472 files changed, 0 insertions, 360933 deletions

diff --git a/lisp/=ada.el b/lisp/=ada.el
deleted file mode 100644
index bf7633bf82d..00000000000
--- a/lisp/=ada.el
+++ /dev/null
@@ -1,734 +0,0 @@
-;;; ada.el --- Ada editing support package in GNUlisp.  v1.0
-
-;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
-
-;; Author: Vincent Broman <broman@bugs.nosc.mil>
-;; Keywords: languages
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Created May 1987.
-;; (borrows heavily from Mick Jordan's Modula-2 package for GNU,
-;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)
-
-;;; Code:
-
-(defvar ada-mode-syntax-table nil
-  "Syntax table in use in Ada-mode buffers.")
-
-(let ((table (make-syntax-table)))
-  (modify-syntax-entry ?_ "_" table)
-  (modify-syntax-entry ?\# "_" table)
-  (modify-syntax-entry ?\( "()" table)
-  (modify-syntax-entry ?\) ")(" table)
-  (modify-syntax-entry ?$ "." table)
-  (modify-syntax-entry ?* "." table)
-  (modify-syntax-entry ?/ "." table)
-  (modify-syntax-entry ?+ "." table)
-  (modify-syntax-entry ?- ". 12" table)
-  (modify-syntax-entry ?= "." table)
-  (modify-syntax-entry ?\& "." table)
-  (modify-syntax-entry ?\| "." table)
-  (modify-syntax-entry ?< "." table)
-  (modify-syntax-entry ?> "." table)
-  (modify-syntax-entry ?\[ "." table)
-  (modify-syntax-entry ?\] "." table)
-  (modify-syntax-entry ?\{ "." table)
-  (modify-syntax-entry ?\} "." table)
-  (modify-syntax-entry ?. "." table)
-  (modify-syntax-entry ?\\ "." table)
-  (modify-syntax-entry ?: "." table)
-  (modify-syntax-entry ?\; "." table)
-  (modify-syntax-entry ?\' "." table)
-  (modify-syntax-entry ?\" "\"" table)
-  (modify-syntax-entry ?\n ">" table)
-  (setq ada-mode-syntax-table table))
-
-;; Strings are a real pain in Ada because both ' and " can appear in a
-;; non-string quote context (the former as an operator, the latter as a
-;; character string).  We follow the least losing solution, in which only " is
-;; a string quote.  Therefore a character string of the form '"' will throw
-;; fontification off on the wrong track.
-
-(defconst ada-font-lock-keywords-1
-  (list
-   ;;
-   ;; Function, package (body), pragma, procedure, task (body) plus name.
-   (list (concat "\\<\\("
-		 "function\\|"
-		 "p\\(ackage\\(\\|[ \t]+body\\)\\|r\\(agma\\|ocedure\\)\\)\\|"
-		 "task\\(\\|[ \t]+body\\)"
-		 "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
-	 '(1 font-lock-keyword-face) '(6 font-lock-function-name-face nil t)))
-  "For consideration as a value of `ada-font-lock-keywords'.
-This does fairly subdued highlighting.")
-
-(defconst ada-font-lock-keywords-2
-  (append ada-font-lock-keywords-1
-   (list
-    ;;
-    ;; Main keywords, except those treated specially below.
-    (concat "\\<\\("
-;    ("abort" "abs" "abstract" "accept" "access" "aliased" "all"
-;     "and" "array" "at" "begin" "case" "declare" "delay" "delta"
-;     "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
-;     "generic" "if" "in" "is" "limited" "loop" "mod" "not"
-;     "null" "or" "others" "private" "protected"
-;     "range" "record" "rem" "renames" "requeue" "return" "reverse"
-;     "select" "separate" "tagged" "task" "terminate" "then" "until"
-;     "while" "xor")
-	    "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|"
-	    "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|"
-	    "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|"
-	    "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|"
-	    "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|"
-	    "o\\(r\\|thers\\)\\|pr\\(ivate\\|otected\\)\\|"
-	    "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|"
-	    "se\\(lect\\|parate\\)\\|"
-	    "t\\(a\\(gged\\|sk\\)\\|erminate\\|hen\\)\\|until\\|while\\|xor"
-	    "\\)\\>")
-    ;;
-    ;; Anything following end and not already fontified is a body name.
-    '("\\<\\(end\\)\\>[ \t]*\\(\\sw+\\)?"
-      (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-;    ;;
-;    ;; Variable name plus optional keywords followed by a type name.  Slow.
-;    (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:"
-;		  "[ \t]*\\(constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*"
-;		  "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
-;	  '(1 font-lock-variable-name-face)
-;	  '(2 font-lock-keyword-face nil t) '(3 font-lock-type-face nil t))
-    ;;
-    ;; Optional keywords followed by a type name.
-    (list (concat ":[ \t]*\\<\\(constant\\|in\\|in[ \t]+out\\|out\\)\\>?[ \t]*"
-		  "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
-	  '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
-    ;;
-    ;; Keywords followed by a type or function name.
-    (list (concat "\\<\\("
-		  "new\\|of\\|subtype\\|type"
-		  "\\)\\>[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?[ \t]*\\((\\)?")
-	  '(1 font-lock-keyword-face)
-	  '(2 (if (match-beginning 4)
-		  font-lock-function-name-face
-		font-lock-type-face) nil t))
-    ;;
-    ;; Keywords followed by a reference.
-    (list (concat "\\<\\(goto\\|raise\\|use\\|when\\|with\\)\\>"
-		  "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?")
-	  '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
-    ;;
-    ;; Goto tags.
-    '("<<\\(\\sw+\\(\\.\\sw*\\)*\\)>>" 1 font-lock-reference-face)
-    ))
-  "For consideration as a value of `ada-font-lock-keywords'.
-This does a lot more highlighting.")
-
-(defvar ada-font-lock-keywords (if font-lock-maximum-decoration
-				   ada-font-lock-keywords-2
-				 ada-font-lock-keywords-1)
-  "Additional expressions to highlight in Ada mode.")
-
-(defvar ada-mode-map nil
-  "Keymap used in Ada mode.")
-
-(let ((map (make-sparse-keymap)))
-  (define-key map "\C-m" 'ada-newline)
-  (define-key map "\C-?" 'backward-delete-char-untabify)
-  (define-key map "\C-i" 'ada-tab)
-  (define-key map "\C-c\C-i" 'ada-untab)
-  (define-key map "\C-c<" 'ada-backward-to-same-indent)
-  (define-key map "\C-c>" 'ada-forward-to-same-indent)
-  (define-key map "\C-ch" 'ada-header)
-  (define-key map "\C-c(" 'ada-paired-parens)
-  (define-key map "\C-c-" 'ada-inline-comment)
-  (define-key map "\C-c\C-a" 'ada-array)
-  (define-key map "\C-cb" 'ada-exception-block)
-  (define-key map "\C-cd" 'ada-declare-block)
-  (define-key map "\C-c\C-e" 'ada-exception)
-  (define-key map "\C-cc" 'ada-case)
-  (define-key map "\C-c\C-k" 'ada-package-spec)
-  (define-key map "\C-ck" 'ada-package-body)
-  (define-key map "\C-c\C-p" 'ada-procedure-spec)
-  (define-key map "\C-cp" 'ada-subprogram-body)
-  (define-key map "\C-c\C-f" 'ada-function-spec)
-  (define-key map "\C-cf" 'ada-for-loop)
-  (define-key map "\C-cl" 'ada-loop)
-  (define-key map "\C-ci" 'ada-if)
-  (define-key map "\C-cI" 'ada-elsif)
-  (define-key map "\C-ce" 'ada-else)
-  (define-key map "\C-c\C-v" 'ada-private)
-  (define-key map "\C-c\C-r" 'ada-record)
-  (define-key map "\C-c\C-s" 'ada-subtype)
-  (define-key map "\C-cs" 'ada-separate)
-  (define-key map "\C-c\C-t" 'ada-type)
-  (define-key map "\C-ct" 'ada-tabsize)
-;;    (define-key map "\C-c\C-u" 'ada-use)
-;;    (define-key map "\C-c\C-w" 'ada-with)
-  (define-key map "\C-cw" 'ada-while-loop)
-  (define-key map "\C-c\C-w" 'ada-when)
-  (define-key map "\C-cx" 'ada-exit)
-  (define-key map "\C-cC" 'ada-compile)
-  (define-key map "\C-cB" 'ada-bind)
-  (define-key map "\C-cE" 'ada-find-listing)
-  (define-key map "\C-cL" 'ada-library-name)
-  (define-key map "\C-cO" 'ada-options-for-bind)
-  (setq ada-mode-map map))
-
-(defvar ada-indent 4 "*Value is the number of columns to indent in Ada-Mode.")
-
-(defvar ada-comment-end-column)
-
-(defun ada-mode ()
-"This is a mode intended to support program development in Ada.
-Most control constructs and declarations of Ada can be inserted in the buffer
-by typing Control-C followed by a character mnemonic for the construct.
-
-\\<ada-mode-map>\\[ada-array] array         	\\[ada-exception-block]    exception block
-\\[ada-exception]  exception      \\[ada-declare-block]    declare block
-\\[ada-package-spec]  package spec   \\[ada-package-body]    package body
-\\[ada-procedure-spec]  procedure spec \\[ada-subprogram-body]    proc/func body
-\\[ada-function-spec]  func spec      \\[ada-for-loop]    for loop
-                        \\[ada-if]    if
-                        \\[ada-elsif]    elsif
-                        \\[ada-else]    else
-\\[ada-private]  private        \\[ada-loop]    loop
-\\[ada-record]  record         \\[ada-case]    case
-\\[ada-subtype]  subtype        \\[ada-separate]    separate
-\\[ada-type]  type           \\[ada-tabsize]    tab spacing for indents
-\\[ada-when]  when           \\[ada-while]    while
-                        \\[ada-exit]    exit
-\\[ada-paired-parens]    paired parens  \\[ada-inline-comment]    inline comment
-                        \\[ada-header]    header spec
-\\[ada-compile]    compile        \\[ada-bind]    bind
-\\[ada-find-listing]    find error list
-\\[ada-library-name]    name library   \\[ada-options-for-bind]    options for bind
-
-\\[ada-backward-to-same-indent] and \\[ada-forward-to-same-indent] move backward and forward respectively to the next line
-having the same (or lesser) level of indentation.
-
-Variable `ada-indent' controls the number of spaces for indent/undent."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map ada-mode-map)
-  (setq major-mode 'ada-mode)
-  (setq mode-name "Ada")
-  (make-local-variable 'comment-column)
-  (setq comment-column 41)
-  (make-local-variable 'ada-comment-end-column)
-  (setq ada-comment-end-column 72)
-  (set-syntax-table ada-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-;  (make-local-variable 'indent-line-function)
-;  (setq indent-line-function 'c-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "--")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 41)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "--+ *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'c-comment-indent)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(ada-font-lock-keywords nil t ((?\_ . "w"))))
-  (run-hooks 'ada-mode-hook))
-
-(defun ada-tabsize (s)
-  "Changes spacing used for indentation.
-The prefix argument is used as the new spacing."
-  (interactive "p")
-  (setq ada-indent s))
-
-(defun ada-newline ()
-  "Start new line and indent to current tab stop."
-  (interactive)
-  (let ((ada-cc (current-indentation)))
-    (newline)
-    (indent-to ada-cc)))
-
-(defun ada-tab ()
-  "Indent to next tab stop."
-  (interactive)
-  (indent-to (* (1+ (/ (current-indentation) ada-indent)) ada-indent)))
-
-(defun ada-untab ()
-  "Delete backwards to previous tab stop."
-  (interactive)
-  (backward-delete-char-untabify ada-indent nil))
-
-(defun ada-go-to-this-indent (step indent-level)
-  "Move point repeatedly by STEP lines until the current line has
-given INDENT-LEVEL or less, or the start or end of the buffer is reached.
-Ignore blank lines, statement labels and block or loop names."
-  (while (and
-	  (zerop (forward-line step))
-	  (or (looking-at "^[ 	]*$")
-	      (looking-at "^[ 	]*--")
-	      (looking-at "^<<[A-Za-z0-9_]+>>")
-	      (looking-at "^[A-Za-z0-9_]+:")
-	      (> (current-indentation) indent-level)))
-    nil))
-
-(defun ada-backward-to-same-indent ()
-  "Move point backwards to nearest line with same indentation or less.
-If not found, point is left at the top of the buffer."
-  (interactive)
-  (ada-go-to-this-indent -1 (current-indentation))
-  (back-to-indentation))
-
-(defun ada-forward-to-same-indent ()
-  "Move point forwards to nearest line with same indentation or less.
-If not found, point is left at the start of the last line in the buffer."
-  (interactive)
-  (ada-go-to-this-indent 1 (current-indentation))
-  (back-to-indentation))
-
-(defun ada-array ()
-  "Insert array type definition.  Uses the minibuffer to prompt
-for component type and index subtypes."
-  (interactive)
-  (insert "array ()")
-  (backward-char)
-  (insert (read-string "index subtype[s]: "))
-  (end-of-line)
-  (insert " of ;")
-  (backward-char)
-  (insert (read-string "component-type: "))
-  (end-of-line))
-
-(defun ada-case ()
-  "Build skeleton case statement.
-Uses the minibuffer to prompt for the selector expression.
-Also builds the first when clause."
-  (interactive)
-  (insert "case ")
-  (insert (read-string "selector expression: ") " is")
-  (ada-newline)
-  (ada-newline)
-  (insert "end case;")
-  (end-of-line 0)
-  (ada-tab)
-  (ada-tab)
-  (ada-when))
-
-(defun ada-declare-block ()
-  "Insert a block with a declare part.
-Indent for the first declaration."
-  (interactive)
-  (let ((ada-block-name (read-string "[block name]: ")))
-    (insert "declare")
-    (cond
-     ( (not (string-equal ada-block-name ""))
-       (beginning-of-line)
-       (open-line 1)
-       (insert ada-block-name ":")
-       (next-line 1)
-       (end-of-line)))
-    (ada-newline)
-    (ada-newline)
-    (insert "begin")
-    (ada-newline)
-    (ada-newline)
-    (if (string-equal ada-block-name "")
-	(insert "end;")
-      (insert "end " ada-block-name ";"))
-    )
-  (end-of-line -2)
-  (ada-tab))
-
-(defun ada-exception-block ()
-  "Insert a block with an exception part.
-Indent for the first line of code."
-  (interactive)
-  (let ((block-name (read-string "[block name]: ")))
-    (insert "begin")
-    (cond
-     ( (not (string-equal block-name ""))
-       (beginning-of-line)
-       (open-line 1)
-       (insert block-name ":")
-       (next-line 1)
-       (end-of-line)))
-    (ada-newline)
-    (ada-newline)
-    (insert "exception")
-    (ada-newline)
-    (ada-newline)
-    (cond
-     ( (string-equal block-name "")
-       (insert "end;"))
-     ( t
-       (insert "end " block-name ";")))
-    )
-  (end-of-line -2)
-  (ada-tab))
-
-(defun ada-exception ()
-  "Insert an indented exception part into a block."
-  (interactive)
-  (ada-untab)
-  (insert "exception")
-  (ada-newline)
-  (ada-tab))
-
-(defun ada-else ()
-  "Add an else clause inside an if-then-end-if clause."
-  (interactive)
-  (ada-untab)
-  (insert "else")
-  (ada-newline)
-  (ada-tab))
-
-(defun ada-exit ()
-  "Insert an exit statement, prompting for loop name and condition."
-  (interactive)
-  (insert "exit")
-  (let ((ada-loop-name (read-string "[name of loop to exit]: ")))
-    (if (not (string-equal ada-loop-name "")) (insert " " ada-loop-name)))
-  (let ((ada-exit-condition (read-string "[exit condition]: ")))
-    (if (not (string-equal ada-exit-condition ""))
-	(if (string-match "^ *[Ww][Hh][Ee][Nn] +" ada-exit-condition)
-	    (insert " " ada-exit-condition)
-	  (insert " when " ada-exit-condition))))
-  (insert ";"))
-
-(defun ada-when ()
-  "Start a case statement alternative with a when clause."
-  (interactive)
-  (ada-untab)     ; we were indented in code for the last alternative.
-  (insert "when ")
-  (insert (read-string "'|'-delimited choice list: ") " =>")
-  (ada-newline)
-  (ada-tab))
-
-(defun ada-for-loop ()
-  "Build a skeleton for-loop statement, prompting for the loop parameters."
-  (interactive)
-  (insert "for ")
-  (let* ((ada-loop-name (read-string "[loop name]: "))
-	 (ada-loop-is-named (not (string-equal ada-loop-name ""))))
-    (if ada-loop-is-named
-	(progn
-	  (beginning-of-line)
-	  (open-line 1)
-	  (insert ada-loop-name ":")
-	  (next-line 1)
-	  (end-of-line 1)))
-    (insert (read-string "loop variable: ") " in ")
-    (insert (read-string "range: ") " loop")
-    (ada-newline)
-    (ada-newline)
-    (insert "end loop")
-    (if ada-loop-is-named (insert " " ada-loop-name))
-    (insert ";"))
-  (end-of-line 0)
-  (ada-tab))
-
-(defun ada-header ()
-  "Insert a comment block containing the module title, author, etc."
-  (interactive)
-  (insert "--\n--  Title: \t")
-  (insert (read-string "Title: "))
-  (insert "\n--  Created:\t" (current-time-string))
-  (insert "\n--  Author: \t" (user-full-name))
-  (insert "\n--\t\t<" (user-login-name) "@" (system-name) ">\n--\n"))
-
-(defun ada-if ()
-  "Insert skeleton if statment, prompting for a boolean-expression."
-  (interactive)
-  (insert "if ")
-  (insert (read-string "condition: ") " then")
-  (ada-newline)
-  (ada-newline)
-  (insert "end if;")
-  (end-of-line 0)
-  (ada-tab))
-
-(defun ada-elsif ()
-  "Add an elsif clause to an if statement, prompting for the boolean-expression."
-  (interactive)
-  (ada-untab)
-  (insert "elsif ")
-  (insert (read-string "condition: ") " then")
-  (ada-newline)
-  (ada-tab))
-
-(defun ada-loop ()
-  "Insert a skeleton loop statement.  The exit statement is added by hand."
-  (interactive)
-  (insert "loop ")
-  (let* ((ada-loop-name (read-string "[loop name]: "))
-	 (ada-loop-is-named (not (string-equal ada-loop-name ""))))
-    (if ada-loop-is-named
-	(progn
-	  (beginning-of-line)
-	  (open-line 1)
-	  (insert ada-loop-name ":")
-	  (forward-line 1)
-	  (end-of-line 1)))
-    (ada-newline)
-    (ada-newline)
-    (insert "end loop")
-    (if ada-loop-is-named (insert " " ada-loop-name))
-    (insert ";"))
-  (end-of-line 0)
-  (ada-tab))
-
-(defun ada-package-spec ()
-  "Insert a skeleton package specification."
-  (interactive)
-  (insert "package ")
-  (let ((ada-package-name (read-string "package name: " )))
-    (insert ada-package-name " is")
-    (ada-newline)
-    (ada-newline)
-    (insert "end " ada-package-name ";")
-    (end-of-line 0)
-    (ada-tab)))
-
-(defun ada-package-body ()
-  "Insert a skeleton package body --  includes a begin statement."
-  (interactive)
-  (insert "package body ")
-  (let ((ada-package-name (read-string "package name: " )))
-    (insert ada-package-name " is")
-    (ada-newline)
-    (ada-newline)
-    (insert "begin")
-    (ada-newline)
-    (insert "end " ada-package-name ";")
-    (end-of-line -1)
-    (ada-tab)))
-
-(defun ada-private ()
-  "Undent and start a private section of a package spec. Reindent."
-  (interactive)
-  (ada-untab)
-  (insert "private")
-  (ada-newline)
-  (ada-tab))
-
-(defun ada-get-arg-list ()
-  "Read from the user a procedure or function argument list.
-Add parens unless arguments absent, and insert into buffer.
-Individual arguments are arranged vertically if entered one at a time.
-Arguments ending with `;' are presumed single and stacked."
-  (insert " (")
-  (let ((ada-arg-indent (current-column))
-	(ada-args (read-string "[arguments]: ")))
-    (if (string-equal ada-args "")
-	(backward-delete-char 2)
-      (progn
-	(while (string-match ";$" ada-args)
-	  (insert ada-args)
-	  (newline)
-	  (indent-to ada-arg-indent)
-	  (setq ada-args (read-string "next argument: ")))
-	(insert ada-args ")")))))
-
-(defun ada-function-spec ()
-  "Insert a function specification.  Prompts for name and arguments."
-  (interactive)
-  (insert "function ")
-  (insert (read-string "function name: "))
-  (ada-get-arg-list)
-  (insert " return ")
-  (insert (read-string "result type: ")))
-
-(defun ada-procedure-spec ()
-  "Insert a procedure specification, prompting for its name and arguments."
-  (interactive)
-  (insert "procedure ")
-  (insert (read-string "procedure name: " ))
-  (ada-get-arg-list))
-
-(defun get-ada-subprogram-name ()
-  "Return (without moving point or mark) a pair whose CAR is the name of
-the function or procedure whose spec immediately precedes point, and whose
-CDR is the column number where the procedure/function keyword was found."
-  (save-excursion
-    (let ((ada-proc-indent 0))
-      (if (re-search-backward
-  ;;;; Unfortunately, comments are not ignored in this string search.
-	     "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" nil t)
-	  (if (or (looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>")
-		  (looking-at "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>"))
-	      (progn
-		(setq ada-proc-indent (current-column))
-		(forward-word 2)
-		(let ((p2 (point)))
-		  (forward-word -1)
-		  (cons (buffer-substring (point) p2) ada-proc-indent)))
-	      (get-ada-subprogram-name))
-	   (cons "NAME?" ada-proc-indent)))))
-
-(defun ada-subprogram-body ()
-  "Insert frame for subprogram body.
-Invoke right after `ada-function-spec' or `ada-procedure-spec'."
-  (interactive)
-  (insert " is")
-  (let ((ada-subprogram-name-col (get-ada-subprogram-name)))
-    (newline)
-    (indent-to (cdr ada-subprogram-name-col))
-    (ada-newline)
-    (insert "begin")
-    (ada-newline)
-    (ada-newline)
-    (insert "end " (car ada-subprogram-name-col) ";"))
-  (end-of-line -2)
-  (ada-tab))
-
-(defun ada-separate ()
-  "Finish a body stub with `is separate'."
-  (interactive)
-  (insert " is")
-  (ada-newline)
-  (ada-tab)
-  (insert "separate;")
-  (ada-newline)
-  (ada-untab))
-
-;(defun ada-with ()
-;  "Inserts a with clause, prompting for the list of units depended upon."
-;  (interactive)
-;  (insert "with ")
-;  (insert (read-string "list of units depended upon: ") ";"))
-;
-;(defun ada-use ()
-;  "Inserts a use clause, prompting for the list of packages used."
-;  (interactive)
-;  (insert "use ")
-;  (insert (read-string "list of packages to use: ") ";"))
-
-(defun ada-record ()
-  "Insert a skeleton record type declaration."
-  (interactive)
-  (insert "record")
-  (ada-newline)
-  (ada-newline)
-  (insert "end record;")
-  (end-of-line 0)
-  (ada-tab))
-
-(defun ada-subtype ()
-  "Start insertion of a subtype declaration, prompting for the subtype name."
-  (interactive)
-  (insert "subtype " (read-string "subtype name: ") " is ;")
-  (backward-char)
-  (message "insert subtype indication."))
-
-(defun ada-type ()
-  "Start insertion of a type declaration, prompting for the type name."
-  (interactive)
-  (insert "type " (read-string "type name: "))
-  (let ((disc-part (read-string "discriminant specs: ")))
-    (if (not (string-equal disc-part ""))
-	(insert "(" disc-part ")")))
-  (insert " is ")
-  (message "insert type definition."))
-
-(defun ada-while-loop ()
-  (interactive)
-  (insert "while ")
-  (let* ((ada-loop-name (read-string "loop name: "))
-	 (ada-loop-is-named (not (string-equal ada-loop-name ""))))
-    (if ada-loop-is-named
-	(progn
-	  (beginning-of-line)
-	  (open-line 1)
-	  (insert ada-loop-name ":")
-	  (next-line 1)
-	  (end-of-line 1)))
-    (insert (read-string "entry condition: ") " loop")
-    (ada-newline)
-    (ada-newline)
-    (insert "end loop")
-    (if ada-loop-is-named (insert " " ada-loop-name))
-    (insert ";"))
-  (end-of-line 0)
-  (ada-tab))
-
-(defun ada-paired-parens ()
-  "Insert a pair of round parentheses, placing point between them."
-  (interactive)
-  (insert "()")
-  (backward-char))
-
-(defun ada-inline-comment ()
-  "Start a comment after the end of the line, indented at least
-`comment-column' spaces.  If starting after `end-comment-column',
-start a new line."
-  (interactive)
-  (end-of-line)
-  (if (> (current-column) ada-comment-end-column) (newline))
-  (if (< (current-column) comment-column) (indent-to comment-column))
-  (insert " -- "))
-
-(defun ada-display-comment ()
-"Inserts three comment lines, making a display comment."
-  (interactive)
-  (insert "--\n-- \n--")
-  (end-of-line 0))
-
-;; Much of this is specific to Ada-Ed
-
-(defvar ada-lib-dir-name "lib" "*Current Ada program library directory.")
-(defvar ada-bind-opts "" "*Options to supply for binding.")
-
-(defun ada-library-name (ada-lib-name)
-  "Specify name of Ada library directory for later compilations."
-  (interactive "DName of Ada library directory: ")
-  (setq ada-lib-dir-name ada-lib-name))
-
-(defun ada-options-for-bind ()
-  "Specify options, such as -m and -i, needed for `ada-bind'."
-  (setq ada-bind-opts (read-string "-m and -i options for `ada-bind': ")))
-
-(defun ada-compile (arg)
-  "Save the current buffer and compile it into the current program library.
-Initialize the library if a prefix arg is given."
-  (interactive "P")
-  (let* ((ada-init (if (null arg) "" "-n "))
-	(ada-source-file (buffer-name)))
-    (compile
-     (concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file))))
-
-(defun ada-find-listing ()
-  "Find listing file for ada source in current buffer, using other window."
-  (interactive)
-  (find-file-other-window (concat (substring (buffer-name) 0 -4) ".lis"))
-  (search-forward "*** ERROR"))
-
-(defun ada-bind ()
-  "Bind the current program library, using the current binding options."
-  (interactive)
-  (compile (concat "adabind " ada-bind-opts " " ada-lib-dir-name)))
-
-;;; ada.el ends here
diff --git a/lisp/=batmode.el b/lisp/=batmode.el
deleted file mode 100644
index 72a0735c6a6..00000000000
--- a/lisp/=batmode.el
+++ /dev/null
@@ -1,165 +0,0 @@
-;;; batmode.el --- Simple mode for Windows BAT files
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Peter Breton <pbreton@i-kinetics.com> 
-;; Created: Thu Jul 25 1996
-;; Keywords: BAT, DOS, Windows
-
-;; 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:
-;;
-;; USAGE: Byte-compile this file, and add the following lines to your
-;;   emacs initialization file (.emacs/_emacs):
-;; 
-;; (setq auto-mode-alist 
-;;       (append 
-;;        (list (cons "\\.[bB][aA][tT]$" 'bat-mode))
-;;        ;; For DOS init files
-;;        (list (cons "CONFIG\\."   'bat-mode))
-;;        (list (cons "AUTOEXEC\\." 'bat-mode))
-;;        auto-mode-alist))
-;;
-;;   (autoload 'bat-mode "batmode"
-;;      "DOS and WIndows BAT files" t)
-
-;; TODO:
-;;
-;; Support "compiles" ?
-;; Imenu? Don't have real functions.....
-
-;;; Change log:
-;; $Log: batmode.el,v $
-;; Revision 1.3  1996/08/22 02:31:47  peter
-;; Added Usage message, credit to folks from NTEmacs mailing list,
-;; Syntax table, New font-lock keywords
-;;
-;; Revision 1.2  1996/08/18 16:27:13  peter
-;; Added preliminary global-font-lock support
-;;
-;; Revision 1.1  1996/08/18 16:14:18  peter
-;; Initial revision
-;;
-
-;; Credit for suggestions, patches and bug-fixes:
-;;   Robert Brodersen <rbrodersen@siebel.com>
-;;   ACorreir@pervasive-sw.com (Alfred Correira)
-
-;;; Code:
-
-(defvar bat-mode-map nil "Local keymap for bat-mode buffers.")
-
-;; Make this lowercase if you like
-(defvar bat-mode-comment-start "REM "
-  "Comment string to use in BAT mode")
-
-(defvar bat-mode-syntax-table nil
-  "Syntax table in use in Bat-mode buffers.")
-
-(if bat-mode-map
-    nil
-  (setq bat-mode-map (copy-keymap global-map))
-)
-
-;; Make underscores count as words
-(if bat-mode-syntax-table
-    ()
-  (setq bat-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?_  "w"  bat-mode-syntax-table)
-)
-
-(defun bat-mode ()
-  "Mode for DOS and Windows BAT files"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map             bat-mode-map)
-  (set-syntax-table	     bat-mode-syntax-table)
-
-  (make-local-variable	     'parse-sexp-ignore-comments)
-  (make-local-variable	     'comment-start)
-  (make-local-variable	     'comment-start-skip)
-  (make-local-variable	     'comment-end)
-  (make-local-variable	     'executable-command)
-  (make-local-variable	     'font-lock-defaults)
-
-  (setq major-mode          'bat-mode
-        mode-name           "bat"
-
-        comment-end         ""
-
-       comment-start       bat-mode-comment-start
-       comment-start-skip  "[Rr][Ee][Mm] *"
-
-       parse-sexp-ignore-comments t
-       
-       )
-
-  ;; Global font-lock support
-  ;; (setq font-lock-defaults (list 'bat-font-lock-keywords nil t nil nil))
-  (setq font-lock-defaults (list 'bat-font-lock-keywords nil))
-
-  (run-hooks 'bat-mode-hook))
-
-(defvar bat-font-lock-keywords
-  (list
-   ;; Make this one first in the list, otherwise comments will
-   ;; be over-written by other variables
-    (list "^[@ \t]*\\([rR][eE][mM].*\\)" 1 'font-lock-comment-face t)
-    (list "^[ \t]*\\(::-.*\\)"		 1 'font-lock-comment-face t)
-    (list
-     (concat "\\(\\<"
-      (mapconcat 'identity
-                 '(
-                   "call"
-                   "echo"
-                   "exist"
-                   "errorlevel"
-                   "for"
-                   "goto"
-                   "if"
-                   "not"
-                   "path"
-                   "pause"
-                   "prompt"
-                   "set"
-                   "start"
-                  )
-                 "\\>\\|\\<")
-             "\\>\\)") 1 'font-lock-keyword-face)
-	(list "^[ \t]*\\(:\\sw+\\)"      1 'font-lock-function-name-face t)
-	(list "\\(%\\sw+%\\)"		 1 'font-lock-reference-face)
-	(list "\\(%[0-9]\\)"		 1 'font-lock-reference-face)
-	(list "\\(/[^/ \t\n]+\\)"	 1 'font-lock-type-face)
-	(list "\\<\\(goto\\)\\>[ \t]*\\(\\sw+\\)?" 
-	      '(1 font-lock-keyword-face)
-	      '(2 font-lock-function-name-face nil t))
-
-  )
-  "Keywords to hilight in BAT mode")
-
-;;; don't do it in Win-Emacs
-(if (boundp 'font-lock-defaults-alist)
-    (add-to-list
-     'font-lock-defaults-alist 
-     (cons 'bat-mode
-	   (list 'bat-font-lock-keywords nil t nil nil))))
-
-(provide 'bat-mode)
-
-;;; batmode.el ends here
diff --git a/lisp/=bytecpat.el b/lisp/=bytecpat.el
deleted file mode 100644
index 1698b2659ba..00000000000
--- a/lisp/=bytecpat.el
+++ /dev/null
@@ -1,15 +0,0 @@
-;;; bytecpat.el --- do recompilation for Emacs patch files.
-;;; This function is used by the patch files to update Emacs releases.
-
-(defun batch-byte-recompile-emacs ()
-  "Recompile the Emacs `lisp' directory.
-This is used after installing the patches for a new version."
-  (let ((load-path (list (expand-file-name "lisp"))))
-    (byte-recompile-directory "lisp")))
-
-(defun batch-byte-compile-emacs ()
-  "Compile new files installed in the Emacs `lisp' directory.
-This is used after installing the patches for a new version.
-It uses the command line arguments to specify the files to compile."
-  (let ((load-path (list (expand-file-name "lisp"))))
-    (batch-byte-compile)))
diff --git a/lisp/=cl.el b/lisp/=cl.el
deleted file mode 100644
index 1a6a385e3ee..00000000000
--- a/lisp/=cl.el
+++ /dev/null
@@ -1,3162 +0,0 @@
-;;; cl.el --- Common-Lisp extensions for GNU Emacs Lisp.
-
-;; Copyright (C) 1987, 1988, 1989, 1992  Free Software Foundation, Inc.
-
-;; Author: Cesar Quiroz <quiroz@cs.rochester.edu>
-;; Keywords: extensions
-
-(defvar cl-version "3.0	07-February-1993")
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY.  No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing.  Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License.   A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities.  It should be in a
-;; file named COPYING.  Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; Notes from Rob Austein on his mods
-;; yaya:/usr/u/sra/cl/cl.el, 5-May-1991 16:01:34, sra
-;;
-;; Slightly hacked copy of cl.el 2.0 beta 27.
-;;
-;; Various minor performance improvements:
-;;  a) Don't use MAPCAR when we're going to discard its results.
-;;  b) Make various macros a little more clever about optimizing
-;;     generated code in common cases.
-;;  c) Fix DEFSETF to expand to the right code at compile-time.
-;;  d) Make various macros cleverer about generating reasonable
-;;     code when compiled, particularly forms like DEFSTRUCT which
-;;     are usually used at top-level and thus are only compiled if
-;;     you use Hallvard Furuseth's hacked bytecomp.el.
-;;
-;; New features: GETF, REMF, and REMPROP.
-;;
-;; Notes:
-;;  1) I'm sceptical about the FBOUNDP checks in SETF.  Why should
-;;     the SETF expansion fail because the SETF method isn't defined
-;;     at compile time?  Lisp is going to check for a binding at run-time
-;;     anyway, so maybe we should just assume the user's right here.
-
-;;;; These are extensions to Emacs Lisp that provide some form of
-;;;; Common Lisp compatibility, beyond what is already built-in
-;;;; in Emacs Lisp.
-;;;;
-;;;; When developing them, I had the code spread among several files.
-;;;; This file 'cl.el' is a concatenation of those original files,
-;;;; minus some declarations that became redundant.  The marks between
-;;;; the original files can be found easily, as they are lines that
-;;;; begin with four semicolons (as this does).  The names of the
-;;;; original parts follow the four semicolons in uppercase, those
-;;;; names are GLOBAL, SYMBOLS, LISTS, SEQUENCES, CONDITIONALS,
-;;;; ITERATIONS, MULTIPLE VALUES, ARITH, SETF and DEFSTRUCT.  If you
-;;;; add functions to this file, you might want to put them in a place
-;;;; that is compatible with the division above (or invent your own
-;;;; categories).
-;;;;
-;;;; To compile this file, make sure you load it first.  This is
-;;;; because many things are implemented as macros and now that all
-;;;; the files are concatenated together one cannot ensure that
-;;;; declaration always precedes use.
-;;;;
-;;;; Bug reports, suggestions and comments,
-;;;; to quiroz@cs.rochester.edu
-
-
-;;;; GLOBAL
-;;;;    This file provides utilities and declarations that are global
-;;;;    to Common Lisp and so might be used by more than one of the
-;;;;    other libraries.  Especially, I intend to keep here some
-;;;;    utilities that help parsing/destructuring some difficult calls. 
-;;;;
-;;;;
-;;;;    Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;;       (quiroz@cs.rochester.edu)
-
-;;; Too many pieces of the rest of this package use psetq.  So it is unwise to
-;;; use here anything but plain Emacs Lisp!  There is a neater recursive form
-;;; for the algorithm that deals with the bodies.
-
-;;; Code:
-
-;;; This version is due to Hallvard Furuseth (hallvard@ifi.uio.no, 6 Jul 91)
-(defmacro psetq (&rest args)
-  "(psetq {VARIABLE VALUE}...): In parallel, set each VARIABLE to its VALUE.
-All the VALUEs are evaluated, and then all the VARIABLEs are set.
-Aside from order of evaluation, this is the same as `setq'."
-  ;; check there is a reasonable number of forms
-  (if (/= (% (length args) 2) 0)
-      (error "Odd number of arguments to `psetq'"))
-  (setq args (copy-sequence args))      ;for safety below
-  (prog1 (cons 'setq args)
-    (while (progn (if (not (symbolp (car args)))
-		      (error "`psetq' expected a symbol, found '%s'."
-			     (prin1-to-string (car args))))
-		  (cdr (cdr args)))
-      (setcdr args (list (list 'prog1 (nth 1 args)
-			       (cons 'setq
-				     (setq args (cdr (cdr args))))))))))
-
-;;; utilities
-;;;
-;;; pair-with-newsyms takes a list and returns a list of lists of the
-;;; form (newsym form), such that a let* can then bind the evaluation
-;;; of the forms to the newsyms.  The idea is to guarantee correct
-;;; order of evaluation of the subforms of a setf.  It also returns a
-;;; list of the newsyms generated, in the corresponding order.
-
-(defun pair-with-newsyms (oldforms)
-  "PAIR-WITH-NEWSYMS OLDFORMS
-The top-level components of the list oldforms are paired with fresh
-symbols, the pairings list and the newsyms list are returned."
-  (do ((ptr oldforms (cdr ptr))
-       (bindings '())
-       (newsyms  '()))
-      ((endp ptr) (values (nreverse bindings) (nreverse newsyms)))
-    (let ((newsym (gentemp)))
-      (setq bindings (cons (list newsym (car ptr)) bindings))
-      (setq newsyms  (cons newsym newsyms)))))
-
-(defun zip-lists (evens odds)
-  "Merge two lists EVENS and ODDS, taking elts from each list alternatingly.
-EVENS and ODDS are two lists.  ZIP-LISTS constructs a new list, whose
-even numbered elements (0,2,...) come from EVENS and whose odd
-numbered elements (1,3,...) come from ODDS. 
-The construction stops when the shorter list is exhausted."
-  (do* ((p0   evens    (cdr p0))
-        (p1   odds     (cdr p1))
-        (even (car p0) (car p0))
-        (odd  (car p1) (car p1))
-        (result '()))
-      ((or (endp p0) (endp p1))
-       (nreverse result))
-    (setq result
-          (cons odd (cons even result)))))
-
-(defun unzip-list (list)
-  "Extract even and odd elements of LIST into two separate lists.
-The argument LIST is separated in two strands, the even and the odd
-numbered elements.  Numbering starts with 0, so the first element
-belongs in EVENS. No check is made that there is an even number of
-elements to start with."
-  (do* ((ptr   list       (cddr ptr))
-        (this  (car ptr)  (car ptr))
-        (next  (cadr ptr) (cadr ptr))
-        (evens '())
-        (odds  '()))
-      ((endp ptr)
-       (values (nreverse evens) (nreverse odds)))
-    (setq evens (cons this evens))
-    (setq odds  (cons next odds))))
-
-(defun reassemble-argslists (argslists)
-  "(reassemble-argslists ARGSLISTS) => a list of lists
-ARGSLISTS is a list of sequences.  Return a list of lists, the first
-sublist being all the entries coming from ELT 0 of the original
-sublists, the next those coming from ELT 1 and so on, until the
-shortest list is exhausted."
-  (let* ((minlen   (apply 'min (mapcar 'length argslists)))
-         (result   '()))
-    (dotimes (i minlen (nreverse result))
-      ;; capture all the elements at index i
-      (setq result
-            (cons (mapcar (function (lambda (sublist) (elt sublist i)))
-                   argslists)
-                  result)))))
-
-
-;;; Checking that a list of symbols contains no duplicates is a common
-;;; task when checking the legality of some macros.  The check for 'eq
-;;; pairs can be too expensive, as it is quadratic on the length of
-;;; the list.  I use a 4-pass, linear, counting approach.  It surely
-;;; loses on small lists (less than 5 elements?), but should win for
-;;; larger lists.  The fourth pass could be eliminated.
-;;; 10 dec 1986.  Emacs Lisp has no REMPROP, so I just eliminated the
-;;; 4th pass.
-;;;
-;;; [22 April 1991, sra] REMPROP now in library, so restored 4th pass.
-(defun duplicate-symbols-p (list)
-  "Find all symbols appearing more than once in LIST.
-Return a list of all such duplicates; `nil' if there are no duplicates."
-  (let  ((duplicates '())               ;result built here
-         (propname   (gensym))          ;we use a fresh property
-         )
-    ;; check validity
-    (unless (and (listp list)
-                 (every 'symbolp list))
-      (error "a list of symbols is needed"))
-    ;; pass 1: mark
-    (dolist (x list)
-      (put x propname 0))
-    ;; pass 2: count
-    (dolist (x list)
-      (put x propname (1+ (get x propname))))
-    ;; pass 3: collect
-    (dolist (x list)
-      (if (> (get x propname) 1)
-          (setq duplicates (cons x duplicates))))
-    ;; pass 4: unmark.
-    (dolist (x list)
-      (remprop x propname))
-    ;; return result
-    duplicates))
-
-;;;; end of cl-global.el
-
-;;;; SYMBOLS
-;;;;    This file provides the gentemp function, which generates fresh
-;;;;    symbols, plus some other minor Common Lisp symbol tools.
-;;;;
-;;;;    Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;;       (quiroz@cs.rochester.edu)
-
-;;; Keywords.  There are no packages in Emacs Lisp, so this is only a
-;;; kludge around to let things be "as if" a keyword package was around.
-
-(defmacro defkeyword (x &optional docstring)
-  "Make symbol X a keyword (symbol whose value is itself).
-Optional second argument is a documentation string for it."
-  (cond ((symbolp x)
-         (list 'defconst x (list 'quote x) docstring))
-        (t
-         (error "`%s' is not a symbol" (prin1-to-string x)))))
-
-(defun keywordp (sym)
-  "t if SYM is a keyword."
-  (if (and (symbolp sym) (char-equal (aref (symbol-name sym) 0) ?\:))
-      ;; looks like one, make sure value is right
-      (set sym sym)
-    nil))
-
-(defun keyword-of (sym)
-  "Return a keyword that is naturally associated with symbol SYM.
-If SYM is keyword, the value is SYM.
-Otherwise it is a keyword whose name is `:' followed by SYM's name."
-  (cond ((keywordp sym)
-         sym)
-        ((symbolp sym)
-         (let ((newsym (intern (concat ":" (symbol-name sym)))))
-           (set newsym newsym)))
-        (t
-         (error "expected a symbol, not `%s'" (prin1-to-string sym)))))
-
-;;; Temporary symbols.  
-;;; 
-
-(defvar *gentemp-index* 0
-  "Integer used by gentemp to produce new names.")
-
-(defvar *gentemp-prefix* "T$$_"
-  "Names generated by gentemp begin with this string by default.")
-
-(defun gentemp (&optional prefix oblist)
-  "Generate a fresh interned symbol.
-There are 2 optional arguments, PREFIX and OBLIST.  PREFIX is the
-string that begins the new name, OBLIST is the obarray used to search for
-old names.  The defaults are just right, YOU SHOULD NEVER NEED THESE
-ARGUMENTS IN YOUR OWN CODE."
-  (if (null prefix)
-      (setq prefix *gentemp-prefix*))
-  (if (null oblist)
-      (setq oblist obarray))            ;default for the intern functions
-  (let ((newsymbol nil)
-        (newname))
-    (while (not newsymbol)
-      (setq newname (concat prefix *gentemp-index*))
-      (setq *gentemp-index* (+ *gentemp-index* 1))
-      (if (not (intern-soft newname oblist))
-          (setq newsymbol (intern newname oblist))))
-    newsymbol))
-
-(defvar *gensym-index* 0
-  "Integer used by gensym to produce new names.")
-
-(defvar *gensym-prefix* "G$$_"
-  "Names generated by gensym begin with this string by default.")
-
-(defun gensym (&optional prefix)
-  "Generate a fresh uninterned symbol.
-There is an  optional argument, PREFIX.  PREFIX is the
-string that begins the new name. Most people take just the default,
-except when debugging needs suggest otherwise."
-  (if (null prefix)
-      (setq prefix *gensym-prefix*))
-  (let ((newsymbol nil)
-        (newname   ""))
-    (while (not newsymbol)
-      (setq newname (concat prefix *gensym-index*))
-      (setq *gensym-index* (+ *gensym-index* 1))
-      (if (not (intern-soft newname))
-          (setq newsymbol (make-symbol newname))))
-    newsymbol))
-
-;;;; end of cl-symbols.el
-
-;;;; CONDITIONALS
-;;;;    This file provides some of the conditional constructs of
-;;;;    Common Lisp.  Total compatibility is again impossible, as the
-;;;;    'if' form is different in both languages, so only a good
-;;;;    approximation is desired.
-;;;;
-;;;;    Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;;       (quiroz@cs.rochester.edu)
-
-;;; indentation info
-(put 'case      'lisp-indent-hook 1)
-(put 'ecase     'lisp-indent-hook 1)
-(put 'when      'lisp-indent-hook 1)
-(put 'unless    'lisp-indent-hook 1)
-
-;;; WHEN and UNLESS
-;;; These two forms are simplified ifs, with a single branch.
-
-(defmacro when (condition &rest body)
-  "(when CONDITION . BODY) => evaluate BODY if CONDITION is true."
-  (list* 'if (list 'not condition) '() body))
-
-(defmacro unless (condition &rest body)
-  "(unless CONDITION . BODY) => evaluate BODY if CONDITION is false."
-  (list* 'if condition '() body))
-
-;;; CASE and ECASE
-;;; CASE selects among several clauses, based on the value (evaluated)
-;;; of a expression and a list of (unevaluated) key values.  ECASE is
-;;; the same, but signals an error if no clause is activated.
-
-(defmacro case (expr &rest cases)
-  "(case EXPR . CASES) => evals EXPR, chooses from CASES on that value.
-EXPR   -> any form
-CASES  -> list of clauses, non empty
-CLAUSE -> HEAD . BODY
-HEAD   -> t             = catch all, must be last clause
-       -> otherwise     = same as t
-       -> nil           = illegal
-       -> atom          = activated if (eql  EXPR HEAD)
-       -> list of atoms = activated if (memq EXPR HEAD)
-BODY   -> list of forms, implicit PROGN is built around it.
-EXPR is evaluated only once."
-  (let* ((newsym (gentemp))
-         (clauses (case-clausify cases newsym)))
-    ;; convert case into a cond inside a let
-    (list 'let
-         (list (list newsym expr))
-         (list* 'cond (nreverse clauses)))))
-
-(defmacro ecase (expr &rest cases)
-  "(ecase EXPR . CASES) => like `case', but error if no case fits.
-`t'-clauses are not allowed."
-  (let* ((newsym (gentemp))
-         (clauses (case-clausify cases newsym)))
-    ;; check that no 't clause is present.
-    ;; case-clausify would put one such at the beginning of clauses
-    (if (eq (caar clauses) t)
-        (error "no clause-head should be `t' or `otherwise' for `ecase'"))
-    ;; insert error-catching clause
-    (setq clauses
-          (cons
-           (list 't (list 'error
-                          "ecase on %s = %s failed to take any branch"
-                          (list 'quote expr)
-                          (list 'prin1-to-string newsym)))
-           clauses))
-    ;; generate code as usual
-    (list 'let
-          (list (list newsym expr))
-          (list* 'cond (nreverse clauses)))))
-
-
-(defun case-clausify (cases newsym)
-  "CASE-CLAUSIFY CASES NEWSYM => clauses for a 'cond'
-Converts the CASES of a [e]case macro into cond clauses to be
-evaluated inside a let that binds NEWSYM.  Returns the clauses in
-reverse order."
-  (do* ((currentpos cases        (cdr currentpos))
-        (nextpos    (cdr cases)  (cdr nextpos))
-        (curclause  (car cases)  (car currentpos))
-        (result     '()))
-      ((endp currentpos) result)
-    (let ((head (car curclause))
-          (body (cdr curclause)))
-      ;; construct a cond-clause according to the head
-      (cond ((null head)
-             (error "case clauses cannot have null heads: `%s'"
-                    (prin1-to-string curclause)))
-            ((or (eq head 't)
-                 (eq head 'otherwise))
-             ;; check it is the last clause
-             (if (not (endp nextpos))
-                 (error "clause with `t' or `otherwise' head must be last"))
-             ;; accept this clause as a 't' for cond
-             (setq result (cons (cons 't body) result)))
-            ((atom head)
-             (setq result
-                   (cons (cons (list 'eql newsym (list 'quote head)) body)
-                         result)))
-            ((listp head)
-             (setq result
-                   (cons (cons (list 'memq newsym (list 'quote head)) body)
-                         result)))
-            (t
-             ;; catch-all for this parser
-             (error "don't know how to parse case clause `%s'"
-                    (prin1-to-string head)))))))
-
-;;;; end of cl-conditionals.el
-
-;;;; ITERATIONS
-;;;;    This file provides simple iterative macros (a la Common Lisp)
-;;;;    constructed on the basis of let, let* and while, which are the
-;;;;    primitive binding/iteration constructs of Emacs Lisp
-;;;;
-;;;;    The Common Lisp iterations use to have a block named nil
-;;;;    wrapped around them, and allow declarations at the beginning
-;;;;    of their bodies and you can return a value using (return ...).
-;;;;    Nothing of the sort exists in Emacs Lisp, so I haven't tried
-;;;;    to imitate these behaviors.
-;;;;
-;;;;    Other than the above, the semantics of Common Lisp are
-;;;;    correctly reproduced to the extent this was reasonable.
-;;;;
-;;;;    Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;;       (quiroz@cs.rochester.edu)
-
-;;; some lisp-indentation information
-(put 'do                'lisp-indent-hook 2)
-(put 'do*               'lisp-indent-hook 2)
-(put 'dolist            'lisp-indent-hook 1)
-(put 'dotimes           'lisp-indent-hook 1)
-(put 'do-symbols        'lisp-indent-hook 1)
-(put 'do-all-symbols    'lisp-indent-hook 1)
-
-
-(defmacro do (stepforms endforms &rest body)
-  "(do STEPFORMS ENDFORMS . BODY): Iterate BODY, stepping some local variables.
-STEPFORMS must be a list of symbols or lists.  In the second case, the
-lists must start with a symbol and contain up to two more forms. In
-the STEPFORMS, a symbol is the same as a (symbol).  The other 2 forms
-are the initial value (def. NIL) and the form to step (def. itself).
-The values used by initialization and stepping are computed in parallel.
-The ENDFORMS are a list (CONDITION . ENDBODY).  If the CONDITION
-evaluates to true in any iteration, ENDBODY is evaluated and the last
-form in it is returned.
-The BODY (which may be empty) is evaluated at every iteration, with
-the symbols of the STEPFORMS bound to the initial or stepped values."
-  ;; check the syntax of the macro
-  (and (check-do-stepforms stepforms)
-       (check-do-endforms endforms))
-  ;; construct emacs-lisp equivalent
-  (let ((initlist (extract-do-inits stepforms))
-        (steplist (extract-do-steps stepforms))
-        (endcond  (car endforms))
-        (endbody  (cdr endforms)))
-    (cons 'let (cons initlist
-                     (cons (cons 'while (cons (list 'not endcond) 
-                                              (append body steplist)))
-                           (append endbody))))))
-
-
-(defmacro do* (stepforms endforms &rest body)
-  "`do*' is to `do' as `let*' is to `let'.
-STEPFORMS must be a list of symbols or lists.  In the second case, the
-lists must start with a symbol and contain up to two more forms. In
-the STEPFORMS, a symbol is the same as a (symbol).  The other 2 forms
-are the initial value (def. NIL) and the form to step (def. itself).
-Initializations and steppings are done in the sequence they are written.
-The ENDFORMS are a list (CONDITION . ENDBODY).  If the CONDITION
-evaluates to true in any iteration, ENDBODY is evaluated and the last
-form in it is returned.
-The BODY (which may be empty) is evaluated at every iteration, with
-the symbols of the STEPFORMS bound to the initial or stepped values."
-  ;; check the syntax of the macro
-  (and (check-do-stepforms stepforms)
-       (check-do-endforms endforms))
-  ;; construct emacs-lisp equivalent
-  (let ((initlist (extract-do-inits stepforms))
-        (steplist (extract-do*-steps stepforms))
-        (endcond  (car endforms))
-        (endbody  (cdr endforms)))
-    (cons 'let* (cons initlist
-                     (cons (cons 'while (cons (list 'not endcond) 
-                                              (append body steplist)))
-                           (append endbody))))))
-
-
-;;; DO and DO* share the syntax checking functions that follow.
-
-(defun check-do-stepforms (forms)
-  "True if FORMS is a valid stepforms for the do[*] macro (q.v.)"
-  (if (nlistp forms)
-      (error "init/step form for do[*] should be a list, not `%s'"
-             (prin1-to-string forms))
-    (mapcar
-     (function
-      (lambda (entry)
-        (if (not (or (symbolp entry)
-                     (and (listp entry)
-                          (symbolp (car entry))
-                          (< (length entry) 4))))
-            (error "init/step must be %s, not `%s'"
-                   "symbol or (symbol [init [step]])"
-                   (prin1-to-string entry)))))
-     forms)))
-
-(defun check-do-endforms (forms)
-  "True if FORMS is a valid endforms for the do[*] macro (q.v.)"
-  (if (nlistp forms)
-      (error "termination form for do macro should be a list, not `%s'"
-             (prin1-to-string forms))))
-
-(defun extract-do-inits (forms)
-  "Returns a list of the initializations (for do) in FORMS
---a stepforms, see the do macro--. FORMS is assumed syntactically valid."
-  (mapcar
-   (function
-    (lambda (entry)
-      (cond ((symbolp entry)
-             (list entry nil))
-            ((listp entry)
-             (list (car entry) (cadr entry))))))
-   forms))
-
-;;; There used to be a reason to deal with DO differently than with
-;;; DO*.  The writing of PSETQ has made it largely unnecessary.
-
-(defun extract-do-steps (forms)
-  "EXTRACT-DO-STEPS FORMS => an s-expr
-FORMS is the stepforms part of a DO macro (q.v.).  This function
-constructs an s-expression that does the stepping at the end of an
-iteration."
-  (list (cons 'psetq (select-stepping-forms forms))))
-
-(defun extract-do*-steps (forms)
-  "EXTRACT-DO*-STEPS FORMS => an s-expr
-FORMS is the stepforms part of a DO* macro (q.v.).  This function
-constructs an s-expression that does the stepping at the end of an
-iteration."
-  (list (cons 'setq (select-stepping-forms forms))))
-
-(defun select-stepping-forms (forms)
-  "Separate only the forms that cause stepping."
-  (let ((result '())			;ends up being (... var form ...)
-	(ptr forms)			;to traverse the forms
-	entry				;to explore each form in turn
-	)
-    (while ptr				;(not (endp entry)) might be safer
-      (setq entry (car ptr))
-      (cond ((and (listp entry) (= (length entry) 3))
-             (setq result (append       ;append in reverse order!
-                           (list (caddr entry) (car entry))
-                           result))))
-      (setq ptr (cdr ptr)))		;step in the list of forms
-    (nreverse result)))
-
-;;; Other iterative constructs
-
-(defmacro dolist  (stepform &rest body)
-  "(dolist (VAR LIST [RESULTFORM]) . BODY): do BODY for each elt of LIST.
-The RESULTFORM defaults to nil.  The VAR is bound to successive
-elements of the value of LIST and remains bound (to the nil value) when the
-RESULTFORM is evaluated."
-  ;; check sanity
-  (cond
-   ((nlistp stepform)
-    (error "stepform for `dolist' should be (VAR LIST [RESULT]), not `%s'"
-           (prin1-to-string stepform)))
-   ((not (symbolp (car stepform)))
-    (error "first component of stepform should be a symbol, not `%s'"
-           (prin1-to-string (car stepform))))
-   ((> (length stepform) 3)
-    (error "too many components in stepform `%s'"
-           (prin1-to-string stepform))))
-  ;; generate code
-  (let* ((var (car stepform))
-         (listform (cadr stepform))
-         (resultform (caddr stepform))
-	 (listsym (gentemp)))
-    (nconc
-     (list 'let (list var (list listsym listform))
-	   (nconc
-	    (list 'while listsym
-		  (list 'setq
-			var (list 'car listsym)
-			listsym (list 'cdr listsym)))
-	    body))
-     (and resultform
-	  (cons (list 'setq var nil)
-		(list resultform))))))
-
-(defmacro dotimes (stepform &rest body)
-  "(dotimes (VAR COUNTFORM [RESULTFORM]) .  BODY): Repeat BODY, counting in VAR.
-The COUNTFORM should return a positive integer.  The VAR is bound to
-successive integers from 0 to COUNTFORM-1 and the BODY is repeated for
-each of them.  At the end, the RESULTFORM is evaluated and its value
-returned. During this last evaluation, the VAR is still bound, and its
-value is the number of times the iteration occurred. An omitted RESULTFORM
-defaults to nil."
-  ;; check sanity 
-  (cond
-   ((nlistp stepform)
-    (error "stepform for `dotimes' should be (VAR COUNT [RESULT]), not `%s'"
-           (prin1-to-string stepform)))
-   ((not (symbolp (car stepform)))
-    (error "first component of stepform should be a symbol, not `%s'"
-           (prin1-to-string (car stepform))))
-   ((> (length stepform) 3)
-    (error "too many components in stepform `%s'"
-           (prin1-to-string stepform))))
-  ;; generate code
-  (let* ((var (car stepform))
-         (countform (cadr stepform))
-         (resultform (caddr stepform))
-         (testsym (if (consp countform) (gentemp) countform)))
-    (nconc
-    (list
-      'let (cons (list var -1)
-		(and (not (eq countform testsym))
-		     (list (list testsym countform))))
-      (nconc
-       (list 'while (list '< (list 'setq var (list '1+ var)) testsym))
-       body))
-     (and resultform (list resultform)))))
-
-(defmacro do-symbols (stepform &rest body)
-  "(do_symbols (VAR [OBARRAY [RESULTFORM]]) . BODY)
-The VAR is bound to each of the symbols in OBARRAY (def. obarray) and
-the BODY is repeatedly performed for each of those bindings. At the
-end, RESULTFORM (def. nil) is evaluated and its value returned.
-During this last evaluation, the VAR is still bound and its value is nil.
-See also the function `mapatoms'."
-  ;; check sanity
-  (cond
-   ((nlistp stepform)
-    (error "stepform for `do-symbols' should be (VAR OBARRAY [RESULT]), not `%s'"
-           (prin1-to-string stepform)))
-   ((not (symbolp (car stepform)))
-    (error "first component of stepform should be a symbol, not `%s'"
-           (prin1-to-string (car stepform))))
-   ((> (length stepform) 3)
-    (error "too many components in stepform `%s'"
-           (prin1-to-string stepform))))
-  ;; generate code
-  (let* ((var (car stepform))
-         (oblist (cadr stepform))
-         (resultform (caddr stepform)))
-    (list 'progn
-          (list 'mapatoms
-                (list 'function
-                      (cons 'lambda (cons (list var) body)))
-                oblist)
-          (list 'let
-                (list (list var nil))
-                resultform))))
-
-
-(defmacro do-all-symbols (stepform &rest body)
-  "(do-all-symbols (VAR [RESULTFORM]) . BODY)
-Is the same as (do-symbols (VAR obarray RESULTFORM) . BODY)."
-  (list*
-   'do-symbols
-   (list (car stepform) 'obarray (cadr stepform))
-   body))
-
-(defmacro loop (&rest body)
-  "(loop . BODY) repeats BODY indefinitely and does not return.
-Normally BODY uses `throw' or `signal' to cause an exit.
-The forms in BODY should be lists, as non-lists are reserved for new features."
-  ;; check that the body doesn't have atomic forms
-  (if (nlistp body)
-      (error "body of `loop' should be a list of lists or nil")
-    ;; ok, it is a list, check for atomic components
-    (mapcar
-     (function (lambda (component)
-                 (if (nlistp component)
-                     (error "components of `loop' should be lists"))))
-     body)
-    ;; build the infinite loop
-    (cons 'while (cons 't body))))
-
-;;;; end of cl-iterations.el
-
-;;;; LISTS
-;;;;    This file provides some of the lists machinery of Common-Lisp
-;;;;    in a way compatible with Emacs Lisp.  Especially, see the the
-;;;;    typical c[ad]*r functions.
-;;;;
-;;;;    Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;;       (quiroz@cs.rochester.edu)
-
-;;; Synonyms for list functions
-(defsubst first (x)
-  "Synonym for `car'"
-  (car x))
-
-(defsubst second (x)
-  "Return the second element of the list LIST."
-  (nth 1 x))
-
-(defsubst third (x)
-  "Return the third element of the list LIST."
-  (nth 2 x))
-
-(defsubst fourth (x)
-  "Return the fourth element of the list LIST."
-  (nth 3 x))
-
-(defsubst fifth (x)
-  "Return the fifth element of the list LIST."
-  (nth 4 x))
-
-(defsubst sixth (x)
-  "Return the sixth element of the list LIST."
-  (nth 5 x))
-
-(defsubst seventh (x)
-  "Return the seventh element of the list LIST."
-  (nth 6 x))
-
-(defsubst eighth (x)
-  "Return the eighth element of the list LIST."
-  (nth 7 x))
-
-(defsubst ninth (x)
-  "Return the ninth element of the list LIST."
-  (nth 8 x))
-
-(defsubst tenth (x)
-  "Return the tenth element of the list LIST."
-  (nth 9 x))
-
-(defsubst rest (x)
-  "Synonym for `cdr'"
-  (cdr x))
-
-(defsubst endp (x)
-  "t if X is nil, nil if X is a cons; error otherwise."
-  (if (listp x)
-      (null x)
-    (error "endp received a non-cons, non-null argument `%s'"
-	   (prin1-to-string x))))
-
-(defun last (x)
-  "Returns the last link in the list LIST."
-  (if (nlistp x)
-      (error "arg to `last' must be a list"))
-  (do ((current-cons    x       (cdr current-cons))
-       (next-cons    (cdr x)    (cdr next-cons)))
-      ((endp next-cons) current-cons)))
-
-(defun list-length (x)                  ;taken from CLtL sect. 15.2
-  "Returns the length of a non-circular list, or `nil' for a circular one."
-  (do ((n 0)                            ;counter
-       (fast x (cddr fast))             ;fast pointer, leaps by 2
-       (slow x (cdr slow))              ;slow pointer, leaps by 1
-       (ready nil))                     ;indicates termination
-      (ready n)
-    (cond ((endp fast)
-           (setq ready t))              ;return n
-          ((endp (cdr fast))
-           (setq n (+ n 1))
-           (setq ready t))              ;return n+1
-          ((and (eq fast slow) (> n 0))
-           (setq n nil)
-           (setq ready t))              ;return nil
-          (t
-           (setq n (+ n 2))))))         ;just advance counter
-
-(defun butlast (list &optional n)
-  "Return a new list like LIST but sans the last N elements.
-N defaults to 1.  If the list doesn't have N elements, nil is returned."
-  (if (null n) (setq n 1))
-  (nreverse (nthcdr n (reverse list)))) ;optim. due to macrakis@osf.org
-
-;;; This version due to Aaron Larson (alarson@src.honeywell.com, 26 Jul 91)
-(defun list* (arg &rest others)
-  "Return a new list containing the first arguments consed onto the last arg.
-Thus, (list* 1 2 3 '(a b)) returns (1 2 3 a b)."
-  (if (null others)
-      arg
-      (let* ((others (cons arg (copy-sequence others)))
-	     (a others))
-	(while (cdr (cdr a))
-	  (setq a (cdr a)))
-	(setcdr a (car (cdr a)))
-	others)))
-
-(defun adjoin (item list)
-  "Return a list which contains ITEM but is otherwise like LIST.
-If ITEM occurs in LIST, the value is LIST.  Otherwise it is (cons ITEM LIST).
-When comparing ITEM against elements, `eql' is used."
-  (if (memq item list)
-      list
-    (cons item list)))
-
-(defun ldiff (list sublist)
-  "Return a new list like LIST but sans SUBLIST.
-SUBLIST must be one of the links in LIST; otherwise the value is LIST itself."
-  (do ((result '())
-       (curcons list (cdr curcons)))
-      ((or (endp curcons) (eq curcons sublist))
-       (reverse result))
-    (setq result (cons (car curcons) result))))
-
-;;; The popular c[ad]*r functions and other list accessors.
-
-;;; To implement this efficiently, a new byte compile handler is used to
-;;; generate the minimal code, saving one function call.
-
-(defsubst caar (X)
-  "Return the car of the car of X."
-  (car (car X)))
-
-(defsubst cadr (X)
-  "Return the car of the cdr of X."
-  (car (cdr X)))
-
-(defsubst cdar (X)
-  "Return the cdr of the car of X."
-  (cdr (car X)))
-
-(defsubst cddr (X)
-  "Return the cdr of the cdr of X."
-  (cdr (cdr X)))
-
-(defsubst caaar (X)
-  "Return the car of the car of the car of X."
-  (car (car (car X))))
-
-(defsubst caadr (X)
-  "Return the car of the car of the cdr of X."
-  (car (car (cdr X))))
-
-(defsubst cadar (X)
-  "Return the car of the cdr of the car of X."
-  (car (cdr (car X))))
-
-(defsubst cdaar (X)
-  "Return the cdr of the car of the car of X."
-  (cdr (car (car X))))
-
-(defsubst caddr (X)
-  "Return the car of the cdr of the cdr of X."
-  (car (cdr (cdr X))))
-
-(defsubst cdadr (X)
-  "Return the cdr of the car of the cdr of X."
-  (cdr (car (cdr X))))
-
-(defsubst cddar (X)
-  "Return the cdr of the cdr of the car of X."
-  (cdr (cdr (car X))))
-
-(defsubst cdddr (X)
-  "Return the cdr of the cdr of the cdr of X."
-  (cdr (cdr (cdr X))))
-
-(defsubst caaaar (X)
-  "Return the car of the car of the car of the car of X."
-  (car (car (car (car X)))))
-
-(defsubst caaadr (X)
-  "Return the car of the car of the car of the cdr of X."
-  (car (car (car (cdr X)))))
-
-(defsubst caadar (X)
-  "Return the car of the car of the cdr of the car of X."
-  (car (car (cdr (car X)))))
-
-(defsubst cadaar (X)
-  "Return the car of the cdr of the car of the car of X."
-  (car (cdr (car (car X)))))
-
-(defsubst cdaaar (X)
-  "Return the cdr of the car of the car of the car of X."
-  (cdr (car (car (car X)))))
-
-(defsubst caaddr (X)
-  "Return the car of the car of the cdr of the cdr of X."
-  (car (car (cdr (cdr X)))))
-
-(defsubst cadadr (X)
-  "Return the car of the cdr of the car of the cdr of X."
-  (car (cdr (car (cdr X)))))
-
-(defsubst cdaadr (X)
-  "Return the cdr of the car of the car of the cdr of X."
-  (cdr (car (car (cdr X)))))
-
-(defsubst caddar (X)
-  "Return the car of the cdr of the cdr of the car of X."
-  (car (cdr (cdr (car X)))))
-
-(defsubst cdadar (X)
-  "Return the cdr of the car of the cdr of the car of X."
-  (cdr (car (cdr (car X)))))
-
-(defsubst cddaar (X)
-  "Return the cdr of the cdr of the car of the car of X."
-  (cdr (cdr (car (car X)))))
-
-(defsubst cadddr (X)
-  "Return the car of the cdr of the cdr of the cdr of X."
-  (car (cdr (cdr (cdr X)))))
-
-(defsubst cddadr (X)
-  "Return the cdr of the cdr of the car of the cdr of X."
-  (cdr (cdr (car (cdr X)))))
-
-(defsubst cdaddr (X)
-  "Return the cdr of the car of the cdr of the cdr of X."
-  (cdr (car (cdr (cdr X)))))
-
-(defsubst cdddar (X)
-  "Return the cdr of the cdr of the cdr of the car of X."
-  (cdr (cdr (cdr (car X)))))
-
-(defsubst cddddr (X)
-  "Return the cdr of the cdr of the cdr of the cdr of X."
-  (cdr (cdr (cdr (cdr X)))))
-
-;;; some inverses of the accessors are needed for setf purposes
-
-(defsubst setnth (n list newval)
-  "Set (nth N LIST) to NEWVAL.  Returns NEWVAL."
-  (rplaca (nthcdr n list) newval))
-
-(defun setnthcdr (n list newval)
-  "(setnthcdr N LIST NEWVAL) => NEWVAL
-As a side effect, sets the Nth cdr of LIST to NEWVAL."
-  (when (< n 0)
-    (error "N must be 0 or greater, not %d" n))
-  (while (> n 0)
-    (setq list (cdr list)
-          n    (- n 1)))
-  ;; here only if (zerop n)
-  (rplaca list (car newval))
-  (rplacd list (cdr newval))
-  newval)
-
-;;; A-lists machinery
-
-(defsubst acons (key item alist)
-  "Return a new alist with KEY paired with ITEM; otherwise like ALIST.
-Does not copy ALIST."
-  (cons (cons key item) alist))
-
-(defun pairlis (keys data &optional alist)
-  "Return a new alist with each elt of KEYS paired with an elt of DATA;
-optional 3rd arg ALIST is nconc'd at the end.  KEYS and DATA must
-have the same length."
-  (unless (= (length keys) (length data))
-    (error "keys and data should be the same length"))
-  (do* ;;collect keys and data in front of alist
-      ((kptr keys (cdr kptr))           ;traverses the keys
-       (dptr data (cdr dptr))           ;traverses the data
-       (key (car kptr) (car kptr))      ;current key
-       (item (car dptr) (car dptr))     ;current data item
-       (result alist))
-      ((endp kptr) result)
-    (setq result (acons key item result))))
-
-;;;; end of cl-lists.el
-
-;;;; SEQUENCES
-;;;; Emacs Lisp provides many of the 'sequences' functionality of
-;;;; Common Lisp.  This file provides a few things that were left out.
-;;;; 
-
-
-(defkeyword :test           "Used to designate positive (selection) tests.")
-(defkeyword :test-not       "Used to designate negative (rejection) tests.")
-(defkeyword :key            "Used to designate component extractions.")
-(defkeyword :predicate      "Used to define matching of sequence components.")
-(defkeyword :start          "Inclusive low index in sequence")
-(defkeyword :end            "Exclusive high index in sequence")
-(defkeyword :start1         "Inclusive low index in first of two sequences.")
-(defkeyword :start2         "Inclusive low index in second of two sequences.")
-(defkeyword :end1           "Exclusive high index in first of two sequences.")
-(defkeyword :end2           "Exclusive high index in second of two sequences.")
-(defkeyword :count          "Number of elements to affect.")
-(defkeyword :from-end       "T when counting backwards.")
-(defkeyword :initial-value  "For the syntax of #'reduce")
-
-(defun some     (pred seq &rest moreseqs)
-  "Test PREDICATE on each element of SEQUENCE; is it ever non-nil?
-Extra args are additional sequences; PREDICATE gets one arg from each
-sequence and we advance down all the sequences together in lock-step.
-A sequence means either a list or a vector."
-  (let ((args  (reassemble-argslists (list* seq moreseqs))))
-    (do* ((ready nil)                   ;flag: return when t
-          (result nil)                  ;resulting value
-          (applyval nil)                ;result of applying pred once
-          (remaining args
-                     (cdr remaining))   ;remaining argument sets
-          (current (car remaining)      ;current argument set
-                   (car remaining)))
-        ((or ready (endp remaining)) result)
-      (setq applyval (apply pred current))
-      (when applyval
-        (setq ready t)
-        (setq result applyval)))))
-
-(defun every    (pred seq &rest moreseqs)
-  "Test PREDICATE on each element of SEQUENCE; is it always non-nil?
-Extra args are additional sequences; PREDICATE gets one arg from each
-sequence and we advance down all the sequences together in lock-step.
-A sequence means either a list or a vector."
-  (let ((args  (reassemble-argslists (list* seq moreseqs))))
-    (do* ((ready nil)                   ;flag: return when t
-          (result t)                    ;resulting value
-          (applyval nil)                ;result of applying pred once
-          (remaining args
-                     (cdr remaining))   ;remaining argument sets
-          (current (car remaining)      ;current argument set
-                   (car remaining)))
-        ((or ready (endp remaining)) result)
-      (setq applyval (apply pred current))
-      (unless applyval
-        (setq ready t)
-        (setq result nil)))))
-
-(defun notany   (pred seq &rest moreseqs)
-  "Test PREDICATE on each element of SEQUENCE; is it always nil?
-Extra args are additional sequences; PREDICATE gets one arg from each
-sequence and we advance down all the sequences together in lock-step.
-A sequence means either a list or a vector."
-  (let ((args  (reassemble-argslists (list* seq moreseqs))))
-    (do* ((ready nil)                   ;flag: return when t
-          (result t)                    ;resulting value
-          (applyval nil)                ;result of applying pred once
-          (remaining args
-                     (cdr remaining))   ;remaining argument sets
-          (current (car remaining)      ;current argument set
-                   (car remaining)))
-        ((or ready (endp remaining)) result)
-      (setq applyval (apply pred current))
-      (when applyval
-        (setq ready t)
-        (setq result nil)))))
-
-(defun notevery (pred seq &rest moreseqs)
-  "Test PREDICATE on each element of SEQUENCE; is it sometimes nil?
-Extra args are additional sequences; PREDICATE gets one arg from each
-sequence and we advance down all the sequences together in lock-step.
-A sequence means either a list or a vector."
-  (let ((args  (reassemble-argslists (list* seq moreseqs))))
-    (do* ((ready nil)                   ;flag: return when t
-          (result nil)                  ;resulting value
-          (applyval nil)                ;result of applying pred once
-          (remaining args
-                     (cdr remaining))   ;remaining argument sets
-          (current (car remaining)      ;current argument set
-                   (car remaining)))
-        ((or ready (endp remaining)) result)
-      (setq applyval (apply pred current))
-      (unless applyval
-        (setq ready t)
-        (setq result t)))))
-
-;;; More sequence functions that don't need keyword arguments
-
-(defun concatenate (type &rest sequences)
-  "(concatenate TYPE &rest SEQUENCES) => a sequence
-The sequence returned is of type TYPE (must be 'list, 'string, or 'vector) and
-contains the concatenation of the elements of all the arguments, in the order
-given."
-  (let ((sequences (append sequences '(()))))
-    (case type
-      (list
-       (apply (function append) sequences))
-      (string
-       (apply (function concat) sequences))
-      (vector
-       (apply (function vector) (apply (function append) sequences)))
-      (t
-       (error "type for concatenate `%s' not 'list, 'string or 'vector"
-              (prin1-to-string type))))))
-
-(defun map (type function &rest sequences)
-  "(map TYPE FUNCTION &rest SEQUENCES) => a sequence
-The FUNCTION is called on each set of elements from the SEQUENCES \(stopping
-when the shortest sequence is terminated\) and the results are possibly
-returned in a sequence of type TYPE \(one of 'list, 'vector, 'string, or nil\)
-giving NIL for TYPE gets rid of the values."
-  (if (not (memq type (list 'list 'string 'vector nil)))
-      (error "type for map `%s' not 'list, 'string, 'vector or nil"
-             (prin1-to-string type)))
-  (let ((argslists (reassemble-argslists sequences))
-        results)
-    (if (null type)
-        (while argslists                ;don't bother accumulating
-          (apply function (car argslists))
-          (setq argslists (cdr argslists)))
-      (setq results (mapcar (function (lambda (args) (apply function args)))
-                            argslists))
-      (case type
-        (list
-         results)
-        (string
-         (funcall (function concat) results))
-        (vector
-         (apply (function vector) results))))))
-
-;;; an inverse of elt is needed for setf purposes
-
-(defun setelt (seq n newval)
-  "In SEQUENCE, set the Nth element to NEWVAL.  Returns NEWVAL.
-A sequence means either a list or a vector."
-  (let ((l (length seq)))
-    (if (or (< n 0) (>= n l))
-        (error "N(%d) should be between 0 and %d" n l)
-      ;; only two cases need be considered valid, as strings are arrays
-      (cond ((listp seq)
-             (setnth n seq newval))
-            ((arrayp seq)
-             (aset seq n newval))
-            (t
-             (error "SEQ should be a sequence, not `%s'"
-                    (prin1-to-string seq)))))))
-
-;;; Testing with keyword arguments.
-;;;
-;;; Many of the sequence functions use keywords to denote some stylized
-;;; form of selecting entries in a sequence.  The involved arguments
-;;; are collected with a &rest marker (as Emacs Lisp doesn't have a &key
-;;; marker), then they are passed to build-klist, who
-;;; constructs an association list.  That association list is used to
-;;; test for satisfaction and matching.
-
-;;; DON'T USE MEMBER, NOR ANY FUNCTION THAT COULD TAKE KEYWORDS HERE!!!
-
-(defun build-klist (argslist acceptable &optional allow-other-keys)
-  "Decode a keyword argument list ARGSLIST for keywords in ACCEPTABLE.
-ARGSLIST is a list, presumably the &rest argument of a call, whose
-even numbered elements must be keywords.
-ACCEPTABLE is a list of keywords, the only ones that are truly acceptable.
-The result is an alist containing the arguments named by the keywords
-in ACCEPTABLE, or an error is signalled, if something failed.
-If the third argument (an optional) is non-nil, other keys are acceptable."
-  ;; check legality of the arguments, then destructure them
-  (unless (and (listp argslist)
-               (evenp (length argslist)))
-    (error "build-klist: odd number of keyword-args"))
-  (unless (and (listp acceptable)
-               (every 'keywordp acceptable))
-    (error "build-klist: second arg should be a list of keywords"))
-  (multiple-value-bind
-      (keywords forms)
-      (unzip-list argslist)
-    (unless (every 'keywordp keywords)
-      (error "build-klist: expected keywords, found `%s'"
-             (prin1-to-string keywords)))
-    (unless (or allow-other-keys
-                (every (function (lambda (keyword)
-                                   (memq keyword acceptable)))
-                       keywords))
-      (error "bad keyword[s]: %s not in %s"
-             (prin1-to-string (mapcan (function (lambda (keyword)
-                                                  (if (memq keyword acceptable)
-                                                      nil
-                                                    (list keyword))))
-                                      keywords))
-             (prin1-to-string acceptable)))
-    (do* ;;pick up the pieces
-        ((auxlist                       ;auxiliary a-list, may
-          (pairlis keywords forms))     ;contain repetitions and junk
-         (ptr    acceptable  (cdr ptr)) ;pointer in acceptable
-         (this  (car ptr)  (car ptr))   ;current acceptable keyword
-         (auxval nil)                   ;used to move values around
-         (alist  '()))                  ;used to build the result
-        ((endp ptr) alist)
-      ;; if THIS appears in auxlist, use its value
-      (when (setq auxval (assq this auxlist))
-        (setq alist (cons auxval alist))))))
-
-
-(defun extract-from-klist (klist key &optional default)
-  "(extract-from-klist KLIST KEY [DEFAULT]) => value of KEY or DEFAULT
-Extract value associated with KEY in KLIST (return DEFAULT if nil)."
-  (let ((retrieved (cdr (assq key klist))))
-    (or retrieved default)))
-
-(defun keyword-argument-supplied-p (klist key)
-  "(keyword-argument-supplied-p KLIST KEY) => nil or something
-NIL if KEY (a keyword) does not appear in the KLIST."
-  (assq key klist))
-
-(defun add-to-klist (key item klist)
-  "(ADD-TO-KLIST KEY ITEM KLIST) => new KLIST
-Add association (KEY . ITEM) to KLIST."
-  (setq klist (acons key item klist)))
-
-(defun elt-satisfies-test-p (item elt klist)
-  "(elt-satisfies-test-p ITEM ELT KLIST) => t or nil
-KLIST encodes a keyword-arguments test, as in CH. 14 of CLtL.
-True if the given ITEM and ELT satisfy the test."
-  (let ((test     (extract-from-klist klist :test))
-        (test-not (extract-from-klist klist :test-not))
-        (keyfn    (extract-from-klist klist :key 'identity)))
-    (cond (test
-           (funcall test item (funcall keyfn elt)))
-          (test-not
-           (not (funcall test-not item (funcall keyfn elt))))
-          (t                            ;should never happen
-           (error "neither :test nor :test-not in `%s'"
-                  (prin1-to-string klist))))))
-
-(defun elt-satisfies-if-p   (item klist)
-  "(elt-satisfies-if-p ITEM KLIST) => t or nil
-True if an -if style function was called and ITEM satisfies the
-predicate under :predicate in KLIST."
-  (let ((predicate (extract-from-klist klist :predicate))
-        (keyfn     (extract-from-klist klist :key 'identity)))
-    (funcall predicate (funcall keyfn item))))
-
-(defun elt-satisfies-if-not-p (item klist)
-  "(elt-satisfies-if-not-p ITEM KLIST) => t or nil
-KLIST encodes a keyword-arguments test, as in CH. 14 of CLtL.
-True if an -if-not style function was called and ITEM does not satisfy
-the predicate under :predicate in KLIST."
-  (let ((predicate (extract-from-klist klist :predicate))
-        (keyfn     (extract-from-klist klist :key 'identity)))
-    (not (funcall predicate (funcall keyfn item)))))
-
-(defun elts-match-under-klist-p (e1 e2 klist)
-  "(elts-match-under-klist-p E1 E2 KLIST) => t or nil
-KLIST encodes a keyword-arguments test, as in CH. 14 of CLtL.
-True if elements E1 and E2 match under the tests encoded in KLIST."
-  (let ((test     (extract-from-klist klist :test))
-        (test-not (extract-from-klist klist :test-not))
-        (keyfn    (extract-from-klist klist :key 'identity)))
-    (if (and test test-not)
-        (error "both :test and :test-not in `%s'"
-               (prin1-to-string klist)))
-    (cond (test
-           (funcall test (funcall keyfn e1) (funcall keyfn e2)))
-          (test-not
-           (not (funcall test-not (funcall keyfn e1) (funcall keyfn e2))))
-          (t                            ;should never happen
-           (error "neither :test nor :test-not in `%s'"
-                  (prin1-to-string klist))))))
-
-;;; This macro simplifies using keyword args.  It is less clumsy than using
-;;; the primitives build-klist, etc...  For instance, member could be written
-;;; this way:
-
-;;; (defun member (item list &rest kargs)
-;;;  (with-keyword-args kargs (test test-not (key 'identity))
-;;;    ...))
-
-;;; Suggested by Robert Potter (potter@cs.rochester.edu, 15 Nov 1989)
-
-(defmacro with-keyword-args (keyargslist vardefs &rest body)
-  "(WITH-KEYWORD-ARGS KEYARGSLIST VARDEFS . BODY)
-KEYARGSLIST can be either a symbol or a list of one or two symbols.  
-In the second case, the second symbol is either T or NIL, indicating whether
-keywords other than the mentioned ones are tolerable.
-
-VARDEFS is a list.  Each entry is either a VAR (symbol) or matches
-\(VAR [DEFAULT [KEYWORD]]).  Just giving VAR is the same as giving
-\(VAR nil :VAR).
-
-The BODY is executed in an environment where each VAR (a symbol) is bound to
-the value present in the KEYARGSLIST provided, or to the DEFAULT.  The value
-is searched by using the keyword form of VAR (i.e., :VAR) or the optional
-keyword if provided.
-
-Notice that this macro doesn't distinguish between a default value given
-explicitly by the user and one provided by default.  See also the more
-primitive functions build-klist, add-to-klist, extract-from-klist,
-keyword-argument-supplied-p, elt-satisfies-test-p, elt-satisfies-if-p,
-elt-satisfies-if-not-p, elts-match-under-klist-p.  They provide more complete,
-if clumsier, control over this feature."
-  (let (allow-other-keys)
-    (if (listp keyargslist)
-        (if (> (length keyargslist) 2)
-            (error
-             "`%s' should be SYMBOL, (SYMBOL), or (SYMBOL t-OR-nil)"
-             (prin1-to-string keyargslist))
-          (setq allow-other-keys (cadr keyargslist)
-                keyargslist      (car keyargslist))
-          (if (not (and
-                    (symbolp keyargslist)
-                    (memq allow-other-keys '(t nil))))
-              (error
-               "first subform should be SYMBOL, (SYMBOL), or (SYMBOL t-OR-nil)"
-               )))
-      (if (symbolp keyargslist)
-          (setq allow-other-keys nil)
-        (error
-         "first subform should be SYMBOL, (SYMBOL), or (SYMBOL t-OR-nil)")))
-    (let (vars defaults keywords forms
-          (klistname (gensym "KLIST_")))
-      (mapcar (function (lambda (entry)
-                          (if (symbolp entry) ;defaulty case
-                              (setq entry (list entry nil (keyword-of entry))))
-                          (let* ((l (length entry))
-                                 (v (car entry))
-                                 (d (cadr entry))
-                                 (k (caddr entry)))
-                            (if (or (< l 1) (> l 3))
-                                (error
-                                 "`%s' must match (VAR [DEFAULT [KEYWORD]])"
-                                 (prin1-to-string entry)))
-                            (if (or (null v) (not (symbolp v)))
-                                (error
-                                 "bad variable `%s': must be non-null symbol"
-                                 (prin1-to-string v)))
-                            (setq vars (cons v vars))
-                            (setq defaults (cons d defaults))
-                            (if (< l 3)
-                                (setq k (keyword-of v)))
-                            (if (and (= l 3)
-                                     (or (null k)
-                                         (not (keywordp k))))
-                                (error
-                                 "bad keyword `%s'" (prin1-to-string k)))
-                            (setq keywords (cons k keywords))
-                            (setq forms (cons (list v (list 'extract-from-klist
-                                                            klistname
-                                                            k
-                                                            d))
-                                              forms)))))
-              vardefs)
-      (append
-       (list 'let* (nconc (list (list klistname
-                                      (list 'build-klist keyargslist
-                                            (list 'quote keywords)
-                                            allow-other-keys)))
-                          (nreverse forms)))
-       body))))
-(put 'with-keyword-args 'lisp-indent-hook 1)
-
-
-;;; REDUCE
-;;; It is here mostly as an example of how to use KLISTs.
-;;;
-;;; First of all, you need to declare the keywords (done elsewhere in this
-;;; file):
-;;;         (defkeyword :from-end "syntax of sequence functions")
-;;;         (defkeyword :start "syntax of sequence functions")
-;;; etc...
-;;;
-;;; Then, you capture all the possible keyword arguments with a &rest
-;;; argument.  You can pass that list downward again, of course, but
-;;; internally you need to parse it into a KLIST (an alist, really).  One uses
-;;; (build-klist REST-ARGS ACCEPTABLE-KEYWORDS [ALLOW-OTHER]).  You can then
-;;; test for presence by using (keyword-argument-supplied-p KLIST KEY) and
-;;; extract a value with (extract-from-klist KLIST KEY [DEFAULT]).
-
-(defun reduce (function sequence &rest kargs)
-  "Apply FUNCTION (a function of two arguments) to successive pairs of elements
-from SEQUENCE.  Some keyword arguments are valid after FUNCTION and SEQUENCE:
-:from-end       If non-nil, process the values backwards
-:initial-value  If given, prefix it to the SEQUENCE.  Suffix, if :from-end
-:start          Restrict reduction to the subsequence from this index
-:end            Restrict reduction to the subsequence BEFORE this index.
-If the sequence is empty and no :initial-value is given, the FUNCTION is
-called on zero (not two) arguments.  Otherwise, if there is exactly one
-element in the combination of SEQUENCE and the initial value, that element is
-returned."
-  (let* ((klist (build-klist kargs '(:from-end :start :end :initial-value)))
-         (length (length sequence))
-         (from-end (extract-from-klist klist :from-end))
-         (initial-value-given (keyword-argument-supplied-p
-                               klist :initial-value))
-         (start (extract-from-klist kargs :start 0))
-         (end   (extract-from-klist kargs :end length)))
-    (setq sequence (cl$subseq-as-list sequence start end))
-    (if from-end
-        (setq sequence (reverse sequence)))
-    (if initial-value-given
-        (setq sequence (cons (extract-from-klist klist :initial-value)
-                             sequence)))
-    (if (null sequence)
-        (funcall function)              ;only use of 0 arguments
-      (let* ((result (car sequence))
-             (sequence (cdr sequence)))
-        (while sequence
-          (setq result   (if from-end
-                             (funcall function (car sequence) result)
-                           (funcall function result (car sequence)))
-                sequence (cdr sequence)))
-        result))))
-
-(defun cl$subseq-as-list (sequence start end)
-  "(cl$subseq-as-list SEQUENCE START END) => a list"
-  (let ((list (append sequence nil))
-        (length (length sequence))
-        result)
-    (if (< start 0)
-        (error "start should be >= 0, not %d" start))
-    (if (> end length)
-        (error "end should be <= %d, not %d" length end))
-    (if (and (zerop start) (= end length))
-        list
-      (let ((i start)
-            (vector (apply 'vector list)))
-        (while (/= i end)
-          (setq result (cons (elt vector i) result))
-          (setq i      (+ i 1)))
-        (nreverse result)))))
-
-;;;; end of cl-sequences.el
-
-;;;; Some functions with keyword arguments
-;;;;
-;;;; Both list and sequence functions are considered here together.  This
-;;;; doesn't fit any more with the original split of functions in files.
-
-(defun cl-member (item list &rest kargs)
-  "Look for ITEM in LIST; return first tail of LIST the car of whose first
-cons cell tests the same as ITEM.  Admits arguments :key, :test, and
-:test-not."
-  (if (null kargs)                      ;treat this fast for efficiency
-      (memq item list)
-    (let* ((klist     (build-klist kargs '(:test :test-not :key)))
-           (test      (extract-from-klist klist :test))
-           (testnot   (extract-from-klist klist :test-not))
-           (key       (extract-from-klist klist :key 'identity)))
-      ;; another workaround allegedly for speed, BLAH
-      (if (and (or (eq test 'eq) (eq test 'eql)
-                   (eq test (symbol-function 'eq))
-                   (eq test (symbol-function 'eql)))
-               (null testnot)
-               (or (eq key 'identity)   ;either by default or so given
-                   (eq key (function identity)) ;could this happen?
-                   (eq key (symbol-function 'identity)) ;sheer paranoia
-                   ))
-          (memq item list)
-        (if (and test testnot)
-            (error ":test and :test-not both specified for member"))
-        (if (not (or test testnot))
-            (setq test 'eql))
-        ;; final hack: remove the indirection through the function names
-        (if testnot
-            (if (symbolp testnot)
-                (setq testnot (symbol-function testnot)))
-          (if (symbolp test)
-              (setq test (symbol-function test))))
-        (if (symbolp key)
-            (setq key (symbol-function key)))
-        ;; ok, go for it
-        (let ((ptr list)
-              (done nil)
-              (result '()))
-          (if testnot
-              (while (not (or done (endp ptr)))
-                (cond ((not (funcall testnot item (funcall key (car ptr))))
-                       (setq done t)
-                       (setq result ptr)))
-                (setq ptr (cdr ptr)))
-            (while (not (or done (endp ptr)))
-                (cond ((funcall test item (funcall key (car ptr)))
-                       (setq done t)
-                       (setq result ptr)))
-                (setq ptr (cdr ptr))))
-          result)))))
-
-;;;; MULTIPLE VALUES
-;;;;    This package approximates the behavior of the multiple-values
-;;;;    forms of Common Lisp.  
-;;;;
-;;;;    Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;;       (quiroz@cs.rochester.edu)
-
-;;; Lisp indentation information
-(put 'multiple-value-bind  'lisp-indent-hook 2)
-(put 'multiple-value-setq  'lisp-indent-hook 2)
-(put 'multiple-value-list  'lisp-indent-hook nil)
-(put 'multiple-value-call  'lisp-indent-hook 1)
-(put 'multiple-value-prog1 'lisp-indent-hook 1)
-
-;;; Global state of the package is kept here
-(defvar *mvalues-values* nil
-  "Most recently returned multiple-values")
-(defvar *mvalues-count*  nil
-  "Count of multiple-values returned, or nil if the mechanism was not used")
-
-;;; values is the standard multiple-value-return form.  Must be the
-;;; last thing evaluated inside a function.  If the caller is not
-;;; expecting multiple values, only the first one is passed.  (values)
-;;; is the same as no-values returned (unaware callers see nil). The
-;;; alternative (values-list <list>) is just a convenient shorthand
-;;; and complements multiple-value-list.
-
-(defun values (&rest val-forms)
-  "Produce multiple values (zero or more).  Each arg is one value.
-See also `multiple-value-bind', which is one way to examine the
-multiple values produced by a form.  If the containing form or caller
-does not check specially to see multiple values, it will see only
-the first value."
-  (setq *mvalues-values* val-forms)
-  (setq *mvalues-count*  (length *mvalues-values*))
-  (car *mvalues-values*))
-
-(defun values-list (&optional val-forms)
-  "Produce multiple values (zero or more).  Each element of LIST is one value.
-This is equivalent to (apply 'values LIST)."
-  (cond ((nlistp val-forms)
-         (error "Argument to values-list must be a list, not `%s'"
-                (prin1-to-string val-forms))))
-  (setq *mvalues-values* val-forms)
-  (setq *mvalues-count* (length *mvalues-values*))
-  (car *mvalues-values*))
-
-;;; Callers that want to see the multiple values use these macros.
-
-(defmacro multiple-value-list (form)
-  "Execute FORM and return a list of all the (multiple) values FORM produces.
-See `values' and `multiple-value-bind'."
-  (list 'progn
-        (list 'setq '*mvalues-count* nil)
-        (list 'let (list (list 'it '(gensym)))
-              (list 'set 'it form)
-              (list 'if '*mvalues-count*
-                    (list 'copy-sequence '*mvalues-values*)
-                    (list 'progn
-                          (list 'setq '*mvalues-count* 1)
-                          (list 'setq '*mvalues-values*
-                                (list 'list (list 'symbol-value 'it)))
-                          (list 'copy-sequence '*mvalues-values*))))))
-
-(defmacro multiple-value-call (function &rest args)
-  "Call FUNCTION on all the values produced by the remaining arguments.
-(multiple-value-call '+ (values 1 2) (values 3 4)) is 10."
-  (let* ((result (gentemp))
-         (arg    (gentemp)))
-    (list 'apply (list 'function (eval function))
-          (list 'let* (list (list result '()))
-                (list 'dolist (list arg (list 'quote args) result)
-                      (list 'setq result
-                            (list 'append
-                                  result
-                                  (list 'multiple-value-list
-                                        (list 'eval arg)))))))))
-
-(defmacro multiple-value-bind (vars form &rest body)
-  "Bind VARS to the (multiple) values produced by FORM, then do BODY.
-VARS is a list of variables; each is bound to one of FORM's values.
-If FORM doesn't make enough values, the extra variables are bound to nil.
-(Ordinary forms produce only one value; to produce more, use `values'.)
-Extra values are ignored.
-BODY (zero or more forms) is executed with the variables bound,
-then the bindings are unwound."
-  (let* ((vals   (gentemp))             ;name for intermediate values
-         (clauses (mv-bind-clausify     ;convert into clauses usable
-                   vars vals)))         ; in a let form
-    (list* 'let*
-           (cons (list vals (list 'multiple-value-list form))
-                 clauses)
-           body)))
-
-(defmacro multiple-value-setq (vars form)
-  "Set VARS to the (multiple) values produced by FORM.
-VARS is a list of variables; each is set to one of FORM's values.
-If FORM doesn't make enough values, the extra variables are set to nil.
-(Ordinary forms produce only one value; to produce more, use `values'.)
-Extra values are ignored."
-  (let* ((vals (gentemp))               ;name for intermediate values
-         (clauses (mv-bind-clausify     ;convert into clauses usable
-                   vars vals)))         ; in a setq (after append).
-    (list 'let*
-          (list (list vals (list 'multiple-value-list form)))
-          (cons 'setq (apply (function append) clauses)))))
-
-(defmacro multiple-value-prog1 (form &rest body)
-  "Evaluate FORM, then BODY, then produce the same values FORM produced.
-Thus, (multiple-value-prog1 (values 1 2) (foobar)) produces values 1 and 2.
-This is like `prog1' except that `prog1' would produce only one value,
-which would be the first of FORM's values."
-  (let* ((heldvalues (gentemp)))
-    (cons 'let*
-          (cons (list (list heldvalues (list 'multiple-value-list form)))
-                (append body (list (list 'values-list heldvalues)))))))
-
-;;; utility functions
-;;;
-;;; mv-bind-clausify makes the pairs needed to have the variables in
-;;; the variable list correspond with the values returned by the form.
-;;; vals is a fresh symbol that intervenes in all the bindings.
-
-(defun mv-bind-clausify (vars vals)
-  "MV-BIND-CLAUSIFY VARS VALS => Auxiliary list
-Forms a list of pairs `(,(nth i vars) (nth i vals)) for i from 0 to
-the length of VARS (a list of symbols).  VALS is just a fresh symbol."
-  (if (or (nlistp vars)
-          (notevery 'symbolp vars))
-      (error "expected a list of symbols, not `%s'"
-             (prin1-to-string vars)))
-  (let* ((nvars    (length vars))
-         (clauses '()))
-    (dotimes (n nvars clauses)
-      (setq clauses (cons (list (nth n vars)
-                                (list 'nth n vals)) clauses)))))
-
-;;;; end of cl-multiple-values.el
-
-;;;; ARITH
-;;;;    This file provides integer arithmetic extensions.  Although
-;;;;    Emacs Lisp doesn't really support anything but integers, that
-;;;;    has still to be made to look more or less standard.
-;;;;
-;;;;
-;;;;    Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;;       (quiroz@cs.rochester.edu)
-
-
-(defsubst plusp (number)
-  "True if NUMBER is strictly greater than zero."
-  (> number 0))
-
-(defsubst minusp (number)
-  "True if NUMBER is strictly less than zero."
-  (< number 0))
-
-(defsubst oddp (number)
-  "True if INTEGER is not divisible by 2."
-  (/= (% number 2) 0))
-
-(defsubst evenp (number)
-  "True if INTEGER is divisible by 2."
-  (= (% number 2) 0))
-
-(defsubst abs (number)
-  "Return the absolute value of NUMBER."
-  (if (< number 0)
-      (- number)
-    number))
-
-(defsubst signum (number)
-  "Return -1, 0 or 1 according to the sign of NUMBER."
-  (cond ((< number 0)
-         -1)
-        ((> number 0)
-         1)
-        (t                              ;exactly zero
-         0)))
-
-(defun gcd (&rest integers)
-  "Return the greatest common divisor of all the arguments.
-The arguments must be integers.  With no arguments, value is zero."
-  (let ((howmany (length integers)))
-    (cond ((= howmany 0)
-           0)
-          ((= howmany 1)
-           (abs (car integers)))
-          ((> howmany 2)
-           (apply (function gcd)
-                  (cons (gcd (nth 0 integers) (nth 1 integers))
-                        (nthcdr 2 integers))))
-          (t                            ;howmany=2
-           ;; essentially the euclidean algorithm
-           (when (zerop (* (nth 0 integers) (nth 1 integers)))
-             (error "a zero argument is invalid for `gcd'"))
-           (do* ((absa (abs (nth 0 integers))) ; better to operate only
-                 (absb (abs (nth 1 integers))) ;on positives.
-                 (dd (max absa absb))   ; setup correct order for the
-                 (ds (min absa absb))   ;successive divisions.
-                 ;; intermediate results
-                 (q 0)
-                 (r 0)
-                 ;; final results
-                 (done nil)             ; flag: end of iterations
-                 (result 0))            ; final value
-               (done result)
-             (setq q (/ dd ds))
-             (setq r (% dd ds))
-             (cond ((zerop r) (setq done t) (setq result ds))
-                   (t         (setq dd ds)  (setq ds r))))))))
-
-(defun lcm (integer &rest more)
-  "Return the least common multiple of all the arguments.
-The arguments must be integers and there must be at least one of them."
-  (let ((howmany (length more))
-        (a       integer)
-        (b       (nth 0 more))
-        prod                            ; intermediate product
-        (yetmore (nthcdr 1 more)))
-    (cond ((zerop howmany)
-           (abs a))
-          ((> howmany 1)                ; recursive case
-           (apply (function lcm)
-                  (cons (lcm a b) yetmore)))
-          (t                            ; base case, just 2 args
-           (setq prod (* a b))
-           (cond
-            ((zerop prod)
-             0)
-            (t
-             (/ (abs prod) (gcd a b))))))))
-
-(defun isqrt (number)
-  "Return the integer square root of NUMBER.
-NUMBER must not be negative.  Result is largest integer less than or
-equal to the real square root of the argument."
-  ;; The method used here is essentially the Newtonian iteration
-  ;;    x[n+1] <- (x[n] + Number/x[n]) / 2
-  ;; suitably adapted to integer arithmetic.
-  ;; Thanks to Philippe Schnoebelen <phs@lifia.imag.fr> for suggesting the
-  ;; termination condition.
-  (cond ((minusp number)
-         (error "argument to `isqrt' (%d) must not be negative"
-                number))
-        ((zerop number)
-         0)
-        (t                              ;so (>= number 0)
-         (do* ((approx 1)               ;any positive integer will do
-               (new 0)                  ;init value irrelevant
-               (done nil))
-             (done (if (> (* approx approx) number)
-                       (- approx 1)
-                     approx))
-           (setq new    (/ (+ approx (/ number approx)) 2)
-                 done   (or (= new approx) (= new (+ approx 1)))
-                 approx new)))))
-
-(defun cl-floor (number &optional divisor)
-  "Divide DIVIDEND by DIVISOR, rounding toward minus infinity.
-DIVISOR defaults to 1.  The remainder is produced as a second value."
-  (cond ((and (null divisor)            ; trivial case
-              (numberp number))
-         (values number 0))
-        (t                              ; do the division
-         (multiple-value-bind
-             (q r s)
-             (safe-idiv number divisor)
-           (cond ((zerop s)
-                  (values 0 0))
-                 ((plusp s)
-                  (values q r))
-                 (t                     ;opposite-signs case
-                  (if (zerop r)
-                      (values (- q) 0)
-                    (let ((q (- (+ q 1))))
-                      (values q (- number (* q divisor)))))))))))
-
-(defun cl-ceiling (number &optional divisor)
-  "Divide DIVIDEND by DIVISOR, rounding toward plus infinity.
-DIVISOR defaults to 1.  The remainder is produced as a second value."
-  (cond ((and (null divisor)            ; trivial case
-              (numberp number))
-         (values number 0))
-        (t                              ; do the division
-         (multiple-value-bind
-             (q r s)
-             (safe-idiv number divisor)
-           (cond ((zerop s)
-                  (values 0 0))
-                 ((plusp s)
-                  (values (+ q 1) (- r divisor)))
-                 (t
-                  (values (- q) (+ number (* q divisor)))))))))
-
-(defun cl-truncate (number &optional divisor)
-  "Divide DIVIDEND by DIVISOR, rounding toward zero.
-DIVISOR defaults to 1.  The remainder is produced as a second value."
-  (cond ((and (null divisor)            ; trivial case
-              (numberp number))
-         (values number 0))
-        (t                              ; do the division
-         (multiple-value-bind
-             (q r s)
-             (safe-idiv number divisor)
-           (cond ((zerop s)
-                  (values 0 0))
-                 ((plusp s)             ;same as floor
-                  (values q r))
-                 (t                     ;same as ceiling
-                  (values (- q) (+ number (* q divisor)))))))))
-
-(defun cl-round (number &optional divisor)
-  "Divide DIVIDEND by DIVISOR, rounding to nearest integer.
-DIVISOR defaults to 1.  The remainder is produced as a second value."
-  (cond ((and (null divisor)            ; trivial case
-              (numberp number))
-         (values number 0))    
-        (t                              ; do the division
-         (multiple-value-bind
-             (q r s)
-             (safe-idiv number divisor)
-           (setq r (abs r))
-           ;; adjust magnitudes first, and then signs
-           (let ((other-r (- (abs divisor) r)))
-             (cond ((> r other-r)
-                    (setq q (+ q 1)))
-                   ((and (= r other-r)
-                         (oddp q))
-                    ;; round to even is mandatory
-                    (setq q (+ q 1))))
-             (setq q (* s q))
-             (setq r (- number (* q divisor)))
-             (values q r))))))
-
-;;; These two functions access the implementation-dependent representation of
-;;; the multiple value returns.
-
-(defun cl-mod (number divisor)
-  "Return remainder of X by Y (rounding quotient toward minus infinity).
-That is, the remainder goes with the quotient produced by `cl-floor'.
-Emacs Lisp hint:
-If you know that both arguments are positive, use `%' instead for speed."
-  (cl-floor number divisor)
-  (cadr *mvalues-values*))
-
-(defun rem (number divisor)
-  "Return remainder of X by Y (rounding quotient toward zero).
-That is, the remainder goes with the quotient produced by `cl-truncate'.
-Emacs Lisp hint:
-If you know that both arguments are positive, use `%' instead for speed."
-  (cl-truncate number divisor)
-  (cadr *mvalues-values*))
-
-;;; internal utilities
-;;;
-;;; safe-idiv performs an integer division with positive numbers only.
-;;; It is known that some machines/compilers implement weird remainder
-;;; computations when working with negatives, so the idea here is to
-;;; make sure we know what is coming back to the caller in all cases.
-
-;;; Signum computation fixed by mad@math.keio.JUNET (MAEDA Atusi)
-
-(defun safe-idiv (a b)
-  "SAFE-IDIV A B => Q R S
-Q=|A|/|B|, S is the sign of A/B, R is the rest A - S*Q*B."
-  ;; (unless (and (numberp a) (numberp b))
-  ;;   (error "arguments to `safe-idiv' must be numbers"))
-  ;; (when (zerop b)
-  ;;   (error "cannot divide %d by zero" a))
-  (let* ((q (/ (abs a) (abs b)))
-         (s (* (signum a) (signum b)))
-         (r (- a (* s q b))))
-    (values q r s)))
-
-;;;; end of cl-arith.el
-
-;;;; SETF
-;;;;    This file provides the setf macro and friends. The purpose has
-;;;;    been modest, only the simplest defsetf forms are accepted.
-;;;;    Use it and enjoy.
-;;;;
-;;;;    Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;;       (quiroz@cs.rochester.edu)
-
-
-(defkeyword :setf-update-fn
-  "Property, its value is the function setf must invoke to update a
-generalized variable whose access form is a function call of the
-symbol that has this property.")
-
-(defkeyword :setf-update-doc
-  "Property of symbols that have a `defsetf' update function on them,
-installed by the `defsetf' from its optional third argument.")
-
-(defmacro setf (&rest pairs)
-  "Generalized `setq' that can set things other than variable values.
-A use of `setf' looks like (setf {PLACE VALUE}...).
-The behavior of (setf PLACE VALUE) is to access the generalized variable
-at PLACE and store VALUE there.  It returns VALUE.  If there is more
-than one PLACE and VALUE, each PLACE is set from its VALUE before
-the next PLACE is evaluated."
-  (let ((nforms (length pairs)))
-    ;; check the number of subforms
-    (cond ((/= (% nforms 2) 0)
-           (error "odd number of arguments to `setf'"))
-          ((= nforms 0)
-           nil)
-          ((> nforms 2)
-           ;; this is the recursive case
-           (cons 'progn
-                 (do*                   ;collect the place-value pairs
-                     ((args pairs (cddr args))
-                      (place (car args) (car args))
-                      (value (cadr args) (cadr args))
-                      (result '()))
-                     ((endp args) (nreverse result))
-                   (setq result
-                         (cons (list 'setf place value)
-                               result)))))
-          (t                            ;i.e., nforms=2
-           ;; this is the base case (SETF PLACE VALUE)
-           (let* ((place (car pairs))
-                  (value (cadr pairs))
-                  (head  nil)
-                  (updatefn nil))
-             ;; dispatch on the type of the PLACE
-             (cond ((symbolp place)
-                    (list 'setq place value))
-                   ((and (listp place)
-                         (setq head (car place))
-                         (symbolp head)
-                         (setq updatefn (get head :setf-update-fn)))
-                    ;; dispatch on the type of update function
-		    (cond ((and (consp updatefn) (eq (car updatefn) 'lambda))
-			   (cons 'funcall
-				 (cons (list 'function updatefn)
-				       (append (cdr place) (list value)))))
-			  ((and (symbolp updatefn)
-                                (fboundp updatefn)
-                                (let ((defn (symbol-function updatefn)))
-                                  (or (subrp defn)
-                                      (and (consp defn)
-					   (or (eq (car defn) 'lambda)
-					       (eq (car defn) 'macro))))))
-			   (cons updatefn (append (cdr place) (list value))))
-			  (t
-                           (multiple-value-bind
-                               (bindings newsyms)
-                               (pair-with-newsyms
-                                (append (cdr place) (list value)))
-                             ;; this let gets new symbols to ensure adequate 
-                             ;; order of evaluation of the subforms.
-                             (list 'let
-                                   bindings              
-                                   (cons updatefn newsyms))))))
-                   (t
-                    (error "no `setf' update-function for `%s'"
-                           (prin1-to-string place)))))))))
-
-(defmacro defsetf (accessfn updatefn &optional docstring)
-  "Define how `setf' works on a certain kind of generalized variable.
-A use of `defsetf' looks like (defsetf ACCESSFN UPDATEFN [DOCSTRING]).
-ACCESSFN is a symbol.  UPDATEFN is a function or macro which takes
-one more argument than ACCESSFN does.  DEFSETF defines the translation
-of (SETF (ACCESFN . ARGS) NEWVAL) to be a form like (UPDATEFN ARGS... NEWVAL).
-The function UPDATEFN must return its last arg, after performing the
-updating called for."
-  ;; reject ill-formed requests.  too bad one can't test for functionp
-  ;; or macrop.
-  (when (not (symbolp accessfn))
-    (error "first argument of `defsetf' must be a symbol, not `%s'"
-           (prin1-to-string accessfn)))
-  ;; update properties
-  (list 'progn
-	(list 'eval-and-compile
-	      (list 'put (list 'quote accessfn)
-		    :setf-update-fn (list 'function updatefn)))
-        (list 'put (list 'quote accessfn) :setf-update-doc docstring)
-        ;; any better thing to return?
-        (list 'quote accessfn)))
-
-;;; This section provides the "default" setfs for Common-Emacs-Lisp
-;;; The user will not normally add anything to this, although
-;;; defstruct will introduce new ones as a matter of fact.
-;;;
-;;; Apply is a special case.   The Common Lisp
-;;; standard makes the case of apply be useful when the user writes
-;;; something like (apply #'name ...), Emacs Lisp doesn't have the #
-;;; stuff, but it has (function ...).  Notice that V18 includes a new
-;;; apply: this file is compatible with V18 and pre-V18 Emacses.
-
-;;; INCOMPATIBILITY: the SETF macro evaluates its arguments in the
-;;; (correct) left to right sequence *before* checking for apply
-;;; methods (which should really be an special case inside setf).  Due
-;;; to this, the lambda expression defsetf'd to apply will succeed in
-;;; applying the right function even if the name was not quoted, but
-;;; computed!  That extension is not Common Lisp (nor is particularly
-;;; useful, I think).
-
-(defsetf apply
-  (lambda (&rest args)
-    ;; disassemble the calling form
-    ;; "(((quote fn) x1 x2 ... xn) val)" (function instead of quote, too)
-    (let* ((fnform (car args))          ;functional form
-           (applyargs (append           ;arguments "to apply fnform"
-                       (apply 'list* (butlast (cdr args)))
-                       (last args)))
-           (newupdater nil))            ; its update-fn, if any
-      (if (and (symbolp fnform)
-               (setq newupdater (get fnform :setf-update-fn)))
-          (apply  newupdater applyargs)
-        (error "can't `setf' to `%s'"
-               (prin1-to-string fnform)))))
-  "`apply' is a special case for `setf'")
-
-
-(defsetf aref
-  aset
-  "`setf' inversion for `aref'")
-
-(defsetf nth
-  setnth
-  "`setf' inversion for `nth'")
-
-(defsetf nthcdr
-  setnthcdr
-  "`setf' inversion for `nthcdr'")
-
-(defsetf elt
-  setelt
-  "`setf' inversion for `elt'")
-
-(defsetf first
-  (lambda (list val) (setnth 0 list val))
-  "`setf' inversion for `first'")
-
-(defsetf second
-  (lambda (list val) (setnth 1 list val))
-  "`setf' inversion for `second'")
-
-(defsetf third
-  (lambda (list val) (setnth 2 list val))
-  "`setf' inversion for `third'")
-
-(defsetf fourth
-  (lambda (list val) (setnth 3 list val))
-  "`setf' inversion for `fourth'")
-
-(defsetf fifth
-  (lambda (list val) (setnth 4 list val))
-  "`setf' inversion for `fifth'")
-
-(defsetf sixth
-  (lambda (list val) (setnth 5 list val))
-  "`setf' inversion for `sixth'")
-
-(defsetf seventh
-  (lambda (list val) (setnth 6 list val))
-  "`setf' inversion for `seventh'")
-
-(defsetf eighth
-  (lambda (list val) (setnth 7 list val))
-  "`setf' inversion for `eighth'")
-
-(defsetf ninth
-  (lambda (list val) (setnth 8 list val))
-  "`setf' inversion for `ninth'")
-
-(defsetf tenth
-  (lambda (list val) (setnth 9 list val))
-  "`setf' inversion for `tenth'")
-
-(defsetf rest
-  (lambda (list val) (setcdr list val))
-  "`setf' inversion for `rest'")
-
-(defsetf car setcar "Replace the car of a cons")
-
-(defsetf cdr setcdr "Replace the cdr of a cons")
-
-(defsetf caar
-  (lambda (list val) (setcar (nth 0 list) val))
-  "`setf' inversion for `caar'")
-
-(defsetf cadr
-  (lambda (list val) (setcar (cdr list) val))
-  "`setf' inversion for `cadr'")
-
-(defsetf cdar
-  (lambda (list val) (setcdr (car list) val))
-  "`setf' inversion for `cdar'")
-
-(defsetf cddr
-  (lambda (list val) (setcdr (cdr list) val))
-  "`setf' inversion for `cddr'")
-
-(defsetf caaar
-  (lambda (list val) (setcar (caar list) val))
-  "`setf' inversion for `caaar'")
-
-(defsetf caadr
-  (lambda (list val) (setcar (cadr list) val))
-  "`setf' inversion for `caadr'")
-
-(defsetf cadar
-  (lambda (list val) (setcar (cdar list) val))
-  "`setf' inversion for `cadar'")
-
-(defsetf cdaar
-  (lambda (list val) (setcdr (caar list) val))
-  "`setf' inversion for `cdaar'")
-
-(defsetf caddr
-  (lambda (list val) (setcar (cddr list) val))
-  "`setf' inversion for `caddr'")
-
-(defsetf cdadr
-  (lambda (list val) (setcdr (cadr list) val))
-  "`setf' inversion for `cdadr'")
-
-(defsetf cddar
-  (lambda (list val) (setcdr (cdar list) val))
-  "`setf' inversion for `cddar'")
-
-(defsetf cdddr
-  (lambda (list val) (setcdr (cddr list) val))
-  "`setf' inversion for `cdddr'")
-
-(defsetf caaaar
-  (lambda (list val) (setcar (caaar list) val))
-  "`setf' inversion for `caaaar'")
-
-(defsetf caaadr
-  (lambda (list val) (setcar (caadr list) val))
-  "`setf' inversion for `caaadr'")
-
-(defsetf caadar
-  (lambda (list val) (setcar (cadar list) val))
-  "`setf' inversion for `caadar'")
-
-(defsetf cadaar
-  (lambda (list val) (setcar (cdaar list) val))
-  "`setf' inversion for `cadaar'")
-
-(defsetf cdaaar
-  (lambda (list val) (setcdr (caar list) val))
-  "`setf' inversion for `cdaaar'")
-
-(defsetf caaddr
-  (lambda (list val) (setcar (caddr list) val))
-  "`setf' inversion for `caaddr'")
-
-(defsetf cadadr
-  (lambda (list val) (setcar (cdadr list) val))
-  "`setf' inversion for `cadadr'")
-
-(defsetf cdaadr
-  (lambda (list val) (setcdr (caadr list) val))
-  "`setf' inversion for `cdaadr'")
-
-(defsetf caddar
-  (lambda (list val) (setcar (cddar list) val))
-  "`setf' inversion for `caddar'")
-
-(defsetf cdadar
-  (lambda (list val) (setcdr (cadar list) val))
-  "`setf' inversion for `cdadar'")
-
-(defsetf cddaar
-  (lambda (list val) (setcdr (cdaar list) val))
-  "`setf' inversion for `cddaar'")
-
-(defsetf cadddr
-  (lambda (list val) (setcar (cdddr list) val))
-  "`setf' inversion for `cadddr'")
-
-(defsetf cddadr
-  (lambda (list val) (setcdr (cdadr list) val))
-  "`setf' inversion for `cddadr'")
-
-(defsetf cdaddr
-  (lambda (list val) (setcdr (caddr list) val))
-  "`setf' inversion for `cdaddr'")
-
-(defsetf cdddar
-  (lambda (list val) (setcdr (cddar list) val))
-  "`setf' inversion for `cdddar'")
-
-(defsetf cddddr
-  (lambda (list val) (setcdr (cddr list) val))
-  "`setf' inversion for `cddddr'")
-
-(defsetf get put "`setf' inversion for `get' is `put'")
-
-(defsetf symbol-function fset
-  "`setf' inversion for `symbol-function' is `fset'")
-
-(defsetf symbol-plist setplist
-  "`setf' inversion for `symbol-plist' is `setplist'")
-
-(defsetf symbol-value set
-  "`setf' inversion for `symbol-value' is `set'")
-
-(defsetf point goto-char
-  "To set (point) to N, use (goto-char N)")
-
-;; how about defsetfing other Emacs forms?
-
-;;; Modify macros
-;;;
-;;; It could be nice to implement define-modify-macro, but I don't
-;;; think it really pays.
-
-(defmacro incf (ref &optional delta)
-  "(incf REF [DELTA]) -> increment the g.v. REF by DELTA (default 1)"
-  (if (null delta)
-      (setq delta 1))
-  (list 'setf ref (list '+ ref delta)))
-
-(defmacro decf (ref &optional delta)
-  "(decf REF [DELTA]) -> decrement the g.v. REF by DELTA (default 1)"
-  (if (null delta)
-      (setq delta 1))
-  (list 'setf ref (list '- ref delta)))
-
-(defmacro push (item ref)
-  "(push ITEM REF) -> cons ITEM at the head of the g.v. REF (a list)"
-  (list 'setf ref (list 'cons item ref)))
-
-(defmacro pushnew (item ref)
-  "(pushnew ITEM REF): adjoin ITEM at the head of the g.v. REF (a list)"
-  (list 'setf ref (list 'adjoin item ref)))
-
-(defmacro pop (ref)
-  "(pop REF) -> (prog1 (car REF) (setf REF (cdr REF)))"
-  (let ((listname (gensym)))
-    (list 'let (list (list listname ref))
-          (list 'prog1
-                (list 'car listname)
-                (list 'setf ref (list 'cdr listname))))))
-
-;;; PSETF
-;;;
-;;; Psetf is the generalized variable equivalent of psetq.  The right
-;;; hand sides are evaluated and assigned (via setf) to the left hand
-;;; sides. The evaluations are done in an environment where they
-;;; appear to occur in parallel.
-
-(defmacro psetf (&rest body)
-  "(psetf {var value }...) => nil
-Like setf, but all the values are computed before any assignment is made."
-  (let ((length (length body)))
-    (cond ((/= (% length 2) 0)
-           (error "psetf needs an even number of arguments, %d given"
-                  length))
-          ((null body)
-           '())
-          (t
-           (list 'prog1 nil
-                 (let ((setfs     '())
-                       (bodyforms (reverse body)))
-                   (while bodyforms
-                     (let* ((value (car bodyforms))
-                            (place (cadr bodyforms)))
-                       (setq bodyforms (cddr bodyforms))
-                       (if (null setfs)
-                           (setq setfs (list 'setf place value))
-                         (setq setfs (list 'setf place
-                                           (list 'prog1 value
-                                                 setfs))))))
-                   setfs))))))
-
-;;; SHIFTF and ROTATEF 
-;;;
-
-(defmacro shiftf (&rest forms)
-  "(shiftf PLACE1 PLACE2... NEWVALUE)
-Set PLACE1 to PLACE2, PLACE2 to PLACE3...
-Each PLACE is set to the old value of the following PLACE,
-and the last PLACE is set to the value NEWVALUE.  
-Returns the old value of PLACE1."
-  (unless (> (length forms) 1)
-    (error "`shiftf' needs more than one argument"))
-  (let ((places (butlast forms))
-	(newvalue (car (last forms))))
-    ;; the places are accessed to fresh symbols
-    (multiple-value-bind
-	(bindings newsyms)
-	(pair-with-newsyms places)
-      (list 'let bindings
-	    (cons 'setf
-		  (zip-lists places
-			     (append (cdr newsyms) (list newvalue))))
-	    (car newsyms)))))
-
-(defmacro rotatef (&rest places)
-  "(rotatef PLACE...) sets each PLACE to the old value of the following PLACE.
-The last PLACE is set to the old value of the first PLACE.
-Thus, the values rotate through the PLACEs.  Returns nil."
-  (if (null places)
-      nil
-   (multiple-value-bind
-       (bindings newsyms)
-       (pair-with-newsyms places)
-     (list
-      'let bindings
-      (cons 'setf
-            (zip-lists places
-                       (append (cdr newsyms) (list (car newsyms)))))
-      nil))))
-
-;;; GETF, REMF, and REMPROP
-;;;
-
-(defun getf (place indicator &optional default)
-  "Return PLACE's PROPNAME property, or DEFAULT if not present."
-  (while (and place (not (eq (car place) indicator)))
-    (setq place (cdr (cdr place))))
-  (if place
-      (car (cdr place))
-    default))
-
-(defmacro getf$setf$method (place indicator default &rest newval)
-  "SETF method for GETF.  Not for public use."
-  (case (length newval)
-    (0 (setq newval default default nil))
-    (1 (setq newval (car newval)))
-    (t (error "Wrong number of arguments to (setf (getf ...)) form")))
-  (let ((psym (gentemp)) (isym (gentemp)) (vsym (gentemp)))
-    (list 'let (list (list psym place)
-		     (list isym indicator)
-		     (list vsym newval))
-	  (list 'while
-		(list 'and psym
-		      (list 'not
-			    (list 'eq (list 'car psym) isym)))
-		(list 'setq psym (list 'cdr (list 'cdr psym))))
-	  (list 'if psym
-		(list 'setcar (list 'cdr psym) vsym)
-		(list 'setf place
-		      (list 'nconc place (list 'list isym newval))))
-	  vsym)))
-
-(defsetf getf
-  getf$setf$method)
-
-(defmacro remf (place indicator)
-  "Remove from the property list at PLACE its PROPNAME property.
-Returns non-nil if and only if the property existed."
-  (let ((psym (gentemp)) (isym (gentemp)))
-    (list 'let (list (list psym place) (list isym indicator))
-	  (list 'cond
-		(list (list 'eq isym (list 'car psym))
-		      (list 'setf place (list 'cdr (list 'cdr psym)))
-		      t)
-		(list t
-		      (list 'setq psym (list 'cdr psym))
-		      (list 'while
-			    (list 'and (list 'cdr psym)
-				  (list 'not
-					(list 'eq (list 'car (list 'cdr psym))
-					      isym)))
-			    (list 'setq psym (list 'cdr (list 'cdr psym))))
-		      (list 'cond
-			    (list (list 'cdr psym)
-				  (list 'setcdr psym
-					(list 'cdr
-					      (list 'cdr (list 'cdr psym))))
-				  t)))))))
-
-(defun remprop (symbol indicator)
-  "Remove SYMBOL's PROPNAME property, returning non-nil if it was present."
-  (remf (symbol-plist symbol) indicator))
-  
-
-;;;; STRUCTS
-;;;;    This file provides the structures mechanism.  See the
-;;;;    documentation for Common-Lisp's defstruct.  Mine doesn't
-;;;;    implement all the functionality of the standard, although some
-;;;;    more could be grafted if so desired.  More details along with
-;;;;    the code.
-;;;;
-;;;;
-;;;;    Cesar Quiroz @ UofR DofCSc - Dec. 1986
-;;;;       (quiroz@cs.rochester.edu)
-
-
-(defkeyword :include             "Syntax of `defstruct'")
-(defkeyword :named               "Syntax of `defstruct'")
-(defkeyword :conc-name           "Syntax of `defstruct'")
-(defkeyword :copier              "Syntax of `defstruct'")
-(defkeyword :predicate           "Syntax of `defstruct'")
-(defkeyword :print-function      "Syntax of `defstruct'")
-(defkeyword :type                "Syntax of `defstruct'")
-(defkeyword :initial-offset      "Syntax of `defstruct'")
-
-(defkeyword :structure-doc       "Documentation string for a structure.")
-(defkeyword :structure-slotsn    "Number of slots in structure")
-(defkeyword :structure-slots     "List of the slot's names")
-(defkeyword :structure-indices   "List of (KEYWORD-NAME . INDEX)")
-(defkeyword :structure-initforms "List of (KEYWORD-NAME . INITFORM)")
-(defkeyword :structure-includes
-            "() or list of a symbol, that this struct includes")
-(defkeyword :structure-included-in
-            "List of the structs that include this")
-
-
-(defmacro defstruct (&rest args)
-  "(defstruct NAME [DOC-STRING] . SLOTS)  define NAME as structure type.
-NAME must be a symbol, the name of the new structure.  It could also
-be a list (NAME . OPTIONS).  
-
-Each option is either a symbol, or a list of a keyword symbol taken from the
-list \{:conc-name, :copier, :constructor, :predicate, :include,
-:print-function, :type, :initial-offset\}.  The meanings of these are as in
-CLtL, except that no BOA-constructors are provided, and the options
-\{:print-function, :type, :initial-offset\} are ignored quietly.  All these
-structs are named, in the sense that their names can be used for type
-discrimination.
-
-The DOC-STRING is established as the `structure-doc' property of NAME.
-
-The SLOTS are one or more of the following:
-SYMBOL -- meaning the SYMBOL is the name of a SLOT of NAME
-list of SYMBOL and VALUE -- meaning that VALUE is the initial value of
-the slot.
-`defstruct' defines functions `make-NAME', `NAME-p', `copy-NAME' for the
-structure, and functions with the same name as the slots to access
-them.  `setf' of the accessors sets their values."
-  (multiple-value-bind
-      (name options docstring slotsn slots initlist)
-      (parse$defstruct$args args)
-    ;; Names for the member functions come from the options.  The
-    ;; slots* stuff collects info about the slots declared explicitly. 
-    (multiple-value-bind
-        (conc-name constructor copier predicate
-         moreslotsn moreslots moreinits included)
-        (parse$defstruct$options name options slots)
-      ;; The moreslots* stuff refers to slots gained as a consequence
-      ;; of (:include clauses). -- Oct 89:  Only one :include tolerated
-      (when (and (numberp moreslotsn)
-                 (> moreslotsn 0))
-        (setf slotsn (+ slotsn moreslotsn))
-        (setf slots (append moreslots slots))
-        (setf initlist (append moreinits initlist)))
-      (unless (> slotsn 0)
-        (error "%s needs at least one slot"
-               (prin1-to-string name)))
-      (let ((dups (duplicate-symbols-p slots)))
-        (when dups
-          (error "`%s' are duplicates"
-                 (prin1-to-string dups))))
-      (setq initlist (simplify$inits slots initlist))
-      (let (properties functions keywords accessors alterators returned)
-        ;; compute properties of NAME
-        (setq properties
-              (append
-               (list
-                (list 'put (list 'quote name) :structure-doc
-                      docstring)
-                (list 'put (list 'quote name) :structure-slotsn
-                      slotsn)
-                (list 'put (list 'quote name) :structure-slots
-                      (list 'quote slots))
-                (list 'put (list 'quote name) :structure-initforms
-                      (list 'quote initlist))
-                (list 'put (list 'quote name) :structure-indices
-                      (list 'quote (extract$indices initlist))))
-               ;; If this definition :includes another defstruct,
-               ;; modify both property lists.
-               (cond (included
-                      (list
-                       (list 'put
-                             (list 'quote name)
-                             :structure-includes
-                             (list 'quote included))
-                       (list 'pushnew
-                             (list 'quote name)
-                             (list 'get (list 'quote (car included))
-                                   :structure-included-in))))
-                     (t
-                      (list
-                       (let ((old (gensym)))
-                         (list 'let 
-                               (list (list old
-                                           (list 'car
-                                                 (list 'get
-                                                       (list 'quote name)
-                                                       :structure-includes))))
-                               (list 'when old
-                                     (list 'put
-                                           old
-                                           :structure-included-in
-                                           (list 'delq
-                                                 (list 'quote name)
-                                                 ;; careful with destructive
-                                                 ;;manipulation!
-                                                 (list
-                                                  'append
-                                                  (list
-                                                   'get
-                                                   old
-                                                   :structure-included-in)
-                                                  '())
-                                                 )))))
-                       (list 'put
-                             (list 'quote name)
-                             :structure-includes
-                             '()))))
-               ;; If this definition used to be :included in another, warn
-               ;; that things make break.  On the other hand, the redefinition
-               ;; may be trivial, so don't call it an error.
-               (let ((old (gensym)))
-                 (list
-                  (list 'let
-                        (list (list old (list 'get
-                                              (list 'quote name)
-                                              :structure-included-in)))
-                        (list 'when old
-                              (list 'message
-                                    "`%s' redefined.  Should redefine `%s'?"
-                                    (list 'quote name)
-                                    (list 'prin1-to-string old))))))))
-
-        ;; Compute functions associated with NAME.  This is not
-	;; handling BOA constructors yet, but here would be the place.
-        (setq functions
-              (list
-               (list 'fset (list 'quote constructor)
-                     (list 'function
-                           (list 'lambda (list '&rest 'args)
-                                 (list 'make$structure$instance
-                                       (list 'quote name)
-                                       'args))))
-               (list 'fset (list 'quote copier)
-                     (list 'function 'copy-sequence))
-               (let ((typetag (gensym)))
-                 (list 'fset (list 'quote predicate)
-                       (list 
-                        'function
-                        (list 
-                         'lambda (list 'thing)
-                         (list 'and
-                               (list 'vectorp 'thing)
-                               (list 'let
-                                     (list (list typetag
-                                                 (list 'elt 'thing 0)))
-                                     (list 'or
-                                           (list
-                                            'and
-                                            (list 'eq
-                                                  typetag
-                                                  (list 'quote name))
-                                            (list '=
-                                                  (list 'length 'thing)
-                                                  (1+ slotsn)))
-                                           (list
-                                            'memq
-                                            typetag
-                                            (list 'get
-                                                  (list 'quote name)
-                                                  :structure-included-in))))))
-                        )))))
-        ;; compute accessors for NAME's slots
-        (multiple-value-setq
-            (accessors alterators keywords)
-            (build$accessors$for name conc-name predicate slots slotsn))
-        ;; generate returned value -- not defined by the standard
-        (setq returned
-              (list
-               (cons 'vector
-                     (mapcar
-                      (function (lambda (x) (list 'quote x)))
-                      (cons name slots)))))
-        ;; generate code
-        (cons 'progn
-              (nconc properties functions keywords
-                     accessors alterators returned))))))
-
-(defun parse$defstruct$args (args)
-  "(parse$defstruct$args ARGS) => NAME OPTIONS DOCSTRING SLOTSN SLOTS INITLIST
-NAME=symbol, OPTIONS=list of, DOCSTRING=string, SLOTSN=count of slots,
-SLOTS=list of their names, INITLIST=alist (keyword . initform)."
-  (let (name                            ;args=(symbol...) or ((symbol...)...)
-        options                         ;args=((symbol . options) ...)
-        (docstring "")                  ;args=(head docstring . slotargs)
-        slotargs                        ;second or third cdr of args
-        (slotsn 0)                      ;number of slots 
-        (slots '())                     ;list of slot names
-        (initlist '()))                 ;list of (slot keyword . initform)
-    ;; extract name and options
-    (cond ((symbolp (car args))         ;simple name
-           (setq name    (car args)
-                 options '()))
-          ((and (listp   (car args))    ;(name . options)
-                (symbolp (caar args)))
-           (setq name    (caar args)
-                 options (cdar args)))
-          (t
-           (error "first arg to `defstruct' must be symbol or (symbol ...)")))
-    (setq slotargs (cdr args))
-    ;; is there a docstring?
-    (when (stringp (car slotargs))
-      (setq docstring (car slotargs)
-            slotargs  (cdr slotargs)))
-    ;; now for the slots
-    (multiple-value-bind
-        (slotsn slots initlist)
-        (process$slots slotargs)
-      (values name options docstring slotsn slots initlist))))
-
-(defun process$slots (slots)
-  "(process$slots SLOTS) => SLOTSN SLOTSLIST INITLIST
-Converts a list of symbols or lists of symbol and form into the last 3
-values returned by PARSE$DEFSTRUCT$ARGS."
-  (let ((slotsn (length slots))         ;number of slots
-        slotslist                       ;(slot1 slot2 ...)
-        initlist)                       ;((:slot1 . init1) ...)
-    (do*
-        ((ptr  slots     (cdr ptr))
-         (this (car ptr) (car ptr)))
-        ((endp ptr))
-      (cond ((symbolp this)
-             (setq slotslist (cons this slotslist))
-             (setq initlist (acons (keyword-of this) nil initlist)))
-            ((and (listp this)
-                  (symbolp (car this)))
-             (let ((name (car this))
-                   (form (cadr this)))
-               ;; this silently ignores any slot options.  bad...
-               (setq slotslist (cons name slotslist))
-               (setq initlist  (acons (keyword-of name) form initlist))))
-            (t
-             (error "slot should be symbol or (symbol ...), not `%s'"
-                    (prin1-to-string this)))))
-    (values slotsn (nreverse slotslist) (nreverse initlist))))
-
-(defun parse$defstruct$options (name options slots)
-  "(parse$defstruct$options name OPTIONS SLOTS) => many values
-A defstruct named NAME, with options list OPTIONS, has already slots SLOTS.
-Parse the OPTIONS and return the updated form of the struct's slots and other
-information.  The values returned are:
-
-   CONC-NAME is the string to use as prefix/suffix in the methods,
-   CONST is the name of the official constructor,
-   COPIER is the name of the structure copier,
-   PRED is the name of the type predicate,
-   MORESLOTSN is the number of slots added by :include,
-   MORESLOTS is the list of slots added by :include,
-   MOREINITS is the list of initialization forms added by :include,
-   INCLUDED is nil, or the list of the symbol added by :include"
-  (let* ((namestring (symbol-name name))
-         ;; to build the return values
-         (conc-name  (concat namestring "-"))
-         (const (intern (concat "make-" namestring)))
-         (copier (intern (concat "copy-" namestring)))
-         (pred (intern (concat namestring "-p")))
-         (moreslotsn 0)
-         (moreslots '())
-         (moreinits '())
-         ;; auxiliaries
-         option-head                    ;When an option is not a plain
-         option-second                  ; keyword, it must be a list of
-         option-rest                    ; the form (head second . rest)
-         these-slotsn                   ;When :include is found, the
-         these-slots                    ; info about the included
-         these-inits                    ; structure is added here.
-         included                       ;NIL or (list INCLUDED)
-         )
-    ;; Values above are the defaults.  Now we read the options themselves
-    (dolist (option options)
-      ;; 2 cases arise, as options must be a keyword or a list
-      (cond
-       ((keywordp option)
-        (case option
-          (:named
-           )                            ;ignore silently
-          (t
-           (error "can't recognize option `%s'"
-                  (prin1-to-string option)))))
-       ((and (listp option)
-             (keywordp (setq option-head (car option))))
-        (setq option-second (second option))
-        (setq option-rest   (nthcdr 2 option))
-        (case option-head
-          (:conc-name
-           (setq conc-name
-                 (cond
-                  ((stringp option-second)
-                   option-second)
-                  ((null option-second)
-                   "")
-                  (t
-                   (error "`%s' is invalid as `conc-name'"
-                          (prin1-to-string option-second))))))
-          (:copier
-           (setq copier
-                 (cond
-                  ((and (symbolp option-second)
-                        (null option-rest))
-                   option-second)
-                  (t
-                   (error "can't recognize option `%s'"
-                          (prin1-to-string option))))))
-
-          (:constructor                 ;no BOA-constructors allowed
-           (setq const
-                 (cond
-                  ((and (symbolp option-second)
-                        (null option-rest))
-                   option-second)
-                  (t
-                   (error "can't recognize option `%s'"
-                          (prin1-to-string option))))))
-          (:predicate
-           (setq pred
-                 (cond
-                  ((and (symbolp option-second)
-                        (null option-rest))
-                   option-second)
-                  (t
-                   (error "can't recognize option `%s'"
-                          (prin1-to-string option))))))
-          (:include
-           (unless (symbolp option-second)
-             (error "arg to `:include' should be a symbol, not `%s'"
-                    (prin1-to-string option-second)))
-           (setq these-slotsn (get option-second :structure-slotsn)
-                 these-slots  (get option-second :structure-slots)
-                 these-inits  (get option-second :structure-initforms))
-           (unless (and (numberp these-slotsn)
-                        (> these-slotsn 0))
-             (error "`%s' is not a valid structure"
-                    (prin1-to-string option-second)))
-           (if included
-               (error "`%s' already includes `%s', can't include `%s' too"
-                      name (car included) option-second)
-             (push option-second included))
-           (multiple-value-bind
-               (xtra-slotsn xtra-slots xtra-inits)
-               (process$slots option-rest)
-             (when (> xtra-slotsn 0)
-               (dolist (xslot xtra-slots)
-                 (unless (memq xslot these-slots)
-                   (error "`%s' is not a slot of `%s'"
-                          (prin1-to-string xslot)
-                          (prin1-to-string option-second))))
-               (setq these-inits (append xtra-inits these-inits)))
-             (setq moreslotsn (+ moreslotsn these-slotsn))
-             (setq moreslots  (append these-slots moreslots))
-             (setq moreinits  (append these-inits moreinits))))
-          ((:print-function :type :initial-offset)
-           )                            ;ignore silently
-          (t
-           (error "can't recognize option `%s'"
-                  (prin1-to-string option)))))
-       (t
-        (error "can't recognize option `%s'"
-               (prin1-to-string option)))))
-    ;; Return values found
-    (values conc-name const copier pred
-            moreslotsn moreslots moreinits
-            included)))
-
-(defun simplify$inits (slots initlist)
-  "(simplify$inits SLOTS INITLIST) => new INITLIST
-Removes from INITLIST - an ALIST - any shadowed bindings."
-  (let ((result '())                    ;built here
-        key                             ;from the slot 
-        )
-    (dolist (slot slots)
-      (setq key (keyword-of slot))
-      (setq result (acons key (cdr (assoc key initlist)) result)))
-    (nreverse result)))
-
-(defun extract$indices (initlist)
-  "(extract$indices INITLIST) => indices list
-Kludge.  From a list of pairs (keyword . form) build a list of pairs
-of the form (keyword . position in list from 0).  Useful to precompute
-some of the work of MAKE$STRUCTURE$INSTANCE."
-  (let ((result '())
-        (index   0))
-    (dolist (entry initlist (nreverse result))
-      (setq result (acons (car entry) index result)
-            index  (+ index 1)))))
-
-(defun build$accessors$for (name conc-name predicate slots slotsn)
-  "(build$accessors$for NAME PREDICATE SLOTS SLOTSN) => FSETS DEFSETFS KWDS
-Generate the code for accesors and defsetfs of a structure called
-NAME, whose slots are SLOTS.  Also, establishes the keywords for the
-slots names."
-  (do ((i 0 (1+ i))
-       (accessors '())
-       (alterators '())
-       (keywords '())
-       (canonic  ""))                   ;slot name with conc-name prepended
-      ((>= i slotsn)
-       (values
-        (nreverse accessors) (nreverse alterators) (nreverse keywords)))
-    (setq canonic (intern (concat conc-name (symbol-name (nth i slots)))))
-    (setq accessors
-          (cons
-           (list 'fset (list 'quote canonic)
-                 (list 'function
-                       (list 'lambda (list 'object)
-                             (list 'cond
-                                   (list (list predicate 'object)
-                                         (list 'aref 'object (1+ i)))
-                                   (list 't
-                                         (list 'error
-                                               "`%s' is not a struct %s"
-                                               (list 'prin1-to-string
-                                                     'object)
-                                               (list 'prin1-to-string
-                                                     (list 'quote
-                                                           name))))))))
-           accessors))
-    (setq alterators
-           (cons
-            (list 'defsetf canonic
-                  (list 'lambda (list 'object 'newval)
-                        (list 'cond
-                              (list (list predicate 'object)
-                                    (list 'aset 'object (1+ i) 'newval))
-                              (list 't
-                                    (list 'error
-                                          "`%s' not a `%s'"
-                                          (list 'prin1-to-string
-                                                'object)
-                                          (list 'prin1-to-string
-                                                (list 'quote
-                                                      name)))))))
-            alterators))
-    (setq keywords
-          (cons (list 'defkeyword (keyword-of (nth i slots)))
-                keywords))))
-
-(defun make$structure$instance (name args)
-  "(make$structure$instance NAME ARGS) => new struct NAME
-A struct of type NAME is created, some slots might be initialized
-according to ARGS (the &rest argument of MAKE-name)."
-  (unless (symbolp name)
-    (error "`%s' is not a possible name for a structure"
-           (prin1-to-string name)))
-  (let ((initforms (get name :structure-initforms))
-        (slotsn    (get name :structure-slotsn))
-        (indices   (get name :structure-indices))
-        initalist                       ;pairlis'd on initforms
-        initializers                    ;definitive initializers
-        )
-    ;; check sanity of the request
-    (unless (and (numberp slotsn)
-                 (> slotsn 0))
-      (error "`%s' is not a defined structure"
-             (prin1-to-string name)))
-    (unless (evenp (length args))
-      (error "slot initializers `%s' not of even length"
-             (prin1-to-string args)))
-    ;; analyze the initializers provided by the call
-    (multiple-value-bind
-        (speckwds specvals)             ;keywords and values given 
-        (unzip-list args)               ; by the user
-      ;; check that all the arguments are introduced by keywords 
-      (unless (every (function keywordp) speckwds)
-        (error "all of the names in `%s' should be keywords"
-               (prin1-to-string speckwds)))
-      ;; check that all the keywords are known
-      (dolist (kwd speckwds)
-        (unless (numberp (cdr (assoc kwd indices)))
-          (error "`%s' is not a valid slot name for %s"
-                 (prin1-to-string kwd) (prin1-to-string name))))
-      ;; update initforms
-      (setq initalist
-            (pairlis speckwds
-                     (do* ;;protect values from further evaluation
-                         ((ptr specvals (cdr ptr))
-                          (val (car ptr) (car ptr))
-                          (result '()))
-                         ((endp ptr) (nreverse result))
-                       (setq result
-                             (cons (list 'quote val)
-                                   result)))
-                     (copy-sequence initforms)))
-      ;; compute definitive initializers
-      (setq initializers
-            (do* ;;gather the values of the most definitive forms
-                ((ptr indices (cdr ptr))
-                 (key (caar ptr) (caar ptr))
-                 (result '()))
-                ((endp ptr) (nreverse result))
-              (setq result
-                    (cons (eval (cdr (assoc key initalist))) result))))
-      ;; do real initialization
-      (apply (function vector)
-             (cons name initializers)))))
-
-;;;; end of cl-structs.el
-
-;;; For lisp-interaction mode, so that multiple values can be seen when passed
-;;; back.  Lies every now and then...
-
-(defvar - nil "form currently under evaluation")
-(defvar + nil "previous -")
-(defvar ++ nil "previous +")
-(defvar +++ nil "previous ++")
-(defvar / nil "list of values returned by +")
-(defvar // nil "list of values returned by ++")
-(defvar /// nil "list of values returned by +++")
-(defvar * nil "(first) value of +")
-(defvar ** nil "(first) value of ++")
-(defvar *** nil "(first) value of +++")
-
-(defun cl-eval-print-last-sexp ()
-  "Evaluate sexp before point; print value\(s\) into current buffer.
-If the evaled form returns multiple values, they are shown one to a line.
-The variables -, +, ++, +++, *, **, ***, /, //, /// have their usual meaning.
-
-It clears the multiple-value passing mechanism, and does not pass back
-multiple values.  Use this only if you are debugging cl.el and understand well
-how the multiple-value stuff works, because it can be fooled into believing
-that multiple values have been returned when they actually haven't, for
-instance 
-    \(identity \(values nil 1\)\)
-However, even when this fails, you can trust the first printed value to be
-\(one of\) the returned value\(s\)."
-  (interactive)
-  ;; top level call, can reset mvalues
-  (setq *mvalues-count*  nil
-        *mvalues-values* nil)
-  (setq -  (car (read-from-string
-                 (buffer-substring
-                  (let ((stab (syntax-table)))
-                    (unwind-protect
-                        (save-excursion
-                          (set-syntax-table emacs-lisp-mode-syntax-table)
-                          (forward-sexp -1)
-                          (point))
-                      (set-syntax-table stab)))
-                  (point)))))
-  (setq *** **
-        **  *
-        *   (eval -))
-  (setq /// //
-        //  /
-        /   *mvalues-values*)
-  (setq +++ ++
-        ++  +
-        +   -)
-  (cond ((or (null *mvalues-count*)     ;mvalues mechanism not used
-             (not (eq * (car *mvalues-values*))))
-         (print * (current-buffer)))
-        ((null /)                       ;no values returned
-         (terpri (current-buffer)))
-        (t                              ;more than zero mvalues
-         (terpri (current-buffer))
-         (mapcar (function (lambda (value)
-                             (prin1 value (current-buffer))
-                             (terpri (current-buffer))))
-                 /)))
-  (setq *mvalues-count*  nil            ;make sure
-        *mvalues-values* nil))
-
-;;;; More LISTS functions
-;;;;
-
-;;; Some mapping functions on lists, commonly useful.
-;;; They take no extra sequences, to go along with Emacs Lisp's MAPCAR.
-
-(defun mapc (function list)
-  "(MAPC FUNCTION LIST) => LIST
-Apply FUNCTION to each element of LIST, return LIST.
-Like mapcar, but called only for effect."
-  (let ((args list))
-    (while args
-      (funcall function (car args))
-      (setq args (cdr args))))
-  list)
-
-(defun maplist (function list)
-  "(MAPLIST FUNCTION LIST) => list'ed results of FUNCTION on cdrs of LIST
-Apply FUNCTION to successive sublists of LIST, return the list of the results"
-  (let ((args list)
-        results '())
-    (while args
-      (setq results (cons (funcall function args) results)
-            args (cdr args)))
-    (nreverse results)))
-
-(defun mapl (function list)
-  "(MAPL FUNCTION LIST) => LIST
-Apply FUNCTION to successive cdrs of LIST, return LIST.
-Like maplist, but called only for effect."
-  (let ((args list))
-    (while args
-      (funcall function args)
-      (setq args (cdr args)))
-    list))
-
-(defun mapcan (function list)
-  "(MAPCAN FUNCTION LIST) => nconc'd results of FUNCTION on LIST
-Apply FUNCTION to each element of LIST, nconc the results.
-Beware: nconc destroys its first argument!  See copy-list."
-  (let ((args list)
-        (results '()))
-    (while args
-      (setq results (nconc (funcall function (car args)) results)
-            args (cdr args)))
-    (nreverse results)))
-
-(defun mapcon (function list)
-  "(MAPCON FUNCTION LIST) => nconc'd results of FUNCTION on cdrs of LIST
-Apply FUNCTION to successive sublists of LIST, nconc the results.
-Beware: nconc destroys its first argument!  See copy-list."
-  (let ((args list)
-        (results '()))
-    (while args
-      (setq results (nconc (funcall function args) results)
-            args (cdr args)))
-    (nreverse results)))
-
-;;; Copiers
-
-(defsubst copy-list (list)
-  "Build a copy of LIST"
-  (append list '()))
-
-(defun copy-tree (tree)
-  "Build a copy of the tree of conses TREE
-The argument is a tree of conses, it is recursively copied down to
-non conses.  Circularity and sharing of substructure are not
-necessarily preserved."
-  (if (consp tree)
-      (cons (copy-tree (car tree))
-            (copy-tree (cdr tree)))
-    tree))
-
-;;; reversals, and destructive manipulations of a list's spine
-
-(defun revappend (x y)
-  "does what (append (reverse X) Y) would, only faster"
-  (if (endp x)
-      y
-    (revappend (cdr x) (cons (car x) y))))
-
-(defun nreconc (x y)
-  "does (nconc (nreverse X) Y) would, only faster
-Destructive on X, be careful."
-  (if (endp x)
-      y
-    ;; reuse the first cons of x, making it point to y
-    (nreconc (cdr x) (prog1 x (rplacd x y)))))
-
-(defun nbutlast (list &optional n)
-  "Side-effected LIST truncated N+1 conses from the end.
-This is the destructive version of BUTLAST.  Returns () and does not
-modify the LIST argument if the length of the list is not at least N."
-  (when (null n) (setf n 1))
-  (let ((length (list-length list)))
-    (cond ((null length)
-           list)
-          ((< length n)
-           '())
-          (t
-           (setnthcdr (- length n) list nil)
-           list))))
-
-;;; Substitutions
-
-(defun subst (new old tree)
-  "NEW replaces OLD in a copy of TREE
-Uses eql for the test."
-  (subst-if new (function (lambda (x) (eql x old))) tree))
-
-(defun subst-if-not (new test tree)
-  "NEW replaces any subtree or leaf that fails TEST in a copy of TREE"
-  ;; (subst-if new (function (lambda (x) (not (funcall test x)))) tree)
-  (cond ((not (funcall test tree))
-         new)
-        ((atom tree)
-         tree)
-        (t                              ;no match so far
-         (let ((head (subst-if-not new test (car tree)))
-               (tail (subst-if-not new test (cdr tree))))
-           ;; If nothing changed, return originals.  Else use the new
-           ;; components to assemble a new tree.
-           (if (and (eql head (car tree))
-                    (eql tail (cdr tree)))
-               tree
-             (cons head tail))))))
-
-(defun subst-if (new test tree)
-  "NEW replaces any subtree or leaf that satisfies TEST in a copy of TREE"
-  (cond ((funcall test tree)
-         new)
-        ((atom tree)
-         tree)
-        (t                              ;no match so far
-         (let ((head (subst-if new test (car tree)))
-               (tail (subst-if new test (cdr tree))))
-           ;; If nothing changed, return originals.  Else use the new
-           ;; components to assemble a new tree.
-           (if (and (eql head (car tree))
-                    (eql tail (cdr tree)))
-               tree
-             (cons head tail))))))
-
-(defun sublis (alist tree)
-  "Use association list ALIST to modify a copy of TREE
-If a subtree or leaf of TREE is a key in ALIST, it is replaced by the
-associated value.  Not exactly Common Lisp, but close in spirit and
-compatible with the native Emacs Lisp ASSOC, which uses EQUAL."
-  (let ((toplevel (assoc tree alist)))
-    (cond (toplevel                     ;Bingo at top
-           (cdr toplevel))
-          ((atom tree)                  ;Give up on this
-           tree)
-          (t
-           (let ((head (sublis alist (car tree)))
-                 (tail (sublis alist (cdr tree))))
-             (if (and (eql head (car tree))
-                      (eql tail (cdr tree)))
-                 tree
-               (cons head tail)))))))
-
-(defun member-if (predicate list)
-  "PREDICATE is applied to the members of LIST.  As soon as one of them
-returns true, that tail of the list if returned.  Else NIL."
-  (catch 'found-member-if
-    (while (not (endp list))
-      (if (funcall predicate (car list))
-          (throw 'found-member-if list)
-        (setq list (cdr list))))
-    nil))
-
-(defun member-if-not (predicate list)
-  "PREDICATE is applied to the members of LIST.  As soon as one of them
-returns false, that tail of the list if returned.  Else NIL."
-  (catch 'found-member-if-not
-    (while (not (endp list))
-      (if (funcall predicate (car list))
-          (setq list (cdr list))
-        (throw 'found-member-if-not list)))
-    nil))
-
-(defun tailp (sublist list)
-  "(tailp SUBLIST LIST) => True if SUBLIST is a sublist of LIST."
-  (catch 'tailp-found
-    (while (not (endp list))
-      (if (eq sublist list)
-          (throw 'tailp-found t)
-        (setq list (cdr list))))
-    nil))
-
-;;; Suggestion of phr%widow.Berkeley.EDU@lilac.berkeley.edu
-
-(defmacro declare (&rest decls)
-  "Ignore a Common-Lisp declaration."
-  "declarations are ignored in this implementation")
-
-(defun proclaim (&rest decls)
-  "Ignore a Common-Lisp proclamation."
-  "declarations are ignored in this implementation")
-
-(defmacro the (type form)
-  "(the TYPE FORM) macroexpands to FORM
-No checking is even attempted.  This is just for compatibility with
-Common-Lisp codes."
-  form)
-
-;;; Due to Aaron Larson (alarson@src.honeywell.com, 26 Jul 91)
-(put 'progv 'common-lisp-indent-hook '(4 4 &body))
-(defmacro progv (vars vals &rest body)
-  "progv vars vals &body forms
-bind vars to vals then execute forms.
-If there are more vars than vals, the extra vars are unbound, if
-there are more vals than vars, the extra vals are just ignored."
-  (` (progv$runtime (, vars) (, vals) (function (lambda () (,@ body))))))
-
-;;; To do this efficiently, it really needs to be a special form...
-(defun progv$runtime (vars vals body)
-  (eval (let ((vars-n-vals nil)
-	      (unbind-forms nil))
-	  (do ((r vars (cdr r))
-	       (l vals (cdr l)))
-	      ((endp r))
-	    (push (list (car r) (list 'quote (car l))) vars-n-vals)
-	    (if (null l)
-		(push (` (makunbound '(, (car r)))) unbind-forms)))
-	  (` (let (, vars-n-vals) (,@ unbind-forms) (funcall '(, body)))))))
-
-(provide 'cl)
-
-;;;; end of cl.el
diff --git a/lisp/=cmulisp.el b/lisp/=cmulisp.el
deleted file mode 100644
index 1e49da84165..00000000000
--- a/lisp/=cmulisp.el
+++ /dev/null
@@ -1,694 +0,0 @@
-;;; cmulisp.el --- improved version of standard inferior-lisp mode
-
-;;; Copyright Olin Shivers (1988).
-
-;; Keywords: processes, lisp
-
-;;; Please imagine a long, tedious, legalistic 5-page gnu-style copyright
-;;; notice appearing here to the effect that you may use this code any
-;;; way you like, as long as you don't charge money for it, remove this
-;;; notice, or hold me liable for its results.
-
-;;; Commentary:
-
-;;; This replaces the standard inferior-lisp mode.
-;;; Hacked from tea.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
-;;; Please send me bug reports, bug fixes, and extensions, so that I can
-;;; merge them into the master source.
-;;;
-;;; Change log at end of file.
-
-;;; This file defines a a lisp-in-a-buffer package (cmulisp mode) built on top
-;;; of comint mode.  Cmulisp mode is similar to, and intended to replace, its
-;;; counterpart in the standard gnu emacs release. This replacements is more
-;;; featureful, robust, and uniform than the released version.  The key
-;;; bindings are also more compatible with the bindings of Hemlock and Zwei
-;;; (the Lisp Machine emacs).
-
-;;; Since this mode is built on top of the general command-interpreter-in-
-;;; a-buffer mode (comint mode), it shares a common base functionality, 
-;;; and a common set of bindings, with all modes derived from comint mode.
-;;; This makes these modes easier to use.
-
-;;; For documentation on the functionality provided by comint mode, and
-;;; the hooks available for customising it, see the file comint.el.
-;;; For further information on cmulisp mode, see the comments below.
-
-;;; Needs fixin:
-;;; The load-file/compile-file default mechanism could be smarter -- it
-;;; doesn't know about the relationship between filename extensions and
-;;; whether the file is source or executable. If you compile foo.lisp
-;;; with compile-file, then the next load-file should use foo.bin for
-;;; the default, not foo.lisp. This is tricky to do right, particularly
-;;; because the extension for executable files varies so much (.o, .bin,
-;;; .lbin, .mo, .vo, .ao, ...).
-;;;
-;;; It would be nice if cmulisp (and inferior scheme, T, ...) modes
-;;; had a verbose minor mode wherein sending or compiling defuns, etc.
-;;; would be reflected in the transcript with suitable comments, e.g.
-;;; ";;; redefining fact". Several ways to do this. Which is right?
-;;;
-;;; When sending text from a source file to a subprocess, the process-mark can 
-;;; move off the window, so you can lose sight of the process interactions.
-;;; Maybe I should ensure the process mark is in the window when I send
-;;; text to the process? Switch selectable?
-
-(require 'comint)
-;; YOUR .EMACS FILE
-;;=============================================================================
-;; Some suggestions for your .emacs file.
-;;
-;; ; If cmulisp lives in some non-standard directory, you must tell emacs
-;; ; where to get it. This may or may not be necessary.
-;; (setq load-path (cons (expand-file-name "~jones/lib/emacs") load-path))
-;;
-;; ; Autoload cmulisp from file cmulisp.el
-;; (autoload 'cmulisp "cmulisp"
-;;           "Run an inferior Lisp process."
-;;           t)
-;;
-;; ; Define C-c t to run my favorite command in cmulisp mode:
-;; (setq cmulisp-load-hook
-;;       '((lambda () 
-;;           (define-key cmulisp-mode-map "\C-ct" 'favorite-cmd))))
-
-;; Brief Command Documentation:
-;;============================================================================
-;; Comint Mode Commands: (common to cmulisp and all comint-derived modes)
-;;
-;; m-p	    comint-previous-input    	    Cycle backwards in input history
-;; m-n	    comint-next-input  	    	    Cycle forwards
-;; m-c-r   comint-previous-input-matching  Search backwards in input history
-;; return  comint-send-input
-;; c-a     comint-bol                      Beginning of line; skip prompt.
-;; c-d	    comint-delchar-or-maybe-eof	    Delete char unless at end of buff.
-;; c-c c-u comint-kill-input	    	    ^u
-;; c-c c-w backward-kill-word    	    ^w
-;; c-c c-c comint-interrupt-subjob 	    ^c
-;; c-c c-z comint-stop-subjob	    	    ^z
-;; c-c c-\ comint-quit-subjob	    	    ^\
-;; c-c c-o comint-kill-output		    Delete last batch of process output
-;; c-c c-r comint-show-output		    Show last batch of process output
-;;         send-invisible                  Read line w/o echo & send to proc
-;;         comint-continue-subjob	    Useful if you accidentally suspend
-;;					        top-level job.
-;; comint-mode-hook is the comint mode hook.
-
-;; CMU Lisp Mode Commands:
-;; c-m-x   lisp-send-defun     This binding is a gnu convention.
-;; c-c c-l lisp-load-file  	Prompt for file name; tell Lisp to load it.
-;; c-c c-k lisp-compile-file	Prompt for file name; tell Lisp to kompile it.
-;; 	    	    	    	Filename completion is available, of course.
-;;
-;; Additionally, these commands are added to the key bindings of Lisp mode:
-;; c-m-x   lisp-eval-defun         This binding is a gnu convention.
-;; c-c c-e lisp-eval-defun 	    Send the current defun to Lisp process.
-;; c-x c-e lisp-eval-last-sexp     Send the previous sexp to Lisp process.
-;; c-c c-r lisp-eval-region        Send the current region to Lisp process.
-;; c-c c-c lisp-compile-defun      Compile the current defun in Lisp process.
-;; c-c c-z switch-to-lisp          Switch to the Lisp process buffer.
-;; c-c c-l lisp-load-file          (See above. In a Lisp file buffer, default
-;; c-c c-k lisp-compile-file        is to load/compile the current file.)
-;; c-c c-d lisp-describe-sym	    Query Lisp for a symbol's description.
-;; c-c c-a lisp-show-arglist	    Query Lisp for function's arglist.
-;; c-c c-f lisp-show-function-documentation Query Lisp for a function's doc.
-;; c-c c-v lisp-show-variable-documentation Query Lisp for a variable's doc.
-
-;; cmulisp	    	    	    Fires up the Lisp process.
-;; lisp-compile-region     	    Compile all forms in the current region.
-;;
-;; CMU Lisp Mode Variables:
-;; cmulisp-filter-regexp	    Match this => don't get saved on input hist
-;; inferior-lisp-program   	    Name of Lisp program run-lisp executes
-;; inferior-lisp-load-command	    Customises lisp-load-file
-;; cmulisp-mode-hook  	    
-;; inferior-lisp-prompt	    Initialises comint-prompt-regexp.
-;;				    Backwards compatibility.
-;; lisp-source-modes               Anything loaded into a buffer that's in
-;;                                 one of these modes is considered Lisp 
-;;                                 source by lisp-load/compile-file.
-
-;;; Code:
-
-(require 'comint)
-
-;;; Read the rest of this file for more information.
-
-
-;;; Code:
-
-(defvar cmulisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'"
-  "*What not to save on inferior Lisp's input history
-Input matching this regexp is not saved on the input history in cmulisp
-mode. Default is whitespace followed by 0 or 1 single-letter :keyword 
-(as in :a, :c, etc.)")
-
-(defvar cmulisp-mode-map nil)
-(cond ((not cmulisp-mode-map)
-       (setq cmulisp-mode-map
-	     (nconc (full-copy-sparse-keymap comint-mode-map)
-		    shared-lisp-mode-map))
-       (define-key cmulisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp)
-       (define-key cmulisp-mode-map "\C-c\C-l" 'lisp-load-file)
-       (define-key cmulisp-mode-map "\C-c\C-k" 'lisp-compile-file)
-       (define-key cmulisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
-       (define-key cmulisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
-       (define-key cmulisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation)
-       (define-key cmulisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)))
-
-;;; These commands augment Lisp mode, so you can process Lisp code in
-;;; the source files.
-(define-key lisp-mode-map "\M-\C-x"  'lisp-eval-defun)     ; Gnu convention
-(define-key lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp) ; Gnu convention
-(define-key lisp-mode-map "\C-c\C-e" 'lisp-eval-defun)
-(define-key lisp-mode-map "\C-c\C-r" 'lisp-eval-region)
-(define-key lisp-mode-map "\C-c\C-c" 'lisp-compile-defun)
-(define-key lisp-mode-map "\C-c\C-z" 'switch-to-lisp)
-(define-key lisp-mode-map "\C-c\C-l" 'lisp-load-file)
-(define-key lisp-mode-map "\C-c\C-k" 'lisp-compile-file)  ; "kompile" file
-(define-key lisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
-(define-key lisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
-(define-key lisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation)
-(define-key lisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)
-
-(defvar cmulisp-buffer)
-
-;;; This function exists for backwards compatibility.
-;;; Previous versions of this package bound commands to C-c <letter>
-;;; bindings, which is not allowed by the gnumacs standard.
-
-(defun cmulisp-install-letter-bindings ()
-  "This function binds many cmulisp commands to C-c <letter> bindings,
-where they are more accessible. C-c <letter> bindings are reserved for the
-user, so these bindings are non-standard. If you want them, you should
-have this function called by the cmulisp-load-hook:
-    (setq cmulisp-load-hook '(cmulisp-install-letter-bindings))
-You can modify this function to install just the bindings you want."
-
-  (define-key lisp-mode-map "\C-ce" 'lisp-eval-defun-and-go)
-  (define-key lisp-mode-map "\C-cr" 'lisp-eval-region-and-go)
-  (define-key lisp-mode-map "\C-cc" 'lisp-compile-defun-and-go)
-  (define-key lisp-mode-map "\C-cz" 'switch-to-lisp)
-  (define-key lisp-mode-map "\C-cl" 'lisp-load-file)
-  (define-key lisp-mode-map "\C-ck" 'lisp-compile-file)
-  (define-key lisp-mode-map "\C-ca" 'lisp-show-arglist)
-  (define-key lisp-mode-map "\C-cd" 'lisp-describe-sym)
-  (define-key lisp-mode-map "\C-cf" 'lisp-show-function-documentation)
-  (define-key lisp-mode-map "\C-cv" 'lisp-show-variable-documentation)
-
-  (define-key cmulisp-mode-map "\C-cl" 'lisp-load-file)
-  (define-key cmulisp-mode-map "\C-ck" 'lisp-compile-file)
-  (define-key cmulisp-mode-map "\C-ca" 'lisp-show-arglist)
-  (define-key cmulisp-mode-map "\C-cd" 'lisp-describe-sym)
-  (define-key cmulisp-mode-map "\C-cf" 'lisp-show-function-documentation)
-  (define-key cmulisp-mode-map "\C-cv" 'lisp-show-variable-documentation))
-
-
-(defvar inferior-lisp-program "lisp"
-  "*Program name for invoking an inferior Lisp with `cmulisp'.")
-
-(defvar inferior-lisp-load-command "(load \"%s\")\n"
-  "*Format-string for building a Lisp expression to load a file.
-This format string should use %s to substitute a file name
-and should result in a Lisp expression that will command the inferior Lisp
-to load that file.  The default works acceptably on most Lisps.
-The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\\n\"
-produces cosmetically superior output for this application,
-but it works only in Common Lisp.")
-
-(defvar inferior-lisp-prompt "^[^> ]*>+:? *"
-  "Regexp to recognise prompts in the inferior Lisp.
-Defaults to \"^[^> ]*>+:? *\", which works pretty good for Lucid, kcl,
-and franz. This variable is used to initialise comint-prompt-regexp in the 
-cmulisp buffer.
-
-More precise choices:
-Lucid Common Lisp: \"^\\(>\\|\\(->\\)+\\) *\"
-franz: \"^\\(->\\|<[0-9]*>:\\) *\"
-kcl: \"^>+ *\"
-
-This is a fine thing to set in your .emacs file.")
-
-(defvar cmulisp-mode-hook '()
-  "*Hook for customising cmulisp mode")
-
-(defun cmulisp-mode () 
-  "Major mode for interacting with an inferior Lisp process.  
-Runs a Lisp interpreter as a subprocess of Emacs, with Lisp I/O through an
-Emacs buffer.  Variable inferior-lisp-program controls which Lisp interpreter
-is run.  Variables inferior-lisp-prompt, cmulisp-filter-regexp and
-inferior-lisp-load-command can customize this mode for different Lisp
-interpreters.
-
-For information on running multiple processes in multiple buffers, see
-documentation for variable cmulisp-buffer.
-
-\\{cmulisp-mode-map}
-
-Customisation: Entry to this mode runs the hooks on comint-mode-hook and
-cmulisp-mode-hook (in that order).
-
-You can send text to the inferior Lisp process from other buffers containing
-Lisp source.  
-    switch-to-lisp switches the current buffer to the Lisp process buffer.
-    lisp-eval-defun sends the current defun to the Lisp process.
-    lisp-compile-defun compiles the current defun.
-    lisp-eval-region sends the current region to the Lisp process.
-    lisp-compile-region compiles the current region.
-
-    Prefixing the lisp-eval/compile-defun/region commands with
-    a \\[universal-argument] causes a switch to the Lisp process buffer after sending
-    the text.
-
-Commands:
-Return after the end of the process' output sends the text from the 
-    end of process to point.
-Return before the end of the process' output copies the sexp ending at point
-    to the end of the process' output, and sends it.
-Delete converts tabs to spaces as it moves back.
-Tab indents for Lisp; with argument, shifts rest
-    of expression rigidly with the current line.
-C-M-q does Tab on each line starting within following expression.
-Paragraphs are separated only by blank lines.  Semicolons start comments.
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it."
-  (interactive)
-  (comint-mode)
-  (setq comint-prompt-regexp inferior-lisp-prompt)
-  (setq major-mode 'cmulisp-mode)
-  (setq mode-name "CMU Lisp")
-  (setq mode-line-process '(": %s"))
-  (lisp-mode-variables t)
-  (use-local-map cmulisp-mode-map)    ;c-c c-k for "kompile" file
-  (setq comint-get-old-input (function lisp-get-old-input))
-  (setq comint-input-filter (function lisp-input-filter))
-  (setq comint-input-sentinel 'ignore)
-  (run-hooks 'cmulisp-mode-hook))
-
-(defun lisp-get-old-input ()
-  "Snarf the sexp ending at point"
-  (save-excursion
-    (let ((end (point)))
-      (backward-sexp)
-      (buffer-substring (point) end))))
-
-(defun lisp-input-filter (str)
-  "Don't save anything matching cmulisp-filter-regexp"
-  (not (string-match cmulisp-filter-regexp str)))
-
-(defun cmulisp (cmd)
-  "Run an inferior Lisp process, input and output via buffer *cmulisp*.
-If there is a process already running in *cmulisp*, just switch to that buffer.
-With argument, allows you to edit the command line (default is value
-of inferior-lisp-program).  Runs the hooks from cmulisp-mode-hook (after the
-comint-mode-hook is run).
-\(Type \\[describe-mode] in the process buffer for a list of commands.)"
-  (interactive (list (if current-prefix-arg
-			 (read-string "Run lisp: " inferior-lisp-program)
-			 inferior-lisp-program)))
-  (if (not (comint-check-proc "*cmulisp*"))
-      (let ((cmdlist (cmulisp-args-to-list cmd)))
-	 (set-buffer (apply (function make-comint) "cmulisp" (car cmdlist) nil
-			    (cdr cmdlist)))
-	 (cmulisp-mode)))
-  (setq cmulisp-buffer "*cmulisp*")
-  (switch-to-buffer "*cmulisp*"))
-
-;;; Break a string up into a list of arguments.
-;;; This will break if you have an argument with whitespace, as in
-;;; string = "-ab +c -x 'you lose'".
-(defun cmulisp-args-to-list (string)
-  (let ((where (string-match "[ \t]" string)))
-    (cond ((null where) (list string))
-	  ((not (= where 0))
-	   (cons (substring string 0 where)
-		 (tea-args-to-list (substring string (+ 1 where)
-					      (length string)))))
-	  (t (let ((pos (string-match "[^ \t]" string)))
-	       (if (null pos)
-		   nil
-		 (cmulisp-args-to-list (substring string pos
-						  (length string)))))))))
-
-(defun lisp-eval-region (start end &optional and-go)
-  "Send the current region to the inferior Lisp process.
-Prefix argument means switch-to-lisp afterwards."
-  (interactive "r\nP")
-  (comint-send-region (cmulisp-proc) start end)
-  (comint-send-string (cmulisp-proc) "\n")
-  (if and-go (switch-to-lisp t)))
-
-(defun lisp-eval-defun (&optional and-go)
-  "Send the current defun to the inferior Lisp process.
-Prefix argument means switch-to-lisp afterwards."
-  (interactive "P")
-  (save-excursion
-    (end-of-defun)
-    (skip-chars-backward " \t\n\r\f") ;  Makes allegro happy
-    (let ((end (point)))
-      (beginning-of-defun)
-      (lisp-eval-region (point) end)))
-  (if and-go (switch-to-lisp t)))
-
-(defun lisp-eval-last-sexp (&optional and-go)
-  "Send the previous sexp to the inferior Lisp process.
-Prefix argument means switch-to-lisp afterwards."
-  (interactive "P")
-  (lisp-eval-region (save-excursion (backward-sexp) (point)) (point) and-go))
-
-;;; Common Lisp COMPILE sux. 
-(defun lisp-compile-region (start end &optional and-go)
-  "Compile the current region in the inferior Lisp process.
-Prefix argument means switch-to-lisp afterwards."
-  (interactive "r\nP")
-  (comint-send-string (cmulisp-proc)
-    (format "(funcall (compile nil `(lambda () (progn 'compile %s))))\n"
-	    (buffer-substring start end)))
-  (if and-go (switch-to-lisp t)))
-			 
-(defun lisp-compile-defun (&optional and-go)
-  "Compile the current defun in the inferior Lisp process.
-Prefix argument means switch-to-lisp afterwards."
-  (interactive "P")
-  (save-excursion
-    (end-of-defun)
-    (skip-chars-backward " \t\n\r\f") ;  Makes allegro happy
-    (let ((e (point)))
-      (beginning-of-defun)
-      (lisp-compile-region (point) e)))
-  (if and-go (switch-to-lisp t)))
-
-(defun switch-to-lisp (eob-p)
-  "Switch to the inferior Lisp process buffer.
-With argument, positions cursor at end of buffer."
-  (interactive "P")
-  (if (get-buffer cmulisp-buffer)
-      (pop-to-buffer cmulisp-buffer)
-      (error "No current process buffer. See variable cmulisp-buffer."))
-  (cond (eob-p
-	 (push-mark)
-	 (goto-char (point-max)))))
-
-
-;;; Now that lisp-compile/eval-defun/region takes an optional prefix arg,
-;;; these commands are redundant. But they are kept around for the user
-;;; to bind if he wishes, for backwards functionality, and because it's
-;;; easier to type C-c e than C-u C-c C-e.
-
-(defun lisp-eval-region-and-go (start end)
-  "Send the current region to the inferior Lisp, 
-and switch to the process buffer."
-  (interactive "r")
-  (lisp-eval-region start end t))
-
-(defun lisp-eval-defun-and-go ()
-  "Send the current defun to the inferior Lisp, 
-and switch to the process buffer."
-  (interactive)
-  (lisp-eval-defun t))
-
-(defun lisp-compile-region-and-go (start end)
-  "Compile the current region in the inferior Lisp, 
-and switch to the process buffer."
-  (interactive "r")
-  (lisp-compile-region start end t))
-
-(defun lisp-compile-defun-and-go ()
-  "Compile the current defun in the inferior Lisp, 
-and switch to the process buffer."
-  (interactive)
-  (lisp-compile-defun t))
-
-;;; A version of the form in H. Shevis' soar-mode.el package. Less robust.
-;(defun lisp-compile-sexp (start end)
-;  "Compile the s-expression bounded by START and END in the inferior lisp.
-;If the sexp isn't a DEFUN form, it is evaluated instead."
-;    (cond ((looking-at "(defun\\s +")
-;	   (goto-char (match-end 0))
-;	   (let ((name-start (point)))
-;	     (forward-sexp 1)
-;	     (process-send-string "cmulisp" (format "(compile '%s #'(lambda "
-;						 (buffer-substring name-start
-;								   (point)))))
-;	   (let ((body-start (point)))
-;	     (goto-char start) (forward-sexp 1) ; Can't use end-of-defun.
-;	     (process-send-region "cmulisp" (buffer-substring body-start (point))))
-;	   (process-send-string "cmulisp" ")\n"))
-;	  (t (lisp-eval-region start end)))))
-;
-;(defun lisp-compile-region (start end)
-;  "Each s-expression in the current region is compiled (if a DEFUN)
-;or evaluated (if not) in the inferior lisp."
-;  (interactive "r")
-;  (save-excursion
-;    (goto-char start) (end-of-defun) (beginning-of-defun) ; error check
-;    (if (< (point) start) (error "region begins in middle of defun"))
-;    (goto-char start)
-;    (let ((s start))
-;      (end-of-defun)
-;      (while (<= (point) end) ; Zip through
-;	(lisp-compile-sexp s (point)) ; compiling up defun-sized chunks.
-;	(setq s (point))
-;	(end-of-defun))
-;      (if (< s end) (lisp-compile-sexp s end)))))
-;;;
-;;; End of HS-style code
-
-
-(defvar lisp-prev-l/c-dir/file nil
-  "Saves the (directory . file) pair used in the last lisp-load-file or
-lisp-compile-file command. Used for determining the default in the 
-next one.")
-
-(defvar lisp-source-modes '(lisp-mode)
-  "*Used to determine if a buffer contains Lisp source code.
-If it's loaded into a buffer that is in one of these major modes, it's
-considered a Lisp source file by lisp-load-file and lisp-compile-file.
-Used by these commands to determine defaults.")
-
-(defun lisp-load-file (file-name)
-  "Load a Lisp file into the inferior Lisp process."
-  (interactive (comint-get-source "Load Lisp file: " lisp-prev-l/c-dir/file
-				  lisp-source-modes nil)) ; NIL because LOAD
-                                                   ; doesn't need an exact name
-  (comint-check-source file-name) ; Check to see if buffer needs saved.
-  (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
-				     (file-name-nondirectory file-name)))
-  (comint-send-string (cmulisp-proc)
-		      (format inferior-lisp-load-command file-name))
-  (switch-to-lisp t))
-
-
-(defun lisp-compile-file (file-name)
-  "Compile a Lisp file in the inferior Lisp process."
-  (interactive (comint-get-source "Compile Lisp file: " lisp-prev-l/c-dir/file
-				  lisp-source-modes nil)) ; NIL = don't need
-                                                          ; suffix .lisp
-  (comint-check-source file-name) ; Check to see if buffer needs saved.
-  (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
-				     (file-name-nondirectory file-name)))
-  (comint-send-string (cmulisp-proc) (concat "(compile-file \""
-					     file-name
-					     "\"\)\n"))
-  (switch-to-lisp t))
-
-
-
-;;; Documentation functions: function doc, var doc, arglist, and
-;;; describe symbol.
-;;; ===========================================================================
-
-;;; Command strings
-;;; ===============
-
-(defvar lisp-function-doc-command
-  "(let ((fn '%s))
-     (format t \"Documentation for ~a:~&~a\"
-	     fn (documentation fn 'function))
-     (values))\n"
-  "Command to query inferior Lisp for a function's documentation.")
-
-(defvar lisp-var-doc-command
-  "(let ((v '%s))
-     (format t \"Documentation for ~a:~&~a\"
-	     v (documentation v 'variable))
-     (values))\n"
-  "Command to query inferior Lisp for a variable's documentation.")
-
-(defvar lisp-arglist-command
-  "(let ((fn '%s))
-     (format t \"Arglist for ~a: ~a\" fn (arglist fn))
-     (values))\n"
-  "Command to query inferior Lisp for a function's arglist.")
-
-(defvar lisp-describe-sym-command
-  "(describe '%s)\n"
-  "Command to query inferior Lisp for a variable's documentation.")
-
-
-;;; Ancillary functions
-;;; ===================
-
-;;; Reads a string from the user.
-(defun lisp-symprompt (prompt default)
-  (list (let* ((prompt (if default
-			   (format "%s (default %s): " prompt default)
-			   (concat prompt ": ")))
-	       (ans (read-string prompt)))
-	  (if (zerop (length ans)) default ans))))
-
-
-;;; Adapted from function-called-at-point in help.el.
-(defun lisp-fn-called-at-pt ()
-  "Returns the name of the function called in the current call.
-Nil if it can't find one."
-  (condition-case nil
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
-	  (backward-up-list 1)
-	  (forward-char 1)
-	  (let ((obj (read (current-buffer))))
-	    (and (symbolp obj) obj))))
-    (error nil)))
-
-
-;;; Adapted from variable-at-point in help.el.
-(defun lisp-var-at-pt ()
-  (condition-case ()
-      (save-excursion
-	(forward-sexp -1)
-	(skip-chars-forward "'")
-	(let ((obj (read (current-buffer))))
-	  (and (symbolp obj) obj)))
-    (error nil)))
-
-
-;;; Documentation functions: fn and var doc, arglist, and symbol describe.
-;;; ======================================================================
-
-(defun lisp-show-function-documentation (fn)
-  "Send a command to the inferior Lisp to give documentation for function FN.
-See variable lisp-function-doc-command."
-  (interactive (lisp-symprompt "Function doc" (lisp-fn-called-at-pt)))
-  (comint-proc-query (cmulisp-proc) (format lisp-function-doc-command fn)))
-
-(defun lisp-show-variable-documentation (var)
-  "Send a command to the inferior Lisp to give documentation for function FN.
-See variable lisp-var-doc-command."
-  (interactive (lisp-symprompt "Variable doc" (lisp-var-at-pt)))
-  (comint-proc-query (cmulisp-proc) (format lisp-var-doc-command var)))
-
-(defun lisp-show-arglist (fn)
-  "Sends an query to the inferior Lisp for the arglist for function FN.
-See variable lisp-arglist-command."
-  (interactive (lisp-symprompt "Arglist" (lisp-fn-called-at-pt)))
-  (comint-proc-query (cmulisp-proc) (format lisp-arglist-command fn)))
-
-(defun lisp-describe-sym (sym)
-  "Send a command to the inferior Lisp to describe symbol SYM.
-See variable lisp-describe-sym-command."
-  (interactive (lisp-symprompt "Describe" (lisp-var-at-pt)))
-  (comint-proc-query (cmulisp-proc) (format lisp-describe-sym-command sym)))
-
-
-(defvar cmulisp-buffer nil "*The current cmulisp process buffer.
-
-MULTIPLE PROCESS SUPPORT
-===========================================================================
-Cmulisp.el supports, in a fairly simple fashion, running multiple Lisp
-processes. To run multiple Lisp processes, you start the first up with
-\\[cmulisp]. It will be in a buffer named *cmulisp*. Rename this buffer
-with \\[rename-buffer]. You may now start up a new process with another
-\\[cmulisp]. It will be in a new buffer, named *cmulisp*. You can
-switch between the different process buffers with \\[switch-to-buffer].
-
-Commands that send text from source buffers to Lisp processes --
-like lisp-eval-defun or lisp-show-arglist -- have to choose a process
-to send to, when you have more than one Lisp process around. This
-is determined by the global variable cmulisp-buffer. Suppose you
-have three inferior lisps running:
-    Buffer	Process
-    foo		cmulisp
-    bar		cmulisp<2>
-    *cmulisp*   cmulisp<3>
-If you do a \\[lisp-eval-defun] command on some Lisp source code, 
-what process do you send it to?
-
-- If you're in a process buffer (foo, bar, or *cmulisp*), 
-  you send it to that process.
-- If you're in some other buffer (e.g., a source file), you
-  send it to the process attached to buffer cmulisp-buffer.
-This process selection is performed by function cmulisp-proc.
-
-Whenever \\[cmulisp] fires up a new process, it resets cmulisp-buffer
-to be the new process's buffer. If you only run one process, this will
-do the right thing. If you run multiple processes, you can change
-cmulisp-buffer to another process buffer with \\[set-variable].
-
-More sophisticated approaches are, of course, possible. If you find yourself
-needing to switch back and forth between multiple processes frequently,
-you may wish to consider ilisp.el, a larger, more sophisticated package
-for running inferior Lisp processes. The approach taken here is for a
-minimal, simple implementation. Feel free to extend it.")
-
-(defun cmulisp-proc ()
-  "Returns the current cmulisp process. See variable cmulisp-buffer."
-  (let ((proc (get-buffer-process (if (eq major-mode 'inferior-lisp-mode)
-				      (current-buffer)
-				      cmulisp-buffer))))
-    (or proc
-	(error "No current process. See variable cmulisp-buffer"))))
-
-
-;;; Do the user's customisation...
-;;;===============================
-(defvar cmulisp-load-hook nil
-  "This hook is run when cmulisp is loaded in.
-This is a good place to put keybindings.")
-	
-(run-hooks 'cmulisp-load-hook)
-
-;;; CHANGE LOG
-;;; ===========================================================================
-;;; 5/24/90 Olin
-;;; - Split cmulisp and cmushell modes into separate files. 
-;;;   Not only is this a good idea, it's apparently the way it'll be rel 19.
-;;; - Upgraded process sends to use comint-send-string instead of
-;;;   process-send-string.
-;;; - Explicit references to process "cmulisp" have been replaced with
-;;;   (cmulisp-proc). This allows better handling of multiple process bufs.
-;;; - Added process query and var/function/symbol documentation
-;;;   commands. Based on code written by Douglas Roberts.
-;;; - Added lisp-eval-last-sexp, bound to C-x C-e.
-;;;
-;;; 9/20/90 Olin
-;;; Added a save-restriction to lisp-fn-called-at-pt. This bug and fix
-;;; reported by Lennart Staflin.
-;;;
-;;; 3/12/90 Olin
-;;; - lisp-load-file and lisp-compile-file no longer switch-to-lisp.
-;;;   Tale suggested this.
-;;; - Reversed this decision 7/15/91. You need the visual feedback.
-;;;
-;;; 7/25/91 Olin
-;;; Changed all keybindings of the form C-c <letter>. These are
-;;; supposed to be reserved for the user to bind. This affected
-;;; mainly the compile/eval-defun/region[-and-go] commands.
-;;; This was painful, but necessary to adhere to the gnumacs standard.
-;;; For some backwards compatibility, see the 
-;;;     cmulisp-install-letter-bindings
-;;; function.
-;;;
-;;; 8/2/91 Olin
-;;; - The lisp-compile/eval-defun/region commands now take a prefix arg,
-;;;   which means switch-to-lisp after sending the text to the Lisp process.
-;;;   This obsoletes all the -and-go commands. The -and-go commands are
-;;;   kept around for historical reasons, and because the user can bind
-;;;   them to key sequences shorter than C-u C-c C-<letter>.
-;;; - If M-x cmulisp is invoked with a prefix arg, it allows you to
-;;;   edit the command line.
-
-(provide 'cmulisp)
-
-;;; cmulisp.el ends here
diff --git a/lisp/=custom.el b/lisp/=custom.el
deleted file mode 100644
index e747264583c..00000000000
--- a/lisp/=custom.el
+++ /dev/null
@@ -1,2472 +0,0 @@
-;;; custom.el --- User friendly customization support.
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Keywords: help
-;; Version: 0.5
-
-;; 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:
-
-;; WARNING: This package is still under construction and not all of
-;; the features below are implemented.
-;;
-;; This package provides a framework for adding user friendly
-;; customization support to Emacs.  Having to do customization by
-;; editing a text file in some arcane syntax is user hostile in the
-;; extreme, and to most users emacs lisp definitely count as arcane.
-;;
-;; The intent is that authors of emacs lisp packages declare the
-;; variables intended for user customization with `custom-declare'.
-;; Custom can then automatically generate a customization buffer with
-;; `custom-buffer-create' where the user can edit the package
-;; variables in a simple and intuitive way, as well as a menu with
-;; `custom-menu-create' where he can set the more commonly used
-;; variables interactively.
-;;
-;; It is also possible to use custom for modifying the properties of
-;; other objects than the package itself, by specifying extra optional
-;; arguments to `custom-buffer-create'.
-;;
-;; Custom is inspired by OPEN LOOK property windows.
-
-;;; Todo:  
-;;
-;; - Toggle documentation in three states `none', `one-line', `full'.
-;; - Function to generate an XEmacs menu from a CUSTOM.
-;; - Write TeXinfo documentation.
-;; - Make it possible to hide sections by clicking at the level.
-;; - Declare AUC TeX variables.
-;; - Declare (ding) Gnus variables.
-;; - Declare Emacs variables.
-;; - Implement remaining types.
-;; - XEmacs port.
-;; - Allow `URL', `info', and internal hypertext buttons.
-;; - Support meta-variables and goal directed customization.
-;; - Make it easy to declare custom types independently.
-;; - Make it possible to declare default value and type for a single
-;;   variable, storing the data in a symbol property.
-;; - Syntactic sugar for CUSTOM declarations.
-;; - Use W3 for variable documentation.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl))
-
-;;; Compatibility:
-
-(defun custom-xmas-add-text-properties (start end props &optional object)
-  (add-text-properties start end props object)
-  (put-text-property start end 'start-open t object)
-  (put-text-property start end 'end-open t object))
-
-(defun custom-xmas-put-text-property (start end prop value &optional object)
-  (put-text-property start end prop value object)
-  (put-text-property start end 'start-open t object)
-  (put-text-property start end 'end-open t object))
-
-(defun custom-xmas-extent-start-open ()
-  (map-extents (lambda (extent arg)
-		 (set-extent-property extent 'start-open t))
-	       nil (point) (min (1+ (point)) (point-max))))
-		  
-(if (string-match "XEmacs\\|Lucid" emacs-version)
-    (progn
-      (fset 'custom-add-text-properties 'custom-xmas-add-text-properties)
-      (fset 'custom-put-text-property 'custom-xmas-put-text-property)
-      (fset 'custom-extent-start-open 'custom-xmas-extent-start-open)
-      (fset 'custom-set-text-properties
-	    (if (fboundp 'set-text-properties)
-		'set-text-properties))
-      (fset 'custom-buffer-substring-no-properties
-	    (if (fboundp 'buffer-substring-no-properties)
-		'buffer-substring-no-properties
-	      'custom-xmas-buffer-substring-no-properties)))
-  (fset 'custom-add-text-properties 'add-text-properties)
-  (fset 'custom-put-text-property 'put-text-property)
-  (fset 'custom-extent-start-open 'ignore)
-  (fset 'custom-set-text-properties 'set-text-properties)
-  (fset 'custom-buffer-substring-no-properties 
-	'buffer-substring-no-properties))
-
-(defun custom-xmas-buffer-substring-no-properties (beg end)
-  "Return the text from BEG to END, without text properties, as a string."
-  (let ((string (buffer-substring beg end)))
-    (custom-set-text-properties 0 (length string) nil string)
-    string))
-
-(or (fboundp 'add-to-list)
-    ;; Introduced in Emacs 19.29.
-    (defun add-to-list (list-var element)
-      "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
-If you want to use `add-to-list' on a variable that is not defined
-until a certain package is loaded, you should put the call to `add-to-list'
-into a hook function that will be run only after loading the package.
-`eval-after-load' provides one way to do this.  In some cases
-other hooks, such as major mode hooks, can do the job."
-      (or (member element (symbol-value list-var))
-	  (set list-var (cons element (symbol-value list-var))))))
-
-(or (fboundp 'plist-get)
-    ;; Introduced in Emacs 19.29.
-    (defun plist-get (plist prop)
-      "Extract a value from a property list.
-PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2...).  This function returns the value
-corresponding to the given PROP, or nil if PROP is not
-one of the properties on the list."
-      (let (result)
-	(while plist
-	  (if (eq (car plist) prop)
-	      (setq result (car (cdr plist))
-		    plist nil)
-	    (set plist (cdr (cdr plist)))))
-	result)))
-
-(or (fboundp 'plist-put)
-    ;; Introduced in Emacs 19.29.
-    (defun plist-put (plist prop val)    
-      "Change value in PLIST of PROP to VAL.
-PLIST is a property list, which is a list of the form
-\(PROP1 VALUE1 PROP2 VALUE2 ...).  PROP is a symbol and VAL is any object.
-If PROP is already a property on the list, its value is set to VAL,
-otherwise the new PROP VAL pair is added.  The new plist is returned;
-use `(setq x (plist-put x prop val))' to be sure to use the new value.
-The PLIST is modified by side effects."
-      (if (null plist)
-	  (list prop val)
-	(let ((current plist))
-	  (while current
-	    (cond ((eq (car current) prop)
-		   (setcar (cdr current) val)
-		   (setq current nil))
-		  ((null (cdr (cdr current)))
-		   (setcdr (cdr current) (list prop val))
-		   (setq current nil))
-		  (t
-		   (setq current (cdr (cdr current)))))))
-	plist)))
-
-(or (fboundp 'match-string)
-    ;; Introduced in Emacs 19.29.
-    (defun match-string (num &optional string)
-  "Return string of text matched by last search.
-NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
-Zero means the entire text matched by the whole regexp or whole string.
-STRING should be given if the last search was by `string-match' on STRING."
-  (if (match-beginning num)
-      (if string
-	  (substring string (match-beginning num) (match-end num))
-	(buffer-substring (match-beginning num) (match-end num))))))
-
-(or (fboundp 'facep)
-    ;; Introduced in Emacs 19.29.
-    (defun facep (x)
-      "Return t if X is a face name or an internal face vector."
-      (and (or (and (fboundp 'internal-facep) (internal-facep x))
-	       (and 
-		(symbolp x) 
-		(assq x (and (boundp 'global-face-data) global-face-data))))
-	   t)))
-
-;; XEmacs and Emacs 19.29 facep does different things.
-(if (fboundp 'find-face)
-    (fset 'custom-facep 'find-face)
-  (fset 'custom-facep 'facep))
-
-(if (custom-facep 'underline)
-    ()
-  ;; No underline face in XEmacs 19.12.
-  (and (fboundp 'make-face)
-       (funcall (intern "make-face") 'underline))
-  ;; Must avoid calling set-face-underline-p directly, because it
-  ;; is a defsubst in emacs19, and will make the .elc files non
-  ;; portable!
-  (or (and (fboundp 'face-differs-from-default-p)
-	   (face-differs-from-default-p 'underline))
-      (and (fboundp 'set-face-underline-p)
-	   (funcall 'set-face-underline-p 'underline t))))
-
-(defun custom-xmas-set-text-properties (start end props &optional buffer)
-  (if (null buffer)
-      (if props
-	  (while props
-	    (custom-put-text-property 
-	     start end (car props) (nth 1 props) buffer)
-	    (setq props (nthcdr 2 props)))
-	(remove-text-properties start end ()))))
-
-(or (fboundp 'event-point)
-    ;; Missing in Emacs 19.29.
-    (defun event-point (event)
-      "Return the character position of the given mouse-motion, button-press,
-or button-release event.  If the event did not occur over a window, or did
-not occur over text, then this returns nil.  Otherwise, it returns an index
-into the buffer visible in the event's window."
-      (posn-point (event-start event))))
-
-(eval-when-compile
-  (defvar x-colors nil)
-  (defvar custom-button-face nil)
-  (defvar custom-field-uninitialized-face nil)
-  (defvar custom-field-invalid-face nil)
-  (defvar custom-field-modified-face nil)
-  (defvar custom-field-face nil)
-  (defvar custom-mouse-face nil)
-  (defvar custom-field-active-face nil))
-
-;; We can't easily check for a working intangible.
-(defconst intangible (if (and (boundp 'emacs-minor-version)
-			      (or (> emacs-major-version 19)
-				  (and (> emacs-major-version 18)
-				       (> emacs-minor-version 28))))
-			 (setq intangible 'intangible)
-		       (setq intangible 'intangible-if-it-had-been-working))
-  "The symbol making text intangible.")
-
-(defconst rear-nonsticky (if (string-match "XEmacs" emacs-version)
-			     'end-open
-			   'rear-nonsticky)
-  "The symbol making text properties non-sticky in the rear end.")
-
-(defconst front-sticky (if (string-match "XEmacs" emacs-version)
-			   'front-closed
-			 'front-sticky)
-  "The symbol making text properties sticky in the front.")
-
-(defconst mouse-face (if (string-match "XEmacs" emacs-version)
-			 'highlight
-		       'mouse-face)
-  "Symbol used for highlighting text under mouse.")
-
-;; Put it in the Help menu, if possible.
-(if (string-match "XEmacs" emacs-version)
-    (if (featurep 'menubar)
-	;; XEmacs (disabled because it doesn't work)
-	(and current-menubar
-	     (add-menu-item '("Help") "Customize..." 'customize t)))
-  ;; Emacs 19.28 and earlier
-  (global-set-key [ menu-bar help customize ]
-		  '("Customize..." . customize))
-  ;; Emacs 19.29 and later
-  (global-set-key [ menu-bar help-menu customize ] 
-		  '("Customize..." . customize)))
-
-;; XEmacs popup-menu stolen from w3.el.
-(defun custom-x-really-popup-menu (pos title menudesc)
-  "My hacked up function to do a blocking popup menu..."
-  (let ((echo-keystrokes 0)
-	event menu)
-    (while menudesc
-      (setq menu (cons (vector (car (car menudesc))
-			       (list (car (car menudesc))) t) menu)
-	    menudesc (cdr menudesc)))
-    (setq menu (cons title menu))
-    (popup-menu menu)
-    (catch 'popup-done
-      (while t
-	(setq event (next-command-event event))
-	(cond ((and (misc-user-event-p event) (stringp (car-safe						   (event-object event))))
-	       (throw 'popup-done (event-object event)))
-	      ((and (misc-user-event-p event)
-		    (or (eq (event-object event) 'abort)
-			(eq (event-object event) 'menu-no-selection-hook)))
-	       nil)
-	      ((not (popup-menu-up-p))
-	       (throw 'popup-done nil))
-	      ((button-release-event-p event);; don't beep twice
-	       nil)
-	      (t
-	       (beep)
-	       (message "please make a choice from the menu.")))))))
-
-;;; Categories:
-;;
-;; XEmacs use inheritable extents for the same purpose as Emacs uses
-;; the category text property.
-
-(if (string-match "XEmacs" emacs-version)
-    (progn 
-      ;; XEmacs categories.
-      (defun custom-category-create (name)
-	(set name (make-extent nil nil))
-	"Create a text property category named NAME.")
-
-      (defun custom-category-put (name property value)
-	"In CATEGORY set PROPERTY to VALUE."
-	(set-extent-property (symbol-value name) property value))
-      
-      (defun custom-category-get (name property)
-	"In CATEGORY get PROPERTY."
-	(extent-property (symbol-value name) property))
-      
-      (defun custom-category-set (from to category)
-	"Make text between FROM and TWO have category CATEGORY."
-	(let ((extent (make-extent from to)))
-	  (set-extent-parent extent (symbol-value category)))))
-      
-  ;; Emacs categories.
-  (defun custom-category-create (name)
-    "Create a text property category named NAME."
-    (set name name))
-
-  (defun custom-category-put (name property value)
-    "In CATEGORY set PROPERTY to VALUE."
-    (put name property value))
-
-  (defun custom-category-get (name property)
-    "In CATEGORY get PROPERTY."
-    (get name property))
-
-  (defun custom-category-set (from to category)
-    "Make text between FROM and TWO have category CATEGORY."
-    (custom-put-text-property from to 'category category)))
-
-;;; External Data:
-;; 
-;; The following functions and variables defines the interface for
-;; connecting a CUSTOM with an external entity, by default an emacs
-;; lisp variable.
-
-(defvar custom-external 'default-value
-  "Function returning the external value of NAME.")
-
-(defvar custom-external-set 'set-default
-  "Function setting the external value of NAME to VALUE.")
-
-(defun custom-external (name)
-  "Get the external value associated with NAME."
-  (funcall custom-external name))
-
-(defun custom-external-set (name value)
-  "Set the external value associated with NAME to VALUE."
-  (funcall custom-external-set name value))
-
-(defvar custom-name-fields nil
-  "Alist of custom names and their associated editing field.")
-(make-variable-buffer-local 'custom-name-fields)
-
-(defun custom-name-enter (name field)
-  "Associate NAME with FIELD."
-  (if (null name)
-      ()
-    (custom-assert 'field)
-    (setq custom-name-fields (cons (cons name field) custom-name-fields))))
-
-(defun custom-name-field (name)
-  "The editing field associated with NAME."
-  (cdr (assq name custom-name-fields)))
-
-(defun custom-name-value (name)
-  "The value currently displayed for NAME in the customization buffer."
-  (let* ((field (custom-name-field name))
-	 (custom (custom-field-custom field)))
-    (custom-field-parse field)
-    (funcall (custom-property custom 'export) custom
-	     (car (custom-field-extract custom field)))))
-
-(defvar custom-save 'custom-save
-  "Function that will save current customization buffer.")
-
-;;; Custom Functions:
-;;
-;; The following functions are part of the public interface to the
-;; CUSTOM datastructure.  Each CUSTOM describes a group of variables,
-;; a single variable, or a component of a structured variable.  The
-;; CUSTOM instances are part of two hierarchies, the first is the
-;; `part-of' hierarchy in which each CUSTOM is a component of another
-;; CUSTOM, except for the top level CUSTOM which is contained in
-;; `custom-data'.  The second hierarchy is a `is-a' type hierarchy
-;; where each CUSTOM is a leaf in the hierarchy defined by the `type'
-;; property and `custom-type-properties'.
-
-(defvar custom-file "~/.custom.el"
-  "Name of file with customization information.")
-
-(defconst custom-data
-  '((tag . "Emacs")
-    (doc . "The extensible self-documenting text editor.")
-    (type . group)
-    (data "\n"
-	  ((header . nil)
-	   (compact . t)
-	   (type . group)
-	   (doc . "\
-Press [Save] to save any changes permanently after you are done editing.  
-You can load customization information from other files by editing the
-`File' field and pressing the [Load] button.  When you press [Save] the
-customization information of all files you have loaded, plus any
-changes you might have made manually, will be stored in the file 
-specified by the `File' field.")
-	   (data ((tag . "Load")
-		  (type . button)
-		  (query . custom-load))
-		 ((tag . "Save")
-		  (type . button)
-		  (query . custom-save))
-		 ((name . custom-file)
-		  (default . "~/.custom.el")
-		  (doc . "Name of file with customization information.\n")
-		  (tag . "File")
-		  (type . file))))))
-  "The global customization information.  
-A custom association list.")
-
-(defun custom-declare (path custom)
-  "Declare variables for customization.  
-PATH is a list of tags leading to the place in the customization
-hierarchy the new entry should be added.  CUSTOM is the entry to add."
-  (custom-initialize custom)
-  (let ((current (custom-travel-path custom-data path)))
-    (or (member custom (custom-data current))
-	(nconc (custom-data current) (list custom)))))
-
-(put 'custom-declare 'lisp-indent-hook 1)
-
-(defconst custom-type-properties
-  '((repeat (type . default)
-	    ;; See `custom-match'.
-	    (import . custom-repeat-import)
-	    (eval . custom-repeat-eval)
-	    (quote . custom-repeat-quote)
-	    (accept . custom-repeat-accept)
-	    (extract . custom-repeat-extract)
-	    (validate . custom-repeat-validate)
-	    (insert . custom-repeat-insert)
-	    (match . custom-repeat-match)
-	    (query . custom-repeat-query)
-	    (prefix . "")
-	    (del-tag . "[DEL]")
-	    (add-tag . "[INS]"))
-    (pair (type . group)
-	  ;; A cons-cell.
-	  (accept . custom-pair-accept)
-	  (eval . custom-pair-eval)
-	  (import . custom-pair-import)
-	  (quote . custom-pair-quote)
-	  (valid . (lambda (c d) (consp d)))
-	  (extract . custom-pair-extract))
-    (list (type . group)
-	  ;; A lisp list.
-	  (quote . custom-list-quote)
-	  (valid . (lambda (c d)
-		     (listp d)))
-	  (extract . custom-list-extract))
-    (group (type . default)
-	   ;; See `custom-match'.
-	   (face-tag . nil)
-	   (eval . custom-group-eval)
-	   (import . custom-group-import)
-	   (initialize . custom-group-initialize)
-	   (apply . custom-group-apply)
-	   (reset . custom-group-reset)
-	   (factory-reset . custom-group-factory-reset)
-	   (extract . nil)
-	   (validate . custom-group-validate)
-	   (query . custom-toggle-hide)
-	   (accept . custom-group-accept)
-	   (insert . custom-group-insert)
-	   (find . custom-group-find))
-    (toggle (type . choice)
-	    ;; Booleans.
-	    (data ((type . const)
-		   (tag . "On ")
-		   (default . t))
-		  ((type . const)
-		   (tag . "Off")
-		   (default . nil))))
-    (triggle (type . choice)
-	     ;; On/Off/Default.
-	     (data ((type . const)
-		    (tag . "On ")
-		    (default . t))
-		   ((type . const)
-		    (tag . "Off")
-		    (default . nil))
-		   ((type . const)
-		    (tag . "Def")
-		    (default . custom:asis))))
-    (choice (type . default)
-	    ;; See `custom-match'.
-	    (query . custom-choice-query)
-	    (accept . custom-choice-accept)
-	    (extract . custom-choice-extract)
-	    (validate . custom-choice-validate)
-	    (insert . custom-choice-insert)
-	    (none (tag . "Unknown")
-		  (default . __uninitialized__)
-		  (type . const)))
-    (const (type . default)
-	   ;; A `const' only matches a single lisp value.
-	   (extract . (lambda (c f) (list (custom-default c))))
-	   (validate . (lambda (c f) nil))
-	   (valid . custom-const-valid)
-	   (update . custom-const-update)
-	   (insert . custom-const-insert))
-    (face-doc (type . doc)
-	      ;; A variable containing a face.
-	      (doc . "\
-You can customize the look of Emacs by deciding which faces should be
-used when.  If you push one of the face buttons below, you will be
-given a choice between a number of standard faces.  The name of the
-selected face is shown right after the face button, and it is
-displayed its own face so you can see how it looks.  If you know of
-another standard face not listed and want to use it, you can select
-`Other' and write the name in the editing field.
-
-If none of the standard faces suits you, you can select `Customize' to
-create your own face.  This will make six fields appear under the face
-button.  The `Fg' and `Bg' fields are the foreground and background
-colors for the face, respectively.  You should type the name of the
-color in the field.  You can use any X11 color name.  A list of X11
-color names may be available in the file `/usr/lib/X11/rgb.txt' on
-your system.  The special color name `default' means that the face
-will not change the color of the text.  The `Stipple' field is weird,
-so just ignore it.  The three remaining fields are toggles, which will
-make the text `bold', `italic', or `underline' respectively.  For some
-fonts `bold' or `italic' will not make any visible change."))
-    (face (type . choice)
-	  (eval . custom-face-eval)
-	  (import . custom-face-import)
-	  (data ((tag . "None")
-		 (default . nil)
-		 (type . const))
-		((tag . "Default")
-		 (default . default)
-		 (face . custom-const-face)
-		 (type . const))
-		((tag . "Bold")
-		 (default . bold)
-		 (face . custom-const-face)
-		 (type . const))
-		((tag . "Bold-italic")
-		 (default . bold-italic)
-		 (face . custom-const-face)
-		 (type . const))
-		((tag . "Italic")
-		 (default . italic)
-		 (face . custom-const-face)
-		 (type . const))
-		((tag . "Underline")
-		 (default . underline)
-		 (face . custom-const-face)
-		 (type . const))
-		((tag . "Highlight")
-		 (default . highlight)
-		 (face . custom-const-face)
-		 (type . const))
-		((tag . "Modeline")
-		 (default . modeline)
-		 (face . custom-const-face)
-		 (type . const))
-		((tag . "Region")
-		 (default . region)
-		 (face . custom-const-face)
-		 (type . const))
-		((tag . "Secondary Selection")
-		 (default . secondary-selection)
-		 (face . custom-const-face)
-		 (type . const))
-		((tag . "Customized")
-		 (compact . t)
-		 (face-tag . custom-face-hack)
-		 (eval . custom-face-eval)
-		 (data ((hidden . t)
-			(tag . "")
-			(doc . "\
-Select the properties you want this face to have.")
-			(default . custom-face-lookup)
-			(type . const))
-		       "\n"
-		       ((tag . "Fg")
-			(hidden . t)
-			(default . "default")
-			(width . 20)
-			(type . string))
-		       ((tag . "Bg")
-			(default . "default")
-			(width . 20)
-			(type . string))
-		       ((tag . "Stipple")
-			(default . "default")
-			(width . 20)
-			(type . string))
-		       "\n"
-		       ((tag . "Bold")
-			(default . custom:asis)
-			(type . triggle))
-		       "              "
-		       ((tag . "Italic")
-			(default . custom:asis)
-			(type . triggle))
-		       "             "
-		       ((tag . "Underline")
-			(hidden . t)
-			(default . custom:asis)
-			(type . triggle)))
-		 (default . (custom-face-lookup "default" "default" "default"
-						nil nil nil))
-		 (type . list))
-		((prompt . "Other")
-		 (face . custom-field-value)
-		 (default . __uninitialized__)
-		 (type . symbol))))
-    (file (type . string)
-	  ;; A string containing a file or directory name.
-	  (directory . nil)
-	  (default-file . nil)
-	  (query . custom-file-query))
-    (sexp (type . default)
-	  ;; Any lisp expression.
-	  (width . 40)
-	  (default . (__uninitialized__ . "Uninitialized"))
-	  (read . custom-sexp-read)
-	  (write . custom-sexp-write))
-    (symbol (type . sexp)
-	    ;; A lisp symbol.
-	    (width . 40)
-	    (valid . (lambda (c d) (symbolp d))))
-    (integer (type . sexp)
-	     ;; A lisp integer.
-	     (width . 10)
-	     (valid . (lambda (c d) (integerp d))))
-    (string (type . default)
-	    ;; A lisp string.
-	    (width . 40) 
-	    (valid . (lambda (c d) (stringp d)))
-	    (read . custom-string-read)
-	    (write . custom-string-write))
-    (button (type . default)
-	    ;; Push me.
-	    (accept . ignore)
-	    (extract . nil)
-	    (validate . ignore)
-	    (insert . custom-button-insert))
-    (doc (type . default)
-	 ;; A documentation only entry with no value.
-	 (header . nil)
-	 (reset . ignore)
-	 (extract . nil)
-	 (validate . ignore)
-	 (insert . custom-documentation-insert))
-    (default (width . 20)
-             (valid . (lambda (c v) t))
-	     (insert . custom-default-insert)
-	     (update . custom-default-update)
-	     (query . custom-default-query)
-	     (tag . nil)
-	     (prompt . nil)
-	     (doc . nil)
-	     (header . t)
-	     (padding . ? )
-	     (quote . custom-default-quote)
-	     (eval . (lambda (c v) nil))
-	     (export . custom-default-export)
-	     (import . (lambda (c v) (list v)))
-	     (synchronize . ignore)
-	     (initialize . custom-default-initialize)
-	     (extract . custom-default-extract)
-	     (validate . custom-default-validate)
-	     (apply . custom-default-apply)
-	     (reset . custom-default-reset)
-	     (factory-reset . custom-default-factory-reset)
-	     (accept . custom-default-accept)
-	     (match . custom-default-match)
-	     (name . nil)
-	     (compact . nil)
-	     (hidden . nil)
-	     (face . custom-default-face)
-	     (data . nil)
-	     (calculate . nil)
-	     (default . __uninitialized__)))
-  "Alist of default properties for type symbols.
-The format is `((SYMBOL (PROPERTY . VALUE)... )... )'.")
-
-(defconst custom-local-type-properties nil
-  "Local type properties.
-Entries in this list take precedence over `custom-type-properties'.")
-
-(make-variable-buffer-local 'custom-local-type-properties)
-
-(defconst custom-nil '__uninitialized__
-  "Special value representing an uninitialized field.")
-
-(defconst custom-invalid '__invalid__
-  "Special value representing an invalid field.")
-
-(defconst custom:asis 'custom:asis)
-;; Bad, ugly, and horrible kludge.
-
-(defun custom-property (custom property)
-  "Extract from CUSTOM property PROPERTY."
-  (let ((entry (assq property custom)))
-    (while (null entry)
-      ;; Look in superclass.
-      (let ((type (custom-type custom)))
-	(setq custom (cdr (or (assq type custom-local-type-properties)
-			      (assq type custom-type-properties)))
-	      entry (assq property custom))
-	(custom-assert 'custom)))
-    (cdr entry)))
-
-(defun custom-super (custom property)
-  "Extract from CUSTOM property PROPERTY.  Start with CUSTOM's superclass."
-  (let ((entry nil))
-    (while (null entry)
-      ;; Look in superclass.
-      (let ((type (custom-type custom)))
-	(setq custom (cdr (or (assq type custom-local-type-properties)
-			      (assq type custom-type-properties)))
-	      entry (assq property custom))
-	(custom-assert 'custom)))
-    (cdr entry)))
-
-(defun custom-property-set (custom property value)
-  "Set CUSTOM PROPERTY to VALUE by side effect.
-CUSTOM must have at least one property already."
-  (let ((entry (assq property custom)))
-    (if entry
-	(setcdr entry value)
-      (setcdr custom (cons (cons property value) (cdr custom))))))
-
-(defun custom-type (custom)
-  "Extract `type' from CUSTOM."
-  (cdr (assq 'type custom)))
-
-(defun custom-name (custom)
-  "Extract `name' from CUSTOM."
-  (custom-property custom 'name))
-
-(defun custom-tag (custom)
-  "Extract `tag' from CUSTOM."
-  (custom-property custom 'tag))
-
-(defun custom-face-tag (custom)
-  "Extract `face-tag' from CUSTOM."
-  (custom-property custom 'face-tag))
-
-(defun custom-prompt (custom)
-  "Extract `prompt' from CUSTOM.  
-If none exist, default to `tag' or, failing that, `type'."
-  (or (custom-property custom 'prompt)
-      (custom-property custom 'tag)
-      (capitalize (symbol-name (custom-type custom)))))
-
-(defun custom-default (custom)
-  "Extract `default' from CUSTOM."
-  (let ((value (custom-property custom 'calculate)))
-    (if value
-	(eval value)
-      (custom-property custom 'default))))
-	       
-(defun custom-data (custom)
-  "Extract the `data' from CUSTOM."
-  (custom-property custom 'data))
-
-(defun custom-documentation (custom)
-  "Extract `doc' from CUSTOM."
-  (custom-property custom 'doc))
-
-(defun custom-width (custom)
-  "Extract `width' from CUSTOM."
-  (custom-property custom 'width))
-
-(defun custom-compact (custom)
-  "Extract `compact' from CUSTOM."
-  (custom-property custom 'compact))
-
-(defun custom-padding (custom)
-  "Extract `padding' from CUSTOM."
-  (custom-property custom 'padding))
-
-(defun custom-valid (custom value)
-  "Non-nil if CUSTOM may validly be set to VALUE."
-  (and (not (and (listp value) (eq custom-invalid (car value))))
-       (funcall (custom-property custom 'valid) custom value)))
-
-(defun custom-import (custom value)
-  "Import CUSTOM VALUE from external variable.
-
-This function change VALUE into a form that makes it easier to edit 
-internally.  What the internal form is exactly depends on CUSTOM.  
-The internal form is returned."
-  (if (eq custom-nil value)
-      (list custom-nil)
-    (funcall (custom-property custom 'import) custom value)))
-
-(defun custom-eval (custom value)
-  "Return non-nil if CUSTOM's VALUE needs to be evaluated."
-  (funcall (custom-property custom 'eval) custom value))
-
-(defun custom-quote (custom value)
-  "Quote CUSTOM's VALUE if necessary."
-  (funcall (custom-property custom 'quote) custom value))
-
-(defun custom-write (custom value)
-  "Convert CUSTOM VALUE to a string."
-  (cond ((eq value custom-nil) 
-	 "")
-	((and (listp value) (eq (car value) custom-invalid))
-	 (cdr value))
-	(t
-	 (funcall (custom-property custom 'write) custom value))))
-
-(defun custom-read (custom string)
-  "Convert CUSTOM field content STRING into lisp."
-  (condition-case nil
-      (funcall (custom-property custom 'read) custom string)
-    (error (cons custom-invalid string))))
-
-(defun custom-match (custom values)
-  "Match CUSTOM with a list of VALUES.
-
-Return a cons-cell where the car is the sublist of VALUES matching CUSTOM,
-and the cdr is the remaining VALUES.
-
-A CUSTOM is actually a regular expression over the alphabet of lisp
-types.  Most CUSTOM types are just doing a literal match, e.g. the
-`symbol' type matches any lisp symbol.  The exceptions are:
-
-group:    which corresponds to a `(' and `)' group in a regular expression.
-choice:   which corresponds to a group of `|' in a regular expression.
-repeat:   which corresponds to a `*' in a regular expression.
-optional: which corresponds to a `?', and isn't implemented yet."
-  (if (memq values (list custom-nil nil))
-      ;; Nothing matches the uninitialized or empty list.
-      (cons custom-nil nil)
-    (funcall (custom-property custom 'match) custom values)))
-
-(defun custom-initialize (custom)
-  "Initialize `doc' and `default' attributes of CUSTOM."
-  (funcall (custom-property custom 'initialize) custom))
-
-(defun custom-find (custom tag)
-  "Find child in CUSTOM with `tag' TAG."
-  (funcall (custom-property custom 'find) custom tag))
-
-(defun custom-travel-path (custom path)
-  "Find decedent of CUSTOM by looking through PATH."
-  (if (null path)
-      custom
-    (custom-travel-path (custom-find custom (car path)) (cdr path))))
-
-(defun custom-field-extract (custom field)
-  "Extract CUSTOM's value in FIELD."
-  (if (stringp custom)
-      nil
-    (funcall (custom-property (custom-field-custom field) 'extract)
-	     custom field)))
-
-(defun custom-field-validate (custom field)
-  "Validate CUSTOM's value in FIELD.
-Return nil if valid, otherwise return a cons-cell where the car is the
-position of the error, and the cdr is a text describing the error."
-  (if (stringp custom)
-      nil
-    (funcall (custom-property custom 'validate) custom field)))
-
-;;; Field Functions:
-;;
-;; This section defines the public functions for manipulating the
-;; FIELD datatype.  The FIELD instance hold information about a
-;; specific editing field in the customization buffer.
-;;
-;; Each FIELD can be seen as an instantiation of a CUSTOM.
-
-(defvar custom-field-last nil)
-;; Last field containing point.
-(make-variable-buffer-local 'custom-field-last)
-
-(defvar custom-modified-list nil)
-;; List of modified fields.
-(make-variable-buffer-local 'custom-modified-list)
-
-(defun custom-field-create (custom value)
-  "Create a field structure of type CUSTOM containing VALUE.
-
-A field structure is an array [ CUSTOM VALUE ORIGINAL START END ], where
-CUSTOM defines the type of the field, 
-VALUE is the current value of the field,
-ORIGINAL is the original value when created, and
-START and END are markers to the start and end of the field."
-  (vector custom value custom-nil nil nil))
-
-(defun custom-field-custom (field)
-  "Return the `custom' attribute of FIELD."
-  (aref field 0))
-  
-(defun custom-field-value (field)
-  "Return the `value' attribute of FIELD."
-  (aref field 1))
-
-(defun custom-field-original (field)
-  "Return the `original' attribute of FIELD."
-  (aref field 2))
-
-(defun custom-field-start (field)
-  "Return the `start' attribute of FIELD."
-  (aref field 3))
-
-(defun custom-field-end (field)
-  "Return the `end' attribute of FIELD."
-  (aref field 4))
-  
-(defun custom-field-value-set (field value)
-  "Set the `value' attribute of FIELD to VALUE."
-  (aset field 1 value))
-
-(defun custom-field-original-set (field original)
-  "Set the `original' attribute of FIELD to ORIGINAL."
-  (aset field 2 original))
-
-(defun custom-field-move (field start end)
-  "Set the `start'and `end' attributes of FIELD to START and END."
-  (set-marker (or (aref field 3) (aset field 3 (make-marker))) start)
-  (set-marker (or (aref field 4) (aset field 4 (make-marker))) end))
-
-(defun custom-field-query (field)
-  "Query user for content of current field."
-  (funcall (custom-property (custom-field-custom field) 'query) field))
-
-(defun custom-field-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE.
-If optional ORIGINAL is non-nil, consider VALUE for the original value."
-  (let ((inhibit-point-motion-hooks t))
-    (funcall (custom-property (custom-field-custom field) 'accept) 
-	     field value original)))
-
-(defun custom-field-face (field)
-  "The face used for highlighting FIELD."
-  (let ((custom (custom-field-custom field)))
-    (if (stringp custom)
-	nil
-      (let ((face (funcall (custom-property custom 'face) field)))
-	(if (custom-facep face) face nil)))))
-
-(defun custom-field-update (field)
-  "Update the screen appearance of FIELD to correspond with the field's value."
-  (let ((custom (custom-field-custom field)))
-    (if (stringp custom)
-	nil
-      (funcall (custom-property custom 'update) field))))
-
-;;; Types:
-;;
-;; The following functions defines type specific actions.
-
-(defun custom-repeat-eval (custom value)
-  "Non-nil if CUSTOM's VALUE needs to be evaluated."
-  (if (eq value custom-nil)
-      nil
-    (let ((child (custom-data custom))
-	  (found nil))
-      (mapcar (lambda (v) (if (custom-eval child v) (setq found t)))
-	      value))))
-
-(defun custom-repeat-quote (custom value)
-  "A list of CUSTOM's VALUEs quoted."
-  (let ((child (custom-data custom)))
-    (apply 'append (mapcar (lambda (v) (custom-quote child v))
-			   value))))
-
-  
-(defun custom-repeat-import (custom value)
-  "Modify CUSTOM's VALUE to match internal expectations."
-  (let ((child (custom-data custom)))
-    (apply 'append (mapcar (lambda (v) (custom-import child v))
-			   value))))
-
-(defun custom-repeat-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE."
-  (let ((values (copy-sequence (custom-field-value field)))
-	(all (custom-field-value field))
-	(start (custom-field-start field))
-	current new)
-    (if original 
-	(custom-field-original-set field value))
-    (while (consp value)
-      (setq new (car value)
-	    value (cdr value))
-      (if values
-	  ;; Change existing field.
-	  (setq current (car values)
-		values (cdr values))
-	;; Insert new field if series has grown.
-	(goto-char start)
-	(setq current (custom-repeat-insert-entry field))
-	(setq all (custom-insert-before all nil current))
-	(custom-field-value-set field all))
-      (custom-field-accept current new original))
-    (while (consp values)
-      ;; Delete old field if series has scrunk.
-      (setq current (car values)
-	    values (cdr values))
-      (let ((pos (custom-field-start current))
-	    data)
-	(while (not data)
-	  (setq pos (previous-single-property-change pos 'custom-data))
-	  (custom-assert 'pos)
-	  (setq data (get-text-property pos 'custom-data))
-	  (or (and (arrayp data)
-		   (> (length data) 1)
-		   (eq current (aref data 1)))
-	      (setq data nil)))
-	(custom-repeat-delete data)))))
-
-(defun custom-repeat-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (let* ((field (custom-field-create custom nil))
-	 (add-tag (custom-property custom 'add-tag))
-	 (start (make-marker))
-	 (data (vector field nil start nil)))
-    (custom-text-insert "\n")
-    (let ((pos (point)))
-      (custom-text-insert (custom-property custom 'prefix))
-      (custom-tag-insert add-tag 'custom-repeat-add data)
-      (set-marker start pos))
-    (custom-field-move field start (point))
-    (custom-documentation-insert custom)
-    field))
-
-(defun custom-repeat-insert-entry (repeat)
-  "Insert entry at point in the REPEAT field."
-  (let* ((inhibit-point-motion-hooks t)
-	 (inhibit-read-only t)
-	 (before-change-functions nil)
-	 (after-change-functions nil)
-	 (custom (custom-field-custom repeat))
-	 (add-tag (custom-property custom 'add-tag))
-	 (del-tag (custom-property custom 'del-tag))
-	 (start (make-marker))
-	 (end (make-marker))
-	 (data (vector repeat nil start end))
-	 field)
-    (custom-extent-start-open)
-    (insert-before-markers "\n")
-    (backward-char 1)
-    (set-marker start (point))
-    (custom-text-insert " ")
-    (aset data 1 (setq field (custom-insert (custom-data custom) nil)))
-    (custom-text-insert " ")
-    (set-marker end (point))
-    (goto-char start)
-    (custom-text-insert (custom-property custom 'prefix))
-    (custom-tag-insert add-tag 'custom-repeat-add data)
-    (custom-text-insert " ")
-    (custom-tag-insert del-tag 'custom-repeat-delete data)
-    (forward-char 1)
-    field))
-
-(defun custom-repeat-add (data)
-  "Add list entry."
-  (let ((parent (aref data 0))
-	(field (aref data 1))
-	(at (aref data 2))
-	new)
-    (goto-char at)
-    (setq new (custom-repeat-insert-entry parent))
-    (custom-field-value-set parent
-			    (custom-insert-before (custom-field-value parent)
-						  field new))))
-
-(defun custom-repeat-delete (data)
-  "Delete list entry."
-  (let ((inhibit-point-motion-hooks t)
-	(inhibit-read-only t)
-	(before-change-functions nil)
-	(after-change-functions nil)
-	(parent (aref data 0))
-	(field (aref data 1)))
-    (delete-region (aref data 2) (1+ (aref data 3)))
-    (custom-field-untouch (aref data 1))
-    (custom-field-value-set parent 
-			    (delq field (custom-field-value parent)))))
-
-(defun custom-repeat-match (custom values)
-  "Match CUSTOM with VALUES."
-  (let* ((child (custom-data custom))
-	 (match (custom-match child values))
-	 matches)
-    (while (not (eq (car match) custom-nil))
-      (setq matches (cons (car match) matches)
-	    values (cdr match)
-	    match (custom-match child values)))
-    (cons (nreverse matches) values)))
-
-(defun custom-repeat-extract (custom field)
-  "Extract list of children's values."
-  (let ((values (custom-field-value field))
-	(data (custom-data custom))
-	result)
-    (if (eq values custom-nil)
-	()
-      (while values
-	(setq result (append result (custom-field-extract data (car values)))
-	      values (cdr values))))
-    result))
-
-(defun custom-repeat-validate (custom field)
-  "Validate children."
-  (let ((values (custom-field-value field))
-	(data (custom-data custom))
-	result)
-    (if (eq values custom-nil)
-	(setq result (cons (custom-field-start field) "Uninitialized list")))
-    (while (and values (not result))
-      (setq result (custom-field-validate data (car values))
-	    values (cdr values)))
-    result))
-
-(defun custom-pair-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE."
-  (custom-group-accept field (list (car value) (cdr value)) original))
-
-(defun custom-pair-eval (custom value)
-  "Non-nil if CUSTOM's VALUE needs to be evaluated."
-  (custom-group-eval custom (list (car value) (cdr value))))
-
-(defun custom-pair-import (custom value)
-  "Modify CUSTOM's VALUE to match internal expectations."
-  (let ((result (car (custom-group-import custom 
-					  (list (car value) (cdr value))))))
-    (custom-assert '(eq (length result) 2))
-    (list (cons (nth 0 result) (nth 1 result)))))
-
-(defun custom-pair-quote (custom value)
-  "Quote CUSTOM's VALUE if necessary."
-  (if (custom-eval custom value)
-      (let ((v (car (custom-group-quote custom 
-					(list (car value) (cdr value))))))
-	(list (list 'cons (nth 0 v) (nth 1 v))))
-    (custom-default-quote custom value)))
-
-(defun custom-pair-extract (custom field)
-  "Extract cons of children's values."
-  (let ((values (custom-field-value field))
-	(data (custom-data custom))
-	result)
-    (custom-assert '(eq (length values) (length data)))
-    (while values
-      (setq result (append result
-			   (custom-field-extract (car data) (car values)))
-	    data (cdr data)
-	    values (cdr values)))
-    (custom-assert '(null data))
-    (list (cons (nth 0 result) (nth 1 result)))))
-
-(defun custom-list-quote (custom value)
-  "Quote CUSTOM's VALUE if necessary."
-  (if (custom-eval custom value)
-      (let ((v (car (custom-group-quote custom value))))
-	(list (cons 'list v)))
-    (custom-default-quote custom value)))
-
-(defun custom-list-extract (custom field)
-  "Extract list of children's values."
-  (let ((values (custom-field-value field))
-	(data (custom-data custom))
-	result)
-    (custom-assert '(eq (length values) (length data)))
-    (while values
-      (setq result (append result
-			   (custom-field-extract (car data) (car values)))
-	    data (cdr data)
-	    values (cdr values)))
-    (custom-assert '(null data))
-    (list result)))
-
-(defun custom-group-validate (custom field)
-  "Validate children."
-  (let ((values (custom-field-value field))
-	(data (custom-data custom))
-	result)
-    (if (eq values custom-nil)
-	(setq result (cons (custom-field-start field) "Uninitialized list"))
-      (custom-assert '(eq (length values) (length data))))
-    (while (and values (not result))
-      (setq result (custom-field-validate (car data) (car values))
-	    data (cdr data)
-	    values (cdr values)))
-    result))
-
-(defun custom-group-eval (custom value)
-  "Non-nil if CUSTOM's VALUE needs to be evaluated."
-  (let ((found nil))
-    (mapcar (lambda (c)
-	      (or (stringp c)
-		  (let ((match (custom-match c value)))
-		    (if (custom-eval c (car match))
-			(setq found t))
-		    (setq value (cdr match)))))
-	    (custom-data custom))
-    found))
-
-(defun custom-group-quote (custom value)
-  "A list of CUSTOM's VALUE members, quoted."
-  (list (apply 'append 
-	       (mapcar (lambda (c)
-			 (if (stringp c)
-			     ()
-			   (let ((match (custom-match c value)))
-			     (prog1 (custom-quote c (car match))
-			       (setq value (cdr match))))))
-		       (custom-data custom)))))
-
-(defun custom-group-import (custom value)
-  "Modify CUSTOM's VALUE to match internal expectations."
-  (list (apply 'append 
-	       (mapcar (lambda (c)
-			 (if (stringp c)
-			     ()
-			   (let ((match (custom-match c value)))
-			     (prog1 (custom-import c (car match))
-			       (setq value (cdr match))))))
-		       (custom-data custom)))))
-
-(defun custom-group-initialize (custom)
-  "Initialize `doc' and `default' entries in CUSTOM."
-  (if (custom-name custom)
-      (custom-default-initialize custom)
-    (mapcar 'custom-initialize (custom-data custom))))
-
-(defun custom-group-apply (field)
-  "Reset `value' in FIELD to `original'."
-  (let ((custom (custom-field-custom field))
-	(values (custom-field-value field)))
-    (if (custom-name custom)
-	(custom-default-apply field)
-      (mapcar 'custom-field-apply values))))
-
-(defun custom-group-reset (field)
-  "Reset `value' in FIELD to `original'."
-  (let ((custom (custom-field-custom field))
-	(values (custom-field-value field)))
-    (if (custom-name custom)
-	(custom-default-reset field)
-      (mapcar 'custom-field-reset values))))
-
-(defun custom-group-factory-reset (field)
-  "Reset `value' in FIELD to `default'."
-  (let ((custom (custom-field-custom field))
-	(values (custom-field-value field)))
-    (if (custom-name custom)
-	(custom-default-factory-reset field)
-      (mapcar 'custom-field-factory-reset values))))
-
-(defun custom-group-find (custom tag)
-  "Find child in CUSTOM with `tag' TAG."
-  (let ((data (custom-data custom))
-	(result nil))
-    (while (not result)
-      (custom-assert 'data)
-      (if (equal (custom-tag (car data)) tag)
-	  (setq result (car data))
-	(setq data (cdr data))))))
-
-(defun custom-group-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE."
-  (let* ((values (custom-field-value field))
-	 (custom (custom-field-custom field))
-	 (from (custom-field-start field))
-	 (face-tag (custom-face-tag custom))
-	 current)
-    (if face-tag 
-	(custom-put-text-property from (+ from (length (custom-tag custom)))
-			   'face (funcall face-tag field value)))
-    (if original 
-	(custom-field-original-set field value))
-    (while values
-      (setq current (car values)
-	    values (cdr values))
-      (if current
-	  (let* ((custom (custom-field-custom current))
-		 (match (custom-match custom value)))
-	    (setq value (cdr match))
-	    (custom-field-accept current (car match) original))))))
-
-(defun custom-group-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (let* ((field (custom-field-create custom nil))
-	 fields hidden
-	 (from (point))
-	 (compact (custom-compact custom))
-	 (tag (custom-tag custom))
-	 (face-tag (custom-face-tag custom)))
-    (cond (face-tag (custom-text-insert tag))
-	  (tag (custom-tag-insert tag field)))
-    (or compact (custom-documentation-insert custom))
-    (or compact (custom-text-insert "\n"))
-    (let ((data (custom-data custom)))
-      (while data
-	(setq fields (cons (custom-insert (car data) (if level (1+ level)))
-			   fields))
-	(setq hidden (or (stringp (car data))
-			 (custom-property (car data) 'hidden)))
-	(setq data (cdr data))
-	(if data (custom-text-insert (cond (hidden "")
-					   (compact " ")
-					   (t "\n"))))))
-    (if compact (custom-documentation-insert custom))
-    (custom-field-value-set field (nreverse fields))
-    (custom-field-move field from (point))
-    field))
-
-(defun custom-choice-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (let* ((field (custom-field-create custom nil))
-	 (from (point)))
-    (custom-text-insert "lars er en nisse")
-    (custom-field-move field from (point))
-    (custom-documentation-insert custom)
-    (custom-field-reset field)
-    field))
-
-(defun custom-choice-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE."
-  (let ((custom (custom-field-custom field))
-	(start (custom-field-start field))
-	(end (custom-field-end field))
-	(inhibit-read-only t)
-	(before-change-functions nil)
-	(after-change-functions nil)
-	from)
-    (cond (original 
-	   (setq custom-modified-list (delq field custom-modified-list))
-	   (custom-field-original-set field value))
-	  ((equal value (custom-field-original field))
-	   (setq custom-modified-list (delq field custom-modified-list)))
-	  (t
-	   (add-to-list 'custom-modified-list field)))
-    (custom-field-untouch (custom-field-value field))
-    (delete-region start end)
-    (goto-char start)
-    (setq from (point))
-    (insert-before-markers " ")
-    (backward-char 1)
-    (custom-category-set (point) (1+ (point)) 'custom-hidden-properties)
-    (custom-tag-insert (custom-tag custom) field)
-    (custom-text-insert ": ")
-    (let ((data (custom-data custom))
-	  found begin)
-      (while (and data (not found))
-	(if (not (custom-valid (car data) value))
-	    (setq data (cdr data))
-	  (setq found (custom-insert (car data) nil))
-	  (setq data nil)))
-      (if found 
-	  ()
-	(setq begin (point)
-	      found (custom-insert (custom-property custom 'none) nil))
-	(custom-add-text-properties 
-	 begin (point)
-	 (list rear-nonsticky t
-	       'face custom-field-uninitialized-face)))
-      (or original
-	  (custom-field-original-set found (custom-field-original field)))
-      (custom-field-accept found value original)
-      (custom-field-value-set field found)
-      (custom-field-move field from end))))
-
-(defun custom-choice-extract (custom field)
-  "Extract child's value."
-  (let ((value (custom-field-value field)))
-    (custom-field-extract (custom-field-custom value) value)))
-
-(defun custom-choice-validate (custom field)
-  "Validate child's value."
-  (let ((value (custom-field-value field))
-	(custom (custom-field-custom field)))
-    (if (or (eq value custom-nil)
-	    (eq (custom-field-custom value) (custom-property custom 'none)))
-	(cons (custom-field-start field) "Make a choice")
-      (custom-field-validate (custom-field-custom value) value))))
-
-(defun custom-choice-query (field)
-  "Choose a child."
-  (let* ((custom (custom-field-custom field))
-	 (old (custom-field-custom (custom-field-value field)))
-	 (default (custom-prompt old))
-	 (tag (custom-prompt custom))
-	 (data (custom-data custom))
-	 current alist)
-    (if (eq (length data) 2)
-	(custom-field-accept field (custom-default (if (eq (nth 0 data) old)
-						       (nth 1 data)
-						     (nth 0 data))))
-      (while data
-	(setq current (car data)
-	      data (cdr data))
-	(setq alist (cons (cons (custom-prompt current) current) alist)))
-      (let ((answer (cond ((and (fboundp 'button-press-event-p)
-				(fboundp 'popup-menu)
-				(button-press-event-p last-input-event))
-			   (cdr (assoc (car (custom-x-really-popup-menu 
-					     last-input-event tag 
-					     (reverse alist)))
-				       alist)))
-			  ((listp last-input-event)
-			   (x-popup-menu last-input-event
-					 (list tag (cons "" (reverse alist)))))
-			  (t 
-			   (let ((choice (completing-read (concat tag
-								  " (default "
-								  default 
-								  "): ") 
-							  alist nil t)))
-			     (if (or (null choice) (string-equal choice ""))
-				 (setq choice default))
-			     (cdr (assoc choice alist)))))))
-	(if answer
-	    (custom-field-accept field (custom-default answer)))))))
-
-(defun custom-file-query (field)
-  "Prompt for a file name"
-  (let* ((value (custom-field-value field))
-	 (custom (custom-field-custom field))
-	 (valid (custom-valid custom value))
-	 (directory (custom-property custom 'directory))
-	 (default (and (not valid)
-		       (custom-property custom 'default-file)))
-	 (tag (custom-tag custom))
-	 (prompt (if default
-		     (concat tag " (" default "): ")
-		   (concat tag ": "))))
-    (custom-field-accept field 
-			 (if (custom-valid custom value)
-			     (read-file-name prompt 
-					     (if (file-name-absolute-p value)
-						 ""
-					       directory)
-					     default nil value)
-			   (read-file-name prompt directory default)))))
-
-(defun custom-face-eval (custom value)
-  "Return non-nil if CUSTOM's VALUE needs to be evaluated."
-  (not (symbolp value)))
-
-(defun custom-face-import (custom value)
-  "Modify CUSTOM's VALUE to match internal expectations."
-  (let ((name (or (and (facep value) (symbol-name (face-name value)))
-		  (symbol-name value))))
-    (list (if (string-match "\
-custom-face-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)-\\(.*\\)"
-			    name)
-	      (list 'custom-face-lookup 
-		    (match-string 1 name)
-		    (match-string 2 name)
-		    (match-string 3 name)
-		    (intern (match-string 4 name))
-		    (intern (match-string 5 name))
-		    (intern (match-string 6 name)))
-	    value))))
-
-(defun custom-face-lookup (&optional fg bg stipple bold italic underline)
-  "Lookup or create a face with specified attributes."
-  (let ((name (intern (format "custom-face-%s-%s-%s-%S-%S-%S"
-			      (or fg "default")
-			      (or bg "default")
-			      (or stipple "default")
-			      bold italic underline))))
-    (if (and (custom-facep name)
-	     (fboundp 'make-face))
-	()
-      (copy-face 'default name)
-      (when (and fg
-		 (not (string-equal fg "default")))
-	(condition-case ()
-	    (set-face-foreground name fg)
-	  (error nil)))
-      (when (and bg
-		 (not (string-equal bg "default")))
-	(condition-case ()
-	    (set-face-background name bg)
-	  (error nil)))
-      (when (and stipple
-		 (not (string-equal stipple "default"))
-		 (not (eq stipple 'custom:asis))
-		 (fboundp 'set-face-stipple))
-	(set-face-stipple name stipple))
-      (when (and bold
-		 (not (eq bold 'custom:asis)))
-	(condition-case ()
-	    (make-face-bold name)
-	  (error nil)))
-      (when (and italic
-		 (not (eq italic 'custom:asis)))
-	(condition-case ()
-	    (make-face-italic name)
-	  (error nil)))
-      (when (and underline
-		 (not (eq underline 'custom:asis)))
-	(condition-case ()
-	    (set-face-underline-p name t)
-	  (error nil))))
-    name))
-
-(defun custom-face-hack (field value)
-  "Face that should be used for highlighting FIELD containing VALUE."
-  (let* ((custom (custom-field-custom field))
-	 (form (funcall (custom-property custom 'export) custom value))
-	 (face (apply (car form) (cdr form))))
-    (if (custom-facep face) face nil)))
-
-(defun custom-const-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (let* ((field (custom-field-create custom custom-nil))
-	 (face (custom-field-face field))
-	 (from (point)))
-    (custom-text-insert (custom-tag custom))
-    (custom-add-text-properties from (point) 
-			 (list 'face face
-			       rear-nonsticky t))
-    (custom-documentation-insert custom)
-    (custom-field-move field from (point))
-    field))
-
-(defun custom-const-update (field)
-  "Update face of FIELD."
-  (let ((from (custom-field-start field))
-	(custom (custom-field-custom field)))
-    (custom-put-text-property from (+ from (length (custom-tag custom)))
-		       'face (custom-field-face field))))
-
-(defun custom-const-valid (custom value)
-  "Non-nil if CUSTOM can validly have the value VALUE."
-  (equal (custom-default custom) value))
-
-(defun custom-const-face (field)
-  "Face used for a FIELD."
-  (custom-default (custom-field-custom field)))
-
-(defun custom-sexp-read (custom string)
-  "Read from CUSTOM an STRING."
-  (save-match-data
-    (save-excursion
-      (set-buffer (get-buffer-create " *Custom Scratch*"))
-      (erase-buffer)
-      (insert string)
-      (goto-char (point-min))
-      (prog1 (read (current-buffer))
-	(or (looking-at
-	     (concat (regexp-quote (char-to-string
-				    (custom-padding custom)))
-		     "*\\'"))
-	    (error "Junk at end of expression"))))))
-
-(autoload 'pp-to-string "pp")
-
-(defun custom-sexp-write (custom sexp)
-  "Write CUSTOM SEXP as string."
-  (let ((string (prin1-to-string sexp)))
-    (if (<= (length string) (custom-width custom))
-	string
-      (setq string (pp-to-string sexp))
-      (string-match "[ \t\n]*\\'" string)
-      (concat "\n" (substring string 0 (match-beginning 0))))))
-
-(defun custom-string-read (custom string)
-  "Read string by ignoring trailing padding characters."
-  (let ((last (length string))
-	(padding (custom-padding custom)))
-    (while (and (> last 0)
-		(eq (aref string (1- last)) padding))
-      (setq last (1- last)))
-    (substring string 0 last)))
-
-(defun custom-string-write (custom string)
-  "Write raw string."
-  string)
-
-(defun custom-button-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (custom-tag-insert (concat "[" (custom-tag custom) "]") 
-		     (custom-property custom 'query))
-  (custom-documentation-insert custom)
-  nil)
-
-(defun custom-default-export (custom value)
-  ;; Convert CUSTOM's VALUE to external representation.
-  ;; See `custom-import'.
-  (if (custom-eval custom value)
-      (eval (car (custom-quote custom value)))
-    value))
-
-(defun custom-default-quote (custom value)
-  "Quote CUSTOM's VALUE if necessary."
-  (list (if (and (not (custom-eval custom value))
-		 (or (and (symbolp value)
-			  value 
-			  (not (eq t value)))
-		     (and (listp value)
-			  value
-			  (not (memq (car value) '(quote function lambda))))))
-	    (list 'quote value)
-	  value)))
-
-(defun custom-default-initialize (custom)
-  "Initialize `doc' and `default' entries in CUSTOM."
-  (let ((name (custom-name custom)))
-    (if (null name)
-	()
-      (let ((default (custom-default custom))
-	    (doc (custom-documentation custom))
-	    (vdoc (documentation-property name 'variable-documentation t)))
-	(if doc
-	    (or vdoc (put name 'variable-documentation doc))
-	  (if vdoc (custom-property-set custom 'doc vdoc)))
-	(if (eq default custom-nil)
-	    (if (boundp name)
-		(custom-property-set custom 'default (symbol-value name)))
-	  (or (boundp name)
-	      (set name default)))))))
-
-(defun custom-default-insert (custom level)
-  "Insert field for CUSTOM at nesting LEVEL in customization buffer."
-  (let ((field (custom-field-create custom custom-nil))
-	(tag (custom-tag custom)))
-    (if (null tag)
-	()
-      (custom-tag-insert tag field)
-      (custom-text-insert ": "))
-    (custom-field-insert field)
-    (custom-documentation-insert custom)
-    field))
-
-(defun custom-default-accept (field value &optional original)
-  "Store a new value into field FIELD, taking it from VALUE."
-  (if original 
-      (custom-field-original-set field value))
-  (custom-field-value-set field value)
-  (custom-field-update field))
-  
-(defun custom-default-apply (field)
-  "Apply any changes in FIELD since the last apply."
-  (let* ((custom (custom-field-custom field))
-	 (name (custom-name custom)))
-    (if (null name)
-	(error "This field cannot be applied alone"))
-    (custom-external-set name (custom-name-value name))
-    (custom-field-reset field)))
-
-(defun custom-default-reset (field)
-  "Reset content of editing FIELD to `original'."
-  (custom-field-accept field (custom-field-original field) t))
-
-(defun custom-default-factory-reset (field)
-  "Reset content of editing FIELD to `default'."
-  (let* ((custom (custom-field-custom field))
-	 (default (car (custom-import custom (custom-default custom)))))
-    (or (eq default custom-nil)
-	(custom-field-accept field default nil))))
-
-(defun custom-default-query (field)
-  "Prompt for a FIELD"
-  (let* ((custom (custom-field-custom field))
-	 (value (custom-field-value field))
-	 (initial (custom-write custom value))
-	 (prompt (concat (custom-prompt custom) ": ")))
-    (custom-field-accept field 
-			 (custom-read custom 
-				      (if (custom-valid custom value)
-					  (read-string prompt (cons initial 1))
-					(read-string prompt))))))
-
-(defun custom-default-match (custom values)
-  "Match CUSTOM with VALUES."
-  values)
-
-(defun custom-default-extract (custom field)
-  "Extract CUSTOM's content in FIELD."
-  (list (custom-field-value field)))
-
-(defun custom-default-validate (custom field)
-  "Validate FIELD."
-  (let ((value (custom-field-value field))
-	(start (custom-field-start field)))
-    (cond ((eq value custom-nil)
-	   (cons start "Uninitialized field"))
-	  ((and (consp value) (eq (car value) custom-invalid))
-	   (cons start "Unparsable field content"))
-	  ((custom-valid custom value)
-	   nil)
-	  (t
-	   (cons start "Wrong type of field content")))))
-
-(defun custom-default-face (field)
-  "Face used for a FIELD."
-  (let ((value (custom-field-value field)))
-    (cond ((eq value custom-nil)
-	   custom-field-uninitialized-face)
-	  ((not (custom-valid (custom-field-custom field) value))
-	   custom-field-invalid-face)
-	  ((not (equal (custom-field-original field) value))
-	   custom-field-modified-face)
-	  (t
-	   custom-field-face))))
-
-(defun custom-default-update (field)
-  "Update the content of FIELD."
-  (let ((inhibit-point-motion-hooks t)
-	(before-change-functions nil)
-	(after-change-functions nil)
-	(start (custom-field-start field))
-	(end (custom-field-end field)) 
-	(pos (point)))
-    ;; Keep track of how many modified fields we have.
-    (cond ((equal (custom-field-value field) (custom-field-original field))
-	   (setq custom-modified-list (delq field custom-modified-list)))
-	  ((memq field custom-modified-list))
-	  (t
-	   (setq custom-modified-list (cons field custom-modified-list))))
-    ;; Update the field.
-    (goto-char end)
-    (insert-before-markers " ")
-    (delete-region start (1- end))
-    (goto-char start)
-    (custom-field-insert field)
-    (goto-char end)
-    (delete-char 1)
-    (goto-char pos)
-    (and (<= start pos) 
-	 (<= pos end)
-	 (custom-field-enter field))))
-
-;;; Create Buffer:
-;;
-;; Public functions to create a customization buffer and to insert
-;; various forms of text, fields, and buttons in it.
-
-(defun customize ()
-  "Customize GNU Emacs.
-Create a *Customize* buffer with editable customization information
-about GNU Emacs." 
-  (interactive)
-  (custom-buffer-create "*Customize*")
-  (custom-reset-all))
-
-(defun custom-buffer-create (name &optional custom types set get save)
-  "Create a customization buffer named NAME.
-If the optional argument CUSTOM is non-nil, use that as the custom declaration.
-If the optional argument TYPES is non-nil, use that as the local types.
-If the optional argument SET is non-nil, use that to set external data.
-If the optional argument GET is non-nil, use that to get external data.
-If the optional argument SAVE is non-nil, use that for saving changes."
-  (switch-to-buffer name)
-  (buffer-disable-undo (current-buffer))
-  (custom-mode)
-  (setq custom-local-type-properties types)
-  (if (null custom)
-      ()
-    (make-local-variable 'custom-data)
-    (setq custom-data custom))
-  (if (null set)
-      ()
-    (make-local-variable 'custom-external-set)
-    (setq custom-external-set set))
-  (if (null get)
-      ()
-    (make-local-variable 'custom-external)
-    (setq custom-external get))
-  (if (null save)
-      ()
-    (make-local-variable 'custom-save)
-    (setq custom-save save))
-  (let ((inhibit-point-motion-hooks t)
-	(before-change-functions nil)
-	(after-change-functions nil))
-    (erase-buffer)
-    (insert "\n")
-    (goto-char (point-min))
-    (custom-text-insert "This is a customization buffer.\n")
-    (custom-help-insert "\n")
-    (custom-help-button 'custom-forward-field)
-    (custom-help-button 'custom-backward-field)
-    (custom-help-button 'custom-enter-value)
-    (custom-help-button 'custom-field-factory-reset)
-    (custom-help-button 'custom-field-reset)
-    (custom-help-button 'custom-field-apply)
-    (custom-help-button 'custom-save-and-exit)
-    (custom-help-button 'custom-toggle-documentation)
-    (custom-help-insert "\nClick mouse-2 on any button to activate it.\n")
-    (custom-text-insert "\n")
-    (custom-insert custom-data 0)
-    (goto-char (point-min))))
-
-(defun custom-insert (custom level)
-  "Insert custom declaration CUSTOM in current buffer at level LEVEL."
-  (if (stringp custom)
-      (progn 
-	(custom-text-insert custom)
-	nil)
-    (and level (null (custom-property custom 'header))
-	 (setq level nil))
-    (and level 
-	 (> level 0)
-	 (custom-text-insert (concat "\n" (make-string level ?*) " ")))
-    (let ((field (funcall (custom-property custom 'insert) custom level)))
-      (custom-name-enter (custom-name custom) field)
-      field)))
-
-(defun custom-text-insert (text)
-  "Insert TEXT in current buffer." 
-  (insert text))
-
-(defun custom-tag-insert (tag field &optional data)
-  "Insert TAG for FIELD in current buffer."
-  (let ((from (point)))
-    (insert tag)
-    (custom-category-set from (point) 'custom-button-properties)
-    (custom-put-text-property from (point) 'custom-tag field)
-    (if data
-	(custom-add-text-properties from (point) (list 'custom-data data)))))
-
-(defun custom-documentation-insert (custom &rest ignore)
-  "Insert documentation from CUSTOM in current buffer."
-  (let ((doc (custom-documentation custom)))
-    (if (null doc)
-	()
-      (custom-help-insert "\n" doc))))
-
-(defun custom-help-insert (&rest args)
-  "Insert ARGS as documentation text."
-  (let ((from (point)))
-    (apply 'insert args)
-    (custom-category-set from (point) 'custom-documentation-properties)))
-
-(defun custom-help-button (command)
-  "Describe how to execute COMMAND."
-  (let ((from (point)))
-    (insert "`" (key-description (where-is-internal command nil t)) "'")
-    (custom-set-text-properties from (point)
-				(list 'face custom-button-face
-				      mouse-face custom-mouse-face
-				      'custom-jump t ;Make TAB jump over it.
-				      'custom-tag command
-				      'start-open t
-				      'end-open t))
-    (custom-category-set from (point) 'custom-documentation-properties))
-  (custom-help-insert ": " (custom-first-line (documentation command)) "\n"))
-
-;;; Mode:
-;;
-;; The Customization major mode and interactive commands. 
-
-(defvar custom-mode-map nil
-  "Keymap for Custom Mode.")
-(if custom-mode-map
-    nil
-  (setq custom-mode-map (make-sparse-keymap))
-  (define-key custom-mode-map (if (string-match "XEmacs" emacs-version) [button2] [mouse-2]) 'custom-push-button)
-  (define-key custom-mode-map "\t" 'custom-forward-field)
-  (define-key custom-mode-map "\M-\t" 'custom-backward-field)
-  (define-key custom-mode-map "\r" 'custom-enter-value)
-  (define-key custom-mode-map "\C-k" 'custom-kill-line)
-  (define-key custom-mode-map "\C-c\C-r" 'custom-field-reset)
-  (define-key custom-mode-map "\C-c\M-\C-r" 'custom-reset-all)
-  (define-key custom-mode-map "\C-c\C-z" 'custom-field-factory-reset)
-  (define-key custom-mode-map "\C-c\M-\C-z" 'custom-factory-reset-all)
-  (define-key custom-mode-map "\C-c\C-a" 'custom-field-apply)
-  (define-key custom-mode-map "\C-c\M-\C-a" 'custom-apply-all)
-  (define-key custom-mode-map "\C-c\C-c" 'custom-save-and-exit)
-  (define-key custom-mode-map "\C-c\C-d" 'custom-toggle-documentation))
-
-;; C-c keymap ideas: C-a field-beginning, C-e field-end, C-f
-;; forward-field, C-b backward-field, C-n next-field, C-p
-;; previous-field, ? describe-field.
-
-(defun custom-mode ()
-  "Major mode for doing customizations.
-
-\\{custom-mode-map}"
-  (kill-all-local-variables)
-  (setq major-mode 'custom-mode
-	mode-name "Custom")
-  (use-local-map custom-mode-map)
-  (make-local-variable 'before-change-functions)
-  (setq before-change-functions '(custom-before-change))
-  (make-local-variable 'after-change-functions)
-  (setq after-change-functions '(custom-after-change))
-  (if (not (fboundp 'make-local-hook))
-      ;; Emacs 19.28 and earlier.
-      (add-hook 'post-command-hook 
-		(lambda ()
-		  (if (eq major-mode 'custom-mode)
-		      (custom-post-command))))
-    ;; Emacs 19.29.
-    (make-local-hook 'post-command-hook)
-    (add-hook 'post-command-hook 'custom-post-command nil t)))
-
-(defun custom-forward-field (arg)
-  "Move point to the next field or button.
-With optional ARG, move across that many fields."
-  (interactive "p")
-  (while (> arg 0)
-    (let ((next (if (get-text-property (point) 'custom-tag)
-		    (next-single-property-change (point) 'custom-tag)
-		  (point))))
-      (setq next (or (next-single-property-change next 'custom-tag)
-		     (next-single-property-change (point-min) 'custom-tag)))
-      (if next
-	  (goto-char next)
-	(error "No customization fields in this buffer.")))
-    (or (get-text-property (point) 'custom-jump)
-	(setq arg (1- arg))))
-  (while (< arg 0)
-    (let ((previous (if (get-text-property (1- (point)) 'custom-tag)
-			(previous-single-property-change (point) 'custom-tag)
-		      (point))))
-      (setq previous
-	    (or (previous-single-property-change previous 'custom-tag)
-		(previous-single-property-change (point-max) 'custom-tag)))
-      (if previous
-	  (goto-char previous)
-	(error "No customization fields in this buffer.")))
-    (or (get-text-property (1- (point)) 'custom-jump)
-	(setq arg (1+ arg)))))
-
-(defun custom-backward-field (arg)
-  "Move point to the previous field or button.
-With optional ARG, move across that many fields."
-  (interactive "p")
-  (custom-forward-field (- arg)))
-
-(defun custom-toggle-documentation (&optional arg)
-  "Toggle display of documentation text.
-If the optional argument is non-nil, show text iff the argument is positive."
-  (interactive "P")
-  (let ((hide (or (and (null arg) 
-		       (null (custom-category-get 
-			      'custom-documentation-properties 'invisible)))
-		  (<= (prefix-numeric-value arg) 0))))
-    (custom-category-put 'custom-documentation-properties 'invisible hide)
-    (custom-category-put 'custom-documentation-properties intangible hide))
-  (redraw-display))
-
-(defun custom-enter-value (field data)
-  "Enter value for current customization field or push button."
-  (interactive (list (get-text-property (point) 'custom-tag)
-		     (get-text-property (point) 'custom-data)))
-  (cond (data
-	 (funcall field data))
-	((eq field 'custom-enter-value)
-	 (error "Don't be silly"))
-	((and (symbolp field) (fboundp field))
-	 (call-interactively field))
-	(field
-	 (custom-field-query field))
-	(t
-	 (message "Nothing to enter here"))))
-
-(defun custom-kill-line ()
-  "Kill to end of field or end of line, whichever is first."
-  (interactive)
-  (let ((field (get-text-property (point) 'custom-field))
-	(newline (save-excursion (search-forward "\n")))
-	(next (next-single-property-change (point) 'custom-field)))
-    (if (and field (> newline next))
-	(kill-region (point) next)
-      (call-interactively 'kill-line))))
-
-(defun custom-push-button (event)
-  "Activate button below mouse pointer."
-  (interactive "@e")
-  (let* ((pos (event-point event))
-         (field (get-text-property pos 'custom-field))
-         (tag (get-text-property pos 'custom-tag))
-	 (data (get-text-property pos 'custom-data)))
-    (cond (data
-	    (funcall tag data))
-	  ((and (symbolp tag) (fboundp tag))
-	   (call-interactively tag))
-	  (field
-	   (call-interactively (lookup-key global-map (this-command-keys))))
-	  (tag
-	   (custom-enter-value tag data))
-	  (t 
-	   (error "Nothing to click on here.")))))
-
-(defun custom-reset-all ()
-  "Undo any changes since the last apply in all fields."
-  (interactive (and custom-modified-list
-		    (not (y-or-n-p "Discard all changes? "))
-		    (error "Reset aborted")))
-  (let ((all custom-name-fields)
-	current field)
-    (while all
-      (setq current (car all)
-	    field (cdr current)
-	    all (cdr all))
-      (custom-field-reset field))))
-
-(defun custom-field-reset (field)
-  "Undo any changes in FIELD since the last apply."
-  (interactive (list (or (get-text-property (point) 'custom-field)
-			 (get-text-property (point) 'custom-tag))))
-  (if (arrayp field)
-      (let* ((custom (custom-field-custom field))
-	     (name (custom-name custom)))
-	(save-excursion
-	  (if name
-	      (custom-field-original-set 
-	       field (car (custom-import custom (custom-external name)))))
-	  (if (not (custom-valid custom (custom-field-original field)))
-	      (error "This field cannot be reset alone")
-	    (funcall (custom-property custom 'reset) field)
-	    (funcall (custom-property custom 'synchronize) field))))))
-
-(defun custom-factory-reset-all ()
-  "Reset all field to their default values."
-  (interactive (and custom-modified-list
-		    (not (y-or-n-p "Discard all changes? "))
-		    (error "Reset aborted")))
-  (let ((all custom-name-fields)
-	field)
-    (while all
-      (setq field (cdr (car all))
-	    all (cdr all))
-      (custom-field-factory-reset field))))
-
-(defun custom-field-factory-reset (field)
-  "Reset FIELD to its default value."
-  (interactive (list (or (get-text-property (point) 'custom-field)
-			 (get-text-property (point) 'custom-tag))))
-  (if (arrayp field)
-      (save-excursion
-	(funcall (custom-property (custom-field-custom field) 'factory-reset)
-		 field))))
-
-(defun custom-apply-all ()
-  "Apply any changes since the last reset in all fields."
-  (interactive (if custom-modified-list
-		   nil
-		 (error "No changes to apply.")))
-  (custom-field-parse custom-field-last)
-  (let ((all custom-name-fields)
-	field)
-    (while all
-      (setq field (cdr (car all))
-	    all (cdr all))
-      (let ((error (custom-field-validate (custom-field-custom field) field)))
-	(if (null error)
-	    ()
-	  (goto-char (car error))
-	  (error (cdr error))))))
-  (let ((all custom-name-fields)
-	field)
-    (while all
-      (setq field (cdr (car all))
-	    all (cdr all))
-      (custom-field-apply field))))
-
-(defun custom-field-apply (field)
-  "Apply any changes in FIELD since the last apply."
-  (interactive (list (or (get-text-property (point) 'custom-field)
-			 (get-text-property (point) 'custom-tag))))
-  (custom-field-parse custom-field-last)
-  (if (arrayp field)
-      (let* ((custom (custom-field-custom field))
-	     (error (custom-field-validate custom field)))
-	(if error
-	    (error (cdr error)))
-	(funcall (custom-property custom 'apply) field))))
-
-(defun custom-toggle-hide (&rest ignore)
-  "Hide or show entry."
-  (interactive)
-  (error "This button is not yet implemented"))
-
-(defun custom-save-and-exit ()
-  "Save and exit customization buffer."
-  (interactive "@")
-  (save-excursion
-   (funcall custom-save))
-  (kill-buffer (current-buffer)))
-
-(defun custom-save ()
-  "Save customization information."
-  (interactive)
-  (custom-apply-all)
-  (let ((new custom-name-fields))
-    (set-buffer (find-file-noselect custom-file))
-    (goto-char (point-min))
-    (save-excursion
-      (let ((old (condition-case nil
-		     (read (current-buffer))
-		   (end-of-file (append '(setq custom-dummy
-					       'custom-dummy) ())))))
-	(or (eq (car old) 'setq)
-	    (error "Invalid customization file: %s" custom-file))
-	(while new
-	  (let* ((field (cdr (car new)))
-		 (custom (custom-field-custom field))
-		 (value (custom-field-original field))
-		 (default (car (custom-import custom (custom-default custom))))
-		 (name (car (car new))))
-	    (setq new (cdr new))
-	    (custom-assert '(eq name (custom-name custom)))
-	    (if (equal default value)
-		(setcdr old (custom-plist-delq name (cdr old)))
-	      (setcdr old (plist-put (cdr old) name 
-				     (car (custom-quote custom value)))))))
-	(erase-buffer)
-	(insert ";; " custom-file "\
- --- Automatically generated customization information.
-;; 
-;; Feel free to edit by hand, but the entire content should consist of
-;; a single setq.  Any other lisp expressions will confuse the
-;; automatic configuration engine.
-
-\(setq ")
-	(setq old (cdr old))
-	(while old
-	  (prin1 (car old) (current-buffer))
-	  (setq old (cdr old))
-	  (insert " ")
-	  (pp (car old) (current-buffer))
-	  (setq old (cdr old))
-	  (if old (insert "\n      ")))
-	(insert ")\n")
-	(save-buffer)
-	(kill-buffer (current-buffer))))))
-
-(defun custom-load ()
-  "Save customization information."
-  (interactive (and custom-modified-list
-		    (not (equal (list (custom-name-field 'custom-file))
-				custom-modified-list))
-		    (not (y-or-n-p "Discard all changes? "))
-		    (error "Load aborted")))
-  (load-file (custom-name-value 'custom-file))
-  (custom-reset-all))
-
-;;; Field Editing:
-;;
-;; Various internal functions for implementing the direct editing of
-;; fields in the customization buffer.
-
-(defun custom-field-untouch (field)
-  ;; Remove FIELD and its children from `custom-modified-list'.
-  (setq custom-modified-list (delq field custom-modified-list))
-  (if (arrayp field)
-      (let ((value (custom-field-value field)))
-	(cond ((null (custom-data (custom-field-custom field))))
-	      ((arrayp value)
-	       (custom-field-untouch value))
-	      ((listp value)
-	       (mapcar 'custom-field-untouch value))))))
-
-
-(defun custom-field-insert (field)
-  ;; Insert editing FIELD in current buffer.
-  (let ((from (point))
-	(custom (custom-field-custom field))
-	(value (custom-field-value field)))
-    (insert (custom-write custom value))
-    (insert-char (custom-padding custom)
-		 (- (custom-width custom) (- (point) from)))
-    (custom-field-move field from (point))
-    (custom-set-text-properties 
-     from (point)
-     (list 'custom-field field
-	   'custom-tag field
-	   'face (custom-field-face field)
-	   'start-open t
-	   'end-open t))))
-
-(defun custom-field-read (field)
-  ;; Read the screen content of FIELD.
-  (custom-read (custom-field-custom field)
-	       (custom-buffer-substring-no-properties (custom-field-start field)
-					       (custom-field-end field))))
-
-;; Fields are shown in a special `active' face when point is inside
-;; it.  You activate the field by moving point inside (entering) it
-;; and deactivate the field by moving point outside (leaving) it.
-
-(defun custom-field-leave (field)
-  ;; Deactivate FIELD.
-  (let ((before-change-functions nil)
-	(after-change-functions nil))
-    (custom-put-text-property (custom-field-start field) (custom-field-end field)
-		       'face (custom-field-face field))))
-
-(defun custom-field-enter (field)
-  ;; Activate FIELD.
-  (let* ((start (custom-field-start field)) 
-	 (end (custom-field-end field))
-	 (custom (custom-field-custom field))
-	 (padding (custom-padding custom))
-	 (before-change-functions nil)
-	 (after-change-functions nil))
-    (or (eq this-command 'self-insert-command)
-	(let ((pos end))
-	  (while (and (< start pos)
-		      (eq (char-after (1- pos)) padding))
-	    (setq pos (1- pos)))
-	  (if (< pos (point))
-	      (goto-char pos))))
-    (custom-put-text-property start end 'face custom-field-active-face)))
-
-(defun custom-field-resize (field)
-  ;; Resize FIELD after change.
-  (let* ((custom (custom-field-custom field))
-	 (begin (custom-field-start field))
-	 (end (custom-field-end field))
-	 (pos (point))
-	 (padding (custom-padding custom))
-	 (width (custom-width custom))
-	 (size (- end begin)))
-    (cond ((< size width)
-	   (goto-char end)
-	   (if (fboundp 'insert-before-markers-and-inherit)
-	       ;; Emacs 19.
-	       (insert-before-markers-and-inherit
-		(make-string (- width size) padding))
-	     ;; XEmacs:  BUG:  Doesn't work!
-	     (insert-before-markers (make-string (- width size) padding)))
-	   (goto-char pos))
-	  ((> size width)
-	   (let ((start (if (and (< (+ begin width) pos) (<= pos end))
-			    pos
-			  (+ begin width))))
-	     (goto-char end)
-	     (while (and (< start (point)) (= (preceding-char) padding))
-	       (backward-delete-char 1))
-	     (goto-char pos))))))
-
-(defvar custom-field-changed nil)
-;; List of fields changed on the screen but whose VALUE attribute has
-;; not yet been updated to reflect the new screen content.
-(make-variable-buffer-local 'custom-field-changed)
-
-(defun custom-field-parse (field)
-  ;; Parse FIELD content iff changed.
-  (if (memq field custom-field-changed)
-      (progn 
-	(setq custom-field-changed (delq field custom-field-changed))
-	(custom-field-value-set field (custom-field-read field))
-	(custom-field-update field))))
-
-(defun custom-post-command ()
-  ;; Keep track of their active field.
-  (custom-assert '(eq major-mode 'custom-mode))
-  (let ((field (custom-field-property (point))))
-    (if (eq field custom-field-last)
-	(if (memq field custom-field-changed)
-	    (custom-field-resize field))
-      (custom-field-parse custom-field-last)
-      (if custom-field-last
-	  (custom-field-leave custom-field-last))
-      (if field
-	  (custom-field-enter field))
-      (setq custom-field-last field))
-    (set-buffer-modified-p (or custom-modified-list
-			       custom-field-changed))))
-
-(defvar custom-field-was nil)
-;; The custom data before the change.
-(make-variable-buffer-local 'custom-field-was)
-
-(defun custom-before-change (begin end)
-  ;; Check that we the modification is allowed.
-  (if (not (eq major-mode 'custom-mode))
-      (message "Aargh! Why is custom-before-change called here?")
-    (let ((from (custom-field-property begin))
-	  (to (custom-field-property end)))
-      (cond ((or (null from) (null to))
-	     (error "You can only modify the fields"))
-	    ((not (eq from to))
-	     (error "Changes must be limited to a single field."))
-	    (t
-	     (setq custom-field-was from))))))
-
-(defun custom-after-change (begin end length)
-  ;; Keep track of field content.
-  (if (not (eq major-mode 'custom-mode))
-      (message "Aargh! Why is custom-after-change called here?")
-    (let ((field custom-field-was))
-      (custom-assert '(prog1 field (setq custom-field-was nil)))
-      ;; Prevent mixing fields properties.
-      (custom-put-text-property begin end 'custom-field field)
-      ;; Update the field after modification.
-      (if (eq (custom-field-property begin) field)
-	  (let ((field-end (custom-field-end field)))
-	    (if (> end field-end)
-		(set-marker field-end end))
-	    (add-to-list 'custom-field-changed field))
-	;; We deleted the entire field, reinsert it.
-	(custom-assert '(eq begin end))
-	(save-excursion
-	  (goto-char begin)
-	  (custom-field-value-set field
-				  (custom-read (custom-field-custom field) ""))
-	  (custom-field-insert field))))))
-
-(defun custom-field-property (pos)
-  ;; The `custom-field' text property valid for POS.
-  (or (get-text-property pos 'custom-field)
-      (and (not (eq pos (point-min)))
-	   (get-text-property (1- pos) 'custom-field))))
-
-;;; Generic Utilities:
-;;
-;; Some utility functions that are not really specific to custom.
-
-(defun custom-assert (expr)
-  "Assert that EXPR evaluates to non-nil at this point"
-  (or (eval expr)
-      (error "Assertion failed: %S" expr)))
-
-(defun custom-first-line (string)
-  "Return the part of STRING before the first newline."
-  (let ((pos 0)
-	(len (length string)))
-    (while (and (< pos len) (not (eq (aref string pos) ?\n)))
-      (setq pos (1+ pos)))
-    (if (eq pos len)
-	string
-    (substring string 0 pos))))
-
-(defun custom-insert-before (list old new)
-  "In LIST insert before OLD a NEW element."
-  (cond ((null list)
-	 (list new))
-	((null old)
-	 (nconc list (list new)))
-	((eq old (car list))
-	 (cons new list))
-	(t
-	 (let ((list list))
-	   (while (not (eq old (car (cdr list))))
-	     (setq list (cdr list))
-	     (custom-assert '(cdr list)))
-	   (setcdr list (cons new (cdr list))))
-	 list)))
-
-(defun custom-strip-padding (string padding)
-  "Remove padding from STRING."
-  (let ((regexp (concat (regexp-quote (char-to-string padding)) "+")))
-    (while (string-match regexp string)
-      (setq string (concat (substring string 0 (match-beginning 0))
-			   (substring string (match-end 0))))))
-  string)
-
-(defun custom-plist-memq (prop plist)
-  "Return non-nil if PROP is a property of PLIST.  Comparison done with EQ."
-  (let (result)
-    (while plist
-      (if (eq (car plist) prop)
-	  (setq result plist
-		plist nil)
-	(setq plist (cdr (cdr plist)))))
-    result))
-
-(defun custom-plist-delq (prop plist)
-  "Delete property PROP from property list PLIST."
-  (while (eq (car plist) prop)
-    (setq plist (cdr (cdr plist))))
-  (let ((list plist)
-	(next (cdr (cdr plist))))
-    (while next
-      (if (eq (car next) prop)
-	  (progn 
-	    (setq next (cdr (cdr next)))
-	    (setcdr (cdr list) next))
-	(setq list next
-	      next (cdr (cdr next))))))
-  plist)
-
-;;; Meta Customization:
-
-(custom-declare '()
-  '((tag . "Meta Customization")
-    (doc . "Customization of the customization support.")
-    (type . group)
-    (data ((type . face-doc))
-	  ((tag . "Button Face")
-	   (default . bold)
-	   (doc . "Face used for tags in customization buffers.")
-	   (name . custom-button-face)
-	   (synchronize . (lambda (f)
-			    (custom-category-put 'custom-button-properties 
-						 'face custom-button-face)))
-	   (type . face))
-	  ((tag . "Mouse Face")
-	   (default . highlight)
-	   (doc . "\
-Face used when mouse is above a button in customization buffers.")
-	   (name . custom-mouse-face)
-	   (synchronize . (lambda (f)
-			    (custom-category-put 'custom-button-properties 
-						 mouse-face 
-						 custom-mouse-face)))
-	   (type . face))
-	  ((tag . "Field Face")
-	   (default . italic)
-	   (doc . "Face used for customization fields.")
-	   (name . custom-field-face)
-	   (type . face))
-	  ((tag . "Uninitialized Face")
-	   (default . modeline)
-	   (doc . "Face used for uninitialized customization fields.")
-	   (name . custom-field-uninitialized-face)
-	   (type . face))
-	  ((tag . "Invalid Face")
-	   (default . highlight)
-	   (doc . "\
-Face used for customization fields containing invalid data.")
-	   (name . custom-field-invalid-face)
-	   (type . face))
-	  ((tag . "Modified Face")
-	   (default . bold-italic)
-	   (doc . "Face used for modified customization fields.")
-	   (name . custom-field-modified-face)
-	   (type . face))
-	  ((tag . "Active Face")
-	   (default . underline)
-	   (doc . "\
-Face used for customization fields while they are being edited.")
-	   (name . custom-field-active-face)
-	   (type . face)))))
-
-;; custom.el uses two categories.
-
-(custom-category-create 'custom-documentation-properties)
-(custom-category-put 'custom-documentation-properties rear-nonsticky t)
-
-(custom-category-create 'custom-button-properties)
-(custom-category-put 'custom-button-properties 'face custom-button-face)
-(custom-category-put 'custom-button-properties mouse-face custom-mouse-face)
-(custom-category-put 'custom-button-properties rear-nonsticky t)
-
-(custom-category-create 'custom-hidden-properties)
-(custom-category-put 'custom-hidden-properties 'invisible
-		     (not (string-match "XEmacs" emacs-version)))
-(custom-category-put 'custom-hidden-properties intangible t)
-
-(and init-file-user  ; Don't load any init file if -q was used.
-     (file-readable-p custom-file)
-     (load-file custom-file))
-
-(provide 'custom)
-
-;;; custom.el ends here
diff --git a/lisp/=diary-ins.el b/lisp/=diary-ins.el
deleted file mode 100644
index d84bb260670..00000000000
--- a/lisp/=diary-ins.el
+++ /dev/null
@@ -1,251 +0,0 @@
-;;; diary-ins.el --- calendar functions for adding diary entries.
-
-;; Copyright (C) 1990, 1994 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: diary, calendar
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This collection of functions implements the diary insertion features as
-;; described in calendar.el.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'diary-lib)
-
-(defun make-diary-entry (string &optional nonmarking file)
-  "Insert a diary entry STRING which may be NONMARKING in FILE.
-If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
-  (find-file-other-window
-   (substitute-in-file-name (if file file diary-file)))
-  (goto-char (point-max))
-  (insert
-   (if (bolp) "" "\n")
-   (if nonmarking diary-nonmarking-symbol "")
-   string " "))
-
-(defun insert-diary-entry (arg)
-  "Insert a diary entry for the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t)
-                    arg))
-
-(defun insert-weekly-diary-entry (arg)
-  "Insert a weekly diary entry for the day of the week indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (make-diary-entry (calendar-day-name (calendar-cursor-to-date t))
-                    arg))
-
-(defun insert-monthly-diary-entry (arg)
-  "Insert a monthly diary entry for the day of the month indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " * ")
-            '("* " day))))
-    (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
-                      arg)))
-
-(defun insert-yearly-diary-entry (arg)
-  "Insert an annual diary entry for the day of the year indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " monthname)
-            '(monthname " " day))))
-    (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
-                      arg)))
-
-(defun insert-anniversary-diary-entry (arg)
-  "Insert an anniversary diary entry for the date given by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " month " " year)
-            '(month " " day " " year))))
-    (make-diary-entry
-     (format "%s(diary-anniversary %s)"
-             sexp-diary-entry-symbol
-             (calendar-date-string (calendar-cursor-to-date t) nil t))
-     arg)))
-
-(defun insert-block-diary-entry (arg)
-  "Insert a block diary entry for the days between the point and marked date.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " month " " year)
-            '(month " " day " " year)))
-         (cursor (calendar-cursor-to-date t))
-         (mark (or (car calendar-mark-ring)
-                   (error "No mark set in this buffer")))
-         (start)
-         (end))
-    (if (< (calendar-absolute-from-gregorian mark)
-           (calendar-absolute-from-gregorian cursor))
-        (setq start mark
-              end cursor)
-      (setq start cursor
-              end mark))
-    (make-diary-entry
-     (format "%s(diary-block %s %s)"
-      sexp-diary-entry-symbol
-      (calendar-date-string start nil t)
-      (calendar-date-string end nil t))
-     arg)))
-
-(defun insert-cyclic-diary-entry (arg)
-  "Insert a cyclic diary entry starting at the date given by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " month " " year)
-            '(month " " day " " year))))
-    (make-diary-entry
-     (format "%s(diary-cyclic %d %s)"
-             sexp-diary-entry-symbol
-             (calendar-read "Repeat every how many days: "
-                            '(lambda (x) (> x 0)))
-             (calendar-date-string (calendar-cursor-to-date t) nil t))
-     arg)))
-
-(defun insert-hebrew-diary-entry (arg)
-  "Insert a diary entry.
-For the Hebrew date corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-month-name-array
-          calendar-hebrew-month-name-array-leap-year))
-    (make-diary-entry
-     (concat
-      hebrew-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-hebrew-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))
-       nil t))
-     arg)))
-
-(defun insert-monthly-hebrew-diary-entry (arg)
-  "Insert a monthly diary entry.
-For the day of the Hebrew month corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style '(day " * ") '("* " day )))
-         (calendar-month-name-array
-          calendar-hebrew-month-name-array-leap-year))
-    (make-diary-entry
-     (concat
-      hebrew-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-hebrew-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
-     arg)))
-
-(defun insert-yearly-hebrew-diary-entry (arg)
-  "Insert an annual diary entry.
-For the day of the Hebrew year corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " monthname)
-            '(monthname " " day)))
-         (calendar-month-name-array
-          calendar-hebrew-month-name-array-leap-year))
-    (make-diary-entry
-     (concat
-      hebrew-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-hebrew-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
-     arg)))
-
-(defun insert-islamic-diary-entry (arg)
-  "Insert a diary entry.
-For the Islamic date corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-month-name-array calendar-islamic-month-name-array))
-    (make-diary-entry
-     (concat
-      islamic-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-islamic-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))
-       nil t))
-     arg)))
-
-(defun insert-monthly-islamic-diary-entry (arg)
-  "Insert a monthly diary entry.
-For the day of the Islamic month corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style '(day " * ") '("* " day )))
-         (calendar-month-name-array calendar-islamic-month-name-array))
-    (make-diary-entry
-     (concat
-      islamic-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-islamic-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
-     arg)))
-
-(defun insert-yearly-islamic-diary-entry (arg)
-  "Insert an annual diary entry.
-For the day of the Islamic year corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " monthname)
-            '(monthname " " day)))
-         (calendar-month-name-array calendar-islamic-month-name-array))
-    (make-diary-entry
-     (concat
-      islamic-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-islamic-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
-     arg)))
-
-(provide 'diary-ins)
-
-;;; diary-ins.el ends here
diff --git a/lisp/=diary-lib.el b/lisp/=diary-lib.el
deleted file mode 100644
index a78475bc916..00000000000
--- a/lisp/=diary-lib.el
+++ /dev/null
@@ -1,1919 +0,0 @@
-;;; diary-lib.el --- diary functions.
-
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This collection of functions implements the diary features as described
-;; in calendar.el.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'calendar)
-
-;;;###autoload
-(defun diary (&optional arg)
-  "Generate the diary window for ARG days starting with the current date.
-If no argument is provided, the number of days of diary entries is governed
-by the variable `number-of-diary-entries'.  This function is suitable for
-execution in a `.emacs' file."
-  (interactive "P")
-  (let ((d-file (substitute-in-file-name diary-file))
-        (date (calendar-current-date)))
-    (if (and d-file (file-exists-p d-file))
-        (if (file-readable-p d-file)
-            (list-diary-entries
-             date
-             (cond
-              (arg (prefix-numeric-value arg))
-              ((vectorp number-of-diary-entries)
-               (aref number-of-diary-entries (calendar-day-of-week date)))
-              (t number-of-diary-entries)))
-        (error "Your diary file is not readable!"))
-      (error "You don't have a diary file!"))))
-
-(defun view-diary-entries (arg)
-  "Prepare and display a buffer with diary entries.
-Searches the file named in `diary-file' for entries that
-match ARG days starting with the date indicated by the cursor position
-in the displayed three-month calendar."
-  (interactive "p")
-  (let ((d-file (substitute-in-file-name diary-file)))
-    (if (and d-file (file-exists-p d-file))
-        (if (file-readable-p d-file)
-            (list-diary-entries (calendar-cursor-to-date t) arg)
-          (error "Diary file is not readable!"))
-      (error "You don't have a diary file!"))))
-
-(defun view-other-diary-entries (arg diary-file)
-  "Prepare and display buffer of diary entries from an alternative diary file.
-Prompts for a file name and searches that file for entries that match ARG
-days starting with the date indicated by the cursor position in the displayed
-three-month calendar."
-  (interactive
-   (list (cond ((null current-prefix-arg) 1)
-               ((listp current-prefix-arg) (car current-prefix-arg))
-               (t current-prefix-arg))
-         (setq diary-file (read-file-name "Enter diary file name: "
-                                          default-directory nil t))))
-  (view-diary-entries arg))
-
-(autoload 'check-calendar-holidays "holidays"
-  "Check the list of holidays for any that occur on DATE.
-The value returned is a list of strings of relevant holiday descriptions.
-The holidays are those in the list `calendar-holidays'."
-  t)
-
-(autoload 'calendar-holiday-list "holidays"
-  "Form the list of holidays that occur on dates in the calendar window.
-The holidays are those in the list `calendar-holidays'."
-  t)
-
-(autoload 'diary-french-date "cal-french"
-  "French calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-mayan-date "cal-mayan"
-  "Mayan calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry." t)
-
-(autoload 'diary-sunrise-sunset "solar"
-  "Local time of sunrise and sunset as a diary entry."
-  t)
-
-(autoload 'diary-sabbath-candles "solar"
-  "Local time of candle lighting diary entry--applies if date is a Friday.
-No diary entry if there is no sunset on that date."
-  t)
-
-(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table))
-  "The syntax table used when parsing dates in the diary file.
-It is the standard syntax table used in Fundamental mode, but with the
-syntax of `*' changed to be a word constituent.")
-
-(modify-syntax-entry ?* "w" diary-syntax-table)
-
-(defun list-diary-entries (date number)
-  "Create and display a buffer containing the relevant lines in diary-file.
-The arguments are DATE and NUMBER; the entries selected are those
-for NUMBER days starting with date DATE.  The other entries are hidden
-using selective display.
-
-Returns a list of all relevant diary entries found, if any, in order by date.
-The list entries have the form ((month day year) string).  If the variable
-`diary-list-include-blanks' is t, this list includes a dummy diary entry
-\(consisting of the empty string) for a date with no diary entries.
-
-After the list is prepared, the hooks `nongregorian-diary-listing-hook',
-`list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run.
-These hooks have the following distinct roles:
-
-    `nongregorian-diary-listing-hook' can cull dates from the diary
-        and each included file.  Usually used for Hebrew or Islamic
-        diary entries in files.  Applied to *each* file.
-
-    `list-diary-entries-hook' adds or manipulates diary entries from
-        external sources.  Used, for example, to include diary entries
-        from other files or to sort the diary entries.  Invoked *once* only,
-        before the display hook is run.
-
-    `diary-display-hook' does the actual display of information.  If this is
-        nil, simple-diary-display will be used.  Use add-hook to set this to
-        fancy-diary-display, if desired.  If you want no diary display, use
-        add-hook to set this to ignore.
-
-    `diary-hook' is run last.  This can be used for an appointment
-        notification function."
-
-  (if (< 0 number)
-      (let* ((original-date date);; save for possible use in the hooks
-             (old-diary-syntax-table)
-             (diary-entries-list)
-             (date-string (calendar-date-string date))
-             (d-file (substitute-in-file-name diary-file)))
-        (message "Preparing diary...")
-        (save-excursion
-          (let ((diary-buffer (get-file-buffer d-file)))
-            (set-buffer (if diary-buffer
-                            diary-buffer
-                         (find-file-noselect d-file t))))
-          (setq selective-display t)
-          (setq selective-display-ellipses nil)
-          (setq old-diary-syntax-table (syntax-table))
-          (set-syntax-table diary-syntax-table)
-          (unwind-protect
-            (let ((buffer-read-only nil)
-                  (diary-modified (buffer-modified-p))
-                  (mark (regexp-quote diary-nonmarking-symbol)))
-              (goto-char (1- (point-max)))
-              (if (not (looking-at "\^M\\|\n"))
-                  (progn
-                    (forward-char 1)
-                    (insert-string "\^M")))
-              (goto-char (point-min))
-              (if (not (looking-at "\^M\\|\n"))
-                  (insert-string "\^M"))
-              (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
-              (calendar-for-loop i from 1 to number do
-                 (let ((d diary-date-forms)
-                       (month (extract-calendar-month date))
-                       (day (extract-calendar-day date))
-                       (year (extract-calendar-year date))
-                       (entry-found (list-sexp-diary-entries date)))
-                   (while d
-                     (let*
-                          ((date-form (if (equal (car (car d)) 'backup)
-                                          (cdr (car d))
-                                        (car d)))
-                          (backup (equal (car (car d)) 'backup))
-                          (dayname
-                           (concat
-                            (calendar-day-name date) "\\|"
-                            (substring (calendar-day-name date) 0 3) ".?"))
-                          (monthname
-                           (concat
-                            "\\*\\|"
-                            (calendar-month-name month) "\\|"
-                            (substring (calendar-month-name month) 0 3) ".?"))
-                          (month (concat "\\*\\|0*" (int-to-string month)))
-                          (day (concat "\\*\\|0*" (int-to-string day)))
-                          (year
-                           (concat
-                            "\\*\\|0*" (int-to-string year)
-                            (if abbreviated-calendar-year
-                                (concat "\\|" (int-to-string (% year 100)))
-                              "")))
-                          (regexp
-                           (concat
-                            "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
-                            (mapconcat 'eval date-form "\\)\\(")
-                            "\\)"))
-                          (case-fold-search t))
-                       (goto-char (point-min))
-                       (while (re-search-forward regexp nil t)
-                         (if backup (re-search-backward "\\<" nil t))
-                         (if (and (or (char-equal (preceding-char) ?\^M)
-                                      (char-equal (preceding-char) ?\n))
-                                  (not (looking-at " \\|\^I")))
-                             ;;  Diary entry that consists only of date.
-                             (backward-char 1)
-                           ;; Found a nonempty diary entry--make it visible and
-                           ;; add it to the list.
-                           (setq entry-found t)
-                           (let ((entry-start (point))
-                                 (date-start))
-                             (re-search-backward "\^M\\|\n\\|\\`")
-                             (setq date-start (point))
-                             (re-search-forward "\^M\\|\n" nil t 2)
-                             (while (looking-at " \\|\^I")
-                               (re-search-forward "\^M\\|\n" nil t))
-                             (backward-char 1)
-                             (subst-char-in-region date-start
-                                (point) ?\^M ?\n t)
-                             (add-to-diary-list
-                               date (buffer-substring entry-start (point)))))))
-                     (setq d (cdr d)))
-                   (or entry-found
-                       (not diary-list-include-blanks)
-                       (setq diary-entries-list 
-                             (append diary-entries-list
-                                     (list (list date "")))))
-                   (setq date
-                         (calendar-gregorian-from-absolute
-                           (1+ (calendar-absolute-from-gregorian date))))
-                   (setq entry-found nil)))
-              (set-buffer-modified-p diary-modified))
-          (set-syntax-table old-diary-syntax-table))
-        (goto-char (point-min))
-        (run-hooks 'nongregorian-diary-listing-hook
-                   'list-diary-entries-hook)
-        (if diary-display-hook
-            (run-hooks 'diary-display-hook)
-          (simple-diary-display))
-        (run-hooks 'diary-hook)
-        diary-entries-list))))
-
-(defun include-other-diary-files ()
-  "Include the diary entries from other diary files with those of diary-file.
-This function is suitable for use in `list-diary-entries-hook';
-it enables you to use shared diary files together with your own.
-The files included are specified in the diaryfile by lines of this form:
-        #include \"filename\"
-This is recursive; that is, #include directives in diary files thus included
-are obeyed.  You can change the `#include' to some other string by
-changing the variable `diary-include-string'."
-  (goto-char (point-min))
-  (while (re-search-forward
-          (concat
-           "\\(\\`\\|\^M\\|\n\\)"
-           (regexp-quote diary-include-string)
-           " \"\\([^\"]*\\)\"")
-          nil t)
-    (let ((diary-file (substitute-in-file-name
-                       (buffer-substring (match-beginning 2) (match-end 2))))
-          (diary-list-include-blanks nil)
-          (list-diary-entries-hook 'include-other-diary-files)
-          (diary-display-hook 'ignore)
-          (diary-hook nil))
-      (if (file-exists-p diary-file)
-          (if (file-readable-p diary-file)
-              (unwind-protect
-                  (setq diary-entries-list
-                        (append diary-entries-list
-                                (list-diary-entries original-date number)))
-                (kill-buffer (get-file-buffer diary-file)))
-            (beep)
-            (message "Can't read included diary file %s" diary-file)
-            (sleep-for 2))
-        (beep)
-        (message "Can't find included diary file %s" diary-file)
-        (sleep-for 2))))
-    (goto-char (point-min)))
-
-(defun simple-diary-display ()
-  "Display the diary buffer if there are any relevant entries or holidays."
-  (let* ((holiday-list (if holidays-in-diary-buffer
-                           (check-calendar-holidays original-date)))
-         (msg (format "No diary entries for %s %s"
-                      (concat date-string (if holiday-list ":" ""))
-                      (mapconcat 'identity holiday-list "; "))))
-    (if (or (not diary-entries-list)
-            (and (not (cdr diary-entries-list))
-                 (string-equal (car (cdr (car diary-entries-list))) "")))
-        (if (<= (length msg) (frame-width))
-            (message msg)
-          (set-buffer (get-buffer-create holiday-buffer))
-          (setq buffer-read-only nil)
-          (calendar-set-mode-line date-string)
-          (erase-buffer)
-          (insert (mapconcat 'identity holiday-list "\n"))
-          (goto-char (point-min))
-          (set-buffer-modified-p nil)
-          (setq buffer-read-only t)
-          (display-buffer holiday-buffer)
-          (message  "No diary entries for %s" date-string))
-      (calendar-set-mode-line
-       (concat "Diary for " date-string
-               (if holiday-list ": " "")
-               (mapconcat 'identity holiday-list "; ")))
-      (display-buffer (get-file-buffer d-file))
-      (message "Preparing diary...done"))))
-
-(defun fancy-diary-display ()
-  "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
-This function is provided for optional use as the `diary-display-hook'."
-  (save-excursion;; Turn off selective-display in the diary file's buffer.
-    (set-buffer (get-file-buffer (substitute-in-file-name diary-file)))
-    (let ((diary-modified (buffer-modified-p)))
-      (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
-      (setq selective-display nil)
-      (kill-local-variable 'mode-line-format)
-      (set-buffer-modified-p diary-modified)))
-  (if (or (not diary-entries-list)
-          (and (not (cdr diary-entries-list))
-               (string-equal (car (cdr (car diary-entries-list))) "")))
-      (let* ((holiday-list (if holidays-in-diary-buffer
-                               (check-calendar-holidays original-date)))
-             (msg (format "No diary entries for %s %s"
-                          (concat date-string (if holiday-list ":" ""))
-                          (mapconcat 'identity holiday-list "; "))))
-        (if (<= (length msg) (frame-width))
-            (message msg)
-          (set-buffer (get-buffer-create holiday-buffer))
-          (setq buffer-read-only nil)
-          (calendar-set-mode-line date-string)
-          (erase-buffer)
-          (insert (mapconcat 'identity holiday-list "\n"))
-          (goto-char (point-min))
-          (set-buffer-modified-p nil)
-          (setq buffer-read-only t)
-          (display-buffer holiday-buffer)
-          (message  "No diary entries for %s" date-string)))
-    (save-excursion;; Prepare the fancy diary buffer.
-      (set-buffer (make-fancy-diary-buffer))
-      (setq buffer-read-only nil)
-      (let ((entry-list diary-entries-list)
-            (holiday-list)
-            (holiday-list-last-month 1)
-            (holiday-list-last-year 1)
-            (date (list 0 0 0)))
-        (while entry-list
-          (if (not (calendar-date-equal date (car (car entry-list))))
-              (progn
-                (setq date (car (car entry-list)))
-                (and holidays-in-diary-buffer
-                     (calendar-date-compare
-                      (list (list holiday-list-last-month
-                                  (calendar-last-day-of-month
-                                   holiday-list-last-month
-                                   holiday-list-last-year)
-                                  holiday-list-last-year))
-                      (list date))
-                     ;; We need to get the holidays for the next 3 months.
-                     (setq holiday-list-last-month
-                           (extract-calendar-month date))
-                     (setq holiday-list-last-year
-                           (extract-calendar-year date))
-                     (increment-calendar-month
-                      holiday-list-last-month holiday-list-last-year 1)
-                     (setq holiday-list
-                           (let ((displayed-month holiday-list-last-month)
-                                 (displayed-year holiday-list-last-year))
-                             (calendar-holiday-list)))
-                     (increment-calendar-month
-                      holiday-list-last-month holiday-list-last-year 1))
-                (let* ((date-string (calendar-date-string date))
-                       (date-holiday-list
-                        (let ((h holiday-list)
-                              (d))
-                          ;; Make a list of all holidays for date.
-                          (while h
-                            (if (calendar-date-equal date (car (car h)))
-                                (setq d (append d (cdr (car h)))))
-                            (setq h (cdr h)))
-                          d)))
-                  (insert (if (= (point) (point-min)) "" ?\n) date-string)
-                  (if date-holiday-list (insert ":  "))
-                  (let ((l (current-column)))
-                    (insert (mapconcat 'identity date-holiday-list
-                                       (concat "\n" (make-string l ? )))))
-                  (let ((l (current-column)))
-                    (insert ?\n (make-string l ?=) ?\n)))))
-          (if (< 0 (length (car (cdr (car entry-list)))))
-              (insert (car (cdr (car entry-list))) ?\n))
-          (setq entry-list (cdr entry-list))))
-      (set-buffer-modified-p nil)
-      (goto-char (point-min))
-      (setq buffer-read-only t)
-      (display-buffer fancy-diary-buffer)
-      (message "Preparing diary...done"))))
-
-(defun make-fancy-diary-buffer ()
-  "Create and return the initial fancy diary buffer."
-  (save-excursion
-    (set-buffer (get-buffer-create fancy-diary-buffer))
-    (setq buffer-read-only nil)
-    (make-local-variable 'mode-line-format)
-    (calendar-set-mode-line "Diary Entries")
-    (erase-buffer)
-    (set-buffer-modified-p nil)
-    (setq buffer-read-only t)
-    (get-buffer fancy-diary-buffer)))
-
-(defun print-diary-entries ()
-  "Print a hard copy of the diary display.
-
-If the simple diary display is being used, prepare a temp buffer with the
-visible lines of the diary buffer, add a heading line composed from the mode
-line, print the temp buffer, and destroy it.
-
-If the fancy diary display is being used, just print the buffer.
-
-The hooks given by the variable `print-diary-entries-hook' are called to do
-the actual printing."
-  (interactive)
-  (if (bufferp (get-buffer fancy-diary-buffer))
-      (save-excursion
-        (set-buffer (get-buffer fancy-diary-buffer))
-        (run-hooks 'print-diary-entries-hook))
-    (let ((diary-buffer
-           (get-file-buffer (substitute-in-file-name diary-file))))
-      (if diary-buffer
-          (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*"))
-                (heading))
-            (save-excursion
-              (set-buffer diary-buffer)
-              (setq heading
-                    (if (not (stringp mode-line-format))
-                        "All Diary Entries"
-                      (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
-                      (substring mode-line-format
-                                 (match-beginning 1) (match-end 1))))
-              (copy-to-buffer temp-buffer (point-min) (point-max))
-              (set-buffer temp-buffer)
-              (while (re-search-forward "\^M.*$" nil t)
-                (replace-match ""))
-              (goto-char (point-min))
-              (insert heading "\n"
-                      (make-string (length heading) ?=) "\n")
-              (run-hooks 'print-diary-entries-hook)
-              (kill-buffer temp-buffer)))
-        (error "You don't have a diary buffer!")))))
-
-(defun show-all-diary-entries ()
-  "Show all of the diary entries in the diary file.
-This function gets rid of the selective display of the diary file so that
-all entries, not just some, are visible.  If there is no diary buffer, one
-is created."
-  (interactive)
-  (let ((d-file (substitute-in-file-name diary-file)))
-    (if (and d-file (file-exists-p d-file))
-        (if (file-readable-p d-file)
-            (save-excursion
-              (let ((diary-buffer (get-file-buffer d-file)))
-                (set-buffer (if diary-buffer
-                                diary-buffer
-                              (find-file-noselect d-file t)))
-                (let ((buffer-read-only nil)
-                      (diary-modified (buffer-modified-p)))
-                  (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
-                  (setq selective-display nil)
-                  (make-local-variable 'mode-line-format)
-                  (setq mode-line-format default-mode-line-format)
-                  (display-buffer (current-buffer))
-                  (set-buffer-modified-p diary-modified))))
-          (error "Your diary file is not readable!"))
-      (error "You don't have a diary file!"))))
-
-(defun diary-name-pattern (string-array &optional fullname)
-  "Convert an STRING-ARRAY, an array of strings to a pattern.
-The pattern will match any of the strings, either entirely or abbreviated
-to three characters.  An abbreviated form will match with or without a period;
-If the optional FULLNAME is t, abbreviations will not match, just the full
-name."
-  (let ((pattern ""))
-    (calendar-for-loop i from 0 to (1- (length string-array)) do
-      (setq pattern
-            (concat
-             pattern
-             (if (string-equal pattern "") "" "\\|")
-             (aref string-array i)
-             (if fullname
-                 ""
-               (concat
-                "\\|"
-                (substring (aref string-array i) 0 3) ".?")))))
-    pattern))
-
-(defun mark-diary-entries ()
-  "Mark days in the calendar window that have diary entries.
-Each entry in the diary file visible in the calendar window is marked.
-After the entries are marked, the hooks `nongregorian-diary-marking-hook' and
-`mark-diary-entries-hook' are run."
-  (interactive)
-  (setq mark-diary-entries-in-calendar t)
-  (let ((d-file (substitute-in-file-name diary-file)))
-    (if (and d-file (file-exists-p d-file))
-        (if (file-readable-p d-file)
-            (save-excursion
-              (message "Marking diary entries...")
-              (set-buffer (find-file-noselect d-file t))
-              (let ((d diary-date-forms)
-                    (old-diary-syntax-table))
-                (setq old-diary-syntax-table (syntax-table))
-                (set-syntax-table diary-syntax-table)
-                (while d
-                  (let*
-                      ((date-form (if (equal (car (car d)) 'backup)
-                                      (cdr (car d))
-                                    (car d)));; ignore 'backup directive
-                       (dayname (diary-name-pattern calendar-day-name-array))
-                       (monthname
-                        (concat
-                         (diary-name-pattern calendar-month-name-array)
-                         "\\|\\*"))
-                       (month "[0-9]+\\|\\*")
-                       (day "[0-9]+\\|\\*")
-                       (year "[0-9]+\\|\\*")
-                       (l (length date-form))
-                       (d-name-pos (- l (length (memq 'dayname date-form))))
-                       (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
-                       (m-name-pos (- l (length (memq 'monthname date-form))))
-                       (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
-                       (d-pos (- l (length (memq 'day date-form))))
-                       (d-pos (if (/= l d-pos) (+ 2 d-pos)))
-                       (m-pos (- l (length (memq 'month date-form))))
-                       (m-pos (if (/= l m-pos) (+ 2 m-pos)))
-                       (y-pos (- l (length (memq 'year date-form))))
-                       (y-pos (if (/= l y-pos) (+ 2 y-pos)))
-                       (regexp
-                        (concat
-                         "\\(\\`\\|\^M\\|\n\\)\\("
-                         (mapconcat 'eval date-form "\\)\\(")
-                         "\\)"))
-                       (case-fold-search t))
-                    (goto-char (point-min))
-                    (while (re-search-forward regexp nil t)
-                      (let* ((dd-name
-                              (if d-name-pos
-                                  (buffer-substring
-                                   (match-beginning d-name-pos)
-                                   (match-end d-name-pos))))
-                             (mm-name
-                              (if m-name-pos
-                                  (buffer-substring
-                                   (match-beginning m-name-pos)
-                                   (match-end m-name-pos))))
-                             (mm (string-to-int
-                                  (if m-pos
-                                      (buffer-substring
-                                       (match-beginning m-pos)
-                                       (match-end m-pos))
-                                    "")))
-                             (dd (string-to-int
-                                  (if d-pos
-                                      (buffer-substring
-                                       (match-beginning d-pos)
-                                       (match-end d-pos))
-                                    "")))
-                             (y-str (if y-pos
-                                        (buffer-substring
-                                         (match-beginning y-pos)
-                                         (match-end y-pos))))
-                             (yy (if (not y-str)
-                                     0
-                                   (if (and (= (length y-str) 2)
-                                            abbreviated-calendar-year)
-                                       (let* ((current-y
-                                               (extract-calendar-year
-                                                (calendar-current-date)))
-                                              (y (+ (string-to-int y-str)
-                                                    (* 100
-                                                       (/ current-y 100)))))
-                                         (if (> (- y current-y) 50)
-                                             (- y 100)
-                                           (if (> (- current-y y) 50)
-                                               (+ y 100)
-                                             y)))
-                                     (string-to-int y-str)))))
-                        (if dd-name
-                            (mark-calendar-days-named
-                             (cdr (assoc (capitalize (substring dd-name 0 3))
-                                         (calendar-make-alist
-                                          calendar-day-name-array
-                                          0
-                                          '(lambda (x) (substring x 0 3))))))
-                          (if mm-name
-                              (if (string-equal mm-name "*")
-                                  (setq mm 0)
-                                (setq mm
-                                      (cdr (assoc
-                                            (capitalize
-                                             (substring mm-name 0 3))
-                                            (calendar-make-alist
-                                             calendar-month-name-array
-                                             1
-                                             '(lambda (x) (substring x 0 3)))
-                                            )))))
-                          (mark-calendar-date-pattern mm dd yy))))
-                    (setq d (cdr d))))
-                (mark-sexp-diary-entries)
-                (run-hooks 'nongregorian-diary-marking-hook
-                           'mark-diary-entries-hook)
-                (set-syntax-table old-diary-syntax-table)
-                (message "Marking diary entries...done")))
-          (error "Your diary file is not readable!"))
-      (error "You don't have a diary file!"))))
-
-(defun mark-sexp-diary-entries ()
-  "Mark days in the calendar window that have sexp diary entries.
-Each entry in the diary file (or included files) visible in the calendar window
-is marked.  See the documentation for the function `list-sexp-diary-entries'."
-  (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol))
-         (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" sexp-mark "("))
-         (m)
-         (y)
-         (first-date)
-         (last-date))
-    (save-excursion
-      (set-buffer calendar-buffer)
-      (setq m displayed-month)
-      (setq y displayed-year))
-    (increment-calendar-month m y -1)
-    (setq first-date
-          (calendar-absolute-from-gregorian (list m 1 y)))
-    (increment-calendar-month m y 2)
-    (setq last-date
-          (calendar-absolute-from-gregorian
-           (list m (calendar-last-day-of-month m y) y)))
-    (goto-char (point-min))
-    (while (re-search-forward s-entry nil t)
-      (backward-char 1)
-      (let ((sexp-start (point))
-            (sexp)
-            (entry)
-            (entry-start)
-            (line-start))
-        (forward-sexp)
-        (setq sexp (buffer-substring sexp-start (point)))
-        (save-excursion
-          (re-search-backward "\^M\\|\n\\|\\`")
-          (setq line-start (point)))
-        (forward-char 1)
-        (if (and (or (char-equal (preceding-char) ?\^M)
-                     (char-equal (preceding-char) ?\n))
-                 (not (looking-at " \\|\^I")))
-            (progn;; Diary entry consists only of the sexp
-              (backward-char 1)
-              (setq entry ""))
-          (setq entry-start (point))
-          (re-search-forward "\^M\\|\n" nil t)
-          (while (looking-at " \\|\^I")
-            (re-search-forward "\^M\\|\n" nil t))
-          (backward-char 1)
-          (setq entry (buffer-substring entry-start (point)))
-          (while (string-match "[\^M]" entry)
-            (aset entry (match-beginning 0) ?\n )))
-        (calendar-for-loop date from first-date to last-date do
-          (if (diary-sexp-entry sexp entry
-                                (calendar-gregorian-from-absolute date))
-              (mark-visible-calendar-date
-               (calendar-gregorian-from-absolute date))))))))
-
-(defun mark-included-diary-files ()
-  "Mark the diary entries from other diary files with those of the diary file.
-This function is suitable for use as the `mark-diary-entries-hook'; it enables
-you to use shared diary files together with your own.  The files included are
-specified in the diary-file by lines of this form:
-        #include \"filename\"
-This is recursive; that is, #include directives in diary files thus included
-are obeyed.  You can change the `#include' to some other string by
-changing the variable `diary-include-string'."
-  (goto-char (point-min))
-  (while (re-search-forward
-          (concat
-           "\\(\\`\\|\^M\\|\n\\)"
-           (regexp-quote diary-include-string)
-           " \"\\([^\"]*\\)\"")
-          nil t)
-    (let ((diary-file (substitute-in-file-name
-                       (buffer-substring (match-beginning 2) (match-end 2))))
-          (mark-diary-entries-hook 'mark-included-diary-files))
-      (if (file-exists-p diary-file)
-          (if (file-readable-p diary-file)
-              (progn
-                (mark-diary-entries)
-                (kill-buffer (get-file-buffer diary-file)))
-            (beep)
-            (message "Can't read included diary file %s" diary-file)
-            (sleep-for 2))
-        (beep)
-        (message "Can't find included diary file %s" diary-file)
-        (sleep-for 2))))
-  (goto-char (point-min)))
-
-(defun mark-calendar-days-named (dayname)
-  "Mark all dates in the calendar window that are day DAYNAME of the week.
-0 means all Sundays, 1 means all Mondays, and so on."
-  (save-excursion
-    (set-buffer calendar-buffer)
-    (let ((prev-month displayed-month)
-          (prev-year displayed-year)
-          (succ-month displayed-month)
-          (succ-year displayed-year)
-          (last-day)
-          (day))
-      (increment-calendar-month succ-month succ-year 1)
-      (increment-calendar-month prev-month prev-year -1)
-      (setq day (calendar-absolute-from-gregorian
-                 (calendar-nth-named-day 1 dayname prev-month prev-year)))
-      (setq last-day (calendar-absolute-from-gregorian
-                 (calendar-nth-named-day -1 dayname succ-month succ-year)))
-      (while (<= day last-day)
-        (mark-visible-calendar-date (calendar-gregorian-from-absolute day))
-        (setq day (+ day 7))))))
-
-(defun mark-calendar-date-pattern (month day year)
-  "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
-A value of 0 in any position is a wildcard."
-  (save-excursion
-    (set-buffer calendar-buffer)
-    (let ((m displayed-month)
-          (y displayed-year))
-      (increment-calendar-month m y -1)
-      (calendar-for-loop i from 0 to 2 do
-          (mark-calendar-month m y month day year)
-          (increment-calendar-month m y 1)))))
-
-(defun mark-calendar-month (month year p-month p-day p-year)
-  "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
-A value of 0 in any position of the pattern is a wildcard."
-  (if (or (and (= month p-month)
-               (or (= p-year 0) (= year p-year)))
-          (and (= p-month 0)
-               (or (= p-year 0) (= year p-year))))
-      (if (= p-day 0)
-          (calendar-for-loop
-              i from 1 to (calendar-last-day-of-month month year) do
-            (mark-visible-calendar-date (list month i year)))
-        (mark-visible-calendar-date (list month p-day year)))))
-
-(defun sort-diary-entries ()
-  "Sort the list of diary entries by time of day."
-  (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
-
-(defun diary-entry-compare (e1 e2)
-  "Returns t if E1 is earlier than E2."
-  (or (calendar-date-compare e1 e2)
-      (and (calendar-date-equal (car e1) (car e2))
-           (< (diary-entry-time (car (cdr e1)))
-              (diary-entry-time (car (cdr e2)))))))
-
-(defun diary-entry-time (s)
-  "Time at the beginning of the string S in a military-style integer.
-For example, returns 1325 for 1:25pm.  Returns -9999 if no time is recognized.
-The recognized forms are XXXX or X:XX or XX:XX (military time), XXam or XXpm,
-and XX:XXam or XX:XXpm."
-  (cond ((string-match;; Military time  
-          "^[ \t]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s)
-         (+ (* 100 (string-to-int
-                    (substring s (match-beginning 1) (match-end 1))))
-            (string-to-int (substring s (match-beginning 2) (match-end 2)))))
-        ((string-match;; Hour only  XXam or XXpm
-          "^[ \t]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
-         (+ (* 100 (% (string-to-int
-                         (substring s (match-beginning 1) (match-end 1)))
-                        12))
-            (if (string-equal "a"
-                              (substring s (match-beginning 2) (match-end 2)))
-                0 1200)))
-        ((string-match;; Hour and minute  XX:XXam or XX:XXpm
-          "^[ \t]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
-         (+ (* 100 (% (string-to-int
-                         (substring s (match-beginning 1) (match-end 1)))
-                        12))
-            (string-to-int (substring s (match-beginning 2) (match-end 2)))
-            (if (string-equal "a"
-                              (substring s (match-beginning 3) (match-end 3)))
-                0 1200)))
-        (t -9999)));; Unrecognizable
-
-(defun list-hebrew-diary-entries ()
-  "Add any Hebrew date entries from the diary file to `diary-entries-list'.
-Hebrew date diary entries must be prefaced by `hebrew-diary-entry-symbol'
-\(normally an `H').  The same diary date forms govern the style of the Hebrew
-calendar entries, except that the Hebrew month names must be spelled in full.
-The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
-Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
-common Hebrew year.  If a Hebrew date diary entry begins with a
-`diary-nonmarking-symbol', the entry will appear in the diary listing, but will
-not be marked in the calendar.  This function is provided for use with the
-`nongregorian-diary-listing-hook'."
-  (if (< 0 number)
-      (let ((buffer-read-only nil)
-            (diary-modified (buffer-modified-p))
-            (gdate original-date)
-            (mark (regexp-quote diary-nonmarking-symbol)))
-        (calendar-for-loop i from 1 to number do
-           (let* ((d diary-date-forms)
-                  (hdate (calendar-hebrew-from-absolute 
-                          (calendar-absolute-from-gregorian gdate)))
-                  (month (extract-calendar-month hdate))
-                  (day (extract-calendar-day hdate))
-                  (year (extract-calendar-year hdate)))
-             (while d
-               (let*
-                   ((date-form (if (equal (car (car d)) 'backup)
-                                   (cdr (car d))
-                                 (car d)))
-                    (backup (equal (car (car d)) 'backup))
-                    (dayname
-                     (concat
-                      (calendar-day-name gdate) "\\|"
-                      (substring (calendar-day-name gdate) 0 3) ".?"))
-                    (calendar-month-name-array
-                     calendar-hebrew-month-name-array-leap-year)
-                    (monthname
-                     (concat
-                      "\\*\\|"
-                      (calendar-month-name month)))
-                    (month (concat "\\*\\|0*" (int-to-string month)))
-                    (day (concat "\\*\\|0*" (int-to-string day)))
-                    (year
-                     (concat
-                      "\\*\\|0*" (int-to-string year)
-                      (if abbreviated-calendar-year
-                          (concat "\\|" (int-to-string (% year 100)))
-                        "")))
-                    (regexp
-                     (concat
-                      "\\(\\`\\|\^M\\|\n\\)" mark "?"
-                      (regexp-quote hebrew-diary-entry-symbol)
-                      "\\("
-                      (mapconcat 'eval date-form "\\)\\(")
-                      "\\)"))
-                    (case-fold-search t))
-                 (goto-char (point-min))
-                 (while (re-search-forward regexp nil t)
-                   (if backup (re-search-backward "\\<" nil t))
-                   (if (and (or (char-equal (preceding-char) ?\^M)
-                                (char-equal (preceding-char) ?\n))
-                            (not (looking-at " \\|\^I")))
-                       ;;  Diary entry that consists only of date.
-                       (backward-char 1)
-                     ;;  Found a nonempty diary entry--make it visible and
-                     ;;  add it to the list.
-                     (let ((entry-start (point))
-                           (date-start))
-                       (re-search-backward "\^M\\|\n\\|\\`")
-                       (setq date-start (point))
-                       (re-search-forward "\^M\\|\n" nil t 2)
-                       (while (looking-at " \\|\^I")
-                         (re-search-forward "\^M\\|\n" nil t))
-                       (backward-char 1)
-                       (subst-char-in-region date-start (point) ?\^M ?\n t)
-                       (add-to-diary-list
-                         gdate (buffer-substring entry-start (point)))))))
-               (setq d (cdr d))))
-           (setq gdate
-                 (calendar-gregorian-from-absolute
-                  (1+ (calendar-absolute-from-gregorian gdate)))))
-           (set-buffer-modified-p diary-modified))
-        (goto-char (point-min))))
-
-(defun mark-hebrew-diary-entries ()
-  "Mark days in the calendar window that have Hebrew date diary entries.
-Each entry in diary-file (or included files) visible in the calendar window
-is marked.  Hebrew date entries are prefaced by a hebrew-diary-entry-symbol
-\(normally an `H').  The same diary-date-forms govern the style of the Hebrew
-calendar entries, except that the Hebrew month names must be spelled in full.
-The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
-Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
-common Hebrew year.  Hebrew date diary entries that begin with a
-diary-nonmarking symbol will not be marked in the calendar.  This function
-is provided for use as part of the nongregorian-diary-marking-hook."
-  (let ((d diary-date-forms))
-    (while d
-      (let*
-          ((date-form (if (equal (car (car d)) 'backup)
-                          (cdr (car d))
-                        (car d)));; ignore 'backup directive
-           (dayname (diary-name-pattern calendar-day-name-array))
-           (monthname
-            (concat
-             (diary-name-pattern calendar-hebrew-month-name-array-leap-year t)
-             "\\|\\*"))
-           (month "[0-9]+\\|\\*")
-           (day "[0-9]+\\|\\*")
-           (year "[0-9]+\\|\\*")
-           (l (length date-form))
-           (d-name-pos (- l (length (memq 'dayname date-form))))
-           (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
-           (m-name-pos (- l (length (memq 'monthname date-form))))
-           (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
-           (d-pos (- l (length (memq 'day date-form))))
-           (d-pos (if (/= l d-pos) (+ 2 d-pos)))
-           (m-pos (- l (length (memq 'month date-form))))
-           (m-pos (if (/= l m-pos) (+ 2 m-pos)))
-           (y-pos (- l (length (memq 'year date-form))))
-           (y-pos (if (/= l y-pos) (+ 2 y-pos)))
-           (regexp
-            (concat
-             "\\(\\`\\|\^M\\|\n\\)"
-             (regexp-quote hebrew-diary-entry-symbol)
-             "\\("
-             (mapconcat 'eval date-form "\\)\\(")
-             "\\)"))
-           (case-fold-search t))
-        (goto-char (point-min))
-        (while (re-search-forward regexp nil t)
-          (let* ((dd-name
-                  (if d-name-pos
-                      (buffer-substring
-                       (match-beginning d-name-pos)
-                       (match-end d-name-pos))))
-                 (mm-name
-                  (if m-name-pos
-                      (buffer-substring
-                       (match-beginning m-name-pos)
-                       (match-end m-name-pos))))
-                 (mm (string-to-int
-                      (if m-pos
-                          (buffer-substring
-                           (match-beginning m-pos)
-                           (match-end m-pos))
-                        "")))
-                 (dd (string-to-int
-                      (if d-pos
-                          (buffer-substring
-                           (match-beginning d-pos)
-                           (match-end d-pos))
-                        "")))
-                 (y-str (if y-pos
-                            (buffer-substring
-                             (match-beginning y-pos)
-                             (match-end y-pos))))
-                 (yy (if (not y-str)
-                         0
-                       (if (and (= (length y-str) 2)
-                                abbreviated-calendar-year)
-                           (let* ((current-y
-                                   (extract-calendar-year
-                                    (calendar-hebrew-from-absolute
-                                     (calendar-absolute-from-gregorian
-                                      (calendar-current-date)))))
-                                  (y (+ (string-to-int y-str)
-                                        (* 100 (/ current-y 100)))))
-                             (if (> (- y current-y) 50)
-                                 (- y 100)
-                               (if (> (- current-y y) 50)
-                                   (+ y 100)
-                                 y)))
-                         (string-to-int y-str)))))
-            (if dd-name
-                (mark-calendar-days-named
-                 (cdr (assoc (capitalize (substring dd-name 0 3))
-                             (calendar-make-alist
-                               calendar-day-name-array
-                               0
-                              '(lambda (x) (substring x 0 3))))))
-              (if mm-name
-                  (if (string-equal mm-name "*")
-                      (setq mm 0)
-                    (setq
-                      mm
-                      (cdr 
-                        (assoc
-                          (capitalize mm-name)
-                            (calendar-make-alist
-                               calendar-hebrew-month-name-array-leap-year))))))
-              (mark-hebrew-calendar-date-pattern mm dd yy)))))
-      (setq d (cdr d)))))
-
-(defun mark-hebrew-calendar-date-pattern (month day year)
-  "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
-A value of 0 in any position is a wildcard."
-  (save-excursion
-    (set-buffer calendar-buffer)
-    (if (and (/= 0 month) (/= 0 day))
-        (if (/= 0 year)
-            ;; Fully specified Hebrew date.
-            (let ((date (calendar-gregorian-from-absolute
-                         (calendar-absolute-from-hebrew
-                          (list month day year)))))
-              (if (calendar-date-is-visible-p date)
-                  (mark-visible-calendar-date date)))
-          ;; Month and day in any year--this taken from the holiday stuff.
-          (if (memq displayed-month;;  This test is only to speed things up a
-                    (list          ;;  bit; it works fine without the test too.
-                     (if (< 11 month) (- month 11) (+ month 1))
-                     (if (< 10 month) (- month 10) (+ month 2))
-                     (if (<  9 month) (- month  9) (+ month 3))
-                     (if (<  8 month) (- month  8) (+ month 4))
-                     (if (<  7 month) (- month  7) (+ month 5))))
-              (let ((m1 displayed-month)
-                    (y1 displayed-year)
-                    (m2 displayed-month)
-                    (y2 displayed-year)
-                    (year))
-                (increment-calendar-month m1 y1 -1)
-                (increment-calendar-month m2 y2 1)
-                (let* ((start-date (calendar-absolute-from-gregorian
-                                    (list m1 1 y1)))
-                       (end-date (calendar-absolute-from-gregorian
-                                  (list m2
-                                        (calendar-last-day-of-month m2 y2)
-                                        y2)))
-                       (hebrew-start
-                        (calendar-hebrew-from-absolute start-date))
-                       (hebrew-end (calendar-hebrew-from-absolute end-date))
-                       (hebrew-y1 (extract-calendar-year hebrew-start))
-                       (hebrew-y2 (extract-calendar-year hebrew-end)))
-                  (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
-                  (let ((date (calendar-gregorian-from-absolute
-                               (calendar-absolute-from-hebrew
-                                (list month day year)))))
-                    (if (calendar-date-is-visible-p date)
-                        (mark-visible-calendar-date date)))))))
-      ;; Not one of the simple cases--check all visible dates for match.
-      ;; Actually, the following code takes care of ALL of the cases, but
-      ;; it's much too slow to be used for the simple (common) cases.
-      (let ((m displayed-month)
-            (y displayed-year)
-            (first-date)
-            (last-date))
-        (increment-calendar-month m y -1)
-        (setq first-date
-              (calendar-absolute-from-gregorian
-               (list m 1 y)))
-        (increment-calendar-month m y 2)
-        (setq last-date
-              (calendar-absolute-from-gregorian
-               (list m (calendar-last-day-of-month m y) y)))
-        (calendar-for-loop date from first-date to last-date do
-          (let* ((h-date (calendar-hebrew-from-absolute date))
-                 (h-month (extract-calendar-month h-date))
-                 (h-day (extract-calendar-day h-date))
-                 (h-year (extract-calendar-year h-date)))
-            (and (or (zerop month)
-                     (= month h-month))
-                 (or (zerop day)
-                     (= day h-day))
-                 (or (zerop year)
-                     (= year h-year))
-                 (mark-visible-calendar-date
-                  (calendar-gregorian-from-absolute date)))))))))
-
-(defun list-sexp-diary-entries (date)
-  "Add sexp entries for DATE from the diary file to `diary-entries-list'.
-Also, Make them visible in the diary file.  Returns t if any entries were
-found.
-
-Sexp diary entries must be prefaced by a `sexp-diary-entry-symbol' (normally
-`%%').  The form of a sexp diary entry is
-
-                  %%(SEXP) ENTRY
-
-Both ENTRY and DATE are globally available when the SEXP is evaluated.  If the
-SEXP yields the value nil, the diary entry does not apply.  If it yields a
-non-nil value, ENTRY will be taken to apply to DATE; if the non-nil value is a
-string, that string will be the diary entry in the fancy diary display.
-
-For example, the following diary entry will apply to the 21st of the month
-if it is a weekday and the Friday before if the 21st is on a weekend:
-
-      &%%(let ((dayname (calendar-day-of-week date))
-               (day (extract-calendar-day date)))
-           (or
-             (and (= day 21) (memq dayname '(1 2 3 4 5)))
-             (and (memq day '(19 20)) (= dayname 5)))
-         ) UIUC pay checks deposited
-
-A number of built-in functions are available for this type of diary entry:
-
-      %%(diary-float MONTH DAYNAME N) text
-                  Entry will appear on the Nth DAYNAME of MONTH.
-                  (DAYNAME=0 means Sunday, 1 means Monday, and so on;
-                  if N is negative it counts backward from the end of
-                  the month.  MONTH can be a list of months, a single
-                  month, or t to specify all months.
-
-      %%(diary-block M1 D1 Y1 M2 D2 Y2) text
-                  Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
-                  inclusive.  (If `european-calendar-style' is t, the
-                  order of the parameters should be changed to D1, M1, Y1,
-                  D2, M2, Y2.)
-
-      %%(diary-anniversary MONTH DAY YEAR) text
-                  Entry will appear on anniversary dates of MONTH DAY, YEAR.
-                  (If `european-calendar-style' is t, the order of the
-                  parameters should be changed to DAY, MONTH, YEAR.)  Text
-                  can contain %d or %d%s; %d will be replaced by the number
-                  of years since the MONTH DAY, YEAR and %s will be replaced
-                  by the ordinal ending of that number (that is, `st', `nd',
-                  `rd' or `th', as appropriate.  The anniversary of February
-                  29 is considered to be March 1 in a non-leap year.
-
-      %%(diary-cyclic N MONTH DAY YEAR) text
-                  Entry will appear every N days, starting MONTH DAY, YEAR.
-                  (If `european-calendar-style' is t, the order of the
-                  parameters should be changed to N, DAY, MONTH, YEAR.)  Text
-                  can contain %d or %d%s; %d will be replaced by the number
-                  of repetitions since the MONTH DAY, YEAR and %s will
-                  be replaced by the ordinal ending of that number (that is,
-                  `st', `nd', `rd' or `th', as appropriate.
-
-      %%(diary-day-of-year)
-                  Diary entries giving the day of the year and the number of
-                  days remaining in the year will be made every day.  Note
-                  that since there is no text, it makes sense only if the
-                  fancy diary display is used.
-
-      %%(diary-iso-date)
-                  Diary entries giving the corresponding ISO commercial date
-                  will be made every day.  Note that since there is no text,
-                  it makes sense only if the fancy diary display is used.
-
-      %%(diary-french-date)
-                  Diary entries giving the corresponding French Revolutionary
-                  date will be made every day.  Note that since there is no
-                  text, it makes sense only if the fancy diary display is used.
-
-      %%(diary-islamic-date)
-                  Diary entries giving the corresponding Islamic date will be
-                  made every day.  Note that since there is no text, it
-                  makes sense only if the fancy diary display is used.
-
-      %%(diary-hebrew-date)
-                  Diary entries giving the corresponding Hebrew date will be
-                  made every day.  Note that since there is no text, it
-                  makes sense only if the fancy diary display is used.
-
-      %%(diary-astro-day-number) Diary entries giving the corresponding
-                  astronomical (Julian) day number will be made every day.
-                  Note that since there is no text, it makes sense only if the
-                  fancy diary display is used.
-
-      %%(diary-julian-date) Diary entries giving the corresponding
-                 Julian date will be made every day.  Note that since
-                 there is no text, it makes sense only if the fancy diary
-                 display is used.
-
-      %%(diary-sunrise-sunset)
-                  Diary entries giving the local times of sunrise and sunset
-                  will be made every day.  Note that since there is no text,
-                  it makes sense only if the fancy diary display is used.
-                  Floating point required.
-
-      %%(diary-phases-of-moon)
-                  Diary entries giving the times of the phases of the moon
-                  will be when appropriate.  Note that since there is no text,
-                  it makes sense only if the fancy diary display is used.
-                  Floating point required.
-
-      %%(diary-yahrzeit MONTH DAY YEAR) text
-                  Text is assumed to be the name of the person; the date is
-                  the date of death on the *civil* calendar.  The diary entry
-                  will appear on the proper Hebrew-date anniversary and on the
-                  day before.  (If `european-calendar-style' is t, the order
-                  of the parameters should be changed to DAY, MONTH, YEAR.)
-                  
-      %%(diary-rosh-hodesh)
-                  Diary entries will be made on the dates of Rosh Hodesh on
-                  the Hebrew calendar.  Note that since there is no text, it
-                  makes sense only if the fancy diary display is used.
-
-      %%(diary-parasha)
-                  Diary entries giving the weekly parasha will be made on
-                  every Saturday.  Note that since there is no text, it
-                  makes sense only if the fancy diary display is used.
-
-      %%(diary-omer)
-                  Diary entries giving the omer count will be made every day
-                  from Passover to Shavuoth.  Note that since there is no text,
-                  it makes sense only if the fancy diary display is used.
-
-Marking these entries is *extremely* time consuming, so these entries are
-best if they are nonmarking."
-  (let* ((mark (regexp-quote diary-nonmarking-symbol))
-         (sexp-mark (regexp-quote sexp-diary-entry-symbol))
-         (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "("))
-         (entry-found))
-    (goto-char (point-min))
-    (while (re-search-forward s-entry nil t)
-      (backward-char 1)
-      (let ((sexp-start (point))
-            (sexp)
-            (entry)
-            (entry-start)
-            (line-start))
-        (forward-sexp)
-        (setq sexp (buffer-substring sexp-start (point)))
-        (save-excursion
-          (re-search-backward "\^M\\|\n\\|\\`")
-          (setq line-start (point)))
-        (forward-char 1)
-        (if (and (or (char-equal (preceding-char) ?\^M)
-                     (char-equal (preceding-char) ?\n))
-                 (not (looking-at " \\|\^I")))
-            (progn;; Diary entry consists only of the sexp
-              (backward-char 1)
-              (setq entry ""))
-          (setq entry-start (point))
-          (re-search-forward "\^M\\|\n" nil t)
-          (while (looking-at " \\|\^I")
-            (re-search-forward "\^M\\|\n" nil t))
-          (backward-char 1)
-          (setq entry (buffer-substring entry-start (point)))
-          (while (string-match "[\^M]" entry)
-            (aset entry (match-beginning 0) ?\n )))
-        (let ((diary-entry (diary-sexp-entry sexp entry date)))
-          (if diary-entry
-              (subst-char-in-region line-start (point) ?\^M ?\n t))
-          (add-to-diary-list date diary-entry)
-          (setq entry-found (or entry-found diary-entry)))))
-    entry-found))
-
-(defun diary-sexp-entry (sexp entry date)
-  "Process a SEXP diary ENTRY for DATE."
-  (let ((result (if calendar-debug-sexp
-                  (let ((stack-trace-on-error t))
-                    (eval (car (read-from-string sexp))))
-                  (condition-case nil
-                      (eval (car (read-from-string sexp)))
-                    (error
-                     (beep)
-                     (message "Bad sexp at line %d in %s: %s"
-                              (save-excursion
-                                (save-restriction
-                                  (narrow-to-region 1 (point))
-                                  (goto-char (point-min))
-                                  (let ((lines 1))
-                                    (while (re-search-forward "\n\\|\^M" nil t)
-                                      (setq lines (1+ lines)))
-                                    lines)))
-                              diary-file sexp)
-                     (sleep-for 2))))))
-    (if (stringp result)
-        result
-      (if result
-          entry
-        nil))))
-
-(defun diary-block (m1 d1 y1 m2 d2 y2)
-  "Block diary entry.
-Entry applies if date is between two dates.  Order of the parameters is
-M1, D1, Y1, M2, D2, Y2 `european-calendar-style' is nil, and
-D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t."
-  (let ((date1 (calendar-absolute-from-gregorian
-                (if european-calendar-style
-                    (list d1 m1 y1)
-                  (list m1 d1 y1))))
-        (date2 (calendar-absolute-from-gregorian
-                (if european-calendar-style
-                    (list d2 m2 y2)
-                  (list m2 d2 y2))))
-        (d (calendar-absolute-from-gregorian date)))
-    (if (and (<= date1 d) (<= d date2))
-        entry)))
-
-(defun diary-float (month dayname n)
-  "Floating diary entry--entry applies if date is the nth dayname of month.
-Parameters are MONTH, DAYNAME, N.  MONTH can be a list of months, the constant
-t, or an integer.  The constant t means all months.  If N is negative, count
-backward from the end of the month."
-  (let ((m (extract-calendar-month date))
-        (y (extract-calendar-year date)))
-    (if (and
-         (or (and (listp month) (memq m month))
-             (equal m month)
-             (eq month t))
-         (calendar-date-equal date (calendar-nth-named-day n dayname m y)))
-        entry)))
-
-(defun diary-anniversary (month day year)
-  "Anniversary diary entry.
-Entry applies if date is the anniversary of MONTH, DAY, YEAR if
-`european-calendar-style' is nil, and DAY, MONTH, YEAR if
-`european-calendar-style' is t.  Diary entry can contain `%d' or `%d%s'; the
-%d will be replaced by the number of years since the MONTH DAY, YEAR and the
-%s will be replaced by the ordinal ending of that number (that is, `st', `nd',
-`rd' or `th', as appropriate.  The anniversary of February 29 is considered
-to be March 1 in non-leap years."
-  (let* ((d (if european-calendar-style
-                month
-              day))
-         (m (if european-calendar-style
-                day
-              month))
-         (y (extract-calendar-year date))
-         (diff (- y year)))
-    (if (and (= m 2) (= d 29) (not (calendar-leap-year-p y)))
-        (setq m 3
-              d 1))
-    (if (and (> diff 0) (calendar-date-equal (list m d y) date))
-        (format entry diff (diary-ordinal-suffix diff)))))
-
-(defun diary-cyclic (n month day year)
-  "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
-If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR.
-ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of
-years since the MONTH DAY, YEAR and the %s will be replaced by the ordinal
-ending of that number (that is, `st', `nd', `rd' or `th', as appropriate."
-  (let* ((d (if european-calendar-style
-                month
-              day))
-         (m (if european-calendar-style
-                day
-              month))
-         (diff (- (calendar-absolute-from-gregorian date)
-                  (calendar-absolute-from-gregorian
-                   (list m d year))))
-         (cycle (/ diff n)))
-    (if (and (>= diff 0) (zerop (% diff n)))
-        (format entry cycle (diary-ordinal-suffix cycle)))))
-
-(defun diary-ordinal-suffix (n)
-  "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)"
-  (if (or (memq (% n 100) '(11 12 13))
-          (< 3 (% n 10)))
-      "th"
-    (aref ["th" "st" "nd" "rd"] (% n 10))))
-
-(defun diary-day-of-year ()
-  "Day of year and number of days remaining in the year of date diary entry."
-  (calendar-day-of-year-string date))
-
-(defun diary-iso-date ()
-  "ISO calendar equivalent of date diary entry."
-  (format "ISO date: %s" (calendar-iso-date-string date)))
-
-(defun diary-islamic-date ()
-  "Islamic calendar equivalent of date diary entry."
-  (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t))))
-    (if (string-equal i "")
-        "Date is pre-Islamic"
-      (format "Islamic date (until sunset): %s" i))))
-
-(defun diary-hebrew-date ()
-  "Hebrew calendar equivalent of date diary entry."
-  (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
-
-(defun diary-julian-date ()
-  "Julian calendar equivalent of date diary entry."
-  (format "Julian date: %s" (calendar-julian-date-string date)))
-
-(defun diary-astro-day-number ()
-  "Astronomical (Julian) day number diary entry."
-  (format "Astronomical (Julian) day number %s"
-          (calendar-astro-date-string date)))
-
-(defun diary-omer ()
-  "Omer count diary entry.
-Entry applies if date is within 50 days after Passover."
-  (let* ((passover
-          (calendar-absolute-from-hebrew
-           (list 1 15 (+ (extract-calendar-year date) 3760))))
-         (omer (- (calendar-absolute-from-gregorian date) passover))
-         (week (/ omer 7))
-         (day (% omer 7)))
-    (if (and (> omer 0) (< omer 50))
-        (format "Day %d%s of the omer (until sunset)"
-                omer
-                (if (zerop week)
-                    ""
-                  (format ", that is, %d week%s%s"
-                          week
-                          (if (= week 1) "" "s")
-                          (if (zerop day)
-                              ""
-                            (format " and %d day%s"
-                                    day (if (= day 1) "" "s")))))))))
-
-(defun diary-yahrzeit (death-month death-day death-year)
-  "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
-Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
-to be the name of the person.  Date of death is on the *civil* calendar;
-although the date of death is specified by the civil calendar, the proper
-Hebrew calendar yahrzeit is determined.  If `european-calendar-style' is t, the
-order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR."
-  (let* ((h-date (calendar-hebrew-from-absolute
-                  (calendar-absolute-from-gregorian
-                   (if european-calendar-style
-                       (list death-day death-month death-year)
-                   (list death-month death-day death-year)))))
-         (h-month (extract-calendar-month h-date))
-         (h-day (extract-calendar-day h-date))
-         (h-year (extract-calendar-year h-date))
-         (d (calendar-absolute-from-gregorian date))
-         (yr (extract-calendar-year (calendar-hebrew-from-absolute d)))
-         (diff (- yr h-year))
-         (y (hebrew-calendar-yahrzeit h-date yr)))
-    (if (and (> diff 0) (or (= y d) (= y (1+ d))))
-        (format "Yahrzeit of %s%s: %d%s anniversary"
-                entry
-                (if (= y d) "" " (evening)")
-                diff
-                (cond ((= (% diff 10) 1) "st")
-                      ((= (% diff 10) 2) "nd")
-                      ((= (% diff 10) 3) "rd")
-                      (t "th"))))))
-
-(defun diary-rosh-hodesh ()
-  "Rosh Hodesh diary entry.
-Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
-  (let* ((d (calendar-absolute-from-gregorian date))
-         (h-date (calendar-hebrew-from-absolute d))
-         (h-month (extract-calendar-month h-date))
-         (h-day (extract-calendar-day h-date))
-         (h-year (extract-calendar-year h-date))
-         (leap-year (hebrew-calendar-leap-year-p h-year))
-         (last-day (hebrew-calendar-last-day-of-month h-month h-year))
-         (h-month-names
-          (if leap-year
-              calendar-hebrew-month-name-array-leap-year
-            calendar-hebrew-month-name-array-common-year))
-         (this-month (aref h-month-names (1- h-month)))
-         (h-yesterday (extract-calendar-day
-                       (calendar-hebrew-from-absolute (1- d)))))
-    (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
-        (format
-         "Rosh Hodesh %s"
-         (if (= h-day 30)
-             (format
-              "%s (first day)"
-              ;; next month must be in the same year since this
-              ;; month can't be the last month of the year since
-              ;; it has 30 days
-              (aref h-month-names h-month))
-           (if (= h-yesterday 30)
-               (format "%s (second day)" this-month)
-             this-month)))
-      (if (= (% d 7) 6);; Saturday--check for Shabbat Mevarhim
-          (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
-                 (format "Mevarhim Rosh Hodesh %s (%s)"
-                         (aref h-month-names
-                               (if (= h-month
-                                      (hebrew-calendar-last-month-of-year
-                                       h-year))
-                                   0 h-month))
-                         (aref calendar-day-name-array (- 29 h-day))))
-                ((and (< h-day 30) (> h-day 22) (= 30 last-day))
-                 (format "Mevarhim Rosh Hodesh %s (%s-%s)"
-                         (aref h-month-names h-month)
-                         (if (= h-day 29)
-                             "tomorrow"
-                           (aref calendar-day-name-array (- 29 h-day)))
-                         (aref calendar-day-name-array
-                               (% (- 30 h-day) 7)))))
-        (if (and (= h-day 29) (/= h-month 6))
-            (format "Erev Rosh Hodesh %s"
-                    (aref h-month-names
-                          (if (= h-month
-                                 (hebrew-calendar-last-month-of-year
-                                  h-year))
-                              0 h-month))))))))
-
-(defun diary-parasha ()
-  "Parasha diary entry--entry applies if date is a Saturday."
-  (let ((d (calendar-absolute-from-gregorian date)))
-    (if (= (% d 7) 6);;  Saturday
-        (let*
-            ((h-year (extract-calendar-year
-                      (calendar-hebrew-from-absolute d)))
-             (rosh-hashannah
-              (calendar-absolute-from-hebrew (list 7 1 h-year)))
-             (passover
-              (calendar-absolute-from-hebrew (list 1 15 h-year)))
-             (rosh-hashannah-day
-              (aref calendar-day-name-array (% rosh-hashannah 7)))
-             (passover-day
-              (aref calendar-day-name-array (% passover 7)))
-             (long-h (hebrew-calendar-long-heshvan-p h-year))
-             (short-k (hebrew-calendar-short-kislev-p h-year))
-             (type (cond ((and long-h (not short-k)) "complete")
-                         ((and (not long-h) short-k) "incomplete")
-                         (t "regular")))
-             (year-format
-              (symbol-value
-               (intern (format "hebrew-calendar-year-%s-%s-%s";; keviah
-                               rosh-hashannah-day type passover-day))))
-             (first-saturday;; of Hebrew year
-              (calendar-dayname-on-or-before 6 (+ 6 rosh-hashannah)))
-             (saturday;; which Saturday of the Hebrew year
-              (/ (- d first-saturday) 7))
-             (parasha (aref year-format saturday)))
-          (if parasha
-              (format
-               "Parashat %s"
-               (if (listp parasha);; Israel differs from diaspora
-                   (if (car parasha)
-                       (format "%s (diaspora), %s (Israel)"
-                               (hebrew-calendar-parasha-name (car parasha))
-                               (hebrew-calendar-parasha-name (cdr parasha)))
-                     (format "%s (Israel)"
-                             (hebrew-calendar-parasha-name (cdr parasha))))
-                 (hebrew-calendar-parasha-name parasha))))))))
-
-(defun add-to-diary-list (date string)
-  "Add the entry (DATE STRING) to `diary-entries-list'.
-Do nothing if DATE or STRING is nil."
-  (and date string
-       (setq diary-entries-list 
-             (append diary-entries-list (list (list date string))))))
-
-(defvar hebrew-calendar-parashiot-names
-["Bereshith"   "Noah"      "Lech L'cha" "Vayera"    "Hayei Sarah" "Toledoth"
- "Vayetze"     "Vayishlah" "Vayeshev"   "Mikketz"   "Vayiggash"   "Vayhi"
- "Shemoth"     "Vaera"     "Bo"         "Beshallah" "Yithro"      "Mishpatim"
- "Terumah"     "Tetzavveh" "Ki Tissa"   "Vayakhel"  "Pekudei"     "Vayikra"
- "Tzav"        "Shemini"   "Tazria"     "Metzora"   "Aharei Moth" "Kedoshim"
- "Emor"        "Behar"     "Behukkotai" "Bemidbar"  "Naso"       "Behaalot'cha"
- "Shelah L'cha" "Korah"    "Hukkath"    "Balak"     "Pinhas"      "Mattoth"
- "Masei"       "Devarim"   "Vaethanan"  "Ekev"      "Reeh"        "Shofetim"
- "Ki Tetze"    "Ki Tavo"   "Nitzavim"   "Vayelech"  "Haazinu"]
-  "The names of the parashiot in the Torah.")
-
-;; The seven ordinary year types (keviot)
-
-(defconst hebrew-calendar-year-Saturday-incomplete-Sunday
-  [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
-    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
-    43 44 45 46 47 48 49 50]
-  "The structure of the parashiot.
-Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have
-29 days), and has Passover start on Sunday.")
-
-(defconst hebrew-calendar-year-Saturday-complete-Tuesday
-  [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
-    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
-    43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
-have 30 days), and has Passover start on Tuesday.")
-
-(defconst hebrew-calendar-year-Monday-incomplete-Tuesday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
-    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
-    43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
-have 29 days), and has Passover start on Tuesday.")
-
-(defconst hebrew-calendar-year-Monday-complete-Thursday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
-   23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
-   (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
-30 days), and has Passover start on Thursday.")
-
-(defconst hebrew-calendar-year-Tuesday-regular-Thursday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
-   23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
-   (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
-Kislev has 30 days), and has Passover start on Thursday.")
-
-(defconst hebrew-calendar-year-Thursday-regular-Saturday
-  [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23
-   24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30)
-   (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48
-   49 50]
-  "The structure of the parashiot.
-Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and
-Kislev has 30 days), and has Passover start on Saturday.")
-
-(defconst hebrew-calendar-year-Thursday-complete-Sunday
-  [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
-    43 44 45 46 47 48 49 50]
-  "The structure of the parashiot.
-Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each
-have 30 days), and has Passover start on Sunday.")
-
-;; The seven leap year types (keviot)
-
-(defconst hebrew-calendar-year-Saturday-incomplete-Tuesday
-  [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-    23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42]
-    43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each
-have 29 days), and has Passover start on Tuesday.")
-
-(defconst hebrew-calendar-year-Saturday-complete-Thursday
-  [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-   23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
-   (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
-have 30 days), and has Passover start on Thursday.")
-
-(defconst hebrew-calendar-year-Monday-incomplete-Thursday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-   23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
-   (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
-have 29 days), and has Passover start on Thursday.")
-
-(defconst hebrew-calendar-year-Monday-complete-Saturday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-   23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
-   (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
-   (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
-  "The structure of the parashiot.
-Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
-30 days), and has Passover start on Saturday.")
-
-(defconst hebrew-calendar-year-Tuesday-regular-Saturday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-   23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
-   (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
-   (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
-  "The structure of the parashiot.
-Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
-Kislev has 30 days), and has Passover start on Saturday.")
-
-(defconst hebrew-calendar-year-Thursday-incomplete-Sunday
-  [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-    23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
-    43 44 45 46 47 48 49 50]
-  "The structure of the parashiot.
-Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both
-have 29 days), and has Passover start on Sunday.")
-
-(defconst hebrew-calendar-year-Thursday-complete-Tuesday
-  [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-    23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
-    43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
-have 30 days), and has Passover start on Tuesday.")
-
-(defun hebrew-calendar-parasha-name (p)
-  "Name(s) corresponding to parasha P."
-  (if (arrayp p);; combined parasha
-      (format "%s/%s"
-              (aref hebrew-calendar-parashiot-names (aref p 0))
-              (aref hebrew-calendar-parashiot-names (aref p 1)))
-    (aref hebrew-calendar-parashiot-names p)))
-
-(defun list-islamic-diary-entries ()
-  "Add any Islamic date entries from the diary file to `diary-entries-list'.
-Islamic date diary entries must be prefaced by an `islamic-diary-entry-symbol'
-\(normally an `I').  The same diary date forms govern the style of the Islamic
-calendar entries, except that the Islamic month names must be spelled in full.
-The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
-Dhu al-Hijjah.  If an Islamic date diary entry begins with a
-`diary-nonmarking-symbol', the entry will appear in the diary listing, but will
-not be marked in the calendar.  This function is provided for use with the
-`nongregorian-diary-listing-hook'."
-  (if (< 0 number)
-      (let ((buffer-read-only nil)
-            (diary-modified (buffer-modified-p))
-            (gdate original-date)
-            (mark (regexp-quote diary-nonmarking-symbol)))
-        (calendar-for-loop i from 1 to number do
-           (let* ((d diary-date-forms)
-                  (idate (calendar-islamic-from-absolute 
-                          (calendar-absolute-from-gregorian gdate)))
-                  (month (extract-calendar-month idate))
-                  (day (extract-calendar-day idate))
-                  (year (extract-calendar-year idate)))
-             (while d
-               (let*
-                   ((date-form (if (equal (car (car d)) 'backup)
-                                   (cdr (car d))
-                                 (car d)))
-                    (backup (equal (car (car d)) 'backup))
-                    (dayname
-                     (concat
-                      (calendar-day-name gdate) "\\|"
-                      (substring (calendar-day-name gdate) 0 3) ".?"))
-                    (calendar-month-name-array
-                     calendar-islamic-month-name-array)
-                    (monthname
-                     (concat
-                      "\\*\\|"
-                      (calendar-month-name month)))
-                    (month (concat "\\*\\|0*" (int-to-string month)))
-                    (day (concat "\\*\\|0*" (int-to-string day)))
-                    (year
-                     (concat
-                      "\\*\\|0*" (int-to-string year)
-                      (if abbreviated-calendar-year
-                          (concat "\\|" (int-to-string (% year 100)))
-                        "")))
-                    (regexp
-                     (concat
-                      "\\(\\`\\|\^M\\|\n\\)" mark "?"
-                      (regexp-quote islamic-diary-entry-symbol)
-                      "\\("
-                      (mapconcat 'eval date-form "\\)\\(")
-                      "\\)"))
-                    (case-fold-search t))
-                 (goto-char (point-min))
-                 (while (re-search-forward regexp nil t)
-                   (if backup (re-search-backward "\\<" nil t))
-                   (if (and (or (char-equal (preceding-char) ?\^M)
-                                (char-equal (preceding-char) ?\n))
-                            (not (looking-at " \\|\^I")))
-                       ;;  Diary entry that consists only of date.
-                       (backward-char 1)
-                     ;;  Found a nonempty diary entry--make it visible and
-                     ;;  add it to the list.
-                     (let ((entry-start (point))
-                           (date-start))
-                       (re-search-backward "\^M\\|\n\\|\\`")
-                       (setq date-start (point))
-                       (re-search-forward "\^M\\|\n" nil t 2)
-                       (while (looking-at " \\|\^I")
-                         (re-search-forward "\^M\\|\n" nil t))
-                       (backward-char 1)
-                       (subst-char-in-region date-start (point) ?\^M ?\n t)
-                       (add-to-diary-list
-                         gdate (buffer-substring entry-start (point)))))))
-               (setq d (cdr d))))
-           (setq gdate
-                 (calendar-gregorian-from-absolute
-                  (1+ (calendar-absolute-from-gregorian gdate)))))
-           (set-buffer-modified-p diary-modified))
-        (goto-char (point-min))))
-
-(defun mark-islamic-diary-entries ()
-  "Mark days in the calendar window that have Islamic date diary entries.
-Each entry in diary-file (or included files) visible in the calendar window
-is marked.  Islamic date entries are prefaced by a islamic-diary-entry-symbol
-\(normally an `I').  The same diary-date-forms govern the style of the Islamic
-calendar entries, except that the Islamic month names must be spelled in full.
-The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
-Dhu al-Hijjah.  Islamic date diary entries that begin with a
-diary-nonmarking-symbol will not be marked in the calendar.  This function is
-provided for use as part of the nongregorian-diary-marking-hook."
-  (let ((d diary-date-forms))
-    (while d
-      (let*
-          ((date-form (if (equal (car (car d)) 'backup)
-                          (cdr (car d))
-                        (car d)));; ignore 'backup directive
-           (dayname (diary-name-pattern calendar-day-name-array))
-           (monthname
-            (concat
-             (diary-name-pattern calendar-islamic-month-name-array t)
-             "\\|\\*"))
-           (month "[0-9]+\\|\\*")
-           (day "[0-9]+\\|\\*")
-           (year "[0-9]+\\|\\*")
-           (l (length date-form))
-           (d-name-pos (- l (length (memq 'dayname date-form))))
-           (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
-           (m-name-pos (- l (length (memq 'monthname date-form))))
-           (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
-           (d-pos (- l (length (memq 'day date-form))))
-           (d-pos (if (/= l d-pos) (+ 2 d-pos)))
-           (m-pos (- l (length (memq 'month date-form))))
-           (m-pos (if (/= l m-pos) (+ 2 m-pos)))
-           (y-pos (- l (length (memq 'year date-form))))
-           (y-pos (if (/= l y-pos) (+ 2 y-pos)))
-           (regexp
-            (concat
-             "\\(\\`\\|\^M\\|\n\\)"
-             (regexp-quote islamic-diary-entry-symbol)
-             "\\("
-             (mapconcat 'eval date-form "\\)\\(")
-             "\\)"))
-           (case-fold-search t))
-        (goto-char (point-min))
-        (while (re-search-forward regexp nil t)
-          (let* ((dd-name
-                  (if d-name-pos
-                      (buffer-substring
-                       (match-beginning d-name-pos)
-                       (match-end d-name-pos))))
-                 (mm-name
-                  (if m-name-pos
-                      (buffer-substring
-                       (match-beginning m-name-pos)
-                       (match-end m-name-pos))))
-                 (mm (string-to-int
-                      (if m-pos
-                          (buffer-substring
-                           (match-beginning m-pos)
-                           (match-end m-pos))
-                        "")))
-                 (dd (string-to-int
-                      (if d-pos
-                          (buffer-substring
-                           (match-beginning d-pos)
-                           (match-end d-pos))
-                        "")))
-                 (y-str (if y-pos
-                            (buffer-substring
-                             (match-beginning y-pos)
-                             (match-end y-pos))))
-                 (yy (if (not y-str)
-                         0
-                       (if (and (= (length y-str) 2)
-                                abbreviated-calendar-year)
-                           (let* ((current-y
-                                   (extract-calendar-year
-                                    (calendar-islamic-from-absolute
-                                     (calendar-absolute-from-gregorian
-                                      (calendar-current-date)))))
-                                  (y (+ (string-to-int y-str)
-                                        (* 100 (/ current-y 100)))))
-                             (if (> (- y current-y) 50)
-                                 (- y 100)
-                               (if (> (- current-y y) 50)
-                                   (+ y 100)
-                                 y)))
-                         (string-to-int y-str)))))
-            (if dd-name
-                (mark-calendar-days-named
-                 (cdr (assoc (capitalize (substring dd-name 0 3))
-                             (calendar-make-alist
-                               calendar-day-name-array
-                               0
-                               '(lambda (x) (substring x 0 3))))))
-              (if mm-name
-                  (if (string-equal mm-name "*")
-                      (setq mm 0)
-                    (setq mm
-                          (cdr (assoc
-                                (capitalize mm-name)
-                                (calendar-make-alist
-                                  calendar-islamic-month-name-array))))))
-              (mark-islamic-calendar-date-pattern mm dd yy)))))
-      (setq d (cdr d)))))
-
-(defun mark-islamic-calendar-date-pattern (month day year)
-  "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
-A value of 0 in any position is a wildcard."
-  (save-excursion
-    (set-buffer calendar-buffer)
-    (if (and (/= 0 month) (/= 0 day))
-        (if (/= 0 year)
-            ;; Fully specified Islamic date.
-            (let ((date (calendar-gregorian-from-absolute
-                         (calendar-absolute-from-islamic
-                          (list month day year)))))
-              (if (calendar-date-is-visible-p date)
-                  (mark-visible-calendar-date date)))
-          ;; Month and day in any year--this taken from the holiday stuff.
-          (let* ((islamic-date (calendar-islamic-from-absolute
-                                (calendar-absolute-from-gregorian
-                                 (list displayed-month 15 displayed-year))))
-                 (m (extract-calendar-month islamic-date))
-                 (y (extract-calendar-year islamic-date))
-                 (date))
-            (if (< m 1)
-                nil;;   Islamic calendar doesn't apply.
-              (increment-calendar-month m y (- 10 month))
-              (if (> m 7);;  Islamic date might be visible
-                  (let ((date (calendar-gregorian-from-absolute
-                               (calendar-absolute-from-islamic
-                                (list month day y)))))
-                    (if (calendar-date-is-visible-p date)
-                        (mark-visible-calendar-date date)))))))
-      ;; Not one of the simple cases--check all visible dates for match.
-      ;; Actually, the following code takes care of ALL of the cases, but
-      ;; it's much too slow to be used for the simple (common) cases.
-      (let ((m displayed-month)
-            (y displayed-year)
-            (first-date)
-            (last-date))
-        (increment-calendar-month m y -1)
-        (setq first-date
-              (calendar-absolute-from-gregorian
-               (list m 1 y)))
-        (increment-calendar-month m y 2)
-        (setq last-date
-              (calendar-absolute-from-gregorian
-               (list m (calendar-last-day-of-month m y) y)))
-        (calendar-for-loop date from first-date to last-date do
-          (let* ((i-date (calendar-islamic-from-absolute date))
-                 (i-month (extract-calendar-month i-date))
-                 (i-day (extract-calendar-day i-date))
-                 (i-year (extract-calendar-year i-date)))
-            (and (or (zerop month)
-                     (= month i-month))
-                 (or (zerop day)
-                     (= day i-day))
-                 (or (zerop year)
-                     (= year i-year))
-                 (mark-visible-calendar-date
-                  (calendar-gregorian-from-absolute date)))))))))
-
-(provide 'diary-lib)
-
-;;; diary-lib.el ends here
diff --git a/lisp/=ftp.el b/lisp/=ftp.el
deleted file mode 100644
index 01186dda27a..00000000000
--- a/lisp/=ftp.el
+++ /dev/null
@@ -1,392 +0,0 @@
-;;; ftp.el --- file input and output over Internet using FTP
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik <mly@prep.ai.mit.edu>
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-;; Prevent changes in major modes from altering these variables.
-(put 'ftp-temp-file-name 'permanent-local t)
-(put 'ftp-file 'permanent-local t)
-(put 'ftp-host 'permanent-local t)
-
-;; you can turn this off by doing
-;;  (setq ftp-password-alist 'compulsory-urinalysis)
-(defvar ftp-password-alist () "Security sucks")
-
-(defun read-ftp-user-password (host user new)
-  (let (tem)
-    (if (and (not new)
-	     (listp ftp-password-alist)
-	     (setq tem (cdr (assoc host ftp-password-alist)))
-	     (or (null user)
-		 (string= user (car tem))))
-	tem
-      (or user
-	  (progn
-	    (setq tem (or (and (listp ftp-password-alist)
-			       (car (cdr (assoc host ftp-password-alist))))
-			  (user-login-name)))
-	    (setq user (read-string (format
-				      "User-name for %s (default \"%s\"): "
-				      host tem)))
-	    (if (equal user "") (setq user tem))))
-      (setq tem (cons user
-		      ;; If you want to use some non-echoing string-reader,
-		      ;; feel free to write it yourself.  I don't care enough.
-		      (read-string (format "Password for %s@%s: " user host)
-			(if (not (listp ftp-password-alist))
-			    ""
-			  (or (cdr (cdr (assoc host ftp-password-alist)))
-			      (let ((l ftp-password-alist))
-				(catch 'foo
-				  (while l
-				    (if (string= (car (cdr (car l))) user)
-					(throw 'foo (cdr (cdr (car l))))
-				      (setq l (cdr l))))
-				  nil))
-			      "")))))
-      (message "")
-      (if (and (listp ftp-password-alist)
-	       (not (string= (cdr tem) "")))
-	  (setq ftp-password-alist (cons (cons host tem)
-					 ftp-password-alist)))
-      tem)))
-
-(defun ftp-read-file-name (prompt)
-  (let ((s ""))
-    (while (not (string-match "\\`[ \t]*\\([^ \t:]+\\)[ \t]*:\\(.+\\)\\'" s))
-      (setq s (read-string prompt s)))
-    (list (substring s (match-beginning 1) (match-end 1))
-	  (substring s (match-beginning 2) (match-end 2)))))
-
-
-;;;###autoload
-(defun ftp-find-file (host file &optional user password)
-  "FTP to HOST to get FILE, logging in as USER with password PASSWORD.
-Interactively, HOST and FILE are specified by reading a string with
- a colon character separating the host from the filename.
-USER and PASSWORD are defaulted from the values used when
- last ftping from HOST (unless password-remembering is disabled).
- Supply a password of the symbol `t' to override this default
- (interactively, this is done by giving a prefix arg)"
-  (interactive
-	(append (ftp-read-file-name "FTP get host:file: ")
-		(list nil (not (null current-prefix-arg)))))
-  (ftp-find-file-or-directory host file t user password))
-
-;;;###autoload
-(defun ftp-list-directory (host file &optional user password)
-  "FTP to HOST to list DIRECTORY, logging in as USER with password PASSWORD.
-Interactively, HOST and FILE are specified by reading a string with
- a colon character separating the host from the filename.
-USER and PASSWORD are defaulted from the values used when
- last ftping from HOST (unless password-remembering is disabled).
- Supply a password of the symbol `t' to override this default
- (interactively, this is done by giving a prefix arg)"
-  (interactive
-	(append (ftp-read-file-name "FTP get host:directory: ")
-		(list nil (not (null current-prefix-arg)))))
-  (ftp-find-file-or-directory host file nil user password))
-
-(defun ftp-find-file-or-directory (host file filep &optional user password)
-  "FTP to HOST to get FILE.  Third arg is t for file, nil for directory.
-Log in as USER with PASSWORD.  If USER is nil or PASSWORD is nil or t,
-we prompt for the user name and password."
-  (or (and user password (not (eq password t)))
-      (progn (setq user (read-ftp-user-password host user (eq password t))
-		   password (cdr user)
-		   user (car user))))
-  (let ((buffer (get-buffer-create (format "*ftp%s %s:%s*"
-					   (if filep "" "-directory")
-					   host file))))
-    (set-buffer buffer)
-    (let ((process nil)
-	  (case-fold-search nil))
-      (let ((win nil))
-	(unwind-protect
-	    (progn
-	      (setq process (ftp-setup-buffer host file))
-	      (if (setq win (ftp-login process host user password))
-		  (message "Logged in")
-		(error "Ftp login failed")))
-	  (or win (and process (delete-process process)))))
-      (message "Opening %s %s:%s..." (if filep "file" "directory")
-	       host file)
-      (if (ftp-command process
-		       (format "%s \"%s\" -\nquit\n" (if filep "get" "dir")
-			       file)
-		       "\\(150\\|125\\).*\n"
-		       "200.*\n")
-	  (progn (forward-line 1)
-		 (let ((buffer-read-only nil))
-		   (delete-region (point-min) (point)))
-		 (message "Retrieving %s:%s in background.  Bye!" host file)
-		 (set-process-sentinel process
-				       'ftp-asynchronous-input-sentinel)
-		 process)
-	(switch-to-buffer buffer)
-	(let ((buffer-read-only nil))
-	  (insert-before-markers "<<<Ftp lost>>>"))
-	(delete-process process)
-	(error "Ftp %s:%s lost" host file)))))
-
-
-;;;###autoload
-(defun ftp-write-file (host file &optional user password)
-  "FTP to HOST to write FILE, logging in as USER with password PASSWORD.
-Interactively, HOST and FILE are specified by reading a string with colon
-separating the host from the filename.
-USER and PASSWORD are defaulted from the values used when
- last ftping from HOST (unless `password-remembering' is disabled).
- Supply a password of the symbol `t' to override this default
- (interactively, this is done by giving a prefix arg)"
-  (interactive
-    (append (ftp-read-file-name "FTP write host:file: ")
-	    (list nil (not (null current-prefix-arg)))))
-  (or (and user password (not (eq password t)))
-      (progn (setq user (read-ftp-user-password host user (eq password t))
-		   password (cdr user)
-		   user (car user))))
-  (let ((buffer (get-buffer-create (format "*ftp %s:%s*" host file)))
-	(tmp (make-temp-name "/tmp/emacsftp")))
-    (write-region (point-min) (point-max) tmp)
-    (save-excursion
-      (set-buffer buffer)
-      (make-local-variable 'ftp-temp-file-name)
-      (setq ftp-temp-file-name tmp)
-      (let ((process (ftp-setup-buffer host file))
-	    (case-fold-search nil))
-	(let ((win nil))
-	  (unwind-protect
-	      (if (setq win (ftp-login process host user password))
-		  (message "Logged in")
-	        (error "Ftp login lost"))
-	    (or win (delete-process process))))
-	(message "Opening file %s:%s..." host file)
-	(if (ftp-command process
-			 (format "send \"%s\" \"%s\"\nquit\n" tmp file)
-			 "\\(150\\|125\\).*\n"
-			 "200.*\n")
-	    (progn (forward-line 1)
-		   (setq foo1 (current-buffer))
-		   (let ((buffer-read-only nil))
-		     (delete-region (point-min) (point)))
-		   (message "Saving %s:%s in background.  Bye!" host file)
-		   (set-process-sentinel process
-					 'ftp-asynchronous-output-sentinel)
-		   process)
-	  (switch-to-buffer buffer)
-	  (setq foo2 (current-buffer))
-	  (let ((buffer-read-only nil))
-	    (insert-before-markers "<<<Ftp lost>>>"))
-	  (delete-process process)
-	  (error "Ftp write %s:%s lost" host file))))))
-
-
-(defun ftp-setup-buffer (host file)
-  (fundamental-mode)
-  (and (get-buffer-process (current-buffer))
-       (progn (discard-input)
-	      (if (y-or-n-p (format "Kill process \"%s\" in %s? "
-				    (process-name (get-buffer-process
-						    (current-buffer)))
-				    (buffer-name (current-buffer))))
-		  (while (get-buffer-process (current-buffer))
-		    (kill-process (get-buffer-process (current-buffer))))
-		(error "Foo"))))
-  ;(buffer-disable-undo (current-buffer))
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  (make-local-variable 'ftp-host)
-  (setq ftp-host host)
-  (make-local-variable 'ftp-file)
-  (setq ftp-file file)
-  (setq foo3 (current-buffer))
-  (setq buffer-read-only t)
-  (start-process "ftp" (current-buffer) "ftp" "-i" "-n" "-g"))
-
-
-(defun ftp-login (process host user password)
-  (message "FTP logging in as %s@%s..." user host)
-  (if (ftp-command process
-		   (format "open %s\nuser %s %s\n" host user password)
-		   "230.*\n"
-		   "\\(Connected to \\|220\\|331\\|Remote system type\\|Using.*mode\\|Remember to set\\).*\n")
-      t
-    (switch-to-buffer (process-buffer process))
-    (delete-process process)
-    (if (listp ftp-password-alist)
-	(setq ftp-password-alist (delq (assoc host ftp-password-alist)
-				       ftp-password-alist)))
-    nil))
-
-(defun ftp-command (process command win ignore)
-  (process-send-string process command)
-  (let ((p 1))
-    (while (numberp p)
-      (cond ;((not (bolp)))
-	    ((looking-at "^[0-9]+-")
-	     (while (not (re-search-forward "^[0-9]+ " nil t))
-	       (save-excursion
-		 (accept-process-output process)))
-	     (beginning-of-line))
-	    ((looking-at win)
-	     (goto-char (point-max))
-	     (setq p t))
-	    ((looking-at "^ftp> \\|^\n")
-	     (goto-char (match-end 0)))
-	    ((looking-at ignore)
-	     ;; Ignore status messages whose codes indicate no problem.
-	     (forward-line 1))
-	    ((looking-at "^[^0-9]")
-	     ;; Ignore any lines that don't have status codes.
-	     (forward-line 1))
-	    ((not (search-forward "\n" nil t))
-	     ;; the way asynchronous process-output works with (point)
-	     ;;  is really really disgusting.
-	     (setq p (point))
-	     (condition-case ()
-		 (accept-process-output process)
-	       (error nil))
-	     (goto-char p))
-	    (t
-	     (setq p nil))))
-    p))
-
-
-(defun ftp-asynchronous-input-sentinel (process msg)
-  (ftp-sentinel process msg t t))
-(defun ftp-synchronous-input-sentinel (process msg)
-  (ftp-sentinel process msg nil t))
-(defun ftp-asynchronous-output-sentinel (process msg)
-  (ftp-sentinel process msg t nil))
-(defun ftp-synchronous-output-sentinel (process msg)
-  (ftp-sentinel process msg nil nil))
-
-(defun ftp-sentinel (process msg asynchronous input)
-  (cond ((null (buffer-name (process-buffer process)))
-	 ;; deleted buffer
-	 (set-process-buffer process nil))
-	((and (eq (process-status process) 'exit)
-	      (= (process-exit-status process) 0))
-	 (save-excursion
-	   (set-buffer (process-buffer process))
-	   (let (msg
-		 (r (if input "[0-9]+ bytes received in [0-9]+\\.[0-9]+ seconds.*$" "[0-9]+ bytes sent in [0-9]+\\.[0-9]+ seconds.*$")))
-	     (goto-char (point-max))
-	     (search-backward "226 ")
-	     (if (looking-at r)
-		 (search-backward "226 "))
-	     (let ((p (point)))
-	       (setq msg (concat (format "ftp %s %s:%s done"
-					 (if input "read" "write")
-					 ftp-host ftp-file)
-				 (if (re-search-forward r nil t)
-				     (concat ": " (buffer-substring
-						   (match-beginning 0)
-						   (match-end 0)))
-				   "")))
-	       (delete-region p (point-max))
-	       (save-excursion
-		 (set-buffer (get-buffer-create "*ftp log*"))
-		 (let ((buffer-read-only nil))
-		   (insert msg ?\n))))
-	     ;; Note the preceding let must end here
-	     ;; so it doesn't cross the (kill-buffer (current-buffer)).
-	     (if (not input)
-		 (progn
-		   (condition-case ()
-		       (and (boundp 'ftp-temp-file-name)
-			    ftp-temp-file-name
-			    (delete-file ftp-temp-file-name))
-		     (error nil))
-		   ;; Kill the temporary buffer which the ftp process
-		   ;; puts its output in.
-		   (kill-buffer (current-buffer)))
-	       ;; You don't want to look at this.
-	       (let ((kludge (generate-new-buffer (format "%s:%s (ftp)"
-							  ftp-host ftp-file))))
-		 (setq kludge (prog1 (buffer-name kludge) (kill-buffer kludge)))
-		 (rename-buffer kludge)
-		 ;; ok, you can look again now.
-		 (set-buffer-modified-p nil)
-		 (ftp-setup-write-file-hooks)))
-	     (if (and asynchronous
-		      ;(waiting-for-user-input-p)
-		      )
-		 (progn (message "%s" msg)
-			(sleep-for 2))))))
-	((memq (process-status process) '(exit signal))
-	 (save-excursion
-	   (set-buffer (process-buffer process))
-	   (setq msg (format "Ftp died (buffer %s): %s"
-			     (buffer-name (current-buffer))
-			     msg))
-	   (let ((buffer-read-only nil))
-	     (goto-char (point-max))
-	     (insert ?\n ?\n msg))
-	   (delete-process proc)
-	   (set-buffer (get-buffer-create "*ftp log*"))
-	   (let ((buffer-read-only nil))
-	     (goto-char (point-max))
-	     (insert msg))
-	   (if (waiting-for-user-input-p)
-	       (error "%s" msg))))))
-
-(defun ftp-setup-write-file-hooks ()
-  (let ((hooks write-file-hooks))
-    (make-local-variable 'write-file-hooks)
-    (setq write-file-hooks (append write-file-hooks
-				   '(ftp-write-file-hook))))
-  (make-local-variable 'revert-buffer-function)
-  (setq revert-buffer-function 'ftp-revert-buffer)
-  (setq default-directory "/tmp/")
-  (setq buffer-file-name (concat default-directory
-				 (make-temp-name
-				  (buffer-name (current-buffer)))))
-  (setq buffer-read-only nil))
-
-(defun ftp-write-file-hook ()
-  (let ((process (ftp-write-file ftp-host ftp-file)))
-    (set-process-sentinel process 'ftp-synchronous-output-sentinel)
-    (message "FTP writing %s:%s..." ftp-host ftp-file)
-    (while (eq (process-status process) 'run)
-      (condition-case ()
-	  (accept-process-output process)
-	(error nil)))
-    (set-buffer-modified-p nil)
-    (message "FTP writing %s:%s...done" ftp-host ftp-file))
-  t)
-
-(defun ftp-revert-buffer (&rest ignore)
-  (let ((process (ftp-find-file ftp-host ftp-file)))
-    (set-process-sentinel process 'ftp-synchronous-input-sentinel)
-    (message "FTP reverting %s:%s" ftp-host ftp-file)
-    (while (eq (process-status process) 'run)
-      (condition-case ()
-	  (accept-process-output process)
-	(error nil)))
-    (and (eq (process-status process) 'exit)
-	 (= (process-exit-status process) 0)
-	 (set-buffer-modified-p nil))
-    (message "Reverted")))
-
-;;; ftp.el ends here
diff --git a/lisp/=gnus-uu.el b/lisp/=gnus-uu.el
deleted file mode 100644
index b85f2e23f89..00000000000
--- a/lisp/=gnus-uu.el
+++ /dev/null
@@ -1,3057 +0,0 @@
-;;; gnus-uu.el --- extract, view or save (uu)encoded files from gnus
-
-;; Copyright (C) 1985, 1986, 1987, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Lars Ingebrigtsen <larsi@ifi.uio.no>
-;; Created: 2 Oct 1993
-;; Version: v2.8
-;; Last Modified: 1994/06/01
-;; Keywords: news
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; All gnus-uu commands start with `C-c C-v'.
-;;
-;; Short user manual for this package:
-;;
-;; Type `C-c C-v C-v' to decode and view all articles of the current
-;; series. The defaults should be reasonable for most systems.
-;;
-;; Type `C-c C-v C-i' to toggle interactive mode. When using
-;; interactive mode, gnus-uu will which display a buffer that will let
-;; you see the suggested commands to be executed.
-;;
-;; To post an uuencoded file, type `C-c C-v p', which will enter you
-;; into a buffer analogous to the one you will get when typing `a'. Do
-;; an `M-x describe-mode' in this buffer to get a description of what
-;; this buffer lets you do.
-;;
-;; Read the documentation of the `gnus-uu' dummy function for a more
-;; complete description of what this package does and how you can
-;; customize it to fit your needs.
-;; 
-;;
-;;
-;; History
-;;
-;; v1.0: First version released Oct 2 1992.
-;;
-;; v1.1: Changed `C-c C-r' to `C-c C-e' and `C-c C-p' to `C-c C-k'.
-;; Changed (setq gnus-exit-group-hook) to (add-hook).  Removed
-;; checking for "Re:" for finding parts.
-;;
-;; v2.2: Fixed handling of currupted archives. Changed uudecoding to
-;; an asynchronous process to avoid loading tons of data into emacs
-;; buffers. No longer reads articles emacs already have aboard.  Fixed
-;; a firmer support for shar files. Made regexp searches for files
-;; more convenient. Added `C-c C-l' for editing uucode begin
-;; lines. Added multi-system decoder entry point. Added interactive
-;; view mode. Added function for decoding and saving all uuencoded
-;; articles in the current newsgroup.
-;;
-;; v2.3: After suggestions I have changed all the gnus-uu key bindings
-;; to avoid hogging all the user keys (C-c LETTER). Also added
-;; (provide) and fixed some saving stuff. First posted version to
-;; gnu.emacs.sources.
-;;
-;; v2.4: Fixed some more in the save-all category. Automatic fixing of
-;; uucode "begin" lines: names on the form of "dir/file" are
-;; translated into "dir-file". Added a function for fixing stripped
-;; uucode articles. Added binhex save.
-;;
-;; v2.5: First version copyrighted by FSF. Changed lots of
-;; documentation strings.
-;;
-;; v2.5.1: Added uuencode/posting code to post binary files. 
-;;
-;; v2.6: Thread support. gnus-uu is now able to decode uuencoded files
-;; posted in threads. gnus-uu can also post in threads. I don't know
-;; if this ability is of much use - I've never seen anyone post
-;; uuencoded files in threads.
-;;
-;; v2.7: gnus-uu is now able to decode (and view/save) multiple
-;; encoded files in one big gulp. Also added pseudo-mime support
-;; (users can use metamail to view files), posting uuencoded/mime
-;; files and various other bits and pieces.
-;;
-;; v2.7.1: New functions for decoding/saving threads bound to `C-c
-;; C-v C-j'. Handy to save entire threads, not very useful for
-;; decoding, as nobody posts encoded files in threads...
-;;
-;; v2.7.2: New functions for digesting and forwarding articles added
-;; on the suggestion of Per Abrahamsen. Also added a function for
-;; marking threads. 
-;;
-;; v2.8: Fixed saving original files in interactive mode. Fixed ask
-;; before/save after view. Fixed setting up interactive buffers. Added
-;; scanning and rescanning from interactive mode. Added the
-;; `gnus-uu-ignore-file-by-name' and `...-by-type' variables to allow
-;; users to sift files they don't want to view. At the suggestion of
-;; boris@cs.rochester.edu, `C-c C-v C-h' has been undefined to allow
-;; users to view list of binding beginning with `C-c C-v'. Fixed
-;; viewing with `gnus-uu-asynchronous' set. The
-;; "decode-and-save/view-all-articles" functions now accepts the
-;; numeric prefix to delimit the maximum number of files to be
-;; decoded.
-
-;;; Code: 
-
-(require 'gnus)
-(require 'gnuspost)
-
-;; Binding of keys to the gnus-uu functions.
-
-(defvar gnus-uu-ctl-map nil)
-(define-prefix-command 'gnus-uu-ctl-map)
-(define-key gnus-summary-mode-map "\C-c\C-v" gnus-uu-ctl-map)
-
-(define-key gnus-uu-ctl-map "\C-v" 'gnus-uu-decode-and-view)
-(define-key gnus-uu-ctl-map "v" 'gnus-uu-decode-and-save)
-(define-key gnus-uu-ctl-map "\C-s" 'gnus-uu-shar-and-view)
-(define-key gnus-uu-ctl-map "s" 'gnus-uu-shar-and-save)
-(define-key gnus-uu-ctl-map "\C-m" 'gnus-uu-multi-decode-and-view)
-(define-key gnus-uu-ctl-map "m" 'gnus-uu-multi-decode-and-save)
-
-(define-key gnus-uu-ctl-map "\C-b" 'gnus-uu-decode-and-show-in-buffer)
-
-(define-key gnus-summary-mode-map "#" 'gnus-uu-mark-article)
-(define-key gnus-summary-mode-map "\M-#" 'gnus-uu-unmark-article)
-(define-key gnus-uu-ctl-map "\C-u" 'gnus-uu-unmark-all-articles)
-(define-key gnus-uu-ctl-map "\C-r" 'gnus-uu-mark-by-regexp)
-(define-key gnus-uu-ctl-map "r" 'gnus-uu-mark-by-regexp)
-(define-key gnus-uu-ctl-map "t" 'gnus-uu-mark-thread)
-
-(define-key gnus-uu-ctl-map "\M-\C-v" 'gnus-uu-marked-decode-and-view)
-(define-key gnus-uu-ctl-map "\M-v" 'gnus-uu-marked-decode-and-save)
-(define-key gnus-uu-ctl-map "\M-\C-s" 'gnus-uu-marked-shar-and-view)
-(define-key gnus-uu-ctl-map "\M-s" 'gnus-uu-marked-shar-and-save)
-(define-key gnus-uu-ctl-map "\M-\C-m" 'gnus-uu-marked-multi-decode-and-view)
-(define-key gnus-uu-ctl-map "\M-m" 'gnus-uu-marked-multi-decode-and-save)
-
-(define-key gnus-uu-ctl-map "f" 'gnus-uu-digest-and-forward)
-(define-key gnus-uu-ctl-map "\M-f" 'gnus-uu-marked-digest-and-forward)
-
-(define-key gnus-uu-ctl-map "\C-i" 'gnus-uu-toggle-interactive-view)
-(define-key gnus-uu-ctl-map "\C-t" 'gnus-uu-toggle-any-variable)
-
-(define-key gnus-uu-ctl-map "\C-l" 'gnus-uu-edit-begin-line)
-
-(define-key gnus-uu-ctl-map "a" 'gnus-uu-decode-and-save-all-unread-articles)
-(define-key gnus-uu-ctl-map "w" 'gnus-uu-decode-and-save-all-articles)
-(define-key gnus-uu-ctl-map "\C-a" 'gnus-uu-decode-and-view-all-unread-articles)
-(define-key gnus-uu-ctl-map "\C-w" 'gnus-uu-decode-and-view-all-articles)
-
-(define-key gnus-uu-ctl-map "\C-j" 'gnus-uu-threaded-multi-decode-and-view)
-(define-key gnus-uu-ctl-map "j" 'gnus-uu-threaded-multi-decode-and-save)
-
-(define-key gnus-uu-ctl-map "p" 'gnus-uu-post-news)
-
-;; Dummy function gnus-uu
-
-(defun gnus-uu ()
-  "gnus-uu is a package for uudecoding and viewing articles.
-
-
-Keymap overview:
-
-By default, all gnus-uu keystrokes begin with `C-c C-v'. 
-
-There four decoding commands categories:
-All commands for viewing are `C-c C-v C-LETTER'.
-All commands for saving are `C-c C-v LETTER'.
-All commands for marked viewing are `C-c C-v C-M-LETTER'.
-All commands for marked saving are `C-c C-v M-LETTER'.
-
-\\<gnus-summary-mode-map>\\[gnus-uu-decode-and-view]\tDecode and view articles
-\\[gnus-uu-decode-and-save]\tDecode and save articles
-\\[gnus-uu-shar-and-view]\tUnshar and view articles
-\\[gnus-uu-shar-and-save]\tUnshar and save articles
-\\[gnus-uu-multi-decode-and-view]\tChoose a decoding method, decode and view articles
-\\[gnus-uu-multi-decode-and-save]\tChoose a decoding method, decode and save articles
-
-\\[gnus-uu-threaded-multi-decode-and-view]\tDecode a thread and view
-\\[gnus-uu-threaded-multi-decode-and-save]\tDecode a thread and save
-
-\\[gnus-uu-decode-and-show-in-buffer]\tDecode the current article and view the result in a buffer
-\\[gnus-uu-edit-begin-line]\tEdit the 'begin' line of an uuencoded article
-
-\\[gnus-uu-decode-and-save-all-unread-articles]\tDecode and save all unread articles
-\\[gnus-uu-decode-and-save-all-articles]\tDecode and save all articles
-\\[gnus-uu-decode-and-view-all-unread-articles]\tDecode and view all unread articles
-\\[gnus-uu-decode-and-view-all-articles]\tDecode and view all articles
-
-\\[gnus-uu-digest-and-forward]\tDigest and forward a series of articles
-\\[gnus-uu-marked-digest-and-forward]\tDigest and forward all marked articles
-
-\\[gnus-uu-mark-article]\tMark the current article for decoding
-\\[gnus-uu-unmark-article]\tUnmark the current article
-\\[gnus-uu-unmark-all-articles]\tUnmark all articles
-\\[gnus-uu-mark-by-regexp]\tMark articles for decoding by regexp
-\\[gnus-uu-mark-thread]\tMark articles in this thread
-\\[gnus-uu-marked-decode-and-view]\tDecode and view marked articles
-\\[gnus-uu-marked-decode-and-save]\tDecode and save marked articles
-\\[gnus-uu-marked-shar-and-view]\tUnshar and view marked articles
-\\[gnus-uu-marked-shar-and-save]\tUnshar and save marked articles
-\\[gnus-uu-marked-multi-decode-and-view]\tChoose decoding method, decode and view marked articles
-\\[gnus-uu-marked-multi-decode-and-save]\tChoose decoding method, decode and save marked articles
-
-\\[gnus-uu-toggle-asynchronous]\tToggle asynchronous viewing mode
-\\[gnus-uu-toggle-query]\tToggle whether to ask before viewing a file
-\\[gnus-uu-toggle-always-ask]\tToggle whether to ask to save a file after viewing
-\\[gnus-uu-toggle-kill-carriage-return]\tToggle whether to strip trailing carriage returns
-\\[gnus-uu-toggle-interactive-view]\tToggle whether to use interactive viewing mode
-\\[gnus-uu-toggle-correct-stripped-articles]\tToggle whether to 'correct' articles
-\\[gnus-uu-toggle-view-with-metamail]\tToggle whether to use metamail for viewing 
-\\[gnus-uu-toggle-any-variable]\tToggle any of the things above
-
-\\[gnus-uu-post-news]\tPost an uuencoded article
-
-Function description:
-
-`gnus-uu-decode-and-view' will try to find all articles in the same
-series, uudecode them and view the resulting file(s).
-
-gnus-uu guesses what articles are in the series according to the
-following simplish rule: The subjects must be (nearly) identical,
-except for the last two numbers of the line. (Spaces are largely
-ignored, however.)
-
-For example: If you choose a subject called 
-  \"cat.gif (2/3)\"
-gnus-uu will find all the articles that matches
-  \"^cat.gif ([0-9]+/[0-9]+).*$\".  
-
-Subjects that are nonstandard, like 
-  \"cat.gif (2/3) Part 6 of a series\", 
-will not be properly recognized by any of the automatic viewing
-commands, and you have to mark the articles manually with '#'.
-
-`gnus-uu-decode-and-save' will do the same as
-`gnus-uu-decode-and-view', except that it will not display the
-resulting file, but save it instead.
-
-`gnus-uu-shar-and-view' and `gnus-uu-shar-and-save' are the \"shar\"
-equivalents to the uudecode functions. Instead of feeding the articles
-to uudecode, they are run through /bin/sh. Most shar files can be
-viewed and/or saved with the normal uudecode commands, which is much
-safer, as no foreign code is run.
-
-Instead of having windows popping up automatically, it can be handy to
-view files interactivly, especially when viewing archives. Use
-`gnus-uu-toggle-interactive-mode' to toggle interactive mode.
-
-`gnus-uu-mark-article' marks an article for later
-decoding/unsharing/saving/viewing. The files will be decoded in the
-sequence they were marked. To decode the files after you've marked the
-articles you are interested in, type the corresponding key strokes as
-the normal decoding commands, but put a `M-' in the last
-keystroke. For instance, to perform a standard uudecode and view, you
-would type `C-c C-v C-v'. To perform a marked uudecode and view, say
-`C-v C-v M-C-v'. All the other view and save commands are handled the
-same way; marked uudecode and save is then `C-c C-v M-v'.
-
-`gnus-uu-unmark-article' will remove the mark from a previosly marked
-article.
-
-`gnus-uu-unmark-all-articles' will remove the mark from all marked
-articles.
-
-`gnus-uu-mark-by-regexp' will prompt for a regular expression and mark
-all articles matching that regular expression.
-
-`gnus-uu-mark-thread' will mark all articles downward in the current
-thread.
-
-There's an additional way to reach the decoding functions to make
-future expansions easier: `gnus-uu-multi-decode-and-view' and the
-corresponding save, marked view and marked save functions. You will be
-prompted for a decoding method, like uudecode, shar, binhex or plain
-save. Note that methods like binhex and save doesn't have view modes;
-even if you issue a view command (`C-c C-v C-m' and \"binhex\"),
-gnus-uu will just save the resulting binhex file.
-
-`gnus-uu-decode-and-show-in-buffer' will decode the current article
-and display the results in an emacs buffer. This might be useful if
-there's jsut some text in the current article that has been uuencoded
-by some perverse poster.
-
-`gnus-uu-decode-and-save-all-articles' looks at all the articles in
-the current newsgroup and tries to uudecode everything it can
-find. The user will be prompted for a directory where the resulting
-files (if any) will be
-saved. `gnus-uu-decode-and-save-unread-articles' does only checks
-unread articles. 
-
-`gnus-uu-decode-and-view-all-articles' does the same as the function
-above, only viewing files instead of saving them. 
-
-`gnus-uu-edit-begin-line' lets you edit the begin line of an uuencoded
-file in the current article. Useful to change a corrupted begin line.
-
-
-When using the view commands, `gnus-uu-decode-and-view' for instance,
-gnus-uu will (normally, see below) try to view the file according to
-the rules given in `gnus-uu-default-view-rules' and
-`gnus-uu-user-view-rules'. If it recognizes the file, it will display
-it immediately. If the file is some sort of archive, gnus-uu will
-attempt to unpack the archive and see if any of the files in the
-archive can be viewed. For instance, if you have a gzipped tar file
-\"pics.tar.gz\" containing the files \"pic1.jpg\" and \"pic2.gif\",
-gnus-uu will uncompress and detar the main file, and then view the two
-pictures. This unpacking process is recursive, so if the archive
-contains archives of archives, it'll all be unpacked.
-
-If the view command doesn't recognise the file type, or can't view it
-because you don't have the viewer, or can't view *any* of the files in
-the archive, the user will be asked if she wishes to have the file
-saved somewhere. Note that if the decoded file is an archive, and
-gnus-uu manages to view some of the files in the archive, it won't
-tell the user that there were some files that were unviewable. Try
-interactive view for a different approach.
-
-
-Note that gnus-uu adds a function to `gnus-exit-group-hook' to clear
-the list of marked articles and check for any generated files that
-might have escaped deletion if the user typed `C-g' during viewing.
-
-
-`gnus-uu-toggle-asynchronous' toggles the `gnus-uu-asynchronous'
-variable.
-
-`gnus-uu-toggle-query' toggles the `gnus-uu-ask-before-view'
-variable.
-
-`gnus-uu-toggle-always-ask' toggles the `gnus-uu-view-and-save'
-variable.
-
-`gnus-uu-toggle-kill-carriage-return' toggles the
-`gnus-uu-kill-carriage-return' variable.
-
-`gnus-uu-toggle-interactive-view' toggles interactive mode. If it is
-turned on, gnus-uu won't view files immediately, but will give you a
-buffer with the default commands and files and let you edit the
-commands and execute them at leisure.
-
-`gnus-uu-toggle-correct-stripped-articles' toggles whether to check
-and correct uuencoded articles that may have had trailing spaces
-stripped by mailers.
-
-`gnus-uu-toggle-view-with-metamail' toggles whether to skip the
-gnus-uu viewing methods and just guess at an content-type based on the
-file name suffix and feed it to metamail.
-
-`gnus-uu-toggle-any-variable' is an interface to the toggle commands
-listed above.
-
-
-Customization
-
-   Rule Variables
-
-   gnus-uu uses \"rule\" variables to decide how to view a file. All
-   these variables are of the form
-  
-      (list '(regexp1 command2)
-            '(regexp2 command2)
-            ...)
-
-   `gnus-uu-user-view-rules'
-     This variable is consulted first when viewing files. If you wish
-     to use, for instance, sox to convert an .au sound file, you could
-     say something like:
-
-       (setq gnus-uu-user-view-rules
-         (list '(\"\\\\.au$\" \"sox %s -t .aiff > /dev/audio\")))
-
-   `gnus-uu-user-view-rules-end'
-     This variable is consulted if gnus-uu couldn't make any matches
-     from the user and default view rules.
-
-   `gnus-uu-user-interactive-view-rules'
-     This is the variable used instead of `gnus-uu-user-view-rules'
-     when in interactive mode.
-
-   `gnus-uu-user-interactive-view-rules-end'
-     This variable is used instead of `gnus-uu-user-view-rules-end'
-     when in interactive mode.
-
-   `gnus-uu-user-archive-rules`
-     This variable can be used to say what comamnds should be used to
-     unpack archives.
-
-   
-   Other Variables
-
-   `gnus-uu-ignore-files-by-name'
-     Files with name matching this regular expression won't be viewed.
-
-   `gnus-uu-ignore-files-by-type'
-     Files with a MIME type matching this variable won't be viewed.
-     Note that gnus-uu tries to guess what type the file is based on
-     the name. gnus-uu is not a MIME package, so this is slightly
-     kludgy.
-
-   `gnus-uu-tmp-dir'
-     Where gnus-uu does its work.
-
-   `gnus-uu-do-not-unpack-archives'
-     Non-nil means that gnus-uu won't peek inside archives looking for
-     files to dispay.
-
-   `gnus-uu-view-and-save'
-     Non-nil means that the user will always be asked to save a file
-     after viewing it.
-
-   `gnus-uu-asynchronous' 
-     Non-nil means that files will be viewed asynchronously.  This can
-     be useful if you're viewing long .mod files, for instance, which
-     often takes several minutes. Note, however, that since gnus-uu
-     doesn't ask, and if you are viewing an archive with lots of
-     viewable files, you'll get them all up more or less at once,
-     which can be confusing, to say the least. To get gnus-uu to ask
-     you before viewing a file, set the `gnus-uu-ask-before-view' 
-     variable.
-
-   `gnus-uu-ask-before-view'
-     Non-nil means that gnus-uu will ask you before viewing each file
-
-   `gnus-uu-ignore-default-view-rules'
-     Non-nil means that gnus-uu will ignore the default viewing rules.
-
-   `gnus-uu-ignore-default-archive-rules'
-     Non-nil means that gnus-uu will ignore the default archive
-     unpacking commands.
-
-   `gnus-uu-kill-carriage-return'
-     Non-nil means that gnus-uu will strip all carriage returns from
-     articles.
-
-   `gnus-uu-unmark-articles-not-decoded'
-     Non-nil means that gnus-uu will mark articles that were
-     unsuccessfully decoded as unread.
-
-   `gnus-uu-output-window-height'
-     This variable says how tall the output buffer window is to be
-     when using interactive view mode.
-
-   `gnus-uu-correct-stripped-uucode'
-     Non-nil means that gnus-uu will *try* to fix uuencoded files that
-     have had traling spaces deleted.
-
-   `gnus-uu-use-interactive-view'
-     Non-nil means that gnus-uu will use interactive viewing mode.
-
-   `gnus-uu-view-with-metamail'
-     Non-nil means that gnus-uu will ignore the viewing commands
-     defined by the rule variables and just fudge a MIME content type
-     based on the file name. The result will be fed to metamail for
-     viewing.
-
-   `gnus-uu-save-in-digest'
-     Non-nil means that gnus-uu, when asked to save without decoding,
-     will save in digests.  If this variable is nil, gnus-uu will just
-     save everything in a file without any embellishments. The
-     digesting almost conforms to RFC1153 - no easy way to specify any
-     meaningful volume and issue numbers were found, so I simply
-     dropped them.
-
-   `gnus-uu-post-include-before-composing'
-     Non-nil means that gnus-uu will ask for a file to encode before
-     you compose the article.  If this variable is t, you can either
-     include an encoded file with \\<gnus-uu-post-reply-mode-map>\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you 
-     post the article.
-
-   `gnus-uu-post-length'
-     Maximum length of an article.  The encoded file will be split
-     into how many articles it takes to post the entire file.
-
-   `gnus-uu-post-threaded'
-     Non-nil means that gnus-uu will post the encoded file in a
-     thread.  This may not be smart, as no other decoder I have seen
-     are able to follow threads when collecting uuencoded
-     articles. (Well, I have seen one package that does that -
-     gnus-uu, but somehow, I don't think that counts...) Default is
-     nil.
-
-   `gnus-uu-post-separate-description'
-     Non-nil means that the description will be posted in a separate
-     article.  The first article will typically be numbered (0/x). If
-     this variable is nil, the description the user enters will be
-     included at the beginning of the first article, which will be
-     numbered (1/x). Default is t.
-"
-  (interactive)
-  )
-
-;; Default viewing action rules
-
-(defvar gnus-uu-default-view-rules 
-  (list 
-   '("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv")
-   '("\\.tga$" "tgatoppm %s | xv -")
-   '("\\.te?xt$\\|\\.doc$\\|read.*me" "xterm -e less")
-   '("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" 
-     "sox -v .5 %s -t .au -u - > /dev/audio")
-   '("\\.au$" "cat %s > /dev/audio")
-   '("\\.mod$" "str32")
-   '("\\.ps$" "ghostview")
-   '("\\.dvi$" "xdvi")
-   '("\\.[1-6]$" "xterm -e man -l")
-   '("\\.html$" "xmosaic")
-   '("\\.mpe?g$" "mpeg_play")
-   '("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\)$" "xanim")
-   '("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" 
-     "gnus-uu-archive"))
-
-  "Default actions to be taken when the user asks to view a file.  
-To change the behaviour, you can either edit this variable or set
-`gnus-uu-user-view-rules' to something useful.
-
-For example:
-
-To make gnus-uu use 'xli' to display JPEG and GIF files, put the
-following in your .emacs file
-
-  (setq gnus-uu-user-view-rules (list '(\"jpg$\\\\|gif$\" \"xli\")))
-
-Both these variables are lists of lists with two string elements. The
-first string is a regular expression. If the file name matches this
-regular expression, the command in the second string is executed with
-the file as an argument.
-
-If the command string contains \"%s\", the file name will be inserted
-at that point in the command string. If there's no \"%s\" in the
-command string, the file name will be appended to the command string
-before executing.
-
-There are several user variables to tailor the behaviour of gnus-uu to
-your needs. First we have `gnus-uu-user-view-rules', which is the
-variable gnus-uu first consults when trying to decide how to view a
-file. If this variable contains no matches, gnus-uu examines the
-default rule vaiable provided in this package. If gnus-uu finds no
-match here, it uses `gnus-uu-user-view-rules-end' to try to make a
-match.
-
-Unless, of course, you are using the interactive view mode. Then
-`gnus-uu-user-interactive-view-rules' and
-`gnus-uu-user-interactive-view-rules-end' will be used instead.")
-
-(defvar gnus-uu-user-view-rules nil 
-  "Variable detailing what actions are to be taken to view a file.
-See the documentation on the `gnus-uu-default-view-rules' variable for 
-details.")
-
-(defvar gnus-uu-user-view-rules-end nil
-  "Variable saying what actions are to be taken if no rule matched the file name.
-See the documentation on the `gnus-uu-default-view-rules' variable for 
-details.")
-
-(defvar gnus-uu-user-interactive-view-rules nil
-  "Variable detailing what actions are to be taken to view a file when using interactive mode.
-See the documentation on the `gnus-uu-default-view-rules' variable for 
-details.")
-
-(defvar gnus-uu-user-interactive-view-rules-end nil
-  "Variable saying what actions are to be taken if no rule matched the file name when using interactive mode.
-See the documentation on the `gnus-uu-default-view-rules' variable for 
-details.")
-
-(defvar gnus-uu-default-interactive-view-rules-begin
-  (list
-   '("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g")
-   '("\\.pas$" "cat %s | sed s/\r//g")
-   ))
-
-(defvar gnus-uu-default-interactive-view-rules-end
-  (list
-   '(".*" "file")))
-
-;; Default unpacking commands
-
-(defvar gnus-uu-default-archive-rules 
-  (list '("\\.tar$" "tar xf")
-	'("\\.zip$" "unzip -o")
-	'("\\.ar$" "ar x")
-	'("\\.arj$" "unarj x")
-	'("\\.zoo$" "zoo -e")
-	'("\\.\\(lzh\\|lha\\)$" "lha x")
-	'("\\.Z$" "uncompress")
-	'("\\.gz$" "gunzip")
-	'("\\.arc$" "arc -x"))
-  )
-
-(defvar gnus-uu-destructive-archivers 
-  (list "uncompress" "gunzip"))
-
-(defvar gnus-uu-user-archive-rules nil
-  "A list that can be set to override the default archive unpacking commands.
-To use, for instance, 'untar' to unpack tar files and 'zip -x' to
-unpack zip files, say the following:
-  (setq gnus-uu-user-archive-rules 
-    (list '(\"\\\\.tar$\" \"untar\")
-          '(\"\\\\.zip$\" \"zip -x\")))")
-
-(defvar gnus-uu-ignore-files-by-name nil
-  "A regular expression saying what files should not be viewed based on name.
-If, for instance, you want gnus-uu to ignore all .au and .wav files, 
-you could say something like
-
-  (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
-
-Note that this variable can be used in conjunction with the
-`gnus-uu-ignore-files-by-type' variable.")
-
-(defvar gnus-uu-ignore-files-by-type nil
-  "A regular expression saying what files that shouldn't be viewed, based on MIME file type.
-If, for instance, you want gnus-uu to ignore all audio files and all mpegs, 
-you could say something like
-
-  (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
-
-Note that this variable can be used in conjunction with the
-`gnus-uu-ignore-files-by-name' variable.")
-
-;; Pseudo-MIME support
-
-(defconst gnus-uu-ext-to-mime-list
-  (list '("\\.gif$" "image/gif")
-	'("\\.jpe?g$" "image/jpeg")
-	'("\\.tiff?$" "image/tiff")
-	'("\\.xwd$" "image/xwd")
-	'("\\.pbm$" "image/pbm")
-	'("\\.pgm$" "image/pgm")
-	'("\\.ppm$" "image/ppm")
-	'("\\.xbm$" "image/xbm")
-	'("\\.pcx$" "image/pcx")
-	'("\\.tga$" "image/tga")
-	'("\\.ps$" "image/postscript")
-	'("\\.fli$" "video/fli")
-	'("\\.wav$" "audio/wav")
-	'("\\.aiff$" "audio/aiff")
-	'("\\.hcom$" "audio/hcom")
-	'("\\.voc$" "audio/voc")
-	'("\\.smp$" "audio/smp")
-	'("\\.mod$" "audio/mod")
-	'("\\.dvi$" "image/dvi")
-	'("\\.mpe?g$" "video/mpeg")
-	'("\\.au$" "audio/basic")
-	'("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain")
-	'("\\.\\(c\\|h\\)$" "text/source")
-	'("read.*me" "text/plain")
-	'("\\.html$" "text/html")
-	'("\\.bat$" "text/bat")
-	'("\\.[1-6]$" "text/man")
-	'("\\.flc$" "video/flc")
-	'("\\.rle$" "video/rle")
-	'("\\.pfx$" "video/pfx")
-	'("\\.avi$" "video/avi")
-	'("\\.sme$" "video/sme")
-	'("\\.rpza$" "video/prza")
-	'("\\.dl$" "video/dl")
-	'("\\.qt$" "video/qt")
-	'("\\.rsrc$" "video/rsrc")
-	'("\\..*$" "unknown/unknown")))
-
-;; Various variables users may set 
-
-(defvar gnus-uu-tmp-dir "/tmp/" 
-  "Variable saying where gnus-uu is to do its work.
-Default is \"/tmp/\".")
-
-(defvar gnus-uu-do-not-unpack-archives nil 
-  "Non-nil means that gnus-uu won't peek inside archives looking for files to dispay. 
-Default is nil.")
-
-(defvar gnus-uu-view-and-save nil 
-  "Non-nil means that the user will always be asked to save a file after viewing it.
-If the variable is nil, the suer will only be asked to save if the
-viewing is unsuccessful. Default is nil.")
-
-(defvar gnus-uu-asynchronous nil
-  "Non-nil means that files will be viewed asynchronously.
-Default is nil.")
-
-(defvar gnus-uu-ask-before-view nil
-  "Non-nil means that gnus-uu will ask you before viewing each file. 
-Especially useful when `gnus-uu-asynchronous' is set. Default is
-nil.")
-
-(defvar gnus-uu-ignore-default-view-rules nil
-  "Non-nil means that gnus-uu will ignore the default viewing rules.
-Only the user viewing rules will be consulted. Default is nil.")
-
-(defvar gnus-uu-ignore-default-archive-rules nil 
-  "Non-nil means that gnus-uu will ignore the default archive unpacking commands.  
-Only the user unpacking commands will be consulted. Default is nil.")
-
-(defvar gnus-uu-kill-carriage-return t
-  "Non-nil means that gnus-uu will strip all carriage returns from articles.
-Default is t.")
-
-(defvar gnus-uu-view-with-metamail nil
-  "Non-nil means that files will be viewed with metamail.
-The gnus-uu viewing functions will be ignored and gnus-uu will try
-to guess at a content-type based on file name suffixes. Default
-it nil.")
-
-(defvar gnus-uu-unmark-articles-not-decoded nil
-  "Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. 
-Default is nil.")
-
-(defvar gnus-uu-output-window-height 20 
-  "This variable says how tall the output buffer window is to be when using interactive view mode. 
-Change it at your convenience. Default is 20.")
-
-(defvar gnus-uu-correct-stripped-uucode nil
-  "Non-nil means that gnus-uu will *try* to fix uuencoded files that have had traling spaces deleted. 
-Default is nil.")
-
-(defvar gnus-uu-use-interactive-view nil
-  "Non-nil means that gnus-uu will use interactive viewing mode.
-Gnus-uu will create a special buffer where the user may choose
-interactively which files to view and how. Default is nil.")
-
-(defvar gnus-uu-save-in-digest nil
-  "Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
-If this variable is nil, gnus-uu will just save everything in a 
-file without any embellishments. The digesting almost conforms to RFC1153 -
-no easy way to specify any meaningful volume and issue numbers were found, 
-so I simply dropped them.")
-
-
-;; Internal variables
-
-(defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
-(defconst gnus-uu-end-string "^end[ \t]*$")
-
-(defconst gnus-uu-body-line "^M")
-(let ((i 61))
-  (while (> (setq i (1- i)) 0)
-    (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
-  (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$")))
-
-;"^M.............................................................?$"
-
-(defconst gnus-uu-shar-begin-string "^#! */bin/sh")
-
-(defvar gnus-uu-shar-file-name nil)
-(defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
-(defvar gnus-uu-shar-directory nil)
-
-(defvar gnus-uu-file-name nil)
-(defvar gnus-uu-list-of-files-decoded nil)
-(defconst gnus-uu-uudecode-process nil)
-
-(defvar gnus-uu-interactive-file-list nil)
-(defvar gnus-uu-marked-article-list nil)
-(defvar gnus-uu-generated-file-list nil)
-(defvar gnus-uu-work-dir nil)
-
-(defconst gnus-uu-interactive-buffer-name "*gnus-uu interactive*")
-(defconst gnus-uu-output-buffer-name "*Gnus UU Output*")
-(defconst gnus-uu-result-buffer "*Gnus UU Result Buffer*")
-
-(defconst gnus-uu-highest-article-number 1)
-
-;; Interactive functions
-
-;; UUdecode and view
-
-(defun gnus-uu-decode-and-view ()
-  "UUdecodes and 'views' (if possible) the resulting file.
-'Viewing' can be any action at all, as defined in the
-`gnus-uu-file-action-list' variable. Running 'xv' on gifs and 'cat
->/dev/audio' on au files are popular actions. If the file can't be
-viewed, the user is asked if she would like to save the file instead."
-  (interactive) 
-  (gnus-uu-decode-and-view-or-save t nil))
-
-(defun gnus-uu-decode-and-save ()
-  "Decodes and saves the resulting file."
-  (interactive)
-  (gnus-uu-decode-and-view-or-save nil nil))
-
-(defun gnus-uu-marked-decode-and-view ()
-  "Decodes and views articles marked.
-The marked equivalent to `gnus-uu-decode-and-view'."
-  (interactive)
-  (gnus-uu-decode-and-view-or-save t t))
-
-(defun gnus-uu-marked-decode-and-save ()
-  "Decodes and saves articles marked.
-The marked equivalent to `gnus-uu-decode-and-save'."
-  (interactive)
-  (gnus-uu-decode-and-view-or-save nil t))
-      
-
-;; Unshar and view
-
-(defun gnus-uu-shar-and-view ()
-  "Unshars and views articles.
-The shar equivalent of `gnus-uu-decode-and-view'."
-  (interactive)
-  (gnus-uu-unshar-and-view-or-save t nil))
-
-(defun gnus-uu-shar-and-save ()
-  "Unshars and saves files.
-The shar equivalent to `gnus-uu-decode-and-save'."
-  (interactive)
-  (gnus-uu-unshar-and-view-or-save nil nil))
-
-(defun gnus-uu-marked-shar-and-view ()
-  "Unshars and views articles marked.
-The marked equivalent to `gnus-uu-shar-and-view'."
-  (interactive)
-  (gnus-uu-unshar-and-view-or-save t t))
-
-(defun gnus-uu-marked-shar-and-save ()
-  "Unshars and saves articles marked.
-The marked equivalent to `gnus-uu-shar-and-save'."
-  (interactive)
-  (gnus-uu-unshar-and-view-or-save nil t))
-
-;; Threaded decode
-
-(defun gnus-uu-threaded-decode-and-view ()
-  "Decodes and saves the resulting file."
-  (interactive)
-  (gnus-uu-threaded-decode-and-view-or-save t))
-
-(defun gnus-uu-threaded-decode-and-save ()
-  "Decodes and saves the resulting file."
-  (interactive)
-  (gnus-uu-threaded-decode-and-view-or-save nil))
-
-(defun gnus-uu-threaded-multi-decode-and-view ()
-  "Decodes and saves the resulting file."
-  (interactive)
-  (gnus-uu-threaded-multi-decode-and-view-or-save t))
-
-(defun gnus-uu-threaded-multi-decode-and-save ()
-  "Decodes and saves the resulting file."
-  (interactive)
-  (gnus-uu-threaded-multi-decode-and-view-or-save nil))
-
-(defun gnus-uu-threaded-decode-and-view-or-save (&optional view)
-  (gnus-uu-unmark-all-articles)
-  (gnus-uu-mark-thread)
-  (gnus-uu-decode-and-view-or-save view t))
-
-(defun gnus-uu-threaded-multi-decode-and-view-or-save (view)
-  (let (type)
-    (message "Decode type: [u]udecode, (s)har, s(a)ve, (b)inhex: ")
-    (setq type (read-char))
-    (if (not (or (= type ?u) (= type ?s) (= type ?b) (= type ?a)))
-	(error "No such decoding method '%c'" type))
-    
-    (gnus-uu-unmark-all-articles)
-    (gnus-uu-mark-thread)
-
-    (if (= type ?\r) (setq type ?u))
-    (cond ((= type ?u) (gnus-uu-decode-and-view-or-save view t))
-	  ((= type ?s) (gnus-uu-unshar-and-view-or-save view t))
-	  ((= type ?b) (gnus-uu-binhex-and-save view t))
-	  ((= type ?a) (gnus-uu-save-articles view t)))))
-    
-
-;; Toggle commands      
-
-(defun gnus-uu-toggle-asynchronous ()
-  "This function toggles asynchronous viewing."
-  (interactive)
-  (if (setq gnus-uu-asynchronous (not gnus-uu-asynchronous))
-      (message "gnus-uu will now view files asynchronously")
-    (message "gnus-uu will now view files synchronously")))
-
-(defun gnus-uu-toggle-query ()
-  "This function toggles whether to ask before viewing or not."
-  (interactive)
-  (if (setq gnus-uu-ask-before-view (not gnus-uu-ask-before-view))
-      (message "gnus-uu will now ask before viewing")
-    (message "gnus-uu will now view without asking first")))
-
-(defun gnus-uu-toggle-always-ask ()
-  "This function toggles whether to always ask to save a file after viewing."
-  (interactive)
-  (if (setq gnus-uu-view-and-save (not gnus-uu-view-and-save))
-      (message "gnus-uu will now ask to save the file after viewing")
-    (message "gnus-uu will now not ask to save after successful viewing")))
-
-(defun gnus-uu-toggle-interactive-view ()
-  "This function toggles whether to use interactive view."
-  (interactive)
-  (if (setq gnus-uu-use-interactive-view (not gnus-uu-use-interactive-view))
-      (message "gnus-uu will now use interactive view")
-    (message "gnus-uu will now use non-interactive view")))
-
-(defun gnus-uu-toggle-unmark-undecoded ()
-  "This function toggles whether to unmark articles not decoded."
-  (interactive)
-  (if (setq gnus-uu-unmark-articles-not-decoded 
-	    (not gnus-uu-unmark-articles-not-decoded))
-      (message "gnus-uu will now unmark articles not decoded")
-    (message "gnus-uu will now not unmark articles not decoded")))
-
-(defun gnus-uu-toggle-kill-carriage-return ()
-  "This function toggles the stripping of carriage returns from the articles."
-  (interactive)
-  (if (setq gnus-uu-kill-carriage-return (not gnus-uu-kill-carriage-return))
-      (message "gnus-uu will now strip carriage returns")
-    (message "gnus-uu won't strip carriage returns")))
-
-(defun gnus-uu-toggle-view-with-metamail ()
-  "This function toggles whether to view files with metamail."
-  (interactive)
-  (if (setq gnus-uu-view-with-metamail (not gnus-uu-view-with-metamail))
-      (message "gnus-uu will now view with metamail")
-    (message "gnus-uu will now view with the gnus-uu viewing functions")))
-
-(defun gnus-uu-toggle-correct-stripped-uucode ()
-  "This function toggles whether to correct stripped uucode."
-  (interactive)
-  (if (setq gnus-uu-correct-stripped-uucode 
-	    (not gnus-uu-correct-stripped-uucode))
-      (message "gnus-uu will now correct stripped uucode")
-    (message "gnus-uu won't check and correct stripped uucode")))
-
-(defun gnus-uu-toggle-any-variable ()
-  "This function ask what variable the user wants to toggle."
-  (interactive)
-  (let (rep)
-    (message "(a)sync, (q)uery, (p)ask, (k)ill CR, (i)nteract, (u)nmark, (c)orrect, (m)eta")
-    (setq rep (read-char))
-    (if (= rep ?a)
-	(gnus-uu-toggle-asynchronous))
-    (if (= rep ?q)
-	(gnus-uu-toggle-query))
-    (if (= rep ?p)
-	(gnus-uu-toggle-always-ask))
-    (if (= rep ?k)
-	(gnus-uu-toggle-kill-carriage-return))
-    (if (= rep ?u)
-	(gnus-uu-toggle-unmark-undecoded))
-    (if (= rep ?c)
-	(gnus-uu-toggle-correct-stripped-uucode))
-    (if (= rep ?m)
-	(gnus-uu-toggle-view-with-metamail))
-    (if (= rep ?i)
-	(gnus-uu-toggle-interactive-view))))
-
-
-;; Misc interactive functions
-
-(defun gnus-uu-decode-and-show-in-buffer ()
-  "Uudecodes the current article and displays the result in a buffer.
-Might be useful if someone has, for instance, some text uuencoded in
-their sigs. (Stranger things have happened.)"
-  (interactive)
-  (gnus-uu-initialize)
-  (let ((uu-buffer (get-buffer-create gnus-uu-output-buffer-name))
-	file-name)
-    (save-excursion
-      (and 
-       (gnus-summary-select-article)
-       (gnus-uu-grab-articles (list gnus-current-article) 
-			      'gnus-uu-uustrip-article-as)
-       (setq file-name (concat gnus-uu-work-dir gnus-uu-file-name))
-       (progn
-	 (save-excursion
-	   (set-buffer uu-buffer)
-	   (erase-buffer)
-	   (insert-file-contents file-name))
-	 (set-window-buffer (get-buffer-window gnus-article-buffer) 
-			    uu-buffer)
-	 (message "Showing file %s in buffer" file-name)
-	 (delete-file file-name))))))
-
-(defun gnus-uu-edit-begin-line ()
-  "Edit the begin line of the current article."
-  (interactive)
-  (let ((buffer-read-only nil)
-	begin b)
-    (save-excursion
-      (gnus-summary-select-article)
-      (set-buffer gnus-article-buffer)
-      (goto-line 1)
-      (if (not (re-search-forward "begin " nil t))
-	  (error "No begin line in the current article")
-	(beginning-of-line)
-	(setq b (point))
-	(end-of-line)
-	(setq begin (buffer-substring b (point)))
-	(setq begin (read-string "" begin))
-	(setq buffer-read-only nil)
-	(delete-region b (point))
-	(insert-string begin)))))
-
-
-;; Multi functions
-
-(defun gnus-uu-multi-decode-and-view ()
-  "Choose a method of decoding and then decode and view.
-This function lets the user decide what method to use for decoding.
-Other than that, it's equivalent to the other decode-and-view
-functions."
-  (interactive)
-  (gnus-uu-multi-decode-and-view-or-save t nil))
-
-(defun gnus-uu-multi-decode-and-save ()
-  "Choose a method of decoding and then decode and save.
-This function lets the user decide what method to use for decoding.
-Other than that, it's equivalent to the other decode-and-save 
-functions."
-  (interactive)
-  (gnus-uu-multi-decode-and-view-or-save nil nil))
-
-(defun gnus-uu-marked-multi-decode-and-view ()
-  "Choose a method of decoding and then decode and view the marked articles.
-This function lets the user decide what method to use for decoding.
-Other than that, it's equivalent to the other marked decode-and-view 
-functions."
-  (interactive)
-  (gnus-uu-multi-decode-and-view-or-save t t))
-
-(defun gnus-uu-marked-multi-decode-and-save ()
-  "Choose a method of decoding and then decode and save the marked articles.
-This function lets the user decide what method to use for decoding.
-Other than that, it's equivalent to the other marked decode-and-save 
-functions."
-  (interactive)
-  (gnus-uu-multi-decode-and-view-or-save t t))
-
-(defun gnus-uu-multi-decode-and-view-or-save (view marked)
-  (let (type)
-    (message "[u]udecode, (s)har, s(a)ve, (b)inhex: ")
-    (setq type (read-char))
-    (if (= type ?\r) (setq type ?u))
-    (cond ((= type ?u) (gnus-uu-decode-and-view-or-save view marked))
-	  ((= type ?s) (gnus-uu-unshar-and-view-or-save view marked))
-	  ((= type ?b) (gnus-uu-binhex-and-save view marked))
-	  ((= type ?a) (gnus-uu-save-articles view marked))
-	  (t (error "Unknown decode method '%c'." type)))))
-
-
-;; "All articles" commands
-
-(defconst gnus-uu-rest-of-articles nil)
-(defvar gnus-uu-current-save-dir nil)
-
-(defun gnus-uu-decode-and-view-all-articles (arg &optional unread)
-  "Try to decode all articles and view the result.
-ARG delimits the number of files to be decoded."
-  (interactive "p")
-  (if (not (setq gnus-uu-marked-article-list 
-		 (nreverse (gnus-uu-get-list-of-articles 
-			    "^." nil unread t))))
-      (error "No%s articles to be decoded" (if unread " unread" "")))
-  (gnus-uu-decode-and-view-or-save t t nil (if (> arg 1) arg nil)))
-
-(defun gnus-uu-decode-and-view-all-unread-articles (arg)
-  "Try to decode all unread articles and view the result.
-ARG delimits the number of files to be decoded."
-  (interactive "p")
-  (gnus-uu-decode-and-view-all-articles arg t))
-
-(defun gnus-uu-decode-and-save-all-unread-articles (arg)
-  "Try to decode all unread articles and saves the result.
-This function reads all unread articles in the current group and sees
-whether it can uudecode the articles. The user will be prompted for an
-directory to put the resulting (if any) files.
-ARG delimits the number of files to be decoded."
-  (interactive "p")
-  (gnus-uu-decode-and-save-articles arg t t))
-
-(defun gnus-uu-decode-and-save-all-articles (arg)
-  "Try to decode all articles and saves the result.
-Does the same as `gnus-uu-decode-and-save-all-unread-articles', except
-that it grabs all articles visible, unread or not.
-ARG delimits the number of files to be decoded."
-  (interactive "p")
-  (gnus-uu-decode-and-save-articles arg nil t))
-
-(defun gnus-uu-decode-and-save-articles (arg &optional unread unmark)
-  (let (dir)
-    (if (not (setq gnus-uu-marked-article-list 
-		   (nreverse (gnus-uu-get-list-of-articles 
-			      "^." nil unread t))))
-	(error "No%s articles to be decoded." (if unread " unread" ""))
-      (setq dir (gnus-uu-read-directory "Where do you want the files? "))
-      (gnus-uu-decode-and-view-or-save nil t dir (if (> arg 1) arg nil))
-      (message "Saved."))))
-
-
-;; Work functions
-
-; All the interactive uudecode/view/save/marked functions are interfaces
-; to this function, which does the rest.
-(defun gnus-uu-decode-and-view-or-save (view marked &optional save-dir limit)
-  (gnus-uu-initialize)
-  (let (decoded)
-    (save-excursion
-      (if (gnus-uu-decode-and-strip nil marked limit)
-	  (progn
-	    (setq decoded t)
-	    (if view 
-		(gnus-uu-view-directory gnus-uu-work-dir 
-					gnus-uu-use-interactive-view)
-	      (gnus-uu-save-directory gnus-uu-work-dir save-dir save-dir)
-	      (gnus-uu-check-for-generated-files)))))
-
-    (gnus-uu-summary-next-subject)
-
-    (if (and gnus-uu-use-interactive-view view decoded)
-	(gnus-uu-do-interactive))
-
-    (if (or (not view) (not gnus-uu-use-interactive-view) (not decoded))
-	(gnus-uu-clean-up))))
-
-; Unshars and views/saves marked/unmarked articles.
-(defun gnus-uu-unshar-and-view-or-save (view marked)
-  (gnus-uu-initialize)
-  (let (tar-file files decoded)
-    (save-excursion
-      (setq gnus-uu-shar-directory 
-	    (make-temp-name (concat gnus-uu-tmp-dir "gnusuush")))
-      (make-directory gnus-uu-shar-directory)
-      (gnus-uu-add-file gnus-uu-shar-directory)
-      (if (gnus-uu-decode-and-strip t marked)
-	  (progn
-	    (setq decoded t)
-	    (setq files (directory-files gnus-uu-shar-directory t))
-	    (setq gnus-uu-generated-file-list
-		  (append files gnus-uu-generated-file-list))
-	    (if (> (length files) 3)
-		(progn 
-		  (setq tar-file 
-			(concat
-			 (make-temp-name (concat gnus-uu-tmp-dir "gnusuuar"))
-			 ".tar"))
-		  (gnus-uu-add-file tar-file)
-		  (call-process 
-		   "sh" nil 
-		   (get-buffer-create gnus-uu-output-buffer-name) nil "-c" 
-		   (format "cd %s ; tar cf %s * ; cd .. ; rm -r %s" 
-			   gnus-uu-shar-directory tar-file
-			   gnus-uu-shar-directory))
-		  (if view
-		      (gnus-uu-view-file tar-file)
-		    (gnus-uu-save-file tar-file)))
-	      (if view
-		  (gnus-uu-view-file (elt files 2))
-		(gnus-uu-save-file (elt files 2)))))))
-
-    (gnus-uu-summary-next-subject)
-
-    (if (and gnus-uu-use-interactive-view view decoded)
-	(gnus-uu-do-interactive))
-
-    (if (or (not gnus-uu-use-interactive-view) (not decoded))
-	(gnus-uu-clean-up))))
-
-
-;; Functions for saving and possibly digesting articles without
-;; any decoding.
-
-(defconst gnus-uu-saved-article-name nil)
-
-; VIEW isn't used, but is here anyway, to provide similar interface to
-; the other related functions.  If MARKED is non-nil, the list of
-; marked articles is used.  If NO-SAVE is non-nil, the articles aren't
-; actually saved in a permanent location, but the collecting is done
-; and a temporary file with the result is returned.
-(defun gnus-uu-save-articles (view marked &optional no-save)
-  (let (list-of-articles)
-    (save-excursion
-      (gnus-uu-initialize)
-      (if (not marked)
-	  (setq list-of-articles (gnus-uu-get-list-of-articles))
-	(setq list-of-articles (reverse gnus-uu-marked-article-list))
-	(setq gnus-uu-marked-article-list nil))
-
-      (if (not list-of-articles)
-	  (error "No list of articles"))
-
-      (setq gnus-uu-saved-article-name 
-	    (concat gnus-uu-work-dir 
-		    (if no-save
-			gnus-newsgroup-name
-		      (read-file-name "Enter file name: " gnus-newsgroup-name
-				      gnus-newsgroup-name))))
-      (gnus-uu-add-file gnus-uu-saved-article-name)
-      (if (and (gnus-uu-grab-articles list-of-articles 'gnus-uu-save-article t)
-	       (not no-save))
-	  (gnus-uu-save-file gnus-uu-saved-article-name)
-	gnus-uu-saved-article-name))))
-
-; Function called by gnus-uu-grab-articles to treat each article.
-(defun gnus-uu-save-article (buffer in-state)
-  (if (not gnus-uu-save-in-digest)
-      (save-excursion
-	(set-buffer buffer)
-	(write-region 1 (point-max) gnus-uu-saved-article-name t)
-	(cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
-	      ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 'begin 'end))
-	      ((eq in-state 'last) (list 'end))
-	      (t (list 'middle))))
-    (let (beg subj name headers headline sorthead body end-string state)
-      (string-match "/\\([^/]*\\)$" gnus-uu-saved-article-name)
-      (setq name (substring gnus-uu-saved-article-name (match-beginning 1)
-			    (match-end 1)))
-      (if (or (eq in-state 'first) 
-	      (eq in-state 'first-and-last))
-	  (progn 
-	    (setq state (list 'begin))
-	    (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*"))
-			    (erase-buffer))
-	    (save-excursion 
-	      (set-buffer (get-buffer-create "*gnus-uu-pre*"))
-	      (erase-buffer)
-	      (insert (format 
-		       "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n"
-		       (current-time-string) name name))))
-	(if (not (eq in-state 'end))
-	    (setq state (list 'middle))))
-      (save-excursion
-	(set-buffer (get-buffer "*gnus-uu-body*"))
-	(goto-char (setq beg (point-max)))
-	(save-excursion
-	  (save-restriction
-	    (set-buffer buffer)
-	    (goto-char 1)
-	    (re-search-forward "\n\n")
-	    (setq body (buffer-substring (1- (point)) (point-max)))
-	    (narrow-to-region 1 (point))
-	    (setq headers (list "Date:" "From:" "To:" "Cc:" "Subject:"
-				"Message-ID:" "Keywords:" "Summary:"))
-	    (while headers
-	      (setq headline (car headers))
-	      (setq headers (cdr headers))
-	      (goto-char 1)
-	      (if (re-search-forward (concat "^" headline ".*$") nil t)
-		  (setq sorthead 
-			(concat sorthead (buffer-substring 
-					  (match-beginning 0)
-					  (match-end 0)) "\n"))))
-	    (widen)))
-	(insert sorthead)(goto-char (point-max))
-	(insert body)(goto-char (point-max))
-	(insert (concat "\n" (make-string 30 ?-) "\n\n"))
-	(goto-char beg)
-	(if (re-search-forward "^Subject: \\(.*\\)$" nil t)
-	    (progn
-	      (setq subj (buffer-substring (match-beginning 1) (match-end 1)))
-	      (save-excursion 
-		(set-buffer (get-buffer "*gnus-uu-pre*"))
-		(insert (format "   %s\n" subj))))))
-      (if (or (eq in-state 'last)
-	      (eq in-state 'first-and-last))
-	  (progn
-	    (save-excursion
-	      (set-buffer (get-buffer "*gnus-uu-pre*"))
-	      (insert (format "\n\n%s\n\n" (make-string 70 ?-)))
-	      (write-region 1 (point-max) gnus-uu-saved-article-name))
-	    (save-excursion
-	      (set-buffer (get-buffer "*gnus-uu-body*"))
-	      (goto-char (point-max))
-	      (insert 
-	       (concat (setq end-string (format "End of %s Digest" name)) 
-		       "\n"))
-	      (insert (concat (make-string (length end-string) ?*) "\n"))
-	      (write-region 1 (point-max) gnus-uu-saved-article-name t))
-	    (kill-buffer (get-buffer "*gnus-uu-pre*"))
-	    (kill-buffer (get-buffer "*gnus-uu-body*"))
-	    (setq state (cons 'end state))))
-      (if (memq 'begin state)
-	  (cons gnus-uu-saved-article-name state)
-	state))))
-
-
-;; Digest and forward articles
-
-(autoload 'gnus-mail-forward-using-mail "gnusmail"
-	  "Forward the current message to another user." t)
-(autoload 'gnus-mail-forward-using-mhe "gnusmail"
-	  "Forward the current message to another user." t)
-
-(defun gnus-uu-digest-and-forward (&optional marked)
-  "Digests and forwards all articles in this series."
-  (interactive)
-  (let ((gnus-uu-save-in-digest t)
-	file buf)
-    (setq file (gnus-uu-save-articles nil marked t))
-    (switch-to-buffer (setq buf (get-buffer-create "*gnus-uu-forward*")))
-    (erase-buffer)
-    (delete-other-windows)
-    (erase-buffer)
-    (insert-file file)
-    (goto-char 1)
-    (bury-buffer buf)
-    (funcall gnus-mail-forward-method)))
-
-(defun gnus-uu-marked-digest-and-forward (&optional marked)
-  "Digests and forwards all marked articles."
-  (interactive)
-  (gnus-uu-digest-and-forward t))
-
-
-;; Binhex treatment - not very advanced. 
-
-(defconst gnus-uu-binhex-body-line 
-  "^[^:]...............................................................$")
-(defconst gnus-uu-binhex-begin-line 
-  "^:...............................................................$")
-(defconst gnus-uu-binhex-end-line
-  ":$")
-(defvar gnus-uu-binhex-article-name nil)
-
-; This just concatenates and strips stuff from binhexed articles.
-; No actual unbinhexing takes place. VIEW is ignored.
-(defun gnus-uu-binhex-and-save (view marked)
-  (gnus-uu-initialize)
-  (let (list-of-articles)
-    (save-excursion
-      (if (not marked)
-	  (setq list-of-articles (gnus-uu-get-list-of-articles))
-	(setq list-of-articles (reverse gnus-uu-marked-article-list))
-	(setq gnus-uu-marked-article-list nil))
-      (if (not list-of-articles)
-	  (error "No list of articles"))
-
-      (setq gnus-uu-binhex-article-name 
-	    (concat gnus-uu-work-dir 
-		    (read-file-name "Enter binhex file name: " 
-				    gnus-newsgroup-name
-				    gnus-newsgroup-name)))
-      (gnus-uu-add-file gnus-uu-binhex-article-name)
-      (if (gnus-uu-grab-articles list-of-articles 'gnus-uu-binhex-article t)
-	  (gnus-uu-save-file gnus-uu-binhex-article-name))))
-  (gnus-uu-check-for-generated-files)
-  (gnus-uu-summary-next-subject))
-
-(defun gnus-uu-binhex-article (buffer in-state)
-  (let (state start-char)
-    (save-excursion
-      (set-buffer buffer)
-      (widen)
-      (goto-char 1)
-      (if (not (re-search-forward gnus-uu-binhex-begin-line nil t))
-	  (if (not (re-search-forward gnus-uu-binhex-body-line nil t))
-	      (setq state (list 'wrong-type))))
-
-      (if (memq 'wrong-type state)
-	  ()
-	(beginning-of-line)
-	(setq start-char (point))
-	(if (looking-at gnus-uu-binhex-begin-line)
-	    (progn
-	      (setq state (list 'begin))
-	      (write-region 1 1 gnus-uu-binhex-article-name))
-	  (setq state (list 'middle)))
-	(goto-char (point-max))
-	(re-search-backward (concat gnus-uu-binhex-body-line "\\|" 
-				    gnus-uu-binhex-end-line) nil t)
-	(if (looking-at gnus-uu-binhex-end-line)
-	    (setq state (if (memq 'begin state)
-			    (cons 'end state)
-			  (list 'end))))
-	(beginning-of-line)
-	(forward-line 1)
-	(if (file-exists-p gnus-uu-binhex-article-name)
-	    (append-to-file start-char (point) gnus-uu-binhex-article-name))))
-    (if (memq 'begin state)
-	(cons gnus-uu-binhex-article-name state)
-      state)))
-      
-
-;; Internal view commands
-
-; This function takes two parameters. The first is name of the file to
-; be viewed. `gnus-uu-view-file' will look for an action associated
-; with the file type of the file. If it finds an appropriate action,
-; the file will be attempted displayed.
-; 
-; The second parameter specifies if the user is to be asked whether to
-; save the file if viewing is unsuccessful. t means "do not ask."
-;
-; Note that the file given will be deleted by this function, one way
-; or another. If `gnus-uu-asynchronous' is set, it won't be deleted
-; right away, but sometime later. If the user is offered to save the
-; file, it'll be moved to wherever the user wants it.
-
-; `gnus-uu-view-file' returns t if viewing is successful.
-
-(defun gnus-uu-view-file (file &optional silent)
-  (let (action did-view)
-    (cond 
-     ((not (setq action (gnus-uu-get-action file)))
-      (if (and (not silent) (not gnus-uu-use-interactive-view))
-	  (progn
-	    (message "Couldn't find any rule for file '%s'" file)
-	    (sleep-for 2)
-	    (gnus-uu-ask-to-save-file file))))
-     
-     ((and gnus-uu-use-interactive-view 
-	   (not (string= (or action "") "gnus-uu-archive")))
-      (gnus-uu-enter-interactive-file (or action "") file))
-
-     (gnus-uu-ask-before-view
-      (if (y-or-n-p (format "Do you want to view %s? " file))
-	  (setq did-view (gnus-uu-call-file-action file action)))
-      (message ""))
-     
-     ((setq did-view (gnus-uu-call-file-action file action)))
-
-     ((not silent)
-      (gnus-uu-ask-to-save-file file)))
-
-    (if (and (file-exists-p file) 
-	     (not gnus-uu-use-interactive-view)
-	     (or 
-	      (not (and gnus-uu-asynchronous did-view))
-	      (string= (or action  "") "gnus-uu-archive")))
-	(delete-file file))
-
-  did-view))
-
-(defun gnus-uu-call-file-action (file action)
-  (prog1
-      (if gnus-uu-asynchronous
-	  (gnus-uu-call-asynchronous file action)
-	(gnus-uu-call-synchronous file action))
-    (if gnus-uu-view-and-save
-	(gnus-uu-ask-to-save-file file))))
-
-(defun gnus-uu-ask-to-save-file (file)
-  (if (y-or-n-p (format "Do you want to save the file %s? " file))
-      (gnus-uu-save-file file))
-  (message ""))
-
-(defun gnus-uu-get-action (file-name)
-  (let (action)
-    (setq action 
-	  (gnus-uu-choose-action 
-	   file-name
-	   (append 
-	    (if (and gnus-uu-use-interactive-view 
-		     gnus-uu-user-interactive-view-rules)
-		gnus-uu-user-interactive-view-rules
-	      gnus-uu-user-view-rules)
-	    (if (or gnus-uu-ignore-default-view-rules 
-		    (not gnus-uu-use-interactive-view))
-		()
-	      gnus-uu-default-interactive-view-rules-begin)
-	    (if gnus-uu-ignore-default-view-rules 
-		nil 
-	      gnus-uu-default-view-rules)
-	    (if gnus-uu-use-interactive-view
-		(append gnus-uu-user-interactive-view-rules-end
-			(if gnus-uu-ignore-default-view-rules
-			    ()
-			  gnus-uu-default-interactive-view-rules-end))
-	      gnus-uu-user-view-rules-end))))
-    (if (and (not (string= (or action "") "gnus-uu-archive")) 
-	     gnus-uu-view-with-metamail)
-	(if (setq action 
-		  (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list))
-	    (setq action (format "metamail -d -b -c \"%s\"" action))))
-    action))
-
-; `gnus-uu-call-synchronous' takes two parameters: The name of the
-; file to be displayed and the command to display it with. Returns t
-; on success and nil if the file couldn't be displayed.
-(defun gnus-uu-call-synchronous (file-name action)
-  (let (did-view command)
-    (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
-      (erase-buffer)
-      (setq command (gnus-uu-command action file-name))
-      (message "Viewing with '%s'" command)
-      (if (not (= 0 (call-process "sh" nil t nil "-c" command)))
-	  (progn
-	    (goto-char 1)
-	    (while (re-search-forward "\n" nil t)
-	      (replace-match " "))
-	    (message (concat "Error: " (buffer-substring 1 (point-max))))
-	    (sit-for 2))
-	(message "")
-	(setq did-view t)))
-    did-view))
-
-; `gnus-uu-call-asyncronous' takes two parameters: The name of the
-; file to be displayed and the command to display it with. Since the
-; view command is executed asynchronously, it's kinda hard to decide
-; whether the command succeded or not, so this function always returns
-; t. It also adds "; rm -f file-name" to the end of the execution
-; string, so the file will be removed after viewing has ended.
-(defun gnus-uu-call-asynchronous (file-name action)
-  (let (command file tmp-file start)
-    (while (string-match "/" file-name start)
-      (setq start (1+ (match-beginning 0))))
-    (setq file (substring file-name start))
-    (setq tmp-file (concat gnus-uu-work-dir file))
-    (if (string= tmp-file file-name)
-	()
-      (rename-file file-name tmp-file t)
-      (setq file-name tmp-file))
-
-    (setq command (gnus-uu-command action file-name))
-    (setq command (format "%s ; rm -f %s" command file-name))
-    (message "Viewing with %s" command)
-    (start-process "gnus-uu-view" nil "sh" "-c" command)
-    t))
-
-; `gnus-uu-decode-and-strip' does all the main work. It finds out what
-; articles to grab, grabs them, strips the result and decodes. If any
-; of these operations fail, it returns nil, t otherwise.  If shar is
-; t, it will pass this on to `gnus-uu-grab-articles', which will
-; (probably) unshar the articles. If use-marked is non-nil, it won't
-; try to find articles, but use the marked list.
-(defun gnus-uu-decode-and-strip (&optional shar use-marked limit)
-  (let (list-of-articles)
-    (save-excursion
-
-      (if use-marked
-	  (if (not gnus-uu-marked-article-list)
-	      (message "No articles marked")
-	    (setq list-of-articles (reverse gnus-uu-marked-article-list))
-	    (setq gnus-uu-marked-article-list nil))
-	(setq list-of-articles (gnus-uu-get-list-of-articles)))
-      
-      (and list-of-articles
-	   (gnus-uu-grab-articles 
-	    list-of-articles 
-	    (if shar 'gnus-uu-unshar-article 'gnus-uu-uustrip-article-as)
-	    t limit)))))
-
-; Takes a string and puts a \ in front of every special character;
-; ignores any leading "version numbers" thingies that they use in the
-; comp.binaries groups, and either replaces anything that looks like
-; "2/3" with "[0-9]+/[0-9]+" or, if it can't find something like that,
-; replaces the last two numbers with "[0-9]+". This, in my experience,
-; should get most postings of a series."
-(defun gnus-uu-reginize-string (string)
-  (let ((count 2)
-	(vernum "v[0-9]+[a-z][0-9]+:")
-	reg beg)
-    (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
-      (erase-buffer)
-      (insert (regexp-quote string))
-      (setq beg 1)
-
-      (setq case-fold-search nil)
-      (goto-char 1)
-      (if (looking-at vernum)
-	  (progn
-	    (replace-match vernum t t)
-	    (setq beg (length vernum))))
-
-      (goto-char beg)
-      (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t)
-	  (replace-match " [0-9]+/[0-9]+")
-
-	(goto-char beg)
-	(if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t)
-	    (replace-match "[0-9]+ of [0-9]+")
-
-	  (end-of-line)
-	  (while (and (re-search-backward "[0-9]" nil t) (> count 0))
-            (while (and 
-		    (looking-at "[0-9]") 
-		    (< 1 (goto-char (1- (point))))))
-            (re-search-forward "[0-9]+" nil t)
-	    (replace-match "[0-9]+")
-	    (backward-char 5)
-	    (setq count (1- count)))))
-
-      (goto-char beg)
-      (while (re-search-forward "[ \t]+" nil t)
-	(replace-match "[ \t]*" t t))
-
-      (buffer-substring 1 (point-max)))))
-
-; Finds all articles that matches the regular expression given.
-; Returns the resulting list. SUBJECT is the regular expression to be
-; matched. If it is nil, the current article name will be used. If
-; MARK-ARTICLES is non-nil, articles found are marked. If ONLY-UNREAD
-; is non-nil, only unread articles are chose. If DO-NOT-TRANSLATE is
-; non-nil, article names are not equialized before sorting.
-(defun gnus-uu-get-list-of-articles (&optional subject mark-articles only-unread do-not-translate)
-  (let (beg end reg-subject list-of-subjects list-of-numbers art-num)
-    (save-excursion
-      
-; If the subject is not given, this function looks at the current subject
-; and takes that.
-
-      (if subject
-	  (setq reg-subject subject)
-	(end-of-line)
-	(setq end (point))
-	(beginning-of-line)
-	(if (not (re-search-forward "\\] " end t))
-	    (progn (message "No valid subject chosen") (sit-for 2))
-	  (setq subject (buffer-substring (point) end))
-	  (setq reg-subject 
-		(concat "\\[.*\\] " (gnus-uu-reginize-string subject)))))
-
-;      (message reg-subject)(sleep-for 2)
-      
-      (if reg-subject
-	  (progn
-
-; Collect all subjects matching reg-subject.
-
-	    (let ((case-fold-search t))
-	      (goto-char 1)
-	      (while (re-search-forward reg-subject nil t)
-		(beginning-of-line)
-		(setq beg (point))
-		(if (or (not only-unread) (looking-at " \\|-"))
-		    (progn
-		      (end-of-line)
-		      (setq list-of-subjects (cons 
-					      (buffer-substring beg (point))
-					      list-of-subjects)))
-		  (end-of-line))))
-
-; Expand all numbers in all the subjects: (hi9 -> hi0009, etc).
-
-	    (setq list-of-subjects (gnus-uu-expand-numbers 
-				    list-of-subjects
-				    (not do-not-translate)))
-
-; Sort the subjects.
-
-	    (setq list-of-subjects (sort list-of-subjects 'gnus-uu-string<))
-
-; Get the article numbers from the sorted list of subjects.
-
-	    (while list-of-subjects 
-	      (setq art-num (gnus-uu-article-number (car list-of-subjects)))
-	      (if mark-articles (gnus-summary-mark-as-read art-num ?#))
-	      (setq list-of-numbers (cons art-num list-of-numbers))
-	      (setq list-of-subjects (cdr list-of-subjects)))
-
-	    (setq list-of-numbers (nreverse list-of-numbers))))
-
-      list-of-numbers)))
-
-; Takes a list of strings and "expands" all numbers in all the
-; strings.  That is, this function makes all numbers equal length by
-; prepending lots of zeroes before each number. This is to ease later
-; sorting to find out what sequence the articles are supposed to be
-; decoded in. Returns the list of expanded strings.
-(defun gnus-uu-expand-numbers (string-list &optional translate)
-  (let (string out-list pos num)
-    (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
-      (while string-list
-	(erase-buffer)
-	(setq string (car string-list))
-	(setq string-list (cdr string-list))
-	(insert string)
-	(goto-char 1)
-	(while (re-search-forward "[ \t]+" nil t)
-	  (replace-match " "))
-	(goto-char 1)
-	(if translate 
-	    (while (re-search-forward "[A-Za-z]" nil t)
-	      (replace-match "a" t t)))
-
-	(goto-char 1)
-	(if (not (search-forward "] " nil t))
-	    ()
-	  (while (re-search-forward "[0-9]+" nil t)
-	    (replace-match  
-	     (format "%06d" 
-		     (string-to-int (buffer-substring 
-				     (match-beginning 0) (match-end 0))))))
-	  (setq string (buffer-substring 1 (point-max)))
-	  (setq out-list (cons string out-list)))))
-    out-list))
-
-; Used in a sort for finding out what string is bigger, but ignoring
-; everything before the subject part.
-(defun gnus-uu-string< (string1 string2) 
-  (string< (substring string1 (string-match "\\] " string1))
-	   (substring string2 (string-match "\\] " string2))))
-
-
-;; gnus-uu-grab-article
-;
-; This is the general multi-article treatment function.  It takes a
-; list of articles to be grabbed and a function to apply to each
-; article. It puts the result in `gnus-uu-result-buffer'.
-;
-; The function to be called should take two parameters.  The first
-; parameter is the article buffer. The function should leave the
-; result, if any, in this buffer. This result is then appended on to
-; the `gnus-uu-result-buffer'. Most treatment functions will just
-; generate files...
-;
-; The second parameter is the state of the list of articles, and can
-; have four values: `first', `middle', `last' and `first-and-last'.
-;
-; The function should return a list. The list may contain the
-; following symbols:
-; `error' if an error occurred
-; `begin' if the beginning of an encoded file has been received
-;   If the list returned contains a `begin', the first element of
-;   the list *must* be a string with the file name of the decoded
-;   file.
-; `end' if the the end of an encoded file has been received
-; `middle' if the article was a body part of an encoded file
-; `wrong-type' if the article was not a part of an encoded file
-; `ok', which can be used everything is ok
-
-(defvar gnus-uu-has-been-grabbed nil)
-
-(defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article)
-  (let (art)
-    (if (not (and gnus-uu-has-been-grabbed
-		  gnus-uu-unmark-articles-not-decoded))
-	()
-      (if dont-unmark-last-article
-	  (progn
-	    (setq art (car gnus-uu-has-been-grabbed))
-	    (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))))
-      (while gnus-uu-has-been-grabbed
-	(gnus-summary-mark-as-unread (car gnus-uu-has-been-grabbed) t)
-	(setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
-      (if dont-unmark-last-article
-	  (setq gnus-uu-has-been-grabbed (list art))))))
-
-
-; This function takes a list of articles and a function to apply to
-; each article grabbed. The result of the function is appended on to
-; `gnus-uu-result-buffer'.
-; 
-; This function returns a list of files decoded if the grabbing and
-; the process-function has been successful and nil otherwise.
-(defun gnus-uu-grab-articles (list-of-articles process-function &optional sloppy limit)
-  (let ((result-buffer (get-buffer-create gnus-uu-result-buffer))
-	(state 'first)
-	(wrong-type t)
-	has-been-begin has-been-end 
-	article result-file result-files process-state)
-
-    (save-excursion
-      (set-buffer result-buffer)
-      (erase-buffer))
-    (setq gnus-uu-has-been-grabbed nil)
-
-    (while (and list-of-articles 
-		(not (memq 'error process-state))
-		(or sloppy
-		    (not (memq 'end process-state))))
-
-      (setq article (car list-of-articles))
-      (setq list-of-articles (cdr list-of-articles))
-      (setq gnus-uu-has-been-grabbed (cons article gnus-uu-has-been-grabbed))
-
-      (if (> article gnus-uu-highest-article-number) 
-	  (setq gnus-uu-highest-article-number article))
-
-      (if (eq list-of-articles ()) 
-	  (if (eq state 'first)
-	      (setq state 'first-and-last)
-	    (setq state 'last)))
-
-      (message "Getting article %d" article)
-      (if (not (= (or gnus-current-article 0) article))
-	  (gnus-summary-display-article article))
-      (gnus-summary-mark-as-read article)
-
-      (save-excursion (set-buffer gnus-article-buffer) (widen))
-
-      (setq process-state (funcall process-function gnus-article-buffer state))
-
-;      (message "process-state er %s" process-state)(sleep-for 3)
-
-      (if (or (memq 'begin process-state)
-	      (and (or (eq state 'first) (eq state 'first-and-last))
-		   (memq 'ok process-state)))
-	  (progn
-	    (if has-been-begin
-		(if (file-exists-p result-file) (delete-file result-file)))
-	    (setq result-file (car process-state))
-	    (setq has-been-begin t)
-	    (setq has-been-end nil)))
-
-      (if (memq 'end process-state)
-	  (progn
-	    (setq gnus-uu-has-been-grabbed nil)
-	    (setq result-files (cons result-file result-files))
-	    (setq has-been-end t)
-	    (setq has-been-begin nil)
-	    (if (and limit (= (length result-files) limit))
-		(progn
-		  (setq list-of-articles nil)
-		  (setq gnus-uu-marked-article-list nil)))))
-
-      (if (and (or (eq state 'last) (eq state 'first-and-last))
-	       (not (memq 'end process-state)))
-		(if (and result-file (file-exists-p result-file))
-		    (delete-file result-file)))
-
-      (setq result-file nil)
-
-      (if (not (memq 'wrong-type process-state))
-	  (setq wrong-type nil)
-	(if gnus-uu-unmark-articles-not-decoded
-	    (gnus-summary-mark-as-unread article t)))
-
-      (if sloppy (setq wrong-type nil))
-
-      (if (and (not has-been-begin)
-	       (not sloppy)
-	       (or (memq 'end process-state)
-		   (memq 'middle process-state)))
-	  (progn
-	    (setq process-state (list 'error))
-	    (message "No begin part at the beginning")
-	    (sleep-for 2))
-	(setq state 'middle)))
-
-    (if result-files
-	()
-      (if (not has-been-begin)
-	  (message "Wrong type file")
-	(if (memq 'error process-state)
-	    (setq result-files nil)
-	  (if (not (or (memq 'ok process-state) 
-		       (memq 'end process-state)))
-	      (progn
-		(message "End of articles reached before end of file")
-		(setq result-files nil))
-	    (gnus-uu-unmark-list-of-grabbed)))))
-    (setq gnus-uu-list-of-files-decoded result-files)
-    result-files))
-
-(defun gnus-uu-uudecode-sentinel (process event)
-  (delete-process (get-process process)))
-
-; Uudecodes a file asynchronously.
-(defun gnus-uu-uustrip-article-as (process-buffer in-state)
-  (let ((state (list 'ok))
-	(process-connection-type nil)
-	start-char pst name-beg name-end)
-    (save-excursion
-      (set-buffer process-buffer)
-      (let ((case-fold-search nil)
-	    (buffer-read-only nil))
-
-	(goto-char 1)
-
-	(if gnus-uu-kill-carriage-return
-	    (progn
-	      (while (search-forward "\r" nil t)
-		(delete-backward-char 1))
-	      (goto-char 1)))
-
-	(if (not (re-search-forward gnus-uu-begin-string nil t))
-	    (if (not (re-search-forward gnus-uu-body-line nil t))
-		(setq state (list 'wrong-type))))
-     
-	(if (memq 'wrong-type state)
-	    ()
-	  (beginning-of-line)
-	  (setq start-char (point))
-
-	  (if (looking-at gnus-uu-begin-string)
-	      (progn 
-		(setq name-end (match-end 1))
-
-		; Replace any slashes and spaces in file names before decoding
-		(goto-char (setq name-beg (match-beginning 1)))
-		(while (re-search-forward "/" name-end t)
-		  (replace-match ","))
-		(goto-char name-beg)
-		(while (re-search-forward " " name-end t)
-		  (replace-match "_"))
-
-		(setq gnus-uu-file-name (buffer-substring name-beg name-end))
-		(and gnus-uu-uudecode-process
-		     (setq pst (process-status 
-				(or gnus-uu-uudecode-process "nevair")))
-		     (if (or (eq pst 'stop) (eq pst 'run))
-			 (progn
-			   (delete-process gnus-uu-uudecode-process)
-			   (gnus-uu-unmark-list-of-grabbed t))))
-		(setq gnus-uu-uudecode-process
-		      (start-process 
-		       "*uudecode*" 
-		       (get-buffer-create gnus-uu-output-buffer-name)
-		       "sh" "-c" 
-		       (format "cd %s ; uudecode" gnus-uu-work-dir)))
-		(set-process-sentinel 
-		 gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
-		(setq state (list 'begin))
-		(gnus-uu-add-file (concat gnus-uu-work-dir gnus-uu-file-name)))
-	    (setq state (list 'middle)))
-	
-	  (goto-char (point-max))
-
-	  (re-search-backward 
-	   (concat gnus-uu-body-line "\\|" gnus-uu-end-string) nil t)
-	  (beginning-of-line)
-
-	  (if (looking-at gnus-uu-end-string)
-	      (setq state (cons 'end state)))
-	  (forward-line 1)
-
-	  (and gnus-uu-uudecode-process
-	       (setq pst (process-status 
-			  (or gnus-uu-uudecode-process "nevair")))
-	       (if (or (eq pst 'run) (eq pst 'stop))
-		   (progn
-		     (if gnus-uu-correct-stripped-uucode
-			 (progn
-			   (gnus-uu-check-correct-stripped-uucode 
-			    start-char (point))
-			   (goto-char (point-max))
-			   (re-search-backward 
-			    (concat gnus-uu-body-line "\\|" 
-				    gnus-uu-end-string) 
-			    nil t)
-			   (forward-line 1)))
-		     (condition-case err
-			 (process-send-region gnus-uu-uudecode-process 
-					      start-char (point))
-		       (error 
-			(progn 
-			  (message "gnus-uu: Couldn't uudecode")
-			  (sleep-for 2)
-			  (setq state (list 'wrong-type))
-			  (delete-process gnus-uu-uudecode-process))))
-		     (if (memq 'end state)
-			 (accept-process-output gnus-uu-uudecode-process)))
-		 (setq state (list 'wrong-type))))
-	  (if (not gnus-uu-uudecode-process)
-	      (setq state (list 'wrong-type)))))
-
-      (if (memq 'begin state)
-	  (cons (concat gnus-uu-work-dir gnus-uu-file-name) state)
-	state))))
-
-; This function is used by `gnus-uu-grab-articles' to treat
-; a shared article.
-(defun gnus-uu-unshar-article (process-buffer in-state)
-  (let ((state (list 'ok))
-	start-char)
-    (save-excursion
-     (set-buffer process-buffer)
-     (goto-char 1)
-     (if (not (re-search-forward gnus-uu-shar-begin-string nil t))
-	 (setq state (list 'wrong-type))
-       (beginning-of-line)
-       (setq start-char (point))
-       (call-process-region 
-	start-char (point-max) "sh" nil 
-	(get-buffer-create gnus-uu-output-buffer-name) nil 
-	"-c" (concat "cd " gnus-uu-shar-directory " ; sh"))))
-    state))
-
-; Returns the name of what the shar file is going to unpack.
-(defun gnus-uu-find-name-in-shar ()
-  (let ((oldpoint (point))
-	res)
-    (goto-char 1)
-    (if (re-search-forward gnus-uu-shar-name-marker nil t)
-	(setq res (buffer-substring (match-beginning 1) (match-end 1))))
-    (goto-char oldpoint)
-    res))
-
-; Returns the article number of the given subject.
-(defun gnus-uu-article-number (subject)
-  (let (end)
-    (string-match "[0-9]+[^0-9]" subject 1)
-    (setq end (match-end 0))
-    (string-to-int 
-     (substring subject (string-match "[0-9]" subject 1) end)))) 
-	      
-; `gnus-uu-choose-action' chooses what action to perform given the name
-; and `gnus-uu-file-action-list'.  Returns either nil if no action is
-; found, or the name of the command to run if such a rule is found.
-(defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore)
-  (let ((action-list (copy-sequence file-action-list))
-	rule action)
-    (and 
-     (or no-ignore 
-	 (and (not 
-	       (and gnus-uu-ignore-files-by-name
-		    (string-match gnus-uu-ignore-files-by-name file-name)))
-	      (not 
-	       (and gnus-uu-ignore-files-by-type
-		    (string-match gnus-uu-ignore-files-by-type 
-				  (or (gnus-uu-choose-action 
-				       file-name gnus-uu-ext-to-mime-list t) 
-				      ""))))))
-     (while (not (or (eq action-list ()) action))
-       (setq rule (car action-list))
-       (setq action-list (cdr action-list))
-       (if (string-match (car rule) file-name)
-	   (setq action (car (cdr rule))))))
-    action))
-
-(defun gnus-uu-save-directory (from-dir &optional default-dir ignore-existing)
-  (let (dir file-name command files file)
-    (setq files (directory-files from-dir t))
-    (if default-dir
-	(setq dir default-dir)
-      (setq dir (gnus-uu-read-directory 
-		 (concat "Where do you want the file" 
-			 (if (< 3 (length files)) "s" "") "? "))))
-
-    (while files
-      (setq file (car files))
-      (setq files (cdr files))
-      (string-match "/[^/]*$" file)
-      (setq file-name (substring file (1+ (match-beginning 0))))
-      (if (string-match "^\\.\\.?$" file-name)
-	  ()
-	(if (and (not ignore-existing) (file-exists-p (concat dir file-name)))
-	    (setq file-name
-		  (read-file-name "File exists. Enter a new name: " dir 
-				  (concat dir file-name) nil file-name))
-	  (setq file-name (concat dir file-name)))
-	(rename-file file file-name t)))))
-
-; Moves the file from the tmp directory to where the user wants it.
-(defun gnus-uu-save-file (from-file-name &optional default-dir ignore-existing)
-  (let (dir file-name command)
-    (string-match "/[^/]*$" from-file-name)
-    (setq file-name (substring from-file-name (1+ (match-beginning 0))))
-    (if default-dir
-	(setq dir default-dir)
-      (setq dir (gnus-uu-read-directory "Where do you want the file? ")))
-    (if (and (not ignore-existing) (file-exists-p (concat dir file-name)))
-	(setq file-name
-	      (read-file-name "File exist. Enter a new name: " dir 
-			      (concat dir file-name) nil file-name))
-      (setq file-name (concat dir file-name)))
-    (rename-file from-file-name file-name t)))
-    
-(defun gnus-uu-read-directory (prompt &optional default)
-  (let (dir ok create)
-    (while (not ok)
-      (setq ok t)
-      (setq dir (if default default
-		  (read-file-name prompt gnus-uu-current-save-dir 
-				  gnus-uu-current-save-dir)))
-      (while (string-match "/$" dir)
-	(setq dir (substring dir 0 (match-beginning 0))))
-      (if (file-exists-p dir)
-	  (if (not (file-directory-p dir))
-	      (progn
-		(setq ok nil)
-		(message "%s is a file" dir)
-		(sit-for 2)))
-	(setq create ?o)
-	(while (not (or (= create ?y) (= create ?n)))
-	  (message "%s: No such directory. Do you want to create it? (y/n)" 
-		   dir)
-	  (setq create (read-char)))
-	(if (= create ?y) (make-directory dir))))
-    (setq gnus-uu-current-save-dir (concat dir "/"))))
-
-; Unpacks an archive and views all the files in it. Returns t if
-; viewing one or more files is successful.
-(defun gnus-uu-treat-archive (file-path)
-  (let ((did-unpack t)
-	action command files file file-name dir)
-    (setq action (gnus-uu-choose-action 
-		  file-path (append gnus-uu-user-archive-rules
-				    (if gnus-uu-ignore-default-archive-rules
-					nil
-				      gnus-uu-default-archive-rules))))
-
-    (if (not action) (error "No unpackers for the file %s" file-path))
-
-    (string-match "/[^/]*$" file-path)
-    (setq file-name (substring file-path (1+ (match-beginning 0))))
-    (setq dir (substring file-path 0 (match-beginning 0)))
-
-    (if (gnus-uu-string-in-list action gnus-uu-destructive-archivers)
-	(copy-file file-path (concat file-path "~") t))
-
-    (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path)))
-
-    (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
-      (erase-buffer))
-
-    (message "Unpacking: %s..." (gnus-uu-command action file-path))
-
-    (if (= 0 (call-process "sh" nil 
-			   (get-buffer-create gnus-uu-output-buffer-name)
-			   nil "-c" command))
-	(message "")
-      (if (not gnus-uu-use-interactive-view)
-	  (progn
-	    (message "Error during unpacking of archive")
-	    (sleep-for 2)))
-      (setq did-unpack nil))
-
-    (if (gnus-uu-string-in-list action gnus-uu-destructive-archivers)
-	(rename-file (concat file-path "~") file-path t))
-
-    did-unpack))
-
-; Tries to view all the files in the given directory. Returns t if
-; viewing one or more files is successful.
-(defun gnus-uu-view-directory (dir &optional dont-delete-files not-top)
-  (let ((first t)
-	files file did-view ignore-files)
-    (setq files (directory-files dir t "[^/][^\\.][^\\.]?$"))
-    (gnus-uu-add-file files)
-    (setq ignore-files files)
-    
-    (while (gnus-uu-unpack-archives 
-	    files (if not-top (list ".")
-		    (if first () ignore-files)))
-      (setq first nil)
-      (gnus-uu-add-file 
-       (setq files (directory-files dir t "[^/][^\\.][^\\.]?$"))))
-
-    (gnus-uu-add-file (directory-files dir t "[^/][^\\.][^\\.]?$"))
-      
-    (while files
-      (setq file (car files))
-      (setq files (cdr files))
-      (if (not (string= (or (gnus-uu-get-action file) "") "gnus-uu-archive"))
-	  (progn
-	    (set-file-modes file 448)
-	    (if (file-directory-p file)
-		(setq did-view (or (gnus-uu-view-directory file 
-							   dont-delete-files 
-							   t) 
-				   did-view))
-	      (setq did-view (or (gnus-uu-view-file file t) did-view)))))
-      (if (and (not dont-delete-files) (not gnus-uu-asynchronous) 
-	       (file-exists-p file))
-	  (delete-file file)))
-
-    (if (and (not gnus-uu-asynchronous) (not dont-delete-files))
-	(if (string-match "/$" dir)
-	    (delete-directory (substring dir 0 (match-beginning 0)))
-	  (delete-directory dir)))
-    did-view))
-
-(defun gnus-uu-unpack-archives (files &optional ignore)
-  (let (path did-unpack)
-    (while files
-      (setq path (car files))
-      (setq files (cdr files))
-      (if (not (gnus-uu-string-in-list path ignore))
-	  (if (string= (or (gnus-uu-get-action 
-			    (gnus-uu-name-from-path path)) "") 
-		       "gnus-uu-archive")
-	      (progn
-		(if (and (not (setq did-unpack (gnus-uu-treat-archive path)))
-			 gnus-uu-use-interactive-view)
-		    (gnus-uu-enter-interactive-file 
-		     "# error during unpacking of" path))
-		(if ignore (delete-file path))))))
-    did-unpack))
-
-
-;; Manual marking
-
-(defun gnus-uu-enter-mark-in-list ()
-  (let (article	beg)
-    (save-excursion
-      (beginning-of-line)
-      (setq beg (point))
-      (end-of-line)
-      (setq article (gnus-uu-article-number 
-		     (buffer-substring beg (point))))
-      (message "Adding article %d to list" article)
-      (setq gnus-uu-marked-article-list 
-	    (cons article gnus-uu-marked-article-list))))) 
-
-(defun gnus-uu-mark-article (&optional dont-move)
-  "Marks the current article to be decoded later."
-  (interactive)
-  (gnus-uu-enter-mark-in-list)
-  (gnus-summary-mark-as-read nil ?#)
-  (gnus-summary-next-subject 1 nil))
-
-(defun gnus-uu-unmark-article ()
-  "Unmarks the current article."
-  (interactive)
-  (let ((in (copy-sequence gnus-uu-marked-article-list))
-	out article beg found
-	(old-point (point)))
-    (beginning-of-line)
-      (setq beg (point))
-      (end-of-line)
-      (setq article (gnus-uu-article-number (buffer-substring beg (point))))
-      (message "Removing article %d" article)
-      (while in 
-	(if (not (= (car in) article))
-	    (setq out (cons (car in) out))
-	  (setq found t)
-	  (message "Removing article %d" article))
-	(setq in (cdr in)))
-      (if (not found) (message "Not a marked article."))
-      (setq gnus-uu-marked-article-list (reverse out))
-      (gnus-summary-mark-as-unread nil t)
-      (gnus-summary-next-subject 1 nil)))
-
-(defun gnus-uu-unmark-all-articles ()
-  "Removes the mark from all articles marked for decoding."
-  (interactive)
-  (while gnus-uu-marked-article-list
-    (gnus-summary-goto-subject (car gnus-uu-marked-article-list))
-    (gnus-summary-mark-as-unread nil t)
-    (setq gnus-uu-marked-article-list (cdr gnus-uu-marked-article-list))))
-
-(defun gnus-uu-mark-by-regexp ()
-  "Asks for a regular expression and marks all articles that match."
-  (interactive)
-  (let (exp)
-    (setq exp (read-from-minibuffer "Mark (regexp): "))
-    (setq gnus-uu-marked-article-list 
-	  (append gnus-uu-marked-article-list
-		  (reverse (gnus-uu-get-list-of-articles exp t))))
-    (message "")))
-      
-(defun gnus-uu-mark-thread ()
-  "Marks all articles downwards in this thread."
-  (interactive)
-  (beginning-of-line)
-  (let (level)
-    (if (not (search-forward ":" nil t))
-	()
-      (setq level (current-column))
-      (gnus-uu-enter-mark-in-list)
-      (gnus-summary-mark-as-read nil ?#)
-      (gnus-summary-search-forward)
-      (while (< level (current-column))
-	(gnus-uu-enter-mark-in-list)
-	(gnus-summary-mark-as-read nil ?#)
-	(gnus-summary-search-forward))
-      (gnus-summary-search-backward))))
-
-
-;; Various stuff
-
-(defun gnus-uu-string-in-list (string list)
-  (while (and list
-	      (not (string= (car list) string))
-	      (setq list (cdr list))))
-  list)
-
-(defun gnus-uu-name-from-path (path)
-  (string-match "/[^/]*$" path)
-  (substring path (1+ (match-beginning 0))))
-
-(defun gnus-uu-directory-files (dir)
-  (let (files out file)
-    (setq files (directory-files dir t))
-    (while files
-      (setq file (car files))
-      (setq files (cdr files))
-      (if (not (string-match "/\\.\\.?$" file))
-	  (setq out (cons file out))))
-    (setq out (reverse out))
-    out))
-
-(defun gnus-uu-check-correct-stripped-uucode (start end)
-  (let (found beg length short)
-    (if (not gnus-uu-correct-stripped-uucode)
-	()
-      (goto-char start)
-
-      (if (re-search-forward " \\|`" end t)
-	  (progn
-	    (goto-char start)
-	    (while (not (eobp))
-	      (progn
-		(if (looking-at "\n") (replace-match ""))
-		(forward-line 1))))
-	    
-	(while (not (eobp))
-	  (if (looking-at (concat gnus-uu-begin-string "\\|" 
-				  gnus-uu-end-string))
-	      ()
-	    (if (not found)
-		(progn
-		  (beginning-of-line)
-		  (setq beg (point))
-		  (end-of-line)
-		  (setq length (- (point) beg))))
-	    (setq found t)
-	    (beginning-of-line)
-	    (setq beg (point))
-	    (end-of-line)
-	    (if (not (= length (- (point) beg)))
-		(insert (make-string (- length (- (point) beg)) ? ))))
-	  (forward-line 1))))))
-
-(defun gnus-uu-initialize ()
-  (setq gnus-uu-highest-article-number 1)
-  (gnus-uu-check-for-generated-files)
-  (setq gnus-uu-tmp-dir (expand-file-name gnus-uu-tmp-dir))
-  (if (string-match "[^/]$" gnus-uu-tmp-dir) 
-      (setq gnus-uu-tmp-dir (concat gnus-uu-tmp-dir "/")))
-  (if (not (file-directory-p gnus-uu-tmp-dir))
-      (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir)
-    (if (not (file-writable-p gnus-uu-tmp-dir))
-	(error "Temp directory %s can't be written to" gnus-uu-tmp-dir)))
-  (setq gnus-uu-work-dir 
-	(concat gnus-uu-tmp-dir (make-temp-name "gnus")))
-  (gnus-uu-add-file gnus-uu-work-dir)
-  (if (not (file-directory-p gnus-uu-work-dir)) 
-      (make-directory gnus-uu-work-dir))
-  (setq gnus-uu-work-dir (concat gnus-uu-work-dir "/"))
-  (setq gnus-uu-interactive-file-list nil))
-
-; Kills the temporary uu buffers, kills any processes, etc.
-(defun gnus-uu-clean-up ()
-  (let (buf pst)
-    (and gnus-uu-uudecode-process
-	 (setq pst (process-status (or gnus-uu-uudecode-process "nevair")))
-	 (if (or (eq pst 'stop) (eq pst 'run))
-	     (delete-process gnus-uu-uudecode-process)))
-    (and (not gnus-uu-asynchronous) 
-	 (setq buf (get-buffer gnus-uu-output-buffer-name))
-	 (kill-buffer buf))
-    (and (setq buf (get-buffer gnus-uu-result-buffer))
-	 (kill-buffer buf))))
-
-; `gnus-uu-check-for-generated-files' deletes any generated files that
-; hasn't been deleted, if, for instance, the user terminated decoding
-; with `C-g'.
-(defun gnus-uu-check-for-generated-files ()
-  (let (file dirs)
-    (while gnus-uu-generated-file-list
-      (setq file (car gnus-uu-generated-file-list))
-      (setq gnus-uu-generated-file-list (cdr gnus-uu-generated-file-list))
-      (if (not (string-match "/\\.[\\.]?$" file))
-	  (progn
-	    (if (file-directory-p file)
-		(setq dirs (cons file dirs))
-	      (if (file-exists-p file)
-		  (delete-file file))))))
-    (setq dirs (nreverse dirs))
-    (while dirs
-      (setq file (car dirs))
-      (setq dirs (cdr dirs))
-      (if (file-directory-p file)
-	  (if (string-match "/$" file)
-	      (delete-directory (substring file 0 (match-beginning 0)))
-	    (delete-directory file))))))
-
-; Add a file (or a list of files) to be checked (and deleted if it/they
-; still exists upon exiting the newsgroup).
-(defun gnus-uu-add-file (file)
-  (if (stringp file)
-      (setq gnus-uu-generated-file-list 
-	    (cons file gnus-uu-generated-file-list))
-    (setq gnus-uu-generated-file-list 
-	  (append file gnus-uu-generated-file-list))))
-
-; Go to the next unread subject. If there is no further unread
-; subjects, go to the last subject in the buffer.
-(defun gnus-uu-summary-next-subject ()
-  (let (opi)
-    (if (not (gnus-summary-search-forward t))
-	(progn
-	  (goto-char 1)
-	  (sit-for 0)
-	  (gnus-summary-goto-subject gnus-uu-highest-article-number)))
-
-    ; You may well find all this a bit puzzling - so do I, but I seem
-    ; to have to do something like this to move to the next unread article,
-    ; as `sit-for' seems to do some rather strange things here. Might
-    ; be a bug in my head, probably.
-    (setq opi (point))
-    (sit-for 0)
-    (goto-char opi)
-    (gnus-summary-recenter)))
-
-; Inputs an action and a file and returns a full command, putting
-; ticks round the file name and escaping any ticks in the file name.
-(defun gnus-uu-command (action file)
-  (let ((ofile ""))
-    (while (string-match "`\\|\"\\|\\$\\|\\\\" file)
-      (progn
-	(setq ofile
-	      (concat ofile (substring file 0 (match-beginning 0)) "\\"
-		      (substring file (match-beginning 0) (match-end 0))))
-	(setq file (substring file (1+ (match-beginning 0))))))
-    (setq ofile (concat "\"" ofile file "\""))
-    (if (string-match "%s" action)
-	(format action ofile)
-      (concat action " " ofile))))
-
-
-;; Initializing
-(add-hook 'gnus-exit-group-hook
-      '(lambda ()
-	 (gnus-uu-clean-up)
-	 (setq gnus-uu-marked-article-list nil)
-	 (gnus-uu-check-for-generated-files)))
-
-
-;; Interactive exec mode
-
-(defvar gnus-uu-output-window nil)
-(defvar gnus-uu-mode-hook nil)
-
-(defvar gnus-uu-mode-map nil)
-(if gnus-uu-mode-map
-    ()
-  (setq gnus-uu-mode-map (make-sparse-keymap))
-  (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute)
-  (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute)
-  (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute)
-  (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end)
-  (define-key gnus-uu-mode-map "\C-c\C-z" 
-    'gnus-uu-interactive-save-current-file)
-  (define-key gnus-uu-mode-map "\C-c\C-s"
-    'gnus-uu-interactive-save-current-file-silent)
-  (define-key gnus-uu-mode-map "\C-c\C-w" 'gnus-uu-interactive-save-all-files)
-  (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file)
-  (define-key gnus-uu-mode-map "\C-c\C-r" 'gnus-uu-interactive-rescan-directory)
-  (define-key gnus-uu-mode-map "\C-c\C-d" 'gnus-uu-interactive-scan-directory)
-  )
-
-(defun gnus-uu-interactive-set-up-windows ()
-  (let (int-buf out-buf)
-    (set-buffer 
-     (setq int-buf (get-buffer-create gnus-uu-interactive-buffer-name)))
-    (if (not (get-buffer-window int-buf))
-	(switch-to-buffer-other-window int-buf))
-    (pop-to-buffer int-buf)
-    (setq out-buf (get-buffer-create gnus-uu-output-buffer-name))
-    (if (not (get-buffer-window out-buf))
-	(progn
-	  (setq gnus-uu-output-window 
-		(split-window nil (- (window-height) 
-				     gnus-uu-output-window-height)))
-	  (set-window-buffer gnus-uu-output-window out-buf)))))
-
-(defun gnus-uu-do-interactive (&optional dont-do-windows)
-  (if (not gnus-uu-interactive-file-list) 
-      (gnus-uu-enter-interactive-file "#" ""))
-  (if (not dont-do-windows) (gnus-uu-interactive-set-up-windows))
-  (save-excursion 
-    (set-buffer (get-buffer-create gnus-uu-output-buffer-name)) 
-    (erase-buffer))
-  (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name))
-  (goto-char 1)
-  (forward-line 3)
-  (run-hooks 'gnus-uu-mode-hook))
-
-(defun gnus-uu-enter-interactive-file (action file)
-  (let (command)
-    (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-interactive-buffer-name))
-      (if (not gnus-uu-interactive-file-list)
-	  (progn
-	    (erase-buffer)
-	    (gnus-uu-mode)
-	    (insert 
-	     "# Press return to execute a command.
-# Press `C-c C-c' to exit interactive view.
-
-")))   
-      (setq gnus-uu-interactive-file-list
-	    (cons file gnus-uu-interactive-file-list))
-;      (if (string-match (concat "^" gnus-uu-work-dir) file)
-;	  (setq file (substring file (match-end 0))))
-      (setq command (gnus-uu-command action file))
-      (goto-char (point-max))
-      (insert (format "%s\n" command)))))
-
-(defun gnus-uu-interactive-execute ()
-  "Executes the command on the current line in interactive mode."
-  (interactive)
-  (let (beg out-buf command)
-    (beginning-of-line)
-    (setq beg (point))
-    (end-of-line)
-    (setq command (buffer-substring beg (point)))
-    (setq out-buf (get-buffer-create gnus-uu-output-buffer-name))
-    (save-excursion
-      (set-buffer out-buf)
-      (erase-buffer)
-      (insert (format "$ %s \n\n" command)))
-    (setq command (format "cd %s ; %s" gnus-uu-work-dir command))
-    (message "Executing...")
-    (if gnus-uu-asynchronous
-	(start-process "gnus-uu-view" out-buf "sh" "-c" command)
-      (call-process "sh" nil out-buf nil "-c" command)
-      (message ""))
-    (end-of-line)
-    (if (= (forward-line 1) 1)
-	(progn
-	  (end-of-line)
-	  (insert "\n")))
-    (beginning-of-line)))
-
-(defun gnus-uu-interactive-end ()
-  "This function exits interactive view mode and returns to summary mode."
-  (interactive)
-  (let (buf)
-    (delete-window gnus-uu-output-window)
-    (gnus-uu-clean-up)
-    (if (not gnus-uu-asynchronous) (gnus-uu-check-for-generated-files))
-    (setq buf (get-buffer gnus-uu-interactive-buffer-name))
-    (if gnus-article-buffer (switch-to-buffer gnus-article-buffer))
-    (if buf (kill-buffer buf))
-    (pop-to-buffer gnus-summary-buffer)))
-
-
-(defun gnus-uu-interactive-scan-directory (dir)
-  "Read any directory and view the files.
-When used in interactive mode, the files and commands will be displayed,
-as usual, in the interactive mode buffer."
-  (interactive "DDirectory: ")
-  (setq gnus-uu-interactive-file-list nil)
-  (gnus-uu-view-directory dir gnus-uu-use-interactive-view)
-  (gnus-uu-do-interactive t))
-  
-(defun gnus-uu-interactive-rescan-directory ()
-  "Reread the directory and view the files.
-When used in interactive mode, the files and commands will be displayed,
-as usual, in the interactive mode buffer."
-  (interactive)
-  (gnus-uu-interactive-scan-directory gnus-uu-work-dir))
-
-(defun gnus-uu-interactive-save-original-file ()
-  "Saves the file from whence the file on the current line came from."
-  (interactive)
-  (let ((files gnus-uu-list-of-files-decoded)
-	(filestr "")
-	file did dir)
-    (while files
-      (setq file (car files))
-      (setq files (cdr files))
-      (if (file-exists-p file)
-	  (progn
-	    (if (not did)
-		(progn
-		  (setq dir (gnus-uu-read-directory 
-			     (format "Where do you want the file%s? " 
-				     (if (> (length files) 1) "s" ""))))
-		  (setq did t)))
-	    (setq filestr (concat filestr (gnus-uu-name-from-path file) " "))
-	    (gnus-uu-save-file file dir t)))
-      (if did 
-	  (message "Saved %s" filestr)
-	(message "Already saved.")))))
-
-(defun gnus-uu-interactive-save-current-file-silent ()
-  "Saves the file referred to on the current line in the current directory."
-  (interactive)
-  (gnus-uu-interactive-save-current-file t))
-
-(defun gnus-uu-interactive-save-current-file (&optional dont-ask silent)
-  "Saves the file referred to on the current line."
-  (interactive)
-  (let (files beg line file)
-    (setq files (copy-sequence gnus-uu-interactive-file-list))
-    (beginning-of-line)
-    (setq beg (point))
-    (end-of-line)
-    (setq line (buffer-substring beg (point)))
-    (while (and files
-		(not (string-match 
-		      (concat "" (regexp-quote (setq file (car files))) "")
-		      line)))
-      (setq files (cdr files)))
-    (beginning-of-line)
-    (forward-line 1)
-    (if (not files)
-	(if (not silent)
-	    (progn (message "Could not find file") (sit-for 2)))
-      (gnus-uu-save-file file (if dont-ask gnus-uu-current-save-dir nil) silent)
-      (delete-region beg (point)))))
-
-(defun gnus-uu-interactive-save-all-files ()
-  "Saves all files referred to in the interactive buffer."
-  (interactive)
-  (let (dir)
-    (goto-char 1)
-    (setq dir (gnus-uu-read-directory "Where do you want the files? "))
-    (while (not (eobp))
-      (gnus-uu-interactive-save-current-file t t))))
-
-(defun gnus-uu-mode ()
-  "Major mode for editing view commands in gnus-uu.
-
-Commands:
-\\<gnus-uu-mode-map>Return, C-c C-v, C-c C-x        Execute the current command
-\\[gnus-uu-interactive-end]\tEnd interactive mode
-\\[gnus-uu-interactive-save-current-file]\tSave the current file
-\\[gnus-uu-interactive-save-current-file-silent]\tSave the current file without asking 
-\twhere to put it
-\\[gnus-uu-interactive-save-all-files]\tSave all files
-\\[gnus-uu-interactive-save-original-file]\tSave the original file: If the files
-\toriginated in an archive, the archive 
-\tfile is saved.
-\\[gnus-uu-interactive-rescan-directory]\tRescan the directory
-\\[gnus-uu-interactive-scan-directory]\tScan any directory
-"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map gnus-uu-mode-map)   
-  (setq mode-name "gnus-uu")         
-  (setq major-mode 'gnus-uu-mode)    
-)
-
-  (define-key gnus-uu-mode-map "\C-c\C-x" 'gnus-uu-interactive-execute)
-  (define-key gnus-uu-mode-map "\C-c\C-v" 'gnus-uu-interactive-execute)
-  (define-key gnus-uu-mode-map "\C-m" 'gnus-uu-interactive-execute)
-  (define-key gnus-uu-mode-map "\C-c\C-c" 'gnus-uu-interactive-end)
-  (define-key gnus-uu-mode-map "\C-cs" 
-    'gnus-uu-interactive-save-current-file)
-  (define-key gnus-uu-mode-map "\C-c\C-s"
-    'gnus-uu-interactive-save-current-file-silent)
-  (define-key gnus-uu-mode-map "\C-c\C-a" 'gnus-uu-interactive-save-all-files)
-  (define-key gnus-uu-mode-map "\C-c\C-o" 'gnus-uu-interactive-save-original-file)
-
-
-;; Major mode for posting encoded articles.
-
-(require 'sendmail)
-(require 'rnews)
-
-; Any function that is to be used as and encoding method will take two
-; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg"
-; and "spiral.jpg", respectively.) The function should return nil if
-; the encoding wasn't successful.
-(defvar gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode
-  "Function used for encoding binary files.
-There are three functions supplied with gnus-uu for encoding files:
-`gnus-uu-post-encode-uuencode', which does straight uuencoding;
-`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME 
-headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with 
-uuencode and adds MIME headers.")
-
-(defvar gnus-uu-post-include-before-composing nil
-  "Non-nil means that gnus-uu will ask for a file to encode before you compose the article.
-If this variable is t, you can either include an encoded file with
-\\<gnus-uu-post-reply-mode-map>\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article.")
-
-(defvar gnus-uu-post-length 990
-  "Maximum length of an article.
-The encoded file will be split into how many articles it takes to
-post the entire file.")
-
-(defvar gnus-uu-post-threaded nil
-  "Non-nil means that gnus-uu will post the encoded file in a thread.
-This may not be smart, as no other decoder I have seen are able to
-follow threads when collecting uuencoded articles. (Well, I have seen
-one package that does that - gnus-uu, but somehow, I don't think that 
-counts...) Default is nil.")
-
-(defvar gnus-uu-post-separate-description t
-  "Non-nil means that the description will be posted in a separate article.
-The first article will typically be numbered (0/x). If this variable
-is nil, the description the user enters will be included at the 
-beginning of the first article, which will be numbered (1/x). Default 
-is t.")
-
-(defconst gnus-uu-post-binary-separator "--binary follows this line--")
-(defvar gnus-uu-post-message-id nil)
-(defvar gnus-uu-post-inserted-file-name nil)
-(defvar gnus-uu-winconf-post-news nil)
-
-; The following map and mode was taken from rnewspost.el and edited
-; somewhat.
-(defvar gnus-uu-post-reply-mode-map () "Mode map used by gnus-uu-post-reply.")
-(or gnus-uu-post-reply-mode-map
-    (progn
-      (setq gnus-uu-post-reply-mode-map (make-keymap))
-      (define-key gnus-uu-post-reply-mode-map "\C-c?" 'describe-mode)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-d" 
-	'news-reply-distribution)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-k" 
-	'news-reply-keywords)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-n" 
-	'news-reply-newsgroups)
-      
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-f" 
-	'news-reply-followup-to)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-f\C-a" 
-	'gnus-uu-post-reply-summary)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-r" 
-	'news-caesar-buffer-body)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-w" 'news-reply-signature)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-y" 
-	'news-reply-yank-original)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-q" 
-	'mail-fill-yanked-message)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-c" 
-	'gnus-uu-post-news-inews)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-s" 
-	'gnus-uu-post-news-inews)
-      (define-key gnus-uu-post-reply-mode-map "\C-c\C-i" 
-	'gnus-uu-post-insert-binary-in-article)
-      ))
-
-; This mode was taken from rnewspost.el and modified slightly.
-(defun gnus-uu-post-reply-mode ()
-  "Major mode for editing binary news to be posted on USENET.
-First-time posters are asked to please read the articles in newsgroup:
-                                                     news.announce.newusers .
-
-Like news-reply-mode, which is like Text Mode, but with these
-additional commands:
-
-\\<gnus-uu-post-reply-mode-map>\\[gnus-uu-post-news-inews]  post the message.
-C-c C-f	 move to a header field (and create it if there isn't):
-	 C-c C-f C-n  move to Newsgroups:	C-c C-f C-s  move to Subj:
-	 C-c C-f C-f  move to Followup-To:      C-c C-f C-k  move to Keywords:
-	 C-c C-f C-d  move to Distribution:	C-c C-f C-a  move to Summary:
-C-c C-y  news-reply-yank-original (insert current message, in NEWS).
-C-c C-q  mail-fill-yanked-message (fill what was yanked).
-C-c C-r  caesar rotate all letters by 13 places in the article's body (rot13).
-\\[gnus-uu-post-insert-binary-in-article]  encode and include a file in this article.
-
-This mode is almost identical to news-reply-mode, but has some
-additional commands for treating encoded binary articles. In
-particular, \\[gnus-uu-post-news-inews] will ask for a file to include, if
-one hasn't been included already. It will post, first, the message
-composed, and then it will post as many additional articles it takes
-to post the entire encoded files.
-
-   Relevant Variables
-
-   `gnus-uu-post-encode-method' 
-   There are three functions supplied with gnus-uu for encoding files:
-   `gnus-uu-post-encode-uuencode', which does straight uuencoding;
-   `gnus-uu-post-encode-mime', which encodes with base64 and adds MIME 
-   headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with 
-   uuencode and adds MIME headers.
- 
-   `gnus-uu-post-include-before-composing'
-   Non-nil means that gnus-uu will ask for a file to encode before you
-   compose the article.  If this variable is t, you can either include
-   an encoded file with `C-c C-i' or have one included for you when you 
-   post the article.
-
-   `gnus-uu-post-length'
-   Maximum length of an article. The encoded file will be split into how 
-   many articles it takes to post the entire file.
-
-   `gnus-uu-post-separate-description'
-   Non-nil means that the description will be posted in a separate 
-   article. The first article will typically be numbered (0/x). If 
-   this variable is nil, the description the user enters will be 
-   included at the beginning of the first article, which will be 
-   numbered (1/x). Default is t.
-
-   `gnus-uu-post-threaded'
-   Non-nil means that gnus-uu will post the encoded file in a thread.
-   This may not be smart, as no other decoder I have seen are able to
-   follow threads when collecting uuencoded articles. (Well, I have seen
-   one package that does that - gnus-uu, but somehow, I don't think that 
-   counts...) Default is nil.
-"
-  (interactive)
-  ;; require...
-  (or (fboundp 'mail-setup) (load "sendmail"))
-  (kill-all-local-variables)
-  (make-local-variable 'mail-reply-buffer)
-  (setq mail-reply-buffer nil)
-  (set-syntax-table text-mode-syntax-table)
-  (use-local-map gnus-uu-post-reply-mode-map)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (setq major-mode 'gnus-uu-post-reply-mode)
-  (setq mode-name "Gnus UU News")
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat mail-header-separator "$\\|"
-				paragraph-start))
-  (setq paragraph-separate (concat mail-header-separator "$\\|"
-				   paragraph-separate))
-  (run-hooks 'text-mode-hook 'gnus-uu-post-reply-mode-hook))
-
-(defun gnus-uu-post-news ()
-  "Compose an article and post an encoded file."
-  (interactive)
-  (setq gnus-uu-post-inserted-file-name nil)
-  (setq gnus-uu-winconf-post-news (current-window-configuration))
-  (let (news-reply-mode)
-    (fset 'news-reply-mode 'gnus-uu-post-reply-mode)
-    (gnus-summary-post-news)
-    (if gnus-uu-post-include-before-composing
-	(save-excursion (setq gnus-uu-post-inserted-file-name 
-			      (gnus-uu-post-insert-binary))))))
-
-(defun gnus-uu-post-insert-binary-in-article ()
-  "Inserts an encoded file in the buffer.
-The user will be asked for a file name."
-  (interactive)
-  (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer)))
-      (error "Not in post-news buffer"))
-  (save-excursion 
-    (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))
-
-; Encodes with uuencode and substitutes all spaces with backticks.
-(defun gnus-uu-post-encode-uuencode (path file-name)
-  (if (gnus-uu-post-encode-file "uuencode" path file-name)
-      (progn
-	(goto-char 1)
-	(forward-line 1)
-	(while (re-search-forward " " nil t)
-	  (replace-match "`"))
-	t)))
-
-; Encodes with uuencode and adds MIME headers.
-(defun gnus-uu-post-encode-mime-uuencode (path file-name)
-  (if (gnus-uu-post-encode-uuencode path file-name)
-      (progn
-	(gnus-uu-post-make-mime file-name "x-uue")
-	t)))
-
-; Encodes with base64 and adds MIME headers
-(defun gnus-uu-post-encode-mime (path file-name)
-  (if (gnus-uu-post-encode-file "mmencode" path file-name)
-      (progn
-	(gnus-uu-post-make-mime file-name "base64")
-	t)))
-
-; Adds MIME headers.
-(defun gnus-uu-post-make-mime (file-name encoding)
-  (goto-char 1)
-  (insert (format "Content-Type: %s; name=\"%s\"\n" 
-		  (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) 
-		  file-name))
-  (insert (format "Content-Transfer-Encoding: %s\n\n" encoding))
-  (save-restriction
-    (set-buffer gnus-post-news-buffer)
-    (goto-char 1)
-    (re-search-forward mail-header-separator)
-    (beginning-of-line)
-    (forward-line -1)
-    (narrow-to-region 1 (point))
-    (or (mail-fetch-field "mime-version")
-	(progn
-	  (widen)
-	  (insert "MIME-Version: 1.0\n")))
-    (widen)))
-
-; Encodes a file PATH with COMMAND, leaving the result in the
-; current buffer.
-(defun gnus-uu-post-encode-file (command path file-name)
-  (= 0 (call-process "sh" nil t nil "-c" 
-		     (format "%s %s %s" command path file-name))))
-
-(defun gnus-uu-post-news-inews ()
-  "Posts the composed news article and encoded file.
-If no file has been included, the user will be asked for a file."
-  (interactive)
-  (if (not (eq (current-buffer) (get-buffer gnus-post-news-buffer)))
-      (error "Not in post news buffer"))
-
-  (let (file-name)
-
-    (if gnus-uu-post-inserted-file-name
-	(setq file-name gnus-uu-post-inserted-file-name)
-      (setq file-name (gnus-uu-post-insert-binary)))
-  
-    (if gnus-uu-post-threaded
-	(let ((gnus-required-headers 
-	       (if (memq 'Message-ID gnus-required-headers)
-		   gnus-required-headers
-		 (cons 'Message-ID gnus-required-headers)))
-	      gnus-inews-article-hook elem)
-
-	  (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook)
-					    gnus-inews-article-hook
-					  (list gnus-inews-article-hook)))
-	  (setq gnus-inews-article-hook 
-		(cons
-		 '(lambda ()
-		    (save-excursion
-		      (goto-char 1)
-		      (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t)
-			  (setq gnus-uu-post-message-id 
-				(buffer-substring 
-				 (match-beginning 1) (match-end 1)))
-			(setq gnus-uu-post-message-id nil))))
-		 gnus-inews-article-hook))
-	  (gnus-uu-post-encoded file-name t))
-      (gnus-uu-post-encoded file-name nil)))
-  (setq gnus-uu-post-inserted-file-name nil)
-  (and gnus-uu-winconf-post-news
-       (set-window-configuration gnus-uu-winconf-post-news)))
-      
-; Asks for a file to encode, encodes it and inserts the result in
-; the current buffer. Returns the file name the user gave.
-(defun gnus-uu-post-insert-binary ()
-  (let ((uuencode-buffer-name "*uuencode buffer*")
-	file-path post-buf uubuf file-name)
-
-    (setq file-path (read-file-name 
-		     "What file do you want to encode? "))
-    (if (not (file-exists-p file-path))
-	(error "%s: No such file" file-path))
-
-    (goto-char (point-max))
-    (insert (format "\n%s\n" gnus-uu-post-binary-separator))
-    
-    (if (string-match "^~/" file-path)
-	(setq file-path (concat "$HOME" (substring file-path 1))))
-    (if (string-match "/[^/]*$" file-path)
-	(setq file-name (substring file-path (1+ (match-beginning 0))))
-      (setq file-name file-path))
-
-    (unwind-protect
-	(if (save-excursion
-	      (set-buffer (setq uubuf 
-				(get-buffer-create uuencode-buffer-name)))
-	      (erase-buffer)
-	      (funcall gnus-uu-post-encode-method file-path file-name))
-	    (insert-buffer uubuf)
-	  (error "Encoding unsuccessful"))
-      (kill-buffer uubuf))
-    file-name))
-
-; Posts the article and all of the encoded file.
-(defun gnus-uu-post-encoded (file-name &optional threaded)
-  (let ((send-buffer-name "*uuencode send buffer*")
-	(encoded-buffer-name "*encoded buffer*")
-	(top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]")
-	(separator (concat mail-header-separator "\n\n"))
-	file uubuf length parts header i end beg
-	beg-line minlen buf post-buf whole-len beg-binary end-binary)
-
-    (setq post-buf (current-buffer))
-
-    (goto-char 1)
-    (if (not (re-search-forward 
-	      (if gnus-uu-post-separate-description 
-		  gnus-uu-post-binary-separator 
-		mail-header-separator) nil t))
-	(error "Internal error: No binary/header separator"))
-    (beginning-of-line)
-    (forward-line 1)
-    (setq beg-binary (point))
-    (setq end-binary (point-max))
-
-    (save-excursion 
-      (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name)))
-      (erase-buffer)
-      (insert-buffer-substring post-buf beg-binary end-binary)
-      (goto-char 1)
-      (setq length (count-lines 1 (point-max)))
-      (setq parts (/ length gnus-uu-post-length))
-      (if (not (< (% length gnus-uu-post-length) 4))
-	  (setq parts (1+ parts))))
-
-    (if gnus-uu-post-separate-description
-	(forward-line -1))
-    (kill-region (point) (point-max))
-
-    (goto-char 1)
-    (search-forward mail-header-separator nil t)
-    (beginning-of-line)
-    (setq header (buffer-substring 1 (point)))
-
-    (goto-char 1)
-    (if (not gnus-uu-post-separate-description)
-	()
-      (if (and (not threaded) (re-search-forward "^Subject: " nil t))
-	  (progn
-	    (end-of-line)
-	    (insert (format " (0/%d)" parts))))
-      (gnus-inews-news))
-
-    (save-excursion
-      (setq i 1)
-      (setq beg 1)
-      (while (not (> i parts))
-	(set-buffer (get-buffer-create send-buffer-name))
-	(erase-buffer)
-	(insert header)
-	(if (and threaded gnus-uu-post-message-id)
-	    (insert (format "References: %s\n" gnus-uu-post-message-id)))
-	(insert separator)
-	(setq whole-len
-	      (- 62 (length (format top-string "" file-name i parts ""))))
-	(if (> 1 (setq minlen (/ whole-len 2)))
-	    (setq minlen 1))
-	(setq 
-	 beg-line 
-	 (format top-string
-		 (make-string minlen ?-) 
-		 file-name i parts
-		 (make-string 
-		  (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
-
-	(goto-char 1)
-	(if (not (re-search-forward "^Subject: " nil t))
-	    ()
-	  (if (not threaded)
-	      (progn
-		(end-of-line)
-		(insert (format " (%d/%d)" i parts)))
-	    (if (or (and (= i 2) gnus-uu-post-separate-description)
-		    (and (= i 1) (not gnus-uu-post-separate-description)))
-		(replace-match "Subject: Re: "))))
-		  
-	(goto-char (point-max))
-	(save-excursion
-	  (set-buffer uubuf)
-	  (goto-char beg)
-	  (if (= i parts)
-	      (goto-char (point-max))
-	    (forward-line gnus-uu-post-length))
-	  (if (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4))
-	      (forward-line -4))
-	  (setq end (point)))
-	(insert-buffer-substring uubuf beg end)
-	(insert beg-line)
-	(insert "\n")
-	(setq beg end)
-	(setq i (1+ i))
-	(goto-char 1)
-	(re-search-forward mail-header-separator nil t)
-	(beginning-of-line)
-	(forward-line 2)
-	(if (re-search-forward gnus-uu-post-binary-separator nil t)
-	    (progn 
-	      (replace-match "")
-	      (forward-line 1)))
-	(insert beg-line)
-	(insert "\n")
-	(gnus-inews-news)))
-
-    (and (setq buf (get-buffer send-buffer-name))
-	 (kill-buffer buf))
-    (and (setq buf (get-buffer encoded-buffer-name))
-	 (kill-buffer buf))
-
-    (if (not gnus-uu-post-separate-description)
-	(progn
-	  (set-buffer-modified-p nil)
-	  (and (fboundp 'bury-buffer) (bury-buffer))))))
-
-(provide 'gnus-uu)
-
-;; gnus-uu.el ends here
diff --git a/lisp/=gnus.el b/lisp/=gnus.el
deleted file mode 100644
index 0a410e367d7..00000000000
--- a/lisp/=gnus.el
+++ /dev/null
@@ -1,7243 +0,0 @@
-;;; gnus.el --- NNTP-based News Reader for GNU Emacs
-;; Copyright (C) 1987,88,89,90,93,94,95 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Keywords: news
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; How to Install GNUS:
-;; (0) First of all, remove GNUS related OLD *.elc files (at least
-;;     nntp.elc).
-;; (1) Unshar gnus.el, gnuspost.el, gnusmail.el, gnusmisc.el, and
-;;     nntp.el.
-;; (2) byte-compile-file nntp.el, gnus.el, gnuspost.el, gnusmail.el,
-;;     and gnusmisc.el.  If you have a local news spool,
-;;     byte-compile-file nnspool.el, too.
-;; (3) Define three environment variables in .login file as follows:
-;;
-;;     setenv	NNTPSERVER	flab
-;;     setenv	DOMAINNAME	"stars.flab.Fujitsu.CO.JP"
-;;     setenv	ORGANIZATION	"Fujitsu Laboratories Ltd., Kawasaki, Japan."
-;;
-;;     Or instead, define lisp variables in your .emacs, site-init.el,
-;;     or default.el as follows:
-;;
-;;     (setq gnus-nntp-server "flab")
-;;     (setq gnus-local-domain "stars.flab.Fujitsu.CO.JP")
-;;     (setq gnus-local-organization "Fujitsu Laboratories Ltd., ...")
-;;
-;;     If the function (system-name) returns the full internet name,
-;;     you don't have to define the domain.
-;;
-;; (4) You may have to define NNTP service name as number 119.
-;;
-;;     (setq gnus-nntp-service 119)
-;;
-;;     Or, if you'd like to use a local news spool directly in stead
-;;     of NNTP, set the variable to nil as follows:
-;;
-;;     (setq gnus-nntp-service nil)
-;;
-;; (5) If you'd like to use the GENERICFROM feature like the Bnews,
-;;     define the variable as follows:
-;;
-;;     (setq gnus-use-generic-from t)
-;;
-;; (6) Define autoload entries in .emacs file as follows:
-;;
-;;     (autoload 'gnus "gnus" "Read network news." t)
-;;     (autoload 'gnus-post-news "gnuspost" "Post a news." t)
-;;
-;; (7) Read nntp.el if you have problems with NNTP or kanji handling.
-;;
-;; (8) Install mhspool.el, tcp.el, and tcp.c if it is necessary.
-;;
-;;     mhspool.el is a package for reading articles or mail in your
-;;     private directory using GNUS.
-;;
-;;     tcp.el and tcp.c are necessary if and only if your Emacs does
-;;     not have the function `open-network-stream' which is used for
-;;     communicating with NNTP server inside Emacs.
-;;
-;; (9) Install an Info file generated from the texinfo manual gnus.texinfo.
-;;
-;;     If you are not allowed to create the Info file to the standard
-;;     Info-directory, create it in your private directory and set the
-;;     variable gnus-info-directory to that directory.
-;;
-;; For getting more information about GNUS, consult USENET newsgorup
-;; gnu.emacs.gnus.
-
-;; TO DO:
-;; (1) Incremental update of active info.
-;; (2) Asynchronous transmission of large messages.
-
-;;; Code:
-
-(require 'nntp)
-(require 'mail-utils)
-(require 'timezone)
-
-(defvar gnus-default-nntp-server nil
-  "*Specify default NNTP server.
-This variable should be defined in `site-init.el'.")
-
-(defvar gnus-nntp-server (or (getenv "NNTPSERVER") gnus-default-nntp-server)
-  "*The name of the host running NNTP server.
-If it is a string starting with a colon, as in as `:DIRECTORY', then the
-directory ~/DIRECTORY is used as the news spool.
-This variable is initialized from the NNTPSERVER environment variable
-or from `gnus-default-nntp-server'.")
-
-(defvar gnus-nntp-service "nntp"
-  "*NNTP service name (\"nntp\" or 119).
-Go to a local news spool if its value is nil.")
-
-(defvar gnus-startup-file "~/.newsrc"
-  "*Your `.newsrc' file.  Use `.newsrc-SERVER' instead if exists.")
-
-(defvar gnus-signature-file "~/.signature"
-  "*Your `.signature' file.  Use `.signature-DISTRIBUTION' instead if exists.")
-
-(defvar gnus-use-cross-reference t
-  "*Specifies what to do with cross references (Xref: field).
-If nil, ignore cross references.  If t, mark articles as read in
-subscribed newsgroups.  Otherwise, if not nil nor t, mark articles as
-read in all newsgroups.")
-
-(defvar gnus-use-followup-to t
-  "*Specifies what to do with Followup-To: field.
-If nil, ignore `Followup-to:' field.  If t, use its value except for
-`poster'.  Otherwise, if not nil nor t, always use its value.")
-
-(defvar gnus-large-newsgroup 50
-  "*The number of articles which indicates a large newsgroup.
-If the number of articles in a newsgroup is greater than the value,
-confirmation is required for selecting the newsgroup.")
-
-(defvar gnus-author-copy (getenv "AUTHORCOPY")
-  "*File name saving a copy of an article posted using FCC: field.
-Initialized from the AUTHORCOPY environment variable.
-
-Articles are saved using a function specified by the the variable
-`gnus-author-copy-saver' (`rmail-output' is default) if a file name is
-given.  Instead, if the first character of the name is `|', the
-contents of the article is piped out to the named program.  It is
-possible to save an article in an MH folder as follows:
-
-\(setq gnus-author-copy \"|/usr/local/lib/mh/rcvstore +Article\")")
-
-(defvar gnus-author-copy-saver (function rmail-output)
-  "*A function called with a file name to save an author copy to.
-The default function is `rmail-output' which saves in  inbox format.")
-
-(defvar gnus-use-long-file-name
-  (not (memq system-type '(usg-unix-v xenix)))
-  "*Non-nil means that a newsgroup name is used as a default file name
-to save articles to.  If it's nil, the directory form of a newsgroup is
-used instead.")
-
-(defvar gnus-article-save-directory (getenv "SAVEDIR")
-  "*A directory name to save articles to (default is `~/News').
-Initialized from the SAVEDIR environment variable.")
-
-(defvar gnus-kill-files-directory (getenv "SAVEDIR")
-  "*A directory name to save kill files to (default to ~/News).
-Initialized from the SAVEDIR environment variable.")
-
-(defvar gnus-default-article-saver (function gnus-summary-save-in-rmail)
-  "*A function to save articles in your favorite format.
-The function must be interactively callable (in other words, it must
-be an Emacs command).
-
-GNUS provides the following functions:
-	gnus-summary-save-in-rmail (in Rmail format)
-	gnus-summary-save-in-mail (in Unix mail format)
-	gnus-summary-save-in-folder (in an MH folder)
-	gnus-summary-save-in-file (in article format).")
-
-(defvar gnus-rmail-save-name (function gnus-plain-save-name)
-  "*A function generating a file name to save articles in Rmail format.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
-
-(defvar gnus-mail-save-name (function gnus-plain-save-name)
-  "*A function generating a file name to save articles in Unix mail format.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
-
-(defvar gnus-folder-save-name (function gnus-folder-save-name)
-  "*A function generating a file name to save articles in MH folder.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
-
-(defvar gnus-file-save-name (function gnus-numeric-save-name)
-  "*A function generating a file name to save articles in article format.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
-
-(defvar gnus-kill-file-name "KILL"
-  "*File name of a KILL file.")
-
-(defvar gnus-novice-user t
-  "*Non-nil means that you are a novice to USENET.
-If non-nil, verbose messages may be displayed
-or your confirmations may be required.")
-
-(defvar gnus-interactive-catchup t
-  "*Require your confirmation when catching up a newsgroup if non-nil.")
-
-(defvar gnus-interactive-post t
-  "*Newsgroup, subject, and distribution will be asked for if non-nil.")
-
-(defvar gnus-interactive-exit t
-  "*Require your confirmation when exiting GNUS if non-nil.")
-
-(defvar gnus-user-login-name nil
-  "*The login name of the user.
-Got from the function `user-login-name' if undefined.")
-
-(defvar gnus-user-full-name nil
-  "*The full name of the user.
-Got from the NAME environment variable if undefined.")
-
-(defvar gnus-show-mime nil
-  "*Show MIME message if non-nil.")
-
-(defvar gnus-show-threads t
-  "*Show conversation threads in Summary Mode if non-nil.")
-
-(defvar gnus-thread-hide-subject t
-  "*Non-nil means hide subjects for thread subtrees.")
-
-(defvar gnus-thread-hide-subtree nil
-  "*Non-nil means hide thread subtrees initially.
-If non-nil, you have to run the command `gnus-summary-show-thread' by
-hand or by using `gnus-select-article-hook' to show hidden threads.")
-
-(defvar gnus-thread-hide-killed t
-  "*Non-nil means hide killed thread subtrees automatically.")
-
-(defvar gnus-thread-ignore-subject nil
-  "*Don't take care of subject differences, but only references if non-nil.
-If it is non-nil, some commands work with subjects do not work properly.")
-
-(defvar gnus-thread-indent-level 4
-  "*Indentation of thread subtrees.")
-
-(defvar gnus-ignored-newsgroups "^to\\..*$"
-  "*A regexp to match uninteresting newsgroups in the active file.
-Any lines in the active file matching this regular expression are
-removed from the newsgroup list before anything else is done to it,
-thus making them effectively invisible.")
-
-(defvar gnus-ignored-headers
-  "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:"
-  "*Header fields not worth displaying.
-Ordinarily GNUS excludes these when displaying an article.
-If you want to see them, ask to see the message with \"the full header\"
-\(also known as \"the original header\").")
-
-(defvar gnus-required-headers
-  '(From Date Newsgroups Subject Message-ID Path Organization Distribution)
-  "*All required fields for articles you post.
-RFC977 and RFC1036 require From, Date, Newsgroups, Subject, Message-ID
-and Path fields.  Organization, Distribution and Lines are optional.
-If you want GNUS not to insert some field, remove it from this list.")
-
-(defvar gnus-show-all-headers nil
-  "*Show all headers of an article if non-nil.")
-
-(defvar gnus-save-all-headers t
-  "*Save all headers of an article if non-nil.")
-
-(defvar gnus-optional-headers (function gnus-optional-lines-and-from)
-  "*A function generating a optional string displayed in GNUS Summary
-mode buffer.  The function is called with an article HEADER.  The
-result must be a string excluding `[' and `]'.")
-
-(defvar gnus-auto-extend-newsgroup t
-  "*Extend visible articles to forward and backward if non-nil.")
-
-(defvar gnus-auto-select-first t
-  "*Select the first unread article automagically if non-nil.
-If you want to prevent automatic selection of the first unread article
-in some newsgroups, set the variable to nil in `gnus-select-group-hook'
-or `gnus-apply-kill-hook'.")
-
-(defvar gnus-auto-select-next t
-  "*Select the next newsgroup automagically if non-nil.
-If the value is t and the next newsgroup is empty, GNUS will exit
-Summary mode and go back to Group mode.  If the value is neither nil
-nor t, GNUS will select the following unread newsgroup.  Especially, if
-the value is the symbol `quietly', the next unread newsgroup will be
-selected without any confirmations.")
-
-(defvar gnus-auto-select-same nil
-  "*Select the next article with the same subject automagically if non-nil.")
-
-(defvar gnus-auto-center-summary t
-  "*Always center the current summary in GNUS Summary window if non-nil.")
-
-(defvar gnus-auto-mail-to-author nil
-  "*Insert `To: author' of the article when following up if non-nil.
-Mail is sent using the function specified by the variable
-`gnus-mail-send-method'.")
-
-(defvar gnus-break-pages t
-  "*Break an article into pages if non-nil.
-Page delimiter is specified by the variable `gnus-page-delimiter'.")
-
-(defvar gnus-page-delimiter "^\^L"
-  "*Regexp describing line-beginnings that separate pages of news article.")
-
-(defvar gnus-digest-show-summary t
-  "*Show a summary of undigestified messages if non-nil.")
-
-(defvar gnus-digest-separator "^Subject:[ \t]"
-  "*Regexp that separates messages in a digest article.")
-
-(defvar gnus-use-full-window t
-  "*Non-nil means to take up the entire screen of Emacs.")
-
-(defvar gnus-window-configuration
-  '((summary (0 1 0))
-    (newsgroups   (1 0 0))
-    (article   (0 3 10)))
-  "*Specify window configurations for each action.
-The format of the variable is a list of (ACTION (G S A)), where G, S,
-and A are the relative height of Group, Summary, and Article windows,
-respectively.  ACTION is `summary', `newsgroups', or `article'.")
-
-(defvar gnus-show-mime-method (function metamail-buffer)
-  "*Function to process a MIME message.
-The function is expected to process current buffer as a MIME message.")
-
-(defvar gnus-mail-reply-method
-  (function gnus-mail-reply-using-mail)
-  "*Function to compose reply mail.
-The function `gnus-mail-reply-using-mail' uses usual sendmail mail
-program.  The function `gnus-mail-reply-using-mhe' uses the MH-E mail
-program.  You can use yet another program by customizing this variable.")
-
-(defvar gnus-mail-forward-method
-  (function gnus-mail-forward-using-mail)
-  "*Function to forward current message to another user.
-The function `gnus-mail-reply-using-mail' uses usual sendmail mail
-program.  You can use yet another program by customizing this variable.")
-
-(defvar gnus-mail-other-window-method
-  (function gnus-mail-other-window-using-mail)
-  "*Function to compose mail in other window.
-The function `gnus-mail-other-window-using-mail' uses the usual sendmail
-mail program.  The function `gnus-mail-other-window-using-mhe' uses the MH-E
-mail program.  You can use yet another program by customizing this variable.")
-
-(defvar gnus-mail-send-method send-mail-function
-  "*Function to mail a message too which is being posted as an article.
-The message must have To: or Cc: field.  The default is copied from
-the variable `send-mail-function'.")
-
-(defvar gnus-subscribe-newsgroup-method
-  (function gnus-subscribe-alphabetically)
-  "*Function called with a newsgroup name when new newsgroup is found.
-The function `gnus-subscribe-randomly' inserts a new newsgroup a the
-beginning of newsgroups.  The function `gnus-subscribe-alphabetically'
-inserts it in strict alphabetic order.  The function
-`gnus-subscribe-hierarchically' inserts it in hierarchical newsgroup
-order.  The function `gnus-subscribe-interactively' asks for your decision.")
-
-(defvar gnus-group-mode-hook nil
-  "*A hook for GNUS Group Mode.")
-
-(defvar gnus-summary-mode-hook nil
-  "*A hook for GNUS Summary Mode.")
-
-(defvar gnus-article-mode-hook nil
-  "*A hook for GNUS Article Mode.")
-
-(defvar gnus-kill-file-mode-hook nil
-  "*A hook for GNUS KILL File Mode.")
-
-(defvar gnus-open-server-hook nil
-  "*A hook called just before opening connection to news server.")
-
-(defvar gnus-startup-hook nil
-  "*A hook called at start up time.
-This hook is called after GNUS is connected to the NNTP server.  So, it
-is possible to change the behavior of GNUS according to the selected
-NNTP server.")
-
-(defvar gnus-group-prepare-hook nil
-  "*A hook called after newsgroup list is created in the Newsgroup buffer.
-If you want to modify the Newsgroup buffer, you can use this hook.")
-
-(defvar gnus-summary-prepare-hook nil
-  "*A hook called after summary list is created in the Summary buffer.
-If you want to modify the Summary buffer, you can use this hook.")
-
-(defvar gnus-article-prepare-hook nil
-  "*A hook called after an article is prepared in the Article buffer.
-If you want to run a special decoding program like nkf, use this hook.")
-
-(defvar gnus-select-group-hook nil
-  "*A hook called when a newsgroup is selected.
-If you want to sort Summary buffer by date and then by subject, you
-can use the following hook:
-
-\(add-hook 'gnus-select-group-hook
-       (function
-	(lambda ()
-	  ;; First of all, sort by date.
-	  (gnus-keysort-headers
-	   (function string-lessp)
-	   (function
-	    (lambda (a)
-	      (gnus-sortable-date (gnus-header-date a)))))
-	  ;; Then sort by subject string ignoring `Re:'.
-	  ;; If case-fold-search is non-nil, case of letters is ignored.
-	  (gnus-keysort-headers
-	   (function string-lessp)
-	   (function
-	    (lambda (a)
-	      (if case-fold-search
-		  (downcase (gnus-simplify-subject (gnus-header-subject a) t))
-		(gnus-simplify-subject (gnus-header-subject a) t)))))
-	  )))
-
-If you'd like to simplify subjects like the
-`gnus-summary-next-same-subject' command does, you can use the
-following hook:
-
-\(add-hook 'gnus-select-group-hook
-       (function
-	(lambda ()
-	  (mapcar (function
-		   (lambda (header)
-		     (nntp-set-header-subject
-		      header
-		      (gnus-simplify-subject
-		       (gnus-header-subject header) 're-only))))
-		  gnus-newsgroup-headers))))
-
-In some newsgroups author name is meaningless.  It is possible to
-prevent listing author names in GNUS Summary buffer as follows:
-
-\(add-hook 'gnus-select-group-hook
-       (function
-	(lambda ()
-	  (cond ((string-equal \"comp.sources.unix\" gnus-newsgroup-name)
-		 (setq gnus-optional-headers
-		       (function gnus-optional-lines)))
-		(t
-		 (setq gnus-optional-headers
-		       (function gnus-optional-lines-and-from)))))))")
-
-(defvar gnus-select-article-hook
-  '(gnus-summary-show-thread)
-  "*A hook called when an article is selected.
-The default hook shows conversation thread subtrees of the selected
-article automatically using `gnus-summary-show-thread'.
-
-If you'd like to run Rmail on a digest article automagically, you can
-use the following hook:
-
-\(add-hook 'gnus-select-article-hook
-       (function
-	(lambda ()
-	  (cond ((string-equal \"comp.sys.sun\" gnus-newsgroup-name)
-		 (gnus-summary-rmail-digest))
-		((and (string-equal \"comp.text\" gnus-newsgroup-name)
-		      (string-match \"^TeXhax Digest\"
-				    (gnus-header-subject gnus-current-headers)))
-		 (gnus-summary-rmail-digest)
-		 ))))
-       t)")
-
-(defvar gnus-select-digest-hook
-  (list
-   (function
-    (lambda ()
-      ;; Reply-To: is required by `undigestify-rmail-message'.
-      (or (mail-position-on-field "Reply-to" t)
-	  (progn
-	    (mail-position-on-field "Reply-to")
-	    (insert (gnus-fetch-field "From")))))))
-  "*A hook called when reading digest messages using Rmail.
-This hook can be used to modify incomplete digest articles as follows
-\(this is the default):
-
-\(add-hook 'gnus-select-digest-hook
-       (function
-	(lambda ()
-	  ;; Reply-To: is required by `undigestify-rmail-message'.
-	  (or (mail-position-on-field \"Reply-to\" t)
-	      (progn
-		(mail-position-on-field \"Reply-to\")
-		(insert (gnus-fetch-field \"From\")))))))")
-
-(defvar gnus-rmail-digest-hook nil
-  "*A hook called when reading digest messages using Rmail.
-This hook is intended to customize Rmail mode for reading digest articles.")
-
-(defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
-  "*A hook called when a newsgroup is selected and summary list is prepared.
-This hook is intended to apply a KILL file to the selected newsgroup.
-The function `gnus-apply-kill-file' is called by default.
-
-Since a general KILL file is too heavy to use only for a few
-newsgroups, I recommend you to use a lighter hook function.  For
-example, if you'd like to apply a KILL file to articles which contains
-a string `rmgroup' in subject in newsgroup `control', you can use the
-following hook:
-
-\(setq gnus-apply-kill-hook
-      (list
-       (function
-	(lambda ()
-	  (cond ((string-match \"control\" gnus-newsgroup-name)
-		 (gnus-kill \"Subject\" \"rmgroup\")
-		 (gnus-expunge \"X\")))))))")
-
-(defvar gnus-mark-article-hook
-  (list
-   (function
-    (lambda ()
-      (or (memq gnus-current-article gnus-newsgroup-marked)
-	  (gnus-summary-mark-as-read gnus-current-article))
-      (gnus-summary-set-current-mark "+"))))
-  "*A hook called when an article is selected at the first time.
-The hook is intended to mark an article as read (or unread)
-automatically when it is selected.
-
-If you'd like to mark as unread (-) instead, use the following hook:
-
-\(setq gnus-mark-article-hook
-      (list
-       (function
-        (lambda ()
-	  (gnus-summary-mark-as-unread gnus-current-article)
-	  (gnus-summary-set-current-mark \"+\")))))")
-
-(defvar gnus-prepare-article-hook (list (function gnus-inews-insert-signature))
-  "*A hook called after preparing body, but before preparing header fields.
-The default hook (`gnus-inews-insert-signature') inserts a signature
-file specified by the variable `gnus-signature-file'.")
-
-(defvar gnus-inews-article-hook (list (function gnus-inews-do-fcc))
-  "*A hook called before finally posting an article.
-The default hook (`gnus-inews-do-fcc') does FCC processing (save article
-to a file).")
-
-(defvar gnus-exit-group-hook nil
-  "*A hook called when exiting (not quitting) Summary mode.
-If your machine is so slow that exiting from Summary mode takes very
-long time, set the variable `gnus-use-cross-reference' to nil.  This
-inhibits marking articles as read using cross-reference information.")
-
-(defvar gnus-suspend-gnus-hook nil
-  "*A hook called when suspending (not exiting) GNUS.")
-
-(defvar gnus-exit-gnus-hook nil
-  "*A hook called when exiting (not suspending) GNUS.")
-
-(defvar gnus-save-newsrc-hook nil
-  "*A hook called when saving the newsrc file.
-This hook is called before saving the `.newsrc' file.")
-
-
-;; Site dependent variables.  You have to define these variables in
-;;  site-init.el, default.el or your .emacs.
-
-(defvar gnus-local-timezone nil
-  "*Local time zone.
-This value is used only if `current-time-zone' does not work in your Emacs.
-It specifies the GMT offset, i.e. a decimal integer
-of the form +-HHMM giving the hours and minutes ahead of (i.e. east of) GMT.
-For example, +0900 should be used in Japan, since it is 9 hours ahead of GMT.
-
-For backwards compatibility, it may also be a string like \"JST\",
-but strings are obsolescent: you should use numeric offsets instead.")
-
-(defvar gnus-local-domain nil
-  "*Local domain name without a host name like: \"stars.flab.Fujitsu.CO.JP\"
-The `DOMAINNAME' environment variable is used instead if defined.  If
-the function (system-name) returns the full internet name, there is no
-need to define the name.")
-
-(defvar gnus-local-organization nil
-  "*Local organization like: \"Fujitsu Laboratories Ltd., Kawasaki, Japan.\"
-The `ORGANIZATION' environment variable is used instead if defined.")
-
-(defvar gnus-local-distributions '("local" "world")
-  "*List of distributions.
-The first element in the list is used as default.  If distributions
-file is available, its content is also used.")
-
-(defvar gnus-use-generic-from nil
-  "*If nil, prepend local host name to the defined domain in the From:
-field; if a string, use this; if non-nil, strip off the local host name.")
-
-(defvar gnus-use-generic-path nil
-  "*If nil, use the NNTP server name in the Path: field; if stringp,
-use this; if non-nil, use no host name (user name only)")
-
-(defvar gnus-newsgroups-regex "^\\([^ \t\n]+\\)[ \t]+\\(.*\\)$"
-  "Regex to retrieve the group name and the group description from
-the output of the newsgroups listing.
-
-If you have ^M at the end of lines try \"^\\([^ \t\n]+\\)[ \t]+\\([^\r]+\\)[\r]*$\"")
-
-(defvar gnus-newsgroups-display t
-  "*display the newsgroup description in *Newsgroup* buffer if not nil")
-
-(defvar gnus-newsgroups-alist nil
-  "alist (groupname . description)")
-
-(defvar gnus-newsgroups-hashtb nil
-  "hashtable of gnus-newsgroups-alist")
-
-(defvar gnus-newsgroups-showall nil
-  "non nil if we display all the groups")
-
-
-;; Internal variables.
-
-(defconst gnus-version "GNUS 4.1"
-  "Version numbers of this version of GNUS.")
-
-(defconst gnus-emacs-version
-  (progn
-    (string-match "[0-9]*" emacs-version)
-    (string-to-int (substring emacs-version
-			      (match-beginning 0) (match-end 0))))
-  "Major version number of this emacs.")
-
-(defvar gnus-info-nodes
-  '((gnus-group-mode		"(gnus)Newsgroup Commands")
-    (gnus-summary-mode		"(gnus)Summary Commands")
-    (gnus-article-mode		"(gnus)Article Commands")
-    (gnus-kill-file-mode	"(gnus)Kill File")
-    (gnus-browse-killed-mode	"(gnus)Maintaining Subscriptions"))
-  "Assoc list of major modes and related Info nodes.")
-
-;; Alist syntax is different from that of 3.14.3.
-(defvar gnus-access-methods
-  '((nntp
-     (gnus-retrieve-headers		nntp-retrieve-headers)
-     (gnus-open-server			nntp-open-server)
-     (gnus-close-server			nntp-close-server)
-     (gnus-server-opened		nntp-server-opened)
-     (gnus-status-message		nntp-status-message)
-     (gnus-request-article		nntp-request-article)
-     (gnus-request-group		nntp-request-group)
-     (gnus-request-list			nntp-request-list)
-     (gnus-request-list-newsgroups	nntp-request-list-newsgroups)
-     (gnus-request-list-distributions	nntp-request-list-distributions)
-     (gnus-request-post			nntp-request-post))
-    (nnspool
-     (gnus-retrieve-headers		nnspool-retrieve-headers)
-     (gnus-open-server			nnspool-open-server)
-     (gnus-close-server			nnspool-close-server)
-     (gnus-server-opened		nnspool-server-opened)
-     (gnus-status-message		nnspool-status-message)
-     (gnus-request-article		nnspool-request-article)
-     (gnus-request-group		nnspool-request-group)
-     (gnus-request-list			nnspool-request-list)
-     (gnus-request-list-newsgroups	nnspool-request-list-newsgroups)
-     (gnus-request-list-distributions	nnspool-request-list-distributions)
-     (gnus-request-post			nnspool-request-post))
-    (mhspool
-     (gnus-retrieve-headers		mhspool-retrieve-headers)
-     (gnus-open-server			mhspool-open-server)
-     (gnus-close-server			mhspool-close-server)
-     (gnus-server-opened		mhspool-server-opened)
-     (gnus-status-message		mhspool-status-message)
-     (gnus-request-article		mhspool-request-article)
-     (gnus-request-group		mhspool-request-group)
-     (gnus-request-list			mhspool-request-list)
-     (gnus-request-list-newsgroups	mhspool-request-list-newsgroups)
-     (gnus-request-list-distributions	mhspool-request-list-distributions)
-     (gnus-request-post			mhspool-request-post)))
-  "Access method for NNTP, nnspool, and mhspool.")
-
-(defvar gnus-group-buffer "*Newsgroup*")
-(defvar gnus-summary-buffer "*Summary*")
-(defvar gnus-article-buffer "*Article*")
-(defvar gnus-digest-buffer "GNUS Digest")
-(defvar gnus-digest-summary-buffer "GNUS Digest-summary")
-
-(defvar gnus-buffer-list
-  (list gnus-group-buffer gnus-summary-buffer gnus-article-buffer
-	gnus-digest-buffer gnus-digest-summary-buffer)
-  "GNUS buffer names which should be killed when exiting.")
-
-(defvar gnus-variable-list
-  '(gnus-newsrc-options
-    gnus-newsrc-options-n-yes gnus-newsrc-options-n-no
-    gnus-newsrc-assoc gnus-killed-assoc gnus-marked-assoc)
-  "GNUS variables saved in the quick startup file.")
-
-(defvar gnus-overload-functions
-  '((news-inews gnus-inews-news "rnewspost")
-    (caesar-region gnus-caesar-region "rnews"))
-  "Functions overloaded by gnus.
-It is a list of `(original overload &optional file)'.")
-
-(defvar gnus-distribution-list nil)
-
-(defvar gnus-newsrc-options nil
-  "Options line in the `.newsrc' file.")
-
-(defvar gnus-newsrc-options-n-yes nil
-  "Regexp representing subscribed newsgroups.")
-
-(defvar gnus-newsrc-options-n-no nil
-  "Regexp representing unsubscribed newsgroups.")
-
-(defvar gnus-newsrc-assoc nil
-  "Assoc list of read articles.
-`gnus-newsrc-hashtb' should be kept so that both hold the same information.")
-
-(defvar gnus-newsrc-hashtb nil
-  "Hashtable of `gnus-newsrc-assoc'.")
-
-(defvar gnus-killed-assoc nil
-  "Assoc list of newsgroups removed from `gnus-newsrc-assoc'.
-`gnus-killed-hashtb' should be kept so that both hold the same information.")
-
-(defvar gnus-killed-hashtb nil
-  "Hashtable of `gnus-killed-assoc'.")
-
-(defvar gnus-marked-assoc nil
-  "Assoc list of articles marked as unread.
-`gnus-marked-hashtb' should be kept so that both hold the same information.")
-
-(defvar gnus-marked-hashtb nil
-  "Hashtable of `gnus-marked-assoc'.")
-
-(defvar gnus-unread-hashtb nil
-  "Hashtable of unread articles.")
-
-(defvar gnus-active-hashtb nil
-  "Hashtable of active articles.")
-
-(defvar gnus-octive-hashtb nil
-  "Hashtable of OLD active articles.")
-
-(defvar gnus-current-startup-file nil
-  "Startup file for the current host.")
-
-(defvar gnus-last-search-regexp nil
-  "Default regexp for article search command.")
-
-(defvar gnus-last-shell-command nil
-  "Default shell command on article.")
-
-(defvar gnus-have-all-newsgroups nil)
-
-(defvar gnus-newsgroup-name nil)
-(defvar gnus-newsgroup-begin nil)
-(defvar gnus-newsgroup-end nil)
-(defvar gnus-newsgroup-last-rmail nil)
-(defvar gnus-newsgroup-last-mail nil)
-(defvar gnus-newsgroup-last-folder nil)
-(defvar gnus-newsgroup-last-file nil)
-
-(defvar gnus-newsgroup-unreads nil
-  "List of unread articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-unselected nil
-  "List of unselected unread articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-marked nil
-  "List of marked articles in the current newsgroup (a subset of unread art).")
-
-(defvar gnus-newsgroup-headers nil
-  "List of article headers in the current newsgroup.
-If you modify the variable, you must call the function
-`gnus-clear-hashtables-for-newsgroup-headers' to clear the hash tables.")
-(defvar gnus-newsgroup-headers-hashtb-by-id nil)
-(defvar gnus-newsgroup-headers-hashtb-by-number nil)
-
-(defvar gnus-current-article nil)
-(defvar gnus-current-headers nil)
-(defvar gnus-current-history nil)
-(defvar gnus-have-all-headers nil "Must be either T or NIL.")
-(defvar gnus-last-article nil)
-(defvar gnus-current-kill-article nil)
-
-;; Save window configuration.
-(defvar gnus-winconf-kill-file nil)
-
-(defvar gnus-group-mode-map nil)
-(defvar gnus-summary-mode-map nil)
-(defvar gnus-article-mode-map nil)
-(defvar gnus-kill-file-mode-map nil)
-
-(defvar rmail-default-file (expand-file-name "~/XMBOX"))
-(defvar rmail-default-rmail-file (expand-file-name "~/XNEWS"))
-
-;; Define GNUS Subsystems.
-(autoload 'gnus-group-post-news "gnuspost"
-	  "Post an article." t)
-(autoload 'gnus-summary-post-news "gnuspost"
-	  "Post an article." t)
-(autoload 'gnus-summary-followup "gnuspost"
-	  "Post a reply article." t)
-(autoload 'gnus-summary-followup-with-original "gnuspost"
-	  "Post a reply article with original article." t)
-(autoload 'gnus-summary-cancel-article "gnuspost"
-	  "Cancel an article you posted." t)
-
-(autoload 'gnus-summary-reply "gnusmail"
-	  "Reply mail to news author." t)
-(autoload 'gnus-summary-reply-with-original "gnusmail"
-	  "Reply mail to news author with original article." t)
-(autoload 'gnus-summary-mail-forward "gnusmail"
-	  "Forward the current message to another user." t)
-(autoload 'gnus-summary-mail-other-window "gnusmail"
-	  "Compose mail in other window." t)
-
-(autoload 'gnus-group-kill-group "gnusmisc"
-	  "Kill newsgroup on current line." t)
-(autoload 'gnus-group-yank-group "gnusmisc"
-	  "Yank the last killed newsgroup on current line." t)
-(autoload 'gnus-group-kill-region "gnusmisc"
-	  "Kill newsgroups in current region." t)
-(autoload 'gnus-group-transpose-groups "gnusmisc"
-	  "Exchange current newsgroup and previous newsgroup." t)
-(autoload 'gnus-list-killed-groups "gnusmisc"
-	  "List the killed newsgroups." t)
-(autoload 'gnus-gmt-to-local "gnusmisc"
-	  "Rewrite Date field in GMT to local in current buffer.")
-
-(autoload 'metamail-buffer "metamail"
-	  "Process current buffer through `metamail'." t)
-
-(autoload 'rmail-output "rmailout"
-	  "Append this message to Unix mail file named FILE-NAME." t)
-(autoload 'mail-position-on-field "sendmail")
-(autoload 'mh-find-path "mh-e")
-(autoload 'mh-prompt-for-folder "mh-e")
-
-(put 'gnus-group-mode 'mode-class 'special)
-(put 'gnus-summary-mode 'mode-class 'special)
-(put 'gnus-article-mode 'mode-class 'special)
-
-(autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap)
-(autoload 'gnus-uu-mark-article "gnus-uu" nil t)
-
-;;(put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
-
-(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
-  "Pop to BUFFER, evaluate FORMS, and then returns to original window."
-  (` (let ((GNUSStartBufferWindow (selected-window)))
-       (unwind-protect
-	   (progn
-	     (pop-to-buffer (, buffer))
-	     (,@ forms))
-	 (select-window GNUSStartBufferWindow)))))
-
-(defmacro gnus-make-hashtable (&optional hashsize)
-  "Make a hash table (default and minimum size is 200).
-Optional argument HASHSIZE specifies the table size."
-  (` (make-vector (, (if hashsize (` (max (, hashsize) 200)) 200)) 0)))
-
-(defmacro gnus-gethash (string hashtable)
-  "Get hash value of STRING in HASHTABLE."
-  ;;(` (symbol-value (abbrev-symbol (, string) (, hashtable))))
-  ;;(` (abbrev-expansion (, string) (, hashtable)))
-  (` (symbol-value (intern-soft (, string) (, hashtable)))))
-
-(defmacro gnus-sethash (string value hashtable)
-  "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
-  ;; We cannot use define-abbrev since it only accepts string as value.
-  (` (set (intern (, string) (, hashtable)) (, value))))
-
-;; Note: Macros defined here are also defined in nntp.el.  I don't like
-;; to put them here, but many users got troubled with the old
-;; definitions in nntp.elc.  These codes are NNTP 3.10 version.
-
-(defmacro nntp-header-number (header)
-  "Return article number in HEADER."
-  (` (aref (, header) 0)))
-
-(defmacro nntp-set-header-number (header number)
-  "Set article number of HEADER to NUMBER."
-  (` (aset (, header) 0 (, number))))
-
-(defmacro nntp-header-subject (header)
-  "Return subject string in HEADER."
-  (` (aref (, header) 1)))
-
-(defmacro nntp-set-header-subject (header subject)
-  "Set article subject of HEADER to SUBJECT."
-  (` (aset (, header) 1 (, subject))))
-
-(defmacro nntp-header-from (header)
-  "Return author string in HEADER."
-  (` (aref (, header) 2)))
-
-(defmacro nntp-set-header-from (header from)
-  "Set article author of HEADER to FROM."
-  (` (aset (, header) 2 (, from))))
-
-(defmacro nntp-header-xref (header)
-  "Return xref string in HEADER."
-  (` (aref (, header) 3)))
-
-(defmacro nntp-set-header-xref (header xref)
-  "Set article xref of HEADER to xref."
-  (` (aset (, header) 3 (, xref))))
-
-(defmacro nntp-header-lines (header)
-  "Return lines in HEADER."
-  (` (aref (, header) 4)))
-
-(defmacro nntp-set-header-lines (header lines)
-  "Set article lines of HEADER to LINES."
-  (` (aset (, header) 4 (, lines))))
-
-(defmacro nntp-header-date (header)
-  "Return date in HEADER."
-  (` (aref (, header) 5)))
-
-(defmacro nntp-set-header-date (header date)
-  "Set article date of HEADER to DATE."
-  (` (aset (, header) 5 (, date))))
-
-(defmacro nntp-header-id (header)
-  "Return Id in HEADER."
-  (` (aref (, header) 6)))
-
-(defmacro nntp-set-header-id (header id)
-  "Set article Id of HEADER to ID."
-  (` (aset (, header) 6 (, id))))
-
-(defmacro nntp-header-references (header)
-  "Return references in HEADER."
-  (` (aref (, header) 7)))
-
-(defmacro nntp-set-header-references (header ref)
-  "Set article references of HEADER to REF."
-  (` (aset (, header) 7 (, ref))))
-
-
-;;;
-;;; GNUS Group Mode
-;;;
-
-(if gnus-group-mode-map
-    nil
-  (setq gnus-group-mode-map (make-keymap))
-  (suppress-keymap gnus-group-mode-map)
-  (define-key gnus-group-mode-map " " 'gnus-group-read-group)
-  (define-key gnus-group-mode-map "=" 'gnus-group-select-group)
-  (define-key gnus-group-mode-map "j" 'gnus-group-jump-to-group)
-  (define-key gnus-group-mode-map "n" 'gnus-group-next-unread-group)
-  (define-key gnus-group-mode-map "p" 'gnus-group-prev-unread-group)
-  (define-key gnus-group-mode-map "\177" 'gnus-group-prev-unread-group)
-  (define-key gnus-group-mode-map "N" 'gnus-group-next-group)
-  (define-key gnus-group-mode-map "P" 'gnus-group-prev-group)
-  (define-key gnus-group-mode-map "\C-n" 'gnus-group-next-group)
-  (define-key gnus-group-mode-map "\C-p" 'gnus-group-prev-group)
-  (define-key gnus-group-mode-map [down] 'gnus-group-next-group)
-  (define-key gnus-group-mode-map [up] 'gnus-group-prev-group)
-  (define-key gnus-group-mode-map "\r" 'next-line)
-  ;;(define-key gnus-group-mode-map "/" 'isearch-forward)
-  (define-key gnus-group-mode-map "<" 'beginning-of-buffer)
-  (define-key gnus-group-mode-map ">" 'end-of-buffer)
-  (define-key gnus-group-mode-map "u" 'gnus-group-unsubscribe-current-group)
-  (define-key gnus-group-mode-map "U" 'gnus-group-unsubscribe-group)
-  (define-key gnus-group-mode-map "c" 'gnus-group-catchup)
-  (define-key gnus-group-mode-map "C" 'gnus-group-catchup-all)
-  (define-key gnus-group-mode-map "l" 'gnus-group-list-groups)
-  (define-key gnus-group-mode-map "L" 'gnus-group-list-all-groups)
-  (define-key gnus-group-mode-map "g" 'gnus-group-get-new-news)
-  (define-key gnus-group-mode-map "R" 'gnus-group-restart)
-  (define-key gnus-group-mode-map "b" 'gnus-group-check-bogus-groups)
-  (define-key gnus-group-mode-map "r" 'gnus-group-restrict-groups)
-  (define-key gnus-group-mode-map "a" 'gnus-group-post-news)
-  (define-key gnus-group-mode-map "\ek" 'gnus-group-edit-local-kill)
-  (define-key gnus-group-mode-map "\eK" 'gnus-group-edit-global-kill)
-  (define-key gnus-group-mode-map "\C-k" 'gnus-group-kill-group)
-  (define-key gnus-group-mode-map "\C-y" 'gnus-group-yank-group)
-  (define-key gnus-group-mode-map "\C-w" 'gnus-group-kill-region)
-  (define-key gnus-group-mode-map "\C-x\C-t" 'gnus-group-transpose-groups)
-  (define-key gnus-group-mode-map "\C-c\C-l" 'gnus-list-killed-groups)
-  (define-key gnus-group-mode-map "V" 'gnus-version)
-  ;;(define-key gnus-group-mode-map "x" 'gnus-group-force-update)
-  (define-key gnus-group-mode-map "s" 'gnus-group-force-update)
-  (define-key gnus-group-mode-map "z" 'gnus-group-suspend)
-  (define-key gnus-group-mode-map "q" 'gnus-group-exit)
-  (define-key gnus-group-mode-map "Q" 'gnus-group-quit)
-  (define-key gnus-group-mode-map "?" 'gnus-group-describe-briefly)
-  (define-key gnus-group-mode-map "\C-c\C-i" 'gnus-info-find-node)
-  (define-key gnus-group-mode-map   [mouse-2] 'gnus-mouse-pick-group)
-  (define-key gnus-group-mode-map "t" 'gnus-newsgroups-display-toggle)
-
-  ;; Make a menu bar item.
-  (define-key gnus-group-mode-map [menu-bar GNUS]
-	(cons "GNUS" (make-sparse-keymap "GNUS")))
-
-  (define-key gnus-group-mode-map [menu-bar GNUS force-update]
-	'("Force Update" . gnus-group-force-update))
-  (define-key gnus-group-mode-map [menu-bar GNUS quit]
-	'("Quit" . gnus-group-quit))
-  (define-key gnus-group-mode-map [menu-bar GNUS exit]
-	'("Exit" . gnus-group-exit))
-  (define-key gnus-group-mode-map [menu-bar GNUS restart]
-	'("Restart" . gnus-group-restart))
-  (define-key gnus-group-mode-map [menu-bar GNUS suspend]
-	'("Suspend" . gnus-group-suspend))
-  (define-key gnus-group-mode-map [menu-bar GNUS get-new-news]
-	'("Get New News" . gnus-group-get-new-news))
-
-  ;; Make a menu bar item.
-  (define-key gnus-group-mode-map [menu-bar groups]
-	(cons "Groups" (make-sparse-keymap "Groups")))
-
-  (define-key gnus-group-mode-map [menu-bar groups catchup]
-	'("Catchup" . gnus-group-catchup))
-  (define-key gnus-group-mode-map [menu-bar groups edit-global-kill]
-	'("Edit Kill File" . gnus-group-edit-global-kill))
-
-  (define-key gnus-group-mode-map [menu-bar groups separator-2]
-	'("--"))
-
-  (define-key gnus-group-mode-map [menu-bar groups yank-group]
-	'("Yank Group" . gnus-group-yank-group))
-  (define-key gnus-group-mode-map [menu-bar groups kill-group]
-	'("Kill Group" . gnus-group-kill-group))
-
-  (define-key gnus-group-mode-map [menu-bar groups separator-1]
-	'("--"))
-
-  (define-key gnus-group-mode-map [menu-bar groups newsgroups-update-description]
-        '("Update descriptions" . gnus-newsgroups-update-description))
-  (define-key gnus-group-mode-map [menu-bar groups newsgroups-display-toggle]
-        '("Toggle descriptions" . gnus-newsgroups-display-toggle))
-  (define-key gnus-group-mode-map [menu-bar groups jump-to-group]
-	'("Jump to Group..." . gnus-group-jump-to-group))
-  (define-key gnus-group-mode-map [menu-bar groups list-all-groups]
-	'("List All Groups" . gnus-group-list-all-groups))
-  (define-key gnus-group-mode-map [menu-bar groups list-groups]
-	'("List Groups" . gnus-group-list-groups))
-  (define-key gnus-group-mode-map [menu-bar groups unsub-current-group]
-	'("Unsubscribe Group" . gnus-group-unsubscribe-current-group))
-  )
-
-(defun gnus-group-mode ()
-  "Major mode for reading network news.
-All normal editing commands are turned off.
-Instead, these commands are available:
-
-SPC	Read articles in this newsgroup.
-=	Select this newsgroup.
-j	Move to the specified newsgroup.
-n	Move to the next unread newsgroup.
-p	Move to the previous unread newsgroup.
-C-n	Move to the next newsgroup.
-C-p	Move to the previous newsgroup.
-<	Move point to the beginning of this buffer.
->	Move point to the end of this buffer.
-u	Unsubscribe from (subscribe to) this newsgroup.
-U	Unsubscribe from (subscribe to) the specified newsgroup.
-c	Mark all articles as read, preserving marked articles.
-C	Mark all articles in this newsgroup as read.
-l	Revert this buffer.
-L	List all newsgroups.
-g	Get new news.
-R	Force to read the raw .newsrc file and get new news.
-b	Check bogus newsgroups.
-r	Restrict visible newsgroups to the current region.
-a	Post a new article.
-ESC k	Edit a local KILL file applied to this newsgroup.
-ESC K	Edit a global KILL file applied to all newsgroups.
-C-k	Kill this newsgroup.
-C-y	Yank killed newsgroup here.
-C-w	Kill newsgroups in current region (excluding current point).
-C-x C-t	Exchange this newsgroup and previous newsgroup.
-C-c C-l	list killed newsgroups.
-s	Save .newsrc file.
-z	Suspend reading news.
-q	Quit reading news.
-Q	Quit reading news without saving .newsrc file.
-V	Show the version number of this GNUS.
-?	Describe Group Mode commands briefly.
-C-h m	Describe Group Mode.
-C-c C-i	Read Info about Group Mode.
-t       Toggle displaying newsgroup descriptions.
-
-  The name of the host running NNTP server is asked for if no default
-host is specified.  It is also possible to choose another NNTP server
-even when the default server is defined by giving a prefix argument to
-the command `\\[gnus]'.
-
-  If the NNTP server name starts with a colon, as in `:Mail', the user's
-own directory `~/Mail' is used as a news spool.  This makes it
-possible to read mail stored in MH folders or articles saved by GNUS.
-File names of mail or articles must consist of only numeric
-characters.  Otherwise, they are ignored.
-
-  If there is a file named `~/.newsrc-SERVER', it is used as the
-startup file instead of standard one when talking to SERVER.  It is
-possible to talk to many hosts by using different startup files for
-each.
-
-  Option `-n' of the options line in the startup file is recognized
-properly the same as the Bnews system.  For example, if the options
-line is `options -n !talk talk.rumors', newsgroups under the `talk'
-hierarchy except for `talk.rumors' are ignored while checking new
-newsgroups.
-
-  If there is a file named `~/.signature-DISTRIBUTION', it is used as
-signature file instead of standard one when posting a news in
-DISTRIBUTION.
-
-  If an Info file generated from `gnus.texinfo' is installed, you can
-read an appropriate Info node of the Info file according to the
-current major mode of GNUS by \\[gnus-info-find-node].
-
-  The variable `gnus-version', `nntp-version', `nnspool-version', and
-`mhspool-version' have the version numbers of this version of gnus.el,
-nntp.el, nnspool.el, and mhspoo.el, respectively.
-
-User customizable variables:
- gnus-nntp-server
-    Specifies the name of the host running the NNTP server.  If its
-    value is a string such as `:DIRECTORY', the user's private
-    DIRECTORY is used as a news spool.  The variable is initialized
-    from the NNTPSERVER environment variable.
-
- gnus-nntp-service
-    Specifies a NNTP service name.  It is usually \"nntp\" or 119.
-    Nil forces GNUS to use a local news spool if the variable
-    `gnus-nntp-server' is set to the local host name.
-
- gnus-startup-file
-    Specifies a startup file (.newsrc).  If there is a file named
-    `.newsrc-SERVER', it's used instead when talking to SERVER.  I
-    recommend you to use the server specific file, if you'd like to
-    talk to many servers.  Especially if you'd like to read your
-    private directory, the name of the file must be
-    `.newsrc-:DIRECTORY'.
-
- gnus-signature-file
-    Specifies a signature file (.signature).  If there is a file named
-    `.signature-DISTRIBUTION', it's used instead when posting an
-    article in DISTRIBUTION.  Set the variable to nil to prevent
-    appending the file automatically.  If you use an NNTP inews which
-    comes with the NNTP package, you may have to set the variable to
-    nil.
-
- gnus-use-cross-reference
-    Specifies what to do with cross references (Xref: field).  If it
-    is nil, cross references are ignored.  If it is t, articles in
-    subscribed newsgroups are only marked as read.  Otherwise, if it
-    is not nil nor t, articles in all newsgroups are marked as read.
-
- gnus-use-followup-to
-    Specifies what to do with followup-to: field.  If it is nil, its
-    value is ignored.  If it is non-nil, its value is used as followup
-    newsgroups.  Especially, if it is t and field value is `poster',
-    your confirmation is required.
-
- gnus-author-copy
-    Specifies a file name to save a copy of article you posted using
-    FCC: field.  If the first character of the value is `|', the
-    contents of the article is piped out to a program specified by the
-    rest of the value.  The variable is initialized from the
-    AUTHORCOPY environment variable.
-
- gnus-author-copy-saver
-    Specifies a function to save an author copy.  The function is
-    called with a file name.  The default function `rmail-output'
-    saves in Unix mail format.
-
- gnus-kill-file-name
-    Use specified file name as a KILL file (default to `KILL').
-
- gnus-novice-user
-    Non-nil means that you are a novice to USENET.  If non-nil,
-    verbose messages may be displayed or your confirmations may be
-    required.
-
- gnus-interactive-post
-    Non-nil means that newsgroup, subject and distribution are asked
-    for interactively when posting a new article.
-
- gnus-use-full-window
-    Non-nil means to take up the entire screen of Emacs.
-
- gnus-window-configuration
-    Specifies the configuration of Group, Summary, and Article
-    windows.  It is a list of (ACTION (G S A)), where G, S, and A are
-    the relative height of Group, Summary, and Article windows,
-    respectively.  ACTION is `summary', `newsgroups', or `article'.
-
- gnus-subscribe-newsgroup-method
-    Specifies a function called with a newsgroup name when new
-    newsgroup is found.  The default definition adds new newsgroup at
-    the beginning of other newsgroups.
-
-  And more and more.  Please refer to texinfo documentation.
-
-Various hooks for customization:
- gnus-group-mode-hook
-    Entry to this mode calls the value with no arguments, if that
-    value is non-nil.  This hook is called before GNUS is connected to
-    the NNTP server.  So, you can change or define the NNTP server in
-    this hook.
-
- gnus-startup-hook
-    Called with no arguments after the NNTP server is selected.  It is
-    possible to change the behavior of GNUS or initialize the
-    variables according to the selected NNTP server.
-
- gnus-group-prepare-hook
-    Called with no arguments after a newsgroup list is created in the
-    Newsgroup buffer, if that value is non-nil.
-
- gnus-save-newsrc-hook
-    Called with no arguments when saving newsrc file if that value is
-    non-nil.
-
- gnus-prepare-article-hook
-    Called with no arguments after preparing message body, but before
-    preparing header fields which is automatically generated if that
-    value is non-nil.  The default hook (gnus-inews-insert-signature)
-    inserts a signature file.
-
- gnus-inews-article-hook
-    Called with no arguments when posting an article if that value is
-    non-nil.  This hook is called just before posting an article.  The
-    default hook does FCC (save an article to the specified file).
-
- gnus-suspend-gnus-hook
-    Called with no arguments when suspending (not exiting) GNUS, if
-    that value is non-nil.
-
- gnus-exit-gnus-hook
-    Called with no arguments when exiting (not suspending) GNUS, if
-    that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  ;; Gee.  Why don't you upgrade?
-  (cond ((boundp 'mode-line-modified)
-	 (setq mode-line-modified "--- "))
-	((listp (default-value 'mode-line-format))
-	 (setq mode-line-format
-	       (cons "--- " (cdr (default-value 'mode-line-format)))))
-	(t
-	 (setq mode-line-format
-	       "--- GNUS: List of Newsgroups  %[(%m)%]----%3p-%-")))
-  (setq major-mode 'gnus-group-mode)
-  (setq mode-name "Newsgroup")
-  (setq mode-line-buffer-identification	"GNUS: List of Newsgroups")
-  (setq mode-line-process nil)
-  (use-local-map gnus-group-mode-map)
-  (buffer-flush-undo (current-buffer))
-  (setq buffer-read-only t)		;Disable modification
-  (setq truncate-lines t)		;In case descriptions are too long.
-  (run-hooks 'gnus-group-mode-hook))
-
-(defun gnus-mouse-pick-group (e)
-  (interactive "e")
-  (mouse-set-point e)
-  (gnus-group-read-group nil))
-
-;;;###autoload
-(defun gnus (&optional confirm)
-  "Read network news.
-If optional argument CONFIRM is non-nil, ask NNTP server."
-  (interactive "P")
-  (unwind-protect
-      (progn
-	(switch-to-buffer (get-buffer-create gnus-group-buffer))
-	(gnus-group-mode)
-	(gnus-start-news-server confirm))
-    (if (not (gnus-server-opened))
-	(gnus-group-quit)
-      ;; NNTP server is successfully open. 
-      (setq mode-line-process (format " {%s}" gnus-nntp-server))
-      (let ((buffer-read-only nil))
-	(erase-buffer)
-	(gnus-group-startup-message)
-	(sit-for 0))
-      (run-hooks 'gnus-startup-hook)
-      (gnus-setup-news)
-      (if gnus-novice-user
-	  (gnus-group-describe-briefly)) ;Show brief help message.
-      (gnus-group-list-groups nil)
-      )))
-
-(defun gnus-group-startup-message ()
-  "Insert startup message in current buffer."
-  ;; Insert the message.
-  (insert
-   (format "
-                   %s
-
-         NNTP-based News Reader for GNU Emacs
-
-
-If you have any trouble with this software, please let me
-know.  I will fix your problems in the next release.
-
-Comments, suggestions, and bug fixes are welcome.
-
-Masanobu UMEDA
-umerin@mse.kyutech.ac.jp" gnus-version))
-  ;; And then hack it.
-  ;; 57 is the longest line.
-  (indent-rigidly (point-min) (point-max) (/ (max (- (window-width) 57) 0) 2))
-  (goto-char (point-min))
-  ;; +4 is fuzzy factor.
-  (insert-char ?\n (/ (max (- (window-height) 18) 0) 2)))
-
-(defun gnus-group-list-groups (show-all)
-  "List newsgroups in the Newsgroup buffer.
-If argument SHOW-ALL is non-nil, unsubscribed groups are also listed."
-  (interactive "P")
-  (setq gnus-newsgroups-showall show-all)
-  (let ((case-fold-search nil)
-	(last-group			;Current newsgroup.
-	 (gnus-group-group-name))
-	(next-group			;Next possible newsgroup.
-	 (progn
-	   (gnus-group-search-forward nil nil)
-	   (gnus-group-group-name)))
-	(prev-group			;Previous possible newsgroup.
-	 (progn
-	   (gnus-group-search-forward t nil)
-	   (gnus-group-group-name))))
-    (set-buffer gnus-group-buffer)	;May call from out of Group buffer
-    (gnus-group-prepare show-all)
-    (if (zerop (buffer-size))
-	(message "No news is good news")
-      ;; Go to last newsgroup if possible.  If cannot, try next and
-      ;; previous.  If all fail, go to first unread newsgroup.
-      (goto-char (point-min))
-      (or (and last-group
-	       (re-search-forward (gnus-group-make-regexp last-group) nil t))
-	  (and next-group
-	       (re-search-forward (gnus-group-make-regexp next-group) nil t))
-	  (and prev-group
-	       (re-search-forward (gnus-group-make-regexp prev-group) nil t))
-	  (gnus-group-search-forward nil nil t))
-      ;; Adjust cursor point.
-      (beginning-of-line)
-      (search-forward ":" nil t)
-      )))
-
-(defun gnus-group-prepare (&optional all)
-  "Prepare list of newsgroups in current buffer.
-If optional argument ALL is non-nil, unsubscribed groups are also listed."
-  (let ((buffer-read-only nil)
-	(newsrc gnus-newsrc-assoc)
-	(group-info nil)
-	(group-name nil)
-	(group-description nil)
-	(unread-count 0)
-	(nb-tab 0)
-	;; This specifies the format of Group buffer.
-	(cntl "%s%s%5d: %s"))
-    (erase-buffer)
-    ;; List newsgroups.
-    (while newsrc
-      (setq group-info (car newsrc))
-      (setq group-name (car group-info))
-      (if gnus-newsgroups-display
-	  (progn (setq group-description (gnus-gethash group-name gnus-newsgroups-hashtb))
-		 (setq nb-tab (/ (- 38 (length group-name)) tab-width))))
-      (setq unread-count (nth 1 (gnus-gethash group-name gnus-unread-hashtb)))
-      (if (or all
-	      (and (nth 1 group-info)	;Subscribed.
-		   (> unread-count 0)))	;There are unread articles.
-	  ;; Yes, I can use gnus-group-prepare-line, but this is faster.
-	  (insert
-	   (format (concat cntl (make-string (if (> nb-tab 0) nb-tab 1) ?\t)
-			   "%s\n")
-		   ;; Subscribed or not.
-		   (if (nth 1 group-info) " " "U")
-		   ;; Has new news?
-		   (if (and (> unread-count 0)
-			    (>= 0
-				(- unread-count
-				   (length
-				    (cdr (gnus-gethash group-name
-						       gnus-marked-hashtb))))))
-		       "*" " ")
-		   ;; Number of unread articles.
-		   unread-count
-		   ;; Newsgroup name.
-		   group-name
-		   ;; Newsgroup description
-		   (if group-description (cdr group-description) "")
-		   ))
-	)
-      (setq newsrc (cdr newsrc))
-      )
-    (setq gnus-have-all-newsgroups all)
-    (goto-char (point-min))
-    (run-hooks 'gnus-group-prepare-hook)
-    ))
-
-(defun gnus-group-prepare-line (info)
-  "Return a string for the Newsgroup buffer from INFO.
-INFO is an element of `gnus-newsrc-assoc' or `gnus-killed-assoc'."
-  (let* ((group-name (car info))
-	 (group-description nil)
-	 (nb-tab 0)
-	 (unread-count
-	  (or (nth 1 (gnus-gethash group-name gnus-unread-hashtb))
-	      ;; Not in hash table, so compute it now.
-	      (gnus-number-of-articles
-	       (gnus-difference-of-range
-		(nth 2 (gnus-gethash group-name gnus-active-hashtb))
-		(nthcdr 2 info)))))
-	 ;; This specifies the format of Group buffer.
-	 (cntl "%s%s%5d: %s"))
-    (if gnus-newsgroups-display
-	(progn
-	  (setq group-description (gnus-gethash group-name gnus-newsgroups-hashtb))
-	  (setq nb-tab (/ (- 38 (length group-name)) tab-width))))
-    (format (concat cntl (make-string (if (> nb-tab 0) nb-tab 1) ?\t)
-		    "%s\n")
-	    ;; Subscribed or not.
-	    (if (nth 1 info) " " "U")
-	    ;; Has new news?
-	    (if (and (> unread-count 0)
-		     (>= 0
-			 (- unread-count
-			    (length
-			     (cdr (gnus-gethash group-name
-						gnus-marked-hashtb))))))
-		"*" " ")
-	    ;; Number of unread articles.
-	    unread-count
-	    ;; Newsgroup name.
-	    group-name
-	    ;; Newsgroup description
-	    (if group-description (cdr group-description) "")
-	    )))
-
-(defun gnus-group-update-group (group &optional visible-only)
-  "Update newsgroup info of GROUP.
-If optional argument VISIBLE-ONLY is non-nil, non displayed group is ignored."
-  (let ((buffer-read-only nil)
-	(case-fold-search nil)		;appleIIgs vs. appleiigs
-	(regexp (gnus-group-make-regexp group))
-	(visible nil))
-    ;; Buffer may be narrowed.
-    (save-restriction
-      (widen)
-      ;; Search a line to modify.  If the buffer is large, the search
-      ;; takes long time.  In most cases, current point is on the line
-      ;; we are looking for.  So, first of all, check current line. 
-      ;; And then if current point is in the first half, search from
-      ;; the beginning.  Otherwise, search from the end.
-      (if (cond ((progn
-		   (beginning-of-line)
-		   (looking-at regexp)))
-		((and (> (/ (buffer-size) 2) (point)) ;In the first half.
-		      (progn
-			(goto-char (point-min))
-			(re-search-forward regexp nil t))))
-		((progn
-		   (goto-char (point-max))
-		   (re-search-backward regexp nil t))))
-	  ;; GROUP is listed in current buffer.  So, delete old line.
-	  (progn
-	    (setq visible t)
-	    (beginning-of-line)
-	    (delete-region (point) (progn (forward-line 1) (point)))
-	    )
-	;; No such line in the buffer, so insert it at the top.
-	(goto-char (point-min)))
-      (if (or visible (not visible-only))
-	  (progn
-	    (insert (gnus-group-prepare-line
-		     (gnus-gethash group gnus-newsrc-hashtb)))
-	    (forward-line -1)		;Move point on that line.
-	    ))
-      )))
-
-(defun gnus-group-group-name ()
-  "Get newsgroup name around point."
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at "^..[0-9 \t]+:[ \t]+\\([^ \t\n]+\\)\\([ \t].*\\|$\\)")
-        (let ((group-name (buffer-substring (match-beginning 1) (match-end 1))))
-          (set-text-properties 0 (length group-name) nil group-name)
-          group-name))))
-
-(defun gnus-group-make-regexp (newsgroup)
-  "Return regexp that matches for a line of NEWSGROUP."
-  (concat "^.+: " (regexp-quote newsgroup) "\\([ \t].*\\|$\\)"))
-
-(defun gnus-group-search-forward (backward norest &optional heretoo)
-  "Search for the next (or previous) newsgroup.
-If 1st argument BACKWARD is non-nil, search backward instead.
-If 2nd argument NOREST is non-nil, don't care about newsgroup property.
-If optional argument HERETOO is non-nil, current line is searched for, too."
-  (let ((case-fold-search nil)
-	(func
-	 (if backward
-	     (function re-search-backward) (function re-search-forward)))
-	(regexp
-	 (format "^%s[ \t]*\\(%s\\):"
-		 (if norest ".." " [ \t]")
-		 (if norest "[0-9]+" "[1-9][0-9]*")))
-	(found nil))
-    (if backward
-	(if heretoo
-	    (end-of-line)
-	  (beginning-of-line))
-      (if heretoo
-	  (beginning-of-line)
-	(end-of-line)))
-    (setq found (funcall func regexp nil t))
-    ;; Adjust cursor point.
-    (beginning-of-line)
-    (search-forward ":" nil t)
-    ;; Return T if found.
-    found
-    ))
-
-;; GNUS Group mode command
-
-(defun gnus-group-read-group (all &optional no-article)
-  "Read news in this newsgroup.
-If argument ALL is non-nil, already read articles become readable.
-If optional argument NO-ARTICLE is non-nil, no article body is displayed."
-  (interactive "P")
-  (let ((group (gnus-group-group-name))) ;Newsgroup name to read.
-    (if group
-	(gnus-summary-read-group
-	 group
-	 (or all
-	     ;;(not (nth 1 (gnus-gethash group gnus-newsrc-hashtb))) ;Unsubscribed
-	     (zerop
-	      (nth 1 (gnus-gethash group gnus-unread-hashtb))))	;No unread
-	 no-article
-	 ))
-    ))
-
-(defun gnus-group-select-group (all)
-  "Select this newsgroup.
-No article is selected automatically.
-If argument ALL is non-nil, already read articles become readable."
-  (interactive "P")
-  (gnus-group-read-group all t))
-
-(defun gnus-group-jump-to-group (group)
-  "Jump to newsgroup GROUP."
-  (interactive
-   (list (completing-read "Newsgroup: " gnus-newsrc-assoc nil 'require-match)))
-  (let ((case-fold-search nil))
-    (goto-char (point-min))
-    (or (re-search-forward (gnus-group-make-regexp group) nil t)
-	(if (gnus-gethash group gnus-newsrc-hashtb)
-	    ;; Add GROUP entry, then seach again.
-	    (gnus-group-update-group group)))
-    ;; Adjust cursor point.
-    (beginning-of-line)
-    (search-forward ":" nil t)
-    ))
-
-(defun gnus-group-next-group (n)
-  "Go to Nth following newsgroup."
-  (interactive "p")
-  (while (and (> n 1)
-	      (gnus-group-search-forward nil t))
-    (setq n (1- n)))
-  (or (gnus-group-search-forward nil t)
-      (message "No more newsgroups")))
-
-(defun gnus-group-next-unread-group (n)
-  "Go to Nth following unread newsgroup."
-  (interactive "p")
-  (while (and (> n 1)
-	      (gnus-group-search-forward nil nil))
-    (setq n (1- n)))
-  (or (gnus-group-search-forward nil nil)
-      (message "No more unread newsgroups")))
-
-(defun gnus-group-prev-group (n)
-  "Go to Nth previous newsgroup."
-  (interactive "p")
-  (while (and (> n 1)
-	      (gnus-group-search-forward t t))
-    (setq n (1- n)))
-  (or (gnus-group-search-forward t t)
-      (message "No more newsgroups")))
-
-(defun gnus-group-prev-unread-group (n)
-  "Go to Nth previous unread newsgroup."
-  (interactive "p")
-  (while (and (> n 1)
-	      (gnus-group-search-forward t nil))	      
-    (setq n (1- n)))
-  (or (gnus-group-search-forward t nil)
-      (message "No more unread newsgroups")))
-
-(defun gnus-group-catchup (all)
-  "Mark all articles not marked as unread in current newsgroup as read.
-If prefix argument ALL is non-nil, all articles are marked as read.
-Cross references (Xref: field) of articles are ignored."
-  (interactive "P")
-  (let* ((group (gnus-group-group-name))
-         (marked (if (not all)
-		     (cdr (gnus-gethash group gnus-marked-hashtb)))))
-    (and group
-	 (or (not gnus-interactive-catchup) ;Without confirmation?
-	     (y-or-n-p
-	      (if all
-		  "Do you really want to mark everything as read? "
-		"Delete all articles not marked as read? ")))
-	 (progn
-	   (message "")			;Clear "Yes or No" question.
-	   ;; Any marked articles will be preserved.
-	   (gnus-update-unread-articles group marked marked)
-	   (gnus-group-update-group group)
-	   (gnus-group-next-group 1)))
-    ))
-
-(defun gnus-group-catchup-all ()
-  "Mark all articles in current newsgroup as read.
-Cross references (Xref: field) of articles are ignored."
-  (interactive)
-  (gnus-group-catchup t))
-
-(defun gnus-group-unsubscribe-current-group ()
-  "Toggle subscribe from/to unsubscribe current group."
-  (interactive)
-  (let ((group (gnus-group-group-name)))
-    (if group
-	 (progn
-	   (gnus-group-unsubscribe-group group)
-	   (gnus-group-next-group 1))
-      (message "No Newsgroup found to \(un\)subscribe"))))
-
-(defun gnus-group-unsubscribe-group (group)
-  "Toggle subscribe from/to unsubscribe GROUP.
-\(If GROUP is new, it is added to `.newsrc' automatically.)"
-  (interactive
-   (list (completing-read "Newsgroup: "
-			  gnus-active-hashtb nil 'require-match)))
-  (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
-    (cond ((not (null newsrc))
-	   ;; Toggle subscription flag.
-	   (setcar (nthcdr 1 newsrc) (not (nth 1 newsrc)))
-	   (gnus-update-newsrc-buffer group)
-	   (gnus-group-update-group group)
-	   ;; Adjust cursor point.
-	   (beginning-of-line)
-	   (search-forward ":" nil t))
-	  ((and (stringp group)
-		(gnus-gethash group gnus-active-hashtb))
-	   ;; Add new newsgroup.
-	   (gnus-add-newsgroup group)
-	   (gnus-group-update-group group)
-	   ;; Adjust cursor point.
-	   (beginning-of-line)
-	   (search-forward ":" nil t))
-	  (t (error "No such newsgroup: %s" group)))
-    ))
-
-(defun gnus-group-list-all-groups ()
-  "List all of newsgroups in the Newsgroup buffer."
-  (interactive)
-  (message "Listing all groups...")
-  (gnus-group-list-groups t)
-  (message "Listing all groups...done"))
-
-(defun gnus-group-get-new-news ()
-  "Get newly arrived articles.  In fact, read the active file again."
-  (interactive)
-  (gnus-setup-news)
-  (gnus-group-list-groups gnus-have-all-newsgroups))
-
-(defun gnus-group-restart ()
-  "Force GNUS to read the raw startup file."
-  (interactive)
-  (gnus-save-newsrc-file)
-  (gnus-setup-news t)			;Force to read the raw startup file.
-  (gnus-group-list-groups gnus-have-all-newsgroups))
-
-(defun gnus-group-check-bogus-groups ()
-  "Check bogus newsgroups."
-  (interactive)
-  (gnus-check-bogus-newsgroups t)	;Require confirmation.
-  (gnus-group-list-groups gnus-have-all-newsgroups))
-
-(defun gnus-group-restrict-groups (start end)
-  "Restrict visible newsgroups to the current region (START and END).
-Type \\[widen] to remove restriction."
-  (interactive "r")
-  (save-excursion
-    (narrow-to-region (progn
-			(goto-char start)
-			(beginning-of-line)
-			(point))
-		      (progn
-			(goto-char end)
-			(forward-line 1)
-			(point))))
-  (message (substitute-command-keys "Type \\[widen] to remove restriction")))
-
-(defun gnus-group-edit-global-kill ()
-  "Edit a global KILL file."
-  (interactive)
-  (setq gnus-current-kill-article nil)	;No articles selected.
-  (gnus-kill-file-edit-file nil) 	;Nil stands for global KILL file.
-  (message
-   (substitute-command-keys
-    "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)")))
-
-(defun gnus-group-edit-local-kill ()
-  "Edit a local KILL file."
-  (interactive)
-  (setq gnus-current-kill-article nil)	;No articles selected.
-  (gnus-kill-file-edit-file (gnus-group-group-name))
-  (message
-   (substitute-command-keys
-    "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)")))
-
-(defun gnus-group-force-update ()
-  "Update `.newsrc' file."
-  (interactive)
-  (gnus-save-newsrc-file))
-
-(defun gnus-group-suspend ()
-  "Suspend the current GNUS session.
-In fact, cleanup buffers except for Group Mode buffer.
-The hook `gnus-suspend-gnus-hook' is called before actually suspending."
-  (interactive)
-  (run-hooks 'gnus-suspend-gnus-hook)
-  ;; Kill GNUS buffers except for Group Mode buffer.
-  (let ((buffers gnus-buffer-list)
-	(group-buf (get-buffer gnus-group-buffer)))
-    (while buffers
-      (and (not (eq (car buffers) gnus-group-buffer))
-	   (get-buffer (car buffers))
-	   (kill-buffer (car buffers)))
-      (setq buffers (cdr buffers))
-      )
-    (bury-buffer group-buf)
-    (delete-windows-on group-buf t)))
-
-(defun gnus-group-exit ()
-  "Quit reading news after updating `.newsrc'.
-The hook `gnus-exit-gnus-hook' is called before actually quitting."
-  (interactive)
-  (if (or noninteractive		;For gnus-batch-kill
-	  (zerop (buffer-size))		;No news is good news.
-	  (not (gnus-server-opened))	;NNTP connection closed.
-	  (not gnus-interactive-exit)	;Without confirmation
-	  (y-or-n-p "Are you sure you want to quit reading news? "))
-      (progn
-	(message "")			;Erase "Yes or No" question.
-	(run-hooks 'gnus-exit-gnus-hook)
-	(gnus-save-newsrc-file)
-	(gnus-clear-system)
-	(gnus-close-server))
-    ))
-
-(defun gnus-group-quit ()
-  "Quit reading news without updating `.newsrc'.
-The hook `gnus-exit-gnus-hook' is called before actually quitting."
-  (interactive)
-  (if (or noninteractive		;For gnus-batch-kill
-	  (zerop (buffer-size))
-	  (not (gnus-server-opened))
-	  (yes-or-no-p
-	   (format "Quit reading news without saving %s? "
-		   (file-name-nondirectory gnus-current-startup-file))))
-      (progn
-	(message "")			;Erase "Yes or No" question.
-	(run-hooks 'gnus-exit-gnus-hook)
-	(gnus-clear-system)
-	(gnus-close-server))
-    ))
-
-(defun gnus-group-describe-briefly ()
-  "Describe Group mode commands briefly."
-  (interactive)
-  (message
-   (concat
-    (substitute-command-keys "\\[gnus-group-read-group]:Select  ")
-    (substitute-command-keys "\\[gnus-group-next-unread-group]:Forward  ")
-    (substitute-command-keys "\\[gnus-group-prev-unread-group]:Backward  ")
-    (substitute-command-keys "\\[gnus-group-exit]:Exit  ")
-    (substitute-command-keys "\\[gnus-info-find-node]:Run Info  ")
-    (substitute-command-keys "\\[gnus-group-describe-briefly]:This help")
-    )))
-
-
-;;;
-;;; GNUS Summary Mode
-;;;
-
-(if gnus-summary-mode-map
-    nil
-  (setq gnus-summary-mode-map (make-keymap))
-  (suppress-keymap gnus-summary-mode-map)
-  (define-key gnus-summary-mode-map "\C-c\C-v" 'gnus-uu-ctl-map)
-  (define-key gnus-summary-mode-map "#" 'gnus-uu-mark-article)
-  (define-key gnus-summary-mode-map " " 'gnus-summary-next-page)
-  (define-key gnus-summary-mode-map "\177" 'gnus-summary-prev-page)
-  (define-key gnus-summary-mode-map "\r" 'gnus-summary-scroll-up)
-  (define-key gnus-summary-mode-map "n" 'gnus-summary-next-unread-article)
-  (define-key gnus-summary-mode-map "p" 'gnus-summary-prev-unread-article)
-  (define-key gnus-summary-mode-map "N" 'gnus-summary-next-article)
-  (define-key gnus-summary-mode-map "P" 'gnus-summary-prev-article)
-  (define-key gnus-summary-mode-map "\e\C-n" 'gnus-summary-next-same-subject)
-  (define-key gnus-summary-mode-map "\e\C-p" 'gnus-summary-prev-same-subject)
-  ;;(define-key gnus-summary-mode-map "\e\C-n" 'gnus-summary-next-unread-same-subject)
-  ;;(define-key gnus-summary-mode-map "\e\C-p" 'gnus-summary-prev-unread-same-subject)
-  (define-key gnus-summary-mode-map "\C-c\C-n" 'gnus-summary-next-digest)
-  (define-key gnus-summary-mode-map "\C-c\C-p" 'gnus-summary-prev-digest)
-  (define-key gnus-summary-mode-map "\C-n" 'gnus-summary-next-subject)
-  (define-key gnus-summary-mode-map "\C-p" 'gnus-summary-prev-subject)
-  (define-key gnus-summary-mode-map [down] 'gnus-summary-next-subject)
-  (define-key gnus-summary-mode-map [up] 'gnus-summary-prev-subject)
-  (define-key gnus-summary-mode-map "\en" 'gnus-summary-next-unread-subject)
-  (define-key gnus-summary-mode-map "\ep" 'gnus-summary-prev-unread-subject)
-  ;;(define-key gnus-summary-mode-map "\C-cn" 'gnus-summary-next-group)
-  ;;(define-key gnus-summary-mode-map "\C-cp" 'gnus-summary-prev-group)
-  (define-key gnus-summary-mode-map "." 'gnus-summary-first-unread-article)
-  ;;(define-key gnus-summary-mode-map "/" 'isearch-forward)
-  (define-key gnus-summary-mode-map "s" 'gnus-summary-isearch-article)
-  (define-key gnus-summary-mode-map "\es" 'gnus-summary-search-article-forward)
-  ;;(define-key gnus-summary-mode-map "\eS" 'gnus-summary-search-article-backward)
-  (define-key gnus-summary-mode-map "\er" 'gnus-summary-search-article-backward)
-  (define-key gnus-summary-mode-map "<" 'gnus-summary-beginning-of-article)
-  (define-key gnus-summary-mode-map ">" 'gnus-summary-end-of-article)
-  (define-key gnus-summary-mode-map "j" 'gnus-summary-goto-subject)
-  ;;(define-key gnus-summary-mode-map "J" 'gnus-summary-goto-article)
-  (define-key gnus-summary-mode-map "l" 'gnus-summary-goto-last-article)
-  (define-key gnus-summary-mode-map "^" 'gnus-summary-refer-parent-article)
-  ;;(define-key gnus-summary-mode-map "\er" 'gnus-summary-refer-article)
-  (define-key gnus-summary-mode-map "\e^" 'gnus-summary-refer-article)
-  (define-key gnus-summary-mode-map "u" 'gnus-summary-mark-as-unread-forward)
-  (define-key gnus-summary-mode-map "U" 'gnus-summary-mark-as-unread-backward)
-  (define-key gnus-summary-mode-map "d" 'gnus-summary-mark-as-read-forward)
-  (define-key gnus-summary-mode-map "D" 'gnus-summary-mark-as-read-backward)
-  (define-key gnus-summary-mode-map "\eu" 'gnus-summary-clear-mark-forward)
-  (define-key gnus-summary-mode-map "\eU" 'gnus-summary-clear-mark-backward)
-  (define-key gnus-summary-mode-map "k" 'gnus-summary-kill-same-subject-and-select)
-  (define-key gnus-summary-mode-map "\C-k" 'gnus-summary-kill-same-subject)
-  (define-key gnus-summary-mode-map "\e\C-t" 'gnus-summary-toggle-threads)
-  (define-key gnus-summary-mode-map "\e\C-s" 'gnus-summary-show-thread)
-  (define-key gnus-summary-mode-map "\e\C-h" 'gnus-summary-hide-thread)
-  (define-key gnus-summary-mode-map "\e\C-f" 'gnus-summary-next-thread)
-  (define-key gnus-summary-mode-map "\e\C-b" 'gnus-summary-prev-thread)
-  (define-key gnus-summary-mode-map "\e\C-u" 'gnus-summary-up-thread)
-  (define-key gnus-summary-mode-map "\e\C-d" 'gnus-summary-down-thread)
-  (define-key gnus-summary-mode-map "\e\C-k" 'gnus-summary-kill-thread)
-  (define-key gnus-summary-mode-map "&" 'gnus-summary-execute-command)
-  ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup)
-  ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-all)
-  (define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-and-exit)
-  ;;(define-key gnus-summary-mode-map "c" 'gnus-summary-catchup-all-and-exit)
-  (define-key gnus-summary-mode-map "\C-t" 'gnus-summary-toggle-truncation)
-  (define-key gnus-summary-mode-map "x" 'gnus-summary-delete-marked-as-read)
-  (define-key gnus-summary-mode-map "X" 'gnus-summary-delete-marked-with)
-  (define-key gnus-summary-mode-map "\C-c\C-sn" 'gnus-summary-sort-by-number)
-  (define-key gnus-summary-mode-map "\C-c\C-sa" 'gnus-summary-sort-by-author)
-  (define-key gnus-summary-mode-map "\C-c\C-ss" 'gnus-summary-sort-by-subject)
-  (define-key gnus-summary-mode-map "\C-c\C-sd" 'gnus-summary-sort-by-date)
-  (define-key gnus-summary-mode-map "\C-c\C-s\C-n" 'gnus-summary-sort-by-number)
-  (define-key gnus-summary-mode-map "\C-c\C-s\C-a" 'gnus-summary-sort-by-author)
-  (define-key gnus-summary-mode-map "\C-c\C-s\C-s" 'gnus-summary-sort-by-subject)
-  (define-key gnus-summary-mode-map "\C-c\C-s\C-d" 'gnus-summary-sort-by-date)
-  (define-key gnus-summary-mode-map "=" 'gnus-summary-expand-window)
-  ;;(define-key gnus-summary-mode-map "G" 'gnus-summary-reselect-current-group)
-  (define-key gnus-summary-mode-map "\C-x\C-s" 'gnus-summary-reselect-current-group)
-  (define-key gnus-summary-mode-map "w" 'gnus-summary-stop-page-breaking)
-  (define-key gnus-summary-mode-map "\C-c\C-r" 'gnus-summary-caesar-message)
-  (define-key gnus-summary-mode-map "g" 'gnus-summary-show-article)
-  (define-key gnus-summary-mode-map "t" 'gnus-summary-toggle-header)
-  ;;(define-key gnus-summary-mode-map "v" 'gnus-summary-show-all-headers)
-  (define-key gnus-summary-mode-map "\et" 'gnus-summary-toggle-mime)
-  (define-key gnus-summary-mode-map "\C-d" 'gnus-summary-rmail-digest)
-  (define-key gnus-summary-mode-map "a" 'gnus-summary-post-news)
-  (define-key gnus-summary-mode-map "f" 'gnus-summary-followup)
-  (define-key gnus-summary-mode-map "F" 'gnus-summary-followup-with-original)
-  (define-key gnus-summary-mode-map "C" 'gnus-summary-cancel-article)
-  (define-key gnus-summary-mode-map "r" 'gnus-summary-reply)
-  (define-key gnus-summary-mode-map "R" 'gnus-summary-reply-with-original)
-  (define-key gnus-summary-mode-map "\C-c\C-f" 'gnus-summary-mail-forward)
-  (define-key gnus-summary-mode-map "m" 'gnus-summary-mail-other-window)
-  (define-key gnus-summary-mode-map "o" 'gnus-summary-save-article)
-  (define-key gnus-summary-mode-map "\C-o" 'gnus-summary-save-in-mail)
-  (define-key gnus-summary-mode-map "|" 'gnus-summary-pipe-output)
-  (define-key gnus-summary-mode-map "\ek" 'gnus-summary-edit-local-kill)
-  (define-key gnus-summary-mode-map "\eK" 'gnus-summary-edit-global-kill)
-  (define-key gnus-summary-mode-map "V" 'gnus-version)
-  (define-key gnus-summary-mode-map "q" 'gnus-summary-exit)
-  (define-key gnus-summary-mode-map "Q" 'gnus-summary-quit)
-  (define-key gnus-summary-mode-map "?" 'gnus-summary-describe-briefly)
-  (define-key gnus-summary-mode-map "\C-c\C-i" 'gnus-info-find-node)
-  (define-key gnus-summary-mode-map [mouse-2] 'gnus-mouse-pick-article)
-
-  (define-key gnus-summary-mode-map [menu-bar misc]
-	(cons "Misc" (make-sparse-keymap "misc")))
-
-  (define-key gnus-summary-mode-map [menu-bar misc caesar-message]
-	'("Caesar Message" . gnus-summary-caesar-message))
-  (define-key gnus-summary-mode-map [menu-bar misc cancel-article]
-	'("Cancel Article" . gnus-summary-cancel-article))
-  (define-key gnus-summary-mode-map [menu-bar misc edit-local-kill]
-	'("Edit Kill File" . gnus-summary-edit-local-kill))
-
-  (define-key gnus-summary-mode-map [menu-bar misc mark-as-unread]
-	'("Mark as Unread" . gnus-summary-mark-as-unread-forward))
-  (define-key gnus-summary-mode-map [menu-bar misc mark-as-read]
-	'("Mark as Read" . gnus-summary-mark-as-read))
-
-  (define-key gnus-summary-mode-map [menu-bar misc quit]
-	'("Quit Group" . gnus-summary-quit))
-  (define-key gnus-summary-mode-map [menu-bar misc exit]
-	'("Exit Group" . gnus-summary-exit))
-
-  (define-key gnus-summary-mode-map [menu-bar sort]
-	(cons "Sort" (make-sparse-keymap "sort")))
-
-  (define-key gnus-summary-mode-map [menu-bar sort sort-by-author]
-	'("Sort by Author" . gnus-summary-sort-by-author))
-  (define-key gnus-summary-mode-map [menu-bar sort sort-by-date]
-	'("Sort by Date" . gnus-summary-sort-by-date))
-  (define-key gnus-summary-mode-map [menu-bar sort sort-by-number]
-	'("Sort by Number" . gnus-summary-sort-by-number))
-  (define-key gnus-summary-mode-map [menu-bar sort sort-by-subject]
-	'("Sort by Subject" . gnus-summary-sort-by-subject))
-
-  (define-key gnus-summary-mode-map [menu-bar show/hide]
-	(cons "Show/Hide" (make-sparse-keymap "show/hide")))
-
-  (define-key gnus-summary-mode-map [menu-bar show/hide hide-all-threads]
-	'("Hide All Threads" . gnus-summary-hide-all-threads))
-  (define-key gnus-summary-mode-map [menu-bar show/hide hide-thread]
-	'("Hide Thread" . gnus-summary-hide-thread))
-  (define-key gnus-summary-mode-map [menu-bar show/hide show-all-threads]
-	'("Show All Threads" . gnus-summary-show-all-threads))
-  (define-key gnus-summary-mode-map [menu-bar show/hide show-all-headers]
-	'("Show All Headers" . gnus-summary-show-all-headers))
-  (define-key gnus-summary-mode-map [menu-bar show/hide show-thread]
-	'("Show Thread" . gnus-summary-show-thread))
-  (define-key gnus-summary-mode-map [menu-bar show/hide show-article]
-	'("Show Article" . gnus-summary-show-article))
-  (define-key gnus-summary-mode-map [menu-bar show/hide toggle-truncation]
-	'("Toggle Truncation" . gnus-summary-toggle-truncation))
-  (define-key gnus-summary-mode-map [menu-bar show/hide toggle-mime]
-	'("Toggle Mime" . gnus-summary-toggle-mime))
-  (define-key gnus-summary-mode-map [menu-bar show/hide toggle-header]
-	'("Toggle Header" . gnus-summary-toggle-header))
-
-  (define-key gnus-summary-mode-map [menu-bar action]
-	(cons "Action" (make-sparse-keymap "action")))
-
-  (define-key gnus-summary-mode-map [menu-bar action kill-same-subject]
-	'("Kill Same Subject" . gnus-summary-kill-same-subject))
-  (define-key gnus-summary-mode-map [menu-bar action kill-thread]
-	'("Kill Thread" . gnus-summary-kill-thread))
-  (define-key gnus-summary-mode-map [menu-bar action delete-marked-with]
-	'("Delete Marked With" . gnus-summary-delete-marked-with))
-  (define-key gnus-summary-mode-map [menu-bar action delete-marked-as-read]
-	'("Delete Marked As Read" . gnus-summary-delete-marked-as-read))
-  (define-key gnus-summary-mode-map [menu-bar action catchup-and-exit]
-	'("Catchup And Exit" . gnus-summary-catchup-and-exit))
-  (define-key gnus-summary-mode-map [menu-bar action catchup-to-here]
-	'("Catchup to Here" . gnus-summary-catchup-to-here))
-
-  (define-key gnus-summary-mode-map [menu-bar action ignore]
-    '("---"))
-
-  (define-key gnus-summary-mode-map [menu-bar action save-in-file]
-	'("Save in File" . gnus-summary-save-in-file))
-  (define-key gnus-summary-mode-map [menu-bar action save-article]
-	'("Save Article" . gnus-summary-save-article))
-
-  (define-key gnus-summary-mode-map [menu-bar action lambda]
-    '("---"))
-
-  (define-key gnus-summary-mode-map [menu-bar action forward]
-	'("Forward" . gnus-summary-mail-forward))
-  (define-key gnus-summary-mode-map [menu-bar action followup-with-original]
-	'("Followup with Original" . gnus-summary-followup-with-original))
-  (define-key gnus-summary-mode-map [menu-bar action followup]
-	'("Followup" . gnus-summary-followup))
-  (define-key gnus-summary-mode-map [menu-bar action reply-with-original]
-	'("Reply with Original" . gnus-summary-reply-with-original))
-  (define-key gnus-summary-mode-map [menu-bar action reply]
-	'("Reply" . gnus-summary-reply))
-  (define-key gnus-summary-mode-map [menu-bar action post]
-	'("Post News" . gnus-summary-post-news))
-
-  (define-key gnus-summary-mode-map [menu-bar move]
-	(cons "Move" (make-sparse-keymap "move")))
-
-  (define-key gnus-summary-mode-map [menu-bar move isearch-article]
-	'("Search in Article" . gnus-summary-isearch-article))
-  (define-key gnus-summary-mode-map [menu-bar move search-through-articles]
-	'("Search through Articles" . gnus-summary-search-article-forward))
-  (define-key gnus-summary-mode-map [menu-bar move down-thread]
-	'("Down Thread" . gnus-summary-down-thread))
-  (define-key gnus-summary-mode-map [menu-bar move prev-same-subject]
-	'("Prev Same Subject" . gnus-summary-prev-same-subject))
-  (define-key gnus-summary-mode-map [menu-bar move prev-group]
-	'("Prev Group" . gnus-summary-prev-group))
-  (define-key gnus-summary-mode-map [menu-bar move next-unread-same-subject]
-	'("Next Unread Same Subject" . gnus-summary-next-unread-same-subject))
-  (define-key gnus-summary-mode-map [menu-bar move next-unread-article]
-	'("Next Unread Article" . gnus-summary-next-unread-article))
-  (define-key gnus-summary-mode-map [menu-bar move next-thread]
-	'("Next Thread" . gnus-summary-next-thread))
-  (define-key gnus-summary-mode-map [menu-bar move next-group]
-	'("Next Group" . gnus-summary-next-group))
-  (define-key gnus-summary-mode-map [menu-bar move first-unread-article]
-	'("First Unread Article" . gnus-summary-first-unread-article))
-  )
-
-
-(defun gnus-summary-mode ()
-  "Major mode for reading articles in this newsgroup.
-All normal editing commands are turned off.
-Instead, these commands are available:
-
-SPC	Scroll to the next page of the current article.  The next unread
-	article is selected automatically at the end of the message.
-DEL	Scroll to the previous page of the current article.
-RET	Scroll up (or down) one line the current article.
-n	Move to the next unread article.
-p	Move to the previous unread article.
-N	Move to the next article.
-P	Move to the previous article.
-ESC C-n	Move to the next article which has the same subject as the
-	current article.
-ESC C-p	Move to the previous article which has the same subject as the
-	current article.
-\\[gnus-summary-next-unread-same-subject]
-	Move to the next unread article which has the same subject as the
-	current article.
-\\[gnus-summary-prev-unread-same-subject]
-	Move to the previous unread article which has the same subject as
-	the current article.
-C-c C-n	Scroll to the next digested message of the current article.
-C-c C-p	Scroll to the previous digested message of the current article.
-C-n	Move to the next subject.
-C-p	Move to the previous subject.
-ESC n	Move to the next unread subject.
-ESC p	Move to the previous unread subject.
-\\[gnus-summary-next-group]
-	Exit the current newsgroup and select the next unread newsgroup.
-\\[gnus-summary-prev-group]
-	Exit the current newsgroup and select the previous unread newsgroup.
-.	Jump to the first unread article in the current newsgroup.
-s	Do an incremental search forward on the current article.
-ESC s	Search for an article containing a regexp forward.
-ESC r	Search for an article containing a regexp backward.
-<	Move point to the beginning of the current article.
->	Move point to the end of the current article.
-j	Jump to the article specified by the numeric article ID.
-l	Jump to the article you read last.
-^	Refer to parent of the current article.
-ESC ^	Refer to the article specified by the Message-ID.
-u	Mark the current article as unread, and go forward.
-U	Mark the current article as unread, and go backward.
-d	Mark the current article as read, and go forward.
-D	Mark the current article as read, and go backward.
-ESC u	Clear the current article's mark, and go forward.
-ESC U	Clear the current article's mark, and go backward.
-k	Mark articles which has the same subject as the current article as
-	read, and then select the next unread article.
-C-k	Mark articles which has the same subject as the current article as
-	read.
-ESC k	Edit a local KILL file applied to the current newsgroup.
-ESC K	Edit a global KILL file applied to all newsgroups.
-ESC C-t	Toggle showing conversation threads.
-ESC C-s	Show thread subtrees.
-ESC C-h	Hide thread subtrees.
-\\[gnus-summary-show-all-threads]	Show all thread subtrees.
-\\[gnus-summary-hide-all-threads]	Hide all thread subtrees.
-ESC C-f	Go to the same level next thread.
-ESC C-b	Go to the same level previous thread.
-ESC C-d	Go downward current thread.
-ESC C-u	Go upward current thread.
-ESC C-k	Mark articles under current thread as read.
-&	Execute a command for each article conditionally.
-\\[gnus-summary-catchup]
-	Mark all articles as read in the current newsgroup, preserving
-	articles marked as unread.
-\\[gnus-summary-catchup-all]
-	Mark all articles as read in the current newsgroup.
-\\[gnus-summary-catchup-and-exit]
-	Catch up all articles not marked as unread, and then exit the
-	current newsgroup.
-\\[gnus-summary-catchup-all-and-exit]
-	Catch up all articles, and then exit the current newsgroup.
-C-t	Toggle truncations of subject lines.
-x	Delete subject lines marked as read.
-X	Delete subject lines with the specific marks.
-C-c C-s C-n	Sort subjects by article number.
-C-c C-s C-a	Sort subjects by article author.
-C-c C-s C-s	Sort subjects alphabetically.
-C-c C-s C-d	Sort subjects by date.
-=	Expand Summary window to show headers full window.
-C-x C-s	Reselect the current newsgroup.  Prefix argument means to select all.
-w	Stop page breaking by linefeed.
-C-c C-r	Caesar rotates letters by 13/47 places.
-g	Force to show the current article.
-t	Show original article header if pruned header currently shown, or
-	vice versa.
-ESC-t	Toggle MIME processing.
-C-d	Run RMAIL on the current digest article.
-a	Post a new article.
-f	Post a reply article.
-F	Post a reply article with original article.
-C	Cancel the current article.
-r	Mail a message to the author.
-R	Mail a message to the author with original author.
-C-c C-f	Forward the current message to another user.
-m	Mail a message in other window.
-o	Save the current article in your favorite format.
-C-o	Append the current article to a file in Unix mail format.
-|	Pipe the contents of the current article to a subprocess.
-q	Quit reading news in the current newsgroup.
-Q	Quit reading news without recording unread articles information.
-V	Show the version number of this GNUS.
-?	Describe Summary mode commands briefly.
-C-h m	Describe Summary mode.
-C-c C-i	Read Info about Summary mode.
-
-User customizable variables:
- gnus-large-newsgroup
-    The number of articles which indicates a large newsgroup.  If the
-    number of articles in a newsgroup is greater than the value, the
-    number of articles to be selected is asked for.  If the given value
-    N is positive, the last N articles is selected.  If N is negative,
-    the first N articles are selected.  An empty string means to select
-    all articles.
-
- gnus-use-long-file-name
-    Non-nil means that a newsgroup name is used as a default file name
-    to save articles to.  If it's nil, the directory form of a
-    newsgroup is used instead.
-
- gnus-default-article-saver
-    Specifies your favorite article saver which is interactively
-    funcallable.  Following functions are available:
-
-	gnus-summary-save-in-rmail (in Rmail format)
-	gnus-summary-save-in-mail (in Unix mail format)
-	gnus-summary-save-in-folder (in MH folder)
-	gnus-summary-save-in-file (in article format).
-
- gnus-rmail-save-name
- gnus-mail-save-name
- gnus-folder-save-name
- gnus-file-save-name
-    Specifies a function generating a file name to save articles in
-    specified format.  The function is called with NEWSGROUP, HEADERS,
-    and optional LAST-FILE.  Access macros to the headers are defined
-    as `nntp-header-FIELD', and functions are defined as
-    `gnus-header-FIELD'.
-
- gnus-article-save-directory
-    Specifies a directory name to save articles to using the commands
-    `gnus-summary-save-in-rmail', `gnus-summary-save-in-mail' and
-    `gnus-summary-save-in-file'.  The variable is initialized from the
-    SAVEDIR environment variable.
-
- gnus-kill-files-directory
-    Specifies a directory name to save KILL files to using the commands
-    `gnus-edit-global-kill', and `gnus-edit-local-kill'.  The variable is
-    initialized from the SAVEDIR environment variable.
-
- gnus-show-all-headers
-    Non-nil means that all headers of an article are shown.
-
- gnus-save-all-headers
-    Non-nil means that all headers of an article are saved in a file.
-
- gnus-show-mime
-    Non-nil means that show a MIME message.
-
- gnus-show-threads
-    Non-nil means that conversation threads are shown in tree structure.
-
- gnus-thread-hide-subject
-    Non-nil means that subjects for thread subtrees are hidden.
-
- gnus-thread-hide-subtree
-    Non-nil means that thread subtrees are hidden initially.
-
- gnus-thread-hide-killed
-    Non-nil means that killed thread subtrees are hidden automatically.
-
- gnus-thread-ignore-subject
-    Non-nil means that subject differences are ignored in constructing
-    thread trees.
-
- gnus-thread-indent-level
-    Indentation of thread subtrees.
-
- gnus-optional-headers
-    Specifies a function which generates an optional string displayed
-    in the Summary buffer.  The function is called with an article
-    HEADERS.  The result must be a string excluding `[' and `]'.  The
-    default function returns a string like NNN:AUTHOR, where NNN is
-    the number of lines in an article and AUTHOR is the name of the
-    author.
-
- gnus-auto-extend-newsgroup
-    Non-nil means visible articles are extended to forward and
-    backward automatically if possible.
-
- gnus-auto-select-first
-    Non-nil means the first unread article is selected automagically
-    when a newsgroup is selected normally (by `gnus-group-read-group').
-    If you'd like to prevent automatic selection of the first unread
-    article in some newsgroups, set the variable to nil in
-    `gnus-select-group-hook' or `gnus-apply-kill-hook'.
-
- gnus-auto-select-next
-    Non-nil means the next newsgroup is selected automagically at the
-    end of the newsgroup.  If the value is t and the next newsgroup is
-    empty (no unread articles), GNUS will exit Summary mode and go
-    back to Group mode.  If the value is neither nil nor t, GNUS won't
-    exit Summary mode but select the following unread newsgroup.
-    Especially, if the value is the symbol `quietly', the next unread
-    newsgroup will be selected without any confirmations.
-
- gnus-auto-select-same
-    Non-nil means an article with the same subject as the current
-    article is selected automagically like `rn -S'.
-
- gnus-auto-center-summary
-    Non-nil means the point of Summary Mode window is always kept
-    centered.
-
- gnus-break-pages
-    Non-nil means an article is broken into pages at page delimiters.
-    This may not work with some versions of GNU Emacs earlier than
-    version 18.50.
-
- gnus-page-delimiter
-    Specifies a regexp describing line-beginnings that separate pages
-    of news article.
-
- gnus-digest-show-summary
-    Non-nil means that a summary of digest messages is shown when
-    reading a digest article using `gnus-summary-rmail-digest'
-    command.
-
- gnus-digest-separator
-    Specifies a regexp separating messages in a digest article.
-
- gnus-mail-reply-method
- gnus-mail-other-window-method
-    Specifies a function to begin composing mail message using
-    commands `gnus-summary-reply' and `gnus-summary-mail-other-window'.
-    Functions `gnus-mail-reply-using-mail' and `gnus-mail-reply-using-mhe'
-    are available for the value of `gnus-mail-reply-method'.  And
-    functions `gnus-mail-other-window-using-mail' and
-    `gnus-mail-other-window-using-mhe' are available for the value of
-    `gnus-mail-other-window-method'.
-
- gnus-mail-send-method
-    Specifies a function to mail a message too which is being posted
-    as an article.  The message must have To: or Cc: field.  The value
-    of the variable `send-mail-function' is the default function, which
-    uses sendmail mail program.
-
-Various hooks for customization:
- gnus-summary-mode-hook
-    Entry to this mode calls the value with no arguments, if that
-    value is non-nil.
-
- gnus-select-group-hook
-    Called with no arguments when newsgroup is selected, if that value
-    is non-nil.  It is possible to sort subjects in this hook.  See the
-    documentation of this variable for more information.
-
- gnus-summary-prepare-hook
-    Called with no arguments after a summary list is created in the
-    Summary buffer, if that value is non-nil.  If you'd like to modify
-    the buffer, you can use this hook.
-
- gnus-select-article-hook
-    Called with no arguments when an article is selected, if that
-    value is non-nil.  See the documentation of this variable for more
-    information.
-
- gnus-select-digest-hook
-    Called with no arguments when reading digest messages using Rmail,
-    if that value is non-nil.  This hook can be used to modify an
-    article so that Rmail can work with it.  See the documentation of
-    the variable for more information.
-
- gnus-rmail-digest-hook
-    Called with no arguments when reading digest messages using Rmail,
-    if that value is non-nil.  This hook is intended to customize Rmail
-    mode.
-
- gnus-apply-kill-hook
-    Called with no arguments when a newsgroup is selected and the
-    Summary buffer is prepared.  This hook is intended to apply a KILL
-    file to the selected newsgroup.  The format of KILL file is
-    completely different from that of version 3.8.  You have to rewrite
-    them in the new format.  See the documentation of Kill file mode
-    for more information.
-
- gnus-mark-article-hook
-    Called with no arguments when an article is selected at the first
-    time.  The hook is intended to mark an article as read (or unread)
-    automatically when it is selected.  See the documentation of the
-    variable for more information.
-
- gnus-exit-group-hook
-    Called with no arguments when exiting the current newsgroup, if
-    that value is non-nil.  If your machine is so slow that exiting
-    from Summary mode takes very long time, inhibit marking articles
-    as read using cross-references by setting the variable
-    gnus-use-cross-reference to nil in this hook."
-  (interactive)
-  (kill-all-local-variables)
-  ;; Gee.  Why don't you upgrade?
-  (cond ((boundp 'mode-line-modified)
-	 (setq mode-line-modified "--- "))
-	((listp (default-value 'mode-line-format))
-	 (setq mode-line-format
-	       (cons "--- " (cdr (default-value 'mode-line-format))))))
-  ;; To disable display-time facility.
-  ;;(make-local-variable 'global-mode-string)
-  ;;(setq global-mode-string nil)
-  (setq major-mode 'gnus-summary-mode)
-  (setq mode-name "Summary")
-  ;;(setq mode-line-process '(" " gnus-newsgroup-name))
-  (make-local-variable 'minor-mode-alist)
-  (or (assq 'gnus-show-threads minor-mode-alist)
-      (setq minor-mode-alist
-	    (cons (list 'gnus-show-threads " Thread") minor-mode-alist)))
-  (gnus-summary-set-mode-line)
-  (use-local-map gnus-summary-mode-map)
-  (buffer-flush-undo (current-buffer))
-  (setq buffer-read-only t)		;Disable modification
-  (setq truncate-lines t)		;Stop line folding
-  (setq selective-display t)
-  (setq selective-display-ellipses t)	;Display `...'
-  ;;(setq case-fold-search t)
-  (run-hooks 'gnus-summary-mode-hook))
-
-(defun gnus-mouse-pick-article (e)
-  (interactive "e")
-  (mouse-set-point e)
-  (gnus-summary-next-page nil))
-
-(defun gnus-summary-setup-buffer ()
-  "Initialize Summary buffer."
-  (if (get-buffer gnus-summary-buffer)
-      (set-buffer gnus-summary-buffer)
-    (set-buffer (get-buffer-create gnus-summary-buffer))
-    (gnus-summary-mode)
-    ))
-
-(defun gnus-summary-read-group (group &optional show-all no-article)
-  "Start reading news in newsgroup GROUP.
-If optional 1st argument SHOW-ALL is non-nil, already read articles are
-also listed.
-If optional 2nd argument NO-ARTICLE is non-nil, no article is selected
-initially."
-  (message "Retrieving newsgroup: %s..." group)
-  (if (gnus-select-newsgroup group show-all)
-      (progn
-	;; Don't switch-to-buffer to prevent displaying old contents
-	;;  of the buffer until new subjects list is created.
-	;; Suggested by Juha Heinanen <jh@tut.fi>
-	(gnus-summary-setup-buffer)
-	;; You can change the order of subjects in this hook.
-	(run-hooks 'gnus-select-group-hook)
-	(gnus-summary-prepare)
-	;; Function `gnus-apply-kill-file' must be called in this hook.
-	(run-hooks 'gnus-apply-kill-hook)
-	(if (zerop (buffer-size))
-	    ;; This newsgroup is empty.
-	    (progn
-	      (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
-	      (message "No unread news"))
-	  ;; Hide conversation thread subtrees.  We cannot do this in
-	  ;; gnus-summary-prepare-hook since kill processing may not
-	  ;; work with hidden articles.
-	  (and gnus-show-threads
-	       gnus-thread-hide-subtree
-	       (gnus-summary-hide-all-threads))
-	  ;; Show first unread article if requested.
-	  (goto-char (point-min))
-	  (if (and (not no-article)
-		   gnus-auto-select-first
-		   (gnus-summary-first-unread-article))
-	      ;; Window is configured automatically.
-	      ;; Current buffer may be changed as a result of hook
-	      ;; evaluation, especially by gnus-summary-rmail-digest
-	      ;; command, so we should adjust cursor point carefully.
-	      (if (eq (current-buffer) (get-buffer gnus-summary-buffer))
-		  (progn
-		    ;; Adjust cursor point.
-		    (beginning-of-line)
-		    (search-forward ":" nil t)))
-	    (gnus-configure-windows 'summary)
-	    (pop-to-buffer gnus-summary-buffer)
-	    (gnus-summary-set-mode-line)
-	    ;; I sometime get confused with the old Article buffer.
-	    (if (get-buffer gnus-article-buffer)
-		(if (get-buffer-window gnus-article-buffer)
-		    (save-excursion
-		      (set-buffer gnus-article-buffer)
-		      (let ((buffer-read-only nil))
-			(erase-buffer)))
-		  (kill-buffer gnus-article-buffer)))
-	    ;; Adjust cursor point.
-	    (beginning-of-line)
-	    (search-forward ":" nil t))
-	  ))
-    ;; Cannot select newsgroup GROUP.
-    (if (gnus-gethash group gnus-active-hashtb)
-	(progn
-	  ;; If NNTP is used, nntp_access file may not be installed
-	  ;; properly.  Otherwise, may be active file problem.
-	  (ding)
-	  (message
-	   (gnus-nntp-message
-	    (format "Cannot select %s.  May be security or active file problem." group)))
-	  (sit-for 0))
-      ;; Check bogus newsgroups.
-      ;; We must be in Group Mode buffer.
-      (gnus-group-check-bogus-groups))
-    ))
-
-(defun gnus-summary-prepare ()
-  "Prepare summary list of current newsgroup in Summary buffer."
-  (let ((buffer-read-only nil))
-    ;; Note: The next codes are not actually used because the user who
-    ;; want it can define them in gnus-select-group-hook.
-    ;; Print verbose messages if too many articles are selected.
-    ;;    (and (numberp gnus-large-newsgroup)
-    ;;       (> (length gnus-newsgroup-headers) gnus-large-newsgroup)
-    ;;       (message "Preparing headers..."))
-    (erase-buffer)
-    (gnus-summary-prepare-threads
-     (if gnus-show-threads
-	 (gnus-make-threads gnus-newsgroup-headers)
-       gnus-newsgroup-headers) 0)
-    ;; Erase header retrieval message.
-    (message "")
-    ;; Call hooks for modifying Summary buffer.
-    ;; Suggested by sven@tde.LTH.Se (Sven Mattisson).
-    (goto-char (point-min))
-    (run-hooks 'gnus-summary-prepare-hook)
-    ))
-
-;; Basic ideas by Paul Dworkin <paul@media-lab.media.mit.edu>
-;; Subject bug fix by jbw@bigbird.bu.edu (Joe Wells)
-
-(defun gnus-summary-prepare-threads (threads level &optional parent-subject)
-  "Prepare Summary buffer from THREADS and indentation LEVEL.
-THREADS is a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...]).'
-Optional PARENT-SUBJECT specifies the subject of the parent."
-  (let ((thread nil)
-	(header nil)
-	(number nil)
-	(subject nil)
-	(child-subject nil)
-	(parent-subject (or parent-subject ""))
-	;; `M Indent NUM: [OPT] SUBJECT'
-	(cntl (format "%%s %%s%%%dd: [%%s] %%s\n"
-		      (length (prin1-to-string gnus-newsgroup-end)))))
-    (while threads
-      (setq thread (car threads))
-      (setq threads (cdr threads))
-      ;; If thread is a cons, hierarchical threads is given.
-      ;; Otherwise, thread itself is header.
-      (if (consp thread)
-	  (setq header (car thread))
-	(setq header thread))
-      ;; Print valid header only.
-      (if (vectorp header)		;Depends on nntp.el.
-	  (progn
-	    (setq number (nntp-header-number header))
-	    (setq subject (nntp-header-subject header))
-	    (setq child-subject (gnus-simplify-subject subject 're-only))
-	    (insert
-	     (format cntl
-		     ;; Read or not.
-		     (cond ((memq number gnus-newsgroup-marked)  "-")
-			   ((memq number gnus-newsgroup-unreads) " ")
-			   (t "D"))
-		     ;; Thread level.
-		     (make-string (* level gnus-thread-indent-level) ? )
-		     ;; Article number.
-		     number
-		     ;; Optional headers.
-		     (or (and gnus-optional-headers
-			      (funcall gnus-optional-headers header)) "")
-		     ;; Its subject string.
-		     (concat (if (or (zerop level)
-				     (not gnus-thread-hide-subject)
-				     ;; Subject is different from the parent.
-				     (not (string-equal
-					   parent-subject child-subject)))
-				 nil
-			       (make-string (window-width) ? ))
-			     subject)
-		     ))
-	    ))
-      ;; Print subthreads.
-      (and (consp thread)
-	   (cdr thread)
-	   (gnus-summary-prepare-threads
-	    (cdr thread) (1+ level) child-subject))
-      )))
-
-;;(defun gnus-summary-set-mode-line ()
-;;  "Set Summary mode line string."
-;;  ;; The value must be a string to escape %-constructs.
-;;  (let ((subject
-;;	 (if gnus-current-headers
-;;	     (nntp-header-subject gnus-current-headers) gnus-newsgroup-name)))
-;;    (setq mode-line-buffer-identification
-;;	  (concat "GNUS: "
-;;		  subject
-;;		  ;; Enough spaces to pad subject to 17 positions.
-;;		  (make-string (max 0 (- 17 (length subject))) ? ))))
-;;  (set-buffer-modified-p t))
-
-;; New implementation in gnus 3.14.3
-
-(defun gnus-summary-set-mode-line ()
-  "Set Summary mode line string.
-If you don't like it, define your own `gnus-summary-set-mode-line'."
-  (let ((unmarked
-	 (- (length gnus-newsgroup-unreads)
-	    (length (gnus-intersection
-		     gnus-newsgroup-unreads gnus-newsgroup-marked))))
-	(unselected
-	 (- (length gnus-newsgroup-unselected)
-	    (length (gnus-intersection
-		     gnus-newsgroup-unselected gnus-newsgroup-marked)))))
-    (setq mode-line-buffer-identification
-	  (list 17
-		(format "GNUS: %s%s %s"
-			gnus-newsgroup-name
-			(if gnus-current-article
-			    (format "/%d" gnus-current-article) "")
-			;; Basic ideas by tale@pawl.rpi.edu.
-			(cond ((and (zerop unmarked)
-				    (zerop unselected))
-			       "")
-			      ((zerop unselected)
-			       (format "{%d more}" unmarked))
-			      (t
-			       (format "{%d(+%d) more}" unmarked unselected)))
-			))))
-  (set-buffer-modified-p t))
-
-;; GNUS Summary mode command.
-
-(defun gnus-summary-search-group (&optional backward)
-  "Search for next unread newsgroup.
-If optional argument BACKWARD is non-nil, search backward instead."
-  (save-excursion
-    (set-buffer gnus-group-buffer)
-    (save-excursion
-      ;; We don't want to alter current point of Group mode buffer.
-      (if (gnus-group-search-forward backward nil)
-	  (gnus-group-group-name))
-      )))
-
-(defun gnus-summary-search-subject (backward unread subject)
-  "Search for article forward.
-If 1st argument BACKWARD is non-nil, search backward.
-If 2nd argument UNREAD is non-nil, only unread article is selected.
-If 3rd argument SUBJECT is non-nil, the article which has
-the same subject will be searched for."
-  (let ((func
-	 (if backward
-	     (function re-search-backward) (function re-search-forward)))
-	(article nil)
-	;; We have to take care of hidden lines.
-	(regexp 
-	 (format "^%s[ \t]+\\([0-9]+\\):.\\[[^]\r\n]*\\][ \t]+%s"
-		 ;;(if unread " " ".")
-		 (cond ((eq unread t) " ") (unread "[- ]") (t "."))
-		 (if subject
-		     (concat "\\([Rr][Ee]:[ \t]+\\)*"
-			     (regexp-quote (gnus-simplify-subject subject))
-			     ;; Ignore words in parentheses.
-			     "\\([ \t]*([^\r\n]*)\\)*[ \t]*\\(\r\\|$\\)")
-		   "")
-		 )))
-    (if backward
-	(beginning-of-line)
-      (end-of-line))
-    (if (funcall func regexp nil t)
-	(setq article
-	      (string-to-int
-	       (buffer-substring (match-beginning 1) (match-end 1)))))
-    ;; Adjust cursor point.
-    (beginning-of-line)
-    (search-forward ":" nil t)
-    ;; This is the result.
-    article
-    ))
-
-(defun gnus-summary-search-forward (&optional unread subject)
-  "Search for article forward.
-If 1st optional argument UNREAD is non-nil, only unread article is selected.
-If 2nd optional argument SUBJECT is non-nil, the article which has
-the same subject will be searched for."
-  (gnus-summary-search-subject nil unread subject))
-
-(defun gnus-summary-search-backward (&optional unread subject)
-  "Search for article backward.
-If 1st optional argument UNREAD is non-nil, only unread article is selected.
-If 2nd optional argument SUBJECT is non-nil, the article which has
-the same subject will be searched for."
-  (gnus-summary-search-subject t unread subject))
-
-(defun gnus-summary-article-number ()
-  "Return the Article number around point.
-If none, return current article number."
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at ".[ \t]+\\([0-9]+\\):")
-	(string-to-int
-	 (buffer-substring (match-beginning 1) (match-end 1)))
-      ;; If search fail, return current article number.
-      gnus-current-article
-      )))
-
-(defun gnus-summary-subject-string ()
-  "Return current subject string or nil if nothing."
-  (save-excursion
-    ;; It is possible to implement this function using
-    ;;  `gnus-summary-article-number' and `gnus-newsgroup-headers'.
-    (beginning-of-line)
-    ;; We have to take care of hidden lines.
-    (if (looking-at ".[ \t]+[0-9]+:.\\[[^]\r\n]*\\][ \t]+\\([^\r\n]*\\)[\r\n]")
-	(buffer-substring (match-beginning 1) (match-end 1)))
-    ))
-
-(defun gnus-summary-goto-subject (article)
-  "Move point to ARTICLE's subject."
-  (interactive
-   (list
-    (string-to-int
-     (completing-read "Article number: "
-		      (mapcar
-		       (function
-			(lambda (headers)
-			  (list
-			   (int-to-string (nntp-header-number headers)))))
-		       gnus-newsgroup-headers)
-		      nil 'require-match))))
-  (let ((current (point)))
-    (goto-char (point-min))
-    (or (and article (re-search-forward (format "^.[ \t]+%d:" article) nil t))
-	(progn (goto-char current) nil))
-    ))
-
-(defun gnus-summary-recenter ()
-  "Center point in Summary window."
-  ;; Scroll window so as to cursor comes center of Summary window
-  ;;  only when article is displayed.
-  ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
-  ;; Recenter only when requested.
-  ;; Subbested by popovich@park.cs.columbia.edu
-  (and gnus-auto-center-summary
-       (get-buffer-window gnus-article-buffer)
-       (< (/ (- (window-height) 1) 2)
-	  (count-lines (point) (point-max)))
-       (recenter (/ (- (window-height) 2) 2))))
-
-;; Walking around Group mode buffer.
-
-(defun gnus-summary-jump-to-group (newsgroup)
-  "Move point to NEWSGROUP in Group mode buffer."
-  ;; Keep update point of Group mode buffer if visible.
-  (if (eq (current-buffer)
-	  (get-buffer gnus-group-buffer))
-      (save-window-excursion
-	;; Take care of tree window mode.
-	(if (get-buffer-window gnus-group-buffer)
-	    (pop-to-buffer gnus-group-buffer))
-	(gnus-group-jump-to-group newsgroup))
-    (save-excursion
-      ;; Take care of tree window mode.
-      (if (get-buffer-window gnus-group-buffer)
-	  (pop-to-buffer gnus-group-buffer)
-	(set-buffer gnus-group-buffer))
-      (gnus-group-jump-to-group newsgroup))))
-
-(defun gnus-summary-next-group (no-article)
-  "Exit current newsgroup and then select next unread newsgroup.
-If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
-  (interactive "P")
-  ;; Make sure Group mode buffer point is on current newsgroup.
-  (gnus-summary-jump-to-group gnus-newsgroup-name)
-  (let ((group (gnus-summary-search-group)))
-    (if (null group)
-	(progn
-	  (message "Exiting %s..." gnus-newsgroup-name)  
-	  (gnus-summary-exit)
-	  (message ""))
-      (message "Selecting %s..." group)
-      (gnus-summary-exit t)		;Exit Summary mode temporary.
-      ;; We are now in Group mode buffer.
-      ;; Make sure Group mode buffer point is on GROUP.
-      (gnus-summary-jump-to-group group)
-      (gnus-summary-read-group group nil no-article)
-      (or (eq (current-buffer)
-	      (get-buffer gnus-summary-buffer))
-	  (eq gnus-auto-select-next t)
-	  ;; Expected newsgroup has nothing to read since the articles
-	  ;; are marked as read by cross-referencing.  So, try next
-	  ;; newsgroup.  (Make sure we are in Group mode buffer now.)
-	  (and (eq (current-buffer)
-		   (get-buffer gnus-group-buffer))
-	       (gnus-group-group-name)
-	       (gnus-summary-read-group
-		(gnus-group-group-name) nil no-article))
-	  )
-      )))
-
-(defun gnus-summary-prev-group (no-article)
-  "Exit current newsgroup and then select previous unread newsgroup.
-If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
-  (interactive "P")
-  ;; Make sure Group mode buffer point is on current newsgroup.
-  (gnus-summary-jump-to-group gnus-newsgroup-name)
-  (let ((group (gnus-summary-search-group t)))
-    (if (null group)
-	(progn
-	  (message "Exiting %s..." gnus-newsgroup-name)  
-	  (gnus-summary-exit)
-	  (message ""))
-      (message "Selecting %s..." group)
-      (gnus-summary-exit t)		;Exit Summary mode temporary.
-      ;; We are now in Group mode buffer.
-      ;; We have to adjust point of Group mode buffer because current
-      ;; point is moved to next unread newsgroup by exiting.
-      (gnus-summary-jump-to-group group)
-      (gnus-summary-read-group group nil no-article)
-      (or (eq (current-buffer)
-	      (get-buffer gnus-summary-buffer))
-	  (eq gnus-auto-select-next t)
-	  ;; Expected newsgroup has nothing to read since the articles
-	  ;; are marked as read by cross-referencing.  So, try next
-	  ;; newsgroup.  (Make sure we are in Group mode buffer now.)
-	  (and (eq (current-buffer)
-		   (get-buffer gnus-group-buffer))
-	       (gnus-summary-search-group t)
-	       (gnus-summary-read-group
-		(gnus-summary-search-group t) nil no-article))
-	  )
-      )))
-
-;; Walking around summary lines.
-
-(defun gnus-summary-next-subject (n &optional unread)
-  "Go to Nth following summary line.
-If optional argument UNREAD is non-nil, only unread article is selected."
-  (interactive "p")
-  (while (and (> n 1)
-	      (gnus-summary-search-forward unread))
-    (setq n (1- n)))
-  (cond ((gnus-summary-search-forward unread)
-	 (gnus-summary-recenter))
-	(unread
-	 (message "No more unread articles"))
-	(t
-	 (message "No more articles"))
-	))
-
-(defun gnus-summary-next-unread-subject (n)
-  "Go to Nth following unread summary line."
-  (interactive "p")
-  (gnus-summary-next-subject n t))
-
-(defun gnus-summary-prev-subject (n &optional unread)
-  "Go to Nth previous summary line.
-If optional argument UNREAD is non-nil, only unread article is selected."
-  (interactive "p")
-  (while (and (> n 1)
-	      (gnus-summary-search-backward unread))
-    (setq n (1- n)))
-  (cond ((gnus-summary-search-backward unread)
-	 (gnus-summary-recenter))
-	(unread
-	 (message "No more unread articles"))
-	(t
-	 (message "No more articles"))
-	))
-
-(defun gnus-summary-prev-unread-subject (n)
-  "Go to Nth previous unread summary line."
-  (interactive "p")
-  (gnus-summary-prev-subject n t))
-
-;; Walking around summary lines with displaying articles.
-
-(defun gnus-summary-expand-window ()
-  "Expand Summary window to show headers full window."
-  (interactive)
-  (gnus-configure-windows 'summary)
-  (pop-to-buffer gnus-summary-buffer))
-
-(defun gnus-summary-display-article (article &optional all-header)
-  "Display ARTICLE in Article buffer."
-  (if (null article)
-      nil
-    (gnus-configure-windows 'article)
-    (pop-to-buffer gnus-summary-buffer)
-    (gnus-article-prepare article all-header)
-    (gnus-summary-recenter)
-    (gnus-summary-set-mode-line)
-    (run-hooks 'gnus-select-article-hook)
-    ;; Successfully display article.
-    t
-    ))
-
-(defun gnus-summary-select-article (&optional all-headers force)
-  "Select the current article.
-Optional first argument ALL-HEADERS is non-nil, show all header fields.
-Optional second argument FORCE is nil, the article is only selected
-again when current header does not match with ALL-HEADERS option."
-  (let ((article (gnus-summary-article-number))
-	(all-headers (not (not all-headers)))) ;Must be T or NIL.
-    (if (or (null gnus-current-article)
-	    (/= article gnus-current-article)
-	    (and force (not (eq all-headers gnus-have-all-headers))))
-	;; The selected one is different from that of the current article.
-	(gnus-summary-display-article article all-headers)
-      (gnus-configure-windows 'article)
-      (pop-to-buffer gnus-summary-buffer))
-    ))
-
-(defun gnus-summary-set-current-mark (&optional current-mark)
-  "Put `+' at the current article.
-Optional argument specifies CURRENT-MARK instead of `+'."
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
-    (let ((buffer-read-only nil))
-      (goto-char (point-min))
-      ;; First of all clear mark at last article.
-      (if (re-search-forward "^.[ \t]+[0-9]+:[^ \t]" nil t)
-	  (progn
-	    (delete-char -1)
-	    (insert " ")
-	    (goto-char (point-min))))
-      (if (re-search-forward (format "^.[ \t]+%d:" gnus-current-article) nil t)
-	  (progn
-	    (delete-char 1)
-	    (insert (or current-mark "+"))))
-      )))
-
-;;(defun gnus-summary-next-article (unread &optional subject)
-;;  "Select article after current one.
-;;If argument UNREAD is non-nil, only unread article is selected."
-;;  (interactive "P")
-;;  (cond ((gnus-summary-display-article
-;;	  (gnus-summary-search-forward unread subject)))
-;;	(unread
-;;	 (message "No more unread articles"))
-;;	(t
-;;	 (message "No more articles"))
-;;	))
-
-(defun gnus-summary-next-article (unread &optional subject)
-  "Select article after current one.
-If argument UNREAD is non-nil, only unread article is selected."
-  (interactive "P")
-  (let ((header nil))
-    (cond ((gnus-summary-display-article
-	    (gnus-summary-search-forward unread subject)))
-	  ((and subject
-		gnus-auto-select-same
-		(gnus-set-difference gnus-newsgroup-unreads
-				     gnus-newsgroup-marked)
-		(memq this-command
-		      '(gnus-summary-next-unread-article
-			gnus-summary-next-page
-			gnus-summary-kill-same-subject-and-select
-			;;gnus-summary-next-article
-			;;gnus-summary-next-same-subject
-			;;gnus-summary-next-unread-same-subject
-			)))
-	   ;; Wrap article pointer if there are unread articles.
-	   ;; Hook function, such as gnus-summary-rmail-digest, may
-	   ;; change current buffer, so need check.
-	   (let ((buffer (current-buffer))
-		 (last-point (point)))
-	     ;; No more articles with same subject, so jump to the first
-	     ;; unread article.
-	     (gnus-summary-first-unread-article)
-	     ;;(and (eq buffer (current-buffer))
-	     ;;	(= (point) last-point)
-	     ;;	;; Ignore given SUBJECT, and try again.
-	     ;;	(gnus-summary-next-article unread nil))
-	     (and (eq buffer (current-buffer))
-		  (< (point) last-point)
-		  (message "Wrapped"))
-	     ))
-	  ((and gnus-auto-extend-newsgroup
-		(not unread)		;Not unread only
-		(not subject)		;Only if subject is not specified.
-		(setq header (gnus-more-header-forward)))
-	   ;; Extend to next article if possible.
-	   ;; Basic ideas by himacdonald@watdragon.waterloo.edu
-	   (gnus-extend-newsgroup header nil)
-	   ;; Threads feature must be turned off.
-	   (let ((buffer-read-only nil))
-	     (goto-char (point-max))
-	     (gnus-summary-prepare-threads (list header) 0))
-	   (gnus-summary-goto-article gnus-newsgroup-end))
-	  (t
-	   ;; Select next newsgroup automatically if requested.
-	   (let ((cmd (aref (this-command-keys) 0))
-		 (group (gnus-summary-search-group))
-		 (auto-select
-		  (and gnus-auto-select-next
-		       ;;(null (gnus-set-difference gnus-newsgroup-unreads
-		       ;;				gnus-newsgroup-marked))
-		       (memq this-command
-			     '(gnus-summary-next-unread-article
-			       gnus-summary-next-article
-			       gnus-summary-next-page
-			       gnus-summary-next-same-subject
-			       gnus-summary-next-unread-same-subject
-			       gnus-summary-kill-same-subject
-			       gnus-summary-kill-same-subject-and-select
-			       ))
-		       ;; Ignore characters typed ahead.
-		       (not (input-pending-p))
-		       )))
-	     ;; Keep just the event type of CMD.
-	     (if (listp cmd)
-		 (setq cmd (car cmd)))
-	     (message "No more%s articles%s"
-		      (if unread " unread" "")
-		      (if (and auto-select
-			       (not (eq gnus-auto-select-next 'quietly)))
-			  (if group
-			      (format " (Type %s for %s [%d])"
-				      (single-key-description cmd)
-				      group
-				      (nth 1 (gnus-gethash group
-							   gnus-unread-hashtb)))
-			    (format " (Type %s to exit %s)"
-				    (single-key-description cmd)
-				    gnus-newsgroup-name))
-			""))
-	     ;; Select next unread newsgroup automagically.
-	     (cond ((and auto-select
-			 (eq gnus-auto-select-next 'quietly))
-		    ;; Select quietly.
-		    (gnus-summary-next-group nil))
-		   (auto-select
-		    ;; Confirm auto selection.
-		    (let* ((event (read-event))
-			   (type
-			    (if (listp event)
-				(car event)
-			      event)))
-		      (if (and (eq event type) (eq event cmd))
-			  (gnus-summary-next-group nil)
-			(setq unread-command-events (list event)))))
-		   )
-	     ))
-	  )))
-
-(defun gnus-summary-next-unread-article ()
-  "Select unread article after current one."
-  (interactive)
-  (gnus-summary-next-article t (and gnus-auto-select-same
-				    (gnus-summary-subject-string))))
-
-(defun gnus-summary-prev-article (unread &optional subject)
-  "Select article before current one.
-If argument UNREAD is non-nil, only unread article is selected."
-  (interactive "P")
-  (let ((header nil))
-    (cond ((gnus-summary-display-article
-	    (gnus-summary-search-backward unread subject)))
-	  ((and subject
-		gnus-auto-select-same
-		(gnus-set-difference gnus-newsgroup-unreads
-				     gnus-newsgroup-marked)
-		(memq this-command
-		      '(gnus-summary-prev-unread-article
-			;;gnus-summary-prev-page
-			;;gnus-summary-prev-article
-			;;gnus-summary-prev-same-subject
-			;;gnus-summary-prev-unread-same-subject
-			)))
-	   ;; Ignore given SUBJECT, and try again.
-	   (gnus-summary-prev-article unread nil))
-	  (unread
-	   (message "No more unread articles"))
-	  ((and gnus-auto-extend-newsgroup
-		(not subject)		;Only if subject is not specified.
-		(setq header (gnus-more-header-backward)))
-	   ;; Extend to previous article if possible.
-	   ;; Basic ideas by himacdonald@watdragon.waterloo.edu
-	   (gnus-extend-newsgroup header t)
-	   (let ((buffer-read-only nil))
-	     (goto-char (point-min))
-	     (gnus-summary-prepare-threads (list header) 0))
-	   (gnus-summary-goto-article gnus-newsgroup-begin))
-	  (t
-	   (message "No more articles"))
-	  )))
-
-(defun gnus-summary-prev-unread-article ()
-  "Select unread article before current one."
-  (interactive)
-  (gnus-summary-prev-article t (and gnus-auto-select-same
-				    (gnus-summary-subject-string))))
-
-(defun gnus-summary-next-page (lines)
-  "Show next page of selected article.
-If end of article, select next article.
-Argument LINES specifies lines to be scrolled up."
-  (interactive "P")
-  (let ((article (gnus-summary-article-number))
-	(endp nil))
-    (if (or (null gnus-current-article)
-	    (/= article gnus-current-article))
-	;; Selected subject is different from current article's.
-	(gnus-summary-display-article article)
-      (gnus-configure-windows 'article)
-      (pop-to-buffer gnus-summary-buffer)
-      (gnus-eval-in-buffer-window gnus-article-buffer
-	(setq endp (gnus-article-next-page lines)))
-      (cond ((and endp lines)
-	     (message "End of message"))
-	    ((and endp (null lines))
-	     (gnus-summary-next-unread-article)))
-      )))
-
-(defun gnus-summary-prev-page (lines)
-  "Show previous page of selected article.
-Argument LINES specifies lines to be scrolled down."
-  (interactive "P")
-  (let ((article (gnus-summary-article-number)))
-    (if (or (null gnus-current-article)
-	    (/= article gnus-current-article))
-	;; Selected subject is different from current article's.
-	(gnus-summary-display-article article)
-      (gnus-configure-windows 'article)
-      (pop-to-buffer gnus-summary-buffer)
-      (gnus-eval-in-buffer-window gnus-article-buffer
-	(gnus-article-prev-page lines))
-      )))
-
-(defun gnus-summary-scroll-up (lines)
-  "Scroll up (or down) one line current article.
-Argument LINES specifies lines to be scrolled up (or down if negative)."
-  (interactive "p")
-  (gnus-summary-select-article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (cond ((> lines 0)
-	   (if (gnus-article-next-page lines)
-	       (message "End of message")))
-	  ((< lines 0)
-	   (gnus-article-prev-page (- 0 lines))))
-    ))
-
-(defun gnus-summary-next-same-subject ()
-  "Select next article which has the same subject as current one."
-  (interactive)
-  (gnus-summary-next-article nil (gnus-summary-subject-string)))
-
-(defun gnus-summary-prev-same-subject ()
-  "Select previous article which has the same subject as current one."
-  (interactive)
-  (gnus-summary-prev-article nil (gnus-summary-subject-string)))
-
-(defun gnus-summary-next-unread-same-subject ()
-  "Select next unread article which has the same subject as current one."
-  (interactive)
-  (gnus-summary-next-article t (gnus-summary-subject-string)))
-
-(defun gnus-summary-prev-unread-same-subject ()
-  "Select previous unread article which has the same subject as current one."
-  (interactive)
-  (gnus-summary-prev-article t (gnus-summary-subject-string)))
-
-(defun gnus-summary-refer-parent-article (child)
-  "Refer parent article of current article.
-If a prefix argument CHILD is non-nil, go back to the child article
-using internally maintained articles history.
-NOTE: This command may not work with `nnspool.el'."
-  (interactive "P")
-  (gnus-summary-select-article t t)	;Request all headers.
-  (let ((referenced-id nil))		;Message-id of parent or child article.
-    (if child
-	;; Go back to child article using history.
-	(gnus-summary-refer-article nil)
-      (gnus-eval-in-buffer-window gnus-article-buffer
-	;; Look for parent Message-ID.
-	;; We cannot use gnus-current-headers to get references
-	;; because we may be looking at parent or referred article.
-	(let ((references (gnus-fetch-field "References")))
-	  ;; Get the last message-id in the references.
-	  (and references
-	       (string-match "\\(<[^<>]+>\\)[^>]*\\'" references)
-	       (setq referenced-id
-		     (substring references
-				(match-beginning 1) (match-end 1))))
-	  ))
-      (if (stringp referenced-id)
-	  (gnus-summary-refer-article referenced-id)
-	(error "No more parents"))
-      )))
-
-(defun gnus-summary-refer-article (message-id)
-  "Refer article specified by MESSAGE-ID.
-If the MESSAGE-ID is nil or an empty string, Message-ID is poped from
-internally maintained articles history.
-NOTE: This command may not work with `nnspool.el' nor `mhspool.el'."
-  (interactive "sMessage-ID: ")
-  ;; Make sure that this command depends on the fact that article
-  ;; related information is not updated when an article is retrieved
-  ;; by Message-ID.
-  (gnus-summary-select-article t t)	;Request all headers.
-  (if (and (stringp message-id)
-	   (> (length message-id) 0))
-      (gnus-eval-in-buffer-window gnus-article-buffer
-	;; Construct the correct Message-ID if necessary.
-	;; Suggested by tale@pawl.rpi.edu.
-	(or (string-match "^<" message-id)
-	    (setq message-id (concat "<" message-id)))
-	(or (string-match ">$" message-id)
-	    (setq message-id (concat message-id ">")))
-	;; Push current message-id on history.
-	;; We cannot use gnus-current-headers to get current
-	;; message-id because we may be looking at parent or referred
-	;; article.
-	(let ((current (gnus-fetch-field "Message-ID")))
-	  (or (equal current message-id) ;Nothing to do.
-	      (equal current (car gnus-current-history))
-	      (setq gnus-current-history
-		    (cons current gnus-current-history)))
-	  ))
-    ;; Pop message-id from history.
-    (setq message-id (car gnus-current-history))
-    (setq gnus-current-history (cdr gnus-current-history)))
-  (if (stringp message-id)
-      ;; Retrieve article by message-id.  This may not work with
-      ;; nnspool nor mhspool.
-      (gnus-article-prepare message-id t)
-    (error "No such references"))
-  )
-
-(defun gnus-summary-next-digest (n)
-  "Move to head of Nth next digested message."
-  (interactive "p")
-  (gnus-summary-select-article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (gnus-article-next-digest (or n 1))
-    ))
-
-(defun gnus-summary-prev-digest (n)
-  "Move to head of Nth previous digested message."
-  (interactive "p")
-  (gnus-summary-select-article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (gnus-article-prev-digest (or n 1))))
-
-(defun gnus-summary-first-unread-article ()
-  "Select first unread article.  Return non-nil if successfully selected."
-  (interactive)
-  (let ((begin (point)))
-    (goto-char (point-min))
-    (if (re-search-forward "^ [ \t]+[0-9]+:" nil t)
-	(gnus-summary-display-article (gnus-summary-article-number))
-      ;; If there is no unread articles, stay there.
-      (goto-char begin)
-      ;;(gnus-summary-display-article (gnus-summary-article-number))
-      (message "No more unread articles")
-      nil
-      )
-    ))
-
-(defun gnus-summary-isearch-article ()
-  "Do incremental search forward on current article."
-  (interactive)
-  (gnus-summary-select-article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-			      (isearch-forward)))
-
-(defun gnus-summary-search-article-forward (regexp)
-  "Search for an article containing REGEXP forward.
-`gnus-select-article-hook' is not called for articles examined
-by searching search."
-  (interactive
-   (list (read-string
-	  (concat "Search forward (regexp): "
-		  (if gnus-last-search-regexp
-		      (concat "(default " gnus-last-search-regexp ") "))))))
-  (if (string-equal regexp "")
-      (setq regexp (or gnus-last-search-regexp ""))
-    (setq gnus-last-search-regexp regexp))
-  (if (gnus-summary-search-article regexp nil)
-      (gnus-eval-in-buffer-window gnus-article-buffer
-	(recenter 0)
-	;;(sit-for 1)
-	)
-    (error "Search failed: \"%s\"" regexp)
-    ))
-
-(defun gnus-summary-search-article-backward (regexp)
-  "Search for an article containing REGEXP backward.
-`gnus-select-article-hook' is not called for articles examined
-by searching search."
-  (interactive
-   (list (read-string
-	  (concat "Search backward (regexp): "
-		  (if gnus-last-search-regexp
-		      (concat "(default " gnus-last-search-regexp ") "))))))
-  (if (string-equal regexp "")
-      (setq regexp (or gnus-last-search-regexp ""))
-    (setq gnus-last-search-regexp regexp))
-  (if (gnus-summary-search-article regexp t)
-      (gnus-eval-in-buffer-window gnus-article-buffer
-	(recenter 0)
-	;;(sit-for 1)
-	)
-    (error "Search failed: \"%s\"" regexp)
-    ))
-
-(defun gnus-summary-search-article (regexp &optional backward)
-  "Search for an article containing REGEXP.
-Optional argument BACKWARD means do search for backward.
-`gnus-select-article-hook' is not called for articles examined
-by searching search."
-  (let ((gnus-select-article-hook nil)	;Disable hook.
-	(gnus-mark-article-hook nil)	;Inhibit marking as read.
-	(re-search
-	 (if backward
-	     (function re-search-backward) (function re-search-forward)))
-	(found nil)
-	(last nil))
-    ;; Hidden thread subtrees must be searched for ,too.
-    (gnus-summary-show-all-threads)
-    ;; First of all, search current article.
-    ;; We don't want to read article again from NNTP server nor reset
-    ;; current point.
-    (gnus-summary-select-article)
-    (message "Searching article: %d..." gnus-current-article)
-    (setq last gnus-current-article)
-    (gnus-eval-in-buffer-window gnus-article-buffer
-      (save-restriction
-	(widen)
-	;; Begin search from current point.
-	(setq found (funcall re-search regexp nil t))))
-    ;; Then search next articles.
-    (while (and (not found)
-		(gnus-summary-display-article 
-		 (gnus-summary-search-subject backward nil nil)))
-      (message "Searching article: %d..." gnus-current-article)
-      (gnus-eval-in-buffer-window gnus-article-buffer
-	(save-restriction
-	  (widen)
-	  (goto-char (if backward (point-max) (point-min)))
-	  (setq found (funcall re-search regexp nil t)))
-	))
-    (message "")
-    ;; Adjust article pointer.
-    (or (eq last gnus-current-article)
-	(setq gnus-last-article last))
-    ;; Return T if found such article.
-    found
-    ))
-
-(defun gnus-summary-execute-command (field regexp command &optional backward)
-  "If FIELD of article header matches REGEXP, execute a COMMAND string.
-If FIELD is an empty string (or nil), entire article body is searched for.
-If optional (prefix) argument BACKWARD is non-nil, do backward instead."
-  (interactive
-   (list (let ((completion-ignore-case t))
-	   (completing-read "Field name: "
-			    '(("Number")("Subject")("From")
-			      ("Lines")("Date")("Id")
-			      ("Xref")("References"))
-			    nil 'require-match))
-	 (read-string "Regexp: ")
-	 (read-key-sequence "Command: ")
-	 current-prefix-arg))
-  ;; Hidden thread subtrees must be searched for ,too.
-  (gnus-summary-show-all-threads)
-  ;; We don't want to change current point nor window configuration.
-  (save-excursion
-    (save-window-excursion
-      (message "Executing %s..." (key-description command))
-      ;; We'd like to execute COMMAND interactively so as to give arguments.
-      (gnus-execute field regexp
-		    (` (lambda ()
-			 (call-interactively '(, (key-binding command)))))
-		    backward)
-      (message "Executing %s...done" (key-description command)))))
-
-(defun gnus-summary-beginning-of-article ()
-  "Go to beginning of article body."
-  (interactive)
-  (gnus-summary-select-article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (widen)
-    (beginning-of-buffer)
-    (if gnus-break-pages
-	(gnus-narrow-to-page))
-    ))
-
-(defun gnus-summary-end-of-article ()
-  "Go to end of article body."
-  (interactive)
-  (gnus-summary-select-article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (widen)
-    (end-of-buffer)
-    (if gnus-break-pages
-	(gnus-narrow-to-page))
-    ))
-
-(defun gnus-summary-goto-article (article &optional all-headers)
-  "Read article number ARTICLE if it exists.
-Optional argument ALL-HEADERS means show the full header."
-  (interactive
-   (list
-    (string-to-int
-     (completing-read "Article number: "
-		      (mapcar
-		       (function
-			(lambda (headers)
-			  (list
-			   (int-to-string (nntp-header-number headers)))))
-		       gnus-newsgroup-headers)
-		      nil 'require-match))))
-  (if (gnus-summary-goto-subject article)
-      (gnus-summary-display-article article all-headers)))
-
-(defun gnus-summary-goto-last-article ()
-  "Go to last subject line."
-  (interactive)
-  (if gnus-last-article
-      (gnus-summary-goto-article gnus-last-article)))
-
-(defun gnus-summary-show-article ()
-  "Force to show current article."
-  (interactive)
-  ;; The following is a trick to force to read the current article again.
-  (setq gnus-have-all-headers (not gnus-have-all-headers))
-  (gnus-summary-select-article (not gnus-have-all-headers) t))
-
-(defun gnus-summary-toggle-header (arg)
-  "Show original header if pruned header currently shown, or vice versa.
-With arg, show original header iff arg is positive."
-  (interactive "P")
-  ;; Variable gnus-show-all-headers must be NIL to toggle really.
-  (let ((gnus-show-all-headers nil)
-	(all-headers
-	 (if (null arg) (not gnus-have-all-headers)
-	   (> (prefix-numeric-value arg) 0))))
-    (gnus-summary-select-article all-headers t)))
-
-(defun gnus-summary-show-all-headers ()
-  "Show original article header."
-  (interactive)
-  (gnus-summary-select-article t t))
-
-(defun gnus-summary-toggle-mime (arg)
-  "Toggle MIME processing.
-With arg, turn MIME processing on iff arg is positive."
-  (interactive "P")
-  (setq gnus-show-mime
-	(if (null arg) (not gnus-show-mime)
-	  (> (prefix-numeric-value arg) 0)))
-  ;; The following is a trick to force to read the current article again.
-  (setq gnus-have-all-headers (not gnus-have-all-headers))
-  (gnus-summary-select-article (not gnus-have-all-headers) t))
-
-(defun gnus-summary-stop-page-breaking ()
-  "Stop page breaking by linefeed temporary (widen article buffer)."
-  (interactive)
-  (gnus-summary-select-article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (widen)
-    ))
-
-(defun gnus-summary-kill-same-subject-and-select (unmark)
-  "Mark articles which has the same subject as read, and then select next.
-If argument UNMARK is positive, remove any kinds of marks.
-If argument UNMARK is negative, mark articles as unread instead."
-  (interactive "P")
-  (if unmark
-      (setq unmark (prefix-numeric-value unmark)))
-  (let ((count
-	 (gnus-summary-mark-same-subject
-	  (gnus-summary-subject-string) unmark)))
-    ;; Select next unread article.  If auto-select-same mode, should
-    ;; select the first unread article.
-    (gnus-summary-next-article t (and gnus-auto-select-same
-				      (gnus-summary-subject-string)))
-    (message "%d articles are marked as %s"
-	     count (if unmark "unread" "read"))
-    ))
-
-(defun gnus-summary-kill-same-subject (unmark)
-  "Mark articles which has the same subject as read. 
-If argument UNMARK is positive, remove any kinds of marks.
-If argument UNMARK is negative, mark articles as unread instead."
-  (interactive "P")
-  (if unmark
-      (setq unmark (prefix-numeric-value unmark)))
-  (let ((count
-	 (gnus-summary-mark-same-subject
-	  (gnus-summary-subject-string) unmark)))
-    ;; If marked as read, go to next unread subject.
-    (if (null unmark)
-	;; Go to next unread subject.
-	(gnus-summary-next-subject 1 t))
-    (message "%d articles are marked as %s"
-	     count (if unmark "unread" "read"))
-    ))
-
-(defun gnus-summary-mark-same-subject (subject &optional unmark)
-  "Mark articles with same SUBJECT as read, and return marked number.
-If optional argument UNMARK is positive, remove any kinds of marks.
-If optional argument UNMARK is negative, mark articles as unread instead."
-  (let ((count 1))
-    (save-excursion
-      (cond ((null unmark)
-	     (gnus-summary-mark-as-read nil "K"))
-	    ((> unmark 0)
-	     (gnus-summary-mark-as-unread nil t))
-	    (t
-	     (gnus-summary-mark-as-unread)))
-      (while (and subject
-		  (gnus-summary-search-forward nil subject))
-	(cond ((null unmark)
-	       (gnus-summary-mark-as-read nil "K"))
-	      ((> unmark 0)
-	       (gnus-summary-mark-as-unread nil t))
-	      (t
-	       (gnus-summary-mark-as-unread)))
-	(setq count (1+ count))
-	))
-    ;; Hide killed thread subtrees.  Does not work properly always.
-    ;;(and (null unmark)
-    ;;     gnus-thread-hide-killed
-    ;;	   (gnus-summary-hide-thread))
-    ;; Return number of articles marked as read.
-    count
-    ))
-
-(defun gnus-summary-mark-as-unread-forward (count)
-  "Mark current article as unread, and then go forward.
-Argument COUNT specifies number of articles marked as unread."
-  (interactive "p")
-  (while (> count 0)
-    (gnus-summary-mark-as-unread nil nil)
-    (gnus-summary-next-subject 1 nil)
-    (setq count (1- count))))
-
-(defun gnus-summary-mark-as-unread-backward (count)
-  "Mark current article as unread, and then go backward.
-Argument COUNT specifies number of articles marked as unread."
-  (interactive "p")
-  (while (> count 0)
-    (gnus-summary-mark-as-unread nil nil)
-    (gnus-summary-prev-subject 1 nil)
-    (setq count (1- count))))
-
-(defun gnus-summary-mark-as-unread (&optional article clear-mark)
-  "Mark current article as unread.
-Optional 1st argument ARTICLE specifies article number to be marked as unread.
-Optional 2nd argument CLEAR-MARK remove any kinds of mark."
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
-    ;; First of all, show hidden thread subtrees.
-    (gnus-summary-show-thread)
-    (let* ((buffer-read-only nil)
-	   (current (gnus-summary-article-number))
-	   (article (or article current)))
-      (gnus-mark-article-as-unread article clear-mark)
-      (if (or (eq article current)
-	      (gnus-summary-goto-subject article))
-	  (progn
-	    (beginning-of-line)
-	    (delete-char 1)
-	    (insert (if clear-mark " " "-"))))
-      )))
-
-(defun gnus-summary-mark-as-read-forward (count)
-  "Mark current article as read, and then go forward.
-Argument COUNT specifies number of articles marked as read."
-  (interactive "p")
-  (while (> count 0)
-    (gnus-summary-mark-as-read)
-    (gnus-summary-next-subject 1 'unread-only)
-    (setq count (1- count))))
-
-(defun gnus-summary-mark-as-read-backward (count)
-  "Mark current article as read, and then go backward.
-Argument COUNT specifies number of articles marked as read."
-  (interactive "p")
-  (while (> count 0)
-    (gnus-summary-mark-as-read)
-    (gnus-summary-prev-subject 1 'unread-only)
-    (setq count (1- count))))
-
-(defun gnus-summary-mark-as-read (&optional article mark)
-  "Mark current article as read.
-Optional 1st argument ARTICLE specifies article number to be marked as read.
-Optional 2nd argument MARK specifies a string inserted at beginning of line.
-Any kind of string (length 1) except for a space and `-' is ok."
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
-    ;; First of all, show hidden thread subtrees.
-    (gnus-summary-show-thread)
-    (let* ((buffer-read-only nil)
-	   (mark (or mark "D"))		;Default mark is `D'.
-	   (current (gnus-summary-article-number))
-	   (article (or article current)))
-      (gnus-mark-article-as-read article)
-      (if (or (eq article current)
-	      (gnus-summary-goto-subject article))
-	  (progn
-	    (beginning-of-line)
-	    (delete-char 1)
-	    (insert mark)))
-      )))
-
-(defun gnus-summary-clear-mark-forward (count)
-  "Remove current article's mark, and go forward.
-Argument COUNT specifies number of articles unmarked."
-  (interactive "p")
-  (while (> count 0)
-    (gnus-summary-mark-as-unread nil t)
-    (gnus-summary-next-subject 1 nil)
-    (setq count (1- count))))
-
-(defun gnus-summary-clear-mark-backward (count)
-  "Remove current article's mark, and go backward.
-Argument COUNT specifies number of articles unmarked."
-  (interactive "p")
-  (while (> count 0)
-    (gnus-summary-mark-as-unread nil t)
-    (gnus-summary-prev-subject 1 nil)
-    (setq count (1- count))))
-
-(defun gnus-summary-delete-marked-as-read ()
-  "Delete summary lines for articles that are marked as read."
-  (interactive)
-  (if gnus-newsgroup-unreads
-      (let ((buffer-read-only nil))
-	(save-excursion
-	  (goto-char (point-min))
-	  (delete-non-matching-lines "^[- ]"))
-	;; Adjust point.
-	(if (eobp)
-	    (gnus-summary-prev-subject 1)
-	  (beginning-of-line)
-	  (search-forward ":" nil t)))
-    ;; It is not so good idea to make the buffer empty.
-    (message "All articles are marked as read")
-    ))
-
-(defun gnus-summary-delete-marked-with (marks)
-  "Delete lines which are marked with MARKS (e.g. \"DK\")."
-  (interactive "sMarks: ")
-  (let ((buffer-read-only nil))
-    (save-excursion
-      (goto-char (point-min))
-      (delete-matching-lines (concat "^[" marks "]")))
-    ;; Adjust point.
-    (or (zerop (buffer-size))
-	(if (eobp)
-	    (gnus-summary-prev-subject 1)
-	  (beginning-of-line)
-	  (search-forward ":" nil t)))
-    ))
-
-;; Thread-based commands.
-
-(defun gnus-summary-toggle-threads (arg)
-  "Toggle showing conversation threads.
-With arg, turn showing conversation threads on iff arg is positive."
-  (interactive "P")
-  (let ((current (gnus-summary-article-number)))
-    (setq gnus-show-threads
-	  (if (null arg) (not gnus-show-threads)
-	    (> (prefix-numeric-value arg) 0)))
-    (gnus-summary-prepare)
-    (gnus-summary-goto-subject current)
-    ))
-
-(defun gnus-summary-show-all-threads ()
-  "Show all thread subtrees."
-  (interactive)
-  (if gnus-show-threads
-      (save-excursion
-	(let ((buffer-read-only nil))
-	  (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
-	  ))))
-
-(defun gnus-summary-show-thread ()
-  "Show thread subtrees."
-  (interactive)
-  (if gnus-show-threads
-      (save-excursion
-	(let ((buffer-read-only nil))
-	  (subst-char-in-region (progn
-				  (beginning-of-line) (point))
-				(progn
-				  (end-of-line) (point))
-				?\^M ?\n t)
-	  ))))
-
-(defun gnus-summary-hide-all-threads ()
-  "Hide all thread subtrees."
-  (interactive)
-  (if gnus-show-threads
-      (save-excursion
-	;; Adjust cursor point.
-	(goto-char (point-min))
-	(search-forward ":" nil t)
-	(let ((level (current-column)))
-	  (gnus-summary-hide-thread)
-	  (while (gnus-summary-search-forward)
-	    (and (>= level (current-column))
-		 (gnus-summary-hide-thread)))
-	  ))))
-
-(defun gnus-summary-hide-thread ()
-  "Hide thread subtrees."
-  (interactive)
-  (if gnus-show-threads
-      (save-excursion
-	;; Adjust cursor point.
-	(beginning-of-line)
-	(search-forward ":" nil t)
-	(let ((buffer-read-only nil)
-	      (init (point))
-	      (last (point))
-	      (level (current-column)))
-	  (while (and (gnus-summary-search-forward)
-		      (< level (current-column)))
-	    ;; Interested in lower levels.
-	    (if (< level (current-column))
-		(progn
-		  (setq last (point))
-		  ))
-	    )
-	  (subst-char-in-region init last ?\n ?\^M t)
-	  ))))
-
-(defun gnus-summary-next-thread (n)
-  "Go to the same level next thread.
-Argument N specifies the number of threads."
-  (interactive "p")
-  ;; Adjust cursor point.
-  (beginning-of-line)
-  (search-forward ":" nil t)
-  (let ((init (point))
-	(last (point))
-	(level (current-column)))
-    (while (and (> n 0)
-		(gnus-summary-search-forward)
-		(<= level (current-column)))
-      ;; We have to skip lower levels.
-      (if (= level (current-column))
-	  (progn
-	    (setq last (point))
-	    (setq n (1- n))
-	    ))
-      )
-    ;; Return non-nil if successfully move to the next.
-    (prog1 (not (= init last))
-      (goto-char last))
-    ))
-
-(defun gnus-summary-prev-thread (n)
-  "Go to the same level previous thread.
-Argument N specifies the number of threads."
-  (interactive "p")
-  ;; Adjust cursor point.
-  (beginning-of-line)
-  (search-forward ":" nil t)
-  (let ((init (point))
-	(last (point))
-	(level (current-column)))
-    (while (and (> n 0)
-		(gnus-summary-search-backward)
-		(<= level (current-column)))
-      ;; We have to skip lower levels.
-      (if (= level (current-column))
-	  (progn
-	    (setq last (point))
-	    (setq n (1- n))
-	    ))
-      )
-    ;; Return non-nil if successfully move to the previous.
-    (prog1 (not (= init last))
-      (goto-char last))
-    ))
-
-(defun gnus-summary-down-thread (d)
-  "Go downward current thread.
-Argument D specifies the depth goes down."
-  (interactive "p")
-  ;; Adjust cursor point.
-  (beginning-of-line)
-  (search-forward ":" nil t)
-  (let ((last (point))
-	(level (current-column)))
-    (while (and (> d 0)
-		(gnus-summary-search-forward)
-		(<= level (current-column))) ;<= can be <.  Which do you like?
-      ;; We have to skip the same levels.
-      (if (< level (current-column))
-	  (progn
-	    (setq last (point))
-	    (setq level (current-column))
-	    (setq d (1- d))
-	    ))
-      )
-    (goto-char last)
-    ))
-
-(defun gnus-summary-up-thread (d)
-  "Go upward current thread.
-Argument D specifies the depth goes up."
-  (interactive "p")
-  ;; Adjust cursor point.
-  (beginning-of-line)
-  (search-forward ":" nil t)
-  (let ((last (point))
-	(level (current-column)))
-    (while (and (> d 0)
-		(gnus-summary-search-backward))
-      ;; We have to skip the same levels.
-      (if (> level (current-column))
-	  (progn
-	    (setq last (point))
-	    (setq level (current-column))
-	    (setq d (1- d))
-	    ))
-      )
-    (goto-char last)
-    ))
-
-(defun gnus-summary-kill-thread (unmark)
-  "Mark articles under current thread as read.
-If argument UNMARK is positive, remove any kinds of marks.
-If argument UNMARK is negative, mark articles as unread instead."
-  (interactive "P")
-  (if unmark
-      (setq unmark (prefix-numeric-value unmark)))
-  ;; Adjust cursor point.
-  (beginning-of-line)
-  (search-forward ":" nil t)
-  (save-excursion
-    (let ((level (current-column)))
-      ;; Mark current article.
-      (cond ((null unmark)
-	     (gnus-summary-mark-as-read nil "K"))
-	    ((> unmark 0)
-	     (gnus-summary-mark-as-unread nil t))
-	    (t
-	     (gnus-summary-mark-as-unread))
-	    )
-      ;; Mark following articles.
-      (while (and (gnus-summary-search-forward)
-		  (< level (current-column)))
-	(cond ((null unmark)
-	       (gnus-summary-mark-as-read nil "K"))
-	      ((> unmark 0)
-	       (gnus-summary-mark-as-unread nil t))
-	      (t
-	       (gnus-summary-mark-as-unread))
-	      ))
-      ))
-  ;; Hide killed subtrees.
-  (and (null unmark)
-       gnus-thread-hide-killed
-       (gnus-summary-hide-thread))
-  ;; If marked as read, go to next unread subject.
-  (if (null unmark)
-      ;; Go to next unread subject.
-      (gnus-summary-next-subject 1 t))
-  )
-
-(defun gnus-summary-toggle-truncation (arg)
-  "Toggle truncation of summary lines.
-With arg, turn line truncation on iff arg is positive."
-  (interactive "P")
-  (setq truncate-lines
-	(if (null arg) (not truncate-lines)
-	  (> (prefix-numeric-value arg) 0)))
-  (redraw-display))
-
-(defun gnus-summary-sort-by-number (reverse)
-  "Sort Summary buffer by article number.
-Argument REVERSE means reverse order."
-  (interactive "P")
-  (gnus-summary-keysort-summary
-   (function <)
-   (function
-    (lambda (a)
-      (nntp-header-number a)))
-   reverse
-   ))
-
-(defun gnus-summary-sort-by-author (reverse)
-  "Sort Summary buffer by author name alphabetically.
-If case-fold-search is non-nil, case of letters is ignored.
-Argument REVERSE means reverse order."
-  (interactive "P")
-  (gnus-summary-keysort-summary
-   (function string-lessp)
-   (function
-    (lambda (a)
-      (if case-fold-search
-	  (downcase (nntp-header-from a))
-	(nntp-header-from a))))
-   reverse
-   ))
-
-(defun gnus-summary-sort-by-subject (reverse)
-  "Sort Summary buffer by subject alphabetically.  `Re:'s are ignored.
-If case-fold-search is non-nil, case of letters is ignored.
-Argument REVERSE means reverse order."
-  (interactive "P")
-  (gnus-summary-keysort-summary
-   (function string-lessp)
-   (function
-    (lambda (a)
-      (if case-fold-search
-	  (downcase (gnus-simplify-subject (nntp-header-subject a) 're-only))
-	(gnus-simplify-subject (nntp-header-subject a) 're-only))))
-   reverse
-   ))
-
-(defun gnus-summary-sort-by-date (reverse)
-  "Sort Summary buffer by date.
-Argument REVERSE means reverse order."
-  (interactive "P")
-  (gnus-summary-keysort-summary
-   (function string-lessp)
-   (function
-    (lambda (a)
-      (gnus-sortable-date (nntp-header-date a))))
-   reverse
-   ))
-
-(defun gnus-summary-keysort-summary (predicate key &optional reverse)
-  "Sort Summary buffer by PREDICATE using a value passed by KEY.
-Optional argument REVERSE means reverse order."
-  (let ((current (gnus-summary-article-number)))
-    (gnus-keysort-headers predicate key reverse)
-    (gnus-summary-prepare)
-    (gnus-summary-goto-subject current)
-    ))
-
-(defun gnus-summary-sort-summary (predicate &optional reverse)
-  "Sort Summary buffer by PREDICATE.
-Optional argument REVERSE means reverse order."
-  (let ((current (gnus-summary-article-number)))
-    (gnus-sort-headers predicate reverse)
-    (gnus-summary-prepare)
-    (gnus-summary-goto-subject current)
-    ))
-
-(defun gnus-summary-reselect-current-group (show-all)
-  "Once exit and then reselect the current newsgroup.
-Prefix argument SHOW-ALL means to select all articles."
-  (interactive "P")
-  (let ((current-subject (gnus-summary-article-number)))
-    (gnus-summary-exit t)
-    ;; We have to adjust the point of Group mode buffer because the
-    ;; current point was moved to the next unread newsgroup by
-    ;; exiting.
-    (gnus-summary-jump-to-group gnus-newsgroup-name)
-    (gnus-group-read-group show-all t)
-    (gnus-summary-goto-subject current-subject)
-    ))
-
-(defun gnus-summary-caesar-message (rotnum)
-  "Caesar rotates all letters of current message by 13/47 places.
-With prefix arg, specifies the number of places to rotate each letter forward.
-Caesar rotates Japanese letters by 47 places in any case."
-  (interactive "P")
-  (gnus-summary-select-article)
-  (gnus-overload-functions)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (save-restriction
-      (widen)
-      ;; We don't want to jump to the beginning of the message.
-      ;; `save-excursion' does not do its job.
-      (move-to-window-line 0)
-      (let ((last (point)))
-	(news-caesar-buffer-body rotnum)
-	(goto-char last)
-	(recenter 0)
-	))
-    ))
-
-(defun gnus-summary-rmail-digest ()
-  "Run RMAIL on current digest article.
-`gnus-select-digest-hook' will be called with no arguments, if that
-value is non-nil.  It is possible to modify the article so that Rmail
-can work with it.
-`gnus-rmail-digest-hook' will be called with no arguments, if that value
-is non-nil.  The hook is intended to customize Rmail mode."
-  (interactive)
-  (gnus-summary-select-article)
-  (require 'rmail)
-  (let ((artbuf gnus-article-buffer)
-	(digbuf (get-buffer-create gnus-digest-buffer))
-	(mail-header-separator ""))
-    (set-buffer digbuf)
-    (buffer-flush-undo (current-buffer))
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (insert-buffer-substring artbuf)
-    (run-hooks 'gnus-select-digest-hook)
-    (gnus-convert-article-to-rmail)
-    (goto-char (point-min))
-    ;; Rmail initializations.
-    (rmail-insert-rmail-file-header)
-    (rmail-mode)
-    (rmail-set-message-counters)
-    (rmail-show-message)
-    (condition-case ()
-	(progn
-	  (undigestify-rmail-message)
-	  (rmail-expunge)		;Delete original message.
-	  ;; File name is meaningless but `save-buffer' requires it.
-	  (setq buffer-file-name "GNUS Digest")
-	  (setq mode-line-buffer-identification
-		(concat "Digest: "
-			(nntp-header-subject gnus-current-headers)))
-	  ;; There is no need to write this buffer to a file.
-	  (make-local-variable 'write-file-hooks)
-	  (setq write-file-hooks
-		(list (function
-		       (lambda ()
-			 (set-buffer-modified-p nil)
-			 (message "(No changes need to be saved)")
-			 'no-need-to-write-this-buffer))))
-	  ;; Default file name saving digest messages.
-	  (setq rmail-default-rmail-file
-		(funcall gnus-rmail-save-name
-			 gnus-newsgroup-name
-			 gnus-current-headers
-			 gnus-newsgroup-last-rmail
-			 ))
-	  (setq rmail-default-file
-		(funcall gnus-mail-save-name
-			 gnus-newsgroup-name
-			 gnus-current-headers
-			 gnus-newsgroup-last-mail
-			 ))
-	  ;; Prevent generating new buffer named ***<N> each time.
-	  (setq rmail-summary-buffer
-		(get-buffer-create gnus-digest-summary-buffer))
-	  (run-hooks 'gnus-rmail-digest-hook)
-	  ;; Take all windows safely.
-	  (gnus-configure-windows '(1 0 0))
-	  (pop-to-buffer gnus-group-buffer)
-	  ;; Use Summary Article windows for Digest summary and
-	  ;; Digest buffers.
-	  (if gnus-digest-show-summary
-	      (let ((gnus-summary-buffer gnus-digest-summary-buffer)
-		    (gnus-article-buffer gnus-digest-buffer))
-		(gnus-configure-windows 'article)
-		(pop-to-buffer gnus-digest-buffer)
-		(rmail-summary)
-		(pop-to-buffer gnus-digest-summary-buffer)
-		(message (substitute-command-keys
-			  "Type \\[rmail-summary-quit] to return to GNUS")))
-	    (let ((gnus-summary-buffer gnus-digest-buffer))
-	      (gnus-configure-windows 'summary)
-	      (pop-to-buffer gnus-digest-buffer)
-	      (message (substitute-command-keys
-			"Type \\[rmail-quit] to return to GNUS")))
-	    )
-	  ;; Move the buffers to the end of buffer list.
-	  (bury-buffer gnus-article-buffer)
-	  (bury-buffer gnus-group-buffer)
-	  (bury-buffer gnus-digest-summary-buffer)
-	  (bury-buffer gnus-digest-buffer))
-      (error (set-buffer-modified-p nil)
-	     (kill-buffer digbuf)
-	     ;; This command should not signal an error because the
-	     ;; command is called from hooks.
-	     (ding) (message "Article is not a digest")))
-    ))
-
-(defun gnus-summary-save-article ()
-  "Save this article using default saver function.
-The variable `gnus-default-article-saver' specifies the saver function."
-  (interactive)
-  (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
-  (if gnus-default-article-saver
-      (call-interactively gnus-default-article-saver)
-    (error "No default saver is defined.")))
-
-(defun gnus-summary-save-in-rmail (&optional filename)
-  "Append this article to Rmail file.
-Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
-  (interactive)
-  (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (save-excursion
-      (save-restriction
-	(widen)
-	(let ((default-name
-		(funcall gnus-rmail-save-name
-			 gnus-newsgroup-name
-			 gnus-current-headers
-			 gnus-newsgroup-last-rmail
-			 )))
-	  (or filename
-	      (setq filename
-		    (read-file-name
-		     (concat "Save article in Rmail file: (default "
-			     (file-name-nondirectory default-name)
-			     ") ")
-		     (file-name-directory default-name)
-		     default-name)))
-	  (gnus-make-directory (file-name-directory filename))
-	  (gnus-output-to-rmail filename)
-	  ;; Remember the directory name to save articles.
-	  (setq gnus-newsgroup-last-rmail filename)
-	  )))
-    ))
-
-(defun gnus-summary-save-in-mail (&optional filename)
-  "Append this article to Unix mail file.
-Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
-  (interactive)
-  (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (save-excursion
-      (save-restriction
-	(widen)
-	(let ((default-name
-		(funcall gnus-mail-save-name
-			 gnus-newsgroup-name
-			 gnus-current-headers
-			 gnus-newsgroup-last-mail
-			 )))
-	  (or filename
-	      (setq filename
-		    (read-file-name
-		     (concat "Save article in Unix mail file: (default "
-			     (file-name-nondirectory default-name)
-			     ") ")
-		     (file-name-directory default-name)
-		     default-name)))
-	  (setq filename
-		(expand-file-name filename
-				  (and default-name
-				       (file-name-directory default-name))))
-	  (gnus-make-directory (file-name-directory filename))
-	  (if (and (file-readable-p filename) (mail-file-babyl-p filename))
-	      (gnus-output-to-rmail filename)
-	    (rmail-output filename 1 t t))
-	  ;; Remember the directory name to save articles.
-	  (setq gnus-newsgroup-last-mail filename)
-	  )))
-    ))
-
-(defun gnus-summary-save-in-file (&optional filename)
-  "Append this article to file.
-Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory' which
-is initialized from the SAVEDIR environment variable."
-  (interactive)
-  (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (save-excursion
-      (save-restriction
-	(widen)
-	(let ((default-name
-		(funcall gnus-file-save-name
-			 gnus-newsgroup-name
-			 gnus-current-headers
-			 gnus-newsgroup-last-file
-			 )))
-	  (or filename
-	      (setq filename
-		    (read-file-name
-		     (concat "Save article in file: (default "
-			     (file-name-nondirectory default-name)
-			     ") ")
-		     (file-name-directory default-name)
-		     default-name)))
-	  (gnus-make-directory (file-name-directory filename))
-	  (gnus-output-to-file filename)
-	  ;; Remember the directory name to save articles.
-	  (setq gnus-newsgroup-last-file filename)
-	  )))
-    ))
-
-(defun gnus-summary-save-in-folder (&optional folder)
-  "Save this article to MH folder (using `rcvstore' in MH library).
-Optional argument FOLDER specifies folder name."
-  (interactive)
-  (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (save-restriction
-      (widen)
-      ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
-      (mh-find-path)
-      (let ((folder
-	     (or folder
-		 (mh-prompt-for-folder "Save article in"
-				       (funcall gnus-folder-save-name
-						gnus-newsgroup-name
-						gnus-current-headers
-						gnus-newsgroup-last-folder
-						)
-				       t
-				       )))
-	    (errbuf (get-buffer-create " *GNUS rcvstore*")))
-	(unwind-protect
-	    (call-process-region (point-min) (point-max)
-				 (expand-file-name "rcvstore" mh-lib)
-				 nil errbuf nil folder)
-	  (set-buffer errbuf)
-	  (if (zerop (buffer-size))
-	      (message "Article saved in folder: %s" folder)
-	    (message "%s" (buffer-string)))
-	  (kill-buffer errbuf)
-	  (setq gnus-newsgroup-last-folder folder))
-	))
-    ))
-
-(defun gnus-summary-pipe-output ()
-  "Pipe this article to subprocess."
-  (interactive)
-  ;; Ignore `gnus-save-all-headers' since this is not save command.
-  ;;(gnus-summary-select-article)
-  ;; Huuum.  Is this right?
-  (gnus-summary-select-article gnus-save-all-headers gnus-save-all-headers)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (save-restriction
-      (widen)
-      (let ((command (read-string "Shell command on article: "
-				  gnus-last-shell-command)))
-	(if (string-equal command "")
-	    (setq command gnus-last-shell-command))
-	(shell-command-on-region (point-min) (point-max) command nil)
-	(setq gnus-last-shell-command command)
-	))
-    ))
-
-(defun gnus-summary-catchup (all &optional quietly)
-  "Mark all articles not marked as unread in this newsgroup as read.
-If prefix argument ALL is non-nil, all articles are marked as read."
-  (interactive "P")
-  (if (or quietly
-	  (not gnus-interactive-catchup) ;Without confirmation?
-	  (y-or-n-p
-	   (if all
-	       "Do you really want to mark everything as read? "
-	     "Delete all articles not marked as unread? ")))
-      (let ((unmarked
-	     (gnus-set-difference gnus-newsgroup-unreads
-				  (if (not all) gnus-newsgroup-marked))))
-        (message "")			;Erase "Yes or No" question.
-	;; Hidden thread subtrees must be searched for ,too.
-	(gnus-summary-show-all-threads)
-	(while unmarked
-          (gnus-summary-mark-as-read (car unmarked) "C")
-	  (setq unmarked (cdr unmarked))
-	  ))
-    ))
-
-(defun gnus-summary-catchup-to-here ()
-  "Mark all articles before the current one in this newsgroup as read."
-  (interactive)
-  (beginning-of-line)
-  (let ((current (gnus-summary-article-number)))
-	(beginning-of-buffer)
-	(while (not (= (gnus-summary-article-number) current))
-	  (gnus-summary-mark-as-read)
-	  (gnus-summary-next-subject 1))))
-
-(defun gnus-summary-catchup-all (&optional quietly)
-  "Mark all articles in this newsgroup as read."
-  (interactive)
-  (gnus-summary-catchup t quietly))
-
-(defun gnus-summary-catchup-and-exit (all &optional quietly)
-  "Mark all articles not marked as unread in this newsgroup as read, then exit.
-If prefix argument ALL is non-nil, all articles are marked as read."
-  (interactive "P")
-  (if (or quietly
-	  (not gnus-interactive-catchup) ;Without confirmation?
-	  (y-or-n-p
-	   (if all
-	       "Do you really want to mark everything as read? "
-	     "Delete all articles not marked as unread? ")))
-      (let ((unmarked
-             (gnus-set-difference gnus-newsgroup-unreads
-                                  (if (not all) gnus-newsgroup-marked))))
-        (message "")			;Erase "Yes or No" question.
-	(while unmarked
-          (gnus-mark-article-as-read (car unmarked))
-	  (setq unmarked (cdr unmarked)))
-	;; Select next newsgroup or exit.
-	(cond ((eq gnus-auto-select-next 'quietly)
-	       ;; Select next newsgroup quietly.
-	       (gnus-summary-next-group nil))
-	      (t
-	       (gnus-summary-exit)))
-	)))
-
-(defun gnus-summary-catchup-all-and-exit (&optional quietly)
-  "Mark all articles in this newsgroup as read, and then exit."
-  (interactive)
-  (gnus-summary-catchup-and-exit t quietly))
-
-(defun gnus-summary-edit-global-kill ()
-  "Edit a global KILL file."
-  (interactive)
-  (setq gnus-current-kill-article (gnus-summary-article-number))
-  (gnus-kill-file-edit-file nil)	;Nil stands for global KILL file.
-  (message
-   (substitute-command-keys
-    "Editing a global KILL file (Type \\[gnus-kill-file-exit] to exit)")))
-
-(defun gnus-summary-edit-local-kill ()
-  "Edit a local KILL file applied to the current newsgroup."
-  (interactive)
-  (setq gnus-current-kill-article (gnus-summary-article-number))
-  (gnus-kill-file-edit-file gnus-newsgroup-name)
-  (message
-   (substitute-command-keys
-    "Editing a local KILL file (Type \\[gnus-kill-file-exit] to exit)")))
-
-(defun gnus-summary-exit (&optional temporary)
-  "Exit reading current newsgroup, and then return to group selection mode.
-`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
-  (interactive)
-  (let ((updated nil)
-	(gnus-newsgroup-headers gnus-newsgroup-headers)
-	(gnus-newsgroup-unreads gnus-newsgroup-unreads)
-	(gnus-newsgroup-unselected gnus-newsgroup-unselected)
-	(gnus-newsgroup-marked gnus-newsgroup-marked))
-    ;; Important internal variables are saved, so we can reenter
-    ;; Summary buffer even if hook changes them.
-    (run-hooks 'gnus-exit-group-hook)
-    (gnus-update-unread-articles gnus-newsgroup-name
-				 (append gnus-newsgroup-unselected
-					 gnus-newsgroup-unreads)
-				 gnus-newsgroup-marked)
-    ;; T means ignore unsubscribed newsgroups.
-    (if gnus-use-cross-reference
-	(setq updated
-	      (gnus-mark-as-read-by-xref gnus-newsgroup-name
-					 gnus-newsgroup-headers
-					 gnus-newsgroup-unreads
-					 (eq gnus-use-cross-reference t)
-					 )))
-    ;; Do not switch windows but change the buffer to work.
-    (set-buffer gnus-group-buffer)
-    ;; Update cross referenced group info.
-    (while updated
-      (gnus-group-update-group (car updated) t) ;Ignore invisible group.
-      (setq updated (cdr updated)))
-    (gnus-group-update-group gnus-newsgroup-name))
-  ;; Make sure where I was, and go to next newsgroup.
-  (gnus-group-jump-to-group gnus-newsgroup-name)
-  (gnus-group-next-unread-group 1)
-  (if temporary
-      ;; If exiting temporary, caller should adjust Group mode
-      ;; buffer point by itself.
-      nil				;Nothing to do.
-    ;; Return to Group mode buffer.
-    (if (get-buffer gnus-summary-buffer)
-	(bury-buffer gnus-summary-buffer))
-    (if (get-buffer gnus-article-buffer)
-	(bury-buffer gnus-article-buffer))
-    (gnus-configure-windows 'newsgroups)
-    (pop-to-buffer gnus-group-buffer)))
-
-(defun gnus-summary-quit ()
-  "Quit reading current newsgroup without updating read article info."
-  (interactive)
-  (if (y-or-n-p "Do you really wanna quit reading this group? ")
-      (progn
-	(message "")			;Erase "Yes or No" question.
-	;; Return to Group selection mode.
-	(if (get-buffer gnus-summary-buffer)
-	    (bury-buffer gnus-summary-buffer))
-	(if (get-buffer gnus-article-buffer)
-	    (bury-buffer gnus-article-buffer))
-	(gnus-configure-windows 'newsgroups)
-	(pop-to-buffer gnus-group-buffer)
-	(gnus-group-jump-to-group gnus-newsgroup-name) ;Make sure where I was.
-	(gnus-group-next-group 1)	;(gnus-group-next-unread-group 1)
-	)))
-
-(defun gnus-summary-describe-briefly ()
-  "Describe Summary mode commands briefly."
-  (interactive)
-  (message
-   (concat
-    (substitute-command-keys "\\[gnus-summary-next-page]:Select  ")
-    (substitute-command-keys "\\[gnus-summary-next-unread-article]:Forward  ")
-    (substitute-command-keys "\\[gnus-summary-prev-unread-article]:Backward  ")
-    (substitute-command-keys "\\[gnus-summary-exit]:Exit  ")
-    (substitute-command-keys "\\[gnus-info-find-node]:Run Info  ")
-    (substitute-command-keys "\\[gnus-summary-describe-briefly]:This help")
-    )))
-
-
-;;;
-;;; GNUS Article Mode
-;;;
-
-(if gnus-article-mode-map
-    nil
-  (setq gnus-article-mode-map (make-keymap))
-  (suppress-keymap gnus-article-mode-map)
-  (define-key gnus-article-mode-map " " 'gnus-article-next-page)
-  (define-key gnus-article-mode-map "\177" 'gnus-article-prev-page)
-  (define-key gnus-article-mode-map "r" 'gnus-article-refer-article)
-  (define-key gnus-article-mode-map "o" 'gnus-article-pop-article)
-  (define-key gnus-article-mode-map "h" 'gnus-article-show-summary)
-  (define-key gnus-article-mode-map "s" 'gnus-article-show-summary)
-  (define-key gnus-article-mode-map "?" 'gnus-article-describe-briefly)
-  (define-key gnus-article-mode-map "\C-c\C-i" 'gnus-info-find-node))
-
-(defun gnus-article-mode ()
-  "Major mode for browsing through an article.
-All normal editing commands are turned off.
-Instead, these commands are available:
-\\{gnus-article-mode-map}
-
-Various hooks for customization:
- gnus-article-mode-hook
-    Entry to this mode calls the value with no arguments, if that
-    value is non-nil.
-
- gnus-article-prepare-hook
-    Called with no arguments after an article is prepared for reading,
-    if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  ;; Gee.  Why don't you upgrade?
-  (cond ((boundp 'mode-line-modified)
-	 (setq mode-line-modified "--- "))
-	((listp (default-value 'mode-line-format))
-	 (setq mode-line-format
-	       (cons "--- " (cdr (default-value 'mode-line-format))))))
-  ;; To disable display-time facility.
-  ;;(make-local-variable 'global-mode-string)
-  ;;(setq global-mode-string nil)
-  (setq major-mode 'gnus-article-mode)
-  (setq mode-name "Article")
-  (make-local-variable 'minor-mode-alist)
-  (or (assq 'gnus-show-mime minor-mode-alist)
-      (setq minor-mode-alist
-	    (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
-  (gnus-article-set-mode-line)
-  (use-local-map gnus-article-mode-map)
-  (make-local-variable 'page-delimiter)
-  (setq page-delimiter gnus-page-delimiter)
-  (make-local-variable 'mail-header-separator)
-  (setq mail-header-separator "")	;For caesar function.
-  (buffer-flush-undo (current-buffer))
-  (setq buffer-read-only t)		;Disable modification
-  (run-hooks 'gnus-article-mode-hook))
-
-(defun gnus-article-setup-buffer ()
-  "Initialize Article mode buffer."
-  (or (get-buffer gnus-article-buffer)
-      (save-excursion
-	(set-buffer (get-buffer-create gnus-article-buffer))
-	(gnus-article-mode))
-      ))
-
-(defun gnus-article-prepare (article &optional all-headers)
-  "Prepare ARTICLE in Article mode buffer.
-ARTICLE can be either a article number or Message-ID.
-If optional argument ALL-HEADERS is non-nil,
-include the article's whole original header."
-  ;; Make sure a connection to NNTP server is alive.
-  (if (not (gnus-server-opened))
-      (progn
-	(gnus-start-news-server)
-	(gnus-request-group gnus-newsgroup-name)))
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil))
-      (erase-buffer)
-      ;; mhspool does not work with Message-ID.  So, let's translate
-      ;; it into an article number as possible as can.  This may help
-      ;; nnspool too.
-      ;; Note: this conversion must be done here since if the article
-      ;; is specified by number or message-id has a different meaning
-      ;; in the following.
-      (if (let* ((header
-		  (and (stringp article)
-		       (gnus-get-header-by-id article)))
-		 (article
-		  (if header
-		      (nntp-header-number header) article)))
-	    (gnus-request-article article))
-	  (progn
-	    ;; Prepare article buffer
-	    (insert-buffer-substring nntp-server-buffer)
-	    ;; gnus-have-all-headers must be either T or NIL.
-	    (setq gnus-have-all-headers
-		  (not (not (or all-headers gnus-show-all-headers))))
-	    (if (and (numberp article)
-		     (not (eq article gnus-current-article)))
-		;; Seems me that a new article has been selected.
-		(progn
-		  ;; gnus-current-article must be an article number.
-		  (setq gnus-last-article gnus-current-article)
-		  (setq gnus-current-article article)
-;;		  (setq gnus-current-headers
-;;			(gnus-find-header-by-number gnus-newsgroup-headers
-;;						    gnus-current-article))
-		  (setq gnus-current-headers
-			(gnus-get-header-by-number gnus-current-article))
-		  (run-hooks 'gnus-mark-article-hook)
-		  ))
-	    ;; Clear article history only when the article is
-	    ;; retrieved by the article number.
-	    (if (numberp article)
-		(setq gnus-current-history nil))
-	    ;; Hooks for modifying contents of the article.  This hook
-	    ;; must be called before being narrowed.
-	    (run-hooks 'gnus-article-prepare-hook)
-	    ;; Decode MIME message.
-	    (if (and gnus-show-mime
-		     (gnus-fetch-field "Mime-Version"))
-		(funcall gnus-show-mime-method))
-	    ;; Delete unnecessary headers.
-	    (or gnus-have-all-headers
-		(gnus-article-delete-headers))
-	    ;; Do page break.
-	    (goto-char (point-min))
-	    (if gnus-break-pages
-		(gnus-narrow-to-page))
-	    ;; Next function must be called after setting
-	    ;;  `gnus-current-article' variable and narrowed to page.
-	    (gnus-article-set-mode-line)
-	    )
-	;; There is no such article.
-	(if (numberp article)
-	    (gnus-summary-mark-as-read article))
-	(ding) (message "No such article (may be canceled)"))
-      )))
-
-(defun gnus-article-show-all-headers ()
-  "Show all article headers in Article mode buffer."
-  (or gnus-have-all-headers
-      (gnus-article-prepare gnus-current-article t)))
-
-;;(defun gnus-article-set-mode-line ()
-;;  "Set Article mode line string."
-;;  (setq mode-line-buffer-identification
-;;	(list 17
-;;	      (format "GNUS: %s {%d-%d} %d"
-;;		      gnus-newsgroup-name
-;;		      gnus-newsgroup-begin
-;;		      gnus-newsgroup-end
-;;		      gnus-current-article
-;;                    )))
-;;  (set-buffer-modified-p t))
-
-;;(defun gnus-article-set-mode-line ()
-;;  "Set Article mode line string."
-;;  (let ((unmarked
-;;	 (- (length gnus-newsgroup-unreads)
-;;	    (length (gnus-intersection
-;;		     gnus-newsgroup-unreads gnus-newsgroup-marked))))
-;;	(unselected
-;;	 (- (length gnus-newsgroup-unselected)
-;;	    (length (gnus-intersection
-;;		     gnus-newsgroup-unselected gnus-newsgroup-marked)))))
-;;    (setq mode-line-buffer-identification
-;;	  (list 17
-;;		(format "GNUS: %s{%d} %s"
-;;			gnus-newsgroup-name
-;;			gnus-current-article
-;;			;; This is proposed by tale@pawl.rpi.edu.
-;;			(cond ((and (zerop unmarked)
-;;				    (zerop unselected))
-;;			       "      ")
-;;			      ((zerop unselected)
-;;			       (format "%d more" unmarked))
-;;			      (t
-;;			       (format "%d(+%d) more" unmarked unselected)))
-;;			))))
-;;  (set-buffer-modified-p t))
-
-;; New implementation in gnus 3.14.3
-
-(defun gnus-article-set-mode-line ()
-  "Set Article mode line string.
-If you don't like it, define your own `gnus-article-set-mode-line'."
-  (let ((maxlen 15)			;Maximum subject length
-	(subject
-	 (if gnus-current-headers
-	     (nntp-header-subject gnus-current-headers) "")))
-    ;; The value must be a string to escape %-constructs because of subject.
-    (setq mode-line-buffer-identification
-	  (format "GNUS: %s%s %s%s%s"
-		  gnus-newsgroup-name
-		  (if gnus-current-article
-		      (format "/%d" gnus-current-article) "")
-		  (substring subject 0 (min (length subject) maxlen))
-		  (if (> (length subject) maxlen) "..." "")
-		  (make-string (max 0 (- 17 (length subject))) ? )
-		  )))
-  (set-buffer-modified-p t))
-
-(defun gnus-article-delete-headers ()
-  "Delete unnecessary headers."
-  (save-excursion
-    (save-restriction
-      (goto-char (point-min))
-      (narrow-to-region (point-min)
-			(progn (search-forward "\n\n" nil 'move) (point)))
-      (goto-char (point-min))
-      (and (stringp gnus-ignored-headers)
-	   (while (re-search-forward gnus-ignored-headers nil t)
-	     (beginning-of-line)
-	     (delete-region (point)
-			    (progn (re-search-forward "\n[^ \t]")
-				   (forward-char -1)
-				   (point)))))
-      )))
-
-;; Working on article's buffer
-
-(defun gnus-article-next-page (lines)
-  "Show next page of current article.
-If end of article, return non-nil.  Otherwise return nil.
-Argument LINES specifies lines to be scrolled up."
-  (interactive "P")
-  (move-to-window-line -1)
-  ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
-  (if (save-excursion
-	(end-of-line)
-	(and (pos-visible-in-window-p)	;Not continuation line.
-	     (eobp)))
-      ;; Nothing in this page.
-      (if (or (not gnus-break-pages)
-	      (save-excursion
-		(save-restriction
-		  (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
-	  t				;Nothing more.
-	(gnus-narrow-to-page 1)		;Go to next page.
-	nil
-	)
-    ;; More in this page.
-    (condition-case ()
-	(scroll-up lines)
-      (end-of-buffer
-       ;; Long lines may cause an end-of-buffer error.
-       (goto-char (point-max))))
-    nil
-    ))
-
-(defun gnus-article-prev-page (lines)
-  "Show previous page of current article.
-Argument LINES specifies lines to be scrolled down."
-  (interactive "P")
-  (move-to-window-line 0)
-  (if (and gnus-break-pages
-	   (bobp)
-	   (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
-      (progn
-	(gnus-narrow-to-page -1) ;Go to previous page.
-	(goto-char (point-max))
-	(recenter -1))
-    (scroll-down lines)))
-
-(defun gnus-article-next-digest (nth)
-  "Move to head of NTH next digested message.
-Set mark at end of digested message."
-  ;; Stop page breaking in digest mode.
-  (widen)
-  (end-of-line)
-  ;; Skip NTH - 1 digest.
-  ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
-  ;; Digest separator is customizable.
-  ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
-  (while (and (> nth 1)
-	      (re-search-forward gnus-digest-separator nil 'move))
-    (setq nth (1- nth)))
-  (if (re-search-forward gnus-digest-separator nil t)
-      (let ((begin (point)))
-	;; Search for end of this message.
-	(end-of-line)
-	(if (re-search-forward gnus-digest-separator nil t)
-	    (progn
-	      (search-backward "\n\n")	;This may be incorrect.
-	      (forward-line 1))
-	  (goto-char (point-max)))
-	(push-mark)			;Set mark at end of digested message.
-	(goto-char begin)
-	(beginning-of-line)
-	;; Show From: and Subject: fields.
-	(recenter 1))
-    (message "End of message")
-    ))
-
-(defun gnus-article-prev-digest (n)
-  "Move to head of Nth previous digested message."
-  ;; Stop page breaking in digest mode.
-  (widen)
-  (beginning-of-line)
-  ;; Skip N - 1 digest.
-  ;; Suggested by Khalid Sattar <admin@cs.exeter.ac.uk>.
-  ;; Digest separator is customizable.
-  ;; Suggested by Skip Montanaro <montanaro@sprite.crd.ge.com>.
-  (while (and (> n 1)
-	      (re-search-backward gnus-digest-separator nil 'move))
-    (setq n (1- n)))
-  (if (re-search-backward gnus-digest-separator nil t)
-      (let ((begin (point)))
-	;; Search for end of this message.
-	(end-of-line)
-	(if (re-search-forward gnus-digest-separator nil t)
-	    (progn
-	      (search-backward "\n\n")	;This may be incorrect.
-	      (forward-line 1))
-	  (goto-char (point-max)))
-	(push-mark)			;Set mark at end of digested message.
-	(goto-char begin)
-	;; Show From: and Subject: fields.
-	(recenter 1))
-    (goto-char (point-min))
-    (message "Top of message")
-    ))
-
-(defun gnus-article-refer-article ()
-  "Read article specified by message-id around point."
-  (interactive)
-  (save-window-excursion
-    (save-excursion
-      (re-search-forward ">" nil t)	;Move point to end of "<....>".
-      (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
-	  (let ((message-id
-		 (buffer-substring (match-beginning 1) (match-end 1))))
-	    (set-buffer gnus-summary-buffer)
-	    (gnus-summary-refer-article message-id))
-	(error "No references around point"))
-      )))
-
-(defun gnus-article-pop-article ()
-  "Pop up article history."
-  (interactive)
-  (save-window-excursion
-    (set-buffer gnus-summary-buffer)
-    (gnus-summary-refer-article nil)))
-
-(defun gnus-article-show-summary ()
-  "Reconfigure windows to show Summary buffer."
-  (interactive)
-  (gnus-configure-windows 'article)
-  (pop-to-buffer gnus-summary-buffer)
-  (gnus-summary-goto-subject gnus-current-article))
-
-(defun gnus-article-describe-briefly ()
-  "Describe Article mode commands briefly."
-  (interactive)
-  (message
-   (concat
-    (substitute-command-keys "\\[gnus-article-next-page]:Next page  ")
-    (substitute-command-keys "\\[gnus-article-prev-page]:Prev page  ")
-    (substitute-command-keys "\\[gnus-article-show-summary]:Show Summary  ")
-    (substitute-command-keys "\\[gnus-info-find-node]:Run Info  ")
-    (substitute-command-keys "\\[gnus-article-describe-briefly]:This help")
-    )))
-
-
-;;;
-;;; GNUS KILL-File Mode
-;;;
-
-(if gnus-kill-file-mode-map
-    nil
-  (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
-  (define-key gnus-kill-file-mode-map "\C-c\C-k\C-s" 'gnus-kill-file-kill-by-subject)
-  (define-key gnus-kill-file-mode-map "\C-c\C-k\C-a" 'gnus-kill-file-kill-by-author)
-  (define-key gnus-kill-file-mode-map "\C-c\C-a" 'gnus-kill-file-apply-buffer)
-  (define-key gnus-kill-file-mode-map "\C-c\C-e" 'gnus-kill-file-apply-last-sexp)
-  (define-key gnus-kill-file-mode-map "\C-c\C-c" 'gnus-kill-file-exit)
-  (define-key gnus-kill-file-mode-map "\C-c\C-i" 'gnus-info-find-node))
-
-(defun gnus-kill-file-mode ()
-  "Major mode for editing KILL file.
-
-In addition to Emacs-Lisp Mode, the following commands are available:
-
-\\[gnus-kill-file-kill-by-subject]	Insert KILL command for current subject.
-\\[gnus-kill-file-kill-by-author]	Insert KILL command for current author.
-\\[gnus-kill-file-apply-buffer]	Apply current buffer to selected newsgroup.
-\\[gnus-kill-file-apply-last-sexp]	Apply sexp before point to selected newsgroup.
-\\[gnus-kill-file-exit]	Save file and exit editing KILL file.
-\\[gnus-info-find-node]	Read Info about KILL file.
-
-  A KILL file contains Lisp expressions to be applied to a selected
-newsgroup.  The purpose is to mark articles as read on the basis of
-some set of regexps.  A global KILL file is applied to every newsgroup,
-and a local KILL file is applied to a specified newsgroup.  Since a
-global KILL file is applied to every newsgroup, for better performance
-use a local one.
-
-  A KILL file can contain any kind of Emacs Lisp expressions expected
-to be evaluated in the Summary buffer.  Writing Lisp programs for this
-purpose is not so easy because the internal working of GNUS must be
-well-known.  For this reason, GNUS provides a general function which
-does this easily for non-Lisp programmers.
-
-  The `gnus-kill' function executes commands available in Summary Mode
-by their key sequences.  `gnus-kill' should be called with FIELD,
-REGEXP and optional COMMAND and ALL.  FIELD is a string representing
-the header field or an empty string.  If FIELD is an empty string, the
-entire article body is searched for.  REGEXP is a string which is
-compared with FIELD value.  COMMAND is a string representing a valid
-key sequence in Summary mode or Lisp expression.  COMMAND defaults to
-\(gnus-summary-mark-as-read nil \"X\").  Make sure that COMMAND is
-executed in the Summary buffer.  If the second optional argument ALL
-is non-nil, the COMMAND is applied to articles which are already
-marked as read or unread.  Articles which are marked are skipped over
-by default.
-
-  For example, if you want to mark articles of which subjects contain
-the string `AI' as read, a possible KILL file may look like:
-
-	(gnus-kill \"Subject\" \"AI\")
-
-  If you want to mark articles with `D' instead of `X', you can use
-the following expression:
-
-	(gnus-kill \"Subject\" \"AI\" \"d\")
-
-\(Here we assume the command `gnus-summary-mark-as-read-forward' is
-assigned to `d' in Summary Mode.)
-
-  It is possible to delete unnecessary headers which are marked with
-`X' in a KILL file as follows:
-
-	(gnus-expunge \"X\")
-
-  If the Summary buffer is empty after applying KILL files, GNUS will
-exit the selected newsgroup normally.  If headers which are marked
-with `D' are deleted in a KILL file, it is impossible to read articles
-which are marked as read in the previous GNUS sessions.  Marks other
-than `D' should be used for articles which should really be deleted.
-
-Entry to this mode calls `emacs-lisp-mode-hook' and
-`gnus-kill-file-mode-hook' with no arguments, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map gnus-kill-file-mode-map)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (setq major-mode 'gnus-kill-file-mode)
-  (setq mode-name "KILL-File")
-  (lisp-mode-variables nil)
-  (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
-
-(defun gnus-kill-file-edit-file (newsgroup)
-  "Begin editing a KILL file of NEWSGROUP.
-If NEWSGROUP is nil, the global KILL file is selected."
-  (interactive "sNewsgroup: ")
-  (let ((file (gnus-newsgroup-kill-file newsgroup)))
-    (gnus-make-directory (file-name-directory file))
-    ;; Save current window configuration if this is first invocation.
-    (or (and (get-file-buffer file)
-	     (get-buffer-window (get-file-buffer file)))
-	(setq gnus-winconf-kill-file (current-window-configuration)))
-    ;; Hack windows.
-    (let ((buffer (find-file-noselect file)))
-      (cond ((get-buffer-window buffer)
-	     (pop-to-buffer buffer))
-	    ((eq major-mode 'gnus-group-mode)
-	     (gnus-configure-windows '(1 0 0)) ;Take all windows.
-	     (pop-to-buffer gnus-group-buffer)
-	     (let ((gnus-summary-buffer buffer))
-	       (gnus-configure-windows '(1 1 0)) ;Split into two.
-	       (pop-to-buffer buffer)))
-	    ((eq major-mode 'gnus-summary-mode)
-	     (gnus-configure-windows 'article)
-	     (pop-to-buffer gnus-article-buffer)
-	     (bury-buffer gnus-article-buffer)
-	     (switch-to-buffer buffer))
-	    (t				;No good rules.
-	     (find-file-other-window file))
-	    ))
-    (gnus-kill-file-mode)
-    ))
-
-(defun gnus-kill-file-kill-by-subject ()
-  "Insert KILL command for current subject."
-  (interactive)
-  (insert
-   (format "(gnus-kill \"Subject\" %s)\n"
-	   (prin1-to-string
-	    (if gnus-current-kill-article
-		(regexp-quote
-		 (nntp-header-subject
-		  ;; No need to speed up this command.
-		  ;;(gnus-get-header-by-number gnus-current-kill-article)
-		  (gnus-find-header-by-number gnus-newsgroup-headers
-					      gnus-current-kill-article)))
-	      "")))))
-
-(defun gnus-kill-file-kill-by-author ()
-  "Insert KILL command for current author."
-  (interactive)
-  (insert
-   (format "(gnus-kill \"From\" %s)\n"
-	   (prin1-to-string
-	    (if gnus-current-kill-article
-		(regexp-quote
-		 (nntp-header-from
-		  ;; No need to speed up this command.
-		  ;;(gnus-get-header-by-number gnus-current-kill-article)
-		  (gnus-find-header-by-number gnus-newsgroup-headers
-					      gnus-current-kill-article)))
-	      "")))))
-
-(defun gnus-kill-file-apply-buffer ()
-  "Apply current buffer to current newsgroup."
-  (interactive)
-  (if (and gnus-current-kill-article
-	   (get-buffer gnus-summary-buffer))
-      ;; Assume newsgroup is selected.
-      (let ((string (concat "(progn \n" (buffer-string) "\n)" )))
-	(save-excursion
-	  (save-window-excursion
-	    (pop-to-buffer gnus-summary-buffer)
-	    (eval (car (read-from-string string))))))
-    (ding) (message "No newsgroup is selected.")))
-
-(defun gnus-kill-file-apply-last-sexp ()
-  "Apply sexp before point in current buffer to current newsgroup."
-  (interactive)
-  (if (and gnus-current-kill-article
-	   (get-buffer gnus-summary-buffer))
-      ;; Assume newsgroup is selected.
-      (let ((string
-	     (buffer-substring
-	      (save-excursion (forward-sexp -1) (point)) (point))))
-	(save-excursion
-	  (save-window-excursion
-	    (pop-to-buffer gnus-summary-buffer)
-	    (eval (car (read-from-string string))))))
-    (ding) (message "No newsgroup is selected.")))
-
-(defun gnus-kill-file-exit ()
-  "Save a KILL file, then return to the previous buffer."
-  (interactive)
-  (save-buffer)
-  (let ((killbuf (current-buffer)))
-    ;; We don't want to return to Article buffer.
-    (and (get-buffer gnus-article-buffer)
-	 (bury-buffer (get-buffer gnus-article-buffer)))
-    ;; Delete the KILL file windows.
-    (delete-windows-on killbuf)
-    ;; Restore last window configuration if available.
-    (and gnus-winconf-kill-file
-	 (set-window-configuration gnus-winconf-kill-file))
-    (setq gnus-winconf-kill-file nil)
-    ;; Kill the KILL file buffer.  Suggested by tale@pawl.rpi.edu.
-    (kill-buffer killbuf)))
-
-
-;;;
-;;; Utility functions
-;;;
-
-;; Basic ideas by emv@math.lsa.umich.edu (Edward Vielmetti)
-
-(defun gnus-batch-kill ()
-  "Run batched KILL.
-Usage: emacs -batch -l gnus -f gnus-batch-kill NEWSGROUP ..."
-  (if (not noninteractive)
-      (error "gnus-batch-kill is to be used only with -batch"))
-  (let* ((group nil)
-	 (subscribed nil)
-	 (newsrc nil)
-	 (yes-and-no
-	  (gnus-parse-n-options
-	   (apply (function concat)
-		  (mapcar (function (lambda (g) (concat g " ")))
-			  command-line-args-left))))
-	 (yes (car yes-and-no))
-	 (no  (cdr yes-and-no))
-	 ;; Disable verbose message.
-	 (gnus-novice-user nil)
-	 (gnus-large-newsgroup nil)
-	 (nntp-large-newsgroup nil))
-    ;; Eat all arguments.
-    (setq command-line-args-left nil)
-    ;; Startup GNUS.
-    (gnus)
-    ;; Apply kills to specified newsgroups in command line arguments.
-    (setq newsrc (copy-sequence gnus-newsrc-assoc))
-    (while newsrc
-      (setq group (car (car newsrc)))
-      (setq subscribed (nth 1 (car newsrc)))
-      (setq newsrc (cdr newsrc))
-      (if (and subscribed
-	       (not (zerop (nth 1 (gnus-gethash group gnus-unread-hashtb))))
-	       (if yes
-		   (string-match yes group) t)
-	       (or (null no)
-		   (not (string-match no group))))
-	  (progn
-	    (gnus-summary-read-group group nil t)
-	    (if (eq (current-buffer) (get-buffer gnus-summary-buffer))
-		(gnus-summary-exit t))
-	    ))
-      )
-    ;; Finally, exit Emacs.
-    (set-buffer gnus-group-buffer)
-    (gnus-group-exit)
-    ))
-
-;; For saving articles
-
-(defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
-  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
-Otherwise, it is like ~/News/news/group/num."
-  (let ((default
-	  (expand-file-name
-	   (concat (if gnus-use-long-file-name
-		       (gnus-capitalize-newsgroup newsgroup)
-		     (gnus-newsgroup-directory-form newsgroup))
-		   "/" (int-to-string (nntp-header-number headers)))
-	   (or gnus-article-save-directory "~/News"))))
-    (if (and last-file
-	     (string-equal (file-name-directory default)
-			   (file-name-directory last-file))
-	     (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
-	default
-      (or last-file default))))
-
-(defun gnus-numeric-save-name (newsgroup headers &optional last-file)
-  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group/num.
-Otherwise, it is like ~/News/news/group/num."
-  (let ((default
-	  (expand-file-name
-	   (concat (if gnus-use-long-file-name
-		       newsgroup
-		     (gnus-newsgroup-directory-form newsgroup))
-		   "/" (int-to-string (nntp-header-number headers)))
-	   (or gnus-article-save-directory "~/News"))))
-    (if (and last-file
-	     (string-equal (file-name-directory default)
-			   (file-name-directory last-file))
-	     (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
-	default
-      (or last-file default))))
-
-(defun gnus-Plain-save-name (newsgroup headers &optional last-file)
-  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group.
-Otherwise, it is like ~/News/news/group/news."
-  (or last-file
-      (expand-file-name
-       (if gnus-use-long-file-name
-	   (gnus-capitalize-newsgroup newsgroup)
-	 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
-       (or gnus-article-save-directory "~/News"))))
-
-(defun gnus-plain-save-name (newsgroup headers &optional last-file)
-  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is nil, it is ~/News/news.group.
-Otherwise, it is like ~/News/news/group/news."
-  (or last-file
-      (expand-file-name
-       (if gnus-use-long-file-name
-	   newsgroup
-	 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
-       (or gnus-article-save-directory "~/News"))))
-
-(defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
-  "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
-If variable `gnus-use-long-file-name' is nil, it is +News.group.
-Otherwise, it is like +news/group."
-  (or last-folder
-      (concat "+"
-	      (if gnus-use-long-file-name
-		  (gnus-capitalize-newsgroup newsgroup)
-		(gnus-newsgroup-directory-form newsgroup)))))
-
-(defun gnus-folder-save-name (newsgroup headers &optional last-folder)
-  "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
-If variable `gnus-use-long-file-name' is nil, it is +news.group.
-Otherwise, it is like +news/group."
-  (or last-folder
-      (concat "+"
-	      (if gnus-use-long-file-name
-		  newsgroup
-		(gnus-newsgroup-directory-form newsgroup)))))
-
-;; For KILL files
-
-(defun gnus-apply-kill-file ()
-  "Apply KILL file to the current newsgroup."
-  ;; Apply the global KILL file.
-  (load (gnus-newsgroup-kill-file nil) t nil t)
-  ;; And then apply the local KILL file.
-  (load (gnus-newsgroup-kill-file gnus-newsgroup-name) t nil t))
-
-(defun gnus-Newsgroup-kill-file (newsgroup)
-  "Return the name of a KILL file of NEWSGROUP.
-If NEWSGROUP is nil, return the global KILL file instead."
-  (cond ((or (null newsgroup)
-	     (string-equal newsgroup ""))
-	 ;; The global KILL file is placed at top of the directory.
-	 (expand-file-name gnus-kill-file-name
-			   (or gnus-kill-files-directory "~/News")))
-	(gnus-use-long-file-name
-	 ;; Append ".KILL" to capitalized newsgroup name.
-	 (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
-				   "." gnus-kill-file-name)
-			   (or gnus-kill-files-directory "~/News")))
-	(t
-	 ;; Place "KILL" under the hierarchical directory.
-	 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
-				   "/" gnus-kill-file-name)
-			   (or gnus-kill-files-directory "~/News")))
-	))
-
-(defun gnus-newsgroup-kill-file (newsgroup)
-  "Return the name of a KILL file of NEWSGROUP.
-If NEWSGROUP is nil, return the global KILL file instead."
-  (cond ((or (null newsgroup)
-	     (string-equal newsgroup ""))
-	 ;; The global KILL file is placed at top of the directory.
-	 (expand-file-name gnus-kill-file-name
-			   (or gnus-kill-files-directory "~/News")))
-	(gnus-use-long-file-name
-	 ;; Append ".KILL" to newsgroup name.
-	 (expand-file-name (concat newsgroup "." gnus-kill-file-name)
-			   (or gnus-kill-files-directory "~/News")))
-	(t
-	 ;; Place "KILL" under the hierarchical directory.
-	 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
-				   "/" gnus-kill-file-name)
-			   (or gnus-kill-files-directory "~/News")))
-	))
-
-;; For subscribing new newsgroup
-
-(defun gnus-subscribe-randomly (newsgroup)
-  "Subscribe new NEWSGROUP and insert it at the beginning of newsgroups."
-  (gnus-subscribe-newsgroup newsgroup
-			    (car (car gnus-newsrc-assoc))))
-
-(defun gnus-subscribe-alphabetically (newgroup)
-  "Subscribe new NEWSGROUP and insert it in strict alphabetic order."
-  ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
-  (let ((groups gnus-newsrc-assoc)
-	(before nil))
-    (while (and (not before) groups)
-      (if (string< newgroup (car (car groups)))
-	  (setq before (car (car groups)))
-	(setq groups (cdr groups))))
-    (gnus-subscribe-newsgroup newgroup before)
-    ))
-
-(defun gnus-subscribe-hierarchically (newgroup)
-  "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
-  ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
-  (save-excursion
-    (set-buffer (find-file-noselect gnus-current-startup-file))
-    (let ((groupkey newgroup)
-	  (before nil))
-      (while (and (not before) groupkey)
-	(goto-char (point-min))
-	(let ((groupkey-re
-	       (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
-	  (while (and (re-search-forward groupkey-re nil t)
-		      (progn
-			(setq before (buffer-substring
-				      (match-beginning 1) (match-end 1)))
-			(string< before newgroup)))
-	    ))
-	;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
-	(setq groupkey
-	      (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
-		  (substring groupkey (match-beginning 1) (match-end 1)))))
-      (gnus-subscribe-newsgroup newgroup before)
-      )))
-
-(defun gnus-subscribe-interactively (newsgroup)
-  "Subscribe new NEWSGROUP interactively.
-It is inserted in hierarchical newsgroup order if subscribed.
-Unless, it is killed."
-  (if (y-or-n-p (format "Subscribe new newsgroup: %s " newsgroup))
-      (gnus-subscribe-hierarchically newsgroup)
-    ;; Save in kill-ring
-    (gnus-subscribe-newsgroup newsgroup)
-    (gnus-kill-newsgroup newsgroup)))
-
-(defun gnus-subscribe-newsgroup (newsgroup &optional next)
-  "Subscribe new NEWSGROUP.
-If optional argument NEXT is non-nil, it is inserted before NEXT."
-  (gnus-insert-newsgroup (list newsgroup t) next)
-  (message "Subscribe newsgroup: %s" newsgroup))
-
-;; For directories
-
-(defun gnus-newsgroup-directory-form (newsgroup)
-  "Make hierarchical directory name from NEWSGROUP name."
-  (let ((newsgroup (substring newsgroup 0)) ;Copy string.
-	(len (length newsgroup))
-	(idx 0))
-    ;; Replace all occurrences of `.' with `/'.
-    (while (< idx len)
-      (if (= (aref newsgroup idx) ?.)
-	  (aset newsgroup idx ?/))
-      (setq idx (1+ idx)))
-    newsgroup
-    ))
-
-(defun gnus-make-directory (directory)
-  "Make DIRECTORY recursively."
-  (let ((directory (expand-file-name directory default-directory)))
-    (or (file-exists-p directory)
-	(gnus-make-directory-1 "" directory))
-    ))
-
-(defun gnus-make-directory-1 (head tail)
-  (cond ((string-match "^/\\([^/]+\\)" tail)
-	 ;; ange-ftp interferes with calling match-* after
-	 ;; calling file-name-as-directory.
-	 (let ((beg (match-beginning 1))
-	       (end (match-end 1)))
-	   (setq head (concat (file-name-as-directory head)
-			      (substring tail beg end)))
-	   (or (file-exists-p head)
-	       (call-process "mkdir" nil nil nil head))
-	   (gnus-make-directory-1 head (substring tail end))))
-	((string-equal tail "") t)
-	))
-
-(defun gnus-capitalize-newsgroup (newsgroup)
-  "Capitalize NEWSGROUP name with treating `.' and `-' as part of words."
-  ;; Suggested by "Jonathan I. Kamens" <jik@pit-manager.MIT.EDU>.
-  (let ((current-syntax-table (syntax-table)))
-    (unwind-protect
-	(progn
-	  (set-syntax-table (copy-syntax-table current-syntax-table))
-	  (modify-syntax-entry ?- "w")
-	  (modify-syntax-entry ?. "w")
-	  (capitalize newsgroup))
-      (set-syntax-table current-syntax-table))))
-
-(defun gnus-simplify-subject (subject &optional re-only)
-  "Remove `Re:' and words in parentheses.
-If optional argument RE-ONLY is non-nil, strip `Re:' only."
-  (let ((case-fold-search t))		;Ignore case.
-    ;; Remove `Re:' and `Re^N:'.
-    (if (string-match "\\`\\(re\\(\\^[0-9]+\\)?:[ \t]+\\)+" subject)
-	(setq subject (substring subject (match-end 0))))
-    ;; Remove words in parentheses from end.
-    (or re-only
-	(while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
-	  (setq subject (substring subject 0 (match-beginning 0)))))
-    ;; Return subject string.
-    subject
-    ))
-
-(defun gnus-optional-lines-and-from (header)
-  "Return a string like `NNN:AUTHOR' from HEADER."
-  (let ((name-length (length "umerin@photon")))
-    (substring (format "%3d:%s"
-		       ;; Lines of the article.
-		       ;; Suggested by dana@bellcore.com.
-		       (nntp-header-lines header)
-		       ;; Its author.
-		       (concat (mail-strip-quoted-names
-				(nntp-header-from header))
-			       (make-string name-length ? )))
-	       ;; 4 stands for length of `NNN:'.
-	       0 (+ 4 name-length))))
-
-(defun gnus-optional-lines (header)
-  "Return a string like `NNN' from HEADER."
-  (format "%4d" (nntp-header-lines header)))
-
-;; Basic ideas by flee@cs.psu.edu (Felix Lee)
-
-(defun gnus-keysort-headers (predicate key &optional reverse)
-  "Sort current headers by PREDICATE using a value passed by KEY safely.
-*Safely* means C-g quitting is disabled during sort.
-Optional argument REVERSE means reverse order."
-  (let ((inhibit-quit t))
-    (setq gnus-newsgroup-headers
-	  (if reverse
-	      (nreverse
-	       (gnus-keysort (nreverse gnus-newsgroup-headers) predicate key))
-	    (gnus-keysort gnus-newsgroup-headers predicate key)))
-    ;; Make sure we don't have to call
-    ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash
-    ;; tables for the variable gnus-newsgroup-headers since no new
-    ;; entry is added to nor deleted from the variable.
-    ))
-
-(defun gnus-keysort (list predicate key)
-  "Sort LIST by PREDICATE using a value passed by KEY."
-  (mapcar (function cdr)
-	  (sort (mapcar (function (lambda (a) (cons (funcall key a) a))) list)
-		(function (lambda (a b)
-			    (funcall predicate (car a) (car b)))))))
-
-(defun gnus-sort-headers (predicate &optional reverse)
-  "Sort current headers by PREDICATE safely.
-*Safely* means C-g quitting is disabled during sort.
-Optional argument REVERSE means reverse order."
-  (let ((inhibit-quit t))
-    (setq gnus-newsgroup-headers
-	  (if reverse
-	      (nreverse (sort (nreverse gnus-newsgroup-headers) predicate))
-	    (sort gnus-newsgroup-headers predicate)))
-    ;; Make sure we don't have to call
-    ;; gnus-clear-hashtables-for-newsgroup-headers to clear hash
-    ;; tables for the variable gnus-newsgroup-headers since no new
-    ;; entry is added to nor deleted from the variable.
-    ))
-
-(defun gnus-string-lessp (a b)
-  "Return T if first arg string is less than second in lexicographic order.
-If `case-fold-search' is non-nil, case of letters is ignored."
-  (if case-fold-search
-      (string-lessp (downcase a) (downcase b))
-    (string-lessp a b)))
-
-(defun gnus-date-lessp (date1 date2)
-  "Return T if DATE1 is earlyer than DATE2."
-  (string-lessp (gnus-sortable-date date1)
-		(gnus-sortable-date date2)))
-
-(defun gnus-sortable-date (date)
-  "Convert DATE into a string that can be sorted with `string-lessp'.
-Timezone package is used."
-  (let* ((date   (timezone-fix-time date nil nil)) ;[Y M D H M S]
-	 (year   (aref date 0))
-	 (month  (aref date 1))
-	 (day    (aref date 2)))
-    (timezone-make-sortable-date year month day 
-				 (timezone-make-time-string
-				  (aref date 3) (aref date 4) (aref date 5)))
-    ))
-
-;;(defun gnus-sortable-date (date)
-;;  "Make sortable string by string-lessp from DATE."
-;;  (let ((month '(("JAN" . " 1")("FEB" . " 2")("MAR" . " 3")
-;;		 ("APR" . " 4")("MAY" . " 5")("JUN" . " 6")
-;;		 ("JUL" . " 7")("AUG" . " 8")("SEP" . " 9")
-;;		 ("OCT" . "10")("NOV" . "11")("DEC" . "12")))
-;;	(date (or date "")))
-;;    ;; Can understand the following styles:
-;;    ;; (1) 14 Apr 89 03:20:12 GMT
-;;    ;; (2) Fri, 17 Mar 89 4:01:33 GMT
-;;    (if (string-match
-;;	 "\\([0-9]+\\) \\([^ ,]+\\) \\([0-9]+\\) \\([0-9:]+\\)" date)
-;;	(concat
-;;	 ;; Year
-;;	 (substring date (match-beginning 3) (match-end 3))
-;;	 ;; Month
-;;	 (cdr
-;;	  (assoc
-;;	   (upcase (substring date (match-beginning 2) (match-end 2))) month))
-;;	 ;; Day
-;;	 (format "%2d" (string-to-int
-;;			(substring date
-;;				   (match-beginning 1) (match-end 1))))
-;;	 ;; Time
-;;	 (substring date (match-beginning 4) (match-end 4)))
-;;      ;; Cannot understand DATE string.
-;;      date
-;;      )
-;;    ))
-
-(defun gnus-fetch-field (field)
-  "Return the value of the header FIELD of current article."
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      (narrow-to-region (point-min)
-			(progn (search-forward "\n\n" nil 'move) (point)))
-      (mail-fetch-field field))))
-
-(defalias 'gnus-expunge 'gnus-summary-delete-marked-with)
-
-(defun gnus-kill (field regexp &optional command all)
-  "If FIELD of an article matches REGEXP, execute COMMAND.
-Optional 1st argument COMMAND is default to
-	(gnus-summary-mark-as-read nil \"X\").
-If optional 2nd argument ALL is non-nil, articles marked are also applied to.
-If FIELD is an empty string (or nil), entire article body is searched for.
-COMMAND must be a Lisp expression or a string representing a key sequence."
-  ;; We don't want to change current point nor window configuration.
-  (save-excursion
-    (save-window-excursion
-      ;; Selected window must be Summary buffer to execute keyboard
-      ;; macros correctly.  See command_loop_1.
-      (switch-to-buffer gnus-summary-buffer 'norecord)
-      (goto-char (point-min))		;From the beginning.
-      (if (null command)
-	  (setq command '(gnus-summary-mark-as-read nil "X")))
-      (gnus-execute field regexp command nil (not all))
-      )))
-
-(defun gnus-execute (field regexp form &optional backward ignore-marked)
-  "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
-If FIELD is an empty string (or nil), entire article body is searched for.
-If optional 1st argument BACKWARD is non-nil, do backward instead.
-If optional 2nd argument IGNORE-MARKED is non-nil, ignore articles
-marked as read or unread."
-  (let ((function nil)
-	(header nil)
-	(article nil))
-    (if (string-equal field "")
-	(setq field nil))
-    (if (null field)
-	nil
-      (or (stringp field)
-	  (setq field (symbol-name field)))
-      ;; Get access function of header filed.
-      (setq function (intern-soft (concat "gnus-header-" (downcase field))))
-      (if (and function (fboundp function))
-	  (setq function (symbol-function function))
-	(error "Unknown header field: \"%s\"" field)))
-    ;; Make FORM funcallable.
-    (if (and (listp form) (not (eq (car form) 'lambda)))
-	(setq form (list 'lambda nil form)))
-    ;; Starting from the current article.
-    (or (and ignore-marked
-	     ;; Articles marked as read and unread should be ignored.
-	     (setq article (gnus-summary-article-number))
-	     (or (not (memq article gnus-newsgroup-unreads)) ;Marked as read.
-		 (memq article gnus-newsgroup-marked) ;Marked as unread.
-		 ))
-	(gnus-execute-1 function regexp form))
-    (while (gnus-summary-search-subject backward ignore-marked nil)
-      (gnus-execute-1 function regexp form))
-    ))
-
-(defun gnus-execute-1 (function regexp form)
-  (save-excursion
-    ;; The point of Summary buffer must be saved during execution.
-    (let ((article (gnus-summary-article-number)))
-      (if (null article)
-	  nil				;Nothing to do.
-	(if function
-	    ;; Compare with header field.
-	    (let (;;(header (gnus-find-header-by-number
-		  ;;	    gnus-newsgroup-headers article))
-		  (header (gnus-get-header-by-number article))
-		  (value nil))
-	      (and header
-		   (progn
-		     (setq value (funcall function header))
-		     ;; Number (Lines:) or symbol must be converted to string.
-		     (or (stringp value)
-			 (setq value (prin1-to-string value)))
-		     (string-match regexp value))
-		   (if (stringp form)	;Keyboard macro.
-		       (execute-kbd-macro form)
-		     (funcall form))))
-	  ;; Search article body.
-	  (let ((gnus-current-article nil) ;Save article pointer.
-		(gnus-last-article nil)
-		(gnus-break-pages nil)	;No need to break pages.
-		(gnus-mark-article-hook nil)) ;Inhibit marking as read.
-	    (message "Searching for article: %d..." article)
-	    (gnus-article-setup-buffer)
-	    (gnus-article-prepare article t)
-	    (if (save-excursion
-		  (set-buffer gnus-article-buffer)
-		  (goto-char (point-min))
-		  (re-search-forward regexp nil t))
-		(if (stringp form)	;Keyboard macro.
-		    (execute-kbd-macro form)
-		  (funcall form))))
-	  ))
-      )))
-
-;;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
-;;; modified by tower@prep Nov 86
-;;; Modified by umerin@flab.flab.Fujitsu.JUNET for ROT47.
-
-(defun gnus-caesar-region (&optional n)
-  "Caesar rotation of region by N, default 13, for decrypting netnews.
-ROT47 will be performed for Japanese text in any case."
-  (interactive (if current-prefix-arg	; Was there a prefix arg?
-		   (list (prefix-numeric-value current-prefix-arg))
-		 (list nil)))
-  (cond ((not (numberp n)) (setq n 13))
-	(t (setq n (mod n 26))))	;canonicalize N
-  (if (not (zerop n))		; no action needed for a rot of 0
-      (progn
-	(if (or (not (boundp 'caesar-translate-table))
-		(/= (aref caesar-translate-table ?a) (+ ?a n)))
-	    (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
-	      (message "Building caesar-translate-table...")
-	      (setq caesar-translate-table (make-vector 256 0))
-	      (while (< i 256)
-		(aset caesar-translate-table i i)
-		(setq i (1+ i)))
-	      (setq lower (concat lower lower) upper (upcase lower) i 0)
-	      (while (< i 26)
-		(aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
-		(aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
-		(setq i (1+ i)))
-	      ;; ROT47 for Japanese text.
-	      ;; Thanks to ichikawa@flab.fujitsu.junet.
-	      (setq i 161)
-	      (let ((t1 (logior ?O 128))
-		    (t2 (logior ?! 128))
-		    (t3 (logior ?~ 128)))
-		(while (< i 256)
-		  (aset caesar-translate-table i
-			(let ((v (aref caesar-translate-table i)))
-			  (if (<= v t1) (if (< v t2) v (+ v 47))
-			    (if (<= v t3) (- v 47) v))))
-		  (setq i (1+ i))))
-	      (message "Building caesar-translate-table...done")))
-	(let ((from (region-beginning))
-	      (to (region-end))
-	      (i 0) str len)
-	  (setq str (buffer-substring from to))
-	  (setq len (length str))
-	  (while (< i len)
-	    (aset str i (aref caesar-translate-table (aref str i)))
-	    (setq i (1+ i)))
-	  (goto-char from)
-	  (delete-region from to)
-	  (insert str)))))
-
-;; Functions accessing headers.
-;; Functions are more convenient than macros in some case.
-
-(defun gnus-header-number (header)
-  "Return article number in HEADER."
-  (nntp-header-number header))
-
-(defun gnus-header-subject (header)
-  "Return subject string in HEADER."
-  (nntp-header-subject header))
-
-(defun gnus-header-from (header)
-  "Return author string in HEADER."
-  (nntp-header-from header))
-
-(defun gnus-header-xref (header)
-  "Return xref string in HEADER."
-  (nntp-header-xref header))
-
-(defun gnus-header-lines (header)
-  "Return lines in HEADER."
-  (nntp-header-lines header))
-
-(defun gnus-header-date (header)
-  "Return date in HEADER."
-  (nntp-header-date header))
-
-(defun gnus-header-id (header)
-  "Return Id in HEADER."
-  (nntp-header-id header))
-
-(defun gnus-header-references (header)
-  "Return references in HEADER."
-  (nntp-header-references header))
-
-
-;;;
-;;; Article savers.
-;;;
-
-(defun gnus-output-to-rmail (file-name)
-  "Append the current article to an Rmail file named FILE-NAME."
-  (require 'rmail)
-  ;; Most of these codes are borrowed from rmailout.el.
-  (setq file-name (expand-file-name file-name))
-  (setq rmail-default-rmail-file file-name)
-  (let ((artbuf (current-buffer))
-	(tmpbuf (get-buffer-create " *GNUS-output*")))
-    (save-excursion
-      (or (get-file-buffer file-name)
-	  (file-exists-p file-name)
-	  (if (yes-or-no-p
-	       (concat "\"" file-name "\" does not exist, create it? "))
-	      (let ((file-buffer (create-file-buffer file-name)))
-		(save-excursion
-		  (set-buffer file-buffer)
-		  (rmail-insert-rmail-file-header)
-		  (let ((require-final-newline nil))
-		    (write-region (point-min) (point-max) file-name t 1)))
-		(kill-buffer file-buffer))
-	    (error "Output file does not exist")))
-      (set-buffer tmpbuf)
-      (buffer-flush-undo (current-buffer))
-      (erase-buffer)
-      (insert-buffer-substring artbuf)
-      (gnus-convert-article-to-rmail)
-      ;; Decide whether to append to a file or to an Emacs buffer.
-      (let ((outbuf (get-file-buffer file-name)))
-	(if (not outbuf)
-	    (append-to-file (point-min) (point-max) file-name)
-	  ;; File has been visited, in buffer OUTBUF.
-	  (set-buffer outbuf)
-	  (let ((buffer-read-only nil)
-		(msg (and (boundp 'rmail-current-message)
-			  rmail-current-message)))
-	    ;; If MSG is non-nil, buffer is in RMAIL mode.
-	    (if msg
-		(progn (widen)
-		       (narrow-to-region (point-max) (point-max))))
-	    (insert-buffer-substring tmpbuf)
-	    (if msg
-		(progn
-		  (goto-char (point-min))
-		  (widen)
-		  (search-backward "\^_")
-		  (narrow-to-region (point) (point-max))
-		  (goto-char (1+ (point-min)))
-		  (rmail-count-new-messages t)
-		  (rmail-show-message msg))))))
-      )
-    (kill-buffer tmpbuf)
-    ))
-
-(defun gnus-output-to-file (file-name)
-  "Append the current article to a file named FILE-NAME."
-  (setq file-name (expand-file-name file-name))
-  (let ((artbuf (current-buffer))
-	(tmpbuf (get-buffer-create " *GNUS-output*")))
-    (save-excursion
-      (set-buffer tmpbuf)
-      (buffer-flush-undo (current-buffer))
-      (erase-buffer)
-      (insert-buffer-substring artbuf)
-      ;; Append newline at end of the buffer as separator, and then
-      ;; save it to file.
-      (goto-char (point-max))
-      (insert "\n")
-      (append-to-file (point-min) (point-max) file-name))
-    (kill-buffer tmpbuf)
-    ))
-
-(defun gnus-convert-article-to-rmail ()
-  "Convert article in current buffer to Rmail message format."
-  (let ((buffer-read-only nil))
-    ;; Convert article directly into Babyl format.
-    ;; Suggested by Rob Austein <sra@lcs.mit.edu>
-    (goto-char (point-min))
-    (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
-    (while (search-forward "\n\^_" nil t) ;single char
-      (replace-match "\n^_"))		;2 chars: "^" and "_"
-    (goto-char (point-max))
-    (insert "\^_")))
-
-;;(defun gnus-convert-article-to-rmail ()
-;;  "Convert article in current buffer to Rmail message format."
-;;  (let ((buffer-read-only nil))
-;;    ;; Insert special header of Unix mail.
-;;    (goto-char (point-min))
-;;    (insert "From "
-;;	    (or (mail-strip-quoted-names (mail-fetch-field "from"))
-;;		"unknown")
-;;	    " " (current-time-string) "\n")
-;;    ;; Stop quoting `From' since this seems unnecessary in most cases.
-;;    ;; ``Quote'' "\nFrom " as "\n>From "
-;;    ;;(while (search-forward "\nFrom " nil t)
-;;    ;;  (forward-char -5)
-;;    ;;  (insert ?>))
-;;    ;; Convert article to babyl format.
-;;    (rmail-convert-to-babyl-format)
-;;    ))
-
-
-;;;
-;;; Internal functions.
-;;;
-
-(defun gnus-start-news-server (&optional confirm)
-  "Open network stream to remote NNTP server.
-If optional argument CONFIRM is non-nil, ask you host that NNTP server
-is running even if it is defined.
-Run `gnus-open-server-hook' just before opening news server."
-  (if (gnus-server-opened)
-      ;; Stream is already opened.
-      nil
-    ;; Open NNTP server.
-    (if (or confirm
-	    (null gnus-nntp-server))
-	;; If someone has set the service to nil, then this should always
-	;; be the local host.
-	(if gnus-nntp-service
-	    (if (and (boundp 'gnus-secondary-servers) gnus-secondary-servers)
-		;; Read server name with completion.
-		(setq gnus-nntp-server
-		      (completing-read "NNTP server: "
-				       (cons (list gnus-nntp-server)
-					     gnus-secondary-servers)
-				       nil nil gnus-nntp-server))
-	      (setq gnus-nntp-server
-		    (read-string "NNTP server: " gnus-nntp-server)))
-	  (setq gnus-nntp-server "")))
-    ;; If no server name is given, local host is assumed.
-    (if (or (string-equal gnus-nntp-server "")
-	    (string-equal gnus-nntp-server "::")) ;RMS preference.
-	(setq gnus-nntp-server (system-name)))
-    ;; gnus-nntp-server must be either (system-name), ':DIRECTORY', or
-    ;; nntp server name.  I mean '::' cannot be a value of
-    ;; gnus-nntp-server.
-    (cond ((and (null gnus-nntp-service)
-		(string-equal gnus-nntp-server (system-name)))
-	   (require 'nnspool)
-	   (gnus-define-access-method 'nnspool)
-	   (message "Looking up local news spool..."))
-	  ((string-match ":" gnus-nntp-server)
-	   ;; :DIRECTORY
-	   (require 'mhspool)
-	   (gnus-define-access-method 'mhspool)
-	   (message "Looking up private directory..."))
-	  (t
-	   (gnus-define-access-method 'nntp)
-	   (message "Connecting to NNTP server on %s..." gnus-nntp-server)))
-    (run-hooks 'gnus-open-server-hook)
-    (cond ((gnus-server-opened)		;Maybe opened in gnus-open-server-hook.
-	   (message ""))
-	  ((gnus-open-server gnus-nntp-server gnus-nntp-service)
-	   (message ""))
-	  (t
-	   (error "%s"
-	    (gnus-nntp-message
-	     (format "Cannot open NNTP server on %s" gnus-nntp-server)))))
-    ))
-
-;; Dummy functions used only once.  Should return nil.
-(defun gnus-server-opened () nil)
-(defun gnus-close-server () nil)
-
-(defun gnus-nntp-message (&optional message)
-  "Return a message returned from NNTP server.
-If no message is available and optional MESSAGE is given, return it."
-  (let ((status (gnus-status-message))
-	(message (or message "")))
-    (if (and (stringp status)
-	     (> (length status) 0))
-	status message)))
-
-(defun gnus-define-access-method (method &optional access-methods)
-  "Define access functions for the access METHOD.
-Methods definition is taken from optional argument ACCESS-METHODS or
-the variable `gnus-access-methods'."
-  (let ((bindings
-	 (cdr (assoc method (or access-methods gnus-access-methods)))))
-    (if (null bindings)
-	(error "Unknown access method: %s" method)
-      ;; Should not use symbol-function here since overload does not work.
-      (while bindings
-	;; Alist syntax is different from that of 3.14.3.
-	(fset (car (car bindings)) (car (cdr (car bindings))))
-	(setq bindings (cdr bindings)))
-      )))
-
-(defun gnus-select-newsgroup (group &optional show-all)
-  "Select newsgroup GROUP.
-If optional argument SHOW-ALL is non-nil, all of articles in the group
-are selected."
-  ;; Make sure a connection to NNTP server is alive.
-  (gnus-start-news-server)
-  (if (gnus-request-group group)
-      (let ((articles nil))
-	(setq gnus-newsgroup-name group)
-	(setq gnus-newsgroup-unreads
-	      (gnus-uncompress-sequence
-	       (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
-	(cond (show-all
-	       ;; Select all active articles.
-	       (setq articles
-		     (gnus-uncompress-sequence
-		      (nthcdr 2 (gnus-gethash group gnus-active-hashtb)))))
-	      (t
-	       ;; Select unread articles only.
-	       (setq articles gnus-newsgroup-unreads)))
-	;; Require confirmation if selecting large newsgroup.
-	(setq gnus-newsgroup-unselected nil)
-	(if (not (numberp gnus-large-newsgroup))
-	    nil
-	  (let ((selected nil)
-		(number (length articles)))
-	    (if (> number gnus-large-newsgroup)
-		(progn
-		  (condition-case ()
-		      (let ((input
-			     (read-string
-			      (format
-			       "How many articles from %s (default %d): "
-			       gnus-newsgroup-name number))))
-			(setq selected
-			      (if (string-equal input "")
-				  number (string-to-int input))))
-		    (quit
-		     (setq selected 0)))
-		  (cond ((and (> selected 0)
-			      (< selected number))
-			 ;; Select last N articles.
-			 (setq articles (nthcdr (- number selected) articles)))
-			((and (< selected 0)
-			      (< (- 0 selected) number))
-			 ;; Select first N articles.
-			 (setq selected (- 0 selected))
-			 (setq articles (copy-sequence articles))
-			 (setcdr (nthcdr (1- selected) articles) nil))
-			((zerop selected)
-			 (setq articles nil))
-			;; Otherwise select all.
-			)
-		  ;; Get unselected unread articles.
-		  (setq gnus-newsgroup-unselected
-			(gnus-set-difference gnus-newsgroup-unreads articles))
-		  ))
-	    ))
-	;; Get headers list.
-	(setq gnus-newsgroup-headers (gnus-retrieve-headers articles))
-	;; UNREADS may contain expired articles, so we have to remove
-	;;  them from the list.
-	(setq gnus-newsgroup-unreads
-	      (gnus-intersection gnus-newsgroup-unreads
-				 (mapcar
-				  (function
-				   (lambda (header)
-				     (nntp-header-number header)))
-				  gnus-newsgroup-headers)))
-	;; Marked article must be a subset of unread articles.
-	(setq gnus-newsgroup-marked
-	      (gnus-intersection (append gnus-newsgroup-unselected
-					 gnus-newsgroup-unreads)
-				 (cdr
-				  (gnus-gethash group gnus-marked-hashtb))))
-	;; First and last article in this newsgroup.
-	(setq gnus-newsgroup-begin
-	      (if gnus-newsgroup-headers
-		  (nntp-header-number (car gnus-newsgroup-headers))
-		0
-		))
-	(setq gnus-newsgroup-end
-	      (if gnus-newsgroup-headers
-		  (nntp-header-number
-		   (gnus-last-element gnus-newsgroup-headers))
-		0
-		))
-	;; File name that an article was saved last.
-	(setq gnus-newsgroup-last-rmail nil)
-	(setq gnus-newsgroup-last-mail nil)
-	(setq gnus-newsgroup-last-folder nil)
-	(setq gnus-newsgroup-last-file nil)
-	;; Reset article pointer etc.
-	(setq gnus-current-article nil)
-	(setq gnus-current-headers nil)
-	(setq gnus-current-history nil)
-	(setq gnus-have-all-headers nil)
-	(setq gnus-last-article nil)
-	;; Clear old hash tables for the variable gnus-newsgroup-headers.
-	(gnus-clear-hashtables-for-newsgroup-headers)
-	;; GROUP is successfully selected.
-	t
-	)
-    ))
-
-;; Hacking for making header search much faster.
-
-(defun gnus-get-header-by-number (number)
-  "Return a header specified by a NUMBER.
-If you update the variable `gnus-newsgroup-headers', you must set the
-hash table `gnus-newsgroup-headers-hashtb-by-number' to nil to indicate
-rehash is necessary."
-  (or gnus-newsgroup-headers-hashtb-by-number
-      (gnus-make-headers-hashtable-by-number))
-  (gnus-gethash (int-to-string number)
-		gnus-newsgroup-headers-hashtb-by-number))
-
-(defun gnus-get-header-by-id (id)
-  "Return a header specified by an ID.
-If you update the variable `gnus-newsgroup-headers', you must set the
-hash table `gnus-newsgroup-headers-hashtb-by-id' to nil to indicate
-rehash is necessary."
-  (or gnus-newsgroup-headers-hashtb-by-id
-      (gnus-make-headers-hashtable-by-id))
-  (and (stringp id)
-       (gnus-gethash id gnus-newsgroup-headers-hashtb-by-id)))
-
-(defun gnus-make-headers-hashtable-by-number ()
-  "Make hashtable for the variable `gnus-newsgroup-headers' by number."
-  (let ((header nil)
-	(headers gnus-newsgroup-headers))
-    (setq gnus-newsgroup-headers-hashtb-by-number
-	  (gnus-make-hashtable (length headers)))
-    (while headers
-      (setq header (car headers))
-      (gnus-sethash (int-to-string (nntp-header-number header))
-		    header gnus-newsgroup-headers-hashtb-by-number)
-      (setq headers (cdr headers))
-      )))
-
-(defun gnus-make-headers-hashtable-by-id ()
-  "Make hashtable for the variable `gnus-newsgroup-headers' by id."
-  (let ((header nil)
-	(headers gnus-newsgroup-headers))
-    (setq gnus-newsgroup-headers-hashtb-by-id
-	  (gnus-make-hashtable (length headers)))
-    (while headers
-      (setq header (car headers))
-      (gnus-sethash (nntp-header-id header)
-		    header gnus-newsgroup-headers-hashtb-by-id)
-      (setq headers (cdr headers))
-      )))
-
-(defun gnus-clear-hashtables-for-newsgroup-headers ()
-  "Clear hash tables created for the variable `gnus-newsgroup-headers'."
-  (setq gnus-newsgroup-headers-hashtb-by-id nil)
-  (setq gnus-newsgroup-headers-hashtb-by-number nil))
-
-(defun gnus-more-header-backward ()
-  "Find new header backward."
-  (let ((first
-	 (car (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
-	(artnum gnus-newsgroup-begin)
-	(header nil))
-    (while (and (not header)
-		(> artnum first))
-      (setq artnum (1- artnum))
-      (setq header (car (gnus-retrieve-headers (list artnum)))))
-    header
-    ))
-
-(defun gnus-more-header-forward ()
-  "Find new header forward."
-  (let ((last
-	 (cdr (nth 2 (gnus-gethash gnus-newsgroup-name gnus-active-hashtb))))
-	(artnum gnus-newsgroup-end)
-	(header nil))
-    (while (and (not header)
-		(< artnum last))
-      (setq artnum (1+ artnum))
-      (setq header (car (gnus-retrieve-headers (list artnum)))))
-    header
-    ))
-
-(defun gnus-extend-newsgroup (header &optional backward)
-  "Extend newsgroup selection with HEADER.
-Optional argument BACKWARD means extend toward backward."
-  (if header
-      (let ((artnum (nntp-header-number header)))
-	(setq gnus-newsgroup-headers
-	      (if backward
-		  (cons header gnus-newsgroup-headers)
-		(append gnus-newsgroup-headers (list header))))
-	;; Clear current hash tables for the variable gnus-newsgroup-headers.
-	(gnus-clear-hashtables-for-newsgroup-headers)
-	;; We have to update unreads and unselected, but don't have to
-	;; care about gnus-newsgroup-marked.
-	(if (memq artnum gnus-newsgroup-unselected)
-	    (setq gnus-newsgroup-unreads
-		  (cons artnum gnus-newsgroup-unreads)))
-	(setq gnus-newsgroup-unselected
-	      (delq artnum gnus-newsgroup-unselected))
-	(setq gnus-newsgroup-begin (min gnus-newsgroup-begin artnum))
-	(setq gnus-newsgroup-end (max gnus-newsgroup-end artnum))
-	)))
-
-(defun gnus-mark-article-as-read (article)
-  "Remember that ARTICLE is marked as read."
-  ;; Remove from unread and marked list.
-  (setq gnus-newsgroup-unreads
-	(delq article gnus-newsgroup-unreads))
-  (setq gnus-newsgroup-marked
-	(delq article gnus-newsgroup-marked)))
-
-(defun gnus-mark-article-as-unread (article &optional clear-mark)
-  "Remember that ARTICLE is marked as unread.
-Optional argument CLEAR-MARK means ARTICLE should not be remembered
-that it was marked as read once."
-  ;; Add to unread list.
-  (or (memq article gnus-newsgroup-unreads)
-      (setq gnus-newsgroup-unreads
-	    (cons article gnus-newsgroup-unreads)))
-  ;; If CLEAR-MARK is non-nil, the article must be removed from marked
-  ;; list.  Otherwise, it must be added to the list.
-  (if clear-mark
-      (setq gnus-newsgroup-marked
-	    (delq article gnus-newsgroup-marked))
-    (or (memq article gnus-newsgroup-marked)
-	(setq gnus-newsgroup-marked
-	      (cons article gnus-newsgroup-marked)))))
-
-(defun gnus-clear-system ()
-  "Clear all variables and buffer."
-  ;; Clear GNUS variables.
-  (let ((variables gnus-variable-list))
-    (while variables
-      (set (car variables) nil)
-      (setq variables (cdr variables))))
-  ;; Clear other internal variables.
-  (setq gnus-newsrc-hashtb nil)
-  (setq gnus-marked-hashtb nil)
-  (setq gnus-killed-hashtb nil)
-  (setq gnus-active-hashtb nil)
-  (setq gnus-octive-hashtb nil)
-  (setq gnus-unread-hashtb nil)
-  (setq gnus-newsgroup-headers nil)
-  (setq gnus-newsgroup-headers-hashtb-by-id nil)
-  (setq gnus-newsgroup-headers-hashtb-by-number nil)
-  ;; Kill the startup file.
-  (and gnus-current-startup-file
-       (get-file-buffer gnus-current-startup-file)
-       (kill-buffer (get-file-buffer gnus-current-startup-file)))
-  (setq gnus-current-startup-file nil)
-  ;; Kill GNUS buffers.
-  (let ((buffers gnus-buffer-list))
-    (while buffers
-      (if (get-buffer (car buffers))
-	  (kill-buffer (car buffers)))
-      (setq buffers (cdr buffers))
-      )))
-
-(defun gnus-configure-windows (action)
-  "Configure GNUS windows according to the next ACTION.
-The ACTION is either a symbol, such as `summary', or a
-configuration list such as `(1 1 2)'.  If ACTION is not a list,
-configuration list is got from the variable `gnus-window-configuration'."
-  (let* ((windows
-	  (if (listp action)
-	      action (car (cdr (assq action gnus-window-configuration)))))
-	 (grpwin (get-buffer-window gnus-group-buffer))
-	 (subwin (get-buffer-window gnus-summary-buffer))
-	 (artwin (get-buffer-window gnus-article-buffer))
-	 (winsum nil)
-	 (height nil)
-	 (grpheight 0)
-	 (subheight 0)
-	 (artheight 0)
-	 ;; Make split-window-vertically leave focus in upper window.
-	 (split-window-keep-point t))
-    (if (or (null windows)		;No configuration is specified.
-	    (and (eq (null grpwin)
-		     (zerop (nth 0 windows)))
-		 (eq (null subwin)
-		     (zerop (nth 1 windows)))
-		 (eq (null artwin)
-		     (zerop (nth 2 windows)))))
-	;; No need to change window configuration.
-	nil
-      (select-window (or grpwin subwin artwin (selected-window)))
-      ;; First of all, compute the height of each window.
-      (cond (gnus-use-full-window
-	     ;; Take up the entire screen.
-	     (delete-other-windows)
-	     (setq height (window-height (selected-window))))
-	    (t
-	     (setq height (+ (if grpwin (window-height grpwin) 0)
-			     (if subwin (window-height subwin) 0)
-			     (if artwin (window-height artwin) 0)))))
-      ;; The Newsgroup buffer exits always.  So, use it to extend the
-      ;; Group window so as to get enough window space.
-      (switch-to-buffer gnus-group-buffer 'norecord)
-      (and (get-buffer gnus-summary-buffer)
-	   (delete-windows-on gnus-summary-buffer))
-      (and (get-buffer gnus-article-buffer)
-	   (delete-windows-on gnus-article-buffer))
-      ;; Compute expected window height.
-      (setq winsum (apply (function +) windows))
-      (if (not (zerop (nth 0 windows)))
-	  (setq grpheight (max window-min-height
-			       (/ (* height (nth 0 windows)) winsum))))
-      (if (not (zerop (nth 1 windows)))
-	  (setq subheight (max window-min-height
-			       (/ (* height (nth 1 windows)) winsum))))
-      (if (not (zerop (nth 2 windows)))
-	  (setq artheight (max window-min-height
-			       (/ (* height (nth 2 windows)) winsum))))
-      (setq height (+ grpheight subheight artheight))
-      (enlarge-window (max 0 (- height (window-height (selected-window)))))
-      ;; Then split the window.
-      (and (not (zerop artheight))
-	   (or (not (zerop grpheight))
-	       (not (zerop subheight)))
-	   (split-window-vertically (+ grpheight subheight)))
-      (and (not (zerop grpheight))
-	   (not (zerop subheight))
-	   (split-window-vertically grpheight))
-      ;; Then select buffers in each window.
-      (and (not (zerop grpheight))
-	   (progn
-	     (switch-to-buffer gnus-group-buffer 'norecord)
-	     (other-window 1)))
-      (and (not (zerop subheight))
-	   (progn
-	     (switch-to-buffer gnus-summary-buffer 'norecord)
-	     (other-window 1)))
-      (and (not (zerop artheight))
-	   (progn
-	     ;; If Article buffer does not exist, it will be created
-	     ;; and initialized.
-	     (gnus-article-setup-buffer)
-	     (switch-to-buffer gnus-article-buffer 'norecord)))
-      )
-    ))
-
-(defun gnus-find-header-by-number (headers number)
-  "Return a header which is a element of HEADERS and has NUMBER."
-  (let ((found nil))
-    (while (and headers (not found))
-      ;; We cannot use `=' to accept non-numeric NUMBER.
-      (if (eq number (nntp-header-number (car headers)))
-	  (setq found (car headers)))
-      (setq headers (cdr headers)))
-    found
-    ))
-
-(defun gnus-find-header-by-id (headers id)
-  "Return a header which is a element of HEADERS and has Message-ID."
-  (let ((found nil))
-    (while (and headers (not found))
-      (if (string-equal id (nntp-header-id (car headers)))
-	  (setq found (car headers)))
-      (setq headers (cdr headers)))
-    found
-    ))
-
-(defun gnus-version ()
-  "Version numbers of this version of GNUS."
-  (interactive)
-  (cond ((and (boundp 'mhspool-version) (boundp 'nnspool-version))
-	 (message "%s; %s; %s; %s"
-		  gnus-version nntp-version nnspool-version mhspool-version))
-	((boundp 'mhspool-version)
-	 (message "%s; %s; %s"
-		  gnus-version nntp-version mhspool-version))
-	((boundp 'nnspool-version)
-	 (message "%s; %s; %s"
-		  gnus-version nntp-version nnspool-version))
-	(t
-	 (message "%s; %s" gnus-version nntp-version))))
-
-(defun gnus-info-find-node ()
-  "Find Info documentation of GNUS."
-  (interactive)
-  (require 'info)
-  ;; Enlarge info window if needed.
-  (cond ((eq major-mode 'gnus-group-mode)
-	 (gnus-configure-windows '(1 0 0)) ;Take all windows.
-	 (pop-to-buffer gnus-group-buffer))
-	((eq major-mode 'gnus-summary-mode)
-	 (gnus-configure-windows '(0 1 0)) ;Take all windows.
-	 (pop-to-buffer gnus-summary-buffer)))
-  (Info-goto-node (car (cdr (assq major-mode gnus-info-nodes)))))
-
-(defun gnus-overload-functions (&optional overloads)
-  "Overload functions specified by optional argument OVERLOADS.
-If nothing is specified, use the variable `gnus-overload-functions'."
-  (let ((defs nil)
-	(overloads (or overloads gnus-overload-functions)))
-    (while overloads
-      (setq defs (car overloads))
-      (setq overloads (cdr overloads))
-      ;; Load file before overloading function if necessary.  Make
-      ;; sure we cannot use `require' always.
-      (and (not (fboundp (car defs)))
-	   (car (cdr (cdr defs)))
-	   (load (car (cdr (cdr defs))) nil 'nomessage))
-      (fset (car defs) (car (cdr defs)))
-      )))
-
-(defun gnus-make-threads (newsgroup-headers)
-  "Make conversation threads tree from NEWSGROUP-HEADERS."
-  (let ((headers newsgroup-headers)
-	(refer nil)
-	(h nil)
-	(d nil)
-	(roots nil)
-	(dependencies nil))
-    ;; Make message dependency alist.
-    (while headers
-      (setq h (car headers))
-      (setq headers (cdr headers))
-      ;; Ignore invalid headers.
-      (if (vectorp h)			;Depends on nntp.el.
-	  (progn
-	    ;; Ignore broken references, e.g "<123@a.b.c".
-	    (setq refer (nntp-header-references h))
-	    (setq d (and refer
-			 (string-match "\\(<[^<>]+>\\)[^>]*$" refer)
-;;			 (gnus-find-header-by-id
-;;			  newsgroup-headers
-;;			  (substring refer (match-beginning 1) (match-end 1)))
-			 ;; In fact if the variable newsgroup-headers
-			 ;; is not 'equal' to the variable
-			 ;; gnus-newsgroup-headers, the following
-			 ;; function call may return bogus value.
-			 (gnus-get-header-by-id
-			  (substring refer (match-beginning 1) (match-end 1)))
-			 ))
-	    ;; Check subject equality.
-	    (or gnus-thread-ignore-subject
-		(null d)
-		(string-equal (gnus-simplify-subject
-			       (nntp-header-subject h) 're)
-			      (gnus-simplify-subject
-			       (nntp-header-subject d) 're))
-		;; H should be a thread root.
-		(setq d nil))
-	    ;; H depends on D.
-	    (setq dependencies
-		  (cons (cons h d) dependencies))
-	    ;; H is a thread root.
-	    (if (null d)
-		(setq roots (cons h roots)))
-	    ))
-      )
-    ;; Make complete threads from the roots.
-    ;; Note: dependencies are in reverse order, but
-    ;; gnus-make-threads-1 processes it in reverse order again.  So,
-    ;; we don't have to worry about it.
-    (mapcar
-     (function
-      (lambda (root)
-	(gnus-make-threads-1 root dependencies))) (nreverse roots))
-    ))
-
-(defun gnus-make-threads-1 (parent dependencies)
-  (let ((children nil)
-	(d nil)
-	(depends dependencies))
-    ;; Find children.
-    (while depends
-      (setq d (car depends))
-      (setq depends (cdr depends))
-      (and (cdr d)
-	   (eq (nntp-header-id parent) (nntp-header-id (cdr d)))
-	   (setq children (cons (car d) children))))
-    ;; Go down.
-    (cons parent
-	  (mapcar
-	   (function
-	    (lambda (child)
-	      (gnus-make-threads-1 child dependencies))) children))
-    ))
-
-(defun gnus-narrow-to-page (&optional arg)
-  "Make text outside current page invisible except for page delimiter.
-A numeric arg specifies to move forward or backward by that many pages,
-thus showing a page other than the one point was originally in."
-  (interactive "P")
-  (setq arg (if arg (prefix-numeric-value arg) 0))
-  (save-excursion
-    (forward-page -1)			;Beginning of current page.
-    (widen)
-    (if (> arg 0)
-	(forward-page arg)
-      (if (< arg 0)
-	  (forward-page (1- arg))))
-    ;; Find the end of the page.
-    (forward-page)
-    ;; If we stopped due to end of buffer, stay there.
-    ;; If we stopped after a page delimiter, put end of restriction
-    ;; at the beginning of that line.
-    ;; These are commented out.
-    ;;    (if (save-excursion (beginning-of-line)
-    ;;			(looking-at page-delimiter))
-    ;;	(beginning-of-line))
-    (narrow-to-region (point)
-		      (progn
-			;; Find the top of the page.
-			(forward-page -1)
-			;; If we found beginning of buffer, stay there.
-			;; If extra text follows page delimiter on same line,
-			;; include it.
-			;; Otherwise, show text starting with following line.
-			(if (and (eolp) (not (bobp)))
-			    (forward-line 1))
-			(point)))
-    ))
-
-;; Create hash table for alist, such as gnus-newsrc-assoc,
-;; gnus-killed-assoc, and gnus-marked-assoc.
-
-(defun gnus-make-hashtable-from-alist (alist &optional hashsize)
-  "Return hash table for ALIST.
-Optional argument HASHSIZE specifies the hashtable size.
-Hash key is a car of alist element, which must be a string."
-  (let ((hashtb (gnus-make-hashtable (or hashsize (length alist)))))
-    (while alist
-      (gnus-sethash (car (car alist))	;Newsgroup name
-		    (car alist)		;Alist element
-		    hashtb)
-      (setq alist (cdr alist)))
-    hashtb
-    ))
-
-(defun gnus-last-element (list)
-  "Return last element of LIST."
-  (let ((last nil))
-    (while list
-      (if (null (cdr list))
-	  (setq last (car list)))
-      (setq list (cdr list)))
-    last
-    ))
-
-(defun gnus-set-difference (list1 list2)
-  "Return a list of elements of LIST1 that do not appear in LIST2."
-  (let ((list1 (copy-sequence list1)))
-    (while list2
-      (setq list1 (delq (car list2) list1))
-      (setq list2 (cdr list2)))
-    list1
-    ))
-
-(defun gnus-intersection (list1 list2)
-  "Return a list of elements that appear in both LIST1 and LIST2."
-  (let ((result nil))
-    (while list2
-      (if (memq (car list2) list1)
-	  (setq result (cons (car list2) result)))
-      (setq list2 (cdr list2)))
-    result
-    ))
-
-
-;;;
-;;; Get information about active articles, already read articles, and
-;;;  still unread articles.
-;;;
-
-;; GNUS internal format of gnus-newsrc-assoc and gnus-killed-assoc:
-;; (("general" t (1 . 1))
-;;  ("misc"    t (1 . 10) (12 . 15))
-;;  ("test"  nil (1 . 99)) ...)
-;; GNUS internal format of gnus-marked-assoc:
-;; (("general" 1 2 3)
-;;  ("misc" 2) ...)
-;; GNUS internal format of gnus-active-hashtb:
-;; (("general" t (1 . 1))
-;;  ("misc"    t (1 . 10))
-;;  ("test"  nil (1 . 99)) ...)
-;; GNUS internal format of gnus-unread-hashtb:
-;; (("general" 1 (1 . 1))
-;;  ("misc"   14 (1 . 10) (12 . 15))
-;;  ("test"   99 (1 . 99)) ...)
-
-(defun gnus-setup-news (&optional rawfile)
-  "Setup news information.
-If optional argument RAWFILE is non-nil, force to read raw startup file."
-  (let ((init (not (and gnus-newsrc-assoc
-			gnus-active-hashtb
-			gnus-unread-hashtb
-			(not rawfile)
-			))))
-    ;; We have to clear some variables to re-initialize news info.
-    (if init
-	(setq gnus-newsrc-assoc nil
-	      gnus-active-hashtb nil
-	      gnus-unread-hashtb nil))
-    (gnus-read-active-file)
-    ;; Initialize only once.
-    (if init
-	(progn
-	  ;; Get distributions only once.
-	  (gnus-read-distributions-file)
-	  ;; newsrc file must be read after reading active file since
-	  ;; its size is used to guess the size of gnus-newsrc-hashtb.
-	  (gnus-read-newsrc-file rawfile)
-	  ))
-    (gnus-expire-marked-articles)
-    (gnus-get-unread-articles)
-    
-    ;; newsgroups description
-    (if gnus-newsgroups-display
-	(if (not gnus-newsgroups-alist)
-	    ;; Get newsgroups file only once.
-	    (gnus-newsgroups-retrieve-description)))
-	
-    (setq gnus-newsgroups-hashtb (gnus-make-hashtable-from-alist gnus-newsgroups-alist))
-    
-    ;; Check new newsgroups and subscribe them.
-    (if init
-	(let ((new-newsgroups (gnus-find-new-newsgroups)))
-	  (while new-newsgroups
-	    (funcall gnus-subscribe-newsgroup-method (car new-newsgroups))
-	    (setq new-newsgroups (cdr new-newsgroups))
-	    )))
-    ))
-
-(defun gnus-add-newsgroup (newsgroup)
-  "Subscribe new NEWSGROUP safely and put it at top."
-  (and (null (gnus-gethash newsgroup gnus-newsrc-hashtb)) ;Really new?
-       (gnus-gethash newsgroup gnus-active-hashtb) ;Really exist?
-       (gnus-insert-newsgroup (or (gnus-gethash newsgroup gnus-killed-hashtb)
-				  (list newsgroup t))
-			      (car (car gnus-newsrc-assoc)))))
-
-(defun gnus-find-new-newsgroups ()
-  "Looking for new newsgroups and return names.
-`-n' option of options line in `.newsrc' file is recognized."
-  (let ((group nil)
-	(new-newsgroups nil))
-    (mapatoms
-     (function
-      (lambda (sym)
-	(setq group (symbol-name sym))
-	;; Taking account of `-n' option.
-	(and (or (null gnus-newsrc-options-n-no)
-		 (not (string-match gnus-newsrc-options-n-no group))
-		 (and gnus-newsrc-options-n-yes
-		      (string-match gnus-newsrc-options-n-yes group)))
-	     (null (gnus-gethash group gnus-killed-hashtb)) ;Ignore killed.
-	     (null (gnus-gethash group gnus-newsrc-hashtb)) ;Really new.
-	     ;; Find new newsgroup.
-	     (setq new-newsgroups
-		   (cons group new-newsgroups)))
-	))
-     gnus-active-hashtb)
-    ;; Return new newsgroups.
-    new-newsgroups
-    ))
-
-(defun gnus-kill-newsgroup (group)
-  "Kill GROUP from `gnus-newsrc-assoc', `.newsrc' and `gnus-unread-hashtb'."
-  (let ((info (gnus-gethash group gnus-newsrc-hashtb)))
-    (if (null info)
-	nil
-      ;; Delete from gnus-newsrc-assoc and gnus-newsrc-hashtb.
-      (setq gnus-newsrc-assoc (delq info gnus-newsrc-assoc))
-      (gnus-sethash group nil gnus-newsrc-hashtb)
-      ;; Add to gnus-killed-assoc and gnus-killed-hashtb.
-      (setq gnus-killed-assoc
-	    (cons info
-		  (delq (gnus-gethash group gnus-killed-hashtb)
-			gnus-killed-assoc)))
-      (gnus-sethash group info gnus-killed-hashtb)
-      ;; Clear unread hashtable.
-      ;; Thanks cwitty@csli.Stanford.EDU (Carl Witty).
-      (gnus-sethash group nil gnus-unread-hashtb)
-      ;; Then delete from .newsrc
-      (gnus-update-newsrc-buffer group 'delete)
-      ;; Return the deleted newsrc entry.
-      info
-      )))
-
-(defun gnus-insert-newsgroup (info &optional next)
-  "Insert newsrc INFO entry before NEXT.
-If optional argument NEXT is nil, appended to the last."
-  (if (null info)
-      (error "Invalid argument: %s" info))
-  (let* ((group (car info))		;Newsgroup name.
-	 (range
-	  (gnus-difference-of-range
-	   (nth 2 (gnus-gethash group gnus-active-hashtb)) (nthcdr 2 info))))
-    ;; Check duplication.
-    (if (gnus-gethash group gnus-newsrc-hashtb)
-	(error "Duplicated: %s" group))
-    ;; Insert to gnus-newsrc-assoc and gnus-newsrc-hashtb.
-    (if (string-equal next (car (car gnus-newsrc-assoc)))
-	(setq gnus-newsrc-assoc
-	      (cons info gnus-newsrc-assoc))
-      (let ((found nil)
-	    (rest (cdr gnus-newsrc-assoc))
-	    (tail gnus-newsrc-assoc))
-	;; Seach insertion point.
-	(while (and (not found) rest)
-	  (if (string-equal next (car (car rest)))
-	      (setq found t)
-	    (setq rest (cdr rest))
-	    (setq tail (cdr tail))
-	    ))
-	;; Find it.
-	(if (consp tail)
-	    (setcdr tail (cons info rest))
-	  ;; gnus-newsrc-assoc must be nil.
-	  (setq gnus-newsrc-assoc
-		(append gnus-newsrc-assoc (cons info rest))))
-	))
-    (gnus-sethash group info gnus-newsrc-hashtb)
-    ;; Delete from gnus-killed-assoc and gnus-killed-hashtb.
-    (setq gnus-killed-assoc
-	  (delq (gnus-gethash group gnus-killed-hashtb) gnus-killed-assoc))
-    (gnus-sethash group nil gnus-killed-hashtb)
-    ;; Then insert to .newsrc.
-    (gnus-update-newsrc-buffer group nil next)
-    ;; Add to gnus-unread-hashtb.
-    (gnus-sethash group
-		  (cons group		;Newsgroup name.
-			(cons (gnus-number-of-articles range) range))
-		  gnus-unread-hashtb)
-    ))
-
-(defun gnus-check-killed-newsgroups ()
-  "Update `gnus-killed-assoc' based on `gnus-newsrc-assoc'.
-Update `gnus-killed-hashtb' also."
-  (let ((group nil)
-	(new-killed nil)
-	(old-killed gnus-killed-assoc))
-    (while old-killed
-      (setq group (car (car old-killed)))
-      (and (or (null gnus-newsrc-options-n-no)
-	       (not (string-match gnus-newsrc-options-n-no group))
-	       (and gnus-newsrc-options-n-yes
-		    (string-match gnus-newsrc-options-n-yes group)))
-	   (null (gnus-gethash group gnus-newsrc-hashtb)) ;No duplication.
-	   ;; Subscribed in options line and not in gnus-newsrc-assoc.
-	   (setq new-killed
-		 (cons (car old-killed) new-killed)))
-      (setq old-killed (cdr old-killed))
-      )
-    (setq gnus-killed-assoc (nreverse new-killed))
-    (setq gnus-killed-hashtb
-	  (gnus-make-hashtable-from-alist gnus-killed-assoc))
-    ))
-
-(defun gnus-check-bogus-newsgroups (&optional confirm)
-  "Delete bogus newsgroups.
-If optional argument CONFIRM is non-nil, confirm deletion of newsgroups."
-  (let ((group nil)			;Newsgroup name temporary used.
-	(old-newsrc gnus-newsrc-assoc)
-	(new-newsrc nil)
-	(bogus nil)			;List of bogus newsgroups.
-	(old-killed gnus-killed-assoc)
-	(new-killed nil)
-	(old-marked gnus-marked-assoc)
-	(new-marked nil))
-    (message "Checking bogus newsgroups...")
-    ;; Update gnus-newsrc-assoc and gnus-newsrc-hashtb.
-    (while old-newsrc
-      (setq group (car (car old-newsrc)))
-      (if (or (gnus-gethash group gnus-active-hashtb)
-	      (and confirm
-		   (not (y-or-n-p
-			 (format "Delete bogus newsgroup: %s " group)))))
-	  ;; Active newsgroup.
-	  (setq new-newsrc (cons (car old-newsrc) new-newsrc))
-	;; Found a bogus newsgroup.
-	(setq bogus (cons group bogus)))
-      (setq old-newsrc (cdr old-newsrc))
-      )
-    (setq gnus-newsrc-assoc (nreverse new-newsrc))
-    (setq gnus-newsrc-hashtb
-	  (gnus-make-hashtable-from-alist gnus-newsrc-assoc))
-    ;; Update gnus-killed-assoc and gnus-killed-hashtb.
-    ;; The killed newsgroups are deleted without any confirmations.
-    (while old-killed
-      (setq group (car (car old-killed)))
-      (and (gnus-gethash group gnus-active-hashtb)
-	   (null (gnus-gethash group gnus-newsrc-hashtb))
-	   ;; Active and really killed newsgroup.
-	   (setq new-killed (cons (car old-killed) new-killed)))
-      (setq old-killed (cdr old-killed))
-      )
-    (setq gnus-killed-assoc (nreverse new-killed))
-    (setq gnus-killed-hashtb
-	  (gnus-make-hashtable-from-alist gnus-killed-assoc))
-    ;; Remove BOGUS from .newsrc file.
-    (while bogus
-      (gnus-update-newsrc-buffer (car bogus) 'delete)
-      (setq bogus (cdr bogus)))
-    ;; Update gnus-marked-assoc and gnus-marked-hashtb.
-    (while old-marked
-      (setq group (car (car old-marked)))
-      (if (and (cdr (car old-marked))	;Non-empty?
-	       (gnus-gethash group gnus-newsrc-hashtb))	;Not bogus?
-	  (setq new-marked (cons (car old-marked) new-marked)))
-      (setq old-marked (cdr old-marked)))
-    (setq gnus-marked-assoc new-marked)
-    (setq gnus-marked-hashtb
-	  (gnus-make-hashtable-from-alist gnus-marked-assoc))
-    (message "Checking bogus newsgroups...done")
-    ))
-
-(defun gnus-get-unread-articles ()
-  "Compute diffs between active and read articles."
-  (let ((read gnus-newsrc-assoc)
-	(group-info nil)
-	(group-name nil)
-	(active nil)
-	(range nil))
-    (message "Checking new news...")
-    (or gnus-unread-hashtb
-	(setq gnus-unread-hashtb
-	      (gnus-make-hashtable (length gnus-active-hashtb))))
-    (while read
-      (setq group-info (car read))	;About one newsgroup
-      (setq group-name (car group-info))
-      (setq active (nth 2 (gnus-gethash group-name gnus-active-hashtb)))
-      (if (and gnus-octive-hashtb
-	       ;; Is nothing changed?
-	       (equal active
-		      (nth 2 (gnus-gethash group-name gnus-octive-hashtb)))
-	       ;; Is this newsgroup in the unread hash table?
-	       (gnus-gethash group-name gnus-unread-hashtb)
-	       )
-	  nil				;Nothing to do.
-	(setq range (gnus-difference-of-range active (nthcdr 2 group-info)))
-	(gnus-sethash group-name
-		      (cons group-name	;Group name
-			    (cons (gnus-number-of-articles range)
-				  range)) ;Range of unread articles
-		      gnus-unread-hashtb)
-	)
-      (setq read (cdr read))
-      )
-    (message "Checking new news...done")
-    ))
-
-(defun gnus-expire-marked-articles ()
-  "Check expired article which is marked as unread."
-  (let ((marked-assoc gnus-marked-assoc)
-	(updated-assoc nil)
-	(marked nil)			;Current marked info.
-	(articles nil)			;List of marked articles.
-	(updated nil)			;List of real marked.
-	(begin nil))
-    (while marked-assoc
-      (setq marked (car marked-assoc))
-      (setq articles (cdr marked))
-      (setq updated nil)
-      (setq begin
-	    (car (nth 2 (gnus-gethash (car marked) gnus-active-hashtb))))
-      (while (and begin articles)
-	(if (>= (car articles) begin)
-	    ;; This article is still active.
-	    (setq updated (cons (car articles) updated)))
-	(setq articles (cdr articles)))
-      (if updated
-	  (setq updated-assoc
-		(cons (cons (car marked) updated) updated-assoc)))
-      (setq marked-assoc (cdr marked-assoc)))
-    (setq gnus-marked-assoc updated-assoc)
-    (setq gnus-marked-hashtb
-	  (gnus-make-hashtable-from-alist gnus-marked-assoc))
-    ))
-
-(defun gnus-mark-as-read-by-xref
-  (group headers unreads &optional subscribed-only)
-  "Mark articles as read using cross references and return updated newsgroups.
-Arguments are GROUP, HEADERS, UNREADS, and optional SUBSCRIBED-ONLY."
-  (let ((xref-list nil)
-	(header nil)
-	(xrefs nil)			;One Xref: field info.
-	(xref nil)			;(NEWSGROUP . ARTICLE)
-	(gname nil)			;Newsgroup name
-	(article nil))			;Article number
-    (while headers
-      (setq header (car headers))
-      (if (memq (nntp-header-number header) unreads)
-	  ;; This article is not yet marked as read.
-	  nil
-	(setq xrefs (gnus-parse-xref-field (nntp-header-xref header)))
-	;; For each cross reference info. in one Xref: field.
-	(while xrefs
-	  (setq xref (car xrefs))
-	  (setq gname (car xref))	;Newsgroup name
-	  (setq article (cdr xref))	;Article number
-	  (or (string-equal group gname) ;Ignore current newsgroup.
-	      ;; Ignore unsubscribed newsgroup if requested.
-	      (and subscribed-only
-		   (not (nth 1 (gnus-gethash gname gnus-newsrc-hashtb))))
-	      ;; Ignore article marked as unread.
-	      (memq article (cdr (gnus-gethash gname gnus-marked-hashtb)))
-	      (let ((group-xref (assoc gname xref-list)))
-		(if group-xref
-		    (if (memq article (cdr group-xref))
-			nil		;Alread marked.
-		      (setcdr group-xref (cons article (cdr group-xref))))
-		  ;; Create new assoc entry for GROUP.
-		  (setq xref-list (cons (list gname article) xref-list)))
-		))
-	  (setq xrefs (cdr xrefs))
-	  ))
-      (setq headers (cdr headers)))
-    ;; Mark cross referenced articles as read.
-    (gnus-mark-xrefed-as-read xref-list)
-    ;;(message "%s %s" (prin1-to-string unreads) (prin1-to-string xref-list))
-    ;; Return list of updated group name.
-    (mapcar (function car) xref-list)
-    ))
-
-(defun gnus-parse-xref-field (xref-value)
-  "Parse Xref: field value, and return list of `(group . article-id)'."
-  (let ((xref-list nil)
-	(xref-value (or xref-value "")))
-    ;; Remove server host name.
-    (if (string-match "^[ \t]*[^ \t,]+[ \t,]+\\(.*\\)$" xref-value)
-	(setq xref-value (substring xref-value (match-beginning 1)))
-      (setq xref-value nil))
-    ;; Process each xref info.
-    (while xref-value
-      (if (string-match
-	   "^[ \t,]*\\([^ \t,]+\\):\\([0-9]+\\)[^0-9]*" xref-value)
-	  (progn
-	    (setq xref-list
-		  (cons
-		   (cons
-		    ;; Group name
-		    (substring xref-value (match-beginning 1) (match-end 1))
-		    ;; Article-ID
-		    (string-to-int
-		     (substring xref-value (match-beginning 2) (match-end 2))))
-		   xref-list))
-	    (setq xref-value (substring xref-value (match-end 2))))
-	(setq xref-value nil)))
-    ;; Return alist.
-    xref-list
-    ))
-
-(defun gnus-mark-xrefed-as-read (xrefs)
-  "Update unread article information using XREFS alist."
-  (let ((group nil)
-	(idlist nil)
-	(unread nil))
-    (while xrefs
-      (setq group (car (car xrefs)))
-      (setq idlist (cdr (car xrefs)))
-      (setq unread (gnus-uncompress-sequence
-		    (nthcdr 2 (gnus-gethash group gnus-unread-hashtb))))
-      (while idlist
-	(setq unread (delq (car idlist) unread))
-	(setq idlist (cdr idlist)))
-      (gnus-update-unread-articles group unread 'ignore)
-      (setq xrefs (cdr xrefs))
-      )))
-
-(defun gnus-update-unread-articles (group unread-list marked-list)
-  "Update unread articles of GROUP using UNREAD-LIST and MARKED-LIST."
-  (let ((active (nth 2 (gnus-gethash group gnus-active-hashtb)))
-	(unread (gnus-gethash group gnus-unread-hashtb)))
-    (if (or (null active) (null unread))
-	;; Ignore unknown newsgroup.
-	nil
-      ;; Update gnus-unread-hashtb.
-      (if unread-list
-	  (setcdr (cdr unread)
-		  (gnus-compress-sequence unread-list))
-	;; All of the articles are read.
-	(setcdr (cdr unread) '((0 . 0))))
-      ;; Number of unread articles.
-      (setcar (cdr unread)
-	      (gnus-number-of-articles (nthcdr 2 unread)))
-      ;; Update gnus-newsrc-assoc.
-      (if (> (car active) 0)
-	  ;; Articles from 1 to N are not active.
-	  (setq active (cons 1 (cdr active))))
-      (setcdr (cdr (gnus-gethash group gnus-newsrc-hashtb))
-	      (gnus-difference-of-range active (nthcdr 2 unread)))
-      ;; Update .newsrc buffer.
-      (gnus-update-newsrc-buffer group)
-      ;; Update gnus-marked-assoc.
-      (if (listp marked-list)		;Includes NIL.
-	  (let ((marked (gnus-gethash group gnus-marked-hashtb)))
-	    (cond (marked		;There is an entry.
-		   (setcdr marked marked-list))
-		  (marked-list		;Non-NIL.
-		   (let ((info (cons group marked-list)))
-		     ;; hashtb must share the same cons cell.
-		     (setq gnus-marked-assoc
-			   (cons info gnus-marked-assoc))
-		     (gnus-sethash group info gnus-marked-hashtb)
-		     ))
-		  )))
-      )))
-
-(defun gnus-read-active-file ()
-  "Get active file from NNTP server."
-  ;; Make sure a connection to NNTP server is alive.
-  (gnus-start-news-server)
-  (message "Reading active file...")
-  (if (gnus-request-list)		;Get active file from server
-      (save-excursion
-	(set-buffer nntp-server-buffer)
-	(gnus-active-to-gnus-format)
-	(message "Reading active file...done"))
-    (error "Cannot read active file from NNTP server.")))
-
-(defun gnus-active-to-gnus-format ()
-  "Convert active file format to internal format.
-Lines matching `gnus-ignored-newsgroups' are ignored."
-  ;; Delete unnecessary lines.
-  (goto-char (point-min))
-  ;;(delete-matching-lines "^to\\..*$")
-  (delete-matching-lines gnus-ignored-newsgroups)
-  ;; Save OLD active info.
-  (setq gnus-octive-hashtb gnus-active-hashtb)
-  ;; Make large enough hash table.
-  (setq gnus-active-hashtb
-	(gnus-make-hashtable (count-lines (point-min) (point-max))))
-  ;; Store active file in hashtable.
-  (goto-char (point-min))
-  (while
-      (re-search-forward
-       "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([ymn]\\).*$"
-       nil t)
-    (gnus-sethash
-     (buffer-substring (match-beginning 1) (match-end 1))
-     (list (buffer-substring (match-beginning 1) (match-end 1))
-	   (string-equal
-	    "y" (buffer-substring (match-beginning 4) (match-end 4)))
-	   (cons (string-to-int
-		  (buffer-substring (match-beginning 3) (match-end 3)))
-		 (string-to-int
-		  (buffer-substring (match-beginning 2) (match-end 2)))))
-     gnus-active-hashtb)
-    ))
-
-(defun gnus-read-newsrc-file (&optional rawfile)
-  "Read startup FILE.
-If optional argument RAWFILE is non-nil, the raw startup file is read."
-  (setq gnus-current-startup-file (gnus-make-newsrc-file gnus-startup-file))
-  ;; Reset variables which may be included in the quick startup file.
-  (let ((variables gnus-variable-list))
-    (while variables
-      (set (car variables) nil)
-      (setq variables (cdr variables))))
-  (let* ((newsrc-file gnus-current-startup-file)
-	 (quick-file (concat newsrc-file ".el"))
-	 (quick-loaded nil))
-    (save-excursion
-      ;; Prepare .newsrc buffer.
-      (set-buffer (find-file-noselect newsrc-file))
-      ;; It is not so good idea turning off undo.
-      ;;(buffer-flush-undo (current-buffer))
-      ;; Load quick .newsrc to restore gnus-marked-assoc and
-      ;; gnus-killed-assoc even if gnus-newsrc-assoc is out of date.
-      (condition-case nil
-	  (progn
-	    (setq quick-loaded (load quick-file t t t))
-	    ;; Recreate hashtables.
-	    (setq gnus-killed-hashtb
-		  (gnus-make-hashtable-from-alist gnus-killed-assoc))
-	    (setq gnus-marked-hashtb
-		  (gnus-make-hashtable-from-alist gnus-marked-assoc))
-	    )
-	(error nil))
-      (cond ((and (not rawfile)		;Not forced to read the raw file.
-		  ;; .newsrc.el is newer than .newsrc.
-		  ;; Do it this way in case timestamps are identical
-		  ;; (on fast machines/disks).
-		  (not (file-newer-than-file-p newsrc-file quick-file))
-		  quick-loaded
-		  gnus-newsrc-assoc	;Really loaded?
-		  )
-	     ;; We don't have to read the raw startup file.
-	     ;; gnus-newsrc-assoc may be defined in the quick startup file.
-	     ;; So, we have to define the hashtable here.
-	     (setq gnus-newsrc-hashtb
-		   (gnus-make-hashtable-from-alist gnus-newsrc-assoc)))
-	    (t
-	     ;; Since .newsrc file is newer than quick file, read it.
-	     (message "Reading %s..." newsrc-file)
-	     (gnus-newsrc-to-gnus-format)
-	     (gnus-check-killed-newsgroups)
-	     (message "Reading %s...done" newsrc-file)))
-      )))
-
-(defun gnus-make-newsrc-file (file)
-  "Make server dependent file name by catenating FILE and server host name."
-  (let* ((file (expand-file-name file nil))
-	 (real-file (concat file "-" gnus-nntp-server)))
-    (if (file-exists-p real-file)
-	real-file file)
-    ))
-
-(defun gnus-newsrc-to-gnus-format ()
-  "Parse current buffer as `.newsrc' file."
-  (let ((newsgroup nil)
-	(subscribe nil)
-	(ranges nil)
-	(subrange nil)
-	(read-list nil))
-    ;; We have to re-initialize these variable (except for
-    ;; gnus-marked-assoc and gnus-killed-assoc) because quick startup
-    ;; file may contain bogus values.
-    (setq gnus-newsrc-options nil)
-    (setq gnus-newsrc-options-n-yes nil)
-    (setq gnus-newsrc-options-n-no nil)
-    (setq gnus-newsrc-assoc nil)
-    ;; Make large enough hash table.
-    (setq gnus-newsrc-hashtb
-	  (gnus-make-hashtable
-	   (max (length gnus-active-hashtb)
-		(count-lines (point-min) (point-max)))))
-    ;; Save options line to variable.
-    ;; Lines beginning with white spaces are treated as continuation
-    ;; line.  Refer man page of newsrc(5).
-    (goto-char (point-min))
-    (if (re-search-forward
-	 "^[ \t]*options[ \t]*\\(.*\\(\n[ \t]+.*\\)*\\)[ \t]*$" nil t)
-	(progn
-	  ;; Save entire options line.
-	  (setq gnus-newsrc-options
-		(buffer-substring (match-beginning 1) (match-end 1)))
-	  ;; Compile "-n" option.
-	  (if (string-match "\\(^\\|[ \t\n]\\)-n" gnus-newsrc-options)
-	      (let ((yes-and-no
-		     (gnus-parse-n-options
-		      (substring gnus-newsrc-options (match-end 0)))))
-		(setq gnus-newsrc-options-n-yes (car yes-and-no))
-		(setq gnus-newsrc-options-n-no  (cdr yes-and-no))
-		))
-	  ))
-    ;; Parse body of .newsrc file
-    ;; Options line continuation lines must be also considered here.
-    ;; Before supporting continuation lines, " newsgroup ! 1-5" was
-    ;; okay, but now it is invalid.  It should be "newsgroup! 1-5".
-    (goto-char (point-min))
-    ;; We used this regexp, but it caused overflows.
-    ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(.*\\)$"
-    ;; Suggested by composer@bucsf.bu.edu (Jeff Kellem)
-    ;; but no longer viable because of extensive backtracking in Emacs 19:
-    ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\(...\\)*.*\\)$"
-    ;; but, the following causes trouble on some case:
-    ;; "^\\([^:! \t\n]+\\)\\([:!]\\)[ \t]*\\(\\|[^ \t\n].*\\)$"
-    ;; So now we don't try to match the tail of the line at all.
-    ;; It's just as easy to extract it later.
-    (while (re-search-forward "^\\([^:! \t\n]+\\)\\([:!]\\)"
-			      nil t)
-      (setq newsgroup (buffer-substring (match-beginning 1) (match-end 1)))
-      ;; Check duplications of newsgroups.
-      ;; Note: Checking the duplications takes very long time.
-      (if (gnus-gethash newsgroup gnus-newsrc-hashtb)
-	  (message "Ignore duplicated newsgroup: %s" newsgroup)
-	(setq subscribe
-	      (string-equal
-	       ":" (buffer-substring (match-beginning 2) (match-end 2))))
-	(skip-chars-forward " \t")
-	(setq ranges (buffer-substring (point) (save-excursion
-						 (end-of-line) (point))))
-	(setq read-list nil)
-	(while (string-match "^[, \t]*\\([0-9-]+\\)" ranges)
-	  (setq subrange (substring ranges (match-beginning 1) (match-end 1)))
-	  (setq ranges (substring ranges (match-end 1)))
-	  (cond ((string-match "^\\([0-9]+\\)-\\([0-9]+\\)$" subrange)
-		 (setq read-list
-		       (cons
-			(cons (string-to-int
-			       (substring subrange
-					  (match-beginning 1) (match-end 1)))
-			      (string-to-int
-			       (substring subrange
-					  (match-beginning 2) (match-end 2))))
-			read-list)))
-		((string-match "^[0-9]+$" subrange)
-		 (setq read-list
-		       (cons (cons (string-to-int subrange)
-				   (string-to-int subrange))
-			     read-list)))
-		(t
-		 (ding) (message "Ignoring bogus lines of %s" newsgroup)
-		 (sit-for 0))
-		))
-	(setq gnus-newsrc-assoc
-	      (cons (cons newsgroup (cons subscribe (nreverse read-list)))
-		    gnus-newsrc-assoc))
-	;; Update gnus-newsrc-hashtb one by one.
-	(gnus-sethash newsgroup (car gnus-newsrc-assoc) gnus-newsrc-hashtb)
-	))
-    (setq gnus-newsrc-assoc (nreverse gnus-newsrc-assoc))
-    ))
-
-(defun gnus-parse-n-options (options)
-  "Parse -n NEWSGROUPS options and return a cons of YES and NO regexps."
-  (let ((yes nil)
-	(no nil)
-	(yes-or-no nil)			;`!' or not.
-	(newsgroup nil))
-    ;; Parse each newsgroup description such as "comp.all".  Commas
-    ;; and white spaces can be a newsgroup separator.
-    (while
-	(string-match "^[ \t\n,]*\\(!?\\)\\([^- \t\n,][^ \t\n,]*\\)" options)
-      (setq yes-or-no
-	    (substring options (match-beginning 1) (match-end 1)))
-      (setq newsgroup
-	    (regexp-quote
-	     (substring options
-			(match-beginning 2) (match-end 2))))
-      (setq options (substring options (match-end 2)))
-      ;; Rewrite "all" to ".+" not ".*".  ".+" requires at least one
-      ;; character.
-      (while (string-match "\\(^\\|\\\\[.]\\)all\\(\\\\[.]\\|$\\)" newsgroup)
-	(setq newsgroup
-	      (concat (substring newsgroup 0 (match-end 1))
-		      ".+"
-		      (substring newsgroup (match-beginning 2)))))
-      ;; It is yes or no.
-      (cond ((string-equal yes-or-no "!")
-	     (setq no (cons newsgroup no)))
-	    ((string-equal newsgroup ".+")) ;Ignore `all'.
-	    (t
-	     (setq yes (cons newsgroup yes))))
-      )
-    ;; Make a cons of regexps from parsing result.
-    ;; We have to append \(\.\|$\) to prevent matching substring of
-    ;; newsgroup.  For example, "jp.net" should not match with
-    ;; "jp.network".
-    ;; Fixes for large regexp problems are from yonezu@nak.math.keio.ac.jp.
-    (cons (if yes
-	      (concat "^\\("
-		      (apply (function concat)
-			     (mapcar
-			      (function
-			       (lambda (newsgroup)
-				 (concat newsgroup "\\|")))
-			      (cdr yes)))
-		      (car yes) "\\)\\(\\.\\|$\\)"))
-	  (if no
-	      (concat "^\\("
-		      (apply (function concat)
-			     (mapcar
-			      (function
-			       (lambda (newsgroup)
-				 (concat newsgroup "\\|")))
-			      (cdr no)))
-		      (car no) "\\)\\(\\.\\|$\\)")))
-    ))
-
-(defun gnus-save-newsrc-file ()
-  "Save current status in the `.newsrc' file."
-  ;; Note: We cannot save .newsrc file if all newsgroups are removed
-  ;; from the variable gnus-newsrc-assoc.
-  (and (or gnus-newsrc-assoc gnus-killed-assoc)
-       gnus-current-startup-file
-       (save-excursion
-	 ;; A buffer containing .newsrc file may be deleted.
-	 (set-buffer (find-file-noselect gnus-current-startup-file))
-	 (if (not (buffer-modified-p))
-	     (message "(No changes need to be saved)")
-	   (message "Saving %s..." gnus-current-startup-file)
-	   (let ((make-backup-files t)
-		 (version-control nil)
-		 (require-final-newline t)) ;Don't ask even if requested.
-	     ;; Make backup file of master newsrc.
-	     ;; You can stop or change version control of backup file.
-	     ;; Suggested by jason@violet.berkeley.edu.
-	     (run-hooks 'gnus-save-newsrc-hook)
-	     (save-buffer))
-	   ;; Quickly loadable .newsrc.
-	   (set-buffer (get-buffer-create " *GNUS-newsrc*"))
-	   (buffer-flush-undo (current-buffer))
-	   (erase-buffer)
-	   (gnus-gnus-to-quick-newsrc-format)
-	   (let ((make-backup-files nil)
-		 (version-control nil)
-		 (require-final-newline t)) ;Don't ask even if requested.
-	     (write-file (concat gnus-current-startup-file ".el")))
-	   (kill-buffer (current-buffer))
-	   (message "Saving %s...done" gnus-current-startup-file)
-	   ))
-    ))
-
-(defun gnus-update-newsrc-buffer (group &optional delete next)
-  "Incrementally update `.newsrc' buffer about GROUP.
-If optional 1st argument DELETE is non-nil, delete the group.
-If optional 2nd argument NEXT is non-nil, inserted before it."
-  (save-excursion
-    ;; Taking account of the killed startup file.
-    ;; Suggested by tale@pawl.rpi.edu.
-    (set-buffer (or (get-file-buffer gnus-current-startup-file)
-		    (find-file-noselect gnus-current-startup-file)))
-    ;; Options line continuation lines must be also considered here.
-    ;; Before supporting continuation lines, " newsgroup ! 1-5" was
-    ;; okay, but now it is invalid.  It should be "newsgroup! 1-5".
-    (let ((deleted nil)
-	  (case-fold-search nil)	;Should NOT ignore case.
-	  (buffer-read-only nil))	;May be not modifiable.
-      ;; Delete ALL entries which match for GROUP.
-      (goto-char (point-min))
-      (while (re-search-forward
-	      (concat "^" (regexp-quote group) "[:!]") nil t)
-	(beginning-of-line)
-	(delete-region (point) (progn (forward-line 1) (point)))
-	(setq deleted t)		;Old entry is deleted.
-	)
-      (if delete
-	  nil
-	;; Insert group entry.
-	(let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
-	  (if (null newsrc)
-	      nil
-	    ;; Find insertion point.
-	    (cond (deleted nil)		;Insert here.
-		  ((and (stringp next)
-			(progn
-			  (goto-char (point-min))
-			  (re-search-forward
-			   (concat "^" (regexp-quote next) "[:!]") nil t)))
-		   (beginning-of-line))
-		  (t
-		   (goto-char (point-max))
-		   (or (bolp)
-		       (insert "\n"))))
-	    ;; Insert after options line.
-	    (if (looking-at "^[ \t]*options\\([ \t]\\|$\\)")
-		(progn
-		  (forward-line 1)
-		  ;; Skip continuation lines.
-		  (while (and (not (eobp))
-			      (looking-at "^[ \t]+"))
-		    (forward-line 1))))
-	    (insert group		;Group name
-		    (if (nth 1 newsrc) ": " "! ")) ;Subscribed?
-	    (gnus-ranges-to-newsrc-format (nthcdr 2 newsrc)) ;Read articles
-	    (insert "\n")
-	    )))
-      )))
-
-(defun gnus-gnus-to-quick-newsrc-format ()
-  "Insert GNUS variables such as `gnus-newsrc-assoc' in Lisp format."
-  (insert ";; GNUS internal format of .newsrc.\n")
-  (insert ";; Touch .newsrc instead if you think to remove this file.\n")
-  (let ((variable nil)
-	(variables gnus-variable-list)
-	;; Temporary rebind to make changes
-	;; gnus-check-killed-newsgroups in invisible.
-	(gnus-killed-assoc gnus-killed-assoc)
-	(gnus-killed-hashtb gnus-killed-hashtb))
-    ;; Remove duplicated or unsubscribed newsgroups in
-    ;; gnus-killed-assoc (and gnus-killed-hashtb).
-    (gnus-check-killed-newsgroups)
-    ;; Then, insert lisp expressions.
-    (while variables
-      (setq variable (car variables))
-      (and (boundp variable)
-	   (symbol-value variable)
-	   (insert "(setq " (symbol-name variable) " '"
-		   (prin1-to-string (symbol-value variable))
-		   ")\n"))
-      (setq variables (cdr variables)))
-    ))
-
-(defun gnus-ranges-to-newsrc-format (ranges)
-  "Insert ranges of read articles."
-  (let ((range nil))			;Range is a pair of BEGIN and END.
-    (while ranges
-      (setq range (car ranges))
-      (setq ranges (cdr ranges))
-      (cond ((= (car range) (cdr range))
-	     (if (= (car range) 0)
-		 (setq ranges nil)	;No unread articles.
-	       (insert (int-to-string (car range)))
-	       (if ranges (insert ","))
-	       ))
-	    (t
-	     (insert (int-to-string (car range))
-		     "-"
-		     (int-to-string (cdr range)))
-	     (if ranges (insert ","))
-	     ))
-      )))
-
-(defun gnus-compress-sequence (numbers)
-  "Convert list of sorted numbers to ranges."
-  (let* ((numbers (sort (copy-sequence numbers) (function <)))
-	 (first (car numbers))
-	 (last (car numbers))
-	 (result nil))
-    (while numbers
-      (cond ((= last (car numbers)) nil) ;Omit duplicated number
-	    ((= (1+ last) (car numbers)) ;Still in sequence
-	     (setq last (car numbers)))
-	    (t				;End of one sequence
-	     (setq result (cons (cons first last) result))
-	     (setq first (car numbers))
-	     (setq last  (car numbers)))
-	    )
-      (setq numbers (cdr numbers))
-      )
-    (nreverse (cons (cons first last) result))
-    ))
-
-(defun gnus-uncompress-sequence (ranges)
-  "Expand compressed format of sequence."
-  (let ((first nil)
-	(last  nil)
-	(result nil))
-    (while ranges
-      (setq first (car (car ranges)))
-      (setq last  (cdr (car ranges)))
-      (while (< first last)
-	(setq result (cons first result))
-	(setq first (1+ first)))
-      (setq result (cons first result))
-      (setq ranges (cdr ranges))
-      )
-    (nreverse result)
-    ))
-
-(defun gnus-number-of-articles (range)
-  "Compute number of articles from RANGE `((beg1 . end1) (beg2 . end2) ...)'."
-  (let ((count 0))
-    (while range
-      (if (/= (cdr (car range)) 0)
-	  ;; If end1 is 0, it must be skipped.  Usually no articles in
-	  ;;  this group.
-	  (setq count (+ count 1 (- (cdr (car range)) (car (car range))))))
-      (setq range (cdr range))
-      )
-    count				;Result
-    ))
-
-(defun gnus-difference-of-range (src obj)
-  "Compute (SRC - OBJ) on range.
-Range of SRC is expressed as `(beg . end)'.
-Range of OBJ is expressed as `((beg1 . end1) (beg2 . end2) ...)."
-  (let ((beg (car src))
-	(end (cdr src))
-	(range nil))			;This is result.
-    ;; Src may be nil.
-    (while (and src obj)
-      (let ((beg1 (car (car obj)))
-	    (end1 (cdr (car obj))))
-	(cond ((> beg end)
-	       (setq obj nil))		;Terminate loop
-	      ((< beg beg1)
-	       (setq range (cons (cons beg (min (1- beg1) end)) range))
-	       (setq beg (1+ end1)))
-	      ((>= beg beg1)
-	       (setq beg (max beg (1+ end1))))
-	      )
-	(setq obj (cdr obj))		;Next OBJ
-	))
-    ;; Src may be nil.
-    (if (and src (<= beg end))
-	(setq range (cons (cons beg end) range)))
-    ;; Result
-    (if range
-	(nreverse range)
-      (list (cons 0 0)))
-    ))
-
-(defun gnus-read-distributions-file ()
-  "Get distributions file from NNTP server (NNTP2 functionality)."
-  ;; Make sure a connection to NNTP server is alive.
-  (gnus-start-news-server)
-  (message "Reading distributions file...")
-  (setq gnus-distribution-list nil)
-  (if (gnus-request-list-distributions)
-      (save-excursion
-	(set-buffer nntp-server-buffer)
-	(gnus-distributions-to-gnus-format)
-	(message "Reading distributions file...done"))
-    ;; It's not a fatal error.
-    ;;(error "Cannot read distributions file from NNTP server.")
-    )
-  ;; Merge with user supplied default distributions.
-  (let ((defaults (reverse gnus-local-distributions))
-	(dist nil))
-    (while defaults
-      (setq dist (assoc (car defaults) gnus-distribution-list))
-      (if dist
-	  (setq gnus-distribution-list
-		(delq dist gnus-distribution-list)))
-      (setq gnus-distribution-list
-	    (cons (list (car defaults)) gnus-distribution-list))
-      (setq defaults (cdr defaults))
-      )))
-
-(defun gnus-distributions-to-gnus-format ()
-  "Convert distributions file format to internal format."
-  (setq gnus-distribution-list nil)
-  (goto-char (point-min))
-  (while (re-search-forward "^\\([^ \t\n]+\\).*$" nil t)
-    (setq gnus-distribution-list
-	  (cons (list (buffer-substring (match-beginning 1) (match-end 1)))
-		gnus-distribution-list)))
-  (setq gnus-distribution-list
-	(nreverse gnus-distribution-list)))
-
-(defun gnus-newsgroups-retrieve-description ()
-  "Retrieve newsgroups description and build gnus-newsgroups-alist"
-  (message "Reading newsgroups file...")
-  (if (gnus-request-list-newsgroups)
-      (save-excursion
-	(setq gnus-newsgroups-alist nil)
-	(set-buffer nntp-server-buffer)
-	(goto-char (point-min))
-	(while (re-search-forward gnus-newsgroups-regex nil t)
-	  (setq gnus-newsgroups-alist
-		(cons (cons (buffer-substring (match-beginning 1) (match-end 1))
-			    (buffer-substring (match-beginning 2) (match-end 2)))
-		      gnus-newsgroups-alist)))
-	(message "Reading newsgroups file...done"))
-    (message "Cannot read newsgroups file")))
-
-(defun gnus-newsgroups-update-description ()
-  "Update the newsgroups description"
-  (interactive)
-  (gnus-newsgroups-retrieve-description)
-  (setq gnus-newsgroups-hashtb (gnus-make-hashtable-from-alist gnus-newsgroups-alist)))
-
-(defun gnus-newsgroups-display-toggle ()
-  "Toggle displaying newsgroup descriptions in *Newsgroup* buffer."
-  (interactive)
-  (setq gnus-newsgroups-display (not gnus-newsgroups-display))
-  (if gnus-newsgroups-showall
-        (gnus-group-list-groups t)
-    (gnus-group-list-groups nil)))
-
-(provide 'gnus)
-
-;;Local variables:
-;;eval: (put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
-;;end:
-
-;;; gnus.el ends here
diff --git a/lisp/=gnusmail.el b/lisp/=gnusmail.el
deleted file mode 100644
index 293bde54f4a..00000000000
--- a/lisp/=gnusmail.el
+++ /dev/null
@@ -1,220 +0,0 @@
-;;; gnusmail.el --- mail reply commands for GNUS newsreader
-
-;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Keywords: news
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Provides mail reply and mail other window command using usual mail
-;; interface and mh-e interface.
-;; 
-;; To use MAIL: set the variables gnus-mail-reply-method and
-;; gnus-mail-other-window-method to gnus-mail-reply-using-mail and
-;; gnus-mail-other-window-using-mail, respectively.
-;;
-;; To use MH-E: set the variables gnus-mail-reply-method and
-;; gnus-mail-other-window-method to gnus-mail-reply-using-mhe and
-;; gnus-mail-other-window-using-mhe, respectively.
-
-;;; Code:
-
-(require 'gnus)
-
-(autoload 'news-mail-reply "rnewspost")
-(autoload 'news-mail-other-window "rnewspost")
-
-(autoload 'mh-send "mh-e")
-(autoload 'mh-send-other-window "mh-e")
-(autoload 'mh-find-path "mh-e")
-(autoload 'mh-yank-cur-msg "mh-e")
-
-;;; Mail reply commands of GNUS Summary Mode
-
-(defun gnus-summary-reply (yank)
-  "Reply mail to news author.
-If prefix argument YANK is non-nil, original article is yanked automatically.
-Customize the variable gnus-mail-reply-method to use another mailer."
-  (interactive "P")
-  ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
-  ;; Stripping headers should be specified with mail-yank-ignored-headers.
-  (gnus-summary-select-article t t)
-  (switch-to-buffer gnus-article-buffer)
-  (widen)
-  (delete-other-windows)
-  (bury-buffer gnus-article-buffer)
-  (funcall gnus-mail-reply-method yank))
-
-(defun gnus-summary-reply-with-original ()
-  "Reply mail to news author with original article.
-Customize the variable gnus-mail-reply-method to use another mailer."
-  (interactive)
-  (gnus-summary-reply t))
-
-(defun gnus-summary-mail-forward ()
-  "Forward the current message to another user.
-Customize the variable gnus-mail-forward-method to use another mailer."
-  (interactive)
-  (gnus-summary-select-article)
-  (switch-to-buffer gnus-article-buffer)
-  (widen)
-  (delete-other-windows)
-  (bury-buffer gnus-article-buffer)
-  (funcall gnus-mail-forward-method))
-
-(defun gnus-summary-mail-other-window ()
-  "Compose mail in other window.
-Customize the variable gnus-mail-other-window-method to use another mailer."
-  (interactive)
-  (gnus-summary-select-article)
-  (switch-to-buffer gnus-article-buffer)
-  (widen)
-  (delete-other-windows)
-  (bury-buffer gnus-article-buffer)
-  (funcall gnus-mail-other-window-method))
-
-
-;;; Send mail using sendmail mail mode.
-
-(defun gnus-mail-reply-using-mail (&optional yank)
-  "Compose reply mail using mail.
-Optional argument YANK means yank original article."
-  (news-mail-reply)
-  (gnus-overload-functions)
-  (if yank
-      (mail-yank-original nil)))
-
-(defun gnus-mail-forward-using-mail ()
-  "Forward the current message to another user using mail."
-  ;; This is almost a carbon copy of rmail-forward in rmail.el.
-  (let ((forward-buffer (current-buffer))
-	(subject
-	 (concat "[" gnus-newsgroup-name "] "
-		 ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": "
-		 (or (gnus-fetch-field "Subject") ""))))
-    ;; If only one window, use it for the mail buffer.
-    ;; Otherwise, use another window for the mail buffer
-    ;; so that the Rmail buffer remains visible
-    ;; and sending the mail will get back to it.
-    (if (if (one-window-p t)
-	    (mail nil nil subject)
-	  (mail-other-window nil nil subject))
-	(save-excursion
-	  (goto-char (point-max))
-	  (insert "------- Start of forwarded message -------\n")
-	  (insert-buffer forward-buffer)
-	  (goto-char (point-max))
-	  (insert "------- End of forwarded message -------\n")
-	  ;; You have a chance to arrange the message.
-	  (run-hooks 'gnus-mail-forward-hook)
-	  ))))
-
-(defun gnus-mail-other-window-using-mail ()
-  "Compose mail other window using mail."
-  (news-mail-other-window)
-  (gnus-overload-functions))
-
-
-;;; Send mail using mh-e.
-
-;; The following mh-e interface is all cooperative works of
-;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP
-;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki
-;; SHINGU).
-
-(defun gnus-mail-reply-using-mhe (&optional yank)
-  "Compose reply mail using mh-e.
-Optional argument YANK means yank original article.
-The command \\[mh-yank-cur-msg] yank the original message into current buffer."
-  ;; First of all, prepare mhe mail buffer.
-  (let (from cc subject date to reply-to (buffer (current-buffer)))
-    (save-restriction
-      (gnus-article-show-all-headers)	;I don't think this is really needed.
-      (setq from (gnus-fetch-field "from")
-	    subject (let ((subject (or (gnus-fetch-field "subject")
-				       "(None)")))
-		      (if (and subject
-			       (not (string-match "^[Rr][Ee]:.+$" subject)))
-			  (concat "Re: " subject) subject))
-	    reply-to (gnus-fetch-field "reply-to")
-	    cc (gnus-fetch-field "cc")
-	    date (gnus-fetch-field "date"))
-      (setq mh-show-buffer buffer)
-      (setq to (or reply-to from))
-      (mh-find-path)
-      (mh-send to (or cc "") subject)
-      (save-excursion
-	(mh-insert-fields
-	 "In-reply-to:"
-	 (concat
-	  (substring from 0 (string-match "  *at \\|  *@ \\| *(\\| *<" from))
-	  "'s message of " date)))
-      (setq mh-sent-from-folder buffer)
-      (setq mh-sent-from-msg 1)
-      ))
-  ;; Then, yank original article if requested.
-  (if yank
-      (let ((last (point)))
-	(mh-yank-cur-msg)
-	(goto-char last)
-	)))
-
-;; gnus-mail-forward-using-mhe is contributed by Jun-ichiro Itoh
-;; <itojun@ingram.mt.cs.keio.ac.jp>
-
-(defun gnus-mail-forward-using-mhe ()
-  "Forward the current message to another user using mh-e."
-  ;; First of all, prepare mhe mail buffer.
-  (let ((to (read-string "To: "))
- 	(cc (read-string "Cc: "))
- 	(buffer (current-buffer))
- 	subject)
-    ;;(gnus-article-show-all-headers)
-    (setq subject
-	  (concat "[" gnus-newsgroup-name "] "
-		  ;;(mail-strip-quoted-names (gnus-fetch-field "From")) ": "
-		  (or (gnus-fetch-field "subject") "")))
-    (setq mh-show-buffer buffer)
-    (mh-find-path)
-    (mh-send to (or cc "") subject)
-    (save-excursion
-      (goto-char (point-max))
-      (insert "\n------- Forwarded Message\n\n")
-      (insert-buffer buffer)
-      (goto-char (point-max))
-      (insert "\n------- End of Forwarded Message\n")
-      (setq mh-sent-from-folder buffer)
-      (setq mh-sent-from-msg 1))))
-
-(defun gnus-mail-other-window-using-mhe ()
-  "Compose mail other window using mh-e."
-  (let ((to (read-string "To: "))
-	(cc (read-string "Cc: "))
-	(subject (read-string "Subject: " (gnus-fetch-field "subject"))))
-    (gnus-article-show-all-headers)	;I don't think this is really needed.
-    (setq mh-show-buffer (current-buffer))
-    (mh-find-path)
-    (mh-send-other-window to cc subject)
-    (setq mh-sent-from-folder (current-buffer))
-    (setq mh-sent-from-msg 1)))
-
-(provide 'gnusmail)
-
-;;; gnusmail.el ends here
diff --git a/lisp/=gnusmisc.el b/lisp/=gnusmisc.el
deleted file mode 100644
index df7b16f48d2..00000000000
--- a/lisp/=gnusmisc.el
+++ /dev/null
@@ -1,294 +0,0 @@
-;;; gnusmisc.el --- miscellaneous commands for GNUS newsreader
-
-;; Copyright (C) 1989, 1990, 1993 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Keywords: news
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(require 'gnus)
-
-;;;
-;;; GNUS Browse-Killed Mode
-;;;
-
-;; Some ideas are due to roland@wheaties.ai.mit.edu (Roland McGrath).
-;; I'd like to thank him very much.
-
-(defvar gnus-browse-killed-mode-hook nil
-  "*A hook for GNUS Browse-Killed Mode.")
-
-(defvar gnus-browse-killed-buffer "*Killed Newsgroup*")
-(defvar gnus-browse-killed-mode-map nil)
-(defvar gnus-winconf-browse-killed nil)
-
-(autoload 'timezone-make-date-arpa-standard "timezone")
-
-(put 'gnus-browse-killed-mode 'mode-class 'special)
-
-
-;;;
-;;; GNUS Browse-Killed Mode
-;;;
-
-;; Some ideas are due to roland@wheaties.ai.mit.edu (Roland McGrath).
-;; I'd like to thank him very much.
-
-;; Make the buffer to be managed by GNUS.
-
-(or (memq gnus-browse-killed-buffer gnus-buffer-list)
-    (setq gnus-buffer-list
-	  (cons gnus-browse-killed-buffer gnus-buffer-list)))
-
-(if gnus-browse-killed-mode-map
-    nil
-  (setq gnus-browse-killed-mode-map (make-keymap))
-  (suppress-keymap gnus-browse-killed-mode-map t)
-  (define-key gnus-browse-killed-mode-map " " 'gnus-group-next-group)
-  (define-key gnus-browse-killed-mode-map "\177" 'gnus-group-prev-group)
-  (define-key gnus-browse-killed-mode-map "\C-n" 'gnus-group-next-group)
-  (define-key gnus-browse-killed-mode-map "\C-p" 'gnus-group-prev-group)
-  (define-key gnus-browse-killed-mode-map "n" 'gnus-group-next-group)
-  (define-key gnus-browse-killed-mode-map "p" 'gnus-group-prev-group)
-  (define-key gnus-browse-killed-mode-map "y" 'gnus-browse-killed-yank)
-  (define-key gnus-browse-killed-mode-map "\C-y" 'gnus-browse-killed-yank)
-  (define-key gnus-browse-killed-mode-map "l" 'gnus-list-killed-groups)
-  (define-key gnus-browse-killed-mode-map "q" 'gnus-browse-killed-exit)
-  (define-key gnus-browse-killed-mode-map "\C-c\C-c" 'gnus-browse-killed-exit)
-  (define-key gnus-browse-killed-mode-map "\C-c\C-i" 'gnus-info-find-node))
-
-(defun gnus-browse-killed-mode ()
-  "Major mode for browsing the killed newsgroups.
-All normal editing commands are turned off.
-Instead, these commands are available:
-\\{gnus-browse-killed-mode-map}
-
-The killed newsgroups are saved in the quick startup file (.newsrc.el)
-unless it against the options line in the startup file (.newsrc).
-
-Entry to this mode calls gnus-browse-killed-mode-hook with no arguments,
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  ;; Gee.  Why don't you upgrade?
-  (cond ((boundp 'mode-line-modified)
-	 (setq mode-line-modified "--- "))
-	((listp (default-value 'mode-line-format))
-	 (setq mode-line-format
-	       (cons "--- " (cdr (default-value 'mode-line-format)))))
-	(t
-	 (setq mode-line-format
-	       "--- GNUS: Killed Newsgroups  %[(%m)%]----%3p-%-")))
-  (setq major-mode 'gnus-browse-killed-mode)
-  (setq mode-name "Browse-Killed")
-  (setq mode-line-buffer-identification	"GNUS: Killed Newsgroups")
-  (use-local-map gnus-browse-killed-mode-map)
-  (buffer-flush-undo (current-buffer))
-  (setq buffer-read-only t)		;Disable modification
-  (run-hooks 'gnus-browse-killed-mode-hook))
-
-(defun gnus-list-killed-groups ()
-  "List the killed newsgroups.
-The keys y and C-y yank the newsgroup on the current line into the
-Newsgroups buffer."
-  (interactive)
-  (or gnus-killed-assoc
-      (error "No killed newsgroups"))
-  ;; Save current window configuration if this is first invocation..
-  (or (get-buffer-window gnus-browse-killed-buffer)
-      (setq gnus-winconf-browse-killed
-	    (current-window-configuration)))
-  ;; Prepare browsing buffer.
-  (pop-to-buffer (get-buffer-create gnus-browse-killed-buffer))
-  (gnus-browse-killed-mode)
-  (let ((buffer-read-only nil)
-	(killed-assoc gnus-killed-assoc))
-    (erase-buffer)
-    (while killed-assoc
-      (insert (gnus-group-prepare-line (car killed-assoc)))
-      (setq killed-assoc (cdr killed-assoc)))
-    (goto-char (point-min))
-    ))
-
-(defun gnus-browse-killed-yank ()
-  "Yank current newsgroup to Newsgroup buffer."
-  (interactive)
-  (let ((group (gnus-group-group-name)))
-    (if group
-	(let* ((buffer-read-only nil)
-	       (killed (gnus-gethash group gnus-killed-hashtb)))
-	  (pop-to-buffer gnus-group-buffer) ;Needed to adjust point.
-	  (if killed
-	      (gnus-group-insert-group killed))
-	  (pop-to-buffer gnus-browse-killed-buffer)
-	  (beginning-of-line)
-	  (delete-region (point)
-			 (progn (forward-line 1) (point)))
-	  )))
-  (gnus-browse-killed-check-buffer))
-
-(defun gnus-browse-killed-check-buffer ()
-  "Exit if the buffer is empty by deleting the window and killing the buffer."
-  (and (null gnus-killed-assoc)
-       (get-buffer gnus-browse-killed-buffer)
-       (gnus-browse-killed-exit)))
-
-(defun gnus-browse-killed-exit ()
-  "Exit this mode by deleting the window and killing the buffer."
-  (interactive)
-  (and (get-buffer-window gnus-browse-killed-buffer)
-       (delete-window (get-buffer-window gnus-browse-killed-buffer)))
-  (kill-buffer gnus-browse-killed-buffer)
-  ;; Restore previous window configuration if available.
-  (and gnus-winconf-browse-killed
-       (set-window-configuration gnus-winconf-browse-killed))
-  (setq gnus-winconf-browse-killed nil))
-
-
-;;;
-;;; kill/yank newsgroup commands of GNUS Group Mode
-;;;
-
-(defun gnus-group-transpose-groups (arg)
-  "Exchange current newsgroup and previous newsgroup.
-With argument ARG, takes previous newsgroup and moves it past ARG newsgroup."
-  (interactive "p")
-  ;; BUG: last newsgroup and the last but one cannot be transposed
-  ;; since gnus-group-search-forward does not move forward beyond the
-  ;; last.  If we instead use forward-line, no problem, but I don't
-  ;; want to use it for later extension.
-  (while (> arg 0)
-    (gnus-group-search-forward t t)
-    (gnus-group-kill-group 1)
-    (gnus-group-search-forward nil t)
-    (gnus-group-yank-group)
-    (gnus-group-search-forward nil t)
-    (setq arg (1- arg))
-    ))
-
-(defun gnus-group-kill-region (begin end)
-  "Kill newsgroups in current region (excluding current point).
-The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
-  (interactive "r")
-  (let ((lines
-	 ;; Exclude a line where current point is on.
-	 (1-
-	  ;; Count lines.
-	  (save-excursion
-	    (count-lines
-	     (progn
-	       (goto-char begin)
-	       (beginning-of-line)
-	       (point))
-	     (progn
-	       (goto-char end)
-	       (end-of-line)
-	       (point)))))))
-    (goto-char begin)
-    (beginning-of-line)			;Important when LINES < 1
-    (gnus-group-kill-group lines)))
-
-(defun gnus-group-kill-group (n)
-  "Kill newsgroup on current line, repeated prefix argument N times.
-The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
-  (interactive "p")
-  (let ((buffer-read-only nil)
-	(group nil))
-    (while (> n 0)
-      (setq group (gnus-group-group-name))
-      (or group
-	  (signal 'end-of-buffer nil))
-      (beginning-of-line)
-      (delete-region (point)
-		     (progn (forward-line 1) (point)))
-      (gnus-kill-newsgroup group)
-      (setq n (1- n))
-      ;; Add to killed newsgroups in the buffer if exists.
-      (if (get-buffer gnus-browse-killed-buffer)
-	  (save-excursion
-	    (set-buffer gnus-browse-killed-buffer)
-	    (let ((buffer-read-only nil))
-	      (goto-char (point-min))
-	      (insert (gnus-group-prepare-line (car gnus-killed-assoc)))
-	      )))
-      )
-    (search-forward ":" nil t)
-    ))
-
-(defun gnus-group-yank-group ()
-  "Yank the last newsgroup killed with \\[gnus-group-kill-group],
-inserting it before the newsgroup on the line containing point."
-  (interactive)
-  (gnus-group-insert-group (car gnus-killed-assoc))
-  ;; Remove killed newsgroups from the buffer if exists.
-  (if (get-buffer gnus-browse-killed-buffer)
-      (save-excursion
-	(set-buffer gnus-browse-killed-buffer)
-	(let ((buffer-read-only nil))
-	  (goto-char (point-min))
-	  (delete-region (point-min)
-			 (progn (forward-line 1) (point)))
-	  )))
-  (gnus-browse-killed-check-buffer))
-
-(defun gnus-group-insert-group (info)
-  "Insert newsgroup at current line using gnus-newsrc-assoc INFO."
-  (if (null gnus-killed-assoc)
-      (error "No killed newsgroups"))
-  ;; Huuum.  It this right?
-  ;;(if (not gnus-have-all-newsgroups)
-  ;;    (error
-  ;;     (substitute-command-keys
-  ;;	"Not all newsgroups are displayed.  Type \\[gnus-group-list-all-groups] to display all newsgroups.")))
-  (let ((buffer-read-only nil)
-	(group (gnus-group-group-name)))
-    (gnus-insert-newsgroup info group)
-    (beginning-of-line)
-    (insert (gnus-group-prepare-line info))
-    (forward-line -1)
-    (search-forward ":" nil t)
-    ))
-
-
-;;; Rewrite Date: field in GMT to local
-
-(defun gnus-gmt-to-local ()
-  "Rewrite Date: field described in GMT to local in current buffer.
-The variable gnus-local-timezone is used for local time zone.
-Intended to be used with gnus-article-prepare-hook."
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      (narrow-to-region (point-min)
-			(progn (search-forward "\n\n" nil 'move) (point)))
-      (goto-char (point-min))
-      (if (re-search-forward "^Date:[ \t]\\(.*\\)$" nil t)
-	  (let ((buffer-read-only nil)
-		(date (buffer-substring (match-beginning 1) (match-end 1))))
-	    (delete-region (match-beginning 1) (match-end 1))
-	    (insert
-	     (timezone-make-date-arpa-standard date nil gnus-local-timezone))
-	    ))
-      )))
-
-(provide 'gnusmisc)
-
-;;; gnusmisc.el ends here
diff --git a/lisp/=gnuspost.el b/lisp/=gnuspost.el
deleted file mode 100644
index 441feb245d2..00000000000
--- a/lisp/=gnuspost.el
+++ /dev/null
@@ -1,842 +0,0 @@
-;;; gnuspost.el --- post news commands for GNUS newsreader
-
-;; Copyright (C) 1989, 1990, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Keywords: news
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(require 'gnus)
-
-(defvar gnus-organization-file "/usr/lib/news/organization"
-  "*Local news organization file.")
-
-(defvar gnus-post-news-buffer "*post-news*")
-(defvar gnus-winconf-post-news nil)
-
-(autoload 'news-reply-mode "rnewspost")
-(autoload 'timezone-make-date-arpa-standard "timezone")
-
-;;; Post news commands of GNUS Group Mode and Summary Mode
-
-(defun gnus-group-post-news ()
-  "Post an article."
-  (interactive)
-  ;; Save window configuration.
-  (setq gnus-winconf-post-news (current-window-configuration))
-  (unwind-protect
-      (gnus-post-news)
-    (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
-	     (not (zerop (buffer-size))))
-	;; Restore last window configuration.
-	(set-window-configuration gnus-winconf-post-news)))
-  ;; We don't want to return to Summary buffer nor Article buffer later.
-  (if (get-buffer gnus-summary-buffer)
-      (bury-buffer gnus-summary-buffer))
-  (if (get-buffer gnus-article-buffer)
-      (bury-buffer gnus-article-buffer)))
-
-(defun gnus-summary-post-news ()
-  "Post an article."
-  (interactive)
-  (gnus-summary-select-article t nil)
-  ;; Save window configuration.
-  (setq gnus-winconf-post-news (current-window-configuration))
-  (unwind-protect
-      (progn
-	(switch-to-buffer gnus-article-buffer)
-	(widen)
-	(delete-other-windows)
-	(gnus-post-news))
-    (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
-	     (not (zerop (buffer-size))))
-	;; Restore last window configuration.
-	(set-window-configuration gnus-winconf-post-news)))
-  ;; We don't want to return to Article buffer later.
-  (bury-buffer gnus-article-buffer))
-
-(defun gnus-summary-followup (yank)
-  "Post a reply article.
-If prefix argument YANK is non-nil, original article is yanked automatically."
-  (interactive "P")
-  (gnus-summary-select-article t nil)
-  ;; Check Followup-To: poster.
-  (set-buffer gnus-article-buffer)
-  (if (and gnus-use-followup-to
-	   (string-equal "poster" (gnus-fetch-field "followup-to"))
-	   (or (not (eq gnus-use-followup-to t))
-	       (not (y-or-n-p "Do you want to ignore `Followup-To: poster'? "))))
-      ;; Mail to the poster.  GNUS is now RFC1036 compliant.
-      (gnus-summary-reply yank)
-    ;; Save window configuration.
-    (setq gnus-winconf-post-news (current-window-configuration))
-    (unwind-protect
-	(progn
-	  (switch-to-buffer gnus-article-buffer)
-	  (widen)
-	  (delete-other-windows)
-	  (gnus-news-reply yank))
-      (or (and (eq (current-buffer) (get-buffer gnus-post-news-buffer))
-	       (not (zerop (buffer-size))))
-	  ;; Restore last window configuration.
-	  (set-window-configuration gnus-winconf-post-news)))
-    ;; We don't want to return to Article buffer later.
-    (bury-buffer gnus-article-buffer)))
-
-(defun gnus-summary-followup-with-original ()
-  "Post a reply article with original article."
-  (interactive)
-  (gnus-summary-followup t))
-
-(defun gnus-summary-cancel-article ()
-  "Cancel an article you posted."
-  (interactive)
-  (gnus-summary-select-article t nil)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (gnus-cancel-news)))
-
-
-;;; Post a News using NNTP
-
-;;;###autoload
-(defalias 'sendnews 'gnus-post-news)
-
-;;;###autoload
-(defalias 'postnews 'gnus-post-news)
-
-;;;###autoload
-(defun gnus-post-news ()
-  "Begin editing a new USENET news article to be posted.
-Type \\[describe-mode] once editing the article to get a list of commands."
-  (interactive)
-  (if (or (not gnus-novice-user)
-	  (y-or-n-p "Are you sure you want to post to all of USENET? "))
-      (let ((artbuf (current-buffer))
-	    (newsgroups			;Default newsgroup.
-	     (if (eq major-mode 'gnus-article-mode) gnus-newsgroup-name))
-	    (subject nil)
-	    ;; Get default distribution.
-	    (distribution (car gnus-local-distributions))
-	    (followup-to nil))
-	;; Connect to NNTP server if not connected yet, and get
-	;; several information.
-	(if (not (gnus-server-opened))
-	    (progn
-	      (gnus-start-news-server t) ;Confirm server.
-	      (gnus-setup-news)))
-	;; Get current article information.
-	(save-restriction
-	  (and (not (zerop (buffer-size)))
-	       ;;(equal major-mode 'news-mode)
-	       (equal major-mode 'gnus-article-mode)
-	       (progn
-		 ;;(news-show-all-headers)
-		 (gnus-article-show-all-headers)
-		 (narrow-to-region (point-min)
-				   (progn (goto-char (point-min))
-					  (search-forward "\n\n")
-					  (point)))))
-	  (setq news-reply-yank-from (mail-fetch-field "from"))
-	  (setq news-reply-yank-message-id (mail-fetch-field "message-id")))
-	(pop-to-buffer gnus-post-news-buffer)
-	(news-reply-mode)
-	(gnus-overload-functions)
-	(if (and (buffer-modified-p)
-		 (> (buffer-size) 0)
-		 (not (y-or-n-p "Unsent article being composed; erase it? ")))
-	    ;; Continue composition.
-	    ;; Make news-reply-yank-original work on the current article.
-	    (setq mail-reply-buffer artbuf)
-	  (erase-buffer)
-	  (if gnus-interactive-post
-	      ;; Newsgroups, subject and distribution are asked for.
-	      ;; Suggested by yuki@flab.fujitsu.junet.
-	      (progn
-		;; Subscribed newsgroup names are required for
-		;; completing read of newsgroup.
-		(or gnus-newsrc-assoc
-		    (gnus-read-newsrc-file))
-		;; Which do you like? (UMERIN)
-		;; (setq newsgroups (read-string "Newsgroups: " "general"))
-		(or newsgroups		;Use the default newsgroup.
-		    (let (group)
-		      (while (not
-			      (string=
-			       (setq group 
-				     (completing-read "Newsgroup: "
-						      gnus-newsrc-assoc
-						      nil 'require-match))
-			       ""))
-			(or followup-to (setq followup-to group))
-			(if newsgroups
-			    (setq newsgroups (concat newsgroups "," group))
-			  (setq newsgroups group)))))
-		(setq subject (read-string "Subject: "))
-		;; Choose a distribution from gnus-distribution-list.
-		;; completing-read should not be used with
-		;; 'require-match functionality in order to allow use
-		;; of unknow distribution.
-		(gnus-read-distributions-file)
-		(setq distribution
-		      (if (consp gnus-distribution-list)
-			  (completing-read "Distribution: "
-					   gnus-distribution-list
-					   nil nil ;Never 'require-match
-					   distribution ;Default distribution.
-					   )
-			(read-string "Distribution: ")))
-		;; Empty string is okay.
-		;;(if (string-equal distribution "")
-		;;    (setq distribution nil))
-		))
-	  (news-setup () subject () newsgroups artbuf)
-	  ;; Make sure the article is posted by GNUS.
-	  ;;(mail-position-on-field "Posting-Software")
-	  ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
-	  ;; Insert Distribution: field.
-	  ;; Suggested by ichikawa@flab.fujitsu.junet.
-	  (mail-position-on-field "Distribution")
-	  (insert (or distribution ""))
-	  ;; Add Followup-To header
-	  (if followup-to
-	      (progn
-		(mail-position-on-field "Followup-To")
-		(insert followup-to)))
-	  ;; Handle author copy using FCC field.
-	  (if gnus-author-copy
-	      (progn
-		(mail-position-on-field "FCC")
-		(insert gnus-author-copy)))
-	  (if gnus-interactive-post
-	      ;; All fields are filled in.
-	      (goto-char (point-max))
-	    ;; Move point to Newsgroup: field.
-	    (goto-char (point-min))
-	    (end-of-line))
-	  ))
-    (message "")))
-
-(defun gnus-news-reply (&optional yank)
-  "Compose and post a reply (aka a followup) to the current article on USENET.
-While composing the followup, use \\[news-reply-yank-original] to yank the
-original message into it."
-  (interactive)
-  (if (or (not gnus-novice-user)
-	  (y-or-n-p "Are you sure you want to followup to all of USENET? "))
-      (let (from cc subject date to followup-to newsgroups message-of
-		 references distribution message-id
-		 (artbuf (current-buffer)))
-	(save-restriction
-	  (and (not (zerop (buffer-size)))
-	       ;;(equal major-mode 'news-mode)
-	       (equal major-mode 'gnus-article-mode)
-	       (progn
-		 ;; (news-show-all-headers)
-		 (gnus-article-show-all-headers)
-		 (narrow-to-region (point-min)
-				   (progn (goto-char (point-min))
-					  (search-forward "\n\n")
-					  (point)))))
-	  (setq from (mail-fetch-field "from"))
-	  ;; Get reply-to working corrrectly for gnus-auto-mail-to-author (jpm)
-	  (setq reply-to (mail-fetch-field "reply-to"))
-	  (setq	news-reply-yank-from from)
-	  (setq	subject (mail-fetch-field "subject"))
-	  (setq	date (mail-fetch-field "date"))
-	  (setq followup-to (mail-fetch-field "followup-to"))
-	  ;; Ignore Followup-To: poster.
-	  (if (or (null gnus-use-followup-to) ;Ignore followup-to: field.
-		  (string-equal "" followup-to)	;Bogus header.
-		  (string-equal "poster" followup-to))
-	      (setq followup-to nil))
-	  (setq	newsgroups (or followup-to (mail-fetch-field "newsgroups")))
-	  (setq	references (mail-fetch-field "references"))
-	  (setq	distribution (mail-fetch-field "distribution"))
-	  (setq	message-id (mail-fetch-field "message-id"))
-	  (setq	news-reply-yank-message-id message-id))
-	(pop-to-buffer gnus-post-news-buffer)
-	(news-reply-mode)
-	(gnus-overload-functions)
-	(if (and (buffer-modified-p)
-		 (> (buffer-size) 0)
-		 (not (y-or-n-p "Unsent article being composed; erase it? ")))
-	    ;; Continue composition.
-	    ;; Make news-reply-yank-original work on current article.
-	    (setq mail-reply-buffer artbuf)
-	  (erase-buffer)
-	  (and subject
-	       (setq subject
-		     (concat "Re: " (gnus-simplify-subject subject 're-only))))
-	  (and from
-	       (progn
-		 (let ((stop-pos
-			(string-match "  *at \\|  *@ \\| *(\\| *<" from)))
-		   (setq message-of
-			 (concat
-			  (if stop-pos (substring from 0 stop-pos) from)
-			  "'s message of "
-			  date)))))
-	  (news-setup nil subject message-of newsgroups artbuf)
-	  (if followup-to
-	      (progn (news-reply-followup-to)
-		     (insert followup-to)))
-	  ;; Fold long references line to follow RFC1036.
-	  (mail-position-on-field "References")
-	  (let ((begin (point))
-		(fill-column 79)
-		(fill-prefix "\t"))
-	    (if references
-		(insert references))
-	    (if (and references message-id)
-		(insert " "))
-	    (if message-id
-		(insert message-id))
-	    ;; The region must end with a newline to fill the region
-	    ;; without inserting extra newline.
-	    (fill-region-as-paragraph begin (1+ (point))))
-	  ;; Make sure the article is posted by GNUS.
-	  ;;(mail-position-on-field "Posting-Software")
-	  ;;(insert "GNUS: NNTP-based News Reader for GNU Emacs")
-	  ;; Distribution must be the same as original article.
-	  (mail-position-on-field "Distribution")
-	  (insert (or distribution ""))
-	  ;; Handle author copy using FCC field.
-	  (if gnus-author-copy
-	      (progn
-		(mail-position-on-field "FCC")
-		(insert gnus-author-copy)))
-	  ;; Insert To: FROM field, which is expected to mail the
-	  ;; message to the author of the article too.  Use Reply-To
-	  ;; field like gnus-mail-reply-using-m* (jpm).
-	  (if (and gnus-auto-mail-to-author (or reply-to from))
-	      (progn
-		(goto-char (point-min))
-		(insert "To: " (or reply-to from) "\n")))
-	  (goto-char (point-max)))
-	;; Yank original article automatically.
-	(if yank
-	    (let ((last (point)))
-	      ;;(goto-char (point-max))
-	      ;; Insert at current point.
-	      (news-reply-yank-original nil)
-	      (goto-char last)))
-	)
-    (message "")))
-
-(defun gnus-inews-news ()
-  "Send a news message."
-  (interactive)
-  (let* ((case-fold-search nil)
-	 (server-running (gnus-server-opened)))
-    (save-excursion
-      ;; Connect to default NNTP server if necessary.
-      ;; Suggested by yuki@flab.fujitsu.junet.
-      (gnus-start-news-server)		;Use default server.
-      ;; NNTP server must be opened before current buffer is modified.
-      (widen)
-      (goto-char (point-min))
-      (run-hooks 'news-inews-hook)
-      (save-restriction
-	(narrow-to-region
-	 (point-min)
-	 (progn
-	   (goto-char (point-min))
-	   (search-forward (concat "\n" mail-header-separator "\n"))
-	   (point)))
-
-	 ;; Correct newsgroups field: change sequence of spaces to comma and 
-	 ;; eliminate spaces around commas.  Eliminate imbedded line breaks.
-	 (goto-char (point-min))
-	 (if (search-forward-regexp "^Newsgroups: +" nil t)
-	     (save-restriction
-	       (narrow-to-region
-		(point)
-		(if (re-search-forward "^[^ \t]" nil 'end)
-		    (match-beginning 0)
-		  (point-max)))
-	       (goto-char (point-min))
-	       (replace-regexp "\n[ \t]+" " ") ;No line breaks (too confusing)
-	       (goto-char (point-min))
-	       (replace-regexp "[ \t\n]*,[ \t\n]*\\|[ \t]+" ",")
-	     ))
-
-	 ;; Mail the message too if To: or Cc: exists.
-	 (if (or (mail-fetch-field "to" nil t)
-		 (mail-fetch-field "cc" nil t))
-	     (if gnus-mail-send-method
-		 (progn
-		   (message "Sending via mail...")
-		   (widen)
-		   (funcall gnus-mail-send-method)
-		   (message "Sending via mail... done"))
-	       (ding)
-	       (message "No mailer defined.  To: and/or Cc: fields ignored.")
-	       (sit-for 1))))
-
-      ;; Send to NNTP server. 
-      (message "Posting to USENET...")
-      (if (gnus-inews-article)
-	  (message "Posting to USENET... done")
-	;; We cannot signal an error.
-	(ding) (message "Article rejected: %s" (gnus-status-message)))
-      (set-buffer-modified-p nil))
-    ;; If NNTP server is opened by gnus-inews-news, close it by myself.
-    (or server-running
-	(gnus-close-server))
-    (and (fboundp 'bury-buffer) (bury-buffer))
-    ;; Restore last window configuration.
-    (and gnus-winconf-post-news
-	 (set-window-configuration gnus-winconf-post-news))
-    (setq gnus-winconf-post-news nil)
-    ))
-
-(defun gnus-cancel-news ()
-  "Cancel an article you posted."
-  (interactive)
-  (if (yes-or-no-p "Do you really want to cancel this article? ")
-      (let ((from nil)
-	    (newsgroups nil)
-	    (message-id nil)
-	    (distribution nil))
-	(save-excursion
-	  ;; Get header info. from original article.
-	  (save-restriction
-	    (gnus-article-show-all-headers)
-	    (goto-char (point-min))
-	    (search-forward "\n\n" nil 'move)
-	    (narrow-to-region (point-min) (point))
-	    (setq from (mail-fetch-field "from"))
-	    (setq newsgroups (mail-fetch-field "newsgroups"))
-	    (setq message-id (mail-fetch-field "message-id"))
-	    (setq distribution (mail-fetch-field "distribution")))
-	  ;; Verify if the article is absolutely user's by comparing
-	  ;; user id with value of its From: field.
-	  (if (not
-	       (string-equal
-		(downcase (mail-strip-quoted-names from))
-		(downcase (mail-strip-quoted-names (gnus-inews-user-name)))))
-	      (progn
-		(ding) (message "This article is not yours."))
-	    ;; Make control article.
-	    (set-buffer (get-buffer-create " *GNUS-canceling*"))
-	    (buffer-disable-undo (current-buffer))
-	    (erase-buffer)
-	    (insert "Newsgroups: " newsgroups "\n"
-		    "Subject: cancel " message-id "\n"
-		    "Control: cancel " message-id "\n"
-		    ;; We should not use the first value of
-		    ;;  `gnus-distribution-list' as default value,
-		    ;;  because distribution must be as same as original
-		    ;;  article.
-		    "Distribution: " (or distribution "") "\n"
-		    mail-header-separator "\n"
-		    )
-	    ;; Send the control article to NNTP server.
-	    (message "Canceling your article...")
-	    (if (gnus-inews-article)
-		(message "Canceling your article... done")
-	      (ding) (message "Failed to cancel your article"))
-	    ;; Kill the article buffer.
-	    (kill-buffer (current-buffer))
-	    )))
-    ))
-
-
-;;; Lowlevel inews interface
-
-(defun gnus-inews-article ()
-  "Post an article in current buffer using NNTP protocol."
-  (let ((artbuf (current-buffer))
-	(tmpbuf (get-buffer-create " *GNUS-posting*")))
-    (save-excursion
-      (set-buffer tmpbuf)
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (insert-buffer-substring artbuf)
-      ;; Remove the header separator.
-      (goto-char (point-min))
-      (search-forward (concat "\n" mail-header-separator "\n"))
-      (replace-match "\n\n")
-      (goto-char (point-max))
-      ;; require a newline at the end for inews to append .signature to
-      (or (= (preceding-char) ?\n)
-	  (insert ?\n))
-      ;; This hook may insert a signature.
-      (run-hooks 'gnus-prepare-article-hook)
-      ;; Prepare article headers.  All message body such as signature
-      ;; must be inserted before Lines: field is prepared.
-      (save-restriction
-	(goto-char (point-min))
-	(search-forward "\n\n")
-	(narrow-to-region (point-min) (point))
-	(gnus-inews-insert-headers))
-      ;; Run final inews hooks.  This hook may do FCC.
-      ;; The article must be saved before being posted because
-      ;; `gnus-request-post' modifies the buffer.
-      (run-hooks 'gnus-inews-article-hook)
-      ;; Post an article to NNTP server.
-      ;; Return NIL if post failed.
-      (prog1
-	  (gnus-request-post)
-	(kill-buffer (current-buffer)))
-      )))
-
-(defun gnus-inews-insert-headers ()
-  "Prepare article headers.
-Fields already prepared in the buffer are not modified.
-Fields in gnus-required-headers will be generated."
-  (save-excursion
-    (let ((date (gnus-inews-date))
-	  (message-id (gnus-inews-message-id))
-	  (organization (gnus-inews-organization)))
-      (goto-char (point-min))
-      (or (mail-fetch-field "path")
-	  (and (memq 'Path gnus-required-headers)
-	       (insert "Path: " (gnus-inews-path) "\n")))
-      (or (mail-fetch-field "from")
-	  (and (memq 'From gnus-required-headers)
-	       (insert "From: " (gnus-inews-user-name) "\n")))
-      ;; If there is no subject, make Subject: field.
-      (or (mail-fetch-field "subject")
-	  (and (memq 'Subject gnus-required-headers)
-	       (insert "Subject: \n")))
-      ;; If there is no newsgroups, make Newsgroups: field.
-      (or (mail-fetch-field "newsgroups")
-	  (and (memq 'Newsgroups gnus-required-headers)
-	       (insert "Newsgroups: \n")))
-      (or (mail-fetch-field "message-id")
-	  (and message-id
-	       (memq 'Message-ID gnus-required-headers)
-	       (insert "Message-ID: " message-id "\n")))
-      (or (mail-fetch-field "date")
-	  (and date
-	       (memq 'Date gnus-required-headers)
-	       (insert "Date: " date "\n")))
-      ;; Optional fields in RFC977 and RFC1036
-      (or (mail-fetch-field "organization")
-	  (and organization
-	       (memq 'Organization gnus-required-headers)
-	       (let ((begin (point))
-		     (fill-column 79)
-		     (fill-prefix "\t"))
-		 (insert "Organization: " organization "\n")
-		 (fill-region-as-paragraph begin (point)))))
-      (or (mail-fetch-field "distribution")
-	  (and (memq 'Distribution gnus-required-headers)
-	       (insert "Distribution: \n")))
-      (or (mail-fetch-field "lines")
-	  (and (memq 'Lines gnus-required-headers)
-	       (insert "Lines: " (gnus-inews-lines) "\n")))
-      )))
-
-
-;; Utility functions.
-
-(defun gnus-inews-insert-signature ()
-  "Insert signature file in current article buffer.
-If there is a file named .signature-DISTRIBUTION, it is used instead
-of usual .signature when the distribution of the article is
-DISTRIBUTION.  Set the variable to nil to prevent appending the
-signature file automatically.
-Signature file is specified by the variable gnus-signature-file."
-  (save-excursion
-    (save-restriction
-      ;; Change signature file by distribution.
-      ;; Suggested by hyoko@flab.fujitsu.co.jp.
-      (let ((signature
-	     (if gnus-signature-file
-		 (expand-file-name gnus-signature-file nil)))
-	    (distribution nil))
-	(goto-char (point-min))
-	(search-forward "\n\n")
-	(narrow-to-region (point-min) (point))
-	(setq distribution (mail-fetch-field "distribution"))
-	(widen)
-	(if signature
-	    (progn
-	      (if (file-exists-p (concat signature "-" distribution))
-		  (setq signature (concat signature "-" distribution)))
-	      ;; Insert signature.
-	      (if (file-exists-p signature)
-		  (progn
-		    (goto-char (point-max))
-		    (insert "-- \n")
-		    (insert-file-contents signature)))
-	      ))))))
-
-(defun gnus-inews-do-fcc ()
-  "Process FCC: fields in current article buffer.
-Unless the first character of the field is `|', the article is saved
-to the specified file using the function specified by the variable
-gnus-author-copy-saver.  The default function rmail-output saves in
-Unix mailbox format.
-If the first character is `|', the contents of the article is send to
-a program specified by the rest of the value."
-  (let ((fcc-list nil)
-	(fcc-file nil)
-	(case-fold-search t))		;Should ignore case.
-    (save-excursion
-      (save-restriction
-	(goto-char (point-min))
-	(search-forward "\n\n")
-	(narrow-to-region (point-min) (point))
-	(goto-char (point-min))
-	(while (re-search-forward "^FCC:[ \t]*" nil t)
-	  (setq fcc-list
-		(cons (buffer-substring
-		       (point)
-		       (progn
-			 (end-of-line)
-			 (skip-chars-backward " \t")
-			 (point)))
-		      fcc-list))
-	  (delete-region (match-beginning 0)
-			 (progn (forward-line 1) (point))))
-	;; Process FCC operations.
-	(widen)
-	(while fcc-list
-	  (setq fcc-file (car fcc-list))
-	  (setq fcc-list (cdr fcc-list))
-	  (cond ((string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" fcc-file)
-		 (let ((program (substring fcc-file
-					   (match-beginning 1) (match-end 1))))
-		   ;; Suggested by yuki@flab.fujitsu.junet.
-		   ;; Send article to named program.
-		   (call-process-region (point-min) (point-max) shell-file-name
-					nil nil nil "-c" program)
-		   ))
-		(t
-		 ;; Suggested by hyoko@flab.fujitsu.junet.
-		 ;; Save article in Unix mail format by default.
-		 (if (and gnus-author-copy-saver
-			  (not (eq gnus-author-copy-saver 'rmail-output)))
-		     (funcall gnus-author-copy-saver fcc-file)
-		   (if (and (file-readable-p fcc-file)
-			    (mail-file-babyl-p fcc-file))
-		       (gnus-output-to-rmail fcc-file)
-		     (rmail-output fcc-file 1 t t)))
-		 ))
-	  )
-	))
-    ))
-
-(defun gnus-inews-path ()
-  "Return uucp path."
-  (let ((login-name (gnus-inews-login-name)))
-    (cond ((null gnus-use-generic-path)
-	   (concat gnus-nntp-server "!" login-name))
-	  ((stringp gnus-use-generic-path)
-	   ;; Support GENERICPATH.  Suggested by vixie@decwrl.dec.com.
-	   (concat gnus-use-generic-path "!" login-name))
-	  (t login-name))
-    ))
-
-(defun gnus-inews-user-name ()
-  "Return user's network address as `NAME@DOMAIN (FULLNAME)'."
-  (let ((full-name (gnus-inews-full-name)))
-    (concat (if (or gnus-user-login-name gnus-use-generic-from
-		    gnus-local-domain (getenv "DOMAINNAME"))
-		(concat (gnus-inews-login-name) "@"
-			(gnus-inews-domain-name gnus-use-generic-from))
-	      user-mail-address)
-	    ;; User's full name.
-	    (cond ((string-equal full-name "") "")
-		  ((string-equal full-name "&")	;Unix hack.
-		   (concat " (" login-name ")"))
-		  (t
-		   (concat " (" full-name ")")))
-	    )))
-
-(defun gnus-inews-login-name ()
-  "Return user login name.
-Got from the variable `gnus-user-login-name' and the function
-`user-login-name'."
-  (or gnus-user-login-name (user-login-name)))
-
-(defun gnus-inews-full-name ()
-  "Return user full name.
-Got from the variable `gnus-user-full-name', the environment variable
-NAME, and the function `user-full-name'."
-  (or gnus-user-full-name
-      (getenv "NAME") (user-full-name)))
-
-(defun gnus-inews-domain-name (&optional genericfrom)
-  "Return user's domain name.
-If optional argument GENERICFROM is a string, use it as the domain
-name; if it is non-nil, strip of local host name from the domain name.
-If the function `system-name' returns full internet name and the
-domain is undefined, the domain name is got from it."
-  (and (null gnus-local-domain)
-       (boundp 'gnus-your-domain)
-       (setq gnus-local-domain gnus-your-domain))
-  (if (or genericfrom gnus-local-domain (getenv "DOMAINNAME"))
-      (let ((domain (or (if (stringp genericfrom) genericfrom)
-			(getenv "DOMAINNAME")
-			gnus-local-domain
-			;; Function `system-name' may return full internet name.
-			;; Suggested by Mike DeCorte <mrd@sun.soe.clarkson.edu>.
-			(if (string-match "\\." (system-name))
-			    (substring (system-name) (match-end 0)))
-			(read-string "Domain name (no host): ")))
-	    (host (or (if (string-match "\\." (system-name))
-			  (substring (system-name) 0 (match-beginning 0)))
-		      (system-name))))
-	(if (string-equal "." (substring domain 0 1))
-	    (setq domain (substring domain 1)))
-	;; Support GENERICFROM as same as standard Bnews system.
-	;; Suggested by ohm@kaba.junet and vixie@decwrl.dec.com.
-	(cond ((null genericfrom)
-	       (concat host "." domain))
-	      ;;((stringp genericfrom) genericfrom)
-	      (t domain)))
-    (substring user-mail-address (1+ (string-match "@" user-mail-address)))))
-
-(defun gnus-inews-message-id ()
-  "Generate unique Message-ID for user."
-  ;; Message-ID should not contain a slash and should be terminated by
-  ;; a number.  I don't know the reason why it is so.
-  (concat "<" (gnus-inews-unique-id) "@" (gnus-inews-domain-name) ">"))
-
-(defun gnus-inews-unique-id ()
-  "Generate unique ID from user name and current time."
-  (let ((date (current-time-string))
-	(name (gnus-inews-login-name)))
-    (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
-		      date)
-	(concat (upcase name) "."
-		(substring date (match-beginning 6) (match-end 6)) ;Year
-		(substring date (match-beginning 1) (match-end 1)) ;Month
-		(substring date (match-beginning 2) (match-end 2)) ;Day
-		(substring date (match-beginning 3) (match-end 3)) ;Hour
-		(substring date (match-beginning 4) (match-end 4)) ;Minute
-		(substring date (match-beginning 5) (match-end 5)) ;Second
-		)
-      (error "Cannot understand current-time-string: %s." date))
-    ))
-
-(defun gnus-current-time-zone (time)
-  "The local time zone in effect at TIME, or nil if not known."
-  (let ((z (and (fboundp 'current-time-zone) (current-time-zone time))))
-    (if (and z (car z)) z gnus-local-timezone)))
-
-(defun gnus-inews-date ()
-  "Date string of today.
-If `current-time-zone' works, or if `gnus-local-timezone' is set correctly,
-this yields a date that conforms to RFC 822.  Otherwise a buggy date will
-be generated; this might work with some older news servers."
-  (let* ((now (and (fboundp 'current-time) (current-time)))
-	 (zone (gnus-current-time-zone now)))
-    (if zone
-	(gnus-inews-valid-date now zone)
-      ;; No timezone info.
-      (gnus-inews-buggy-date now))))
-
-(defun gnus-inews-valid-date (&optional time zone)
-  "A date string that represents TIME and conforms to the Usenet standard.
-TIME is optional and defaults to the current time.
-Some older versions of Emacs always act as if TIME is nil.
-The optional argument ZONE specifies the local time zone (default GMT)."
-  (timezone-make-date-arpa-standard
-   (if (fboundp 'current-time)
-       (current-time-string time)
-     (current-time-string))
-   zone "GMT"))
-
-(defun gnus-inews-buggy-date (&optional time)
-  "A buggy date string that represents TIME.
-TIME is optional and defaults to the current time.
-Some older versions of Emacs always act as if TIME is nil."
-  (let ((date (if (fboundp 'current-time)
-		  (current-time-string time)
-		(current-time-string))))
-    (if (string-match "^[^ ]+ \\([^ ]+\\)[ ]+\\([0-9]+\\) \\([0-9:]+\\) [0-9][0-9]\\([0-9][0-9]\\)"
-		      date)
-	(concat (substring date (match-beginning 2) (match-end 2)) ;Day
-		" "
-		(substring date (match-beginning 1) (match-end 1)) ;Month
-		" "
-		(substring date (match-beginning 4) (match-end 4)) ;Year
-		" "
-		(substring date (match-beginning 3) (match-end 3))) ;Time
-      (error "Cannot understand current-time-string: %s." date))
-    ))
-
-(defun gnus-inews-organization ()
-  "Return user's organization.
-The ORGANIZATION environment variable is used if defined.
-If not, the variable gnus-local-organization is used instead.
-If the value begins with a slash, it is taken as the name of a file
-containing the organization."
-  ;; The organization must be got in this order since the ORGANIZATION
-  ;; environment variable is intended for user specific while
-  ;; gnus-local-organization is for machine or organization specific.
-
-  ;; Note: compatibility hack.  This will be removed in the next version.
-  (and (null gnus-local-organization)
-       (boundp 'gnus-your-organization)
-       (setq gnus-local-organization gnus-your-organization))
-  ;; End of compatibility hack.
-  (let* ((private-file (expand-file-name "~/.organization" nil))
-	 (organization (or (getenv "ORGANIZATION")
-			   gnus-local-organization
-			   private-file)))
-    (and (stringp organization)
-	 (> (length organization) 0)
-	 (string-equal (substring organization 0 1) "/")
-	 ;; Get it from the user and system file.
-	 ;; Suggested by roland@wheaties.ai.mit.edu (Roland McGrath).
-	 (let ((dist (mail-fetch-field "distribution")))
-	   (setq organization
-		 (cond ((file-exists-p (concat organization "-" dist))
-			(concat organization "-" dist))
-		       ((file-exists-p organization) organization)
-		       ((file-exists-p gnus-organization-file)
-			gnus-organization-file)
-		       (t organization)))
-	   ))
-    (cond ((not (stringp organization)) nil)
-	  ((and (string-equal (substring organization 0 1) "/")
-		(file-exists-p organization))
-	   ;; If the first character is `/', assume it is the name of
-	   ;; a file containing the organization.
-	   (save-excursion
-	     (let ((tmpbuf (get-buffer-create " *GNUS organization*")))
-	       (set-buffer tmpbuf)
-	       (erase-buffer)
-	       (insert-file-contents organization)
-	       (prog1 (buffer-string)
-		 (kill-buffer tmpbuf))
-	       )))
-	  ((string-equal organization private-file) nil) ;No such file
-	  (t organization))
-    ))
-
-(defun gnus-inews-lines ()
-  "Count the number of lines and return numeric string."
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      (search-forward "\n\n" nil 'move)
-      (int-to-string (count-lines (point) (point-max))))))
-
-(provide 'gnuspost)
-
-;;; gnuspost.el ends here
diff --git a/lisp/=gosmacs.el b/lisp/=gosmacs.el
deleted file mode 100644
index 93bbbaa5b80..00000000000
--- a/lisp/=gosmacs.el
+++ /dev/null
@@ -1,117 +0,0 @@
-;;; gosmacs.el --- rebindings to imitate Gosmacs.
-
-;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: emulations
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Make GNU Emacs look like Gosling Emacs.  `M-x set-gosmacs-bindings'
-;; does this change; `M-x set-gnu-bindings' undoes it.
-
-;;; Code:
-
-(require 'mlsupport)
-
-(defvar non-gosmacs-binding-alist nil)
-
-;;;###autoload
-(defun set-gosmacs-bindings ()
-  "Rebind some keys globally to make GNU Emacs resemble Gosling Emacs.
-Use \\[set-gnu-bindings] to restore previous global bindings."
-  (interactive)
-  (setq non-gosmacs-binding-alist
-	(rebind-and-record
-	 '(("\C-x\C-e" compile)
-	   ("\C-x\C-f" save-buffers-kill-emacs)
-	   ("\C-x\C-i" insert-file)
-	   ("\C-x\C-m" save-some-buffers)
-	   ("\C-x\C-n" next-error)
-	   ("\C-x\C-o" switch-to-buffer)
-	   ("\C-x\C-r" insert-file)
-	   ("\C-x\C-u" undo)
-	   ("\C-x\C-v" find-file-other-window)
-	   ("\C-x\C-z" shrink-window)
-	   ("\C-x!" shell-command)
-	   ("\C-xd" delete-window)
-	   ("\C-xn" gosmacs-next-window)
-	   ("\C-xp" gosmacs-previous-window)
-	   ("\C-xz" enlarge-window)
-	   ("\C-z" scroll-one-line-up)
-	   ("\e\C-c" save-buffers-kill-emacs)
-	   ("\e!" line-to-top-of-window)
-	   ("\e(" backward-paragraph)
-	   ("\e)" forward-paragraph)
-	   ("\e?" apropos)
-	   ("\eh" delete-previous-word)
-	   ("\ej" indent-sexp)
-	   ("\eq" query-replace)
-	   ("\er" replace-string)
-	   ("\ez" scroll-one-line-down)
-	   ("\C-_" suspend-emacs)))))
-
-(defun rebind-and-record (bindings)
-  "Establish many new global bindings and record the bindings replaced.
-Arg BINDINGS is an alist whose elements are (KEY DEFINITION).
-Returns a similar alist whose elements describe the same KEYs
-but each with the old definition that was replaced,"
-  (let (old)
-    (while bindings
-      (let* ((this (car bindings))
-	     (key (car this))
-	     (newdef (nth 1 this)))
-	(setq old (cons (list key (lookup-key global-map key)) old))
-	(global-set-key key newdef))
-      (setq bindings (cdr bindings)))
-    (nreverse old)))
-
-(defun set-gnu-bindings ()
-  "Restore the global bindings that were changed by \\[set-gosmacs-bindings]."
-  (interactive)
-  (rebind-and-record non-gosmacs-binding-alist))
-
-(defun gosmacs-previous-window ()
-  "Select the window above or to the left of the window now selected.
-From the window at the upper left corner, select the one at the lower right."
-  (interactive)
-  (select-window (previous-window)))
-
-(defun gosmacs-next-window ()
-  "Select the window below or to the right of the window now selected.
-From the window at the lower right corner, select the one at the upper left."
-  (interactive)
-  (select-window (next-window)))
-
-(defun scroll-one-line-up (&optional arg)
-  "Scroll the selected window up (forward in the text) one line (or N lines)."
-  (interactive "p")
-  (scroll-up (or arg 1)))
-
-(defun scroll-one-line-down (&optional arg)
-  "Scroll the selected window down (backward in the text) one line (or N)."
-  (interactive "p")
-  (scroll-down (or arg 1)))
-
-(defun line-to-top-of-window ()
-  "Scroll the selected window up so that the current line is at the top."
-  (interactive)
-  (recenter 0))
-
-;;; gosmacs.el ends here
diff --git a/lisp/=grow-vers.el b/lisp/=grow-vers.el
deleted file mode 100644
index a7d03dd00bf..00000000000
--- a/lisp/=grow-vers.el
+++ /dev/null
@@ -1,41 +0,0 @@
-;;; grow-vers.el --- increment Emacs version number
-
-;; Copyright (C) 1985 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Load this file to add a new level (starting at zero)
-;; to the Emacs version number recorded in version.el.
-
-;;; Code:
-
-(insert-file-contents "lisp/version.el")
-
-(re-search-forward "emacs-version \"[0-9.]*")
-(insert ".0")
-
-;; Delete the share-link with the current version
-;; so that we do not alter the current version.
-(delete-file "lisp/version.el")
-(write-region (point-min) (point-max) "lisp/version.el" nil 'nomsg)
-
-;;; grow-vers.el ends here
diff --git a/lisp/=inc-vers.el b/lisp/=inc-vers.el
deleted file mode 100644
index 0a4a43f0ea8..00000000000
--- a/lisp/=inc-vers.el
+++ /dev/null
@@ -1,54 +0,0 @@
-;;; inc-vers.el --- load this to increment the recorded Emacs version number.
-
-;; Copyright (C) 1985, 1986 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(insert-file-contents "../lisp/version.el")
-
-(re-search-forward "emacs-version \"[^\"]*[0-9]+\"")
-(forward-char -1)
-(save-excursion
-  (save-restriction
-    (narrow-to-region (point)
-		      (progn (skip-chars-backward "0-9") (point)))
-    (goto-char (point-min))
-    (let ((version (read (current-buffer))))
-      (delete-region (point-min) (point-max))
-      (prin1 (1+ version) (current-buffer)))))
-(skip-chars-backward "^\"")
-(message "New Emacs version will be %s"
-	 (buffer-substring (point)
-			   (progn (skip-chars-forward "^\"") (point))))
-
-
-(if (and (file-accessible-directory-p "../lisp/")
-	 (null (file-writable-p "../lisp/version.el")))
-    (delete-file "../lisp/version.el"))
-(if (eq system-type 'ms-dos) (setq buffer-file-type t))
-(write-region (point-min) (point-max) "../lisp/version.el" nil 'nomsg)
-(erase-buffer)
-(set-buffer-modified-p nil)
-
-(kill-emacs)
-
-;;; inc-vers.el ends here
diff --git a/lisp/=isearch-old.el b/lisp/=isearch-old.el
deleted file mode 100644
index ee7a1b04476..00000000000
--- a/lisp/=isearch-old.el
+++ /dev/null
@@ -1,608 +0,0 @@
-;;; isearch.el --- incremental search commands
-
-;; Copyright (C) 1985, 1986 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(defvar search-last-string "" "\
-Last string search for by a non-regexp search command.
-This does not include direct calls to the primitive search functions,
-and does not include searches that are aborted.")
-
-(defvar search-last-regexp "" "\
-Last string searched for by a regexp search command.
-This does not include direct calls to the primitive search functions,
-and does not include searches that are aborted.")
-
-
-(defconst search-repeat-char ?\C-s "\
-*Character to repeat incremental search forwards.")
-(defconst search-reverse-char ?\C-r "\
-*Character to repeat incremental search backwards.")
-(defconst search-exit-char ?\C-m "\
-*Character to exit incremental search.")
-(defconst search-delete-char ?\177 "\
-*Character to delete from incremental search string.")
-(defconst search-quote-char ?\C-q "\
-*Character to quote special characters for incremental search.")
-(defconst search-yank-word-char ?\C-w "\
-*Character to pull next word from buffer into search string.")
-(defconst search-yank-line-char ?\C-y "\
-*Character to pull rest of line from buffer into search string.")
-(defconst search-ring-advance-char ?\M-n "\
-*Character to pull next (more recent) search string from the ring of same.")
-(defconst search-ring-retreat-char ?\M-p "\
-*Character to pull previous (older) search string from the ring of same.")
-
-(defconst search-exit-option t "\
-*Non-nil means random control characters terminate incremental search.")
-
-(defvar search-slow-window-lines 1 "\
-*Number of lines in slow search display windows.
-These are the short windows used during incremental search on slow terminals.
-Negative means put the slow search window at the top (normally it's at bottom)
-and the value is minus the number of lines.")
-
-(defvar search-slow-speed 1200 "\
-*Highest terminal speed at which to use \"slow\" style incremental search.
-This is the style where a one-line window is created to show the line
-that the search has reached.")
-
-(defconst search-upper-case t
-  "*Non-nil means an upper-case letter as search input means case-sensitive.
-Any upper-case letter given explicitly as input to the incremental search
-has the effect of turning off `case-fold-search' for the rest of this search.
-Deleting the letter from the search string cancels the effect.")
-
-(fset 'search-forward-regexp 're-search-forward)
-(fset 'search-backward-regexp 're-search-backward)
-
-(defvar search-ring nil
-  "List of recent non-regexp incremental searches.
-Each element is a cons cell of the form (STRING . UPPERCASE-FLAG).")
-
-(defvar regexp-search-ring nil
-  "List of recent regexp incremental searches.
-Each element is a cons cell of the form (STRING . UPPERCASE-FLAG).")
-
-(defconst search-ring-max 16
-  "*Maximum length of search ring before oldest elements are thrown away.")
-
-(defvar search-ring-yank-pointer nil
-  "The tail of the search ring whose car is the last thing searched for.")
-
-(defvar regexp-search-ring-yank-pointer nil
-  "The tail of the regular expression search ring whose car is the last
-thing searched for.")
-
-
-(defun isearch-forward ()
-  "Do incremental search forward.
-As you type characters, they add to the search string and are found.
-Type Delete to cancel characters from end of search string.
-Type RET to exit, leaving point at location found.
-Type C-s to search again forward, C-r to search again backward.
-Type C-w to yank word from buffer onto end of search string and search for it.
-Type C-y to yank rest of line onto end of search string, etc.
-Type C-q to quote control character to search for it.
-Other control and meta characters terminate the search
- and are then executed normally.
-The above special characters are mostly controlled by parameters;
- do M-x apropos on search-.*-char to find them.
-C-g while searching or when search has failed
- cancels input back to what has been found successfully.
-C-g when search is successful aborts and moves point to starting point."
-  (interactive)
-  (isearch t))
-(define-key global-map "\C-s" 'isearch-forward)
-
-(defun isearch-forward-regexp ()
-  "Do incremental search forward for regular expression.
-Like ordinary incremental search except that your input
-is treated as a regexp.  See \\[isearch-forward] for more info."
-  (interactive)
-  (isearch t t))
-(define-key esc-map "\C-s" 'isearch-forward-regexp)
-
-(defun isearch-backward ()
-  "Do incremental search backward.
-See \\[isearch-forward] for more information."
-  (interactive)
-  (isearch nil))
-(define-key global-map "\C-r" 'isearch-backward)
-
-(defun isearch-backward-regexp ()
-  "Do incremental search backward for regular expression.
-Like ordinary incremental search except that your input
-is treated as a regexp.  See \\[isearch-forward] for more info."
-  (interactive)
-  (isearch nil t))
-(define-key esc-map "\C-r" 'isearch-backward-regexp)
-
-
-;; This function does all the work of incremental search.
-;; The functions attached to ^R and ^S are trivial,
-;; merely calling this one, but they are always loaded by default
-;; whereas this file can optionally be autoloadable.
-;; This is the only entry point in this file.
-
-;; OP-FUN is a function to be called after each input character is processed.
-;; (It is not called after characters that exit the search.)
-
-(defun isearch (forward &optional regexp op-fun)
-  (let ((search-string "")
-	(search-message "")
-	;; List of previous states during this search.
-	(history nil)
-	;; t means search is currently successful.
-	(success t)
-	;; Set once the search has wrapped around the end of the buffer.
-	(wrapped nil)
-	;; Nominal starting point for searching
-	;; Usually this is the same as the opoint,
-	;; but it is changed by wrapping
-	;; and also by repeating the search.
-	(barrier (point))
-	;; Set temporarily when adding a character to a regexp
-	;; enables it to match more rather than fewer places in the buffer.
-	liberalized
-	;; Set temporarily by yanking text into the search string.
-	yank-flag
-	(invalid-regexp nil)
-	;; non-nil means an explicit uppercase letter seen in the input
-	(uppercase-flag nil)
-	;; Non-nil means start using a small window
-	;; if the search moves outside what is currently on the frame.
-	(slow-terminal-mode (and (<= baud-rate search-slow-speed)
-				 (> (window-height)
-				    (* 4 search-slow-window-lines))))
-	;; t means a small window is currently in use.
-	(small-window nil)		;if t, using a small window
-	;; These variables preserve information from the small window
-	;; through exit from the save-window-excursion.
-	(found-point nil)
-	(found-start nil)
-	;; Point is at one end of the last match.
-	;; This variable records the other end of that match.
-	(other-end nil)
-	;; Value of point at start of search,
-	;; for moving the cursor back on quitting.
-	(opoint (point))
-	(inhibit-quit t)  ;Prevent ^G from quitting, so we can read it.
-	;; The frame we're working on; if this changes, we exit isearch.
-	(frame (if (fboundp 'selected-frame) (selected-frame))))
-	   
-    (isearch-push-state)
-    (save-window-excursion
-     (catch 'search-done
-       (while t
-	 (or (and (numberp unread-command-char) (>= unread-command-char 0))
-	     (progn
-	       (or (input-pending-p)
-		   (isearch-message))
-	       (if (and slow-terminal-mode
-			(not (or small-window (pos-visible-in-window-p))))
-		   (progn
-		     (setq small-window t)
-		     (setq found-point (point))
-		     (move-to-window-line 0)
-		     (let ((window-min-height 1))
-		       (split-window nil (if (< search-slow-window-lines 0)
-					     (1+ (- search-slow-window-lines))
-					   (- (window-height)
-					      (1+ search-slow-window-lines)))))
-		     (if (< search-slow-window-lines 0)
-			 (progn (vertical-motion (- 1 search-slow-window-lines))
-				(set-window-start (next-window) (point))
-				(set-window-hscroll (next-window)
-						    (window-hscroll))
-				(set-window-hscroll (selected-window) 0))
-		       (other-window 1))
-		     (goto-char found-point)))))
-	 (let ((char (if quit-flag
-			 ?\C-g
-		       (read-event))))
-	   (setq quit-flag nil liberalized nil yank-flag nil)
-	   (cond ((and (or (not (integerp char))
-			   (and (>= char 128)
-				(not (= char search-ring-advance-char))
-				(not (= char search-ring-retreat-char))))
-		       search-exit-option)
-		  (setq unread-command-char char)
-		  (throw 'search-done t))
-
-		 ;; If the user switches to a different frame, exit.
-		 ((not (eq frame last-event-frame))
-		  (setq unread-command-char char)
-		  (throw 'search-done t))
-
-		 ((eq char search-exit-char)
-		  ;; RET means exit search normally.
-		  ;; Except, if first thing typed, it means do nonincremental
-		  (if (= 0 (length search-string))
-		      (nonincremental-search forward regexp))
-		  (throw 'search-done t))
-		 ((= char ?\C-g)
-		  ;; ^G means the user tried to quit.
-		  (ding)
-		  (discard-input)
-		  (if success
-		      ;; If search is successful, move back to starting point
-		      ;; and really do quit.
-		      (progn (goto-char opoint)
-			     (signal 'quit nil))
-		    ;; If search is failing, rub out until it is once more
-		    ;;  successful.
-		    (while (not success) (isearch-pop))))
-		 ((or (eq char search-repeat-char)
-		      (eq char search-reverse-char))
-		  (if (eq forward (eq char search-repeat-char))
-		      ;; C-s in forward or C-r in reverse.
-		      (if (equal search-string "")
-			  ;; If search string is empty, use last one.
-			  (isearch-get-string-from-ring)
-			;; If already have what to search for, repeat it.
-			(or success
-			    (progn (goto-char (if forward (point-min) (point-max)))
-				   (setq wrapped t))))
-		    ;; C-s in reverse or C-r in forward, change direction.
-		    (setq forward (not forward)))
-		  (setq barrier (point)) ; For subsequent \| if regexp.
-		  (setq success t)
-		  (or (equal search-string "")
-		      (progn
-			;; If repeating a search that found an empty string,
-			;; ensure we advance.  Test history to make sure we
-			;; actually have done a search already; otherwise,
-			;; the match data will be random.
-			(if (and (cdr history)
-				 (= (match-end 0) (match-beginning 0)))
-			    (forward-char (if forward 1 -1)))
-			(isearch-search)))
-		  (isearch-push-state))
-		 ((= char search-delete-char)
-		  ;; Rubout means discard last input item and move point
-		  ;; back.  If buffer is empty, just beep.
-		  (if (null (cdr history))
-		      (ding)
-		    (isearch-pop)))
-		 ((= char search-ring-advance-char)
-		  (isearch-pop)
-		  (if regexp
-		      (let ((length (length regexp-search-ring)))
-			(if (zerop length)
-			    ()
-			  (setq regexp-search-ring-yank-pointer
-				(nthcdr (% (+ 1 (- length (length regexp-search-ring-yank-pointer)))
-					   length)
-					regexp-search-ring))
-			  (isearch-get-string-from-ring)))
-		    (let ((length (length search-ring)))
-			(if (zerop length)
-			    ()
-			  (setq search-ring-yank-pointer
-				(nthcdr (% (+ 1 (- length (length search-ring-yank-pointer)))
-					   length)
-					search-ring))
-			  (isearch-get-string-from-ring))))
-		  (isearch-push-state)
-		  (isearch-search))
-		 ((= char search-ring-retreat-char)
-		  (isearch-pop)
-		  (if regexp
-		      (let ((length (length regexp-search-ring)))
-			(if (zerop length)
-			    ()
-			  (setq regexp-search-ring-yank-pointer
-				(nthcdr (% (+ (- length (length regexp-search-ring-yank-pointer))
-					      (1- length))
-					   length)
-					regexp-search-ring))
-			  (isearch-get-string-from-ring)))
-		    (let ((length (length search-ring)))
-			(if (zerop length)
-			    ()
-			  (setq search-ring-yank-pointer
-				(nthcdr (% (+ (- length (length search-ring-yank-pointer))
-					      (1- length))
-					   length)
-					search-ring))
-			  (isearch-get-string-from-ring))))
-		  (isearch-push-state)
-		  (isearch-search))
-		 (t
-		  (cond ((or (eq char search-yank-word-char)
-			     (eq char search-yank-line-char))
-			 ;; ^W means gobble next word from buffer.
-			 ;; ^Y means gobble rest of line from buffer.
-			 (let ((word (save-excursion
-				       (and (not forward) other-end
-					    (goto-char other-end))
-				       (buffer-substring
-					(point)
-					(save-excursion
-					  (if (eq char search-yank-line-char)
-					      (end-of-line)
-					    (forward-word 1))
-					  (point))))))
-			   (if regexp
-			       (setq word (regexp-quote word)))
-			   (setq search-string (concat search-string word)
-				 search-message
-				 (concat search-message
-					 (mapconcat 'text-char-description
-						    word ""))
-				 ;; Don't move cursor in reverse search.
-				 yank-flag t)))
-			 ;; Any other control char =>
-			 ;;  unread it and exit the search normally.
-			 ((and search-exit-option
-			       (/= char search-quote-char)
-			       (or (>= char ?\177)
-				   (and (< char ? )
-					(/= char ?\t)
-					(/= char ?\n))))
-			  (setq unread-command-char char)
-			  (throw 'search-done t))
-			 (t
-			  ;; Any other character => add it to the
-			  ;;  search string and search.
-			  (cond ((= char search-quote-char)
-				 (setq char (read-quoted-char
-					     (isearch-message t))))
-				((= char ?\r)
-				 ;; RET translates to newline.
-				 (setq char ?\n)))
-			  (setq search-string (concat search-string
-						      (char-to-string char))
-				search-message (concat search-message
-						       (text-char-description char))
-				uppercase-flag (or uppercase-flag
-						   (not (= char (downcase char)))))))
-		  (if (and (not success)
-			   ;; unsuccessful regexp search may become
-			   ;;  successful by addition of characters which
-			   ;;  make search-string valid
-			   (not regexp))
-		      nil
-		    ;; Check for chars that can make a regexp more liberal.
-		    ;; They can make a regexp match sooner
-		    ;; or make it succeed instead of failing.
-		    ;; So go back to place last successful search started
-		    ;; or to the last ^S/^R (barrier), whichever is nearer.
-		    (and regexp history
-			 (cond ((and (memq char '(?* ??))
-				     ;; Don't treat *, ? as special
-				     ;; within [] or after \.
-				     (not (nth 6 (car history))))
-				(setq liberalized t)
-				;; This used to use element 2
-				;; in a reverse search, but it seems that 5
-				;; (which is the end of the old match)
-				;; is better in that case too.
-				(let ((cs (nth 5 ; old other-end.
-					       (car (cdr history)))))
-				  ;; (car history) is after last search;
-				  ;; (car (cdr history)) is from before it.
-				  (setq cs (or cs barrier))
-				  (goto-char
-				   (if forward
-				       (max cs barrier)
-				     (min cs barrier)))))
-			       ((eq char ?\|)
-				(setq liberalized t)
-				(goto-char barrier))))
-		    ;; Turn off case-sensitivity if string requests it.
-		    (let ((case-fold-search
-			   (and case-fold-search
-				(not (and uppercase-flag
-					  search-upper-case)))))
-		      ;; In reverse search, adding stuff at
-		      ;; the end may cause zero or many more chars to be
-		      ;; matched, in the string following point.
-		      ;; Allow all those possibilities without moving point as
-		      ;; long as the match does not extend past search origin.
-		      (if (and (not forward) (not liberalized)
-			       (condition-case ()
-				   (looking-at (if regexp search-string
-						 (regexp-quote search-string)))
-				 (error nil))
-			       (or yank-flag
-				   ;; Used to have (min opoint barrier)
-				   ;; instead of barrier.
-				   ;; This lost when wrapping.
-				   (<= (match-end 0) barrier)))
-			  (setq success t invalid-regexp nil
-				other-end (match-end 0))
-			;; Not regexp, not reverse, or no match at point.
-			(if (and other-end (not liberalized))
-			    (goto-char (if forward other-end
-					 ;; Used to have opoint inside the min.
-					 ;; This lost when wrapping.
-					 (min barrier (1+ other-end)))))
-			(isearch-search))))
-		  (isearch-push-state))))
-	 (if op-fun (funcall op-fun))))
-     (setq found-start (window-start (selected-window)))
-     (setq found-point (point)))
-    (if (> (length search-string) 0)
-	(if (and regexp (not (member search-string regexp-search-ring)))
-	    (progn
-	      (setq regexp-search-ring (cons (cons search-string uppercase-flag)
-					    regexp-search-ring)
-		    regexp-search-ring-yank-pointer regexp-search-ring)
-	      (if (> (length regexp-search-ring) search-ring-max)
-		  (setcdr (nthcdr (1- search-ring-max) regexp-search-ring) nil)))
-	  (if (not (member search-string search-ring))
-	      (progn
-		(setq search-ring (cons (cons search-string uppercase-flag)
-					search-ring)
-		      search-ring-yank-pointer search-ring)
-		(if (> (length search-ring) search-ring-max)
-		    (setcdr (nthcdr (1- search-ring-max) search-ring) nil))))))
-    ;; If we displayed a single-line window, set point in this window. 
-    (if small-window
-	(goto-char found-point))
-    ;; If there was movement, mark the starting position.
-    ;; Maybe should test difference between and set mark iff > threshold.
-    (if (/= (point) opoint)
-	(push-mark opoint)
-      (message ""))
-    (or small-window
-	;; Exiting the save-window-excursion clobbers this; restore it.
-	(set-window-start (selected-window) found-start t))))
-
-(defun isearch-message (&optional c-q-hack ellipsis)
-  ;; If about to search, and previous search regexp was invalid,
-  ;; check that it still is.  If it is valid now,
-  ;; let the message we display while searching say that it is valid.
-  (and invalid-regexp ellipsis
-       (condition-case ()
-	   (progn (re-search-forward search-string (point) t)
-		  (setq invalid-regexp nil))
-	 (error nil)))
-  ;; If currently failing, display no ellipsis.
-  (or success (setq ellipsis nil))
-  (let ((m (concat (if success "" "failing ")
-		   (if wrapped "wrapped ")
-		   (if (or (not case-fold-search)
-			   (and uppercase-flag search-upper-case))
-		       "case-sensitive ")
-		   (if regexp "regexp " "")
-		   "I-search"
-		   (if forward ": " " backward: ")
-		   search-message
-		   (if c-q-hack "^Q" "")
-		   (if invalid-regexp
-		       (concat " [" invalid-regexp "]")
-		     ""))))
-    (aset m 0 (upcase (aref m 0)))
-    (let ((cursor-in-echo-area ellipsis))
-      (if c-q-hack m (message "%s" m)))))
-
-;; Get the search string from the "front" of the ring of previous searches.
-(defun isearch-get-string-from-ring ()
-  (let ((elt (car (if regexp
-		      (or regexp-search-ring-yank-pointer regexp-search-ring)
-		    (or search-ring-yank-pointer search-ring)))))
-    ;; ELT describes the most recent search or where we have rotated the ring.
-    (if elt
-	(setq search-string (car elt)
-	      uppercase-flag (cdr elt))
-      (setq search-string "" uppercase-flag nil)))
-  ;; Let's give this one the benefit of the doubt.
-  (setq invalid-regexp nil)
-  (setq search-message (mapconcat 'text-char-description search-string "")))
-
-(defun isearch-pop ()
-  (setq history (cdr history))
-  (let ((cmd (car history)))
-    (setq search-string (car cmd)
-	  search-message (car (cdr cmd))
-	  success (nth 3 cmd)
-	  forward (nth 4 cmd)
-	  other-end (nth 5 cmd)
-	  invalid-regexp (nth 6 cmd)
-	  wrapped (nth 7 cmd)
-	  barrier (nth 8 cmd)
-	  uppercase-flag (nth 9 cmd))
-    (goto-char (car (cdr (cdr cmd))))))
-
-(defun isearch-push-state ()
-  (setq history (cons (list search-string search-message (point)
-			    success forward other-end invalid-regexp
-			    wrapped barrier uppercase-flag)
-		      history)))
-
-(defun isearch-search ()
-  (let ((case-fold-search
-	 (and case-fold-search
-	      (not (and uppercase-flag
-			search-upper-case)))))
-    (isearch-message nil t)
-    (condition-case lossage
-	(let ((inhibit-quit nil))
-	  (if regexp (setq invalid-regexp nil))
-	  (setq success
-		(funcall
-		 (if regexp
-		     (if forward 're-search-forward 're-search-backward)
-		   (if forward 'search-forward 'search-backward))
-		 search-string nil t))
-	  (if success
-	      (setq other-end
-		    (if forward (match-beginning 0) (match-end 0)))))
-      (quit (setq unread-command-char ?\C-g)
-	    (setq success nil))
-      (invalid-regexp (setq invalid-regexp (car (cdr lossage)))
-		      (if (string-match "\\`Premature \\|\\`Unmatched \\|\\`Invalid "
-					invalid-regexp)
-			  (setq invalid-regexp "incomplete input"))))
-    (if success
-	nil
-      ;; Ding if failed this time after succeeding last time.
-      (and (nth 3 (car history))
-	   (ding))
-      (goto-char (nth 2 (car history))))))
-
-;; This is called from incremental-search
-;; if the first input character is the exit character.
-;; The interactive-arg-reader uses free variables `forward' and `regexp'
-;; which are bound by `incremental-search'.
-
-;; We store the search string in `search-string'
-;; which has been bound already by `incremental-search'
-;; so that, when we exit, it is copied into `search-last-string'.
-
-(defun nonincremental-search (forward regexp)
-  (let (message char function string inhibit-quit)
-    (let ((cursor-in-echo-area t))
-      ;; Prompt assuming not word search,
-      (setq message (if regexp 
-			(if forward "Regexp search: "
-			  "Regexp search backward: ")
-		      (if forward "Search: " "Search backward: ")))
-      (message "%s" message)
-      ;; Read 1 char and switch to word search if it is ^W.
-      (setq char (read-event)))
-    (if (and (numberp char) (eq char search-yank-word-char))
-	(setq message (if forward "Word search: " "Word search backward: "))
-      ;; Otherwise let that 1 char be part of the search string.
-      (setq unread-command-char char))
-    (setq function
-	  (if (eq char search-yank-word-char)
-	      (if forward 'word-search-forward 'word-search-backward)
-	    (if regexp
-		(if forward 're-search-forward 're-search-backward)
-	      (if forward 'search-forward 'search-backward))))
-    ;; Read the search string with corrected prompt.
-    (setq string (read-string message))
-    ;; Empty means use default.
-    (if (= 0 (length string))
-	(setq string search-last-string)
-      ;; Set last search string now so it is set even if we fail.
-      (setq search-last-string string))
-    ;; Since we used the minibuffer, we should be available for redo.
-    (setq command-history (cons (list function string) command-history))
-    ;; Go ahead and search.
-    (funcall function string)))
-
-;;; isearch.el ends here
diff --git a/lisp/=iso8859-1.el b/lisp/=iso8859-1.el
deleted file mode 100644
index 34d0ac0d368..00000000000
--- a/lisp/=iso8859-1.el
+++ /dev/null
@@ -1,104 +0,0 @@
-;;; iso8859-1.el --- set up case-conversion and syntax tables for ISO 8859/1
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Written by Howard Gayle.  See case-table.el for details.
-
-;;; Code:
-
-(require 'case-table)
-
-(let ((table (car (standard-case-table))))
-  (set-case-syntax 160 " " table)	; NBSP (no-break space)
-  (set-case-syntax 161 "." table)	; inverted exclamation mark
-  (set-case-syntax 162 "w" table)	; cent sign
-  (set-case-syntax 163 "w" table)	; pound sign
-  (set-case-syntax 164 "w" table)	; general currency sign
-  (set-case-syntax 165 "w" table)	; yen sign
-  (set-case-syntax 166 "_" table)	; broken vertical line
-  (set-case-syntax 167 "w" table)	; section sign
-  (set-case-syntax 168 "w" table)	; diaeresis
-  (set-case-syntax 169 "_" table)	; copyright sign
-  (set-case-syntax 170 "w" table)	; ordinal indicator, feminine
-  (set-case-syntax-delims 171 187 table) ; angle quotation marks
-  (set-case-syntax 172 "_" table)	; not sign
-  (set-case-syntax 173 "_" table)	; soft hyphen
-  (set-case-syntax 174 "_" table)	; registered sign
-  (set-case-syntax 175 "w" table)	; macron
-  (set-case-syntax 176 "_" table)	; degree sign
-  (set-case-syntax 177 "_" table)	; plus or minus sign
-  (set-case-syntax 178 "w" table)	; superscript two
-  (set-case-syntax 179 "w" table)	; superscript three
-  (set-case-syntax 180 "w" table)	; acute accent
-  (set-case-syntax 181 "_" table)	; micro sign
-  (set-case-syntax 182 "w" table)	; pilcrow
-  (set-case-syntax 183 "_" table)	; middle dot
-  (set-case-syntax 184 "w" table)	; cedilla
-  (set-case-syntax 185 "w" table)	; superscript one
-  (set-case-syntax 186 "w" table)	; ordinal indicator, masculine
-  ;;    	       	      187          ; See 171 above.
-  (set-case-syntax 188 "_" table)	; fraction one-quarter
-  (set-case-syntax 189 "_" table)	; fraction one-half
-  (set-case-syntax 190 "_" table)	; fraction three-quarters
-  (set-case-syntax 191 "." table)	; inverted question mark
-  (set-case-syntax-pair 192 224 table) ; A with grave accent
-  (set-case-syntax-pair 193 225 table) ; A with acute accent
-  (set-case-syntax-pair 194 226 table) ; A with circumflex accent
-  (set-case-syntax-pair 195 227 table) ; A with tilde
-  (set-case-syntax-pair 196 228 table) ; A with diaeresis or umlaut mark
-  (set-case-syntax-pair 197 229 table) ; A with ring
-  (set-case-syntax-pair 198 230 table) ; AE diphthong
-  (set-case-syntax-pair 199 231 table) ; C with cedilla
-  (set-case-syntax-pair 200 232 table) ; E with grave accent
-  (set-case-syntax-pair 201 233 table) ; E with acute accent
-  (set-case-syntax-pair 202 234 table) ; E with circumflex accent
-  (set-case-syntax-pair 203 235 table) ; E with diaeresis or umlaut mark
-  (set-case-syntax-pair 204 236 table) ; I with grave accent
-  (set-case-syntax-pair 205 237 table) ; I with acute accent
-  (set-case-syntax-pair 206 238 table) ; I with circumflex accent
-  (set-case-syntax-pair 207 239 table) ; I with diaeresis or umlaut mark
-  (set-case-syntax-pair 208 240 table) ; D with stroke, Icelandic eth
-  (set-case-syntax-pair 209 241 table) ; N with tilde
-  (set-case-syntax-pair 210 242 table) ; O with grave accent
-  (set-case-syntax-pair 211 243 table) ; O with acute accent
-  (set-case-syntax-pair 212 244 table) ; O with circumflex accent
-  (set-case-syntax-pair 213 245 table) ; O with tilde
-  (set-case-syntax-pair 214 246 table) ; O with diaeresis or umlaut mark
-  (set-case-syntax 215 "_" table)	; multiplication sign
-  (set-case-syntax-pair 216 248 table) ; O with slash
-  (set-case-syntax-pair 217 249 table) ; U with grave accent
-  (set-case-syntax-pair 218 250 table) ; U with acute accent
-  (set-case-syntax-pair 219 251 table) ; U with circumflex accent
-  (set-case-syntax-pair 220 252 table) ; U with diaeresis or umlaut mark
-  (set-case-syntax-pair 221 253 table) ; Y with acute accent
-  (set-case-syntax-pair 222 254 table) ; thorn, Icelandic
-  (set-case-syntax 223 "w" table)	; small sharp s, German
-  (set-case-syntax 247 "_" table)	; division sign
-  (set-case-syntax 255 "w" table)	; small y with diaeresis or umlaut mark
-  (set-standard-case-table (list table)))
-
-(provide 'iso8859-1)
-
-;;; iso8859-1.el ends here
diff --git a/lisp/=man.el b/lisp/=man.el
deleted file mode 100644
index 6461f3f2447..00000000000
--- a/lisp/=man.el
+++ /dev/null
@@ -1,181 +0,0 @@
-;;; man.el --- read in and display parts of Unix manual.
-
-;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: unix
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This package provides an equivalent of the UNIX man(1) command within
-;; Emacs.  The single entry point is `manual-entry'.
-
-;;; Code:
-
-;;;###autoload
-(defun manual-entry (topic &optional section)
-  "Display the Unix manual entry for TOPIC.
-TOPIC is either the title of the entry, or has the form TITLE(SECTION)
-where SECTION is the desired section of the manual, as in \"tty(4)\"."
-  (interactive "sManual entry (topic): ")
-  (if (= (length topic) 0)
-      (error "Must specify topic"))
-  (if (and (null section)
-	   (string-match "\\`[ \t]*\\([^( \t]+\\)[ \t]*(\\(.+\\))[ \t]*\\'" topic))
-      (setq section (substring topic (match-beginning 2)
-				     (match-end 2))
-	    topic (substring topic (match-beginning 1)
-				   (match-end 1))))
-  (with-output-to-temp-buffer (concat "*" topic " Manual Entry*")
-    (buffer-disable-undo standard-output)
-    (save-excursion
-      (set-buffer standard-output)
-      (message "Looking for formatted entry for %s%s..."
-	       topic (if section (concat "(" section ")") ""))
-      (let ((dirlist manual-formatted-dirlist)
-	    (case-fold-search nil)
-	    name)
-	(if (and section (or (file-exists-p
-			       (setq name (concat manual-formatted-dir-prefix
-						  (substring section 0 1)
-						  "/"
-						  topic "." section)))
-			     (file-exists-p
-			       (setq name (concat manual-formatted-dir-prefix
-						  section
-						  "/"
-						  topic "." section)))))
-	    (insert-man-file name)
-	  (while dirlist
-	    (let* ((dir (car dirlist))
-		   (name1 (concat dir "/" topic "."
-				  (or section
-				      (substring
-					dir
-					(1+ (or (string-match "\\.[^./]*$" dir)
-						-2))))))
-		   completions)
-	      (if (file-exists-p name1)
-		  (insert-man-file name1)
-		(condition-case ()
-		    (progn
-		      (setq completions (file-name-all-completions
-					 (concat topic "." (or section ""))
-					 dir))
-		      (while completions
-			(insert-man-file (concat dir "/" (car completions)))
-			(setq completions (cdr completions))))
-		  (file-error nil)))
-	      (goto-char (point-max)))
-	    (setq dirlist (cdr dirlist)))))
-
-      (if (= (buffer-size) 0)
-	  (progn
-	    (message "No formatted entry, invoking man %s%s..."
-		     (if section (concat section " ") "") topic)
-	    (if section
-		(call-process manual-program nil t nil section topic)
-	        (call-process manual-program nil t nil topic))
-	    (if (< (buffer-size) 80)
-		(progn
-		  (goto-char (point-min))
-		  (end-of-line)
-		  (error (buffer-substring 1 (point)))))))
-
-      (message "Cleaning manual entry for %s..." topic)
-      (nuke-nroff-bs)
-      (set-buffer-modified-p nil)
-      (setq buffer-read-only t)
-      (view-mode nil 'bury-buffer)
-      (message ""))))
-
-;; Hint: BS stands for more things than "back space"
-(defun nuke-nroff-bs ()
-  (interactive "*")
-  ;; Nuke headers: "MORE(1) UNIX Programmer's Manual MORE(1)"
-  ;; We expext to find a footer just before the header except at the beginning.
-  (goto-char (point-min))
-  (while (re-search-forward "^ *\\([A-Za-z][-_.A-Za-z0-9]*([0-9A-Z]+)\\).*\\1$" nil t)
-    (let (start end)
-      ;; Put START and END around footer and header and garbage blank lines.
-      ;; Fixed line counts are risky, but allow us to preserve
-      ;; significant blank lines.
-      ;; These numbers are correct for MORE BSD, at least.
-      (setq start (save-excursion (forward-line -9) (point)))
-      (setq end (save-excursion (forward-line 3) (point)))
-      (delete-region start end)))
-  ;; Catch the final footer.
-  (goto-char (point-max))
-  (delete-region (point) (save-excursion (forward-line -7) (point)))
-
-  ;; Nuke underlining and overstriking (only by the same letter)
-  (goto-char (point-min))
-  (while (search-forward "\b" nil t)
-    (let* ((preceding (char-after (- (point) 2)))
-	   (following (following-char)))
-      (cond ((= preceding following)
-	     ;; x\bx
-	     (delete-char -2))
-	    ((and (= preceding ?o) (= following ?\+))
-	     ;; o\b+ 
-	     (delete-char -2))
-	    ((= preceding ?\_)
-	     ;; _\b
-	     (delete-char -2))
-	    ((= following ?\_)
-	     ;; \b_
-	     (delete-region (1- (point)) (1+ (point)))))))
-
-  ;; Zap ESC7, ESC8, and ESC9.
-  ;; This is for Sun man pages like "man 1 csh"
-  (goto-char (point-min))
-  (while (re-search-forward "\e[789]" nil t)
-    (replace-match ""))
-
-  ;; Convert o^H+ into o.
-  (goto-char (point-min))
-  (while (re-search-forward "o\010\\+" nil t)
-    (replace-match "o"))
-
-  ;; Nuke the dumb reformatting message
-  (goto-char (point-min))
-  (while (re-search-forward "Reformatting page.  Wait... done\n\n" nil t)
-    (replace-match ""))
-
-  ;; Crunch blank lines
-  (goto-char (point-min))
-  (while (re-search-forward "\n\n\n\n*" nil t)
-    (replace-match "\n\n"))
-
-  ;; Nuke blanks lines at start.
-  (goto-char (point-min))
-  (skip-chars-forward "\n")
-  (delete-region (point-min) (point)))
-
-
-(defun insert-man-file (name)
-  ;; Insert manual file (unpacked as necessary) into buffer
-  (if (or (equal (substring name -2) ".Z")
-	  (string-match "/cat[0-9][a-z]?\\.Z/" name))
-      (call-process "zcat" name t nil)
-    (if (equal (substring name -2) ".z")
-	(call-process "pcat" nil t nil name)
-      (insert-file-contents name))))
-
-;;; man.el ends here
diff --git a/lisp/=medit.el b/lisp/=medit.el
deleted file mode 100644
index 985c9b27344..00000000000
--- a/lisp/=medit.el
+++ /dev/null
@@ -1,123 +0,0 @@
-;;; medit.el --- front-end to the MEDIT package for editing MDL
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; Maintainer: FSF
-;; Keywords: languages
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; >> This package depends on two MDL packages: MEDIT and FORKS which
-;; >> can be obtained from the public (network) library at mit-ajax.
-
-;;; Code:
-
-(require 'mim-mode)
-
-(defconst medit-zap-file (concat "/tmp/" (user-login-name) ".medit.mud")
-  "File name for data sent to MDL by Medit.")
-(defconst medit-buffer "*MEDIT*"
-  "Name of buffer in which Medit accumulates data to send to MDL.")
-(defconst medit-save-files t
-  "If non-nil, Medit offers to save files on return to MDL.")
-  
-(defun medit-save-define ()
-  "Mark the previous or surrounding toplevel object to be sent back to MDL."
-  (interactive)
-  (save-excursion
-      (beginning-of-DEFINE)
-      (let ((start (point)))
-	(forward-mim-object 1)
-	(append-to-buffer medit-buffer start (point))
-	(goto-char start)
-	(message "%s" (buffer-substring start (progn (end-of-line) (point)))))))
-
-(defun medit-save-region (start end)
-  "Mark the current region to be sent to back to MDL."
-  (interactive "r")
-  (append-to-buffer medit-buffer start end)
-  (message "Current region saved for MDL."))
-
-(defun medit-save-buffer ()
-  "Mark the current buffer to be sent back to MDL."
-  (interactive)
-  (append-to-buffer medit-buffer (point-min) (point-max))
-  (message "Current buffer saved for MDL."))
-
-(defun medit-zap-define-to-mdl ()
-  "Return to MDL with surrounding or previous toplevel MDL object."
-  (interactive)
-  (medit-save-define)
-  (medit-goto-mdl))
-
-(defun medit-zap-region-mdl (start end)
-  "Return to MDL with current region."
-  (interactive)
-  (medit-save-region start end)
-  (medit-goto-mdl))
-
-(defun medit-zap-buffer ()
-  "Return to MDL with current buffer."
-  (interactive)
-  (medit-save-buffer)
-  (medit-goto-mdl))
-
-(defun medit-goto-mdl ()
-  "Return from Emacs to superior MDL, sending saved code.
-Optionally, offers to save changed files."
-  (interactive)
-  (let ((buffer (get-buffer medit-buffer)))
-  (if buffer
-      (save-excursion
-	(set-buffer buffer)
-	(if (buffer-modified-p buffer)
-	    (write-region (point-min) (point-max) medit-zap-file))
-	(set-buffer-modified-p nil)
-	(erase-buffer)))
-  (if medit-save-files (save-some-buffers))
-  ;; Note could handle parallel fork by giving argument "%xmdl".  Then
-  ;; mdl would have to invoke with "%emacs".
-  (suspend-emacs)))
-
-(defconst medit-mode-map nil)
-(if (not medit-mode-map)
-    (progn
-      (setq medit-mode-map (copy-keymap mim-mode-map))
-      (define-key medit-mode-map "\e\z" 'medit-save-define)
-      (define-key medit-mode-map "\e\^z" 'medit-save-buffer)
-      (define-key medit-mode-map "\^xz" 'medit-goto-mdl)
-      (define-key medit-mode-map "\^xs" 'medit-zap-buffer)))
-
-(defconst medit-mode-hook (and (boundp 'mim-mode-hook) mim-mode-hook) "")
-(setq mim-mode-hook '(lambda () (medit-mode)))
-	 
-(defun medit-mode (&optional state)
-  "Major mode for editing text and returning it to a superior MDL.
-Like Mim mode, plus these special commands:
-\\{medit-mode-map}"
-  (interactive)
-  (use-local-map medit-mode-map)
-  (run-hooks 'medit-mode-hook)
-  (setq major-mode 'medit-mode)
-  (setq mode-name "Medit"))
-
-(mim-mode)
-
-;;; medit.el ends here
diff --git a/lisp/=mh-e.el b/lisp/=mh-e.el
deleted file mode 100644
index 619556d260f..00000000000
--- a/lisp/=mh-e.el
+++ /dev/null
@@ -1,2933 +0,0 @@
-;;; mh-e.el --- GNU Emacs interface to the MH mail system
-
-;;; Copyright (C) 1985, 86, 87, 88, 90, 92, 93 Free Software Foundation
-
-(defconst mh-e-time-stamp "Time-stamp: <93/05/30 18:37:43 gildea>")
-
-;; Maintainer: Stephen Gildea <gildea@lcs.mit.edu>
-;; Version: 3.8.2
-;; Keywords: mail
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but without any warranty.  No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; document "GNU Emacs copying permission notice".   An exact copy
-;; of the document is supposed to have been given to you along with
-;; GNU Emacs so that you can know how you may redistribute it all.
-;; It should be in a file named COPYING.  Among other things, the
-;; copyright notice and this notice must be preserved on all copies.
-
-;;; Commentary:
-
-;;; mh-e works with Emacs 18 or 19, and MH 5 or 6.
-
-;;; HOW TO USE:
-;;; M-x mh-rmail to read mail.  Type C-h m there for a list of commands.
-;;; C-u M-x mh-rmail to visit any folder.
-;;; M-x mh-smail to send mail.  From within the mail reader, "m" works, too.
-;;; Your .emacs might benefit from these bindings:
-;;; (global-set-key "\C-xm" 'mh-smail)
-;;; (global-set-key "\C-x4m" 'mh-smail-other-window)
-;;; (global-set-key "\C-cr" 'mh-rmail)
-
-;;; MH (Message Handler) is a powerful mail reader.  The MH newsgroup
-;;; is comp.mail.mh; the mailing list is mh-users@ics.uci.edu (send to
-;;; mh-users-request to be added).  See the monthly Frequently Asked
-;;; Questions posting there for information on getting MH.
-
-;;; NB.  MH must have been compiled with the MHE compiler flag or several
-;;; features necessary mh-e will be missing from MH commands, specifically
-;;; the -build switch to repl and forw.
-
-;;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
-;;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
-;;; Rewritten for GNU Emacs, James Larus 1985.  larus@ginger.berkeley.edu
-;;; Modified by Stephen Gildea 1988.  gildea@bbn.com
-(defconst mh-e-RCS-id "$Header: /home/fsf/rms/e19/lisp/RCS/mh-e.el,v 1.15 1993/07/20 04:35:00 rms Exp rms $")
-
-;;; Code:
-
-
-
-;;; Constants:
-
-;;; Set for local environment:
-;;;* These are now in paths.el.
-;;;(defvar mh-progs "/usr/new/mh/" "Directory containing MH commands.")
-;;;(defvar mh-lib "/usr/new/lib/mh/" "Directory of MH library.")
-
-(defvar mh-redist-full-contents nil
-  "Non-nil if the `dist' command needs whole letter for redistribution.
-This is the case when `send' is compiled with the BERK option.")
-
-
-;;; Hooks:
-
-(defvar mh-folder-mode-hook nil
-  "Invoked in `mh-folder mode' on a new folder.")
-
-(defvar mh-letter-mode-hook nil
-  "Invoked in `mh-letter-mode' on a new letter.")
-
-(defvar mh-compose-letter-function nil
-  "Invoked in `mh-compose-and-send-mail' on a draft letter.
-It is passed three arguments: TO recipients, SUBJECT, and CC recipients.")
-
-(defvar mh-before-send-letter-hook nil
-  "Invoked at the beginning of the \\[mh-send-letter] command.")
-
-(defvar mh-inc-folder-hook nil
-  "Invoked after incorporating mail into a folder with \\[mh-inc-folder].")
-
-(defvar mh-before-quit-hook nil
-  "Invoked by \\[mh-quit] before quitting mh-e.  See also  mh-quit-hook")
-
-(defvar mh-quit-hook nil
-  "Invoked after quitting mh-e by \\[mh-quit].  See also  mh-before-quit-hook")
-
-
-(defvar mh-ins-string nil
-  "Temporarily set by `mh-insert-prefix' prior to running `mh-yank-hooks'.")
-
-(defvar mh-yank-hooks
-  '(lambda ()
-    (save-excursion
-      (goto-char (point))
-      (or (bolp) (forward-line 1))
-      (while (< (point) (mark t))
-	(insert mh-ins-string)
-	(forward-line 1))))
-  "Hook to run citation function.
-Expects POINT and MARK to be set to the region to cite.")
-
-
-;;; Personal preferences:
-
-(defvar mh-clean-message-header nil
-  "*Non-nil means clean headers of messages that are displayed or inserted.
-The variables `mh-visible-headers' and `mh-invisible-headers' control what
-is removed.")
-
-(defvar mh-visible-headers nil
-  "*If non-nil, contains a regexp specifying the headers to keep when cleaning.
-Only used if `mh-clean-message-header' is non-nil.  Setting this variable
-overrides `mh-invisible-headers'.")
-
-(defvar mhl-formfile nil
-  "*Name of format file to be used by mhl to show messages.
-A value of T means use the default format file.
-Nil means don't use mhl to format messages.")
-
-(defvar mh-lpr-command-format "lpr -p -J '%s'"
-  "*Format for Unix command that prints a message.
-The string should be a Unix command line, with the string '%s' where
-the job's name (folder and message number) should appear.  The message text
-is piped to this command.")
-
-(defvar mh-print-background nil
-  "*Print messages in the background if non-nil.
-WARNING: do not delete the messages until printing is finished;
-otherwise, your output may be truncated.")
-
-(defvar mh-summary-height 4
-  "*Number of lines in summary window (including the mode line).")
-
-(defvar mh-recenter-summary-p nil
-  "*Recenter summary window when the show window is toggled off if non-nil.")
-
-(defvar mh-ins-buf-prefix "> "
-  "*String to put before each non-blank line of a yanked or inserted message.
-Used when the message is inserted in an outgoing letter.")
-
-(defvar mh-do-not-confirm nil
-  "*Non-nil means do not prompt for confirmation before some commands.
-Only affects certain innocuous commands.")
-
-(defvar mh-bury-show-buffer t
-  "*Non-nil means that the displayed show buffer for a folder is buried.")
-
-(defvar mh-delete-yanked-msg-window nil
-  "*Controls window display when a message is yanked by \\[mh-yank-cur-msg].
-If non-nil, yanking the current message into a draft letter deletes any
-windows displaying the message.")
-
-(defvar mh-yank-from-start-of-msg t
-  "*Controls which part of a message is yanked by \\[mh-yank-cur-msg].
-If non-nil, include the entire message.  If the symbol `body', then yank the
-message minus the header.  If nil, yank only the portion of the message
-following the point.  If the show buffer has a region, this variable is
-ignored.")
-
-(defvar mh-reply-default-reply-to nil
-  "*Sets the person or persons to whom a reply will be sent.
-If nil, prompt for recipient. If non-nil, then \\[mh-reply] will use this
-value and it should be one of \"from\", \"to\", or \"cc\".")
-
-(defvar mh-recursive-folders nil
-  "*If non-nil, then commands which operate on folders do so recursively.")
-
-(defvar mh-unshar-default-directory ""
-  "*Default for directory name prompted for by mh-unshar-msg.")
-
-(defvar mh-signature-file-name "~/.signature"
-  "*Name of file containing the user's signature.
-Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature].")
-
-
-;;; Parameterize mh-e to work with different scan formats.  The defaults work
-;;; with the standard MH scan listings.
-
-(defvar mh-cmd-note 4
-  "Offset to insert notation.")
-
-(defvar mh-note-repl "-"
-  "String whose first character is used to notate replied to messages.")
-
-(defvar mh-note-forw "F"
-  "String whose first character is used to notate forwarded messages.")
-
-(defvar mh-note-dist "R"
-  "String whose first character is used to notate redistributed messages.")
-
-(defvar mh-good-msg-regexp  "^....[^D^]"
-  "Regexp specifying the scan lines that are 'good' messages.")
-
-(defvar mh-deleted-msg-regexp "^....D"
-  "Regexp matching scan lines of deleted messages.")
-
-(defvar mh-refiled-msg-regexp  "^....\\^"
-  "Regexp matching scan lines of refiled messages.")
-
-(defvar mh-valid-scan-line "^ *[0-9]"
-  "Regexp matching scan lines for messages (not error messages).")
-
-(defvar mh-msg-number-regexp "^ *\\([0-9]+\\)"
-  "Regexp to find the number of a message in a scan line.
-The message's number must be surrounded with \\( \\)")
-
-(defvar mh-msg-search-regexp "^[^0-9]*%d[^0-9]"
-  "Format string containing a regexp matching the scan listing for a message.
-The desired message's number will be an argument to format.")
-
-(defvar mh-flagged-scan-msg-regexp "^....\\D\\|^....\\^\\|^....\\+\\|^.....%"
-  "Regexp matching flagged scan lines.
-Matches lines marked as deleted, refiled, in a sequence, or the cur message.")
-
-(defvar mh-cur-scan-msg-regexp "^....\\+"
-  "Regexp matching scan line for the cur message.")
-
-(defvar mh-show-buffer-mode-line-buffer-id "{%%b}  %s/%d"
-  "Format string to produce `mode-line-buffer-id' for show buffers.
-First argument is folder name.  Second is message number.")
-
-(defvar mh-partial-folder-mode-line-annotation "select"
-  "Annotation when displaying part of a folder.
-The string is displayed after the folder's name.  NIL for no annotation.")
-
-
-;;; Real constants:
-
-(defvar mh-invisible-headers
-  "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^In-Reply-To: \\|^Resent-"
-  "Regexp matching lines in a message header that are not to be shown.
-If `mh-visible-headers' is non-nil, it is used instead to specify what
-to keep.")
-
-(defvar mh-rejected-letter-start
-  (concat "^   ----- Unsent message follows -----$" ;from mail system
-	  "\\|^------- Unsent Draft$"	;from MH itself
-	  "\\|^  --- The unsent message follows ---$") ;from AIX mail system
-  "Regexp specifying the beginning of the wrapper around a returned letter.
-This wrapper is generated by the mail system when rejecting a letter.")
-
-(defvar mh-to-field-choices '((?t . "To:") (?s . "Subject:") (?c . "Cc:")
-			      (?b . "Bcc:") (?f . "Fcc:"))
-  "A-list of (character . field name) strings for mh-to-field.")
-
-
-;;; Global variables:
-
-(defvar mh-user-path  ""
-  "User's mail folder.")
-
-(defvar mh-last-destination nil
-  "Destination of last refile or write command.")
-
-(defvar mh-folder-mode-map (make-keymap)
-  "Keymap for MH folders.")
-
-(defvar mh-letter-mode-map (copy-keymap text-mode-map)
-  "Keymap for composing mail.")
-
-(defvar mh-pick-mode-map (make-sparse-keymap)
-  "Keymap for searching folder.")
-
-(defvar mh-searching-folder nil
-  "Folder this pick is searching.")
-
-(defvar mh-letter-mode-syntax-table nil
-  "Syntax table used while in mh-e letter mode.")
-
-(if mh-letter-mode-syntax-table
-    ()
-    (setq mh-letter-mode-syntax-table
-	  (make-syntax-table text-mode-syntax-table))
-    (set-syntax-table mh-letter-mode-syntax-table)
-    (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
-
-(defvar mh-folder-list nil
-  "List of folder names for completion.")
-
-(defvar mh-draft-folder nil
-  "Name of folder containing draft messages.
-NIL means do not use draft folder.")
-
-(defvar mh-unseen-seq nil
-  "Name of the unseen sequence.")
-
-(defvar mh-previous-window-config nil
-  "Window configuration before mh-e command.")
-
-(defvar mh-previous-seq nil
-  "Name of the sequence to which a message was last added.")
-
-
-;;; Macros and generic functions:
-
-(defmacro mh-push (v l)
-  (list 'setq l (list 'cons v l)))
-
-
-(defmacro mh-when (pred &rest body)
-  (list 'cond (cons pred body)))
-
-
-(defmacro with-mh-folder-updating (save-modification-flag-p &rest body)
-  ;; Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG-P) &body BODY).
-  ;; Execute BODY, which can modify the folder buffer without having to
-  ;; worry about file locking or the read-only flag, and return its result.
-  ;; If SAVE-MODIFICATION-FLAG-P is non-nil, the buffer's modification
-  ;; flag is unchanged, otherwise it is cleared.
-  (setq save-modification-flag-p (car save-modification-flag-p)) ; CL style
-  (` (let ((folder-updating-mod-flag (buffer-modified-p)))
-       (prog1
-	   (let ((buffer-read-only nil)
-		 (buffer-file-name nil)) ; don't let the buffer get locked
-	     (,@ body))
-	 (, (if save-modification-flag-p
-		'(mh-set-folder-modified-p folder-updating-mod-flag)
-	      '(mh-set-folder-modified-p nil)))))))
-
-
-(defun mh-mapc (func list)
-  (while list
-    (funcall func (car list))
-    (setq list (cdr list))))
-
-
-
-;;; Entry points:
-
-;;;###autoload
-(defun mh-rmail (&optional arg)
-  "Inc(orporate) new mail (no arg) or scan a MH mail box (arg given).
-This front end uses the MH mail system, which uses different conventions
-from the usual mail system."
-  (interactive "P")
-  (mh-find-path)
-  (if arg
-      (call-interactively 'mh-visit-folder)
-      (mh-inc-folder)))
-
-
-;;;###autoload
-(defun mh-smail ()
-  "Compose and send mail with the MH mail system."
-  (interactive)
-  (mh-find-path)
-  (call-interactively 'mh-send))
-
-
-(defun mh-smail-other-window ()
-  "Compose and send mail in other window with the MH mail system."
-  (interactive)
-  (mh-find-path)
-  (call-interactively 'mh-send-other-window))
-
-
-
-;;; User executable mh-e commands:
-
-(defun mh-burst-digest ()
-  "Burst apart the current message, which should be a digest.
-The message is replaced by its table of contents and the letters from the
-digest are inserted into the folder after that message."
-  (interactive)
-  (let ((digest (mh-get-msg-num t)))
-    (mh-process-or-undo-commands mh-current-folder)
-    (mh-set-folder-modified-p t)		; lock folder while bursting
-    (message "Bursting digest...")
-    (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
-    (mh-scan-folder mh-current-folder (format "%d-last" mh-first-msg-num))
-    (message "Bursting digest...done")))
-
-
-(defun mh-copy-msg (prefix-provided msg-or-seq dest)
-  "Copy specified MESSAGE(s) to another FOLDER without deleting them.
-Default is the displayed message.  If optional prefix argument is
-provided, then prompt for the message sequence."
-  (interactive (list current-prefix-arg
-		     (if current-prefix-arg
-			 (mh-read-seq-default "Copy" t)
-			 (mh-get-msg-num t))
-		     (mh-prompt-for-folder "Copy to" "" t)))
-  (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder dest)
-  (if prefix-provided
-      (mh-notate-seq msg-or-seq ?C mh-cmd-note)
-      (mh-notate msg-or-seq ?C mh-cmd-note)))
-
-
-(defun mh-delete-msg (msg-or-seq)
-  "Mark the specified MESSAGE(s) for subsequent deletion and move to the next.
-Default is the displayed message.  If optional prefix argument is
-given then prompt for the message sequence."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-seq-default "Delete" t)
-			 (mh-get-msg-num t))))
-  (if (numberp msg-or-seq)
-      (mh-delete-a-msg msg-or-seq)
-      (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq))
-  (mh-next-msg))
-
-
-(defun mh-delete-msg-no-motion (msg-or-seq)
-  "Mark the specified MESSAGE(s) for subsequent deletion.
-Default is the displayed message.  If optional prefix argument is
-provided, then prompt for the message sequence."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-seq-default "Delete" t)
-			 (mh-get-msg-num t))))
-  (if (numberp msg-or-seq)
-      (mh-delete-a-msg msg-or-seq)
-      (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
-
-
-(defun mh-delete-msg-from-seq (prefix-provided msg-or-seq &optional from-seq)
-  "Delete MESSAGE (default: displayed message) from SEQUENCE.
-If optional prefix argument provided, then delete all messages
-from a sequence."
-  (interactive (let ((argp current-prefix-arg))
-		 (list argp
-		       (if argp
-			   (mh-read-seq-default "Delete" t)
-			   (mh-get-msg-num t))
-		       (if (not argp)
-			   (mh-read-seq-default "Delete from" t)))))
-  (if prefix-provided
-      (mh-remove-seq msg-or-seq)
-      (mh-remove-msg-from-seq msg-or-seq from-seq)))
-
-
-(defun mh-edit-again (msg)
-  "Clean-up a draft or a message previously sent and make it resendable."
-  (interactive (list (mh-get-msg-num t)))
-  (let* ((from-folder mh-current-folder)
-	 (config (current-window-configuration))
-	 (draft
-	  (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
-		 (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
-		 (rename-buffer (format "draft-%d" msg))
-		 (buffer-name))
-		(t
-		 (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
-    (mh-clean-msg-header (point-min)
-			 "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Delivery-Date:"
-			 nil)
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
-			      config)))
-
-
-(defun mh-execute-commands ()
-  "Process outstanding delete and refile requests."
-  (interactive)
-  (if mh-narrowed-to-seq (mh-widen))
-  (mh-process-commands mh-current-folder)
-  (mh-set-scan-mode)
-  (mh-goto-cur-msg)			; after mh-set-scan-mode for efficiency
-  (mh-make-folder-mode-line)
-  t)					; return t for write-file-hooks
-
-
-(defun mh-extract-rejected-mail (msg)
-  "Extract a letter returned by the mail system and make it resendable.
-Default is the displayed message."
-  (interactive (list (mh-get-msg-num t)))
-  (let ((from-folder mh-current-folder)
-	(config (current-window-configuration))
-	(draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
-    (goto-char (point-min))
-    (cond ((re-search-forward mh-rejected-letter-start nil t)
-	   (forward-char 1)
-	   (delete-region (point-min) (point))
-	   (mh-clean-msg-header (point-min)
-				"^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Return-Path:"
-				nil))
-	  (t
-	   (message "Does not appear to be a rejected letter.")))
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    (mh-compose-and-send-mail draft "" from-folder msg (mh-get-field "To")
-			      (mh-get-field "From") (mh-get-field "cc")
-			      nil nil config)))
-
-
-(defun mh-first-msg ()
-  "Move to the first message."
-  (interactive)
-  (goto-char (point-min)))
-
-
-(defun mh-forward (prefix-provided msg-or-seq to cc)
-  "Forward MESSAGE(s) (default: displayed message).
-If optional prefix argument provided, then prompt for the message sequence."
-  (interactive (list current-prefix-arg
-		     (if current-prefix-arg
-			 (mh-read-seq-default "Forward" t)
-			 (mh-get-msg-num t))
-		     (read-string "To: ")
-		     (read-string "Cc: ")))
-  (let* ((folder mh-current-folder)
-	 (config (current-window-configuration))
-	 ;; forw always leaves file in "draft" since it doesn't have -draft
-	 (draft-name (expand-file-name "draft" mh-user-path))
-	 (draft (cond ((or (not (file-exists-p draft-name))
-			   (y-or-n-p "The file 'draft' exists.  Discard it? "))
-		       (mh-exec-cmd "forw"
-				    "-build" mh-current-folder msg-or-seq)
-		       (prog1
-			   (mh-read-draft "" draft-name t)
-			 (mh-insert-fields "To:" to "Cc:" cc)
-			 (set-buffer-modified-p nil)))
-		      (t
-		       (mh-read-draft "" draft-name nil)))))
-    (goto-char (point-min))
-    (re-search-forward "^------- Forwarded Message")
-    (forward-line -1)
-    (narrow-to-region (point) (point-max))
-    (let* ((subject (save-excursion (mh-get-field "From:")))
-	   (trim (string-match "<" subject))
-	   (forw-subject (save-excursion (mh-get-field "Subject:"))))
-      (if trim
-	  (setq subject (substring subject 0 (1- trim))))
-      (widen)
-      (save-excursion
-	(mh-insert-fields "Subject:" (format "[%s: %s]" subject forw-subject)))
-      (delete-other-windows)
-      (if prefix-provided
-	  (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t)
-	  (mh-add-msgs-to-seq msg-or-seq 'forwarded t))
-      (mh-compose-and-send-mail draft "" folder msg-or-seq
-				to subject cc
-				mh-note-forw "Forwarded:"
-				config))))
-
-
-(defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
-  "Position the cursor at message NUMBER.
-Non-nil second argument means do not signal an error if message does not exist.
-Non-nil third argument means not to show the message.
-Return non-nil if cursor is at message."
-  (interactive "NGoto message: ")
-  (let ((cur-msg (mh-get-msg-num nil))
-	(starting-place (point))
-	(msg-pattern (mh-msg-search-pat number)))
-    (cond ((cond ((and cur-msg (= cur-msg number)) t)
-		 ((and cur-msg
-		       (< cur-msg number)
-		       (re-search-forward msg-pattern nil t)) t)
-		 ((and cur-msg
-		       (> cur-msg number)
-		       (re-search-backward msg-pattern nil t)) t)
-		 (t			; Do thorough search of buffer
-		  (goto-char (point-max))
-		  (re-search-backward msg-pattern nil t)))
-	    (beginning-of-line)
-	    (if (not dont-show) (mh-maybe-show number))
-	    t)
-	  (t
-	   (goto-char starting-place)
-	   (if (not no-error-if-no-message)
-	       (error "No message %d" number))
-	   nil))))
-
-
-(defun mh-inc-folder (&optional maildrop-name)
-  "Inc(orporate) new mail into +inbox.
-Optional prefix argument specifies an alternate maildrop from the default.
-If this is given, incorporate mail into the current folder, rather
-than +inbox.  Run `mh-inc-folder-hook' after incorporating new mail."
-  (interactive (list (if current-prefix-arg
-			 (expand-file-name
-			  (read-file-name "inc mail from file: "
-					  mh-user-path)))))
-  (let ((config (current-window-configuration)))
-    (if (not maildrop-name)
-	(cond ((not (get-buffer "+inbox"))
-	       (mh-make-folder "+inbox")
-	       (setq mh-previous-window-config config))
-	      ((not (eq (current-buffer) (get-buffer "+inbox")))
-	       (switch-to-buffer "+inbox")
-	       (setq mh-previous-window-config config)))))
-  (mh-get-new-mail maildrop-name)
-  (run-hooks 'mh-inc-folder-hook))
-
-
-(defun mh-kill-folder ()
-  "Remove the current folder."
-  (interactive)
-  (if (or mh-do-not-confirm
-	  (yes-or-no-p (format "Remove folder %s? " mh-current-folder)))
-      (let ((folder mh-current-folder))
-	(mh-set-folder-modified-p t)	; lock folder to kill it
-	(mh-exec-cmd-daemon "rmf" folder)
-	(mh-remove-folder-from-folder-list folder)
-	(message "Folder %s removed" folder)
-	(mh-set-folder-modified-p nil)	; so kill-buffer doesn't complain
-	(if (get-buffer mh-show-buffer)
-	    (kill-buffer mh-show-buffer))
-	(kill-buffer folder))
-      (message "Folder not removed")))
-
-
-(defun mh-last-msg ()
-  "Move to the last message."
-  (interactive)
-  (goto-char (point-max))
-  (while (and (not (bobp)) (looking-at "^$"))
-    (forward-line -1)))
-
-
-(defun mh-list-folders ()
-  "List mail folders."
-  (interactive)
-  (with-output-to-temp-buffer " *mh-temp*"
-    (save-excursion
-      (switch-to-buffer " *mh-temp*")
-      (erase-buffer)
-      (message "Listing folders...")
-      (mh-exec-cmd-output "folders" t (if mh-recursive-folders
-					  "-recurse"
-					  "-norecurse"))
-      (goto-char (point-min))
-      (message "Listing folders...done"))))
-
-
-(defun mh-msg-is-in-seq (msg)
-  "Display the sequences that contain MESSAGE (default: displayed message)."
-  (interactive (list (mh-get-msg-num t)))
-  (message "Message %d is in sequences: %s"
-	   msg
-	   (mapconcat 'concat
-		      (mh-list-to-string (mh-seq-containing-msg msg))
-		      " ")))
-
-
-(defun mh-narrow-to-seq (seq)
-  "Restrict display of this folder to just messages in a sequence.
-Reads which sequence.  Use \\[mh-widen] to undo this command."
-  (interactive (list (mh-read-seq "Narrow to" t)))
-  (let ((eob (point-max)))
-    (with-mh-folder-updating (t)
-      (cond ((mh-seq-to-msgs seq)
-	     (mh-copy-seq-to-point seq eob)
-	     (narrow-to-region eob (point-max))
-	     (mh-make-folder-mode-line (symbol-name seq))
-	     (mh-recenter nil)
-	     (setq mh-narrowed-to-seq seq))
-	    (t
-	     (error "No messages in sequence `%s'" (symbol-name seq)))))))
-
-
-(defun mh-next-undeleted-msg (&optional arg)
-  "Move to next undeleted message in window."
-  (interactive "P")
-  (forward-line (prefix-numeric-value arg))
-  (setq mh-next-direction 'forward)
-  (cond ((re-search-forward mh-good-msg-regexp nil 0 arg)
-	 (beginning-of-line)
-	 (mh-maybe-show))
-	(t
-	 (forward-line -1)
-	 (if (get-buffer mh-show-buffer)
-	     (delete-windows-on mh-show-buffer)))))
-
-
-(defun mh-pack-folder (range)
-  "Renumber the messages of a folder to be 1..n.
-First, offer to execute any outstanding commands for the current folder.
-If optional prefix argument provided, prompt for the range of messages
-to display after packing.  Otherwise, show the entire folder."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-msg-range
-			  "Range to scan after packing [all]? ")
-			 "all")))
-  (mh-pack-folder-1 range)
-  (mh-goto-cur-msg)
-  (message "Packing folder...done"))
-
-
-(defun mh-pipe-msg (prefix-provided command)
-  "Pipe the current message through the given shell COMMAND.
-If optional prefix argument is provided, send the entire message.
-Otherwise just send the message's body."
-  (interactive
-   (list current-prefix-arg (read-string "Shell command on message: ")))
-  (save-excursion
-    (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer
-    (goto-char (point-min))
-    (if (not prefix-provided) (search-forward "\n\n"))
-    (shell-command-on-region (point) (point-max) command nil)))
-
-
-(defun mh-refile-msg (prefix-provided msg-or-seq dest)
-  "Refile MESSAGE(s) (default: displayed message) in FOLDER.
-If optional prefix argument provided, then prompt for message sequence."
-  (interactive
-   (list current-prefix-arg
-	 (if current-prefix-arg
-	     (mh-read-seq-default "Refile" t)
-	     (mh-get-msg-num t))
-	 (intern
-	  (mh-prompt-for-folder "Destination"
-				(if (eq 'refile (car mh-last-destination))
-				    (symbol-name (cdr mh-last-destination))
-				    "")
-				t))))
-  (setq mh-last-destination (cons 'refile dest))
-  (if prefix-provided
-      (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq dest)
-      (mh-refile-a-msg msg-or-seq dest))
-  (mh-next-msg))
-
-
-(defun mh-refile-or-write-again (msg)
-  "Re-execute the last refile or write command on the given MESSAGE.
-Default is the displayed message.  Use the same folder or file as the
-previous refile or write command."
-  (interactive (list (mh-get-msg-num t)))
-  (if (null mh-last-destination)
-      (error "No previous refile or write"))
-  (cond ((eq (car mh-last-destination) 'refile)
-	 (mh-refile-a-msg msg (cdr mh-last-destination))
-	 (message "Destination folder: %s" (cdr mh-last-destination)))
-	(t
-	 (mh-write-msg-to-file msg (cdr mh-last-destination))
-	 (message "Destination: %s" (cdr mh-last-destination))))
-  (mh-next-msg))
-
-
-(defun mh-reply (prefix-provided msg)
-  "Reply to a MESSAGE (default: displayed message).
-If optional prefix argument provided, then include the message in the reply
-using filter mhl.reply in your MH directory."
-  (interactive (list current-prefix-arg (mh-get-msg-num t)))
-  (let ((minibuffer-help-form
-	 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
-    (let ((reply-to (or mh-reply-default-reply-to
-			(completing-read "Reply to whom: "
-					 '(("from") ("to") ("cc") ("all"))
-					 nil
-					 t)))
-	  (folder mh-current-folder)
-	  (show-buffer mh-show-buffer)
-	  (config (current-window-configuration)))
-      (message "Composing a reply...")
-      (cond ((or (equal reply-to "from") (equal reply-to ""))
-	     (apply 'mh-exec-cmd
-		    "repl" "-build" "-noquery"
-		    "-nodraftfolder" mh-current-folder
-		    msg
-		    "-nocc" "all"
-		    (if prefix-provided
-			(list "-filter" "mhl.reply"))))
-	    ((equal reply-to "to")
-	     (apply 'mh-exec-cmd
-		    "repl" "-build" "-noquery"
-		    "-nodraftfolder" mh-current-folder
-		    msg
-		    "-cc" "to"
-		    (if prefix-provided
-			(list "-filter" "mhl.reply"))))
-	    ((or (equal reply-to "cc") (equal reply-to "all"))
-	     (apply 'mh-exec-cmd
-		    "repl" "-build" "-noquery"
-		    "-nodraftfolder" mh-current-folder
-		    msg
-		    "-cc" "all" "-nocc" "me"
-		    (if prefix-provided
-			(list "-filter" "mhl.reply")))))
-
-      (let ((draft (mh-read-draft "reply"
-				  (expand-file-name "reply" mh-user-path)
-				  t)))
-	(delete-other-windows)
-	(set-buffer-modified-p nil)
-
-	(let ((to (mh-get-field "To:"))
-	      (subject (mh-get-field "Subject:"))
-	      (cc (mh-get-field "Cc:")))
-	  (goto-char (point-min))
-	  (mh-goto-header-end 1)
-	  (if (not prefix-provided)
-	      (mh-display-msg msg folder))
-	  (mh-add-msgs-to-seq msg 'answered t)
-	  (message "Composing a reply...done")
-	  (mh-compose-and-send-mail draft "" folder msg to subject cc
-				    mh-note-repl "Replied:" config))))))
-
-
-(defun mh-quit ()
-  "Quit mh-e.
-Start by running mh-before-quit-hook.  Restore the previous window
-configuration, if one exists.  Finish by running mh-quit-hook."
-  (interactive)
-  (run-hooks 'mh-before-quit-hook)
-  (if mh-previous-window-config
-      (set-window-configuration mh-previous-window-config))
-  (run-hooks 'mh-quit-hook))
-
-
-(defun mh-page-digest ()
-  "Advance displayed message to next digested message."
-  (interactive)
-  (save-excursion
-    (mh-show-message-in-other-window)
-    ;; Go to top of screen (in case user moved point).
-    (move-to-window-line 0)
-    (let ((case-fold-search nil))
-      ;; Search for blank line and then for From:
-      (mh-when (not (and (search-forward "\n\n" nil t)
-			 (search-forward "From:" nil t)))
-	(other-window -1)
-	(error "No more messages")))
-    ;; Go back to previous blank line, then forward to the first non-blank.
-    (search-backward "\n\n" nil t)
-    (forward-line 2)
-    (mh-recenter 0)
-    (other-window -1)))
-
-
-(defun mh-page-digest-backwards ()
-  "Back up displayed message to previous digested message."
-  (interactive)
-  (save-excursion
-    (mh-show-message-in-other-window)
-    ;; Go to top of screen (in case user moved point).
-    (move-to-window-line 0)
-    (let ((case-fold-search nil))
-      (beginning-of-line)
-      (mh-when (not (and (search-backward "\n\n" nil t)
-			 (search-backward "From:" nil t)))
-	(other-window -1)
-	(error "No more messages")))
-    ;; Go back to previous blank line, then forward to the first non-blank.
-    (search-backward "\n\n" nil t)
-    (forward-line 2)
-    (mh-recenter 0)
-    (other-window -1)))
-
-
-(defun mh-page-msg (&optional arg)
-  "Page the displayed message forwards.
-Scrolls ARG lines or a full screen if no argument is supplied."
-  (interactive "P")
-  (scroll-other-window arg))
-
-
-(defun mh-previous-page (&optional arg)
-  "Page the displayed message backwards.
-Scrolls ARG lines or a full screen if no argument is supplied."
-  (interactive "P")
-  (save-excursion
-    (mh-show-message-in-other-window)
-    (unwind-protect
-	(scroll-down arg)
-      (other-window -1))))
-
-
-(defun mh-previous-undeleted-msg (&optional arg)
-  "Move to previous undeleted message in window."
-  (interactive "p")
-  (setq mh-next-direction 'backward)
-  (beginning-of-line)
-  (cond ((re-search-backward mh-good-msg-regexp nil 0 arg)
-	 (mh-maybe-show))
-	(t
-	 (if (get-buffer mh-show-buffer)
-	     (delete-windows-on mh-show-buffer)))))
-
-
-(defun mh-print-msg (prefix-provided msg-or-seq)
-  "Print MESSAGE(s) (default: displayed message) on a line printer.
-If optional prefix argument provided, then prompt for the message sequence."
-  (interactive (list current-prefix-arg
-		     (if current-prefix-arg
-			 (reverse (mh-seq-to-msgs
-				   (mh-read-seq-default "Print" t)))
-			 (mh-get-msg-num t))))
-  (if prefix-provided
-      (message "Printing sequence...")
-      (message "Printing message..."))
-  (let ((print-command
-	 (if prefix-provided
-	     (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
-		     (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
-		     (expand-file-name "mhl" mh-lib)
-		     (if (stringp mhl-formfile)
-			 (format "-form %s" mhl-formfile)
-		         "")
-		     (mh-msg-filenames msg-or-seq)
-		     (format mh-lpr-command-format
-			     (if prefix-provided
-				 (format "Sequence from %s" mh-current-folder)
-				 (format "%s/%d" mh-current-folder
-					 msg-or-seq))))
-	     (format "%s -nobell -clear %s %s | %s"
-		     (expand-file-name "mhl" mh-lib)
-		     (mh-msg-filename msg-or-seq)
-		     (if (stringp mhl-formfile)
-			 (format "-form %s" mhl-formfile)
-		         "")
-		     (format mh-lpr-command-format
-			     (if prefix-provided
-				 (format "Sequence from %s" mh-current-folder)
-				 (format "%s/%d" mh-current-folder
-					 msg-or-seq)))))))
-    (if mh-print-background
-	(mh-exec-cmd-daemon shell-file-name "-c" print-command)
-	(call-process shell-file-name nil nil nil "-c" print-command))
-    (if prefix-provided
-	(mh-notate-seq msg-or-seq ?P mh-cmd-note)
-	(mh-notate msg-or-seq ?P mh-cmd-note))
-    (mh-add-msgs-to-seq msg-or-seq 'printed t)
-    (if prefix-provided
-	(message "Printing sequence...done")
-        (message "Printing message...done"))))
-
-
-(defun mh-put-msg-in-seq (prefix-provided from to)
-  "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
-If optional prefix argument provided, then prompt for the message sequence."
-  (interactive (list current-prefix-arg
-		     (if current-prefix-arg
-			 (mh-seq-to-msgs
-			   (mh-read-seq-default "Add messages from" t))
-			 (mh-get-msg-num t))
-		     (mh-read-seq-default "Add to" nil)))
-  (setq mh-previous-seq to)
-  (mh-add-msgs-to-seq from to))
-
-
-(defun mh-rescan-folder (&optional range)
-  "Rescan a folder after optionally processing the outstanding commands.
-If optional prefix argument is provided, prompt for the range of
-messages to display.  Otherwise show the entire folder."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-msg-range "Range to scan [all]? ")
-			 nil)))
-  (setq mh-next-direction 'forward)
-  (mh-scan-folder mh-current-folder (or range "all")))
-
-
-(defun mh-redistribute (to cc msg)
-  "Redistribute a letter.
-Depending on how your copy of MH was compiled, you may need to change the
-setting of the variable mh-redist-full-contents.  See its documentation."
-  (interactive (list (read-string "Redist-To: ")
-		     (read-string "Redist-Cc: ")
-		     (mh-get-msg-num t)))
-  (save-window-excursion
-    (let ((folder mh-current-folder)
-	  (draft (mh-read-draft "redistribution"
-				(if mh-redist-full-contents
-				    (mh-msg-filename msg)
-				    nil)
-				nil)))
-      (mh-goto-header-end 0)
-      (insert "Resent-To: " to "\n")
-      (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
-      (mh-clean-msg-header (point-min)
-			   "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
-			   nil)
-      (save-buffer)
-      (message "Redistributing...")
-      (if mh-redist-full-contents
-	  (call-process "/bin/sh" nil 0 nil "-c"
-			(format "mhdist=1 mhaltmsg=%s %s -push %s"
-				(buffer-file-name)
-				(expand-file-name "send" mh-progs)
-				(buffer-file-name)))
-	  (call-process "/bin/sh" nil 0 nil "-c"
-			(format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
-				(mh-msg-filename msg folder)
-				(expand-file-name "send" mh-progs)
-				(buffer-file-name))))
-      (mh-annotate-msg msg folder mh-note-dist
-		       "-component" "Resent:"
-		       "-text" (format "\"%s %s\"" to cc))
-      (kill-buffer draft)
-      (message "Redistributing...done"))))
-
-
-(defun mh-write-msg-to-file (msg file)
-  "Append MESSAGE to the end of a FILE."
-  (interactive
-   (list (mh-get-msg-num t)
-	 (let ((default-dir (if (eq 'write (car mh-last-destination))
-				(file-name-directory (cdr mh-last-destination))
-				default-directory)))
-	   (read-file-name "Save message in file: " default-dir
-			   (expand-file-name "mail.out" default-dir)))))
-  (let ((file-name (mh-msg-filename msg))
-	(output-file (mh-expand-file-name file)))
-    (setq mh-last-destination (cons 'write file))
-    (save-excursion
-      (set-buffer (get-buffer-create " *mh-temp*"))
-      (erase-buffer)
-      (insert-file-contents file-name)
-      (append-to-file (point-min) (point-max) output-file))))
-
-
-(defun mh-search-folder (folder)
-  "Search FOLDER for messages matching a pattern."
-  (interactive (list (mh-prompt-for-folder "Search"
-					   mh-current-folder
-					   t)))
-  (switch-to-buffer-other-window "pick-pattern")
-  (if (or (zerop (buffer-size))
-	  (not (y-or-n-p "Reuse pattern? ")))
-      (mh-make-pick-template)
-      (message ""))
-  (setq mh-searching-folder folder))
-
-
-(defun mh-send (to cc subject)
-  "Compose and send a letter.
-The letter is composed in mh-letter-mode; see its documentation for more
-details.  If `mh-compose-letter-function' is defined, it is called on the
-draft and passed three arguments: to, subject, and cc."
-  (interactive "sTo: \nsCc: \nsSubject: ")
-  (let ((config (current-window-configuration)))
-    (delete-other-windows)
-    (mh-send-sub to cc subject config)))
-
-
-(defun mh-send-other-window (to cc subject)
-  "Compose and send a letter in another window.."
-  (interactive "sTo: \nsCc: \nsSubject: ")
-  (let ((pop-up-windows t))
-    (mh-send-sub to cc subject (current-window-configuration))))
-
-
-(defun mh-send-sub (to cc subject config)
-  "Do the real work of composing and sending a letter.
-Expects the TO, CC, and SUBJECT fields as arguments.
-CONFIG is the window configuration before sending mail."
-  (let ((folder mh-current-folder)
-	(msg-num (mh-get-msg-num nil)))
-    (message "Composing a message...")
-    (let ((draft (mh-read-draft
-		  "message"
-		  (if (file-exists-p
-		       (expand-file-name "components" mh-user-path))
-		      (expand-file-name "components" mh-user-path)
-		      (if (file-exists-p
-			   (expand-file-name "components" mh-lib))
-			  (expand-file-name "components" mh-lib)
-			  (error "Can't find components file")))
-		  nil)))
-      (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
-      (set-buffer-modified-p nil)
-      (goto-char (point-max))
-      (message "Composing a message...done")
-      (mh-compose-and-send-mail draft "" folder msg-num
-				to subject cc
-				nil nil config))))
-
-
-(defun mh-show (&optional msg)
-  "Show MESSAGE (default: displayed message).
-Forces a two-window display with the folder window on top (size
-mh-summary-height) and the show buffer below it."
-  (interactive)
-  (if (not msg)
-      (setq msg (mh-get-msg-num t)))
-  (setq mh-showing t)
-  (mh-set-mode-name "mh-e show")
-  (if (not (eql (next-window (minibuffer-window)) (selected-window)))
-      (delete-other-windows))		; force ourself to the top window
-  (let ((folder mh-current-folder))
-    (mh-show-message-in-other-window)
-    (mh-display-msg msg folder))
-  (other-window -1)
-  (if (not (= (1+ (window-height)) (screen-height))) ;not horizontally split
-      (shrink-window (- (window-height) mh-summary-height)))
-  (mh-recenter nil)
-  (if (not (memq msg mh-seen-list)) (mh-push msg mh-seen-list)))
-
-
-(defun mh-sort-folder ()
-  "Sort the messages in the current folder by date."
-  (interactive)
-  (mh-process-or-undo-commands mh-current-folder)
-  (setq mh-next-direction 'forward)
-  (mh-set-folder-modified-p t)		; lock folder while sorting
-  (message "Sorting folder...")
-  (mh-exec-cmd "sortm" mh-current-folder)
-  (message "Sorting folder...done")
-  (mh-scan-folder mh-current-folder "all"))
-
-
-(defun mh-toggle-showing ()
-  "Toggle the scanning mode/showing mode of displaying messages."
-  (interactive)
-  (if mh-showing
-      (mh-set-scan-mode)
-      (mh-show)))
-
-
-(defun mh-undo (prefix-provided msg-or-seq)
-  "Undo the deletion or refile of the specified MESSAGE(s).
-Default is the displayed message.  If optional prefix argument is
-provided, then prompt for the message sequence."
-  (interactive (list current-prefix-arg
-		     (if current-prefix-arg
-			 (mh-read-seq-default "Undo" t)
-			 (mh-get-msg-num t))))
-  (cond (prefix-provided
-	 (mh-mapc (function mh-undo-msg) (mh-seq-to-msgs msg-or-seq)))
-	(t
-	 (let ((original-position (point)))
-	   (beginning-of-line)
-	   (while (not (or (looking-at mh-deleted-msg-regexp)
-			   (looking-at mh-refiled-msg-regexp)
-			   (and (eq mh-next-direction 'forward) (bobp))
-			   (and (eq mh-next-direction 'backward)
-				(save-excursion (forward-line) (eobp)))))
-	     (forward-line (if (eq mh-next-direction 'forward) -1 1)))
-	   (if (or (looking-at mh-deleted-msg-regexp)
-		   (looking-at mh-refiled-msg-regexp))
-	       (progn
-		 (mh-undo-msg (mh-get-msg-num t))
-		 (mh-maybe-show))
-	       (goto-char original-position)
-	       (error "Nothing to undo")))))
-  ;; update the mh-refile-list so mh-outstanding-commands-p will work
-  (mh-mapc (function
-	    (lambda (elt)
-	      (if (not (mh-seq-to-msgs elt))
-		  (setq mh-refile-list (delq elt mh-refile-list)))))
-	   mh-refile-list)
-  (if (not (mh-outstanding-commands-p))
-      (mh-set-folder-modified-p nil)))
-
-
-(defun mh-undo-msg (msg)
-  ;; Undo the deletion or refile of one MESSAGE.
-  (cond ((memq msg mh-delete-list)
-	 (setq mh-delete-list (delq msg mh-delete-list))
-	 (mh-remove-msg-from-seq msg 'deleted t))
-	(t
-	 (mh-mapc (function (lambda (dest)
-			      (mh-remove-msg-from-seq msg dest t)))
-		  mh-refile-list)))
-  (mh-notate msg ?  mh-cmd-note))
-
-
-(defun mh-undo-folder (&rest ignore)
-  "Undo all commands in current folder."
-  (interactive)
-  (cond ((or mh-do-not-confirm
-	     (yes-or-no-p "Undo all commands in folder? "))
-	 (setq mh-delete-list nil
-	       mh-refile-list nil
-	       mh-seq-list nil
-	       mh-next-direction 'forward)
-	 (with-mh-folder-updating (nil)
-	   (mh-unmark-all-headers t)))
-	(t
-	 (message "Commands not undone.")
-	 (sit-for 2))))
-
-
-(defun mh-unshar-msg (dir)
-  "Unpack the shar file contained in the current message into directory DIR."
-  (interactive (list (read-file-name "Unshar message in directory: "
-				     mh-unshar-default-directory
-				     mh-unshar-default-directory nil)))
-  (mh-display-msg (mh-get-msg-num t) mh-current-folder) ;update show buffer
-  (mh-unshar-buffer dir))
-
-(defun mh-unshar-buffer (dir)
-  ;; Unpack the shar file contained in the current buffer into directory DIR.
-  (goto-char (point-min))
-  (if (or (re-search-forward "^#![ \t]*/bin/sh" nil t)
-	  (and (re-search-forward "^[^a-z0-9\"]*cut here\b" nil t)
-	       (forward-line 1))
-	  (re-search-forward "^#" nil t)
-	  (re-search-forward "^: " nil t))
-      (let ((default-directory (expand-file-name dir))
-	    (start (progn (beginning-of-line) (point)))
-	    (log-buffer (get-buffer-create "*Unshar Output*")))
-	(save-excursion
-	  (set-buffer log-buffer)
-	  (setq default-directory (expand-file-name dir))
-	  (erase-buffer)
-	  (if (file-directory-p default-directory)
-	      (insert "cd " dir "\n")
-	    (insert "mkdir " dir "\n")
-	    (call-process "mkdir" nil log-buffer t default-directory)))
-	(set-window-start (display-buffer log-buffer) 0) ;so can watch progress
-	(call-process-region start (point-max) "sh" nil log-buffer t))
-    (error "Cannot find start of shar.")))
-	
-
-(defun mh-visit-folder (folder &optional range)
-  "Visit FOLDER and display RANGE of messages.
-Assumes mh-e has already been initialized."
-  (interactive (list (mh-prompt-for-folder "Visit" "+inbox" t)
-		     (mh-read-msg-range "Range [all]? ")))
-  (let ((config (current-window-configuration)))
-    (mh-scan-folder folder (or range "all"))
-    (setq mh-previous-window-config config))
-  nil)
-
-
-(defun mh-widen ()
-  "Remove restrictions from the current folder, thereby showing all messages."
-  (interactive)
-  (if mh-narrowed-to-seq
-      (with-mh-folder-updating (t)
-	(delete-region (point-min) (point-max))
-	(widen)
-	(mh-make-folder-mode-line)))
-  (setq mh-narrowed-to-seq nil))
-
-
-
-;;; Support routines.
-
-(defun mh-delete-a-msg (msg)
-  ;; Delete the MESSAGE.
-  (save-excursion
-    (mh-goto-msg msg nil t)
-    (if (looking-at mh-refiled-msg-regexp)
-	(error "Message %d is refiled.  Undo refile before deleting." msg))
-    (if (looking-at mh-deleted-msg-regexp)
-	nil
-	(mh-set-folder-modified-p t)
-	(mh-push msg mh-delete-list)
-	(mh-add-msgs-to-seq msg 'deleted t)
-	(mh-notate msg ?D mh-cmd-note))))
-
-
-(defun mh-refile-a-msg (msg destination)
-  ;; Refile MESSAGE in FOLDER.  FOLDER is a symbol, not a string.
-  (save-excursion
-    (mh-goto-msg msg nil t)
-    (cond ((looking-at mh-deleted-msg-regexp)
-	   (error "Message %d is deleted.  Undo delete before moving." msg))
-	  ((looking-at mh-refiled-msg-regexp)
-	   (if (y-or-n-p
-		(format "Message %d already refiled.  Copy to %s as well? "
-			msg destination))
-	       (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
-			    "-src" mh-current-folder
-			    (symbol-name destination))
-	       (message "Message not copied.")))
-	  (t
-	   (mh-set-folder-modified-p t)
-	   (if (not (memq destination mh-refile-list))
-	       (mh-push destination mh-refile-list))
-	   (if (not (memq msg (mh-seq-to-msgs destination)))
-	       (mh-add-msgs-to-seq msg destination t))
-	   (mh-notate msg ?^ mh-cmd-note)))))
-
-
-(defun mh-display-msg (msg-num folder)
-  ;; Display message NUMBER of FOLDER.
-  ;; Sets the current buffer to the show buffer.
-  (set-buffer folder)
-  ;; Bind variables in folder buffer in case they are local
-  (let ((formfile mhl-formfile)
-	(clean-message-header mh-clean-message-header)
-	(invisible-headers mh-invisible-headers)
-	(visible-headers mh-visible-headers)
-	(msg-filename (mh-msg-filename msg-num))
-	(show-buffer mh-show-buffer)
-	(folder mh-current-folder))
-    (if (not (file-exists-p msg-filename))
-	(error "Message %d does not exist" msg-num))
-    (switch-to-buffer show-buffer)
-    (if mh-bury-show-buffer (bury-buffer (current-buffer)))
-    (mh-when (not (equal msg-filename buffer-file-name))
-      ;; Buffer does not yet contain message.
-      (clear-visited-file-modtime)
-      (unlock-buffer)
-      (setq buffer-file-name nil)	; no locking during setup
-      (erase-buffer)
-      (if formfile
-	  (if (stringp formfile)
-	      (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
-				      "-form" formfile msg-filename)
-	      (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
-				      msg-filename))
-	  (insert-file-contents msg-filename))
-      (goto-char (point-min))
-      (cond (clean-message-header
-	     (mh-clean-msg-header (point-min)
-				  invisible-headers
-				  visible-headers)
-	     (goto-char (point-min)))
-	    (t
-	     (let ((case-fold-search t))
-	       (re-search-forward
-		"^To:\\|^From:\\|^Subject:\\|^Date:" nil t)
-	       (beginning-of-line)
-	       (mh-recenter 0))))
-      (set-buffer-modified-p nil)
-      (setq buffer-file-name msg-filename)
-      (set-mark nil)
-      (setq mode-line-buffer-identification
-	    (list (format mh-show-buffer-mode-line-buffer-id
-			  folder msg-num))))))
-
-
-(defun mh-invalidate-show-buffer ()
-  ;; Invalidate the show buffer so we must update it to use it.
-  (if (get-buffer mh-show-buffer)
-      (save-excursion
-	(set-buffer mh-show-buffer)
-	(setq buffer-file-name nil))))
-
-
-(defun mh-show-message-in-other-window ()
-  (switch-to-buffer-other-window mh-show-buffer)
-  (if mh-bury-show-buffer (bury-buffer (current-buffer))))
-
-
-(defun mh-clean-msg-header (start invisible-headers visible-headers)
-  ;; Flush extraneous lines in a message header, from the given POINT to the
-  ;; end of the message header.  If VISIBLE-HEADERS is non-nil, it contains a
-  ;; regular expression specifying the lines to display, otherwise
-  ;; INVISIBLE-HEADERS contains a regular expression specifying lines to
-  ;; delete from the header.
-  (let ((case-fold-search t))
-    (save-restriction
-      (goto-char start)
-      (if (search-forward "\n\n" nil t)
-	  (backward-char 1))
-      (narrow-to-region start (point))
-      (goto-char (point-min))
-      (if visible-headers
-	  (while (< (point) (point-max))
-	    (beginning-of-line)
-	    (cond ((looking-at visible-headers)
-		   (forward-line 1)
-		   (while (looking-at "^[ \t]+") (forward-line 1)))
-		  (t
-		    (mh-delete-line 1)
-		    (while (looking-at "^[ \t]+")
-		      (beginning-of-line)
-		      (mh-delete-line 1)))))
-	  (while (re-search-forward invisible-headers nil t)
-	    (beginning-of-line)
-	    (mh-delete-line 1)
-	    (while (looking-at "^[ \t]+")
-	      (beginning-of-line)
-	      (mh-delete-line 1))))
-      (unlock-buffer))))
-
-
-(defun mh-delete-line (lines)
-  ;; Delete version of kill-line.
-  (delete-region (point) (save-excursion (forward-line lines) (point))))
-
-
-(defun mh-read-draft (use initial-contents delete-contents-file)
-  ;; Read draft file into a draft buffer and make that buffer the current one.
-  ;; USE is a message used for prompting about the intended use of the message.
-  ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL
-  ;; if buffer should not be modified.  Delete the initial-contents file if
-  ;; DELETE-CONTENTS-FILE flag is set.
-  ;; Returns the draft folder's name.
-  ;; If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
-  ;; used each time and saved in the draft folder.  The draft file can then be
-  ;; reused.
-  (cond (mh-draft-folder
-	 (let ((orig-default-dir default-directory))
-	   (pop-to-buffer (find-file-noselect (mh-new-draft-name)) t)
-	   (rename-buffer (format "draft-%s" (buffer-name)))
-	   (setq default-directory orig-default-dir)))
-	(t
-	 (let ((draft-name (expand-file-name "draft" mh-user-path)))
-	   (pop-to-buffer "draft")	; Create if necessary
-	   (if (buffer-modified-p)
-	       (if (y-or-n-p "Draft has been modified; kill anyway? ")
-		   (set-buffer-modified-p nil)
-		   (error "Draft preserved")))
-	   (setq buffer-file-name draft-name)
-	   (clear-visited-file-modtime)
-	   (unlock-buffer)
-	   (mh-when (and (file-exists-p draft-name)
-			 (not (equal draft-name initial-contents)))
-	     (insert-file-contents draft-name)
-	     (delete-file draft-name)))))
-  (mh-when (and initial-contents
-		(or (zerop (buffer-size))
-		    (not (y-or-n-p
-			  (format "A draft exists.  Use for %s? " use)))))
-    (erase-buffer)
-    (insert-file-contents initial-contents)
-    (if delete-contents-file (delete-file initial-contents)))
-  (auto-save-mode 1)
-  (if mh-draft-folder
-      (save-buffer))			; Do not reuse draft name
-  (buffer-name))
-
-
-(defun mh-new-draft-name ()
-  ;; Returns the pathname of folder for draft messages.
-  (save-excursion
-    (set-buffer (get-buffer-create " *mh-temp*"))
-    (erase-buffer)
-    (mh-exec-cmd-output "mhpath" nil mh-draft-folder "new")
-    (buffer-substring (point) (1- (mark t)))))
-
-
-(defun mh-next-msg ()
-  ;; Move backward or forward to the next undeleted message in the buffer.
-  (if (eq mh-next-direction 'forward)
-      (mh-next-undeleted-msg 1)
-      (mh-previous-undeleted-msg 1)))
-
-
-(defun mh-set-scan-mode ()
-  ;; Display the scan listing buffer, but do not show a message.
-  (if (get-buffer mh-show-buffer)
-      (delete-windows-on mh-show-buffer))
-  (mh-set-mode-name "mh-e scan")
-  (setq mh-showing nil)
-  (if mh-recenter-summary-p
-      (mh-recenter nil)))
-
-
-(defun mh-maybe-show (&optional msg)
-  ;; If in showing mode, then display the message pointed to by the cursor.
-  (if mh-showing (mh-show msg)))
-
-
-(defun mh-set-mode-name (mode-name-string)
-  ;; Set the mode-name and ensure that the mode line is updated.
-  (setq mode-name mode-name-string)
-  ;; Force redisplay of all buffers' mode lines to be considered.
-  (save-excursion (set-buffer (other-buffer)))
-  (set-buffer-modified-p (buffer-modified-p)))
-
-
-
-;;; The folder data abstraction.
-
-(defvar mh-current-folder nil "Name of current folder, a string.")
-(defvar mh-show-buffer nil "Buffer that displays message for this folder.")
-(defvar mh-folder-filename nil "Full path of directory for this folder.")
-(defvar mh-showing nil "If non-nil, show the message in a separate window.")
-(defvar mh-next-seq-num nil "Index of free sequence id.")
-(defvar mh-delete-list nil "List of msg numbers to delete.")
-(defvar mh-refile-list nil "List of folder names in mh-seq-list.")
-(defvar mh-seq-list nil "Alist of (seq . msgs) numbers.")
-(defvar mh-seen-list nil "List of displayed messages.")
-(defvar mh-next-direction 'forward "Direction to move to next message.")
-(defvar mh-narrowed-to-seq nil "Sequence display is narrowed to.")
-(defvar mh-first-msg-num nil "Number of first msg in buffer.")
-(defvar mh-last-msg-num nil "Number of last msg in buffer.")
-
-
-(defun mh-make-folder (name)
-  ;; Create and initialize a new mail folder called NAME and make it the
-  ;; current folder.
-  (switch-to-buffer name)
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  (setq buffer-read-only t)
-  (mh-folder-mode)
-  (mh-set-folder-modified-p nil)
-  (setq buffer-file-name mh-folder-filename)
-  (mh-set-mode-name "mh-e scan"))
-
-
-;;; Don't use this mode when creating buffers if default-major-mode is nil.
-(put 'mh-folder-mode 'mode-class 'special)
-
-(defun mh-folder-mode ()
-  "Major mode for \"editing\" an MH folder scan listing.
-Messages can be marked for refiling and deletion.  However, both actions
-are deferred until you request execution with \\[mh-execute-commands].
-\\{mh-folder-mode-map}
-  A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
-applies the action to a message sequence.
-
-Variables controlling mh-e operation are (defaults in parentheses):
-
- mh-bury-show-buffer (t)
-    Non-nil means that the buffer used to display message is buried.
-    It will never be offered as the default other buffer.
-
- mh-clean-message-header (nil)
-    Non-nil means remove header lines matching the regular expression
-    specified in mh-invisible-headers from messages.
-
- mh-visible-headers (nil)
-    If non-nil, it contains a regexp specifying the headers that are shown in
-    a message if mh-clean-message-header is non-nil.  Setting this variable
-    overrides mh-invisible-headers.
-
- mh-do-not-confirm (nil)
-    Non-nil means do not prompt for confirmation before executing some
-    non-recoverable commands such as mh-kill-folder and mh-undo-folder.
-
- mhl-formfile (nil)
-    Name of format file to be used by mhl to show messages.
-    A value of T means use the default format file.
-    Nil means don't use mhl to format messages.
-
- mh-lpr-command-format (\"lpr -p -J '%s'\")
-    Format for command used to print a message on a system printer.
-
- mh-recenter-summary-p (nil)
-    If non-nil, then the scan listing is recentered when the window displaying
-    a messages is toggled off.
-
- mh-summary-height (4)
-    Number of lines in the summary window including the mode line.
-
- mh-ins-buf-prefix (\"> \")
-    String to insert before each non-blank line of a message as it is
-    inserted in a draft letter.
-
-The value of mh-folder-mode-hook is called when a new folder is set up."
-
-  (kill-all-local-variables)
-  (use-local-map mh-folder-mode-map)
-  (setq major-mode 'mh-folder-mode)
-  (mh-set-mode-name "mh-e folder")
-  (make-local-vars
-   'mh-current-folder (buffer-name)	; Name of folder, a string
-   'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
-   'mh-folder-filename			; e.g. "/usr/foobar/Mail/inbox/"
-   (file-name-as-directory (mh-expand-file-name (buffer-name)))
-   'mh-showing nil			; Show message also?
-   'mh-next-seq-num 0			; Index of free sequence id
-   'mh-delete-list nil			; List of msgs nums to delete
-   'mh-refile-list nil			; List of folder names in mh-seq-list
-   'mh-seq-list nil			; Alist of (seq . msgs) nums
-   'mh-seen-list nil			; List of displayed messages
-   'mh-next-direction 'forward		; Direction to move to next message
-   'mh-narrowed-to-seq nil		; Sequence display is narrowed to
-   'mh-first-msg-num nil		; Number of first msg in buffer
-   'mh-last-msg-num nil			; Number of last msg in buffer
-   'mh-previous-window-config nil)	; Previous window configuration
-  (setq truncate-lines t)
-  (auto-save-mode -1)
-  (setq buffer-offer-save t)
-  (make-local-variable 'write-file-hooks)
-  (setq write-file-hooks '(mh-execute-commands))
-  (make-local-variable 'revert-buffer-function)
-  (setq revert-buffer-function 'mh-undo-folder)
-  (run-hooks 'mh-folder-mode-hook))
-
-
-(defun make-local-vars (&rest pairs)
-  ;; Take VARIABLE-VALUE pairs and makes local variables initialized to the
-  ;; value.
-  (while pairs
-    (make-variable-buffer-local (car pairs))
-    (set (car pairs) (car (cdr pairs)))
-    (setq pairs (cdr (cdr pairs)))))
-
-
-(defun mh-scan-folder (folder range)
-  ;; Scan the FOLDER over the RANGE.  Return in the folder's buffer.
-  (cond ((null (get-buffer folder))
-	 (mh-make-folder folder))
-	(t
-	 (mh-process-or-undo-commands folder)
-	 (switch-to-buffer folder)))
-  (mh-regenerate-headers range)
-  (mh-when (zerop (buffer-size))
-    (if (equal range "all")
-	(message "Folder %s is empty" folder)
-	(message "No messages in %s, range %s" folder range))
-    (sit-for 5))
-  (mh-goto-cur-msg))
-
-
-(defun mh-regenerate-headers (range)
-  ;; Replace buffer with scan of its contents over range RANGE.
-  (let ((folder mh-current-folder))
-    (message "Scanning %s..." folder)
-    (with-mh-folder-updating (nil)
-      (erase-buffer)
-      (mh-exec-cmd-output "scan" nil
-			  "-noclear" "-noheader"
-			  "-width" (window-width)
-			  folder range)
-      (goto-char (point-min))
-      (cond ((looking-at "scan: no messages in")
-	     (keep-lines mh-valid-scan-line)) ; Flush random scan lines
-	    ((looking-at "scan: "))	; Keep error messages
-	    (t
-	     (keep-lines mh-valid-scan-line))) ; Flush random scan lines
-      (mh-delete-seq-locally 'cur)	; To pick up new one
-      (setq mh-seq-list (mh-read-folder-sequences folder nil))
-      (mh-notate-user-sequences)
-      (mh-make-folder-mode-line (if (equal range "all")
-				    nil
-				    mh-partial-folder-mode-line-annotation)))
-    (message "Scanning %s...done" folder)))
-
-
-(defun mh-get-new-mail (maildrop-name)
-  ;; Read new mail from a maildrop into the current buffer.
-  ;; Return T if there was new mail, NIL otherwise.  Return in the current
-  ;; buffer.
-  (let ((point-before-inc (point))
-	(folder mh-current-folder)
-	(return-value t))
-    (with-mh-folder-updating (t)
-      (message (if maildrop-name
-		   (format "inc %s -file %s..." folder maildrop-name)
-		   (format "inc %s..." folder)))
-      (mh-unmark-all-headers nil)
-      (setq mh-next-direction 'forward)
-      (goto-char (point-max))
-      (let ((start-of-inc (point)))
-	(if maildrop-name
-	    (mh-exec-cmd-output "inc" nil folder
-				"-file" (expand-file-name maildrop-name)
-				"-width" (window-width)
-				"-truncate")
-	    (mh-exec-cmd-output "inc" nil
-				"-width" (window-width)))
-	(message
-	 (if maildrop-name
-	     (format "inc %s -file %s...done" folder maildrop-name)
-	     (format "inc %s...done" folder)))
-	(goto-char start-of-inc)
-	(cond ((looking-at "inc: no mail")
-	       (keep-lines mh-valid-scan-line) ; Flush random scan lines
-	       (goto-char point-before-inc)
-	       (message "No new mail%s%s" (if maildrop-name " in " "")
-			(if maildrop-name maildrop-name "")))
-	      ((re-search-forward "^inc:" nil t) ; Error messages
-	       (error "inc error"))
-	      (t
-	       (mh-delete-seq-locally 'cur) ; To pick up new one
-	       (setq mh-seq-list (mh-read-folder-sequences folder t))
-	       (mh-notate-user-sequences)
-	       (keep-lines mh-valid-scan-line)
-	       (mh-make-folder-mode-line)
-	       (mh-goto-cur-msg)
-	       (setq return-value t))))
-      return-value)))
-
-
-(defun mh-make-folder-mode-line (&optional annotation)
-  ;; Set the fields of the mode line for a folder buffer.
-  ;; The optional ANNOTATION string is displayed after the folder's name.
-  (save-excursion
-    (mh-first-msg)
-    (setq mh-first-msg-num (mh-get-msg-num nil))
-    (mh-last-msg)
-    (setq mh-last-msg-num (mh-get-msg-num nil))
-    (let ((lines (count-lines (point-min) (point-max))))
-      (setq mode-line-buffer-identification
-	    (list (format "{%%b%s}  %d msg%s"
-			  (if annotation (format "/%s" annotation) "")
-			  lines
-			  (if (zerop lines)
-			      "s"
-			      (if (> lines 1)
-				  (format "s (%d-%d)" mh-first-msg-num
-					  mh-last-msg-num)
-				  (format " (%d)" mh-first-msg-num)))))))))
-
-
-(defun mh-unmark-all-headers (remove-all-flags)
-  ;; Remove all '+' flags from the headers, and if called with a non-nil
-  ;; argument, remove all 'D', '^' and '%' flags too.
-  ;; Optimized for speed (i.e., no regular expressions).
-  (save-excursion
-    (let ((case-fold-search nil)
-	  (last-line (- (point-max) mh-cmd-note))
-	  char)
-      (mh-first-msg)
-      (while (<= (point) last-line)
-	(forward-char mh-cmd-note)
-	(setq char (following-char))
-	(if (or (and remove-all-flags
-		     (or (eql char ?D)
-			 (eql char ?^)
-			 (eql char ?%)))
-		(eql char ?+))
-	    (progn
-	      (delete-char 1)
-	      (insert " ")))
-	(forward-line)))))
-
-
-(defun mh-goto-cur-msg ()
-  ;; Position the cursor at the current message.
-  (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
-    (cond ((and cur-msg
-		(mh-goto-msg cur-msg t nil))
-	   (mh-notate nil ?+ mh-cmd-note)
-	   (mh-recenter 0)
-	   (mh-maybe-show cur-msg))
-	  (t
-	   (mh-last-msg)
-	   (message "No current message")))))
-
-
-(defun mh-pack-folder-1 (range)
-  ;; Close and pack the current folder.
-  (mh-process-or-undo-commands mh-current-folder)
-  (message "Packing folder...")
-  (mh-set-folder-modified-p t)		; lock folder while packing
-  (save-excursion
-    (mh-exec-cmd-quiet " *mh-temp*" "folder" mh-current-folder "-pack"))
-  (mh-regenerate-headers range))
-
-
-(defun mh-process-or-undo-commands (folder)
-  ;; If FOLDER has outstanding commands, then either process or discard them.
-  (set-buffer folder)
-  (if (mh-outstanding-commands-p)
-      (if (or mh-do-not-confirm
-	      (y-or-n-p
-		"Process outstanding deletes and refiles (or lose them)? "))
-	  (mh-process-commands folder)
-	  (mh-undo-folder))
-      (mh-invalidate-show-buffer)))
-
-
-(defun mh-process-commands (folder)
-  ;; Process outstanding commands for the folder FOLDER.
-  (message "Processing deletes and refiles for %s..." folder)
-  (set-buffer folder)
-  (with-mh-folder-updating (nil)
-    ;; Update the unseen sequence if it exists
-    (if (and mh-seen-list (mh-seq-to-msgs mh-unseen-seq))
-	(mh-undefine-sequence mh-unseen-seq mh-seen-list))
-
-    ;; Then refile messages
-    (mh-mapc
-     (function
-      (lambda (dest)
-	(let ((msgs (mh-seq-to-msgs dest)))
-	  (mh-when msgs
-	    (apply 'mh-exec-cmd "refile"
-		   "-src" folder (symbol-name dest) msgs)
-	    (mh-delete-scan-msgs msgs)))))
-     mh-refile-list)
-
-    ;; Now delete messages
-    (mh-when mh-delete-list
-      (apply 'mh-exec-cmd "rmm" folder mh-delete-list)
-      (mh-delete-scan-msgs mh-delete-list))
-
-    ;; Don't need to remove sequences since delete and refile do so.
-
-    ;; Mark cur message
-    (if (> (buffer-size) 0)
-	(mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
-
-    (mh-invalidate-show-buffer)
-
-    (setq mh-delete-list nil
-	  mh-refile-list nil
-	  mh-seq-list (mh-read-folder-sequences mh-current-folder nil)
-	  mh-seen-list nil)
-    (mh-unmark-all-headers t)
-    (mh-notate-user-sequences)
-    (message "Processing deletes and refiles for %s...done" folder)))
-
-
-(defun mh-delete-scan-msgs (msgs)
-  ;; Delete the scan listing lines for each of the msgs in the LIST.
-  ;; Optimized for speed (i.e., no regular expressions).
-  (setq msgs (sort msgs (function <)))	;okay to clobber msgs
-  (save-excursion
-    (mh-first-msg)
-    (while (and msgs (< (point) (point-max)))
-      (cond ((equal (mh-get-msg-num nil) (car msgs))
-	     (delete-region (point) (save-excursion (forward-line) (point)))
-	     (setq msgs (cdr msgs)))
-	    (t
-	     (forward-line))))))
-
-
-(defun mh-set-folder-modified-p (flag)
-  "Mark current folder as modified or unmodified according to FLAG."
-  (set-buffer-modified-p flag))
-
-
-(defun mh-outstanding-commands-p ()
-  ;; Returns non-nil if there are outstanding deletes or refiles.
-  (or mh-delete-list mh-refile-list))
-
-
-
-;;; Mode for composing and sending a draft message.
-
-(defvar mh-sent-from-folder nil
-  "Folder of msg associated with this letter.")
-
-(defvar mh-sent-from-msg nil
-  "Number of msg associated with this letter.")
-
-(defvar mh-send-args nil
-  "Extra arguments to pass to \"send\" command.")
-
-(defvar mh-annotate-char nil
-  "Character to use to annotate mh-sent-from-msg.")
-
-(defvar mh-annotate-field nil
-  "Field name for message annotation.")
-
-(defun mh-letter-mode ()
-  "Mode for composing letters in mh-e.
-When you have finished composing, type \\[mh-send-letter] to send the letter.
-
-Variables controlling this mode (defaults in parentheses):
-
- mh-delete-yanked-msg-window (nil)
-    If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying
-    the yanked message.
-
- mh-yank-from-start-of-msg (t)
-    If non-nil, \\[mh-yank-cur-msg] will include the entire message.
-    If `body', just yank the body (no header).
-    If nil, only the portion of the message following the point will be yanked.
-    If there is a region, this variable is ignored.
-
- mh-signature-file-name (\"~/.signature\")
-    File to be inserted into message by \\[mh-insert-signature].
-
-Upon invoking mh-letter-mode, text-mode-hook and mh-letter-mode-hook are
-invoked with no args, if those values are non-nil.
-
-\\{mh-letter-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate
-	(concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate))
-  (make-local-variable 'mh-send-args)
-  (make-local-variable 'mh-annotate-char)
-  (make-local-variable 'mh-annotate-field)
-  (make-local-variable 'mh-previous-window-config)
-  (make-local-variable 'mh-sent-from-folder)
-  (make-local-variable 'mh-sent-from-msg)
-  (use-local-map mh-letter-mode-map)
-  (setq major-mode 'mh-letter-mode)
-  (mh-set-mode-name "mh-e letter")
-  (set-syntax-table mh-letter-mode-syntax-table)
-  (run-hooks 'text-mode-hook 'mh-letter-mode-hook)
-  (mh-when (and (boundp 'auto-fill-hook) auto-fill-hook) ;emacs 18
-    (make-local-variable 'auto-fill-hook)
-    (setq auto-fill-hook 'mh-auto-fill-for-letter))
-  (mh-when (and (boundp 'auto-fill-function) auto-fill-function) ;emacs 19
-    (make-local-variable 'auto-fill-function)
-    (setq auto-fill-function 'mh-auto-fill-for-letter)))
-
-
-(defun mh-auto-fill-for-letter ()
-  ;; Auto-fill in letters treats the header specially by inserting a tab
-  ;; before continuation line.
-  (do-auto-fill)
-  (if (mh-in-header-p)
-      (save-excursion
-	(beginning-of-line nil)
-	(insert-char ?\t 1))))
-
-
-(defun mh-in-header-p ()
-  ;; Return non-nil if the point is in the header of a draft message.
-  (save-excursion
-    (let ((cur-point (point)))
-      (goto-char (point-min))
-      (re-search-forward "^--------" nil t)
-      (< cur-point (point)))))
-
-
-(defun mh-to-field ()
-  "Move point to the end of a specified header field.
-The field is indicated by the previous keystroke.  Create the field if
-it does not exist.  Set the mark to point before moving."
-  (interactive)
-  (expand-abbrev)
-  (let ((target (cdr (assoc (logior last-input-char ?`) mh-to-field-choices)))
-	(case-fold-search t))
-    (cond ((mh-position-on-field target t)
-	   (let ((eol (point)))
-	     (skip-chars-backward " \t")
-	     (delete-region (point) eol))
-	   (if (and (not (eq (logior last-input-char ?`) ?s))
-		    (save-excursion
-		      (backward-char 1)
-		      (not (looking-at "[:,]"))))
-	       (insert ", ")
-	       (insert " ")))
-	  (t
-	   (goto-char (point-min))
-	   (re-search-forward "^To:")
-	   (forward-line 1)
-	   (while (looking-at "^[ \t]") (forward-line 1))
-	   (insert (format "%s \n" target))
-	   (backward-char 1)))))
-
-
-(defun mh-to-fcc ()
-  "Insert an Fcc: field in the current message.
-Prompt for the field name with a completion list of the current folders."
-  (interactive)
-  (let ((last-input-char ?\C-f)
-        (folder (mh-prompt-for-folder "Fcc" "" t)))
-    (expand-abbrev)
-    (save-excursion
-      (mh-to-field)
-      (insert (substring folder 1 nil)))))
-
-
-(defun mh-insert-signature ()
-  "Insert the file named by mh-signature-file-name at the current point."
-  (interactive)
-  (insert-file-contents mh-signature-file-name)
-  (set-buffer-modified-p (buffer-modified-p))) ; force mode line update
-
-
-(defun mh-check-whom ()
-  "Verify recipients of the current letter."
-  (interactive)
-  (let ((file-name (buffer-file-name)))
-    (set-buffer-modified-p t)		; Force writing of contents
-    (save-buffer)
-    (message "Checking recipients...")
-    (switch-to-buffer-other-window "*Mail Recipients*")
-    (bury-buffer (current-buffer))
-    (erase-buffer)
-    (mh-exec-cmd-output "whom" t file-name)
-    (other-window -1)
-    (message "Checking recipients...done")))
-
-
-
-;;; Routines to make a search pattern and search for a message.
-
-(defvar mh-searching-folder nil "Folder this pick is searching.")
-
-
-(defun mh-make-pick-template ()
-  ;; Initialize the current buffer with a template for a pick pattern.
-  (erase-buffer)
-  (kill-all-local-variables)
-  (make-local-variable 'mh-searching-folder)
-  (insert "From: \n"
-	  "To: \n"
-	  "Cc: \n"
-	  "Date: \n"
-	  "Subject: \n"
-	  "---------\n")
-  (mh-letter-mode)
-  (use-local-map mh-pick-mode-map)
-  (goto-char (point-min))
-  (end-of-line))
-
-
-(defun mh-do-pick-search ()
-  "Find messages that match the qualifications in the current pattern buffer.
-Messages are searched for in the folder named in mh-searching-folder.
-Put messages found in a sequence named `search'."
-  (interactive)
-  (let ((pattern-buffer (buffer-name))
-	(searching-buffer mh-searching-folder)
-	range msgs
-	(pattern nil)
-	(new-buffer nil))
-    (save-excursion
-      (cond ((get-buffer searching-buffer)
-	     (set-buffer searching-buffer)
-	     (setq range (format "%d-%d" mh-first-msg-num mh-last-msg-num)))
-	    (t
-	     (mh-make-folder searching-buffer)
-	     (setq range "all")
-	     (setq new-buffer t))))
-    (message "Searching...")
-    (goto-char (point-min))
-    (while (setq pattern (mh-next-pick-field pattern-buffer))
-      (setq msgs (mh-seq-from-command searching-buffer
-				      'search
-				      (nconc (cons "pick" pattern)
-					     (list searching-buffer
-						   range
-						   "-sequence" "search"
-						   "-list"))))
-      (setq range "search"))
-    (message "Searching...done")
-    (if new-buffer
-	(mh-scan-folder searching-buffer msgs)
-	(switch-to-buffer searching-buffer))
-    (delete-other-windows)
-    (mh-notate-seq 'search ?% (1+ mh-cmd-note))))
-
-
-(defun mh-next-pick-field (buffer)
-  ;; Return the next piece of a pick argument that can be extracted from the
-  ;; BUFFER.  Returns nil if no pieces remain.
-  (set-buffer buffer)
-  (let ((case-fold-search t))
-    (cond ((eobp)
-	   nil)
-	  ((re-search-forward "^\\([a-z].*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
-	   (let* ((component
-		   (format "--%s"
-			   (downcase (buffer-substring (match-beginning 1)
-						       (match-end 1)))))
-		  (pat (buffer-substring (match-beginning 2) (match-end 2))))
-	       (forward-line 1)
-	       (list component pat)))
-	  ((re-search-forward "^-*$" nil t)
-	   (forward-char 1)
-	   (let ((body (buffer-substring (point) (point-max))))
-	     (if (and (> (length body) 0) (not (equal body "\n")))
-		 (list "-search" body)
-		 nil)))
-	  (t
-	   nil))))
-
-
-
-;;; Routines to compose and send a letter.
-
-(defun mh-compose-and-send-mail (draft send-args
-				       sent-from-folder sent-from-msg
-				       to subject cc
-				       annotate-char annotate-field
-				       config)
-  ;; Edit and compose a draft message in buffer DRAFT and send or save it.
-  ;; SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
-  ;; nil if none exists.
-  ;; SENT-FROM-MSG is the message number or sequence name or nil.
-  ;; SEND-ARGS is an optional argument passed to the send command.
-  ;; The TO, SUBJECT, and CC fields are passed to the
-  ;; mh-compose-letter-function.
-  ;; If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
-  ;; message.  In that case, the ANNOTATE-FIELD is used to build a string
-  ;; for mh-annotate-msg.
-  ;; CONFIG is the window configuration to restore after sending the letter.
-  (pop-to-buffer draft)
-  (mh-letter-mode)
-  (setq mh-sent-from-folder sent-from-folder)
-  (setq mh-sent-from-msg sent-from-msg)
-  (setq mh-send-args send-args)
-  (setq mh-annotate-char annotate-char)
-  (setq mh-annotate-field annotate-field)
-  (setq mh-previous-window-config config)
-  (setq mode-line-buffer-identification (list "{%b}"))
-  (if (and (boundp 'mh-compose-letter-function)
-	   (symbol-value 'mh-compose-letter-function))
-      ;; run-hooks will not pass arguments.
-      (let ((value (symbol-value 'mh-compose-letter-function)))
-	(if (and (listp value) (not (eq (car value) 'lambda)))
-	    (while value
-	      (funcall (car value) to subject cc)
-	      (setq value (cdr value)))
-	    (funcall mh-compose-letter-function to subject cc)))))
-
-
-(defun mh-send-letter (&optional arg)
-  "Send the draft letter in the current buffer.
-If optional prefix argument is provided, monitor delivery.
-Run mh-before-send-letter-hook before doing anything."
-  (interactive "P")
-  (run-hooks 'mh-before-send-letter-hook)
-  (set-buffer-modified-p t)		; Make sure buffer is written
-  (save-buffer)
-  (message "Sending...")
-  (let ((draft-buffer (current-buffer))
-	(file-name (buffer-file-name))
-	(config mh-previous-window-config))
-    (cond (arg
-	   (pop-to-buffer "MH mail delivery")
-	   (erase-buffer)
-	   (if mh-send-args
-	       (mh-exec-cmd-output "send" t "-watch" "-nopush"
-				   "-nodraftfolder" mh-send-args file-name)
-	       (mh-exec-cmd-output "send" t "-watch" "-nopush"
-				   "-nodraftfolder" file-name))
-	   (goto-char (point-max))	; show the interesting part
-	   (recenter -1)
-	   (set-buffer draft-buffer))	; for annotation below
-	  (mh-send-args
-	   (mh-exec-cmd-daemon "send" "-nodraftfolder" "-noverbose"
-			       mh-send-args file-name))
-	  (t
-	   (mh-exec-cmd-daemon "send" "-nodraftfolder" "-noverbose"
-			       file-name)))
-
-    (if mh-annotate-char
-	(mh-annotate-msg mh-sent-from-msg
-			 mh-sent-from-folder
-			 mh-annotate-char
-			 "-component" mh-annotate-field
-			 "-text" (format "\"%s %s\""
-					 (mh-get-field "To:")
-					 (mh-get-field "Cc:"))))
-
-    (mh-when (or (not arg)
-		 (y-or-n-p "Kill draft buffer? "))
-      (kill-buffer draft-buffer)
-      (if config
-	  (set-window-configuration config)))
-    (message "Sending...done")))
-
-
-(defun mh-insert-letter (prefix-provided folder msg)
-  "Insert a message from any folder into the current letter.
-Removes the message's headers using mh-invisible-headers.
-Prefixes each non-blank line with mh-ins-buf-prefix (default \">> \").
-If optional prefix argument provided, do not indent and do not delete
-headers.  Leaves the mark before the letter and point after it."
-  (interactive
-   (list current-prefix-arg
-	 (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
-	 (read-input (format "Message number%s: "
-			     (if mh-sent-from-msg
-				 (format " [%d]" mh-sent-from-msg)
-				 "")))))
-  (save-restriction
-    (narrow-to-region (point) (point))
-    (let ((start (point-min)))
-      (if (equal msg "") (setq msg (int-to-string mh-sent-from-msg)))
-      (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
-			      (expand-file-name msg
-						(mh-expand-file-name folder)))
-      (mh-when (not prefix-provided)
-	(mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
-	(set-mark start)		; since mh-clean-msg-header moves it
-	(mh-insert-prefix-string mh-ins-buf-prefix)))))
-
-
-(defun mh-yank-cur-msg ()
-  "Insert the current message into the draft buffer.
-Prefix each non-blank line in the message with the string in
-`mh-ins-buf-prefix'.  If a region is set in the message's buffer, then
-only the region will be inserted.  Otherwise, the entire message will
-be inserted if `mh-yank-from-start-of-msg' is non-nil.  If this variable
-is nil, the portion of the message following the point will be yanked.
-If `mh-delete-yanked-msg-window' is non-nil, any window displaying the
-yanked message will be deleted."
-  (interactive)
-  (if (and mh-sent-from-folder mh-sent-from-msg)
-      (let ((to-point (point))
-	    (to-buffer (current-buffer)))
-	(set-buffer mh-sent-from-folder)
-	(if mh-delete-yanked-msg-window
-	    (delete-windows-on mh-show-buffer))
-	(set-buffer mh-show-buffer)	; Find displayed message
-	(let ((mh-ins-str (cond (mark-active
-				 (buffer-substring (region-beginning)
-						   (region-end)))
-				((eq 'body mh-yank-from-start-of-msg)
-				 (buffer-substring
-				  (save-excursion
-				    (goto-char (point-min))
-				    (mh-goto-header-end 1)
-				    (point))
-				  (point-max)))
-				(mh-yank-from-start-of-msg
-				 (buffer-substring (point-min) (point-max)))
-				(t
-				 (buffer-substring (point) (point-max))))))
-	  (set-buffer to-buffer)
-	  (narrow-to-region to-point to-point)
-	  (push-mark)
-	  (insert mh-ins-str)
-	  (mh-insert-prefix-string mh-ins-buf-prefix)
-	  (insert "\n")
-	  (widen)))
-      (error "There is no current message")))
-
-
-(defun mh-insert-prefix-string (mh-ins-string)
-  ;; Run MH-YANK-HOOK to insert a prefix string before each line in the buffer.
-  ;; Generality for supercite users.
-  (save-excursion
-    (set-mark (point-max))
-    (goto-char (point-min))
-    (run-hooks 'mh-yank-hooks)))
-
-
-(defun mh-fully-kill-draft ()
-  "Kill the draft message file and the draft message buffer.
-Use \\[kill-buffer] if you don't want to delete the draft message file."
-  (interactive)
-  (if (y-or-n-p "Kill draft message? ")
-      (let ((config mh-previous-window-config))
-	(if (file-exists-p (buffer-file-name))
-	    (delete-file (buffer-file-name)))
-	(set-buffer-modified-p nil)
-	(kill-buffer (buffer-name))
-	(message "")
-	(if config
-	    (set-window-configuration config)))
-    (error "Message not killed")))
-
-
-(defun mh-recenter (arg)
-  ;; Like recenter but with two improvements: nil arg means recenter,
-  ;; and only does anything if the current buffer is in the selected
-  ;; window.  (Commands like save-some-buffers can make this false.)
-  (if (eql (get-buffer-window (current-buffer))
-	   (selected-window))
-      (recenter (if arg arg '(t)))))
-
-
-
-;;; Commands to manipulate sequences.  Sequences are stored in an alist
-;;; of the form:
-;;;	((seq-name msgs ...) (seq-name msgs ...) ...)
-
-(defun mh-make-seq (name msgs) (cons name msgs))
-
-(defmacro mh-seq-name (pair) (list 'car pair))
-
-(defmacro mh-seq-msgs (pair) (list 'cdr pair))
-
-(defun mh-find-seq (name) (assoc name mh-seq-list))
-
-
-(defun mh-seq-to-msgs (seq)
-  "Return a list of the messages in SEQUENCE."
-  (mh-seq-msgs (mh-find-seq seq)))
-
-
-(defun mh-seq-containing-msg (msg)
-  ;; Return a list of the sequences containing MESSAGE.
-  (let ((l mh-seq-list)
-	(seqs ()))
-    (while l
-      (if (memq msg (mh-seq-msgs (car l)))
-	  (mh-push (mh-seq-name (car l)) seqs))
-      (setq l (cdr l)))
-    seqs))
-
-
-(defun mh-msg-to-seq (msg)
-  ;; Given a MESSAGE number, return the first sequence in which it occurs.
-  (car (mh-seq-containing-msg msg)))
-
-
-(defun mh-read-seq-default (prompt not-empty)
-  ;; Read and return sequence name with default narrowed or previous sequence.
-  (mh-read-seq prompt not-empty (or mh-narrowed-to-seq mh-previous-seq)))
-
-
-(defun mh-read-seq (prompt not-empty &optional default)
-  ;; Read and return a sequence name.  Prompt with PROMPT, raise an error
-  ;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply
-  ;; an optional DEFAULT sequence.
-  ;; A reply of '%' defaults to the first sequence containing the current
-  ;; message.
-  (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
-					 (if default
-					     (format "[%s] " default)
-					     ""))
-				 (mh-seq-names mh-seq-list)))
-	 (seq (cond ((equal input "%") (mh-msg-to-seq (mh-get-msg-num t)))
-		    ((equal input "") default)
-		    (t (intern input))))
-	 (msgs (mh-seq-to-msgs seq)))
-    (if (and (null msgs) not-empty)
-	(error (format "No messages in sequence `%s'" seq)))
-    seq))
-
-
-(defun mh-read-folder-sequences (folder define-sequences)
-  ;; Read and return the predefined sequences for a FOLDER.  If
-  ;; DEFINE-SEQUENCES is non-nil, then define mh-e's sequences before
-  ;; reading MH's sequences.
-  (let ((seqs ()))
-    (mh-when define-sequences
-      (mh-define-sequences mh-seq-list)
-      (mh-mapc (function (lambda (seq)	; Save the internal sequences
-			   (if (mh-folder-name-p (mh-seq-name seq))
-			       (mh-push seq seqs))))
-	       mh-seq-list))
-    (save-excursion
-      (mh-exec-cmd-quiet " *mh-temp*" "mark" folder "-list")
-      (goto-char (point-min))
-      ;; look for name in line of form "cur: 4" or "myseq (private): 23"
-      (while (re-search-forward "^[^: ]+" nil t)
-	(mh-push (mh-make-seq (intern (buffer-substring (match-beginning 0)
-							(match-end 0)))
-			      (mh-read-msg-list))
-		 seqs))
-      (delete-region (point-min) (point))) ; avoid race with mh-process-daemon
-    seqs))
-
-
-(defun mh-seq-names (seq-list)
-  ;; Return an alist containing the names of the SEQUENCES.
-  (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry)))))
-	  seq-list))
-
-
-(defun mh-seq-from-command (folder seq seq-command)
-  ;; In FOLDER, make a sequence named SEQ by executing COMMAND.
-  ;; COMMAND is a list.  The first element is a program name
-  ;; and the subsequent elements are its arguments, all strings.
-  (let ((msg)
-	(msgs ())
-	(case-fold-search t))
-    (save-excursion
-      (save-window-excursion
-	(apply 'mh-exec-cmd-quiet " *mh-temp*" seq-command)
-	(goto-char (point-min))
-	(while (setq msg (car (mh-read-msg-list)))
-	  (mh-push msg msgs)
-	  (forward-line 1)))
-      (set-buffer folder)
-      (setq msgs (nreverse msgs))	; Put in ascending order
-      (mh-push (mh-make-seq seq msgs) mh-seq-list)
-      msgs)))
-
-
-(defun mh-read-msg-list ()
-  ;; Return a list of message numbers from the current point to the end of
-  ;; the line.
-  (let ((msgs ())
-	(end-of-line (save-excursion (end-of-line) (point)))
-	num)
-    (while (re-search-forward "[0-9]+" end-of-line t)
-      (setq num (string-to-int (buffer-substring (match-beginning 0)
-						 (match-end 0))))
-      (cond ((looking-at "-")		; Message range
-	     (forward-char 1)
-	     (re-search-forward "[0-9]+" end-of-line t)
-	     (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
-							  (match-end 0)))))
-	       (if (< num2 num)
-		   (error "Bad message range: %d-%d" num num2))
-	       (while (<= num num2)
-		 (mh-push num msgs)
-		 (setq num (1+ num)))))
-	    ((not (zerop num)) (mh-push num msgs))))
-    msgs))
-
-
-(defun mh-remove-seq (seq)
-  ;; Delete the SEQUENCE.
-  (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq seq ?  (1+ mh-cmd-note) seq)
-  (mh-undefine-sequence seq (list "all"))
-  (mh-delete-seq-locally seq))
-
-
-(defun mh-delete-seq-locally (seq)
-  ;; Remove mh-e's record of SEQUENCE.
-  (let ((entry (mh-find-seq seq)))
-    (setq mh-seq-list (delq entry mh-seq-list))))
-
-
-(defun mh-remove-msg-from-seq (msg seq &optional internal-flag)
-  ;; Remove MESSAGE from the SEQUENCE.  If optional FLAG is non-nil, do not
-  ;; inform MH of the change.
-  (let ((entry (mh-find-seq seq)))
-    (mh-when entry
-      (mh-notate-if-in-one-seq msg ?  (1+ mh-cmd-note) (mh-seq-name entry))
-      (if (not internal-flag)
-	  (mh-undefine-sequence seq (list msg)))
-      (setcdr entry (delq msg (mh-seq-msgs entry))))))
-
-
-(defun mh-add-msgs-to-seq (msgs seq &optional internal-flag)
-  ;; Add MESSAGE(s) to the SEQUENCE.  If optional FLAG is non-nil, do not mark
-  ;; the message in the scan listing or inform MH of the addition.
-  (let ((entry (mh-find-seq seq)))
-    (if (and msgs (atom msgs)) (setq msgs (list msgs)))
-    (if (null entry)
-	(mh-push (mh-make-seq seq msgs) mh-seq-list)
-	(if msgs (setcdr entry (append msgs (cdr entry)))))
-    (mh-when (not internal-flag)
-      (mh-add-to-sequence seq msgs)
-      (mh-notate-seq seq ?% (1+ mh-cmd-note)))))
-
-
-(defun mh-rename-seq (seq new-name)
-  "Rename a SEQUENCE to have a new NAME."
-  (interactive "SOld sequence name: \nSNew name: ")
-  (let ((old-seq (mh-find-seq seq)))
-    (if old-seq
-	(rplaca old-seq new-name)
-	(error "Sequence %s does not exists" seq))
-    (mh-undefine-sequence seq (mh-seq-msgs old-seq))
-    (mh-define-sequence new-name (mh-seq-msgs old-seq))))
-
-
-(defun mh-notate-user-sequences ()
-  ;; Mark the scan listing of all messages in user-defined sequences.
-  (let ((seqs mh-seq-list)
-	name)
-    (while seqs
-      (setq name (mh-seq-name (car seqs)))
-      (if (not (mh-internal-seq name))
-	  (mh-notate-seq name ?% (1+ mh-cmd-note)))
-      (setq seqs (cdr seqs)))))
-
-
-(defun mh-internal-seq (name)
-  ;; Return non-NIL if NAME is the name of an internal mh-e sequence.
-  (or (memq name '(answered cur deleted forwarded printed))
-      (eq name mh-unseen-seq)
-      (mh-folder-name-p name)))
-
-
-(defun mh-folder-name-p (name)
-  ;; Return non-NIL if NAME is possibly the name of a folder.
-  ;; A name (a string or symbol) can be a folder name if it begins with "+".
-  (if (symbolp name)
-      (eql (aref (symbol-name name) 0) ?+)
-      (eql (aref name 0) ?+)))
-
-
-(defun mh-notate-seq (seq notation offset)
-  ;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER
-  ;; at the given OFFSET from the beginning of the listing line.
-  (mh-map-to-seq-msgs 'mh-notate seq notation offset))
-
-
-(defun mh-notate-if-in-one-seq (msg notation offset seq)
-  ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the
-  ;; message with the CHARACTER at the given OFFSET from the beginning of the
-  ;; listing line.
-  (let ((in-seqs (mh-seq-containing-msg msg)))
-    (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
-	(mh-notate msg notation offset))))
-
-
-(defun mh-map-to-seq-msgs (func seq &rest args)
-  ;; Invoke the FUNCTION at each message in the SEQUENCE, passing the
-  ;; remaining ARGS as arguments.
-  (save-excursion
-    (let ((msgs (mh-seq-to-msgs seq)))
-      (while msgs
-	(if (mh-goto-msg (car msgs) t t)
-	    (apply func (car msgs) args))
-	(setq msgs (cdr msgs))))))
-
-
-(defun mh-map-over-seqs (func seq-list)
-  ;; Apply the FUNCTION to each element in the list of SEQUENCES,
-  ;; passing the sequence name and the list of messages as arguments.
-  (while seq-list
-    (funcall func (mh-seq-name (car seq-list)) (mh-seq-msgs (car seq-list)))
-    (setq seq-list (cdr seq-list))))
-
-
-(defun mh-define-sequences (seq-list)
-  ;; Define the sequences in SEQ-LIST.
-  (mh-map-over-seqs 'mh-define-sequence seq-list))
-
-
-(defun mh-add-to-sequence (seq msgs)
-  ;; Add to a SEQUENCE each message the list of MSGS.
-  (if (not (mh-folder-name-p seq))
-      (if msgs
-	  (apply 'mh-exec-cmd "mark" mh-current-folder
-		 "-sequence" (symbol-name seq)
-		 "-add" msgs))))
-
-
-(defun mh-define-sequence (seq msgs)
-  ;; Define the SEQUENCE to contain the list of MSGS.  Do not mark
-  ;; pseudo-sequences or empty sequences.
-  (if (and msgs
-	   (not (mh-folder-name-p seq)))
-      (save-excursion
-	(apply 'mh-exec-cmd "mark" mh-current-folder
-	       "-sequence" (symbol-name seq)
-	       "-add" "-zero" (mh-list-to-string msgs)))))
-
-
-(defun mh-undefine-sequence (seq msgs)
-  ;; Remove from the SEQUENCE the list of MSGS.
-  (apply 'mh-exec-cmd "mark" mh-current-folder
-	 "-sequence" (symbol-name seq)
-	 "-delete" msgs))
-
-
-(defun mh-copy-seq-to-point (seq location)
-  ;; Copy the scan listing of the messages in SEQUENCE to after the point
-  ;; LOCATION in the current buffer.
-  (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
-
-
-(defun mh-copy-line-to-point (msg location)
-  ;; Copy the current line to the LOCATION in the current buffer.
-  (beginning-of-line)
-  (let ((beginning-of-line (point)))
-    (forward-line 1)
-    (copy-region-as-kill beginning-of-line (point))
-    (goto-char location)
-    (yank)
-    (goto-char beginning-of-line)))
-
-
-
-;;; Issue commands to MH.
-
-(defun mh-exec-cmd (command &rest args)
-  ;; Execute MH command COMMAND with ARGS.
-  ;; Any output is assumed to be an error and is shown to the user.
-  (save-excursion
-    (set-buffer " *mh-temp*")
-    (erase-buffer)
-    (apply 'call-process
-	   (expand-file-name command mh-progs) nil t nil
-	   (mh-list-to-string args))
-    (if (> (buffer-size) 0)
-	(save-window-excursion
-	  (switch-to-buffer-other-window " *mh-temp*")
-	  (sit-for 5)))))
-
-
-(defun mh-exec-cmd-quiet (buffer command &rest args)
-  ;; In BUFFER, execute MH command COMMAND with ARGS.
-  ;; ARGS is a list of strings.  Return in BUFFER, if one exists.
-  (mh-when (stringp buffer)
-    (set-buffer buffer)
-    (erase-buffer))
-  (apply 'call-process
-	 (expand-file-name command mh-progs) nil buffer nil
-	 args))
-
-
-(defun mh-exec-cmd-output (command display &rest args)
-  ;; Execute MH command COMMAND with DISPLAY flag and ARGS putting the output
-  ;; into buffer after point.  Set mark after inserted text.
-  (push-mark (point) t)
-  (apply 'call-process
-	 (expand-file-name command mh-progs) nil t display
-	 (mh-list-to-string args))
-  (exchange-point-and-mark))
-
-
-(defun mh-exec-cmd-daemon (command &rest args)
-  ;; Execute MH command COMMAND with ARGS.  Any output from command is
-  ;; displayed in an asynchronous pop-up window.
-  (save-excursion
-    (set-buffer (get-buffer-create " *mh-temp*"))
-    (erase-buffer))
-  (let* ((process-connection-type nil)
-	 (process (apply 'start-process
-			 command nil
-			 (expand-file-name command mh-progs)
-			 (mh-list-to-string args))))
-    (set-process-filter process 'mh-process-daemon)))
-
-
-(defun mh-process-daemon (process output)
-  ;; Process daemon that puts output into a temporary buffer.
-  (set-buffer (get-buffer-create " *mh-temp*"))
-  (insert-before-markers output)
-  (display-buffer " *mh-temp*"))
-
-
-(defun mh-exec-lib-cmd-output (command &rest args)
-  ;; Execute MH library command COMMAND with ARGS.
-  ;; Put the output into buffer after point.  Set mark after inserted text.
-  (push-mark (point) t)
-  (apply 'call-process
-	 (expand-file-name command mh-lib) nil t nil
-	 (mh-list-to-string args))
-  (exchange-point-and-mark))
-
-
-(defun mh-list-to-string (l)
-  ;; Flattens the list L and makes every element of the new list into a string.
-  (let ((new-list nil))
-    (while l
-      (cond ((null (car l)))
-	    ((symbolp (car l)) (mh-push (symbol-name (car l)) new-list))
-	    ((numberp (car l)) (mh-push (int-to-string (car l)) new-list))
-	    ((equal (car l) ""))
-	    ((stringp (car l)) (mh-push (car l) new-list))
-	    ((listp (car l))
-	     (setq new-list (nconc (nreverse (mh-list-to-string (car l)))
-				   new-list)))
-	    (t (error "Bad element in mh-list-to-string: %s" (car l))))
-      (setq l (cdr l)))
-    (nreverse new-list)))
-
-
-
-;;; Commands to annotate a message.
-
-(defun mh-annotate-msg (msg buffer note &rest args)
-  ;; Mark the MESSAGE in BUFFER listing with the character NOTE and annotate
-  ;; the saved message with ARGS.
-  (apply 'mh-exec-cmd "anno" buffer msg args)
-  (save-excursion
-    (cond ((get-buffer buffer)		; Buffer may be deleted
-	   (set-buffer buffer)
-	   (if (symbolp msg)
-	       (mh-notate-seq msg note (1+ mh-cmd-note))
-	       (mh-notate msg note (1+ mh-cmd-note)))))))
-
-
-(defun mh-notate (msg notation offset)
-  ;; Marks MESSAGE with the character NOTATION at position OFFSET.
-  ;; Null MESSAGE means the message that the cursor points to.
-  (save-excursion
-    (if (or (null msg)
-	    (mh-goto-msg msg t t))
-	(with-mh-folder-updating (t)
-	  (beginning-of-line)
-	  (forward-char offset)
-	  (delete-char 1)
-	  (insert notation)))))
-
-
-
-;;; User prompting commands.
-
-(defun mh-prompt-for-folder (prompt default can-create)
-  ;; Prompt for a folder name with PROMPT.  Returns the folder's name as a
-  ;; string.  DEFAULT is used if the folder exists and the user types return.
-  ;; If the CAN-CREATE flag is t, then a non-existent folder is made.
-  (let* ((prompt (format "%s folder%s" prompt
-			 (if (equal "" default)
-			     "? "
-			     (format " [%s]? " default))))
-	 name)
-    (if (null mh-folder-list)
-	(mh-set-folder-list))
-    (while (and (setq name (completing-read prompt mh-folder-list
-					    nil nil "+"))
-		(equal name "")
-		(equal default "")))
-    (cond ((or (equal name "") (equal name "+"))
-	   (setq name default))
-	  ((not (mh-folder-name-p name))
-	   (setq name (format "+%s" name))))
-    (let ((new-file-p (not (file-exists-p (mh-expand-file-name name)))))
-      (cond ((and new-file-p
-		  (y-or-n-p
-		   (format "Folder %s does not exist. Create it? " name)))
-	     (message "Creating %s" name)
-	     (call-process "mkdir" nil nil nil (mh-expand-file-name name))
-	     (message "Creating %s...done" name)
-	     (mh-push (list name) mh-folder-list))
-	    (new-file-p
-	     (error "Folder %s is not created" name))
-	    (t
-	     (mh-when (null (assoc name mh-folder-list))
-	       (mh-push (list name) mh-folder-list)))))
-    name))
-
-
-(defun mh-set-folder-list ()
-  "Sets mh-folder-list correctly.
-A useful function for the command line or for when you need to sync by hand."
-  (setq mh-folder-list (mh-make-folder-list)))
-
-
-(defun mh-make-folder-list ()
-  "Return a list of the user's folders.
-Result is in a form suitable for completing read."
-  (interactive)
-  (message "Collecting folder names...")
-  (save-window-excursion
-    (mh-exec-cmd-quiet " *mh-temp*" "folders" "-fast"
-		       (if mh-recursive-folders
-			   "-recurse"
-			   "-norecurse"))
-    (goto-char (point-min))
-    (let ((list nil)
-	  start)
-      (while (not (eobp))
-	(setq start (point))
-	(forward-line 1)
-	(mh-push (list (format "+%s" (buffer-substring start (1- (point)))))
-		 list))
-      (message "Collecting folder names...done")
-      list)))
-
-
-(defun mh-remove-folder-from-folder-list (folder)
-  ;; Remove FOLDER from the list of folders.
-  (setq mh-folder-list
-	(delq (assoc folder mh-folder-list) mh-folder-list)))
-
-
-(defun mh-read-msg-range (prompt)
-  ;; Read a list of blank-separated items.
-  (let* ((buf (read-string prompt))
-	 (buf-size (length buf))
-	 (start 0)
-	 (input ()))
-    (while (< start buf-size)
-      (let ((next (read-from-string buf start buf-size)))
-	(mh-push (car next) input)
-	(setq start (cdr next))))
-    (nreverse input)))
-
-
-
-;;; Misc. functions.
-
-(defun mh-get-msg-num (error-if-no-message)
-  ;; Return the message number of the displayed message.  If the argument
-  ;; ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is not
-  ;; pointing to a message.
-  (save-excursion
-    (beginning-of-line)
-    (cond ((looking-at mh-msg-number-regexp)
-	   (string-to-int (buffer-substring (match-beginning 1)
-					    (match-end 1))))
-	  (error-if-no-message
-	   (error "Cursor not pointing to message"))
-	  (t nil))))
-
-
-(defun mh-msg-search-pat (n)
-  ;; Return a search pattern for message N in the scan listing.
-  (format mh-msg-search-regexp n))
-
-
-(defun mh-msg-filename (msg &optional folder)
-  ;; Return the file name of MESSAGE in FOLDER (default current folder).
-  (expand-file-name (int-to-string msg)
-		    (if folder
-			(mh-expand-file-name folder)
-			mh-folder-filename)))
-
-
-(defun mh-msg-filenames (msgs &optional folder)
-  ;; Return a list of file names for MSGS in FOLDER (default current folder).
-  (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
-
-
-(defun mh-expand-file-name (filename &optional default)
-  "Just like `expand-file-name', but also handles MH folder names.
-Assumes that any filename that starts with '+' is a folder name."
-   (if (mh-folder-name-p filename)
-       (expand-file-name (substring filename 1) mh-user-path)
-     (expand-file-name filename default)))
-
-
-(defun mh-find-path ()
-  ;; Set mh-user-path, mh-draft-folder, and mh-unseen-seq from profile file.
-  (save-excursion
-    ;; Be sure profile is fully expanded before switching buffers
-    (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile"))))
-      (if (not (file-exists-p profile))
-	  (error "Cannot find MH profile %s" profile))
-      (set-buffer (get-buffer-create " *mh-temp*"))
-      (erase-buffer)
-      (insert-file-contents profile)
-      (setq mh-draft-folder (mh-get-field "Draft-Folder:"))
-      (cond ((equal mh-draft-folder "")
-	     (setq mh-draft-folder nil))
-	    ((not (mh-folder-name-p mh-draft-folder))
-	     (setq mh-draft-folder (format "+%s" mh-draft-folder))))
-      (setq mh-user-path (mh-get-field "Path:"))
-      (if (equal mh-user-path "")
-	  (setq mh-user-path "Mail"))
-      (setq mh-user-path
-	    (file-name-as-directory
-	     (expand-file-name mh-user-path (expand-file-name "~"))))
-      (if (and mh-draft-folder
-	       (not (file-exists-p (mh-expand-file-name mh-draft-folder))))
-	  (error "Draft folder %s does not exist.  Create it and try again."
-		 mh-draft-folder))
-      (setq mh-unseen-seq (mh-get-field "Unseen-Sequence:"))
-      (if (equal mh-unseen-seq "")
-	  (setq mh-unseen-seq 'unseen)
-	  (setq mh-unseen-seq (intern mh-unseen-seq))))))
-
-
-(defun mh-get-field (field)
-  ;; Find and return the value of field FIELD in the current buffer.
-  ;; Returns the empty string if the field is not in the message.
-  (let ((case-fold-search t))
-    (goto-char (point-min))
-    (cond ((not (re-search-forward (format "^%s" field) nil t)) "")
-	  ((looking-at "[\t ]*$") "")
-	  (t
-	   (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
-	   (let ((start (match-beginning 1)))
-	     (forward-line 1)
-	     (while (looking-at "[ \t]")
-	       (forward-line 1))
-	     (buffer-substring start (1- (point))))))))
-
-
-(defun mh-insert-fields (&rest name-values)
-  ;; Insert the NAME-VALUE pairs in the current buffer.
-  ;; Do not insert any pairs whose value is the empty string.
-  (let ((case-fold-search t))
-    (while name-values
-      (let ((field-name (car name-values))
-	    (value (car (cdr name-values))))
-	(mh-when (not (equal value ""))
-	  (goto-char (point-min))
-	  (cond ((not (re-search-forward (format "^%s" field-name) nil t))
-		 (mh-goto-header-end 0)
-		 (insert field-name " " value "\n"))
-		(t
-		 (end-of-line)
-		 (insert " " value))))
-	(setq name-values (cdr (cdr name-values)))))))
-
-
-(defun mh-position-on-field (field set-mark)
-  ;; Set point to the end of the line beginning with FIELD.
-  ;; Set the mark to the old value of point, if SET-MARK is non-nil.
-  ;; Returns non-nil iff the field was found.
-  (let ((case-fold-search t))
-    (if set-mark (push-mark))
-    (goto-char (point-min))
-    (mh-goto-header-end 0)
-    (if (re-search-backward (format "^%s" field) nil t)
-	(progn (end-of-line) t)
-	nil)))
-
-
-(defun mh-goto-header-end (arg)
-  ;; Find the end of the message header in the current buffer and position
-  ;; the cursor at the ARG'th newline after the header.
-  (if (re-search-forward "^$\\|^-+$" nil nil)
-      (forward-line arg)))
-
-
-
-;;; Build the folder-mode keymap:
-
-(suppress-keymap mh-folder-mode-map)
-(define-key mh-folder-mode-map "q" 'mh-quit)
-(define-key mh-folder-mode-map "b" 'mh-quit)
-(define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq)
-(define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq)
-(define-key mh-folder-mode-map "|" 'mh-pipe-msg)
-(define-key mh-folder-mode-map "\ea" 'mh-edit-again)
-(define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq)
-(define-key mh-folder-mode-map "\C-xn" 'mh-narrow-to-seq)
-(define-key mh-folder-mode-map "\C-xw" 'mh-widen)
-(define-key mh-folder-mode-map "\eb" 'mh-burst-digest)
-(define-key mh-folder-mode-map "\eu" 'mh-undo-folder)
-(define-key mh-folder-mode-map "\e " 'mh-page-digest)
-(define-key mh-folder-mode-map "\e\177" 'mh-page-digest-backwards)
-(define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail)
-(define-key mh-folder-mode-map "\ef" 'mh-visit-folder)
-(define-key mh-folder-mode-map "\ek" 'mh-kill-folder)
-(define-key mh-folder-mode-map "\el" 'mh-list-folders)
-(define-key mh-folder-mode-map "\en" 'mh-unshar-msg)
-(define-key mh-folder-mode-map "\eo" 'mh-write-msg-to-file)
-(define-key mh-folder-mode-map "\ep" 'mh-pack-folder)
-(define-key mh-folder-mode-map "\es" 'mh-search-folder)
-(define-key mh-folder-mode-map "\er" 'mh-rescan-folder)
-(define-key mh-folder-mode-map "l" 'mh-print-msg)
-(define-key mh-folder-mode-map "t" 'mh-toggle-showing)
-(define-key mh-folder-mode-map "c" 'mh-copy-msg)
-(define-key mh-folder-mode-map ">" 'mh-write-msg-to-file)
-(define-key mh-folder-mode-map "i" 'mh-inc-folder)
-(define-key mh-folder-mode-map "x" 'mh-execute-commands)
-(define-key mh-folder-mode-map "e" 'mh-execute-commands)
-(define-key mh-folder-mode-map "r" 'mh-redistribute)
-(define-key mh-folder-mode-map "f" 'mh-forward)
-(define-key mh-folder-mode-map "s" 'mh-send)
-(define-key mh-folder-mode-map "m" 'mh-send)
-(define-key mh-folder-mode-map "a" 'mh-reply)
-(define-key mh-folder-mode-map "j" 'mh-goto-msg)
-(define-key mh-folder-mode-map "<" 'mh-first-msg)
-(define-key mh-folder-mode-map "g" 'mh-goto-msg)
-(define-key mh-folder-mode-map "\177" 'mh-previous-page)
-(define-key mh-folder-mode-map " " 'mh-page-msg)
-(define-key mh-folder-mode-map "." 'mh-show)
-(define-key mh-folder-mode-map "u" 'mh-undo)
-(define-key mh-folder-mode-map "!" 'mh-refile-or-write-again)
-(define-key mh-folder-mode-map "^" 'mh-refile-msg)
-(define-key mh-folder-mode-map "d" 'mh-delete-msg)
-(define-key mh-folder-mode-map "\C-d" 'mh-delete-msg-no-motion)
-(define-key mh-folder-mode-map "p" 'mh-previous-undeleted-msg)
-(define-key mh-folder-mode-map "n" 'mh-next-undeleted-msg)
-(define-key mh-folder-mode-map "o" 'mh-refile-msg)
-
-
-;;; Build the letter-mode keymap:
-
-(define-key mh-letter-mode-map "\C-c\C-f\C-b" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-f\C-c" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-f\C-f" 'mh-to-fcc)
-(define-key mh-letter-mode-map "\C-c\C-f\C-s" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-f\C-t" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-fb" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-fc" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-ff" 'mh-to-fcc)
-(define-key mh-letter-mode-map "\C-c\C-fs" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-ft" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-q" 'mh-fully-kill-draft)
-(define-key mh-letter-mode-map "\C-c\C-w" 'mh-check-whom)
-(define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter)
-(define-key mh-letter-mode-map "\C-c\C-y" 'mh-yank-cur-msg)
-(define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature)
-(define-key mh-letter-mode-map "\C-c\C-c" 'mh-send-letter)
-
-
-;;; Build the pick-mode keymap:
-
-(define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search)
-(define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-w" 'mh-check-whom)
-
-
-
-;;; For Gnu Emacs.
-;;; Local Variables: ***
-;;; eval: (put 'mh-when 'lisp-indent-hook 1) ***
-;;; eval: (put 'with-mh-folder-updating 'lisp-indent-hook 1) ***
-;;; End: ***
-
-(provide 'mh-e)
-
-;;; mh-e.el ends here
diff --git a/lisp/=mhspool.el b/lisp/=mhspool.el
deleted file mode 100644
index b81823938f0..00000000000
--- a/lisp/=mhspool.el
+++ /dev/null
@@ -1,490 +0,0 @@
-;;; mhspool.el --- MH folder access using NNTP for GNU Emacs
-
-;; Copyright (C) 1988, 1989, 1990, 1993 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Maintainer: FSF
-;; Keywords: mail, news
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This package enables you to read mail or articles in MH folders, or
-;; articles saved by GNUS. In any case, the file names of mail or
-;; articles must consist of only numeric letters.
-
-;; Before using this package, you have to create a server specific
-;; startup file according to the directory which you want to read. For
-;; example, if you want to read mail under the directory named
-;; `~/Mail', the file must be a file named `.newsrc-:Mail'. (There is
-;; no way to specify hierarchical directory now.) In this case, the
-;; name of the NNTP server passed to GNUS must be `:Mail'.
-
-;;; Code:
-
-(require 'nntp)
-
-(defvar mhspool-list-folders-method
-  (function mhspool-list-folders-using-sh)
-  "*Function to list files in folders.
-The function should accept a directory as its argument, and fill the
-current buffer with file and directory names.  The output format must
-be the same as that of 'ls -R1'.  Two functions
-mhspool-list-folders-using-ls and mhspool-list-folders-using-sh are
-provided now.  I suppose the later is faster.")
-
-(defvar mhspool-list-directory-switches '("-R")
-  "*Switches for mhspool-list-folders-using-ls to pass to `ls' for getting file lists.
-One entry should appear on one line. You may need to add `-1' option.")
-
-
-
-(defconst mhspool-version "MHSPOOL 1.8"
-  "Version numbers of this version of MHSPOOL.")
-
-(defvar mhspool-spool-directory "~/Mail"
-  "Private mail directory.")
-
-(defvar mhspool-current-directory nil
-  "Current news group directory.")
-
-;;;
-;;; Replacement of Extended Command for retrieving many headers.
-;;;
-
-(defun mhspool-retrieve-headers (sequence)
-  "Return list of article headers specified by SEQUENCE of article id.
-The format of list is
- `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
-If there is no References: field, In-Reply-To: field is used instead.
-Reader macros for the vector are defined as `nntp-header-FIELD'.
-Writer macros for the vector are defined as `nntp-set-header-FIELD'.
-Newsgroup must be selected before calling this."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    ;;(erase-buffer)
-    (let ((file nil)
-	  (number (length sequence))
-	  (count 0)
-	  (headers nil)			;Result list.
-	  (article 0)
-	  (subject nil)
-	  (message-id nil)
-	  (from nil)
-	  (xref nil)
-	  (lines 0)
-	  (date nil)
-	  (references nil))
-      (while sequence
-	;;(nntp-send-strings-to-server "HEAD" (car sequence))
-	(setq article (car sequence))
-	(setq file
-	      (concat mhspool-current-directory (prin1-to-string article)))
-	(if (and (file-exists-p file)
-		 (not (file-directory-p file)))
-	    (progn
-	      (erase-buffer)
-	      (insert-file-contents file)
-	      ;; Make message body invisible.
-	      (goto-char (point-min))
-	      (search-forward "\n\n" nil 'move)
-	      (narrow-to-region (point-min) (point))
-	      ;; Fold continuation lines.
-	      (goto-char (point-min))
-	      (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
-		(replace-match " " t t))
-	      ;; Make it possible to search for `\nFIELD'.
-	      (goto-char (point-min))
-	      (insert "\n")
-	      ;; Extract From:
-	      (goto-char (point-min))
-	      (if (search-forward "\nFrom: " nil t)
-		  (setq from (buffer-substring
-			      (point)
-			      (save-excursion (end-of-line) (point))))
-		(setq from "(Unknown User)"))
-	      ;; Extract Subject:
-	      (goto-char (point-min))
-	      (if (search-forward "\nSubject: " nil t)
-		  (setq subject (buffer-substring
-				 (point)
-				 (save-excursion (end-of-line) (point))))
-		(setq subject "(None)"))
-	      ;; Extract Message-ID:
-	      (goto-char (point-min))
-	      (if (search-forward "\nMessage-ID: " nil t)
-		  (setq message-id (buffer-substring
-				    (point)
-				    (save-excursion (end-of-line) (point))))
-		(setq message-id nil))
-	      ;; Extract Date:
-	      (goto-char (point-min))
-	      (if (search-forward "\nDate: " nil t)
-		  (setq date (buffer-substring
-			      (point)
-			      (save-excursion (end-of-line) (point))))
-		(setq date nil))
-	      ;; Extract Lines:
-	      (goto-char (point-min))
-	      (if (search-forward "\nLines: " nil t)
-		  (setq lines (string-to-int
-			       (buffer-substring
-				(point)
-				(save-excursion (end-of-line) (point)))))
-		;; Count lines since there is no lines field in most cases.
-		(setq lines
-		      (save-restriction
-			(goto-char (point-max))
-			(widen)
-			(count-lines (point) (point-max)))))
-	      ;; Extract Xref:
-	      (goto-char (point-min))
-	      (if (search-forward "\nXref: " nil t)
-		  (setq xref (buffer-substring
-			      (point)
-			      (save-excursion (end-of-line) (point))))
-		(setq xref nil))
-	      ;; Extract References:
-	      ;; If no References: field, use In-Reply-To: field instead.
-	      ;; Suggested by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA).
-	      (goto-char (point-min))
-	      (if (or (search-forward "\nReferences: " nil t)
-		      (search-forward "\nIn-Reply-To: " nil t))
-		  (setq references (buffer-substring
-				    (point)
-				    (save-excursion (end-of-line) (point))))
-		(setq references nil))
-	      ;; Collect valid article only.
-	      (and article
-		   message-id
-		   (setq headers
-			 (cons (vector article subject from
-				       xref lines date
-				       message-id references) headers)))
-	      ))
-	(setq sequence (cdr sequence))
-	(setq count (1+ count))
-	(and (numberp nntp-large-newsgroup)
-	     (> number nntp-large-newsgroup)
-	     (zerop (% count 20))
-	     (message "MHSPOOL: Receiving headers... %d%%"
-		      (/ (* count 100) number)))
-	)
-      (and (numberp nntp-large-newsgroup)
-	   (> number nntp-large-newsgroup)
-	   (message "MHSPOOL: Receiving headers... done"))
-      (nreverse headers)
-      )))
-
-
-;;;
-;;; Replacement of NNTP Raw Interface.
-;;;
-
-(defun mhspool-open-server (host &optional service)
-  "Open news server on HOST.
-If HOST is nil, use value of environment variable `NNTPSERVER'.
-If optional argument SERVICE is non-nil, open by the service name."
-  (let ((host (or host (getenv "NNTPSERVER")))
-	(status nil))
-    ;; Get directory name from HOST name.
-    (if (string-match ":\\(.+\\)$" host)
-	(progn
-	  (setq mhspool-spool-directory
-		(file-name-as-directory
-		 (expand-file-name
-		  (substring host (match-beginning 1) (match-end 1))
-		  (expand-file-name "~/" nil))))
-	  (setq host (system-name)))
-      (setq mhspool-spool-directory nil))
-    (setq nntp-status-string "")
-    (cond ((and (stringp host)
-		(stringp mhspool-spool-directory)
-		(file-directory-p mhspool-spool-directory)
-		(string-equal host (system-name)))
-	   (setq status (mhspool-open-server-internal host service)))
-	  ((string-equal host (system-name))
-	   (setq nntp-status-string
-		 (format "No such directory: %s.  Goodbye."
-			 mhspool-spool-directory)))
-	  ((null host)
-	   (setq nntp-status-string "NNTP server is not specified."))
-	  (t
-	   (setq nntp-status-string
-		 (format "MHSPOOL: cannot talk to %s." host)))
-	  )
-    status
-    ))
-
-(defun mhspool-close-server ()
-  "Close news server."
-  (mhspool-close-server-internal))
-
-(fset 'mhspool-request-quit (symbol-function 'mhspool-close-server))
-
-(defun mhspool-server-opened ()
-  "Return server process status, T or NIL.
-If the stream is opened, return T, otherwise return NIL."
-  (and nntp-server-buffer
-       (get-buffer nntp-server-buffer)))
-
-(defun mhspool-status-message ()
-  "Return server status response as string."
-  nntp-status-string
-  )
-
-(defun mhspool-request-article (id)
-  "Select article by message ID (or number)."
-  (let ((file (concat mhspool-current-directory (prin1-to-string id))))
-    (if (and (stringp file)
-	     (file-exists-p file)
-	     (not (file-directory-p file)))
-	(save-excursion
-	  (mhspool-find-file file)))
-    ))
-
-(defun mhspool-request-body (id)
-  "Select article body by message ID (or number)."
-  (if (mhspool-request-article id)
-      (save-excursion
-	(set-buffer nntp-server-buffer)
-	(goto-char (point-min))
-	(if (search-forward "\n\n" nil t)
-	    (delete-region (point-min) (point)))
-	t
-	)
-    ))
-
-(defun mhspool-request-head (id)
-  "Select article head by message ID (or number)."
-  (if (mhspool-request-article id)
-      (save-excursion
-	(set-buffer nntp-server-buffer)
-	(goto-char (point-min))
-	(if (search-forward "\n\n" nil t)
-	    (delete-region (1- (point)) (point-max)))
-	t
-	)
-    ))
-
-(defun mhspool-request-stat (id)
-  "Select article by message ID (or number)."
-  (setq nntp-status-string "MHSPOOL: STAT is not implemented.")
-  nil
-  )
-
-(defun mhspool-request-group (group)
-  "Select news GROUP."
-  (cond ((file-directory-p
-	  (mhspool-article-pathname group))
-	 ;; Mail/NEWS.GROUP/N
-	 (setq mhspool-current-directory
-	       (mhspool-article-pathname group)))
-	((file-directory-p
-	  (mhspool-article-pathname
-	   (mhspool-replace-chars-in-string group ?. ?/)))
-	 ;; Mail/NEWS/GROUP/N
-	 (setq mhspool-current-directory
-	       (mhspool-article-pathname
-		(mhspool-replace-chars-in-string group ?. ?/))))
-	))
-
-(defun mhspool-request-list ()
-  "List active newsgoups."
-  (save-excursion
-    (let* ((newsgroup nil)
-	   (articles nil)
-	   (directory (file-name-as-directory
-		       (expand-file-name mhspool-spool-directory nil)))
-	   (folder-regexp (concat "^" (regexp-quote directory) "\\(.+\\):$"))
-	   (buffer (get-buffer-create " *MHSPOOL File List*")))
-      (set-buffer nntp-server-buffer)
-      (erase-buffer)
-      (set-buffer buffer)
-      (erase-buffer)
-;;      (apply 'call-process
-;;	     "ls" nil t nil
-;;	     (append mhspool-list-directory-switches (list directory)))
-      (funcall mhspool-list-folders-method directory)
-      (goto-char (point-min))
-      (while (re-search-forward folder-regexp nil t)
-	(setq newsgroup
-	      (mhspool-replace-chars-in-string
-	       (buffer-substring (match-beginning 1) (match-end 1)) ?/ ?.))
-	(setq articles nil)
-	(forward-line 1)		;(beginning-of-line)
-	;; Thank nobu@flab.fujitsu.junet for his bug fixes.
-	(while (and (not (eobp))
-		    (not (looking-at "^$")))
-	  (if (looking-at "^[0-9]+$")
-	      (setq articles
-		    (cons (string-to-int
-			   (buffer-substring
-			    (match-beginning 0) (match-end 0)))
-			  articles)))
-	  (forward-line 1))
-	(if articles
-	    (princ (format "%s %d %d n\n" newsgroup
-			   (apply (function max) articles)
-			   (apply (function min) articles))
-		   nntp-server-buffer))
-	)
-      (kill-buffer buffer)
-      (set-buffer nntp-server-buffer)
-      (buffer-size)
-      )))
-
-(defun mhspool-request-list-newsgroups ()
-  "List newsgoups (defined in NNTP2)."
-  (setq nntp-status-string "MHSPOOL: LIST NEWSGROUPS is not implemented.")
-  nil
-  )
-
-(defun mhspool-request-list-distributions ()
-  "List distributions (defined in NNTP2)."
-  (setq nntp-status-string "MHSPOOL: LIST DISTRIBUTIONS is not implemented.")
-  nil
-  )
-
-(defun mhspool-request-last ()
-  "Set current article pointer to the previous article
-in the current news group."
-  (setq nntp-status-string "MHSPOOL: LAST is not implemented.")
-  nil
-  )
-
-(defun mhspool-request-next ()
-  "Advance current article pointer."
-  (setq nntp-status-string "MHSPOOL: NEXT is not implemented.")
-  nil
-  )
-
-(defun mhspool-request-post ()
-  "Post a new news in current buffer."
-  (setq nntp-status-string "MHSPOOL: POST: what do you mean?")
-  nil
-  )
-
-
-;;;
-;;; Replacement of Low-Level Interface to NNTP Server.
-;;; 
-
-(defun mhspool-open-server-internal (host &optional service)
-  "Open connection to news server on HOST by SERVICE (default is nntp)."
-  (save-excursion
-    (if (not (string-equal host (system-name)))
-	(error "MHSPOOL: cannot talk to %s." host))
-    ;; Initialize communication buffer.
-    (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
-    (set-buffer nntp-server-buffer)
-    (buffer-flush-undo (current-buffer))
-    (erase-buffer)
-    (kill-all-local-variables)
-    (setq case-fold-search t)		;Should ignore case.
-    (setq nntp-server-process nil)
-    (setq nntp-server-name host)
-    ;; It is possible to change kanji-fileio-code in this hook.
-    (run-hooks 'nntp-server-hook)
-    t
-    ))
-
-(defun mhspool-close-server-internal ()
-  "Close connection to news server."
-  (if nntp-server-buffer
-      (kill-buffer nntp-server-buffer))
-  (setq nntp-server-buffer nil)
-  (setq nntp-server-process nil))
-
-(defun mhspool-find-file (file)
-  "Insert FILE in server buffer safely."
-  (set-buffer nntp-server-buffer)
-  (erase-buffer)
-  (condition-case ()
-      (progn
-	(insert-file-contents file)
-	(goto-char (point-min))
-	;; If there is no body, `^L' appears at end of file. Special
-	;; hack for MH folder.
-	(and (search-forward "\n\n" nil t)
-	     (string-equal (buffer-substring (point) (point-max)) "\^L")
-	     (delete-char 1))
-	t
-	)
-    (file-error nil)
-    ))
-
-(defun mhspool-article-pathname (group)
-  "Make pathname for GROUP."
-  (concat (file-name-as-directory mhspool-spool-directory) group "/"))
-
-(defun mhspool-replace-chars-in-string (string from to)
-  "Replace characters in STRING from FROM to TO."
-  (let ((string (substring string 0))	;Copy string.
-	(len (length string))
-	(idx 0))
-    ;; Replace all occurrences of FROM with TO.
-    (while (< idx len)
-      (if (= (aref string idx) from)
-	  (aset string idx to))
-      (setq idx (1+ idx)))
-    string
-    ))
-
-
-;; Methods for listing files in folders.
-
-(defun mhspool-list-folders-using-ls (directory)
-  "List files in folders under DIRECTORY using 'ls'."
-  (apply 'call-process
-	 "ls" nil t nil
-	 (append mhspool-list-directory-switches (list directory))))
-
-;; Basic ideas by tanaka@flab.fujitsu.co.jp (Hiroshi TANAKA)
-
-(defun mhspool-list-folders-using-sh (directory)
-  "List files in folders under DIRECTORY using '/bin/sh'."
-  (let ((buffer (current-buffer))
-	(script (get-buffer-create " *MHSPOOL Shell Script Buffer*")))
-    (save-excursion
-      (save-restriction
-	(set-buffer script)
-	(erase-buffer)
-	;; /bin/sh script which does 'ls -R'.
-	(insert
-	 "PS2=
-          ffind() {
-		cd $1; echo $1:
-		ls -1
-		echo
-		for j in `echo *[a-zA-Z]*`
-		do
-		  if [ -d $1/$j ]; then
-			ffind $1/$j
-		  fi
-		done
-	  }
-	  cd " directory "; ffind `pwd`; exit 0\n")
-	(call-process-region (point-min) (point-max) "sh" nil buffer nil)
-	))
-    (kill-buffer script)
-    ))
-
-(provide 'mhspool)
-
-;;; mhspool.el ends here
diff --git a/lisp/=mim-mode.el b/lisp/=mim-mode.el
deleted file mode 100644
index 94e63cb9f48..00000000000
--- a/lisp/=mim-mode.el
+++ /dev/null
@@ -1,848 +0,0 @@
-;;; mim-mode.el --- Mim (MDL in MDL) mode.
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; Maintainer: FSF
-;; Keywords: languages
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(autoload 'fast-syntax-check-mim "mim-syntax"
-	  "Checks Mim syntax quickly.
-Answers correct or incorrect, cannot point out the error context."
-	  t)
-
-(autoload 'slow-syntax-check-mim "mim-syntax"
-	  "Check Mim syntax slowly.
-Points out the context of the error, if the syntax is incorrect."
-	  t)
-
-(defvar mim-mode-hysterical-bindings t
-  "*Non-nil means bind list manipulation commands to Meta keys as well as
-Control-Meta keys for historical reasons.  Otherwise, only the latter keys
-are bound.")
-
-(defvar mim-mode-map nil)
-
-(defvar mim-mode-syntax-table nil)
-
-(if mim-mode-syntax-table
-    ()
-  (let ((i -1))
-    (setq mim-mode-syntax-table (make-syntax-table))
-    (while (< i ?\ )
-      (modify-syntax-entry (setq i (1+ i)) "    " mim-mode-syntax-table))
-    (while (< i 127)
-      (modify-syntax-entry (setq i (1+ i)) "_   " mim-mode-syntax-table))
-    (setq i (1- ?a))
-    (while (< i ?z)
-      (modify-syntax-entry (setq i (1+ i)) "w   " mim-mode-syntax-table))
-    (setq i (1- ?A))
-    (while (< i ?Z)
-      (modify-syntax-entry (setq i (1+ i)) "w   " mim-mode-syntax-table))
-    (setq i (1- ?0))
-    (while (< i ?9)
-      (modify-syntax-entry (setq i (1+ i)) "w   " mim-mode-syntax-table))
-    (modify-syntax-entry ?:  "     " mim-mode-syntax-table) ; make : symbol delimiter
-    (modify-syntax-entry ?,  "'    " mim-mode-syntax-table)
-    (modify-syntax-entry ?.  "'    " mim-mode-syntax-table)
-    (modify-syntax-entry ?'  "'    " mim-mode-syntax-table)
-    (modify-syntax-entry ?`  "'    " mim-mode-syntax-table)
-    (modify-syntax-entry ?~  "'    " mim-mode-syntax-table)
-    (modify-syntax-entry ?\; "'    " mim-mode-syntax-table) ; comments are prefixed objects
-    (modify-syntax-entry ?#  "'    " mim-mode-syntax-table)
-    (modify-syntax-entry ?%  "'    " mim-mode-syntax-table)
-    (modify-syntax-entry ?!  "'    " mim-mode-syntax-table)
-    (modify-syntax-entry ?\" "\"   " mim-mode-syntax-table)
-    (modify-syntax-entry ?\\ "\\   " mim-mode-syntax-table)
-    (modify-syntax-entry ?\( "\()  " mim-mode-syntax-table)
-    (modify-syntax-entry ?\< "\(>  " mim-mode-syntax-table)
-    (modify-syntax-entry ?\{ "\(}  " mim-mode-syntax-table)
-    (modify-syntax-entry ?\[ "\(]  " mim-mode-syntax-table)
-    (modify-syntax-entry ?\) "\)(  " mim-mode-syntax-table)
-    (modify-syntax-entry ?\> "\)<  " mim-mode-syntax-table)
-    (modify-syntax-entry ?\} "\){  " mim-mode-syntax-table)
-    (modify-syntax-entry ?\] "\)[  " mim-mode-syntax-table)))
-
-(defconst mim-whitespace "\000- ")
-
-(defvar mim-mode-hook nil
-  "*User function run after mim mode initialization.  Usage:
-\(setq mim-mode-hook '(lambda () ... your init forms ...)).")
-
-(define-abbrev-table 'mim-mode-abbrev-table nil)
-
-(defconst indent-mim-function 'indent-mim-function
-  "Controls (via properties) indenting of special forms.
-\(put 'FOO 'indent-mim-function n\), integer n, means lines inside
-<FOO ...> will be indented n spaces from start of form.
-\(put 'FOO 'indent-mim-function 'DEFINE\) is like above but means use
-value of mim-body-indent as offset from start of form.
-\(put 'FOO 'indent-mim-function <cons>\) where <cons> is a list or pointed list
-of integers, means indent each form in <FOO ...> by the amount specified
-in <cons>.  When <cons> is exhausted, indent remaining forms by
-`mim-body-indent' unless <cons> is a pointed list, in which case the last
-cdr is used.  Confused?  Here is an example:
-\(put 'FROBIT 'indent-mim-function '\(4 2 . 1\)\)
-<FROBIT
-     <CHOMP-IT>
-   <CHOMP-SOME-MORE>
-  <DIGEST>
-  <BELCH>
-  ...>
-Finally, the property can be a function name (read the code).")
-
-(defvar indent-mim-comment t
-  "*Non-nil means indent string comments.")
-
-(defvar mim-body-indent 2
-  "*Amount to indent in special forms which have DEFINE property on
-`indent-mim-function'.")
-
-(defvar indent-mim-arglist t
-  "*nil means indent arglists like ordinary lists.
-t means strings stack under start of arglist and variables stack to
-right of them.  Otherwise, strings stack under last string (or start
-of arglist if none) and variables stack to right of them.
-Examples (for values 'stack, t, nil):
-
-\(FOO \"OPT\" BAR             \(FOO \"OPT\" BAR            \(FOO \"OPT\" BAR
-           BAZ MUMBLE                 BAZ MUMBLE      BAZ MUMBLE
-     \"AUX\"                  \"AUX\"                     \"AUX\"
-     BLETCH ...             BLETCH ...                BLETCH ...")
-
-(put 'DEFINE 'indent-mim-function 'DEFINE)
-(put 'DEFMAC 'indent-mim-function 'DEFINE)
-(put 'BIND 'indent-mim-function 'DEFINE)
-(put 'PROG 'indent-mim-function 'DEFINE)
-(put 'REPEAT 'indent-mim-function 'DEFINE)
-(put 'CASE 'indent-mim-function 'DEFINE)
-(put 'FUNCTION 'indent-mim-function 'DEFINE)
-(put 'MAPF 'indent-mim-function 'DEFINE)
-(put 'MAPR 'indent-mim-function 'DEFINE)
-(put 'UNWIND 'indent-mim-function (cons (* 2 mim-body-indent) mim-body-indent))
-
-(defvar mim-down-parens-only t
-  "*nil means treat ADECLs and ATOM trailers like structures when
-moving down a level of structure.")
-
-(defvar mim-stop-for-slop t
-  "*Non-nil means {next previous}-mim-object consider any
-non-whitespace character in column 0 to be a toplevel object, otherwise
-only open paren syntax characters will be considered.")
-
-(defalias 'mdl-mode 'mim-mode)
-
-(defun mim-mode ()
-  "Major mode for editing Mim (MDL in MDL) code.
-Commands:
-    If value of `mim-mode-hysterical-bindings' is non-nil, then following
-commands are assigned to escape keys as well (e.g. ESC f = ESC C-f).
-The default action is bind the escape keys.
-\\{mim-mode-map}
-Other Commands:
-  Use \\[describe-function] to obtain documentation.
-  replace-in-mim-object  find-mim-definition  fast-syntax-check-mim
-  slow-syntax-check-mim  backward-down-mim-object  forward-up-mim-object
-Variables:
-  Use \\[describe-variable] to obtain documentation.
-  mim-mode-hook  indent-mim-comment  indent-mim-arglist  indent-mim-function
-  mim-body-indent  mim-down-parens-only  mim-stop-for-slop
-  mim-mode-hysterical-bindings
-Entry to this mode calls the value of mim-mode-hook if non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (if (not mim-mode-map)
-      (progn
-	(setq mim-mode-map (make-sparse-keymap))
-	(define-key mim-mode-map "\e\^o" 'open-mim-line)
-	(define-key mim-mode-map "\e\^q" 'indent-mim-object)
-	(define-key mim-mode-map "\e\^p" 'previous-mim-object)
-	(define-key mim-mode-map "\e\^n" 'next-mim-object)
-	(define-key mim-mode-map "\e\^a" 'beginning-of-DEFINE)
-	(define-key mim-mode-map "\e\^e" 'end-of-DEFINE)
-	(define-key mim-mode-map "\e\^t" 'transpose-mim-objects)
-	(define-key mim-mode-map "\e\^u" 'backward-up-mim-object)	
-	(define-key mim-mode-map "\e\^d" 'forward-down-mim-object)	 
-	(define-key mim-mode-map "\e\^h" 'mark-mim-object)
-	(define-key mim-mode-map "\e\^k" 'forward-kill-mim-object)	
-	(define-key mim-mode-map "\e\^f" 'forward-mim-object)	   
-	(define-key mim-mode-map "\e\^b" 'backward-mim-object)
-	(define-key mim-mode-map "\e^" 'raise-mim-line)
-	(define-key mim-mode-map "\e\\" 'fixup-whitespace)
-	(define-key mim-mode-map "\177" 'backward-delete-char-untabify)
-	(define-key mim-mode-map "\e\177" 'backward-kill-mim-object)
-	(define-key mim-mode-map "\^j" 'newline-and-mim-indent)
-	(define-key mim-mode-map "\e;" 'begin-mim-comment)
-	(define-key mim-mode-map "\t" 'indent-mim-line)
-	(define-key mim-mode-map "\e\t" 'indent-mim-object)
-	(if (not mim-mode-hysterical-bindings)
-	    nil
-	  ;; i really hate this but too many people are accustomed to these.
-	  (define-key mim-mode-map "\e!" 'line-to-top-of-window)
-	  (define-key mim-mode-map "\eo" 'open-mim-line)
-	  (define-key mim-mode-map "\ep" 'previous-mim-object)
-	  (define-key mim-mode-map "\en" 'next-mim-object)
-	  (define-key mim-mode-map "\ea" 'beginning-of-DEFINE)
-	  (define-key mim-mode-map "\ee" 'end-of-DEFINE)
-	  (define-key mim-mode-map "\et" 'transpose-mim-objects)
-	  (define-key mim-mode-map "\eu" 'backward-up-mim-object)
-	  (define-key mim-mode-map "\ed" 'forward-down-mim-object)
-	  (define-key mim-mode-map "\ek" 'forward-kill-mim-object)
-	  (define-key mim-mode-map "\ef" 'forward-mim-object)
-	  (define-key mim-mode-map "\eb" 'backward-mim-object))))
-  (use-local-map mim-mode-map)
-  (set-syntax-table mim-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  ;; Most people use string comments.
-  (make-local-variable 'comment-start)
-  (setq comment-start ";\"")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip ";\"")
-  (make-local-variable 'comment-end)
-  (setq comment-end "\"")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'indent-mim-comment)
-  ;; tell generic indenter how to indent.
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'indent-mim-line)
-  ;; look for that paren
-  (make-local-variable 'blink-matching-paren-distance)
-  (setq blink-matching-paren-distance nil)
-  ;; so people who dont like tabs can turn them off locally in indenter.
-  (make-local-variable 'indent-tabs-mode)
-  (setq indent-tabs-mode t)
-  (setq local-abbrev-table mim-mode-abbrev-table)
-  (setq major-mode 'mim-mode)
-  (setq mode-name "Mim")
-  (run-hooks 'mim-mode-hook))
-
-(defun line-to-top-of-window ()
-  "Move current line to top of window."
-  (interactive)				; for lazy people
-  (recenter 0))
-
-(defun forward-mim-object (arg)
-  "Move forward across Mim object.
-With ARG, move forward that many objects."
-  (interactive "p")
-  ;; this function is weird because it emulates the behavior of the old
-  ;; (gosling) mim-mode - if the arg is 1 and we are `inside' an ADECL,
-  ;; more than one character into the ATOM part and not sitting on the
-  ;; colon, then we move to the DECL part (just past colon) instead of
-  ;; the end of the object (the entire ADECL).  otherwise, ADECL's are
-  ;; atomic objects.  likewise for ATOM trailers.
-  (if (= (abs arg) 1)
-      (if (inside-atom-p)
-	  ;; Move to end of ATOM or to trailer (!) or to ADECL (:).
-	  (forward-sexp arg)
-	;; Either scan an sexp or move over one bracket.
-	(forward-mim-objects arg t))
-    ;; in the multi-object case, don't perform any magic.
-    ;; treats ATOM trailers and ADECLs atomically, stops at unmatched
-    ;; brackets with error.
-    (forward-mim-objects arg)))
-
-(defun inside-atom-p ()
-  ;; Returns t iff inside an atom (takes account of trailers)
-  (let ((c1 (preceding-char))
-	(c2 (following-char)))
-    (and (or (= (char-syntax c1) ?w) (= (char-syntax c1) ?_) (= c1 ?!))
-	 (or (= (char-syntax c2) ?w) (= (char-syntax c2) ?_) (= c2 ?!)))))
-
-(defun forward-mim-objects (arg &optional skip-bracket-p)
-  ;; Move over arg objects ignoring ADECLs and trailers.  If
-  ;; skip-bracket-p is non-nil, then move over one bracket on error.
-  (let ((direction (sign arg)))
-    (condition-case conditions
-	(while (/= arg 0)
-	  (forward-sexp direction)
-	  (if (not (inside-adecl-or-trailer-p direction))
-	      (setq arg (- arg direction))))
-      (error (if (not skip-bracket-p)
-		 (signal 'error (cdr conditions))
-	       (skip-mim-whitespace direction)
-	       (goto-char (+ (point) direction)))))
-    ;; If we moved too far move back to first interesting character.
-    (if (= (point) (buffer-end direction)) (skip-mim-whitespace (- direction)))))
-				    
-(defun backward-mim-object (&optional arg)
-  "Move backward across Mim object.
-With ARG, move backward that many objects."
-  (interactive "p")
-  (forward-mim-object (if arg (- arg) -1)))
-
-(defun mark-mim-object (&optional arg)
-  "Mark following Mim object.
-With ARG, mark that many following (preceding, ARG < 0) objects."
-  (interactive "p")
-  (push-mark (save-excursion (forward-mim-object (or arg 1)) (point))))
-
-(defun forward-kill-mim-object (&optional arg)
-  "Kill following Mim object.
-With ARG, kill that many objects."
-  (interactive "*p")
-  (kill-region (point) (progn (forward-mim-object (or arg 1)) (point))))
-
-(defun backward-kill-mim-object (&optional arg)
-  "Kill preceding Mim object.
-With ARG, kill that many objects."
-  (interactive "*p")
-  (forward-kill-mim-object (- (or arg 1))))
-
-(defun raise-mim-line (&optional arg)
-  "Raise following line, fixing up whitespace at join.
-With ARG raise that many following lines.
-A negative ARG will raise current line and previous lines."
-  (interactive "*p")
-  (let* ((increment (sign (or arg (setq arg 1))))
-	 (direction (if (> arg 0) 1 0)))
-    (save-excursion
-      (while (/= arg 0)
-	;; move over eol and kill it
-	(forward-line direction)
-	(delete-region (point) (1- (point)))
-	(fixup-whitespace)
-	(setq arg (- arg increment))))))
-
-(defun forward-down-mim-object (&optional arg)
-  "Move down a level of Mim structure forwards.
-With ARG, move down that many levels forwards (backwards, ARG < 0)."
-  (interactive "p")
-  ;; another weirdo - going down `inside' an ADECL or ATOM trailer
-  ;; depends on the value of mim-down-parens-only.  if nil, treat
-  ;; ADECLs and trailers as structured objects.
-  (let ((direction (sign (or arg (setq arg 1)))))
-    (if (and (= (abs arg) 1) (not mim-down-parens-only))
-	(goto-char
-	  (save-excursion
-	    (skip-mim-whitespace direction)
-	    (if (> direction 0) (re-search-forward "\\s'*"))
-	    (or (and (let ((c (next-char direction)))
-		       (or (= (char-syntax c) ?_)
-			   (= (char-syntax c) ?w)))
-		     (progn (forward-sexp direction)
-			    (if (inside-adecl-or-trailer-p direction)
-				(point))))
-		(scan-lists (point) direction -1)
-		(buffer-end direction))))
-      (while (/= arg 0)
-	(goto-char (or (scan-lists (point) direction -1) (buffer-end direction)))
-	(setq arg (- arg direction))))))
-
-(defun backward-down-mim-object (&optional arg)
-  "Move down a level of Mim structure backwards.
-With ARG, move down that many levels backwards (forwards, ARG < 0)."
-  (interactive "p")
-  (forward-down-mim-object (if arg (- arg) -1)))
-
-(defun forward-up-mim-object (&optional arg)
-  "Move up a level of Mim structure forwards
-With ARG, move up that many levels forwards (backwards, ARG < 0)."
-  (interactive "p")
-  (let ((direction (sign (or arg (setq arg 1)))))
-    (while (/= arg 0)
-      (goto-char (or (scan-lists (point) direction 1) (buffer-end arg)))
-      (setq arg (- arg direction)))
-    (if (< direction 0) (backward-prefix-chars))))
-
-(defun backward-up-mim-object (&optional arg)
-  "Move up a level of Mim structure backwards
-With ARG, move up that many levels backwards (forwards, ARG > 0)."
-  (interactive "p")
-  (forward-up-mim-object (if arg (- arg) -1)))
-
-(defun replace-in-mim-object (old new)
-  "Replace string in following Mim object."
-  (interactive "*sReplace in object: \nsReplace %s with: ")
-  (save-restriction
-    (narrow-to-region (point) (save-excursion (forward-mim-object 1) (point)))
-    (replace-string old new)))
-  
-(defun transpose-mim-objects (&optional arg)
-  "Transpose Mim objects around point.
-With ARG, transpose preceding object that many times with following objects.
-A negative ARG will transpose backwards."
-  (interactive "*p")
-  (transpose-subr 'forward-mim-object (or arg 1)))
-
-(defun beginning-of-DEFINE (&optional arg move)
-  "Move backward to beginning of surrounding or previous toplevel Mim form.
-With ARG, do it that many times.  Stops at last toplevel form seen if buffer
-end is reached."
-  (interactive "p")
-  (let ((direction (sign (or arg (setq arg 1)))))
-    (if (not move) (setq move t))
-    (if (< direction 0) (goto-char (1+ (point))))
-    (while (and (/= arg 0) (re-search-backward "^<" nil move direction))
-      (setq arg (- arg direction)))
-    (if (< direction 0)
-	(goto-char (1- (point))))))
-
-(defun end-of-DEFINE (&optional arg)
-  "Move forward to end of surrounding or next toplevel mim form.
-With ARG, do it that many times.  Stops at end of last toplevel form seen
-if buffer end is reached."
-  (interactive "p")
-  (if (not arg) (setq arg 1))
-  (if (< arg 0)
-      (beginning-of-DEFINE (- (1- arg)))
-    (if (not (looking-at "^<")) (setq arg (1+ arg)))
-    (beginning-of-DEFINE (- arg) 'move)
-    (beginning-of-DEFINE 1))
-  (forward-mim-object 1)
-  (forward-line 1))
-
-(defun next-mim-object (&optional arg)
-  "Move to beginning of next toplevel Mim object.
-With ARG, do it that many times.  Stops at last object seen if buffer end
-is reached."
-  (interactive "p")
-  (let ((search-string (if mim-stop-for-slop "^\\S " "^\\s("))
-	(direction (sign (or arg (setq arg 1)))))
-    (if (> direction 0)
-	(goto-char (1+ (point))))		; no error if end of buffer
-    (while (and (/= arg 0)
-		(re-search-forward search-string nil t direction))
-      (setq arg (- arg direction)))
-    (if (> direction 0)
-	(goto-char (1- (point))))		; no error if beginning of buffer
-    ;; scroll to top of window if moving forward and end not visible.
-    (if (not (or (< direction 0)
-		 (save-excursion (forward-mim-object 1)
-				 (pos-visible-in-window-p (point)))))
-	(recenter 0))))
-
-(defun previous-mim-object (&optional arg)
-  "Move to beginning of previous toplevel Mim object.
-With ARG do it that many times.  Stops at last object seen if buffer end
-is reached."
-  (interactive "p")
-  (next-mim-object (- (or arg 1))))
-
-(defun calculate-mim-indent (&optional parse-start)
-  "Calculate indentation for Mim line.  Returns column."
-  (save-excursion			; some excursion, huh, toto?
-    (beginning-of-line)
-    (let ((indent-point (point)) retry state containing-sexp last-sexp
-	  desired-indent start peek where paren-depth)
-      (if parse-start
-	  (goto-char parse-start)	; should be containing environment
-	(catch 'from-the-top
-	  ;; find a place to start parsing.  going backwards is fastest.
-	  ;; forward-sexp signals error on encountering unmatched open.
-	  (setq retry t)
-	  (while retry
-	    (condition-case nil (forward-sexp -1) (error (setq retry nil)))
-	    (if (looking-at ".?[ \t]*\"")
-		;; cant parse backward in presence of strings, go forward.
-		(progn
-		  (goto-char indent-point)
-		  (re-search-backward "^\\s(" nil 'move 1)  ; to top of object
-		  (throw 'from-the-top nil)))
-	    (setq retry (and retry (/= (current-column) 0))))
-	  (skip-chars-backward mim-whitespace)
-	  (if (not (bobp)) (forward-char -1))     ; onto unclosed open
-	  (backward-prefix-chars)))
-      ;; find outermost containing sexp if we started inside an sexp.
-      (while (< (point) indent-point)    
-	(setq state (parse-partial-sexp (point) indent-point 0)))
-      ;; find usual column to indent under (not in string or toplevel).
-      ;; on termination, state will correspond to containing environment
-      ;; (if retry is nil), where will be position of character to indent
-      ;; under normally, and desired-indent will be the column to indent to
-      ;; except if inside form, string, or at toplevel.  point will be in
-      ;; in column to indent to unless inside string.
-      (setq retry t)
-      (while (and retry (setq paren-depth (car state)) (> paren-depth 0))
-	;; find innermost containing sexp.
-	(setq retry nil)
-	(setq last-sexp (car (nthcdr 2 state)))
-	(setq containing-sexp (car (cdr state)))
-	(goto-char (1+ containing-sexp))	  ; to last unclosed open
-	(if (and last-sexp (> last-sexp (point)))
-	    ;; is the last sexp a containing sexp?
-	    (progn (setq peek (parse-partial-sexp last-sexp indent-point 0))
-		   (if (setq retry (car (cdr peek))) (setq state peek))))
-	(if retry
-	    nil
-	  (setq where (1+ containing-sexp))   ; innermost containing sexp
-	  (goto-char where)
-	  (cond
-	   ((not last-sexp)		      ; indent-point after bracket
-	    (setq desired-indent (current-column)))
-	   ((= (preceding-char) ?\<)	      ; it's a form
-	    (cond ((> (progn (forward-sexp 1) (point)) last-sexp)
-		   (goto-char where))	      ; only one frob
-		  ((> (save-excursion (forward-line 1) (point)) last-sexp)
-		   (skip-chars-forward " \t") ; last-sexp is on same line
-		   (setq where (point)))	      ; as containing-sexp
-		  ((progn
-		     (goto-char last-sexp)
-		     (beginning-of-line)
-		     (parse-partial-sexp (point) last-sexp 0 t)
-		     (or (= (point) last-sexp)
-			 (save-excursion
-			   (= (car (parse-partial-sexp (point) last-sexp 0))
-			      0))))
-		   (backward-prefix-chars)    ; last-sexp 1st on line or 1st
-		   (setq where (point)))        ; frob on that line level 0
-		  (t (goto-char where))))     ; punt, should never occur
-	   ((and indent-mim-arglist	      ; maybe hack arglist    
-		 (= (preceding-char) ?\()     ; its a list
-		 (save-excursion	      ; look for magic atoms
-		   (setq peek 0)	      ; using peek as counter
-		   (forward-char -1)	      ; back over containing paren
-		   (while (and (< (setq peek (1+ peek)) 6)
-			       (condition-case nil
-				   (progn (forward-sexp -1) t)
-				 (error nil))))
-		   (and (< peek 6) (looking-at "DEFINE\\|DEFMAC\\|FUNCTION"))))
-	    ;; frobs stack under strings they belong to or under first
-	    ;; frob to right of strings they belong to unless luser has
-	    ;; frob (non-string) on preceding line with different
-	    ;; indentation.  strings stack under start of arglist unless
-	    ;; mim-indent-arglist is not t, in which case they stack
-	    ;; under the last string, if any, else the start of the arglist.
-	    (let ((eol 0) last-string)
-	      (while (< (point) last-sexp)      ; find out where the strings are
-		(skip-chars-forward mim-whitespace last-sexp)		
-		(if (> (setq start (point)) eol)
-		    (progn                    ; simultaneously keeping track
-		      (setq where (min where start))
-		      (end-of-line)	      ; of indentation of first frob
-		      (setq eol (point))	      ; on each line
-		      (goto-char start)))
-		(if (= (following-char) ?\")
-		    (progn (setq last-string (point))
-			   (forward-sexp 1)
-			   (if (= last-string last-sexp)
-			       (setq where last-sexp)
-			     (skip-chars-forward mim-whitespace last-sexp)
-			     (setq where (point))))
-		  (forward-sexp 1)))
-	      (goto-char indent-point)	           ; if string is first on
-	      (skip-chars-forward " \t" (point-max)) ; line we are indenting, it 
-	      (if (= (following-char) ?\")         ; goes under arglist start
-		  (if (and last-string (not (equal indent-mim-arglist t)))
-		      (setq where last-string)     ; or under last string.
-		    (setq where (1+ containing-sexp)))))
-	    (goto-char where)
-	    (setq desired-indent (current-column)))
-	   (t				      ; plain vanilla structure
-	    (cond ((> (save-excursion (forward-line 1) (point)) last-sexp)
-		   (skip-chars-forward " \t") ; last-sexp is on same line
-		   (setq where (point)))	      ; as containing-sexp
-		  ((progn
-		     (goto-char last-sexp)
-		     (beginning-of-line)
-		     (parse-partial-sexp (point) last-sexp 0 t)
-		     (or (= (point) last-sexp)
-			 (save-excursion
-			   (= (car (parse-partial-sexp (point) last-sexp 0))
-			      0))))
-		     (backward-prefix-chars)  ; last-sexp 1st on line or 1st
-		     (setq where (point)))      ; frob on that line level 0
-		  (t (goto-char where)))      ; punt, should never occur
-	    (setq desired-indent (current-column))))))
-      ;; state is innermost containing environment unless toplevel or string.
-      (if (car (nthcdr 3 state))	      ; inside string
-	  (progn
-	    (if last-sexp		      ; string must be next
-		(progn (goto-char last-sexp)
-		       (forward-sexp 1)
-		       (search-forward "\"")
-		       (forward-char -1))
-	      (goto-char indent-point)	      ; toplevel string, look for it
-	      (re-search-backward "[^\\]\"")
-	      (forward-char 1))
-	    (setq start (point))		      ; opening double quote
-	    (skip-chars-backward " \t")
-	    (backward-prefix-chars)
-	    ;; see if the string is really a comment.
-       	    (if (and (looking-at ";[ \t]*\"") indent-mim-comment)
-		;; it's a comment, line up under the start unless disabled.
-		(goto-char (1+ start))
-	      ;; it's a string, dont mung the indentation.
-	      (goto-char indent-point)
-	      (skip-chars-forward " \t"))
-	    (setq desired-indent (current-column))))
-      ;; point is sitting in usual column to indent to and if retry is nil
-      ;; then state corresponds to containing environment.  if desired
-      ;; indentation not determined, we are inside a form, so call hook.
-      (or desired-indent
-	  (and indent-mim-function
-	       (not retry)
-	       (setq desired-indent
-		     (funcall indent-mim-function state indent-point)))
-	  (setq desired-indent (current-column)))
-      (goto-char indent-point)		; back to where we started
-      desired-indent)))			; return column to indent to
-
-(defun indent-mim-function (state indent-point)
-  "Compute indentation for Mim special forms.  Returns column or nil."
-  (let ((containing-sexp (car (cdr state))) (current-indent (point)))
-    (save-excursion
-      (goto-char (1+ containing-sexp))
-      (backward-prefix-chars)
-      ;; make sure we are looking at a symbol.  if so, see if it is a special
-      ;; symbol.  if so, add the special indentation to the indentation of
-      ;; the start of the special symbol, unless the property is not
-      ;; an integer and not nil (in this case, call the property, it must
-      ;; be a function which returns the appropriate indentation or nil and
-      ;; does not change the buffer).
-      (if (looking-at "\\sw\\|\\s_")
-	  (let* ((start (current-column))
-		 (function
-		  (intern-soft (buffer-substring (point)
-						 (progn (forward-sexp 1)
-							(point)))))
-		 (method (get function 'indent-mim-function)))
-	    (if (or (if (equal method 'DEFINE) (setq method mim-body-indent))
-		    (integerp method))
-		;; only use method if its first line after containing-sexp.
-		;; we could have done this in calculate-mim-indent, but someday
-		;; someone might want to format frobs in a special form based
-		;; on position instead of indenting uniformly (like lisp if),
-		;; so preserve right for posterity.  if not first line,
-		;; calculate-mim-indent already knows right indentation -
-		;; give luser chance to change indentation manually by changing
-		;; 1st line after containing-sexp.
-		(if (> (progn (forward-line 1) (point)) (car (nthcdr 2 state)))
-		    (+ method start))
-	      (goto-char current-indent)
-	      (if (consp method)
-		  ;; list or pointed list of explicit indentations
-		  (indent-mim-offset state indent-point)
-		(if (and (symbolp method) (fboundp method))
-		    ;; luser function - s/he better know what's going on.
-		    ;; should take state and indent-point as arguments - for
-		    ;; description of state, see parse-partial-sexp
-		    ;; documentation the function is guaranteed the following:
-		    ;; (1) state describes the closest surrounding form,
-		    ;; (2) indent-point is the beginning of the line being
-		    ;; indented, (3) point points to char in column that would
-		    ;; normally be used for indentation, (4) function is bound
-		    ;; to the special ATOM.  See indent-mim-offset for example
-		    ;; of a special function.
-		    (funcall method state indent-point)))))))))
-
-(defun indent-mim-offset (state indent-point)
-  ;; offset forms explicitly according to list of indentations.
-  (let ((mim-body-indent mim-body-indent)
-	(indentations (get function 'indent-mim-function))
-	(containing-sexp (car (cdr state)))
-	(last-sexp (car (nthcdr 2 state)))
-	indentation)
-    (goto-char (1+ containing-sexp))
-    ;; determine which of the indentations to use.
-    (while (and (< (point) indent-point)
-		(condition-case nil
-		    (progn (forward-sexp 1)
-			   (parse-partial-sexp (point) indent-point 1 t))
-		  (error nil)))
-      (skip-chars-backward " \t")
-      (backward-prefix-chars)
-      (if (= (following-char) ?\;)
-	  nil					    ; ignore comments
-	(setq indentation (car indentations))
-	(if (integerp (setq indentations (cdr indentations)))
-	    ;; if last cdr is integer, that is indentation to use for all
-	    ;; all the rest of the forms.
-	    (progn (setq mim-body-indent indentations)
-		   (setq indentations nil)))))
-    (goto-char (1+ containing-sexp))
-    (+ (current-column) (or indentation mim-body-indent))))
-
-(defun indent-mim-comment (&optional start)
-  "Indent a one line (string) Mim comment following object, if any."
-  (let* ((old-point (point)) (eol (progn (end-of-line) (point))) state last-sexp)
-    ;; this function assumes that comment indenting is enabled.  it is caller's
-    ;; responsibility to check the indent-mim-comment flag before calling.
-    (beginning-of-line)
-    (catch 'no-comment
-      (setq state (parse-partial-sexp (point) eol))
-      ;; determine if there is an existing regular comment.  a `regular'
-      ;; comment is defined as a commented string which is the last thing
-      ;; on the line and does not extend beyond the end of the line.
-      (if (or (not (setq last-sexp (car (nthcdr 2 state))))
-	      (car (nthcdr 3 state)))
-	  ;; empty line or inside string (multiple line).
-	  (throw 'no-comment nil))	
-      ;; could be a comment, but make sure its not the only object.
-      (beginning-of-line)
-      (parse-partial-sexp (point) eol 0 t)
-      (if (= (point) last-sexp)
-	  ;; only one object on line
-	  (throw 'no-comment t))
-      (goto-char last-sexp)
-      (skip-chars-backward " \t")
-      (backward-prefix-chars)
-      (if (not (looking-at ";[ \t]*\""))
-	  ;; aint no comment
-	  (throw 'no-comment nil))
-      ;; there is an existing regular comment
-      (delete-horizontal-space)
-      ;; move it to comment-column if possible else to tab-stop
-      (if (< (current-column) comment-column)
-	  (indent-to comment-column)
-	(tab-to-tab-stop)))
-    (goto-char old-point)))
-	
-(defun indent-mim-line ()
-  "Indent line of Mim code."
-  (interactive "*")
-  (let* ((position (- (point-max) (point)))
-	 (bol (progn (beginning-of-line) (point)))
-	 (indent (calculate-mim-indent)))
-    (skip-chars-forward " \t")
-    (if (/= (current-column) indent)
-	(progn (delete-region bol (point)) (indent-to indent)))
-    (if (> (- (point-max) position) (point)) (goto-char (- (point-max) position)))))
-
-(defun newline-and-mim-indent ()
-  "Insert newline at point and indent."
-  (interactive "*")
-  ;; commented code would correct indentation of line in arglist which
-  ;; starts with string, but it would indent every line twice.  luser can
-  ;; just say tab after typing string to get same effect.
-  ;(if indent-mim-arglist (indent-mim-line))
-  (newline)
-  (indent-mim-line))
-
-(defun open-mim-line (&optional lines)
-  "Insert newline before point and indent.
-With ARG insert that many newlines."
-  (interactive "*p")
-  (beginning-of-line)
-  (let ((indent (calculate-mim-indent)))
-    (while (> lines 0)
-      (newline)
-      (forward-line -1)
-      (indent-to indent)
-      (setq lines (1- lines)))))
-
-(defun indent-mim-object (&optional dont-indent-first-line)
-  "Indent object following point and all lines contained inside it.
-With ARG, idents only contained lines (skips first line)."
-  (interactive "*P")
-  (let (end bol indent start)
-    (save-excursion (parse-partial-sexp (point) (point-max) 0 t)
-		    (setq start (point))
-		    (forward-sexp 1)
-		    (setq end (- (point-max) (point))))
-    (save-excursion
-      (if (not dont-indent-first-line) (indent-mim-line))
-      (while (progn (forward-line 1) (> (- (point-max) (point)) end))
-	(setq indent (calculate-mim-indent start))
-	(setq bol (point))
-	(skip-chars-forward " \t")
-	(if (/= indent (current-column))
-	    (progn (delete-region bol (point)) (indent-to indent)))
-	(if indent-mim-comment (indent-mim-comment))))))
-  
-(defun find-mim-definition (name)
-  "Search for definition of function, macro, or gfcn.
-You need type only enough of the name to be unambiguous."
-  (interactive "sName: ")
-  (let (where)
-    (save-excursion
-      (goto-char (point-min))
-      (condition-case nil
-	  (progn
-	    (re-search-forward
-	     (concat "^<\\(DEFINE\\|\\DEFMAC\\|FCN\\|GFCN\\)\\([ \t]*\\)"
-		     name))
-	    (setq where (point)))
-	(error (error "Can't find %s" name))))
-    (if where
-	(progn (push-mark)
-	       (goto-char where)
-	       (beginning-of-line)
-	       (recenter 0)))))
-    
-(defun begin-mim-comment ()
-  "Move to existing comment or insert empty comment."
-  (interactive "*")
-  (let* ((eol (progn (end-of-line) (point)))
-	 (bol (progn (beginning-of-line) (point))))
-    ;; check for existing comment first.
-    (if (re-search-forward ";[ \t]*\"" eol t)
-	;; found it.  indent if desired and go there.
-	(if indent-mim-comment
-	    (let ((where (- (point-max) (point))))
-	      (indent-mim-comment)
-	      (goto-char (- (point-max) where))))
-      ;; nothing there, make a comment.
-      (let (state last-sexp)
-	;; skip past all the sexps on the line
-	(goto-char bol)
-	(while (and (equal (car (setq state (parse-partial-sexp (point) eol 0)))
-			   0)
-		    (car (nthcdr 2 state)))
-	  (setq last-sexp (car (nthcdr 2 state))))
-	(if (car (nthcdr 3 state))
-	    nil					    ; inside a string, punt
-      (delete-region (point) eol)			    ; flush trailing whitespace
-      (if (and (not last-sexp) (equal (car state) 0))
-	  (indent-to (calculate-mim-indent))	    ; empty, indent like code
-	(if (> (current-column) comment-column)	    ; indent to comment column
-	    (tab-to-tab-stop)			    ; unless past it, else to
-	  (indent-to comment-column)))		    ; tab-stop
-      ;; if luser changes comment-{start end} to something besides semi
-      ;; followed by zero or more whitespace characters followed by string
-      ;; delimiters, the code above fails to find existing comments, but as
-      ;; taa says, `let the losers lose'.
-      (insert comment-start)
-      (save-excursion (insert comment-end)))))))
-
-(defun skip-mim-whitespace (direction)
-  (if (>= direction 0)
-      (skip-chars-forward mim-whitespace (point-max))
-    (skip-chars-backward mim-whitespace (point-min))))
-
-(defun inside-adecl-or-trailer-p (direction)
-  (if (>= direction 0)
-      (looking-at ":\\|!-")
-    (or (= (preceding-char) ?:)
-	(looking-at "!-"))))
-		  
-(defun sign (n)
-  "Returns -1 if N < 0, else 1."
-  (if (>= n 0) 1 -1))
-
-(defun abs (n)
-  "Returns the absolute value of N."
-  (if (>= n 0) n (- n)))
-
-(defun next-char (direction)
-  "Returns preceding-char if DIRECTION < 0, otherwise following-char."
-  (if (>= direction 0) (following-char) (preceding-char)))
-
-(provide 'mim-mode)
-
-;;; mim-mode.el ends here
diff --git a/lisp/=mim-syntax.el b/lisp/=mim-syntax.el
deleted file mode 100644
index beb8d330a35..00000000000
--- a/lisp/=mim-syntax.el
+++ /dev/null
@@ -1,95 +0,0 @@
-;;; mim-syntax.el --- syntax checker for Mim (MDL).
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; Maintainer: FSF
-;; Keywords: languages
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(require 'mim-mode)
-
-(defun slow-syntax-check-mim ()
-  "Check Mim syntax slowly.
-Points out the context of the error, if the syntax is incorrect."
-  (interactive)
-  (message "checking syntax...")
-  (let ((stop (point-max)) point-stack current last-bracket whoops last-point)
-    (save-excursion
-      (goto-char (point-min))
-      (while (and (not whoops)
-		  (re-search-forward "\\s(\\|\\s)\\|\"\\|[\\]" stop t))
-	(setq current (preceding-char))
-	(cond ((= current ?\")
-	       (condition-case nil
-		   (progn (re-search-forward "[^\\]\"")
-			  (setq current nil))
-		 (error (setq whoops (point)))))
-	      ((= current ?\\)
-	       (condition-case nil (forward-char 1) (error nil)))
-	      ((= (char-syntax current) ?\))
-	       (if (or (not last-bracket)
-		       (not (= (logand (lsh (aref (syntax-table) last-bracket) -8)
-				       ?\177)
-			       current)))
-		   (setq whoops (point))
-		 (setq last-point (car point-stack))
-		 (setq last-bracket (if last-point (char-after (1- last-point))))
-		 (setq point-stack (cdr point-stack))))
-	      (t
-	       (if last-point (setq point-stack (cons last-point point-stack)))
-	       (setq last-point (point))
-	       (setq last-bracket current)))))
-    (cond ((not (or whoops last-point))
-	   (message "Syntax correct"))
-	  (whoops
-	   (goto-char whoops)
-	   (cond ((equal current ?\")
-		  (error "Unterminated string"))
-		 ((not last-point)
-		  (error "Extraneous %s" (char-to-string current)))
-		 (t
-		  (error "Mismatched %s with %s"
-			   (save-excursion
-			     (setq whoops (1- (point)))
-			     (goto-char (1- last-point))
-			     (buffer-substring (point)
-					       (min (progn (end-of-line) (point))
-						    whoops)))
-			   (char-to-string current)))))
-	  (t
-	   (goto-char last-point)
-	   (error "Unmatched %s" (char-to-string last-bracket))))))
-      
-(defun fast-syntax-check-mim ()
-  "Checks Mim syntax quickly.
-Answers correct or incorrect, cannot point out the error context."
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (let (state)
-      (while (and (not (eobp))
-		  (equal (car (setq state (parse-partial-sexp (point) (point-max) 0)))
-			 0)))
-      (if (equal (car state) 0)
-	  (message "Syntax correct")
-	(error "Syntax incorrect")))))
-
-;;; mim-syntax.el ends here
diff --git a/lisp/=netunam.el b/lisp/=netunam.el
deleted file mode 100644
index 492ac9b2c12..00000000000
--- a/lisp/=netunam.el
+++ /dev/null
@@ -1,160 +0,0 @@
-;;; netunam.el --- HP-UX RFA Commands
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Chris Hanson <cph@zurich.ai.mit.edu>
-;; Keywords: comm
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Use the Remote File Access (RFA) facility of HP-UX from Emacs.
-
-;;; Code:
-
-(defconst rfa-node-directory "/net/"
-  "Directory in which RFA network special files are stored.
-By HP convention, this is \"/net/\".")
-
-(defvar rfa-default-node nil
-  "If not nil, this is the name of the default RFA network special file.")
-
-(defvar rfa-password-memoize-p t
-  "If non-nil, remember login user's passwords after they have been entered.")
-
-(defvar rfa-password-alist '()
-  "An association from node-name strings to password strings.
-Used if `rfa-password-memoize-p' is non-nil.")
-
-(defvar rfa-password-per-node-p t
-  "If nil, login user uses same password on all machines.
-Has no effect if `rfa-password-memoize-p' is nil.")
-
-(defun rfa-set-password (password &optional node user)
-  "Add PASSWORD to the RFA password database.
-Optional second arg NODE is a string specifying a particular nodename;
- if supplied and not nil, PASSWORD applies to only that node.
-Optional third arg USER is a string specifying the (remote) user whose
- password this is; if not supplied this defaults to (user-login-name)."
-  (if (not user) (setq user (user-login-name)))
-  (let ((node-entry (assoc node rfa-password-alist)))
-    (if node-entry
-	(let ((user-entry (assoc user (cdr node-entry))))
-	  (if user-entry
-	      (rplacd user-entry password)
-	      (rplacd node-entry
-		      (nconc (cdr node-entry)
-			     (list (cons user password))))))
-	(setq rfa-password-alist
-	      (nconc rfa-password-alist
-		     (list (list node (cons user password))))))))
-
-(defun rfa-open (node &optional user password)
-  "Open a network connection to a server using remote file access.
-First argument NODE is the network node for the remote machine.
-Second optional argument USER is the user name to use on that machine.
-  If called interactively, the user name is prompted for.
-Third optional argument PASSWORD is the password string for that user.
-  If not given, this is filled in from the value of
-`rfa-password-alist', or prompted for.  A prefix argument of - will
-cause the password to be prompted for even if previously memoized."
-  (interactive
-   (list (read-file-name "rfa-open: " rfa-node-directory rfa-default-node t)
-	 (read-string "user-name: " (user-login-name))))
-  (let ((node
-	 (and (or rfa-password-per-node-p
-		  (not (equal user (user-login-name))))
-	      node)))
-    (if (not password)
-	(setq password
-	      (let ((password
-		     (cdr (assoc user (cdr (assoc node rfa-password-alist))))))
-		(or (and (not current-prefix-arg) password)
-		    (rfa-password-read
-		     (format "password for user %s%s: "
-			     user
-			     (if node (format " on node \"%s\"" node) ""))
-		     password))))))
-  (let ((result
-	 (sysnetunam (expand-file-name node rfa-node-directory)
-		     (concat user ":" password))))
-    (if (interactive-p)
-	(if result
-	    (message "Opened network connection to %s as %s" node user)
-	    (error "Unable to open network connection")))
-    (if (and rfa-password-memoize-p result)
-	(rfa-set-password password node user))
-    result))
-
-(defun rfa-close (node)
-  "Close a network connection to a server using remote file access.
-NODE is the network node for the remote machine."
-  (interactive
-   (list (read-file-name "rfa-close: " rfa-node-directory rfa-default-node t)))
-  (let ((result (sysnetunam (expand-file-name node rfa-node-directory) "")))
-    (cond ((not (interactive-p)) result)
-	  ((not result) (error "Unable to close network connection"))
-	  (t (message "Closed network connection to %s" node)))))
-
-(defun rfa-password-read (prompt default)
-  (let ((rfa-password-accumulator (or default "")))
-    (read-from-minibuffer prompt
-			  (and default
-			       (let ((copy (concat default))
-				     (index 0)
-				     (length (length default)))
-				 (while (< index length)
-				   (aset copy index ?.)
-				   (setq index (1+ index)))
-				 copy))
-			  rfa-password-map)
-    rfa-password-accumulator))
-
-(defvar rfa-password-map nil)
-(if (not rfa-password-map)
-    (let ((char ? ))
-      (setq rfa-password-map (make-keymap))
-      (while (< char 127)
-	(define-key rfa-password-map (char-to-string char)
-	  'rfa-password-self-insert)
-	(setq char (1+ char)))
-      (define-key rfa-password-map "\C-g"
-	'abort-recursive-edit)
-      (define-key rfa-password-map "\177"
-	'rfa-password-rubout)
-      (define-key rfa-password-map "\n"
-	'exit-minibuffer)
-      (define-key rfa-password-map "\r"
-	'exit-minibuffer)))
-
-(defvar rfa-password-accumulator nil)
-
-(defun rfa-password-self-insert ()
-  (interactive)
-  (setq rfa-password-accumulator
-	(concat rfa-password-accumulator
-		(char-to-string last-command-char)))
-  (insert ?.))
-
-(defun rfa-password-rubout ()
-  (interactive)
-  (delete-char -1)
-  (setq rfa-password-accumulator
-	(substring rfa-password-accumulator 0 -1)))
-
-;;; netunam.el ends here
diff --git a/lisp/=nnspool.el b/lisp/=nnspool.el
deleted file mode 100644
index 72cc48bbb5a..00000000000
--- a/lisp/=nnspool.el
+++ /dev/null
@@ -1,409 +0,0 @@
-;;; nnspool.el --- spool access using NNTP for GNU Emacs
-
-;; Copyright (C) 1988, 1989, 1990, 1993 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(require 'nntp)
-
-(defvar nnspool-inews-program news-inews-program
-  "*Program to post news.")
-
-(defvar nnspool-inews-switches '("-h")
-  "*Switches for nnspool-request-post to pass to `inews' for posting news.")
-
-(defvar nnspool-spool-directory news-path
-  "*Local news spool directory.")
-
-(defvar nnspool-active-file "/usr/lib/news/active"
-  "*Local news active file.")
-
-(defvar nnspool-newsgroups-file "/usr/lib/news/newsgroups"
-  "*Local news newsgroups file.")
-
-(defvar nnspool-distributions-file "/usr/lib/news/distributions"
-  "*Local news distributions file.")
-
-(defvar nnspool-history-file "/usr/lib/news/history"
-  "*Local news history file.")
-
-
-
-(defconst nnspool-version "NNSPOOL 1.12"
-  "Version numbers of this version of NNSPOOL.")
-
-(defvar nnspool-current-directory nil
-  "Current news group directory.")
-
-;;;
-;;; Replacement of Extended Command for retrieving many headers.
-;;;
-
-(defun nnspool-retrieve-headers (sequence)
-  "Return list of article headers specified by SEQUENCE of article id.
-The format of list is
- `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
-If there is no References: field, In-Reply-To: field is used instead.
-Reader macros for the vector are defined as `nntp-header-FIELD'.
-Writer macros for the vector are defined as `nntp-set-header-FIELD'.
-Newsgroup must be selected before calling this."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    ;;(erase-buffer)
-    (let ((file nil)
-	  (number (length sequence))
-	  (count 0)
-	  (headers nil)			;Result list.
-	  (article 0)
-	  (subject nil)
-	  (message-id nil)
-	  (from nil)
-	  (xref nil)
-	  (lines 0)
-	  (date nil)
-	  (references nil))
-      (while sequence
-	;;(nntp-send-strings-to-server "HEAD" (car sequence))
-	(setq article (car sequence))
-	(setq file
-	      (concat nnspool-current-directory (prin1-to-string article)))
-	(if (and (file-exists-p file)
-		 (not (file-directory-p file)))
-	    (progn
-	      (erase-buffer)
-	      (insert-file-contents file)
-	      ;; Make message body invisible.
-	      (goto-char (point-min))
-	      (search-forward "\n\n" nil 'move)
-	      (narrow-to-region (point-min) (point))
-	      ;; Fold continuation lines.
-	      (goto-char (point-min))
-	      (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
-		(replace-match " " t t))
-	      ;; Make it possible to search for `\nFIELD'.
-	      (goto-char (point-min))
-	      (insert "\n")
-	      ;; Extract From:
-	      (goto-char (point-min))
-	      (if (search-forward "\nFrom: " nil t)
-		  (setq from (buffer-substring
-			      (point)
-			      (save-excursion (end-of-line) (point))))
-		(setq from "(Unknown User)"))
-	      ;; Extract Subject:
-	      (goto-char (point-min))
-	      (if (search-forward "\nSubject: " nil t)
-		  (setq subject (buffer-substring
-				 (point)
-				 (save-excursion (end-of-line) (point))))
-		(setq subject "(None)"))
-	      ;; Extract Message-ID:
-	      (goto-char (point-min))
-	      (if (search-forward "\nMessage-ID: " nil t)
-		  (setq message-id (buffer-substring
-				    (point)
-				    (save-excursion (end-of-line) (point))))
-		(setq message-id nil))
-	      ;; Extract Date:
-	      (goto-char (point-min))
-	      (if (search-forward "\nDate: " nil t)
-		  (setq date (buffer-substring
-			      (point)
-			      (save-excursion (end-of-line) (point))))
-		(setq date nil))
-	      ;; Extract Lines:
-	      (goto-char (point-min))
-	      (if (search-forward "\nLines: " nil t)
-		  (setq lines (string-to-int
-			       (buffer-substring
-				(point)
-				(save-excursion (end-of-line) (point)))))
-		(setq lines 0))
-	      ;; Extract Xref:
-	      (goto-char (point-min))
-	      (if (search-forward "\nXref: " nil t)
-		  (setq xref (buffer-substring
-			      (point)
-			      (save-excursion (end-of-line) (point))))
-		(setq xref nil))
-	      ;; Extract References:
-	      ;; If no References: field, use In-Reply-To: field instead.
-	      (goto-char (point-min))
-	      (if (or (search-forward "\nReferences: " nil t)
-		      (search-forward "\nIn-Reply-To: " nil t))
-		  (setq references (buffer-substring
-				    (point)
-				    (save-excursion (end-of-line) (point))))
-		(setq references nil))
-	      ;; Collect valid article only.
-	      (and article
-		   message-id
-		   (setq headers
-			 (cons (vector article subject from
-				       xref lines date
-				       message-id references) headers)))
-	      ))
-	(setq sequence (cdr sequence))
-	(setq count (1+ count))
-	(and (numberp nntp-large-newsgroup)
-	     (> number nntp-large-newsgroup)
-	     (zerop (% count 20))
-	     (message "NNSPOOL: Receiving headers... %d%%"
-		      (/ (* count 100) number)))
-	)
-      (and (numberp nntp-large-newsgroup)
-	   (> number nntp-large-newsgroup)
-	   (message "NNSPOOL: Receiving headers... done"))
-      (nreverse headers)
-      )))
-
-
-;;;
-;;; Replacement of NNTP Raw Interface.
-;;;
-
-(defun nnspool-open-server (host &optional service)
-  "Open news server on HOST.
-If HOST is nil, use value of environment variable `NNTPSERVER'.
-If optional argument SERVICE is non-nil, open by the service name."
-  (let ((host (or host (getenv "NNTPSERVER")))
-	(status nil))
-    (setq nntp-status-string "")
-    (cond ((and (file-directory-p nnspool-spool-directory)
-		(file-exists-p nnspool-active-file)
-		(string-equal host (system-name)))
-	   (setq status (nnspool-open-server-internal host service)))
-	  ((string-equal host (system-name))
-	   (setq nntp-status-string
-		 (format "%s has no news spool.  Goodbye." host)))
-	  ((null host)
-	   (setq nntp-status-string "NNTP server is not specified."))
-	  (t
-	   (setq nntp-status-string
-		 (format "NNSPOOL: cannot talk to %s." host)))
-	  )
-    status
-    ))
-
-(defun nnspool-close-server ()
-  "Close news server."
-  (nnspool-close-server-internal))
-
-(fset 'nnspool-request-quit (symbol-function 'nnspool-close-server))
-
-(defun nnspool-server-opened ()
-  "Return server process status, T or NIL.
-If the stream is opened, return T, otherwise return NIL."
-  (and nntp-server-buffer
-       (get-buffer nntp-server-buffer)))
-
-(defun nnspool-status-message ()
-  "Return server status response as string."
-  nntp-status-string
-  )
-
-(defun nnspool-request-article (id)
-  "Select article by message ID (or number)."
-  (let ((file (if (stringp id)
-		  (nnspool-find-article-by-message-id id)
-		(concat nnspool-current-directory (prin1-to-string id)))))
-    (if (and (stringp file)
-	     (file-exists-p file)
-	     (not (file-directory-p file)))
-	(save-excursion
-	  (nnspool-find-file file)))
-    ))
-
-(defun nnspool-request-body (id)
-  "Select article body by message ID (or number)."
-  (if (nnspool-request-article id)
-      (save-excursion
-	(set-buffer nntp-server-buffer)
-	(goto-char (point-min))
-	(if (search-forward "\n\n" nil t)
-	    (delete-region (point-min) (point)))
-	t
-	)
-    ))
-
-(defun nnspool-request-head (id)
-  "Select article head by message ID (or number)."
-  (if (nnspool-request-article id)
-      (save-excursion
-	(set-buffer nntp-server-buffer)
-	(goto-char (point-min))
-	(if (search-forward "\n\n" nil t)
-	    (delete-region (1- (point)) (point-max)))
-	t
-	)
-    ))
-
-(defun nnspool-request-stat (id)
-  "Select article by message ID (or number)."
-  (setq nntp-status-string "NNSPOOL: STAT is not implemented.")
-  nil
-  )
-
-(defun nnspool-request-group (group)
-  "Select news GROUP."
-  (let ((pathname (nnspool-article-pathname
-		   (nnspool-replace-chars-in-string group ?. ?/))))
-    (if (file-directory-p pathname)
-	(setq nnspool-current-directory pathname))
-    ))
-
-(defun nnspool-request-list ()
-  "List active newsgoups."
-  (save-excursion
-    (nnspool-find-file nnspool-active-file)))
-
-(defun nnspool-request-list-newsgroups ()
-  "List newsgroups (defined in NNTP2)."
-  (save-excursion
-    (nnspool-find-file nnspool-newsgroups-file)))
-
-(defun nnspool-request-list-distributions ()
-  "List distributions (defined in NNTP2)."
-  (save-excursion
-    (nnspool-find-file nnspool-distributions-file)))
-
-(defun nnspool-request-last ()
-  "Set current article pointer to the previous article
-in the current news group."
-  (setq nntp-status-string "NNSPOOL: LAST is not implemented.")
-  nil
-  )
-
-(defun nnspool-request-next ()
-  "Advance current article pointer."
-  (setq nntp-status-string "NNSPOOL: NEXT is not implemented.")
-  nil
-  )
-
-(defun nnspool-request-post ()
-  "Post a new news in current buffer."
-  (save-excursion
-    ;; We have to work in the server buffer because of NEmacs hack.
-    (copy-to-buffer nntp-server-buffer (point-min) (point-max))
-    (set-buffer nntp-server-buffer)
-    (apply (function call-process-region)
-	   (point-min) (point-max)
-	   nnspool-inews-program 'delete t nil nnspool-inews-switches)
-    (prog1
-	(or (zerop (buffer-size))
-	    ;; If inews returns strings, it must be error message 
-	    ;;  unless SPOOLNEWS is defined.  
-	    ;; This condition is very weak, but there is no good rule 
-	    ;;  identifying errors when SPOOLNEWS is defined.  
-	    ;; Suggested by ohm@kaba.junet.
-	    (string-match "spooled" (buffer-string)))
-      ;; Make status message by unfolding lines.
-      (subst-char-in-region (point-min) (point-max) ?\n ?\\ 'noundo)
-      (setq nntp-status-string (buffer-string))
-      (erase-buffer))
-    ))
-
-
-;;;
-;;; Replacement of Low-Level Interface to NNTP Server.
-;;; 
-
-(defun nnspool-open-server-internal (host &optional service)
-  "Open connection to news server on HOST by SERVICE (default is nntp)."
-  (save-excursion
-    (if (not (string-equal host (system-name)))
-	(error "NNSPOOL: cannot talk to %s." host))
-    ;; Initialize communication buffer.
-    (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
-    (set-buffer nntp-server-buffer)
-    (buffer-flush-undo (current-buffer))
-    (erase-buffer)
-    (kill-all-local-variables)
-    (setq case-fold-search t)		;Should ignore case.
-    (setq nntp-server-process nil)
-    (setq nntp-server-name host)
-    ;; It is possible to change kanji-fileio-code in this hook.
-    (run-hooks 'nntp-server-hook)
-    t
-    ))
-
-(defun nnspool-close-server-internal ()
-  "Close connection to news server."
-  (if (get-file-buffer nnspool-history-file)
-      (kill-buffer (get-file-buffer nnspool-history-file)))
-  (if nntp-server-buffer
-      (kill-buffer nntp-server-buffer))
-  (setq nntp-server-buffer nil)
-  (setq nntp-server-process nil))
-
-(defun nnspool-find-article-by-message-id (id)
-  "Return full pathname of an article identified by message-ID."
-  (save-excursion
-    (let ((buffer (get-file-buffer nnspool-history-file)))
-      (if buffer
-	  (set-buffer buffer)
-	;; Finding history file may take lots of time.
-	(message "Reading history file...")
-	(set-buffer (find-file-noselect nnspool-history-file))
-	(message "Reading history file... done")))
-    ;; Search from end of the file. I think this is much faster than
-    ;; do from the beginning of the file.
-    (goto-char (point-max))
-    (if (re-search-backward
-	 (concat "^" (regexp-quote id)
-		 "[ \t].*[ \t]\\([^ \t/]+\\)/\\([0-9]+\\)[ \t]*$") nil t)
-	(let ((group (buffer-substring (match-beginning 1) (match-end 1)))
-	      (number (buffer-substring (match-beginning 2) (match-end 2))))
-	  (concat (nnspool-article-pathname
-		   (nnspool-replace-chars-in-string group ?. ?/))
-		  number))
-      )))
-
-(defun nnspool-find-file (file)
-  "Insert FILE in server buffer safely."
-  (set-buffer nntp-server-buffer)
-  (erase-buffer)
-  (condition-case ()
-      (progn (insert-file-contents file) t)
-    (file-error nil)
-    ))
-
-(defun nnspool-article-pathname (group)
-  "Make pathname for GROUP."
-  (concat (file-name-as-directory nnspool-spool-directory) group "/"))
-
-(defun nnspool-replace-chars-in-string (string from to)
-  "Replace characters in STRING from FROM to TO."
-  (let ((string (substring string 0))	;Copy string.
-	(len (length string))
-	(idx 0))
-    ;; Replace all occurrences of FROM with TO.
-    (while (< idx len)
-      (if (= (aref string idx) from)
-	  (aset string idx to))
-      (setq idx (1+ idx)))
-    string
-    ))
-
-(provide 'nnspool)
-
-;;; nnspool.el ends here
diff --git a/lisp/=nntp.el b/lisp/=nntp.el
deleted file mode 100644
index 1c3f0705f44..00000000000
--- a/lisp/=nntp.el
+++ /dev/null
@@ -1,698 +0,0 @@
-;;; nntp.el --- NNTP (RFC977) Interface for GNU Emacs
-
-;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-
-;;; Commentary:
-
-;; This implementation is tested on both 1.2a and 1.5 version of the
-;; NNTP package.
-
-;; Troubleshooting of NNTP
-;;
-;; (1) Select routine may signal an error or fall into infinite loop
-;;  while waiting for the server response. In this case, you'd better
-;;  not use byte-compiled codes but original source. If you still have
-;;  a problems with it, set the variable `nntp-buggy-select' to t.
-;;
-;; (2) Emacs may hang up while retrieving headers since too many
-;;  requests have been sent to the NNTP server without reading their
-;;  replies. In this case, reduce the number of the requests sent to
-;;  the server at one time by setting the variable
-;;  `nntp-maximum-request' to a lower value.
-;;
-;; (3) If the TCP/IP stream (open-network-stream) is not supported by
-;;  emacs, compile and install `tcp.el' and `tcp.c' which is an
-;;  emulation program of the stream. If you modified `tcp.c' for your
-;;  system, please send me the diffs. I'll include some of them in the
-;;  future releases.
-
-;;; Code:
-
-(defvar nntp-server-hook nil
-  "*Hooks for the NNTP server.
-If the kanji code of the NNTP server is different from the local kanji
-code, the correct kanji code of the buffer associated with the NNTP
-server must be specified as follows:
-
-\(setq nntp-server-hook
-      (function
-       (lambda ()
-	 ;; Server's Kanji code is EUC (NEmacs hack).
-	 (make-local-variable 'kanji-fileio-code)
-	 (setq kanji-fileio-code 0))))
-
-If you'd like to change something depending on the server in this
-hook, use the variable `nntp-server-name'.")
-
-(defvar nntp-large-newsgroup 50
-  "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
-messages will be shown to indicate the current status.")
-
-
-(defvar nntp-buggy-select (memq system-type '(fujitsu-uts))
-  "*Non-nil if your select routine is buggy.
-If the select routine signals error or fall into infinite loop while
-waiting for the server response, the variable must be set to t.  In
-case of Fujitsu UTS, it is set to t since `accept-process-output'
-doesn't work properly.")
-
-(defvar nntp-maximum-request 400
-  "*The maximum number of the requests sent to the NNTP server at one time.
-If Emacs hangs up while retrieving headers, set the variable to a
-lower value.")
-
-(defvar nntp-debug-read 10000
-  "*Display '...' every 10Kbytes of a message being received if it is non-nil.
-If it is a number, dots are displayed per the number.")
-
-
-(defconst nntp-version "NNTP 3.12"
-  "Version numbers of this version of NNTP.")
-
-(defvar nntp-server-name nil
-  "The name of the host running NNTP server.")
-
-(defvar nntp-server-buffer nil
-  "Buffer associated with NNTP server process.")
-
-(defvar nntp-server-process nil
-  "The NNTP server process.
-You'd better not use this variable in NNTP front-end program but
-instead use `nntp-server-buffer'.")
-
-(defvar nntp-status-string nil
-  "Save the server response message.
-You'd better not use this variable in NNTP front-end program but
-instead call function `nntp-status-message' to get status message.")
-
-;;;
-;;; Extended Command for retrieving many headers.
-;;;
-;; Retrieving lots of headers by sending command asynchronously.
-;; Access functions to headers are defined as macro.
-
-(defmacro nntp-header-number (header)
-  "Return article number in HEADER."
-  (` (aref (, header) 0)))
-
-(defmacro nntp-set-header-number (header number)
-  "Set article number of HEADER to NUMBER."
-  (` (aset (, header) 0 (, number))))
-
-(defmacro nntp-header-subject (header)
-  "Return subject string in HEADER."
-  (` (aref (, header) 1)))
-
-(defmacro nntp-set-header-subject (header subject)
-  "Set article subject of HEADER to SUBJECT."
-  (` (aset (, header) 1 (, subject))))
-
-(defmacro nntp-header-from (header)
-  "Return author string in HEADER."
-  (` (aref (, header) 2)))
-
-(defmacro nntp-set-header-from (header from)
-  "Set article author of HEADER to FROM."
-  (` (aset (, header) 2 (, from))))
-
-(defmacro nntp-header-xref (header)
-  "Return xref string in HEADER."
-  (` (aref (, header) 3)))
-
-(defmacro nntp-set-header-xref (header xref)
-  "Set article xref of HEADER to xref."
-  (` (aset (, header) 3 (, xref))))
-
-(defmacro nntp-header-lines (header)
-  "Return lines in HEADER."
-  (` (aref (, header) 4)))
-
-(defmacro nntp-set-header-lines (header lines)
-  "Set article lines of HEADER to LINES."
-  (` (aset (, header) 4 (, lines))))
-
-(defmacro nntp-header-date (header)
-  "Return date in HEADER."
-  (` (aref (, header) 5)))
-
-(defmacro nntp-set-header-date (header date)
-  "Set article date of HEADER to DATE."
-  (` (aset (, header) 5 (, date))))
-
-(defmacro nntp-header-id (header)
-  "Return Id in HEADER."
-  (` (aref (, header) 6)))
-
-(defmacro nntp-set-header-id (header id)
-  "Set article Id of HEADER to ID."
-  (` (aset (, header) 6 (, id))))
-
-(defmacro nntp-header-references (header)
-  "Return references (or in-reply-to) in HEADER."
-  (` (aref (, header) 7)))
-
-(defmacro nntp-set-header-references (header ref)
-  "Set article references of HEADER to REF."
-  (` (aset (, header) 7 (, ref))))
-
-(defun nntp-retrieve-headers (sequence)
-  "Return list of article headers specified by SEQUENCE of article id.
-The format of list is
- `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
-If there is no References: field, In-Reply-To: field is used instead.
-Reader macros for the vector are defined as `nntp-header-FIELD'.
-Writer macros for the vector are defined as `nntp-set-header-FIELD'.
-Newsgroup must be selected before calling this."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (let ((number (length sequence))
-	  (last-point (point-min))
-	  (received 0)
-	  (count 0)
-	  (headers nil)			;Result list.
-	  (article 0)
-	  (subject nil)
-	  (message-id)
-	  (from nil)
-	  (xref nil)
-	  (lines 0)
-	  (date nil)
-	  (references nil))
-      ;; Send HEAD command.
-      (while sequence
-	(nntp-send-strings-to-server "HEAD" (car sequence))
-	(setq sequence (cdr sequence))
-	(setq count (1+ count))
-	;; Every 400 header requests we have to read stream in order
-	;;  to avoid deadlock.
-	(if (or (null sequence)		;All requests have been sent.
-		(zerop (% count nntp-maximum-request)))
-	    (progn
-	      (accept-process-output)
-	      (while (progn
-		       (goto-char last-point)
-		       ;; Count replies.
-		       (while (re-search-forward "^[0-9]" nil t)
-			 (setq received (1+ received)))
-		       (setq last-point (point))
-		       (< received count))
-		;; If number of headers is greater than 100, give
-		;;  informative messages.
-		(and (numberp nntp-large-newsgroup)
-		     (> number nntp-large-newsgroup)
-		     (zerop (% received 20))
-		     (message "NNTP: Receiving headers... %d%%"
-			      (/ (* received 100) number)))
-		(nntp-accept-response))
-	      ))
-	)
-      ;; Wait for text of last command.
-      (goto-char (point-max))
-      (re-search-backward "^[0-9]" nil t)
-      (if (looking-at "^[23]")
-	  (while (progn
-		   (goto-char (- (point-max) 3))
-		   (not (looking-at "^\\.\r$")))
-	    (nntp-accept-response)))
-      (and (numberp nntp-large-newsgroup)
-	   (> number nntp-large-newsgroup)
-	   (message "NNTP: Receiving headers... done"))
-      ;; Now all of replies are received.
-      (setq received number)
-      ;; First, fold continuation lines.
-      (goto-char (point-min))
-      (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
-        (replace-match " " t t))
-      ;;(delete-non-matching-lines
-      ;; "^Subject:\\|^Xref:\\|^From:\\|^Lines:\\|^Date:\\|^References:\\|^[23]")
-      (and (numberp nntp-large-newsgroup)
-	   (> number nntp-large-newsgroup)
-	   (message "NNTP: Parsing headers..."))
-      ;; Then examines replies.
-      (goto-char (point-min))
-      (while (not (eobp))
-	(cond ((looking-at "^[23][0-9][0-9][ \t]+\\([0-9]+\\)[ \t]+\\(<[^>]+>\\)")
-	       (setq article
-		     (string-to-int
-		      (buffer-substring (match-beginning 1) (match-end 1))))
-	       (setq message-id
-		     (buffer-substring (match-beginning 2) (match-end 2)))
-	       (forward-line 1)
-	       ;; Set default value.
-	       (setq subject nil)
-	       (setq xref nil)
-	       (setq from nil)
-	       (setq lines 0)
-	       (setq date nil)
-	       (setq references nil)
-	       ;; Thanks go to mly@AI.MIT.EDU (Richard Mlynarik)
-	       (while (and (not (eobp))
-			   (not (memq (following-char) '(?2 ?3))))
-		 (if (looking-at "\\(From\\|Subject\\|Date\\|Lines\\|Xref\\|References\\|In-Reply-To\\):[ \t]+\\([^ \t\n]+.*\\)\r$")
-		     (let ((s (buffer-substring
-			       (match-beginning 2) (match-end 2)))
-			   (c (char-after (match-beginning 0))))
-		       ;; We don't have to worry about letter case.
-		       (cond ((char-equal c ?F)	;From:
-			      (setq from s))
-			     ((char-equal c ?S)	;Subject:
-			      (setq subject s))
-			     ((char-equal c ?D)	;Date:
-			      (setq date s))
-			     ((char-equal c ?L)	;Lines:
-			      (setq lines (string-to-int s)))
-			     ((char-equal c ?X)	;Xref:
-			      (setq xref s))
-			     ((char-equal c ?R)	;References:
-			      (setq references s))
-			     ;; In-Reply-To: should be used only when
-			     ;; there is no References: field.
-			     ((and (char-equal c ?I) ;In-Reply-To:
-				   (null references))
-			      (setq references s))
-			     )))
-		 (forward-line 1))
-	       ;; Finished to parse one header.
-	       (if (null subject)
-		   (setq subject "(None)"))
-	       (if (null from)
-		   (setq from "(Unknown User)"))
-	       ;; Collect valid article only.
-	       (and article
-		    message-id
-		    (setq headers
-			  (cons (vector article subject from
-					xref lines date
-					message-id references) headers)))
-	       )
-	      (t (forward-line 1))
-	      )
-	(setq received (1- received))
-	(and (numberp nntp-large-newsgroup)
-	     (> number nntp-large-newsgroup)
-	     (zerop (% received 20))
-	     (message "NNTP: Parsing headers... %d%%"
-		      (/ (* received 100) number)))
-	)
-      (and (numberp nntp-large-newsgroup)
-	   (> number nntp-large-newsgroup)
-	   (message "NNTP: Parsing headers... done"))
-      (nreverse headers)
-      )))
-
-
-;;;
-;;; Raw Interface to Network News Transfer Protocol (RFC977).
-;;;
-
-(defun nntp-open-server (host &optional service)
-  "Open news server on HOST.
-If HOST is nil, use value of environment variable `NNTPSERVER'.
-If optional argument SERVICE is non-nil, open by the service name."
-  (let ((host (or host (getenv "NNTPSERVER")))
-	(status nil))
-    (setq nntp-status-string "")
-    (cond ((and host (nntp-open-server-internal host service))
-	   (setq status (nntp-wait-for-response "^[23].*\r$"))
-	   ;; Do check unexpected close of connection.
-	   ;; Suggested by feldmark@hanako.stars.flab.fujitsu.junet.
-	   (if status
-	       (progn (set-process-sentinel nntp-server-process
-					    'nntp-default-sentinel)
-		      (nntp-send-command "^[25].*\r$" "MODE" "READER"))
-	     ;; We have to close connection here, since function
-	     ;;  `nntp-server-opened' may return incorrect status.
-	     (nntp-close-server-internal)
-	     ))
-	  ((null host)
-	   (setq nntp-status-string "NNTP server is not specified."))
-	  )
-    status
-    ))
-
-(defun nntp-close-server ()
-  "Close news server."
-  (unwind-protect
-      (progn
-	;; Un-set default sentinel function before closing connection.
-	(and nntp-server-process
-	     (eq 'nntp-default-sentinel
-		 (process-sentinel nntp-server-process))
-	     (set-process-sentinel nntp-server-process nil))
-	;; We cannot send QUIT command unless the process is running.
-	(if (nntp-server-opened)
-	    (nntp-send-command nil "QUIT"))
-	)
-    (nntp-close-server-internal)
-    ))
-
-(fset 'nntp-request-quit (symbol-function 'nntp-close-server))
-
-(defun nntp-server-opened ()
-  "Return server process status, T or NIL.
-If the stream is opened, return T, otherwise return NIL."
-  (and nntp-server-process
-       (memq (process-status nntp-server-process) '(open run))))
-
-(defun nntp-status-message ()
-  "Return server status response as string."
-  (if (and nntp-status-string
-	   ;; NNN MESSAGE
-	   (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
-			 nntp-status-string))
-      (substring nntp-status-string (match-beginning 1) (match-end 1))
-    ;; Empty message if nothing.
-    ""
-    ))
-
-(defun nntp-request-article (id)
-  "Select article by message ID (or number)."
-  (if (numberp id)
-      (setq id (number-to-string id)))
-  (prog1
-      ;; If NEmacs, end of message may look like: "\256\215" (".^M")
-      (nntp-send-command "^\\.\r$" "ARTICLE" id)
-    (nntp-decode-text)
-    ))
-
-(defun nntp-request-body (id)
-  "Select article body by message ID (or number)."
-  (prog1
-      ;; If NEmacs, end of message may look like: "\256\215" (".^M")
-      (nntp-send-command "^\\.\r$" "BODY" id)
-    (nntp-decode-text)
-    ))
-
-(defun nntp-request-head (id)
-  "Select article head by message ID (or number)."
-  (prog1
-      (nntp-send-command "^\\.\r$" "HEAD" id)
-    (nntp-decode-text)
-    ))
-
-(defun nntp-request-stat (id)
-  "Select article by message ID (or number)."
-  (nntp-send-command "^[23].*\r$" "STAT" id))
-
-(defun nntp-request-group (group)
-  "Select news GROUP."
-  ;; 1.2a NNTP's group command is buggy. "^M" (\r) is not appended to
-  ;;  end of the status message.
-  (nntp-send-command "^[23].*$" "GROUP" group))
-
-(defun nntp-request-list ()
-  "List active newsgroups."
-  (prog1
-      (nntp-send-command "^\\.\r$" "LIST")
-    (nntp-decode-text)
-    ))
-
-(defun nntp-request-list-newsgroups ()
-  "List newsgroups (defined in NNTP2)."
-  (prog1
-      (nntp-send-command "^\\.\r$" "LIST NEWSGROUPS")
-    (nntp-decode-text)
-    ))
-
-(defun nntp-request-list-distributions ()
-  "List distributions (defined in NNTP2)."
-  (prog1
-      (nntp-send-command "^\\.\r$" "LIST DISTRIBUTIONS")
-    (nntp-decode-text)
-    ))
-
-(defun nntp-request-last ()
-  "Set current article pointer to the previous article
-in the current news group."
-  (nntp-send-command "^[23].*\r$" "LAST"))
-
-(defun nntp-request-next ()
-  "Advance current article pointer."
-  (nntp-send-command "^[23].*\r$" "NEXT"))
-
-(defun nntp-request-post ()
-  "Post a new news in current buffer."
-  (if (nntp-send-command "^[23].*\r$" "POST")
-      (progn
-	(nntp-encode-text)
-	(nntp-send-region-to-server (point-min) (point-max))
-	;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
-	;;  appended to end of the status message.
-	(nntp-wait-for-response "^[23].*$")
-	)))
-
-(defun nntp-default-sentinel (proc status)
-  "Default sentinel function for NNTP server process."
-  (if (and nntp-server-process
-	   (not (nntp-server-opened)))
-      (error "NNTP: Connection closed.")
-    ))
-
-;; Encoding and decoding of NNTP text.
-
-(defun nntp-decode-text ()
-  "Decode text transmitted by NNTP.
-0. Delete status line.
-1. Delete `^M' at end of line.
-2. Delete `.' at end of buffer (end of text mark).
-3. Delete `.' at beginning of line."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    ;; Insert newline at end of buffer.
-    (goto-char (point-max))
-    (if (not (bolp))
-	(insert "\n"))
-    ;; Delete status line.
-    (goto-char (point-min))
-    (delete-region (point) (progn (forward-line 1) (point)))
-    ;; Delete `^M' at end of line.
-    ;; (replace-regexp "\r$" "")
-    (while (not (eobp))
-      (end-of-line)
-      (if (= (preceding-char) ?\r)
-	  (delete-char -1))
-      (forward-line 1)
-      )
-    ;; Delete `.' at end of buffer (end of text mark).
-    (goto-char (point-max))
-    (forward-line -1)			;(beginning-of-line)
-    (if (looking-at "^\\.$")
-	(delete-region (point) (progn (forward-line 1) (point))))
-    ;; Replace `..' at beginning of line with `.'.
-    (goto-char (point-min))
-    ;; (replace-regexp "^\\.\\." ".")
-    (while (search-forward "\n.." nil t)
-      (delete-char -1))
-    ))
-
-(defun nntp-encode-text ()
-  "Encode text in current buffer for NNTP transmission.
-1. Insert `.' at beginning of line.
-2. Insert `.' at end of buffer (end of text mark)."
-  (save-excursion
-    ;; Insert newline at end of buffer.
-    (goto-char (point-max))
-    (if (not (bolp))
-	(insert "\n"))
-    ;; Replace `.' at beginning of line with `..'.
-    (goto-char (point-min))
-    ;; (replace-regexp "^\\." "..")
-    (while (search-forward "\n." nil t)
-      (insert "."))
-    ;; Insert `.' at end of buffer (end of text mark).
-    (goto-char (point-max))
-    (insert ".\r\n")
-    ))
-
-
-;;;
-;;; Synchronous Communication with NNTP Server.
-;;;
-
-(defun nntp-send-command (response cmd &rest args)
-  "Wait for server RESPONSE after sending CMD and optional ARGS to server."
-  (save-excursion
-    ;; Clear communication buffer.
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (apply 'nntp-send-strings-to-server cmd args)
-    (if response
-	(nntp-wait-for-response response)
-      t)
-    ))
-
-(defun nntp-wait-for-response (regexp)
-  "Wait for server response which matches REGEXP."
-  (save-excursion
-    (let ((status t)
-	  (wait t)
-	  (dotnum 0)			;Number of "." being displayed.
-	  (dotsize			;How often "." displayed.
-	   (if (numberp nntp-debug-read) nntp-debug-read 10000)))
-      (set-buffer nntp-server-buffer)
-      ;; Wait for status response (RFC977).
-      ;; 1xx - Informative message.
-      ;; 2xx - Command ok.
-      ;; 3xx - Command ok so far, send the rest of it.
-      ;; 4xx - Command was correct, but couldn't be performed for some
-      ;;       reason.
-      ;; 5xx - Command unimplemented, or incorrect, or a serious
-      ;;       program error occurred.
-      (nntp-accept-response)
-      (while wait
-	(goto-char (point-min))
-	(cond ((looking-at "[23]")
-	       (setq wait nil))
-	      ((looking-at "[45]")
-	       (setq status nil)
-	       (setq wait nil))
-	      (t (nntp-accept-response))
-	      ))
-      ;; Save status message.
-      (end-of-line)
-      (setq nntp-status-string
-	    (buffer-substring (point-min) (point)))
-      (if status
-	  (progn
-	    (setq wait t)
-	    (while wait
-	      (goto-char (point-max))
-	      (forward-line -1)		;(beginning-of-line)
-	      ;;(message (buffer-substring
-	      ;;	 (point)
-	      ;;	 (save-excursion (end-of-line) (point))))
-	      (if (looking-at regexp)
-		  (setq wait nil)
-		(if nntp-debug-read
-		    (let ((newnum (/ (buffer-size) dotsize)))
-		      (if (not (= dotnum newnum))
-			  (progn
-			    (setq dotnum newnum)
-			    (message "NNTP: Reading %s"
-				     (make-string dotnum ?.))))))
-		(nntp-accept-response)
-		;;(if nntp-debug-read (message ""))
-		))
-	    ;; Remove "...".
-	    (if (and nntp-debug-read (> dotnum 0))
-		(message ""))
-	    ;; Successfully received server response.
-	    t
-	    ))
-      )))
-
-
-;;;
-;;; Low-Level Interface to NNTP Server.
-;;; 
-
-(defun nntp-send-strings-to-server (&rest strings)
-  "Send list of STRINGS to news server as command and its arguments."
-  (let ((cmd (car strings))
-	(strings (cdr strings)))
-    ;; Command and each argument must be separated by one or more spaces.
-    (while strings
-      (setq cmd (concat cmd " " (car strings)))
-      (setq strings (cdr strings)))
-    ;; Command line must be terminated by a CR-LF.
-    (process-send-string nntp-server-process (concat cmd "\r\n"))
-    ))
-
-(defun nntp-send-region-to-server (begin end)
-  "Send current buffer region (from BEGIN to END) to news server."
-  (save-excursion
-    ;; We have to work in the buffer associated with NNTP server
-    ;;  process because of NEmacs hack.
-    (copy-to-buffer nntp-server-buffer begin end)
-    (set-buffer nntp-server-buffer)
-    (process-send-region nntp-server-process (point-min) (point-max))
-    ;; We cannot erase buffer, because reply may be received.
-    (delete-region begin end)
-    ))
-
-(defun nntp-open-server-internal (host &optional service)
-  "Open connection to news server on HOST by SERVICE (default is nntp)."
-  (save-excursion
-    ;; Use TCP/IP stream emulation package if needed.
-    (or (fboundp 'open-network-stream)
-	(require 'tcp))
-    ;; Initialize communication buffer.
-    (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
-    (set-buffer nntp-server-buffer)
-    (buffer-flush-undo (current-buffer))
-    (erase-buffer)
-    (kill-all-local-variables)
-    (setq case-fold-search t)		;Should ignore case.
-    (setq nntp-server-process
-	  (open-network-stream "nntpd" (current-buffer)
-			       host (or service "nntp")))
-    (setq nntp-server-name host)
-    ;; It is possible to change kanji-fileio-code in this hook.
-    (run-hooks 'nntp-server-hook)
-    ;; Return the server process.
-    nntp-server-process
-    ))
-
-(defun nntp-close-server-internal ()
-  "Close connection to news server."
-  (if nntp-server-process
-      (delete-process nntp-server-process))
-  (if nntp-server-buffer
-      (kill-buffer nntp-server-buffer))
-  (setq nntp-server-buffer nil)
-  (setq nntp-server-process nil))
-
-(defun nntp-accept-response ()
-  "Read response of server.
-It is well-known that the communication speed will be much improved by
-defining this function as macro."
-  ;; To deal with server process exiting before
-  ;;  accept-process-output is called.
-  ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
-  ;; This is a copy of `nntp-default-sentinel'.
-  (or (memq (process-status nntp-server-process) '(open run))
-      (error "NNTP: Connection closed."))
-  (if nntp-buggy-select
-      (progn
-	;; We cannot use `accept-process-output'.
-	;; Fujitsu UTS requires messages during sleep-for. I don't know why.
-	(message "NNTP: Reading...")
-	(sleep-for 1)
-	(message ""))
-    (condition-case errorcode
-	(accept-process-output nntp-server-process)
-      (error
-       (cond ((string-equal "select error: Invalid argument" (nth 1 errorcode))
-	      ;; Ignore select error.
-	      nil
-	      )
-	     (t
-	      (signal (car errorcode) (cdr errorcode))))
-       ))
-    ))
-
-(provide 'nntp)
-
-;;; nntp.el ends here
diff --git a/lisp/=old-shell.el b/lisp/=old-shell.el
deleted file mode 100644
index 4c3944a65f4..00000000000
--- a/lisp/=old-shell.el
+++ /dev/null
@@ -1,399 +0,0 @@
-;;; old-shell.el --- run a shell in an Emacs window
-
-;; Copyright (C) 1985, 1986, 1987, 1990 Free Software Foundation, Inc.
-
-;; Keywords: processes
-  
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Hacked from tea.el and shell.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
-
-;;; Since this mode is built on top of the general command-interpreter-in-
-;;; a-buffer mode (comint mode), it shares a common base functionality, 
-;;; and a common set of bindings, with all modes derived from comint mode.
-
-;;; For documentation on the functionality provided by comint mode, and
-;;; the hooks available for customising it, see the file comint.el.
-
-;;; Needs fixin:
-;;; When sending text from a source file to a subprocess, the process-mark can 
-;;; move off the window, so you can lose sight of the process interactions.
-;;; Maybe I should ensure the process mark is in the window when I send
-;;; text to the process? Switch selectable?
-
-;;; Code:
-
-(require 'comint)
-(defvar shell-popd-regexp "popd"
-  "*Regexp to match subshell commands equivalent to popd.")
-
-(defvar shell-pushd-regexp "pushd"
-  "*Regexp to match subshell commands equivalent to pushd.")
-
-(defvar shell-cd-regexp "cd"
-  "*Regexp to match subshell commands equivalent to cd.")
-
-(defvar explicit-shell-file-name nil
-  "*If non-nil, is file name to use for explicitly requested inferior shell.")
-
-(defvar explicit-csh-args
-  (if (eq system-type 'hpux)
-      ;; -T persuades HP's csh not to think it is smarter
-      ;; than us about what terminal modes to use.
-      '("-i" "-T")
-    '("-i"))
-  "*Args passed to inferior shell by M-x shell, if the shell is csh.
-Value is a list of strings, which may be nil.")
-
-(defvar shell-dirstack nil
-  "List of directories saved by pushd in this buffer's shell.")
-
-(defvar shell-dirstack-query "dirs"
-  "Command used by shell-resync-dirlist to query shell.")
-
-(defvar shell-mode-map ())
-(cond ((not shell-mode-map)
-       (setq shell-mode-map (copy-keymap comint-mode-map))
-       (define-key shell-mode-map "\t" 'comint-dynamic-complete)
-       (define-key shell-mode-map "\M-?"  'comint-dynamic-list-completions)))
-
-(defvar shell-mode-hook '()
-  "*Hook for customising shell mode")
-
-
-;;; Basic Procedures
-;;; ===========================================================================
-;;;
-
-(defun shell-mode ()
-  "Major mode for interacting with an inferior shell.
-Return after the end of the process' output sends the text from the 
-    end of process to the end of the current line.
-Return before end of process output copies rest of line to end (skipping
-    the prompt) and sends it.
-M-x send-invisible reads a line of text without echoing it, and sends it to
-    the shell.
-
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it.
-
-cd, pushd and popd commands given to the shell are watched by Emacs to keep
-this buffer's default directory the same as the shell's working directory.
-M-x dirs queries the shell and resyncs Emacs' idea of what the current 
-    directory stack is.
-M-x dirtrack-toggle turns directory tracking on and off.
-
-\\{shell-mode-map}
-Customisation: Entry to this mode runs the hooks on comint-mode-hook and
-shell-mode-hook (in that order).
-
-Variables shell-cd-regexp, shell-pushd-regexp and shell-popd-regexp are used
-to match their respective commands."
-  (interactive)
-  (comint-mode)
-  (setq major-mode 'shell-mode
-        mode-name "Shell"
-        comint-prompt-regexp shell-prompt-pattern
-        comint-input-sentinel 'shell-directory-tracker)
-  (use-local-map shell-mode-map)
-  (make-local-variable 'shell-dirstack)
-  (set (make-local-variable 'shell-dirtrackp) t)
-  (run-hooks 'shell-mode-hook))
-
-
-(defun shell ()
-  "Run an inferior shell, with I/O through buffer *shell*.
-If buffer exists but shell process is not running, make new shell.
-If buffer exists and shell process is running, just switch to buffer *shell*.
-
-The shell to use comes from the first non-nil variable found from these:
-explicit-shell-file-name in Emacs, ESHELL in the environment or SHELL in the
-environment.  If none is found, /bin/sh is used.
-
-If a file ~/.emacs_SHELLNAME exists, it is given as initial input, simulating
-a start-up file for the shell like .profile or .cshrc.  Note that this may
-lose due to a timing error if the shell discards input when it starts up.
-
-The buffer is put in shell-mode, giving commands for sending input
-and controlling the subjobs of the shell.
-
-The shell file name, sans directories, is used to make a symbol name
-such as `explicit-csh-arguments'.  If that symbol is a variable,
-its value is used as a list of arguments when invoking the shell.
-Otherwise, one argument `-i' is passed to the shell.
-
-\(Type \\[describe-mode] in the shell buffer for a list of commands.)"
-  (interactive)
-  (if (not (comint-check-proc "*shell*"))
-      (let* ((prog (or explicit-shell-file-name
-		       (getenv "ESHELL")
-		       (getenv "SHELL")
-		       "/bin/sh"))
-	     (name (file-name-nondirectory prog))
-	     (startfile (concat "~/.emacs_" name))
-	     (xargs-name (intern-soft (concat "explicit-" name "-args"))))
-	(set-buffer (apply 'make-comint "shell" prog
-			   (if (file-exists-p startfile) startfile)
-			   (if (and xargs-name (boundp xargs-name))
-			       (symbol-value xargs-name)
-			     '("-i"))))
-	(shell-mode)))
-  (switch-to-buffer "*shell*"))
-
-
-;;; Directory tracking
-;;; ===========================================================================
-;;; This code provides the shell mode input sentinel
-;;;     SHELL-DIRECTORY-TRACKER
-;;; that tracks cd, pushd, and popd commands issued to the shell, and
-;;; changes the current directory of the shell buffer accordingly.
-;;;
-;;; This is basically a fragile hack, although it's more accurate than
-;;; the original version in shell.el. It has the following failings:
-;;; 1. It doesn't know about the cdpath shell variable.
-;;; 2. It only spots the first command in a command sequence. E.g., it will
-;;;    miss the cd in "ls; cd foo"
-;;; 3. More generally, any complex command (like ";" sequencing) is going to
-;;;    throw it. Otherwise, you'd have to build an entire shell interpreter in
-;;;    emacs lisp.  Failing that, there's no way to catch shell commands where
-;;;    cd's are buried inside conditional expressions, aliases, and so forth.
-;;;
-;;; The whole approach is a crock. Shell aliases mess it up. File sourcing
-;;; messes it up. You run other processes under the shell; these each have
-;;; separate working directories, and some have commands for manipulating
-;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have
-;;; commands that do *not* effect the current w.d. at all, but look like they
-;;; do (e.g., the cd command in ftp).  In shells that allow you job
-;;; control, you can switch between jobs, all having different w.d.'s. So
-;;; simply saying %3 can shift your w.d..
-;;;
-;;; The solution is to relax, not stress out about it, and settle for
-;;; a hack that works pretty well in typical circumstances. Remember
-;;; that a half-assed solution is more in keeping with the spirit of Unix, 
-;;; anyway. Blech.
-;;;
-;;; One good hack not implemented here for users of programmable shells
-;;; is to program up the shell w.d. manipulation commands to output
-;;; a coded command sequence to the tty. Something like
-;;;     ESC | <cwd> |
-;;; where <cwd> is the new current working directory. Then trash the
-;;; directory tracking machinery currently used in this package, and
-;;; replace it with a process filter that watches for and strips out
-;;; these messages.
-
-;;; REGEXP is a regular expression. STR is a string. START is a fixnum.
-;;; Returns T if REGEXP matches STR where the match is anchored to start
-;;; at position START in STR. Sort of like LOOKING-AT for strings.
-(defun shell-front-match (regexp str start)
-  (eq start (string-match regexp str start)))
-
-(defun shell-directory-tracker (str)
-  "Tracks cd, pushd and popd commands issued to the shell.
-This function is called on each input passed to the shell.
-It watches for cd, pushd and popd commands and sets the buffer's
-default directory to track these commands.
-
-You may toggle this tracking on and off with M-x dirtrack-toggle.
-If emacs gets confused, you can resync with the shell with M-x dirs.
-
-See variables shell-cd-regexp, shell-pushd-regexp, and shell-popd-regexp.
-Environment variables are expanded, see function substitute-in-file-name."
-  (condition-case err
-    (cond (shell-dirtrackp
-	   (string-match "^\\s *" str) ; skip whitespace
-	   (let ((bos (match-end 0))
-		 (x nil))
-	     (cond ((setq x (shell-match-cmd-w/optional-arg shell-popd-regexp
-							       str bos))
-		    (shell-process-popd (substitute-in-file-name x)))
-		   ((setq x (shell-match-cmd-w/optional-arg shell-pushd-regexp
-							       str bos))
-		    (shell-process-pushd (substitute-in-file-name x)))
-		   ((setq x (shell-match-cmd-w/optional-arg shell-cd-regexp
-							       str bos))
-		    (shell-process-cd (substitute-in-file-name x)))))))
-    (error (message (car (cdr err))))))
-
-
-;;; Try to match regexp CMD to string, anchored at position START.
-;;; CMD may be followed by a single argument. If a match, then return
-;;; the argument, if there is one, or the empty string if not. If
-;;; no match, return nil.
-
-(defun shell-match-cmd-w/optional-arg (cmd str start)
-  (and (shell-front-match cmd str start)
-       (let ((eoc (match-end 0))) ; end of command
-	 (cond ((shell-front-match "\\s *\\(\;\\|$\\)" str eoc)
-		"")			; no arg
-	       ((shell-front-match "\\s +\\([^ \t\;]+\\)\\s *\\(\;\\|$\\)"
-				      str eoc)
-		(substring str (match-beginning 1) (match-end 1))) ; arg
-	       (t nil))))) ; something else.
-;;; The first regexp is [optional whitespace, (";" or the end of string)].
-;;; The second regexp is [whitespace, (an arg), optional whitespace,
-;;;     (";" or end of string)].
-
-
-;;; popd [+n]
-(defun shell-process-popd (arg)
-  (let ((num (if (zerop (length arg)) 0 ; no arg means +0
-		 (shell-extract-num arg))))
-    (if (and num (< num (length shell-dirstack)))
-	(if (= num 0) ; condition-case because the CD could lose.
-	    (condition-case nil (progn (cd (car shell-dirstack))
-				       (setq shell-dirstack
-					     (cdr shell-dirstack))
-				       (shell-dirstack-message))
-	      (error (message "Couldn't cd.")))
-	    (let* ((ds (cons nil shell-dirstack))
-		   (cell (nthcdr (- num 1) ds)))
-	      (rplacd cell (cdr (cdr cell)))
-	      (setq shell-dirstack (cdr ds))
-	      (shell-dirstack-message)))
-	(message "Bad popd."))))
-
-
-;;; cd [dir]
-(defun shell-process-cd (arg)
-  (condition-case nil (progn (cd (if (zerop (length arg)) (getenv "HOME")
-				     arg))
-			     (shell-dirstack-message))
-	   (error (message "Couldn't cd."))))
-
-
-;;; pushd [+n | dir]
-(defun shell-process-pushd (arg)
-  (if (zerop (length arg))
-      ;; no arg -- swap pwd and car of shell stack
-      (condition-case nil (if shell-dirstack
-			      (let ((old default-directory))
-				(cd (car shell-dirstack))
-				(setq shell-dirstack
-				      (cons old (cdr shell-dirstack)))
-				(shell-dirstack-message))
-			      (message "Directory stack empty."))
-	(message "Couldn't cd."))
-
-      (let ((num (shell-extract-num arg)))
-	(if num				; pushd +n
-	    (if (> num (length shell-dirstack))
-		(message "Directory stack not that deep.")
-		(let* ((ds (cons default-directory shell-dirstack))
-		       (dslen (length ds))
-		       (front (nthcdr num ds))
-		       (back (reverse (nthcdr (- dslen num) (reverse ds))))
-		       (new-ds (append front back)))
-		  (condition-case nil
-		      (progn (cd (car new-ds))
-			     (setq shell-dirstack (cdr new-ds))
-			     (shell-dirstack-message))
-		    (error (message "Couldn't cd.")))))
-	       
-	    ;; pushd <dir>
-	    (let ((old-wd default-directory))
-	      (condition-case nil
-		  (progn (cd arg)
-			 (setq shell-dirstack
-			       (cons old-wd shell-dirstack))
-			 (shell-dirstack-message))
-		(error (message "Couldn't cd."))))))))
-
-;; If STR is of the form +n, for n>0, return n. Otherwise, nil.
-(defun shell-extract-num (str)
-  (and (string-match "^\\+[1-9][0-9]*$" str)
-       (string-to-int str)))
-
-
-(defun shell-dirtrack-toggle ()
-  "Turn directory tracking on and off in a shell buffer."
-  (interactive)
-  (setq shell-dirtrackp (not shell-dirtrackp))
-  (message "directory tracking %s."
-	   (if shell-dirtrackp "ON" "OFF")))
-
-;;; For your typing convenience:
-(fset 'dirtrack-toggle 'shell-dirtrack-toggle)
-
-
-(defun shell-resync-dirs ()
-  "Resync the buffer's idea of the current directory stack.
-This command queries the shell with the command bound to 
-shell-dirstack-query (default \"dirs\"), reads the next
-line output and parses it to form the new directory stack.
-DON'T issue this command unless the buffer is at a shell prompt.
-Also, note that if some other subprocess decides to do output
-immediately after the query, its output will be taken as the
-new directory stack -- you lose. If this happens, just do the
-command again."
-  (interactive)
-  (let* ((proc (get-buffer-process (current-buffer)))
-	 (pmark (process-mark proc)))
-    (goto-char pmark)
-    (insert shell-dirstack-query) (insert "\n")
-    (sit-for 0) ; force redisplay
-    (comint-send-string proc shell-dirstack-query) 
-    (comint-send-string proc "\n")
-    (set-marker pmark (point))
-    (let ((pt (point))) ; wait for 1 line
-      ;; This extra newline prevents the user's pending input from spoofing us.
-      (insert "\n") (backward-char 1)
-      (while (not (looking-at ".+\n"))
-	(accept-process-output proc)
-	(goto-char pt)))
-    (goto-char pmark) (delete-char 1) ; remove the extra newline
-    ;; That's the dirlist. grab it & parse it.
-    (let* ((dl (buffer-substring (match-beginning 0) (- (match-end 0) 1)))
-	   (dl-len (length dl))
-	   (ds '())			; new dir stack
-	   (i 0))
-      (while (< i dl-len)
-	;; regexp = optional whitespace, (non-whitespace), optional whitespace
-	(string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
-	(setq ds (cons (substring dl (match-beginning 1) (match-end 1))
-		       ds))
-	(setq i (match-end 0)))
-      (let ((ds (reverse ds)))
-	(condition-case nil
-	    (progn (cd (car ds))
-		   (setq shell-dirstack (cdr ds))
-		   (shell-dirstack-message))
-	  (error (message "Couldn't cd.")))))))
-
-;;; For your typing convenience:
-(fset 'dirs 'shell-resync-dirs)
-
-
-;;; Show the current dirstack on the message line.
-;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo".
-;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".)
-;;; All the commands that mung the buffer's dirstack finish by calling
-;;; this guy.
-(defun shell-dirstack-message ()
-  (let ((msg "")
-	(ds (cons default-directory shell-dirstack)))
-    (while ds
-      (let ((dir (car ds)))
-	(if (string-match (format "^%s\\(/\\|$\\)" (getenv "HOME")) dir)
-	    (setq dir (concat "~/" (substring dir (match-end 0)))))
-	(if (string-equal dir "~/") (setq dir "~"))
-	(setq msg (concat msg dir " "))
-	(setq ds (cdr ds))))
-    (message msg)))
-
-(provide 'shell)
-
-;;; old-shell.el ends here
diff --git a/lisp/=sc-alist.el b/lisp/=sc-alist.el
deleted file mode 100644
index 31cb0a180ba..00000000000
--- a/lisp/=sc-alist.el
+++ /dev/null
@@ -1,134 +0,0 @@
-;; -*- Mode: Emacs-Lisp -*-
-;; sc-alist.el -- Version 1.0 (used to be baw-alist.el)
-
-;; association list utilities providing insertion, deletion, sorting
-;; fetching off key-value pairs in association lists.
-
-;; ========== Disclaimer ==========
-;; This software is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY.  No author or distributor accepts
-;; responsibility to anyone for the consequences of using it or for
-;; whether it serves any particular purpose or works at all, unless he
-;; says so in writing.
-
-;; This software was written as part of the supercite author's
-;; official duty as an employee of the United States Government and is
-;; thus in the public domain.  You are free to use that particular
-;; software as you wish, but WITHOUT ANY WARRANTY WHATSOEVER.  It
-;; would be nice, though if when you use any of this code, you give
-;; due credit to the author.
-
-;; ========== Author (unless otherwise stated) ========================
-;; NAME: Barry A. Warsaw      USMAIL: Century Computing, Inc.
-;; TELE: (301) 593-3330               1014 West Street
-;; INET: bwarsaw@cen.com              Laurel, Md 20707
-;; UUCP: uunet!cen.com!bwarsaw
-;;
-(provide 'sc-alist)
-
-
-(defun asort (alist-symbol key)
-  "Move a specified key-value pair to the head of an alist.
-The alist is referenced by ALIST-SYMBOL. Key-value pair to move to
-head is one matching KEY.  Returns the sorted list and doesn't affect
-the order of any other key-value pair.  Side effect sets alist to new
-sorted list."
-  (set alist-symbol
-       (sort (copy-alist (eval alist-symbol))
-	     (function (lambda (a b) (equal (car a) key))))))
-
-
-(defun aelement (key value)
-  "Makes a list of a cons cell containing car of KEY and cdr of VALUE.
-The returned list is suitable as an element of an alist."
-  (list (cons key value)))
-
-
-(defun aheadsym (alist)
-  "Return the key symbol at the head of ALIST."
-  (car (car alist)))
-
-
-(defun anot-head-p (alist key)
-  "Find out if a specified key-value pair is not at the head of an alist.
-The alist to check is specified by ALIST and the key-value pair is the
-one matching the supplied KEY.  Returns nil if ALIST is nil, or if
-key-value pair is at the head of the alist.  Returns t if key-value
-pair is not at the head of alist.  ALIST is not altered."
-  (not (equal (aheadsym alist) key)))
-
-
-(defun aput (alist-symbol key &optional value)
-  "Inserts a key-value pair into an alist.
-The alist is referenced by ALIST-SYMBOL. The key-value pair is made
-from KEY and optionally, VALUE. Returns the altered alist or nil if
-ALIST is nil.
-
-If the key-value pair referenced by KEY can be found in the alist, and
-VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
-If VALUE is not supplied, or is nil, the key-value pair will not be
-modified, but will be moved to the head of the alist. If the key-value
-pair cannot be found in the alist, it will be inserted into the head
-of the alist (with value nil if VALUE is nil or not supplied)."
-  (let ((elem (aelement key value))
-	alist)
-    (asort alist-symbol key)
-    (setq alist (eval alist-symbol))
-    (cond ((null alist) (set alist-symbol elem))
-	  ((anot-head-p alist key) (set alist-symbol (nconc elem alist)))
-	  (value (setcar alist (car elem)))
-	  (t alist))))
-
-
-(defun adelete (alist-symbol key)
-  "Delete a key-value pair from the alist.
-Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
-is pair matching KEY.  Returns the altered alist."
-  (asort alist-symbol key)
-  (let ((alist (eval alist-symbol)))
-    (cond ((null alist) nil)
-	  ((anot-head-p alist key) alist)
-	  (t (set alist-symbol (cdr alist))))))
-
-
-(defun aget (alist key &optional keynil-p)
-  "Returns the value in ALIST that is associated with KEY.
-Optional KEYNIL-P describes what to do if the value associated with
-KEY is nil.  If KEYNIL-P is not supplied or is nil, and the value is
-nil, then KEY is returned.  If KEYNIL-P is non-nil, then nil would be
-returned.
-
-If no key-value pair matching KEY could be found in ALIST, or ALIST is
-nil then nil is returned. ALIST is not altered."
-  (let ((copy (copy-alist alist)))
-    (cond ((null alist) nil)
-	  ((progn (asort 'copy key)
-		  (anot-head-p copy key)) nil)
-	  ((cdr (car copy)))
-	  (keynil-p nil)
-	  ((car (car copy)))
-	  (t nil))))
-
-
-(defun amake (alist-symbol keylist &optional valuelist)
-  "Make an association list.
-The association list is attached to the alist referenced by
-ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is
-associated with the value in VALUELIST with the same index. If
-VALUELIST is not supplied or is nil, then each key in KEYLIST is
-associated with nil.
-
-KEYLIST and VALUELIST should have the same number of elements, but
-this isn't enforced.  If VALUELIST is smaller than KEYLIST, remaining
-keys are associated with nil.  If VALUELIST is larger than KEYLIST,
-extra values are ignored.  Returns the created alist."
-  (let ((keycar (car keylist))
-	(keycdr (cdr keylist))
-	(valcar (car valuelist))
-	(valcdr (cdr valuelist)))
-    (cond ((null keycdr)
-	   (aput alist-symbol keycar valcar))
-	  (t
-	   (amake alist-symbol keycdr valcdr)
-	   (aput alist-symbol keycar valcar))))
-  (eval alist-symbol))
diff --git a/lisp/=sc-elec.el b/lisp/=sc-elec.el
deleted file mode 100644
index 67f18c66a5e..00000000000
--- a/lisp/=sc-elec.el
+++ /dev/null
@@ -1,198 +0,0 @@
-;; -*- Mode: Emacs-Lisp -*-
-;; sc-elec.el  --  Version 2.3
-
-;; ========== Introduction ==========
-;; This file contains sc-electric mode for viewing reference headers.
-;; It is loaded automatically by supercite.el when needed.
-
-;; ========== Disclaimer ==========
-;; This software is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY.  No author or distributor accepts
-;; responsibility to anyone for the consequences of using it or for
-;; whether it serves any particular purpose or works at all, unless he
-;; says so in writing.
-
-;; Some of this software was written as part of the supercite author's
-;; official duty as an employee of the United States Government and is
-;; thus in the public domain.  You are free to use that particular
-;; software as you wish, but WITHOUT ANY WARRANTY WHATSOEVER.  It
-;; would be nice, though if when you use any of this code, you give
-;; due credit to the author.
-
-;; Other parts of this code were written by other people.  Wherever
-;; possible, credit to that author, and the copy* notice supplied by
-;; the author are included with that code. In all cases, the spirit,
-;; if not the letter of the GNU General Public Licence applies.
-
-;; ========== Author (unless otherwise stated) ==========
-;; NAME: Barry A. Warsaw        USMAIL: Century Computing, Inc.
-;; TELE: (301) 593-3330                 1014 West Street
-;; UUCP: uunet!cen.com!bwarsaw          Laurel, MD 20707
-;; INET: bwarsaw@cen.com                    
-
-;; Want to be on the Supercite mailing list?
-;;
-;; Send articles to:
-;;         INET: supercite@anthem.nlm.nih.gov
-;;         UUCP: uunet!anthem.nlm.nih.gov!supercite
-;; 
-;; Send administrivia (additions/deletions to list, etc) to:
-;;         INET: supercite-request@anthem.nlm.nih.gov
-;;         UUCP: uunet!anthem.nlm.nih.gov!supercite-request
-;;
-(provide 'sc-elec)
-
-
-;; ======================================================================
-;; set up vars for major mode
-
-(defconst sc-electric-bufname "*sc-erefs*"
-  "*Supercite's electric buffer name.")
-
-
-(defvar sc-electric-mode-hook nil
-  "*Hook for sc-electric-mode.")
-
-
-
-;; ======================================================================
-;; sc-electric-mode
-
-(defun sc-electric-mode (&optional arg)
-  "Quasi major mode for viewing supercite reference headers.
-Commands are: \\{sc-electric-mode-map}
-Sc-electric-mode is not intended to be run interactively, but rather
-accessed through supercite's electric reference feature.  See
-sc-insert-reference for more details. Optional ARG is the initial
-header style to use, unless not supplied or invalid, in which case
-sc-preferred-header-style is used."
-  (let ((gal sc-gal-information)
-	(sc-eref-style (if arg  ;; assume passed arg is okay
-			   arg
-			 (if (and (natnump sc-preferred-header-style)
-				  (sc-valid-index-p sc-preferred-header-style))
-			     sc-preferred-header-style
-			   0))))
-    (get-buffer-create sc-electric-bufname)
-    ;; set up buffer and enter command loop
-    (save-excursion
-      (save-window-excursion
-	(pop-to-buffer sc-electric-bufname)
-	(kill-all-local-variables)
-	(setq sc-gal-information gal
-	      buffer-read-only t
-	      mode-name "Supercite-Electric-References"
-	      major-mode 'sc-electric-mode)
-	(use-local-map sc-electric-mode-map)
-	(sc-eref-show sc-eref-style)
-	(run-hooks 'sc-electric-mode-hook)
-	(recursive-edit)
-	))
-    (if sc-eref-style
-	(condition-case nil
-	    (eval (nth sc-eref-style sc-rewrite-header-list))
-	  (error nil)
-	  ))	  
-    ;; now restore state
-    (kill-buffer sc-electric-bufname)
-    ))
-
-
-
-;; ======================================================================
-;; functions for electric mode
-
-(defun sc-eref-index (index)
-  "Check INDEX to be sure it is a valid index into sc-rewrite-header-list.
-If sc-electric-circular-p is non-nil, then list is considered circular
-so that movement across the ends of the list wraparound."
-  (let ((last (1- (length sc-rewrite-header-list))))
-    (cond ((sc-valid-index-p index) index)
-	  ((< index 0)
-	   (if sc-electric-circular-p last
-	     (progn (error "No preceding reference headers in list.") 0)))
-	  ((> index last)
-	   (if sc-electric-circular-p 0
-	     (progn (error "No following reference headers in list.") last)))
-	  )
-    ))
-
-
-(defun sc-eref-show (index)
-  "Show reference INDEX in sc-rewrite-header-list."
-  (setq sc-eref-style (sc-eref-index index))
-  (save-excursion
-    (set-buffer sc-electric-bufname)
-    (let ((ref (nth sc-eref-style sc-rewrite-header-list))
-	  (buffer-read-only nil))
-      (erase-buffer)
-      (goto-char (point-min))
-      (condition-case err
-	  (progn
-	    (set-mark (point-min))
-	    (eval ref)
-	    (message "Showing reference header %d." sc-eref-style)
-	    (goto-char (point-max))
-	    )
-	(void-function
-	 (progn (message
-		 "Symbol's function definition is void: %s (Header %d)"
-		 (symbol-name (car (cdr err)))
-		 sc-eref-style)
-		(beep)
-		))
-	))))
-
-
-
-;; ======================================================================
-;; interactive commands
-
-(defun sc-eref-next ()
-  "Display next reference in other buffer."
-  (interactive)
-  (sc-eref-show (1+ sc-eref-style)))
-
-
-(defun sc-eref-prev ()
-  "Display previous reference in other buffer."
-  (interactive)
-  (sc-eref-show (1- sc-eref-style)))
-
-
-(defun sc-eref-setn ()
-  "Set reference header selected as preferred."
-  (interactive)
-  (setq sc-preferred-header-style sc-eref-style)
-  (message "Preferred reference style set to header %d." sc-eref-style))
-
-
-(defun sc-eref-goto (refnum)
-  "Show reference style indexed by REFNUM.
-If REFNUM is an invalid index, don't go to that reference and return
-nil."
-  (interactive "NGoto Reference: ")
-  (if (sc-valid-index-p refnum)
-      (sc-eref-show refnum)
-    (error "Invalid reference: %d. (Range: [%d .. %d])"
-	   refnum 0 (1- (length sc-rewrite-header-list)))
-    ))
-
-
-(defun sc-eref-jump ()
-  "Set reference header to preferred header."
-  (interactive)
-  (sc-eref-show sc-preferred-header-style))
-
-
-(defun sc-eref-abort ()
-  "Exit from electric reference mode without inserting reference."
-  (interactive)
-  (setq sc-eref-style nil)
-  (exit-recursive-edit))
-
-
-(defun sc-eref-exit ()
-  "Exit from electric reference mode and insert selected reference."
-  (interactive)
-  (exit-recursive-edit))
diff --git a/lisp/=sc.el b/lisp/=sc.el
deleted file mode 100644
index 03eade6cba2..00000000000
--- a/lisp/=sc.el
+++ /dev/null
@@ -1,1547 +0,0 @@
-;; -*- Mode: Emacs-Lisp -*-
-;; sc.el -- Version 2.3 (used to be supercite.el)
-
-;; ========== Introduction ==========
-;; Citation and attribution package for various GNU emacs news and
-;; electronic mail reading subsystems.  This version of supercite should
-;; work with Rmail and GNUS as found in Emacs 19.  It may also work with
-;; VM 4.40+ and MH-E 3.7.
-
-;; This package does not do any yanking of messages, but instead
-;; massages raw reply buffers set up by the reply/forward functions in
-;; the news/mail subsystems. Therefore, such useful operations as
-;; yanking and citing portions of the original article (instead of the
-;; whole article) are not within the ability or responsibility of
-;; supercite.
-
-;; ========== Disclaimer ==========
-;; This software is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY.  No author or distributor, nor any
-;; author's past, present, or future employers accepts responsibility
-;; to anyone for the consequences of using it or for whether it serves
-;; any particular purpose or works at all, unless he says so in
-;; writing.
-
-;; Some of this software was written as part of the supercite author's
-;; official duty as an employee of the United States Government and is
-;; thus not subject to copyright.  You are free to use that particular
-;; software as you wish, but WITHOUT ANY WARRANTY WHATSOEVER.  It
-;; would be nice, though if when you use any of this or other freely
-;; available code, you give due credit to the author.
-
-;; Other parts of this code were written by other people.  Wherever
-;; possible, credit to that author, and the copy* notice supplied by
-;; the author are included with that code. The supercite author is no
-;; longer an employee of the U.S. Government so the GNU Public Licence
-;; should be considered in effect for all enhancements and bug fixes
-;; performed by the author.
-
-;; ========== Author (unless otherwise stated) ========================
-;; NAME: Barry A. Warsaw      USMAIL: Century Computing, Inc.
-;; TELE: (301) 593-3330               1014 West Street
-;; INET: bwarsaw@cen.com              Laurel, Md 20707
-;; UUCP: uunet!cen.com!bwarsaw
-;;
-;; Want to be on the Supercite mailing list?
-;;
-;; Send articles to:
-;;     Internet: supercite@anthem.nlm.nih.gov
-;;         UUCP: uunet!anthem.nlm.nih.gov!supercite
-;; 
-;; Send administrivia (additions/deletions to list, etc) to:
-;;     Internet: supercite-request@anthem.nlm.nih.gov
-;;         UUCP: uunet!anthem.nlm.nih.gov!supercite-request
-
-;; ========== Credits and Thanks ==========
-;; This package was derived from the Superyank 1.11 package as posted
-;; to the net.  Superyank 1.11 was inspired by code and ideas from
-;; Martin Neitzel and Ashwin Ram.  Supercite version 2.3 has evolved
-;; through the comments and suggestions of the supercite mailing list
-;; which consists of many authors and users of the various mail and
-;; news reading subsystems.
-
-;; Many folks on the supercite mailing list have contributed their
-;; help in debugging, making suggestions and supplying support code or
-;; bug fixes for the previous versions of supercite.  I want to thank
-;; everyone who helped, especially (in no particular order):
-;;
-;; Mark D. Baushke, Khalid Sattar, David Lawrence, Chris Davis, Kyle
-;; Jones, Kayvan Sylvan, Masanobu Umeda, Dan Jacobson, Piet van
-;; Oostrum, Hamish (H.I.) Macdonald, and Joe Wells.
-;;
-;; I don't mean to leave anyone out. All who have helped have been
-;; appreciated.
-
-;; ========== Getting Started ==========
-;; Here is a quick guide to getting started with supercite. The
-;; information contained here is mostly excerpted from the more
-;; detailed explanations given in the accompanying README file.
-;; Naturally, there are many customizations you can do to give your
-;; replies that personalized flair, but the instructions in this
-;; section should be sufficient for getting started.
-
-;; First, to connect supercite to any mail/news reading subsystem, put
-;; this in your .emacs file:
-;;
-;; (setq mail-yank-hooks 'sc-cite-original)  ; for old mail agents
-;; (setq mh-yank-hooks   'sc-cite-original)  ; for MH-E only
-;; (add-hook 'mail-citation-hook 'sc-cite-original) ; for newer mail agents
-;;
-;; If supercite is not pre-loaded into your emacs session, you should
-;; add the following autoload:
-;;
-;; (autoload 'sc-cite-original "sc" "Supercite 2.3" t)
-;;
-;; Finally, if you want to customize supercite, you should do it in a
-;; function called my-supercite-hook and:
-;;
-;; (setq sc-load-hook 'my-supercite-hook)
-
-(require 'assoc)
-
-
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; start of user defined variables
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-
-(defvar sc-nested-citation-p nil
-  "*Controls whether to use nested or non-nested citation style.
-Non-nil uses nested citations, nil uses non-nested citations.  Type
-\\[sc-describe] for more information.")
-
-(defvar sc-citation-leader "	"
-  "*String comprising first part of a citation.")
-
-(defvar sc-citation-delimiter ">"
-  "*String comprising third part of a citation.
-This string is used in both nested and non-nested citations.")
-
-(defvar sc-citation-separator " "
-  "*String comprising fourth and last part of a citation.")
-
-(defvar sc-default-author-name "Anonymous"
-  "*String used when author's name cannot be determined.")
-
-(defvar sc-default-attribution "Anon"
-  "*String used when author's attribution cannot be determined.")
-
-;; Noriya KOBAYASHI (nk@ics.osaka-u.ac.jp) writes to the supercite
-;; mailing list:
-;; I use supercite in Nemacs-3.3.2.  In order to handle citation using
-;; Kanji, [...set sc-cite-regexp to...]
-;; "\\s *\\([a-zA-Z0-9]\\|\\cc\\|\\cC\\|\\ch\\|\\cH\\|\\ck\\|\\cK\\)*\\s *>+"
-;;
-(defvar sc-cite-regexp "\\s *[-a-zA-Z0-9_.]*>+\\s *"
-  "*Regular expression describing how a already cited line begins.
-The regexp is only used at the beginning of a line, so it doesn't need
-to start with a '^'.")
-
-(defvar sc-titlecue-regexp "\\s +-+\\s +"
-  "*Regular expression describing the separator between names and titles.
-Set to nil to treat entire field as a name.")
-
-(defvar sc-spacify-name-chars '(?_ ?* ?+ ?=)
-  "*List of characters to convert to spaces if found in an author's name.")
-
-(defvar sc-nicknames-alist
-  '(("Michael" "Mike")
-    ("Daniel" "Dan")
-    ("David" "Dave")
-    ("Jonathan" "John")
-    ("William" "Bill")
-    ("Elizabeth" "Beth")
-    ("Elizabeth" "Betsy")
-    ("Kathleen" "Kathy")
-    ("Smith" "Smitty"))
-  "*Association list of names and their common nicknames.
-Entries are of the form (NAME NICKNAME), and NAMEs can have more than
-one nickname. Nicknames will not be automatically used as an
-attribution string, since I'm not sure this is really polite, but if a
-name is glommed from the author name and presented in the attribution
-string completion list, the matching nicknames will also be presented.
-Set this variable to nil to defeat nickname expansions. Also note that
-nicknames are not put in the supercite information alist.")
-
-(defvar sc-confirm-always-p t
-  "*If non-nil, always confirm attribution string before citing text body.")
-
-(defvar sc-preferred-attribution 'firstname
-  "*Specifies which part of the author's name becomes the attribution.
-The value of this variable must be one of the following quoted symbols:
-
-     emailname   -- email terminus name
-     initials    -- initials of author
-     firstname   -- first name of author
-     lastname    -- last name of author
-     middlename1 -- first middle name of author
-     middlename2 -- second middle name of author
-     ...
-
-Middle name indexes can be any positive integer greater than 0, though
-it is unlikely that many authors will supply more than one middle
-name, if that many.")
-
-(defvar sc-use-only-preference-p nil
-  "*Controls what happens when the preferred attribution cannot be found.
-If non-nil, then sc-default-attribution will be used. If nil, then
-some secondary scheme will be employed to find a suitable attribution
-string.")
-
-(defvar sc-downcase-p nil
-  "*Non-nil means downcase the attribution and citation strings.")
-
-(defvar sc-rewrite-header-list
-  '((sc-no-header)
-    (sc-header-on-said)
-    (sc-header-inarticle-writes)
-    (sc-header-regarding-adds)
-    (sc-header-attributed-writes)
-    (sc-header-verbose)
-    (sc-no-blank-line-or-header)
-    )
-  "*List of reference header rewrite functions.
-The variable sc-preferred-header-style controls which function in this
-list is chosen for automatic reference header insertions. Electric
-reference mode will cycle through this list of functions. For more
-information, type \\[sc-describe].")
-
-(defvar sc-preferred-header-style 1
-  "*Index into sc-rewrite-header-list specifying preferred header style.
-Index zero accesses the first function in the list.")
-
-(defvar sc-electric-references-p t
-  "*Use electric references if non-nil.")
-
-(defvar sc-electric-circular-p t
-  "*Treat electric references as circular if non-nil.")
-
-(defvar sc-mail-fields-list
-  '("date"  "message-id"  "subject" "newsgroups" "references"
-    "from"  "return-path" "path"    "reply-to"   "organization"
-    "reply" )
-  "*List of mail header whose values will be saved by supercite.
-These values can be used in header rewrite functions by accessing them
-with the sc-field function. Mail headers in this list are case
-insensitive and do not require a trailing colon.")
-
-(defvar sc-mumble-string ""
-  "*Value returned by sc-field if chosen field cannot be found.")
-
-(defvar sc-nuke-mail-headers-p t
-  "*Nuke or don't nuke mail headers.
-If non-nil, nuke mail headers after gleaning useful information from
-them.")
-
-(defvar sc-reference-tag-string ">>>>> "
-  "*String used at the beginning of built-in reference headers.")
-
-(defvar sc-fill-paragraph-hook 'sc-fill-paragraph
-  "*Hook for filling a paragraph.  
-This hook gets executed when you fill a paragraph either manually or
-automagically. It expects point to be within the extent of the
-paragraph that is going to be filled. This hook allows you to use a
-different paragraph filling package than the one supplied with
-supercite.")
-
-(defvar sc-auto-fill-region-p nil
-  "*If non-nil, automatically fill each paragraph after it has been cited.")
-
-(defvar sc-auto-fill-query-each-paragraph-p nil
-  "*If non-nil, query before filling each paragraph.
-No querying and no filling will be performed if sc-auto-fill-region-p
-is set to nil.")
-
-(defvar sc-fixup-whitespace-p nil
-  "*If non-nil, delete all leading white space before citing.")
-
-(defvar sc-all-but-cite-p nil
-  "*If non-nil, sc-cite-original does everything but cite the text.
-This is useful for manually citing large messages, or portions of
-large messages. When non-nil, sc-cite-original will still set up all
-necessary variables and databases, but will skip the citing routine
-which modify the reply buffer's text.")
-
-(defvar sc-load-hook nil
-  "*User definable hook.
-Runs after supercite is loaded. Set your customizations here.")
-
-(defvar sc-pre-hook nil
-  "*User definable hook.
-Runs before sc-cite-original executes.")
-
-(defvar sc-post-hook nil
-  "*User definable hook.
-Runs after sc-cite-original executes.")
-
-(defvar sc-header-nuke-list
-  '("via" "origin" "status" "received" "remailed" "cc" "sender" "replied"
-    "organization" "keywords" "distribution" "xref" "references" "expires"
-    "approved" "summary" "precedence" "subject" "newsgroup[s]?"
-    "\\(followup\\|apparently\\|errors\\|\\(\\(in-\\)?reply\\)?-\\)?to"
-    "x-[a-z0-9-]+" "[a-z-]*message-id" "\\(summary-\\)?line[s]"
-    "\\(\\(return\\|reply\\)-\\)?path" "\\(posted-\\)?date"
-    "\\(mail-\\)?from")
-  "*List of mail headers to remove from body of reply.")
-
-
-
-;; ======================================================================
-;; keymaps
-
-(defvar sc-default-keymap
-  '(lambda ()
-     (local-set-key "\C-c\C-r" 'sc-insert-reference)
-     (local-set-key "\C-c\C-t" 'sc-cite)
-     (local-set-key "\C-c\C-a" 'sc-recite)
-     (local-set-key "\C-c\C-u" 'sc-uncite)
-     (local-set-key "\C-c\C-i" 'sc-insert-citation)
-     (local-set-key "\C-c\C-o" 'sc-open-line)
-     (local-set-key "\C-c\C-q" 'sc-fill-paragraph-manually)
-     (local-set-key "\C-cq"    'sc-fill-paragraph-manually)
-     (local-set-key "\C-c\C-m" 'sc-modify-information)
-     (local-set-key "\C-cf"    'sc-view-field)
-     (local-set-key "\C-cg"    'sc-glom-headers)
-     (local-set-key "\C-c\C-v" 'sc-version)
-     (local-set-key "\C-c?"    'sc-describe)
-     )
-  "*Default keymap if major-mode can't be found in `sc-local-keymaps'.")
-
-(defvar sc-local-keymaps
-  '((mail-mode
-     (lambda ()
-       (local-set-key "\C-c\C-r" 'sc-insert-reference)
-       (local-set-key "\C-c\C-t" 'sc-cite)
-       (local-set-key "\C-c\C-a" 'sc-recite)
-       (local-set-key "\C-c\C-u" 'sc-uncite)
-       (local-set-key "\C-c\C-i" 'sc-insert-citation)
-       (local-set-key "\C-c\C-o" 'sc-open-line)
-       (local-set-key "\C-c\C-q" 'sc-fill-paragraph-manually)
-       (local-set-key "\C-cq"    'sc-fill-paragraph-manually)
-       (local-set-key "\C-c\C-m" 'sc-modify-information)
-       (local-set-key "\C-cf"    'sc-view-field)
-       (local-set-key "\C-cg"    'sc-glom-headers)
-       (local-set-key "\C-c\C-v" 'sc-version)
-       (local-set-key "\C-c?"    'sc-describe)
-       ))
-    (mh-letter-mode
-     (lambda ()
-       (local-set-key "\C-c\C-r" 'sc-insert-reference)
-       (local-set-key "\C-c\C-t" 'sc-cite)
-       (local-set-key "\C-c\C-a" 'sc-recite)
-       (local-set-key "\C-c\C-u" 'sc-uncite)
-       (local-set-key "\C-ci"    'sc-insert-citation)
-       (local-set-key "\C-c\C-o" 'sc-open-line)
-       (local-set-key "\C-cq"    'sc-fill-paragraph-manually)
-       (local-set-key "\C-c\C-m" 'sc-modify-information)
-       (local-set-key "\C-cf"    'sc-view-field)
-       (local-set-key "\C-cg"    'sc-glom-headers)
-       (local-set-key "\C-c\C-v" 'sc-version)
-       (local-set-key "\C-c?"    'sc-describe)
-       ))
-    (news-reply-mode mail-mode)
-    (vm-mail-mode mail-mode)
-    (e-reply-mode mail-mode)
-    (n-reply-mode mail-mode)
-    )
-  "*List of keymaps to use with the associated major-mode.")
-
-(defvar sc-electric-mode-map nil
-  "*Keymap for sc-electric-mode.")
-
-(if sc-electric-mode-map
-    nil
-  (setq sc-electric-mode-map (make-sparse-keymap))
-  (define-key sc-electric-mode-map "p"     'sc-eref-prev)
-  (define-key sc-electric-mode-map "n"     'sc-eref-next)
-  (define-key sc-electric-mode-map "s"     'sc-eref-setn)
-  (define-key sc-electric-mode-map "j"     'sc-eref-jump)
-  (define-key sc-electric-mode-map "x"     'sc-eref-abort)
-  (define-key sc-electric-mode-map "\r"    'sc-eref-exit)
-  (define-key sc-electric-mode-map "\n"    'sc-eref-exit)
-  (define-key sc-electric-mode-map "q"     'sc-eref-exit)
-  (define-key sc-electric-mode-map "g"     'sc-eref-goto)
-  )
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end of user defined variables
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-
-
-;; ======================================================================
-;; global variables, not user accessible
-
-(defconst sc-version-number "2.3"
-  "Supercite's version number.")
-
-;; when rnewspost.el patch is installed (or function is overloaded)
-;; this should be nil since supercite now does this itself.
-(setq news-reply-header-hook nil)
-
-;; autoload for sc-electric-mode
-(autoload 'sc-electric-mode "sc-elec"
-	  "Quasi-major mode for viewing supercite reference headers." nil)
-
-;; global alists (gals), misc variables. make new bytecompiler happy
-(defvar sc-gal-information nil
-  "Internal global alist variable containing information.")
-(defvar sc-gal-attributions nil
-  "Internal global alist variable containing attributions.")
-(defvar sc-fill-arg nil
-  "Internal fill argument holder.")
-(defvar sc-cite-context nil
-  "Internal citation context holder.")
-(defvar sc-force-confirmation-p nil
-  "Internal variable.")
-
-(make-variable-buffer-local 'sc-gal-attributions)
-(make-variable-buffer-local 'sc-gal-information)
-(make-variable-buffer-local 'sc-leached-keymap)
-(make-variable-buffer-local 'sc-fill-arg)
-(make-variable-buffer-local 'sc-cite-context)
-
-(setq-default sc-gal-attributions nil)
-(setq-default sc-gal-information  nil)
-(setq-default sc-leached-keymap (current-local-map))
-(setq-default sc-fill-arg nil)
-(setq-default sc-cite-context nil)
-
-
-
-;; ======================================================================
-;; miscellaneous support functions
-
-(defun sc-mark ()
-  "Mark compatibility between emacs v18 and v19."
-  (let ((zmacs-regions nil))
-    (marker-position (mark-marker))))
-
-(defun sc-update-gal (attribution)
-  "Update the information alist.
-Add ATTRIBUTION and compose the nested and non-nested citation
-strings."
-  (let ((attrib (if sc-downcase-p (downcase attribution) attribution)))
-    (aput 'sc-gal-information "sc-attribution" attrib)
-    (aput 'sc-gal-information "sc-nested-citation"
-	  (concat attrib sc-citation-delimiter))
-    (aput 'sc-gal-information "sc-citation"
-	  (concat sc-citation-leader
-		  attrib
-		  sc-citation-delimiter
-		  sc-citation-separator))))
-
-(defun sc-valid-index-p (index)
-  "Returns t if INDEX is a valid index into sc-rewrite-header-list."
-  (let ((last (1- (length sc-rewrite-header-list))))
-    (and (natnump index)  ;; a number, and greater than or equal to zero
-	 (<= index last)  ;; less than or equal to the last index
-	 )))
-
-(defun sc-string-car (namestring)
-  "Return the string-equivalent \"car\" of NAMESTRING.
-
-     example: (sc-string-car \"John Xavier Doe\")
-              => \"John\""
-  (substring namestring
-	     (progn (string-match "\\s *" namestring) (match-end 0))
-	     (progn (string-match "\\s *\\S +" namestring) (match-end 0))))
-
-(defun sc-string-cdr (namestring)
-  "Return the string-equivalent \"cdr\" of NAMESTRING.
-
-     example: (sc-string-cdr \"John Xavier Doe\")
-              => \"Xavier Doe\""
-  (substring namestring
-	     (progn (string-match "\\s *\\S +\\s *" namestring)
-		    (match-end 0))))
-
-(defun sc-linepos (&optional position col-p)
-  "Return the character position at various line positions.
-Optional POSITION can be one of the following symbols:
-     bol == beginning of line
-     boi == beginning of indentation
-     eol == end of line [default]
-
-Optional COL-P non-nil returns current-column instead of character position."
-  (let ((tpnt (point))
-	rval)
-    (cond
-     ((eq position 'bol) (beginning-of-line))
-     ((eq position 'boi) (back-to-indentation))
-     (t (end-of-line)))
-    (setq rval (if col-p (current-column) (point)))
-    (goto-char tpnt)
-    rval))
-
-
-;; ======================================================================
-;; this section snarfs mail fields and places them in the info alist
-
-(defun sc-build-header-zap-regexp ()
-  "Return a regexp for sc-mail-yank-clear-headers."
-  (let ((headers sc-header-nuke-list)
-	(regexp nil))
-    (while headers
-      (setq regexp (concat regexp
-			   "^" (car headers) ":"
-			   (if (cdr headers) "\\|" nil)))
-      (setq headers (cdr headers)))
-    regexp))
-
-(defun sc-mail-yank-clear-headers (start end)
-  "Nuke mail headers between START and END."
-  (if (and sc-nuke-mail-headers-p sc-header-nuke-list)
-      (let ((regexp (sc-build-header-zap-regexp)))
-	(save-excursion
-	  (goto-char start)
-	  (if (search-forward "\n\n" end t)
-	      (save-restriction
-		(narrow-to-region start (point))
-		(goto-char start)
-		(while (let ((case-fold-search t))
-			 (re-search-forward regexp nil t))
-		  (beginning-of-line)
-		  (delete-region (point)
-				 (progn (re-search-forward "\n[^ \t]")
-					(forward-char -1)
-					(point)))
-		  )))
-	  ))))
-
-(defun sc-mail-fetch-field (field)
-  "Return the value of the header field FIELD.
-The buffer is expected to be narrowed to just the headers of the
-message."
-  (save-excursion
-    (goto-char (point-min))
-    (let ((case-fold-search t)
-	  (name (concat "^" (regexp-quote field) "[ \t]*:[ \t]*")))
-      (goto-char (point-min))
-      (if (re-search-forward name nil t)
-	  (let ((opoint (point)))
-	    (while (progn (forward-line 1)
-			  (looking-at "[ \t]")))
-	    (buffer-substring opoint (1- (point))))))))
-
-(defun sc-fetch-fields (start end)
-  "Fetch the mail fields in the region from START to END.
-These fields can be accessed in header rewrite functions with sc-field."
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char start)
-      (let ((fields sc-mail-fields-list))
-	(while fields
-	  (let ((value (sc-mail-fetch-field (car fields)))
-		(next (cdr fields)))
-	    (and value
-		 (aput 'sc-gal-information (car fields) value))
-	    (setq fields next)))
-	(if (sc-mail-fetch-field "from")
-	    (aput 'sc-gal-information "from" (sc-mail-fetch-field "from")))))))
-
-(defun sc-field (field)
-  "Return the alist information associated with the FIELD.
-If FIELD is not a valid key, return sc-mumble-string."
-  (or (aget sc-gal-information field) sc-mumble-string))
-
-
-;; ======================================================================
-;; built-in reference header rewrite functions
-
-(defun sc-no-header ()
-  "Does nothing. Use this instead of nil to get a blank header."
-  ())
-
-(defun sc-no-blank-line-or-header()
-  "Similar to sc-no-header except it removes the preceding blank line."
-  (if (not (bobp))
-      (if (and (eolp)
-	       (progn (forward-line -1)
-		      (or (looking-at mail-header-separator)
-			  (and (eq major-mode 'mh-letter-mode)
-			       (mh-in-header-p)))))
-	  (progn (forward-line)
-		 (let ((kill-lines-magic t)) (kill-line))))))
-
-(defun sc-header-on-said ()
-  "\"On <date>, <from> said:\", unless 1. the \"from\" field cannot be
-found, in which case nothing is inserted; or 2. the \"date\" field is
-missing in which case only the from part is printed."
-  (let* ((sc-mumble-string "")
-	 (whofrom (sc-field "from"))
-	 (when (sc-field "date")))
-    (if (not (string= whofrom ""))
-	(insert sc-reference-tag-string
-		(if (not (string= when ""))
-		    (concat "On " when ", ") "")
-		whofrom " said:\n"))))
-
-(defun sc-header-inarticle-writes ()
-  "\"In article <message-id>, <from> writes:\"
-Treats \"message-id\" and \"from\" fields similar to sc-header-on-said."
-  (let* ((sc-mumble-string "")
-	 (whofrom (sc-field "from"))
-	 (msgid (sc-field "message-id")))
-    (if (not (string= whofrom ""))
-	(insert sc-reference-tag-string
-		(if (not (string= msgid ""))
-		    (concat "In article " msgid ", ") "")
-		whofrom " writes:\n"))))
-
-(defun sc-header-regarding-adds ()
-  "\"Regarding <subject>; <from> adds:\"
-Treats \"subject\" and \"from\" fields similar to sc-header-on-said."
-  (let* ((sc-mumble-string "")
-	 (whofrom (sc-field "from"))
-	 (subj (sc-field "subject")))
-    (if (not (string= whofrom ""))
-	(insert sc-reference-tag-string
-		(if (not (string= subj ""))
-		    (concat "Regarding " subj "; ") "")
-		whofrom " adds:\n"))))
-
-(defun sc-header-attributed-writes ()
-  "\"<sc-attribution>\" == <sc-author> <address> writes:
-Treats these fields in a similar manner to sc-header-on-said."
-  (let* ((sc-mumble-string "")
-	 (whofrom (sc-field "from"))
-	 (reply (sc-field "sc-reply-address"))
-	 (from (sc-field "sc-from-address"))
-	 (attr (sc-field "sc-attribution"))
-	 (auth (sc-field "sc-author")))
-    (if (not (string= whofrom ""))
-	(insert sc-reference-tag-string
-		(if (not (string= attr ""))
-		    (concat "\"" attr "\" == " ) "")
-		(if (not (string= auth ""))
-		    (concat auth " ") "")
-		(if (not (string= reply ""))
-		    (concat "<" reply ">")
-		  (if (not (string= from ""))
-		      (concat "<" from ">") ""))
-		" writes:\n"))))
-
-(defun sc-header-verbose ()
-  "Very verbose, some say gross."
-  (let* ((sc-mumble-string "")
-	 (whofrom (sc-field "from"))
-	 (reply (sc-field "sc-reply-address"))
-	 (from (sc-field "sc-from-address"))
-	 (author (sc-field "sc-author"))
-	 (date (sc-field "date"))
-	 (org (sc-field "organization"))
-	 (msgid (sc-field "message-id"))
-	 (ngrps (sc-field "newsgroups"))
-	 (subj (sc-field "subject"))
-	 (refs (sc-field "references"))
-	 (cite (sc-field "sc-citation"))
-	 (nl sc-reference-tag-string))
-    (if (not (string= whofrom ""))
-	(insert (if (not (string= date ""))
-		    (concat nl "On " date ",\n") "")
-		(concat nl (if (not (string= author ""))
-			       author
-			     whofrom) "\n")
-		(if (not (string= org ""))
-		    (concat nl "from the organization of " org "\n") "")
-		(if (not (string= reply ""))
-		    (concat nl "who can be reached at: " reply "\n")
-		  (if (not (string= from ""))
-		      (concat nl "who can be reached at: " from "\n") ""))
-		(if (not (string= cite ""))
-		    (concat nl "(whose comments are cited below with \""
-			    cite "\"),\n") "")
-		(if (not (string= msgid ""))
-		    (concat nl "had this to say in article " msgid "\n") "")
-		(if (not (string= ngrps ""))
-		    (concat nl "in newsgroups " ngrps "\n") "")
-		(if (not (string= subj ""))
-		    (concat nl "concerning the subject of " subj "\n") "")
-		(if (not (string= refs ""))
-		    (concat nl "(see " refs " for more details)\n") "")
-		))))
-
-
-;; ======================================================================
-;; this section queries the user for necessary information
-
-(defun sc-query (&optional default)
-  "Query for an attribution string with the optional DEFAULT choice.
-Returns the string entered by the user, if non-empty and non-nil, or
-DEFAULT otherwise. If DEFAULT is not supplied, sc-default-attribution
-is used."
-  (if (not default) (setq default sc-default-attribution))
-  (let* ((prompt (concat "Enter attribution string: (default " default ") "))
-	 (query (read-string prompt)))
-    (if (or (null query)
-	    (string= query ""))
-	default
-      query)))
-
-(defun sc-confirm ()
-  "Confirm the preferred attribution with the user."
-  (if (or sc-confirm-always-p
-	  sc-force-confirmation-p)
-      (aput 'sc-gal-attributions
-	    (let* ((default (aheadsym sc-gal-attributions))
-		   chosen
-		   (prompt (concat "Complete "
-				   (cond
-				    ((eq sc-cite-context 'citing) "cite")
-				    ((eq sc-cite-context 'reciting) "recite")
-				    (t ""))
-				   " attribution string: (default "
-				   default ") "))
-		   (minibuffer-local-completion-map
-		    (copy-keymap minibuffer-local-completion-map)))
-	      (define-key minibuffer-local-completion-map "\C-g"
-		'(lambda () (interactive) (beep) (throw 'select-abort nil)))
-	      (setq chosen (completing-read prompt sc-gal-attributions))
-	      (if (or (not chosen)
-		      (string= chosen ""))
-		  default
-		chosen)))))
-
-
-;; ======================================================================
-;; this section contains primitive functions used in the email address
-;; parsing schemes.  they extract name fields from various parts of
-;; the "from:" field.
-
-(defun sc-style1-addresses (from-string &optional delim)
-  "Extract the author's email terminus from email address FROM-STRING.
-Match addresses of the style \"name%[stuff].\" when called with DELIM
-of \"%\" and addresses of the style \"[stuff]name@[stuff]\" when
-called with DELIM \"@\". If DELIM is nil or not provided, matches
-addresses of the style \"name\"."
-  (and (string-match (concat "[a-zA-Z0-9_-]+" delim) from-string 0)
-       (substring from-string
-		  (match-beginning 0)
-		  (- (match-end 0) (if (null delim) 0 1)))))
-
-(defun sc-style2-addresses (from-string)
-  "Extract the author's email terminus from email address FROM-STRING.
-Match addresses of the style \"[stuff]![stuff]...!name[stuff].\""
-  (let ((eos (length from-string))
-	(mstart (string-match "![a-zA-Z0-9_-]+\\([^!a-zA-Z0-9_-]\\|$\\)"
-			      from-string 0))
-	(mend (match-end 0)))
-    (and mstart
-	 (substring from-string (1+ mstart) (- mend (if (= mend eos) 0 1)))
-	 )))
-
-(defun sc-get-address (from-string author)
-  "Get the full email address path from FROM-STRING.
-AUTHOR is the author's name (which is removed from the address)."
-  (let ((eos (length from-string)))
-    (if (string-match (concat "\\(^\\|^\"\\)" author
-			      "\\(\\s +\\|\"\\s +\\)") from-string 0)
-	(let ((addr (substring from-string (match-end 0) eos)))
-	  (if (and (= (aref addr 0) ?<)
-		   (= (aref addr (1- (length addr))) ?>))
-	      (substring addr 1 (1- (length addr)))
-	    addr))
-      (if (string-match "[a-zA-Z0-9!@%._-]+" from-string 0)
-	  (substring from-string (match-beginning 0) (match-end 0))
-	"")
-      )))
-
-(defun sc-get-emailname (from-string)
-  "Get the email terminus name from FROM-STRING."
-  (cond
-   ((sc-style1-addresses from-string "%"))
-   ((sc-style1-addresses from-string "@"))
-   ((sc-style2-addresses from-string))
-   ((sc-style1-addresses from-string nil))
-   (t (substring from-string 0 10))))
-
-
-;; ======================================================================
-;; this section contains functions that will extract a list of names
-;; from the name field string.
-
-(defun sc-spacify-name-chars (name)
-  (let ((len (length name))
-	(s 0))
-    (while (< s len)
-      (if (memq (aref name s) sc-spacify-name-chars)
-	  (aset name s 32))
-      (setq s (1+ s)))
-    name))
-
-(defun sc-name-substring (string start end extend)
-  "Extract the specified substring of STRING from START to END.
-EXTEND is the number of characters on each side to extend the
-substring."
-  (and start
-       (let ((sos (+ start extend))
-	     (eos (- end extend)))
-	 (substring string sos
-		    (or (string-match sc-titlecue-regexp string sos) eos)
-		    ))))
-
-(defun sc-extract-namestring (from-string)
-  "Extract the name string from FROM-STRING.
-This should be the author's full name minus an optional title."
-  (let ((pstart (string-match "(.*)" from-string 0))
-	(pend (match-end 0))
-	(qstart (string-match "\".*\"" from-string 0))
-	(qend (match-end 0))
-	(bstart (string-match "\\([.a-zA-Z0-9_-]+\\s *\\)+" from-string 0))
-	(bend (match-end 0)))
-    (sc-spacify-name-chars
-     (cond
-      ((sc-name-substring from-string pstart pend 1))
-      ((sc-name-substring from-string qstart qend 1))
-      ((sc-name-substring from-string bstart bend 0))
-      ))))
-
-(defun sc-chop-namestring (namestring)
-  "Convert NAMESTRING to a list of names.
-
-     example: (sc-namestring-to-list \"John Xavier Doe\")
-              => (\"John\" \"Xavier\" \"Doe\")"
-  (if (not (string= namestring ""))
-      (append (list (sc-string-car namestring))
-	      (sc-chop-namestring (sc-string-cdr namestring)))))
-
-(defun sc-strip-initials (namelist)
-  "Extract the author's initials from the NAMELIST."
-  (if (not namelist)
-      nil
-    (concat (if (string= (car namelist) "")
-		""
-	      (substring (car namelist) 0 1))
-	    (sc-strip-initials (cdr namelist)))))
-
-
-;; ======================================================================
-;; this section handles selection of the attribution and citation strings
-
-(defun sc-populate-alists (from-string)
-  "Put important and useful information in the alists using FROM-STRING.
-Return the list of name symbols."
-  (let* ((namelist (sc-chop-namestring (sc-extract-namestring from-string)))
-	 (revnames (reverse (cdr namelist)))
-	 (midnames (reverse (cdr revnames)))
-	 (firstname (car namelist))
-	 (midnames (reverse (cdr revnames)))
-	 (lastname (car revnames))
-	 (initials (sc-strip-initials namelist))
-	 (emailname (sc-get-emailname from-string))
-	 (n 1)
-	 (symlist (list 'emailname 'initials 'firstname 'lastname)))
-    
-    ;; put basic information
-    (aput 'sc-gal-attributions 'firstname firstname)
-    (aput 'sc-gal-attributions 'lastname lastname)
-    (aput 'sc-gal-attributions 'emailname emailname)
-    (aput 'sc-gal-attributions 'initials initials)
-    
-    (aput 'sc-gal-information "sc-firstname" firstname)
-    (aput 'sc-gal-information "sc-lastname" lastname)
-    (aput 'sc-gal-information "sc-emailname" emailname)
-    (aput 'sc-gal-information "sc-initials" initials)
-    
-    ;; put middle names and build sc-author entry
-    (let ((author (concat firstname " ")))
-      (while midnames
-	(let ((name (car midnames))
-	      (next (cdr midnames))
-	      (symbol (intern (format "middlename%d" n)))
-	      (string (format "sc-middlename-%d" n)))
-	  ;; first put new middlename
-	  (aput 'sc-gal-attributions symbol name)
-	  (aput 'sc-gal-information string name)
-	  (setq n (1+ n))
-	  (nconc symlist (list symbol))
-
-	  ;; now build author name
-	  (setq author (concat author name " "))
-
-	  ;; incr loop
-	  (setq midnames next)
-	  ))
-      (setq author (concat author lastname))
-
-      ;; put author name and email address
-      (aput 'sc-gal-information "sc-author" author)
-      (aput 'sc-gal-information "sc-from-address"
-	    (sc-get-address from-string author))
-      (aput 'sc-gal-information "sc-reply-address"
-	    (sc-get-address (sc-field "reply-to") author))
-      )
-    ;; return value
-    symlist))
-
-(defun sc-sort-attribution-alist ()
-  "Put preferred attribution at head of attributions alist."
-  (asort 'sc-gal-attributions sc-preferred-attribution)
-  
-  ;; use backup scheme if preference is not legal
-  (if (or (null sc-preferred-attribution)
-	  (anot-head-p sc-gal-attributions sc-preferred-attribution)
-	  (let ((prefval (aget sc-gal-attributions
-			       sc-preferred-attribution)))
-	    (or (null prefval)
-		(string= prefval ""))))
-      ;; no legal attribution
-      (if sc-use-only-preference-p
-	  (aput 'sc-gal-attributions 'sc-user-query
-		(sc-query sc-default-attribution))
-	;; else use secondary scheme
-	(asort 'sc-gal-attributions 'firstname))))
-
-(defun sc-build-attribution-alist (from-string)
-  "Extract attributions from FROM-STRING, applying preferences."
-  (let ((symlist (sc-populate-alists from-string))
-	(headval (progn (sc-sort-attribution-alist)
-			(aget sc-gal-attributions
-			      (aheadsym sc-gal-attributions) t))))
-    
-    ;; for each element in the symlist, remove the corresponding 
-    ;; key-value pair in the alist, then insert just the value.
-    (while symlist
-      (let ((value (aget sc-gal-attributions (car symlist) t))
-	    (next (cdr symlist)))
-	(if (not (or (null value)
-		     (string= value "")))
-	    (aput 'sc-gal-attributions value))
-	(adelete 'sc-gal-attributions (car symlist))
-	(setq symlist next)))
-
-    ;; add nicknames to the completion list
-    (let ((gal sc-gal-attributions))
-      (while gal
-	(let ((nns sc-nicknames-alist)
-	      (galname (car (car gal))))
-	  (while nns
-	    (if (string= galname (car (car nns)))
-		(aput 'sc-gal-attributions (car (cdr (car nns)))))
-	    (setq nns (cdr nns)))
-	  (setq gal (cdr gal)))))
-
-    ;; now reinsert the head (preferred) attribution unless it is nil,
-    ;; this effectively just moves the head value to the front of the
-    ;; list.
-    (if headval
-	(aput 'sc-gal-attributions headval))
-    
-    ;; check to be sure alist is not nil
-    (if (null sc-gal-attributions)
-	(aput 'sc-gal-attributions sc-default-attribution))))
-
-(defun sc-select ()
-  "Select an attribution and create a citation string."
-  (cond
-   (sc-nested-citation-p
-    (sc-update-gal ""))
-   ((null (aget sc-gal-information "from" t))
-    (aput 'sc-gal-information "sc-author" sc-default-author-name)
-    (sc-update-gal (sc-query sc-default-attribution)))
-   ((null sc-gal-attributions)
-    (sc-build-attribution-alist (aget sc-gal-information "from" t))
-    (sc-confirm)
-    (sc-update-gal (aheadsym sc-gal-attributions)))
-   (t
-    (sc-confirm)
-    (sc-update-gal (aheadsym sc-gal-attributions))))
-  t)
-
-
-;; ======================================================================
-;; region citing and unciting
-
-(defun sc-cite-region (start end)
-  "Cite a region delineated by START and END."
-  (save-excursion
-    ;; set real end-of-region
-    (goto-char end)
-    (forward-line 1)
-    (set-mark (point))
-    ;; goto real beginning-of-region
-    (goto-char start)
-    (beginning-of-line)
-    (let ((fstart (point))
-	  (fend   (point)))
-      (while (< (point) (sc-mark))
-	;; remove leading whitespace if desired 
-	(and sc-fixup-whitespace-p
-	     (fixup-whitespace))
-	;; if end of line then perhaps autofill
-	(cond ((eolp)
-	       (or (= fstart fend)
-		   (not sc-auto-fill-region-p)
-		   (and sc-auto-fill-query-each-paragraph-p
-			(not (y-or-n-p "Fill this paragraph? ")))
-		   (save-excursion (set-mark fend)
-				   (goto-char (/ (+ fstart fend 1) 2))
-				   (run-hooks 'sc-fill-paragraph-hook)))
-	       (setq fstart (point)
-		     fend (point)))
-	      ;; not end of line so perhaps cite it
-	      ((not (looking-at sc-cite-regexp))
-	       (insert (aget sc-gal-information "sc-citation")))
-	      (sc-nested-citation-p
-	       (insert (aget sc-gal-information "sc-nested-citation"))))
-	(setq fend (point))
-	(forward-line 1))
-      (and sc-auto-fill-query-each-paragraph-p
-	   (message " "))
-      )))
-
-(defun sc-uncite-region (start end cite-regexp)
-  "Uncite a previously cited region delineated by START and END.
-CITE-REGEXP describes how a cited line of texts starts.  Unciting also
-auto-fills paragraph if sc-auto-fill-region-p is non-nil."
-  (save-excursion
-    (set-mark end)
-    (goto-char start)
-    (beginning-of-line)
-    (let ((fstart (point))
-	  (fend (point)))
-      (while (< (point) (sc-mark))
-	;; if end of line, then perhaps autofill
-	(cond ((eolp)
-	       (or (= fstart fend)
-		   (not sc-auto-fill-region-p)
-		   (and sc-auto-fill-query-each-paragraph-p
-			(not (y-or-n-p "Fill this paragraph? ")))
-		   (save-excursion (set-mark fend)
-				   (goto-char (/ (+ fstart fend 1) 2))
-				   (run-hooks 'sc-fill-paragraph-hook)))
-	       (setq fstart (point)
-		     fend (point)))
-	      ;; not end of line so perhaps uncite it
-	      ((looking-at cite-regexp)
-	       (save-excursion
-		 (save-restriction
-		   (narrow-to-region (sc-linepos 'bol) (sc-linepos))
-		   (beginning-of-line)
-		   (delete-region (point-min)
-				  (progn (re-search-forward cite-regexp
-							    (point-max)
-							    t)
-					 (match-end 0)))))))
-	(setq fend (point))
-	(forward-line 1)))))
-
-
-;; ======================================================================
-;; this section contains paragraph filling support
-
-(defun sc-guess-fill-prefix (&optional literalp)
-  "Guess the fill prefix used on the current line.
-Use various heuristics to find the fill prefix. Search begins on first
-non-blank line after point.
-
-     1) If fill-prefix is already bound to the empty string, return
-        nil.
-
-     2) If fill-prefix is already bound, but not to the empty
-        string, return the value of fill-prefix.
-
-     3) If the current line starts with the last chosen citation
-        string, then that string is returned.
-
-     4) If the current line starts with a string matching the regular
-        expression sc-cite-regexp, return the match.  Note that if
-        optional LITERALP is provided and non-nil, then the *string*
-        that matches the regexp is return.  Otherwise, if LITERALP is
-        not provided or is nil, the *regexp* sc-cite-regexp is
-        returned.
-
-     5) If the current line starts with any number of characters,
-        followed by the sc-citation-delimiter and then white space,
-        that match is returned. See comment #4 above for handling of
-        LITERALP. 
-
-     6) Nil is returned."
-  (save-excursion
-    ;; scan for first non-blank line in the region
-    (beginning-of-line)
-    (skip-chars-forward "\n\t ")
-    (beginning-of-line)
-    (let ((citation (aget sc-gal-information "sc-citation"))
-	  (generic-citation
-	   (concat "\\s *[^ \t\n" sc-citation-delimiter "]+>\\s +")))
-      (cond
-       ((string= fill-prefix "") nil)                   ;; heuristic #1
-       (fill-prefix)                                    ;; heuristic #2
-       ((looking-at (regexp-quote citation)) citation)  ;; heuristic #3
-       ((looking-at sc-cite-regexp)                     ;; heuristic #4
-	(if literalp
-	    (buffer-substring
-	     (point)
-	     (progn (re-search-forward (concat sc-cite-regexp "\\s *")
-				       (point-max) nil)
-		    (point)))
-	  sc-cite-regexp))
-       ((looking-at generic-citation)                   ;; heuristic #5
-	(if literalp
-	    (buffer-substring
-	     (point)
-	     (progn (re-search-forward generic-citation) (point)))
-	  generic-citation))
-       (t nil)))))                                      ;; heuristic #6
-
-(defun sc-consistent-cite-p (prefix)
-  "Check current paragraph for consistent citation.
-Scans to paragraph delineated by (forward|backward)-paragraph to see
-if all lines start with PREFIX. Returns t if entire paragraph is
-consistently cited, nil otherwise."
-  (save-excursion
-    (let ((end   (progn (forward-paragraph)
-			(beginning-of-line)
-			(or (not (eolp))
-			    (forward-char -1))
-			(point)))
-	  (start (progn (backward-paragraph)
-			(beginning-of-line)
-			(or (not (eolp))
-			    (forward-char 1))
-			(point)))
-	  (badline t))
-      (goto-char start)
-      (beginning-of-line)
-      (while (and (< (point) end)
-		  badline)
-	(setq badline (looking-at prefix))
-	(forward-line 1))
-      badline)))
-
-(defun sc-fill-start (fill-prefix)
-  "Find buffer position of start of region which begins with FILL-PREFIX.
-Restrict scan to current paragraph."
-  (save-excursion
-    (let ((badline nil)
-	  (top (save-excursion
-		 (backward-paragraph)
-		 (beginning-of-line)
-		 (or (not (eolp))
-		     (forward-char 1))
-		 (point))))
-      (while (and (not badline)
-		  (> (point) top))
-	(forward-line -1)
-	(setq badline (not (looking-at fill-prefix)))))
-    (forward-line 1)
-    (point)))
-
-(defun sc-fill-end (fill-prefix)
-  "Find the buffer position of end of region which begins with FILL-PREFIX.
-Restrict scan to current paragraph."
-  (save-excursion
-    (let ((badline nil)
-	  (bot (save-excursion
-		 (forward-paragraph)
-		 (beginning-of-line)
-		 (or (not (eolp))
-		     (forward-char -1))
-		 (point))))
-      (while (and (not badline)
-		  (< (point) bot))
-	(beginning-of-line)
-	(setq badline (not (looking-at fill-prefix)))
-	(forward-line 1)))
-    (forward-line -1)
-    (point)))
-
-(defun sc-fill-paragraph ()
-  "Supercite's paragraph fill function.
-Fill the paragraph containing or following point. Use
-sc-guess-fill-prefix to find the fill-prefix for the paragraph.
-
-If the paragraph is inconsistently cited (mixed fill-prefix), then the
-user is queried to restrict the the fill to only those lines around
-point which begin with the fill prefix.
-
-The variable sc-fill-arg is passed to fill-paragraph and
-fill-region-as-paragraph which controls justification of the
-paragraph.  sc-fill-arg is set by sc-fill-paragraph-manually."
-  (save-excursion
-    (let ((pnt (point))
-	  (fill-prefix (sc-guess-fill-prefix t)))
-      (cond
-       ((not fill-prefix)
-	(fill-paragraph sc-fill-arg))
-       ((sc-consistent-cite-p fill-prefix)
-	(fill-paragraph sc-fill-arg))
-       ((y-or-n-p "Inconsistent citation found. Restrict? ")
-	(message "")
-	(fill-region-as-paragraph (progn (goto-char pnt)
-					 (sc-fill-start fill-prefix))
-				  (progn (goto-char pnt)
-					 (sc-fill-end fill-prefix))
-				  sc-fill-arg))
-       (t
-	(message "")
-	(progn
-	  (setq fill-prefix (aget sc-gal-information "sc-citation"))
-	  (fill-paragraph sc-fill-arg)))))))
-
-
-;; ======================================================================
-;; the following functions are the top level, interactive commands that
-;; can be bound to key strokes
-
-(defun sc-insert-reference (arg)
-  "Insert, at point, a reference header in the body of the reply.
-Numeric ARG indicates which header style from sc-rewrite-header-list
-to use when rewriting the header. No supplied ARG indicates use of
-sc-preferred-header-style.
-
-With just \\[universal-argument], electric reference insert mode is
-entered, regardless of the value of sc-electric-references-p.  See
-sc-electric-mode for more information."
-  (interactive "P")
-  (if (consp arg)
-      (sc-electric-mode)
-    (let ((pref (cond ((sc-valid-index-p arg) arg)
-		      ((sc-valid-index-p sc-preferred-header-style)
-		       sc-preferred-header-style)
-		      (t 0))))
-      (if sc-electric-references-p (sc-electric-mode pref)
-	(condition-case err
-	    (eval (nth pref sc-rewrite-header-list))
-	  (void-function
-	   (progn (message
-		   "Symbol's function definition is void: %s. (Header %d)."
-		   (symbol-name (car (cdr err)))
-		   pref)
-		  (beep)))
-	  (error
-	   (progn (message "Error evaluating rewrite header function %d."
-			   pref)
-		  (beep)))
-	  )))))
-
-(defun sc-cite (arg)
-  "Cite the region of text between point and mark.
-Numeric ARG, if supplied, is passed unaltered to sc-insert-reference."
-  (interactive "P")
-  (if (not (sc-mark))
-      (error "Please designate a region to cite (i.e. set the mark)."))
-  (catch 'select-abort
-    (let ((sc-cite-context 'citing)
-	  (sc-force-confirmation-p (interactive-p)))
-      (sc-select)
-      (undo-boundary)
-      (let ((xchange (if (> (sc-mark) (point)) nil
-		       (exchange-point-and-mark)
-		       t)))
-	(sc-insert-reference arg)
-	(sc-cite-region (point) (sc-mark))
-	;; leave point on first cited line
-	(while (and (< (point) (sc-mark))
-		    (not (looking-at (aget sc-gal-information
-					   (if sc-nested-citation-p
-					       "sc-nested-citation"
-					     "sc-citation")))))
-	  (forward-line 1))
-	(and xchange
-	     (exchange-point-and-mark))
-	))))
-
-(defun sc-uncite ()
-  "Uncite the region between point and mark."
-  (interactive)
-  (if (not (sc-mark))
-      (error "Please designate a region to uncite (i.e. set the mark)."))
-  (undo-boundary)
-  (let ((xchange (if (> (sc-mark) (point)) nil
-		   (exchange-point-and-mark)
-		   t))
-	(fp (or (sc-guess-fill-prefix)
-		"")))
-    (sc-uncite-region (point) (sc-mark) fp)
-    (and xchange
-	 (exchange-point-and-mark))))
-
-(defun sc-recite ()
-  "Recite the region by first unciting then citing the text."
-  (interactive)
-  (if (not (sc-mark))
-      (error "Please designate a region to recite (i.e. set the mark)."))
-  (catch 'select-abort
-    (let ((sc-cite-context 'reciting)
-	  (sc-force-confirmation-p t))
-      (sc-select)
-      (undo-boundary)
-      (let ((xchange (if (> (sc-mark) (point)) nil
-		       (exchange-point-and-mark)
-		       t))
-	    (fp (or (sc-guess-fill-prefix)
-		    "")))
-	(sc-uncite-region (point) (sc-mark) fp)
-	(sc-cite-region (point) (sc-mark))
-	(and xchange
-	     (exchange-point-and-mark))
-	))))
-
-(defun sc-insert-citation ()
-  "Insert citation string at beginning of current line."
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (insert (aget sc-gal-information "sc-citation"))))
-
-(defun sc-open-line (arg)
-  "Insert a newline and leave point before it.
-Also inserts the guessed prefix at the beginning of the new line. With
-numeric ARG, inserts that many new lines."
-  (interactive "p")
-  (save-excursion
-    (let ((start (point))
-	  (string (or (sc-guess-fill-prefix t)
-		      "")))
-      (open-line arg)
-      (goto-char start)
-      (forward-line 1)
-      (while (< 0 arg)
-	(insert string)
-	(forward-line 1)
-	(setq arg (- arg 1))))))
-
-(defun sc-fill-paragraph-manually (arg)
-  "Fill current cited paragraph.
-Really just runs the hook sc-fill-paragraph-hook, however it does set
-the global variable sc-fill-arg to the value of ARG.  This is
-currently the only way to pass an argument to a hookified function."
-  (interactive "P")
-  (setq sc-fill-arg arg)
-  (run-hooks 'sc-fill-paragraph-hook))
-
-(defun sc-modify-information (arg)
-  "Interactively modify information in the information alist.
-\\[universal-argument] if supplied, deletes the entry from the alist.
-You can add an entry by supplying a key instead of completing."
-  (interactive "P")
-  (let* ((delete-p   (consp arg))
-	 (action     (if delete-p "delete" "modify"))
-	 (defaultkey (aheadsym sc-gal-information))
-	 (prompt     (concat "Select information key to "
-			     action ": (default "
-			     defaultkey ") "))
-	 (key (completing-read prompt sc-gal-information))
-	 )
-    (if (or (string= key "")
-	    (null key))
-	(setq key defaultkey))
-    (if delete-p (adelete 'sc-gal-information key)
-      (let* ((oldval (aget sc-gal-information key t))
-	     (prompt (concat "Enter new value for key \""
-			     key "\" (default \"" oldval "\") "))
-	     (newval (read-input prompt)))
-	(if (or (string= newval "")
-		(null newval))
-	    nil
-	  (aput 'sc-gal-information key newval)
-	  )))))
-
-(defun sc-view-field (arg)
-  "View field values in the information alist.
-This is essentially an interactive version of sc-field, and is similar
-to sc-modify-information, except that the field values can't be
-modified. With \\[universal-argument], if supplied, inserts the value
-into the current buffer as well."
-  (interactive "P")
-  (let* ((defaultkey (aheadsym sc-gal-information))
-	 (prompt     (concat "View information key: (default "
-			     defaultkey ") "))
-	 (key (completing-read prompt sc-gal-information)))
-    (if (or (string= key "")
-	    (null key))
-	(setq key defaultkey))
-    (let* ((val (aget sc-gal-information key t))
-	   (pval (if val (concat "\"" val "\"") "nil")))
-      (message "value of key %s: %s" key pval)
-      (if (and key (consp arg)) (insert val)))))
-
-(defun sc-glom-headers ()
-  "Glom information from mail headers in region between point and mark.
-Any old information is lost, unless an error occurs."
-  (interactive)
-  (let ((attr (copy-sequence sc-gal-attributions))
-	(info (copy-sequence sc-gal-information)))
-    (setq sc-gal-attributions nil
-	  sc-gal-information nil)
-    (let (start end
-	  (sc-force-confirmation-p t)
-	  (sc-cite-context nil))
-      (let ((mark-active t))
-	(setq start (region-beginning)
-	      end (region-end)))
-      (sc-fetch-fields start end)
-      (if (null sc-gal-information)
-	  (progn
-	    (message "No mail headers found! Restoring old information.")
-	    (setq sc-gal-attributions attr
-		  sc-gal-information info))
-	(sc-mail-yank-clear-headers start end)
-	(if (not (catch 'select-abort
-		   (condition-case foo
-		       (sc-select)
-		     (quit (beep) (throw 'select-abort nil)))
-		   ))
-	    (setq sc-gal-attributions attr
-		  sc-gal-information info))
-	))))
-
-(defun sc-version (arg)
-  "Show supercite version.
-Universal argument (\\[universal-argument]) ARG inserts version
-information in the current buffer instead of printing the message in
-the echo area."
-  (interactive "P")
-  (if (consp arg)
-      (insert "Using Supercite version " sc-version-number)
-    (message "Using Supercite version %s" sc-version-number)))
-
-
-;; ======================================================================
-;; leach onto current mode
-
-(defun sc-append-current-keymap ()
-  "Append some useful key bindings to the current local key map.
-This searches sc-local-keymap for the keymap to install based on the
-major-mode of the current buffer."
-  (let ((hook (car (cdr (assq major-mode sc-local-keymaps)))))
-    (cond
-     ((not hook)
-      (run-hooks 'sc-default-keymap))
-     ((not (listp hook))
-      (setq hook (car (cdr (assq hook sc-local-keymaps))))
-      (run-hooks 'hook))
-     (t
-      (run-hooks 'hook))))
-  (setq sc-leached-keymap (current-local-map)))
-
-(defun sc-snag-all-keybindings ()
-  "Snag all keybindings in major-mode's current keymap."
-  (let* ((curkeymap (current-local-map))
-	 (symregexp ".*sc-.*\n")
-	 (docstring (substitute-command-keys "\\{curkeymap}"))
-	 (start 0)
-	 (maxend (length docstring))
-	 (spooge ""))
-    (while (and (< start maxend)
-		(string-match symregexp docstring start))
-      (setq spooge (concat spooge (substring docstring
-					     (match-beginning 0)
-					     (match-end 0))))
-      (setq start (match-end 0)))
-    spooge))
-
-(defun sc-spoogify-docstring ()
-  "Modifies (makes into spooge) the docstring for the current major mode.
-This will leach the keybinding descriptions for supercite onto the end
-of the current major mode's docstring.  If major mode is preloaded,
-this function will first make a copy of the list associated with the
-mode, then modify this copy."
-  (let* ((symfunc (symbol-function major-mode))
-         (doc-cdr (and (listp symfunc) (nthcdr 2 symfunc)))
-	 (doc-str (documentation major-mode)))
-    (cond
-     ;; is a docstring even provided?
-     ((not (stringp doc-str)))
-     ;; have we already leached on?
-     ((string-match "Supercite" doc-str))
-     ;; lets build the new doc string
-     (t
-      (let* ((described (sc-snag-all-keybindings))
-	     (commonstr "
-
-The major mode for this buffer has been modified to include the
-Supercite 2.3 package for handling attributions and citations of
-original messages in email replies.  For more information on this
-package, type \"\\[sc-describe]\".")
-	    (newdoc-str
-	     (concat doc-str commonstr
-		     (if (not (string= described ""))
-			 (concat "\n\nThe following keys are bound "
-				 "to Supercite commands:\n\n"
-				 described)))
-	     ))
-        (cond
-         (doc-cdr
-          (condition-case nil
-              (setcar doc-cdr newdoc-str)
-            (error
-             ;; the major mode must be preloaded, make a copy first
-             (setq symfunc (copy-sequence (symbol-function major-mode))
-                   doc-cdr (nthcdr 2 symfunc))
-             (setcar doc-cdr newdoc-str)
-             (fset major-mode symfunc))))
-         ;; lemacs 19 byte-code.
-         ;; Set function to a new byte-code vector with the
-         ;; new documentation in the documentation slot (element 4).
-         ;; We can't use aset because aset won't allow you to modify
-         ;; a byte-code vector.
-         ;; Include element 5 if the vector has one.
-         (t
-          (fset major-mode
-                (apply 'make-byte-code
-                       (aref symfunc 0) (aref symfunc 1)
-                       (aref symfunc 2) (aref symfunc 3)
-                       newdoc-str
-                       (if (> (length symfunc) 5)
-                           (list (aref symfunc 5)))))
-	  )))))))
-
-
-;; ======================================================================
-;; this section contains default hooks and hook support for execution
-
-;;;###autoload
-(defun sc-cite-original ()
-  "Hook version of sc-cite.
-This is callable from the various mail and news readers' reply
-function according to the agreed upon standard. See \\[sc-describe]
-for more details.  Sc-cite-original does not do any yanking of the
-original message but it does require a few things:
-
-     1) The reply buffer is the current buffer.
-
-     2) The original message has been yanked and inserted into the
-        reply buffer.
-
-     3) Verbose mail headers from the original message have been
-        inserted into the reply buffer directly before the text of the
-        original message.
-
-     4) Point is at the beginning of the verbose headers.
-
-     5) Mark is at the end of the body of text to be cited."
-  (run-hooks 'sc-pre-hook)
-  (setq sc-gal-attributions nil)
-  (setq sc-gal-information nil)
-  (let (start end)
-    (let ((mark-active t))
-      (setq start (region-beginning)
-	    end (region-end)))
-    (sc-fetch-fields start end)
-    (sc-mail-yank-clear-headers start end)
-    (if (not sc-all-but-cite-p)
-	(sc-cite sc-preferred-header-style))
-    (sc-append-current-keymap)
-    (sc-spoogify-docstring)
-    (run-hooks 'sc-post-hook)))
-
-
-;; ======================================================================
-;; describe this package
-;;
-(defun sc-describe ()
-  "Supercite version 2.3 is now described in a texinfo manual which
-makes the documentation available both for online perusal via emacs'
-info system, or for hard-copy printing using the TeX facility.
-
-To view the online document hit \\[info], then \"mSupercite <RET>\"."
-  (interactive)
-  (describe-function 'sc-describe))
-
-;; ======================================================================
-;; load hook
-(run-hooks 'sc-load-hook)
-(provide 'sc)
diff --git a/lisp/=sun-keys.el b/lisp/=sun-keys.el
deleted file mode 100644
index f91abc2063f..00000000000
--- a/lisp/=sun-keys.el
+++ /dev/null
@@ -1,77 +0,0 @@
-;;; sun-keys.el --- support for Sun function keys
-
-;;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; Author: Ian G. Batten <batten@uk.ac.bham.multics>
-;; Keywords: terminals
-
-;;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; Support (cleanly) for Sun function keys.  Provides help facilities,
-;;; better diagnostics, etc.
-;;;
-;;; To use: make sure your .ttyswrc binds 'F1' to <ESC> * F1 <CR> and so on.
-;;;         load this lot from your start_up
-
-;;; Code:
-
-(defun sun-function-keys-dispatch (arg)
-  "Dispatcher for function keys."
-  (interactive "p")
-  (let* ((key-stroke (read t))
-         (command (assq key-stroke sun-function-keys-command-list)))
-    (cond (command (funcall (cdr command) arg))
-          (t (error "Unbound function key %s" key-stroke)))))
-
-(defvar sun-function-keys-command-list 
-  '((F1 . sun-function-keys-describe-bindings)
-    (R8 . previous-line)                ; arrow keys
-    (R10 . backward-char)
-    (R12 . forward-char)
-    (R14 . next-line)))
-
-(defun sun-function-keys-bind-key (arg1 arg2)
-  "Bind a specified key."
-  (interactive "xFunction Key Cap Label:
-CCommand To Use:")
-  (setq sun-function-keys-command-list 
-        (cons (cons arg1 arg2) sun-function-keys-command-list)))
-
-(defun sun-function-keys-describe-bindings (arg)
-  "Describe the function key bindings we're running"
-  (interactive)
-  (with-output-to-temp-buffer "*Help*"
-    (sun-function-keys-write-bindings
-     (sort (copy-sequence sun-function-keys-command-list)
-           '(lambda (x y) (string-lessp (car x) (car y)))))))
-
-(defun sun-function-keys-write-bindings (list)
-  (cond ((null list)
-         t)
-        (t
-         (princ (format "%s: %s\n" 
-                        (car (car list))
-                        (cdr (car list))))
-         (sun-function-keys-write-bindings (cdr list)))))
-    
-(global-set-key "\e*" 'sun-function-keys-dispatch)
-
-(make-variable-buffer-local 'sun-function-keys-command-list)
-
-;;; sun-keys.el ends here
diff --git a/lisp/=superyank.el b/lisp/=superyank.el
deleted file mode 100644
index f76e6c7c3bf..00000000000
--- a/lisp/=superyank.el
+++ /dev/null
@@ -1,1243 +0,0 @@
-;;; superyank.el --- smart message-yanking code for GNUS
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Barry A. Warsaw <warsaw@cme.nist.gov>
-;; Version: 1.1
-;; Adapted-By: ESR
-;; Keywords: news
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Inserts the message being replied to with various user controlled
-;; citation styles.
-;;
-
-;; This file is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY.  No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing.  Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; this file, but only under the conditions described in the
-;; GNU Emacs General Public License.   A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities.  It should be in a
-;; file named COPYING.  Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-
-;; NAME: Barry A. Warsaw                USMAIL: National Institute of Standards
-;; TELE: (301) 975-3460                         and Technology (formerly NBS)
-;; UUCP: {...}!uunet!cme-durer!warsaw           Rm. B-124, Bldg. 220
-;; ARPA: warsaw@cme.nist.gov                    Gaithersburg, MD 20899
-
-;; Modification history:
-;;
-;; modified: 14-Jun-1989 baw (better keymap set procedure, rewrite-headers)
-;; modified: 12-Jun-1989 baw (added defvar for sy-use-only-preference-p)
-;; modified:  6-Jun-1989 baw (better sy-rewrite-headers, no kill/yank)
-;; modified:  5-Jun-1989 baw (requires rnewspost.el)
-;; modified:  1-Jun-1989 baw (persistent attribution, sy-open-line)
-;; modified: 31-May-1989 baw (fixed some gnus problems, id'd another)
-;; modified: 22-May-1989 baw (documentation)
-;; modified:  8-May-1989 baw (auto filling of regions)
-;; modified:  1-May-1989 baw (documentation)
-;; modified: 27-Apr-1989 baw (new preference scheme)
-;; modified: 24-Apr-1989 baw (remove gnus headers, attrib scheme, cite lines)
-;; modified: 19-Apr-1989 baw (cite key, fill p, yank region, naming scheme)
-;; modified: 12-Apr-1989 baw (incorp other mail yank features seen on net)
-;; created : 16-Feb-1989 baw (mod vanilla fn indent-rigidly mail-yank-original)
-
-;; Though I wrote this package basically from scratch, as an Emacs Lisp
-;; learning exercise, it was inspired by postings of similar packages to
-;; the gnu.emacs newsgroup over the past month or so.
-;;
-;; Here's a brief history of how this package developed:
-;;
-;; I as well as others on the net were pretty unhappy about the way emacs
-;; cited replies with the tab or 4 spaces.  It looked ugly and made it hard
-;; to distinguish between original and cited lines.  I hacked on the function
-;; yank-original to at least give the user the ability to define the citation
-;; character.  I posted this simple hack, and others did as well.  The main
-;; difference between mine and others was that a space was put after the
-;; citation string on on new citations, but not after previously cited lines:
-;;
-;; >> John wrote this originally
-;; > Jane replied to that
-;;
-;; Then Martin Neitzel posted some code that he developed, derived in part
-;; from code that Ashwin Ram posted previous to that.  In Martin's
-;; posting, he introduced a new, and (IMHO) superior, citation style,
-;; eliminating nested citations.  Yes, I wanted to join the Small-But-
-;; Growing-Help-Stamp-Out-Nested-Citation-Movement! You should too.
-;;
-;; But Martin's code simply asks the user for the citation string (here
-;; after called the `attribution' string), and I got to thinking, it wouldn't
-;; be that difficult to automate that part.  So I started hacking this out.
-;; It proved to be not as simple as I first thought.  But anyway here it
-;; is.  See the wish list below for future plans (if I have time).
-;;
-;; Type "C-h f mail-yank-original" after this package is loaded to get a
-;; description of what it does and the variables that control it.
-;;
-;; ======================================================================
-;;
-;; Changes wish list
-;;
-;; 1) C-x C-s yanks a region from the RMAIL buffer instead of the
-;;    whole buffer
-;;
-;; 2) reparse nested citations to try to recast as non-nested citations
-;;    perhaps by checking the References: line
-;;
-
-;;; Code:
-
-;; ======================================================================
-;;
-;; require and provide features
-;;
-(require 'sendmail)
-;;
-;; ======================================================================
-;;
-;; don't need rnewspost.el to rewrite the header.  This only works
-;; with diffs to rnewspost.el that I posted with the original
-;; superyank code.
-;;
-(setq news-reply-header-hook nil)
-
-;; **********************************************************************
-;; start of user defined variables
-;; **********************************************************************
-;;
-;; this section defines variables that control the operation of
-;; super-mail-yank.  Most of these are described in the comment section
-;; as well as the DOCSTRING.
-;;
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; this variable holds the default author's name for citations
-;;
-(defvar sy-default-attribution "Anon"
-  "String that describes attribution to unknown person. This string
-should not contain the citation string.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; string used as an end delimiter for both nested and non-nested citations
-;;
-(defvar sy-citation-string ">"
-  "String to use as an end-delimiter for citations.  This string is
-used in both nested and non-nested citations.  For best results, use a
-single character with no trailing space.  Most commonly used string
-is: \">\.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; variable controlling citation type, nested or non-nested
-;;
-(defvar sy-nested-citation-p nil
-  "Non-nil uses nested citations, nil uses non-nested citations.
-Nested citations are of the style:
-
-I wrote this
-> He wrote this
->> She replied to something he wrote
-
-Non-nested citations are of the style:
-
-I wrote this
-John> He wrote this
-Jane> She originally wrote this")
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; regular expression that matches existing citations
-;;
-(defvar sy-cite-regexp "[a-zA-Z0-9]*>"
-  "Regular expression that describes how an already cited line in an
-article begins.  The regexp is only used at the beginning of a line,
-so it doesn't need to begin with a '^'.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; regular expression that delimits names from titles in the field that
-;; looks like:   (John X. Doe -- Computer Hacker Extraordinaire)
-;;
-(defvar sy-titlecue-regexp "\\s +-+\\s +"
-  
-  "Regular expression that delineates names from titles in the name
-field.  Often, people will set up their name field to look like this:
-
-(John Xavier Doe -- Computer Hacker Extraordinaire)
-
-Set to nil to treat entire field as a name.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;;
-(defvar sy-preferred-attribution 2
-  
-  "This is an integer indicating what the user's preference is in
-attribution style, based on the following key:
-
-0: email address name is preferred
-1: initials are preferred
-2: first name is preferred
-3: last name is preferred
-
-The value of this variable may also be greater than 3, which would
-allow you to prefer the 2nd through nth - 1 name.  If the preferred
-attribution is nil or the empty string, then the secondary preferrence
-will be the first name.  After that, the entire name alist is search
-until a non-empty, non-nil name is found.  If no such name is found,
-then the user is either queried or the default attribution string is
-used depending on the value of sy-confirm-always-p.
-
-Examples:
-
-assume the from: line looks like this:
-
-from: doe@computer.some.where.com (John Xavier Doe)
-
-The following preferences would return these strings:
-
-0: \"doe\"
-1: \"JXD\"
-2: \"John\"
-3: \"Doe\"
-4: \"Xavier\"
-
-anything else would return \"John\".")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-(defvar sy-confirm-always-p t
-  "If t, always confirm attribution string before inserting into
-buffer.")
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; informative header hook
-;;
-(defvar sy-rewrite-header-hook 'sy-header-on-said
-  "Hook for inserting informative header at the top of the yanked
-message. Set to nil for no header.  Here is a list of predefined
-header styles; you can use these as a model to write you own:
-
-sy-header-on-said [default]:   On 14-Jun-1989 GMT,
-                               John Xavier Doe said:
-
-sy-header-inarticle-writes:    In article <123456789> John Xavier Doe writes:
-
-sy-header-regarding-writes:    Regarding RE: superyank; John Xavier Doe adds:
-
-sy-header-verbose:             On 14-Jun-1989 GMT, John Xavier Doe
-                               from the organization Great Company
-                               has this to say about article <123456789>
-                               in newsgroups misc.misc
-                               concerning RE: superyank
-                               referring to previous articles <987654321>
-
-You can use the following variables as information strings in your header:
-
-sy-reply-yank-date:         the date field              [ex: 14-Jun-1989 GMT]
-sy-reply-yank-from:         the from field              [ex: John Xavier Doe]
-sy-reply-yank-message-id:   the message id              [ex: <123456789>]
-sy-reply-yank-subject:      the subject line            [ex: RE: superyank]
-sy-reply-yank-newsgroup:    the newsgroup name for GNUS [ex: misc.misc]
-sy-reply-yank-references:   the article references      [ex: <987654321>]
-sy-reply-yank-organization: the author's organization   [ex: Great Company]
-
-If a field can't be found, because it doesn't exist or is not being
-shown, perhaps because of toggle-headers, the corresponding field
-variable will contain the string \"mumble mumble\".")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; non-nil means downcase the author's name string
-;;
-(defvar sy-downcase-p nil
-  "Non-nil means downcase the author's name string.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; controls removal of leading white spaces
-;;
-(defvar sy-left-justify-p nil
-  "If non-nil, delete all leading white space before citing.")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; controls auto filling of region
-;;
-(defvar sy-auto-fill-region-p nil
-  "If non-nil, automatically fill each paragraph that is cited.  If
-nil, do not auto fill each paragraph.")
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; controls use of preferred attribution only, or use of attribution search
-;; scheme if the preferred attrib can't be found.
-;;
-(defvar sy-use-only-preference-p nil
-  
-  "If non-nil, then only the preferred attribution string will be
-used.  If the preferred attribution string can not be found, then the
-sy-default-attribution will be used.  If nil, and the preferred
-attribution string is not found, then some secondary scheme will be
-employed to find a suitable attribution string.")
-
-;; **********************************************************************
-;; end of user defined variables
-;; **********************************************************************
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; The new citation style means we can clean out other headers in addition
-;; to those previously cleaned out.  Anyway, we create our own headers.
-;; Also, we want to clean out any headers that gnus puts in.  Add to this
-;; for other mail or news readers you may be using.
-;;
-(setq mail-yank-ignored-headers "^via:\\|^origin:\\|^status:\\|^re\\(mail\\|ceiv\\)ed\\|^[a-z-]*message-id:\\|^\\(summary-\\)?line[s]?:\\|^cc:\\|^subject:\\|^\\(\\(in-\\)?reply-\\)?to:\\|^\\(\\(return\\|reply\\)-\\)?path:\\|^\\(posted-\\)?date:\\|^\\(mail-\\)?from:\\|^newsgroup[s]?:\\|^organization:\\|^keywords:\\|^distribution:\\|^references:")
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; global variables, not user accessable
-;;
-(setq sy-persist-attribution (concat sy-default-attribution "> "))
-(setq sy-reply-yank-date "")
-(setq sy-reply-yank-from "")
-(setq sy-reply-yank-message-id "")
-(setq sy-reply-yank-subject "")
-(setq sy-reply-yank-newsgroups "")
-(setq sy-reply-yank-references "")
-(setq sy-reply-yank-organization "")
-
-;;
-;; ======================================================================
-;;
-;; This section contains primitive functions used in the schemes.  They
-;; extract name fields from various parts of the "from:" field based on
-;; the control variables described above.
-;;
-;; Some will use recursion to pick out the correct namefield in the namestring
-;; or the list of initials.  These functions all scan a string that contains
-;; the name, ie:  "John Xavier Doe".  There is no limit on the number of names
-;; in the string.  Also note that all white spaces are basically ignored and
-;; are stripped from the returned strings, and titles are ignored if 
-;; sy-titlecue-regexp is set to non-nil.
-;;
-;; Others will use methods to try to extract the name from the email
-;; address of the originator.  The types of addresses readable are
-;; described above.
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; try to extract the name from an email address of the form
-;; name%[stuff]
-;;
-;; Unlike the get-name functions above, these functions operate on the
-;; buffer instead of a supplied name-string.
-;;
-(defun sy-%-style-address ()
-  (beginning-of-line)
-  (buffer-substring
-   (progn (re-search-forward "%" (point-max) t)
-	  (if (not (bolp)) (forward-char -1))
-	  (point))
-   (progn (re-search-backward "^\\|[^a-zA-Z0-9]")
-	  (point))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; try to extract names from addresses with the form:
-;; [stuff]name@[stuff]
-;;
-(defun sy-@-style-address ()
-  (beginning-of-line)
-  (buffer-substring
-   (progn (re-search-forward "@" (point-max) t)
-	  (if (not (bolp)) (forward-char -1))
-	  (point))
-   (progn (re-search-backward "^\\|[^a-zA-Z0-0]")
-	  (if (not (bolp)) (forward-char 1))
-	  (point))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; try to extract the name from addresses with the form:
-;; [stuff]![stuff]...!name[stuff]
-;;
-(defun sy-!-style-address ()
-  (beginning-of-line)
-  (buffer-substring
-   (progn (while (re-search-forward "!" (point-max) t))
-	  (point))
-   (progn (re-search-forward "[^a-zA-Z0-9]\\|$")
-	  (if (not (eolp)) (forward-char -1))
-	  (point))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; using the different email name schemes, try each one until you get a
-;; non-nil entry
-;;
-(defun sy-get-emailname ()
-  (let ((en1 (sy-%-style-address))
-	(en2 (sy-@-style-address))
-	(en3 (sy-!-style-address)))
-    (cond
-     ((not (string-equal en1 "")) en1)
-     ((not (string-equal en2 "")) en2)
-     ((not (string-equal en3 "")) en3)
-     (t ""))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; returns the "car" of the namestring, really the first namefield
-;;
-;; (sy-string-car "John Xavier Doe")
-;; => "John"
-;;
-(defun sy-string-car (namestring)
-  (substring namestring
-	     (progn (string-match "\\s *" namestring) (match-end 0))
-	     (progn (string-match "\\s *\\S +" namestring) (match-end 0))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; returns the "cdr" of the namestring, really the whole string from
-;; after the first name field to the end of the string.
-;;
-;; (sy-string-cdr "John Xavier Doe")
-;; => "Xavier Doe"
-;;
-(defun sy-string-cdr (namestring)
-  (substring namestring
-	     (progn (string-match "\\s *\\S +\\s *" namestring)
-		    (match-end 0))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; convert a namestring to a list of namefields
-;;
-;; (sy-namestring-to-list "John Xavier Doe")
-;; => ("John" "Xavier" "Doe")
-;;
-(defun sy-namestring-to-list (namestring)
-  (if (not (string-match namestring ""))
-      (append (list (sy-string-car namestring))
-	      (sy-namestring-to-list (sy-string-cdr namestring)))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; strip the initials from each item in the list and return a string
-;; that is the concatenation of the initials
-;;
-(defun sy-strip-initials (raw-nlist)
-  (if (not raw-nlist)
-      nil
-    (concat (substring (car raw-nlist) 0 1)
-	    (sy-strip-initials (cdr raw-nlist)))))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; using the namestring, build a list which is in the following order
-;;
-;; (email, initials, firstname, lastname, name1, name2, name3 ... nameN-1)
-;;
-(defun sy-build-ordered-namelist (namestring)
-  (let* ((raw-nlist (sy-namestring-to-list namestring))
-	 (initials (sy-strip-initials raw-nlist))
-	 (firstname (car raw-nlist))
-	 (revnames (reverse (cdr raw-nlist)))
-	 (lastname (car revnames))
-	 (midnames (reverse (cdr revnames)))
-	 (emailnames (sy-get-emailname)))
-    (append (list emailnames)
-	    (list initials)
-	    (list firstname)
-	    (list lastname)
-	    midnames)))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; Query the user for the attribution string.  Supply sy-default-attribution
-;; as the default choice.
-;;
-(defun sy-query-for-attribution ()
-  (concat 
-   (let* ((prompt (concat "Enter attribution string: (default "
-			  sy-default-attribution
-			  ") "))
-	  (query (read-input prompt))
-	  (attribution (if (string-equal query "")
-			   sy-default-attribution
-			 query)))
-     (if sy-downcase-p
-	 (downcase attribution)
-       attribution))
-   sy-citation-string))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; parse the current line for the namestring
-;;
-(defun sy-get-namestring ()
-  (save-restriction
-    (beginning-of-line)
-    (if (re-search-forward "(.*)" (point-max) t)
-	(let ((start (progn
-		       (beginning-of-line)
-		       (re-search-forward "\\((\\s *\\)\\|$" (point-max) t)
-		       (point)))
-	      (end (progn
-		     (re-search-forward
-		      (concat "\\(\\s *\\()\\|" sy-titlecue-regexp "\\)\\)\\|$")
-		      (point-max) t)
-		     (point))))
-	  (narrow-to-region start end)
-	  (let ((start (progn
-			 (beginning-of-line)
-			 (point)))
-		(end (progn
-		       (end-of-line)
-		       (re-search-backward
-			(concat "\\s *\\()\\|" sy-titlecue-regexp "\\)$")
-			(point-min) t)
-		       (point))))
-	    (buffer-substring start end)))
-      (let ((start (progn
-		     (beginning-of-line)
-		     (re-search-forward "^\"*")
-		     (point)))
-	    (end (progn
-		   (re-search-forward "\\(\\s *[a-zA-Z0-9\\.]+\\)*"
-				      (point-max) t)
-		   (point))))
-	(buffer-substring start end)))))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; scan the nlist and return the integer pointing to the first legal
-;; non-empty namestring.  Returns the integer pointing to the index
-;; in the nlist of the preferred namestring, or nil if no legal
-;; non-empty namestring could be found.
-;;
-(defun sy-return-preference-n (nlist)
-  (let ((p sy-preferred-attribution)
-	(exception nil))
-    ;;
-    ;; check to be sure the index is not out-of-bounds
-    ;;
-    (cond
-     ((< p 0) (setq p 2) (setq exception t))
-     ((not (nth p nlist)) (setq p 2) (setq exception t)))
-    ;;
-    ;; check to be sure that the explicit preference is not empty
-    ;;
-    (if (string-equal (nth p nlist) "")
-	(progn (setq p 0)
-	       (setq exception t)))
-    ;;
-    ;; find the first non-empty namestring
-    ;;
-    (while (and (nth p nlist)
-		(string-equal (nth p nlist) ""))
-      (setq exception t)
-      (setq p (+ p 1)))
-    ;;
-    ;; return the preference index if non-nil, otherwise nil
-    ;;
-    (if (or (and exception sy-use-only-preference-p)
-	    (not (nth p nlist)))
-	nil
-      p)))
-
-;;
-;;
-;; ----------------------------------------------------------------------
-;;
-;; rebuild the nlist into an alist for completing-read.  Use as a guide
-;; the index of the preferred name field.  Get the actual preferred
-;; name field base on other factors (see above).  If no actual preferred
-;; name field is found, then query the user for the attribution string.
-;;
-;; also note that the nlist is guaranteed to be non-empty.  At the very
-;; least it will consist of 4 empty strings ("" "" "" "")
-;; 
-(defun sy-nlist-to-alist (nlist)
-  (let ((preference (sy-return-preference-n nlist))
-	alist
-	(n 0))
-    ;;
-    ;; check to be sure preference is not nil
-    ;;
-    (if (not preference)
-	(setq alist (list (cons (sy-query-for-attribution) nil)))
-      ;;
-      ;; preference is non-nil
-      ;;
-      (setq alist (list (cons (nth preference nlist) nil)))
-      (while (nth n nlist)
-	(if (= n preference) nil
-	  (setq alist (append alist (list (cons (nth n nlist) nil)))))
-	(setq n (+ n 1))))
-    alist))
-
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; confirm if desired after the alist has been built
-;;
-(defun sy-get-attribution (alist)
-  (concat
-   ;;
-   ;; check to see if nested citations are to be used
-   ;;
-   (if sy-nested-citation-p
-       ""
-     ;;
-     ;; check to see if confirmation is needed
-     ;; if not, just return the preference (first element in alist)
-     ;;
-     (if (not sy-confirm-always-p)
-	 (car (car alist))
-       ;;
-       ;; confirmation is requested so build the prompt, confirm
-       ;; and return the chosen string
-       ;;
-       (let* (ignore
-	      (prompt (concat "Complete attribution string: (default "
-			      (car (car alist))
-			      ") "))
-	      ;;
-	      ;; set up the local completion keymap
-	      ;;
-	      (minibuffer-local-must-match-map
-	       (let ((map (make-sparse-keymap)))
-		 (define-key map "?"    'minibuffer-completion-help)
-		 (define-key map " "    'minibuffer-complete-word)
-		 (define-key map "\t"   'minibuffer-complete)
-		 (define-key map "\00A" 'exit-minibuffer)
-		 (define-key map "\00D" 'exit-minibuffer)
-		 (define-key map "\007"
-		   '(lambda ()
-		      (interactive)
-		      (beep)
-		      (exit-minibuffer)))
-		 map))
-	      ;;
-	      ;; read the completion
-	      ;;
-	      (attribution (completing-read prompt alist))
-	      ;;
-	      ;; check attribution string for emptyness
-	      ;;
-	      (choice (if (or (not attribution)
-			      (string-equal attribution ""))
-			  (car (car alist))
-			attribution)))
-	 
-	 (if sy-downcase-p
-	     (downcase choice)
-	   choice))))
-   sy-citation-string))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; this function will scan the current rmail buffer, narrowing it to the
-;; from: line, then using this, it will try to decipher some names from
-;; that line.  It will then build the name alist and try to confirm
-;; its choice of attribution strings.  It returns the chosen attribution
-;; string.
-;;
-(defun sy-scan-rmail-for-names (rmailbuffer)
-  (save-excursion
-    (let ((case-fold-search t)
-	  alist
-	  attribution)
-      (switch-to-buffer rmailbuffer)
-      (goto-char (point-min))
-      ;;
-      ;; be sure there is a from: line
-      ;;
-      (if (not (re-search-forward "^from:\\s *" (point-max) t))
-	  (setq attribution (sy-query-for-attribution))
-	;;
-	;; if there is a from: line, then scan the narrow the buffer,
-	;; grab the namestring, and build the alist, then using this
-	;; get the attribution string.
-	;;
-	(save-restriction
-	  (narrow-to-region (point)
-			    (progn (end-of-line) (point)))
-	  (let* ((namestring (sy-get-namestring))
-		 (nlist (sy-build-ordered-namelist namestring)))
-	    (setq alist (sy-nlist-to-alist nlist))))
-	;;
-	;; we've built the alist, now confirm the attribution choice
-	;; if appropriate
-	;;
-	(setq attribution (sy-get-attribution alist)))
-      attribution)))
-
-
-;;
-;; ======================================================================
-;;
-;; the following function insert of citations, writing of headers, filling
-;; paragraphs and general higher level operations
-;;
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; insert a nested citation
-;;
-(defun sy-insert-citation (start end cite-string)
-  (save-excursion
-    (goto-char end)
-    (setq end (point-marker))
-    (goto-char start)
-    (or (bolp)
-	(forward-line 1))
-    
-    (let ((fill-prefix (concat cite-string " "))
-	  (fstart (point))
-	  (fend (point)))
-      
-      (while (< (point) end)
-	;;
-	;; remove leading tabs if desired
-	;;
-	(if sy-left-justify-p
-	    (delete-region (point)
-			   (progn (skip-chars-forward " \t") (point))))
-	;;
-	;; check to see if the current line should be cited
-	;;
-	(if (or (eolp)
-		(looking-at sy-cite-regexp))
-	    ;;
-	    ;; do not cite this line unless nested-citations are to be 
-	    ;; used
-	    ;;
-	    (progn
-	      (or (eolp)
-		  (if sy-nested-citation-p
-		      (insert cite-string)))
-	      
-	      ;; set fill start and end points
-	      ;;
-	      (or (= fstart  fend)
-		  (not sy-auto-fill-region-p)
-		  (progn (goto-char fend)
-			 (or (not (eolp))
-			     (setq fend (+ fend 1)))
-			 (fill-region-as-paragraph fstart fend)))
-	      (setq fstart (point))
-	      (setq fend (point)))
-	  
-	  ;; else
-	  ;;
-	  (insert fill-prefix)
-	  (end-of-line)
-	  (setq fend (point)))
-	
-	(forward-line 1)))
-    (move-marker end nil)))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; yank a particular field into a holding variable
-;;
-(defun sy-yank-fields (start)
-  (save-excursion
-    (goto-char start)
-    (setq sy-reply-yank-date         (mail-fetch-field "date")
-	  sy-reply-yank-from         (mail-fetch-field "from")
-	  sy-reply-yank-subject      (mail-fetch-field "subject")
-	  sy-reply-yank-newsgroups   (mail-fetch-field "newsgroups")
-	  sy-reply-yank-references   (mail-fetch-field "references")
-	  sy-reply-yank-message-id   (mail-fetch-field "message-id")
-	  sy-reply-yank-organization (mail-fetch-field "organization"))
-    (or sy-reply-yank-date
-	(setq sy-reply-yank-date "mumble mumble"))
-    (or sy-reply-yank-from
-	(setq sy-reply-yank-from "mumble mumble"))
-    (or sy-reply-yank-subject
-	(setq sy-reply-yank-subject "mumble mumble"))
-    (or sy-reply-yank-newsgroups
-	(setq sy-reply-yank-newsgroups "mumble mumble"))
-    (or sy-reply-yank-references
-	(setq sy-reply-yank-references "mumble mumble"))
-    (or sy-reply-yank-message-id
-	(setq sy-reply-yank-message-id "mumble mumble"))
-    (or sy-reply-yank-organization
-	(setq sy-reply-yank-organization "mumble mumble"))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; rewrite the header to be more conversational
-;;
-(defun sy-rewrite-headers (start)
-  (goto-char start)
-  (run-hooks 'sy-rewrite-header-hook))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; some different styles of headers
-;;
-(defun sy-header-on-said ()
-  (insert-string "\nOn " sy-reply-yank-date ",\n"
-		 sy-reply-yank-from " said:\n"))
-
-(defun sy-header-inarticle-writes ()
-  (insert-string "\nIn article " sy-reply-yank-message-id
-		 " " sy-reply-yank-from " writes:\n"))
-
-(defun sy-header-regarding-writes ()
-  (insert-string "\nRegarding " sy-reply-yank-subject
-		 "; " sy-reply-yank-from " adds:\n"))
-
-(defun sy-header-verbose ()
-  (insert-string "\nOn " sy-reply-yank-date ",\n"
-		 sy-reply-yank-from "\nfrom the organization "
-		 sy-reply-yank-organization "\nhad this to say about article "
-		 sy-reply-yank-message-id "\nin newsgroups "
-		 sy-reply-yank-newsgroups "\nconcerning "
-		 sy-reply-yank-subject "\nreferring to previous articles "
-		 sy-reply-yank-references "\n"))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; yank the original article in and attribute
-;;
-(defun sy-yank-original (arg)
-  
-  "Insert the message being replied to, if any (in rmail/gnus). Puts
-point before the text and mark after. Calls generalized citation
-function sy-insert-citation to cite all allowable lines."
-  
-  (interactive "P")
-  (if mail-reply-buffer
-      (let* ((sy-confirm-always-p (if (consp arg)
-				      t
-				    sy-confirm-always-p))
-	     (attribution (sy-scan-rmail-for-names mail-reply-buffer))
-	     (top (point))
-	     (start (point))
-	     (end (progn (delete-windows-on mail-reply-buffer)
-			 (insert-buffer mail-reply-buffer)
-			 (mark))))
-	
-	(sy-yank-fields start)
-	(sy-rewrite-headers start)
-	(setq start (point))
-	(mail-yank-clear-headers top (mark))
-	(setq sy-persist-attribution (concat attribution " "))
-	(sy-insert-citation start end attribution))
-    
-    (goto-char top)
-    (exchange-point-and-mark)))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; this is here for compatibility with existing mail/news yankers
-;; overloads the default mail-yank-original
-;;
-(defun mail-yank-original (arg)
-  
-  "Yank original message buffer into the reply buffer, citing as per
-user preferences.  Numeric Argument forces confirmation.
-
-Here is a description of the superyank.el package, what it does and
-what variables control its operation.  This was written by Barry
-Warsaw (warsaw@cme.nist.gov, {...}!uunet!cme-durer!warsaw).
-
-A 'Citation' is the acknowledgement of the original author of a mail
-message.  There are two general forms of citation. In 'nested
-citations', indication is made that the cited line was written by
-someone *other* that the current message author (or by that author at
-an earlier time).  No indication is made as to the identity of the
-original author.  Thus, a nested citation after multiple replies would
-look like this (this is after my reply to a previous message):
-
->>John originally wrote this
->>and this as well
-> Jane said that John didn't know
-> what he was talking about
-And that's what I think as well.
-
-In non-nested citations, you won't see multiple \">\" characters at
-the beginning of the line.  Non-nested citations will insert an
-informative string at the beginning of a cited line, attributing that
-line to an author.  The same message described above might look like
-this if non-nested citations were used:
-
-John> John originally wrote this
-John> and this as well
-Jane> Jane said that John didn't know
-Jane> what he was talking about
-And that's what I think as well.
-
-Notice that my inclusion of Jane's inclusion of John's original
-message did not result in a cited line of the form: Jane>John>.  Thus
-no nested citations.  The style of citation is controlled by the
-variable `sy-nested-citation-p'.  Nil uses non-nested citations and
-non-nil uses old style, nested citations.
-
-The variable `sy-citation-string' is the string to use as a marker for
-a citation, either nested or non-nested.  For best results, this
-string should be a single character with no trailing space and is
-typically the character \">\".  In non-nested citations this string is
-appended to the attribution string (author's name), along with a
-trailing space.  In nested citations, a trailing space is only added
-to a first level citation.
-
-Another important variable is `sy-cite-regexp' which describes strings
-that indicate a previously cited line.  This regular expression is
-always used at the beginning of a line so it doesn't need to begin
-with a \"^\" character.  Change this variable if you change
-`sy-citation-string'.
-
-The following section only applies to non-nested citations.
-
-This package has a fair amount of intellegence related to deciphering
-the author's name based on information provided by the original
-message buffer.  In normal operation, the program will pick out the
-author's first and last names, initials, terminal email address and
-any other names it can find.  It will then pick an attribution string
-from this list based on a user defined preference and it will ask for
-confirmation if the user specifies.  This package gathers its
-information from the `From:' line of the original message buffer.  It
-recognizes From: lines with the following forms:
-
-From: John Xavier Doe <doe@speedy.computer.com>
-From: \"John Xavier Doe\" <doe@speedy.computer.com>
-From: doe@speedy.computer.com (John Xavier Doe)
-From: computer!speedy!doe (John Xavier Doe)
-From: computer!speedy!doe (John Xavier Doe)
-From: doe%speedy@computer.com (John Xavier Doe)
-
-In this case, if confirmation is requested, the following strings will
-be made available for completion and confirmation:
-
-\"John\"
-\"Xavier\"
-\"Doe\"
-\"JXD\"
-\"doe\"
-
-Note that completion is case sensitive.  If there was a problem
-picking out a From: line, or any other problem getting even a single
-name, then the user will be queried for an attribution string.  The
-default attribution string is set in the variable
-`sy-default-attribution'.
-
-Sometimes people set their name fields so that it also includes a
-title of the form:
-
-From: doe@speedy.computer.com (John Doe -- Hacker Extraordinaire)
-
-To avoid the inclusion of the string \"-- Hacker Extraordinaire\" in
-the name list, the variable `sy-titlecue-regexp' is provided.  Its
-default setting will still properly recognize names of the form:
-
-From: xdoe@speedy.computer.com (John Xavier-Doe -- Crazed Hacker)
-
-The variable `sy-preferred-attribution' contains an integer that
-indicates which name field the user prefers to use as the attribution
-string, based on the following key:
-
-0: email address name is preferred
-1: initials are preferred
-2: first name is preferred
-3: last name is preferred
-
-The value can be greater than 3, in which case, you would be
-preferring the 2nd throught nth -1 name.  In any case, if the
-preferred name can't be found, then one of two actions will be taken
-depending on the value of the variable `sy-use-only-preference-p'.  If
-this is non-nil, then the `sy-default-attribution will be used.  If it
-is nil, then a secondary scheme will be employed to find a suitable
-attribution scheme.  First, the author's first name will be used.  If
-that can't be found than the name list is searched for the first
-non-nil, non-empty name string.  If still no name can be found, then
-the user is either queried, or the `sy-default-attribution' is used,
-depending on the value of `sy-confirm-always-p'.
-
-If the variable `sy-confirm-always-p' is non-nil, superyank will always
-confirm the attribution string with the user before inserting it into
-the reply buffer.  Confirmation is with completion, but the completion
-list is merely a suggestion; the user can override the list by typing
-in a string of their choice.
-
-The variable `sy-rewrite-header-hook' is a hook that contains a lambda
-expression which rewrites the informative header at the top of the
-yanked message.  Set to nil to avoid writing any header.
-
-You can make superyank autofill each paragraph it cites by setting the
-variable `sy-auto-fill-region-p' to non-nil.  Or set the variable to nil
-and fill the paragraphs manually with sy-fill-paragraph-manually (see
-below).
-
-Finally, `sy-downcase-p' if non-nil, indicates that you always want to
-downcase the attribution string before insertion, and
-`sy-left-justify-p', if non-nil, indicates that you want to delete all
-leading white space before citing.
-
-Since the almost all yanking in other modes (RMAIL, GNUS) is done
-through the function `mail-yank-original', and since superyank
-overloads this function, cited yanking is automatically bound to the
-C-c C-y key.  There are three other smaller functions that are
-provided with superyank and they are bound as below.  Try C-h f on
-each function to get more information on these functions.
-
-Key Bindings:
-
-C-c C-y     mail-yank-original (superyank's version)
-C-c q       sy-fill-paragraph-manually
-C-c C-q     sy-fill-paragraph-manually
-C-c i       sy-insert-persist-attribution
-C-c C-i     sy-insert-persist-attribution
-C-c C-o     sy-open-line
-
-
-Summary of variables, with their default values:
-
-sy-default-attribution     (default: \"Anon\")
-           Attribution to use if no attribution string can be deciphered
-           from the original message buffer.
-
-sy-citation-string         (default: \">\")
-           String to append to the attribution string for citation, for
-           best results, it should be one character with no trailing space.
-
-sy-nested-citation-p       (default: nil)
-           Nil means use non-nested citations, non-nil means use old style
-           nested citations.
-
-sy-cite-regexp             (default: \"[a-zA-Z0-9]*>\")
-           Regular expression that matches the beginning of a previously
-           cited line.  Always used at the beginning of a line so it does
-           not need to start with a \"^\" character.
-
-sy-titlecue-regexp         (default: \"\\s +-+\\s +\")
-           Regular expression that matches a title delimiter in the name
-           field.
-
-sy-preferred-attribution   (default: 2)
-           Integer indicating user's preferred attribution field.
-
-sy-confirm-always-p        (default: t)
-           Non-nil says always confirm with completion before inserting
-           attribution.
-
-sy-rewrite-header-hook     (default: 'sy-header-on-said)
-           Hook for inserting informative header at the top of the yanked
-           message.
-
-sy-downcase-p              (default: nil)
-           Non-nil says downcase the attribution string before insertion.
-
-sy-left-justify-p          (default: nil)
-           Non-nil says delete leading white space before citing.
-  
-sy-auto-fill-region-p      (default: nil)
-           Non-nil says don't auto fill the region.  T says auto fill the
-           paragraph.
-
-sy-use-only-preference-p   (default: nil)
-           If nil, use backup scheme when preferred attribution string
-           can't be found.  If non-nil and preferred attribution string
-           can't be found, then use sy-default-attribution."
-  
-  (interactive "P")
-  
-  (local-set-key "\C-cq"    'sy-fill-paragraph-manually)
-  (local-set-key "\C-c\C-q" 'sy-fill-paragraph-manually)
-  (local-set-key "\C-c\i"   'sy-insert-persist-attribution)
-  (local-set-key "\C-c\C-i" 'sy-insert-persist-attribution)
-  (local-set-key "\C-c\C-o" 'sy-open-line)
-  
-  (sy-yank-original arg))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; based on Bruce Israel's "fill-paragraph-properly", and modified from
-;; code posted by David C. Lawrence.  Modified to use the persistant
-;; attribution if none could be found from the paragraph.
-;;
-(defun sy-fill-paragraph-manually (arg)
-  "Fill paragraph containing or following point.
-This automatically finds the sy-cite-regexp and uses it as the prefix.
-If the sy-cite-regexp is not in the first line of the paragraph, it
-makes a guess at what the fill-prefix for the paragraph should be by
-looking at the first line and taking anything up to the first
-alphanumeric character.
-
-Prefix arg means justify both sides of paragraph as well.
-
-This function just does fill-paragraph if the fill-prefix is set. If
-what it deduces to be the paragraph prefix (based on the first line)
-does not precede each line in the region, then the persistant
-attribution is used.  The persistant attribution is just the last
-attribution string used to cite lines."
-  
-  (interactive "P")
-  (save-excursion
-    (forward-paragraph)
-    (or (bolp)
-	(newline 1))
-    
-    (let ((end (point))
-	  st
-	  (fill-prefix fill-prefix))
-      (backward-paragraph)
-      (if (looking-at "\n")
-	  (forward-char 1))
-      (setq st (point))
-      (if fill-prefix
-	  nil
-	(untabify st end) ;; die, scurvy tabs!
-	;;
-        ;; untabify might have made the paragraph longer character-wise,
-        ;; make sure end reflects the correct location of eop.
-	;;
-        (forward-paragraph)
-	(setq end (point))
-        (goto-char st)
-        (if (looking-at sy-cite-regexp)
-            (setq fill-prefix (concat
-			       (buffer-substring
-				st (progn (re-search-forward sy-cite-regexp)
-					  (point)))
-			       " "))
-	  ;;
-          ;; this regexp is is convenient because paragraphs quoted by simple
-          ;; indentation must still yield to us  <evil laugh>
-	  ;;
-          (while (looking-at "[^a-zA-Z0-9]")
-	    (forward-char 1))
-          (setq fill-prefix (buffer-substring st (point))))
-        (next-line 1) (beginning-of-line)
-        (while (and (< (point) end)
-		    (not (string-equal fill-prefix "")))
-	  ;;
-          ;; if what we decided was the fill-prefix does not precede all
-          ;; of the lines in the paragraph, we probably goofed.  In this
-	  ;; case set it to the persistant attribution.
-	  ;;
-          (if (looking-at (regexp-quote fill-prefix))
-	      ()
-	    (setq fill-prefix sy-persist-attribution))
-          (next-line 1)
-	  (beginning-of-line)))
-      (fill-region-as-paragraph st end arg))))
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; insert the persistant attribution at point
-;;
-(defun sy-insert-persist-attribution ()
-  "Insert the persistant attribution.
-This inserts the peristant attribution at the beginning of the line that
-point is on.  This string is the last attribution confirmed and used
-in the yanked reply buffer."
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (insert-string sy-persist-attribution)))
-
-
-;;
-;; ----------------------------------------------------------------------
-;;
-;; open a line putting the attribution at the beginning
-
-(defun sy-open-line (arg)
-  "Insert a newline and leave point before it.
-Also inserts the persistant attribution at the beginning of the line.
-With argument, inserts ARG newlines."
-  (interactive "p")
-  (save-excursion
-    (let ((start (point)))
-      (open-line arg)
-      (goto-char start)
-      (forward-line)
-      (while (< 0 arg)
-	(sy-insert-persist-attribution)
-	(forward-line 1)
-	(setq arg (- arg 1))))))
-
-(provide 'superyank)
-
-;;; superyank.el ends here
diff --git a/lisp/=term-nasty.el b/lisp/=term-nasty.el
deleted file mode 100644
index 77a801e2889..00000000000
--- a/lisp/=term-nasty.el
+++ /dev/null
@@ -1,12 +0,0 @@
-;;; term-nasty.el --- Damned Things from terminfo.el
-
-;;; This text is no longer included in Emacs, because it was censored
-;;; by the Communications Decency Act.  The law was promoted as a ban
-;;; on pornography, but it bans far more than that.  This file did not
-;;; contain pornography, but it was prohibited nonetheless.
-
-;;; For information on US government censorship of the Internet, and
-;;; what you can do to bring back freedom of the press, see the web
-;;; site http://www.vtw.org/
-
-;;; term-nasty.el ends here
diff --git a/lisp/=timer.el b/lisp/=timer.el
deleted file mode 100644
index 3b468023437..00000000000
--- a/lisp/=timer.el
+++ /dev/null
@@ -1,223 +0,0 @@
-;;; timers.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.
-;; The single entry point is `run-at-time'.
-
-;;; Code:
-
-;; Layout of a timer vector:
-;; [triggered-p trigger-high trigger-low delta-secs function args]
-
-(defun timer-create ()
-  "Create a timer object."
-  (let ((timer (make-vector 7 nil)))
-    (aset timer 0 (make-vector 1 'timer-event))
-    timer))
-
-(defun timerp (object)
-  "Return t if OBJECT is a timer."
-  (and (vectorp object) (= (length object) 7)))
-
-(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 non-zero integer make the timer
-fire repeatedly that menu 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 (if (consp (cdr time)) (nth 2 time) 0))
-  (aset timer 4 (and (integerp delta) (> delta 0) delta))
-  timer)
-
-
-(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."
-  (or usecs (setq usecs 0))
-  (if (floatp secs)
-      (let* ((integer (floor secs))
-	     (fraction (floor (* 1000000 (- secs integer)))))
-	(setq usecs fraction secs integer)))
-  (let ((newusecs (+ (aref timer 3) usecs)))
-    (aset timer 3 (mod newusecs 1000000))
-    (setq secs (+ secs (/ newusecs 1000000))))
-  (let ((newlow (+ (aref timer 2) secs))
-	(newhigh (aref timer 1)))
-    (setq newhigh (+ newhigh (/ newlow 65536))
-	  newlow (logand newlow 65535))
-    (aset timer 1 newhigh)
-    (aset timer 2 newlow)))
-
-(defun timer-set-time-with-usecs (timer time usecs &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 non-zero integer make the timer
-fire repeatedly that menu 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 usecs)
-  (aset timer 4 (and (integerp delta) (> delta 0) delta))
-  timer)
-
-(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)
-	nil)
-    (error "Invalid or uninitialized timer")))
-
-(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))
-  nil)
-
-(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)))))
-
-;; Set up the common handler for all timer events.  Since the event has
-;; the timer as parameter we can still distinguish.  Note that using
-;; special-event-map ensures that event timer events that arrive in the
-;; middle of a key sequence being entered are still handled correctly.
-(define-key special-event-map [timer-event] 'timer-event-handler)
-(defun timer-event-handler (event)
-  "Call the handler for the timer in the event EVENT."
-  (interactive "e")
-  (let ((timer (cdr-safe event)))
-    (if (timerp timer)
-	(progn
-	  ;; Delete from queue.
-	  (cancel-timer timer)
-	  ;; Run handler
-	  (apply (aref timer 5) (aref timer 6))
-	  ;; Re-schedule if requested.
-	  (if (aref timer 4)
-	      (progn
-		(timer-inc-time timer (aref timer 4) 0)
-		(timer-activate timer))))
-      (error "Bogus timer event"))))
-
-;;;###autoload
-(defun run-at-time (time repeat function &rest args)
-  "Run a function at a time, and optionally on a regular interval.
-Arguments are TIME, REPEAT, FUNCTION &rest ARGS.
-TIME is a string like \"11:23pm\" or a value from `encode-time'.
-REPEAT, an integer number of seconds, is the interval on which to repeat
-the call to the function.  If REPEAT is nil or 0, call it just once."
-  (interactive "sRun at time: \nNRepeat interval: \naFunction: ")
-
-  ;; Handle "11:23pm" and the like.  Interpret it as meaning today
-  ;; which admittedly is rather stupid if we have passed that time
-  ;; already.  Unfortunately we don't have a `parse-time' function
-  ;; to do the right thing.
-  (if (stringp time)
-      (progn
-	(require 'diary-lib)
-	(let ((hhmm (diary-entry-time time))
-	      (now (decode-time)))
-	  (if (< hhmm 0)
-	      (setq time 'bad)
-	    (setq time
-		  (encode-time 0 (% hhmm 100) (/ hhmm 100) (nth 3 now)
-			       (nth 4 now) (nth 5 now) (nth 8 now)))))))
-
-  ;; Special case: nil means "now" and is useful when repeting.
-  (if (null time)
-      (setq time (current-time)))
-
-  (or (consp time)
-      (error "Invalid time format"))
-
-  (or (null repeat)
-      (natnump repeat)
-      (error "Invalid repetition interval"))
-
-  (let ((timer (timer-create)))
-    (timer-set-time timer time repeat)
-    (timer-set-function timer function args)
-    (timer-activate timer)))
-
-;;;###autoload
-(defun run-after-delay (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 need not be integers.
-The action is to call FUNCTION with arguments ARGS."
-  (interactive "sRun after delay (seconds): \nNRepeat interval: \naFunction: ")
-
-  (or (null repeat)
-      (and (numberp repeat) (>= repeat 0))
-      (error "Invalid repetition interval"))
-
-  (let ((timer (timer-create)))
-    (timer-set-time timer (current-time))
-    (timer-inc-time timer secs)
-    (timer-set-function timer function args)
-    (timer-activate timer)))
-
-(provide 'timers)
-
-;;; timers.el ends here
diff --git a/lisp/=tpu-doc.el b/lisp/=tpu-doc.el
deleted file mode 100644
index ef724ecb6d9..00000000000
--- a/lisp/=tpu-doc.el
+++ /dev/null
@@ -1,469 +0,0 @@
-;;; tpu-doc.el --- Documentation for TPU-edt
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Rob Riepel <riepel@networking.stanford.edu>
-;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
-;; Keywords: emulations
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-
-;; This is documentation for the TPU-edt editor for GNU emacs.  Major
-;; sections of this document are separated with lines that begin with
-;; ";; %% <topic>", where <topic> is what is discussed in that section.
-
-
-;; %% Contents
-
-;;  % Introduction
-;;  % Terminal Support
-;;  % X-windows Support
-;;  % Differences Between TPU-edt and the Real Thing
-;;  % Starting TPU-edt
-;;  % TPU-edt Default Editing Keypad, Control and Gold Key Bindings
-;;  % Optional TPU-edt Extensions
-;;  % Customizing TPU-edt using the Emacs Initialization File
-;;  % Compiling TPU-edt
-;;  % Regular expressions in TPU-edt
-;;  % Etcetera
-
-
-;; %% Introduction
-
-;;    TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey.  TPU-edt
-;;    endeavors to be even more like TPU's EDT emulation than the original
-;;    tpu.el.  Considerable effort has been expended to that end.  Still,
-;;    emacs is emacs and there are differences between TPU-edt and the
-;;    real thing.  Please read the "Differences Between TPU-edt and the
-;;    Real Thing" and "Starting TPU-edt" sections before running TPU-edt.
-
-
-;; %% Terminal Support
-
-;;    TPU-edt, like it's VMS cousin, works on VT-series terminals with
-;;    DEC style keyboards.  VT terminal emulators, including xterm with
-;;    the appropriate key translations, work just fine too.
-
-
-;; %% X-windows Support
-
-;;    Starting with version 19 of emacs, TPU-edt works with X-windows.
-;;    This is accomplished through a TPU-edt X keymap.  The emacs lisp
-;;    program tpu-mapper.el creates this map and stores it in a file.
-;;    Tpu-mapper will be run automatically the first time you invoke
-;;    the X-windows version of emacs, or you can run it by hand.  See
-;;    the commentary in tpu-mapper.el for details.
-
-
-;; %% Differences Between TPU-edt and the Real Thing (not Coke (r))
-
-;;    Emacs (version 18.58) doesn't support text highlighting, so selected
-;;    regions are not shown in inverse video.  Emacs uses the concept of
-;;    "the mark".  The mark is set at one end of a selected region; the
-;;    cursor is at the other.  The letter "M" appears in the mode line
-;;    when the mark is set.  The native emacs command ^X^X (Control-X
-;;    twice) exchanges the cursor with the mark; this provides a handy
-;;    way to find the location of the mark.
-
-;;    In TPU the cursor can be either bound or free.  Bound means the
-;;    cursor cannot wander outside the text of the file being edited.
-;;    Free means the arrow keys can move the cursor past the ends of
-;;    lines.  Free is the default mode in TPU; bound is the only mode
-;;    in EDT.  Bound is the only mode in the base version of TPU-edt;
-;;    optional extensions add an approximation of free mode.
-
-;;    Like TPU, emacs uses multiple buffers.  Some buffers are used to
-;;    hold files you are editing; other "internal" buffers are used for
-;;    emacs' own purposes (like showing you help).  Here are some commands
-;;    for dealing with buffers.
-
-;;	 Gold-B   moves to next buffer, including internal buffers
-;;	 Gold-N   moves to next buffer containing a file
-;;	 Gold-M   brings up a buffer menu (like TPU "show buffers")
-
-;;    Emacs is very fond of throwing up new windows.  Dealing with all
-;;    these windows can be a little confusing at first, so here are a few
-;;    commands to that may help:
-
-;;       Gold-Next_Scr  moves to the next window on the screen
-;;       Gold-Prev_Scr  moves to the previous window on the screen
-;;       Gold-TAB       also moves to the next window on the screen
-
-;;	 Control-x 1    deletes all but the current window
-;;	 Control-x 0    deletes the current window
-
-;;    Note that the buffers associated with deleted windows still exist!
-
-;;    Like TPU, TPU-edt has a "command" function, invoked with Gold-KP7 or
-;;    Do.  Most of the commands available are emacs commands.  Some TPU
-;;    commands are available, they are: replace, exit, quit, include, and
-;;    Get (unfortunately, "get" is an internal emacs function, so we are
-;;    stuck with "Get" - to make life easier, Get is available as Gold-g).
-
-;;    Support for recall of commands, file names, and search strings was
-;;    added to emacs in version 19.  For version 18 of emacs, optional
-;;    extensions are available to add this recall capability (see "Optional
-;;    TPU-edt Extensions" below).  The history of strings recalled in both
-;;    versions of emacs differs slightly from TPU/edt, but it is still very
-;;    convenient.
-
-;;    Help is available!  The traditional help keys (Help and PF2) display
-;;    a three page help file showing the default keypad layout, control key
-;;    functions, and Gold key functions.  Pressing any key inside of help
-;;    splits the screen and prints a description of the function of the
-;;    pressed key.  Gold-PF2 invokes the native emacs help, with it's
-;;    zillions of options.  Gold-Help shows all the current key bindings.
-
-;;    Thanks to emacs, TPU-edt has some extensions that may make your life
-;;    easier, or at least more interesting.  For example, Gold-r toggles
-;;    TPU-edt rectangular mode.  In rectangular mode, Remove and Insert work
-;;    on rectangles.  Likewise, Gold-* toggles TPU-edt regular expression
-;;    mode.  In regular expression mode Find, Find Next, and the line-mode
-;;    replace command work with regular expressions.  [A regular expression
-;;    is a pattern that denotes a set of strings; like VMS wildcards.]
-
-;;    Emacs also gives TPU-edt the undo and occur functions.  Undo does
-;;    what it says; it undoes the last change.  Multiple undos in a row
-;;    undo multiple changes.  For your convenience, undo is available on
-;;    Gold-u.  Occur shows all the lines containing a specific string in
-;;    another window.  Moving to that window, and typing ^C^C (Control-C
-;;    twice) on a particular line moves you back to the original window
-;;    at that line.  Occur is on Gold-o.
-
-;;    Finally, as you edit, remember that all the power of emacs is at
-;;    your disposal.  It really is a fantastic tool.  You may even want to
-;;    take some time and read the emacs tutorial; perhaps not to learn the
-;;    native emacs key bindings, but to get a feel for all the things
-;;    emacs can do for you.  The emacs tutorial is available from the
-;;    emacs help function: "Gold-PF2 t"
-
-
-;; %% Starting TPU-edt
-
-;;    In order to use TPU-edt, the TPU-edt editor definitions, contained
-;;    in tpu-edt.el, need to be loaded when emacs is run.  This can be
-;;    done in a couple of ways.  The first is by explicitly requesting
-;;    loading of the TPU-edt emacs definition file on the command line:
-
-;;        prompt> emacs -l /path/to/definitions/tpu-edt.el
-
-;;    If TPU-edt is installed on your system, that is, if tpu-edt.el is in
-;;    a directory like /usr/local/emacs/lisp, along with dozens of other
-;;    .el files, you should be able to use the command:
-
-;;        prompt> emacs -l tpu-edt
-
-;;    If you like TPU-edt and want to use it all the time, you can load
-;;    the TPU-edt definitions using the emacs initialization file, .emacs.
-;;    Simply create a .emacs file in your home directory containing the
-;;    line:
-
-;;        (load "/path/to/definitions/tpu-edt")
-
-;;    or, if (as above) TPU-edt is installed on your system:
-
-;;        (load "tpu-edt")
-
-;;    Once TPU-edt has been loaded, you will be using an editor with the
-;;    interface shown in the next section (A section that is suitable for
-;;    cutting out of this document and pasting next to your terminal!).
-
-
-;; %% TPU-edt Default Editing Keypad, Control and Gold Key Bindings
-;;
-;;        _______________________    _______________________________
-;;       | HELP  |      Do       |  |       |       |       |       |
-;;       |KeyDefs|               |  |       |       |       |       |
-;;       |_______|_______________|  |_______|_______|_______|_______|
-;;        _______________________    _______________________________
-;;       | Find  |Insert |Remove |  | Gold  | HELP  |FndNxt | Del L |
-;;       |       |       |Sto Tex|  |  key  |E-Help | Find  |Undel L|
-;;       |_______|_______|_______|  |_______|_______|_______|_______|
-;;       |Select |Pre Scr|Nex Scr|  | Page  | Sect  |Append | Del W |
-;;       | Reset |Pre Win|Nex Win|  |  Do   | Fill  |Replace|Undel W|
-;;       |_______|_______|_______|  |_______|_______|_______|_______|
-;;               |Move up|          |Forward|Reverse|Remove | Del C |
-;;               |  Top  |          |Bottom |  Top  |Insert |Undel C|
-;;        _______|_______|_______   |_______|_______|_______|_______|
-;;       |Mov Lef|Mov Dow|Mov Rig|  | Word  |  EOL  | Char  |       |
-;;       |StaOfLi|Bottom |EndOfLi|  |ChngCas|Del EOL|SpecIns| Enter |
-;;       |_______|_______|_______|  |_______|_______|_______|       |
-;;                                  |     Line      |Select | Subs  |
-;;                                  |   Open Line   | Reset |       |
-;;                                  |_______________|_______|_______|
-;;     Control Characters
-;;
-;;    ^A  toggle insert and overwrite    ^L  insert page break
-;;    ^B  recall                         ^R  remember, re-center
-;;    ^E  end of line                    ^U  delete to beginning of line
-;;    ^G  cancel current operation       ^V  quote
-;;    ^H  beginning of line              ^W  refresh
-;;    ^J  delete previous word           ^Z  exit
-;;    ^K  learn                        ^X^X  exchange point and mark
-;;
-;;
-;;     Gold-<key> Functions
-;;     -----------------------------------------------------------------
-;;     W     Write - save current buffer
-;;     K     Kill buffer - abandon edits and delete buffer
-;;
-;;     E     Exit - save current buffer and ask about others
-;;     X     eXit - save all modified buffers and exit
-;;     Q     Quit - exit without saving anything
-;;
-;;     G     Get - load a file into a new edit buffer
-;;     I     Include - include a file in this buffer
-;;
-;;     B     next Buffer - display the next buffer (all buffers)
-;;     N     Next file buffer - display next buffer containing a file
-;;     M     buffer Menu - display a list of all buffers
-;;
-;;     U     Undo - undo the last edit
-;;     C     Recall - edit and possibly repeat previous commands
-;;
-;;     O     Occur - show following lines containing REGEXP
-;;     S     Search and substitute - line mode REPLACE command
-;;
-;;     ?     Spell check - check spelling in a region or entire buffer
-;;
-;;     R     Toggle Rectangular mode for remove and insert
-;;     *     Toggle regular expression mode for search and substitute
-;;
-;;     V     Show TPU-edt version
-;;     -----------------------------------------------------------------
-
-
-;; %% Optional TPU-edt Extensions
-
-;;    Several optional packages have been included in this distribution
-;;    of TPU-edt.  The following is a brief description of each package.
-;;    See the {package}.el file for more detailed information and usage
-;;    instructions.
-
-;;      tpu-extras  -  TPU/edt scroll margins and free cursor mode.
-;;      tpu-recall  -  String, file name, and command history.
-;;      vt-control  -  VTxxx terminal width and keypad controls.
-
-;;    Packages are normally loaded from the emacs initialization file
-;;    (discussed below).  If a package is not installed in the emacs
-;;    lisp directory, it can be loaded by specifying the complete path
-;;    to the package file.  However, it is preferable to modify the
-;;    emacs load-path variable to include the directory where packages
-;;    are stored.  This way, packages can be loaded by name, just as if
-;;    they were installed.  The first part of the sample .emacs file
-;;    below shows how to make such a modification.
-
-
-;; %% Customizing TPU-edt using the Emacs Initialization File
-
-;; .emacs - a sample emacs initialization file
-
-;; This is a sample emacs initialization file.  It shows how to invoke
-;; TPU-edt, and how to customize it.
-
-;; The load-path is where emacs looks for files to fulfill load requests.
-;; If TPU-edt is not installed in a standard emacs directory, the load-path
-;; should be updated to include the directory where the TPU-edt files are
-;; stored.  Modify and un-comment the following section if TPU-ed is not
-;; installed on your system - be sure to leave the double quotes!
-
-;; (setq load-path
-;;       (append (list (expand-file-name "/path/to/tpu-edt/files"))
-;;               load-path))
-
-;; Load TPU-edt
-(load "tpu-edt")
-
-;; Load the optional goodies - scroll margins, free cursor mode, command
-;; and string recall.  But don't complain if the file aren't available.
-(load "tpu-extras" t)
-(load "tpu-recall" t)
-
-;; Uncomment this line to set scroll margins 10% (top) and 15% (bottom).
-;(and (fboundp 'tpu-set-scroll-margins) (tpu-set-scroll-margins "10%" "15%"))
-
-;; Load the vtxxx terminal control functions, but don't complain if
-;; if the file is not found.
-(load "vt-control" t)
-
-;; TPU-edt treats words like EDT; here's how to add word separators.
-;; Note that backslash (\) and double quote (") are quoted with '\'.
-(tpu-add-word-separators "]\\[-_,.\"=+()'/*#:!&;$")
-
-;; Emacs is happy to save files without a final newline; other Unix programs
-;; hate that!  This line will make sure that files end with newlines.
-(setq require-final-newline t)
-
-;; Emacs has the ability to automatically run code embedded in files
-;; you edit.  This line makes emacs ask if you want to run the code.
-(if tpu-emacs19-p (setq enable-local-variables "ask")
-  (setq inhibit-local-variables t))
-
-;; Emacs uses Control-s and Control-q.  Problems can occur when using emacs
-;; on terminals that use these codes for flow control (Xon/Xoff flow control).
-;; These lines disable emacs' use of these characters.
-(global-unset-key "\C-s")
-(global-unset-key "\C-q")
-
-;; top, bottom, bol, eol seem like a waste of Gold-arrow functions.  The
-;; following section re-maps up and down arrow keys to top and bottom of
-;; screen, and left and right arrow keys to pan left and right (pan-left,
-;; right moves the screen 16 characters left or right - try it, you'll
-;; like it!).
-
-;; Re-map the Gold-arrow functions
-(define-key GOLD-CSI-map "A" 'tpu-beginning-of-window)          ; up-arrow
-(define-key GOLD-CSI-map "B" 'tpu-end-of-window)                ; down-arrow
-(define-key GOLD-CSI-map "C" 'tpu-pan-right)                    ; right-arrow
-(define-key GOLD-CSI-map "D" 'tpu-pan-left)                     ; left-arrow
-(define-key GOLD-SS3-map "A" 'tpu-beginning-of-window)          ; up-arrow
-(define-key GOLD-SS3-map "B" 'tpu-end-of-window)                ; down-arrow
-(define-key GOLD-SS3-map "C" 'tpu-pan-right)                    ; right-arrow
-(define-key GOLD-SS3-map "D" 'tpu-pan-left)                     ; left-arrow
-
-;; Re-map the Gold-arrow functions for X-windows TPU-edt (emacs version 19)
-(cond
- ((and tpu-emacs19-p window-system)
-  (define-key GOLD-map [up] 'tpu-beginning-of-window)           ; up-arrow
-  (define-key GOLD-map [down] 'tpu-end-of-window)               ; down-arrow
-  (define-key GOLD-map [right] 'tpu-pan-right)                  ; right-arrow
-  (define-key GOLD-map [left] 'tpu-pan-left)))                  ; left-arrow
-
-;; The emacs universal-argument function is very useful for native emacs
-;; commands.  This line maps universal-argument to Gold-PF1
-(define-key GOLD-SS3-map "P" 'universal-argument)               ; Gold-PF1
-
-;; Make KP7 move by paragraphs, instead of pages.
-(define-key SS3-map "w" 'tpu-paragraph)                         ; KP7
-
-;; TPU-edt assumes you have the ispell spelling checker;
-;; Un-comment this line if you don't.
-;(setq tpu-have-spell nil)
-
-;; Display the TPU-edt version.
-(tpu-version)
-
-;; End of .emacs - a sample emacs initialization file
-
-;;    After initialization with the .emacs file shown above, the editing
-;;    keys have been re-mapped to look like this:
-
-;;        _______________________    _______________________________
-;;       | HELP  |      Do       |  |       |       |       |       |
-;;       |KeyDefs|               |  |       |       |       |       |
-;;       |_______|_______________|  |_______|_______|_______|_______|
-;;        _______________________    _______________________________
-;;       | Find  |Insert |Remove |  | Gold  | HELP  |FndNxt | Del L |
-;;       |       |       |Sto Tex|  | U Arg |E-Help | Find  |Undel L|
-;;       |_______|_______|_______|  |_______|_______|_______|_______|
-;;       |Select |Pre Scr|Nex Scr|  |Paragra| Sect  |Append | Del W |
-;;       | Reset |Pre Win|Nex Win|  |  Do   | Fill  |Replace|Undel W|
-;;       |_______|_______|_______|  |_______|_______|_______|_______|
-;;               |Move up|          |Forward|Reverse|Remove | Del C |
-;;               |Tscreen|          |Bottom |  Top  |Insert |Undel C|
-;;        _______|_______|_______   |_______|_______|_______|_______|
-;;       |Mov Lef|Mov Dow|Mov Rig|  | Word  |  EOL  | Char  |       |
-;;       |PanLeft|Bscreen|PanRigh|  |ChngCas|Del EOL|SpecIns| Enter |
-;;       |_______|_______|_______|  |_______|_______|_______|       |
-;;                                  |     Line      |Select | Subs  |
-;;                                  |   Open Line   | Reset |       |
-;;                                  |_______________|_______|_______|
-
-;;    Astute emacs hackers will realize that on systems where TPU-edt is
-;;    installed, this documentation file can be loaded to produce the above
-;;    editing keypad layout.  In fact, to get all the changes in the sample
-;;    initialization file, you only need a one line initialization file:
-
-;;        (load "tpu-doc")
-
-;;    wow!
-
-
-;; %% Compiling TPU-edt
-
-;;    It is not necessary to compile (byte-compile in emacs parlance)
-;;    TPU-edt to use it.  However, byte-compiled code loads and runs
-;;    faster, and takes up less memory when loaded.  To byte compile
-;;    TPU-edt, use the following command.
-
-;;        emacs -batch -f batch-byte-compile tpu-edt.el
-
-;;    This will produce a file named tpu-edt.elc.  This new file can be
-;;    used in place of the original tpu-edt.el file.  In commands where
-;;    the file type is not specified, emacs always attempts to use the
-;;    byte-compiled version before resorting to the source.
-
-
-;; %% Regular expressions in TPU-edt
-
-;;    Gold-* toggles TPU-edt regular expression mode.  In regular expression
-;;    mode, find, find next, replace, and substitute accept emacs regular
-;;    expressions.  A complete list of emacs regular expressions can be
-;;    found using the emacs "info" command (it's somewhat like the VMS help
-;;    command).  Try the following sequence of commands:
-
-;;        DO info             <enter info mode>
-;;	  m regex             <select the "regular expression" topic>
-;;	  m directives        <select the "directives" topic>
-
-;;    Type "q" to quit out of info mode.
-
-;;    There is a problem in regular expression mode when searching for
-;;    empty strings, like beginning-of-line (^) and end-of-line ($).
-;;    When searching for these strings, find-next may find the current
-;;    string, instead of the next one.  This can cause global replace and
-;;    substitute commands to loop forever in the same location.  For this
-;;    reason, commands like
-
-;;        replace "^" "> "       <add "> " to beginning of line>
-;;	  replace "$" "00711"    <add "00711" to end of line>
-
-;;    may not work properly.
-
-;;    Commands like those above are very useful for adding text to the
-;;    beginning or end of lines.  They might work on a line-by-line basis,
-;;    but go into an infinite loop if the "all" response is specified.  If
-;;    the goal is to add a string to the beginning or end of a particular
-;;    set of lines TPU-edt provides functions to do this.
-
-;;        Gold-^  Add a string at BOL in region or buffer
-;;        Gold-$  Add a string at EOL in region or buffer
-
-;;    There is also a TPU-edt interface to the native emacs string
-;;    replacement commands.  Gold-/ invokes this command.  It accepts
-;;    regular expressions if TPU-edt is in regular expression mode.  Given
-;;    a repeat count, it will perform the replacement without prompting
-;;    for confirmation.
-
-;;    This command replaces empty strings correctly, however, it has its
-;;    drawbacks.  As a native emacs command, it has a different interface
-;;    than the emulated TPU commands.  Also, it works only in the forward
-;;    direction, regardless of the current TPU-edt direction.
-
-
-;; %% Etcetera
-
-;;    That's TPU-edt in a nutshell...
-
-;;    Please send any bug reports, feature requests, or cookies to the
-;;    author, Rob Riepel, at the address shown by the tpu-version command
-;;    (Gold-V).
-
-;;    Share and enjoy...  Rob Riepel  7/93
-
-;;; tpu-doc.el ends here
diff --git a/lisp/=vmsx.el b/lisp/=vmsx.el
deleted file mode 100644
index b3ab41e51f7..00000000000
--- a/lisp/=vmsx.el
+++ /dev/null
@@ -1,144 +0,0 @@
-;;; vmsx.el --- run asynchronous VMS subprocesses under Emacs
-
-;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; Author: Mukesh Prasad
-;; Maintainer: FSF
-;; Keywords: vms
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Code:
-
-(defvar display-subprocess-window nil
-  "If non-nil, the suprocess window is displayed whenever input is received.")
-
-(defvar command-prefix-string "$ "
-  "String to insert to distinguish commands entered by user.")
-
-(defvar subprocess-running nil)
-(defvar command-mode-map nil)
-
-(if command-mode-map
-    nil
-  (setq command-mode-map (make-sparse-keymap))
-  (define-key command-mode-map "\C-m" 'command-send-input)
-  (define-key command-mode-map "\C-u" 'command-kill-line))
-
-(defun subprocess-input (name str)
-   "Handles input from a subprocess.  Called by Emacs."
-   (if display-subprocess-window
-      (display-buffer subprocess-buf))
-   (let ((old-buffer (current-buffer)))
-      (set-buffer subprocess-buf)
-      (goto-char (point-max))
-      (insert str)
-      (insert ?\n)
-      (set-buffer old-buffer)))
-
-(defun subprocess-exit (name)
-   "Called by Emacs upon subprocess exit."
-   (setq subprocess-running nil))
-
-(defun start-subprocess ()
-   "Spawns an asynchronous subprocess with output redirected to
-the buffer *COMMAND*.  Within this buffer, use C-m to send
-the last line to the subprocess or to bring another line to
-the end."
-   (if subprocess-running
-       (return t))
-   (setq subprocess-buf (get-buffer-create "*COMMAND*"))
-   (save-excursion
-	(set-buffer subprocess-buf)
-	(use-local-map command-mode-map))
-   (setq subprocess-running (spawn-subprocess 1 'subprocess-input
-                                               'subprocess-exit))
-   ;; Initialize subprocess so it doesn't panic and die upon
-   ;; encountering the first error.
-   (and subprocess-running
-        (send-command-to-subprocess 1 "ON SEVERE_ERROR THEN CONTINUE")))
-
-(defvar subprocess-command-to-buffer-tmpdir "SYS$SCRATCH:"
-  "*Put temporary files from subprocess-command-to-buffer here.")
-
-(defun subprocess-command-to-buffer (command buffer)
-  "Execute command and redirect output into buffer.
-
-BUGS: only the output up to the end of the first image activation is trapped."
-  (if (not subprocess-running) 
-	  (start-subprocess))
-  (save-excursion
-	(set-buffer buffer)
-	(let ((output-filename
-	       (concat subprocess-command-to-buffer-tmpdir
-		       "OUTPUT-FOR-" (getenv "USER") ".LISTING")))
-	  (while (file-attributes output-filename)
-	    (delete-file output-filename))
-	  (send-command-to-subprocess 1 (concat "DEFINE/USER SYS$OUTPUT "
-						output-filename "-NEW"))
-	  (send-command-to-subprocess 1 command)
-	  (send-command-to-subprocess 1 (concat "RENAME " output-filename 
-						"-NEW " output-filename))
-	  (while (not (file-attributes output-filename))
-	    (sleep-for 2))
-	  (insert-file output-filename))))
-
-(defun subprocess-command ()
-  "Starts asynchronous subprocess if not running and switches to its window."
-  (interactive)
-  (if (not subprocess-running)
-      (start-subprocess))
-  (and subprocess-running
-      (progn (pop-to-buffer subprocess-buf) (goto-char (point-max)))))
-
-(defun command-send-input ()
-  "If at last line of buffer, sends the current line to
-the spawned subprocess.  Otherwise brings back current
-line to the last line for resubmission."
-  (interactive)
-  (beginning-of-line)
-  (let ((current-line (buffer-substring (point)
-                                        (progn (end-of-line) (point)))))
-    (if (eobp)
-      (progn
-        (if (not subprocess-running)
-            (start-subprocess))
-        (if subprocess-running
-          (progn
-            (beginning-of-line)
-            (send-command-to-subprocess 1 current-line)
-            (if command-prefix-string
-              (progn (beginning-of-line) (insert command-prefix-string)))
-            (next-line 1))))
-      ;; else -- if not at last line in buffer
-      (end-of-buffer)
-      (backward-char)
-      (next-line 1)
-      (if (string-equal command-prefix-string
-                (substring current-line 0 (length command-prefix-string)))
-	  (insert (substring current-line (length command-prefix-string)))
-          (insert current-line)))))
-
-(defun command-kill-line()
-  "Kills the current line.  Used in command mode."
-  (interactive)
-  (beginning-of-line)
-  (kill-line))
-
-(define-key esc-map "$" 'subprocess-command)
-
-;;; vmsx.el ends here
diff --git a/lisp/=word-help.el b/lisp/=word-help.el
deleted file mode 100644
index f535fd9073c..00000000000
--- a/lisp/=word-help.el
+++ /dev/null
@@ -1,970 +0,0 @@
-;;; word-help.el --- keyword help for any language doc'd in TeXinfo.
-
-;; Copyright (c) 1996 Free Software Foundation, Inc.
-
-;; Maintainer: Jens T. Berger Thielemann, <jensthi@ifi.uio.no>
-;; Keywords: help, keyword, languages, completion
-
-;; This file is part of GNU Emacs.
-
-;; This program 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.
-
-;; This program 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 provides a rather general interface for doing keyword
-;; help in most languages.  In short, it'll determine which TeXinfo
-;; file which is relevant for the current mode; cache the index and
-;; use regexps to give you help on the keyword you're looking at.
-
-;; Installation
-;; ************
-
-;; For the default setup to work for all supported modes, make sure
-;; the Texinfo files from the following packages are installed:
-
-;; Texinfo file   | Available in archive or URL | Notes
-;; autoconf.info  | autoconf-2.10.tar.gz        | -
-;; bison.info     | bison-1.25.tar.gz           | -
-;; libc.info      | glibc-1.09.1.tar.gz         | -
-;; elisp.info     | elisp-manual-19-2.4.tar.gz  | -
-;; latex.info     | ftp://ftp.dante.de/pub/tex/info/latex2e-help-texinfo/latex2e.texi
-;; groff.info     | groff-1.10.tar.gz           | -
-;; m4.info        | m4-1.4.tar.gz               | -
-;; make.info      | make-3.75.tar.gz            | -
-;; perl.info      | http://www.perl.com/CPAN/doc/manual/info/
-;; simula.info    | Mail bjort@ifi.uio.no       | Written in Norwegian
-;; texinfo.info   | texinfo-3.9.tar.gz          | -
-
-;; BTW: We refer to Texinfo files by just their last component, not
-;; with an absolute file name.  You must thus set up
-;; `Info-directory-list' and `Info-default-directory-list' so that
-;; these can automatically be located.
-
-;; Usage
-;; *****
-;;
-;; Place the cursor over the function/variable/type/whatever you want
-;; help on.  Type "C-h C-i".  `word-help' will then make a suggestion
-;; to an index topic; press return to accept this.  If not, you may use
-;; tab-completion to find the topic you're interested in.
-
-;; `word-help' is also able to do symbol completion via the
-;; `word-help-complete' function. Bind this function to C-TAB by
-;; adding the following line to your .emacs file:
-;;
-;;   (global-set-key [?\M-\t] 'word-help-complete)
-;;
-;; Note that some modes automatically override this key; you may
-;; therefore wish to either put the above statement in a hook or
-;; associate the function with an other key.
-
-;; Usually, `word-help' is able to determine the relevant Texinfo
-;; file from looking at the buffer's `mode-name'; if not, you can use
-;; the interactive function `set-help-file' to set this.
-
-;; Customizing
-;; ***********
-;;
-;; User interface
-;; --------------
-;;
-;; Two variables control the behaviour of the user-interface of
-;; `word-help': `word-help-split-window' and
-;; `word-help-magic-index'.  Do C-h v to get more information on
-;; these.
-
-;; Adding more Texinfo files
-;; -------------------------
-;;
-;; Associations between mode-names and Texinfo files can be done
-;; through the `word-help-mode-alist' variable, which defines an
-;; `alist' making `set-help-file' able to initialize the necessary
-;; variable.
-
-;; NOTE: If you have to customize the regexps, it is *CRUCIAL* that
-;; none of your regexps match the empty string! Not adhering to this
-;; restriction will make `word-help' enter an infinite loop.
-
-;; Contacting the author
-;; *********************
-;;
-;; If you wish to contact me for any reason, please feel free to write
-;; to:
-
-;; Jens Berger
-;; Spektrumveien 4
-;; N-0666 Oslo
-;; Norway
-;;
-;; E-mail: <jensthi@ifi.uio.no>
-
-;; Have fun.
-
-;;
-;;; Code:
-;;
-
-(require 'info)
-
-;;;--------------------
-;;;    USER OPTIONS
-;;;--------------------
-
-(defvar word-help-split-window t
-  "*Non-nil means that the info buffer will pop up in a separate window.
-If nil, we will just switch to it.")
-
-(defvar word-help-magic-index t
-  "*Non-nil means that the keyword will be searched for in the requested node.
-This is done by determining whether the line the point is positioned
-on after using `Info-goto-node', actually contains the keyword.  If
-not, we will search for the first occurence of the keyword.  This may
-help when the info file isn't correctly indexed.")
-
-;;; ---- end of user configurable variables
-
-;;;-------------------------
-;;;   ADVANCED USER OPTIONS
-;;;-------------------------
-
-(defvar word-help-mode-alist
-  '(
-    ("autoconf"
-     (("autoconf" "Macro Index") ("m4" "Macro index"))
-     (("AC_\\([A-Za-z0-9_]+\\)" 1)
-      ("[a-z]+"))
-     nil
-     nil
-     (("AC_\\([A-Za-z0-9_]+\\)" 1 nil (("^[A-Z_]+$")))
-      ("[a-z_][a-z_]*" 0 nil (("^[a-z_]+$")))))
-
-    ("Bison"
-     (("bison" "Index")
-      ("libc" "Type Index" "Function Index" "Variable Index"))
-     (("%[A-Za-z]*")
-      ("[A-Za-z_][A-Za-z0-9_]*"))
-     nil
-     nil
-     (("%[A-Za-z]*" nil nil (("^%")))
-      ("[A-Za-z_][A-Za-z0-9_]*" nil nil (("[A-Za-z_][A-Za-z0-9_]*")))))
-
-    ("YACC" . "Bison")
-
-    ("C" (("libc" "Type Index" "Function Index" "Variable Index")))
-    ("C++" . "C")
-
-    ("Emacs-Lisp"
-     (("elisp" "Index"))
-     (("[^][ ()\n\t.\"'#]+"))
-     nil
-     nil
-     lisp-complete-symbol)
-
-    ("LaTeX"
-     (("latex" "Command Index"))
-     (("\\\\\\(begin\\|end\\){\\([^}\n]+\\)}" 2 0)
-      ("\\\\[A-Za-z]+")
-      ("\\\\[^A-Za-z]")
-      ("[A-Za-z]+"))
-     nil
-     nil
-     (("\\\\begin{\\([A-Za-z]*\\)" 1 "}" (("^[A-Za-z]+$")))
-      ("\\\\end{\\([A-Za-z]*\\)" 1 "}" (("^[A-Za-z]+$")))
-      ("\\\\renewcommand{\\(\\\\?[A-Za-z]*\\)" 1 "}" (("^\\\\[A-Za-z]+")))
-      ("\\\\renewcommand\\(\\\\?[A-Za-z]*\\)" 1 "" (("^\\\\[A-Za-z]+")))
-      ("\\\\renewenvironment{?\\([A-Za-z]*\\)" 1  "}"(("^[A-Za-z]+$")))
-      ("\\\\[A-Za-z]*" 0 "" (("^\\\\[A-Za-z]+")))))
-
-    ("latex" . "LaTeX")
-
-    ("Nroff"
-     (("groff" "Macro Index" "Register Index" "Request Index"))
-     (("\\.[^A-Za-z]")
-      ("\\.[A-Za-z]+")
-      ("\\.\\([A-Za-z]+\\)" 1))
-     nil
-     nil
-     (("\\.[A-Za-z]*" nil nil (("^\\.[A-Za-z]+$")))
-      ("\\.\\([A-Za-z]*\\)" 1 nil (("^[A-Za-z]+$")))))
-
-    ("Groff" . "Nroff")
-
-   ("m4"
-     (("m4" "Macro index"))
-     (("\\([mM]4_\\)?\\([A-Za-z_][A-Za-z_0-9]*\\)" 2))
-     nil
-     nil
-     (("[mM]4_\\([A-Za-z_]?[A-Za-z_0-9]*\\)" 1)
-      ("[A-Za-z_][A-Za-z_0-9]*")))
-
-    ("Makefile"
-     (("make" "Name Index"))
-     (("\\.[A-Za-z]+") ;; .SUFFIXES
-      ("\\$[^()]")  ;; $@
-      ("\\$([^A-Za-z].)") ;; $(<@)
-      ("\\$[\(\{]\\([a-zA-Z+]\\)" 1) ;; $(wildcard)
-      ("[A-Za-z]+")) ;; foreach
-     nil
-     nil
-     (("\\.[A-Za-z]*" nil ":" (("^\\.[A-Za-z]+$")))
-      ("\\$(\\([A-Z]*\\)" 1 ")" (("^[A-Z]")))
-      ("[a-z]+" nil nil (("^[a-z]+$")))))
-
-    ("Perl"
-     (("perl" "Variable Index" "Function Index"))
-     (("\\$[^A-Za-z^]") ;; $@
-      ("\\$\\^[A-Za-z]?") ;; $^D
-      ("\\$[A-Za-z][A-Za-z_0-9]+") ;; $foobar
-      ("[A-Za-z_][A-Za-z_0-9]+")) ;; dbmopen
-     nil
-     nil
-     (("\\$[A-Za-z]*" nil nil (("^\\$[A-Za-z]+$"))) ;; $variable
-      ("[A-Za-z_][A-Za-z_0-9]*" nil nil
-       (("^[A-Za-z_][A-Za-z_0-9]*$"))))) ;; function
-
-    ("Simula" (("simula" "Index")) nil t)
-    ("Ifi Simula" . "Simula")
-    ("SIMULA" . "Simula")
-
-    ("Texinfo"
-     (("texinfo" "Command and Variable Index"))
-     (("@\\([A-Za-z]+\\)" 1))
-     nil
-     nil
-     (("@\\([A-Za-z]*\\)" 1)))
-
-    )
-  "Assoc list between `mode-name' and Texinfo files.
-The variable should be initialized with a list of elements with the
-following form:
-
-\(mode-name (word-help-info-files) (word-help-keyword-regexps)
-	   word-help-ignore-case word-help-index-mapper
-           word-help-complete-list)
-
-where `word-help-info-files', `word-help-keyword-regexps' and so
-forth of course are the values which should be put in these variables
-for this mode.  Note that `mode-name' doesn't have to be a legal
-mode-name; the user may use the call `set-help-file', where
-`mode-name' will be used in the `completing-read'.
-
-Example entry (for C):
-
-\(\"C\" ((\"libc\" \"Type Index\" \"Function Index\" \"Variable Index\"))
-       ((\"[A-Za-z_][A-Za-z0-9]+\")))
-
-The two first variables must be initialized; the two remaining will
-get default values if you omit them or set them to nil.  The default
-values are:
-
-word-help-keyword-regexps: (\"[A-Za-z_][A-Za-z0-9]+\")
-word-help-ignore-case:     nil
-
-More settings may be defined in the future.
-
-You may also define aliases, if there are several relevant mode-names
-to a single entry.  These should be of the form:
-
-\(MODE-NAME-ALIAS . MODE-NAME-REAL)
-
-For C++, you would use the alias
-
-\(\"C++\" . \"C\")
-
-to make C++ mode use the same help files as C files do.  Please note
-that you can shoot yourself in the foot with this possibility, by
-defining recursive aliases.")
-
-;;; --- end of advanced user options
-
-(defvar word-help-ignore-case nil
-  "Non-nil means that case is ignored when doing lookup.")
-(make-variable-buffer-local 'word-help-ignore-case)
-
-(defvar word-help-info-files nil
-  "List of info files with respective nodes, for the current mode.
-
-This should be a list of the following form:
-
-\((INFO-FILE-1 NODE-NAME-1 NODE-NAME-2 ...)
- (INFO-FILE-1 NODE-NAME-1 NODE-NAME-2 ...)
-      :           :           :
- (INFO-FILE-1 NODE-NAME-1 NODE-NAME-2 ...))
-
-An example entry for e.g. C would be:
-
-\((\"/local/share/gnu/info/libc\" \"Function Index\" \"Type Index\"
-  \"Variable Index\"))
-
-The files and nodes will be searched/cached in the order specified.
-This variable is usually set by the `word-help-switch-help-file'
-function, which utilizes  the `word-help-mode-alist'.")
-(make-variable-buffer-local 'word-help-info-files)
-
-(defvar word-help-keyword-regexps nil
-  "Regexps for finding keywords in the current mode.
-
-This is constructed as a list of the following form:
-
-\((REGEXP SUBMATCH-LOOKUP SUBMATCH-CURSOR)
- (REGEXP SUBMATCH-LOOKUP SUBMATCH-CURSOR)
-       :          :          :
- (REGEXP SUBMATCH-LOOKUP SUBMATCH-CURSOR))
-
-The regexps will be searched in order for a match which the cursor is
-within.
-
-submatch-lookup is the submatch number which will be looked for in the
-index.  May be omitted; defaults to 0 (e.g. the entire pattern).  This is
-useful in for instance configure lookup; each command is there prefixed
-with 'AC_', which must be ignored when doing a lookup.  Example regexp
-entry for this:
-
-\(\"AC_\\\\([A-Za-z0-9]+\\\\)\" 1)
-
-submatch-cursor is the part of the match which the cursor must be within.
-May be omitted; defaults to 0 (e.g. the entire pattern).")
-(make-variable-buffer-local 'word-help-keyword-regexps)
-(set-default 'word-help-keyword-regexps '(("[A-Za-z_][A-Za-z_0-9]*")))
-
-(defvar word-help-index-mapper nil
-  "Regexps to use for massaging index-entries into keywords.
-This variable should contain a list of regexps with sub-expressions,
-where we will only look for the sub-expression in the user text.
-
-The regexp list should be formatted as:
-
-  ((REGEXP SUBEXP) (REGEXP SUBEXP) ... )
-
-If the index entry does not match any of the regexps, it will be ignored.
-
-Example:
-
-Perl has index entries of the following form:
-
-* abs VALUE:                    perlfunc.
-* accept NEWSOCKET,GENERICSOCKET: perlfunc.
-* alarm SECONDS:                perlfunc.
-* atan2 Y,X:                    perlfunc.
-* bind SOCKET,NAME:             perlfunc.
-         :             :           :
-
-We will thus try to extract the first word in the index entry -
-\"abs\" from \"abs VALUE\", etc.  This is done by the following entry:
-
-\((\"^\\\\([^ \\t\\n]+\\\\)\" 1))
-
-This value is btw. the default one, and works with most Texinfo files")
-(make-variable-buffer-local 'word-help-index-mapper)
-(set-default 'word-help-index-mapper '(("^\\([^ \t\n]+\\)" 1)))
-
-
-(defvar word-help-complete-list nil
-  "Regexps or function to use for completion of symbols.
-The list should have the following format:
-
-  ((REGEXP SUBMATCH TEXT-APPEND (RE-FILTER-1 REG-FILTER-2 ...)
-           :               :             :               :      :
-   (REGEXP SUBMATCH TEXT-APPEND (RE-FILTER-1 REG-FILTER-2 ...))
-
-The two first entries are similar to `word-help-keyword-regexps',
-REGEXP is a regular expression which should match any relevant
-expression, and where SUBMATCH should be used for look up. By
-specifying non-nil REGEXP-FILTERs, we'll only include entries in the
-index which matches the regexp specified.
-
-If the contents of this variable is a symbol of a function, this
-function will be called instead. This is useful for modes providing
-a more intelligent function (like `lisp-complete-symbol' in Emacs Lisp mode).
-
-If you would like to use another function instead, you may.
-
-Non-nil TEXT-APPEND means that this text will be inserted after the
-completion, if we manage to do make a completion.")
-(make-variable-buffer-local 'word-help-complete-list)
-(set-default 'word-help-complete-list '(("[A-Za-z_][A-Za-z_0-9]*")))
-
-;;; Work variables
-
-
-(defvar word-help-main-index nil
-  "List of all index entries.
-
-See `word-help-process-indexes' for structure formatting.
-
-Minor note: This variable is a list if it is initialized, t if
-initializing failed and nil if uninitialized.")
-(make-variable-buffer-local 'word-help-main-index)
-
-(defvar word-help-complete-index nil
-  "List of regexps for completion, with matching index entries.
-Value is nil if uninitialized, t if initialized but not accessible,
-a list if we're feeling ok.")
-(make-variable-buffer-local 'word-help-complete-index)
-
-(defvar word-help-main-obarray nil
-  "Global work variable for `word-help' system.
-Do Not mess with this!")
-
-(defvar word-help-history nil
-  "History for `word-help' minibuffer queries.")
-(make-local-variable 'word-help-history)
-
-(defvar word-help-current-help-file nil
-  "Current help file active for this mode.")
-
-(defvar word-help-index-alist nil
-  "An assoc list mapping help files to info indexes.
-This means that `word-help-mode-index' can be init'ed faster.")
-
-(defvar word-help-help-mode nil
-  "Which mode the help system is bound to for the current mode.")
-(make-variable-buffer-local 'word-help-help-mode)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;; User Functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Debugging
-
-;;;###autoload
-(defun reset-word-help ()
-  "Clear all cached indexes in the `word-help' system.
-You should only need this when installing new info files, and/or
-adding more Texinfo files to the `word-help' system."
-  (interactive)
-  (setq word-help-index-alist nil
-	word-help-main-index nil
-	word-help-info-files nil
-	word-help-complete-index nil))
-
-
-;;; Changing help file
-
-;;;###autoload
-(defun set-help-file ()
-  "Change which set of Texinfo files used for word-help.
-
-`word-help' maintains a list over which Texinfo files which are
-relevant for each programming language (`word-help-mode-alist').  It
-usually selects the correct one, based upon the value of `mode-name'.
-If this guess is incorrect, you may also use this function manually to
-instruct future `word-help' calls which Texinfo files to use."
-  (interactive)
-  (let (helpfile helpguess (completion-ignore-case t))
-;; Try to make a guess
-    (setq helpguess (cond
-		     (word-help-current-help-file)
-		     ((word-help-guess-help-file))))
-;; Ask the user
-    (setq helpfile (completing-read
-		    (if helpguess
-			(format "Select help mode (default %s): " helpguess)
-		      "Select help mode: ")
-		    word-help-mode-alist
-		    nil t nil nil))
-    (if (equal "" helpfile)
-	(setq helpfile helpguess))
-    (if helpfile
-	(word-help-switch-help-file helpfile))))
-
-;;; Main user interface
-
-;;;###autoload
-(defun word-help ()
-  "Find documentation on the keyword under the cursor.
-The determination of which language the keyword belongs to, is based upon
-The relevant info file is selected by matching `mode-name' (the major
-mode) against the assoc list `word-help-mode-alist'.
-
-If this is not possible, `set-help-file' will be invoked for selecting
-the relevant info file.  `set-help-file' may also be invoked
-interactively by the user.
-
-If the keyword you are looking at is not available in any index, no
-default suggestion will be presented. "
-  (interactive)
-  (let (myguess guess index-info
-		(completion-ignore-case word-help-ignore-case))
-;; Set necessary variables for later lookup
-    (word-help-find-help-file)
-;; Have we previously cached datas?
-    (word-help-process-indexes)
-    (if
-	(atom word-help-main-index)
-	(message "No help file available for this mode.")
-;; First make a guess at what the user is looking for
-        (setq myguess (word-help-guess
-		       (point)
-		       (cond
-			((not (atom word-help-main-index))
-			 (car word-help-main-index)))
-		       word-help-keyword-regexps))
-;; Ask the user himself
-	(setq guess (completing-read
-					; Format string
-		     (if myguess
-			 (format "Look up keyword (default %s): " myguess)
-  		       "Look up keyword: ")
-					; Collection
-		     (car word-help-main-index)
-		     nil t nil 'word-help-history))
-	(if (equal guess "")
-	    (setq guess myguess))
-;; If we've got anything meaningful to lookup, do so
-	(if (not guess)
-	    (message "Help aborted.")
-	    (setq index-info (word-help-find-index-node
-			      guess
-			      word-help-main-index))
-	    (if (not index-info)
-		(message "Oops, I could not find \"%s\" anyway! Bug?" guess)
-	      (word-help-goto-index-node (nconc index-info (list guess))))))))
-
-;;;###autoload
-(defun word-help-complete ()
-  "Perform completion on the symbol preceding the point.
-The determination of which language the keyword belongs to, is based upon
-The relevant info file is selected by matching `mode-name' (the major
-mode) against the assoc list `word-help-mode-alist'.
-
-If this is not possible, `set-help-file' will be invoked for selecting
-the relevant info file.  `set-help-file' may also be invoked
-interactively by the user.
-
-The keywords are extracted from the index of the info file defined for
-this mode, by using the `word-help-complete-list' variable."
-  (interactive)
-  (word-help-make-complete)
-  (cond
-   ((not word-help-complete-index)
-    (message "No completion available for this mode."))
-   ((symbolp word-help-complete-index)
-    (call-interactively word-help-complete-index))
-   ((listp word-help-complete-index)
-    (let ((all-match (word-help-guess-all (point)
-					  word-help-complete-index t))
-	  (completion-ignore-case word-help-ignore-case)
-	  (c-list word-help-complete-index)
-	  c-entry word-match completion completed)
-;; Loop over and try to find a match
-      (while (and all-match (not completed))
-	(setq word-match (car all-match)
-	      c-entry (car c-list)
-	      c-list (cdr c-list)
-	      all-match (cdr all-match))
-;; Check whether the current pattern matched
-	(if word-match
-	    (let ((close (nth 3 c-entry))
-		  (words (nth 4 c-entry)))
-;; Find the maximum completion for this word
-;		(print word-match)
-;		(print c-entry)
-;		(print close)
-	      (setq completion (try-completion word-match words))
-;; Was the match exact
-	      (cond ((eq completion t)
-		     (and close
-			  (not (looking-at (regexp-quote close)))
-			  (insert close))
-		     (setq completed t))
-;; Silently ignore non-matches
-		    ((not completion))
-;; May we complete more unambiguously
-		    ((not (string-equal completion word-match))
-		     (delete-region (- (point) (length word-match))
-				    (point))
-		     (insert completion)
-		     (if (eq t (try-completion completion words))
-			 (progn
-			   (and close
-				(not (looking-at (regexp-quote close)))
-				(insert close))))
-		     (setq completed t))
-		    (t
-		     (message "Making completion list...")
-		     (let ((list (all-completions word-match words nil)))
-		       (setq completed list)
-		       (with-output-to-temp-buffer "*Completions*"
-			 (display-completion-list list)))
-		     (message "Making completion list...done"))))))
-      (if (not completed) (message "No match."))))
-   (t (message "No completion available for this mode."))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;; Index mapping ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defun word-help-map-index-entries (str re-list)
-  "Transform an Info index entry into a programming keyword.
-Uses this by mapping the entries through `word-help-index-mapper'."
-  (let ((regexp (car (car re-list)))
-	(subexp (car (cdr (car re-list))))
-	(next (cdr re-list)))
-    (cond
-     ((string-match regexp str)
-      (substring str (match-beginning subexp) (match-end subexp)))
-     (next
-      (word-help-map-index-entries str next)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;; Switch mode files ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Mode lookup
-
-(defun word-help-guess-help-file ()
-  "Guesses a relevant help file based on mode name.
-Returns nil if no guess could be made.  Uses `word-help-mode-alist'."
-  (let (guess)
-    (cond
-     ((setq guess (assoc mode-name word-help-mode-alist))
-      (car guess)))))
-
-
-(defun word-help-switch-help-file (helpfile)
-  "Changes the help-file to the mode name given.
-Uses `word-help-mode-alist'."
-  (if helpfile
-      (let (helpdesc)
-	(if (not (setq helpdesc (assoc helpfile word-help-mode-alist)))
-	    (message "No help defined for \"%s\"." helpfile)
-	    (if (stringp (cdr helpdesc))
-		(word-help-switch-help-file (cdr helpdesc))
-  	        (word-help-make-default-map
-		 helpdesc
-		 (list 'word-help-help-mode
-		       'word-help-info-files
-		       'word-help-keyword-regexps
-		       'word-help-ignore-case
-		       'word-help-index-mapper
-		       'word-help-complete-list))))
-	    (setq word-help-main-index nil
-		  word-help-complete-index nil))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;; Index collection ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-(defun word-help-extract-index (file-name index-list index-map ignore-case)
-  "Extract index from filename and the first node name in index list.
-`file-name' is the name of the info file, while `index-list' is a list
-of node-names to search."
-  (let (cmd1 cmdlow nodename ob-array next (case-fold-search word-help-ignore-case))
-    (setq nodename (car index-list))
-    (setq ob-array (make-vector 211 0))
-    (message "Processing \"%s\" in %s..." nodename file-name)
-    (save-window-excursion
-      (Info-goto-node (concat "(" file-name ")" nodename))
-      (end-of-buffer)
-      (while (re-search-backward "\\* \\([^\n:]+\\):" nil t)
-	(setq cmd1 (buffer-substring (match-beginning 1) (match-end 1)))
-	(setq cmdlow (if ignore-case (downcase cmd1) cmd1))
-	(if index-map
-	    (setq cmdlow (word-help-map-index-entries cmdlow
-			      index-map)))
-;; We have to do this workaround to support case-insensitive matching
-	(cond
-	 (cmdlow
-	  (put (intern cmdlow ob-array) 'word-help-real-name cmd1)
-	  (intern cmdlow word-help-main-obarray)))))
-    (setq next (cond
-		((cdr index-list)
-		 (word-help-extract-index file-name (cdr index-list)
-					     index-map ignore-case))))
-    (nconc (list (list nodename ob-array)) next)))
-
-
-(defun word-help-collect-indexes (info-file)
-  "Process all the indexes in an info file.
-
-Uses `word-help-extract-index' on each node, and returns an entry
-suitable for merging into `word-help-process-indexes'.  `info-file'
-is an entry of the form
-
-\(FILE-NAME INDEX-NAME-1 INDEX-NAME-2 ...)"
-  (let ((file  (car info-file))
-	(nodes (cdr info-file)))
-    (nconc (list file) (word-help-extract-index file nodes
-						   word-help-index-mapper
-                                                   word-help-ignore-case))))
-
-(defun word-help-process-indexes ()
-  "Process all the entries in the global variable `word-help-info-files'.
-Returns a list formatted as follows:
-
-\(all-entries-ob
- (file-name-1 (node-name-1 this-node-entries-ob)
-	      (node-name-2 this-node-entries-ob)
-	           :          :         :
-	      (node-name-n this-node-entries-ob))
- (file-name-2 (node-name-1 this-node-entries-ob)
-	      (node-name-2 this-node-entries-ob)
-	           :          :         :
-	      (node-name-n this-node-entries-ob))
-    :    :    :    :    :    :    :    :    :
- (file-name-n (node-name-1 this-node-entries-ob)
-	      (node-name-2 this-node-entries-ob)
-	           :          :         :
-	      (node-name-n this-node-entries-ob)))
-
-The symbols in the obarrays may contain the additional property
-`word-help-real-name', which tells the *real* node to go to.
-
-Note that we use `word-help-index-alist' to speed up the process.  Note
-that `word-help-switch-help-file' must have been called before this function.
-
-This structure is then later searched by `word-help-find-index-node'."
-  (let (index-words old-index)
-    (if (not word-help-main-index)
-	 (cond
-	  ((setq old-index
-		 (assoc word-help-help-mode word-help-index-alist))
-	   (setq word-help-main-index (nth 1 old-index)))
-	  (word-help-info-files
-	   (setq word-help-main-obarray (make-vector 307 0)
-		 index-words (mapcar 'word-help-collect-indexes
-				     word-help-info-files)
-		 word-help-main-index
-		 (append (list word-help-main-obarray) index-words))
-	   (setq word-help-index-alist (cons (list word-help-help-mode
-						       word-help-main-index)
-						 word-help-index-alist)))
-	  (t (setq word-help-main-index t))))))
-
-(defun word-help-find-help-file ()
-  "Tries to find and set a relevant help file for the current mode."
-  (let (helpguess)
-    (if (not word-help-info-files)
-	(if (setq helpguess (word-help-guess-help-file))
-	    (word-help-switch-help-file helpguess)
-	  (set-help-file)))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;; Keyword guess ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun word-help-guess-all (cur-point re-list
-			    &optional copy-to-point)
-  "Guesses *all* keywords the user possibly may be looking at.
-Returns a list of all possible keywords. "
-  (let ((regexp (car (car re-list)))
-	(submatch  (cond ((nth 1 (car re-list))) (0)))
-	(cursmatch (cond ((nth 2 (car re-list))) (0)))
-	(guess nil)
-	(next-guess nil)
-	(case-fold-search word-help-ignore-case)
-	(end-point nil))
-    (save-excursion
-      (end-of-line)
-      (setq end-point (point))
-      ;; Start at the beginning
-      (beginning-of-line)
-      (while (and (not guess) (re-search-forward regexp end-point t))
-	;; Look whether the cursor is within the match
-	(if (and (<= (match-beginning cursmatch) cur-point)
-		 (>= (match-end cursmatch) cur-point))
-	    (if (or (not copy-to-point) (<= cur-point (match-end submatch)))
-		(setq guess (buffer-substring (match-beginning submatch)
-					      (if copy-to-point
-						  cur-point
-						(match-end submatch)))))))
-      ;; If we found anything, return it and call ourselves again
-      (if (cdr re-list)
-	  (setq next-guess (word-help-guess-all cur-point (cdr re-list)
-						copy-to-point))))
-    (cons guess next-guess)))
-
-(defun word-help-guess-match (all-match cmd-array)
-  (let ((sym (car all-match)))
-    (cond
-     ((and sym (intern-soft (if word-help-ignore-case
-				(downcase sym)
-			      sym) cmd-array)
-      sym))
-     ((cdr all-match)
-      (word-help-guess-match (cdr all-match) cmd-array)))))
-
-
-(defun word-help-guess (cur-point cmd-array re-list)
-  "Guesses what keyword the user is looking at, and returns that.
-CUR-POINT should be the current value of `point', CMD-ARRAY an obarray
-of all the keywords which are defined for the current mode, and
-RE-LIST a list of regexps use for the hunt.  See also
-`word-help-keyword-regexps'."
-  (let ((all-matches (word-help-guess-all cur-point re-list)))
-;    (print all-matches)
-    (word-help-guess-match all-matches cmd-array)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;	Show node for keyword ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Find an index entry
-
-(defun word-help-find-index-node (node index-reg)
-  "Finds the node named `node' in the index-register `index-reg'.
-`index-reg' has the format as returned (and documented) by the
-`word-help-process-indexes' call.  In most cases, this will be equal to
-`word-help-main-index'.
-
-Returns a list with format
-  (file-name index-node-name index-entry)
-which contains the file and index where the entry can be found.
-Returns nil if the entry can't be found."
-  (let (file-info node-name)
-    (setq node-name (cond (word-help-ignore-case (downcase node)) (node)))
-    (if (intern-soft node-name (car index-reg))
-      (setq file-info (word-help-index-search-file node-name
-						      (cdr index-reg))))
-    file-info))
-
-(defun word-help-index-search-file (entry file-data)
-  "Searches a cached file for the index-entry `entry'."
-  (let (this-file next-files file-name node node-infos)
-    (setq this-file (car file-data)
-	  next-files (cdr file-data)
-	  file-name (car this-file)
-	  node-infos (cdr this-file)
-	  node (word-help-index-search-nodes entry node-infos))
-    (cond
-     (node
-      (cons file-name node))
-     (next-files (word-help-index-search-file entry next-files)))))
-
-(defun word-help-index-search-nodes (entry node-info)
-  "Searches a cached list of nodes for the entry `entry'."
-  (let (this-node next-nodes node-name node-ob node-sym)
-    (setq this-node (car node-info)
-	  next-nodes (cdr node-info)
-	  node-name (car this-node)
-	  node-ob (car (cdr this-node))
-	  node-sym (intern-soft entry node-ob))
-    (cond
-     (node-sym
-      (list node-name (get node-sym 'word-help-real-name)))
-     (next-nodes (word-help-index-search-nodes entry next-nodes)))))
-
-;;; Switch to a node in an index
-
-(defun word-help-goto-index-node (index-info)
-  "Jumps to an index node.
-`index-info' should be a list with the following format:
-
-\(FILE-NAME INDEX-NODE-NAME INDEX-ENTRY KEYWORD)"
-
-  (let* ((file-name (car index-info))
-	 (node-name (nth 1 index-info))
-	 (entry-name (nth 2 index-info))
-	 (kw-name (nth 3 index-info))
-	 (buffer (current-buffer)))
-    (if word-help-split-window
-	(pop-to-buffer nil))
-    (Info-goto-node (concat "(" file-name ")" node-name))
-    (Info-menu entry-name)
-;; Do magic keyword search
-    (if word-help-magic-index
-	(let (end-point regs this-re found entry-re)
-	  (setq entry-re (regexp-quote kw-name)
-		regs (list (concat
-			    (if (string-match "^[A-Za-z]" entry-name)
-				"\\<" "")
-			    entry-re
-			    (if (string-match "[A-Za-z]$" entry-name)
-				"\\>" ""))
-			   (concat "[`\"\(]" entry-re)
-			   (concat "^" entry-re
-				   (if (string-match "[A-Za-z]$" entry-name)
-				       "\\>" ""))))
-	  (end-of-line)
-	  (setq end-point (point))
-	  (beginning-of-line)
-	  (if (not (re-search-forward (car regs) end-point t))
-	      (while (and (not found) (car regs))
-		(setq this-re (car regs)
-		      regs (cdr regs)
-		      found (re-search-forward this-re nil t))))
-	(recenter 0)))
-    (if word-help-split-window
-	(pop-to-buffer buffer))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Completion ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-
-(defun word-help-extract-matches (from-ob dest-ob re-list)
-  "Takes atoms from from-ob, and puts them in dest-ob if they match re-list."
-  (let ((regexp (car (car re-list))))
-    (mapatoms (lambda (x)
-		(if (or (not regexp) (string-match regexp (symbol-name x)))
-		    (intern (symbol-name x) dest-ob)))
-	      from-ob)
-    (if (cdr re-list)
-	(word-help-extract-matches from-ob dest-ob (cdr re-list))))
-  dest-ob)
-
-(defun word-help-make-complete ()
-  "Generates the `word-help-complete-index'."
-  (if word-help-complete-index
-      nil
-    (word-help-find-help-file)
-    (cond
-     ((symbolp word-help-complete-list)
-      (setq word-help-complete-index word-help-complete-list))
-     (t
-      (word-help-process-indexes)
-      (if (not (atom word-help-main-index))
-	  (let ((from-ob (car word-help-main-index)))
-	    (message "Processing keywords...")
-	    (setq word-help-complete-index
-		  (mapcar
-		   (lambda (cmpl)
-		     (let
-			 ((regexp (car cmpl))
-			  (subm (cond ((nth 1 cmpl)) (0)))
-			  (app (cond ((nth 2 cmpl)) ("")))
-			  (re-list (cond ((nth 3 cmpl)) ('((".")))))
-			  (obarr (make-vector 47 0)))
-		       (list regexp subm subm app
-			     (word-help-extract-matches from-ob obarr
-							re-list))))
-		   word-help-complete-list))))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Misc. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;;; Default mapping
-
-(defun word-help-make-default-map (list vars)
-  "Makes a default mapping for `vars', which must be listed in order.
-vars is a list of quoted symbols.  If the nth entry in the list is
-non-nil, the nth variable will be given this value.  If nil, the var
-will be given the global default value."
-  (set (car vars) (cond ((car list)) ((default-value (car vars)))))
-  (if (cdr vars)
-      (word-help-make-default-map (cdr list) (cdr vars))))
-
-(provide 'word-help)
-
-;;; word-help.el ends here
diff --git a/lisp/abbrev.el b/lisp/abbrev.el
deleted file mode 100644
index ff6ae3ac672..00000000000
--- a/lisp/abbrev.el
+++ /dev/null
@@ -1,299 +0,0 @@
-;;; abbrev.el --- abbrev mode commands for Emacs
-
-;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
-
-;; Keywords: abbrev
-
-;; 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 facility is documented in the Emacs Manual.
-
-;;; Code:
-
-(defvar only-global-abbrevs nil "\
-*t means user plans to use global abbrevs only.
-Makes the commands to define mode-specific abbrevs define global ones instead.")
-
-(defun abbrev-mode (arg)
-  "Toggle abbrev mode.
-With argument ARG, turn abbrev mode on iff ARG is positive.
-In abbrev mode, inserting an abbreviation causes it to expand
-and be replaced by its expansion."
-  (interactive "P")
-  (setq abbrev-mode
-	(if (null arg) (not abbrev-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (force-mode-line-update))
-
-(defvar edit-abbrevs-map nil
-  "Keymap used in edit-abbrevs.")
-(if edit-abbrevs-map
-    nil
-  (setq edit-abbrevs-map (make-sparse-keymap))
-  (define-key edit-abbrevs-map "\C-x\C-s" 'edit-abbrevs-redefine)
-  (define-key edit-abbrevs-map "\C-c\C-c" 'edit-abbrevs-redefine))
-
-(defun kill-all-abbrevs ()
-  "Undefine all defined abbrevs."
-  (interactive)
-  (let ((tables abbrev-table-name-list))
-    (while tables
-      (clear-abbrev-table (symbol-value (car tables)))
-      (setq tables (cdr tables)))))
-
-(defun insert-abbrevs ()
-  "Insert after point a description of all defined abbrevs.
-Mark is set after the inserted text."
-  (interactive)
-  (push-mark
-   (save-excursion
-    (let ((tables abbrev-table-name-list))
-      (while tables
-	(insert-abbrev-table-description (car tables) t)
-	(setq tables (cdr tables))))
-    (point))))
-
-(defun list-abbrevs ()
-  "Display a list of all defined abbrevs."
-  (interactive)
-  (display-buffer (prepare-abbrev-list-buffer)))
-
-(defun prepare-abbrev-list-buffer ()
-  (save-excursion
-    (set-buffer (get-buffer-create "*Abbrevs*"))
-    (erase-buffer)
-    (let ((tables abbrev-table-name-list))
-      (while tables
-	(insert-abbrev-table-description (car tables) t)
-	(setq tables (cdr tables))))
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    (edit-abbrevs-mode))
-  (get-buffer-create "*Abbrevs*"))
-
-(defun edit-abbrevs-mode ()
-  "Major mode for editing the list of abbrev definitions.
-\\{edit-abbrevs-map}"
-  (interactive)
-  (setq major-mode 'edit-abbrevs-mode)
-  (setq mode-name "Edit-Abbrevs")
-  (use-local-map edit-abbrevs-map))
-
-(defun edit-abbrevs ()
-  "Alter abbrev definitions by editing a list of them.
-Selects a buffer containing a list of abbrev definitions.
-You can edit them and type \\<edit-abbrevs-map>\\[edit-abbrevs-redefine] to redefine abbrevs
-according to your editing.
-Buffer contains a header line for each abbrev table,
- which is the abbrev table name in parentheses.
-This is followed by one line per abbrev in that table:
-NAME   USECOUNT   EXPANSION   HOOK
-where NAME and EXPANSION are strings with quotes,
-USECOUNT is an integer, and HOOK is any valid function
-or may be omitted (it is usually omitted)."
-  (interactive)
-  (switch-to-buffer (prepare-abbrev-list-buffer)))
-
-(defun edit-abbrevs-redefine ()
-  "Redefine abbrevs according to current buffer contents."
-  (interactive)
-  (define-abbrevs t)
-  (set-buffer-modified-p nil))
-
-(defun define-abbrevs (&optional arg)
-  "Define abbrevs according to current visible buffer contents.
-See documentation of `edit-abbrevs' for info on the format of the
-text you must have in the buffer.
-With argument, eliminate all abbrev definitions except
-the ones defined from the buffer now."
-  (interactive "P")
-  (if arg (kill-all-abbrevs))
-  (save-excursion
-   (goto-char (point-min))
-   (while (and (not (eobp)) (re-search-forward "^(" nil t))
-     (let* ((buf (current-buffer))
-	    (table (read buf))
-	    abbrevs name hook exp count)
-       (forward-line 1)
-       (while (progn (forward-line 1)
-		     (not (eolp)))
-	 (setq name (read buf) count (read buf) exp (read buf))
-	 (skip-chars-backward " \t\n\f")
-	 (setq hook (if (not (eolp)) (read buf)))
-	 (skip-chars-backward " \t\n\f")
-	 (setq abbrevs (cons (list name exp hook count) abbrevs)))
-       (define-abbrev-table table abbrevs)))))
-
-(defun read-abbrev-file (&optional file quietly)
-  "Read abbrev definitions from file written with `write-abbrev-file'.
-Optional argument FILE is the name of the file to read;
-it defaults to the value of `abbrev-file-name'.
-Optional second argument QUIETLY non-nil means don't print anything."
-  (interactive "fRead abbrev file: ")
-  (load (if (and file (> (length file) 0)) file abbrev-file-name)
-	nil quietly)
-  (setq save-abbrevs t abbrevs-changed nil))
-
-(defun quietly-read-abbrev-file (&optional file)
-  "Read abbrev definitions from file written with write-abbrev-file.
-Optional argument FILE is the name of the file to read;
-it defaults to the value of `abbrev-file-name'.
-Does not print anything."
-  ;(interactive "fRead abbrev file: ")
-  (read-abbrev-file file t))
-
-(defun write-abbrev-file (file)
-  "Write all abbrev definitions to a file of Lisp code.
-The file written can be loaded in another session to define the same abbrevs.
-The argument FILE is the file name to write."
-  (interactive
-   (list
-    (read-file-name "Write abbrev file: "
-		    (file-name-directory (expand-file-name abbrev-file-name))
-		    abbrev-file-name)))
-  (or (and file (> (length file) 0))
-      (setq file abbrev-file-name))
-  (save-excursion
-   (set-buffer (get-buffer-create " write-abbrev-file"))
-   (erase-buffer)
-   (let ((tables abbrev-table-name-list))
-     (while tables
-       (insert-abbrev-table-description (car tables) nil)
-       (setq tables (cdr tables))))
-   (write-region 1 (point-max) file)
-   (erase-buffer)))
-
-(defun add-mode-abbrev (arg)
-  "Define mode-specific abbrev for last word(s) before point.
-Argument is how many words before point form the expansion;
-or zero means the region is the expansion.
-A negative argument means to undefine the specified abbrev.
-Reads the abbreviation in the minibuffer.
-
-Don't use this function in a Lisp program; use `define-abbrev' instead."
-  (interactive "p")
-  (add-abbrev
-   (if only-global-abbrevs
-       global-abbrev-table 
-     (or local-abbrev-table
-	 (error "No per-mode abbrev table")))
-   "Mode" arg))
-
-(defun add-global-abbrev (arg)
-  "Define global (all modes) abbrev for last word(s) before point.
-The prefix argument specifies the number of words before point that form the
-expansion; or zero means the region is the expansion.
-A negative argument means to undefine the specified abbrev.
-This command uses the minibuffer to read the abbreviation.
-
-Don't use this function in a Lisp program; use `define-abbrev' instead."
-  (interactive "p")
-  (add-abbrev global-abbrev-table "Global" arg))
-
-(defun add-abbrev (table type arg)
-  (let ((exp (and (>= arg 0)
-		  (buffer-substring
-		   (point)
-		   (if (= arg 0) (mark)
-		     (save-excursion (forward-word (- arg)) (point))))))
-	name)
-    (setq name
-	  (read-string (format (if exp "%s abbrev for \"%s\": "
-				 "Undefine %s abbrev: ")
-			       type exp)))
-    (set-text-properties 0 (length name) nil name)
-    (if (or (null exp)
-	    (not (abbrev-expansion name table))
-	    (y-or-n-p (format "%s expands to \"%s\"; redefine? "
-			      name (abbrev-expansion name table))))
-	(define-abbrev table (downcase name) exp))))
-	
-(defun inverse-add-mode-abbrev (arg)
-  "Define last word before point as a mode-specific abbrev.
-With prefix argument N, defines the Nth word before point.
-This command uses the minibuffer to read the expansion.
-Expands the abbreviation after defining it."
-  (interactive "p")
-  (inverse-add-abbrev
-   (if only-global-abbrevs
-       global-abbrev-table 
-     (or local-abbrev-table
-	 (error "No per-mode abbrev table")))
-   "Mode" arg))
-
-(defun inverse-add-global-abbrev (arg)
-  "Define last word before point as a global (mode-independent) abbrev.
-With prefix argument N, defines the Nth word before point.
-This command uses the minibuffer to read the expansion.
-Expands the abbreviation after defining it."
-  (interactive "p")
-  (inverse-add-abbrev global-abbrev-table "Global" arg))
-
-(defun inverse-add-abbrev (table type arg)
-  (let (name nameloc exp)
-    (save-excursion
-     (forward-word (- arg))
-     (setq name (buffer-substring (point) (progn (forward-word 1)
-					       (setq nameloc (point))))))
-    (set-text-properties 0 (length name) nil name)
-    (setq exp (read-string (format "%s expansion for \"%s\": "
-				   type name)))
-    (if (or (not (abbrev-expansion name table))
-	    (y-or-n-p (format "%s expands to \"%s\"; redefine? "
-			      name (abbrev-expansion name table))))
-	(progn
-	 (define-abbrev table (downcase name) exp)
-	 (save-excursion
-	  (goto-char nameloc)
-	  (expand-abbrev))))))
-
-(defun abbrev-prefix-mark (&optional arg)
-  "Mark current point as the beginning of an abbrev.
-Abbrev to be expanded starts here rather than at beginning of word.
-This way, you can expand an abbrev with a prefix: insert the prefix,
-use this command, then insert the abbrev."
-  (interactive "P")
-  (or arg (expand-abbrev))
-  (setq abbrev-start-location (point-marker)
-	abbrev-start-location-buffer (current-buffer))
-  (insert "-"))
-
-(defun expand-region-abbrevs (start end &optional noquery)
-  "For abbrev occurrence in the region, offer to expand it.
-The user is asked to type y or n for each occurrence.
-A prefix argument means don't query; expand all abbrevs.
-If called from a Lisp program, arguments are START END &optional NOQUERY."
-  (interactive "r\nP")
-  (save-excursion
-    (goto-char start)
-    (let ((lim (- (point-max) end))
-	  pnt string)
-      (while (and (not (eobp))
-		  (progn (forward-word 1)
-			 (<= (setq pnt (point)) (- (point-max) lim))))
-	(if (abbrev-expansion
-	     (setq string
-		   (buffer-substring
-		    (save-excursion (forward-word -1) (point))
-		    pnt)))
-	    (if (or noquery (y-or-n-p (format "Expand `%s'? " string)))
-		(expand-abbrev)))))))
-
-;;; abbrev.el ends here
diff --git a/lisp/abbrevlist.el b/lisp/abbrevlist.el
deleted file mode 100644
index 355e24cf5ec..00000000000
--- a/lisp/abbrevlist.el
+++ /dev/null
@@ -1,53 +0,0 @@
-;;; abbrevlist.el --- list one abbrev table alphabetically ordered.
-
-;; Copyright (C) 1986, 1992 Free Software Foundation, Inc.
-;; Suggested by a previous version by Gildea.
-
-;; Maintainer: FSF
-;; Keywords: abbrev
-
-;; 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.
-
-;;; Code:
-
-(defun list-one-abbrev-table (abbrev-table output-buffer)
-  "Display alphabetical listing of ABBREV-TABLE in buffer OUTPUT-BUFFER."
-  (with-output-to-temp-buffer output-buffer
-    (save-excursion
-      (let ((abbrev-list nil) (first-column 0))
-	(set-buffer standard-output)
-	(mapatoms 
-	  (function (lambda (abbrev)
-		      (setq abbrev-list (cons abbrev abbrev-list))))
-	  abbrev-table)
-	(setq abbrev-list (sort abbrev-list 'string-lessp))
-	(while abbrev-list
-	  (if (> (+ first-column 40) (frame-width))
-	      (progn
-		(insert "\n")
-		(setq first-column 0)))
-	  (indent-to first-column)
-	  (insert (symbol-name (car abbrev-list)))
-	  (indent-to (+ first-column 8))
-	  (insert (symbol-value (car abbrev-list)))
-	  (setq first-column (+ first-column 40))
-	  (setq abbrev-list (cdr abbrev-list)))))))
-
-(provide 'abbrevlist)
-
-;;; abbrevlist.el ends here
diff --git a/lisp/add-log.el b/lisp/add-log.el
deleted file mode 100644
index ef0e83dbca1..00000000000
--- a/lisp/add-log.el
+++ /dev/null
@@ -1,596 +0,0 @@
-;;; add-log.el --- change log maintenance commands for Emacs
-
-;; Copyright (C) 1985, 1986, 1988, 1993, 1994 Free Software Foundation, Inc.
-
-;; Keywords: maint
-
-;; 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 facility is documented in the Emacs Manual.
-
-;;; Code:
-
-(defvar change-log-default-name nil
-  "*Name of a change log file for \\[add-change-log-entry].")
-
-(defvar add-log-current-defun-function nil
-  "\
-*If non-nil, function to guess name of current function from surrounding text.
-\\[add-change-log-entry] calls this function (if nil, `add-log-current-defun'
-instead) with no arguments.  It returns a string or nil if it cannot guess.")
-
-;;;###autoload
-(defvar add-log-full-name nil
-  "*Full name of user, for inclusion in ChangeLog daily headers.
-This defaults to the value returned by the `user-full-name' function.")
-
-;;;###autoload
-(defvar add-log-mailing-address nil
-  "*Electronic mail address of user, for inclusion in ChangeLog daily headers.
-This defaults to the value of `user-mail-address'.")
-
-(defvar change-log-font-lock-keywords
-  '(;;
-    ;; Date lines, new and old styles.
-    ("^\\sw........."
-     (0 font-lock-string-face)
-     ("[A-Z][^\n<]+" nil nil (0 font-lock-reference-face)))
-    ;;
-    ;; File names.
-    ("^\t\\* \\([^ ,:([\n]+\\)"
-     (1 font-lock-function-name-face)
-     ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 font-lock-function-name-face)))
-    ;;
-    ;; Function or variable names.
-    ("(\\([^ ,:\n]+\\)"
-     (1 font-lock-keyword-face)
-     ("\\=, \\([^ ,:\n]+\\)" nil nil (1 font-lock-keyword-face)))
-    ;;
-    ;; Conditionals.
-    ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 font-lock-variable-name-face))
-    ;;
-    ;; Acknowledgments.
-    ("^\t\\(From\\|Reported by\\)" 1 font-lock-comment-face)
-    )
-  "Additional expressions to highlight in Change Log mode.")
-
-(defvar change-log-mode-map nil
-  "Keymap for Change Log major mode.")
-(if change-log-mode-map
-    nil
-  (setq change-log-mode-map (make-sparse-keymap)))
-
-(defvar change-log-time-zone-rule nil
-  "Time zone used for calculating change log time stamps.
-It takes the same format as the TZ argument of `set-time-zone-rule'.
-If nil, use local time.")
-
-(defun iso8601-time-zone (time)
-  (let* ((utc-offset (or (car (current-time-zone time)) 0))
-	 (sign (if (< utc-offset 0) ?- ?+))
-	 (sec (abs utc-offset))
-	 (ss (% sec 60))
-	 (min (/ sec 60))
-	 (mm (% min 60))
-	 (hh (/ min 60)))
-    (format (cond ((not (zerop ss)) "%c%02d:%02d:%02d")
-		  ((not (zerop mm)) "%c%02d:%02d")
-		  (t "%c%02d"))
-	    sign hh mm ss)))
-
-(defun change-log-name ()
-  (or change-log-default-name
-      (if (eq system-type 'vax-vms) 
-	  "$CHANGE_LOG$.TXT"
-	"ChangeLog")))
-
-;;;###autoload
-(defun prompt-for-change-log-name ()
-  "Prompt for a change log name."
-  (let* ((default (change-log-name))
-	 (name (expand-file-name
-		(read-file-name (format "Log file (default %s): " default)
-				nil default))))
-    ;; Handle something that is syntactically a directory name.
-    ;; Look for ChangeLog or whatever in that directory.
-    (if (string= (file-name-nondirectory name) "")
-	(expand-file-name (file-name-nondirectory default)
-			  name)
-      ;; Handle specifying a file that is a directory.
-      (if (file-directory-p name)
-	  (expand-file-name (file-name-nondirectory default)
-			    (file-name-as-directory name))
-	name))))
-
-;;;###autoload
-(defun find-change-log (&optional file-name)
-  "Find a change log file for \\[add-change-log-entry] and return the name.
-
-Optional arg FILE-NAME specifies the file to use.
-If FILE-NAME is nil, use the value of `change-log-default-name'.
-If 'change-log-default-name' is nil, behave as though it were 'ChangeLog'
-\(or whatever we use on this operating system).
-
-If 'change-log-default-name' contains a leading directory component, then
-simply find it in the current directory.  Otherwise, search in the current 
-directory and its successive parents for a file so named.
-
-Once a file is found, `change-log-default-name' is set locally in the
-current buffer to the complete file name."
-  ;; If user specified a file name or if this buffer knows which one to use,
-  ;; just use that.
-  (or file-name
-      (setq file-name (and change-log-default-name
-			   (file-name-directory change-log-default-name)
-			   change-log-default-name))
-      (progn
-	;; Chase links in the source file
-	;; and use the change log in the dir where it points.
-	(setq file-name (or (and buffer-file-name
-				 (file-name-directory
-				  (file-chase-links buffer-file-name)))
-			    default-directory))
-	(if (file-directory-p file-name)
-	    (setq file-name (expand-file-name (change-log-name) file-name)))
-	;; Chase links before visiting the file.
-	;; This makes it easier to use a single change log file
-	;; for several related directories.
-	(setq file-name (file-chase-links file-name))
-	(setq file-name (expand-file-name file-name))
-	;; Move up in the dir hierarchy till we find a change log file.
-	(let ((file1 file-name)
-	      parent-dir)
-	  (while (and (not (or (get-file-buffer file1) (file-exists-p file1)))
-		      (progn (setq parent-dir
-				   (file-name-directory
-				    (directory-file-name
-				     (file-name-directory file1))))
-			     ;; Give up if we are already at the root dir.
-			     (not (string= (file-name-directory file1)
-					   parent-dir))))
-	    ;; Move up to the parent dir and try again.
-	    (setq file1 (expand-file-name 
-			 (file-name-nondirectory (change-log-name))
-			 parent-dir)))
-	  ;; If we found a change log in a parent, use that.
-	  (if (or (get-file-buffer file1) (file-exists-p file1))
-	      (setq file-name file1)))))
-  ;; Make a local variable in this buffer so we needn't search again.
-  (set (make-local-variable 'change-log-default-name) file-name)
-  file-name)
-
-;;;###autoload
-(defun add-change-log-entry (&optional whoami file-name other-window new-entry)
-  "Find change log file and add an entry for today.
-Optional arg (interactive prefix) non-nil means prompt for user name and site.
-Second arg is file name of change log.  If nil, uses `change-log-default-name'.
-Third arg OTHER-WINDOW non-nil means visit in other window.
-Fourth arg NEW-ENTRY non-nil means always create a new entry at the front;
-never append to an existing entry.  Today's date is calculated according to
-`change-log-time-zone-rule' if non-nil, otherwise in local time."
-  (interactive (list current-prefix-arg
-		     (prompt-for-change-log-name)))
-  (or add-log-full-name
-      (setq add-log-full-name (user-full-name)))
-  (or add-log-mailing-address
-      (setq add-log-mailing-address user-mail-address))
-  (if whoami
-      (progn
-	(setq add-log-full-name (read-input "Full name: " add-log-full-name))
-	 ;; Note that some sites have room and phone number fields in
-	 ;; full name which look silly when inserted.  Rather than do
-	 ;; anything about that here, let user give prefix argument so that
-	 ;; s/he can edit the full name field in prompter if s/he wants.
-	(setq add-log-mailing-address
-	      (read-input "Mailing address: " add-log-mailing-address))))
-  (let ((defun (funcall (or add-log-current-defun-function
-			    'add-log-current-defun)))
-	paragraph-end entry)
-
-    (setq file-name (expand-file-name (find-change-log file-name)))
-
-    ;; Set ENTRY to the file name to use in the new entry.
-    (and buffer-file-name
-	 ;; Never want to add a change log entry for the ChangeLog file itself.
-	 (not (string= buffer-file-name file-name))
-	 (setq entry (if (string-match
-			  (concat "^" (regexp-quote (file-name-directory
-						     file-name)))
-			  buffer-file-name)
-			 (substring buffer-file-name (match-end 0))
-		       (file-name-nondirectory buffer-file-name))))
-
-    (if (and other-window (not (equal file-name buffer-file-name)))
-	(find-file-other-window file-name)
-      (find-file file-name))
-    (or (eq major-mode 'change-log-mode)
-	(change-log-mode))
-    (undo-boundary)
-    (goto-char (point-min))
-    (let ((new-entry (concat (if change-log-time-zone-rule
-				 (let ((tz (getenv "TZ"))
-				       (now (current-time)))
-				   (unwind-protect
-				       (progn
-					 (set-time-zone-rule
-					  change-log-time-zone-rule)
-					 (concat 
-					  (format-time-string "%Y-%m-%d " now)
-					  (iso8601-time-zone now)))
-				     (set-time-zone-rule tz)))
-			       (format-time-string "%Y-%m-%d"))
-			     "  " add-log-full-name
-			     "  <" add-log-mailing-address ">")))
-      (if (looking-at (regexp-quote new-entry))
-	  (forward-line 1)
-	(insert new-entry "\n\n")))
-
-    ;; Search only within the first paragraph.
-    (if (looking-at "\n*[^\n* \t]")
-	(skip-chars-forward "\n")
-      (forward-paragraph 1))
-    (setq paragraph-end (point))
-    (goto-char (point-min))
-
-    ;; Now insert the new line for this entry.
-    (cond ((re-search-forward "^\\s *\\*\\s *$" paragraph-end t)
-	   ;; Put this file name into the existing empty entry.
-	   (if entry
-	       (insert entry)))
-	  ((and (not new-entry)
-		(let (case-fold-search)
-		  (re-search-forward
-		   (concat (regexp-quote (concat "* " entry))
-			   ;; Don't accept `foo.bar' when
-			   ;; looking for `foo':
-			   "\\(\\s \\|[(),:]\\)")
-		   paragraph-end t)))
-	   ;; Add to the existing entry for the same file.
-	   (re-search-forward "^\\s *$\\|^\\s \\*")
-	   (goto-char (match-beginning 0))
-	   ;; Delete excess empty lines; make just 2.
-	   (while (and (not (eobp)) (looking-at "^\\s *$"))
-	     (delete-region (point) (save-excursion (forward-line 1) (point))))
-	   (insert "\n\n")
-	   (forward-line -2)
-	   (indent-relative-maybe))
-	  (t
-	   ;; Make a new entry.
-	   (forward-line 1)
-	   (while (looking-at "\\sW")
-	     (forward-line 1))
-	   (while (and (not (eobp)) (looking-at "^\\s *$"))
-	     (delete-region (point) (save-excursion (forward-line 1) (point))))
-	   (insert "\n\n\n")
-	   (forward-line -2)
-	   (indent-to left-margin)
-	   (insert "* " (or entry ""))))
-    ;; Now insert the function name, if we have one.
-    ;; Point is at the entry for this file,
-    ;; either at the end of the line or at the first blank line.
-    (if defun
-	(progn
-	  ;; Make it easy to get rid of the function name.
-	  (undo-boundary)
-	  (insert (if (save-excursion
-			(beginning-of-line 1)
-			(looking-at "\\s *$")) 
-		      ""
-		    " ")
-		  "(" defun "): "))
-      ;; No function name, so put in a colon unless we have just a star.
-      (if (not (save-excursion
-		 (beginning-of-line 1)
-		 (looking-at "\\s *\\(\\*\\s *\\)?$")))
-	  (insert ": ")))))
-
-;;;###autoload
-(defun add-change-log-entry-other-window (&optional whoami file-name)
-  "Find change log file in other window and add an entry for today.
-Optional arg (interactive prefix) non-nil means prompt for user name and site.
-Second arg is file name of change log.  \
-If nil, uses `change-log-default-name'."
-  (interactive (if current-prefix-arg
-		   (list current-prefix-arg
-			 (prompt-for-change-log-name))))
-  (add-change-log-entry whoami file-name t))
-;;;###autoload (define-key ctl-x-4-map "a" 'add-change-log-entry-other-window)
-
-;;;###autoload
-(defun change-log-mode ()
-  "Major mode for editing change logs; like Indented Text Mode.
-Prevents numeric backups and sets `left-margin' to 8 and `fill-column' to 74.
-New log entries are usually made with \\[add-change-log-entry] or \\[add-change-log-entry-other-window].
-Each entry behaves as a paragraph, and the entries for one day as a page.
-Runs `change-log-mode-hook'."
-  (interactive)
-  (kill-all-local-variables)
-  (indented-text-mode)
-  (setq major-mode 'change-log-mode
-	mode-name "Change Log"
-	left-margin 8
-	fill-column 74
-	indent-tabs-mode t
-	tab-width 8)
-  (use-local-map change-log-mode-map)
-  (set (make-local-variable 'fill-paragraph-function)
-       'change-log-fill-paragraph)
-  ;; Let each entry behave as one paragraph:
-  ;; We really do want "^" in paragraph-start below: it is only the lines that
-  ;; begin at column 0 (despite the left-margin of 8) that we are looking for.
-  (set (make-local-variable 'paragraph-start) "\\s *$\\|\f\\|^\\<")
-  (set (make-local-variable 'paragraph-separate) "\\s *$\\|\f\\|^\\<")
-  ;; Let all entries for one day behave as one page.
-  ;; Match null string on the date-line so that the date-line
-  ;; is grouped with what follows.
-  (set (make-local-variable 'page-delimiter) "^\\<\\|^\f")
-  (set (make-local-variable 'version-control) 'never)
-  (set (make-local-variable 'adaptive-fill-regexp) "\\s *")
-  (set (make-local-variable 'font-lock-defaults)
-       '(change-log-font-lock-keywords t))
-  (run-hooks 'change-log-mode-hook))
-
-;; It might be nice to have a general feature to replace this.  The idea I
-;; have is a variable giving a regexp matching text which should not be
-;; moved from bol by filling.  change-log-mode would set this to "^\\s *\\s(".
-;; But I don't feel up to implementing that today.
-(defun change-log-fill-paragraph (&optional justify)
-  "Fill the paragraph, but preserve open parentheses at beginning of lines.
-Prefix arg means justify as well."
-  (interactive "P")
-  (let ((end (progn (forward-paragraph) (point)))
-	(beg (progn (backward-paragraph) (point)))
-	(paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
-    (fill-region beg end justify)
-    t))
-
-(defvar add-log-current-defun-header-regexp
-  "^\\([A-Z][A-Z_ ]*[A-Z_]\\|[-_a-zA-Z]+\\)[ \t]*[:=]"
-  "*Heuristic regexp used by `add-log-current-defun' for unknown major modes.")
-
-;;;###autoload
-(defun add-log-current-defun ()
-  "Return name of function definition point is in, or nil.
-
-Understands C, Lisp, LaTeX (\"functions\" are chapters, sections, ...),
-Texinfo (@node titles), Perl, and Fortran.
-
-Other modes are handled by a heuristic that looks in the 10K before
-point for uppercase headings starting in the first column or
-identifiers followed by `:' or `=', see variable
-`add-log-current-defun-header-regexp'.
-
-Has a preference of looking backwards."
-  (condition-case nil
-      (save-excursion
-	(let ((location (point)))
-	  (cond ((memq major-mode '(emacs-lisp-mode lisp-mode scheme-mode
-						    lisp-interaction-mode))
-		 ;; If we are now precisely at the beginning of a defun,
-		 ;; make sure beginning-of-defun finds that one
-		 ;; rather than the previous one.
-		 (or (eobp) (forward-char 1))
-		 (beginning-of-defun)
-		 ;; Make sure we are really inside the defun found, not after it.
-		 (if (and (looking-at "\\s(")
-			  (progn (end-of-defun)
-				 (< location (point)))
-			  (progn (forward-sexp -1)
-				 (>= location (point))))
-		     (progn
-		       (if (looking-at "\\s(")
-			   (forward-char 1))
-		       (forward-sexp 1)
-		       (skip-chars-forward " '")
-		       (buffer-substring (point)
-					 (progn (forward-sexp 1) (point))))))
-		((and (memq major-mode '(c-mode c++-mode c++-c-mode objc-mode))
-		      (save-excursion (beginning-of-line)
-				      ;; Use eq instead of = here to avoid
-				      ;; error when at bob and char-after
-				      ;; returns nil.
-				      (while (eq (char-after (- (point) 2)) ?\\)
-					(forward-line -1))
-				      (looking-at "[ \t]*#[ \t]*define[ \t]")))
-		 ;; Handle a C macro definition.
-		 (beginning-of-line)
-		 (while (eq (char-after (- (point) 2)) ?\\) ;not =; note above
-		   (forward-line -1))
-		 (search-forward "define")
-		 (skip-chars-forward " \t")
-		 (buffer-substring (point)
-				   (progn (forward-sexp 1) (point))))
-		((memq major-mode '(c-mode c++-mode c++-c-mode objc-mode))
-		 (beginning-of-line)
-		 ;; See if we are in the beginning part of a function,
-		 ;; before the open brace.  If so, advance forward.
-		 (while (not (looking-at "{\\|\\(\\s *$\\)"))
-		   (forward-line 1))
-		 (or (eobp)
-		     (forward-char 1))
-		 (beginning-of-defun)
-		 (if (progn (end-of-defun)
-			    (< location (point)))
-		     (progn
-		       (backward-sexp 1)
-		       (let (beg tem)
-
-			 (forward-line -1)
-			 ;; Skip back over typedefs of arglist.
-			 (while (and (not (bobp))
-				     (looking-at "[ \t\n]"))
-			   (forward-line -1))
-			 ;; See if this is using the DEFUN macro used in Emacs,
-			 ;; or the DEFUN macro used by the C library.
-			 (if (condition-case nil
-				 (and (save-excursion
-					(end-of-line)
-					(while (= (preceding-char) ?\\)
-					  (end-of-line 2))
-					(backward-sexp 1)
-					(beginning-of-line)
-					(setq tem (point))
-					(looking-at "DEFUN\\b"))
-				      (>= location tem))
-			       (error nil))
-			     (progn
-			       (goto-char tem)
-			       (down-list 1)
-			       (if (= (char-after (point)) ?\")
-				   (progn
-				     (forward-sexp 1)
-				     (skip-chars-forward " ,")))
-			       (buffer-substring (point)
-						 (progn (forward-sexp 1) (point))))
-                           (if (looking-at "^[+-]")
-                               (get-method-definition)
-                             ;; Ordinary C function syntax.
-                             (setq beg (point))
-                             (if (and (condition-case nil
-					  ;; Protect against "Unbalanced parens" error.
-					  (progn
-					    (down-list 1) ; into arglist
-					    (backward-up-list 1)
-					    (skip-chars-backward " \t")
-					    t)
-					(error nil))
-				      ;; Verify initial pos was after
-				      ;; real start of function.
-				      (save-excursion
-					(goto-char beg)
-					;; For this purpose, include the line
-					;; that has the decl keywords.  This
-					;; may also include some of the
-					;; comments before the function.
-					(while (and (not (bobp))
-						    (save-excursion
-						      (forward-line -1)
-						      (looking-at "[^\n\f]")))
-					  (forward-line -1))
-					(>= location (point)))
-                                          ;; Consistency check: going down and up
-                                          ;; shouldn't take us back before BEG.
-                                          (> (point) beg))
-				 (let (end middle)
-				   ;; Don't include any final newline
-				   ;; in the name we use.
-				   (if (= (preceding-char) ?\n)
-				       (forward-char -1))
-				   (setq end (point))
-				   (backward-sexp 1)
-				   ;; Now find the right beginning of the name.
-				   ;; Include certain keywords if they
-				   ;; precede the name.
-				   (setq middle (point))
-				   (forward-word -1)
-				   ;; Ignore these subparts of a class decl
-				   ;; and move back to the class name itself.
-				   (while (looking-at "public \\|private ")
-				     (skip-chars-backward " \t:")
-				     (setq end (point))
-				     (backward-sexp 1)
-				     (setq middle (point))
-				     (forward-word -1))
-				   (and (bolp)
-					(looking-at "struct \\|union \\|class ")
-					(setq middle (point)))
-				   (buffer-substring middle end)))))))))
-		((memq major-mode
-		       '(TeX-mode plain-TeX-mode LaTeX-mode;; tex-mode.el
-				  plain-tex-mode latex-mode;; cmutex.el
-				  ))
-		 (if (re-search-backward
-		      "\\\\\\(sub\\)*\\(section\\|paragraph\\|chapter\\)" nil t)
-		     (progn
-		       (goto-char (match-beginning 0))
-		       (buffer-substring (1+ (point));; without initial backslash
-					 (progn
-					   (end-of-line)
-					   (point))))))
-		((eq major-mode 'texinfo-mode)
-		 (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t)
-		     (buffer-substring (match-beginning 1)
-				       (match-end 1))))
-		((eq major-mode 'perl-mode)
-		 (if (re-search-backward "^sub[ \t]+\\([^ \t\n]+\\)" nil t)
-		     (buffer-substring (match-beginning 1)
-				       (match-end 1))))
-                ((eq major-mode 'fortran-mode)
-                 ;; must be inside function body for this to work
-                 (beginning-of-fortran-subprogram)
-                 (let ((case-fold-search t)) ; case-insensitive
-                   ;; search for fortran subprogram start
-                   (if (re-search-forward
-			 "^[ \t]*\\(program\\|subroutine\\|function\
-\\|[ \ta-z0-9*]*[ \t]+function\\)"
-			 nil t)
-                       (progn
-                         ;; move to EOL or before first left paren
-                         (if (re-search-forward "[(\n]" nil t)
-			     (progn (forward-char -1)
-				    (skip-chars-backward " \t"))
-			   (end-of-line))
-			 ;; Use the name preceding that.
-                         (buffer-substring (point)
-                                           (progn (forward-sexp -1)
-                                                  (point)))))))
-		(t
-		 ;; If all else fails, try heuristics
-		 (let (case-fold-search)
-		   (end-of-line)
-		   (if (re-search-backward add-log-current-defun-header-regexp
-					   (- (point) 10000)
-					   t)
-		       (buffer-substring (match-beginning 1)
-					 (match-end 1))))))))
-    (error nil)))
-
-(defvar get-method-definition-md)
-
-;; Subroutine used within get-method-definition.
-;; Add the last match in the buffer to the end of `md',
-;; followed by the string END; move to the end of that match.
-(defun get-method-definition-1 (end)
-  (setq get-method-definition-md
-	(concat get-method-definition-md 
-		(buffer-substring (match-beginning 1) (match-end 1))
-		end))
-  (goto-char (match-end 0)))
-
-;; For objective C, return the method name if we are in a method.
-(defun get-method-definition ()
-  (let ((get-method-definition-md "["))
-    (save-excursion
-      (if (re-search-backward "^@implementation\\s-*\\([A-Za-z_]*\\)" nil t)
-	  (get-method-definition-1 " ")))
-    (save-excursion
-      (cond
-       ((re-search-forward "^\\([-+]\\)[ \t\n\f\r]*\\(([^)]*)\\)?\\s-*" nil t)
-	(get-method-definition-1 "")
-	(while (not (looking-at "[{;]"))
-	  (looking-at
-	   "\\([A-Za-z_]*:?\\)\\s-*\\(([^)]*)\\)?[A-Za-z_]*[ \t\n\f\r]*")
-	  (get-method-definition-1 ""))
-	(concat get-method-definition-md "]"))))))
-
-
-(provide 'add-log)
-
-;;; add-log.el ends here
diff --git a/lisp/allout.el b/lisp/allout.el
deleted file mode 100644
index a38b9fca4c2..00000000000
--- a/lisp/allout.el
+++ /dev/null
@@ -1,4339 +0,0 @@
-;;; allout.el --- Extensive outline mode for use alone and with other modes.
-
-;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Ken Manheimer <klm@nist.gov>
-;; Maintainer: Ken Manheimer <klm@nist.gov>
-;; Created: Dec 1991 - first release to usenet
-;; Version: Id: allout.el,v 4.3 1994/05/12 17:43:08 klm Exp ||
-;; Keywords: outline mode
-
-;; 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:
-
-;; Allout outline mode provides extensive outline formatting and
-;; manipulation capabilities, subsuming and well beyond that of
-;; standard emacs outline mode.  It is specifically aimed at
-;; supporting outline structuring and manipulation of syntax-
-;; sensitive text, eg programming languages.  (For an example, see the
-;; allout code itself, which is organized in outline structure.)
-;;
-;; It also includes such things as topic-oriented repositioning, cut, and
-;; paste; integral outline exposure-layout; incremental search with
-;; dynamic exposure/concealment of concealed text; automatic topic-number
-;; maintenance; and many other features.
-;;
-;; See the docstring of the variables `outline-layout' and
-;; `outline-auto-activation' for details on automatic activation of
-;; allout outline-mode as a minor mode.  (It has changed since allout
-;; 3.x, for those of you that depend on the old method.)
-;;
-;; Note - the lines beginning with `;;;_' are outline topic headers.
-;;        Just `ESC-x eval-current-buffer' to give it a whirl.
-
-;;Ken Manheimer	      				   301 975-3539
-;;ken.manheimer@nist.gov			   FAX: 301 963-9137
-;;
-;;Computer Systems and Communications Division
-;;
-;;		Nat'l Institute of Standards and Technology
-;;		Technology A151
-;;		Gaithersburg, MD 20899
-
-;;;_* Provide
-(provide 'outline)
-(provide 'allout)
-
-;;;_* USER CUSTOMIZATION VARIABLES:
-
-;;;_ + Layout, Mode, and Topic Header Configuration
-
-;;;_  = outline-auto-activation
-(defvar outline-auto-activation nil
-  "*Regulates auto-activation modality of allout outlines - see `outline-init'.
-
-Setq-default by `outline-init' to regulate whether or not allout
-outline mode is automatically activated when the buffer-specific
-variable `outline-layout' is non-nil, and whether or not the layout
-dictated by `outline-layout' should be imposed on mode activation.
-
-With value `t', auto-mode-activation and auto-layout are enabled.
-\(This also depends on `outline-find-file-hooks' being installed in
-`find-file-hooks', which is also done by `outline-init'.)
-
-With value `ask', auto-mode-activation is enabled, and endorsement for
-performing auto-layout is asked of the user each time.
-
-With value `activate', only auto-mode-activation is enabled,
-auto-layout is not.
-
-With value `nil', neither auto-mode-activation nor auto-layout are
-enabled.
-
-See the docstring for `outline-init' for the proper interface to
-this variable.")
-;;;_  = outline-layout
-(defvar outline-layout nil
-  "*Layout specification and provisional mode trigger for allout outlines.
-
-Buffer-specific.
-
-A list value specifies a default layout for the current buffer, to be
-applied upon activation of allout outline-mode.  Any non-nil value will
-automatically trigger allout outline-mode, provided `outline-init'
-has been called to enable it.
-
-See the docstring for `outline-init' for details on setting up for
-auto-mode-activation, and for `outline-expose-topic' for the format of
-the layout specification.
-
-You can associate a particular outline layout with a file by setting
-this var via the file's local variables.  For example, the following
-lines at the bottom of an Emacs Lisp file:
-
-;;;Local variables:
-;;;outline-layout: \(0 : -1 -1 0\)
-;;;End:
-
-will, modulo the above-mentioned conditions, cause the mode to be
-activated when the file is visited, followed by the equivalent of
-`\(outline-expose-topic 0 : -1 -1 0\)'.  \(This is the layout used for
-the allout.el, itself.)
-
-Also, allout's mode-specific provisions will make topic prefixes default
-to the comment-start string, if any, of the language of the file.  This
-is modulo the setting of `outline-use-mode-specific-leader', which see.")
-(make-variable-buffer-local 'outline-layout)
-
-;;;_  = outline-header-prefix
-(defvar outline-header-prefix "."
-  "*Leading string which helps distinguish topic headers.
-
-Outline topic header lines are identified by a leading topic
-header prefix, which mostly have the value of this var at their front.
-\(Level 1 topics are exceptions.  They consist of only a single
-character, which is typically set to the outline-primary-bullet.  Many
-outlines start at level 2 to avoid this discrepancy.")
-(make-variable-buffer-local 'outline-header-prefix)
-;;;_  = outline-primary-bullet
-(defvar outline-primary-bullet "*"
-  "Bullet used for top-level outline topics.
-
-Outline topic header lines are identified by a leading topic header
-prefix, which is concluded by bullets that includes the value of this
-var and the respective outline-*-bullets-string vars.
-
-The value of an asterisk (`*') provides for backwards compatibility
-with the original emacs outline mode.  See outline-plain-bullets-string
-and outline-distinctive-bullets-string for the range of available
-bullets.")
-(make-variable-buffer-local 'outline-primary-bullet)
-;;;_  = outline-plain-bullets-string
-(defvar outline-plain-bullets-string (concat outline-primary-bullet
-					     "+-:.;,")
-  "*The bullets normally used in outline topic prefixes.
-
-See `outline-distinctive-bullets-string' for the other kind of
-bullets.
-
-DO NOT include the close-square-bracket, `]', as a bullet.
-
-Outline mode has to be reactivated in order for changes to the value
-of this var to take effect.")
-(make-variable-buffer-local 'outline-plain-bullets-string)
-;;;_  = outline-distinctive-bullets-string
-(defvar outline-distinctive-bullets-string "=>([{}&!?#%\"X@$~\\"
-  "*Persistent outline header bullets used to distinguish special topics.
-
-These bullets are not offered among the regular, level-specific
-rotation, and are not altered by automatic rebulleting, as when
-shifting the level of a topic.  See `outline-plain-bullets-string' for
-the selection of alternating bullets.
-
-You must run `set-outline-regexp' in order for changes
-to the value of this var to effect outline-mode operation.
-
-DO NOT include the close-square-bracket, `]', on either of the bullet
-strings.")
-(make-variable-buffer-local 'outline-distinctive-bullets-string)
-
-;;;_  = outline-use-mode-specific-leader
-(defvar outline-use-mode-specific-leader t
-  "*When non-nil, use mode-specific topic-header prefixes.
-
-Allout outline mode will use the mode-specific `outline-mode-leaders'
-and/or comment-start string, if any, to lead the topic prefix string,
-so topic headers look like comments in the programming language.
-
-String values are used as they stand.
-
-Value `t' means to first check for assoc value in `outline-mode-leaders'
-alist, then use comment-start string, if any, then use default \(`.').
-\(See note about use of comment-start strings, below.\)
-
-Set to the symbol for either of `outline-mode-leaders' or
-`comment-start' to use only one of them, respectively.
-
-Value `nil' means to always use the default \(`.'\).
-
-comment-start strings that do not end in spaces are tripled, and an
-`_' underscore is tacked on the end, to distinguish them from regular
-comment strings.  comment-start strings that do end in spaces are not
-tripled, but an underscore is substituted for the space.  [This
-presumes that the space is for appearance, not comment syntax.  You
-can use `outline-mode-leaders' to override this behavior, when
-incorrect.]")
-;;;_  = outline-mode-leaders
-(defvar outline-mode-leaders '()
-  "Specific outline-prefix leading strings per major modes.
-
-Entries will be used in the stead (or lieu) of mode-specific
-comment-start strings.  See also `outline-use-mode-specific-leader'.
-
-If you're constructing a string that will comment-out outline
-structuring so it can be included in program code, append an extra
-character, like an \"_\" underscore, to distinguish the lead string
-from regular comments that start at bol.")
-
-;;;_  = outline-old-style-prefixes
-(defvar outline-old-style-prefixes nil
-  "*When non-nil, use only old-and-crusty outline-mode `*' topic prefixes.
-
-Non-nil restricts the topic creation and modification
-functions to asterix-padded prefixes, so they look exactly
-like the original emacs-outline style prefixes.
-
-Whatever the setting of this variable, both old and new style prefixes
-are always respected by the topic maneuvering functions.")
-(make-variable-buffer-local 'outline-old-style-prefixes)
-;;;_  = outline-stylish-prefixes - alternating bullets
-(defvar outline-stylish-prefixes t
-  "*Do fancy stuff with topic prefix bullets according to level, etc.
-
-Non-nil enables topic creation, modification, and repositioning
-functions to vary the topic bullet char (the char that marks the topic
-depth) just preceding the start of the topic text) according to level.
-Otherwise, only asterisks (`*') and distinctive bullets are used.
-
-This is how an outline can look (but sans indentation) with stylish
-prefixes:
-
-    * Top level
-    .* A topic
-    . + One level 3 subtopic
-    .  . One level 4 subtopic
-    .  . A second 4 subtopic
-    . + Another level 3 subtopic
-    .  #1 A numbered level 4 subtopic
-    .  #2 Another
-    .  ! Another level 4 subtopic with a different distinctive bullet
-    .  #4 And another numbered level 4 subtopic
-
-This would be an outline with stylish prefixes inhibited (but the
-numbered and other distinctive bullets retained):
-
-    * Top level
-    .* A topic
-    . * One level 3 subtopic
-    .  * One level 4 subtopic
-    .  * A second 4 subtopic
-    . * Another level 3 subtopic
-    .  #1 A numbered level 4 subtopic
-    .  #2 Another
-    .  ! Another level 4 subtopic with a different distinctive bullet
-    .  #4 And another numbered level 4 subtopic
-
-Stylish and constant prefixes (as well as old-style prefixes) are
-always respected by the topic maneuvering functions, regardless of
-this variable setting.
-
-The setting of this var is not relevant when outline-old-style-prefixes
-is non-nil.")
-(make-variable-buffer-local 'outline-stylish-prefixes)
-
-;;;_  = outline-numbered-bullet
-(defvar outline-numbered-bullet "#"
-  "*String designating bullet of topics that have auto-numbering; nil for none.
-
-Topics having this bullet have automatic maintenance of a sibling
-sequence-number tacked on, just after the bullet.  Conventionally set
-to \"#\", you can set it to a bullet of your choice.  A nil value
-disables numbering maintenance.")
-(make-variable-buffer-local 'outline-numbered-bullet)
-;;;_  = outline-file-xref-bullet
-(defvar outline-file-xref-bullet "@"
-  "*Bullet signifying file cross-references, for `outline-resolve-xref'.
-
-Set this var to the bullet you want to use for file cross-references.
-Set it to nil if you want to inhibit this capability.")
-
-;;;_ + LaTeX formatting
-;;;_  - outline-number-pages
-(defvar outline-number-pages nil
-  "*Non-nil turns on page numbering for LaTeX formatting of an outline.")
-;;;_  - outline-label-style
-(defvar outline-label-style "\\large\\bf"
-  "*Font and size of labels for LaTeX formatting of an outline.")
-;;;_  - outline-head-line-style
-(defvar outline-head-line-style "\\large\\sl "
-  "*Font and size of entries for LaTeX formatting of an outline.")
-;;;_  - outline-body-line-style
-(defvar outline-body-line-style " "
-  "*Font and size of entries for LaTeX formatting of an outline.")
-;;;_  - outline-title-style
-(defvar outline-title-style "\\Large\\bf"
-  "*Font and size of titles for LaTeX formatting of an outline.")
-;;;_  - outline-title
-(defvar outline-title '(or buffer-file-name (current-buffer-name))
-  "*Expression to be evaluated to determine the title for LaTeX
-formatted copy.")
-;;;_  - outline-line-skip
-(defvar outline-line-skip ".05cm"
-  "*Space between lines for LaTeX formatting of an outline.")
-;;;_  - outline-indent
-(defvar outline-indent ".3cm"
-  "*LaTeX formatted depth-indent spacing.")
-
-;;;_ + Miscellaneous customization
-
-;;;_  = outline-keybindings-list
-;;; You have to reactivate outline-mode - `(outline-mode t)' - to
-;;; institute changes to this var.
-(defvar outline-keybindings-list ()
-  "*List of outline-mode key / function bindings.
-
-These bindings will be locally bound on the outline-mode-map.  The
-keys will be prefixed by outline-command-prefix, unless the cell
-contains a third, no-nil element, in which case the initial string
-will be used as is.")
-(setq outline-keybindings-list
-      '(
-                                        ; Motion commands:
-        ("?t" outline-latexify-exposed)
-        ("\C-n" outline-next-visible-heading)
-        ("\C-p" outline-previous-visible-heading)
-        ("\C-u" outline-up-current-level)
-        ("\C-f" outline-forward-current-level)
-        ("\C-b" outline-backward-current-level)
-        ("\C-a" outline-beginning-of-current-entry)
-        ("\C-e" outline-end-of-current-entry)
-	;;("\C-n" outline-next-line-or-topic)
-	;;("\C-p" outline-previous-line-or-topic)
-                                        ; Exposure commands:
-        ("\C-i" outline-show-children)
-        ("\C-s" outline-show-current-subtree)
-        ("\C-h" outline-hide-current-subtree)
-        ("\C-o" outline-show-current-entry)
-        ("!" outline-show-all)
-                                        ; Alteration commands:
-        (" " outline-open-sibtopic)
-        ("." outline-open-subtopic)
-        ("," outline-open-supertopic)
-        ("'" outline-shift-in)
-        (">" outline-shift-in)
-        ("<" outline-shift-out)
-        ("\C-m" outline-rebullet-topic)
-        ("*" outline-rebullet-current-heading)
-        ("#" outline-number-siblings)
-        ("\C-k" outline-kill-line t)
-        ("\C-y" outline-yank t)
-        ("\M-y" outline-yank-pop t)
-        ("\C-k" outline-kill-topic)
-                                        ; Miscellaneous commands:
-	("\C-@" outline-mark-topic)
-        ("@" outline-resolve-xref)
-        ("?c" outline-copy-exposed)))
-
-;;;_  = outline-command-prefix
-(defvar outline-command-prefix "\C-c"
-  "*Key sequence to be used as prefix for outline mode command key bindings.")
-
-;;;_  = outline-enwrap-isearch-mode
-(defvar outline-enwrap-isearch-mode t
-  "*Set non-nil to enable automatic exposure of concealed isearch targets.
-
-If non-nil, isearch will expose hidden text encountered in the course
-of a search, and to reconceal it if the search is continued past it.")
-
-;;;_  = outline-use-hanging-indents
-(defvar outline-use-hanging-indents t
-  "*If non-nil, topic body text auto-indent defaults to indent of the header.
-Ie, it is indented to be just past the header prefix.  This is
-relevant mostly for use with indented-text-mode, or other situations
-where auto-fill occurs.
-
-\[This feature no longer depends in any way on the `filladapt.el'
-lisp-archive package.\]")
-(make-variable-buffer-local 'outline-use-hanging-indents)
-
-;;;_  = outline-reindent-bodies
-(defvar outline-reindent-bodies (if outline-use-hanging-indents
-				    'text)
-  "*Non-nil enables auto-adjust of topic body hanging indent with depth shifts.
-
-When active, topic body lines that are indented even with or beyond
-their topic header are reindented to correspond with depth shifts of
-the header.
-
-A value of `t' enables reindent in non-programming-code buffers, ie
-those that do not have the variable `comment-start' set.  A value of
-`force' enables reindent whether or not `comment-start' is set.")
-
-(make-variable-buffer-local 'outline-reindent-bodies)
-
-;;;_  = outline-inhibit-protection
-(defvar outline-inhibit-protection nil
-  "*Non-nil disables warnings and confirmation-checks for concealed-text edits.
-
-Outline mode uses emacs change-triggered functions to detect unruly
-changes to concealed regions.  Set this var non-nil to disable the
-protection, potentially increasing text-entry responsiveness a bit.
-
-This var takes effect at outline-mode activation, so you may have to
-deactivate and then reactivate the mode if you want to toggle the
-behavior.")
-
-;;;_* CODE - no user customizations below.
-
-;;;_ #1  Internal Outline Formatting and Configuration
-;;;_  - Version
-;;;_   = outline-version
-(defvar outline-version
-  (let ((rcs-rev "Revision: 4.3"))
-    (condition-case err
-	(save-match-data
-	  (string-match "Revision: \\([0-9]+\\.[0-9]+\\)" rcs-rev)
-	  (substring rcs-rev (match-beginning 1) (match-end 1)))
-      (error rcs-rev)))
-  "Revision number of currently loaded outline package.  \(allout.el)")
-;;;_   > outline-version
-(defun outline-version (&optional here)
-  "Return string describing the loaded outline version."
-  (interactive "P")
-  (let ((msg (concat "Allout Outline Mode v " outline-version)))
-    (if here (insert-string msg))
-    (message "%s" msg)
-    msg))
-;;;_  - Topic header format
-;;;_   = outline-regexp
-(defvar outline-regexp ""
-  "*Regular expression to match the beginning of a heading line.
-
-Any line whose beginning matches this regexp is considered a
-heading.  This var is set according to the user configuration vars
-by set-outline-regexp.")
-(make-variable-buffer-local 'outline-regexp)
-;;;_   = outline-bullets-string
-(defvar outline-bullets-string ""
-  "A string dictating the valid set of outline topic bullets.
-
-This var should *not* be set by the user - it is set by `set-outline-regexp',
-and is produced from the elements of `outline-plain-bullets-string'
-and `outline-distinctive-bullets-string'.")
-(make-variable-buffer-local 'outline-bullets-string)
-;;;_   = outline-bullets-string-len
-(defvar outline-bullets-string-len 0
-  "Length of current buffers' outline-plain-bullets-string.")
-(make-variable-buffer-local 'outline-bullets-string-len)
-;;;_   = outline-line-boundary-regexp
-(defvar outline-line-boundary-regexp ()
-  "Outline-regexp with outline-style beginning-of-line anchor.
-
-\(Ie, C-j, *or* C-m, for prefixes of hidden topics).  This is properly
-set when outline-regexp is produced by `set-outline-regexp', so
-that (match-beginning 2) and (match-end 2) delimit the prefix.")
-(make-variable-buffer-local 'outline-line-boundary-regexp)
-;;;_   = outline-bob-regexp
-(defvar outline-bob-regexp ()
-  "Like outline-line-boundary-regexp, for headers at beginning of buffer.
-\(match-beginning 2) and (match-end 2) delimit the prefix.")
-(make-variable-buffer-local 'outline-bob-regexp)
-;;;_   = outline-header-subtraction
-(defvar outline-header-subtraction (1- (length outline-header-prefix))
-  "Outline-header prefix length to subtract when computing topic depth.")
-(make-variable-buffer-local 'outline-header-subtraction)
-;;;_   = outline-plain-bullets-string-len
-(defvar outline-plain-bullets-string-len (length outline-plain-bullets-string)
-  "Length of outline-plain-bullets-string, updated by set-outline-regexp.")
-(make-variable-buffer-local 'outline-plain-bullets-string-len)
-
-
-;;;_   X outline-reset-header-lead (header-lead)
-(defun outline-reset-header-lead (header-lead)
-  "*Reset the leading string used to identify topic headers."
-  (interactive "sNew lead string: ")
-  (setq outline-header-prefix header-lead)
-  (setq outline-header-subtraction (1- (length outline-header-prefix)))
-  (set-outline-regexp))
-;;;_   X outline-lead-with-comment-string (header-lead)
-(defun outline-lead-with-comment-string (&optional header-lead)
-  "*Set the topic-header leading string to specified string.
-
-Useful when for encapsulating outline structure in programming
-language comments.  Returns the leading string."
-
-  (interactive "P")
-  (if (not (stringp header-lead))
-      (setq header-lead (read-string
-                         "String prefix for topic headers: ")))
-  (setq outline-reindent-bodies nil)
-  (outline-reset-header-lead header-lead)
-  header-lead)
-;;;_   > outline-infer-header-lead ()
-(defun outline-infer-header-lead ()
-  "Determine appropriate `outline-header-prefix'.
-
-Works according to settings of:
-
-       `comment-start'
-       `outline-header-prefix' (default)
-       `outline-use-mode-specific-leader'
-and    `outline-mode-leaders'.
-
-Apply this via \(re\)activation of `outline-mode', rather than
-invoking it directly."
-  (let* ((use-leader (and (boundp 'outline-use-mode-specific-leader)
-			  (if (or (stringp outline-use-mode-specific-leader)
-				  (memq outline-use-mode-specific-leader
-					'(outline-mode-leaders
-					  comment-start
-					  t)))
-			      outline-use-mode-specific-leader
-			    ;; Oops - garbled value, equate with effect of 't:
-			    t)))
-	 (leader
-	  (cond
-	   ((not use-leader) nil)
-	   ;; Use the explicitly designated leader:
-	   ((stringp use-leader) use-leader)
-	   (t (or (and (memq use-leader '(t outline-mode-leaders))
-		       ;; Get it from outline mode leaders?
-		       (cdr (assq major-mode outline-mode-leaders)))
-		  ;; ... didn't get from outline-mode-leaders...
-		  (and (memq use-leader '(t comment-start))
-		       comment-start
-		       ;; Use comment-start, maybe tripled, and with
-		       ;; underscore:
-		       (concat
-			(if (string= " "
-				     (substring comment-start
-						(1- (length comment-start))))
-			    ;; Use comment-start, sans trailing space:
-			    (substring comment-start 0 -1)
-			  (concat comment-start comment-start comment-start))
-			;; ... and append underscore, whichever:
-			"_")))))))
-    (if (not leader)
-	nil
-      (if (string= leader outline-header-prefix)
-	  nil				; no change, nothing to do.
-	(setq outline-header-prefix leader)
-	outline-header-prefix))))
-;;;_   > outline-infer-body-reindent ()
-(defun outline-infer-body-reindent ()
-  "Determine proper setting for `outline-reindent-bodies'.
-
-Depends on default setting of `outline-reindent-bodies' \(which see)
-and presence of setting for `comment-start', to tell whether the
-file is programming code."
-  (if (and outline-reindent-bodies
-	   comment-start
-	   (not (eq 'force outline-reindent-bodies)))
-      (setq outline-reindent-bodies nil)))
-;;;_   > set-outline-regexp ()
-(defun set-outline-regexp ()
-  "Generate proper topic-header regexp form for outline functions.
-
-Works with respect to `outline-plain-bullets-string' and
-`outline-distinctive-bullets-string'."
-
-  (interactive)
-  ;; Derive outline-bullets-string from user configured components:
-  (setq outline-bullets-string "")
-  (let ((strings (list 'outline-plain-bullets-string
-                       'outline-distinctive-bullets-string))
-        cur-string
-        cur-len
-        cur-char
-        cur-char-string
-        index
-        new-string)
-    (while strings
-      (setq new-string "") (setq index 0)
-      (setq cur-len (length (setq cur-string (symbol-value (car strings)))))
-      (while (< index cur-len)
-        (setq cur-char (aref cur-string index))
-        (setq outline-bullets-string
-              (concat outline-bullets-string
-                      (cond
-                                        ; Single dash would denote a
-                                        ; sequence, repeated denotes
-                                        ; a dash:
-                       ((eq cur-char ?-) "--")
-                                        ; literal close-square-bracket
-                                        ; doesn't work right in the
-                                        ; expr, exclude it:
-                       ((eq cur-char ?\]) "")
-                       (t (regexp-quote  (char-to-string cur-char))))))
-        (setq index (1+ index)))
-      (setq strings (cdr strings)))
-    )
-  ;; Derive next for repeated use in outline-pending-bullet:
-  (setq outline-plain-bullets-string-len (length outline-plain-bullets-string))
-  (setq outline-header-subtraction (1- (length outline-header-prefix)))
-  ;; Produce the new outline-regexp:
-  (setq outline-regexp (concat "\\(\\"
-                               outline-header-prefix
-                               "[ \t]*["
-                               outline-bullets-string
-                               "]\\)\\|\\"
-                               outline-primary-bullet
-                               "+\\|\^l"))
-  (setq outline-line-boundary-regexp
-        (concat "\\([\n\r]\\)\\(" outline-regexp "\\)"))
-  (setq outline-bob-regexp
-        (concat "\\(\\`\\)\\(" outline-regexp "\\)"))
-  )
-;;;_  - Key bindings
-;;;_   = outline-mode-map
-(defvar outline-mode-map nil "Keybindings for (allout) outline minor mode.")
-;;;_   > produce-outline-mode-map (keymap-alist &optional base-map)
-(defun produce-outline-mode-map (keymap-list &optional base-map)
-  "Produce keymap for use as outline-mode-map, from keymap-list.
-
-Built on top of optional BASE-MAP, or empty sparse map if none specified.
-See doc string for outline-keybindings-list for format of binding list."
-  (let ((map (or base-map (make-sparse-keymap))))
-    (mapcar (lambda (cell)
-	      (apply 'define-key map (if (null (cdr (cdr cell)))
-					 (cons (concat outline-command-prefix
-						       (car cell))
-					       (cdr cell))
-				       (list (car cell) (car (cdr cell))))))
-	    keymap-list)
-    map))
-;;;_   = outline-prior-bindings - being deprecated.
-(defvar outline-prior-bindings nil
-  "Variable for use in V18, with outline-added-bindings, for
-resurrecting, on mode deactivation, bindings that existed before
-activation.  Being deprecated.")
-;;;_   = outline-added-bindings - being deprecated
-(defvar outline-added-bindings nil
-  "Variable for use in V18, with outline-prior-bindings, for
-resurrecting, on mode deactivation, bindings that existed before
-activation.  Being deprecated.")
-;;;_  - Mode-Specific Variable Maintenance Utilities
-;;;_   = outline-mode-prior-settings
-(defvar outline-mode-prior-settings nil
-  "Internal outline mode use; settings to be resumed on mode deactivation.")
-(make-variable-buffer-local 'outline-mode-prior-settings)
-;;;_   > outline-resumptions (name &optional value)
-(defun outline-resumptions (name &optional value)
-
-  "Registers or resumes settings over outline-mode activation/deactivation.
-
-First arg is NAME of variable affected.  Optional second arg is list
-containing outline-mode-specific VALUE to be imposed on named
-variable, and to be registered.  (It's a list so you can specify
-registrations of null values.)  If no value is specified, the
-registered value is returned (encapsulated in the list, so the caller
-can distinguish nil vs no value), and the registration is popped
-from the list."
-
-  (let ((on-list (assq name outline-mode-prior-settings))
-        prior-capsule                   ; By `capsule' i mean a list
-                                        ; containing a value, so we can
-                                        ; distinguish nil from no value.
-        )
-
-    (if value
-
-        ;; Registering:
-        (progn
-          (if on-list
-              nil 	; Already preserved prior value - don't mess with it.
-            ;; Register the old value, or nil if previously unbound:
-            (setq outline-mode-prior-settings
-                  (cons (list name
-                              (if (boundp name) (list (symbol-value name))))
-                        outline-mode-prior-settings)))
-                                        ; And impose the new value, locally:
-	  (progn (make-local-variable name)
-		 (set name (car value))))
-
-      ;; Relinquishing:
-      (if (not on-list)
-
-          ;; Oops, not registered - leave it be:
-          nil
-
-        ;; Some registration:
-                                        ; reestablish it:
-        (setq prior-capsule (car (cdr on-list)))
-        (if prior-capsule
-            (set name (car prior-capsule)) ; Some prior value - reestablish it.
-          (makunbound name))		; Previously unbound - demolish var.
-                                        ; Remove registration:
-        (let (rebuild)
-          (while outline-mode-prior-settings
-            (if (not (eq (car outline-mode-prior-settings)
-                         on-list))
-                (setq rebuild
-                      (cons (car outline-mode-prior-settings)
-                            rebuild)))
-            (setq outline-mode-prior-settings
-                  (cdr outline-mode-prior-settings)))
-          (setq outline-mode-prior-settings rebuild)))))
-  )
-;;;_  - Mode-specific incidentals
-;;;_   = outline-during-write-cue nil
-(defvar outline-during-write-cue nil
-  "Used to inhibit outline change-protection during file write.
-
-See also `outline-post-command-business', `outline-write-file-hook',
-`outline-before-change-protect', and `outline-post-command-business'
-functions.")
-;;;_   = outline-override-protect nil
-(defvar outline-override-protect nil
-  "Used in outline-mode for regulate of concealed-text protection mechanism.
-
-Allout outline mode regulates alteration of concealed text to protect
-against inadvertent, unnoticed changes.  This is for use by specific,
-native outline functions to temporarily override that protection.
-It's automatically reset to nil after every buffer modification.")
-(make-variable-buffer-local 'outline-override-protect)
-;;;_   > outline-unprotected (expr)
-(defmacro outline-unprotected (expr)
-  "Evaluate EXPRESSION with `outline-override-protect' let-bound to t."
-  (` (let ((outline-override-protect t))
-       (, expr))))
-;;;_   = outline-undo-aggregation
-(defvar outline-undo-aggregation 30
-  "Amount of successive self-insert actions to bunch together per undo.
-
-This is purely a kludge variable, regulating the compensation for a bug in
-the way that before-change-function and undo interact.")
-(make-variable-buffer-local 'outline-undo-aggregation)
-;;;_   = file-var-bug hack
-(defvar outline-v18/9-file-var-hack nil
-  "Horrible hack used to prevent invalid multiple triggering of outline
-mode from prop-line file-var activation.  Used by outline-mode function
-to track repeats.")
-;;;_   > outline-write-file-hook ()
-(defun outline-write-file-hook ()
-  "In outline mode, run as a local-write-file-hooks activity.
-
-Currently just sets `outline-during-write-cue', so outline-change-protection
-knows to keep inactive during file write."
-  (setq outline-during-write-cue t)
-  nil)
-
-;;;_ #2 Mode activation
-;;;_  = outline-mode
-(defvar outline-mode () "Allout outline mode minor-mode flag.")
-(make-variable-buffer-local 'outline-mode)
-;;;_  > outline-mode-p ()
-(defmacro outline-mode-p ()
-  "Return t if outline-mode is active in current buffer."
-  'outline-mode)
-;;;_  = outline-explicitly-deactivated
-(defvar outline-explicitly-deactivated nil
-  "Outline-mode was last deliberately deactivated.
-So outline-post-command-business should not reactivate it...")
-(make-variable-buffer-local 'outline-explicitly-deactivated)
-;;;_  > outline-init (&optional mode)
-(defun outline-init (&optional mode)
-  "Prime outline-mode to enable/disable auto-activation, wrt `outline-layout'.
-
-MODE is one of the following symbols:
-
- - nil \(or no argument) deactivate auto-activation/layout;
- - `activate', enable auto-activation only;
- - `ask', enable auto-activation, and enable auto-layout but with
-   confirmation for layout operation solicited from user each time;
- - `report', just report and return the current auto-activation state;
- - anything else \(eg, t) for auto-activation and auto-layout, without
-   any confirmation check.
-
-Use this function to setup your emacs session for automatic activation
-of allout outline mode, contingent to the buffer-specific setting of
-the `outline-layout' variable.  (See `outline-layout' and
-`outline-expose-topic' docstrings for more details on auto layout).
-
-`outline-init' works by setting up (or removing) the outline-mode
-find-file-hook, and giving `outline-auto-activation' a suitable
-setting.
-
-To prime your emacs session for full auto-outline operation, include
-the following two lines in your emacs init file:
-
-\(require 'allout)
-\(outline-init t)"
-
-  (interactive)
-  (if (interactive-p)
-      (progn
-	(setq mode
-	      (completing-read
-	       (concat "Select outline auto setup mode "
-		       "(empty for report, ? for options) ")
-	       '(("nil")("full")("activate")("deactivate")
-		 ("ask") ("report") (""))
-	       nil
-	       t))
-	(if (string= mode "")
-	    (setq mode 'report)
-	  (setq mode (intern-soft mode)))))
-  (let
-      ;; convenience aliases, for consistent ref to respective vars:
-      ((hook 'outline-find-file-hook)
-       (curr-mode 'outline-auto-activation))
-
-    (cond ((not mode)
-	   (setq find-file-hooks (delq hook find-file-hooks))
-	   (if (interactive-p)
-	       (message "Allout outline mode auto-activation inhibited.")))
-	  ((eq mode 'report)
-	   (if (not (memq hook find-file-hooks))
-	       (outline-init nil)
-	     ;; Just punt and use the reports from each of the modes:
-	     (outline-init (symbol-value curr-mode))))
-	  (t (add-hook 'find-file-hooks hook)
-	     (set curr-mode		; `set', not `setq'!
-		  (cond ((eq mode 'activate)
-			 (message
-			  "Outline mode auto-activation enabled.")
-			 'activate)
-			((eq mode 'report)
-			 ;; Return the current mode setting:
-			 (outline-init mode))
-			((eq mode 'ask)
-			 (message
-			  (concat "Outline mode auto-activation and "
-				  "-layout \(upon confirmation) enabled."))
-			 'ask)
-			((message
-			  "Outline mode auto-activation and -layout enabled.")
-			 'full)))))))
-
-;;;_  > outline-mode (&optional toggle)
-;;;_   : Defun:
-(defun outline-mode (&optional toggle)
-;;;_    . Doc string:
-  "Toggle minor mode for controlling exposure and editing of text outlines.
-
-Optional arg forces mode reactivation iff arg is positive num or symbol.
-
-Allout outline mode provides extensive outline formatting and
-manipulation capabilities.  It is specifically aimed at supporting
-outline structuring and manipulation of syntax-sensitive text, eg
-programming languages.  \(For an example, see the allout code itself,
-which is organized in outline structure.\)
-
-It also includes such things as topic-oriented repositioning, cut, and
-paste; integral outline exposure-layout; incremental search with
-dynamic exposure/concealment of concealed text; automatic topic-number
-maintenance; and many other features.
-
-See the docstring of the variable `outline-init' for instructions on
-priming your emacs session for automatic activation of outline-mode,
-according to file-var settings of the `outline-layout' variable.
-
-Below is a description of the bindings, and then explanation of
-special outline-mode features and terminology.
-
-The bindings themselves are established according to the values of
-variables `outline-keybindings-list' and `outline-command-prefix',
-each time the mode is invoked.  Prior bindings are resurrected when
-the mode is revoked.
-
-	Navigation:				   Exposure Control:
-	----------                                 ----------------
-C-c C-n outline-next-visible-heading     | C-c C-h outline-hide-current-subtree
-C-c C-p outline-previous-visible-heading | C-c C-i outline-show-children
-C-c C-u outline-up-current-level         | C-c C-s outline-show-current-subtree
-C-c C-f outline-forward-current-level    | C-c C-o outline-show-current-entry
-C-c C-b outline-backward-current-level   | ^U C-c C-s outline-show-all
-C-c C-e outline-end-of-current-entry     |	   outline-hide-current-leaves
-C-c C-a outline-beginning-of-current-entry, alternately, goes to hot-spot
-
-	Topic Header Production:
-	-----------------------
-C-c<SP>	outline-open-sibtopic	Create a new sibling after current topic.
-C-c .	outline-open-subtopic	... an offspring of current topic.
-C-c ,	outline-open-supertopic	... a sibling of the current topic's parent.
-
-	Topic Level and Prefix Adjustment:
-	---------------------------------
-C-c >	outline-shift-in	Shift current topic and all offspring deeper.
-C-c <	outline-shift-out	... less deep.
-C-c<CR>	outline-rebullet-topic	Reconcile bullets of topic and its offspring
-				- distinctive bullets are not changed, others
-				  alternated according to nesting depth.
-C-c *	outline-rebullet-current-heading Prompt for alternate bullet for
-					 current topic.
-C-c #	outline-number-siblings	Number bullets of topic and siblings - the
-				offspring are not affected.  With repeat
-				count, revoke numbering.
-
-	Topic-oriented Killing and Yanking:
-	----------------------------------
-C-c C-k	outline-kill-topic	Kill current topic, including offspring.
-C-k	outline-kill-line	Like kill-line, but reconciles numbering, etc.
-C-y	outline-yank		Yank, adjusting depth of yanked topic to
-				depth of heading if yanking into bare topic
-				heading (ie, prefix sans text).
-M-y	outline-yank-pop	Is to outline-yank as yank-pop is to yank
-
-	Misc commands:
-	-------------
-C-c @   outline-resolve-xref    pop-to-buffer named by xref (cf
-				outline-file-xref-bullet)
-C-c c	outline-copy-exposed	Copy current topic outline sans concealed
-				text, to buffer with name derived from
-				current buffer - \"XXX exposed\"
-M-x outlineify-sticky		Activate outline mode for current buffer,
-				and establish a default file-var setting
-				for `outline-layout'.
-ESC ESC (outline-init t)	Setup emacs session for outline mode
-				auto-activation.
-
-		 HOT-SPOT Operation
-
-Hot-spot operation provides a means for easy, single-keystroke outline
-navigation and exposure control.
-
-\\<outline-mode-map>
-When the text cursor is positioned directly on the bullet character of
-a topic, regular characters (a to z) invoke the commands of the
-corresponding outline-mode keymap control chars.  For example, \"f\"
-would invoke the command typically bound to \"C-c C-f\"
-\(\\[outline-forward-current-level] `outline-forward-current-level').
-
-Thus, by positioning the cursor on a topic bullet, you can execute
-the outline navigation and manipulation commands with a single
-keystroke.  Non-literal chars never get this special translation, so
-you can use them to get away from the hot-spot, and back to normal
-operation.
-
-Note that the command `outline-beginning-of-current-entry' \(\\[outline-beginning-of-current-entry]\)
-will move to the hot-spot when the cursor is already located at the
-beginning of the current entry, so you can simply hit \\[outline-beginning-of-current-entry]
-twice in a row to get to the hot-spot.
-
-			    Terminology
-
-Topic hierarchy constituents - TOPICS and SUBTOPICS:
-
-TOPIC:	A basic, coherent component of an emacs outline.  It can
-	contain other topics, and it can be subsumed by other topics,
-CURRENT topic:
-	The visible topic most immediately containing the cursor.
-DEPTH:	The degree of nesting of a topic; it increases with
-	containment.  Also called the:
-LEVEL:	The same as DEPTH.
-
-ANCESTORS:
-	The topics that contain a topic.
-PARENT:	A topic's immediate ancestor.  It has a depth one less than
-	the topic.
-OFFSPRING:
-	The topics contained by a topic;
-SUBTOPIC:
-	An immediate offspring of a topic;
-CHILDREN:
-	The immediate offspring of a topic.
-SIBLINGS:
-	Topics having the same parent and depth.
-
-Topic text constituents:
-
-HEADER:	The first line of a topic, include the topic PREFIX and header
-	text.
-PREFIX: The leading text of a topic which which distinguishes it from
-	normal text.  It has a strict form, which consists of a
-	prefix-lead string, padding, and a bullet.  The bullet may be
-	followed by a number, indicating the ordinal number of the
-	topic among its siblings, a space, and then the header text.
-
-	The relative length of the PREFIX determines the nesting depth
-	of the topic.
-PREFIX-LEAD:
-	The string at the beginning of a topic prefix, normally a `.'.
-	It can be customized by changing the setting of
-	`outline-header-prefix' and then reinitializing outline-mode.
-
-	By setting the prefix-lead to the comment-string of a
-	programming language, you can embed outline-structuring in
-	program code without interfering with the language processing
-	of that code.  See `outline-use-mode-specific-leader'
-	docstring for more detail.
-PREFIX-PADDING:
-	Spaces or asterisks which separate the prefix-lead and the
-	bullet, according to the depth of the topic.
-BULLET: A character at the end of the topic prefix, it must be one of
-	the characters listed on `outline-plain-bullets-string' or
-        `outline-distinctive-bullets-string'.  (See the documentation
-        for these variables for more details.)  The default choice of
-	bullet when generating varies in a cycle with the depth of the
-	topic.
-ENTRY:	The text contained in a topic before any offspring.
-BODY:	Same as ENTRY.
-
-
-EXPOSURE:
- 	The state of a topic which determines the on-screen visibility
-	of its offspring and contained text.
-CONCEALED:
-	Topics and entry text whose display is inhibited.  Contiguous
-	units of concealed text is represented by `...' ellipses.
-	(Ref the `selective-display' var.)
-
-	Concealed topics are effectively collapsed within an ancestor.
-CLOSED:	A topic whose immediate offspring and body-text is concealed.
-OPEN:	A topic that is not closed, though its offspring or body may be."
-;;;_    . Code
-  (interactive "P")
-
-  (let* ((active (and (not (equal major-mode 'outline))
-		     (outline-mode-p)))
-				       ; Massage universal-arg `toggle' val:
-	 (toggle (and toggle
-		     (or (and (listp toggle)(car toggle))
-			 toggle)))
-				       ; Activation specifically demanded?
-	 (explicit-activation (or
-			      ;;
-			      (and toggle
-				   (or (symbolp toggle)
-				       (and (natnump toggle)
-					    (not (zerop toggle)))))))
-	 ;; outline-mode already called once during this complex command?
-	 (same-complex-command (eq outline-v18/9-file-var-hack
-				  (car command-history)))
-	 do-layout
-	 )
-
-				       ; See comments below re v19.18,.19 bug.
-    (setq outline-v18/9-file-var-hack (car command-history))
-
-    (cond
-
-     ;; Provision for v19.18, 19.19 bug -
-     ;; Emacs v 19.18, 19.19 file-var code invokes prop-line-designated
-     ;; modes twice when file is visited.  We have to avoid toggling mode
-     ;; off on second invocation, so we detect it as best we can, and
-     ;; skip everything.
-     ((and same-complex-command		; Still in same complex command
-				       ; as last time outline-mode invoked.
-	  active			; Already activated.
-	  (not explicit-activation)	; Prop-line file-vars don't have args.
-	  (string-match "^19.1[89]"	; Bug only known to be in v19.18 and
-			emacs-version)); 19.19.
-      t)
-
-     ;; Deactivation:
-     ((and (not explicit-activation)
-	  (or active toggle))
-				       ; Activation not explicitly
-				       ; requested, and either in
-				       ; active state or *de*activation
-				       ; specifically requested:
-      (setq outline-explicitly-deactivated t)
-      (if (string-match "^18\." emacs-version)
-				       ; Revoke those keys that remain
-				       ; as we set them:
-	  (let ((curr-loc (current-local-map)))
-	   (mapcar '(lambda (cell)
-		      (if (eq (lookup-key curr-loc (car cell))
-			      (car (cdr cell)))
-			  (define-key curr-loc (car cell)
-			    (assq (car cell) outline-prior-bindings))))
-		   outline-added-bindings)
-	   (outline-resumptions 'outline-added-bindings)
-	   (outline-resumptions 'outline-prior-bindings)))
-
-      (if outline-old-style-prefixes
-	  (progn
-	   (outline-resumptions 'outline-primary-bullet)
-	   (outline-resumptions 'outline-old-style-prefixes)))
-      (outline-resumptions 'selective-display)
-      (if (and (boundp 'before-change-function) before-change-function)
-	  (outline-resumptions 'before-change-function))
-      (setq pre-command-hook (delq 'outline-pre-command-business
-				  pre-command-hook))
-      (setq local-write-file-hooks
-	   (delq 'outline-write-file-hook
-		 local-write-file-hooks))
-      (outline-resumptions 'paragraph-start)
-      (outline-resumptions 'paragraph-separate)
-      (outline-resumptions (if (string-match "^18" emacs-version)
-			      'auto-fill-hook
-			    'auto-fill-function))
-      (outline-resumptions 'outline-former-auto-filler)
-      (setq outline-mode nil))
-
-     ;; Activation:
-     ((not active)
-      (setq outline-explicitly-deactivated nil)
-      (if outline-old-style-prefixes
-	  (progn			; Inhibit all the fancy formatting:
-	   (outline-resumptions 'outline-primary-bullet '("*"))
-	   (outline-resumptions 'outline-old-style-prefixes '(()))))
-
-      (outline-infer-header-lead)
-      (outline-infer-body-reindent)
-
-      (set-outline-regexp)
-
-				       ; Produce map from current version
-				       ; of outline-keybindings-list:
-      (if (boundp 'minor-mode-map-alist)
-
-	  (progn			; V19, and maybe lucid and
-				       ; epoch, minor-mode key bindings:
-	   (setq outline-mode-map
-		 (produce-outline-mode-map outline-keybindings-list))
-	   (fset 'outline-mode-map outline-mode-map)
-				       ; Include on minor-mode-map-alist,
-				       ; if not already there:
-	   (if (not (member '(outline-mode . outline-mode-map)
-			    minor-mode-map-alist))
-	       (setq minor-mode-map-alist
-		     (cons '(outline-mode . outline-mode-map)
-			   minor-mode-map-alist))))
-
-				       ; V18 minor-mode key bindings:
-				       ; Stash record of added bindings
-				       ; for later revocation:
-	(outline-resumptions 'outline-added-bindings
-			    (list outline-keybindings-list))
-	(outline-resumptions 'outline-prior-bindings
-			    (list (current-local-map)))
-				       ; and add them:
-	(use-local-map (produce-outline-mode-map outline-keybindings-list
-						(current-local-map)))
-	)
-
-				       ; selective-display is the
-				       ; emacs conditional exposure
-				       ; mechanism:
-      (outline-resumptions 'selective-display '(t))
-      (if outline-inhibit-protection
-	  t
-	(outline-resumptions 'before-change-function
-			    '(outline-before-change-protect)))
-				       ; Temporarily set by any outline
-				       ; functions that can be trusted to
-				       ; deal properly with concealed text.
-      (add-hook 'local-write-file-hooks 'outline-write-file-hook)
-				       ; Custom auto-fill func, to support
-				       ; respect for topic headline,
-				       ; hanging-indents, etc:
-      (let* ((fill-func-var (if (string-match "^18" emacs-version)
-			       'auto-fill-hook
-			     'auto-fill-function))
-	    (fill-func (symbol-value fill-func-var)))
-	;; Register prevailing fill func for use by outline-auto-fill:
-	(outline-resumptions 'outline-former-auto-filler (list fill-func))
-	;; Register outline-auto-fill to be used if filling is active:
-	(outline-resumptions fill-func-var '(outline-auto-fill)))
-      ;; Paragraphs are broken by topic headlines.
-      (make-local-variable 'paragraph-start)
-      (outline-resumptions 'paragraph-start
-			  (list (concat paragraph-start "\\|\\("
-					outline-regexp "\\)")))
-      (make-local-variable 'paragraph-separate)
-      (outline-resumptions 'paragraph-separate
-			  (list (concat paragraph-separate "\\|\\("
-					outline-regexp "\\)")))
-
-      (or (assq 'outline-mode minor-mode-alist)
-	  (setq minor-mode-alist
-	       (cons '(outline-mode " Outl") minor-mode-alist)))
-
-      (if outline-layout
-	  (setq do-layout t))
-
-      (if outline-enwrap-isearch-mode
-	  (outline-enwrap-isearch))
-
-      (run-hooks 'outline-mode-hook)
-      (setq outline-mode t))
-
-     ;; Reactivation:
-     ((setq do-layout t)
-      (outline-infer-body-reindent))
-     )					; cond
-
-    (if (and do-layout
-	     outline-auto-activation
-	     (listp outline-layout)
-	     (and (not (eq outline-auto-activation 'activate))
-		  (if (eq outline-auto-activation 'ask)
-		      (if (y-or-n-p (format "Expose %s with layout '%s'? "
-					    (buffer-name)
-					    outline-layout))
-			  t
-			(message "Skipped %s layout." (buffer-name))
-			nil)
-		    t)))
-	(save-excursion
-	  (message "Adjusting '%s' exposure..." (buffer-name))
-	  (goto-char 0)
-	  (outline-this-or-next-heading)
-	  (condition-case err
-	      (progn
-		(apply 'outline-expose-topic (list outline-layout))
-		(message "Adjusting '%s' exposure... done." (buffer-name)))
-	    ;; Problem applying exposure - notify user, but don't
-	    ;; interrupt, eg, file visit:
-	    (error (message "%s" (car (cdr err)))
-		   (sit-for 1)))))
-    outline-mode
-    )					; let*
-  )  					; defun
-
-;;;_ #3 Internal Position State-Tracking - "outline-recent-*" funcs
-;;; All the basic outline functions that directly do string matches to
-;;; evaluate heading prefix location set the variables
-;;; `outline-recent-prefix-beginning'  and `outline-recent-prefix-end'
-;;; when successful.  Functions starting with `outline-recent-' all
-;;; use this state, providing the means to avoid redundant searches
-;;; for just-established data.  This optimization can provide
-;;; significant speed improvement, but it must be employed carefully.
-;;;_  = outline-recent-prefix-beginning
-(defvar outline-recent-prefix-beginning 0
-  "Buffer point of the start of the last topic prefix encountered.")
-(make-variable-buffer-local 'outline-recent-prefix-beginning)
-;;;_  = outline-recent-prefix-end
-(defvar outline-recent-prefix-end 0
-  "Buffer point of the end of the last topic prefix encountered.")
-(make-variable-buffer-local 'outline-recent-prefix-end)
-;;;_  = outline-recent-end-of-subtree
-(defvar outline-recent-end-of-subtree 0
-  "Buffer point last returned by outline-end-of-current-subtree.")
-(make-variable-buffer-local 'outline-recent-end-of-subtree)
-;;;_  > outline-prefix-data (beg end)
-(defmacro outline-prefix-data (beg end)
-  "Register outline-prefix state data - BEGINNING and END of prefix.
-
-For reference by `outline-recent' funcs.  Returns BEGINNING."
-  (` (setq outline-recent-prefix-end (, end)
-	   outline-recent-prefix-beginning (, beg))))
-;;;_  > outline-recent-depth ()
-(defmacro outline-recent-depth ()
-  "Return depth of last heading encountered by an outline maneuvering function.
-
-All outline functions which directly do string matches to assess
-headings set the variables outline-recent-prefix-beginning and
-outline-recent-prefix-end if successful.  This function uses those settings
-to return the current depth."
-
-  '(max 1 (- outline-recent-prefix-end
-	     outline-recent-prefix-beginning
-	     outline-header-subtraction)))
-;;;_  > outline-recent-prefix ()
-(defmacro outline-recent-prefix ()
-  "Like outline-recent-depth, but returns text of last encountered prefix.
-
-All outline functions which directly do string matches to assess
-headings set the variables outline-recent-prefix-beginning and
-outline-recent-prefix-end if successful.  This function uses those settings
-to return the current depth."
-  '(buffer-substring outline-recent-prefix-beginning
-		     outline-recent-prefix-end))
-;;;_  > outline-recent-bullet ()
-(defmacro outline-recent-bullet ()
-  "Like outline-recent-prefix, but returns bullet of last encountered prefix.
-
-All outline functions which directly do string matches to assess
-headings set the variables outline-recent-prefix-beginning and
-outline-recent-prefix-end if successful.  This function uses those settings
-to return the current depth of the most recently matched topic."
-  '(buffer-substring (1- outline-recent-prefix-end)
-		     outline-recent-prefix-end))
-
-;;;_ #4 Navigation
-
-;;;_  - Position Assessment
-;;;_   : Location Predicates
-;;;_    > outline-on-current-heading-p ()
-(defun outline-on-current-heading-p ()
-  "Return non-nil if point is on current visible topics' header line.
-
-Actually, returns prefix beginning point."
-  (save-excursion
-    (beginning-of-line)
-    (and (looking-at outline-regexp)
-	 (outline-prefix-data (match-beginning 0) (match-end 0)))))
-;;;_    > outline-e-o-prefix-p ()
-(defun outline-e-o-prefix-p ()
-  "True if point is located where current topic prefix ends, heading begins."
-  (and (save-excursion (beginning-of-line)
-		       (looking-at outline-regexp))
-       (= (point)(save-excursion (outline-end-of-prefix)(point)))))
-;;;_    > outline-hidden-p ()
-(defmacro outline-hidden-p ()
-  "True if point is in hidden text."
-  '(save-excursion
-     (and (re-search-backward "[\n\r]" () t)
-	  (= ?\r (following-char)))))
-;;;_    > outline-visible-p ()
-(defmacro outline-visible-p ()
-  "True if point is not in hidden text."
-  (interactive)
-  '(not (outline-hidden-p)))
-;;;_   : Location attributes
-;;;_    > outline-depth ()
-(defmacro outline-depth ()
-  "Like outline-current-depth, but respects hidden as well as visible topics."
-  '(save-excursion
-     (if (outline-goto-prefix)
-	 (outline-recent-depth)
-       (progn
-	 ;; Oops, no prefix, zero prefix data:
-	 (outline-prefix-data (point)(point))
-	 ;; ... and return 0:
-	 0))))
-;;;_    > outline-current-depth ()
-(defmacro outline-current-depth ()
-  "Return nesting depth of visible topic most immediately containing point."
-  '(save-excursion
-     (if (outline-back-to-current-heading)
-	 (max 1
-	      (- outline-recent-prefix-end
-		 outline-recent-prefix-beginning
-		 outline-header-subtraction))
-       0)))
-;;;_    > outline-get-current-prefix ()
-(defun outline-get-current-prefix ()
-  "Topic prefix of the current topic."
-  (save-excursion
-    (if (outline-goto-prefix)
-	(outline-recent-prefix))))
-;;;_    > outline-get-bullet ()
-(defun outline-get-bullet ()
-  "Return bullet of containing topic (visible or not)."
-  (save-excursion
-    (and (outline-goto-prefix)
-	 (outline-recent-bullet))))
-;;;_    > outline-current-bullet ()
-(defun outline-current-bullet ()
-  "Return bullet of current (visible) topic heading, or none if none found."
-  (condition-case err
-      (save-excursion
-	(outline-back-to-current-heading)
-	(buffer-substring (- outline-recent-prefix-end 1)
-			  outline-recent-prefix-end))
-    ;; Quick and dirty provision, ostensibly for missing bullet:
-    (args-out-of-range nil))
-  )
-;;;_    > outline-get-prefix-bullet (prefix)
-(defun outline-get-prefix-bullet (prefix)
-  "Return the bullet of the header prefix string PREFIX."
-  ;; Doesn't make sense if we're old-style prefixes, but this just
-  ;; oughtn't be called then, so forget about it...
-  (if (string-match outline-regexp prefix)
-      (substring prefix (1- (match-end 0)) (match-end 0))))
-
-;;;_  - Navigation macros
-;;;_   > outline-next-heading ()
-(defmacro outline-next-heading ()
-  "Move to the heading for the topic \(possibly invisible) before this one.
-
-Returns the location of the heading, or nil if none found."
-
-  '(if (and (bobp) (not (eobp)))
-       (forward-char 1))
-
-  '(if (re-search-forward outline-line-boundary-regexp nil 0)
-       (progn				; Got valid location state - set vars:
-	 (outline-prefix-data
-	  (goto-char (or (match-beginning 2)
-			 outline-recent-prefix-beginning))
-	  (or (match-end 2) outline-recent-prefix-end)))))
-;;;_   : outline-this-or-next-heading
-(defun outline-this-or-next-heading ()
-  "Position cursor on current or next heading."
-  ;; A throwaway non-macro that is defined after outline-next-heading
-  ;; and usable by outline-mode.
-  (if (not (outline-goto-prefix)) (outline-next-heading)))
-;;;_   > outline-previous-heading ()
-(defmacro outline-previous-heading ()
-  "Move to the prior \(possibly invisible) heading line.
-
-Return the location of the beginning of the heading, or nil if not found."
-
-  '(if (bobp)
-       nil
-     (outline-goto-prefix)
-     (if
-	 ;; searches are unbounded and return nil if failed:
-	 (or (re-search-backward outline-line-boundary-regexp nil 0)
-	     (looking-at outline-bob-regexp))
-	 (progn				; Got valid location state - set vars:
-	   (outline-prefix-data
-	    (goto-char (or (match-beginning 2)
-			   outline-recent-prefix-beginning))
-	    (or (match-end 2) outline-recent-prefix-end))))))
-
-;;;_  - Subtree Charting
-;;;_   " These routines either produce or assess charts, which are
-;;; nested lists of the locations of topics within a subtree.
-;;;
-;;; Use of charts enables efficient navigation of subtrees, by
-;;; requiring only a single regexp-search based traversal, to scope
-;;; out the subtopic locations.  The chart then serves as the basis
-;;; for whatever assessment or adjustment of the subtree that is
-;;; required, without requiring redundant topic-traversal procedures.
-
-;;;_   > outline-chart-subtree (&optional levels orig-depth prev-depth)
-(defun outline-chart-subtree (&optional levels orig-depth prev-depth)
-  "Produce a location \"chart\" of subtopics of the containing topic.
-
-Optional argument LEVELS specifies the depth \(relative to start
-depth\) for the chart.  Subsequent optional args are not for public
-use.
-
-Charts are used to capture outline structure, so that outline-altering
-routines need assess the structure only once, and then use the chart
-for their elaborate manipulations.
-
-Topics are entered in the chart so the last one is at the car.
-The entry for each topic consists of an integer indicating the point
-at the beginning of the topic.  Charts for offspring consists of a
-list containing, recursively, the charts for the respective subtopics.
-The chart for a topics' offspring precedes the entry for the topic
-itself.
-
-The other function parameters are for internal recursion, and should
-not be specified by external callers.  ORIG-DEPTH is depth of topic at
-starting point, and PREV-DEPTH is depth of prior topic."
-
-  (let ((original (not orig-depth))	; `orig-depth' set only in recursion.
-	chart curr-depth)
-
-    (if original			; Just starting?
-					; Register initial settings and
-					; position to first offspring:
-	(progn (setq orig-depth (outline-depth))
-	       (or prev-depth (setq prev-depth (1+ orig-depth)))
-	       (outline-next-heading)))
-
-    ;; Loop over the current levels' siblings.  Besides being more
-    ;; efficient than tail-recursing over a level, it avoids exceeding
-    ;; the typically quite constrained emacs max-lisp-eval-depth.
-    ;; Probably would speed things up to implement loop-based stack
-    ;; operation rather than recursing for lower levels.  Bah.
-    (while (and (not (eobp))
-					; Still within original topic?
-		(< orig-depth (setq curr-depth (outline-recent-depth)))
-		(cond ((= prev-depth curr-depth)
-		       ;; Register this one and move on:
-		       (setq chart (cons (point) chart))
-		       (if (and levels (<= levels 1))
-			   ;; At depth limit - skip sublevels:
-			   (or (outline-next-sibling curr-depth)
-			       ;; or no more siblings - proceed to
-			       ;; next heading at lesser depth:
-			       (while (and (<= curr-depth
-					       (outline-recent-depth))
-					   (outline-next-heading))))
-			 (outline-next-heading)))
-
-		      ((and (< prev-depth curr-depth)
-			    (or (not levels)
-				(> levels 0)))
-		       ;; Recurse on deeper level of curr topic:
-		       (setq chart
-			     (cons (outline-chart-subtree (and levels
-							       (1- levels))
-							  orig-depth
-							  curr-depth)
-				   chart))
-		       ;; ... then continue with this one.
-		       )
-
-		      ;; ... else nil if we've ascended back to prev-depth.
-
-		      )))
-
-    (if original			; We're at the last sibling on
-					; the original level.  Position
-					; to the end of it:
-	(progn (and (not (eobp)) (forward-char -1))
-	       (and (memq (preceding-char) '(?\n ?\^M))
-		    (memq (aref (buffer-substring (max 1 (- (point) 3))
-						  (point))
-				1)
-			  '(?\n ?\^M))
-		    (forward-char -1))
-	       (setq outline-recent-end-of-subtree (point))))
-
-    chart				; (nreverse chart) not necessary,
-					; and maybe not preferable.
-    ))
-;;;_   > outline-chart-siblings (&optional start end)
-(defun outline-chart-siblings (&optional start end)
-  "Produce a list of locations of this and succeeding sibling topics.
-Effectively a top-level chart of siblings.  See `outline-chart-subtree'
-for an explanation of charts."
-  (save-excursion
-    (if (outline-goto-prefix)
-	(let ((chart (list (point))))
-	  (while (outline-next-sibling)
-	    (setq chart (cons (point) chart)))
-	  (if chart (setq chart (nreverse chart)))))))
-;;;_   > outline-chart-to-reveal (chart depth)
-(defun outline-chart-to-reveal (chart depth)
-
-  "Return a flat list of hidden points in subtree CHART, up to DEPTH.
-
-Note that point can be left at any of the points on chart, or at the
-start point."
-
-  (let (result here)
-    (while (and (or (eq depth t) (> depth 0))
-		chart)
-      (setq here (car chart))
-      (if (listp here)
-	  (let ((further (outline-chart-to-reveal here (or (eq depth t)
-							   (1- depth)))))
-	    ;; We're on the start of a subtree - recurse with it, if there's
-	    ;; more depth to go:
-	    (if further (setq result (append further result)))
-	    (setq chart (cdr chart)))
-	(goto-char here)
-	(if (= (preceding-char) ?\r)
-	    (setq result (cons here result)))
-	(setq chart (cdr chart))))
-    result))
-;;;_   X outline-chart-spec (chart spec &optional exposing)
-(defun outline-chart-spec (chart spec &optional exposing)
-  "Not yet \(if ever\) implemented.
-
-Produce exposure directives given topic/subtree CHART and an exposure SPEC.
-
-Exposure spec indicates the locations to be exposed and the prescribed
-exposure status.  Optional arg EXPOSING is an integer, with 0
-indicating pending concealment, anything higher indicating depth to
-which subtopic headers should be exposed, and negative numbers
-indicating (negative of) the depth to which subtopic headers and
-bodies should be exposed.
-
-The produced list can have two types of entries.  Bare numbers
-indicate points in the buffer where topic headers that should be
-exposed reside.
-
- - bare negative numbers indicates that the topic starting at the
-   point which is the negative of the number should be opened,
-   including their entries.
- - bare positive values indicate that this topic header should be
-   opened.
- - Lists signify the beginning and end points of regions that should
-   be flagged, and the flag to employ.  (For concealment: `\(\?r\)', and
-   exposure:"
-  (while spec
-    (cond ((listp spec)
-	   )
-	  )
-    (setq spec (cdr spec)))
-  )
-
-;;;_  - Within Topic
-;;;_   > outline-goto-prefix ()
-(defun outline-goto-prefix ()
-  "Put point at beginning of outline prefix for immediately containing topic.
-
-Goes to first subsequent topic if none immediately containing.
-
-Not sensitive to topic visibility.
-
-Returns a the point at the beginning of the prefix, or nil if none."
-
-  (let (done)
-    (while (and (not done)
-		(re-search-backward "[\n\r]" nil 1))
-      (forward-char 1)
-      (if (looking-at outline-regexp)
-	  (setq done (outline-prefix-data (match-beginning 0)
-					  (match-end 0)))
-	(forward-char -1)))
-    (if (bobp)
-	(cond ((looking-at outline-regexp)
-	       (outline-prefix-data (match-beginning 0)(match-end 0)))
-	      ((outline-next-heading)
-	       (outline-prefix-data (match-beginning 0)(match-end 0)))
-	      (done))
-      done)))
-;;;_   > outline-end-of-prefix ()
-(defun outline-end-of-prefix (&optional ignore-decorations)
-  "Position cursor at beginning of header text.
-
-If optional IGNORE-DECORATIONS is non-nil, put just after bullet,
-otherwise skip white space between bullet and ensuing text."
-
-  (if (not (outline-goto-prefix))
-      nil
-    (let ((match-data (match-data)))
-      (goto-char (match-end 0))
-      (if ignore-decorations
-	  t
-	(while (looking-at "[0-9]") (forward-char 1))
-	(if (and (not (eolp)) (looking-at "\\s-")) (forward-char 1)))
-      (store-match-data match-data))
-    ;; Reestablish where we are:
-    (outline-current-depth)))
-;;;_   > outline-current-bullet-pos ()
-(defun outline-current-bullet-pos ()
-  "Return position of current \(visible) topic's bullet."
-
- (if (not (outline-current-depth))
-      nil
-   (1- (match-end 0))))
-;;;_   > outline-back-to-current-heading ()
-(defun outline-back-to-current-heading ()
-  "Move to heading line of current topic, or beginning if already on the line."
-
-  (beginning-of-line)
-  (prog1 (or (outline-on-current-heading-p)
-             (and (re-search-backward (concat "^\\(" outline-regexp "\\)")
-                                      nil
-                                      'move)
-                  (outline-prefix-data (match-beginning 1)(match-end 1))))
-    (if (interactive-p) (outline-end-of-prefix))))
-;;;_   > outline-pre-next-preface ()
-(defun outline-pre-next-preface ()
-  "Skip forward to just before the next heading line.
-
-Returns that character position."
-
-  (if (re-search-forward outline-line-boundary-regexp nil 'move)
-      (prog1 (goto-char (match-beginning 0))
-             (outline-prefix-data (match-beginning 2)(match-end 2)))))
-;;;_   > outline-end-of-current-subtree ()
-(defun outline-end-of-current-subtree ()
-  "Put point at the end of the last leaf in the currently visible topic."
-  (interactive)
-  (outline-back-to-current-heading)
-  (let ((level (outline-recent-depth)))
-    (outline-next-heading)
-    (while (and (not (eobp))
-                (> (outline-recent-depth) level))
-      (outline-next-heading))
-    (and (not (eobp)) (forward-char -1))
-    (and (memq (preceding-char) '(?\n ?\^M))
-         (memq (aref (buffer-substring (max 1 (- (point) 3)) (point)) 1)
-               '(?\n ?\^M))
-         (forward-char -1))
-    (setq outline-recent-end-of-subtree (point))))
-;;;_   > outline-beginning-of-current-entry ()
-(defun outline-beginning-of-current-entry ()
-  "When not already there, position point at beginning of current topic's body.
-
-If already there, move cursor to bullet for hot-spot operation.
-\(See outline-mode doc string for details on hot-spot operation.)"
-  (interactive)
-  (let ((start-point (point)))
-    (outline-end-of-prefix)
-    (if (and (interactive-p)
-	     (= (point) start-point))
-	(goto-char (outline-current-bullet-pos)))))
-;;;_   > outline-end-of-current-entry ()
-(defun outline-end-of-current-entry ()
-  "Position the point at the end of the current topics' entry."
-  (interactive)
-  (outline-show-entry)
-  (prog1 (outline-pre-next-preface)
-    (if (and (not (bobp))(looking-at "^$"))
-        (forward-char -1))))
-
-;;;_  - Depth-wise
-;;;_   > outline-ascend-to-depth (depth)
-(defun outline-ascend-to-depth (depth)
-  "Ascend to depth DEPTH, returning depth if successful, nil if not."
-  (if (and (> depth 0)(<= depth (outline-depth)))
-      (let ((last-good (point)))
-        (while (and (< depth (outline-depth))
-                    (setq last-good (point))
-                    (outline-beginning-of-level)
-                    (outline-previous-heading)))
-        (if (= (outline-recent-depth) depth)
-            (progn (goto-char outline-recent-prefix-beginning)
-                   depth)
-          (goto-char last-good)
-          nil))
-    (if (interactive-p) (outline-end-of-prefix))))
-;;;_   > outline-descend-to-depth (depth)
-(defun outline-descend-to-depth (depth)
-  "Descend to depth DEPTH within current topic.
-
-Returning depth if successful, nil if not."
-  (let ((start-point (point))
-        (start-depth (outline-depth)))
-    (while
-        (and (> (outline-depth) 0)
-             (not (= depth (outline-recent-depth))) ; ... not there yet
-             (outline-next-heading)     ; ... go further
-             (< start-depth (outline-recent-depth)))) ; ... still in topic
-    (if (and (> (outline-depth) 0)
-             (= (outline-recent-depth) depth))
-        depth
-      (goto-char start-point)
-      nil))
-  )
-;;;_   > outline-up-current-level (arg &optional dont-complain)
-(defun outline-up-current-level (arg &optional dont-complain)
-  "Move out ARG levels from current visible topic.
-
-Positions on heading line of containing topic.  Error if unable to
-ascend that far, or nil if unable to ascend but optional arg
-DONT-COMPLAIN is non-nil."
-  (interactive "p")
-  (outline-back-to-current-heading)
-  (let ((present-level (outline-recent-depth))
-	(last-good (point))
-	failed
-	return)
-    ;; Loop for iterating arg:
-    (while (and (> (outline-recent-depth) 1)
-                (> arg 0)
-                (not (bobp))
-		(not failed))
-      (setq last-good (point))
-      ;; Loop for going back over current or greater depth:
-      (while (and (not (< (outline-recent-depth) present-level))
-		  (or (outline-previous-visible-heading 1)
-		      (not (setq failed present-level)))))
-      (setq present-level (outline-current-depth))
-      (setq arg (- arg 1)))
-    (if (or failed
-	    (> arg 0))
-	(progn (goto-char last-good)
-	       (if (interactive-p) (outline-end-of-prefix))
-	       (if (not dont-complain)
-		   (error "Can't ascend past outermost level.")
-		 (if (interactive-p) (outline-end-of-prefix))
-		 nil))
-      (if (interactive-p) (outline-end-of-prefix))
-      outline-recent-prefix-beginning)))
-
-;;;_  - Linear
-;;;_   > outline-next-sibling (&optional depth backward)
-(defun outline-next-sibling (&optional depth backward)
-  "Like outline-forward-current-level, but respects invisible topics.
-
-Traverse at optional DEPTH, or current depth if none specified.
-
-Go backward if optional arg BACKWARD is non-nil.
-
-Return depth if successful, nil otherwise."
-
-  (if (and backward (bobp))
-      nil
-    (let ((start-depth (or depth (outline-depth)))
-          (start-point (point))
-	  last-depth)
-      (while (and (not (if backward (bobp) (eobp)))
-                  (if backward (outline-previous-heading)
-                    (outline-next-heading))
-                  (> (setq last-depth (outline-recent-depth)) start-depth)))
-      (if (and (not (eobp))
-               (and (> (or last-depth (outline-depth)) 0)
-                    (= (outline-recent-depth) start-depth)))
-          outline-recent-prefix-beginning
-        (goto-char start-point)
-	(if depth (outline-depth) start-depth)
-        nil))))
-;;;_   > outline-previous-sibling (&optional depth backward)
-(defun outline-previous-sibling (&optional depth backward)
-  "Like outline-forward-current-level,but backwards & respect invisible topics.
-
-Optional DEPTH specifies depth to traverse, default current depth.
-
-Optional BACKWARD reverses direction.
-
-Return depth if successful, nil otherwise."
-  (outline-next-sibling depth (not backward))
-  )
-;;;_   > outline-snug-back ()
-(defun outline-snug-back ()
-  "Position cursor at end of previous topic
-
-Presumes point is at the start of a topic prefix."
- (if (or (bobp) (eobp))
-     nil
-   (forward-char -1))
- (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M))))
-     nil
-   (forward-char -1)
-   (if (or (bobp) (not (memq (preceding-char) '(?\n ?\^M))))
-       (forward-char -1)))
- (point))
-;;;_   > outline-beginning-of-level ()
-(defun outline-beginning-of-level ()
-  "Go back to the first sibling at this level, visible or not."
-  (outline-end-of-level 'backward))
-;;;_   > outline-end-of-level (&optional backward)
-(defun outline-end-of-level (&optional backward)
-  "Go to the last sibling at this level, visible or not."
-
-  (let ((depth (outline-depth)))
-    (while (outline-previous-sibling depth nil))
-    (prog1 (outline-recent-depth)
-      (if (interactive-p) (outline-end-of-prefix)))))
-;;;_   > outline-next-visible-heading (arg)
-(defun outline-next-visible-heading (arg)
-  "Move to the next ARG'th visible heading line, backward if arg is negative.
-
-Move as far as possible in indicated direction \(beginning or end of
-buffer\) if headings are exhausted."
-
-  (interactive "p")
-  (let* ((backward (if (< arg 0) (setq arg (* -1 arg))))
-	 (step (if backward -1 1))
-	 (start-point (point))
-	 prev got)
-
-    (while (> arg 0)			; limit condition
-      (while (and (not (if backward (bobp)(eobp))) ; boundary condition
-		  ;; Move, skipping over all those concealed lines:
-		  (< -1 (forward-line step))
-		  (not (setq got (looking-at outline-regexp)))))
-      ;; Register this got, it may be the last:
-      (if got (setq prev got))
-      (setq arg (1- arg)))
-    (cond (got				; Last move was to a prefix:
-	   (outline-prefix-data (match-beginning 0) (match-end 0))
-	   (outline-end-of-prefix))
-	  (prev				; Last move wasn't, but prev was:
-	   (outline-prefix-data (match-beginning 0) (match-end 0)))
-	  ((not backward) (end-of-line) nil))))
-;;;_   > outline-previous-visible-heading (arg)
-(defun outline-previous-visible-heading (arg)
-  "Move to the previous heading line.
-
-With argument, repeats or can move forward if negative.
-A heading line is one that starts with a `*' (or that outline-regexp
-matches)."
-  (interactive "p")
-  (outline-next-visible-heading (- arg)))
-;;;_   > outline-forward-current-level (arg)
-(defun outline-forward-current-level (arg)
-  "Position point at the next heading of the same level.
-
-Takes optional repeat-count, goes backward if count is negative.
-
-Returns resulting position, else nil if none found."
-  (interactive "p")
-  (let ((start-depth (outline-current-depth))
-	(start-point (point))
-	(start-arg arg)
-	(backward (> 0 arg))
-	last-depth
-	(last-good (point))
-	at-boundary)
-    (if (= 0 start-depth)
-	(error "No siblings, not in a topic..."))
-    (if backward (setq arg (* -1 arg)))
-    (while (not (or (zerop arg)
-		    at-boundary))
-      (while (and (not (if backward (bobp) (eobp)))
-		  (if backward (outline-previous-visible-heading 1)
-		    (outline-next-visible-heading 1))
-		  (> (setq last-depth (outline-recent-depth)) start-depth)))
-      (if (and last-depth (= last-depth start-depth)
-	       (not (if backward (bobp) (eobp))))
-	  (setq last-good (point)
-		arg (1- arg))
-	(setq at-boundary t)))
-    (if (and (not (eobp))
-	     (= arg 0)
-	     (and (> (or last-depth (outline-depth)) 0)
-		  (= (outline-recent-depth) start-depth)))
-	outline-recent-prefix-beginning
-      (goto-char last-good)
-      (if (not (interactive-p))
-	  nil
-	(outline-end-of-prefix)
-	(error "Hit %s level %d topic, traversed %d of %d requested."
-	       (if backward "first" "last")
-	       (outline-recent-depth)
-	       (- (abs start-arg) arg)
-	       (abs start-arg))))))
-;;;_   > outline-backward-current-level (arg)
-(defun outline-backward-current-level (arg)
-  "Inverse of `outline-forward-current-level'."
-  (interactive "p")
-  (if (interactive-p)
-      (let ((current-prefix-arg (* -1 arg)))
-	(call-interactively 'outline-forward-current-level))
-    (outline-forward-current-level (* -1 arg))))
-
-;;;_ #5 Alteration
-
-;;;_  - Fundamental
-;;;_   > outline-before-change-protect (beg end)
-(defun outline-before-change-protect (beg end)
-  "Outline before-change hook, regulates changes to concealed text.
-
-Reveal concealed text that would be changed by current command, and
-offer user choice to commit or forego the change.  Unchanged text is
-reconcealed.  User has option to have changed text reconcealed.
-
-Undo commands are specially treated - the user is not prompted for
-choice, the undoes are always committed (based on presumption that the
-things being undone were already subject to this regulation routine),
-and undoes always leave the changed stuff exposed.
-
-Changes to concealed regions are ignored while file is being written.
-\(This is for the sake of functions that do change the file during
-writes, like crypt and zip modes.)
-
-Locally bound in outline buffers to `before-change-function', which
-in emacs 19 is run before any change to the buffer.  (Has no effect
-in Emacs 18, which doesn't support before-change-function.)
-
-Any functions which set [`this-command' to `undo', or which set]
-`outline-override-protect' non-nil (as does, eg, outline-flag-chars)
-are exempt from this restriction."
-  (if (and (outline-mode-p)
-					; outline-override-protect
-					; set by functions that know what
-					; they're doing, eg outline internals:
-	   (not outline-override-protect)
-	   (not outline-during-write-cue)
-	   (save-match-data		; Preserve operation position state.
-					; Both beginning and end chars must
-					; be exposed:
-	     (save-excursion (if (memq this-command '(newline open-line))
-				 ;; Compensate for stupid emacs {new,
-				 ;; open-}line display optimization:
-				 (setq beg (1+ beg)
-				       end (1+ end)))
-			     (goto-char beg)
-			     (or (outline-hidden-p)
-				 (and (not (= beg end))
-				      (goto-char end)
-				      (outline-hidden-p))))))
-      (save-match-data
-	(if (equal this-command 'undo)
-		 ;; Allow undo without inhibition.
-		 ;; - Undoing new and open-line hits stupid emacs redisplay
-		 ;;   optimization (em 19 cmds.c, ~ line 200).
-		 ;; - Presumably, undoing what was properly protected when
-		 ;;   done.
-		 ;; - Undo may be users' only recourse in protection faults.
-		 ;; So, expose what getting changed:
-	    (progn (message "Undo! - exposing concealed target...")
-		   (if (outline-hidden-p)
-		       (outline-show-children))
-		   (message "Undo!"))
-	  (let (response
-		(rehide-completely (save-excursion (outline-goto-prefix)
-						   (outline-hidden-p)))
-		rehide-place)
-
-	    (save-excursion
-	      (if (condition-case err
-		      ;; Condition case to catch keyboard quits during reads.
-		      (progn
-					; Give them a peek where
-			(save-excursion
-			  (if (eolp) (setq rehide-place
-					   (outline-goto-prefix)))
-			  (outline-show-entry))
-					; Present the message, but...
-					; leave the cursor at the location
-					; until they respond:
-					; Then interpret the response:
-			(while
-			    (progn
-			      (message (concat "Change inside concealed"
-					       " region - do it? "
-					       "(n or 'y'/'r'eclose)"))
-			      (setq response (read-char))
-			      (not
-			       (cond ((memq response '(?r ?R))
-				      (setq response 'reclose))
-				     ((memq response '(?y ?Y ? ))
-				      (setq response t))
-				     ((memq response '(?n ?N 127))
-				      (setq response nil)
-				      t)
-				     ((eq response ??)
-				      (message
-				       "`r' means `yes, then reclose'")
-				      nil)
-				     (t (message "Please answer y, n, or r")
-					(sit-for 1)
-					nil)))))
-			response)
-		    (quit nil))
-					; Continue:
-		  (if (eq response 'reclose)
-		      (save-excursion
-			(if rehide-place (goto-char rehide-place))
-			(if rehide-completely
-			    (outline-hide-current-entry-completely)
-			  (outline-hide-current-entry)))
-		    (if (outline-ascend-to-depth (1- (outline-recent-depth)))
-			(outline-show-children)
-		      (outline-show-to-offshoot)))
-					; Prevent:
-		(if rehide-completely
-		    (save-excursion
-		      (if rehide-place (goto-char rehide-place))
-		      (outline-hide-current-entry-completely))
-		  (outline-hide-current-entry))
-		(error (concat
-			"Change within concealed region prevented.")))))))
-    )	; if
-  )	; defun
-;;;_   = outline-post-goto-bullet
-(defvar outline-post-goto-bullet nil
-  "Outline internal var, for `outline-pre-command-business' hot-spot operation.
-
-When set, tells post-processing to reposition on topic bullet, and
-then unset it.  Set by outline-pre-command-business when implementing
-hot-spot operation, where literal characters typed over a topic bullet
-are mapped to the command of the corresponding control-key on the
-outline-mode-map.")
-(make-variable-buffer-local 'outline-post-goto-bullet)
-;;;_   > outline-post-command-business ()
-(defun outline-post-command-business ()
-  "Outline post-command-hook function.
-
-- Null outline-override-protect, so it's not left open.
-
-- Implement (and clear) outline-post-goto-bullet, for hot-spot
-  outline commands.
-
-- Massages buffer-undo-list so successive, standard character self-inserts are
-  aggregated.  This kludge compensates for lack of undo bunching when
-  before-change-function is used."
-
-					; Apply any external change func:
-  (if (not (outline-mode-p))		; In outline-mode.
-      nil
-    (setq outline-override-protect nil)
-    (if outline-during-write-cue
-	;; Was used by outline-before-change-protect, done with it now:
-	(setq outline-during-write-cue nil))
-    ;; Undo bunching business:
-    (if (and (listp buffer-undo-list)	; Undo history being kept.
-	     (equal this-command 'self-insert-command)
-	     (equal last-command 'self-insert-command))
-	(let* ((prev-stuff (cdr buffer-undo-list))
-	       (before-prev-stuff (cdr (cdr prev-stuff)))
-	       cur-cell cur-from cur-to
-	       prev-cell prev-from prev-to)
-	  (if (and before-prev-stuff	; Goes back far enough to bother,
-		   (not (car prev-stuff)) ; and break before current,
-		   (not (car before-prev-stuff)) ; !and break before prev!
-		   (setq prev-cell (car (cdr prev-stuff))) ; contents now,
-		   (setq cur-cell (car buffer-undo-list)) ; contents prev.
-
-		   ;; cur contents denote a single char insertion:
-		   (numberp (setq cur-from (car cur-cell)))
-		   (numberp (setq cur-to (cdr cur-cell)))
-		   (= 1 (- cur-to cur-from))
-
-		   ;; prev contents denote fewer than aggregate-limit
-		   ;; insertions:
-		   (numberp (setq prev-from (car prev-cell)))
-		   (numberp (setq prev-to (cdr prev-cell)))
-					; Below threshold:
-		   (> outline-undo-aggregation (- prev-to prev-from)))
-	      (setq buffer-undo-list
-		    (cons (cons prev-from cur-to)
-			  (cdr (cdr (cdr buffer-undo-list))))))))
-    ;; Implement -post-goto-bullet, if set: (must be after undo business)
-    (if (and outline-post-goto-bullet
-	     (outline-current-bullet-pos))
-	(progn (goto-char (outline-current-bullet-pos))
-	       (setq outline-post-goto-bullet nil)))
-    ))
-;;;_   > outline-pre-command-business ()
-(defun outline-pre-command-business ()
-  "Outline pre-command-hook function for outline buffers.
-
-Implements special behavior when cursor is on bullet char.
-
-Self-insert characters are reinterpreted control-character references
-into the outline-mode-map.  The outline-mode post-command hook will
-position a cursor that has moved as a result of such reinterpretation,
-on the destination topic's bullet, when the cursor wound up in the
-
-The upshot is that you can get easy, single (unmodified) key outline
-maneuvering and general operations by positioning the cursor on the
-bullet char, and it continues until you deliberately some non-outline
-motion command to relocate the cursor off of a bullet char."
-
-  (if (and (boundp 'outline-mode)
-	   outline-mode
-	   (eq this-command 'self-insert-command)
-	   (eq (point)(outline-current-bullet-pos)))
-
-      (let* ((this-key-num (if (numberp last-command-event)
-			       last-command-event))
-	     mapped-binding)
-
-					; Map upper-register literals
-					; to lower register:
-	(if (<= 96 this-key-num)
-	    (setq this-key-num (- this-key-num 32)))
-					; Check if we have a literal:
-	(if (and (<= 64 this-key-num)
-		 (>= 96 this-key-num))
-	    (setq mapped-binding
-		  (lookup-key 'outline-mode-map
-			      (concat outline-command-prefix
-				      (char-to-string (- this-key-num 64))))))
-	(if mapped-binding
-	    (setq outline-post-goto-bullet t
-		  this-command mapped-binding)))))
-;;;_   > outline-find-file-hook ()
-(defun outline-find-file-hook ()
-  "Activate outline-mode when `outline-auto-activation' & `outline-layout' are non-nil.
-
-See `outline-init' for setup instructions."
-  (if (and outline-auto-activation
-	   (not (outline-mode-p))
-	   outline-layout)
-      (outline-mode t)))
-;;;_   : Establish the hooks
-(add-hook 'post-command-hook 'outline-post-command-business)
-(add-hook 'pre-command-hook 'outline-pre-command-business)
-
-;;;_  - Topic Format Assessment
-;;;_   > outline-solicit-alternate-bullet (depth &optional current-bullet)
-(defun outline-solicit-alternate-bullet (depth &optional current-bullet)
-
-  "Prompt for and return a bullet char as an alternative to the current one.
-
-Offer one suitable for current depth DEPTH as default."
-
-  (let* ((default-bullet (or current-bullet
-                             (outline-bullet-for-depth depth)))
-	 (sans-escapes (regexp-sans-escapes outline-bullets-string))
-	 (choice (solicit-char-in-string
-                  (format "Select bullet: %s ('%s' default): "
-			  sans-escapes
-                          default-bullet)
-		  sans-escapes
-                  t)))
-    (if (string= choice "") default-bullet choice))
-  )
-;;;_   > outline-sibling-index (&optional depth)
-(defun outline-sibling-index (&optional depth)
-  "Item number of this prospective topic among its siblings.
-
-If optional arg depth is greater than current depth, then we're
-opening a new level, and return 0.
-
-If less than this depth, ascend to that depth and count..."
-
-  (save-excursion
-    (cond ((and depth (<= depth 0) 0))
-          ((or (not depth) (= depth (outline-depth)))
-           (let ((index 1))
-             (while (outline-previous-sibling (outline-recent-depth) nil)
-	       (setq index (1+ index)))
-             index))
-          ((< depth (outline-recent-depth))
-           (outline-ascend-to-depth depth)
-           (outline-sibling-index))
-          (0))))
-;;;_   > outline-distinctive-bullet (bullet)
-(defun outline-distinctive-bullet (bullet)
-  "True if bullet is one of those on outline-distinctive-bullets-string."
-  (string-match (regexp-quote bullet) outline-distinctive-bullets-string))
-;;;_   > outline-numbered-type-prefix (&optional prefix)
-(defun outline-numbered-type-prefix (&optional prefix)
-  "True if current header prefix bullet is numbered bullet."
-  (and outline-numbered-bullet
-        (string= outline-numbered-bullet
-                 (if prefix
-                     (outline-get-prefix-bullet prefix)
-                   (outline-get-bullet)))))
-;;;_   > outline-bullet-for-depth (&optional depth)
-(defun outline-bullet-for-depth (&optional depth)
-  "Return outline topic bullet suited to optional DEPTH, or current depth."
-  ;; Find bullet in plain-bullets-string modulo DEPTH.
-  (if outline-stylish-prefixes
-      (char-to-string (aref outline-plain-bullets-string
-                            (% (max 0 (- depth 2))
-                               outline-plain-bullets-string-len)))
-    outline-primary-bullet)
-  )
-
-;;;_  - Topic Production
-;;;_   > outline-make-topic-prefix (&optional prior-bullet
-(defun outline-make-topic-prefix (&optional prior-bullet
-                                            new
-                                            depth
-                                            solicit
-                                            number-control
-                                            index)
-  ;; Depth null means use current depth, non-null means we're either
-  ;; opening a new topic after current topic, lower or higher, or we're
-  ;; changing level of current topic.
-  ;; Solicit dominates specified bullet-char.
-;;;_    . Doc string:
-  "Generate a topic prefix suitable for optional arg DEPTH, or current depth.
-
-All the arguments are optional.
-
-PRIOR-BULLET indicates the bullet of the prefix being changed, or
-nil if none.  This bullet may be preserved (other options
-notwithstanding) if it is on the outline-distinctive-bullets-string,
-for instance.
-
-Second arg NEW indicates that a new topic is being opened after the
-topic at point, if non-nil.  Default bullet for new topics, eg, may
-be set (contingent to other args) to numbered bullets if previous
-sibling is one.  The implication otherwise is that the current topic
-is being adjusted - shifted or rebulleted - and we don't consider
-bullet or previous sibling.
-
-Third arg DEPTH forces the topic prefix to that depth, regardless of
-the current topics' depth.
-
-Fourth arg SOLICIT non-nil provokes solicitation from the user of a
-choice among the valid bullets.  (This overrides other all the
-options, including, eg, a distinctive PRIOR-BULLET.)
-
-Fifth arg, NUMBER-CONTROL, matters only if `outline-numbered-bullet'
-is non-nil *and* soliciting was not explicitly invoked.  Then
-NUMBER-CONTROL non-nil forces prefix to either numbered or
-denumbered format, depending on the value of the sixth arg, INDEX.
-
-\(Note that NUMBER-CONTROL does *not* apply to level 1 topics.  Sorry...)
-
-If NUMBER-CONTROL is non-nil and sixth arg INDEX is non-nil then
-the prefix of the topic is forced to be numbered.  Non-nil
-NUMBER-CONTROL and nil INDEX forces non-numbered format on the
-bullet.  Non-nil NUMBER-CONTROL and non-nil, non-number INDEX means
-that the index for the numbered prefix will be derived, by counting
-siblings back to start of level.  If INDEX is a number, then that
-number is used as the index for the numbered prefix (allowing, eg,
-sequential renumbering to not require this function counting back the
-index for each successive sibling)."
-;;;_    . Code:
-  ;; The options are ordered in likely frequence of use, most common
-  ;; highest, least lowest.  Ie, more likely to be doing prefix
-  ;; adjustments than soliciting, and yet more than numbering.
-  ;; Current prefix is least dominant, but most likely to be commonly
-  ;; specified...
-
-  (let* (body
-         numbering
-         denumbering
-         (depth (or depth (outline-depth)))
-         (header-lead outline-header-prefix)
-         (bullet-char
-
-          ;; Getting value for bullet char is practically the whole job:
-
-          (cond
-                                        ; Simplest situation - level 1:
-           ((<= depth 1) (setq header-lead "") outline-primary-bullet)
-                                        ; Simple, too: all asterisks:
-           (outline-old-style-prefixes
-            ;; Cheat - make body the whole thing, null out header-lead and
-            ;; bullet-char:
-            (setq body (make-string depth
-                                    (string-to-char outline-primary-bullet)))
-            (setq header-lead "")
-            "")
-
-           ;; (Neither level 1 nor old-style, so we're space padding.
-           ;; Sneak it in the condition of the next case, whatever it is.)
-
-           ;; Solicitation overrides numbering and other cases:
-           ((progn (setq body (make-string (- depth 2) ?\ ))
-                   ;; The actual condition:
-                   solicit)
-            (let* ((got (outline-solicit-alternate-bullet depth)))
-              ;; Gotta check whether we're numbering and got a numbered bullet:
-              (setq numbering (and outline-numbered-bullet
-                                   (not (and number-control (not index)))
-                                   (string= got outline-numbered-bullet)))
-              ;; Now return what we got, regardless:
-              got))
-
-           ;; Numbering invoked through args:
-           ((and outline-numbered-bullet number-control)
-            (if (setq numbering (not (setq denumbering (not index))))
-                outline-numbered-bullet
-              (if (and prior-bullet
-                       (not (string= outline-numbered-bullet
-                                     prior-bullet)))
-                  prior-bullet
-                (outline-bullet-for-depth depth))))
-
-          ;;; Neither soliciting nor controlled numbering ;;;
-             ;;; (may be controlled denumbering, tho) ;;;
-
-           ;; Check wrt previous sibling:
-           ((and new				  ; only check for new prefixes
-                 (<= depth (outline-depth))
-                 outline-numbered-bullet	      ; ... & numbering enabled
-                 (not denumbering)
-                 (let ((sibling-bullet
-                        (save-excursion
-                          ;; Locate correct sibling:
-                          (or (>= depth (outline-depth))
-                              (outline-ascend-to-depth depth))
-                          (outline-get-bullet))))
-                   (if (and sibling-bullet
-                            (string= outline-numbered-bullet sibling-bullet))
-                       (setq numbering sibling-bullet)))))
-
-           ;; Distinctive prior bullet?
-           ((and prior-bullet
-                 (outline-distinctive-bullet prior-bullet)
-                 ;; Either non-numbered:
-                 (or (not (and outline-numbered-bullet
-                               (string= prior-bullet outline-numbered-bullet)))
-                     ;; or numbered, and not denumbering:
-                     (setq numbering (not denumbering)))
-                 ;; Here 'tis:
-                 prior-bullet))
-
-           ;; Else, standard bullet per depth:
-           ((outline-bullet-for-depth depth)))))
-
-    (concat header-lead
-            body
-            bullet-char
-            (if numbering
-                (format "%d" (cond ((and index (numberp index)) index)
-                                   (new (1+ (outline-sibling-index depth)))
-                                   ((outline-sibling-index))))))
-    )
-  )
-;;;_   > outline-open-topic (relative-depth &optional before)
-(defun outline-open-topic (relative-depth &optional before)
-  "Open a new topic at depth DEPTH.
-
-New topic is situated after current one, unless optional flag BEFORE
-is non-nil, or unless current line is complete empty (not even
-whitespace), in which case open is done on current line.
-
-Nuances:
-
-- Creation of new topics is with respect to the visible topic
-  containing the cursor, regardless of intervening concealed ones.
-
-- New headers are generally created after/before the body of a
-  topic.  However, they are created right at cursor location if the
-  cursor is on a blank line, even if that breaks the current topic
-  body.  This is intentional, to provide a simple means for
-  deliberately dividing topic bodies.
-
-- Double spacing of topic lists is preserved.  Also, the first
-  level two topic is created double-spaced (and so would be
-  subsequent siblings, if that's left intact).  Otherwise,
-  single-spacing is used.
-
-- Creation of sibling or nested topics is with respect to the topic
-  you're starting from, even when creating backwards.  This way you
-  can easily create a sibling in front of the current topic without
-  having to go to its preceding sibling, and then open forward
-  from there."
-
-  (let* ((depth (+ (outline-current-depth) relative-depth))
-         (opening-on-blank (if (looking-at "^\$")
-                               (not (setq before nil))))
-         opening-numbered	; Will get while computing ref-topic, below
-         ref-depth		; Will get while computing ref-topic, next
-         (ref-topic (save-excursion
-                      (cond ((< relative-depth 0)
-                             (outline-ascend-to-depth depth))
-                            ((>= relative-depth 1) nil)
-                            (t (outline-back-to-current-heading)))
-                      (setq ref-depth (outline-recent-depth))
-                      (setq opening-numbered
-                            (save-excursion
-                              (and outline-numbered-bullet
-                                   (or (<= relative-depth 0)
-                                       (outline-descend-to-depth depth))
-                                   (if (outline-numbered-type-prefix)
-                                       outline-numbered-bullet))))
-                      (point)))
-         dbl-space
-         doing-beginning)
-
-    (if (not opening-on-blank)
-                                        ; Positioning and vertical
-                                        ; padding - only if not
-                                        ; opening-on-blank:
-        (progn
-          (goto-char ref-topic)
-          (setq dbl-space               ; Determine double space action:
-                (or (and (<= relative-depth 0)	; not descending;
-                         (save-excursion
-                           ;; at b-o-b or preceded by a blank line?
-                           (or (> 0 (forward-line -1))
-                               (looking-at "^\\s-*$")
-			       (bobp)))
-                         (save-excursion
-                           ;; succeeded by a blank line?
-                           (outline-end-of-current-subtree)
-                           (bolp)))
-                    (and (= ref-depth 1)
-                         (or before
-                             (= depth 1)
-                             (save-excursion
-                               ;; Don't already have following
-                               ;; vertical padding:
-                               (not (outline-pre-next-preface)))))))
-
-                                        ; Position to prior heading,
-                                        ; if inserting backwards, and
-					; not going outwards:
-          (if (and before (>= relative-depth 0))
-	      (progn (outline-back-to-current-heading)
-                            (setq doing-beginning (bobp))
-                            (if (not (bobp))
-                                (outline-previous-heading)))
-	    (if (and before (bobp))
-		(outline-unprotected (open-line 1))))
-
-          (if (<= relative-depth 0)
-              ;; Not going inwards, don't snug up:
-              (if doing-beginning
-		  (outline-unprotected (open-line (if dbl-space 2 1)))
-		(if before
-		    (progn (end-of-line)
-			   (outline-pre-next-preface)
-			   (while (= ?\r (following-char))
-                             (forward-char 1))
-			   (if (not (looking-at "^$"))
-			       (outline-unprotected (open-line 1))))
-		  (outline-end-of-current-subtree)))
-            ;; Going inwards - double-space if first offspring is,
-            ;; otherwise snug up.
-            (end-of-line)		; So we skip any concealed progeny.
-            (outline-pre-next-preface)
-            (if (bolp)
-                ;; Blank lines between current header body and next
-                ;; header - get to last substantive (non-white-space)
-                ;; line in body:
-                (re-search-backward "[^ \t\n]" nil t))
-            (if (save-excursion
-                  (outline-next-heading)
-                  (if (> (outline-recent-depth) ref-depth)
-                      ;; This is an offspring.
-                      (progn (forward-line -1)
-                             (looking-at "^\\s-*$"))))
-                (progn (forward-line 1)
-                       (outline-unprotected (open-line 1))))
-            (end-of-line))
-          ;;(if doing-beginning (goto-char doing-beginning))
-          (if (not (bobp))
-              (progn (if (and (not (> depth ref-depth))
-                              (not before))
-                         (outline-unprotected (open-line 1))
-		       (if (> depth ref-depth)
-			   (outline-unprotected (newline 1))
-			 (if dbl-space
-			     (outline-unprotected (open-line 1))
-			   (if (not before)
-			       (outline-unprotected (newline 1))))))
-                     (if dbl-space
-			 (outline-unprotected (newline  1)))
-                     (if (and (not (eobp))
-                              (not (bolp)))
-                         (forward-char 1))))
-          ))
-    (insert-string (concat (outline-make-topic-prefix opening-numbered
-                                                      t
-                                                      depth)
-                           " "))
-
-    ;;(if doing-beginning (save-excursion (newline (if dbl-space 2 1))))
-
-
-    (outline-rebullet-heading nil		;;; solicit
-                              depth 		;;; depth
-                              nil 		;;; number-control
-                              nil		;;; index
-                              t)     (end-of-line)
-    )
-  )
-;;;_    . open-topic contingencies
-;;;_     ; base topic - one from which open was issued
-;;;_      , beginning char
-;;;_      , amount of space before will be used, unless opening in place
-;;;_      , end char will be used, unless opening before (and it still may)
-;;;_     ; absolute depth of new topic
-;;;_     ! insert in place - overrides most stuff
-;;;_     ; relative depth of new re base
-;;;_     ; before or after base topic
-;;;_     ; spacing around topic, if any, prior to new topic and at same depth
-;;;_     ; buffer boundaries - special provisions for beginning and end ob
-;;;_     ; level 1 topics have special provisions also - double space.
-;;;_     ; location of new topic
-;;;_    .
-;;;_   > outline-open-subtopic (arg)
-(defun outline-open-subtopic (arg)
-  "Open new topic header at deeper level than the current one.
-
-Negative universal arg means to open deeper, but place the new topic
-prior to the current one."
-  (interactive "p")
-  (outline-open-topic 1 (> 0 arg)))
-;;;_   > outline-open-sibtopic (arg)
-(defun outline-open-sibtopic (arg)
-  "Open new topic header at same level as the current one.
-
-Negative universal arg means to place the new topic prior to the current
-one."
-  (interactive "p")
-  (outline-open-topic 0 (> 0 arg)))
-;;;_   > outline-open-supertopic (arg)
-(defun outline-open-supertopic (arg)
-  "Open new topic header at shallower level than the current one.
-
-Negative universal arg means to open shallower, but place the new
-topic prior to the current one."
-
-  (interactive "p")
-  (outline-open-topic -1 (> 0 arg)))
-
-;;;_  - Outline Alteration
-;;;_   : Topic Modification
-;;;_    = outline-former-auto-filler
-(defvar outline-former-auto-filler nil
-  "Name of modal fill function being wrapped by outline-auto-fill.")
-;;;_    > outline-auto-fill ()
-(defun outline-auto-fill ()
-  "Outline-mode autofill function.
-
-Maintains outline hanging topic indentation if
-`outline-use-hanging-indents' is set."
-  (let ((fill-prefix (if outline-use-hanging-indents
-                         ;; Check for topic header indentation:
-                         (save-excursion
-                           (beginning-of-line)
-                           (if (looking-at outline-regexp)
-                               ;; ... construct indentation to account for
-                               ;; length of topic prefix:
-                               (make-string (progn (outline-end-of-prefix)
-                                                   (current-column))
-                                            ?\ ))))))
-    (if (or outline-former-auto-filler outline-use-hanging-indents)
-        (do-auto-fill))))
-;;;_    > outline-reindent-body (old-depth new-depth &optional number)
-(defun outline-reindent-body (old-depth new-depth &optional number)
-  "Reindent body lines which were indented at old-depth to new-depth.
-
-Optional arg NUMBER indicates numbering is being added, and it must
-be accommodated.
-
-Note that refill of indented paragraphs is not done."
-
-  (save-excursion
-    (outline-end-of-prefix)
-    (let* ((new-margin (current-column))
-	   excess old-indent-begin old-indent-end
-	   curr-ind
-	   ;; We want the column where the header-prefix text started
-	   ;; *before* the prefix was changed, so we infer it relative
-	   ;; to the new margin and the shift in depth:
-	   (old-margin (+ old-depth (- new-margin new-depth))))
-
-      ;; Process lines up to (but excluding) next topic header:
-      (outline-unprotected
-       (save-match-data
-         (while
-	     (and (re-search-forward "[\n\r]\\(\\s-*\\)"
-				     nil
-				     t)
-		  ;; Register the indent data, before we reset the
-		  ;; match data with a subsequent `looking-at':
-		  (setq old-indent-begin (match-beginning 1)
-			old-indent-end (match-end 1))
-		  (not (looking-at outline-regexp)))
-	   (if (> 0 (setq excess (- (current-column)
-				     old-margin)))
-	       ;; Text starts left of old margin - don't adjust:
-	       nil
-	     ;; Text was hanging at or right of old left margin -
-	     ;; reindent it, preserving its existing indentation
-	     ;; beyond the old margin:
-	     (delete-region old-indent-begin old-indent-end)
-	     (indent-to (+ new-margin excess)))))))))
-;;;_    > outline-rebullet-current-heading (arg)
-(defun outline-rebullet-current-heading (arg)
-  "Like non-interactive version `outline-rebullet-heading'.
-
-But \(only\) affects visible heading containing point.
-
-With repeat count, solicit for bullet."
-  (interactive "P")
-  (save-excursion (outline-back-to-current-heading)
-                  (outline-end-of-prefix)
-                  (outline-rebullet-heading (not arg)	;;; solicit
-                                            nil		;;; depth
-                                            nil		;;; number-control
-                                            nil		;;; index
-                                            t)		;;; do-successors
-                  )
-  )
-;;;_    > outline-rebullet-heading (&optional solicit ...)
-(defun outline-rebullet-heading (&optional solicit
-                                           new-depth
-                                           number-control
-                                           index
-                                           do-successors)
-
-  "Adjust bullet of current topic prefix.
-
-All args are optional.
-
-If SOLICIT is non-nil then the choice of bullet is solicited from
-user.  Otherwise the distinctiveness of the bullet or the topic
-depth determines it.
-
-Second arg DEPTH forces the topic prefix to that depth, regardless
-of the topics current depth.
-
-Third arg NUMBER-CONTROL can force the prefix to or away from
-numbered form.  It has effect only if `outline-numbered-bullet' is
-non-nil and soliciting was not explicitly invoked (via first arg).
-Its effect, numbering or denumbering, then depends on the setting
-of the forth arg, INDEX.
-
-If NUMBER-CONTROL is non-nil and forth arg INDEX is nil, then the
-prefix of the topic is forced to be non-numbered.  Null index and
-non-nil NUMBER-CONTROL forces denumbering.  Non-nil INDEX (and
-non-nil NUMBER-CONTROL) forces a numbered-prefix form.  If non-nil
-INDEX is a number, then that number is used for the numbered
-prefix.  Non-nil and non-number means that the index for the
-numbered prefix will be derived by outline-make-topic-prefix.
-
-Fifth arg DO-SUCCESSORS t means re-resolve count on succeeding
-siblings.
-
-Cf vars `outline-stylish-prefixes', `outline-old-style-prefixes',
-and `outline-numbered-bullet', which all affect the behavior of
-this function."
-
-  (let* ((current-depth (outline-depth))
-         (new-depth (or new-depth current-depth))
-         (mb outline-recent-prefix-beginning)
-         (me outline-recent-prefix-end)
-         (current-bullet (buffer-substring (- me 1) me))
-         (new-prefix (outline-make-topic-prefix current-bullet
-                                                nil
-                                                new-depth
-                                                solicit
-                                                number-control
-                                                index)))
-
-    ;; Is new one is identical to old?
-    (if (and (= current-depth new-depth)
-             (string= current-bullet
-                      (substring new-prefix (1- (length new-prefix)))))
-	;; Nothing to do:
-        t
-
-      ;; New prefix probably different from old:
-					; get rid of old one:
-      (outline-unprotected (delete-region mb me))
-      (goto-char mb)
-					; Dispense with number if
-					; numbered-bullet prefix:
-      (if (and outline-numbered-bullet
-               (string= outline-numbered-bullet current-bullet)
-               (looking-at "[0-9]+"))
-	  (outline-unprotected
-	   (delete-region (match-beginning 0)(match-end 0))))
-
-					; Put in new prefix:
-      (outline-unprotected (insert-string new-prefix))
-
-      ;; Reindent the body if elected and margin changed:
-      (if (and outline-reindent-bodies
-	       (not (= new-depth current-depth)))
-	  (outline-reindent-body current-depth new-depth))
-
-      ;; Recursively rectify successive siblings of orig topic if
-      ;; caller elected for it:
-      (if do-successors
-	  (save-excursion
-	    (while (outline-next-sibling new-depth nil)
-	      (setq index
-		    (cond ((numberp index) (1+ index))
-			  ((not number-control)  (outline-sibling-index))))
-	      (if (outline-numbered-type-prefix)
-		  (outline-rebullet-heading nil		;;; solicit
-					    new-depth	;;; new-depth
-					    number-control;;; number-control
-					    index	;;; index
-					    nil)))))	;;;(dont!)do-successors
-      )	; (if (and (= current-depth new-depth)...))
-    ) ; let* ((current-depth (outline-depth))...)
-  ) ; defun
-;;;_    > outline-rebullet-topic (arg)
-(defun outline-rebullet-topic (arg)
-  "Like outline-rebullet-topic-grunt, but start from topic visible at point.
-
-Descends into invisible as well as visible topics, however.
-
-With repeat count, shift topic depth by that amount."
-  (interactive "P")
-  (let ((start-col (current-column))
-        (was-eol (eolp)))
-    (save-excursion
-      ;; Normalize arg:
-      (cond ((null arg) (setq arg 0))
-            ((listp arg) (setq arg (car arg))))
-      ;; Fill the user in, in case we're shifting a big topic:
-      (if (not (zerop arg)) (message "Shifting..."))
-      (outline-back-to-current-heading)
-      (if (<= (+ (outline-recent-depth) arg) 0)
-          (error "Attempt to shift topic below level 1"))
-      (outline-rebullet-topic-grunt arg)
-      (if (not (zerop arg)) (message "Shifting... done.")))
-    (move-to-column (max 0 (+ start-col arg)))))
-;;;_     > outline-rebullet-topic-grunt (&optional relative-depth ...)
-(defun outline-rebullet-topic-grunt (&optional relative-depth
-                                               starting-depth
-                                               starting-point
-                                               index
-                                               do-successors)
-
-  "Rebullet the topic at point, visible or invisible, and all
-contained subtopics.  See outline-rebullet-heading for rebulleting
-behavior.
-
-All arguments are optional.
-
-First arg RELATIVE-DEPTH means to shift the depth of the entire
-topic that amount.
-
-The rest of the args are for internal recursive use by the function
-itself.  The are STARTING-DEPTH, STARTING-POINT, and INDEX."
-
-  (let* ((relative-depth (or relative-depth 0))
-         (new-depth (outline-depth))
-         (starting-depth (or starting-depth new-depth))
-         (on-starting-call  (null starting-point))
-         (index (or index
-                    ;; Leave index null on starting call, so rebullet-heading
-                    ;; calculates it at what might be new depth:
-                    (and (or (zerop relative-depth)
-                             (not on-starting-call))
-                         (outline-sibling-index))))
-         (moving-outwards (< 0 relative-depth))
-         (starting-point (or starting-point (point))))
-
-    ;; Sanity check for excessive promotion done only on starting call:
-    (and on-starting-call
-         moving-outwards
-         (> 0 (+ starting-depth relative-depth))
-         (error "Attempt to shift topic out beyond level 1."))	;;; ====>
-
-    (cond ((= starting-depth new-depth)
-           ;; We're at depth to work on this one:
-           (outline-rebullet-heading nil		;;; solicit
-                                     (+ starting-depth	;;; starting-depth
-                                        relative-depth)
-                                     nil		;;; number
-                                     index		;;; index
-                                     ;; Every contained topic will get hit,
-                                     ;; and we have to get to outside ones
-                                     ;; deliberately:
-                                     nil)		;;; do-successors
-           ;; ... and work on subsequent ones which are at greater depth:
-           (setq index 0)
-           (outline-next-heading)
-           (while (and (not (eobp))
-                       (< starting-depth (outline-recent-depth)))
-             (setq index (1+ index))
-             (outline-rebullet-topic-grunt relative-depth   ;;; relative-depth
-                                           (1+ starting-depth);;;starting-depth
-                                           starting-point   ;;; starting-point
-                                           index)))	    ;;; index
-
-          ((< starting-depth new-depth)
-           ;; Rare case - subtopic more than one level deeper than parent.
-           ;; Treat this one at an even deeper level:
-           (outline-rebullet-topic-grunt relative-depth   ;;; relative-depth
-                                         new-depth	  ;;; starting-depth
-                                         starting-point	  ;;; starting-point
-                                         index)))	  ;;; index
-
-    (if on-starting-call
-        (progn
-          ;; Rectify numbering of former siblings of the adjusted topic,
-          ;; if topic has changed depth
-          (if (or do-successors
-                  (and (not (zerop relative-depth))
-                       (or (= (outline-recent-depth) starting-depth)
-                           (= (outline-recent-depth) (+ starting-depth
-                                                        relative-depth)))))
-              (outline-rebullet-heading nil nil nil nil t))
-          ;; Now rectify numbering of new siblings of the adjusted topic,
-          ;; if depth has been changed:
-          (progn (goto-char starting-point)
-                 (if (not (zerop relative-depth))
-                     (outline-rebullet-heading nil nil nil nil t)))))
-    )
-  )
-;;;_    > outline-renumber-to-depth (&optional depth)
-(defun outline-renumber-to-depth (&optional depth)
-  "Renumber siblings at current depth.
-
-Affects superior topics if optional arg DEPTH is less than current depth.
-
-Returns final depth."
-
-  ;; Proceed by level, processing subsequent siblings on each,
-  ;; ascending until we get shallower than the start depth:
-
-  (let ((ascender (outline-depth)))
-    (while (and (not (eobp))
-		(outline-depth)
-                (>= (outline-recent-depth) depth)
-                (>= ascender depth))
-                                        ; Skip over all topics at
-                                        ; lesser depths, which can not
-                                        ; have been disturbed:
-      (while (and (not (eobp))
-		  (> (outline-recent-depth) ascender))
-        (outline-next-heading))
-                                        ; Prime ascender for ascension:
-      (setq ascender (1- (outline-recent-depth)))
-      (if (>= (outline-recent-depth) depth)
-          (outline-rebullet-heading nil	;;; solicit
-                                    nil	;;; depth
-                                    nil	;;; number-control
-                                    nil	;;; index
-                                    t))));;; do-successors
-  (outline-recent-depth))
-;;;_    > outline-number-siblings (&optional denumber)
-(defun outline-number-siblings (&optional denumber)
-  "Assign numbered topic prefix to this topic and its siblings.
-
-With universal argument, denumber - assign default bullet to this
-topic and its siblings.
-
-With repeated universal argument (`^U^U'), solicit bullet for each
-rebulleting each topic at this level."
-
-  (interactive "P")
-
-  (save-excursion
-    (outline-back-to-current-heading)
-    (outline-beginning-of-level)
-    (let ((depth (outline-recent-depth))
-	  (index (if (not denumber) 1))
-          (use-bullet (equal '(16) denumber))
-          (more t))
-      (while more
-        (outline-rebullet-heading use-bullet		;;; solicit
-                                  depth			;;; depth
-                                  t			;;; number-control
-                                  index			;;; index
-                                  nil)			;;; do-successors
-        (if index (setq index (1+ index)))
-        (setq more (outline-next-sibling depth nil))))))
-;;;_    > outline-shift-in (arg)
-(defun outline-shift-in (arg)
-  "Increase depth of current heading and any topics collapsed within it."
-  (interactive "p")
-  (outline-rebullet-topic arg))
-;;;_    > outline-shift-out (arg)
-(defun outline-shift-out (arg)
-  "Decrease depth of current heading and any topics collapsed within it."
-  (interactive "p")
-  (outline-rebullet-topic (* arg -1)))
-;;;_   : Surgery (kill-ring) functions with special provisions for outlines:
-;;;_    > outline-kill-line (&optional arg)
-(defun outline-kill-line (&optional arg)
-  "Kill line, adjusting subsequent lines suitably for outline mode."
-
-  (interactive "*P")
-  (if (not (and (outline-mode-p)		; active outline mode,
-		outline-numbered-bullet		; numbers may need adjustment,
-		(bolp)				; may be clipping topic head,
-		(looking-at outline-regexp)))	; are clipping topic head.
-      ;; Above conditions do not obtain - just do a regular kill:
-      (kill-line arg)
-    ;; Ah, have to watch out for adjustments:
-    (let* ((depth (outline-depth)))
-                                        ; Do the kill:
-      (kill-line arg)
-                                        ; Provide some feedback:
-      (sit-for 0)
-      (save-excursion
-                                        ; Start with the topic
-                                        ; following killed line:
-        (if (not (looking-at outline-regexp))
-            (outline-next-heading))
-        (outline-renumber-to-depth depth)))))
-;;;_    > outline-kill-topic ()
-(defun outline-kill-topic ()
-  "Kill topic together with subtopics.
-
-Leaves primary topic's trailing vertical whitespace, if any."
-
-  ;; Some finagling is done to make complex topic kills appear faster
-  ;; than they actually are.  A redisplay is performed immediately
-  ;; after the region is disposed of, though the renumbering process
-  ;; has yet to be performed.  This means that there may appear to be
-  ;; a lag *after* the kill has been performed.
-
-  (interactive)
-  (let* ((beg (prog1 (outline-back-to-current-heading)(beginning-of-line)))
-         (depth (outline-recent-depth)))
-    (outline-end-of-current-subtree)
-    (if (not (eobp))
-	(if (or (not (looking-at "^$"))
-		;; A blank line - cut it with this topic *unless* this
-		;; is the last topic at this level, in which case
-		;; we'll leave the blank line as part of the
-		;; containing topic:
-		(save-excursion
-		  (and (outline-next-heading)
-		       (>= (outline-recent-depth) depth))))
-	    (forward-char 1)))
-
-    (kill-region beg (point))
-    (sit-for 0)
-    (save-excursion
-      (outline-renumber-to-depth depth))))
-;;;_    > outline-yank-processing ()
-(defun outline-yank-processing (&optional arg)
-
-  "Incidental outline-specific business to be done just after text yanks.
-
-Does depth adjustment of yanked topics, when:
-
-1 the stuff being yanked starts with a valid outline header prefix, and
-2 it is being yanked at the end of a line which consists of only a valid
-     topic prefix.
-
-Also, adjusts numbering of subsequent siblings when appropriate.
-
-Depth adjustment alters the depth of all the topics being yanked
-the amount it takes to make the first topic have the depth of the
-header into which it's being yanked.
-
-The point is left in front of yanked, adjusted topics, rather than
-at the end (and vice-versa with the mark).  Non-adjusted yanks,
-however, are left exactly like normal, non-outline-specific yanks."
-
-  (interactive "*P")
-					; Get to beginning, leaving
-					; region around subject:
-  (if (< (mark-marker) (point))
-      (exchange-point-and-mark))
-  (let* ((subj-beg (point))
-	 (subj-end (mark-marker))
-	 ;; `resituate' if yanking an entire topic into topic header:
-	 (resituate (and (outline-e-o-prefix-p)
-			 (looking-at (concat "\\(" outline-regexp "\\)"))
-			 (outline-prefix-data (match-beginning 1)
-					      (match-end 1))))
-	 ;; `rectify-numbering' if resituating (where several topics may
-	 ;; be resituating) or yanking a topic into a topic slot (bol):
-	 (rectify-numbering (or resituate
-				(and (bolp) (looking-at outline-regexp)))))
-    (if resituate
-                                        ; The yanked stuff is a topic:
-	(let* ((prefix-len (- (match-end 1) subj-beg))
-	       (subj-depth (outline-recent-depth))
-	       (prefix-bullet (outline-recent-bullet))
-	       (adjust-to-depth
-		;; Nil if adjustment unnecessary, otherwise depth to which
-		;; adjustment should be made:
-		(save-excursion
-		  (and (goto-char subj-end)
-		       (eolp)
-		       (goto-char subj-beg)
-		       (and (looking-at outline-regexp)
-			    (progn
-			      (beginning-of-line)
-			      (not (= (point) subj-beg)))
-			    (looking-at outline-regexp)
-			    (outline-prefix-data (match-beginning 0)
-						 (match-end 0)))
-		       (outline-recent-depth))))
-	       done
-	       (more t))
-	  (setq rectify-numbering outline-numbered-bullet)
-	  (if adjust-to-depth
-                                        ; Do the adjustment:
-	      (progn
-		(message "... yanking") (sit-for 0)
-		(save-restriction
-		  (narrow-to-region subj-beg subj-end)
-                                        ; Trim off excessive blank
-                                        ; line at end, if any:
-		  (goto-char (point-max))
-		  (if (looking-at "^$")
-		      (outline-unprotected (delete-char -1)))
-                                        ; Work backwards, with each
-                                        ; shallowest level,
-                                        ; successively excluding the
-                                        ; last processed topic from
-                                        ; the narrow region:
-		  (while more
-		    (outline-back-to-current-heading)
-                                        ; go as high as we can in each bunch:
-		    (while (outline-ascend-to-depth (1- (outline-depth))))
-		    (save-excursion
-		      (outline-rebullet-topic-grunt (- adjust-to-depth
-						       subj-depth))
-		      (outline-depth))
-		    (if (setq more (not (bobp)))
-			(progn (widen)
-			       (forward-char -1)
-			       (narrow-to-region subj-beg (point))))))
-		(message "")
-		;; Preserve new bullet if it's a distinctive one, otherwise
-		;; use old one:
-		(if (string-match (regexp-quote prefix-bullet)
-				  outline-distinctive-bullets-string)
-                                        ; Delete from bullet of old to
-                                        ; before bullet of new:
-		    (progn
-		      (beginning-of-line)
-		      (delete-region (point) subj-beg)
-		      (set-marker (mark-marker) subj-end)
-		      (goto-char subj-beg)
-		      (outline-end-of-prefix))
-                                        ; Delete base subj prefix,
-                                        ; leaving old one:
-		  (delete-region (point) (+ (point)
-					    prefix-len
-					    (- adjust-to-depth subj-depth)))
-                                        ; and delete residual subj
-                                        ; prefix digits and space:
-		  (while (looking-at "[0-9]") (delete-char 1))
-		  (if (looking-at " ") (delete-char 1))))
-	    (exchange-point-and-mark))))
-    (if rectify-numbering
-	(progn
-	  (save-excursion
-                                        ; Give some preliminary feedback:
-	    (message "... reconciling numbers") (sit-for 0)
-                                        ; ... and renumber, in case necessary:
-	    (goto-char subj-beg)
-	    (if (outline-goto-prefix)
-		(outline-rebullet-heading nil	;;; solicit
-					  (outline-depth) ;;; depth
-					  nil	;;; number-control
-					  nil	;;; index
-					  t))
-	    (message ""))))
-    (if (not resituate)
-      (exchange-point-and-mark))))
-;;;_    > outline-yank (&optional arg)
-(defun outline-yank (&optional arg)
-  "Outline-mode yank, with depth and numbering adjustment of yanked topics.
-
-Non-topic yanks work no differently than normal yanks.
-
-If a topic is being yanked into a bare topic prefix, the depth of the
-yanked topic is adjusted to the depth of the topic prefix.
-
-  1 we're yanking in an outline-mode buffer
-  2 the stuff being yanked starts with a valid outline header prefix, and
-  3 it is being yanked at the end of a line which consists of only a valid
-    topic prefix.
-
-If these conditions hold then the depth of the yanked topics are all
-adjusted the amount it takes to make the first one at the depth of the
-header into which it's being yanked.
-
-The point is left in front of yanked, adjusted topics, rather than
-at the end (and vice-versa with the mark).  Non-adjusted yanks,
-however, (ones that don't qualify for adjustment) are handled
-exactly like normal yanks.
-
-Numbering of yanked topics, and the successive siblings at the depth
-into which they're being yanked, is adjusted.
-
-Outline-yank-pop works with outline-yank just like normal yank-pop
-works with normal yank in non-outline buffers."
-
-  (interactive "*P")
-  (setq this-command 'yank)
-  (yank arg)
-  (if (outline-mode-p)
-      (outline-yank-processing)))
-;;;_    > outline-yank-pop (&optional arg)
-(defun outline-yank-pop (&optional arg)
-  "Yank-pop like outline-yank when popping to bare outline prefixes.
-
-Adapts level of popped topics to level of fresh prefix.
-
-Note - prefix changes to distinctive bullets will stick, if followed
-by pops to non-distinctive yanks.  Bug..."
-
-  (interactive "*p")
-  (setq this-command 'yank)
-  (yank-pop arg)
-  (if (outline-mode-p)
-      (outline-yank-processing)))
-
-;;;_  - Specialty bullet functions
-;;;_   : File Cross references
-;;;_    > outline-resolve-xref ()
-(defun outline-resolve-xref ()
-  "Pop to file associated with current heading, if it has an xref bullet.
-
-\(Works according to setting of `outline-file-xref-bullet')."
-  (interactive)
-  (if (not outline-file-xref-bullet)
-      (error
-       "outline cross references disabled - no `outline-file-xref-bullet'")
-    (if (not (string= (outline-current-bullet) outline-file-xref-bullet))
-        (error "current heading lacks cross-reference bullet `%s'"
-               outline-file-xref-bullet)
-      (let (file-name)
-        (save-excursion
-          (let* ((text-start outline-recent-prefix-end)
-                 (heading-end (progn (end-of-line) (point))))
-            (goto-char text-start)
-            (setq file-name
-                  (if (re-search-forward "\\s-\\(\\S-*\\)" heading-end t)
-                      (buffer-substring (match-beginning 1) (match-end 1))))))
-        (setq file-name
-              (if (not (= (aref file-name 0) ?:))
-                  (expand-file-name file-name)
-                                        ; A registry-files ref, strip the `:'
-                                        ; and try to follow it:
-                (let ((reg-ref (reference-registered-file
-                                (substring file-name 1) nil t)))
-                  (if reg-ref (car (cdr reg-ref))))))
-        (if (or (file-exists-p file-name)
-                (if (file-writable-p file-name)
-                    (y-or-n-p (format "%s not there, create one? "
-                                      file-name))
-                  (error "%s not found and can't be created" file-name)))
-            (condition-case failure
-                (find-file-other-window file-name)
-              (error failure))
-          (error "%s not found" file-name))
-        )
-      )
-    )
-  )
-
-;;;_ #6 Exposure Control and Processing
-
-;;;_  - Fundamental
-;;;_   > outline-flag-region (from to flag)
-(defmacro outline-flag-region (from to flag)
-  "Hide or show lines from FROM to TO, via emacs selective-display FLAG char.
-Ie, text following flag C-m \(carriage-return) is hidden until the
-next C-j (newline) char.
-
-Returns the endpoint of the region."
-  (` (let ((buffer-read-only nil)
-	   (outline-override-protect t))
-       (subst-char-in-region (, from) (, to)
-			     (if (= (, flag) ?\n) ?\r ?\n)
-			     (, flag) t))))
-;;;_   > outline-flag-current-subtree (flag)
-(defun outline-flag-current-subtree (flag)
-  "Hide or show subtree of currently-visible topic.
-
-See `outline-flag-region' for more details."
-
-  (save-excursion
-    (outline-back-to-current-heading)
-    (outline-flag-region (point)
-			 (progn (outline-end-of-current-subtree) (1- (point)))
-			 flag)))
-
-;;;_  - Mapping and processing of topics
-;;;_   " See also chart functions, in navigation
-;;;_   > outline-listify-exposed (&optional start end)
-(defun outline-listify-exposed (&optional start end)
-
-  "Produce a list representing exposed topics in current region.
-
-This list can then be used by `outline-process-exposed' to manipulate
-the subject region.
-
-List is composed of elements that may themselves be lists representing
-exposed components in subtopic.
-
-Each component list contains:
- - a number representing the depth of the topic,
- - a string representing the header-prefix (ref. `outline-header-prefix'),
- - a string representing the bullet character,
- - and a series of strings, each containing one line of the exposed
-   portion of the topic entry."
-
-  (interactive "r")
-  (save-excursion
-    (let* (strings pad result depth bullet beg next done) ; State vars.
-      (goto-char start)
-      (beginning-of-line)
-      (if (not (outline-goto-prefix))	; Get initial position within a topic:
-	  (outline-next-visible-heading 1))
-      (while (and (not done)
-		  (not (eobp))		; Loop until we've covered the region.
-		  (not (> (point) end)))
-	(setq depth (outline-recent-depth) 	; Current topics' depth,
-	      bullet (outline-recent-bullet)	; ... bullet,
-	      beg (progn (outline-end-of-prefix t) (point))) ; and beginning.
-	(setq done			; The boundary for the current topic:
-	      (not (outline-next-visible-heading 1)))
-	(beginning-of-line)
-	(setq next (point))
-	(goto-char beg)
-	(setq strings nil)
-	(while (> next (point))		; Get all the exposed text in
-	  (setq strings
-		(cons (buffer-substring
-		       beg
-					;To hidden text or end of line:
-		       (progn
-			 (search-forward "\r"
-					 (save-excursion (end-of-line)
-							 (point))
-					 1)
-			 (if (= (preceding-char) ?\r)
-			     (1- (point))
-			   (point))))
-		      strings))
-	  (if (< (point) next)		; Resume from after hid text, if any.
-	      (forward-line 1))
-	  (setq beg (point)))
-	;; Accumulate list for this topic:
-	(setq result
-	      (cons (append (list depth
-				  outline-header-prefix
-				  bullet)
-			    (nreverse strings))
-		    result)))
-      ;; Put the list with first at front, to last at back:
-      (nreverse result))))
-;;;_   > outline-process-exposed (arg &optional tobuf)
-(defun outline-process-exposed (&optional func from to frombuf tobuf)
-  "Map function on exposed parts of current topic; results to another buffer.
-
-Apply FUNCTION \(default 'outline-insert-listified) to exposed
-portions FROM position TO position \(default region, or the entire
-buffer if no region active) in buffer FROMBUF \(default current
-buffer) to buffer TOBUF \(default is buffer named like frombuf but
-with \"*\" prepended and \" exposed*\" appended).
-
-The function must as its arguments the elements of the list
-representations of topic entries produced by outline-listify-exposed."
-
-					; Resolve arguments,
-					; defaulting if necessary:
-  (if (not func) (setq func 'outline-insert-listified))
-  (if (not (and from to))
-      (if mark-active
-	  (setq from (region-beginning) to (region-end))
-	(setq from (point-min) to (point-max))))
-  (if frombuf
-      (if (not (bufferp frombuf))
-	  ;; Specified but not a buffer - get it:
-	  (let ((got (get-buffer frombuf)))
-	    (if (not got)
-		(error "outline-process-exposed: source buffer %s not found."
-		       frombuf)
-	      (setq frombuf got))))
-    ;; not specified - default it:
-    (setq frombuf (current-buffer)))
-  (if tobuf
-      (if (not (bufferp tobuf))
-	  (setq tobuf (get-buffer-create tobuf)))
-    ;; not specified - default it:
-    (setq tobuf (concat "*" (buffer-name frombuf) " exposed*")))
-
-  (let* ((listified (progn (set-buffer frombuf)
-			   (outline-listify-exposed from to)))
-	 (prefix outline-header-prefix)	; ... as set in frombuf.
-	 curr)
-    (set-buffer tobuf)
-    (while listified
-      (setq curr (car listified))
-      (setq listified (cdr listified))
-      (apply func (list (car curr)			; depth
-			(car (cdr curr))		; header-prefix
-			(car (cdr (cdr curr)))		; bullet
-			(cdr (cdr (cdr curr))))))	; list of text lines
-    (pop-to-buffer tobuf)))
-
-;;;_  - Topic-specific
-;;;_   > outline-show-entry ()
-; outline-show-entry basically for isearch dynamic exposure, as is...
-(defun outline-show-entry ()
-  "Like `outline-show-current-entry', reveals entries nested in hidden topics.
-
-This is a way to give restricted peek at a concealed locality without the
-expense of exposing its context, but can leave the outline with aberrant
-exposure.  outline-hide-current-entry-completely or outline-show-offshoot
-should be used after the peek to rectify the exposure."
-
-  (interactive)
-  (save-excursion
-    (outline-goto-prefix)
-    (outline-flag-region (if (bobp) (point) (1- (point)))
-                         (or (outline-pre-next-preface) (point))
-			 ?\n)))
-;;;_   > outline-show-children (&optional level strict)
-(defun outline-show-children (&optional level strict)
-
-  "If point is visible, show all direct subheadings of this heading.
-
-Otherwise, do outline-show-to-offshoot, and then show subheadings.
-
-Optional LEVEL specifies how many levels below the current level
-should be shown, or all levels if t.  Default is 1.
-
-Optional STRICT means don't resort to -show-to-offshoot, no matter
-what.  This is basically so -show-to-offshoot, which is called by
-this function, can employ the pure offspring-revealing capabilities of
-it.
-
-Returns point at end of subtree that was opened, if any.  (May get a
-point of non-opened subtree?)"
-
-  (interactive "p")
-  (let (max-pos)
-    (if (and (not strict)
-	     (outline-hidden-p))
-
-	(progn (outline-show-to-offshoot) ; Point's concealed, open to
-					  ; expose it.
-	       ;; Then recurse, but with "strict" set so we don't
-	       ;; infinite regress:
-	       (setq max-pos (outline-show-children level t)))
-
-      (save-excursion
-	(save-restriction
-	  (let* ((start-pt (point))
-		 (chart (outline-chart-subtree (or level 1)))
-		 (to-reveal (outline-chart-to-reveal chart (or level 1))))
-	    (goto-char start-pt)
-	    (if (and strict (= (preceding-char) ?\r))
-		;; Concealed root would already have been taken care of,
-		;; unless strict was set.
-		(outline-flag-region (point) (outline-snug-back) ?\n))
-	    (while to-reveal
-	      (goto-char (car to-reveal))
-	      (outline-flag-region (point) (outline-snug-back) ?\n)
-	      (setq to-reveal (cdr to-reveal)))))))))
-;;;_   x outline-show-current-children (&optional level strict)
-(defun outline-show-current-children (&optional level strict)
-  "This command was misnamed, use `outline-show-children' instead.
-
-\(The \"current\" in the name is supposed to imply that it works on
-the visible topic containing point, while it really works with respect
-to the most immediate topic, concealed or not.  I'll leave this old
-name around for a bit, but i'll soon activate an annoying message to
-warn people about the change, and then deprecate this alias."
-
-  (interactive "p")
-  ;;(beep)
-  ;;(message (format "Use `%s' instead of `%s' (%s)."
-  ;;		   "outline-show-children"
-  ;;		   "outline-show-current-children"
-  ;;		   (buffer-name (current-buffer))))
-  (outline-show-children level strict))
-;;;_   > outline-hide-point-reconcile ()
-(defun outline-hide-reconcile ()
-  "Like `outline-hide-current-entry'; hides completely if within hidden region.
-
-Specifically intended for aberrant exposure states, like entries that were
-exposed by outline-show-entry but are within otherwise concealed regions."
-  (interactive)
-  (save-excursion
-    (outline-goto-prefix)
-    (outline-flag-region (if (not (bobp)) (1- (point)) (point))
-                         (progn (outline-pre-next-preface)
-                                (if (= ?\r (following-char))
-                                    (point)
-                                  (1- (point))))
-                         ?\r)))
-;;;_   > outline-show-to-offshoot ()
-(defun outline-show-to-offshoot ()
-  "Like outline-show-entry, but reveals opens all concealed ancestors, as well.
-
-As with outline-hide-current-entry-completely, useful for rectifying
-aberrant exposure states produced by outline-show-entry."
-
-  (interactive)
-  (save-excursion
-    (let ((orig-pt (point))
-	  (orig-pref (outline-goto-prefix))
-	  (last-at (point))
-	  bag-it)
-      (while (or bag-it (= (preceding-char) ?\r))
-	(beginning-of-line)
-	(if (= last-at (setq last-at (point)))
-	    ;; Oops, we're not making any progress!  Show the current
-	    ;; topic completely, and bag this try.
-	    (progn (beginning-of-line)
-		   (outline-show-current-subtree)
-		   (goto-char orig-pt)
-		   (setq bag-it t)
-		   (beep)
-		   (message "%s: %s"
-			    "outline-show-to-offshoot: "
-			    "Aberrant nesting encountered.")))
-	(outline-show-children)
-	(goto-char orig-pref))
-      (goto-char orig-pt)))
-  (if (outline-hidden-p)
-      (outline-show-entry)))
-;;;_   > outline-hide-current-entry ()
-(defun outline-hide-current-entry ()
-  "Hide the body directly following this heading."
-  (interactive)
-  (outline-back-to-current-heading)
-  (save-excursion
-   (outline-flag-region (point)
-                        (progn (outline-end-of-current-entry) (point))
-                        ?\^M)))
-;;;_   > outline-show-current-entry (&optional arg)
-(defun outline-show-current-entry (&optional arg)
-
-  "Show body following current heading, or hide the entry if repeat count."
-
-  (interactive "P")
-  (if arg
-      (outline-hide-current-entry)
-    (save-excursion
-      (outline-flag-region (point)
-			   (progn (outline-end-of-current-entry) (point))
-			   ?\n))))
-;;;_   > outline-hide-current-entry-completely ()
-; ... outline-hide-current-entry-completely also for isearch dynamic exposure:
-(defun outline-hide-current-entry-completely ()
-  "Like outline-hide-current-entry, but conceal topic completely.
-
-Specifically intended for aberrant exposure states, like entries that were
-exposed by outline-show-entry but are within otherwise concealed regions."
-  (interactive)
-  (save-excursion
-    (outline-goto-prefix)
-    (outline-flag-region (if (not (bobp)) (1- (point)) (point))
-                         (progn (outline-pre-next-preface)
-                                (if (= ?\r (following-char))
-                                    (point)
-                                  (1- (point))))
-                         ?\r)))
-;;;_   > outline-show-current-subtree (&optional arg)
-(defun outline-show-current-subtree (&optional arg)
-  "Show everything within the current topic.  With a repeat-count,
-expose this topic and its siblings."
-  (interactive "P")
-  (save-excursion
-    (if (<= (outline-current-depth) 0)
-	;; Outside any topics - try to get to the first:
-	(if (not (outline-next-heading))
-	    (error "No topics.")
-	  ;; got to first, outermost topic - set to expose it and siblings:
-	  (message "Above outermost topic - exposing all.")
-	  (outline-flag-region (point-min)(point-max) ?\n))
-      (if (not arg)
-	  (outline-flag-current-subtree ?\n)
-	(outline-beginning-of-level)
-	(outline-expose-topic '(* :))))))
-;;;_   > outline-hide-current-subtree (&optional just-close)
-(defun outline-hide-current-subtree (&optional just-close)
-  "Close the current topic, or containing topic if this one is already closed.
-
-If this topic is closed and it's a top level topic, close this topic
-and its siblings.
-
-If optional arg JUST-CLOSE is non-nil, do not treat the parent or
-siblings, even if the target topic is already closed."
-
-  (interactive)
-  (let ((from (point))
-	(orig-eol (progn (end-of-line)
-			 (if (not (outline-goto-prefix))
-			     (error "No topics found.")
-			   (end-of-line)(point)))))
-    (outline-flag-current-subtree ?\^M)
-    (goto-char from)
-    (if (and (= orig-eol (progn (goto-char orig-eol)
-				(end-of-line)
-				(point)))
-	     (not just-close)
-             ;; Structure didn't change - try hiding current level:
-	     (goto-char from)
-	     (if (outline-up-current-level 1 t)
-		 t
-	       (goto-char 0)
-	       (let ((msg
-		      "Top-level topic already closed - closing siblings..."))
-		 (message msg)
-		 (outline-expose-topic '(0 :))
-		 (message (concat msg "  Done.")))
-	       nil)
-	     (/= (outline-recent-depth) 0))
-	(outline-hide-current-subtree))
-      (goto-char from)))
-;;;_   > outline-show-current-branches ()
-(defun outline-show-current-branches ()
-  "Show all subheadings of this heading, but not their bodies."
-  (interactive)
-  (beginning-of-line)
-  (outline-show-children t))
-;;;_   > outline-hide-current-leaves ()
-(defun outline-hide-current-leaves ()
-  "Hide the bodies of the current topic and all its offspring."
-  (interactive)
-  (outline-back-to-current-heading)
-  (outline-hide-region-body (point) (progn (outline-end-of-current-subtree)
-                                           (point))))
-
-;;;_  - Region and beyond
-;;;_   > outline-show-all ()
-(defun outline-show-all ()
-  "Show all of the text in the buffer."
-  (interactive)
-  (message "Exposing entire buffer...")
-  (outline-flag-region (point-min) (point-max) ?\n)
-  (message "Exposing entire buffer...  Done."))
-;;;_   > outline-hide-bodies ()
-(defun outline-hide-bodies ()
-  "Hide all of buffer except headings."
-  (interactive)
-  (outline-hide-region-body (point-min) (point-max)))
-;;;_   > outline-hide-region-body (start end)
-(defun outline-hide-region-body (start end)
-  "Hide all body lines in the region, but not headings."
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char (point-min))
-      (while (not (eobp))
-	(outline-flag-region (point)
-                             (progn (outline-pre-next-preface) (point)) ?\^M)
-	(if (not (eobp))
-	    (forward-char
-	     (if (looking-at "[\n\r][\n\r]")
-		 2 1)))))))
-
-;;;_   > outline-expose-topic (spec)
-(defun outline-expose-topic (spec)
-  "Apply exposure specs to successive outline topic items.
-
-Use the more convenient frontend, `outline-new-exposure', if you don't
-need evaluation of the arguments, or even better, the `outline-layout'
-variable-keyed mode-activation/auto-exposure feature of allout outline
-mode.  See the respective documentation strings for more details.
-
-Cursor is left at start position.
-
-SPEC is either a number or a list.
-
-Successive specs on a list are applied to successive sibling topics.
-
-A simple spec \(either a number, one of a few symbols, or the null
-list) dictates the exposure for the corresponding topic.
-
-Non-null lists recursively designate exposure specs for respective
-subtopics of the current topic.
-
-The `:' repeat spec is used to specify exposure for any number of
-successive siblings, up to the trailing ones for which there are
-explicit specs following the `:'.
-
-Simple (numeric and null-list) specs are interpreted as follows:
-
- Numbers indicate the relative depth to open the corresponding topic.
-     - negative numbers force the topic to be closed before opening to the
-       absolute value of the number, so all siblings are open only to
-       that level.
-     - positive numbers open to the relative depth indicated by the
-       number, but do not force already opened subtopics to be closed.
-     - 0 means to close topic - hide all offspring.
-  :  - `repeat'
-       apply prior element to all siblings at current level, *up to*
-       those siblings that would be covered by specs following the `:'
-       on the list.  Ie, apply to all topics at level but the last
-       ones.  \(Only first of multiple colons at same level is
-       respected - subsequent ones are discarded.)
-  *  - completely opens the topic, including bodies.
-  +  - shows all the sub headers, but not the bodies
-  -  - exposes the body of the corresponding topic.
-
-Examples:
-\(outline-expose-topic '(-1 : 0))
-	Close this and all following topics at current level, exposing
-	only their immediate children, but close down the last topic
-	at this current level completely.
-\(outline-expose-topic '(-1 () : 1 0))
-	Close current topic so only the immediate subtopics are shown;
-	show the children in the second to last topic, and completely
-	close the last one.
-\(outline-expose-topic '(-2 : -1 *))
-        Expose children and grandchildren of all topics at current
-	level except the last two; expose children of the second to
-	last and completely open the last one."
-
-  (interactive "xExposure spec: ")
-  (if (not (listp spec))
-      nil
-    (let ((depth (outline-depth))
-	  (max-pos 0)
-	  prev-elem curr-elem
-	  stay done
-	  snug-back
-	  )
-      (while spec
-	(setq prev-elem curr-elem
-	      curr-elem (car spec)
-	      spec (cdr spec))
-	(cond				; Do current element:
-	 ((null curr-elem) nil)
-	 ((symbolp curr-elem)
-	  (cond ((eq curr-elem '*) (outline-show-current-subtree)
-		 (if (> outline-recent-end-of-subtree max-pos)
-		     (setq max-pos outline-recent-end-of-subtree)))
-		((eq curr-elem '+) (outline-show-current-branches)
-		 (if (> outline-recent-end-of-subtree max-pos)
-		     (setq max-pos outline-recent-end-of-subtree)))
-		((eq curr-elem '-) (outline-show-current-entry))
-		((eq curr-elem ':)
-		 (setq stay t)
-		 ;; Expand the `repeat' spec to an explicit version,
-		 ;; w.r.t. remaining siblings:
-		 (let ((residue	   ; = # of sibs not covered by remaining spec
-			;; Dang - could be nice to make use of the chart, sigh:
-			(- (length (outline-chart-siblings))
-			   (length spec))))
-		   (if (< 0 residue)
-		       ;; Some residue - cover it with prev-elem:
-		       (setq spec (append (make-list residue prev-elem)
-					  spec)))))))
-	 ((numberp curr-elem)
-	  (if (and (>= 0 curr-elem) (outline-visible-p))
-	      (save-excursion (outline-hide-current-subtree t)
-			      (if (> 0 curr-elem)
-				  nil
-				(if (> outline-recent-end-of-subtree max-pos)
-				    (setq max-pos
-					  outline-recent-end-of-subtree)))))
-	  (if (> (abs curr-elem) 0)
-	      (progn (outline-show-children (abs curr-elem))
-		     (if (> outline-recent-end-of-subtree max-pos)
-			 (setq max-pos outline-recent-end-of-subtree)))))
-	  ((listp curr-elem)
-	   (if (outline-descend-to-depth (1+ depth))
-	       (let ((got (outline-expose-topic curr-elem)))
-		 (if (and got (> got max-pos)) (setq max-pos got))))))
-	(cond (stay (setq stay nil))
-	      ((listp (car spec)) nil)
-	      ((> max-pos (point))
-	       ;; Capitalize on max-pos state to get us nearer next sibling:
-	       (progn (goto-char (min (point-max) max-pos))
-		      (outline-next-heading)))
-	      ((outline-next-sibling depth))))
-      max-pos)))
-;;;_   > outline-old-expose-topic (spec &rest followers)
-(defun outline-old-expose-topic (spec &rest followers)
-
-  "Deprecated.  Use outline-expose-topic \(with different schema
-format\) instead.
-
-Dictate wholesale exposure scheme for current topic, according to SPEC.
-
-SPEC is either a number or a list.  Optional successive args
-dictate exposure for subsequent siblings of current topic.
-
-A simple spec (either a number, a special symbol, or the null list)
-dictates the overall exposure for a topic.  Non null lists are
-composite specs whose first element dictates the overall exposure for
-a topic, with the subsequent elements in the list interpreted as specs
-that dictate the exposure for the successive offspring of the topic.
-
-Simple (numeric and null-list) specs are interpreted as follows:
-
- - Numbers indicate the relative depth to open the corresponding topic:
-  - negative numbers force the topic to be close before opening to the
-    absolute value of the number.
-  - positive numbers just open to the relative depth indicated by the number.
-  - 0 just closes
- - `*' completely opens the topic, including bodies.
- - `+' shows all the sub headers, but not the bodies
- - `-' exposes the body and immediate offspring of the corresponding topic.
-
-If the spec is a list, the first element must be a number, which
-dictates the exposure depth of the topic as a whole.  Subsequent
-elements of the list are nested SPECs, dictating the specific exposure
-for the corresponding offspring of the topic.
-
-Optional FOLLOWER arguments dictate exposure for succeeding siblings."
-
-  (interactive "xExposure spec: ")
-  (let ((depth (outline-current-depth))
-	done
-	max-pos)
-    (cond ((null spec) nil)
-	  ((symbolp spec)
-	   (if (eq spec '*) (outline-show-current-subtree))
-	   (if (eq spec '+) (outline-show-current-branches))
-	   (if (eq spec '-) (outline-show-current-entry)))
-	  ((numberp spec)
-	   (if (>= 0 spec)
-	       (save-excursion (outline-hide-current-subtree t)
-			       (end-of-line)
-			       (if (or (not max-pos)
-				       (> (point) max-pos))
-				   (setq max-pos (point)))
-			       (if (> 0 spec)
-				   (setq spec (* -1 spec)))))
-	   (if (> spec 0)
-	     (outline-show-children spec)))
-	  ((listp spec)
-	   ;(let ((got (outline-old-expose-topic (car spec))))
-	   ;  (if (and got (or (not max-pos) (> got max-pos)))
-	   ;	 (setq max-pos got)))
-	   (let ((new-depth  (+ (outline-current-depth) 1))
-		 got)
-	     (setq max-pos (outline-old-expose-topic (car spec)))
-	     (setq spec (cdr spec))
-	     (if (and spec
-		      (outline-descend-to-depth new-depth)
-		      (not (outline-hidden-p)))
-		 (progn (setq got (apply 'outline-old-expose-topic spec))
-			(if (and got (or (not max-pos) (> got max-pos)))
-			    (setq max-pos got)))))))
-    (while (and followers
-		(progn (if (and max-pos (< (point) max-pos))
-			   (progn (goto-char max-pos)
-				  (setq max-pos nil)))
-		       (end-of-line)
-		       (outline-next-sibling depth)))
-      (outline-old-expose-topic (car followers))
-      (setq followers (cdr followers)))
-    max-pos))
-;;;_   > outline-new-exposure '()
-(defmacro outline-new-exposure (&rest spec)
-  "Literal frontend for `outline-expose-topic', doesn't evaluate arguments.
-Some arguments that would need to be quoted in outline-expose-topic
-need not be quoted in outline-new-exposure.
-
-Cursor is left at start position.
-
-Use this instead of obsolete `outline-exposure'.
-
-Examples:
-\(outline-exposure (-1 () () () 1) 0)
-	Close current topic at current level so only the immediate
-	subtopics are shown, except also show the children of the
-	third subtopic; and close the next topic at the current level.
-\(outline-exposure : -1 0)
-	Close all topics at current level to expose only their
-	immediate children, except for the last topic at the current
-	level, in which even its immediate children are hidden.
-\(outline-exposure -2 : -1 *)
-        Expose children and grandchildren of first topic at current
-	level, and expose children of subsequent topics at current
-	level *except* for the last, which should be opened completely."
-  (list 'save-excursion
-	'(if (not (or (outline-goto-prefix)
-		      (outline-next-heading)))
-	     (error "outline-new-exposure: Can't find any outline topics."))
-	(list 'outline-expose-topic (list 'quote spec))))
-;;;_   > outline-exposure '()
-(defmacro outline-exposure (&rest spec)
-  "Being deprecated - use more recent `outline-new-exposure' instead.
-
-Literal frontend for `outline-old-expose-topic', doesn't evaluate arguments
-and retains start position."
-  (list 'save-excursion
-	'(if (not (or (outline-goto-prefix)
-		      (outline-next-heading)))
-	     (error "Can't find any outline topics."))
-	(cons 'outline-old-expose-topic
-	      (mapcar '(lambda (x) (list 'quote x)) spec))))
-
-;;;_ #7 ISearch with Dynamic Exposure
-;;;_  = outline-search-reconceal
-(defvar outline-search-reconceal nil
-  "Track whether current search match was concealed outside of search.
-
-The value is the location of the match, if it was concealed, regular
-if the entire topic was concealed, in a list if the entry was concealed.")
-;;;_  = outline-search-quitting
-(defconst outline-search-quitting nil
-  "Distinguishes isearch conclusion and cancellation.
-
-Used by isearch-terminate/outline-provisions and
-isearch-done/outline-provisions")
-
-
-;;;_  > outline-enwrap-isearch ()
-(defun outline-enwrap-isearch ()
-  "Impose outline-mode isearch-mode wrappers for dynamic exposure in isearch.
-
-Isearch progressively exposes and reconceals hidden topics when
-working in outline mode, but works normally elsewhere.
-
-The function checks to ensure that the rebindings are done only once."
-
-                                        ; Should isearch-mode be employed,
-  (if (or (not outline-enwrap-isearch-mode)
-                                        ; or are preparations already done?
-          (fboundp 'real-isearch-terminate))
-
-      ;; ... no - skip this all:
-      nil
-
-    ;; ... yes:
-
-                                        ; Ensure load of isearch-mode:
-    (if (or (and (fboundp 'isearch-mode)
-                 (fboundp 'isearch-quote-char))
-            (condition-case error
-                (load-library outline-enwrap-isearch-mode)
-              (file-error (message "Skipping isearch-mode provisions - %s '%s'"
-                                   (car (cdr error))
-                                   (car (cdr (cdr error))))
-                          (sit-for 1)
-                          ;; Inhibit subsequent tries and return nil:
-                          (setq outline-enwrap-isearch-mode nil))))
-        ;; Isearch-mode loaded, encapsulate specific entry points for
-        ;; outline dynamic-exposure business:
-        (progn
-
-	  ;; stash crucial isearch-mode funcs under known, private
-	  ;; names, then register wrapper functions under the old
-	  ;; names, in their stead: `isearch-quit' is pre isearch v 1.2.
-          (fset 'real-isearch-terminate
-                                        ; `isearch-quit' is pre v 1.2:
-                (or (if (fboundp 'isearch-quit)
-                        (symbol-function 'isearch-quit))
-                    (if (fboundp 'isearch-abort)
-                                        ; `isearch-abort' is v 1.2 and on:
-                        (symbol-function 'isearch-abort))))
-          (fset 'isearch-quit 'isearch-terminate/outline-provisions)
-          (fset 'isearch-abort 'isearch-terminate/outline-provisions)
-          (fset 'real-isearch-done (symbol-function 'isearch-done))
-          (fset 'isearch-done 'isearch-done/outline-provisions)
-          (fset 'real-isearch-update (symbol-function 'isearch-update))
-          (fset 'isearch-update 'isearch-update/outline-provisions)
-          (make-variable-buffer-local 'outline-search-reconceal)))))
-;;;_  > outline-isearch-arrival-business ()
-(defun outline-isearch-arrival-business ()
-  "Do outline business like exposing current point, if necessary.
-
-Registers reconcealment requirements in outline-search-reconceal
-accordingly.
-
-Set outline-search-reconceal to nil if current point is not
-concealed, to value of point if entire topic is concealed, and a
-list containing point if only the topic body is concealed.
-
-This will be used to determine whether outline-hide-current-entry
-or outline-hide-current-entry-completely will be necessary to
-restore the prior concealment state."
-
-  (if (outline-mode-p)
-      (setq outline-search-reconceal
-            (if (outline-hidden-p)
-                (save-excursion
-                  (if (re-search-backward outline-line-boundary-regexp nil 1)
-                      ;; Nil value means we got to b-o-b - wouldn't need
-                      ;; to advance.
-                      (forward-char 1))
-                                        ; We'll return point or list
-                                        ; containing point, depending
-                                        ; on concealment state of
-                                        ; topic prefix.
-                  (prog1 (if (outline-hidden-p) (point) (list (point)))
-                                        ; And reveal the current
-                                        ; search target:
-                    (outline-show-entry)))))))
-;;;_  > outline-isearch-advancing-business ()
-(defun outline-isearch-advancing-business ()
-  "Do outline business like deexposing current point, if necessary.
-
-Works according to reconceal state registration."
-  (if (and (outline-mode-p) outline-search-reconceal)
-      (save-excursion
-        (if (listp outline-search-reconceal)
-            ;; Leave the topic visible:
-            (progn (goto-char (car outline-search-reconceal))
-                   (outline-hide-current-entry))
-          ;; Rehide the entire topic:
-          (goto-char outline-search-reconceal)
-          (outline-hide-current-entry-completely)))))
-;;;_  > isearch-terminate/outline-provisions ()
-(defun isearch-terminate/outline-provisions ()
-  (interactive)
-    (if (and (outline-mode-p) outline-enwrap-isearch-mode)
-        (outline-isearch-advancing-business))
-    (let ((outline-search-quitting t)
-          (outline-search-reconceal nil))
-      (real-isearch-terminate)))
-;;;_  > isearch-done/outline-provisions ()
-(defun isearch-done/outline-provisions (&optional nopush)
-  (interactive)
-  (if (and (outline-mode-p) outline-enwrap-isearch-mode)
-      (progn (if (and outline-search-reconceal
-		      (not (listp outline-search-reconceal)))
-		 ;; The topic was concealed - reveal it, its siblings,
-		 ;; and any ancestors that are still concealed:
-		 (save-excursion
-		   (message "(exposing destination)")(sit-for 0)
-		   (outline-goto-prefix)
-					; There may be a closed blank
-					; line between prior and
-					; current topic that would be
-					; missed - provide for it:
-		   (if (not (bobp))
-		       (progn (forward-char -1) ; newline
-			      (if (eq ?\r (preceding-char))
-				  (outline-flag-region (1- (point))
-						       (point)
-						       ?\n))
-			      (forward-char 1)))
-					; Goto parent
-		   (outline-ascend-to-depth (1- (outline-recent-depth)))
-		   (outline-show-children)))
-	     (if (and (boundp 'outline-search-quitting)
-		      outline-search-quitting)
-		 nil
-					; We're concluding abort:
-	       (outline-isearch-arrival-business)
-	       (outline-show-children))))
-  (if nopush
-      ;; isearch-done in newer version of isearch mode takes arg:
-      (real-isearch-done nopush)
-    (real-isearch-done)))
-;;;_  > isearch-update/outline-provisions ()
-(defun isearch-update/outline-provisions ()
-  "Wrapper dynamically adjusts isearch target exposure.
-
-Appropriately exposes and reconceals hidden outline portions, as
-necessary, in the course of searching."
-  (if (not (and (outline-mode-p) outline-enwrap-isearch-mode))
-      ;; Just do the plain business:
-      (real-isearch-update)
-
-    ;; Ah - provide for outline conditions:
-    (outline-isearch-advancing-business)
-    (real-isearch-update)
-    (cond (isearch-success (outline-isearch-arrival-business))
-          ((not isearch-success) (outline-isearch-advancing-business)))))
-
-;;;_ #8 Copying and printing
-
-;;;_  - Copy exposed
-;;;_   > outline-insert-listified (depth prefix bullet text)
-(defun outline-insert-listified (depth prefix bullet text)
-  "Insert contents of listified outline portion in current buffer."
-  (insert-string (concat (if (> depth 1) prefix "")
-			 (make-string (1- depth) ?\ )
-			 bullet))
-  (while text
-    (insert-string (car text))
-    (if (setq text (cdr text))
-	(insert-string "\n")))
-  (insert-string "\n"))
-;;;_   > outline-copy-exposed (arg &optional tobuf)
-(defun outline-copy-exposed (arg &optional tobuf)
-  "Duplicate exposed portions of current topic to another buffer.
-
-Other buffer has current buffers' name with \" exposed\" appended to it.
-
-With repeat count, copy the exposed portions of entire buffer."
-
-  (interactive "P")
-  (if (not tobuf)
-      (setq tobuf (get-buffer-create (concat "*" (buffer-name) " exposed*"))))
-  (let* ((start-pt (point))
-	 (beg (if arg (point-min) (outline-back-to-current-heading)))
-	 (end (if arg (point-max) (outline-end-of-current-subtree)))
-	 (buf (current-buffer)))
-    (save-excursion (set-buffer tobuf)(erase-buffer))
-    (outline-process-exposed 'outline-insert-listified
-			     beg
-			     end
-			     (current-buffer)
-			     tobuf)
-    (goto-char (point-min))
-    (pop-to-buffer buf)
-    (goto-char start-pt)))
-
-;;;_  - LaTeX formatting
-;;;_   > outline-latex-verb-quote (str &optional flow)
-(defun outline-latex-verb-quote (str &optional flow)
-  "Return copy of STRING for literal reproduction across latex processing.
-Expresses the original characters \(including carriage returns) of the
-string across latex processing."
-  (mapconcat '(lambda (char)
-       ;;;mess: (cond ((memq char '(?"" ?$ ?% ?# ?& ?- ?" ?` ?^ ?- ?*));;;"))))
-		(cond ((memq char '(?\\ ?$ ?% ?# ?& ?{ ?} ?_ ?^ ?- ?*))
-		       (concat "\\char" (number-to-string char) "{}"))
-		      ((= char ?\n) "\\\\")
-		      (t (char-to-string char))))
-	     str
-	     ""))
-;;;_   > outline-latex-verbatim-quote-curr-line ()
-(defun outline-latex-verbatim-quote-curr-line ()
-  "Express line for exact \(literal\) representation across latex processing.
-
-Adjust line contents so it is unaltered \(from the original line)
-across latex processing, within the context of a `verbatim'
-environment.  Leaves point at the end of the line."
-  (beginning-of-line)
-  (let ((beg (point))
-	(end (progn (end-of-line)(point))))
-    (goto-char beg)
-    (while (re-search-forward "\\\\"
-	    ;;"\\\\\\|\\{\\|\\}\\|\\_\\|\\$\\|\\\"\\|\\&\\|\\^\\|\\-\\|\\*\\|#"
-			      end	; bounded by end-of-line
-			      1)	; no matches, move to end & return nil
-      (goto-char (match-beginning 0))
-      (insert-string "\\")
-      (setq end (1+ end))
-      (goto-char (1+ (match-end 0))))))
-;;;_   > outline-insert-latex-header (buf)
-(defun outline-insert-latex-header (buf)
-  "Insert initial latex commands at point in BUFFER."
-  ;; Much of this is being derived from the stuff in appendix of E in
-  ;; the TeXBook, pg 421.
-  (set-buffer buf)
-  (let ((doc-style (format "\n\\documentstyle{%s}\n"
-			   "report"))
-	(page-numbering (if outline-number-pages
-			    "\\pagestyle{empty}\n"
-			  ""))
-	(linesdef (concat "\\def\\beginlines{"
-			  "\\par\\begingroup\\nobreak\\medskip"
-			  "\\parindent=0pt\n"
-			  " \\kern1pt\\nobreak \\obeylines \\obeyspaces "
-			  "\\everypar{\\strut}}\n"
-			  "\\def\\endlines{"
-			  "\\kern1pt\\endgroup\\medbreak\\noindent}\n"))
-	(titlecmd (format "\\newcommand{\\titlecmd}[1]{{%s #1}}\n"
-			  outline-title-style))
-	(labelcmd (format "\\newcommand{\\labelcmd}[1]{{%s #1}}\n"
-			  outline-label-style))
-	(headlinecmd (format "\\newcommand{\\headlinecmd}[1]{{%s #1}}\n"
-			     outline-head-line-style))
-	(bodylinecmd (format "\\newcommand{\\bodylinecmd}[1]{{%s #1}}\n"
-			     outline-body-line-style))
-	(setlength (format "%s%s%s%s"
-			   "\\newlength{\\stepsize}\n"
-			   "\\setlength{\\stepsize}{"
-			   outline-indent
-			   "}\n"))
-	(oneheadline (format "%s%s%s%s%s%s%s"
-			     "\\newcommand{\\OneHeadLine}[3]{%\n"
-			     "\\noindent%\n"
-			     "\\hspace*{#2\\stepsize}%\n"
-			     "\\labelcmd{#1}\\hspace*{.2cm}"
-			     "\\headlinecmd{#3}\\\\["
-			     outline-line-skip
-			     "]\n}\n"))
-	(onebodyline (format "%s%s%s%s%s%s"
-			       "\\newcommand{\\OneBodyLine}[2]{%\n"
-			       "\\noindent%\n"
-			       "\\hspace*{#1\\stepsize}%\n"
-			       "\\bodylinecmd{#2}\\\\["
-			       outline-line-skip
-			       "]\n}\n"))
-	(begindoc "\\begin{document}\n\\begin{center}\n")
-	(title (format "%s%s%s%s"
-		       "\\titlecmd{"
-		       (outline-latex-verb-quote (if outline-title
-						(condition-case err
-						    (eval outline-title)
-						  (error "<unnamed buffer>"))
-					      "Unnamed Outline"))
-		       "}\n"
-		       "\\end{center}\n\n"))
-	(hsize "\\hsize = 7.5 true in\n")
-	(hoffset "\\hoffset = -1.5 true in\n")
-	(vspace "\\vspace{.1cm}\n\n"))
-    (insert (concat doc-style
-		    page-numbering
-		    titlecmd
-		    labelcmd
-		    headlinecmd
-		    bodylinecmd
-		    setlength
-		    oneheadline
-		    onebodyline
-		    begindoc
-		    title
-		    hsize
-		    hoffset
-		    vspace)
-	    )))
-;;;_   > outline-insert-latex-trailer (buf)
-(defun outline-insert-latex-trailer (buf)
-  "Insert concluding latex commands at point in BUFFER."
-  (set-buffer buf)
-  (insert "\n\\end{document}\n"))
-;;;_   > outline-latexify-one-item (depth prefix bullet text)
-(defun outline-latexify-one-item (depth prefix bullet text)
-  "Insert LaTeX commands for formatting one outline item.
-
-Args are the topics' numeric DEPTH, the header PREFIX lead string, the
-BULLET string, and a list of TEXT strings for the body."
-  (let* ((head-line (if text (car text)))
-	 (body-lines (cdr text))
-	 (curr-line)
-	 body-content bop)
-					; Do the head line:
-    (insert-string (concat "\\OneHeadLine{\\verb\1 "
-			   (outline-latex-verb-quote bullet)
-			   "\1}{"
-			   depth
-			   "}{\\verb\1 "
-			   (if head-line
-			       (outline-latex-verb-quote head-line)
-			     "")
-			   "\1}\n"))
-    (if (not body-lines)
-	nil
-      ;;(insert-string "\\beginlines\n")
-      (insert-string "\\begin{verbatim}\n")
-      (while body-lines
-	(setq curr-line (car body-lines))
-	(if (and (not body-content)
-		 (not (string-match "^\\s-*$" curr-line)))
-	    (setq body-content t))
-					; Mangle any occurrences of
-					; "\end{verbatim}" in text,
-					; it's special:
-	(if (and body-content
-		 (setq bop (string-match "\\end{verbatim}" curr-line)))
-	    (setq curr-line (concat (substring curr-line 0 bop)
-				    ">"
-				    (substring curr-line bop))))
-	;;(insert-string "|" (car body-lines) "|")
-	(insert-string curr-line)
-	(outline-latex-verbatim-quote-curr-line)
-	(insert-string "\n")
-	(setq body-lines (cdr body-lines)))
-      (if body-content
-	  (setq body-content nil)
-	(forward-char -1)
-	(insert-string "\\ ")
-	(forward-char 1))
-      ;;(insert-string "\\endlines\n")
-      (insert-string "\\end{verbatim}\n")
-      )))
-;;;_   > outline-latexify-exposed (arg &optional tobuf)
-(defun outline-latexify-exposed (arg &optional tobuf)
-  "Format current topic's exposed portions to TOBUF for latex processing.
-TOBUF defaults to a buffer named the same as the current buffer, but
-with \"*\" prepended and \" latex-formed*\" appended.
-
-With repeat count, copy the exposed portions of entire buffer."
-
-  (interactive "P")
-  (if (not tobuf)
-      (setq tobuf
-	    (get-buffer-create (concat "*" (buffer-name) " latexified*"))))
-  (let* ((start-pt (point))
-	 (beg (if arg (point-min) (outline-back-to-current-heading)))
-	 (end (if arg (point-max) (outline-end-of-current-subtree)))
-	 (buf (current-buffer)))
-    (set-buffer tobuf)
-    (erase-buffer)
-    (outline-insert-latex-header tobuf)
-    (goto-char (point-max))
-    (outline-process-exposed 'outline-latexify-one-item
-			     beg
-			     end
-			     buf
-			     tobuf)
-    (goto-char (point-max))
-    (outline-insert-latex-trailer tobuf)
-    (goto-char (point-min))
-    (pop-to-buffer buf)
-    (goto-char start-pt)))
-
-;;;_ #9 miscellaneous
-;;;_  > outline-mark-topic ()
-(defun outline-mark-topic ()
-  "Put the region around topic currently containing point."
-  (interactive)
-  (beginning-of-line)
-  (outline-goto-prefix)
-  (push-mark (point))
-  (outline-end-of-current-subtree)
-  (exchange-point-and-mark))
-;;;_  > outlineify-sticky ()
-;; outlinify-sticky is correct spelling; provide this alias for sticklers:
-(defalias 'outlinify-sticky 'outlineify-sticky)
-(defun outlineify-sticky (&optional arg)
-  "Activate outline mode and establish file var so it is started subsequently.
-
-See doc-string for `outline-layout' and `outline-init' for details on
-setup for auto-startup."
-
-  (interactive "P")
-
-  (outline-mode t)
-
-  (save-excursion
-    (goto-char (point-min))
-    (if (looking-at outline-regexp)
-	t
-      (outline-open-topic 2)
-      (insert-string (concat "Dummy outline topic header - see"
-			     "`outline-mode' docstring for info."))
-      (next-line 1)
-      (goto-char (point-max))
-      (next-line 1)
-      (outline-open-topic 0)
-      (insert-string "Local emacs vars.\n")
-      (outline-open-topic 1)
-      (insert-string "(`outline-layout' is for allout.el outline-mode)\n")
-      (outline-open-topic 0)
-      (insert-string "Local variables:\n")
-      (outline-open-topic 0)
-      (insert-string (format "outline-layout: %s\n"
-			     (or outline-layout
-				 '(1 : 0))))
-      (outline-open-topic 0)
-      (insert-string "End:\n"))))
-;;;_  > solicit-char-in-string (prompt string &optional do-defaulting)
-(defun solicit-char-in-string (prompt string &optional do-defaulting)
-  "Solicit (with first arg PROMPT) choice of a character from string STRING.
-
-Optional arg DO-DEFAULTING indicates to accept empty input (CR)."
-
-  (let ((new-prompt prompt)
-        got)
-
-    (while (not got)
-      (message "%s" new-prompt)
-
-      ;; We do our own reading here, so we can circumvent, eg, special
-      ;; treatment for `?' character.  (Might oughta change minibuffer
-      ;; keymap instead, oh well.)
-      (setq got
-            (char-to-string (let ((cursor-in-echo-area nil)) (read-char))))
-
-      (if (null (string-match (regexp-quote got) string))
-          (if (and do-defaulting (string= got "\^M"))
-              ;; We're defaulting, return null string to indicate that:
-              (setq got "")
-            ;; Failed match and not defaulting,
-            ;; set the prompt to give feedback,
-            (setq new-prompt (concat prompt
-                                     got
-                                     " ...pick from: "
-                                     string
-                                     ""))
-            ;; and set loop to try again:
-            (setq got nil))
-        ;; Got a match - give feedback:
-        (message "")))
-    ;; got something out of loop - return it:
-    got)
-  )
-;;;_  > regexp-sans-escapes (string)
-(defun regexp-sans-escapes (regexp &optional successive-backslashes)
-  "Return a copy of REGEXP with all character escapes stripped out.
-
-Representations of actual backslashes - '\\\\\\\\' - are left as a
-single backslash.
-
-Optional arg SUCCESSIVE-BACKSLASHES is used internally for recursion."
-
-  (if (string= regexp "")
-      ""
-    ;; Set successive-backslashes to number if current char is
-    ;; backslash, or else to nil:
-    (setq successive-backslashes
-	  (if (= (aref regexp 0) ?\\)
-	      (if successive-backslashes (1+ successive-backslashes) 1)
-	    nil))
-    (if (or (not successive-backslashes) (= 2 successive-backslashes))
-	;; Include first char:
-	(concat (substring regexp 0 1)
-		(regexp-sans-escapes (substring regexp 1)))
-      ;; Exclude first char, but maintain count:
-      (regexp-sans-escapes (substring regexp 1) successive-backslashes))))
-;;;_  - add-hook definition for divergent emacsen
-;;;_   > add-hook (hook function &optional append)
-(if (not (fboundp 'add-hook))
-    (defun add-hook (hook function &optional append)
-      "Add to the value of HOOK the function FUNCTION unless already present.
-\(It becomes the first hook on the list unless optional APPEND is non-nil, in
-which case it becomes the last).  HOOK should be a symbol, and FUNCTION may be
-any valid function.  HOOK's value should be a list of functions, not a single
-function.  If HOOK is void, it is first set to nil."
-      (or (boundp hook) (set hook nil))
-      (or (if (consp function)
-	      ;; Clever way to tell whether a given lambda-expression
-	      ;; is equal to anything in the hook.
-	      (let ((tail (assoc (cdr function) (symbol-value hook))))
-		(equal function tail))
-	    (memq function (symbol-value hook)))
-	  (set hook
-	       (if append
-		   (nconc (symbol-value hook) (list function))
-		 (cons function (symbol-value hook)))))))
-
-;;;_ #10 Under development
-;;;_  > outline-bullet-isearch (&optional bullet)
-(defun outline-bullet-isearch (&optional bullet)
-  "Isearch \(regexp\) for topic with bullet BULLET."
-  (interactive)
-  (if (not bullet)
-      (setq bullet (solicit-char-in-string
-		    "ISearch for topic with bullet: "
-		    (regexp-sans-escapes outline-bullets-string))))
-
-  (let ((isearch-regexp t)
-	(isearch-string (concat "^"
-				outline-header-prefix
-				"[ \t]*"
-				bullet)))
-    (isearch-repeat 'forward)
-    (isearch-mode t)))
-;;;_  ? Re hooking up with isearch - use isearch-op-fun rather than
-;;;	wrapping the isearch functions.
-
-;;;_* Local emacs vars.
-;;; The following `outline-layout' local variable setting:
-;;;  - closes all topics from the first topic to just before the third-to-last,
-;;;  - shows the children of the third to last (config vars)
-;;;  - and the second to last (code section),
-;;;  - and closes the last topic (this local-variables section).
-;;;Local variables:
-;;;outline-layout: (0 : -1 -1 0)
-;;;End:
-
-;; allout.el ends here
diff --git a/lisp/ange-ftp.el b/lisp/ange-ftp.el
deleted file mode 100644
index 137e63abd79..00000000000
--- a/lisp/ange-ftp.el
+++ /dev/null
@@ -1,5479 +0,0 @@
-;;; ange-ftp.el --- transparent FTP support for GNU Emacs
-
-;; Copyright (C) 1989,90,91,92,93,94,95,96  Free Software Foundation, Inc.
-
-;; Author: Andy Norman (ange@hplb.hpl.hp.com)
-;; Maintainer: FSF
-;; Keywords: comm
-
-;; 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 attempts to make accessing files and directories using FTP
-;; from within GNU Emacs as simple and transparent as possible.  A subset of
-;; the common file-handling routines are extended to interact with FTP.
-
-;; Usage:
-;;
-;; Some of the common GNU Emacs file-handling operations have been made
-;; FTP-smart.  If one of these routines is given a filename that matches
-;; '/user@host:name' then it will spawn an FTP process connecting to machine
-;; 'host' as account 'user' and perform its operation on the file 'name'.
-;;
-;; For example: if find-file is given a filename of:
-;;
-;;   /ange@anorman:/tmp/notes
-;;
-;; then ange-ftp spawns an FTP process, connect to the host 'anorman' as
-;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the
-;; contents of that file as if it were on the local filesystem.  If ange-ftp
-;; needs a password to connect then it reads one in the echo area.
-
-;; Extended filename syntax:
-;;
-;; The default extended filename syntax is '/user@host:name', where the
-;; 'user@' part may be omitted.  This syntax can be customised to a certain
-;; extent by changing ange-ftp-name-format.  There are limitations.
-;;
-;; If the user part is omitted then ange-ftp generates a default user
-;; instead whose value depends on the variable ange-ftp-default-user.
-
-;; Passwords:
-;;
-;; A password is required for each host/user pair.  Ange-ftp reads passwords
-;; as needed.  You can also specify a password with ange-ftp-set-passwd, or
-;; in a *valid* ~/.netrc file.
-
-;; Passwords for user "anonymous":
-;;
-;; Passwords for the user "anonymous" (or "ftp") are handled
-;; specially.  The variable `ange-ftp-generate-anonymous-password'
-;; controls what happens: if the value of this variable is a string,
-;; then this is used as the password; if non-nil (the default), then
-;; the value of `user-mail-address' is used; if nil then the user
-;; is prompted for a password as normal.
-
-;; "Dumb" UNIX hosts:
-;;
-;; The FTP servers on some UNIX machines have problems if the 'ls' command is
-;; used.
-;;
-;; The routine ange-ftp-add-dumb-unix-host can be called to tell ange-ftp to
-;; limit itself to the DIR command and not 'ls' for a given UNIX host.  Note
-;; that this change will take effect for the current GNU Emacs session only.
-;; See below for a discussion of non-UNIX hosts.  If a large number of
-;; machines with similar hostnames have this problem then it is easier to set
-;; the value of ange-ftp-dumb-unix-host-regexp in your .emacs file. ange-ftp
-;; is unable to automatically recognize dumb unix hosts.
-
-;; File name completion:
-;;
-;; Full file-name completion is supported on UNIX, VMS, CMS, and MTS hosts.
-;; To do filename completion, ange-ftp needs a listing from the remote host.
-;; Therefore, for very slow connections, it might not save any time.
-
-;; FTP processes:
-;;
-;; When ange-ftp starts up an FTP process, it leaves it running for speed
-;; purposes.  Some FTP servers will close the connection after a period of
-;; time, but ange-ftp should be able to quietly reconnect the next time that
-;; the process is needed.
-;;
-;; Killing the "*ftp user@host*" buffer also kills the ftp process.
-;; This should not cause ange-ftp any grief.
-
-;; Binary file transfers:
-;;
-;; By default ange-ftp transfers files in ASCII mode.  If a file being
-;; transferred matches the value of ange-ftp-binary-file-name-regexp then
-;; binary mode is used for that transfer.
-
-;; Account passwords:
-;;
-;; Some FTP servers require an additional password which is sent by the
-;; ACCOUNT command.  ange-ftp partially supports this by allowing the user to
-;; specify an account password by either calling ange-ftp-set-account, or by
-;; specifying an account token in the .netrc file.  If the account password
-;; is set by either of these methods then ange-ftp will issue an ACCOUNT
-;; command upon starting the FTP process.
-
-;; Preloading:
-;;
-;; ange-ftp can be preloaded, but must be put in the site-init.el file and
-;; not the site-load.el file in order for the documentation strings for the
-;; functions being overloaded to be available.
-
-;; Status reports:
-;;
-;; Most ange-ftp commands that talk to the FTP process output a status
-;; message on what they are doing.  In addition, ange-ftp can take advantage
-;; of the FTP client's HASH command to display the status of transferring
-;; files and listing directories.  See the documentation for the variables
-;; ange-ftp-{ascii,binary}-hash-mark-size, ange-ftp-send-hash and
-;; ange-ftp-process-verbose for more details.
-
-;; Gateways:
-;;
-;; Sometimes it is necessary for the FTP process to be run on a different
-;; machine than the machine running GNU Emacs.  This can happen when the
-;; local machine has restrictions on what hosts it can access.
-;;
-;; ange-ftp has support for running the ftp process on a different (gateway)
-;; machine.  The way it works is as follows:
-;;
-;; 1) Set the variable 'ange-ftp-gateway-host' to the name of a machine
-;;    that doesn't have the access restrictions.
-;;
-;; 2) Set the variable 'ange-ftp-local-host-regexp' to a regular expression
-;;    that matches hosts that can be contacted from running a local ftp
-;;    process, but fails to match hosts that can't be accessed locally.  For
-;;    example:
-;;
-;;    "\\.hp\\.com$\\|^[^.]*$"
-;;
-;;    will match all hosts that are in the .hp.com domain, or don't have an
-;;    explicit domain in their name, but will fail to match hosts with
-;;    explicit domains or that are specified by their ip address.
-;;
-;; 3) Using NFS and symlinks, make sure that there is a shared directory with
-;;    the *same* name between the local machine and the gateway machine.
-;;    This directory is necessary for temporary files created by ange-ftp.
-;;
-;; 4) Set the variable 'ange-ftp-gateway-tmp-name-template' to the name of
-;;    this directory plus an identifying filename prefix.  For example:
-;;
-;;    "/nfs/hplose/ange/ange-ftp"
-;;
-;;    where /nfs/hplose/ange is a directory that is shared between the
-;;    gateway machine and the local machine.
-;;
-;; The simplest way of getting a ftp process running on the gateway machine
-;; is if you can spawn a remote shell using either 'rsh' or 'remsh'.  If you
-;; can't do this for some reason such as security then points 7 onwards will
-;; discuss an alternative approach.
-;;
-;; 5) Set the variable ange-ftp-gateway-program to the name of the remote
-;;    shell process such as 'remsh' or 'rsh' if the default isn't correct.
-;;
-;; 6) Set the variable ange-ftp-gateway-program-interactive to nil if it
-;;    isn't already.  This tells ange-ftp that you are using a remote shell
-;;    rather than logging in using telnet or rlogin.
-;;
-;; That should be all you need to allow ange-ftp to spawn a ftp process on
-;; the gateway machine.  If you have to use telnet or rlogin to get to the
-;; gateway machine then follow the instructions below.
-;;
-;; 7) Set the variable ange-ftp-gateway-program to the name of the program
-;;    that lets you log onto the gateway machine.  This may be something like
-;;    telnet or rlogin.
-;;
-;; 8) Set the variable ange-ftp-gateway-prompt-pattern to a regular
-;;    expression that matches the prompt you get when you login to the
-;;    gateway machine.  Be very specific here; this regexp must not match
-;;    *anything* in your login banner except this prompt.
-;;    shell-prompt-pattern is far too general as it appears to match some
-;;    login banners from Sun machines.  For example:
-;;
-;;    "^$*$ *"
-;;
-;; 9) Set the variable ange-ftp-gateway-program-interactive to 't' to let
-;;    ange-ftp know that it has to "hand-hold" the login to the gateway
-;;    machine.
-;;
-;; 10) Set the variable ange-ftp-gateway-setup-term-command to a UNIX command
-;;     that will put the pty connected to the gateway machine into a
-;;     no-echoing mode, and will strip off carriage-returns from output from
-;;     the gateway machine.  For example:
-;;
-;;     "stty -onlcr -echo"
-;;
-;;     will work on HP-UX machines, whereas:
-;;
-;;     "stty -echo nl"
-;;
-;;     appears to work for some Sun machines.
-;;
-;; That's all there is to it.
-
-;; Smart gateways:
-;;
-;; If you have a "smart" ftp program that allows you to issue commands like
-;; "USER foo@bar" which do nice proxy things, then look at the variables
-;; ange-ftp-smart-gateway and ange-ftp-smart-gateway-port.
-;;
-;; Otherwise, if there is an alternate ftp program that implements proxy in
-;; a transparent way (i.e. w/o specifying the proxy host), that will
-;; connect you directly to the desired destination host:
-;; Set ange-ftp-gateway-ftp-program-name to that program's name.
-;; Set ange-ftp-local-host-regexp to a value as stated earlier on.
-;; Leave ange-ftp-gateway-host set to nil.
-;; Set ange-ftp-smart-gateway to t.
-
-;; Tips for using ange-ftp:
-;;
-;; 1. For dired to work on a host which marks symlinks with a trailing @ in
-;;    an ls -alF listing, you need to (setq dired-ls-F-marks-symlinks t).
-;;    Most UNIX systems do not do this, but ULTRIX does. If you think that
-;;    there is a chance you might connect to an ULTRIX machine (such as
-;;    prep.ai.mit.edu), then set this variable accordingly.  This will have
-;;    the side effect that dired will have problems with symlinks whose names
-;;    end in an @.  If you get yourself into this situation then editing
-;;    dired's ls-switches to remove "F", will temporarily fix things.
-;;
-;; 2. If you know that you are connecting to a certain non-UNIX machine
-;;    frequently, and ange-ftp seems to be unable to guess its host-type,
-;;    then setting the appropriate host-type regexp
-;;    (ange-ftp-vms-host-regexp, ange-ftp-mts-host-regexp, or
-;;    ange-ftp-cms-host-regexp) accordingly should help. Also, please report
-;;    ange-ftp's inability to recognize the host-type as a bug.
-;;
-;; 3. For slow connections, you might get "listing unreadable" error
-;;    messages, or get an empty buffer for a file that you know has something
-;;    in it. The solution is to increase the value of ange-ftp-retry-time.
-;;    Its default value is 5 which is plenty for reasonable connections.
-;;    However, for some transatlantic connections I set this to 20.
-;;
-;; 4. Beware of compressing files on non-UNIX hosts. Ange-ftp will do it by
-;;    copying the file to the local machine, compressing it there, and then
-;;    sending it back. Binary file transfers between machines of different
-;;    architectures can be a risky business. Test things out first on some
-;;    test files. See "Bugs" below. Also, note that ange-ftp copies files by
-;;    moving them through the local machine. Again, be careful when doing
-;;    this with binary files on non-Unix machines.
-;;
-;; 5. Beware that dired over ftp will use your setting of dired-no-confirm
-;;    (list of dired commands for which confirmation is not asked).  You
-;;    might want to reconsider your setting of this variable, because you
-;;    might want confirmation for more commands on remote direds than on
-;;    local direds. For example, I strongly recommend that you not include
-;;    compress and uncompress in this list. If there is enough demand it
-;;    might be a good idea to have an alist ange-ftp-dired-no-confirm of
-;;    pairs ( TYPE . LIST ), where TYPE is an operating system type and LIST
-;;    is a list of commands for which confirmation would be suppressed.  Then
-;;    remote dired listings would take their (buffer-local) value of
-;;    dired-no-confirm from this alist. Who votes for this?
-
-;; ---------------------------------------------------------------------
-;; Non-UNIX support:
-;; ---------------------------------------------------------------------
-
-;; VMS support:
-;;
-;; Ange-ftp has full support for VMS hosts.  It
-;; should be able to automatically recognize any VMS machine. However, if it
-;; fails to do this, you can use the command ange-ftp-add-vms-host.  As well,
-;; you can set the variable ange-ftp-vms-host-regexp in your .emacs file. We
-;; would be grateful if you would report any failures to automatically
-;; recognize a VMS host as a bug.
-;;
-;; Filename Syntax:
-;;
-;; For ease of *implementation*, the user enters the VMS filename syntax in a
-;; UNIX-y way.  For example:
-;;  PUB$:[ANONYMOUS.SDSCPUB.NEXT]README.TXT;1
-;; would be entered as:
-;;  /PUB$$:/ANONYMOUS/SDSCPUB/NEXT/README.TXT;1
-;; i.e. to log in as anonymous on ymir.claremont.edu and grab the file:
-;;  [.CSV.POLICY]RULES.MEM
-;; you would type:
-;;  C-x C-f /anonymous@ymir.claremont.edu:CSV/POLICY/RULES.MEM
-;;
-;; A legal VMS filename is of the form: FILE.TYPE;##
-;; where FILE can be up to 39 characters
-;;       TYPE can be up to 39 characters
-;;       ## is a version number (an integer between 1 and 32,767)
-;; Valid characters in FILE and TYPE are A-Z 0-9 _ - $
-;; $ cannot begin a filename, and - cannot be used as the first or last
-;; character.
-;;
-;; Tips:
-;; 1. Although VMS is not case sensitive, EMACS running under UNIX is.
-;;    Therefore, to access a VMS file, you must enter the filename with upper
-;;    case letters.
-;; 2. To access the latest version of file under VMS, you use the filename
-;;    without the ";" and version number. You should always edit the latest
-;;    version of a file. If you want to edit an earlier version, copy it to a
-;;    new file first. This has nothing to do with ange-ftp, but is simply
-;;    good VMS operating practice. Therefore, to edit FILE.TXT;3 (say 3 is
-;;    latest version), do C-x C-f /ymir.claremont.edu:FILE.TXT. If you
-;;    inadvertently do C-x C-f /ymir.claremont.edu:FILE.TXT;3, you will find
-;;    that VMS will not allow you to save the file because it will refuse to
-;;    overwrite FILE.TXT;3, but instead will want to create FILE.TXT;4, and
-;;    attach the buffer to this file. To get out of this situation, M-x
-;;    write-file /ymir.claremont.edu:FILE.TXT will attach the buffer to
-;;    latest version of the file. For this reason, in dired "f"
-;;    (dired-find-file), always loads the file sans version, whereas "v",
-;;    (dired-view-file), always loads the explicit version number. The
-;;    reasoning being that it reasonable to view old versions of a file, but
-;;    not to edit them.
-;; 3. EMACS has a feature in which it does environment variable substitution
-;;    in filenames. Therefore, to enter a $ in a filename, you must quote it
-;;    by typing $$.
-
-;; MTS support:
-;;
-;; Ange-ftp has full support for hosts running
-;; the Michigan terminal system.  It should be able to automatically
-;; recognize any MTS machine. However, if it fails to do this, you can use
-;; the command ange-ftp-add-mts-host.  As well, you can set the variable
-;; ange-ftp-mts-host-regexp in your .emacs file. We would be grateful if you
-;; would report any failures to automatically recognize a MTS host as a bug.
-;;
-;; Filename syntax:
-;; 
-;; MTS filenames are entered in a UNIX-y way. For example, if your account
-;; was YYYY, the file FILE in the account XXXX: on mtsg.ubc.ca would be
-;; entered as
-;;   /YYYY@mtsg.ubc.ca:/XXXX:/FILE
-;; In other words, MTS accounts are treated as UNIX directories. Of course,
-;; to access a file in another account, you must have access permission for
-;; it.  If FILE were in your own account, then you could enter it in a
-;; relative name fashion as
-;;   /YYYY@mtsg.ubc.ca:FILE
-;; MTS filenames can be up to 12 characters. Like UNIX, the structure of the
-;; filename does not contain a TYPE (i.e. it can have as many "."'s as you
-;; like.) MTS filenames are always in upper case, and hence be sure to enter
-;; them as such! MTS is not case sensitive, but an EMACS running under UNIX
-;; is.
-
-;; CMS support:
-;; 
-;; Ange-ftp has full support for hosts running
-;; CMS.  It should be able to automatically recognize any CMS machine.
-;; However, if it fails to do this, you can use the command
-;; ange-ftp-add-cms-host.  As well, you can set the variable
-;; ange-ftp-cms-host-regexp in your .emacs file. We would be grateful if you
-;; would report any failures to automatically recognize a CMS host as a bug.
-;; 
-;; Filename syntax:
-;;
-;; CMS filenames are entered in a UNIX-y way. In otherwords, minidisks are
-;; treated as UNIX directories. For example to access the file READ.ME in
-;; minidisk *.311 on cuvmb.cc.columbia.edu, you would enter
-;;   /anonymous@cuvmb.cc.columbia.edu:/*.311/READ.ME
-;; If *.301 is the default minidisk for this account, you could access
-;; FOO.BAR on this minidisk as
-;;   /anonymous@cuvmb.cc.columbia.edu:FOO.BAR
-;; CMS filenames are of the form FILE.TYPE, where both FILE and TYPE can be
-;; up to 8 characters. Again, beware that CMS filenames are always upper
-;; case, and hence must be entered as such.
-;;
-;; Tips:
-;; 1. CMS machines, with the exception of anonymous accounts, nearly always
-;;    need an account password. To have ange-ftp send an account password,
-;;    you can either include it in your .netrc file, or use
-;;    ange-ftp-set-account.
-;; 2. Ange-ftp cannot send "write passwords" for a minidisk. Hopefully, we
-;;    can fix this.
-;;
-;; ------------------------------------------------------------------
-;; Bugs:
-;; ------------------------------------------------------------------
-;; 
-;; 1. Umask problems:
-;;    Be warned that files created by using ange-ftp will take account of the
-;;    umask of the ftp daemon process rather than the umask of the creating
-;;    user.  This is particularly important when logging in as the root user.
-;;    The way that I tighten up the ftp daemon's umask under HP-UX is to make
-;;    sure that the umask is changed to 027 before I spawn /etc/inetd.  I
-;;    suspect that there is something similar on other systems.
-;;
-;; 2. Some combinations of FTP clients and servers break and get out of sync
-;;    when asked to list a non-existent directory.  Some of the ai.mit.edu
-;;    machines cause this problem for some FTP clients. Using
-;;    ange-ftp-kill-ftp-process can restart the ftp process, which
-;;    should get things back in sync.
-;;
-;; 3. Ange-ftp does not check to make sure that when creating a new file,
-;;    you provide a valid filename for the remote operating system.
-;;    If you do not, then the remote FTP server will most likely
-;;    translate your filename in some way. This may cause ange-ftp to
-;;    get confused about what exactly is the name of the file. The
-;;    most common causes of this are using lower case filenames on systems
-;;    which support only upper case, and using filenames which are too
-;;    long.
-;;
-;; 4. Null (blank) passwords confuse both ange-ftp and some FTP daemons.
-;;
-;; 5. Ange-ftp likes to use pty's to talk to its FTP processes.  If GNU Emacs
-;;    for some reason creates a FTP process that only talks via pipes then
-;;    ange-ftp won't be getting the information it requires at the time that
-;;    it wants it since pipes flush at different times to pty's.  One
-;;    disgusting way around this problem is to talk to the FTP process via
-;;    rlogin which does the 'right' things with pty's.
-;;
-;; 6. For CMS support, we send too many cd's. Since cd's are cheap, I haven't
-;;    worried about this too much. Eventually, we should have some caching
-;;    of the current minidisk.
-;;    
-;; 7. Some CMS machines do not assign a default minidisk when you ftp them as
-;;    anonymous. It is then necessary to guess a valid minidisk name, and cd
-;;    to it. This is (understandably) beyond ange-ftp.
-;;
-;; 8. Remote to remote copying of files on non-Unix machines can be risky.
-;;    Depending on the variable ange-ftp-binary-file-name-regexp, ange-ftp
-;;    will use binary mode for the copy. Between systems of different
-;;    architecture, this still may not be enough to guarantee the integrity
-;;    of binary files. Binary file transfers from VMS machines are
-;;    particularly problematical. Should ange-ftp-binary-file-name-regexp be
-;;    an alist of OS type, regexp pairs?
-;;
-;; 9. The code to do compression of files over ftp is not as careful as it
-;;    should be. It deletes the old remote version of the file, before
-;;    actually checking if the local to remote transfer of the compressed
-;;    file succeeds. Of course to delete the original version of the file
-;;    after transferring the compressed version back is also dangerous,
-;;    because some OS's have severe restrictions on the length of filenames,
-;;    and when the compressed version is copied back the "-Z" or ".Z" may be
-;;    truncated. Then, ange-ftp would delete the only remaining version of
-;;    the file.  Maybe ange-ftp should make backups when it compresses files
-;;    (of course, the backup "~" could also be truncated off, sigh...).
-;;    Suggestions?
-;;
-;; 10. If a dir listing is attempted for an empty directory on (at least
-;;     some) VMS hosts, an ftp error is given. This is really an ftp bug, and
-;;     I don't know how to get ange-ftp work to around it.
-;;
-;; 11. Bombs on filenames that start with a space. Deals well with filenames
-;;     containing spaces, but beware that the remote ftpd may not like them
-;;     much.
-;;
-;; 12. The dired support for non-Unix-like systems does not currently work.
-;;     It needs to be reimplemented by modifying the parse-...-listing
-;;	functions to convert the directory listing to ls -l format.
-;; 
-;; 13. The famous @ bug. As mentioned above in TIPS, ULTRIX marks symlinks
-;;     with a trailing @ in a ls -alF listing. In order to account for this
-;;     ange-ftp looks to chop trailing @'s off of symlink names when it is
-;;     parsing a listing with the F switch. This will cause ange-ftp to
-;;     incorrectly get the name of a symlink on a non-ULTRIX host if its name
-;;     ends in an @. ange-ftp will correct itself if you take F out of the
-;;     dired ls switches (C-u s will allow you to edit the switches). The
-;;     dired buffer will be automatically reverted, which will allow ange-ftp
-;;     to fix its files hashtable.  A cookie to anyone who can think of a
-;;     fast, sure-fire way to recognize ULTRIX over ftp.
-
-;; If you find any bugs or problems with this package, PLEASE either e-mail
-;; the above author, or send a message to the ange-ftp-lovers mailing list
-;; below.  Ideas and constructive comments are especially welcome.
-
-;; ange-ftp-lovers:
-;;
-;; ange-ftp has its own mailing list modestly called ange-ftp-lovers.  All
-;; users of ange-ftp are welcome to subscribe (see below) and to discuss
-;; aspects of ange-ftp.  New versions of ange-ftp are posted periodically to
-;; the mailing list.
-;;
-;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the
-;; list, please mail one of the following addresses:
-;;
-;;     ange-ftp-lovers-request@anorman.hpl.hp.com
-;; or
-;;     ange-ftp-lovers-request%anorman.hpl.hp.com@hplb.hpl.hp.com
-;;
-;; Please don't forget the -request part.
-;;
-;; For mail to be posted directly to ange-ftp-lovers, send to one of the
-;; following addresses:
-;; 
-;;     ange-ftp-lovers@anorman.hpl.hp.com
-;; or
-;;     ange-ftp-lovers%anorman.hpl.hp.com@hplb.hpl.hp.com
-;;
-;; Alternatively, there is a mailing list that only gets announcements of new
-;; ange-ftp releases.  This is called ange-ftp-lovers-announce, and can be
-;; subscribed to by e-mailing to the -request address as above.  Please make
-;; it clear in the request which mailing list you wish to join.
-
-;; The latest version of ange-ftp can usually be obtained via anonymous ftp
-;; from:
-;;     alpha.gnu.ai.mit.edu:ange-ftp/ange-ftp.tar.Z
-;; or:
-;;     ugle.unit.no:/pub/gnu/emacs-lisp/ange-ftp.tar.Z
-;; or:
-;;   archive.cis.ohio-state.edu:pub/gnu/emacs/elisp-archive/packages/ange-ftp.tar.Z
-
-;; The archives for ange-ftp-lovers can be found via anonymous ftp under:
-;;
-;;     ftp.reed.edu:pub/mailing-lists/ange-ftp/
-
-;; -----------------------------------------------------------
-;; Technical information on this package:
-;; -----------------------------------------------------------
-
-;; ange-ftp works by putting a handler on file-name-handler-alist
-;; which is called by many primitives, and a few non-primitives,
-;; whenever they see a file name of the appropriate sort.
-
-;; Checklist for adding non-UNIX support for TYPE
-;; 
-;; The following functions may need TYPE versions:
-;; (not all functions will be needed for every OS)
-;;
-;; ange-ftp-fix-name-for-TYPE
-;; ange-ftp-fix-dir-name-for-TYPE
-;; ange-ftp-TYPE-host
-;; ange-ftp-TYPE-add-host
-;; ange-ftp-parse-TYPE-listing
-;; ange-ftp-TYPE-delete-file-entry
-;; ange-ftp-TYPE-add-file-entry
-;; ange-ftp-TYPE-file-name-as-directory
-;; ange-ftp-TYPE-make-compressed-filename
-;; ange-ftp-TYPE-file-name-sans-versions
-;;
-;; Variables:
-;;
-;; ange-ftp-TYPE-host-regexp
-;; May need to add TYPE to ange-ftp-dumb-host-types
-;;
-;; Check the following functions for OS dependent coding:
-;;
-;; ange-ftp-host-type
-;; ange-ftp-guess-host-type
-;; ange-ftp-allow-child-lookup
-
-;; Host type conventions:
-;;
-;; The function ange-ftp-host-type and the variable ange-ftp-dired-host-type
-;; (mostly) follow the following conventions for remote host types.  At
-;; least, I think that future code should try to follow these conventions,
-;; and the current code should eventually be made compliant.
-;;
-;; nil = local host type, whatever that is (probably unix).
-;;       Think nil as in "not a remote host". This value is used by
-;;       ange-ftp-dired-host-type for local buffers.
-;;
-;; t = a remote host of unknown type. Think t as in true, it's remote.
-;;     Currently, 'unix is used as the default remote host type.
-;;     Maybe we should use t.
-;;
-;; 'type = a remote host of TYPE type.
-;;
-;; 'type:list = a remote host of TYPE type, using a specialized ftp listing
-;;              program called list. This is currently only used for Unix
-;;              dl (descriptive listings), when ange-ftp-dired-host-type
-;;              is set to 'unix:dl.
-
-;; Bug report codes:
-;;
-;; Because of their naive faith in this code, there are certain situations
-;; which the writers of this program believe could never happen. However,
-;; being realists they have put calls to `error' in the program at these
-;; points. These errors provide a code, which is an integer, greater than 1.
-;; To aid debugging.  the error codes, and the functions in which they reside
-;; are listed below.
-;; 
-;; 1: See ange-ftp-ls
-;;
-
-;; -----------------------------------------------------------
-;; Hall of fame:
-;; -----------------------------------------------------------
-;; 
-;; Thanks to Roland McGrath for improving the filename syntax handling,
-;; for suggesting many enhancements and for numerous cleanups to the code.
-;;
-;; Thanks to Jamie Zawinski for bugfixes and for ideas such as gateways.
-;;
-;; Thanks to Ken Laprade for improved .netrc parsing, password reading, and
-;; dired / shell auto-loading.
-;;
-;; Thanks to Sebastian Kremer for dired support and for many ideas and
-;; bugfixes.
-;;
-;; Thanks to Joe Wells for bugfixes, the original non-UNIX system support,
-;; VOS support, and hostname completion.
-;;
-;; Thanks to Nakagawa Takayuki for many good ideas, filename-completion, help
-;; with file-name expansion, efficiency worries, stylistic concerns and many
-;; bugfixes.
-;;
-;; Thanks to Sandy Rutherford who re-wrote most of ange-ftp to support VMS,
-;; MTS, CMS and UNIX-dls.  Sandy also added dired-support for non-UNIX OS and
-;; auto-recognition of the host type.
-;;
-;; Thanks to Dave Smith who wrote the info file for ange-ftp.
-;;
-;; Finally, thanks to Keith Waclena, Mark D. Baushke, Terence Kelleher, Ping
-;; Zhou, Edward Vielmetti, Jack Repenning, Mike Balenger, Todd Kaufmann,
-;; Kjetil Svarstad, Tom Wurgler, Linus Tolke, Niko Makila, Carl Edman, Bill
-;; Trost, Dave Brennan, Dan Jacobson, Andy Scott, Steve Anderson, Sanjay
-;; Mathur, the folks on the ange-ftp-lovers mailing list and many others
-;; whose names I've forgotten who have helped to debug and fix problems with
-;; ange-ftp.el.
-
-;;; Code:
-
-(require 'comint)
-
-;;;; ------------------------------------------------------------
-;;;; User customization variables.
-;;;; ------------------------------------------------------------
-
-(defvar ange-ftp-name-format
-  '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
-  "*Format of a fully expanded remote file name.
-This is a list of the form \(REGEXP HOST USER NAME\),
-where REGEXP is a regular expression matching
-the full remote name, and HOST, USER, and NAME are the numbers of
-parenthesized expressions in REGEXP for the components (in that order).")
-
-;; ange-ftp-multi-skip-msgs should only match ###-, where ### is one of
-;; the number codes corresponding to ange-ftp-good-msgs or ange-ftp-fatal-msgs.
-;; Otherwise, ange-ftp will go into multi-skip mode, and never come out.
-
-(defvar ange-ftp-multi-msgs
-  "^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-"
-  "*Regular expression matching the start of a multiline ftp reply.")
-
-(defvar ange-ftp-good-msgs
-  "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark"
-  "*Regular expression matching ftp \"success\" messages.")
-
-;; CMS and the odd VMS machine say 200 Port rather than 200 PORT.
-;; Also CMS machines use a multiline 550- reply to say that you
-;; don't have write permission. ange-ftp gets into multi-line skip
-;; mode and hangs. Have it ignore 550- instead. It will then barf
-;; when it gets the 550 line, as it should.
-
-(defvar ange-ftp-skip-msgs
-  (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|"
-	  "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
-	  "^Data connection \\|"
-	  "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|"
-	  "^227 .*[Pp]assive")
-  "*Regular expression matching ftp messages that can be ignored.")
-
-(defvar ange-ftp-fatal-msgs
-  (concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|"
-	  "^No control connection\\|unknown host\\|^lost connection")
-  "*Regular expression matching ftp messages that indicate serious errors.
-These mean that the FTP process should (or already has) been killed.")
-
-(defvar ange-ftp-gateway-fatal-msgs
-  "No route to host\\|Connection closed\\|No such host\\|Login incorrect"
-  "*Regular expression matching login failure messages from rlogin/telnet.")
-
-(defvar ange-ftp-xfer-size-msgs
-  "^150 .* connection for .* (\\([0-9]+\\) bytes)"
-  "*Regular expression used to determine the number of bytes in a FTP transfer.")
-
-(defvar ange-ftp-tmp-name-template "/tmp/ange-ftp"
-  "*Template used to create temporary files.")
-
-(defvar ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp"
-  "*Template used to create temporary files when ftp-ing through a gateway.
-Files starting with this prefix need to be accessible from BOTH the local
-machine and the gateway machine, and need to have the SAME name on both
-machines, that is, /tmp is probably NOT what you want, since that is rarely
-cross-mounted.")
-
-(defvar ange-ftp-netrc-filename "~/.netrc"
-  "*File in .netrc format to search for passwords.")
-
-(defvar ange-ftp-disable-netrc-security-check nil
-  "*If non-nil avoid checking permissions on the .netrc file.")
-
-(defvar ange-ftp-default-user nil
-  "*User name to use when none is specified in a file name.
-If non-nil but not a string, you are prompted for the name.
-If nil, the value of `ange-ftp-netrc-default-user' is used.
-If that is nil too, then your login name is used.
-
-Once a connection to a given host has been initiated, the user name
-and password information for that host are cached and re-used by
-ange-ftp.  Use `ange-ftp-set-user' to change the cached values,
-since setting `ange-ftp-default-user' directly does not affect
-the cached information.")  
-
-(defvar ange-ftp-netrc-default-user nil
-  "Alternate default user name to use when none is specified.
-This variable is set from the `default' command in your `.netrc' file,
-if there is one.")
-
-(defvar ange-ftp-default-password nil
-  "*Password to use when the user name equals `ange-ftp-default-user'.")
-
-(defvar ange-ftp-default-account nil
-  "*Account to use when the user name equals `ange-ftp-default-user'.")
-
-(defvar ange-ftp-netrc-default-password nil
-  "*Password to use when the user name equals `ange-ftp-netrc-default-user'.")
-
-(defvar ange-ftp-netrc-default-account nil
-  "*Account to use when the user name equals `ange-ftp-netrc-default-user'.")
-
-(defvar ange-ftp-generate-anonymous-password t
-  "*If t, use value of `user-mail-address' as password for anonymous ftp.
-If a string, then use that string as the password.
-If nil, prompt the user for a password.")
-
-(defvar ange-ftp-dumb-unix-host-regexp nil
-  "*If non-nil, regexp matching hosts on which `dir' command lists directory.")
-
-(defvar ange-ftp-binary-file-name-regexp
-  (concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|"
-	  "\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|"
-	  "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$\\|"
-	  "\\.taz$\\|\\.tgz$")
-  "*If a file matches this regexp then it is transferred in binary mode.")
-
-(defvar ange-ftp-gateway-host nil
-  "*Name of host to use as gateway machine when local FTP isn't possible.")
-
-(defvar ange-ftp-local-host-regexp ".*"
-  "*Regexp selecting hosts which can be reached directly with ftp.
-For other hosts the FTP process is started on \`ange-ftp-gateway-host\'
-instead, and/or reached via \`ange-ftp-gateway-ftp-program-name\'.")
-
-(defvar ange-ftp-gateway-program-interactive nil
-  "*If non-nil then the gateway program should  give a shell prompt.
-Both telnet and rlogin do something like this.")
-
-(defvar ange-ftp-gateway-program remote-shell-program
-  "*Name of program to spawn a shell on the gateway machine.
-Valid candidates are rsh (remsh on some systems), telnet and rlogin.  See
-also the gateway variable above.")
-
-(defvar ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *"
-  "*Regexp matching prompt after complete login sequence on gateway machine.
-A match for this means the shell is now awaiting input.  Make this regexp as
-strict as possible; it shouldn't match *anything* at all except the user's
-initial prompt.  The above string will fail under most SUN-3's since it
-matches the login banner.")
-
-(defvar ange-ftp-gateway-setup-term-command
-  (if (eq system-type 'hpux)
-      "stty -onlcr -echo\n"
-    "stty -echo nl\n")
-  "*Set up terminal after logging in to the gateway machine.
-This command should stop the terminal from echoing each command, and
-arrange to strip out trailing ^M characters.")
-
-(defvar ange-ftp-smart-gateway nil
-  "*Non-nil means the ftp gateway and/or the gateway ftp program is smart.
-Don't bother telnetting, etc., already connected to desired host transparently,
-or just issue a user@host command in case \`ange-ftp-gateway-host\' is non-nil.")
-
-(defvar ange-ftp-smart-gateway-port "21"
-  "*Port on gateway machine to use when smart gateway is in operation.")
-
-(defvar ange-ftp-send-hash t
-  "*If non-nil, send the HASH command to the FTP client.")
-
-(defvar ange-ftp-binary-hash-mark-size nil
-  "*Default size, in bytes, between hash-marks when transferring a binary file.
-If NIL, this variable will be locally overridden if the FTP client outputs a
-suitable response to the HASH command.  If non-NIL then this value takes
-precedence over the local value.")
-
-(defvar ange-ftp-ascii-hash-mark-size 1024
-  "*Default size, in bytes, between hash-marks when transferring an ASCII file.
-This variable is buffer-local and will be locally overridden if the FTP client
-outputs a suitable response to the HASH command.")
-
-(defvar ange-ftp-process-verbose t
-  "*If non-NIL then be chatty about interaction with the FTP process.")
-
-(defvar ange-ftp-ftp-program-name "ftp"
-  "*Name of FTP program to run.")
-
-(defvar ange-ftp-gateway-ftp-program-name "ftp"
-  "*Name of FTP program to run when accessing non-local hosts.
-Some AT&T folks claim to use something called `pftp' here.")
-
-(defvar ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v")
-  "*A list of arguments passed to the FTP program when started.")
-
-(defvar ange-ftp-nslookup-program nil
-  "*If non-NIL then a string naming nslookup program." )
-
-(defvar ange-ftp-make-backup-files ()
-  "*Non-nil means make backup files for \"magic\" remote files.")
-
-(defvar ange-ftp-retry-time 5
-  "*Number of seconds to wait before retry if file or listing doesn't arrive.
-This might need to be increased for very slow connections.")
-
-(defvar ange-ftp-auto-save 0
-  "If 1, allows ange-ftp files to be auto-saved.
-If 0, suppresses auto-saving of ange-ftp files.
-Don't use any other value.")
-
-;;;; ------------------------------------------------------------
-;;;; Hash table support.
-;;;; ------------------------------------------------------------
-
-(require 'backquote)
-
-(defun ange-ftp-make-hashtable (&optional size)
-  "Make an obarray suitable for use as a hashtable.
-SIZE, if supplied, should be a prime number."
-  (make-vector (or size 31) 0))
-
-(defun ange-ftp-map-hashtable (fun tbl)
-  "Call FUNCTION on each key and value in HASHTABLE."
-  (mapatoms
-   (function 
-    (lambda (sym)
-      (funcall fun (get sym 'key) (get sym 'val))))
-   tbl))
-
-(defmacro ange-ftp-make-hash-key (key)
-  "Convert KEY into a suitable key for a hashtable."
-  (` (if (stringp (, key))
-	 (, key)
-       (prin1-to-string (, key)))))
-
-(defun ange-ftp-get-hash-entry (key tbl)
-  "Return the value associated with KEY in HASHTABLE."
-  (let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl)))
-    (and sym (get sym 'val))))
-
-(defun ange-ftp-put-hash-entry (key val tbl)
-  "Record an association between KEY and VALUE in HASHTABLE."
-  (let ((sym (intern (ange-ftp-make-hash-key key) tbl)))
-    (put sym 'val val)
-    (put sym 'key key)))
-
-(defun ange-ftp-del-hash-entry (key tbl)
-  "Copy all symbols except KEY in HASHTABLE and return modified hashtable."
-  (let* ((len (length tbl))
-	 (new-tbl (ange-ftp-make-hashtable len))
-	 (i (1- len)))
-    (ange-ftp-map-hashtable
-     (function
-      (lambda (k v)
-	(or (equal k key)
-	    (ange-ftp-put-hash-entry k v new-tbl))))
-     tbl)
-    (while (>= i 0)
-      (aset tbl i (aref new-tbl i))
-      (setq i (1- i)))
-    tbl))
-
-(defun ange-ftp-hash-entry-exists-p (key tbl)
-  "Return whether there is an association for KEY in TABLE."
-  (intern-soft (ange-ftp-make-hash-key key) tbl))
-
-(defun ange-ftp-hash-table-keys (tbl)
-  "Return a sorted list of all the active keys in TABLE, as strings."
-  (sort (all-completions "" tbl)
-	(function string-lessp)))
-
-;;;; ------------------------------------------------------------
-;;;; Internal variables.
-;;;; ------------------------------------------------------------
-
-(defvar ange-ftp-data-buffer-name " *ftp data*"
-  "Buffer name to hold directory listing data received from ftp process.")
-
-(defvar ange-ftp-netrc-modtime nil
-  "Last modified time of the netrc file from file-attributes.")
-
-(defvar ange-ftp-user-hashtable (ange-ftp-make-hashtable)
-  "Hash table holding associations between HOST, USER pairs.")
-
-(defvar ange-ftp-passwd-hashtable (ange-ftp-make-hashtable)
-  "Mapping between a HOST, USER pair and a PASSWORD for them.")
-
-(defvar ange-ftp-account-hashtable (ange-ftp-make-hashtable)
-  "Mapping between a HOST, USER pair and a ACCOUNT password for them.")
-
-(defvar ange-ftp-files-hashtable (ange-ftp-make-hashtable 97)
-  "Hash table for storing directories and their respective files.")
-
-(defvar ange-ftp-ls-cache-lsargs nil
-  "Last set of args used by ange-ftp-ls.")
-
-(defvar ange-ftp-ls-cache-file nil
-  "Last file passed to ange-ftp-ls.")
-
-(defvar ange-ftp-ls-cache-res nil
-  "Last result returned from ange-ftp-ls.")
-
-(defconst ange-ftp-expand-dir-hashtable (ange-ftp-make-hashtable))
-
-(defconst ange-ftp-expand-dir-regexp "^5.0 \\([^: ]+\\):")
-
-;; These are local variables in each FTP process buffer.
-(defvar ange-ftp-hash-mark-unit nil)
-(defvar ange-ftp-hash-mark-count nil)
-(defvar ange-ftp-xfer-size nil)
-(defvar ange-ftp-process-string nil)
-(defvar ange-ftp-process-result-line nil)
-(defvar ange-ftp-process-busy nil)
-(defvar ange-ftp-process-result nil)
-(defvar ange-ftp-process-multi-skip nil)
-(defvar ange-ftp-process-msg nil)
-(defvar ange-ftp-process-continue nil)
-(defvar ange-ftp-last-percent nil)
-
-;; These variables are bound by one function and examined by another.
-;; Leave them void globally for error checking.
-(defvar ange-ftp-this-file)
-(defvar ange-ftp-this-dir)
-(defvar ange-ftp-this-user)
-(defvar ange-ftp-this-host)
-(defvar ange-ftp-this-msg)
-(defvar ange-ftp-completion-ignored-pattern)
-(defvar ange-ftp-trample-marker)
-
-;; New error symbols.
-(put 'ftp-error 'error-conditions '(ftp-error file-error error))
-;; (put 'ftp-error 'error-message "FTP error")
-
-;;; ------------------------------------------------------------
-;;; Enhanced message support.
-;;; ------------------------------------------------------------
-
-(defun ange-ftp-message (fmt &rest args)
-  "Display message in echo area, but indicate if truncated.
-Args are as in `message': a format string, plus arguments to be formatted."
-  (let ((msg (apply (function format) fmt args))
-	(max (window-width (minibuffer-window))))
-    (if noninteractive
-	msg
-      (if (>= (length msg) max)
-	  ;; Take just the last MAX - 3 chars of the string.
-	  (setq msg (concat "> " (substring msg (- 3 max)))))
-      (message "%s" msg))))
-
-(defun ange-ftp-abbreviate-filename (file &optional new)
-  "Abbreviate the file name FILE relative to the default-directory.
-If the optional parameter NEW is given and the non-directory parts match,
-only return the directory part of FILE."
-  (save-match-data
-    (if (and default-directory
-	     (string-match (concat "^"
-				   (regexp-quote default-directory)
-				   ".") file))
-	(setq file (substring file (1- (match-end 0)))))
-    (if (and new
-	     (string-equal (file-name-nondirectory file)
-			   (file-name-nondirectory new)))
-	(setq file (file-name-directory file)))
-    (or file "./")))
-
-;;;; ------------------------------------------------------------
-;;;; User / Host mapping support.
-;;;; ------------------------------------------------------------
-
-(defun ange-ftp-set-user (host user)
-  "For a given HOST, set or change the default USER."
-  (interactive "sHost: \nsUser: ")
-  (ange-ftp-put-hash-entry host user ange-ftp-user-hashtable))
-
-(defun ange-ftp-get-user (host)
-  "Given a HOST, return the default USER."
-  (ange-ftp-parse-netrc)
-  (let ((user (ange-ftp-get-hash-entry host ange-ftp-user-hashtable)))
-    (or user
-	(prog1
-	    (setq user
-		  (cond ((stringp ange-ftp-default-user)
-			 ;; We have a default name.  Use it.
-			 ange-ftp-default-user)
-			(ange-ftp-default-user
-			 ;; Ask the user.
-			 (let ((enable-recursive-minibuffers t))
-			   (read-string (format "User for %s: " host)
-					(user-login-name))))
-			(ange-ftp-netrc-default-user)
-			;; Default to the user's login name.
-			(t
-			 (user-login-name))))
-	  (ange-ftp-set-user host user)))))
-
-;;;; ------------------------------------------------------------
-;;;; Password support.
-;;;; ------------------------------------------------------------
-
-(defun ange-ftp-read-passwd (prompt &optional default)
-  "Read a password, echoing `.' for each character typed.
-End with RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.
-Optional DEFAULT is password to start with."
-  (let ((pass nil)
-	(c 0)
-	(echo-keystrokes 0)
-	(cursor-in-echo-area t))
-    (while (progn (message "%s%s"
-			   prompt
-			   (make-string (length pass) ?.))
-		  (setq c (read-char))
-		  (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
-      (if (= c ?\C-u)
-	  (setq pass "")
-	(if (and (/= c ?\b) (/= c ?\177))
-	    (setq pass (concat pass (char-to-string c)))
-	  (if (> (length pass) 0)
-	      (setq pass (substring pass 0 -1))))))
-    (message "")
-    (ange-ftp-repaint-minibuffer)
-    (or pass default "")))
-
-(defmacro ange-ftp-generate-passwd-key (host user)
-  (` (concat (, host) "/" (, user))))
-
-(defmacro ange-ftp-lookup-passwd (host user)
-  (` (ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key (, host) (, user))
-			      ange-ftp-passwd-hashtable)))
-
-(defun ange-ftp-set-passwd (host user passwd)
-  "For a given HOST and USER, set or change the associated PASSWORD."
-  (interactive (list (read-string "Host: ")
-		     (read-string "User: ")
-		     (ange-ftp-read-passwd "Password: ")))
-  (ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user)
-			   passwd
-			   ange-ftp-passwd-hashtable))
-
-(defun ange-ftp-get-host-with-passwd (user)
-  "Given a USER, return a host we know the password for."
-  (ange-ftp-parse-netrc)
-  (catch 'found-one
-    (ange-ftp-map-hashtable
-     (function (lambda (host val)
-		 (if (ange-ftp-lookup-passwd host user)
-		     (throw 'found-one host))))
-     ange-ftp-user-hashtable)
-    (save-match-data
-      (ange-ftp-map-hashtable
-       (function
-	(lambda (key value)
-	  (if (string-match "^[^/]*\\(/\\).*$" key)
-	      (let ((host (substring key 0 (match-beginning 1))))
-		(if (and (string-equal user (substring key (match-end 1)))
-			 value)
-		    (throw 'found-one host))))))
-       ange-ftp-passwd-hashtable))
-    nil))
-
-(defun ange-ftp-get-passwd (host user)
-  "Return the password for specified HOST and USER, asking user if necessary."
-  (ange-ftp-parse-netrc)
-
-  ;; look up password in the hash table first; user might have overridden the
-  ;; defaults.
-  (cond ((ange-ftp-lookup-passwd host user))
-	
-	;; See if default user and password set.
-	((and (stringp ange-ftp-default-user)
-	      ange-ftp-default-password
-	      (string-equal user ange-ftp-default-user))
-	 ange-ftp-default-password)
-	
-	;; See if default user and password set from .netrc file.
-	((and (stringp ange-ftp-netrc-default-user)
-	      ange-ftp-netrc-default-password
-	      (string-equal user ange-ftp-netrc-default-user))
-	 ange-ftp-netrc-default-password)
-	
-	;; anonymous ftp password is handled specially since there is an
-	;; unwritten rule about how that is used on the Internet.
-	((and (or (string-equal user "anonymous")
-		  (string-equal user "ftp"))
-	      ange-ftp-generate-anonymous-password)
-	 (if (stringp ange-ftp-generate-anonymous-password)
-	     ange-ftp-generate-anonymous-password
-	   user-mail-address))
-	
-	;; see if same user has logged in to other hosts; if so then prompt
-	;; with the password that was used there.
-	(t
-	 (let* ((other (ange-ftp-get-host-with-passwd user))
-		(passwd (if other
-			    
-			    ;; found another machine with the same user.
-			    ;; Try that account.
-			    (ange-ftp-read-passwd
-			     (format "passwd for %s@%s (default same as %s@%s): "
-				     user host user other)
-			     (ange-ftp-lookup-passwd other user))
-			  
-			  ;; I give up.  Ask the user for the password.
-			  (ange-ftp-read-passwd
-			   (format "Password for %s@%s: " user host)))))
-	   (ange-ftp-set-passwd host user passwd)
-	   passwd))))
-
-;;;; ------------------------------------------------------------
-;;;; Account support
-;;;; ------------------------------------------------------------
-
-;; Account passwords must be either specified in the .netrc file, or set
-;; manually by calling ange-ftp-set-account.  For the moment, ange-ftp doesn't
-;; check to see whether the FTP process is actually prompting for an account
-;; password.
- 
-(defun ange-ftp-set-account (host user account)
-  "For a given HOST and USER, set or change the associated ACCOUNT password."
-  (interactive (list (read-string "Host: ")
-		     (read-string "User: ")
-		     (ange-ftp-read-passwd "Account password: ")))
-  (ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user)
-			   account
-			   ange-ftp-account-hashtable))
-
-(defun ange-ftp-get-account (host user)
-  "Given a HOST and USER, return the FTP account."
-  (ange-ftp-parse-netrc)
-  (or (ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key host user)
-			       ange-ftp-account-hashtable)
-      (and (stringp ange-ftp-default-user)
-	   (string-equal user ange-ftp-default-user)
-	   ange-ftp-default-account)
-      (and (stringp ange-ftp-netrc-default-user)
-	   (string-equal user ange-ftp-netrc-default-user)
-	   ange-ftp-netrc-default-account)))
-
-;;;; ------------------------------------------------------------
-;;;; ~/.netrc support
-;;;; ------------------------------------------------------------
-
-(defun ange-ftp-chase-symlinks (file)
-  "Return the filename that FILE references, following all symbolic links."
-  (let (temp)
-    (while (setq temp (ange-ftp-real-file-symlink-p file))
-      (setq file
-	    (if (file-name-absolute-p temp)
-		temp
-	      (concat (file-name-directory file) temp)))))
-  file)
-
-;; Move along current line looking for the value of the TOKEN.
-;; Valid separators between TOKEN and its value are commas and
-;; whitespace.  Second arg LIMIT is a limit for the search.
-
-(defun ange-ftp-parse-netrc-token (token limit)
-  (if (search-forward token limit t)
-      (let (beg)
-	(skip-chars-forward ", \t\r\n" limit)
-	(if (eq (following-char) ?\")	;quoted token value
-	    (progn (forward-char 1)
-		   (setq beg (point))
-		   (skip-chars-forward "^\"" limit)
-		   (forward-char 1)
-		   (buffer-substring beg (1- (point))))
-	  (setq beg (point))
-	  (skip-chars-forward "^, \t\r\n" limit)
-	  (buffer-substring beg (point))))))
-
-;; Extract the values for the tokens `machine', `login',
-;; `password' and `account' in the current buffer.  If successful,
-;; record the information found.
-
-(defun ange-ftp-parse-netrc-group ()
-  (let ((start (point))
-	(end (save-excursion
-	       (if (looking-at "machine\\>")
-		   ;; Skip `machine' and the machine name that follows.
-		   (progn
-		     (skip-chars-forward "^ \t\n")
-		     (skip-chars-forward " \t\n")
-		     (skip-chars-forward "^ \t\n"))
-		 ;; Skip `default'.
-		 (skip-chars-forward "^ \t\n"))
-	       ;; Find start of the next `machine' or `default'
-	       ;; or the end of the buffer.
-	       (if (re-search-forward "machine\\>\\|default\\>" nil t)
-		   (match-beginning 0)
-		 (point-max))))
-	machine login password account)
-    (setq machine  (ange-ftp-parse-netrc-token "machine"  end)
-	  login    (ange-ftp-parse-netrc-token "login"    end)
-	  password (ange-ftp-parse-netrc-token "password" end)
-	  account  (ange-ftp-parse-netrc-token "account"  end))
-    (if (and machine login)
-	;; found a `machine` token.
-	(progn
-	  (ange-ftp-set-user machine login)
-	  (ange-ftp-set-passwd machine login password)
-	  (and account
-	       (ange-ftp-set-account machine login account)))
-      (goto-char start)
-      (if (search-forward "default" end t)
-	  ;; found a `default' token
-	  (progn
-	    (setq login    (ange-ftp-parse-netrc-token "login"    end)
-		  password (ange-ftp-parse-netrc-token "password" end)
-		  account  (ange-ftp-parse-netrc-token "account"  end))
-	    (and login
-		 (setq ange-ftp-netrc-default-user login))
-	    (and password
-		 (setq ange-ftp-netrc-default-password password))
-	    (and account
-		 (setq ange-ftp-netrc-default-account account)))))
-    (goto-char end)))
-
-;; Read in ~/.netrc, if one exists.  If ~/.netrc file exists and has
-;; the correct permissions then extract the \`machine\', \`login\',
-;; \`password\' and \`account\' information from within.
-
-(defun ange-ftp-parse-netrc ()
-  ;; We set this before actually doing it to avoid the possibility
-  ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file.
-  (interactive)
-  (let (file attr)
-    (let ((default-directory "/"))
-      (setq file (ange-ftp-chase-symlinks
-		  (ange-ftp-real-expand-file-name ange-ftp-netrc-filename)))
-      (setq attr (ange-ftp-real-file-attributes file)))
-    (if (and attr			; file exists.
-	     (not (equal (nth 5 attr) ange-ftp-netrc-modtime)))	; file changed
-	(save-match-data
-	  (if (or ange-ftp-disable-netrc-security-check
-		  (and (eq (nth 2 attr) (user-uid)) ; Same uids.
-		       (string-match ".r..------" (nth 8 attr))))
-	      (save-excursion
-		;; we are cheating a bit here.  I'm trying to do the equivalent
-		;; of find-file on the .netrc file, but then nuke it afterwards.
-		;; with the bit of logic below we should be able to have
-		;; encrypted .netrc files.
-		(set-buffer (generate-new-buffer "*ftp-.netrc*"))
-		(ange-ftp-real-insert-file-contents file)
-		(setq buffer-file-name file)
-		(setq default-directory (file-name-directory file))
-		(normal-mode t)
-		(mapcar 'funcall find-file-hooks)
-		(setq buffer-file-name nil)
-		(goto-char (point-min))
-		(skip-chars-forward " \t\n")
-		(while (not (eobp))
-		  (ange-ftp-parse-netrc-group))
-		(kill-buffer (current-buffer)))
-	    (ange-ftp-message "%s either not owned by you or badly protected."
-			      ange-ftp-netrc-filename)
-	    (sit-for 1))
-	  (setq ange-ftp-netrc-modtime (nth 5 attr))))))
-
-;; Return a list of prefixes of the form 'user@host:' to be used when
-;; completion is done in the root directory.
-
-(defun ange-ftp-generate-root-prefixes ()
-  (ange-ftp-parse-netrc)
-  (save-match-data
-    (let (res)
-      (ange-ftp-map-hashtable
-       (function
-	(lambda (key value)
-	  (if (string-match "^[^/]*\\(/\\).*$" key)
-	      (let ((host (substring key 0 (match-beginning 1)))
-		    (user (substring key (match-end 1))))
-		(setq res (cons (list (concat user "@" host ":"))
-				res))))))
-       ange-ftp-passwd-hashtable)
-      (ange-ftp-map-hashtable
-       (function (lambda (host user)
-		   (setq res (cons (list (concat host ":"))
-				   res))))
-       ange-ftp-user-hashtable)
-      (or res (list nil)))))
-
-;;;; ------------------------------------------------------------
-;;;; Remote file name syntax support.
-;;;; ------------------------------------------------------------
-
-(defmacro ange-ftp-ftp-name-component (n ns name)
-  "Extract the Nth ftp file name component from NS."
-  (` (let ((elt (nth (, n) (, ns))))
-       (if (match-beginning elt)
-	   (substring (, name) (match-beginning elt) (match-end elt))))))
-
-(defvar ange-ftp-ftp-name-arg "")
-(defvar ange-ftp-ftp-name-res nil)
-
-;; Parse NAME according to `ange-ftp-name-format' (which see).
-;; Returns a list (HOST USER NAME), or nil if NAME does not match the format.
-(defun ange-ftp-ftp-name (name)
-  (if (string-equal name ange-ftp-ftp-name-arg)
-      ange-ftp-ftp-name-res
-    (setq ange-ftp-ftp-name-arg name
-	  ange-ftp-ftp-name-res
-	  (save-match-data
-	    (if (posix-string-match (car ange-ftp-name-format) name)
-		(let* ((ns (cdr ange-ftp-name-format))
-		       (host (ange-ftp-ftp-name-component 0 ns name))
-		       (user (ange-ftp-ftp-name-component 1 ns name))
-		       (name (ange-ftp-ftp-name-component 2 ns name)))
-		  (if (zerop (length user))
-		      (setq user (ange-ftp-get-user host)))
-		  (list host user name))
-	      nil)))))
-
-;; Take a FULLNAME that matches according to ange-ftp-name-format and
-;; replace the name component with NAME.
-(defun ange-ftp-replace-name-component (fullname name)
-  (save-match-data
-    (if (posix-string-match (car ange-ftp-name-format) fullname)
-	(let* ((ns (cdr ange-ftp-name-format))
-	       (elt (nth 2 ns)))
-	  (concat (substring fullname 0 (match-beginning elt))
-		  name
-		  (substring fullname (match-end elt)))))))
-
-;;;; ------------------------------------------------------------
-;;;; Miscellaneous utils.
-;;;; ------------------------------------------------------------
-
-;; (setq ange-ftp-tmp-keymap (make-sparse-keymap))
-;; (define-key ange-ftp-tmp-keymap "\C-m" 'exit-minibuffer)
-
-(defun ange-ftp-repaint-minibuffer ()
-  "Clear any existing minibuffer message; let the minibuffer contents show."
-  (message nil))
-
-;; Return the name of the buffer that collects output from the ftp process
-;; connected to the given HOST and USER pair.
-(defun ange-ftp-ftp-process-buffer (host user)
-  (concat "*ftp " user "@" host "*"))
-
-;; Display the last chunk of output from the ftp process for the given HOST
-;; USER pair, and signal an error including MSG in the text.
-(defun ange-ftp-error (host user msg)
-  (let ((cur (selected-window))
-	(pop-up-windows t))
-    (pop-to-buffer
-     (get-buffer-create
-      (ange-ftp-ftp-process-buffer host user)))
-    (goto-char (point-max))
-    (select-window cur))
-  (signal 'ftp-error (list (format "FTP Error: %s" msg))))
-
-(defun ange-ftp-set-buffer-mode ()
-  "Set correct modes for the current buffer if visiting a remote file."
-  (if (and (stringp buffer-file-name)
-	   (ange-ftp-ftp-name buffer-file-name))
-      (auto-save-mode ange-ftp-auto-save)))
-
-(defun ange-ftp-kill-ftp-process (&optional buffer)
-  "Kill the FTP process associated with BUFFER (the current buffer, if nil).
-If the BUFFER's visited filename or default-directory is an ftp filename
-then kill the related ftp process."
-  (interactive "bKill FTP process associated with buffer: ")
-  (if (null buffer)
-      (setq buffer (current-buffer))
-    (setq buffer (get-buffer buffer)))
-  (let ((file (or (buffer-file-name buffer)
-		  (save-excursion (set-buffer buffer) default-directory))))
-    (if file
-	(let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
-	  (if parsed
-	      (let ((host (nth 0 parsed))
-		    (user (nth 1 parsed)))
-		(kill-buffer (ange-ftp-ftp-process-buffer host user))))))))
-
-(defun ange-ftp-quote-string (string)
-  "Quote any characters in STRING that may confuse the ftp process."
-  (apply (function concat)
-	 (mapcar (function
-		   (lambda (char)
-		     (if (or (<= char ? )
-			     (> char ?\~)
-		             (= char ?\")
-			     (= char ?\\))
-			 (vector ?\\ char)
-		       (vector char))))
-		 string)))
-
-(defun ange-ftp-barf-if-not-directory (directory)
-  (or (file-directory-p directory)
-      (signal 'file-error
-	      (list "Opening directory"
-		    (if (file-exists-p directory)
-			"not a directory"
-		      "no such file or directory")
-		    directory))))
-
-;;;; ------------------------------------------------------------
-;;;; FTP process filter support.
-;;;; ------------------------------------------------------------
-
-(defun ange-ftp-process-handle-line (line proc)
-  "Look at the given LINE from the ftp process PROC.
-Try to categorize it into one of four categories:
-good, skip, fatal, or unknown."
-  (cond ((string-match ange-ftp-xfer-size-msgs line)
-	 (setq ange-ftp-xfer-size
-	       (ash (string-to-int (substring line
-					      (match-beginning 1)
-					      (match-end 1)))
-		    -10)))
-	((string-match ange-ftp-skip-msgs line)
-	 t)
-	((string-match ange-ftp-good-msgs line)
-	 (setq ange-ftp-process-busy nil
-	       ange-ftp-process-result t
-	       ange-ftp-process-result-line line))
-	;; Check this before checking for errors.
-	;; Otherwise the last line of these three seems to be an error:
-	;; 230-see a significant impact from the move.  For those of you who can't
-	;; 230-use DNS to resolve hostnames and get an error message like
-	;; 230-"ftp.stsci.edu: unknown host", the new IP address will be...
-	((string-match ange-ftp-multi-msgs line)
-	 (setq ange-ftp-process-multi-skip t))
-	((string-match ange-ftp-fatal-msgs line)
-	 (delete-process proc)
-	 (setq ange-ftp-process-busy nil
-	       ange-ftp-process-result-line line))
-	(ange-ftp-process-multi-skip
-	 t)
-	(t
-	 (setq ange-ftp-process-busy nil
-	       ange-ftp-process-result-line line))))
-
-(defun ange-ftp-set-xfer-size (host user bytes)
-  "Set the size of the next FTP transfer in bytes."
-  (let ((proc (ange-ftp-get-process host user)))
-    (if proc
-	(let ((buf (process-buffer proc)))
-	  (if buf
-	      (save-excursion
-		(set-buffer buf)
-		(setq ange-ftp-xfer-size (ash bytes -10))))))))
-
-(defun ange-ftp-process-handle-hash (str)
-  "Remove hash marks from STRING and display count so far."
-  (setq str (concat (substring str 0 (match-beginning 0))
-		    (substring str (match-end 0)))
-	ange-ftp-hash-mark-count (+ (- (match-end 0)
-				       (match-beginning 0))
-				    ange-ftp-hash-mark-count))
-  (and ange-ftp-hash-mark-unit
-       ange-ftp-process-msg
-       ange-ftp-process-verbose
-       (not (eq (selected-window) (minibuffer-window)))
-       (not (boundp 'search-message))	;screws up isearch otherwise
-       (not cursor-in-echo-area)	;screws up y-or-n-p otherwise
-       (let ((kbytes (ash (* ange-ftp-hash-mark-unit
-			     ange-ftp-hash-mark-count)
-			  -6)))
-       (if (zerop ange-ftp-xfer-size)
-	   (ange-ftp-message "%s...%dk" ange-ftp-process-msg kbytes)
-	 (let ((percent (/ (* 100 kbytes) ange-ftp-xfer-size)))
-	   ;; cut out the redisplay of identical %-age messages.
-	   (if (not (eq percent ange-ftp-last-percent))
-	       (progn
-		 (setq ange-ftp-last-percent percent)
-		 (ange-ftp-message "%s...%d%%" ange-ftp-process-msg percent)))))))
-  str)
-
-;; Call the function specified by CONT.  CONT can be either a function
-;; or a list of a function and some args.  The first two parameters
-;; passed to the function will be RESULT and LINE.  The remaining args
-;; will be taken from CONT if a list was passed.
-
-(defun ange-ftp-call-cont (cont result line)
-  (if cont
-      (if (and (listp cont)
-	       (not (eq (car cont) 'lambda)))
-	  (apply (car cont) result line (cdr cont))
-	(funcall cont result line))))
-
-;; Build up a complete line of output from the ftp PROCESS and pass it
-;; on to ange-ftp-process-handle-line to deal with.
-
-(defun ange-ftp-process-filter (proc str)
-  (let ((buffer (process-buffer proc))
-	(old-buffer (current-buffer)))
-
-    ;; Eliminate nulls.
-    (while (string-match "\000+" str)
-      (setq str (replace-match "" nil nil str))) 
-
-    ;; see if the buffer is still around... it could have been deleted.
-    (if (buffer-name buffer)
-	(unwind-protect
-	    (progn
-	      (set-buffer (process-buffer proc))
-	      
-	      ;; handle hash mark printing
-	      (and ange-ftp-process-busy
-		   (string-match "^#+$" str)
-		   (setq str (ange-ftp-process-handle-hash str)))
-	      (comint-output-filter proc str)
-	      ;; Replace STR by the result of the comint processing.
-	      (setq str (buffer-substring comint-last-output-start
-					  (process-mark proc)))
-	      (if ange-ftp-process-busy
-		  (progn
-		    (setq ange-ftp-process-string (concat ange-ftp-process-string
-							  str))
-		    
-		    ;; if we gave an empty password to the USER command earlier
-		    ;; then we should send a null password now.
-		    (if (string-match "Password: *$" ange-ftp-process-string)
-			(send-string proc "\n"))))
-	      (while (and ange-ftp-process-busy
-			  (string-match "\n" ange-ftp-process-string))
-		(let ((line (substring ange-ftp-process-string
-				       0
-				       (match-beginning 0))))
-		  (setq ange-ftp-process-string (substring ange-ftp-process-string
-							   (match-end 0)))
-		  (while (string-match "^ftp> *" line)
-		    (setq line (substring line (match-end 0))))
-		  (ange-ftp-process-handle-line line proc)))
-
-	      ;; has the ftp client finished?  if so then do some clean-up
-	      ;; actions.
-	      (if (not ange-ftp-process-busy)
-		  (progn
-		    ;; reset the xfer size
-		    (setq ange-ftp-xfer-size 0)
-
-		    ;; issue the "done" message since we've finished.
-		    (if (and ange-ftp-process-msg
-			     ange-ftp-process-verbose
-			     ange-ftp-process-result)
-			(progn
-			  (ange-ftp-message "%s...done" ange-ftp-process-msg)
-			  (ange-ftp-repaint-minibuffer)
-			  (setq ange-ftp-process-msg nil)))
-		    
-		    ;; is there a continuation we should be calling?  if so,
-		    ;; we'd better call it, making sure we only call it once.
-		    (if ange-ftp-process-continue
-			(let ((cont ange-ftp-process-continue))
-			  (setq ange-ftp-process-continue nil)
-			  (ange-ftp-call-cont cont
-					      ange-ftp-process-result
-					      ange-ftp-process-result-line))))))
-	  (set-buffer old-buffer)))))
-
-(defun ange-ftp-process-sentinel (proc str)
-  "When ftp process changes state, nuke all file-entries in cache."
-  (let ((name (process-name proc)))
-    (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" name)
-	(let ((user (substring name (match-beginning 1) (match-end 1)))
-	      (host (substring name (match-beginning 2) (match-end 2))))
-	  (ange-ftp-wipe-file-entries host user))))
-  (setq ange-ftp-ls-cache-file nil))
-
-;;;; ------------------------------------------------------------
-;;;; Gateway support.
-;;;; ------------------------------------------------------------
-
-(defun ange-ftp-use-gateway-p (host)
-  "Returns whether to access this host via a normal (non-smart) gateway."
-  ;; yes, I know that I could simplify the following expression, but it is
-  ;; clearer (to me at least) this way.
-  (and (not ange-ftp-smart-gateway)
-       (save-match-data
-	 (not (string-match ange-ftp-local-host-regexp host)))))
-
-(defun ange-ftp-use-smart-gateway-p (host)
-  "Returns whether to access this host via a smart gateway."
-  (and ange-ftp-smart-gateway
-       (save-match-data
-	 (not (string-match ange-ftp-local-host-regexp host)))))
-
-
-;;; ------------------------------------------------------------
-;;; Temporary file location and deletion...
-;;; ------------------------------------------------------------
-
-(defvar ange-ftp-tmp-name-files ())
-(defvar ange-ftp-tmp-name-hashtable (ange-ftp-make-hashtable 10))
-(defvar ange-ftp-pid nil)
-
-(defun ange-ftp-get-pid ()
-  "Half-hearted attempt to get the current process's id."
-  (setq ange-ftp-pid (substring (make-temp-name "") 1)))
-
-(defun ange-ftp-make-tmp-name (host)
-  "This routine will return the name of a new file."
-  (let* ((template (if (ange-ftp-use-gateway-p host)
-		       ange-ftp-gateway-tmp-name-template
-		     ange-ftp-tmp-name-template))
-	 (pid (or ange-ftp-pid (ange-ftp-get-pid)))
-	 (start ?a)
-	 file entry)
-    (while 
-	(progn
-	  (setq file (format "%s%c%s" template start pid))
-	  (setq entry (intern file ange-ftp-tmp-name-hashtable))
-	  (or (memq entry ange-ftp-tmp-name-files)
-	      (ange-ftp-real-file-exists-p file)))
-      (if (> (setq start (1+ start)) ?z)
-	  (progn
-	    (setq template (concat template "X"))
-	    (setq start ?a))))
-    (setq ange-ftp-tmp-name-files
-	  (cons entry ange-ftp-tmp-name-files))
-    file))
-
-(defun ange-ftp-del-tmp-name (temp)
-  (setq ange-ftp-tmp-name-files
-	(delq (intern temp ange-ftp-tmp-name-hashtable)
-	      ange-ftp-tmp-name-files))
-  (condition-case ()
-      (ange-ftp-real-delete-file temp)
-    (error nil)))
-
-;;;; ------------------------------------------------------------
-;;;; Interactive gateway program support.
-;;;; ------------------------------------------------------------
-
-(defvar ange-ftp-gwp-running t)
-(defvar ange-ftp-gwp-status nil)
-
-(defun ange-ftp-gwp-sentinel (proc str)
-  (setq ange-ftp-gwp-running nil))
-
-(defun ange-ftp-gwp-filter (proc str)
-  (comint-output-filter proc str)
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    ;; Replace STR by the result of the comint processing.
-    (setq str (buffer-substring comint-last-output-start (process-mark proc))))
-  (cond ((string-match "login: *$" str)
-	 (send-string proc
-		      (concat
-		       (let ((ange-ftp-default-user t))
-			 (ange-ftp-get-user ange-ftp-gateway-host))
-		       "\n")))
-	((string-match "Password: *$" str)
-	 (send-string proc
-		      (concat
-		       (ange-ftp-get-passwd ange-ftp-gateway-host
-					    (ange-ftp-get-user
-					     ange-ftp-gateway-host))
-		       "\n")))
-	((string-match ange-ftp-gateway-fatal-msgs str)
-	 (delete-process proc)
-	 (setq ange-ftp-gwp-running nil))
-	((string-match ange-ftp-gateway-prompt-pattern str)
-	 (setq ange-ftp-gwp-running nil
-	       ange-ftp-gwp-status t))))
-
-(defun ange-ftp-gwp-start (host user name args)
-  "Login to the gateway machine and fire up an ftp process."
-  (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host))
-	 ;; It would be nice to make process-connection-type nil,
-	 ;; but that doesn't work: ftp never responds.
-	 ;; Can anyone find a fix for that?
-	 (proc (let ((process-connection-type t))
-		 (start-process name name
-				ange-ftp-gateway-program
-				ange-ftp-gateway-host)))
-	 (ftp (mapconcat (function identity) args " ")))
-    (process-kill-without-query proc)
-    (set-process-sentinel proc (function ange-ftp-gwp-sentinel))
-    (set-process-filter proc (function ange-ftp-gwp-filter))
-    (save-excursion
-      (set-buffer (process-buffer proc))
-      (internal-ange-ftp-mode)
-      (set-marker (process-mark proc) (point)))
-    (setq ange-ftp-gwp-running t
-	  ange-ftp-gwp-status nil)
-    (ange-ftp-message "Connecting to gateway %s..." ange-ftp-gateway-host)
-    (while ange-ftp-gwp-running		;perform login sequence
-      (accept-process-output proc))
-    (if (not ange-ftp-gwp-status)
-	(ange-ftp-error host user "unable to login to gateway"))
-    (ange-ftp-message "Connecting to gateway %s...done" ange-ftp-gateway-host)
-    (setq ange-ftp-gwp-running t
-	  ange-ftp-gwp-status nil)
-    (process-send-string proc ange-ftp-gateway-setup-term-command)
-    (while ange-ftp-gwp-running		;zap ^M's and double echoing.
-      (accept-process-output proc))
-    (if (not ange-ftp-gwp-status)
-	(ange-ftp-error host user "unable to set terminal modes on gateway"))
-    (setq ange-ftp-gwp-running t
-	  ange-ftp-gwp-status nil)
-    (process-send-string proc (concat "exec " ftp "\n")) ;spawn ftp process
-    proc))
-
-;;;; ------------------------------------------------------------
-;;;; Support for sending commands to the ftp process.
-;;;; ------------------------------------------------------------
-
-(defun ange-ftp-raw-send-cmd (proc cmd &optional msg cont nowait)
-  "Low-level routine to send the given ftp CMD to the ftp PROCESS.
-MSG is an optional message to output before and after the command.
-If CONT is non-NIL then it is either a function or a list of function and
-some arguments.  The function will be called when the ftp command has completed.
-If CONT is NIL then this routine will return \( RESULT . LINE \) where RESULT
-is whether the command was successful, and LINE is the line from the FTP
-process that caused the command to complete.
-If NOWAIT is given then the routine will return immediately the command has
-been queued with no result.  CONT will still be called, however."
-  (if (memq (process-status proc) '(run open))
-      (save-excursion
-	(set-buffer (process-buffer proc))
-	(ange-ftp-wait-not-busy proc)
-	(setq ange-ftp-process-string ""
-	      ange-ftp-process-result-line ""
-	      ange-ftp-process-busy t
-	      ange-ftp-process-result nil
-	      ange-ftp-process-multi-skip nil
-	      ange-ftp-process-msg msg
-	      ange-ftp-process-continue cont
-	      ange-ftp-hash-mark-count 0
-	      ange-ftp-last-percent -1
-	      cmd (concat cmd "\n"))
-	(and msg ange-ftp-process-verbose (ange-ftp-message "%s..." msg))
-	(goto-char (point-max))
-	(move-marker comint-last-input-start (point))
-	;; don't insert the password into the buffer on the USER command.
-	(save-match-data
-	  (if (string-match "^user \"[^\"]*\"" cmd)
-	      (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
-	    (insert cmd)))
-	(move-marker comint-last-input-end (point))
-	(send-string proc cmd)
-	(set-marker (process-mark proc) (point))
-	(if nowait
-	    nil
-	  (ange-ftp-wait-not-busy proc)
-	  (if cont
-	      nil			;cont has already been called
-	    (cons ange-ftp-process-result ange-ftp-process-result-line))))))
-
-;; Wait for the ange-ftp process PROC not to be busy.
-(defun ange-ftp-wait-not-busy (proc)
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    (condition-case nil
-	;; This is a kludge to let user quit in case ftp gets hung.
-	;; It matters because this function can be called from the filter.
-	;; It is bad to allow quitting in a filter, but getting hung
-	;; is worse.  By binding quit-flag to nil, we might avoid
-	;; most of the probability of getting screwed because the user
-	;; wants to quit some command.
-	(let ((quit-flag nil)
-	      (inhibit-quit nil))
-	  (while ange-ftp-process-busy
-	    (accept-process-output proc)))
-      (quit
-       ;; If the user does quit out of this,
-       ;; kill the process.  That stops any transfer in progress.
-       ;; The next operation will open a new ftp connection.
-       (delete-process proc)
-       (signal 'quit nil)))))
-
-(defun ange-ftp-nslookup-host (host)
-  "Attempt to resolve the given HOSTNAME using nslookup if possible."
-  (interactive "sHost:  ")
-  (if ange-ftp-nslookup-program
-      (let ((default-directory
-	      (if (file-accessible-directory-p default-directory)
-		  default-directory
-		exec-directory))
-	    ;; It would be nice to make process-connection-type nil,
-	    ;; but that doesn't work: ftp never responds.
-	    ;; Can anyone find a fix for that?
-	    (proc (let ((process-connection-type t))
-		    (start-process " *nslookup*" " *nslookup*"
-				   ange-ftp-nslookup-program host)))
-	    (res host))
-	(process-kill-without-query proc)
-	(save-excursion
-	  (set-buffer (process-buffer proc))
-	  (while (memq (process-status proc) '(run open))
-	    (accept-process-output proc))
-	  (goto-char (point-min))
-	  (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
-	      (setq res (buffer-substring (match-beginning 1)
-					  (match-end 1))))
-	  (kill-buffer (current-buffer)))
-	res)
-    host))
-
-(defun ange-ftp-start-process (host user name)
-  "Spawn a new ftp process ready to connect to machine HOST and give it NAME.
-If HOST is only ftp-able through a gateway machine then spawn a shell
-on the gateway machine to do the ftp instead."
-  (let* ((use-gateway (ange-ftp-use-gateway-p host))
-	 (use-smart-ftp (and (not ange-ftp-gateway-host)
-			     (ange-ftp-use-smart-gateway-p host)))
-	 (ftp-prog (if (or use-gateway
-			   use-smart-ftp) 
-		       ange-ftp-gateway-ftp-program-name
-		     ange-ftp-ftp-program-name))
-	 (args (append (list ftp-prog) ange-ftp-ftp-program-args))
-	 ;; Without the following binding, ange-ftp-start-process
-	 ;; recurses on file-accessible-directory-p, since it needs to
-	 ;; restart its process in order to determine anything about
-	 ;; default-directory.
-	 (file-name-handler-alist)
-	 (default-directory
-	   (if (file-accessible-directory-p default-directory)
-	       default-directory
-	     exec-directory))
-	 proc)
-    ;; It would be nice to make process-connection-type nil,
-    ;; but that doesn't work: ftp never responds.
-    ;; Can anyone find a fix for that?
-    (let ((process-connection-type t)
-	  (process-environment process-environment))
-      ;; This tells GNU ftp not to output any fancy escape sequences.
-      (setenv "TERM" "dumb")
-      (if use-gateway
-	  (if ange-ftp-gateway-program-interactive
-	      (setq proc (ange-ftp-gwp-start host user name args))
-	    (setq proc (apply 'start-process name name
-			      (append (list ange-ftp-gateway-program
-					    ange-ftp-gateway-host)
-				      args))))
-	(setq proc (apply 'start-process name name args))))
-    (process-kill-without-query proc)
-    (save-excursion
-      (set-buffer (process-buffer proc))
-      (internal-ange-ftp-mode))
-    (set-process-sentinel proc (function ange-ftp-process-sentinel))
-    (set-process-filter proc (function ange-ftp-process-filter))
-    (accept-process-output proc)	;wait for ftp startup message
-    proc))
-
-(defun internal-ange-ftp-mode ()
-  "Major mode for interacting with the FTP process.
-
-\\{comint-mode-map}"
-  (interactive)
-  (comint-mode)
-  (setq major-mode 'internal-ange-ftp-mode)
-  (setq mode-name "Internal Ange-ftp")
-  (let ((proc (get-buffer-process (current-buffer))))
-    (goto-char (point-max))
-    (set-marker (process-mark proc) (point))
-    (make-local-variable 'ange-ftp-process-string)
-    (setq ange-ftp-process-string "")
-    (make-local-variable 'ange-ftp-process-busy)
-    (make-local-variable 'ange-ftp-process-result)
-    (make-local-variable 'ange-ftp-process-msg)
-    (make-local-variable 'ange-ftp-process-multi-skip)
-    (make-local-variable 'ange-ftp-process-result-line)
-    (make-local-variable 'ange-ftp-process-continue)
-    (make-local-variable 'ange-ftp-hash-mark-count)
-    (make-local-variable 'ange-ftp-binary-hash-mark-size)
-    (make-local-variable 'ange-ftp-ascii-hash-mark-size)
-    (make-local-variable 'ange-ftp-hash-mark-unit)
-    (make-local-variable 'ange-ftp-xfer-size)
-    (make-local-variable 'ange-ftp-last-percent)
-    (setq ange-ftp-hash-mark-count 0)
-    (setq ange-ftp-xfer-size 0)
-    (setq ange-ftp-process-result-line "")
-
-    (setq comint-prompt-regexp "^ftp> ")
-    (make-local-variable 'comint-password-prompt-regexp)
-    ;; This is a regexp that can't match anything.
-    ;; ange-ftp has its own ways of handling passwords.
-    (setq comint-password-prompt-regexp "^a\\'z")
-    (make-local-variable 'paragraph-start)
-    (setq paragraph-start comint-prompt-regexp)))
-
-(defun ange-ftp-smart-login (host user pass account proc)
-  "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
-PROC is the FTP-client's process.  This routine uses the smart-gateway
-host specified in ``ange-ftp-gateway-host''."
-  (let ((result (ange-ftp-raw-send-cmd
-		 proc
-		 (format "open %s %s"
-			 (ange-ftp-nslookup-host ange-ftp-gateway-host)
-			 ange-ftp-smart-gateway-port)
-		 (format "Opening FTP connection to %s via %s"
-			 host
-			 ange-ftp-gateway-host))))
-    (or (car result)
-	(ange-ftp-error host user 
-			(concat "OPEN request failed: "
-				(cdr result))))
-    (setq result (ange-ftp-raw-send-cmd
-		  proc (format "user \"%s\"@%s %s %s"
-			       user
-			       (ange-ftp-nslookup-host host)
-			       pass
-			       account)
-		  (format "Logging in as user %s@%s"
-			  user host)))
-    (or (car result)
-	(progn
-	  (ange-ftp-set-passwd host user nil) ; reset password
-	  (ange-ftp-set-account host user nil) ; reset account
-	  (ange-ftp-error host user
-			  (concat "USER request failed: "
-				  (cdr result)))))))
-
-(defun ange-ftp-normal-login (host user pass account proc)
-  "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
-PROC is the process to the FTP-client."
-  (let* ((nshost (ange-ftp-nslookup-host host))
-	 (result (ange-ftp-raw-send-cmd
-		 proc
-		 (format "open %s" nshost)
-		 (format "Opening FTP connection to %s" host))))
-    (or (car result)
-	(ange-ftp-error host user
-			(concat "OPEN request failed: "
-				(cdr result))))
-    (setq result (ange-ftp-raw-send-cmd
-		  proc
-		  (if (and (ange-ftp-use-smart-gateway-p host)
-			   ange-ftp-gateway-host)
-		      (format "user \"%s\"@%s %s %s" user nshost pass account)
-		    (format "user \"%s\" %s %s" user pass account))
-		  (format "Logging in as user %s@%s" user host)))
-    (or (car result)
-	(progn
-	  (ange-ftp-set-passwd host user nil) ;reset password.
-	  (ange-ftp-set-account host user nil) ;reset account.
-	  (ange-ftp-error host user
-			  (concat "USER request failed: "
-				  (cdr result)))))))
-
-;; ange@hplb.hpl.hp.com says this should not be changed.
-(defvar ange-ftp-hash-mark-msgs
-  "[hH]ash mark [^0-9]*\\([0-9]+\\)"
-  "*Regexp matching the FTP client's output upon doing a HASH command.")
-
-(defun ange-ftp-guess-hash-mark-size (proc)
-  (if ange-ftp-send-hash
-      (save-excursion
-	(set-buffer (process-buffer proc))
-	(let* ((status (ange-ftp-raw-send-cmd proc "hash"))
-	       (result (car status))
-	       (line (cdr status)))
-	  (save-match-data
-	    (if (string-match ange-ftp-hash-mark-msgs line)
-		(let ((size (string-to-int
-			    (substring line
-				       (match-beginning 1)
-				       (match-end 1)))))
-		  (setq ange-ftp-ascii-hash-mark-size size
-			ange-ftp-hash-mark-unit (ash size -4))
-
-		  ;; if a default value for this is set, use that value.
-		  (or ange-ftp-binary-hash-mark-size
-		      (setq ange-ftp-binary-hash-mark-size size)))))))))
-
-(defun ange-ftp-get-process (host user)
-  "Return an FTP subprocess connected to HOST and logged in as USER.
-Create a new process if needed."
-  (let* ((name (ange-ftp-ftp-process-buffer host user))
-	 (proc (get-process name)))
-    (if (and proc (memq (process-status proc) '(run open)))
-	proc
-      (let ((pass (ange-ftp-quote-string
-		   (ange-ftp-get-passwd host user)))
-	    (account (ange-ftp-quote-string
-		      (ange-ftp-get-account host user))))
-	;; grab a suitable process.
-	(setq proc (ange-ftp-start-process host user name))
-	
-	;; login to FTP server.
-	(if (and (ange-ftp-use-smart-gateway-p host)
-		 ange-ftp-gateway-host)
-	    (ange-ftp-smart-login host user pass account proc)
-	  (ange-ftp-normal-login host user pass account proc))
-      
-	;; Tell client to send back hash-marks as progress.  It isn't usually
-	;; fatal if this command fails.
-	(ange-ftp-guess-hash-mark-size proc)
-
-	;; Guess at the host type.
-	(ange-ftp-guess-host-type host user)
-
-	;; Run any user-specified hooks.  Note that proc, host and user are
-	;; dynamically bound at this point.
-	(run-hooks 'ange-ftp-process-startup-hook))
-      proc)))
-
-;; Variables for caching host and host-type
-(defvar ange-ftp-host-cache nil)
-(defvar ange-ftp-host-type-cache nil)
-
-;; If ange-ftp-host-type is called with the optional user
-;; argument, it will attempt to guess the host type by connecting
-;; as user, if necessary. For efficiency, I have tried to give this
-;; optional second argument only when necessary. Have I missed any calls
-;; to ange-ftp-host-type where it should have been supplied?
-
-(defun ange-ftp-host-type (host &optional user)
-  "Return a symbol which represents the type of the HOST given.
-If the optional argument USER is given, attempts to guess the
-host-type by logging in as USER."
-  (if (eq host ange-ftp-host-cache)
-      ange-ftp-host-type-cache
-    ;; Trigger an ftp connection, in case we need to guess at the host type.
-    (if (and user (ange-ftp-get-process host user) (eq host ange-ftp-host-cache))
-	ange-ftp-host-type-cache
-      (setq ange-ftp-host-cache host
-	    ange-ftp-host-type-cache
-	    (cond ((ange-ftp-dumb-unix-host host)
-		   'dumb-unix)
-;;		  ((and (fboundp 'ange-ftp-vos-host)
-;;			(ange-ftp-vos-host host))
-;;		   'vos)
-		  ((and (fboundp 'ange-ftp-vms-host)
-			(ange-ftp-vms-host host))
-		   'vms)
-		  ((and (fboundp 'ange-ftp-mts-host)
-			(ange-ftp-mts-host host))
-		   'mts)
-		  ((and (fboundp 'ange-ftp-cms-host)
-			(ange-ftp-cms-host host))
-		   'cms)
-		  (t
-		   'unix))))))
-
-;; It would be nice to abstract the functions ange-ftp-TYPE-host and
-;; ange-ftp-add-TYPE-host. The trick is to abstract these functions
-;; without sacrificing speed. Also, having separate variables
-;; ange-ftp-TYPE-regexp is more user friendly then requiring the user to
-;; set an alist to indicate that a host is of a given type. Even with
-;; automatic host type recognition, setting a regexp is still a good idea
-;; (for efficiency) if you log into a particular non-UNIX host frequently.
-
-(defvar ange-ftp-fix-name-func-alist nil
-  "Alist saying how to convert file name to the host's syntax.
-Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
-which can change a UNIX file name into a name more suitable for a host of type
-TYPE.")
-
-(defvar ange-ftp-fix-dir-name-func-alist nil
-  "Alist saying how to convert directory name to the host's syntax.
-Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
-which can change UNIX directory name into a directory name more suitable
-for a host of type TYPE.")
-
-;; *** Perhaps the sense of this variable should be inverted, since there
-;; *** is only 1 host type that can take ls-style listing options.
-(defvar ange-ftp-dumb-host-types '(dumb-unix)
-  "List of host types that can't take UNIX ls-style listing options.")
-
-(defun ange-ftp-send-cmd (host user cmd &optional msg cont nowait)
-  "Find an ftp process connected to HOST logged in as USER and send it CMD.
-MSG is an optional status message to be output before and after issuing the
-command.
-See the documentation for ange-ftp-raw-send-cmd for a description of CONT
-and NOWAIT."
-  ;; Handle conversion to remote file name syntax and remote ls option
-  ;; capability.
-  (let ((cmd0 (car cmd))
-	(cmd1 (nth 1 cmd))
-	(ange-ftp-this-user user)
-	(ange-ftp-this-host host)
-	(ange-ftp-this-msg msg)
-	cmd2 cmd3 host-type fix-name-func)
-
-    (cond
-     
-     ;; pwd case (We don't care what host-type.)
-     ((null cmd1))
-     
-     ;; cmd == 'dir "remote-name" "local-name" "ls-switches"
-     ((progn
-       (setq cmd2 (nth 2 cmd)
-	     host-type (ange-ftp-host-type host user))
-       ;; This will trigger an FTP login, if one doesn't exist
-       (eq cmd0 'dir))
-      (setq cmd1 (funcall
-		  (or (cdr (assq host-type ange-ftp-fix-dir-name-func-alist))
-		      'identity)
-		  cmd1)
-	    cmd3 (nth 3 cmd))
-      ;; Need to deal with the HP-UX ftp bug. This should also allow
-      ;; us to resolve symlinks to directories on SysV machines. (Sebastian will
-      ;; be happy.)
-      (and (eq host-type 'unix)
-	   (string-match "/$" cmd1)
-	   (not (string-match "R" cmd3))
-	   (setq cmd1 (concat cmd1 ".")))
-      ;; If the remote ls can take switches, put them in
-      (or (memq host-type ange-ftp-dumb-host-types)
-	  (setq cmd0 'ls
-		cmd1 (format "\"%s %s\"" cmd3 cmd1))))
-     
-     ;; First argument is the remote name
-     ((progn
-	(setq fix-name-func (or (cdr (assq host-type
-					   ange-ftp-fix-name-func-alist))
-				'identity))
-	(memq cmd0 '(get delete mkdir rmdir cd)))
-      (setq cmd1 (funcall fix-name-func cmd1)))
-
-     ;; Second argument is the remote name
-     ((memq cmd0 '(append put chmod))
-      (setq cmd2 (funcall fix-name-func cmd2)))
-
-     ;; Both arguments are remote names
-     ((eq cmd0 'rename)
-      (setq cmd1 (funcall fix-name-func cmd1)
-	    cmd2 (funcall fix-name-func cmd2))))
-	  
-    ;; Turn the command into one long string 
-    (setq cmd0 (symbol-name cmd0))
-    (setq cmd (concat cmd0
-		      (and cmd1 (concat " " cmd1))
-		      (and cmd2 (concat " " cmd2))))
-
-    ;; Actually send the resulting command.
-    (let (afsc-result
-	  afsc-line)
-      (ange-ftp-raw-send-cmd
-       (ange-ftp-get-process host user)
-       cmd
-       msg
-       (list
-	(function (lambda (result line host user
-				  cmd msg cont nowait)
-		    (or cont
-			(setq afsc-result result
-			      afsc-line line))
-		    (if result
-			(ange-ftp-call-cont cont result line)
-		      (ange-ftp-raw-send-cmd
-		       (ange-ftp-get-process host user)
-		       cmd
-		       msg
-		       (list
-			(function (lambda (result line cont)
-				    (or cont
-					(setq afsc-result result
-					      afsc-line line))
-				    (ange-ftp-call-cont cont result line)))
-			cont)
-		       nowait))))
-	host user cmd msg cont nowait)
-       nowait)
-
-      (if nowait
-	  nil
-	(if cont
-	    nil
-	  (cons afsc-result afsc-line))))))
-
-;; It might be nice to message users about the host type identified,
-;; but there is so much other messaging going on, it would not be
-;; seen. No point in slowing things down just so users can read
-;; a host type message.
-
-(defconst ange-ftp-cms-name-template
-  (concat
-   "^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?"
-   "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$"))
-(defconst ange-ftp-vms-name-template
-  "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$")
-(defconst ange-ftp-mts-name-template
-  "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
-
-(defun ange-ftp-guess-host-type (host user)
-  "Guess at the the host type of HOST.
-Works by doing a pwd and examining the directory syntax."
-  (let ((host-type (ange-ftp-host-type host))
-	(key (concat host "/" user "/~")))
-    (if (eq host-type 'unix)
-	;; Note that ange-ftp-host-type returns unix as the default value.
-	(save-match-data
-	  (let* ((result (ange-ftp-get-pwd host user))
-		 (dir (car result))
-		 fix-name-func)
-	    (cond ((null dir)
-		   (message "Warning! Unable to get home directory")
-		   (sit-for 1)
-		   (if (string-match
-			"^450 No current working directory defined$"
-			(cdr result))
-		       
-		       ;; We'll assume that if pwd bombs with this
-		       ;; error message, then it's CMS.
-		       (progn
-			 (ange-ftp-add-cms-host host)
-			 (setq ange-ftp-host-cache host
-			       ange-ftp-host-type-cache 'cms))))
-
-		  ;; try for VMS
-		  ((string-match ange-ftp-vms-name-template dir)
-		   (ange-ftp-add-vms-host host)
-		   ;; The add-host functions clear the host type cache.
-		   ;; Therefore, need to set the cache afterwards.
-		   (setq ange-ftp-host-cache host
-			 ange-ftp-host-type-cache 'vms))
-
-		  ;; try for MTS
-		  ((string-match ange-ftp-mts-name-template dir)
-		   (ange-ftp-add-mts-host host)
-		   (setq ange-ftp-host-cache host
-			 ange-ftp-host-type-cache 'mts))
-		  
-		  ;; try for CMS
-		  ((string-match ange-ftp-cms-name-template dir)
-		   (ange-ftp-add-cms-host host)
-		   (setq ange-ftp-host-cache host
-			 ange-ftp-host-type-cache 'cms))
-
-		  ;; assume UN*X
-		  (t
-		   (setq ange-ftp-host-cache host
-			 ange-ftp-host-type-cache 'unix)))
-
-	    ;; Now that we have done a pwd, might as well put it in
-	    ;; the expand-dir hashtable.
-	    (let ((ange-ftp-this-user user)
-		  (ange-ftp-this-host host))
-	      (setq fix-name-func (cdr (assq ange-ftp-host-type-cache
-					     ange-ftp-fix-name-func-alist)))
-	      (if fix-name-func
-		  (setq dir (funcall fix-name-func dir 'reverse))))
-	    (ange-ftp-put-hash-entry key dir
-				     ange-ftp-expand-dir-hashtable))))
-
-    ;; In the special case of CMS make sure that know the
-    ;; expansion of the home minidisk now, because we will
-    ;; be doing a lot of cd's.
-    (if (and (eq host-type 'cms)
-	     (not (ange-ftp-hash-entry-exists-p
-		   key ange-ftp-expand-dir-hashtable)))
-	(let ((dir (car (ange-ftp-get-pwd host user))))
-	  (if dir
-	      (ange-ftp-put-hash-entry key (concat "/" dir)
-				       ange-ftp-expand-dir-hashtable)
-	    (message "Warning! Unable to get home directory")
-	    (sit-for 1))))))
-
-
-;;;; ------------------------------------------------------------
-;;;; Remote file and directory listing support.
-;;;; ------------------------------------------------------------
-
-;; Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
-;; to take switch arguments.
-(defun ange-ftp-dumb-unix-host (host)
-  (and host ange-ftp-dumb-unix-host-regexp
-       (save-match-data
-	 (string-match ange-ftp-dumb-unix-host-regexp host))))
-
-(defun ange-ftp-add-dumb-unix-host (host)
-  "Interactively adds a given HOST to ange-ftp-dumb-unix-host-regexp."
-  (interactive
-   (list (read-string "Host: "
-		      (let ((name (or (buffer-file-name) default-directory)))
-			(and name (car (ange-ftp-ftp-name name)))))))
-  (if (not (ange-ftp-dumb-unix-host host))
-      (setq ange-ftp-dumb-unix-host-regexp
-	    (concat "^" (regexp-quote host) "$"
-		    (and ange-ftp-dumb-unix-host-regexp "\\|")
-		    ange-ftp-dumb-unix-host-regexp)
-	    ange-ftp-host-cache nil)))
-
-(defvar ange-ftp-parse-list-func-alist nil
-  "Alist saying how to parse directory listings for certain OS types.
-Association list of \( TYPE \. FUNC \) pairs.  The FUNC is a routine
-which can parse the output from a DIR listing for a host of type TYPE.")
-
-;; With no-error nil, this function returns:
-;; an error if file is not an ange-ftp-name
-;;                      (This should never happen.) 
-;; an error if either the listing is unreadable or there is an ftp error.
-;; the listing (a string), if everything works.
-;; 
-;; With no-error t, it returns:
-;; an error if not an ange-ftp-name
-;; error if listing is unreadable (most likely caused by a slow connection)
-;; nil if ftp error (this is because although asking to list a nonexistent
-;;                   directory on a remote unix machine usually (except
-;;                   maybe for dumb hosts) returns an ls error, but no
-;;                   ftp error, if the same is done on a VMS machine,
-;;                   an ftp error is returned. Need to trap the error
-;;                   so we can go on and try to list the parent.)
-;; the listing, if everything works.
-
-;; If WILDCARD is non-nil, then this implements the guts of insert-directory
-;; in the wildcard case.  Then we make a relative directory listing
-;; of FILE within the directory specified by `default-directory'.
-
-(defvar ange-ftp-before-parse-ls-hook nil
-  "Normal hook run before parsing the text of an ftp directory listing.")
-
-(defun ange-ftp-ls (file lsargs parse &optional no-error wildcard)
-  "Return the output of an `DIR' or `ls' command done over ftp.
-FILE is the full name of the remote file, LSARGS is any args to pass to the
-`ls' command, and PARSE specifies that the output should be parsed and stored
-away in the internal cache."
-  ;; If parse is t, we assume that file is a directory. i.e. we only parse
-  ;; full directory listings.
-  (let* ((ange-ftp-this-file (ange-ftp-expand-file-name file))
-	 (parsed (ange-ftp-ftp-name ange-ftp-this-file)))
-    (if parsed
-	(let* ((host (nth 0 parsed))
-	       (user (nth 1 parsed))
-	       (name (ange-ftp-quote-string (nth 2 parsed)))
-	       (key (directory-file-name ange-ftp-this-file))
-	       (host-type (ange-ftp-host-type host user))
-	       (dumb (memq host-type ange-ftp-dumb-host-types))
-	       result
-	       temp
-	       lscmd parse-func)
-	  (if (string-equal name "")
-	      (setq name
-		    (ange-ftp-real-file-name-as-directory
-		          (ange-ftp-expand-dir host user "~"))))
-	  (if (and ange-ftp-ls-cache-file
-		   (string-equal key ange-ftp-ls-cache-file)
-		   ;; Don't care about lsargs for dumb hosts.
-		   (or dumb (string-equal lsargs ange-ftp-ls-cache-lsargs)))
-	      ange-ftp-ls-cache-res
-	    (setq temp (ange-ftp-make-tmp-name host))
-	    (if wildcard
-		(progn
-		  (ange-ftp-cd host user (file-name-directory name))
-		  (setq lscmd (list 'dir file temp lsargs)))
-	      (setq lscmd (list 'dir name temp lsargs)))
-	    (unwind-protect
-		(if (car (setq result (ange-ftp-send-cmd
-				       host
-				       user
-				       lscmd
-				       (format "Listing %s"
-					       (ange-ftp-abbreviate-filename
-						ange-ftp-this-file)))))
-		    (save-excursion
-		      (set-buffer (get-buffer-create
-				   ange-ftp-data-buffer-name))
-		      (erase-buffer)
-		      (if (ange-ftp-real-file-readable-p temp)
-			  (ange-ftp-real-insert-file-contents temp)
-			(sleep-for ange-ftp-retry-time)
-					;wait for file to possibly appear
-			(if (ange-ftp-real-file-readable-p temp)
-			    ;; Try again.
-			    (ange-ftp-real-insert-file-contents temp)
-			  (ange-ftp-error host user
-					  (format
-					   "list data file %s not readable"
-					   temp))))
-		      (run-hooks 'ange-ftp-before-parse-ls-hook)
-		      (if parse
-			  (ange-ftp-set-files
-			   ange-ftp-this-file
-			   (if (setq
-				parse-func
-				(cdr (assq host-type
-					   ange-ftp-parse-list-func-alist)))
-			       (funcall parse-func)
-			     (ange-ftp-parse-dired-listing lsargs))))
-		      (setq ange-ftp-ls-cache-file key
-			    ange-ftp-ls-cache-lsargs lsargs
-					; For dumb hosts-types this is
-					; meaningless but harmless.
-			    ange-ftp-ls-cache-res (buffer-string))
-		      ;; (kill-buffer (current-buffer))
-		      ange-ftp-ls-cache-res)
-		  (if no-error
-		      nil
-		    (ange-ftp-error host user
-				    (concat "DIR failed: " (cdr result)))))
-	      (ange-ftp-del-tmp-name temp))))
-      (error "Should never happen. Please report. Bug ref. no.: 1"))))
-
-;;;; ------------------------------------------------------------
-;;;; Directory information caching support.
-;;;; ------------------------------------------------------------
-
-(defconst ange-ftp-date-regexp
-  " [A-Za-z\xa0-\xff][A-Za-z\xa0-\xff][A-Za-z\xa0-\xff] [0-3 ][0-9] "
-  "Regular expression to recognize the date in a directory listing.
-This regular expression is designed to recognize month names
-regardless of the language.")
-
-(defvar ange-ftp-add-file-entry-alist nil
-  "Alist saying how to add file entries on certain OS types.
-Association list of pairs \( TYPE \. FUNC \), where FUNC
-is a function to be used to add a file entry for the OS TYPE. The
-main reason for this alist is to deal with file versions in VMS.")
-
-(defvar ange-ftp-delete-file-entry-alist nil
-  "Alist saying how to delete files on certain OS types.
-Association list of pairs \( TYPE \. FUNC \), where FUNC
-is a function to be used to delete a file entry for the OS TYPE.
-The main reason for this alist is to deal with file versions in VMS.")
-
-(defun ange-ftp-add-file-entry (name &optional dir-p)
-  "Add a file entry for file NAME, if its directory info exists."
-  (funcall (or (cdr (assq (ange-ftp-host-type
-			   (car (ange-ftp-ftp-name name)))
-			  ange-ftp-add-file-entry-alist))
-	       'ange-ftp-internal-add-file-entry)
-	   name dir-p)
-  (setq ange-ftp-ls-cache-file nil))
-
-(defun ange-ftp-delete-file-entry (name &optional dir-p)
-  "Delete the file entry for file NAME, if its directory info exists."
-  (funcall (or (cdr (assq (ange-ftp-host-type
-			   (car (ange-ftp-ftp-name name)))
-			  ange-ftp-delete-file-entry-alist))
-	       'ange-ftp-internal-delete-file-entry)
-	   name dir-p)
-  (setq ange-ftp-ls-cache-file nil))
-
-(defmacro ange-ftp-parse-filename ()
-  ;;Extract the filename from the current line of a dired-like listing.
-  (` (let ((eol (progn (end-of-line) (point))))
-       (beginning-of-line)
-       (if (re-search-forward ange-ftp-date-regexp eol t)
-	   (progn
-	     (skip-chars-forward " ")
-	     (skip-chars-forward "^ " eol)
-	     (skip-chars-forward " " eol)
-	     ;; We bomb on filenames starting with a space.
-	     (buffer-substring (point) eol))))))
-  
-;; This deals with the F switch. Should also do something about
-;; unquoting names obtained with the SysV b switch and the GNU Q
-;; switch. See Sebastian's dired-get-filename.
-
-(defmacro ange-ftp-ls-parser ()
-  ;; Note that switches is dynamically bound.
-  ;; Meant to be called by ange-ftp-parse-dired-listing
-  (` (let ((tbl (ange-ftp-make-hashtable))
-	   (used-F (and (stringp switches)
-			(string-match "F" switches)))
-	   file-type symlink directory file)
-       (while (setq file (ange-ftp-parse-filename))
-	 (beginning-of-line)
-	 (skip-chars-forward "\t 0-9")
-	 (setq file-type (following-char)
-	       directory (eq file-type ?d))
-	 (if (eq file-type ?l)
-	     (if (string-match " -> " file)
-		 (setq symlink (substring file (match-end 0))
-		       file (substring file 0 (match-beginning 0)))
-	       ;; Shouldn't happen
-	       (setq symlink ""))
-	   (setq symlink nil))
-	 ;; Only do a costly regexp search if the F switch was used.
-	 (if (and used-F
-		  (not (string-equal file ""))
-		  (looking-at
-		   ".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"))
-	     (let ((socket (eq file-type ?s))
-		   (executable
-		    (and (not symlink) ; x bits don't mean a thing for symlinks
-			 (string-match "[xst]"
-				       (concat
-					(buffer-substring
-					 (match-beginning 1)
-					 (match-end 1))
-					(buffer-substring
-					 (match-beginning 2)
-					 (match-end 2))
-					(buffer-substring
-					 (match-beginning 3)
-					 (match-end 3)))))))
-	       ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
-	       ;; and others don't. (sigh...) Beware, that some Unix's don't
-	       ;; seem to believe in the F-switch
-	       (if (or (and symlink (string-match "@$" file))
-		       (and directory (string-match "/$" file))
-		       (and executable (string-match "*$" file))
-		       (and socket (string-match "=$" file)))
-		   (setq file (substring file 0 -1)))))
-	 (ange-ftp-put-hash-entry file (or symlink directory) tbl)
-	 (forward-line 1))
-       (ange-ftp-put-hash-entry "." t tbl)
-       (ange-ftp-put-hash-entry ".." t tbl)
-       tbl)))
-
-;;; The dl stuff for descriptive listings
-
-(defvar ange-ftp-dl-dir-regexp nil
-  "Regexp matching directories which are listed in dl format.
-This regexp should not be anchored with a trailing `$', because it should
-match subdirectories as well.")
-
-(defun ange-ftp-add-dl-dir (dir)
-  "Interactively adds a DIR to ange-ftp-dl-dir-regexp."
-  (interactive
-   (list (read-string "Directory: "
-		      (let ((name (or (buffer-file-name) default-directory)))
-			(and name (ange-ftp-ftp-name name)
-			     (file-name-directory name))))))
-  (if (not (and ange-ftp-dl-dir-regexp
-		(string-match ange-ftp-dl-dir-regexp dir)))
-      (setq ange-ftp-dl-dir-regexp
-	    (concat "^" (regexp-quote dir)
-		    (and ange-ftp-dl-dir-regexp "\\|")
-		    ange-ftp-dl-dir-regexp))))
-
-(defmacro ange-ftp-dl-parser ()
-  ;; Parse the current buffer, which is assumed to be a descriptive
-  ;; listing, and return a hashtable.
-  (` (let ((tbl (ange-ftp-make-hashtable)))
-       (while (not (eobp))
-	 (ange-ftp-put-hash-entry
-	  (buffer-substring (point)
-			    (progn
-			      (skip-chars-forward "^ /\n")
-			      (point)))
-	  (eq (following-char) ?/)
-	  tbl)
-	 (forward-line 1))
-       (ange-ftp-put-hash-entry "." t tbl)
-       (ange-ftp-put-hash-entry ".." t tbl)
-       tbl)))
-
-;; Parse the current buffer which is assumed to be in a dired-like listing
-;; format, and return a hashtable as the result. If the listing is not really
-;; a listing, then return nil.
-
-(defun ange-ftp-parse-dired-listing (&optional switches)
-  (save-match-data
-    (cond
-     ((looking-at "^total [0-9]+$")
-      (forward-line 1)
-      ;; Some systems put in a blank line here.
-      (if (eolp) (forward-line 1))
-      (ange-ftp-ls-parser))
-     ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
-      ;; It's an ls error message.
-      nil)
-     ((eobp) ; i.e. (zerop (buffer-size))
-      ;; This could be one of:
-      ;; (1) An Ultrix ls error message
-      ;; (2) A listing with the A switch of an empty directory
-      ;;     on a machine which doesn't give a total line.
-      ;; (3) The twilight zone.
-      ;; We'll assume (1) for now.
-      nil)
-     ((re-search-forward ange-ftp-date-regexp nil t)
-      (beginning-of-line)
-      (ange-ftp-ls-parser))
-     ((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t)
-      ;; It's a dl listing (I hope).
-      ;; file is bound by the call to ange-ftp-ls
-      (ange-ftp-add-dl-dir ange-ftp-this-file)
-      (beginning-of-line)
-      (ange-ftp-dl-parser))
-     (t nil))))
-
-(defun ange-ftp-set-files (directory files)
-  "For a given DIRECTORY, set or change the associated FILES hashtable."
-  (and files (ange-ftp-put-hash-entry (file-name-as-directory directory)
-				      files ange-ftp-files-hashtable)))
-
-(defun ange-ftp-get-files (directory &optional no-error)
-  "Given a given DIRECTORY, return a hashtable of file entries.
-This will give an error or return nil, depending on the value of
-NO-ERROR, if a listing for DIRECTORY cannot be obtained."
-  (setq directory (file-name-as-directory directory)) ;normalize
-  (or (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable)
-      (save-match-data
-	(and (ange-ftp-ls directory
-			  ;; This is an efficiency hack. We try to
-			  ;; anticipate what sort of listing dired
-			  ;; might want, and cache just such a listing.
-			  (if (and (boundp 'dired-actual-switches)
-				   (stringp dired-actual-switches)
-				   ;; We allow the A switch, which lists
-				   ;; all files except "." and "..".
-				   ;; This is OK because we manually
-				   ;; insert these entries
-				   ;; in the hash table.
-				   (string-match
-				    "[aA]" dired-actual-switches)
-				   (string-match
-				    "l" dired-actual-switches)
-				   (not (string-match
-					 "R" dired-actual-switches)))
-			      dired-actual-switches
-			    (if (and (boundp 'dired-listing-switches)
-				     (stringp dired-listing-switches)
-				     (string-match
-				      "[aA]" dired-listing-switches)
-				     (string-match
-				      "l" dired-listing-switches)
-				     (not (string-match
-					   "R" dired-listing-switches)))
-				dired-listing-switches
-			      "-al"))
-			  t no-error)
-	     (ange-ftp-get-hash-entry
-	      directory ange-ftp-files-hashtable)))))
-
-;; Given NAME, return the file part that can be used for looking up the
-;; file's entry in a hashtable.
-(defmacro ange-ftp-get-file-part (name)
-  (` (let ((file (file-name-nondirectory (, name))))
-       (if (string-equal file "")
-	   "."
-	 file))))
-
-;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
-;; allowed to determine if NAME is a sub-directory by listing it directly,
-;; rather than listing its parent directory. This is used for efficiency so
-;; that a wasted listing is not done:
-;; 1. When looking for a .dired file in dired-x.el.
-;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid
-;;     subdirectory. This is of course an OS dependent judgement.
-
-(defmacro ange-ftp-allow-child-lookup (dir file)
-  (` (not
-      (let* ((efile (, file)) ; expand once.
-	     (edir (, dir))
-	     (parsed (ange-ftp-ftp-name edir))
-	     (host-type (ange-ftp-host-type
-			 (car parsed))))
-	(or
-;;; This variable seems not to exist in Emacs 19 -- rms.
-;;;	 ;; Deal with dired
-;;;	 (and (boundp 'dired-local-variables-file)
-;;;	      (stringp dired-local-variables-file)
-;;;	      (string-equal dired-local-variables-file efile))
-	 ;; No dots in dir names in vms.
-	 (and (eq host-type 'vms)
-	      (string-match "\\." efile))
-	 ;; No subdirs in mts of cms.
-	 (and (memq host-type '(mts cms))
-	      (not (string-equal "/" (nth 2 parsed)))))))))
-
-(defun ange-ftp-file-entry-p (name)
-  "Given NAME, return whether there is a file entry for it."
-  (let* ((name (directory-file-name name))
-	 (dir (file-name-directory name))
-	 (ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable))
-	 (file (ange-ftp-get-file-part name)))
-    (if ent
-	(ange-ftp-hash-entry-exists-p file ent)
-      (or (and (ange-ftp-allow-child-lookup dir file)
-	       (setq ent (ange-ftp-get-files name t))
-	       ;; Try a child lookup. i.e. try to list file as a
-	       ;; subdirectory of dir. This is a good idea because
-	       ;; we may not have read permission for file's parent. Also,
-	       ;; people tend to work down directory trees anyway. We use
-	       ;; no-error ;; because if file does not exist as a subdir.,
-	       ;; then dumb hosts will give an ftp error. Smart unix hosts
-	       ;; will simply send back the ls
-	       ;; error message.
-	       (ange-ftp-get-hash-entry "." ent))
-	  ;; Child lookup failed. Try the parent. If this bombs,
-	  ;; we are at wits end -- signal an error.
-	  ;; Problem: If this signals an error, the error message
-	  ;; may  not have a lot to do with what went wrong.
-	  (ange-ftp-hash-entry-exists-p file
-					(ange-ftp-get-files dir))))))
-
-(defun ange-ftp-get-file-entry (name)
-  "Given NAME, return the given file entry.
-The entry will be either t for a directory, nil for a normal file,
-or a string for a symlink. If the file isn't in the hashtable,
-this also returns nil."
-  (let* ((name (directory-file-name name))
-	 (dir (file-name-directory name))
-	 (ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable))
-	 (file (ange-ftp-get-file-part name)))
-    (if ent
-	(ange-ftp-get-hash-entry file ent)
-      (or (and (ange-ftp-allow-child-lookup dir file)
-	       (setq ent (ange-ftp-get-files name t))
-	       (ange-ftp-get-hash-entry "." ent))
-	       ;; i.e. it's a directory by child lookup
-	  (ange-ftp-get-hash-entry file
-				   (ange-ftp-get-files dir))))))
-
-(defun ange-ftp-internal-delete-file-entry (name &optional dir-p)
-  (if dir-p
-      (progn 
-	(setq name (file-name-as-directory name))
-	(ange-ftp-del-hash-entry name ange-ftp-files-hashtable)
-	(setq name (directory-file-name name))))
-  ;; Note that file-name-as-directory followed by directory-file-name
-  ;; serves to canonicalize directory file names to their unix form.
-  ;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO
-  (let ((files (ange-ftp-get-hash-entry (file-name-directory name)
-					ange-ftp-files-hashtable)))
-    (if files
-	(ange-ftp-del-hash-entry (ange-ftp-get-file-part name)
-				 files))))
-
-(defun ange-ftp-internal-add-file-entry (name &optional dir-p)
-  (and dir-p
-       (setq name (directory-file-name name)))
-  (let ((files (ange-ftp-get-hash-entry (file-name-directory name)
-					ange-ftp-files-hashtable)))
-    (if files
-	(ange-ftp-put-hash-entry (ange-ftp-get-file-part name)
-				 dir-p
-				 files))))
-
-(defun ange-ftp-wipe-file-entries (host user)
-  "Get rid of entry for HOST, USER pair from file entry information hashtable."
-  (let ((new-tbl (ange-ftp-make-hashtable (length ange-ftp-files-hashtable))))
-    (ange-ftp-map-hashtable
-     (function
-      (lambda (key val)
-	(let ((parsed (ange-ftp-ftp-name key)))
-	  (if parsed
-	      (let ((h (nth 0 parsed))
-		    (u (nth 1 parsed)))
-		(or (and (equal host h) (equal user u))
-		    (ange-ftp-put-hash-entry key val new-tbl)))))))
-     ange-ftp-files-hashtable)
-    (setq ange-ftp-files-hashtable new-tbl)))
-
-;;;; ------------------------------------------------------------
-;;;; File transfer mode support.
-;;;; ------------------------------------------------------------
-
-(defun ange-ftp-set-binary-mode (host user)
-  "Tell the ftp process for the given HOST & USER to switch to binary mode."
-  (let ((result (ange-ftp-send-cmd host user '(type "binary"))))
-    (if (not (car result))
-	(ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
-      (save-excursion
-	(set-buffer (process-buffer (ange-ftp-get-process host user)))
-	(and ange-ftp-binary-hash-mark-size
-	     (setq ange-ftp-hash-mark-unit
-		   (ash ange-ftp-binary-hash-mark-size -4)))))))
-
-(defun ange-ftp-set-ascii-mode (host user)
-  "Tell the ftp process for the given HOST & USER to switch to ascii mode."
-  (let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
-    (if (not (car result))
-	(ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
-      (save-excursion
-	(set-buffer (process-buffer (ange-ftp-get-process host user)))
-	(and ange-ftp-ascii-hash-mark-size
-	     (setq ange-ftp-hash-mark-unit
-		   (ash ange-ftp-ascii-hash-mark-size -4)))))))
-
-(defun ange-ftp-cd (host user dir)
-  (let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD")))
-    (or (car result)
-	(ange-ftp-error host user (concat "CD failed: " (cdr result))))))
-
-(defun ange-ftp-get-pwd (host user)
-  "Attempts to get the current working directory for the given HOST/USER pair.
-Returns \( DIR . LINE \) where DIR is either the directory or NIL if not found,
-and LINE is the relevant success or fail line from the FTP-client."
-  (let* ((result (ange-ftp-send-cmd host user '(pwd) "Getting PWD"))
-	 (line (cdr result))
-	 dir)
-    (if (car result)
-	(save-match-data
-	  (and (or (string-match "\"\\([^\"]*\\)\"" line)
-		   (string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers!
-	       (setq dir (substring line
-				    (match-beginning 1)
-				    (match-end 1))))))
-    (cons dir line)))
-
-;;; ------------------------------------------------------------
-;;; expand-file-name and friends...which currently don't work
-;;; ------------------------------------------------------------
-
-(defun ange-ftp-expand-dir (host user dir)
-  "Return the result of doing a PWD in the current FTP session.
-Use the connection to machine HOST
-logged in as user USER and cd'd to directory DIR."
-  (let* ((host-type (ange-ftp-host-type host user))
-	 ;; It is more efficient to call ange-ftp-host-type
-	 ;; before binding res, because ange-ftp-host-type sometimes
-	 ;; adds to the info in the expand-dir-hashtable.
-	 (fix-name-func
-	  (cdr (assq host-type ange-ftp-fix-name-func-alist)))
-	 (key (concat host "/" user "/" dir))
-	 (res (ange-ftp-get-hash-entry key ange-ftp-expand-dir-hashtable)))
-    (or res
-	(progn
-	  (or
-	   (string-equal user "anonymous")
-	   (string-equal user "ftp")
-	   (not (eq host-type 'unix))
-	   (let* ((ange-ftp-good-msgs (concat ange-ftp-expand-dir-regexp
-					      "\\|"
-					      ange-ftp-good-msgs))
-		  (result (ange-ftp-send-cmd host user
-					     (list 'get dir "/dev/null")
-					     (format "expanding %s" dir)))
-		  (line (cdr result)))
-	     (setq res
-		   (if (string-match ange-ftp-expand-dir-regexp line)
-		       (substring line 
-				  (match-beginning 1)
-				  (match-end 1))))))
-	  (or res
-	      (if (string-equal dir "~")
-		  (setq res (car (ange-ftp-get-pwd host user)))
-		(let ((home (ange-ftp-expand-dir host user "~")))
-		  (unwind-protect
-		      (and (ange-ftp-cd host user dir)
-			   (setq res (car (ange-ftp-get-pwd host user))))
-		    (ange-ftp-cd host user home)))))
-	  (if res
-	      (let ((ange-ftp-this-user user)
-		    (ange-ftp-this-host host))
-		(if fix-name-func
-		    (setq res (funcall fix-name-func res 'reverse)))
-		(ange-ftp-put-hash-entry
-		 key res ange-ftp-expand-dir-hashtable)))
-	  res))))
-
-(defun ange-ftp-canonize-filename (n)
-  "Take a string and short-circuit //, /. and /.."
-  (if (string-match "[^:]+//" n)		;don't upset Apollo users
-      (setq n (substring n (1- (match-end 0)))))
-  (let ((parsed (ange-ftp-ftp-name n)))
-    (if parsed
-	(let ((host (car parsed))
-	      (user (nth 1 parsed))
-	      (name (nth 2 parsed)))
-	  
-	  ;; See if remote name is absolute.  If so then just expand it and
-	  ;; replace the name component of the overall name.
-	  (cond ((string-match "^/" name)
-		 name)
-		
-		;; Name starts with ~ or ~user.  Resolve that part of the name
-		;; making it absolute then re-expand it.
-		((string-match "^~[^/]*" name)
-		 (let* ((tilda (substring name
-					  (match-beginning 0) 
-					  (match-end 0)))
-			(rest (substring name (match-end 0)))
-			(dir (ange-ftp-expand-dir host user tilda)))
-		   (if dir
-		       (setq name (concat dir rest))
-		     (error "User \"%s\" is not known" 
-			    (substring tilda 1)))))
-		
-		;; relative name.  Tack on homedir and re-expand.
-		(t
-		 (let ((dir (ange-ftp-expand-dir host user "~")))
-		   (if dir
-		       (setq name (concat
-				   (ange-ftp-real-file-name-as-directory dir)
-				   name))
-		     (error "Unable to obtain CWD")))))
-	  
-	  ;; If name starts with //, preserve that, for apollo system.
-	  (if (not (string-match "^//" name))
-	      (progn
-		(setq name (ange-ftp-real-expand-file-name name))
-
-		(if (string-match "^//" name)
-		    (setq name (substring name 1)))))
-	  
-	  ;; Now substitute the expanded name back into the overall filename.
-	  (ange-ftp-replace-name-component n name))
-      
-      ;; non-ange-ftp name.  Just expand normally.
-      (if (eq (string-to-char n) ?/)
-	  (ange-ftp-real-expand-file-name n)
-	(ange-ftp-real-expand-file-name
-	 (ange-ftp-real-file-name-nondirectory n)
-	 (ange-ftp-real-file-name-directory n))))))
-
-(defun ange-ftp-expand-file-name (name &optional default)
-  "Documented as original."
-  (save-match-data
-    (if (eq (string-to-char name) ?/)
-	(while (cond ((string-match "[^:]+//" name) ;don't upset Apollo users
-		      (setq name (substring name (1- (match-end 0)))))
-		     ((string-match "/~" name)
-		      (setq name (substring name (1- (match-end 0))))))))
-    (cond ((eq (string-to-char name) ?~)
-	   (ange-ftp-real-expand-file-name name))
-	  ((eq (string-to-char name) ?/)
-	   (ange-ftp-canonize-filename name))
-	  ((zerop (length name))
-	   (ange-ftp-canonize-filename (or default default-directory)))
-	  ((ange-ftp-canonize-filename
-	    (concat (file-name-as-directory (or default default-directory))
-		    name))))))
-
-;;; These are problems--they are currently not enabled.
-
-(defvar ange-ftp-file-name-as-directory-alist nil
-  "Association list of \( TYPE \. FUNC \) pairs.
-FUNC converts a filename to a directory name for the operating
-system TYPE.")
-
-(defun ange-ftp-file-name-as-directory (name)
-  "Documented as original."
-  (let ((parsed (ange-ftp-ftp-name name)))
-    (if parsed
-	(if (string-equal (nth 2 parsed) "")
-	    name
-	  (funcall (or (cdr (assq
-			     (ange-ftp-host-type (car parsed))
-			     ange-ftp-file-name-as-directory-alist))
-		       'ange-ftp-real-file-name-as-directory)
-		   name))
-      (ange-ftp-real-file-name-as-directory name))))
- 	
-(defun ange-ftp-file-name-directory (name)
-  "Documented as original."
-  (let ((parsed (ange-ftp-ftp-name name)))
-    (if parsed
-	(let ((filename (nth 2 parsed)))
-	  (if (save-match-data
-		(string-match "^~[^/]*$" filename))
-	      name
-	    (ange-ftp-replace-name-component
-	     name
-	     (ange-ftp-real-file-name-directory filename))))
-      (ange-ftp-real-file-name-directory name))))
-
-(defun ange-ftp-file-name-nondirectory (name)
-  "Documented as original."
-  (let ((parsed (ange-ftp-ftp-name name)))
-    (if parsed
-	(let ((filename (nth 2 parsed)))
-	  (if (save-match-data
-		(string-match "^~[^/]*$" filename))
-	      ""
-	    (ange-ftp-real-file-name-nondirectory name)))
-      (ange-ftp-real-file-name-nondirectory name))))
-
-(defun ange-ftp-directory-file-name (dir)
-  "Documented as original."
-  (let ((parsed (ange-ftp-ftp-name dir)))
-    (if parsed
-	(ange-ftp-replace-name-component
-	   dir
-	   (ange-ftp-real-directory-file-name (nth 2 parsed)))
-      (ange-ftp-real-directory-file-name dir))))
-
-
-;;; Hooks that handle Emacs primitives.
-
-;; Returns non-nil if should transfer FILE in binary mode.
-(defun ange-ftp-binary-file (file)
-  (save-match-data
-    (string-match ange-ftp-binary-file-name-regexp file)))
-
-(defun ange-ftp-write-region (start end filename &optional append visit)
-  (setq filename (expand-file-name filename))
-  (let ((parsed (ange-ftp-ftp-name filename)))
-    (if parsed
-	(let* ((host (nth 0 parsed))
-	       (user (nth 1 parsed))
-	       (name (ange-ftp-quote-string (nth 2 parsed)))
-	       (temp (ange-ftp-make-tmp-name host))
-	       (binary (or (ange-ftp-binary-file filename)
-			   (eq (ange-ftp-host-type host user) 'unix)))
-	       (cmd (if append 'append 'put))
-	       (abbr (ange-ftp-abbreviate-filename filename)))
-	  (unwind-protect
-	      (progn
-		(let ((executing-kbd-macro t)
-		      (filename (buffer-file-name))
-		      (mod-p (buffer-modified-p)))
-		  (unwind-protect
-		      (ange-ftp-real-write-region start end temp nil visit)
-		    ;; cleanup forms
-		    (setq buffer-file-name filename)
-		    (set-buffer-modified-p mod-p)))
-		(if binary
-		    (ange-ftp-set-binary-mode host user))
-
-		;; tell the process filter what size the transfer will be.
-		(let ((attr (file-attributes temp)))
-		  (if attr
-		      (ange-ftp-set-xfer-size host user (nth 7 attr))))
-
-		;; put or append the file.
-		(let ((result (ange-ftp-send-cmd host user
-						 (list cmd temp name)
-						 (format "Writing %s" abbr))))
-		  (or (car result)
-		      (signal 'ftp-error
-			      (list
-			       "Opening output file"
-			       (format "FTP Error: \"%s\"" (cdr result))
-			       filename)))))
-	    (ange-ftp-del-tmp-name temp)
-	    (if binary 
-		(ange-ftp-set-ascii-mode host user)))
-	  (if (eq visit t)
-	      (progn
-		(set-visited-file-modtime '(0 0))
-		(ange-ftp-set-buffer-mode)
-		(setq buffer-file-name filename)
-		(set-buffer-modified-p nil)))
-	  (ange-ftp-message "Wrote %s" abbr)
-	  (ange-ftp-add-file-entry filename))
-      (ange-ftp-real-write-region start end filename append visit))))
-
-(defun ange-ftp-insert-file-contents (filename &optional visit beg end replace)
-  (barf-if-buffer-read-only)
-  (setq filename (expand-file-name filename))
-  (let ((parsed (ange-ftp-ftp-name filename)))
-    (if parsed
-	(progn
-	  (if visit
-	      (setq buffer-file-name filename))
-	  (if (or (file-exists-p filename)
-		  (progn
-		    (setq ange-ftp-ls-cache-file nil)
-		    (ange-ftp-del-hash-entry (file-name-directory filename)
-					     ange-ftp-files-hashtable)
-		    (file-exists-p filename)))
-	      (let* ((host (nth 0 parsed))
-		     (user (nth 1 parsed))
-		     (name (ange-ftp-quote-string (nth 2 parsed)))
-		     (temp (ange-ftp-make-tmp-name host))
-		     (binary (or (ange-ftp-binary-file filename)
-				 (eq (ange-ftp-host-type host user) 'unix)))
-		     (abbr (ange-ftp-abbreviate-filename filename))
-		     size)
-		(unwind-protect
-		    (progn
-		      (if binary
-			  (ange-ftp-set-binary-mode host user))
-		      (let ((result (ange-ftp-send-cmd host user
-					      (list 'get name temp)
-					      (format "Retrieving %s" abbr))))
-			(or (car result)
-			    (signal 'ftp-error
-				    (list
-				     "Opening input file"
-				     (format "FTP Error: \"%s\"" (cdr result))
-				     filename))))
-		      (if (or (ange-ftp-real-file-readable-p temp)
-			      (sleep-for ange-ftp-retry-time)
-			      ;; Wait for file to hopefully appear.
-			      (ange-ftp-real-file-readable-p temp))
-			  (setq
-			   size
-			   (nth 1 (ange-ftp-real-insert-file-contents
-				   temp visit beg end replace)))
-			(signal 'ftp-error
-				(list
-				 "Opening input file:"
-				 (format
-				  "FTP Error: %s not arrived or readable"
-				  filename)))))
-		  (if binary
-		      (ange-ftp-set-ascii-mode host user))
-		  (ange-ftp-del-tmp-name temp))
-		(if visit
-		    (progn
-		      (set-visited-file-modtime '(0 0))
-		      (setq buffer-file-name filename)))
-		(list filename size))
-	    (signal 'file-error
-		    (list 
-		     "Opening input file"
-		     filename))))
-      (ange-ftp-real-insert-file-contents filename visit beg end replace))))
- 
-(defun ange-ftp-expand-symlink (file dir)
-  (if (file-name-absolute-p file)
-      (ange-ftp-replace-name-component dir file)
-    (expand-file-name file dir)))
-
-(defun ange-ftp-file-symlink-p (file)
-  ;; call ange-ftp-expand-file-name rather than the normal
-  ;; expand-file-name to stop loops when using a package that
-  ;; redefines both file-symlink-p and expand-file-name.
-  (setq file (ange-ftp-expand-file-name file))
-  (if (ange-ftp-ftp-name file)
-      (let ((file-ent
-	     (ange-ftp-get-hash-entry
-	      (ange-ftp-get-file-part file)
-	      (ange-ftp-get-files (file-name-directory file)))))
-	(if (stringp file-ent)
-	    (if (file-name-absolute-p file-ent)
-		(ange-ftp-replace-name-component
-		      (file-name-directory file) file-ent)
-	      file-ent)))
-    (ange-ftp-real-file-symlink-p file)))
-
-(defun ange-ftp-file-exists-p (name)
-  (setq name (expand-file-name name))
-  (if (ange-ftp-ftp-name name)
-      (if (ange-ftp-file-entry-p name)
-	  (let ((file-ent (ange-ftp-get-file-entry name)))
-	    (if (stringp file-ent)
-		(file-exists-p
-		 (ange-ftp-expand-symlink file-ent
-					  (file-name-directory
-					   (directory-file-name name))))
-	      t)))
-    (ange-ftp-real-file-exists-p name)))
-
-(defun ange-ftp-file-directory-p (name)
-  (setq name (expand-file-name name))
-  (if (ange-ftp-ftp-name name)
-      ;; We do a file-name-as-directory on name here because some
-      ;; machines (VMS) use a .DIR to indicate the filename associated
-      ;; with a directory. This needs to be canonicalized.
-      (let ((file-ent (ange-ftp-get-file-entry
-		       (ange-ftp-file-name-as-directory name))))
-	(if (stringp file-ent)
-	    (file-directory-p
-	     (ange-ftp-expand-symlink file-ent
-				      (file-name-directory
-				       (directory-file-name name))))
-	  file-ent))
-    (ange-ftp-real-file-directory-p name)))
-
-(defun ange-ftp-directory-files (directory &optional full match
-					   &rest v19-args)
-  (setq directory (expand-file-name directory))
-  (if (ange-ftp-ftp-name directory)
-      (progn
-	(ange-ftp-barf-if-not-directory directory)
-	(let ((tail (ange-ftp-hash-table-keys
-		     (ange-ftp-get-files directory)))
-	      files f)
-	  (setq directory (file-name-as-directory directory))
-	  (save-match-data
-	    (while tail
-	      (setq f (car tail)
-		    tail (cdr tail))
-	      (if (or (not match) (string-match match f))
-		  (setq files
-			(cons (if full (concat directory f) f) files)))))
-	  (nreverse files)))
-    (apply 'ange-ftp-real-directory-files directory full match v19-args)))
-
-(defun ange-ftp-file-attributes (file)
-  (setq file (expand-file-name file))
-  (let ((parsed (ange-ftp-ftp-name file)))
-    (if parsed
-	(let ((part (ange-ftp-get-file-part file))
-	      (files (ange-ftp-get-files (file-name-directory file))))
-	  (if (ange-ftp-hash-entry-exists-p part files)
-	      (let ((host (nth 0 parsed))
-		    (user (nth 1 parsed))
-		    (name (nth 2 parsed))
-		    (dirp (ange-ftp-get-hash-entry part files)))
-		(list (if (and (stringp dirp) (file-name-absolute-p dirp))
-			  (ange-ftp-expand-symlink dirp
-						   (file-name-directory file))
-			dirp)		;0 file type
-		      -1		;1 link count
-		      -1		;2 uid
-		      -1		;3 gid
-		      '(0 0)		;4 atime
-		      '(0 0)		;5 mtime
-		      '(0 0)		;6 ctime
-		      -1		;7 size
-		      (concat (if (stringp dirp) "l" (if dirp "d" "-"))
-			      "?????????") ;8 mode
-		      nil		;9 gid weird
-		      ;; Hack to give remote files a unique "inode number".
-		      ;; It's actually the sum of the characters in its name.
-		      (apply '+ (nconc (mapcar 'identity host)
-				       (mapcar 'identity user)
-				       (mapcar 'identity
-					       (directory-file-name name))))
-		      -1		;11 device number [v19 only]
-		      ))))
-      (ange-ftp-real-file-attributes file))))
-
-(defun ange-ftp-file-writable-p (file)
-  (setq file (expand-file-name file))
-  (if (ange-ftp-ftp-name file)
-      (or (file-exists-p file)		;guess here for speed
-	  (file-directory-p (file-name-directory file)))
-    (ange-ftp-real-file-writable-p file)))
-
-(defun ange-ftp-file-readable-p (file)
-  (setq file (expand-file-name file))
-  (if (ange-ftp-ftp-name file)
-      (file-exists-p file)
-    (ange-ftp-real-file-readable-p file)))
-
-(defun ange-ftp-file-executable-p (file)
-  (setq file (expand-file-name file))
-  (if (ange-ftp-ftp-name file)
-      (file-exists-p file)
-    (ange-ftp-real-file-executable-p file)))
-
-(defun ange-ftp-delete-file (file)
-  (interactive "fDelete file: ")
-  (setq file (expand-file-name file))
-  (let ((parsed (ange-ftp-ftp-name file)))
-    (if parsed
-	(let* ((host (nth 0 parsed))
-	       (user (nth 1 parsed))
-	       (name (ange-ftp-quote-string (nth 2 parsed)))
-	       (abbr (ange-ftp-abbreviate-filename file))
-	       (result (ange-ftp-send-cmd host user
-					  (list 'delete name)
-					  (format "Deleting %s" abbr))))
-	  (or (car result)
-	      (signal 'ftp-error
-		      (list
-		       "Removing old name"
-		       (format "FTP Error: \"%s\"" (cdr result))
-		       file)))
-	  (ange-ftp-delete-file-entry file))
-      (ange-ftp-real-delete-file file))))
-
-(defun ange-ftp-verify-visited-file-modtime (buf)
-  (let ((name (buffer-file-name buf)))
-    (if (and (stringp name) (ange-ftp-ftp-name name))
-	t
-      (ange-ftp-real-verify-visited-file-modtime buf))))
-
-;;;; ------------------------------------------------------------
-;;;; File copying support... totally re-written 6/24/92.
-;;;; ------------------------------------------------------------
-
-(defun ange-ftp-barf-or-query-if-file-exists (absname querystring interactive)
-  (if (file-exists-p absname)
-      (if (not interactive)
-	  (signal 'file-already-exists (list absname))
-	(if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
-				      absname querystring)))
-	    (signal 'file-already-exists (list absname))))))
-
-;; async local copy commented out for now since I don't seem to get
-;; the process sentinel called for some processes.
-;;
-;; (defun ange-ftp-copy-file-locally (filename newname ok-if-already-exists
-;; 					    keep-date cont)
-;;   "Kludge to copy a local file and call a continuation when the copy
-;; finishes."
-;;   ;; check to see if we can overwrite
-;;   (if (or (not ok-if-already-exists)
-;; 	  (numberp ok-if-already-exists))
-;;       (ange-ftp-barf-or-query-if-file-exists newname "copy to it" 
-;; 					     (numberp ok-if-already-exists)))
-;;   (let ((proc (start-process " *copy*"
-;; 			     (generate-new-buffer "*copy*")
-;; 			     "cp"
-;; 			     filename
-;; 			     newname))
-;; 	res)
-;;     (set-process-sentinel proc (function ange-ftp-copy-file-locally-sentinel))
-;;     (process-kill-without-query proc)
-;;     (save-excursion
-;;       (set-buffer (process-buffer proc))
-;;       (make-variable-buffer-local 'copy-cont)
-;;       (setq copy-cont cont))))
-;; 
-;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
-;;   (save-excursion
-;;     (set-buffer (process-buffer proc))
-;;     (let ((cont copy-cont)
-;; 	  (result (buffer-string)))
-;;       (unwind-protect
-;; 	  (if (and (string-equal status "finished\n")
-;; 		   (zerop (length result)))
-;; 	      (ange-ftp-call-cont cont t nil)
-;; 	    (ange-ftp-call-cont cont
-;; 				nil
-;; 				(if (zerop (length result))
-;; 				    (substring status 0 -1)
-;; 				  (substring result 0 -1))))
-;; 	(kill-buffer (current-buffer))))))
-
-;; this is the extended version of ange-ftp-copy-file-internal that works
-;; asynchronously if asked nicely.
-(defun ange-ftp-copy-file-internal (filename newname ok-if-already-exists
-					     keep-date &optional msg cont nowait)
-  (setq filename (expand-file-name filename)
-	newname (expand-file-name newname))
-
-  ;; canonicalize newname if a directory.
-  (if (file-directory-p newname)
-      (setq newname (expand-file-name (file-name-nondirectory filename) newname)))
-
-  (let ((f-parsed (ange-ftp-ftp-name filename))
-	(t-parsed (ange-ftp-ftp-name newname)))
-
-    ;; local file to local file copy?
-    (if (and (not f-parsed) (not t-parsed))
-	(progn
-	  (ange-ftp-real-copy-file filename newname ok-if-already-exists
-				   keep-date)
-	  (if cont
-	      (ange-ftp-call-cont cont t "Copied locally")))
-      ;; one or both files are remote.
-      (let* ((f-host (and f-parsed (nth 0 f-parsed)))
-	     (f-user (and f-parsed (nth 1 f-parsed)))
-	     (f-name (and f-parsed (ange-ftp-quote-string (nth 2 f-parsed))))
-	     (f-abbr (ange-ftp-abbreviate-filename filename))
-	     (t-host (and t-parsed (nth 0 t-parsed)))
-	     (t-user (and t-parsed (nth 1 t-parsed)))
-	     (t-name (and t-parsed (ange-ftp-quote-string (nth 2 t-parsed))))
-	     (t-abbr (ange-ftp-abbreviate-filename newname filename))
-	     (binary (or (ange-ftp-binary-file filename)
-			 (ange-ftp-binary-file newname)
-			 (and (eq (ange-ftp-host-type f-host f-user) 'unix)
-			      (eq (ange-ftp-host-type t-host t-user) 'unix))))
-	     temp1
-	     temp2)
-
-	;; check to see if we can overwrite
-	(if (or (not ok-if-already-exists)
-		(numberp ok-if-already-exists))
-	    (ange-ftp-barf-or-query-if-file-exists newname "copy to it" 
-						   (numberp ok-if-already-exists)))
-
-	;; do the copying.
-	(if f-parsed
-	    
-	    ;; filename was remote.
-	    (progn
-	      (if (or (ange-ftp-use-gateway-p f-host)
-		      t-parsed)
-		  ;; have to use intermediate file if we are getting via
-		  ;; gateway machine or we are doing a remote to remote copy.
-		  (setq temp1 (ange-ftp-make-tmp-name f-host)))
-	      
-	      (if binary
-		  (ange-ftp-set-binary-mode f-host f-user))
-
-	      (ange-ftp-send-cmd
-	       f-host
-	       f-user
-	       (list 'get f-name (or temp1 newname))
-	       (or msg
-		   (if (and temp1 t-parsed)
-		       (format "Getting %s" f-abbr)
-		     (format "Copying %s to %s" f-abbr t-abbr)))
-	       (list (function ange-ftp-cf1)
-		     filename newname binary msg
-		     f-parsed f-host f-user f-name f-abbr
-		     t-parsed t-host t-user t-name t-abbr
-		     temp1 temp2 cont nowait)
-	       nowait))
-
-	  ;; filename wasn't remote.  newname must be remote.  call the
-	  ;; function which does the remainder of the copying work.
-	  (ange-ftp-cf1 t nil
-			filename newname binary msg
-			f-parsed f-host f-user f-name f-abbr
-			t-parsed t-host t-user t-name t-abbr
-			nil nil cont nowait))))))
-
-;; next part of copying routine.
-(defun ange-ftp-cf1 (result line
-			    filename newname binary msg
-			    f-parsed f-host f-user f-name f-abbr
-			    t-parsed t-host t-user t-name t-abbr
-			    temp1 temp2 cont nowait)
-  (if line
-      ;; filename must have been remote, and we must have just done a GET.
-      (unwind-protect
-	  (or result
-	      ;; GET failed for some reason.  Clean up and get out.
-	      (progn
-		(and temp1 (ange-ftp-del-tmp-name temp1))
-		(or cont
-		    (signal 'ftp-error (list "Opening input file"
-					     (format "FTP Error: \"%s\"" line)
-					     filename)))))
-	;; cleanup
-	(if binary
-	    (ange-ftp-set-ascii-mode f-host f-user))))
-
-  (if result
-      ;; We now have to copy either temp1 or filename to newname.
-      (if t-parsed
-      
-	  ;; newname was remote.
-	  (progn
-	    (if (ange-ftp-use-gateway-p t-host)
-		(setq temp2 (ange-ftp-make-tmp-name t-host)))
-	    
-	    ;; make sure data is moved into the right place for the
-	    ;; outgoing transfer.  gateway temporary files complicate
-	    ;; things nicely.
-	    (if temp1
-		(if temp2
-		    (if (string-equal temp1 temp2)
-			(setq temp1 nil)
-		      (ange-ftp-real-copy-file temp1 temp2 t))
-		  (setq temp2 temp1 temp1 nil))
-	      (if temp2
-		  (ange-ftp-real-copy-file filename temp2 t)))
-	    
-	    (if binary
-		(ange-ftp-set-binary-mode t-host t-user))
-
-	    ;; tell the process filter what size the file is.
-	    (let ((attr (file-attributes (or temp2 filename))))
-	      (if attr
-		  (ange-ftp-set-xfer-size t-host t-user (nth 7 attr))))
-
-	    (ange-ftp-send-cmd
-	     t-host
-	     t-user
-	     (list 'put (or temp2 filename) t-name)
-	     (or msg
-		 (if (and temp2 f-parsed)
-		     (format "Putting %s" newname)
-		   (format "Copying %s to %s" f-abbr t-abbr)))
-	     (list (function ange-ftp-cf2)
-		   newname t-host t-user binary temp1 temp2 cont)
-	     nowait))
-    
-	;; newname wasn't remote.
-	(ange-ftp-cf2 t nil newname t-host t-user binary temp1 temp2 cont))
-
-    ;; first copy failed, tell caller
-    (ange-ftp-call-cont cont result line)))
-
-;; last part of copying routine.
-(defun ange-ftp-cf2 (result line newname t-host t-user binary temp1 temp2 cont)
-  (unwind-protect
-      (if line
-	  ;; result from doing a local to remote copy.
-	  (unwind-protect
-	      (progn
-		(or result
-		    (or cont
-			(signal 'ftp-error
-				(list "Opening output file"
-				      (format "FTP Error: \"%s\"" line)
-				      newname))))
-		
-		(ange-ftp-add-file-entry newname))
-	    
-	    ;; cleanup.
-	    (if binary
-		(ange-ftp-set-ascii-mode t-host t-user)))
-	      
-	;; newname was local.
-	(if temp1
-	    (ange-ftp-real-copy-file temp1 newname t)))
-	  
-    ;; clean up
-    (and temp1 (ange-ftp-del-tmp-name temp1))
-    (and temp2 (ange-ftp-del-tmp-name temp2))
-    (ange-ftp-call-cont cont result line)))
-
-(defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
-				    keep-date)
-  (interactive "fCopy file: \nFCopy %s to file: \np")
-  (ange-ftp-copy-file-internal filename
-			       newname
-			       ok-if-already-exists
-			       keep-date
-			       nil
-			       nil
-			       (interactive-p)))
-
-;;;; ------------------------------------------------------------
-;;;; File renaming support.
-;;;; ------------------------------------------------------------
-
-(defun ange-ftp-rename-remote-to-remote (filename newname f-parsed t-parsed)
-  "Rename remote file FILE to remote file NEWNAME."
-  (let ((f-host (nth 0 f-parsed))
-	(f-user (nth 1 f-parsed))
-	(t-host (nth 0 t-parsed))
-	(t-user (nth 1 t-parsed)))
-    (if (and (string-equal f-host t-host)
-	     (string-equal f-user t-user))
-	(let* ((f-name (ange-ftp-quote-string (nth 2 f-parsed)))
-	       (t-name (ange-ftp-quote-string (nth 2 t-parsed)))
-	       (cmd (list 'rename f-name t-name))
-	       (fabbr (ange-ftp-abbreviate-filename filename))
-	       (nabbr (ange-ftp-abbreviate-filename newname filename))
-	       (result (ange-ftp-send-cmd f-host f-user cmd
-					  (format "Renaming %s to %s"
-						  fabbr
-						  nabbr))))
-	  (or (car result)
-	      (signal 'ftp-error
-		      (list
-		       "Renaming"
-		       (format "FTP Error: \"%s\"" (cdr result))
-		       filename
-		       newname)))
-	  (ange-ftp-add-file-entry newname)
-	  (ange-ftp-delete-file-entry filename))
-      (ange-ftp-copy-file-internal filename newname t nil)
-      (delete-file filename))))
-
-(defun ange-ftp-rename-local-to-remote (filename newname)
-  "Rename local FILENAME to remote file NEWNAME."
-  (let* ((fabbr (ange-ftp-abbreviate-filename filename))
-	 (nabbr (ange-ftp-abbreviate-filename newname filename))
-	 (msg (format "Renaming %s to %s" fabbr nabbr)))
-    (ange-ftp-copy-file-internal filename newname t nil msg)
-    (let (ange-ftp-process-verbose)
-      (delete-file filename))))
-
-(defun ange-ftp-rename-remote-to-local (filename newname)
-  "Rename remote file FILENAME to local file NEWNAME."
-  (let* ((fabbr (ange-ftp-abbreviate-filename filename))
-	 (nabbr (ange-ftp-abbreviate-filename newname filename))
-	 (msg (format "Renaming %s to %s" fabbr nabbr)))
-    (ange-ftp-copy-file-internal filename newname t nil msg)
-    (let (ange-ftp-process-verbose)
-      (delete-file filename))))
-
-(defun ange-ftp-rename-file (filename newname &optional ok-if-already-exists)
-  (interactive "fRename file: \nFRename %s to file: \np")
-  (setq filename (expand-file-name filename))
-  (setq newname (expand-file-name newname))
-  (let* ((f-parsed (ange-ftp-ftp-name filename))
-	 (t-parsed (ange-ftp-ftp-name newname)))
-    (if (and (or f-parsed t-parsed)
-	     (or (not ok-if-already-exists)
-		 (numberp ok-if-already-exists)))
-	(ange-ftp-barf-or-query-if-file-exists
-	 newname
-	 "rename to it"
-	 (numberp ok-if-already-exists)))
-    (if f-parsed
-	(if t-parsed
-	    (ange-ftp-rename-remote-to-remote filename newname f-parsed
-					      t-parsed)
-	  (ange-ftp-rename-remote-to-local filename newname))
-      (if t-parsed
-	  (ange-ftp-rename-local-to-remote filename newname)
-	(ange-ftp-real-rename-file filename newname ok-if-already-exists)))))
-
-;;;; ------------------------------------------------------------
-;;;; File name completion support.
-;;;; ------------------------------------------------------------
-
-;; If the file entry SYM is a symlink, returns whether its file exists.
-;; Note that `ange-ftp-this-dir' is used as a free variable.
-(defun ange-ftp-file-entry-active-p (sym)
-  (let ((val (get sym 'val)))
-    (or (not (stringp val))
-	(file-exists-p (ange-ftp-expand-symlink val ange-ftp-this-dir)))))
-
-;; If the file entry is not a directory (nor a symlink pointing to a directory)
-;; returns whether the file (or file pointed to by the symlink) is ignored
-;; by completion-ignored-extensions.
-;; Note that `ange-ftp-this-dir' and `ange-ftp-completion-ignored-pattern'
-;; are used as free variables.
-(defun ange-ftp-file-entry-not-ignored-p (sym)
-  (let ((val (get sym 'val))
-	(symname (symbol-name sym)))
-    (if (stringp val)
-	(let ((file (ange-ftp-expand-symlink val ange-ftp-this-dir)))
-	  (or (file-directory-p file)
-	      (and (file-exists-p file)
-		   (not (string-match ange-ftp-completion-ignored-pattern
-				      symname)))))
-      (or val ; is a directory name
-	  (not (string-match ange-ftp-completion-ignored-pattern symname))))))
-
-(defun ange-ftp-file-name-all-completions (file dir)
-  (let ((ange-ftp-this-dir (expand-file-name dir)))
-    (if (ange-ftp-ftp-name ange-ftp-this-dir)
-	(progn
-	  (ange-ftp-barf-if-not-directory ange-ftp-this-dir)
-	  (setq ange-ftp-this-dir
-		(ange-ftp-real-file-name-as-directory ange-ftp-this-dir))
-	  (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
-		 (completions
-		  (all-completions file tbl
-				   (function ange-ftp-file-entry-active-p))))
-
-	    ;; see whether each matching file is a directory or not...
-	    (mapcar
-	     (function
-	      (lambda (file)
-		(let ((ent (ange-ftp-get-hash-entry file tbl)))
-		  (if (and ent
-			   (or (not (stringp ent))
-			       (file-directory-p
-				(ange-ftp-expand-symlink ent
-							 ange-ftp-this-dir))))
-		      (concat file "/")
-		    file))))
-	     completions)))
-
-      (if (string-equal "/" ange-ftp-this-dir)
-	  (nconc (all-completions file (ange-ftp-generate-root-prefixes))
-		 (ange-ftp-real-file-name-all-completions file
-							  ange-ftp-this-dir))
-	(ange-ftp-real-file-name-all-completions file ange-ftp-this-dir)))))
-
-(defun ange-ftp-file-name-completion (file dir)
-  (let ((ange-ftp-this-dir (expand-file-name dir)))
-    (if (ange-ftp-ftp-name ange-ftp-this-dir)
-	(progn
-	  (ange-ftp-barf-if-not-directory ange-ftp-this-dir)
-	  (if (equal file "")
-	      ""
-	    (setq ange-ftp-this-dir
-		  (ange-ftp-real-file-name-as-directory ange-ftp-this-dir))	;real?
-	    (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
-		   (ange-ftp-completion-ignored-pattern
-		    (mapconcat (function
-				(lambda (s) (if (stringp s)
-						(concat (regexp-quote s) "$")
-					      "/"))) ; / never in filename
-			       completion-ignored-extensions
-			       "\\|")))
-	      (save-match-data
-		(or (ange-ftp-file-name-completion-1
-		     file tbl ange-ftp-this-dir
-		     (function ange-ftp-file-entry-not-ignored-p))
-		    (ange-ftp-file-name-completion-1
-		     file tbl ange-ftp-this-dir
-		     (function ange-ftp-file-entry-active-p)))))))
-
-      (if (string-equal "/" ange-ftp-this-dir)
-	  (try-completion
-	   file
-	   (nconc (ange-ftp-generate-root-prefixes)
-		  (mapcar 'list
-			  (ange-ftp-real-file-name-all-completions file "/"))))
-	(ange-ftp-real-file-name-completion file ange-ftp-this-dir)))))
-
-
-(defun ange-ftp-file-name-completion-1 (file tbl dir predicate)
-  (let ((bestmatch (try-completion file tbl predicate)))
-    (if bestmatch
-	(if (eq bestmatch t)
-	    (if (file-directory-p (expand-file-name file dir))
-		(concat file "/")
-	      t)
-	  (if (and (eq (try-completion bestmatch tbl predicate) t)
-		   (file-directory-p
-		    (expand-file-name bestmatch dir)))
-	      (concat bestmatch "/")
-	    bestmatch)))))
-
-;; Put these lines uncommmented in your .emacs if you want C-r to refresh
-;; ange-ftp's cache whilst doing filename completion.
-;;
-;;(define-key minibuffer-local-completion-map "\C-r" 'ange-ftp-re-read-dir)
-;;(define-key minibuffer-local-must-match-map "\C-r" 'ange-ftp-re-read-dir)
-
-;; Force a re-read of the directory DIR.  If DIR is omitted then it defaults
-;; to the directory part of the contents of the current buffer.
-(defun ange-ftp-re-read-dir (&optional dir)
-  (interactive)
-  (if dir
-      (setq dir (expand-file-name dir))
-    (setq dir (file-name-directory (expand-file-name (buffer-string)))))
-  (if (ange-ftp-ftp-name dir)
-      (progn
-	(setq ange-ftp-ls-cache-file nil)
-	(ange-ftp-del-hash-entry dir ange-ftp-files-hashtable)
-	(ange-ftp-get-files dir t))))
-
-(defun ange-ftp-make-directory (dir &optional parents)
-  (interactive (list (expand-file-name (read-file-name "Make directory: "))))
-  (if parents
-      (let ((parent (file-name-directory (directory-file-name dir))))
-	(or (file-exists-p parent)
-	    (ange-ftp-make-directory parent parents))))
-  (if (file-exists-p dir)
-      (error "Cannot make directory %s: file already exists" dir)
-    (let ((parsed (ange-ftp-ftp-name dir)))
-      (if parsed
-	  (let* ((host (nth 0 parsed))
-		 (user (nth 1 parsed))
-		 ;; Some ftp's on unix machines (at least on Suns)
-		 ;; insist that mkdir take a filename, and not a
-		 ;; directory-name name as an arg. Argh!! This is a bug.
-		 ;; Non-unix machines will probably always insist
-		 ;; that mkdir takes a directory-name as an arg
-		 ;; (as the ftp man page says it should).
-		 (name (ange-ftp-quote-string
-			(if (eq (ange-ftp-host-type host) 'unix)
-			    (ange-ftp-real-directory-file-name (nth 2 parsed))
-			  (ange-ftp-real-file-name-as-directory
-			   (nth 2 parsed)))))
-		 (abbr (ange-ftp-abbreviate-filename dir))
-		 (result (ange-ftp-send-cmd host user
-					    (list 'mkdir name)
-					    (format "Making directory %s"
-						    abbr))))
-	    (or (car result)
-		(ange-ftp-error host user
-				(format "Could not make directory %s: %s"
-					dir
-					(cdr result))))
-	    (ange-ftp-add-file-entry dir t))
-	(ange-ftp-real-make-directory dir)))))
-
-(defun ange-ftp-delete-directory (dir)
-  (if (file-directory-p dir)
-      (let ((parsed (ange-ftp-ftp-name dir)))
-	(if parsed
-	    (let* ((host (nth 0 parsed))
-		   (user (nth 1 parsed))
-		   ;; Some ftp's on unix machines (at least on Suns)
-		   ;; insist that rmdir take a filename, and not a
-		   ;; directory-name name as an arg. Argh!! This is a bug.
-		   ;; Non-unix machines will probably always insist
-		   ;; that rmdir takes a directory-name as an arg
-		   ;; (as the ftp man page says it should).
-		   (name (ange-ftp-quote-string
-			  (if (eq (ange-ftp-host-type host) 'unix)
-			      (ange-ftp-real-directory-file-name
-			       (nth 2 parsed))
-			    (ange-ftp-real-file-name-as-directory
-			     (nth 2 parsed)))))
-		  (abbr (ange-ftp-abbreviate-filename dir))
-		  (result (ange-ftp-send-cmd host user
-					     (list 'rmdir name)
-					     (format "Removing directory %s"
-						     abbr))))
-	      (or (car result)
-		  (ange-ftp-error host user
-				  (format "Could not remove directory %s: %s"
-					  dir
-					  (cdr result))))
-	      (ange-ftp-delete-file-entry dir t))
-	  (ange-ftp-real-delete-directory dir)))
-    (error "Not a directory: %s" dir)))
-
-;; Make a local copy of FILE and return its name.
-
-(defun ange-ftp-file-local-copy (file)
-  (let* ((fn1 (expand-file-name file))
-	 (pa1 (ange-ftp-ftp-name fn1)))
-    (if pa1
-	(let ((tmp1 (ange-ftp-make-tmp-name (car pa1))))
-	  (ange-ftp-copy-file-internal fn1 tmp1 t nil
-				       (format "Getting %s" fn1))
-	  tmp1))))
-
-(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
-  (if (ange-ftp-ftp-name file)
-      (let ((tryfiles (if nosuffix
-			  (list file)
-			(list (concat file ".elc") (concat file ".el") file)))
-	    copy)
-	(while (and tryfiles (not copy))
-	  (condition-case error
-	      (setq copy (ange-ftp-file-local-copy (car tryfiles)))
-	    (ftp-error nil))
-	  (setq tryfiles (cdr tryfiles)))
-	(if copy
-	    (unwind-protect
-		(funcall 'load copy noerror nomessage nosuffix)
-	      (delete-file copy))
-	  (or noerror
-	      (signal 'file-error (list "Cannot open load file" file)))))
-    (ange-ftp-real-load file noerror nomessage nosuffix)))
-
-;; Calculate default-unhandled-directory for a given ange-ftp buffer.
-(defun ange-ftp-unhandled-file-name-directory (filename)
-  (file-name-directory ange-ftp-tmp-name-template))
-
-
-;; Need the following functions for making filenames of compressed
-;; files, because some OS's (unlike UNIX) do not allow a filename to
-;; have two extensions.
-
-(defvar ange-ftp-make-compressed-filename-alist nil
-  "Alist of host-type-specific functions to process file names for compression.
-Each element has the form (TYPE . FUNC).
-FUNC should take one argument, a file name, and return a list
-of the form (COMPRESSING NEWNAME).
-COMPRESSING should be t if the specified file should be compressed, 
-and nil if it should be uncompressed (that is, if it is a compressed file).
-NEWNAME should be the name to give the new compressed or uncompressed file.")
-
-(defun ange-ftp-dired-compress-file (name)
-  (let ((parsed (ange-ftp-ftp-name name))
-	conversion-func)
-    (if (and parsed
-	     (setq conversion-func
-		   (cdr (assq (ange-ftp-host-type (car parsed))
-			      ange-ftp-make-compressed-filename-alist))))
-	(let* ((decision
-		(save-match-data (funcall conversion-func name)))
-	       (compressing (car decision))
-	       (newfile (nth 1 decision)))
-	  (if compressing
-	      (ange-ftp-compress name newfile)
-	    (ange-ftp-uncompress name newfile)))
-      (let (file-name-handler-alist)
-	(dired-compress-file name)))))
-
-;; Copy FILE to this machine, compress it, and copy out to NFILE.
-(defun ange-ftp-compress (file nfile)
-  (let* ((parsed (ange-ftp-ftp-name file))
-	 (tmp1 (ange-ftp-make-tmp-name (car parsed)))
-	 (tmp2 (ange-ftp-make-tmp-name (car parsed)))
-	 (abbr (ange-ftp-abbreviate-filename file))
-	 (nabbr (ange-ftp-abbreviate-filename nfile))
-	 (msg1 (format "Getting %s" abbr))
-	 (msg2 (format "Putting %s" nabbr)))
-    (unwind-protect
-	(progn
-	  (ange-ftp-copy-file-internal file tmp1 t nil msg1)
-	  (and ange-ftp-process-verbose
-	       (ange-ftp-message "Compressing %s..." abbr))
-	  (call-process-region (point)
-			       (point)
-			       shell-file-name
-			       nil
-			       t
-			       nil
-			       "-c"
-			       (format "compress -f -c < %s > %s" tmp1 tmp2))
-	  (and ange-ftp-process-verbose
-	       (ange-ftp-message "Compressing %s...done" abbr))
-	  (if (zerop (buffer-size))
-	      (progn
-		(let (ange-ftp-process-verbose)
-		  (delete-file file))
-		(ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
-      (ange-ftp-del-tmp-name tmp1)
-      (ange-ftp-del-tmp-name tmp2))))
-    
-;; Copy FILE to this machine, uncompress it, and copy out to NFILE.
-(defun ange-ftp-uncompress (file nfile)
-  (let* ((parsed (ange-ftp-ftp-name file))
-	 (tmp1 (ange-ftp-make-tmp-name (car parsed)))
-	 (tmp2 (ange-ftp-make-tmp-name (car parsed)))
-	 (abbr (ange-ftp-abbreviate-filename file))
-	 (nabbr (ange-ftp-abbreviate-filename nfile))
-	 (msg1 (format "Getting %s" abbr))
-	 (msg2 (format "Putting %s" nabbr))
-;;	 ;; Cheap hack because of problems with binary file transfers from
-;;	 ;; VMS hosts.
-;;	 (gbinary (not (eq 'vms (ange-ftp-host-type (car parsed)))))
-	 )
-    (unwind-protect
-	(progn
-	  (ange-ftp-copy-file-internal file tmp1 t nil msg1)
-	  (and ange-ftp-process-verbose
-	       (ange-ftp-message "Uncompressing %s..." abbr))
-	  (call-process-region (point)
-			       (point)
-			       shell-file-name
-			       nil
-			       t
-			       nil
-			       "-c"
-			       (format "uncompress -c < %s > %s" tmp1 tmp2))
-	  (and ange-ftp-process-verbose
-	       (ange-ftp-message "Uncompressing %s...done" abbr))
-	  (if (zerop (buffer-size))
-	      (progn
-		(let (ange-ftp-process-verbose)
-		  (delete-file file))
-		(ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
-      (ange-ftp-del-tmp-name tmp1)
-      (ange-ftp-del-tmp-name tmp2))))
-
-(defun ange-ftp-find-backup-file-name (fn)
-  ;; Either return the ordinary backup name, etc.,
-  ;; or return nil meaning don't make a backup.
-  (if ange-ftp-make-backup-files
-      (ange-ftp-real-find-backup-file-name fn)))
-
-;;; Define the handler for special file names
-;;; that causes ange-ftp to be invoked.
-
-;;;###autoload
-(defun ange-ftp-hook-function (operation &rest args)
-  (let ((fn (get operation 'ange-ftp)))
-    (if fn (apply fn args)
-      (ange-ftp-run-real-handler operation args))))
-
-
-;;; This regexp takes care of real ange-ftp file names (with a slash
-;;; and colon).
-;;; Don't allow the host name to end in a period--some systems use /.:
-;;;###autoload
-(or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist)
-    (setq file-name-handler-alist
-	  (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
-		file-name-handler-alist)))
-
-;;; This regexp recognizes and absolute filenames with only one component,
-;;; for the sake of hostname completion.
-;;;###autoload
-(or (assoc "^/[^/:]*\\'" file-name-handler-alist)
-    (setq file-name-handler-alist
-	  (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
-		file-name-handler-alist)))
-
-;;; The above two forms are sufficient to cause this file to be loaded
-;;; if the user ever uses a file name with a colon in it.
-
-;;; This sets the mode 
-(or (memq 'ange-ftp-set-buffer-mode find-file-hooks)
-    (setq find-file-hooks
-	  (cons 'ange-ftp-set-buffer-mode find-file-hooks)))
-
-;;; Now say where to find the handlers for particular operations.
-
-(put 'file-name-directory 'ange-ftp 'ange-ftp-file-name-directory)
-(put 'file-name-nondirectory 'ange-ftp 'ange-ftp-file-name-nondirectory)
-(put 'file-name-as-directory 'ange-ftp 'ange-ftp-file-name-as-directory)
-(put 'directory-file-name 'ange-ftp 'ange-ftp-directory-file-name)
-(put 'expand-file-name 'ange-ftp 'ange-ftp-expand-file-name)
-(put 'make-directory 'ange-ftp 'ange-ftp-make-directory)
-(put 'delete-directory 'ange-ftp 'ange-ftp-delete-directory)
-(put 'insert-file-contents 'ange-ftp 'ange-ftp-insert-file-contents)
-(put 'directory-files 'ange-ftp 'ange-ftp-directory-files)
-(put 'file-directory-p 'ange-ftp 'ange-ftp-file-directory-p)
-(put 'file-writable-p 'ange-ftp 'ange-ftp-file-writable-p)
-(put 'file-readable-p 'ange-ftp 'ange-ftp-file-readable-p)
-(put 'file-executable-p 'ange-ftp 'ange-ftp-file-executable-p)
-(put 'file-symlink-p 'ange-ftp 'ange-ftp-file-symlink-p)
-(put 'delete-file 'ange-ftp 'ange-ftp-delete-file)
-(put 'read-file-name-internal 'ange-ftp 'ange-ftp-read-file-name-internal)
-(put 'verify-visited-file-modtime 'ange-ftp
-     'ange-ftp-verify-visited-file-modtime)
-(put 'file-exists-p 'ange-ftp 'ange-ftp-file-exists-p)
-(put 'write-region 'ange-ftp 'ange-ftp-write-region)
-(put 'backup-buffer 'ange-ftp 'ange-ftp-backup-buffer)
-(put 'copy-file 'ange-ftp 'ange-ftp-copy-file)
-(put 'rename-file 'ange-ftp 'ange-ftp-rename-file)
-(put 'file-attributes 'ange-ftp 'ange-ftp-file-attributes)
-(put 'file-name-all-completions 'ange-ftp 'ange-ftp-file-name-all-completions)
-(put 'file-name-completion 'ange-ftp 'ange-ftp-file-name-completion)
-(put 'insert-directory 'ange-ftp 'ange-ftp-insert-directory)
-(put 'file-local-copy 'ange-ftp 'ange-ftp-file-local-copy)
-(put 'unhandled-file-name-directory 'ange-ftp
-     'ange-ftp-unhandled-file-name-directory)
-(put 'file-name-sans-versions 'ange-ftp 'ange-ftp-file-name-sans-versions)
-(put 'dired-uncache 'ange-ftp 'ange-ftp-dired-uncache)
-(put 'dired-compress-file 'ange-ftp 'ange-ftp-dired-compress-file)
-(put 'load 'ange-ftp 'ange-ftp-load)
-(put 'find-backup-file-name 'ange-ftp 'ange-ftp-find-backup-file-name)
-
-;; Turn off truename processing to save time.
-;; Treat each name as its own truename.
-(put 'file-truename 'ange-ftp 'identity)
-
-;; Turn off RCS/SCCS processing to save time.
-;; This returns nil for any file name as argument.
-(put 'vc-registered 'ange-ftp 'null)
-
-(put 'dired-call-process 'ange-ftp 'ange-ftp-dired-call-process)
-
-;;; Define ways of getting at unmodified Emacs primitives,
-;;; turning off our handler.
-
-(defun ange-ftp-run-real-handler (operation args)
-  (let ((inhibit-file-name-handlers
-	 (cons 'ange-ftp-hook-function
-	       (cons 'ange-ftp-completion-hook-function
-		     (and (eq inhibit-file-name-operation operation)
-			  inhibit-file-name-handlers))))
-	(inhibit-file-name-operation operation))
-    (apply operation args)))
-
-(defun ange-ftp-real-file-name-directory (&rest args)
-  (ange-ftp-run-real-handler 'file-name-directory args))
-(defun ange-ftp-real-file-name-nondirectory (&rest args)
-  (ange-ftp-run-real-handler 'file-name-nondirectory args))
-(defun ange-ftp-real-file-name-as-directory (&rest args)
-  (ange-ftp-run-real-handler 'file-name-as-directory args))
-(defun ange-ftp-real-directory-file-name (&rest args)
-  (ange-ftp-run-real-handler 'directory-file-name args))
-(defun ange-ftp-real-expand-file-name (&rest args)
-  (ange-ftp-run-real-handler 'expand-file-name args))
-(defun ange-ftp-real-make-directory (&rest args)
-  (ange-ftp-run-real-handler 'make-directory args))
-(defun ange-ftp-real-delete-directory (&rest args)
-  (ange-ftp-run-real-handler 'delete-directory args))
-(defun ange-ftp-real-insert-file-contents (&rest args)
-  (ange-ftp-run-real-handler 'insert-file-contents args))
-(defun ange-ftp-real-directory-files (&rest args)
-  (ange-ftp-run-real-handler 'directory-files args))
-(defun ange-ftp-real-file-directory-p (&rest args)
-  (ange-ftp-run-real-handler 'file-directory-p args))
-(defun ange-ftp-real-file-writable-p (&rest args)
-  (ange-ftp-run-real-handler 'file-writable-p args))
-(defun ange-ftp-real-file-readable-p (&rest args)
-  (ange-ftp-run-real-handler 'file-readable-p args))
-(defun ange-ftp-real-file-executable-p (&rest args)
-  (ange-ftp-run-real-handler 'file-executable-p args))
-(defun ange-ftp-real-file-symlink-p (&rest args)
-  (ange-ftp-run-real-handler 'file-symlink-p args))
-(defun ange-ftp-real-delete-file (&rest args)
-  (ange-ftp-run-real-handler 'delete-file args))
-(defun ange-ftp-real-read-file-name-internal (&rest args)
-  (ange-ftp-run-real-handler 'read-file-name-internal args))
-(defun ange-ftp-real-verify-visited-file-modtime (&rest args)
-  (ange-ftp-run-real-handler 'verify-visited-file-modtime args))
-(defun ange-ftp-real-file-exists-p (&rest args)
-  (ange-ftp-run-real-handler 'file-exists-p args))
-(defun ange-ftp-real-write-region (&rest args)
-  (ange-ftp-run-real-handler 'write-region args))
-(defun ange-ftp-real-backup-buffer (&rest args)
-  (ange-ftp-run-real-handler 'backup-buffer args))
-(defun ange-ftp-real-copy-file (&rest args)
-  (ange-ftp-run-real-handler 'copy-file args))
-(defun ange-ftp-real-rename-file (&rest args)
-  (ange-ftp-run-real-handler 'rename-file args))
-(defun ange-ftp-real-file-attributes (&rest args)
-  (ange-ftp-run-real-handler 'file-attributes args))
-(defun ange-ftp-real-file-name-all-completions (&rest args)
-  (ange-ftp-run-real-handler 'file-name-all-completions args))
-(defun ange-ftp-real-file-name-completion (&rest args)
-  (ange-ftp-run-real-handler 'file-name-completion args))
-(defun ange-ftp-real-insert-directory (&rest args)
-  (ange-ftp-run-real-handler 'insert-directory args))
-(defun ange-ftp-real-file-name-sans-versions (&rest args)
-  (ange-ftp-run-real-handler 'file-name-sans-versions args))
-(defun ange-ftp-real-shell-command (&rest args)
-  (ange-ftp-run-real-handler 'shell-command args))
-(defun ange-ftp-real-load (&rest args)
-  (ange-ftp-run-real-handler 'load args))
-(defun ange-ftp-real-find-backup-file-name (&rest args)
-  (ange-ftp-run-real-handler 'find-backup-file-name args))
-
-;; Here we support using dired on remote hosts.
-;; I have turned off the support for using dired on foreign directory formats.
-;; That involves too many unclean hooks.
-;; It would be cleaner to support such operations by 
-;; converting the foreign directory format to something dired can understand;
-;; something close to ls -l output.
-;; The logical place to do this is in the functions ange-ftp-parse-...-listing.
-
-;; Some of the old dired hooks would still be needed even if this is done.
-;; I have preserved (and modernized) those hooks.
-;; So the format conversion should be all that is needed.
-
-(defun ange-ftp-insert-directory (file switches &optional wildcard full)
-  (let ((short (ange-ftp-abbreviate-filename file))
-	(parsed (ange-ftp-ftp-name (expand-file-name file))))
-    (if parsed
-	(insert
-	 (if wildcard
-	     (let ((default-directory (file-name-directory file)))
-	       (ange-ftp-ls (file-name-nondirectory file) switches nil nil t))
-	   (ange-ftp-ls file switches full)))
-      (ange-ftp-real-insert-directory file switches wildcard full))))
-
-(defun ange-ftp-dired-uncache (dir)
-  (if (ange-ftp-ftp-name (expand-file-name dir))
-      (setq ange-ftp-ls-cache-file nil)))
-
-(defvar ange-ftp-sans-version-alist nil
-  "Alist of mapping host type into function to remove file version numbers.")
-
-(defun ange-ftp-file-name-sans-versions (file keep-backup-version)
-  (setq file (ange-ftp-abbreviate-filename file))
-  (let ((parsed (ange-ftp-ftp-name file))
-	host-type func)
-    (if parsed
-	(setq host-type (ange-ftp-host-type (car parsed))
-	      func (cdr (assq (ange-ftp-host-type (car parsed))
-			      ange-ftp-sans-version-alist))))
-    (if func (funcall func file keep-backup-version)
-      (ange-ftp-real-file-name-sans-versions file keep-backup-version))))
-
-;;; This doesn't work yet; a new hook needs to be created.
-;;; Maybe the new hook should be in call-process.
-(defun ange-ftp-shell-command (command)
-  (let* ((parsed (ange-ftp-ftp-name default-directory))
-	 (host (nth 0 parsed))
-	 (user (nth 1 parsed))
-	 (name (nth 2 parsed)))
-    (if (not parsed)
-	(ange-ftp-real-shell-command command)
-      (if (> (length name) 0)		; else it's $HOME
-	  (setq command (concat "cd " name "; " command)))
-      (setq command
-	    (format  "%s %s \"%s\""	; remsh -l USER does not work well
-					; on a hp-ux machine I tried
-		     remote-shell-program host command))
-      (ange-ftp-message "Remote command '%s' ..." command)
-      ;; Cannot call ange-ftp-real-dired-run-shell-command here as it
-      ;; would prepend "cd default-directory" --- which bombs because
-      ;; default-directory is in ange-ftp syntax for remote file names.
-      (ange-ftp-real-shell-command command))))
-
-;;; This is the handler for call-process.
-(defun ange-ftp-dired-call-process (program discard &rest arguments)
-  ;; PROGRAM is always one of those below in the cond in dired.el.
-  ;; The ARGUMENTS are (nearly) always files.
-  (if (ange-ftp-ftp-name default-directory)
-      ;; Can't use ange-ftp-dired-host-type here because the current
-      ;; buffer is *dired-check-process output*
-      (condition-case oops
-	  (cond ((equal "chmod" program)
-		 (ange-ftp-call-chmod arguments))
-		;; ((equal "chgrp" program))
-		;; ((equal dired-chown-program program))
-		(t (error "Unknown remote command: %s" program)))
-	(ftp-error (insert (format "%s: %s, %s\n"
-				    (nth 1 oops)
-				    (nth 2 oops)
-				    (nth 3 oops)))
-		   ;; Caller expects nonzero value to mean failure.
-		   1)
-	(error (insert (format "%s\n" (nth 1 oops)))
-	       1))
-    (apply 'call-process program nil (not discard) nil arguments)))
-
-(defvar ange-ftp-remote-shell "rsh" 
-  "Remote shell to use for chmod, if FTP server rejects the `chmod' command.")
-
-;; Handle an attempt to run chmod on a remote file
-;; by using the ftp chmod command.
-(defun ange-ftp-call-chmod (args)
-  (if (< (length args) 2)
-      (error "ange-ftp-call-chmod: missing mode and/or filename: %s" args))
-  (let ((mode (car args)))
-    (mapcar
-     (function
-      (lambda (file)
-	(setq file (expand-file-name file))
-	(let ((parsed (ange-ftp-ftp-name file)))
-	  (if parsed
-	      (let* ((host (nth 0 parsed))
-		     (user (nth 1 parsed))
-		     (name (ange-ftp-quote-string (nth 2 parsed)))
-		     (abbr (ange-ftp-abbreviate-filename file))
-		     (result (ange-ftp-send-cmd host user
-						(list 'chmod mode name)
-						(format "doing chmod %s"
-							abbr))))
-		(or (car result)
-		    (call-process 
-		     ange-ftp-remote-shell
-		     nil t nil host "chmod" mode name)))))))
-     (cdr args)))
-  (setq ange-ftp-ls-cache-file nil)	;Stop confusing Dired.
-  0)
-
-;;; This is turned off because it has nothing properly to do
-;;; with dired.  It could be reasonable to adapt this to
-;;; replace ange-ftp-copy-file.
-
-;;;;; ------------------------------------------------------------
-;;;;; Noddy support for async copy-file within dired.
-;;;;; ------------------------------------------------------------
-
-;;(defun ange-ftp-dired-copy-file (from to ok-flag &optional cont nowait)
-;;  "Documented as original."
-;;  (dired-handle-overwrite to)
-;;  (ange-ftp-copy-file-internal from to ok-flag dired-copy-preserve-time nil
-;;			       cont nowait))
-
-;;(defun ange-ftp-dired-do-create-files (op-symbol file-creator operation arg
-;;						 &optional marker-char op1
-;;						 how-to)
-;;  "Documented as original."
-;;  ;; we need to let ange-ftp-dired-create-files know that we indirectly
-;;  ;; called it rather than somebody else.
-;;  (let ((ange-ftp-dired-do-create-files t)) ; tell who caller is
-;;    (ange-ftp-real-dired-do-create-files op-symbol file-creator operation
-;;					 arg marker-char op1 how-to)))
-
-;;(defun ange-ftp-dired-create-files (file-creator operation fn-list name-constructor
-;;						 &optional marker-char)
-;;  "Documented as original."
-;;  (if (and (boundp 'ange-ftp-dired-do-create-files)
-;;	   ;; called from ange-ftp-dired-do-create-files?
-;;	   ange-ftp-dired-do-create-files
-;;	   ;; any files worth copying?
-;;	   fn-list
-;;	   ;; we only support async copy-file at the mo.
-;;	   (eq file-creator 'dired-copy-file)
-;;	   ;; it is only worth calling the alternative function for remote files
-;;	   ;; as we tie ourself in recursive knots otherwise.
-;;	   (or (ange-ftp-ftp-name (car fn-list))
-;;	       ;; we can only call the name constructor for dired-do-create-files
-;;	       ;; since the one for regexps starts prompting here, there and
-;;	       ;; everywhere.
-;;	       (ange-ftp-ftp-name (funcall name-constructor (car fn-list)))))
-;;      ;; use the process-filter driven routine rather than the iterative one.
-;;      (ange-ftp-dcf-1 file-creator
-;;   		      operation
-;; 		      fn-list
-;; 		      name-constructor
-;; 		      (and (boundp 'target) target)	;dynamically bound
-;; 		      marker-char
-;; 		      (current-buffer)
-;; 		      nil	;overwrite-query
-;; 		      nil	;overwrite-backup-query
-;; 		      nil	;failures
-;; 		      nil	;skipped
-;; 		      0		;success-count
-;; 		      (length fn-list) ;total
-;; 		      )
-;;    ;; normal case... use the interactive routine... much cheaper.
-;;    (ange-ftp-real-dired-create-files file-creator operation fn-list
-;;				      name-constructor marker-char)))
-
-;;(defun ange-ftp-dcf-1 (file-creator operation fn-list name-constructor
-;;		       target marker-char buffer overwrite-query 
-;;		       overwrite-backup-query failures skipped
-;;		       success-count total)
-;;  (let ((old-buf (current-buffer)))
-;;    (unwind-protect
-;;	(progn
-;;	  (set-buffer buffer)
-;;	  (if (null fn-list)
-;;	      (ange-ftp-dcf-3 failures operation total skipped
-;;			      success-count buffer)
-	    
-;;	    (let* ((from (car fn-list))
-;;		   (to (funcall name-constructor from)))
-;;	      (if (equal to from)
-;;		  (progn
-;;		    (setq to nil)
-;;		    (dired-log "Cannot %s to same file: %s\n"
-;;			       (downcase operation) from)))
-;;	      (if (not to)
-;;		  (ange-ftp-dcf-1 file-creator
-;;				  operation
-;;				  (cdr fn-list)
-;;				  name-constructor
-;;				  target
-;;				  marker-char
-;;				  buffer
-;;				  overwrite-query
-;;				  overwrite-backup-query
-;;				  failures
-;;				  (cons (dired-make-relative from) skipped)
-;;				  success-count
-;;				  total)
-;;		(let* ((overwrite (file-exists-p to))
-;;		       (overwrite-confirmed	; for dired-handle-overwrite
-;;			(and overwrite
-;;			     (let ((help-form '(format "\
-;;Type SPC or `y' to overwrite file `%s',
-;;DEL or `n' to skip to next,
-;;ESC or `q' to not overwrite any of the remaining files,
-;;`!' to overwrite all remaining files with no more questions." to)))
-;;			       (dired-query 'overwrite-query
-;;					    "Overwrite `%s'?" to))))
-;;		       ;; must determine if FROM is marked before file-creator
-;;		       ;; gets a chance to delete it (in case of a move).
-;;		       (actual-marker-char
-;;			(cond  ((integerp marker-char) marker-char)
-;;			       (marker-char (dired-file-marker from)) ; slow
-;;			       (t nil))))
-;;		  (condition-case err
-;;		      (funcall file-creator from to overwrite-confirmed
-;;			       (list (function ange-ftp-dcf-2)
-;;				     nil	;err
-;;				     file-creator operation fn-list
-;;				     name-constructor
-;;				     target
-;;				     marker-char actual-marker-char
-;;				     buffer to from
-;;				     overwrite
-;;				     overwrite-confirmed
-;;				     overwrite-query 
-;;				     overwrite-backup-query
-;;				     failures skipped success-count
-;;				     total)
-;;			       t)
-;;		    (file-error		; FILE-CREATOR aborted
-;;		     (ange-ftp-dcf-2 nil ;result
-;;				     nil ;line
-;;				     err
-;;				     file-creator operation fn-list
-;;				     name-constructor
-;;				     target
-;;				     marker-char actual-marker-char
-;;				     buffer to from
-;;				     overwrite
-;;				     overwrite-confirmed
-;;				     overwrite-query 
-;;				     overwrite-backup-query
-;;				     failures skipped success-count
-;;				     total))))))))
-;;      (set-buffer old-buf))))
-
-;;(defun ange-ftp-dcf-2 (result line err
-;;			      file-creator operation fn-list
-;;			      name-constructor
-;;			      target
-;;			      marker-char actual-marker-char
-;;			      buffer to from
-;;			      overwrite
-;;			      overwrite-confirmed
-;;			      overwrite-query 
-;;			      overwrite-backup-query
-;;			      failures skipped success-count
-;;			      total)
-;;  (let ((old-buf (current-buffer)))
-;;    (unwind-protect
-;;	(progn
-;;	  (set-buffer buffer)
-;;	  (if (or err (not result))
-;;	      (progn
-;;		(setq failures (cons (dired-make-relative from) failures))
-;;		(dired-log "%s `%s' to `%s' failed:\n%s\n"
-;;			   operation from to (or err line)))
-;;	    (if overwrite
-;;		;; If we get here, file-creator hasn't been aborted
-;;		;; and the old entry (if any) has to be deleted
-;;		;; before adding the new entry.
-;;		(dired-remove-file to))
-;;	    (setq success-count (1+ success-count))
-;;	    (message "%s: %d of %d" operation success-count total)
-;;	    (dired-add-file to actual-marker-char))
-	  
-;;	  (ange-ftp-dcf-1 file-creator operation (cdr fn-list)
-;;			  name-constructor
-;;			  target
-;;			  marker-char
-;;			  buffer
-;;			  overwrite-query 
-;;			  overwrite-backup-query
-;;			  failures skipped success-count
-;;			  total))
-;;      (set-buffer old-buf))))
-
-;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
-;;				buffer)
-;;  (let ((old-buf (current-buffer)))
-;;    (unwind-protect
-;;	(progn
-;;	  (set-buffer buffer)
-;;	  (cond
-;;	   (failures
-;;	    (dired-log-summary
-;;	     (message "%s failed for %d of %d file%s %s"
-;;		      operation (length failures) total
-;;		      (dired-plural-s total) failures)))
-;;	   (skipped
-;;	    (dired-log-summary
-;;	     (message "%s: %d of %d file%s skipped %s"
-;;		      operation (length skipped) total
-;;		      (dired-plural-s total) skipped)))
-;;	   (t
-;;	    (message "%s: %s file%s."
-;;		     operation success-count (dired-plural-s success-count))))
-;;	  (dired-move-to-filename))
-;;      (set-buffer old-buf))))
-
-;;;; -----------------------------------------------
-;;;; Unix Descriptive Listing (dl) Support
-;;;; -----------------------------------------------
-
-;; This is turned off because nothing uses it currently
-;; and because I don't understand what it's supposed to be for. --rms.
-
-;;(defconst ange-ftp-dired-dl-re-dir
-;;  "^. [^ /]+/[ \n]"
-;;  "Regular expression to use to search for dl directories.")
-
-;;(or (assq 'unix:dl ange-ftp-dired-re-dir-alist)
-;;    (setq ange-ftp-dired-re-dir-alist
-;;	  (cons (cons 'unix:dl  ange-ftp-dired-dl-re-dir)
-;;		ange-ftp-dired-re-dir-alist)))
-
-;;(defun ange-ftp-dired-dl-move-to-filename (&optional raise-error eol)
-;;  "In dired, move to the first character of the filename on this line."
-;;  ;; This is the Unix dl version.
-;;  (or eol (setq eol (progn (end-of-line) (point))))
-;;  (let (case-fold-search)
-;;    (beginning-of-line)
-;;    (if (looking-at ". [^ ]+ +\\([0-9]+\\|-\\|=\\) ")
-;;	(goto-char (+ (point) 2))
-;;      (if raise-error
-;;	  (error "No file on this line")
-;;	nil))))
-
-;;(or (assq 'unix:dl ange-ftp-dired-move-to-filename-alist)
-;;    (setq ange-ftp-dired-move-to-filename-alist
-;;	  (cons '(unix:dl . ange-ftp-dired-dl-move-to-filename)
-;;		ange-ftp-dired-move-to-filename-alist)))
-
-;;(defun ange-ftp-dired-dl-move-to-end-of-filename (&optional no-error eol)
-;;  ;; Assumes point is at beginning of filename.
-;;  ;; So, it should be called only after (dired-move-to-filename t).
-;;  ;; On failure, signals an error or returns nil.
-;;  ;; This is the Unix dl version.
-;;  (let ((opoint (point))
-;;	case-fold-search hidden)
-;;    (or eol (setq eol (save-excursion (end-of-line) (point))))
-;;    (setq hidden (and selective-display
-;;		       (save-excursion
-;;			 (search-forward "\r" eol t))))
-;;    (if hidden
-;;	(if no-error
-;;	    nil
-;;	  (error
-;;	   (substitute-command-keys
-;;	    "File line is hidden, type \\[dired-hide-subdir] to unhide")))
-;;      (skip-chars-forward "^ /" eol)
-;;      (if (eq opoint (point))
-;;	  (if no-error
-;;	      nil
-;;	    (error "No file on this line"))
-;;	(point)))))
-
-;;(or (assq 'unix:dl ange-ftp-dired-move-to-end-of-filename-alist)
-;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
-;;	  (cons '(unix:dl . ange-ftp-dired-dl-move-to-end-of-filename)
-;;		ange-ftp-dired-move-to-end-of-filename-alist)))
-
-;;;; ------------------------------------------------------------
-;;;; VOS support (VOS support is probably broken,
-;;;; but I don't know anything about VOS.)
-;;;; ------------------------------------------------------------
-;
-;(defun ange-ftp-fix-name-for-vos (name &optional reverse)
-;  (setq name (copy-sequence name))
-;  (let ((from (if reverse ?\> ?\/))
-;	(to (if reverse ?\/ ?\>))
-;	(i (1- (length name))))
-;    (while (>= i 0)
-;      (if (= (aref name i) from)
-;	  (aset name i to))
-;      (setq i (1- i)))
-;    name))
-;
-;(or (assq 'vos ange-ftp-fix-name-func-alist)
-;    (setq ange-ftp-fix-name-func-alist
-;	  (cons '(vos . ange-ftp-fix-name-for-vos)
-;		ange-ftp-fix-name-func-alist)))
-;
-;(or (memq 'vos ange-ftp-dumb-host-types)
-;    (setq ange-ftp-dumb-host-types
-;	  (cons 'vos ange-ftp-dumb-host-types)))
-;
-;(defun ange-ftp-fix-dir-name-for-vos (dir-name)
-;  (ange-ftp-fix-name-for-vos
-;   (concat dir-name
-;	   (if (eq ?/ (aref dir-name (1- (length dir-name))))
-;	       "" "/")
-;	   "*")))
-;
-;(or (assq 'vos ange-ftp-fix-dir-name-func-alist)
-;    (setq ange-ftp-fix-dir-name-func-alist
-;	  (cons '(vos . ange-ftp-fix-dir-name-for-vos)
-;		ange-ftp-fix-dir-name-func-alist)))
-;
-;(defvar ange-ftp-vos-host-regexp nil
-;  "If a host matches this regexp then it is assumed to be running VOS.")
-;
-;(defun ange-ftp-vos-host (host)
-;  (and ange-ftp-vos-host-regexp
-;       (save-match-data
-;	 (string-match ange-ftp-vos-host-regexp host))))
-;
-;(defun ange-ftp-parse-vos-listing ()
-;  "Parse the current buffer which is assumed to be in VOS list -all
-;format, and return a hashtable as the result."
-;  (let ((tbl (ange-ftp-make-hashtable))
-;	(type-list
-;	 '(("^Files: [0-9]+ +Blocks: [0-9]+\n+" nil 40)
-;	   ("^Dirs: [0-9]+\n+" t 30)))
-;	type-regexp type-is-dir type-col file)
-;    (goto-char (point-min))
-;    (save-match-data
-;      (while type-list
-;	(setq type-regexp (car (car type-list))
-;	      type-is-dir (nth 1 (car type-list))
-;	      type-col (nth 2 (car type-list))
-;	      type-list (cdr type-list))
-;	(if (re-search-forward type-regexp nil t)
-;	    (while (eq (char-after (point)) ? )
-;	      (move-to-column type-col)
-;	      (setq file (buffer-substring (point)
-;					   (progn
-;					     (end-of-line 1)
-;					     (point))))
-;	      (ange-ftp-put-hash-entry file type-is-dir tbl)
-;	      (forward-line 1))))
-;      (ange-ftp-put-hash-entry "." 'vosdir tbl)
-;      (ange-ftp-put-hash-entry ".." 'vosdir tbl))
-;    tbl))
-;
-;(or (assq 'vos ange-ftp-parse-list-func-alist)
-;    (setq ange-ftp-parse-list-func-alist
-;	  (cons '(vos . ange-ftp-parse-vos-listing)
-;		ange-ftp-parse-list-func-alist)))
-
-;;;; ------------------------------------------------------------
-;;;; VMS support.
-;;;; ------------------------------------------------------------
-
-;; Convert NAME from UNIX-ish to VMS.  If REVERSE given then convert from VMS
-;; to UNIX-ish.
-(defun ange-ftp-fix-name-for-vms (name &optional reverse)
-  (save-match-data
-    (if reverse
-	(if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name)
-	    (let (drive dir file)
-	      (if (match-beginning 1)
-		  (setq drive (substring name
-					 (match-beginning 1)
-					 (match-end 1))))
-	      (if (match-beginning 2)
-		  (setq dir
-			(substring name (match-beginning 2) (match-end 2))))
-	      (if (match-beginning 3)
-		  (setq file
-			(substring name (match-beginning 3) (match-end 3))))
-	      (and dir
-		   (setq dir (apply (function concat)
-				    (mapcar (function
-					     (lambda (char)
-					       (if (= char ?.)
-						   (vector ?/)
-						 (vector char))))
-					    (substring dir 1 -1)))))
-	      (concat (and drive
-			   (concat "/" drive "/"))
-		      dir (and dir "/")
-		      file))
-	  (error "name %s didn't match" name))
-      (let (drive dir file tmp)
-	(if (string-match "^/[^:]+:/" name)
-	    (setq drive (substring name 1
-				   (1- (match-end 0)))
-		  name (substring name (match-end 0))))
-	(setq tmp (file-name-directory name))
-	(if tmp
-	    (setq dir (apply (function concat)
-			     (mapcar (function
-				      (lambda (char)
-					(if (= char ?/)
-					    (vector ?.)
-					  (vector char))))
-				     (substring tmp 0 -1)))))
-	(setq file (file-name-nondirectory name))
-	(concat drive
-		(and dir (concat "[" (if drive nil ".") dir "]"))
-		file)))))
-
-;; (ange-ftp-fix-name-for-vms "/PUB$:/ANONYMOUS/SDSCPUB/NEXT/Readme.txt;1")
-;; (ange-ftp-fix-name-for-vms "/PUB$:[ANONYMOUS.SDSCPUB.NEXT]Readme.txt;1" t)
-
-(or (assq 'vms ange-ftp-fix-name-func-alist)
-    (setq ange-ftp-fix-name-func-alist
-	  (cons '(vms . ange-ftp-fix-name-for-vms)
-		ange-ftp-fix-name-func-alist)))
-
-(or (memq 'vms ange-ftp-dumb-host-types)
-    (setq ange-ftp-dumb-host-types
-	  (cons 'vms ange-ftp-dumb-host-types)))
-
-;; It is important that this function barf for directories for which we know
-;; that we cannot possibly get a directory listing, such as "/" and "/DEV:/".
-;; This is because it saves an unnecessary FTP error, or possibly the listing
-;; might succeed, but give erroneous info. This last case is particularly
-;; likely for OS's (like MTS) for which we need to use a wildcard in order
-;; to list a directory.
-
-;; Convert name from UNIX-ish to VMS ready for a DIRectory listing.
-(defun ange-ftp-fix-dir-name-for-vms (dir-name)
-  ;; Should there be entries for .. -> [-] and . -> [] below. Don't
-  ;; think so, because expand-filename should have already short-circuited
-  ;; them.
-  (cond ((string-equal dir-name "/")
-	 (error "Cannot get listing for fictitious \"/\" directory."))
-	((string-match "^/[-A-Z0-9_$]+:/$" dir-name)
-	 (error "Cannot get listing for device."))
-	((ange-ftp-fix-name-for-vms dir-name))))
-  
-(or (assq 'vms ange-ftp-fix-dir-name-func-alist)
-    (setq ange-ftp-fix-dir-name-func-alist
-	  (cons '(vms . ange-ftp-fix-dir-name-for-vms)
-		ange-ftp-fix-dir-name-func-alist)))
-
-(defvar ange-ftp-vms-host-regexp nil)
-
-;; Return non-nil if HOST is running VMS.
-(defun ange-ftp-vms-host (host)
-  (and ange-ftp-vms-host-regexp
-       (save-match-data
-	 (string-match ange-ftp-vms-host-regexp host))))
-
-;; Because some VMS ftp servers convert filenames to lower case
-;; we allow a-z in the filename regexp. I'm not too happy about this.
-
-(defconst ange-ftp-vms-filename-regexp
-  (concat
-   "\\(\\([_A-Za-z0-9$]?\\|[_A-Za-z0-9$][-_A-Za-z0-9$]*\\)\\."
-   "[-_A-Za-z0-9$]*;+[0-9]*\\)")
-  "Regular expression to match for a valid VMS file name in Dired buffer.
-Stupid freaking bug! Position of _ and $ shouldn't matter but they do.
-Having [A-Z0-9$_] bombs on filename _$$CHANGE_LOG$.TXT$ and $CHANGE_LOG$.TX
-Other orders of $ and _ seem to all work just fine.")
-
-;; These parsing functions are as general as possible because the syntax
-;; of ftp listings from VMS hosts is a bit erratic. What saves us is that
-;; the VMS filename syntax is so rigid. If they bomb on a listing in the
-;; standard VMS Multinet format, then this is a bug. If they bomb on a listing
-;; from vms.weird.net, then too bad.
-
-;; Extract the next filename from a VMS dired-like listing.
-(defun ange-ftp-parse-vms-filename ()
-  (if (re-search-forward
-	 ange-ftp-vms-filename-regexp
-	 nil t)
-	(buffer-substring (match-beginning 0) (match-end 0))))
-
-;; Parse the current buffer which is assumed to be in MultiNet FTP dir
-;; format, and return a hashtable as the result.
-(defun ange-ftp-parse-vms-listing ()
-  (let ((tbl (ange-ftp-make-hashtable))
-	file)
-    (goto-char (point-min))
-    (save-match-data
-      (while (setq file (ange-ftp-parse-vms-filename))
-	(if (string-match "\\.\\(DIR\\|dir\\);[0-9]+" file)
-	    ;; deal with directories
-	    (ange-ftp-put-hash-entry
-	     (substring file 0 (match-beginning 0)) t tbl)
-	  (ange-ftp-put-hash-entry file nil tbl)
-	  (if (string-match ";[0-9]+$" file) ; deal with extension
-	      ;; sans extension
-	      (ange-ftp-put-hash-entry
-	       (substring file 0 (match-beginning 0)) nil tbl)))
-	(forward-line 1))
-      ;; Would like to look for a "Total" line, or a "Directory" line to
-      ;; make sure that the listing isn't complete garbage before putting
-      ;; in "." and "..", but we can't even count on all VAX's giving us
-      ;; either of these.
-	   (ange-ftp-put-hash-entry "." t tbl)
-	   (ange-ftp-put-hash-entry ".." t tbl))
-    tbl))
-
-(or (assq 'vms ange-ftp-parse-list-func-alist)
-    (setq ange-ftp-parse-list-func-alist
-	  (cons '(vms . ange-ftp-parse-vms-listing)
-		ange-ftp-parse-list-func-alist)))
-
-;; This version only deletes file entries which have
-;; explicit version numbers, because that is all VMS allows.
-
-;; Can the following two functions be speeded up using file
-;; completion functions?
-
-(defun ange-ftp-vms-delete-file-entry (name &optional dir-p)
-  (if dir-p
-      (ange-ftp-internal-delete-file-entry name t)
-    (save-match-data
-      (let ((file (ange-ftp-get-file-part name)))
-	(if (string-match ";[0-9]+$" file)
-	    ;; In VMS you can't delete a file without an explicit	
-	    ;; version number, or wild-card (e.g. FOO;*)
-	    ;; For now, we give up on wildcards.
-	    (let ((files (ange-ftp-get-hash-entry
-			  (file-name-directory name)
-			  ange-ftp-files-hashtable)))
-	      (if files
-		  (let* ((root (substring file 0
-					  (match-beginning 0)))
-			 (regexp (concat "^"
-					 (regexp-quote root)
-					 ";[0-9]+$"))
-			 versions)
-		    (ange-ftp-del-hash-entry file files)
-		    ;; Now we need to check if there are any
-		    ;; versions left. If not, then delete the
-		    ;; root entry.
-		    (mapatoms
-		     '(lambda (sym)
-			(and (string-match regexp (get sym 'key))
-			     (setq versions t)))
-		     files)
-		    (or versions
-			(ange-ftp-del-hash-entry root files))))))))))
-
-(or (assq 'vms ange-ftp-delete-file-entry-alist)
-    (setq ange-ftp-delete-file-entry-alist
-	  (cons '(vms . ange-ftp-vms-delete-file-entry)
-		ange-ftp-delete-file-entry-alist)))
-
-(defun ange-ftp-vms-add-file-entry (name &optional dir-p)
-  (if dir-p
-      (ange-ftp-internal-add-file-entry name t)
-    (let ((files (ange-ftp-get-hash-entry
-		  (file-name-directory name)
-		  ange-ftp-files-hashtable)))
-      (if files
-	  (let ((file (ange-ftp-get-file-part name)))
-	    (save-match-data
-	      (if (string-match ";[0-9]+$" file)
-		  (ange-ftp-put-hash-entry
-		   (substring file 0 (match-beginning 0))
-		   nil files)
-		;; Need to figure out what version of the file
-		;; is being added.
-		(let ((regexp (concat "^"
-				      (regexp-quote file)
-				      ";\\([0-9]+\\)$"))
-		      (version 0))
-		  (mapatoms
-		   '(lambda (sym)
-		      (let ((name (get sym 'key)))
-			(and (string-match regexp name)
-			     (setq version
-				   (max version
-					(string-to-int
-					 (substring name
-						    (match-beginning 1)
-						    (match-end 1))))))))
-		   files)
-		  (setq version (1+ version))
-		  (ange-ftp-put-hash-entry
-		   (concat file ";" (int-to-string version))
-		   nil files))))
-	    (ange-ftp-put-hash-entry file nil files))))))
-
-(or (assq 'vms ange-ftp-add-file-entry-alist)
-    (setq ange-ftp-add-file-entry-alist
-	  (cons '(vms . ange-ftp-vms-add-file-entry)
-		ange-ftp-add-file-entry-alist)))
-
-
-(defun ange-ftp-add-vms-host (host)
-  "Mark HOST as the name of a machine running VMS."
-  (interactive
-   (list (read-string "Host: "
-		      (let ((name (or (buffer-file-name) default-directory)))
-			(and name (car (ange-ftp-ftp-name name)))))))
-  (if (not (ange-ftp-vms-host host))
-      (setq ange-ftp-vms-host-regexp
-	    (concat "^" (regexp-quote host) "$"
-		    (and ange-ftp-vms-host-regexp "\\|")
-		    ange-ftp-vms-host-regexp)
-	    ange-ftp-host-cache nil)))
-
-
-(defun ange-ftp-vms-file-name-as-directory (name)
-  (save-match-data
-    (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name)
-	(setq name (substring name 0 (match-beginning 0))))
-    (ange-ftp-real-file-name-as-directory name)))
-
-(or (assq 'vms ange-ftp-file-name-as-directory-alist)
-    (setq ange-ftp-file-name-as-directory-alist
-	  (cons '(vms . ange-ftp-vms-file-name-as-directory)
-		ange-ftp-file-name-as-directory-alist)))
-
-;;; Tree dired support:
-
-;; For this code I have borrowed liberally from Sebastian Kremer's
-;; dired-vms.el
-
-
-;;;; These regexps must be anchored to beginning of line.
-;;;; Beware that the ftpd may put the device in front of the filename.
-
-;;(defconst ange-ftp-dired-vms-re-exe "^. [^ \t.]+\\.\\(EXE\\|exe\\)[; ]"
-;;  "Regular expression to use to search for VMS executable files.")
-
-;;(defconst ange-ftp-dired-vms-re-dir "^. [^ \t.]+\\.\\(DIR\\|dir\\)[; ]"
-;;  "Regular expression to use to search for VMS directories.")
-
-;;(or (assq 'vms ange-ftp-dired-re-exe-alist)
-;;    (setq ange-ftp-dired-re-exe-alist
-;;	  (cons (cons 'vms  ange-ftp-dired-vms-re-exe)
-;;		ange-ftp-dired-re-exe-alist)))
-
-;;(or (assq 'vms ange-ftp-dired-re-dir-alist)
-;;    (setq ange-ftp-dired-re-dir-alist
-;;	  (cons (cons 'vms  ange-ftp-dired-vms-re-dir)
-;;		ange-ftp-dired-re-dir-alist)))
-
-;;(defun ange-ftp-dired-vms-insert-headerline (dir)
-;;  ;; VMS inserts a headerline. I would prefer the headerline
-;;  ;; to be in ange-ftp format. This version tries to
-;;  ;; be careful, because we can't count on a headerline
-;;  ;; over ftp, and we wouldn't want to delete anything
-;;  ;; important.
-;;  (save-excursion
-;;    (if (looking-at "^  wildcard ")
-;;	(forward-line 1))
-;;    (if (looking-at "^[ \n\t]*[^\n]+\\][ \t]*\n")
-;;	(delete-region (point) (match-end 0))))
-;;  (ange-ftp-real-dired-insert-headerline dir))
-
-;;(or (assq 'vms ange-ftp-dired-insert-headerline-alist)
-;;    (setq ange-ftp-dired-insert-headerline-alist
-;;	  (cons '(vms . ange-ftp-dired-vms-insert-headerline)
-;;		ange-ftp-dired-insert-headerline-alist)))
-
-;;(defun ange-ftp-dired-vms-move-to-filename (&optional raise-error eol)
-;;  "In dired, move to first char of filename on this line.
-;;Returns position (point) or nil if no filename on this line."
-;;  ;; This is the VMS version.
-;;  (let (case-fold-search)
-;;    (or eol (setq eol (progn (end-of-line) (point))))
-;;    (beginning-of-line)
-;;    (if (re-search-forward ange-ftp-vms-filename-regexp eol t)
-;;	(goto-char (match-beginning 1))
-;;      (if raise-error
-;;	  (error "No file on this line")
-;;	nil))))
-
-;;(or (assq 'vms ange-ftp-dired-move-to-filename-alist)
-;;    (setq ange-ftp-dired-move-to-filename-alist
-;;	  (cons '(vms . ange-ftp-dired-vms-move-to-filename)
-;;		ange-ftp-dired-move-to-filename-alist)))
-
-;;(defun ange-ftp-dired-vms-move-to-end-of-filename (&optional no-error eol)
-;;  ;; Assumes point is at beginning of filename.
-;;  ;; So, it should be called only after (dired-move-to-filename t).
-;;  ;; case-fold-search must be nil, at least for VMS.
-;;  ;; On failure, signals an error or returns nil.
-;;  ;; This is the VMS version.
-;;  (let (opoint hidden case-fold-search)
-;;    (setq opoint (point))
-;;    (or eol (setq eol (save-excursion (end-of-line) (point))))
-;;    (setq hidden (and selective-display
-;;		      (save-excursion (search-forward "\r" eol t))))
-;;    (if hidden
-;;	nil
-;;      (re-search-forward ange-ftp-vms-filename-regexp eol t))
-;;    (or no-error
-;;	(not (eq opoint (point)))
-;;	(error
-;;	 (if hidden
-;;	     (substitute-command-keys
-;;	      "File line is hidden, type \\[dired-hide-subdir] to unhide")
-;;	   "No file on this line")))
-;;    (if (eq opoint (point))
-;;	nil
-;;      (point))))
-
-;;(or (assq 'vms ange-ftp-dired-move-to-end-of-filename-alist)
-;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
-;;	  (cons '(vms . ange-ftp-dired-vms-move-to-end-of-filename)
-;;		ange-ftp-dired-move-to-end-of-filename-alist)))
-
-;;(defun ange-ftp-dired-vms-between-files ()
-;;  (save-excursion
-;;    (beginning-of-line)
-;;    (or (equal (following-char) 10) ; newline
-;;     (equal (following-char) 9)     ; tab
-;;     (progn (forward-char 2)
-;;	    (or (looking-at "Total of")
-;;		(equal (following-char) 32))))))
-
-;;(or (assq 'vms ange-ftp-dired-between-files-alist)
-;;    (setq ange-ftp-dired-between-files-alist
-;;	  (cons '(vms . ange-ftp-dired-vms-between-files)
-;;		ange-ftp-dired-between-files-alist)))
-
-;; Beware! In VMS filenames must be of the form "FILE.TYPE".
-;; Therefore, we cannot just append a ".Z" to filenames for
-;; compressed files. Instead, we turn "FILE.TYPE" into
-;; "FILE.TYPE-Z". Hope that this is a reasonable thing to do.
-
-(defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
-  (cond
-   ((string-match "-Z;[0-9]+$" name)
-    (list nil (substring name 0 (match-beginning 0))))
-   ((string-match ";[0-9]+$" name)
-    (list nil (substring name 0 (match-beginning 0))))
-   ((string-match "-Z$" name)
-    (list nil (substring name 0 -2)))
-   (t
-    (list t
-	  (if (string-match ";[0-9]+$" name)
-	      (concat (substring name 0 (match-beginning 0))
-		      "-Z")
-	    (concat name "-Z"))))))
-
-(or (assq 'vms ange-ftp-make-compressed-filename-alist)
-    (setq ange-ftp-make-compressed-filename-alist
-	  (cons '(vms . ange-ftp-vms-make-compressed-filename)
-		ange-ftp-make-compressed-filename-alist)))
-
-;;;; When the filename is too long, VMS will use two lines to list a file
-;;;; (damn them!) This will confuse dired. To solve this, need to convince
-;;;; Sebastian to use a function dired-go-to-end-of-file-line, instead of
-;;;; (forward-line 1). This would require a number of changes to dired.el.
-;;;; If dired gets confused, revert-buffer will fix it.
-
-;;(defun ange-ftp-dired-vms-ls-trim ()
-;;  (goto-char (point-min))
-;;  (let ((case-fold-search nil))
-;;    (re-search-forward  ange-ftp-vms-filename-regexp))
-;;  (beginning-of-line)
-;;  (delete-region (point-min) (point))
-;;  (forward-line 1)
-;;  (delete-region (point) (point-max)))
-
-
-;;(or (assq 'vms ange-ftp-dired-ls-trim-alist)
-;;    (setq ange-ftp-dired-ls-trim-alist
-;;	  (cons '(vms . ange-ftp-dired-vms-ls-trim)
-;;		ange-ftp-dired-ls-trim-alist)))	
-
-(defun ange-ftp-vms-sans-version (name &rest args)
-  (save-match-data
-    (if (string-match ";[0-9]+$" name)
-	(substring name 0 (match-beginning 0))
-      name)))
-
-(or (assq 'vms ange-ftp-sans-version-alist)
-    (setq ange-ftp-sans-version-alist
-	  (cons '(vms . ange-ftp-vms-sans-version)
-		ange-ftp-sans-version-alist)))
-
-;;(defvar ange-ftp-file-version-alist)
-
-;;;;; The vms version of clean-directory has 2 more optional args
-;;;;; than the usual dired version. This is so that it can be used by
-;;;;; ange-ftp-dired-vms-flag-backup-files.
-
-;;(defun ange-ftp-dired-vms-clean-directory (keep &optional marker msg)
-;;  "Flag numerical backups for deletion.
-;;Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
-;;Positive prefix arg KEEP overrides `dired-kept-versions';
-;;Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
-
-;;To clear the flags on these files, you can use \\[dired-flag-backup-files]
-;;with a prefix argument."
-;;;  (interactive "P") ; Never actually called interactively.
-;;  (setq keep (max 1 (if keep (prefix-numeric-value keep) dired-kept-versions)))
-;;  (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
-;;	;; late-retention must NEVER be allowed to be less than 1 in VMS!
-;;	;; This could wipe ALL copies of the file.
-;;	(late-retention (max 1 (if (<= keep 0) dired-kept-versions keep)))
-;;	(action (or msg "Cleaning"))
-;;	(ange-ftp-trample-marker (or marker dired-del-marker))
-;;	(ange-ftp-file-version-alist ()))
-;;    (message (concat action
-;;		     " numerical backups (keeping %d late, %d old)...")
-;;	     late-retention early-retention)
-;;    ;; Look at each file.
-;;    ;; If the file has numeric backup versions,
-;;    ;; put on ange-ftp-file-version-alist an element of the form
-;;    ;; (FILENAME . VERSION-NUMBER-LIST)
-;;    (dired-map-dired-file-lines (function
-;;				 ange-ftp-dired-vms-collect-file-versions))
-;;    ;; Sort each VERSION-NUMBER-LIST,
-;;    ;; and remove the versions not to be deleted.
-;;    (let ((fval ange-ftp-file-version-alist))
-;;      (while fval
-;;	(let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
-;;	       (v-count (length sorted-v-list)))
-;;	  (if (> v-count (+ early-retention late-retention))
-;;	      (rplacd (nthcdr early-retention sorted-v-list)
-;;		      (nthcdr (- v-count late-retention)
-;;			      sorted-v-list)))
-;;	  (rplacd (car fval)
-;;		  (cdr sorted-v-list)))
-;;	(setq fval (cdr fval))))
-;;    ;; Look at each file.  If it is a numeric backup file,
-;;    ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
-;;    (dired-map-dired-file-lines
-;;     (function
-;;      ange-ftp-dired-vms-trample-file-versions mark))
-;;    (message (concat action " numerical backups...done"))))
-
-;;(or (assq 'vms ange-ftp-dired-clean-directory-alist)
-;;    (setq ange-ftp-dired-clean-directory-alist
-;;	  (cons '(vms . ange-ftp-dired-vms-clean-directory)
-;;		ange-ftp-dired-clean-directory-alist)))
-
-;;(defun ange-ftp-dired-vms-collect-file-versions (fn)
-;;  ;;  "If it looks like file FN has versions, return a list of the versions.
-;;  ;;That is a list of strings which are file names.
-;;  ;;The caller may want to flag some of these files for deletion."
-;;(let ((name (nth 2 (ange-ftp-ftp-name fn))))
-;;  (if (string-match ";[0-9]+$" name)
-;;      (let* ((name (substring name 0 (match-beginning 0)))
-;;	     (fn (ange-ftp-replace-name-component fn name)))
-;;	(if (not (assq fn ange-ftp-file-version-alist))
-;;	    (let* ((base-versions
-;;		    (concat (file-name-nondirectory name) ";"))
-;;		   (bv-length (length base-versions))
-;;		   (possibilities (file-name-all-completions
-;;				   base-versions
-;;				   (file-name-directory fn)))
-;;		   (versions (mapcar
-;;			      '(lambda (arg)
-;;				 (if (and (string-match
-;;					   "[0-9]+$" arg bv-length)
-;;					  (= (match-beginning 0) bv-length))
-;;				     (string-to-int (substring arg bv-length))
-;;				   0))
-;;			      possibilities)))
-;;	      (if versions
-;;		  (setq
-;;		   ange-ftp-file-version-alist
-;;		   (cons (cons fn versions)
-;;			 ange-ftp-file-version-alist)))))))))
-
-;;(defun ange-ftp-dired-vms-trample-file-versions (fn)
-;;  (let* ((start-vn (string-match ";[0-9]+$" fn))
-;;	 base-version-list)
-;;    (and start-vn
-;;	 (setq base-version-list	; there was a base version to which
-;;	       (assoc (substring fn 0 start-vn)	; this looks like a
-;;		      ange-ftp-file-version-alist))	; subversion
-;;	 (not (memq (string-to-int (substring fn (1+ start-vn)))
-;;		    base-version-list))	; this one doesn't make the cut
-;;	 (progn (beginning-of-line)
-;;		(delete-char 1)
-;;		(insert ange-ftp-trample-marker)))))
-
-;;(defun ange-ftp-dired-vms-flag-backup-files (&optional unflag-p)
-;;  (let ((dired-kept-versions 1)
-;;	(kept-old-versions 0)
-;;	marker msg)
-;;    (if unflag-p
-;;	(setq marker ?\040 msg "Unflagging")
-;;      (setq marker dired-del-marker msg "Cleaning"))
-;;    (ange-ftp-dired-vms-clean-directory nil marker msg)))
-
-;;(or (assq 'vms ange-ftp-dired-flag-backup-files-alist)
-;;    (setq ange-ftp-dired-flag-backup-files-alist
-;;	  (cons '(vms . ange-ftp-dired-vms-flag-backup-files)
-;;		ange-ftp-dired-flag-backup-files-alist)))
-
-;;(defun ange-ftp-dired-vms-backup-diff (&optional switches)
-;;  (let ((file (dired-get-filename 'no-dir))
-;;	bak)
-;;    (if (and (string-match ";[0-9]+$" file)
-;;	     ;; Find most recent previous version.
-;;	     (let ((root (substring file 0 (match-beginning 0)))
-;;		   (ver
-;;		    (string-to-int (substring file (1+ (match-beginning 0)))))
-;;		   found)
-;;	       (setq ver (1- ver))
-;;	       (while (and (> ver 0) (not found))
-;;		 (setq bak (concat root ";" (int-to-string ver)))
-;;		 (and (file-exists-p bak) (setq found t))
-;;		 (setq ver (1- ver)))
-;;	       found))
-;;	(if switches
-;;	    (diff (expand-file-name bak) (expand-file-name file) switches)
-;;	  (diff (expand-file-name bak) (expand-file-name file)))
-;;      (error "No previous version found for %s" file))))
-
-;;(or (assq 'vms ange-ftp-dired-backup-diff-alist)
-;;    (setq ange-ftp-dired-backup-diff-alist
-;;	  (cons '(vms . ange-ftp-dired-vms-backup-diff)
-;;		ange-ftp-dired-backup-diff-alist)))
-
-
-;;;; ------------------------------------------------------------
-;;;; MTS support
-;;;; ------------------------------------------------------------
-
-
-;; Convert NAME from UNIX-ish to MTS. If REVERSE given then convert from
-;; MTS to UNIX-ish.
-(defun ange-ftp-fix-name-for-mts (name &optional reverse)
-  (save-match-data
-    (if reverse
-	(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name)
-	    (let (acct file)
-	      (if (match-beginning 1)
-		  (setq acct (substring name 0 (match-end 1))))
-	      (if (match-beginning 2)
-		  (setq file (substring name
-					(match-beginning 2) (match-end 2))))
-	      (concat (and acct (concat "/" acct "/"))
-		      file))
-	  (error "name %s didn't match" name))
-      (if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name)
-	  (concat (substring name 1 (match-end 1))
-		  (substring name (match-beginning 2) (match-end 2)))
-	;; Let's hope that mts will recognize it anyway.
-	name))))
-
-(or (assq 'mts ange-ftp-fix-name-func-alist)
-    (setq ange-ftp-fix-name-func-alist
-	  (cons '(mts . ange-ftp-fix-name-for-mts)
-		ange-ftp-fix-name-func-alist)))
-
-;; Convert name from UNIX-ish to MTS ready for a DIRectory listing.
-;; Remember that there are no directories in MTS.
-(defun ange-ftp-fix-dir-name-for-mts (dir-name)
-  (if (string-equal dir-name "/")
-      (error "Cannot get listing for fictitious \"/\" directory.")
-    (let ((dir-name (ange-ftp-fix-name-for-mts dir-name)))
-      (cond
-       ((string-equal dir-name "")
-	"?")
-       ((string-match ":$" dir-name)
-	(concat dir-name "?"))
-       (dir-name))))) ; It's just a single file.
-
-(or (assq 'mts ange-ftp-fix-dir-name-func-alist)
-    (setq ange-ftp-fix-dir-name-func-alist
-	  (cons '(mts . ange-ftp-fix-dir-name-for-mts)
-		ange-ftp-fix-dir-name-func-alist)))
-
-(or (memq 'mts ange-ftp-dumb-host-types)
-    (setq ange-ftp-dumb-host-types
-	  (cons 'mts ange-ftp-dumb-host-types)))
-
-(defvar ange-ftp-mts-host-regexp nil)
-
-;; Return non-nil if HOST is running MTS.
-(defun ange-ftp-mts-host (host)
-  (and ange-ftp-mts-host-regexp
-       (save-match-data
-	 (string-match ange-ftp-mts-host-regexp host))))
-
-;; Parse the current buffer which is assumed to be in mts ftp dir format.
-(defun ange-ftp-parse-mts-listing ()
-  (let ((tbl (ange-ftp-make-hashtable)))
-    (goto-char (point-min))
-    (save-match-data
-      (while (re-search-forward ange-ftp-date-regexp nil t)
-	(end-of-line)
-	(skip-chars-backward " ")
-	(let ((end (point)))
-	  (skip-chars-backward "-A-Z0-9_.!")
-	  (ange-ftp-put-hash-entry (buffer-substring (point) end) nil tbl))
-	(forward-line 1)))
-      ;; Don't need to bother with ..
-    (ange-ftp-put-hash-entry "." t tbl)
-    tbl))
-
-(or (assq 'mts ange-ftp-parse-list-func-alist)
-    (setq ange-ftp-parse-list-func-alist
-	  (cons '(mts . ange-ftp-parse-mts-listing)
-		ange-ftp-parse-list-func-alist)))
-
-(defun ange-ftp-add-mts-host (host)
-  "Mark HOST as the name of a machine running MTS."
-  (interactive
-   (list (read-string "Host: "
-		      (let ((name (or (buffer-file-name) default-directory)))
-			(and name (car (ange-ftp-ftp-name name)))))))
-  (if (not (ange-ftp-mts-host host))
-      (setq ange-ftp-mts-host-regexp
-	    (concat "^" (regexp-quote host) "$"
-		    (and ange-ftp-mts-host-regexp "\\|")
-		    ange-ftp-mts-host-regexp)
-	    ange-ftp-host-cache nil)))
-
-;;; Tree dired support:
-
-;;;; There aren't too many systems left that use MTS. This dired support will
-;;;; work for the implementation of ftp on mtsg.ubc.ca. I hope other mts systems
-;;;; implement ftp in the same way. If not, it might be necessary to make the
-;;;; following more flexible.
-
-;;(defun ange-ftp-dired-mts-move-to-filename (&optional raise-error eol)
-;;  "In dired, move to first char of filename on this line.
-;;Returns position (point) or nil if no filename on this line."
-;;  ;; This is the MTS version.
-;;  (or eol (setq eol (progn (end-of-line) (point))))
-;;  (beginning-of-line)
-;;  (if (re-search-forward
-;;       ange-ftp-date-regexp eol t)
-;;      (progn
-;;	(skip-chars-forward " ")          ; Eat blanks after date
-;;	(skip-chars-forward "0-9:" eol)   ; Eat time or year
-;;	(skip-chars-forward " " eol)      ; one space before filename
-;;	;; When listing an account other than the users own account it appends
-;;	;; ACCT: to the beginning of the filename. Skip over this.
-;;	(and (looking-at "[A-Z0-9_.]+:")
-;;	     (goto-char (match-end 0)))
-;;	(point))
-;;    (if raise-error
-;;	(error "No file on this line")
-;;      nil)))
-
-;;(or (assq 'mts ange-ftp-dired-move-to-filename-alist)
-;;    (setq ange-ftp-dired-move-to-filename-alist
-;;	  (cons '(mts . ange-ftp-dired-mts-move-to-filename)
-;;		ange-ftp-dired-move-to-filename-alist)))
-
-;;(defun ange-ftp-dired-mts-move-to-end-of-filename (&optional no-error eol)
-;;  ;; Assumes point is at beginning of filename.
-;;  ;; So, it should be called only after (dired-move-to-filename t).
-;;  ;; On failure, signals an error or returns nil.
-;;  ;; This is the MTS version.
-;;  (let (opoint hidden case-fold-search)
-;;    (setq opoint (point)
-;;	  eol (save-excursion (end-of-line) (point))
-;;	  hidden (and selective-display
-;;		      (save-excursion (search-forward "\r" eol t))))
-;;    (if hidden
-;;	nil
-;;      (skip-chars-forward "-A-Z0-9._!" eol))
-;;    (or no-error
-;;	(not (eq opoint (point)))
-;;	(error
-;;	 (if hidden
-;;	     (substitute-command-keys
-;;	      "File line is hidden, type \\[dired-hide-subdir] to unhide")
-;;	   "No file on this line")))
-;;    (if (eq opoint (point))
-;;	nil
-;;      (point))))
-
-;;(or (assq 'mts ange-ftp-dired-move-to-end-of-filename-alist)
-;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
-;;	  (cons '(mts . ange-ftp-dired-mts-move-to-end-of-filename)
-;;		ange-ftp-dired-move-to-end-of-filename-alist)))
-
-;;;; ------------------------------------------------------------
-;;;; CMS support
-;;;; ------------------------------------------------------------
-
-;; Since CMS doesn't have any full file name syntax, we have to fudge
-;; things with cd's. We actually send too many cd's, but it's dangerous
-;; to try to remember the current minidisk, because if the connection
-;; is closed and needs to be reopened, we will find ourselves back in
-;; the default minidisk. This is fairly likely since CMS ftp servers
-;; usually close the connection after 5 minutes of inactivity.
-
-;; Have I got the filename character set right?
-
-(defun ange-ftp-fix-name-for-cms (name &optional reverse)
-  (save-match-data
-    (if reverse
-	;; Since we only convert output from a pwd in this direction,
-	;; we'll assume that it's a minidisk, and make it into a
-	;; directory file name. Note that the expand-dir-hashtable
-	;; stores directories without the trailing /. Is this
-	;; consistent?
-	(concat "/" name)
-      (if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$"
-			name)
-	  (let ((minidisk (substring name 1 (match-end 1))))
-	    (if (match-beginning 2)
-		(let ((file (substring name (match-beginning 2)
-				       (match-end 2)))
-		      (cmd (concat "cd " minidisk))
-
-		      ;; Note that host and user are bound in the call
-		      ;; to ange-ftp-send-cmd
-		      (proc (ange-ftp-get-process ange-ftp-this-host
-						  ange-ftp-this-user)))
-
-		  ;; Must use ange-ftp-raw-send-cmd here to avoid
-		  ;; an infinite loop.
-		  (if (car (ange-ftp-raw-send-cmd proc cmd ange-ftp-this-msg))
-		      file
-		    ;; failed... try ONCE more.
-		    (setq proc (ange-ftp-get-process ange-ftp-this-host
-						     ange-ftp-this-user))
-		    (let ((result (ange-ftp-raw-send-cmd proc cmd
-							 ange-ftp-this-msg)))
-		      (if (car result)
-			  file
-			;; failed.  give up.
-			(ange-ftp-error ange-ftp-this-host ange-ftp-this-user
-					(format "cd to minidisk %s failed: %s"
-						minidisk (cdr result)))))))
-	      ;; return the minidisk
-	      minidisk))
-	(error "Invalid CMS filename")))))
-
-(or (assq 'cms ange-ftp-fix-name-func-alist)
-    (setq ange-ftp-fix-name-func-alist
-	  (cons '(cms . ange-ftp-fix-name-for-cms)
-		ange-ftp-fix-name-func-alist)))
-
-(or (memq 'cms ange-ftp-dumb-host-types)
-    (setq ange-ftp-dumb-host-types
-	  (cons 'cms ange-ftp-dumb-host-types)))
-
-;; Convert name from UNIX-ish to CMS ready for a DIRectory listing.
-(defun ange-ftp-fix-dir-name-for-cms (dir-name)
-  (cond
-   ((string-equal "/" dir-name)
-    (error "Cannot get listing for fictitious \"/\" directory."))
-   ((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name)
-    (let* ((minidisk (substring dir-name (match-beginning 1) (match-end 1)))
-	   ;; host and user are bound in the call to ange-ftp-send-cmd
-	   (proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user))
-	   (cmd (concat "cd " minidisk))
-	   (file (if (match-beginning 2)
-		     ;; it's a single file
-		     (substring dir-name (match-beginning 2)
-				(match-end 2))
-		   ;; use the wild-card
-		   "*")))
-      (if (car (ange-ftp-raw-send-cmd proc cmd))
-	  file
-	;; try again...
-	(setq proc (ange-ftp-get-process ange-ftp-this-host
-					 ange-ftp-this-user))
-	(let ((result (ange-ftp-raw-send-cmd proc cmd)))
-	  (if (car result)
-	      file
-	    ;; give up
-	    (ange-ftp-error ange-ftp-this-host ange-ftp-this-user
-			    (format "cd to minidisk %s failed: %s"
-				    minidisk (cdr result))))))))
-   (t (error "Invalid CMS file name"))))
-
-(or (assq 'cms ange-ftp-fix-dir-name-func-alist)
-    (setq ange-ftp-fix-dir-name-func-alist
-	  (cons '(cms . ange-ftp-fix-dir-name-for-cms)
-		ange-ftp-fix-dir-name-func-alist)))
-
-(defvar ange-ftp-cms-host-regexp nil
-  "Regular expression to match hosts running the CMS operating system.")
-
-;; Return non-nil if HOST is running CMS.
-(defun ange-ftp-cms-host (host)
-  (and ange-ftp-cms-host-regexp
-       (save-match-data
-	 (string-match ange-ftp-cms-host-regexp host))))
-
-(defun ange-ftp-add-cms-host (host)
-  "Mark HOST as the name of a CMS host."
-  (interactive
-   (list (read-string "Host: "
-		      (let ((name (or (buffer-file-name) default-directory)))
-			(and name (car (ange-ftp-ftp-name name)))))))
-  (if (not (ange-ftp-cms-host host))
-      (setq ange-ftp-cms-host-regexp
-	    (concat "^" (regexp-quote host) "$"
-		    (and ange-ftp-cms-host-regexp "\\|")
-		    ange-ftp-cms-host-regexp)
-	    ange-ftp-host-cache nil)))
-
-(defun ange-ftp-parse-cms-listing ()
-  ;; Parse the current buffer which is assumed to be a CMS directory listing.
-  ;; If we succeed in getting a listing, then we will assume that the minidisk
-  ;; exists. file is bound by the call to ange-ftp-ls. This doesn't work
-  ;; because ange-ftp doesn't know that the root hashtable has only part of
-  ;; the info. It will assume that if a minidisk isn't in it, then it doesn't
-  ;; exist. It would be nice if completion worked for minidisks, as we
-  ;; discover them.
-;  (let* ((dir-file (directory-file-name file))
-;	 (root (file-name-directory dir-file))
-;	 (minidisk (ange-ftp-get-file-part dir-file))
-;	 (root-tbl (ange-ftp-get-hash-entry root ange-ftp-files-hashtable)))
-;    (if root-tbl
-;	(ange-ftp-put-hash-entry minidisk t root-tbl)
-;      (setq root-tbl (ange-ftp-make-hashtable))
-;      (ange-ftp-put-hash-entry minidisk t root-tbl)
-;      (ange-ftp-put-hash-entry "." t root-tbl)
-;      (ange-ftp-set-files root root-tbl)))
-  ;; Now do the usual parsing
-  (let ((tbl (ange-ftp-make-hashtable)))
-    (goto-char (point-min))
-    (save-match-data
-      (while
-	  (re-search-forward
-	   "^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t)
-	(ange-ftp-put-hash-entry
-	 (concat (buffer-substring (match-beginning 1)
-				   (match-end 1))
-		 "."
-		 (buffer-substring (match-beginning 2)
-				   (match-end 2)))
-	 nil tbl)
-	(forward-line 1))
-      (ange-ftp-put-hash-entry "." t tbl))
-    tbl))
-
-(or (assq 'cms ange-ftp-parse-list-func-alist)
-    (setq ange-ftp-parse-list-func-alist
-	  (cons '(cms . ange-ftp-parse-cms-listing)
-		ange-ftp-parse-list-func-alist)))
-    
-;;;;; Tree dired support:
-
-;;(defconst ange-ftp-dired-cms-re-exe
-;;  "^. [-A-Z0-9$_]+ +EXEC "
-;;  "Regular expression to use to search for CMS executables.")
-
-;;(or (assq 'cms ange-ftp-dired-re-exe-alist)
-;;    (setq ange-ftp-dired-re-exe-alist
-;;	  (cons (cons 'cms  ange-ftp-dired-cms-re-exe)
-;;		ange-ftp-dired-re-exe-alist)))
-
-
-;;(defun ange-ftp-dired-cms-insert-headerline (dir)
-;;  ;; CMS has no total line, so we insert a blank line for
-;;  ;; aesthetics.
-;;  (insert "\n")
-;;  (forward-char -1)
-;;  (ange-ftp-real-dired-insert-headerline dir))
-
-;;(or (assq 'cms ange-ftp-dired-insert-headerline-alist)
-;;    (setq ange-ftp-dired-insert-headerline-alist
-;;	  (cons '(cms . ange-ftp-dired-cms-insert-headerline)
-;;		ange-ftp-dired-insert-headerline-alist)))
-
-;;(defun ange-ftp-dired-cms-move-to-filename (&optional raise-error eol)
-;;  "In dired, move to the first char of filename on this line."
-;;  ;; This is the CMS version.
-;;  (or eol (setq eol (progn (end-of-line) (point))))
-;;  (let (case-fold-search)
-;;    (beginning-of-line)
-;;    (if (re-search-forward " [-A-Z0-9$_]+ +[-A-Z0-9$_]+ +[VF] +[0-9]+ " eol t)
-;;	(goto-char (1+ (match-beginning 0)))
-;;      (if raise-error
-;;	  (error "No file on this line")
-;;	nil))))
-
-;;(or (assq 'cms ange-ftp-dired-move-to-filename-alist)
-;;    (setq ange-ftp-dired-move-to-filename-alist
-;;	  (cons '(cms . ange-ftp-dired-cms-move-to-filename)
-;;		ange-ftp-dired-move-to-filename-alist)))
-
-;;(defun ange-ftp-dired-cms-move-to-end-of-filename (&optional no-error eol)
-;;  ;; Assumes point is at beginning of filename.
-;;  ;; So, it should be called only after (dired-move-to-filename t).
-;;  ;; case-fold-search must be nil, at least for VMS.
-;;  ;; On failure, signals an error or returns nil.
-;;  ;; This is the CMS version.
-;;  (let ((opoint (point))
-;;	case-fold-search hidden)
-;;    (or eol (setq eol (save-excursion (end-of-line) (point))))
-;;    (setq hidden (and selective-display
-;;		      (save-excursion
-;;			(search-forward "\r" eol t))))
-;;    (if hidden
-;;	(if no-error
-;;	    nil
-;;	  (error
-;;	   (substitute-command-keys
-;;	    "File line is hidden, type \\[dired-hide-subdir] to unhide")))
-;;      (skip-chars-forward "-A-Z0-9$_" eol)
-;;      (skip-chars-forward " " eol)
-;;      (skip-chars-forward "-A-Z0-9$_" eol)
-;;      (if (eq opoint (point))
-;;	  (if no-error
-;;	      nil
-;;	    (error "No file on this line"))
-;;	(point)))))
-
-;;(or (assq 'cms ange-ftp-dired-move-to-end-of-filename-alist)
-;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
-;;	  (cons '(cms . ange-ftp-dired-cms-move-to-end-of-filename)
-;;		ange-ftp-dired-move-to-end-of-filename-alist)))
-
-(defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
-  (if (string-match "-Z$" name)
-      (list nil (substring name 0 -2))
-    (list t (concat name "-Z"))))
-
-(or (assq 'cms ange-ftp-make-compressed-filename-alist)
-    (setq ange-ftp-make-compressed-filename-alist
-	  (cons '(cms . ange-ftp-cms-make-compressed-filename)
-		ange-ftp-make-compressed-filename-alist)))
-
-;;(defun ange-ftp-dired-cms-get-filename (&optional localp no-error-if-not-filep)
-;;  (let ((name (ange-ftp-real-dired-get-filename localp no-error-if-not-filep)))
-;;    (and name
-;;	 (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\)$" name)
-;;	     (concat (substring name 0 (match-end 1))
-;;		     "."
-;;		     (substring name (match-beginning 2) (match-end 2)))
-;;	   name))))
-
-;;(or (assq 'cms ange-ftp-dired-get-filename-alist)
-;;    (setq ange-ftp-dired-get-filename-alist
-;;	  (cons '(cms . ange-ftp-dired-cms-get-filename)
-;;		ange-ftp-dired-get-filename-alist)))
-
-;;;; ------------------------------------------------------------
-;;;; Finally provide package.
-;;;; ------------------------------------------------------------
-
-(provide 'ange-ftp)
-
-;;; ange-ftp.el ends here
diff --git a/lisp/apropos.el b/lisp/apropos.el
deleted file mode 100644
index adbc13d0b7d..00000000000
--- a/lisp/apropos.el
+++ /dev/null
@@ -1,603 +0,0 @@
-;;; apropos.el --- apropos commands for users and programmers.
-
-;; Copyright (C) 1989, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Joe Wells <jbw@bigbird.bu.edu>
-;; Rewritten: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
-;; Keywords: help
-
-;; 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:
-
-;; The ideas for this package were derived from the C code in
-;; src/keymap.c and elsewhere.  The functions in this file should
-;; always be byte-compiled for speed.  Someone should rewrite this in
-;; C (as part of src/keymap.c) for speed.
-
-;; The idea for super-apropos is based on the original implementation
-;; by Lynn Slater <lrs@esl.com>.
-
-;; History:
-;; Fixed bug, current-local-map can return nil.
-;; Change, doesn't calculate key-bindings unless needed.
-;; Added super-apropos capability, changed print functions.
-;;; Made fast-apropos and super-apropos share code.
-;;; Sped up fast-apropos again.
-;; Added apropos-do-all option.
-;;; Added fast-command-apropos.
-;; Changed doc strings to comments for helping functions.
-;;; Made doc file buffer read-only, buried it.
-;; Only call substitute-command-keys if do-all set.
-
-;; Optionally use configurable faces to make the output more legible.
-;; Differentiate between command, function and macro.
-;; Apropos-command (ex command-apropos) does cmd and optionally user var.
-;; Apropos shows all 3 aspects of symbols (fn, var and plist)
-;; Apropos-documentation (ex super-apropos) now finds all it should.
-;; New apropos-value snoops through all values and optionally plists.
-;; Reading DOC file doesn't load nroff.
-;; Added hypertext following of documentation, mouse-2 on variable gives value
-;;   from buffer in active window.
-
-;;; Code:
-
-;; I see a degradation of maybe 10-20% only.
-(defvar apropos-do-all nil
-  "*Whether the apropos commands should do more.
-Slows them down more or less.  Set this non-nil if you have a fast machine.")
-
-
-(defvar apropos-symbol-face (if window-system 'bold)
-  "*Face for symbol name in apropos output or `nil'.  
-This looks good, but slows down the commands several times.")
-
-(defvar apropos-keybinding-face (if window-system 'underline)
-  "*Face for keybinding display in apropos output or `nil'.  
-This looks good, but slows down the commands several times.")
-
-(defvar apropos-label-face (if window-system 'italic)
-  "*Face for label (Command, Variable ...) in apropos output or `nil'.
-If this is `nil' no mouse highlighting occurs.
-This looks good, but slows down the commands several times.
-When this is a face name, as it is initially, it gets transformed to a
-text-property list for efficiency.")
-
-(defvar apropos-property-face (if window-system 'bold-italic)
-  "*Face for property name in apropos output or `nil'.  
-This looks good, but slows down the commands several times.")
-
-(defvar apropos-match-face (if window-system 'secondary-selection)
-  "*Face for matching part in apropos-documentation/value output or `nil'.  
-This looks good, but slows down the commands several times.")
-
-
-(defvar apropos-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-m" 'apropos-follow)
-    (define-key map " "      'scroll-up)
-    (define-key map "\177"   'scroll-down)
-    (define-key map [mouse-2] 'apropos-mouse-follow)
-    (define-key map [down-mouse-2] nil)
-    map)
-  "Keymap used in Apropos mode.")
-
-
-(defvar apropos-regexp nil
-  "Regexp used in current apropos run.")
-
-(defvar apropos-files-scanned ()
-  "List of elc files already scanned in current run of `apropos-documentation'.")
-
-(defvar apropos-accumulator ()
-  "Alist of symbols already found in current apropos run.")
-
-(defvar apropos-item ()
-  "Current item in or for apropos-accumulator.")
-
-(defun apropos-mode ()
-  "Major mode for following hyperlinks in output of apropos commands.
-
-\\{apropos-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map apropos-mode-map)
-  (setq major-mode 'apropos-mode
-	mode-name "Apropos"))
-
-
-;; For auld lang syne:
-;;;###autoload
-(fset 'command-apropos 'apropos-command)
-;;;###autoload
-(defun apropos-command (apropos-regexp &optional do-all)
-  "Shows commands (interactively callable functions) that match REGEXP.
-With optional prefix ARG or if `apropos-do-all' is non-nil, also show
-variables."
-  (interactive (list (read-string (concat "Apropos command "
-					  (if (or current-prefix-arg
-						  apropos-do-all)
-					      "or variable ")
-					  "(regexp): "))
-		     current-prefix-arg))
-  (let ((message
-	 (let ((standard-output (get-buffer-create "*Apropos*")))
-	   (print-help-return-message 'identity))))
-    (or do-all (setq do-all apropos-do-all))
-    (setq apropos-accumulator
-	  (apropos-internal apropos-regexp
-			    (if do-all
-				(lambda (symbol) (or (commandp symbol)
-						     (user-variable-p symbol)))
-			      'commandp)))
-    (if (apropos-print
-	 t
-	 (lambda (p)
-	   (let (doc symbol)
-	     (while p
-	       (setcar p (list
-			  (setq symbol (car p))
-			  (if (commandp symbol)
-			      (if (setq doc (documentation symbol t))
-				  (substring doc 0 (string-match "\n" doc))
-				"(not documented)"))
-			  (and do-all
-			       (user-variable-p symbol)
-			       (if (setq doc (documentation-property
-					      symbol 'variable-documentation t))
-				   (substring doc 0
-					      (string-match "\n" doc))))))
-	       (setq p (cdr p)))))
-	 nil)
-	(and message (message message)))))
-
-
-;;;###autoload
-(defun apropos (apropos-regexp &optional do-all)
-  "Show all bound symbols whose names match REGEXP.
-With optional prefix ARG or if `apropos-do-all' is non-nil, also show unbound
-symbols and key bindings, which is a little more time-consuming.
-Returns list of symbols and documentation found."
-  (interactive "sApropos symbol (regexp): \nP")
-  (setq apropos-accumulator
-	(apropos-internal apropos-regexp
-			  (and (not do-all)
-			       (not apropos-do-all)
-			       (lambda (symbol)
-				 (or (fboundp symbol)
-				     (boundp symbol)
-				     (symbol-plist symbol))))))
-  (apropos-print
-   (or do-all apropos-do-all)
-   (lambda (p)
-     (let (symbol doc)
-       (while p
-	 (setcar p (list
-		    (setq symbol (car p))
-		    (if (fboundp symbol)
-			(if (setq doc (documentation symbol t))
-			    (substring doc 0 (string-match "\n" doc))
-			  "(not documented)"))
-		    (if (boundp symbol)
-			(if (setq doc (documentation-property
-				       symbol 'variable-documentation t))
-			    (substring doc 0
-				       (string-match "\n" doc))
-			  "(not documented)"))
-		    (if (setq doc (symbol-plist symbol))
-			(if (eq (/ (length doc) 2) 1)
-			    (format "1 property (%s)" (car doc))
-			  (concat (/ (length doc) 2) " properties")))))
-	 (setq p (cdr p)))))
-   nil))
-
-
-;;;###autoload
-(defun apropos-value (apropos-regexp &optional do-all)
-  "Show all symbols whose value's printed image matches REGEXP.
-With optional prefix ARG or if `apropos-do-all' is non-nil, also looks
-at the function and at the names and values of properties.
-Returns list of symbols and values found."
-  (interactive "sApropos value (regexp): \nP")
-  (or do-all (setq do-all apropos-do-all))
-  (setq apropos-accumulator ())
-   (let (f v p)
-     (mapatoms
-      (lambda (symbol)
-	(setq f nil v nil p nil)
-	(or (memq symbol '(apropos-regexp do-all apropos-accumulator
-					  symbol f v p))
-	    (setq v (apropos-value-internal 'boundp symbol 'symbol-value)))
-	(if do-all
-	    (setq f (apropos-value-internal 'fboundp symbol 'symbol-function)
-		  p (apropos-format-plist symbol "\n    " t)))
-	(if (or f v p)
-	    (setq apropos-accumulator (cons (list symbol f v p)
-					    apropos-accumulator))))))
-  (apropos-print nil nil t))
-
-
-;;;###autoload
-(defun apropos-documentation (apropos-regexp &optional do-all)
-  "Show symbols whose documentation contain matches for REGEXP.
-With optional prefix ARG or if `apropos-do-all' is non-nil, also use
-documentation that is not stored in the documentation file and show key
-bindings.
-Returns list of symbols and documentation found."
-  (interactive "sApropos documentation (regexp): \nP")
-  (or do-all (setq do-all apropos-do-all))
-  (setq apropos-accumulator () apropos-files-scanned ())
-  (let ((standard-input (get-buffer-create " apropos-temp"))
-	f v)
-    (unwind-protect
-	(save-excursion
-	  (set-buffer standard-input)
-	  (apropos-documentation-check-doc-file)
-	  (if do-all
-	      (mapatoms
-	       (lambda (symbol)
-		 (setq f (apropos-safe-documentation symbol)
-		       v (get symbol 'variable-documentation))
-		 (if (integerp v) (setq v))
-		 (setq f (apropos-documentation-internal f)
-		       v (apropos-documentation-internal v))
-		 (if (or f v)
-		     (if (setq apropos-item
-			       (cdr (assq symbol apropos-accumulator)))
-			 (progn
-			   (if f
-			       (setcar apropos-item f))
-			   (if v
-			       (setcar (cdr apropos-item) v)))
-		       (setq apropos-accumulator
-			     (cons (list symbol f v)
-				   apropos-accumulator)))))))
-	  (apropos-print nil nil t))
-      (kill-buffer standard-input))))
-
-
-(defun apropos-value-internal (predicate symbol function)
-  (if (funcall predicate symbol)
-      (progn
-	(setq symbol (prin1-to-string (funcall function symbol)))
-	(if (string-match apropos-regexp symbol)
-	    (progn
-	      (if apropos-match-face
-		  (put-text-property (match-beginning 0) (match-end 0)
-				     'face apropos-match-face
-				     symbol))
-	      symbol)))))
-
-(defun apropos-documentation-internal (doc)
-  (if (consp doc)
-      (apropos-documentation-check-elc-file (car doc))
-    (and doc
-	 (string-match apropos-regexp doc)
-	 (progn
-	   (if apropos-match-face
-	       (put-text-property (match-beginning 0)
-				  (match-end 0)
-				  'face apropos-match-face
-				  (setq doc (copy-sequence doc))))
-	   doc))))
-
-(defun apropos-format-plist (pl sep &optional compare)
-  (setq pl (symbol-plist pl))
-  (let (p p-out)
-    (while pl
-      (setq p (format "%s %S" (car pl) (nth 1 pl)))
-      (if (or (not compare) (string-match apropos-regexp p))
-	  (if apropos-property-face
-	      (put-text-property 0 (length (symbol-name (car pl)))
-				 'face apropos-property-face p))
-	(setq p nil))
-      (if p
-	  (progn
-	    (and compare apropos-match-face
-		 (put-text-property (match-beginning 0) (match-end 0)
-				    'face apropos-match-face
-				    p))
-	    (setq p-out (concat p-out (if p-out sep) p))))
-      (setq pl (nthcdr 2 pl)))
-    p-out))
-
-
-;; Finds all documentation related to APROPOS-REGEXP in internal-doc-file-name.
-
-(defun apropos-documentation-check-doc-file ()
-  (let (type symbol (sepa 2) sepb beg end)
-    (insert ?\^_)
-    (backward-char)
-    (insert-file-contents (concat doc-directory internal-doc-file-name))
-    (forward-char)
-    (while (save-excursion
-	     (setq sepb (search-forward "\^_"))
-	     (not (eobp)))
-      (beginning-of-line 2)
-      (if (save-restriction
-	    (narrow-to-region (point) (1- sepb))
-	    (re-search-forward apropos-regexp nil t))
-	  (progn
-	    (setq beg (match-beginning 0)
-		  end (point))
-	    (goto-char (1+ sepa))
-	    (or (setq type (if (eq ?F (preceding-char))
-			       1	; function documentation
-			     2)		; variable documentation
-		      symbol (read)
-		      beg (- beg (point) 1)
-		      end (- end (point) 1)
-		      doc (buffer-substring (1+ (point)) (1- sepb))
-		      apropos-item (assq symbol apropos-accumulator))
-		(setq apropos-item (list symbol nil nil)
-		      apropos-accumulator (cons apropos-item
-						apropos-accumulator)))
-	    (if apropos-match-face
-		(put-text-property beg end 'face apropos-match-face doc))
-	    (setcar (nthcdr type apropos-item) doc)))
-      (setq sepa (goto-char sepb)))))
-
-(defun apropos-documentation-check-elc-file (file)
-  (if (member file apropos-files-scanned)
-      nil
-    (let (symbol doc beg end this-is-a-variable)
-      (setq apropos-files-scanned (cons file apropos-files-scanned))
-      (erase-buffer)
-      (insert-file-contents file)
-      (while (search-forward "\n#@" nil t)
-	;; Read the comment length, and advance over it.
-	(setq end (read)
-	      beg (1+ (point))
-	      end (+ (point) end -1))
-	(forward-char)
-	(if (save-restriction
-	      ;; match ^ and $ relative to doc string
-	      (narrow-to-region beg end)
-	      (re-search-forward apropos-regexp nil t))
-	    (progn
-	      (goto-char (+ end 2))
-	      (setq doc (buffer-substring beg end)
-		    end (- (match-end 0) beg)
-		    beg (- (match-beginning 0) beg)
-		    this-is-a-variable (looking-at "(def\\(var\\|const\\) ")
-		    symbol (progn
-			     (skip-chars-forward "(a-z")
-			     (forward-char)
-			     (read))
-		    symbol (if (consp symbol)
-			       (nth 1 symbol)
-			     symbol))
-	      (if (if this-is-a-variable
-		      (get symbol 'variable-documentation)
-		    (and (fboundp symbol) (apropos-safe-documentation symbol)))
-		  (progn
-		    (or (setq apropos-item (assq symbol apropos-accumulator))
-			(setq apropos-item (list symbol nil nil)
-			      apropos-accumulator (cons apropos-item
-							apropos-accumulator)))
-		    (if apropos-match-face
-			(put-text-property beg end 'face apropos-match-face
-					   doc))
-		    (setcar (nthcdr (if this-is-a-variable 2 1)
-				    apropos-item)
-			    doc)))))))))
-
-
-
-(defun apropos-safe-documentation (function)
-  "Like documentation, except it avoids calling `get_doc_string'.
-Will return nil instead."
-  (while (and function (symbolp function))
-    (setq function (if (fboundp function)
-		       (symbol-function function))))
-  (if (eq (car-safe function) 'macro)
-      (setq function (cdr function)))
-  (setq function (if (byte-code-function-p function)
-		     (if (> (length function) 4)
-			 (aref function 4))
-		   (if (eq (car-safe function) 'autoload)
-		       (nth 2 function)
-		     (if (eq (car-safe function) 'lambda)
-			 (if (stringp (nth 2 function))
-			     (nth 2 function)
-			   (if (stringp (nth 3 function))
-			       (nth 3 function)))))))
-  (if (integerp function)
-      nil
-    function))
-
-
-
-(defun apropos-print (do-keys doc-fn spacing)
-  "Output result of various apropos commands with `apropos-regexp'.
-APROPOS-ACCUMULATOR is a list.  Optional DOC-FN is called for each element
-of apropos-accumulator and may modify it resulting in (symbol fn-doc
-var-doc [plist-doc]).  Returns sorted list of symbols and documentation
-found."
-  (if (null apropos-accumulator)
-      (message "No apropos matches for `%s'" apropos-regexp)
-    (if doc-fn
-	(funcall doc-fn apropos-accumulator))
-    (setq apropos-accumulator
-	  (sort apropos-accumulator (lambda (a b)
-				      (string-lessp (car a) (car b)))))
-    (and apropos-label-face
-	 (symbolp apropos-label-face)
-	 (setq apropos-label-face `(face ,apropos-label-face
-					 mouse-face highlight)))
-    (with-output-to-temp-buffer "*Apropos*"
-      (let ((p apropos-accumulator)
-	    (old-buffer (current-buffer))
-	    symbol item point1 point2)
-	(set-buffer standard-output)
-	(apropos-mode)
-	(if window-system
-	    (insert "If you move the mouse over text that changes color,\n"
-		    (substitute-command-keys
-		     "you can click \\[apropos-mouse-follow] to get more information.\n")))
-	(insert (substitute-command-keys
-		 "In this buffer, type \\[apropos-follow] to get full documentation.\n\n"))
-	(while (consp p)
-	  (or (not spacing) (bobp) (terpri))
-	  (setq apropos-item (car p)
-		symbol (car apropos-item)
-		p (cdr p)
-		point1 (point))
-	  (princ symbol)		        ; print symbol name
-	  (setq point2 (point))
-	  ;; Calculate key-bindings if we want them.
-	  (and do-keys
-	       (commandp symbol)
-	       (indent-to 30 1)
-	       (if (let ((keys
-			  (save-excursion
-			    (set-buffer old-buffer)
-			    (where-is-internal symbol)))
-			 filtered)
-		     ;; Copy over the list of key sequences,
-		     ;; omitting any that contain a buffer or a frame.
-		     (while keys
-		       (let ((key (car keys))
-			     (i 0)
-			     loser)
-			 (while (< i (length key))
-			   (if (or (framep (aref key i))
-				   (bufferp (aref key i)))
-			       (setq loser t))
-			   (setq i (1+ i)))
-			 (or loser
-			     (setq filtered (cons key filtered))))
-		       (setq keys (cdr keys)))
-		     (setq item filtered))
-		   ;; Convert the remaining keys to a string and insert.
-		   (insert
-		    (mapconcat
-		     (lambda (key)
-		       (setq key (key-description key))
-		       (if apropos-keybinding-face
-			   (put-text-property 0 (length key)
-					      'face apropos-keybinding-face
-					      key))
-		       key)
-		     item ", "))
-		 (insert "M-x")
-		 (put-text-property (- (point) 3) (point)
-				    'face apropos-keybinding-face)
-		 (insert " " (symbol-name symbol) " ")
-		 (insert "RET")
-		 (put-text-property (- (point) 3) (point)
-				    'face apropos-keybinding-face)))
-	  (terpri)
-	  ;; only now so we don't propagate text attributes all over
-	  (put-text-property point1 point2 'item
-			     (if (eval `(or ,@(cdr apropos-item)))
-				 (car apropos-item)
-			       apropos-item))
-	  (if apropos-symbol-face
-	      (put-text-property point1 point2 'face apropos-symbol-face))
-	  (apropos-print-doc 'describe-function 1
-			     (if (commandp symbol)
-				 "Command"
-			       (if (apropos-macrop symbol)
-				   "Macro"
-				 "Function"))
-			     do-keys)
-	  (apropos-print-doc 'describe-variable 2
-			     "Variable" do-keys)
-	  (apropos-print-doc 'apropos-describe-plist 3
-			     "Plist" nil)))))
-  (prog1 apropos-accumulator
-    (setq apropos-accumulator ())))	; permit gc
-
-
-(defun apropos-macrop (symbol)
-  "T if SYMBOL is a Lisp macro."
-  (and (fboundp symbol)
-       (consp (setq symbol
-		    (symbol-function symbol)))
-       (or (eq (car symbol) 'macro)
-	   (if (eq (car symbol) 'autoload)
-	       (memq (nth 4 symbol)
-		     '(macro t))))))
-
-
-(defun apropos-print-doc (action i str do-keys)
-  (if (stringp (setq i (nth i apropos-item)))
-      (progn
-	(insert "  ")
-	(put-text-property (- (point) 2) (1- (point))
-			   'action action)
-	(insert str ": ")
-	(if apropos-label-face
-	    (add-text-properties (- (point) (length str) 2)
-				 (1- (point))
-				 apropos-label-face))
-	(insert (if do-keys (substitute-command-keys i) i))
-	(or (bolp) (terpri)))))
-
-
-(defun apropos-mouse-follow (event)
-  (interactive "e")
-  (let ((other (if (eq (current-buffer) (get-buffer "*Apropos*"))
-		   ()
-		 (current-buffer))))
-    (save-excursion
-      (set-buffer (window-buffer (posn-window (event-start event))))
-      (goto-char (posn-point (event-start event)))
-      (or (and (not (eobp)) (get-text-property (point) 'mouse-face))
-	  (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
-	  (error "There is nothing to follow here"))
-      (apropos-follow other))))
-
-
-(defun apropos-follow (&optional other)
-  (interactive)
-  (let* (;; Properties are always found at the beginning of the line.
-	 (bol (save-excursion (beginning-of-line) (point)))
-	 ;; If there is no `item' property here, look behind us.
-	 (item (get-text-property bol 'item))
-	 (item-at (if item nil (previous-single-property-change bol 'item)))
-	 ;; Likewise, if there is no `action' property here, look in front.
-	 (action (get-text-property bol 'action))
-	 (action-at (if action nil (next-single-property-change bol 'action))))
-    (and (null item) item-at
-	 (setq item (get-text-property (1- item-at) 'item)))
-    (and (null action) action-at
-	 (setq action (get-text-property action-at 'action)))
-    (if (not (and item action))
-	(error "There is nothing to follow here"))
-    (if (consp item) (error "There is nothing to follow in `%s'" (car item)))
-    (if other (set-buffer other))
-    (funcall action item)))
-
-
-
-(defun apropos-describe-plist (symbol)
-  "Display a pretty listing of SYMBOL's plist."
-  (with-output-to-temp-buffer "*Help*"
-    (set-buffer standard-output)
-    (princ "Symbol ")
-    (prin1 symbol)
-    (princ "'s plist is\n (")
-    (if apropos-symbol-face
-	(put-text-property 8 (- (point) 14) 'face apropos-symbol-face))
-    (insert (apropos-format-plist symbol "\n  "))
-    (princ ")")
-    (print-help-return-message)))
-
-;;; apropos.el ends here
diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el
deleted file mode 100644
index 0a63debcd99..00000000000
--- a/lisp/arc-mode.el
+++ /dev/null
@@ -1,1482 +0,0 @@
-;;; arc-mode.el --- simple editing of archives
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Morten Welinder (terra@diku.dk)
-;; Keywords: archives msdog editing major-mode
-;; Favourite-brand-of-beer: None, I hate beer.
-
-;; 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:
-
-;; NAMING: "arc" is short for "archive" and does not refer specifically
-;; to files whose name end in ".arc"
-;;
-;; This code does not decode any files internally, although it does
-;; understand the directory level of the archives.  For this reason,
-;; you should expect this code to need more fiddling than tar-mode.el
-;; (although it at present has fewer bugs :-)  In particular, I have
-;; not tested this under Ms-Dog myself.
-;; -------------------------------------
-;; INTERACTION: arc-mode.el should play together with
-;;
-;; * ange-ftp.el: Remote archives (i.e., ones that ange-ftp has brought
-;;                to you) are handled by doing all updates on a local
-;;                copy.  When you make changes to a remote file the
-;;                changes will first take effect when the archive buffer
-;;                is saved.  You will be warned about this.
-;;
-;; * dos-fns.el:  (Part of Emacs 19).  You get automatic ^M^J <--> ^J
-;;                conversion.
-;;
-;; arc-mode.el does not work well with crypt++.el; for the archives as
-;; such this could be fixed (but wouldn't be useful) by declaring such
-;; archives to be "remote".  For the members this is a general Emacs
-;; problem that 19.29's file formats may fix.
-;; -------------------------------------
-;; ARCHIVE TYPES: Currently only the archives below are handled, but the
-;; structure for handling just about anything is in place.
-;;
-;;                        Arc     Lzh     Zip     Zoo
-;;                        --------------------------------
-;; View listing           Intern  Intern  Intern  Intern
-;; Extract member         Y       Y       Y       Y
-;; Save changed member    Y       Y       Y       Y
-;; Add new member         N       N       N       N
-;; Delete member          Y       Y       Y       Y
-;; Rename member          Y       Y       N       N
-;; Chmod                  -       Y       Y       -
-;; Chown                  -       Y       -       -
-;; Chgrp                  -       Y       -       -
-;;
-;; Special thanks to Bill Brodie <wbrodie@panix.com> for very useful tips
-;; on the first released version of this package.
-;;
-;; This code is partly based on tar-mode.el from Emacs.
-;; -------------------------------------
-;; ARCHIVE STRUCTURES:
-;; (This is mostly for myself.)
-;;
-;; ARC         A series of (header,file).  No interactions among members.
-;;
-;; LZH         A series of (header,file).  Headers are checksummed.  No
-;;             interaction among members.
-;;
-;; ZIP         A series of (lheader,fil) followed by a "central directory"
-;;             which is a series of (cheader) followed by an end-of-
-;;             central-dir record possibly followed by junk.  The e-o-c-d
-;;             links to c-d.  cheaders link to lheaders which are basically
-;;             cut-down versions of the cheaders.
-;;
-;; ZOO         An archive header followed by a series of (header,file).
-;;             Each member header points to the next.  The archive is
-;;             terminated by a bogus header with a zero next link.
-;; -------------------------------------
-;; HOOKS: `foo' means one the the supported archive types.
-;;
-;; archive-mode-hook
-;; archive-foo-mode-hook
-;; archive-extract-hooks
-
-;;; Code:
-
-;; -------------------------------------------------------------------------
-;; Section: Configuration.
-
-(defvar archive-dos-members t
-  "*If non-nil then recognize member files using ^M^J as line terminator.")
-
-(defvar archive-tmpdir
-  (expand-file-name
-   (make-temp-name (if (eq system-type 'ms-dos) "ar" "archive.tmp"))
-   (or (getenv "TMPDIR") (getenv "TMP") "/tmp"))
-  "*Directory for temporary files made by arc-mode.el")
-
-(defvar archive-remote-regexp "^/[^/:]*[^/:.]:"
-  "*Regexp recognizing archive files names that are not local.
-A non-local file is one whose file name is not proper outside Emacs.
-A local copy of the archive will be used when updating.")
-
-(defvar archive-extract-hooks nil
-  "*Hooks to run when an archive member has been extracted.")
-;; ------------------------------
-;; Arc archive configuration
-
-;; We always go via a local file since there seems to be no reliable way
-;; to extract to stdout without junk getting added.
-(defvar archive-arc-extract
-  '("arc" "x")
-  "*Program and its options to run in order to extract an arc file member.
-Extraction should happen to the current directory.  Archive and member
-name will be added.")
-
-(defvar archive-arc-expunge
-  '("arc" "d")
-  "*Program and its options to run in order to delete arc file members.
-Archive and member names will be added.")
-
-(defvar archive-arc-write-file-member
-  '("arc" "u")
-  "*Program and its options to run in order to update an arc file member.
-Archive and member name will be added.")
-;; ------------------------------
-;; Lzh archive configuration
-
-(defvar archive-lzh-extract
-  '("lha" "pq")
-  "*Program and its options to run in order to extract an lzh file member.
-Extraction should happen to standard output.  Archive and member name will
-be added.")
-
-(defvar archive-lzh-expunge
-  '("lha" "d")
-  "*Program and its options to run in order to delete lzh file members.
-Archive and member names will be added.")
-
-(defvar archive-lzh-write-file-member
-  '("lha" "a")
-  "*Program and its options to run in order to update an lzh file member.
-Archive and member name will be added.")
-;; ------------------------------
-;; Zip archive configuration
-
-(defvar archive-zip-use-pkzip (memq system-type '(ms-dos windows-nt))
-  "*If non-nil then pkzip option are used instead of zip options.
-Only set to true for msdog systems!")
-
-(defvar archive-zip-extract
-  (if archive-zip-use-pkzip '("pkunzip" "-e") '("unzip" "-qq" "-c"))
-  "*Program and its options to run in order to extract a zip file member.
-Extraction should happen to standard output.  Archive and member name will
-be added.  If `archive-zip-use-pkzip' is non-nil then this program is
-expected to extract to a file junking the directory part of the name.")
-
-;; For several reasons the latter behaviour is not desirable in general.
-;; (1) It uses more disk space.  (2) Error checking is worse or non-
-;; existent.  (3) It tends to do funny things with other systems' file
-;; names.
-
-(defvar archive-zip-expunge
-  (if archive-zip-use-pkzip '("pkzip" "-d") '("zip" "-d" "-q"))
-  "*Program and its options to run in order to delete zip file members.
-Archive and member names will be added.")
-
-(defvar archive-zip-update
-  (if archive-zip-use-pkzip '("pkzip" "-u") '("zip" "-q"))
-  "*Program and its options to run in order to update a zip file member.
-Options should ensure that specified directory will be put into the zip
-file.  Archive and member name will be added.")
-
-(defvar archive-zip-update-case
-  (if archive-zip-use-pkzip archive-zip-update '("zip" "-q" "-k"))
-  "*Program and its options to run in order to update a case fiddled zip member.
-Options should ensure that specified directory will be put into the zip file.
-Archive and member name will be added.")
-
-(defvar archive-zip-case-fiddle t
-  "*If non-nil then zip file members are case fiddled.
-Case fiddling will only happen for members created by a system that
-uses caseless file names.")
-;; ------------------------------
-;; Zoo archive configuration
-
-(defvar archive-zoo-extract
-  '("zoo" "xpq")
-  "*Program and its options to run in order to extract a zoo file member.
-Extraction should happen to standard output.  Archive and member name will
-be added.")
-
-(defvar archive-zoo-expunge
-  '("zoo" "DqPP")
-  "*Program and its options to run in order to delete zoo file members.
-Archive and member names will be added.")
-
-(defvar archive-zoo-write-file-member
-  '("zoo" "a")
-  "*Program and its options to run in order to update a zoo file member.
-Archive and member name will be added.")
-;; -------------------------------------------------------------------------
-;; Section: Variables
-
-(defvar archive-subtype nil "*Symbol describing archive type.")
-(defvar archive-file-list-start nil "*Position of first contents line.")
-(defvar archive-file-list-end nil "*Position just after last contents line.")
-(defvar archive-proper-file-start nil "*Position of real archive's start.")
-(defvar archive-read-only nil "*Non-nil if the archive is read-only on disk.")
-(defvar archive-remote nil "*Non-nil if the archive is outside file system.")
-(defvar archive-local-name nil "*Name of local copy of remote archive.")
-(defvar archive-mode-map nil "*Local keymap for archive mode listings.")
-(defvar archive-file-name-indent nil "*Column where file names start.")
-
-(defvar archive-alternate-display nil
-  "*Non-nil when alternate information is shown.")
-(make-variable-buffer-local 'archive-alternate-display)
-(put 'archive-alternate-display 'permanent-local t)
-
-(defvar archive-superior-buffer nil "*In archive members, points to archive.")
-(put 'archive-superior-buffer 'permanent-local t)
-
-(defvar archive-subfile-mode nil "*Non-nil in archive member buffers.")
-(make-variable-buffer-local 'archive-subfile-mode)
-(put 'archive-subfile-mode 'permanent-local t)
-
-(defvar archive-subfile-dos nil
-  "Negation of `buffer-file-type', which see.")
-(make-variable-buffer-local 'archive-subfile-dos)
-(put 'archive-subfile-dos 'permanent-local t)
-
-(defvar archive-files nil
-  "Vector of file descriptors.
-Each descriptor is a vector of the form
- [EXT-FILE-NAME INT-FILE-NAME CASE-FIDDLED MODE ...]")
-(make-variable-buffer-local 'archive-files)
-
-(defvar archive-lemacs
-  (string-match "\\(Lucid\\|Xemacs\\)" emacs-version)
-  "*Non-nil when running under under Lucid Emacs or Xemacs.")
-;; -------------------------------------------------------------------------
-;; Section: Support functions.
-
-(defsubst archive-name (suffix)
-  (intern (concat "archive-" (symbol-name archive-subtype) "-" suffix)))
-
-(defun archive-l-e (str &optional len)
-  "Convert little endian string/vector to integer.
-Alternatively, first argument may be a buffer position in the current buffer
-in which case a second argument, length, should be supplied."
-  (if (stringp str)
-      (setq len (length str))
-    (setq str (buffer-substring str (+ str len))))
-  (let ((result 0)
-        (i 0))
-    (while (< i len)
-      (setq i (1+ i)
-            result (+ (ash result 8) (aref str (- len i)))))
-    result))
-
-(defun archive-int-to-mode (mode)
-  "Turn an integer like 0700 (i.e., 448) into a mode string like -rwx------"
-  (let ((str (make-string 10 ?-)))
-    (or (zerop (logand 16384 mode)) (aset str 0 ?d))
-    (or (zerop (logand  8192 mode)) (aset str 0 ?c)) ; completeness
-    (or (zerop (logand   256 mode)) (aset str 1 ?r))
-    (or (zerop (logand   128 mode)) (aset str 2 ?w))
-    (or (zerop (logand    64 mode)) (aset str 3 ?x))
-    (or (zerop (logand    32 mode)) (aset str 4 ?r))
-    (or (zerop (logand    16 mode)) (aset str 5 ?w))
-    (or (zerop (logand     8 mode)) (aset str 6 ?x))
-    (or (zerop (logand     4 mode)) (aset str 7 ?r))
-    (or (zerop (logand     2 mode)) (aset str 8 ?w))
-    (or (zerop (logand     1 mode)) (aset str 9 ?x))
-    (or (zerop (logand  1024 mode)) (aset str 3 (if (zerop (logand 64 mode))
-						    ?S ?s)))
-    (or (zerop (logand  2048 mode)) (aset str 6 (if (zerop (logand  8 mode))
-						    ?S ?s)))
-    str))
-
-(defun archive-calc-mode (oldmode newmode &optional error)
-  "From the integer OLDMODE and the string NEWMODE calculate a new file mode.
-NEWMODE may be an octal number including a leading zero in which case it
-will become the new mode.\n
-NEWMODE may also be a relative specification like \"og-rwx\" in which case
-OLDMODE will be modified accordingly just like chmod(2) would have done.\n
-If optional third argument ERROR is non-nil an error will be signaled if
-the mode is invalid.  If ERROR is nil then nil will be returned."
-  (cond ((string-match "^0[0-7]*$" newmode)
-	 (let ((result 0)
-	       (len (length newmode))
-	       (i 1))
-	   (while (< i len)
-	     (setq result (+ (lsh result 3) (aref newmode i) (- ?0))
-		   i (1+ i)))
-	   (logior (logand oldmode 65024) result)))
-	((string-match "^\\([agou]+\\)\\([---+=]\\)\\([rwxst]+\\)$" newmode)
-	 (let ((who 0)
-	       (result oldmode)
-	       (op (aref newmode (match-beginning 2)))
-	       (bits 0)
-	       (i (match-beginning 3)))
-	   (while (< i (match-end 3))
-	     (let ((rwx (aref newmode i)))
-	       (setq bits (logior bits (cond ((= rwx ?r)  292)
-					     ((= rwx ?w)  146)
-					     ((= rwx ?x)   73)
-					     ((= rwx ?s) 3072)
-					     ((= rwx ?t)  512)))
-		     i (1+ i))))
-	   (while (< who (match-end 1))
-	     (let* ((whoc (aref newmode who))
-		    (whomask (cond ((= whoc ?a) 4095)
-				   ((= whoc ?u) 1472)
-				   ((= whoc ?g) 2104)
-				   ((= whoc ?o)    7))))
-	       (if (= op ?=)
-		   (setq result (logand result (lognot whomask))))
-	       (if (= op ?-)
-		   (setq result (logand result (lognot (logand whomask bits))))
-		 (setq result (logior result (logand whomask bits)))))
-	     (setq who (1+ who)))
-	   result))
-	(t
-	 (if error
-	     (error "Invalid mode specification: %s" newmode)))))
-
-(defun archive-dosdate (date)
-  "Stringify dos packed DATE record."
-  (let ((year (+ 1980 (logand (ash date -9) 127)))
-        (month (logand (ash date -5) 15))
-        (day (logand date 31)))
-    (if (or (> month 12) (< month 1))
-        ""
-      (format "%2d-%s-%d"
-              day
-              (aref ["Jan" "Feb" "Mar" "Apr" "May" "Jun"
-                     "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"] (1- month))
-              year))))
-
-(defun archive-dostime (time)
-  "Stringify dos packed TIME record."
-  (let ((hour (logand (ash time -11) 31))
-        (minute (logand (ash time -5) 53))
-        (second (* 2 (logand time 31)))) ; 2 seconds resolution
-    (format "%02d:%02d:%02d" hour minute second)))
-
-;;(defun archive-unixdate (low high)
-;;  "Stringify unix (LOW HIGH) date."
-;;  (let ((str (current-time-string (cons high low))))
-;;    (format "%s-%s-%s"
-;;	    (substring str 8 9)
-;;	    (substring str 4 7)
-;;	    (substring str 20 24))))
-
-;;(defun archive-unixtime (low high)
-;;  "Stringify unix (LOW HIGH) time."
-;;  (let ((str (current-time-string (cons high low))))
-;;    (substring str 11 19)))
-
-(defun archive-get-lineno ()
-  (if (>= (point) archive-file-list-start)
-      (count-lines archive-file-list-start
-		   (save-excursion (beginning-of-line) (point)))
-    0))
-
-(defun archive-get-descr (&optional noerror)
-  "Return the descriptor vector for file at point.
-Does not signal an error if optional second argument NOERROR is non-nil."
-  (let ((no (archive-get-lineno)))
-    (if (and (>= (point) archive-file-list-start)
-             (< no (length archive-files)))
-	(let ((item (aref archive-files no)))
-	  (if (vectorp item)
-	      item
-	    (if (not noerror)
-		(error "Entry is not a regular member of the archive"))))
-      (if (not noerror)
-          (error "Line does not describe a member of the archive")))))
-;; -------------------------------------------------------------------------
-;; Section: the mode definition
-
-;;;###autoload
-(defun archive-mode (&optional force)
-  "Major mode for viewing an archive file in a dired-like way.
-You can move around using the usual cursor motion commands.
-Letters no longer insert themselves.
-Type `e' to pull a file out of the archive and into its own buffer;
-or click mouse-2 on the file's line in the archive mode buffer.
-
-If you edit a sub-file of this archive (as with the `e' command) and
-save it, the contents of that buffer will be saved back into the
-archive.
-
-\\{archive-mode-map}"
-  ;; This is not interactive because you shouldn't be turning this
-  ;; mode on and off.  You can corrupt things that way.
-  (if (zerop (buffer-size))
-      ;; At present we cannot create archives from scratch
-      (funcall default-major-mode)
-    (if (and (not force) archive-files) nil
-      (let* ((type (archive-find-type))
-	     (typename (copy-sequence (symbol-name type))))
-	(aset typename 0 (upcase (aref typename 0)))
-	(kill-all-local-variables)
-	(make-local-variable 'archive-subtype)
-	(setq archive-subtype type)
-
-	;; Buffer contains treated image of file before the file contents
-	(make-local-variable 'revert-buffer-function)
-	(setq revert-buffer-function 'archive-mode-revert)
-	(auto-save-mode 0)
-	(make-local-variable 'local-write-file-hooks)
-	(add-hook 'local-write-file-hooks 'archive-write-file)
-
-	;; Real file contents is binary
-	(make-local-variable 'require-final-newline)
-	(setq require-final-newline nil)
-	(make-local-variable 'enable-local-variables)
-	(setq enable-local-variables nil)
-	(if (boundp 'default-buffer-file-type)
-	    (setq buffer-file-type t))
-
-	(make-local-variable 'archive-read-only)
-	(setq archive-read-only (not (file-writable-p (buffer-file-name))))
-
-	;; Should we use a local copy when accessing from outside Emacs?
-	(make-local-variable 'archive-local-name)
-	(make-local-variable 'archive-remote)
-	(setq archive-remote (string-match archive-remote-regexp
-					   (buffer-file-name)))
-
-	(setq major-mode 'archive-mode)
-	(setq mode-name (concat typename "-Archive"))
-	;; Run archive-foo-mode-hook and archive-mode-hook
-	(run-hooks (archive-name "mode-hook") 'archive-mode-hook)
-	(use-local-map archive-mode-map))
-
-      (make-local-variable 'archive-proper-file-start)
-      (make-local-variable 'archive-file-list-start)
-      (make-local-variable 'archive-file-list-end)
-      (make-local-variable 'archive-file-name-indent)
-      (archive-summarize)
-      (setq buffer-read-only t))))
-
-;; Archive mode is suitable only for specially formatted data.
-(put 'archive-mode 'mode-class 'special)
-;; -------------------------------------------------------------------------
-;; Section: Key maps
-
-(if archive-mode-map nil
-  (setq archive-mode-map (make-keymap))
-  (suppress-keymap archive-mode-map)
-  (define-key archive-mode-map " " 'archive-next-line)
-  (define-key archive-mode-map "a" 'archive-alternate-display)
-  ;;(define-key archive-mode-map "c" 'archive-copy)
-  (define-key archive-mode-map "d" 'archive-flag-deleted)
-  (define-key archive-mode-map "\C-d" 'archive-flag-deleted)
-  (define-key archive-mode-map "e" 'archive-extract)
-  (define-key archive-mode-map "f" 'archive-extract)
-  (define-key archive-mode-map "\C-m" 'archive-extract)
-  (define-key archive-mode-map "g" 'revert-buffer)
-  (define-key archive-mode-map "h" 'describe-mode)
-  (define-key archive-mode-map "m" 'archive-mark)
-  (define-key archive-mode-map "n" 'archive-next-line)
-  (define-key archive-mode-map "\C-n" 'archive-next-line)
-  (define-key archive-mode-map [down] 'archive-next-line)
-  (define-key archive-mode-map "o" 'archive-extract-other-window)
-  (define-key archive-mode-map "p" 'archive-previous-line)
-  (define-key archive-mode-map "\C-p" 'archive-previous-line)
-  (define-key archive-mode-map [up] 'archive-previous-line)
-  (define-key archive-mode-map "r" 'archive-rename-entry)
-  (define-key archive-mode-map "u" 'archive-unflag)
-  (define-key archive-mode-map "\M-\C-?" 'archive-unmark-all-files)
-  (define-key archive-mode-map "v" 'archive-view)
-  (define-key archive-mode-map "x" 'archive-expunge)
-  (define-key archive-mode-map "\177" 'archive-unflag-backwards)
-  (define-key archive-mode-map "E" 'archive-extract-other-window)
-  (define-key archive-mode-map "M" 'archive-chmod-entry)
-  (define-key archive-mode-map "G" 'archive-chgrp-entry)
-  (define-key archive-mode-map "O" 'archive-chown-entry)
-
-  (if archive-lemacs
-      (progn
-	;; Not a nice "solution" but it'll have to do
-	(define-key archive-mode-map "\C-xu" 'archive-undo)
-	(define-key archive-mode-map "\C-_" 'archive-undo))
-    (substitute-key-definition 'undo 'archive-undo
-			       archive-mode-map global-map))
-
-  (define-key archive-mode-map
-    (if archive-lemacs 'button2 [mouse-2]) 'archive-mouse-extract)
-
-  (if archive-lemacs
-      ()				; out of luck
-    ;; Get rid of the Edit menu bar item to save space.
-    (define-key archive-mode-map [menu-bar edit] 'undefined)
-
-    (define-key archive-mode-map [menu-bar immediate]
-      (cons "Immediate" (make-sparse-keymap "Immediate")))
-    (define-key archive-mode-map [menu-bar immediate alternate]
-      '("Alternate Display" . archive-alternate-display))
-    (put 'archive-alternate-display 'menu-enable
-	 '(boundp (archive-name "alternate-display")))
-    (define-key archive-mode-map [menu-bar immediate view]
-      '("View This File" . archive-view))
-    (define-key archive-mode-map [menu-bar immediate display]
-      '("Display in Other Window" . archive-display-other-window))
-    (define-key archive-mode-map [menu-bar immediate find-file-other-window]
-      '("Find in Other Window" . archive-extract-other-window))
-    (define-key archive-mode-map [menu-bar immediate find-file]
-      '("Find This File" . archive-extract))
-
-    (define-key archive-mode-map [menu-bar mark]
-      (cons "Mark" (make-sparse-keymap "Mark")))
-    (define-key archive-mode-map [menu-bar mark unmark-all]
-      '("Unmark All" . archive-unmark-all-files))
-    (define-key archive-mode-map [menu-bar mark deletion]
-      '("Flag" . archive-flag-deleted))
-    (define-key archive-mode-map [menu-bar mark unmark]
-      '("Unflag" . archive-unflag))
-    (define-key archive-mode-map [menu-bar mark mark]
-      '("Mark" . archive-mark))
-
-    (define-key archive-mode-map [menu-bar operate]
-      (cons "Operate" (make-sparse-keymap "Operate")))
-    (define-key archive-mode-map [menu-bar operate chown]
-      '("Change Owner..." . archive-chown-entry))
-    (put 'archive-chown-entry 'menu-enable
-	 '(fboundp (archive-name "chown-entry")))
-    (define-key archive-mode-map [menu-bar operate chgrp]
-      '("Change Group..." . archive-chgrp-entry))
-    (put 'archive-chgrp-entry 'menu-enable
-	 '(fboundp (archive-name "chgrp-entry")))
-    (define-key archive-mode-map [menu-bar operate chmod]
-      '("Change Mode..." . archive-chmod-entry))
-    (put 'archive-chmod-entry 'menu-enable
-	 '(fboundp (archive-name "chmod-entry")))
-    (define-key archive-mode-map [menu-bar operate rename]
-      '("Rename to..." . archive-rename-entry))
-    (put 'archive-rename-entry 'menu-enable
-	 '(fboundp (archive-name "rename-entry")))
-    ;;(define-key archive-mode-map [menu-bar operate copy]
-    ;;  '("Copy to..." . archive-copy))
-    (define-key archive-mode-map [menu-bar operate expunge]
-      '("Expunge Marked Files" . archive-expunge))
-  ))
-
-(let* ((item1 '(archive-subfile-mode " Archive"))
-       (item2 '(archive-subfile-dos " Dos"))
-       (items (if (memq system-type '(ms-dos windows-nt))
-		  (list item1) ; msdog has its own indicator
-		(list item1 item2))))
-  (or (member item1 minor-mode-alist)
-      (setq minor-mode-alist (append items minor-mode-alist))))
-;; -------------------------------------------------------------------------
-(defun archive-find-type ()
-  (widen)
-  (goto-char (point-min))
-  ;; The funny [] here make it unlikely that the .elc file will be treated
-  ;; as an archive by other software.
-  (let (case-fold-search)
-    (cond ((looking-at "[P]K\003\004") 'zip)
-	  ((looking-at "..-l[hz][0-9]-") 'lzh)
-	  ((looking-at "....................[\334]\247\304\375") 'zoo)
-	  ((and (looking-at "\C-z")	; signature too simple, IMHO
-		(string-match "\\.[aA][rR][cC]$"
-			      (or buffer-file-name (buffer-name))))
-	   'arc)
-	  (t (error "Buffer format not recognized.")))))
-;; -------------------------------------------------------------------------
-(defun archive-summarize ()
-  "Parse the contents of the archive file in the current buffer.
-Place a dired-like listing on the front;
-then narrow to it, so that only that listing
-is visible (and the real data of the buffer is hidden)."
-  (widen)
-  (let (buffer-read-only)
-    (message "Parsing archive file...")
-    (buffer-disable-undo (current-buffer))
-    (setq archive-files (funcall (archive-name "summarize")))
-    (message "Parsing archive file...done.")
-    (setq archive-proper-file-start (point-marker))
-    (narrow-to-region (point-min) (point))
-    (set-buffer-modified-p nil)
-    (buffer-enable-undo))
-  (goto-char archive-file-list-start)
-  (archive-next-line 0))
-
-(defun archive-resummarize ()
-  "Recreate the contents listing of an archive."
-  (let ((modified (buffer-modified-p))
-	(no (archive-get-lineno))
-	buffer-read-only)
-    (widen)
-    (delete-region (point-min) archive-proper-file-start)
-    (archive-summarize)
-    (set-buffer-modified-p modified)
-    (goto-char archive-file-list-start)
-    (archive-next-line no)))
-
-(defun archive-summarize-files (files)
-  "Insert a description of a list of files annotated with proper mouse face."
-  (setq archive-file-list-start (point-marker))
-  (setq archive-file-name-indent (if files (aref (car files) 1) 0))
-  ;; We don't want to do an insert for each element since that takes too
-  ;; long when the archive -- which has to be moved in memory -- is large.
-  (insert
-   (apply
-    (function concat)
-    (mapcar
-     (function 
-      (lambda (fil)
-	;; Using `concat' here copies the text also, so we can add
-	;; properties without problems.
-	(let ((text (concat (aref fil 0) "\n")))
-	  (if archive-lemacs
-	      ()			; out of luck
-	    (put-text-property (aref fil 1) (aref fil 2)
-			       'mouse-face 'highlight
-			       text))
-	  text)))
-     files)))
-  (setq archive-file-list-end (point-marker)))
-
-(defun archive-alternate-display ()
-  "Toggle alternative display.
-To avoid very long lines some archive mode don't show all information.
-This function changes the set of information shown for each files."
-  (interactive)
-  (setq archive-alternate-display (not archive-alternate-display))
-  (archive-resummarize))
-;; -------------------------------------------------------------------------
-;; Section: Local archive copy handling
-
-(defun archive-maybe-copy (archive)
-  (if archive-remote
-      (let ((start (point-max)))
-	(setq archive-local-name (expand-file-name
-				  (file-name-nondirectory archive)
-				  archive-tmpdir))
-	(make-directory archive-tmpdir t)
-	(save-restriction
-	  (widen)
-	  (write-region start (point-max) archive-local-name nil 'nomessage))
-	archive-local-name)
-    (if (buffer-modified-p) (save-buffer))
-    archive))
-
-(defun archive-maybe-update (unchanged)
-  (if archive-remote
-      (let ((name archive-local-name)
-	    (modified (buffer-modified-p))
-	    buffer-read-only)
-	(if unchanged nil
-	  (erase-buffer)
-	  (insert-file-contents name)
-	  (archive-mode t))
-	(archive-delete-local name)
-	(if (not unchanged)
-	    (message "Archive file must be saved for changes to take effect"))
-	(set-buffer-modified-p (or modified (not unchanged))))))
-
-(defun archive-delete-local (name)
-  "Delete file NAME and its parents up to and including `archive-tmpdir'."
-  (let ((again t)
-	(top (directory-file-name (file-name-as-directory archive-tmpdir))))
-    (condition-case nil
-	(delete-file name)
-      (error nil))
-    (while again
-      (setq name (directory-file-name (file-name-directory name)))
-      (condition-case nil
-	  (delete-directory name)
-	(error nil))
-      (if (string= name top) (setq again nil)))))
-;; -------------------------------------------------------------------------
-;; Section: Member extraction
-
-(defun archive-mouse-extract (event)
-  "Extract a file whose name you click on."
-  (interactive "e")
-  (mouse-set-point event)
-  (switch-to-buffer
-   (save-excursion
-     (archive-extract)
-     (current-buffer))))
-
-(defun archive-extract (&optional other-window-p)
-  "In archive mode, extract this entry of the archive into its own buffer."
-  (interactive)
-  (let* ((view-p (eq other-window-p 'view))
-	 (descr (archive-get-descr))
-         (ename (aref descr 0))
-         (iname (aref descr 1))
-         (archive-buffer (current-buffer))
-         (arcdir default-directory)
-         (archive (buffer-file-name))
-         (arcname (file-name-nondirectory archive))
-         (bufname (concat (file-name-nondirectory iname) " (" arcname ")"))
-         (extractor (archive-name "extract"))
-         (read-only-p (or archive-read-only view-p))
-         (buffer (get-buffer bufname))
-         (just-created nil))
-      (if buffer
-          nil
-	(setq archive (archive-maybe-copy archive))
-        (setq buffer (get-buffer-create bufname))
-        (setq just-created t)
-        (save-excursion
-          (set-buffer buffer)
-          (setq buffer-file-name
-                (expand-file-name (concat arcname ":" iname)))
-          (setq buffer-file-truename
-                (abbreviate-file-name buffer-file-name))
-          ;; Set the default-directory to the dir of the superior buffer.
-          (setq default-directory arcdir)
-          (make-local-variable 'archive-superior-buffer)
-          (setq archive-superior-buffer archive-buffer)
-          (make-local-variable 'local-write-file-hooks)
-          (add-hook 'local-write-file-hooks 'archive-write-file-member)
-          (setq archive-subfile-mode descr)
-	  (setq archive-subfile-dos nil)
-	  (if (boundp 'default-buffer-file-type)
-	      (setq buffer-file-type t))
-	  (if (fboundp extractor)
-	      (funcall extractor archive ename)
-	    (archive-*-extract archive ename (symbol-value extractor)))
-          (if archive-dos-members (archive-check-dos))
-          (goto-char (point-min))
-          (rename-buffer bufname)
-          (setq buffer-read-only read-only-p)
-	  (setq buffer-undo-list nil)
-          (set-buffer-modified-p nil)
-	  (setq buffer-saved-size (buffer-size))
-          (normal-mode)
-	  ;; Just in case an archive occurs inside another archive.
-	  (if (eq major-mode 'archive-mode)
-	      (setq archive-remote t))
-	  (run-hooks 'archive-extract-hooks))
-	(archive-maybe-update t))
-      (if view-p
-          (progn
-            (view-buffer buffer)
-            (and just-created (setq view-exit-action 'kill-buffer)))
-        (if (eq other-window-p 'display)
-            (display-buffer buffer)
-          (if other-window-p
-              (switch-to-buffer-other-window buffer)
-            (switch-to-buffer buffer))))))
-
-(defun archive-*-extract (archive name command)
-  (let* ((default-directory (file-name-as-directory archive-tmpdir))
-	 (tmpfile (expand-file-name (file-name-nondirectory name)
-				    default-directory)))
-    (make-directory (directory-file-name default-directory) t)
-    (apply 'call-process
-	   (car command)
-	   nil
-	   nil
-	   nil
-	   (append (cdr command) (list archive name)))
-    (insert-file-contents tmpfile)
-    (archive-delete-local tmpfile)))
-
-(defun archive-extract-by-stdout (archive name command)
-  (let ((binary-process-output t)) ; for Ms-Dos
-    (apply 'call-process
-	   (car command)
-	   nil
-	   t
-	   nil
-	   (append (cdr command) (list archive name)))))
-
-(defun archive-extract-other-window ()
-  "In archive mode, find this member in another window."
-  (interactive)
-  (archive-extract t))
-
-(defun archive-display-other-window ()
-  "In archive mode, display this member in another window."
-  (interactive)
-  (archive-extract 'display))
-
-(defun archive-view ()
-  "In archive mode, view the member on this line."
-  (interactive)
-  (archive-extract 'view))
-
-(defun archive-add-new-member (arcbuf name)
-  "Add current buffer to the archive in ARCBUF naming it NAME."
-  (interactive
-   (list (get-buffer
-	  (read-buffer "Buffer containing archive: "
-		       ;; Find first archive buffer and suggest that
-		       (let ((bufs (buffer-list)))
-			 (while (and bufs (not (eq (save-excursion
-						     (set-buffer (car bufs))
-						     major-mode)
-						   'archive-mode)))
-			   (setq bufs (cdr bufs)))
-			 (if bufs
-			     (car bufs)
-			   (error "There are no archive buffers")))
-		       t))
-	 (read-string "File name in archive: "
-		      (if buffer-file-name
-			  (file-name-nondirectory buffer-file-name)
-			""))))
-  (save-excursion
-    (set-buffer arcbuf)
-    (or (eq major-mode 'archive-mode)
-	(error "Buffer is not an archive buffer"))
-    (if archive-read-only
-	(error "Archive is read-only")))
-  (if (eq arcbuf (current-buffer))
-      (error "An archive buffer cannot be added to itself"))
-  (if (string= name "")
-      (error "Archive members may not be given empty names"))
-  (let ((func (save-excursion (set-buffer arcbuf)
-			      (archive-name "add-new-member")))
-	(membuf (current-buffer)))
-    (if (fboundp func)
-	(save-excursion
-	  (set-buffer arcbuf)
-	  (funcall func buffer-file-name membuf name))
-      (error "Adding a new member is not supported for this archive type"))))
-;; -------------------------------------------------------------------------
-;; Section: IO stuff
-
-(defun archive-check-dos (&optional force)
-  "*Possibly handle a buffer with ^M^J terminated lines."
-  (save-restriction
-    (widen)
-    (save-excursion
-      (goto-char (point-min))
-      (setq archive-subfile-dos
-	    (or force (not (search-forward-regexp "[^\r]\n" nil t))))
-      (if (boundp 'default-buffer-file-type)
-	  (setq buffer-file-type (not archive-subfile-dos)))
-      (if archive-subfile-dos
-          (let ((modified (buffer-modified-p)))
-            (buffer-disable-undo (current-buffer))
-            (goto-char (point-min))
-            (while (search-forward "\r\n" nil t)
-              (replace-match "\n"))
-            (buffer-enable-undo)
-            (set-buffer-modified-p modified))))))
-
-(defun archive-write-file-member ()
-  (if archive-subfile-dos
-      (save-restriction
-	(widen)
-        (save-excursion
-          (goto-char (point-min))
-          ;; We don't want our ^M^J <--> ^J changes to show in the undo list
-          (let ((undo-list buffer-undo-list))
-            (unwind-protect
-                (progn
-                  (setq buffer-undo-list t)
-                  (while (search-forward "\n" nil t)
-                    (replace-match "\r\n"))
-                  (setq archive-subfile-dos nil)
-		  (if (boundp 'default-buffer-file-type)
-		      (setq buffer-file-type t))
-                  ;; OK, we're now have explicit ^M^Js -- save and re-unixfy
-                  (archive-write-file-member))
-              (progn
-                (archive-check-dos t)
-                (setq buffer-undo-list undo-list))))
-          t))
-    (save-excursion
-      (save-restriction
-        (message "Updating archive...")
-        (widen)
-	(let ((writer  (save-excursion (set-buffer archive-superior-buffer)
-				       (archive-name "write-file-member")))
-	      (archive (save-excursion (set-buffer archive-superior-buffer)
-				       (buffer-file-name))))
-	  (if (fboundp writer)
-	      (funcall writer archive archive-subfile-mode)
-	    (archive-*-write-file-member archive
-					 archive-subfile-mode
-					 (symbol-value writer))))
-	(set-buffer-modified-p nil)
-        (message "Updating archive...done")
-        (set-buffer archive-superior-buffer)
-        (revert-buffer)
-        t))))
-
-(defun archive-*-write-file-member (archive descr command)
-  (let* ((ename (aref descr 0))
-         (tmpfile (expand-file-name ename archive-tmpdir))
-         (top (directory-file-name (file-name-as-directory archive-tmpdir)))
-	 (default-directory (file-name-as-directory top)))
-    (unwind-protect
-        (progn
-          (make-directory (file-name-directory tmpfile) t)
-	  (write-region (point-min) (point-max) tmpfile nil 'nomessage)
-	  (if (aref descr 3)
-	      ;; Set the file modes, but make sure we can read it.
-	      (set-file-modes tmpfile (logior ?\400 (aref descr 3))))
-          (let ((exitcode (apply 'call-process
-                                 (car command)
-                                 nil
-                                 nil
-                                 nil
-                                 (append (cdr command) (list archive ename)))))
-            (if (equal exitcode 0)
-                nil
-              (error "Updating was unsuccessful (%S)" exitcode))))
-      (archive-delete-local tmpfile))))
-
-(defun archive-write-file ()
-  (save-excursion
-    (write-region archive-proper-file-start (point-max) buffer-file-name nil t)
-    (set-buffer-modified-p nil)
-    t))
-;; -------------------------------------------------------------------------
-;; Section: Marking and unmarking.
-
-(defun archive-flag-deleted (p &optional type)
-  "In archive mode, mark this member to be deleted from the archive.
-With a prefix argument, mark that many files."
-  (interactive "p")
-  (or type (setq type ?D))
-  (beginning-of-line)
-  (let ((sign (if (>= p 0) +1 -1))
-	(modified (buffer-modified-p))
-        buffer-read-only)
-    (while (not (zerop p))
-      (if (archive-get-descr t)
-          (progn
-            (delete-char 1)
-            (insert type)))
-      (forward-line sign)
-      (setq p (- p sign)))
-    (set-buffer-modified-p modified))
-  (archive-next-line 0))
-
-(defun archive-unflag (p)
-  "In archive mode, un-mark this member if it is marked to be deleted.
-With a prefix argument, un-mark that many files forward."
-  (interactive "p")
-  (archive-flag-deleted p ? ))
-
-(defun archive-unflag-backwards (p)
-  "In archive mode, un-mark this member if it is marked to be deleted.
-With a prefix argument, un-mark that many members backward."
-  (interactive "p")
-  (archive-flag-deleted (- p) ? ))
-
-(defun archive-unmark-all-files ()
-  "Remove all marks."
-  (interactive)
-  (let ((modified (buffer-modified-p))
-	buffer-read-only)
-    (save-excursion
-      (goto-char archive-file-list-start)
-      (while (< (point) archive-file-list-end)
-        (or (= (following-char) ? )
-            (progn (delete-char 1) (insert ? )))
-        (forward-line 1)))
-    (set-buffer-modified-p modified)))
-
-(defun archive-mark (p)
-  "In archive mode, mark this member for group operations.
-With a prefix argument, mark that many members.
-Use \\[archive-unmark-all-files] to remove all marks."
-  (interactive "p")
-  (archive-flag-deleted p ?*))
-
-(defun archive-get-marked (mark &optional default)
-  (let (files)
-    (save-excursion
-      (goto-char archive-file-list-start)
-      (while (< (point) archive-file-list-end)
-        (if (= (following-char) mark)
-	    (setq files (cons (archive-get-descr) files)))
-        (forward-line 1)))
-    (or (nreverse files)
-	(and default
-	     (list (archive-get-descr))))))
-;; -------------------------------------------------------------------------
-;; Section: Operate
-
-(defun archive-next-line (p)
-  (interactive "p")
-  (forward-line p)
-  (or (eobp)
-      (forward-char archive-file-name-indent)))
-
-(defun archive-previous-line (p)
-  (interactive "p")
-  (archive-next-line (- p)))
-
-(defun archive-chmod-entry (new-mode)
-  "Change the protection bits associated with all marked or this member.
-The new protection bits can either be specified as an octal number or
-as a relative change like \"g+rw\" as for chmod(2)"
-  (interactive "sNew mode (octal or relative): ")
-  (if archive-read-only (error "Archive is read-only"))
-  (let ((func (archive-name "chmod-entry")))
-    (if (fboundp func)
-	(progn
-	  (funcall func new-mode (archive-get-marked ?* t))
-	  (archive-resummarize))
-      (error "Setting mode bits is not supported for this archive type"))))
-
-(defun archive-chown-entry (new-uid)
-  "Change the owner of all marked or this member."
-  (interactive "nNew uid: ")
-  (if archive-read-only (error "Archive is read-only"))
-  (let ((func (archive-name "chown-entry")))
-    (if (fboundp func)
-	(progn
-	  (funcall func new-uid (archive-get-marked ?* t))
-	  (archive-resummarize))
-      (error "Setting owner is not supported for this archive type"))))
-
-(defun archive-chgrp-entry (new-gid)
-  "Change the group of all marked or this member."
-  (interactive "nNew gid: ")
-  (if archive-read-only (error "Archive is read-only"))
-  (let ((func (archive-name "chgrp-entry")))
-    (if (fboundp func)
-	(progn
-	  (funcall func new-gid (archive-get-marked ?* t))
-	  (archive-resummarize))
-      (error "Setting group is not supported for this archive type"))))
-
-(defun archive-expunge ()
-  "Do the flagged deletions."
-  (interactive)
-  (let (files)
-    (save-excursion
-      (goto-char archive-file-list-start)
-      (while (< (point) archive-file-list-end)
-        (if (= (following-char) ?D)
-	    (setq files (cons (aref (archive-get-descr) 0) files)))
-        (forward-line 1)))
-    (setq files (nreverse files))
-    (and files
-	 (or (not archive-read-only)
-	     (error "Archive is read-only"))
-	 (or (yes-or-no-p (format "Really delete %d member%s? "
-				  (length files)
-				  (if (null (cdr files)) "" "s")))
-	     (error "Operation aborted"))
-	 (let ((archive (archive-maybe-copy (buffer-file-name)))
-	       (expunger (archive-name "expunge")))
-	   (if (fboundp expunger)
-	       (funcall expunger archive files)
-	     (archive-*-expunge archive files (symbol-value expunger)))
-	   (archive-maybe-update nil)
-	   (if archive-remote
-	       (archive-resummarize)
-	     (revert-buffer))))))
-
-(defun archive-*-expunge (archive files command)
-  (apply 'call-process
-	 (car command)
-	 nil
-	 nil
-	 nil
-	 (append (cdr command) (cons archive files))))
-
-(defun archive-rename-entry (newname)
-  "Change the name associated with this entry in the tar file."
-  (interactive "sNew name: ")
-  (if archive-read-only (error "Archive is read-only"))
-  (if (string= newname "")
-      (error "Archive members may not be given empty names"))
-  (let ((func (archive-name "rename-entry"))
-	(descr (archive-get-descr)))
-    (if (fboundp func)
-        (progn
-	  (funcall func (buffer-file-name) newname descr)
-	  (archive-resummarize))
-      (error "Renaming is not supported for this archive type"))))
-
-;; Revert the buffer and recompute the dired-like listing.
-(defun archive-mode-revert (&optional no-autosave no-confirm)
-  (let ((no (archive-get-lineno)))
-    (setq archive-files nil)
-    (let ((revert-buffer-function nil))
-      (revert-buffer t t))
-    (archive-mode)
-    (goto-char archive-file-list-start)
-    (archive-next-line no)))
-
-(defun archive-undo ()
-  "Undo in an archive buffer.
-This doesn't recover lost files, it just undoes changes in the buffer itself."
-  (interactive)
-  (let (buffer-read-only)
-    (undo)))
-;; -------------------------------------------------------------------------
-;; Section: Arc Archives
-
-(defun archive-arc-summarize ()
-  (let ((p 1)
-	(totalsize 0)
-	(maxlen 8)
-        files
-	visual)
-    (while (and (< (+ p 29) (point-max))
-		(= (char-after p) ?\C-z)
-		(> (char-after (1+ p)) 0))
-      (let* ((namefld (buffer-substring (+ p 2) (+ p 2 13)))
-	     (fnlen   (or (string-match "\0" namefld) 13))
-	     (efnname (substring namefld 0 fnlen))
-             (csize   (archive-l-e (+ p 15) 4))
-             (moddate (archive-l-e (+ p 19) 2))
-             (modtime (archive-l-e (+ p 21) 2))
-             (ucsize  (archive-l-e (+ p 25) 4))
-	     (fiddle  (string= efnname (upcase efnname)))
-             (ifnname (if fiddle (downcase efnname) efnname))
-             (text    (format "  %8d  %-11s  %-8s  %s"
-                              ucsize
-                              (archive-dosdate moddate)
-                              (archive-dostime modtime)
-                              ifnname)))
-        (setq maxlen (max maxlen fnlen)
-	      totalsize (+ totalsize ucsize)
-	      visual (cons (vector text
-				   (- (length text) (length ifnname))
-				   (length text))
-			   visual)
-	      files (cons (vector efnname ifnname fiddle nil (1- p))
-                          files)
-              p (+ p 29 csize))))
-    (goto-char (point-min))
-    (let ((dash (concat "- --------  -----------  --------  "
-			(make-string maxlen ?-)
-			"\n")))
-      (insert "M   Length  Date         Time      File\n"
-	      dash)
-      (archive-summarize-files (nreverse visual))
-      (insert dash
-	      (format "  %8d                         %d file%s"
-		      totalsize
-		      (length files)
-		      (if (= 1 (length files)) "" "s"))
-	      "\n"))
-    (apply 'vector (nreverse files))))
-
-(defun archive-arc-rename-entry (archive newname descr)
-  (if (string-match "[:\\\\/]" newname)
-      (error "File names in arc files may not contain a path"))
-  (if (> (length newname) 12)
-      (error "File names in arc files are limited to 12 characters"))
-  (let ((name (concat newname (substring "\0\0\0\0\0\0\0\0\0\0\0\0\0"
-					 (length newname))))
-	buffer-read-only)
-    (save-restriction
-      (save-excursion
-	(widen)
-	(goto-char (+ archive-proper-file-start (aref descr 4) 2))
-	(delete-char 13)
-	(insert name)))))
-;; -------------------------------------------------------------------------
-;; Section: Lzh Archives
-
-(defun archive-lzh-summarize ()
-  (let ((p 1)
-	(totalsize 0)
-	(maxlen 8)
-        files
-	visual)
-    (while (progn (goto-char p) (looking-at "..-l[hz][0-9]-"))
-      (let* ((hsize   (char-after p))
-             (csize   (archive-l-e (+ p 7) 4))
-             (ucsize  (archive-l-e (+ p 11) 4))
-	     (modtime (archive-l-e (+ p 15) 2))
-	     (moddate (archive-l-e (+ p 17) 2))
-	     (fnlen   (char-after (+ p 21)))
-	     (efnname (buffer-substring (+ p 22) (+ p 22 fnlen)))
-	     (fiddle  (string= efnname (upcase efnname)))
-             (ifnname (if fiddle (downcase efnname) efnname))
-	     (p2      (+ p 22 fnlen))
-	     (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
-	     (mode    (if (= creator ?U) (archive-l-e (+ p2 8) 2) ?\666))
-	     (modestr (if mode (archive-int-to-mode mode) "??????????"))
-	     (uid     (if (= creator ?U) (archive-l-e (+ p2 10) 2)))
-	     (gid     (if (= creator ?U) (archive-l-e (+ p2 12) 2)))
-	     (text    (if archive-alternate-display
-			  (format "  %8d  %5S  %5S  %s"
-				  ucsize
-				  (or uid "?")
-				  (or gid "?")
-				  ifnname)
-			(format "  %10s  %8d  %-11s  %-8s  %s"
-				modestr
-				ucsize
-				(archive-dosdate moddate)
-				(archive-dostime modtime)
-				ifnname))))
-        (setq maxlen (max maxlen fnlen)
-	      totalsize (+ totalsize ucsize)
-	      visual (cons (vector text
-				   (- (length text) (length ifnname))
-				   (length text))
-			   visual)
-	      files (cons (vector efnname ifnname fiddle mode (1- p))
-                          files)
-              p (+ p hsize 2 csize))))
-    (goto-char (point-min))
-    (let ((dash (concat (if archive-alternate-display
-			    "- --------  -----  -----  "
-			  "- ----------  --------  -----------  --------  ")
-			(make-string maxlen ?-)
-			"\n"))
-	  (header (if archive-alternate-display
-		       "M   Length    Uid    Gid  File\n"
-		    "M   Filemode    Length  Date         Time      File\n"))
-	  (sumline (if archive-alternate-display
-		       "  %8d                %d file%s"
-		     "              %8d                         %d file%s")))
-      (insert header dash)
-      (archive-summarize-files (nreverse visual))
-      (insert dash
-	      (format sumline
-		      totalsize
-		      (length files)
-		      (if (= 1 (length files)) "" "s"))
-	      "\n"))
-    (apply 'vector (nreverse files))))
-
-(defconst archive-lzh-alternate-display t)
-
-(defun archive-lzh-extract (archive name)
-  (archive-extract-by-stdout archive name archive-lzh-extract))
-
-(defun archive-lzh-resum (p count)
-  (let ((sum 0))
-    (while (> count 0)
-      (setq count (1- count)
-	    sum (+ sum (char-after p))
-	    p (1+ p)))
-    (logand sum 255)))
-
-(defun archive-lzh-rename-entry (archive newname descr)
-  (save-restriction
-    (save-excursion
-      (widen)
-      (let* ((p        (+ archive-proper-file-start (aref descr 4)))
-	     (oldhsize (char-after p))
-	     (oldfnlen (char-after (+ p 21)))
-	     (newfnlen (length newname))
-	     (newhsize (+ oldhsize newfnlen (- oldfnlen)))
-	     buffer-read-only)
-	(if (> newhsize 255)
-	    (error "The file name is too long"))
-	(goto-char (+ p 21))
-	(delete-char (1+ oldfnlen))
-	(insert newfnlen newname)
-	(goto-char p)
-	(delete-char 2)
-	(insert newhsize (archive-lzh-resum p newhsize))))))
-
-(defun archive-lzh-ogm (newval files errtxt ofs)
-  (save-restriction
-    (save-excursion
-      (widen)
-      (while files
-	(let* ((fil (car files))
-	       (p (+ archive-proper-file-start (aref fil 4)))
-	       (hsize   (char-after p))
-	       (fnlen   (char-after (+ p 21)))
-	       (p2      (+ p 22 fnlen))
-	       (creator (if (>= (- hsize fnlen) 24) (char-after (+ p2 2)) 0))
-	       buffer-read-only)
-	  (if (= creator ?U)
-	      (progn
-		(or (numberp newval)
-		    (setq newval (funcall newval (archive-l-e (+ p2 ofs) 2))))
-		(goto-char (+ p2 ofs))
-		(delete-char 2)
-		(insert (logand newval 255) (lsh newval -8))
-		(goto-char (1+ p))
-		(delete-char 1)
-		(insert (archive-lzh-resum (1+ p) hsize)))
-	    (message "Member %s does not have %s field"
-		     (aref fil 1) errtxt)))
-	(setq files (cdr files))))))
-
-(defun archive-lzh-chown-entry (newuid files)
-  (archive-lzh-ogm newuid files "an uid" 10))
-
-(defun archive-lzh-chgrp-entry (newgid files)
-  (archive-lzh-ogm newgid files "a gid" 12))
-
-(defun archive-lzh-chmod-entry (newmode files)
-  (archive-lzh-ogm
-   ;; This should work even though newmode will be dynamically accessed.
-   (function (lambda (old) (archive-calc-mode old newmode t)))
-   files "a unix-style mode" 8))
-;; -------------------------------------------------------------------------
-;; Section: Zip Archives
-
-(defun archive-zip-summarize ()
-  (goto-char (- (point-max) (- 22 18)))
-  (search-backward-regexp "[P]K\005\006")
-  (let ((p (1+ (archive-l-e (+ (point) 16) 4)))
-        (maxlen 8)
-	(totalsize 0)
-        files
-	visual)
-    (while (string= "PK\001\002" (buffer-substring p (+ p 4)))
-      (let* ((creator (char-after (+ p 5)))
-	     (method  (archive-l-e (+ p 10) 2))
-             (modtime (archive-l-e (+ p 12) 2))
-             (moddate (archive-l-e (+ p 14) 2))
-             (ucsize  (archive-l-e (+ p 24) 4))
-             (fnlen   (archive-l-e (+ p 28) 2))
-             (exlen   (archive-l-e (+ p 30) 2))
-             (fclen   (archive-l-e (+ p 32) 2))
-             (lheader (archive-l-e (+ p 42) 4))
-             (efnname (buffer-substring (+ p 46) (+ p 46 fnlen)))
-	     (isdir   (and (= ucsize 0)
-			   (string= (file-name-nondirectory efnname) "")))
-	     (mode    (cond ((memq creator '(2 3)) ; Unix + VMS
-			     (archive-l-e (+ p 40) 2))
-			    ((memq creator '(0 5 6 7 10 11)) ; Dos etc.
-			     (logior ?\444
-				     (if isdir (logior 16384 ?\111) 0)
-				     (if (zerop
-					  (logand 1 (char-after (+ p 38))))
-					 ?\222 0)))
-			    (t nil)))
-	     (modestr (if mode (archive-int-to-mode mode) "??????????"))
-	     (fiddle  (and archive-zip-case-fiddle
-			   (not (not (memq creator '(0 2 4 5 9))))))
-             (ifnname (if fiddle (downcase efnname) efnname))
-             (text    (format "  %10s  %8d  %-11s  %-8s  %s"
-			      modestr
-                              ucsize
-                              (archive-dosdate moddate)
-                              (archive-dostime modtime)
-                              ifnname)))
-        (setq maxlen (max maxlen fnlen)
-	      totalsize (+ totalsize ucsize)
-	      visual (cons (vector text
-				   (- (length text) (length ifnname))
-				   (length text))
-			   visual)
-	      files (cons (if isdir
-			      nil
-			    (vector efnname ifnname fiddle mode
-				    (list (1- p) lheader)))
-                          files)
-              p (+ p 46 fnlen exlen fclen))))
-    (goto-char (point-min))
-    (let ((dash (concat "- ----------  --------  -----------  --------  "
-			(make-string maxlen ?-)
-			"\n")))
-      (insert "M Filemode      Length  Date         Time      File\n"
-	      dash)
-      (archive-summarize-files (nreverse visual))
-      (insert dash
-	      (format "              %8d                         %d file%s"
-		      totalsize
-		      (length files)
-		      (if (= 1 (length files)) "" "s"))
-	      "\n"))
-    (apply 'vector (nreverse files))))
-
-(defun archive-zip-extract (archive name)
-  (if archive-zip-use-pkzip
-      (archive-*-extract archive name archive-zip-extract)
-    (archive-extract-by-stdout archive name archive-zip-extract)))
-
-(defun archive-zip-write-file-member (archive descr)
-  (archive-*-write-file-member
-   archive
-   descr
-   (if (aref descr 2) archive-zip-update-case archive-zip-update)))
-
-(defun archive-zip-chmod-entry (newmode files)
-  (save-restriction
-    (save-excursion
-      (widen)
-      (while files
-	(let* ((fil (car files))
-	       (p (+ archive-proper-file-start (car (aref fil 4))))
-	       (creator (char-after (+ p 5)))
-	       (oldmode (aref fil 3))
-	       (newval  (archive-calc-mode oldmode newmode t))
-	       buffer-read-only)
-	  (cond ((memq creator '(2 3)) ; Unix + VMS
-		 (goto-char (+ p 40))
-		 (delete-char 2)
-		 (insert (logand newval 255) (lsh newval -8)))
-		((memq creator '(0 5 6 7 10 11)) ; Dos etc.
-		 (goto-char (+ p 38))
-		 (insert (logior (logand (char-after (point)) 254)
-				 (logand (logxor 1 (lsh newval -7)) 1)))
-		 (delete-char 1))
-		(t (message "Don't know how to change mode for this member"))))
-	(setq files (cdr files))))))
-;; -------------------------------------------------------------------------
-;; Section: Zoo Archives
-
-(defun archive-zoo-summarize ()
-  (let ((p (1+ (archive-l-e 25 4)))
-        (maxlen 8)
-	(totalsize 0)
-        files
-	visual)
-    (while (and (string= "\334\247\304\375" (buffer-substring p (+ p 4)))
-		(> (archive-l-e (+ p 6) 4) 0))
-      (let* ((next    (1+ (archive-l-e (+ p 6) 4)))
-             (moddate (archive-l-e (+ p 14) 2))
-             (modtime (archive-l-e (+ p 16) 2))
-             (ucsize  (archive-l-e (+ p 20) 4))
-	     (namefld (buffer-substring (+ p 38) (+ p 38 13)))
-	     (dirtype (char-after (+ p 4)))
-	     (lfnlen  (if (= dirtype 2) (char-after (+ p 56)) 0))
-	     (ldirlen (if (= dirtype 2) (char-after (+ p 57)) 0))
-	     (fnlen   (+ ldirlen
-			 (if (> lfnlen 0)
-			     (1- lfnlen)
-			   (or (string-match "\0" namefld) 13))))
-	     (efnname (concat
-		       (if (> ldirlen 0)
-			   (concat (buffer-substring
-				    (+ p 58 lfnlen) (+ p 58 lfnlen ldirlen -1))
-				   "/")
-			 "")
-		       (if (> lfnlen 0)
-			   (buffer-substring (+ p 58) (+ p 58 lfnlen -1))
-			 (substring namefld 0 fnlen))))
-	     (fiddle  (and (= lfnlen 0) (string= efnname (upcase efnname))))
-             (ifnname (if fiddle (downcase efnname) efnname))
-             (text    (format "  %8d  %-11s  %-8s  %s"
-                              ucsize
-                              (archive-dosdate moddate)
-                              (archive-dostime modtime)
-                              ifnname)))
-        (setq maxlen (max maxlen fnlen)
-	      totalsize (+ totalsize ucsize)
-	      visual (cons (vector text
-				   (- (length text) (length ifnname))
-				   (length text))
-			   visual)
-	      files (cons (vector efnname ifnname fiddle nil (1- p))
-                          files)
-              p next)))
-    (goto-char (point-min))
-    (let ((dash (concat "- --------  -----------  --------  "
-			(make-string maxlen ?-)
-			"\n")))
-      (insert "M   Length  Date         Time      File\n"
-	      dash)
-      (archive-summarize-files (nreverse visual))
-      (insert dash
-	      (format "  %8d                         %d file%s"
-		      totalsize
-		      (length files)
-		      (if (= 1 (length files)) "" "s"))
-	      "\n"))
-    (apply 'vector (nreverse files))))
-
-(defun archive-zoo-extract (archive name)
-  (archive-extract-by-stdout archive name archive-zoo-extract))
-;; -------------------------------------------------------------------------
-(provide 'archive-mode)
-
-;; arc-mode.el ends here.
diff --git a/lisp/array.el b/lisp/array.el
deleted file mode 100644
index fab1c1ec59c..00000000000
--- a/lisp/array.el
+++ /dev/null
@@ -1,949 +0,0 @@
-;;; array.el --- array editing commands for Gnu Emacs
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author David M. Brown
-;; 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:
-
-;; Commands for editing a buffer interpreted as a rectangular array
-;; or matrix of whitespace-separated strings.  You specify the array
-;; dimensions and some other parameters at startup time.
-
-;;  Written by dmb%morgoth@harvard.harvard.edu (address is old)
-;;   (David M. Brown at Goldberg-Zoino & Associates, Inc.)
-;;  Thanks to cph@kleph.ai.mit.edu for assistance
-
-;; To do:
-;;   Smooth initialization process by grokking local variables list
-;;     at end of buffer or parsing buffer using whitespace as delimiters.
-;;   Make 'array-copy-column-right faster.
-
-
-;;; Code:
-
-;;; Internal information functions.
-  
-(defun array-cursor-in-array-range ()
-  "Returns t if the cursor is in a valid array cell.
-Its ok to be on a row number line."
-  (let ((columns-last-line (% max-column columns-per-line)))
-    ;; Requires buffer-line and buffer-column to be current.
-    (not (or
-	  ;; The cursor is too far to the right.
-	  (>= buffer-column line-length)
-	  ;; The cursor is below the last row.
-	  (>= buffer-line (* lines-per-row max-row))
-	  ;; The cursor is on the last line of the row, the line is smaller
-	  ;;  than the others, and the cursor is after the last array column
-	  ;;  on the line.
-	  (and (zerop (% (1+ buffer-line) lines-per-row))
-	       (not (zerop columns-last-line))
-	       (>= buffer-column (* columns-last-line field-width)))))))
-
-(defun array-current-row ()
-  "Return the array row of the field in which the cursor is located."
-  ;; Requires buffer-line and buffer-column to be current.
-  (and (array-cursor-in-array-range)
-       (1+ (floor buffer-line lines-per-row))))
-
-(defun array-current-column ()
-  "Return the array column of the field in which the cursor is located."
-  ;; Requires buffer-line and buffer-column to be current.
-  (and (array-cursor-in-array-range)
-       ;; It's not okay to be on a row number line.
-       (not (and rows-numbered
-		 (zerop (% buffer-line lines-per-row))))
-       (+
-	;; Array columns due to line differences.
-	(* columns-per-line
-	   (if rows-numbered
-	       (1- (% buffer-line lines-per-row))
-	     (% buffer-line lines-per-row)))
-	;; Array columns on the current line.
-	(1+ (floor buffer-column field-width)))))
-
-(defun array-update-array-position (&optional a-row a-column)
-  "Set `array-row' and `array-column' to their current values or
-to the optional arguments A-ROW and A-COLUMN."
-  ;; Requires that buffer-line and buffer-column be current.
-  (setq array-row (or a-row (array-current-row))
-	array-column (or a-column (array-current-column))))
-
-(defun array-update-buffer-position ()
-  "Set buffer-line and buffer-column to their current values."
-  (setq buffer-line (current-line)
-	buffer-column (current-column)))
-
-
-
-;;; Information commands.
-
-(defun array-what-position ()
-  "Display the row and column in which the cursor is positioned."
-  (interactive)
-  (let ((buffer-line (current-line))
-	(buffer-column (current-column)))
-    (message "Array row: %s  Array column: %s" 
-	     (prin1-to-string (array-current-row))
-	     (prin1-to-string (array-current-column)))))
-
-(defun array-display-local-variables ()
-  "Display the current state of the local variables in the minibuffer."
-  (interactive)
-  (let ((buf (buffer-name (current-buffer))))
-    (with-output-to-temp-buffer "*Local Variables*"
-      (buffer-disable-undo standard-output)
-      (terpri)
-      (princ (format " Buffer:             %s\n\n" buf))
-      (princ (format "  max-row:           %s\n"
-		     (prin1-to-string max-row)))
-      (princ (format "  max-column:        %s\n"
-		     (prin1-to-string max-column)))
-      (princ (format "  columns-per-line:  %s\n"
-		     (prin1-to-string columns-per-line)))
-      (princ (format "  field-width:       %s\n"
-		     (prin1-to-string field-width)))
-      (princ (format "  rows-numbered:     %s\n"
-		     (prin1-to-string rows-numbered)))
-      (princ (format "  lines-per-row:     %s\n"
-		     (prin1-to-string lines-per-row)))
-      (princ (format "  line-length:       %s\n"
-		     (prin1-to-string line-length))))))
-
-
-
-;;; Internal movement functions.
-
-(defun array-beginning-of-field (&optional go-there)
-   "Return the column of the beginning of the current field.
-Optional argument GO-THERE, if non-nil, means go there too."
-   ;; Requires that buffer-column be current.
-   (let ((goal-column (- buffer-column (% buffer-column field-width))))
-     (if go-there
-	 (move-to-column-untabify goal-column)
-       goal-column)))
-
-(defun array-end-of-field (&optional go-there)
-  "Return the column of the end of the current array field.
-If optional argument GO-THERE is non-nil, go there too."
-  ;; Requires that buffer-column be current.
-  (let ((goal-column (+ (- buffer-column (% buffer-column field-width))
-			field-width)))
-    (if go-there
-	(move-to-column-untabify goal-column)
-      goal-column)))
-
-(defun array-move-to-cell (a-row a-column)
-  "Move to array row A-ROW and array column A-COLUMN.  
-Leave point at the beginning of the field and return the new buffer column."
-  (let ((goal-line (+ (* lines-per-row (1- a-row))
-		      (if rows-numbered 1 0)
-		      (floor (1- a-column) columns-per-line)))
-	(goal-column (* field-width (% (1- a-column) columns-per-line))))
-    (goto-char (point-min))
-    (forward-line goal-line)
-    (move-to-column-untabify goal-column)))
-
-(defun array-move-to-row (a-row)
-  "Move to array row A-ROW preserving the current array column.
-Leave point at the beginning of the field and return the new array row."
-  ;; Requires that buffer-line and buffer-column be current.
-  (let ((goal-line (+ (* lines-per-row (1- a-row))
-		      (% buffer-line lines-per-row)))
-	(goal-column (- buffer-column (% buffer-column field-width))))
-    (forward-line (- goal-line buffer-line))
-    (move-to-column-untabify goal-column)
-    a-row))
-
-(defun array-move-to-column (a-column)
-  "Move to array column A-COLUMN preserving the current array row.
-Leave point at the beginning of the field and return the new array column."
-  ;; Requires that buffer-line and buffer-column be current.
-  (let ((goal-line (+ (- buffer-line (% buffer-line lines-per-row))
-		      (if rows-numbered 1 0)
-		      (floor (1- a-column) columns-per-line)))
-	(goal-column (* field-width (% (1- a-column) columns-per-line))))
-    (forward-line (- goal-line buffer-line))
-    (move-to-column-untabify goal-column)
-    a-column))
-
-(defun array-move-one-row (sign)
-  "Move one array row in direction SIGN (1 or -1).
-Leave point at the beginning of the field and return the new array row.
-If requested to move beyond the array bounds, signal an error."
-  ;; Requires that buffer-line and buffer-column be current.
-  (let ((goal-column (array-beginning-of-field))
-	(array-row (or (array-current-row)
-		       (error "Cursor is not in a valid array cell."))))
-    (cond ((and (= array-row max-row) (= sign 1))
-	   (error "End of array."))
-	  ((and (= array-row 1) (= sign -1))
-	   (error "Beginning of array."))
-	  (t
-	   (progn
-	     (forward-line (* sign lines-per-row))
-	     (move-to-column-untabify goal-column)
-	     (+ array-row sign))))))
-
-(defun array-move-one-column (sign)
-  "Move one array column in direction SIGN (1 or -1).
-Leave point at the beginning of the field and return the new array column.
-If requested to move beyond the array bounds, signal an error."
-  ;; Requires that buffer-line and buffer-column be current.
-  (let ((array-column (or (array-current-column)
-		      (error "Cursor is not in a valid array cell."))))
-    (cond ((and (= array-column max-column) (= sign 1))
-	   (error "End of array."))
-	  ((and (= array-column 1) (= sign -1))
-	   (error "Beginning of array."))
-	  (t
-	   (cond 
-	    ;; Going backward from first column on the line.
-	    ((and (= sign -1) (= 1 (% array-column columns-per-line)))
-	     (forward-line -1)
-	     (move-to-column-untabify
-	      (* field-width (1- columns-per-line))))
-	    ;; Going forward from last column on the line.
-	    ((and (= sign 1) (zerop (% array-column columns-per-line)))
-	     (forward-line 1))
-	    ;; Somewhere in the middle of the line.
-	    (t
-	     (move-to-column-untabify (+ (array-beginning-of-field)
-					 (* field-width sign)))))
-	   (+ array-column sign)))))
-
-(defun array-normalize-cursor ()
-  "Move the cursor to the first non-whitespace character in the field and,
-if necessary, scroll horizontally to keep the cursor in view."
-  ;; Assumes point is at the beginning of the field.
-  (let ((buffer-column (current-column)))
-    (skip-chars-forward " \t"
-			(1- (save-excursion (array-end-of-field t) (point))))
-    (array-maybe-scroll-horizontally)))
-
-(defun array-maybe-scroll-horizontally ()
-  "If necessary, scroll horizontally to keep the cursor in view."
-  ;; This is only called from array-normalize-cursor so
-  ;;  buffer-column will always be current.
-  (let ((w-hscroll (window-hscroll))
-	(w-width (window-width)))
-    (cond
-     ((and (>= buffer-column w-hscroll)
-	   (<= buffer-column (+ w-hscroll w-width)))
-      ;; It's already visible.  Do nothing.
-      nil)
-     ((> buffer-column (+ w-hscroll w-width))
-      ;; It's to the right.  Scroll left.
-      (scroll-left (- (- buffer-column w-hscroll)
-		      (/ w-width 2))))
-     (t
-      ;; It's to the left.  Scroll right.
-      (scroll-right (+ (- w-hscroll buffer-column)
-		       (/ w-width 2)))))))
-
-
-
-;;; Movement commands.
-
-(defun array-next-row (&optional arg)
-  "Move down one array row, staying in the current array column.
-If optional ARG is given, move down ARG array rows."
-  (interactive "p")
-  (let ((buffer-line (current-line))
-	(buffer-column (current-column)))
-    (if (= (abs arg) 1)
-	(array-move-one-row arg)
-      (array-move-to-row
-       (limit-index (+ (or (array-current-row)
-			   (error "Cursor is not in an array cell."))
-		       arg)
-		    max-row))))
-  (array-normalize-cursor))
-
-(defun array-previous-row (&optional arg)
-  "Move up one array row, staying in the current array column.
-If optional ARG is given, move up ARG array rows."
-  (interactive "p")
-  (array-next-row (- arg)))
-
-(defun array-forward-column (&optional arg)
-  "Move forward one field, staying in the current array row.
-If optional ARG is given, move forward ARG array columns.
-If necessary, keep the cursor in the window by scrolling right or left."
-  (interactive "p")
-  (let ((buffer-line (current-line))
-	(buffer-column (current-column)))
-    (if (= (abs arg) 1)
-	(array-move-one-column arg)
-      (array-move-to-column
-       (limit-index (+ (or (array-current-column)
-			   (error "Cursor is not in an array cell."))
-		       arg)
-		    max-column))))
-  (array-normalize-cursor))
-
-(defun array-backward-column (&optional arg)
-  "Move backward one field, staying in the current array row.
-If optional ARG is given, move backward ARG array columns.
-If necessary, keep the cursor in the window by scrolling right or left."
-  (interactive "p")
-  (array-forward-column (- arg)))
-
-(defun array-goto-cell (a-row a-column)
-  "Go to array row A-ROW and array column A-COLUMN."
-  (interactive "nArray row: \nnArray column: ")
-  (array-move-to-cell
-   (limit-index a-row max-row)
-   (limit-index a-column max-column))
-  (array-normalize-cursor))
-
-
-
-;;; Internal copying functions.
-
-(defun array-field-string ()
-  "Return the field string at the current cursor location."
-  ;; Requires that buffer-column be current.
-  (buffer-substring
-   (save-excursion (array-beginning-of-field t) (point))
-   (save-excursion (array-end-of-field t) (point))))
-
-(defun array-copy-once-vertically (sign)
-  "Copy the current field into one array row in direction SIGN (1 or -1).
-Leave point at the beginning of the field and return the new array row.
-If requested to move beyond the array bounds, signal an error."
-  ;; Requires that buffer-line, buffer-column, and copy-string be current.
-  (let ((a-row (array-move-one-row sign)))
-    (let ((inhibit-quit t))
-      (delete-region (point) (save-excursion (array-end-of-field t) (point)))
-      (insert copy-string))
-    (move-to-column buffer-column)
-    a-row))
-
-(defun array-copy-once-horizontally (sign)
-  "Copy the current field into one array column in direction SIGN (1 or -1).
-Leave point at the beginning of the field and return the new array column.
-If requested to move beyond the array bounds, signal an error."
-  ;; Requires that buffer-line, buffer-column, and copy-string be current.
-  (let ((a-column (array-move-one-column sign)))
-    (array-update-buffer-position)
-    (let ((inhibit-quit t))
-      (delete-region (point) (save-excursion (array-end-of-field t) (point)))
-      (insert copy-string))
-    (move-to-column buffer-column)
-    a-column))
-
-(defun array-copy-to-row (a-row)
-  "Copy the current field vertically into every cell up to and including A-ROW.
-Leave point at the beginning of the field."
-  ;; Requires that buffer-line, buffer-column, array-row, and
-  ;;  copy-string be current.
-  (let* ((num (- a-row array-row))
-	 (count (abs num))
-	 (sign (if (zerop count) () (/ num count))))
-    (while (> count 0)
-      (array-move-one-row sign)
-      (array-update-buffer-position)
-      (let ((inhibit-quit t))
-	(delete-region (point) (save-excursion (array-end-of-field t) (point)))
-	(insert copy-string))
-      (move-to-column buffer-column)
-      (setq count (1- count)))))
-	
-(defun array-copy-to-column (a-column)
-  "Copy the current field horizontally into every cell up to and including
-A-COLUMN.  Leave point at the beginning of the field."
-  ;; Requires that buffer-line, buffer-column, array-column, and
-  ;;  copy-string be current.
-  (let* ((num (- a-column array-column))
-	 (count (abs num))
-	 (sign (if (zerop count) () (/ num count))))
-    (while (> count 0)
-      (array-move-one-column sign)
-      (array-update-buffer-position)
-      (let ((inhibit-quit t))
-	(delete-region (point) (save-excursion (array-end-of-field t) (point)))
-	(insert copy-string))
-      (move-to-column buffer-column)
-      (setq count (1- count)))))
-
-(defun array-copy-to-cell (a-row a-column)
-  "Copy the current field into the cell at A-ROW, A-COLUMN.
-Leave point at the beginning of the field."
-  ;; Requires that copy-string be current.
-  (array-move-to-cell a-row a-column)
-  (array-update-buffer-position)
-  (delete-region (point) (save-excursion (array-end-of-field t) (point)))
-  (insert copy-string)
-  (move-to-column buffer-column))
-
-
-
-;;; Commands for copying.
-
-(defun array-copy-down (&optional arg)
-  "Copy the current field one array row down.
-If optional ARG is given, copy down through ARG array rows."
-  (interactive "p")
-  (let* ((buffer-line (current-line))
-	 (buffer-column (current-column))
-	 (array-row (or (array-current-row)
-			   (error "Cursor is not in a valid array cell.")))
-	 (copy-string (array-field-string)))
-    (if (= (abs arg) 1)
-	(array-copy-once-vertically arg)
-      (array-copy-to-row
-       (limit-index (+ array-row arg) max-row))))
-  (array-normalize-cursor))
-
-(defun array-copy-up (&optional arg)
-  "Copy the current field one array row up.
-If optional ARG is given, copy up through ARG array rows."
-  (interactive "p")
-  (array-copy-down (- arg)))
-
-(defun array-copy-forward (&optional arg)
-  "Copy the current field one array column to the right.
-If optional ARG is given, copy through ARG array columns to the right."
-  (interactive "p")
-  (let* ((buffer-line (current-line))
-	 (buffer-column (current-column))
-	 (array-column (or (array-current-column)
-			   (error "Cursor is not in a valid array cell.")))
-	 (copy-string (array-field-string)))
-    (if (= (abs arg) 1)
-	(array-copy-once-horizontally arg)
-      (array-copy-to-column
-       (limit-index (+ array-column arg) max-column))))
-  (array-normalize-cursor))
-
-(defun array-copy-backward (&optional arg)
-  "Copy the current field one array column to the left.
-If optional ARG is given, copy through ARG array columns to the left."
-  (interactive "p")
-  (array-copy-forward (- arg)))
-
-(defun array-copy-column-forward (&optional arg)
-  "Copy the entire current column in to the column to the right.
-If optional ARG is given, copy through ARG array columns to the right."
-  (interactive "p")
-  (array-update-buffer-position)
-  (array-update-array-position)
-  (if (not array-column)
-      (error "Cursor is not in a valid array cell."))
-  (message "Working...")
-  (let ((this-row 0))
-    (while (< this-row max-row)
-      (setq this-row (1+ this-row))
-      (array-move-to-cell this-row array-column)
-      (array-update-buffer-position)
-      (let ((copy-string (array-field-string)))
-	(if (= (abs arg) 1)
-	    (array-copy-once-horizontally arg)
-	  (array-copy-to-column
-	   (limit-index (+ array-column arg) max-column))))))
-  (message "Working...done")
-  (array-move-to-row array-row)
-  (array-normalize-cursor))
-
-(defun array-copy-column-backward (&optional arg)
-  "Copy the entire current column one column to the left.
-If optional ARG is given, copy through ARG columns to the left."
-  (interactive "p")
-  (array-copy-column-forward (- arg)))
-
-(defun array-copy-row-down (&optional arg)
-  "Copy the entire current row one row down.
-If optional ARG is given, copy through ARG rows down."
-  (interactive "p")
-  (array-update-buffer-position)
-  (array-update-array-position)
-  (if (not array-row)
-      (error "Cursor is not in a valid array cell."))
-  (cond
-   ((and (= array-row 1) (= arg -1))
-    (error "Beginning of array."))
-   ((and (= array-row max-row) (= arg 1))
-    (error "End of array."))
-   (t
-    (let* ((copy-string
-	    (buffer-substring
-	     (save-excursion (array-move-to-cell array-row 1)
-			     (point))
-	     (save-excursion (array-move-to-cell array-row max-column)
-			     (forward-line 1)
-			     (point))))
-	   (this-row array-row)
-	   (goal-row (limit-index (+ this-row arg) max-row))
-	   (num (- goal-row this-row))
-	   (count (abs num))
-	   (sign (if (not (zerop count)) (/ num count))))
-      (while (> count 0)
-	(setq this-row (+ this-row sign))
-	(array-move-to-cell this-row 1)
-	(let ((inhibit-quit t))
-	  (delete-region (point)
-			 (save-excursion
-			   (array-move-to-cell this-row max-column)
-			   (forward-line 1)
-			   (point)))
-	  (insert copy-string))
-	(setq count (1- count)))
-      (array-move-to-cell goal-row (or array-column 1)))))
-  (array-normalize-cursor))
-
-(defun array-copy-row-up (&optional arg)
-  "Copy the entire current array row into the row above.
-If optional ARG is given, copy through ARG rows up."
-  (interactive "p")
-  (array-copy-row-down (- arg)))
-
-(defun array-fill-rectangle ()
-  "Copy the field at mark into every cell between mark and point."
-  (interactive)
-  ;; Bind arguments.
-  (array-update-buffer-position)
-  (let ((p-row (or (array-current-row)
-		   (error "Cursor is not in a valid array cell.")))
-	(p-column (or (array-current-column)
-		      (error "Cursor is not in a valid array cell.")))
-	(m-row
-	 (save-excursion
-	   (exchange-point-and-mark)
-	   (array-update-buffer-position)
-	   (or (array-current-row)
-	       (error "Mark is not in a valid array cell."))))
-	(m-column 
-	 (save-excursion
-	   (exchange-point-and-mark)
-	   (array-update-buffer-position)
-	   (or (array-current-column)
-	       (error "Mark is not in a valid array cell.")))))
-    (message "Working...")
-    (let ((top-row (min m-row p-row))
-	  (bottom-row (max m-row p-row))
-	  (left-column (min m-column p-column))
-	  (right-column (max m-column p-column)))
-      ;; Do the first row.
-      (let ((copy-string
-	     (save-excursion
-	       (array-move-to-cell m-row m-column)
-	       (array-update-buffer-position)
-	       (array-field-string))))
-	(array-copy-to-cell top-row left-column)
-	(array-update-array-position top-row left-column)
-	(array-update-buffer-position)
-	(array-copy-to-column right-column))
-      ;; Do the rest of the rows.
-      (array-move-to-cell top-row left-column)
-      (let ((copy-string
-	     (buffer-substring
-	      (point)
-	      (save-excursion
-		(array-move-to-cell top-row right-column)
-		(setq buffer-column (current-column))
-		(array-end-of-field t)
-		(point))))
-	    (this-row top-row))
-	(while (/= this-row bottom-row)
-	  (setq this-row (1+ this-row))
-	  (array-move-to-cell this-row left-column)
-	  (let ((inhibit-quit t))
-	    (delete-region
-	     (point)
-	     (save-excursion
-	       (array-move-to-cell this-row right-column)
-	       (setq buffer-column (current-column))
-	       (array-end-of-field t)
-	       (point)))
-	    (insert copy-string)))))
-    (message "Working...done")
-    (array-goto-cell p-row p-column)))
-
-
-
-;;; Reconfiguration of the array.
-
-(defun array-make-template ()
-  "Create the template of an array."
-  (interactive)
-  ;; If there is a conflict between field-width and init-string, resolve it.
-  (let ((check t)
-	(len))
-    (while check
-      (setq init-field (read-input "Initial field value: "))
-      (setq len (length init-field))
-      (if (/= len field-width)
-	  (if (y-or-n-p (format "Change field width to %d? " len))
-	      (progn (setq field-width len)
-		     (setq check nil)))
-	(setq check nil))))
-  (goto-char (point-min))
-  (message "Working...")
-  (let ((this-row 1))
-    ;; Loop through the rows.
-    (while (<= this-row max-row)
-      (if rows-numbered
-	  (insert (format "%d:\n" this-row)))
-      (let ((this-column 1))
-	;; Loop through the columns.
-	(while (<= this-column max-column)
-	  (insert init-field)
-	  (if (and (zerop (% this-column columns-per-line))
-		   (/= this-column max-column))
-	      (newline))
-	  (setq this-column (1+ this-column))))
-      (setq this-row (1+ this-row))
-      (newline)))
-  (message "Working...done")
-  (array-goto-cell 1 1))
-
-(defun array-reconfigure-rows (new-columns-per-line new-rows-numbered)
-  "Reconfigure the state of `rows-numbered' and `columns-per-line'.
-NEW-COLUMNS-PER-LINE is the desired value of `columns-per-line' and
-NEW-ROWS-NUMBERED (a character, either ?y or ?n) is the desired value
-of rows-numbered."
-  (interactive "nColumns per line: \ncRows numbered? (y or n) ")
-  ;; Check on new-columns-per-line
-  (let ((check t))
-    (while check
-      (if (and (>= new-columns-per-line 1)
-	       (<= new-columns-per-line max-column))
-	  (setq check nil)
-	(setq new-columns-per-line
-	      (string-to-int 
-	       (read-input 
-		(format "Columns per line (1 - %d): " max-column)))))))
-  ;; Check on new-rows-numbered.  It has to be done this way
-  ;;  because interactive does not have y-or-n-p.
-  (cond
-   ((eq new-rows-numbered ?y)
-    (setq new-rows-numbered t))
-   ((eq new-rows-numbered ?n)
-    (setq new-rows-numbered nil))
-   (t
-    (setq new-rows-numbered (y-or-n-p "Rows numbered? "))))
-  (message "Working...")
-  (array-update-buffer-position)
-  (let* ((main-buffer (buffer-name (current-buffer)))
-	 (temp-buffer (make-temp-name "Array"))
-	 (temp-max-row max-row)
-	 (temp-max-column max-column)
-	 (old-rows-numbered rows-numbered)
-	 (old-columns-per-line columns-per-line)
-	 (old-lines-per-row lines-per-row)
-	 (old-field-width field-width)
-	 (old-line-length line-length)
-	 (this-row 1))
-    (array-update-array-position)
-    ;; Do the cutting in a temporary buffer.
-    (copy-to-buffer temp-buffer (point-min) (point-max))
-    (set-buffer temp-buffer)
-    (goto-char (point-min))
-    (while (<= this-row temp-max-row)
-      ;; Deal with row number.
-      (cond
-       ((or (and old-rows-numbered new-rows-numbered)
-	    (and (not old-rows-numbered) (not new-rows-numbered)))
-	;; Nothing is changed.
-	())
-       ((and old-rows-numbered (not new-rows-numbered))
-	;; Delete the row number.
-	(kill-line 1))
-       (t
-	;; Add the row number.
-	(insert-string (format "%d:\n" this-row))))
-      ;; Deal with the array columns in this row.
-      (cond
-       ((= old-columns-per-line new-columns-per-line)
-	;; Nothing is changed.  Go to the next row.
-	(forward-line (- old-lines-per-row (if old-rows-numbered 1 0))))
-       (t
-	;; First expand the row.  Then cut it up into new pieces.
-	(let ((newlines-to-be-removed
-	       (floor (1- temp-max-column) old-columns-per-line))
-	      (newlines-removed 0)
-	      (newlines-to-be-added
-	       (floor (1- temp-max-column) new-columns-per-line))
-	      (newlines-added 0))
-	  (while (< newlines-removed newlines-to-be-removed)
-	    (move-to-column-untabify
-	     (* (1+ newlines-removed) old-line-length))
-	    (kill-line 1)
-	    (setq newlines-removed (1+ newlines-removed)))
-	  (beginning-of-line)
-	  (while (< newlines-added newlines-to-be-added)
-	    (move-to-column-untabify (* old-field-width new-columns-per-line))
-	    (newline)
-	    (setq newlines-added (1+ newlines-added)))
-	  (forward-line 1))))
-      (setq this-row (1+ this-row)))
-    (let ((inhibit-quit t))
-      (set-buffer main-buffer)
-      (erase-buffer)
-      (insert-buffer temp-buffer) 
-      ;; Update local variables.
-      (setq columns-per-line new-columns-per-line)
-      (setq rows-numbered new-rows-numbered)
-      (setq line-length (* old-field-width new-columns-per-line))
-      (setq lines-per-row 
-	    (+ (floor (1- temp-max-column) new-columns-per-line)
-	       (if new-rows-numbered 2 1)))
-      (array-goto-cell (or array-row 1) (or array-column 1)))
-    (kill-buffer temp-buffer))
-  (message "Working...done"))
-
-(defun array-expand-rows ()
-  "Expand the rows so each fits on one line and remove row numbers."
-  (interactive)
-  (array-reconfigure-rows max-column ?n))
-
-
-
-;;; Utilities.
-
-(defun limit-index (index limit)
-  (cond ((< index 1) 1)
-	((> index limit) limit)
-	(t index)))
-
-(defun xor (pred1 pred2)
-  "Returns the logical exclusive or of predicates PRED1 and PRED2."
-  (and (or pred1 pred2)
-       (not (and pred1 pred2))))
-
-(defun current-line ()
-  "Return the current buffer line at point.  The first line is 0." 
-  (save-excursion
-    (beginning-of-line)
-    (count-lines (point-min) (point))))
-
-(defun move-to-column-untabify (column)
-  "Move to COLUMN on the current line, untabifying if necessary.
-Return COLUMN."
-  (or (and (= column (move-to-column column))
-	   column)
-      ;; There is a tab in the way.
-      (if respect-tabs
-	  (error "There is a TAB character in the way.")
-	(progn
-	  (untabify-backward)
-	  (move-to-column column)))))
-
-(defun untabify-backward ()
-  "Untabify the preceding tab."
-  (save-excursion
-    (let ((start (point)))
-      (backward-char 1)
-      (untabify (point) start))))
-
-
-
-;;; Array mode.
-
-(defvar array-mode-map nil 
-  "Keymap used in array mode.")
-
-(if array-mode-map
-    ()
-  (setq array-mode-map (make-keymap))
-  ;; Bind keys.
-  (define-key array-mode-map "\M-ad"   'array-display-local-variables)
-  (define-key array-mode-map "\M-am"   'array-make-template)
-  (define-key array-mode-map "\M-ae"   'array-expand-rows)
-  (define-key array-mode-map "\M-ar"   'array-reconfigure-rows)
-  (define-key array-mode-map "\M-a="   'array-what-position)
-  (define-key array-mode-map "\M-ag"   'array-goto-cell)
-  (define-key array-mode-map "\M-af"   'array-fill-rectangle)
-  (define-key array-mode-map "\C-n"    'array-next-row)
-  (define-key array-mode-map "\C-p"    'array-previous-row)
-  (define-key array-mode-map "\C-f"    'array-forward-column)
-  (define-key array-mode-map "\C-b"    'array-backward-column)
-  (define-key array-mode-map "\M-n"    'array-copy-down)
-  (define-key array-mode-map "\M-p"    'array-copy-up)
-  (define-key array-mode-map "\M-f"    'array-copy-forward)
-  (define-key array-mode-map "\M-b"    'array-copy-backward)
-  (define-key array-mode-map "\M-\C-n" 'array-copy-row-down)
-  (define-key array-mode-map "\M-\C-p" 'array-copy-row-up)
-  (define-key array-mode-map "\M-\C-f" 'array-copy-column-forward)
-  (define-key array-mode-map "\M-\C-b" 'array-copy-column-backward))
-
-(put 'array-mode 'mode-class 'special)
-
-(defun array-mode ()
-  "Major mode for editing arrays.
-
-  Array mode is a specialized mode for editing arrays.  An array is
-considered to be a two-dimensional set of strings.  The strings are
-NOT recognized as integers or real numbers.
-
-  The array MUST reside at the top of the buffer.  
-
-  TABs are not respected, and may be converted into spaces at any time.
-Setting the variable 'respect-tabs to non-nil will prevent TAB conversion,
-but will cause many functions to give errors if they encounter one.
-
-  Upon entering array mode, you will be prompted for the values of
-several variables.  Others will be calculated based on the values you
-supply.  These variables are all local the the buffer.  Other buffer
-in array mode may have different values assigned to the variables.
-The variables are:
-
-Variables you assign:
-     max-row:          The number of rows in the array.
-     max-column:       The number of columns in the array. 
-     columns-per-line: The number of columns in the array per line of buffer.
-     field-width:      The width of each field, in characters.
-     rows-numbered:    A logical variable describing whether to ignore
-                       row numbers in the buffer.
-
-Variables which are calculated:
-     line-length:      The number of characters in a buffer line.
-     lines-per-row:    The number of buffer lines used to display each row.
-
-  The following commands are available (an asterisk indicates it may
-take a numeric prefix argument):
-
-    *  	\\<array-mode-map>\\[array-forward-column]	  Move forward one column.
-    *  	\\[array-backward-column]	  Move backward one column.
-    *  	\\[array-next-row]	  Move down one row.
-    *  	\\[array-previous-row]	  Move up one row.
-
-    *   \\[array-copy-forward]	  Copy the current field into the column to the right.
-    *   \\[array-copy-backward]	  Copy the current field into the column to the left.
-    *   \\[array-copy-down]	  Copy the current field into the row below.
-    *   \\[array-copy-up]	  Copy the current field into the row above.
-
-    *   \\[array-copy-column-forward]   Copy the current column into the column to the right.
-    *   \\[array-copy-column-backward]   Copy the current column into the column to the left.
-    *   \\[array-copy-row-down]   Copy the current row into the row below.
-    *   \\[array-copy-row-up]   Copy the current row into the row above.
-
-        \\[array-fill-rectangle]   Copy the field at mark into every cell with row and column
-                  between that of point and mark.
-
-	\\[array-what-position]	  Display the current array row and column.
-	\\[array-goto-cell]	  Go to a particular array cell.
-
-	\\[array-make-template]	  Make a template for a new array.
-	\\[array-reconfigure-rows]	  Reconfigure the array.
-        \\[array-expand-rows]   Expand the array (remove row numbers and
-                  newlines inside rows)
-
-        \\[array-display-local-variables]   Display the current values of local variables.
-
-Entering array mode calls the function `array-mode-hook'."
-
-  (interactive)
-  ;; Number of rows in the array.
-  (make-local-variable 'max-row)    
-  ;; Number of columns in the array.
-  (make-local-variable 'max-column)    
-  ;; Number of array columns per line.
-  (make-local-variable 'columns-per-line) 
-  ;; Width of a field in the array.
-  (make-local-variable 'field-width)   
-  ;; Are rows numbered in the buffer?
-  (make-local-variable 'rows-numbered) 
-  ;; Length of a line in the array.
-  (make-local-variable 'line-length)   
-  ;; Number of lines per array row.
-  (make-local-variable 'lines-per-row) 
-  ;; Current line number of point in the buffer.
-  (make-local-variable 'buffer-line)
-  ;; Current column number of point in the buffer.
-  (make-local-variable 'buffer-column)
-  ;; Current array row location of point.
-  (make-local-variable 'array-row)
-  ;; Current array column location of point.
-  (make-local-variable 'array-column)
-  ;; Current field string being copied.
-  (make-local-variable 'copy-string)
-  ;; Should TAB conversion be prevented?
-  (make-local-variable 'respect-tabs)
-  (setq respect-tabs nil)
-  (array-init-local-variables)
-  (setq major-mode 'array-mode)
-  (setq mode-name "Array")
-  (force-mode-line-update)
-  (make-variable-buffer-local 'truncate-lines)
-  (setq truncate-lines t)
-  (setq overwrite-mode 'overwrite-mode-textual)
-  (use-local-map array-mode-map)
-  (run-hooks 'array-mode-hook))
-
-
-
-;;; Initialization functions.  These are not interactive.
-
-(defun array-init-local-variables ()
-  "Initialize the variables associated with the
-array in this buffer."
-  (array-init-max-row)
-  (array-init-max-column)
-  (array-init-columns-per-line)
-  (array-init-field-width)
-  (array-init-rows-numbered)
-  (array-init-line-length)
-  (array-init-lines-per-row)
-  (message ""))
-
-(defun array-init-max-row (&optional arg)
-  "Initialize the value of max-row."
-  (setq max-row
-	(or arg (string-to-int (read-input "Number of array rows: ")))))
-
-(defun array-init-max-column (&optional arg)
-  "Initialize the value of max-column."
-  (setq max-column
-	(or arg (string-to-int (read-input "Number of array columns: ")))))
-
-(defun array-init-columns-per-line (&optional arg)
-  "Initialize the value of columns-per-line."
-  (setq columns-per-line 
-	(or arg (string-to-int (read-input "Array columns per line: ")))))
-
-(defun array-init-field-width (&optional arg)
-  "Initialize the value of field-width."
-  (setq field-width 
-	(or arg (string-to-int (read-input "Field width: ")))))
-
-(defun array-init-rows-numbered (&optional arg)
-  "Initialize the value of rows-numbered."
-  (setq rows-numbered 
-	(or arg (y-or-n-p "Rows numbered? "))))
-
-(defun array-init-line-length (&optional arg)
-  "Initialize the value of line-length."
-  (setq line-length
-	(or arg
-	  (* field-width columns-per-line))))
-
-(defun array-init-lines-per-row (&optional arg)
-  "Initialize the value of lines-per-row."
-  (setq lines-per-row
-	(or arg
-	  (+ (floor (1- max-column) columns-per-line)
-	     (if rows-numbered 2 1)))))
-
-;;; array.el ends here
diff --git a/lisp/auto-show.el b/lisp/auto-show.el
deleted file mode 100644
index 2cae3c334e0..00000000000
--- a/lisp/auto-show.el
+++ /dev/null
@@ -1,114 +0,0 @@
-;;; auto-show.el --- perform automatic horizontal scrolling as point moves
-;;; This file is in the public domain.
-
-;;; Keywords: scroll display minor-mode
-;;; Author: Pete Ware <ware@cis.ohio-state.edu>
-;;; Maintainer: FSF
-
-;;; Commentary:
-
-;;; This file provides functions that
-;;; automatically scroll the window horizontally when the point moves
-;;; off the left or right side of the window.
-
-;;; Once this library is loaded, automatic horizontal scrolling
-;;; occurs whenever long lines are being truncated.
-;;; To request truncation of long lines, set the variable
-;;; Setting the variable `truncate-lines' to non-nil.
-;;; You can do this for all buffers as follows:
-;;;
-;;; (set-default 'truncate-lines t)
-
-;;; Here is how to do it for C mode only:
-;;;
-;;; (set-default 'truncate-lines nil)	; this is the original value
-;;; (defun my-c-mode-hook ()
-;;;   "Run when C-mode starts up.  Changes ..."
-;;;   ... set various personal preferences ...
-;;;   (setq truncate-lines t))
-;;; (add-hook 'c-mode-hook 'my-c-mode-hook)
-;;;
-;;;
-;;; As a finer level of control, you can still have truncated lines but
-;;; without the automatic horizontal scrolling by setting the buffer
-;;; local variable `auto-show-mode' to nil.  The default value is t.
-;;; The command `auto-show-mode' toggles the value of the variable
-;;; `auto-show-mode'.
-
-;;; Code:
-
-(defvar auto-show-mode t
-  "*Non-nil enables automatic horizontal scrolling, when lines are truncated.
-The default value is t.  To change the default, do this:
-	(set-default 'auto-show-mode nil)
-See also command `auto-show-mode'.
-This variable has no effect when lines are not being truncated.")
-
-(make-variable-buffer-local 'auto-show-mode)
-
-(defvar auto-show-shift-amount 8 
-  "*Extra columns to scroll. for automatic horizontal scrolling.")
-
-(defvar auto-show-show-left-margin-threshold 50
-  "*Threshold column for automatic horizontal scrolling to the right.
-If point is before this column, we try to scroll to make the left margin
-visible.  Setting this to 0 disables this feature.")
-
-(defun auto-show-truncationp ()
-  "True if line truncation is enabled for the selected window."
-  (or truncate-lines 
-      (and truncate-partial-width-windows
-	   (< (window-width) (frame-width)))))
-
-;;;###autoload
-(defun auto-show-mode (arg)
-  "Turn automatic horizontal scroll mode on or off.
-With arg, turn auto scrolling on if arg is positive, off otherwise."
-  (interactive "P")
-  (setq auto-show-mode
-	(if (null arg)
-	    (not auto-show-mode)
-	  (> (prefix-numeric-value arg) 0))))
-  
-(defun auto-show-make-point-visible (&optional ignore-arg)
-  "Scroll horizontally to make point visible, if that is enabled.
-This function only does something if `auto-show-mode' is non-nil
-and longlines are being truncated in the selected window.
-See also the command `auto-show-toggle'."
-  (interactive)
-  (if (and auto-show-mode (auto-show-truncationp)
-	   (equal (window-buffer) (current-buffer)))
-      (let* ((col (current-column))	;column on line point is at
-	     (scroll (window-hscroll))	;how far window is scrolled
-	     (w-width (- (window-width) 
-			 (if (> scroll 0)
-			     2 1)))	;how wide window is on the screen
-	     (right-col (+ scroll w-width)))
-	(if (and (< col auto-show-show-left-margin-threshold)
-		 (< col (window-width))
-		 (> scroll 0))
-	    (scroll-right scroll)
-	  (if (< col scroll)		;to the left of the screen
-	      (scroll-right (+ (- scroll col) auto-show-shift-amount))
-	    (if (or (> col right-col)	;to the right of the screen
-		    (and (= col right-col)
-			 (not (eolp))))
-		(scroll-left (+ auto-show-shift-amount 
-				(- col (+ scroll w-width))))
-	      )
-	    )
-	  )
-	)
-    )
-  )
-
-;; Do auto-scrolling after commands.
-(add-hook 'post-command-hook 'auto-show-make-point-visible)
-
-;; Do auto-scrolling in comint buffers after process output also.
-(add-hook 'comint-output-filter-functions 'auto-show-make-point-visible t)
-
-(provide 'auto-show)
-
-;; auto-show.el ends here
-
diff --git a/lisp/autoinsert.el b/lisp/autoinsert.el
deleted file mode 100644
index e67ab211aba..00000000000
--- a/lisp/autoinsert.el
+++ /dev/null
@@ -1,255 +0,0 @@
-;;; autoinsert.el --- automatic mode-dependent insertion of text into new files
-
-;; Copyright (C) 1985, 1986, 1987, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Charlie Martin <crm@cs.duke.edu>
-;; Adapted-By: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
-
-;; 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:
-
-;;  The following defines an association list for text to be
-;;  automatically inserted when a new file is created, and a function
-;;  which automatically inserts these files; the idea is to insert
-;;  default text much as the mode is automatically set using
-;;  auto-mode-alist.
-;;
-;;  To use: 
-;;     (add-hook 'find-file-hooks 'auto-insert)
-;;     setq auto-insert-directory to an appropriate slash-terminated value
-;;
-;;  Author:  Charlie Martin
-;;           Department of Computer Science and
-;;           National Biomedical Simulation Resource
-;;           Box 3709
-;;           Duke University Medical Center
-;;           Durham, NC 27710
-;;	      (crm@cs.duke.edu,mcnc!duke!crm) 
-
-;;; Code:
-
-(defvar auto-insert 'not-modified
-  "*Controls automatic insertion into newly found empty files:
-	nil	do nothing
-	t	insert if possible
-	other	insert if possible, but mark as unmodified.
-Insertion is possible when something appropriate is found in
-`auto-insert-alist'.  When the insertion is marked as unmodified, you can
-save it with  \\[write-file] RET.
-This variable is used when `auto-insert' is called as a function, e.g.
-when you do (add-hook 'find-file-hooks 'auto-insert).
-With \\[auto-insert], this is always treated as if it were `t'.")
-
-
-(defvar auto-insert-query 'function
-  "*If non-`nil', ask user before auto-inserting.
-When this is `function', only ask when called non-interactively.")
-
-
-(defvar auto-insert-prompt "Perform %s auto-insertion? "
-  "*Prompt to use when querying whether to auto-insert.
-If this contains a %s, that will be replaced by the matching rule.")
-
-
-(defvar auto-insert-alist
-  '((("\\.\\([Hh]\\|hh\\|hpp\\)\\'" . "C / C++ header")
-     (upcase (concat (file-name-nondirectory
-		      (substring buffer-file-name 0 (match-beginning 0)))
-		     "_"
-		     (substring buffer-file-name (1+ (match-beginning 0)))))
-     "#ifndef " str \n
-     "#define " str "\n\n"
-     _ "\n\n#endif")
-
-    (("\\.\\([Cc]\\|cc\\|cpp\\)\\'" . "C / C++ program")
-     nil
-     "#include \""
-     ;; nop without latest cc-mode
-     (and (fboundp 'c-companion-file)
-	  ;(file-readable-p (c-companion-file 'name))
-	  (file-name-nondirectory (c-companion-file 'name))) & ?\"
-     | -10)
-
-    ("[Mm]akefile\\'" . "makefile.inc")
-
-    (html-mode . (lambda () (sgml-tag "html")))
-    
-    (plain-tex-mode . "tex-insert.tex")
-    (bibtex-mode . "tex-insert.tex")
-    (latex-mode
-     ;; should try to offer completing read for these
-     "options, RET: "
-     "\\documentstyle[" str & ?\] | -1
-     ?{ (read-string "class: ") "}\n"
-     ("package, %s: "
-      "\\usepackage[" (read-string "options, RET: ") & ?\] | -1 ?{ str "}\n")
-     _ "\n\\begin{document}\n" _
-     "\n\\end{document}")
-
-    (("/bin/.*[^/]\\'" . "Shell-Script mode magic number")
-     lambda ()
-       (if (eq major-mode default-major-mode)
-	 (sh-mode)))
-    
-    (ada-mode . ada-header)
-
-    (("\\.el\\'" . "Emacs Lisp header")
-     "Short description: "
-     ";;; " (file-name-nondirectory (buffer-file-name)) " --- " str "
-
-;; Copyright (C) " (substring (current-time-string) -4) " by "
- (getenv "ORGANIZATION") | "Free Software Foundation, Inc." "
-
-;; Author: " (user-full-name)
-'(if (search-backward "&" (save-excursion (beginning-of-line 1) (point)) t)
-     (replace-match (capitalize (user-login-name)) t t))
-'(end-of-line 1) " <" (user-login-name) ?@ (system-name) ">
-;; Keywords: "
- '(require 'finder)
- ;;'(setq v1 (apply 'vector (mapcar 'car finder-known-keywords)))
- '(setq v1 (mapcar (lambda (x) (list (symbol-name (car x))))
-		   finder-known-keywords)
-	v2 (mapconcat (lambda (x) (format "%10.0s:  %s" (car x) (cdr x)))
-	   finder-known-keywords
-	   "\n"))
- ((let ((minibuffer-help-form v2))
-    (completing-read "Keyword, C-h: " v1 nil t))
-    str ", ") & -2 "
-
-;; 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:
-
-
-
-;;; " (file-name-nondirectory (buffer-file-name)) " ends here"))
-  "A list specifying text to insert by default into a new file.
-Elements look like (CONDITION . ACTION) or ((CONDITION . DESCRIPTION) . ACTION).
-CONDITION maybe a regexp that must match the new file's name, or it may be
-a symbol that must match the major mode for this element to apply.
-Only the first matching element is effective.
-Optional DESCRIPTION is a string for filling `auto-insert-prompt'.
-ACTION may be a skeleton to insert (see `skeleton-insert'), an absolute
-file-name or one relative to `auto-insert-directory' or a function to call.
-ACTION may also be a vector containing several successive single actions as
-described above, e.g. [\"header.insert\" date-and-author-update].")
-
-
-;; Establish a default value for auto-insert-directory
-(defvar auto-insert-directory "~/insert/"
-  "*Directory from which auto-inserted files are taken.")
-
-
-;;;###autoload
-(defun auto-insert ()
-  "Insert default contents into a new file if `auto-insert' is non-nil.
-Matches the visited file name against the elements of `auto-insert-alist'."
-  (interactive)
-  (and (not buffer-read-only)
-       (or (eq this-command 'auto-insert)
-	   (and auto-insert
-		(bobp) (eobp)))
-       (let ((alist auto-insert-alist)
-	     case-fold-search cond desc action)
-	 (goto-char 1)
-	 ;; find first matching alist entry
-	 (while alist
-	   (if (atom (setq cond (car (car alist))))
-	       (setq desc cond)
-	     (setq desc (cdr cond)
-		   cond (car cond)))
-	   (if (if (symbolp cond)
-		   (eq cond major-mode)
-		 (string-match cond buffer-file-name))
-	       (setq action (cdr (car alist))
-		     alist nil)
-	     (setq alist (cdr alist))))
-
-	 ;; Now, if we found something, do it
-	 (and action
-	      (if (stringp action)
-		  (file-readable-p (concat auto-insert-directory action))
-		t)
-	      (if auto-insert-query
-		  (or (if (eq auto-insert-query 'function)
-			  (eq this-command 'auto-insert))
-		      (y-or-n-p (format auto-insert-prompt desc)))
-		t)
-	      (mapcar
-	       (lambda (action)
-		 (if (stringp action)
-		     (if (file-readable-p
-			  (setq action (concat auto-insert-directory action)))
-			 (insert-file-contents action))
-		   (save-window-excursion
-		     ;; make buffer visible before skeleton or function
-		     ;; which might ask the user for something
-		     (switch-to-buffer (current-buffer))
-		     (if (and (consp action)
-			      (not (eq (car action) 'lambda)))
-			 (skeleton-insert action)
-		       (funcall action)))))
-	       (if (vectorp action)
-		   action
-		 (vector action))))
-	 (and (buffer-modified-p)
-	      (not (eq this-command 'auto-insert))
-	      (set-buffer-modified-p (eq auto-insert t))))))
-
-
-;;;###autoload
-(defun define-auto-insert (key action &optional after)
-  "Associate CONDITION with (additional) ACTION in `auto-insert-alist'.
-Optional AFTER means to insert action after all existing actions for CONDITION,
-or if CONDITION had no actions, after all other CONDITIONs."
-  (let ((elt (assoc key auto-insert-alist)))
-    (if elt
-	(setcdr elt
-		(if (vectorp (cdr elt))
-		    (vconcat (if after (cdr elt))
-			     (if (vectorp action) action (vector action))
-			     (if after () (cdr elt)))
-		  (if after
-		      (vector (cdr elt) action)
-		    (vector action (cdr elt)))))
-      (if after
-	  (nconc auto-insert-alist (list (cons key action)))
-	(setq auto-insert-alist (cons (cons key action)
-				      auto-insert-alist))))))
-
-;;; autoinsert.el ends here
diff --git a/lisp/avoid.el b/lisp/avoid.el
deleted file mode 100644
index f95ee81985e..00000000000
--- a/lisp/avoid.el
+++ /dev/null
@@ -1,359 +0,0 @@
-;;; avoid.el --- make mouse pointer stay out of the way of editing
-
-;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
-;; Keywords: mouse
-
-;; 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:
-
-;; For those who are annoyed by the mouse pointer obscuring text,
-;; this mode moves the mouse pointer - either just a little out of
-;; the way, or all the way to the corner of the frame. 
-;; To use, load or evaluate this file and type M-x mouse-avoidance-mode .
-;; To set up permanently, put the following in your .emacs: 
-;;
-;; (if window-system (mouse-avoidance-mode 'animate))
-;;
-;; The 'animate can be 'jump or 'banish or 'exile or 'protean if you prefer.
-;; See the documentation for function `mouse-avoidance-mode' for
-;; details of the different modes.
-;;
-;; For added silliness, make the animatee animate...
-;; put something similar to the following into your .emacs:
-;;
-;; (if window-system
-;;     (mouse-avoidance-set-pointer-shape
-;;	     (eval (nth (random 4)
-;;			'(x-pointer-man x-pointer-spider
-;;			  x-pointer-gobbler x-pointer-gumby)))))
-;;
-;; For completely random pointer shape, replace the setq above with:
-;; (setq x-pointer-shape (mouse-avoidance-random-shape))
-;; 
-;; Bugs / Warnings / To-Do:
-;;
-;; - Using this code does slow emacs down.  "banish" mode shouldn't
-;;   be too bad, and on my workstation even "animate" is reasonable.
-;;
-;; - It ought to find out where any overlapping frames are and avoid them,
-;;   rather than always raising the frame.
-
-;; Credits:
-;; This code was helped by all those who contributed suggestions, 
-;;   fixes, and additions
-;; Joe Harrington (and his advisor), for the original inspiration.
-;; Ken Manheimer, for dreaming up the Protean mode.
-;; Richard Stallman, for the awful cat-and-mouse pun, among other things.
-;; Mike Williams, Denis Howe, Bill Benedetto, Chris Moore, Don Morris,
-;; Simon Marshall, and M.S. Ashton, for their feedback.
-
-;;; Code:
-
-(provide 'avoid)
-
-(defvar mouse-avoidance-mode nil
-  "Value is t or a symbol if the mouse pointer should avoid the cursor.
-See function `mouse-avoidance-mode' for possible values.  Changing this
-variable is NOT the recommended way to change modes; use that function 
-instead.")
-
-(defvar mouse-avoidance-nudge-dist 15
-  "*Average distance that mouse will be moved when approached by cursor.
-Only applies in mouse-avoidance-mode `jump' and its derivatives.
-For best results make this larger than `mouse-avoidance-threshold'.")
-
-(defvar mouse-avoidance-nudge-var 10
-  "*Variability of `mouse-avoidance-nudge-dist' (which see).")
-
-(defvar mouse-avoidance-animation-delay .01
-  "Delay between animation steps, in seconds.")
-
-(defvar mouse-avoidance-threshold 5
-  "*Mouse-pointer's flight distance.
-If the cursor gets closer than this, the mouse pointer will move away.
-Only applies in mouse-avoidance-modes `animate' and `jump'.")
-
-;; Internal variables
-(defvar mouse-avoidance-state nil)
-(defvar mouse-avoidance-pointer-shapes nil)
-(defvar mouse-avoidance-n-pointer-shapes 0)
-(defvar mouse-avoidance-old-pointer-shape nil)
-
-;;; Functions:
-
-(defsubst mouse-avoidance-set-pointer-shape (shape)
-  "Set the shape of the mouse pointer to SHAPE."
-  (setq x-pointer-shape shape)
-  (set-mouse-color nil))
-
-(defun mouse-avoidance-point-position ()
-  "Return the position of point as (FRAME X . Y).
-Analogous to mouse-position."
-  (let* ((w (selected-window))
-	 (edges (window-edges w))
-	 (list 
-	  (compute-motion (max (window-start w) (point-min))   ; start pos
-			  ;; window-start can be < point-min if the
-			  ;; latter has changed since the last redisplay 
-			  '(0 . 0)	                       ; start XY
-			  (point)	                       ; stop pos
-			  (cons (window-width) (window-height)); stop XY: none
-			  (1- (window-width))                  ; width
-			  (cons (window-hscroll w) 0)          ; 0 may not be right?
-			  (selected-window))))
-    ;; compute-motion returns (pos HPOS VPOS prevhpos contin)
-    ;; we want:               (frame hpos . vpos)
-    (cons (selected-frame)
-	  (cons (+ (car edges)       (car (cdr list)))
-		(+ (car (cdr edges)) (car (cdr (cdr list))))))))
-
-;(defun mouse-avoidance-point-position-test ()
-;  (interactive)
-;  (message (format "point=%s mouse=%s" 
-;		   (cdr (mouse-avoidance-point-position))
-;		   (cdr (mouse-position)))))
-
-(defun mouse-avoidance-set-mouse-position (pos)
-  ;; Carefully set mouse position to given position (X . Y)
-  ;; Ideally, should check if X,Y is in the current frame, and if not,
-  ;; leave the mouse where it was.  However, this is currently
-  ;; difficult to do, so we just raise the frame to avoid frame switches.
-  ;; Returns t if it moved the mouse.
-  (let ((f (selected-frame)))
-    (raise-frame f)
-    (set-mouse-position f (car pos) (cdr pos))
-    t))
-      
-(defun mouse-avoidance-too-close-p (mouse)
-  ;;  Return t if mouse pointer and point cursor are too close.
-  ;; Acceptable distance is defined by mouse-avoidance-threshold.
-  (let ((point (mouse-avoidance-point-position)))
-    (and (eq (car mouse) (car point))
-	 (car (cdr mouse))
-	 (< (abs (- (car (cdr mouse)) (car (cdr point))))
-	    mouse-avoidance-threshold)
-	 (< (abs (- (cdr (cdr mouse)) (cdr (cdr point))))
-	    mouse-avoidance-threshold))))
-
-(defun mouse-avoidance-banish-destination ()
-  "The position to which mouse-avoidance-mode `banish' moves the mouse.
-You can redefine this if you want the mouse banished to a different corner."
- (cons (1- (frame-width))
-       0))
-
-(defun mouse-avoidance-banish-mouse ()
-  ;; Put the mouse pointer in the upper-right corner of the current frame.
-  (mouse-avoidance-set-mouse-position (mouse-avoidance-banish-destination)))
-
-(defsubst mouse-avoidance-delta (cur delta dist var min max)
-  ;; Decide how far to move in either dimension.
-  ;; Args are the CURRENT location, the desired DELTA for
-  ;; warp-conservation, the DISTANCE we like to move, the VARIABILITY
-  ;; in distance allowed, and the MIN and MAX possible window positions.
-  ;; Returns something as close to DELTA as possible within the constraints.
-  (let ((L1 (max (- min cur) (+ (- dist) (- var))))
-	(R1                  (+ (- dist)    var ))
-	(L2                  (+    dist  (- var)))
-	(R2 (min (- max cur) (+    dist     var))))
-    (if (< R1 (- min cur)) (setq L1 nil R1 nil))
-    (if (> L2 (- max cur)) (setq L2 nil R2 nil))
-    (cond ((and L1 (< delta L1)) L1)
-	  ((and R1 (< delta R1)) delta)
-	  ((and R1 (< delta 0)) R1)
-	  ((and L2 (< delta L2)) L2)
-	  ((and R2 (< delta R2)) delta)
-	  (R2)
-	  ((or R1 L2))
-	  (t 0))))
-
-(defun mouse-avoidance-nudge-mouse () 
-  ;; Push the mouse a little way away, possibly animating the move
-  ;; For these modes, state keeps track of the total offset that we've
-  ;; accumulated, and tries to keep it close to zero.
-  (let* ((cur (mouse-position))
-	 (cur-frame (car cur))
-	 (cur-pos (cdr cur))
-	 (deltax (mouse-avoidance-delta 
-		  (car cur-pos) (- (random mouse-avoidance-nudge-var)
-				   (car mouse-avoidance-state))
-		  mouse-avoidance-nudge-dist mouse-avoidance-nudge-var
-		  0 (frame-width)))
-	 (deltay (mouse-avoidance-delta 
-		  (cdr cur-pos) (- (random mouse-avoidance-nudge-var)
-				   (cdr mouse-avoidance-state))
-		  mouse-avoidance-nudge-dist mouse-avoidance-nudge-var
-		  0 (frame-height))))
-    (setq mouse-avoidance-state
-	  (cons (+ (car mouse-avoidance-state) deltax)
-		(+ (cdr mouse-avoidance-state) deltay)))
-    (if (or (eq mouse-avoidance-mode 'animate) 
-	    (eq mouse-avoidance-mode 'proteus))
-	(let ((i 0.0))
-	  (while (<= i 1)
-	    (mouse-avoidance-set-mouse-position 
-	     (cons (+ (car cur-pos) (round (* i deltax)))
-		   (+ (cdr cur-pos) (round (* i deltay)))))
-    	    (setq i (+ i (max .1 (/ 1.0 mouse-avoidance-nudge-dist))))
-	    (if (eq mouse-avoidance-mode 'proteus)
-		(mouse-avoidance-set-pointer-shape 
-		 (mouse-avoidance-random-shape)))
-	    (sit-for mouse-avoidance-animation-delay)))
-      (mouse-avoidance-set-mouse-position (cons (+ (car (cdr cur)) deltax)
-						(+ (cdr (cdr cur)) deltay))))))
-
-(defun mouse-avoidance-random-shape ()
-  "Return a random cursor shape.
-This assumes that any variable whose name begins with x-pointer- and
-has an integer value is a valid cursor shape.  You might want to
-redefine this function to suit your own tastes."
-  (if (null mouse-avoidance-pointer-shapes)
-      (progn
-	(setq mouse-avoidance-pointer-shapes
-	      (mapcar '(lambda (x) (symbol-value (intern x)))
-		      (all-completions "x-pointer-" obarray
-				       '(lambda (x) 
-					  (and (boundp x)
-					       (integerp (symbol-value x)))))))
-	(setq mouse-avoidance-n-pointer-shapes 
-	      (length mouse-avoidance-pointer-shapes))))
-  (nth (random mouse-avoidance-n-pointer-shapes)
-       mouse-avoidance-pointer-shapes))
-
-(defun mouse-avoidance-banish-hook ()
-  (if (and (not executing-kbd-macro)	; don't check inside macro
-	   (mouse-avoidance-kbd-command (this-command-keys)))
-      (mouse-avoidance-banish-mouse)))
-
-(defun mouse-avoidance-exile-hook ()
-  ;; For exile mode, the state is nil when the mouse is in its normal
-  ;; position, and set to the old mouse-position when the mouse is in exile.
-  (if (and (not executing-kbd-macro)
-	   (mouse-avoidance-kbd-command (this-command-keys)))
-      (let ((mp (mouse-position)))
-	(cond ((and (not mouse-avoidance-state)
-		    (mouse-avoidance-too-close-p mp))
-	       (setq mouse-avoidance-state mp)
-	       (mouse-avoidance-banish-mouse))
-	      ((and mouse-avoidance-state
-		    (not (mouse-avoidance-too-close-p mouse-avoidance-state)))
-	       (if (and (eq (car mp) (selected-frame))
-			(equal (cdr mp) (mouse-avoidance-banish-destination)))
-		   (mouse-avoidance-set-mouse-position
-		    ;; move back only if user has not moved mouse
-		    (cdr mouse-avoidance-state)))
-	       ;; but clear state anyway, to be ready for another move
-	       (setq mouse-avoidance-state nil))))))
-
-(defun mouse-avoidance-fancy-hook ()
-  ;; Used for the "fancy" modes, ie jump et al.
-  (if (and (not executing-kbd-macro)	; don't check inside macro
-	   (mouse-avoidance-kbd-command (this-command-keys))
-	   (mouse-avoidance-too-close-p (mouse-position)))
-      (let ((old-pos (mouse-position)))
-	(mouse-avoidance-nudge-mouse)
-	(if (not (eq (selected-frame) (car old-pos)))
-	    ;; This should never happen.
-	    (apply 'set-mouse-position old-pos)))))
-
-(defun mouse-avoidance-kbd-command (key)
-  "Return t if the KEYSEQENCE is composed of keyboard events only.
-Return nil if there are any lists in the key sequence."
-  (cond ((null key) nil)		; Null event seems to be
-					; returned occasionally.
-	((not (vectorp key)) t)		; Strings are keyboard events.
-	((catch 'done
-	   (let ((i 0)
-		 (l (length key)))
-	     (while (< i l)
-	       (if (listp (aref key i))
-		   (throw 'done nil))
-	       (setq i (1+ i))))
-	   t))))
-
-;;;###autoload
-(defun mouse-avoidance-mode (&optional mode)
-  "Set cursor avoidance mode to MODE.
-MODE should be one of the symbols `banish', `exile', `jump', `animate',
-`cat-and-mouse', `proteus', or `none'.
-
-If MODE is nil, toggle mouse avoidance between `none` and `banish'
-modes.  Positive numbers and symbols other than the above are treated
-as equivalent to `banish'; negative numbers and `-' are equivalent to `none'.
-
-Effects of the different modes: 
- * banish: Move the mouse to the upper-right corner on any keypress.
- * exile: Move the mouse to the corner only if the cursor gets too close,
-     and allow it to return once the cursor is out of the way.
- * jump: If the cursor gets too close to the mouse, displace the mouse
-     a random distance & direction.
- * animate: As `jump', but shows steps along the way for illusion of motion.
- * cat-and-mouse: Same as `animate'.
- * proteus: As `animate', but changes the shape of the mouse pointer too.
-
-Whenever the mouse is moved, the frame is also raised.
-
-\(see `mouse-avoidance-threshold' for definition of \"too close\",
-and `mouse-avoidance-nudge-dist' and `mouse-avoidance-nudge-var' for
-definition of \"random distance\".)"
-  (interactive
-   (list (intern (completing-read
-		  "Select cursor avoidance technique (SPACE for list): "
-		  '(("banish") ("exile") ("jump") ("animate")
-		    ("cat-and-mouse") ("proteus") ("none"))
-		  nil t))))
-  (if (eq mode 'cat-and-mouse)
-      (setq mode 'animate))
-  (remove-hook 'post-command-idle-hook 'mouse-avoidance-banish-hook)
-  (remove-hook 'post-command-idle-hook 'mouse-avoidance-exile-hook)
-  (remove-hook 'post-command-idle-hook 'mouse-avoidance-fancy-hook)
-
-  ;; Restore pointer shape if necessary
-  (if (eq mouse-avoidance-mode 'proteus)
-      (mouse-avoidance-set-pointer-shape mouse-avoidance-old-pointer-shape))
-
-  ;; Do additional setup depending on version of mode requested
-  (cond	((eq mode 'none)
-	 (setq mouse-avoidance-mode nil))
-	((or (eq mode 'jump)
-	     (eq mode 'animate)
-	     (eq mode 'proteus))
-	 (add-hook 'post-command-idle-hook 'mouse-avoidance-fancy-hook)
-	 (setq mouse-avoidance-mode mode
-	       mouse-avoidance-state (cons 0 0)
-	       mouse-avoidance-old-pointer-shape x-pointer-shape))
-	((eq mode 'exile)
-	 (add-hook 'post-command-idle-hook 'mouse-avoidance-exile-hook)
-	 (setq mouse-avoidance-mode mode
-	       mouse-avoidance-state nil))
-	((or (eq mode 'banish) 
-	     (eq mode t)
-	     (and (null mode) (null mouse-avoidance-mode))
-	     (and mode (> (prefix-numeric-value mode) 0)))
-	 (add-hook 'post-command-idle-hook 'mouse-avoidance-banish-hook)
-	 (setq mouse-avoidance-mode 'banish))
-	(t (setq mouse-avoidance-mode nil)))
-  (force-mode-line-update))
-
-(or (assq 'mouse-avoidance-mode minor-mode-alist)
-    (setq minor-mode-alist (cons '(mouse-avoidance-mode " Avoid")
-				 minor-mode-alist)))
-
-;;; End of avoid.el
diff --git a/lisp/bindings.el b/lisp/bindings.el
deleted file mode 100644
index 3978afa58e7..00000000000
--- a/lisp/bindings.el
+++ /dev/null
@@ -1,554 +0,0 @@
-;;; bindings.el --- define standard key bindings and some variables.
-
-;; Copyright (C) 1985,86,87,92,93,94,95,96 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:
-
-;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-;;; Special formatting conventions are used in this file!
-;;;
-;;; a backslash-newline is used at the beginning of a documentation string
-;;; when that string should be stored in the file etc/DOCnnn, not in core.
-;;;
-;;; Such strings read into Lisp as numbers (during the pure-loading phase).
-;;;
-;;; But you must obey certain rules to make sure the string is understood
-;;; and goes into etc/DOCnnn properly.  Otherwise, the string will not go
-;;; anywhere!
-;;;
-;;; The doc string must appear in the standard place in a call to
-;;; defun, autoload, defvar or defconst.  No Lisp macros are recognized.
-;;; The open-paren starting the definition must appear in column 0.
-;;;
-;;; In defvar and defconst, there is an additional rule:
-;;; The double-quote that starts the string must be on the same
-;;; line as the defvar or defconst.
-;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-;;; Code:
-
-(defvar mode-line-buffer-identification (purecopy '("%F: %12b"))
-  "Mode-line control for identifying the buffer being displayed.
-Its default value is (\"%F: %12b\").  Under X, `%F' is replaced with `Emacs'.
-Major modes that edit things other than ordinary files may change this
-\(e.g. Info, Dired,...)")
-
-(make-variable-buffer-local 'mode-line-buffer-identification)
-
-(defvar mode-line-process nil
-  "Mode-line control for displaying info on process status.
-Normally nil in most modes, since there is no process to display.")
-
-(make-variable-buffer-local 'mode-line-process)
-
-(defvar mode-line-modified (purecopy '("--%1*%1+-"))
-  "Mode-line control for displaying whether current buffer is modified.")
-
-(make-variable-buffer-local 'mode-line-modified)
-
-(setq-default mode-line-format
-  (list (purecopy "")
-   'mode-line-modified
-   'mode-line-buffer-identification
-   (purecopy "   ")
-   'global-mode-string
-   (purecopy "   %[(")
-   'mode-name 'mode-line-process 'minor-mode-alist
-   (purecopy "%n")
-   (purecopy ")%]--")
-   (purecopy '(line-number-mode "L%l--"))
-   (purecopy '(column-number-mode "C%c--"))
-   (purecopy '(-3 . "%p"))
-   (purecopy "-%-")))
-
-(defvar minor-mode-alist nil "\
-Alist saying how to show minor modes in the mode line.
-Each element looks like (VARIABLE STRING);
-STRING is included in the mode line iff VARIABLE's value is non-nil.
-
-Actually, STRING need not be a string; any possible mode-line element
-is okay.  See `mode-line-format'.")
-;; Don't use purecopy here--some people want to change these strings.
-(setq minor-mode-alist '((abbrev-mode " Abbrev")
-			 (overwrite-mode overwrite-mode)
-			 (auto-fill-function " Fill")
-			 ;; not really a minor mode...
-			 (defining-kbd-macro " Def")))
-
-;; These variables are used by autoloadable packages.
-;; They are defined here so that they do not get overridden
-;; by the loading of those packages.
-
-;; Names in directory that end in one of these
-;; are ignored in completion,
-;; making it more likely you will get a unique match.
-(setq completion-ignored-extensions
-      (append
-       (cond ((or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
-	      '(".o" "~" ".bin" ".bak" ".obj" ".map"
-		".a" ".ln" ".blg" ".bbl"))
-	     ((eq system-type 'vax-vms)
-	      '(".obj" ".exe" ".bin" ".lbin" ".sbin"
-		".brn" ".rnt" ".mem" ".lni" ".lis"
-		".olb" ".tlb" ".mlb" ".hlb"))
-	     (t
-	      '(".o" "~" ".bin" ".lbin" ".fasl"
-		".a" ".ln" ".blg" ".bbl")))
-       '(".elc" ".lof"
-	 ".glo" ".idx" ".lot"
-	 ;; TeX-related
-	 ".dvi" ".fmt"
-	 ;; Texinfo-related
-	 ".toc" ".log" ".aux"
-	 ".cp" ".fn" ".ky" ".pg" ".tp" ".vr"
-	 ".cps" ".fns" ".kys" ".pgs" ".tps" ".vrs")))
-
-(setq debug-ignored-errors
-      '(beginning-of-line beginning-of-buffer end-of-line
-	end-of-buffer end-of-file buffer-read-only
-      	"^Previous command was not a yank$"
-	"^Minibuffer window is not active$"
-	"^End of history; no next item$"
-	"^Beginning of history; no preceding item$"
-	"^No recursive edit is in progress$"
-	"^Changes to be undone are outside visible portion of buffer$"
-	"^No undo information in this buffer$"
-	"^No further undo information$"
-	"^Save not confirmed$"
-	"^Recover-file cancelled\\.$"
-
-	;; comint
-	"^Not at command line$"
-	"^Empty input ring$"
-	"^No history$"
-	"^Not found$";; To common?
-	"^Current buffer has no process$"
-
-	;; dabbrev
-	"^No dynamic expansion for \".*\" found\\.$"
-	"^No further dynamic expansions for \".*\" found\\.$"
-	"^No further dynamic expansions for `.*' found$"
-
-	;; Completion
-	"^To complete, the point must be after a symbol at least [0-9]* character long\\.$"
-	"^The string \".*\" is too short to be saved as a completion\\.$"
-
-	;; Compile
-	"^No more errors\\( yet\\|\\)$"
-
-	;; Gnus
-	"^NNTP: Connection closed\\.$"
-
-	;; info
-	"^Node has no Previous$"
-	"^No \".*\" in index$"
-
-	;; imenu
-	"^No items suitable for an index found in this buffer\\.$"
-	"^The mode \".*\" does not take full advantage of imenu\\.el yet\\.$"
-
-	;; ispell
-	"^No word found to check!$"
-
-	;; mh-e
-	"^Cursor not pointing to message$"
-	"^There is no other window$"
-
-	;; man
-	"^No manpage [0-9]* found$"
-
-	;; etags
-	"^No tags table in use!  Use .* to select one\\.$"
-	"^There is no default tag$"
-	"^No previous tag locations$"
-	"^File .* is not a valid tags table$"
-	"^No \\(more \\|\\)tags \\(matching\\|containing\\) "
-	"^Rerun etags: `.*' not found in "
-	"^All files processed\\.$"
-	"^No .* or .* in progress.$"
-	"^File .* not in current tags tables$"
-	"No tags table loaded."
-	"^Nothing to complete$"
-
-	;; BBDB
-	"^no previous record$"
-	"^no next record$"))
-
-
-(make-variable-buffer-local 'indent-tabs-mode)
-
-;; This is here to avoid autoloading etags on M-TAB.
-;; M-x visit-tags-table will autoload etags, which will redefine complete-tag.
-(defun complete-tag ()
-  "Perform tags completion on the text around point.
-Completes to the set of names listed in the current tags table.
-The string to complete is chosen in the same way as the default
-for \\[find-tag] (which see)."
-  (interactive)
-  (error (substitute-command-keys
-	  "No tags table loaded.  Try \\[visit-tags-table].")))
-
-;; Reduce total amount of space we must allocate during this function
-;; that we will not need to keep permanently.
-(garbage-collect)
-
-(define-key ctl-x-map "n" (make-sparse-keymap))
-(define-key ctl-x-map "r" (make-sparse-keymap))
-
-(setq help-event-list '(help f1))
-
-;These commands are defined in editfns.c
-;but they are not assigned to keys there.
-(put 'narrow-to-region 'disabled t)
-(define-key ctl-x-map "nn" 'narrow-to-region)
-(define-key ctl-x-map "nw" 'widen)
-;; (define-key ctl-x-map "n" 'narrow-to-region)
-;; (define-key ctl-x-map "w" 'widen)
-
-(define-key global-map "\C-j" 'newline-and-indent)
-(define-key global-map "\C-m" 'newline)
-(define-key global-map "\C-o" 'open-line)
-(define-key esc-map "\C-o" 'split-line)
-(define-key global-map "\C-q" 'quoted-insert)
-(define-key esc-map "^" 'delete-indentation)
-(define-key esc-map "\\" 'delete-horizontal-space)
-(define-key esc-map "m" 'back-to-indentation)
-(define-key ctl-x-map "\C-o" 'delete-blank-lines)
-(define-key esc-map " " 'just-one-space)
-(define-key esc-map "z" 'zap-to-char)
-(define-key esc-map "=" 'count-lines-region)
-(define-key ctl-x-map "=" 'what-cursor-position)
-(define-key esc-map ":" 'eval-expression)
-;; Define ESC ESC : like ESC : for people who type ESC ESC out of habit.
-(define-key esc-map "\M-:" 'eval-expression)
-;; Changed from C-x ESC so that function keys work following C-x.
-(define-key ctl-x-map "\e\e" 'repeat-complex-command)
-;; New binding analogous to M-:.
-(define-key ctl-x-map "\M-:" 'repeat-complex-command)
-(define-key ctl-x-map "u" 'advertised-undo)
-;; Many people are used to typing C-/ on X terminals and getting C-_.
-(define-key global-map [?\C-/] 'undo)
-(define-key global-map "\C-_" 'undo)
-(define-key esc-map "!" 'shell-command)
-(define-key esc-map "|" 'shell-command-on-region)
-
-;; This is an experiment--make up and down arrows do history.
-(define-key minibuffer-local-map [up] 'previous-history-element)
-(define-key minibuffer-local-map [down] 'next-history-element)
-(define-key minibuffer-local-ns-map [up] 'previous-history-element)
-(define-key minibuffer-local-ns-map [down] 'next-history-element)
-(define-key minibuffer-local-completion-map [up] 'previous-history-element)
-(define-key minibuffer-local-completion-map [down] 'next-history-element)
-(define-key minibuffer-local-must-match-map [up] 'previous-history-element)
-(define-key minibuffer-local-must-match-map [down] 'next-history-element)
-
-(define-key global-map "\C-u" 'universal-argument)
-(let ((i ?0))
-  (while (<= i ?9)
-    (define-key esc-map (char-to-string i) 'digit-argument)
-    (setq i (1+ i))))
-(define-key esc-map "-" 'negative-argument)
-;; Define control-digits.
-(let ((i ?0))
-  (while (<= i ?9)
-    (define-key global-map (read (format "[?\\C-%c]" i)) 'digit-argument)
-    (setq i (1+ i))))
-(define-key global-map [?\C--] 'negative-argument)
-;; Define control-meta-digits.
-(let ((i ?0))
-  (while (<= i ?9)
-    (define-key esc-map (read (format "[?\\C-%c]" i)) 'digit-argument)
-    (setq i (1+ i))))
-(define-key global-map [?\C-\M--] 'negative-argument)
-
-(define-key global-map "\C-k" 'kill-line)
-(define-key global-map "\C-w" 'kill-region)
-(define-key esc-map "w" 'kill-ring-save)
-(define-key esc-map "\C-w" 'append-next-kill)
-(define-key global-map "\C-y" 'yank)
-(define-key esc-map "y" 'yank-pop)
-
-;; (define-key ctl-x-map "a" 'append-to-buffer)
-
-(define-key global-map "\C-@" 'set-mark-command)
-;; Many people are used to typing C-SPC and getting C-@.
-(define-key global-map [?\C-\ ] 'set-mark-command)
-(define-key ctl-x-map "\C-x" 'exchange-point-and-mark)
-(define-key ctl-x-map "\C-@" 'pop-global-mark)
-(define-key ctl-x-map [?\C-\ ] 'pop-global-mark)
-
-(define-key global-map "\C-n" 'next-line)
-(define-key global-map "\C-p" 'previous-line)
-(define-key ctl-x-map "\C-n" 'set-goal-column)
-
-;;(defun function-key-error ()
-;;  (interactive)
-;;  (error "That function key is not bound to anything."))
-
-(define-key global-map [menu] 'execute-extended-command)
-(define-key global-map [find] 'search-forward)
-
-;; natural bindings for terminal keycaps --- defined in X keysym order
-(define-key global-map [home]		'beginning-of-buffer)
-(define-key global-map [M-home]		'beginning-of-buffer-other-window)
-(define-key global-map [left]		'backward-char)
-(define-key global-map [up]		'previous-line)
-(define-key global-map [right]		'forward-char)
-(define-key global-map [down]		'next-line)
-(define-key global-map [prior]		'scroll-down)
-(define-key global-map [next]		'scroll-up)
-(define-key global-map [C-up]		'backward-paragraph)
-(define-key global-map [C-down]		'forward-paragraph)
-(define-key global-map [C-prior]	'scroll-right)
-(define-key global-map [C-next]		'scroll-left)
-(define-key global-map [M-next]		'scroll-other-window)
-(define-key global-map [M-prior]	'scroll-other-window-down)
-(define-key global-map [end]		'end-of-buffer)
-(define-key global-map [M-end]		'end-of-buffer-other-window)
-(define-key global-map [begin]		'beginning-of-buffer)
-(define-key global-map [M-begin]	'beginning-of-buffer-other-window)
-;; (define-key global-map [select]	'function-key-error)
-;; (define-key global-map [print]	'function-key-error)
-(define-key global-map [execute]	'execute-extended-command)
-(define-key global-map [insert]		'overwrite-mode)
-(define-key global-map [C-insert]	'kill-ring-save)
-(define-key global-map [S-insert]	'yank)
-(define-key global-map [undo]		'undo)
-(define-key global-map [redo]		'repeat-complex-command)
-;; (define-key global-map [clearline]	'function-key-error)
-(define-key global-map [insertline]	'open-line)
-(define-key global-map [deleteline]	'kill-line)
-;; (define-key global-map [insertchar]	'function-key-error)
-(define-key global-map [deletechar]	'delete-char)
-;; (define-key global-map [backtab]	'function-key-error)
-;; (define-key global-map [f1]		'function-key-error)
-;; (define-key global-map [f2]		'function-key-error)
-;; (define-key global-map [f3]		'function-key-error)
-;; (define-key global-map [f4]		'function-key-error)
-;; (define-key global-map [f5]		'function-key-error)
-;; (define-key global-map [f6]		'function-key-error)
-;; (define-key global-map [f7]		'function-key-error)
-;; (define-key global-map [f8]		'function-key-error)
-;; (define-key global-map [f9]		'function-key-error)
-;; (define-key global-map [f10]		'function-key-error)
-;; (define-key global-map [f11]		'function-key-error)
-;; (define-key global-map [f12]		'function-key-error)
-;; (define-key global-map [f13]		'function-key-error)
-;; (define-key global-map [f14]		'function-key-error)
-;; (define-key global-map [f15]		'function-key-error)
-;; (define-key global-map [f16]		'function-key-error)
-;; (define-key global-map [f17]		'function-key-error)
-;; (define-key global-map [f18]		'function-key-error)
-;; (define-key global-map [f19]		'function-key-error)
-;; (define-key global-map [f20]		'function-key-error)
-;; (define-key global-map [f21]		'function-key-error)
-;; (define-key global-map [f22]		'function-key-error)
-;; (define-key global-map [f23]		'function-key-error)
-;; (define-key global-map [f24]		'function-key-error)
-;; (define-key global-map [f25]		'function-key-error)
-;; (define-key global-map [f26]		'function-key-error)
-;; (define-key global-map [f27]		'function-key-error)
-;; (define-key global-map [f28]		'function-key-error)
-;; (define-key global-map [f29]		'function-key-error)
-;; (define-key global-map [f30]		'function-key-error)
-;; (define-key global-map [f31]		'function-key-error)
-;; (define-key global-map [f32]		'function-key-error)
-;; (define-key global-map [f33]		'function-key-error)
-;; (define-key global-map [f34]		'function-key-error)
-;; (define-key global-map [f35]		'function-key-error)
-;; (define-key global-map [kp-backtab]	'function-key-error)
-;; (define-key global-map [kp-space]	'function-key-error)
-;; (define-key global-map [kp-tab]		'function-key-error)
-;; (define-key global-map [kp-enter]	'function-key-error)
-;; (define-key global-map [kp-f1]		'function-key-error)
-;; (define-key global-map [kp-f2]		'function-key-error)
-;; (define-key global-map [kp-f3]		'function-key-error)
-;; (define-key global-map [kp-f4]		'function-key-error)
-;; (define-key global-map [kp-multiply]	'function-key-error)
-;; (define-key global-map [kp-add]		'function-key-error)
-;; (define-key global-map [kp-separator]	'function-key-error)
-;; (define-key global-map [kp-subtract]	'function-key-error)
-;; (define-key global-map [kp-decimal]	'function-key-error)
-;; (define-key global-map [kp-divide]	'function-key-error)
-;; (define-key global-map [kp-0]		'function-key-error)
-;; (define-key global-map [kp-1]		'function-key-error)
-;; (define-key global-map [kp-2]		'function-key-error)
-;; (define-key global-map [kp-3]		'function-key-error)
-;; (define-key global-map [kp-4]		'function-key-error)
-;; (define-key global-map [kp-5]		'recenter)
-;; (define-key global-map [kp-6]		'function-key-error)
-;; (define-key global-map [kp-7]		'function-key-error)
-;; (define-key global-map [kp-8]		'function-key-error)
-;; (define-key global-map [kp-9]		'function-key-error)
-;; (define-key global-map [kp-equal]	'function-key-error)
-
-;; X11R6 distinguishes these keys from the non-kp keys.
-;; Make them behave like the non-kp keys unless otherwise bound.
-(define-key function-key-map [kp-home] [home])
-(define-key function-key-map [kp-left] [left])
-(define-key function-key-map [kp-up] [up])
-(define-key function-key-map [kp-right] [right])
-(define-key function-key-map [kp-down] [down])
-(define-key function-key-map [kp-prior] [prior])
-(define-key function-key-map [kp-next] [next])
-(define-key function-key-map [M-kp-next] [M-next])
-(define-key function-key-map [kp-end] [end])
-(define-key function-key-map [kp-begin] [begin])
-(define-key function-key-map [kp-insert] [insert])
-(define-key function-key-map [kp-delete] [delete])
-
-(define-key global-map [mouse-movement] 'ignore)
-
-(define-key global-map "\C-t" 'transpose-chars)
-(define-key esc-map "t" 'transpose-words)
-(define-key esc-map "\C-t" 'transpose-sexps)
-(define-key ctl-x-map "\C-t" 'transpose-lines)
-
-(define-key esc-map ";" 'indent-for-comment)
-(define-key esc-map "j" 'indent-new-comment-line)
-(define-key esc-map "\C-j" 'indent-new-comment-line)
-(define-key ctl-x-map ";" 'set-comment-column)
-(define-key ctl-x-map "f" 'set-fill-column)
-(define-key ctl-x-map "$" 'set-selective-display)
-
-(define-key esc-map "@" 'mark-word)
-(define-key esc-map "f" 'forward-word)
-(define-key esc-map "b" 'backward-word)
-(define-key esc-map "d" 'kill-word)
-(define-key esc-map "\177" 'backward-kill-word)
-
-(define-key esc-map "<" 'beginning-of-buffer)
-(define-key esc-map ">" 'end-of-buffer)
-(define-key ctl-x-map "h" 'mark-whole-buffer)
-(define-key esc-map "\\" 'delete-horizontal-space)
-
-(defalias 'mode-specific-command-prefix (make-sparse-keymap))
-(defvar mode-specific-map (symbol-function 'mode-specific-command-prefix)
-  "Keymap for characters following C-c.")
-(define-key global-map "\C-c" 'mode-specific-command-prefix)
-
-(global-set-key [M-right]  'forward-word)
-(global-set-key [M-left]   'backward-word)
-;; ilya@math.ohio-state.edu says these bindings are standard on PC editors.
-(global-set-key [C-right]  'forward-word)
-(global-set-key [C-left]   'backward-word)
-;; This is not quite compatible, but at least is analogous
-(global-set-key [C-delete]   'backward-kill-word)
-;; This is "move to the clipboard", or as close as we come.
-(global-set-key [S-delete] 'kill-region)
-
-(define-key esc-map "\C-f" 'forward-sexp)
-(define-key esc-map "\C-b" 'backward-sexp)
-(define-key esc-map "\C-u" 'backward-up-list)
-(define-key esc-map "\C-@" 'mark-sexp)
-(define-key esc-map [?\C-\ ] 'mark-sexp)
-(define-key esc-map "\C-d" 'down-list)
-(define-key esc-map "\C-k" 'kill-sexp)
-(define-key global-map [C-M-delete] 'backward-kill-sexp)
-(define-key global-map [C-M-backspace] 'backward-kill-sexp)
-(define-key esc-map "\C-n" 'forward-list)
-(define-key esc-map "\C-p" 'backward-list)
-(define-key esc-map "\C-a" 'beginning-of-defun)
-(define-key esc-map "\C-e" 'end-of-defun)
-(define-key esc-map "\C-h" 'mark-defun)
-(define-key ctl-x-map "nd" 'narrow-to-defun)
-(define-key esc-map "(" 'insert-parentheses)
-(define-key esc-map ")" 'move-past-close-and-reindent)
-(define-key esc-map "\t" 'lisp-complete-symbol)
-
-(define-key ctl-x-map "\C-e" 'eval-last-sexp)
-
-(define-key ctl-x-map "r\C-@" 'point-to-register)
-(define-key ctl-x-map [?r ?\C-\ ] 'point-to-register)
-(define-key ctl-x-map "r " 'point-to-register)
-(define-key ctl-x-map "rj" 'jump-to-register)
-(define-key ctl-x-map "rs" 'copy-to-register)
-(define-key ctl-x-map "rx" 'copy-to-register)
-(define-key ctl-x-map "ri" 'insert-register)
-(define-key ctl-x-map "rg" 'insert-register)
-(define-key ctl-x-map "rr" 'copy-rectangle-to-register)
-(define-key ctl-x-map "rc" 'clear-rectangle)
-(define-key ctl-x-map "rk" 'kill-rectangle)
-(define-key ctl-x-map "rd" 'delete-rectangle)
-(define-key ctl-x-map "ry" 'yank-rectangle)
-(define-key ctl-x-map "ro" 'open-rectangle)
-(define-key ctl-x-map "rt" 'string-rectangle)
-(define-key ctl-x-map "rw" 'window-configuration-to-register)
-(define-key ctl-x-map "rf" 'frame-configuration-to-register)
-
-;; These key bindings are deprecated; use the above C-x r map instead.
-;; We use these aliases so \[...] will show the C-x r bindings instead.
-(defalias 'point-to-register-compatibility-binding 'point-to-register)
-(defalias 'jump-to-register-compatibility-binding 'jump-to-register)
-(defalias 'copy-to-register-compatibility-binding 'copy-to-register)
-(defalias 'insert-register-compatibility-binding 'insert-register)
-(define-key ctl-x-map "/" 'point-to-register-compatibility-binding)
-(define-key ctl-x-map "j" 'jump-to-register-compatibility-binding)
-(define-key ctl-x-map "x" 'copy-to-register-compatibility-binding)
-(define-key ctl-x-map "g" 'insert-register-compatibility-binding)
-;; (define-key ctl-x-map "r" 'copy-rectangle-to-register)
-
-(define-key esc-map "q" 'fill-paragraph)
-;; (define-key esc-map "g" 'fill-region)
-(define-key ctl-x-map "." 'set-fill-prefix)
-
-(define-key esc-map "{" 'backward-paragraph)
-(define-key esc-map "}" 'forward-paragraph)
-(define-key esc-map "h" 'mark-paragraph)
-(define-key esc-map "a" 'backward-sentence)
-(define-key esc-map "e" 'forward-sentence)
-(define-key esc-map "k" 'kill-sentence)
-(define-key ctl-x-map "\177" 'backward-kill-sentence)
-
-(define-key ctl-x-map "[" 'backward-page)
-(define-key ctl-x-map "]" 'forward-page)
-(define-key ctl-x-map "\C-p" 'mark-page)
-(define-key ctl-x-map "l" 'count-lines-page)
-(define-key ctl-x-map "np" 'narrow-to-page)
-;; (define-key ctl-x-map "p" 'narrow-to-page)
-
-(define-key ctl-x-map "al" 'add-mode-abbrev)
-(define-key ctl-x-map "a\C-a" 'add-mode-abbrev)
-(define-key ctl-x-map "ag" 'add-global-abbrev)
-(define-key ctl-x-map "a+" 'add-mode-abbrev)
-(define-key ctl-x-map "aig" 'inverse-add-global-abbrev)
-(define-key ctl-x-map "ail" 'inverse-add-mode-abbrev)
-;; (define-key ctl-x-map "a\C-h" 'inverse-add-global-abbrev)
-(define-key ctl-x-map "a-" 'inverse-add-global-abbrev)
-(define-key ctl-x-map "ae" 'expand-abbrev)
-(define-key ctl-x-map "a'" 'expand-abbrev)
-;; (define-key ctl-x-map "\C-a" 'add-mode-abbrev)
-;; (define-key ctl-x-map "\+" 'add-global-abbrev)
-;; (define-key ctl-x-map "\C-h" 'inverse-add-mode-abbrev)
-;; (define-key ctl-x-map "\-" 'inverse-add-global-abbrev)
-(define-key esc-map "'" 'abbrev-prefix-mark)
-(define-key ctl-x-map "'" 'expand-abbrev)
-
-;;; Don't compile this file; it contains no large function definitions.
-;;; Don't look for autoload cookies in this file.
-;;; Local Variables:
-;;; no-byte-compile: t
-;;; no-update-autoloads: t
-;;; End:
-
-;;; bindings.el ends here
diff --git a/lisp/bookmark.el b/lisp/bookmark.el
deleted file mode 100644
index 36bb94464bb..00000000000
--- a/lisp/bookmark.el
+++ /dev/null
@@ -1,2214 +0,0 @@
-;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later.
-
-;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation
-
-;; Author: Karl Fogel <kfogel@red-bean.com>
-;; Maintainer: Karl Fogel <kfogel@red-bean.com>
-;; Created: July, 1993
-;; Author's Update Number: see variable `bookmark-version'.
-;; Keywords: bookmarks, placeholders, annotations
-
-;; 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 is for setting "bookmarks" in files.  A bookmark
-;; associates a string with a location in a certain file.  Thus, you
-;; can navigate your way to that location by providing the string.
-;; See the "User Variables" section for customizations.
-
-;; Thanks to David Bremner <bremner@cs.sfu.ca> for thinking of and
-;; then implementing the bookmark-current-bookmark idea.  He even
-;; sent *patches*, bless his soul...
-
-;; Thanks to Gregory M. Saunders <saunders@cis.ohio-state.edu> for
-;; fixing and improving bookmark-time-to-save-p.
-
-;; Thanks go to Andrew V. Klein <avk@cig.mot.com> for the code that
-;; sorts the alist before presenting it to the user (in bookmark-bmenu-list
-;; and the menu-bar).
-
-;; And much thanks to David Hughes <djh@harston.cv.com> for many small
-;; suggestions and the code to implement them (like
-;; bookmark-bmenu-check-position, and some of the Lucid compatibility
-;; stuff).
-
-;; Kudos (whatever they are) go to Jim Blandy <jimb@red-bean.com>
-;; for his eminently sensible suggestion to separate bookmark-jump
-;; into bookmark-jump and bookmark-jump-noselect, which made many
-;; other things cleaner as well.
-
-;; Thanks to Roland McGrath for encouragement and help with defining
-;; autoloads on the menu-bar.
-
-;; Jonathan Stigelman <stig@hackvan.com> gave patches for default
-;; values in bookmark-jump and bookmark-set.  Everybody please keep
-;; all the keystrokes they save thereby and send them to him at the
-;; end of each year :-)  (No, seriously, thanks Jonathan!)
-
-;; Buckets of gratitude to John Grabowski <johng@media.mit.edu> for
-;; thinking up the annotations feature and implementing it so well.
-
-;; Based on info-bookmark.el, by Karl Fogel and Ken Olstad
-;; <olstad@msc.edu>.
-
-;; Thanks to Mikio Nakajima <PBC01764@niftyserve.or.jp> for many bugs
-;; reported and fixed.
-
-;; Thank you, Michael Kifer, for contributing the XEmacs support.
-
-;; Enough with the credits already, get on to the good stuff:
-
-;; FAVORITE CHINESE RESTAURANT: 
-;; Boy, that's a tough one.  Probably Hong Min, or maybe Emperor's
-;; Choice (both in Chicago's Chinatown).  Well, both.  How about you?
-
-;;;; Code:
-
-(require 'pp)
-
-(defconst bookmark-version "2.6.4"
-  "Version number of bookmark.el.  This is not related to the version
-of Emacs bookmark comes with; it is used solely by bookmark's
-maintainers to avoid version confusion.")
-
-;;; Misc comments:
-;;
-;; If variable bookmark-use-annotations is non-nil, an annotation is
-;; queried for when setting a bookmark.  
-;;
-;; The bookmark list is sorted lexically by default, but you can turn
-;; this off by setting bookmark-sort-flag to nil.  If it is nil, then
-;; the list will be presented in the order it is recorded
-;; (chronologically), which is actually fairly useful as well.
-
-;;; User Variables
-
-(defvar bookmark-use-annotations nil
-  "*If non-nil, saving a bookmark will query for an annotation in a
-buffer.")
-
-
-(defvar bookmark-save-flag t
-  "*Controls when Emacs saves bookmarks to a file.
---> Nil means never save bookmarks, except when `bookmark-save' is
-    explicitly called \(\\[bookmark-save]\).
---> t means save bookmarks when Emacs is killed.
---> Otherwise, it should be a number that is the frequency with which
-    the bookmark list is saved \(i.e.: the number of times which
-    Emacs' bookmark list may be modified before it is automatically
-    saved.\).  If it is a number, Emacs will also automatically save
-    bookmarks when it is killed.
-
-Therefore, the way to get it to save every time you make or delete a
-bookmark is to set this variable to 1 \(or 0, which produces the same
-behavior.\)
-
-To specify the file in which to save them, modify the variable
-bookmark-default-file, which is `~/.emacs.bmk' by default.")
-
-
-(defconst bookmark-old-default-file "~/.emacs-bkmrks"
-  "*The .emacs.bmk file used to be called this.")
-
-
-;; defvarred to avoid a compilation warning:
-(defvar bookmark-file nil
-  "Old name for `bookmark-default-file'.")
-
-(defvar bookmark-default-file
-  (if bookmark-file
-      ;; In case user set `bookmark-file' in her .emacs:
-      bookmark-file
-    (convert-standard-filename "~/.emacs.bmk"))
-  "*File in which to save bookmarks by default.")
-
-
-(defvar bookmark-version-control 'nospecial
-  "*Whether or not to make numbered backups of the bookmark file.
-It can have four values: t, nil, `never', and `nospecial'.
-The first three have the same meaning that they do for the
-variable `version-control', and the final value `nospecial' means just
-use the value of `version-control'.")
-
-
-(defvar bookmark-completion-ignore-case t
-  "*Non-nil means bookmark functions ignore case in completion.")
-
-
-(defvar bookmark-sort-flag t
-  "*Non-nil means that bookmarks will be displayed sorted by bookmark
-name.  Otherwise they will be displayed in LIFO order (that is, most
-recently set ones come first, oldest ones come last).")
-
-
-(defvar bookmark-automatically-show-annotations t
-  "*Nil means don't show annotations when jumping to a bookmark.")
-
-
-(defvar bookmark-bmenu-file-column 30
-  "*Column at which to display filenames in a buffer listing bookmarks.
-You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames].")
-
-
-(defvar bookmark-bmenu-toggle-filenames t
-  "*Non-nil means show filenames when listing bookmarks.
-This may result in truncated bookmark names.  To disable this, put the
-following in your .emacs:
-
-\(setq bookmark-bmenu-toggle-filenames nil\)")
-
-
-(defvar bookmark-menu-length 70
-  "*Maximum length of a bookmark name displayed on a popup menu.")
-
-
-;;; No user-serviceable parts beyond this point.
-
-;; Is it XEmacs?
-(defconst bookmark-xemacsp
-  (string-match "\\(Lucid\\|Xemacs\\)" emacs-version))
-
-
-;; Added  for lucid emacs  compatibility, db
-(or (fboundp 'defalias)  (fset 'defalias 'fset))
-
-;; suggested for lucid compatibility by david hughes:
-(or (fboundp 'frame-height)  (defalias 'frame-height 'screen-height))
-
-;; This variable is probably obsolete now...
-(or (boundp 'baud-rate)
-    ;; some random value higher than 9600    
-    (setq baud-rate 19200))
-
-;; XEmacs apparently call this `buffer-substring-without-properties',
-;; sigh.
-(or (fboundp 'buffer-substring-no-properties)
-    (if (fboundp 'buffer-substring-without-properties)
-        (fset 'buffer-substring-no-properties
-              'buffer-substring-without-properties)
-      (fset 'buffer-substring-no-properties 'buffer-substring)))
-
-
-;;; Keymap stuff:
-;; some people have C-x r set to rmail or whatever.  We don't want to
-;; assume that C-x r is a prefix map just because it's distributed
-;; that way...
-;; These are the distribution keybindings suggested by RMS, everything
-;; else will be done with M-x or the menubar:
-;;;###autoload
-(if (symbolp (key-binding "\C-xr"))
-    nil
-  (progn (define-key ctl-x-map "rb" 'bookmark-jump)
-         (define-key ctl-x-map "rm" 'bookmark-set)
-         (define-key ctl-x-map "rl" 'bookmark-bmenu-list)))
-
-;; define the map, so it can be bound by those who desire to do so:
-
-;;;###autoload
-(defvar bookmark-map nil
-  "Keymap containing bindings to bookmark functions.
-It is not bound to any key by default: to bind it
-so that you have a bookmark prefix, just use `global-set-key' and bind a
-key of your choice to `bookmark-map'.  All interactive bookmark
-functions have a binding in this keymap.")
-
-;;;###autoload
-(define-prefix-command 'bookmark-map)
-
-;; Read the help on all of these functions for details...
-;;;###autoload
-(define-key bookmark-map "x" 'bookmark-set)
-;;;###autoload
-(define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark"
-;;;###autoload
-(define-key bookmark-map "j" 'bookmark-jump)
-;;;###autoload
-(define-key bookmark-map "g" 'bookmark-jump) ; "g" for "go"
-;;;###autoload
-(define-key bookmark-map "i" 'bookmark-insert)
-;;;###autoload
-(define-key bookmark-map "e" 'edit-bookmarks)
-;;;###autoload
-(define-key bookmark-map "f" 'bookmark-insert-location) ; "f" for "find"
-;;;###autoload
-(define-key bookmark-map "r" 'bookmark-rename)
-;;;###autoload
-(define-key bookmark-map "d" 'bookmark-delete)
-;;;###autoload
-(define-key bookmark-map "l" 'bookmark-load)
-;;;###autoload
-(define-key bookmark-map "w" 'bookmark-write)
-;;;###autoload
-(define-key bookmark-map "s" 'bookmark-save)
-
-
-;;; The annotation maps.
-(defvar bookmark-read-annotation-mode-map (copy-keymap text-mode-map)
-  "Keymap for composing an annotation for a bookmark.")
-
-(define-key bookmark-read-annotation-mode-map "\C-c\C-c"
-  'bookmark-send-annotation)
-
-
-
-;;; Core variables and data structures:
-(defvar bookmark-alist ()
-  "Association list of bookmarks and their records.
-You probably don't want to change the value of this alist yourself;
-instead, let the various bookmark functions do it for you.
-
-The format of the alist is
-
-       \(BOOKMARK1 BOOKMARK2 ...\)
-
-where each BOOKMARK is of the form
-
-\(NAME
-  \(filename . FILE\)
-  \(front-context-string . FRONT-STR\)
-  \(rear-context-string  . REAR-STR\)
-  \(position . POS\)
-  \(info-node . POS\)
-  \(annotation . ANNOTATION\)\)
-
-So the cdr of each bookmark is an alist too.
-`info-node' is optional, by the way.")
-
-
-(defvar bookmarks-already-loaded nil)
-
-
-;; just add the hook to make sure that people don't lose bookmarks
-;; when they kill Emacs, unless they don't want to save them.
-;;;###autoload
-(add-hook 'kill-emacs-hook
-          (function
-           (lambda () (and (featurep 'bookmark)
-                           bookmark-alist
-                           (bookmark-time-to-save-p t)
-                           (bookmark-save)))))
-
-;; more stuff added by db.
-
-(defvar bookmark-current-bookmark nil 
-  "Name of bookmark most recently used in the current file.
-It is buffer local, used to make moving a bookmark forward
-through a file easier.")
-
-(make-variable-buffer-local 'bookmark-current-bookmark)
-
-
-(defvar bookmark-alist-modification-count 0
-  "Number of modifications to bookmark list since it was last saved.")
-
-
-(defvar bookmark-search-size 16
-  "Length of the context strings recorded on either side of a bookmark.")
-
-
-(defvar bookmark-current-point 0)
-(defvar bookmark-yank-point 0)
-(defvar bookmark-current-buffer nil)
-
-
-
-;; Helper functions.
-
-;; Only functions on this page and the next one (file formats) need to
-;; know anything about the format of bookmark-alist entries.
-;; Everyone else should go through them.
-
-(defun bookmark-name-from-full-record (full-record)
-  "Return name of FULL-RECORD \(an alist element instead of a string\)."
-  (car full-record))
-
-
-(defun bookmark-all-names ()
-  "Return a list of all current bookmark names."
-  (bookmark-maybe-load-default-file)
-  (mapcar
-   (lambda (full-record)
-     (bookmark-name-from-full-record full-record))
-   bookmark-alist))
-
-
-(defun bookmark-get-bookmark (bookmark)
-  "Return the full entry for BOOKMARK in bookmark-alist."
-  (assoc bookmark bookmark-alist))
-
-
-(defun bookmark-get-bookmark-record (bookmark)
-  "Return the guts of the entry for BOOKMARK in bookmark-alist.
-That is, all information but the name."
-  (car (cdr (bookmark-get-bookmark bookmark))))
-
-
-(defun bookmark-set-name (bookmark newname)
-  "Set BOOKMARK's name to NEWNAME."
-  (setcar (bookmark-get-bookmark bookmark) newname))
-
-
-(defun bookmark-get-annotation (bookmark)
-  "Return the annotation of BOOKMARK, or nil if none."
-  (cdr (assq 'annotation (bookmark-get-bookmark-record bookmark))))
-
-
-(defun bookmark-set-annotation (bookmark ann)
-  "Set the annotation of BOOKMARK to ANN."
-  (let ((cell (assq 'annotation (bookmark-get-bookmark-record bookmark))))
-    (if cell
-        (setcdr cell ann)
-      (nconc (bookmark-get-bookmark-record bookmark)
-             (list (cons 'annotation ann))))))
-
-
-(defun bookmark-get-filename (bookmark)
-  "Return the full filename of BOOKMARK."
-  (cdr (assq 'filename (bookmark-get-bookmark-record bookmark))))
-
-
-(defun bookmark-set-filename (bookmark filename)
-  "Set the full filename of BOOKMARK to FILENAME."
-  (let ((cell (assq 'filename (bookmark-get-bookmark-record bookmark))))
-    (if cell
-        (setcdr cell filename)
-      (nconc (bookmark-get-bookmark-record bookmark)
-             (list (cons 'filename filename))))))
-
-
-(defun bookmark-get-position (bookmark)
-  "Return the position \(i.e.: point\) of BOOKMARK."
-  (cdr (assq 'position (bookmark-get-bookmark-record bookmark))))
-
-
-(defun bookmark-set-position (bookmark position)
-  "Set the position \(i.e.: point\) of BOOKMARK to POSITION."
-  (let ((cell (assq 'position (bookmark-get-bookmark-record bookmark))))
-    (if cell
-        (setcdr cell position)
-      (nconc (bookmark-get-bookmark-record bookmark)
-             (list (cons 'position position))))))
-
-
-(defun bookmark-get-front-context-string (bookmark)
-  "Return the front-context-string of BOOKMARK."
-  (cdr (assq 'front-context-string (bookmark-get-bookmark-record bookmark))))
-
-
-(defun bookmark-set-front-context-string (bookmark string)
-  "Set the front-context-string of BOOKMARK to STRING."
-  (let ((cell (assq 'front-context-string
-                    (bookmark-get-bookmark-record bookmark))))
-    (if cell
-        (setcdr cell string)
-      (nconc (bookmark-get-bookmark-record bookmark)
-             (list (cons 'front-context-string string))))))
-
-
-(defun bookmark-get-rear-context-string (bookmark)
-  "Return the rear-context-string of BOOKMARK."
-  (cdr (assq 'rear-context-string (bookmark-get-bookmark-record bookmark))))
-
-
-(defun bookmark-set-rear-context-string (bookmark string)
-  "Set the rear-context-string of BOOKMARK to STRING."
-  (let ((cell (assq 'rear-context-string
-                    (bookmark-get-bookmark-record bookmark))))
-    (if cell
-        (setcdr cell string)
-      (nconc (bookmark-get-bookmark-record bookmark)
-             (list (cons 'rear-context-string string))))))
-
-
-(defun bookmark-get-info-node (bookmark)
-  "Get the info node associated with BOOKMARK."
-  (cdr (assq 'info-node (bookmark-get-bookmark-record bookmark))))
-  
-
-(defun bookmark-set-info-node (bookmark node)
-  "Set the Info node of BOOKMARK to NODE."
-  (let ((cell (assq 'info-node
-                    (bookmark-get-bookmark-record bookmark))))
-    (if cell
-        (setcdr cell node)
-      (nconc (bookmark-get-bookmark-record bookmark)
-             (list (cons 'info-node node)))))
-
-  (message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark)))
-  (sit-for 4)
-  )
-  
-
-(defvar bookmark-history nil
-  "The history list for bookmark functions.")
-
-
-(defun bookmark-completing-read (prompt &optional default)
-  "Prompting with PROMPT, read a bookmark name in completion.
-PROMPT will get a \": \" stuck on the end no matter what, so you
-probably don't want to include one yourself.
-Optional second arg DEFAULT is a string to return if the user enters
-the empty string."
-  (bookmark-maybe-load-default-file) ; paranoia
-  (let* ((completion-ignore-case bookmark-completion-ignore-case)
-         (default default)
-         (prompt (if default
-                     (concat prompt (format " (%s): " default))
-                   (concat prompt ": ")))
-         (str
-          (completing-read prompt
-                           bookmark-alist
-                           nil
-                           0
-                           nil
-                           'bookmark-history)))
-    (if (string-equal "" str)
-        (list default)
-      (list str))))
-
-
-(defmacro bookmark-maybe-historicize-string (string)
-  "Put STRING into the bookmark prompt history, if caller non-interactive.
-We need this because sometimes bookmark functions are invoked from
-menus, so `completing-read' never gets a chance to set `bookmark-history'."
-  (` (or
-      (interactive-p)
-      (setq bookmark-history (cons (, string) bookmark-history)))))
-
-
-(defun bookmark-make (name &optional annotation overwrite info-node)
-  "Make a bookmark named NAME.
-Optional second arg ANNOTATION gives it an annotation.
-Optional third arg OVERWRITE means replace any existing bookmarks with
-this name.
-Optional fourth arg INFO-NODE means this bookmark is at info node
-INFO-NODE, so record this fact in the bookmark's entry."
-  (bookmark-maybe-load-default-file)
-  (let ((stripped-name (copy-sequence name)))
-    (or bookmark-xemacsp
-        ;; XEmacs's `set-text-properties' doesn't work on
-        ;; free-standing strings, apparently.
-        (set-text-properties 0 (length stripped-name) nil stripped-name))
-    (if (and (bookmark-get-bookmark stripped-name) (not overwrite))
-        ;; already existing bookmark under that name and
-        ;; no prefix arg means just overwrite old bookmark
-        (setcdr (bookmark-get-bookmark stripped-name)
-                (list (bookmark-make-cell annotation info-node)))
-      
-      ;; otherwise just cons it onto the front (either the bookmark
-      ;; doesn't exist already, or there is no prefix arg.  In either
-      ;; case, we want the new bookmark consed onto the alist...)
-      
-      (setq bookmark-alist
-            (cons
-             (list stripped-name 
-                   (bookmark-make-cell annotation info-node))
-             bookmark-alist)))
-    
-    ;; Added by db
-    (setq bookmark-current-bookmark stripped-name)
-    (setq bookmark-alist-modification-count
-          (1+ bookmark-alist-modification-count))
-    (if (bookmark-time-to-save-p)
-        (bookmark-save))))
-
-
-(defun bookmark-make-cell (annotation &optional info-node)
-  "Return the record part of a new bookmark, given ANNOTATION.
-Must be at the correct position in the buffer in which the bookmark is
-being set.  This might change someday.
-Optional second arg INFO-NODE means this bookmark is at info node
-INFO-NODE, so record this fact in the bookmark's entry."
-  (let ((the-record
-         (` ((filename . (, (bookmark-buffer-file-name)))
-             (front-context-string
-              . (, (if (>= (- (point-max) (point)) bookmark-search-size)
-                       (buffer-substring-no-properties
-                        (point)
-                        (+ (point) bookmark-search-size))
-                     nil)))
-             (rear-context-string
-              . (, (if (>= (- (point) (point-min)) bookmark-search-size)
-                       (buffer-substring-no-properties
-                        (point)
-                        (- (point) bookmark-search-size))
-                     nil)))
-             (position . (, (point)))
-             ))))
-
-    ;; Now fill in the optional parts:
-    (if annotation
-        (nconc the-record (list (cons 'annotation annotation))))
-    (if info-node
-        (nconc the-record (list (cons 'info-node info-node))))
-
-    ;; Finally, return the completed record.
-    the-record))
-    
-  
-
-;;; File format stuff
-
-;; The OLD format of the bookmark-alist was:
-;;
-;;       ((bookmark-name (filename
-;;                        string-in-front
-;;                        string-behind
-;;                        point))
-;;        ...)
-;;
-;; The NEW format of the bookmark-alist is:
-;;
-;;       ((bookmark-name ((filename . FILENAME)
-;;                        (front-context-string . string-in-front)
-;;                        (rear-context-string  . string-behind)
-;;                        (position . POINT)
-;;                        (annotation . annotation)
-;;                        (whatever   . VALUE)
-;;                        ...
-;;                        ))
-;;        ...)
-;;
-;;
-;; I switched to using an internal as well as external alist because I
-;; felt that would be a more flexible framework in which to add
-;; features.  It means that the order in which values appear doesn't
-;; matter, and it means that arbitrary values can be added without
-;; risk of interfering with existing ones.
-;;
-;; BOOKMARK-NAME is the string the user gives the bookmark and
-;; accesses it by from then on.  
-;;
-;; FILENAME is the location of the file in which the bookmark is set.
-;;
-;; STRING-IN-FRONT is a string of `bookmark-search-size' chars of
-;; context in front of the point at which the bookmark is set.
-;;
-;; STRING-BEHIND is the same thing, but after the point.  
-;;
-;; The context strings exist so that modifications to a file don't
-;; necessarily cause a bookmark's position to be invalidated. 
-;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in
-;; case the file has changed since the bookmark was set.  It will
-;; attempt to place the user before the changes, if there were any.
-;; ANNOTATION is the annotation for the bookmark; it may not exist
-;; (for backward compatibility), be nil (no annotation), or be a
-;; string.
-
-
-(defconst bookmark-file-format-version 1
-  "The current version of the format used by bookmark files.
-You should never need to change this.")
-
-
-(defconst bookmark-end-of-version-stamp-marker
-  "-*- End Of Bookmark File Format Version Stamp -*-\n"
-  "This string marks the end of the version stamp in a bookmark file.")
-
-
-(defun bookmark-alist-from-buffer ()
-  "Return a bookmark-alist (in any format) from the current buffer.
-The buffer must of course contain bookmark format information.
-Does not care from where in the buffer it is called, and does not
-affect point."
-  (save-excursion
-    (goto-char (point-min))
-    (if (search-forward bookmark-end-of-version-stamp-marker nil t)
-        (read (current-buffer))
-      ;; Else we're dealing with format version 0
-      (if (search-forward "(" nil t)
-          (progn
-            (forward-char -1)
-            (read (current-buffer)))
-        ;; Else no hope of getting information here.
-        (error "Not bookmark format")))))
-
-
-(defun bookmark-upgrade-version-0-alist (old-list)
-  "Upgrade a version 0 alist OLD-LIST to the current version."
-  (mapcar
-   (lambda (bookmark)
-     (let* ((name      (car bookmark))
-            (record    (car (cdr bookmark)))
-            (filename  (nth 0 record))
-            (front-str (nth 1 record))
-            (rear-str  (nth 2 record))
-            (position  (nth 3 record))
-            (ann       (nth 4 record)))
-       (list
-        name
-        (` ((filename             .    (, filename))
-            (front-context-string .    (, (or front-str "")))
-            (rear-context-string  .    (, (or rear-str  "")))
-            (position             .    (, position))
-            (annotation           .    (, ann)))))))
-   old-list))
-
-
-(defun bookmark-upgrade-file-format-from-0 ()
-  "Upgrade a bookmark file of format 0 (the original format) to format 1.
-This expects to be called from point-min in a bookmark file."
-  (message "Upgrading bookmark format from 0 to %d..."
-           bookmark-file-format-version)
-  (let* ((old-list (bookmark-alist-from-buffer))
-         (new-list (bookmark-upgrade-version-0-alist old-list)))
-    (delete-region (point-min) (point-max))
-    (bookmark-insert-file-format-version-stamp)
-    (pp new-list (current-buffer))
-    (save-buffer))
-  (goto-char (point-min))
-  (message "Upgrading bookmark format from 0 to %d...done"
-           bookmark-file-format-version)
-  )
-
-
-(defun bookmark-grok-file-format-version ()
-  "Return an integer which is the file-format version of this bookmark file.
-This expects to be called from point-min in a bookmark file."
-  (if (looking-at "^;;;;")
-      (save-excursion
-        (save-match-data
-          (re-search-forward "[0-9]")
-          (forward-char -1)
-          (read (current-buffer))))
-    ;; Else this is format version 0, the original one, which didn't
-    ;; even have version stamps.
-    0))
-
-
-(defun bookmark-maybe-upgrade-file-format ()
-  "Check the file-format version of this bookmark file.
-If the version is not up-to-date, upgrade it automatically.
-This expects to be called from point-min in a bookmark file."
-  (let ((version (bookmark-grok-file-format-version)))
-    (cond
-     ((= version bookmark-file-format-version)
-      ) ; home free -- version is current
-     ((= version 0)
-      (bookmark-upgrade-file-format-from-0))
-     (t
-      (error "Bookmark file format version strangeness")))))
-
-
-(defun bookmark-insert-file-format-version-stamp ()
-  "Insert text indicating current version of bookmark file format."
-  (insert
-   (format ";;;; Emacs Bookmark Format Version %d ;;;;\n"
-           bookmark-file-format-version))
-  (insert ";;; This format is meant to be slightly human-readable;\n"
-          ";;; nevertheless, you probably don't want to edit it.\n"
-          ";;; "
-          bookmark-end-of-version-stamp-marker))
-
-
-;;; end file-format stuff
-
-
-;;; Core code:
-
-;;;###autoload
-(defun bookmark-set (&optional name parg)
-  "Set a bookmark named NAME inside a file.
-If name is nil, then the user will be prompted.
-With prefix arg, will not overwrite a bookmark that has the same name
-as NAME if such a bookmark already exists, but instead will \"push\"
-the new bookmark onto the bookmark alist.  Thus the most recently set
-bookmark with name NAME would be the one in effect at any given time,
-but the others are still there, should you decide to delete the most
-recent one.
-
-To yank words from the text of the buffer and use them as part of the
-bookmark name, type C-w while setting a bookmark.  Successive C-w's
-yank successive words.
-
-Typing C-u inserts the name of the last bookmark used in the buffer
-\(as an aid in using a single bookmark name to track your progress
-through a large file\).  If no bookmark was used, then C-u inserts the
-name of the file being visited.
-
-Use \\[bookmark-delete] to remove bookmarks \(you give it a name,
-and it removes only the first instance of a bookmark with that name from
-the list of bookmarks.\)"
-  (interactive (list nil current-prefix-arg))
-  (or
-   (bookmark-buffer-file-name)
-   (error "Buffer not visiting a file or directory"))
-
-  (bookmark-maybe-load-default-file)
-
-  (setq bookmark-current-point (point))
-  (setq bookmark-yank-point (point))
-  (setq bookmark-current-buffer (current-buffer))
-
-  (let* ((default (or bookmark-current-bookmark
-                      (bookmark-buffer-name)))
-	 (str
-	  (or name
-              (read-from-minibuffer
-               (format "Set bookmark (%s): " default)
-               nil
-               (let ((now-map (copy-keymap minibuffer-local-map)))
-                 (progn (define-key now-map  "\C-w" 
-                          'bookmark-yank-word)
-                        (define-key now-map  "\C-u" 
-                          'bookmark-insert-current-bookmark))
-                 now-map))))
-	 (annotation nil))
-    (and (string-equal str "") (setq str default))
-    ;; Ask for an annotation buffer for this bookmark 
-    (if bookmark-use-annotations
-	(bookmark-read-annotation parg str)
-      (progn
-	(bookmark-make str annotation parg (bookmark-info-current-node))
-	(setq bookmark-current-bookmark str)
-	(bookmark-bmenu-surreptitiously-rebuild-list)
-	(goto-char bookmark-current-point)))))
-
-
-(defun bookmark-info-current-node ()
-  "If in Info-mode, return current node name (a string), else nil."
-  (if (eq major-mode 'Info-mode)
-      Info-current-node))
-
-
-(defun bookmark-kill-line (&optional newline-too)
-  "Kill from point to end of line.
-If optional arg NEWLINE-TOO is non-nil, delete the newline too.
-Does not affect the kill-ring."
-  (let ((eol (save-excursion (end-of-line) (point))))
-    (delete-region (point) eol)
-    (if (and newline-too (looking-at "\n"))
-        (delete-char 1))))
-
-
-;; Defvars to avoid compilation warnings:
-(defvar bookmark-annotation-paragraph nil)
-(defvar bookmark-annotation-name nil)
-(defvar bookmark-annotation-buffer nil)
-(defvar bookmark-annotation-file nil)
-(defvar bookmark-annotation-point nil)
-
-
-(defun bookmark-send-annotation ()
-  "Use buffer contents as the annotation for a bookmark.
-Exclude lines that begin with `#'.
-Store the annotation text in the bookmark list with
-the bookmark (and file, and point) specified in buffer local variables."
-  (interactive)
-  (if (not (eq major-mode 'bookmark-read-annotation-mode))
-      (error "Not in bookmark-read-annotation-mode"))
-  (goto-char (point-min))
-  (while (< (point) (point-max))
-    (if (looking-at "^#")
-        (bookmark-kill-line t)
-      (forward-line 1)))
-  (let ((annotation (buffer-substring (point-min) (point-max)))
-	(parg bookmark-annotation-paragraph)
-	(bookmark bookmark-annotation-name)
-	(pt bookmark-annotation-point)
-	(buf bookmark-annotation-buffer))
-    ;; for bookmark-make-cell to work, we need to be
-    ;; in the relevant buffer, at the relevant point.
-    ;; Actually, bookmark-make-cell should probably be re-written,
-    ;; to avoid this need.  Should I handle the error if a buffer is
-    ;; killed between "C-x r m" and a "C-c C-c" in the annotation buffer?
-    (save-excursion 
-      (pop-to-buffer buf)
-      (goto-char pt)
-      (bookmark-make bookmark annotation parg (bookmark-info-current-node))
-      (setq bookmark-current-bookmark bookmark))
-    (bookmark-bmenu-surreptitiously-rebuild-list)
-    (goto-char bookmark-current-point))
-  (kill-buffer (current-buffer)))
-
-
-(defun bookmark-default-annotation-text (bookmark)
-  (concat "#  Type the annotation for bookmark '" bookmark "' here.\n"
-	  "#  All lines which start with a '#' will be deleted.\n"
-	  "#  Type C-c C-c when done.\n#\n"
-	  "#  Author: " (user-full-name) " <" (user-login-name) "@"
-	  (system-name) ">\n"
-	  "#  Date:    " (current-time-string) "\n"))
-
-
-(defvar bookmark-read-annotation-text-func 'bookmark-default-annotation-text
-  "Function to return default text to use for a bookmark annotation.
-It takes the name of the bookmark, as a string, as an arg.")
-
-(defun bookmark-read-annotation-mode (buf point parg bookmark)
-  "Mode for composing annotations for a bookmark.
-Wants BUF POINT PARG and BOOKMARK.
-When you have finished composing, type \\[bookmark-send-annotation] to send
-the annotation.
-
-\\{bookmark-read-annotation-mode-map}
-"
-  (interactive)
-  (kill-all-local-variables)
-  (make-local-variable 'bookmark-annotation-paragraph)
-  (make-local-variable 'bookmark-annotation-name)
-  (make-local-variable 'bookmark-annotation-buffer)
-  (make-local-variable 'bookmark-annotation-file)
-  (make-local-variable 'bookmark-annotation-point)
-  (setq bookmark-annotation-paragraph parg)
-  (setq bookmark-annotation-name bookmark)
-  (setq bookmark-annotation-buffer buf)
-  (setq bookmark-annotation-file (buffer-file-name buf))
-  (setq bookmark-annotation-point point)
-  (use-local-map bookmark-read-annotation-mode-map)
-  (setq major-mode 'bookmark-read-annotation-mode)
-  (insert (funcall bookmark-read-annotation-text-func bookmark))
-  (run-hooks 'text-mode-hook))
-
-
-(defun bookmark-read-annotation (parg bookmark)
-  "Pop up a buffer for entering a bookmark annotation.
-Text surrounding the bookmark is PARG; the bookmark name is BOOKMARK."
-  (let ((buf (current-buffer))
-	(point (point)))
-    (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
-    (bookmark-read-annotation-mode buf point parg bookmark)))
-
-
-(defvar bookmark-edit-annotation-mode-map (copy-keymap text-mode-map)
-  "Keymap for editing an annotation of a bookmark.")
-
-
-(define-key bookmark-edit-annotation-mode-map "\C-c\C-c"
-  'bookmark-send-edited-annotation)
-
-
-(defun bookmark-edit-annotation-mode (bookmark)
-  "Mode for editing the annotation of bookmark BOOKMARK.
-When you have finished composing, type \\[bookmark-send-annotation].
-
-\\{bookmark-edit-annotation-mode-map}
-"
-  (interactive)
-  (kill-all-local-variables)
-  (make-local-variable 'bookmark-annotation-name)
-  (setq bookmark-annotation-name bookmark)
-  (use-local-map bookmark-edit-annotation-mode-map)
-  (setq major-mode 'bookmark-edit-annotation-mode)
-  (insert (funcall bookmark-read-annotation-text-func bookmark))
-  (let ((annotation (bookmark-get-annotation bookmark)))
-    (if (and (not (eq annotation nil))
-	     (not (string-equal annotation "")))
-	(insert annotation)))
-  (run-hooks 'text-mode-hook))
-
-
-(defun bookmark-send-edited-annotation ()
-  "Use buffer contents (minus beginning with `#' as annotation for a bookmark."
-  (interactive)
-  (if (not (eq major-mode 'bookmark-edit-annotation-mode))
-      (error "Not in bookmark-edit-annotation-mode"))
-  (goto-char (point-min))
-  (while (< (point) (point-max))
-    (if (looking-at "^#")
-        (bookmark-kill-line t)
-      (forward-line 1)))
-  (let ((annotation (buffer-substring (point-min) (point-max)))
-	(bookmark bookmark-annotation-name))
-    (bookmark-set-annotation bookmark annotation)
-    (bookmark-bmenu-surreptitiously-rebuild-list)
-    (goto-char bookmark-current-point))
-  (kill-buffer (current-buffer)))
-
-
-(defun bookmark-edit-annotation (bookmark)
-  "Pop up a buffer for editing bookmark BOOKMARK's annotation."
-  (let ((buf (current-buffer))
-	(point (point)))
-    (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
-    (bookmark-edit-annotation-mode bookmark)))
-
-
-(defun bookmark-insert-current-bookmark ()
-  "Insert this buffer's value of bookmark-current-bookmark.
-Default to file name if it's nil."
-  (interactive)
-  (let ((str
-	 (save-excursion
-	   (set-buffer bookmark-current-buffer)
-	   bookmark-current-bookmark)))
-    (if str (insert str) (bookmark-insert-buffer-name))))
-
-
-(defun bookmark-insert-buffer-name ()
-  "Insert the current file name into the bookmark name being set.
-The directory part of the file name is not used."
-  (interactive)
-  (let ((str
-         (save-excursion
-           (set-buffer bookmark-current-buffer)
-           (bookmark-buffer-name))))
-    (insert str)))
-
-
-(defun bookmark-buffer-name ()
-  "Return the name of the current buffer's file, non-directory.
-In Info, return the current node."
-  (cond
-   ;; Are we in Info?
-   ((string-equal mode-name "Info") Info-current-node)
-   ;; Or are we a file?
-   (buffer-file-name (file-name-nondirectory buffer-file-name))
-   ;; Or are we a directory?
-   ((and (boundp 'dired-directory) dired-directory)
-    (let* ((dirname (if (stringp dired-directory)
-                        dired-directory
-                      (car dired-directory)))
-           (idx (1- (length dirname))))
-      ;; Strip the trailing slash.
-      (if (= ?/ (aref dirname idx))
-          (file-name-nondirectory (substring dirname 0 idx))
-        ;; Else return the current-buffer
-        (buffer-name (current-buffer)))))
-   ;; If all else fails, use the buffer's name.
-   (t
-    (buffer-name (current-buffer)))))
-
-
-(defun bookmark-yank-word ()
-  (interactive)
-  ;; get the next word from the buffer and append it to the name of
-  ;; the bookmark currently being set.
-  (let ((string (save-excursion
-                    (set-buffer bookmark-current-buffer)
-                    (goto-char bookmark-yank-point)
-                    (buffer-substring-no-properties
-                     (point)
-                     (save-excursion
-                       (forward-word 1)
-                       (setq bookmark-yank-point (point)))))))
-    (insert string)))
-
-
-(defun bookmark-buffer-file-name ()
-  "Return the current buffer's file in a way useful for bookmarks.
-For example, if this is a Info buffer, return the Info file's name."
-  (if (eq major-mode 'Info-mode)
-        Info-current-file
-    (or
-     buffer-file-name
-     (if (and (boundp 'dired-directory) dired-directory)
-         (if (stringp dired-directory)
-             dired-directory
-           (car dired-directory))))))
-
-
-(defun bookmark-maybe-load-default-file ()
-  (and (not bookmarks-already-loaded)
-       (null bookmark-alist)
-       (prog2
-           (and
-            ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs
-            ;; to be renamed.
-            (file-exists-p (expand-file-name bookmark-old-default-file))
-            (not (file-exists-p (expand-file-name bookmark-default-file)))
-            (rename-file (expand-file-name bookmark-old-default-file)
-                         (expand-file-name bookmark-default-file)))
-           ;; return t so the `and' will continue...
-           t)
-       
-       (file-readable-p (expand-file-name bookmark-default-file))
-       (progn
-         (bookmark-load bookmark-default-file t t)
-         (setq bookmarks-already-loaded t))))
-
-
-(defun bookmark-maybe-sort-alist ()
-  ;;Return the bookmark-alist for display.  If the bookmark-sort-flag
-  ;;is non-nil, then return a sorted copy of the alist.
-  (if bookmark-sort-flag
-      (setq bookmark-alist
-            (sort (copy-alist bookmark-alist)
-                  (function
-                   (lambda (x y) (string-lessp (car x) (car y))))))))
-
-
-;;;###autoload
-(defun bookmark-jump (bookmark)
-  "Jump to bookmark BOOKMARK (a point in some file).  
-You may have a problem using this function if the value of variable
-`bookmark-alist' is nil.  If that happens, you need to load in some
-bookmarks.  See help on function `bookmark-load' for more about
-this.
-
-If the file pointed to by BOOKMARK no longer exists, you will be asked
-if you wish to give the bookmark a new location, and bookmark-jump
-will then jump to the new location, as well as recording it in place
-of the old one in the permanent bookmark record."
-  (interactive
-   (bookmark-completing-read "Jump to bookmark" bookmark-current-bookmark))
-  (bookmark-maybe-historicize-string bookmark)
-  (let ((cell (bookmark-jump-noselect bookmark)))
-    (and cell
-         (switch-to-buffer (car cell))
-         (goto-char (cdr cell))
-	 (if bookmark-automatically-show-annotations
-             ;; if there is an annotation for this bookmark,
-             ;; show it in a buffer.
-             (bookmark-show-annotation bookmark)))))
-
-
-(defun bookmark-jump-noselect (str)
-  ;; a leetle helper for bookmark-jump :-)
-  ;; returns (BUFFER . POINT)
-  (bookmark-maybe-load-default-file)
-  (let* ((file (expand-file-name (bookmark-get-filename str)))
-         (forward-str            (bookmark-get-front-context-string str))
-         (behind-str             (bookmark-get-rear-context-string str))
-         (place                  (bookmark-get-position str))
-         (info-node              (bookmark-get-info-node str))
-         (orig-file              file)
-         )
-    (if (or
-         (file-exists-p file)
-         ;; else try some common compression extensions
-         ;; and Emacs better handle it right!
-         ;; Sigh: I think it may *not* be handled at the moment.  What
-         ;; to do about this?
-         (setq file
-               (or
-                (let ((altname (concat file ".Z")))
-                  (and (file-exists-p altname)
-                       altname))
-                (let ((altname (concat file ".gz")))
-                  (and (file-exists-p altname)
-                       altname))
-                (let ((altname (concat file ".z")))
-                  (and (file-exists-p altname)
-                       altname)))))
-        (save-excursion
-          (if info-node
-              ;; Info nodes must be visited with care.
-              (progn
-                (require 'info)
-                (Info-find-node file info-node))
-            ;; Else no Info.  Can do an ordinary find-file:
-            (set-buffer (find-file-noselect file))
-            (goto-char place))
-
-          ;; Go searching forward first.  Then, if forward-str exists and
-          ;; was found in the file, we can search backward for behind-str.
-          ;; Rationale is that if text was inserted between the two in the
-          ;; file, it's better to be put before it so you can read it,
-          ;; rather than after and remain perhaps unaware of the changes.
-          (if forward-str
-              (if (search-forward forward-str (point-max) t)
-                  (backward-char (length forward-str))))
-          (if behind-str
-              (if (search-backward behind-str (point-min) t)
-                  (forward-char (length behind-str))))
-          ;; added by db
-          (setq bookmark-current-bookmark str)
-          (cons (current-buffer) (point)))
-      (progn
-        (ding)
-        (if (y-or-n-p (concat (file-name-nondirectory orig-file)
-                              " nonexistent.  Relocate \""
-                              str
-                              "\"? "))
-            (progn
-              (bookmark-relocate str)
-              ;; gasp!  It's a recursive function call in Emacs Lisp!
-              (bookmark-jump-noselect str))
-          (message 
-           "Bookmark not relocated; consider removing it \(%s\)." str)
-          nil)))))
-
-
-;;;###autoload
-(defun bookmark-relocate (bookmark)
-  "Relocate BOOKMARK to another file (reading file name with minibuffer).
-This makes an already existing bookmark point to that file, instead of
-the one it used to point at.  Useful when a file has been renamed
-after a bookmark was set in it."
-  (interactive (bookmark-completing-read "Bookmark to relocate"))
-  (bookmark-maybe-historicize-string bookmark)
-  (bookmark-maybe-load-default-file)
-  (let* ((bmrk-filename (bookmark-get-filename bookmark))
-         (newloc (expand-file-name
-                  (read-file-name
-                   (format "Relocate %s to: " bookmark)
-                   (file-name-directory bmrk-filename)))))
-    (bookmark-set-filename bookmark newloc)))
-
-
-;;;###autoload
-(defun bookmark-insert-location (bookmark &optional no-history)
-  "Insert the name of the file associated with BOOKMARK.
-Optional second arg NO-HISTORY means don't record this in the
-minibuffer history list `bookmark-history'."
-  (interactive (bookmark-completing-read "Insert bookmark location"))
-  (or no-history (bookmark-maybe-historicize-string bookmark))
-  (insert (bookmark-location bookmark)))
-
-;;;###autoload
-(defalias 'bookmark-locate 'bookmark-insert-location)
-
-(defun bookmark-location (bookmark)
-  "Return the name of the file associated with BOOKMARK."
-  (bookmark-maybe-load-default-file)
-  (bookmark-get-filename bookmark))
-
-
-;;;###autoload
-(defun bookmark-rename (old &optional new)
-  "Change the name of OLD bookmark to NEW name.
-If called from keyboard, prompt for OLD and NEW.  If called from
-menubar, select OLD from a menu and prompt for NEW.
-
-If called from Lisp, prompt for NEW if only OLD was passed as an
-argument.  If called with two strings, then no prompting is done.  You
-must pass at least OLD when calling from Lisp.
-
-While you are entering the new name, consecutive C-w's insert
-consecutive words from the text of the buffer into the new bookmark
-name."
-  (interactive (bookmark-completing-read "Old bookmark name"))
-  (bookmark-maybe-historicize-string old)
-  (bookmark-maybe-load-default-file)
-  (progn
-    (setq bookmark-current-point (point))
-    (setq bookmark-yank-point (point))
-    (setq bookmark-current-buffer (current-buffer))
-    (let ((newname
-           (or new   ; use second arg, if non-nil
-               (read-from-minibuffer
-                "New name: "
-                nil
-                (let ((now-map (copy-keymap minibuffer-local-map)))
-                  (define-key now-map  "\C-w" 'bookmark-yank-word)
-                  now-map)
-                nil
-                'bookmark-history))))
-      (progn
-	(bookmark-set-name old newname)
-	(setq bookmark-current-bookmark newname)
-        (bookmark-bmenu-surreptitiously-rebuild-list)
-	(setq bookmark-alist-modification-count
-	      (1+ bookmark-alist-modification-count))
-	(if (bookmark-time-to-save-p)
-	    (bookmark-save))))))
-
-
-;;;###autoload
-(defun bookmark-insert (bookmark)
-  "Insert the text of the file pointed to by bookmark BOOKMARK.  
-You may have a problem using this function if the value of variable
-`bookmark-alist' is nil.  If that happens, you need to load in some
-bookmarks.  See help on function `bookmark-load' for more about
-this."
-  (interactive (bookmark-completing-read "Insert bookmark contents"))
-  (bookmark-maybe-historicize-string bookmark)
-  (bookmark-maybe-load-default-file)
-  (let ((orig-point (point))
-        (str-to-insert
-         (save-excursion
-           (set-buffer (car (bookmark-jump-noselect bookmark)))
-           (buffer-substring (point-min) (point-max)))))
-    (insert str-to-insert)
-    (push-mark)
-    (goto-char orig-point)))
-
-
-;;;###autoload
-(defun bookmark-delete (bookmark &optional batch)
-  "Delete BOOKMARK from the bookmark list.  
-Removes only the first instance of a bookmark with that name.  If
-there are one or more other bookmarks with the same name, they will
-not be deleted.  Defaults to the \"current\" bookmark \(that is, the
-one most recently used in this file, if any\).
-Optional second arg BATCH means don't update the bookmark list buffer,
-probably because we were called from there."
-  (interactive
-   (bookmark-completing-read "Delete bookmark" bookmark-current-bookmark))
-  (bookmark-maybe-historicize-string bookmark)
-  (bookmark-maybe-load-default-file)
-  (let ((will-go (bookmark-get-bookmark bookmark)))
-    (setq bookmark-alist (delq will-go bookmark-alist))
-    ;; Added by db, nil bookmark-current-bookmark if the last
-    ;; occurrence has been deleted
-    (or (bookmark-get-bookmark bookmark-current-bookmark)
-        (setq bookmark-current-bookmark nil)))
-  ;; Don't rebuild the list
-  (if batch
-      nil
-    (bookmark-bmenu-surreptitiously-rebuild-list)
-    (setq bookmark-alist-modification-count
-          (1+ bookmark-alist-modification-count))
-    (if (bookmark-time-to-save-p)
-        (bookmark-save))))
-
-
-(defun bookmark-time-to-save-p (&optional last-time)
-  ;; By Gregory M. Saunders <saunders@cis.ohio-state.edu>
-  ;; finds out whether it's time to save bookmarks to a file, by
-  ;; examining the value of variable bookmark-save-flag, and maybe
-  ;; bookmark-alist-modification-count.  Returns t if they should be
-  ;; saved, nil otherwise.  if last-time is non-nil, then this is
-  ;; being called when emacs is killed.
-  (cond (last-time 
-	 (and (> bookmark-alist-modification-count 0)
-	      bookmark-save-flag))
-	((numberp bookmark-save-flag)
-	 (>= bookmark-alist-modification-count bookmark-save-flag))
-	(t
-	 nil)))
-
-
-;;;###autoload
-(defun bookmark-write ()
-  "Write bookmarks to a file (reading the file name with the minibuffer).
-Don't use this in Lisp programs; use `bookmark-save' instead."
-  (interactive)
-  (bookmark-maybe-load-default-file)
-  (bookmark-save t))
-
-
-;;;###autoload
-(defun bookmark-save (&optional parg file) 
-  "Save currently defined bookmarks.
-Saves by default in the file defined by the variable
-`bookmark-default-file'.  With a prefix arg, save it in file FILE
-\(second argument\).
-
-If you are calling this from Lisp, the two arguments are PREFIX-ARG
-and FILE, and if you just want it to write to the default file, then
-pass no arguments.  Or pass in nil and FILE, and it will save in FILE
-instead.  If you pass in one argument, and it is non-nil, then the
-user will be interactively queried for a file to save in.
-
-When you want to load in the bookmarks from a file, use
-\`bookmark-load\', \\[bookmark-load].  That function will prompt you
-for a file, defaulting to the file defined by variable
-`bookmark-default-file'."
-  (interactive "P")
-  (bookmark-maybe-load-default-file)
-  (cond
-   ((and (null parg) (null file))
-    ;;whether interactive or not, write to default file
-    (bookmark-write-file bookmark-default-file))
-   ((and (null parg) file)
-    ;;whether interactive or not, write to given file
-    (bookmark-write-file file))
-   ((and parg (not file))
-    ;;have been called interactively w/ prefix arg
-    (let ((file (read-file-name "File to save bookmarks in: ")))
-      (bookmark-write-file file)))
-   (t ; someone called us with prefix-arg *and* a file, so just write to file
-    (bookmark-write-file file)))
-  ;; signal that we have synced the bookmark file by setting this to
-  ;; 0.  If there was an error at any point before, it will not get
-  ;; set, which is what we want.
-  (setq bookmark-alist-modification-count 0))
-
-
-
-(defun bookmark-write-file (file)
-  (save-excursion
-    (save-window-excursion
-      (if (>= baud-rate 9600)
-          (message "Saving bookmarks to file %s..." file))
-      (set-buffer (let ((enable-local-variables nil))
-                    (find-file-noselect file)))
-      (goto-char (point-min))
-      (delete-region (point-min) (point-max))
-      (bookmark-insert-file-format-version-stamp)
-      (pp bookmark-alist (current-buffer))
-      (let ((version-control
-             (cond
-              ((null bookmark-version-control) nil)
-              ((eq 'never bookmark-version-control) 'never)
-              ((eq 'nospecial bookmark-version-control) version-control)
-              (t
-               t))))
-        (write-file file)
-        (kill-buffer (current-buffer))
-        (if (>= baud-rate 9600)
-            (message "Saving bookmarks to file %s...done" file))
-        ))))
-
-
-;;;###autoload
-(defun bookmark-load (file &optional revert no-msg)
-  "Load bookmarks from FILE (which must be in bookmark format).
-Appends loaded bookmarks to the front of the list of bookmarks.  If
-optional second argument REVERT is non-nil, existing bookmarks are
-destroyed.  Optional third arg NO-MSG means don't display any messages
-while loading.
-
-If you load a file that doesn't contain a proper bookmark alist, you
-will corrupt Emacs's bookmark list.  Generally, you should only load
-in files that were created with the bookmark functions in the first
-place.  Your own personal bookmark file, `~/.emacs.bmk', is
-maintained automatically by Emacs; you shouldn't need to load it
-explicitly."
-  (interactive
-   (list (read-file-name
-          (format "Load bookmarks from: (%s) "
-                  bookmark-default-file)        
-          ;;Default might not be used often,
-          ;;but there's no better default, and
-          ;;I guess it's better than none at all.
-          "~/" bookmark-default-file 'confirm)))
-  (setq file (expand-file-name file))
-  (if (file-readable-p file)
-      (save-excursion
-        (save-window-excursion
-          (if (and (null no-msg) (>= baud-rate 9600))
-              (message "Loading bookmarks from %s..." file))
-          (set-buffer (let ((enable-local-variables nil))
-                        (find-file-noselect file)))
-          (goto-char (point-min))
-          (bookmark-maybe-upgrade-file-format)
-          (let ((blist (bookmark-alist-from-buffer)))
-            (if (listp blist)
-                (progn
-                  (if (not revert)
-                      (setq bookmark-alist-modification-count
-                            (1+ bookmark-alist-modification-count))
-                    (setq bookmark-alist-modification-count 0))
-                  (setq bookmark-alist
-                        (append blist (if (not revert) bookmark-alist)))
-                  (bookmark-bmenu-surreptitiously-rebuild-list)) 
-              (error "Invalid bookmark list in %s" file)))
-          (kill-buffer (current-buffer)))
-	(if (and (null no-msg) (>= baud-rate 9600))
-            (message "Loading bookmarks from %s...done" file)))
-    (error "Cannot read bookmark file %s" file)))
-
-
-
-;;; Code supporting the dired-like bookmark menu.  Prefix is
-;;; "bookmark-bmenu" for "buffer-menu":
-
-
-(defvar bookmark-bmenu-bookmark-column nil)
-
-
-(defvar bookmark-bmenu-hidden-bookmarks ())
-
-
-(defvar bookmark-bmenu-mode-map nil)
-
-
-(if bookmark-bmenu-mode-map
-    nil
-  (setq bookmark-bmenu-mode-map (make-keymap))
-  (suppress-keymap bookmark-bmenu-mode-map t)
-  (define-key bookmark-bmenu-mode-map "q" 'bookmark-bmenu-quit)
-  (define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select)
-  (define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate)
-  (define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window)
-  (define-key bookmark-bmenu-mode-map "1" 'bookmark-bmenu-1-window)
-  (define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window)
-  (define-key bookmark-bmenu-mode-map "\C-c\C-c" 'bookmark-bmenu-this-window)
-  (define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window)
-  (define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window)
-  (define-key bookmark-bmenu-mode-map "\C-o"
-    'bookmark-bmenu-switch-other-window)
-  (define-key bookmark-bmenu-mode-map "s" 'bookmark-bmenu-save)
-  (define-key bookmark-bmenu-mode-map "k" 'bookmark-bmenu-delete)
-  (define-key bookmark-bmenu-mode-map "\C-d" 'bookmark-bmenu-delete-backwards)
-  (define-key bookmark-bmenu-mode-map "x" 'bookmark-bmenu-execute-deletions)
-  (define-key bookmark-bmenu-mode-map "d" 'bookmark-bmenu-delete)
-  (define-key bookmark-bmenu-mode-map " " 'next-line)
-  (define-key bookmark-bmenu-mode-map "n" 'next-line)
-  (define-key bookmark-bmenu-mode-map "p" 'previous-line)
-  (define-key bookmark-bmenu-mode-map "\177" 'bookmark-bmenu-backup-unmark)
-  (define-key bookmark-bmenu-mode-map "?" 'describe-mode)
-  (define-key bookmark-bmenu-mode-map "u" 'bookmark-bmenu-unmark)
-  (define-key bookmark-bmenu-mode-map "m" 'bookmark-bmenu-mark)
-  (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load) 
-  (define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename)
-  (define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames)
-  (define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation)
-  (define-key bookmark-bmenu-mode-map "A" 'bookmark-bmenu-show-all-annotations)
-  (define-key bookmark-bmenu-mode-map "e" 'bookmark-bmenu-edit-annotation))
-
-  
-
-;; Bookmark Buffer Menu mode is suitable only for specially formatted
-;; data.
-(put 'bookmark-bmenu-mode 'mode-class 'special)
-
-
-;; todo: need to display whether or not bookmark exists as a buffer in
-;; flag column. 
-
-;; Format:
-;; FLAGS  BOOKMARK [ LOCATION ]
-
-
-(defun bookmark-bmenu-surreptitiously-rebuild-list ()
-  "Rebuild the Bookmark List if it exists.
-Don't affect the buffer ring order."
-  (if (get-buffer "*Bookmark List*")
-      (save-excursion
-        (save-window-excursion 
-          (bookmark-bmenu-list)))))
-
-
-;;;###autoload
-(defun bookmark-bmenu-list ()
-  "Display a list of existing bookmarks.
-The list is displayed in a buffer named `*Bookmark List*'.
-The leftmost column displays a D if the bookmark is flagged for
-deletion, or > if it is flagged for displaying."
-  (interactive)
-  (bookmark-maybe-load-default-file)
-  (if (interactive-p)
-      (switch-to-buffer (get-buffer-create "*Bookmark List*"))
-    (set-buffer (get-buffer-create "*Bookmark List*")))
-  (let ((buffer-read-only nil))
-    (delete-region (point-max) (point-min))
-    (goto-char (point-min)) ;sure are playing it safe...
-    (insert "% Bookmark\n- --------\n")
-    (bookmark-maybe-sort-alist)
-    (mapcar
-     (lambda (full-record)
-       ;; if a bookmark has an annotation, prepend a "*"
-       ;; in the list of bookmarks.
-       (let ((annotation (bookmark-get-annotation
-                          (bookmark-name-from-full-record full-record))))
-         (if (and (not (eq annotation nil))
-                  (not (string-equal annotation "")))
-             (insert " *")
-           (insert "  "))
-         (insert (concat (bookmark-name-from-full-record full-record) "\n"))))
-     bookmark-alist))
-  (goto-char (point-min))
-  (forward-line 2)
-  (bookmark-bmenu-mode)
-  (if bookmark-bmenu-toggle-filenames
-      (bookmark-bmenu-toggle-filenames t)))
-
-;;;###autoload
-(defalias 'list-bookmarks 'bookmark-bmenu-list)
-;;;###autoload
-(defalias 'edit-bookmarks 'bookmark-bmenu-list)
-
-
-
-(defun bookmark-bmenu-mode ()
-  "Major mode for editing a list of bookmarks.
-Each line describes one of the bookmarks in Emacs.
-Letters do not insert themselves; instead, they are commands.
-Bookmark names preceded by a \"*\" have annotations.
-\\<bookmark-bmenu-mode-map>
-\\[bookmark-bmenu-mark] -- mark bookmark to be displayed.
-\\[bookmark-bmenu-select] -- select bookmark of line point is on.
-  Also show bookmarks marked using m in other windows.
-\\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names).
-\\[bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark.
-\\[bookmark-bmenu-1-window] -- select this bookmark in full-frame window.
-\\[bookmark-bmenu-2-window] -- select this bookmark in one window,
-  together with bookmark selected before this one in another window.
-\\[bookmark-bmenu-this-window] -- select this bookmark in place of the bookmark menu buffer.
-\\[bookmark-bmenu-other-window] -- select this bookmark in another window,
-  so the bookmark menu bookmark remains visible in its window.
-\\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark.
-\\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).   
-\\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
-\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up. 
-\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'.
-\\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
-  With a prefix arg, prompts for a file to save in.
-\\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
-\\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
-  With prefix argument, also move up one line.
-\\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
-\\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark
-  in another buffer.
-\\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
-\\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
-  (kill-all-local-variables)
-  (use-local-map bookmark-bmenu-mode-map)
-  (setq truncate-lines t)
-  (setq buffer-read-only t)
-  (setq major-mode 'bookmark-bmenu-mode)
-  (setq mode-name "Bookmark Menu")
-  (run-hooks 'bookmark-bmenu-mode-hook))
-
-
-(defun bookmark-bmenu-toggle-filenames (&optional show)
-  "Toggle whether filenames are shown in the bookmark list.
-Optional argument SHOW means show them unconditionally."
-  (interactive)
-  (cond
-   (show
-    (setq bookmark-bmenu-toggle-filenames nil)
-    (bookmark-bmenu-show-filenames)
-    (setq bookmark-bmenu-toggle-filenames t))
-   (bookmark-bmenu-toggle-filenames
-    (bookmark-bmenu-hide-filenames)
-    (setq bookmark-bmenu-toggle-filenames nil))
-   (t
-    (bookmark-bmenu-show-filenames)
-    (setq bookmark-bmenu-toggle-filenames t))))
-
-
-(defun bookmark-bmenu-show-filenames (&optional force)
-  (if (and (not force) bookmark-bmenu-toggle-filenames)
-      nil ;already shown, so do nothing
-    (save-excursion
-      (save-window-excursion
-        (goto-char (point-min))
-        (forward-line 2)
-        (setq bookmark-bmenu-hidden-bookmarks ())
-        (let ((buffer-read-only nil))
-          (while (< (point) (point-max))
-            (let ((bmrk (bookmark-bmenu-bookmark)))
-              (setq bookmark-bmenu-hidden-bookmarks
-                    (cons bmrk bookmark-bmenu-hidden-bookmarks))
-              (move-to-column bookmark-bmenu-file-column t)
-              (delete-region (point) (progn (end-of-line) (point)))
-              (insert "  ")
-              ;; Pass the NO-HISTORY arg:
-              (bookmark-insert-location bmrk t)
-              (forward-line 1))))))))
-
-
-(defun bookmark-bmenu-hide-filenames (&optional force)
-  (if (and (not force) bookmark-bmenu-toggle-filenames)
-      ;; nothing to hide if above is nil
-      (save-excursion
-        (save-window-excursion
-          (goto-char (point-min))
-          (forward-line 2)
-          (setq bookmark-bmenu-hidden-bookmarks
-                (nreverse bookmark-bmenu-hidden-bookmarks))
-          (save-excursion
-            (goto-char (point-min))
-            (search-forward "Bookmark")
-            (backward-word 1)
-            (setq bookmark-bmenu-bookmark-column (current-column)))
-          (save-excursion
-            (let ((buffer-read-only nil))
-              (while bookmark-bmenu-hidden-bookmarks
-                (move-to-column bookmark-bmenu-bookmark-column t)
-                (bookmark-kill-line)
-                (insert (car bookmark-bmenu-hidden-bookmarks))
-                (setq bookmark-bmenu-hidden-bookmarks
-                      (cdr bookmark-bmenu-hidden-bookmarks))
-                (forward-line 1))))))))
-
-
-;; if you look at this next function from far away, it resembles a
-;; gun.  But only with this comment above... 
-(defun bookmark-bmenu-check-position ()
-  ;; Returns t if on a line with a bookmark.
-  ;; Otherwise, repositions and returns t.
-  ;; written by David Hughes <djh@harston.cv.com>
-  ;; Mucho thanks, David!  -karl
-  (cond ((< (count-lines (point-min) (point)) 2)
-         (goto-char (point-min))
-         (forward-line 2)
-         t)
-        ((and (bolp) (eobp))
-         (beginning-of-line 0)
-         t)
-        (t
-         t)))
-
-
-(defun bookmark-bmenu-bookmark ()
-  ;; return a string which is bookmark of this line.
-  (if (bookmark-bmenu-check-position)
-      (save-excursion
-        (save-window-excursion
-          (goto-char (point-min))
-          (search-forward "Bookmark")
-          (backward-word 1)
-          (setq bookmark-bmenu-bookmark-column (current-column)))))
-  (if bookmark-bmenu-toggle-filenames
-      (bookmark-bmenu-hide-filenames))
-  (save-excursion
-    (save-window-excursion
-      (beginning-of-line)
-      (forward-char bookmark-bmenu-bookmark-column)
-      (prog1
-          (buffer-substring (point)
-                            (progn 
-                              (end-of-line)
-                              (point)))
-        ;; well, this is certainly crystal-clear:
-        (if bookmark-bmenu-toggle-filenames
-            (bookmark-bmenu-toggle-filenames t))))))
-
-
-(defun bookmark-show-annotation (bookmark)
-  "Display the annotation for bookmark named BOOKMARK in a buffer,
-if an annotation exists."
-  (let ((annotation (bookmark-get-annotation bookmark)))
-    (if (and (not (eq annotation nil))
-	     (not (string-equal annotation "")))
-	(progn
-          (save-excursion
-	    (let ((old-buf (current-buffer)))
-	      (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
-	      (delete-region (point-min) (point-max))
-	      ; (insert (concat "Annotation for bookmark '" bookmark "':\n\n"))
-	      (insert annotation)
-	      (goto-char (point-min))
-	      (pop-to-buffer old-buf)))))))
-
-
-(defun bookmark-show-all-annotations ()
-  "Display the annotations for all bookmarks in a buffer."
-  (let ((old-buf (current-buffer)))
-    (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
-    (delete-region (point-min) (point-max))
-    (mapcar
-     (lambda (full-record)
-       (let* ((name (bookmark-name-from-full-record full-record))
-              (ann  (bookmark-get-annotation name)))
-         (insert (concat name ":\n"))
-         (if (and (not (eq ann nil)) (not (string-equal ann "")))
-             ;; insert the annotation, indented by 4 spaces.
-             (progn
-               (save-excursion (insert ann))
-               (while (< (point) (point-max))
-                 (beginning-of-line) ; paranoia
-                 (insert "    ")
-                 (forward-line)
-                 (end-of-line))))))
-     bookmark-alist)
-    (goto-char (point-min))
-    (pop-to-buffer old-buf)))
-
-
-(defun bookmark-bmenu-mark ()
-  "Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
-  (interactive)
-  (beginning-of-line)
-  (if (bookmark-bmenu-check-position)
-      (let ((buffer-read-only nil))
-        (delete-char 1)
-        (insert ?>)
-        (forward-line 1))))
-
-
-(defun bookmark-bmenu-select ()
-  "Select this line's bookmark; also display bookmarks marked with `>'.
-You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] command."
-  (interactive)
-  (if (bookmark-bmenu-check-position)
-      (let ((bmrk (bookmark-bmenu-bookmark))
-            (menu (current-buffer))	      
-            (others ())
-            tem)
-        (goto-char (point-min))
-        (while (re-search-forward "^>" nil t)
-          (setq tem (bookmark-bmenu-bookmark))
-          (let ((buffer-read-only nil))
-            (delete-char -1)
-            (insert ?\ ))
-          (or (string-equal tem bmrk) 
-              (member tem others) 
-              (setq others (cons tem others))))
-        (setq others (nreverse others)
-              tem (/ (1- (frame-height)) (1+ (length others))))
-        (delete-other-windows)
-        (bookmark-jump bmrk)
-        (bury-buffer menu)
-        (if others
-            (while others
-              (split-window nil tem)
-              (other-window 1)
-              (bookmark-jump (car others))
-              (setq others (cdr others)))
-          (other-window 1)))))
-
-
-(defun bookmark-bmenu-save (parg)
-  "Save the current list into a bookmark file.
-With a prefix arg, prompts for a file to save them in."
-  (interactive "P")
-  (save-excursion
-    (save-window-excursion
-      (bookmark-save parg))))
-
-
-(defun bookmark-bmenu-load ()
-  "Load the bookmark file and rebuild the bookmark menu-buffer."
-  (interactive)
-  (if (bookmark-bmenu-check-position)
-      (save-excursion
-        (save-window-excursion
-          ;; This will call `bookmark-bmenu-list'
-          (call-interactively 'bookmark-load)))))
-
-
-(defun bookmark-bmenu-1-window ()
-  "Select this line's bookmark, alone, in full frame."
-  (interactive)
-  (if (bookmark-bmenu-check-position)
-      (progn
-        (bookmark-jump (bookmark-bmenu-bookmark))
-        (bury-buffer (other-buffer))
-        (delete-other-windows))))
-
-
-(defun bookmark-bmenu-2-window ()
-  "Select this line's bookmark, with previous buffer in second window."
-  (interactive)
-  (if (bookmark-bmenu-check-position)
-      (let ((bmrk (bookmark-bmenu-bookmark))
-            (menu (current-buffer))
-            (pop-up-windows t))
-        (delete-other-windows)
-        (switch-to-buffer (other-buffer))
-	(let* ((pair (bookmark-jump-noselect bmrk))
-               (buff (car pair))
-               (pos  (cdr pair)))
-          (pop-to-buffer buff)
-          (goto-char pos))
-        (bury-buffer menu))))
-
-
-(defun bookmark-bmenu-this-window ()
-  "Select this line's bookmark in this window."
-  (interactive)
-  (if (bookmark-bmenu-check-position)
-      (bookmark-jump (bookmark-bmenu-bookmark))))
-
-
-(defun bookmark-bmenu-other-window ()
-  "Select this line's bookmark in other window, leaving bookmark menu visible."
-  (interactive)
-  (let ((bookmark (bookmark-bmenu-bookmark)))
-    (if (bookmark-bmenu-check-position)
-	(let* ((pair (bookmark-jump-noselect bookmark))
-               (buff (car pair))
-               (pos  (cdr pair)))
-	  (switch-to-buffer-other-window buff)
-          (goto-char pos)
-          (set-window-point (get-buffer-window buff) pos)
-	  (bookmark-show-annotation bookmark)))))
-
-
-(defun bookmark-bmenu-switch-other-window ()
-  "Make the other window select this line's bookmark.
-The current window remains selected."
-  (interactive)
-  (let ((bookmark (bookmark-bmenu-bookmark)))
-    (if (bookmark-bmenu-check-position)
-	(let* ((pair (bookmark-jump-noselect bookmark))
-               (buff (car pair))
-               (pos  (cdr pair)))
-	  (display-buffer buff)
-          (let ((o-buffer (current-buffer)))
-            ;; save-excursion won't do
-            (set-buffer buff)
-            (goto-char pos)
-            (set-window-point (get-buffer-window buff) pos)
-            (set-buffer o-buffer))
-	  (bookmark-show-annotation bookmark)))))
-
-
-(defun bookmark-bmenu-show-annotation ()
-  "Show the annotation for the current bookmark in another window."
-  (interactive)
-  (let ((bookmark (bookmark-bmenu-bookmark)))
-    (if (bookmark-bmenu-check-position)
-	(bookmark-show-annotation bookmark))))
-
-
-(defun bookmark-bmenu-show-all-annotations ()
-  "Show the annotation for all bookmarks in another window."
-  (interactive)
-  (bookmark-show-all-annotations))
-
-
-(defun bookmark-bmenu-edit-annotation ()
-  "Edit the annotation for the current bookmark in another window."
-  (interactive)
-  (let ((bookmark (bookmark-bmenu-bookmark)))
-    (if (bookmark-bmenu-check-position)
-	(bookmark-edit-annotation bookmark))))
-
-
-(defun bookmark-bmenu-quit ()
-  "Quit the bookmark menu."
-  (interactive)
-  (let ((buffer (current-buffer)))
-    (switch-to-buffer (other-buffer))
-    (bury-buffer buffer)))
-
-
-(defun bookmark-bmenu-unmark (&optional backup)
-  "Cancel all requested operations on bookmark on this line and move down.
-Optional BACKUP means move up."
-  (interactive "P")
-  (beginning-of-line)
-  (if (bookmark-bmenu-check-position)
-      (progn
-        (let ((buffer-read-only nil))
-          (delete-char 1)
-          ;; any flags to reset according to circumstances?  How about a
-          ;; flag indicating whether this bookmark is being visited?
-          ;; well, we don't have this now, so maybe later.
-          (insert " "))
-        (forward-line (if backup -1 1)))))
-
-
-(defun bookmark-bmenu-backup-unmark ()
-  "Move up and cancel all requested operations on bookmark on line above."
-  (interactive)
-  (forward-line -1)
-  (if (bookmark-bmenu-check-position)
-      (progn
-        (bookmark-bmenu-unmark)
-        (forward-line -1))))
-
-
-(defun bookmark-bmenu-delete ()
-  "Mark bookmark on this line to be deleted.
-To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
-  (interactive)
-  (beginning-of-line)
-  (if (bookmark-bmenu-check-position)
-      (let ((buffer-read-only nil))
-        (delete-char 1)
-        (insert ?D)
-        (forward-line 1))))
-
-
-(defun bookmark-bmenu-delete-backwards ()
-  "Mark bookmark on this line to be deleted, then move up one line.
-To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
-  (interactive)
-  (bookmark-bmenu-delete)
-  (forward-line -2)
-  (if (bookmark-bmenu-check-position)
-      (forward-line 1)))
-
-
-(defun bookmark-bmenu-execute-deletions ()
-  "Delete bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
-  (interactive)
-  (message "Deleting bookmarks...")
-  (let ((hide-em bookmark-bmenu-toggle-filenames)
-        (o-point  (point))
-        (o-str    (save-excursion
-                    (beginning-of-line)
-                    (if (looking-at "^D")
-                        nil
-                      (buffer-substring
-                       (point)
-                       (progn (end-of-line) (point))))))
-        (o-col     (current-column)))
-    (if hide-em (bookmark-bmenu-hide-filenames))
-    (setq bookmark-bmenu-toggle-filenames nil)
-    (goto-char (point-min))
-    (forward-line 1)
-    (while (re-search-forward "^D" (point-max) t)
-      (bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg
-    (bookmark-bmenu-list)
-    (setq bookmark-bmenu-toggle-filenames hide-em)
-    (if bookmark-bmenu-toggle-filenames
-        (bookmark-bmenu-toggle-filenames t))
-    (if o-str
-        (progn
-          (goto-char (point-min))
-          (search-forward o-str)
-          (beginning-of-line)
-          (forward-char o-col))
-      (goto-char o-point))
-    (beginning-of-line)
-    (setq bookmark-alist-modification-count
-          (1+ bookmark-alist-modification-count))
-    (if (bookmark-time-to-save-p)
-        (bookmark-save))
-    (message "Deleting bookmarks...done")
-    ))
-
-
-(defun bookmark-bmenu-rename ()
-  "Rename bookmark on current line.  Prompts for a new name."
-  (interactive)
-  (if (bookmark-bmenu-check-position)
-      (let ((bmrk (bookmark-bmenu-bookmark))
-            (thispoint (point)))
-        (bookmark-rename bmrk)
-        (bookmark-bmenu-list)
-        (goto-char thispoint))))
-
-
-(defun bookmark-bmenu-locate ()
-  "Display location of this bookmark.  Displays in the minibuffer."
-  (interactive)
-  (if (bookmark-bmenu-check-position)
-      (let ((bmrk (bookmark-bmenu-bookmark)))
-        (message (bookmark-location bmrk)))))
-
-
-
-;;; Menu bar stuff.  Prefix is "bookmark-menu".
-
-(defun bookmark-menu-build-paned-menu (name entries)
-  "Build a multi-paned menu named NAME from the strings in ENTRIES.
-That is, ENTRIES is a list of strings which appear as the choices
-in the menu.  The number of panes depends on the number of entries.
-The visible entries are truncated to `bookmark-menu-length', but the
-strings returned are not."
-  (let* ((f-height (/ (frame-height) 2))
-         (pane-list
-          (let (temp-pane-list
-                (iter 0))
-            (while entries
-              (let (lst
-                    (count 0))
-                (while (and (< count f-height) entries)
-                  (let ((str (car entries)))
-                    (setq lst (cons
-                               (cons
-                                (if (> (length str) bookmark-menu-length)
-                                    (substring str 0 bookmark-menu-length)
-                                  str)
-                                str)
-                               lst))
-                    (setq entries (cdr entries))
-                    (setq count (1+ count))))
-                (setq iter (1+ iter))
-                (setq
-                 temp-pane-list
-                 (cons
-                  (cons
-                   (format "-*- %s (%d) -*-" name iter)
-                   (nreverse lst))
-                  temp-pane-list))))
-            (nreverse temp-pane-list))))
-
-    ;; Return the menu:
-    (cons (concat "-*- " name " -*-") pane-list)))
-
-
-(defun bookmark-build-xemacs-menu (name entries function)
-  "Build a menu named NAME from the strings in ENTRIES.
-That is, ENTRIES is a list of strings that appear as the choices
-in the menu.
-The visible entries are truncated to `bookmark-menu-length', but the
-strings returned are not."
-  (let* (lst 
-	 (pane-list
-	  (progn
-	    (while entries
-	      (let ((str (car entries)))
-		(setq lst (cons
-			   (vector
-			    (if (> (length str) bookmark-menu-length)
-				(substring str 0 bookmark-menu-length)
-			      str)
-			    (list function str)
-			    t)
-			   lst))
-		(setq entries (cdr entries))))
-	    (nreverse lst))))
-
-    ;; Return the menu:
-    (append (if popup-menu-titles (list (concat "-*- " name " -*-")))
- 	    pane-list)))
-
-
-(defun bookmark-menu-popup-paned-menu (event name entries)
-  "Pop up multi-paned menu at EVENT, return string chosen from ENTRIES.
-That is, ENTRIES is a list of strings which appear as the choices
-in the menu.
-The number of panes depends on the number of entries."
-  (interactive "e")
-  (x-popup-menu event (bookmark-menu-build-paned-menu name entries)))
-
-
-(defun bookmark-menu-popup-paned-bookmark-menu (event name)
-  "Pop up menu of bookmarks, return chosen bookmark.
-Pop up at EVENT, menu's name is NAME.
-The number of panes depends on the number of bookmarks."
-  (bookmark-menu-popup-paned-menu event name (bookmark-all-names)))
-
-
-(defun bookmark-popup-menu-and-apply-function (func-sym menu-label event)
-  ;; help function for making menus that need to apply a bookmark
-  ;; function to a string.
-  (let* ((choice (bookmark-menu-popup-paned-bookmark-menu
-                  event menu-label)))
-    (if choice (apply func-sym (list choice)))))
-
-
-;;;###autoload
-(defun bookmark-menu-insert (event)
-  "Insert the text of the file pointed to by bookmark BOOKMARK.  
-You may have a problem using this function if the value of variable
-`bookmark-alist' is nil.  If that happens, you need to load in some
-bookmarks.  See help on function `bookmark-load' for more about
-this.
-
-Warning: this function only takes an EVENT as argument.  Use the
-corresponding bookmark function from Lisp \(the one without the
-\"-menu-\" in its name\)."
-  (interactive "e")
-  (bookmark-popup-menu-and-apply-function
-   'bookmark-insert "Insert Bookmark Contents" event))
-
-
-;;;###autoload
-(defun bookmark-menu-jump (event)
-  "Jump to bookmark BOOKMARK (a point in some file).  
-You may have a problem using this function if the value of variable
-`bookmark-alist' is nil.  If that happens, you need to load in some
-bookmarks.  See help on function `bookmark-load' for more about
-this.
-
-Warning: this function only takes an EVENT as argument.  Use the
-corresponding bookmark function from Lisp \(the one without the
-\"-menu-\" in its name\)."
-  (interactive "e")
-  (bookmark-popup-menu-and-apply-function
-   'bookmark-jump "Jump to Bookmark" event))
-
-
-;;;###autoload
-(defun bookmark-menu-locate (event)
-  "Insert the name of the file associated with BOOKMARK. 
-\(This is not the same as the contents of that file\).
-
-Warning: this function only takes an EVENT as argument.  Use the
-corresponding bookmark function from Lisp \(the one without the
-\"-menu-\" in its name\)."
-  (interactive "e")
-  (bookmark-popup-menu-and-apply-function
-   'bookmark-insert-location "Insert Bookmark Location" event))
-
-
-;;;###autoload
-(defun bookmark-menu-rename (event)
-  "Change the name of OLD-BOOKMARK to NEWNAME.  
-If called from keyboard, prompts for OLD-BOOKMARK and NEWNAME.
-If called from menubar, OLD-BOOKMARK is selected from a menu, and
-prompts for NEWNAME. 
-If called from Lisp, prompts for NEWNAME if only OLD-BOOKMARK was
-passed as an argument.  If called with two strings, then no prompting
-is done.  You must pass at least OLD-BOOKMARK when calling from Lisp.
-
-While you are entering the new name, consecutive C-w's insert
-consecutive words from the text of the buffer into the new bookmark
-name.
-
-Warning: this function only takes an EVENT as argument.  Use the
-corresponding bookmark function from Lisp \(the one without the
-\"-menu-\" in its name\)."
-  (interactive "e")
-  (bookmark-popup-menu-and-apply-function
-   'bookmark-rename "Rename Bookmark" event))
-
-
-;;;###autoload
-(defun bookmark-menu-delete (event)
-  "Delete the bookmark named NAME from the bookmark list.  
-Removes only the first instance of a bookmark with that name.  If
-there are one or more other bookmarks with the same name, they will
-not be deleted.  Defaults to the \"current\" bookmark \(that is, the
-one most recently used in this file, if any\).
-
-Warning: this function only takes an EVENT as argument.  Use the
-corresponding bookmark function from Lisp \(the one without the
-\"-menu-\" in its name\)."
-  (interactive "e")
-  (bookmark-popup-menu-and-apply-function
-   'bookmark-delete "Delete Bookmark" event))
-
-
-;; Thanks to Roland McGrath for fixing menubar.el so that the
-;; following works, and for explaining what to do to make it work.
-
-;; We MUST autoload EACH form used to set up this variable's value, so
-;; that the whole job is done in loaddefs.el.
-
-;; Emacs menubar stuff.
-
-;;;###autoload
-(defvar menu-bar-bookmark-map (make-sparse-keymap "Bookmark functions"))
-
-;;;###autoload
-(defalias 'menu-bar-bookmark-map (symbol-value 'menu-bar-bookmark-map))
-
-;; make bookmarks appear toward the right side of the menu.
-(if (boundp 'menu-bar-final-items)
-    (if menu-bar-final-items 
-        (setq menu-bar-final-items
-              (cons 'bookmark menu-bar-final-items)))
-  (setq menu-bar-final-items '(bookmark)))
-
-;;;###autoload
-(define-key menu-bar-bookmark-map [load]
-  '("Load a Bookmark File..." . bookmark-load))
-
-;;;###autoload
-(define-key menu-bar-bookmark-map [write]
-  '("Save Bookmarks As..." . bookmark-write))
-
-;;;###autoload
-(define-key menu-bar-bookmark-map [save]
-  '("Save Bookmarks" . bookmark-save))
-
-;;;###autoload
-(define-key menu-bar-bookmark-map [edit]
-  '("Edit Bookmark List" . bookmark-bmenu-list))
-
-;;;###autoload
-(define-key menu-bar-bookmark-map [delete]
-  '("Delete Bookmark" . bookmark-menu-delete))
-
-;;;###autoload
-(define-key menu-bar-bookmark-map [rename]
-  '("Rename Bookmark" . bookmark-menu-rename))
-
-;;;###autoload
-(define-key menu-bar-bookmark-map [locate]
-  '("Insert Location" . bookmark-menu-locate))
-
-;;;###autoload
-(define-key menu-bar-bookmark-map [insert]
-  '("Insert Contents" . bookmark-menu-insert))
-
-;;;###autoload
-(define-key menu-bar-bookmark-map [set]
-  '("Set Bookmark" . bookmark-set))
-
-;;;###autoload
-(define-key menu-bar-bookmark-map [jump] 
-  '("Jump to Bookmark" . bookmark-menu-jump))
-
-;;;; end bookmark menu stuff ;;;;
-
-
-;;; Load Hook
-(defvar bookmark-load-hook nil
-  "Hook to run at the end of loading bookmark.")
-
-(run-hooks 'bookmark-load-hook)
-
-(provide 'bookmark)
-      
-;;; bookmark.el ends here
diff --git a/lisp/browse-url.el b/lisp/browse-url.el
deleted file mode 100644
index d4e6988a387..00000000000
--- a/lisp/browse-url.el
+++ /dev/null
@@ -1,764 +0,0 @@
-;;; browse-url.el --- ask a WWW browser to load a URL
-
-;; Copyright 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Denis Howe <dbh@doc.ic.ac.uk>
-;; Maintainer: Denis Howe <dbh@doc.ic.ac.uk>
-;; Created: 03 Apr 1995
-;; Keywords: hypertext
-;; X-Home page: http://wombat.doc.ic.ac.uk/
-
-;; 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:
-
-;; The latest version of this package should be available from
-;; <URL:http://wombat.doc.ic.ac.uk/emacs/browse-url.el>.
-
-;; This package provides functions which read a URL (Uniform Resource
-;; Locator) from the minibuffer, defaulting to the URL around point,
-;; and ask a World-Wide Web browser to load it.  It can also load the
-;; URL associated with the current buffer.  Different browsers use
-;; different methods of remote control so there is one function for
-;; each supported browser.  If the chosen browser is not running, it
-;; is started.  Currently there is support for:
-
-;; Function              Browser     Earliest version
-;; browse-url-netscape   Netscape    1.1b1         
-;; browse-url-mosaic     XMosaic     <= 2.4
-;; browse-url-cci        XMosaic     2.5
-;; browse-url-w3         w3          0
-;; browse-url-iximosaic  IXI Mosaic  ?
-;; browse-url-lynx-*	 Lynx	     0
-;; browse-url-grail      Grail       0.3b1
-
-;; Note that versions of Netscape before 1.1b1 did not have remote
-;; control.  <URL:http://www.netscape.com/newsref/std/x-remote.html>
-;; and <URL:http://www.netscape.com/info/APIs/>.
-
-;; Netscape can cache Web pages so it may be necessary to tell it to
-;; reload the current page if it has changed (e.g. if you have edited
-;; it).  There is currently no perfect automatic solution to this.
-
-;; Netscape allows you to specify the id of the window you want to
-;; control but which window DO you want to control and how do you
-;; discover its id?
-
-;; If using XMosaic before version 2.5, check the definition of
-;; browse-url-usr1-signal below.
-;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html>
-
-;; XMosaic version 2.5 introduced Common Client Interface allowing you
-;; to control mosaic through Unix sockets.
-;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/CCI/cci-spec.html>
-
-;; William M. Perry's excellent "w3" WWW browser for
-;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/>
-;; has a function w3-follow-url-at-point, but that
-;; doesn't let you edit the URL like browse-url.
-
-;; I recommend Nelson Minar <nelson@santafe.edu>'s excellent
-;; html-helper-mode.el for editing HTML and thank Nelson for
-;; his many useful comments on this code.
-;; <URL:http://www.santafe.edu/~nelson/hhm-beta/>
-
-;; This package generalises function html-previewer-process in Marc
-;; Andreessen <marca@ncsa.uiuc.edu>'s html-mode (LCD
-;; modes/html-mode.el.Z) and provides better versions of the URL
-;; functions in Michelangelo Grigni <mic@cs.ucsd.edu>'s ffap.el
-;; (find-file-at-point) <URL:ftp://cs.ucsd.edu:/pub/mic/>.  The huge
-;; hyperbole package also contains similar functions.
-
-;; Grail is the freely available WWW browser implemented in Python, a
-;; cool object-oriented freely available interpreted language.  Grail
-;; 0.3b1 was the first version to have remote control as distributed.
-;; For more information on Grail see
-;; <URL:http://monty.cnri.reston.va.us/> and for more information on
-;; Python see <url:http://www.python.org/>.  Grail support in
-;; browse-url.el written by Barry Warsaw <bwarsaw@python.org>.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Help!
-
-;; Can you write and test some code for the Macintrash and Windoze
-;; Netscape remote control APIs?  (See the URL above).
-
-;; Do any other browsers have remote control?
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Usage
-
-;; To display the URL at or before point:
-;; M-x browse-url-at-point RET
-
-;; To display a URL by shift-clicking on it, put this in your ~/.emacs
-;; file:
-;;      (global-set-key [S-mouse-2] 'browse-url-at-mouse)
-;; (Note that using Shift-mouse-1 is not desirable because
-;; that event has a standard meaning in Emacs.)
-
-;; To display the current buffer in a web browser:
-;; M-x browse-url-of-buffer RET
-
-;; In Dired, to display the file named on the current line:
-;; M-x browse-url-of-dired-file RET
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Customisation (~/.emacs)
-
-;; To see what variables are available for customization, type
-;; `M-x set-variable browse-url TAB'.
-
-;; Bind the browse-url commands to keys with the `C-c C-z' prefix
-;; (as used by html-helper-mode):
-;;	(global-set-key "\C-c\C-z." 'browse-url-at-point)
-;;	(global-set-key "\C-c\C-zb" 'browse-url-of-buffer)
-;;	(global-set-key "\C-c\C-zu" 'browse-url)
-;;	(global-set-key "\C-c\C-zv" 'browse-url-of-file)
-;;      (add-hook 'dired-mode-hook
-;;		  (function (lambda ()
-;;			      (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file))))
-
-;; Browse URLs in mail messages by clicking mouse-2:
-;;	(add-hook 'rmail-mode-hook (function (lambda () ; rmail-mode startup
-;;	  (define-key rmail-mode-map [mouse-2] 'browse-url-at-mouse))))
-
-;; Browse URLs in Usenet messages by clicking mouse-2:
-;;	(eval-after-load "gnus"
-;;	  '(define-key gnus-article-mode-map [mouse-2] 'browse-url-at-mouse))
-
-;; Use the Emacs w3 browser when not running under X11:
-;;	(or (eq window-system 'x)
-;;          (setq browse-url-browser-function 'browse-url-w3))
-
-;; To always save modified buffers before displaying the file in a browser:
-;;      (setq browse-url-save-file t)
-
-;; To get round the Netscape caching problem, you could EITHER have
-;; write-file in html-helper-mode make Netscape reload the document:
-;;
-;;      (autoload 'browse-url-netscape-reload "browse-url"
-;;        "Ask a WWW browser to redisplay the current file." t)
-;;      (add-hook 'html-helper-mode-hook
-;;                (function (lambda ()
-;;                   (add-hook 'local-write-file-hooks
-;;                             (function (lambda ()
-;;                                (let ((local-write-file-hooks))
-;;                                  (save-buffer))
-;;                                (browse-url-netscape-reload)
-;;                                t))                   ; => file written by hook
-;;                             t))))                    ; append to l-w-f-hooks
-;;
-;; OR have browse-url-of-file ask Netscape to load and then reload the
-;; file:
-;;
-;;      (add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload)
-
-;; You may also want to customise browse-url-netscape-arguments, e.g.
-;;      (setq browse-url-netscape-arguments '("-install"))
-;;
-;; or similarly for the other browsers. 
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Change Log:
-
-;; 0.00 03 Apr 1995 Denis Howe <dbh@doc.ic.ac.uk>
-;;      Created.
-
-;; 0.01 04 Apr 1995
-;;      All names start with "browse-url-".  Added provide.
-
-;; 0.02 05 Apr 1995
-;;      Save file at start of browse-url-of-file.
-;;      Use start-process instead of start-process-shell-command.
-
-;; 0.03 06 Apr 1995
-;;	Add browse-url-netscape-reload, browse-url-netscape-send.
-;;      browse-url-of-file save file option.
-
-;; 0.04 08 Apr 1995
-;;      b-u-file-url separate function.  Change b-u-filename-alist
-;;      default.
-
-;; 0.05 09 Apr 1995
-;;      Added b-u-of-file-hook.
-
-;; 0.06 11 Apr 1995
-;;      Improved .emacs suggestions and documentation.
-
-;; 0.07 13 Apr 1995
-;;      Added browse-url-interactive-arg optional prompt.
-
-;; 0.08 18 Apr 1995
-;;      Exclude final "." from browse-url-regexp.
-
-;; 0.09 21 Apr 1995
-;;      Added mouse-set-point to browse-url-interactive-arg.
-
-;; 0.10 24 Apr 1995
-;;      Added Mosaic signal sending variations.
-;;      Thanks Brian K Servis <servis@ecn.purdue.edu>.
-;;      Don't use xprop for Netscape.
-
-;; 0.11 25 Apr 1995
-;;      Fix reading of ~/.mosaicpid.  Thanks Dag.H.Wanvik@kvatro.no.
-
-;; 0.12 27 Apr 1995
-;;      Interactive prefix arg => URL *after* point.
-;;      Thanks Michelangelo Grigni <mic@cs.ucsd.edu>.
-;;      Added IXI Mosaic support.
-;;      Thanks David Karr <dkarr@nmo.gtegsc.com>.
-
-;; 0.13 28 Apr 1995
-;;      Exclude final [,;] from browse-url-regexp.
-
-;; 0.14 02 May 1995
-;;      Provide browser argument variables.
-
-;; 0.15 07 May 1995
-;;      More Netscape options.  Thanks Peter Arius
-;;      <arius@immd2.informatik.uni-erlangen.de>.
-
-;; 0.16 17 May 1995
-;;      Added browse-url-at-mouse.
-;;      Thanks Wayne Mesard <wmesard@sgi.com>
-
-;; 0.17 27 Jun 1995
-;;      Renamed browse-url-at-point to browse-url-url-at-point.
-;;      Added browse-url-at-point.
-;;      Thanks Jonathan Cano <cano@patch.tandem.com>.
-
-;; 0.18 16 Aug 1995
-;;      Fixed call to browse-url-url-at-point in browse-url-at-point.
-;;      Thanks Eric Ding <ericding@San-Jose.ate.slb.com>.
-
-;; 0.19 24 Aug 1995
-;;      Improved documentation.
-;;      Thanks Kevin Rodgers <kevin.rodgers@ihs.com>.
-
-;; 0.20 31 Aug 1995
-;;      browse-url-of-buffer to handle file-less buffers.
-;;      browse-url-of-dired-file browses current file in dired.
-;;      Thanks Kevin Rodgers <kevin.rodgers@ihs.com>.
-
-;; 0.21 09 Sep 1995
-;;      XMosaic CCI functions.
-;;      Thanks Marc Furrer <Marc.Furrer@di.epfl.ch>.
-
-;; 0.22 13 Sep 1995
-;;      Fixed new-window documentation and added to browse-url-cci.
-;;      Thanks Dilip Sequeira <djs@dcs.ed.ac.uk>.
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Code:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Variables
-
-(eval-when-compile (require 'dired))
-
-(defvar browse-url-path-regexp
-  "[^]\t\n \"'()<>[^`{}]*[^]\t\n \"'()<>[^`{}.,;]+"
-  "A regular expression probably matching the host, path or e-mail
-part of a URL.")
-
-(defvar browse-url-short-regexp
-  (concat "[-A-Za-z0-9.]+" browse-url-path-regexp)
-  "A regular expression probably matching a URL without an access scheme.
-Hostname matching is stricter in this case than for
-``browse-url-regexp''.")
-
-(defvar browse-url-regexp
-  (concat
-   "\\(https?://\\|ftp://\\|gopher://\\|telnet://\\|wais://\\|file:/\\|s?news:\\|mailto:\\)"
-   browse-url-path-regexp)
-  "A regular expression probably matching a complete URL.")
-
-
-;;;###autoload
-(defvar browse-url-browser-function
-  'browse-url-netscape
-  "*Function to display the current buffer in a WWW browser.
-Used by the `browse-url-at-point', `browse-url-at-mouse', and
-`browse-url-of-file' commands.")
-
-(defvar browse-url-netscape-command "netscape"
-  "*The name by which to invoke Netscape.")
-
-(defvar browse-url-netscape-arguments nil
-  "*A list of strings to pass to Netscape as arguments.")
-
-(defvar browse-url-netscape-startup-arguments browse-url-netscape-arguments
-  "*A list of strings to pass to Netscape when it starts up.
-Defaults to the value of browse-url-netscape-arguments at the time
-browse-url is loaded.")
-
-(defvar browse-url-new-window-p nil
-  "*If non-nil, always open a new browser window.
-Passing an interactive argument to \\[browse-url-netscape] or
-\\[browse-url-cci] reverses the effect of this variable.  Requires
-Netscape version 1.1N or later or XMosaic version 2.5 or later.")
-
-(defvar browse-url-mosaic-arguments nil
-  "*A list of strings to pass to Mosaic as arguments.")
-
-(defvar browse-url-filename-alist
-  '(("^/+" . "file:/"))
-  "An alist of (REGEXP . STRING) pairs.
-Any substring of a filename matching one of the REGEXPs is replaced by
-the corresponding STRING.  All pairs are applied in the order given.
-The default value prepends `file:' to any path beginning with `/'.
-Used by the `browse-url-of-file' command.")
-
-(defvar browse-url-save-file nil
-  "If non-nil, save the buffer before displaying its file.
-Used by the `browse-url-of-file' command.")
-
-(defvar browse-url-of-file-hook nil
-  "A hook to be run with run-hook after `browse-url-of-file' has asked
-a browser to load a file.
-
-Set this to `browse-url-netscape-reload' to force Netscape to load the
-file rather than displaying a cached copy.")
-
-(defvar browse-url-usr1-signal
-  (if (and (boundp 'emacs-major-version)
-           (or (> emacs-major-version 19) (>= emacs-minor-version 29)))
-      'SIGUSR1 ; Why did I think this was in lower case before?
-    30)                                 ; Check /usr/include/signal.h.
-  "The argument to `signal-process' for sending SIGUSR1 to XMosaic.
-Emacs 19.29 accepts 'SIGUSR1, earlier versions require an integer
-which is 30 on SunOS and 16 on HP-UX and Solaris.")
-
-(defvar browse-url-CCI-port 3003
-  "Port to access XMosaic via CCI.
-This can be any number between 1024 and 65535 but must correspond to
-the value set in the browser.")
-
-(defvar browse-url-CCI-host "localhost"
-  "*Host to access XMosaic via CCI.
-This should be the host name of the machine running XMosaic with CCI
-enabled.  The port number should be set in `browse-url-CCI-port'.")
-
-(defvar browse-url-temp-file-name nil)
-(make-variable-buffer-local 'browse-url-temp-file-name)
-
-(defvar browse-url-temp-file-list '())
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; URL input
-
-;; thingatpt.el doesn't work for complex regexps
-
-(defun browse-url-url-at-point ()
-  "Return the URL around or before point.
-Search backwards for the start of a URL ending at or after 
-point.  If no URL found, return the empty string.
-A file name is also acceptable, and `http://' will be prepended to it."
-  (or (thing-at-point 'url)
-      (let ((file (thing-at-point 'filename)))
-	(if file (concat "http://" file)))
-      ""))
-
-;; Having this as a separate function called by the browser-specific
-;; functions allows them to be stand-alone commands, making it easier
-;; to switch between browsers.
-
-(defun browse-url-interactive-arg (prompt)
-  "Read a URL from the minibuffer, prompting with PROMPT.
-Default to the URL at or before point.  If invoke with a mouse button,
-set point to the position clicked first.  Return a list for use in
-`interactive' containing the URL and browse-url-new-window-p or its
-negation if a prefix argument was given."
-  (let ((event (elt (this-command-keys) 0)))
-    (and (listp event) (mouse-set-point event)))
-  (list (read-string prompt (browse-url-url-at-point))
-	(not (eq (null browse-url-new-window-p)
-		 (null current-prefix-arg)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Browse current buffer
-
-;;;###autoload
-(defun browse-url-of-file (&optional file)
-  "Ask a WWW browser to display FILE.
-Display the current buffer's file if FILE is nil or if called
-interactively.  Turn the filename into a URL with function
-browse-url-file-url.  Pass the URL to a browser using variable
-`browse-url-browser-function' then run `browse-url-of-file-hook'."
-  (interactive)
-        (or file
-      (setq file (buffer-file-name))
-      (error "Current buffer has no file"))
-  (let ((buf (get-file-buffer file)))
-    (if buf
-        (save-excursion
-          (set-buffer buf)
-          (cond ((not (buffer-modified-p)))
-                (browse-url-save-file (save-buffer))
-                (t (message "%s modified since last save" file))))))
-  (funcall browse-url-browser-function (browse-url-file-url file))
-  (run-hooks 'browse-url-of-file-hook))
-
-(defun browse-url-file-url (file)
-  "Return the URL corresponding to FILE.
-Use variable `browse-url-filename-alist' to map filenames to URLs.
-Convert EFS file names of the form /USER@HOST:PATH to ftp://HOST/PATH."
-  ;; URL-encode special chars, do % first
-  (let ((s 0))
-    (while (setq s (string-match "%" file s))
-      (setq file (replace-match "%25" t t file)
-	    s (1+ s))))
-  (while (string-match "[*\"()',=;? ]" file)
-    (let ((enc (format "%%%x" (aref file (match-beginning 0)))))
-      (setq file (replace-match enc t t file))))
-  (let ((maps browse-url-filename-alist))
-    (while maps
-      (let* ((map (car maps))
-             (from-re (car map))
-             (to-string (cdr map)))
-        (setq maps (cdr maps))
-	(and (string-match from-re file)
-	     (setq file (replace-match to-string t t file))))))
-  ;; Check for EFS path
-  (and (string-match "^/\\([^:@]+@\\)?\\([^:]+\\):/*" file)
-       (setq file (concat "ftp://"
-			  (substring file (match-beginning 2) (match-end 2))
-			  "/" (substring file (match-end 0)))))
-  file)
-
-;;;###autoload
-(defun browse-url-of-buffer (&optional buffer)
-  "Ask a WWW browser to display BUFFER.
-Display the current buffer if BUFFER is nil."
-  (interactive)
-  (save-excursion
-    (and buffer (set-buffer buffer))
-    (let ((file-name
-           (or buffer-file-name
-               (and (boundp 'dired-directory) dired-directory))))
-      (or file-name
-                (progn
-	    (or browse-url-temp-file-name
-                  (setq browse-url-temp-file-name
-                        (make-temp-name
-                         (expand-file-name (buffer-name)
-					 (or (getenv "TMPDIR") "/tmp")))
-		      browse-url-temp-file-list
-                        (cons browse-url-temp-file-name
-			    browse-url-temp-file-list)))
-	    (setq file-name browse-url-temp-file-name)
-	    (write-region (point-min) (point-max) file-name nil 'no-message)))
-      (browse-url-of-file file-name))))
-
-(defun browse-url-delete-temp-file (&optional temp-file-name)
-  ;; Delete browse-url-temp-file-name from the file system and from
-  ;; browse-url-temp-file-list.  If optional arg TEMP-FILE-NAME is
-  ;; non-nil, delete it instead, but only from the file system --
-  ;; browse-url-temp-file-list is not affected.
-  (let ((file-name (or temp-file-name browse-url-temp-file-name)))
-    (if (and file-name (file-exists-p file-name))
-        (progn
-          (delete-file file-name)
-          (if (null temp-file-name)
-              (setq browse-url-temp-file-list
-                    (delete browse-url-temp-file-name
-                            browse-url-temp-file-list)))))))
-
-(defun browse-url-delete-temp-file-list ()
-  ;; Delete all elements of browse-url-temp-file-list.
-  (while browse-url-temp-file-list
-    (browse-url-delete-temp-file (car browse-url-temp-file-list))
-    (setq browse-url-temp-file-list
-          (cdr browse-url-temp-file-list))))
-
-(add-hook 'kill-buffer-hook 'browse-url-delete-temp-file)
-(add-hook 'kill-emacs-hook 'browse-url-delete-temp-file-list)
-
-;;;###autoload
-(defun browse-url-of-dired-file ()
-  "In Dired, ask a WWW browser to display the file named on this line."
-  (interactive)
-  (browse-url-of-file (dired-get-filename)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Browser-independant commands
-
-;; A generic command to call the current b-u-browser-function
-
-(defun browse-url (&rest args)
-  "Ask a WWW browser to load URL.
-Prompts for a URL, defaulting to the URL at or before point.  Variable
-`browse-url-browser-function' says which browser to use."
-  (interactive (browse-url-interactive-arg "URL: "))
-  (apply browse-url-browser-function args))
-
-;;;###autoload
-(defun browse-url-at-point ()
-  "Ask a WWW browser to load the URL at or before point.
-Doesn't let you edit the URL like browse-url.  Variable
-`browse-url-browser-function' says which browser to use."
-  (interactive)
-  (funcall browse-url-browser-function (browse-url-url-at-point)))
-
-;; Define these if not already defined (XEmacs compatibility)
-
-(eval-and-compile
-  (or (fboundp 'event-buffer)
-      (defun event-buffer (event)
-	(window-buffer (posn-window (event-start event))))))
-
-(eval-and-compile
-  (or (fboundp 'event-point)
-      (defun event-point (event)
-	(posn-point (event-start event)))))
-
-;;;###autoload
-(defun browse-url-at-mouse (event)
-  "Ask a WWW browser to load a URL clicked with the mouse.
-The URL is the one around or before the position of the mouse click
-but point is not changed.  Doesn't let you edit the URL like
-browse-url.  Variable `browse-url-browser-function' says which browser
-to use."
-  (interactive "e")
-  (save-excursion
-    (set-buffer (event-buffer event))
-    (goto-char (event-point event))
-    (let ((url (browse-url-url-at-point)))
-      (if (string-equal url "")
-	  (error "No URL found"))
-      (funcall browse-url-browser-function url))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Browser-specific commands
-
-;; --- Netscape ---
-
-;; Put the correct DISPLAY value in the environment for Netscape
-;; launched from multi-display Emacs.
-
-(defun browse-url-process-environment ()
-  (let* ((device (and (fboundp 'selected-device)
-		      (fboundp 'device-connection)
-                      (selected-device)))
-         (display (and device (fboundp 'device-type)
-                       (eq (device-type device) 'x)
-                       (not (equal (device-connection device)
-                                   (getenv "DISPLAY"))))))
-    (if display
-        ;; Attempt to run on the correct display
-        (cons (concat "DISPLAY=" (device-connection device))
-              process-environment)
-      process-environment)))
-
-
-;;;###autoload
-(defun browse-url-netscape (url &optional new-window)
-  "Ask the Netscape WWW browser to load URL.
-
-Default to the URL around or before point.  The strings in variable
-`browse-url-netscape-arguments' are also passed to Netscape.
-
-When called interactively, if variable `browse-url-new-window-p' is
-non-nil, load the document in a new Netscape window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of browse-url-new-window-p.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of browse-url-new-window-p."
-  (interactive (browse-url-interactive-arg "Netscape URL: "))
-  ;; URL encode any commas in the URL
-  (while (string-match "," url)
-    (setq url (replace-match "%2C" t t url)))
-  (let* ((process-environment (browse-url-process-environment))
-         (process (apply 'start-process
- 			(concat "netscape " url) nil
- 			browse-url-netscape-command
-		(append browse-url-netscape-arguments
-			(if new-window '("-noraise"))
-			(list "-remote" 
-			      (concat "openURL(" url 
-				      (if new-window ",new-window")
- 					      ")"))))))
-    (set-process-sentinel process
-       (list 'lambda '(process change)
-	     (list 'browse-url-netscape-sentinel 'process url)))))
-
-(defun browse-url-netscape-sentinel (process url)
-  "Handle a change to the process communicating with Netscape."
-  (or (eq (process-exit-status process) 0)
-      (let* ((process-environment (browse-url-process-environment)))
-	;; Netscape not running - start it
-	    (message "Starting Netscape...")
-	(apply 'start-process (concat "netscape" url) nil
-	       browse-url-netscape-command
-	       (append browse-url-netscape-startup-arguments (list url))))))
-
-(defun browse-url-netscape-reload ()
-  "Ask Netscape to reload its current document."
-  (interactive)
-  (browse-url-netscape-send "reload"))
-
-(defun browse-url-netscape-send (command)
-  "Send a remote control command to Netscape."
-  (let* ((process-environment (browse-url-process-environment)))
-    (apply 'start-process "netscape" nil
-           browse-url-netscape-command
-         (append browse-url-netscape-arguments
-                   (list "-remote" command)))))
-
-;; --- Mosaic ---
-
-;;;###autoload
-(defun browse-url-mosaic (url &optional new-window)
-  ;; new-window ignored
-  "Ask the XMosaic WWW browser to load URL.
-Default to the URL around or before point."
-  (interactive (browse-url-interactive-arg "Mosaic URL: "))
-  (let ((pidfile (expand-file-name "~/.mosaicpid"))
-        pid pidbuf)
-    (if (file-readable-p pidfile)
-        (save-excursion
-          (find-file pidfile)
-          (goto-char (point-min))
-          (setq pid (read (current-buffer)))
-          (kill-buffer nil)))
-    (if (and pid (zerop (signal-process pid 0))) ; Mosaic running
-        (save-excursion
-          (find-file (format "/tmp/Mosaic.%d" pid))
-          (erase-buffer)
-          (insert "goto\n" url "\n")
-          (save-buffer)
-          (kill-buffer nil)
-          ;; Send signal SIGUSR to Mosaic
-	  (message "Signalling Mosaic...")
-          (signal-process pid browse-url-usr1-signal)
-          ;; Or you could try:
-          ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
-	  (message "Signalling Mosaic...done")
-          )
-      ;; Mosaic not running - start it
-      (message "Starting Mosaic...")
-      (apply 'start-process "xmosaic" nil "xmosaic"
-             (append browse-url-mosaic-arguments (list url)))
-      (message "Starting Mosaic...done"))))
-
-;; --- Grail ---
-
-;;;###autoload
-(defvar browse-url-grail
-  (concat (or (getenv "GRAILDIR") "~/.grail") "/user/rcgrail.py")
-  "*Location of Grail remote control client script `rcgrail.py'.
-Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.")
-
-;;;###autoload
-(defun browse-url-grail (url)
-  "Ask the Grail WWW browser to load URL.
-Default to the URL around or before point.  Runs the program in the
-variable `browse-url-grail'."
-  (interactive (browse-url-interactive-arg "Grail URL: "))
-  (message "Sending URL to Grail...")
-  (save-excursion
-    (set-buffer (get-buffer-create " *Shell Command Output*"))
-    (erase-buffer)
-    ;; don't worry about this failing.
-    (call-process browse-url-grail nil 0 nil url)
-    (message "Sending URL to Grail... done")))
-
-;; --- Mosaic using CCI ---
-
-(defun browse-url-cci (url &optional new-window)
-  "Ask the XMosaic WWW browser to load URL.
-Default to the URL around or before point.
-
-This function only works for XMosaic version 2.5 or later.  You must
-select `CCI' from XMosaic's File menu, set the CCI Port Address to the
-value of variable `browse-url-CCI-port', and enable `Accept requests'.
-
-When called interactively, if variable `browse-url-new-window-p' is
-non-nil, load the document in a new browser window, otherwise use a
-random existing one.  A non-nil interactive prefix argument reverses
-the effect of browse-url-new-window-p.
-
-When called non-interactively, optional second argument NEW-WINDOW is
-used instead of browse-url-new-window-p."
-  (interactive (browse-url-interactive-arg "Mosaic URL: "))
-  (open-network-stream "browse-url" " *browse-url*"
-		       browse-url-CCI-host browse-url-CCI-port)
-  ;; Todo: start browser if fails
-  (process-send-string "browse-url"
-                       (concat "get url (" url ") output "
-                               (if new-window "new" "current") "\r\n"))
-  (process-send-string "browse-url" "disconnect\r\n")
-  (delete-process "browse-url"))
-
-;; --- IXI Mosaic ---
-
-;;;###autoload
-(defun browse-url-iximosaic (url &optional new-window)
-  ;; new-window ignored
-  "Ask the IXIMosaic WWW browser to load URL.
-Default to the URL around or before point."
-  (interactive (browse-url-interactive-arg "IXI Mosaic URL: "))
-  (start-process "tellw3b" nil "tellw3b"
-                 "-service WWW_BROWSER ixi_showurl " url))
-
-;; --- W3 ---
-
-;;;###autoload
-(defun browse-url-w3 (url &optional new-window)
-  ;; new-window ignored
-  "Ask the w3 WWW browser to load URL.
-Default to the URL around or before point."
-  (interactive (browse-url-interactive-arg "W3 URL: "))
-  (w3-fetch url))
-
-;; --- Lynx in an xterm ---
-
-;;;###autoload
-(defun browse-url-lynx-xterm (url &optional new-window)
-  ;; new-window ignored
-  "Ask the Lynx WWW browser to load URL.
-Default to the URL around or before point.  A new Lynx process is run
-in an Xterm window."
-  (interactive (browse-url-interactive-arg "Lynx URL: "))
-  (start-process (concat "lynx" url) nil "xterm" "-e" "lynx" url))
-
-(eval-when-compile (require 'term))
-
-;; --- Lynx in an Emacs "term" window ---
-
-;;;###autoload
-(defun browse-url-lynx-emacs (url &optional new-window)
-  ;; new-window ignored
-  "Ask the Lynx WWW browser to load URL.
-Default to the URL around or before point.  Run a new Lynx process in
-an Emacs buffer."
-  (interactive (browse-url-interactive-arg "Lynx URL: "))
-  (let ((system-uses-terminfo t))	; Lynx uses terminfo
-    (if (fboundp 'make-term)
-	(let ((term-term-name "vt100"))
-	  (set-buffer (make-term "browse-url" "lynx" nil url))
-	  (term-mode)
-	  (term-char-mode)
-	  (switch-to-buffer "*browse-url*"))
-      (terminal-emulator "*browse-url*" "lynx" (list url)))))
-
-(provide 'browse-url)
-
-;;; browse-url.el ends here
diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el
deleted file mode 100644
index d25cdbdb8ea..00000000000
--- a/lisp/buff-menu.el
+++ /dev/null
@@ -1,550 +0,0 @@
-;;; buff-menu.el --- buffer menu main function and support functions.
-
-;; Copyright (C) 1985, 86, 87, 93, 94, 95 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:
-
-;; Edit, delete, or change attributes of all currently active Emacs
-;; buffers from a list summarizing their state.  A good way to browse
-;; any special or scratch buffers you have loaded, since you can't find
-;; them by filename.  The single entry point is `Buffer-menu-mode',
-;; normally bound to C-x C-b.
-
-;;; Change Log:
-
-;; Merged by esr with recent mods to Emacs 19 buff-menu, 23 Mar 1993
-;;
-;; Modified by Bob Weiner, Motorola, Inc., 4/14/89
-;;
-;; Added optional backup argument to 'Buffer-menu-unmark' to make it undelete
-;; current entry and then move to previous one.
-;;
-;; Based on FSF code dating back to 1985.
-
-;;; Code:
- 
-;;;Trying to preserve the old window configuration works well in
-;;;simple scenarios, when you enter the buffer menu, use it, and exit it.
-;;;But it does strange things when you switch back to the buffer list buffer
-;;;with C-x b, later on, when the window configuration is different.
-;;;The choice seems to be, either restore the window configuration
-;;;in all cases, or in no cases.
-;;;I decided it was better not to restore the window config at all. -- rms.
-
-;;;But since then, I changed buffer-menu to use the selected window,
-;;;so q now once again goes back to the previous window configuration.
-
-;;;(defvar Buffer-menu-window-config nil
-;;;  "Window configuration saved from entry to `buffer-menu'.")
-
-; Put buffer *Buffer List* into proper mode right away
-; so that from now on even list-buffers is enough to get a buffer menu.
-
-(defvar Buffer-menu-buffer-column nil)
-
-(defvar Buffer-menu-mode-map nil "")
-
-(if Buffer-menu-mode-map
-    ()
-  (setq Buffer-menu-mode-map (make-keymap))
-  (suppress-keymap Buffer-menu-mode-map t)
-  (define-key Buffer-menu-mode-map "q" 'Buffer-menu-quit)
-  (define-key Buffer-menu-mode-map "v" 'Buffer-menu-select)
-  (define-key Buffer-menu-mode-map "2" 'Buffer-menu-2-window)
-  (define-key Buffer-menu-mode-map "1" 'Buffer-menu-1-window)
-  (define-key Buffer-menu-mode-map "f" 'Buffer-menu-this-window)
-  (define-key Buffer-menu-mode-map "\C-m" 'Buffer-menu-this-window)
-  (define-key Buffer-menu-mode-map "o" 'Buffer-menu-other-window)
-  (define-key Buffer-menu-mode-map "\C-o" 'Buffer-menu-switch-other-window)
-  (define-key Buffer-menu-mode-map "s" 'Buffer-menu-save)
-  (define-key Buffer-menu-mode-map "d" 'Buffer-menu-delete)
-  (define-key Buffer-menu-mode-map "k" 'Buffer-menu-delete)
-  (define-key Buffer-menu-mode-map "\C-d" 'Buffer-menu-delete-backwards)
-  (define-key Buffer-menu-mode-map "\C-k" 'Buffer-menu-delete)
-  (define-key Buffer-menu-mode-map "x" 'Buffer-menu-execute)
-  (define-key Buffer-menu-mode-map " " 'next-line)
-  (define-key Buffer-menu-mode-map "n" 'next-line)
-  (define-key Buffer-menu-mode-map "p" 'previous-line)
-  (define-key Buffer-menu-mode-map "\177" 'Buffer-menu-backup-unmark)
-  (define-key Buffer-menu-mode-map "~" 'Buffer-menu-not-modified)
-  (define-key Buffer-menu-mode-map "?" 'describe-mode)
-  (define-key Buffer-menu-mode-map "u" 'Buffer-menu-unmark)
-  (define-key Buffer-menu-mode-map "m" 'Buffer-menu-mark)
-  (define-key Buffer-menu-mode-map "t" 'Buffer-menu-visit-tags-table)
-  (define-key Buffer-menu-mode-map "%" 'Buffer-menu-toggle-read-only)
-  (define-key Buffer-menu-mode-map "g" 'Buffer-menu-revert)
-  (define-key Buffer-menu-mode-map [mouse-2] 'Buffer-menu-mouse-select)
-)
-
-;; Buffer Menu mode is suitable only for specially formatted data.
-(put 'Buffer-menu-mode 'mode-class 'special)
-
-(defun Buffer-menu-mode ()
-  "Major mode for editing a list of buffers.
-Each line describes one of the buffers in Emacs.
-Letters do not insert themselves; instead, they are commands.
-\\<Buffer-menu-mode-map>
-\\[Buffer-menu-mouse-select] -- select buffer you click on, in place of the buffer menu.
-\\[Buffer-menu-this-window] -- select current line's buffer in place of the buffer menu.
-\\[Buffer-menu-other-window] -- select that buffer in another window,
-  so the buffer menu buffer remains visible in its window.
-\\[Buffer-menu-switch-other-window] -- make another window display that buffer.
-\\[Buffer-menu-mark] -- mark current line's buffer to be displayed.
-\\[Buffer-menu-select] -- select current line's buffer.
-  Also show buffers marked with m, in other windows.
-\\[Buffer-menu-1-window] -- select that buffer in full-frame window.
-\\[Buffer-menu-2-window] -- select that buffer in one window,
-  together with buffer selected before this one in another window.
-\\[Buffer-menu-visit-tags-table] -- visit-tags-table this buffer.
-\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
-\\[Buffer-menu-save] -- mark that buffer to be saved, and move down.
-\\[Buffer-menu-delete] -- mark that buffer to be deleted, and move down.
-\\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted, and move up.
-\\[Buffer-menu-execute] -- delete or save marked buffers.
-\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
-  With prefix argument, also move up one line.
-\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
-\\[Buffer-menu-toggle-read-only] -- toggle read-only status of buffer on this line.
-\\[Buffer-menu-revert] -- update the list of buffers."
-  (kill-all-local-variables)
-  (use-local-map Buffer-menu-mode-map)
-  (setq major-mode 'Buffer-menu-mode)
-  (setq mode-name "Buffer Menu")
-  (make-local-variable 'revert-buffer-function)
-  (setq revert-buffer-function 'Buffer-menu-revert-function)
-  (setq truncate-lines t)
-  (setq buffer-read-only t)
-  (run-hooks 'buffer-menu-mode-hook))
-
-(defun Buffer-menu-revert ()
-  "Update the list of buffers."
-  (interactive)
-  (revert-buffer))
-
-(defun Buffer-menu-revert-function (ignore1 ignore2)
-  (list-buffers))
-
-(defun Buffer-menu-buffer (error-if-non-existent-p)
-  "Return buffer described by this line of buffer menu."
-  (let* ((where (save-excursion
-		  (beginning-of-line)
-		  (+ (point) Buffer-menu-buffer-column)))
-	 (name (and (not (eobp)) (get-text-property where 'buffer-name))))
-    (if name
-	(or (get-buffer name)
-	    (if error-if-non-existent-p
-		(error "No buffer named `%s'" name)
-	      nil))
-      (if error-if-non-existent-p
-	  (error "No buffer on this line")
-	nil))))
-
-(defun buffer-menu (&optional arg)
-  "Make a menu of buffers so you can save, delete or select them.
-With argument, show only buffers that are visiting files.
-Type ? after invocation to get help on commands available.
-Type q immediately to make the buffer menu go away."
-  (interactive "P")
-;;;  (setq Buffer-menu-window-config (current-window-configuration))
-  (switch-to-buffer (list-buffers-noselect arg))
-  (message
-   "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
-
-(defun buffer-menu-other-window (&optional arg)
-  "Display a list of buffers in another window.
-With the buffer list buffer, you can save, delete or select the buffers.
-With argument, show only buffers that are visiting files.
-Type ? after invocation to get help on commands available.
-Type q immediately to make the buffer menu go away."
-  (interactive "P")
-;;;  (setq Buffer-menu-window-config (current-window-configuration))
-  (switch-to-buffer-other-window (list-buffers-noselect arg))
-  (message
-   "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help."))
-
-(defun Buffer-menu-quit ()
-  "Quit the buffer menu."
-  (interactive)
-  (let ((buffer (current-buffer)))
-    ;; Switch away from the buffer menu and bury it.
-    (switch-to-buffer (other-buffer))
-    (bury-buffer buffer)))
-
-(defun Buffer-menu-mark ()
-  "Mark buffer on this line for being displayed by \\<Buffer-menu-mode-map>\\[Buffer-menu-select] command."
-  (interactive)
-  (beginning-of-line)
-  (if (looking-at " [-M]")
-      (ding)
-    (let ((buffer-read-only nil))
-      (delete-char 1)
-      (insert ?>)
-      (forward-line 1))))
-
-(defun Buffer-menu-unmark (&optional backup)
-  "Cancel all requested operations on buffer on this line and move down.
-Optional ARG means move up."
-  (interactive "P")
-  (beginning-of-line)
-  (if (looking-at " [-M]")
-      (ding)
-    (let* ((buf (Buffer-menu-buffer t))
-	   (mod (buffer-modified-p buf))
-	   (readonly (save-excursion (set-buffer buf) buffer-read-only))
-	   (buffer-read-only nil))
-      (delete-char 3)
-      (insert (if readonly (if mod " *%" "  %") (if mod " * " "   ")))))
-  (forward-line (if backup -1 1)))
-
-(defun Buffer-menu-backup-unmark ()
-  "Move up and cancel all requested operations on buffer on line above."
-  (interactive)
-  (forward-line -1)
-  (Buffer-menu-unmark)
-  (forward-line -1))
-
-(defun Buffer-menu-delete (&optional arg)
-  "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command.
-Prefix arg is how many buffers to delete.
-Negative arg means delete backwards."
-  (interactive "p")
-  (beginning-of-line)
-  (if (looking-at " [-M]")		;header lines
-      (ding)
-    (let ((buffer-read-only nil))
-      (if (or (null arg) (= arg 0))
-	  (setq arg 1))
-      (while (> arg 0)
-	(delete-char 1)
-	(insert ?D)
-	(forward-line 1)
-	(setq arg (1- arg)))
-      (while (< arg 0)
-	(delete-char 1)
-	(insert ?D)
-	(forward-line -1)
-	(setq arg (1+ arg))))))
-
-(defun Buffer-menu-delete-backwards (&optional arg)
-  "Mark buffer on this line to be deleted by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command
-and then move up one line.  Prefix arg means move that many lines."
-  (interactive "p")
-  (Buffer-menu-delete (- (or arg 1)))
-  (while (looking-at " [-M]")
-    (forward-line 1)))
-
-(defun Buffer-menu-save ()
-  "Mark buffer on this line to be saved by \\<Buffer-menu-mode-map>\\[Buffer-menu-execute] command."
-  (interactive)
-  (beginning-of-line)
-  (if (looking-at " [-M]")		;header lines
-      (ding)
-    (let ((buffer-read-only nil))
-      (forward-char 1)
-      (delete-char 1)
-      (insert ?S)
-      (forward-line 1))))
-
-(defun Buffer-menu-not-modified (&optional arg)
-  "Mark buffer on this line as unmodified (no changes to save)."
-  (interactive "P")
-  (save-excursion
-    (set-buffer (Buffer-menu-buffer t))
-    (set-buffer-modified-p arg))
-  (save-excursion
-   (beginning-of-line)
-   (forward-char 1)
-   (if (= (char-after (point)) (if arg ?  ?*))
-       (let ((buffer-read-only nil))
-	 (delete-char 1)
-	 (insert (if arg ?* ? ))))))
-
-(defun Buffer-menu-execute ()
-  "Save and/or delete buffers marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-save] or \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (forward-line 1)
-    (while (re-search-forward "^.S" nil t)
-      (let ((modp nil))
-	(save-excursion
-	  (set-buffer (Buffer-menu-buffer t))
-	  (save-buffer)
-	  (setq modp (buffer-modified-p)))
-	(let ((buffer-read-only nil))
-	  (delete-char -1)
-	  (insert (if modp ?* ? ))))))
-  (save-excursion
-    (goto-char (point-min))
-    (forward-line 1)
-    (let ((buff-menu-buffer (current-buffer))
-	  (buffer-read-only nil))
-      (while (search-forward "\nD" nil t)
-	(forward-char -1)
-	(let ((buf (Buffer-menu-buffer nil)))
-	  (or (eq buf nil)
-	      (eq buf buff-menu-buffer)
-	      (save-excursion (kill-buffer buf))))
-	(if (Buffer-menu-buffer nil)
-	    (progn (delete-char 1)
-		   (insert ? ))
-	  (delete-region (point) (progn (forward-line 1) (point)))
- 	  (forward-char -1))))))
-
-(defun Buffer-menu-select ()
-  "Select this line's buffer; also display buffers marked with `>'.
-You can mark buffers with the \\<Buffer-menu-mode-map>\\[Buffer-menu-mark] command.
-This command deletes and replaces all the previously existing windows
-in the selected frame."
-  (interactive)
-  (let ((buff (Buffer-menu-buffer t))
-	(menu (current-buffer))	      
-	(others ())
-	tem)
-    (goto-char (point-min))
-    (while (search-forward "\n>" nil t)
-      (setq tem (Buffer-menu-buffer t))
-      (let ((buffer-read-only nil))
-	(delete-char -1)
-	(insert ?\ ))
-      (or (eq tem buff) (memq tem others) (setq others (cons tem others))))
-    (setq others (nreverse others)
-	  tem (/ (1- (frame-height)) (1+ (length others))))
-    (delete-other-windows)
-    (switch-to-buffer buff)
-    (or (eq menu buff)
-	(bury-buffer menu))
-    (if (equal (length others) 0)
-	(progn
-;;;	  ;; Restore previous window configuration before displaying
-;;;	  ;; selected buffers.
-;;;	  (if Buffer-menu-window-config
-;;;	      (progn
-;;;		(set-window-configuration Buffer-menu-window-config)
-;;;		(setq Buffer-menu-window-config nil)))
-	  (switch-to-buffer buff))
-      (while others
-	(split-window nil tem)
-	(other-window 1)
-	(switch-to-buffer (car others))
-	(setq others (cdr others)))
-      (other-window 1)  			;back to the beginning!
-)))
-
-
-
-(defun Buffer-menu-visit-tags-table ()
-  "Visit the tags table in the buffer on this line.  See `visit-tags-table'."
-  (interactive)
-  (let ((file (buffer-file-name (Buffer-menu-buffer t))))
-    (if file
-	(visit-tags-table file)
-      (error "Specified buffer has no file"))))
-
-(defun Buffer-menu-1-window ()
-  "Select this line's buffer, alone, in full frame."
-  (interactive)
-  (switch-to-buffer (Buffer-menu-buffer t))
-  (bury-buffer (other-buffer))
-  (delete-other-windows))
-
-(defun Buffer-menu-mouse-select (event)
-  "Select the buffer whose line you click on."
-  (interactive "e")
-  (let (buffer)
-    (save-excursion
-      (set-buffer (window-buffer (posn-window (event-end event))))
-      (save-excursion
-	(goto-char (posn-point (event-end event)))
-	(setq buffer (Buffer-menu-buffer t))))
-    (select-window (posn-window (event-end event)))
-    (if (and (window-dedicated-p (selected-window))
-	     (eq (selected-window) (frame-root-window)))
-	(switch-to-buffer-other-frame buffer)
-      (switch-to-buffer buffer))))
-
-(defun Buffer-menu-this-window ()
-  "Select this line's buffer in this window."
-  (interactive)
-  (switch-to-buffer (Buffer-menu-buffer t)))
-
-(defun Buffer-menu-other-window ()
-  "Select this line's buffer in other window, leaving buffer menu visible."
-  (interactive)
-  (switch-to-buffer-other-window (Buffer-menu-buffer t)))
-
-(defun Buffer-menu-switch-other-window ()
-  "Make the other window select this line's buffer.
-The current window remains selected."
-  (interactive)
-  (display-buffer (Buffer-menu-buffer t)))
-
-(defun Buffer-menu-2-window ()
-  "Select this line's buffer, with previous buffer in second window."
-  (interactive)
-  (let ((buff (Buffer-menu-buffer t))
-	(menu (current-buffer))
-	(pop-up-windows t))
-    (delete-other-windows)
-    (switch-to-buffer (other-buffer))
-    (pop-to-buffer buff)
-    (bury-buffer menu)))
-
-(defun Buffer-menu-toggle-read-only ()
-  "Toggle read-only status of buffer on this line, perhaps via version control."
-  (interactive)
-  (let (char)
-    (save-excursion
-      (set-buffer (Buffer-menu-buffer t))
-      (vc-toggle-read-only)
-      (setq char (if buffer-read-only ?% ? )))
-    (save-excursion
-      (beginning-of-line)
-      (forward-char 2)
-      (if (/= (following-char) char)
-          (let (buffer-read-only)
-            (delete-char 1)
-            (insert char))))))
-
-
-
-(define-key ctl-x-map "\C-b" 'list-buffers)
-
-(defun list-buffers (&optional files-only)
-  "Display a list of names of existing buffers.
-The list is displayed in a buffer named `*Buffer List*'.
-Note that buffers with names starting with spaces are omitted.
-Non-null optional arg FILES-ONLY means mention only file buffers.
-
-The M column contains a * for buffers that are modified.
-The R column contains a % for buffers that are read-only."
-  (interactive "P")
-  (display-buffer (list-buffers-noselect files-only)))
-
-(defun list-buffers-noselect (&optional files-only)
-  "Create and return a buffer with a list of names of existing buffers.
-The buffer is named `*Buffer List*'.
-Note that buffers with names starting with spaces are omitted.
-Non-null optional arg FILES-ONLY means mention only file buffers.
-
-The M column contains a * for buffers that are modified.
-The R column contains a % for buffers that are read-only."
-  (let ((old-buffer (current-buffer))
-	(standard-output standard-output)
-	desired-point)
-    (save-excursion
-      (set-buffer (get-buffer-create "*Buffer List*"))
-      (setq buffer-read-only nil)
-      (erase-buffer)
-      (setq standard-output (current-buffer))
-      (princ "\
- MR Buffer           Size  Mode         File
- -- ------           ----  ----         ----
-")
-      ;; Record the column where buffer names start.
-      (setq Buffer-menu-buffer-column 4)
-      (let ((bl (buffer-list)))
-	(while bl
-	  (let* ((buffer (car bl))
-		 (name (buffer-name buffer))
-		 (file (buffer-file-name buffer))
-		 this-buffer-line-start
-		 this-buffer-read-only
-		 this-buffer-size
-		 this-buffer-mode-name
-		 this-buffer-directory)
-	    (save-excursion
-	      (set-buffer buffer)
-	      (setq this-buffer-read-only buffer-read-only)
-	      (setq this-buffer-size (buffer-size))
-	      (setq this-buffer-mode-name
-		    (if (eq buffer standard-output)
-			"Buffer Menu" mode-name))
-	      (or file
-		  ;; No visited file.  Check local value of
-		  ;; list-buffers-directory.
-		  (if (and (boundp 'list-buffers-directory)
-			   list-buffers-directory)
-		      (setq this-buffer-directory list-buffers-directory))))
-	    (cond
-	     ;; Don't mention internal buffers.
-	     ((string= (substring name 0 1) " "))
-	     ;; Maybe don't mention buffers without files.
-	     ((and files-only (not file)))
-	     ;; Otherwise output info.
-	     (t
-	      (setq this-buffer-line-start (point))
-	      ;; Identify current buffer.
-	      (if (eq buffer old-buffer)
-		  (progn
-		    (setq desired-point (point))
-		    (princ "."))
-		(princ " "))
-	      ;; Identify modified buffers.
-	      (princ (if (buffer-modified-p buffer) "*" " "))
-	      ;; Handle readonly status.  The output buffer is special
-	      ;; cased to appear readonly; it is actually made so at a later
-	      ;; date.
-	      (princ (if (or (eq buffer standard-output)
-			     this-buffer-read-only)
-			 "% "
-		       "  "))
-	      (princ name)
-	      ;; Put the buffer name into a text property
-	      ;; so we don't have to extract it from the text.
-	      ;; This way we avoid problems with unusual buffer names.
-	      (setq this-buffer-line-start
-		    (+ this-buffer-line-start Buffer-menu-buffer-column))
-	      (let ((name-end (point)))
-		(indent-to 17 2)
-		(put-text-property this-buffer-line-start name-end
-				   'buffer-name name)
-		(put-text-property this-buffer-line-start name-end
-				   'mouse-face 'highlight))
-	      (let (size
-		    mode
-		    (excess (- (current-column) 17)))
-		(setq size (format "%8d" this-buffer-size))
-		;; Ack -- if looking at the *Buffer List* buffer,
-		;; always use "Buffer Menu" mode.  Otherwise the
-		;; first time the buffer is created, the mode will be wrong.
-		(setq mode this-buffer-mode-name)
-		(while (and (> excess 0) (= (aref size 0) ?\ ))
-		  (setq size (substring size 1))
-		  (setq excess (1- excess)))
-		(princ size)
-		(indent-to 27 1)
-		(princ mode))
-	      (indent-to 40 1)
-	      (or file (setq file this-buffer-directory))
-	      (if file
-		  (princ file))
-	      (princ "\n"))))
-	  (setq bl (cdr bl))))
-      (Buffer-menu-mode)
-      ;; DESIRED-POINT doesn't have to be set; it is not when the
-      ;; current buffer is not displayed for some reason.
-      (and desired-point
-	   (goto-char desired-point))
-      (current-buffer))))
-
-;;; buff-menu.el ends here
diff --git a/lisp/byte-run.el b/lisp/byte-run.el
deleted file mode 100644
index 79b64b241a1..00000000000
--- a/lisp/byte-run.el
+++ /dev/null
@@ -1,161 +0,0 @@
-;;; 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>
-;; 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)
-  "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."
-  (interactive "aMake function obsolete: \nxObsoletion replacement: ")
-  (let ((handler (get fn 'byte-compile)))
-    (if (eq 'byte-compile-obsolete handler)
-	(setcar (get fn 'byte-obsolete-info) new)
-      (put fn 'byte-obsolete-info (cons new handler))
-      (put fn 'byte-compile 'byte-compile-obsolete)))
-  fn)
-
-(defun make-obsolete-variable (var new)
-  "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."
-  (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 new)
-  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))
-
-
-;;; 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/calendar/appt.el b/lisp/calendar/appt.el
deleted file mode 100644
index e5fe7d05428..00000000000
--- a/lisp/calendar/appt.el
+++ /dev/null
@@ -1,600 +0,0 @@
-;;; appt.el --- appointment notification functions.
-
-;; Copyright (C) 1989, 1990, 1994 Free Software Foundation, Inc.
-
-;; Author: Neil Mager <neilm@juliet.ll.mit.edu>
-;; Maintainer: FSF
-;; Keywords: calendar
-
-;; 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:
-
-;;
-;; appt.el - visible and/or audible notification of
-;;           appointments from ~/diary file generated from
-;;           Edward M. Reingold's calendar.el.
-;;
-;;
-;; Comments, corrections, and improvements should be sent to
-;; Neil M. Mager
-;; Net                     <neilm@juliet.ll.mit.edu>
-;; Voice                   (617) 981-4803
-;;;
-;;; Thanks to  Edward M. Reingold for much help and many suggestions, 
-;;; And to many others for bug fixes and suggestions.
-;;;
-;;;
-;;; This functions in this file will alert the user of a 
-;;; pending appointment based on their diary file.
-;;;
-;;;
-;;; ******* It is necessary to invoke 'display-time' ********
-;;; *******  and 'diary' for this to work properly.  ********
-;;; 
-;;; A message will be displayed in the mode line of the emacs buffer
-;;; and (if the user desires) the terminal will beep and display a message
-;;; from the diary in the mini-buffer, or the user may select to 
-;;; have a message displayed in a new buffer.
-;;;
-;;; The variable 'appt-message-warning-time' allows the
-;;; user to specify how much notice they want before the appointment. The 
-;;; variable 'appt-issue-message' specifies whether the user wants
-;;; to to be notified of a pending appointment.
-;;; 
-;;; In order to use, the following should be in your .emacs file in addition to
-;;; creating a diary file and invoking calendar:
-;;;
-;;;    Set some options
-;;; (setq view-diary-entries-initially t)
-;;; (setq appt-issue-message t)
-;;;
-;;;   The following three lines are required:
-;;; (display-time)
-;;; (add-hook 'diary-hook 'appt-make-list)
-;;;
-;;; 
-;;;  This is an example of what can be in your diary file:
-;;; Monday
-;;;   9:30am Coffee break
-;;;  12:00pm Lunch        
-;;; 
-;;; Based upon the above lines in your .emacs and diary files, 
-;;; the calendar and diary will be displayed when you enter
-;;; emacs and your appointments list will automatically be created.
-;;; You will then be reminded at 9:20am about your coffee break
-;;; and at 11:50am to go to lunch. 
-;;;
-;;; Use describe-function on appt-check for a description of other variables
-;;; that can be used to personalize the notification system.
-;;;
-;;;  In order to add or delete items from todays list, use appt-add
-;;;  and appt-delete.
-;;;
-;;;  Additionally, the appointments list is recreated automatically
-;;;  at 12:01am for those who do not logout every day or are programming
-;;;  late.
-;;;
-;;; Brief internal description - Skip this if your not interested!
-;;;
-;;; The function appt-check is run from the 'loadst' process which is started
-;;; by invoking (display-time). A temporary function below modifies
-;;; display-time-filter 
-;;; (from original time.el) to include a hook which will invoke appt-check.
-;;; This will not be necessary in the next version of gnuemacs.
-;;;
-;;;
-;;; The function appt-make-list creates the appointments list which appt-check
-;;; reads. This is all done automatically.
-;;; It is invoked from the function list-diary-entries.
-;;;
-;;; You can change the way the appointment window is created/deleted by
-;;; setting  the variables
-;;;
-;;;	     appt-disp-window-function
-;;; and
-;;; 	     appt-delete-window-function
-;;;
-;;; For instance, these variables can be set to functions that display
-;;; appointments in pop-up frames, which are lowered or iconified after
-;;; appt-display-interval seconds.
-;;;
-
-;;; Code:
-
-;; Make sure calendar is loaded when we compile this.
-(require 'calendar)
-
-(provide 'appt)
-
-;;;###autoload
-(defvar appt-issue-message t
-  "*Non-nil means check for appointments in the diary buffer.
-To be detected, the diary entry must have the time
-as the first thing on a line.")
-
-;;;###autoload
-(defvar appt-message-warning-time 12
-  "*Time in minutes before an appointment that the warning begins.")
-
-;;;###autoload
-(defvar appt-audible t
-  "*Non-nil means beep to indicate appointment.")
-
-;;;###autoload
-(defvar appt-visible t
-  "*Non-nil means display appointment message in echo area.")
-
-;;;###autoload
-(defvar appt-display-mode-line t
-  "*Non-nil means display minutes to appointment and time on the mode line.")
-
-;;;###autoload
-(defvar appt-msg-window t
-  "*Non-nil means display appointment message in another window.")
-
-;;;###autoload
-(defvar appt-display-duration 10
-  "*The number of seconds an appointment message is displayed.")
-
-;;;###autoload
-(defvar appt-display-diary t
-  "*Non-nil means to display the next days diary on the screen. 
-This will occur at midnight when the appointment list is updated.")
-
-(defvar appt-time-msg-list nil
-  "The list of appointments for today.
-Use `appt-add' and `appt-delete' to add and delete appointments from list.
-The original list is generated from the today's `diary-entries-list'.
-The number before each time/message is the time in minutes from midnight.")
-
-(defconst max-time 1439
-  "11:59pm in minutes - number of minutes in a day minus 1.")
-
-(defvar appt-display-interval 3
-  "*Number of minutes to wait between checking the appointment list.")
-  
-(defvar appt-buffer-name " *appt-buf*"
-  "Name of the appointments buffer.")
-  
-(defvar appt-disp-window-function 'appt-disp-window
-  "Function called to display appointment window.")
-  
-(defvar appt-delete-window-function 'appt-delete-window
-  "Function called to remove appointment window and buffer.")
-
-(defun appt-check ()
-  "Check for an appointment and update the mode line.
-Note: the time must be the first thing in the line in the diary
-for a warning to be issued.
-
-The format of the time can be either 24 hour or am/pm.
-Example: 
-
-               02/23/89
-                 18:00 Dinner
-            
-              Thursday
-                11:45am Lunch meeting.
-
-The following variables control the action of the notification:
-
-appt-issue-message
-	If T, the diary buffer is checked for appointments.
-
-appt-message-warning-time
-	Variable used to determine if appointment message
-	should be displayed.
-
-appt-audible
-	Variable used to determine if appointment is audible.
-	Default is t.
-
-appt-visible
-	Variable used to determine if appointment message should be
-	displayed in the mini-buffer. Default is t.
-
-appt-msg-window
-	Variable used to determine if appointment message
-	should temporarily appear in another window. Mutually exclusive
-	to appt-visible.
-
-appt-display-duration
-	The number of seconds an appointment message
-	is displayed in another window.
-
-appt-display-interval
-	The number of minutes to wait between checking the appointments
-	list.
-
-appt-disp-window-function 
-    	Function called to display appointment window. You can customize
-	appt.el by setting this variable to a function different from the
-	one provided with this package.
-  
-appt-delete-window-function 
-    	Function called to remove appointment window and buffer.  You can
-	customize appt.el by setting this variable to a function different
-	from the one provided with this package.
-
-This function is run from the loadst process for display time.
-Therefore, you need to have `(display-time)' in your .emacs file."
-
-
-  (if (or (= appt-display-interval 1)
-	  ;; This is true every appt-display-interval minutes.
-	  (= 0 (mod (/ (nth 1 (current-time)) 60) appt-display-interval)))
-      (let ((min-to-app -1)
-	    (new-time ""))
-	(save-excursion
-
-	  ;; Get the current time and convert it to minutes
-	  ;; from midnight. ie. 12:01am = 1, midnight = 0.
-
-	  (let* ((now (decode-time))
-		 (cur-hour (nth 2 now))
-		 (cur-min (nth 1 now))
-		 (cur-comp-time (+ (* cur-hour 60) cur-min)))
-
-	    ;; At the first check after 12:01am, we should update our 
-	    ;; appointments to today's list.
-
-	    (if (and (>= cur-comp-time 1)
-		     (<= cur-comp-time appt-display-interval))
-		(if (and view-diary-entries-initially appt-display-diary)
-		    (diary)
-		  (let ((diary-display-hook 'appt-make-list))
-		    (diary))))
-
-	    ;; If there are entries in the list, and the
-	    ;; user wants a message issued
-	    ;; get the first time off of the list
-	    ;; and calculate the number of minutes until
-	    ;; the appointment.
-
-	    (if (and appt-issue-message appt-time-msg-list)
-		(let ((appt-comp-time (car (car (car appt-time-msg-list)))))
-		  (setq min-to-app (- appt-comp-time cur-comp-time))
-
-		  (while (and appt-time-msg-list 
-			      (< appt-comp-time cur-comp-time))
-		    (setq appt-time-msg-list (cdr appt-time-msg-list)) 
-		    (if appt-time-msg-list
-			(setq appt-comp-time 
-			      (car (car (car appt-time-msg-list))))))
-
-		  ;; If we have an appointment between midnight and
-		  ;; 'appt-message-warning-time' minutes after midnight,
-		  ;; we must begin to issue a message before midnight.
-		  ;; Midnight is considered 0 minutes and 11:59pm is
-		  ;; 1439 minutes. Therefore we must recalculate the minutes
-		  ;; to appointment variable. It is equal to the number of 
-		  ;; minutes before midnight plus the number of 
-		  ;; minutes after midnight our appointment is.
-
-		  (if (and (< appt-comp-time appt-message-warning-time)
-			   (> (+ cur-comp-time appt-message-warning-time)
-			      max-time))
-		      (setq min-to-app (+ (- (1+ max-time) cur-comp-time))
-			    appt-comp-time))
-
-		  ;; issue warning if the appointment time is 
-		  ;; within appt-message-warning time
-
-		  (if (and (<= min-to-app appt-message-warning-time)
-			   (>= min-to-app 0))
-		      (progn
-			(if appt-msg-window
-			    (progn
-			      (string-match
-			       "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" 
-			       display-time-string)
-
-			      (setq new-time (substring display-time-string 
-							(match-beginning 0)
-							(match-end 0)))
-			      (funcall
-			       appt-disp-window-function
-			       min-to-app new-time
-			       (car (cdr (car appt-time-msg-list))))
-			      
-			      (run-at-time
-			       (format "%d sec" appt-display-duration)
-			       nil
-			       appt-delete-window-function))
-			  ;;; else
-
-			  (if appt-visible
-			      (message "%s" 
-				       (car (cdr (car appt-time-msg-list)))))
-
-			  (if appt-audible
-			      (beep 1)))
-
-			(if appt-display-mode-line
-			    (progn
-			      (string-match
-			       "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" 
-			       display-time-string)
-
-			      (setq new-time (substring display-time-string 
-							(match-beginning 0)
-							(match-end 0)))
-			      (setq display-time-string
-				    (concat  "App't in "
-					     min-to-app " min. " new-time " "))
-
-			      (force-mode-line-update t)
-			      (sit-for 0)))
-
-			(if (= min-to-app 0)
-			    (setq appt-time-msg-list
-				  (cdr appt-time-msg-list))))))))))))
-
-
-;; Display appointment message in a separate buffer.
-(defun appt-disp-window (min-to-app new-time appt-msg)
-  (require 'electric)
-
-  ;; Make sure we're not in the minibuffer
-  ;; before splitting the window.
-
-  (if (equal (selected-window) (minibuffer-window))
-      (if (other-window 1) 
-	  (select-window (other-window 1))
-	(if window-system
-	    (select-frame (other-frame 1)))))
-      
-  (let* ((this-buffer (current-buffer))
-	 (this-window (selected-window))
-	 (appt-disp-buf (set-buffer (get-buffer-create appt-buffer-name))))
-
-    (appt-select-lowest-window)
-    (if (cdr (assq 'unsplittable (frame-parameters)))
-	;; In an unsplittable frame, use something somewhere else.
-	(display-buffer appt-disp-buf)
-      ;; Otherwise, split the bottom window and use the lower part.
-      (split-window)
-      (pop-to-buffer appt-disp-buf))
-    (setq mode-line-format 
-	  (concat "-------------------- Appointment in "
-		  min-to-app " minutes. " new-time " %-"))
-    (insert-string appt-msg)
-    (shrink-window-if-larger-than-buffer (get-buffer-window appt-disp-buf t))
-    (set-buffer-modified-p nil)
-    (raise-frame (selected-frame))
-    (select-window this-window)
-    (if appt-audible
-	(beep 1))))
-      
-(defun appt-delete-window ()
-  "Function called to undisplay appointment messages.
-Usually just deletes the appointment buffer."
-  (let ((window (get-buffer-window appt-buffer-name t)))
-    (and window
-	 (or (and (fboundp 'frame-root-window)
-		  (eq window (frame-root-window (window-frame window))))
-	     (delete-window window))))
-  (kill-buffer appt-buffer-name)
-  (if appt-audible
-      (beep 1)))
-
-;; Select the lowest window on the frame.
-(defun appt-select-lowest-window ()
-  (let* ((lowest-window (selected-window))
-	 (bottom-edge (car (cdr (cdr (cdr (window-edges))))))
-         (last-window (previous-window))
-         (window-search t))
-    (while window-search
-      (let* ((this-window (next-window))
-             (next-bottom-edge (car (cdr (cdr (cdr 
-                                               (window-edges this-window)))))))
-        (if (< bottom-edge next-bottom-edge)
-            (progn
-              (setq bottom-edge next-bottom-edge)
-              (setq lowest-window this-window)))
-
-        (select-window this-window)
-        (if (eq last-window this-window)
-            (progn
-              (select-window lowest-window)
-              (setq window-search nil)))))))
-
-
-(defun appt-add (new-appt-time new-appt-msg)
-  "Add an appointment for the day at TIME and issue MESSAGE.
-The time should be in either 24 hour format or am/pm format."
-
-  (interactive "sTime (hh:mm[am/pm]): \nsMessage: ")
-  (if (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?" new-appt-time)
-      nil
-    (error "Unacceptable time-string"))
-  
-  (let* ((appt-time-string (concat new-appt-time " " new-appt-msg))
-         (appt-time (list (appt-convert-time new-appt-time)))
-         (time-msg (cons appt-time (list appt-time-string))))
-    (setq appt-time-msg-list (append appt-time-msg-list
-                                     (list time-msg)))
-    (setq appt-time-msg-list (appt-sort-list appt-time-msg-list)))) 
-
-(defun appt-delete ()
-  "Delete an appointment from the list of appointments."
-  (interactive)
-  (let* ((tmp-msg-list appt-time-msg-list))
-    (while tmp-msg-list
-      (let* ((element (car tmp-msg-list))
-             (prompt-string (concat "Delete " 
-                                    (prin1-to-string (car (cdr element))) 
-                                    " from list? "))
-             (test-input (y-or-n-p prompt-string)))
-        (setq tmp-msg-list (cdr tmp-msg-list))
-        (if test-input
-            (setq appt-time-msg-list (delq element appt-time-msg-list)))))
-    (message "")))
-                 
-
-;; Create the appointments list from todays diary buffer.
-;; The time must be at the beginning of a line for it to be
-;; put in the appointments list.
-;;                02/23/89
-;;                  12:00pm lunch
-;;                 Wednesday
-;;                   10:00am group meeting
-;; We assume that the variables DATE and NUMBER
-;; hold the arguments that list-diary-entries received.
-;; They specify the range of dates that the diary is being processed for.
-
-;;;###autoload
-(defun appt-make-list ()
-  ;; We have something to do if the range of dates that the diary is
-  ;; considering includes the current date.
-  (if (and (not (calendar-date-compare
-		 (list (calendar-current-date))
-		 (list original-date)))
-	   (calendar-date-compare
-	    (list (calendar-current-date))
-            (list (calendar-gregorian-from-absolute
-		   (+ (calendar-absolute-from-gregorian original-date)
-		      number)))))
-      (save-excursion
-	;; Clear the appointments list, then fill it in from the diary.
-	(setq appt-time-msg-list nil)
-	(if diary-entries-list
-
-	    ;; Cycle through the entry-list (diary-entries-list)
-	    ;; looking for entries beginning with a time. If 
-	    ;; the entry begins with a time, add it to the
-	    ;; appt-time-msg-list. Then sort the list.
-
-	    (let ((entry-list diary-entries-list)
-		  (new-time-string ""))
-	      ;; Skip diary entries for dates before today.
-	      (while (and entry-list
-			  (calendar-date-compare
-			   (car entry-list) (list (calendar-current-date))))
-		(setq entry-list (cdr entry-list)))
-	      ;; Parse the entries for today.
-	      (while (and entry-list 
-			  (calendar-date-equal 
-			   (calendar-current-date) (car (car entry-list))))
-		(let ((time-string (substring (prin1-to-string 
-					       (cdr (car entry-list))) 2 -2)))
-
-		  (while (string-match
-			  "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?.*" 
-			  time-string)
-		    (let* ((appt-time-string (substring time-string
-							(match-beginning 0)
-							(match-end 0))))
-
-		      (if (< (match-end 0) (length time-string))
-			  (setq new-time-string (substring time-string 
-							   (+ (match-end 0) 1)
-							   nil))
-			(setq new-time-string ""))
-
-		      (string-match "[0-9]?[0-9]:[0-9][0-9]\\(am\\|pm\\)?"
-				    time-string)
-
-		      (let* ((appt-time (list (appt-convert-time 
-					       (substring time-string
-							  (match-beginning 0)
-							  (match-end 0)))))
-			     (time-msg (cons appt-time
-					     (list appt-time-string))))
-			(setq time-string new-time-string)
-			(setq appt-time-msg-list (append appt-time-msg-list
-							 (list time-msg)))))))
-		(setq entry-list (cdr entry-list)))))
-	(setq appt-time-msg-list (appt-sort-list appt-time-msg-list))
-
-	;; Get the current time and convert it to minutes
-	;; from midnight. ie. 12:01am = 1, midnight = 0,
-	;; so that the elements in the list
-	;; that are earlier than the present time can
-	;; be removed.
-
-	(let* ((now (decode-time))
-	       (cur-hour (nth 2 now))
-	       (cur-min (nth 1 now))
-	       (cur-comp-time (+ (* cur-hour 60) cur-min))
-	       (appt-comp-time (car (car (car appt-time-msg-list)))))
-
-	  (while (and appt-time-msg-list (< appt-comp-time cur-comp-time))
-	    (setq appt-time-msg-list (cdr appt-time-msg-list)) 
-	    (if appt-time-msg-list
-		(setq appt-comp-time (car (car (car appt-time-msg-list))))))))))
-  
-
-;;Simple sort to put the appointments list in order.
-;;Scan the list for the smallest element left in the list.
-;;Append the smallest element left into the new list, and remove
-;;it from the original list.
-(defun appt-sort-list (appt-list)
-  (let ((order-list nil))
-    (while appt-list
-      (let* ((element (car appt-list))
-             (element-time (car (car element)))
-             (tmp-list (cdr appt-list)))
-        (while tmp-list
-          (if (< element-time (car (car (car tmp-list))))
-              nil
-            (setq element (car tmp-list))
-            (setq element-time (car (car element))))
-          (setq tmp-list (cdr tmp-list)))
-        (setq order-list (append order-list (list element)))
-        (setq appt-list (delq element appt-list))))
-    order-list))
-
-
-(defun appt-convert-time (time2conv)
-  "Convert hour:min[am/pm] format to minutes from midnight."
-
-  (let ((conv-time 0)
-        (hr 0)
-        (min 0))
-
-    (string-match ":[0-9][0-9]" time2conv)
-    (setq min (string-to-int 
-               (substring time2conv 
-                          (+ (match-beginning 0) 1) (match-end 0))))
-  
-    (string-match "[0-9]?[0-9]:" time2conv)
-    (setq hr (string-to-int 
-              (substring time2conv 
-                         (match-beginning 0)
-                         (match-end 0))))
-  
-    ;; convert the time appointment time into 24 hour time
-  
-    (if (and (string-match  "[p][m]" time2conv) (< hr 12))
-        (progn
-          (string-match "[0-9]?[0-9]:" time2conv)
-          (setq hr (+ 12 hr))))
-  
-    ;; convert the actual time
-    ;; into minutes for comparison
-    ;; against the actual time.
-  
-    (setq conv-time (+ (* hr 60) min))
-    conv-time))
-
-(add-hook 'display-time-hook 'appt-check)
-
-;;; appt.el ends here
-
diff --git a/lisp/calendar/cal-china.el b/lisp/calendar/cal-china.el
deleted file mode 100644
index c15f4511c48..00000000000
--- a/lisp/calendar/cal-china.el
+++ /dev/null
@@ -1,455 +0,0 @@
-;;; cal-china.el --- calendar functions for the Chinese calendar.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: Chinese calendar, calendar, holidays, diary
-
-;; 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 collection of functions implements the features of calendar.el,
-;; diary.el, and holidays.el that deal with the Chinese calendar.  The rules
-;; used for the Chinese calendar are those of Baolin Liu (see L. E. Doggett's
-;; article "Calendars" in the Explanatory Supplement to the Astronomical
-;; Almanac, second edition, 1992) for the calendar as revised at the beginning
-;; of the Qing dynasty in 1644.  The nature of the astronomical calculations
-;; is such that precise calculations cannot be made without great expense in
-;; time, so that the calendars produced may not agree perfectly with published
-;; tables--but no two pairs of published tables agree perfectly either!  Liu's
-;; rules produce a calendar for 2033 which is not accepted by all authorities.
-;; The date of Chinese New Year is correct from 1644-2051.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'lunar)
-
-(defvar chinese-calendar-celestial-stem
-  ["Jia" "Yi" "Bing" "Ding" "Wu" "Ji" "Geng" "Xin" "Ren" "Gui"])
-
-(defvar chinese-calendar-terrestrial-branch
-  ["Zi" "Chou" "Yin" "Mao" "Chen" "Si" "Wu" "Wei" "Shen" "You" "Xu" "Hai"])
-
-(defvar chinese-calendar-time-zone 
-  '(if (< year 1928)
-       (+ 465 (/ 40.0 60.0))
-     480)
-  "*Number of minutes difference between local standard time for Chinese
-calendar and Coordinated Universal (Greenwich) Time.  Default is for Beijing.
-This is an expression in `year' since it changed at 1928-01-01 00:00:00 from
-UT+7:45:40 to UT+8.")
-
-(defvar chinese-calendar-location-name "Beijing"
-  "*Name of location used for calculation of Chinese calendar.")
-
-(defvar chinese-calendar-daylight-time-offset 0
-; The correct value is as follows, but the Chinese calendrical
-; authorities do NOT use DST in determining astronomical events:
-;  60
-  "*Number of minutes difference between daylight savings and standard time
-for Chinese calendar.  Default is for no daylight savings time.")
-
-(defvar chinese-calendar-standard-time-zone-name
-  '(if (< year 1928)
-       "PMT"
-     "CST")
-  "*Abbreviated name of standard time zone used for Chinese calendar.")
-
-(defvar chinese-calendar-daylight-time-zone-name "CDT"
-  "*Abbreviated name of daylight-savings time zone used for Chinese calendar.")
-
-(defvar chinese-calendar-daylight-savings-starts nil
-; The correct value is as follows, but the Chinese calendrical
-; authorities do NOT use DST in determining astronomical events:
-;  '(cond ((< 1986 year) (calendar-nth-named-day 1 0 4 year 10))
-;         ((= 1986 year) '(5 4 1986))
-;         (t nil))
-  "*Sexp giving the date on which daylight savings time starts for Chinese
-calendar.  Default is for no daylight savings time.  See documentation of
-`calendar-daylight-savings-starts'.")
-
-(defvar chinese-calendar-daylight-savings-ends nil
-; The correct value is as follows, but the Chinese calendrical
-; authorities do NOT use DST in determining astronomical events:
-;  '(if (<= 1986 year) (calendar-nth-named-day 1 0 9 year 11))
-  "*Sexp giving the date on which daylight savings time ends for Chinese
-calendar.  Default is for no daylight savings time.  See documentation of
-`calendar-daylight-savings-ends'.")
-
-(defvar chinese-calendar-daylight-savings-starts-time 0
-  "*Number of minutes after midnight that daylight savings time starts for
-Chinese calendar.  Default is for no daylight savings time.")
-
-(defvar chinese-calendar-daylight-savings-ends-time 0
-  "*Number of minutes after midnight that daylight savings time ends for
-Chinese calendar.  Default is for no daylight savings time.")
-
-(defun chinese-zodiac-sign-on-or-after (d)
-  "Absolute date of first new Zodiac sign on or after absolute date d.
-The Zodiac signs begin when the sun's longitude is a multiple of 30 degrees."
- (let* ((year (extract-calendar-year
-                (calendar-gregorian-from-absolute d)))
-         (calendar-time-zone (eval chinese-calendar-time-zone))
-         (calendar-daylight-time-offset
-          chinese-calendar-daylight-time-offset)
-         (calendar-standard-time-zone-name
-          chinese-calendar-standard-time-zone-name)
-         (calendar-daylight-time-zone-name
-          chinese-calendar-daylight-time-zone-name)
-         (calendar-calendar-daylight-savings-starts
-          chinese-calendar-daylight-savings-starts)
-         (calendar-daylight-savings-ends
-          chinese-calendar-daylight-savings-ends)
-         (calendar-daylight-savings-starts-time
-          chinese-calendar-daylight-savings-starts-time)
-         (calendar-daylight-savings-ends-time
-          chinese-calendar-daylight-savings-ends-time))
-   (floor
-    (calendar-absolute-from-astro
-     (solar-date-next-longitude
-      (calendar-astro-from-absolute d)
-      30)))))
-
-(defun chinese-new-moon-on-or-after (d)
-  "Absolute date of first new moon on or after absolute date d."
-  (let* ((year (extract-calendar-year
-                (calendar-gregorian-from-absolute d)))
-         (calendar-time-zone (eval chinese-calendar-time-zone))
-         (calendar-daylight-time-offset
-          chinese-calendar-daylight-time-offset)
-         (calendar-standard-time-zone-name
-          chinese-calendar-standard-time-zone-name)
-         (calendar-daylight-time-zone-name
-          chinese-calendar-daylight-time-zone-name)
-         (calendar-calendar-daylight-savings-starts
-          chinese-calendar-daylight-savings-starts)
-         (calendar-daylight-savings-ends
-          chinese-calendar-daylight-savings-ends)
-         (calendar-daylight-savings-starts-time
-          chinese-calendar-daylight-savings-starts-time)
-         (calendar-daylight-savings-ends-time
-          chinese-calendar-daylight-savings-ends-time))
-    (floor
-     (calendar-absolute-from-astro
-      (lunar-new-moon-on-or-after
-       (calendar-astro-from-absolute d))))))
-
-(defvar chinese-year-cache
-  '((1989 (12 726110) (1 726139) (2 726169) (3 726198) (4 726227) (5 726257)
-          (6 726286) (7 726316) (8 726345) (9 726375) (10 726404) (11 726434))
-    (1990 (12 726464) (1 726494) (2 726523) (3 726553) (4 726582) (5 726611)
-          (5.5 726641) (6 726670) (7 726699) (8 726729) (9 726758) (10 726788)
-          (11 726818))
-    (1991 (12 726848) (1 726878) (2 726907) (3 726937) (4 726966) (5 726995)
-          (6 727025) (7 727054) (8 727083) (9 727113) (10 727142) (11 727172))
-    (1992 (12 727202) (1 727232) (2 727261) (3 727291) (4 727321) (5 727350)
-          (6 727379) (7 727409) (8 727438) (9 727467) (10 727497) (11 727526))
-    (1993 (12 727556) (1 727586) (2 727615) (3 727645) (3.5 727675) (4 727704)
-          (5 727734) (6 727763) (7 727793) (8 727822) (9 727851) (10 727881)
-          (11 727910))
-    (1994 (12 727940) (1 727969) (2 727999) (3 728029) (4 728059) (5 728088)
-          (6 728118) (7 728147) (8 728177) (9 728206) (10 728235) (11 728265))
-    (1995 (12 728294) (1 728324) (2 728353) (3 728383) (4 728413) (5 728442)
-          (6 728472) (7 728501) (8 728531) (8.5 728561) (9 728590) (10 728619)
-          (11 728649))
-    (1996 (12 728678) (1 728708) (2 728737) (3 728767) (4 728796) (5 728826)
-          (6 728856) (7 728885) (8 728915) (9 728944) (10 728974) (11 729004))
-    (1997 (12 729033) (1 729062) (2 729092) (3 729121) (4 729151) (5 729180)
-          (6 729210) (7 729239) (8 729269) (9 729299) (10 729328) (11 729358))
-    (1998 (12 729388) (1 729417) (2 729447) (3 729476) (4 729505) (5 729535)
-          (5.5 729564) (6 729593) (7 729623) (8 729653) (9 729682) (10 729712)
-          (11 729742))
-    (1999 (12 729771) (1 729801) (2 729831) (3 729860) (4 729889) (5 729919)
-          (6 729948) (7 729977) (8 730007) (9 730036) (10 730066) (11 730096))
-    (2000 (12 730126) (1 730155) (2 730185) (3 730215) (4 730244) (5 730273)
-          (6 730303) (7 730332) (8 730361) (9 730391) (10 730420) (11 730450)))
-  "An assoc list of Chinese year structures as determined by `chinese-year'.
-
-Values are computed as needed, but to save time, the initial value consists
-of the precomputed years 1989-2000.  The code works just as well with this
-set to nil initially (which is how the value for 1989-2000 was computed).")
-
-(defun chinese-year (y)
-  "The structure of the Chinese year for Gregorian year Y.
-The result is a list of pairs (i d), where month i begins on absolute date d,
-of the Chinese months from the Chinese month following the solstice in
-Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y.
-
-The list is cached for further use."
-  (let ((list (cdr (assoc y chinese-year-cache))))
-    (if (not list)
-        (progn
-          (setq list (compute-chinese-year y))
-          (setq chinese-year-cache
-                (append chinese-year-cache (list (cons y list))))))
-    list))
-
-(defun number-chinese-months (list start)
-  "Assign month numbers to the lunar months in LIST, starting with START.
-Numbers are assigned sequentially, START, START+1, ..., 11, with half
-numbers used for leap months.
-
-First month of list will never be a leap month, nor will the last."
-  (if list
-      (if (zerop (- 12 start (length list)))
-          ;; List is too short for a leap month
-          (cons (list start (car list))
-                (number-chinese-months (cdr list) (1+ start)))
-        (cons
-         ;; First month
-         (list start (car list))
-         ;; Remaining months
-         (if (and (cdr (cdr list));; at least two more months...
-                  (<= (car (cdr (cdr list)))
-                      (chinese-zodiac-sign-on-or-after (car (cdr list)))))
-             ;; Next month is a leap month
-             (cons (list (+ start 0.5) (car (cdr list)))
-                   (number-chinese-months (cdr (cdr list)) (1+ start)))
-           ;; Next month is not a leap month
-           (number-chinese-months (cdr list) (1+ start)))))))
-
-(defun chinese-month-list (start end)
-  "List of starting dates of Chinese months from START to END."
-  (if (<= start end)
-      (let ((new-moon (chinese-new-moon-on-or-after start)))
-        (if (<= new-moon end)
-            (cons new-moon
-                  (chinese-month-list (1+ new-moon) end))))))
-
-(defun compute-chinese-year (y)
-  "Compute the structure of the Chinese year for Gregorian year Y.
-The result is a list of pairs (i d), where month i begins on absolute date d,
-of the Chinese months from the Chinese month following the solstice in
-Gregorian year Y-1 to the Chinese month of the solstice of Gregorian year Y."
-  (let* ((next-solstice (chinese-zodiac-sign-on-or-after
-                         (calendar-absolute-from-gregorian
-                          (list 12 15 y))))
-         (list (chinese-month-list (1+ (chinese-zodiac-sign-on-or-after
-                                        (calendar-absolute-from-gregorian
-                                         (list 12 15 (1- y)))))
-                                   next-solstice))
-         (next-sign (chinese-zodiac-sign-on-or-after (car list))))
-    (if (= (length list) 12)
-        ;; No room for a leap month, just number them 12, 1, 2, ..., 11
-        (cons (list 12 (car list))
-              (number-chinese-months (cdr list) 1))
-      ;; Now we can assign numbers to the list for y
-      ;; The first month or two are special
-      (if (or (> (car list) next-sign) (>= next-sign (car (cdr list))))
-          ;; First month on list is a leap month, second is not
-          (append (list (list 11.5 (car list))
-                        (list 12 (car (cdr list))))
-                  (number-chinese-months (cdr (cdr list)) 1))
-        ;; First month on list is not a leap month
-        (append (list (list 12 (car list)))
-                (if (>= (chinese-zodiac-sign-on-or-after (car (cdr list)))
-                        (car (cdr (cdr list))))
-                    ;; Second month on list is a leap month
-                    (cons (list 12.5 (car (cdr list)))
-                          (number-chinese-months (cdr (cdr list)) 1))
-                  ;; Second month on list is not a leap month
-                  (number-chinese-months (cdr list) 1)))))))
-
-(defun calendar-absolute-from-chinese (date)
-  "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
-The Gregorian date Sunday, December 31, 1 BC is imaginary."
-  (let* ((cycle (car date))
-         (year (car (cdr date)))
-         (month (car (cdr (cdr date))))
-         (day (car (cdr (cdr (cdr date)))))
-         (g-year (+ (* (1- cycle) 60);; years in prior cycles
-                    (1- year)        ;; prior years this cycle
-                    -2636)))         ;; years before absolute date 0
-    (+ (1- day);; prior days this month
-       (car
-        (cdr    ;; absolute date of start of this month
-         (assoc month (append (memq (assoc 1 (chinese-year g-year))
-                                    (chinese-year g-year))
-                              (chinese-year (1+ g-year)))))))))
-
-(defun calendar-chinese-from-absolute (date)
-  "Compute Chinese date (cycle year month day) corresponding to absolute DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let* ((g-year (extract-calendar-year
-                  (calendar-gregorian-from-absolute date)))
-         (c-year (+ g-year 2695))
-         (list (append (chinese-year (1- g-year))
-                       (chinese-year g-year)
-                       (chinese-year (1+ g-year)))))
-    (while (<= (car (cdr (car (cdr list)))) date)
-      ;; the first month on the list is in Chinese year c-year
-      ;; date is on or after start of second month on list...
-      (if (= 1 (car (car (cdr list))))
-          ;; second month on list is a new Chinese year
-          (setq c-year (1+ c-year)))
-      ;; ...so first month on list is of no interest
-      (setq list (cdr list)))
-    (list (/ (1- c-year) 60)
-          (calendar-mod c-year 60)
-          (car (car list))
-          (1+ (- date (car (cdr (car list))))))))
-
-(defun holiday-chinese-new-year ()
-  "Date of Chinese New Year."
-  (let ((m displayed-month)
-        (y displayed-year))
-    (increment-calendar-month m y 1)
-    (if (< m 5)
-        (let ((chinese-new-year
-               (calendar-gregorian-from-absolute
-                (car (cdr (assoc 1 (chinese-year y)))))))
-          (if (calendar-date-is-visible-p chinese-new-year)
-          (list
-           (list chinese-new-year
-                 (format "Chinese New Year (%s)"
-                         (calendar-chinese-sexagesimal-name (+ y 57))))))))))
-
-(defun calendar-chinese-date-string (&optional date)
-  "String of Chinese date of Gregorian DATE.
-Defaults to today's date if DATE is not given."
-  (let* ((a-date (calendar-absolute-from-gregorian
-                  (or date (calendar-current-date))))
-         (c-date (calendar-chinese-from-absolute a-date))
-         (cycle (car c-date))
-         (year (car (cdr c-date)))
-         (month (car (cdr (cdr c-date))))
-         (day (car (cdr (cdr (cdr c-date)))))
-         (this-month (calendar-absolute-from-chinese
-                      (list cycle year month 1)))
-         (next-month (calendar-absolute-from-chinese
-                      (list (if (= year 60) (1+ cycle) cycle)
-                            (if (= (floor month) 12) (1+ year) year)
-                            (calendar-mod (1+ (floor month)) 12)
-                            1)))
-         (m-cycle (% (+ (* year 5) (floor month)) 60)))
-    (format "Cycle %s, year %s (%s), %smonth %s%s, day %s (%s)"
-            cycle
-            year (calendar-chinese-sexagesimal-name year)
-            (if (not (integerp month))
-                "second "
-              (if (< 30 (- next-month this-month))
-                  "first "
-                ""))
-            (floor month)
-            (if (integerp month)
-                (format " (%s)" (calendar-chinese-sexagesimal-name
-                                 (+ (* 5 year) month 44)))
-              "")
-            day (calendar-chinese-sexagesimal-name (+ a-date 15)))))
-
-(defun calendar-chinese-sexagesimal-name (n)
-  "The N-th name of the Chinese sexagesimal cycle.
-N congruent to 1 gives the first name, N congruent to 2 gives the second name,
-..., N congruent to 60 gives the sixtieth name."
-  (format "%s-%s"
-          (aref chinese-calendar-celestial-stem (% (1- n) 10))
-          (aref chinese-calendar-terrestrial-branch (% (1- n) 12))))
-
-(defun calendar-print-chinese-date ()
-  "Show the Chinese date equivalents of date."
-  (interactive)
-  (message "Computing Chinese date...")
-  (message "Chinese date: %s"
-           (calendar-chinese-date-string (calendar-cursor-to-date t))))
-
-(defun calendar-goto-chinese-date (date &optional noecho)
-  "Move cursor to Chinese date DATE.
-Echo Chinese date unless NOECHO is t."
-  (interactive
-   (let* ((c (calendar-chinese-from-absolute
-              (calendar-absolute-from-gregorian
-               (calendar-current-date))))
-          (cycle (calendar-read
-                  "Chinese calendar cycle number (>44): "
-                  '(lambda (x) (> x 44))
-                  (int-to-string (car c))))
-          (year (calendar-read
-                 "Year in Chinese cycle (1..60): "
-                 '(lambda (x) (and (<= 1 x) (<= x 60)))
-                 (int-to-string (car (cdr c)))))
-          (month-list (make-chinese-month-assoc-list
-                       (chinese-months cycle year)))
-          (month (cdr (assoc
-                       (completing-read "Chinese calendar month: "
-                                        month-list nil t)
-                       month-list)))
-          (last (if (= month
-                       (car (cdr (cdr
-                                  (calendar-chinese-from-absolute
-                                   (+ 29
-                                      (calendar-absolute-from-chinese
-                                       (list cycle year month 1))))))))
-                    30
-                  29))
-          (day (calendar-read
-                (format "Chinese calendar day (1-%d): " last)
-                '(lambda (x) (and (<= 1 x) (<= x last))))))
-     (list (list cycle year month day))))
-  (calendar-goto-date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-chinese date)))
-  (or noecho (calendar-print-chinese-date)))
-
-(defun chinese-months (c y)
-  "A list of the months in cycle C, year Y of the Chinese calendar."
-  (let* ((l (memq 1 (append
-                     (mapcar '(lambda (x)
-                                (car x))
-                             (chinese-year (extract-calendar-year
-                                            (calendar-gregorian-from-absolute
-                                             (calendar-absolute-from-chinese
-                                              (list c y 1 1))))))
-                     (mapcar '(lambda (x)
-                                (if (> (car x) 11) (car x)))
-                             (chinese-year (extract-calendar-year
-                                            (calendar-gregorian-from-absolute
-                                             (calendar-absolute-from-chinese
-                                              (list (if (= y 60) (1+ c) c)
-                                                    (if (= y 60) 1 y)
-                                                    1 1))))))))))
-    l))
-
-(defun make-chinese-month-assoc-list (l)
-  "Make list of months L into an assoc list."
-  (if (and l (car l))
-      (if (and (cdr l) (car (cdr l)))
-          (if (= (car l) (floor (car (cdr l))))
-              (append
-               (list (cons (format "%s (first)" (car l)) (car l))
-                     (cons (format "%s (second)" (car l)) (car (cdr l))))
-               (make-chinese-month-assoc-list (cdr (cdr l))))
-            (append
-             (list (cons (int-to-string (car l)) (car l)))
-             (make-chinese-month-assoc-list (cdr l))))
-        (list (cons (int-to-string (car l)) (car l))))))
-
-(defun diary-chinese-date ()
-  "Chinese calendar equivalent of date diary entry."
-  (format "Chinese date: %s" (calendar-chinese-date-string date)))
-
-(provide 'cal-china)
-
-;;; cal-china.el ends here
diff --git a/lisp/calendar/cal-coptic.el b/lisp/calendar/cal-coptic.el
deleted file mode 100644
index 6fce26c5013..00000000000
--- a/lisp/calendar/cal-coptic.el
+++ /dev/null
@@ -1,234 +0,0 @@
-;;; cal-coptic.el --- calendar functions for the Coptic/Ethiopic calendars.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: Coptic calendar, Ethiopic calendar, calendar, diary
-
-;; 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 collection of functions implements the features of calendar.el and
-;; diary.el that deal with the Coptic and Ethiopic calendars.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'cal-julian)
-
-(defvar coptic-calendar-month-name-array
-  ["Tut" "Babah" "Hatur" "Kiyahk" "Tubah" "Amshir" "Baramhat" "Barmundah"
-   "Bashans" "Baunah" "Abib" "Misra" "al-Nasi"])
-
-(defvar coptic-calendar-epoch (calendar-absolute-from-julian '(8 29 284))
-  "Absolute date of start of Coptic calendar = August 29, 284 A.D. (Julian).")
-
-(defconst coptic-name "Coptic")
-
-(defun coptic-calendar-leap-year-p (year)
-  "True if YEAR is a leap year on the Coptic calendar."
-  (zerop (mod (1+ year) 4)))
-
-(defun coptic-calendar-last-day-of-month (month year)
-  "Return last day of MONTH, YEAR on the Coptic calendar.
-The 13th month is not really a month, but the 5 (6 in leap years) day period of
-Nisi (Kebus)  at the end of the year."
-  (if (< month 13)
-      30
-    (if (coptic-calendar-leap-year-p year)
-        6
-      5)))
-
-(defun calendar-absolute-from-coptic (date)
-  "Compute absolute date from Coptic date DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let ((month (extract-calendar-month date))
-        (day (extract-calendar-day date))
-        (year (extract-calendar-year date)))
-    (+ (1- coptic-calendar-epoch);; Days before start of calendar
-       (* 365 (1- year))         ;; Days in prior years
-       (/ year 4)                ;; Leap days in prior years
-       (* 30 (1- month))         ;; Days in prior months this year
-       day)))                    ;; Days so far this month
-       
-
-(defun calendar-coptic-from-absolute (date)
-  "Compute the Coptic equivalent for absolute date DATE.
-The result is a list of the form (MONTH DAY YEAR).
-The absolute date is the number of days elapsed since the imaginary
-Gregorian date Sunday, December 31, 1 BC."
-  (if (< date coptic-calendar-epoch)
-      (list 0 0 0);; pre-Coptic date
-    (let* ((approx (/ (- date coptic-calendar-epoch)
-                      366))   ;; Approximation from below.
-           (year              ;; Search forward from the approximation.
-            (+ approx
-               (calendar-sum y approx
-                 (>= date (calendar-absolute-from-coptic (list 1 1 (1+ y))))
-                 1)))
-           (month             ;; Search forward from Tot.
-            (1+ (calendar-sum m 1
-                  (> date
-                     (calendar-absolute-from-coptic
-                      (list m
-                            (coptic-calendar-last-day-of-month m year)
-                            year)))
-                  1)))
-           (day                ;; Calculate the day by subtraction.
-            (- date
-               (1- (calendar-absolute-from-coptic (list month 1 year))))))
-    (list month day year))))
-
-(defun calendar-coptic-date-string (&optional date)
-  "String of Coptic date of Gregorian DATE.
-Returns the empty string if DATE is pre-Coptic calendar.
-Defaults to today's date if DATE is not given."
-  (let* ((coptic-date (calendar-coptic-from-absolute
-                       (calendar-absolute-from-gregorian
-                        (or date (calendar-current-date)))))
-         (y (extract-calendar-year coptic-date))
-         (m (extract-calendar-month coptic-date)))
-    (if (< y 1)
-        ""
-      (let ((monthname (aref coptic-calendar-month-name-array (1- m)))
-            (day (int-to-string (extract-calendar-day coptic-date)))
-            (dayname nil)
-            (month (int-to-string m))
-            (year (int-to-string y)))
-        (mapconcat 'eval calendar-date-display-form "")))))
-
-(defun calendar-print-coptic-date ()
-  "Show the Coptic calendar equivalent of the selected date."
-  (interactive)
-  (let ((f (calendar-coptic-date-string (calendar-cursor-to-date t))))
-    (if (string-equal f "")
-        (message "Date is pre-%s calendar" coptic-name)
-      (message f))))
-
-(defun calendar-goto-coptic-date (date &optional noecho)
-  "Move cursor to Coptic date DATE.
-Echo Coptic date unless NOECHO is t."
-  (interactive (coptic-prompt-for-date))
-  (calendar-goto-date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-coptic date)))
-  (or noecho (calendar-print-coptic-date)))
-
-(defun coptic-prompt-for-date ()
-  "Ask for a Coptic date."
-  (let* ((today (calendar-current-date))
-         (year (calendar-read
-                (format "%s calendar year (>0): " coptic-name)
-                '(lambda (x) (> x 0))
-                (int-to-string
-                 (extract-calendar-year
-                  (calendar-coptic-from-absolute
-                   (calendar-absolute-from-gregorian today))))))
-         (completion-ignore-case t)
-         (month (cdr (assoc
-                      (capitalize
-                       (completing-read
-                        (format "%s calendar month name: " coptic-name)
-                        (mapcar 'list
-                                (append coptic-calendar-month-name-array nil))
-                        nil t))
-                      (calendar-make-alist coptic-calendar-month-name-array
-                                           1 'capitalize))))
-         (last (coptic-calendar-last-day-of-month month year))
-         (day (calendar-read
-               (format "%s calendar day (1-%d): " coptic-name last)
-               '(lambda (x) (and (< 0 x) (<= x last))))))
-    (list (list month day year))))
-
-(defun diary-coptic-date ()
-  "Coptic calendar equivalent of date diary entry."
-  (let ((f (calendar-coptic-date-string (calendar-cursor-to-date t))))
-    (if (string-equal f "")
-        (format "Date is pre-%s calendar" coptic-name)
-      f)))
-
-(defconst ethiopic-calendar-month-name-array
-  ["Maskaram" "Teqemt" "Khedar" "Takhsas" "Ter" "Yakatit" "Magabit" "Miyazya"
-   "Genbot" "Sane" "Hamle" "Nahas" "Paguem"])
-
-(defconst ethiopic-calendar-epoch 2430
-  "Absolute date of start of Ethiopic calendar = August 29, 7 C.E. (Julian).")
-
-(defconst ethiopic-name "Ethiopic")
-
-(defun calendar-absolute-from-ethiopic (date)
-  "Compute absolute date from Ethiopic date DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let ((coptic-calendar-epoch ethiopic-calendar-epoch))
-    (calendar-absolute-from-coptic date)))
-
-(defun calendar-ethiopic-from-absolute (date)
-  "Compute the Ethiopic equivalent for absolute date DATE.
-The result is a list of the form (MONTH DAY YEAR).
-The absolute date is the number of days elapsed since the imaginary
-Gregorian date Sunday, December 31, 1 BC."
-  (let ((coptic-calendar-epoch ethiopic-calendar-epoch))
-    (calendar-coptic-from-absolute date)))
-
-(defun calendar-ethiopic-date-string (&optional date)
-  "String of Ethiopic date of Gregorian DATE.
-Returns the empty string if DATE is pre-Ethiopic calendar.
-Defaults to today's date if DATE is not given."
-  (let ((coptic-calendar-epoch ethiopic-calendar-epoch)
-        (coptic-name ethiopic-name)
-        (coptic-calendar-month-name-array ethiopic-calendar-month-name-array))
-    (calendar-coptic-date-string date)))
-
-(defun calendar-print-ethiopic-date ()
-  "Show the Ethiopic calendar equivalent of the selected date."
-  (interactive)
-  (let ((coptic-calendar-epoch ethiopic-calendar-epoch)
-        (coptic-name ethiopic-name)
-        (coptic-calendar-month-name-array ethiopic-calendar-month-name-array))
-    (call-interactively 'calendar-print-coptic-date)))
-
-(defun calendar-goto-ethiopic-date (date &optional noecho)
-  "Move cursor to Ethiopic date DATE.
-Echo Ethiopic date unless NOECHO is t."
-  (interactive
-   (let ((coptic-calendar-epoch ethiopic-calendar-epoch)
-         (coptic-name ethiopic-name)
-         (coptic-calendar-month-name-array ethiopic-calendar-month-name-array))
-     (coptic-prompt-for-date)))
-  (calendar-goto-date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-ethiopic date)))
-  (or noecho (calendar-print-ethiopic-date)))
-
-(defun diary-ethiopic-date ()
-  "Ethiopic calendar equivalent of date diary entry."
-  (let ((coptic-calendar-epoch ethiopic-calendar-epoch)
-        (coptic-name ethiopic-name)
-        (coptic-calendar-month-name-array ethiopic-calendar-month-name-array))
-    (diary-coptic-date)))
-
-(provide 'cal-coptic)
-
-;;; cal-coptic.el ends here
diff --git a/lisp/calendar/cal-dst.el b/lisp/calendar/cal-dst.el
deleted file mode 100644
index 3e33f6cb9f3..00000000000
--- a/lisp/calendar/cal-dst.el
+++ /dev/null
@@ -1,397 +0,0 @@
-;;; cal-dst.el --- calendar functions for daylight savings rules.
-
-;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Paul Eggert <eggert@twinsun.com>
-;;	Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: daylight savings time, calendar, diary, holidays
-
-;; 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 collection of functions implements the features of calendar.el and
-;; holiday.el that deal with daylight savings time.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'calendar)
-(require 'cal-persia)
-
-(defvar calendar-current-time-zone-cache nil
-  "Cache for result of calendar-current-time-zone.")
-
-(defvar calendar-system-time-basis
-  (calendar-absolute-from-gregorian '(1 1 1970))
-  "Absolute date of starting date of system clock.")
-
-(defun calendar-absolute-from-time (x utc-diff)
-  "Absolute local date of time X; local time is UTC-DIFF seconds from UTC.
-
-X is (HIGH . LOW) or (HIGH LOW . IGNORED) where HIGH and LOW are the
-high and low 16 bits, respectively, of the number of seconds since
-1970-01-01 00:00:00 UTC, ignoring leap seconds.
-
-Returns the pair (ABS-DATE . SECONDS) where SECONDS after local midnight on
-absolute date ABS-DATE is the equivalent moment to X."
-  (let* ((h (car x))
-	 (xtail (cdr x))
-         (l (+ utc-diff (if (numberp xtail) xtail (car xtail))))
-         (u (+ (* 512 (mod h 675)) (floor l 128))))
-    ;; Overflow is a terrible thing!
-    (cons (+ calendar-system-time-basis
-	     ;; floor((2^16 h +l) / (60*60*24))
-	     (* 512 (floor h 675)) (floor u 675))
-	  ;; (2^16 h +l) mod (60*60*24)
-	  (+ (* (mod u 675) 128) (mod l 128)))))
-
-(defun calendar-time-from-absolute (abs-date s)
-  "Time of absolute date ABS-DATE, S seconds after midnight.
-
-Returns the pair (HIGH . LOW) where HIGH and LOW are the high and low
-16 bits, respectively, of the number of seconds 1970-01-01 00:00:00 UTC,
-ignoring leap seconds, that is the equivalent moment to S seconds after
-midnight UTC on absolute date ABS-DATE."
-  (let* ((a (- abs-date calendar-system-time-basis))
-         (u (+ (* 163 (mod a 512)) (floor s 128))))
-    ;; Overflow is a terrible thing!
-    (cons
-     ;; floor((60*60*24*a + s) / 2^16)
-     (+ a (* 163 (floor a 512)) (floor u 512))
-     ;; (60*60*24*a + s) mod 2^16
-     (+ (* 128 (mod u 512)) (mod s 128)))))
-
-(defun calendar-next-time-zone-transition (time)
-  "Return the time of the next time zone transition after TIME.
-Both TIME and the result are acceptable arguments to current-time-zone.
-Return nil if no such transition can be found."
-  (let* ((base 65536);; 2^16 = base of current-time output
-	 (quarter-multiple 120);; approx = (seconds per quarter year) / base
-	 (time-zone (current-time-zone time))
-	 (time-utc-diff (car time-zone))
-         hi
-	 hi-zone
-         (hi-utc-diff time-utc-diff)
-         (quarters '(2 1 3)))
-    ;; Heuristic: probe the time zone offset in the next three calendar
-    ;; quarters, looking for a time zone offset different from TIME.
-    (while (and quarters (eq time-utc-diff hi-utc-diff))
-      (setq hi (cons (+ (car time) (* (car quarters) quarter-multiple)) 0))
-      (setq hi-zone (current-time-zone hi))
-      (setq hi-utc-diff (car hi-zone))
-      (setq quarters (cdr quarters)))
-    (and
-     time-utc-diff
-     hi-utc-diff
-     (not (eq time-utc-diff hi-utc-diff))
-     ;; Now HI is after the next time zone transition.
-     ;; Set LO to TIME, and then binary search to increase LO and decrease HI
-     ;; until LO is just before and HI is just after the time zone transition.
-     (let* ((tail (cdr time))
-	    (lo (cons (car time) (if (numberp tail) tail (car tail))))
-	    probe)
-       (while
-	   ;; Set PROBE to halfway between LO and HI, rounding down.
-	   ;; If PROBE equals LO, we are done.
-	   (let* ((lsum (+ (cdr lo) (cdr hi)))
-		  (hsum (+ (car lo) (car hi) (/ lsum base)))
-		  (hsumodd (logand 1 hsum)))
-	     (setq probe (cons (/ (- hsum hsumodd) 2)
-			       (/ (+ (* hsumodd base) (% lsum base)) 2)))
-	     (not (equal lo probe)))
-	 ;; Set either LO or HI to PROBE, depending on probe results.
-	 (if (eq (car (current-time-zone probe)) hi-utc-diff)
-	     (setq hi probe)
-	   (setq lo probe)))
-       hi))))
-
-(defun calendar-time-zone-daylight-rules (abs-date utc-diff)
-  "Return daylight transition rule for ABS-DATE, UTC-DIFF sec offset from UTC.
-ABS-DATE must specify a day that contains a daylight savings transition.
-The result has the proper form for calendar-daylight-savings-starts'."
-  (let* ((date (calendar-gregorian-from-absolute abs-date))
-	 (weekday (% abs-date 7))
-	 (m (extract-calendar-month date))
-	 (d (extract-calendar-day date))
-	 (y (extract-calendar-year date))
-         (last (calendar-last-day-of-month m y))
-	 (candidate-rules
-	  (append
-	   ;; Day D of month M.
-	   (list (list 'list m d 'year))
-	   ;; The first WEEKDAY of month M.
-           (if (< d 8)
-               (list (list 'calendar-nth-named-day 1 weekday m 'year)))
-	   ;; The last WEEKDAY of month M.
-           (if (> d (- last 7))
-               (list (list 'calendar-nth-named-day -1 weekday m 'year)))
-	   ;; The first WEEKDAY after day J of month M, for D-6 < J <= D.
-           (let (l)
-             (calendar-for-loop j from (max 2 (- d 6)) to (min d (- last 8)) do
-		(setq l
-		      (cons
-		       (list 'calendar-nth-named-day 1 weekday m 'year j)
-		       l)))
-	     l)
-	   ;; 01-01 and 07-01 for this year's Persian calendar.
-	   (if (and (= m 3) (<= 20 d) (<= d 21))
-	       '((calendar-gregorian-from-absolute
-		  (calendar-absolute-from-persian
-		   (list 1 1 (- year 621))))))
-	   (if (and (= m 9) (<= 22 d) (<= d 23))
-	       '((calendar-gregorian-from-absolute
-		  (calendar-absolute-from-persian
-		   (list 7 1 (- year 621))))))))
-	 (prevday-sec (- -1 utc-diff)) ;; last sec of previous local day
-	 (year (1+ y)))
-    ;; Scan through the next few years until only one rule remains.
-    (while
-	(let ((rules candidate-rules)
-	      new-rules)
-	  (while
-	      (let*
-		  ((rule (car rules))
-		   (date
-		    ;; The following is much faster than
-		    ;; (calendar-absolute-from-gregorian (eval rule)).
-		    (cond ((eq (car rule) 'calendar-nth-named-day)
-			   (eval (cons 'calendar-nth-named-absday (cdr rule))))
-			  ((eq (car rule) 'calendar-gregorian-from-absolute)
-			   (eval (car (cdr rule))))
-			  (t (let ((g (eval rule)))
-			       (calendar-absolute-from-gregorian g))))))
-		(or (equal
-		     (current-time-zone
-		      (calendar-time-from-absolute date prevday-sec))
-		     (current-time-zone
-		      (calendar-time-from-absolute (1+ date) prevday-sec)))
-		    (setq new-rules (cons rule new-rules)))
-		(setq rules (cdr rules))))
-	  ;; If no rules remain, just use the first candidate rule;
-	  ;; it's wrong in general, but it's right for at least one year.
-	  (setq candidate-rules (if new-rules (nreverse new-rules)
-				  (list (car candidate-rules))))
-	  (setq year (1+ year))
-	  (cdr candidate-rules)))
-    (car candidate-rules)))
-
-(defun calendar-current-time-zone ()
-  "Return UTC difference, dst offset, names and rules for current time zone.
-
-Returns (UTC-DIFF DST-OFFSET STD-ZONE DST-ZONE DST-STARTS DST-ENDS
-DST-STARTS-TIME DST-ENDS-TIME), based on a heuristic probing of what the
-system knows:
-
-UTC-DIFF is an integer specifying the number of minutes difference between
-    standard time in the current time zone and Coordinated Universal Time
-    (Greenwich Mean Time).  A negative value means west of Greenwich.
-DST-OFFSET is an integer giving the daylight savings time offset in minutes.
-STD-ZONE is a string giving the name of the time zone when no seasonal time
-    adjustment is in effect.
-DST-ZONE is a string giving the name of the time zone when there is a seasonal
-    time adjustment in effect.
-DST-STARTS and DST-ENDS are sexps in the variable `year' giving the daylight
-    savings time start and end rules, in the form expected by
-    `calendar-daylight-savings-starts'.
-DST-STARTS-TIME and DST-ENDS-TIME are integers giving the number of minutes
-    after midnight that daylight savings time starts and ends.
-
-If the local area does not use a seasonal time adjustment, STD-ZONE and
-DST-ZONE are equal, and all the DST-* integer variables are 0.
-
-Some operating systems cannot provide all this information to Emacs; in this
-case, `calendar-current-time-zone' returns a list containing nil for the data
-it can't find."
-  (or
-   calendar-current-time-zone-cache
-   (setq
-    calendar-current-time-zone-cache
-    (let* ((t0 (current-time))
-	   (t0-zone (current-time-zone t0))
-	   (t0-utc-diff (car t0-zone))
-	   (t0-name (car (cdr t0-zone))))
-      (if (not t0-utc-diff)
-	  ;; Little or no time zone information is available.
-	  (list nil nil t0-name t0-name nil nil nil nil)
-	(let* ((t1 (calendar-next-time-zone-transition t0))
-	       (t2 (and t1 (calendar-next-time-zone-transition t1))))
-	  (if (not t2)
-	      ;; This locale does not have daylight savings time.
-	      (list (/ t0-utc-diff 60) 0 t0-name t0-name nil nil 0 0)
-	    ;; Use heuristics to find daylight savings parameters.
-	    (let* ((t1-zone (current-time-zone t1))
-		   (t1-utc-diff (car t1-zone))
-		   (t1-name (car (cdr t1-zone)))
-		   (t1-date-sec (calendar-absolute-from-time t1 t0-utc-diff))
-		   (t2-date-sec (calendar-absolute-from-time t2 t1-utc-diff))
-		   (t1-rules (calendar-time-zone-daylight-rules
-			      (car t1-date-sec) t0-utc-diff))
-		   (t2-rules (calendar-time-zone-daylight-rules
-			      (car t2-date-sec) t1-utc-diff))
-		   (t1-time (/ (cdr t1-date-sec) 60))
-		   (t2-time (/ (cdr t2-date-sec) 60)))
-	      (cons
-	       (/ (min t0-utc-diff t1-utc-diff) 60)
-	       (cons
-		(/ (abs (- t0-utc-diff t1-utc-diff)) 60)
-		(if (< t0-utc-diff t1-utc-diff)
-		    (list t0-name t1-name t1-rules t2-rules t1-time t2-time)
-		    (list t1-name t0-name t2-rules t1-rules t2-time t1-time)
-		    )))))))))))
-
-;;; The following eight defvars relating to daylight savings time should NOT be
-;;; marked to go into loaddefs.el where they would be evaluated when Emacs is
-;;; dumped.  These variables' appropriate values depend on the conditions under
-;;; which the code is INVOKED; so it's inappropriate to initialize them when
-;;; Emacs is dumped---they should be initialized when calendar.el is loaded.
-;;; They default to US Eastern time if time zone info is not available.
-
-(calendar-current-time-zone)
-
-(defvar calendar-time-zone (or (car calendar-current-time-zone-cache) -300)
-  "*Number of minutes difference between local standard time at
-`calendar-location-name' and Coordinated Universal (Greenwich) Time.  For
-example, -300 for New York City, -480 for Los Angeles.")
-
-(defvar calendar-daylight-time-offset
-  (or (car (cdr calendar-current-time-zone-cache)) 60)
-  "*Number of minutes difference between daylight savings and standard time.
-  
-If the locale never uses daylight savings time, set this to 0.")
-
-(defvar calendar-standard-time-zone-name
-  (or (car (nthcdr 2 calendar-current-time-zone-cache)) "EST")
-  "*Abbreviated name of standard time zone at `calendar-location-name'.
-For example, \"EST\" in New York City, \"PST\" for Los Angeles.")
-
-(defvar calendar-daylight-time-zone-name
-  (or (car (nthcdr 3 calendar-current-time-zone-cache)) "EDT")
-  "*Abbreviated name of daylight-savings time zone at `calendar-location-name'.
-For example, \"EDT\" in New York City, \"PDT\" for Los Angeles.")
-  
-;;;###autoload
-(put 'calendar-daylight-savings-starts 'risky-local-variable t)
-(defvar calendar-daylight-savings-starts
-  (or (car (nthcdr 4 calendar-current-time-zone-cache))
-      (and (not (zerop calendar-daylight-time-offset))
-	   '(calendar-nth-named-day 1 0 4 year)))
-  "*Sexp giving the date on which daylight savings time starts.
-This is an expression in the variable `year' whose value gives the Gregorian
-date in the form (month day year) on which daylight savings time starts.  It is
-used to determine the starting date of daylight savings time for the holiday
-list and for correcting times of day in the solar and lunar calculations.
-
-For example, if daylight savings time is mandated to start on October 1,
-you would set `calendar-daylight-savings-starts' to
-
-      '(10 1 year)
-
-If it starts on the first Sunday in April, you would set it to
-
-      '(calendar-nth-named-day 1 0 4 year)
-
-If the locale never uses daylight savings time, set this to nil.")
-
-;;;###autoload
-(put 'calendar-daylight-savings-ends 'risky-local-variable t)
-(defvar calendar-daylight-savings-ends
-  (or (car (nthcdr 5 calendar-current-time-zone-cache))
-      (and (not (zerop calendar-daylight-time-offset))
-	   '(calendar-nth-named-day -1 0 10 year)))
-  "*Sexp giving the date on which daylight savings time ends.
-This is an expression in the variable `year' whose value gives the Gregorian
-date in the form (month day year) on which daylight savings time ends.  It is
-used to determine the starting date of daylight savings time for the holiday
-list and for correcting times of day in the solar and lunar calculations.
-
-For example, if daylight savings time ends on the last Sunday in October:
-
-      '(calendar-nth-named-day -1 0 10 year)
-
-If the locale never uses daylight savings time, set this to nil.")
-  
-(defvar calendar-daylight-savings-starts-time
-  (or (car (nthcdr 6 calendar-current-time-zone-cache)) 120)
-  "*Number of minutes after midnight that daylight savings time starts.")
-  
-(defvar calendar-daylight-savings-ends-time
-  (or (car (nthcdr 7 calendar-current-time-zone-cache))
-      calendar-daylight-savings-starts-time)
-  "*Number of minutes after midnight that daylight savings time ends.")
-
-(defun dst-in-effect (date)
-  "True if on absolute DATE daylight savings time is in effect.
-Fractional part of DATE is local standard time of day."
-  (let* ((year (extract-calendar-year
-                (calendar-gregorian-from-absolute (floor date))))
-         (dst-starts-gregorian (eval calendar-daylight-savings-starts))
-         (dst-ends-gregorian (eval calendar-daylight-savings-ends))
-         (dst-starts (and dst-starts-gregorian
-                          (+ (calendar-absolute-from-gregorian
-                              dst-starts-gregorian)
-                             (/ calendar-daylight-savings-starts-time
-                                60.0 24.0))))
-         (dst-ends (and dst-ends-gregorian
-                        (+ (calendar-absolute-from-gregorian
-                            dst-ends-gregorian)
-                           (/ (- calendar-daylight-savings-ends-time
-                                 calendar-daylight-time-offset)
-                              60.0 24.0)))))
-    (and dst-starts dst-ends
-         (if (< dst-starts dst-ends)
-             (and (<= dst-starts date) (< date dst-ends))
-           (or (<= dst-starts date) (< date dst-ends))))))
-
-(defun dst-adjust-time (date time &optional style)
-  "Adjust, to account for dst on DATE, decimal fraction standard TIME.
-Returns a list (date adj-time zone) where `date' and `adj-time' are the values
-adjusted for `zone'; here `date' is a list (month day year), `adj-time' is a
-decimal fraction time, and `zone' is a string.
-
-Optional parameter STYLE forces the result time to be standard time when its
-value is 'standard and daylight savings time (if available) when its value is
-'daylight.
-
-Conversion to daylight savings time is done according to
-`calendar-daylight-savings-starts', `calendar-daylight-savings-ends',
-`calendar-daylight-savings-starts-time',
-`calendar-daylight-savings-ends-time', and
-`calendar-daylight-savings-offset'."
-
-  (let* ((rounded-abs-date (+ (calendar-absolute-from-gregorian date)
-			      (/ (round (* 60 time)) 60.0 24.0)))
-         (dst (dst-in-effect rounded-abs-date))
-	 (time-zone (if dst
-			calendar-daylight-time-zone-name
-			calendar-standard-time-zone-name))
-	 (time (+ rounded-abs-date
-                  (if dst (/ calendar-daylight-time-offset 24.0 60.0) 0))))
-    (list (calendar-gregorian-from-absolute (truncate time))
-          (* 24.0 (- time (truncate time)))
-          time-zone)))
-
-(provide 'cal-dst)
-
-;;; cal-dst.el ends here
diff --git a/lisp/calendar/cal-french.el b/lisp/calendar/cal-french.el
deleted file mode 100644
index 8f68841d229..00000000000
--- a/lisp/calendar/cal-french.el
+++ /dev/null
@@ -1,244 +0,0 @@
-;;; cal-french.el --- calendar functions for the French Revolutionary calendar.
-
-;; Copyright (C) 1988, 1989, 1992, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: French Revolutionary calendar, calendar, diary
-
-;; 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 collection of functions implements the features of calendar.el and
-;; diary.el that deal with the French Revolutionary calendar.
-
-;; Technical details of the French Revolutionary calendar can be found in
-;; ``Calendrical Calculations, Part II: Three Historical Calendars'' by
-;; E. M. Reingold, N. Dershowitz, and S. M. Clamen, Software--Practice and
-;; Experience, Volume 23, Number 4 (April, 1993), pages 383-404.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'calendar)
-
-(defvar french-calendar-accents
-  (and (char-table-p standard-display-table)
-       (equal (aref standard-display-table 161) [161]))
-  "True if diacritical marks are available.")
-
-(defconst french-calendar-epoch (calendar-absolute-from-gregorian '(9 22 1792))
-  "Absolute date of start of French Revolutionary calendar = September 22, 1792.")
-
-(defconst french-calendar-month-name-array
-  (if french-calendar-accents
-      ["Vendémiaire" "Brumaire" "Frimaire" "Nivôse" "Pluviôse" "Ventôse"
-       "Germinal" "Floréal" "Prairial" "Messidor" "Thermidor" "Fructidor"]
-    ["Vende'miaire" "Brumaire" "Frimaire" "Nivo^se" "Pluvio^se" "Vento^se"
-     "Germinal" "Flore'al" "Prairial" "Messidor" "Thermidor" "Fructidor"]))
-
-(defconst french-calendar-day-name-array
-  ["Primidi" "Duodi" "Tridi" "Quartidi" "Quintidi" "Sextidi" "Septidi"
-   "Octidi" "Nonidi" "Decadi"])
-
-(defconst french-calendar-special-days-array
-  (if french-calendar-accents
-      ["de la Vertu" "du Genie" "du Labour" "de la Raison"
-       "de la Récompense" "de la Révolution"]
-    ["de la Vertu" "du Genie" "du Labour" "de la Raison" "de la Re'compense"
-     "de la Re'volution"]))
-
-(defun french-calendar-leap-year-p (year)
-  "True if YEAR is a leap year on the French Revolutionary calendar.
-For Gregorian years 1793 to 1805, the years of actual operation of the
-calendar, uses historical practice based on equinoxes is followed (years 3, 7,
-and 11 were leap years; 15 and 20 would have been leap years).  For later
-years uses the proposed rule of Romme (never adopted)--leap years fall every
-four years except century years not divisible 400 and century years that are
-multiples of 4000."
-  (or (memq year '(3 7 11));; Actual practice--based on equinoxes
-      (memq year '(15 20)) ;; Anticipated practice--based on equinoxes
-      (and (> year 20)     ;; Romme's proposal--never adopted
-           (zerop (% year 4))
-           (not (memq (% year 400) '(100 200 300)))
-           (not (zerop (% year 4000))))))
-
-(defun french-calendar-last-day-of-month (month year)
-  "Return last day of MONTH, YEAR on the French Revolutionary calendar.
-The 13th month is not really a month, but the 5 (6 in leap years) day period of
-`sansculottides' at the end of the year."
-  (if (< month 13)
-      30
-    (if (french-calendar-leap-year-p year)
-        6
-      5)))
-
-(defun calendar-absolute-from-french (date)
-  "Compute absolute date from French Revolutionary date DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let ((month (extract-calendar-month date))
-        (day (extract-calendar-day date))
-        (year (extract-calendar-year date)))
-    (+ (* 365 (1- year));; Days in prior years
-       ;; Leap days in prior years
-       (if (< year 20)
-           (/ year 4);; Actual and anticipated practice (years 3, 7, 11, 15)
-         ;; Romme's proposed rule (using the Principle of Inclusion/Exclusion)
-         (+ (/ (1- year) 4);; Luckily, there were 4 leap years before year 20
-            (- (/ (1- year) 100))
-            (/ (1- year) 400)
-            (- (/ (1- year) 4000))))
-       (* 30 (1- month));; Days in prior months this year
-       day;; Days so far this month
-       (1- french-calendar-epoch))));; Days before start of calendar
-
-(defun calendar-french-from-absolute (date)
-  "Compute the French Revolutionary equivalent for absolute date DATE.
-The result is a list of the form (MONTH DAY YEAR).
-The absolute date is the number of days elapsed since the
-\(imaginary) Gregorian date Sunday, December 31, 1 BC."
-  (if (< date french-calendar-epoch)
-      (list 0 0 0);; pre-French Revolutionary date
-    (let* ((approx              ;; Approximation from below.
-            (/ (- date french-calendar-epoch) 366))
-           (year                ;; Search forward from the approximation.
-            (+ approx
-               (calendar-sum y approx
-                 (>= date (calendar-absolute-from-french (list 1 1 (1+ y))))
-                 1)))
-           (month               ;; Search forward from Vendemiaire.
-            (1+ (calendar-sum m 1
-                  (> date
-                     (calendar-absolute-from-french
-                      (list m
-                            (french-calendar-last-day-of-month m year)
-                            year)))
-                  1)))
-           (day                   ;; Calculate the day by subtraction.
-            (- date
-               (1- (calendar-absolute-from-french (list month 1 year))))))
-    (list month day year))))
-
-(defun calendar-french-date-string (&optional date)
-  "String of French Revolutionary date of Gregorian DATE.
-Returns the empty string if DATE is pre-French Revolutionary.
-Defaults to today's date if DATE is not given."
-  (let* ((french-date (calendar-french-from-absolute
-                       (calendar-absolute-from-gregorian
-                        (or date (calendar-current-date)))))
-         (y (extract-calendar-year french-date))
-         (m (extract-calendar-month french-date))
-         (d (extract-calendar-day french-date)))
-    (cond
-     ((< y 1) "")
-     ((= m 13) (format (if french-calendar-accents
-                           "Jour %s de l'Année %d de la Révolution"
-                         "Jour %s de l'Anne'e %d de la Re'volution")
-                       (aref french-calendar-special-days-array (1- d))
-                       y))
-     (t (format
-         (if french-calendar-accents
-             "Décade %s, %s de %s de l'Année %d de la Révolution"
-           "De'cade %s, %s de %s de l'Anne'e %d de la Re'volution")
-         (make-string (1+ (/ (1- d) 10)) ?I)
-         (aref french-calendar-day-name-array (% (1- d) 10))
-         (aref french-calendar-month-name-array (1- m))
-         y)))))
-
-(defun calendar-print-french-date ()
-  "Show the French Revolutionary calendar equivalent of the selected date."
-  (interactive)
-  (let ((f (calendar-french-date-string (calendar-cursor-to-date t))))
-    (if (string-equal f "")
-        (message "Date is pre-French Revolution")
-      (message f))))
-
-(defun calendar-goto-french-date (date &optional noecho)
-  "Move cursor to French Revolutionary date DATE.
-Echo French Revolutionary date unless NOECHO is t."
-  (interactive
-   (let* ((year (calendar-read
-                 (if french-calendar-accents
-                     "Année de la Révolution (>0): "
-                   "Anne'e de la Re'volution (>0): ")
-                 '(lambda (x) (> x 0))
-                 (int-to-string
-                  (extract-calendar-year
-                   (calendar-french-from-absolute
-                    (calendar-absolute-from-gregorian
-                     (calendar-current-date)))))))
-          (month-list
-           (mapcar 'list
-                   (append french-calendar-month-name-array
-                           (if (french-calendar-leap-year-p year)
-                               (mapcar
-                                '(lambda (x) (concat "Jour " x))
-                                french-calendar-special-days-array)
-                             (reverse
-                              (cdr;; we don't want rev. day in a non-leap yr.
-                               (reverse
-                                (mapcar
-                                 '(lambda (x) (concat "Jour " x))
-                                 french-calendar-special-days-array))))))))
-          (completion-ignore-case t)
-          (month (cdr (assoc
-                       (capitalize
-                        (completing-read
-                         "Mois ou Sansculottide: "
-                         month-list
-                         nil t))
-                       (calendar-make-alist
-                        month-list
-                        1
-                        '(lambda (x) (capitalize (car x)))))))
-          (decade (if (> month 12)
-                      1
-                    (calendar-read
-                     (if french-calendar-accents
-                         "Décade (1-3): "
-                       "De'cade (1-3): ")
-                     '(lambda (x) (memq x '(1 2 3))))))
-          (day (if (> month 12)
-                   (- month 12)
-                 (calendar-read
-                  "Jour (1-10): "
-                  '(lambda (x) (and (<= 1 x) (<= x 10))))))
-          (month (if (> month 12) 13 month))
-          (day (+ day (* 10 (1- decade)))))
-     (list (list month day year))))
-  (calendar-goto-date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-french date)))
-  (or noecho (calendar-print-french-date)))
-
-(defun diary-french-date ()
-  "French calendar equivalent of date diary entry."
-  (let ((f (calendar-french-date-string (calendar-cursor-to-date t))))
-    (if (string-equal f "")
-        "Date is pre-French Revolution"
-      f)))
-
-(provide 'cal-french)
-
-;;; cal-french.el ends here
diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el
deleted file mode 100644
index 23e6d694b08..00000000000
--- a/lisp/calendar/cal-hebrew.el
+++ /dev/null
@@ -1,1180 +0,0 @@
-;;; cal-hebrew.el --- calendar functions for the Hebrew calendar.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Nachum Dershowitz <nachum@cs.uiuc.edu>
-;;      Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: Hebrew calendar, calendar, diary
-
-;; 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 collection of functions implements the features of calendar.el and
-;; diary.el that deal with the Hebrew calendar.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'calendar)
-
-(defun calendar-hebrew-from-absolute (date)
-  "Compute the Hebrew date (month day year) corresponding to absolute DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let* ((greg-date (calendar-gregorian-from-absolute date))
-         (month (aref [9 10 11 12 1 2 3 4 7 7 7 8]
-                 (1- (extract-calendar-month greg-date))))
-         (day)
-         (year (+ 3760 (extract-calendar-year greg-date))))
-    (while (>= date (calendar-absolute-from-hebrew (list 7 1 (1+ year))))
-        (setq year (1+ year)))
-    (let ((length (hebrew-calendar-last-month-of-year year)))
-      (while (> date
-                (calendar-absolute-from-hebrew
-                 (list month
-                       (hebrew-calendar-last-day-of-month month year)
-                       year)))
-        (setq month (1+ (% month length)))))
-    (setq day (1+
-               (- date (calendar-absolute-from-hebrew (list month 1 year)))))
-    (list month day year)))
-
-(defun hebrew-calendar-leap-year-p (year)
-  "t if YEAR is a Hebrew calendar leap year."
-  (< (% (1+ (* 7 year)) 19) 7))
-
-(defun hebrew-calendar-last-month-of-year (year)
-  "The last month of the Hebrew calendar YEAR."
-  (if (hebrew-calendar-leap-year-p year)
-      13
-    12))
-
-(defun hebrew-calendar-last-day-of-month (month year)
-  "The last day of MONTH in YEAR."
-  (if (or (memq month (list 2 4 6 10 13))
-          (and (= month 12) (not (hebrew-calendar-leap-year-p year)))
-          (and (= month 8) (not (hebrew-calendar-long-heshvan-p year)))
-          (and (= month 9) (hebrew-calendar-short-kislev-p year)))
-      29
-    30))
-
-(defun hebrew-calendar-elapsed-days (year)
-  "Days from Sun. prior to start of Hebrew calendar to mean conjunction of Tishri of Hebrew YEAR."
-  (let* ((months-elapsed
-          (+ (* 235 (/ (1- year) 19));; Months in complete cycles so far.
-             (* 12 (% (1- year) 19))      ;; Regular months in this cycle
-             (/ (1+ (* 7 (% (1- year) 19))) 19)));; Leap months this cycle
-         (parts-elapsed (+ 204 (* 793 (% months-elapsed 1080))))
-         (hours-elapsed (+ 5
-                           (* 12 months-elapsed)
-                           (* 793 (/ months-elapsed 1080))
-                           (/ parts-elapsed 1080)))
-         (parts                                  ;; Conjunction parts
-          (+ (* 1080 (% hours-elapsed 24)) (% parts-elapsed 1080)))
-         (day                                    ;; Conjunction day
-          (+ 1 (* 29 months-elapsed) (/ hours-elapsed 24)))
-         (alternative-day
-          (if (or (>= parts 19440)    ;; If the new moon is at or after midday,
-                  (and (= (% day 7) 2);; ...or is on a Tuesday...
-                       (>= parts 9924)  ;;    at 9 hours, 204 parts or later...
-                       (not (hebrew-calendar-leap-year-p year)));; of a
-                                                                ;; common year,
-                  (and (= (% day 7) 1);; ...or is on a Monday...
-                       (>= parts 16789) ;;   at 15 hours, 589 parts or later...
-                       (hebrew-calendar-leap-year-p (1- year))));; at the end
-                                                     ;; of a leap year
-       ;; Then postpone Rosh HaShanah one day
-              (1+ day)
-       ;; Else
-            day)))
-    (if ;; If Rosh HaShanah would occur on Sunday, Wednesday, or Friday
-        (memq (% alternative-day 7) (list 0 3 5))
-  ;; Then postpone it one (more) day and return        
-        (1+ alternative-day)
-  ;; Else return        
-      alternative-day)))
-
-(defun hebrew-calendar-days-in-year (year)
-  "Number of days in Hebrew YEAR."
-  (- (hebrew-calendar-elapsed-days (1+ year))
-     (hebrew-calendar-elapsed-days year)))
-
-(defun hebrew-calendar-long-heshvan-p (year)
-  "t if Heshvan is long in Hebrew YEAR."
-  (= (% (hebrew-calendar-days-in-year year) 10) 5))
-
-(defun hebrew-calendar-short-kislev-p (year)
-  "t if Kislev is short in Hebrew YEAR."
-  (= (% (hebrew-calendar-days-in-year year) 10) 3))
-
-(defun calendar-absolute-from-hebrew (date)
-  "Absolute date of Hebrew DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let* ((month (extract-calendar-month date))
-         (day (extract-calendar-day date))
-         (year (extract-calendar-year date)))
-    (+ day                            ;; Days so far this month.
-       (if (< month 7);; before Tishri
-     ;; Then add days in prior months this year before and after Nisan
-           (+ (calendar-sum
-               m 7 (<= m (hebrew-calendar-last-month-of-year year))
-               (hebrew-calendar-last-day-of-month m year))
-              (calendar-sum
-               m 1 (< m month)
-               (hebrew-calendar-last-day-of-month m year)))
-     ;; Else add days in prior months this year
-         (calendar-sum
-          m 7 (< m month)
-          (hebrew-calendar-last-day-of-month m year)))
-    (hebrew-calendar-elapsed-days year);; Days in prior years.
-    -1373429)))                        ;; Days elapsed before absolute date 1.
-
-(defvar calendar-hebrew-month-name-array-common-year
-  ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
-   "Heshvan" "Kislev" "Teveth" "Shevat" "Adar"])
-
-(defvar calendar-hebrew-month-name-array-leap-year
-  ["Nisan" "Iyar" "Sivan" "Tammuz" "Av" "Elul" "Tishri"
-   "Heshvan" "Kislev" "Teveth" "Shevat" "Adar I" "Adar II"])
-
-(defun calendar-hebrew-date-string (&optional date)
-  "String of Hebrew date before sunset of Gregorian DATE.
-Defaults to today's date if DATE is not given.
-Driven by the variable `calendar-date-display-form'."
-  (let* ((hebrew-date (calendar-hebrew-from-absolute
-                       (calendar-absolute-from-gregorian
-                        (or date (calendar-current-date)))))
-         (calendar-month-name-array
-          (if (hebrew-calendar-leap-year-p (extract-calendar-year hebrew-date))
-              calendar-hebrew-month-name-array-leap-year
-            calendar-hebrew-month-name-array-common-year)))
-    (calendar-date-string hebrew-date nil t)))
-
-(defun calendar-print-hebrew-date ()
-  "Show the Hebrew calendar equivalent of the date under the cursor."
-  (interactive)
-  (message "Hebrew date (until sunset): %s"
-           (calendar-hebrew-date-string (calendar-cursor-to-date t))))
-
-(defun hebrew-calendar-yahrzeit (death-date year)
-  "Absolute date of the anniversary of Hebrew DEATH-DATE in Hebrew YEAR."
-  (let* ((death-day (extract-calendar-day death-date))
-         (death-month (extract-calendar-month death-date))
-         (death-year (extract-calendar-year death-date)))
-    (cond
-     ;; If it's Heshvan 30 it depends on the first anniversary; if
-     ;; that was not Heshvan 30, use the day before Kislev 1.
-     ((and (= death-month 8)
-           (= death-day 30)
-           (not (hebrew-calendar-long-heshvan-p (1+ death-year))))
-      (1- (calendar-absolute-from-hebrew (list 9 1 year))))
-     ;; If it's Kislev 30 it depends on the first anniversary; if
-     ;; that was not Kislev 30, use the day before Teveth 1.
-     ((and (= death-month 9)
-           (= death-day 30)
-           (hebrew-calendar-short-kislev-p (1+ death-year)))
-      (1- (calendar-absolute-from-hebrew (list 10 1 year))))
-     ;; If it's Adar II, use the same day in last month of
-     ;; year (Adar or Adar II).
-     ((= death-month 13)
-      (calendar-absolute-from-hebrew
-       (list (hebrew-calendar-last-month-of-year year) death-day year)))
-     ;; If it's the 30th in Adar I and year is not a leap year
-     ;; (so Adar has only 29 days), use the last day in Shevat.
-     ((and (= death-day 30)
-           (= death-month 12)
-           (not (hebrew-calendar-leap-year-p year)))
-      (calendar-absolute-from-hebrew (list 11 30 year)))
-     ;; In all other cases, use the normal anniversary of the date of death.
-     (t (calendar-absolute-from-hebrew
-         (list death-month death-day year))))))
-
-(defun calendar-goto-hebrew-date (date &optional noecho)
-  "Move cursor to Hebrew DATE; echo Hebrew date unless NOECHO is t."
-  (interactive
-   (let* ((today (calendar-current-date))
-          (year (calendar-read
-                 "Hebrew calendar year (>3760): "
-                 '(lambda (x) (> x 3760))
-                 (int-to-string
-                  (extract-calendar-year
-                   (calendar-hebrew-from-absolute
-                    (calendar-absolute-from-gregorian today))))))
-          (month-array (if (hebrew-calendar-leap-year-p year)
-                           calendar-hebrew-month-name-array-leap-year
-                         calendar-hebrew-month-name-array-common-year))
-          (completion-ignore-case t)
-          (month (cdr (assoc
-                       (capitalize
-                        (completing-read
-                         "Hebrew calendar month name: "
-                         (mapcar 'list (append month-array nil))
-                         (if (= year 3761)
-                             '(lambda (x)
-                                (let ((m (cdr
-                                          (assoc
-                                           (car x)
-                                           (calendar-make-alist
-                                            month-array)))))
-                                  (< 0
-                                     (calendar-absolute-from-hebrew
-                                      (list m
-                                            (hebrew-calendar-last-day-of-month
-                                             m year)
-                                            year))))))
-                                 
-                         t))
-                       (calendar-make-alist month-array 1 'capitalize))))
-          (last (hebrew-calendar-last-day-of-month month year))
-          (first (if (and (= year 3761) (= month 10))
-                     18 1))
-          (day (calendar-read
-                (format "Hebrew calendar day (%d-%d): "
-                        first last)
-                '(lambda (x) (and (<= first x) (<= x last))))))
-     (list (list month day year))))
-  (calendar-goto-date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-hebrew date)))
-  (or noecho (calendar-print-hebrew-date)))
-
-(defun holiday-hebrew (month day string)
-  "Holiday on MONTH, DAY (Hebrew) called STRING.
-If MONTH, DAY (Hebrew) is visible, the value returned is corresponding
-Gregorian date in the form of the list (((month day year) STRING)).  Returns
-nil if it is not visible in the current calendar window."
-  (if (memq displayed-month;;  This test is only to speed things up a bit;
-            (list          ;;  it works fine without the test too.
-             (if (< 11 month) (- month 11) (+ month 1))
-             (if (< 10 month) (- month 10) (+ month 2))
-             (if (<  9 month) (- month  9) (+ month 3))
-             (if (<  8 month) (- month  8) (+ month 4))
-             (if (<  7 month) (- month  7) (+ month 5))))
-      (let ((m1 displayed-month)
-            (y1 displayed-year)
-            (m2 displayed-month)
-            (y2 displayed-year)
-            (year))
-        (increment-calendar-month m1 y1 -1)
-        (increment-calendar-month m2 y2 1)
-        (let* ((start-date (calendar-absolute-from-gregorian
-                            (list m1 1 y1)))
-               (end-date (calendar-absolute-from-gregorian
-                          (list m2 (calendar-last-day-of-month m2 y2) y2)))
-               (hebrew-start (calendar-hebrew-from-absolute start-date))
-               (hebrew-end (calendar-hebrew-from-absolute end-date))
-               (hebrew-y1 (extract-calendar-year hebrew-start))
-               (hebrew-y2 (extract-calendar-year hebrew-end)))
-          (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
-          (let ((date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-hebrew
-                        (list month day year)))))
-            (if (calendar-date-is-visible-p date)
-                (list (list date string))))))))
-
-(defun holiday-rosh-hashanah-etc ()
-  "List of dates related to Rosh Hashanah, as visible in calendar window."
-  (if (or (< displayed-month 8)
-          (> displayed-month 11))
-      nil;; None of the dates is visible
-    (let* ((abs-r-h (calendar-absolute-from-hebrew
-                      (list 7 1 (+ displayed-year 3761))))
-            (mandatory
-             (list
-              (list (calendar-gregorian-from-absolute abs-r-h)
-                    (format "Rosh HaShanah %d" (+ 3761 displayed-year)))
-              (list (calendar-gregorian-from-absolute (+ abs-r-h 9))
-                    "Yom Kippur")
-              (list (calendar-gregorian-from-absolute (+ abs-r-h 14))
-                    "Sukkot")
-              (list (calendar-gregorian-from-absolute (+ abs-r-h 21))
-                    "Shemini Atzeret")
-              (list (calendar-gregorian-from-absolute (+ abs-r-h 22))
-                    "Simchat Torah")))
-           (optional
-            (list 
-             (list (calendar-gregorian-from-absolute
-                    (calendar-dayname-on-or-before 6 (- abs-r-h 4)))
-                   "Selichot (night)")
-             (list (calendar-gregorian-from-absolute (1- abs-r-h))
-                   "Erev Rosh HaShanah")
-             (list (calendar-gregorian-from-absolute (1+ abs-r-h))
-                   "Rosh HaShanah (second day)")
-             (list (calendar-gregorian-from-absolute
-                    (if (= (% abs-r-h 7) 4) (+ abs-r-h 3) (+ abs-r-h 2)))
-                   "Tzom Gedaliah")
-             (list (calendar-gregorian-from-absolute
-                    (calendar-dayname-on-or-before 6 (+ 7 abs-r-h)))
-                   "Shabbat Shuvah")
-             (list (calendar-gregorian-from-absolute (+ abs-r-h 8))
-                   "Erev Yom Kippur")
-             (list (calendar-gregorian-from-absolute (+ abs-r-h 13))
-                   "Erev Sukkot")
-             (list (calendar-gregorian-from-absolute (+ abs-r-h 15))
-                   "Sukkot (second day)")
-             (list (calendar-gregorian-from-absolute (+ abs-r-h 16))
-                   "Hol Hamoed Sukkot (first day)")
-             (list (calendar-gregorian-from-absolute (+ abs-r-h 17))
-                   "Hol Hamoed Sukkot (second day)")
-             (list (calendar-gregorian-from-absolute (+ abs-r-h 18))
-                   "Hol Hamoed Sukkot (third day)")
-             (list (calendar-gregorian-from-absolute (+ abs-r-h 19))
-                   "Hol Hamoed Sukkot (fourth day)")
-             (list (calendar-gregorian-from-absolute (+ abs-r-h 20))
-                   "Hoshannah Rabbah")))
-            (output-list
-             (filter-visible-calendar-holidays mandatory)))
-      (if all-hebrew-calendar-holidays
-          (setq output-list
-                (append 
-                 (filter-visible-calendar-holidays optional)
-                 output-list)))
-      output-list)))
-
-(defun holiday-hanukkah ()
-  "List of dates related to Hanukkah, as visible in calendar window."
-    (if (memq displayed-month;;  This test is only to speed things up a bit;
-              '(10 11 12 1 2));; it works fine without the test too.
-        (let ((m displayed-month)
-              (y displayed-year))
-          (increment-calendar-month m y 1)
-          (let* ((h-y (extract-calendar-year
-                         (calendar-hebrew-from-absolute
-                          (calendar-absolute-from-gregorian
-                           (list m (calendar-last-day-of-month m y) y)))))
-                 (abs-h (calendar-absolute-from-hebrew (list 9 25 h-y))))
-            (filter-visible-calendar-holidays
-             (list
-              (list (calendar-gregorian-from-absolute (1- abs-h))
-                    "Erev Hanukkah")
-              (list (calendar-gregorian-from-absolute abs-h)
-                    "Hanukkah (first day)")
-              (list (calendar-gregorian-from-absolute (1+ abs-h))
-                    "Hanukkah (second day)")
-              (list (calendar-gregorian-from-absolute (+ abs-h 2))
-                    "Hanukkah (third day)")
-              (list (calendar-gregorian-from-absolute (+ abs-h 3))
-                    "Hanukkah (fourth day)")
-              (list (calendar-gregorian-from-absolute (+ abs-h 4))
-                    "Hanukkah (fifth day)")
-              (list (calendar-gregorian-from-absolute (+ abs-h 5))
-                    "Hanukkah (sixth day)")
-              (list (calendar-gregorian-from-absolute (+ abs-h 6))
-                    "Hanukkah (seventh day)")
-              (list (calendar-gregorian-from-absolute (+ abs-h 7))
-                    "Hanukkah (eighth day)")))))))
-
-(defun holiday-passover-etc ()
-  "List of dates related to Passover, as visible in calendar window."
- (if (< 7 displayed-month)
-      nil;; None of the dates is visible
-    (let* ((abs-p (calendar-absolute-from-hebrew
-                      (list 1 15 (+ displayed-year 3760))))
-           (mandatory
-            (list
-             (list (calendar-gregorian-from-absolute abs-p)
-                   "Passover")
-             (list (calendar-gregorian-from-absolute (+ abs-p 50))
-                   "Shavuot")))
-           (optional
-            (list 
-             (list (calendar-gregorian-from-absolute
-                    (calendar-dayname-on-or-before 6 (- abs-p 43)))
-                   "Shabbat Shekalim")
-             (list (calendar-gregorian-from-absolute
-                    (calendar-dayname-on-or-before 6 (- abs-p 30)))
-                   "Shabbat Zachor")
-             (list (calendar-gregorian-from-absolute
-                    (if (= (% abs-p 7) 2) (- abs-p 33) (- abs-p 31)))
-                   "Fast of Esther")
-             (list (calendar-gregorian-from-absolute (- abs-p 31))
-                   "Erev Purim")
-             (list (calendar-gregorian-from-absolute (- abs-p 30))
-                   "Purim")
-             (list (calendar-gregorian-from-absolute
-                    (if (zerop (% abs-p 7)) (- abs-p 28) (- abs-p 29)))
-                   "Shushan Purim")
-             (list (calendar-gregorian-from-absolute
-                    (- (calendar-dayname-on-or-before 6 (- abs-p 14)) 7))
-                   "Shabbat Parah")
-             (list (calendar-gregorian-from-absolute
-                    (calendar-dayname-on-or-before 6 (- abs-p 14)))
-                   "Shabbat HaHodesh")
-             (list (calendar-gregorian-from-absolute
-                    (calendar-dayname-on-or-before 6 (1- abs-p)))
-                   "Shabbat HaGadol")
-             (list (calendar-gregorian-from-absolute (1- abs-p))
-                   "Erev Passover")
-             (list (calendar-gregorian-from-absolute (1+ abs-p))
-                   "Passover (second day)")
-             (list (calendar-gregorian-from-absolute (+ abs-p 2))
-                   "Hol Hamoed Passover (first day)")
-             (list (calendar-gregorian-from-absolute (+ abs-p 3))
-                   "Hol Hamoed Passover (second day)")
-             (list (calendar-gregorian-from-absolute (+ abs-p 4))
-                   "Hol Hamoed Passover (third day)")
-             (list (calendar-gregorian-from-absolute (+ abs-p 5))
-                   "Hol Hamoed Passover (fourth day)")
-             (list (calendar-gregorian-from-absolute (+ abs-p 6))
-                   "Passover (seventh day)")
-             (list (calendar-gregorian-from-absolute (+ abs-p 7))
-                   "Passover (eighth day)")
-             (list (calendar-gregorian-from-absolute (+ abs-p 12))
-                   "Yom HaShoah")
-             (list (calendar-gregorian-from-absolute
-                    (if (zerop (% abs-p 7))
-                        (+ abs-p 18)
-                      (if (= (% abs-p 7) 6)
-                          (+ abs-p 19)
-                        (+ abs-p 20))))
-                   "Yom HaAtzma'ut")
-             (list (calendar-gregorian-from-absolute (+ abs-p 33))
-                   "Lag BaOmer")
-             (list (calendar-gregorian-from-absolute (+ abs-p 43))
-                   "Yom Yerushalim")
-             (list (calendar-gregorian-from-absolute (+ abs-p 49))
-                   "Erev Shavuot")
-             (list (calendar-gregorian-from-absolute (+ abs-p 51))
-                   "Shavuot (second day)")))
-           (output-list
-             (filter-visible-calendar-holidays mandatory)))
-      (if all-hebrew-calendar-holidays
-          (setq output-list
-                (append 
-                 (filter-visible-calendar-holidays optional)
-                 output-list)))
-      output-list)))
-
-(defun holiday-tisha-b-av-etc ()
-  "List of dates around Tisha B'Av, as visible in calendar window."
-  (if (or (< displayed-month 5)
-          (> displayed-month 9))
-      nil;; None of the dates is visible
-    (let* ((abs-t-a (calendar-absolute-from-hebrew
-                      (list 5 9 (+ displayed-year 3760)))))
-
-      (filter-visible-calendar-holidays
-       (list 
-        (list (calendar-gregorian-from-absolute
-               (if (= (% abs-t-a 7) 6) (- abs-t-a 20) (- abs-t-a 21)))
-              "Tzom Tammuz")
-        (list (calendar-gregorian-from-absolute
-               (calendar-dayname-on-or-before 6 abs-t-a))
-              "Shabbat Hazon")
-        (list (calendar-gregorian-from-absolute
-               (if (= (% abs-t-a 7) 6) (1+ abs-t-a) abs-t-a))
-              "Tisha B'Av")
-        (list (calendar-gregorian-from-absolute
-               (calendar-dayname-on-or-before 6 (+ abs-t-a 7)))
-              "Shabbat Nahamu"))))))
-
-(defun list-hebrew-diary-entries ()
-  "Add any Hebrew date entries from the diary file to `diary-entries-list'.
-Hebrew date diary entries must be prefaced by `hebrew-diary-entry-symbol'
-\(normally an `H').  The same diary date forms govern the style of the Hebrew
-calendar entries, except that the Hebrew month names must be spelled in full.
-The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
-Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
-common Hebrew year.  If a Hebrew date diary entry begins with a
-`diary-nonmarking-symbol', the entry will appear in the diary listing, but will
-not be marked in the calendar.  This function is provided for use with the
-`nongregorian-diary-listing-hook'."
-  (if (< 0 number)
-      (let ((buffer-read-only nil)
-            (diary-modified (buffer-modified-p))
-            (gdate original-date)
-            (mark (regexp-quote diary-nonmarking-symbol)))
-        (calendar-for-loop i from 1 to number do
-           (let* ((d diary-date-forms)
-                  (hdate (calendar-hebrew-from-absolute 
-                          (calendar-absolute-from-gregorian gdate)))
-                  (month (extract-calendar-month hdate))
-                  (day (extract-calendar-day hdate))
-                  (year (extract-calendar-year hdate)))
-             (while d
-               (let*
-                   ((date-form (if (equal (car (car d)) 'backup)
-                                   (cdr (car d))
-                                 (car d)))
-                    (backup (equal (car (car d)) 'backup))
-                    (dayname
-                     (concat
-                      (calendar-day-name gdate) "\\|"
-                      (substring (calendar-day-name gdate) 0 3) ".?"))
-                    (calendar-month-name-array
-                     calendar-hebrew-month-name-array-leap-year)
-                    (monthname
-                     (concat
-                      "\\*\\|"
-                      (calendar-month-name month)))
-                    (month (concat "\\*\\|0*" (int-to-string month)))
-                    (day (concat "\\*\\|0*" (int-to-string day)))
-                    (year
-                     (concat
-                      "\\*\\|0*" (int-to-string year)
-                      (if abbreviated-calendar-year
-                          (concat "\\|" (int-to-string (% year 100)))
-                        "")))
-                    (regexp
-                     (concat
-                      "\\(\\`\\|\^M\\|\n\\)" mark "?"
-                      (regexp-quote hebrew-diary-entry-symbol)
-                      "\\("
-                      (mapconcat 'eval date-form "\\)\\(")
-                      "\\)"))
-                    (case-fold-search t))
-                 (goto-char (point-min))
-                 (while (re-search-forward regexp nil t)
-                   (if backup (re-search-backward "\\<" nil t))
-                   (if (and (or (char-equal (preceding-char) ?\^M)
-                                (char-equal (preceding-char) ?\n))
-                            (not (looking-at " \\|\^I")))
-                       ;;  Diary entry that consists only of date.
-                       (backward-char 1)
-                     ;;  Found a nonempty diary entry--make it visible and
-                     ;;  add it to the list.
-                     (let ((entry-start (point))
-                           (date-start))
-                       (re-search-backward "\^M\\|\n\\|\\`")
-                       (setq date-start (point))
-                       (re-search-forward "\^M\\|\n" nil t 2)
-                       (while (looking-at " \\|\^I")
-                         (re-search-forward "\^M\\|\n" nil t))
-                       (backward-char 1)
-                       (subst-char-in-region date-start (point) ?\^M ?\n t)
-                       (add-to-diary-list
-                         gdate (buffer-substring entry-start (point)))))))
-               (setq d (cdr d))))
-           (setq gdate
-                 (calendar-gregorian-from-absolute
-                  (1+ (calendar-absolute-from-gregorian gdate)))))
-           (set-buffer-modified-p diary-modified))
-        (goto-char (point-min))))
-
-(defun mark-hebrew-diary-entries ()
-  "Mark days in the calendar window that have Hebrew date diary entries.
-Each entry in diary-file (or included files) visible in the calendar window
-is marked.  Hebrew date entries are prefaced by a hebrew-diary-entry-symbol
-\(normally an `H').  The same diary-date-forms govern the style of the Hebrew
-calendar entries, except that the Hebrew month names must be spelled in full.
-The Hebrew months are numbered from 1 to 13 with Nisan being 1, 12 being
-Adar I and 13 being Adar II; you must use `Adar I' if you want Adar of a
-common Hebrew year.  Hebrew date diary entries that begin with a
-diary-nonmarking symbol will not be marked in the calendar.  This function
-is provided for use as part of the nongregorian-diary-marking-hook."
-  (let ((d diary-date-forms))
-    (while d
-      (let*
-          ((date-form (if (equal (car (car d)) 'backup)
-                          (cdr (car d))
-                        (car d)));; ignore 'backup directive
-           (dayname (diary-name-pattern calendar-day-name-array))
-           (monthname
-            (concat
-             (diary-name-pattern calendar-hebrew-month-name-array-leap-year t)
-             "\\|\\*"))
-           (month "[0-9]+\\|\\*")
-           (day "[0-9]+\\|\\*")
-           (year "[0-9]+\\|\\*")
-           (l (length date-form))
-           (d-name-pos (- l (length (memq 'dayname date-form))))
-           (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
-           (m-name-pos (- l (length (memq 'monthname date-form))))
-           (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
-           (d-pos (- l (length (memq 'day date-form))))
-           (d-pos (if (/= l d-pos) (+ 2 d-pos)))
-           (m-pos (- l (length (memq 'month date-form))))
-           (m-pos (if (/= l m-pos) (+ 2 m-pos)))
-           (y-pos (- l (length (memq 'year date-form))))
-           (y-pos (if (/= l y-pos) (+ 2 y-pos)))
-           (regexp
-            (concat
-             "\\(\\`\\|\^M\\|\n\\)"
-             (regexp-quote hebrew-diary-entry-symbol)
-             "\\("
-             (mapconcat 'eval date-form "\\)\\(")
-             "\\)"))
-           (case-fold-search t))
-        (goto-char (point-min))
-        (while (re-search-forward regexp nil t)
-          (let* ((dd-name
-                  (if d-name-pos
-                      (buffer-substring
-                       (match-beginning d-name-pos)
-                       (match-end d-name-pos))))
-                 (mm-name
-                  (if m-name-pos
-                      (buffer-substring
-                       (match-beginning m-name-pos)
-                       (match-end m-name-pos))))
-                 (mm (string-to-int
-                      (if m-pos
-                          (buffer-substring
-                           (match-beginning m-pos)
-                           (match-end m-pos))
-                        "")))
-                 (dd (string-to-int
-                      (if d-pos
-                          (buffer-substring
-                           (match-beginning d-pos)
-                           (match-end d-pos))
-                        "")))
-                 (y-str (if y-pos
-                            (buffer-substring
-                             (match-beginning y-pos)
-                             (match-end y-pos))))
-                 (yy (if (not y-str)
-                         0
-                       (if (and (= (length y-str) 2)
-                                abbreviated-calendar-year)
-                           (let* ((current-y
-                                   (extract-calendar-year
-                                    (calendar-hebrew-from-absolute
-                                     (calendar-absolute-from-gregorian
-                                      (calendar-current-date)))))
-                                  (y (+ (string-to-int y-str)
-                                        (* 100 (/ current-y 100)))))
-                             (if (> (- y current-y) 50)
-                                 (- y 100)
-                               (if (> (- current-y y) 50)
-                                   (+ y 100)
-                                 y)))
-                         (string-to-int y-str)))))
-            (if dd-name
-                (mark-calendar-days-named
-                 (cdr (assoc (capitalize (substring dd-name 0 3))
-                             (calendar-make-alist
-                               calendar-day-name-array
-                               0
-                              '(lambda (x) (substring x 0 3))))))
-              (if mm-name
-                  (if (string-equal mm-name "*")
-                      (setq mm 0)
-                    (setq
-                      mm
-                      (cdr 
-                        (assoc
-                          (capitalize mm-name)
-                            (calendar-make-alist
-                               calendar-hebrew-month-name-array-leap-year))))))
-              (mark-hebrew-calendar-date-pattern mm dd yy)))))
-      (setq d (cdr d)))))
-
-(defun mark-hebrew-calendar-date-pattern (month day year)
-  "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR.
-A value of 0 in any position is a wildcard."
-  (save-excursion
-    (set-buffer calendar-buffer)
-    (if (and (/= 0 month) (/= 0 day))
-        (if (/= 0 year)
-            ;; Fully specified Hebrew date.
-            (let ((date (calendar-gregorian-from-absolute
-                         (calendar-absolute-from-hebrew
-                          (list month day year)))))
-              (if (calendar-date-is-visible-p date)
-                  (mark-visible-calendar-date date)))
-          ;; Month and day in any year--this taken from the holiday stuff.
-          (if (memq displayed-month;;  This test is only to speed things up a
-                    (list          ;;  bit; it works fine without the test too.
-                     (if (< 11 month) (- month 11) (+ month 1))
-                     (if (< 10 month) (- month 10) (+ month 2))
-                     (if (<  9 month) (- month  9) (+ month 3))
-                     (if (<  8 month) (- month  8) (+ month 4))
-                     (if (<  7 month) (- month  7) (+ month 5))))
-              (let ((m1 displayed-month)
-                    (y1 displayed-year)
-                    (m2 displayed-month)
-                    (y2 displayed-year)
-                    (year))
-                (increment-calendar-month m1 y1 -1)
-                (increment-calendar-month m2 y2 1)
-                (let* ((start-date (calendar-absolute-from-gregorian
-                                    (list m1 1 y1)))
-                       (end-date (calendar-absolute-from-gregorian
-                                  (list m2
-                                        (calendar-last-day-of-month m2 y2)
-                                        y2)))
-                       (hebrew-start
-                        (calendar-hebrew-from-absolute start-date))
-                       (hebrew-end (calendar-hebrew-from-absolute end-date))
-                       (hebrew-y1 (extract-calendar-year hebrew-start))
-                       (hebrew-y2 (extract-calendar-year hebrew-end)))
-                  (setq year (if (< 6 month) hebrew-y2 hebrew-y1))
-                  (let ((date (calendar-gregorian-from-absolute
-                               (calendar-absolute-from-hebrew
-                                (list month day year)))))
-                    (if (calendar-date-is-visible-p date)
-                        (mark-visible-calendar-date date)))))))
-      ;; Not one of the simple cases--check all visible dates for match.
-      ;; Actually, the following code takes care of ALL of the cases, but
-      ;; it's much too slow to be used for the simple (common) cases.
-      (let ((m displayed-month)
-            (y displayed-year)
-            (first-date)
-            (last-date))
-        (increment-calendar-month m y -1)
-        (setq first-date
-              (calendar-absolute-from-gregorian
-               (list m 1 y)))
-        (increment-calendar-month m y 2)
-        (setq last-date
-              (calendar-absolute-from-gregorian
-               (list m (calendar-last-day-of-month m y) y)))
-        (calendar-for-loop date from first-date to last-date do
-          (let* ((h-date (calendar-hebrew-from-absolute date))
-                 (h-month (extract-calendar-month h-date))
-                 (h-day (extract-calendar-day h-date))
-                 (h-year (extract-calendar-year h-date)))
-            (and (or (zerop month)
-                     (= month h-month))
-                 (or (zerop day)
-                     (= day h-day))
-                 (or (zerop year)
-                     (= year h-year))
-                 (mark-visible-calendar-date
-                  (calendar-gregorian-from-absolute date)))))))))
-
-(defun insert-hebrew-diary-entry (arg)
-  "Insert a diary entry.
-For the Hebrew date corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-month-name-array
-          calendar-hebrew-month-name-array-leap-year))
-    (make-diary-entry
-     (concat
-      hebrew-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-hebrew-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))
-       nil t))
-     arg)))
-
-(defun insert-monthly-hebrew-diary-entry (arg)
-  "Insert a monthly diary entry.
-For the day of the Hebrew month corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style '(day " * ") '("* " day )))
-         (calendar-month-name-array
-          calendar-hebrew-month-name-array-leap-year))
-    (make-diary-entry
-     (concat
-      hebrew-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-hebrew-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
-     arg)))
-
-(defun insert-yearly-hebrew-diary-entry (arg)
-  "Insert an annual diary entry.
-For the day of the Hebrew year corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " monthname)
-            '(monthname " " day)))
-         (calendar-month-name-array
-          calendar-hebrew-month-name-array-leap-year))
-    (make-diary-entry
-     (concat
-      hebrew-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-hebrew-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
-     arg)))
-
-;;;###autoload
-(defun list-yahrzeit-dates (death-date start-year end-year)
-  "List Yahrzeit dates for *Gregorian* DEATH-DATE from START-YEAR to END-YEAR.
-When called interactively from the calendar window, the date of death is taken
-from the cursor position."
-  (interactive
-   (let* ((death-date
-           (if (equal (current-buffer) (get-buffer calendar-buffer))
-               (calendar-cursor-to-date)
-             (let* ((today (calendar-current-date))
-                    (year (calendar-read
-                           "Year of death (>0): "
-                           '(lambda (x) (> x 0))
-                           (int-to-string (extract-calendar-year today))))
-                    (month-array calendar-month-name-array)
-                    (completion-ignore-case t)
-                    (month (cdr (assoc
-                                 (capitalize
-                                  (completing-read
-                                   "Month of death (name): "
-                                   (mapcar 'list (append month-array nil))
-                                   nil t))
-                                 (calendar-make-alist
-                                  month-array 1 'capitalize))))
-                    (last (calendar-last-day-of-month month year))
-                    (day (calendar-read
-                          (format "Day of death (1-%d): " last)
-                          '(lambda (x) (and (< 0 x) (<= x last))))))
-               (list month day year))))
-          (death-year (extract-calendar-year death-date))
-          (start-year (calendar-read
-                       (format "Starting year of Yahrzeit table (>%d): "
-                               death-year)
-                       '(lambda (x) (> x death-year))
-                       (int-to-string (1+ death-year))))
-          (end-year (calendar-read
-                     (format "Ending year of Yahrzeit table (>=%d): "
-                             start-year)
-                       '(lambda (x) (>= x start-year)))))
-   (list death-date start-year end-year)))
-  (message "Computing yahrzeits...")
-  (let* ((yahrzeit-buffer "*Yahrzeits*")
-         (h-date (calendar-hebrew-from-absolute
-                  (calendar-absolute-from-gregorian death-date)))
-         (h-month (extract-calendar-month h-date))
-         (h-day (extract-calendar-day h-date))
-         (h-year (extract-calendar-year h-date)))
-    (set-buffer (get-buffer-create yahrzeit-buffer))
-    (setq buffer-read-only nil)
-    (calendar-set-mode-line
-     (format "Yahrzeit dates for %s = %s"
-             (calendar-date-string death-date)
-             (let ((calendar-month-name-array
-                    (if (hebrew-calendar-leap-year-p h-year)
-                        calendar-hebrew-month-name-array-leap-year
-                      calendar-hebrew-month-name-array-common-year)))
-               (calendar-date-string h-date nil t))))
-    (erase-buffer)
-    (goto-char (point-min))
-    (calendar-for-loop i from start-year to end-year do
-        (insert
-         (calendar-date-string
-          (calendar-gregorian-from-absolute
-           (hebrew-calendar-yahrzeit
-            h-date
-            (extract-calendar-year
-             (calendar-hebrew-from-absolute
-              (calendar-absolute-from-gregorian (list 1 1 i))))))) "\n"))
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    (setq buffer-read-only t)
-    (display-buffer yahrzeit-buffer)
-    (message "Computing yahrzeits...done")))
-
-(defun diary-hebrew-date ()
-  "Hebrew calendar equivalent of date diary entry."
-  (format "Hebrew date (until sunset): %s" (calendar-hebrew-date-string date)))
-
-(defun diary-omer ()
-  "Omer count diary entry.
-Entry applies if date is within 50 days after Passover."
-  (let* ((passover
-          (calendar-absolute-from-hebrew
-           (list 1 15 (+ (extract-calendar-year date) 3760))))
-         (omer (- (calendar-absolute-from-gregorian date) passover))
-         (week (/ omer 7))
-         (day (% omer 7)))
-    (if (and (> omer 0) (< omer 50))
-        (format "Day %d%s of the omer (until sunset)"
-                omer
-                (if (zerop week)
-                    ""
-                  (format ", that is, %d week%s%s"
-                          week
-                          (if (= week 1) "" "s")
-                          (if (zerop day)
-                              ""
-                            (format " and %d day%s"
-                                    day (if (= day 1) "" "s")))))))))
-
-(defun diary-yahrzeit (death-month death-day death-year)
-  "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before.
-Parameters are DEATH-MONTH, DEATH-DAY, DEATH-YEAR; the diary entry is assumed
-to be the name of the person.  Date of death is on the *civil* calendar;
-although the date of death is specified by the civil calendar, the proper
-Hebrew calendar yahrzeit is determined.  If `european-calendar-style' is t, the
-order of the parameters is changed to DEATH-DAY, DEATH-MONTH, DEATH-YEAR."
-  (let* ((h-date (calendar-hebrew-from-absolute
-                  (calendar-absolute-from-gregorian
-                   (if european-calendar-style
-                       (list death-day death-month death-year)
-                   (list death-month death-day death-year)))))
-         (h-month (extract-calendar-month h-date))
-         (h-day (extract-calendar-day h-date))
-         (h-year (extract-calendar-year h-date))
-         (d (calendar-absolute-from-gregorian date))
-         (yr (extract-calendar-year (calendar-hebrew-from-absolute d)))
-         (diff (- yr h-year))
-         (y (hebrew-calendar-yahrzeit h-date yr)))
-    (if (and (> diff 0) (or (= y d) (= y (1+ d))))
-        (format "Yahrzeit of %s%s: %d%s anniversary"
-                entry
-                (if (= y d) "" " (evening)")
-                diff
-                (cond ((= (% diff 10) 1) "st")
-                      ((= (% diff 10) 2) "nd")
-                      ((= (% diff 10) 3) "rd")
-                      (t "th"))))))
-
-(defun diary-rosh-hodesh ()
-  "Rosh Hodesh diary entry.
-Entry applies if date is Rosh Hodesh, the day before, or the Saturday before."
-  (let* ((d (calendar-absolute-from-gregorian date))
-         (h-date (calendar-hebrew-from-absolute d))
-         (h-month (extract-calendar-month h-date))
-         (h-day (extract-calendar-day h-date))
-         (h-year (extract-calendar-year h-date))
-         (leap-year (hebrew-calendar-leap-year-p h-year))
-         (last-day (hebrew-calendar-last-day-of-month h-month h-year))
-         (h-month-names
-          (if leap-year
-              calendar-hebrew-month-name-array-leap-year
-            calendar-hebrew-month-name-array-common-year))
-         (this-month (aref h-month-names (1- h-month)))
-         (h-yesterday (extract-calendar-day
-                       (calendar-hebrew-from-absolute (1- d)))))
-    (if (or (= h-day 30) (and (= h-day 1) (/= h-month 7)))
-        (format
-         "Rosh Hodesh %s"
-         (if (= h-day 30)
-             (format
-              "%s (first day)"
-              ;; next month must be in the same year since this
-              ;; month can't be the last month of the year since
-              ;; it has 30 days
-              (aref h-month-names h-month))
-           (if (= h-yesterday 30)
-               (format "%s (second day)" this-month)
-             this-month)))
-      (if (= (% d 7) 6);; Saturday--check for Shabbat Mevarhim
-          (cond ((and (> h-day 22) (/= h-month 6) (= 29 last-day))
-                 (format "Mevarhim Rosh Hodesh %s (%s)"
-                         (aref h-month-names
-                               (if (= h-month
-                                      (hebrew-calendar-last-month-of-year
-                                       h-year))
-                                   0 h-month))
-                         (aref calendar-day-name-array (- 29 h-day))))
-                ((and (< h-day 30) (> h-day 22) (= 30 last-day))
-                 (format "Mevarhim Rosh Hodesh %s (%s-%s)"
-                         (aref h-month-names h-month)
-                         (if (= h-day 29)
-                             "tomorrow"
-                           (aref calendar-day-name-array (- 29 h-day)))
-                         (aref calendar-day-name-array
-                               (% (- 30 h-day) 7)))))
-        (if (and (= h-day 29) (/= h-month 6))
-            (format "Erev Rosh Hodesh %s"
-                    (aref h-month-names
-                          (if (= h-month
-                                 (hebrew-calendar-last-month-of-year
-                                  h-year))
-                              0 h-month))))))))
-
-(defun diary-parasha ()
-  "Parasha diary entry--entry applies if date is a Saturday."
-  (let ((d (calendar-absolute-from-gregorian date)))
-    (if (= (% d 7) 6);;  Saturday
-        (let*
-            ((h-year (extract-calendar-year
-                      (calendar-hebrew-from-absolute d)))
-             (rosh-hashanah
-              (calendar-absolute-from-hebrew (list 7 1 h-year)))
-             (passover
-              (calendar-absolute-from-hebrew (list 1 15 h-year)))
-             (rosh-hashanah-day
-              (aref calendar-day-name-array (% rosh-hashanah 7)))
-             (passover-day
-              (aref calendar-day-name-array (% passover 7)))
-             (long-h (hebrew-calendar-long-heshvan-p h-year))
-             (short-k (hebrew-calendar-short-kislev-p h-year))
-             (type (cond ((and long-h (not short-k)) "complete")
-                         ((and (not long-h) short-k) "incomplete")
-                         (t "regular")))
-             (year-format
-              (symbol-value
-               (intern (format "hebrew-calendar-year-%s-%s-%s";; keviah
-                               rosh-hashanah-day type passover-day))))
-             (first-saturday;; of Hebrew year
-              (calendar-dayname-on-or-before 6 (+ 6 rosh-hashanah)))
-             (saturday;; which Saturday of the Hebrew year
-              (/ (- d first-saturday) 7))
-             (parasha (aref year-format saturday)))
-          (if parasha
-              (format
-               "Parashat %s"
-               (if (listp parasha);; Israel differs from diaspora
-                   (if (car parasha)
-                       (format "%s (diaspora), %s (Israel)"
-                               (hebrew-calendar-parasha-name (car parasha))
-                               (hebrew-calendar-parasha-name (cdr parasha)))
-                     (format "%s (Israel)"
-                             (hebrew-calendar-parasha-name (cdr parasha))))
-                 (hebrew-calendar-parasha-name parasha))))))))
-
-(defvar hebrew-calendar-parashiot-names
-["Bereshith"   "Noah"      "Lech L'cha" "Vayera"    "Hayei Sarah" "Toledoth"
- "Vayetze"     "Vayishlah" "Vayeshev"   "Mikketz"   "Vayiggash"   "Vayhi"
- "Shemoth"     "Vaera"     "Bo"         "Beshallah" "Yithro"      "Mishpatim"
- "Terumah"     "Tetzavveh" "Ki Tissa"   "Vayakhel"  "Pekudei"     "Vayikra"
- "Tzav"        "Shemini"   "Tazria"     "Metzora"   "Aharei Moth" "Kedoshim"
- "Emor"        "Behar"     "Behukkotai" "Bemidbar"  "Naso"       "Behaalot'cha"
- "Shelah L'cha" "Korah"    "Hukkath"    "Balak"     "Pinhas"      "Mattoth"
- "Masei"       "Devarim"   "Vaethanan"  "Ekev"      "Reeh"        "Shofetim"
- "Ki Tetze"    "Ki Tavo"   "Nitzavim"   "Vayelech"  "Haazinu"]
-  "The names of the parashiot in the Torah.")
-
-;; The seven ordinary year types (keviot)
-
-(defconst hebrew-calendar-year-Saturday-incomplete-Sunday
-  [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
-    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
-    43 44 45 46 47 48 49 50]
-  "The structure of the parashiot.
-Hebrew year starts on Saturday, is `incomplete' (Heshvan and Kislev each have
-29 days), and has Passover start on Sunday.")
-
-(defconst hebrew-calendar-year-Saturday-complete-Tuesday
-  [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
-    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
-    43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
-have 30 days), and has Passover start on Tuesday.")
-
-(defconst hebrew-calendar-year-Monday-incomplete-Tuesday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
-    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
-    43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
-have 29 days), and has Passover start on Tuesday.")
-
-(defconst hebrew-calendar-year-Monday-complete-Thursday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
-   23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
-   (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
-30 days), and has Passover start on Thursday.")
-
-(defconst hebrew-calendar-year-Tuesday-regular-Thursday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22]
-   23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 (nil . 34) (34 . 35) (35 . 36)
-   (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
-Kislev has 30 days), and has Passover start on Thursday.")
-
-(defconst hebrew-calendar-year-Thursday-regular-Saturday
-  [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 [21 22] 23
-   24 nil (nil . 25) (25 . [26 27]) ([26 27] . [28 29]) ([28 29] . 30)
-   (30 . 31) ([31 32] . 32) 33 34 35 36 37 38 39 40 [41 42] 43 44 45 46 47 48
-   49 50]
-  "The structure of the parashiot.
-Hebrew year that starts on Thursday, is `regular' (Heshvan has 29 days and
-Kislev has 30 days), and has Passover start on Saturday.")
-
-(defconst hebrew-calendar-year-Thursday-complete-Sunday
-  [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-    23 24 nil 25 [26 27] [28 29] 30 [31 32] 33 34 35 36 37 38 39 40 [41 42]
-    43 44 45 46 47 48 49 50]
-  "The structure of the parashiot.
-Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev each
-have 30 days), and has Passover start on Sunday.")
-
-;; The seven leap year types (keviot)
-
-(defconst hebrew-calendar-year-Saturday-incomplete-Tuesday
-  [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-    23 24 25 26 27 nil 28 29 30 31 32 33 34 35 36 37 38 39 40 [41 42]
-    43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Saturday, is `incomplete' (Heshvan and Kislev each
-have 29 days), and has Passover start on Tuesday.")
-
-(defconst hebrew-calendar-year-Saturday-complete-Thursday
-  [nil 52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-   23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
-   (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Saturday, is `complete' (Heshvan and Kislev each
-have 30 days), and has Passover start on Thursday.")
-
-(defconst hebrew-calendar-year-Monday-incomplete-Thursday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-   23 24 25 26 27 nil 28 29 30 31 32 33 (nil . 34) (34 . 35) (35 . 36)
-   (36 . 37) (37 . 38) ([38 39] . 39) 40 [41 42] 43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Monday, is `incomplete' (Heshvan and Kislev each
-have 29 days), and has Passover start on Thursday.")
-
-(defconst hebrew-calendar-year-Monday-complete-Saturday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-   23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
-   (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
-   (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
-  "The structure of the parashiot.
-Hebrew year that starts on Monday, is `complete' (Heshvan and Kislev each have
-30 days), and has Passover start on Saturday.")
-
-(defconst hebrew-calendar-year-Tuesday-regular-Saturday
-  [51 52 nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-   23 24 25 26 27 nil (nil . 28) (28 . 29) (29 . 30) (30 . 31) (31 . 32)
-   (32 . 33) (33 . 34) (34 . 35) (35 . 36) (36 . 37) (37 . 38) (38 . 39)
-   (39 . 40) (40 . 41) ([41 42] . 42) 43 44 45 46 47 48 49 50]
-  "The structure of the parashiot.
-Hebrew year that starts on Tuesday, is `regular' (Heshvan has 29 days and
-Kislev has 30 days), and has Passover start on Saturday.")
-
-(defconst hebrew-calendar-year-Thursday-incomplete-Sunday
-  [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-    23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
-    43 44 45 46 47 48 49 50]
-  "The structure of the parashiot.
-Hebrew year that starts on Thursday, is `incomplete' (Heshvan and Kislev both
-have 29 days), and has Passover start on Sunday.")
-
-(defconst hebrew-calendar-year-Thursday-complete-Tuesday
-  [52 nil nil 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22
-    23 24 25 26 27 28 nil 29 30 31 32 33 34 35 36 37 38 39 40 41 42
-    43 44 45 46 47 48 49 [50 51]]
-  "The structure of the parashiot.
-Hebrew year that starts on Thursday, is `complete' (Heshvan and Kislev both
-have 30 days), and has Passover start on Tuesday.")
-
-(defun hebrew-calendar-parasha-name (p)
-  "Name(s) corresponding to parasha P."
-  (if (arrayp p);; combined parasha
-      (format "%s/%s"
-              (aref hebrew-calendar-parashiot-names (aref p 0))
-              (aref hebrew-calendar-parashiot-names (aref p 1)))
-    (aref hebrew-calendar-parashiot-names p)))
-
-(provide 'cal-hebrew)
-
-;;; cal-hebrew.el ends here
diff --git a/lisp/calendar/cal-islam.el b/lisp/calendar/cal-islam.el
deleted file mode 100644
index a8e038e52eb..00000000000
--- a/lisp/calendar/cal-islam.el
+++ /dev/null
@@ -1,492 +0,0 @@
-;;; cal-islam.el --- calendar functions for the Islamic calendar.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: Islamic calendar, calendar, diary
-
-;; 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 collection of functions implements the features of calendar.el and
-;; diary.el that deal with the Islamic calendar.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'cal-julian)
-
-(defvar calendar-islamic-month-name-array
-  ["Muharram" "Safar" "Rabi I" "Rabi II" "Jumada I" "Jumada II"
-   "Rajab" "Sha'ban" "Ramadan" "Shawwal" "Dhu al-Qada" "Dhu al-Hijjah"])
-
-(defvar calendar-islamic-epoch (calendar-absolute-from-julian '(7 16 622))
-  "Absolute date of start of Islamic calendar = August 29, 284 A.D. (Julian).")
-
-(defun islamic-calendar-leap-year-p (year)
-  "Returns t if YEAR is a leap year on the Islamic calendar."
-  (memq (% year 30)
-        (list 2 5 7 10 13 16 18 21 24 26 29)))
-
-(defun islamic-calendar-last-day-of-month (month year)
-  "The last day in MONTH during YEAR on the Islamic calendar."
-  (cond
-   ((memq month (list 1 3 5 7 9 11)) 30)
-   ((memq month (list 2 4 6 8 10)) 29)
-   (t (if (islamic-calendar-leap-year-p year) 30 29))))
-
-(defun islamic-calendar-day-number (date)
-  "Return the day number within the year of the Islamic date DATE."
-    (let* ((month (extract-calendar-month date))
-           (day (extract-calendar-day date)))
-      (+ (* 30 (/ month 2))
-         (* 29 (/ (1- month) 2))
-         day)))
-
-(defun calendar-absolute-from-islamic (date)
-  "Absolute date of Islamic DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let* ((month (extract-calendar-month date))
-         (day (extract-calendar-day date))
-         (year (extract-calendar-year date))
-         (y (% year 30))
-         (leap-years-in-cycle
-          (cond
-           ((< y 3) 0)  ((< y 6) 1)  ((< y 8) 2)  ((< y 11) 3) ((< y 14) 4)
-           ((< y 17) 5) ((< y 19) 6) ((< y 22) 7) ((< y 25) 8) ((< y 27) 9)
-           (t 10))))
-    (+ (islamic-calendar-day-number date);; days so far this year
-       (* (1- year) 354)                 ;; days in all non-leap years
-       (* 11 (/ year 30))                ;; leap days in complete cycles
-       leap-years-in-cycle               ;; leap days this cycle
-       (1- calendar-islamic-epoch))))    ;; days before start of calendar
-
-(defun calendar-islamic-from-absolute (date)
-  "Compute the Islamic date (month day year) corresponding to absolute DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (if (< date calendar-islamic-epoch)
-      (list 0 0 0);; pre-Islamic date
-    (let* ((approx (/ (- date calendar-islamic-epoch)
-                      355));; Approximation from below.
-           (year           ;; Search forward from the approximation.
-            (+ approx
-               (calendar-sum y approx
-                             (>= date (calendar-absolute-from-islamic
-                                       (list 1 1 (1+ y))))
-                             1)))
-           (month          ;; Search forward from Muharram.
-            (1+ (calendar-sum m 1
-                              (> date
-                                 (calendar-absolute-from-islamic
-                                  (list m
-                                        (islamic-calendar-last-day-of-month
-                                         m year)
-                                        year)))
-                              1)))
-           (day            ;; Calculate the day by subtraction.
-            (- date
-               (1- (calendar-absolute-from-islamic (list month 1 year))))))
-      (list month day year))))
-
-(defun calendar-islamic-date-string (&optional date)
-  "String of Islamic date before sunset of Gregorian DATE.
-Returns the empty string if DATE is pre-Islamic.
-Defaults to today's date if DATE is not given.
-Driven by the variable `calendar-date-display-form'."
-  (let ((calendar-month-name-array calendar-islamic-month-name-array)
-        (islamic-date (calendar-islamic-from-absolute
-                       (calendar-absolute-from-gregorian
-                        (or date (calendar-current-date))))))
-    (if (< (extract-calendar-year islamic-date) 1)
-        ""
-      (calendar-date-string islamic-date nil t))))
-
-(defun calendar-print-islamic-date ()
-  "Show the Islamic calendar equivalent of the date under the cursor."
-  (interactive)
-  (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t))))
-    (if (string-equal i "")
-        (message "Date is pre-Islamic")
-      (message "Islamic date (until sunset): %s" i))))
-
-(defun calendar-goto-islamic-date (date &optional noecho)
-  "Move cursor to Islamic DATE; echo Islamic date unless NOECHO is t."
-  (interactive
-   (let* ((today (calendar-current-date))
-          (year (calendar-read
-                 "Islamic calendar year (>0): "
-                 '(lambda (x) (> x 0))
-                 (int-to-string
-                  (extract-calendar-year
-                   (calendar-islamic-from-absolute
-                    (calendar-absolute-from-gregorian today))))))
-          (month-array calendar-islamic-month-name-array)
-          (completion-ignore-case t)
-          (month (cdr (assoc
-                       (capitalize
-                        (completing-read
-                         "Islamic calendar month name: "
-                         (mapcar 'list (append month-array nil))
-                         nil t))
-                       (calendar-make-alist month-array 1 'capitalize))))
-          (last (islamic-calendar-last-day-of-month month year))
-          (day (calendar-read
-                (format "Islamic calendar day (1-%d): " last)
-                '(lambda (x) (and (< 0 x) (<= x last))))))
-     (list (list month day year))))
-  (calendar-goto-date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-islamic date)))
-  (or noecho (calendar-print-islamic-date)))
-
-(defun diary-islamic-date ()
-  "Islamic calendar equivalent of date diary entry."
-  (let ((i (calendar-islamic-date-string (calendar-cursor-to-date t))))
-    (if (string-equal i "")
-        "Date is pre-Islamic"
-      (format "Islamic date (until sunset): %s" i))))
-
-(defun holiday-islamic (month day string)
-  "Holiday on MONTH, DAY (Islamic) called STRING.
-If MONTH, DAY (Islamic) is visible, the value returned is corresponding
-Gregorian date in the form of the list (((month day year) STRING)).  Returns
-nil if it is not visible in the current calendar window."
-  (let* ((islamic-date (calendar-islamic-from-absolute
-                        (calendar-absolute-from-gregorian
-                         (list displayed-month 15 displayed-year))))
-         (m (extract-calendar-month islamic-date))
-         (y (extract-calendar-year islamic-date))
-        (date))
-    (if (< m 1)
-        nil;;   Islamic calendar doesn't apply.
-      (increment-calendar-month m y (- 10 month))
-      (if (> m 7);;  Islamic date might be visible
-          (let ((date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-islamic (list month day y)))))
-            (if (calendar-date-is-visible-p date)
-                (list (list date string))))))))
-
-(defun list-islamic-diary-entries ()
-  "Add any Islamic date entries from the diary file to `diary-entries-list'.
-Islamic date diary entries must be prefaced by an `islamic-diary-entry-symbol'
-\(normally an `I').  The same diary date forms govern the style of the Islamic
-calendar entries, except that the Islamic month names must be spelled in full.
-The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
-Dhu al-Hijjah.  If an Islamic date diary entry begins with a
-`diary-nonmarking-symbol', the entry will appear in the diary listing, but will
-not be marked in the calendar.  This function is provided for use with the
-`nongregorian-diary-listing-hook'."
-  (if (< 0 number)
-      (let ((buffer-read-only nil)
-            (diary-modified (buffer-modified-p))
-            (gdate original-date)
-            (mark (regexp-quote diary-nonmarking-symbol)))
-        (calendar-for-loop i from 1 to number do
-           (let* ((d diary-date-forms)
-                  (idate (calendar-islamic-from-absolute 
-                          (calendar-absolute-from-gregorian gdate)))
-                  (month (extract-calendar-month idate))
-                  (day (extract-calendar-day idate))
-                  (year (extract-calendar-year idate)))
-             (while d
-               (let*
-                   ((date-form (if (equal (car (car d)) 'backup)
-                                   (cdr (car d))
-                                 (car d)))
-                    (backup (equal (car (car d)) 'backup))
-                    (dayname
-                     (concat
-                      (calendar-day-name gdate) "\\|"
-                      (substring (calendar-day-name gdate) 0 3) ".?"))
-                    (calendar-month-name-array
-                     calendar-islamic-month-name-array)
-                    (monthname
-                     (concat
-                      "\\*\\|"
-                      (calendar-month-name month)))
-                    (month (concat "\\*\\|0*" (int-to-string month)))
-                    (day (concat "\\*\\|0*" (int-to-string day)))
-                    (year
-                     (concat
-                      "\\*\\|0*" (int-to-string year)
-                      (if abbreviated-calendar-year
-                          (concat "\\|" (int-to-string (% year 100)))
-                        "")))
-                    (regexp
-                     (concat
-                      "\\(\\`\\|\^M\\|\n\\)" mark "?"
-                      (regexp-quote islamic-diary-entry-symbol)
-                      "\\("
-                      (mapconcat 'eval date-form "\\)\\(")
-                      "\\)"))
-                    (case-fold-search t))
-                 (goto-char (point-min))
-                 (while (re-search-forward regexp nil t)
-                   (if backup (re-search-backward "\\<" nil t))
-                   (if (and (or (char-equal (preceding-char) ?\^M)
-                                (char-equal (preceding-char) ?\n))
-                            (not (looking-at " \\|\^I")))
-                       ;;  Diary entry that consists only of date.
-                       (backward-char 1)
-                     ;;  Found a nonempty diary entry--make it visible and
-                     ;;  add it to the list.
-                     (let ((entry-start (point))
-                           (date-start))
-                       (re-search-backward "\^M\\|\n\\|\\`")
-                       (setq date-start (point))
-                       (re-search-forward "\^M\\|\n" nil t 2)
-                       (while (looking-at " \\|\^I")
-                         (re-search-forward "\^M\\|\n" nil t))
-                       (backward-char 1)
-                       (subst-char-in-region date-start (point) ?\^M ?\n t)
-                       (add-to-diary-list
-                         gdate (buffer-substring entry-start (point)))))))
-               (setq d (cdr d))))
-           (setq gdate
-                 (calendar-gregorian-from-absolute
-                  (1+ (calendar-absolute-from-gregorian gdate)))))
-           (set-buffer-modified-p diary-modified))
-        (goto-char (point-min))))
-
-(defun mark-islamic-diary-entries ()
-  "Mark days in the calendar window that have Islamic date diary entries.
-Each entry in diary-file (or included files) visible in the calendar window
-is marked.  Islamic date entries are prefaced by a islamic-diary-entry-symbol
-\(normally an `I').  The same diary-date-forms govern the style of the Islamic
-calendar entries, except that the Islamic month names must be spelled in full.
-The Islamic months are numbered from 1 to 12 with Muharram being 1 and 12 being
-Dhu al-Hijjah.  Islamic date diary entries that begin with a
-diary-nonmarking-symbol will not be marked in the calendar.  This function is
-provided for use as part of the nongregorian-diary-marking-hook."
-  (let ((d diary-date-forms))
-    (while d
-      (let*
-          ((date-form (if (equal (car (car d)) 'backup)
-                          (cdr (car d))
-                        (car d)));; ignore 'backup directive
-           (dayname (diary-name-pattern calendar-day-name-array))
-           (monthname
-            (concat
-             (diary-name-pattern calendar-islamic-month-name-array t)
-             "\\|\\*"))
-           (month "[0-9]+\\|\\*")
-           (day "[0-9]+\\|\\*")
-           (year "[0-9]+\\|\\*")
-           (l (length date-form))
-           (d-name-pos (- l (length (memq 'dayname date-form))))
-           (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
-           (m-name-pos (- l (length (memq 'monthname date-form))))
-           (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
-           (d-pos (- l (length (memq 'day date-form))))
-           (d-pos (if (/= l d-pos) (+ 2 d-pos)))
-           (m-pos (- l (length (memq 'month date-form))))
-           (m-pos (if (/= l m-pos) (+ 2 m-pos)))
-           (y-pos (- l (length (memq 'year date-form))))
-           (y-pos (if (/= l y-pos) (+ 2 y-pos)))
-           (regexp
-            (concat
-             "\\(\\`\\|\^M\\|\n\\)"
-             (regexp-quote islamic-diary-entry-symbol)
-             "\\("
-             (mapconcat 'eval date-form "\\)\\(")
-             "\\)"))
-           (case-fold-search t))
-        (goto-char (point-min))
-        (while (re-search-forward regexp nil t)
-          (let* ((dd-name
-                  (if d-name-pos
-                      (buffer-substring
-                       (match-beginning d-name-pos)
-                       (match-end d-name-pos))))
-                 (mm-name
-                  (if m-name-pos
-                      (buffer-substring
-                       (match-beginning m-name-pos)
-                       (match-end m-name-pos))))
-                 (mm (string-to-int
-                      (if m-pos
-                          (buffer-substring
-                           (match-beginning m-pos)
-                           (match-end m-pos))
-                        "")))
-                 (dd (string-to-int
-                      (if d-pos
-                          (buffer-substring
-                           (match-beginning d-pos)
-                           (match-end d-pos))
-                        "")))
-                 (y-str (if y-pos
-                            (buffer-substring
-                             (match-beginning y-pos)
-                             (match-end y-pos))))
-                 (yy (if (not y-str)
-                         0
-                       (if (and (= (length y-str) 2)
-                                abbreviated-calendar-year)
-                           (let* ((current-y
-                                   (extract-calendar-year
-                                    (calendar-islamic-from-absolute
-                                     (calendar-absolute-from-gregorian
-                                      (calendar-current-date)))))
-                                  (y (+ (string-to-int y-str)
-                                        (* 100 (/ current-y 100)))))
-                             (if (> (- y current-y) 50)
-                                 (- y 100)
-                               (if (> (- current-y y) 50)
-                                   (+ y 100)
-                                 y)))
-                         (string-to-int y-str)))))
-            (if dd-name
-                (mark-calendar-days-named
-                 (cdr (assoc (capitalize (substring dd-name 0 3))
-                             (calendar-make-alist
-                               calendar-day-name-array
-                               0
-                               '(lambda (x) (substring x 0 3))))))
-              (if mm-name
-                  (if (string-equal mm-name "*")
-                      (setq mm 0)
-                    (setq mm
-                          (cdr (assoc
-                                (capitalize mm-name)
-                                (calendar-make-alist
-                                  calendar-islamic-month-name-array))))))
-              (mark-islamic-calendar-date-pattern mm dd yy)))))
-      (setq d (cdr d)))))
-
-(defun mark-islamic-calendar-date-pattern (month day year)
-  "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR.
-A value of 0 in any position is a wildcard."
-  (save-excursion
-    (set-buffer calendar-buffer)
-    (if (and (/= 0 month) (/= 0 day))
-        (if (/= 0 year)
-            ;; Fully specified Islamic date.
-            (let ((date (calendar-gregorian-from-absolute
-                         (calendar-absolute-from-islamic
-                          (list month day year)))))
-              (if (calendar-date-is-visible-p date)
-                  (mark-visible-calendar-date date)))
-          ;; Month and day in any year--this taken from the holiday stuff.
-          (let* ((islamic-date (calendar-islamic-from-absolute
-                                (calendar-absolute-from-gregorian
-                                 (list displayed-month 15 displayed-year))))
-                 (m (extract-calendar-month islamic-date))
-                 (y (extract-calendar-year islamic-date))
-                 (date))
-            (if (< m 1)
-                nil;;   Islamic calendar doesn't apply.
-              (increment-calendar-month m y (- 10 month))
-              (if (> m 7);;  Islamic date might be visible
-                  (let ((date (calendar-gregorian-from-absolute
-                               (calendar-absolute-from-islamic
-                                (list month day y)))))
-                    (if (calendar-date-is-visible-p date)
-                        (mark-visible-calendar-date date)))))))
-      ;; Not one of the simple cases--check all visible dates for match.
-      ;; Actually, the following code takes care of ALL of the cases, but
-      ;; it's much too slow to be used for the simple (common) cases.
-      (let ((m displayed-month)
-            (y displayed-year)
-            (first-date)
-            (last-date))
-        (increment-calendar-month m y -1)
-        (setq first-date
-              (calendar-absolute-from-gregorian
-               (list m 1 y)))
-        (increment-calendar-month m y 2)
-        (setq last-date
-              (calendar-absolute-from-gregorian
-               (list m (calendar-last-day-of-month m y) y)))
-        (calendar-for-loop date from first-date to last-date do
-          (let* ((i-date (calendar-islamic-from-absolute date))
-                 (i-month (extract-calendar-month i-date))
-                 (i-day (extract-calendar-day i-date))
-                 (i-year (extract-calendar-year i-date)))
-            (and (or (zerop month)
-                     (= month i-month))
-                 (or (zerop day)
-                     (= day i-day))
-                 (or (zerop year)
-                     (= year i-year))
-                 (mark-visible-calendar-date
-                  (calendar-gregorian-from-absolute date)))))))))
-
-(defun insert-islamic-diary-entry (arg)
-  "Insert a diary entry.
-For the Islamic date corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-month-name-array calendar-islamic-month-name-array))
-    (make-diary-entry
-     (concat
-      islamic-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-islamic-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))
-       nil t))
-     arg)))
-
-(defun insert-monthly-islamic-diary-entry (arg)
-  "Insert a monthly diary entry.
-For the day of the Islamic month corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style '(day " * ") '("* " day )))
-         (calendar-month-name-array calendar-islamic-month-name-array))
-    (make-diary-entry
-     (concat
-      islamic-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-islamic-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
-     arg)))
-
-(defun insert-yearly-islamic-diary-entry (arg)
-  "Insert an annual diary entry.
-For the day of the Islamic year corresponding to the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " monthname)
-            '(monthname " " day)))
-         (calendar-month-name-array calendar-islamic-month-name-array))
-    (make-diary-entry
-     (concat
-      islamic-diary-entry-symbol
-      (calendar-date-string 
-       (calendar-islamic-from-absolute
-        (calendar-absolute-from-gregorian
-         (calendar-cursor-to-date t)))))
-     arg)))
-
-(provide 'cal-islam)
-
-;;; cal-islam.el ends here
diff --git a/lisp/calendar/cal-iso.el b/lisp/calendar/cal-iso.el
deleted file mode 100644
index 130f5bc97d8..00000000000
--- a/lisp/calendar/cal-iso.el
+++ /dev/null
@@ -1,126 +0,0 @@
-;;; cal-iso.el --- calendar functions for the ISO calendar.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: ISO calendar, calendar, diary
-
-;; 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 collection of functions implements the features of calendar.el and
-;; diary.el that deal with the ISO calendar.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'calendar)
-
-(defun calendar-absolute-from-iso (date)
-  "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
-The `ISO year' corresponds approximately to the Gregorian year, but
-weeks start on Monday and end on Sunday.  The first week of the ISO year is
-the first such week in which at least 4 days are in a year.  The ISO
-commercial DATE has the form (week day year) in which week is in the range
-1..52 and day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 =
-Sunday).  The Gregorian date Sunday, December 31, 1 BC is imaginary."
-  (let* ((week (extract-calendar-month date))
-         (day (extract-calendar-day date))
-         (year (extract-calendar-year date)))
-    (+ (calendar-dayname-on-or-before
-        1 (+ 3 (calendar-absolute-from-gregorian (list 1 1 year))))
-       (* 7 (1- week))
-       (if (= day 0) 6 (1- day)))))
-
-(defun calendar-iso-from-absolute (date)
-  "Compute the `ISO commercial date' corresponding to the absolute DATE.
-The ISO year corresponds approximately to the Gregorian year, but weeks
-start on Monday and end on Sunday.  The first week of the ISO year is the
-first such week in which at least 4 days are in a year.  The ISO commercial
-date has the form (week day year) in which week is in the range 1..52 and
-day is in the range 0..6 (1 = Monday, 2 = Tuesday, ..., 0 = Sunday).  The
-absolute date is the number of days elapsed since the (imaginary) Gregorian
-date Sunday, December 31, 1 BC."
-  (let* ((approx (extract-calendar-year
-                  (calendar-gregorian-from-absolute (- date 3))))
-         (year (+ approx
-                  (calendar-sum y approx
-                      (>= date (calendar-absolute-from-iso (list 1 1 (1+ y))))
-                      1))))
-    (list
-     (1+ (/ (- date (calendar-absolute-from-iso (list 1 1 year))) 7))
-     (% date 7)
-     year)))
-
-(defun calendar-iso-date-string (&optional date)
-  "String of ISO date of Gregorian DATE.
-Defaults to today's date if DATE is not given."
-  (let* ((d (calendar-absolute-from-gregorian 
-             (or date (calendar-current-date))))
-         (day (% d 7))
-         (iso-date (calendar-iso-from-absolute d)))
-    (format "Day %s of week %d of %d"
-            (if (zerop day) 7 day)
-            (extract-calendar-month iso-date)
-            (extract-calendar-year iso-date))))
-
-(defun calendar-print-iso-date ()
-  "Show equivalent ISO date for the date under the cursor."
-  (interactive)
-  (message "ISO date: %s"
-           (calendar-iso-date-string (calendar-cursor-to-date t))))
-
-(defun calendar-goto-iso-date (date &optional noecho)
-  "Move cursor to ISO DATE; echo ISO date unless NOECHO is t."
-  (interactive
-   (let* ((today (calendar-current-date))
-          (year (calendar-read
-                 "ISO calendar year (>0): "
-                 '(lambda (x) (> x 0))
-                 (int-to-string (extract-calendar-year today))))
-          (no-weeks (extract-calendar-month
-                     (calendar-iso-from-absolute
-                      (1-
-                       (calendar-dayname-on-or-before
-                        1 (calendar-absolute-from-gregorian
-                           (list 1 4 (1+ year))))))))
-          (week (calendar-read
-                 (format "ISO calendar week (1-%d): " no-weeks)
-                 '(lambda (x) (and (> x 0) (<= x no-weeks)))))
-          (day (calendar-read
-                "ISO day (1-7): "
-                '(lambda (x) (and (<= 1 x) (<= x 7))))))
-     (list (list week day year))))
-  (calendar-goto-date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-iso date)))
-  (or noecho (calendar-print-iso-date)))
-
-(defun diary-iso-date ()
-  "ISO calendar equivalent of date diary entry."
-  (format "ISO date: %s" (calendar-iso-date-string date)))
-
-(provide 'cal-iso)
-
-;;; cal-iso.el ends here
diff --git a/lisp/calendar/cal-julian.el b/lisp/calendar/cal-julian.el
deleted file mode 100644
index 4437789e7fe..00000000000
--- a/lisp/calendar/cal-julian.el
+++ /dev/null
@@ -1,207 +0,0 @@
-;;; cal-julian.el --- calendar functions for the Julian calendar.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: Julian calendar, Julian day number, calendar, diary
-
-;; 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 collection of functions implements the features of calendar.el and
-;; diary.el that deal with the Julian calendar.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'calendar)
-
-(defun calendar-julian-from-absolute (date)
-  "Compute the Julian (month day year) corresponding to the absolute DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let* ((approx (/ (+ date 2) 366));; Approximation from below.
-         (year        ;; Search forward from the approximation.
-          (+ approx
-             (calendar-sum y approx
-                (>= date (calendar-absolute-from-julian (list 1 1 (1+ y))))
-                1)))
-         (month       ;; Search forward from January.
-          (1+ (calendar-sum m 1
-                 (> date
-                    (calendar-absolute-from-julian
-                     (list m
-                           (if (and (= m 2) (= (% year 4) 0))
-                               29
-                             (aref [31 28 31 30 31 30 31 31 30 31 30 31]
-                                   (1- m)))
-                           year)))
-                 1)))
-         (day         ;; Calculate the day by subtraction.
-          (- date (1- (calendar-absolute-from-julian (list month 1 year))))))
-    (list month day year)))
-
-(defun calendar-absolute-from-julian (date)
-  "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
-The Gregorian date Sunday, December 31, 1 BC is imaginary."
-  (let ((month (extract-calendar-month date))
-        (day (extract-calendar-day date))
-        (year (extract-calendar-year date)))
-    (+ (calendar-day-number date)
-       (if (and (= (% year 100) 0)
-                (/= (% year 400) 0)
-                (> month 2))
-           1 0);; Correct for Julian but not Gregorian leap year.
-       (* 365 (1- year))
-       (/ (1- year) 4)
-       -2)))
-
-(defun calendar-julian-date-string (&optional date)
-  "String of Julian date of Gregorian DATE.
-Defaults to today's date if DATE is not given.
-Driven by the variable `calendar-date-display-form'."
-  (calendar-date-string
-   (calendar-julian-from-absolute
-    (calendar-absolute-from-gregorian
-     (or date (calendar-current-date))))
-   nil t))
-
-(defun calendar-print-julian-date ()
-  "Show the Julian calendar equivalent of the date under the cursor."
-  (interactive)
-  (message "Julian date: %s"
-           (calendar-julian-date-string (calendar-cursor-to-date t))))
-
-(defun calendar-goto-julian-date (date &optional noecho)
-  "Move cursor to Julian DATE; echo Julian date unless NOECHO is t."
-  (interactive
-   (let* ((today (calendar-current-date))
-          (year (calendar-read
-                 "Julian calendar year (>0): "
-                 '(lambda (x) (> x 0))
-                 (int-to-string
-                  (extract-calendar-year
-                   (calendar-julian-from-absolute
-                    (calendar-absolute-from-gregorian
-                     today))))))
-          (month-array calendar-month-name-array)
-          (completion-ignore-case t)
-          (month (cdr (assoc
-                       (capitalize
-                        (completing-read
-                         "Julian calendar month name: "
-                         (mapcar 'list (append month-array nil))
-                         nil t))
-                       (calendar-make-alist month-array 1 'capitalize))))
-          (last 
-           (if (and (zerop (% year 4)) (= month 2))
-               29
-             (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
-          (day (calendar-read
-                (format "Julian calendar day (%d-%d): "
-                        (if (and (= year 1) (= month 1)) 3 1) last)
-                '(lambda (x) 
-                   (and (< (if (and (= year 1) (= month 1)) 2 0) x)
-                        (<= x last))))))
-     (list (list month day year))))
-  (calendar-goto-date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-julian date)))
-  (or noecho (calendar-print-julian-date)))
-
-(defun holiday-julian (month day string)
-  "Holiday on MONTH, DAY  (Julian) called STRING.
-If MONTH, DAY (Julian) is visible, the value returned is corresponding
-Gregorian date in the form of the list (((month day year) STRING)).  Returns
-nil if it is not visible in the current calendar window."
-  (let ((m1 displayed-month)
-        (y1 displayed-year)
-        (m2 displayed-month)
-        (y2 displayed-year)
-        (year))
-    (increment-calendar-month m1 y1 -1)
-    (increment-calendar-month m2 y2 1)
-    (let* ((start-date (calendar-absolute-from-gregorian
-                        (list m1 1 y1)))
-           (end-date (calendar-absolute-from-gregorian
-                      (list m2 (calendar-last-day-of-month m2 y2) y2)))
-           (julian-start (calendar-julian-from-absolute start-date))
-           (julian-end (calendar-julian-from-absolute end-date))
-           (julian-y1 (extract-calendar-year julian-start))
-           (julian-y2 (extract-calendar-year julian-end)))
-      (setq year (if (< 10 month) julian-y1 julian-y2))
-      (let ((date (calendar-gregorian-from-absolute
-                   (calendar-absolute-from-julian
-                    (list month day year)))))
-        (if (calendar-date-is-visible-p date)
-            (list (list date string)))))))
-
-(defun diary-julian-date ()
-  "Julian calendar equivalent of date diary entry."
-  (format "Julian date: %s" (calendar-julian-date-string date)))
-
-(defun calendar-absolute-from-astro (d)
-  "Absolute date of astronomical (Julian) day number D."
-  (- d 1721424.5))
-
-(defun calendar-astro-from-absolute (d)
-  "Astronomical (Julian) day number of absolute date D."
-  (+ d 1721424.5))
-
-(defun calendar-astro-date-string (&optional date)
-  "String of astronomical (Julian) day number after noon UTC of Gregorian DATE.
-Defaults to today's date if DATE is not given."
-  (int-to-string
-   (ceiling
-    (calendar-astro-from-absolute
-     (calendar-absolute-from-gregorian
-      (or date (calendar-current-date)))))))
-
-(defun calendar-print-astro-day-number ()
-  "Show astronomical (Julian) day number after noon UTC on date shown by cursor."
-  (interactive)
-  (message
-   "Astronomical (Julian) day number (at noon UTC): %s.0"
-   (calendar-astro-date-string (calendar-cursor-to-date t))))
-
-(defun calendar-goto-astro-day-number (daynumber &optional noecho)
-  "Move cursor to astronomical (Julian) DAYNUMBER.
-Echo astronomical (Julian) day number unless NOECHO is t."
-  (interactive (list (calendar-read
-                      "Astronomical (Julian) day number (>1721425): "
-                      '(lambda (x) (> x 1721425)))))
-  (calendar-goto-date
-   (calendar-gregorian-from-absolute
-    (floor
-     (calendar-absolute-from-astro daynumber))))
-  (or noecho (calendar-print-astro-day-number)))
-
-(defun diary-astro-day-number ()
-  "Astronomical (Julian) day number diary entry."
-  (format "Astronomical (Julian) day number %s"
-          (calendar-astro-date-string date)))
-
-(provide 'cal-julian)
-
-;;; cal-julian.el ends here
diff --git a/lisp/calendar/cal-mayan.el b/lisp/calendar/cal-mayan.el
deleted file mode 100644
index 6b7b1b70027..00000000000
--- a/lisp/calendar/cal-mayan.el
+++ /dev/null
@@ -1,382 +0,0 @@
-;;; cal-mayan.el --- calendar functions for the Mayan calendars.
-
-;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
-
-;; Author: Stewart M. Clamen <clamen@cs.cmu.edu>
-;;	Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: Mayan calendar, Maya, calendar, diary
-
-;; 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 collection of functions implements the features of calendar.el and
-;; diary.el that deal with the Mayan calendar.  It was written jointly by
-
-;;  Stewart M. Clamen                School of Computer Science
-;;  clamen@cs.cmu.edu                Carnegie Mellon University
-;;                                   5000 Forbes Avenue
-;;                                   Pittsburgh, PA 15213
-
-;; and
-
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;; Comments, improvements, and bug reports should be sent to Reingold.
-
-;; Technical details of the Mayan calendrical calculations can be found in
-;; ``Calendrical Calculations, Part II: Three Historical Calendars''
-;; by E. M. Reingold,  N. Dershowitz, and S. M. Clamen,
-;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
-;; pages 383-404.
-
-;;; Code:
-
-(require 'calendar)
-
-(defconst calendar-mayan-days-before-absolute-zero 1137140
-  "Number of days of the Mayan calendar epoch before absolute day 0.
-According to the Goodman-Martinez-Thompson correlation.  This correlation is
-not universally accepted, as it still a subject of astro-archeological
-research.  Using 1232041 will give you Spinden's correlation; using
-1142840 will give you Hochleitner's correlation.")
-
-(defconst calendar-mayan-haab-at-epoch '(8 . 18)
-  "Mayan haab date at the epoch.")
-
-(defconst calendar-mayan-haab-month-name-array
-  ["Pop" "Uo" "Zip" "Zotz" "Tzec" "Xul" "Yaxkin" "Mol" "Chen" "Yax"
-   "Zac" "Ceh" "Mac" "Kankin" "Muan" "Pax" "Kayab" "Cumku"])
-
-(defconst calendar-mayan-tzolkin-at-epoch '(4 . 20)
-  "Mayan tzolkin date at the epoch.")
-
-(defconst calendar-mayan-tzolkin-names-array
-  ["Imix" "Ik" "Akbal" "Kan" "Chicchan" "Cimi" "Manik" "Lamat" "Muluc" "Oc"
-   "Chuen" "Eb" "Ben" "Ix" "Men" "Cib" "Caban" "Etznab" "Cauac" "Ahau"])
-
-(defun calendar-mayan-long-count-from-absolute (date)
-  "Compute the Mayan long count corresponding to the absolute DATE."
-  (let ((long-count (+ date calendar-mayan-days-before-absolute-zero)))
-    (let* ((baktun (/ long-count 144000))
-           (remainder (% long-count 144000))
-           (katun (/ remainder 7200))
-           (remainder (% remainder 7200))
-           (tun (/ remainder 360))
-           (remainder (% remainder 360))
-           (uinal (/ remainder 20))
-           (kin (% remainder 20)))
-      (list baktun katun tun uinal kin))))
-
-(defun calendar-mayan-long-count-to-string (mayan-long-count)
-  "Convert MAYAN-LONG-COUNT into traditional written form."
-  (apply 'format (cons "%s.%s.%s.%s.%s" mayan-long-count)))
-
-(defun calendar-string-to-mayan-long-count (str)
-  "Given STR, a string of format \"%d.%d.%d.%d.%d\", return list of nums."
-  (let ((rlc nil)
-        (c (length str))
-        (cc 0))
-    (condition-case condition
-        (progn
-          (while (< cc c)
-	    (let* ((start (string-match "[0-9]+" str cc))
-		   (end (match-end 0))
-		   datum)
-	      (setq datum (read (substring str start end)))
-	      (setq rlc (cons datum rlc))
-	      (setq cc end)))
-          (if (not (= (length rlc) 5)) (signal 'invalid-read-syntax nil)))
-      (invalid-read-syntax nil))
-    (reverse rlc)))
-
-(defun calendar-mayan-haab-from-absolute (date)
-  "Convert absolute DATE into a Mayan haab date (a pair)."
-  (let* ((long-count (+ date calendar-mayan-days-before-absolute-zero))
-         (day-of-haab
-          (% (+ long-count
-                (car calendar-mayan-haab-at-epoch)
-                (* 20 (1- (cdr calendar-mayan-haab-at-epoch))))
-             365))
-         (day (% day-of-haab 20))
-         (month (1+ (/ day-of-haab 20))))
-    (cons day month)))
-
-(defun calendar-mayan-haab-difference (date1 date2)
-  "Number of days from Mayan haab DATE1 to next occurrence of haab date DATE2."
-  (mod (+ (* 20 (- (cdr date2) (cdr date1)))
-	  (- (car date2) (car date1)))
-       365))
-
-(defun calendar-mayan-haab-on-or-before (haab-date date)
-  "Absolute date of latest HAAB-DATE on or before absolute DATE."
-  (- date
-     (% (- date
-	   (calendar-mayan-haab-difference
-	    (calendar-mayan-haab-from-absolute 0) haab-date))
-	365)))
-
-(defun calendar-next-haab-date (haab-date &optional noecho)
-  "Move cursor to next instance of Mayan HAAB-DATE. 
-Echo Mayan date if NOECHO is t."
-  (interactive (list (calendar-read-mayan-haab-date)))
-  (calendar-goto-date
-   (calendar-gregorian-from-absolute
-    (calendar-mayan-haab-on-or-before
-     haab-date
-     (+ 365
-        (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
-  (or noecho (calendar-print-mayan-date)))
-
-(defun calendar-previous-haab-date (haab-date &optional noecho)
-  "Move cursor to previous instance of Mayan HAAB-DATE. 
-Echo Mayan date if NOECHO is t."
-  (interactive (list (calendar-read-mayan-haab-date)))
-  (calendar-goto-date
-   (calendar-gregorian-from-absolute
-    (calendar-mayan-haab-on-or-before
-     haab-date
-     (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
-  (or noecho (calendar-print-mayan-date)))
-
-(defun calendar-mayan-haab-to-string (haab)
-  "Convert Mayan haab date (a pair) into its traditional written form."
-  (let ((month (cdr haab))
-        (day (car haab)))
-  ;; 19th month consists of 5 special days
-  (if (= month 19)
-      (format "%d Uayeb" day)
-    (format "%d %s"
-            day
-            (aref calendar-mayan-haab-month-name-array (1- month))))))
-
-(defun calendar-mayan-tzolkin-from-absolute (date)
-  "Convert absolute DATE into a Mayan tzolkin date (a pair)."
-  (let* ((long-count (+ date calendar-mayan-days-before-absolute-zero))
-         (day (calendar-mod
-               (+ long-count (car calendar-mayan-tzolkin-at-epoch))
-               13))
-         (name (calendar-mod
-                (+ long-count (cdr calendar-mayan-tzolkin-at-epoch))
-                20)))
-    (cons day name)))
-
-(defun calendar-mayan-tzolkin-difference (date1 date2)
-  "Number of days from Mayan tzolkin DATE1 to next occurrence of tzolkin DATE2."
-  (let ((number-difference (- (car date2) (car date1)))
-        (name-difference (- (cdr date2) (cdr date1))))
-    (mod (+ number-difference
-	    (* 13 (mod (* 3 (- number-difference name-difference))
-		       20)))
-	 260)))
-
-(defun calendar-mayan-tzolkin-on-or-before (tzolkin-date date)
-  "Absolute date of latest TZOLKIN-DATE on or before absolute DATE."
-  (- date
-     (% (- date (calendar-mayan-tzolkin-difference
-		 (calendar-mayan-tzolkin-from-absolute 0)
-		 tzolkin-date))
-	260)))
-
-(defun calendar-next-tzolkin-date (tzolkin-date &optional noecho)
-  "Move cursor to next instance of Mayan TZOLKIN-DATE. 
-Echo Mayan date if NOECHO is t."
-  (interactive (list (calendar-read-mayan-tzolkin-date)))
-  (calendar-goto-date
-   (calendar-gregorian-from-absolute
-    (calendar-mayan-tzolkin-on-or-before
-     tzolkin-date
-     (+ 260
-        (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
-  (or noecho (calendar-print-mayan-date)))
-
-(defun calendar-previous-tzolkin-date (tzolkin-date &optional noecho)
-  "Move cursor to previous instance of Mayan TZOLKIN-DATE. 
-Echo Mayan date if NOECHO is t."
-  (interactive (list (calendar-read-mayan-tzolkin-date)))
-  (calendar-goto-date
-   (calendar-gregorian-from-absolute
-    (calendar-mayan-tzolkin-on-or-before
-     tzolkin-date
-     (1- (calendar-absolute-from-gregorian (calendar-cursor-to-date))))))
-  (or noecho (calendar-print-mayan-date)))
-
-(defun calendar-mayan-tzolkin-to-string (tzolkin)
-  "Convert Mayan tzolkin date (a pair) into its traditional written form."
-  (format "%d %s"
-          (car tzolkin)
-          (aref calendar-mayan-tzolkin-names-array (1- (cdr tzolkin)))))
-
-(defun calendar-mayan-tzolkin-haab-on-or-before (tzolkin-date haab-date date)
-  "Absolute date that is Mayan TZOLKIN-DATE and HAAB-DATE.
-Latest such date on or before DATE.
-Returns nil if such a tzolkin-haab combination is impossible." 
-  (let* ((haab-difference
-          (calendar-mayan-haab-difference
-           (calendar-mayan-haab-from-absolute 0)
-           haab-date))
-         (tzolkin-difference
-          (calendar-mayan-tzolkin-difference
-           (calendar-mayan-tzolkin-from-absolute 0)
-           tzolkin-date))
-         (difference (- tzolkin-difference haab-difference)))
-    (if (= (% difference 5) 0)
-        (- date
-           (mod (- date
-		   (+ haab-difference (* 365 difference)))
-		18980))
-      nil)))
-
-(defun calendar-read-mayan-haab-date ()
-  "Prompt for a Mayan haab date"
-  (let* ((completion-ignore-case t)
-         (haab-day (calendar-read
-                    "Haab kin (0-19): "
-                    '(lambda (x) (and (>= x 0) (< x 20)))))
-         (haab-month-list (append calendar-mayan-haab-month-name-array 
-                                  (and (< haab-day 5) '("Uayeb"))))
-         (haab-month (cdr
-                      (assoc
-                       (capitalize
-                        (completing-read "Haab uinal: "
-                                         (mapcar 'list haab-month-list)
-                                         nil t))
-                       (calendar-make-alist
-                        haab-month-list 1 'capitalize)))))
-    (cons haab-day haab-month)))
-
-(defun calendar-read-mayan-tzolkin-date ()
-  "Prompt for a Mayan tzolkin date"
-  (let* ((completion-ignore-case t)
-         (tzolkin-count (calendar-read
-                         "Tzolkin kin (1-13): "
-                         '(lambda (x) (and (> x 0) (< x 14)))))
-         (tzolkin-name-list (append calendar-mayan-tzolkin-names-array nil))
-         (tzolkin-name (cdr
-                        (assoc
-                         (capitalize
-                          (completing-read "Tzolkin uinal: " 
-                                           (mapcar 'list tzolkin-name-list)
-                                           nil t))
-                         (calendar-make-alist
-                          tzolkin-name-list 1 'capitalize)))))
-    (cons tzolkin-count tzolkin-name)))
-
-(defun calendar-next-calendar-round-date
-  (tzolkin-date haab-date &optional noecho)
-  "Move cursor to next instance of Mayan HAAB-DATE TZOLKIN-DATE combination.
-Echo Mayan date if NOECHO is t."
-  (interactive (list (calendar-read-mayan-tzolkin-date)
-                     (calendar-read-mayan-haab-date)))
-  (let ((date (calendar-mayan-tzolkin-haab-on-or-before
-               tzolkin-date haab-date
-               (+ 18980 (calendar-absolute-from-gregorian
-                         (calendar-cursor-to-date))))))
-    (if (not date)
-        (error "%s, %s does not exist in the Mayan calendar round"
-               (calendar-mayan-tzolkin-to-string tzolkin-date)
-               (calendar-mayan-haab-to-string haab-date))
-      (calendar-goto-date (calendar-gregorian-from-absolute date))
-      (or noecho (calendar-print-mayan-date)))))
-
-(defun calendar-previous-calendar-round-date
-  (tzolkin-date haab-date &optional noecho)
-  "Move to previous instance of Mayan TZOLKIN-DATE HAAB-DATE combination.
-Echo Mayan date if NOECHO is t."
-  (interactive (list (calendar-read-mayan-tzolkin-date)
-                     (calendar-read-mayan-haab-date)))
-  (let ((date (calendar-mayan-tzolkin-haab-on-or-before
-               tzolkin-date haab-date
-               (1- (calendar-absolute-from-gregorian
-                    (calendar-cursor-to-date))))))
-    (if (not date)
-        (error "%s, %s does not exist in the Mayan calendar round"
-               (calendar-mayan-tzolkin-to-string tzolkin-date)
-               (calendar-mayan-haab-to-string haab-date))
-      (calendar-goto-date (calendar-gregorian-from-absolute date))
-      (or noecho (calendar-print-mayan-date)))))
-
-(defun calendar-absolute-from-mayan-long-count (c)
-  "Compute the absolute date corresponding to the Mayan Long Count C.
-Long count is a list (baktun katun tun uinal kin)"
-  (+ (* (nth 0 c) 144000)        ; baktun
-     (* (nth 1 c) 7200)          ; katun
-     (* (nth 2 c) 360)           ; tun
-     (* (nth 3 c) 20)            ; uinal
-     (nth 4 c)                   ; kin (days)
-     (-                          ; days before absolute date 0
-      calendar-mayan-days-before-absolute-zero)))
-
-(defun calendar-mayan-date-string (&optional date)
-  "String of Mayan date of Gregorian DATE.
-Defaults to today's date if DATE is not given."
-  (let* ((d (calendar-absolute-from-gregorian 
-             (or date (calendar-current-date))))
-         (tzolkin (calendar-mayan-tzolkin-from-absolute d))
-         (haab (calendar-mayan-haab-from-absolute d))
-         (long-count (calendar-mayan-long-count-from-absolute d)))
-      (format "Long count = %s; tzolkin = %s; haab = %s"
-              (calendar-mayan-long-count-to-string long-count)
-              (calendar-mayan-tzolkin-to-string tzolkin)
-              (calendar-mayan-haab-to-string haab))))
-
-(defun calendar-print-mayan-date ()
-  "Show the Mayan long count, tzolkin, and haab equivalents of date."
-  (interactive)
-  (message "Mayan date: %s"
-           (calendar-mayan-date-string (calendar-cursor-to-date t))))
-
-(defun calendar-goto-mayan-long-count-date (date &optional noecho)
-  "Move cursor to Mayan long count DATE.  Echo Mayan date unless NOECHO is t."
-  (interactive
-   (let (lc)
-     (while (not lc)
-       (let ((datum
-              (calendar-string-to-mayan-long-count 
-               (read-string "Mayan long count (baktun.katun.tun.uinal.kin): "
-                            (calendar-mayan-long-count-to-string
-                             (calendar-mayan-long-count-from-absolute
-                               (calendar-absolute-from-gregorian
-                                (calendar-current-date))))))))
-         (if (calendar-mayan-long-count-common-era datum)
-             (setq lc datum))))
-     (list lc)))
-  (calendar-goto-date
-   (calendar-gregorian-from-absolute
-    (calendar-absolute-from-mayan-long-count date)))
-  (or noecho (calendar-print-mayan-date)))
-              
-(defun calendar-mayan-long-count-common-era (lc)
-  "T if long count represents date in the Common Era."
-  (let ((base (calendar-mayan-long-count-from-absolute 1)))
-    (while (and (not (null base)) (= (car lc) (car base)))
-      (setq lc (cdr lc)
-            base (cdr base)))
-    (or (null lc) (> (car lc) (car base)))))
-
-(defun diary-mayan-date ()
-  "Show the Mayan long count, haab, and tzolkin dates as a diary entry."
-  (format "Mayan date: %s" (calendar-mayan-date-string date)))
-
-(provide 'cal-mayan)
-
-;;; cal-mayan.el ends here
diff --git a/lisp/calendar/cal-menu.el b/lisp/calendar/cal-menu.el
deleted file mode 100644
index b8d17ef5597..00000000000
--- a/lisp/calendar/cal-menu.el
+++ /dev/null
@@ -1,523 +0,0 @@
-;;; cal-menu.el --- calendar functions for menu bar and popup menu support
-
-;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;;	Lara Rios <lrios@coewl.cen.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: calendar, popup menus, menu bar
-
-;; 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 collection of functions implements menu bar and popup menu support for
-;; calendar.el.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(define-key calendar-mode-map [menu-bar edit] 'undefined)
-(define-key calendar-mode-map [menu-bar search] 'undefined)
-
-(define-key calendar-mode-map [down-mouse-2] 'calendar-mouse-2-date-menu)
-(define-key calendar-mode-map [mouse-2] 'ignore)
-
-(defvar calendar-mouse-3-map (make-sparse-keymap "Calendar"))
-(define-key calendar-mode-map [down-mouse-3] calendar-mouse-3-map)
-(define-key calendar-mode-map [C-down-mouse-3] calendar-mouse-3-map)
-
-(define-key calendar-mode-map [menu-bar moon]
-  (cons "Moon" (make-sparse-keymap "Moon")))
-
-(define-key calendar-mode-map [menu-bar moon moon]
-  '("Lunar Phases" . calendar-phases-of-moon))
-
-(define-key calendar-mode-map [menu-bar diary]
-  (cons "Diary" (make-sparse-keymap "Diary")))
-
-(define-key calendar-mode-map [menu-bar diary heb]
-  '("Insert Hebrew" . calendar-mouse-insert-hebrew-diary-entry))
-(define-key calendar-mode-map [menu-bar diary isl]
-  '("Insert Islamic" . calendar-mouse-insert-islamic-diary-entry))
-(define-key calendar-mode-map [menu-bar diary cyc]
-  '("Insert Cyclic" . insert-cyclic-diary-entry))
-(define-key calendar-mode-map [menu-bar diary blk]
-  '("Insert Block" . insert-block-diary-entry))
-(define-key calendar-mode-map [menu-bar diary ann]
-  '("Insert Anniversary" . insert-anniversary-diary-entry))
-(define-key calendar-mode-map [menu-bar diary yr]
-  '("Insert Yearly" . insert-yearly-diary-entry))
-(define-key calendar-mode-map [menu-bar diary mon]
-  '("Insert Monthly" . insert-monthly-diary-entry))
-(define-key calendar-mode-map [menu-bar diary wk]
-  '("Insert Weekly" . insert-weekly-diary-entry))
-(define-key calendar-mode-map [menu-bar diary ent]
-  '("Insert Daily". insert-diary-entry))
-(define-key calendar-mode-map [menu-bar diary all]
-  '("Show All" . show-all-diary-entries))
-(define-key calendar-mode-map [menu-bar diary mark]
- '("Mark All" . mark-diary-entries))
-(define-key calendar-mode-map [menu-bar diary view]
-  '("Cursor Date" . view-diary-entries))
-(define-key calendar-mode-map [menu-bar diary view]
-  '("Other File" . view-other-diary-entries))
-
-(define-key calendar-mode-map [menu-bar holidays]
-  (cons "Holidays" (make-sparse-keymap "Holidays")))
-
-(define-key calendar-mode-map [menu-bar holidays unmark]
-  '("Unmark" . calendar-unmark))
-(define-key calendar-mode-map [menu-bar holidays mark]
-  '("Mark" . mark-calendar-holidays))
-(define-key calendar-mode-map [menu-bar holidays 3-mon]
-  '("3 Months" . list-calendar-holidays))
-(define-key calendar-mode-map [menu-bar holidays 1-day]
-  '("One Day" . calendar-cursor-holidays))
-
-(define-key calendar-mode-map [menu-bar goto]
-  (cons "Goto" (make-sparse-keymap "Goto")))
-
-(define-key calendar-mode-map [menu-bar goto french]
-  '("French Date" . calendar-goto-french-date))
-(define-key calendar-mode-map [menu-bar goto mayan]
-  (cons "Mayan Date" (make-sparse-keymap "Mayan")))
-(define-key calendar-mode-map [menu-bar goto ethiopic]
-  '("Ethiopic Date" . calendar-goto-ethiopic-date))
-(define-key calendar-mode-map [menu-bar goto coptic]
-  '("Coptic Date" . calendar-goto-coptic-date))
-(define-key calendar-mode-map [menu-bar goto chinese]
-  '("Chinese Date" . calendar-goto-chinese-date))
-(define-key calendar-mode-map [menu-bar goto julian]
-  '("Julian Date" . calendar-goto-julian-date))
-(define-key calendar-mode-map [menu-bar goto islamic]
-  '("Islamic Date" . calendar-goto-islamic-date))
-(define-key calendar-mode-map [menu-bar goto persian]
-  '("Persian Date" . calendar-goto-persian-date))
-(define-key calendar-mode-map [menu-bar goto hebrew]
-  '("Hebrew Date" . calendar-goto-hebrew-date))
-(define-key calendar-mode-map [menu-bar goto astro]
-  '("Astronomical Date" . calendar-goto-astro-day-number))
-(define-key calendar-mode-map [menu-bar goto iso]
-  '("ISO Date" . calendar-goto-iso-date))
-(define-key calendar-mode-map [menu-bar goto gregorian]
-  '("Other Date" . calendar-goto-date))
-(define-key calendar-mode-map [menu-bar goto end-of-year]
-  '("End of Year" . calendar-end-of-year))
-(define-key calendar-mode-map [menu-bar goto beginning-of-year]
-  '("Beginning of Year" . calendar-beginning-of-year))
-(define-key calendar-mode-map [menu-bar goto end-of-month]
-  '("End of Month" . calendar-end-of-month))
-(define-key calendar-mode-map [menu-bar goto beginning-of-month]
-  '("Beginning of Month" . calendar-beginning-of-month))
-(define-key calendar-mode-map [menu-bar goto end-of-week]
-  '("End of Week" . calendar-end-of-week))
-(define-key calendar-mode-map [menu-bar goto beginning-of-week]
-  '("Beginning of Week" . calendar-beginning-of-week))
-(define-key calendar-mode-map [menu-bar goto today]
-  '("Today" . calendar-goto-today))
-
-
-(define-key calendar-mode-map [menu-bar goto mayan prev-rnd]
-  '("Previous Round" . calendar-previous-calendar-round-date))
-(define-key calendar-mode-map [menu-bar goto mayan nxt-rnd]
-  '("Next Round" . calendar-next-calendar-round-date))
-(define-key calendar-mode-map [menu-bar goto mayan prev-haab]
-  '("Previous Haab" . calendar-previous-haab-date))
-(define-key calendar-mode-map [menu-bar goto mayan next-haab]
-  '("Next Haab" . calendar-next-haab-date))
-(define-key calendar-mode-map [menu-bar goto mayan prev-tzol]
-  '("Previous Tzolkin" . calendar-previous-tzolkin-date))
-(define-key calendar-mode-map [menu-bar goto mayan next-tzol]
-  '("Next Tzolkin" . calendar-next-tzolkin-date))
-
-(define-key calendar-mode-map [menu-bar scroll]
-  (cons "Scroll" (make-sparse-keymap "Scroll")))
-
-(define-key calendar-mode-map [menu-bar scroll bk-12]
-  '("Backward 1 Year" . "4\ev"))
-(define-key calendar-mode-map [menu-bar scroll bk-3]
-  '("Backward 3 Months" . scroll-calendar-right-three-months))
-(define-key calendar-mode-map [menu-bar scroll bk-1]
-  '("Backward 1 Month" . scroll-calendar-right))
-(define-key calendar-mode-map [menu-bar scroll fwd-12]
-  '("Forward 1 Year" . "4\C-v"))
-(define-key calendar-mode-map [menu-bar scroll fwd-3]
-  '("Forward 3 Months" . scroll-calendar-left-three-months))
-(define-key calendar-mode-map [menu-bar scroll fwd-1]
-  '("Forward 1 Month" . scroll-calendar-left))
-
-(put 'calendar-forward-day 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-backward-day 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-forward-week 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-backward-week 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-forward-month 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-backward-month 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-forward-year 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-backward-year 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-beginning-of-year 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-end-of-year 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-beginning-of-month 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-end-of-month 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-end-of-week 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-beginning-of-week 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-mouse-print-dates 'menu-enable '(calendar-event-to-date))
-(put 'calendar-sunrise-sunset 'menu-enable '(calendar-event-to-date))
-(put 'calendar-cursor-holidays 'menu-enable '(calendar-cursor-to-date))
-(put 'view-diary-entries 'menu-enable '(calendar-cursor-to-date))
-(put 'view-other-diary-entries 'menu-enable '(calendar-cursor-to-date))
-(put 'calendar-mouse-insert-hebrew-diary-entry
-     'menu-enable
-     '(calendar-cursor-to-date))
-(put 'calendar-mouse-insert-islamic-diary-entry
-     'menu-enable
-     '(calendar-cursor-to-date))
-(put 'insert-cyclic-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'insert-block-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'insert-anniversary-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'insert-yearly-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'insert-monthly-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'insert-weekly-diary-entry 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-day 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week2 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week-iso 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-week-monday 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-filofax-2week
-     'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-filofax-week 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-month 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-month-landscape 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-year 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-filofax-year 'menu-enable '(calendar-cursor-to-date))
-(put 'cal-tex-cursor-year-landscape 'menu-enable '(calendar-cursor-to-date))
-
-(defun calendar-event-to-date (&optional error)
-  "Date of last event.
-If event is not on a specific date, signals an error if optional parameter
-ERROR is t, otherwise just returns nil."
-  (save-excursion
-    (set-buffer (window-buffer (posn-window (event-start last-input-event))))
-    (goto-char (posn-point (event-start last-input-event)))
-    (calendar-cursor-to-date error)))
-
-(defun calendar-mouse-insert-hebrew-diary-entry (event)
-  "Pop up menu to insert a Hebrew-date diary entry."
-  (interactive "e")
-  (let ((hebrew-selection
-         (x-popup-menu
-          event
-          (list "Hebrew insert menu"
-                (list (calendar-hebrew-date-string (calendar-cursor-to-date))
-                      '("One time" . insert-hebrew-diary-entry)
-                      '("Monthly" . insert-monthly-hebrew-diary-entry)
-                      '("Yearly" . insert-yearly-hebrew-diary-entry))))))
-    (and hebrew-selection (call-interactively hebrew-selection))))
-
-(defun calendar-mouse-insert-islamic-diary-entry (event)
-  "Pop up menu to insert an Islamic-date diary entry."
-  (interactive "e")
-  (let ((islamic-selection
-         (x-popup-menu
-          event
-          (list "Islamic insert menu"
-                (list (calendar-islamic-date-string (calendar-cursor-to-date))
-                      '("One time" . insert-islamic-diary-entry)
-                      '("Monthly" . insert-monthly-islamic-diary-entry)
-                      '("Yearly" . insert-yearly-islamic-diary-entry))))))
-    (and islamic-selection (call-interactively islamic-selection))))
-
-(defun calendar-mouse-sunrise/sunset ()
-  "Show sunrise/sunset times for mouse-selected date."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (calendar-sunrise-sunset)))
-
-(defun calendar-mouse-holidays ()
-  "Show holidays for mouse-selected date."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (calendar-cursor-holidays)))
-
-(defun calendar-mouse-view-diary-entries ()
-  "View diary entries on mouse-selected date."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (view-diary-entries 1)))
-
-(defun calendar-mouse-view-other-diary-entries ()
-  "View diary entries from alternative file on mouse-selected date."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (call-interactively 'view-other-diary-entries)))
-
-(defun calendar-mouse-insert-diary-entry ()
-  "Insert diary entry for mouse-selected date."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (insert-diary-entry nil)))
-
-(defun calendar-mouse-set-mark ()
-  "Mark the date under the cursor."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (calendar-set-mark nil)))
-
-(defun cal-tex-mouse-day ()
-  "Make a buffer with LaTeX commands for the day mouse is on."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-day nil)))
-
-(defun cal-tex-mouse-week ()
-  "One page calendar for week indicated by cursor.
-Holidays are included if `cal-tex-holidays' is t."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-week nil)))
-
-(defun cal-tex-mouse-week2 ()
-  "Make a buffer with LaTeX commands for the week cursor is on.
-The printed output will be on two pages."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-week2 nil)))
-
-(defun cal-tex-mouse-week-iso ()
-  "One page calendar for week indicated by cursor.
-Holidays are included if `cal-tex-holidays' is t."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-week-iso nil)))
-
-(defun cal-tex-mouse-week-monday ()
-  "One page calendar for week indicated by cursor."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-week-monday nil)))
-
-(defun cal-tex-mouse-filofax-2week ()
-  "One page Filofax calendar for week indicated by cursor."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-filofax-2week nil)))
-
-(defun cal-tex-mouse-filofax-week ()
-  "Two page Filofax calendar for week indicated by cursor."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-filofax-week nil)))
-
-(defun cal-tex-mouse-month ()
-  "Make a buffer with LaTeX commands for the month cursor is on.
-Calendar is condensed onto one page."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-month nil)))
-
-(defun cal-tex-mouse-month-landscape ()
-  "Make a buffer with LaTeX commands for the month cursor is on.
-The output is in landscape format, one month to a page."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-month-landscape nil)))
-
-(defun cal-tex-mouse-year ()
-  "Make a buffer with LaTeX commands for the year cursor is on."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-year nil)))
-
-(defun cal-tex-mouse-filofax-year ()
-  "Make a buffer with LaTeX commands for Filofax calendar of year cursor is on."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-filofax-year nil)))
-
-(defun cal-tex-mouse-year-landscape ()
-  "Make a buffer with LaTeX commands for the year cursor is on."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (cal-tex-cursor-year-landscape nil)))
-
-(defun calendar-mouse-print-dates ()
-  "Pop up menu of equivalent dates to mouse selected date."
-  (interactive)
-  (let ((date (calendar-event-to-date))
-        (selection
-         (x-popup-menu
-          event
-          (list
-           (concat (calendar-date-string date) " (Gregorian)")
-           (append
-            (list
-             (concat (calendar-date-string date) " (Gregorian)")
-             (list (calendar-day-of-year-string date))
-             (list (format "ISO date: %s" (calendar-iso-date-string date)))
-             (list (format "Julian date: %s"
-                           (calendar-julian-date-string date)))
-             (list
-              (format "Astronomical (Julian) day number (at noon UTC): %s.0"
-                           (calendar-astro-date-string date)))
-             (list (format "Hebrew date (before sunset): %s"
-                           (calendar-hebrew-date-string date)))
-             (list (format "Persian date: %s"
-                           (calendar-persian-date-string date))))
-            (let ((i (calendar-islamic-date-string date)))
-              (if (not (string-equal i ""))
-                  (list (list (format "Islamic date (before sunset): %s" i)))))
-            (list
-             (list (format "Chinese date: %s"
-                           (calendar-chinese-date-string date))))
-;            (list '("Chinese date (select to echo Chinese date)"
-;                    . calendar-mouse-chinese-date))
-            (let ((c (calendar-coptic-date-string date)))
-              (if (not (string-equal c ""))
-                  (list (list (format "Coptic date: %s" c)))))
-            (let ((e (calendar-ethiopic-date-string date)))
-              (if (not (string-equal e ""))
-                  (list (list (format "Ethiopic date: %s" e)))))
-            (let ((f (calendar-french-date-string date)))
-              (if (not (string-equal f ""))
-                  (list (list (format "French Revolutionary date: %s" f)))))
-            (list
-             (list
-              (format "Mayan date: %s"
-                      (calendar-mayan-date-string date)))))))))
-        (and selection (call-interactively selection))))
-
-(defun calendar-mouse-chinese-date ()
-  "Show Chinese equivalent for mouse-selected date."
-  (interactive)
-  (save-excursion
-    (calendar-mouse-goto-date (calendar-event-to-date))
-    (calendar-print-chinese-date)))
-
-(defun calendar-mouse-goto-date (date)
-  (set-buffer (window-buffer (posn-window (event-start last-input-event))))
-  (calendar-goto-date date))
-
-(defun calendar-mouse-2-date-menu (event)
-  "Pop up menu for Mouse-2 for selected date in the calendar window."
-  (interactive "e")
-  (let* ((date (calendar-event-to-date t))
-         (selection
-          (x-popup-menu
-           event
-           (list (calendar-date-string date t nil)
-                 (list
-                  ""
-                  '("Holidays" . calendar-mouse-holidays)
-                  '("Mark date" . calendar-mouse-set-mark)
-                  '("Sunrise/sunset" . calendar-mouse-sunrise/sunset)
-                  '("Other calendars" . calendar-mouse-print-dates)
-                  '("Prepare LaTeX buffer" . calendar-mouse-cal-tex-menu)
-                  '("Diary entries" . calendar-mouse-view-diary-entries)
-                  '("Insert diary entry" . calendar-mouse-insert-diary-entry)
-                  '("Other diary file entries"
-                    . calendar-mouse-view-other-diary-entries)
-                  )))))
-    (and selection (call-interactively selection))))
-
-(defun calendar-mouse-cal-tex-menu (event)
-  "Pop up submenu for Mouse-2 for cal-tex commands for selected date in the calendar window."
-  (interactive "e")
-  (let* ((selection
-          (x-popup-menu
-           event
-           (list (calendar-date-string date t nil)
-                 (list
-                  ""
-                  '("Daily (1 page)" . cal-tex-mouse-day)
-                  '("Weekly (1 page)" . cal-tex-mouse-week)
-                  '("Weekly (2 pages)" . cal-tex-mouse-week2)
-                  '("Weekly (other style; 1 page)" . cal-tex-mouse-week-iso)
-                  '("Weekly (yet another style; 1 page)" .
-                    cal-tex-mouse-week-monday)
-                  '("Monthly" . cal-tex-mouse-month)
-                  '("Monthly (landscape)" . cal-tex-mouse-month-landscape)
-                  '("Yearly" . cal-tex-mouse-year)
-                  '("Yearly (landscape)" . cal-tex-mouse-year-landscape)
-                  '("Filofax styles" . cal-tex-mouse-filofax)
-                  )))))
-    (and selection (call-interactively selection))))
-
-(defun cal-tex-mouse-filofax (event)
-  "Pop up sub-submenu for Mouse-2 for Filofax cal-tex commands for selected date."
-  (interactive "e")
-  (let* ((selection
-          (x-popup-menu
-           event
-           (list (calendar-date-string date t nil)
-                 (list
-                  ""
-                  '("Filofax Weekly (2-weeks-at-a-glance)" .
-                    cal-tex-mouse-filofax-2week)
-                  '("Filofax Weekly (week-at-a-glance)" .
-                    cal-tex-mouse-filofax-week)
-                  '("Filofax Yearly" . cal-tex-mouse-filofax-year)
-                  )))))
-    (and selection (call-interactively selection))))
-
-(define-key calendar-mouse-3-map [exit-calendar]
-  '("Exit calendar" . exit-calendar))
-(define-key calendar-mouse-3-map [show-diary]
-  '("Show diary" . show-all-diary-entries))
-(define-key calendar-mouse-3-map [lunar-phases]
-  '("Lunar phases" . calendar-phases-of-moon))
-(define-key calendar-mouse-3-map [unmark]
-  '("Unmark" . calendar-unmark))
-(define-key calendar-mouse-3-map [mark-holidays]
-  '("Mark holidays" . mark-calendar-holidays))
-(define-key calendar-mouse-3-map [list-holidays]
-  '("List holidays" . list-calendar-holidays))
-(define-key calendar-mouse-3-map [mark-diary-entries]
-  '("Mark diary entries" . mark-diary-entries))
-(define-key calendar-mouse-3-map [scroll-backward]
-  '("Scroll backward" . scroll-calendar-right-three-months))
-(define-key calendar-mouse-3-map [scroll-forward]
-  '("Scroll forward" . scroll-calendar-left-three-months))
-
-(run-hooks 'cal-menu-load-hook)
-
-(provide 'cal-menu)
-
-;;; cal-menu.el ends here
diff --git a/lisp/calendar/cal-move.el b/lisp/calendar/cal-move.el
deleted file mode 100644
index 8ec3295d77a..00000000000
--- a/lisp/calendar/cal-move.el
+++ /dev/null
@@ -1,315 +0,0 @@
-;;; cal-move.el --- calendar functions for movement in the calendar
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: calendar
-
-;; 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 collection of functions implements movement in the calendar for
-;; calendar.el.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(defun calendar-goto-today ()
-  "Reposition the calendar window so the current date is visible."
-  (interactive)
-  (let ((today (calendar-current-date)));; The date might have changed.
-    (if (not (calendar-date-is-visible-p today))
-        (generate-calendar-window)
-      (update-calendar-mode-line)
-      (calendar-cursor-to-visible-date today))))
-
-(defun calendar-forward-month (arg)
-  "Move the cursor forward ARG months.
-Movement is backward if ARG is negative."
-  (interactive "p")
-  (calendar-cursor-to-nearest-date)
-  (let* ((cursor-date (calendar-cursor-to-date t))
-         (month (extract-calendar-month cursor-date))
-         (day (extract-calendar-day cursor-date))
-         (year (extract-calendar-year cursor-date)))
-    (increment-calendar-month month year arg)
-    (let ((last (calendar-last-day-of-month month year)))
-      (if (< last day)
-        (setq day last)))
-    ;; Put the new month on the screen, if needed, and go to the new date.
-    (let ((new-cursor-date (list month day year)))
-      (if (not (calendar-date-is-visible-p new-cursor-date))
-          (calendar-other-month month year))
-      (calendar-cursor-to-visible-date new-cursor-date))))
-
-(defun calendar-forward-year (arg)
-  "Move the cursor forward by ARG years.
-Movement is backward if ARG is negative."
-  (interactive "p")
-  (calendar-forward-month (* 12 arg)))
-
-(defun calendar-backward-month (arg)
-  "Move the cursor backward by ARG months.
-Movement is forward if ARG is negative."
-  (interactive "p")
-  (calendar-forward-month (- arg)))
-
-(defun calendar-backward-year (arg)
-  "Move the cursor backward ARG years.
-Movement is forward is ARG is negative."
-  (interactive "p")
-  (calendar-forward-month (* -12 arg)))
-
-(defun scroll-calendar-left (arg)
-  "Scroll the displayed calendar left by ARG months.
-If ARG is negative the calendar is scrolled right.  Maintains the relative
-position of the cursor with respect to the calendar as well as possible."
-  (interactive "p")
-  (calendar-cursor-to-nearest-date)
-  (let ((old-date (calendar-cursor-to-date))
-        (today (calendar-current-date)))
-    (if (/= arg 0)
-        (progn
-          (increment-calendar-month displayed-month displayed-year arg)
-          (generate-calendar-window displayed-month displayed-year)
-          (calendar-cursor-to-visible-date
-           (cond
-            ((calendar-date-is-visible-p old-date) old-date)
-            ((calendar-date-is-visible-p today) today)
-            (t (list displayed-month 1 displayed-year))))))))
-
-(defun scroll-calendar-right (arg)
-  "Scroll the displayed calendar window right by ARG months.
-If ARG is negative the calendar is scrolled left.  Maintains the relative
-position of the cursor with respect to the calendar as well as possible."
-  (interactive "p")
-  (scroll-calendar-left (- arg)))
-
-(defun scroll-calendar-left-three-months (arg)
-  "Scroll the displayed calendar window left by 3*ARG months.
-If ARG is negative the calendar is scrolled right.  Maintains the relative
-position of the cursor with respect to the calendar as well as possible."
-  (interactive "p")
-  (scroll-calendar-left (* 3 arg)))
-
-(defun scroll-calendar-right-three-months (arg)
-  "Scroll the displayed calendar window right by 3*ARG months.
-If ARG is negative the calendar is scrolled left.  Maintains the relative
-position of the cursor with respect to the calendar as well as possible."
-  (interactive "p")
-  (scroll-calendar-left (* -3 arg)))
-
-(defun calendar-cursor-to-nearest-date ()
-  "Move the cursor to the closest date.
-The position of the cursor is unchanged if it is already on a date.
-Returns the list (month day year) giving the cursor position."
-  (let ((date (calendar-cursor-to-date))
-        (column (current-column)))
-    (if date
-        date
-      (if (> 3 (count-lines (point-min) (point)))
-          (progn
-            (goto-line 3)
-            (move-to-column column)))
-      (if (not (looking-at "[0-9]"))
-          (if (and (not (looking-at " *$"))
-                   (or (< column 25)
-                       (and (> column 27)
-                            (< column 50))
-                       (and (> column 52)
-                            (< column 75))))
-              (progn
-                (re-search-forward "[0-9]" nil t)
-                (backward-char 1))
-            (re-search-backward "[0-9]" nil t)))
-      (calendar-cursor-to-date))))
-
-(defun calendar-forward-day (arg)
-  "Move the cursor forward ARG days.
-Moves backward if ARG is negative."
-  (interactive "p")
-  (if (/= 0 arg)
-      (let*
-          ((cursor-date (calendar-cursor-to-date))
-           (cursor-date (if cursor-date
-                            cursor-date
-                          (if (> arg 0) (setq arg (1- arg)))
-                          (calendar-cursor-to-nearest-date)))
-           (new-cursor-date
-            (calendar-gregorian-from-absolute
-             (+ (calendar-absolute-from-gregorian cursor-date) arg)))
-           (new-display-month (extract-calendar-month new-cursor-date))
-           (new-display-year (extract-calendar-year new-cursor-date)))
-        ;; Put the new month on the screen, if needed, and go to the new date.
-        (if (not (calendar-date-is-visible-p new-cursor-date))
-            (calendar-other-month new-display-month new-display-year))
-        (calendar-cursor-to-visible-date new-cursor-date))))
-
-(defun calendar-backward-day (arg)
-  "Move the cursor back ARG days.
-Moves forward if ARG is negative."
-  (interactive "p")
-  (calendar-forward-day (- arg)))
-
-(defun calendar-forward-week (arg)
-  "Move the cursor forward ARG weeks.
-Moves backward if ARG is negative."
-  (interactive "p")
-  (calendar-forward-day (* arg 7)))
-
-(defun calendar-backward-week (arg)
-  "Move the cursor back ARG weeks.
-Moves forward if ARG is negative."
-  (interactive "p")
-  (calendar-forward-day (* arg -7)))
-
-(defun calendar-beginning-of-week (arg)
-  "Move the cursor back ARG calendar-week-start-day's."
-  (interactive "p")
-  (calendar-cursor-to-nearest-date)
-  (let ((day (calendar-day-of-week (calendar-cursor-to-date))))
-    (calendar-backward-day
-     (if (= day calendar-week-start-day)
-         (* 7 arg)
-       (+ (mod (- day calendar-week-start-day) 7)
-          (* 7 (1- arg)))))))
-
-(defun calendar-end-of-week (arg)
-  "Move the cursor forward ARG calendar-week-start-day+6's."
-  (interactive "p")
-  (calendar-cursor-to-nearest-date)
-  (let ((day (calendar-day-of-week (calendar-cursor-to-date))))
-    (calendar-forward-day
-     (if (= day (mod (1- calendar-week-start-day) 7))
-         (* 7 arg)
-       (+ (- 6 (mod (- day calendar-week-start-day) 7))
-          (* 7 (1- arg)))))))
-
-(defun calendar-beginning-of-month (arg)
-  "Move the cursor backward ARG month beginnings."
-  (interactive "p")
-  (calendar-cursor-to-nearest-date)
-  (let* ((date (calendar-cursor-to-date))
-         (month (extract-calendar-month date))
-         (day (extract-calendar-day date))
-         (year (extract-calendar-year date)))
-    (if (= day 1)
-        (calendar-backward-month arg)
-      (calendar-cursor-to-visible-date (list month 1 year))
-      (calendar-backward-month (1- arg)))))
-
-(defun calendar-end-of-month (arg)
-  "Move the cursor forward ARG month ends."
-  (interactive "p")
-  (calendar-cursor-to-nearest-date)
-  (let* ((date (calendar-cursor-to-date))
-         (month (extract-calendar-month date))
-         (day (extract-calendar-day date))
-         (year (extract-calendar-year date))
-         (last-day (calendar-last-day-of-month month year)))
-    (if (/= day last-day)
-        (progn
-          (calendar-cursor-to-visible-date (list month last-day year))
-          (setq arg (1- arg))))
-    (increment-calendar-month month year arg)
-    (let ((last-day (list
-                     month
-                     (calendar-last-day-of-month month year)
-                     year)))
-      (if (not (calendar-date-is-visible-p last-day))
-          (calendar-other-month month year)
-      (calendar-cursor-to-visible-date last-day)))))
-
-(defun calendar-beginning-of-year (arg)
-  "Move the cursor backward ARG year beginnings."
-  (interactive "p")
-  (calendar-cursor-to-nearest-date)
-  (let* ((date (calendar-cursor-to-date))
-         (month (extract-calendar-month date))
-         (day (extract-calendar-day date))
-         (year (extract-calendar-year date))
-         (jan-first (list 1 1 year)))
-    (if (and (= day 1) (= 1 month))
-        (calendar-backward-month (* 12 arg))
-      (if (and (= arg 1)
-               (calendar-date-is-visible-p jan-first))
-          (calendar-cursor-to-visible-date jan-first)
-        (calendar-other-month 1 (- year (1- arg)))))))
-
-(defun calendar-end-of-year (arg)
-  "Move the cursor forward ARG year beginnings."
-  (interactive "p")
-  (calendar-cursor-to-nearest-date)
-  (let* ((date (calendar-cursor-to-date))
-         (month (extract-calendar-month date))
-         (day (extract-calendar-day date))
-         (year (extract-calendar-year date))
-         (dec-31 (list 12 31 year)))
-    (if (and (= day 31) (= 12 month))
-        (calendar-forward-month (* 12 arg))
-      (if (and (= arg 1)
-               (calendar-date-is-visible-p dec-31))
-          (calendar-cursor-to-visible-date dec-31)
-        (calendar-other-month 12 (- year (1- arg)))
-        (calendar-cursor-to-visible-date (list 12 31 displayed-year))))))
-
-(defun calendar-cursor-to-visible-date (date)
-  "Move the cursor to DATE that is on the screen."
-  (let* ((month (extract-calendar-month date))
-	 (day (extract-calendar-day date))
-	 (year (extract-calendar-year date))
-	 (first-of-month-weekday (calendar-day-of-week (list month 1 year))))
-    (goto-line (+ 3
-		  (/ (+ day  -1
-                        (mod
-                         (- (calendar-day-of-week (list month 1 year))
-                            calendar-week-start-day)
-                         7))
-                     7)))
-    (move-to-column (+ 6
-		       (* 25
-			  (1+ (calendar-interval
-			       displayed-month displayed-year month year)))
-		       (* 3 (mod
-                             (- (calendar-day-of-week date)
-                                calendar-week-start-day)
-                             7))))))
-
-(defun calendar-goto-date (date)
-  "Move cursor to DATE."
-  (interactive (list (calendar-read-date)))
-  (let ((month (extract-calendar-month date))
-        (year (extract-calendar-year date)))
-    (if (not (calendar-date-is-visible-p date))
-        (calendar-other-month
-         (if (and (= month 1) (= year 1))
-             2
-           month)
-         year)))
-  (calendar-cursor-to-visible-date date))
-
-(provide 'cal-move)
-
-;;; cal-move.el ends here
diff --git a/lisp/calendar/cal-persia.el b/lisp/calendar/cal-persia.el
deleted file mode 100644
index 89269526be8..00000000000
--- a/lisp/calendar/cal-persia.el
+++ /dev/null
@@ -1,206 +0,0 @@
-;;; cal-persia.el --- calendar functions for the Persian calendar.
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: Persian calendar, calendar, diary
-
-;; 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 collection of functions implements the features of calendar.el and
-;; diary.el that deal with the Persian calendar.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'cal-julian)
-
-(defvar persian-calendar-month-name-array
-  ["Farvardin" "Ordibehest" "Xordad" "Tir" "Mordad" "Sahrivar" "Mehr" "Aban"
-   "Azar" "Dey" "Bahman" "Esfand"])
-
-(defvar persian-calendar-epoch (calendar-absolute-from-julian '(3 19 622))
-  "Absolute date of start of Persian calendar = March 19, 622 A.D. (Julian).")
-
-(defun persian-calendar-leap-year-p (year)
-  "True if YEAR is a leap year on the Persian calendar."
-  (< (mod (* (mod (mod (if (<= 0 year)
-                           ; No year zero
-                           (+ year 2346)
-                         (+ year 2347))
-                       2820)
-                  768)
-              683)
-           2820)
-      683))
-
-(defun persian-calendar-last-day-of-month (month year)
-  "Return last day of MONTH, YEAR on the Persian calendar."
-  (cond
-   ((< month 7) 31)
-   ((or (< month 12) (persian-calendar-leap-year-p year)) 30)
-   (t 29)))
-
-(defun calendar-absolute-from-persian (date)
-  "Compute absolute date from Persian date DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let ((month (extract-calendar-month date))
-        (day (extract-calendar-day date))
-        (year (extract-calendar-year date)))
-    (if (< year 0)
-        (+ (calendar-absolute-from-persian
-            (list month day (1+ (mod year 2820))))
-           (* 1029983 (floor year 2820)))
-      (+ (1- persian-calendar-epoch); Days before epoch
-         (* 365 (1- year)) ; Days in prior years.
-         (* 683        ; Leap days in prior 2820-year cycles
-            (floor (+ year 2345) 2820))
-         (* 186        ; Leap days in prior 768 year cycles
-            (floor (mod (+ year 2345) 2820) 768))
-         (floor; Leap years in current 768 or 516 year cycle
-          (* 683 (mod (mod (+ year 2345) 2820) 768))
-          2820)
-         -568          ; Leap years in Persian years -2345...-1
-         (calendar-sum ; Days in prior months this year.
-          m 1 (< m month)
-          (persian-calendar-last-day-of-month m year))
-         day))))        ; Days so far this month.
-
-(defun calendar-persian-year-from-absolute (date)
-  "Persian year corresponding to the absolute DATE."
-  (let* ((d0        ; Prior days since start of 2820 cycles
-          (- date (calendar-absolute-from-persian (list 1 1 -2345))))
-         (n2820     ; Completed 2820-year cycles
-          (floor d0 1029983))
-         (d1        ; Prior days not in n2820
-          (mod d0 1029983))
-         (n768      ; 768-year cycles not in n2820
-          (floor d1 280506))
-         (d2        ; Prior days not in n2820 or n768
-          (mod d1 280506))
-         (n1        ; Years not in n2820 or n768
-          ; we want is
-          ; (floor (+ (* 2820 d2) (* 2820 366)) 1029983))
-          ; but that causes overflow, so we use
-          (let ((a (floor d2 366)); we use 366 as the divisor because
-                                  ; (2820*366 mod 1029983) is small
-                (b (mod d2 366)))
-            (+ 1 a (floor (+ (* 2137 a) (* 2820 b) 2137) 1029983))))
-         (year (+ (* 2820 n2820); Complete 2820 year cycles
-                  (* 768 n768)  ; Complete 768 year cycles
-                  (if           ; Remaining years
-                      ; Last day of 2820 year cycle
-                      (= d1 1029617)
-                      (1- n1)
-                    n1)
-                  -2345)))      ; Years before year 1
-    (if (< year 1)
-        (1- year); No year zero
-      year)))
-
-(defun calendar-persian-from-absolute (date)
-  "Compute the Persian equivalent for absolute date DATE.
-The result is a list of the form (MONTH DAY YEAR).
-The absolute date is the number of days elapsed since the imaginary
-Gregorian date Sunday, December 31, 1 BC."
-  (let* ((year (calendar-persian-year-from-absolute date))
-         (month         ; Search forward from Farvardin
-          (1+ (calendar-sum m 1
-                            (> date
-                               (calendar-absolute-from-persian
-                                (list
-                                 m
-                                 (persian-calendar-last-day-of-month m year)
-                                 year)))
-                            1)))
-         (day           ; Calculate the day by subtraction
-          (- date (1- (calendar-absolute-from-persian
-                       (list month 1 year))))))
-    (list month day year)))
-
-(defun calendar-persian-date-string (&optional date)
-  "String of Persian date of Gregorian DATE.
-Defaults to today's date if DATE is not given."
-  (let* ((persian-date (calendar-persian-from-absolute
-                       (calendar-absolute-from-gregorian
-                        (or date (calendar-current-date)))))
-         (y (extract-calendar-year persian-date))
-         (m (extract-calendar-month persian-date)))
-    (let ((monthname (aref persian-calendar-month-name-array (1- m)))
-          (day (int-to-string (extract-calendar-day persian-date)))
-          (dayname nil)
-          (month (int-to-string m))
-          (year (int-to-string y)))
-      (mapconcat 'eval calendar-date-display-form ""))))
-
-(defun calendar-print-persian-date ()
-  "Show the Persian calendar equivalent of the selected date."
-  (interactive)
-  (message "Persian date: %s"
-           (calendar-persian-date-string (calendar-cursor-to-date t))))
-
-(defun calendar-goto-persian-date (date &optional noecho)
-  "Move cursor to Persian date DATE.
-Echo Persian date unless NOECHO is t."
-  (interactive (persian-prompt-for-date))
-  (calendar-goto-date (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-persian date)))
-  (or noecho (calendar-print-persian-date)))
-
-(defun persian-prompt-for-date ()
-  "Ask for a Persian date."
-  (let* ((today (calendar-current-date))
-         (year (calendar-read
-                "Persian calendar year (not 0): "
-                '(lambda (x) (/= x 0))
-                (int-to-string
-                 (extract-calendar-year
-                  (calendar-persian-from-absolute
-                   (calendar-absolute-from-gregorian today))))))
-         (completion-ignore-case t)
-         (month (cdr (assoc
-                      (capitalize
-                       (completing-read
-                        "Persian calendar month name: "
-                        (mapcar 'list
-                                (append persian-calendar-month-name-array nil))
-                        nil t))
-                      (calendar-make-alist persian-calendar-month-name-array
-                                           1 'capitalize))))
-         (last (persian-calendar-last-day-of-month month year))
-         (day (calendar-read
-               (format "Persian calendar day (1-%d): " last)
-               '(lambda (x) (and (< 0 x) (<= x last))))))
-    (list (list month day year))))
-
-(defun diary-persian-date ()
-  "Persian calendar equivalent of date diary entry."
- (calendar-persian-date-string (calendar-cursor-to-date t)))
-
-(provide 'cal-persia)
-
-;;; cal-persia.el ends here
diff --git a/lisp/calendar/cal-tex.el b/lisp/calendar/cal-tex.el
deleted file mode 100644
index 315d2b45b4e..00000000000
--- a/lisp/calendar/cal-tex.el
+++ /dev/null
@@ -1,1608 +0,0 @@
-;;; cal-tex.el --- calendar functions for printing calendars with LaTeX.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Steve Fisk <fisk@bowdoin.edu>
-;;      Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: Calendar, LaTeX
-
-;; 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 collection of functions implements the creation of LaTeX calendars
-;; based on the user's holiday choices and diary file.
-
-;; TO DO
-;;
-;;     (*)  Add holidays and diary entries to daily calendar.
-;;
-;;     (*)  Add diary entries to weekly calendar functions.
-;;
-;;     (*)  Make calendar styles for A4 paper.
-;;
-;;     (*)  Make daily and monthly styles Filofax paper.
-;;
-;;     (*)  Improve the LaTeX command that produces the boxes in the monthly
-;;          calendar to eliminate slight gap--what causes it?!
-
-;;; Code:
-
-(require 'calendar)
-
-(autoload 'list-diary-entries "diary-lib" nil t)
-(autoload 'calendar-holiday-list "holidays" nil t)
-(autoload 'calendar-iso-from-absolute "cal-iso" nil t)
-
-;;;
-;;; Customizable variables 
-;;;
-
-(defvar cal-tex-which-days '(0 1 2 3 4 5 6)
-  "*The days of the week that are displayed on the portrait monthly calendar.
-Sunday is 0, Monday is 1, and so on.  The default is to print from Sunday to
-Saturday.  For example, use
-
-                    (setq cal-tex-which-days '(1 3 5))
-
-to only print Monday, Wednesday, Friday.")
-
-(defvar cal-tex-holidays t
-  "*If t (default), then the holidays are also printed.
-If finding the holidays is too slow, set this to nil.")
-
-(defvar cal-tex-diary nil
-  "*If t, the diary entries are printed in the calendar.")
-
-(defvar cal-tex-daily-string
-  '(let* ((year (extract-calendar-year date))
-          (day  (calendar-day-number date))
-          (days-remaining (- (calendar-day-number (list 12 31 year)) day)))
-     (format "%d/%d" day  days-remaining))
-  "*An expression in the variable `date' whose value is placed on date.
-The string resulting from evaluating this expression is placed at the bottom
-center of `date' on the monthly calendar, next to the date in the weekly
-calendars, and in the top center of daily calendars.
-
-Default is ordinal day number of the year and the number of days remaining.
-As an example of what you do, setting this to
-
-    '(progn
-       (require 'cal-hebrew)
-       (calendar-hebrew-date-string date))
-
-will put the Hebrew date at the bottom of each day.")
-
-(defvar cal-tex-buffer "calendar.tex"
-  "*The name for the tex-ed calendar.")
-
-(defvar cal-tex-24 nil
-  "*If t, use a 24 hour clock in the daily calendar.")
-
-(defvar cal-tex-daily-start 8
-  "*The first hour of the daily calendar page.")
-
-(defvar cal-tex-daily-end 20
-  "*The last hour of the daily calendar page.")
-
-;;;
-;;; Definitions for LaTeX code
-;;;
-
-(defvar  cal-tex-day-prefix "\\caldate{%s}{%s}"
-  "The initial LaTeX code for a day.  
-The holidays, diary entries, bottom string, and the text follow.")
- 
-(defvar cal-tex-day-name-format "\\myday{%s}%%"
-  "The format for LaTeX code for a day name.  The names are taken from
-calendar-day-name-array.")
-
-(defvar cal-tex-cal-one-month
-"\\def\\calmonth#1#2%
-{\\begin{center}%
-\\Huge\\bf\\uppercase{#1} #2 \\\\[1cm]%
-\\end{center}}% 
-\\vspace*{-1.5cm}%
-%
-"
-  "LaTeX code for the month header")
-
-(defvar cal-tex-cal-multi-month
-"\\def\\calmonth#1#2#3#4%
-{\\begin{center}%
-\\Huge\\bf #1 #2---#3 #4\\\\[1cm]%
-\\end{center}}% 
-\\vspace*{-1.5cm}%
-%
-"
-  "LaTeX code for the month header")
-
-(defvar cal-tex-myday
-"\\renewcommand{\\myday}[1]%
-{\\makebox[\\cellwidth]{\\hfill\\large\\bf#1\\hfill}}
-%
-"
-  "LaTeX code for a day heading")
-
-(defvar cal-tex-caldate
-"\\fboxsep=0pt
-\\long\\def\\caldate#1#2#3#4#5#6{%
-    \\fbox{\\hbox to\\cellwidth{%
-     \\vbox to\\cellheight{%
-       \\hbox to\\cellwidth{%
-          {\\hspace*{1mm}\\Large \\bf \\strut #2}\\hspace{.05\\cellwidth}%
-          \\raisebox{\\holidaymult\\cellheight}%
-                   {\\parbox[t]{.75\\cellwidth}{\\tiny \\raggedright #4}}}
-       \\hbox to\\cellwidth{%
-           \\hspace*{1mm}\\parbox{.95\\cellwidth}{\\tiny \\raggedright #3}}
-       \\hspace*{1mm}%
-       \\hbox to\\cellwidth{#6}%
-       \\vfill%
-       \\hbox to\\cellwidth{\\hfill \\tiny #5 \\hfill}%
-       \\vskip 1.4pt}%
-     \\hskip -0.4pt}}}
-"
-  "LaTeX code to insert one box with date info in calendar.
-This definition is the heart of the calendar!")
-
-(defun cal-tex-list-holidays (d1 d2)
-  "Generate a list of all holidays from absolute date D1 to D2."
-  (let* ((result nil)
-         (start (calendar-gregorian-from-absolute d1))
-         (start-month (extract-calendar-month start))
-         (start-year (extract-calendar-year start)))
-    (increment-calendar-month start-month start-year 1)
-    (let* ((end (calendar-gregorian-from-absolute d2))
-           (end-month (extract-calendar-month end))
-           (end-year (extract-calendar-year end)))
-      (if (= (extract-calendar-day end) 1)
-          (increment-calendar-month end-month end-year -1))
-      (let* ((s (calendar-absolute-from-gregorian
-                 (list start-month 1 start-year)))
-             (e (calendar-absolute-from-gregorian
-                 (list end-month 1 end-year)))
-             (d s)
-             (never t)
-             (displayed-month start-month)
-             (displayed-year start-year))
-        (while (or never (<= d e))
-          (setq result (append result (calendar-holiday-list)))
-          (setq never nil)
-          (increment-calendar-month displayed-month displayed-year 3)
-          (setq d (calendar-absolute-from-gregorian
-                   (list displayed-month 1 displayed-year))))))
-    (let ((in-range)
-          (p result))
-      (while p
-        (and (car (car p))
-             (let ((a (calendar-absolute-from-gregorian (car (car p)))))
-               (and (<= d1 a) (<= a d2)))
-             (setq in-range (append (list (car p)) in-range)))
-        (setq p (cdr p)))
-      in-range)))
-
-(defun cal-tex-list-diary-entries (d1 d2)
-  "Generate a list of all diary-entries from absolute date D1 to D2."
-  (let ((diary-display-hook nil))
-    (list-diary-entries
-     (calendar-gregorian-from-absolute d1)
-     (1+ (- d2 d1)))))
-
-(defun cal-tex-preamble (&optional args)
-  "Insert the LaTeX preamble.
-Preamble Includes initial definitions for various LaTeX commands.
-Optional ARGS are included."
-  (set-buffer (get-buffer-create cal-tex-buffer))
-  (erase-buffer)
-  (insert "\\documentstyle")
-  (if args
-      (insert "[" args "]"))
-  (insert "{article}\n"
-          "\\hbadness 20000
-\\hfuzz=1000pt
-\\vbadness 20000
-\\marginparwidth 0pt
-\\oddsidemargin  -2cm
-\\evensidemargin -2cm
-\\marginparsep   0pt
-\\topmargin      0pt
-\\textwidth      7.5in
-\\textheight     9.5in
-\\newlength{\\cellwidth}
-\\newlength{\\cellheight}
-\\newlength{\\boxwidth}
-\\newlength{\\boxheight}
-\\newlength{\\cellsize}
-\\newcommand{\\myday}[1]{}
-\\newcommand{\\caldate}[6]{}
-\\newcommand{\\nocaldate}[6]{}
-\\newcommand{\\calsmall}[6]{}
-%
-"))
-
-;;;
-;;;  Yearly calendars
-;;;
-
-(defun cal-tex-cursor-year (&optional arg)
-  "Make a buffer with LaTeX commands for the year cursor is on.
-Optional prefix argument specifies number of years."
-  (interactive "P")
-  (cal-tex-year (extract-calendar-year (calendar-cursor-to-date t))
-                (if arg arg 1)))
-
-(defun cal-tex-cursor-year-landscape (&optional arg)
-  "Make a buffer with LaTeX commands for the year cursor is on.
-Optional prefix argument specifies number of years."
-  (interactive "P")
-  (cal-tex-year (extract-calendar-year (calendar-cursor-to-date t))
-                (if arg arg 1)
-                t))
-
-(defun cal-tex-year (year n &optional landscape)
-  "Make a one page yearly calendar of YEAR; do this for N years.
-There are four rows of three months each, unless optional LANDSCAPE is t,
-in which case the calendar isprinted in landscape mode with three rows of
-four months each."
-  (cal-tex-insert-preamble 1 landscape "12pt")
-  (if landscape
-      (cal-tex-vspace "-.6cm")
-    (cal-tex-vspace "-3.1cm"))
-  (calendar-for-loop j from 1 to n do
-     (insert "\\vfill%\n")
-     (cal-tex-b-center)
-     (cal-tex-Huge (number-to-string year))
-     (cal-tex-e-center)
-     (cal-tex-vspace "1cm")
-     (cal-tex-b-center)
-     (cal-tex-b-parbox "l" (if landscape "5.9in" "4.3in"))
-     (insert "\n")
-     (cal-tex-noindent)
-     (cal-tex-nl)
-     (calendar-for-loop i from 1 to 12 do
-        (insert (cal-tex-mini-calendar i year "month" "1.1in" "1in"))
-        (insert "\\month")
-        (cal-tex-hspace "0.5in")
-        (if (zerop (mod i (if landscape 4 3)))
-            (cal-tex-nl "0.5in")))
-     (cal-tex-e-parbox)
-     (cal-tex-e-center)
-     (insert "\\vfill%\n")
-     (setq year (1+ year))
-     (if (/= j n)
-         (cal-tex-newpage)
-       (cal-tex-end-document))
-     (run-hooks 'cal-tex-year-hook))
-  (run-hooks 'cal-tex-hook))
-
-(defun cal-tex-cursor-filofax-year (&optional arg)
-  "Make a Filofax one page yearly calendar of year indicated by cursor.
-Optional parameter specifies number of years."
-  (interactive "P")
-  (let* ((n (if arg arg 1))
-         (year (extract-calendar-year (calendar-cursor-to-date t))))
-    (cal-tex-preamble "twoside")
-    (cal-tex-cmd "\\textwidth 3.25in")
-    (cal-tex-cmd "\\textheight 6.5in")
-    (cal-tex-cmd "\\oddsidemargin 1.675in")
-    (cal-tex-cmd "\\evensidemargin 1.675in")
-    (cal-tex-cmd "\\topmargin 0pt")
-    (cal-tex-cmd "\\headheight -0.875in")
-    (cal-tex-cmd "\\fboxsep 0.5mm")
-    (cal-tex-cmd "\\pagestyle{empty}")
-    (cal-tex-b-document)
-    (cal-tex-cmd "\\vspace*{0.25in}")
-    (calendar-for-loop j from 1 to n do
-       (insert (format "\\hfil {\\Large \\bf %s} \\hfil\\\\\n" year))
-       (cal-tex-b-center)
-       (cal-tex-b-parbox "l" "\\textwidth")
-       (insert "\n")
-       (cal-tex-noindent)
-       (cal-tex-nl)
-       (calendar-for-loop i from 1 to 12 do
-          (insert (cal-tex-mini-calendar i year
-                                         (calendar-month-name i)
-                                         "1in" ".9in" "tiny" "0.6mm")))
-       (insert
-"\\noindent\\fbox{\\January}\\fbox{\\February}\\fbox{\\March}\\\\
-\\noindent\\fbox{\\April}\\fbox{\\May}\\fbox{\\June}\\\\
-\\noindent\\fbox{\\July}\\fbox{\\August}\\fbox{\\September}\\\\
-\\noindent\\fbox{\\October}\\fbox{\\November}\\fbox{\\December}
-")
-       (cal-tex-e-parbox)
-       (cal-tex-e-center)
-       (setq year (1+ year))
-       (if (= j n)
-           (cal-tex-end-document)
-         (cal-tex-newpage)
-         (cal-tex-cmd "\\vspace*{0.25in}"))
-       (run-hooks 'cal-tex-year-hook))
-    (run-hooks 'cal-tex-hook)))
-
-;;;
-;;;  Monthly calendars
-;;;
-
-(defun cal-tex-cursor-month-landscape (&optional arg)
-  "Make a buffer with LaTeX commands for the month cursor is on.
-Optional prefix argument specifies number of months to be produced.
-The output is in landscape format, one month to a page."
-  (interactive "P")
-  (let* ((n (if arg arg 1))
-         (date (calendar-cursor-to-date t))
-         (month (extract-calendar-month date))
-         (year (extract-calendar-year date))
-         (end-month month)
-         (end-year year)
-         (cal-tex-which-days '(0 1 2 3 4 5 6)))
-    (increment-calendar-month end-month end-year (1- n))
-    (let ((diary-list (if cal-tex-diary
-                          (cal-tex-list-diary-entries
-                           (calendar-absolute-from-gregorian
-                            (list month 1 year))
-                           (calendar-absolute-from-gregorian
-                            (list end-month
-                                  (calendar-last-day-of-month
-                                   end-month end-year)
-                                  end-year)))))
-          (holidays (if cal-tex-holidays
-                        (cal-tex-list-holidays
-                         (calendar-absolute-from-gregorian
-                          (list month 1 year))
-                         (calendar-absolute-from-gregorian
-                          (list end-month
-                                (calendar-last-day-of-month end-month end-year)
-                                end-year)))))
-          (other-month)
-          (other-year)
-          (small-months-at-start))
-      (cal-tex-insert-preamble (cal-tex-number-weeks month year 1) t "12pt")
-      (cal-tex-cmd cal-tex-cal-one-month)
-      (calendar-for-loop i from 1 to n do
-         (setq other-month month)
-         (setq other-year year)
-         (increment-calendar-month other-month other-year -1)
-         (insert (cal-tex-mini-calendar other-month other-year "lastmonth"
-                                        "\\cellwidth" "\\cellheight"))
-         (increment-calendar-month other-month other-year 2)
-         (insert (cal-tex-mini-calendar other-month other-year "nextmonth"
-                                        "\\cellwidth" "\\cellheight"))
-         (cal-tex-insert-month-header 1 month year month year)
-         (cal-tex-insert-day-names)
-         (cal-tex-nl ".2cm")
-         (setq small-months-at-start
-               (< 1 (mod (- (calendar-day-of-week (list month 1 year))
-                            calendar-week-start-day)
-                         7)))
-         (if small-months-at-start
-             (insert "\\lastmonth\\nextmonth\\hspace*{-2\\cellwidth}"))
-         (cal-tex-insert-blank-days month year cal-tex-day-prefix)
-         (cal-tex-insert-days month year diary-list holidays
-                              cal-tex-day-prefix)
-         (cal-tex-insert-blank-days-at-end month year cal-tex-day-prefix)
-         (if (and (not small-months-at-start)
-                  (< 1 (mod (- (1- calendar-week-start-day)
-                               (calendar-day-of-week
-                                (list month
-                                      (calendar-last-day-of-month month year)
-                                      year)))
-                                 7)))
-             (insert "\\vspace*{-\\cellwidth}\\hspace*{-2\\cellwidth}"
-                     "\\lastmonth\\nextmonth"))
-         (if (/= i n)
-             (progn
-               (run-hooks 'cal-tex-month-hook)
-               (cal-tex-newpage)
-               (increment-calendar-month month year 1)
-               (cal-tex-vspace "-2cm")
-               (cal-tex-insert-preamble
-                (cal-tex-number-weeks month year 1) t "12pt" t))))
-      (cal-tex-end-document)
-      (run-hooks 'cal-tex-hook))))
-
-(defun cal-tex-cursor-month (arg)
-  "Make a buffer with LaTeX commands for the month cursor is on.
-Optional prefix argument specifies number of months to be produced.
-Calendar is condensed onto one page."
-  (interactive "P")
-  (let* ((date (calendar-cursor-to-date t))
-         (month (extract-calendar-month date))
-         (year (extract-calendar-year date))
-         (end-month month)
-         (end-year year)
-         (n (if arg arg 1)))
-    (increment-calendar-month end-month end-year (1- n))
-    (let ((diary-list (if cal-tex-diary
-                          (cal-tex-list-diary-entries
-                           (calendar-absolute-from-gregorian
-                            (list month 1 year))
-                           (calendar-absolute-from-gregorian
-                            (list end-month
-                                  (calendar-last-day-of-month
-                                   end-month end-year)
-                                  end-year)))))
-          (holidays (if cal-tex-holidays
-                        (cal-tex-list-holidays
-                         (calendar-absolute-from-gregorian
-                          (list month 1 year))
-                         (calendar-absolute-from-gregorian
-                          (list end-month
-                                (calendar-last-day-of-month end-month end-year)
-                                end-year)))))
-          (other-month)
-          (other-year))
-      (cal-tex-insert-preamble (cal-tex-number-weeks month year n) nil"12pt")
-      (if (> n 1)
-          (cal-tex-cmd cal-tex-cal-multi-month)
-        (cal-tex-cmd cal-tex-cal-one-month))
-      (cal-tex-insert-month-header n month year end-month end-year)
-      (cal-tex-insert-day-names)
-      (cal-tex-nl ".2cm")
-      (cal-tex-insert-blank-days month year cal-tex-day-prefix)
-      (calendar-for-loop i from 1 to n do
-         (setq other-month month)
-         (setq other-year year)
-         (cal-tex-insert-days month year diary-list holidays
-                              cal-tex-day-prefix)
-         (increment-calendar-month month year 1))
-      (cal-tex-insert-blank-days-at-end end-month end-year cal-tex-day-prefix)
-      (cal-tex-end-document)))
-  (run-hooks 'cal-tex-hook))
-
-(defun cal-tex-insert-days (month year diary-list holidays day-format) 
-  "Insert LaTeX commands for a range of days in monthly calendars.
-LaTeX commands are inserted for the days of the MONTH in YEAR.
-Diary entries on DIARY-LIST are included. Holidays on HOLIDAYS are included.
-Each day is formatted using format DAY-FORMAT."
-  (let* ((blank-days;; at start of month
-          (mod
-           (- (calendar-day-of-week (list month 1 year))
-              calendar-week-start-day)
-           7))
-         (date)
-         (last (calendar-last-day-of-month month year)))
-    (calendar-for-loop i from 1 to last do
-       (setq date (list month i year))
-       (if (memq (calendar-day-of-week date) cal-tex-which-days)
-           (progn 
-             (insert (format day-format (calendar-month-name month) i))
-             (cal-tex-arg (cal-tex-latexify-list diary-list date))
-             (cal-tex-arg (cal-tex-latexify-list holidays date))
-             (cal-tex-arg (eval cal-tex-daily-string))
-             (cal-tex-arg)
-             (cal-tex-comment)))
-       (if (and (zerop (mod (+ i blank-days) 7))
-                (/= i last))
-           (progn
-             (cal-tex-hfill)
-             (cal-tex-nl))))))
-
-(defun cal-tex-insert-day-names ()
-  "Insert the names of the days at top of a monthly calendar."
-  (calendar-for-loop i from 0 to 6 do
-     (if (memq i cal-tex-which-days)
-         (insert (format cal-tex-day-name-format 
-                         (aref calendar-day-name-array 
-                               (mod (+ calendar-week-start-day i) 7)))))
-     (cal-tex-comment)))
-
-(defun cal-tex-insert-month-header (n month year end-month end-year)
-  "Create a title for a calendar.
-A title is inserted for a calendar with N months starting with 
-MONTH YEAR and ending with END-MONTH END-YEAR."
-  (let ( (month-name (calendar-month-name  month))
-         (end-month-name (calendar-month-name  end-month)))
-    (if (= 1 n)
-        (insert (format "\\calmonth{%s}{%s}\n\\vspace*{-0.5cm}"
-                month-name year) )       
-        (insert (format "\\calmonth{%s}{%s}{%s}{%s}\n\\vspace*{-0.5cm}"
-                month-name year end-month-name end-year))))
-  (cal-tex-comment))
-
-(defun cal-tex-insert-blank-days (month year day-format)
-  "Insert code for initial days not in calendar.
-Insert LaTeX code for the blank days at the beginning of the MONTH in
-YEAR.  The entry is formatted using DAY-FORMAT.  If the entire week is
-blank, no days are inserted."
-  (if (cal-tex-first-blank-p month year)
-      (let* ((blank-days;; at start of month
-              (mod
-               (- (calendar-day-of-week (list month 1 year))
-                  calendar-week-start-day)
-               7)))
-        (calendar-for-loop i from 0 to (1- blank-days) do 
-            (if (memq i cal-tex-which-days)
-                (insert (format day-format " " " ") "{}{}{}{}%\n"))))))
-
-(defun cal-tex-insert-blank-days-at-end (month year day-format)
-  "Insert code for final days not in calendar.
-Insert LaTeX code for the blank days at the end of the MONTH in YEAR.
-The entry is formatted using DAY-FORMAT."
-  (if (cal-tex-last-blank-p month year)
-      (let* ((last-day (calendar-last-day-of-month month year))
-             (blank-days;; at end of month
-              (mod
-               (- (calendar-day-of-week (list month last-day year))
-                  calendar-week-start-day)
-               7)))
-        (calendar-for-loop i from (1+ blank-days) to 6 do 
-           (if (memq i cal-tex-which-days)
-               (insert (format day-format "" "") "{}{}{}{}%\n"))))))
-
-(defun cal-tex-first-blank-p (month year)
-  "Determine if any days of the first week will be printed.
-Return t if there will there be any days of the first week printed
-in the calendar starting in MONTH YEAR."
-  (let ((any-days nil)
-        (the-saturday))                 ;the day of week of 1st Saturday
-    (calendar-for-loop i from 1 to 7 do
-       (if (= 6 (calendar-day-of-week (list month i year)))
-           (setq the-saturday i)))
-    (calendar-for-loop i from 1 to the-saturday do
-       (if (memq (calendar-day-of-week (list month i year))
-                 cal-tex-which-days)
-           (setq any-days t)))
-    any-days))
-
-(defun cal-tex-last-blank-p (month year)
-  "Determine if any days of the last week will be printed.
-Return t if there will there be any days of the last week printed
-in the calendar starting in MONTH YEAR."
-  (let ((any-days nil)
-        (last-day (calendar-last-day-of-month month year))
-        (the-sunday))                   ;the day of week of last Sunday
-    (calendar-for-loop i from (- last-day 6) to last-day do
-       (if (= 0 (calendar-day-of-week (list month i year)))
-           (setq the-sunday i)))
-    (calendar-for-loop i from the-sunday to last-day do
-       (if (memq (calendar-day-of-week (list month i year))
-                 cal-tex-which-days)
-           (setq any-days t)))
-    any-days))
-
-(defun cal-tex-number-weeks (month year n)
-  "Determine the number of weeks in a range of dates.
-Compute the number of  weeks in the calendar starting with MONTH and YEAR, 
-and lasting N months, including only the days in WHICH-DAYS. As it stands, 
-this is only an upper bound."
-  (let ((d (list month 1 year)))
-    (increment-calendar-month month year (1- n))
-    (/ (- (calendar-dayname-on-or-before
-           calendar-week-start-day
-           (+ 7 (calendar-absolute-from-gregorian
-                   (list month (calendar-last-day-of-month month year) year))))
-          (calendar-dayname-on-or-before
-           calendar-week-start-day
-           (calendar-absolute-from-gregorian d)))
-       7)))
-
-;;;
-;;; Weekly calendars
-;;;
-
-(defun cal-tex-cursor-week (&optional arg)
-  "Make a buffer with LaTeX commands for a two-page one-week calendar.
-It applies to the week that point is in.
-Optional prefix argument specifies number of weeks.
-Holidays are included if `cal-tex-holidays' is t."
-  (interactive "P")
-  (let* ((n (if arg arg 1))
-         (date (calendar-gregorian-from-absolute
-                (calendar-dayname-on-or-before
-                 calendar-week-start-day
-                 (calendar-absolute-from-gregorian
-                  (calendar-cursor-to-date t)))))
-         (month (extract-calendar-month date))
-         (year (extract-calendar-year date))
-         (holidays (if cal-tex-holidays
-                       (cal-tex-list-holidays
-                        (calendar-absolute-from-gregorian date)
-                        (+ (* 7 n)
-                           (calendar-absolute-from-gregorian date))))))
-    (cal-tex-preamble "11pt")
-    (cal-tex-cmd "\\textwidth   6.5in")
-    (cal-tex-cmd "\\textheight 10.5in")
-    (cal-tex-cmd "\\oddsidemargin 0in")
-    (cal-tex-cmd "\\evensidemargin 0in")
-    (insert cal-tex-LaTeX-hourbox)
-    (cal-tex-b-document)
-    (cal-tex-cmd "\\pagestyle{empty}")
-    (calendar-for-loop i from 1 to n do
-       (cal-tex-vspace "-1.5in")
-       (cal-tex-b-center)
-       (cal-tex-Huge-bf (format "\\uppercase{%s}"
-                                (calendar-month-name month)))
-       (cal-tex-hspace "2em")
-       (cal-tex-Huge-bf (number-to-string year))
-       (cal-tex-nl ".5cm")
-       (cal-tex-e-center)
-       (cal-tex-hspace "-.2in")
-       (cal-tex-b-parbox "l" "7in")
-       (calendar-for-loop j from 1 to 7 do 
-          (cal-tex-week-hours date holidays "3.1")
-          (setq date (cal-tex-incr-date date)))
-       (cal-tex-e-parbox)
-       (setq month (extract-calendar-month date))
-       (setq year (extract-calendar-year date))
-       (if (/= i n)
-           (progn
-             (run-hooks 'cal-tex-week-hook)
-             (cal-tex-newpage))))
-    (cal-tex-end-document)
-    (run-hooks 'cal-tex-hook)))
-
-(defun cal-tex-cursor-week2 (&optional arg)
-  "Make a buffer with LaTeX commands for a two-page one-week calendar.
-It applies to the week that point is in.
-Optional prefix argument specifies number of weeks.
-Holidays are included if `cal-tex-holidays' is t."
-  (interactive "P")
-  (let* ((n (if arg arg 1))
-         (date (calendar-gregorian-from-absolute
-                (calendar-dayname-on-or-before
-                 calendar-week-start-day
-                 (calendar-absolute-from-gregorian
-                  (calendar-cursor-to-date t)))))
-         (month (extract-calendar-month date))
-         (year (extract-calendar-year date))
-         (d date)
-         (holidays (if cal-tex-holidays
-                       (cal-tex-list-holidays
-                        (calendar-absolute-from-gregorian date)
-                        (+ (* 7 n)
-                           (calendar-absolute-from-gregorian date))))))
-    (cal-tex-preamble "12pt")
-    (cal-tex-cmd "\\textwidth   6.5in")
-    (cal-tex-cmd "\\textheight 10.5in")
-    (cal-tex-cmd "\\oddsidemargin 0in")
-    (cal-tex-cmd "\\evensidemargin 0in")
-    (insert cal-tex-LaTeX-hourbox)
-    (cal-tex-b-document)
-    (cal-tex-cmd "\\pagestyle{empty}")
-    (calendar-for-loop i from 1 to n do
-       (cal-tex-vspace "-1.5in")
-       (cal-tex-b-center)
-       (cal-tex-Huge-bf (format "\\uppercase{%s}"
-                                (calendar-month-name month)))
-       (cal-tex-hspace "2em")
-       (cal-tex-Huge-bf (number-to-string year))
-       (cal-tex-nl ".5cm")
-       (cal-tex-e-center)
-       (cal-tex-hspace "-.2in")
-       (cal-tex-b-parbox "l" "\\textwidth")
-       (calendar-for-loop j from 1 to 3 do 
-          (cal-tex-week-hours date holidays "5")
-          (setq date (cal-tex-incr-date date)))
-       (cal-tex-e-parbox)
-       (cal-tex-nl)
-       (insert (cal-tex-mini-calendar
-                (extract-calendar-month (cal-tex-previous-month date))
-                (extract-calendar-year (cal-tex-previous-month date))
-                "lastmonth" "1.1in" "1in"))
-       (insert (cal-tex-mini-calendar
-                (extract-calendar-month date)
-                (extract-calendar-year date)
-                "thismonth" "1.1in" "1in"))
-       (insert (cal-tex-mini-calendar
-                (extract-calendar-month (cal-tex-next-month date))
-                (extract-calendar-year (cal-tex-next-month date))
-                "nextmonth" "1.1in" "1in"))
-       (insert "\\hbox to \\textwidth{")
-       (cal-tex-hfill)
-       (insert "\\lastmonth")
-       (cal-tex-hfill)
-       (insert "\\thismonth")
-       (cal-tex-hfill)
-       (insert "\\nextmonth")
-       (cal-tex-hfill)
-       (insert "}")
-       (cal-tex-nl)
-       (cal-tex-b-parbox "l" "\\textwidth")
-       (calendar-for-loop j from 4 to 7 do 
-                          (cal-tex-week-hours date holidays "5")
-                          (setq date (cal-tex-incr-date date)))
-       (cal-tex-e-parbox)
-       (setq month (extract-calendar-month date))
-       (setq year (extract-calendar-year date))
-       (if (/= i n)
-           (progn
-             (run-hooks 'cal-tex-week-hook)
-             (cal-tex-newpage))))
-    (cal-tex-end-document)
-    (run-hooks 'cal-tex-hook)))
-
-(defun cal-tex-cursor-week-iso (&optional arg)
-  "Make a buffer with LaTeX commands for a one page ISO-style weekly calendar.
-Optional prefix argument specifies number of weeks.
-Diary entries are included if `cal-tex-diary' is t.
-Holidays are included if `cal-tex-holidays' is t."
-  (interactive "P")
-  (let* ((n (if arg arg 1))
-         (date (calendar-gregorian-from-absolute
-                (calendar-dayname-on-or-before
-                 1
-                 (calendar-absolute-from-gregorian
-                  (calendar-cursor-to-date t)))))
-         (month (extract-calendar-month date))
-         (year (extract-calendar-year date))
-         (day (extract-calendar-day date))
-         (holidays (if cal-tex-holidays
-                       (cal-tex-list-holidays
-                        (calendar-absolute-from-gregorian date)
-                        (+ (* 7 n)
-                           (calendar-absolute-from-gregorian date)))))
-         (diary-list (if cal-tex-diary
-                         (cal-tex-list-diary-entries
-                          (calendar-absolute-from-gregorian
-                           (list month 1 year))
-                        (+ (* 7 n)
-                           (calendar-absolute-from-gregorian date))))))
-    (cal-tex-preamble "11pt")
-    (cal-tex-cmd "\\textwidth 6.5in")
-    (cal-tex-cmd "\\textheight 10.5in")
-    (cal-tex-cmd "\\oddsidemargin 0in")
-    (cal-tex-cmd "\\evensidemargin 0in")
-    (cal-tex-b-document)
-    (cal-tex-cmd "\\pagestyle{empty}")
-    (calendar-for-loop i from 1 to n do
-       (cal-tex-vspace "-1.5in")
-       (cal-tex-b-center)
-       (cal-tex-Huge-bf
-        (let* ((d (calendar-iso-from-absolute
-                   (calendar-absolute-from-gregorian date))))
-          (format "Week %d of %d"
-                  (extract-calendar-month d)
-                  (extract-calendar-year d))))
-       (cal-tex-nl ".5cm")
-       (cal-tex-e-center)
-       (cal-tex-b-parbox "l" "\\textwidth")
-       (calendar-for-loop j from 1 to 7 do 
-          (cal-tex-b-parbox "t" "\\textwidth")
-          (cal-tex-b-parbox "t" "\\textwidth")
-          (cal-tex-rule "0pt" "\\textwidth" ".2mm")
-          (cal-tex-nl)
-          (cal-tex-b-parbox "t" "\\textwidth")
-          (cal-tex-large-bf (calendar-day-name date))
-          (insert ", ")
-          (cal-tex-large-bf (calendar-month-name month))
-          (insert " ")
-          (cal-tex-large-bf (number-to-string day))
-          (if (not (string= "" (cal-tex-latexify-list holidays date)))
-              (progn
-                (insert ": ")
-                (cal-tex-large-bf (cal-tex-latexify-list holidays date "; "))))
-          (cal-tex-hfill)
-          (insert " " (eval cal-tex-daily-string))
-          (cal-tex-e-parbox)
-          (cal-tex-nl)
-          (cal-tex-noindent)
-          (cal-tex-b-parbox "t" "\\textwidth")
-          (if (not (string= "" (cal-tex-latexify-list diary-list date)))
-              (progn
-                (insert "\\vbox to 0pt{")
-                (cal-tex-large-bf
-                 (cal-tex-latexify-list diary-list date))
-                (insert "}")))
-          (cal-tex-e-parbox)
-          (cal-tex-nl)
-          (setq date (cal-tex-incr-date date))
-          (setq month (extract-calendar-month date))
-          (setq day (extract-calendar-day date))
-          (cal-tex-e-parbox)
-          (cal-tex-e-parbox "2cm")
-          (cal-tex-nl)
-          (setq month (extract-calendar-month date))
-          (setq year (extract-calendar-year date)))
-       (cal-tex-e-parbox)% 
-       (if (/= i n)
-           (progn
-             (run-hooks 'cal-tex-week-hook)
-             (cal-tex-newpage))))
-    (cal-tex-end-document)
-    (run-hooks 'cal-tex-hook)))
-
-(defvar cal-tex-LaTeX-hourbox 
-  "\\newcommand{\\hourbox}[2]%
-{\\makebox[2em]{\\rule{0cm}{#2ex}#1}\\rule{3in}{.15mm}}\n"
-  "One hour and a line on the right.")
-
-(defun cal-tex-week-hours (date holidays height)
-  "Insert hourly entries for DATE with HOLIDAYS, with line height HEIGHT." 
-  (let ((month (extract-calendar-month date))
-        (day   (extract-calendar-day date))
-        (year  (extract-calendar-year date))
-        (afternoon))
-  (cal-tex-comment "begin cal-tex-week-hours")
-  (cal-tex-cmd  "\\ \\\\[-.2cm]")
-  (cal-tex-cmd "\\noindent")
-  (cal-tex-b-parbox "l" "6.8in")
-  (cal-tex-large-bf (calendar-day-name date))
-  (insert ", ")
-  (cal-tex-large-bf (calendar-month-name month))
-  (insert " ")
-  (cal-tex-large-bf (number-to-string day))
-  (if (not (string= "" (cal-tex-latexify-list holidays date)))
-      (progn
-        (insert ": ")
-        (cal-tex-large-bf (cal-tex-latexify-list holidays date "; "))))
-  (cal-tex-hfill)
-  (insert " " (eval cal-tex-daily-string))
-  (cal-tex-e-parbox)
-  (cal-tex-nl "-.3cm")
-  (cal-tex-rule "0pt" "6.8in" ".2mm")
-  (cal-tex-nl "-.1cm")
-  (calendar-for-loop i from 8 to 12 do
-     (if cal-tex-24
-         (setq afternoon (+ i 5))
-       (setq afternoon (- i 7)))
-     (cal-tex-cmd "\\hourbox"  (number-to-string i))
-     (cal-tex-arg height)
-     (cal-tex-hspace ".4cm")
-     (cal-tex-cmd "\\hourbox"  (number-to-string afternoon))
-     (cal-tex-arg height)
-     (cal-tex-nl))))
-
-(defun cal-tex-cursor-week-monday (&optional arg)
-  "Make a buffer with LaTeX commands for a two-page one-week calendar.
-It applies to the week that point is in, and starts on Monday.
-Optional prefix argument specifies number of weeks.
-Holidays are included if `cal-tex-holidays' is t."
-  (interactive "P")
-  (let* ((n (if arg arg 1))
-         (date (calendar-gregorian-from-absolute
-                (calendar-dayname-on-or-before
-                 0
-                 (calendar-absolute-from-gregorian
-                  (calendar-cursor-to-date t))))))
-    (cal-tex-preamble "11pt")
-    (cal-tex-cmd "\\textwidth   6.5in")
-    (cal-tex-cmd "\\textheight 10.5in")
-    (cal-tex-cmd "\\oddsidemargin 0in")
-    (cal-tex-cmd "\\evensidemargin 0in")
-    (cal-tex-b-document)
-    (calendar-for-loop i from 1 to n do
-       (cal-tex-vspace "-1cm")
-       (insert "\\noindent ")
-       (cal-tex-weekly4-box (cal-tex-incr-date date) nil)
-       (cal-tex-weekly4-box (cal-tex-incr-date date 4) nil)
-       (cal-tex-nl ".2cm")
-       (cal-tex-weekly4-box (cal-tex-incr-date date 2) nil)
-       (cal-tex-weekly4-box (cal-tex-incr-date date 5) nil)
-       (cal-tex-nl ".2cm")
-       (cal-tex-weekly4-box (cal-tex-incr-date date 3) nil)
-       (cal-tex-weekly4-box (cal-tex-incr-date date 6) t)
-       (if (/= i n)
-           (progn
-             (run-hooks 'cal-tex-week-hook)
-	     (setq date (cal-tex-incr-date date 7))
-             (cal-tex-newpage))))
-    (cal-tex-end-document)
-    (run-hooks 'cal-tex-hook)))
-
-(defun cal-tex-weekly4-box (date weekend)
-  "Make one box for DATE, different if WEEKEND."
-  (let* (
-	(day (extract-calendar-day date))
-	(month (extract-calendar-month date))
-	(year (extract-calendar-year date))
-	(dayname (calendar-day-name date))
-	(date1 (cal-tex-incr-date date))
-	(day1 (extract-calendar-day date1))
-	(month1 (extract-calendar-month date1))
-	(year1 (extract-calendar-year date1))
-	(dayname1 (calendar-day-name date1))
-	)
-    (cal-tex-b-framebox "8cm" "l")
-    (cal-tex-b-parbox "b" "7.5cm")
-    (insert (format "{\\Large\\bf %s,} %s/%s/%s\\\\\n" dayname month day year))
-    (cal-tex-rule "0pt" "7.5cm" ".5mm")
-    (cal-tex-nl)
-    (if (not weekend)
-	(progn
-	  (calendar-for-loop i from 8 to 12 do
-	     (insert (format "{\\large\\sf %d}\\\\\n" i)))
-	  (calendar-for-loop i from 1 to 5 do
-	     (insert (format "{\\large\\sf %d}\\\\\n" i)))))
-    (cal-tex-nl ".5cm")
-    (if weekend
-	(progn
-	  (cal-tex-vspace "1cm")
-	  (insert "\\ \\vfill")
-	  (insert (format "{\\Large\\bf %s,} %s/%s/%s\\\\\n" 
-			  dayname1 month1 day1 year1))
-	  (cal-tex-rule "0pt" "7.5cm" ".5mm")
-	  (cal-tex-nl "1.5cm")
-	  (cal-tex-vspace "1cm")))
-     (cal-tex-e-parbox)
-     (cal-tex-e-framebox)
-     (cal-tex-hspace "1cm")))
-
-(defun cal-tex-cursor-filofax-2week (&optional arg)
-  "Two-weeks-at-a-glance Filofax style calendar for week indicated by cursor.
-Optional prefix argument specifies number of weeks.
-Diary entries are included if `cal-tex-diary' is t.
-Holidays are included if `cal-tex-holidays' is t."
-  (interactive "P")
-  (let* ((n (if arg arg 1))
-         (date (calendar-gregorian-from-absolute
-                (calendar-dayname-on-or-before
-                 calendar-week-start-day
-                 (calendar-absolute-from-gregorian
-                  (calendar-cursor-to-date t)))))
-         (month (extract-calendar-month date))
-         (year (extract-calendar-year date))
-         (day (extract-calendar-day date))
-         (holidays (if cal-tex-holidays
-                       (cal-tex-list-holidays
-                        (calendar-absolute-from-gregorian date)
-                        (+ (* 7 n)
-                           (calendar-absolute-from-gregorian date)))))
-         (diary-list (if cal-tex-diary
-                         (cal-tex-list-diary-entries
-                          (calendar-absolute-from-gregorian
-                           (list month 1 year))
-                        (+ (* 7 n)
-                           (calendar-absolute-from-gregorian date))))))
-    (cal-tex-preamble "twoside")
-    (cal-tex-cmd "\\textwidth 3.25in")
-    (cal-tex-cmd "\\textheight 6.5in")
-    (cal-tex-cmd "\\oddsidemargin 1.75in")
-    (cal-tex-cmd "\\evensidemargin 1.5in")
-    (cal-tex-cmd "\\topmargin 0pt")
-    (cal-tex-cmd "\\headheight -0.875in")
-    (cal-tex-cmd "\\headsep 0.125in")
-    (cal-tex-cmd "\\footskip .125in")
-    (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
-\\long\\def\\rightday#1#2#3#4#5{%
-   \\rule{\\textwidth}{0.3pt}\\\\%
-   \\hbox to \\textwidth{%
-     \\vbox to 0.7in{%
-          \\vspace*{2pt}%
-          \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
-          \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
-          \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
-\\long\\def\\leftday#1#2#3#4#5{%
-   \\rule{\\textwidth}{0.3pt}\\\\%
-   \\hbox to \\textwidth{%
-     \\vbox to 0.7in{%
-          \\vspace*{2pt}%
-          \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%
-          \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}%
-          \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-")
-    (cal-tex-b-document)
-    (cal-tex-cmd "\\pagestyle{empty}")
-    (calendar-for-loop i from 1 to n do
-       (if (= (mod i 2) 1)
-           (insert "\\righthead")
-         (insert "\\lefthead"))
-       (cal-tex-arg
-        (let ((d (cal-tex-incr-date date 6)))
-          (if (= (extract-calendar-month date)
-                 (extract-calendar-month d))
-              (format "%s %s"
-                      (calendar-month-name
-                       (extract-calendar-month date))
-                      (extract-calendar-year date))
-            (if (=  (extract-calendar-year date)
-                    (extract-calendar-year d))
-                (format "%s---%s %s"
-                        (calendar-month-name
-                         (extract-calendar-month date))
-                        (calendar-month-name
-                         (extract-calendar-month d))
-                        (extract-calendar-year date))
-              (format "%s %s---%s %s"
-                      (calendar-month-name
-                       (extract-calendar-month date))
-                      (extract-calendar-year date)
-                      (calendar-month-name (extract-calendar-month d))
-                      (extract-calendar-year d))))))
-       (insert "%\n")
-       (calendar-for-loop j from 1 to 7 do 
-          (if (= (mod i 2) 1)
-              (insert "\\rightday")
-            (insert "\\leftday"))
-          (cal-tex-arg (calendar-day-name date))
-          (cal-tex-arg (int-to-string (extract-calendar-day date)))
-          (cal-tex-arg (cal-tex-latexify-list diary-list date))
-          (cal-tex-arg (cal-tex-latexify-list holidays date))
-          (cal-tex-arg (eval cal-tex-daily-string))
-          (insert "%\n")
-          (setq date (cal-tex-incr-date date)))
-       (if (/= i n)
-           (progn
-             (run-hooks 'cal-tex-week-hook)
-             (cal-tex-newpage))))
-    (cal-tex-end-document)
-    (run-hooks 'cal-tex-hook)))
-
-(defun cal-tex-cursor-filofax-week (&optional arg)
-  "One-week-at-a-glance Filofax style calendar for week indicated by cursor.
-Optional prefix argument specifies number of weeks.
-Weeks start on Monday. 
-Diary entries are included if `cal-tex-diary' is t.
-Holidays are included if `cal-tex-holidays' is t."
-  (interactive "P")
-  (let* ((n (if arg arg 1))
-         (date (calendar-gregorian-from-absolute
-                (calendar-dayname-on-or-before
-                 1
-                 (calendar-absolute-from-gregorian
-                  (calendar-cursor-to-date t)))))
-         (month (extract-calendar-month date))
-         (year (extract-calendar-year date))
-         (day (extract-calendar-day date))
-         (holidays (if cal-tex-holidays
-                       (cal-tex-list-holidays
-                        (calendar-absolute-from-gregorian date)
-                        (+ (* 7 n)
-                           (calendar-absolute-from-gregorian date)))))
-         (diary-list (if cal-tex-diary
-                         (cal-tex-list-diary-entries
-                          (calendar-absolute-from-gregorian
-                           (list month 1 year))
-                        (+ (* 7 n)
-                           (calendar-absolute-from-gregorian date))))))
-    (cal-tex-preamble "twoside")
-    (cal-tex-cmd "\\textwidth 3.25in")
-    (cal-tex-cmd "\\textheight 6.5in")
-    (cal-tex-cmd "\\oddsidemargin 1.75in")
-    (cal-tex-cmd "\\evensidemargin 1.5in")
-    (cal-tex-cmd "\\topmargin 0pt")
-    (cal-tex-cmd "\\headheight -0.875in")
-    (cal-tex-cmd "\\headsep 0.125in")
-    (cal-tex-cmd "\\footskip .125in")
-    (insert "\\def\\righthead#1{\\hfill {\\normalsize \\bf #1}\\\\[-6pt]}
-\\long\\def\\rightday#1#2#3#4#5{%
-   \\rule{\\textwidth}{0.3pt}\\\\%
-   \\hbox to \\textwidth{%
-     \\vbox to 1.85in{%
-          \\vspace*{2pt}%
-          \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
-          \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
-          \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-\\long\\def\\weekend#1#2#3#4#5{%
-   \\rule{\\textwidth}{0.3pt}\\\\%
-   \\hbox to \\textwidth{%
-     \\vbox to .8in{%
-          \\vspace*{2pt}%
-          \\hbox to \\textwidth{\\small #5 \\hfill #1 {\\normalsize \\bf #2}}%
-          \\hbox to \\textwidth{\\vbox {\\raggedleft \\footnotesize \\em #4}}%
-          \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-\\def\\lefthead#1{\\noindent {\\normalsize \\bf #1}\\hfill\\\\[-6pt]}
-\\long\\def\\leftday#1#2#3#4#5{%
-   \\rule{\\textwidth}{0.3pt}\\\\%
-   \\hbox to \\textwidth{%
-     \\vbox to 1.85in{%
-          \\vspace*{2pt}%
-          \\hbox to \\textwidth{\\noindent {\\normalsize \\bf #2} \\small #1 \\hfill #5}%
-          \\hbox to \\textwidth{\\vbox {\\noindent \\footnotesize \\em #4}}%
-          \\hbox to \\textwidth{\\vbox to 0pt {\\noindent \\footnotesize #3}}}}\\\\}
-")
-    (cal-tex-b-document)
-    (cal-tex-cmd "\\pagestyle{empty}\\ ")
-    (cal-tex-newpage)
-    (calendar-for-loop i from 1 to n do
-       (insert "\\lefthead")
-       (cal-tex-arg
-        (let ((d (cal-tex-incr-date date 2)))
-          (if (= (extract-calendar-month date)
-                 (extract-calendar-month d))
-              (format "%s %s"
-                      (calendar-month-name
-                       (extract-calendar-month date))
-                      (extract-calendar-year date))
-            (if (=  (extract-calendar-year date)
-                    (extract-calendar-year d))
-                (format "%s---%s %s"
-                        (calendar-month-name
-                         (extract-calendar-month date))
-                        (calendar-month-name
-                         (extract-calendar-month d))
-                        (extract-calendar-year date))
-              (format "%s %s---%s %s"
-                      (calendar-month-name
-                       (extract-calendar-month date))
-                      (extract-calendar-year date)
-                      (calendar-month-name (extract-calendar-month d))
-                      (extract-calendar-year d))))))
-       (insert "%\n")
-       (calendar-for-loop j from 1 to 3 do 
-          (insert "\\leftday")
-          (cal-tex-arg (calendar-day-name date))
-          (cal-tex-arg (int-to-string (extract-calendar-day date)))
-          (cal-tex-arg (cal-tex-latexify-list diary-list date))
-          (cal-tex-arg (cal-tex-latexify-list holidays date))
-          (cal-tex-arg (eval cal-tex-daily-string))
-          (insert "%\n")
-          (setq date (cal-tex-incr-date date)))
-       (insert "\\noindent\\rule{\\textwidth}{0.3pt}\\\\%\n")
-       (cal-tex-newpage)
-       (insert "\\righthead")
-       (cal-tex-arg
-        (let ((d (cal-tex-incr-date date 3)))
-          (if (= (extract-calendar-month date)
-                 (extract-calendar-month d))
-              (format "%s %s"
-                      (calendar-month-name
-                       (extract-calendar-month date))
-                      (extract-calendar-year date))
-            (if (=  (extract-calendar-year date)
-                    (extract-calendar-year d))
-                (format "%s---%s %s"
-                        (calendar-month-name
-                         (extract-calendar-month date))
-                        (calendar-month-name
-                         (extract-calendar-month d))
-                        (extract-calendar-year date))
-              (format "%s %s---%s %s"
-                      (calendar-month-name
-                       (extract-calendar-month date))
-                      (extract-calendar-year date)
-                      (calendar-month-name (extract-calendar-month d))
-                      (extract-calendar-year d))))))
-       (insert "%\n")
-       (calendar-for-loop j from 1 to 2 do 
-          (insert "\\rightday")
-          (cal-tex-arg (calendar-day-name date))
-          (cal-tex-arg (int-to-string (extract-calendar-day date)))
-          (cal-tex-arg (cal-tex-latexify-list diary-list date))
-          (cal-tex-arg (cal-tex-latexify-list holidays date))
-          (cal-tex-arg (eval cal-tex-daily-string))
-          (insert "%\n")
-          (setq date (cal-tex-incr-date date)))
-       (calendar-for-loop j from 1 to 2 do 
-          (insert "\\weekend")
-          (cal-tex-arg (calendar-day-name date))
-          (cal-tex-arg (int-to-string (extract-calendar-day date)))
-          (cal-tex-arg (cal-tex-latexify-list diary-list date))
-          (cal-tex-arg (cal-tex-latexify-list holidays date))
-          (cal-tex-arg (eval cal-tex-daily-string))
-          (insert "%\n")
-          (setq date (cal-tex-incr-date date)))
-       (if (/= i n)
-           (progn
-             (run-hooks 'cal-tex-week-hook)
-             (cal-tex-newpage))))
-    (cal-tex-end-document)
-    (run-hooks 'cal-tex-hook)))
-;;;
-;;;  Daily calendars
-;;;
-
-(defun cal-tex-cursor-day (&optional arg)
-  "Make a buffer with LaTeX commands for the day cursor is on.
-Optional prefix argument specifies number of days."
-  (interactive "P")
-  (let ((n (if arg arg 1))
-        (date (calendar-absolute-from-gregorian (calendar-cursor-to-date t))))
-    (cal-tex-preamble "12pt")
-    (cal-tex-cmd "\\textwidth       6.5in")
-    (cal-tex-cmd "\\textheight 10.5in")
-    (cal-tex-b-document)
-    (cal-tex-cmd "\\pagestyle{empty}")
-    (calendar-for-loop i from 1 to n do
-       (cal-tex-vspace "-1.7in")
-       (cal-tex-daily-page (calendar-gregorian-from-absolute date))
-       (setq date (1+ date))
-       (if (/= i n)
-          (progn
-            (cal-tex-newpage)
-            (run-hooks 'cal-tex-daily-hook))))
-    (cal-tex-end-document)
-    (run-hooks 'cal-tex-hook)))
-
-(defun cal-tex-daily-page (date)
-  "Make a calendar page for Gregorian DATE on 8.5 by 11 paper."
-  (let* ((hour)
-         (month-name (calendar-month-name (extract-calendar-month date))))
-    (cal-tex-banner "cal-tex-daily-page")
-    (cal-tex-b-makebox "4cm" "l")
-    (cal-tex-b-parbox "b" "3.8cm")
-    (cal-tex-rule "0mm" "0mm" "2cm")
-    (cal-tex-Huge (number-to-string (extract-calendar-day date)))
-    (cal-tex-nl ".5cm")
-    (cal-tex-bf month-name )
-    (cal-tex-e-parbox)
-    (cal-tex-hspace "1cm")
-    (cal-tex-scriptsize (eval cal-tex-daily-string))
-    (cal-tex-hspace "3.5cm")
-    (cal-tex-e-makebox)
-    (cal-tex-hfill)
-    (cal-tex-b-makebox "4cm" "r")
-    (cal-tex-bf (calendar-day-name date))
-    (cal-tex-e-makebox)
-    (cal-tex-nl)
-    (cal-tex-hspace ".4cm")
-    (cal-tex-rule "0mm" "16.1cm" "1mm")
-    (cal-tex-nl ".1cm")
-    (calendar-for-loop i from cal-tex-daily-start to cal-tex-daily-end do
-       (cal-tex-cmd "\\noindent")
-       (setq hour (if cal-tex-24
-                      i
-                    (mod i 12)))
-       (if (= 0 hour) (setq hour 12))
-       (cal-tex-b-makebox "1cm" "c")
-       (cal-tex-arg (number-to-string hour))
-       (cal-tex-e-makebox)
-       (cal-tex-rule "0mm" "15.5cm" ".2mm")
-       (cal-tex-nl ".2cm")
-       (cal-tex-b-makebox "1cm" "c")
-       (cal-tex-arg "$\\diamond$" )
-       (cal-tex-e-makebox)
-       (cal-tex-rule "0mm" "15.5cm" ".2mm")
-       (cal-tex-nl ".2cm"))
-    (cal-tex-hfill)
-    (insert (cal-tex-mini-calendar
-             (extract-calendar-month (cal-tex-previous-month date))
-             (extract-calendar-year (cal-tex-previous-month date))
-             "lastmonth" "1.1in" "1in"))
-    (insert (cal-tex-mini-calendar
-             (extract-calendar-month date)
-             (extract-calendar-year date)
-             "thismonth" "1.1in" "1in"))
-    (insert (cal-tex-mini-calendar
-             (extract-calendar-month (cal-tex-next-month date))
-             (extract-calendar-year (cal-tex-next-month date))
-             "nextmonth" "1.1in" "1in"))
-    (insert "\\hbox to \\textwidth{")
-    (cal-tex-hfill)
-    (insert "\\lastmonth")
-    (cal-tex-hfill)
-    (insert "\\thismonth")
-    (cal-tex-hfill)
-    (insert "\\nextmonth")
-    (cal-tex-hfill)
-    (insert "}")
-    (cal-tex-banner "end of cal-tex-daily-page")))
-    
-;;;
-;;;  Mini calendars
-;;;
-
-(defun cal-tex-mini-calendar (month year name width height &optional ptsize colsep)
-  "Produce mini-calendar for MONTH, YEAR in macro NAME with WIDTH and HEIGHT.
-Optional PTSIZE gives the point ptsize; scriptsize is the default.  Optional
-COLSEP gives the column separation; 1mm is the default."
-  (let* ((blank-days;; at start of month
-          (mod
-           (- (calendar-day-of-week (list month 1 year))
-              calendar-week-start-day)
-           7))
-          (last (calendar-last-day-of-month month year))
-         (colsep (if colsep colsep "1mm"))
-         (str (concat "\\def\\" name "{\\hbox to" width "{%\n"
-                      "\\vbox to" height "{%\n"
-                      "\\vfil  \\hbox to" width "{%\n"
-                      "\\hfil\\"
-                      (if ptsize ptsize "scriptsize")
-                      "\\begin{tabular}"
-                      "{@{\\hspace{0mm}}r@{\\hspace{" colsep
-                      "}}r@{\\hspace{" colsep "}}r@{\\hspace{" colsep
-                      "}}r@{\\hspace{" colsep "}}r@{\\hspace{" colsep
-                      "}}r@{\\hspace{" colsep "}}r@{\\hspace{0mm}}}%\n"
-                      "\\multicolumn{7}{c}{"
-                      (calendar-month-name month)
-                      " "
-                      (int-to-string year)
-                      "}\\\\[1mm]\n")))
-    (calendar-for-loop i from 0 to 6 do
-      (setq str (concat str
-                        (substring (aref calendar-day-name-array 
-                                         (mod (+ calendar-week-start-day i) 7))
-                                   0 2)
-                        (if (/= i 6)
-                            " & "
-                          "\\\\[0.7mm]\n"))))
-    (calendar-for-loop i from 1 to blank-days do
-      (setq str (concat str " & ")))
-    (calendar-for-loop i from 1 to last do
-      (setq str (concat str (int-to-string i)))
-      (setq str (concat str (if (zerop (mod (+ i blank-days) 7))
-                                (if (/= i last) "\\\\[0.5mm]\n" "")
-                              " & "))))
-    (setq str (concat str "\n\\end{tabular}\\hfil}\\vfil}}}%\n"))
-   str))
-
-;;;
-;;;  Various calendar functions
-;;;
-
-(defun cal-tex-incr-date (date &optional n)
-  "The date of the day following DATE.
-If optional N is given, the date of N days after DATE."
-  (calendar-gregorian-from-absolute
-   (+ (if n n 1) (calendar-absolute-from-gregorian date))))
-
-(defun cal-tex-latexify-list (date-list date &optional separator)
-  "Return string with concatenated, LaTeXified entries in DATE_LIST for DATE.
-Use double backslash as a separator unless optional SEPARATOR is given."
-  (mapconcat '(lambda (x) (cal-tex-LaTeXify-string  x))
-             (let ((result)
-                   (p date-list))
-               (while p
-                 (and (car (car p))
-                      (calendar-date-equal date (car (car p)))
-                      (setq result (append (cdr (car p)) result)))
-                 (setq p (cdr p)))
-               result)
-             (if separator separator "\\\\")))
-
-(defun cal-tex-previous-month (date)
-  "Return the date of the first day in the month previous to DATE."
-  (let* ((month (extract-calendar-month date))
-         (year (extract-calendar-year date)))
-    (increment-calendar-month month year -1)
-    (list month 1 year)))
-
-(defun cal-tex-next-month (date)
-  "Return the date of the first day in the  month following DATE."
-  (let* ((month (extract-calendar-month date))
-         (year (extract-calendar-year date)))
-    (increment-calendar-month month year 1)
-    (list month 1 year)))
-
-;;;
-;;;  LaTeX Code
-;;;
-
-(defun cal-tex-end-document ()
-  "Finish the LaTeX document.
-Insert the trailer to LaTeX document, pop to LaTeX buffer, add 
-informative header, and run HOOK."
-  (cal-tex-e-document)
-  (latex-mode)
-  (pop-to-buffer cal-tex-buffer)
-  (goto-char (point-min))    
-  (cal-tex-comment "       This buffer was produced by cal-tex.el.")
-  (cal-tex-comment "       To print a calendar, type")
-  (cal-tex-comment "          M-x tex-buffer RET")
-  (cal-tex-comment "          M-x tex-print  RET")
-  (goto-char (point-min)))
-
-(defun cal-tex-insert-preamble (weeks landscape size &optional append)
-  "Initialize the output buffer.
-Select the output buffer, and insert the preamble for a calendar of 
-WEEKS weeks.  Insert code for landscape mode if LANDSCAPE is true. 
-Use pointsize SIZE.  Optional argument APPEND, if t, means add to end of
-without erasing current contents."
-  (let ((width "18cm")
-        (height "24cm"))
-    (if landscape
-        (progn
-          (setq width "24cm")
-          (setq height "18cm")))
-    (if (not append)
-        (progn
-          (cal-tex-preamble size)
-          (if (not landscape) 
-            (progn
-              (cal-tex-cmd "\\oddsidemargin -1.75cm")
-              (cal-tex-cmd "\\def\\holidaymult{.06}"))
-            (cal-tex-cmd "\\special{landscape}")
-            (cal-tex-cmd "\\textwidth  9.5in")
-            (cal-tex-cmd "\\textheight 7in")
-            (cal-tex-comment)
-            (cal-tex-cmd "\\def\\holidaymult{.08}"))
-          (cal-tex-cmd  cal-tex-caldate)
-          (cal-tex-cmd  cal-tex-myday)
-          (cal-tex-b-document)
-          (cal-tex-cmd "\\pagestyle{empty}")))
-    (cal-tex-cmd "\\setlength{\\cellwidth}" width)
-    (insert (format "\\setlength{\\cellwidth}{%f\\cellwidth}\n"
-                    (/ 1.1 (length cal-tex-which-days))))
-    (cal-tex-cmd "\\setlength{\\cellheight}" height)
-    (insert (format "\\setlength{\\cellheight}{%f\\cellheight}\n"
-                    (/ 1.0 weeks)))              
-    (cal-tex-cmd "\\ \\par")
-    (cal-tex-vspace "-3cm")))
-
-(defvar cal-tex-LaTeX-subst-list
-  '(("\"". "``")
-    ("\"". "''");; Quote changes meaning when list is reversed.
-    ("@" . "\\verb|@|") 
-    ("&" . "\\&") 
-    ("%" . "\\%") 
-    ("$" . "\\$")
-    ("#" . "\\#")
-    ("_" . "\\_")
-    ("{" . "\\{")
-    ("}" . "\\}")
-    ("<" . "$<$")
-    (">" . "$>$")
-    ("\n" . "\\ \\\\"))  ;\\ needed for e.g \begin{center}\n AA\end{center}
-  "List of symbols and their replacements.")
-
-(defun cal-tex-LaTeXify-string (string)
-  "Protect special characters in STRING from LaTeX."
-  (if (not string)
-      ""
-    (let ((head "")
-          (tail string)
-          (list cal-tex-LaTeX-subst-list))
-      (while (not (string-equal tail ""))
-        (let* ((ch (substring tail 0 1))
-               (pair (assoc ch list)))
-          (if (and pair (string-equal ch "\""))
-              (setq list (reverse list)));; Quote changes meaning each time.
-          (setq tail (substring tail 1))
-          (setq head (concat head (if pair (cdr pair) ch)))))
-      head)))
-
-(defun cal-tex-hfill () "Insert hfill." (insert "\\hfill"))
-
-(defun cal-tex-newpage () "Insert newpage." (insert "\\newpage%\n"))
-
-(defun cal-tex-noindent () "Insert noindent." (insert "\\noindent"))
-
-(defun cal-tex-vspace (space)
-  "Insert vspace command to move SPACE vertically."
-  (insert "\\vspace*{" space "}")
-  (cal-tex-comment))
-
-(defun cal-tex-hspace (space)
-  "Insert hspace command to move SPACE horizontally."
-  (insert "\\hspace*{" space "}")
-  (cal-tex-comment))
-
-(defun cal-tex-comment (&optional comment)
-  "Insert % at end of line, include COMMENT if present, and move
-   to next line."
-  (insert "% ")
-  (if comment
-      (insert comment))
-  (insert "\n"))
-
-(defun cal-tex-banner (comment)
-  "Insert the COMMENT separated by blank lines."
-  (cal-tex-comment)
-  (cal-tex-comment)
-  (cal-tex-comment (concat "\t\t\t" comment))
-  (cal-tex-comment))
-
-
-(defun cal-tex-nl (&optional skip comment)
-  "End a line with \\.  If SKIP, then add that much spacing.
-   Add COMMENT if present"
-  (insert "\\\\")       
-  (if skip 
-      (insert "[" skip "]"))
-  (cal-tex-comment comment))
-    
-(defun cal-tex-arg (&optional text)
-  "Insert optional TEXT surrounded by braces."
-  (insert "{")
-  (if text (insert text))
-  (insert "}"))
-
-(defun cal-tex-cmd (cmd &optional arg)
-  "Insert LaTeX CMD, with optional ARG, and end with %"
-  (insert cmd)
-  (cal-tex-arg arg)
-  (cal-tex-comment))
-
-;;;
-;;;   Environments
-;;;
-
-(defun cal-tex-b-document ()
-  "Insert beginning of document."
-  (cal-tex-cmd "\\begin{document}"))
-
-(defun cal-tex-e-document ()
-  "Insert end of document."
-  (cal-tex-cmd "\\end{document}"))
-
-(defun cal-tex-b-center ()
-  "Insert beginning of centered block."
-  (cal-tex-cmd "\\begin{center}"))
-
-(defun cal-tex-e-center ()
-  "Insert end of centered block."
-  (cal-tex-comment)
-  (cal-tex-cmd "\\end{center}"))
-
-
-;;;
-;;;  Boxes
-;;;
-
-
-(defun cal-tex-b-parbox (position width)
-  "Insert parbox with parameters POSITION and WIDTH."
-  (insert "\\parbox[" position "]{" width "}{")
-  (cal-tex-comment))
-
-(defun cal-tex-e-parbox (&optional height)
-  "Insert end of parbox. Force it to be a given HEIGHT."
-  (cal-tex-comment)
-  (if height
-      (cal-tex-rule "0mm" "0mm" height))
-  (insert "}")
-  (cal-tex-comment "end parbox"))
-
-(defun cal-tex-b-framebox ( width position )
-  "Insert  framebox with parameters WIDTH and POSITION (clr)."
-  (insert "\\framebox[" width "][" position "]{" )
-  (cal-tex-comment))
-
-(defun cal-tex-e-framebox ()
-  "Insert end of framebox."
-  (cal-tex-comment)
-  (insert "}")
-  (cal-tex-comment "end framebox"))
-
-
-(defun cal-tex-b-makebox ( width position )
-  "Insert  makebox with parameters WIDTH and POSITION (clr)."
-  (insert "\\makebox[" width "][" position "]{" )
-  (cal-tex-comment))
-
-(defun cal-tex-e-makebox ()
-  "Insert end of makebox."
-  (cal-tex-comment)
-  (insert "}")
-  (cal-tex-comment "end makebox"))
-
-
-(defun cal-tex-rule (lower width height)
-  "Insert a rule with parameters LOWER WIDTH HEIGHT."
-  (insert "\\rule[" lower "]{" width "}{" height "}"))
-
-;;;
-;;;     Fonts
-;;;
-
-(defun cal-tex-em (string)
-  "Insert STRING in bf font."
-  (insert "{\\em " string "}"))
-
-(defun cal-tex-bf (string)
-  "Insert STRING in bf font."
-  (insert "{\\bf " string "}"))
-
-(defun cal-tex-scriptsize (string)
-  "Insert STRING in scriptsize font."
-  (insert "{\\scriptsize " string "}"))
-
-(defun cal-tex-huge (string)
-  "Insert STRING in huge size."
-  (insert "{\\huge " string "}"))
-
-(defun cal-tex-Huge (string)
-  "Insert STRING in Huge size."
-  (insert "{\\Huge " string "}"))
-
-(defun cal-tex-Huge-bf (string)
-  "Insert STRING in Huge bf size."
-  (insert "{\\Huge\\bf " string "}"))
-
-(defun cal-tex-large (string)
-  "Insert STRING in large size."
-  (insert "{\\large " string "}"))
-
-(defun cal-tex-large-bf (string)
-  "Insert STRING in large bf size."
-  (insert "{\\large\\bf  " string "}"))
-
-(provide 'cal-tex)
-
-;;; cal-tex.el ends here
diff --git a/lisp/calendar/cal-x.el b/lisp/calendar/cal-x.el
deleted file mode 100644
index c12e23cfa26..00000000000
--- a/lisp/calendar/cal-x.el
+++ /dev/null
@@ -1,143 +0,0 @@
-;;; cal-x.el --- calendar windows in dedicated frames in X
-
-;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-;;      Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: calendar, dedicated frames, X Window System
-
-;; 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 collection of functions implements dedicated frames in X for
-;; calendar.el.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'calendar)
-
-(defvar calendar-frame nil "Frame in which to display the calendar.")
-
-(defvar diary-frame nil "Frame in which to display the diary.")
-  
-;; This should not specify the font.  That's up to the user.
-;; Certainly it should not specify auto-lower and auto-raise
-;; since most users won't like that.
-(defvar diary-frame-parameters
-  '((name . "Diary") (height . 10) (width . 80) (unsplittable . t)
-    (minibuffer . nil))
-  "Parameters of the diary frame, if the diary is in its own frame.
-Location and color should be set in .Xdefaults.")
-                                 
-(defvar calendar-frame-parameters
-  '((name . "Calendar") (minibuffer . nil) (height . 10) (width . 80)
-    (unsplittable . t) (vertical-scroll-bars . nil))
-  "Parameters of the calendar frame, if the calendar is in a separate frame.
-Location and color should be set in .Xdefaults.")
-
-(defvar calendar-and-diary-frame-parameters
-  '((name . "Calendar") (height . 28) (width . 80) (minibuffer . nil))
-  "Parameters of the frame that displays both the calendar and the diary.
-Location and color should be set in .Xdefaults.")
-  
-(defvar calendar-after-frame-setup-hooks nil
-  "Hooks to be run just after setting up a calendar frame.
-Can be used to change frame parameters, such as font, color, location, etc.")
-  
-(defun calendar-one-frame-setup (&optional arg)
-  "Start calendar and display it in a dedicated frame together with the diary."
-  (if (not window-system)
-      (calendar-basic-setup arg)
-    (if (frame-live-p calendar-frame) (delete-frame calendar-frame))
-    (if (frame-live-p diary-frame) (delete-frame diary-frame))
-    (let ((special-display-buffer-names nil)
-          (view-diary-entries-initially t))
-      (save-window-excursion
-        (save-excursion
-          (setq calendar-frame
-		(make-frame calendar-and-diary-frame-parameters))
-          (run-hooks 'calendar-after-frame-setup-hooks)
-          (select-frame calendar-frame)
-          (if (eq 'icon (cdr (assoc 'visibility
-                                     (frame-parameters calendar-frame))))
-              (iconify-or-deiconify-frame))
-          (calendar-basic-setup arg)
-          (set-window-dedicated-p (selected-window) 'calendar)
-          (set-window-dedicated-p
-           (display-buffer
-            (if (not (memq 'fancy-diary-display diary-display-hook))
-                (get-file-buffer diary-file)
-              (if (not (bufferp (get-buffer fancy-diary-buffer)))
-                  (make-fancy-diary-buffer))
-              fancy-diary-buffer))
-           'diary))))))
-
-(defun calendar-two-frame-setup (&optional arg)
-  "Start calendar and diary in separate, dedicated frames."
-  (if (not window-system)
-      (calendar-basic-setup arg)
-    (if (frame-live-p calendar-frame) (delete-frame calendar-frame))
-    (if (frame-live-p diary-frame) (delete-frame diary-frame))
-    (let ((pop-up-windows nil)
-          (view-diary-entries-initially nil)
-          (special-display-buffer-names nil))
-      (save-window-excursion
-        (save-excursion (calendar-basic-setup arg))
-        (setq calendar-frame (make-frame calendar-frame-parameters))
-        (run-hooks 'calendar-after-frame-setup-hooks)
-        (select-frame calendar-frame)
-        (if (eq 'icon (cdr (assoc 'visibility
-                                  (frame-parameters calendar-frame))))
-            (iconify-or-deiconify-frame))
-        (display-buffer calendar-buffer)
-        (set-window-dedicated-p (selected-window) 'calendar)
-        (setq diary-frame (make-frame diary-frame-parameters))
-        (run-hooks 'calendar-after-frame-setup-hooks)
-        (select-frame diary-frame)
-        (if (eq 'icon (cdr (assoc 'visibility
-                                  (frame-parameters diary-frame))))
-            (iconify-or-deiconify-frame))
-        (save-excursion (diary))
-        (set-window-dedicated-p
-         (display-buffer
-          (if (not (memq 'fancy-diary-display diary-display-hook))
-              (get-file-buffer diary-file)
-            (if (not (bufferp (get-buffer fancy-diary-buffer)))
-                (make-fancy-diary-buffer))
-            fancy-diary-buffer))
-         'diary)))))
-
-(setq special-display-buffer-names
-      (append special-display-buffer-names
-              (list "*Yahrzeits*" lunar-phases-buffer holiday-buffer
-                    fancy-diary-buffer (get-file-buffer diary-file)
-                    calendar-buffer)))
-
-(run-hooks 'cal-x-load-hook)
-
-(provide 'cal-x)
-
-;;; cal-x.el ends here
diff --git a/lisp/calendar/calendar.el b/lisp/calendar/calendar.el
deleted file mode 100644
index bd3d58fe48f..00000000000
--- a/lisp/calendar/calendar.el
+++ /dev/null
@@ -1,2336 +0,0 @@
-;;; calendar.el --- Calendar functions.
-
-;; Copyright (C) 1988, 1989, 1990, 1991, 1992, 1993, 1994, 1995 Free
-;; Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: calendar, Gregorian calendar, diary, holidays
-
-;; 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 collection of functions implements a calendar window.  It generates a
-;; calendar for the current month, together with the previous and coming
-;; months, or for any other three-month period.  The calendar can be scrolled
-;; forward and backward in the window to show months in the past or future;
-;; the cursor can move forward and backward by days, weeks, or months, making
-;; it possible, for instance, to jump to the date a specified number of days,
-;; weeks, or months from the date under the cursor.  The user can display a
-;; list of holidays and other notable days for the period shown; the notable
-;; days can be marked on the calendar, if desired.  The user can also specify
-;; that dates having corresponding diary entries (in a file that the user
-;; specifies) be marked; the diary entries for any date can be viewed in a
-;; separate window.  The diary and the notable days can be viewed
-;; independently of the calendar.  Dates can be translated from the (usual)
-;; Gregorian calendar to the day of the year/days remaining in year, to the
-;; ISO commercial calendar, to the Julian (old style) calendar, to the Hebrew
-;; calendar, to the Islamic calendar, to the French Revolutionary calendar, to
-;; the Mayan calendar, to the Chinese calendar, to the Coptic calendar, to the
-;; Ethiopic calendar, and to the astronomical (Julian) day number.  When
-;; floating point is available, times of sunrise/sunset can be displayed, as
-;; can the phases of the moon.  Appointment notification for diary entries is
-;; available.  Calendar printing via LaTeX is available.
-
-;; The following files are part of the calendar/diary code:
-
-;;       appt.el                       Appointment notification
-;;       cal-china.el                  Chinese calendar
-;;       cal-coptic.el                 Coptic/Ethiopic calendars
-;;       cal-dst.el                    Daylight savings time rules
-;;       cal-hebrew.el                 Hebrew calendar
-;;       cal-islam.el                  Islamic calendar
-;;       cal-iso.el                    ISO calendar
-;;       cal-julian.el                 Julian/astronomical calendars
-;;       cal-mayan.el                  Mayan calendars
-;;       cal-menu.el                   Menu support
-;;       cal-move.el                   Movement in the calendar
-;;       cal-persia.el                 Persian calendar
-;;       cal-tex.el                    Calendars in LaTeX
-;;       cal-x.el                      X-windows dedicated frame functions
-;;       diary-lib.el                  Diary functions
-;;       holidays.el                   Holiday functions
-;;       lunar.el                      Phases of the moon
-;;       solar.el                      Sunrise/sunset, equinoxes/solstices
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;; Technical details of all the calendrical calculations can be found in
-
-;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
-;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
-;; pages 899-928.  ``Calendrical Calculations, Part II: Three Historical
-;; Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M. Clamen,
-;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
-;; pages 383-404.
-
-;; Hard copies of these two papers can be obtained by sending email to
-;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
-;; the message BODY containing your mailing address (snail).
-
-;;; Code:
-
-(defun calendar-version ()
-  (interactive)
-  (message "Version 6, October 12, 1995"))
-
-;;;###autoload
-(defvar calendar-week-start-day 0
-  "*The day of the week on which a week in the calendar begins.
-0 means Sunday (default), 1 means Monday, and so on.")
-
-;;;###autoload
-(defvar calendar-offset 0
-  "*The offset of the principal month from the center of the calendar window.
-0 means the principal month is in the center (default), -1 means on the left,
-+1 means on the right.  Larger (or smaller) values push the principal month off
-the screen.")
-
-;;;###autoload
-(defvar view-diary-entries-initially nil
-  "*Non-nil means display current date's diary entries on entry.
-The diary is displayed in another window when the calendar is first displayed,
-if the current date is visible.  The number of days of diary entries displayed
-is governed by the variable `number-of-diary-entries'.")
-
-;;;###autoload
-(defvar number-of-diary-entries 1
-  "*Specifies how many days of diary entries are to be displayed initially.
-This variable affects the diary display when the command M-x diary is used,
-or if the value of the variable `view-diary-entries-initially' is t.  For
-example, if the default value 1 is used, then only the current day's diary
-entries will be displayed.  If the value 2 is used, then both the current
-day's and the next day's entries will be displayed.
-
-The value can also be a vector such as [0 2 2 2 2 4 1]; this value
-says to display no diary entries on Sunday, the display the entries
-for the current date and the day after on Monday through Thursday,
-display Friday through Monday's entries on Friday, and display only
-Saturday's entries on Saturday.
-
-This variable does not affect the diary display with the `d' command
-from the calendar; in that case, the prefix argument controls the
-number of days of diary entries displayed.")
-
-;;;###autoload
-(defvar mark-diary-entries-in-calendar nil
-  "*Non-nil means mark dates with diary entries, in the calendar window.
-The marking symbol is specified by the variable `diary-entry-marker'.")
-
-(defvar diary-entry-marker
-  (if (not window-system)
-      "+"
-    (require 'faces)
-    (add-to-list 'facemenu-unlisted-faces 'diary-face)
-    (make-face 'diary-face)
-    (cond ((face-differs-from-default-p 'diary-face))
-          ((x-display-color-p) (set-face-foreground 'diary-face "red"))
-          (t (copy-face 'bold 'diary-face)))
-    'diary-face)
-  "*Used to mark dates that have diary entries.
-Can be either a single-character string or a face.")
-
-(defvar calendar-today-marker
-  (if (not window-system)
-      "="
-    (require 'faces)
-    (add-to-list 'facemenu-unlisted-faces 'calendar-today-face)
-    (make-face 'calendar-today-face)
-    (if (not (face-differs-from-default-p 'calendar-today-face))
-        (set-face-underline-p 'calendar-today-face t))
-    'calendar-today-face)
-  "*Used to mark today's date.
-Can be either a single-character string or a face.")
-
-(defvar calendar-holiday-marker
-  (if (not window-system)
-      "*"
-    (require 'faces)
-    (add-to-list 'facemenu-unlisted-faces 'holiday-face)
-    (make-face 'holiday-face)
-    (cond ((face-differs-from-default-p 'holiday-face))
-          ((x-display-color-p) (set-face-background 'holiday-face "pink"))
-          (t (set-face-background 'holiday-face "black")
-             (set-face-foreground 'holiday-face "white")))
-    'holiday-face)
-  "*Used to mark notable dates in the calendar.
-Can be either a single-character string or a face.")
-
-;;;###autoload
-(defvar view-calendar-holidays-initially nil
-  "*Non-nil means display holidays for current three month period on entry.
-The holidays are displayed in another window when the calendar is first
-displayed.")
-
-;;;###autoload
-(defvar mark-holidays-in-calendar nil
-  "*Non-nil means mark dates of holidays in the calendar window.
-The marking symbol is specified by the variable `calendar-holiday-marker'.")
-
-;;;###autoload
-(defvar all-hebrew-calendar-holidays nil
-  "*If nil, show only major holidays from the Hebrew calendar.
-This means only those Jewish holidays that appear on secular calendars.
-
-If t, show all the holidays that would appear in a complete Hebrew calendar.")
-
-;;;###autoload
-(defvar all-christian-calendar-holidays nil
-  "*If nil, show only major holidays from the Christian calendar.
-This means only those Christian holidays that appear on secular calendars.
-
-If t, show all the holidays that would appear in a complete Christian
-calendar.")
-
-;;;###autoload
-(defvar all-islamic-calendar-holidays nil
-  "*If nil, show only major holidays from the Islamic calendar.
-This means only those Islamic holidays that appear on secular calendars.
-
-If t, show all the holidays that would appear in a complete Islamic
-calendar.")
-
-;;;###autoload
-(defvar calendar-load-hook nil
-  "*List of functions to be called after the calendar is first loaded.
-This is the place to add key bindings to `calendar-mode-map'.")
-
-;;;###autoload
-(defvar initial-calendar-window-hook nil
-  "*List of functions to be called when the calendar window is first opened.
-The functions invoked are called after the calendar window is opened, but
-once opened is never called again.  Leaving the calendar with the `q' command
-and reentering it will cause these functions to be called again.")
-
-;;;###autoload
-(defvar today-visible-calendar-hook nil
-  "*List of functions called whenever the current date is visible.
-This can be used, for example, to replace today's date with asterisks; a
-function `calendar-star-date' is included for this purpose:
-    (setq today-visible-calendar-hook 'calendar-star-date)
-It can also be used to mark the current date with `calendar-today-marker';
-a function is also provided for this:
-    (setq today-visible-calendar-hook 'calendar-mark-today)
-
-The corresponding variable `today-invisible-calendar-hook' is the list of
-functions called when the calendar function was called when the current
-date is not visible in the window.
-
-Other than the use of the provided functions, the changing of any
-characters in the calendar buffer by the hooks may cause the failure of the
-functions that move by days and weeks.")
-
-;;;###autoload
-(defvar today-invisible-calendar-hook nil
-  "*List of functions called whenever the current date is not visible.
-
-The corresponding variable `today-visible-calendar-hook' is the list of
-functions called when the calendar function was called when the current
-date is visible in the window.
-
-Other than the use of the provided functions, the changing of any
-characters in the calendar buffer by the hooks may cause the failure of the
-functions that move by days and weeks.")
-
-;;;###autoload
-(defvar diary-file "~/diary"
-  "*Name of the file in which one's personal diary of dates is kept.
-
-The file's entries are lines in any of the forms
-
-            MONTH/DAY
-            MONTH/DAY/YEAR
-            MONTHNAME DAY
-            MONTHNAME DAY, YEAR
-            DAYNAME
-
-at the beginning of the line; the remainder of the line is the diary entry
-string for that date.  MONTH and DAY are one or two digit numbers, YEAR is
-a number and may be written in full or abbreviated to the final two digits.
-If the date does not contain a year, it is generic and applies to any year.
-DAYNAME entries apply to any date on which is on that day of the week.
-MONTHNAME and DAYNAME can be spelled in full, abbreviated to three
-characters (with or without a period), capitalized or not.  Any of DAY,
-MONTH, or MONTHNAME, YEAR can be `*' which matches any day, month, or year,
-respectively.
-
-The European style (in which the day precedes the month) can be used
-instead, if you execute `european-calendar' when in the calendar, or set
-`european-calendar-style' to t in your .emacs file.  The European forms are
-
-            DAY/MONTH
-            DAY/MONTH/YEAR
-            DAY MONTHNAME
-            DAY MONTHNAME YEAR
-            DAYNAME
-
-To revert to the default American style from the European style, execute
-`american-calendar' in the calendar.
-
-A diary entry can be preceded by the character
-`diary-nonmarking-symbol' (ordinarily `&') to make that entry
-nonmarking--that is, it will not be marked on dates in the calendar
-window but will appear in a diary window.
-
-Multiline diary entries are made by indenting lines after the first with
-either a TAB or one or more spaces.
-
-Lines not in one the above formats are ignored.  Here are some sample diary
-entries (in the default American style):
-
-     12/22/1988 Twentieth wedding anniversary!!
-     &1/1. Happy New Year!
-     10/22 Ruth's birthday.
-     21: Payday
-     Tuesday--weekly meeting with grad students at 10am
-              Supowit, Shen, Bitner, and Kapoor to attend.
-     1/13/89 Friday the thirteenth!!
-     &thu 4pm squash game with Lloyd.
-     mar 16 Dad's birthday
-     April 15, 1989 Income tax due.
-     &* 15 time cards due.
-
-If the first line of a diary entry consists only of the date or day name with
-no trailing blanks or punctuation, then that line is not displayed in the
-diary window; only the continuation lines is shown.  For example, the
-single diary entry
-
-     02/11/1989
-      Bill Blattner visits Princeton today
-      2pm Cognitive Studies Committee meeting
-      2:30-5:30 Lizzie at Lawrenceville for `Group Initiative'
-      4:00pm Jamie Tappenden
-      7:30pm Dinner at George and Ed's for Alan Ryan
-      7:30-10:00pm dance at Stewart Country Day School
-
-will appear in the diary window without the date line at the beginning.  This
-facility allows the diary window to look neater, but can cause confusion if
-used with more than one day's entries displayed.
-
-Diary entries can be based on Lisp sexps.  For example, the diary entry
-
-      %%(diary-block 11 1 1990 11 10 1990) Vacation
-
-causes the diary entry \"Vacation\" to appear from November 1 through November
-10, 1990.  Other functions available are `diary-float', `diary-anniversary',
-`diary-cyclic', `diary-day-of-year', `diary-iso-date', `diary-french-date',
-`diary-hebrew-date', `diary-islamic-date', `diary-mayan-date',
-`diary-chinese-date', `diary-coptic-date', `diary-ethiopic-date',
-`diary-persian-date', `diary-yahrzeit', `diary-sunrise-sunset',
-`diary-phases-of-moon', `diary-parasha', `diary-omer', `diary-rosh-hodesh',
-and `diary-sabbath-candles'.  See the documentation for the function
-`list-sexp-diary-entries' for more details.
-
-Diary entries based on the Hebrew and/or the Islamic calendar are also
-possible, but because these are somewhat slow, they are ignored
-unless you set the `nongregorian-diary-listing-hook' and the
-`nongregorian-diary-marking-hook' appropriately.  See the documentation
-for these functions for details.
-
-Diary files can contain directives to include the contents of other files; for
-details, see the documentation for the variable `list-diary-entries-hook'.")
-
-;;;###autoload
-(defvar diary-nonmarking-symbol "&"
-  "*Symbol indicating that a diary entry is not to be marked in the calendar.")
-
-;;;###autoload
-(defvar hebrew-diary-entry-symbol "H"
-  "*Symbol indicating a diary entry according to the Hebrew calendar.")
-
-;;;###autoload
-(defvar islamic-diary-entry-symbol "I"
-  "*Symbol indicating a diary entry according to the Islamic calendar.")
-
-;;;###autoload
-(defvar diary-include-string "#include"
-  "*The string indicating inclusion of another file of diary entries.
-See the documentation for the function `include-other-diary-files'.")
-
-;;;###autoload
-(defvar sexp-diary-entry-symbol "%%"
-  "*The string used to indicate a sexp diary entry in diary-file.
-See the documentation for the function `list-sexp-diary-entries'.")
-
-;;;###autoload
-(defvar abbreviated-calendar-year t
-  "*Interpret a two-digit year DD in a diary entry as either 19DD or 20DD.
-For the Gregorian calendar; similarly for the Hebrew and Islamic calendars.
-If this variable is nil, years must be written in full.")
-
-;;;###autoload
-(defvar european-calendar-style nil
-  "*Use the European style of dates in the diary and in any displays.
-If this variable is t, a date 1/2/1990 would be interpreted as February 1,
-1990.  The accepted European date styles are
-
-            DAY/MONTH
-            DAY/MONTH/YEAR
-            DAY MONTHNAME
-            DAY MONTHNAME YEAR
-            DAYNAME
-
-Names can be capitalized or not, written in full, or abbreviated to three
-characters with or without a period.")
-
-;;;###autoload
-(defvar american-date-diary-pattern
-  '((month "/" day "[^/0-9]")
-    (month "/" day "/" year "[^0-9]")
-    (monthname " *" day "[^,0-9]")
-    (monthname " *" day ", *" year "[^0-9]")
-    (dayname "\\W"))
-  "*List of pseudo-patterns describing the American patterns of date used.
-See the documentation of `diary-date-forms' for an explanation.")
-
-;;;###autoload
-(defvar european-date-diary-pattern
-  '((day "/" month "[^/0-9]")
-    (day "/" month "/" year "[^0-9]")
-    (backup day " *" monthname "\\W+\\<[^*0-9]")
-    (day " *" monthname " *" year "[^0-9]")
-    (dayname "\\W"))
-  "*List of pseudo-patterns describing the European patterns of date used.
-See the documentation of `diary-date-forms' for an explanation.")
-
-(defvar diary-date-forms
-  (if european-calendar-style
-      european-date-diary-pattern
-    american-date-diary-pattern)
-  "*List of pseudo-patterns describing the forms of date used in the diary.
-The patterns on the list must be MUTUALLY EXCLUSIVE and must should not match
-any portion of the diary entry itself, just the date component.
-
-A pseudo-pattern is a list of regular expressions and the keywords `month',
-`day', `year', `monthname', and `dayname'.  The keyword `monthname' will
-match the name of the month, capitalized or not, or its three-letter
-abbreviation, followed by a period or not; it will also match `*'.
-Similarly, `dayname' will match the name of the day, capitalized or not, or
-its three-letter abbreviation, followed by a period or not.  The keywords
-`month', `day', and `year' will match those numerical values, preceded by
-arbitrarily many zeros; they will also match `*'.
-
-The matching of the diary entries with the date forms is done with the
-standard syntax table from Fundamental mode, but with the `*' changed so
-that it is a word constituent.
-
-If, to be mutually exclusive, a pseudo-pattern must match a portion of the
-diary entry itself, the first element of the pattern MUST be `backup'.  This
-directive causes the date recognizer to back up to the beginning of the
-current word of the diary entry, so in no case can the pattern match more than
-a portion of the first word of the diary entry.")
-
-;;;###autoload
-(defvar european-calendar-display-form
-  '((if dayname (concat dayname ", ")) day " " monthname " " year)
-  "*Pseudo-pattern governing the way a date appears in the European style.
-See the documentation of calendar-date-display-form for an explanation.")
-
-;;;###autoload
-(defvar american-calendar-display-form
-  '((if dayname (concat dayname ", ")) monthname " " day ", " year)
-  "*Pseudo-pattern governing the way a date appears in the American style.
-See the documentation of `calendar-date-display-form' for an explanation.")
-
-(defvar calendar-date-display-form
-  (if european-calendar-style
-      european-calendar-display-form
-    american-calendar-display-form)
-  "*Pseudo-pattern governing the way a date appears.
-
-Used by the function `calendar-date-string', a pseudo-pattern is a list of
-expressions that can involve the keywords `month', `day', and `year', all
-numbers in string form, and `monthname' and `dayname', both alphabetic
-strings.  For example, the ISO standard would use the pseudo- pattern
-
-       '(year \"-\" month \"-\" day)
-
-while a typical American form would be
-
-       '(month \"/\" day \"/\" (substring year -2))
-
-and
-
-       '((format \"%9s, %9s %2s, %4s\" dayname monthname day year))
-
-would give the usual American style in fixed-length fields.
-
-See the documentation of the function `calendar-date-string'.")
-
-(defun european-calendar ()
-  "Set the interpretation and display of dates to the European style."
-  (interactive)
-  (setq european-calendar-style t)
-  (setq calendar-date-display-form european-calendar-display-form)
-  (setq diary-date-forms european-date-diary-pattern)
-  (update-calendar-mode-line))
-
-(defun american-calendar ()
-  "Set the interpretation and display of dates to the American style."
-  (interactive)
-  (setq european-calendar-style nil)
-  (setq calendar-date-display-form american-calendar-display-form)
-  (setq diary-date-forms american-date-diary-pattern)
-  (update-calendar-mode-line))
-
-;;;###autoload
-(defvar print-diary-entries-hook 'lpr-buffer
-  "*List of functions called after a temporary diary buffer is prepared.
-The buffer shows only the diary entries currently visible in the diary
-buffer.  The default just does the printing.  Other uses might include, for
-example, rearranging the lines into order by day and time, saving the buffer
-instead of deleting it, or changing the function used to do the printing.")
-
-;;;###autoload
-(defvar list-diary-entries-hook nil
-  "*List of functions called after diary file is culled for relevant entries.
-It is to be used for diary entries that are not found in the diary file.
-
-A function `include-other-diary-files' is provided for use as the value of
-this hook.  This function enables you to use shared diary files together
-with your own.  The files included are specified in the diary file by lines
-of the form
-
-        #include \"filename\"
-
-This is recursive; that is, #include directives in files thus included are
-obeyed.  You can change the \"#include\" to some other string by changing
-the variable `diary-include-string'.  When you use `include-other-diary-files'
-as part of the list-diary-entries-hook, you will probably also want to use the
-function `mark-included-diary-files' as part of `mark-diary-entries-hook'.
-
-For example, you could use
-
-     (setq list-diary-entries-hook
-       '(include-other-diary-files sort-diary-entries))
-     (setq diary-display-hook 'fancy-diary-display)
-
-in your `.emacs' file to cause the fancy diary buffer to be displayed with
-diary entries from various included files, each day's entries sorted into
-lexicographic order.")
-
-;;;###autoload
-(defvar diary-hook nil
-  "*List of functions called after the display of the diary.
-Can be used for appointment notification.")
-
-;;;###autoload
-(defvar diary-display-hook nil
-  "*List of functions that handle the display of the diary.
-If nil (the default), `simple-diary-display' is used.  Use `ignore' for no
-diary display.
-
-Ordinarily, this just displays the diary buffer (with holidays indicated in
-the mode line), if there are any relevant entries.  At the time these
-functions are called, the variable `diary-entries-list' is a list, in order
-by date, of all relevant diary entries in the form of ((MONTH DAY YEAR)
-STRING), where string is the diary entry for the given date.  This can be
-used, for example, a different buffer for display (perhaps combined with
-holidays), or produce hard copy output.
-
-A function `fancy-diary-display' is provided as an alternative
-choice for this hook; this function prepares a special noneditable diary
-buffer with the relevant diary entries that has neat day-by-day arrangement
-with headings.  The fancy diary buffer will show the holidays unless the
-variable `holidays-in-diary-buffer' is set to nil.  Ordinarily, the fancy
-diary buffer will not show days for which there are no diary entries, even
-if that day is a holiday; if you want such days to be shown in the fancy
-diary buffer, set the variable `diary-list-include-blanks' to t.")
-
-;;;###autoload
-(defvar nongregorian-diary-listing-hook nil
-  "*List of functions called for listing diary file and included files.
-As the files are processed for diary entries, these functions are used to cull
-relevant entries.  You can use either or both of `list-hebrew-diary-entries'
-and `list-islamic-diary-entries'.  The documentation for these functions
-describes the style of such diary entries.")
-
-;;;###autoload
-(defvar mark-diary-entries-hook nil
-  "*List of functions called after marking diary entries in the calendar.
-
-A function `mark-included-diary-files' is also provided for use as the
-mark-diary-entries-hook; it enables you to use shared diary files together
-with your own.  The files included are specified in the diary file by lines
-of the form
-        #include \"filename\"
-This is recursive; that is, #include directives in files thus included are
-obeyed.  You can change the \"#include\" to some other string by changing the
-variable `diary-include-string'.  When you use `mark-included-diary-files' as
-part of the mark-diary-entries-hook, you will probably also want to use the
-function `include-other-diary-files' as part of `list-diary-entries-hook'.")
-
-;;;###autoload
-(defvar nongregorian-diary-marking-hook nil
-  "*List of functions called for marking diary file and included files.
-As the files are processed for diary entries, these functions are used to cull
-relevant entries.  You can use either or both of `mark-hebrew-diary-entries'
-and `mark-islamic-diary-entries'.  The documentation for these functions
-describes the style of such diary entries.")
-
-;;;###autoload
-(defvar diary-list-include-blanks nil
-  "*If nil, do not include days with no diary entry in the list of diary entries.
-Such days will then not be shown in the the fancy diary buffer, even if they
-are holidays.")
-
-;;;###autoload
-(defvar holidays-in-diary-buffer t
-  "*Non-nil means include holidays in the diary display.
-The holidays appear in the mode line of the diary buffer, or in the
-fancy diary buffer next to the date.  This slows down the diary functions
-somewhat; setting it to nil makes the diary display faster.")
-
-(defvar calendar-mark-ring nil)
-
-;;;###autoload
-(put 'general-holidays 'risky-local-variable t)
-;;;###autoload
-(defvar general-holidays
-  '((holiday-fixed 1 1 "New Year's Day")
-    (holiday-float 1 1 3 "Martin Luther King Day")
-    (holiday-fixed 2 2 "Ground Hog Day")
-    (holiday-fixed 2 14 "Valentine's Day")
-    (holiday-float 2 1 3 "President's Day")
-    (holiday-fixed 3 17 "St. Patrick's Day")
-    (holiday-fixed 4 1 "April Fools' Day")
-    (holiday-float 5 0 2 "Mother's Day")
-    (holiday-float 5 1 -1 "Memorial Day")
-    (holiday-fixed 6 14 "Flag Day")
-    (holiday-float 6 0 3 "Father's Day")
-    (holiday-fixed 7 4 "Independence Day")
-    (holiday-float 9 1 1 "Labor Day")
-    (holiday-float 10 1 2 "Columbus Day")
-    (holiday-fixed 10 31 "Halloween")
-    (holiday-fixed 11 11 "Veteran's Day")
-    (holiday-float 11 4 4 "Thanksgiving"))
-  "*General holidays.  Default value is for the United States.
-See the documentation for `calendar-holidays' for details.")
-
-;;;###autoload
-(put 'oriental-holidays 'risky-local-variable t)
-;;;###autoload
-(defvar oriental-holidays
-  '((if (fboundp 'atan)
-	(holiday-chinese-new-year)))
-  "*Oriental holidays.
-See the documentation for `calendar-holidays' for details.")
-
-;;;###autoload
-(put 'local-holidays 'risky-local-variable t)
-;;;###autoload
-(defvar local-holidays nil
-  "*Local holidays.
-See the documentation for `calendar-holidays' for details.")
-
-;;;###autoload
-(put 'other-holidays 'risky-local-variable t)
-;;;###autoload
-(defvar other-holidays nil
-  "*User defined holidays.
-See the documentation for `calendar-holidays' for details.")
-
-;;;###autoload
-(put 'hebrew-holidays-1 'risky-local-variable t)
-;;;###autoload
-(defvar hebrew-holidays-1
-  '((holiday-rosh-hashanah-etc)
-    (if all-hebrew-calendar-holidays
-        (holiday-julian
-         11
-         (let* ((m displayed-month)
-                (y displayed-year)
-                (year))
-           (increment-calendar-month m y -1)
-           (let ((year (extract-calendar-year
-                        (calendar-julian-from-absolute
-                         (calendar-absolute-from-gregorian
-                          (list m 1 y))))))
-             (if (zerop (% (1+ year) 4))
-                 22
-               21))) "\"Tal Umatar\" (evening)"))))
-
-;;;###autoload
-(put 'hebrew-holidays-2 'risky-local-variable t)
-;;;###autoload
-(defvar hebrew-holidays-2
-  '((if all-hebrew-calendar-holidays
-        (holiday-hanukkah)
-      (holiday-hebrew 9 25 "Hanukkah"))
-    (if all-hebrew-calendar-holidays
-      (holiday-hebrew
-       10
-       (let ((h-year (extract-calendar-year
-                      (calendar-hebrew-from-absolute
-                       (calendar-absolute-from-gregorian
-                        (list displayed-month 28 displayed-year))))))
-         (if (= (% (calendar-absolute-from-hebrew (list 10 10 h-year))
-                   7)
-                6)
-             11 10))
-       "Tzom Teveth"))
-    (if all-hebrew-calendar-holidays
-        (holiday-hebrew 11 15 "Tu B'Shevat"))))
-
-;;;###autoload
-(put 'hebrew-holidays-3 'risky-local-variable t)
-;;;###autoload
-(defvar hebrew-holidays-3
-  '((if all-hebrew-calendar-holidays
-        (holiday-hebrew
-         11
-         (let ((m displayed-month)
-               (y displayed-year))
-           (increment-calendar-month m y 1)
-           (let* ((h-year (extract-calendar-year
-                           (calendar-hebrew-from-absolute
-                            (calendar-absolute-from-gregorian
-                             (list m
-                                   (calendar-last-day-of-month m y)
-                                   y)))))
-                  (s-s
-                   (calendar-hebrew-from-absolute
-                    (if (=
-                         (% (calendar-absolute-from-hebrew
-                             (list 7 1 h-year))
-                            7)
-                         6)
-                        (calendar-dayname-on-or-before
-                         6 (calendar-absolute-from-hebrew
-                            (list 11 17 h-year)))
-                      (calendar-dayname-on-or-before
-                       6 (calendar-absolute-from-hebrew
-                          (list 11 16 h-year))))))
-                  (day (extract-calendar-day s-s)))
-             day))
-         "Shabbat Shirah"))))
-
-;;;###autoload
-(put 'hebrew-holidays-4 'risky-local-variable t)
-;;;###autoload
-(defvar hebrew-holidays-4
-  '((holiday-passover-etc)
-    (if (and all-hebrew-calendar-holidays
-             (let* ((m displayed-month)
-                    (y displayed-year)
-                    (year))
-               (increment-calendar-month m y -1)
-               (let ((year (extract-calendar-year
-                            (calendar-julian-from-absolute
-                             (calendar-absolute-from-gregorian
-                              (list m 1 y))))))
-                 (= 21 (% year 28)))))
-        (holiday-julian 3 26 "Kiddush HaHamah"))
-    (if all-hebrew-calendar-holidays
-        (holiday-tisha-b-av-etc))))
-
-;;;###autoload
-(put 'hebrew-holidays 'risky-local-variable t)
-;;;###autoload
-(defvar hebrew-holidays (append hebrew-holidays-1 hebrew-holidays-2
-				hebrew-holidays-3 hebrew-holidays-4)
-  "*Jewish holidays.
-See the documentation for `calendar-holidays' for details.")
-
-;;;###autoload
-(put 'christian-holidays 'risky-local-variable t)
-;;;###autoload
-(defvar christian-holidays
-  '((if all-christian-calendar-holidays
-        (holiday-fixed 1 6 "Epiphany"))
-    (holiday-easter-etc)
-    (if all-christian-calendar-holidays
-        (holiday-greek-orthodox-easter))
-    (if all-christian-calendar-holidays
-        (holiday-fixed 8 15 "Assumption"))
-    (if all-christian-calendar-holidays
-        (holiday-advent))
-    (holiday-fixed 12 25 "Christmas")
-    (if all-christian-calendar-holidays
-        (holiday-julian 12 25 "Eastern Orthodox Christmas")))
-  "*Christian holidays.
-See the documentation for `calendar-holidays' for details.")
-
-;;;###autoload
-(put 'islamic-holidays 'risky-local-variable t)
-;;;###autoload
-(defvar islamic-holidays
-  '((holiday-islamic
-     1 1
-     (format "Islamic New Year %d"
-             (let ((m displayed-month)
-                   (y displayed-year))
-               (increment-calendar-month m y 1)
-               (extract-calendar-year
-                (calendar-islamic-from-absolute
-                 (calendar-absolute-from-gregorian
-                  (list
-                   m (calendar-last-day-of-month m y) y)))))))
-    (if all-islamic-calendar-holidays
-        (holiday-islamic 1 10 "Ashura"))
-    (if all-islamic-calendar-holidays
-        (holiday-islamic 3 12 "Mulad-al-Nabi"))
-    (if all-islamic-calendar-holidays
-        (holiday-islamic 7 26 "Shab-e-Mi'raj"))
-    (if all-islamic-calendar-holidays
-        (holiday-islamic 8 15 "Shab-e-Bara't"))
-    (holiday-islamic 9 1 "Ramadan Begins")
-    (if all-islamic-calendar-holidays
-        (holiday-islamic 9 27 "Shab-e Qadr"))
-    (if all-islamic-calendar-holidays
-        (holiday-islamic 10 1 "Id-al-Fitr"))
-    (if all-islamic-calendar-holidays
-        (holiday-islamic 12 10 "Id-al-Adha")))
-  "*Islamic holidays.
-See the documentation for `calendar-holidays' for details.")
-
-;;;###autoload
-(put 'solar-holidays 'risky-local-variable t)
-;;;###autoload
-(defvar solar-holidays
-  '((if (fboundp 'atan)
-	(solar-equinoxes-solstices))
-    (if (progn
-	  (require 'cal-dst)
-	  t)
-      (funcall
-       'holiday-sexp
-        calendar-daylight-savings-starts
-        '(format "Daylight Savings Time Begins %s"
-                  (if (fboundp 'atan)
-                      (solar-time-string
-                       (/ calendar-daylight-savings-starts-time (float 60))
-                       calendar-standard-time-zone-name)
-                    ""))))
-    (funcall
-     'holiday-sexp
-     calendar-daylight-savings-ends
-     '(format "Daylight Savings Time Ends %s"
-              (if (fboundp 'atan)
-                  (solar-time-string
-                   (/ calendar-daylight-savings-ends-time (float 60))
-                   calendar-daylight-time-zone-name)
-                ""))))
-  "*Sun-related holidays.
-See the documentation for `calendar-holidays' for details.")
-
-;;;###autoload
-(put 'calendar-holidays 'risky-local-variable t)
-(defvar calendar-holidays
-  (append general-holidays local-holidays other-holidays
-          christian-holidays hebrew-holidays islamic-holidays
-          oriental-holidays solar-holidays)
-  "*List of notable days for the command M-x holidays.
-
-Additional holidays are easy to add to the list, just put them in the list
-`other-holidays' in your .emacs file.  Similarly, by setting any of
-`general-holidays', `local-holidays' `christian-holidays', `hebrew-holidays',
-`islamic-holidays', `oriental-holidays', or `solar-holidays' to nil in your
-.emacs file, you can eliminate unwanted categories of holidays.  The intention
-is that (in the US) `local-holidays' be set in site-init.el and
-`other-holidays' be set by the user.
-
-Entries on the list are expressions that return (possibly empty) lists of
-items of the form ((month day year) string) of a holiday in the in the
-three-month period centered around `displayed-month' of `displayed-year'.
-Several basic functions are provided for this purpose:
-
-    (holiday-fixed MONTH DAY STRING) is a fixed date on the Gregorian calendar
-    (holiday-float MONTH DAYNAME K STRING &optional day) is the Kth DAYNAME in
-                               MONTH on the Gregorian calendar (0 for Sunday,
-                               etc.); K<0 means count back from the end of the
-                               month. An optional parameter DAY means the Kth
-                               DAYNAME after/before MONTH DAY.
-    (holiday-hebrew MONTH DAY STRING)  a fixed date on the Hebrew calendar
-    (holiday-islamic MONTH DAY STRING) a fixed date on the Islamic calendar
-    (holiday-julian MONTH DAY STRING)  a fixed date on the Julian calendar
-    (holiday-sexp SEXP STRING) SEXP is a Gregorian-date-valued expression
-                               in the variable `year'; if it evaluates to
-                               a visible date, that's the holiday; if it
-                               evaluates to nil, there's no holiday.  STRING
-                               is an expression in the variable `date'.
-
-For example, to add Bastille Day, celebrated in France on July 14, add
-
-     (holiday-fixed 7 14 \"Bastille Day\")
-
-to the list.  To add Hurricane Supplication Day, celebrated in the Virgin
-Islands on the fourth Monday in August, add
-
-     (holiday-float 8 1 4 \"Hurricane Supplication Day\")
-
-to the list (the last Monday would be specified with `-1' instead of `4').
-To add the last day of Hanukkah to the list, use
-
-     (holiday-hebrew 10 2 \"Last day of Hanukkah\")
-
-since the Hebrew months are numbered with 1 starting from Nisan, while to
-add the Islamic feast celebrating Mohammed's birthday use
-
-     (holiday-islamic 3 12 \"Mohammed's Birthday\")
-
-since the Islamic months are numbered from 1 starting with Muharram.  To
-add Thomas Jefferson's birthday, April 2, 1743 (Julian), use
-
-     (holiday-julian 4 2 \"Jefferson's Birthday\")
-
-To include a holiday conditionally, use the sexp form or a conditional.  For
-example, to include American presidential elections, which occur on the first
-Tuesday after the first Monday in November of years divisible by 4, add
-
-     (holiday-sexp
-       (if (zerop (% year 4))
-           (calendar-gregorian-from-absolute
-             (1+ (calendar-dayname-on-or-before
-                   1 (+ 6 (calendar-absolute-from-gregorian
-                            (list 11 1 year)))))))
-       \"US Presidential Election\")
-
-or
-
-     (if (zerop (% displayed-year 4))
-         (holiday-fixed 11
-                (extract-calendar-day
-                 (calendar-gregorian-from-absolute
-                  (1+ (calendar-dayname-on-or-before
-                       1 (+ 6 (calendar-absolute-from-gregorian
-                               (list 11 1 displayed-year)))))))
-                \"US Presidential Election\"))
-
-to the list.  To include the phases of the moon, add
-
-     (lunar-phases)
-
-to the holiday list, where `lunar-phases' is an Emacs-Lisp function that
-you've written to return a (possibly empty) list of the relevant VISIBLE dates
-with descriptive strings such as
-
-     (((2 6 1989) \"New Moon\") ((2 12 1989) \"First Quarter Moon\") ... ).")
-
-(defconst calendar-buffer "*Calendar*"
-  "Name of the buffer used for the calendar.")
-
-(defconst holiday-buffer "*Holidays*"
-  "Name of the buffer used for the displaying the holidays.")
-
-(defconst fancy-diary-buffer "*Fancy Diary Entries*"
-  "Name of the buffer used for the optional fancy display of the diary.")
-
-(defconst lunar-phases-buffer "*Phases of Moon*"
-  "Name of the buffer used for the lunar phases.")
-
-(defmacro increment-calendar-month (mon yr n)
-  "Move the variables MON and YR to the month and year by N months.
-Forward if N is positive or backward if N is negative."
-  (` (let (( macro-y (+ (* (, yr) 12) (, mon) -1 (, n) )))
-       (setq (, mon) (1+ (% macro-y 12) ))
-       (setq (, yr) (/ macro-y 12)))))
-
-(defmacro calendar-for-loop (var from init to final do &rest body)
-  "Execute a for loop."
-  (` (let (( (, var) (1- (, init)) ))
-       (while (>= (, final) (setq (, var) (1+ (, var))))
-         (,@ body)))))
-
-(defmacro calendar-sum (index initial condition expression)
-  "For INDEX = INITIAL et seq, as long as CONDITION holds, sum EXPRESSION."
-  (` (let (( (, index) (, initial))
-             (sum 0))
-       (while (, condition)
-         (setq sum (+ sum (, expression) ))
-         (setq (, index) (1+ (, index))))
-       sum)))
-
-;; The following are in-line for speed; they can be called thousands of times
-;; when looking up holidays or processing the diary.  Here, for example, are
-;; the numbers of calls to calendar/diary/holiday functions in preparing the
-;; fancy diary display, for a moderately complex diary file, with functions
-;; used instead of macros.  There were a total of 10000 such calls:
-;;
-;;  1934   extract-calendar-month
-;;  1852   extract-calendar-year
-;;  1819   extract-calendar-day
-;;   845   calendar-leap-year-p
-;;   837   calendar-day-number
-;;   775   calendar-absolute-from-gregorian
-;;   346   calendar-last-day-of-month
-;;   286   hebrew-calendar-last-day-of-month
-;;   188   hebrew-calendar-leap-year-p
-;;   180   hebrew-calendar-elapsed-days
-;;   163   hebrew-calendar-last-month-of-year
-;;    66   calendar-date-compare
-;;    65   hebrew-calendar-days-in-year
-;;    60   calendar-absolute-from-julian
-;;    50   calendar-absolute-from-hebrew
-;;    43   calendar-date-equal
-;;    38   calendar-gregorian-from-absolute
-;;     .
-;;     .
-;;     .
-;;
-;; The use of these seven macros eliminates the overhead of 92% of the function
-;; calls; it's faster this way.
-
-(defsubst extract-calendar-month (date)
-  "Extract the month part of DATE which has the form (month day year)."
-  (car date))
-
-(defsubst extract-calendar-day (date)
-  "Extract the day part of DATE which has the form (month day year)."
-  (car (cdr date)))
-
-(defsubst extract-calendar-year (date)
-  "Extract the year part of DATE which has the form (month day year)."
-  (car (cdr (cdr date))))
-
-(defsubst calendar-leap-year-p (year)
-  "Returns t if YEAR is a Gregorian leap year."
-  (and (zerop (% year 4))
-       (or (not (zerop (% year 100)))
-           (zerop (% year 400)))))
-
-;; The foregoing is a bit faster, but not as clear as the following:
-;;
-;;(defsubst calendar-leap-year-p (year)
-;;  "Returns t if YEAR is a Gregorian leap year."
-;;  (or
-;;    (and (=  (% year   4) 0)
-;;         (/= (% year 100) 0))
-;;    (= (% year 400) 0)))
-
-(defsubst calendar-last-day-of-month (month year)
-  "The last day in MONTH during YEAR."
-  (if (and (= month 2) (calendar-leap-year-p year))
-      29
-    (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
-
-;; An explanation of the calculation can be found in PascAlgorithms by
-;; Edward and Ruth Reingold, Scott-Foresman/Little, Brown, 1988.
-
-(defsubst calendar-day-number (date)
-  "Return the day number within the year of the date DATE.
-For example, (calendar-day-number '(1 1 1987)) returns the value 1,
-while (calendar-day-number '(12 31 1980)) returns 366."
-    (let* ((month (extract-calendar-month date))
-           (day (extract-calendar-day date))
-           (year (extract-calendar-year date))
-         (day-of-year (+ day (* 31 (1- month)))))
-      (if (> month 2)
-          (progn
-            (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
-            (if (calendar-leap-year-p year)
-                (setq day-of-year (1+ day-of-year)))))
-      day-of-year))
-
-(defsubst calendar-absolute-from-gregorian (date)
-  "The number of days elapsed between the Gregorian date 12/31/1 BC and DATE.
-The Gregorian date Sunday, December 31, 1 BC is imaginary."
-  (let ((prior-years (1- (extract-calendar-year date))))
-    (+ (calendar-day-number date);; Days this year
-       (* 365 prior-years);;        + Days in prior years
-       (/ prior-years 4);;          + Julian leap years
-       (- (/ prior-years 100));;    - century years
-       (/ prior-years 400))));;     + Gregorian leap years
-
-(autoload 'calendar-goto-today "cal-move"
-  "Reposition the calendar window so the current date is visible."
-  t)
-
-(autoload 'calendar-forward-month "cal-move"
-  "Move the cursor forward ARG months."
-  t)
-
-(autoload 'calendar-forward-year "cal-move"
-  "Move the cursor forward by ARG years."
-  t)
-
-(autoload 'calendar-backward-month "cal-move"
-  "Move the cursor backward by ARG months."
-  t)
-
-(autoload 'calendar-backward-year "cal-move"
-  "Move the cursor backward ARG years."
-  t)
-
-(autoload 'scroll-calendar-left "cal-move"
-  "Scroll the displayed calendar left by ARG months."
-  t)
-
-(autoload 'scroll-calendar-right "cal-move"
-  "Scroll the displayed calendar window right by ARG months."
-  t)
-
-(autoload 'scroll-calendar-left-three-months "cal-move"
-  "Scroll the displayed calendar window left by 3*ARG months."
-  t)
-
-(autoload 'scroll-calendar-right-three-months "cal-move"
-  "Scroll the displayed calendar window right by 3*ARG months."
-  t)
-
-(autoload 'calendar-cursor-to-nearest-date "cal-move"
-  "Move the cursor to the closest date."
-  t)
-
-(autoload 'calendar-forward-day "cal-move"
-  "Move the cursor forward ARG days."
-  t)
-
-(autoload 'calendar-backward-day "cal-move"
-  "Move the cursor back ARG days."
-  t)
-
-(autoload 'calendar-forward-week "cal-move"
-  "Move the cursor forward ARG weeks."
-  t)
-
-(autoload 'calendar-backward-week "cal-move"
-  "Move the cursor back ARG weeks."
-  t)
-
-(autoload 'calendar-beginning-of-week "cal-move"
-  "Move the cursor back ARG calendar-week-start-day's."
-  t)
-
-(autoload 'calendar-end-of-week "cal-move"
-  "Move the cursor forward ARG calendar-week-start-day+6's."
-  t)
-
-(autoload 'calendar-beginning-of-month "cal-move"
-  "Move the cursor backward ARG month beginnings."
-  t)
-
-(autoload 'calendar-end-of-month "cal-move"
-  "Move the cursor forward ARG month ends."
-  t)
-
-(autoload 'calendar-beginning-of-year "cal-move"
-  "Move the cursor backward ARG year beginnings."
-  t)
-
-(autoload 'calendar-end-of-year "cal-move"
-  "Move the cursor forward ARG year beginnings."
-  t)
-
-(autoload 'calendar-cursor-to-visible-date "cal-move"
-  "Move the cursor to DATE that is on the screen."
-  t)
-
-(autoload 'calendar-goto-date "cal-move"
-  "Move cursor to DATE."
-  t)
-
-(autoload 'calendar-one-frame-setup "cal-x"
-  "Start calendar and display it in a dedicated frame together with the diary.")
-
-(autoload 'calendar-two-frame-setup "cal-x"
-  "Start calendar and diary in separate, dedicated frames.")
-  
-;;;###autoload
-(defvar calendar-setup nil
-  "The frame set up of the calendar.
-The choices are `one-frame' (calendar and diary together in one separate,
-dedicated frame) or `two-frames' (calendar and diary in separate, dedicated
-frames); with any other value the current frame is used.")
-
-;;;###autoload
-(defun calendar (&optional arg)
-  "Choose between the one frame, two frame, or basic calendar displays.
-The original function `calendar' has been renamed `calendar-basic-setup'."
-  (interactive "P")
-  (cond ((equal calendar-setup 'one-frame) (calendar-one-frame-setup arg))
-        ((equal calendar-setup 'two-frames) (calendar-two-frame-setup arg))
-        (t (calendar-basic-setup arg))))
-
-(defun calendar-basic-setup (&optional arg)
-  "Display a three-month calendar in another window.
-The three months appear side by side, with the current month in the middle
-surrounded by the previous and next months.  The cursor is put on today's date.
-
-If called with an optional prefix argument, prompts for month and year.
-
-This function is suitable for execution in a .emacs file; appropriate setting
-of the variable `view-diary-entries-initially' will cause the diary entries for
-the current date to be displayed in another window.  The value of the variable
-`number-of-diary-entries' controls the number of days of diary entries
-displayed upon initial display of the calendar.
-
-An optional prefix argument ARG causes the calendar displayed to be ARG
-months in the future if ARG is positive or in the past if ARG is negative;
-in this case the cursor goes on the first day of the month.
-
-Once in the calendar window, future or past months can be moved into view.
-Arbitrary months can be displayed, or the calendar can be scrolled forward
-or backward.
-
-The cursor can be moved forward or backward by one day, one week, one month,
-or one year.  All of these commands take prefix arguments which, when negative,
-cause movement in the opposite direction.  For convenience, the digit keys
-and the minus sign are automatically prefixes.  The window is replotted as
-necessary to display the desired date.
-
-Diary entries can be marked on the calendar or displayed in another window.
-
-Use M-x describe-mode for details of the key bindings in the calendar window.
-
-The Gregorian calendar is assumed.
-
-After loading the calendar, the hooks given by the variable
-`calendar-load-hook' are run.  This is the place to add key bindings to the
-calendar-mode-map.
-
-After preparing the calendar window initially, the hooks given by the variable
-`initial-calendar-window-hook' are run.
-
-The hooks given by the variable `today-visible-calendar-hook' are run
-every time the calendar window gets scrolled, if the current date is visible
-in the window.  If it is not visible, the hooks given by the variable
-`today-invisible-calendar-hook' are run.  Thus, for example, setting
-`today-visible-calendar-hook' to 'calendar-star-date will cause today's date
-to be replaced by asterisks to highlight it whenever it is in the window."
-  (interactive "P")
-  (set-buffer (get-buffer-create calendar-buffer))
-  (calendar-mode)
-  (let* ((pop-up-windows t)
-         (split-height-threshold 1000)
-         (date (if arg
-                   (calendar-read-date t)
-                 (calendar-current-date)))
-         (month (extract-calendar-month date))
-         (year (extract-calendar-year date)))
-    (pop-to-buffer calendar-buffer)
-    (increment-calendar-month month year (- calendar-offset))
-    (generate-calendar-window month year)
-    (if (and view-diary-entries-initially (calendar-date-is-visible-p date))
-        (view-diary-entries
-         (if (vectorp number-of-diary-entries)
-             (aref number-of-diary-entries (calendar-day-of-week date))
-           number-of-diary-entries))))
-  (let* ((diary-buffer (get-file-buffer diary-file))
-         (diary-window (if diary-buffer (get-buffer-window diary-buffer)))
-         (split-height-threshold (if diary-window 2 1000)))
-    (if view-calendar-holidays-initially
-        (list-calendar-holidays)))
-  (run-hooks 'initial-calendar-window-hook))
-
-(autoload 'view-diary-entries "diary-lib"
-  "Prepare and display a buffer with diary entries.
-Searches your diary file for entries that match ARG days starting with
-the date indicated by the cursor position in the displayed three-month
-calendar."
-  t)
-
-(autoload 'calendar-sunrise-sunset "solar"
-  "Local time of sunrise and sunset for date under cursor."
-  t)
-
-(autoload 'calendar-phases-of-moon "lunar"
-  "Create a buffer of the phases of the moon for the current calendar window."
-  t)
-
-(autoload 'calendar-print-french-date "cal-french"
-  "Show the French Revolutionary calendar equivalent of the date under the cursor."
-  t)
-
-(autoload 'calendar-goto-french-date "cal-french"
- "Move cursor to French Revolutionary date."
-  t)
-
-(autoload 'calendar-french-date-string "cal-french"
-  "String of French Revolutionary date of Gregorian date."
-  t)
-
-(autoload 'calendar-mayan-date-string "cal-mayan"
-  "String of Mayan date of Gregorian date."
-  t)
-
-(autoload 'calendar-print-mayan-date "cal-mayan"
-  "Show the Mayan long count, Tzolkin, and Haab equivalents of the date under the cursor."
-  t)
-
-(autoload 'calendar-goto-mayan-long-count-date "cal-mayan"
- "Move cursor to Mayan long count date."
-  t)
-
-(autoload 'calendar-next-haab-date "cal-mayan"
-  "Move cursor to next instance of Mayan Haab date."
-  t)
-
-(autoload 'calendar-previous-haab-date "cal-mayan"
-  "Move cursor to previous instance of Mayan Haab date."
-  t)
-
-(autoload 'calendar-next-tzolkin-date "cal-mayan"
-  "Move cursor to next instance of Mayan Tzolkin date."
-  t)
-
-(autoload 'calendar-previous-tzolkin-date "cal-mayan"
-  "Move cursor to previous instance of Mayan Tzolkin date."
-  t)
-
-(autoload 'calendar-next-calendar-round-date "cal-mayan"
-  "Move cursor to next instance of Mayan Haab/Tzolkin combination."
-  t)
-
-(autoload 'calendar-previous-calendar-round-date "cal-mayan"
-  "Move cursor to previous instance of Mayan Haab/Tzolkin combination."
-  t)
-
-(autoload 'calendar-goto-chinese-date "cal-china"
-   "Move cursor to Chinese date."
-   t)
-
-(autoload 'calendar-print-chinese-date "cal-china"
- "Show the Chinese date equivalents of date."
- t)
-
-(autoload 'calendar-chinese-date-string "cal-china"
-  "String of Chinese date of Gregorian date."
-  t)
-
-(autoload 'calendar-absolute-from-astro
-  "Absolute date of astronomical (Julian) day number D."
-  "cal-julian")
-
-(autoload 'calendar-astro-from-absolute "cal-julian"
-  "Astronomical (Julian) day number of absolute date D.")
-
-(autoload 'calendar-astro-date-string "cal-julian"
-  "String of astronomical (Julian) day number of Gregorian date."
-  t)
-
-(autoload 'calendar-goto-astro-date "cal-julian"
-   "Move cursor to astronomical (Julian) day number."
-   t)
-
-(autoload 'calendar-julian-from-absolute "cal-julian"
-  "Compute the Julian (month day year) corresponding to the absolute DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC.")
-
-(autoload 'calendar-goto-julian-date "cal-julian"
-  "Move cursor to Julian DATE; echo Julian date unless NOECHO is t."
-  t)
-
-(autoload 'calendar-julian-date-string "cal-julian"
-  "String of Julian date of Gregorian DATE.
-Defaults to today's date if DATE is not given.
-Driven by the variable `calendar-date-display-form'."
-  t)
-
-(autoload 'calendar-goto-iso-date "cal-iso"
-  "Move cursor to ISO date."
-  t)
-
-(autoload 'calendar-print-iso-date "cal-iso"
-  "Show the ISO date equivalents of date."
-  t)
-
-(autoload 'calendar-iso-date-string "cal-iso"
-  "String of ISO date of Gregorian date."
-  t)
-
-(autoload 'calendar-print-islamic-date "cal-islam"
-  "Show the Islamic date equivalents of date."
-  t)
-
-(autoload 'calendar-islamic-date-string "cal-islam"
-  "String of Islamic date of Gregorian date."
-  t)
-
-(autoload 'calendar-goto-hebrew-date "cal-hebrew"
-  "Move cursor to Hebrew date date."
-  t)
-
-(autoload 'calendar-print-hebrew-date "cal-hebrew"
-  "Show the Hebrew date equivalents of date."
-  t)
-
-(autoload 'calendar-hebrew-date-string "cal-hebrew"
-  "String of Hebrew date of Gregorian date."
-  t)
-
-(autoload 'calendar-goto-coptic-date "cal-coptic"
-   "Move cursor to Coptic date date."
-   t)
-
-(autoload 'calendar-print-coptic-date "cal-coptic"
- "Show the Coptic date equivalents of date."
- t)
-
-(autoload 'calendar-coptic-date-string "cal-coptic"
-  "String of Coptic date of Gregorian date."
-  t)
-
-(autoload 'calendar-goto-ethiopic-date "cal-coptic"
-   "Move cursor to Ethiopic date date."
-   t)
-
-(autoload 'calendar-print-ethiopic-date "cal-coptic"
- "Show the Ethiopic date equivalents of date."
- t)
-
-(autoload 'calendar-ethiopic-date-string "cal-coptic"
-  "String of Ethiopic date of Gregorian date."
-  t)
-
-(autoload 'calendar-goto-persian-date "cal-persia"
-   "Move cursor to Persian date date."
-   t)
-
-(autoload 'calendar-print-persian-date "cal-persia"
- "Show the Persian date equivalents of date."
- t)
-
-(autoload 'calendar-persian-date-string "cal-persia"
-  "String of Persian date of Gregorian date."
-  t)
-
-(autoload 'show-all-diary-entries "diary-lib"
-  "Show all of the diary entries in the diary file.
-This function gets rid of the selective display of the diary file so that
-all entries, not just some, are visible.  If there is no diary buffer, one
-is created."
-  t)
-
-(autoload 'mark-diary-entries "diary-lib"
-  "Mark days in the calendar window that have diary entries.
-Each entry in diary file visible in the calendar window is marked."
-  t)
-
-(autoload 'make-diary-entry "diary-lib"
-  "Insert a diary entry STRING which may be NONMARKING in FILE."
-  t)
-
-(autoload 'insert-diary-entry "diary-lib"
-  "Insert a diary entry for the date indicated by point."
-  t)
-
-(autoload 'insert-weekly-diary-entry "diary-lib"
-  "Insert a weekly diary entry for the day of the week indicated by point."
-  t)
-
-
-(autoload 'insert-monthly-diary-entry "diary-lib"
-  "Insert a monthly diary entry for the day of the month indicated by point."
-  t)
-
-(autoload 'insert-yearly-diary-entry "diary-lib"
-  "Insert an annual diary entry for the day of the year indicated by point."
-  t)
-
-(autoload 'insert-anniversary-diary-entry "diary-lib"
-  "Insert an anniversary diary entry for the date indicated by point."
-  t)
-
-(autoload 'insert-block-diary-entry "diary-lib"
-  "Insert a block diary entry for the dates indicated by point and mark."
-  t)
-
-(autoload 'insert-cyclic-diary-entry "diary-lib"
-  "Insert a cyclic diary entry starting at the date indicated by point."
-  t)
-
-(autoload 'insert-hebrew-diary-entry "cal-hebrew"
-  "Insert a diary entry for the Hebrew date corresponding to the date
-indicated by point."
-  t)
-
-(autoload 'insert-monthly-hebrew-diary-entry "cal-hebrew"
-  "Insert a monthly diary entry for the day of the Hebrew month corresponding
-to the date indicated by point."
-  t)
-
-(autoload 'insert-yearly-hebrew-diary-entry "cal-hebrew"
-  "Insert an annual diary entry for the day of the Hebrew year corresponding
-to the date indicated by point."
-  t)
-
-(autoload 'insert-islamic-diary-entry "cal-islam"
-  "Insert a diary entry for the Islamic date corresponding to the date
-indicated by point."
-  t)
-
-(autoload 'insert-monthly-islamic-diary-entry "cal-islam"
-  "Insert a monthly diary entry for the day of the Islamic month corresponding
-to the date indicated by point."
-  t)
-
-(autoload 'insert-yearly-islamic-diary-entry "cal-islam"
-  "Insert an annual diary entry for the day of the Islamic year corresponding
-to the date indicated by point."
-  t)
-
-(autoload 'list-calendar-holidays "holidays"
-  "Create a buffer containing the holidays for the current calendar window.
-The holidays are those in the list `calendar-notable-days'.  Returns t if any
-holidays are found, nil if not."
-  t)
-
-(autoload 'cal-tex-cursor-month "cal-tex"
-  "Make a buffer with LaTeX commands for the month cursor is on.
-Optional prefix argument specifies number of months to be produced.
-Calendar is condensed onto one page.")
-
-(autoload 'cal-tex-cursor-month-landscape "cal-tex"
-  "Make a buffer with LaTeX commands for the month cursor is on.
-Optional prefix argument specifies number of months to be produced.")
-
-(autoload 'cal-tex-cursor-day "cal-tex"
-  "Make a buffer with LaTeX commands for the day cursor is on.")
-
-(autoload 'cal-tex-cursor-week "cal-tex"
-  "Make a buffer with LaTeX commands for a two-page one-week calendar.
-It applies to the week that point is in.
-Optional prefix argument specifies number of weeks.
-Holidays are included if `cal-tex-holidays' is t.")
-
-(autoload 'cal-tex-cursor-week2 "cal-tex" 
-  "Make a buffer with LaTeX commands for a two-page one-week calendar.
-It applies to the week that point is in.
-Optional prefix argument specifies number of weeks.
-Holidays are included if `cal-tex-holidays' is t.")
-
-(autoload 'cal-tex-cursor-week-iso "cal-tex"
-  "Make a buffer with LaTeX commands for a one page ISO-style weekly calendar.
-Optional prefix argument specifies number of weeks.
-Diary entries are included if `cal-tex-diary' is t.
-Holidays are included if `cal-tex-holidays' is t.")
-
-(autoload 'cal-tex-cursor-week-monday "cal-tex"
-  "Make a buffer with LaTeX commands for a two-page one-week calendar.
-It applies to the week that point is in, and starts on Monday.
-Optional prefix argument specifies number of weeks.
-Holidays are included if `cal-tex-holidays' is t.")
-
-(autoload 'cal-tex-cursor-filofax-2week "cal-tex"
-  "Two-weeks-at-a-glance Filofax style calendar for week indicated by cursor.
-Optional prefix argument specifies number of weeks.
-Diary entries are included if cal-tex-diary is t.
-Holidays are included if `cal-tex-holidays' is t.")
-
-(autoload 'cal-tex-cursor-filofax-week "cal-tex"
-  "One-week-at-a-glance Filofax style calendar for week indicated by cursor.
-Optional prefix argument specifies number of weeks.
-Weeks start on Monday. 
-Diary entries are included if cal-tex-diary is t.
-Holidays are included if `cal-tex-holidays' is t.")
-
-(autoload 'cal-tex-cursor-year "cal-tex"
-  "Make a buffer with LaTeX commands for a year's calendar.
-Optional prefix argument specifies number of years.")
-
-(autoload 'cal-tex-cursor-year-landscape "cal-tex"
-  "Make a buffer with LaTeX commands for a year's calendar (landscape).
-Optional prefix argument specifies number of years.")
-
-(autoload 'cal-tex-cursor-filofax-year "cal-tex"
-  "Make a buffer with LaTeX commands for a year's calendar (Filofax).
-Optional prefix argument specifies number of years.")
-
-(autoload 'mark-calendar-holidays "holidays"
-  "Mark notable days in the calendar window."
-  t)
-
-(autoload 'calendar-cursor-holidays "holidays"
-  "Find holidays for the date specified by the cursor in the calendar window."
-  t)
-
-(defun generate-calendar-window (&optional mon yr)
-  "Generate the calendar window for the current date.
-Or, for optional MON, YR."
-  (let* ((buffer-read-only nil)
-         (today (calendar-current-date))
-         (month (extract-calendar-month today))
-         (day (extract-calendar-day today))
-         (year (extract-calendar-year today))
-         (today-visible
-          (or (not mon)
-              (let ((offset (calendar-interval mon yr month year)))
-                (and (<= offset 1) (>= offset -1)))))
-         (day-in-week (calendar-day-of-week today)))
-    (update-calendar-mode-line)
-    (if mon
-        (generate-calendar mon yr)
-        (generate-calendar month year))
-    (calendar-cursor-to-visible-date
-     (if today-visible today (list displayed-month 1 displayed-year)))
-    (set-buffer-modified-p nil)
-    (or (one-window-p t)
-        (/= (frame-width) (window-width))
-        (shrink-window (- (window-height) 9)))
-    (sit-for 0)
-    (and mark-holidays-in-calendar
-         (mark-calendar-holidays)
-         (sit-for 0))
-    (unwind-protect
-        (if mark-diary-entries-in-calendar (mark-diary-entries))
-      (if today-visible
-          (run-hooks 'today-visible-calendar-hook)
-        (run-hooks 'today-invisible-calendar-hook)))))
-
-(defun generate-calendar (month year)
-  "Generate a three-month Gregorian calendar centered around MONTH, YEAR."
-  (if (< (+ month (* 12 (1- year))) 2)
-      (error "Months before February, 1 AD are not available."))
-  (setq displayed-month month)
-  (setq displayed-year year)
-  (erase-buffer)
-  (increment-calendar-month month year -1)
-  (calendar-for-loop i from 0 to 2 do
-       (generate-calendar-month month year (+ 5 (* 25 i)))
-       (increment-calendar-month month year 1)))
-
-(defun generate-calendar-month (month year indent)
-  "Produce a calendar for MONTH, YEAR on the Gregorian calendar.
-The calendar is inserted in the buffer starting at the line on which point
-is currently located, but indented INDENT spaces.  The indentation is done
-from the first character on the line and does not disturb the first INDENT
-characters on the line."
-  (let* ((blank-days;; at start of month
-          (mod
-           (- (calendar-day-of-week (list month 1 year))
-              calendar-week-start-day)
-           7))
-	 (last (calendar-last-day-of-month month year)))
-   (goto-char (point-min))
-   (calendar-insert-indented
-    (calendar-string-spread
-     (list (format "%s %d" (calendar-month-name month) year)) ?  20)
-    indent t)
-   (calendar-insert-indented "" indent);; Go to proper spot
-   (calendar-for-loop i from 0 to 6 do
-      (insert (substring (aref calendar-day-name-array 
-                               (mod (+ calendar-week-start-day i) 7))
-                         0 2))
-      (insert " "))
-   (calendar-insert-indented "" 0 t);; Force onto following line
-   (calendar-insert-indented "" indent);; Go to proper spot
-   ;; Add blank days before the first of the month
-   (calendar-for-loop i from 1 to blank-days do (insert "   "))
-   ;; Put in the days of the month
-   (calendar-for-loop i from 1 to last do
-      (insert (format "%2d " i))
-      (put-text-property (- (point) 3) (1- (point))
-			 'mouse-face 'highlight)
-      (and (zerop (mod (+ i blank-days) 7))
-           (/= i last)
-           (calendar-insert-indented "" 0 t)    ;; Force onto following line
-           (calendar-insert-indented "" indent)))));; Go to proper spot
-
-(defun calendar-insert-indented (string indent &optional newline)
-  "Insert STRING at column INDENT.
-If the optional parameter NEWLINE is t, leave point at start of next line,
-inserting a newline if there was no next line; otherwise, leave point after
-the inserted text.  Value is always t."
-  ;; Try to move to that column.
-  (move-to-column indent)
-  ;; If line is too short, indent out to that column.
-  (if (< (current-column) indent)
-      (indent-to indent))
-  (insert string)
-  ;; Advance to next line, if requested.
-  (if newline
-      (progn
-	(end-of-line)
-	(if (eobp)
-            (newline)
-	  (forward-line 1))))
-  t)
-
-(defun redraw-calendar ()
-  "Redraw the calendar display."
-  (interactive)
-  (let ((cursor-date (calendar-cursor-to-date)))
-    (generate-calendar-window displayed-month displayed-year)
-    (calendar-cursor-to-visible-date cursor-date)))
-
-(defvar calendar-debug-sexp nil
-  "*Turn debugging on when evaluating a sexp in the diary or holiday list.")
-
-(defvar calendar-mode-map nil)
-(if calendar-mode-map
-    nil
-  (setq calendar-mode-map (make-sparse-keymap))
-  (if window-system (require 'cal-menu))
-  (calendar-for-loop i from 0 to 9 do
-       (define-key calendar-mode-map (int-to-string i) 'digit-argument))
-  (let ((l (list 'narrow-to-region 'mark-word 'mark-sexp 'mark-paragraph
-                 'mark-defun 'mark-whole-buffer 'mark-page
-                 'downcase-region 'upcase-region 'kill-region
-                 'copy-region-as-kill 'capitalize-region 'write-region)))
-    (while l
-      (substitute-key-definition (car l) 'calendar-not-implemented
-				 calendar-mode-map global-map)
-      (setq l (cdr l))))
-  (define-key calendar-mode-map "-"     'negative-argument)
-  (define-key calendar-mode-map "\C-x>" 'scroll-calendar-right)
-  (define-key calendar-mode-map [prior] 'scroll-calendar-right-three-months)
-  (define-key calendar-mode-map "\ev"   'scroll-calendar-right-three-months)
-  (define-key calendar-mode-map "\C-x<" 'scroll-calendar-left)
-  (define-key calendar-mode-map [next]  'scroll-calendar-left-three-months)
-  (define-key calendar-mode-map "\C-v"  'scroll-calendar-left-three-months)
-  (define-key calendar-mode-map "\C-b"  'calendar-backward-day)
-  (define-key calendar-mode-map "\C-p"  'calendar-backward-week)
-  (define-key calendar-mode-map "\e{"   'calendar-backward-month)
-  (define-key calendar-mode-map "\C-x[" 'calendar-backward-year)
-  (define-key calendar-mode-map "\C-f"  'calendar-forward-day)
-  (define-key calendar-mode-map "\C-n"  'calendar-forward-week)
-  (define-key calendar-mode-map [left]  'calendar-backward-day)
-  (define-key calendar-mode-map [up]    'calendar-backward-week)
-  (define-key calendar-mode-map [right] 'calendar-forward-day)
-  (define-key calendar-mode-map [down]  'calendar-forward-week)
-  (define-key calendar-mode-map "\e}"   'calendar-forward-month)
-  (define-key calendar-mode-map "\C-x]" 'calendar-forward-year)
-  (define-key calendar-mode-map "\C-a"  'calendar-beginning-of-week)
-  (define-key calendar-mode-map "\C-e"  'calendar-end-of-week)
-  (define-key calendar-mode-map "\ea"   'calendar-beginning-of-month)
-  (define-key calendar-mode-map "\ee"   'calendar-end-of-month)
-  (define-key calendar-mode-map "\e<"   'calendar-beginning-of-year)
-  (define-key calendar-mode-map "\e>"   'calendar-end-of-year)
-  (define-key calendar-mode-map "\C-@"  'calendar-set-mark)
-  ;; Many people are used to typing C-SPC and getting C-@.
-  (define-key calendar-mode-map [?\C-\ ] 'calendar-set-mark)
-  (define-key calendar-mode-map "\C-x\C-x" 'calendar-exchange-point-and-mark)
-  (define-key calendar-mode-map "\e=" 'calendar-count-days-region)
-  (define-key calendar-mode-map "gd"  'calendar-goto-date)
-  (define-key calendar-mode-map "gj"  'calendar-goto-julian-date)
-  (define-key calendar-mode-map "ga"  'calendar-goto-astro-day-number)
-  (define-key calendar-mode-map "gh"  'calendar-goto-hebrew-date)
-  (define-key calendar-mode-map "gi"  'calendar-goto-islamic-date)
-  (define-key calendar-mode-map "gC"  'calendar-goto-chinese-date)
-  (define-key calendar-mode-map "gk"  'calendar-goto-coptic-date)
-  (define-key calendar-mode-map "ge"  'calendar-goto-ethiopic-date)
-  (define-key calendar-mode-map "gp"  'calendar-goto-persian-date)
-  (define-key calendar-mode-map "gc"  'calendar-goto-iso-date)
-  (define-key calendar-mode-map "gf"  'calendar-goto-french-date)
-  (define-key calendar-mode-map "gml"  'calendar-goto-mayan-long-count-date)
-  (define-key calendar-mode-map "gmpc" 'calendar-previous-calendar-round-date)
-  (define-key calendar-mode-map "gmnc" 'calendar-next-calendar-round-date)
-  (define-key calendar-mode-map "gmph" 'calendar-previous-haab-date)
-  (define-key calendar-mode-map "gmnh" 'calendar-next-haab-date)
-  (define-key calendar-mode-map "gmpt" 'calendar-previous-tzolkin-date)
-  (define-key calendar-mode-map "gmnt" 'calendar-next-tzolkin-date)
-  (define-key calendar-mode-map "S"   'calendar-sunrise-sunset)
-  (define-key calendar-mode-map "M"   'calendar-phases-of-moon)
-  (define-key calendar-mode-map " "   'scroll-other-window)
-  (define-key calendar-mode-map "\C-c\C-l" 'redraw-calendar)
-  (define-key calendar-mode-map "."   'calendar-goto-today)
-  (define-key calendar-mode-map "o"   'calendar-other-month)
-  (define-key calendar-mode-map "q"   'exit-calendar)
-  (define-key calendar-mode-map "a"   'list-calendar-holidays)
-  (define-key calendar-mode-map "h"   'calendar-cursor-holidays)
-  (define-key calendar-mode-map "x"   'mark-calendar-holidays)
-  (define-key calendar-mode-map "u"   'calendar-unmark)
-  (define-key calendar-mode-map "m"   'mark-diary-entries)
-  (define-key calendar-mode-map "d"   'view-diary-entries)
-  (define-key calendar-mode-map "D"   'view-other-diary-entries)
-  (define-key calendar-mode-map "s"   'show-all-diary-entries)
-  (define-key calendar-mode-map "pd"  'calendar-print-day-of-year)
-  (define-key calendar-mode-map "pC"  'calendar-print-chinese-date)
-  (define-key calendar-mode-map "pk"  'calendar-print-coptic-date)
-  (define-key calendar-mode-map "pe"  'calendar-print-ethiopic-date)
-  (define-key calendar-mode-map "pp"  'calendar-print-persian-date)
-  (define-key calendar-mode-map "pc"  'calendar-print-iso-date)
-  (define-key calendar-mode-map "pj"  'calendar-print-julian-date)
-  (define-key calendar-mode-map "pa"  'calendar-print-astro-day-number)
-  (define-key calendar-mode-map "ph"  'calendar-print-hebrew-date)
-  (define-key calendar-mode-map "pi"  'calendar-print-islamic-date)
-  (define-key calendar-mode-map "pf"  'calendar-print-french-date)
-  (define-key calendar-mode-map "pm"  'calendar-print-mayan-date)
-  (define-key calendar-mode-map "id"  'insert-diary-entry)
-  (define-key calendar-mode-map "iw"  'insert-weekly-diary-entry)
-  (define-key calendar-mode-map "im"  'insert-monthly-diary-entry)
-  (define-key calendar-mode-map "iy"  'insert-yearly-diary-entry)
-  (define-key calendar-mode-map "ia"  'insert-anniversary-diary-entry)
-  (define-key calendar-mode-map "ib"  'insert-block-diary-entry)
-  (define-key calendar-mode-map "ic"  'insert-cyclic-diary-entry)
-  (define-key calendar-mode-map "ihd" 'insert-hebrew-diary-entry)
-  (define-key calendar-mode-map "ihm" 'insert-monthly-hebrew-diary-entry)
-  (define-key calendar-mode-map "ihy" 'insert-yearly-hebrew-diary-entry)
-  (define-key calendar-mode-map "iid" 'insert-islamic-diary-entry)
-  (define-key calendar-mode-map "iim" 'insert-monthly-islamic-diary-entry)
-  (define-key calendar-mode-map "iiy" 'insert-yearly-islamic-diary-entry)
-  (define-key calendar-mode-map "?"   'calendar-goto-info-node)
-  (define-key calendar-mode-map "tm" 'cal-tex-cursor-month)
-  (define-key calendar-mode-map "tM" 'cal-tex-cursor-month-landscape)
-  (define-key calendar-mode-map "td" 'cal-tex-cursor-day)
-  (define-key calendar-mode-map "tw1" 'cal-tex-cursor-week)
-  (define-key calendar-mode-map "tw2" 'cal-tex-cursor-week2)
-  (define-key calendar-mode-map "tw3" 'cal-tex-cursor-week-iso)
-  (define-key calendar-mode-map "tw4" 'cal-tex-cursor-week-monday)
-  (define-key calendar-mode-map "tfw" 'cal-tex-cursor-filofax-2week)
-  (define-key calendar-mode-map "tfW" 'cal-tex-cursor-filofax-week)
-  (define-key calendar-mode-map "tfy" 'cal-tex-cursor-filofax-year)
-  (define-key calendar-mode-map "ty" 'cal-tex-cursor-year)
-  (define-key calendar-mode-map "tY" 'cal-tex-cursor-year-landscape))
-
-(defun describe-calendar-mode ()
-  "Create a help buffer with a brief description of the calendar-mode."
-  (interactive)
-  (with-output-to-temp-buffer "*Help*"
-    (princ
-     (format
-      "Calendar Mode:\nFor a complete description, type %s\n%s\n"
-      (substitute-command-keys
-       "\\<calendar-mode-map>\\[describe-mode] from within the calendar")
-      (substitute-command-keys "\\{calendar-mode-map}")))
-    (save-excursion
-      (set-buffer standard-output)
-      (help-mode))
-    (print-help-return-message)))
-
-;; Calendar mode is suitable only for specially formatted data.
-(put 'calendar-mode 'mode-class 'special)
-
-(defvar calendar-mode-line-format
-  (list
-   (substitute-command-keys "\\<calendar-mode-map>\\[scroll-calendar-left]")
-   "Calendar"
-   (substitute-command-keys "\\<calendar-mode-map>\\[calendar-goto-info-node] info/\\[calendar-other-month] other/\\[calendar-goto-today] today")
-   '(calendar-date-string (calendar-current-date) t)
-   (substitute-command-keys "\\<calendar-mode-map>\\[scroll-calendar-right]"))
-  "The mode line of the calendar buffer.")
-
-(defun calendar-goto-info-node ()
-  "Go to the info node for the calendar."
-  (interactive)
-  (require 'info)
-  (let ((where (save-window-excursion
-		 (Info-find-emacs-command-nodes 'calendar))))
-    (if (not where)
-        (error "Couldn't find documentation for the calendar.")
-      (let (same-window-buffer-names)
-	(info))
-      (Info-find-node (car (car where)) (car (cdr (car where)))))))
-
-(defun calendar-mode ()
-  "A major mode for the calendar window.
-
-For a complete description, type \
-\\<calendar-mode-map>\\[calendar-goto-info-node] from within the calendar.
-
-\\<calendar-mode-map>\\{calendar-mode-map}"
-
-  (kill-all-local-variables)
-  (setq major-mode 'calendar-mode)
-  (setq mode-name "Calendar")
-  (use-local-map calendar-mode-map)
-  (setq buffer-read-only t)
-  (setq indent-tabs-mode nil)
-  (update-calendar-mode-line)
-  (make-local-variable 'calendar-mark-ring)
-  (make-local-variable 'displayed-month);;  Month in middle of window.
-  (make-local-variable 'displayed-year));;  Year in middle of window.
-
-(defun calendar-string-spread (strings char length)
-  "Concatenate list of STRINGS separated with copies of CHAR to fill LENGTH.
-The effect is like mapconcat but the separating pieces are as balanced as
-possible.  Each item of STRINGS is evaluated before concatenation so it can
-actually be an expression that evaluates to a string.  If LENGTH is too short,
-the STRINGS are just concatenated and the result truncated."
-;; The algorithm is based on equation (3.25) on page 85 of Concrete
-;; Mathematics by Ronald L. Graham, Donald E. Knuth, and Oren Patashnik,
-;; Addison-Wesley, Reading, MA, 1989
-  (let* ((strings (mapcar 'eval
-                          (if (< (length strings) 2)
-                              (append (list "") strings (list ""))
-                            strings)))
-         (n (- length (length (apply 'concat strings))))
-         (m (1- (length strings)))
-         (s (car strings))
-         (strings (cdr strings))
-         (i 0))
-    (while strings
-      (setq s (concat s
-                      (make-string (max 0 (/ (+ n i) m)) char)
-                      (car strings)))
-      (setq i (1+ i))
-      (setq strings (cdr strings)))
-    (substring s 0 length)))
-
-(defun update-calendar-mode-line ()
-  "Update the calendar mode line with the current date and date style."
-  (if (bufferp (get-buffer calendar-buffer))
-      (save-excursion
-        (set-buffer calendar-buffer)
-        (setq mode-line-format
-              (calendar-string-spread
-               calendar-mode-line-format ?  (frame-width))))))
-
-(defun calendar-window-list ()
-  "List of all calendar-related windows."
-  (let ((calendar-buffers (calendar-buffer-list))
-        list)
-    (walk-windows '(lambda (w)
-                     (if (memq (window-buffer w) calendar-buffers)
-                         (setq list (cons w list))))
-                  nil t)
-    list))
-
-(defun calendar-buffer-list ()
-  "List of all calendar-related buffers."
-  (let* ((diary-buffer (get-file-buffer diary-file))
-         (buffers (list "*Yahrzeits*" lunar-phases-buffer holiday-buffer
-                        fancy-diary-buffer diary-buffer calendar-buffer))
-         (buffer-list nil)
-         b)
-    (while buffers
-      (setq b (car buffers))
-      (setq b (cond ((stringp b) (get-buffer b))
-                    ((bufferp b) b)
-                    (t nil)))
-      (if b (setq buffer-list (cons b buffer-list)))
-      (setq buffers (cdr buffers)))
-    buffer-list))
-
-(defun exit-calendar ()
-  "Get out of the calendar window and hide it and related buffers."
-  (interactive)
-  (let* ((diary-buffer (get-file-buffer diary-file)))
-    (if (and diary-buffer (buffer-modified-p diary-buffer)
-	     (not
-	      (yes-or-no-p
-	       "Diary modified; do you really want to exit the calendar? ")))
-	(error)
-      ;; Need to do this multiple times because one time can replace some
-      ;; calendar-related buffers with other calendar-related buffers
-      (mapcar (lambda (x)
-                (mapcar 'calendar-hide-window (calendar-window-list)))
-              (calendar-window-list)))))
-
-(defun calendar-hide-window (window)
-  "Hide WINDOW if it is calendar-related."
-  (let ((buffer (if (window-live-p window) (window-buffer window))))
-    (if (memq buffer (calendar-buffer-list))
-        (cond
-         ((and window-system
-               (eq 'icon (cdr (assoc 'visibility
-                                     (frame-parameters
-                                      (window-frame window))))))
-          nil)
-         ((and window-system (window-dedicated-p window))
-          (iconify-frame (window-frame window)))
-         ((not (and (select-window window) (one-window-p window)))
-          (delete-window window))
-         (t (set-buffer buffer)
-            (bury-buffer))))))
-
-(defun calendar-current-date ()
-  "Returns the current date in a list (month day year)."
-  (let ((now (decode-time)))
-    (list (nth 4 now) (nth 3 now) (nth 5 now))))
-
-(defun calendar-cursor-to-date (&optional error)
-  "Returns a list (month day year) of current cursor position.
-If cursor is not on a specific date, signals an error if optional parameter
-ERROR is t, otherwise just returns nil."
-  (let* ((segment (/ (current-column) 25))
-         (month (% (+ displayed-month segment -1) 12))
-         (month (if (= 0 month) 12 month))
-         (year
-          (cond
-           ((and (=  12 month) (= segment 0)) (1- displayed-year))
-           ((and (=   1 month) (= segment 2)) (1+ displayed-year))
-           (t displayed-year))))
-    (if (and (looking-at "[ 0-9]?[0-9][^0-9]")
-             (< 2 (count-lines (point-min) (point))))
-        (save-excursion
-          (if (not (looking-at " "))
-                   (re-search-backward "[^0-9]"))
-          (list month
-                (string-to-int (buffer-substring (1+ (point)) (+ 4 (point))))
-                year))
-      (if (looking-at "\\*")
-          (save-excursion
-            (re-search-backward "[^*]")
-            (if (looking-at ".\\*\\*")
-                (list month calendar-starred-day year)
-              (if error (error "Not on a date!"))))
-        (if error (error "Not on a date!"))))))
-
-;; The following version of calendar-gregorian-from-absolute is preferred for
-;; reasons of clarity, BUT it's much slower than the version that follows it.
-
-;;(defun calendar-gregorian-from-absolute (date)
-;;  "Compute the list (month day year) corresponding to the absolute DATE.
-;;The absolute date is the number of days elapsed since the (imaginary)
-;;Gregorian date Sunday, December 31, 1 BC."
-;;  (let* ((approx (/ date 366));; Approximation from below.
-;;         (year                ;; Search forward from the approximation.
-;;          (+ approx
-;;             (calendar-sum y approx
-;;                 (>= date (calendar-absolute-from-gregorian (list 1 1 (1+ y))))
-;;                  1)))
-;;         (month         ;; Search forward from January.
-;;          (1+ (calendar-sum m 1
-;;                   (> date
-;;                      (calendar-absolute-from-gregorian
-;;                       (list m (calendar-last-day-of-month m year) year)))
-;;                   1)))
-;;         (day           ;; Calculate the day by subtraction.
-;;          (- date
-;;             (1- (calendar-absolute-from-gregorian (list month 1 year))))))
-;;    (list month day year)))
-
-(defun calendar-gregorian-from-absolute (date)
-  "Compute the list (month day year) corresponding to the absolute DATE.
-The absolute date is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-;; See the footnote on page 384 of ``Calendrical Calculations, Part II:
-;; Three Historical Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M.
-;; Clamen, Software--Practice and Experience, Volume 23, Number 4
-;; (April, 1993), pages 383-404 for an explanation.
-  (let* ((d0 (1- date))
-         (n400 (/ d0 146097))
-         (d1 (% d0 146097))
-         (n100 (/ d1 36524))
-         (d2 (% d1 36524))
-         (n4 (/ d2 1461))
-         (d3 (% d2 1461))
-         (n1 (/ d3 365))
-         (day (1+ (% d3 365)))
-         (year (+ (* 400 n400) (* 100 n100) (* n4 4) n1)))
-    (if (or (= n100 4) (= n1 4))
-        (list 12 31 year)
-      (let ((year (1+ year))
-            (month 1))
-        (while (let ((mdays (calendar-last-day-of-month month year)))
-                 (and (< mdays day)
-                      (setq day (- day mdays))))
-          (setq month (1+ month)))
-        (list month day year)))))
-
-(defun calendar-other-month (month year)
-  "Display a three-month calendar centered around MONTH and YEAR."
-  (interactive (calendar-read-date 'noday))
-  (if (and (= month displayed-month)
-           (= year displayed-year))
-      nil
-    (let ((old-date (calendar-cursor-to-date))
-          (today (calendar-current-date)))
-      (generate-calendar-window month year)
-      (calendar-cursor-to-visible-date
-       (cond
-        ((calendar-date-is-visible-p old-date) old-date)
-        ((calendar-date-is-visible-p today) today)
-        (t (list month 1 year)))))))
-
-(defun calendar-set-mark (arg)
-  "Mark the date under the cursor, or jump to marked date.
-With no prefix argument, push current date onto marked date ring.
-With argument, jump to mark, pop it, and put point at end of ring."
-  (interactive "P")
-  (let ((date (calendar-cursor-to-date t)))
-    (if (null arg)
-        (progn
-          (setq calendar-mark-ring (cons date calendar-mark-ring))
-          ;; Since the top of the mark ring is the marked date in the
-          ;; calendar, the mark ring in the calendar is one longer than
-          ;; in other buffers to get the same effect.
-          (if (> (length calendar-mark-ring) (1+ mark-ring-max))
-              (setcdr (nthcdr mark-ring-max calendar-mark-ring) nil))
-          (message "Mark set"))
-      (if (null calendar-mark-ring)
-          (error "No mark set in this buffer")
-        (calendar-goto-date (car calendar-mark-ring))
-        (setq calendar-mark-ring
-              (cdr (nconc calendar-mark-ring (list date))))))))
-
-(defun calendar-exchange-point-and-mark ()
-  "Exchange the current cursor position with the marked date."
-  (interactive)
-  (let ((mark (car calendar-mark-ring))
-        (date (calendar-cursor-to-date t)))
-    (if (null mark)
-        (error "No mark set in this buffer")
-      (setq calendar-mark-ring (cons date (cdr calendar-mark-ring)))
-      (calendar-goto-date mark))))
-
-(defun calendar-count-days-region ()
-  "Count the number of days (inclusive) between point and the mark."
-  (interactive)
-  (let* ((days (- (calendar-absolute-from-gregorian
-                   (calendar-cursor-to-date t))
-                  (calendar-absolute-from-gregorian
-                   (or (car calendar-mark-ring)
-                       (error "No mark set in this buffer")))))
-         (days (1+ (if (> days 0) days (- days)))))
-    (message "Region has %d day%s (inclusive)"
-             days (if (> days 1) "s" ""))))
-
-(defun calendar-not-implemented ()
-  "Not implemented."
-  (interactive)
-  (error "%s not available in the calendar"
-         (global-key-binding (this-command-keys))))
-
-(defun calendar-read (prompt acceptable &optional initial-contents)
-  "Return an object read from the minibuffer.
-Prompt with the string PROMPT and use the function ACCEPTABLE to decide if
-entered item is acceptable.  If non-nil, optional third arg INITIAL-CONTENTS
-is a string to insert in the minibuffer before reading."
-  (let ((value (read-minibuffer prompt initial-contents)))
-    (while (not (funcall acceptable value))
-      (setq value (read-minibuffer prompt initial-contents)))
-    value))
-
-(defun calendar-read-date (&optional noday)
-  "Prompt for Gregorian date.  Returns a list (month day year).
-If optional NODAY is t, does not ask for day, but just returns
-(month nil year); if NODAY is any other non-nil value the value returned is
-(month year) "
-  (let* ((year (calendar-read
-                "Year (>0): "
-                '(lambda (x) (> x 0))
-                (int-to-string (extract-calendar-year
-                                (calendar-current-date)))))
-         (month-array calendar-month-name-array)
-         (completion-ignore-case t)
-         (month (cdr (assoc
-                      (capitalize
-                       (completing-read
-                        "Month name: "
-                        (mapcar 'list (append month-array nil))
-                        nil t))
-                      (calendar-make-alist month-array 1 'capitalize))))
-         (last (calendar-last-day-of-month month year)))
-    (if noday
-        (if (eq noday t)
-            (list month nil year)
-          (list month year))
-      (list month
-            (calendar-read (format "Day (1-%d): " last)
-                                   '(lambda (x) (and (< 0 x) (<= x last))))
-            year))))
-
-(defun calendar-interval (mon1 yr1 mon2 yr2)
-  "The number of months difference between MON1, YR1 and MON2, YR2."
-  (+ (* 12 (- yr2 yr1))
-     (- mon2 mon1)))
-
-(defun calendar-day-name (date)
-  "Returns a string with the name of the day of the week of DATE."
-  (aref calendar-day-name-array (calendar-day-of-week date)))
-
-(defvar calendar-day-name-array
-  ["Sunday" "Monday" "Tuesday" "Wednesday" "Thursday" "Friday" "Saturday"])
-
-(defvar calendar-month-name-array
-  ["January" "February" "March"     "April"   "May"      "June"
-   "July"    "August"   "September" "October" "November" "December"])
-
-(defun calendar-make-alist (sequence &optional start-index filter)
-  "Make an assoc list corresponding to SEQUENCE.
-Start at index 1, unless optional START-INDEX is provided.
-If FILTER is provided, apply it to each item in the list."
-  (let ((index (if start-index (1- start-index) 0)))
-    (mapcar
-     '(lambda (x)
-        (setq index (1+ index))
-        (cons (if filter (funcall filter x) x)
-              index))
-     (append sequence nil))))
-
-(defun calendar-month-name (month)
-  "The name of MONTH."
-  (aref calendar-month-name-array (1- month)))
-
-(defun calendar-day-of-week (date)
-  "Returns the day-of-the-week index of DATE, 0 for Sunday, 1 for Monday, etc."
-  (% (calendar-absolute-from-gregorian date) 7))
-
-(defun calendar-unmark ()
-  "Delete all diary/holiday marks/highlighting from the calendar."
-  (interactive)
-  (setq mark-holidays-in-calendar nil)
-  (setq mark-diary-entries-in-calendar nil)
-  (redraw-calendar))
-
-(defun calendar-date-is-visible-p (date)
-  "Returns t if DATE is legal and is visible in the calendar window."
-  (let ((gap (calendar-interval
-              displayed-month displayed-year
-              (extract-calendar-month date) (extract-calendar-year date))))
-    (and (calendar-date-is-legal-p date) (> 2 gap) (< -2 gap))))
-
-(defun calendar-date-is-legal-p (date)
-  "Returns t if DATE is a legal date."
-  (let ((month (extract-calendar-month date))
-        (day (extract-calendar-day date))
-        (year (extract-calendar-year date)))
-    (and (<= 1 month) (<= month 12)
-         (<= 1 day) (<= day (calendar-last-day-of-month month year))
-         (<= 1 year))))
-
-(defun calendar-date-equal (date1 date2)
-  "Returns t if the DATE1 and DATE2 are the same."
-  (and
-   (= (extract-calendar-month date1) (extract-calendar-month date2))
-   (= (extract-calendar-day date1) (extract-calendar-day date2))
-   (= (extract-calendar-year date1) (extract-calendar-year date2))))
-
-(defun mark-visible-calendar-date (date &optional mark)
-  "Mark DATE in the calendar window with MARK.
-MARK is either a single-character string or a face.
-MARK defaults to diary-entry-marker."
-  (if (calendar-date-is-legal-p date)
-      (save-excursion
-        (set-buffer calendar-buffer)
-        (calendar-cursor-to-visible-date date)
-        (let ((mark (or mark diary-entry-marker)))
-          (if (stringp mark)
-              (let ((buffer-read-only nil))
-                (forward-char 1)
-                (delete-char 1)
-                (insert mark)
-                (forward-char -2))
-	    (overlay-put
-             (make-overlay (1- (point)) (1+ (point))) 'face mark))))))
-
-(defun calendar-star-date ()
-  "Replace the date under the cursor in the calendar window with asterisks.
-This function can be used with the today-visible-calendar-hook run after the
-calendar window has been prepared."
-  (let ((buffer-read-only nil))
-    (make-variable-buffer-local 'calendar-starred-day)
-    (forward-char 1)
-    (setq calendar-starred-day
-          (string-to-int
-           (buffer-substring (point) (- (point) 2))))
-    (delete-char -2)
-    (insert "**")
-    (backward-char 1)
-    (set-buffer-modified-p nil)))
-
-(defun calendar-mark-today ()
-  "Mark the date under the cursor in the calendar window.
-The date is marked with calendar-today-marker.  This function can be used with
-the today-visible-calendar-hook run after the calendar window has been
-prepared."
-  (mark-visible-calendar-date
-   (calendar-cursor-to-date)
-   calendar-today-marker))
-
-(defun calendar-date-compare (date1 date2)
-  "Returns t if DATE1 is before DATE2, nil otherwise.
-The actual dates are in the car of DATE1 and DATE2."
-  (< (calendar-absolute-from-gregorian (car date1))
-     (calendar-absolute-from-gregorian (car date2))))
-
-(defun calendar-date-string (date &optional abbreviate nodayname)
-  "A string form of DATE, driven by the variable `calendar-date-display-form'.
-An optional parameter ABBREVIATE, when t, causes the month and day names to be
-abbreviated to three characters.  An optional parameter NODAYNAME, when t,
-omits the name of the day of the week."
-  (let* ((dayname
-          (if nodayname
-              nil
-            (if abbreviate
-                (substring (calendar-day-name date) 0 3)
-              (calendar-day-name date))))
-         (month (extract-calendar-month date))
-         (monthname
-          (if abbreviate
-              (substring
-               (calendar-month-name month) 0 3)
-            (calendar-month-name month)))
-         (day (int-to-string (extract-calendar-day date)))
-         (month (int-to-string month))
-         (year (int-to-string (extract-calendar-year date))))
-    (mapconcat 'eval calendar-date-display-form "")))
-
-(defun calendar-dayname-on-or-before (dayname date)
-  "Returns the absolute date of the DAYNAME on or before absolute DATE.
-DAYNAME=0 means Sunday, DAYNAME=1 means Monday, and so on.
-
-Note: Applying this function to d+6 gives us the DAYNAME on or after an
-absolute day d.  Similarly, applying it to d+3 gives the DAYNAME nearest to
-absolute date d, applying it to d-1 gives the DAYNAME previous to absolute
-date d, and applying it to d+7 gives the DAYNAME following absolute date d."
-  (- date (% (- date dayname) 7)))
-
-(defun calendar-nth-named-absday (n dayname month year &optional day)
-  "The absolute date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
-A DAYNAME of 0 means Sunday, 1 means Monday, and so on.  If N<0,
-return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
-If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
-
-If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
-  (if (> n 0)
-      (+ (* 7 (1- n))
-	 (calendar-dayname-on-or-before
-	  dayname
-	  (+ 6 (calendar-absolute-from-gregorian
-		(list month (or day 1) year)))))
-    (+ (* 7 (1+ n))
-       (calendar-dayname-on-or-before
-	dayname
-	(calendar-absolute-from-gregorian
-	 (list month
-	       (or day (calendar-last-day-of-month month year))
-	       year))))))
-
-(defun calendar-nth-named-day (n dayname month year &optional day)
-  "The date of Nth DAYNAME in MONTH, YEAR before/after optional DAY.
-A DAYNAME of 0 means Sunday, 1 means Monday, and so on.  If N<0,
-return the Nth DAYNAME before MONTH DAY, YEAR (inclusive).
-If N>0, return the Nth DAYNAME after MONTH DAY, YEAR (inclusive).
-
-If DAY is omitted, it defaults to 1 if N>0, and MONTH's last day otherwise."
-  (calendar-gregorian-from-absolute
-   (calendar-nth-named-absday n dayname month year day)))
-
-(defun calendar-day-of-year-string (&optional date)
-  "String of day number of year of Gregorian DATE.
-Defaults to today's date if DATE is not given."
-  (let* ((d (or date (calendar-current-date)))
-         (year (extract-calendar-year d))
-         (day (calendar-day-number d))
-         (days-remaining (- (calendar-day-number (list 12 31 year)) day)))
-    (format "Day %d of %d; %d day%s remaining in the year"
-            day year days-remaining (if (= days-remaining 1) "" "s"))))
-
-(defun calendar-print-day-of-year ()
-  "Show day number in year/days remaining in year for date under the cursor."
-  (interactive)
-  (message (calendar-day-of-year-string (calendar-cursor-to-date t))))
-
-(defun calendar-set-mode-line (str)
-  "Set mode line to STR, centered, surrounded by dashes."
-  (setq mode-line-format
-        (calendar-string-spread (list str) ?- (frame-width))))
-
-(defun calendar-mod (m n)
-  "Non-negative remainder of M/N with N instead of 0."
-  (1+ (mod (1- m) n)))
-
-(run-hooks 'calendar-load-hook)
-
-(provide 'calendar)
-
-;;; Local variables:
-;;; byte-compile-dynamic: t
-;;; End:
-
-;;; calendar.el ends here
diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el
deleted file mode 100644
index 875cc2ae840..00000000000
--- a/lisp/calendar/diary-lib.el
+++ /dev/null
@@ -1,1392 +0,0 @@
-;;; diary-lib.el --- diary functions.
-
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994, 1995 Free Software
-;; Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-
-;; 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 collection of functions implements the diary features as described
-;; in calendar.el.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(require 'calendar)
-
-;;;###autoload
-(defun diary (&optional arg)
-  "Generate the diary window for ARG days starting with the current date.
-If no argument is provided, the number of days of diary entries is governed
-by the variable `number-of-diary-entries'.  This function is suitable for
-execution in a `.emacs' file."
-  (interactive "P")
-  (let ((d-file (substitute-in-file-name diary-file))
-        (date (calendar-current-date)))
-    (if (and d-file (file-exists-p d-file))
-        (if (file-readable-p d-file)
-            (list-diary-entries
-             date
-             (cond
-              (arg (prefix-numeric-value arg))
-              ((vectorp number-of-diary-entries)
-               (aref number-of-diary-entries (calendar-day-of-week date)))
-              (t number-of-diary-entries)))
-        (error "Your diary file is not readable!"))
-      (error "You don't have a diary file!"))))
-
-(defun view-diary-entries (arg)
-  "Prepare and display a buffer with diary entries.
-Searches the file named in `diary-file' for entries that
-match ARG days starting with the date indicated by the cursor position
-in the displayed three-month calendar."
-  (interactive "p")
-  (let ((d-file (substitute-in-file-name diary-file)))
-    (if (and d-file (file-exists-p d-file))
-        (if (file-readable-p d-file)
-            (list-diary-entries (calendar-cursor-to-date t) arg)
-          (error "Diary file is not readable!"))
-      (error "You don't have a diary file!"))))
-
-(defun view-other-diary-entries (arg diary-file)
-  "Prepare and display buffer of diary entries from an alternative diary file.
-Prompts for a file name and searches that file for entries that match ARG
-days starting with the date indicated by the cursor position in the displayed
-three-month calendar."
-  (interactive
-   (list (cond ((null current-prefix-arg) 1)
-               ((listp current-prefix-arg) (car current-prefix-arg))
-               (t current-prefix-arg))
-         (setq diary-file (read-file-name "Enter diary file name: "
-                                          default-directory nil t))))
-  (view-diary-entries arg))
-
-(autoload 'check-calendar-holidays "holidays"
-  "Check the list of holidays for any that occur on DATE.
-The value returned is a list of strings of relevant holiday descriptions.
-The holidays are those in the list `calendar-holidays'."
-  t)
-
-(autoload 'calendar-holiday-list "holidays"
-  "Form the list of holidays that occur on dates in the calendar window.
-The holidays are those in the list `calendar-holidays'."
-  t)
-
-(autoload 'diary-french-date "cal-french"
-  "French calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-mayan-date "cal-mayan"
-  "Mayan calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-iso-date "cal-iso"
-  "ISO calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-julian-date "cal-julian"
-  "Julian calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-astro-day-number "cal-julian"
-  "Astronomical (Julian) day number diary entry."
-  t)
-
-(autoload 'diary-chinese-date "cal-china"
-  "Chinese calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-islamic-date "cal-islam"
-  "Islamic calendar equivalent of date diary entry."
-  t)
-
-(autoload 'list-islamic-diary-entries "cal-islam"
-  "Add any Islamic date entries from the diary file to `diary-entries-list'."
-  t)
-
-(autoload 'mark-islamic-diary-entries "cal-islam"
-  "Mark days in the calendar window that have Islamic date diary entries."
-  t)
-
-(autoload 'mark-islamic-calendar-date-pattern "cal-islam"
-   "Mark dates in calendar window that conform to Islamic date MONTH/DAY/YEAR."
-  t)
-
-(autoload 'diary-hebrew-date "cal-hebrew"
-  "Hebrew calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-omer "cal-hebrew"
-  "Omer count diary entry."
-  t)
-
-(autoload 'diary-yahrzeit "cal-hebrew"
-  "Yahrzeit diary entry--entry applies if date is yahrzeit or the day before."
-  t)
-
-(autoload 'diary-parasha "cal-hebrew"
-  "Parasha diary entry--entry applies if date is a Saturday."
-  t)
-
-(autoload 'diary-rosh-hodesh "cal-hebrew"
-  "Rosh Hodesh diary entry."
-  t)
-
-(autoload 'list-hebrew-diary-entries "cal-hebrew"
-  "Add any Hebrew date entries from the diary file to `diary-entries-list'."
-  t)
-
-(autoload 'mark-hebrew-diary-entries "cal-hebrew"
-  "Mark days in the calendar window that have Hebrew date diary entries."
-  t)
-
-(autoload 'mark-hebrew-calendar-date-pattern "cal-hebrew"
-   "Mark dates in calendar window that conform to Hebrew date MONTH/DAY/YEAR."
-  t)
-
-(autoload 'diary-coptic-date "cal-coptic"
-  "Coptic calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-ethiopic-date "cal-coptic"
-  "Ethiopic calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-persian-date "cal-persia"
-  "Persian calendar equivalent of date diary entry."
-  t)
-
-(autoload 'diary-phases-of-moon "lunar" "Moon phases diary entry." t)
-
-(autoload 'diary-sunrise-sunset "solar"
-  "Local time of sunrise and sunset as a diary entry."
-  t)
-
-(autoload 'diary-sabbath-candles "solar"
-  "Local time of candle lighting diary entry--applies if date is a Friday.
-No diary entry if there is no sunset on that date."
-  t)
-
-(defvar diary-syntax-table (copy-syntax-table (standard-syntax-table))
-  "The syntax table used when parsing dates in the diary file.
-It is the standard syntax table used in Fundamental mode, but with the
-syntax of `*' changed to be a word constituent.")
-
-(modify-syntax-entry ?* "w" diary-syntax-table)
-
-(defun list-diary-entries (date number)
-  "Create and display a buffer containing the relevant lines in diary-file.
-The arguments are DATE and NUMBER; the entries selected are those
-for NUMBER days starting with date DATE.  The other entries are hidden
-using selective display.
-
-Returns a list of all relevant diary entries found, if any, in order by date.
-The list entries have the form ((month day year) string).  If the variable
-`diary-list-include-blanks' is t, this list includes a dummy diary entry
-\(consisting of the empty string) for a date with no diary entries.
-
-After the list is prepared, the hooks `nongregorian-diary-listing-hook',
-`list-diary-entries-hook', `diary-display-hook', and `diary-hook' are run.
-These hooks have the following distinct roles:
-
-    `nongregorian-diary-listing-hook' can cull dates from the diary
-        and each included file.  Usually used for Hebrew or Islamic
-        diary entries in files.  Applied to *each* file.
-
-    `list-diary-entries-hook' adds or manipulates diary entries from
-        external sources.  Used, for example, to include diary entries
-        from other files or to sort the diary entries.  Invoked *once* only,
-        before the display hook is run.
-
-    `diary-display-hook' does the actual display of information.  If this is
-        nil, simple-diary-display will be used.  Use add-hook to set this to
-        fancy-diary-display, if desired.  If you want no diary display, use
-        add-hook to set this to ignore.
-
-    `diary-hook' is run last.  This can be used for an appointment
-        notification function."
-
-  (if (< 0 number)
-      (let* ((original-date date);; save for possible use in the hooks
-             (old-diary-syntax-table)
-             (diary-entries-list)
-             (date-string (calendar-date-string date))
-             (d-file (substitute-in-file-name diary-file)))
-        (message "Preparing diary...")
-        (save-excursion
-          (let ((diary-buffer (find-buffer-visiting d-file)))
-	    (if (not diary-buffer)
-		(set-buffer (find-file-noselect d-file t))
-	      (set-buffer diary-buffer)
-	      (or (verify-visited-file-modtime diary-buffer)
-		  (revert-buffer t t))))
-          (setq selective-display t)
-          (setq selective-display-ellipses nil)
-          (setq old-diary-syntax-table (syntax-table))
-          (set-syntax-table diary-syntax-table)
-          (unwind-protect
-            (let ((buffer-read-only nil)
-                  (diary-modified (buffer-modified-p))
-                  (mark (regexp-quote diary-nonmarking-symbol)))
-              (goto-char (1- (point-max)))
-              (if (not (looking-at "\^M\\|\n"))
-                  (progn
-                    (forward-char 1)
-                    (insert-string "\^M")))
-              (goto-char (point-min))
-              (if (not (looking-at "\^M\\|\n"))
-                  (insert-string "\^M"))
-              (subst-char-in-region (point-min) (point-max) ?\n ?\^M t)
-              (calendar-for-loop i from 1 to number do
-                 (let ((d diary-date-forms)
-                       (month (extract-calendar-month date))
-                       (day (extract-calendar-day date))
-                       (year (extract-calendar-year date))
-                       (entry-found (list-sexp-diary-entries date)))
-                   (while d
-                     (let*
-                          ((date-form (if (equal (car (car d)) 'backup)
-                                          (cdr (car d))
-                                        (car d)))
-                          (backup (equal (car (car d)) 'backup))
-                          (dayname
-                           (concat
-                            (calendar-day-name date) "\\|"
-                            (substring (calendar-day-name date) 0 3) ".?"))
-                          (monthname
-                           (concat
-                            "\\*\\|"
-                            (calendar-month-name month) "\\|"
-                            (substring (calendar-month-name month) 0 3) ".?"))
-                          (month (concat "\\*\\|0*" (int-to-string month)))
-                          (day (concat "\\*\\|0*" (int-to-string day)))
-                          (year
-                           (concat
-                            "\\*\\|0*" (int-to-string year)
-                            (if abbreviated-calendar-year
-                                (concat "\\|" (int-to-string (% year 100)))
-                              "")))
-                          (regexp
-                           (concat
-                            "\\(\\`\\|\^M\\|\n\\)" mark "?\\("
-                            (mapconcat 'eval date-form "\\)\\(")
-                            "\\)"))
-                          (case-fold-search t))
-                       (goto-char (point-min))
-                       (while (re-search-forward regexp nil t)
-                         (if backup (re-search-backward "\\<" nil t))
-                         (if (and (or (char-equal (preceding-char) ?\^M)
-                                      (char-equal (preceding-char) ?\n))
-                                  (not (looking-at " \\|\^I")))
-                             ;;  Diary entry that consists only of date.
-                             (backward-char 1)
-                           ;; Found a nonempty diary entry--make it visible and
-                           ;; add it to the list.
-                           (setq entry-found t)
-                           (let ((entry-start (point))
-                                 (date-start))
-                             (re-search-backward "\^M\\|\n\\|\\`")
-                             (setq date-start (point))
-                             (re-search-forward "\^M\\|\n" nil t 2)
-                             (while (looking-at " \\|\^I")
-                               (re-search-forward "\^M\\|\n" nil t))
-                             (backward-char 1)
-                             (subst-char-in-region date-start
-                                (point) ?\^M ?\n t)
-                             (add-to-diary-list
-                               date
-                               (buffer-substring-no-properties
-                                entry-start (point)))))))
-                     (setq d (cdr d)))
-                   (or entry-found
-                       (not diary-list-include-blanks)
-                       (setq diary-entries-list 
-                             (append diary-entries-list
-                                     (list (list date "")))))
-                   (setq date
-                         (calendar-gregorian-from-absolute
-                           (1+ (calendar-absolute-from-gregorian date))))
-                   (setq entry-found nil)))
-              (set-buffer-modified-p diary-modified))
-          (set-syntax-table old-diary-syntax-table))
-        (goto-char (point-min))
-        (run-hooks 'nongregorian-diary-listing-hook
-                   'list-diary-entries-hook)
-        (if diary-display-hook
-            (run-hooks 'diary-display-hook)
-          (simple-diary-display))
-        (run-hooks 'diary-hook)
-        diary-entries-list))))
-
-(defun include-other-diary-files ()
-  "Include the diary entries from other diary files with those of diary-file.
-This function is suitable for use in `list-diary-entries-hook';
-it enables you to use shared diary files together with your own.
-The files included are specified in the diaryfile by lines of this form:
-        #include \"filename\"
-This is recursive; that is, #include directives in diary files thus included
-are obeyed.  You can change the `#include' to some other string by
-changing the variable `diary-include-string'."
-  (goto-char (point-min))
-  (while (re-search-forward
-          (concat
-           "\\(\\`\\|\^M\\|\n\\)"
-           (regexp-quote diary-include-string)
-           " \"\\([^\"]*\\)\"")
-          nil t)
-    (let ((diary-file (substitute-in-file-name
-                       (buffer-substring-no-properties
-                        (match-beginning 2) (match-end 2))))
-          (diary-list-include-blanks nil)
-          (list-diary-entries-hook 'include-other-diary-files)
-          (diary-display-hook 'ignore)
-          (diary-hook nil))
-      (if (file-exists-p diary-file)
-          (if (file-readable-p diary-file)
-              (unwind-protect
-                  (setq diary-entries-list
-                        (append diary-entries-list
-                                (list-diary-entries original-date number)))
-                (kill-buffer (find-buffer-visiting diary-file)))
-            (beep)
-            (message "Can't read included diary file %s" diary-file)
-            (sleep-for 2))
-        (beep)
-        (message "Can't find included diary file %s" diary-file)
-        (sleep-for 2))))
-    (goto-char (point-min)))
-
-(defun simple-diary-display ()
-  "Display the diary buffer if there are any relevant entries or holidays."
-  (let* ((holiday-list (if holidays-in-diary-buffer
-                           (check-calendar-holidays original-date)))
-         (msg (format "No diary entries for %s %s"
-                      (concat date-string (if holiday-list ":" ""))
-                      (mapconcat 'identity holiday-list "; "))))
-    (if (or (not diary-entries-list)
-            (and (not (cdr diary-entries-list))
-                 (string-equal (car (cdr (car diary-entries-list))) "")))
-        (if (<= (length msg) (frame-width))
-            (message "%s" msg)
-          (set-buffer (get-buffer-create holiday-buffer))
-          (setq buffer-read-only nil)
-          (calendar-set-mode-line date-string)
-          (erase-buffer)
-          (insert (mapconcat 'identity holiday-list "\n"))
-          (goto-char (point-min))
-          (set-buffer-modified-p nil)
-          (setq buffer-read-only t)
-          (display-buffer holiday-buffer)
-          (message  "No diary entries for %s" date-string))
-      (calendar-set-mode-line
-       (concat "Diary for " date-string
-               (if holiday-list ": " "")
-               (mapconcat 'identity holiday-list "; ")))
-      (display-buffer (find-buffer-visiting d-file))
-      (message "Preparing diary...done"))))
-
-(defun fancy-diary-display ()
-  "Prepare a diary buffer with relevant entries in a fancy, noneditable form.
-This function is provided for optional use as the `diary-display-hook'."
-  (save-excursion;; Turn off selective-display in the diary file's buffer.
-    (set-buffer (find-buffer-visiting (substitute-in-file-name diary-file)))
-    (let ((diary-modified (buffer-modified-p)))
-      (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
-      (setq selective-display nil)
-      (kill-local-variable 'mode-line-format)
-      (set-buffer-modified-p diary-modified)))
-  (if (or (not diary-entries-list)
-          (and (not (cdr diary-entries-list))
-               (string-equal (car (cdr (car diary-entries-list))) "")))
-      (let* ((holiday-list (if holidays-in-diary-buffer
-                               (check-calendar-holidays original-date)))
-             (msg (format "No diary entries for %s %s"
-                          (concat date-string (if holiday-list ":" ""))
-                          (mapconcat 'identity holiday-list "; "))))
-        (if (<= (length msg) (frame-width))
-            (message "%s" msg)
-          (set-buffer (get-buffer-create holiday-buffer))
-          (setq buffer-read-only nil)
-          (calendar-set-mode-line date-string)
-          (erase-buffer)
-          (insert (mapconcat 'identity holiday-list "\n"))
-          (goto-char (point-min))
-          (set-buffer-modified-p nil)
-          (setq buffer-read-only t)
-          (display-buffer holiday-buffer)
-          (message  "No diary entries for %s" date-string)))
-    (save-excursion;; Prepare the fancy diary buffer.
-      (set-buffer (make-fancy-diary-buffer))
-      (setq buffer-read-only nil)
-      (let ((entry-list diary-entries-list)
-            (holiday-list)
-            (holiday-list-last-month 1)
-            (holiday-list-last-year 1)
-            (date (list 0 0 0)))
-        (while entry-list
-          (if (not (calendar-date-equal date (car (car entry-list))))
-              (progn
-                (setq date (car (car entry-list)))
-                (and holidays-in-diary-buffer
-                     (calendar-date-compare
-                      (list (list holiday-list-last-month
-                                  (calendar-last-day-of-month
-                                   holiday-list-last-month
-                                   holiday-list-last-year)
-                                  holiday-list-last-year))
-                      (list date))
-                     ;; We need to get the holidays for the next 3 months.
-                     (setq holiday-list-last-month
-                           (extract-calendar-month date))
-                     (setq holiday-list-last-year
-                           (extract-calendar-year date))
-                     (increment-calendar-month
-                      holiday-list-last-month holiday-list-last-year 1)
-                     (setq holiday-list
-                           (let ((displayed-month holiday-list-last-month)
-                                 (displayed-year holiday-list-last-year))
-                             (calendar-holiday-list)))
-                     (increment-calendar-month
-                      holiday-list-last-month holiday-list-last-year 1))
-                (let* ((date-string (calendar-date-string date))
-                       (date-holiday-list
-                        (let ((h holiday-list)
-                              (d))
-                          ;; Make a list of all holidays for date.
-                          (while h
-                            (if (calendar-date-equal date (car (car h)))
-                                (setq d (append d (cdr (car h)))))
-                            (setq h (cdr h)))
-                          d)))
-                  (insert (if (= (point) (point-min)) "" ?\n) date-string)
-                  (if date-holiday-list (insert ":  "))
-                  (let* ((l (current-column))
-                         (longest 0))
-                    (insert (mapconcat '(lambda (x)
-                                          (if (< longest (length x))
-                                              (setq longest (length x)))
-                                          x)
-                                       date-holiday-list
-                                       (concat "\n" (make-string l ? ))))
-                    (insert ?\n (make-string (+ l longest) ?=) ?\n)))))
-          (if (< 0 (length (car (cdr (car entry-list)))))
-              (insert (car (cdr (car entry-list))) ?\n))
-          (setq entry-list (cdr entry-list))))
-      (set-buffer-modified-p nil)
-      (goto-char (point-min))
-      (setq buffer-read-only t)
-      (display-buffer fancy-diary-buffer)
-      (message "Preparing diary...done"))))
-
-(defun make-fancy-diary-buffer ()
-  "Create and return the initial fancy diary buffer."
-  (save-excursion
-    (set-buffer (get-buffer-create fancy-diary-buffer))
-    (setq buffer-read-only nil)
-    (make-local-variable 'mode-line-format)
-    (calendar-set-mode-line "Diary Entries")
-    (erase-buffer)
-    (set-buffer-modified-p nil)
-    (setq buffer-read-only t)
-    (get-buffer fancy-diary-buffer)))
-
-(defun print-diary-entries ()
-  "Print a hard copy of the diary display.
-
-If the simple diary display is being used, prepare a temp buffer with the
-visible lines of the diary buffer, add a heading line composed from the mode
-line, print the temp buffer, and destroy it.
-
-If the fancy diary display is being used, just print the buffer.
-
-The hooks given by the variable `print-diary-entries-hook' are called to do
-the actual printing."
-  (interactive)
-  (if (bufferp (get-buffer fancy-diary-buffer))
-      (save-excursion
-        (set-buffer (get-buffer fancy-diary-buffer))
-        (run-hooks 'print-diary-entries-hook))
-    (let ((diary-buffer
-           (find-buffer-visiting (substitute-in-file-name diary-file))))
-      (if diary-buffer
-          (let ((temp-buffer (get-buffer-create "*Printable Diary Entries*"))
-                (heading))
-            (save-excursion
-              (set-buffer diary-buffer)
-              (setq heading
-                    (if (not (stringp mode-line-format))
-                        "All Diary Entries"
-                      (string-match "^-*\\([^-].*[^-]\\)-*$" mode-line-format)
-                      (substring mode-line-format
-                                 (match-beginning 1) (match-end 1))))
-              (copy-to-buffer temp-buffer (point-min) (point-max))
-              (set-buffer temp-buffer)
-              (while (re-search-forward "\^M.*$" nil t)
-                (replace-match ""))
-              (goto-char (point-min))
-              (insert heading "\n"
-                      (make-string (length heading) ?=) "\n")
-              (run-hooks 'print-diary-entries-hook)
-              (kill-buffer temp-buffer)))
-        (error "You don't have a diary buffer!")))))
-
-(defun show-all-diary-entries ()
-  "Show all of the diary entries in the diary file.
-This function gets rid of the selective display of the diary file so that
-all entries, not just some, are visible.  If there is no diary buffer, one
-is created."
-  (interactive)
-  (let ((d-file (substitute-in-file-name diary-file)))
-    (if (and d-file (file-exists-p d-file))
-        (if (file-readable-p d-file)
-            (save-excursion
-              (let ((diary-buffer (find-buffer-visiting d-file)))
-                (set-buffer (if diary-buffer
-                                diary-buffer
-                              (find-file-noselect d-file t)))
-                (let ((buffer-read-only nil)
-                      (diary-modified (buffer-modified-p)))
-                  (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)
-                  (setq selective-display nil)
-                  (make-local-variable 'mode-line-format)
-                  (setq mode-line-format default-mode-line-format)
-                  (display-buffer (current-buffer))
-                  (set-buffer-modified-p diary-modified))))
-          (error "Your diary file is not readable!"))
-      (error "You don't have a diary file!"))))
-
-(defun diary-name-pattern (string-array &optional fullname)
-  "Convert an STRING-ARRAY, an array of strings to a pattern.
-The pattern will match any of the strings, either entirely or abbreviated
-to three characters.  An abbreviated form will match with or without a period;
-If the optional FULLNAME is t, abbreviations will not match, just the full
-name."
-  (let ((pattern ""))
-    (calendar-for-loop i from 0 to (1- (length string-array)) do
-      (setq pattern
-            (concat
-             pattern
-             (if (string-equal pattern "") "" "\\|")
-             (aref string-array i)
-             (if fullname
-                 ""
-               (concat
-                "\\|"
-                (substring (aref string-array i) 0 3) ".?")))))
-    pattern))
-
-(defvar marking-diary-entries nil
-  "True during the marking of diary entries, nil otherwise.")
-
-(defvar marking-diary-entry nil
-  "True during the marking of diary entries, if current entry is marking.")
-
-(defun mark-diary-entries ()
-  "Mark days in the calendar window that have diary entries.
-Each entry in the diary file visible in the calendar window is marked.
-After the entries are marked, the hooks `nongregorian-diary-marking-hook' and
-`mark-diary-entries-hook' are run."
-  (interactive)
-  (setq mark-diary-entries-in-calendar t)
-  (let ((d-file (substitute-in-file-name diary-file))
-        (marking-diary-entries t))
-    (if (and d-file (file-exists-p d-file))
-        (if (file-readable-p d-file)
-            (save-excursion
-              (message "Marking diary entries...")
-              (set-buffer (find-file-noselect d-file t))
-              (let ((d diary-date-forms)
-                    (old-diary-syntax-table))
-                (setq old-diary-syntax-table (syntax-table))
-                (set-syntax-table diary-syntax-table)
-                (while d
-                  (let*
-                      ((date-form (if (equal (car (car d)) 'backup)
-                                      (cdr (car d))
-                                    (car d)));; ignore 'backup directive
-                       (dayname (diary-name-pattern calendar-day-name-array))
-                       (monthname
-                        (concat
-                         (diary-name-pattern calendar-month-name-array)
-                         "\\|\\*"))
-                       (month "[0-9]+\\|\\*")
-                       (day "[0-9]+\\|\\*")
-                       (year "[0-9]+\\|\\*")
-                       (l (length date-form))
-                       (d-name-pos (- l (length (memq 'dayname date-form))))
-                       (d-name-pos (if (/= l d-name-pos) (+ 2 d-name-pos)))
-                       (m-name-pos (- l (length (memq 'monthname date-form))))
-                       (m-name-pos (if (/= l m-name-pos) (+ 2 m-name-pos)))
-                       (d-pos (- l (length (memq 'day date-form))))
-                       (d-pos (if (/= l d-pos) (+ 2 d-pos)))
-                       (m-pos (- l (length (memq 'month date-form))))
-                       (m-pos (if (/= l m-pos) (+ 2 m-pos)))
-                       (y-pos (- l (length (memq 'year date-form))))
-                       (y-pos (if (/= l y-pos) (+ 2 y-pos)))
-                       (regexp
-                        (concat
-                         "\\(\\`\\|\^M\\|\n\\)\\("
-                         (mapconcat 'eval date-form "\\)\\(")
-                         "\\)"))
-                       (case-fold-search t))
-                    (goto-char (point-min))
-                    (while (re-search-forward regexp nil t)
-                      (let* ((dd-name
-                              (if d-name-pos
-                                  (buffer-substring-no-properties
-                                   (match-beginning d-name-pos)
-                                   (match-end d-name-pos))))
-                             (mm-name
-                              (if m-name-pos
-                                  (buffer-substring-no-properties
-                                   (match-beginning m-name-pos)
-                                   (match-end m-name-pos))))
-                             (mm (string-to-int
-                                  (if m-pos
-                                      (buffer-substring-no-properties
-                                       (match-beginning m-pos)
-                                       (match-end m-pos))
-                                    "")))
-                             (dd (string-to-int
-                                  (if d-pos
-                                      (buffer-substring-no-properties
-                                       (match-beginning d-pos)
-                                       (match-end d-pos))
-                                    "")))
-                             (y-str (if y-pos
-                                        (buffer-substring-no-properties
-                                         (match-beginning y-pos)
-                                         (match-end y-pos))))
-                             (yy (if (not y-str)
-                                     0
-                                   (if (and (= (length y-str) 2)
-                                            abbreviated-calendar-year)
-                                       (let* ((current-y
-                                               (extract-calendar-year
-                                                (calendar-current-date)))
-                                              (y (+ (string-to-int y-str)
-                                                    (* 100
-                                                       (/ current-y 100)))))
-                                         (if (> (- y current-y) 50)
-                                             (- y 100)
-                                           (if (> (- current-y y) 50)
-                                               (+ y 100)
-                                             y)))
-                                     (string-to-int y-str)))))
-                        (if dd-name
-                            (mark-calendar-days-named
-                             (cdr (assoc (capitalize (substring dd-name 0 3))
-                                         (calendar-make-alist
-                                          calendar-day-name-array
-                                          0
-                                          '(lambda (x) (substring x 0 3))))))
-                          (if mm-name
-                              (if (string-equal mm-name "*")
-                                  (setq mm 0)
-                                (setq mm
-                                      (cdr (assoc
-                                            (capitalize
-                                             (substring mm-name 0 3))
-                                            (calendar-make-alist
-                                             calendar-month-name-array
-                                             1
-                                             '(lambda (x) (substring x 0 3)))
-                                            )))))
-                          (mark-calendar-date-pattern mm dd yy))))
-                    (setq d (cdr d))))
-                (mark-sexp-diary-entries)
-                (run-hooks 'nongregorian-diary-marking-hook
-                           'mark-diary-entries-hook)
-                (set-syntax-table old-diary-syntax-table)
-                (message "Marking diary entries...done")))
-          (error "Your diary file is not readable!"))
-      (error "You don't have a diary file!"))))
-
-(defun mark-sexp-diary-entries ()
-  "Mark days in the calendar window that have sexp diary entries.
-Each entry in the diary file (or included files) visible in the calendar window
-is marked.  See the documentation for the function `list-sexp-diary-entries'."
-  (let* ((sexp-mark (regexp-quote sexp-diary-entry-symbol))
-         (s-entry (concat "\\(\\`\\|\^M\\|\n\\)\\("
-                          (regexp-quote sexp-mark) "(\\)\\|\\("
-                          (regexp-quote diary-nonmarking-symbol)
-                          (regexp-quote sexp-mark) "(diary-remind\\)"))
-         (m)
-         (y)
-         (first-date)
-         (last-date))
-    (save-excursion
-      (set-buffer calendar-buffer)
-      (setq m displayed-month)
-      (setq y displayed-year))
-    (increment-calendar-month m y -1)
-    (setq first-date
-          (calendar-absolute-from-gregorian (list m 1 y)))
-    (increment-calendar-month m y 2)
-    (setq last-date
-          (calendar-absolute-from-gregorian
-           (list m (calendar-last-day-of-month m y) y)))
-    (goto-char (point-min))
-    (while (re-search-forward s-entry nil t)
-      (if (char-equal (preceding-char) ?\()
-          (setq marking-diary-entry t)
-        (setq marking-diary-entry nil))
-      (re-search-backward "(")
-      (let ((sexp-start (point))
-            (sexp)
-            (entry)
-            (entry-start)
-            (line-start))
-        (forward-sexp)
-        (setq sexp (buffer-substring-no-properties sexp-start (point)))
-        (save-excursion
-          (re-search-backward "\^M\\|\n\\|\\`")
-          (setq line-start (point)))
-        (forward-char 1)
-        (if (and (or (char-equal (preceding-char) ?\^M)
-                     (char-equal (preceding-char) ?\n))
-                 (not (looking-at " \\|\^I")))
-            (progn;; Diary entry consists only of the sexp
-              (backward-char 1)
-              (setq entry ""))
-          (setq entry-start (point))
-          (re-search-forward "\^M\\|\n" nil t)
-          (while (looking-at " \\|\^I")
-            (re-search-forward "\^M\\|\n" nil t))
-          (backward-char 1)
-          (setq entry (buffer-substring-no-properties entry-start (point)))
-          (while (string-match "[\^M]" entry)
-            (aset entry (match-beginning 0) ?\n )))
-        (calendar-for-loop date from first-date to last-date do
-          (if (diary-sexp-entry sexp entry
-                                (calendar-gregorian-from-absolute date))
-              (mark-visible-calendar-date
-               (calendar-gregorian-from-absolute date))))))))
-
-(defun mark-included-diary-files ()
-  "Mark the diary entries from other diary files with those of the diary file.
-This function is suitable for use as the `mark-diary-entries-hook'; it enables
-you to use shared diary files together with your own.  The files included are
-specified in the diary-file by lines of this form:
-        #include \"filename\"
-This is recursive; that is, #include directives in diary files thus included
-are obeyed.  You can change the `#include' to some other string by
-changing the variable `diary-include-string'."
-  (goto-char (point-min))
-  (while (re-search-forward
-          (concat
-           "\\(\\`\\|\^M\\|\n\\)"
-           (regexp-quote diary-include-string)
-           " \"\\([^\"]*\\)\"")
-          nil t)
-    (let ((diary-file (substitute-in-file-name
-                       (buffer-substring-no-properties
-                        (match-beginning 2) (match-end 2))))
-          (mark-diary-entries-hook 'mark-included-diary-files))
-      (if (file-exists-p diary-file)
-          (if (file-readable-p diary-file)
-              (progn
-                (mark-diary-entries)
-                (kill-buffer (find-buffer-visiting diary-file)))
-            (beep)
-            (message "Can't read included diary file %s" diary-file)
-            (sleep-for 2))
-        (beep)
-        (message "Can't find included diary file %s" diary-file)
-        (sleep-for 2))))
-  (goto-char (point-min)))
-
-(defun mark-calendar-days-named (dayname)
-  "Mark all dates in the calendar window that are day DAYNAME of the week.
-0 means all Sundays, 1 means all Mondays, and so on."
-  (save-excursion
-    (set-buffer calendar-buffer)
-    (let ((prev-month displayed-month)
-          (prev-year displayed-year)
-          (succ-month displayed-month)
-          (succ-year displayed-year)
-          (last-day)
-          (day))
-      (increment-calendar-month succ-month succ-year 1)
-      (increment-calendar-month prev-month prev-year -1)
-      (setq day (calendar-absolute-from-gregorian
-                 (calendar-nth-named-day 1 dayname prev-month prev-year)))
-      (setq last-day (calendar-absolute-from-gregorian
-                 (calendar-nth-named-day -1 dayname succ-month succ-year)))
-      (while (<= day last-day)
-        (mark-visible-calendar-date (calendar-gregorian-from-absolute day))
-        (setq day (+ day 7))))))
-
-(defun mark-calendar-date-pattern (month day year)
-  "Mark all dates in the calendar window that conform to MONTH/DAY/YEAR.
-A value of 0 in any position is a wildcard."
-  (save-excursion
-    (set-buffer calendar-buffer)
-    (let ((m displayed-month)
-          (y displayed-year))
-      (increment-calendar-month m y -1)
-      (calendar-for-loop i from 0 to 2 do
-          (mark-calendar-month m y month day year)
-          (increment-calendar-month m y 1)))))
-
-(defun mark-calendar-month (month year p-month p-day p-year)
-  "Mark dates in the MONTH/YEAR that conform to pattern P-MONTH/P_DAY/P-YEAR.
-A value of 0 in any position of the pattern is a wildcard."
-  (if (or (and (= month p-month)
-               (or (= p-year 0) (= year p-year)))
-          (and (= p-month 0)
-               (or (= p-year 0) (= year p-year))))
-      (if (= p-day 0)
-          (calendar-for-loop
-              i from 1 to (calendar-last-day-of-month month year) do
-            (mark-visible-calendar-date (list month i year)))
-        (mark-visible-calendar-date (list month p-day year)))))
-
-(defun sort-diary-entries ()
-  "Sort the list of diary entries by time of day."
-  (setq diary-entries-list (sort diary-entries-list 'diary-entry-compare)))
-
-(defun diary-entry-compare (e1 e2)
-  "Returns t if E1 is earlier than E2."
-  (or (calendar-date-compare e1 e2)
-      (and (calendar-date-equal (car e1) (car e2))
-           (< (diary-entry-time (car (cdr e1)))
-              (diary-entry-time (car (cdr e2)))))))
-
-(defun diary-entry-time (s)
-  "Time at the beginning of the string S in a military-style integer.
-For example, returns 1325 for 1:25pm.  Returns -9999 if no time is recognized.
-The recognized forms are XXXX or X:XX or XX:XX (military time), XXam or XXpm,
-and XX:XXam or XX:XXpm."
-  (cond ((string-match;; Military time  
-          "^[ \t]*\\([0-9]?[0-9]\\):?\\([0-9][0-9]\\)\\(\\>\\|[^ap]\\)" s)
-         (+ (* 100 (string-to-int
-                    (substring s (match-beginning 1) (match-end 1))))
-            (string-to-int (substring s (match-beginning 2) (match-end 2)))))
-        ((string-match;; Hour only  XXam or XXpm
-          "^[ \t]*\\([0-9]?[0-9]\\)\\([ap]\\)m\\>" s)
-         (+ (* 100 (% (string-to-int
-                         (substring s (match-beginning 1) (match-end 1)))
-                        12))
-            (if (string-equal "a"
-                              (substring s (match-beginning 2) (match-end 2)))
-                0 1200)))
-        ((string-match;; Hour and minute  XX:XXam or XX:XXpm
-          "^[ \t]*\\([0-9]?[0-9]\\):\\([0-9][0-9]\\)\\([ap]\\)m\\>" s)
-         (+ (* 100 (% (string-to-int
-                         (substring s (match-beginning 1) (match-end 1)))
-                        12))
-            (string-to-int (substring s (match-beginning 2) (match-end 2)))
-            (if (string-equal "a"
-                              (substring s (match-beginning 3) (match-end 3)))
-                0 1200)))
-        (t -9999)));; Unrecognizable
-
-(defun list-sexp-diary-entries (date)
-  "Add sexp entries for DATE from the diary file to `diary-entries-list'.
-Also, Make them visible in the diary file.  Returns t if any entries were
-found.
-
-Sexp diary entries must be prefaced by a `sexp-diary-entry-symbol' (normally
-`%%').  The form of a sexp diary entry is
-
-                  %%(SEXP) ENTRY
-
-Both ENTRY and DATE are globally available when the SEXP is evaluated.  If the
-SEXP yields the value nil, the diary entry does not apply.  If it yields a
-non-nil value, ENTRY will be taken to apply to DATE; if the non-nil value is a
-string, that string will be the diary entry in the fancy diary display.
-
-For example, the following diary entry will apply to the 21st of the month
-if it is a weekday and the Friday before if the 21st is on a weekend:
-
-      &%%(let ((dayname (calendar-day-of-week date))
-               (day (extract-calendar-day date)))
-           (or
-             (and (= day 21) (memq dayname '(1 2 3 4 5)))
-             (and (memq day '(19 20)) (= dayname 5)))
-         ) UIUC pay checks deposited
-
-A number of built-in functions are available for this type of diary entry:
-
-      %%(diary-date MONTH DAY YEAR) text
-                  Entry applies if date is MONTH, DAY, YEAR if
-                  `european-calendar-style' is nil, and DAY, MONTH, YEAR if
-                  `european-calendar-style' is t.  DAY, MONTH, and YEAR
-                  can be lists of integers, the constant t, or an integer.
-                  The constant t means all values.
-
-      %%(diary-float MONTH DAYNAME N) text
-                  Entry will appear on the Nth DAYNAME of MONTH.
-                  (DAYNAME=0 means Sunday, 1 means Monday, and so on;
-                  if N is negative it counts backward from the end of
-                  the month.  MONTH can be a list of months, a single
-                  month, or t to specify all months.
-
-      %%(diary-block M1 D1 Y1 M2 D2 Y2) text
-                  Entry will appear on dates between M1/D1/Y1 and M2/D2/Y2,
-                  inclusive.  (If `european-calendar-style' is t, the
-                  order of the parameters should be changed to D1, M1, Y1,
-                  D2, M2, Y2.)
-
-      %%(diary-anniversary MONTH DAY YEAR) text
-                  Entry will appear on anniversary dates of MONTH DAY, YEAR.
-                  (If `european-calendar-style' is t, the order of the
-                  parameters should be changed to DAY, MONTH, YEAR.)  Text
-                  can contain %d or %d%s; %d will be replaced by the number
-                  of years since the MONTH DAY, YEAR and %s will be replaced
-                  by the ordinal ending of that number (that is, `st', `nd',
-                  `rd' or `th', as appropriate.  The anniversary of February
-                  29 is considered to be March 1 in a non-leap year.
-
-      %%(diary-cyclic N MONTH DAY YEAR) text
-                  Entry will appear every N days, starting MONTH DAY, YEAR.
-                  (If `european-calendar-style' is t, the order of the
-                  parameters should be changed to N, DAY, MONTH, YEAR.)  Text
-                  can contain %d or %d%s; %d will be replaced by the number
-                  of repetitions since the MONTH DAY, YEAR and %s will
-                  be replaced by the ordinal ending of that number (that is,
-                  `st', `nd', `rd' or `th', as appropriate.
-
-      %%(diary-remind SEXP DAYS &optional MARKING) text
-                  Entry is a reminder for diary sexp SEXP.  DAYS is either a
-                  single number or a list of numbers indicating the number(s)
-                  of days before the event that the warning(s) should occur.
-                  If the current date is (one of) DAYS before the event
-                  indicated by EXPR, then a suitable message (as specified
-                  by `diary-remind-message') appears.  In addition to the
-                  reminders beforehand, the diary entry also appears on
-                  the date itself.  If optional MARKING is non-nil then the
-                  *reminders* are marked on the calendar.  Marking of
-                  reminders is independent of whether the entry *itself* is
-                  a marking or nonmarking one.
-
-      %%(diary-day-of-year)
-                  Diary entries giving the day of the year and the number of
-                  days remaining in the year will be made every day.  Note
-                  that since there is no text, it makes sense only if the
-                  fancy diary display is used.
-
-      %%(diary-iso-date)
-                  Diary entries giving the corresponding ISO commercial date
-                  will be made every day.  Note that since there is no text,
-                  it makes sense only if the fancy diary display is used.
-
-      %%(diary-french-date)
-                  Diary entries giving the corresponding French Revolutionary
-                  date will be made every day.  Note that since there is no
-                  text, it makes sense only if the fancy diary display is used.
-
-      %%(diary-islamic-date)
-                  Diary entries giving the corresponding Islamic date will be
-                  made every day.  Note that since there is no text, it
-                  makes sense only if the fancy diary display is used.
-
-      %%(diary-hebrew-date)
-                  Diary entries giving the corresponding Hebrew date will be
-                  made every day.  Note that since there is no text, it
-                  makes sense only if the fancy diary display is used.
-
-      %%(diary-astro-day-number) Diary entries giving the corresponding
-                  astronomical (Julian) day number will be made every day.
-                  Note that since there is no text, it makes sense only if the
-                  fancy diary display is used.
-
-      %%(diary-julian-date) Diary entries giving the corresponding
-                 Julian date will be made every day.  Note that since
-                 there is no text, it makes sense only if the fancy diary
-                 display is used.
-
-      %%(diary-sunrise-sunset)
-                  Diary entries giving the local times of sunrise and sunset
-                  will be made every day.  Note that since there is no text,
-                  it makes sense only if the fancy diary display is used.
-                  Floating point required.
-
-      %%(diary-phases-of-moon)
-                  Diary entries giving the times of the phases of the moon
-                  will be when appropriate.  Note that since there is no text,
-                  it makes sense only if the fancy diary display is used.
-                  Floating point required.
-
-      %%(diary-yahrzeit MONTH DAY YEAR) text
-                  Text is assumed to be the name of the person; the date is
-                  the date of death on the *civil* calendar.  The diary entry
-                  will appear on the proper Hebrew-date anniversary and on the
-                  day before.  (If `european-calendar-style' is t, the order
-                  of the parameters should be changed to DAY, MONTH, YEAR.)
-                  
-      %%(diary-rosh-hodesh)
-                  Diary entries will be made on the dates of Rosh Hodesh on
-                  the Hebrew calendar.  Note that since there is no text, it
-                  makes sense only if the fancy diary display is used.
-
-      %%(diary-parasha)
-                  Diary entries giving the weekly parasha will be made on
-                  every Saturday.  Note that since there is no text, it
-                  makes sense only if the fancy diary display is used.
-
-      %%(diary-omer)
-                  Diary entries giving the omer count will be made every day
-                  from Passover to Shavuot.  Note that since there is no text,
-                  it makes sense only if the fancy diary display is used.
-
-Marking these entries is *extremely* time consuming, so these entries are
-best if they are nonmarking."
-  (let* ((mark (regexp-quote diary-nonmarking-symbol))
-         (sexp-mark (regexp-quote sexp-diary-entry-symbol))
-         (s-entry (concat "\\(\\`\\|\^M\\|\n\\)" mark "?" sexp-mark "("))
-         (entry-found))
-    (goto-char (point-min))
-    (while (re-search-forward s-entry nil t)
-      (backward-char 1)
-      (let ((sexp-start (point))
-            (sexp)
-            (entry)
-            (entry-start)
-            (line-start))
-        (forward-sexp)
-        (setq sexp (buffer-substring-no-properties sexp-start (point)))
-        (save-excursion
-          (re-search-backward "\^M\\|\n\\|\\`")
-          (setq line-start (point)))
-        (forward-char 1)
-        (if (and (or (char-equal (preceding-char) ?\^M)
-                     (char-equal (preceding-char) ?\n))
-                 (not (looking-at " \\|\^I")))
-            (progn;; Diary entry consists only of the sexp
-              (backward-char 1)
-              (setq entry ""))
-          (setq entry-start (point))
-          (re-search-forward "\^M\\|\n" nil t)
-          (while (looking-at " \\|\^I")
-            (re-search-forward "\^M\\|\n" nil t))
-          (backward-char 1)
-          (setq entry (buffer-substring-no-properties entry-start (point)))
-          (while (string-match "[\^M]" entry)
-            (aset entry (match-beginning 0) ?\n )))
-        (let ((diary-entry (diary-sexp-entry sexp entry date)))
-          (if diary-entry
-              (subst-char-in-region line-start (point) ?\^M ?\n t))
-          (add-to-diary-list date diary-entry)
-          (setq entry-found (or entry-found diary-entry)))))
-    entry-found))
-
-(defun diary-sexp-entry (sexp entry date)
-  "Process a SEXP diary ENTRY for DATE."
-  (let ((result (if calendar-debug-sexp
-                    (let ((stack-trace-on-error t))
-                      (eval (car (read-from-string sexp))))
-                  (condition-case nil
-                      (eval (car (read-from-string sexp)))
-                    (error
-                     (beep)
-                     (message "Bad sexp at line %d in %s: %s"
-                              (save-excursion
-                                (save-restriction
-                                  (narrow-to-region 1 (point))
-                                  (goto-char (point-min))
-                                  (let ((lines 1))
-                                    (while (re-search-forward "\n\\|\^M" nil t)
-                                      (setq lines (1+ lines)))
-                                    lines)))
-                              diary-file sexp)
-                     (sleep-for 2))))))
-    (if (stringp result)
-        result
-      (if result
-          entry
-        nil))))
-
-(defun diary-date (month day year)
-  "Specific date(s) diary entry.
-Entry applies if date is MONTH, DAY, YEAR if `european-calendar-style' is nil,
-and DAY, MONTH, YEAR if `european-calendar-style' is t.  DAY, MONTH, and YEAR
-can be lists of integers, the constant t, or an integer.  The constant t means
-all values."
-  (let* ((dd (if european-calendar-style
-                month
-              day))
-         (mm (if european-calendar-style
-                day
-              month))
-         (m (extract-calendar-month date))
-         (y (extract-calendar-year date))
-         (d (extract-calendar-day date)))
-    (if (and
-         (or (and (listp dd) (memq d dd))
-             (equal d dd)
-             (eq dd t))
-         (or (and (listp mm) (memq m mm))
-             (equal m mm)
-             (eq mm t))
-         (or (and (listp year) (memq y year))
-             (equal y year)
-             (eq year t)))
-        entry)))
-
-(defun diary-block (m1 d1 y1 m2 d2 y2)
-  "Block diary entry.
-Entry applies if date is between two dates.  Order of the parameters is
-M1, D1, Y1, M2, D2, Y2 `european-calendar-style' is nil, and
-D1, M1, Y1, D2, M2, Y2 if `european-calendar-style' is t."
-  (let ((date1 (calendar-absolute-from-gregorian
-                (if european-calendar-style
-                    (list d1 m1 y1)
-                  (list m1 d1 y1))))
-        (date2 (calendar-absolute-from-gregorian
-                (if european-calendar-style
-                    (list d2 m2 y2)
-                  (list m2 d2 y2))))
-        (d (calendar-absolute-from-gregorian date)))
-    (if (and (<= date1 d) (<= d date2))
-        entry)))
-
-(defun diary-float (month dayname n)
-  "Floating diary entry--entry applies if date is the nth dayname of month.
-Parameters are MONTH, DAYNAME, N.  MONTH can be a list of months, the constant
-t, or an integer.  The constant t means all months.  If N is negative, count
-backward from the end of the month."
-  (let ((m (extract-calendar-month date))
-        (y (extract-calendar-year date)))
-    (if (and
-         (or (and (listp month) (memq m month))
-             (equal m month)
-             (eq month t))
-         (calendar-date-equal date (calendar-nth-named-day n dayname m y)))
-        entry)))
-
-(defun diary-anniversary (month day year)
-  "Anniversary diary entry.
-Entry applies if date is the anniversary of MONTH, DAY, YEAR if
-`european-calendar-style' is nil, and DAY, MONTH, YEAR if
-`european-calendar-style' is t.  Diary entry can contain `%d' or `%d%s'; the
-%d will be replaced by the number of years since the MONTH DAY, YEAR and the
-%s will be replaced by the ordinal ending of that number (that is, `st', `nd',
-`rd' or `th', as appropriate.  The anniversary of February 29 is considered
-to be March 1 in non-leap years."
-  (let* ((d (if european-calendar-style
-                month
-              day))
-         (m (if european-calendar-style
-                day
-              month))
-         (y (extract-calendar-year date))
-         (diff (- y year)))
-    (if (and (= m 2) (= d 29) (not (calendar-leap-year-p y)))
-        (setq m 3
-              d 1))
-    (if (and (> diff 0) (calendar-date-equal (list m d y) date))
-        (format entry diff (diary-ordinal-suffix diff)))))
-
-(defun diary-cyclic (n month day year)
-  "Cycle diary entry--entry applies every N days starting at MONTH, DAY, YEAR.
-If `european-calendar-style' is t, parameters are N, DAY, MONTH, YEAR.
-ENTRY can contain `%d' or `%d%s'; the %d will be replaced by the number of
-years since the MONTH DAY, YEAR and the %s will be replaced by the ordinal
-ending of that number (that is, `st', `nd', `rd' or `th', as appropriate."
-  (let* ((d (if european-calendar-style
-                month
-              day))
-         (m (if european-calendar-style
-                day
-              month))
-         (diff (- (calendar-absolute-from-gregorian date)
-                  (calendar-absolute-from-gregorian
-                   (list m d year))))
-         (cycle (/ diff n)))
-    (if (and (>= diff 0) (zerop (% diff n)))
-        (format entry cycle (diary-ordinal-suffix cycle)))))
-
-(defun diary-ordinal-suffix (n)
-  "Ordinal suffix for N. (That is, `st', `nd', `rd', or `th', as appropriate.)"
-  (if (or (memq (% n 100) '(11 12 13))
-          (< 3 (% n 10)))
-      "th"
-    (aref ["th" "st" "nd" "rd"] (% n 10))))
-
-(defun diary-day-of-year ()
-  "Day of year and number of days remaining in the year of date diary entry."
-  (calendar-day-of-year-string date))
-
-(defvar diary-remind-message
-  '("Reminder: Only "
-    (if (= 0 (% days 7))
-        (concat (int-to-string (/ days 7)) (if (= 7 days) " week" " weeks"))
-      (concat (int-to-string days) (if (= 1 days) " day" " days")))
-    " until "
-    diary-entry)
-  "*Pseudo-pattern giving form of reminder messages in the fancy diary
-display.
- 
-Used by the function `diary-remind', a pseudo-pattern is a list of
-expressions that can involve the keywords `days' (a number), `date' (a list of
-month, day, year), and `diary-entry' (a string).")
-
-(defun diary-remind (sexp days &optional marking)
-  "Provide a reminder of a diary entry.
-SEXP is a diary-sexp.  DAYS is either a single number or a list of numbers
-indicating the number(s) of days before the event that the warning(s) should
-occur on.  If the current date is (one of) DAYS before the event indicated by
-SEXP, then a suitable message (as specified by `diary-remind-message' is
-returned.
-
-In addition to the reminders beforehand, the diary entry also appears on
-the date itself.
- 
-If optional parameter MARKING is non-nil then the reminders are marked on the
-calendar.  Marking of reminders is independent of whether the entry itself is
-a marking or nonmarking one."
-  (let ((diary-entry))
-    (if (or (not marking-diary-entries) marking)
-        (cond
-         ((integerp days)
-          (let ((date (calendar-gregorian-from-absolute
-                       (+ (calendar-absolute-from-gregorian date) days))))
-            (if (setq diary-entry (eval sexp))
-                (setq diary-entry (mapconcat 'eval diary-remind-message "")))))
-         ((and (listp days) days)
-          (setq diary-entry (diary-remind sexp (car days) marking))
-          (if (not diary-entry)
-              (setq diary-entry (diary-remind sexp (cdr days) marking))))))
-    (or diary-entry
-        (and (or (not marking-diary-entries) marking-diary-entry)
-             (eval sexp)))))
-
-(defun add-to-diary-list (date string)
-  "Add the entry (DATE STRING) to `diary-entries-list'.
-Do nothing if DATE or STRING is nil."
-  (and date string
-       (setq diary-entries-list 
-             (append diary-entries-list (list (list date string))))))
-
-(defun make-diary-entry (string &optional nonmarking file)
-  "Insert a diary entry STRING which may be NONMARKING in FILE.
-If omitted, NONMARKING defaults to nil and FILE defaults to diary-file."
-  (find-file-other-window
-   (substitute-in-file-name (if file file diary-file)))
-  (goto-char (point-max))
-  (insert
-   (if (bolp) "" "\n")
-   (if nonmarking diary-nonmarking-symbol "")
-   string " "))
-
-(defun insert-diary-entry (arg)
-  "Insert a diary entry for the date indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t t)
-                    arg))
-
-(defun insert-weekly-diary-entry (arg)
-  "Insert a weekly diary entry for the day of the week indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (make-diary-entry (calendar-day-name (calendar-cursor-to-date t))
-                    arg))
-
-(defun insert-monthly-diary-entry (arg)
-  "Insert a monthly diary entry for the day of the month indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " * ")
-            '("* " day))))
-    (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
-                      arg)))
-
-(defun insert-yearly-diary-entry (arg)
-  "Insert an annual diary entry for the day of the year indicated by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " monthname)
-            '(monthname " " day))))
-    (make-diary-entry (calendar-date-string (calendar-cursor-to-date t) t)
-                      arg)))
-
-(defun insert-anniversary-diary-entry (arg)
-  "Insert an anniversary diary entry for the date given by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " month " " year)
-            '(month " " day " " year))))
-    (make-diary-entry
-     (format "%s(diary-anniversary %s)"
-             sexp-diary-entry-symbol
-             (calendar-date-string (calendar-cursor-to-date t) nil t))
-     arg)))
-
-(defun insert-block-diary-entry (arg)
-  "Insert a block diary entry for the days between the point and marked date.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " month " " year)
-            '(month " " day " " year)))
-         (cursor (calendar-cursor-to-date t))
-         (mark (or (car calendar-mark-ring)
-                   (error "No mark set in this buffer")))
-         (start)
-         (end))
-    (if (< (calendar-absolute-from-gregorian mark)
-           (calendar-absolute-from-gregorian cursor))
-        (setq start mark
-              end cursor)
-      (setq start cursor
-              end mark))
-    (make-diary-entry
-     (format "%s(diary-block %s %s)"
-      sexp-diary-entry-symbol
-      (calendar-date-string start nil t)
-      (calendar-date-string end nil t))
-     arg)))
-
-(defun insert-cyclic-diary-entry (arg)
-  "Insert a cyclic diary entry starting at the date given by point.
-Prefix arg will make the entry nonmarking."
-  (interactive "P")
-  (let* ((calendar-date-display-form
-          (if european-calendar-style
-              '(day " " month " " year)
-            '(month " " day " " year))))
-    (make-diary-entry
-     (format "%s(diary-cyclic %d %s)"
-             sexp-diary-entry-symbol
-             (calendar-read "Repeat every how many days: "
-                            '(lambda (x) (> x 0)))
-             (calendar-date-string (calendar-cursor-to-date t) nil t))
-     arg)))
-
-(provide 'diary-lib)
-
-;;; diary-lib.el ends here
diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el
deleted file mode 100644
index cb5b3a1d8cb..00000000000
--- a/lisp/calendar/holidays.el
+++ /dev/null
@@ -1,384 +0,0 @@
-;;; holidays.el --- holiday functions for the calendar package
-
-;; Copyright (C) 1989, 1990, 1992, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: holidays, calendar
-
-;; 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 collection of functions implements the holiday features as described
-;; in calendar.el.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;; Technical details of all the calendrical calculations can be found in
-;; ``Calendrical Calculations'' by Nachum Dershowitz and Edward M. Reingold,
-;; Software--Practice and Experience, Volume 20, Number 9 (September, 1990),
-;; pages 899-928.  ``Calendrical Calculations, Part II: Three Historical
-;; Calendars'' by E. M. Reingold,  N. Dershowitz, and S. M. Clamen,
-;; Software--Practice and Experience, Volume 23, Number 4 (April, 1993),
-;; pages 383-404.
-
-;; Hard copies of these two papers can be obtained by sending email to
-;; reingold@cs.uiuc.edu with the SUBJECT "send-paper-cal" (no quotes) and
-;; the message BODY containing your mailing address (snail).
-
-;;; Code:
-
-(require 'calendar)
-
-(autoload 'holiday-julian "cal-julian"
-  "Holiday on MONTH, DAY  (Julian) called STRING."
-  t)
-
-(autoload 'holiday-hebrew "cal-hebrew"
-  "Holiday on MONTH, DAY (Hebrew) called STRING."
-  t)
-
-(autoload 'holiday-rosh-hashanah-etc "cal-hebrew"
-  "List of dates related to Rosh Hashanah, as visible in calendar window."
-  t)
-
-(autoload 'holiday-hanukkah "cal-hebrew"
-  "List of dates related to Hanukkah, as visible in calendar window."
-  t)
-
-(autoload 'holiday-passover-etc "cal-hebrew"
-  "List of dates related to Passover, as visible in calendar window."
-  t)
-
-(autoload 'holiday-tisha-b-av-etc "cal-hebrew"
-  "List of dates around Tisha B'Av, as visible in calendar window."
-  t)
-
-(autoload 'holiday-islamic "cal-islam"
-  "Holiday on MONTH, DAY (Islamic) called STRING."
-  t)
-
-(autoload 'holiday-chinese-new-year "cal-china"
-  "Date of Chinese New Year."
-  t)
-
-(autoload 'solar-equinoxes-solstices "solar"
-  "Date and time of equinoxes and solstices, if visible in the calendar window.
-Requires floating point."
-  t)
-
-(defun holidays (&optional arg)
-  "Display the holidays for last month, this month, and next month.
-If called with an optional prefix argument, prompts for month and year.
-
-This function is suitable for execution in a .emacs file."
-  (interactive "P")
-  (save-excursion
-    (let* ((completion-ignore-case t)
-           (date (if arg
-                     (calendar-read-date t)
-                   (calendar-current-date)))
-           (displayed-month (extract-calendar-month date))
-           (displayed-year (extract-calendar-year date)))
-      (list-calendar-holidays))))
-
-(defun check-calendar-holidays (date)
-  "Check the list of holidays for any that occur on DATE.
-The value returned is a list of strings of relevant holiday descriptions.
-The holidays are those in the list calendar-holidays."
-  (let* ((displayed-month (extract-calendar-month date))
-         (displayed-year (extract-calendar-year date))
-         (h (calendar-holiday-list))
-         (holiday-list))
-    (while h
-      (if (calendar-date-equal date (car (car h)))
-          (setq holiday-list (append holiday-list (cdr (car h)))))
-      (setq h (cdr h)))
-    holiday-list))
-
-(defun calendar-cursor-holidays ()
-  "Find holidays for the date specified by the cursor in the calendar window."
-  (interactive)
-  (message "Checking holidays...")
-  (let* ((date (calendar-cursor-to-date t))
-         (date-string (calendar-date-string date))
-         (holiday-list (check-calendar-holidays date))
-         (holiday-string (mapconcat 'identity holiday-list ";  "))
-         (msg (format "%s:  %s" date-string holiday-string)))
-    (if (not holiday-list)
-        (message "No holidays known for %s" date-string)
-      (if (<= (length msg) (frame-width))
-          (message "%s" msg)
-        (set-buffer (get-buffer-create holiday-buffer))
-        (setq buffer-read-only nil)
-        (calendar-set-mode-line date-string)
-        (erase-buffer)
-        (insert (mapconcat 'identity holiday-list "\n"))
-        (goto-char (point-min))
-        (set-buffer-modified-p nil)
-        (setq buffer-read-only t)
-        (display-buffer holiday-buffer)
-        (message "Checking holidays...done")))))
-
-(defun mark-calendar-holidays ()
-  "Mark notable days in the calendar window."
-  (interactive)
-  (setq mark-holidays-in-calendar t)
-  (message "Marking holidays...")
-  (let ((holiday-list (calendar-holiday-list)))
-    (while holiday-list
-      (mark-visible-calendar-date
-       (car (car holiday-list)) calendar-holiday-marker)
-      (setq holiday-list (cdr holiday-list))))
-  (message "Marking holidays...done"))
-
-(defun list-calendar-holidays ()
-  "Create a buffer containing the holidays for the current calendar window.
-The holidays are those in the list calendar-notable-days.  Returns t if any
-holidays are found, nil if not."
-  (interactive)
-  (message "Looking up holidays...")
-  (let ((holiday-list (calendar-holiday-list))
-        (m1 displayed-month)
-        (y1 displayed-year)
-        (m2 displayed-month)
-        (y2 displayed-year))
-    (if (not holiday-list)
-        (progn
-          (message "Looking up holidays...none found")
-          nil)
-      (set-buffer (get-buffer-create holiday-buffer))
-      (setq buffer-read-only nil)
-      (increment-calendar-month m1 y1 -1)
-      (increment-calendar-month m2 y2 1)
-      (calendar-set-mode-line
-       (if (= y1 y2)
-           (format "Notable Dates from %s to %s, %d%%-"
-                   (calendar-month-name m1) (calendar-month-name m2) y2)
-         (format "Notable Dates from %s, %d to %s, %d%%-"
-                 (calendar-month-name m1) y1 (calendar-month-name m2) y2)))
-      (erase-buffer)
-      (insert
-       (mapconcat
-        '(lambda (x) (concat (calendar-date-string (car x))
-                             ": " (car (cdr x))))
-        holiday-list "\n"))
-      (goto-char (point-min))
-      (set-buffer-modified-p nil)
-      (setq buffer-read-only t)
-      (display-buffer holiday-buffer)
-      (message "Looking up holidays...done")
-      t)))
-
-(defun calendar-holiday-list ()
-  "Form the list of holidays that occur on dates in the calendar window.
-The holidays are those in the list calendar-holidays."
-  (let ((p calendar-holidays)
-        (holiday-list))
-    (while p
-      (let* ((holidays
-              (if calendar-debug-sexp
-                  (let ((stack-trace-on-error t))
-                    (eval (car p)))
-                (condition-case nil
-                    (eval (car p))
-                  (error (beep)
-                         (message "Bad holiday list item: %s" (car p))
-                         (sleep-for 2))))))
-        (if holidays
-            (setq holiday-list (append holidays holiday-list))))
-      (setq p (cdr p)))
-    (setq holiday-list (sort holiday-list 'calendar-date-compare))))
-
-;; Below are the functions that calculate the dates of holidays; these
-;; are eval'ed in the function calendar-holiday-list.  If you
-;; write other such functions, be sure to imitate the style used below.
-;; Remember that each function must return a list of items of the form
-;; ((month day year) string) of VISIBLE dates in the calendar window.
-
-(defun holiday-fixed (month day string)
-  "Holiday on MONTH, DAY (Gregorian) called STRING.
-If MONTH, DAY is visible, the value returned is the list (((MONTH DAY year)
-STRING)).  Returns nil if it is not visible in the current calendar window."
-  (let ((m displayed-month)
-        (y displayed-year))
-    (increment-calendar-month m y (- 11 month))
-    (if (> m 9)
-      (list (list (list month day y) string)))))
-
-(defun holiday-float (month dayname n string &optional day)
-  "Holiday on MONTH, DAYNAME (Nth occurrence, Gregorian) called STRING.
-If the Nth DAYNAME in MONTH is visible, the value returned is the list
-\(((MONTH DAY year) STRING)).
-
-If N<0, count backward from the end of MONTH.
-
-An optional parameter DAY means the Nth DAYNAME after/before MONTH DAY.
-
-Returns nil if it is not visible in the current calendar window."
-  (let ((m displayed-month)
-        (y displayed-year))
-    (increment-calendar-month m y (- 11 month))
-    (if (> m 9)
-      (list (list (calendar-nth-named-day n dayname month y day) string)))))
-
-(defun holiday-sexp (sexp string)
-  "Sexp holiday for dates in the calendar window.
-SEXP is an expression in variable `year' evaluates to `date'.
-
-STRING is an expression in `date' that evaluates to the holiday description
-of `date'.
-
-If `date' is visible in the calendar window, the holiday STRING is on that
-date.  If date is nil, or if the date is not visible, there is no holiday."
-  (let ((m displayed-month)
-        (y displayed-year))
-    (increment-calendar-month m y -1)
-    (filter-visible-calendar-holidays
-     (append
-      (let* ((year y)
-             (date (eval sexp))
-             (string (if date (eval string))))
-        (list (list date string)))
-      (let* ((year (1+ y))
-             (date (eval sexp))
-             (string (if date (eval string))))
-        (list (list date string)))))))
-
-(defun holiday-advent ()
-  "Date of Advent, if visible in calendar window."
-  (let ((year displayed-year)
-        (month displayed-month))
-    (increment-calendar-month month year -1)
-    (let ((advent (calendar-gregorian-from-absolute
-                   (calendar-dayname-on-or-before 0
-                    (calendar-absolute-from-gregorian
-                     (list 12 3 year))))))
-      (if (calendar-date-is-visible-p advent)
-          (list (list advent "Advent"))))))
-
-(defun holiday-easter-etc ()
-  "List of dates related to Easter, as visible in calendar window."
- (if (and (> displayed-month 5) (not all-christian-calendar-holidays))
-     nil;; Ash Wednesday, Good Friday, and Easter are not visible.
-   (let* ((century (1+ (/ displayed-year 100)))
-          (shifted-epact        ;; Age of moon for April 5...
-           (% (+ 14 (* 11 (% displayed-year 19));;     ...by Nicaean rule
-                 (-           ;; ...corrected for the Gregorian century rule
-                  (/ (* 3 century) 4))
-                 (/    ;; ...corrected for Metonic cycle inaccuracy.
-                  (+ 5 (* 8 century)) 25)
-                 (* 30 century));;              Keeps value positive.
-              30))
-          (adjusted-epact       ;;  Adjust for 29.5 day month.
-           (if (or (= shifted-epact 0)
-                   (and (= shifted-epact 1) (< 10 (% displayed-year 19))))
-               (1+ shifted-epact)
-             shifted-epact))
-          (paschal-moon       ;; Day after the full moon on or after March 21.
-           (- (calendar-absolute-from-gregorian (list 4 19 displayed-year))
-              adjusted-epact))
-          (abs-easter (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))
-          (mandatory
-           (list
-            (list (calendar-gregorian-from-absolute abs-easter)
-                  "Easter Sunday")
-            (list (calendar-gregorian-from-absolute (- abs-easter 2))
-                  "Good Friday")
-            (list (calendar-gregorian-from-absolute (- abs-easter 46))
-                  "Ash Wednesday")))
-          (optional
-           (list
-            (list (calendar-gregorian-from-absolute (- abs-easter 63))
-                  "Septuagesima Sunday")
-            (list (calendar-gregorian-from-absolute (- abs-easter 56))
-                  "Sexagesima Sunday")
-            (list (calendar-gregorian-from-absolute (- abs-easter 49))
-                  "Shrove Sunday")
-            (list (calendar-gregorian-from-absolute (- abs-easter 48))
-                  "Shrove Monday")
-            (list (calendar-gregorian-from-absolute (- abs-easter 47))
-                  "Shrove Tuesday")
-            (list (calendar-gregorian-from-absolute (- abs-easter 14))
-                  "Passion Sunday")
-            (list (calendar-gregorian-from-absolute (- abs-easter 7))
-                  "Palm Sunday")
-            (list (calendar-gregorian-from-absolute (- abs-easter 3))
-                  "Maundy Thursday")
-            (list (calendar-gregorian-from-absolute (+ abs-easter 35))
-                  "Rogation Sunday")
-            (list (calendar-gregorian-from-absolute (+ abs-easter 39))
-                  "Ascension Day")
-            (list (calendar-gregorian-from-absolute (+ abs-easter 49))
-                  "Pentecost (Whitsunday)")
-            (list (calendar-gregorian-from-absolute (+ abs-easter 50))
-                  "Whitmonday")
-            (list (calendar-gregorian-from-absolute (+ abs-easter 56))
-                  "Trinity Sunday")
-            (list (calendar-gregorian-from-absolute (+ abs-easter 60))
-                  "Corpus Christi")))
-          (output-list
-           (filter-visible-calendar-holidays mandatory)))
-     (if all-christian-calendar-holidays
-         (setq output-list
-               (append 
-                (filter-visible-calendar-holidays optional)
-                output-list)))
-     output-list)))
-
-(defun holiday-greek-orthodox-easter ()
-  "Date of Easter according to the rule of the Council of Nicaea."
-  (let ((m displayed-month)
-        (y displayed-year))
-    (increment-calendar-month m y 1)
-    (let* ((julian-year
-            (extract-calendar-year
-             (calendar-julian-from-absolute
-              (calendar-absolute-from-gregorian
-               (list m (calendar-last-day-of-month m y) y)))))
-           (shifted-epact ;; Age of moon for April 5.
-            (% (+ 14
-                  (* 11 (% julian-year 19)))
-               30))
-           (paschal-moon  ;; Day after full moon on or after March 21.
-            (- (calendar-absolute-from-julian (list 4 19 julian-year))
-               shifted-epact))
-           (nicaean-easter;; Sunday following the Paschal moon
-            (calendar-gregorian-from-absolute
-             (calendar-dayname-on-or-before 0 (+ paschal-moon 7)))))
-      (if (calendar-date-is-visible-p nicaean-easter)
-          (list (list nicaean-easter "Pascha (Greek Orthodox Easter)"))))))
-
-(defun filter-visible-calendar-holidays (l)
-  "Return a list of all visible holidays of those on L."
-  (let ((visible)
-        (p l))
-    (while p
-      (and (car (car p))
-           (calendar-date-is-visible-p (car (car p)))
-           (setq visible (append (list (car p)) visible)))
-      (setq p (cdr p)))
-    visible))
-
-(provide 'holidays)
-
-;;; holidays.el ends here
diff --git a/lisp/calendar/lunar.el b/lisp/calendar/lunar.el
deleted file mode 100644
index 67a472ebaab..00000000000
--- a/lisp/calendar/lunar.el
+++ /dev/null
@@ -1,391 +0,0 @@
-;;; lunar.el --- calendar functions for phases of the moon.
-
-;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;; Keywords: calendar
-;; Human-Keywords: moon, lunar phases, calendar, diary
-
-;; 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 collection of functions implements lunar phases for calendar.el and
-;; diary.el.
-
-;; Based on ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus,
-;; Willmann-Bell, Inc., 1985 and ``Astronomical Algorithms'' by Jean Meeus,
-;; Willmann-Bell, Inc., 1991.
-;;
-;; WARNING: The calculations will be accurate only to within a few minutes.
-
-;; The author would be delighted to have an astronomically more sophisticated
-;; person rewrite the code for the lunar calculations in this file!
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(if (fboundp 'atan)
-    (require 'lisp-float-type)
-  (error "Lunar calculations impossible since floating point is unavailable."))
-
-(require 'solar)
-
-(defun lunar-phase-list (month year)
-  "List of lunar phases for three months starting with Gregorian MONTH, YEAR."
-  (let ((end-month month)
-        (end-year year)
-        (start-month month)
-        (start-year year))
-    (increment-calendar-month end-month end-year 3)
-    (increment-calendar-month start-month start-year -1)
-    (let* ((end-date (list (list end-month 1 end-year)))
-           (start-date (list (list start-month 
-                                   (calendar-last-day-of-month
-                                    start-month start-year)
-                                   start-year)))
-           (index (* 4
-                     (truncate
-                      (* 12.3685
-                         (+ year
-                            ( / (calendar-day-number (list month 1 year))
-                                366.0)
-                            -1900)))))
-           (new-moon (lunar-phase index))
-           (list))
-      (while (calendar-date-compare new-moon end-date)
-        (if (calendar-date-compare start-date new-moon)
-            (setq list (append list (list new-moon))))
-        (setq index (1+ index))
-        (setq new-moon (lunar-phase index)))
-      list)))
-
-(defun lunar-phase (index)
-  "Local date and time of lunar phase INDEX.
-Integer below INDEX/4 gives the lunation number, counting from Jan 1, 1900;
-remainder mod 4 gives the phase: 0 new moon, 1 first quarter, 2 full moon,
-3 last quarter."
-  (let* ((phase (mod index 4))
-         (index (/ index 4.0))
-         (time (/ index 1236.85))
-         (date (+ (calendar-absolute-from-gregorian '(1 0.5 1900))
-                  0.75933
-                  (* 29.53058868 index)
-                  (* 0.0001178 time time)
-                  (* -0.000000155 time time time)
-                  (* 0.00033
-                     (solar-sin-degrees (+ 166.56
-                                           (* 132.87 time)
-                                           (* -0.009173 time time))))))
-         (sun-anomaly (mod
-                       (+ 359.2242
-                          (* 29.105356 index)
-                          (* -0.0000333 time time)
-                          (* -0.00000347 time time time))
-                       360.0))
-         (moon-anomaly (mod
-                        (+ 306.0253
-                           (* 385.81691806 index)
-                           (* 0.0107306 time time)
-                           (* 0.00001236 time time time))
-                        360.0))
-         (moon-lat (mod
-                    (+ 21.2964
-                       (* 390.67050646 index)
-                       (* -0.0016528 time time)
-                       (* -0.00000239 time time time))
-                    360.0))
-         (adjustment
-          (if (memq phase '(0 2))
-              (+ (* (- 0.1734 (* 0.000393 time))
-                    (solar-sin-degrees sun-anomaly))
-                 (* 0.0021 (solar-sin-degrees (* 2 sun-anomaly)))
-                 (* -0.4068 (solar-sin-degrees moon-anomaly))
-                 (* 0.0161 (solar-sin-degrees (* 2 moon-anomaly)))
-                 (* -0.0004 (solar-sin-degrees (* 3 moon-anomaly)))
-                 (* 0.0104 (solar-sin-degrees (* 2 moon-lat)))
-                 (* -0.0051 (solar-sin-degrees (+ sun-anomaly moon-anomaly)))
-                 (* -0.0074 (solar-sin-degrees (- sun-anomaly moon-anomaly)))
-                 (* 0.0004 (solar-sin-degrees (+ (* 2 moon-lat) sun-anomaly)))
-                 (* -0.0004 (solar-sin-degrees (- (* 2 moon-lat) sun-anomaly)))
-                 (* -0.0006 (solar-sin-degrees
-                             (+ (* 2 moon-lat) moon-anomaly)))
-                 (* 0.0010 (solar-sin-degrees (- (* 2 moon-lat) moon-anomaly)))
-                 (* 0.0005 (solar-sin-degrees
-                            (+ (* 2 moon-anomaly) sun-anomaly))))
-            (+ (* (- 0.1721 (* 0.0004 time))
-                  (solar-sin-degrees sun-anomaly))
-               (* 0.0021 (solar-sin-degrees (* 2 sun-anomaly)))
-               (* -0.6280 (solar-sin-degrees moon-anomaly))
-               (* 0.0089 (solar-sin-degrees (* 2 moon-anomaly)))
-               (* -0.0004 (solar-sin-degrees (* 3 moon-anomaly)))
-               (* 0.0079 (solar-sin-degrees (* 2 moon-lat)))
-               (* -0.0119 (solar-sin-degrees (+ sun-anomaly moon-anomaly)))
-               (* -0.0047 (solar-sin-degrees (- sun-anomaly moon-anomaly)))
-               (* 0.0003 (solar-sin-degrees (+ (* 2 moon-lat) sun-anomaly)))
-               (* -0.0004 (solar-sin-degrees (- (* 2 moon-lat) sun-anomaly)))
-               (* -0.0006 (solar-sin-degrees (+ (* 2 moon-lat) moon-anomaly)))
-               (* 0.0021 (solar-sin-degrees (- (* 2 moon-lat) moon-anomaly)))
-               (* 0.0003 (solar-sin-degrees
-                          (+ (* 2 moon-anomaly) sun-anomaly)))
-               (* 0.0004 (solar-sin-degrees
-                          (- sun-anomaly (* 2 moon-anomaly))))
-               (* -0.0003 (solar-sin-degrees
-                          (+ (* 2 sun-anomaly) moon-anomaly))))))
-         (adj (+ 0.0028
-                 (* -0.0004 (solar-cosine-degrees
-                             sun-anomaly))
-                 (* 0.0003 (solar-cosine-degrees
-                            moon-anomaly))))
-         (adjustment (cond ((= phase 1) (+ adjustment adj))
-                           ((= phase 2) (- adjustment adj))
-                           (t adjustment)))
-         (date (+ date adjustment))
-	 (date (+ date (/ (- calendar-time-zone
-			     (solar-ephemeris-correction
-                              (extract-calendar-year
-                               (calendar-gregorian-from-absolute
-                                (truncate date)))))
-			  60.0 24.0)))
-         (time (* 24 (- date (truncate date))))
-	 (date (calendar-gregorian-from-absolute (truncate date)))
-         (adj (dst-adjust-time date time)))
-    (list (car adj) (apply 'solar-time-string (cdr adj)) phase)))
-
-(defun lunar-phase-name (phase)
-  "Name of lunar PHASE.
-0 = new moon, 1 = first quarter, 2 = full moon, 3 = last quarter."
-  (cond ((= 0 phase) "New Moon")
-        ((= 1 phase) "First Quarter Moon")
-        ((= 2 phase) "Full Moon")
-        ((= 3 phase) "Last Quarter Moon")))
-
-(defun calendar-phases-of-moon ()
-  "Create a buffer with the lunar phases for the current calendar window."
-  (interactive)
-  (message "Computing phases of the moon...")
-  (let ((m1 displayed-month)
-        (y1 displayed-year)
-        (m2 displayed-month)
-        (y2 displayed-year))
-    (increment-calendar-month m1 y1 -1)
-    (increment-calendar-month m2 y2 1)
-    (set-buffer (get-buffer-create lunar-phases-buffer))
-    (setq buffer-read-only nil)
-    (calendar-set-mode-line
-     (if (= y1 y2)
-         (format "Phases of the Moon from %s to %s, %d%%-"
-                 (calendar-month-name m1) (calendar-month-name m2) y2)
-       (format "Phases of the Moon from %s, %d to %s, %d%%-"
-               (calendar-month-name m1) y1 (calendar-month-name m2) y2)))
-    (erase-buffer)
-    (insert
-     (mapconcat
-      '(lambda (x)
-         (let ((date (car x))
-               (time (car (cdr x)))
-               (phase (car (cdr (cdr x)))))
-           (concat (calendar-date-string date)
-                   ": "
-                   (lunar-phase-name phase)
-                   " "
-                   time)))
-      (lunar-phase-list m1 y1) "\n"))
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    (setq buffer-read-only t)
-    (display-buffer lunar-phases-buffer)
-    (message "Computing phases of the moon...done")))
-
-;;;###autoload
-(defun phases-of-moon (&optional arg)
-  "Display the quarters of the moon for last month, this month, and next month.
-If called with an optional prefix argument, prompts for month and year.
-
-This function is suitable for execution in a .emacs file."
-  (interactive "P")
-  (save-excursion
-    (let* ((date (if arg
-                     (calendar-read-date t)
-                   (calendar-current-date)))
-           (displayed-month (extract-calendar-month date))
-           (displayed-year (extract-calendar-year date)))
-      (calendar-phases-of-moon))))
-
-(defun diary-phases-of-moon ()
-  "Moon phases diary entry."
-  (let* ((index (* 4
-                   (truncate
-                    (* 12.3685
-                       (+ (extract-calendar-year date)
-                          ( / (calendar-day-number date)
-                              366.0)
-                          -1900)))))
-         (phase (lunar-phase index)))
-    (while (calendar-date-compare phase (list date))
-      (setq index (1+ index))
-      (setq phase (lunar-phase index)))
-    (if (calendar-date-equal (car phase) date)
-        (concat (lunar-phase-name (car (cdr (cdr phase)))) " "
-                (car (cdr phase))))))
-
-
-;;  For the Chinese calendar the calculations for the new moon need to be more
-;;  accurate than those above, so we use more terms in the approximation.
-
-(defun lunar-new-moon-time (k)
-  "Astronomical (Julian) day number of K th new moon."
-  (let* ((T (/ k 1236.85))
-	 (T2 (* T T))
-	 (T3 (* T T T))
-	 (T4 (* T2 T2))
-	 (JDE (+ 2451550.09765
-		 (* 29.530588853 k)
-		 (* 0.0001337 T2)
-		 (* -0.000000150 T3)
-		 (* 0.00000000073 T4)))
-	 (E (- 1 (* 0.002516 T) (* 0.0000074 T2)))
-	 (sun-anomaly (+ 2.5534
-			 (* 29.10535669 k)
-			 (* -0.0000218 T2)
-			 (* -0.00000011 T3)))
-	 (moon-anomaly (+ 201.5643
-			  (* 385.81693528 k)
-			  (* 0.0107438 T2)
-			  (* 0.00001239 T3)
-			  (* -0.000000058 T4)))
-	 (moon-argument (+ 160.7108
-			   (* 390.67050274 k)
-			   (* -0.0016341 T2)
-			   (* -0.00000227 T3)
-			   (* 0.000000011 T4)))
-	 (omega (+ 124.7746
-		   (* -1.56375580 k)
-		   (* 0.0020691 T2)
-		   (* 0.00000215 T3)))
-	 (A1  (+ 299.77 (*  0.107408 k) (* -0.009173 T2)))
-	 (A2  (+ 251.88 (*  0.016321 k)))
-	 (A3  (+ 251.83 (* 26.641886 k)))
-	 (A4  (+ 349.42 (* 36.412478 k)))
-	 (A5  (+  84.66 (* 18.206239 k)))
-	 (A6  (+ 141.74 (* 53.303771 k)))
-	 (A7  (+ 207.14 (*  2.453732 k)))
-	 (A8  (+ 154.84 (*  7.306860 k)))
-	 (A9  (+  34.52 (* 27.261239 k)))
-	 (A10 (+ 207.19 (*  0.121824 k)))
-	 (A11 (+ 291.34 (*  1.844379 k)))
-	 (A12 (+ 161.72 (* 24.198154 k)))
-	 (A13 (+ 239.56 (* 25.513099 k)))
-	 (A14 (+ 331.55 (*  3.592518 k)))
-	 (correction
-	    (+ (* -0.40720   (solar-sin-degrees moon-anomaly))
-	       (*  0.17241 E (solar-sin-degrees sun-anomaly))
-	       (*  0.01608   (solar-sin-degrees (* 2 moon-anomaly)))
-	       (*  0.01039   (solar-sin-degrees (* 2 moon-argument)))
-	       (*  0.00739 E (solar-sin-degrees (- moon-anomaly sun-anomaly)))
-	       (* -0.00514 E (solar-sin-degrees (+ moon-anomaly sun-anomaly)))
-	       (*  0.00208 E E (solar-sin-degrees (* 2 sun-anomaly)))
-	       (* -0.00111   (solar-sin-degrees
-			       (- moon-anomaly (* 2 moon-argument))))
-	       (* -0.00057   (solar-sin-degrees
-			       (+ moon-anomaly (* 2 moon-argument))))
-	       (*  0.00056 E (solar-sin-degrees
-			       (+ (* 2 moon-anomaly) sun-anomaly)))
-	       (* -0.00042   (solar-sin-degrees (* 3 moon-anomaly)))
-	       (*  0.00042 E (solar-sin-degrees
-			       (+ sun-anomaly (* 2 moon-argument))))
-	       (*  0.00038 E (solar-sin-degrees
-			       (- sun-anomaly (* 2 moon-argument))))
-	       (* -0.00024 E (solar-sin-degrees
-			       (- (* 2 moon-anomaly) sun-anomaly)))
-	       (* -0.00017   (solar-sin-degrees omega))
-	       (* -0.00007   (solar-sin-degrees
-			       (+ moon-anomaly (* 2 sun-anomaly))))
-	       (*  0.00004   (solar-sin-degrees
-			       (- (* 2 moon-anomaly) (* 2 moon-argument))))
-	       (*  0.00004   (solar-sin-degrees (* 3 sun-anomaly)))
-	       (*  0.00003   (solar-sin-degrees (+ moon-anomaly sun-anomaly
-						   (* -2 moon-argument))))
-	       (*  0.00003   (solar-sin-degrees
-			       (+ (* 2 moon-anomaly) (* 2 moon-argument))))
-	       (* -0.00003   (solar-sin-degrees (+ moon-anomaly sun-anomaly
-						   (* 2 moon-argument))))
-	       (*  0.00003   (solar-sin-degrees (- moon-anomaly sun-anomaly
-						   (* -2 moon-argument))))
-	       (* -0.00002   (solar-sin-degrees (- moon-anomaly sun-anomaly
-						   (* 2 moon-argument))))
-	       (* -0.00002   (solar-sin-degrees
-			       (+ (* 3 moon-anomaly) sun-anomaly)))
-	       (*  0.00002   (solar-sin-degrees (* 4 moon-anomaly)))))
-	 (additional
-	    (+ (* 0.000325 (solar-sin-degrees A1))
-	       (* 0.000165 (solar-sin-degrees A2))
-	       (* 0.000164 (solar-sin-degrees A3))
-	       (* 0.000126 (solar-sin-degrees A4))
-	       (* 0.000110 (solar-sin-degrees A5))
-	       (* 0.000062 (solar-sin-degrees A6))
-	       (* 0.000060 (solar-sin-degrees A7))
-	       (* 0.000056 (solar-sin-degrees A8))
-	       (* 0.000047 (solar-sin-degrees A9))
-	       (* 0.000042 (solar-sin-degrees A10))
-	       (* 0.000040 (solar-sin-degrees A11))
-	       (* 0.000037 (solar-sin-degrees A12))
-	       (* 0.000035 (solar-sin-degrees A13))
-	       (* 0.000023 (solar-sin-degrees A14))))
-	 (newJDE (+ JDE correction additional)))
-    (+ newJDE
-       (- (solar-ephemeris-correction
-           (extract-calendar-year
-            (calendar-gregorian-from-absolute
-             (floor (calendar-absolute-from-astro newJDE))))))
-       (/ calendar-time-zone 60.0 24.0))))
-
-(defun lunar-new-moon-on-or-after (d)
-  "Astronomical (Julian) day number of first new moon on or after astronomical
-\(Julian) day number d.  The fractional part is the time of day.
-
-The date and time are local time, including any daylight savings rules,
-as governed by the values of calendar-daylight-savings-starts,
-calendar-daylight-savings-starts-time, calendar-daylight-savings-ends,
-calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
-calendar-time-zone."
-  (let* ((date (calendar-gregorian-from-absolute
-                (floor (calendar-absolute-from-astro d))))
-         (year (+ (extract-calendar-year date)
-		  (/ (calendar-day-number date) 365.25)))
-	 (k (floor (* (- year 2000.0) 12.3685)))
-         (date (lunar-new-moon-time k)))
-    (while (< date d)
-      (setq k (1+ k))
-      (setq date (lunar-new-moon-time k)))
-    (let* ((a-date (calendar-absolute-from-astro date))
-           (time (* 24 (- a-date (truncate a-date))))
-           (date (calendar-gregorian-from-absolute (truncate a-date)))
-           (adj (dst-adjust-time date time)))
-      (calendar-astro-from-absolute
-       (+ (calendar-absolute-from-gregorian (car adj))
-          (/ (car (cdr adj)) 24.0))))))
-
-(provide 'lunar)
-
-;;; lunar.el ends here
diff --git a/lisp/calendar/solar.el b/lisp/calendar/solar.el
deleted file mode 100644
index 936f78501b1..00000000000
--- a/lisp/calendar/solar.el
+++ /dev/null
@@ -1,1045 +0,0 @@
-;;; solar.el --- calendar functions for solar events.
-
-;; Copyright (C) 1992, 1993, 1995 Free Software Foundation, Inc.
-
-;; Author: Edward M. Reingold <reingold@cs.uiuc.edu>
-;;	Denis B. Roegel <Denis.Roegel@loria.fr>
-;; Keywords: calendar
-;; Human-Keywords: sunrise, sunset, equinox, solstice, calendar, diary,
-;;	holidays
-
-;; 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 collection of functions implements the features of calendar.el,
-;; diary.el, and holiday.el that deal with times of day, sunrise/sunset, and
-;; equinoxes/solstices.
-
-;; Based on the ``Almanac for Computers 1984,'' prepared by the Nautical
-;; Almanac Office, United States Naval Observatory, Washington, 1984, on
-;; ``Astronomical Formulae for Calculators,'' 3rd ed., by Jean Meeus,
-;; Willmann-Bell, Inc., 1985, on ``Astronomical Algorithms'' by Jean Meeus,
-;; Willmann-Bell, Inc., 1991, and on ``Planetary Programs and Tables from
-;; -4000 to +2800'' by Pierre Bretagnon and Jean-Louis Simon, Willmann-Bell,
-;; Inc., 1986.
-
-;;
-;; Accuracy:
-;;    1. Sunrise/sunset times will be accurate to the minute for years
-;;       1951--2050.  For other years the times will be within +/- 2 minutes.
-;;
-;;    2. Equinox/solstice times will be accurate to the minute for years
-;;       1951--2050.  For other years the times will be within +/- 1 minute.
-
-;; Comments, corrections, and improvements should be sent to
-;;  Edward M. Reingold               Department of Computer Science
-;;  (217) 333-6733                   University of Illinois at Urbana-Champaign
-;;  reingold@cs.uiuc.edu             1304 West Springfield Avenue
-;;                                   Urbana, Illinois 61801
-
-;;; Code:
-
-(if (fboundp 'atan)
-    (require 'lisp-float-type)
-  (error "Solar/lunar calculations impossible since floating point is unavailable."))
-
-(require 'cal-dst)
-(require 'cal-julian)
-
-;;;###autoload
-(defvar calendar-time-display-form
-  '(12-hours ":" minutes am-pm
-    (if time-zone " (") time-zone (if time-zone ")"))
-  "*The pseudo-pattern that governs the way a time of day is formatted.
-
-A pseudo-pattern is a list of expressions that can involve the keywords
-`12-hours', `24-hours', and `minutes',  all numbers in string form,
-and `am-pm' and `time-zone',  both alphabetic strings.
-
-For example, the form
-
-  '(24-hours \":\" minutes
-    (if time-zone \" (\") time-zone (if time-zone \")\"))
-
-would give military-style times like `21:07 (UTC)'.")
-
-;;;###autoload
-(defvar calendar-latitude nil
-  "*Latitude of `calendar-location-name' in degrees.
-
-The value can be either a decimal fraction (one place of accuracy is
-sufficient), + north, - south, such as 40.7 for New York City, or the value
-can be a vector [degrees minutes north/south] such as [40 50 north] for New
-York City.
-
-This variable should be set in `site-start'.el.")
-
-;;;###autoload
-(defvar calendar-longitude nil
-  "*Longitude of `calendar-location-name' in degrees.
-
-The value can be either a decimal fraction (one place of accuracy is
-sufficient), + east, - west, such as -73.9 for New York City, or the value
-can be a vector [degrees minutes east/west] such as [73 55 west] for New
-York City.
-
-This variable should be set in `site-start'.el.")
-
-(defsubst calendar-latitude ()
-  "Convert calendar-latitude to a signed decimal fraction, if needed."
-  (if (numberp calendar-latitude)
-      calendar-latitude
-    (let ((lat (+ (aref calendar-latitude 0)
-                  (/ (aref calendar-latitude 1) 60.0))))
-      (if (equal (aref calendar-latitude 2) 'north)
-          lat
-        (- lat)))))
-
-(defsubst calendar-longitude ()
-  "Convert calendar-longitude to a signed decimal fraction, if needed."
-  (if (numberp calendar-longitude)
-      calendar-longitude
-    (let ((long (+ (aref calendar-longitude 0)
-                  (/ (aref calendar-longitude 1) 60.0))))
-      (if (equal (aref calendar-longitude 2) 'east)
-          long
-        (- long)))))
-
-;;;###autoload
-(defvar calendar-location-name
-  '(let ((float-output-format "%.1f"))
-     (format "%s%s, %s%s"
-             (if (numberp calendar-latitude)
-                 (abs calendar-latitude)
-               (+ (aref calendar-latitude 0)
-                  (/ (aref calendar-latitude 1) 60.0)))
-             (if (numberp calendar-latitude)
-                 (if (> calendar-latitude 0) "N" "S")
-               (if (equal (aref calendar-latitude 2) 'north) "N" "S"))
-             (if (numberp calendar-longitude)
-                 (abs calendar-longitude)
-               (+ (aref calendar-longitude 0)
-                  (/ (aref calendar-longitude 1) 60.0)))
-             (if (numberp calendar-longitude)
-                 (if (> calendar-longitude 0) "E" "W")
-               (if (equal (aref calendar-longitude 2) 'east) "E" "W"))))
-  "*Expression evaluating to name of `calendar-longitude', calendar-latitude'.
-For example, \"New York City\".  Default value is just the latitude, longitude
-pair.
-
-This variable should be set in `site-start'.el.")
-
-(defvar solar-error 0.5
-"*Tolerance (in minutes) for sunrise/sunset calculations.
-
-A larger value makes the calculations for sunrise/sunset faster, but less
-accurate.  The default is half a minute (30 seconds), so that sunrise/sunset
-times will be correct to the minute.
-
-It is useless to set the value smaller than 4*delta, where delta is the
-accuracy in the longitude of the sun (given by the function
-`solar-ecliptic-coordinates') in degrees since (delta/360) x (86400/60) = 4 x
-delta.  At present, delta = 0.01 degrees, so the value of the variable
-`solar-error' should be at least 0.04 minutes (about 2.5 seconds).")
-
-(defvar solar-n-hemi-seasons
-  '("Vernal Equinox" "Summer Solstice" "Autumnal Equinox" "Winter Solstice")
-  "List of season changes for the northern hemisphere.")
-
-(defvar solar-s-hemi-seasons
-  '("Autumnal Equinox" "Winter Solstice" "Vernal Equinox" "Summer Solstice")
-  "List of season changes for the southern hemisphere.")
-
-(defvar solar-sidereal-time-greenwich-midnight 
-   nil 
-   "Sidereal time at Greenwich at midnight (universal time).")
-
-(defvar solar-spring-or-summer-season nil  
-  "T if spring or summer and nil otherwise.
-Needed for polar areas, in order to know whether the day lasts 0 or 24 hours.")
-
-(defun solar-setup ()
-  "Prompt user for latitude, longitude, and time zone."
-  (beep)
-  (if (not calendar-longitude)
-      (setq calendar-longitude
-            (solar-get-number
-             "Enter longitude (decimal fraction; + east, - west): ")))
-  (if (not calendar-latitude)
-      (setq calendar-latitude
-            (solar-get-number
-             "Enter latitude (decimal fraction; + north, - south): ")))
-  (if (not calendar-time-zone)
-      (setq calendar-time-zone
-            (solar-get-number
-             "Enter difference from Coordinated Universal Time (in minutes): "))))
-
-(defun solar-get-number (prompt)
-  "Return a number from the minibuffer, prompting with PROMPT.
-Returns nil if nothing was entered."
-  (let ((x (read-string prompt "")))
-    (if (not (string-equal x ""))
-        (string-to-int x))))
-
-;; The condition-case stuff is needed to catch bogus arithmetic
-;; exceptions that occur on some machines (like Sparcs)
-(defun solar-sin-degrees (x)
-  (condition-case nil
-      (sin (degrees-to-radians (mod x 360.0)))
-    (solar-sin-degrees x)))
-(defun solar-cosine-degrees (x)
-   (condition-case nil
-       (cos (degrees-to-radians (mod x 360.0)))
-     (solar-cosine-degrees x)))
-(defun solar-tangent-degrees (x)
-  (condition-case nil
-      (tan (degrees-to-radians (mod x 360.0)))
-    (solar-tangent-degrees x)))
-      
-(defun solar-xy-to-quadrant (x y)
-  "Determines the quadrant of the point X, Y."
-  (if (> x 0)
-      (if (> y 0) 1 4)
-      (if (> y 0) 2 3)))
-
-(defun solar-degrees-to-quadrant (angle)
-  "Determines the quadrant of ANGLE."
-  (1+ (floor (mod angle 360) 90)))
-
-(defun solar-arctan (x quad)
-  "Arctangent of X in quadrant QUAD."
-  (let ((deg (radians-to-degrees (atan x))))
-    (cond ((equal quad 2)   (+ deg 180))
-	  ((equal quad 3)   (+ deg 180))
-	  ((equal quad 4)   (+ deg 360))
-	  (t                deg))))
-
-(defun solar-atn2 (x y)
-   "Arctan of point X, Y."
-   (if (= x 0)
-       (if (> y 0) 90 270)
-     (solar-arctan (/ y x) x)))
-
-(defun solar-arccos (x)
-     "Arcos of X."
-     (let ((y (sqrt (- 1 (* x x)))))
-       (solar-atn2 x y)))
-
-(defun solar-arcsin (y)
-     "Arcsin of Y."
-     (let ((x (sqrt (- 1 (* y y)))))
-       (solar-atn2 x y)
-       ))
-
-(defsubst solar-degrees-to-hours (degrees)
-  "Convert DEGREES to hours."
-  (/ degrees 15.0))
-
-(defsubst solar-hours-to-days (hour)
-  "Convert HOUR to decimal fraction of a day."
-  (/ hour 24.0))
-
-(defun solar-right-ascension (longitude obliquity)
-  "Right ascension of the sun, in hours, given LONGITUDE and OBLIQUITY.
-Both arguments are in degrees."
-  (solar-degrees-to-hours
-   (solar-arctan
-    (* (solar-cosine-degrees obliquity) (solar-tangent-degrees longitude))
-    (solar-degrees-to-quadrant longitude))))
-
-(defun solar-declination (longitude obliquity)
-  "Declination of the sun, in degrees, given LONGITUDE and OBLIQUITY.
-Both arguments are in degrees."
-  (solar-arcsin
-   (* (solar-sin-degrees obliquity)
-      (solar-sin-degrees longitude))))
-
-(defun solar-sunrise-and-sunset (time latitude longitude)
-  "Sunrise, sunset and length of day. 
-Parameters are the midday TIME and the LATITUDE, LONGITUDE of the location.
-
-TIME is a pair with the first component being the number of Julian centuries
-elapsed at 0 Universal Time, and the second component being the universal
-time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
-\(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
-Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
-
-Coordinates are included because this function is called with latitude=10
-degrees to find out if polar regions have 24 hours of sun or only night."
-  (let* ((rise-time (solar-moment -1 latitude longitude time))
-         (set-time (solar-moment 1 latitude longitude time))
-         (day-length))
-    (if (not (and rise-time set-time))
-        (if (or (and (> latitude 0) solar-spring-or-summer-season)
-                (and (< latitude 0) (not solar-spring-or-summer-season)))
-          (setq day-length 24)
-          (setq day-length 0))
-        (setq day-length (- set-time rise-time)))
-    (list (if rise-time (+ rise-time (/ calendar-time-zone 60.0)) nil)
-          (if set-time (+ set-time (/ calendar-time-zone 60.0)) nil)
-          day-length)))
-
-(defun solar-moment (direction latitude longitude time)
-  "Sunrise/sunset at location.
-Sunrise if DIRECTION =-1 or sunset if =1 at LATITUDE, LONGITUDE, with midday
-being TIME.
-
-TIME is a pair with the first component being the number of Julian centuries
-elapsed at 0 Universal Time, and the second component being the universal
-time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
-\(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
-Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
-
-Uses binary search."
-  (let* ((ut (car (cdr time)))
-         (possible 1) ; we assume that rise or set are possible
-         (utmin (+ ut (* direction 12.0))) 
-         (utmax ut)    ; the time searched is between utmin and utmax
-            ; utmin and utmax are in hours
-         (utmoment-old 0.0)    ; rise or set approximation
-         (utmoment 1.0) ; rise or set approximation
-         (hut 0)         ; sun height at utmoment
-         (t0 (car time))
-         (hmin (car (cdr 
-               (solar-horizontal-coordinates (list t0 utmin) 
-                                                latitude longitude t))))
-         (hmax (car (cdr 
-               (solar-horizontal-coordinates (list t0 utmax) 
-                                                latitude longitude t)))))
-       ; -0.61 degrees is the height of the middle of the sun, when it rises
-       ;   or sets.
-     (if (< hmin -0.61) 
-              (if (> hmax -0.61)
-                  (while ;(< i 20) ; we perform a simple dichotomy
-                         ; (> (abs (+ hut 0.61)) epsilon)
-                         (>= (abs (- utmoment utmoment-old))
-                             (/ solar-error 60))
-                    (setq utmoment-old utmoment)
-                    (setq utmoment (/ (+ utmin utmax) 2))
-                    (setq hut (car (cdr 
-                                    (solar-horizontal-coordinates 
-                                   (list t0 utmoment) latitude longitude t))))
-                    (if (< hut -0.61) (setq utmin utmoment))
-                    (if (> hut -0.61) (setq utmax utmoment))
-                   )
-                (setq possible 0)) ; the sun never rises
-                (setq possible 0)) ; the sun never sets
-     (if (equal possible 0) nil utmoment)))
-
-(defun solar-time-string (time time-zone)
-  "Printable form for decimal fraction TIME in TIME-ZONE.
-Format used is given by `calendar-time-display-form'."
-  (let* ((time (round (* 60 time)))
-	 (24-hours (/ time 60))
-	 (minutes (format "%02d" (% time 60)))
-	 (12-hours (format "%d" (1+ (% (+ 24-hours 11) 12))))
-	 (am-pm (if (>= 24-hours 12) "pm" "am"))
-	 (24-hours (format "%02d" 24-hours)))
-    (mapconcat 'eval calendar-time-display-form "")))
-
-
-(defun solar-daylight (time)
-  "Printable form for time expressed in hours."
-  (format "%d:%02d"
-          (floor time)
-          (floor (* 60 (- time (floor time))))))
-
-(defun solar-exact-local-noon (date)
-  "Date and Universal Time of local noon at *local date* date. 
-
-The date may be different from the one asked for, but it will be the right
-local date.  The second component of date should be an integer."
-  (let* ((nd date)
-         (ut (- 12.0 (/ (calendar-longitude) 15)))
-         (te (solar-time-equation date ut)))
-    (setq ut (- ut te))
-    (if (>= ut 24)
-        (progn 
-          (setq nd (list (car date) (+ 1 (car (cdr date)))
-                         (car (cdr (cdr date)))))
-          (setq ut (- ut 24))))
-    (if (< ut 0)
-        (progn 
-          (setq nd (list (car date) (- (car (cdr date)) 1)
-                         (car (cdr (cdr date)))))
-          (setq ut (+ ut 24))))
-    (setq nd (calendar-gregorian-from-absolute
-                       (calendar-absolute-from-gregorian nd)))
-        ; date standardization
-    (list nd ut)))
-
-(defun solar-sunrise-sunset (date)
-  "List of *local* times of sunrise, sunset, and daylight on Gregorian DATE.
-
-Corresponding value is nil if there is no sunrise/sunset."
-  (let* (; first, get the exact moment of local noon.
-         (exact-local-noon (solar-exact-local-noon date))
-         ; get the the time from the 2000 epoch.
-         (t0 (solar-julian-ut-centuries (car exact-local-noon)))
-         ; store the sidereal time at Greenwich at midnight of UT time.
-         ; find if summer or winter slightly above the equator
-         (equator-rise-set
-          (progn (setq solar-sidereal-time-greenwich-midnight 
-                       (solar-sidereal-time t0))
-                 (solar-sunrise-and-sunset 
-                  (list t0 (car (cdr exact-local-noon)))
-                  10.0
-                  (calendar-longitude))))
-         ; store the spring/summer information,
-         ; compute sunrise and sunset (two first components of rise-set).
-         ; length of day is the third component (it is only the difference
-         ; between sunset and sunrise when there is a sunset and a sunrise)
-         (rise-set
-          (progn
-            (setq solar-spring-or-summer-season 
-                  (if (> (car (cdr (cdr equator-rise-set))) 12) 1 0))
-            (solar-sunrise-and-sunset 
-             (list t0 (car (cdr exact-local-noon)))
-             (calendar-latitude)
-             (calendar-longitude))))
-         (rise (car rise-set))
-         (adj-rise (if rise (dst-adjust-time date rise) nil))
-         (set (car (cdr rise-set)))
-         (adj-set (if set (dst-adjust-time date set) nil))
-         (length  (car (cdr (cdr rise-set)))) )
-    (list
-     (and rise (calendar-date-equal date (car adj-rise)) (cdr adj-rise))
-     (and set (calendar-date-equal date (car adj-set)) (cdr adj-set))
-     (solar-daylight length))))
-
-(defun solar-sunrise-sunset-string (date)
-  "String of *local* times of sunrise, sunset, and daylight on Gregorian DATE."
-  (let ((l (solar-sunrise-sunset date)))
-    (format
-     "%s, %s at %s (%s hours daylight)"
-     (if (car l)
-         (concat "Sunrise " (apply 'solar-time-string (car l)))
-       "No sunrise")
-     (if (car (cdr l))
-         (concat "sunset " (apply 'solar-time-string (car (cdr l))))
-       "no sunset")
-     (eval calendar-location-name)
-     (car (cdr (cdr l))))))
-
-(defun solar-julian-ut-centuries (date)
-  "Number of Julian centuries elapsed since 1 Jan, 2000 at noon  U.T. for Gregorian DATE."
-  (/ (- (calendar-absolute-from-gregorian date) 
-        (calendar-absolute-from-gregorian '(1 1.5 2000)))
-     36525.0))
-  
-(defun solar-ephemeris-time(time)
-  "Ephemeris Time at moment TIME.
-
-TIME is a pair with the first component being the number of Julian centuries
-elapsed at 0 Universal Time, and the second component being the universal
-time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
-\(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
-Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
-
-Result is in julian centuries of ephemeris time."
-  (let* ((t0 (car time))
-         (ut (car (cdr time)))
-         (t1 (+ t0 (/ (/ ut 24.0) 36525)))
-         (y (+ 2000 (* 100 t1)))
-         (dt (* 86400 (solar-ephemeris-correction (floor y)))))
-      (+ t1 (/ (/ dt 86400) 36525))))
-
-(defun solar-date-next-longitude (d l)
-  "First moment on or after Julian day number D when sun's longitude is a
-multiple of L degrees at calendar-location-name with that location's
-local time (including any daylight savings rules).
-
-L must be an integer divisor of 360.
-
-Result is in local time expressed astronomical (Julian) day numbers.
-
-The values of calendar-daylight-savings-starts,
-calendar-daylight-savings-starts-time, calendar-daylight-savings-ends,
-calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
-calendar-time-zone are used to interpret local time."
-  (let* ((long)
-         (start d)
-         (start-long (solar-longitude d))
-         (next (mod (* l (1+ (floor (/ start-long l)))) 360))
-         (end (+ d (* (/ l 360.0) 400)))
-         (end-long (solar-longitude end)))
-    (while                 ;; bisection search for nearest minute
-        (< 0.00001 (- end start))
-      ;; start   <= d    < end
-      ;; start-long <= next < end-long when next != 0
-      ;; when next = 0, we look for the discontinuity (start-long is near 360
-      ;;                and end-long is small (less than l).
-      (setq d (/ (+ start end) 2.0))
-      (setq long (solar-longitude d))
-      (if (or (and (/= next 0) (< long next))
-              (and (= next 0) (< l long)))
-          (progn
-            (setq start d)
-            (setq start-long long))
-        (setq end d)
-        (setq end-long long)))
-    (/ (+ start end) 2.0)))
-
-(defun solar-horizontal-coordinates 
-          (time latitude longitude for-sunrise-sunset)
-  "Azimuth and height of the sun at TIME, LATITUDE, and LONGITUDE.
-
-TIME is a pair with the first component being the number of Julian centuries
-elapsed at 0 Universal Time, and the second component being the universal
-time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
-\(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
-Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT.
-
-The azimuth is given in degrees as well as the height (between -180 and 180)."
-  (let* ((ut (car (cdr time)))
-         (ec (solar-equatorial-coordinates time for-sunrise-sunset))
-         (st (+ solar-sidereal-time-greenwich-midnight
-                (* ut 1.00273790935)))
-         (ah (- (* st 15) (* 15 (car ec)) (* -1 (calendar-longitude))))
-                       ; hour angle (in degrees)
-         (de (car (cdr ec)))
-         (azimuth (solar-atn2 (- (* (solar-cosine-degrees ah)
-                                   (solar-sin-degrees latitude))
-                                (* (solar-tangent-degrees de)
-                                   (solar-cosine-degrees latitude)))
-                              (solar-sin-degrees ah)))
-         (height (solar-arcsin 
-                  (+ (* (solar-sin-degrees latitude) (solar-sin-degrees de))
-                     (* (solar-cosine-degrees latitude)
-                        (solar-cosine-degrees de)
-                        (solar-cosine-degrees ah))))))
-    (if (> height 180) (setq height (- height 360)))
-    (list azimuth height)))
-
-(defun solar-equatorial-coordinates (time for-sunrise-sunset)
-  "Right ascension (in hours) and declination (in degrees) of the sun at TIME.
-
-TIME is a pair with the first component being the number of Julian centuries
-elapsed at 0 Universal Time, and the second component being the universal
-time.  For instance, the pair corresponding to November 28, 1995 at 16 UT is
-\(-0.040945 16), -0.040945 being the number of julian centuries elapsed between
-Jan 1, 2000 at 12 UT and November 28, 1995 at 0 UT."
-   (let* ((tm (solar-ephemeris-time time)) 
-          (ec (solar-ecliptic-coordinates tm for-sunrise-sunset)))
-     (list (solar-right-ascension (car ec) (car (cdr ec)))
-           (solar-declination (car ec) (car (cdr ec))))))
-
-(defun solar-ecliptic-coordinates (time for-sunrise-sunset)
-  "Apparent longitude of the sun, ecliptic inclination, (both in degrees)
-equation of time (in hours) and nutation in longitude (in seconds)
-at moment `time', expressed in julian centuries of Ephemeris Time
-since January 1st, 2000, at 12 ET."
-  (let* ((l (+ 280.46645
-               (* 36000.76983 time)
-               (* 0.0003032 time time))) ; sun mean longitude 
-         (ml (+ 218.3165
-                (* 481267.8813 time))) ; moon mean longitude 
-         (m (+ 357.52910
-               (* 35999.05030 time)
-               (* -0.0001559 time time)
-               (* -0.00000048 time time time))) ; sun mean anomaly 
-         (i (+ 23.43929111 (* -0.013004167 time)
-               (* -0.00000016389 time time)
-               (* 0.0000005036 time time time))); mean inclination 
-         (c (+ (* (+ 1.914600
-                     (* -0.004817 time)
-                     (* -0.000014 time time))
-                  (solar-sin-degrees m))
-               (* (+ 0.019993 (* -0.000101 time))
-                  (solar-sin-degrees (* 2 m)))
-               (* 0.000290
-                  (solar-sin-degrees (* 3 m))))) ; center equation 
-         (L (+ l c)) ; total longitude 
-         (omega (+ 125.04
-                   (* -1934.136 time))) ; longitude of moon's ascending node
-                                        ; on the ecliptic
-         (nut (if (not for-sunrise-sunset)
-                 (+ (* -17.20 (solar-sin-degrees omega))
-                 (* -1.32 (solar-sin-degrees (* 2 l)))
-                 (* -0.23 (solar-sin-degrees (* 2 ml)))
-                 (* 0.21 (solar-sin-degrees (* 2 omega))))
-               nil))
-                  ; nut = nutation in longitude, measured in seconds of angle.
-         (ecc (if (not for-sunrise-sunset)
-                 (+ 0.016708617
-                 (* -0.000042037 time)
-                 (* -0.0000001236 time time)) ; eccentricity of earth's orbit
-               nil))
-         (app (+ L
-                 -0.00569
-                 (* -0.00478
-                    (solar-sin-degrees omega)))) ; apparent longitude of sun
-         (y (if (not for-sunrise-sunset)
-                 (* (solar-tangent-degrees (/ i 2)) 
-                  (solar-tangent-degrees (/ i 2)))
-                nil))
-         (time-eq (if (not for-sunrise-sunset)
-                    (/ (* 12 (+ (* y (solar-sin-degrees (* 2 l)))
-                     (* -2 ecc (solar-sin-degrees m))
-                     (* 4 ecc y (solar-sin-degrees m) 
-                                (solar-cosine-degrees (* 2 l)))
-                     (* -0.5 y y  (solar-sin-degrees (* 4 l)))
-                     (* -1.25 ecc ecc (solar-sin-degrees (* 2 m)))))
-                      3.1415926535)
-                    nil)))
-                  ; equation of time, in hours
-    (list app i time-eq nut)))
-
-(defun solar-longitude (d)
-  "Longitude of sun on astronomical (Julian) day number D.
-Accurary is about 0.0006 degree (about 365.25*24*60*0.0006/360 = 1 minutes).
-
-The values of calendar-daylight-savings-starts,
-calendar-daylight-savings-starts-time, calendar-daylight-savings-ends,
-calendar-daylight-savings-ends-time, calendar-daylight-time-offset, and
-calendar-time-zone are used to interpret local time."
-  (let* ((a-d (calendar-absolute-from-astro d))
-         ;; get Universal Time
-         (date (calendar-astro-from-absolute
-                (- a-d
-                   (if (dst-in-effect a-d)
-                       (/ calendar-daylight-time-offset 24.0 60.0) 0)
-                   (/ calendar-time-zone 60.0 24.0))))
-         ;; get Ephemeris Time
-         (date (+ date (solar-ephemeris-correction
-                        (extract-calendar-year
-                         (calendar-gregorian-from-absolute
-                          (floor
-                           (calendar-absolute-from-astro
-                            date)))))))
-         (U (/ (- date 2451545) 3652500))
-         (longitude
-          (+ 4.9353929
-             (* 62833.1961680 U)
-             (* 0.0000001
-                (apply '+
-                       (mapcar '(lambda (x)
-                                  (* (car x)
-                                     (sin (mod
-                                           (+ (car (cdr x))
-                                              (* (car (cdr (cdr x))) U))
-                                           (* 2 pi)))))
-                               solar-data-list)))))
-         (aberration
-          (* 0.0000001 (- (* 17 (cos (+ 3.10 (* 62830.14 U)))) 973)))
-         (A1 (mod (+ 2.18 (* U (+ -3375.70 (* 0.36 U)))) (* 2 pi)))
-         (A2 (mod (+ 3.51 (* U (+ 125666.39 (* 0.10 U)))) (* 2 pi)))
-         (nutation (* -0.0000001 (+ (* 834 (sin A1)) (* 64 (sin A2))))))
-    (mod (radians-to-degrees (+ longitude aberration nutation)) 360.0)))
-
-(defconst solar-data-list
-  '((403406 4.721964 1.621043)
-    (195207 5.937458 62830.348067)
-    (119433 1.115589 62830.821524)
-    (112392 5.781616 62829.634302)
-    (3891 5.5474 125660.5691)
-    (2819 1.5120 125660.984)
-    (1721 4.1897 62832.4766)
-    (0 1.163 0.813)
-    (660 5.415 125659.31)
-    (350 4.315 57533.85)
-    (334 4.553 -33.931)
-    (314 5.198 777137.715)
-    (268 5.989 78604.191)
-    (242 2.911 5.412)
-    (234 1.423 39302.098)
-    (158 0.061 -34.861)
-    (132 2.317 115067.698)
-    (129 3.193 15774.337)
-    (114 2.828 5296.670)
-    (99 0.52 58849.27)
-    (93 4.65 5296.11)
-    (86 4.35 -3980.70)
-    (78 2.75 52237.69)
-    (72 4.50 55076.47)
-    (68 3.23 261.08)
-    (64 1.22 15773.85)
-    (46 0.14 188491.03)
-    (38 3.44 -7756.55)
-    (37 4.37 264.89)
-    (32 1.14 117906.27)
-    (29 2.84 55075.75)
-    (28 5.96 -7961.39)
-    (27 5.09 188489.81)
-    (27 1.72 2132.19)
-    (25 2.56 109771.03)
-    (24 1.92 54868.56)
-    (21 0.09 25443.93)
-    (21 5.98 -55731.43)
-    (20 4.03 60697.74)
-    (18 4.47 2132.79)
-    (17 0.79 109771.63)
-    (14 4.24 -7752.82)
-    (13 2.01 188491.91)
-    (13 2.65 207.81)
-    (13 4.98 29424.63)
-    (12 0.93 -7.99)
-    (10 2.21 46941.14)
-    (10 3.59 -68.29)
-    (10 1.50 21463.25)
-    (10 2.55 157208.40)))
-
-(defun solar-ephemeris-correction (year)
-  "Ephemeris time minus Universal Time during Gregorian year.
-Result is in days.
-
-For the years 1800-1987, the maximum error is 1.9 seconds.
-For the other years, the maximum error is about 30 seconds."
-  (cond ((and (<= 1988 year) (< year 2020))
-         (/ (+ year -2000 67.0) 60.0 60.0 24.0))
-        ((and (<= 1900 year) (< year 1988))
-         (let* ((theta (/ (- (calendar-astro-from-absolute
-                              (calendar-absolute-from-gregorian
-                               (list 7 1 year)))
-                             (calendar-astro-from-absolute
-                              (calendar-absolute-from-gregorian
-                               '(1 1 1900))))
-                          36525.0))
-                (theta2 (* theta theta))
-                (theta3 (* theta2 theta))
-                (theta4 (* theta2 theta2))
-                (theta5 (* theta3 theta2)))
-           (+ -0.00002
-              (* 0.000297 theta)
-              (* 0.025184 theta2)
-              (* -0.181133 theta3)
-              (* 0.553040 theta4)
-              (* -0.861938 theta5)
-              (* 0.677066 theta3 theta3)
-              (* -0.212591 theta4 theta3))))
-        ((and (<= 1800 year) (< year 1900))
-         (let* ((theta (/ (- (calendar-astro-from-absolute
-                              (calendar-absolute-from-gregorian
-                               (list 7 1 year)))
-                             (calendar-astro-from-absolute
-                              (calendar-absolute-from-gregorian
-                               '(1 1 1900))))
-                          36525.0))
-                (theta2 (* theta theta))
-                (theta3 (* theta2 theta))
-                (theta4 (* theta2 theta2))
-                (theta5 (* theta3 theta2)))
-           (+ -0.000009
-              (* 0.003844 theta)
-              (* 0.083563 theta2)
-              (* 0.865736 theta3)
-              (* 4.867575 theta4)
-              (* 15.845535 theta5)
-              (* 31.332267 theta3 theta3)
-              (* 38.291999 theta4 theta3)
-              (* 28.316289 theta4 theta4)
-              (* 11.636204 theta4 theta5)
-              (* 2.043794 theta5 theta5))))
-        ((and (<= 1620 year) (< year 1800))
-         (let ((x (/ (- year 1600) 10.0)))
-           (/ (+ (* 2.19167 x x) (* -40.675 x) 196.58333) 60.0 60.0 24.0)))
-        (t (let* ((tmp (- (calendar-astro-from-absolute
-                           (calendar-absolute-from-gregorian
-                            (list 1 1 year)))
-                          2382148))
-                  (second (- (/ (* tmp tmp) 41048480.0) 15)))
-             (/ second 60.0 60.0 24.0)))))
-
-(defun solar-sidereal-time (t0)
-  "Sidereal time (in hours) in Greenwich.
-
-At T0=Julian centuries of universal time.
-T0 must correspond to 0 hours UT."
-   (let* ((mean-sid-time (+ 6.6973746
-                           (* 2400.051337 t0)
-                           (* 0.0000258622 t0 t0)
-                           (* -0.0000000017222 t0 t0 t0)))
-          (et (solar-ephemeris-time (list t0 0.0)))
-          (nut-i (solar-ecliptic-coordinates et nil))
-          (nut (car (cdr (cdr (cdr nut-i))))) ; nutation
-          (i (car (cdr nut-i)))) ; inclination
-       (mod (+ (mod (+ mean-sid-time 
-                    (/ (/ (* nut (solar-cosine-degrees i)) 15) 3600)) 24.0)
-               24.0)
-            24.0)))
-
-(defun solar-time-equation (date ut)
-  "Equation of time expressed in hours at Gregorian DATE at Universal time UT."
-  (let* ((et (solar-date-to-et date ut))
-         (ec (solar-ecliptic-coordinates et nil)))
-     (car (cdr (cdr ec)))))
-
-(defun solar-date-to-et (date ut)
-  "Ephemeris Time at Gregorian DATE at Universal Time UT (in hours).
-Expressed in julian centuries of Ephemeris Time."
-    (let ((t0 (solar-julian-ut-centuries date)))
-      (solar-ephemeris-time (list t0 ut))))
-
-;;;###autoload
-(defun sunrise-sunset (&optional arg)
-  "Local time of sunrise and sunset for today.  Accurate to a few seconds.
-If called with an optional prefix argument, prompt for date.
-
-If called with an optional double prefix argument, prompt for longitude,
-latitude, time zone, and date, and always use standard time.
-
-This function is suitable for execution in a .emacs file."
- (interactive "p")
- (or arg (setq arg 1))
- (if (and (< arg 16)
-          (not (and calendar-latitude calendar-longitude calendar-time-zone)))
-     (solar-setup))
- (let* ((calendar-longitude
-         (if (< arg 16) calendar-longitude
-           (solar-get-number
-            "Enter longitude (decimal fraction; + east, - west): ")))
-        (calendar-latitude
-         (if (< arg 16) calendar-latitude
-           (solar-get-number
-            "Enter latitude (decimal fraction; + north, - south): ")))
-        (calendar-time-zone
-         (if (< arg 16) calendar-time-zone
-           (solar-get-number
-            "Enter difference from Coordinated Universal Time (in minutes): ")))
-        (calendar-location-name
-         (if (< arg 16) calendar-location-name
-           (let ((float-output-format "%.1f"))
-             (format "%s%s, %s%s"
-                     (if (numberp calendar-latitude)
-                         (abs calendar-latitude)
-                       (+ (aref calendar-latitude 0)
-                          (/ (aref calendar-latitude 1) 60.0)))
-                     (if (numberp calendar-latitude)
-                         (if (> calendar-latitude 0) "N" "S")
-                       (if (equal (aref calendar-latitude 2) 'north) "N" "S"))
-                     (if (numberp calendar-longitude)
-                         (abs calendar-longitude)
-                       (+ (aref calendar-longitude 0)
-                          (/ (aref calendar-longitude 1) 60.0)))
-                     (if (numberp calendar-longitude)
-                         (if (> calendar-longitude 0) "E" "W")
-                       (if (equal (aref calendar-longitude 2) 'east)
-                           "E" "W"))))))
-        (calendar-standard-time-zone-name
-         (if (< arg 16) calendar-standard-time-zone-name
-           (cond ((= calendar-time-zone 0) "UTC")
-                 ((< calendar-time-zone 0)
-                     (format "UTC%dmin" calendar-time-zone))
-                 (t  (format "UTC+%dmin" calendar-time-zone)))))
-        (calendar-daylight-savings-starts
-         (if (< arg 16) calendar-daylight-savings-starts))
-        (calendar-daylight-savings-ends
-         (if (< arg 16) calendar-daylight-savings-ends))
-        (date (if (< arg 4) (calendar-current-date) (calendar-read-date)))
-        (date-string (calendar-date-string date t))
-        (time-string (solar-sunrise-sunset-string date))
-        (msg (format "%s: %s" date-string time-string))
-        (one-window (one-window-p t)))
-   (if (<= (length msg) (frame-width))
-       (message "%s" msg)
-     (with-output-to-temp-buffer "*temp*"
-       (princ (concat date-string "\n" time-string)))
-     (message "%s"
-	      (substitute-command-keys
-               (if one-window
-                   (if pop-up-windows
-                       "Type \\[delete-other-windows] to remove temp window."
-                     "Type \\[switch-to-buffer] RET to remove temp window.")
-                 "Type \\[switch-to-buffer-other-window] RET to restore old contents of temp window."))))))
- 
-(defun calendar-sunrise-sunset ()
-  "Local time of sunrise and sunset for date under cursor.
-Accurate to a few seconds."
-  (interactive)
-  (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
-      (solar-setup))
-  (let ((date (calendar-cursor-to-date t)))
-    (message "%s: %s"
-             (calendar-date-string date t t)
-             (solar-sunrise-sunset-string date))))
-
-(defun diary-sunrise-sunset ()
-  "Local time of sunrise and sunset as a diary entry.
-Accurate to a few seconds."
-  (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
-      (solar-setup))
-  (solar-sunrise-sunset-string date))
-
-(defun diary-sabbath-candles ()
-  "Local time of candle lighting diary entry--applies if date is a Friday.
-No diary entry if there is no sunset on that date."
-  (if (not (and calendar-latitude calendar-longitude calendar-time-zone))
-      (solar-setup))
-  (if (= (% (calendar-absolute-from-gregorian date) 7) 5);;  Friday
-      (let* ((sunset (car (cdr (solar-sunrise-sunset date))))
-                  (light (if sunset
-                        (cons (- (car sunset) (/ 18.0 60.0)) (cdr sunset)))))
-        (if sunset
-            (format "%s Sabbath candle lighting"
-                    (apply 'solar-time-string light))))))
-
-(defun solar-equinoxes/solstices (k year)
-  "Date of equinox/solstice K for YEAR.
-K=0, spring equinox; K=1, summer solstice; K=2, fall equinox;
-K=3, winter solstice. 
-RESULT is a gregorian local date.
-
-Accurate to less than a minute between 1951 and 2050."
-  (let* ((JDE0 (solar-mean-equinoxes/solstices k year))
-         (T (/ (- JDE0 2451545.0) 36525))
-         (W (- (* 35999.373 T) 2.47))
-         (Delta-lambda (+ 1 (* 0.0334 (solar-cosine-degrees W))
-                            (* 0.0007 (solar-cosine-degrees (* 2 W)))))
-         (S (apply '+ (mapcar '(lambda(x) 
-                                 (* (car x) (solar-cosine-degrees 
-                                             (+ (* (car (cdr (cdr x))) T)
-                                                  (car (cdr x)))))) 
-                              solar-seasons-data)))
-         (JDE (+ JDE0 (/ (* 0.00001 S) Delta-lambda)))
-         (correction (+ 102.3 (* 123.5 T) (* 32.5 T T))) 
-             ; ephemeris time correction
-         (JD (- JDE (/ correction 86400)))
-         (date (calendar-gregorian-from-absolute (floor (- JD 1721424.5))))
-         (time (- (- JD 0.5) (floor (- JD 0.5))))
-         )
-      (list (car date) (+ (car (cdr date)) time
-                          (/ (/ calendar-time-zone 60.0) 24.0))
-            (car (cdr (cdr date))))))
-
-; from Meeus, 1991, page 166
-(defun solar-mean-equinoxes/solstices (k year)
-  "Julian day of mean equinox/solstice K for YEAR.  
-K=0, spring equinox; K=1, summer solstice; K=2, fall equinox; K=3, winter
-solstice.  These formulas are only to be used between 1000 BC and 3000 AD."
-  (let ((y (/ year 1000.0))
-        (z (/ (- year 2000) 1000.0)))
-    (if (< year 1000) ; actually between -1000 and 1000
-             (cond ((equal k 0) (+ 1721139.29189
-                                   (*  365242.13740 y)
-                                   (* 0.06134 y y)
-                                   (* 0.00111 y y y)
-                                   (* -0.00071 y y y y)))
-                   ((equal k 1) (+ 1721233.25401
-                                   (* 365241.72562 y)
-                                   (* -0.05323 y y)
-                                   (* 0.00907 y y y)
-                                   (* 0.00025 y y y y)))
-                   ((equal k 2) (+ 1721325.70455
-                                   (* 365242.49558 y)
-                                   (* -0.11677 y y)
-                                   (* -0.00297 y y y)
-                                   (* 0.00074 y y y y)))
-                   ((equal k 3) (+ 1721414.39987
-                                   (* 365242.88257 y)
-                                   (* -0.00769 y y)
-                                   (* -0.00933 y y y)
-                                   (* -0.00006 y y y y))))
-                      ; actually between 1000 and 3000
-             (cond ((equal k 0) (+ 2451623.80984
-                                   (* 365242.37404  z)
-                                   (* 0.05169 z z)
-                                   (* -0.00411 z z z)
-                                   (* -0.00057 z z z z)))
-                   ((equal k 1) (+ 2451716.56767
-                                   (* 365241.62603 z)
-                                   (* 0.00325 z z)
-                                   (* 0.00888 z z z)
-                                   (* -0.00030 z z z z)))
-                   ((equal k 2) (+ 2451810.21715
-                                   (* 365242.01767 z)
-                                   (* -0.11575 z z)
-                                   (* 0.00337 z z z)
-                                   (* 0.00078 z z z z)))
-                   ((equal k 3) (+ 2451900.05952
-                                   (* 365242.74049 z)
-                                   (* -0.06223 z z)
-                                   (* -0.00823 z z z)
-                                   (* 0.00032 z z z z)))))))
-
-; from Meeus, 1991, page 167
-(defconst solar-seasons-data
-  '((485 324.96 1934.136)
-    (203 337.23 32964.467)
-    (199 342.08 20.186)
-    (182 27.85 445267.112)
-    (156 73.14 45036.886)
-    (136 171.52 22518.443)
-    (77 222.54 65928.934)
-    (74 296.72 3034.906)
-    (70 243.58 9037.513)
-    (58 119.81 33718.147)
-    (52 297.17 150.678)
-    (50 21.02 2281.226)
-    (45 247.54 29929.562)
-    (44 325.15 31555.956)
-    (29 60.93 4443.417)
-    (18 155.12 67555.328)
-    (17 288.79 4562.452)
-    (16 198.04 62894.029)
-    (14 199.76 31436.921)
-    (12 95.39 14577.848)
-    (12 287.11 31931.756)
-    (12 320.81 34777.259)
-    (9 227.73 1222.114)
-    (8 15.45 16859.074)))
-
-;;;###autoload
-(defun solar-equinoxes-solstices ()
-  "*local* date and time of equinoxes and solstices, if visible in the calendar window.
-Requires floating point."
-  (let ((m displayed-month)
-        (y displayed-year))
-    (increment-calendar-month m y (cond ((= 1 (% m 3)) -1)
-					((= 2 (% m 3))  1)
-					(t              0)))
-    (let* ((calendar-standard-time-zone-name
-            (if calendar-time-zone calendar-standard-time-zone-name "UTC"))
-           (calendar-daylight-savings-starts
-            (if calendar-time-zone calendar-daylight-savings-starts))
-           (calendar-daylight-savings-ends
-            (if calendar-time-zone calendar-daylight-savings-ends))
-           (calendar-time-zone (if calendar-time-zone calendar-time-zone 0))
-           (k (1- (/ m 3)))
-           (d0 (solar-equinoxes/solstices k y)) 
-           (d1 (list (car d0) (floor (car (cdr d0))) (car (cdr (cdr d0)))))
-           (h0 (* 24 (- (car (cdr d0)) (floor (car (cdr d0))))))
-           (adj (dst-adjust-time d1 h0))
-           (d (list (car d1) (+ (car (cdr d1))  
-                  (/ (car (cdr adj)) 24.0))
-                    (car (cdr (cdr d1)))))
-           ; The following is nearly as accurate, but not quite:
-	   ;(d0 (solar-date-next-longitude
-           ;    (calendar-astro-from-absolute
-           ;     (calendar-absolute-from-gregorian
-           ;      (list (+ 3 (* k 3)) 15 y)))
-           ;    90))
-           ;(abs-day (calendar-absolute-from-astro d)))
-           (abs-day (calendar-absolute-from-gregorian d)))
-      (list
-       (list (calendar-gregorian-from-absolute (floor abs-day))
-             (format "%s %s"
-                     (nth k (if (and calendar-latitude
-                                     (< (calendar-latitude) 0))
-                                solar-s-hemi-seasons
-                              solar-n-hemi-seasons))
-                     (solar-time-string
-                      (* 24 (- abs-day (floor abs-day)))
-                      (if (dst-in-effect abs-day)
-                          calendar-daylight-time-zone-name
-                        calendar-standard-time-zone-name))))))))
-
-
-(provide 'solar)
-
-;;; solar.el ends here
diff --git a/lisp/case-table.el b/lisp/case-table.el
deleted file mode 100644
index c47359b24bb..00000000000
--- a/lisp/case-table.el
+++ /dev/null
@@ -1,121 +0,0 @@
-;;; case-table.el --- code to extend the character set and support case tables.
-
-;; Copyright (C) 1988, 1994 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; 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:
-
-;; Written by:
-;; TN/ETX/TX/UMG Howard Gayle        UUCP : seismo!enea!erix!howard
-;; Telefonaktiebolaget L M Ericsson  Phone: +46 8 719 55 65
-;; Ericsson Telecom     	     Telex: 14910 ERIC S
-;; S-126 25 Stockholm                FAX  : +46 8 719 64 82
-;; Sweden
-
-;;; Code:
-
-;;;###autoload
-(defun describe-buffer-case-table ()
-  "Describe the case table of the current buffer."
-  (interactive)
-  (let ((description (make-char-table 'case-table)))
-    (map-char-table
-     (function (lambda (key value)
-		 (set-char-table-range
-		  description key
-		  (cond ((null key)
-			 "case-invariant")
-			((/= key (downcase key))
-			 (concat "uppercase, matches "
-				 (char-to-string (downcase key))))
-			((/= key (upcase key))
-			 (concat "lowercase, matches "
-				 (char-to-string (upcase key))))
-			(t "case-invariant")))))
-     (current-case-table))
-    (save-excursion
-     (with-output-to-temp-buffer "*Help*"
-       (set-buffer standard-output)
-       (describe-vector description)
-       (help-mode)))))
-
-;;;###autoload
-(defun copy-case-table (case-table)
-  (let ((copy (copy-sequence case-table)))
-    ;; Clear out the extra slots so that they will be
-    ;; recomputed from the main (downcase) table.
-    (set-char-table-extra-slot copy 0 nil)
-    (set-char-table-extra-slot copy 1 nil)
-    (set-char-table-extra-slot copy 2 nil)
-    copy))
-    
-;;;###autoload
-(defun set-case-syntax-delims (l r table)
-  "Make characters L and R a matching pair of non-case-converting delimiters.
-This sets the entries for L and R in TABLE, which is a string
-that will be used as the downcase part of a case table.
-It also modifies `standard-syntax-table' to
-indicate left and right delimiters."
-  (aset table l l)
-  (aset table r r)
-  ;; Clear out the extra slots so that they will be
-  ;; recomputed from the main (downcase) table.
-  (set-char-table-extra-slot table 0 nil)
-  (set-char-table-extra-slot table 1 nil)
-  (set-char-table-extra-slot table 2 nil)
-  (modify-syntax-entry l (concat "(" (char-to-string r) "  ")
-		       (standard-syntax-table))
-  (modify-syntax-entry r (concat ")" (char-to-string l) "  ")
-		       (standard-syntax-table)))
-
-;;;###autoload
-(defun set-case-syntax-pair (uc lc table)
-  "Make characters UC and LC a pair of inter-case-converting letters.
-This sets the entries for characters UC and LC in TABLE, which is a string
-that will be used as the downcase part of a case table.
-It also modifies `standard-syntax-table' to give them the syntax of
-word constituents."
-  (aset table uc lc)
-  (aset table lc lc)
-  (set-char-table-extra-slot table 0 nil)
-  (set-char-table-extra-slot table 1 nil)
-  (set-char-table-extra-slot table 2 nil)
-  (modify-syntax-entry lc "w   " (standard-syntax-table))
-  (modify-syntax-entry uc "w   " (standard-syntax-table)))
-
-;;;###autoload
-(defun set-case-syntax (c syntax table)
-  "Make characters C case-invariant with syntax SYNTAX.
-This sets the entries for character C in TABLE, which is a string
-that will be used as the downcase part of a case table.
-It also modifies `standard-syntax-table'.
-SYNTAX should be \" \", \"w\", \".\" or \"_\"."
-  (aset table c c)
-  (set-char-table-extra-slot table 0 nil)
-  (set-char-table-extra-slot table 1 nil)
-  (set-char-table-extra-slot table 2 nil)
-  (modify-syntax-entry c syntax (standard-syntax-table)))
-
-(provide 'case-table)
-
-;;; case-table.el ends here
diff --git a/lisp/cdl.el b/lisp/cdl.el
deleted file mode 100644
index 2c88ec2d09e..00000000000
--- a/lisp/cdl.el
+++ /dev/null
@@ -1,44 +0,0 @@
-;;; cdl.el --- Common Data Language (CDL) utility functions for Gnu Emacs
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: ATAE@spva.physics.imperial.ac.uk (Ata Etemadi)
-;; Keywords: data
-
-;; 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.
-
-;;; Code:
-
-(defun cdl-get-file (filename)
-  "Run file through ncdump and insert result into buffer after point."
-  (interactive "fCDF file: ")
-  (message "ncdump in progress...")
-  (let ((start (point)))
-    (call-process  "ncdump" nil t nil (expand-file-name filename))
-    (goto-char start))
-  (message "ncdump in progress...done"))
-
-(defun cdl-put-region (filename start end)
-  "Run region through ncgen and write results into a file."
-  (interactive "FNew CDF file: \nr")
-  (message "ncgen in progress...")
-  (call-process-region start end "ncgen"
-		       nil nil nil "-o" (expand-file-name filename))
-  (message "ncgen in progress...done"))
-
-;;; cdl.el ends here.
diff --git a/lisp/chistory.el b/lisp/chistory.el
deleted file mode 100644
index 3685e01db5c..00000000000
--- a/lisp/chistory.el
+++ /dev/null
@@ -1,174 +0,0 @@
-;;; chistory.el --- list command history
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; 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 really has nothing to do with list-command-history per se, but
-;; its a nice alternative to C-x ESC ESC (repeat-complex-command) and
-;; functions as a lister if given no pattern.  It's not important
-;; enough to warrant a file of its own.
-
-;;; Code:
-
-;;;###autoload
-(defun repeat-matching-complex-command (&optional pattern)
-  "Edit and re-evaluate complex command with name matching PATTERN.
-Matching occurrences are displayed, most recent first, until you select
-a form for evaluation.  If PATTERN is empty (or nil), every form in the
-command history is offered.  The form is placed in the minibuffer for
-editing and the result is evaluated."
-  (interactive "sRedo Command (regexp): ")
-  (if pattern
-      (if (string-match "[^ \t]" pattern)
-	  (setq pattern (substring pattern (match-beginning 0)))
-	(setq pattern nil)))
-  (let ((history command-history)
-	(temp)
-	(what))
-    (while (and history (not what))
-      (setq temp (car history))
-      (if (and (or (not pattern) (string-match pattern (symbol-name (car temp))))
-	       (y-or-n-p (format "Redo %S? " temp)))
-	  (setq what (car history))
-	(setq history (cdr history))))
-    (if (not what)
-	(error "Command history exhausted")
-      ;; Try to remove any useless command history element for this command.
-      (if (eq (car (car command-history)) 'repeat-matching-complex-command)
-	  (setq command-history (cdr command-history)))
-      (edit-and-eval-command "Redo: " what))))
-
-(defvar default-command-history-filter-garbage
-  '(command-history-mode
-    list-command-history
-    electric-command-history)
-  "*A list of symbols to be ignored by `default-command-history-filter'.
-It that function is given a list whose car is an element of this list,
-then it will return non-nil (indicating the list should be discarded from
-the history).
-Initially, all commands related to the command history are discarded.")
-
-(defvar list-command-history-filter 'default-command-history-filter
-  "Predicate to test which commands should be excluded from the history listing.
-If non-nil, should be the name of a function of one argument.
-It is passed each element of the command history when
-\\[list-command-history] is called.  If the filter returns non-nil for
-some element, that element is excluded from the history listing.  The
-default filter removes commands associated with the command-history.")
-
-(defun default-command-history-filter (frob)
-  "Filter commands matching `default-command-history-filter-garbage' list
-from the command history."
-  (or (not (consp frob))
-      (memq (car frob) default-command-history-filter-garbage)))
-
-(defvar list-command-history-max 32
-  "*If non-nil, maximum length of the listing produced by `list-command-history'.")
-
-;;;###autoload
-(defun list-command-history ()
-  "List history of commands typed to minibuffer.
-The number of commands listed is controlled by `list-command-history-max'.
-Calls value of `list-command-history-filter' (if non-nil) on each history
-element to judge if that element should be excluded from the list.
-
-The buffer is left in Command History mode."
-  (interactive)
-  (with-output-to-temp-buffer
-      "*Command History*"
-    (let ((history command-history)
-	  (buffer-read-only nil)
-	  (count (or list-command-history-max -1)))
-      (while (and (/= count 0) history)
-	(if (and (boundp 'list-command-history-filter)
-		 list-command-history-filter
-		 (funcall list-command-history-filter (car history)))
-	    nil
-	  (setq count (1- count))
-	  (prin1 (car history))
-	  (terpri))
-	(setq history (cdr history))))
-    (save-excursion
-      (set-buffer "*Command History*")
-      (goto-char (point-min))
-      (if (eobp)
-	  (error "No command history")
-	(Command-history-setup)))))
-
-(defun Command-history-setup (&optional majormode modename keymap)
-  (set-buffer "*Command History*")
-  (use-local-map (or keymap command-history-map))
-  (lisp-mode-variables nil)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (setq buffer-read-only t)
-  (use-local-map (or keymap command-history-map))
-  (setq major-mode (or majormode 'command-history-mode))
-  (setq mode-name (or modename "Command History")))
-
-(defvar command-history-hook nil
-  "If non-nil, its value is called on entry to `command-history-mode'.")
-
-(defvar command-history-map nil)
-(if command-history-map
-    nil
-  (setq command-history-map
-	(nconc (make-sparse-keymap) shared-lisp-mode-map))
-  (suppress-keymap command-history-map)
-  (define-key command-history-map "x" 'command-history-repeat)
-  (define-key command-history-map "\n" 'next-line)
-  (define-key command-history-map "\r" 'next-line)
-  (define-key command-history-map "\177" 'previous-line))
-
-(defun command-history-repeat ()
-  "Repeat the command shown on the current line.
-The buffer for that command is the previous current buffer."
-  (interactive)
-  (save-excursion
-    (eval (prog1
-	      (save-excursion
-		(beginning-of-line)
-		(read (current-buffer)))
-	    (set-buffer
-	     (car (cdr (buffer-list))))))))
-
-;;;###autoload
-(defun command-history-mode ()
-  "Major mode for examining commands from `command-history'.
-The number of commands listed is controlled by `list-command-history-max'.
-The command history is filtered by `list-command-history-filter' if non-nil.
-Use \\<command-history-map>\\[command-history-repeat] to repeat the command on the current line.
-
-Otherwise much like Emacs-Lisp Mode except that there is no self-insertion
-and digits provide prefix arguments.  Tab does not indent.
-\\{command-history-map}
-Calls the value of `command-history-hook' if that is non-nil.
-The Command History listing is recomputed each time this mode is invoked."
-  (interactive)
-  (list-command-history)
-  (pop-to-buffer "*Command History*")
-  (run-hooks 'command-history-hook))
-
-(provide 'chistory)
-
-;;; chistory.el ends here
diff --git a/lisp/cmuscheme.el b/lisp/cmuscheme.el
deleted file mode 100644
index 0dbd7a2cb70..00000000000
--- a/lisp/cmuscheme.el
+++ /dev/null
@@ -1,413 +0,0 @@
-;;; cmuscheme.el --- Scheme process in a buffer. Adapted from tea.el.
-
-;; Copyright (C) 1988, 1994 Free Software Foundation, Inc.
-
-;; Author: Olin Shivers <olin.shivers@cs.cmu.edu>
-;; Maintainer: FSF
-;; Keywords: processes, lisp
-
-;; 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 is a customisation of comint-mode (see comint.el)
-;;
-;; Written by Olin Shivers (olin.shivers@cs.cmu.edu). With bits and pieces
-;; lifted from scheme.el, shell.el, clisp.el, newclisp.el, cobol.el, et al..
-;; 8/88
-;;
-;; Please send me bug reports, bug fixes, and extensions, so that I can
-;; merge them into the master source.
-;;
-;; The changelog is at the end of this file.
-;;
-;; NOTE: MIT Cscheme, when invoked with the -emacs flag, has a special user
-;; interface that communicates process state back to the superior emacs by
-;; outputting special control sequences. The gnumacs package, xscheme.el, has
-;; lots and lots of special purpose code to read these control sequences, and
-;; so is very tightly integrated with the cscheme process. The cscheme
-;; interrupt handler and debugger read single character commands in cbreak
-;; mode; when this happens, xscheme.el switches to special keymaps that bind
-;; the single letter command keys to emacs functions that directly send the
-;; character to the scheme process.  Cmuscheme mode does *not* provide this
-;; functionality. If you are a cscheme user, you may prefer to use the
-;; xscheme.el/cscheme -emacs interaction.
-;; 
-;; Here's a summary of the pros and cons, as I see them.
-;; xscheme: Tightly integrated with inferior cscheme process!  A few commands
-;;	     not in cmuscheme. But. Integration is a bit of a hack.  Input
-;;	     history only keeps the immediately prior input. Bizarre
-;;	     keybindings.
-;; 
-;; cmuscheme: Not tightly integrated with inferior cscheme process.  But.
-;;            Carefully integrated functionality with the entire suite of
-;;            comint-derived CMU process modes. Keybindings reminiscent of
-;;            Zwei and Hemlock. Good input history. A few commands not in
-;;            xscheme.
-;;  
-;; It's a tradeoff. Pay your money; take your choice. If you use a Scheme
-;; that isn't Cscheme, of course, there isn't a choice. Xscheme.el is *very*
-;; Cscheme-specific; you must use cmuscheme.el.  Interested parties are
-;; invited to port xscheme functionality on top of comint mode...
-
-;;; Code:
-
-(require 'scheme)
-(require 'comint)
-
-;;; INFERIOR SCHEME MODE STUFF
-;;;============================================================================
-
-(defvar inferior-scheme-mode-hook nil
-  "*Hook for customising inferior-scheme mode.")
-(defvar inferior-scheme-mode-map nil)
-
-(cond ((not inferior-scheme-mode-map)
-       (setq inferior-scheme-mode-map
-	     (copy-keymap comint-mode-map))
-       (define-key inferior-scheme-mode-map "\M-\C-x" ;gnu convention
-	           'scheme-send-definition)
-       (define-key inferior-scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp)
-       (define-key inferior-scheme-mode-map "\C-c\C-l" 'scheme-load-file)
-       (define-key inferior-scheme-mode-map "\C-c\C-k" 'scheme-compile-file)
-       (scheme-mode-commands inferior-scheme-mode-map))) 
-
-;; Install the process communication commands in the scheme-mode keymap.
-(define-key scheme-mode-map "\M-\C-x" 'scheme-send-definition);gnu convention
-(define-key scheme-mode-map "\C-x\C-e" 'scheme-send-last-sexp);gnu convention
-(define-key scheme-mode-map "\C-c\C-e" 'scheme-send-definition)
-(define-key scheme-mode-map "\C-c\M-e" 'scheme-send-definition-and-go)
-(define-key scheme-mode-map "\C-c\C-r" 'scheme-send-region)
-(define-key scheme-mode-map "\C-c\M-r" 'scheme-send-region-and-go)
-(define-key scheme-mode-map "\C-c\M-c" 'scheme-compile-definition)
-(define-key scheme-mode-map "\C-c\C-c" 'scheme-compile-definition-and-go)
-(define-key scheme-mode-map "\C-c\C-z" 'switch-to-scheme)
-(define-key scheme-mode-map "\C-c\C-l" 'scheme-load-file)
-(define-key scheme-mode-map "\C-c\C-k" 'scheme-compile-file) ;k for "kompile"
-
-(defvar scheme-buffer)
-
-(defun inferior-scheme-mode ()
-  "Major mode for interacting with an inferior Scheme process.
-
-The following commands are available:
-\\{inferior-scheme-mode-map}
-
-A Scheme process can be fired up with M-x run-scheme.
-
-Customisation: Entry to this mode runs the hooks on comint-mode-hook and
-inferior-scheme-mode-hook (in that order).
-
-You can send text to the inferior Scheme process from other buffers containing
-Scheme source.  
-    switch-to-scheme switches the current buffer to the Scheme process buffer.
-    scheme-send-definition sends the current definition to the Scheme process.
-    scheme-compile-definition compiles the current definition.
-    scheme-send-region sends the current region to the Scheme process.
-    scheme-compile-region compiles the current region.
-
-    scheme-send-definition-and-go, scheme-compile-definition-and-go,
-        scheme-send-region-and-go, and scheme-compile-region-and-go
-        switch to the Scheme process buffer after sending their text.
-For information on running multiple processes in multiple buffers, see
-documentation for variable scheme-buffer.
-
-Commands:
-Return after the end of the process' output sends the text from the 
-    end of process to point.
-Return before the end of the process' output copies the sexp ending at point
-    to the end of the process' output, and sends it.
-Delete converts tabs to spaces as it moves back.
-Tab indents for Scheme; with argument, shifts rest
-    of expression rigidly with the current line.
-C-M-q does Tab on each line starting within following expression.
-Paragraphs are separated only by blank lines.  Semicolons start comments.
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it."
-  (interactive)
-  (comint-mode)
-  ;; Customise in inferior-scheme-mode-hook
-  (setq comint-prompt-regexp "^[^>\n]*>+ *") ; OK for cscheme, oaklisp, T,...
-  (scheme-mode-variables)
-  (setq major-mode 'inferior-scheme-mode)
-  (setq mode-name "Inferior Scheme")
-  (setq mode-line-process '(":%s"))
-  (use-local-map inferior-scheme-mode-map)
-  (setq comint-input-filter (function scheme-input-filter))
-  (setq comint-get-old-input (function scheme-get-old-input))
-  (run-hooks 'inferior-scheme-mode-hook))
-
-(defvar inferior-scheme-filter-regexp "\\`\\s *\\S ?\\S ?\\s *\\'"
-  "*Input matching this regexp are not saved on the history list.
-Defaults to a regexp ignoring all inputs of 0, 1, or 2 letters.")
-
-(defun scheme-input-filter (str)
-  "Don't save anything matching inferior-scheme-filter-regexp"
-  (not (string-match inferior-scheme-filter-regexp str)))
-
-(defun scheme-get-old-input ()
-  "Snarf the sexp ending at point"
-  (save-excursion
-    (let ((end (point)))
-      (backward-sexp)
-      (buffer-substring (point) end))))
-
-(defun scheme-args-to-list (string)
-  (let ((where (string-match "[ \t]" string)))
-    (cond ((null where) (list string))
-	  ((not (= where 0))
-	   (cons (substring string 0 where)
-		 (scheme-args-to-list (substring string (+ 1 where)
-						 (length string)))))
-	  (t (let ((pos (string-match "[^ \t]" string)))
-	       (if (null pos)
-		   nil
-		 (scheme-args-to-list (substring string pos
-						 (length string)))))))))
-
-(defvar scheme-program-name "scheme"
-  "*Program invoked by the run-scheme command")
-
-;;;###autoload
-(defun run-scheme (cmd)
-  "Run an inferior Scheme process, input and output via buffer *scheme*.
-If there is a process already running in `*scheme*', switch to that buffer.
-With argument, allows you to edit the command line (default is value
-of `scheme-program-name').  Runs the hooks `inferior-scheme-mode-hook'
-\(after the `comint-mode-hook' is run).
-\(Type \\[describe-mode] in the process buffer for a list of commands.)"
-
-  (interactive (list (if current-prefix-arg
-			 (read-string "Run Scheme: " scheme-program-name)
-			 scheme-program-name)))
-  (if (not (comint-check-proc "*scheme*"))
-      (let ((cmdlist (scheme-args-to-list cmd)))
-	(set-buffer (apply 'make-comint "scheme" (car cmdlist)
-			   nil (cdr cmdlist)))
-	(inferior-scheme-mode)))
-  (setq scheme-program-name cmd)
-  (setq scheme-buffer "*scheme*")
-  (pop-to-buffer "*scheme*"))
-;;;###autoload (add-hook 'same-window-buffer-names "*scheme*")
-
-(defun scheme-send-region (start end)
-  "Send the current region to the inferior Scheme process."
-  (interactive "r")
-  (comint-send-region (scheme-proc) start end)
-  (comint-send-string (scheme-proc) "\n"))
-
-(defun scheme-send-definition ()
-  "Send the current definition to the inferior Scheme process."
-  (interactive)
-  (save-excursion
-   (end-of-defun)
-   (let ((end (point)))
-     (beginning-of-defun)
-     (scheme-send-region (point) end))))
-
-(defun scheme-send-last-sexp ()
-  "Send the previous sexp to the inferior Scheme process."
-  (interactive)
-  (scheme-send-region (save-excursion (backward-sexp) (point)) (point)))
-
-(defvar scheme-compile-exp-command "(compile '%s)"
-  "*Template for issuing commands to compile arbitrary Scheme expressions.")
-
-(defun scheme-compile-region (start end)
-  "Compile the current region in the inferior Scheme process.
-\(A BEGIN is wrapped around the region: (BEGIN <region>))"
-  (interactive "r")
-  (comint-send-string (scheme-proc) (format scheme-compile-exp-command
-					    (format "(begin %s)"
-						    (buffer-substring start end))))
-  (comint-send-string (scheme-proc) "\n"))
-
-(defun scheme-compile-definition ()
-  "Compile the current definition in the inferior Scheme process."
-  (interactive)
-  (save-excursion
-   (end-of-defun)
-   (let ((end (point)))
-     (beginning-of-defun)
-     (scheme-compile-region (point) end))))
-
-(defun switch-to-scheme (eob-p)
-  "Switch to the scheme process buffer.
-With argument, positions cursor at end of buffer."
-  (interactive "P")
-  (if (get-buffer scheme-buffer)
-      (pop-to-buffer scheme-buffer)
-      (error "No current process buffer. See variable scheme-buffer."))
-  (cond (eob-p
-	 (push-mark)
-	 (goto-char (point-max)))))
-
-(defun scheme-send-region-and-go (start end)
-  "Send the current region to the inferior Scheme process.
-Then switch to the process buffer."
-  (interactive "r")
-  (scheme-send-region start end)
-  (switch-to-scheme t))
-
-(defun scheme-send-definition-and-go ()
-  "Send the current definition to the inferior Scheme. 
-Then switch to the process buffer."
-  (interactive)
-  (scheme-send-definition)
-  (switch-to-scheme t))
-
-(defun scheme-compile-definition-and-go ()
-  "Compile the current definition in the inferior Scheme. 
-Then switch to the process buffer."
-  (interactive)
-  (scheme-compile-definition)
-  (switch-to-scheme t))
-
-(defun scheme-compile-region-and-go (start end)
-  "Compile the current region in the inferior Scheme. 
-Then switch to the process buffer."
-  (interactive "r")
-  (scheme-compile-region start end)
-  (switch-to-scheme t))
-
-(defvar scheme-source-modes '(scheme-mode)
-  "*Used to determine if a buffer contains Scheme source code.
-If it's loaded into a buffer that is in one of these major modes, it's
-considered a scheme source file by scheme-load-file and scheme-compile-file.
-Used by these commands to determine defaults.")
-
-(defvar scheme-prev-l/c-dir/file nil
-  "Caches the last (directory . file) pair.
-Caches the last pair used in the last scheme-load-file or
-scheme-compile-file command. Used for determining the default in the 
-next one.")
-
-(defun scheme-load-file (file-name)
-  "Load a Scheme file into the inferior Scheme process."
-  (interactive (comint-get-source "Load Scheme file: " scheme-prev-l/c-dir/file
-				  scheme-source-modes t)) ; T because LOAD 
-                                                          ; needs an exact name
-  (comint-check-source file-name) ; Check to see if buffer needs saved.
-  (setq scheme-prev-l/c-dir/file (cons (file-name-directory    file-name)
-				       (file-name-nondirectory file-name)))
-  (comint-send-string (scheme-proc) (concat "(load \""
-					    file-name
-					    "\"\)\n")))
-
-(defun scheme-compile-file (file-name)
-  "Compile a Scheme file in the inferior Scheme process."
-  (interactive (comint-get-source "Compile Scheme file: "
-				  scheme-prev-l/c-dir/file
-				  scheme-source-modes
-				  nil)) ; NIL because COMPILE doesn't
-                                        ; need an exact name.
-  (comint-check-source file-name) ; Check to see if buffer needs saved.
-  (setq scheme-prev-l/c-dir/file (cons (file-name-directory    file-name)
-				       (file-name-nondirectory file-name)))
-  (comint-send-string (scheme-proc) (concat "(compile-file \""
-					    file-name
-					    "\"\)\n")))
-
-
-(defvar scheme-buffer nil "*The current scheme process buffer.
-
-MULTIPLE PROCESS SUPPORT
-===========================================================================
-Cmuscheme.el supports, in a fairly simple fashion, running multiple Scheme
-processes. To run multiple Scheme processes, you start the first up with
-\\[run-scheme]. It will be in a buffer named *scheme*. Rename this buffer
-with \\[rename-buffer]. You may now start up a new process with another
-\\[run-scheme]. It will be in a new buffer, named *scheme*. You can
-switch between the different process buffers with \\[switch-to-buffer].
-
-Commands that send text from source buffers to Scheme processes --
-like scheme-send-definition or scheme-compile-region -- have to choose a
-process to send to, when you have more than one Scheme process around. This
-is determined by the global variable scheme-buffer. Suppose you
-have three inferior Schemes running:
-    Buffer	Process
-    foo		scheme
-    bar		scheme<2>
-    *scheme*    scheme<3>
-If you do a \\[scheme-send-definition-and-go] command on some Scheme source
-code, what process do you send it to?
-
-- If you're in a process buffer (foo, bar, or *scheme*), 
-  you send it to that process.
-- If you're in some other buffer (e.g., a source file), you
-  send it to the process attached to buffer scheme-buffer.
-This process selection is performed by function scheme-proc.
-
-Whenever \\[run-scheme] fires up a new process, it resets scheme-buffer
-to be the new process's buffer. If you only run one process, this will
-do the right thing. If you run multiple processes, you can change
-scheme-buffer to another process buffer with \\[set-variable].
-
-More sophisticated approaches are, of course, possible. If you find yourself
-needing to switch back and forth between multiple processes frequently,
-you may wish to consider ilisp.el, a larger, more sophisticated package
-for running inferior Lisp and Scheme processes. The approach taken here is
-for a minimal, simple implementation. Feel free to extend it.")
-
-(defun scheme-proc ()
-  "Returns the current scheme process. See variable scheme-buffer."
-  (let ((proc (get-buffer-process (if (eq major-mode 'inferior-scheme-mode)
-				      (current-buffer)
-				      scheme-buffer))))
-    (or proc
-	(error "No current process. See variable scheme-buffer"))))
-
-
-;;; Do the user's customisation...
-
-(defvar cmuscheme-load-hook nil
-  "This hook is run when cmuscheme is loaded in.
-This is a good place to put keybindings.")
-	
-(run-hooks 'cmuscheme-load-hook)
-
-
-;;; CHANGE LOG
-;;; ===========================================================================
-;;; 8/88 Olin
-;;; Created. 
-;;;
-;;; 2/15/89 Olin
-;;; Removed -emacs flag from process invocation. It's only useful for
-;;; cscheme, and makes cscheme assume it's running under xscheme.el,
-;;; which messes things up royally. A bug.
-;;;
-;;; 5/22/90 Olin
-;;; - Upgraded to use comint-send-string and comint-send-region.
-;;; - run-scheme now offers to let you edit the command line if
-;;;   you invoke it with a prefix-arg. M-x scheme is redundant, and
-;;;   has been removed.
-;;; - Explicit references to process "scheme" have been replaced with
-;;;   (scheme-proc). This allows better handling of multiple process bufs.
-;;; - Added scheme-send-last-sexp, bound to C-x C-e. A gnu convention.
-;;; - Have not added process query facility a la cmulisp.el's lisp-show-arglist
-;;;   and friends, but interested hackers might find a useful application
-;;;   of this facility.
-;;;
-;;; 3/12/90 Olin
-;;; - scheme-load-file and scheme-compile-file no longer switch-to-scheme.
-;;;   Tale suggested this.
-
-(provide 'cmuscheme)
-
-;;; cmuscheme.el ends here
diff --git a/lisp/comint.el b/lisp/comint.el
deleted file mode 100644
index 11f4afc705b..00000000000
--- a/lisp/comint.el
+++ /dev/null
@@ -1,2213 +0,0 @@
-;;; comint.el --- general command interpreter in a window stuff
-
-;; Copyright (C) 1988, 90, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
-
-;; Author: Olin Shivers <shivers@cs.cmu.edu>
-;; Adapted-by: Simon Marshall <simon@gnu.ai.mit.edu>
-;; Keywords: processes
-
-;; 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:
-
-;; Please send me bug reports, bug fixes, and extensions, so that I can
-;; merge them into the master source.
-;;     - Olin Shivers (shivers@cs.cmu.edu)
-;;     - Simon Marshall (simon@gnu.ai.mit.edu)
-
-;; This file defines a general command-interpreter-in-a-buffer package
-;; (comint mode). The idea is that you can build specific process-in-a-buffer
-;; modes on top of comint mode -- e.g., lisp, shell, scheme, T, soar, ....
-;; This way, all these specific packages share a common base functionality, 
-;; and a common set of bindings, which makes them easier to use (and
-;; saves code, implementation time, etc., etc.).
-
-;; Several packages are already defined using comint mode:
-;; - shell.el defines a shell-in-a-buffer mode.
-;; - cmulisp.el defines a simple lisp-in-a-buffer mode.
-;;
-;; - The file cmuscheme.el defines a scheme-in-a-buffer mode.
-;; - The file tea.el tunes scheme and inferior-scheme modes for T.
-;; - The file soar.el tunes lisp and inferior-lisp modes for Soar.
-;; - cmutex.el defines tex and latex modes that invoke tex, latex, bibtex,
-;;   previewers, and printers from within emacs.
-;; - background.el allows csh-like job control inside emacs.
-;; It is pretty easy to make new derived modes for other processes.
-
-;; For documentation on the functionality provided by comint mode, and
-;; the hooks available for customising it, see the comments below.
-;; For further information on the standard derived modes (shell, 
-;; inferior-lisp, inferior-scheme, ...), see the relevant source files.
-
-;; For hints on converting existing process modes (e.g., tex-mode,
-;; background, dbx, gdb, kermit, prolog, telnet) to use comint-mode
-;; instead of shell-mode, see the notes at the end of this file.
-
-
-;; Brief Command Documentation:
-;;============================================================================
-;; Comint Mode Commands: (common to all derived modes, like shell & cmulisp
-;; mode)
-;;
-;; m-p	    comint-previous-input    	    Cycle backwards in input history
-;; m-n	    comint-next-input  	    	    Cycle forwards
-;; m-r     comint-previous-matching-input  Previous input matching a regexp
-;; m-s     comint-next-matching-input      Next input that matches
-;; m-c-l   comint-show-output		    Show last batch of process output
-;; return  comint-send-input
-;; c-d	    comint-delchar-or-maybe-eof     Delete char unless at end of buff
-;; c-c c-a comint-bol                      Beginning of line; skip prompt
-;; c-c c-u comint-kill-input	    	    ^u
-;; c-c c-w backward-kill-word    	    ^w
-;; c-c c-c comint-interrupt-subjob 	    ^c
-;; c-c c-z comint-stop-subjob	    	    ^z
-;; c-c c-\ comint-quit-subjob	    	    ^\
-;; c-c c-o comint-kill-output		    Delete last batch of process output
-;; c-c c-r comint-show-output		    Show last batch of process output
-;; c-c c-l comint-dynamic-list-input-ring  List input history
-;;
-;; Not bound by default in comint-mode (some are in shell mode)
-;; comint-run				Run a program under comint-mode
-;; send-invisible			Read a line w/o echo, and send to proc
-;; comint-dynamic-complete-filename	Complete filename at point.
-;; comint-dynamic-complete-variable    Complete variable name at point.
-;; comint-dynamic-list-filename-completions List completions in help buffer.
-;; comint-replace-by-expanded-filename	Expand and complete filename at point;
-;;					replace with expanded/completed name.
-;; comint-replace-by-expanded-history	Expand history at point;
-;;					replace with expanded name.
-;; comint-magic-space                  Expand history and add (a) space(s).
-;; comint-kill-subjob			No mercy.
-;; comint-show-maximum-output          Show as much output as possible.
-;; comint-continue-subjob		Send CONT signal to buffer's process
-;;					group. Useful if you accidentally
-;;					suspend your process (with C-c C-z).
-
-;; comint-mode-hook is the comint mode hook. Basically for your keybindings.
-
-;;; Code:
-
-(require 'ring)
-
-;; Buffer Local Variables:
-;;============================================================================
-;; Comint mode buffer local variables:
-;;  comint-prompt-regexp    		string	comint-bol uses to match prompt
-;;  comint-delimiter-argument-list	list	For delimiters and arguments
-;;  comint-last-input-start		marker	Handy if inferior always echoes
-;;  comint-last-input-end		marker	For comint-kill-output command
-;;  comint-input-ring-size		integer	For the input history
-;;  comint-input-ring			ring	mechanism
-;;  comint-input-ring-index		number	...
-;;  comint-input-autoexpand		symbol	...
-;;  comint-input-ignoredups		boolean	...
-;;  comint-last-input-match		string	...
-;;  comint-dynamic-complete-functions	hook   For the completion mechanism
-;;  comint-completion-fignore		list	...
-;;  comint-file-name-chars		string	...
-;;  comint-file-name-quote-list		list	...
-;;  comint-get-old-input		function Hooks for specific 
-;;  comint-input-filter-functions	hook	process-in-a-buffer
-;;  comint-output-filter-functions	hook	function modes.
-;;  comint-input-filter			function ...
-;;  comint-input-sender			function ...
-;;  comint-eol-on-send			boolean	...
-;;  comint-process-echoes		boolean	...
-;;  comint-scroll-to-bottom-on-input	symbol	For scroll behavior
-;;  comint-scroll-to-bottom-on-output	symbol	...
-;;  comint-scroll-show-maximum-output	boolean	...	
-;;
-;; Comint mode non-buffer local variables:
-;;  comint-completion-addsuffix		boolean/cons	For file name
-;;  comint-completion-autolist		boolean		completion behavior
-;;  comint-completion-recexact		boolean		...
-
-(defvar comint-prompt-regexp "^"
-  "Regexp to recognise prompts in the inferior process.
-Defaults to \"^\", the null string at BOL.
-
-Good choices:
-  Canonical Lisp: \"^[^> \\n]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp)
-  Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
-  franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
-  kcl: \"^>+ *\"
-  shell: \"^[^#$%>\\n]*[#$%>] *\"
-  T: \"^>+ *\"
-
-This is a good thing to set in mode hooks.")
-
-(defvar comint-delimiter-argument-list ()
-  "List of characters to recognise as separate arguments in input.
-Strings comprising a character in this list will separate the arguments
-surrounding them, and also be regarded as arguments in their own right (unlike
-whitespace).  See `comint-arguments'.
-Defaults to the empty list.
-
-For shells, a good value is (?\\| ?& ?< ?> ?\\( ?\\) ?;).
-
-This is a good thing to set in mode hooks.")
-
-(defvar comint-input-autoexpand nil
-  "*If non-nil, expand input command history references on completion.
-This mirrors the optional behavior of tcsh (its autoexpand and histlit).
-
-If the value is `input', then the expansion is seen on input.
-If the value is `history', then the expansion is only when inserting
-into the buffer's input ring.  See also `comint-magic-space' and
-`comint-dynamic-complete'.
-
-This variable is buffer-local.")
-
-(defvar comint-input-ignoredups nil
-  "*If non-nil, don't add input matching the last on the input ring.
-This mirrors the optional behavior of bash.
-
-This variable is buffer-local.")
-
-(defvar comint-input-ring-file-name nil
-  "*If non-nil, name of the file to read/write input history.
-See also `comint-read-input-ring' and `comint-write-input-ring'.
-
-This variable is buffer-local, and is a good thing to set in mode hooks.")
-
-(defvar comint-scroll-to-bottom-on-input nil
-  "*Controls whether input to interpreter causes window to scroll.
-If nil, then do not scroll.  If t or `all', scroll all windows showing buffer.
-If `this', scroll only the selected window.
-
-The default is nil.
-
-See `comint-preinput-scroll-to-bottom'.  This variable is buffer-local.")
-
-(defvar comint-scroll-to-bottom-on-output nil
-  "*Controls whether interpreter output causes window to scroll.
-If nil, then do not scroll.  If t or `all', scroll all windows showing buffer.
-If `this', scroll only the selected window.
-If `others', scroll only those that are not the selected window.
-
-The default is nil.
-
-See variable `comint-scroll-show-maximum-output' and function
-`comint-postoutput-scroll-to-bottom'.  This variable is buffer-local.")
-
-(defvar comint-scroll-show-maximum-output nil
-  "*Controls how interpreter output causes window to scroll.
-If non-nil, then show the maximum output when the window is scrolled.
-
-See variable `comint-scroll-to-bottom-on-output' and function
-`comint-postoutput-scroll-to-bottom'.  This variable is buffer-local.")
-
-(defvar comint-buffer-maximum-size 1024
-  "*The maximum size in lines for comint buffers.
-Comint buffers are truncated from the top to be no greater than this number, if
-the function `comint-truncate-buffer' is on `comint-output-filter-functions'.")
-
-(defvar comint-input-ring-size 32
-  "Size of input history ring.")
-
-(defvar comint-process-echoes nil
-  "*If non-nil, assume that the subprocess echoes any input.
-If so, delete one copy of the input so that only one copy eventually
-appears in the buffer.
-
-This variable is buffer-local.")
-
-(defvar comint-password-prompt-regexp
-  "\\(\\([Oo]ld \\|[Nn]ew \\|'s \\|^\\)[Pp]assword\\|pass phrase\\):\\s *\\'"
-  "*Regexp matching prompts for passwords in the inferior process.
-This is used by `comint-watch-for-password-prompt'.")
-
-;; Here are the per-interpreter hooks.
-(defvar comint-get-old-input (function comint-get-old-input-default)
-  "Function that returns old text in comint mode.
-This function is called when return is typed while the point is in old text.
-It returns the text to be submitted as process input.  The default is
-`comint-get-old-input-default', which grabs the current line, and strips off
-leading text matching `comint-prompt-regexp'.")
-
-(defvar comint-dynamic-complete-functions
-  '(comint-replace-by-expanded-history comint-dynamic-complete-filename)
-  "List of functions called to perform completion.
-Functions should return non-nil if completion was performed.
-See also `comint-dynamic-complete'.
-
-This is a good thing to set in mode hooks.")
-
-(defvar comint-input-filter
-  (function (lambda (str) (not (string-match "\\`\\s *\\'" str))))
-  "Predicate for filtering additions to input history.
-Takes one argument, the input.  If non-nil, the input may be saved on the input
-history list.  Default is to save anything that isn't all whitespace.")
-
-(defvar comint-input-filter-functions '()
-  "Functions to call before input is sent to the process.
-These functions get one argument, a string containing the text to send.
-
-This variable is buffer-local.")
-
-(defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom) 
-  "Functions to call after output is inserted into the buffer.
-One possible function is `comint-postoutput-scroll-to-bottom'.
-These functions get one argument, a string containing the text as originally
-inserted.  Note that this might not be the same as the buffer contents between
-`comint-last-output-start' and the buffer's `process-mark', if other filter
-functions have already modified the buffer.
-
-This variable is buffer-local.")
-
-(defvar comint-input-sender (function comint-simple-send)
-  "Function to actually send to PROCESS the STRING submitted by user.
-Usually this is just `comint-simple-send', but if your mode needs to 
-massage the input string, put a different function here.
-`comint-simple-send' just sends the string plus a newline.
-This is called from the user command `comint-send-input'.")
-
-(defvar comint-eol-on-send t
-  "*Non-nil means go to the end of the line before sending input.
-See `comint-send-input'.")
-
-(defvar comint-mode-hook '()
-  "Called upon entry into comint-mode
-This is run before the process is cranked up.")
-
-(defvar comint-exec-hook '()
-  "Called each time a process is exec'd by `comint-exec'.
-This is called after the process is cranked up.  It is useful for things that
-must be done each time a process is executed in a comint mode buffer (e.g.,
-`(process-kill-without-query)').  In contrast, the `comint-mode-hook' is only
-executed once when the buffer is created.")
-
-(defvar comint-mode-map nil)
-
-(defvar comint-ptyp t
-  "Non-nil if communications via pty; false if by pipe.  Buffer local.
-This is to work around a bug in Emacs process signaling.")
-
-(defvar comint-input-ring nil)
-(defvar comint-last-input-start)
-(defvar comint-last-input-end)
-(defvar comint-last-output-start)
-(defvar comint-input-ring-index nil
-  "Index of last matched history element.")
-(defvar comint-matching-input-from-input-string ""
-  "Input previously used to match input history.")
-
-(put 'comint-replace-by-expanded-history 'menu-enable 'comint-input-autoexpand)
-(put 'comint-input-ring 'permanent-local t)
-(put 'comint-input-ring-index 'permanent-local t)
-(put 'comint-input-autoexpand 'permanent-local t)
-(put 'comint-input-filter-functions 'permanent-local t)
-(put 'comint-output-filter-functions 'permanent-local t)
-(put 'comint-scroll-to-bottom-on-input 'permanent-local t)
-(put 'comint-scroll-to-bottom-on-output 'permanent-local t)
-(put 'comint-scroll-show-maximum-output 'permanent-local t)
-(put 'comint-ptyp 'permanent-local t)
-
-(defun comint-mode ()
-  "Major mode for interacting with an inferior interpreter.
-Interpreter name is same as buffer name, sans the asterisks.
-Return at end of buffer sends line as input.
-Return not at end copies rest of line to end and sends it.
-Setting variable `comint-eol-on-send' means jump to the end of the line
-before submitting new input.
-
-This mode is customised to create major modes such as Inferior Lisp
-mode, Shell mode, etc.  This can be done by setting the hooks
-`comint-input-filter-functions', `comint-input-filter', `comint-input-sender'
-and `comint-get-old-input' to appropriate functions, and the variable
-`comint-prompt-regexp' to the appropriate regular expression.
-
-An input history is maintained of size `comint-input-ring-size', and
-can be accessed with the commands \\[comint-next-input], \\[comint-previous-input], and \\[comint-dynamic-list-input-ring].
-Input ring history expansion can be achieved with the commands
-\\[comint-replace-by-expanded-history] or \\[comint-magic-space].
-Input ring expansion is controlled by the variable `comint-input-autoexpand',
-and addition is controlled by the variable `comint-input-ignoredups'.
-
-Commands with no default key bindings include `send-invisible',
-`comint-dynamic-complete', `comint-dynamic-list-filename-completions', and 
-`comint-magic-space'.
-
-Input to, and output from, the subprocess can cause the window to scroll to
-the end of the buffer.  See variables `comint-output-filter-functions',
-`comint-scroll-to-bottom-on-input', and `comint-scroll-to-bottom-on-output'.
-
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it.
-
-\\{comint-mode-map}
-
-Entry to this mode runs the hooks on `comint-mode-hook'."
-  (interactive)
-  ;; Do not remove this.  All major modes must do this.
-  (kill-all-local-variables)
-  (setq major-mode 'comint-mode)
-  (setq mode-name "Comint")
-  (setq mode-line-process '(":%s"))
-  (use-local-map comint-mode-map)
-  (make-local-variable 'comint-last-input-start)
-  (setq comint-last-input-start (make-marker))
-  (set-marker comint-last-input-start (point-min))
-  (make-local-variable 'comint-last-input-end)
-  (setq comint-last-input-end (make-marker))
-  (set-marker comint-last-input-end (point-min))
-  (make-local-variable 'comint-last-output-start)
-  (setq comint-last-output-start (make-marker))
-  (make-local-variable 'comint-prompt-regexp)        ; Don't set; default
-  (make-local-variable 'comint-input-ring-size)      ; ...to global val.
-  (make-local-variable 'comint-input-ring)
-  (make-local-variable 'comint-input-ring-file-name)
-  (or (and (boundp 'comint-input-ring) comint-input-ring)
-      (setq comint-input-ring (make-ring comint-input-ring-size)))
-  (make-local-variable 'comint-input-ring-index)
-  (or (and (boundp 'comint-input-ring-index) comint-input-ring-index)
-      (setq comint-input-ring-index nil))
-  (make-local-variable 'comint-matching-input-from-input-string)
-  (make-local-variable 'comint-input-autoexpand)
-  (make-local-variable 'comint-input-ignoredups)
-  (make-local-variable 'comint-delimiter-argument-list)
-  (make-local-hook 'comint-dynamic-complete-functions)
-  (make-local-variable 'comint-completion-fignore)
-  (make-local-variable 'comint-get-old-input)
-  (make-local-hook 'comint-input-filter-functions)
-  (make-local-variable 'comint-input-filter)
-  (make-local-variable 'comint-input-sender)
-  (make-local-variable 'comint-eol-on-send)
-  (make-local-variable 'comint-scroll-to-bottom-on-input)
-  (make-local-variable 'comint-scroll-to-bottom-on-output)
-  (make-local-variable 'comint-scroll-show-maximum-output)
-  (make-local-variable 'pre-command-hook)
-  (add-hook 'pre-command-hook 'comint-preinput-scroll-to-bottom)
-  (make-local-hook 'comint-output-filter-functions)
-  (make-local-variable 'comint-ptyp)
-  (make-local-variable 'comint-exec-hook)
-  (make-local-variable 'comint-process-echoes)
-  (make-local-variable 'comint-file-name-chars)
-  (make-local-variable 'comint-file-name-quote-list)
-  (run-hooks 'comint-mode-hook))
-
-(if comint-mode-map
-    nil
-  ;; Keys:
-  (setq comint-mode-map (make-sparse-keymap))
-  (define-key comint-mode-map "\ep" 'comint-previous-input)
-  (define-key comint-mode-map "\en" 'comint-next-input)
-  (define-key comint-mode-map [C-up] 'comint-previous-input)
-  (define-key comint-mode-map [C-down] 'comint-next-input)
-  (define-key comint-mode-map "\er" 'comint-previous-matching-input)
-  (define-key comint-mode-map "\es" 'comint-next-matching-input)
-  (define-key comint-mode-map [?\A-\M-r] 'comint-previous-matching-input-from-input)
-  (define-key comint-mode-map [?\A-\M-s] 'comint-next-matching-input-from-input)
-  (define-key comint-mode-map "\e\C-l" 'comint-show-output)
-  (define-key comint-mode-map "\C-m" 'comint-send-input)
-  (define-key comint-mode-map "\C-d" 'comint-delchar-or-maybe-eof)
-  (define-key comint-mode-map "\C-c\C-a" 'comint-bol)
-  (define-key comint-mode-map "\C-c\C-u" 'comint-kill-input)
-  (define-key comint-mode-map "\C-c\C-w" 'backward-kill-word)
-  (define-key comint-mode-map "\C-c\C-c" 'comint-interrupt-subjob)
-  (define-key comint-mode-map "\C-c\C-z" 'comint-stop-subjob)
-  (define-key comint-mode-map "\C-c\C-\\" 'comint-quit-subjob)
-  (define-key comint-mode-map "\C-c\C-m" 'comint-copy-old-input)
-  (define-key comint-mode-map "\C-c\C-o" 'comint-kill-output)
-  (define-key comint-mode-map "\C-c\C-r" 'comint-show-output)
-  (define-key comint-mode-map "\C-c\C-e" 'comint-show-maximum-output)
-  (define-key comint-mode-map "\C-c\C-l" 'comint-dynamic-list-input-ring)
-  (define-key comint-mode-map "\C-c\C-n" 'comint-next-prompt)
-  (define-key comint-mode-map "\C-c\C-p" 'comint-previous-prompt)
-  (define-key comint-mode-map "\C-c\C-d" 'comint-send-eof)
-  ;; Menu bars:
-  ;; completion:
-  (define-key comint-mode-map [menu-bar completion] 
-    (cons "Complete" (make-sparse-keymap "Complete")))
-  (define-key comint-mode-map [menu-bar completion complete-expand]
-    '("Expand File Name" . comint-replace-by-expanded-filename))
-  (define-key comint-mode-map [menu-bar completion complete-listing]
-    '("File Completion Listing" . comint-dynamic-list-filename-completions))
-  (define-key comint-mode-map [menu-bar completion complete-file]
-    '("Complete File Name" . comint-dynamic-complete-filename))
-  (define-key comint-mode-map [menu-bar completion complete]
-    '("Complete Before Point" . comint-dynamic-complete))
-  ;; Input history:
-  (define-key comint-mode-map [menu-bar inout] 
-    (cons "In/Out" (make-sparse-keymap "In/Out")))
-  (define-key comint-mode-map [menu-bar inout kill-output]
-    '("Kill Current Output Group" . comint-kill-output))
-  (define-key comint-mode-map [menu-bar inout next-prompt]
-    '("Forward Output Group" . comint-next-prompt))
-  (define-key comint-mode-map [menu-bar inout previous-prompt]
-    '("Backward Output Group" . comint-previous-prompt))
-  (define-key comint-mode-map [menu-bar inout show-maximum-output]
-    '("Show Maximum Output" . comint-show-maximum-output))
-  (define-key comint-mode-map [menu-bar inout show-output]
-    '("Show Current Output Group" . comint-show-output))
-  (define-key comint-mode-map [menu-bar inout kill-input]
-    '("Kill Current Input" . comint-kill-input))
-  (define-key comint-mode-map [menu-bar inout copy-input]
-    '("Copy Old Input" . comint-copy-old-input))
-  (define-key comint-mode-map [menu-bar inout forward-matching-history]
-    '("Forward Matching Input..." . comint-forward-matching-input))
-  (define-key comint-mode-map [menu-bar inout backward-matching-history]
-    '("Backward Matching Input..." . comint-backward-matching-input))
-  (define-key comint-mode-map [menu-bar inout next-matching-history]
-    '("Next Matching Input..." . comint-next-matching-input))
-  (define-key comint-mode-map [menu-bar inout previous-matching-history]
-    '("Previous Matching Input..." . comint-previous-matching-input))
-  (define-key comint-mode-map [menu-bar inout next-matching-history-from-input]
-    '("Next Matching Current Input" . comint-next-matching-input-from-input))
-  (define-key comint-mode-map [menu-bar inout previous-matching-history-from-input]
-    '("Previous Matching Current Input" . comint-previous-matching-input-from-input))
-  (define-key comint-mode-map [menu-bar inout next-history]
-    '("Next Input" . comint-next-input))
-  (define-key comint-mode-map [menu-bar inout previous-history]
-    '("Previous Input" . comint-previous-input))
-  (define-key comint-mode-map [menu-bar inout list-history]
-    '("List Input History" . comint-dynamic-list-input-ring))
-  (define-key comint-mode-map [menu-bar inout expand-history]
-    '("Expand History Before Point" . comint-replace-by-expanded-history))
-  ;; Signals
-  (define-key comint-mode-map [menu-bar signals]
-    (cons "Signals" (make-sparse-keymap "Signals")))
-  (define-key comint-mode-map [menu-bar signals eof]
-    '("EOF" . comint-send-eof))
-  (define-key comint-mode-map [menu-bar signals kill]
-    '("KILL" . comint-kill-subjob))
-  (define-key comint-mode-map [menu-bar signals quit]
-    '("QUIT" . comint-quit-subjob))
-  (define-key comint-mode-map [menu-bar signals cont]
-    '("CONT" . comint-continue-subjob))
-  (define-key comint-mode-map [menu-bar signals stop]
-    '("STOP" . comint-stop-subjob))
-  (define-key comint-mode-map [menu-bar signals break]
-    '("BREAK" . comint-interrupt-subjob))
-  ;; Put them in the menu bar:
-  (setq menu-bar-final-items (append '(completion inout signals)
-				     menu-bar-final-items))
-  )
-
-(defun comint-check-proc (buffer)
-  "Return t if there is a living process associated w/buffer BUFFER.
-Living means the status is `open', `run', or `stop'.
-BUFFER can be either a buffer or the name of one."
-  (let ((proc (get-buffer-process buffer)))
-    (and proc (memq (process-status proc) '(open run stop)))))
-
-;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it ()
-;; for the second argument (program).
-;;;###autoload
-(defun make-comint (name program &optional startfile &rest switches)
-  "Make a comint process NAME in a buffer, running PROGRAM.
-The name of the buffer is made by surrounding NAME with `*'s.
-PROGRAM should be either a string denoting an executable program to create
-via `start-process', or a cons pair of the form (HOST . SERVICE) denoting a TCP
-connection to be opened via `open-network-stream'.  If there is already a
-running process in that buffer, it is not restarted.  Optional third arg
-STARTFILE is the name of a file to send the contents of to the process.
-
-If PROGRAM is a string, any more args are arguments to PROGRAM."
-  (or (fboundp 'start-process)
-      (error "Multi-processing is not supported for this system"))
-  (let ((buffer (get-buffer-create (concat "*" name "*"))))
-    ;; If no process, or nuked process, crank up a new one and put buffer in
-    ;; comint mode.  Otherwise, leave buffer and existing process alone.
-    (cond ((not (comint-check-proc buffer))
-	   (save-excursion
-	     (set-buffer buffer)
-	     (comint-mode)) ; Install local vars, mode, keymap, ...
-	   (comint-exec buffer name program startfile switches)))
-    buffer))
-
-;;;###autoload
-(defun comint-run (program)
-  "Run PROGRAM in a comint buffer and switch to it.
-The buffer name is made by surrounding the file name of PROGRAM with `*'s.
-The file name is used to make a symbol name, such as `comint-sh-hook', and any
-hooks on this symbol are run in the buffer.
-See `make-comint' and `comint-exec'."
-  (interactive "sRun program: ")
-  (let ((name (file-name-nondirectory program)))
-    (switch-to-buffer (make-comint name program))
-    (run-hooks (intern-soft (concat "comint-" name "-hook")))))
-
-(defun comint-exec (buffer name command startfile switches)
-  "Start up a process in buffer BUFFER for comint modes.
-Blasts any old process running in the buffer.  Doesn't set the buffer mode.
-You can use this to cheaply run a series of processes in the same comint
-buffer.  The hook `comint-exec-hook' is run after each exec."
-  (save-excursion
-    (set-buffer buffer)
-    (let ((proc (get-buffer-process buffer)))	; Blast any old process.
-      (if proc (delete-process proc)))
-    ;; Crank up a new process
-    (let ((proc
-	   (if (consp command)
-	       (open-network-stream name buffer (car command) (cdr command))
-	     (comint-exec-1 name buffer command switches))))
-      (set-process-filter proc 'comint-output-filter)
-      (make-local-variable 'comint-ptyp)
-      (setq comint-ptyp process-connection-type) ; T if pty, NIL if pipe.
-      ;; Jump to the end, and set the process mark.
-      (goto-char (point-max))
-      (set-marker (process-mark proc) (point))
-      ;; Feed it the startfile.
-      (cond (startfile
-	     ;;This is guaranteed to wait long enough
-	     ;;but has bad results if the comint does not prompt at all
-	     ;;	     (while (= size (buffer-size))
-	     ;;	       (sleep-for 1))
-	     ;;I hope 1 second is enough!
-	     (sleep-for 1)
-	     (goto-char (point-max))
-	     (insert-file-contents startfile)
-	     (setq startfile (buffer-substring (point) (point-max)))
-	     (delete-region (point) (point-max))
-	     (comint-send-string proc startfile)))
-    (run-hooks 'comint-exec-hook)
-    buffer)))
-
-;; This auxiliary function cranks up the process for comint-exec in
-;; the appropriate environment.
-
-(defun comint-exec-1 (name buffer command switches)
-  (let ((process-environment
-	 (nconc
-	  ;; If using termcap, we specify `emacs' as the terminal type
-	  ;; because that lets us specify a width.
-	  ;; If using terminfo, we specify `dumb' because that is
-	  ;; a defined terminal type.  `emacs' is not a defined terminal type
-	  ;; and there is no way for us to define it here.
-	  ;; Some programs that use terminfo get very confused
-	  ;; if TERM is not a valid terminal type.
-	  (if (and (boundp 'system-uses-terminfo) system-uses-terminfo)
-	      (list "TERM=dumb"
-		    (format "COLUMNS=%d" (frame-width)))
-	    (list "TERM=emacs"
-		  (format "TERMCAP=emacs:co#%d:tc=unknown:" (frame-width))))
-	  (if (getenv "EMACS") nil (list "EMACS=t"))
-	  process-environment))
-	(default-directory
-	  (if (file-directory-p default-directory)
-	      default-directory
-	    "/")))
-    (apply 'start-process name buffer command switches)))
-
-;; Input history processing in a buffer
-;; ===========================================================================
-;; Useful input history functions, courtesy of the Ergo group.
-
-;; Eleven commands:
-;; comint-dynamic-list-input-ring	List history in help buffer.
-;; comint-previous-input		Previous input...
-;; comint-previous-matching-input	...matching a string.
-;; comint-previous-matching-input-from-input ... matching the current input.
-;; comint-next-input			Next input...
-;; comint-next-matching-input		...matching a string.
-;; comint-next-matching-input-from-input     ... matching the current input.
-;; comint-backward-matching-input      Backwards input...
-;; comint-forward-matching-input       ...matching a string.
-;; comint-replace-by-expanded-history	Expand history at point;
-;;					replace with expanded history.
-;; comint-magic-space			Expand history and insert space.
-;;
-;; Three functions:
-;; comint-read-input-ring              Read into comint-input-ring...
-;; comint-write-input-ring             Write to comint-input-ring-file-name.
-;; comint-replace-by-expanded-history-before-point Workhorse function.
-
-(defun comint-read-input-ring (&optional silent)
-  "Sets the buffer's `comint-input-ring' from a history file.
-The name of the file is given by the variable `comint-input-ring-file-name'.
-The history ring is of size `comint-input-ring-size', regardless of file size.
-If `comint-input-ring-file-name' is nil this function does nothing.
-
-If the optional argument SILENT is non-nil, we say nothing about a
-failure to read the history file.
-
-This function is useful for major mode commands and mode hooks.
-
-The structure of the history file should be one input command per line,
-with the most recent command last.
-See also `comint-input-ignoredups' and `comint-write-input-ring'."
-  (cond ((or (null comint-input-ring-file-name)
-	     (equal comint-input-ring-file-name ""))
-	 nil)
-	((not (file-readable-p comint-input-ring-file-name))
-	 (or silent
-	     (message "Cannot read history file %s"
-		      comint-input-ring-file-name)))
-	(t
-	 (let ((history-buf (get-buffer-create " *temp*"))
-	       (file comint-input-ring-file-name)
-	       (count 0)
-	       (ring (make-ring comint-input-ring-size)))
-	   (unwind-protect
-	       (save-excursion
-		 (set-buffer history-buf)
-		 (widen)
-		 (erase-buffer)
-		 (insert-file-contents file)
-		 ;; Save restriction in case file is already visited...
-		 ;; Watch for those date stamps in history files!
-		 (goto-char (point-max))
-		 (while (and (< count comint-input-ring-size)
-			     (re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$"
-						 nil t))
-		   (let ((history (buffer-substring (match-beginning 1)
-						    (match-end 1))))
-		     (if (or (null comint-input-ignoredups)
-			     (ring-empty-p ring)
-			     (not (string-equal (ring-ref ring 0) history)))
-			 (ring-insert-at-beginning ring history)))
-		   (setq count (1+ count))))
-	     (kill-buffer history-buf))
-	   (setq comint-input-ring ring
-		 comint-input-ring-index nil)))))
-
-(defun comint-write-input-ring ()
-  "Writes the buffer's `comint-input-ring' to a history file.
-The name of the file is given by the variable `comint-input-ring-file-name'.
-The original contents of the file are lost if `comint-input-ring' is not empty.
-If `comint-input-ring-file-name' is nil this function does nothing.
-
-Useful within process sentinels.
-
-See also `comint-read-input-ring'."
-  (cond ((or (null comint-input-ring-file-name)
-	     (equal comint-input-ring-file-name "")
-	     (null comint-input-ring) (ring-empty-p comint-input-ring))
-	 nil)
-	((not (file-writable-p comint-input-ring-file-name))
-	 (message "Cannot write history file %s" comint-input-ring-file-name))
-	(t
-	 (let* ((history-buf (get-buffer-create " *Temp Input History*"))
-		(ring comint-input-ring)
-		(file comint-input-ring-file-name)
-		(index (ring-length ring)))
-	   ;; Write it all out into a buffer first.  Much faster, but messier,
-	   ;; than writing it one line at a time.
-	   (save-excursion
-	     (set-buffer history-buf)
-	     (erase-buffer)
-	     (while (> index 0)
-	       (setq index (1- index))
-	       (insert (ring-ref ring index) ?\n))
-	     (write-region (buffer-string) nil file nil 'no-message)
-	     (kill-buffer nil))))))
-
-
-(defun comint-dynamic-list-input-ring ()
-  "List in help buffer the buffer's input history."
-  (interactive)
-  (if (or (not (ring-p comint-input-ring))
-	  (ring-empty-p comint-input-ring))
-      (message "No history")
-    (let ((history nil)
-	  (history-buffer " *Input History*")
-	  (index (1- (ring-length comint-input-ring)))
-	  (conf (current-window-configuration)))
-      ;; We have to build up a list ourselves from the ring vector.
-      (while (>= index 0)
-	(setq history (cons (ring-ref comint-input-ring index) history)
-	      index (1- index)))
-      ;; Change "completion" to "history reference"
-      ;; to make the display accurate.
-      (with-output-to-temp-buffer history-buffer
-	(display-completion-list history)
-	(set-buffer history-buffer)
-	(forward-line 3)
-	(while (search-backward "completion" nil 'move)
-	  (replace-match "history reference")))
-      (sit-for 0)
-      (message "Hit space to flush")
-      (let ((ch (read-event)))
-	(if (eq ch ?\ )
-	    (set-window-configuration conf)
-	  (setq unread-command-events (list ch)))))))
-
-
-(defun comint-regexp-arg (prompt)
-  ;; Return list of regexp and prefix arg using PROMPT.
-  (let* ((minibuffer-history-sexp-flag nil)
-	 ;; Don't clobber this.
-	 (last-command last-command)
-	 (regexp (read-from-minibuffer prompt nil nil nil
-				       'minibuffer-history-search-history)))
-    (list (if (string-equal regexp "")
-	      (setcar minibuffer-history-search-history
-		      (nth 1 minibuffer-history-search-history))
-	    regexp)
-	  (prefix-numeric-value current-prefix-arg))))
-
-(defun comint-search-arg (arg)
-  ;; First make sure there is a ring and that we are after the process mark
-  (cond ((not (comint-after-pmark-p))
-	 (error "Not at command line"))
-	((or (null comint-input-ring)
-	     (ring-empty-p comint-input-ring))
-	 (error "Empty input ring"))
-	((zerop arg)
-	 ;; arg of zero resets search from beginning, and uses arg of 1
-	 (setq comint-input-ring-index nil)
-	 1)
-	(t
-	 arg)))
-
-(defun comint-search-start (arg)
-  ;; Index to start a directional search, starting at comint-input-ring-index
-  (if comint-input-ring-index
-      ;; If a search is running, offset by 1 in direction of arg
-      (mod (+ comint-input-ring-index (if (> arg 0) 1 -1))
-	   (ring-length comint-input-ring))
-    ;; For a new search, start from beginning or end, as appropriate
-    (if (>= arg 0)
-	0				       ; First elt for forward search
-      (1- (ring-length comint-input-ring)))))  ; Last elt for backward search
-
-(defun comint-previous-input-string (arg)
-  "Return the string ARG places along the input ring.
-Moves relative to `comint-input-ring-index'."
-  (ring-ref comint-input-ring (if comint-input-ring-index
-				  (mod (+ arg comint-input-ring-index) 
-				       (ring-length comint-input-ring))
-				arg)))
-
-(defun comint-previous-input (arg)
-  "Cycle backwards through input history."
-  (interactive "*p")
-  (comint-previous-matching-input "." arg))
-
-(defun comint-next-input (arg)
-  "Cycle forwards through input history."
-  (interactive "*p")
-  (comint-previous-input (- arg)))
-
-(defun comint-previous-matching-input-string (regexp arg)
-  "Return the string matching REGEXP ARG places along the input ring.
-Moves relative to `comint-input-ring-index'."
-  (let* ((pos (comint-previous-matching-input-string-position regexp arg)))
-    (if pos (ring-ref comint-input-ring pos))))
-
-(defun comint-previous-matching-input-string-position (regexp arg &optional start)
-  "Return the index matching REGEXP ARG places along the input ring.
-Moves relative to START, or `comint-input-ring-index'."
-  (if (or (not (ring-p comint-input-ring))
-	  (ring-empty-p comint-input-ring))
-      (error "No history"))
-  (let* ((len (ring-length comint-input-ring))
-	 (motion (if (> arg 0) 1 -1))
-	 (n (mod (- (or start (comint-search-start arg)) motion) len))
-	 (tried-each-ring-item nil)
-	 (prev nil))
-    ;; Do the whole search as many times as the argument says.
-    (while (and (/= arg 0) (not tried-each-ring-item))
-      ;; Step once.
-      (setq prev n
-	    n (mod (+ n motion) len))
-      ;; If we haven't reached a match, step some more.
-      (while (and (< n len) (not tried-each-ring-item)
-		  (not (string-match regexp (ring-ref comint-input-ring n))))
-	(setq n (mod (+ n motion) len)
-	      ;; If we have gone all the way around in this search.
-	      tried-each-ring-item (= n prev)))
-      (setq arg (if (> arg 0) (1- arg) (1+ arg))))
-    ;; Now that we know which ring element to use, if we found it, return that.
-    (if (string-match regexp (ring-ref comint-input-ring n))
-	n)))
-
-(defun comint-previous-matching-input (regexp arg)
-  "Search backwards through input history for match for REGEXP.
-\(Previous history elements are earlier commands.)
-With prefix argument N, search for Nth previous match.
-If N is negative, find the next or Nth next match."
-  (interactive (comint-regexp-arg "Previous input matching (regexp): "))
-  (setq arg (comint-search-arg arg))
-  (let ((pos (comint-previous-matching-input-string-position regexp arg)))
-    ;; Has a match been found?
-    (if (null pos)
-	(error "Not found")
-      (setq comint-input-ring-index pos)
-      (message "History item: %d" (1+ pos))
-      (delete-region 
-       ;; Can't use kill-region as it sets this-command
-       (process-mark (get-buffer-process (current-buffer))) (point))
-      (insert (ring-ref comint-input-ring pos)))))
-
-(defun comint-next-matching-input (regexp arg)
-  "Search forwards through input history for match for REGEXP.
-\(Later history elements are more recent commands.)
-With prefix argument N, search for Nth following match.
-If N is negative, find the previous or Nth previous match."
-  (interactive (comint-regexp-arg "Next input matching (regexp): "))
-  (comint-previous-matching-input regexp (- arg)))
-
-(defun comint-previous-matching-input-from-input (arg)
-  "Search backwards through input history for match for current input.
-\(Previous history elements are earlier commands.)
-With prefix argument N, search for Nth previous match.
-If N is negative, search forwards for the -Nth following match."
-  (interactive "p")
-  (if (not (memq last-command '(comint-previous-matching-input-from-input
-				comint-next-matching-input-from-input)))
-      ;; Starting a new search
-      (setq comint-matching-input-from-input-string
-	    (buffer-substring 
-	     (process-mark (get-buffer-process (current-buffer))) 
-	     (point))
-	    comint-input-ring-index nil))
-  (comint-previous-matching-input
-   (concat "^" (regexp-quote comint-matching-input-from-input-string))
-   arg))
-
-(defun comint-next-matching-input-from-input (arg)
-  "Search forwards through input history for match for current input.
-\(Following history elements are more recent commands.)
-With prefix argument N, search for Nth following match.
-If N is negative, search backwards for the -Nth previous match."
-  (interactive "p")
-  (comint-previous-matching-input-from-input (- arg)))
-
-
-(defun comint-replace-by-expanded-history (&optional silent)
-  "Expand input command history references before point.
-Expansion is dependent on the value of `comint-input-autoexpand'.
-
-This function depends on the buffer's idea of the input history, which may not
-match the command interpreter's idea, assuming it has one.
-
-Assumes history syntax is like typical Un*x shells'.  However, since emacs
-cannot know the interpreter's idea of input line numbers, assuming it has one,
-it cannot expand absolute input line number references.
-
-If the optional argument SILENT is non-nil, never complain
-even if history reference seems erroneous.
-
-See `comint-magic-space' and `comint-replace-by-expanded-history-before-point'.
-
-Returns t if successful."
-  (interactive)
-  (if (and comint-input-autoexpand
-	   (string-match "!\\|^\\^" (funcall comint-get-old-input))
-	   (save-excursion (beginning-of-line)
-			   (looking-at comint-prompt-regexp)))
-      ;; Looks like there might be history references in the command.
-      (let ((previous-modified-tick (buffer-modified-tick)))
-	(message "Expanding history references...")
-	(comint-replace-by-expanded-history-before-point silent)
-	(/= previous-modified-tick (buffer-modified-tick)))))
-
-
-(defun comint-replace-by-expanded-history-before-point (silent)
-  "Expand directory stack reference before point.
-See `comint-replace-by-expanded-history'.  Returns t if successful."
-  (save-excursion
-    (let ((toend (- (save-excursion (end-of-line nil) (point)) (point)))
-	  (start (progn (comint-bol nil) (point))))
-      (while (progn
-	       (skip-chars-forward "^!^"
-				   (save-excursion
-				     (end-of-line nil) (- (point) toend)))
-	       (< (point)
-		  (save-excursion
-		    (end-of-line nil) (- (point) toend))))
-	;; This seems a bit complex.  We look for references such as !!, !-num,
-	;; !foo, !?foo, !{bar}, !?{bar}, ^oh, ^my^, ^god^it, ^never^ends^.
-	;; If that wasn't enough, the plings can be suffixed with argument
-	;; range specifiers.
-	;; Argument ranges are complex too, so we hive off the input line,
-	;; referenced with plings, with the range string to `comint-args'.
-	(setq comint-input-ring-index nil)
-	(cond ((or (= (preceding-char) ?\\)
-		   (comint-within-quotes start (point)))
-	       ;; The history is quoted, or we're in quotes.
-	       (goto-char (1+ (point))))
-	      ((looking-at "![0-9]+\\($\\|[^-]\\)")
-	       ;; We cannot know the interpreter's idea of input line numbers.
-	       (goto-char (match-end 0))
-	       (message "Absolute reference cannot be expanded"))
-	      ((looking-at "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?")
-	       ;; Just a number of args from `number' lines backward.
-	       (let ((number (1- (string-to-number
-				  (buffer-substring (match-beginning 1)
-						    (match-end 1))))))
-		 (if (<= number (ring-length comint-input-ring))
-		     (progn
-		       (replace-match
-			(comint-args (comint-previous-input-string number)
-				     (match-beginning 2) (match-end 2))
-			t t)
-		       (setq comint-input-ring-index number)
-		       (message "History item: %d" (1+ number)))
-		   (goto-char (match-end 0))
-		   (message "Relative reference exceeds input history size"))))
-	      ((or (looking-at "!!?:?\\([0-9^$*-]+\\)") (looking-at "!!"))
-	       ;; Just a number of args from the previous input line.
-	       (replace-match
-		(comint-args (comint-previous-input-string 0)
-			     (match-beginning 1) (match-end 1))
-		t t)
-	       (message "History item: previous"))
-	      ((looking-at
-		"!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?")
-	       ;; Most recent input starting with or containing (possibly
-	       ;; protected) string, maybe just a number of args.  Phew.
-	       (let* ((mb1 (match-beginning 1)) (me1 (match-end 1))
-		      (mb2 (match-beginning 2)) (me2 (match-end 2))
-		      (exp (buffer-substring (or mb2 mb1) (or me2 me1)))
-		      (pref (if (save-match-data (looking-at "!\\?")) "" "^"))
-		      (pos (save-match-data
-			     (comint-previous-matching-input-string-position
-			      (concat pref (regexp-quote exp)) 1))))
-		 (if (null pos)
-		     (progn
-		       (goto-char (match-end 0))
-		       (or silent
-			   (progn (message "Not found")
-				  (ding))))
-		   (setq comint-input-ring-index pos)
-		   (replace-match
-		    (comint-args (ring-ref comint-input-ring pos)
-				 (match-beginning 4) (match-end 4))
-		    t t)
-		   (message "History item: %d" (1+ pos)))))
-	      ((looking-at "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?")
-	       ;; Quick substitution on the previous input line.
-	       (let ((old (buffer-substring (match-beginning 1) (match-end 1)))
-		     (new (buffer-substring (match-beginning 2) (match-end 2)))
-		     (pos nil))
-		 (replace-match (comint-previous-input-string 0) t t)
-		 (setq pos (point))
-		 (goto-char (match-beginning 0))
-		 (if (not (search-forward old pos t))
-		     (or silent
-			 (error "Not found"))
-		   (replace-match new t t)
-		   (message "History item: substituted"))))
-	      (t
-	       (goto-char (match-end 0))))))))
-
-
-(defun comint-magic-space (arg)
-  "Expand input history references before point and insert ARG spaces.
-A useful command to bind to SPC.  See `comint-replace-by-expanded-history'."
-  (interactive "p")
-  (comint-replace-by-expanded-history)
-  (self-insert-command arg))
-
-(defun comint-within-quotes (beg end)
-  "Return t if the number of quotes between BEG and END is odd.
-Quotes are single and double."
-  (let ((countsq (comint-how-many-region "\\(^\\|[^\\\\]\\)\'" beg end))
-	(countdq (comint-how-many-region "\\(^\\|[^\\\\]\\)\"" beg end)))
-    (or (= (mod countsq 2) 1) (= (mod countdq 2) 1))))
-
-(defun comint-how-many-region (regexp beg end)
-  "Return number of matches for REGEXP from BEG to END."
-  (let ((count 0))
-    (save-excursion
-      (save-match-data
-	(goto-char beg)
-	(while (re-search-forward regexp end t)
-	  (setq count (1+ count)))))
-    count))
-
-(defun comint-args (string begin end)
-  ;; From STRING, return the args depending on the range specified in the text
-  ;; from BEGIN to END.  If BEGIN is nil, assume all args.  Ignore leading `:'.
-  ;; Range can be x-y, x-, -y, where x/y can be [0-9], *, ^, $.
-  (save-match-data
-    (if (null begin)
-	(comint-arguments string 0 nil)
-      (let* ((range (buffer-substring
-		     (if (eq (char-after begin) ?:) (1+ begin) begin) end))
-	     (nth (cond ((string-match "^[*^]" range) 1)
-			((string-match "^-" range) 0)
-			((string-equal range "$") nil)
-			(t (string-to-number range))))
-	     (mth (cond ((string-match "[-*$]$" range) nil)
-			((string-match "-" range)
-			 (string-to-number (substring range (match-end 0))))
-			(t nth))))
-	(comint-arguments string nth mth)))))
-
-;; Return a list of arguments from ARG.  Break it up at the
-;; delimiters in comint-delimiter-argument-list.  Returned list is backwards.
-(defun comint-delim-arg (arg)
-  (if (null comint-delimiter-argument-list)
-      (list arg)
-    (let ((args nil)
-	  (pos 0)
-	  (len (length arg)))
-      (while (< pos len)
-	(let ((char (aref arg pos))
-	      (start pos))
-	  (if (memq char comint-delimiter-argument-list)
-	      (while (and (< pos len) (eq (aref arg pos) char))
-		(setq pos (1+ pos)))
-	    (while (and (< pos len)
-			(not (memq (aref arg pos)
-				   comint-delimiter-argument-list)))
-	      (setq pos (1+ pos))))
-	  (setq args (cons (substring arg start pos) args))))
-      args)))
-
-(defun comint-arguments (string nth mth)
-  "Return from STRING the NTH to MTH arguments.
-NTH and/or MTH can be nil, which means the last argument.
-Returned arguments are separated by single spaces.
-We assume whitespace separates arguments, except within quotes.
-Also, a run of one or more of a single character
-in `comint-delimiter-argument-list' is a separate argument.
-Argument 0 is the command name."
-  (let ((argpart "[^ \n\t\"'`]+\\|\\(\"[^\"]*\"\\|'[^']*'\\|`[^`]*`\\)")
-	(args ()) (pos 0)
-	(count 0)
-	beg str value quotes)
-    ;; Build a list of all the args until we have as many as we want.
-    (while (and (or (null mth) (<= count mth))
-		(string-match argpart string pos))
-      (if (and beg (= pos (match-beginning 0)))
-	  ;; It's contiguous, part of the same arg.
-	  (setq pos (match-end 0)
-		quotes (or quotes (match-beginning 1)))
-	;; It's a new separate arg.
-	(if beg
-	    ;; Put the previous arg, if there was one, onto ARGS.
-	    (setq str (substring string beg pos)
-		  args (if quotes (cons str args)
-			 (nconc (comint-delim-arg str) args))
-		  count (1+ count)))
-	(setq quotes (match-beginning 1))
-	(setq beg (match-beginning 0))
-	(setq pos (match-end 0))))
-    (if beg
-	(setq str (substring string beg pos)
-	      args (if quotes (cons str args)
-		     (nconc (comint-delim-arg str) args))
-	      count (1+ count)))
-    (let ((n (or nth (1- count)))
-	  (m (if mth (1- (- count mth)) 0)))
-      (mapconcat
-       (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " "))))
-
-;;
-;; Input processing stuff
-;;
-
-(defun comint-send-input () 
-  "Send input to process.
-After the process output mark, sends all text from the process mark to
-point as input to the process.  Before the process output mark, calls value
-of variable `comint-get-old-input' to retrieve old input, copies it to the
-process mark, and sends it.  If variable `comint-process-echoes' is nil,
-a terminal newline is also inserted into the buffer and sent to the process
-\(if it is non-nil, all text from the process mark to point is deleted,
-since it is assumed the remote process will re-echo it).
-
-Any history reference may be expanded depending on the value of the variable
-`comint-input-autoexpand'.  The list of function names contained in the value
-of `comint-input-filter-functions' is called on the input before sending it.
-The input is entered into the input history ring, if the value of variable
-`comint-input-filter' returns non-nil when called on the input.
-
-If variable `comint-eol-on-send' is non-nil, then point is moved to the
-end of line before sending the input.
-
-The values of `comint-get-old-input', `comint-input-filter-functions', and
-`comint-input-filter' are chosen according to the command interpreter running
-in the buffer.  E.g.,
-
-If the interpreter is the csh,
-    comint-get-old-input is the default: take the current line, discard any
-        initial string matching regexp comint-prompt-regexp.
-    comint-input-filter-functions monitors input for \"cd\", \"pushd\", and
-        \"popd\" commands. When it sees one, it cd's the buffer.
-    comint-input-filter is the default: returns t if the input isn't all white
-	space.
-
-If the comint is Lucid Common Lisp, 
-    comint-get-old-input snarfs the sexp ending at point.
-    comint-input-filter-functions does nothing.
-    comint-input-filter returns nil if the input matches input-filter-regexp,
-        which matches (1) all whitespace (2) :a, :c, etc.
-
-Similarly for Soar, Scheme, etc."
-  (interactive)
-  ;; Note that the input string does not include its terminal newline.
-  (let ((proc (get-buffer-process (current-buffer))))
-    (if (not proc) (error "Current buffer has no process")
-	(let* ((pmark (process-mark proc))
-	       (intxt (if (>= (point) (marker-position pmark))
-			  (progn (if comint-eol-on-send (end-of-line))
-				 (buffer-substring pmark (point)))
-			(let ((copy (funcall comint-get-old-input)))
-			  (goto-char pmark)
-			  (insert copy)
-			  copy)))
-	       (input (if (not (eq comint-input-autoexpand 'input))
-			  ;; Just whatever's already there
-			  intxt
-			;; Expand and leave it visible in buffer
-			(comint-replace-by-expanded-history t)
-			(buffer-substring pmark (point))))
-	       (history (if (not (eq comint-input-autoexpand 'history))
-			    input
-			  ;; This is messy 'cos ultimately the original
-			  ;; functions used do insertion, rather than return
-			  ;; strings.  We have to expand, then insert back.
-			  (comint-replace-by-expanded-history t)
-			  (let ((copy (buffer-substring pmark (point))))
-			    (delete-region pmark (point))
-			    (insert-before-markers input)
-			    copy))))
-          (if comint-process-echoes
-              (delete-region pmark (point))
-	    (insert-before-markers ?\n))
-	  (if (and (funcall comint-input-filter history)
-		   (or (null comint-input-ignoredups)
-		       (not (ring-p comint-input-ring))
-		       (ring-empty-p comint-input-ring)
-		       (not (string-equal (ring-ref comint-input-ring 0)
-					  history))))
-	      (ring-insert comint-input-ring history))
-	  (run-hook-with-args 'comint-input-filter-functions
-			      (concat input "\n"))
-	  (setq comint-input-ring-index nil)
-	  ;; Update the markers before we send the input
-	  ;; in case we get output amidst sending the input.
-	  (set-marker comint-last-input-start pmark)
-	  (set-marker comint-last-input-end (point))
-	  (set-marker (process-mark proc) (point))
-	  (funcall comint-input-sender proc input)
-	  ;; This used to call comint-output-filter-functions,
-	  ;; but that scrolled the buffer in undesirable ways.
-	  (run-hook-with-args 'comint-output-filter-functions "")))))
-
-;; The purpose of using this filter for comint processes
-;; is to keep comint-last-input-end from moving forward
-;; when output is inserted.
-(defun comint-output-filter (process string)
-  ;; First check for killed buffer
-  (let ((oprocbuf (process-buffer process)))
-    (if (and oprocbuf (buffer-name oprocbuf))
-	(let ((obuf (current-buffer))
-	      (opoint nil) (obeg nil) (oend nil))
-	  (set-buffer oprocbuf)
-	  (setq opoint (point))
-	  (setq obeg (point-min))
-	  (setq oend (point-max))
-	  (let ((buffer-read-only nil)
-		(nchars (length string))
-		(ostart nil))
-	    (widen)
-	    (goto-char (process-mark process))
-	    (setq ostart (point))
-	    (if (<= (point) opoint)
-		(setq opoint (+ opoint nchars)))
-	    ;; Insert after old_begv, but before old_zv.
-	    (if (< (point) obeg)
-		(setq obeg (+ obeg nchars)))
-	    (if (<= (point) oend)
-		(setq oend (+ oend nchars)))
-	    (insert-before-markers string)
-	    ;; Don't insert initial prompt outside the top of the window.
-	    (if (= (window-start (selected-window)) (point))
-		(set-window-start (selected-window) (- (point) (length string))))
-	    (if (and comint-last-input-end
-		     (marker-buffer comint-last-input-end)
-		     (= (point) comint-last-input-end))
-		(set-marker comint-last-input-end (- comint-last-input-end nchars)))
-	    (set-marker comint-last-output-start ostart)
-	    (set-marker (process-mark process) (point))
-	    (force-mode-line-update))
-
-	  (narrow-to-region obeg oend)
-	  (goto-char opoint)
-	  (run-hook-with-args 'comint-output-filter-functions string)
-	  (set-buffer obuf)))))
-
-(defun comint-preinput-scroll-to-bottom ()
-  "Go to the end of buffer in all windows showing it.
-Movement occurs if point in the selected window is not after the process mark,
-and `this-command' is an insertion command.  Insertion commands recognised
-are `self-insert-command', `comint-magic-space', `yank', and `hilit-yank'.
-Depends on the value of `comint-scroll-to-bottom-on-input'.
-
-This function should be a pre-command hook."
-  (if (and comint-scroll-to-bottom-on-input
-	   (memq this-command '(self-insert-command comint-magic-space yank
-				hilit-yank)))
-      (let* ((selected (selected-window))
-	     (current (current-buffer))
-	     (process (get-buffer-process current))
-	     (scroll comint-scroll-to-bottom-on-input))
-	(if (and process (< (point) (process-mark process)))
-	    (if (eq scroll 'this)
-		(goto-char (point-max))
-	      (walk-windows
-	       (function (lambda (window)
-		 (if (and (eq (window-buffer window) current)
-			  (or (eq scroll t) (eq scroll 'all)))
-		     (progn
-		       (select-window window)
-		       (goto-char (point-max))
-		       (select-window selected)))))
-	       nil t))))))
-
-(defun comint-postoutput-scroll-to-bottom (string)
-  "Go to the end of buffer in all windows showing it.
-Does not scroll if the current line is the last line in the buffer.
-Depends on the value of `comint-scroll-to-bottom-on-output' and
-`comint-scroll-show-maximum-output'.
-
-This function should be in the list `comint-output-filter-functions'."
-  (let* ((selected (selected-window))
-	 (current (current-buffer))
-	 (process (get-buffer-process current))
-	 (scroll comint-scroll-to-bottom-on-output))
-    (unwind-protect
-	(if process
-	    (walk-windows
-	     (function (lambda (window)
-	       (if (eq (window-buffer window) current)
-		   (progn
-		     (select-window window)
-		     (if (and (< (point) (process-mark process))
-			      (or (eq scroll t) (eq scroll 'all)
-				  ;; Maybe user wants point to jump to end.
-				  (and (eq scroll 'this) (eq selected window))
-				  (and (eq scroll 'others) (not (eq selected window)))
-				  ;; If point was at the end, keep it at end.
-				  (>= (point) comint-last-output-start)))
-			 (goto-char (process-mark process)))
-		     ;; Optionally scroll so that the text
-		     ;; ends at the bottom of the window.
-		     (if (and comint-scroll-show-maximum-output
-			      (>= (point) (process-mark process)))
-			 (save-excursion
-			   (goto-char (point-max))
-			   (recenter -1)))
-		     (select-window selected)))))
-	     nil t))
-      (set-buffer current))))
-
-(defun comint-truncate-buffer (&optional string)
-  "Truncate the buffer to `comint-buffer-maximum-size'.
-This function could be on `comint-output-filter-functions' or bound to a key."
-  (interactive)
-  (save-excursion
-    (goto-char (process-mark (get-buffer-process (current-buffer))))
-    (forward-line (- comint-buffer-maximum-size))
-    (beginning-of-line)
-    (delete-region (point-min) (point))))
-
-(defun comint-strip-ctrl-m (&optional string)
-  "Strip trailing `^M' characters from the current output group.
-This function could be on `comint-output-filter-functions' or bound to a key."
-  (interactive)
-  (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
-    (save-excursion
-      (goto-char
-       (if (interactive-p) comint-last-input-end comint-last-output-start))
-      (while (re-search-forward "\r+$" pmark t)
-	(replace-match "" t t)))))
-(defalias 'shell-strip-ctrl-m 'comint-strip-ctrl-m)
-
-(defun comint-show-maximum-output ()
-  "Put the end of the buffer at the bottom of the window."
-  (interactive)
-  (goto-char (point-max))
-  (recenter -1))
-
-(defun comint-get-old-input-default ()
-  "Default for `comint-get-old-input'.
-Take the current line, and discard any initial text matching
-`comint-prompt-regexp'."
-  (save-excursion
-    (beginning-of-line)
-    (comint-skip-prompt)
-    (let ((beg (point)))
-      (end-of-line)
-      (buffer-substring beg (point)))))
-
-(defun comint-copy-old-input ()
-  "Insert after prompt old input at point as new input to be edited.
-Calls `comint-get-old-input' to get old input."
-  (interactive)
-  (let ((input (funcall comint-get-old-input))
- 	(process (get-buffer-process (current-buffer))))
-    (if (not process)
-	(error "Current buffer has no process")
-      (goto-char (process-mark process))
-      (insert input))))
-
-(defun comint-skip-prompt ()
-  "Skip past the text matching regexp `comint-prompt-regexp'.
-If this takes us past the end of the current line, don't skip at all."
-  (let ((eol (save-excursion (end-of-line) (point))))
-    (if (and (looking-at comint-prompt-regexp)
-	     (<= (match-end 0) eol))
-	(goto-char (match-end 0)))))
-
-(defun comint-after-pmark-p ()
-  "Return t if point is after the process output marker."
-  (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
-    (<= (marker-position pmark) (point))))
-
-(defun comint-simple-send (proc string)
-  "Default function for sending to PROC input STRING.
-This just sends STRING plus a newline. To override this,
-set the hook `comint-input-sender'."
-  (comint-send-string proc string)
-  (comint-send-string proc "\n"))
-
-(defun comint-bol (arg)
-  "Goes to the beginning of line, then skips past the prompt, if any.
-If prefix argument is given (\\[universal-argument]) the prompt is not skipped. 
-
-The prompt skip is done by skipping text matching the regular expression
-`comint-prompt-regexp', a buffer local variable."
-  (interactive "P")
-  (beginning-of-line)
-  (if (null arg) (comint-skip-prompt)))
-
-;; These three functions are for entering text you don't want echoed or
-;; saved -- typically passwords to ftp, telnet, or somesuch.
-;; Just enter m-x send-invisible and type in your line, or add
-;; `comint-watch-for-password-prompt' to `comint-output-filter-functions'.
-
-(defun comint-read-noecho (prompt &optional stars)
-  "Read a single line of text from user without echoing, and return it. 
-Prompt with argument PROMPT, a string.  Optional argument STARS causes
-input to be echoed with '*' characters on the prompt line.  Input ends with
-RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.  C-g aborts (if
-`inhibit-quit' is set because e.g. this function was called from a process
-filter and C-g is pressed, this function returns nil rather than a string).
-
-Note that the keystrokes comprising the text can still be recovered
-\(temporarily) with \\[view-lossage].  Some people find this worrysome.
-Once the caller uses the password, it can erase the password
-by doing (fillarray STRING 0)."
-  (let ((ans "")
-	(newans nil)
-	(c 0)
-	(echo-keystrokes 0)
-	(cursor-in-echo-area t)
-	(message-log-max nil)
-	(done nil))
-    (while (not done)
-      (if stars
-	  (message "%s%s" prompt (make-string (length ans) ?*))
-	(message "%s" prompt))
-      ;; Use this instead of `read-char' to avoid "Non-character input-event".
-      (setq c (read-char-exclusive))
-      (cond ((= c ?\C-g)
-	     ;; This function may get called from a process filter, where
-	     ;; inhibit-quit is set.  In later versions of emacs read-char
-	     ;; may clear quit-flag itself and return C-g.  That would make
-	     ;; it impossible to quit this loop in a simple way, so
-	     ;; re-enable it here (for backward-compatibility the check for
-	     ;; quit-flag below would still be necessary, so this seems
-	     ;; like the simplest way to do things).
-	     (setq quit-flag t
-		   done t))
-	    ((or (= c ?\r) (= c ?\n) (= c ?\e))
-	     (setq done t))
-	    ((= c ?\C-u)
-	     (fillarray ans 0)
-	     (setq ans ""))
-	    ((and (/= c ?\b) (/= c ?\177))
-	     (setq newans (concat ans (char-to-string c)))
-	     (fillarray ans 0)
-	     (setq ans newans))
-	    ((> (length ans) 0)
-	     (aset ans (1- (length ans)) 0)
-	     (setq ans (substring ans 0 -1)))))
-    (if quit-flag
-        ;; Emulate a true quit, except that we have to return a value.
-        (prog1
-            (setq quit-flag nil)
-          (message "Quit")
-          (beep t))
-      (message "")
-      ans)))
-
-(defun send-invisible (str)
-  "Read a string without echoing.
-Then send it to the process running in the current buffer.
-The string is sent using `comint-input-sender'.
-Security bug: your string can still be temporarily recovered with
-\\[view-lossage]."
-  (interactive "P") ; Defeat snooping via C-x ESC ESC
-  (let ((proc (get-buffer-process (current-buffer))))
-    (if (not proc)
-	(error "Current buffer has no process")
-      (funcall comint-input-sender proc
-       (if (stringp str) str (comint-read-noecho "Non-echoed text: " t))))))
-
-(defun comint-watch-for-password-prompt (string) 
-  "Prompt in the minibuffer for password and send without echoing.
-This function uses `send-invisible' to read and send a password to the buffer's
-process if STRING contains a password prompt defined by 
-`comint-password-prompt-regexp'.
-
-This function could be in the list `comint-output-filter-functions'."
-  (if (string-match comint-password-prompt-regexp string)
-      (send-invisible nil)))
-
-;; Low-level process communication
-
-(defalias 'comint-send-string 'process-send-string)
-(defalias 'comint-send-region 'process-send-region)
-
-;; Random input hackage
-
-(defun comint-kill-output ()
-  "Kill all output from interpreter since last input.
-Does not delete the prompt."
-  (interactive)
-  (let ((proc (get-buffer-process (current-buffer)))
-	(replacement nil))
-    (save-excursion
-      (let ((pmark (progn (goto-char (process-mark proc))
-			  (beginning-of-line nil)
-			  (point-marker))))
-	(delete-region comint-last-input-end pmark)
-	(goto-char (process-mark proc))
-	(setq replacement (concat "*** output flushed ***\n"
-				  (buffer-substring pmark (point))))
-	(delete-region pmark (point))))
-    ;; Output message and put back prompt
-    (comint-output-filter proc replacement)))
-
-(defun comint-show-output ()
-  "Display start of this batch of interpreter output at top of window.
-Sets mark to the value of point when this command is run."
-  (interactive)
-  (push-mark)
-  (let ((pos (point)))
-    (goto-char (or (marker-position comint-last-input-end) (point-max)))
-    (beginning-of-line 0)
-    (set-window-start (selected-window) (point))
-    (comint-skip-prompt)))
-
-(defun comint-interrupt-subjob ()
-  "Interrupt the current subjob."
-  (interactive)
-  (interrupt-process nil comint-ptyp))
-
-(defun comint-kill-subjob ()
-  "Send kill signal to the current subjob."
-  (interactive)
-  (kill-process nil comint-ptyp))
-
-(defun comint-quit-subjob ()
-  "Send quit signal to the current subjob."
-  (interactive)
-  (quit-process nil comint-ptyp))
-
-(defun comint-stop-subjob ()
-  "Stop the current subjob.
-WARNING: if there is no current subjob, you can end up suspending
-the top-level process running in the buffer. If you accidentally do
-this, use \\[comint-continue-subjob] to resume the process. (This
-is not a problem with most shells, since they ignore this signal.)"
-  (interactive)
-  (stop-process nil comint-ptyp))
-
-(defun comint-continue-subjob ()
-  "Send CONT signal to process buffer's process group.
-Useful if you accidentally suspend the top-level process."
-  (interactive)
-  (continue-process nil comint-ptyp))
-
-(defun comint-kill-input ()
-  "Kill all text from last stuff output by interpreter to point."
-  (interactive)
-  (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
-    (if (> (point) (marker-position pmark))
-	(kill-region pmark (point)))))
-
-(defun comint-delchar-or-maybe-eof (arg)
-  "Delete ARG characters forward, or (if at eob) send an EOF to subprocess."
-  (interactive "p")
-  (if (eobp)
-      (process-send-eof)
-    (delete-char arg)))
-
-(defun comint-send-eof ()
-  "Send an EOF to the current buffer's process."
-  (interactive)
-  (process-send-eof))
-
-
-(defun comint-backward-matching-input (regexp arg)
-  "Search backward through buffer for match for REGEXP.
-Matches are searched for on lines that match `comint-prompt-regexp'.
-With prefix argument N, search for Nth previous match.
-If N is negative, find the next or Nth next match."
-  (interactive (comint-regexp-arg "Backward input matching (regexp): "))
-  (let* ((re (concat comint-prompt-regexp ".*" regexp))
-	 (pos (save-excursion (end-of-line (if (> arg 0) 0 1))
-			      (if (re-search-backward re nil t arg)
-				  (point)))))
-    (if (null pos)
-	(progn (message "Not found")
-	       (ding))
-      (goto-char pos)
-      (comint-bol nil))))
-
-(defun comint-forward-matching-input (regexp arg)
-  "Search forward through buffer for match for REGEXP.
-Matches are searched for on lines that match `comint-prompt-regexp'.
-With prefix argument N, search for Nth following match.
-If N is negative, find the previous or Nth previous match."
-  (interactive (comint-regexp-arg "Forward input matching (regexp): "))
-  (comint-backward-matching-input regexp (- arg)))
-
-
-(defun comint-next-prompt (n)
-  "Move to end of Nth next prompt in the buffer.
-See `comint-prompt-regexp'."
-  (interactive "p")
-  (let ((paragraph-start comint-prompt-regexp))
-    (end-of-line (if (> n 0) 1 0))
-    (forward-paragraph n)
-    (comint-skip-prompt)))
-
-(defun comint-previous-prompt (n)
-  "Move to end of Nth previous prompt in the buffer.
-See `comint-prompt-regexp'."
-  (interactive "p")
-  (comint-next-prompt (- n)))
-
-;; Support for source-file processing commands.
-;;============================================================================
-;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
-;; commands that process files of source text (e.g. loading or compiling
-;; files). So the corresponding process-in-a-buffer modes have commands
-;; for doing this (e.g., lisp-load-file). The functions below are useful
-;; for defining these commands.
-;;
-;; Alas, these guys don't do exactly the right thing for Lisp, Scheme
-;; and Soar, in that they don't know anything about file extensions.
-;; So the compile/load interface gets the wrong default occasionally.
-;; The load-file/compile-file default mechanism could be smarter -- it
-;; doesn't know about the relationship between filename extensions and
-;; whether the file is source or executable. If you compile foo.lisp
-;; with compile-file, then the next load-file should use foo.bin for
-;; the default, not foo.lisp. This is tricky to do right, particularly
-;; because the extension for executable files varies so much (.o, .bin,
-;; .lbin, .mo, .vo, .ao, ...).
-
-
-;; COMINT-SOURCE-DEFAULT -- determines defaults for source-file processing
-;; commands.
-;;
-;; COMINT-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you
-;; want to save the buffer before issuing any process requests to the command
-;; interpreter.
-;;
-;; COMINT-GET-SOURCE -- used by the source-file processing commands to prompt
-;; for the file to process.
-
-;; (COMINT-SOURCE-DEFAULT previous-dir/file source-modes)
-;;============================================================================
-;; This function computes the defaults for the load-file and compile-file
-;; commands for tea, soar, cmulisp, and cmuscheme modes. 
-;; 
-;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last 
-;; source-file processing command. NIL if there hasn't been one yet.
-;; - SOURCE-MODES is a list used to determine what buffers contain source
-;; files: if the major mode of the buffer is in SOURCE-MODES, it's source.
-;; Typically, (lisp-mode) or (scheme-mode).
-;; 
-;; If the command is given while the cursor is inside a string, *and*
-;; the string is an existing filename, *and* the filename is not a directory,
-;; then the string is taken as default. This allows you to just position
-;; your cursor over a string that's a filename and have it taken as default.
-;;
-;; If the command is given in a file buffer whose major mode is in
-;; SOURCE-MODES, then the the filename is the default file, and the
-;; file's directory is the default directory.
-;; 
-;; If the buffer isn't a source file buffer (e.g., it's the process buffer),
-;; then the default directory & file are what was used in the last source-file
-;; processing command (i.e., PREVIOUS-DIR/FILE).  If this is the first time
-;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory
-;; is the cwd, with no default file. (\"no default file\" = nil)
-;; 
-;; SOURCE-REGEXP is typically going to be something like (tea-mode)
-;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode)
-;; for Soar programs, etc.
-;; 
-;; The function returns a pair: (default-directory . default-file).
-
-(defun comint-source-default (previous-dir/file source-modes)
-  (cond ((and buffer-file-name (memq major-mode source-modes))
-	 (cons (file-name-directory    buffer-file-name)
-	       (file-name-nondirectory buffer-file-name)))
-	(previous-dir/file)
-	(t
-	 (cons default-directory nil))))
-
-
-;; (COMINT-CHECK-SOURCE fname)
-;;============================================================================
-;; Prior to loading or compiling (or otherwise processing) a file (in the CMU
-;; process-in-a-buffer modes), this function can be called on the filename.
-;; If the file is loaded into a buffer, and the buffer is modified, the user
-;; is queried to see if he wants to save the buffer before proceeding with
-;; the load or compile.
-
-(defun comint-check-source (fname)
-  (let ((buff (get-file-buffer fname)))
-    (if (and buff
-	     (buffer-modified-p buff)
-	     (y-or-n-p (format "Save buffer %s first? " (buffer-name buff))))
-	;; save BUFF.
-	(let ((old-buffer (current-buffer)))
-	  (set-buffer buff)
-	  (save-buffer)
-	  (set-buffer old-buffer)))))
-
-
-;; (COMINT-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
-;;============================================================================
-;; COMINT-GET-SOURCE is used to prompt for filenames in command-interpreter
-;; commands that process source files (like loading or compiling a file).
-;; It prompts for the filename, provides a default, if there is one,
-;; and returns the result filename.
-;; 
-;; See COMINT-SOURCE-DEFAULT for more on determining defaults.
-;; 
-;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
-;; from the last source processing command.  SOURCE-MODES is a list of major
-;; modes used to determine what file buffers contain source files.  (These
-;; two arguments are used for determining defaults). If MUSTMATCH-P is true,
-;; then the filename reader will only accept a file that exists.
-;; 
-;; A typical use:
-;; (interactive (comint-get-source "Compile file: " prev-lisp-dir/file
-;;                                 '(lisp-mode) t))
-
-;; This is pretty stupid about strings. It decides we're in a string
-;; if there's a quote on both sides of point on the current line.
-(defun comint-extract-string ()
-  "Return string around POINT that starts the current line, or nil." 
-  (save-excursion
-    (let* ((point (point))
-	   (bol (progn (beginning-of-line) (point)))
-	   (eol (progn (end-of-line) (point)))
-	   (start (progn (goto-char point) 
-			 (and (search-backward "\"" bol t) 
-			      (1+ (point)))))
-	   (end (progn (goto-char point)
-		       (and (search-forward "\"" eol t)
-			    (1- (point))))))
-      (and start end
-	   (buffer-substring start end)))))
-
-(defun comint-get-source (prompt prev-dir/file source-modes mustmatch-p)
-  (let* ((def (comint-source-default prev-dir/file source-modes))
-         (stringfile (comint-extract-string))
-	 (sfile-p (and stringfile
-		       (condition-case ()
-			   (file-exists-p stringfile)
-			 (error nil))
-		       (not (file-directory-p stringfile))))
-	 (defdir  (if sfile-p (file-name-directory stringfile)
-                      (car def)))
-	 (deffile (if sfile-p (file-name-nondirectory stringfile)
-                      (cdr def)))
-	 (ans (read-file-name (if deffile (format "%s(default %s) "
-						  prompt    deffile)
-				  prompt)
-			      defdir
-			      (concat defdir deffile)
-			      mustmatch-p)))
-    (list (expand-file-name (substitute-in-file-name ans)))))
-
-;; I am somewhat divided on this string-default feature. It seems
-;; to violate the principle-of-least-astonishment, in that it makes
-;; the default harder to predict, so you actually have to look and see
-;; what the default really is before choosing it. This can trip you up.
-;; On the other hand, it can be useful, I guess. I would appreciate feedback
-;; on this.
-;;     -Olin
-
-
-;; Simple process query facility.
-;; ===========================================================================
-;; This function is for commands that want to send a query to the process
-;; and show the response to the user. For example, a command to get the
-;; arglist for a Common Lisp function might send a "(arglist 'foo)" query
-;; to an inferior Common Lisp process.
-;; 
-;; This simple facility just sends strings to the inferior process and pops
-;; up a window for the process buffer so you can see what the process
-;; responds with.  We don't do anything fancy like try to intercept what the
-;; process responds with and put it in a pop-up window or on the message
-;; line. We just display the buffer. Low tech. Simple. Works good.
-
-;; Send to the inferior process PROC the string STR. Pop-up but do not select
-;; a window for the inferior process so that its response can be seen.
-(defun comint-proc-query (proc str)
-  (let* ((proc-buf (process-buffer proc))
-	 (proc-mark (process-mark proc)))
-    (display-buffer proc-buf)
-    (set-buffer proc-buf) ; but it's not the selected *window*
-    (let ((proc-win (get-buffer-window proc-buf))
-	  (proc-pt (marker-position proc-mark)))
-      (comint-send-string proc str) ; send the query
-      (accept-process-output proc)  ; wait for some output
-      ;; Try to position the proc window so you can see the answer.
-      ;; This is bogus code. If you delete the (sit-for 0), it breaks.
-      ;; I don't know why. Wizards invited to improve it.
-      (if (not (pos-visible-in-window-p proc-pt proc-win))
-	  (let ((opoint (window-point proc-win)))
-	    (set-window-point proc-win proc-mark)
-	    (sit-for 0)
-	    (if (not (pos-visible-in-window-p opoint proc-win))
-		(push-mark opoint)
-	      (set-window-point proc-win opoint)))))))
-
-
-;; Filename/command/history completion in a buffer
-;; ===========================================================================
-;; Useful completion functions, courtesy of the Ergo group.
-
-;; Six commands:
-;; comint-dynamic-complete		Complete or expand command, filename,
-;;                                     history at point.
-;; comint-dynamic-complete-filename	Complete filename at point.
-;; comint-dynamic-list-filename-completions List completions in help buffer.
-;; comint-replace-by-expanded-filename	Expand and complete filename at point;
-;;					replace with expanded/completed name.
-;; comint-dynamic-simple-complete	Complete stub given candidates.
-
-;; These are not installed in the comint-mode keymap. But they are
-;; available for people who want them. Shell-mode installs them:
-;; (define-key shell-mode-map "\t" 'comint-dynamic-complete)
-;; (define-key shell-mode-map "\M-?"
-;;             'comint-dynamic-list-filename-completions)))
-;;
-;; Commands like this are fine things to put in load hooks if you
-;; want them present in specific modes.
-
-(defvar comint-completion-autolist nil
-  "*If non-nil, automatically list possibilities on partial completion.
-This mirrors the optional behavior of tcsh.")
-
-(defvar comint-completion-addsuffix t
-  "*If non-nil, add a `/' to completed directories, ` ' to file names.
-If a cons pair, it should be of the form (DIRSUFFIX . FILESUFFIX) where
-DIRSUFFIX and FILESUFFIX are strings added on unambiguous or exact completion.
-This mirrors the optional behavior of tcsh.")
-
-(defvar comint-completion-recexact nil
-  "*If non-nil, use shortest completion if characters cannot be added.
-This mirrors the optional behavior of tcsh.
-
-A non-nil value is useful if `comint-completion-autolist' is non-nil too.")
-
-(defvar comint-completion-fignore nil
-  "*List of suffixes to be disregarded during file completion.
-This mirrors the optional behavior of bash and tcsh.
-
-Note that this applies to `comint-dynamic-complete-filename' only.")
-
-(defvar comint-file-name-prefix ""
-  "Prefix prepended to absolute file names taken from process input.
-This is used by comint's and shell's completion functions, and by shell's
-directory tracking functions.")
-
-(defvar comint-file-name-chars
-  (if (memq system-type '(ms-dos windows-nt))
-      "~/A-Za-z0-9_^$!#%&{}@`'.()-"
-    "~/A-Za-z0-9+@:_.$#%,={}-")
-  "String of characters valid in a file name.
-
-This is a good thing to set in mode hooks.")
-
-(defvar comint-file-name-quote-list nil
-  "List of characters to quote with `\\' when in a file name.
-
-This is a good thing to set in mode hooks.")
-
-
-(defun comint-directory (directory)
-  ;; Return expanded DIRECTORY, with `comint-file-name-prefix' if absolute.
-  (expand-file-name (if (file-name-absolute-p directory)
-			(concat comint-file-name-prefix directory)
-		      directory)))
-
-
-(defun comint-word (word-chars)
-  "Return the word of WORD-CHARS at point, or nil if non is found.
-Word constituents are considered to be those in WORD-CHARS, which is like the
-inside of a \"[...]\" (see `skip-chars-forward')."
-  (save-excursion
-    (let ((non-word-chars (concat "[^\\\\" word-chars "]")) (here (point)))
-      (while (and (re-search-backward non-word-chars nil 'move)
-		  ;(memq (char-after (point)) shell-file-name-quote-list)
-		  (eq (preceding-char) ?\\))
-	(backward-char 1))
-      ;; Don't go forward over a word-char (this can happen if we're at bob).
-      (if (or (not (bobp)) (looking-at non-word-chars))
-	  (forward-char 1))
-      ;; Set match-data to match the entire string.
-      (if (< (point) here)
-	  (progn (store-match-data (list (point) here))
-		 (match-string 0))))))
-
-(defun comint-substitute-in-file-name (filename)
-  "Return FILENAME with environment variables substituted.
-Supports additional environment variable syntax of the command
-interpreter (e.g., the percent notation of cmd.exe on NT)."
-  (let ((name (substitute-in-file-name filename)))
-    (if (memq system-type '(ms-dos windows-nt))
-	(let (env-var-name
-	      env-var-val)
-	  (save-match-data
-	    (while (string-match "%\\([^\\\\/]*\\)%" name)
-	      (setq env-var-name 
-		    (substring name (match-beginning 1) (match-end 1)))
-	      (setq env-var-val (if (getenv env-var-name)
-				    (getenv env-var-name)
-				  ""))
-	      (setq name (replace-match env-var-val nil nil name))))))
-    name))
-
-(defun comint-match-partial-filename ()
-  "Return the filename at point, or nil if non is found.
-Environment variables are substituted.  See `comint-word'."
-  (let ((filename (comint-word comint-file-name-chars)))
-    (and filename (comint-substitute-in-file-name 
-		   (comint-unquote-filename filename)))))
-
-
-(defun comint-quote-filename (filename)
-  "Return FILENAME with magic characters quoted.
-Magic characters are those in `comint-file-name-quote-list'."
-  (if (null comint-file-name-quote-list)
-      filename
-    (let ((regexp
-	   (format "\\(^\\|[^\\]\\)\\([%s]\\)"
-	    (mapconcat 'char-to-string comint-file-name-quote-list ""))))
-      (save-match-data
-	(while (string-match regexp filename)
-	  (setq filename (replace-match "\\1\\\\\\2" nil nil filename)))
-	filename))))
-
-(defun comint-unquote-filename (filename)
-  "Return FILENAME with quoted characters unquoted."
-  (if (null comint-file-name-quote-list)
-      filename
-    (save-match-data
-      (let ((i 0))
-	(while (string-match "\\\\\\(.\\)" filename i)
-	  (setq filename (replace-match "\\1" nil nil filename))
-	  (setq i (+ 1 (match-beginning 0)))))
-      filename)))
-
-
-(defun comint-dynamic-complete ()
-  "Dynamically perform completion at point.
-Calls the functions in `comint-dynamic-complete-functions' to perform
-completion until a function returns non-nil, at which point completion is
-assumed to have occurred."
-  (interactive)
-  (run-hook-with-args-until-success 'comint-dynamic-complete-functions))
-
-
-(defun comint-dynamic-complete-filename ()
-  "Dynamically complete the filename at point.
-Completes if after a filename.  See `comint-match-partial-filename' and
-`comint-dynamic-complete-as-filename'.
-This function is similar to `comint-replace-by-expanded-filename', except that
-it won't change parts of the filename already entered in the buffer; it just
-adds completion characters to the end of the filename.  A completions listing
-may be shown in a help buffer if completion is ambiguous.
-
-Completion is dependent on the value of `comint-completion-addsuffix',
-`comint-completion-recexact' and `comint-completion-fignore', and the timing of
-completions listing is dependent on the value of `comint-completion-autolist'.
-
-Returns t if successful."
-  (interactive)
-  (if (comint-match-partial-filename)
-      (let ((directory-sep-char (if (memq system-type '(ms-dos windows-nt))
-				    ?\\
-				  ?/)))
-	(prog2 (or (window-minibuffer-p (selected-window))
-		   (message "Completing file name..."))
-	    (comint-dynamic-complete-as-filename)))))
-
-(defun comint-dynamic-complete-as-filename ()
-  "Dynamically complete at point as a filename.
-See `comint-dynamic-complete-filename'.  Returns t if successful."
-  (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))
-	 (completion-ignored-extensions comint-completion-fignore)
-	 ;; If we bind this, it breaks remote directory tracking in rlogin.el.
-	 ;; I think it was originally bound to solve file completion problems,
-	 ;; but subsequent changes may have made this unnecessary.  sm.
-	 ;;(file-name-handler-alist nil)
-	 (minibuffer-p (window-minibuffer-p (selected-window)))
-	 (success t)
-	 (dirsuffix (cond ((not comint-completion-addsuffix) "")
-			  ((not (consp comint-completion-addsuffix)) "/")
-			  (t (car comint-completion-addsuffix))))
-	 (filesuffix (cond ((not comint-completion-addsuffix) "")
-			   ((not (consp comint-completion-addsuffix)) " ")
-			   (t (cdr comint-completion-addsuffix))))
-	 (filename (or (comint-match-partial-filename) ""))
-	 (pathdir (file-name-directory filename))
-	 (pathnondir (file-name-nondirectory filename))
-	 (directory (if pathdir (comint-directory pathdir) default-directory))
-	 (completion (file-name-completion pathnondir directory)))
-    (cond ((null completion)
-           (message "No completions of %s" filename)
-	   (setq success nil))
-          ((eq completion t)            ; Means already completed "file".
-           (insert filesuffix)
-           (or minibuffer-p (message "Sole completion")))
-          ((string-equal completion "") ; Means completion on "directory/".
-           (comint-dynamic-list-filename-completions))
-          (t                            ; Completion string returned.
-           (let ((file (concat (file-name-as-directory directory) completion)))
-	     (insert (comint-quote-filename
-		      (substring (directory-file-name completion)
-				 (length pathnondir))))
-             (cond ((symbolp (file-name-completion completion directory))
-                    ;; We inserted a unique completion.
-		    (insert (if (file-directory-p file) dirsuffix filesuffix))
-                    (or minibuffer-p (message "Completed")))
-                   ((and comint-completion-recexact comint-completion-addsuffix
-                         (string-equal pathnondir completion)
-                         (file-exists-p file))
-                    ;; It's not unique, but user wants shortest match.
-                    (insert (if (file-directory-p file) dirsuffix filesuffix))
-                    (or minibuffer-p (message "Completed shortest")))
-                   ((or comint-completion-autolist
-                        (string-equal pathnondir completion))
-                    ;; It's not unique, list possible completions.
-                    (comint-dynamic-list-filename-completions))
-                   (t
-                    (or minibuffer-p (message "Partially completed")))))))
-    success))
-
-
-(defun comint-replace-by-expanded-filename ()
-  "Dynamically expand and complete the filename at point.
-Replace the filename with an expanded, canonicalised and completed replacement.
-\"Expanded\" means environment variables (e.g., $HOME) and `~'s are replaced
-with the corresponding directories.  \"Canonicalised\" means `..'  and `.' are
-removed, and the filename is made absolute instead of relative.  For expansion
-see `expand-file-name' and `substitute-in-file-name'.  For completion see
-`comint-dynamic-complete-filename'."
-  (interactive)
-  (replace-match (expand-file-name (comint-match-partial-filename)) t t)
-  (comint-dynamic-complete-filename))
-
-
-(defun comint-dynamic-simple-complete (stub candidates)
-  "Dynamically complete STUB from CANDIDATES list.
-This function inserts completion characters at point by completing STUB from
-the strings in CANDIDATES.  A completions listing may be shown in a help buffer
-if completion is ambiguous.
-
-Returns nil if no completion was inserted.
-Returns `sole' if completed with the only completion match.
-Returns `shortest' if completed with the shortest of the completion matches.
-Returns `partial' if completed as far as possible with the completion matches.
-Returns `listed' if a completion listing was shown.
-
-See also `comint-dynamic-complete-filename'."
-  (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))
-	 (suffix (cond ((not comint-completion-addsuffix) "")
-		       ((not (consp comint-completion-addsuffix)) " ")
-		       (t (cdr comint-completion-addsuffix))))
-	 (candidates (mapcar (function (lambda (x) (list x))) candidates))
-	 (completions (all-completions stub candidates)))
-    (cond ((null completions)
- 	   (message "No completions of %s" stub)
-	   nil)
- 	  ((= 1 (length completions))	; Gotcha!
- 	   (let ((completion (car completions)))
- 	     (if (string-equal completion stub)
- 		 (message "Sole completion")
- 	       (insert (substring completion (length stub)))
- 	       (message "Completed"))
-	     (insert suffix)
-	     'sole))
- 	  (t				; There's no unique completion.
- 	   (let ((completion (try-completion stub candidates)))
- 	     ;; Insert the longest substring.
- 	     (insert (substring completion (length stub)))
- 	     (cond ((and comint-completion-recexact comint-completion-addsuffix
- 			 (string-equal stub completion)
- 			 (member completion completions))
- 		    ;; It's not unique, but user wants shortest match.
- 		    (insert suffix)
- 		    (message "Completed shortest")
-		    'shortest)
- 		   ((or comint-completion-autolist
- 			(string-equal stub completion))
- 		    ;; It's not unique, list possible completions.
- 		    (comint-dynamic-list-completions completions)
-		    'listed)
- 		   (t
-		    (message "Partially completed")
-		    'partial)))))))
-
-
-(defun comint-dynamic-list-filename-completions ()
-  "List in help buffer possible completions of the filename at point."
-  (interactive)
-  (let* ((completion-ignore-case (memq system-type '(ms-dos windows-nt)))
-	 ;; If we bind this, it breaks remote directory tracking in rlogin.el.
-	 ;; I think it was originally bound to solve file completion problems,
-	 ;; but subsequent changes may have made this unnecessary.  sm.
-	 ;;(file-name-handler-alist nil)
-	 (filename (or (comint-match-partial-filename) ""))
-	 (pathdir (file-name-directory filename))
-	 (pathnondir (file-name-nondirectory filename))
-	 (directory (if pathdir (comint-directory pathdir) default-directory))
-	 (completions (file-name-all-completions pathnondir directory)))
-    (if (not completions)
-	(message "No completions of %s" filename)
-      (comint-dynamic-list-completions
-       (mapcar 'comint-quote-filename completions)))))
-
-
-(defun comint-dynamic-list-completions (completions)
-  "List in help buffer sorted COMPLETIONS.
-Typing SPC flushes the help buffer."
-  (let ((conf (current-window-configuration)))
-    (with-output-to-temp-buffer "*Completions*"
-      (display-completion-list (sort completions 'string-lessp)))
-    (message "Hit space to flush")
-    (let (key first)
-      (if (save-excursion
-	    (set-buffer (get-buffer "*Completions*"))
-	    (setq key (read-key-sequence nil)
-		  first (aref key 0))
-	    (and (consp first) (consp (event-start first))
-		 (eq (window-buffer (posn-window (event-start first)))
-		     (get-buffer "*Completions*"))
-		 (eq (key-binding key) 'mouse-choose-completion)))
-	  ;; If the user does mouse-choose-completion with the mouse,
-	  ;; execute the command, then delete the completion window.
-	  (progn
-	    (mouse-choose-completion first)
-	    (set-window-configuration conf))
-	(if (eq first ?\ )
-	    (set-window-configuration conf)
-	  (setq unread-command-events (listify-key-sequence key)))))))
-
-;; Converting process modes to use comint mode
-;; ===========================================================================
-;; The code in the Emacs 19 distribution has all been modified to use comint
-;; where needed.  However, there are `third-party' packages out there that
-;; still use the old shell mode.  Here's a guide to conversion.
-;;
-;; Renaming variables
-;; Most of the work is renaming variables and functions. These are the common
-;; ones:
-;; Local variables:
-;;	last-input-start	comint-last-input-start
-;; 	last-input-end		comint-last-input-end
-;;	shell-prompt-pattern	comint-prompt-regexp
-;;     shell-set-directory-error-hook <no equivalent>
-;; Miscellaneous:
-;;	shell-set-directory	<unnecessary>
-;; 	shell-mode-map		comint-mode-map
-;; Commands:
-;;	shell-send-input	comint-send-input
-;;	shell-send-eof		comint-delchar-or-maybe-eof
-;; 	kill-shell-input	comint-kill-input
-;;	interrupt-shell-subjob	comint-interrupt-subjob
-;;	stop-shell-subjob	comint-stop-subjob
-;;	quit-shell-subjob	comint-quit-subjob
-;;	kill-shell-subjob	comint-kill-subjob
-;;	kill-output-from-shell	comint-kill-output
-;;	show-output-from-shell	comint-show-output
-;;	copy-last-shell-input	Use comint-previous-input/comint-next-input
-;;
-;; SHELL-SET-DIRECTORY is gone, its functionality taken over by
-;; SHELL-DIRECTORY-TRACKER, the shell mode's comint-input-filter-functions.
-;; Comint mode does not provide functionality equivalent to
-;; shell-set-directory-error-hook; it is gone.
-;;
-;; comint-last-input-start is provided for modes which want to munge
-;; the buffer after input is sent, perhaps because the inferior
-;; insists on echoing the input.  The LAST-INPUT-START variable in
-;; the old shell package was used to implement a history mechanism,
-;; but you should think twice before using comint-last-input-start
-;; for this; the input history ring often does the job better.
-;; 
-;; If you are implementing some process-in-a-buffer mode, called foo-mode, do
-;; *not* create the comint-mode local variables in your foo-mode function.
-;; This is not modular.  Instead, call comint-mode, and let *it* create the
-;; necessary comint-specific local variables. Then create the
-;; foo-mode-specific local variables in foo-mode.  Set the buffer's keymap to
-;; be foo-mode-map, and its mode to be foo-mode.  Set the comint-mode hooks
-;; (comint-{prompt-regexp, input-filter, input-filter-functions,
-;; get-old-input) that need to be different from the defaults.  Call
-;; foo-mode-hook, and you're done. Don't run the comint-mode hook yourself;
-;; comint-mode will take care of it. The following example, from shell.el,
-;; is typical:
-;; 
-;; (defvar shell-mode-map '())
-;; (cond ((not shell-mode-map)
-;;        (setq shell-mode-map (copy-keymap comint-mode-map))
-;;        (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command)
-;;        (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command)
-;;        (define-key shell-mode-map "\t" 'comint-dynamic-complete)
-;;        (define-key shell-mode-map "\M-?"
-;;          'comint-dynamic-list-filename-completions)))
-;;
-;; (defun shell-mode ()
-;;   (interactive)
-;;   (comint-mode)
-;;   (setq comint-prompt-regexp shell-prompt-pattern)
-;;   (setq major-mode 'shell-mode)
-;;   (setq mode-name "Shell")
-;;   (use-local-map shell-mode-map)
-;;   (make-local-variable 'shell-directory-stack)
-;;   (setq shell-directory-stack nil)
-;;   (add-hook 'comint-input-filter-functions 'shell-directory-tracker)
-;;   (run-hooks 'shell-mode-hook))
-;;
-;;
-;; Note that make-comint is different from make-shell in that it
-;; doesn't have a default program argument. If you give make-shell
-;; a program name of NIL, it cleverly chooses one of explicit-shell-name,
-;; $ESHELL, $SHELL, or /bin/sh. If you give make-comint a program argument
-;; of NIL, it barfs. Adjust your code accordingly...
-;;
-;; Completion for comint-mode users
-;; 
-;; For modes that use comint-mode, comint-dynamic-complete-functions is the
-;; hook to add completion functions to.  Functions on this list should return
-;; non-nil if completion occurs (i.e., further completion should not occur).
-;; You could use comint-dynamic-simple-complete to do the bulk of the
-;; completion job.
-
-(provide 'comint)
-
-;; comint.el ends here
diff --git a/lisp/compare-w.el b/lisp/compare-w.el
deleted file mode 100644
index ac569963268..00000000000
--- a/lisp/compare-w.el
+++ /dev/null
@@ -1,173 +0,0 @@
-;;; compare-w.el --- compare text between windows for Emacs.
-
-;; Copyright (C) 1986, 1989, 1993 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 provides one entry point, compare-windows.  It compares
-;; text starting from point in two adjacent windows, advancing point
-;; until it finds a difference.  Option variables permit you to ignore
-;; whitespace differences, or case differences, or both.
-
-;;; Code:
-
-(defvar compare-windows-whitespace "[ \t\n]+"
-  "*Regexp that defines whitespace sequences for \\[compare-windows].
-Changes in whitespace are optionally ignored.
-
-The value of `compare-windows-whitespace' may instead be a function; this
-function is called in each buffer, with point at the current scanning point.
-The function's job is to categorize any whitespace around (including before)
-point; it should also advance past any whitespace.
-
-The function is passed one argument, the point where `compare-windows'
-was originally called; it should not consider any text before that point.
-If the function returns the same value for both buffers, then the
-whitespace is considered to match, and is skipped.")
-
-(defvar compare-ignore-case nil
-  "*Non-nil means \\[compare-windows] ignores case differences.")
-
-;;;###autoload
-(defun compare-windows (ignore-whitespace)
-  "Compare text in current window with text in next window.
-Compares the text starting at point in each window,
-moving over text in each one as far as they match.
-
-This command pushes the mark in each window
-at the prior location of point in that window.
-If both windows display the same buffer,
-the mark is pushed twice in that buffer:
-first in the other window, then in the selected window.
-
-A prefix arg means ignore changes in whitespace.
-The variable `compare-windows-whitespace' controls how whitespace is skipped.
-If `compare-ignore-case' is non-nil, changes in case are also ignored."
-  (interactive "P")
-  (let* (p1 p2 maxp1 maxp2 b1 b2 w2
-	    success size
-	    (opoint1 (point))
-	    opoint2
-	    (skip-whitespace (if ignore-whitespace
-				 compare-windows-whitespace)))
-    (setq p1 (point) b1 (current-buffer))
-    (setq w2 (next-window (selected-window)))
-    (if (eq w2 (selected-window))
-	(error "No other window"))
-    (setq p2 (window-point w2)
-	  b2 (window-buffer w2))
-    (setq opoint2 p2)
-    (setq maxp1 (point-max))
-    (save-excursion
-      (set-buffer b2)
-      (push-mark p2 t)
-      (setq maxp2 (point-max)))
-    (push-mark)
-
-    (setq success t)
-    (while success
-      (setq success nil)
-      ;; if interrupted, show how far we've gotten
-      (goto-char p1)
-      (set-window-point w2 p2)
-
-      ;; If both buffers have whitespace next to point,
-      ;; optionally skip over it.
-
-      (and skip-whitespace
-	   (save-excursion
-	     (let (p1a p2a w1 w2 result1 result2)
-	       (setq result1
-		     (if (stringp skip-whitespace)
-			 (compare-windows-skip-whitespace opoint1)
-		       (funcall skip-whitespace opoint1)))
-	       (setq p1a (point))
-	       (set-buffer b2)
-	       (goto-char p2)
-	       (setq result2
-		     (if (stringp skip-whitespace)
-			 (compare-windows-skip-whitespace opoint2)
-		       (funcall skip-whitespace opoint2)))
-	       (setq p2a (point))
-	       (if (or (stringp skip-whitespace)
-		       (and result1 result2 (eq result1 result2)))
-		   (setq p1 p1a
-			 p2 p2a)))))
-
-      ;; Try advancing comparing 1000 chars at a time.
-      ;; When that fails, go 500 chars at a time, and so on.
-      (let ((size 1000)
-	    success-1
-	    (case-fold-search compare-ignore-case))
-	(while (> size 0)
-	  (setq success-1 t)
-	  ;; Try comparing SIZE chars at a time, repeatedly, till that fails.
-	  (while success-1
-	    (setq size (min size (- maxp1 p1) (- maxp2 p2)))
-	    (setq success-1
-		  (and (> size 0)
-		       (= 0 (compare-buffer-substrings b2 p2 (+ size p2)
-						       b1 p1 (+ size p1)))))
-	    (if success-1
-		(setq p1 (+ p1 size) p2 (+ p2 size)
-		      success t)))
-	  ;; If SIZE chars don't match, try fewer.
-	  (setq size (/ size 2)))))
-
-    (goto-char p1)
-    (set-window-point w2 p2)
-    (if (= (point) opoint1)
-	(ding))))
-
-;; Move forward over whatever might be called whitespace.
-;; compare-windows-whitespace is a regexp that matches whitespace.
-;; Match it at various starting points before the original point
-;; and find the latest point at which a match ends.
-;; Don't try starting points before START, though.
-;; Value is non-nil if whitespace is found.
-
-;; If there is whitespace before point, but none after,
-;; then return t, but don't advance point.
-(defun compare-windows-skip-whitespace (start)
-  (let ((end (point))
-	(beg (point))
-	(opoint (point)))
-    (while (or (and (looking-at compare-windows-whitespace)
-		    (<= end (match-end 0))
-		    ;; This match goes past END, so advance END.
-		    (progn (setq end (match-end 0))
-			   (> (point) start)))
-	       (and (/= (point) start)
-		    ;; Consider at least the char before point,
-		    ;; unless it is also before START.
-		    (= (point) opoint)))
-      ;; keep going back until whitespace
-      ;; doesn't extend to or past end
-      (forward-char -1))
-    (setq beg (point))
-    (goto-char end)
-    (or (/= beg opoint)
-	(/= end opoint))))
-
-(provide 'compare-w)
-
-;;; compare-w.el ends here
diff --git a/lisp/complete.el b/lisp/complete.el
deleted file mode 100644
index 50855ebd804..00000000000
--- a/lisp/complete.el
+++ /dev/null
@@ -1,898 +0,0 @@
-;;; complete.el --- partial completion mechanism plus other goodies
-
-;; Copyright (C) 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Keywords: abbrev
-;; Version: 2.02
-;; Special thanks to Hallvard Furuseth for his many ideas and contributions.
-
-;; 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:
-
-;; Extended completion for the Emacs minibuffer.
-;;
-;; The basic idea is that the command name or other completable text is
-;; divided into words and each word is completed separately, so that
-;; "M-x p-b" expands to "M-x print-buffer".  If the entry is ambiguous
-;; each word is completed as much as possible and then the cursor is
-;; left at the first position where typing another letter will resolve
-;; the ambiguity.
-;;
-;; Word separators for this purpose are hyphen, space, and period.
-;; These would most likely occur in command names, Info menu items,
-;; and file names, respectively.  But all word separators are treated
-;; alike at all times.
-;;
-;; This completion package replaces the old-style completer's key
-;; bindings for TAB, SPC, RET, and `?'.  The old completer is still
-;; available on the Meta versions of those keys.  If you set
-;; PC-meta-flag to nil, the old completion keys will be left alone
-;; and the partial completer will use the Meta versions of the keys.
-
-
-;; Usage:  Load this file.  Now, during completable minibuffer entry,
-;;
-;;     TAB    means to do a partial completion;
-;;     SPC    means to do a partial complete-word;
-;;     RET    means to do a partial complete-and-exit;
-;;     ?      means to do a partial completion-help.
-;;
-;; If you set PC-meta-flag to nil, then TAB, SPC, RET, and ? perform
-;; original Emacs completions, and M-TAB etc. do partial completion.
-;; To do this, put the command,
-;;
-;;       (setq PC-meta-flag nil)
-;;
-;; in your .emacs file.  To load partial completion automatically, put
-;;
-;;       (load "complete")
-;;
-;; in your .emacs file, too.  Things will be faster if you byte-compile
-;; this file when you install it.
-;;
-;; As an extra feature, in cases where RET would not normally
-;; complete (such as `C-x b'), the M-RET key will always do a partial
-;; complete-and-exit.  Thus `C-x b f.c RET' will select or create a
-;; buffer called "f.c", but `C-x b f.c M-RET' will select the existing
-;; buffer whose name matches that pattern (perhaps "filing.c").
-;; (PC-meta-flag does not affect this behavior; M-RET used to be
-;; undefined in this situation.)
-;;
-;; The regular M-TAB (lisp-complete-symbol) command also supports
-;; partial completion in this package.
-
-;; This package also contains a wildcard feature for C-x C-f (find-file).
-;; For example, `C-x C-f *.c RET' loads all .c files at once, exactly
-;; as if you had typed C-x C-f separately for each file.  Completion
-;; is supported in connection with wildcards.  Currently only the `*'
-;; wildcard character works.
-
-;; File name completion does not do partial completion of directories
-;; on the path, e.g., "/u/b/f" will not complete to "/usr/bin/foo",
-;; but you can put *'s in the path to accomplish this:  "/u*/b*/f".
-;; Stars are required for performance reasons.
-
-;; In addition, this package includes a feature for accessing include
-;; files.  For example, `C-x C-f <sys/time.h> RET' reads the file
-;; /usr/include/sys/time.h.  The variable PC-include-file-path is a
-;; list of directories in which to search for include files.  Completion
-;; is supported in include file names.
-
-
-;;; Code:
-
-(defvar PC-meta-flag t
-  "*If nil, TAB does normal Emacs completion and M-TAB does Partial Completion.
-If t, TAB does Partial Completion and M-TAB does normal completion.")
-
-
-(defvar PC-word-delimiters "-_. "
-  "*A string of characters which are to be treated as word delimiters
-by the Partial Completion system.
-
-Some arcane rules:  If `]' is in this string it must come first.
-If `^' is in this string it must NOT come first.  If `-' is in this
-string, it must come first or right after `]'.  In other words, if
-S is this string, then `[S]' must be a legal Emacs regular expression
-\(not containing character ranges like `a-z').")
-
-
-(defvar PC-first-char 'x
-  "*If t, first character of a string to be completed is always taken literally.
-If nil, word delimiters are handled even if they appear as first character.
-This controls whether \".e\" matches \".e*\" (t) or \"*.e*\" (nil).
-If neither nil nor t, first char is literal only for filename completion.")
-
-
-(defvar PC-include-file-path '("/usr/include")
-  "*List of directories in which to look for include files.
-If this is nil, uses the colon-separated path in $INCPATH instead.")
-
-
-(defvar PC-disable-wildcards nil
-  "Set this to non-nil to disable wildcard support in \\[find-file].")
-
-(defvar PC-disable-includes nil
-  "Set this to non-nil to disable include-file support in \\[find-file].")
-
-
-(defvar PC-default-bindings t
-  "Set this to nil to suppress the default partial completion key bindings.")
-
-(if PC-default-bindings (progn
-(define-key minibuffer-local-completion-map "\t" 'PC-complete)
-(define-key minibuffer-local-completion-map " "  'PC-complete-word)
-(define-key minibuffer-local-completion-map "?"  'PC-completion-help)
-
-(define-key minibuffer-local-completion-map "\e\t" 'PC-complete)
-(define-key minibuffer-local-completion-map "\e "  'PC-complete-word)
-(define-key minibuffer-local-completion-map "\e\r" 'PC-force-complete-and-exit)
-(define-key minibuffer-local-completion-map "\e\n" 'PC-force-complete-and-exit)
-(define-key minibuffer-local-completion-map "\e?"  'PC-completion-help)
-
-(define-key minibuffer-local-must-match-map "\t" 'PC-complete)
-(define-key minibuffer-local-must-match-map " "  'PC-complete-word)
-(define-key minibuffer-local-must-match-map "\r" 'PC-complete-and-exit)
-(define-key minibuffer-local-must-match-map "\n" 'PC-complete-and-exit)
-(define-key minibuffer-local-must-match-map "?"  'PC-completion-help)
-
-(define-key minibuffer-local-must-match-map "\e\t" 'PC-complete)
-(define-key minibuffer-local-must-match-map "\e "  'PC-complete-word)
-(define-key minibuffer-local-must-match-map "\e\r" 'PC-complete-and-exit)
-(define-key minibuffer-local-must-match-map "\e\n" 'PC-complete-and-exit)
-(define-key minibuffer-local-must-match-map "\e?"  'PC-completion-help)
-
-(define-key global-map "\e\t" 'PC-lisp-complete-symbol)
-))
-
-
-(defun PC-complete ()
-  "Like minibuffer-complete, but allows \"b--di\"-style abbreviations.
-For example, \"M-x b--di\" would match `byte-recompile-directory', or any
-name which consists of three or more words, the first beginning with \"b\"
-and the third beginning with \"di\".
-
-The pattern \"b--d\" is ambiguous for `byte-recompile-directory' and
-`beginning-of-defun', so this would produce a list of completions
-just like when normal Emacs completions are ambiguous.
-
-Word-delimiters for the purposes of Partial Completion are \"-\", \"_\",
-\".\", and SPC."
-  (interactive)
-  (if (PC-was-meta-key)
-      (minibuffer-complete)
-    ;; If the previous command was not this one,
-    ;; never scroll, always retry completion.
-    (or (eq last-command this-command)
-	(setq minibuffer-scroll-window nil))
-    (let ((window minibuffer-scroll-window))
-      ;; If there's a fresh completion window with a live buffer,
-      ;; and this command is repeated, scroll that window.
-      (if (and window (window-buffer window)
-	       (buffer-name (window-buffer window)))
-	  (save-excursion
-	    (set-buffer (window-buffer window))
-	    (if (pos-visible-in-window-p (point-max) window)
-		(set-window-start window (point-min) nil)
-	      (scroll-other-window)))
-	(PC-do-completion nil)))))
-
-
-(defun PC-complete-word ()
-  "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations.
-See `PC-complete' for details.
-This can be bound to other keys, like `-' and `.', if you wish."
-  (interactive)
-  (if (eq (PC-was-meta-key) PC-meta-flag)
-      (if (eq last-command-char ? )
-	  (minibuffer-complete-word)
-	(self-insert-command 1))
-    (self-insert-command 1)
-    (if (eobp)
-	(PC-do-completion 'word))))
-
-
-(defun PC-complete-space ()
-  "Like `minibuffer-complete-word', but allows \"b--di\"-style abbreviations.
-See `PC-complete' for details.
-This is suitable for binding to other keys which should act just like SPC."
-  (interactive)
-  (if (eq (PC-was-meta-key) PC-meta-flag)
-      (minibuffer-complete-word)
-    (insert " ")
-    (if (eobp)
-	(PC-do-completion 'word))))
-
-
-(defun PC-complete-and-exit ()
-  "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations.
-See `PC-complete' for details."
-  (interactive)
-  (if (eq (PC-was-meta-key) PC-meta-flag)
-      (minibuffer-complete-and-exit)
-    (PC-do-complete-and-exit)))
-
-(defun PC-force-complete-and-exit ()
-  "Like `minibuffer-complete-and-exit', but allows \"b--di\"-style abbreviations.
-See `PC-complete' for details."
-  (interactive)
-  (let ((minibuffer-completion-confirm nil))
-    (PC-do-complete-and-exit)))
-
-(defun PC-do-complete-and-exit ()
-  (if (= (buffer-size) 0)  ; Duplicate the "bug" that Info-menu relies on...
-      (exit-minibuffer)
-    (let ((flag (PC-do-completion 'exit)))
-      (and flag
-	   (if (or (eq flag 'complete)
-		   (not minibuffer-completion-confirm))
-	       (exit-minibuffer)
-	     (PC-temp-minibuffer-message " [Confirm]"))))))
-
-
-(defun PC-completion-help ()
-  "Like `minibuffer-completion-help', but allows \"b--di\"-style abbreviations.
-See `PC-complete' for details."
-  (interactive)
-  (if (eq (PC-was-meta-key) PC-meta-flag)
-      (minibuffer-completion-help)
-    (PC-do-completion 'help)))
-
-(defun PC-was-meta-key ()
-  (or (/= (length (this-command-keys)) 1)
-      (let ((key (aref (this-command-keys) 0)))
-	(if (integerp key)
-	    (>= key 128)
-	  (not (null (memq 'meta (event-modifiers key))))))))
-
-
-(defvar PC-ignored-extensions 'empty-cache)
-(defvar PC-delims 'empty-cache)
-(defvar PC-ignored-regexp nil)
-(defvar PC-word-failed-flag nil)
-(defvar PC-delim-regex nil)
-(defvar PC-ndelims-regex nil)
-(defvar PC-delims-list nil)
-
-(defvar PC-completion-as-file-name-predicate
-  (function
-   (lambda ()
-     (memq minibuffer-completion-table
-	   '(read-file-name-internal read-directory-name-internal))))
-   "A function testing whether a minibuffer completion now will work filename-style.
-The function takes no arguments, and typically looks at the value
-of `minibuffer-completion-table' and the minibuffer contents.")
-
-(defun PC-do-completion (&optional mode beg end)
-  (or beg (setq beg (point-min)))
-  (or end (setq end (point-max)))
-  (let* ((table minibuffer-completion-table)
-	 (pred minibuffer-completion-predicate)
-	 (filename (funcall PC-completion-as-file-name-predicate))
-	 (dirname nil)
-	 dirlength
-	 (str (buffer-substring beg end))
-	 (incname (and filename (string-match "<\\([^\"<>]*\\)>?$" str)))
-	 (ambig nil)
-	 basestr
-	 regex
-	 p offset
-	 (poss nil)
-	 helpposs
-	 (case-fold-search completion-ignore-case))
-
-    ;; Check if buffer contents can already be considered complete
-    (if (and (eq mode 'exit)
-	     (PC-is-complete-p str table pred))
-	'complete
-
-      ;; Record how many characters at the beginning are not included
-      ;; in completion.
-      (setq dirlength
-	    (if filename
-		(length (file-name-directory str))
-	      0))
-
-      ;; Do substitutions in directory names
-      (and filename
-	   (not (equal str (setq p (substitute-in-file-name str))))
-	   (progn
-	     (delete-region beg end)
-	     (insert p)
-	     (setq str p end (+ beg (length str)))))
-
-      ;; Prepare various delimiter strings
-      (or (equal PC-word-delimiters PC-delims)
-	  (setq PC-delims PC-word-delimiters
-		PC-delim-regex (concat "[" PC-delims "]")
-		PC-ndelims-regex (concat "[^" PC-delims "]*")
-		PC-delims-list (append PC-delims nil)))
-
-      ;; Look for wildcard expansions in directory name
-      (and filename
-	   (string-match "\\*.*/" str)
-	   (let ((pat str)
-		 files)
-	     (setq p (1+ (string-match "/[^/]*\\'" pat)))
-	     (while (setq p (string-match PC-delim-regex pat p))
-	       (setq pat (concat (substring pat 0 p)
-				 "*"
-				 (substring pat p))
-		     p (+ p 2)))
-	     (setq files (PC-expand-many-files (concat pat "*")))
-	     (if files
-		 (let ((dir (file-name-directory (car files)))
-		       (p files))
-		   (while (and (setq p (cdr p))
-			       (equal dir (file-name-directory (car p)))))
-		   (if p
-		       (setq filename nil table nil pred nil
-			     ambig t)
-		     (delete-region beg end)
-		     (setq str (concat dir (file-name-nondirectory str)))
-		     (insert str)
-		     (setq end (+ beg (length str)))))
-	       (setq filename nil table nil pred nil))))
-
-      ;; Strip directory name if appropriate
-      (if filename
-	  (if incname
-	      (setq basestr (substring str incname)
-		    dirname (substring str 0 incname))
-	    (setq basestr (file-name-nondirectory str)
-		  dirname (file-name-directory str)))
-	(setq basestr str))
-
-      ;; Convert search pattern to a standard regular expression
-      (setq regex (regexp-quote basestr)
-	    offset (if (and (> (length regex) 0)
-			    (not (eq (aref basestr 0) ?\*))
-			    (or (eq PC-first-char t)
-				(and PC-first-char filename))) 1 0)
-	    p offset)
-      (while (setq p (string-match PC-delim-regex regex p))
-	(if (eq (aref regex p) ? )
-	    (setq regex (concat (substring regex 0 p)
-				PC-ndelims-regex
-				PC-delim-regex
-				(substring regex (1+ p)))
-		  p (+ p (length PC-ndelims-regex) (length PC-delim-regex)))
-	  (let ((bump (if (memq (aref regex p)
-				'(?$ ?^ ?\. ?* ?+ ?? ?[ ?] ?\\))
-			  -1 0)))
-	    (setq regex (concat (substring regex 0 (+ p bump))
-				PC-ndelims-regex
-				(substring regex (+ p bump)))
-		  p (+ p (length PC-ndelims-regex) 1)))))
-      (setq p 0)
-      (if filename
-	  (while (setq p (string-match "\\\\\\*" regex p))
-	    (setq regex (concat (substring regex 0 p)
-				"[^/]*"
-				(substring regex (+ p 2))))))
-      ;;(setq the-regex regex)
-      (setq regex (concat "\\`" regex))
-
-      ;; Find an initial list of possible completions
-      (if (not (setq p (string-match (concat PC-delim-regex
-					     (if filename "\\|\\*" ""))
-				     str
-				     (+ (length dirname) offset))))
-
-	  ;; Minibuffer contains no hyphens -- simple case!
-	  (setq poss (all-completions str
-				      table
-				      pred))
-
-	;; Use all-completions to do an initial cull.  This is a big win,
-	;; since all-completions is written in C!
-	(let ((compl (all-completions (substring str 0 p)
-				      table
-				      pred)))
-	  (setq p compl)
-	  (while p
-	    (and (string-match regex (car p))
-		 (progn
-		   (set-text-properties 0 (length (car p)) '() (car p))
-		   (setq poss (cons (car p) poss))))
-	    (setq p (cdr p)))))
-
-      ;; Now we have a list of possible completions
-      (cond
-
-       ;; No valid completions found
-       ((null poss)
-	(if (and (eq mode 'word)
-		 (not PC-word-failed-flag))
-	    (let ((PC-word-failed-flag t))
-	      (delete-backward-char 1)
-	      (PC-do-completion 'word))
-	  (beep)
-	  (PC-temp-minibuffer-message (if ambig
-					  " [Ambiguous dir name]"
-					(if (eq mode 'help)
-					    " [No completions]"
-					  " [No match]")))
-	  nil))
-
-       ;; More than one valid completion found
-       ((or (cdr (setq helpposs poss))
-	    (memq mode '(help word)))
-
-	;; Handle completion-ignored-extensions
-	(and filename
-	     (not (eq mode 'help))
-	     (let ((p2 poss))
-
-	       ;; Build a regular expression representing the extensions list
-	       (or (equal completion-ignored-extensions PC-ignored-extensions)
-		   (setq PC-ignored-regexp
-			 (concat "\\("
-				 (mapconcat
-				  'regexp-quote
-				  (setq PC-ignored-extensions
-					completion-ignored-extensions)
-				  "\\|")
-				 "\\)\\'")))
-
-	       ;; Check if there are any without an ignored extension
-	       (setq p nil)
-	       (while p2
-		 (or (string-match PC-ignored-regexp (car p2))
-		     (setq p (cons (car p2) p)))
-		 (setq p2 (cdr p2)))
-
-	       ;; If there are "good" names, use them
-	       (and p (setq poss p))))
-
-	;; Is the actual string one of the possible completions?
-	(setq p (and (not (eq mode 'help)) poss))
-	(while (and p
-		    (not (string-equal (car p) basestr)))
-	  (setq p (cdr p)))
-	(and p (null mode)
-	     (PC-temp-minibuffer-message " [Complete, but not unique]"))
-	(if (and p
-		 (not (and (null mode)
-			   (eq this-command last-command))))
-	    t
-
-	  ;; If ambiguous, try for a partial completion
-	  (let ((improved nil)
-		prefix
-		(pt nil)
-		(skip "\\`"))
-
-	    ;; Check if next few letters are the same in all cases
-	    (if (and (not (eq mode 'help))
-		     (setq prefix (try-completion "" (mapcar 'list poss))))
-		(let ((first t) i)
-		  (if (eq mode 'word)
-		      (setq prefix (PC-chop-word prefix basestr)))
-		  (goto-char (+ beg (length dirname)))
-		  (while (and (progn
-				(setq i 0)
-				(while (< i (length prefix))
-				  (if (and (< (point) end)
-					   (eq (aref prefix i)
-					       (following-char)))
-				      (forward-char 1)
-				    (if (and (< (point) end)
-					     (or (and (looking-at " ")
-						      (memq (aref prefix i)
-							    PC-delims-list))
-						 (eq (downcase (aref prefix i))
-						     (downcase
-						      (following-char)))))
-					(progn
-					  (delete-char 1)
-					  (setq end (1- end)))
-				      (and filename (looking-at "\\*")
-					   (progn
-					     (delete-char 1)
-					     (setq end (1- end))))
-				      (setq improved t))
-				    (insert (substring prefix i (1+ i)))
-				    (setq end (1+ end)))
-				  (setq i (1+ i)))
-				(or pt (equal (point) beg)
-				    (setq pt (point)))
-				(looking-at PC-delim-regex))
-			      (setq skip (concat skip
-						 (regexp-quote prefix)
-						 PC-ndelims-regex)
-				    prefix (try-completion
-					    ""
-					    (mapcar
-					     (function
-					      (lambda (x)
-						(list
-						 (and (string-match skip x)
-						      (substring
-						       x
-						       (match-end 0))))))
-					     poss)))
-			      (or (> i 0) (> (length prefix) 0))
-			      (or (not (eq mode 'word))
-				  (and first (> (length prefix) 0)
-				       (setq first nil
-					     prefix (substring prefix 0 1))))))
-		  (goto-char (if (eq mode 'word) end
-			       (or pt beg)))))
-
-	    (if (and (eq mode 'word)
-		     (not PC-word-failed-flag))
-
-		(if improved
-
-		    ;; We changed it... would it be complete without the space?
-		    (if (PC-is-complete-p (buffer-substring 1 (1- end))
-					  table pred)
-			(delete-region (1- end) end)))
-
-	      (if improved
-
-		  ;; We changed it... enough to be complete?
-		  (and (eq mode 'exit)
-		       (PC-is-complete-p (buffer-string) table pred))
-
-		;; If totally ambiguous, display a list of completions
-		(if (or completion-auto-help
-			(eq mode 'help))
-		    (with-output-to-temp-buffer "*Completions*"
-		      (display-completion-list (sort helpposs 'string-lessp))
-		      (save-excursion
-			(set-buffer standard-output)
-			;; Record which part of the buffer we are completing
-			;; so that choosing a completion from the list
-			;; knows how much old text to replace.
-			(setq completion-base-size dirlength)))
-		  (PC-temp-minibuffer-message " [Next char not unique]"))
-		nil)))))
-
-       ;; Only one possible completion
-       (t
-	(if (equal basestr (car poss))
-	    (if (null mode)
-		(PC-temp-minibuffer-message " [Sole completion]"))
-	  (delete-region beg end)
-	  (insert (format "%s"
-			  (if filename
-			      (substitute-in-file-name (concat dirname (car poss)))
-			    (car poss)))))
-	t)))))
-
-
-(defun PC-is-complete-p (str table pred)
-  (let ((res (if (listp table)
-		 (assoc str table)
-	       (if (vectorp table)
-		   (or (equal str "nil")   ; heh, heh, heh
-		       (intern-soft str table))
-		 (funcall table str pred 'lambda)))))
-    (and res
-	 (or (not pred)
-	     (and (not (listp table)) (not (vectorp table)))
-	     (funcall pred res))
-	 res)))
-
-(defun PC-chop-word (new old)
-  (let ((i -1)
-	(j -1))
-    (while (and (setq i (string-match PC-delim-regex old (1+ i)))
-		(setq j (string-match PC-delim-regex new (1+ j)))))
-    (if (and j
-	     (or (not PC-word-failed-flag)
-		 (setq j (string-match PC-delim-regex new (1+ j)))))
-	(substring new 0 (1+ j))
-      new)))
-
-(defvar PC-not-minibuffer nil)
-
-(defun PC-temp-minibuffer-message (m)
-  "A Lisp version of `temp_minibuffer_message' from minibuf.c."
-  (if PC-not-minibuffer
-      (progn
-	(message m)
-	(sit-for 2)
-	(message ""))
-    (if (fboundp 'temp-minibuffer-message)
-	(temp-minibuffer-message m)
-      (let ((savemax (point-max)))
-	(save-excursion
-	  (goto-char (point-max))
-	  (insert m))
-	(let ((inhibit-quit t))
-	  (sit-for 2)
-	  (delete-region savemax (point-max))
-	  (if quit-flag
-	      (setq quit-flag nil
-		    unread-command-char 7)))))))
-
-
-(defun PC-lisp-complete-symbol ()
-  "Perform completion on Lisp symbol preceding point.
-That symbol is compared against the symbols that exist
-and any additional characters determined by what is there
-are inserted.
-If the symbol starts just after an open-parenthesis,
-only symbols with function definitions are considered.
-Otherwise, all symbols with function definitions, values
-or properties are considered."
-  (interactive)
-  (let* ((end (point))
-	 (buffer-syntax (syntax-table))
-	 (beg (unwind-protect
-		  (save-excursion
-		    (if lisp-mode-syntax-table
-			(set-syntax-table lisp-mode-syntax-table))
-		    (backward-sexp 1)
-		    (while (= (char-syntax (following-char)) ?\')
-		      (forward-char 1))
-		    (point))
-		(set-syntax-table buffer-syntax)))
-	 (minibuffer-completion-table obarray)
-	 (minibuffer-completion-predicate
-	  (if (eq (char-after (1- beg)) ?\()
-	      'fboundp
-	    (function (lambda (sym)
-			(or (boundp sym) (fboundp sym)
-			    (symbol-plist sym))))))
-	 (PC-not-minibuffer t))
-    (PC-do-completion nil beg end)))
-
-
-;;; Wildcards in `C-x C-f' command.  This is independent from the main
-;;; completion code, except for `PC-expand-many-files' which is called
-;;; when "*"'s are found in the path during filename completion.  (The
-;;; above completion code always understands "*"'s, except in file paths,
-;;; without relying on the following code.)
-
-(defvar PC-many-files-list nil)
-
-(defun PC-try-load-many-files ()
-  (if (string-match "\\*" buffer-file-name)
-      (let* ((pat buffer-file-name)
-	     (files (PC-expand-many-files pat))
-	     (first (car files))
-	     (next files))
-	(kill-buffer (current-buffer))
-	(or files
-	    (error "No matching files"))
-	(save-window-excursion
-	  (while (setq next (cdr next))
-	    (let ((buf (find-file-noselect (car next))))
-	      (switch-to-buffer buf))))
-	;; This modifies the "buf" variable inside find-file-noselect.
-	(setq buf (get-file-buffer first))
-	(if buf
-	    nil   ; should do verify-visited-file-modtime stuff.
-	  (setq filename first)
-	  (setq buf (create-file-buffer filename))
-	  (set-buffer buf)
-	  (erase-buffer)
-	  (insert-file-contents filename t))
-	(if (cdr files)
-	    (setq PC-many-files-list (mapconcat
-				      (if (string-match "\\*.*/" pat)
-					  'identity
-					'file-name-nondirectory)
-				      (cdr files) ", ")
-		  find-file-hooks (cons 'PC-after-load-many-files
-					find-file-hooks)))
-	;; This modifies the "error" variable inside find-file-noselect.
-	(setq error nil)
-	t)
-    nil))
-
-(defun PC-after-load-many-files ()
-  (setq find-file-hooks (delq 'PC-after-load-many-files find-file-hooks))
-  (message "Also loaded %s." PC-many-files-list))
-
-(defun PC-expand-many-files (name)
-  (save-excursion
-    (set-buffer (generate-new-buffer " *Glob Output*"))
-    (erase-buffer)
-    (shell-command (concat "echo " name) t)
-    (goto-char (point-min))
-    (if (looking-at ".*No match")
-	nil
-      (insert "(\"")
-      (while (search-forward " " nil t)
-	(delete-backward-char 1)
-	(insert "\" \""))
-      (goto-char (point-max))
-      (delete-backward-char 1)
-      (insert "\")")
-      (goto-char (point-min))
-      (let ((files (read (current-buffer))))
-	(kill-buffer (current-buffer))
-	files))))
-
-(or PC-disable-wildcards
-    (memq 'PC-try-load-many-files find-file-not-found-hooks)
-    (setq find-file-not-found-hooks (cons 'PC-try-load-many-files
-					  find-file-not-found-hooks)))
-
-
-
-;;; Facilities for loading C header files.  This is independent from the
-;;; main completion code.  See also the variable `PC-include-file-path'
-;;; at top of this file.
-
-(defun PC-look-for-include-file ()
-  (if (string-match "[\"<]\\([^\"<>]*\\)[\">]?$" (buffer-file-name))
-      (let ((name (substring (buffer-file-name)
-			     (match-beginning 1) (match-end 1)))
-	    (punc (aref (buffer-file-name) (match-beginning 0)))
-	    (path nil)
-	    new-buf)
-	(kill-buffer (current-buffer))
-	(if (equal name "")
-	    (save-excursion
-	      (set-buffer (car (buffer-list)))
-	      (save-excursion
-		(beginning-of-line)
-		(if (looking-at
-		     "[ \t]*#[ \t]*include[ \t]+[<\"]\\(.+\\)[>\"][ \t]*[\n/]")
-		    (setq name (buffer-substring (match-beginning 1)
-						 (match-end 1))
-			  punc (char-after (1- (match-beginning 1))))
-		  ;; Suggested by Frank Siebenlist:
-		  (if (or (looking-at
-			   "[ \t]*([ \t]*load[ \t]+\"\\([^\"]+\\)\"")
-			  (looking-at
-			   "[ \t]*([ \t]*load-library[ \t]+\"\\([^\"]+\\)\"")
-			  (looking-at
-			   "[ \t]*([ \t]*require[ \t]+'\\([^\t )]+\\)[\t )]"))
-		      (progn
-			(setq name (buffer-substring (match-beginning 1)
-						     (match-end 1))
-			      punc ?\<
-			      path load-path)
-			(if (string-match "\\.elc$" name)
-			    (setq name (substring name 0 -1))
-			  (or (string-match "\\.el$" name)
-			      (setq name (concat name ".el")))))
-		    (error "Not on an #include line"))))))
-	(or (string-match "\\.[a-zA-Z0-9]+$" name)
-	    (setq name (concat name ".h")))
-	(if (eq punc ?\<)
-	    (let ((path (or path (PC-include-file-path))))
-	      (while (and path
-			  (not (file-exists-p
-				(concat (file-name-as-directory (car path))
-					name))))
-		(setq path (cdr path)))
-	      (if path
-		  (setq name (concat (file-name-as-directory (car path)) name))
-		(error "No such include file: <%s>" name)))
-	  (let ((dir (save-excursion
-		       (set-buffer (car (buffer-list)))
-		       default-directory)))
-	    (if (file-exists-p (concat dir name))
-		(setq name (concat dir name))
-	      (error "No such include file: \"%s\"" name))))
-	(setq new-buf (get-file-buffer name))
-	(if new-buf
-	    ;; no need to verify last-modified time for this!
-	    (set-buffer new-buf)
-	  (setq new-buf (create-file-buffer name))
-	  (set-buffer new-buf)
-	  (erase-buffer)
-	  (insert-file-contents name t))
-	(setq filename name
-	      error nil
-	      buf new-buf)
-	t)
-    nil))
-
-(defun PC-include-file-path ()
-  (or PC-include-file-path
-      (let ((env (getenv "INCPATH"))
-	    (path nil)
-	    pos)
-	(or env (error "No include file path specified"))
-	(while (setq pos (string-match ":[^:]+$" env))
-	  (setq path (cons (substring env (1+ pos)) path)
-		env (substring env 0 pos)))
-	path)))
-
-;;; This is adapted from lib-complete.el, by Mike Williams.
-(defun PC-include-file-all-completions (file search-path &optional full)
-  "Return all completions for FILE in any directory on SEARCH-PATH.
-If optional third argument FULL is non-nil, returned pathnames should be 
-absolute rather than relative to some directory on the SEARCH-PATH."
-  (setq search-path
-	(mapcar '(lambda (dir)
-		   (if dir (file-name-as-directory dir) default-directory))
-		search-path))
-  (if (file-name-absolute-p file)
-      ;; It's an absolute file name, so don't need search-path
-      (progn
-	(setq file (expand-file-name file))
-	(file-name-all-completions 
-	 (file-name-nondirectory file) (file-name-directory file)))
-    (let ((subdir (file-name-directory file))
-	  (ndfile (file-name-nondirectory file))
-	  file-lists)
-      ;; Append subdirectory part to each element of search-path
-      (if subdir
-	  (setq search-path
-		(mapcar '(lambda (dir) (concat dir subdir))
-			search-path)
-		file ))
-      ;; Make list of completions in each directory on search-path
-      (while search-path
-	(let* ((dir (car search-path))
-	       (subdir (if full dir subdir)))
-	  (if (file-directory-p dir)
-	      (progn
-		(setq file-lists
-		      (cons 
-		       (mapcar '(lambda (file) (concat subdir file))
-			       (file-name-all-completions ndfile 
-							  (car search-path)))
-		       file-lists))))
-	  (setq search-path (cdr search-path))))
-      ;; Compress out duplicates while building complete list (slloooow!)
-      (let ((sorted (sort (apply 'nconc file-lists)
-			  '(lambda (x y) (not (string-lessp x y)))))
-	    compressed)
-	(while sorted
-	  (if (equal (car sorted) (car compressed)) nil
-	    (setq compressed (cons (car sorted) compressed)))
-	  (setq sorted (cdr sorted)))
-	compressed))))
-
-(defvar PC-old-read-file-name-internal nil)
-
-(defun PC-read-include-file-name-internal (string dir action)
-  (if (string-match "<\\([^\"<>]*\\)>?$" string)
-      (let* ((name (substring string (match-beginning 1) (match-end 1)))
-	     (str2 (substring string (match-beginning 0)))
-	     (completion-table
-	      (mapcar (function (lambda (x) (list (format "<%s>" x))))
-		      (PC-include-file-all-completions
-		       name (PC-include-file-path)))))
-	(cond
-	 ((not completion-table) nil)
-	 ((eq action nil) (try-completion str2 completion-table nil))
-	 ((eq action t) (all-completions str2 completion-table nil))
-	 ((eq action 'lambda)
-	  (eq (try-completion str2 completion-table nil) t))))
-    (funcall PC-old-read-file-name-internal string dir action)))
-
-(or PC-disable-includes
-    (memq 'PC-look-for-include-file find-file-not-found-hooks)
-    (setq find-file-not-found-hooks (cons 'PC-look-for-include-file
-					  find-file-not-found-hooks)))
-
-(or PC-disable-includes
-    PC-old-read-file-name-internal
-    (progn
-      (setq PC-old-read-file-name-internal
-	    (symbol-function 'read-file-name-internal))
-      (fset 'read-file-name-internal 'PC-read-include-file-name-internal)))
-
-
-(provide 'complete)
-
-;;; End.
diff --git a/lisp/completion.el b/lisp/completion.el
deleted file mode 100644
index 6ef505781e4..00000000000
--- a/lisp/completion.el
+++ /dev/null
@@ -1,2683 +0,0 @@
-;;; completion.el --- dynamic word-completion code
-
-;; Copyright (C) 1990, 1993, 1995 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: abbrev
-;; Author: Jim Salem <alem@bbnplanet.com> of Thinking Machines Inc.
-;;  (ideas suggested by Brewster Kahle)
-
-;; 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:
-
-;; What to put in .emacs
-;;-----------------------
-;; (load "completion")
-;; (initialize-completions)
-
-;;---------------------------------------------------------------------------
-;; Documentation [Slightly out of date]
-;;---------------------------------------------------------------------------
-;;  (also check the documentation string of the functions)
-;;
-;; Introduction
-;;---------------
-;;  
-;;     After you type a few characters, pressing the "complete" key inserts
-;; the rest of the word you are likely to type.  
-;;
-;; This watches all the words that you type and remembers them.  When 
-;; typing a new word, pressing "complete" (meta-return) "completes" the
-;; word by inserting the most recently used word that begins with the 
-;; same characters.  If you press meta-return repeatedly, it cycles
-;; through all the words it knows about.
-;;
-;;  If you like the completion then just continue typing, it is as if you
-;; entered the text by hand.  If you want the inserted extra characters 
-;; to go away, type control-w or delete.  More options are described below.
-;;
-;;  The guesses are made in the order of the most recently "used".  Typing
-;; in a word and then typing a separator character (such as a space) "uses" 
-;; the word.  So does moving a cursor over the word.  If no words are found, 
-;; it uses an extended version of the dabbrev style completion.
-;;
-;;   You automatically save the completions you use to a file between 
-;; sessions.  
-;;
-;;   Completion enables programmers to enter longer, more descriptive 
-;; variable names while typing fewer keystrokes than they normally would.
-;;
-;;
-;; Full documentation
-;;---------------------
-;;
-;;   A "word" is any string containing characters with either word or symbol 
-;; syntax.  [E.G. Any alphanumeric string with hyphens, underscores, etc.]
-;; Unless you change the constants, you must type at least three characters
-;; for the word to be recognized.  Only words longer than 6 characters are
-;; saved.
-;;
-;;   When you load this file, completion will be on.  I suggest you use the
-;; compiled version (because it is noticeably faster).
-;;
-;;  M-X completion-mode toggles whether or not new words are added to the
-;; database by changing the value of enable-completion.
-;;
-;;  SAVING/LOADING COMPLETIONS
-;;   Completions are automatically saved from one session to another
-;; (unless save-completions-flag or enable-completion is nil).
-;; Loading this file (or calling initialize-completions) causes EMACS
-;; to load a completions database for a saved completions file 
-;; (default: ~/.completions).  When you exit, EMACS saves a copy of the
-;; completions that you 
-;; often use.  When you next start, EMACS loads in the saved completion file.
-;;
-;;   The number of completions saved depends loosely on 
-;; *saved-completions-decay-factor*.  Completions that have never been 
-;; inserted via "complete" are not saved.  You are encouraged to experiment
-;; with different functions (see compute-completion-min-num-uses).
-;;
-;;   Some completions are permanent and are always saved out.  These 
-;; completions have their num-uses slot set to T.  Use 
-;; add-permanent-completion to do this
-;;
-;;   Completions are saved only if enable-completion is T.  The number of old
-;; versions kept of the saved completions file is controlled by 
-;; completions-file-versions-kept.
-;;
-;; COMPLETE KEY OPTIONS
-;;   The complete function takes a numeric arguments.  
-;;  control-u :: leave the point at the beginning of the completion rather 
-;;               than the middle.
-;;  a number  :: rotate through the possible completions by that amount
-;;  `-'       :: same as -1 (insert previous completion)
-;;
-;; HOW THE DATABASE IS MAINTAINED
-;;  <write>
-;;
-;; UPDATING THE DATABASE MANUALLY
-;;   m-x kill-completion 
-;;     kills the completion at point.
-;;   m-x add-completion
-;;   m-x add-permanent-completion
-;;   
-;; UPDATING THE DATABASE FROM A SOURCE CODE FILE
-;;   m-x add-completions-from-buffer
-;;     Parses all the definition names from a C or LISP mode buffer and
-;;     adds them to the completion database.
-;;
-;;   m-x add-completions-from-lisp-file 
-;;     Parses all the definition names from a C or Lisp mode file and
-;;     adds them to the completion database.
-;;
-;; UPDATING THE DATABASE FROM A TAGS TABLE
-;;   m-x add-completions-from-tags-table
-;;     Adds completions from the current tags-table-buffer.
-;;
-;; HOW A COMPLETION IS FOUND
-;;  <write>
-;;
-;; STRING CASING
-;;   Completion is string case independent if case-fold-search has its 
-;;  normal default of T.  Also when the completion is inserted the case of the
-;;  entry is coerced appropriately.  
-;;  [E.G.  APP --> APPROPRIATELY     app --> appropriately  
-;;         App --> Appropriately]
-;;
-;; INITIALIZATION
-;;  The form `(initialize-completions)' initializes the completion system by 
-;; trying to load in the user's completions.  After the first cal, further 
-;; calls have no effect so one should be careful not to put the form in a 
-;; site's standard site-init file.
-;;
-;;---------------------------------------------------------------------------
-;;
-;;
-
-;;---------------------------------------------------------------------------
-;; Functions you might like to call
-;;---------------------------------------------------------------------------
-;;
-;;  add-completion  string &optional num-uses
-;;    Adds a new string to the database
-;;
-;;  add-permanent-completion  string
-;;    Adds a new string to the database with num-uses = T
-;;
-
-;;  kill-completion string
-;;    Kills the completion from the database.
-;;
-;;  clear-all-completions
-;;    Clears the database
-;;
-;;  list-all-completions
-;;    Returns a list of all completions.
-;;
-;;
-;;  next-completion string &optional index
-;;    Returns a completion entry that starts with string.
-;;
-;;  find-exact-completion string
-;;    Returns a completion entry that exactly matches string.
-;;
-;;  complete
-;;    Inserts a completion at point
-;;
-;;  initialize-completions
-;;    Loads the completions file and sets up so that exiting emacs will 
-;;  save them.
-;;
-;;  save-completions-to-file &optional filename  
-;;  load-completions-from-file &optional filename
-;;
-;;-----------------------------------------------
-;; Other functions
-;;-----------------------------------------------
-;;
-;;  get-completion-list string
-;;
-;; These things are for manipulating the structure
-;;  make-completion string num-uses
-;;  completion-num-uses completion 
-;;  completion-string completion
-;;  set-completion-num-uses completion num-uses
-;;  set-completion-string completion string
-;;  
-;;
-
-;;-----------------------------------------------
-;; To Do :: (anybody ?)
-;;-----------------------------------------------
-;;
-;;   Implement Lookup and keyboard interface in C
-;;   Add package prefix smarts (for Common Lisp)
-;;   Add autoprompting of possible completions after every keystroke (fast
-;;      terminals only !)
-;;   Add doc. to texinfo
-;;
-;;
-;;-----------------------------------------------
-;;; Change Log:
-;;-----------------------------------------------
-;;    Sometime in '84 Brewster implemented a somewhat buggy version for 
-;; Symbolics LISPMs.
-;;    Jan. '85 Jim became enamored of the idea and implemented a faster, 
-;; more robust version.
-;;    With input from many users at TMC, (rose, craig, and gls come to mind),
-;; the current style of interface was developed. 
-;;    9/87, Jim and Brewster took terminals home.  Yuck.  After 
-;; complaining for a while Brewster implemented a subset of the current 
-;; LISPM version for GNU Emacs.  
-;;    8/88  After complaining for a while (and with sufficient 
-;; promised rewards), Jim reimplemented a version of GNU completion
-;; superior to that of the LISPM version.
-;;
-;;-----------------------------------------------
-;; Acknowledgements
-;;-----------------------------------------------
-;;  Cliff Lasser (cal@think.com), Kevin Herbert (kph@cisco.com),
-;;  eero@media-lab, kgk@cs.brown.edu, jla@ai.mit.edu,
-;;
-;;-----------------------------------------------
-;; Change Log
-;;-----------------------------------------------
-;; From version 9 to 10
-;;  - Allowance for non-integral *completion-version* nos.
-;;  - Fix cmpl-apply-as-top-level for keyboard macros
-;;  - Fix broken completion merging (in save-completions-to-file)
-;;  - More misc. fixes for version 19.0 of emacs
-;;
-;; From Version 8 to 9
-;;  - Ported to version 19.0 of emacs (backcompatible with version 18)
-;;  - Added add-completions-from-tags-table (with thanks to eero@media-lab)
-;;
-;; From Version 7 to 8
-;;  - Misc. changes to comments
-;;  - new completion key bindings: c-x o, M->, M-<, c-a, c-e
-;;  - cdabbrev now checks all the visible window buffers and the "other buffer"
-;;  - `%' is now a symbol character rather than a separator (except in C mode)
-;;
-;; From Version 6 to 7
-;;  - Fixed bug with saving out .completion file the first time
-;;
-;; From Version 5 to 6
-;;  - removed statistics recording
-;;  - reworked advise to handle autoloads
-;;  - Fixed fortran mode support
-;;  - Added new cursor motion triggers
-;;
-;; From Version 4 to 5
-;;  - doesn't bother saving if nothing has changed
-;;  - auto-save if haven't used for a 1/2 hour
-;;  - save period extended to two weeks
-;;  - minor fix to capitalization code
-;;  - added *completion-auto-save-period* to variables recorded.
-;;  - added reenter protection to cmpl-record-statistics-filter
-;;  - added backup protection to save-completions-to-file (prevents 
-;;    problems with disk full errors)
-
-;;; Code:
-
-;;---------------------------------------------------------------------------
-;; User changeable parameters
-;;---------------------------------------------------------------------------
-
-(defvar enable-completion t
-  "*Non-nil means enable recording and saving of completions.
-If nil, no new words added to the database or saved to the init file.")
-
-(defvar save-completions-flag t
-  "*Non-nil means save most-used completions when exiting Emacs.
-See also `saved-completions-retention-time'.")
-
-(defvar save-completions-file-name (convert-standard-filename "~/.completions")
-  "*The filename to save completions to.")
-
-(defvar save-completions-retention-time 336
-  "*Discard a completion if unused for this many hours.
-\(1 day = 24, 1 week = 168).  If this is 0, non-permanent completions
-will not be saved unless these are used.  Default is two weeks.")
-
-(defvar completion-on-separator-character nil
-  "*Non-nil means separator characters mark previous word as used.
-This means the word will be saved as a completion.")
-
-(defvar completions-file-versions-kept kept-new-versions
-  "*Number of versions to keep for the saved completions file.")
-
-(defvar completion-prompt-speed-threshold 4800
-  "*Minimum output speed at which to display next potential completion.")
-
-(defvar completion-cdabbrev-prompt-flag nil
-  "*If non-nil, the next completion prompt does a cdabbrev search.
-This can be time consuming.")
-
-(defvar completion-search-distance 15000
-  "*How far to search in the buffer when looking for completions.
-In number of characters.  If nil, search the whole buffer.")
-
-(defvar completions-merging-modes '(lisp c)
-  "*List of modes {`c' or `lisp'} for automatic completions merging.
-Definitions from visited files which have these modes
-are automatically added to the completion database.")
-
-;;(defvar *record-cmpl-statistics-p* nil
-;;  "*If non-nil, record completion statistics.")
-
-;;(defvar *completion-auto-save-period* 1800
-;;  "*The period in seconds to wait for emacs to be idle before autosaving
-;;the completions.  Default is a 1/2 hour.")
-
-(defconst completion-min-length nil ;; defined below in eval-when
-  "*The minimum length of a stored completion.
-DON'T CHANGE WITHOUT RECOMPILING !  This is used by macros.")
-
-(defconst completion-max-length nil ;; defined below in eval-when
-  "*The maximum length of a stored completion.
-DON'T CHANGE WITHOUT RECOMPILING !  This is used by macros.")
-
-(defconst completion-prefix-min-length nil ;; defined below in eval-when
-  "The minimum length of a completion search string.
-DON'T CHANGE WITHOUT RECOMPILING !  This is used by macros.")
-
-(defmacro eval-when-compile-load-eval (&rest body)
-  ;; eval everything before expanding
-  (mapcar 'eval body)
-  (cons 'progn body))
-
-(eval-when-compile
-  (defvar completion-gensym-counter 0)
-  (defun completion-gensym (&optional arg)
-    "Generate a new uninterned symbol.
-The name is made by appending a number to PREFIX, default \"G\"."
-    (let ((prefix (if (stringp arg) arg "G"))
-	  (num (if (integerp arg) arg
-		 (prog1 completion-gensym-counter
-		   (setq completion-gensym-counter (1+ completion-gensym-counter))))))
-      (make-symbol (format "%s%d" prefix num)))))
-
-(defmacro completion-dolist (spec &rest body)
-  "(completion-dolist (VAR LIST [RESULT]) BODY...): loop over a list.
-Evaluate BODY with VAR bound to each `car' from LIST, in turn.
-Then evaluate RESULT to get return value, default nil."
-  (let ((temp (completion-gensym "--dolist-temp--")))
-    (append (list 'let (list (list temp (nth 1 spec)) (car spec))
-		  (append (list 'while temp
-				(list 'setq (car spec) (list 'car temp)))
-			  body (list (list 'setq temp
-					   (list 'cdr temp)))))
-	    (if (cdr (cdr spec))
-		(cons (list 'setq (car spec) nil) (cdr (cdr spec)))
-	      '(nil)))))
-
-(defun completion-eval-when ()
-  (eval-when-compile-load-eval
-   ;; These vars. are defined at both compile and load time.
-   (setq completion-min-length 6)
-   (setq completion-max-length 200)
-   (setq completion-prefix-min-length 3)))
-
-(completion-eval-when)
- 
-;;---------------------------------------------------------------------------
-;; Internal Variables
-;;---------------------------------------------------------------------------
-
-(defvar cmpl-initialized-p nil
-  "Set to t when the completion system is initialized.
-Indicates that the old completion file has been read in.")
-
-(defvar cmpl-completions-accepted-p nil
-  "Set to t as soon as the first completion has been accepted.
-Used to decide whether to save completions.")
-
-(defvar cmpl-preceding-syntax)
-
-(defvar completion-string)
-
-;;---------------------------------------------------------------------------
-;; Low level tools
-;;---------------------------------------------------------------------------
-
-;;-----------------------------------------------
-;; Misc.
-;;-----------------------------------------------
-
-(defun minibuffer-window-selected-p ()
-  "True iff the current window is the minibuffer."
-  (window-minibuffer-p (selected-window)))
-
-;; This used to be `(eval form)'.  Eval FORM at run time now.
-(defmacro cmpl-read-time-eval (form)
-  form)
-
-;;-----------------------------------------------
-;; String case coercion
-;;-----------------------------------------------
-
-(defun cmpl-string-case-type (string)
-  "Returns :capitalized, :up, :down, :mixed, or :neither."
-  (let ((case-fold-search nil))
-    (cond ((string-match "[a-z]" string)
-	   (cond ((string-match "[A-Z]" string)
-		  (cond ((and (> (length string) 1)
-			      (null (string-match "[A-Z]" string 1)))
-			 ':capitalized)
-			(t
-			 ':mixed)))
-		 (t ':down)))
-	  (t
-	   (cond ((string-match "[A-Z]" string)
-		  ':up)
-		 (t ':neither))))
-    ))
-
-;; Tests -
-;; (cmpl-string-case-type "123ABCDEF456") --> :up
-;; (cmpl-string-case-type "123abcdef456") --> :down
-;; (cmpl-string-case-type "123aBcDeF456") --> :mixed
-;; (cmpl-string-case-type "123456")       --> :neither
-;; (cmpl-string-case-type "Abcde123")     --> :capitalized
-
-(defun cmpl-coerce-string-case (string case-type)
-  (cond ((eq case-type ':down) (downcase string))
-	((eq case-type ':up) (upcase string))
-	((eq case-type ':capitalized)
-	 (setq string (downcase string))
-	 (aset string 0 (logand ?\337 (aref string 0)))
-	 string)
-	(t string)
-	))
-
-(defun cmpl-merge-string-cases (string-to-coerce given-string)
-  (let ((string-case-type (cmpl-string-case-type string-to-coerce))
-	)
-    (cond ((memq string-case-type '(:down :up :capitalized))
-	   ;; Found string is in a standard case.  Coerce to a type based on
-	   ;; the given string
-	   (cmpl-coerce-string-case string-to-coerce
-			       (cmpl-string-case-type given-string))
-	   )
-	  (t
-	   ;; If the found string is in some unusual case, just insert it
-	   ;; as is
-	   string-to-coerce)
-	  )))
-
-;; Tests -
-;; (cmpl-merge-string-cases "AbCdEf456" "abc")     --> AbCdEf456
-;; (cmpl-merge-string-cases "abcdef456" "ABC")     --> ABCDEF456
-;; (cmpl-merge-string-cases "ABCDEF456" "Abc")     --> Abcdef456
-;; (cmpl-merge-string-cases "ABCDEF456" "abc")     --> abcdef456
-
-
-(defun cmpl-hours-since-origin ()
-  (let ((time (current-time)))
-    (floor (+ (* 65536.0 (nth 0 time)) (nth 1 time)) 3600)))
-
-;;---------------------------------------------------------------------------
-;; "Symbol" parsing functions
-;;---------------------------------------------------------------------------
-;; The functions symbol-before-point, symbol-under-point, etc. quickly return
-;; an appropriate symbol string.  The strategy is to temporarily change
-;; the syntax table to enable fast symbol searching.  There are three classes
-;; of syntax in these "symbol" syntax tables ::
-;;
-;; syntax (?_) - "symbol" chars (e.g. alphanumerics)
-;; syntax (?w) - symbol chars to ignore at end of words (e.g. period).  
-;; syntax (? ) - everything else
-;;
-;; Thus by judicious use of scan-sexps and forward-word, we can get
-;; the word we want relatively fast and without consing.  
-;;
-;; Why do we need a separate category for "symbol chars to ignore at ends" ?
-;; For example, in LISP we want starting :'s trimmed 
-;; so keyword argument specifiers also define the keyword completion.  And,
-;; for example, in C we want `.' appearing in a structure ref. to
-;; be kept intact in order to store the whole structure ref.; however, if 
-;; it appears at the end of a symbol it should be discarded because it is
-;; probably used as a period.
-
-;; Here is the default completion syntax ::
-;; Symbol chars :: A-Z a-z 0-9 @ / \ * + ~ $ < > %
-;; Symbol chars to ignore at ends :: _ : . -
-;; Separator chars. :: <tab> <space> ! ^ & ( ) = ` | { } [ ] ; " ' #
-;;                     , ? <Everything else>
-
-;; Mode specific differences and notes ::
-;;  LISP diffs ->
-;;    Symbol chars :: ! & ? = ^
-;;
-;; C diffs ->
-;;   Separator chars :: + * / : %
-;;  A note on the hyphen (`-').  Perhaps the hyphen should also be a separator
-;; char., however, we wanted to have completion symbols include pointer 
-;; references.  For example, "foo->bar" is a symbol as far as completion is
-;; concerned.
-;;
-;; FORTRAN diffs ->
-;;   Separator chars :: + - * / :
-;;
-;; Pathname diffs ->
-;;   Symbol chars :: .
-;;  Of course there is no pathname "mode" and in fact we have not implemented
-;; this table.  However, if there was such a mode, this is what it would look
-;; like.
-
-;;-----------------------------------------------
-;; Table definitions
-;;-----------------------------------------------
-
-(defun cmpl-make-standard-completion-syntax-table ()
-  (let ((table (make-syntax-table))
-	i)
-    ;; Default syntax is whitespace.
-    (setq i 0)
-    (while (< i 256)
-      (modify-syntax-entry i " " table)
-      (setq i (1+ i)))
-    ;; alpha chars
-    (setq i 0)
-    (while (< i 26)
-      (modify-syntax-entry (+ ?a i) "_" table)
-      (modify-syntax-entry (+ ?A i) "_" table)
-      (setq i (1+ i)))
-    ;; digit chars.
-    (setq i 0)
-    (while (< i 10)
-      (modify-syntax-entry (+ ?0 i) "_" table)
-      (setq i (1+ i)))
-    ;; Other ones
-    (let ((symbol-chars '(?@ ?/ ?\\ ?* ?+ ?~ ?$ ?< ?> ?%))
-	  (symbol-chars-ignore '(?_ ?- ?: ?.))
-	  )
-      (completion-dolist (char symbol-chars)
-	(modify-syntax-entry char "_" table))
-      (completion-dolist (char symbol-chars-ignore)
-	(modify-syntax-entry char "w" table)
-	)
-      )
-    table))
-
-(defconst cmpl-standard-syntax-table (cmpl-make-standard-completion-syntax-table))
-
-(defun cmpl-make-lisp-completion-syntax-table ()
-  (let ((table (copy-syntax-table cmpl-standard-syntax-table))
-	(symbol-chars '(?! ?& ?? ?= ?^))
-	)
-    (completion-dolist (char symbol-chars)
-      (modify-syntax-entry char "_" table))
-    table))
-	   
-(defun cmpl-make-c-completion-syntax-table ()
-  (let ((table (copy-syntax-table cmpl-standard-syntax-table))
-	(separator-chars '(?+ ?* ?/ ?: ?%))
-	)
-    (completion-dolist (char separator-chars)
-      (modify-syntax-entry char " " table))
-    table))
-
-(defun cmpl-make-fortran-completion-syntax-table ()
-  (let ((table (copy-syntax-table cmpl-standard-syntax-table))
-	(separator-chars '(?+ ?- ?* ?/ ?:))
-	)
-    (completion-dolist (char separator-chars)
-      (modify-syntax-entry char " " table))
-    table))
-
-(defconst cmpl-lisp-syntax-table       (cmpl-make-lisp-completion-syntax-table))
-(defconst cmpl-c-syntax-table          (cmpl-make-c-completion-syntax-table))
-(defconst cmpl-fortran-syntax-table    (cmpl-make-fortran-completion-syntax-table))
-
-(defvar cmpl-syntax-table cmpl-standard-syntax-table
-  "This variable holds the current completion syntax table.")
-(make-variable-buffer-local 'cmpl-syntax-table)
-
-;;-----------------------------------------------
-;; Installing the appropriate mode tables
-;;-----------------------------------------------
-
-(add-hook 'lisp-mode-hook
-	  '(lambda ()
-	     (setq cmpl-syntax-table cmpl-lisp-syntax-table)))
-
-(add-hook 'c-mode-hook
-	  '(lambda ()
-	     (setq cmpl-syntax-table cmpl-c-syntax-table)))
-
-(add-hook 'fortran-mode-hook
-	  '(lambda ()
-	     (setq cmpl-syntax-table cmpl-fortran-syntax-table)
-	     (completion-setup-fortran-mode)))
-
-;;-----------------------------------------------
-;; Symbol functions
-;;-----------------------------------------------
-(defvar cmpl-symbol-start nil
-  "Holds first character of symbol, after any completion symbol function.")
-(defvar cmpl-symbol-end nil
-  "Holds last character of symbol, after any completion symbol function.")
-;; These are temp. vars. we use to avoid using let.
-;;   Why ?  Small speed improvement.
-(defvar cmpl-saved-syntax nil)
-(defvar cmpl-saved-point nil)
-
-(defun symbol-under-point ()
-  "Returns the symbol that the point is currently on.
-But only if it is longer than `completion-min-length'."
-  (setq cmpl-saved-syntax (syntax-table))
-  (unwind-protect
-      (progn
-	(set-syntax-table cmpl-syntax-table)
-	(cond 
-	;; Cursor is on following-char and after preceding-char
-	  ((memq (char-syntax (following-char)) '(?w ?_))     
-	   (setq cmpl-saved-point (point)
-		 cmpl-symbol-start (scan-sexps (1+ cmpl-saved-point) -1)
-		 cmpl-symbol-end (scan-sexps cmpl-saved-point 1))
-	   ;; Remove chars to ignore at the start.
-	   (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
-		  (goto-char cmpl-symbol-start)
-		  (forward-word 1)
-		  (setq cmpl-symbol-start (point))
-		  (goto-char cmpl-saved-point)
-		  ))
-	   ;; Remove chars to ignore at the end.
-	   (cond ((= (char-syntax (char-after (1- cmpl-symbol-end))) ?w)
-		  (goto-char cmpl-symbol-end)
-		  (forward-word -1)
-		  (setq cmpl-symbol-end (point))
-		  (goto-char cmpl-saved-point)
-		  ))
-	   ;; Return completion if the length is reasonable.
-	   (if (and (<= (cmpl-read-time-eval completion-min-length)
-			(- cmpl-symbol-end cmpl-symbol-start))
-		    (<= (- cmpl-symbol-end cmpl-symbol-start)
-			(cmpl-read-time-eval completion-max-length)))
-	       (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))
-    (set-syntax-table cmpl-saved-syntax)))
-
-;; tests for symbol-under-point
-;;  `^' indicates cursor pos. where value is returned
-;;  simple-word-test
-;;  ^^^^^^^^^^^^^^^^  --> simple-word-test
-;;  _harder_word_test_
-;;  ^^^^^^^^^^^^^^^^^^ --> harder_word_test
-;;  .___.______.
-;;  --> nil
-;;  /foo/bar/quux.hello
-;;  ^^^^^^^^^^^^^^^^^^^ --> /foo/bar/quux.hello
-;;
-
-(defun symbol-before-point ()
-  "Returns a string of the symbol immediately before point.
-Returns nil if there isn't one longer than `completion-min-length'."       
-  ;; This is called when a word separator is typed so it must be FAST !
-  (setq cmpl-saved-syntax (syntax-table))
-  (unwind-protect
-      (progn
-	(set-syntax-table cmpl-syntax-table)
-	;; Cursor is on following-char and after preceding-char
-	(cond ((= (setq cmpl-preceding-syntax (char-syntax (preceding-char))) ?_)
-	       ;; Number of chars to ignore at end.
-	       (setq cmpl-symbol-end (point)
-		     cmpl-symbol-start (scan-sexps cmpl-symbol-end -1)
-		     )
-	       ;; Remove chars to ignore at the start.
-	       (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
-		      (goto-char cmpl-symbol-start)
-		      (forward-word 1)
-		      (setq cmpl-symbol-start (point))
-		      (goto-char cmpl-symbol-end)
-		      ))
-	       ;; Return value if long enough.
-	       (if (>= cmpl-symbol-end
-		       (+ cmpl-symbol-start
-			  (cmpl-read-time-eval completion-min-length)))
-		   (buffer-substring cmpl-symbol-start cmpl-symbol-end))
-	       )
-	      ((= cmpl-preceding-syntax ?w)
-	       ;; chars to ignore at end
-	       (setq cmpl-saved-point (point)
-		     cmpl-symbol-start (scan-sexps cmpl-saved-point -1))
-	       ;; take off chars. from end
-	       (forward-word -1)
-	       (setq cmpl-symbol-end (point))
-	       ;; remove chars to ignore at the start
-	       (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
-		      (goto-char cmpl-symbol-start)
-		      (forward-word 1)
-		      (setq cmpl-symbol-start (point))
-		      ))
-	       ;; Restore state.
-	       (goto-char cmpl-saved-point)
-	       ;; Return completion if the length is reasonable
-	       (if (and (<= (cmpl-read-time-eval completion-min-length)
-			    (- cmpl-symbol-end cmpl-symbol-start))
-			(<= (- cmpl-symbol-end cmpl-symbol-start)
-			    (cmpl-read-time-eval completion-max-length)))
-		   (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))
-    (set-syntax-table cmpl-saved-syntax)))
-
-;; tests for symbol-before-point
-;;  `^' indicates cursor pos. where value is returned
-;;  simple-word-test
-;;  ^ --> nil
-;;   ^ --> nil
-;;          ^  --> simple-w
-;;                  ^ --> simple-word-test
-;;  _harder_word_test_
-;;                   ^  --> harder_word_test
-;;                    ^  --> harder_word_test
-;;          ^ --> harder
-;;  .___....
-;;  --> nil
-
-(defun symbol-under-or-before-point ()
-  ;; This could be made slightly faster but it is better to avoid
-  ;; copying all the code.
-  ;; However, it is only used by the completion string prompter.
-  ;; If it comes into common use, it could be rewritten.
-  (cond ((memq (progn
-		 (setq cmpl-saved-syntax (syntax-table))
-		 (unwind-protect
-		     (progn
-		       (set-syntax-table cmpl-syntax-table)
-		       (char-syntax (following-char)))
-		   (set-syntax-table cmpl-saved-syntax)))
-	       '(?w ?_))
-	 (symbol-under-point))
-	(t
-	 (symbol-before-point))))
-
-
-(defun symbol-before-point-for-complete ()
-  ;; "Returns a string of the symbol immediately before point
-  ;; or nil if there isn't one.  Like symbol-before-point but doesn't trim the
-  ;; end chars."
-  ;; Cursor is on following-char and after preceding-char
-  (setq cmpl-saved-syntax (syntax-table))
-  (unwind-protect
-      (progn
-	(set-syntax-table cmpl-syntax-table)
-	(cond ((memq (setq cmpl-preceding-syntax (char-syntax (preceding-char)))
-		     '(?_ ?w))
-	       (setq cmpl-symbol-end (point)
-		     cmpl-symbol-start (scan-sexps cmpl-symbol-end -1)
-		     )
-	       ;; Remove chars to ignore at the start.
-	       (cond ((= (char-syntax (char-after cmpl-symbol-start)) ?w)
-		      (goto-char cmpl-symbol-start)
-		      (forward-word 1)
-		      (setq cmpl-symbol-start (point))
-		      (goto-char cmpl-symbol-end)
-		      ))
-	       ;; Return completion if the length is reasonable.
-	       (if (and (<= (cmpl-read-time-eval
-			     completion-prefix-min-length)
-			    (- cmpl-symbol-end cmpl-symbol-start))
-			(<= (- cmpl-symbol-end cmpl-symbol-start)
-			    (cmpl-read-time-eval completion-max-length)))
-		   (buffer-substring cmpl-symbol-start cmpl-symbol-end)))))
-    ;; Restore syntax table.
-    (set-syntax-table cmpl-saved-syntax)))
-
-;; tests for symbol-before-point-for-complete
-;;  `^' indicates cursor pos. where value is returned
-;;  simple-word-test
-;;  ^ --> nil
-;;   ^ --> nil
-;;          ^  --> simple-w
-;;                  ^ --> simple-word-test
-;;  _harder_word_test_
-;;                   ^  --> harder_word_test
-;;                    ^  --> harder_word_test_
-;;          ^ --> harder_
-;;  .___....
-;;  --> nil
-
-
-
-;;---------------------------------------------------------------------------
-;; Statistics Recording
-;;---------------------------------------------------------------------------
-
-;; Note that the guts of this has been turned off.  The guts
-;; are in completion-stats.el.
-
-;;-----------------------------------------------
-;; Conditionalizing code on *record-cmpl-statistics-p*
-;;-----------------------------------------------
-;; All statistics code outside this block should use this
-(defmacro cmpl-statistics-block (&rest body))
-;;  "Only executes body if we are recording statistics."
-;;  (list 'cond
-;;	(list* '*record-cmpl-statistics-p* body)
-;;	))		 
-
-;;-----------------------------------------------
-;; Completion Sources
-;;-----------------------------------------------
-
-;; ID numbers
-(defconst cmpl-source-unknown 0)
-(defconst cmpl-source-init-file 1)
-(defconst cmpl-source-file-parsing 2)
-(defconst cmpl-source-separator 3)
-(defconst cmpl-source-cursor-moves 4)
-(defconst cmpl-source-interactive 5)
-(defconst cmpl-source-cdabbrev 6)
-(defconst num-cmpl-sources 7)
-(defvar current-completion-source cmpl-source-unknown)
-
-
-
-;;---------------------------------------------------------------------------
-;; Completion Method #2: dabbrev-expand style
-;;---------------------------------------------------------------------------
-;;
-;;   This method is used if there are no useful stored completions.  It is 
-;; based on dabbrev-expand with these differences :
-;;   1) Faster (we don't use regexps)
-;;   2) case coercion handled correctly
-;; This is called cdabbrev to differentiate it.
-;;   We simply search backwards through the file looking for words which
-;; start with the same letters we are trying to complete.
-;;
-
-(defvar cdabbrev-completions-tried nil)
-;;  "A list of all the cdabbrev completions since the last reset.")
-
-(defvar cdabbrev-current-point 0)
-;;  "The current point position the cdabbrev search is at.")
-
-(defvar cdabbrev-current-window nil)
-;;  "The current window we are looking for cdabbrevs in.  T if looking in
-;; (other-buffer), NIL if no more  cdabbrevs.")
-
-(defvar cdabbrev-wrapped-p nil)
-;;  "T if the cdabbrev search has wrapped around the file.")
-
-(defvar cdabbrev-abbrev-string "")
-(defvar cdabbrev-start-point 0)
-(defvar cdabbrev-stop-point)
-
-;; Test strings for cdabbrev
-;; cdat-upcase   ;;same namestring
-;; CDAT-UPCASE   ;;ok
-;; cdat2         ;;too short
-;; cdat-1-2-3-4  ;;ok
-;; a-cdat-1      ;;doesn't start correctly
-;; cdat-simple   ;;ok
-
-
-(defun reset-cdabbrev (abbrev-string &optional initial-completions-tried)
-  "Resets the cdabbrev search to search for abbrev-string.
-INITIAL-COMPLETIONS-TRIED is a list of downcased strings to ignore
-during the search."
-  (setq cdabbrev-abbrev-string abbrev-string
-	cdabbrev-completions-tried
-	(cons (downcase abbrev-string) initial-completions-tried)
-	)
-  (reset-cdabbrev-window t)
-  )
-
-(defun set-cdabbrev-buffer ()
-  ;; cdabbrev-current-window must not be NIL
-  (set-buffer (if (eq cdabbrev-current-window t)
-		  (other-buffer)
-		  (window-buffer cdabbrev-current-window)))
-  )
-
-
-(defun reset-cdabbrev-window (&optional initializep)
-  "Resets the cdabbrev search to search for abbrev-string."
-  ;; Set the window
-  (cond (initializep
-	 (setq cdabbrev-current-window (selected-window))
-	 )
-	((eq cdabbrev-current-window t)
-	 ;; Everything has failed
-	 (setq cdabbrev-current-window nil))
-	(cdabbrev-current-window
-	 (setq cdabbrev-current-window (next-window cdabbrev-current-window))
-	 (if (eq cdabbrev-current-window (selected-window))
-	     ;; No more windows, try other buffer.
-	     (setq cdabbrev-current-window t)))
-	)
-  (if cdabbrev-current-window
-      (save-excursion
-	(set-cdabbrev-buffer)
-	(setq cdabbrev-current-point (point)
-	      cdabbrev-start-point cdabbrev-current-point
-	      cdabbrev-stop-point
-	      (if completion-search-distance
-		  (max (point-min)
-		       (- cdabbrev-start-point completion-search-distance))
-		  (point-min))
-	      cdabbrev-wrapped-p nil)
-	)))
-
-(defun next-cdabbrev ()
-  "Return the next possible cdabbrev expansion or nil if there isn't one.
-`reset-cdabbrev' must've been called already.
-This is sensitive to `case-fold-search'."
-  ;; note that case-fold-search affects the behavior of this function
-  ;; Bug: won't pick up an expansion that starts at the top of buffer
-  (if cdabbrev-current-window
-      (let (saved-point 
-	    saved-syntax
-	    (expansion nil)
-	    downcase-expansion tried-list syntax saved-point-2)
-	(save-excursion
-	  (unwind-protect
-	      (progn
-		;; Switch to current completion buffer
-		(set-cdabbrev-buffer)
-		;; Save current buffer state
-		(setq saved-point  (point)
-		      saved-syntax (syntax-table))
-		;; Restore completion state
-		(set-syntax-table cmpl-syntax-table)
-		(goto-char cdabbrev-current-point)
-		;; Loop looking for completions
-		(while
-		    ;; This code returns t if it should loop again
-		    (cond
-		      (;; search for the string
-		       (search-backward cdabbrev-abbrev-string cdabbrev-stop-point t)
-		       ;; return nil if the completion is valid
-		       (not
-			(and
-			 ;; does it start with a separator char ?
-			 (or (= (setq syntax (char-syntax (preceding-char))) ? )
-			     (and (= syntax ?w)
-				  ;; symbol char to ignore at end.  Are we at end ?
-				  (progn
-				    (setq saved-point-2 (point))
-				    (forward-word -1)
-				    (prog1
-				      (= (char-syntax (preceding-char)) ? )
-				      (goto-char saved-point-2)
-				      ))))
-			 ;; is the symbol long enough ?
-			 (setq expansion (symbol-under-point))
-			 ;; have we not tried this one before
-			 (progn
-			   ;; See if we've already used it
-			   (setq tried-list cdabbrev-completions-tried
-				 downcase-expansion (downcase expansion))
-			   (while (and tried-list
-				       (not (string-equal downcase-expansion
-							  (car tried-list))))
-			     ;; Already tried, don't choose this one
-			     (setq tried-list (cdr tried-list))
-			     )
-			   ;; at this point tried-list will be nil if this
-			   ;; expansion has not yet been tried
-			   (if tried-list
-			       (setq expansion nil)
-			       t)
-			   ))))
-		      ;; search failed
-		      (cdabbrev-wrapped-p
-		       ;; If already wrapped, then we've failed completely
-		       nil)
-		      (t
-		       ;; need to wrap
-		       (goto-char (setq cdabbrev-current-point
-					(if completion-search-distance
-					    (min (point-max) (+ cdabbrev-start-point completion-search-distance))
-					    (point-max))))
-
-		       (setq cdabbrev-wrapped-p t))
-		      ))
-		;; end of while loop
-		(cond (expansion
-		       ;; successful
-		       (setq cdabbrev-completions-tried
-			     (cons downcase-expansion cdabbrev-completions-tried)
-			     cdabbrev-current-point (point))))
-		)
-	    (set-syntax-table saved-syntax)
-	    (goto-char saved-point)
-	    ))
-	;; If no expansion, go to next window
-	(cond (expansion)
-	      (t (reset-cdabbrev-window)
-		 (next-cdabbrev))))))
-
-;; The following must be eval'd in the minibuffer ::
-;; (reset-cdabbrev "cdat")
-;; (next-cdabbrev)  --> "cdat-simple"
-;; (next-cdabbrev)  --> "cdat-1-2-3-4"
-;; (next-cdabbrev)  --> "CDAT-UPCASE"
-;; (next-cdabbrev)  --> "cdat-wrapping"
-;; (next-cdabbrev)  --> "cdat_start_sym"
-;; (next-cdabbrev)  --> nil
-;; (next-cdabbrev)  --> nil
-;; (next-cdabbrev)  --> nil
-
-;; _cdat_start_sym
-;; cdat-wrapping
-
-
-;;---------------------------------------------------------------------------
-;; Completion Database
-;;---------------------------------------------------------------------------
-
-;; We use two storage modes for the two search types ::
-;;  1) Prefix {cmpl-prefix-obarray} for looking up possible completions
-;;      Used by search-completion-next
-;;      the value of the symbol is nil or a cons of head and tail pointers
-;;  2) Interning {cmpl-obarray} to see if it's in the database
-;;      Used by find-exact-completion, completion-in-database-p
-;;      The value of the symbol is the completion entry
-
-;; bad things may happen if this length is changed due to the way
-;; GNU implements obarrays
-(defconst cmpl-obarray-length 511)
-
-(defvar cmpl-prefix-obarray (make-vector cmpl-obarray-length 0)
-  "An obarray used to store the downcased completion prefixes.
-Each symbol is bound to a list of completion entries.")
-
-(defvar cmpl-obarray (make-vector cmpl-obarray-length 0)
-  "An obarray used to store the downcased completions.
-Each symbol is bound to a single completion entry.")
-
-;;-----------------------------------------------
-;; Completion Entry Structure Definition
-;;-----------------------------------------------
-
-;; A completion entry is a LIST of string, prefix-symbol num-uses, and
-;; last-use-time (the time the completion was last used)
-;; last-use-time is T if the string should be kept permanently
-;; num-uses is incremented every time the completion is used.
-
-;; We chose lists because (car foo) is faster than (aref foo 0) and the 
-;; creation time is about the same.
-
-;; READER MACROS
-
-(defmacro completion-string (completion-entry)
-  (list 'car completion-entry))
-
-(defmacro completion-num-uses (completion-entry)
-  ;;  "The number of times it has used.  Used to decide whether to save 
-  ;; it."
-  (list 'car (list 'cdr completion-entry)))
-
-(defmacro completion-last-use-time (completion-entry)
-  ;;  "The time it was last used.  In hours since origin.  Used to decide
-  ;; whether to save it.  T if one should always save it."
-  (list 'nth 2 completion-entry))
-
-(defmacro completion-source (completion-entry)
-  (list 'nth 3 completion-entry))
-
-;; WRITER MACROS
-(defmacro set-completion-string (completion-entry string)
-  (list 'setcar completion-entry string))
-
-(defmacro set-completion-num-uses (completion-entry num-uses)
-  (list 'setcar (list 'cdr completion-entry) num-uses))
-
-(defmacro set-completion-last-use-time (completion-entry last-use-time)
-  (list 'setcar (list 'cdr (list 'cdr completion-entry)) last-use-time))
-
-;; CONSTRUCTOR
-(defun make-completion (string)
-  "Returns a list of a completion entry."
-  (list (list string 0 nil current-completion-source)))
-
-;; Obsolete
-;;(defmacro cmpl-prefix-entry-symbol (completion-entry)
-;;  (list 'car (list 'cdr completion-entry)))
-
-
-
-;;-----------------------------------------------
-;; Prefix symbol entry definition
-;;-----------------------------------------------
-;; A cons of (head . tail)
-
-;; READER Macros
-
-(defmacro cmpl-prefix-entry-head (prefix-entry)
-  (list 'car prefix-entry))
-
-(defmacro cmpl-prefix-entry-tail (prefix-entry)
-  (list 'cdr prefix-entry))
-
-;; WRITER Macros
-
-(defmacro set-cmpl-prefix-entry-head (prefix-entry new-head)
-  (list 'setcar prefix-entry new-head))
-
-(defmacro set-cmpl-prefix-entry-tail (prefix-entry new-tail)
-  (list 'setcdr prefix-entry new-tail))
-
-;; Constructor
-
-(defun make-cmpl-prefix-entry (completion-entry-list)
-  "Makes a new prefix entry containing only completion-entry."
-  (cons completion-entry-list completion-entry-list))
-
-;;-----------------------------------------------
-;; Completion Database - Utilities
-;;-----------------------------------------------
-
-(defun clear-all-completions ()
-  "Initializes the completion storage.  All existing completions are lost."
-  (interactive)
-  (setq cmpl-prefix-obarray (make-vector cmpl-obarray-length 0))
-  (setq cmpl-obarray (make-vector cmpl-obarray-length 0))
-  (cmpl-statistics-block
-    (record-clear-all-completions))
-  )
-
-(defvar completions-list-return-value)
-
-(defun list-all-completions ()
-  "Returns a list of all the known completion entries."
-  (let ((completions-list-return-value nil))
-    (mapatoms 'list-all-completions-1 cmpl-prefix-obarray)
-    completions-list-return-value))
-
-(defun list-all-completions-1 (prefix-symbol)
-  (if (boundp prefix-symbol)
-      (setq completions-list-return-value
-	    (append (cmpl-prefix-entry-head (symbol-value prefix-symbol))
-		    completions-list-return-value))))
-
-(defun list-all-completions-by-hash-bucket ()
-  "Return list of lists of known completion entries, organized by hash bucket."
-  (let ((completions-list-return-value nil))
-    (mapatoms 'list-all-completions-by-hash-bucket-1 cmpl-prefix-obarray)
-    completions-list-return-value))
-
-(defun list-all-completions-by-hash-bucket-1 (prefix-symbol)
-  (if (boundp prefix-symbol)
-      (setq completions-list-return-value
-	    (cons (cmpl-prefix-entry-head (symbol-value prefix-symbol))
-		  completions-list-return-value))))
-
-
-;;-----------------------------------------------
-;; Updating the database
-;;-----------------------------------------------
-;;
-;;   These are the internal functions used to update the datebase
-;;
-;;
-(defvar completion-to-accept nil)
-  ;;"Set to a string that is pending its acceptance."
-  ;; this checked by the top level reading functions
-
-(defvar cmpl-db-downcase-string nil)
-  ;; "Setup by find-exact-completion, etc.  The given string, downcased."
-(defvar cmpl-db-symbol nil)
-  ;; "The interned symbol corresponding to cmpl-db-downcase-string.
-  ;; Set up by cmpl-db-symbol."
-(defvar cmpl-db-prefix-symbol nil)
-  ;; "The interned prefix symbol corresponding to cmpl-db-downcase-string."
-(defvar cmpl-db-entry nil)
-(defvar cmpl-db-debug-p nil
-  "Set to T if you want to debug the database.")
-
-;; READS
-(defun find-exact-completion (string)
-  "Returns the completion entry for string or nil.
-Sets up `cmpl-db-downcase-string' and `cmpl-db-symbol'."
-  (and (boundp (setq cmpl-db-symbol
-		     (intern (setq cmpl-db-downcase-string (downcase string))
-			     cmpl-obarray)))
-       (symbol-value cmpl-db-symbol)
-       ))
-
-(defun find-cmpl-prefix-entry (prefix-string)
-  "Returns the prefix entry for string.
-Sets `cmpl-db-prefix-symbol'.
-Prefix-string must be exactly `completion-prefix-min-length' long
-and downcased.  Sets up `cmpl-db-prefix-symbol'."
-  (and (boundp (setq cmpl-db-prefix-symbol
-		     (intern prefix-string cmpl-prefix-obarray)))
-       (symbol-value cmpl-db-prefix-symbol)))
-
-(defvar inside-locate-completion-entry nil)
-;; used to trap lossage in silent error correction
-
-(defun locate-completion-entry (completion-entry prefix-entry)
-  "Locates the completion entry.
-Returns a pointer to the element before the completion entry or nil if
-the completion entry is at the head.
-Must be called after `find-exact-completion'."
-  (let ((prefix-list (cmpl-prefix-entry-head prefix-entry))
-	 next-prefix-list
-	 )
-    (cond
-      ((not (eq (car prefix-list) completion-entry))
-       ;; not already at head
-       (while (and prefix-list
-		   (not (eq completion-entry
-			    (car (setq next-prefix-list (cdr prefix-list)))
-			    )))
-	 (setq prefix-list next-prefix-list))
-       (cond (;; found
-	      prefix-list)
-	     ;; Didn't find it.  Database is messed up.
-	     (cmpl-db-debug-p
-	      ;; not found, error if debug mode
-	      (error "Completion entry exists but not on prefix list - %s"
-		     completion-string))
-	     (inside-locate-completion-entry
-	      ;; recursive error: really scrod
-	      (locate-completion-db-error))
-	     (t
-	       ;; Patch out
-	       (set cmpl-db-symbol nil)
-	       ;; Retry
-	       (locate-completion-entry-retry completion-entry)
-	       ))))))
-
-(defun locate-completion-entry-retry (old-entry)
-  (let ((inside-locate-completion-entry t))
-    (add-completion (completion-string old-entry)
-		    (completion-num-uses old-entry)
-		    (completion-last-use-time old-entry))
-    (let* ((cmpl-entry (find-exact-completion (completion-string old-entry)))
-	   (pref-entry
-	    (if cmpl-entry
-		(find-cmpl-prefix-entry
-		  (substring cmpl-db-downcase-string
-			     0 completion-prefix-min-length))))
-	  )
-      (if (and cmpl-entry pref-entry)
-	  ;; try again
-	  (locate-completion-entry cmpl-entry pref-entry)
-	  ;; still losing
-	  (locate-completion-db-error))
-      )))
-
-(defun locate-completion-db-error ()
-  ;; recursive error: really scrod
-  (error "Completion database corrupted.  Try M-x clear-all-completions.  Send bug report.")
-  )
-
-;; WRITES
-(defun add-completion-to-tail-if-new (string)
-  "If STRING is not in the database add it to appropriate prefix list.
-STRING is added to the end of the appropriate prefix list with
-num-uses = 0.  The database is unchanged if it is there.  STRING must be
-longer than `completion-prefix-min-length'.
-This must be very fast.
-Returns the completion entry."
-  (or (find-exact-completion string)
-      ;; not there
-      (let (;; create an entry
-	    (entry (make-completion string))
-	    ;; setup the prefix
-	    (prefix-entry (find-cmpl-prefix-entry
-			    (substring cmpl-db-downcase-string 0
-				       (cmpl-read-time-eval
-					completion-prefix-min-length))))
-	    )
-	;; The next two forms should happen as a unit (atomically) but
-	;; no fatal errors should result if that is not the case.
-	(cond (prefix-entry
-	       ;; These two should be atomic, but nothing fatal will happen
-	       ;; if they're not.
-	       (setcdr (cmpl-prefix-entry-tail prefix-entry) entry)
-	       (set-cmpl-prefix-entry-tail prefix-entry entry))
-	      (t
-	       (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))
-	       ))
-	;; statistics
-	(cmpl-statistics-block
-	  (note-added-completion))
-	;; set symbol
-	(set cmpl-db-symbol (car entry))
-	)))
-
-(defun add-completion-to-head (completion-string)
-  "If COMPLETION-STRING is not in the database, add it to prefix list.
-We add COMPLETION-STRING to the head of the appropriate prefix list,
-or it to the head of the list.
-COMPLETION-STRING must be longer than `completion-prefix-min-length'.
-Updates the saved string with the supplied string.
-This must be very fast.
-Returns the completion entry."
-  ;; Handle pending acceptance
-  (if completion-to-accept (accept-completion))
-  ;; test if already in database
-  (if (setq cmpl-db-entry (find-exact-completion completion-string))
-      ;; found
-      (let* ((prefix-entry (find-cmpl-prefix-entry
-			     (substring cmpl-db-downcase-string 0
-					(cmpl-read-time-eval
-					 completion-prefix-min-length))))
-	     (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
-	     (cmpl-ptr (cdr splice-ptr))
-	     )
-	;; update entry
-	(set-completion-string cmpl-db-entry completion-string)
-	;; move to head (if necessary)
-	(cond (splice-ptr
-	       ;; These should all execute atomically but it is not fatal if
-	       ;; they don't.
-	       ;; splice it out
-	       (or (setcdr splice-ptr (cdr cmpl-ptr))
-		   ;; fix up tail if necessary
-		   (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
-	       ;; splice in at head
-	       (setcdr cmpl-ptr (cmpl-prefix-entry-head prefix-entry))
-	       (set-cmpl-prefix-entry-head prefix-entry cmpl-ptr)
-	       ))
-	cmpl-db-entry)
-    ;; not there
-    (let (;; create an entry
-	  (entry (make-completion completion-string))
-	  ;; setup the prefix
-	  (prefix-entry (find-cmpl-prefix-entry
-			  (substring cmpl-db-downcase-string 0
-				     (cmpl-read-time-eval
-				      completion-prefix-min-length))))
-	  )
-      (cond (prefix-entry
-	     ;; Splice in at head
-	     (setcdr entry (cmpl-prefix-entry-head prefix-entry))
-	     (set-cmpl-prefix-entry-head prefix-entry entry))
-	    (t
-	     ;; Start new prefix entry
-	     (set cmpl-db-prefix-symbol (make-cmpl-prefix-entry entry))
-	     ))
-      ;; statistics
-      (cmpl-statistics-block
-	(note-added-completion))
-      ;; Add it to the symbol
-      (set cmpl-db-symbol (car entry))
-      )))
-      
-(defun delete-completion (completion-string)
-  "Deletes the completion from the database.
-String must be longer than `completion-prefix-min-length'."
-  ;; Handle pending acceptance
-  (if completion-to-accept (accept-completion))
-  (if (setq cmpl-db-entry (find-exact-completion completion-string))
-      ;; found
-      (let* ((prefix-entry (find-cmpl-prefix-entry 
-			     (substring cmpl-db-downcase-string 0
-					(cmpl-read-time-eval
-					 completion-prefix-min-length))))
-	     (splice-ptr (locate-completion-entry cmpl-db-entry prefix-entry))
-	     )
-	 ;; delete symbol reference
-	 (set cmpl-db-symbol nil)
-	 ;; remove from prefix list
-	 (cond (splice-ptr
-		;; not at head
-		(or (setcdr splice-ptr (cdr (cdr splice-ptr)))
-		    ;; fix up tail if necessary
-		    (set-cmpl-prefix-entry-tail prefix-entry splice-ptr))
-		)
-	       (t
-		;; at head
-		(or (set-cmpl-prefix-entry-head
-		      prefix-entry (cdr (cmpl-prefix-entry-head prefix-entry)))
-		    ;; List is now empty
-		    (set cmpl-db-prefix-symbol nil))
-		))
-	 (cmpl-statistics-block
-	   (note-completion-deleted))
-	 )
-      (error "Unknown completion `%s'" completion-string)
-      ))
-
-;; Tests --
-;;  - Add and Find -
-;; (add-completion-to-head "banana")     --> ("banana" 0 nil 0)
-;; (find-exact-completion "banana")      --> ("banana" 0 nil 0)
-;; (find-exact-completion "bana")        --> nil
-;; (car (find-cmpl-prefix-entry "ban"))  --> (("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban"))  --> (("banana" ...))
-;; (add-completion-to-head "banish")     --> ("banish" 0 nil 0)
-;; (find-exact-completion "banish")      --> ("banish" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban"))  --> (("banish" ...) ("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban"))  --> (("banana" ...))
-;; (add-completion-to-head "banana")     --> ("banana" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban"))  --> (("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban"))  --> (("banish" ...))
-;;
-;;  - Deleting -
-;; (add-completion-to-head "banner")     --> ("banner" 0 nil 0)
-;; (delete-completion "banner")        
-;; (find-exact-completion "banner")      --> nil
-;; (car (find-cmpl-prefix-entry "ban"))  --> (("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban"))  --> (("banish" ...))
-;; (add-completion-to-head "banner")     --> ("banner" 0 nil 0) 
-;; (delete-completion "banana")        
-;; (car (find-cmpl-prefix-entry "ban"))  --> (("banner" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban"))  --> (("banish" ...))
-;; (delete-completion "banner")        
-;; (delete-completion "banish")                 
-;; (find-cmpl-prefix-entry "ban")        --> nil
-;; (delete-completion "banner")          --> error
-;;
-;; - Tail -
-;; (add-completion-to-tail-if-new "banana") --> ("banana" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban"))     --> (("banana" ...))
-;; (cdr (find-cmpl-prefix-entry "ban"))     --> (("banana" ...))
-;; (add-completion-to-tail-if-new "banish") --> ("banish" 0 nil 0)
-;; (car (find-cmpl-prefix-entry "ban"))     -->(("banana" ...) ("banish" ...))
-;; (cdr (find-cmpl-prefix-entry "ban"))     -->(("banish" ...))
-;;
-
-
-;;---------------------------------------------------------------------------
-;; Database Update :: Interface level routines
-;;---------------------------------------------------------------------------
-;; 
-;; These lie on top of the database ref. functions but below the standard
-;; user interface level
-
-
-(defun interactive-completion-string-reader (prompt)
-  (let* ((default (symbol-under-or-before-point))
-	 (new-prompt
-	  (if default
-	      (format "%s: (default: %s) " prompt default)
-	      (format "%s: " prompt))
-	   )
-	 (read (completing-read new-prompt cmpl-obarray))
-	 )
-    (if (zerop (length read)) (setq read (or default "")))
-    (list read)
-    ))
-
-(defun check-completion-length (string)
-  (if (< (length string) completion-min-length)
-      (error "The string `%s' is too short to be saved as a completion"
-	     string)
-      (list string)))
-
-(defun add-completion (string &optional num-uses last-use-time)
-  "Add STRING to completion list, or move it to head of list.
-The completion is altered appropriately if num-uses and/or last-use-time is 
-specified."
-  (interactive (interactive-completion-string-reader "Completion to add"))
-  (check-completion-length string)
-  (let* ((current-completion-source (if (interactive-p)
-					cmpl-source-interactive
-					current-completion-source))
-	 (entry (add-completion-to-head string)))
-    
-    (if num-uses (set-completion-num-uses entry num-uses))
-    (if last-use-time
-	(set-completion-last-use-time entry last-use-time))
-    ))
-
-(defun add-permanent-completion (string)
-  "Add STRING if it isn't already listed, and mark it permanent."
-  (interactive
-    (interactive-completion-string-reader "Completion to add permanently"))
-  (let ((current-completion-source (if (interactive-p)
-				       cmpl-source-interactive
-				       current-completion-source))
-	)
-    (add-completion string nil t)
-    ))
-
-(defun kill-completion (string)
-  (interactive (interactive-completion-string-reader "Completion to kill"))
-  (check-completion-length string)
-  (delete-completion string)
-  )
-
-(defun accept-completion ()
-  "Accepts the pending completion in `completion-to-accept'.
-This bumps num-uses.  Called by `add-completion-to-head' and 
-`completion-search-reset'."
-  (let ((string completion-to-accept)
-	;; if this is added afresh here, then it must be a cdabbrev
-	(current-completion-source cmpl-source-cdabbrev)
-	entry
-	)
-    (setq completion-to-accept nil)
-    (setq entry (add-completion-to-head string))
-    (set-completion-num-uses entry (1+ (completion-num-uses entry)))
-    (setq cmpl-completions-accepted-p t)
-    ))
-
-(defun use-completion-under-point ()
-  "Add the completion symbol underneath the point into the completion buffer."
-  (let ((string (and enable-completion (symbol-under-point)))
-	(current-completion-source cmpl-source-cursor-moves))
-    (if string (add-completion-to-head string))))
-	
-(defun use-completion-before-point ()
-  "Add the completion symbol before point into the completion buffer."
-  (let ((string (and enable-completion (symbol-before-point)))
-	(current-completion-source cmpl-source-cursor-moves))
-    (if string (add-completion-to-head string))))
-
-(defun use-completion-under-or-before-point ()
-  "Add the completion symbol before point into the completion buffer."
-  (let ((string (and enable-completion (symbol-under-or-before-point)))
-	(current-completion-source cmpl-source-cursor-moves))
-    (if string (add-completion-to-head string))))
-
-(defun use-completion-before-separator ()
-  "Add the completion symbol before point into the completion buffer.
-Completions added this way will automatically be saved if
-`completion-on-separator-character' is non-nil."
-  (let ((string (and enable-completion (symbol-before-point)))
-	(current-completion-source cmpl-source-separator)
-	entry)
-    (cmpl-statistics-block
-      (note-separator-character string)
-      )
-    (cond (string
-	   (setq entry (add-completion-to-head string))
-	   (if (and completion-on-separator-character
-		      (zerop (completion-num-uses entry)))
-	       (progn
-		 (set-completion-num-uses entry 1)
-		 (setq cmpl-completions-accepted-p t)))))
-    ))
-
-;; Tests --
-;;  - Add and Find -
-;; (add-completion "banana" 5 10)  
-;; (find-exact-completion "banana")  --> ("banana" 5 10 0)
-;; (add-completion "banana" 6)     
-;; (find-exact-completion "banana")  --> ("banana" 6 10 0)
-;; (add-completion "banish")
-;; (car (find-cmpl-prefix-entry "ban"))  --> (("banish" ...) ("banana" ...))
-;;
-;;  - Accepting -
-;; (setq completion-to-accept "banana")
-;; (accept-completion)                   
-;; (find-exact-completion "banana")      --> ("banana" 7 10)
-;; (car (find-cmpl-prefix-entry "ban"))  --> (("banana" ...) ("banish" ...))
-;; (setq completion-to-accept "banish")
-;; (add-completion "banner")           
-;; (car (find-cmpl-prefix-entry "ban"))
-;;        --> (("banner" ...) ("banish" 1 ...) ("banana" 7 ...))
-;;
-;;  - Deleting -
-;; (kill-completion "banish")          
-;; (car (find-cmpl-prefix-entry "ban"))  --> (("banner" ...) ("banana" ...))
-
-
-;;---------------------------------------------------------------------------
-;; Searching the database
-;;---------------------------------------------------------------------------
-;; Functions outside this block must call completion-search-reset followed
-;; by calls to completion-search-next or completion-search-peek
-;;
-
-;; Status variables
-;; Commented out to improve loading speed
-(defvar cmpl-test-string "")
-;;  "The current string used by completion-search-next."
-(defvar cmpl-test-regexp "")
-;;  "The current regexp used by completion-search-next. 
-;;   (derived from cmpl-test-string)"
-(defvar cmpl-last-index 0)
-;;  "The last index that completion-search-next was called with."
-(defvar cmpl-cdabbrev-reset-p nil)
-;;  "Set to t when cdabbrevs have been reset."
-(defvar cmpl-next-possibilities nil)
-;;   "A pointer to the element BEFORE the next set of possible completions.
-;;  cadr of this is the cmpl-next-possibility"
-(defvar cmpl-starting-possibilities nil)
-;;  "The initial list of starting possibilities."
-(defvar cmpl-next-possibility nil)
-;;   "The cached next possibility."
-(defvar cmpl-tried-list nil)
-;;   "A downcased list of all the completions we have tried."
-
-
-(defun completion-search-reset (string)
-  "Set up the for completion searching for STRING.
-STRING must be longer than `completion-prefix-min-length'."
-  (if completion-to-accept (accept-completion))
-  (setq cmpl-starting-possibilities
-	(cmpl-prefix-entry-head
-	  (find-cmpl-prefix-entry
-	   (downcase (substring string 0 completion-prefix-min-length))))
-	cmpl-test-string string
-	cmpl-test-regexp (concat (regexp-quote string) "."))
-  (completion-search-reset-1)
-  )
-
-(defun completion-search-reset-1 ()
-  (setq cmpl-next-possibilities cmpl-starting-possibilities
-	cmpl-next-possibility   nil
-	cmpl-cdabbrev-reset-p nil
-	cmpl-last-index -1
-	cmpl-tried-list nil
-	))
-
-(defun completion-search-next (index)
-  "Return the next completion entry.
-If INDEX is out of sequence, reset and start from the top.
-If there are no more entries, try cdabbrev and returns only a string."
-  (cond
-    ((= index (setq cmpl-last-index (1+ cmpl-last-index)))
-     (completion-search-peek t))
-    ((< index 0)
-     (completion-search-reset-1)
-     (setq cmpl-last-index index)
-     ;; reverse the possibilities list
-     (setq cmpl-next-possibilities (reverse cmpl-starting-possibilities))
-     ;; do a "normal" search
-     (while (and (completion-search-peek nil)
-		 (< (setq index (1+ index)) 0))
-       (setq cmpl-next-possibility nil)
-       )
-     (cond ((not cmpl-next-possibilities))
-	    ;; If no more possibilities, leave it that way
-	   ((= -1 cmpl-last-index)
-	    ;; next completion is at index 0.  reset next-possibility list 
-	    ;; to start at beginning
-	    (setq cmpl-next-possibilities cmpl-starting-possibilities))
-	   (t
-	    ;; otherwise point to one before current
-	    (setq cmpl-next-possibilities
-		  (nthcdr (- (length cmpl-starting-possibilities)
-			     (length cmpl-next-possibilities))
-			  cmpl-starting-possibilities))
-	    )))
-    (t
-     ;; non-negative index, reset and search
-     ;;(prin1 'reset)
-     (completion-search-reset-1)
-     (setq cmpl-last-index index)
-     (while (and (completion-search-peek t)
-		 (not (< (setq index (1- index)) 0)))
-       (setq cmpl-next-possibility nil)
-       ))
-    )
-  (prog1
-      cmpl-next-possibility
-    (setq cmpl-next-possibility nil)
-    ))
-      
-
-(defun completion-search-peek (use-cdabbrev)
-  "Returns the next completion entry without actually moving the pointers.
-Calling this again or calling `completion-search-next' results in the same 
-string being returned.  Depends on `case-fold-search'.
-If there are no more entries, try cdabbrev and then return only a string."
-  (cond
-    ;; return the cached value if we have it
-    (cmpl-next-possibility)
-    ((and cmpl-next-possibilities
-	  ;; still a few possibilities left
-	  (progn
-	    (while
-		(and (not (eq 0 (string-match cmpl-test-regexp
-					      (completion-string (car cmpl-next-possibilities)))))
-		     (setq cmpl-next-possibilities (cdr cmpl-next-possibilities))
-		     ))
-	    cmpl-next-possibilities
-	    ))
-     ;; successful match
-     (setq cmpl-next-possibility (car cmpl-next-possibilities)
-	   cmpl-tried-list (cons (downcase (completion-string cmpl-next-possibility))
-				 cmpl-tried-list)
-	   cmpl-next-possibilities (cdr cmpl-next-possibilities)
-	   )
-     cmpl-next-possibility)
-    (use-cdabbrev
-     ;; unsuccessful, use cdabbrev
-     (cond ((not cmpl-cdabbrev-reset-p)
-	    (reset-cdabbrev cmpl-test-string cmpl-tried-list)
-	    (setq cmpl-cdabbrev-reset-p t)
-	    ))
-     (setq cmpl-next-possibility (next-cdabbrev))
-     )
-    ;; Completely unsuccessful, return nil
-    ))
-
-;; Tests --
-;;  - Add and Find -
-;; (add-completion "banana")       
-;; (completion-search-reset "ban")  
-;; (completion-search-next 0)        --> "banana"
-;;
-;;  - Discrimination -
-;; (add-completion "cumberland")       
-;; (add-completion "cumberbund")       
-;; cumbering   
-;; (completion-search-reset "cumb")
-;; (completion-search-peek t)        --> "cumberbund"
-;; (completion-search-next 0)        --> "cumberbund"
-;; (completion-search-peek t)        --> "cumberland"
-;; (completion-search-next 1)        --> "cumberland"
-;; (completion-search-peek nil)      --> nil
-;; (completion-search-next 2)        --> "cumbering"  {cdabbrev}
-;; (completion-search-next 3)        -->  nil or "cumming"{depends on context}
-;; (completion-search-next 1)        --> "cumberland"
-;; (completion-search-peek t)        --> "cumbering"  {cdabbrev}
-;;
-;;  - Accepting -
-;; (completion-search-next 1)        --> "cumberland"
-;; (setq completion-to-accept "cumberland")
-;; (completion-search-reset "foo")
-;; (completion-search-reset "cum")
-;; (completion-search-next 0)        --> "cumberland"
-;;
-;;  - Deleting -
-;; (kill-completion "cumberland")
-;; cummings    
-;; (completion-search-reset "cum")
-;; (completion-search-next 0)        --> "cumberbund"
-;; (completion-search-next 1)        --> "cummings"
-;;
-;;  - Ignoring Capitalization -
-;; (completion-search-reset "CuMb")
-;; (completion-search-next 0)            --> "cumberbund"
-
-
-
-;;-----------------------------------------------
-;; COMPLETE
-;;-----------------------------------------------
-
-(defun completion-mode ()
-  "Toggles whether or not to add new words to the completion database."
-  (interactive)
-  (setq enable-completion (not enable-completion))
-  (message "Completion mode is now %s." (if enable-completion "ON" "OFF"))
-  )
-	
-(defvar cmpl-current-index 0)
-(defvar cmpl-original-string nil)
-(defvar cmpl-last-insert-location -1)
-(defvar cmpl-leave-point-at-start nil)
-
-(defun complete (&optional arg)
-  "Fill out a completion of the word before point.  
-Point is left at end.  Consecutive calls rotate through all possibilities.
-Prefix args ::
-  control-u :: leave the point at the beginning of the completion rather 
-               than at the end.
-  a number  :: rotate through the possible completions by that amount
-  `-'       :: same as -1 (insert previous completion)
- {See the comments at the top of `completion.el' for more info.}"
-  (interactive "*p")
-  ;;; Set up variables
-  (cond ((eq last-command this-command)
-	 ;; Undo last one
-	 (delete-region cmpl-last-insert-location (point))
-	 ;; get next completion
-	 (setq cmpl-current-index (+ cmpl-current-index (or arg 1)))
-	 )
-	(t
-	 (if (not cmpl-initialized-p)
-	     (initialize-completions)) ;; make sure everything's loaded
-	 (cond ((consp current-prefix-arg) ;; control-u
-		(setq arg 0)
-		(setq cmpl-leave-point-at-start t)
-		)
-	       (t
-		(setq cmpl-leave-point-at-start nil)
-		))
-	 ;; get string
-	 (setq cmpl-original-string (symbol-before-point-for-complete))
-	 (cond ((not cmpl-original-string)
-		(setq this-command 'failed-complete)
-		(error "To complete, point must be after a symbol at least %d character long"
-		       completion-prefix-min-length)))
-	 ;; get index	     
-	 (setq cmpl-current-index (if current-prefix-arg arg 0))
-	 ;; statistics
-	 (cmpl-statistics-block
-	   (note-complete-entered-afresh cmpl-original-string))
-	 ;; reset database
-	 (completion-search-reset cmpl-original-string)
-	 ;; erase what we've got
-	 (delete-region cmpl-symbol-start cmpl-symbol-end)
-	 ))
-
-  ;; point is at the point to insert the new symbol
-  ;; Get the next completion
-  (let* ((print-status-p
-	  (and (>= baud-rate completion-prompt-speed-threshold)
-	       (not (minibuffer-window-selected-p))))
-	 (insert-point (point))
-	 (entry (completion-search-next cmpl-current-index))
-	 string
-	 )
-    ;; entry is either a completion entry or a string (if cdabbrev)
-
-    ;; If found, insert
-    (cond (entry
-	   ;; Setup for proper case
-	   (setq string (if (stringp entry)
-			    entry (completion-string entry)))
-	   (setq string (cmpl-merge-string-cases
-			  string cmpl-original-string))
-	   ;; insert
-	   (insert string)
-	   ;; accept it
-	   (setq completion-to-accept string)
-	   ;; fixup and cache point
-	   (cond (cmpl-leave-point-at-start
-		  (setq cmpl-last-insert-location (point))
-		  (goto-char insert-point))
-		 (t;; point at end,
-		  (setq cmpl-last-insert-location insert-point))
-		 )
-	   ;; statistics
-	   (cmpl-statistics-block
-	     (note-complete-inserted entry cmpl-current-index))
-	   ;; Done ! cmpl-stat-complete-successful
-	   ;;display the next completion
-	   (cond
-	     ((and print-status-p
-		   ;; This updates the display and only prints if there
-		   ;; is no typeahead
-		   (sit-for 0)
-		   (setq entry
-			 (completion-search-peek
-			   completion-cdabbrev-prompt-flag)))
-	      (setq string (if (stringp entry)
-			       entry (completion-string entry)))
-	      (setq string (cmpl-merge-string-cases
-			     string cmpl-original-string))
-	      (message "Next completion: %s" string)
-	      ))
-	   )
-	  (t;; none found, insert old 
-	   (insert cmpl-original-string)
-	   ;; Don't accept completions
-	   (setq completion-to-accept nil)
-	   ;; print message
-	   ;; This used to call cmpl19-sit-for, an undefined function.
-	   ;; I hope that sit-for does the right thing; I don't know -- rms.
-	   (if (and print-status-p (sit-for 0))
-	       (message "No %scompletions."
-			(if (eq this-command last-command) "more " "")))
-	   ;; statistics
-	   (cmpl-statistics-block
-	     (record-complete-failed cmpl-current-index))
-	   ;; Pretend that we were never here
-	   (setq this-command 'failed-complete)
-	   ))))
-
-;;-----------------------------------------------
-;; "Complete" Key Keybindings
-;;-----------------------------------------------
-
-(global-set-key "\M-\r" 'complete)
-(global-set-key [?\C-\r] 'complete)
-(define-key function-key-map [C-return] [?\C-\r])
-
-;; Tests -
-;; (add-completion "cumberland")
-;; (add-completion "cumberbund")
-;; cum
-;; Cumber
-;; cumbering
-;; cumb
-
-
-;;---------------------------------------------------------------------------
-;; Parsing definitions from files into the database
-;;---------------------------------------------------------------------------
-
-;;-----------------------------------------------
-;; Top Level functions ::
-;;-----------------------------------------------
-
-;; User interface
-(defun add-completions-from-file (file)
-  "Parse possible completions from a file and add them to data base."
-  (interactive "fFile: ")
-  (setq file (expand-file-name file))
-  (let* ((buffer (get-file-buffer file))
-	 (buffer-already-there-p buffer)
-	 )
-    (if (not buffer-already-there-p)
-	(let ((completions-merging-modes nil))
-	  (setq buffer (find-file-noselect file))))
-    (unwind-protect
-	 (save-excursion
-	   (set-buffer buffer)
-	   (add-completions-from-buffer)
-	   )
-      (if (not buffer-already-there-p)
-	  (kill-buffer buffer)))))
-
-(defun add-completions-from-buffer ()
-  (interactive)
-  (let ((current-completion-source cmpl-source-file-parsing)
-	(start-num
-	 (cmpl-statistics-block
-	  (aref completion-add-count-vector cmpl-source-file-parsing)))
-	mode
-	)
-    (cond ((memq major-mode '(emacs-lisp-mode lisp-mode))
-	   (add-completions-from-lisp-buffer)
-	   (setq mode 'lisp)
-	   )
-	  ((memq major-mode '(c-mode))
-	   (add-completions-from-c-buffer)
-	   (setq mode 'c)
-	   )
-	  (t
-	   (error "Cannot parse completions in %s buffers"
-		  major-mode)
-	   ))
-    (cmpl-statistics-block
-      (record-cmpl-parse-file
-	mode (point-max)
-	(- (aref completion-add-count-vector cmpl-source-file-parsing)
-	   start-num)))
-    ))
-
-;; Find file hook
-(defun cmpl-find-file-hook ()
-  (cond (enable-completion
-	 (cond ((and (memq major-mode '(emacs-lisp-mode lisp-mode))
-		     (memq 'lisp completions-merging-modes)
-		     )
-		(add-completions-from-buffer))
-	       ((and (memq major-mode '(c-mode))
-		     (memq 'c completions-merging-modes)
-		     )
-		(add-completions-from-buffer)
-		)))
-	))
-    
-(add-hook 'find-file-hooks 'cmpl-find-file-hook)
-
-;;-----------------------------------------------
-;; Tags Table Completions
-;;-----------------------------------------------
-
-(defun add-completions-from-tags-table ()
-  ;; Inspired by eero@media-lab.media.mit.edu
-  "Add completions from the current tags table."
-  (interactive)
-  (visit-tags-table-buffer)		;this will prompt if no tags-table
-  (save-excursion
-    (goto-char (point-min))
-    (let (string)
-      (condition-case e
-	   (while t
-	     (search-forward "\177")
-	     (backward-char 3)
-	     (and (setq string (symbol-under-point))
-		  (add-completion-to-tail-if-new string))
-	     (forward-char 3)
-	     )
-	 (search-failed)
-	 ))))
-
-
-;;-----------------------------------------------
-;; Lisp File completion parsing
-;;-----------------------------------------------
-;;   This merely looks for phrases beginning with (def.... or
-;; (package:def ... and takes the next word.
-;;
-;; We tried using forward-lines and explicit searches but the regexp technique
-;; was faster.  (About 100K characters per second)
-;;
-(defconst *lisp-def-regexp*
-  "\n(\\(\\w*:\\)?def\\(\\w\\|\\s_\\)*\\s +(*"
-  "A regexp that searches for lisp definition form."
-  )
-
-;; Tests -
-;;  (and (string-match *lisp-def-regexp* "\n(defun foo") (match-end 0)) -> 8
-;;  (and (string-match *lisp-def-regexp* "\n(si:def foo") (match-end 0)) -> 9
-;;  (and (string-match *lisp-def-regexp* "\n(def-bar foo")(match-end 0)) -> 10
-;;  (and (string-match *lisp-def-regexp* "\n(defun (foo") (match-end 0)) -> 9
-
-;; Parses all the definition names from a Lisp mode buffer and adds them to 
-;; the completion database.
-(defun add-completions-from-lisp-buffer ()
-  ;;; Benchmarks
-  ;;;  Sun-3/280 - 1500 to 3000 lines of lisp code per second
-  (let (string)
-    (save-excursion
-      (goto-char (point-min))
-      (condition-case e
-	   (while t
-	     (re-search-forward *lisp-def-regexp*)
-	     (and (setq string (symbol-under-point))
-		  (add-completion-to-tail-if-new string))
-	     )
-	 (search-failed)
-	 ))))
-
-
-;;-----------------------------------------------
-;; C file completion parsing
-;;-----------------------------------------------
-;; C :
-;;  Looks for #define or [<storage class>] [<type>] <name>{,<name>}
-;; or structure, array or pointer defs.
-;; It gets most of the definition names.
-;;
-;; As you might suspect by now, we use some symbol table hackery
-;;
-;; Symbol separator chars (have whitespace syntax) --> , ; * = (
-;; Opening char --> [ {
-;; Closing char --> ] }
-;; opening and closing must be skipped over
-;; Whitespace chars (have symbol syntax)
-;; Everything else has word syntax
-
-(defun cmpl-make-c-def-completion-syntax-table ()
-  (let ((table (make-syntax-table))
-	(whitespace-chars '(?  ?\n ?\t ?\f  ?\v ?\r))
-	;; unfortunately the ?( causes the parens to appear unbalanced
-	(separator-chars '(?, ?* ?= ?\( ?\;
-			   ))
-	i)
-    ;; default syntax is whitespace
-    (setq i 0)
-    (while (< i 256)
-      (modify-syntax-entry i "w" table)
-      (setq i (1+ i)))
-    (completion-dolist (char whitespace-chars)
-      (modify-syntax-entry char "_" table))
-    (completion-dolist (char separator-chars)
-      (modify-syntax-entry char " " table))
-    (modify-syntax-entry ?\[ "(]" table)
-    (modify-syntax-entry ?\{ "(}" table)
-    (modify-syntax-entry ?\] ")[" table)
-    (modify-syntax-entry ?\} "){" table)
-    table))
-
-(defconst cmpl-c-def-syntax-table (cmpl-make-c-def-completion-syntax-table))
-
-;; Regexps
-(defconst *c-def-regexp*
-    ;; This stops on lines with possible definitions
-    "\n[_a-zA-Z#]"
-  ;; This stops after the symbol to add.
-  ;;"\n\\(#define\\s +.\\|\\(\\(\\w\\|\\s_\\)+\\b\\s *\\)+[(;,[*{=]\\)"
-  ;; This stops before the symbol to add.  {Test cases in parens. below}
-  ;;"\n\\(\\(\\w\\|\\s_\\)+\\s *(\\|\\(\\(#define\\|auto\\|extern\\|register\\|static\\|int\\|long\\|short\\|unsigned\\|char\\|void\\|float\\|double\\|enum\\|struct\\|union\\|typedef\\)\\s +\\)+\\)"
-  ;; this simple version picks up too much extraneous stuff
-  ;; "\n\\(\\w\\|\\s_\\|#\\)\\B"
-  "A regexp that searches for a definition form."
-  )
-;
-;(defconst *c-cont-regexp*
-;  "\\(\\w\\|\\s_\\)+\\b\\s *\\({\\|\\(\\[[0-9\t ]*\\]\\s *\\)*,\\(*\\|\\s \\)*\\b\\)"
-;  "This regexp should be used in a looking-at to parse for lists of variables.")
-;
-;(defconst *c-struct-regexp*
-;  "\\(*\\|\\s \\)*\\b"
-;  "This regexp should be used to test whether a symbol follows a structure definition.")
-
-;(defun test-c-def-regexp (regexp string)
-;  (and (eq 0 (string-match regexp string)) (match-end 0))
-;  )
-
-;; Tests -
-;;  (test-c-def-regexp *c-def-regexp* "\n#define foo") -> 10 (9)
-;;  (test-c-def-regexp *c-def-regexp* "\nfoo (x, y) {") -> 6 (6)
-;;  (test-c-def-regexp *c-def-regexp* "\nint foo (x, y)") -> 10 (5)
-;;  (test-c-def-regexp *c-def-regexp* "\n int foo (x, y)") -> nil
-;;  (test-c-def-regexp *c-cont-regexp* "oo, bar") -> 4
-;;  (test-c-def-regexp *c-cont-regexp* "oo, *bar") -> 5
-;;  (test-c-def-regexp *c-cont-regexp* "a [5][6], bar") -> 10
-;;  (test-c-def-regexp *c-cont-regexp* "oo(x,y)") -> nil
-;;  (test-c-def-regexp *c-cont-regexp* "a [6] ,\t bar") -> 9
-;;  (test-c-def-regexp *c-cont-regexp* "oo {trout =1} my_carp;") -> 14
-;;  (test-c-def-regexp *c-cont-regexp* "truct_p complex foon") -> nil
-
-;; Parses all the definition names from a C mode buffer and adds them to the 
-;; completion database.
-(defun add-completions-from-c-buffer ()
-  ;; Benchmark --
-  ;;  Sun 3/280-- 1250 lines/sec.
-
-  (let (string next-point char
-	(saved-syntax (syntax-table))
-	)
-    (save-excursion
-      (goto-char (point-min))
-      (catch 'finish-add-completions
-	(unwind-protect
-	     (while t
-	       ;; we loop here only when scan-sexps fails
-	       ;; (i.e. unbalance exps.)
-	       (set-syntax-table cmpl-c-def-syntax-table)
-	       (condition-case e
-		    (while t
-		      (re-search-forward *c-def-regexp*)
-		      (cond
-			((= (preceding-char) ?#)
-			 ;; preprocessor macro, see if it's one we handle
-			 (setq string (buffer-substring (point) (+ (point) 6)))
-			 (cond ((or (string-equal string "define")
-				    (string-equal string "ifdef ")
-				    )
-				;; skip forward over definition symbol
-				;; and add it to database
-				(and (forward-word 2)
-				     (setq string (symbol-before-point))
-				     ;;(push string foo)
-				     (add-completion-to-tail-if-new string)
-				     ))))
-			(t
-			 ;; C definition
-			 (setq next-point (point))
-			 (while (and
-				  next-point
-				  ;; scan to next separator char.
-				  (setq next-point (scan-sexps next-point 1))
-				  )
-			   ;; position the point on the word we want to add
-			   (goto-char next-point)
-			   (while (= (setq char (following-char)) ?*)
-			     ;; handle pointer ref
-			     ;; move to next separator char.
-			     (goto-char
-			       (setq next-point (scan-sexps (point) 1)))
-			     )
-			   (forward-word -1)
-			   ;; add to database
-			   (if (setq string (symbol-under-point))
-			       ;; (push string foo)
-			       (add-completion-to-tail-if-new string)
-			       ;; Local TMC hack (useful for parsing paris.h)
-			       (if (and (looking-at "_AP") ;; "ansi prototype"
-					(progn
-					  (forward-word -1)
-					  (setq string
-						(symbol-under-point))
-					  ))
-				   (add-completion-to-tail-if-new string)
-				   )
-			       )
-			   ;; go to next
-			   (goto-char next-point)
-			   ;; (push (format "%c" (following-char)) foo)
-			   (if (= (char-syntax char) ?\()
-			       ;; if on an opening delimiter, go to end
-			       (while (= (char-syntax char) ?\()
-				 (setq next-point (scan-sexps next-point 1)
-				       char (char-after next-point))
-				 )
-			       (or (= char ?,)
-				   ;; Current char is an end char.
-				   (setq next-point nil)
-				   ))
-			   ))))
-		  (search-failed ;;done
-		    (throw 'finish-add-completions t)
-		    )
-		  (error
-		    ;; Check for failure in scan-sexps
-		    (if (or (string-equal (nth 1 e)
-					  "Containing expression ends prematurely")
-			    (string-equal (nth 1 e) "Unbalanced parentheses"))
-			;; unbalanced paren., keep going
-			;;(ding)
-			(forward-line 1)
-			(message "Error parsing C buffer for completions--please send bug report")
-			(throw 'finish-add-completions t)
-			))
-		  ))
-	  (set-syntax-table saved-syntax)
-	  )))))
-
-
-;;---------------------------------------------------------------------------
-;; Init files
-;;---------------------------------------------------------------------------
-
-;; The version of save-completions-to-file called at kill-emacs time.
-(defun kill-emacs-save-completions ()
-  (if (and save-completions-flag enable-completion cmpl-initialized-p)
-      (cond
-	((not cmpl-completions-accepted-p)
-	 (message "Completions database has not changed - not writing."))
-	(t
-	 (save-completions-to-file)))))
-
-;; There is no point bothering to change this again
-;; unless the package changes so much that it matters
-;; for people that have saved completions.
-(defconst completion-version "11")
-
-(defconst saved-cmpl-file-header
-    ";;; Completion Initialization file.
-;; Version = %s
-;; Format is (<string> . <last-use-time>)
-;;  <string> is the completion
-;;  <last-use-time> is the time the completion was last used
-;;    If it is t, the completion will never be pruned from the file.
-;;    Otherwise it is in hours since origin.
-\n")
-
-(defun completion-backup-filename (filename)
-  (concat filename ".BAK"))
-
-(defun save-completions-to-file (&optional filename)
-  "Save completions in init file FILENAME.
-If file name is not specified, use `save-completions-file-name'."
-  (interactive)
-  (setq filename (expand-file-name (or filename save-completions-file-name)))
-  (if (file-writable-p filename)
-      (progn
-	(if (not cmpl-initialized-p)
-	    (initialize-completions));; make sure everything's loaded
-	(message "Saving completions to file %s" filename)
-
-	(let* ((delete-old-versions t)
-	       (kept-old-versions 0)
-	       (kept-new-versions completions-file-versions-kept)
-	       last-use-time
-	       (current-time (cmpl-hours-since-origin))
-	       (total-in-db 0)
-	       (total-perm 0)
-	       (total-saved 0)
-	       (backup-filename (completion-backup-filename filename))
-	       )
-    
-	  (save-excursion
-	    (get-buffer-create " *completion-save-buffer*")
-	    (set-buffer  " *completion-save-buffer*")
-	    (setq buffer-file-name filename)
-
-	    (if (not (verify-visited-file-modtime (current-buffer)))
-		(progn
-		  ;; file has changed on disk.  Bring us up-to-date
-		  (message "Completion file has changed.  Merging. . .")
-		  (load-completions-from-file filename t)
-		  (message "Merging finished.  Saving completions to file %s" filename)))
-
-	    ;; prepare the buffer to be modified
-	    (clear-visited-file-modtime)
-	    (erase-buffer)
-	    ;; (/ 1 0)
-	    (insert (format saved-cmpl-file-header completion-version))
-	    (completion-dolist (completion (list-all-completions))
-	      (setq total-in-db (1+ total-in-db))
-	      (setq last-use-time (completion-last-use-time completion))
-	      ;; Update num uses and maybe write completion to a file
-	      (cond ((or;; Write to file if
-		      ;; permanent
-		      (and (eq last-use-time t)
-			   (setq total-perm (1+ total-perm)))
-		      ;; or if
-		      (if (> (completion-num-uses completion) 0)
-			  ;; it's been used
-			  (setq last-use-time current-time)
-			;; or it was saved before and
-			(and last-use-time
-			     ;; save-completions-retention-time is nil
-			     (or (not save-completions-retention-time)
-				 ;; or time since last use is < ...retention-time*
-				 (< (- current-time last-use-time)
-				    save-completions-retention-time))
-			     )))
-		     ;; write to file
-		     (setq total-saved (1+ total-saved))
-		     (insert (prin1-to-string (cons (completion-string completion)
-						    last-use-time)) "\n")
-		     )))
-	
-	    ;; write the buffer
-	    (condition-case e
-		(let ((file-exists-p (file-exists-p filename)))
-		  (if file-exists-p
-		      (progn
-			;; If file exists . . .
-			;; Save a backup(so GNU doesn't screw us when we're out of disk)
-			;; (GNU leaves a 0 length file if it gets a disk full error!)
-	       
-			;; If backup doesn't exit, Rename current to backup
-			;;  {If backup exists the primary file is probably messed up}
-			(or (file-exists-p backup-filename)
-			    (rename-file filename backup-filename))
-			;; Copy the backup back to the current name
-			;; (so versioning works)
-			(copy-file backup-filename filename t)))
-		  ;; Save it
-		  (save-buffer)
-		  (if file-exists-p
-		      ;; If successful, remove backup
-		      (delete-file backup-filename)))
-	      (error
-	       (set-buffer-modified-p nil)
-	       (message "Couldn't save completion file `%s'" filename)
-	       ))
-	    ;; Reset accepted-p flag
-	    (setq cmpl-completions-accepted-p nil) 
-	    )
-	  (cmpl-statistics-block
-	   (record-save-completions total-in-db total-perm total-saved))
-	  ))))
-
-;;(defun autosave-completions ()
-;;  (if (and save-completions-flag enable-completion cmpl-initialized-p
-;;	      *completion-auto-save-period*
-;;	      (> cmpl-emacs-idle-time *completion-auto-save-period*)
-;;	      cmpl-completions-accepted-p)
-;;    (save-completions-to-file)))
-
-;;(add-hook 'cmpl-emacs-idle-time-hooks 'autosave-completions)
-
-(defun load-completions-from-file (&optional filename no-message-p)
-  "Loads a completion init file FILENAME.
-If file is not specified, then use `save-completions-file-name'."
-  (interactive)
-  (setq filename (expand-file-name (or filename save-completions-file-name)))
-  (let* ((backup-filename (completion-backup-filename filename))
-	 (backup-readable-p (file-readable-p backup-filename))
-	 )
-    (if backup-readable-p (setq filename backup-filename))
-    (if (file-readable-p filename)
-	(progn
-	  (if (not no-message-p)
-	      (message "Loading completions from %sfile %s . . ."
-		       (if backup-readable-p "backup " "") filename))
-	  (save-excursion
-	    (get-buffer-create " *completion-save-buffer*")
-	    (set-buffer  " *completion-save-buffer*")
-	    (setq buffer-file-name filename)
-	    ;; prepare the buffer to be modified
-	    (clear-visited-file-modtime)
-	    (erase-buffer)
-  
-	    (let ((insert-okay-p nil)
-		  (buffer (current-buffer))
-		  (current-time (cmpl-hours-since-origin))
-		  string num-uses entry last-use-time
-		  cmpl-entry cmpl-last-use-time
-		  (current-completion-source cmpl-source-init-file)
-		  (start-num
-		   (cmpl-statistics-block
-		    (aref completion-add-count-vector cmpl-source-file-parsing)))
-		  (total-in-file 0) (total-perm 0)
-		  )
-	      ;; insert the file into a buffer
-	      (condition-case e
-		  (progn (insert-file-contents filename t)
-			 (setq insert-okay-p t))
-
-		(file-error 
-		 (message "File error trying to load completion file %s."
-			  filename)))
-	      ;; parse it 
-	      (if insert-okay-p
-		  (progn
-		    (goto-char (point-min))
-
-		    (condition-case e
-			(while t
-			  (setq entry (read buffer))
-			  (setq total-in-file (1+ total-in-file))
-			  (cond
-			   ((and (consp entry)
-				 (stringp (setq string (car entry)))
-				 (cond
-				  ((eq (setq last-use-time (cdr entry)) 'T)
-				   ;; handle case sensitivity
-				   (setq total-perm (1+ total-perm))
-				   (setq last-use-time t))
-				  ((eq last-use-time t)
-				   (setq total-perm (1+ total-perm)))
-				  ((integerp last-use-time))
-				  ))
-			    ;; Valid entry
-			    ;; add it in
-			    (setq cmpl-last-use-time
-				  (completion-last-use-time
-				   (setq cmpl-entry
-					 (add-completion-to-tail-if-new string))
-				   ))
-			    (if (or (eq last-use-time t) 
-				    (and (> last-use-time 1000);;backcompatibility
-					 (not (eq cmpl-last-use-time t))
-					 (or (not cmpl-last-use-time)
-					     ;; more recent
-					     (> last-use-time  cmpl-last-use-time))
-					 ))
-				;; update last-use-time
-				(set-completion-last-use-time cmpl-entry last-use-time)
-			      ))
-			   (t
-			    ;; Bad format
-			    (message "Error: invalid saved completion - %s"
-				     (prin1-to-string entry))
-			    ;; try to get back in sync
-			    (search-forward "\n(")
-			    )))
-		      (search-failed
-		       (message "End of file while reading completions.")
-		       )
-		      (end-of-file
-		       (if (= (point) (point-max))
-			   (if (not no-message-p)
-			       (message "Loading completions from file %s . . . Done."
-					filename))
-			 (message "End of file while reading completions.")
-			 ))
-		      )))
-
-	      (cmpl-statistics-block
-	       (record-load-completions
-		total-in-file total-perm
-		(- (aref completion-add-count-vector cmpl-source-init-file)
-		   start-num)))
-
-	      ))))))
-
-(defun initialize-completions ()
-  "Load the default completions file.
-Also sets up so that exiting emacs will automatically save the file."
-  (interactive)
-  (cond ((not cmpl-initialized-p)
-	 (load-completions-from-file)
-	 ))
-  (setq cmpl-initialized-p t)
-  )
-
-
-;;-----------------------------------------------
-;; Kill EMACS patch
-;;-----------------------------------------------
-
-(add-hook 'kill-emacs-hook
-	  '(lambda ()
-	     (kill-emacs-save-completions)
-	     (cmpl-statistics-block
-	      (record-cmpl-kill-emacs))))
-
-;;-----------------------------------------------
-;; Kill region patch
-;;-----------------------------------------------
-
-(defun completion-kill-region (&optional beg end)
-  "Kill between point and mark.
-The text is deleted but saved in the kill ring.
-The command \\[yank] can retrieve it from there.
-/(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
-
-This is the primitive for programs to kill text (as opposed to deleting it).
-Supply two arguments, character numbers indicating the stretch of text
- to be killed.
-Any command that calls this function is a \"kill command\".
-If the previous command was also a kill command,
-the text killed this time appends to the text killed last time
-to make one entry in the kill ring.
-Patched to remove the most recent completion."
-  (interactive "r")  
-  (cond ((eq last-command 'complete)
-	 (delete-region (point) cmpl-last-insert-location)
-	 (insert cmpl-original-string)
-	 (setq completion-to-accept nil)
-	 (cmpl-statistics-block
-	   (record-complete-failed)))
-	(t
-	 (kill-region beg end))))
-
-(global-set-key "\C-w" 'completion-kill-region)
-
-;;-----------------------------------------------
-;; Patches to self-insert-command.
-;;-----------------------------------------------
-
-;; Need 2 versions: generic separator chars. and space (to get auto fill
-;; to work)
-
-;; All common separators (eg. space "(" ")" """) characters go through a
-;; function to add new words to the list of words to complete from:
-;;  COMPLETION-SEPARATOR-SELF-INSERT-COMMAND (arg).
-;; If the character before this was an alpha-numeric then this adds the 
-;; symbol before point to the completion list (using ADD-COMPLETION).
-
-(defun completion-separator-self-insert-command (arg)
-  (interactive "p")
-  (use-completion-before-separator)
-  (self-insert-command arg)
-  )
-
-(defun completion-separator-self-insert-autofilling (arg)
-  (interactive "p")
-  (use-completion-before-separator)
-  (self-insert-command arg)
-  (and auto-fill-function
-       (funcall auto-fill-function))
-  )
-
-;;-----------------------------------------------
-;; Wrapping Macro
-;;-----------------------------------------------
-
-;; Note that because of the way byte compiling works, none of 
-;; the functions defined with this macro get byte compiled.
-
-(defmacro def-completion-wrapper (function-name type &optional new-name)
-  "Add a call to update the completion database before function execution.
-TYPE is the type of the wrapper to be added.  Can be :before or :under."
-  (cond ((eq type ':separator)
-	 (list 'put (list 'quote function-name) ''completion-function
-	       ''use-completion-before-separator))
-	((eq type ':before)
-	 (list 'put (list 'quote function-name) ''completion-function
-	       ''use-completion-before-point))
-	((eq type ':backward-under)
-	 (list 'put (list 'quote function-name) ''completion-function
-	       ''use-completion-backward-under))
-	((eq type ':backward)
-	 (list 'put (list 'quote function-name) ''completion-function
-	       ''use-completion-backward))
-	((eq type ':under)
-	 (list 'put (list 'quote function-name) ''completion-function
-	       ''use-completion-under-point))
-	((eq type ':under-or-before)
-	 (list 'put (list 'quote function-name) ''completion-function
-	       ''use-completion-under-or-before-point))
-	((eq type ':minibuffer-separator)
-	 (list 'put (list 'quote function-name) ''completion-function
-	       ''use-completion-minibuffer-separator))))
-
-(defun use-completion-minibuffer-separator ()
-  (let ((cmpl-syntax-table cmpl-standard-syntax-table))
-    (use-completion-before-separator)))
-
-(defun use-completion-backward-under ()
-  (use-completion-under-point)
-  (if (eq last-command 'complete)
-      ;; probably a failed completion if you have to back up
-      (cmpl-statistics-block (record-complete-failed))))
-
-(defun use-completion-backward ()
-  (if (eq last-command 'complete)
-      ;; probably a failed completion if you have to back up
-      (cmpl-statistics-block (record-complete-failed))))
-
-(defun completion-before-command ()
-  (funcall (or (and (symbolp this-command)
-		    (get this-command 'completion-function))
-	       'use-completion-under-or-before-point)))
-(add-hook 'pre-command-hook 'completion-before-command)
-
-
-;;---------------------------------------------------------------------------
-;; Patches to standard keymaps insert completions
-;;---------------------------------------------------------------------------
-
-;;-----------------------------------------------
-;; Separators
-;;-----------------------------------------------
-;; We've used the completion syntax table given  as a guide.
-;;
-;; Global separator chars.
-;;  We left out <tab> because there are too many special cases for it.  Also,
-;; in normal coding it's rarely typed after a word.
-(global-set-key " " 'completion-separator-self-insert-autofilling)
-(global-set-key "!" 'completion-separator-self-insert-command)
-(global-set-key "%" 'completion-separator-self-insert-command)
-(global-set-key "^" 'completion-separator-self-insert-command)
-(global-set-key "&" 'completion-separator-self-insert-command)
-(global-set-key "(" 'completion-separator-self-insert-command)
-(global-set-key ")" 'completion-separator-self-insert-command)
-(global-set-key "=" 'completion-separator-self-insert-command)
-(global-set-key "`" 'completion-separator-self-insert-command)
-(global-set-key "|" 'completion-separator-self-insert-command)
-(global-set-key "{" 'completion-separator-self-insert-command)
-(global-set-key "}" 'completion-separator-self-insert-command)
-(global-set-key "[" 'completion-separator-self-insert-command)
-(global-set-key "]" 'completion-separator-self-insert-command)
-(global-set-key ";" 'completion-separator-self-insert-command)
-(global-set-key "\"" 'completion-separator-self-insert-command)
-(global-set-key "'" 'completion-separator-self-insert-command)
-(global-set-key "#" 'completion-separator-self-insert-command)
-(global-set-key "," 'completion-separator-self-insert-command)
-(global-set-key "?" 'completion-separator-self-insert-command)
-
-;; We include period and colon even though they are symbol chars because :
-;;  - in text we want to pick up the last word in a sentence.
-;;  - in C pointer refs. we want to pick up the first symbol
-;;  - it won't make a difference for lisp mode (package names are short)
-(global-set-key "." 'completion-separator-self-insert-command)
-(global-set-key ":" 'completion-separator-self-insert-command)
-
-;; Lisp Mode diffs
-(define-key lisp-mode-map "!" 'self-insert-command)
-(define-key lisp-mode-map "&" 'self-insert-command)
-(define-key lisp-mode-map "%" 'self-insert-command)
-(define-key lisp-mode-map "?" 'self-insert-command)
-(define-key lisp-mode-map "=" 'self-insert-command)
-(define-key lisp-mode-map "^" 'self-insert-command)
-
-;; Avoid warnings.
-(defvar c-mode-map)
-(defvar fortran-mode-map)
-
-;; C mode diffs.
-(defun completion-c-mode-hook ()
-  (def-completion-wrapper electric-c-semi :separator)
-  (define-key c-mode-map "+" 'completion-separator-self-insert-command)
-  (define-key c-mode-map "*" 'completion-separator-self-insert-command)
-  (define-key c-mode-map "/" 'completion-separator-self-insert-command))
-;; Do this either now or whenever C mode is loaded.
-(if (featurep 'cc-mode)
-    (completion-c-mode-hook)
-  (add-hook 'c-mode-hook 'completion-c-mode-hook))
-
-;; FORTRAN mode diffs. (these are defined when fortran is called)
-(defun completion-setup-fortran-mode ()
-  (define-key fortran-mode-map "+" 'completion-separator-self-insert-command)
-  (define-key fortran-mode-map "-" 'completion-separator-self-insert-command)
-  (define-key fortran-mode-map "*" 'completion-separator-self-insert-command)
-  (define-key fortran-mode-map "/" 'completion-separator-self-insert-command)
-  )
-
-;;-----------------------------------------------
-;; End of line chars.
-;;-----------------------------------------------
-(def-completion-wrapper newline :separator)
-(def-completion-wrapper newline-and-indent :separator)
-(def-completion-wrapper comint-send-input :separator)
-(def-completion-wrapper exit-minibuffer :minibuffer-separator)
-(def-completion-wrapper eval-print-last-sexp :separator)
-(def-completion-wrapper eval-last-sexp :separator)
-;;(def-completion-wrapper minibuffer-complete-and-exit :minibuffer)
-
-;;-----------------------------------------------
-;; Cursor movement
-;;-----------------------------------------------
-
-(def-completion-wrapper next-line :under-or-before)
-(def-completion-wrapper previous-line :under-or-before)
-(def-completion-wrapper beginning-of-buffer :under-or-before)
-(def-completion-wrapper end-of-buffer :under-or-before)
-(def-completion-wrapper beginning-of-line :under-or-before)
-(def-completion-wrapper end-of-line :under-or-before)
-(def-completion-wrapper forward-char :under-or-before)
-(def-completion-wrapper forward-word :under-or-before)
-(def-completion-wrapper forward-sexp :under-or-before)
-(def-completion-wrapper backward-char :backward-under)
-(def-completion-wrapper backward-word :backward-under)
-(def-completion-wrapper backward-sexp :backward-under)
-
-(def-completion-wrapper delete-backward-char :backward)
-(def-completion-wrapper delete-backward-char-untabify :backward)
-
-;; Tests --
-;; foobarbiz
-;; foobar 
-;; fooquux 
-;; fooper
-
-(cmpl-statistics-block
-  (record-completion-file-loaded))
-
-(provide 'completion)
-
-;;; completion.el ends here
diff --git a/lisp/dabbrev.el b/lisp/dabbrev.el
deleted file mode 100644
index ed6ef3e92a4..00000000000
--- a/lisp/dabbrev.el
+++ /dev/null
@@ -1,867 +0,0 @@
-;;; dabbrev.el --- dynamic abbreviation package
-
-;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Don Morrison
-;; Maintainer: Lars Lindberg <Lars.Lindberg@sypro.cap.se>
-;; Created: 16 Mars 1992
-;; Lindberg's last update version: 5.7
-;; Keywords: abbrev expand completion
-
-;; 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:
-
-;; The purpose with this package is to let you write just a few
-;; characters of words you've written earlier to be able to expand
-;; them.
-;;
-;; To expand a word, just put the point right after the word and press
-;; M-/ (dabbrev-expand) or M-C-/ (dabbrev-completion).
-;;
-;; Check out the customizable variables below to learn about all the
-;; features of this package.
-
-;;; Hints and tips for major modes writers:
-
-;; Recommended values		C/Lisp etc	text
-;; dabbrev-case-fold-search	nil		t
-;; dabbrev-case-replace		nil		t
-;;
-;; Set the variables you want special for your mode like this:
-;; (set (make-local-variable 'dabbrev-case-replace) nil)
-;; Then you don't interfere with other modes.
-;;
-;; If your mode handles buffers that refers to other buffers
-;; (i.e. compilation-mode, gud-mode), then try to set
-;; `dabbrev-select-buffers-function' or `dabbrev-friend-buffer-function'
-;; to a function that point out those buffers.
-
-;; Same goes for major-modes that are connected to other modes.  There
-;; are for instance a number of mail-modes.  One for reading, one for
-;; creating a new mail etc.  Maybe those should be connected.
-
-;; Example for GNUS (when we write a reply, we want dabbrev to look in
-;; the article for expansion):
-;; (set (make-local-variable 'dabbrev-friend-buffer-function)
-;;      (lambda (buffer)
-;;         (save-excursion
-;;           (set-buffer buffer)
-;;           (memq major-mode '(news-reply-mode gnus-article-mode)))))
-
-
-;; Known bugs and limitations.
-;; - Possible to do several levels of `dabbrev-completion' in the
-;;   minibuffer.
-;; - dabbrev-completion doesn't handle resetting the globals variables
-;;   right.  It resets them after finding the abbrev.
-
-;; Future enhancements
-;;  - Check the tags-files? Like tags-complete?
-;;  - Add the possibility of searching both forward and backward to
-;;    the nearest expansion.
-;;  - Check the kill-ring when everything else fails.  (Maybe something
-;;  for hippie-expand?).  [Bng] <boris@cs.rochester.edu>
-
-;;; These people gave suggestions:
-;;  [hymie]	Hyman Rosen <marks!hymie@jyacc.jyacc.com>
-;;  [burgett]	Steve Burgett <burgett@bizet.eecs.berkeley.edu>
-;;  [jules]	Julian Gosnell <jules@x.co.uk>
-;;  [kifer]	Michael Kifer <kifer@sbcs.sunysb.edu>
-;;  [ake]	Ake Stenhoff <extaksf@aom.ericsson.se>
-;;  [alon]	Alon Albert <al%imercury@uunet.uu.net>
-;;  [tromey]	Tom Tromey <tromey@busco.lanl.gov>
-;;  [Rolf]	Rolf Schreiber <rolf@mathematik.uni-stuttgart.de>
-;;  [Petri]	Petri Raitio <per@tekla.fi>
-;;  [ejb]	Jay Berkenbilt <ejb@ERA.COM>
-;;  [hawley]	Bob Hawley <rth1@quartet.mt.att.com>
-;;  ... and to all the people who have participated in the beta tests.
-
-;;; Code:
-
-;;----------------------------------------------------------------
-;; Customization variables
-;;----------------------------------------------------------------
-(defvar dabbrev-backward-only nil
-  "*If non-nil, `dabbrev-expand' only looks backwards.")
-
-(defvar dabbrev-limit nil
-  "*Limits region searched by `dabbrev-expand' to this many chars away.")
-
-(defvar dabbrev-abbrev-skip-leading-regexp nil
-  "*Regexp for skipping leading characters of an abbreviation.
-
-Example: Set this to \"\\\\$\" for programming languages
-in which variable names may appear with or without a leading `$'.
-\(For example, in Makefiles.)
-
-Set this to nil if no characters should be skipped.")
-
-;; I recommend that you set this to nil.
-(defvar dabbrev-case-fold-search 'case-fold-search
-  "*Non-nil if dabbrev searches should ignore case.
-A value of nil means case is significant.
-
-The value of this variable is an expression; it is evaluated
-and the resulting value determines the decision.
-For example: setting this to `case-fold-search' means evaluate that
-variable to see whether its value is nil.")
-
-(defvar dabbrev-upcase-means-case-search nil
-  "*The significance of an uppercase character in an abbreviation.
-nil means case fold search, non-nil means case sensitive search.
-
-This variable has an effect only when the value of
-`dabbrev-case-fold-search' evaluates to t.")
-
-;; I recommend that you set this to nil.
-(defvar dabbrev-case-replace 'case-replace
-  "*Non-nil means dabbrev should preserve case when expanding the abbreviation.
-More precisely, it preserves the case pattern of the abbreviation as you
-typed it--as opposed to the case pattern of the expansion that is copied.
-The value of this variable is an expression; it is evaluated
-and the resulting value determines the decision.
-For example, setting this to `case-replace' means evaluate that
-variable to see if its value is t or nil.
-
-This variable has an effect only when the value of
-`dabbrev-case-fold-search' evaluates to t.")
-
-(defvar dabbrev-abbrev-char-regexp nil
-  "*Regexp to recognize a character in an abbreviation or expansion.
-This regexp will be surrounded with \\\\( ... \\\\) when actually used.
-
-Set this variable to \"\\\\sw\" if you want ordinary words or
-\"\\\\sw\\\\|\\\\s_\" if you want symbols (including characters whose
-syntax is \"symbol\" as well as those whose syntax is \"word\".
-
-The value nil has a special meaning: the abbreviation is from point to
-previous word-start, but the search is for symbols.
-
-For instance, if you are programming in Lisp, `yes-or-no-p' is a symbol,
-while `yes', `or', `no' and `p' are considered words.  If this
-variable is nil, then expanding `yes-or-no-' looks for a symbol
-starting with or containing `no-'.  If you set this variable to
-\"\\\\sw\\\\|\\\\s_\", that expansion looks for a symbol starting with
-`yes-or-no-'.  Finally, if you set this variable to \"\\\\sw\", then
-expanding `yes-or-no-' signals an error because `-' is not part of a word;
-but expanding `yes-or-no' looks for a word starting with `no'.
-
-The recommended value is \"\\\\sw\\\\|\\\\s_\".")
-
-(defvar dabbrev-check-all-buffers t
-  "*Non-nil means dabbrev package should search *all* buffers.
-
-Dabbrev always searches the current buffer first.  Then, if
-`dabbrev-check-other-buffers' says so, it searches the buffers
-designated by `dabbrev-select-buffers-function'.
-
-Then, if `dabbrev-check-all-buffers' is non-nil, dabbrev searches
-all the other buffers.")
-
-(defvar dabbrev-check-other-buffers t
-  "*Should \\[dabbrev-expand] look in other buffers?\
-
-nil: Don't look in other buffers.
-t: Also look for expansions in the buffers pointed out by
-   `dabbrev-select-buffers-function'.
-Anything else: When we can't find any more expansions in
-the current buffer, then ask the user whether to look in other
-buffers too.
-
-The default value is t.")
-
-;; I guess setting this to a function that selects all C- or C++-
-;; mode buffers would be a good choice for a debugging buffer,
-;; when debugging C- or C++-code.
-(defvar dabbrev-select-buffers-function 'dabbrev--select-buffers
-  "A function that selects buffers that should be searched by dabbrev.
-The function should take no arguments and return a list of buffers to
-search for expansions.  Have a look at `dabbrev--select-buffers' for
-an example.
-
-A mode setting this variable should make it buffer local.")
-
-(defvar dabbrev-friend-buffer-function 'dabbrev--same-major-mode-p
-  "*A function to decide whether dabbrev should search OTHER-BUFFER.
-The function should take one argument, OTHER-BUFFER, and return
-non-nil if that buffer should be searched.  Have a look at
-`dabbrev--same-major-mode-p' for an example.
-
-The value of `dabbrev-friend-buffer-function' has an effect only if
-the value of `dabbrev-select-buffers-function' uses it.  The function
-`dabbrev--select-buffers' is one function you can use here.
-
-A mode setting this variable should make it buffer local.")
-
-(defvar dabbrev-search-these-buffers-only nil
-  "If non-nil, a list of buffers which dabbrev should search.
-If this variable is non-nil, dabbrev will only look in these buffers.
-It will not even look in the current buffer if it is not a member of
-this list.")
-
-;;----------------------------------------------------------------
-;; Internal variables
-;;----------------------------------------------------------------
-
-;; Last obarray of completions in `dabbrev-completion'
-(defvar dabbrev--last-obarray nil)
-
-;; Table of expansions seen so far
-(defvar dabbrev--last-table nil)
-
-;; Last string we tried to expand.
-(defvar dabbrev--last-abbreviation nil)
-
-;; Location last abbreviation began
-(defvar dabbrev--last-abbrev-location nil)
-
-;; Direction of last dabbrevs search
-(defvar dabbrev--last-direction 0)
-
-;; Last expansion of an abbreviation.
-(defvar dabbrev--last-expansion nil)
-
-;; Location the last expansion was found.
-(defvar dabbrev--last-expansion-location nil)
-
-;; The list of remaining buffers with the same mode as current buffer.
-(defvar dabbrev--friend-buffer-list nil)
-
-;; The buffer we looked in last.
-(defvar dabbrev--last-buffer nil)
-
-;; The buffer we found the expansion last time.
-(defvar dabbrev--last-buffer-found nil)
-
-;; The buffer we last did a completion in.
-(defvar dabbrev--last-completion-buffer nil)
-
-;; Non-nil means we should upcase
-;; when copying successive words.
-(defvar dabbrev--last-case-pattern nil)
-
-;; Same as dabbrev-check-other-buffers, but is set for every expand.
-(defvar dabbrev--check-other-buffers dabbrev-check-other-buffers)
-
-;; The regexp for recognizing a character in an abbreviation.
-(defvar dabbrev--abbrev-char-regexp nil)
-
-;;----------------------------------------------------------------
-;; Macros
-;;----------------------------------------------------------------
-
-;;; Get the buffer that mini-buffer was activated from
-(defsubst dabbrev--minibuffer-origin ()
-  (car (cdr (buffer-list))))
-
-;; Make a list of some of the elements of LIST.
-;; Check each element of LIST, storing it temporarily in the
-;; variable ELEMENT, and include it in the result
-;; if CONDITION evaluates non-nil.
-(defmacro dabbrev-filter-elements (element list condition)
-  (` (let (dabbrev-result dabbrev-tail (, element))
-       (setq dabbrev-tail (, list))
-       (while dabbrev-tail
-	 (setq (, element) (car dabbrev-tail))
-	 (if (, condition)
-	     (setq dabbrev-result (cons (, element) dabbrev-result)))
-	 (setq dabbrev-tail (cdr dabbrev-tail)))
-       (nreverse dabbrev-result))))
-
-;;----------------------------------------------------------------
-;; Exported functions
-;;----------------------------------------------------------------
-
-;;;###autoload
-(define-key esc-map "/" 'dabbrev-expand)
-;;;??? Do we want this?
-;;;###autoload
-(define-key esc-map [?\C-/] 'dabbrev-completion)
-
-;;;###autoload
-(defun dabbrev-completion (&optional arg)
-  "Completion on current word.
-Like \\[dabbrev-expand] but finds all expansions in the current buffer
-and presents suggestions for completion.
-
-With a prefix argument, it searches all buffers accepted by the
-function pointed out by `dabbrev-friend-buffer-function' to find the
-completions.
-
-If the prefix argument is 16 (which comes from C-u C-u),
-then it searches *all* buffers.
-
-With no prefix argument, it reuses an old completion list
-if there is a suitable one already."
-
-  (interactive "*P")
-  (dabbrev--reset-global-variables)
-  (let* ((dabbrev-check-other-buffers (and arg t))
-	 (dabbrev-check-all-buffers
-	  (and arg (= (prefix-numeric-value arg) 16)))
-	 (abbrev (dabbrev--abbrev-at-point))
-	 (ignore-case-p  (and (eval dabbrev-case-fold-search)
-			      (or (not dabbrev-upcase-means-case-search)
-				  (string= abbrev (downcase abbrev)))))
-	 (my-obarray dabbrev--last-obarray)
-	 init)
-    (save-excursion
-      (if (and (null arg)
-	       my-obarray
-	       (or (eq dabbrev--last-completion-buffer (current-buffer))
-		   (and (window-minibuffer-p (selected-window))
-			(eq dabbrev--last-completion-buffer
-			    (dabbrev--minibuffer-origin))))
-	       dabbrev--last-abbreviation
-	       (>= (length abbrev) (length dabbrev--last-abbreviation))
-	       (string= dabbrev--last-abbreviation
-			(substring abbrev 0
-				   (length dabbrev--last-abbreviation)))
-	       (setq init (try-completion abbrev my-obarray)))
-	  ;; We can reuse the existing completion list.
-	  nil
-	;;--------------------------------
-	;; New abbreviation to expand.
-	;;--------------------------------
-	(setq dabbrev--last-abbreviation abbrev)
-	;; Find all expansion
-	(let ((completion-list
-	       (dabbrev--find-all-expansions abbrev ignore-case-p))
-	      (completion-ignore-case ignore-case-p))
-	  ;; Make an obarray with all expansions
-	  (setq my-obarray (make-vector (length completion-list) 0))
-	  (or (> (length my-obarray) 0)
-	      (error "No dynamic expansion for \"%s\" found%s"
-		     abbrev
-		     (if dabbrev--check-other-buffers "" " in this-buffer")))
-	  (cond
-	   ((or (not ignore-case-p)
-		(not dabbrev-case-replace))
-	    (mapcar (function (lambda (string)
-				(intern string my-obarray)))
-		    completion-list))
-	   ((string= abbrev (upcase abbrev))
-	    (mapcar (function (lambda (string)
-				(intern (upcase string) my-obarray)))
-		    completion-list))
-	   ((string= (substring abbrev 0 1)
-		     (upcase (substring abbrev 0 1)))
-	    (mapcar (function (lambda (string)
-				(intern (capitalize string) my-obarray)))
-		    completion-list))
-	   (t
-	    (mapcar (function (lambda (string)
-				(intern (downcase string) my-obarray)))
-		    completion-list)))
-	  (setq dabbrev--last-obarray my-obarray)
-	  (setq dabbrev--last-completion-buffer (current-buffer))
-	  ;; Find the longest common string.
-	  (setq init (try-completion abbrev my-obarray)))))
-    ;;--------------------------------
-    ;; Let the user choose between the expansions
-    ;;--------------------------------
-    (or (stringp init)
-	(setq init abbrev))
-    (cond
-     ;; * Replace string fragment with matched common substring completion.
-     ((and (not (string-equal init ""))
-	   (not (string-equal (downcase init) (downcase abbrev))))
-      (if (> (length (all-completions init my-obarray)) 1)
-	  (message "Repeat `%s' to see all completions"
-		   (key-description (this-command-keys)))
-	(message "The only possible completion"))
-      (dabbrev--substitute-expansion nil abbrev init))
-     (t
-      ;; * String is a common substring completion already.  Make list.
-      (message "Making completion list...")
-      (with-output-to-temp-buffer " *Completions*"
-	(display-completion-list (all-completions init my-obarray)))
-      (message "Making completion list...done")))
-    (and (window-minibuffer-p (selected-window))
-	 (message nil))))
-
-;;;###autoload
-(defun dabbrev-expand (arg)
-  "Expand previous word \"dynamically\".
-
-Expands to the most recent, preceding word for which this is a prefix.
-If no suitable preceding word is found, words following point are
-considered.  If still no suitable word is found, then look in the
-buffers accepted by the function pointed out by variable
-`dabbrev-friend-buffer-function'.
-
-A positive prefix argument, N, says to take the Nth backward *distinct*
-possibility.  A negative argument says search forward.
-
-If the cursor has not moved from the end of the previous expansion and
-no argument is given, replace the previously-made expansion
-with the next possible expansion not yet tried.
-
-The variable `dabbrev-backward-only' may be used to limit the
-direction of search to backward if set non-nil.
-
-See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]."
-  (interactive "*P")
-  (let (abbrev record-case-pattern
-	       expansion old direction (orig-point (point)))
-    ;; abbrev -- the abbrev to expand
-    ;; expansion -- the expansion found (eventually) or nil until then
-    ;; old -- the text currently in the buffer
-    ;;    (the abbrev, or the previously-made expansion)
-    (save-excursion
-      (if (and (null arg)
-	       (markerp dabbrev--last-abbrev-location)
-	       (marker-position dabbrev--last-abbrev-location)
-	       (or (eq last-command this-command)
-		   (and (window-minibuffer-p (selected-window))
-			(= dabbrev--last-abbrev-location
-			   (point)))))
-	  ;; Find a different expansion for the same abbrev as last time.
-	  (progn
-	    (setq abbrev dabbrev--last-abbreviation)
-	    (setq old dabbrev--last-expansion)
-	    (setq direction dabbrev--last-direction))
-	;; If the user inserts a space after expanding
-	;; and then asks to expand again, always fetch the next word.
-	(if (and (eq (preceding-char) ?\ )
-		 (markerp dabbrev--last-abbrev-location)
-		 (marker-position dabbrev--last-abbrev-location)
-		 (= (point) (1+ dabbrev--last-abbrev-location)))
-	    (progn
-	      ;; The "abbrev" to expand is just the space.
-	      (setq abbrev " ")
-	      (save-excursion
-		(if dabbrev--last-buffer
-		    (set-buffer dabbrev--last-buffer))
-		;; Find the end of the last "expansion" word.
-		(if (or (eq dabbrev--last-direction 1)
-			(and (eq dabbrev--last-direction 0)
-			     (< dabbrev--last-expansion-location (point))))
-		    (setq dabbrev--last-expansion-location
-			  (+ dabbrev--last-expansion-location
-			     (length dabbrev--last-expansion))))
-		(goto-char dabbrev--last-expansion-location)
-		;; Take the following word, with intermediate separators,
-		;; as our expansion this time.
-		(re-search-forward
-		 (concat "\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)"))
-		(setq expansion
-		      (buffer-substring dabbrev--last-expansion-location
-					(point)))
-		(if dabbrev--last-case-pattern
-		    (setq expansion (upcase expansion)))
-
-		;; Record the end of this expansion, in case we repeat this.
-		(setq dabbrev--last-expansion-location (point)))
-	      ;; Indicate that dabbrev--last-expansion-location is
-	      ;; at the end of the expansion.
-	      (setq dabbrev--last-direction -1))
-
-	  ;; We have a different abbrev to expand.
-	  (dabbrev--reset-global-variables)
-	  (setq direction (if (null arg)
-			      (if dabbrev-backward-only 1 0)
-			    (prefix-numeric-value arg)))
-	  (setq abbrev (dabbrev--abbrev-at-point))
-	  (setq record-case-pattern t)
-	  (setq old nil)))
-
-      ;;--------------------------------
-      ;; Find the expansion
-      ;;--------------------------------
-      (or expansion
-	  (setq expansion
-		(dabbrev--find-expansion abbrev direction
-					 (and (eval dabbrev-case-fold-search)
-					      (or (not dabbrev-upcase-means-case-search)
-						  (string= abbrev (downcase abbrev))))))))
-    (cond
-     ((not expansion)
-      (dabbrev--reset-global-variables)
-      (if old
-	  (save-excursion
-	    (setq buffer-undo-list (cons orig-point buffer-undo-list))
-	    ;; Put back the original abbrev with its original case pattern.
-	    (search-backward old)
-	    (insert abbrev)
-	    (delete-region (point) (+ (point) (length old)))))
-      (error "No%s dynamic expansion for `%s' found"
-	     (if old " further" "") abbrev))
-     (t
-      (if (not (eq dabbrev--last-buffer dabbrev--last-buffer-found))
-	  (progn
-	    (message "Expansion found in '%s'"
-		     (buffer-name dabbrev--last-buffer))
-	    (setq dabbrev--last-buffer-found dabbrev--last-buffer))
-	(message nil))
-      (if (and (or (eq (current-buffer) dabbrev--last-buffer)
-		   (null dabbrev--last-buffer))
-	       (numberp dabbrev--last-expansion-location)
-	       (and (> dabbrev--last-expansion-location (point))))
-	  (setq dabbrev--last-expansion-location
-		(copy-marker dabbrev--last-expansion-location)))
-      ;; Success: stick it in and return.
-      (setq buffer-undo-list (cons orig-point buffer-undo-list))
-      (dabbrev--substitute-expansion old abbrev expansion)
-
-      ;; If we are not copying successive words now,
-      ;; set dabbrev--last-case-pattern.
-      (and record-case-pattern
-	   (setq dabbrev--last-case-pattern
-		 (and (eval dabbrev-case-fold-search)
-		      (not dabbrev-upcase-means-case-search)
-		      (equal abbrev (upcase abbrev)))))
-
-      ;; Save state for re-expand.
-      (setq dabbrev--last-expansion expansion)	
-      (setq dabbrev--last-abbreviation abbrev)
-      (setq dabbrev--last-abbrev-location (point-marker))))))
-
-;;----------------------------------------------------------------
-;; Local functions
-;;----------------------------------------------------------------
-
-;;; Checks if OTHER-BUFFER has the same major mode as current buffer.
-(defun dabbrev--same-major-mode-p (other-buffer)
-  (eq major-mode
-      (save-excursion
-	(set-buffer other-buffer)
-	major-mode)))
-
-;;; Back over all abbrev type characters and then moves forward over
-;;; all skip characters.
-(defun dabbrev--goto-start-of-abbrev ()
-  ;; Move backwards over abbrev chars
-  (save-match-data
-    (if (not (bobp))
-	(progn
-	  (forward-char -1)
-	  (while (and (looking-at dabbrev--abbrev-char-regexp)
-		      (not (bobp)))
-	    (forward-char -1))
-	  (or (looking-at dabbrev--abbrev-char-regexp)
-	      (forward-char 1))))
-    (and dabbrev-abbrev-skip-leading-regexp
-	 (while (looking-at dabbrev-abbrev-skip-leading-regexp)
-	   (forward-char 1)))))
-
-;;; Extract the symbol at point to serve as abbreviation.
-(defun dabbrev--abbrev-at-point ()
-  ;; Check for error
-  (if (bobp)
-      (error "No possible abbreviation preceding point"))
-  ;; Return abbrev at point
-  (save-excursion
-    ;; Record the end of the abbreviation.
-    (setq dabbrev--last-abbrev-location (point))
-    ;; If we aren't right after an abbreviation,
-    ;; move point back to just after one.
-    ;; This is so the user can get successive words
-    ;; by typing the punctuation followed by M-/.
-    (save-match-data
-      (if (save-excursion
-	    (forward-char -1)
-	    (not (looking-at (concat "\\("
-				     (or dabbrev-abbrev-char-regexp
-					 "\\sw\\|\\s_")
-				     "\\)+"))))
-	  (if (re-search-backward (or dabbrev-abbrev-char-regexp
-				      "\\sw\\|\\s_")
-				  nil t)
-	      (forward-char 1)
-	    (error "No possible abbreviation preceding point"))))
-    ;; Now find the beginning of that one.
-    (dabbrev--goto-start-of-abbrev)
-    (buffer-substring dabbrev--last-abbrev-location
-		      (point))))
-	
-;;; Initializes all global variables
-(defun dabbrev--reset-global-variables ()
-  ;; dabbrev--last-obarray and dabbrev--last-completion-buffer
-  ;; must not be reset here.
-  (setq dabbrev--last-table nil
-	dabbrev--last-abbreviation nil
-	dabbrev--last-abbrev-location nil
-	dabbrev--last-direction nil
-	dabbrev--last-expansion nil
-	dabbrev--last-expansion-location nil
-	dabbrev--friend-buffer-list nil
-	dabbrev--last-buffer nil
-	dabbrev--last-buffer-found nil
-	dabbrev--abbrev-char-regexp (or dabbrev-abbrev-char-regexp
-					"\\sw\\|\\s_")
-	dabbrev--check-other-buffers dabbrev-check-other-buffers))
-
-;;; Find all buffers that are considered "friends" according to the
-;;; function pointed out by dabbrev-friend-buffer-function.
-(defun dabbrev--select-buffers ()
-  (save-excursion
-    (and (window-minibuffer-p (selected-window))
-	 (set-buffer (dabbrev--minibuffer-origin)))
-    (let ((orig-buffer (current-buffer)))
-      (dabbrev-filter-elements
-       buffer (buffer-list)
-       (and (not (eq orig-buffer buffer))
-	    (boundp 'dabbrev-friend-buffer-function)
-	    (funcall dabbrev-friend-buffer-function buffer))))))
-
-;;; Search for ABBREV, N times, normally looking forward,
-;;; but looking in reverse instead if REVERSE is non-nil.
-(defun dabbrev--try-find (abbrev reverse n ignore-case)
-  (save-excursion
-    (save-restriction
-      (widen)
-      (let ((expansion nil))
-	(and dabbrev--last-expansion-location
-	     (goto-char dabbrev--last-expansion-location))
-	(let ((case-fold-search ignore-case)
-	      (count n))
-	  (while (and (> count 0)
-		      (setq expansion (dabbrev--search abbrev
-						       reverse
-						       ignore-case)))
-	    (setq count (1- count))))
-	(and expansion
-	     (setq dabbrev--last-expansion-location (point)))
-	expansion))))
-
-;;; Find all expansions of ABBREV
-(defun dabbrev--find-all-expansions (abbrev ignore-case)
-  (let ((all-expansions nil)
-	expansion)
-    (save-excursion
-      (goto-char (point-min))
-      (while (setq expansion (dabbrev--find-expansion abbrev -1 ignore-case))
-	(setq all-expansions (cons expansion all-expansions))))
-    all-expansions))
-
-(defun dabbrev--scanning-message ()
-  (message "Scanning `%s'" (buffer-name (current-buffer))))
-
-;;; Find one occasion of ABBREV.
-;;; DIRECTION > 0 means look that many times backwards.
-;;; DIRECTION < 0 means look that many times forward.
-;;; DIRECTION = 0 means try both backward and forward.
-;;; IGNORE-CASE non-nil means ignore case when searching.
-(defun dabbrev--find-expansion (abbrev direction ignore-case)
-  (let (expansion)
-    (save-excursion
-      (cond
-       (dabbrev--last-buffer
-	(set-buffer dabbrev--last-buffer)
-	(dabbrev--scanning-message))
-       ((and (not dabbrev-search-these-buffers-only)
-	     (window-minibuffer-p (selected-window)))
-	(set-buffer (dabbrev--minibuffer-origin))
-	;; In the minibuffer-origin buffer we will only search from
-	;; the top and down.
-	(goto-char (point-min))
-	(setq direction -1)
-	(dabbrev--scanning-message)))
-      (cond
-       ;; ------------------------------------------
-       ;; Look backwards
-       ;; ------------------------------------------
-       ((and (not dabbrev-search-these-buffers-only)
-	     (>= direction 0)
-	     (setq dabbrev--last-direction (min 1 direction))
-	     (setq expansion (dabbrev--try-find abbrev t
-						(max 1 direction)
-						ignore-case)))
-	expansion)
-       ;; ------------------------------------------
-       ;; Look forward
-       ;; ------------------------------------------
-       ((and (or (not dabbrev-search-these-buffers-only)
-		 dabbrev--last-buffer)
-	     (<= direction 0)
-	     (setq dabbrev--last-direction -1)
-	     (setq expansion (dabbrev--try-find abbrev nil
-						(max 1 (- direction))
-						ignore-case)))
-	expansion)
-       ;; ------------------------------------------
-       ;; Look in other buffers.
-       ;; Start at (point-min) and look forward.
-       ;; ------------------------------------------
-       (t
-	(setq dabbrev--last-direction -1)
-	;; Make sure that we should check other buffers
-	(or dabbrev--friend-buffer-list
-	    dabbrev--last-buffer
-	    (setq dabbrev--friend-buffer-list
-		  (mapcar (function get-buffer)
-			  dabbrev-search-these-buffers-only))
-	    (not dabbrev--check-other-buffers)
-	    (not (or (eq dabbrev--check-other-buffers t)
-		     (progn
-		       (setq dabbrev--check-other-buffers
-			     (y-or-n-p "Scan other buffers also? ")))))
-	    (let* (friend-buffer-list non-friend-buffer-list)
-	      (setq dabbrev--friend-buffer-list
-		    (funcall dabbrev-select-buffers-function))
-	      (if dabbrev-check-all-buffers
-		  (setq non-friend-buffer-list
-			(nreverse
-			 (dabbrev-filter-elements
-			  buffer (buffer-list)
-			  (not (memq buffer dabbrev--friend-buffer-list))))
-			dabbrev--friend-buffer-list
-			(append dabbrev--friend-buffer-list
-				non-friend-buffer-list)))))
-	;; Move buffers that are visible on the screen
-	;; to the front of the list.
-	(if dabbrev--friend-buffer-list
-	    (let ((w (next-window (selected-window))))
-	      (while (not (eq w (selected-window)))
-		(setq dabbrev--friend-buffer-list
-		      (cons (window-buffer w)
-			    (delq (window-buffer w) dabbrev--friend-buffer-list)))
-		(setq w (next-window w)))))
-	;; Walk through the buffers
-	(while (and (not expansion) dabbrev--friend-buffer-list)
-	  (setq dabbrev--last-buffer
-		(car dabbrev--friend-buffer-list))
-	  (setq dabbrev--friend-buffer-list
-		(cdr dabbrev--friend-buffer-list))
-	  (set-buffer dabbrev--last-buffer)
-	  (dabbrev--scanning-message)
-	  (setq dabbrev--last-expansion-location (point-min))
-	  (setq expansion (dabbrev--try-find abbrev nil 1 ignore-case)))
-	expansion)))))
-
-(defun dabbrev--safe-replace-match (string &optional fixedcase literal)
-  (if (eq major-mode 'picture-mode)
-      (picture-replace-match string fixedcase literal)
-    (replace-match string fixedcase literal)))
-
-;;;----------------------------------------------------------------
-;;; Substitute the current string in buffer with the expansion
-;;; OLD is nil or the last expansion substring.
-;;; ABBREV is the abbreviation we are working with.
-;;; EXPANSION is the expansion substring.
-(defun dabbrev--substitute-expansion (old abbrev expansion)
-  ;;(undo-boundary)
-  (let ((use-case-replace (and (eval dabbrev-case-fold-search)
-			       (or (not dabbrev-upcase-means-case-search)
-				   (string= abbrev (downcase abbrev)))
-			       (eval dabbrev-case-replace))))
-    (and nil use-case-replace
-	 (setq old (concat abbrev (or old "")))
-	 (setq expansion (concat abbrev expansion)))
-    ;; If the given abbrev is mixed case and its case pattern
-    ;; matches the start of the expansion,
-    ;; copy the expansion's case
-    ;; instead of downcasing all the rest.
-    (if (and (string= abbrev
-		      (substring expansion 0 (length abbrev)))
-	     (not (string= abbrev (downcase abbrev)))
-	     (not (string= abbrev (upcase abbrev))))
-	(setq use-case-replace nil))
-    (if (equal abbrev " ")
-	(setq use-case-replace nil))
-    (if use-case-replace
-	(setq expansion (downcase expansion)))
-    (if old
-	(save-excursion
-	  (search-backward old))
-      ;;(store-match-data (list (point-marker) (point-marker)))
-      (search-backward abbrev))
-    ;; Make case of replacement conform to case of abbreviation
-    ;; provided (1) that kind of thing is enabled in this buffer
-    ;; and (2) the replacement itself is all lower case.
-    (dabbrev--safe-replace-match expansion
-				 (not use-case-replace)
-				 t)))
-
-
-;;;----------------------------------------------------------------
-;;; Search function used by dabbrevs library.
-
-;;; ABBREV is string to find as prefix of word.  Second arg, REVERSE,
-;;; is t for reverse search, nil for forward.  Variable dabbrev-limit
-;;; controls the maximum search region size.  Third argument IGNORE-CASE
-;;; non-nil means treat case as insignificant while looking for a match
-;;; and when comparing with previous matches.  Also if that's non-nil
-;;; and the match is found at the beginning of a sentence and is in
-;;; lower case except for the initial then it is converted to all lower
-;;; case for return.
-
-;;; Table of expansions already seen is examined in buffer
-;;; `dabbrev--last-table' so that only distinct possibilities are found
-;;; by dabbrev-re-expand.
-
-;;; Value is the expansion, or nil if not found.
-
-(defun dabbrev--search (abbrev reverse ignore-case)
-  (save-match-data
-    (let ((pattern1 (concat (regexp-quote abbrev)
-			    "\\(" dabbrev--abbrev-char-regexp "\\)"))
-	  (pattern2 (concat (regexp-quote abbrev)
-			   "\\(\\(" dabbrev--abbrev-char-regexp "\\)+\\)"))
-	  (found-string nil))
-      ;; Limited search.
-      (save-restriction
-	(and dabbrev-limit
-	     (narrow-to-region dabbrev--last-expansion-location
-			       (+ (point)
-				  (if reverse (- dabbrev-limit) dabbrev-limit))))
-	;;--------------------------------
-	;; Look for a distinct expansion, using dabbrev--last-table.
-	;;--------------------------------
-	(while (and (not found-string)
-		    (if reverse
-			(re-search-backward pattern1 nil t)
-		      (re-search-forward pattern1 nil t)))
-	  (goto-char (match-beginning 0))
-	  ;; In case we matched in the middle of a word,
-	  ;; back up to start of word and verify we still match.
-	  (dabbrev--goto-start-of-abbrev)
-
-	  (if (not (looking-at pattern1))
-	      nil
-	    ;; We have a truly valid match.  Find the end.
-	    (re-search-forward pattern2)
-	    (setq found-string
-		  (buffer-substring (match-beginning 1) (match-end 1)))
-	    (and ignore-case (setq found-string (downcase found-string)))
-	    ;; Ignore this match if it's already in the table.
-	    (if (dabbrev-filter-elements
-		 table-string dabbrev--last-table
-		 (string= found-string table-string))
-		(setq found-string nil)))
-	  ;; Prepare to continue searching.
-	  (if reverse
-	      (goto-char (match-beginning 0))
-	    (goto-char (match-end 0))))
-	;; If we found something, use it.
-	(if found-string
-	    ;; Put it into `dabbrev--last-table'
-	    ;; and return it (either downcased, or as is).
-	    (let ((result
-		   (buffer-substring (match-beginning 0) (match-end 0))))
-	      (setq dabbrev--last-table
-		    (cons found-string dabbrev--last-table))
-	      (if (and ignore-case (eval dabbrev-case-replace))
-		  result
-		result)))))))
-
-(provide 'dabbrev)
-
-;;; dabbrev.el ends here
diff --git a/lisp/delsel.el b/lisp/delsel.el
deleted file mode 100644
index b402bf4f3c5..00000000000
--- a/lisp/delsel.el
+++ /dev/null
@@ -1,119 +0,0 @@
-;;; delsel.el --- delete selection if you insert
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Matthieu Devin <devin@lucid.com>
-;; Created: 14 Jul 92
-;; Last change  18-Feb-93, devin.
-
-;; 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 makes the active region be pending delete, meaning that
-;; text inserted while the region is active will replace the region contents.
-;; This is a popular behavior of personal computers text editors.
-
-;;; Code:
-
-(defvar delete-selection-mode t
-  "*Non-nil means Delete Selection mode is enabled.
-In Delete Selection mode, when a region is highlighted,
-insertion commands first delete the region and then insert.")
-
-(defun delete-active-region (&optional killp)
-  (if killp
-      (kill-region (point) (mark))
-    (delete-region (point) (mark)))
-  (setq mark-active nil)
-  (run-hooks 'deactivate-mark-hook)
-  t)
-
-(defun delete-selection-pre-hook ()
-  (if (and delete-selection-mode
-	   (not buffer-read-only)
-	   transient-mark-mode mark-active)
-      (let ((type (and (symbolp this-command)
-		       (get this-command 'delete-selection))))
-	(cond ((eq type 'kill)
-	       (delete-active-region t))
-	      ((eq type 'yank)
-	       ;; Before a yank command,
-	       ;; make sure we don't yank the same region
-	       ;; that we are going to delete.
-	       ;; That would make yank a no-op.
-	       (if (string= (buffer-substring (point) (mark))
-			    (car kill-ring))
-		   (current-kill 1))
-	       (delete-active-region nil))
-	      ((eq type 'supersede)
-	       (if (delete-active-region nil)
-		   (setq this-command '(lambda () (interactive)))))
-	      (type
-	       (delete-active-region nil))))))
-
-(add-hook 'pre-command-hook 'delete-selection-pre-hook)
-
-(put 'self-insert-command 'delete-selection t)
-(put 'self-insert-iso 'delete-selection t)
-
-(put 'yank 'delete-selection 'yank)
-(put 'clipboard-yank 'delete-selection 'yank)
-(put 'insert-register 'delete-selection t)
-
-(put 'delete-backward-char 'delete-selection 'supersede)
-(put 'backward-delete-char-untabify 'delete-selection 'supersede)
-(put 'delete-char 'delete-selection 'supersede)
-
-(put 'newline-and-indent 'delete-selection 't)
-(put 'newline 'delete-selection t)
-(put 'open-line 'delete-selection t)
-
-;;;###autoload
-(defalias 'pending-delete-mode 'delete-selection-mode)
-;;;###autoload
-(defun delete-selection-mode (arg)
-  "Toggle Delete Selection mode.
-When ON, typed text replaces the selection if the selection is active.
-When OFF, typed text is just inserted at point."
-  (interactive "P")
-  (setq delete-selection-mode
-	(if (null arg) (not delete-selection-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (force-mode-line-update))
-
-;; This is very useful for cancelling a selection in the minibuffer without 
-;; aborting the minibuffer.
-(defun minibuffer-keyboard-quit ()
-  "Abort recursive edit.
-In Delete Selection mode mode, if the mark is active, just deactivate it;
-then it takes a second C-g to abort the minibuffer."
-  (interactive)
-  (if (and delete-selection-mode transient-mark-mode mark-active)
-      (setq deactivate-mark t)
-    (abort-recursive-edit)))
-
-(define-key minibuffer-local-map "\C-g" 'minibuffer-keyboard-quit) 
-(define-key minibuffer-local-ns-map "\C-g" 'minibuffer-keyboard-quit) 
-(define-key minibuffer-local-completion-map "\C-g" 'minibuffer-keyboard-quit) 
-(define-key minibuffer-local-must-match-map "\C-g" 'minibuffer-keyboard-quit) 
-(define-key minibuffer-local-isearch-map "\C-g" 'minibuffer-keyboard-quit) 
-
-(provide 'delsel)
-
-;;; delsel.el ends here
diff --git a/lisp/derived.el b/lisp/derived.el
deleted file mode 100644
index 48824a61ec2..00000000000
--- a/lisp/derived.el
+++ /dev/null
@@ -1,352 +0,0 @@
-;;; derived.el --- allow inheritance of major modes.
-;;; (formerly mode-clone.el)
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: David Megginson (dmeggins@aix1.uottawa.ca)
-;; 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:
-
-;; 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.
-;; - **run the command (hypertext-mode-setup), which is empty by
-;;   default, but may be redefined by the user to contain special
-;;   commands (ie. setting local variables like 'outline-regexp')
-;;   **NOTE: do not use this option -- it will soon be obsolete.
-;; - run anything assigned to 'hypertext-mode-hooks' (obsolete, but
-;;   supported for the sake of compatibility).
-;;
-;; 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-class,' which returns the non-derived
-;; major mode which a derived mode is based on (ie. NOT necessarily the
-;; immediate parent).
-;;
-;; (derived-mode-class 'text-mode) ==> text-mode
-;; (derived-mode-class 'hypertext-mode) ==> text-mode
-;; (derived-mode-class 'html-mode) ==> text-mode
-
-;;; Code:
-
-;; 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 (ie. text-mode).
-NAME:      a string which will appear in the status line (ie. \"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.
-
-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."
-
-					; Some trickiness, since what
-					; appears to be the docstring
-					; may really be the first
-					; element of the body.
-  (if (and docstring (not (stringp docstring)))
-      (progn (setq body (cons docstring body))
-	     (setq docstring nil)))
-  (setq docstring (or docstring (derived-mode-make-docstring parent child)))
-
-  (` (progn 
-       (derived-mode-init-mode-variables (quote (, child)))
-       (defun (, child) ()
-	 (, docstring)
-	 (interactive)
-					; Run the parent.
-	 ((, parent))
-					; Identify special modes.
-	 (if (get (quote (, parent)) 'special)
-	     (put (quote (, child)) 'special t))
-					; Identify the child mode.
-	 (setq major-mode (quote (, child)))
-	 (setq mode-name (, name))
-					; Set up maps and tables.
-	 (derived-mode-set-keymap (quote (, child)))
-	 (derived-mode-set-syntax-table (quote (, child)))
-	 (derived-mode-set-abbrev-table (quote (, child)))
-					; Splice in the body (if any).
-	 (,@ body)
-;;;					; Run the setup function, if
-;;;					; any -- this will soon be
-;;;					; obsolete.
-;;;	 (derived-mode-run-setup-function (quote (, child)))
-					; Run the hooks, if any.
-	 (derived-mode-run-hooks (quote (, child)))))))
-
-
-;; 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."
-  (while (get mode 'derived-mode-parent)
-    (setq mode (get mode 'derived-mode-parent)))
-  mode)
-
-
-;; Inline functions to construct various names from a mode name.
-
-(defsubst derived-mode-setup-function-name (mode)
-  "Construct a setup-function name based on a mode name."
-  (intern (concat (symbol-name mode) "-setup")))
-
-(defsubst derived-mode-hooks-name (mode)
-  "Construct a hooks name based on a mode name."
-  (intern (concat (symbol-name mode) "-hooks")))
-
-(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")))
-
-
-;; 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)))))))
-
-(defun derived-mode-make-docstring (parent child)
-  "Construct a docstring for a new mode if none is provided."
-
-  (format "This major mode is a variant of `%s', created by `define-derived-mode'.
-It inherits all of the parent's attributes, but has its own keymap,
-abbrev table and syntax table:
-
-  `%s-map' and `%s-syntax-table'
-
-which more-or-less shadow
-
-  `%s-map' and `%s-syntax-table'
-
-\\{%s-map}" parent child child parent parent child))
-
-
-;; 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 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 hooks if they exist."
-
-  (let ((hooks-name (derived-mode-hooks-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."
-  (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 
-       (function 
-	(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/desktop.el b/lisp/desktop.el
deleted file mode 100644
index 1eee466697a..00000000000
--- a/lisp/desktop.el
+++ /dev/null
@@ -1,587 +0,0 @@
-;;; desktop.el --- save partial status of Emacs when killed
-
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Morten Welinder <terra@diku.dk>
-;; Keywords: customization
-;; Favourite-brand-of-beer: None, I hate beer.
-
-;; 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:
-
-;; Save the Desktop, i.e.,
-;;	- some global variables
-;; 	- the list of buffers with associated files.  For each buffer also
-;;		- the major mode
-;;		- the default directory
-;;		- the point
-;;		- the mark & mark-active
-;;		- buffer-read-only
-;;		- some local variables
-
-;; To use this, first put these three lines in the bottom of your .emacs
-;; file (the later the better):
-;;
-;;	(load "desktop")
-;;	(desktop-load-default)
-;;	(desktop-read)
-;;
-;; Between the second and the third line you may wish to add something that
-;; updates the variables `desktop-globals-to-save' and/or
-;; `desktop-locals-to-save'.  If for instance you want to save the local
-;; variable `foobar' for every buffer in which it is local, you could add
-;; the line
-;;
-;;	(setq desktop-locals-to-save (cons 'foobar desktop-locals-to-save))
-;;
-;; To avoid saving excessive amounts of data you may also wish to add
-;; something like the following
-;;
-;;	(add-hook 'kill-emacs-hook
-;;		  '(lambda ()
-;;		     (desktop-truncate search-ring 3)
-;;		     (desktop-truncate regexp-search-ring 3)))
-;;
-;; which will make sure that no more than three search items are saved.  You
-;; must place this line *after* the (load "desktop") line.  See also the
-;; variable desktop-save-hook.
-
-;; Start Emacs in the root directory of your "project". The desktop saver
-;; is inactive by default.  You activate it by M-x desktop-save RET.  When
-;; you exit the next time the above data will be saved.  This ensures that
-;; all the files you were editing will be reloaded the next time you start
-;; Emacs from the same directory and that points will be set where you
-;; left them.  If you save a desktop file in your home directory it will
-;; act as a default desktop when you start Emacs from a directory that
-;; doesn't have its own.  I never do this, but you may want to.
-
-;; By the way: don't use desktop.el to customize Emacs -- the file .emacs
-;; in your home directory is used for that.  Saving global default values
-;; for buffers is an example of misuse.
-
-;; PLEASE NOTE: The kill ring can be saved as specified by the variable
-;; `desktop-globals-to-save' (by default it isn't).  This may result in saving
-;; things you did not mean to keep.  Use M-x desktop-clear RET.
-
-;; Thanks to  hetrick@phys.uva.nl (Jim Hetrick)      for useful ideas.
-;;            avk@rtsg.mot.com (Andrew V. Klein)     for a dired tip.
-;;            chris@tecc.co.uk (Chris Boucher)       for a mark tip.
-;;            f89-kam@nada.kth.se (Klas Mellbourn)   for a mh-e tip.
-;;            kifer@sbkifer.cs.sunysb.edu (M. Kifer) for a bug hunt.
-;;            treese@lcs.mit.edu (Win Treese)        for ange-ftp tips.
-;;            pot@cnuce.cnr.it (Francesco Potorti`)  for misc. tips.
-;; ---------------------------------------------------------------------------
-;; TODO:
-;;
-;; Save window configuration.
-;; Recognize more minor modes.
-;; Save mark rings.
-;; Start-up with buffer-menu???
-
-;;; Code:
-
-;; Make the compilation more silent
-(eval-when-compile
-  ;; We use functions from these modules
-  ;; We can't (require 'mh-e) since that wants to load something.
-  (mapcar 'require '(info dired reporter)))
-;; ----------------------------------------------------------------------------
-;; USER OPTIONS -- settings you might want to play with.
-;; ----------------------------------------------------------------------------
-(defconst desktop-basefilename
-  (convert-standard-filename ".emacs.desktop")
-  "File for Emacs desktop, not including the directory name.")
-
-(defvar desktop-missing-file-warning t
-  "*If non-nil then desktop warns when a file no longer exists.
-Otherwise it simply ignores that file.")
-
-(defvar desktop-globals-to-save
-  (list 'desktop-missing-file-warning
-	;; Feature: saving kill-ring implies saving kill-ring-yank-pointer
-	;; 'kill-ring
-	'tags-file-name
-	'tags-table-list
-	'search-ring
-	'regexp-search-ring
-	'register-alist
-	;; 'desktop-globals-to-save	; Itself!
-	)
-  "List of global variables to save when killing Emacs.
-An element may be variable name (a symbol)
-or a cons cell of the form  (VAR . MAX-SIZE),
-which means to truncate VAR's value to at most MAX-SIZE elements
-\(if the value is a list) before saving the value.")
-
-(defvar desktop-locals-to-save
-  (list 'desktop-locals-to-save		; Itself!  Think it over.
-        'truncate-lines
-	'case-fold-search
-	'case-replace
-	'fill-column
-	'overwrite-mode
-	'change-log-default-name
-	'line-number-mode
-	)
-  "List of local variables to save for each buffer.
-The variables are saved only when they really are local.")
-(make-variable-buffer-local 'desktop-locals-to-save)
-
-;; We skip .log files because they are normally temporary.
-;;         (ftp) files because they require passwords and whatnot.
-;;         TAGS files to save time (tags-file-name is saved instead).
-(defvar desktop-buffers-not-to-save
- "\\(^nn\\.a[0-9]+\\|\\.log\\|(ftp)\\|^tags\\|^TAGS\\)$"
- "Regexp identifying buffers that are to be excluded from saving.")
-
-;; Skip ange-ftp files
-(defvar desktop-files-not-to-save
-  "^/[^/:]*:"
-  "Regexp identifying files whose buffers are to be excluded from saving.")
-
-(defvar desktop-buffer-major-mode nil
-  "When desktop creates a buffer, this holds the desired Major mode.")
-
-(defvar desktop-buffer-file-name nil
-  "When desktop creates a buffer, this holds the file name to visit.")
-
-(defvar desktop-buffer-name nil
-  "When desktop creates a buffer, this holds the desired buffer name.")
-
-(defvar desktop-buffer-misc nil
-  "When desktop creates a buffer, this holds a list of misc info.
-It is used by the `desktop-buffer-handlers' functions.")
-
-(defvar desktop-buffer-handlers
-  '(desktop-buffer-dired
-    desktop-buffer-rmail
-    desktop-buffer-mh
-    desktop-buffer-info
-    desktop-buffer-file)
-  "*List of functions to call in order to create a buffer.
-The functions are called without explicit parameters but can use the
-variables `desktop-buffer-major-mode', `desktop-buffer-file-name',
-`desktop-buffer-name'.
-If one function returns non-nil, no further functions are called.
-If the function returns t then the buffer is considered created.")
-
-(defvar desktop-create-buffer-form "(desktop-create-buffer 205"
-  "Opening of form for creation of new buffers.")
-
-(defvar desktop-save-hook nil
-  "Hook run before saving the desktop to allow you to cut history lists and
-the like shorter.")
-;; ----------------------------------------------------------------------------
-(defvar desktop-dirname nil
-  "The directory in which the current desktop file resides.")
-
-(defconst desktop-header
-";; --------------------------------------------------------------------------
-;; Desktop File for Emacs
-;; --------------------------------------------------------------------------
-" "*Header to place in Desktop file.")
-
-(defvar desktop-delay-hook nil
-  "Hooks run after all buffers are loaded; intended for internal use.")
-;; ----------------------------------------------------------------------------
-(defun desktop-truncate (l n)
-  "Truncate LIST to at most N elements destructively."
-  (let ((here (nthcdr (1- n) l)))
-    (if (consp here)
-	(setcdr here nil))))
-;; ----------------------------------------------------------------------------
-(defun desktop-clear () "Empty the Desktop."
-  (interactive)
-  (setq kill-ring nil
-	kill-ring-yank-pointer nil
-	search-ring nil
-	search-ring-yank-pointer nil
-	regexp-search-ring nil
-	regexp-search-ring-yank-pointer nil)
-  (mapcar (function kill-buffer) (buffer-list))
-  (delete-other-windows))
-;; ----------------------------------------------------------------------------
-(add-hook 'kill-emacs-hook 'desktop-kill)
-
-(defun desktop-kill ()
-  (if desktop-dirname
-      (condition-case err
-	  (desktop-save desktop-dirname)
-	(file-error
-	 (if (yes-or-no-p "Error while saving the desktop.  Quit anyway? ")
-	     nil
-	   (signal (car err) (cdr err)))))))
-;; ----------------------------------------------------------------------------
-(defun desktop-list* (&rest args)
-  (if (null (cdr args))
-      (car args)
-    (setq args (nreverse args))
-    (let ((value (cons (nth 1 args) (car args))))
-      (setq args (cdr (cdr args)))
-      (while args
-	(setq value (cons (car args) value))
-	(setq args (cdr args)))
-      value)))
-
-(defun desktop-internal-v2s (val)
-  "Convert VALUE to a pair (QUOTE . TXT); (eval (read TXT)) gives VALUE.
-TXT is a string that when read and evaluated yields value.
-QUOTE may be `may' (value may be quoted),
-`must' (values must be quoted), or nil (value may not be quoted)."
-  (cond
-   ((or (numberp val) (null val) (eq t val))
-    (cons 'may (prin1-to-string val)))
-   ((stringp val)
-    (let ((copy (copy-sequence val)))
-      (set-text-properties 0 (length copy) nil copy)
-      ;; Get rid of text properties because we cannot read them
-      (cons 'may (prin1-to-string copy))))
-   ((symbolp val)
-    (cons 'must (prin1-to-string val)))
-   ((vectorp val)
-    (let* ((special nil)
-	   (pass1 (mapcar
-		   (lambda (el)
-		     (let ((res (desktop-internal-v2s el)))
-		       (if (null (car res))
-			   (setq special t))
-		       res))
-		   val)))
-      (if special
-	  (cons nil (concat "(vector "
-			    (mapconcat (lambda (el)
-					 (if (eq (car el) 'must)
-					     (concat "'" (cdr el))
-					   (cdr el)))
-				       pass1
-				       " ")
-			    ")"))
-	(cons 'may (concat "[" (mapconcat 'cdr pass1 " ") "]")))))
-   ((consp val)
-    (let ((p val)
-	  newlist
-	  use-list*
-	  anynil)
-      (while (consp p)
-	(let ((q.txt (desktop-internal-v2s (car p))))
-	  (or anynil (setq anynil (null (car q.txt))))
-	  (setq newlist (cons q.txt newlist)))
-	(setq p (cdr p)))
-      (if p
-	  (let ((last (desktop-internal-v2s p))
-		(el (car newlist)))
-	    (or anynil (setq anynil (null (car last))))
-	    (or anynil
-		(setq newlist (cons '(must . ".") newlist)))
-	    (setq use-list* t)
-	    (setq newlist (cons last newlist))))
-      (setq newlist (nreverse newlist))
-      (if anynil
-	  (cons nil
-		(concat (if use-list* "(desktop-list* "  "(list ")
-			(mapconcat (lambda (el)
-				     (if (eq (car el) 'must)
-					 (concat "'" (cdr el))
-				       (cdr el)))
-				   newlist
-				   " ")
-			")"))
-	(cons 'must
-	      (concat "(" (mapconcat 'cdr newlist " ") ")")))))
-   ((subrp val)
-    (cons nil (concat "(symbol-function '"
-		      (substring (prin1-to-string val) 7 -1)
-		      ")")))
-   ((markerp val)
-    (let ((pos (prin1-to-string (marker-position val)))
-	  (buf (prin1-to-string (buffer-name (marker-buffer val)))))
-      (cons nil (concat "(let ((mk (make-marker)))"
-			" (add-hook 'desktop-delay-hook"
-			" (list 'lambda '() (list 'set-marker mk "
-			pos " (get-buffer " buf ")))) mk)"))))
-   (t					; save as text
-    (cons 'may "\"Unprintable entity\""))))
-
-(defun desktop-value-to-string (val)
-  "Convert VALUE to a string that when read evaluates to the same value.
-Not all types of values are supported."
-  (let* ((print-escape-newlines t)
-	 (float-output-format nil)
-	 (quote.txt (desktop-internal-v2s val))
-	 (quote (car quote.txt))
-	 (txt (cdr quote.txt)))
-    (if (eq quote 'must)
-	(concat "'" txt)
-      txt)))
-;; ----------------------------------------------------------------------------
-(defun desktop-outvar (varspec)
-  "Output a setq statement for variable VAR to the desktop file.
-The argument VARSPEC may be the variable name VAR (a symbol),
-or a cons cell of the form  (VAR . MAX-SIZE),
-which means to truncate VAR's value to at most MAX-SIZE elements
-\(if the value is a list) before saving the value."
-  (let (var size)
-    (if (consp varspec)
-	(setq var (car varspec) size (cdr varspec))
-      (setq var varspec))
-    (if (boundp var)
-	(progn
-	  (if (and (integerp size)
-		   (> size 0)
-		   (listp (eval var)))
-	      (desktop-truncate (eval var) size)) 
-	  (insert "(setq "
-		  (symbol-name var)
-		  " "
-		  (desktop-value-to-string (symbol-value var))
-		  ")\n")))))
-;; ----------------------------------------------------------------------------
-(defun desktop-save-buffer-p (filename bufname mode &rest dummy)
-  "Return t if the desktop should record a particular buffer for next startup.
-FILENAME is the visited file name, BUFNAME is the buffer name, and
-MODE is the major mode."
-  (let ((case-fold-search nil))
-    (or (and filename
-	     (not (string-match desktop-buffers-not-to-save bufname))
-	     (not (string-match desktop-files-not-to-save filename)))
-	(and (eq mode 'dired-mode)
-	     (save-excursion
-	       (set-buffer (get-buffer bufname))
-	       (not (string-match desktop-files-not-to-save
-				  default-directory))))
-	(and (null filename)
-	     (memq mode '(Info-mode rmail-mode))))))
-;; ----------------------------------------------------------------------------
-(defun desktop-save (dirname)
-  "Save the Desktop file.  Parameter DIRNAME specifies where to save desktop."
-  (interactive "DDirectory to save desktop file in: ")
-  (run-hooks 'desktop-save-hook)
-  (save-excursion
-    (let ((filename (expand-file-name
-		     (concat dirname desktop-basefilename)))
-	  (info (nreverse
-		 (mapcar
-		  (function (lambda (b)
-			      (set-buffer b)
-			      (list
-			       (buffer-file-name)
-			       (buffer-name)
-			       major-mode
-			       (list	; list explaining minor modes
-				(not (null auto-fill-function)))
-			       (point)
-			       (list (mark t) mark-active)
-			       buffer-read-only
-			       (cond ((eq major-mode 'Info-mode)
-				      (list Info-current-file
-					    Info-current-node))
-				     ((eq major-mode 'dired-mode)
-				      (cons
-				       (expand-file-name dired-directory)
-				       (cdr
-					(nreverse
-					 (mapcar
-					  (function car)
-					  dired-subdir-alist))))))
-			       (let ((locals desktop-locals-to-save)
-				     (loclist (buffer-local-variables))
-				     (ll))
-				 (while locals
-				   (let ((here (assq (car locals) loclist)))
-				     (if here
-					 (setq ll (cons here ll))
-				       (if (member (car locals) loclist)
-					   (setq ll (cons (car locals) ll)))))
-				   (setq locals (cdr locals)))
-				 ll)
-			       )))
-		  (buffer-list))))
-	  (buf (get-buffer-create "*desktop*")))
-      (set-buffer buf)
-      (erase-buffer)
-
-      (insert desktop-header
-	      ";; Created " (current-time-string) "\n"
-	      ";; Emacs version " emacs-version "\n\n"
-	      ";; Global section:\n")
-      (mapcar (function desktop-outvar) desktop-globals-to-save)
-      (if (memq 'kill-ring desktop-globals-to-save)
-	  (insert "(setq kill-ring-yank-pointer (nthcdr "
-		  (int-to-string
-		   (- (length kill-ring) (length kill-ring-yank-pointer)))
-		  " kill-ring))\n"))
-
-      (insert "\n;; Buffer section:\n")
-      (mapcar
-       (function (lambda (l)
-		   (if (apply 'desktop-save-buffer-p l)
-		       (progn
-			 (insert desktop-create-buffer-form)
-			 (mapcar
-			  (function (lambda (e)
-				      (insert "\n  "
-					      (desktop-value-to-string e))))
-			  l)
-			 (insert ")\n\n")))))
-       info)
-      (setq default-directory dirname)
-      (if (file-exists-p filename) (delete-file filename))
-      (write-region (point-min) (point-max) filename nil 'nomessage)))
-  (setq desktop-dirname dirname))
-;; ----------------------------------------------------------------------------
-(defun desktop-remove ()
-  "Delete the Desktop file and inactivate the desktop system."
-  (interactive)
-  (if desktop-dirname
-      (let ((filename (concat desktop-dirname desktop-basefilename)))
-	(setq desktop-dirname nil)
-	(if (file-exists-p filename)
-	    (delete-file filename)))))
-;; ----------------------------------------------------------------------------
-(defun desktop-read ()
-  "Read the Desktop file and the files it specifies.
-This is a no-op when Emacs is running in batch mode."
-  (interactive)
-  (if noninteractive
-      nil
-    (let ((dirs '("./" "~/")))
-      (while (and dirs
-		  (not (file-exists-p (expand-file-name
-				       desktop-basefilename
-				       (car dirs)))))
-	(setq dirs (cdr dirs)))
-      (setq desktop-dirname (and dirs (expand-file-name (car dirs))))
-      (if desktop-dirname
-	  (progn
-	    (load (expand-file-name desktop-basefilename desktop-dirname)
-		  t t t)
-	    (run-hooks 'desktop-delay-hook)
-	    (setq desktop-delay-hook nil)
-	    (message "Desktop loaded."))
-	(desktop-clear)))))
-;; ----------------------------------------------------------------------------
-(defun desktop-load-default ()
-  "Load the `default' start-up library manually.
-Also inhibit further loading of it.  Call this from your `.emacs' file
-to provide correct modes for autoloaded files."
-  (if (not inhibit-default-init)	; safety check
-      (progn
-	(load "default" t t)
-	(setq inhibit-default-init t))))
-;; ----------------------------------------------------------------------------
-;; Note: the following functions use the dynamic variable binding in Lisp.
-;;
-(defun desktop-buffer-info () "Load an info file."
-  (if (eq 'Info-mode desktop-buffer-major-mode)
-      (progn
-	(require 'info)
-	(Info-find-node (nth 0 desktop-buffer-misc) (nth 1 desktop-buffer-misc))
-	t)))
-;; ----------------------------------------------------------------------------
-(defun desktop-buffer-rmail () "Load an RMAIL file."
-  (if (eq 'rmail-mode desktop-buffer-major-mode)
-      (condition-case error
-	  (progn (rmail-input desktop-buffer-file-name) t)
-	(file-locked
-	 (kill-buffer (current-buffer))
-	 'ignored))))
-;; ----------------------------------------------------------------------------
-(defun desktop-buffer-mh () "Load a folder in the mh system."
-  (if (eq 'mh-folder-mode desktop-buffer-major-mode)
-      (progn
-	(require 'mh-e)
-	(mh-find-path)
-	(mh-visit-folder desktop-buffer-name)
-	t)))
-;; ----------------------------------------------------------------------------
-(defun desktop-buffer-dired () "Load a directory using dired."
-  (if (eq 'dired-mode desktop-buffer-major-mode)
-      (if (file-directory-p (file-name-directory (car desktop-buffer-misc)))
-	  (progn
-	    (dired (car desktop-buffer-misc))
-	    (mapcar 'dired-insert-subdir (cdr desktop-buffer-misc))
-	    t)
-	(message "Directory %s no longer exists." (car desktop-buffer-misc))
-	(sit-for 1)
-	'ignored)))
-;; ----------------------------------------------------------------------------
-(defun desktop-buffer-file () "Load a file."
-  (if desktop-buffer-file-name
-      (if (or (file-exists-p desktop-buffer-file-name)
-	      (and desktop-missing-file-warning
-		   (y-or-n-p (format
-			      "File \"%s\" no longer exists. Re-create? "
-			      desktop-buffer-file-name))))
-	  (progn (find-file desktop-buffer-file-name) t)
-	'ignored)))
-;; ----------------------------------------------------------------------------
-;; Create a buffer, load its file, set is mode, ...;  called from Desktop file
-;; only.
-(defun desktop-create-buffer (ver desktop-buffer-file-name desktop-buffer-name
-				  desktop-buffer-major-mode
-				  mim pt mk ro desktop-buffer-misc &optional locals)
-  (let ((hlist desktop-buffer-handlers)
-	(result)
-	(handler))
-    (while (and (not result) hlist)
-      (setq handler (car hlist))
-      (setq result (funcall handler))
-      (setq hlist (cdr hlist)))
-    (if (eq result t)
-	(progn
-	  (if (not (equal (buffer-name) desktop-buffer-name))
-	      (rename-buffer desktop-buffer-name))
-	  (auto-fill-mode (if (nth 0 mim) 1 0))
-	  (goto-char pt)
-	  (if (consp mk)
-	      (progn
-		(set-mark (car mk))
-		(setq mark-active (car (cdr mk))))
-	    (set-mark mk))
-	  ;; Never override file system if the file really is read-only marked.
-	  (if ro (setq buffer-read-only ro))
-	  (while locals
-	    (let ((this (car locals)))
-	      (if (consp this)
-		  ;; an entry of this form `(symbol . value)'
-		  (progn
-		    (make-local-variable (car this))
-		    (set (car this) (cdr this)))
-		;; an entry of the form `symbol'
-		(make-local-variable this)
-		(makunbound this)))
-	    (setq locals (cdr locals)))
-	  ))))
-
-;; Backward compatibility -- update parameters to 205 standards.
-(defun desktop-buffer (desktop-buffer-file-name desktop-buffer-name
-		       desktop-buffer-major-mode
-		       mim pt mk ro tl fc cfs cr desktop-buffer-misc)
-  (desktop-create-buffer 205 desktop-buffer-file-name desktop-buffer-name
-			 desktop-buffer-major-mode (cdr mim) pt mk ro
-			 desktop-buffer-misc
-			 (list (cons 'truncate-lines tl)
-			       (cons 'fill-column fc)
-			       (cons 'case-fold-search cfs)
-			       (cons 'case-replace cr)
-			       (cons 'overwrite-mode (car mim)))))
-;; ----------------------------------------------------------------------------
-(provide 'desktop)
-
-;; desktop.el ends here.
diff --git a/lisp/diff.el b/lisp/diff.el
deleted file mode 100644
index 2ec0a8b14bd..00000000000
--- a/lisp/diff.el
+++ /dev/null
@@ -1,303 +0,0 @@
-;;; diff.el --- Run `diff' in compilation-mode.
-
-;; Copyright (C) 1992, 1994, 1996 Free Software Foundation, Inc.
-
-;; Keywords: unix, 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 helps you explore differences between files, using the
-;; UNIX command diff(1).  The commands are `diff' and `diff-backup'.
-;; You can specify options with `diff-switches'.
-
-;;; Code:
-
-(require 'compile)
-
-;;; This is duplicated in vc.el.
-(defvar diff-switches "-c"
-  "*A string or list of strings specifying switches to be be passed to diff.")
-
-(defvar diff-command "diff"
-  "*The command to use to run diff.")
-
-(defvar diff-regexp-alist
-  '(
-    ;; -u format: @@ -OLDSTART,OLDEND +NEWSTART,NEWEND @@
-    ("^@@ -\\([0-9]+\\),[0-9]+ \\+\\([0-9]+\\),[0-9]+ @@$" 1 2)
-
-    ;; -c format: *** OLDSTART,OLDEND ****
-    ("^\\*\\*\\* \\([0-9]+\\),[0-9]+ \\*\\*\\*\\*$" 1 nil)
-    ;;            --- NEWSTART,NEWEND ----
-    ("^--- \\([0-9]+\\),[0-9]+ ----$" nil 1)
-
-    ;; plain diff format: OLDSTART[,OLDEND]{a,d,c}NEWSTART[,NEWEND]
-    ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]\\([0-9]+\\)\\(,[0-9]+\\)?$" 1 3)
-
-    ;; -e (ed) format: OLDSTART[,OLDEND]{a,d,c}
-    ("^\\([0-9]+\\)\\(,[0-9]+\\)?[adc]$" 1)
-
-    ;; -f format: {a,d,c}OLDSTART[ OLDEND]
-    ;; -n format: {a,d,c}OLDSTART LINES-CHANGED
-    ("^[adc]\\([0-9]+\\)\\( [0-9]+\\)?$" 1)
-    )
-  "Alist (REGEXP OLD-IDX NEW-IDX) of regular expressions to match difference
-sections in \\[diff] output.  If REGEXP matches, the OLD-IDX'th
-subexpression gives the line number in the old file, and NEW-IDX'th
-subexpression gives the line number in the new file.  If OLD-IDX or NEW-IDX
-is nil, REGEXP matches only half a section.")
-
-(defvar diff-old-file nil
-  "This is the old file name in the comparison in this buffer.")
-(defvar diff-new-file nil
-  "This is the new file name in the comparison in this buffer.")
-(defvar diff-old-temp-file nil
-  "This is the name of a temp file to be deleted after diff finishes.")
-(defvar diff-new-temp-file nil
-  "This is the name of a temp file to be deleted after diff finishes.")
-
-;; See compilation-parse-errors-function (compile.el).
-(defun diff-parse-differences (limit-search find-at-least)
-  (setq compilation-error-list nil)
-  (message "Parsing differences...")
-
-  ;; Don't reparse diffs already seen at last parse.
-  (if compilation-parsing-end (goto-char compilation-parsing-end))
-
-  ;; Construct in REGEXP a regexp composed of all those in dired-regexp-alist.
-  (let ((regexp (mapconcat (lambda (elt)
-			     (concat "\\(" (car elt) "\\)"))
-			   diff-regexp-alist
-			   "\\|"))
-	;; (GROUP-IDX OLD-IDX NEW-IDX)
-	(groups (let ((subexpr 1))
-		  (mapcar (lambda (elt)
-			    (prog1
-				(cons subexpr
-				      (mapcar (lambda (n)
-						(and n
-						     (+ subexpr n)))
-					      (cdr elt)))
-			      (setq subexpr (+ subexpr 1
-					       (count-regexp-groupings
-						(car elt))))))
-			  diff-regexp-alist)))
-
-	(new-error
-	 (function (lambda (file subexpr)
-		     (setq compilation-error-list
-			   (cons
-			    (cons (save-excursion
-				    ;; Report location of message
-				    ;; at beginning of line.
-				    (goto-char
-				     (match-beginning subexpr))
-				    (beginning-of-line)
-				    (point-marker))
-				  ;; Report location of corresponding text.
-				  (let ((line (string-to-int
-					       (buffer-substring
-						(match-beginning subexpr)
-						(match-end subexpr)))))
-				    (save-excursion
-				      (save-match-data
-					(set-buffer (find-file-noselect file)))
-				      (save-excursion
-					(goto-line line)
-					(point-marker)))))
-			    compilation-error-list)))))
-
-	(found-desired nil)
-	(num-loci-found 0)
-	g)
-
-    (while (and (not found-desired)
-		;; We don't just pass LIMIT-SEARCH to re-search-forward
-		;; because we want to find matches containing LIMIT-SEARCH
-		;; but which extend past it.
-		(re-search-forward regexp nil t))
-
-      ;; Find which individual regexp matched.
-      (setq g groups)
-      (while (and g (null (match-beginning (car (car g)))))
-	(setq g (cdr g)))
-      (setq g (car g))
-
-      (if (nth 1 g)			;OLD-IDX
-	  (funcall new-error diff-old-file (nth 1 g)))
-      (if (nth 2 g)			;NEW-IDX
-	  (funcall new-error diff-new-file (nth 2 g)))
-
-      (setq num-loci-found (1+ num-loci-found))
-      (if (or (and find-at-least
-		   (>= num-loci-found find-at-least))
-	      (and limit-search (>= (point) limit-search)))
-	      ;; We have found as many new loci as the user wants,
-	      ;; or the user wanted a specific diff, and we're past it.
-	  (setq found-desired t)))
-    (if found-desired
-	(setq compilation-parsing-end (point))
-      ;; Set to point-max, not point, so we don't perpetually
-      ;; parse the last bit of text when it isn't a diff header.
-      (setq compilation-parsing-end (point-max)))
-    (message "Parsing differences...done"))
-  (setq compilation-error-list (nreverse compilation-error-list)))
-
-;;;###autoload
-(defun diff (old new &optional switches)
-  "Find and display the differences between OLD and NEW files.
-Interactively the current buffer's file name is the default for NEW
-and a backup file for NEW is the default for OLD.
-With prefix arg, prompt for diff switches."
-  (interactive
-   (nconc
-    (let (oldf newf)
-      (nreverse
-       (list
-	(setq newf (buffer-file-name)
-	      newf (if (and newf (file-exists-p newf))
-		       (read-file-name
-			(concat "Diff new file: ("
-				(file-name-nondirectory newf) ") ")
-			nil newf t)
-		     (read-file-name "Diff new file: " nil nil t)))
-	(setq oldf (file-newest-backup newf)
-	      oldf (if (and oldf (file-exists-p oldf))
-		       (read-file-name
-			(concat "Diff original file: ("
-				(file-name-nondirectory oldf) ") ")
-			(file-name-directory oldf) oldf t)
-		     (read-file-name "Diff original file: "
-				     (file-name-directory newf) nil t))))))
-    (if current-prefix-arg
-	(list (read-string "Diff switches: "
-			   (if (stringp diff-switches)
-			       diff-switches
-			     (mapconcat 'identity diff-switches " "))))
-      nil)))
-  (setq new (expand-file-name new)
-	old (expand-file-name old))
-  (let ((old-alt (file-local-copy old))
-	(new-alt (file-local-copy new))
-	buf)
-    (save-excursion
-	(let ((command
-	       (mapconcat 'identity
-			  (append (list diff-command)
-				  ;; Use explicitly specified switches
-				  (if switches
-				      (if (consp switches)
-					  switches (list switches))
-				    ;; If not specified, use default.
-				    (if (consp diff-switches)
-					diff-switches
-				      (list diff-switches)))
-				  (if (or old-alt new-alt)
-				      (list "-L" old "-L" new))
-				  (list
-				   (shell-quote-argument (or old-alt old)))
-				  (list
-				   (shell-quote-argument (or new-alt new))))
-			  " ")))
-	  (setq buf
-		(compile-internal command
-				  "No more differences" "Diff"
-				  'diff-parse-differences))
-	  (set-buffer buf)
-	  ;; Avoid frightening people with "abnormally terminated"
-	  ;; if diff finds differences.
-	  (set (make-local-variable 'compilation-exit-message-function)
-	       (lambda (status code msg)
-		 (cond ((not (eq status 'exit))
-			(cons msg code))
-		       ((zerop code)
-			'("finished (no differences)\n" . "no differences"))
-		       ((= code 1)
-			'("finished\n" . "differences found"))
-		       (t
-			(cons msg code)))))
-	  (set (make-local-variable 'diff-old-file) old)
-	  (set (make-local-variable 'diff-new-file) new)
-	  (set (make-local-variable 'diff-old-temp-file) old-alt)
-	  (set (make-local-variable 'diff-new-temp-file) new-alt)
-	  (set (make-local-variable 'compilation-finish-function)
-	       (function (lambda (buff msg)
-			   (if diff-old-temp-file
-			       (delete-file diff-old-temp-file))
-			   (if diff-new-temp-file
-			       (delete-file diff-new-temp-file)))))
-	  buf))))
-
-;;;###autoload
-(defun diff-backup (file &optional switches)
-  "Diff this file with its backup file or vice versa.
-Uses the latest backup, if there are several numerical backups.
-If this file is a backup, diff it with its original.
-The backup file is the first file given to `diff'."
-  (interactive (list (read-file-name "Diff (file with backup): ")
-		     (if current-prefix-arg
-			 (read-string "Diff switches: "
-				      (if (stringp diff-switches)
-					  diff-switches
-					(mapconcat 'identity
-						   diff-switches " ")))
-		       nil)))
-  (let (bak ori)
-    (if (backup-file-name-p file)
-	(setq bak file
-	      ori (file-name-sans-versions file))
-      (setq bak (or (diff-latest-backup-file file)
-		    (error "No backup found for %s" file))
-	    ori file))
-    (diff bak ori switches)))
-
-(defun diff-latest-backup-file (fn)	; actually belongs into files.el
-  "Return the latest existing backup of FILE, or nil."
-  (let ((handler (find-file-name-handler fn 'diff-latest-backup-file)))
-    (if handler
-	(funcall handler 'diff-latest-backup-file fn)
-      ;; First try simple backup, then the highest numbered of the
-      ;; numbered backups.
-      ;; Ignore the value of version-control because we look for existing
-      ;; backups, which maybe were made earlier or by another user with
-      ;; a different value of version-control.
-      (setq fn (file-chase-links (expand-file-name fn)))
-      (or
-       (let ((bak (make-backup-file-name fn)))
-	 (if (file-exists-p bak) bak))
-       ;; We use BACKUPNAME to cope with backups stored in a different dir.
-       (let* ((backupname (car (find-backup-file-name fn)))
-	      (dir (file-name-directory backupname))
-	      (base-versions (concat (file-name-sans-versions
-				      (file-name-nondirectory backupname))
-				     ".~"))
-	      (bv-length (length base-versions)))
-	 (concat dir
-		 (car (sort
-		       (file-name-all-completions base-versions dir)
-		       ;; bv-length is a fluid var for backup-extract-version:
-		       (function
-			(lambda (fn1 fn2)
-			  (> (backup-extract-version fn1)
-			     (backup-extract-version fn2))))))))))))
-
-(provide 'diff)
-
-;;; diff.el ends here
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
deleted file mode 100644
index 86b897d6616..00000000000
--- a/lisp/dired-aux.el
+++ /dev/null
@@ -1,1894 +0,0 @@
-;;; dired-aux.el --- less commonly used parts of dired  -*-byte-compile-dynamic: t;-*-
-
-;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>.
-
-;; 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:
-
-;; The parts of dired mode not normally used.  This is a space-saving hack
-;; to avoid having to load a large mode when all that's wanted are a few
-;; functions.
-
-;; Rewritten in 1990/1991 to add tree features, file marking and
-;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
-;; Finished up by rms in 1992.
-
-;;; Code:
-
-;; We need macros in dired.el to compile properly.
-(eval-when-compile (require 'dired))
-
-;;; 15K
-;;;###begin dired-cmd.el
-;; Diffing and compressing
-
-;;;###autoload
-(defun dired-diff (file &optional switches)
-  "Compare file at point with file FILE using `diff'.
-FILE defaults to the file at the mark.
-The prompted-for file is the first file given to `diff'.
-With prefix arg, prompt for second argument SWITCHES,
- which is options for `diff'."
-  (interactive
-   (let ((default (if (mark t)
-		      (save-excursion (goto-char (mark t))
-				      (dired-get-filename t t)))))
-     (require 'diff)
-     (list (read-file-name (format "Diff %s with: %s"
-				   (dired-get-filename t)
-				   (if default
-				       (concat "(default " default ") ")
-				     ""))
-			   (dired-current-directory) default t)
-	   (if current-prefix-arg
-	       (read-string "Options for diff: "
-			    (if (stringp diff-switches)
-				diff-switches
-			      (mapconcat 'identity diff-switches " ")))))))
-  (diff file (dired-get-filename t) switches))
-
-;;;###autoload
-(defun dired-backup-diff (&optional switches)
-  "Diff this file with its backup file or vice versa.
-Uses the latest backup, if there are several numerical backups.
-If this file is a backup, diff it with its original.
-The backup file is the first file given to `diff'.
-With prefix arg, prompt for argument SWITCHES which is options for `diff'."
-  (interactive
-    (if current-prefix-arg
-	(list (read-string "Options for diff: "
-			   (if (stringp diff-switches)
-			       diff-switches
-			     (mapconcat 'identity diff-switches " "))))
-      nil))
-  (diff-backup (dired-get-filename) switches))
-
-(defun dired-do-chxxx (attribute-name program op-symbol arg)
-  ;; Change file attributes (mode, group, owner) of marked files and
-  ;; refresh their file lines.
-  ;; ATTRIBUTE-NAME is a string describing the attribute to the user.
-  ;; PROGRAM is the program used to change the attribute.
-  ;; OP-SYMBOL is the type of operation (for use in dired-mark-pop-up).
-  ;; ARG describes which files to use, as in dired-get-marked-files.
-  (let* ((files (dired-get-marked-files t arg))
-	 (new-attribute
-	  (dired-mark-read-string
-	   (concat "Change " attribute-name " of %s to: ")
-	   nil op-symbol arg files))
-	 (operation (concat program " " new-attribute))
-	 failures)
-    (setq failures
-	  (dired-bunch-files 10000
-			     (function dired-check-process)
-			     (append 
-			      (list operation program new-attribute)
-			      (if (string-match "gnu" system-configuration)
-				  '("--") nil))
-			     files))
-    (dired-do-redisplay arg);; moves point if ARG is an integer
-    (if failures
-	(dired-log-summary
-	 (format "%s: error" operation)
-	 nil))))
-
-;;;###autoload
-(defun dired-do-chmod (&optional arg)
-  "Change the mode of the marked (or next ARG) files.
-This calls chmod, thus symbolic modes like `g+w' are allowed."
-  (interactive "P")
-  (dired-do-chxxx "Mode" dired-chmod-program 'chmod arg))
-
-;;;###autoload
-(defun dired-do-chgrp (&optional arg)
-  "Change the group of the marked (or next ARG) files."
-  (interactive "P")
-  (if (memq system-type '(ms-dos windows-nt))
-      (error "chgrp not supported on this system."))
-  (dired-do-chxxx "Group" "chgrp" 'chgrp arg))
-
-;;;###autoload
-(defun dired-do-chown (&optional arg)
-  "Change the owner of the marked (or next ARG) files."
-  (interactive "P")
-  (if (memq system-type '(ms-dos windows-nt))
-      (error "chown not supported on this system."))
-  (dired-do-chxxx "Owner" dired-chown-program 'chown arg))
-
-;; Process all the files in FILES in batches of a convenient size,
-;; by means of (FUNCALL FUNCTION ARGS... SOME-FILES...).
-;; Batches are chosen to need less than MAX chars for the file names,
-;; allowing 3 extra characters of separator per file name.
-(defun dired-bunch-files (max function args files)
-  (let (pending
-	(pending-length 0)
-	failures)
-    ;; Accumulate files as long as they fit in MAX chars,
-    ;; then process the ones accumulated so far.
-    (while files
-      (let* ((thisfile (car files))
-	     (thislength (+ (length thisfile) 3))
-	     (rest (cdr files)))
-	;; If we have at least 1 pending file
-	;; and this file won't fit in the length limit, process now.
-	(if (and pending (> (+ thislength pending-length) max))
-	    (setq failures
-		  (nconc (apply function (append args pending))
-			 failures)
-		  pending nil
-		  pending-length 0))
-	;; Do (setq pending (cons thisfile pending))
-	;; but reuse the cons that was in `files'.
-	(setcdr files pending)
-	(setq pending files)
-	(setq pending-length (+ thislength pending-length))
-	(setq files rest)))
-    (nconc (apply function (append args pending))
-	   failures)))
-
-;;;###autoload
-(defun dired-do-print (&optional arg)
-  "Print the marked (or next ARG) files.
-Uses the shell command coming from variables `lpr-command' and
-`lpr-switches' as default."
-  (interactive "P")
-  (let* ((file-list (dired-get-marked-files t arg))
-	 (command (dired-mark-read-string
-		   "Print %s with: "
- 		   (mapconcat 'identity
-			      (cons lpr-command
-				    (if (stringp lpr-switches)
-					(list lpr-switches)
-				      lpr-switches))
-			      " ")
-		   'print arg file-list)))
-    (dired-run-shell-command (dired-shell-stuff-it command file-list nil))))
-
-;; Read arguments for a marked-files command that wants a string
-;; that is not a file name,
-;; perhaps popping up the list of marked files.
-;; ARG is the prefix arg and indicates whether the files came from
-;; marks (ARG=nil) or a repeat factor (integerp ARG).
-;; If the current file was used, the list has but one element and ARG
-;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
-
-(defun dired-mark-read-string (prompt initial op-symbol arg files)
-  ;; PROMPT for a string, with INITIAL input.
-  ;; Other args are used to give user feedback and pop-up:
-  ;; OP-SYMBOL of command, prefix ARG, marked FILES.
-  (dired-mark-pop-up
-   nil op-symbol files
-   (function read-string)
-   (format prompt (dired-mark-prompt arg files)) initial))
-
-;;; Cleaning a directory: flagging some backups for deletion.
-
-(defvar dired-file-version-alist)
-
-(defun dired-clean-directory (keep)
-  "Flag numerical backups for deletion.
-Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
-Positive prefix arg KEEP overrides `dired-kept-versions';
-Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
-
-To clear the flags on these files, you can use \\[dired-flag-backup-files]
-with a prefix argument."
-  (interactive "P")
-  (setq keep (if keep (prefix-numeric-value keep) dired-kept-versions))
-  (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
-	(late-retention (if (<= keep 0) dired-kept-versions keep))
-	(dired-file-version-alist ()))
-    (message "Cleaning numerical backups (keeping %d late, %d old)..."
-	     late-retention early-retention)
-    ;; Look at each file.
-    ;; If the file has numeric backup versions,
-    ;; put on dired-file-version-alist an element of the form
-    ;; (FILENAME . VERSION-NUMBER-LIST)
-    (dired-map-dired-file-lines (function dired-collect-file-versions))
-    ;; Sort each VERSION-NUMBER-LIST,
-    ;; and remove the versions not to be deleted.
-    (let ((fval dired-file-version-alist))
-      (while fval
-	(let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
-	       (v-count (length sorted-v-list)))
-	  (if (> v-count (+ early-retention late-retention))
-	      (rplacd (nthcdr early-retention sorted-v-list)
-		      (nthcdr (- v-count late-retention)
-			      sorted-v-list)))
-	  (rplacd (car fval)
-		  (cdr sorted-v-list)))
-	(setq fval (cdr fval))))
-    ;; Look at each file.  If it is a numeric backup file,
-    ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
-    (dired-map-dired-file-lines (function dired-trample-file-versions))
-    (message "Cleaning numerical backups...done")))
-
-;;; Subroutines of dired-clean-directory.
-
-(defun dired-map-dired-file-lines (fun)
-  ;; Perform FUN with point at the end of each non-directory line.
-  ;; FUN takes one argument, the filename (complete pathname).
-  (save-excursion
-    (let (file buffer-read-only)
-      (goto-char (point-min))
-      (while (not (eobp))
-	(save-excursion
-	  (and (not (looking-at dired-re-dir))
-	       (not (eolp))
-	       (setq file (dired-get-filename nil t)) ; nil on non-file
-	       (progn (end-of-line)
-		      (funcall fun file))))
-	(forward-line 1)))))
-
-(defun dired-collect-file-versions (fn)
-  (let ((fn (file-name-sans-versions fn)))
-    ;; Only do work if this file is not already in the alist.
-    (if (assoc fn dired-file-version-alist)
-	nil
-      ;; If it looks like file FN has versions, return a list of the versions.
-      ;;That is a list of strings which are file names.
-      ;;The caller may want to flag some of these files for deletion.
-      (let* ((base-versions
-	      (concat (file-name-nondirectory fn) ".~"))
-	     (bv-length (length base-versions))
-	     (possibilities (file-name-all-completions
-			     base-versions
-			     (file-name-directory fn)))
-	     (versions (mapcar 'backup-extract-version possibilities)))
-	(if versions
-	    (setq dired-file-version-alist
-		  (cons (cons fn versions)
-			dired-file-version-alist)))))))
-
-(defun dired-trample-file-versions (fn)
-  (let* ((start-vn (string-match "\\.~[0-9]+~$" fn))
-	 base-version-list)
-    (and start-vn
-	 (setq base-version-list	; there was a base version to which
-	       (assoc (substring fn 0 start-vn)	; this looks like a
-		      dired-file-version-alist))	; subversion
-	 (not (memq (string-to-int (substring fn (+ 2 start-vn)))
-		    base-version-list))	; this one doesn't make the cut
-	 (progn (beginning-of-line)
-		(delete-char 1)
-		(insert dired-del-marker)))))
-
-;;; Shell commands
-;;>>> install (move this function into simple.el)
-(defun dired-shell-quote (filename)
-  "Quote a file name for inferior shell (see variable `shell-file-name')."
-  ;; Quote everything except POSIX filename characters.
-  ;; This should be safe enough even for really weird shells.
-  (let ((result "") (start 0) end)
-    (while (string-match "[^-0-9a-zA-Z_./]" filename start)
-      (setq end (match-beginning 0)
-	    result (concat result (substring filename start end)
-			   "\\" (substring filename end (1+ end)))
-	    start (1+ end)))
-    (concat result (substring filename start))))
-
-(defun dired-read-shell-command (prompt arg files)
-;;  "Read a dired shell command prompting with PROMPT (using read-string).
-;;ARG is the prefix arg and may be used to indicate in the prompt which
-;;  files are affected.
-;;This is an extra function so that you can redefine it, e.g., to use gmhist."
-  (dired-mark-pop-up
-   nil 'shell files
-   (function read-string)
-   (format prompt (dired-mark-prompt arg files))
-   nil 'shell-command-history))
-
-;; The in-background argument is only needed in Emacs 18 where
-;; shell-command doesn't understand an appended ampersand `&'.
-;;;###autoload
-(defun dired-do-shell-command (command &optional arg)
-  "Run a shell command COMMAND on the marked files.
-If no files are marked or a specific numeric prefix arg is given,
-the next ARG files are used.  Just \\[universal-argument] means the current file.
-The prompt mentions the file(s) or the marker, as appropriate.
-
-If there is output, it goes to a separate buffer.
-
-Normally the command is run on each file individually.
-However, if there is a `*' in the command then it is run
-just once with the entire file list substituted there.
-
-No automatic redisplay of dired buffers is attempted, as there's no
-telling what files the command may have changed.  Type
-\\[dired-do-redisplay] to redisplay the marked files.
-
-The shell command has the top level directory as working directory, so
-output files usually are created there instead of in a subdir."
-;;Functions dired-run-shell-command and dired-shell-stuff-it do the
-;;actual work and can be redefined for customization.
-  (interactive (list
-		;; Want to give feedback whether this file or marked files are used:
-		(dired-read-shell-command (concat "! on "
-						  "%s: ")
-					  current-prefix-arg
-					  (dired-get-marked-files
-					   t current-prefix-arg))
-		current-prefix-arg))
-  (let* ((on-each (not (string-match "\\*" command)))
-	 (file-list (dired-get-marked-files t arg)))
-    (if on-each
-	(dired-bunch-files
-	 (- 10000 (length command))
-	 (function (lambda (&rest files)
-		     (dired-run-shell-command
-		      (dired-shell-stuff-it command files t arg))))
-	 nil
-	 file-list)
-      ;; execute the shell command
-      (dired-run-shell-command
-       (dired-shell-stuff-it command file-list nil arg)))))
-
-;; Might use {,} for bash or csh:
-(defvar dired-mark-prefix ""
-  "Prepended to marked files in dired shell commands.")
-(defvar dired-mark-postfix ""
-  "Appended to marked files in dired shell commands.")
-(defvar dired-mark-separator " "
-  "Separates marked files in dired shell commands.")
-
-(defun dired-shell-stuff-it (command file-list on-each &optional raw-arg)
-;; "Make up a shell command line from COMMAND and FILE-LIST.
-;; If ON-EACH is t, COMMAND should be applied to each file, else
-;; simply concat all files and apply COMMAND to this.
-;; FILE-LIST's elements will be quoted for the shell."
-;; Might be redefined for smarter things and could then use RAW-ARG
-;; (coming from interactive P and currently ignored) to decide what to do.
-;; Smart would be a way to access basename or extension of file names.
-;; See dired-trns.el for an approach to this.
-  ;; Bug: There is no way to quote a *
-  ;; On the other hand, you can never accidentally get a * into your cmd.
-  (let ((stuff-it
-	 (if (string-match "\\*" command)
-	     (function (lambda (x)
-			 (dired-replace-in-string "\\*" x command)))
-	   (function (lambda (x) (concat command " " x))))))
-    (if on-each
-	(mapconcat stuff-it (mapcar 'dired-shell-quote file-list) ";")
-      (let ((fns (mapconcat 'dired-shell-quote
-			    file-list dired-mark-separator)))
-	(if (> (length file-list) 1)
-	    (setq fns (concat dired-mark-prefix fns dired-mark-postfix)))
-	(funcall stuff-it fns)))))
-
-;; This is an extra function so that it can be redefined by ange-ftp.
-(defun dired-run-shell-command (command)
-  (shell-command command)
-  ;; Return nil for sake of nconc in dired-bunch-files.
-  nil)
-
-;; In Emacs 19 this will return program's exit status.
-;; This is a separate function so that ange-ftp can redefine it.
-(defun dired-call-process (program discard &rest arguments)
-;  "Run PROGRAM with output to current buffer unless DISCARD is t.
-;Remaining arguments are strings passed as command arguments to PROGRAM."
-  ;; Look for a handler for default-directory in case it is a remote file name.
-  (let ((handler
-	 (find-file-name-handler (directory-file-name default-directory)
-				 'dired-call-process)))
-    (if handler (apply handler 'dired-call-process
-		       program discard arguments)
-      (apply 'call-process program nil (not discard) nil arguments))))
-
-(defun dired-check-process (msg program &rest arguments)
-;  "Display MSG while running PROGRAM, and check for output.
-;Remaining arguments are strings passed as command arguments to PROGRAM.
-; On error, insert output
-; in a log buffer and return the offending ARGUMENTS or PROGRAM.
-; Caller can cons up a list of failed args.
-;Else returns nil for success."
-  (let (err-buffer err (dir default-directory))
-    (message "%s..." msg)
-    (save-excursion
-      ;; Get a clean buffer for error output:
-      (setq err-buffer (get-buffer-create " *dired-check-process output*"))
-      (set-buffer err-buffer)
-      (erase-buffer)
-      (setq default-directory dir	; caller's default-directory
-	    err (/= 0
-		 (apply (function dired-call-process) program nil arguments)))
-      (if err
-	  (progn
-	    (dired-log (concat program " " (prin1-to-string arguments) "\n"))
-	    (dired-log err-buffer)
-	    (or arguments program t))
-	(kill-buffer err-buffer)
-	(message "%s...done" msg)
-	nil))))
-
-;; Commands that delete or redisplay part of the dired buffer.
-
-(defun dired-kill-line (&optional arg)
-  (interactive "P")
-  (setq arg (prefix-numeric-value arg))
-  (let (buffer-read-only file)
-    (while (/= 0 arg)
-      (setq file (dired-get-filename nil t))
-      (if (not file)
-	  (error "Can only kill file lines.")
-	(save-excursion (and file
-			     (dired-goto-subdir file)
-			     (dired-kill-subdir)))
-	(delete-region (progn (beginning-of-line) (point))
-		       (progn (forward-line 1) (point)))
-	(if (> arg 0)
-	    (setq arg (1- arg))
-	  (setq arg (1+ arg))
-	  (forward-line -1))))
-    (dired-move-to-filename)))
-
-;;;###autoload
-(defun dired-do-kill-lines (&optional arg fmt)
-  "Kill all marked lines (not the files).
-With a prefix argument, kill that many lines starting with the current line.
-\(A negative argument kills lines before the current line.)
-To kill an entire subdirectory, go to its directory header line
-and use this command with a prefix argument (the value does not matter)."
-  ;; Returns count of killed lines.  FMT="" suppresses message.
-  (interactive "P")
-  (if arg
-      (if (dired-get-subdir)
-	  (dired-kill-subdir)
-	(dired-kill-line arg))
-    (save-excursion
-      (goto-char (point-min))
-      (let (buffer-read-only (count 0))
-	(if (not arg)			; kill marked lines
-	    (let ((regexp (dired-marker-regexp)))
-	      (while (and (not (eobp))
-			  (re-search-forward regexp nil t))
-		(setq count (1+ count))
-		(delete-region (progn (beginning-of-line) (point))
-			       (progn (forward-line 1) (point)))))
-	  ;; else kill unmarked lines
-	  (while (not (eobp))
-	    (if (or (dired-between-files)
-		    (not (looking-at "^  ")))
-		(forward-line 1)
-	      (setq count (1+ count))
-	      (delete-region (point) (save-excursion
-				       (forward-line 1)
-				       (point))))))
-	(or (equal "" fmt)
-	    (message (or fmt "Killed %d line%s.") count (dired-plural-s count)))
-	count))))
-
-;;;###end dired-cmd.el
-
-;;; 30K
-;;;###begin dired-cp.el
-
-(defun dired-compress ()
-  ;; Compress or uncompress the current file.
-  ;; Return nil for success, offending filename else.
-  (let* (buffer-read-only
-	 (from-file (dired-get-filename))
-	 (new-file (dired-compress-file from-file)))
-    (if new-file
-	(let ((start (point)))
-	  ;; Remove any preexisting entry for the name NEW-FILE.
-	  (condition-case nil
-	      (dired-remove-entry new-file)
-	    (error nil))
-	  (goto-char start)
-	  ;; Now replace the current line with an entry for NEW-FILE.
-	  (dired-update-file-line new-file) nil)
-      (dired-log (concat "Failed to compress" from-file))
-      from-file)))
-
-(defvar dired-compress-file-suffixes
-  '(("\\.gz\\'" "" "gunzip")
-    ("\\.tgz\\'" ".tar" "gunzip")
-    ("\\.Z\\'" "" "uncompress")
-    ;; For .z, try gunzip.  It might be an old gzip file,
-    ;; or it might be from compact? pack? (which?) but gunzip handles both.
-    ("\\.z\\'" "" "gunzip")
-    ;; This item controls naming for compression.
-    ("\\.tar\\'" ".tgz" nil))
-  "Control changes in file name suffixes for compression and uncompression.
-Each element specifies one transformation rule, and has the form:
-  (REGEXP NEW-SUFFIX PROGRAM)
-The rule applies when the old file name matches REGEXP.
-The new file name is computed by deleting the part that matches REGEXP
- (as well as anything after that), then adding NEW-SUFFIX in its place.
-If PROGRAM is non-nil, the rule is an uncompression rule,
-and uncompression is done by running PROGRAM.
-Otherwise, the rule is a compression rule, and compression is done with gzip.")
-
-;;;###autoload
-(defun dired-compress-file (file)
-  ;; Compress or uncompress FILE.
-  ;; Return the name of the compressed or uncompressed file.
-  ;; Return nil if no change in files.
-  (let ((handler (find-file-name-handler file 'dired-compress-file))
-	suffix newname
-	(suffixes dired-compress-file-suffixes))
-    ;; See if any suffix rule matches this file name.
-    (while suffixes
-      (let (case-fold-search)
-	(if (string-match (car (car suffixes)) file)
-	    (setq suffix (car suffixes) suffixes nil))
-	(setq suffixes (cdr suffixes))))
-    ;; If so, compute desired new name.
-    (if suffix	
-	(setq newname (concat (substring file 0 (match-beginning 0))
-			      (nth 1 suffix))))
-    (cond (handler
-	   (funcall handler 'dired-compress-file file))
-	  ((file-symlink-p file)
-	   nil)
-	  ((and suffix (nth 2 suffix))
-	   ;; We found an uncompression rule.
-	   (if (not (dired-check-process (concat "Uncompressing " file)
-					 (nth 2 suffix) file))
-	       newname))
-	  (t
-	   ;;; We don't recognize the file as compressed, so compress it.
-	   ;;; Try gzip; if we don't have that, use compress.
-	   (condition-case nil
-	       (if (not (dired-check-process (concat "Compressing " file)
-					     "gzip" "-f" file))
-		   (let ((out-name
-			  (if (file-exists-p (concat file ".gz"))
-			      (concat file ".gz")
-			    (concat file ".z"))))
-		     ;; Rename the compressed file to NEWNAME
-		     ;; if it hasn't got that name already.
-		     (if (and newname (not (equal newname out-name)))
-			 (progn
-			   (rename-file out-name newname t)
-			   newname)
-		       out-name)))
-	     (file-error
-	      (if (not (dired-check-process (concat "Compressing " file)
-					    "compress" "-f" file))
-		  ;; Don't use NEWNAME with `compress'.
-		  (concat file ".Z"))))))))
-
-(defun dired-mark-confirm (op-symbol arg)
-  ;; Request confirmation from the user that the operation described
-  ;; by OP-SYMBOL is to be performed on the marked files.
-  ;; Confirmation consists in a y-or-n question with a file list
-  ;; pop-up unless OP-SYMBOL is a member of `dired-no-confirm'.
-  ;; The files used are determined by ARG (as in dired-get-marked-files).
-  (or (memq op-symbol dired-no-confirm)
-      (let ((files (dired-get-marked-files t arg))
-	    (string (if (eq op-symbol 'compress) "Compress or uncompress"
-		      (capitalize (symbol-name op-symbol)))))
-	(dired-mark-pop-up nil op-symbol files (function y-or-n-p)
-			   (concat string " "
-				   (dired-mark-prompt arg files) "? ")))))
-
-(defun dired-map-over-marks-check (fun arg op-symbol &optional show-progress)
-;  "Map FUN over marked files (with second ARG like in dired-map-over-marks)
-; and display failures.
-
-; FUN takes zero args.  It returns non-nil (the offending object, e.g.
-; the short form of the filename) for a failure and probably logs a
-; detailed error explanation using function `dired-log'.
-
-; OP-SYMBOL is a symbol describing the operation performed (e.g.
-; `compress').  It is used with `dired-mark-pop-up' to prompt the user
-; (e.g. with `Compress * [2 files]? ') and to display errors (e.g.
-; `Failed to compress 1 of 2 files - type W to see why ("foo")')
-
-; SHOW-PROGRESS if non-nil means redisplay dired after each file."
-  (if (dired-mark-confirm op-symbol arg)
-      (let* ((total-list;; all of FUN's return values
-	      (dired-map-over-marks (funcall fun) arg show-progress))
-	     (total (length total-list))
-	     (failures (delq nil total-list))
-	     (count (length failures))
-	     (string (if (eq op-symbol 'compress) "Compress or uncompress"
-		       (capitalize (symbol-name op-symbol)))))
-	(if (not failures)
-	    (message "%s: %d file%s."
-		     string total (dired-plural-s total))
-	  ;; end this bunch of errors:
-	  (dired-log-summary
-	   (format "Failed to %s %d of %d file%s"
-		   (downcase string) count total (dired-plural-s total))
-	   failures)))))
-
-(defvar dired-query-alist
-  '((?\y . y) (?\040 . y)		; `y' or SPC means accept once
-    (?n . n) (?\177 . n)		; `n' or DEL skips once
-    (?! . yes)				; `!' accepts rest
-    (?q. no) (?\e . no)			; `q' or ESC skips rest
-    ;; None of these keys quit - use C-g for that.
-    ))
-
-(defun dired-query (qs-var qs-prompt &rest qs-args)
-  ;; Query user and return nil or t.
-  ;; Store answer in symbol VAR (which must initially be bound to nil).
-  ;; Format PROMPT with ARGS.
-  ;; Binding variable help-form will help the user who types the help key.
-  (let* ((char (symbol-value qs-var))
-	 (action (cdr (assoc char dired-query-alist))))
-    (cond ((eq 'yes action)
-	   t)				; accept, and don't ask again
-	  ((eq 'no action)
-	   nil)				; skip, and don't ask again
-	  (t;; no lasting effects from last time we asked - ask now
-	   (let ((qprompt (concat qs-prompt
-				  (if help-form
-				      (format " [Type yn!q or %s] "
-					      (key-description
-					       (char-to-string help-char)))
-				    " [Type y, n, q or !] ")))
-		 result elt)
-	     ;; Actually it looks nicer without cursor-in-echo-area - you can
-	     ;; look at the dired buffer instead of at the prompt to decide.
-	     (apply 'message qprompt qs-args)
-	     (setq char (set qs-var (read-char)))
-	     (while (not (setq elt (assoc char dired-query-alist)))
-	       (message "Invalid char - type %c for help." help-char)
-	       (ding)
-	       (sit-for 1)
-	       (apply 'message qprompt qs-args)
-	       (setq char (set qs-var (read-char))))
-	     (memq (cdr elt) '(t y yes)))))))
-
-;;;###autoload
-(defun dired-do-compress (&optional arg)
-  "Compress or uncompress marked (or next ARG) files."
-  (interactive "P")
-  (dired-map-over-marks-check (function dired-compress) arg 'compress t))
-
-;; Commands for Emacs Lisp files - load and byte compile
-
-(defun dired-byte-compile ()
-  ;; Return nil for success, offending file name else.
-  (let* ((filename (dired-get-filename))
-	 elc-file buffer-read-only failure)
-    (condition-case err
-	(save-excursion (byte-compile-file filename))
-      (error
-       (setq failure err)))
-    (setq elc-file (byte-compile-dest-file filename))
-    (or (file-exists-p elc-file)
-	(setq failure t))
-    (if failure
-	(progn
-	  (dired-log "Byte compile error for %s:\n%s\n" filename failure)
-	  (dired-make-relative filename))
-      (dired-remove-file elc-file)
-      (forward-line)			; insert .elc after its .el file
-      (dired-add-file elc-file)
-      nil)))
-
-;;;###autoload
-(defun dired-do-byte-compile (&optional arg)
-  "Byte compile marked (or next ARG) Emacs Lisp files."
-  (interactive "P")
-  (dired-map-over-marks-check (function dired-byte-compile) arg 'byte-compile t))
-
-(defun dired-load ()
-  ;; Return nil for success, offending file name else.
-  (let ((file (dired-get-filename)) failure)
-    (condition-case err
-      (load file nil nil t)
-      (error (setq failure err)))
-    (if (not failure)
-	nil
-      (dired-log "Load error for %s:\n%s\n" file failure)
-      (dired-make-relative file))))
-
-;;;###autoload
-(defun dired-do-load (&optional arg)
-  "Load the marked (or next ARG) Emacs Lisp files."
-  (interactive "P")
-  (dired-map-over-marks-check (function dired-load) arg 'load t))
-
-;;;###autoload
-(defun dired-do-redisplay (&optional arg test-for-subdir)
-  "Redisplay all marked (or next ARG) files.
-If on a subdir line, redisplay that subdirectory.  In that case,
-a prefix arg lets you edit the `ls' switches used for the new listing."
-  ;; Moves point if the next ARG files are redisplayed.
-  (interactive "P\np")
-  (if (and test-for-subdir (dired-get-subdir))
-      (dired-insert-subdir
-       (dired-get-subdir)
-       (if arg (read-string "Switches for listing: " dired-actual-switches)))
-    (message "Redisplaying...")
-    ;; message much faster than making dired-map-over-marks show progress
-    (dired-uncache
-     (if (consp dired-directory) (car dired-directory) dired-directory))
-    (dired-map-over-marks (let ((fname (dired-get-filename)))
-			    (message "Redisplaying... %s" fname)
-			    (dired-update-file-line fname))
-			  arg)
-    (dired-move-to-filename)
-    (message "Redisplaying...done")))
-
-(defun dired-update-file-line (file)
-  ;; Delete the current line, and insert an entry for FILE.
-  ;; If FILE is nil, then just delete the current line.
-  ;; Keeps any marks that may be present in column one (doing this
-  ;; here is faster than with dired-add-entry's optional arg).
-  ;; Does not update other dired buffers.  Use dired-relist-entry for that.
-  (beginning-of-line)
-  (let ((char (following-char)) (opoint (point))
-	(buffer-read-only))
-    (delete-region (point) (progn (forward-line 1) (point)))
-    (if file
-	(progn
-	  (dired-add-entry file)
-	  ;; Replace space by old marker without moving point.
-	  ;; Faster than goto+insdel inside a save-excursion?
-	  (subst-char-in-region opoint (1+ opoint) ?\040 char))))
-  (dired-move-to-filename))
-
-(defun dired-fun-in-all-buffers (directory fun &rest args)
-  ;; In all buffers dired'ing DIRECTORY, run FUN with ARGS.
-  ;; Return list of buffers where FUN succeeded (i.e., returned non-nil).
-  (let ((buf-list (dired-buffers-for-dir (expand-file-name directory)))
-	(obuf (current-buffer))
-	buf success-list)
-    (while buf-list
-      (setq buf (car buf-list)
-	    buf-list (cdr buf-list))
-      (unwind-protect
-	  (progn
-	    (set-buffer buf)
-	    (if (apply fun args)
-		(setq success-list (cons (buffer-name buf) success-list))))
-	(set-buffer obuf)))
-    success-list))
-
-;;;###autoload
-(defun dired-add-file (filename &optional marker-char)
-  (dired-fun-in-all-buffers
-   (file-name-directory filename)
-   (function dired-add-entry) filename marker-char))
-
-(defun dired-add-entry (filename &optional marker-char)
-  ;; Add a new entry for FILENAME, optionally marking it
-  ;; with MARKER-CHAR (a character, else dired-marker-char is used).
-  ;; Note that this adds the entry `out of order' if files sorted by
-  ;; time, etc.
-  ;; At least this version inserts in the right subdirectory (if present).
-  ;; And it skips "." or ".." (see `dired-trivial-filenames').
-  ;; Hidden subdirs are exposed if a file is added there.
-  (setq filename (directory-file-name filename))
-  ;; Entry is always for files, even if they happen to also be directories
-  (let ((opoint (point))
-	(cur-dir (dired-current-directory))
-	(orig-file-name filename)
-	(directory (file-name-directory filename))
-	reason)
-    (setq filename (file-name-nondirectory filename)
-	  reason
-	  (catch 'not-found
-	    (if (string= directory cur-dir)
-		(progn
-		  (skip-chars-forward "^\r\n")
-		  (if (eq (following-char) ?\r)
-		      (dired-unhide-subdir))
-		  ;; We are already where we should be, except when
-		  ;; point is before the subdir line or its total line.
-		  (let ((p (dired-after-subdir-garbage cur-dir)))
-		    (if (< (point) p)
-			(goto-char p))))
-	      ;; else try to find correct place to insert
-	      (if (dired-goto-subdir directory)
-		  (progn;; unhide if necessary
-		    (if (looking-at "\r");; point is at end of subdir line
-			(dired-unhide-subdir))
-		    ;; found - skip subdir and `total' line
-		    ;; and uninteresting files like . and ..
-		    ;; This better not moves into the next subdir!
-		    (dired-goto-next-nontrivial-file))
-		;; not found
-		(throw 'not-found "Subdir not found")))
-	    (let (buffer-read-only opoint)
-	      (beginning-of-line)
-	      (setq opoint (point))
-	      (dired-add-entry-do-indentation marker-char)
-	      ;; don't expand `.'.  Show just the file name within directory.
-	      (let ((default-directory directory))
-		(insert-directory filename
-				  (concat dired-actual-switches "d")))
-	      ;; Compensate for a bug in ange-ftp.
-	      ;; It inserts the file's absolute name, rather than
-	      ;; the relative one.  That may be hard to fix since it
-	      ;; is probably controlled by something in ftp.
-	      (goto-char opoint)	
-	      (let ((inserted-name (dired-get-filename 'no-dir)))
-		(if (file-name-directory inserted-name)
-		    (progn
-		      (end-of-line)
-		      (delete-char (- (length inserted-name)))
-		      (insert filename)
-		      (forward-char 1))
-		  (forward-line 1)))
-	      ;; Give each line a text property recording info about it.
-	      (dired-insert-set-properties opoint (point))
-	      (forward-line -1)
-	      (if dired-after-readin-hook;; the subdir-alist is not affected...
-		  (save-excursion;; ...so we can run it right now:
-		    (save-restriction
-		      (beginning-of-line)
-		      (narrow-to-region (point) (save-excursion
-						  (forward-line 1) (point)))
-		      (run-hooks 'dired-after-readin-hook))))
-	      (dired-move-to-filename))
-	    ;; return nil if all went well
-	    nil))
-    (if reason				; don't move away on failure
-	(goto-char opoint))
-    (not reason)))			; return t on success, nil else
-
-;; This is a separate function for the sake of nested dired format.
-(defun dired-add-entry-do-indentation (marker-char)
-  ;; two spaces or a marker plus a space:
-  (insert (if marker-char
-	      (if (integerp marker-char) marker-char dired-marker-char)
-	    ?\040)
-	  ?\040))
-
-(defun dired-after-subdir-garbage (dir)
-  ;; Return pos of first file line of DIR, skipping header and total
-  ;; or wildcard lines.
-  ;; Important: never moves into the next subdir.
-  ;; DIR is assumed to be unhidden.
-  ;; Will probably be redefined for VMS etc.
-  (save-excursion
-    (or (dired-goto-subdir dir) (error "This cannot happen"))
-    (forward-line 1)
-    (while (and (not (eolp))		; don't cross subdir boundary
-		(not (dired-move-to-filename)))
-	(forward-line 1))
-    (point)))
-
-;;;###autoload
-(defun dired-remove-file (file)
-  (dired-fun-in-all-buffers
-   (file-name-directory file) (function dired-remove-entry) file))
-
-(defun dired-remove-entry (file)
-  (save-excursion
-    (and (dired-goto-file file)
-	 (let (buffer-read-only)
-	   (delete-region (progn (beginning-of-line) (point))
-			  (save-excursion (forward-line 1) (point)))))))
-
-;;;###autoload
-(defun dired-relist-file (file)
-  (dired-fun-in-all-buffers (file-name-directory file)
-			    (function dired-relist-entry) file))
-
-(defun dired-relist-entry (file)
-  ;; Relist the line for FILE, or just add it if it did not exist.
-  ;; FILE must be an absolute pathname.
-  (let (buffer-read-only marker)
-    ;; If cursor is already on FILE's line delete-region will cause
-    ;; save-excursion to fail because of floating makers,
-    ;; moving point to beginning of line.  Sigh.
-    (save-excursion
-      (and (dired-goto-file file)
-	   (delete-region (progn (beginning-of-line)
-				 (setq marker (following-char))
-				 (point))
-			  (save-excursion (forward-line 1) (point))))
-      (setq file (directory-file-name file))
-      (dired-add-entry file (if (eq ?\040 marker) nil marker)))))
-
-;;; Copy, move/rename, making hard and symbolic links
-
-(defvar dired-backup-overwrite nil
-  "*Non-nil if Dired should ask about making backups before overwriting files.
-Special value `always' suppresses confirmation.")
-
-(defvar dired-overwrite-confirmed)
-
-(defun dired-handle-overwrite (to)
-  ;; Save old version of a to be overwritten file TO.
-  ;; `dired-overwrite-confirmed' and `overwrite-backup-query' are fluid vars
-  ;; from dired-create-files.
-  (let (backup)
-    (if (and dired-backup-overwrite
-	     dired-overwrite-confirmed
-	     (setq backup (car (find-backup-file-name to)))
-	     (or (eq 'always dired-backup-overwrite)
-		 (dired-query 'overwrite-backup-query
-			      (format "Make backup for existing file `%s'? " to))))
-	(progn
-	  (rename-file to backup 0)	; confirm overwrite of old backup
-	  (dired-relist-entry backup)))))
-
-;;;###autoload
-(defun dired-copy-file (from to ok-flag)
-  (dired-handle-overwrite to)
-  (copy-file from to ok-flag dired-copy-preserve-time))
-
-;;;###autoload
-(defun dired-rename-file (from to ok-flag)
-  (dired-handle-overwrite to)
-  (rename-file from to ok-flag)		; error is caught in -create-files
-  ;; Silently rename the visited file of any buffer visiting this file.
-  (and (get-file-buffer from)
-       (save-excursion
-	 (set-buffer (get-file-buffer from))
-	 (let ((modflag (buffer-modified-p)))
-	   (set-visited-file-name to)
-	   (set-buffer-modified-p modflag))))
-  (dired-remove-file from)
-  ;; See if it's an inserted subdir, and rename that, too.
-  (dired-rename-subdir from to))
-
-(defun dired-rename-subdir (from-dir to-dir)
-  (setq from-dir (file-name-as-directory from-dir)
-	to-dir (file-name-as-directory to-dir))
-  (dired-fun-in-all-buffers from-dir
-			    (function dired-rename-subdir-1) from-dir to-dir)
-  ;; Update visited file name of all affected buffers
-  (let ((expanded-from-dir (expand-file-name from-dir))
-	(blist (buffer-list)))
-    (while blist
-      (save-excursion
-	(set-buffer (car blist))
-	(if (and buffer-file-name
-		 (dired-in-this-tree buffer-file-name expanded-from-dir))
-	    (let ((modflag (buffer-modified-p))
-		  (to-file (dired-replace-in-string
-			    (concat "^" (regexp-quote from-dir))
-			    to-dir
-			    buffer-file-name)))
-	      (set-visited-file-name to-file)
-	      (set-buffer-modified-p modflag))))
-      (setq blist (cdr blist)))))
-
-(defun dired-rename-subdir-1 (dir to)
-  ;; Rename DIR to TO in headerlines and dired-subdir-alist, if DIR or
-  ;; one of its subdirectories is expanded in this buffer.
-  (let ((expanded-dir (expand-file-name dir))
-	(alist dired-subdir-alist)
-	(elt nil))
-    (while alist
-      (setq elt (car alist)
-	    alist (cdr alist))
-      (if (dired-in-this-tree (car elt) expanded-dir)
-	  ;; ELT's subdir is affected by the rename
-	  (dired-rename-subdir-2 elt dir to)))
-    (if (equal dir default-directory)
-	;; if top level directory was renamed, lots of things have to be
-	;; updated:
-	(progn
-	  (dired-unadvertise dir)	; we no longer dired DIR...
-	  (setq default-directory to
-		dired-directory (expand-file-name;; this is correct
-				 ;; with and without wildcards
-				 (file-name-nondirectory dired-directory)
-				 to))
-	  (let ((new-name (file-name-nondirectory
-			   (directory-file-name dired-directory))))
-	    ;; try to rename buffer, but just leave old name if new
-	    ;; name would already exist (don't try appending "<%d>")
-	    (or (get-buffer new-name)
-		(rename-buffer new-name)))
-	  ;; ... we dired TO now:
-	  (dired-advertise)))))
-
-(defun dired-rename-subdir-2 (elt dir to)
-  ;; Update the headerline and dired-subdir-alist element of directory
-  ;; described by alist-element ELT to reflect the moving of DIR to TO.
-  ;; Thus, ELT describes either DIR itself or a subdir of DIR.
-  (save-excursion
-    (let ((regexp (regexp-quote (directory-file-name dir)))
-	  (newtext (directory-file-name to))
-	  buffer-read-only)
-      (goto-char (dired-get-subdir-min elt))
-      ;; Update subdir headerline in buffer
-      (if (not (looking-at dired-subdir-regexp))
-	  (error "%s not found where expected - dired-subdir-alist broken?"
-		 dir)
-	(goto-char (match-beginning 1))
-	(if (re-search-forward regexp (match-end 1) t)
-	    (replace-match newtext t t)
-	  (error "Expected to find `%s' in headerline of %s" dir (car elt))))
-      ;; Update buffer-local dired-subdir-alist
-      (setcar elt
-	      (dired-normalize-subdir
-	       (dired-replace-in-string regexp newtext (car elt)))))))
-
-;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
-(defun dired-create-files (file-creator operation fn-list name-constructor
-					&optional marker-char)
-
-;; Create a new file for each from a list of existing files.  The user
-;; is queried, dired buffers are updated, and at the end a success or
-;; failure message is displayed
-
-;; FILE-CREATOR must accept three args: oldfile newfile ok-if-already-exists
-
-;; It is called for each file and must create newfile, the entry of
-;; which will be added.  The user will be queried if the file already
-;; exists.  If oldfile is removed by FILE-CREATOR (i.e, it is a
-;; rename), it is FILE-CREATOR's responsibility to update dired
-;; buffers.  FILE-CREATOR must abort by signaling a file-error if it
-;; could not create newfile.  The error is caught and logged.
-
-;; OPERATION (a capitalized string, e.g. `Copy') describes the
-;; operation performed.  It is used for error logging.
-
-;; FN-LIST is the list of files to copy (full absolute pathnames).
-
-;; NAME-CONSTRUCTOR returns a newfile for every oldfile, or nil to
-;; skip.  If it skips files for other reasons than a direct user
-;; query, it is supposed to tell why (using dired-log).
-
-;; Optional MARKER-CHAR is a character with which to mark every
-;; newfile's entry, or t to use the current marker character if the
-;; oldfile was marked.
-
-  (let (failures skipped (success-count 0) (total (length fn-list)))
-    (let (to overwrite-query
-	     overwrite-backup-query)	; for dired-handle-overwrite
-      (mapcar
-       (function
-	(lambda (from)
-	  (setq to (funcall name-constructor from))
-	  (if (equal to from)
-	      (progn
-		(setq to nil)
-		(dired-log "Cannot %s to same file: %s\n"
-			   (downcase operation) from)))
-	  (if (not to)
-	      (setq skipped (cons (dired-make-relative from) skipped))
-	    (let* ((overwrite (file-exists-p to))
-		   (dired-overwrite-confirmed	; for dired-handle-overwrite
-		    (and overwrite
-			 (let ((help-form '(format "\
-Type SPC or `y' to overwrite file `%s',
-DEL or `n' to skip to next,
-ESC or `q' to not overwrite any of the remaining files,
-`!' to overwrite all remaining files with no more questions." to)))
-			   (dired-query 'overwrite-query
-					"Overwrite `%s'?" to))))
-		   ;; must determine if FROM is marked before file-creator
-		   ;; gets a chance to delete it (in case of a move).
-		   (actual-marker-char
-		    (cond  ((integerp marker-char) marker-char)
-			   (marker-char (dired-file-marker from)) ; slow
-			   (t nil))))
-	      (condition-case err
-		  (progn
-		    (funcall file-creator from to dired-overwrite-confirmed)
-		    (if overwrite
-			;; If we get here, file-creator hasn't been aborted
-			;; and the old entry (if any) has to be deleted
-			;; before adding the new entry.
-			(dired-remove-file to))
-		    (setq success-count (1+ success-count))
-		    (message "%s: %d of %d" operation success-count total)
-		    (dired-add-file to actual-marker-char))
-		(file-error		; FILE-CREATOR aborted
-		 (progn
-		   (setq failures (cons (dired-make-relative from) failures))
-		   (dired-log "%s `%s' to `%s' failed:\n%s\n"
-			      operation from to err))))))))
-       fn-list))
-    (cond
-     (failures
-      (dired-log-summary
-       (format "%s failed for %d of %d file%s"
-		operation (length failures) total
-		(dired-plural-s total))
-       failures))
-     (skipped
-      (dired-log-summary
-       (format "%s: %d of %d file%s skipped"
-		operation (length skipped) total
-		(dired-plural-s total))
-       skipped))
-     (t
-      (message "%s: %s file%s"
-	       operation success-count (dired-plural-s success-count)))))
-  (dired-move-to-filename))
-
-(defun dired-do-create-files (op-symbol file-creator operation arg
-					     &optional marker-char op1
-					     how-to)
-  ;; Create a new file for each marked file.
-  ;; Prompts user for target, which is a directory in which to create
-  ;;   the new files.  Target may be a plain file if only one marked
-  ;;   file exists.
-  ;; OP-SYMBOL is the symbol for the operation.  Function `dired-mark-pop-up'
-  ;;   will determine whether pop-ups are appropriate for this OP-SYMBOL.
-  ;; FILE-CREATOR and OPERATION as in dired-create-files.
-  ;; ARG as in dired-get-marked-files.
-  ;; Optional arg OP1 is an alternate form for OPERATION if there is
-  ;;   only one file.
-  ;; Optional arg MARKER-CHAR as in dired-create-files.
-  ;; Optional arg HOW-TO determines how to treat target:
-  ;;   If HOW-TO is not given (or nil), and target is a directory, the
-  ;;     file(s) are created inside the target directory.  If target
-  ;;     is not a directory, there must be exactly one marked file,
-  ;;     else error.
-  ;;   If HOW-TO is t, then target is not modified.  There must be
-  ;;     exactly one marked file, else error.
-  ;; Else HOW-TO is assumed to be a function of one argument, target,
-  ;;     that looks at target and returns a value for the into-dir
-  ;;     variable.  The function dired-into-dir-with-symlinks is provided
-  ;;     for the case (common when creating symlinks) that symbolic
-  ;;     links to directories are not to be considered as directories
-  ;;     (as file-directory-p would if HOW-TO had been nil).
-  (or op1 (setq op1 operation))
-  (let* ((fn-list (dired-get-marked-files nil arg))
-	 (fn-count (length fn-list))
-	 (target (expand-file-name
-		   (dired-mark-read-file-name
-		    (concat (if (= 1 fn-count) op1 operation) " %s to: ")
-		    (dired-dwim-target-directory)
-		    op-symbol arg (mapcar (function dired-make-relative) fn-list))))
-	 (into-dir (cond ((null how-to) (file-directory-p target))
-			 ((eq how-to t) nil)
-			 (t (funcall how-to target)))))
-    (if (and (> fn-count 1)
-	     (not into-dir))
-	(error "Marked %s: target must be a directory: %s" operation target))
-    ;; rename-file bombs when moving directories unless we do this:
-    (or into-dir (setq target (directory-file-name target)))
-    (dired-create-files
-     file-creator operation fn-list
-     (if into-dir			; target is a directory
-	 ;; This function uses fluid vars into-dir and target when called
-	 ;; inside dired-create-files:
-	 (function (lambda (from)
-		     (expand-file-name (file-name-nondirectory from) target)))
-       (function (lambda (from) target)))
-     marker-char)))
-
-;; Read arguments for a marked-files command that wants a file name,
-;; perhaps popping up the list of marked files.
-;; ARG is the prefix arg and indicates whether the files came from
-;; marks (ARG=nil) or a repeat factor (integerp ARG).
-;; If the current file was used, the list has but one element and ARG
-;; does not matter. (It is non-nil, non-integer in that case, namely '(4)).
-
-(defun dired-mark-read-file-name (prompt dir op-symbol arg files)
-  (dired-mark-pop-up
-   nil op-symbol files
-   (function read-file-name)
-   (format prompt (dired-mark-prompt arg files)) dir))
-
-(defun dired-dwim-target-directory ()
-  ;; Try to guess which target directory the user may want.
-  ;; If there is a dired buffer displayed in the next window, use
-  ;; its current subdir, else use current subdir of this dired buffer.
-  (let ((this-dir (and (eq major-mode 'dired-mode)
-		       (dired-current-directory))))
-    ;; non-dired buffer may want to profit from this function, e.g. vm-uudecode
-    (if dired-dwim-target
-	(let* ((other-buf (window-buffer (next-window)))
-	       (other-dir (save-excursion
-			    (set-buffer other-buf)
-			    (and (eq major-mode 'dired-mode)
-				 (dired-current-directory)))))
-	  (or other-dir this-dir))
-      this-dir)))
-
-;;;###autoload
-(defun dired-create-directory (directory)
-  "Create a directory called DIRECTORY."
-  (interactive
-   (list (read-file-name "Create directory: " (dired-current-directory))))
-  (let ((expanded (directory-file-name (expand-file-name directory))))
-    (make-directory expanded)
-    (dired-add-file expanded)
-    (dired-move-to-filename)))
-
-(defun dired-into-dir-with-symlinks (target)
-  (and (file-directory-p target)
-       (not (file-symlink-p target))))
-;; This may not always be what you want, especially if target is your
-;; home directory and it happens to be a symbolic link, as is often the
-;; case with NFS and automounters.  Or if you want to make symlinks
-;; into directories that themselves are only symlinks, also quite
-;; common.
-
-;; So we don't use this function as value for HOW-TO in
-;; dired-do-symlink, which has the minor disadvantage of
-;; making links *into* a symlinked-dir, when you really wanted to
-;; *overwrite* that symlink.  In that (rare, I guess) case, you'll
-;; just have to remove that symlink by hand before making your marked
-;; symlinks.
-
-;;;###autoload
-(defun dired-do-copy (&optional arg)
-  "Copy all marked (or next ARG) files, or copy the current file.
-This normally preserves the last-modified date when copying.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory,
-and new copies of these files are made in that directory
-with the same names that the files currently have."
-  (interactive "P")
-  (dired-do-create-files 'copy (function dired-copy-file)
-			   (if dired-copy-preserve-time "Copy [-p]" "Copy")
-			   arg dired-keep-marker-copy))
-
-;;;###autoload
-(defun dired-do-symlink (&optional arg)
-  "Make symbolic links to current file or all marked (or next ARG) files.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory
-and new symbolic links are made in that directory
-with the same names that the files currently have."
-  (interactive "P")
-  (dired-do-create-files 'symlink (function make-symbolic-link)
-			   "Symlink" arg dired-keep-marker-symlink))
-
-;;;###autoload
-(defun dired-do-hardlink (&optional arg)
-  "Add names (hard links) current file or all marked (or next ARG) files.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory
-and new hard links are made in that directory
-with the same names that the files currently have."
-  (interactive "P")
-  (dired-do-create-files 'hardlink (function add-name-to-file)
-			   "Hardlink" arg dired-keep-marker-hardlink))
-
-;;;###autoload
-(defun dired-do-rename (&optional arg)
-  "Rename current file or all marked (or next ARG) files.
-When renaming just the current file, you specify the new name.
-When renaming multiple or marked files, you specify a directory."
-  (interactive "P")
-  (dired-do-create-files 'move (function dired-rename-file)
-			 "Move" arg dired-keep-marker-rename "Rename"))
-;;;###end dired-cp.el
-
-;;; 5K
-;;;###begin dired-re.el
-(defun dired-do-create-files-regexp
-  (file-creator operation arg regexp newname &optional whole-path marker-char)
-  ;; Create a new file for each marked file using regexps.
-  ;; FILE-CREATOR and OPERATION as in dired-create-files.
-  ;; ARG as in dired-get-marked-files.
-  ;; Matches each marked file against REGEXP and constructs the new
-  ;;   filename from NEWNAME (like in function replace-match).
-  ;; Optional arg WHOLE-PATH means match/replace the whole pathname
-  ;;   instead of only the non-directory part of the file.
-  ;; Optional arg MARKER-CHAR as in dired-create-files.
-  (let* ((fn-list (dired-get-marked-files nil arg))
-	 (fn-count (length fn-list))
-	 (operation-prompt (concat operation " `%s' to `%s'?"))
-	 (rename-regexp-help-form (format "\
-Type SPC or `y' to %s one match, DEL or `n' to skip to next,
-`!' to %s all remaining matches with no more questions."
-					  (downcase operation)
-					  (downcase operation)))
-	 (regexp-name-constructor
-	  ;; Function to construct new filename using REGEXP and NEWNAME:
-	  (if whole-path		; easy (but rare) case
-	      (function
-	       (lambda (from)
-		 (let ((to (dired-string-replace-match regexp from newname))
-		       ;; must bind help-form directly around call to
-		       ;; dired-query
-		       (help-form rename-regexp-help-form))
-		   (if to
-		       (and (dired-query 'rename-regexp-query
-					 operation-prompt
-					 from
-					 to)
-			    to)
-		     (dired-log "%s: %s did not match regexp %s\n"
-				operation from regexp)))))
-	    ;; not whole-path, replace non-directory part only
-	    (function
-	     (lambda (from)
-	       (let* ((new (dired-string-replace-match
-			    regexp (file-name-nondirectory from) newname))
-		      (to (and new	; nil means there was no match
-			       (expand-file-name new
-						 (file-name-directory from))))
-		      (help-form rename-regexp-help-form))
-		 (if to
-		     (and (dired-query 'rename-regexp-query
-				       operation-prompt
-				       (dired-make-relative from)
-				       (dired-make-relative to))
-			  to)
-		   (dired-log "%s: %s did not match regexp %s\n"
-			      operation (file-name-nondirectory from) regexp)))))))
-	 rename-regexp-query)
-    (dired-create-files
-     file-creator operation fn-list regexp-name-constructor marker-char)))
-
-(defun dired-mark-read-regexp (operation)
-  ;; Prompt user about performing OPERATION.
-  ;; Read and return list of: regexp newname arg whole-path.
-  (let* ((whole-path
-	  (equal 0 (prefix-numeric-value current-prefix-arg)))
-	 (arg
-	  (if whole-path nil current-prefix-arg))
-	 (regexp
-	  (dired-read-regexp
-	   (concat (if whole-path "Path " "") operation " from (regexp): ")))
-	 (newname
-	  (read-string
-	   (concat (if whole-path "Path " "") operation " " regexp " to: "))))
-    (list regexp newname arg whole-path)))
-
-;;;###autoload
-(defun dired-do-rename-regexp (regexp newname &optional arg whole-path)
-  "Rename marked files containing REGEXP to NEWNAME.
-As each match is found, the user must type a character saying
-  what to do with it.  For directions, type \\[help-command] at that time.
-NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
-REGEXP defaults to the last regexp used.
-With a zero prefix arg, renaming by regexp affects the complete
-  pathname - usually only the non-directory part of file names is used
-  and changed."
-  (interactive (dired-mark-read-regexp "Rename"))
-  (dired-do-create-files-regexp
-   (function dired-rename-file)
-   "Rename" arg regexp newname whole-path dired-keep-marker-rename))
-
-;;;###autoload
-(defun dired-do-copy-regexp (regexp newname &optional arg whole-path)
-  "Copy all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
-  (interactive (dired-mark-read-regexp "Copy"))
-  (dired-do-create-files-regexp
-   (function dired-copy-file)
-   (if dired-copy-preserve-time "Copy [-p]" "Copy")
-   arg regexp newname whole-path dired-keep-marker-copy))
-
-;;;###autoload
-(defun dired-do-hardlink-regexp (regexp newname &optional arg whole-path)
-  "Hardlink all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
-  (interactive (dired-mark-read-regexp "HardLink"))
-  (dired-do-create-files-regexp
-   (function add-name-to-file)
-   "HardLink" arg regexp newname whole-path dired-keep-marker-hardlink))
-
-;;;###autoload
-(defun dired-do-symlink-regexp (regexp newname &optional arg whole-path)
-  "Symlink all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
-  (interactive (dired-mark-read-regexp "SymLink"))
-  (dired-do-create-files-regexp
-   (function make-symbolic-link)
-   "SymLink" arg regexp newname whole-path dired-keep-marker-symlink))
-
-(defun dired-create-files-non-directory
-  (file-creator basename-constructor operation arg)
-  ;; Perform FILE-CREATOR on the non-directory part of marked files
-  ;; using function BASENAME-CONSTRUCTOR, with query for each file.
-  ;; OPERATION like in dired-create-files, ARG as in dired-get-marked-files.
-  (let (rename-non-directory-query)
-    (dired-create-files
-     file-creator
-     operation
-     (dired-get-marked-files nil arg)
-     (function
-      (lambda (from)
-	(let ((to (concat (file-name-directory from)
-			  (funcall basename-constructor
-				   (file-name-nondirectory from)))))
-	  (and (let ((help-form (format "\
-Type SPC or `y' to %s one file, DEL or `n' to skip to next,
-`!' to %s all remaining matches with no more questions."
-					(downcase operation)
-					(downcase operation))))
-		 (dired-query 'rename-non-directory-query
-			      (concat operation " `%s' to `%s'")
-			      (dired-make-relative from)
-			      (dired-make-relative to)))
-	       to))))
-     dired-keep-marker-rename)))
-
-(defun dired-rename-non-directory (basename-constructor operation arg)
-  (dired-create-files-non-directory
-   (function dired-rename-file)
-   basename-constructor operation arg))
-
-;;;###autoload
-(defun dired-upcase (&optional arg)
-  "Rename all marked (or next ARG) files to upper case."
-  (interactive "P")
-  (dired-rename-non-directory (function upcase) "Rename upcase" arg))
-
-;;;###autoload
-(defun dired-downcase (&optional arg)
-  "Rename all marked (or next ARG) files to lower case."
-  (interactive "P")
-  (dired-rename-non-directory (function downcase) "Rename downcase" arg))
-
-;;;###end dired-re.el
-
-;;; 13K
-;;;###begin dired-ins.el
-
-;;;###autoload
-(defun dired-maybe-insert-subdir (dirname &optional
-					  switches no-error-if-not-dir-p)
-  "Insert this subdirectory into the same dired buffer.
-If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
-  else inserts it at its natural place (as `ls -lR' would have done).
-With a prefix arg, you may edit the ls switches used for this listing.
-  You can add `R' to the switches to expand the whole tree starting at
-  this subdirectory.
-This function takes some pains to conform to `ls -lR' output."
-  (interactive
-   (list (dired-get-filename)
-	 (if current-prefix-arg
-	     (read-string "Switches for listing: " dired-actual-switches))))
-  (let ((opoint (point)))
-    ;; We don't need a marker for opoint as the subdir is always
-    ;; inserted *after* opoint.
-    (setq dirname (file-name-as-directory dirname))
-    (or (and (not switches)
-	     (dired-goto-subdir dirname))
-	(dired-insert-subdir dirname switches no-error-if-not-dir-p))
-    ;; Push mark so that it's easy to find back.  Do this after the
-    ;; insert message so that the user sees the `Mark set' message.
-    (push-mark opoint)))
-
-(defun dired-insert-subdir (dirname &optional switches no-error-if-not-dir-p)
-  "Insert this subdirectory into the same dired buffer.
-If it is already present, overwrites previous entry,
-  else inserts it at its natural place (as `ls -lR' would have done).
-With a prefix arg, you may edit the `ls' switches used for this listing.
-  You can add `R' to the switches to expand the whole tree starting at
-  this subdirectory.
-This function takes some pains to conform to `ls -lR' output."
-  ;; NO-ERROR-IF-NOT-DIR-P needed for special filesystems like
-  ;; Prospero where dired-ls does the right thing, but
-  ;; file-directory-p has not been redefined.
-  (interactive
-   (list (dired-get-filename)
-	 (if current-prefix-arg
-	     (read-string "Switches for listing: " dired-actual-switches))))
-  (setq dirname (file-name-as-directory (expand-file-name dirname)))
-  (dired-insert-subdir-validate dirname switches)
-  (or no-error-if-not-dir-p
-      (file-directory-p dirname)
-      (error  "Attempt to insert a non-directory: %s" dirname))
-  (let ((elt (assoc dirname dired-subdir-alist))
-	 switches-have-R mark-alist case-fold-search buffer-read-only)
-    ;; case-fold-search is nil now, so we can test for capital `R':
-    (if (setq switches-have-R (and switches (string-match "R" switches)))
-	;; avoid duplicated subdirs
-	(setq mark-alist (dired-kill-tree dirname t)))
-    (if elt
-	;; If subdir is already present, remove it and remember its marks
-	(setq mark-alist (nconc (dired-insert-subdir-del elt) mark-alist))
-      (dired-insert-subdir-newpos dirname)) ; else compute new position
-    (dired-insert-subdir-doupdate
-     dirname elt (dired-insert-subdir-doinsert dirname switches))
-    (if switches-have-R (dired-build-subdir-alist))
-    (dired-initial-position dirname)
-    (save-excursion (dired-mark-remembered mark-alist))))
-
-;; This is a separate function for dired-vms.
-(defun dired-insert-subdir-validate (dirname &optional switches)
-  ;; Check that it is valid to insert DIRNAME with SWITCHES.
-  ;; Signal an error if invalid (e.g. user typed `i' on `..').
-  (or (dired-in-this-tree dirname (expand-file-name default-directory))
-      (error  "%s: not in this directory tree" dirname))
-  (if switches
-      (let (case-fold-search)
-	(mapcar
-	 (function
-	  (lambda (x)
-	    (or (eq (null (string-match x switches))
-		    (null (string-match x dired-actual-switches)))
-		(error "Can't have dirs with and without -%s switches together"
-		       x))))
-	 ;; all switches that make a difference to dired-get-filename:
-	 '("F" "b")))))
-
-(defun dired-alist-add (dir new-marker)
-  ;; Add new DIR at NEW-MARKER.  Sort alist.
-  (dired-alist-add-1 dir new-marker)
-  (dired-alist-sort))
-
-(defun dired-alist-sort ()
-  ;; Keep the alist sorted on buffer position.
-  (setq dired-subdir-alist
-	(sort dired-subdir-alist
-	      (function (lambda (elt1 elt2)
-			  (> (dired-get-subdir-min elt1)
-			     (dired-get-subdir-min elt2)))))))
-
-(defun dired-kill-tree (dirname &optional remember-marks)
-  ;;"Kill all proper subdirs of DIRNAME, excluding DIRNAME itself.
-  ;; With optional arg REMEMBER-MARKS, return an alist of marked files."
-  (interactive "DKill tree below directory: ")
-  (setq dirname (expand-file-name dirname))
-  (let ((s-alist dired-subdir-alist) dir m-alist)
-    (while s-alist
-      (setq dir (car (car s-alist))
-	    s-alist (cdr s-alist))
-      (if (and (not (string-equal dir dirname))
-	       (dired-in-this-tree dir dirname)
-	       (dired-goto-subdir dir))
-	  (setq m-alist (nconc (dired-kill-subdir remember-marks) m-alist))))
-    m-alist))
-
-(defun dired-insert-subdir-newpos (new-dir)
-  ;; Find pos for new subdir, according to tree order.
-  ;;(goto-char (point-max))
-  (let ((alist dired-subdir-alist) elt dir pos new-pos)
-    (while alist
-      (setq elt (car alist)
-	    alist (cdr alist)
-	    dir (car elt)
-	    pos (dired-get-subdir-min elt))
-      (if (dired-tree-lessp dir new-dir)
-	  ;; Insert NEW-DIR after DIR
-	  (setq new-pos (dired-get-subdir-max elt)
-		alist nil)))
-    (goto-char new-pos))
-  ;; want a separating newline between subdirs
-  (or (eobp)
-      (forward-line -1))
-  (insert "\n")
-  (point))
-
-(defun dired-insert-subdir-del (element)
-  ;; Erase an already present subdir (given by ELEMENT) from buffer.
-  ;; Move to that buffer position.  Return a mark-alist.
-  (let ((begin-marker (dired-get-subdir-min element)))
-    (goto-char begin-marker)
-    ;; Are at beginning of subdir (and inside it!).  Now determine its end:
-    (goto-char (dired-subdir-max))
-    (or (eobp);; want a separating newline _between_ subdirs:
-	(forward-char -1))
-    (prog1
-	(dired-remember-marks begin-marker (point))
-      (delete-region begin-marker (point)))))
-
-(defun dired-insert-subdir-doinsert (dirname switches)
-  ;; Insert ls output after point and put point on the correct
-  ;; position for the subdir alist.
-  ;; Return the boundary of the inserted text (as list of BEG and END).
-  (let ((begin (point)) end)
-    (message "Reading directory %s..." dirname)
-    (let ((dired-actual-switches
-	   (or switches
-	       (dired-replace-in-string "R" "" dired-actual-switches))))
-      (if (equal dirname (car (car (reverse dired-subdir-alist))))
-	  ;; top level directory may contain wildcards:
-	  (dired-readin-insert dired-directory)
-	(let ((opoint (point)))
-	  (insert-directory dirname dired-actual-switches nil t)
-	  (dired-insert-set-properties opoint (point)))))
-    (message "Reading directory %s...done" dirname)
-    (setq end (point-marker))
-    (indent-rigidly begin end 2)
-    ;;  call dired-insert-headerline afterwards, as under VMS dired-ls
-    ;;  does insert the headerline itself and the insert function just
-    ;;  moves point.
-    ;;  Need a marker for END as this inserts text.
-    (goto-char begin)
-    (dired-insert-headerline dirname)
-    ;; point is now like in dired-build-subdir-alist
-    (prog1
-	(list begin (marker-position end))
-      (set-marker end nil))))
-
-(defun dired-insert-subdir-doupdate (dirname elt beg-end)
-  ;; Point is at the correct subdir alist position for ELT,
-  ;; BEG-END is the subdir-region (as list of begin and end).
-  (if elt				; subdir was already present
-      ;; update its position (should actually be unchanged)
-      (set-marker (dired-get-subdir-min elt) (point-marker))
-    (dired-alist-add dirname (point-marker)))
-  ;; The hook may depend on the subdir-alist containing the just
-  ;; inserted subdir, so run it after dired-alist-add:
-  (if dired-after-readin-hook
-      (save-excursion
-	(let ((begin (nth 0 beg-end))
-	      (end (nth 1 beg-end)))
-	  (goto-char begin)
-	  (save-restriction
-	    (narrow-to-region begin end)
-	    ;; hook may add or delete lines, but the subdir boundary
-	    ;; marker floats
-	    (run-hooks 'dired-after-readin-hook))))))
-
-(defun dired-tree-lessp (dir1 dir2)
-  ;; Lexicographic order on pathname components, like `ls -lR':
-  ;; DIR1 < DIR2 iff DIR1 comes *before* DIR2 in an `ls -lR' listing,
-  ;;   i.e., iff DIR1 is a (grand)parent dir of DIR2,
-  ;;   or DIR1 and DIR2 are in the same parentdir and their last
-  ;;   components are string-lessp.
-  ;; Thus ("/usr/" "/usr/bin") and ("/usr/a/" "/usr/b/") are tree-lessp.
-  ;; string-lessp could arguably be replaced by file-newer-than-file-p
-  ;;   if dired-actual-switches contained `t'.
-  (setq dir1 (file-name-as-directory dir1)
-	dir2 (file-name-as-directory dir2))
-  (let ((components-1 (dired-split "/" dir1))
-	(components-2 (dired-split "/" dir2)))
-    (while (and components-1
-		components-2
-		(equal (car components-1) (car components-2)))
-      (setq components-1 (cdr components-1)
-	    components-2 (cdr components-2)))
-    (let ((c1 (car components-1))
-	  (c2 (car components-2)))
-
-      (cond ((and c1 c2)
-	     (string-lessp c1 c2))
-	    ((and (null c1) (null c2))
-	     nil)			; they are equal, not lessp
-	    ((null c1)			; c2 is a subdir of c1: c1<c2
-	     t)
-	    ((null c2)			; c1 is a subdir of c2: c1>c2
-	     nil)
-	    (t (error "This can't happen"))))))
-
-;; There should be a builtin split function - inverse to mapconcat.
-(defun dired-split (pat str &optional limit)
-  "Splitting on regexp PAT, turn string STR into a list of substrings.
-Optional third arg LIMIT (>= 1) is a limit to the length of the
-resulting list.
-Thus, if SEP is a regexp that only matches itself,
-
-   (mapconcat 'identity (dired-split SEP STRING) SEP)
-
-is always equal to STRING."
-  (let* ((start (string-match pat str))
-	 (result (list (substring str 0 start)))
-	 (count 1)
-	 (end (if start (match-end 0))))
-    (if end				; else nothing left
-	(while (and (or (not (integerp limit))
-			(< count limit))
-		    (string-match pat str end))
-	  (setq start (match-beginning 0)
-		count (1+ count)
-		result (cons (substring str end start) result)
-		end (match-end 0)
-		start end)
-	  ))
-    (if (and (or (not (integerp limit))
-		 (< count limit))
-	     end)			; else nothing left
-	(setq result
-	      (cons (substring str end) result)))
-    (nreverse result)))
-
-;;; moving by subdirectories
-
-;;;###autoload
-(defun dired-prev-subdir (arg &optional no-error-if-not-found no-skip)
-  "Go to previous subdirectory, regardless of level.
-When called interactively and not on a subdir line, go to this subdir's line."
-  ;;(interactive "p")
-  (interactive
-   (list (if current-prefix-arg
-	     (prefix-numeric-value current-prefix-arg)
-	   ;; if on subdir start already, don't stay there!
-	   (if (dired-get-subdir) 1 0))))
-  (dired-next-subdir (- arg) no-error-if-not-found no-skip))
-
-(defun dired-subdir-min ()
-  (save-excursion
-    (if (not (dired-prev-subdir 0 t t))
-	(error "Not in a subdir!")
-      (point))))
-
-;;;###autoload
-(defun dired-goto-subdir (dir)
-  "Go to end of header line of DIR in this dired buffer.
-Return value of point on success, otherwise return nil.
-The next char is either \\n, or \\r if DIR is hidden."
-  (interactive
-   (prog1				; let push-mark display its message
-       (list (expand-file-name
-	      (completing-read "Goto in situ directory: " ; prompt
-			       dired-subdir-alist ; table
-			       nil	; predicate
-			       t	; require-match
-			       (dired-current-directory))))
-     (push-mark)))
-  (setq dir (file-name-as-directory dir))
-  (let ((elt (assoc dir dired-subdir-alist)))
-    (and elt
-	 (goto-char (dired-get-subdir-min elt))
-	 ;; dired-subdir-hidden-p and dired-add-entry depend on point being
-	 ;; at either \r or \n after this function succeeds.
-	 (progn (skip-chars-forward "^\r\n")
-		(point)))))
-
-;;;###autoload
-(defun dired-mark-subdir-files ()
-  "Mark all files except `.' and `..'."
-  (interactive)
-  (let ((p-min (dired-subdir-min)))
-    (dired-mark-files-in-region p-min (dired-subdir-max))))
-
-;;;###autoload
-(defun dired-kill-subdir (&optional remember-marks)
-  "Remove all lines of current subdirectory.
-Lower levels are unaffected."
-  ;; With optional REMEMBER-MARKS, return a mark-alist.
-  (interactive)
-  (let ((beg (dired-subdir-min))
-	(end (dired-subdir-max))
-	buffer-read-only cur-dir)
-    (setq cur-dir (dired-current-directory))
-    (if (equal cur-dir default-directory)
-	(error "Attempt to kill top level directory"))
-    (prog1
-	(if remember-marks (dired-remember-marks beg end))
-      (delete-region beg end)
-      (if (eobp)			; don't leave final blank line
-	  (delete-char -1))
-      (dired-unsubdir cur-dir))))
-
-(defun dired-unsubdir (dir)
-  ;; Remove DIR from the alist
-  (setq dired-subdir-alist
-	(delq (assoc dir dired-subdir-alist) dired-subdir-alist)))
-
-;;;###autoload
-(defun dired-tree-up (arg)
-  "Go up ARG levels in the dired tree."
-  (interactive "p")
-  (let ((dir (dired-current-directory)))
-    (while (>= arg 1)
-      (setq arg (1- arg)
-	    dir (file-name-directory (directory-file-name dir))))
-    ;;(setq dir (expand-file-name dir))
-    (or (dired-goto-subdir dir)
-	(error "Cannot go up to %s - not in this tree." dir))))
-
-;;;###autoload
-(defun dired-tree-down ()
-  "Go down in the dired tree."
-  (interactive)
-  (let ((dir (dired-current-directory)) ; has slash
-	pos case-fold-search)		; filenames are case sensitive
-    (let ((rest (reverse dired-subdir-alist)) elt)
-      (while rest
-	(setq elt (car rest)
-	      rest (cdr rest))
-	(if (dired-in-this-tree (directory-file-name (car elt)) dir)
-	    (setq rest nil
-		  pos (dired-goto-subdir (car elt))))))
-    (if pos
-	(goto-char pos)
-      (error "At the bottom"))))
-
-;;; hiding
-
-(defun dired-unhide-subdir ()
-  (let (buffer-read-only)
-    (subst-char-in-region (dired-subdir-min) (dired-subdir-max) ?\r ?\n)))
-
-(defun dired-hide-check ()
-  (or selective-display
-      (error "selective-display must be t for subdir hiding to work!")))
-
-(defun dired-subdir-hidden-p (dir)
-  (and selective-display
-       (save-excursion
-	 (dired-goto-subdir dir)
-	 (looking-at "\r"))))
-
-;;;###autoload
-(defun dired-hide-subdir (arg)
-  "Hide or unhide the current subdirectory and move to next directory.
-Optional prefix arg is a repeat factor.
-Use \\[dired-hide-all] to (un)hide all directories."
-  (interactive "p")
-  (dired-hide-check)
-  (while (>=  (setq arg (1- arg)) 0)
-    (let* ((cur-dir (dired-current-directory))
-	   (hidden-p (dired-subdir-hidden-p cur-dir))
-	   (elt (assoc cur-dir dired-subdir-alist))
-	   (end-pos (1- (dired-get-subdir-max elt)))
-	   buffer-read-only)
-      ;; keep header line visible, hide rest
-      (goto-char (dired-get-subdir-min elt))
-      (skip-chars-forward "^\n\r")
-      (if hidden-p
-	  (subst-char-in-region (point) end-pos ?\r ?\n)
-	(subst-char-in-region (point) end-pos ?\n ?\r)))
-    (dired-next-subdir 1 t)))
-
-;;;###autoload
-(defun dired-hide-all (arg)
-  "Hide all subdirectories, leaving only their header lines.
-If there is already something hidden, make everything visible again.
-Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
-  (interactive "P")
-  (dired-hide-check)
-  (let (buffer-read-only)
-    (if (save-excursion
-	  (goto-char (point-min))
-	  (search-forward "\r" nil t))
-	;; unhide - bombs on \r in filenames
-	(subst-char-in-region (point-min) (point-max) ?\r ?\n)
-      ;; hide
-      (let ((pos (point-max))		; pos of end of last directory
-	    (alist dired-subdir-alist))
-	(while alist			; while there are dirs before pos
-	  (subst-char-in-region (dired-get-subdir-min (car alist)) ; pos of prev dir
-				(save-excursion
-				  (goto-char pos) ; current dir
-				  ;; we're somewhere on current dir's line
-				  (forward-line -1)
-				  (point))
-				?\n ?\r)
-	  (setq pos (dired-get-subdir-min (car alist)))	; prev dir gets current dir
-	  (setq alist (cdr alist)))))))
-
-;;;###end dired-ins.el
-
-
-;; Functions for searching in tags style among marked files.
-
-;;;###autoload
-(defun dired-do-search (regexp)
-  "Search through all marked files for a match for REGEXP.
-Stops when a match is found.
-To continue searching for next match, use command \\[tags-loop-continue]."
-  (interactive "sSearch marked files (regexp): ")
-  (tags-search regexp '(dired-get-marked-files)))
-
-;;;###autoload
-(defun dired-do-query-replace (from to &optional delimited)
-  "Do `query-replace-regexp' of FROM with TO, on all marked files.
-Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
-If you exit (\\[keyboard-quit] or ESC), you can resume the query replace
-with the command \\[tags-loop-continue]."
-  (interactive
-   "sQuery replace in marked files (regexp): \nsQuery replace %s by: \nP")
-  (tags-query-replace from to delimited '(dired-get-marked-files)))
-
-
-(provide 'dired-aux)
-
-;;; dired-aux.el ends here
diff --git a/lisp/dired-x.el b/lisp/dired-x.el
deleted file mode 100644
index a45c9ad52df..00000000000
--- a/lisp/dired-x.el
+++ /dev/null
@@ -1,1698 +0,0 @@
-;;; dired-x.el --- Sebastian Kremer's Extra DIRED hacked up for GNU Emacs19
-
-;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
-;;	Lawrence R. Dodd <dodd@roebling.poly.edu>
-;; Maintainer: Lawrence R. Dodd <dodd@roebling.poly.edu>
-;; Version: 2.37+
-;; Date: 1994/08/18 19:27:42
-;; Keywords: dired extensions
-
-;; Copyright (C) 1993, 1994 Free Software Foundation
-
-;; 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 is Sebastian Kremer's excellent dired-x.el (Dired Extra), version
-;; 1.191, hacked up for GNU Emacs 19.  Redundant or conflicting material
-;; has been removed or renamed in order to work properly with dired of
-;; GNU Emacs 19.  All suggestions or comments are most welcomed.
-
-;;  
-;; Please, PLEASE, *PLEASE* see the info pages.
-;; 
-
-;; BUGS: Type M-x dired-x-submit-report and a report will be generated.
-
-;; INSTALLATION: In your ~/.emacs,
-;;
-;; (add-hook 'dired-load-hook
-;;           (function (lambda ()
-;;                       (load "dired-x")
-;;                       ;; Set global variables here.  For example:
-;;                       ;; (setq dired-guess-shell-gnutar "gtar")
-;;                       )))
-;; (add-hook 'dired-mode-hook
-;;           (function (lambda ()
-;;                       ;; Set buffer-local variables here.  For example:
-;;                       ;; (setq dired-omit-files-p t)
-;;                       )))
-;;
-;; At load time dired-x.el will install itself, redefine some functions, and
-;; bind some dired keys.  *Please* see the info pages for more details.
-
-;; CAUTION: If you are using a version of GNU Emacs earlier than 19.20 than
-;; you may have to edit dired.el.  The copy of dired.el in GNU Emacs versions
-;; earlier than 19.20 incorrectly had the call to run-hooks *before* the call
-;; to provide.  In such a case, it is possible that byte-compiling and/or
-;; loading dired can cause an infinite loop.  To prevent this, make sure the
-;; line of code
-;;  
-;;         (run-hooks 'dired-load-hook) 
-;;  
-;; is the *last* executable line in the file dired.el.  That is, make sure it
-;; comes *after* the line
-;;  
-;;         (provide 'dired) 
-;; 
-;; *Please* see the info pages for more details. 
-
-;; User defined variables:
-;;
-;;      dired-bind-vm
-;;      dired-vm-read-only-folders
-;;      dired-bind-jump
-;;      dired-bind-info
-;;      dired-bind-man
-;;      dired-x-hands-off-my-keys 
-;;      dired-find-subdir
-;;      dired-enable-local-variables
-;;      dired-local-variables-file
-;;      dired-guess-shell-gnutar
-;;      dired-guess-shell-gzip-quiet
-;;      dired-guess-shell-znew-switches
-;;      dired-guess-shell-alist-user
-;;      dired-clean-up-buffers-too
-;;      dired-omit-files-p
-;;      dired-omit-files
-;;      dired-omit-extensions
-;;      dired-omit-size-limit
-;;
-;; To find out more about these variables, load this file, put your cursor at
-;; the end of any of the variable names, and hit C-h v [RET].  *Please* see
-;; the info pages for more details.
-
-;; When loaded this code redefines the following functions of GNU Emacs
-;;
-;;   Function                         Found in this file of GNU Emacs
-;;   --------                         -------------------------------
-;;   dired-clean-up-after-deletion    ../lisp/dired.el
-;;   dired-find-buffer-nocreate       ../lisp/dired.el
-;;   dired-initial-position           ../lisp/dired.el
-;;
-;;   dired-add-entry                  ../lisp/dired-aux.el
-;;   dired-read-shell-command         ../lisp/dired-aux.el
-;;
-;; One drawback is that dired-x.el will load dired-aux.el as soon as dired is
-;; loaded.  Thus, the advantage of separating out non-essential dired stuff
-;; into dired-aux.el and only loading when necessary will be lost.  Please
-;; note also that some of the comments in dired.el and dired-aux.el are
-;; Kremer's that referred to the old dired-x.el.  This now should be referring
-;; to this program.  (This is also a good reason to call this dired-x.el
-;; instead of dired-x19.el.)
-
-
-;;; Code:
-
-;; LOAD.
-
-;; This is a no-op if dired-x is being loaded via `dired-load-hook'.  It is
-;; here in case the user has autoloaded dired-x via the dired-jump key binding
-;; (instead of autoloading to dired as is suggested in the info-pages).
-
-(require 'dired)
-
-;; We will redefine some functions and also need some macros so we need to
-;; load dired stuff of GNU Emacs.
-
-(require 'dired-aux)
-
-;;; User-defined variables.
-
-(defvar dired-bind-vm nil
-  "*t says \"V\" in dired-mode will `dired-vm', otherwise \"V\" is `dired-rmail'.
-Also, RMAIL files contain -*- rmail -*- at the top so \"f\",
-`dired-advertised-find-file', will run rmail.")
-
-(defvar dired-bind-jump t
-  "*t says bind `dired-jump' to C-x C-j, otherwise do not.")
-
-(defvar dired-bind-man t
-  "*t says bind `dired-man' to \"N\" in dired-mode, otherwise do not.")
-
-(defvar dired-bind-info t
-  "*t says bind `dired-info' to \"I\" in dired-mode, otherwise do not.")
-
-(defvar dired-vm-read-only-folders nil
-  "*If t, \\[dired-vm] will visit all folders read-only.
-If neither nil nor t, e.g. the symbol `if-file-read-only', only
-files not writable by you are visited read-only.
-
-Read-only folders only work in VM 5, not in VM 4.")
-
-(defvar dired-omit-files-p nil
-  "*If non-nil, \"uninteresting\" files are not listed (buffer-local).
-Use \\[dired-omit-toggle] to toggle its value.
-Uninteresting files are those whose filenames match regexp `dired-omit-files',
-plus those ending with extensions in `dired-omit-extensions'.")
-(make-variable-buffer-local 'dired-omit-files-p)
-
-(defvar dired-omit-files "^#\\|^\\.$\\|^\\.\\.$"
-  "*Filenames matching this regexp will not be displayed.
-This only has effect when `dired-omit-files-p' is t.  See interactive function
-`dired-omit-toggle' \(\\[dired-omit-toggle]\) and variable
-`dired-omit-extensions'.  The default is to omit  `.', `..', and auto-save
-files.")
-
-(defvar dired-omit-size-limit 20000
-  "*If a dired buffer listing contains more than this many characters,
-do not do omitting.  If nil, always do omitting.")
-
-(defvar dired-find-subdir nil           ; t is pretty near to DWIM...
-  "*If non-nil, Dired always finds a directory in a buffer of its own.
-If nil, Dired finds the directory as a subdirectory in some other buffer
-if it is present as one.
-
-If there are several Dired buffers for a directory, the most recently
-used is chosen.
-
-Dired avoids switching to the current buffer, so that if you have
-a normal and a wildcard buffer for the same directory, C-x d RET will
-toggle between those two.")
-
-(defvar dired-enable-local-variables t
-  "*Control use of local-variables lists in dired.
-The value can be t, nil or something else.
-A value of t means local-variables lists are obeyed;
-nil means they are ignored; anything else means query.
-
-This temporarily overrides the value of `enable-local-variables' when listing
-a directory.  See also `dired-local-variables-file'.")
-
-(defvar dired-guess-shell-gnutar nil
-  "*If non-nil, name of GNU tar executable (e.g., \"tar\" or \"gtar\") and `z'
-switch will be used for compressed or gzip'ed tar files.  If no GNU tar, set
-to nil: a pipe using `zcat' or `gunzip -c' will be used.")
-
-(defvar dired-guess-shell-gzip-quiet t
-  "*non-nil says pass -q to gzip overriding verbose GZIP environment.")
-
-(defvar dired-guess-shell-znew-switches nil
-  "*If non-nil, then string of switches passed to `znew', example: \"-K\"")
-
-(defvar dired-clean-up-buffers-too t
-  "*t says offer to kill buffers visiting files and dirs deleted in dired.")
-
-;;; KEY BINDINGS.
-
-(define-key dired-mode-map "\M-o" 'dired-omit-toggle)
-(define-key dired-mode-map "\M-(" 'dired-mark-sexp)
-(define-key dired-mode-map "*(" 'dired-mark-sexp)
-(define-key dired-mode-map "*." 'dired-mark-extension)
-(define-key dired-mode-map "\M-!" 'dired-smart-shell-command)
-(define-key dired-mode-map "T" 'dired-do-toggle)
-(define-key dired-mode-map "*t" 'dired-do-toggle)
-(define-key dired-mode-map "w" 'dired-copy-filename-as-kill)
-(define-key dired-mode-map "\M-g" 'dired-goto-file)
-(define-key dired-mode-map "\M-G" 'dired-goto-subdir)
-(define-key dired-mode-map "F" 'dired-do-find-marked-files)
-(define-key dired-mode-map "Y"  'dired-do-relsymlink)
-(define-key dired-mode-map "%Y" 'dired-do-relsymlink-regexp)
-(define-key dired-mode-map "V" 'dired-do-run-mail)
-
-(if dired-bind-man
-    (define-key dired-mode-map "N" 'dired-man))
-
-(if dired-bind-info
-    (define-key dired-mode-map "I" 'dired-info))
-
-;;; GLOBAL BINDING.
-(if dired-bind-jump
-    (progn
-      (define-key global-map "\C-x\C-j" 'dired-jump)
-      (define-key global-map "\C-x4\C-j" 'dired-jump-other-window)))
-
-
-;;; Install into appropriate hooks.
-
-(add-hook 'dired-mode-hook 'dired-extra-startup)
-(add-hook 'dired-after-readin-hook 'dired-omit-expunge)
-
-(defun dired-extra-startup ()
-  "Automatically put on dired-mode-hook to get extra dired features:
-\\<dired-mode-map>
-
-  \\[dired-do-run-mail]\t-- run mail on folder (see `dired-bind-vm')
-  \\[dired-info]\t-- run info on file
-  \\[dired-man]\t-- run man on file
-  \\[dired-do-find-marked-files]\t-- visit all marked files simultaneously
-  \\[dired-omit-toggle]\t-- toggle omitting of files
-  \\[dired-do-toggle]\t-- toggle marks
-  \\[dired-mark-sexp]\t-- mark by lisp expression
-  \\[dired-copy-filename-as-kill]\t-- copy the file or subdir names into the kill ring.
-  \t   You can feed it to other commands using \\[yank].
-
-For more features, see variables
-
-  dired-bind-vm
-  dired-bind-jump
-  dired-bind-info
-  dired-bind-man
-  dired-vm-read-only-folders
-  dired-omit-files-p
-  dired-omit-files
-  dired-omit-extensions
-  dired-omit-size-limit
-  dired-find-subdir
-  dired-enable-local-variables
-  dired-local-variables-file
-  dired-guess-shell-gnutar
-  dired-guess-shell-gzip-quiet
-  dired-guess-shell-znew-switches
-  dired-guess-shell-alist-user
-  dired-clean-up-buffers-too
-
-See also functions
-
-  dired-flag-extension
-  dired-virtual
-  dired-jump
-  dired-man
-  dired-vm
-  dired-rmail
-  dired-info
-  dired-do-find-marked-files
-"
-  (interactive)
-
-  ;; These must be done in each new dired buffer.
-  (dired-hack-local-variables)
-  (dired-omit-startup))
-
-
-;;; BUFFER CLEANING.
-
-;; REDEFINE.
-(defun dired-clean-up-after-deletion (fn)
-
-  ;; Clean up after a deleted file or directory FN.
-  ;; Remove expanded subdir of deleted dir, if any.
-  (save-excursion (and (cdr dired-subdir-alist)
-                       (dired-goto-subdir fn)
-                       (dired-kill-subdir)))
-
-  ;; Offer to kill buffer of deleted file FN.
-  (if dired-clean-up-buffers-too
-      (progn
-        (let ((buf (get-file-buffer fn)))
-          (and buf
-               (funcall (function y-or-n-p)
-                        (format "Kill buffer of %s, too? "
-                                (file-name-nondirectory fn)))
-               (save-excursion ; you never know where kill-buffer leaves you
-                 (kill-buffer buf))))
-        (let ((buf-list (dired-buffers-for-dir (expand-file-name fn)))
-              (buf nil))
-          (and buf-list
-               (y-or-n-p (format "Kill dired buffer%s of %s, too? "
-                                 (dired-plural-s (length buf-list))
-                                 (file-name-nondirectory fn)))
-               (while buf-list
-                 (save-excursion (kill-buffer (car buf-list)))
-                 (setq buf-list (cdr buf-list)))))))
-  ;; Anything else?
-  )
-
-
-;;; EXTENSION MARKING FUNCTIONS.
-
-;;; Mark files with some extension.
-(defun dired-mark-extension (extension &optional marker-char)
-  "Mark all files with a certain extension for use in later commands.
-A `.' is not automatically prepended to the string entered."
-  ;; EXTENSION may also be a list of extensions instead of a single one.
-  ;; Optional MARKER-CHAR is marker to use.
-  (interactive "sMarking extension: \nP")
-  (or (listp extension)
-      (setq extension (list extension)))
-  (dired-mark-files-regexp
-   (concat ".";; don't match names with nothing but an extension
-           "\\("
-           (mapconcat 'regexp-quote extension "\\|")
-           "\\)$")
-   marker-char))
-
-(defun dired-flag-extension (extension)
-  "In dired, flag all files with a certain extension for deletion.
-A `.' is *not* automatically prepended to the string entered."
-  (interactive "sFlagging extension: ")
-  (dired-mark-extension extension dired-del-marker))
-
-;;; Define some unpopular file extensions.  Used for cleaning and omitting.
-
-(defvar dired-patch-unclean-extensions
-  '(".rej" ".orig")
-  "List of extensions of dispensable files created by the `patch' program.")
-
-(defvar dired-tex-unclean-extensions
-  '(".toc" ".log" ".aux");; these are already in completion-ignored-extensions
-  "List of extensions of dispensable files created by TeX.")
-
-(defvar dired-latex-unclean-extensions
-  '(".idx" ".lof" ".lot" ".glo")
-  "List of extensions of dispensable files created by LaTeX.")
-
-(defvar dired-bibtex-unclean-extensions
-  '(".blg" ".bbl")
-  "List of extensions of dispensable files created by BibTeX.")
-
-(defvar dired-texinfo-unclean-extensions
-  '(".cp" ".cps" ".fn" ".fns" ".ky" ".kys" ".pg" ".pgs"
-    ".tp" ".tps" ".vr" ".vrs")
-  "List of extensions of dispensable files created by texinfo.")
-
-(defun dired-clean-patch ()
-  "Flag dispensable files created by patch for deletion.
-See variable `dired-patch-unclean-extensions'."
-  (interactive)
-  (dired-flag-extension dired-patch-unclean-extensions))
-
-(defun dired-clean-tex ()
-  "Flag dispensable files created by [La]TeX etc. for deletion.
-See variables `dired-texinfo-unclean-extensions',
-`dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions' and
-`dired-texinfo-unclean-extensions'."
-  (interactive)
-  (dired-flag-extension (append dired-texinfo-unclean-extensions
-                                dired-latex-unclean-extensions
-                                dired-bibtex-unclean-extensions
-                                dired-tex-unclean-extensions)))
-
-(defun dired-very-clean-tex ()
-  "Flag dispensable files created by [La]TeX *and* \".dvi\" for deletion.
-See variables `dired-texinfo-unclean-extensions',
-`dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions' and
-`dired-texinfo-unclean-extensions'."
-  (interactive)
-  (dired-flag-extension (append dired-texinfo-unclean-extensions
-                                dired-latex-unclean-extensions
-                                dired-bibtex-unclean-extensions
-                                dired-tex-unclean-extensions
-                                (list ".dvi"))))
-
-;;; JUMP.
-
-;;;###autoload
-(defun dired-jump (&optional other-window)
-  "Jump to dired buffer corresponding to current buffer.
-If in a file, dired the current directory and move to file's line.
-If in dired already, pop up a level and goto old directory's line.
-In case the proper dired file line cannot be found, refresh the dired
-buffer and try again."
-  (interactive "P")
-  (let* ((file buffer-file-name)
-         (dir (if file (file-name-directory file) default-directory)))
-    (if (eq major-mode 'dired-mode)
-        (progn
-          (setq dir (dired-current-directory))
-          (dired-up-directory other-window)
-          (or (dired-goto-file dir)
-              ;; refresh and try again
-              (progn
-                (dired-insert-subdir (file-name-directory dir))
-                (dired-goto-file dir))))
-      (if other-window
-          (dired-other-window dir)
-        (dired dir))
-      (if file
-          (or (dired-goto-file file)
-              ;; refresh and try again
-              (progn
-                (dired-insert-subdir (file-name-directory file))
-                (dired-goto-file file))
-              ;; Toggle omitting, if it is on, and try again.
-	      (if dired-omit-files-p
-		  (progn
-		    (dired-omit-toggle)
-		    (dired-goto-file file))))))))
-
-(defun dired-jump-other-window ()
-  "Like \\[dired-jump] (dired-jump) but in other window."
-  (interactive)
-  (dired-jump t))
-
-;;; TOGGLE.
-;;; Toggle marked files with unmarked files.
-
-(defun dired-do-toggle ()
-  "Toggle marks.
-That is, currently marked files become unmarked and vice versa.
-Files marked with other flags (such as `D') are not affected.
-`.' and `..' are never toggled.
-As always, hidden subdirs are not affected."
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (let (buffer-read-only)
-      (while (not (eobp))
-        (or (dired-between-files)
-            (looking-at dired-re-dot)
-            ;; use subst instead of insdel because it does not move
-            ;; the gap and thus should be faster and because
-            ;; other characters are left alone automatically
-            (apply 'subst-char-in-region
-                   (point) (1+ (point))
-                   (if (eq ?\040 (following-char)) ; SPC
-                       (list ?\040 dired-marker-char)
-                     (list dired-marker-char ?\040))))
-        (forward-line 1)))))
-
-
-;;; COPY NAMES OF MARKED FILES INTO KILL-RING.
-
-(defun dired-copy-filename-as-kill (&optional arg)
-  "Copy names of marked (or next ARG) files into the kill ring.
-The names are separated by a space.
-With a zero prefix arg, use the complete pathname of each marked file.
-With \\[universal-argument], use the relative pathname of each marked file.
-
-If on a subdir headerline, use subdirname instead; prefix arg is ignored
-in this case.
-
-You can then feed the file name(s) to other commands with \\[yank]."
-  (interactive "P")
-  (let ((string
-         (or (dired-get-subdir)
-             (mapconcat (function identity)
-                        (if arg
-                            (cond ((zerop (prefix-numeric-value arg))
-                                   (dired-get-marked-files))
-                                  ((integerp arg)
-                                   (dired-get-marked-files 'no-dir arg))
-                                  (t    ; else a raw arg
-                                   (dired-get-marked-files t)))
-                          (dired-get-marked-files 'no-dir))
-                        " "))))
-    (kill-new string)
-    (message "%s" string)))
-
-
-;;; OMITTING.
-
-;;; Enhanced omitting of lines from directory listings.
-;;; Marked files are never omitted.
-
-;; should probably get rid of this and always use 'no-dir.
-;; sk 28-Aug-1991 09:37
-(defvar dired-omit-localp 'no-dir
-  "The LOCALP argument dired-omit-expunge passes to dired-get-filename.
-If it is 'no-dir, omitting is much faster, but you can only match
-against the basename of the file.  Set it to nil if you need to match the
-whole pathname.")
-
-;; \017=^O for Omit - other packages can chose other control characters.
-(defvar dired-omit-marker-char ?\017
-  "Temporary marker used by by dired-omit.
-Should never be used as marker by the user or other packages.")
-
-(defun dired-omit-startup ()
-  (or (assq 'dired-omit-files-p minor-mode-alist)
-      (setq minor-mode-alist
-            (append '((dired-omit-files-p " Omit")) minor-mode-alist))))
-
-(defun dired-omit-toggle (&optional flag)
-  "Toggle omitting files matching `dired-omit-files' and `dired-omit-extensions'.
-With an arg, and if omitting was off, don't toggle and just mark the
-  files but don't actually omit them.
-With an arg, and if omitting was on, turn it off but don't refresh the buffer."
-  (interactive "P")
-  (if flag
-      (if dired-omit-files-p
-          (setq dired-omit-files-p (not dired-omit-files-p))
-        (dired-mark-unmarked-files (dired-omit-regexp) nil nil
-                                   dired-omit-localp))
-    ;; no FLAG
-    (setq dired-omit-files-p (not dired-omit-files-p))
-    (if (not dired-omit-files-p)
-        (revert-buffer)
-      ;; this will mention how many were omitted:
-      (let ((dired-omit-size-limit nil))
-        (dired-omit-expunge)))))
-
-(defvar dired-omit-extensions
-  (append completion-ignored-extensions
-          dired-latex-unclean-extensions
-          dired-bibtex-unclean-extensions
-          dired-texinfo-unclean-extensions)
-  "If non-nil, a list of extensions \(strings\) to omit from Dired listings.  
-Defaults to elements of `completion-ignored-extensions',
-`dired-latex-unclean-extensions', `dired-bibtex-unclean-extensions', and
-`dired-texinfo-unclean-extensions'.  
-
-See interactive function `dired-omit-toggle' \(\\[dired-omit-toggle]\) and
-variables `dired-omit-files-p' and `dired-omit-files'.")
-
-(defun dired-omit-expunge (&optional regexp)
-  "Erases all unmarked files matching REGEXP.
-Does nothing if global variable `dired-omit-files-p' is nil, or if called
-  non-interactively and buffer is bigger than `dired-omit-size-limit'.
-If REGEXP is nil or not specified, uses `dired-omit-files', and also omits
-  filenames ending in `dired-omit-extensions'.
-If REGEXP is the empty string, this function is a no-op.
-
-This functions works by temporarily binding `dired-marker-char' to
-`dired-omit-marker-char' and calling `dired-do-kill-lines'."
-  (interactive "sOmit files (regexp): ")
-  (if (and dired-omit-files-p
-           (or (interactive-p)
-               (not dired-omit-size-limit)
-               (< (buffer-size) dired-omit-size-limit)))
-      (let ((omit-re (or regexp (dired-omit-regexp)))
-            (old-modified-p (buffer-modified-p))
-            count)
-        (or (string= omit-re "")
-            (let ((dired-marker-char dired-omit-marker-char))
-              (message "Omitting...")
-              (if (dired-mark-unmarked-files omit-re nil nil dired-omit-localp)
-                  (progn
-                    (setq count (dired-do-kill-lines nil "Omitted %d line%s."))
-                    (force-mode-line-update))
-                (message "(Nothing to omit)"))))
-        ;; Try to preserve modified state of buffer.  So `%*' doesn't appear
-        ;; in mode-line of omitted buffers.
-        (set-buffer-modified-p (and old-modified-p 
-                                    (save-excursion
-                                      (goto-char (point-min))
-                                      (re-search-forward dired-re-mark nil t))))
-        count)))
-
-(defun dired-omit-regexp ()
-  (concat (if dired-omit-files (concat "\\(" dired-omit-files "\\)") "")
-          (if (and dired-omit-files dired-omit-extensions) "\\|" "")
-          (if dired-omit-extensions
-              (concat ".";; a non-extension part should exist
-                      "\\("
-                      (mapconcat 'regexp-quote dired-omit-extensions "\\|")
-                      "\\)$")
-            "")))
-
-;; Returns t if any work was done, nil otherwise.
-(defun dired-mark-unmarked-files (regexp msg &optional unflag-p localp)
-  "Marks unmarked files matching REGEXP, displaying MSG.
-REGEXP is matched against the complete pathname.
-Does not re-mark files which already have a mark.
-With prefix argument, unflag all those files.
-Second optional argument LOCALP is as in `dired-get-filename'."
-  (interactive "P")
-  (let ((dired-marker-char (if unflag-p ?\  dired-marker-char)))
-    (dired-mark-if
-     (and
-      ;; not already marked
-      (looking-at " ")
-      ;; uninteresting
-      (let ((fn (dired-get-filename localp t)))
-        (and fn (string-match regexp fn))))
-     msg)))
-
-;;; REDEFINE.
-(defun dired-omit-new-add-entry (filename &optional marker-char)
-  ;; This redefines dired-aux.el's dired-add-entry to avoid calling ls for
-  ;; files that are going to be omitted anyway.
-  (if dired-omit-files-p
-      ;; perhaps return t without calling ls
-      (let ((omit-re (dired-omit-regexp)))
-        (if (or (string= omit-re "")
-                (not
-                 (string-match omit-re
-                               (cond
-                                ((eq 'no-dir dired-omit-localp)
-                                 filename)
-                                ((eq t dired-omit-localp)
-                                 (dired-make-relative filename))
-                                (t
-                                 (dired-make-absolute
-                                  filename
-                                  (file-name-directory filename)))))))
-            ;; if it didn't match, go ahead and add the entry
-            (dired-omit-old-add-entry filename marker-char)
-          ;; dired-add-entry returns t for success, perhaps we should
-          ;; return file-exists-p
-          t))
-    ;; omitting is not turned on at all
-    (dired-omit-old-add-entry filename marker-char)))
-
-;;; REDEFINE.
-;;; Redefine dired-aux.el's version of `dired-add-entry'
-;;; Save old defun if not already done:
-(or (fboundp 'dired-omit-old-add-entry)
-    (fset 'dired-omit-old-add-entry (symbol-function 'dired-add-entry)))
-;; Redefine it.
-(fset 'dired-add-entry 'dired-omit-new-add-entry)
-
-
-;;; VIRTUAL DIRED MODE.
-
-;;; For browsing `ls -lR' listings in a dired-like fashion.
-
-(fset 'virtual-dired 'dired-virtual)
-(defun dired-virtual (dirname &optional switches)
-  "Put this buffer into Virtual Dired mode.
-
-In Virtual Dired mode, all commands that do not actually consult the
-filesystem will work.
-
-This is useful if you want to peruse and move around in an ls -lR
-output file, for example one you got from an ftp server.  With
-ange-ftp, you can even dired a directory containing an ls-lR file,
-visit that file and turn on virtual dired mode.  But don't try to save
-this file, as dired-virtual indents the listing and thus changes the
-buffer.
-
-If you have save a Dired buffer in a file you can use \\[dired-virtual] to
-resume it in a later session.
-
-Type \\<dired-mode-map>\\[revert-buffer] in the
-Virtual Dired buffer and answer `y' to convert the virtual to a real
-dired buffer again.  You don't have to do this, though: you can relist
-single subdirs using \\[dired-do-redisplay].
-"
-
-  ;; DIRNAME is the top level directory of the buffer.  It will become
-  ;; its `default-directory'.  If nil, the old value of
-  ;; default-directory is used.
-
-  ;; Optional SWITCHES are the ls switches to use.
-
-  ;; Shell wildcards will be used if there already is a `wildcard'
-  ;; line in the buffer (thus it is a saved Dired buffer), but there
-  ;; is no other way to get wildcards.  Insert a `wildcard' line by
-  ;; hand if you want them.
-
-  (interactive
-   (list (read-string "Virtual Dired directory: " (dired-virtual-guess-dir))))
-  (goto-char (point-min))
-  (or (looking-at "  ")
-      ;; if not already indented, do it now:
-      (indent-region (point-min) (point-max) 2))
-  (or dirname (setq dirname default-directory))
-  (setq dirname (expand-file-name (file-name-as-directory dirname)))
-  (setq default-directory dirname)      ; contains no wildcards
-  (let ((wildcard (save-excursion
-                    (goto-char (point-min))
-                    (forward-line 1)
-                    (and (looking-at "^  wildcard ")
-                         (buffer-substring (match-end 0)
-                                           (progn (end-of-line) (point)))))))
-  (if wildcard
-        (setq dirname (expand-file-name wildcard default-directory))))
-  ;; If raw ls listing (not a saved old dired buffer), give it a
-  ;; decent subdir headerline:
-  (goto-char (point-min))
-  (or (looking-at dired-subdir-regexp)
-      (dired-insert-headerline default-directory))
-  (dired-mode dirname (or switches dired-listing-switches))
-  (setq mode-name "Virtual Dired"
-        revert-buffer-function 'dired-virtual-revert)
-  (set (make-local-variable 'dired-subdir-alist) nil)
-  (dired-build-subdir-alist)
-  (goto-char (point-min))
-  (dired-initial-position dirname))
-
-(defun dired-virtual-guess-dir ()
-
-  ;; Guess and return appropriate working directory of this buffer,
-  ;; assumed to be in Dired or ls -lR format.
-  ;; The guess is based upon buffer contents.
-  ;; If nothing could be guessed, returns nil.
-
-  (let ((regexp "^\\(  \\)?\\([^ \n\r]*\\)\\(:\\)[\n\r]")
-        (subexpr 2))
-    (goto-char (point-min))
-    (cond ((looking-at regexp)
-           ;; If a saved dired buffer, look to which dir and
-           ;; perhaps wildcard it belongs:
-           (let ((dir (buffer-substring (match-beginning subexpr)
-                                        (match-end subexpr))))
-             (file-name-as-directory dir)))
-          ;; Else no match for headerline found.  It's a raw ls listing.
-          ;; In raw ls listings the directory does not have a headerline
-          ;; try parent of first subdir, if any
-          ((re-search-forward regexp nil t)
-           (file-name-directory
-            (directory-file-name
-             (file-name-as-directory
-              (buffer-substring (match-beginning subexpr)
-                                (match-end subexpr))))))
-          (t                            ; if all else fails
-           nil))))
-
-
-(defun dired-virtual-revert (&optional arg noconfirm)
-  (if (not
-       (y-or-n-p "Cannot revert a Virtual Dired buffer - switch to Real Dired mode? "))
-      (error "Cannot revert a Virtual Dired buffer.")
-    (setq mode-name "Dired"
-          revert-buffer-function 'dired-revert)
-    (revert-buffer)))
-
-;; A zero-arg version of dired-virtual.
-;; You need my modified version of set-auto-mode for the
-;; `buffer-contents-mode-alist'.
-;; Or you use infer-mode.el and infer-mode-alist, same syntax.
-(defun dired-virtual-mode ()
-  "Put current buffer into virtual dired mode (see `dired-virtual').
-Useful on `buffer-contents-mode-alist' (which see) with the regexp
-
-    \"^  \\(/[^ /]+\\)/?+:$\"
-
-to put saved dired buffers automatically into virtual dired mode.
-
-Also useful for `auto-mode-alist' (which see) like this:
-
-  \(setq auto-mode-alist (cons '(\"[^/]\\.dired\\'\" . dired-virtual-mode)
-                              auto-mode-alist)\)"
-  (interactive)
-  (dired-virtual (dired-virtual-guess-dir)))
-
-
-;;; SMART SHELL.
-
-;;; An Emacs buffer can have but one working directory, stored in the
-;;; buffer-local variable `default-directory'.  A Dired buffer may have
-;;; several subdirectories inserted, but still has but one working directory:
-;;; that of the top level Dired directory in that buffer.  For some commands
-;;; it is appropriate that they use the current Dired directory instead of
-;;; `default-directory', e.g., `find-file' and `compile'.  This is a general
-;;; mechanism is provided for special handling of the working directory in
-;;; special major modes.
-
-;; It's easier to add to this alist than redefine function
-;; default-directory while keeping the old information.
-(defconst default-directory-alist
-  '((dired-mode . (if (fboundp 'dired-current-directory)
-                      (dired-current-directory)
-                    default-directory)))
-  "Alist of major modes and their opinion on default-directory, as a
-lisp expression to evaluate.  A resulting value of nil is ignored in
-favor of default-directory.")
-
-(defun default-directory ()
-  "Usage like variable `default-directory', but knows about the special
-cases in variable `default-directory-alist' (which see)."
-  (or (eval (cdr (assq major-mode default-directory-alist)))
-      default-directory))
-
-(defun dired-smart-shell-command (cmd &optional insert)
-  "Like function `shell-command', but in the current Tree Dired directory."
-  (interactive "sShell command: \nP")
-  (let ((default-directory (default-directory)))
-    (shell-command cmd insert)))
-
-
-;;; LOCAL VARIABLES FOR DIRED BUFFERS.
-
-;;; Brief Description:
-;;;
-;;; * `dired-extra-startup' is part of the `dired-mode-hook'.
-;;;
-;;; * `dired-extra-startup' calls `dired-hack-local-variables'
-;;;
-;;; * `dired-hack-local-variables' checks the value of
-;;;   `dired-local-variables-file'
-;;;
-;;; * Check if `dired-local-variables-file' is a non-nil string and is a
-;;;   filename found in the directory of the Dired Buffer being created.
-;;;
-;;; * If `dired-local-variables-file' satisfies the above, then temporarily
-;;;   include it in the Dired Buffer at the bottom.
-;;;
-;;; * Set `enable-local-variables' temporarily to the user variable
-;;;   `dired-enable-local-variables' and run `hack-local-variables' on the
-;;;   Dired Buffer.
-
-(defvar dired-local-variables-file (convert-standard-filename ".dired")
-  "Filename, as string, containing local dired buffer variables to be hacked.
-If this file found in current directory, then it will be inserted into dired
-buffer and `hack-local-variables' will be run.  See Emacs Info pages for more
-information on local variables.  See also `dired-enable-local-variables'.")
-
-(defun dired-hack-local-variables ()
-  "Evaluate local variables in `dired-local-variables-file' for dired buffer."
-  (if (and dired-local-variables-file
-           (stringp dired-local-variables-file)
-           (file-exists-p dired-local-variables-file))
-      (let ((opoint (point-max))
-            buffer-read-only
-            ;; In case user has `enable-local-variables' set to nil we
-            ;; override it locally with dired's variable.
-            (enable-local-variables dired-enable-local-variables))
-        ;; Insert 'em.
-        (save-excursion
-          (goto-char opoint)
-          (insert "\^L\n")
-          (insert-file-contents dired-local-variables-file))
-        ;; Hack 'em.
-        (let ((buffer-file-name dired-local-variables-file))
-          (hack-local-variables))
-        ;; Make sure that the modeline shows the proper information.
-        (dired-sort-set-modeline)
-        ;; Delete this stuff: `eobp' is used to find last subdir by dired.el.
-        (delete-region opoint (point-max)))))
-
-(defun dired-omit-here-always ()
-  "Creates `dired-local-variables-file' for omitting and reverts directory.
-Sets dired-omit-file-p to t in a local variables file that is readable by
-dired."
-  (interactive)
-  (if (file-exists-p dired-local-variables-file)
-      (message "File `./%s' already exists." dired-local-variables-file)
-
-    ;; Create `dired-local-variables-file'.
-    (save-excursion
-      (set-buffer (get-buffer-create " *dot-dired*"))
-      (erase-buffer)
-      (insert "Local Variables:\ndired-omit-files-p: t\nEnd:\n")
-      (write-file dired-local-variables-file)
-      (kill-buffer (current-buffer)))
-
-    ;; Run extra-hooks and revert directory.
-    (dired-extra-startup)
-    (dired-revert)))
-
-
-;;; GUESS SHELL COMMAND.
-
-;;; Brief Description:
-;;;
-;;; `dired-do-shell-command' is bound to `!' by dired.el.
-;;;
-;;; * Redefine `dired-do-shell-command' so it calls
-;;;   `dired-guess-shell-command'.
-;;;
-;;; * `dired-guess-shell-command' calls `dired-guess-default' with list of
-;;;    marked files.
-;;;
-;;; * Parse `dired-guess-shell-alist-user' and
-;;;   `dired-guess-shell-alist-default' (in that order) for the first REGEXP
-;;;   that matches the first file in the file list.
-;;;
-;;; * If the REGEXP matches all the entries of the file list then evaluate
-;;;   COMMAND, which is either a string or a Lisp expression returning a
-;;;   string.  COMMAND may be a list of commands.
-;;;
-;;; * Return this command to `dired-guess-shell-command' which prompts user
-;;;   with it.  The list of commands is temporarily put into the history list.
-;;;   If a command is used successfully then it is stored permanently in
-;;;   `dired-shell-command-history'.
-
-;;; Guess what shell command to apply to a file.
-(defvar dired-shell-command-history nil
-  "History list for commands that read dired-shell commands.")
-
-;;; Default list of shell commands.
-
-;;; NOTE: Use `gunzip -c' instead of `zcat' on `.gz' files.  Some do not
-;;; install GNU zip's version of zcat.
-
-(defvar dired-guess-shell-alist-default
-  (list
-   (list "\\.tar$" '(if dired-guess-shell-gnutar
-                        (concat dired-guess-shell-gnutar " xvf")
-                      "tar xvf"))
-
-   ;; REGEXPS for compressed archives must come before the .Z rule to
-   ;; be recognized:
-   (list "\\.tar\\.Z$"
-         ;; Untar it.
-         '(if dired-guess-shell-gnutar
-              (concat dired-guess-shell-gnutar " zxvf")
-            (concat "zcat * | tar xvf -"))
-         ;; Optional conversion to gzip format.
-         '(concat "znew" (if dired-guess-shell-gzip-quiet " -q")
-                  " " dired-guess-shell-znew-switches))
-
-   ;; gzip'ed archives
-   (list "\\.tar\\.g?z$"
-         '(if dired-guess-shell-gnutar
-              (concat dired-guess-shell-gnutar " zxvf")
-            (concat "gunzip -qc * | tar xvf -"))
-         ;; Optional decompression.
-         '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q" "")))
-
-   '("\\.shar.Z$" "zcat * | unshar")
-   '("\\.shar.g?z$" "gunzip -qc * | unshar")
-
-   '("\\.ps$" "ghostview" "xv" "lpr")
-   (list "\\.ps.g?z$" "gunzip -qc * | ghostview -"
-         ;; Optional decompression.
-         '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q")))
-   (list "\\.ps.Z$" "zcat * | ghostview -"
-         ;; Optional conversion to gzip format.
-         '(concat "znew" (if dired-guess-shell-gzip-quiet " -q")
-                  " " dired-guess-shell-znew-switches))
-   '("\\.patch$" "cat * | patch")
-   '("\\.patch.g?z$" "gunzip -qc * | patch")
-   (list "\\.patch.Z$" "zcat * | patch"
-         ;; Optional conversion to gzip format.
-         '(concat "znew" (if dired-guess-shell-gzip-quiet " -q")
-                  " " dired-guess-shell-znew-switches))
-
-   '("\\.dvi$" "xdvi" "dvips")          ; preview and printing
-   '("\\.au$" "play")                   ; play Sun audiofiles
-   '("\\.mpg$" "mpeg_play")
-   '("\\.uu$" "uudecode")               ; for uudecoded files
-   '("\\.hqx$" "mcvert")
-   '("\\.sh$" "sh")                     ; execute shell scripts
-   '("\\.xbm$" "bitmap")                ; view X11 bitmaps
-   '("\\.gp$" "gnuplot")
-   '("\\.p[bgpn]m$" "xv")
-   '("\\.gif$" "xv")                    ; view gif pictures
-   '("\\.tif$" "xv")
-   '("\\.jpg$" "xv")
-   '("\\.fig$" "xfig")                  ; edit fig pictures
-   '("\\.out$" "xgraph")                ; for plotting purposes.
-   '("\\.tex$" "latex" "tex")
-   '("\\.texi\\(nfo\\)?$" "makeinfo" "texi2dvi")
-
-   ;; Some other popular archivers.
-   '("\\.zoo$" "zoo x//")
-   '("\\.zip$" "unzip")
-   '("\\.lzh$" "lharc x")
-   '("\\.arc$" "arc x")
-   '("\\.shar$" "unshar")
-
-   ;; Compression.
-   (list "\\.g?z$" '(concat "gunzip" (if dired-guess-shell-gzip-quiet " -q")))
-   (list "\\.Z$" "uncompress"
-         ;; Optional conversion to gzip format.
-         '(concat "znew" (if dired-guess-shell-gzip-quiet " -q")
-                  " " dired-guess-shell-znew-switches))
-   )
-
-  "Default alist used for shell command guessing.
-See `dired-guess-shell-alist-user'")
-
-(defvar dired-guess-shell-alist-user nil
-  "User-defined alist of rules for suggested commands. These rules take
-precedence over the predefined rules in the variable
-`dired-guess-shell-alist-default' (to which they are prepended).
-
-Each element of this list looks like
-
-    \(REGEXP COMMAND...\)
-
-where each COMMAND can either be a string or a lisp expression that evaluates
-to a string.  If several COMMANDs are given, the first one will be the default
-and the rest will be added temporarily to the history and can be retrieved
-with \\[previous-history-element] (M-p) .
-
-You can set this variable in your ~/.emacs.  For example, to add rules for
-`.foo' and `.bar' files, write
-
- \(setq dired-guess-shell-alist-user
-       (list (list \"\\\\.foo$\" \"FOO-COMMAND\");; fixed rule
-              ;; possibly more rules ...
-              (list \"\\\\.bar$\";; rule with condition test
-                    '(if condition
-                          \"BAR-COMMAND-1\"
-                        \"BAR-COMMAND-2\")))\)
-")
-
-(defun dired-guess-default (files)
-
-  ;; Guess a shell commands for FILES.  Return command or list of commands.
-  ;; See `dired-guess-shell-alist-user'.
-
-  (let* ((case-fold-search nil) ; case-sensitive matching
-         ;; Prepend the user's alist to the default alist.
-         (alist (append dired-guess-shell-alist-user
-                        dired-guess-shell-alist-default))
-         (file (car files))
-         (flist (cdr files))
-         elt regexp cmds)
-
-    ;; Find the first match in the alist for first file in FILES.
-    (while alist
-      (setq elt (car alist)
-            regexp (car elt)
-            alist (cdr alist))
-      (if (string-match regexp file)
-          (setq cmds (cdr elt)
-                alist nil)))
-
-    ;; If more than one file, see if all of FILES match regular expression.
-    (while (and flist
-                (string-match regexp (car flist)))
-      (setq flist (cdr flist)))
-
-    ;; If flist is still non-nil, then do not guess since this means that not
-    ;; all the files in FILES were matched by the regexp.
-    (setq cmds (and (not flist) cmds))
-
-    ;; Return commands or nil if flist is still non-nil.
-    ;; Evaluate the commands in order that any logical testing will be done.
-    (cond ((not (cdr cmds))
-           (eval (car cmds))) ; single command
-          (t
-           (mapcar (function eval) cmds)))))
-
-(defun dired-guess-shell-command (prompt files)
-
-  ;; Ask user with PROMPT for a shell command, guessing a default from FILES.
-
-  (let ((default (dired-guess-default files))
-        default-list old-history val (failed t))
-
-    (if (null default)
-        ;; Nothing to guess
-        (read-from-minibuffer prompt nil nil nil 'dired-shell-command-history)
-
-      ;; Save current history list
-      (setq old-history dired-shell-command-history)
-
-      (if (listp default)
-
-          ;; More than one guess
-          (setq default-list default
-                default (car default)
-                prompt (concat
-                        prompt
-                        (format "{%d guesses} " (length default-list))))
-
-        ;; Just one guess
-        (setq default-list (list default)))
-
-      ;; Push all guesses onto history so that they can be retrieved with M-p
-      ;; and put the first guess in the prompt but not in the initial value.
-      (setq dired-shell-command-history
-            (append default-list dired-shell-command-history)
-            prompt (concat prompt (format "[%s] " default)))
-
-      ;; The unwind-protect returns VAL, and we too.
-      (unwind-protect
-          ;; BODYFORM
-          (progn
-            (setq val (read-from-minibuffer prompt nil nil nil
-                                            'dired-shell-command-history)
-                  failed nil)
-            ;; If we got a return, then use default.
-            (if (equal val "")
-                (setq val default))
-            val)
-
-        ;; UNWINDFORMS
-        ;; Undo pushing onto the history list so that an aborted
-        ;; command doesn't get the default in the next command.
-        (setq dired-shell-command-history old-history)
-        (if (not failed)
-            (or (equal val (car-safe dired-shell-command-history))
-                (setq dired-shell-command-history
-                      (cons val dired-shell-command-history))))))))
-
-
-;;; REDEFINE.
-;;; Redefine dired-aux.el's version:
-(defun dired-read-shell-command (prompt arg files)
-;;  "Read a dired shell command prompting with PROMPT (using read-string).
-;;ARG is the prefix arg and may be used to indicate in the prompt which
-;;  files are affected.
-;;This is an extra function so that you can redefine it, e.g., to use gmhist."
-  (dired-mark-pop-up
-   nil 'shell files
-   'dired-guess-shell-command
-   (format prompt (dired-mark-prompt arg files)) ; PROMPT
-   files))                                       ; FILES
-
-
-;;; RELATIVE SYMBOLIC LINKS.
-
-(defvar dired-keep-marker-relsymlink ?S
-  "See variable `dired-keep-marker-move'.")
-
-(defun dired-make-relative-symlink (file1 file2 &optional ok-if-already-exists)
-  "Three arguments: FILE1 FILE2 &optional OK-IF-ALREADY-EXISTS
-Make a symbolic link (pointing to FILE1) in FILE2.
-The link is relative (if possible), for example
-
-    \"/vol/tex/bin/foo\" \"/vol/local/bin/foo\"
-
-results in
-
-    \"../../tex/bin/foo\" \"/vol/local/bin/foo\"
-"
-  (interactive "FRelSymLink: \nFRelSymLink %s: \np")
-  (let (name1 name2 len1 len2 (index 0) sub)
-    (setq file1 (expand-file-name file1)
-          file2 (expand-file-name file2)
-          len1 (length file1)
-          len2 (length file2))
-    ;; Find common initial pathname components:
-    (let (next)
-      (while (and (setq next (string-match "/" file1 index))
-                  (setq next (1+ next))
-                  (< next (min len1 len2))
-                  ;; For the comparison, both substrings must end in
-                  ;; `/', so NEXT is *one plus* the result of the
-                  ;; string-match.
-                  ;; E.g., consider the case of linking "/tmp/a/abc"
-                  ;; to "/tmp/abc" erroneously giving "/tmp/a" instead
-                  ;; of "/tmp/" as common initial component
-                  (string-equal (substring file1 0 next)
-                                (substring file2 0 next)))
-        (setq index next))
-      (setq name2 file2
-            sub (substring file1 0 index)
-            name1 (substring file1 index)))
-    (if (string-equal sub "/")
-        ;; No common initial pathname found
-        (setq name1 file1)
-      ;; Else they have a common parent directory
-      (let ((tem (substring file2 index))
-            (start 0)
-            (count 0))
-        ;; Count number of slashes we must compensate for ...
-        (while (setq start (string-match "/" tem start))
-          (setq count (1+ count)
-                start (1+ start)))
-        ;; ... and prepend a "../" for each slash found:
-        (while (> count 0)
-          (setq count (1- count)
-                name1 (concat "../" name1)))))
-    (make-symbolic-link
-     (directory-file-name name1)        ; must not link to foo/
-                                        ; (trailing slash!)
-     name2 ok-if-already-exists)))
-
-(defun dired-do-relsymlink (&optional arg)
-   "Relative symlink all marked (or next ARG) files into a directory,
-or make a relative symbolic link to the current file.
-This creates relative symbolic links like
-
-    foo -> ../bar/foo
-
-not absolute ones like
-
-    foo -> /ugly/path/that/may/change/any/day/bar/foo"
-  (interactive "P")
-  (dired-do-create-files 'relsymlink (function dired-make-relative-symlink)
-                           "RelSymLink" arg dired-keep-marker-relsymlink))
-
-(defun dired-do-relsymlink-regexp (regexp newname &optional whole-path)
-  "RelSymlink all marked files containing REGEXP to NEWNAME.
-See functions `dired-do-rename-regexp' and `dired-do-relsymlink'
-for more info."
-  (interactive (dired-mark-read-regexp "RelSymLink"))
-  (dired-do-create-files-regexp
-   (function dired-make-relative-symlink)
-   "RelSymLink" nil regexp newname whole-path dired-keep-marker-relsymlink))
-
-
-;;; VISIT ALL MARKED FILES SIMULTANEOUSLY.
-
-;;; Brief Description:
-;;;
-;;; `dired-do-find-marked-files' is bound to `F' by dired-x.el.
-;;;
-;;; * Use `dired-get-marked-files' to collect the marked files in the current
-;;;   Dired Buffer into a list of filenames `FILE-LIST'.
-;;;
-;;; * Pass FILE-LIST to `dired-simultaneous-find-file' all with
-;;;   `dired-do-find-marked-files''s prefix argument NOSELECT.
-;;;
-;;; * `dired-simultaneous-find-file' runs through FILE-LIST decrementing the
-;;;   list each time.
-;;;
-;;; * If NOSELECT is non-nil then just run `find-file-noselect'  on each
-;;;   element of FILE-LIST.
-;;;
-;;; * If NOSELECT is nil then calculate the `size' of the window for each file
-;;;   by dividing the `window-height' by length of FILE-LIST.  Thus, `size' is
-;;;   cognizant of the window-configuration.
-;;;
-;;; * If `size' is too small abort, otherwise run `find-file' on each element
-;;;   of FILE-LIST giving each a window of height `size'.
-
-(defun dired-do-find-marked-files (&optional noselect)
-  "Find all marked files displaying all of them simultaneously.
-With optional NOSELECT just find files but do not select them.
-
-The current window is split across all files marked, as evenly as possible.
-Remaining lines go to bottom-most window.  The number of files that can be
-displayed this way is restricted by the height of the current window and
-`window-min-height'.
-
-To keep dired buffer displayed, type \\[split-window-vertically] first.
-To display just marked files, type \\[delete-other-windows] first."
-
-  (interactive "P")
-  (dired-simultaneous-find-file (dired-get-marked-files) noselect))
-
-(defun dired-simultaneous-find-file (file-list noselect)
-
-  ;; Visit all files in FILE-LIST and display them simultaneously.  The
-  ;; current window is split across all files in FILE-LIST, as evenly as
-  ;; possible.  Remaining lines go to the bottom-most window.  The number of
-  ;; files that can be displayed this way is restricted by the height of the
-  ;; current window and the variable `window-min-height'.  With non-nil
-  ;; NOSELECT the files are merely found but not selected.
-
-  ;; We don't make this function interactive because it is usually too clumsy
-  ;; to specify FILE-LIST interactively unless via dired.
-
-  (let (size)
-
-    (if noselect
-        ;; Do not select the buffer.
-        (find-file-noselect (car file-list))
-
-      ;; We will have to select the buffer.  Calculate and check window size.
-      (setq size (/ (window-height) (length file-list)))
-      (or (<= window-min-height size)
-          (error "Too many files to visit simultaneously.  Try C-u prefix."))
-      (find-file (car file-list)))
-
-    ;; Decrement.
-    (setq file-list (cdr file-list))
-
-    (while file-list
-
-      (if noselect
-          ;; Do not select the buffer.
-          (find-file-noselect (car file-list))
-
-        ;; Vertically split off a window of desired size.  Upper window will
-        ;; have SIZE lines.  Select lower (larger) window.  We split it again.
-        (select-window (split-window nil size))
-        (find-file (car file-list)))
-
-      ;; Decrement.
-      (setq file-list (cdr file-list)))))
-
-
-;;; MISCELLANEOUS COMMANDS.
-
-;;; Run man on files.
-
-(defun dired-man ()
-  "Run man on this file.  Display old buffer if buffer name matches filename.
-Uses ../lisp/man.el of \\[manual-entry] fame."
-  (interactive)
-  (require 'man)
-  (let ((file (dired-get-filename))
-        (manual-program "nroff -man -h"))
-    (Man-getpage-in-background file)))
-
-;;; Run Info on files.
-
-(defun dired-info ()
-  "Run info on this file."
-  (interactive)
-  (info (dired-get-filename)))
-
-;;; Run mail on mail folders.
-
-;;; (and (not (fboundp 'vm-visit-folder))
-;;;      (defun vm-visit-folder (file &optional arg)
-;;;        nil))
-
-(defun dired-vm (&optional read-only)
-  "Run VM on this file.
-With prefix arg, visit folder read-only (this requires at least VM 5).
-See also variable `dired-vm-read-only-folders'."
-  (interactive "P")
-  (let ((dir (dired-current-directory))
-        (fil (dired-get-filename)))
-    ;; take care to supply 2nd arg only if requested - may still run VM 4!
-    (cond (read-only (vm-visit-folder fil t))
-          ((eq t dired-vm-read-only-folders) (vm-visit-folder fil t))
-          ((null dired-vm-read-only-folders) (vm-visit-folder fil))
-          (t (vm-visit-folder fil (not (file-writable-p fil)))))
-    ;; so that pressing `v' inside VM does prompt within current directory:
-    (set (make-local-variable 'vm-folder-directory) dir)))
-
-(defun dired-rmail ()
-  "Run RMAIL on this file."
-  (interactive)
-  (rmail (dired-get-filename)))
-
-(defun dired-do-run-mail ()
-  "If `dired-bind-vm' is t, then function `dired-vm', otherwise `dired-rmail'."
-  (interactive)
-  (if dired-bind-vm
-      ;; Read mail folder using vm.
-      (dired-vm)
-    ;; Read mail folder using rmail.
-    (dired-rmail)))
-
-
-;;; MISCELLANEOUS INTERNAL FUNCTIONS.
-
-(or (fboundp 'dired-old-find-buffer-nocreate)
-    (fset 'dired-old-find-buffer-nocreate
-          (symbol-function 'dired-find-buffer-nocreate)))
-
-;;; REDEFINE.
-;;; Redefines dired.el's version of `dired-find-buffer-nocreate'
-(defun dired-find-buffer-nocreate (dirname &optional mode)
-  (if (and dired-find-subdir
-	   ;; don't try to find a wildcard as a subdirectory
-	   (string-equal dirname (file-name-directory dirname)))
-      (let* ((cur-buf (current-buffer))
-	     (buffers (nreverse
-		       (dired-buffers-for-dir (expand-file-name dirname))))
-	     (cur-buf-matches (and (memq cur-buf buffers)
-				   ;; wildcards must match, too:
-				   (equal dired-directory dirname))))
-	;; We don't want to switch to the same buffer---
-	(setq buffers (delq cur-buf buffers));;need setq with delq
-	(or (car (sort buffers (function dired-buffer-more-recently-used-p)))
-	    ;; ---unless it's the only possibility:
-	    (and cur-buf-matches cur-buf)))
-    (dired-old-find-buffer-nocreate dirname mode)))
-
-;; This should be a builtin
-(defun dired-buffer-more-recently-used-p (buffer1 buffer2)
-  "Return t if BUFFER1 is more recently used than BUFFER2."
-  (if (equal buffer1 buffer2)
-      nil
-    (let ((more-recent nil)
-          (list (buffer-list)))
-      (while (and list
-                  (not (setq more-recent (equal buffer1 (car list))))
-                  (not (equal buffer2 (car list))))
-        (setq list (cdr list)))
-      more-recent)))
-
-;;; Same thing as `dired-buffers-for-dir' of dired.el? - lrd 11/23/93
-;;; (defun dired-buffers-for-dir-exact (dir)
-;;; ;; Return a list of buffers that dired DIR (a directory or wildcard)
-;;; ;; at top level, or as subdirectory.
-;;; ;; Top level matches must match the wildcard part too, if any.
-;;; ;; The list is in reverse order of buffer creation, most recent last.
-;;; ;; As a side effect, killed dired buffers for DIR are removed from
-;;; ;; dired-buffers.
-;;;   (let ((alist dired-buffers) result elt)
-;;;     (while alist
-;;;       (setq elt (car alist)
-;;;             alist (cdr alist))
-;;;       (let ((buf (cdr elt)))
-;;;         (if (buffer-name buf)
-;;;             ;; Top level must match exactly against dired-directory in
-;;;             ;; case one of them is a wildcard.
-;;;             (if (or (equal dir (save-excursion (set-buffer buf)
-;;;                                                dired-directory))
-;;;                     (assoc dir (save-excursion (set-buffer buf)
-;;;                                                dired-subdir-alist)))
-;;;                 (setq result (cons buf result)))
-;;;           ;; else buffer is killed - clean up:
-;;;           (setq dired-buffers (delq elt dired-buffers)))))
-;;;     result))
-
-;;; REDEFINE.
-;;; Redefines dired.el's version of `dired-initial-position'
-(defun dired-initial-position (dirname)
-  (end-of-line)
-  (if dired-find-subdir (dired-goto-subdir dirname)) ; new
-  (if dired-trivial-filenames (dired-goto-next-nontrivial-file)))
-
-
-;; Does anyone use this? - lrd 6/29/93.
-(defun dired-mark-sexp (predicate &optional unflag-p)
-  "Mark files for which PREDICATE returns non-nil.
-With a prefix arg, unflag those files instead.
-
-PREDICATE is a lisp expression that can refer to the following symbols:
-
-    inode  [integer] the inode of the file (only for ls -i output)
-    s      [integer] the size of the file for ls -s output
-                     (usually in blocks or, with -k, in KByte)
-    mode   [string]  file permission bits, e.g. \"-rw-r--r--\"
-    nlink  [integer] number of links to file
-    uid    [string]  owner
-    gid    [string]  group  (If the gid is not displayed by ls,
-                     this will still be set (to the same as uid))
-    size   [integer] file size in bytes
-    time   [string]  the time that ls displays, e.g. \"Feb 12 14:17\"
-    name   [string]  the name of the file
-    sym    [string]  if file is a symbolic link, the linked-to name, else \"\"
-
-For example, use
-
-        (equal 0 size)
-
-to mark all zero length files."
-  ;; Using sym="" instead of nil avoids the trap of
-  ;; (string-match "foo" sym) into which a user would soon fall.
-  ;; Give `equal' instead of `=' in the example, as this works on
-  ;; integers and strings.
-  (interactive "xMark if (lisp expr): \nP")
-  (message "%s" predicate)
-  (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char))
-        inode s mode nlink uid gid size time name sym)
-    (dired-mark-if
-     (save-excursion
-       (and
-        ;; Sets vars
-        ;;                inode s mode nlink uid gid size time name sym
-
-        ;; according to current file line.  Returns t for success, nil if
-        ;; there is no file line.  Upon success, all variables are set, either
-        ;; to nil or the appropriate value, so they need not be initialized.
-        ;; Moves point within the current line.
-        (if (dired-move-to-filename)
-            (let (pos
-                  (mode-len 10) ; length of mode string
-                  ;; like in dired.el, but with subexpressions \1=inode, \2=s:
-                  (dired-re-inode-size "\\s *\\([0-9]*\\)\\s *\\([0-9]*\\) ?"))
-              (beginning-of-line)
-              (forward-char 2)
-              (if (looking-at dired-re-inode-size)
-                  (progn
-                    (goto-char (match-end 0))
-                    (setq inode (string-to-int (buffer-substring (match-beginning 1)
-                                                                 (match-end 1)))
-                          s (string-to-int (buffer-substring (match-beginning 2)
-                                                             (match-end 2)))))
-                (setq inode nil
-                      s nil))
-              (setq mode (buffer-substring (point) (+ mode-len (point))))
-              (forward-char mode-len)
-              (setq nlink (read (current-buffer)))
-              (setq uid (buffer-substring (point) (progn (forward-word 1) (point))))
-              (re-search-forward "\\(Jan\\|Feb\\|Mar\\|Apr\\|May\\|Jun\\|Jul\\|Aug\\|Sep\\|Oct\\|Nov\\|Dec\\)")
-              (goto-char (match-beginning 1))
-              (forward-char -1)
-              (setq size (string-to-int (buffer-substring (save-excursion
-                                                            (backward-word 1)
-                                                            (setq pos (point)))
-                                                          (point))))
-              (goto-char pos)
-              (backward-word 1)
-              ;; if no gid is displayed, gid will be set to uid
-              ;; but user will then not reference it anyway in PREDICATE.
-              (setq gid (buffer-substring (save-excursion (forward-word 1) (point))
-                                          (point))
-                    time (buffer-substring (match-beginning 1)
-                                           (1- (dired-move-to-filename)))
-                    name (buffer-substring (point)
-                                           (or (dired-move-to-end-of-filename t)
-                                               (point)))
-                    sym  (progn
-                           (if (looking-at " -> ")
-                               (buffer-substring (progn (forward-char 4) (point))
-                                                 (progn (end-of-line) (point)))
-                             "")))
-              t)
-          nil)
-                      (eval predicate)))
-     (format "'%s file" predicate))))
-
-
-;;; FIND FILE AT POINT.
-
-(defvar dired-x-hands-off-my-keys t
-  "*t means don't bind `dired-x-find-file' over `find-file' on keyboard.
-Similarly for `dired-x-find-file-other-window' over `find-file-other-window'.
-If you change this variable after dired-x.el is loaded then do
-\\[dired-x-bind-find-file].")
-
-;;; Bind `dired-x-find-file{-other-window}' over wherever
-;;; `find-file{-other-window}' is bound?
-(defun dired-x-bind-find-file ()
-  "Bind `dired-x-find-file' in place of `find-file' \(or reverse\).
-Similarly for `dired-x-find-file-other-window' and `find-file-other-window'.
-Binding direction based on `dired-x-hands-off-my-keys'.
-This function part of `after-init-hook'."
-  (interactive)
-  (if (interactive-p)
-      (setq dired-x-hands-off-my-keys
-            (not (y-or-n-p "Bind dired-x-find-file over find-file? "))))
-  (cond ((not dired-x-hands-off-my-keys)
-         (substitute-key-definition 'find-file
-                                    'dired-x-find-file
-                                    (current-global-map))
-         (substitute-key-definition 'find-file-other-window
-                                    'dired-x-find-file-other-window
-                                    (current-global-map)))
-        (t
-         (substitute-key-definition 'dired-x-find-file
-                                    'find-file
-                                    (current-global-map))
-         (substitute-key-definition 'dired-x-find-file-other-window
-                                    'find-file-other-window
-                                    (current-global-map))))
-  ;; Clear mini-buffer.
-  (message nil))
-
-;;; Now call it so binding is correct and put on `after-init-hook' in case
-;;; user changes binding.
-(dired-x-bind-find-file)
-(add-hook 'after-init-hook 'dired-x-bind-find-file)
-
-(defun dired-x-find-file (filename)
-  "Edit file FILENAME.
-May create a new window, or reuse an existing one.
-See the function `display-buffer'.
-
-Identical to `find-file' except when called interactively, with a prefix arg
-\(e.g., \\[universal-argument]\), in which case it guesses filename near
-point.  Useful for editing file mentioned in buffer you are viewing, or to
-test if that file exists.  Use minibuffer after snatching filename."
-  (interactive (list (read-filename-at-point "Find file: ")))
-  (find-file (expand-file-name filename)))
-
-(defun dired-x-find-file-other-window (filename)
-  "Edit file FILENAME, in another window.
-May create a new window, or reuse an existing one.
-See the function `display-buffer'.
-
-Identical to `find-file-other-window' except when called interactively, with a
-prefix arg \(e.g., \\[universal-argument]\), in which case it guesses filename
-near point.  Useful for editing file mentioned in buffer you are viewing, or
-to test if that file exists.  Use minibuffer after snatching filename."
-  (interactive (list (read-filename-at-point "Find file: ")))
-  (find-file-other-window (expand-file-name filename)))
-
-;;; Internal functions.
-(defun dired-filename-at-point ()
-
-  ;; Get the filename closest to point, but do not change position.  Has a
-  ;; preference for looking backward when not directly on a symbol.  Not
-  ;; perfect - point must be in middle of or end of filename.
-
-  (let ((filename-chars ".a-zA-Z0-9---_/:$+")
-        (bol (save-excursion (beginning-of-line) (point)))
-        (eol (save-excursion (end-of-line) (point)))
-        start end filename)
-
-    (save-excursion
-      ;; First see if just past a filename.
-      (if (not (eobp))
-          (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens
-              (progn
-                (skip-chars-backward " \n\t\r({[]})")
-                (if (not (bobp))
-                    (backward-char 1)))))
-
-      (if (string-match (concat "[" filename-chars "]")
-                        (char-to-string (following-char)))
-          (progn
-            (skip-chars-backward filename-chars)
-            (setq start (point))
-            (if (string-match "[/~]" (char-to-string (preceding-char)))
-                (setq start (1- start)))
-            (skip-chars-forward filename-chars))
-
-        (error "No file found around point!"))
-
-      ;; Return string.
-      (expand-file-name (buffer-substring start (point))))))
-
-(defun read-filename-at-point (prompt)
-  ;;; Returns filename prompting with PROMPT with completion.  If
-  ;;; `current-prefix-arg' is non-nil, uses name at point as guess.
-  (if current-prefix-arg
-      (let ((guess (dired-filename-at-point)))
-        (read-file-name prompt
-                        (file-name-directory guess)
-                        guess
-                        nil (file-name-nondirectory guess)))
-    (read-file-name prompt default-directory)))
-
-
-;;; BUG REPORTS
-
-;;; This section is provided for reports.  It uses Barry A. Warsaw's
-;;; reporter.el which is bundled with GNU Emacs v19.
-
-(defconst dired-x-version "2.37"
-  "Revision number of dired-x.el -- dired extra for GNU Emacs v19.
-Type \\[dired-x-submit-report] to send a bug report.  Available via anonymous
-ftp in
-
-   /roebling.poly.edu:/pub/packages/dired-x.tar.gz")
-
-(defconst dired-x-help-address "dodd@roebling.poly.edu"
-  "Address(es) accepting submission of reports on dired-x.el.")
-
-(defconst dired-x-maintainer "Larry"
-  "First name(s) of people accepting submission of reports on dired-x.el.")
-
-(defconst dired-x-file "dired-x.el"
-  "Name of file containing emacs lisp code.")
-
-(defconst dired-x-variable-list
-  (list
-   'dired-bind-vm
-   'dired-vm-read-only-folders
-   'dired-bind-jump
-   'dired-bind-info
-   'dired-bind-man
-   'dired-find-subdir
-   'dired-enable-local-variables
-   'dired-local-variables-file
-   'dired-guess-shell-gnutar
-   'dired-guess-shell-gzip-quiet
-   'dired-guess-shell-znew-switches
-   'dired-guess-shell-alist-user
-   'dired-clean-up-buffers-too
-   'dired-omit-files-p
-   'dired-omit-files
-   'dired-omit-extensions
-   )
-  "List of variables to be appended to reports sent by `dired-x-submit-report.'")
-
-(defun dired-x-submit-report ()
-  "Submit via reporter.el a bug report on program.  Send report on `dired-x-file'
-version `dired-x-version,' to `dired-x-maintainer' at address `dired-x-help-address'
-listing variables `dired-x-variable-list' in the message."
-  (interactive)
-
-  ;; In case we can't find reporter...
-  (condition-case err
-      (progn
-        ;; Get it if we can.
-        (require 'reporter)
-
-        (reporter-submit-bug-report
-         dired-x-help-address                           ; address
-         (concat dired-x-file " (" dired-x-version ")") ; pkgname
-         dired-x-variable-list                          ; varlist
-         nil nil                                        ; pre-/post-hooks
-         (concat dired-x-maintainer ",")))              ; salutation
-
-    ;; ...fail gracefully.
-    (error
-     (beep)
-     (message "Sorry, reporter.el not found."))))
-
-
-;; As Barry Warsaw would say: "This might be useful..."
-(provide 'dired-x)
-
-;;; dired-x.el ends here
diff --git a/lisp/dired.el b/lisp/dired.el
deleted file mode 100644
index ffb6bd22831..00000000000
--- a/lisp/dired.el
+++ /dev/null
@@ -1,2506 +0,0 @@
-;;; dired.el --- directory-browsing commands
-
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 1996 Free Software Foundation, Inc.
-
-;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
-;; 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 is a major mode for directory browsing and editing.  It is
-;; documented in the Emacs manual.
-
-;; Rewritten in 1990/1991 to add tree features, file marking and
-;; sorting by Sebastian Kremer <sk@thp.uni-koeln.de>.
-;; Finished up by rms in 1992.
-
-;;; Code:
-
-;;; Customizable variables
-
-;;;###autoload
-(defvar dired-listing-switches "-al"
-  "*Switches passed to `ls' for dired.  MUST contain the `l' option.
-May contain all other options that don't contradict `-l';
-may contain even `F', `b', `i' and `s'.  See also the variable
-`dired-ls-F-marks-symlinks' concerning the `F' switch.")
-
-; Don't use absolute paths as /bin should be in any PATH and people
-; may prefer /usr/local/gnu/bin or whatever.  However, chown is
-; usually not in PATH.
-
-;;;###autoload
-(defvar dired-chown-program
-  (if (memq system-type '(hpux dgux usg-unix-v irix linux gnu/linux))
-      "chown"
-    (if (file-exists-p "/usr/sbin/chown")
-	"/usr/sbin/chown"
-      "/etc/chown"))
-  "Name of chown command (usually `chown' or `/etc/chown').")
-
-(defvar dired-chmod-program
-  (if (eq system-type 'windows-nt)
-      "chmode" "chmod")
-  "Name of chmod command (usually `chmod' or `chmode').")
-
-;;;###autoload
-(defvar dired-ls-F-marks-symlinks nil
-  "*Informs dired about how `ls -lF' marks symbolic links.
-Set this to t if `ls' (or whatever program is specified by
-`insert-directory-program') with `-lF' marks the symbolic link
-itself with a trailing @ (usually the case under Ultrix).
-
-Example: if `ln -s foo bar; ls -F bar' gives `bar -> foo', set it to
-nil (the default), if it gives `bar@ -> foo', set it to t.
-
-Dired checks if there is really a @ appended.  Thus, if you have a
-marking `ls' program on one host and a non-marking on another host, and
-don't care about symbolic links which really end in a @, you can
-always set this variable to t.")
-
-;;;###autoload
-(defvar dired-trivial-filenames "^\\.\\.?$\\|^#"
-  "*Regexp of files to skip when finding first file of a directory.
-A value of nil means move to the subdir line.
-A value of t means move to first file.")
-
-;;;###autoload
-(defvar dired-keep-marker-rename t
-  ;; Use t as default so that moved files "take their markers with them".
-  "*Controls marking of renamed files.
-If t, files keep their previous marks when they are renamed.
-If a character, renamed files (whether previously marked or not)
-are afterward marked with that character.")
-
-;;;###autoload
-(defvar dired-keep-marker-copy ?C
-  "*Controls marking of copied files.
-If t, copied files are marked if and as the corresponding original files were.
-If a character, copied files are unconditionally marked with that character.")
-
-;;;###autoload
-(defvar dired-keep-marker-hardlink ?H
-  "*Controls marking of newly made hard links.
-If t, they are marked if and as the files linked to were marked.
-If a character, new links are unconditionally marked with that character.")
-
-;;;###autoload
-(defvar dired-keep-marker-symlink ?Y
-  "*Controls marking of newly made symbolic links.
-If t, they are marked if and as the files linked to were marked.
-If a character, new links are unconditionally marked with that character.")
-
-;;;###autoload
-(defvar dired-dwim-target nil
-  "*If non-nil, dired tries to guess a default target directory.
-This means: if there is a dired buffer displayed in the next window,
-use its current subdir, instead of the current subdir of this dired buffer.
-
-The target is used in the prompt for file copy, rename etc.")
-
-;;;###autoload
-(defvar dired-copy-preserve-time t
-  "*If non-nil, Dired preserves the last-modified time in a file copy.
-\(This works on only some systems.)")
-
-;;; Hook variables
-
-(defvar dired-load-hook nil
-  "Run after loading dired.
-You can customize key bindings or load extensions with this.")
-
-(defvar dired-mode-hook nil
-  "Run at the very end of dired-mode.")
-
-(defvar dired-before-readin-hook nil
-  "This hook is run before a dired buffer is read in (created or reverted).")
-
-(defvar dired-after-readin-hook nil
-  "Hook run after each time a file or directory is read by Dired.
-After each listing of a file or directory, this hook is run
-with the buffer narrowed to the listing.")
-;; Note this can't simply be run inside function `dired-ls' as the hook
-;; functions probably depend on the dired-subdir-alist to be OK.
-
-;;; Internal variables
-
-(defvar dired-marker-char ?*		; the answer is 42
-  ;; so that you can write things like
-  ;; (let ((dired-marker-char ?X))
-  ;;    ;; great code using X markers ...
-  ;;    )
-  ;; For example, commands operating on two sets of files, A and B.
-  ;; Or marking files with digits 0-9.  This could implicate
-  ;; concentric sets or an order for the marked files.
-  ;; The code depends on dynamic scoping on the marker char.
-  "In Dired, the current mark character.
-This is what the `do' commands look for and what the `mark' commands store.")
-
-(defvar dired-del-marker ?D
-  "Character used to flag files for deletion.")
-
-(defvar dired-shrink-to-fit
-  t
-;; I see no reason ever to make this nil -- rms.
-;;  (> baud-rate search-slow-speed)
-  "Non-nil means Dired shrinks the display buffer to fit the marked files.")
-
-(defvar dired-flagging-regexp nil);; Last regexp used to flag files.
-
-(defvar dired-file-version-alist)
-
-(defvar dired-directory nil
-  "The directory name or shell wildcard that was used as argument to `ls'.
-Local to each dired buffer.  May be a list, in which case the car is the
-directory name and the cdr is the actual files to list.")
-
-(defvar dired-actual-switches nil
-  "The value of `dired-listing-switches' used to make this buffer's text.")
-
-(defvar dired-re-inode-size "[0-9 \t]*"
-  "Regexp for optional initial inode and file size as made by `ls -i -s'.")
-
-;; These regexps must be tested at beginning-of-line, but are also
-;; used to search for next matches, so neither omitting "^" nor
-;; replacing "^" by "\n" (to make it slightly faster) will work.
-
-(defvar dired-re-mark "^[^ \n]")
-;; "Regexp matching a marked line.
-;; Important: the match ends just after the marker."
-(defvar dired-re-maybe-mark "^. ")
-(defvar dired-re-dir (concat dired-re-maybe-mark dired-re-inode-size "d"))
-(defvar dired-re-sym (concat dired-re-maybe-mark dired-re-inode-size "l"))
-(defvar dired-re-exe;; match ls permission string of an executable file
-  (mapconcat (function
-	      (lambda (x)
-		(concat dired-re-maybe-mark dired-re-inode-size x)))
-	     '("-[-r][-w][xs][-r][-w].[-r][-w]."
-	       "-[-r][-w].[-r][-w][xs][-r][-w]."
-	       "-[-r][-w].[-r][-w].[-r][-w][xst]")
-	     "\\|"))
-(defvar dired-re-perms "[-bcdlps][-r][-w].[-r][-w].[-r][-w].")
-(defvar dired-re-dot "^.* \\.\\.?$")
-
-;; The subdirectory names in this list are expanded.
-(defvar dired-subdir-alist nil
-  "Association list of subdirectories and their buffer positions.
-Each subdirectory has an element: (DIRNAME . STARTMARKER).
-The order of elements is the reverse of the order in the buffer.
-In simple cases, this list contains one element.")
-
-(defvar dired-subdir-regexp "^. \\([^\n\r]+\\)\\(:\\)[\n\r]"
-  "Regexp matching a maybe hidden subdirectory line in `ls -lR' output.
-Subexpression 1 is the subdirectory proper, no trailing colon.
-The match starts at the beginning of the line and ends after the end
-of the line (\\n or \\r).
-Subexpression 2 must end right before the \\n or \\r.")
-
-(defvar dired-font-lock-keywords
-  (list
-   ;;
-   ;; Directory headers.
-   (list dired-subdir-regexp '(1 font-lock-type-face))
-   ;;
-   ;; We make heavy use of MATCH-ANCHORED, since the regexps don't identify the
-   ;; file name itself.  We search for Dired defined regexps, and then use the
-   ;; Dired defined function `dired-move-to-filename' before searching for the
-   ;; simple regexp ".+".  It is that regexp which matches the file name.
-   ;;
-   ;; Dired marks.
-   (list dired-re-mark
-	 '(0 font-lock-reference-face)
-	 '(".+" (dired-move-to-filename) nil (0 font-lock-warning-face)))
-   ;;
-   ;; Files that are group or world writable.
-   (list (concat dired-re-maybe-mark dired-re-inode-size
-		 "\\([-d]\\(....w....\\|.......w.\\)\\)")
-	 '(1 font-lock-comment-face)
-	 '(".+" (dired-move-to-filename) nil (0 font-lock-comment-face)))
-   ;;
-   ;; Subdirectories.
-   (list dired-re-dir
-	 '(".+" (dired-move-to-filename) nil (0 font-lock-function-name-face)))
-   ;;
-   ;; Symbolic links.
-   (list dired-re-sym 
-	 '(".+" (dired-move-to-filename) nil (0 font-lock-keyword-face)))
-   ;;
-   ;; Files suffixed with `completion-ignored-extensions'.
-   '(eval .
-     (let ((extensions (mapcar 'regexp-quote completion-ignored-extensions)))
-       ;; It is quicker to first find just an extension, then go back to the
-       ;; start of that file name.  So we do this complex MATCH-ANCHORED form.
-       (list (concat "\\(" (mapconcat 'identity extensions "\\|") "\\|#\\)$")
-	     '(".+" (dired-move-to-filename) nil (0 font-lock-string-face))))))
-  "Additional expressions to highlight in Dired mode.")
-
-;;; Macros must be defined before they are used, for the byte compiler.
-
-;; Mark all files for which CONDITION evals to non-nil.
-;; CONDITION is evaluated on each line, with point at beginning of line.
-;; MSG is a noun phrase for the type of files being marked.
-;; It should end with a noun that can be pluralized by adding `s'.
-;; Return value is the number of files marked, or nil if none were marked.
-(defmacro dired-mark-if (predicate msg)
-  (` (let (buffer-read-only count)
-       (save-excursion
-	 (setq count 0)
-	 (if (, msg) (message "Marking %ss..." (, msg)))
-	 (goto-char (point-min))
-	 (while (not (eobp))
-	   (if (, predicate)
-	       (progn
-		 (delete-char 1)
-		 (insert dired-marker-char)
-		 (setq count (1+ count))))
-	   (forward-line 1))
-	 (if (, msg) (message "%s %s%s %s%s."
-			  count
-			  (, msg)
-			  (dired-plural-s count)
-			  (if (eq dired-marker-char ?\040) "un" "")
-			  (if (eq dired-marker-char dired-del-marker)
-			      "flagged" "marked"))))
-       (and (> count 0) count))))
-
-(defmacro dired-map-over-marks (body arg &optional show-progress)
-;;  "Macro: Perform BODY with point somewhere on each marked line
-;;and return a list of BODY's results.
-;;If no marked file could be found, execute BODY on the current line.
-;;  If ARG is an integer, use the next ARG (or previous -ARG, if ARG<0)
-;;  files instead of the marked files.
-;;  In that case point is dragged along.  This is so that commands on
-;;  the next ARG (instead of the marked) files can be chained easily.
-;;  If ARG is otherwise non-nil, use current file instead.
-;;If optional third arg SHOW-PROGRESS evaluates to non-nil,
-;;   redisplay the dired buffer after each file is processed.
-;;No guarantee is made about the position on the marked line.
-;;  BODY must ensure this itself if it depends on this.
-;;Search starts at the beginning of the buffer, thus the car of the list
-;;  corresponds to the line nearest to the buffer's bottom.  This
-;;  is also true for (positive and negative) integer values of ARG.
-;;BODY should not be too long as it is expanded four times."
-;;
-;;Warning: BODY must not add new lines before point - this may cause an
-;;endless loop.
-;;This warning should not apply any longer, sk  2-Sep-1991 14:10.
-  (` (prog1
-	 (let (buffer-read-only case-fold-search found results)
-	   (if (, arg)
-	       (if (integerp (, arg))
-		   (progn;; no save-excursion, want to move point.
-		     (dired-repeat-over-lines
-		      (, arg)
-		      (function (lambda ()
-				  (if (, show-progress) (sit-for 0))
-				  (setq results (cons (, body) results)))))
-		     (if (< (, arg) 0)
-			 (nreverse results)
-		       results))
-		 ;; non-nil, non-integer ARG means use current file:
-		 (list (, body)))
-	     (let ((regexp (dired-marker-regexp)) next-position)
-	       (save-excursion
-		 (goto-char (point-min))
-		 ;; remember position of next marked file before BODY
-		 ;; can insert lines before the just found file,
-		 ;; confusing us by finding the same marked file again
-		 ;; and again and...
-		 (setq next-position (and (re-search-forward regexp nil t)
-					  (point-marker))
-		       found (not (null next-position)))
-		 (while next-position
-		   (goto-char next-position)
-		   (if (, show-progress) (sit-for 0))
-		   (setq results (cons (, body) results))
-		   ;; move after last match
-		   (goto-char next-position)
-		   (forward-line 1)
-		   (set-marker next-position nil)
-		   (setq next-position (and (re-search-forward regexp nil t)
-					    (point-marker)))))
-	       (if found
-		   results
-		 (list (, body))))))
-       ;; save-excursion loses, again
-       (dired-move-to-filename))))
-
-(defun dired-get-marked-files (&optional localp arg)
-  "Return the marked files' names as list of strings.
-The list is in the same order as the buffer, that is, the car is the
-  first marked file.
-Values returned are normally absolute pathnames.
-Optional arg LOCALP as in `dired-get-filename'.
-Optional second argument ARG forces to use other files.  If ARG is an
-  integer, use the next ARG files.  If ARG is otherwise non-nil, use
-  current file.  Usually ARG comes from the current prefix arg."
-  (save-excursion
-    (nreverse (dired-map-over-marks (dired-get-filename localp) arg))))
-
-
-;; Function dired-ls is redefinable for VMS, ange-ftp, Prospero or
-;; other special applications.
-
-;; The dired command
-
-(defun dired-read-dir-and-switches (str)
-  ;; For use in interactive.
-  (reverse (list
-	    (if current-prefix-arg
-		(read-string "Dired listing switches: "
-			     dired-listing-switches))
-	    (read-file-name (format "Dired %s(directory): " str)
-			    nil default-directory nil))))
-
-;;;###autoload (define-key ctl-x-map "d" 'dired)
-;;;###autoload
-(defun dired (dirname &optional switches)
-  "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it.
-Optional second argument SWITCHES specifies the `ls' options used.
-\(Interactively, use a prefix argument to be able to specify SWITCHES.)
-Dired displays a list of files in DIRNAME (which may also have
-shell wildcards appended to select certain files).  If DIRNAME is a cons,
-its first element is taken as the directory name and the rest as an explicit
-list of files to make directory entries for.
-\\<dired-mode-map>\
-You can move around in it with the usual commands.
-You can flag files for deletion with \\[dired-flag-file-deletion] and then
-delete them by typing \\[dired-do-flagged-delete].
-Type \\[describe-mode] after entering dired for more info.
-
-If DIRNAME is already in a dired buffer, that buffer is used without refresh."
-  ;; Cannot use (interactive "D") because of wildcards.
-  (interactive (dired-read-dir-and-switches ""))
-  (switch-to-buffer (dired-noselect dirname switches)))
-
-;;;###autoload (define-key ctl-x-4-map "d" 'dired-other-window)
-;;;###autoload
-(defun dired-other-window (dirname &optional switches)
-  "\"Edit\" directory DIRNAME.  Like `dired' but selects in another window."
-  (interactive (dired-read-dir-and-switches "in other window "))
-  (switch-to-buffer-other-window (dired-noselect dirname switches)))
-
-;;;###autoload (define-key ctl-x-5-map "d" 'dired-other-frame)
-;;;###autoload
-(defun dired-other-frame (dirname &optional switches)
-  "\"Edit\" directory DIRNAME.  Like `dired' but makes a new frame."
-  (interactive (dired-read-dir-and-switches "in other frame "))
-  (switch-to-buffer-other-frame (dired-noselect dirname switches)))
-
-;;;###autoload
-(defun dired-noselect (dir-or-list &optional switches)
-  "Like `dired' but returns the dired buffer as value, does not select it."
-  (or dir-or-list (setq dir-or-list default-directory))
-  ;; This loses the distinction between "/foo/*/" and "/foo/*" that
-  ;; some shells make:
-  (let (dirname)
-    (if (consp dir-or-list)
-	(setq dirname (car dir-or-list))
-      (setq dirname dir-or-list))
-    (setq dirname (abbreviate-file-name
-		   (expand-file-name (directory-file-name dirname))))
-    (if find-file-visit-truename
-	(setq dirname (file-truename dirname)))
-    (if (file-directory-p dirname)
-	(setq dirname (file-name-as-directory dirname)))
-    (if (consp dir-or-list)
-	(setq dir-or-list (cons dirname (cdr dir-or-list)))
-      (setq dir-or-list dirname))
-    (dired-internal-noselect dir-or-list switches)))
-
-;; Separate function from dired-noselect for the sake of dired-vms.el.
-(defun dired-internal-noselect (dir-or-list &optional switches mode)
-  ;; If there is an existing dired buffer for DIRNAME, just leave
-  ;; buffer as it is (don't even call dired-revert).
-  ;; This saves time especially for deep trees or with ange-ftp.
-  ;; The user can type `g'easily, and it is more consistent with find-file.
-  ;; But if SWITCHES are given they are probably different from the
-  ;; buffer's old value, so call dired-sort-other, which does
-  ;; revert the buffer.
-  ;; A pity we can't possibly do "Directory has changed - refresh? "
-  ;; like find-file does.
-  ;; Optional argument MODE is passed to dired-find-buffer-nocreate,
-  ;; see there.
-  (let* ((dirname (if (consp dir-or-list) (car dir-or-list) dir-or-list))
-	 ;; The following line used to use dir-or-list.
-	 ;; That never found an existing buffer, in the case
-	 ;; where it is a list.
-	 (buffer (dired-find-buffer-nocreate dirname mode))
-	 ;; note that buffer already is in dired-mode, if found
-	 (new-buffer-p (not buffer))
-	 (old-buf (current-buffer)))
-    (or buffer
-	(let ((default-major-mode 'fundamental-mode))
-	  ;; We don't want default-major-mode to run hooks and set auto-fill
-	  ;; or whatever, now that dired-mode does not
-	  ;; kill-all-local-variables any longer.
-	  (setq buffer (create-file-buffer (directory-file-name dirname)))))
-    (set-buffer buffer)
-    (if (not new-buffer-p)     ; existing buffer ...
-	(cond (switches        ; ... but new switches     
-	       ;; file list may have changed
-	       (if (consp dir-or-list) 
-		   (setq dired-directory dir-or-list))
-	       ;; this calls dired-revert
-	       (dired-sort-other switches))  
-	      ;; If directory has changed on disk, offer to revert.
-	      ((if (let ((attributes (file-attributes dirname))
-			 (modtime (visited-file-modtime)))
-		     (or (eq modtime 0)
-			 (not (eq (car attributes) t))
-			 (and (= (car (nth 5 attributes)) (car modtime))
-			      (= (nth 1 (nth 5 attributes)) (cdr modtime)))))
-		   nil
-		 (message "%s"
-			  (substitute-command-keys
-			   "Directory has changed on disk; type \\[revert-buffer] to update Dired")))))
-      ;; Else a new buffer
-      (setq default-directory
-	    (if (file-directory-p dirname)
-		dirname
-	      (file-name-directory dirname)))
-      (or switches (setq switches dired-listing-switches))
-      (dired-mode dirname switches)
-      (if mode (funcall mode))
-      ;; default-directory and dired-actual-switches are set now
-      ;; (buffer-local), so we can call dired-readin:
-      (let ((failed t))
-	(unwind-protect
-	    (progn (dired-readin dir-or-list buffer)
-		   (setq failed nil))
-	  ;; dired-readin can fail if parent directories are inaccessible.
-	  ;; Don't leave an empty buffer around in that case.
-	  (if failed (kill-buffer buffer))))
-      ;; No need to narrow since the whole buffer contains just
-      ;; dired-readin's output, nothing else.  The hook can
-      ;; successfully use dired functions (e.g. dired-get-filename)
-      ;; as the subdir-alist has been built in dired-readin.
-      (run-hooks 'dired-after-readin-hook)
-      (goto-char (point-min))
-      (dired-initial-position dirname))
-    (set-buffer old-buf)
-    buffer))
-
-(defun dired-find-buffer-nocreate (dirname &optional mode)
-  ;; This differs from dired-buffers-for-dir in that it does not consider
-  ;; subdirs of default-directory and searches for the first match only.
-  ;; Also, the major mode must be MODE.
-  (let (found (blist dired-buffers))    ; was (buffer-list)
-    (or mode (setq mode 'dired-mode))
-    (while blist
-      (if (null (buffer-name (cdr (car blist))))
-	  (setq blist (cdr blist))
-	(save-excursion
-	  (set-buffer (cdr (car blist)))
-	  (if (and (eq major-mode mode)
-		   (if (consp dired-directory)
-		       (equal (car dired-directory) dirname)
-		     (equal dired-directory dirname)))
-	      (setq found (cdr (car blist))
-		    blist nil)
-	    (setq blist (cdr blist))))))
-    found))
-
-
-;; Read in a new dired buffer
-
-;; dired-readin differs from dired-insert-subdir in that it accepts
-;; wildcards, erases the buffer, and builds the subdir-alist anew
-;; (including making it buffer-local and clearing it first).
-(defun dired-readin (dir-or-list buffer)
-  ;; default-directory and dired-actual-switches must be buffer-local
-  ;; and initialized by now.
-  ;; Thus we can test (equal default-directory dirname) instead of
-  ;; (file-directory-p dirname) and save a filesystem transaction.
-  ;; Also, we can run this hook which may want to modify the switches
-  ;; based on default-directory, e.g. with ange-ftp to a SysV host
-  ;; where ls won't understand -Al switches.
-  (let (dirname)
-    (if (consp dir-or-list)
-	(setq dirname (car dir-or-list))
-      (setq dirname dir-or-list))
-    (setq dirname (expand-file-name dirname))
-    (if (consp dir-or-list)
-	(setq dir-or-list (cons dirname (cdr dir-or-list))))
-    (run-hooks 'dired-before-readin-hook)
-    (save-excursion
-      (message "Reading directory %s..." dirname)
-      (set-buffer buffer)
-      (let (buffer-read-only (failed t))
-	(widen)
-	(erase-buffer)
-	(dired-readin-insert dir-or-list)
-	(indent-rigidly (point-min) (point-max) 2)
-	;; We need this to make the root dir have a header line as all
-	;; other subdirs have:
-	(goto-char (point-min))
-	(dired-insert-headerline default-directory)
-	;; can't run dired-after-readin-hook here, it may depend on the subdir
-	;; alist to be OK.
-	)
-      (message "Reading directory %s...done" dirname)
-      ;; Must first make alist buffer local and set it to nil because
-      ;; dired-build-subdir-alist will call dired-clear-alist first
-      (set (make-local-variable 'dired-subdir-alist) nil)
-      (dired-build-subdir-alist)
-      (let ((attributes (file-attributes dirname)))
-	(if (eq (car attributes) t)
-	    (set-visited-file-modtime (nth 5 attributes))))
-      (set-buffer-modified-p nil))))
-
-;; Subroutines of dired-readin
-
-(defun dired-readin-insert (dir-or-list)
-  ;; Just insert listing for the passed-in directory or
-  ;; directory-and-file list, assuming a clean buffer.
-  (let (dirname)
-    (if (consp dir-or-list)
-	(setq dirname (car dir-or-list))
-      (setq dirname dir-or-list))
-    ;; Expand before comparing in case one or both have been abbreviated.
-    (if (and (equal (expand-file-name default-directory)
-		    (expand-file-name dirname))
-	     (not (consp dir-or-list)))
-	;; If we are reading a whole single directory...
-	(dired-insert-directory dir-or-list dired-actual-switches nil t)
-      (if (not (file-readable-p
-		(directory-file-name (file-name-directory dirname))))
-	  (error "Directory %s inaccessible or nonexistent" dirname)
-	;; Else assume it contains wildcards,
-	;; unless it is an explicit list of files.
-	(dired-insert-directory dir-or-list dired-actual-switches
-				(not (listp dir-or-list)))
-	(save-excursion		;; insert wildcard instead of total line:
-	  (goto-char (point-min))
-	  (insert "wildcard " (file-name-nondirectory dirname) "\n"))))))
-
-(defun dired-insert-directory (dir-or-list switches &optional wildcard full-p)
-  ;; Do the right thing whether dir-or-list is atomic or not.  If it is,
-  ;; inset all files listed in the cdr (the car is the passed-in directory
-  ;; list).
-  (let ((opoint (point))
-	(process-environment (copy-sequence process-environment))
-	end)
-    ;; We used to specify the C locale here, to force English month names;
-    ;; but this should not be necessary any more,
-    ;; with the new value of dired-move-to-filename-regexp.
-    (if (consp dir-or-list)
-	;; In this case, use the file names in the cdr
-	;; exactly as originally given to dired-noselect.
-	(mapcar
-	 (function (lambda (x) (insert-directory x switches wildcard full-p)))
-	 (cdr dir-or-list))
-      ;; Expand the file name here because it may have been abbreviated
-      ;; in dired-noselect.
-      (insert-directory (expand-file-name dir-or-list) switches wildcard full-p))
-    ;; Quote certain characters, unless ls quoted them for us.
-    (if (not (string-match "b" dired-actual-switches))
-	(save-excursion
-	  (setq end (point-marker))
-	  (goto-char opoint)
-	  (while (search-forward "\\" end t)
-	    (replace-match "\\\\" nil t))
-	  (goto-char opoint)
-	  (while (search-forward "\^m" end t)
-	    (replace-match "\\015" nil t))
-	  (set-marker end nil)))
-    (dired-insert-set-properties opoint (point)))
-  (setq dired-directory dir-or-list))
-
-;; Make the file names highlight when the mouse is on them.
-(defun dired-insert-set-properties (beg end)
-  (save-excursion
-    (goto-char beg)
-    (while (< (point) end)
-      (condition-case nil
-	  (if (dired-move-to-filename)
-	      (put-text-property (point)
-				 (save-excursion
-				   (dired-move-to-end-of-filename)
-				   (point))
-				 'mouse-face 'highlight))
-	(error nil))
-      (forward-line 1))))
-
-(defun dired-insert-headerline (dir);; also used by dired-insert-subdir
-  ;; Insert DIR's headerline with no trailing slash, exactly like ls
-  ;; would, and put cursor where dired-build-subdir-alist puts subdir
-  ;; boundaries.
-  (save-excursion (insert "  " (directory-file-name dir) ":\n")))
-
-
-;; Reverting a dired buffer
-
-(defun dired-revert (&optional arg noconfirm)
-  ;; Reread the dired buffer.  Must also be called after
-  ;; dired-actual-switches have changed.
-  ;; Should not fail even on completely garbaged buffers.
-  ;; Preserves old cursor, marks/flags, hidden-p.
-  (widen)				; just in case user narrowed
-  (let ((opoint (point))
-	(ofile (dired-get-filename nil t))
-	(mark-alist nil)		; save marked files
-	(hidden-subdirs (dired-remember-hidden))
-	(old-subdir-alist (cdr (reverse dired-subdir-alist))) ; except pwd
-	(case-fold-search nil)		; we check for upper case ls flags
-	buffer-read-only)
-    (goto-char (point-min))
-    (setq mark-alist;; only after dired-remember-hidden since this unhides:
-	  (dired-remember-marks (point-min) (point-max)))
-    ;; treat top level dir extra (it may contain wildcards)
-    (dired-uncache
-     (if (consp dired-directory) (car dired-directory) dired-directory))
-    (dired-readin dired-directory (current-buffer))
-    (let ((dired-after-readin-hook nil))
-      ;; don't run that hook for each subdir...
-      (dired-insert-old-subdirs old-subdir-alist))
-    (dired-mark-remembered mark-alist)	; mark files that were marked
-    ;; ... run the hook for the whole buffer, and only after markers
-    ;; have been reinserted (else omitting in dired-x would omit marked files)
-    (run-hooks 'dired-after-readin-hook)	; no need to narrow
-    (or (and ofile (dired-goto-file ofile)) ; move cursor to where it
-	(goto-char opoint))		; was before
-    (dired-move-to-filename)
-    (save-excursion			; hide subdirs that were hidden
-      (mapcar (function (lambda (dir)
-			  (if (dired-goto-subdir dir)
-			      (dired-hide-subdir 1))))
-	      hidden-subdirs)))
-  ;; outside of the let scope
-;;; Might as well not override the user if the user changed this.
-;;;  (setq buffer-read-only t)
-  )
-
-;; Subroutines of dired-revert
-;; Some of these are also used when inserting subdirs.
-
-(defun dired-remember-marks (beg end)
-  ;; Return alist of files and their marks, from BEG to END.
-  (if selective-display			; must unhide to make this work.
-      (let (buffer-read-only)
-	(subst-char-in-region beg end ?\r ?\n)))
-  (let (fil chr alist)
-    (save-excursion
-      (goto-char beg)
-      (while (re-search-forward dired-re-mark end t)
-	(if (setq fil (dired-get-filename nil t))
-	    (setq chr (preceding-char)
-		  alist (cons (cons fil chr) alist)))))
-    alist))
-
-;; Mark all files remembered in ALIST.
-;; Each element of ALIST looks like (FILE . MARKERCHAR).
-(defun dired-mark-remembered (alist)
-  (let (elt fil chr)
-    (while alist
-      (setq elt (car alist)
-	    alist (cdr alist)
-	    fil (car elt)
-	    chr (cdr elt))
-      (if (dired-goto-file fil)
-	  (save-excursion
-	    (beginning-of-line)
-	    (delete-char 1)
-	    (insert chr))))))
-
-;; Return a list of names of subdirs currently hidden.
-(defun dired-remember-hidden ()
-  (let ((l dired-subdir-alist) dir pos result)
-    (while l
-      (setq dir (car (car l))
-	    pos (cdr (car l))
-	    l (cdr l))
-      (goto-char pos)
-      (skip-chars-forward "^\r\n")
-      (if (eq (following-char) ?\r)
-	  (setq result (cons dir result))))
-    result))
-
-;; Try to insert all subdirs that were displayed before,
-;; according to the former subdir alist OLD-SUBDIR-ALIST.
-(defun dired-insert-old-subdirs (old-subdir-alist)
-  (or (string-match "R" dired-actual-switches)
-      (let (elt dir)
-	(while old-subdir-alist
-	  (setq elt (car old-subdir-alist)
-		old-subdir-alist (cdr old-subdir-alist)
-		dir (car elt))
-	  (condition-case ()
-	      (progn
-		(dired-uncache dir)
-		(dired-insert-subdir dir))
-	    (error nil))))))
-
-;; Remove directory DIR from any directory cache.
-(defun dired-uncache (dir)
-  (let ((handler (find-file-name-handler dir 'dired-uncache)))
-    (if handler
-	(funcall handler 'dired-uncache dir))))
-
-;; dired mode key bindings and initialization
-
-(defvar dired-mode-map nil "Local keymap for dired-mode buffers.")
-(if dired-mode-map
-    nil
-  ;; This looks ugly when substitute-command-keys uses C-d instead d:
-  ;;  (define-key dired-mode-map "\C-d" 'dired-flag-file-deletion)
-
-  (let ((map (make-keymap)))
-    (suppress-keymap map)
-    (define-key map [mouse-2] 'dired-mouse-find-file-other-window)
-    ;; Commands to mark or flag certain categories of files
-    (define-key map "#" 'dired-flag-auto-save-files)
-    (define-key map "." 'dired-clean-directory)
-    (define-key map "~" 'dired-flag-backup-files)
-    (define-key map "&" 'dired-flag-garbage-files)
-    ;; Upper case keys (except !) for operating on the marked files
-    (define-key map "A" 'dired-do-search)
-    (define-key map "C" 'dired-do-copy)
-    (define-key map "B" 'dired-do-byte-compile)
-    (define-key map "D" 'dired-do-delete)
-    (define-key map "G" 'dired-do-chgrp)
-    (define-key map "H" 'dired-do-hardlink)
-    (define-key map "L" 'dired-do-load)
-    (define-key map "M" 'dired-do-chmod)
-    (define-key map "O" 'dired-do-chown)
-    (define-key map "P" 'dired-do-print)
-    (define-key map "Q" 'dired-do-query-replace)
-    (define-key map "R" 'dired-do-rename)
-    (define-key map "S" 'dired-do-symlink)
-    (define-key map "X" 'dired-do-shell-command)
-    (define-key map "Z" 'dired-do-compress)
-    (define-key map "!" 'dired-do-shell-command)
-    ;; Comparison commands
-    (define-key map "=" 'dired-diff)
-    (define-key map "\M-=" 'dired-backup-diff)
-    ;; Tree Dired commands
-    (define-key map "\M-\C-?" 'dired-unmark-all-files)
-    (define-key map "\M-\C-d" 'dired-tree-down)
-    (define-key map "\M-\C-u" 'dired-tree-up)
-    (define-key map "\M-\C-n" 'dired-next-subdir)
-    (define-key map "\M-\C-p" 'dired-prev-subdir)
-    ;; move to marked files
-    (define-key map "\M-{" 'dired-prev-marked-file)
-    (define-key map "\M-}" 'dired-next-marked-file)
-    ;; Make all regexp commands share a `%' prefix:
-    ;; We used to get to the submap via a symbol dired-regexp-prefix,
-    ;; but that seems to serve little purpose, and copy-keymap
-    ;; does a better job without it.
-    (define-key map "%" nil)
-    (define-key map "%u" 'dired-upcase)
-    (define-key map "%l" 'dired-downcase)
-    (define-key map "%d" 'dired-flag-files-regexp)
-    (define-key map "%m" 'dired-mark-files-regexp)
-    (define-key map "%r" 'dired-do-rename-regexp)
-    (define-key map "%C" 'dired-do-copy-regexp)
-    (define-key map "%H" 'dired-do-hardlink-regexp)
-    (define-key map "%R" 'dired-do-rename-regexp)
-    (define-key map "%S" 'dired-do-symlink-regexp)
-    ;; Commands for marking and unmarking.
-    (define-key map "*" nil)
-    (define-key map "**" 'dired-mark-executables)
-    (define-key map "*/" 'dired-mark-directories)
-    (define-key map "*@" 'dired-mark-symlinks)
-    (define-key map "*%" 'dired-mark-files-regexp)
-    (define-key map "*c" 'dired-change-marks)
-    (define-key map "*s" 'dired-mark-subdir-files)
-    (define-key map "*m" 'dired-mark)
-    (define-key map "*u" 'dired-unmark)
-    (define-key map "*?" 'dired-unmark-all-files)
-    (define-key map "*!" 'dired-unmark-all-files-no-query)
-    (define-key map "*\177" 'dired-unmark-backward)
-    (define-key map "*\C-n" 'dired-next-marked-file)
-    (define-key map "*\C-p" 'dired-prev-marked-file)
-    ;; Lower keys for commands not operating on all the marked files
-    (define-key map "d" 'dired-flag-file-deletion)
-    (define-key map "e" 'dired-find-file)
-    (define-key map "f" 'dired-find-file)
-    (define-key map "\C-m" 'dired-advertised-find-file)
-    (define-key map "g" 'revert-buffer)
-    (define-key map "h" 'describe-mode)
-    (define-key map "i" 'dired-maybe-insert-subdir)
-    (define-key map "k" 'dired-do-kill-lines)
-    (define-key map "l" 'dired-do-redisplay)
-    (define-key map "m" 'dired-mark)
-    (define-key map "n" 'dired-next-line)
-    (define-key map "o" 'dired-find-file-other-window)
-    (define-key map "\C-o" 'dired-display-file)
-    (define-key map "p" 'dired-previous-line)
-    (define-key map "q" 'dired-quit)
-    (define-key map "s" 'dired-sort-toggle-or-edit)
-    (define-key map "u" 'dired-unmark)
-    (define-key map "v" 'dired-view-file)
-    (define-key map "x" 'dired-do-flagged-delete)
-    (define-key map "+" 'dired-create-directory)
-    ;; moving
-    (define-key map "<" 'dired-prev-dirline)
-    (define-key map ">" 'dired-next-dirline)
-    (define-key map "^" 'dired-up-directory)
-    (define-key map " "  'dired-next-line)
-    (define-key map "\C-n" 'dired-next-line)
-    (define-key map "\C-p" 'dired-previous-line)
-    (define-key map [down] 'dired-next-line)
-    (define-key map [up] 'dired-previous-line)
-    ;; hiding
-    (define-key map "$" 'dired-hide-subdir)
-    (define-key map "\M-$" 'dired-hide-all)
-    ;; misc
-    (define-key map "?" 'dired-summary)
-    (define-key map "\177" 'dired-unmark-backward)
-    (define-key map "\C-_" 'dired-undo)
-    (define-key map "\C-xu" 'dired-undo)
-
-    ;; Make menu bar items.
-
-    ;; Get rid of the Edit menu bar item to save space.
-    (define-key map [menu-bar edit] 'undefined)
-
-    (define-key map [menu-bar subdir]
-      (cons "Subdir" (make-sparse-keymap "Subdir")))
-
-    (define-key map [menu-bar subdir hide-all]
-      '("Hide All" . dired-hide-all))
-    (define-key map [menu-bar subdir hide-subdir]
-      '("Hide Subdir" . dired-hide-subdir))
-    (define-key map [menu-bar subdir tree-down]
-      '("Tree Down" . dired-tree-down))
-    (define-key map [menu-bar subdir tree-up]
-      '("Tree Up" . dired-tree-up))
-    (define-key map [menu-bar subdir up]
-      '("Up Directory" . dired-up-directory))
-    (define-key map [menu-bar subdir prev-subdir]
-      '("Prev Subdir" . dired-prev-subdir))
-    (define-key map [menu-bar subdir next-subdir]
-      '("Next Subdir" . dired-next-subdir))
-    (define-key map [menu-bar subdir prev-dirline]
-      '("Prev Dirline" . dired-prev-dirline))
-    (define-key map [menu-bar subdir next-dirline]
-      '("Next Dirline" . dired-next-dirline))
-    (define-key map [menu-bar subdir insert]
-      '("Insert This Subdir" . dired-maybe-insert-subdir))
-
-    (define-key map [menu-bar immediate]
-      (cons "Immediate" (make-sparse-keymap "Immediate")))
-
-    (define-key map [menu-bar immediate revert-buffer]
-      '("Update Buffer" . revert-buffer))
-
-    (define-key map [menu-bar immediate dashes]
-      '("--"))
-
-    (define-key map [menu-bar immediate backup-diff]
-      '("Compare with Backup" . dired-backup-diff))
-    (define-key map [menu-bar immediate diff]
-      '("Diff" . dired-diff))
-    (define-key map [menu-bar immediate view]
-      '("View This File" . dired-view-file))
-    (define-key map [menu-bar immediate display]
-      '("Display in Other Window" . dired-display-file))
-    (define-key map [menu-bar immediate find-file-other-window]
-      '("Find in Other Window" . dired-find-file-other-window))
-    (define-key map [menu-bar immediate find-file]
-      '("Find This File" . dired-find-file))
-    (define-key map [menu-bar immediate create-directory]
-      '("Create Directory..." . dired-create-directory))
-
-    (define-key map [menu-bar regexp]
-      (cons "Regexp" (make-sparse-keymap "Regexp")))
-
-    (define-key map [menu-bar regexp downcase]
-      '("Downcase" . dired-downcase))
-    (define-key map [menu-bar regexp upcase]
-      '("Upcase" . dired-upcase))
-    (define-key map [menu-bar regexp hardlink]
-      '("Hardlink..." . dired-do-hardlink-regexp))
-    (define-key map [menu-bar regexp symlink]
-      '("Symlink..." . dired-do-symlink-regexp))
-    (define-key map [menu-bar regexp rename]
-      '("Rename..." . dired-do-rename-regexp))
-    (define-key map [menu-bar regexp copy]
-      '("Copy..." . dired-do-copy-regexp))
-    (define-key map [menu-bar regexp flag]
-      '("Flag..." . dired-flag-files-regexp))
-    (define-key map [menu-bar regexp mark]
-      '("Mark..." . dired-mark-files-regexp))
-
-    (define-key map [menu-bar mark]
-      (cons "Mark" (make-sparse-keymap "Mark")))
-
-    (define-key map [menu-bar mark prev]
-      '("Previous Marked" . dired-prev-marked-file))
-    (define-key map [menu-bar mark next]
-      '("Next Marked" . dired-next-marked-file))
-    (define-key map [menu-bar mark marks]
-      '("Change Marks..." . dired-change-marks))
-    (define-key map [menu-bar mark unmark-all]
-      '("Unmark All" . dired-unmark-all-files-no-query))
-    (define-key map [menu-bar mark symlinks]
-      '("Mark Symlinks" . dired-mark-symlinks))
-    (define-key map [menu-bar mark directories]
-      '("Mark Directories" . dired-mark-directories))
-    (define-key map [menu-bar mark directory]
-      '("Mark Old Backups" . dired-clean-directory))
-    (define-key map [menu-bar mark executables]
-      '("Mark Executables" . dired-mark-executables))
-    (define-key map [menu-bar mark garbage-files]
-      '("Flag Garbage Files" . dired-flag-garbage-files))
-    (define-key map [menu-bar mark backup-files]
-      '("Flag Backup Files" . dired-flag-backup-files))
-    (define-key map [menu-bar mark auto-save-files]
-      '("Flag Auto-save Files" . dired-flag-auto-save-files))
-    (define-key map [menu-bar mark deletion]
-      '("Flag" . dired-flag-file-deletion))
-    (define-key map [menu-bar mark unmark]
-      '("Unmark" . dired-unmark))
-    (define-key map [menu-bar mark mark]
-      '("Mark" . dired-mark))
-
-    (define-key map [menu-bar operate]
-      (cons "Operate" (make-sparse-keymap "Operate")))
-
-    (define-key map [menu-bar operate query-replace]
-      '("Query Replace in Files..." . dired-do-query-replace))
-    (define-key map [menu-bar operate search]
-      '("Search Files..." . dired-do-search))
-    (define-key map [menu-bar operate chown]
-      '("Change Owner..." . dired-do-chown))
-    (define-key map [menu-bar operate chgrp]
-      '("Change Group..." . dired-do-chgrp))
-    (define-key map [menu-bar operate chmod]
-      '("Change Mode..." . dired-do-chmod))
-    (define-key map [menu-bar operate load]
-      '("Load" . dired-do-load))
-    (define-key map [menu-bar operate compile]
-      '("Byte-compile" . dired-do-byte-compile))
-    (define-key map [menu-bar operate compress]
-      '("Compress" . dired-do-compress))
-    (define-key map [menu-bar operate print]
-      '("Print" . dired-do-print))
-    (define-key map [menu-bar operate hardlink]
-      '("Hardlink to..." . dired-do-hardlink))
-    (define-key map [menu-bar operate symlink]
-      '("Symlink to..." . dired-do-symlink))
-    (define-key map [menu-bar operate command]
-      '("Shell Command..." . dired-do-shell-command))
-    (define-key map [menu-bar operate delete]
-      '("Delete" . dired-do-delete))
-    (define-key map [menu-bar operate rename]
-      '("Rename to..." . dired-do-rename))
-    (define-key map [menu-bar operate copy]
-      '("Copy to..." . dired-do-copy))
-
-    (setq dired-mode-map map)))
-
-;; Dired mode is suitable only for specially formatted data.
-(put 'dired-mode 'mode-class 'special)
-
-(defun dired-mode (&optional dirname switches)
-  "\
-Mode for \"editing\" directory listings.
-In dired, you are \"editing\" a list of the files in a directory and
-  \(optionally) its subdirectories, in the format of `ls -lR'.
-  Each directory is a page: use \\[backward-page] and \\[forward-page] to move pagewise.
-\"Editing\" means that you can run shell commands on files, visit,
-  compress, load or byte-compile them, change their file attributes
-  and insert subdirectories into the same buffer.  You can \"mark\"
-  files for later commands or \"flag\" them for deletion, either file
-  by file or all files matching certain criteria.
-You can move using the usual cursor motion commands.\\<dired-mode-map>
-Letters no longer insert themselves.  Digits are prefix arguments.
-Instead, type \\[dired-flag-file-deletion] to flag a file for Deletion.
-Type \\[dired-mark] to Mark a file or subdirectory for later commands.
-  Most commands operate on the marked files and use the current file
-  if no files are marked.  Use a numeric prefix argument to operate on
-  the next ARG (or previous -ARG if ARG<0) files, or just `1'
-  to operate on the current file only.  Prefix arguments override marks.
-  Mark-using commands display a list of failures afterwards.  Type \\[dired-summary]
-  to see why something went wrong.
-Type \\[dired-unmark] to Unmark a file or all files of a subdirectory.
-Type \\[dired-unmark-backward] to back up one line and unflag.
-Type \\[dired-do-flagged-delete] to eXecute the deletions requested.
-Type \\[dired-advertised-find-file] to Find the current line's file
-  (or dired it in another buffer, if it is a directory).
-Type \\[dired-find-file-other-window] to find file or dired directory in Other window.
-Type \\[dired-maybe-insert-subdir] to Insert a subdirectory in this buffer.
-Type \\[dired-do-rename] to Rename a file or move the marked files to another directory.
-Type \\[dired-do-copy] to Copy files.
-Type \\[dired-sort-toggle-or-edit] to toggle sorting by name/date or change the `ls' switches.
-Type \\[revert-buffer] to read all currently expanded directories again.
-  This retains all marks and hides subdirs again that were hidden before.
-SPC and DEL can be used to move down and up by lines.
-
-If dired ever gets confused, you can either type \\[revert-buffer] \
-to read the
-directories again, type \\[dired-do-redisplay] \
-to relist a single or the marked files or a
-subdirectory, or type \\[dired-build-subdir-alist] to parse the buffer
-again for the directory tree.
-
-Customization variables (rename this buffer and type \\[describe-variable] on each line
-for more info):
-
-  dired-listing-switches
-  dired-trivial-filenames
-  dired-shrink-to-fit
-  dired-marker-char
-  dired-del-marker
-  dired-keep-marker-rename
-  dired-keep-marker-copy
-  dired-keep-marker-hardlink
-  dired-keep-marker-symlink
-
-Hooks (use \\[describe-variable] to see their documentation):
-
-  dired-before-readin-hook
-  dired-after-readin-hook
-  dired-mode-hook
-  dired-load-hook
-
-Keybindings:
-\\{dired-mode-map}"
-  ;; Not to be called interactively (e.g. dired-directory will be set
-  ;; to default-directory, which is wrong with wildcards).
-  (kill-all-local-variables)
-  (use-local-map dired-mode-map)
-  (dired-advertise)			; default-directory is already set
-  (setq major-mode 'dired-mode
-	mode-name "Dired"
-;;	case-fold-search nil
-	buffer-read-only t
-	selective-display t		; for subdirectory hiding
-	mode-line-buffer-identification '("Dired: %17b"))
-  (set (make-local-variable 'revert-buffer-function)
-       (function dired-revert))
-  (set (make-local-variable 'page-delimiter)
-       "\n\n")
-  (set (make-local-variable 'dired-directory)
-       (or dirname default-directory))
-  ;; list-buffers uses this to display the dir being edited in this buffer.
-  (set (make-local-variable 'list-buffers-directory)
-       (expand-file-name dired-directory))
-  (set (make-local-variable 'dired-actual-switches)
-       (or switches dired-listing-switches))
-  (set (make-local-variable 'font-lock-defaults) '(dired-font-lock-keywords t))
-  (dired-sort-other dired-actual-switches t)
-  (run-hooks 'dired-mode-hook))
-
-;; Idiosyncratic dired commands that don't deal with marks.
-
-(defun dired-quit ()
-  "Bury the current dired buffer."
-  (interactive)
-  (bury-buffer))
-
-(defun dired-summary ()
-  "Summarize basic Dired commands and show recent Dired errors."
-  (interactive)
-  (dired-why)
-  ;>> this should check the key-bindings and use substitute-command-keys if non-standard
-  (message
-   "d-elete, u-ndelete, x-punge, f-ind, o-ther window, R-ename, C-opy, h-elp"))
-
-(defun dired-undo ()
-  "Undo in a dired buffer.
-This doesn't recover lost files, it just undoes changes in the buffer itself.
-You can use it to recover marks, killed lines or subdirs.
-In the latter case, you have to do \\[dired-build-subdir-alist] to
-parse the buffer again."
-  (interactive)
-  (let (buffer-read-only)
-    (undo)))
-
-(defun dired-next-line (arg)
-  "Move down lines then position at filename.
-Optional prefix ARG says how many lines to move; default is one line."
-  (interactive "p")
-  (next-line arg)
-  (dired-move-to-filename))
-
-(defun dired-previous-line (arg)
-  "Move up lines then position at filename.
-Optional prefix ARG says how many lines to move; default is one line."
-  (interactive "p")
-  (previous-line arg)
-  (dired-move-to-filename))
-
-(defun dired-next-dirline (arg &optional opoint)
-  "Goto ARG'th next directory file line."
-  (interactive "p")
-  (or opoint (setq opoint (point)))
-  (if (if (> arg 0)
-	  (re-search-forward dired-re-dir nil t arg)
-	(beginning-of-line)
-	(re-search-backward dired-re-dir nil t (- arg)))
-      (dired-move-to-filename)		; user may type `i' or `f'
-    (goto-char opoint)
-    (error "No more subdirectories")))
-
-(defun dired-prev-dirline (arg)
-  "Goto ARG'th previous directory file line."
-  (interactive "p")
-  (dired-next-dirline (- arg)))
-
-(defun dired-up-directory (&optional other-window)
-  "Run dired on parent directory of current directory.
-Find the parent directory either in this buffer or another buffer.
-Creates a buffer if necessary."
-  (interactive "P")
-  (let* ((dir (dired-current-directory))
-	 (up (file-name-directory (directory-file-name dir))))
-    (or (dired-goto-file (directory-file-name dir))
-	;; Only try dired-goto-subdir if buffer has more than one dir.
-	(and (cdr dired-subdir-alist)
-	     (dired-goto-subdir up))
-	(progn
-	  (if other-window
-	      (dired-other-window up)
-	    (dired up))
-	  (dired-goto-file dir)))))
-
-;; Force `f' rather than `e' in the mode doc:
-(defalias 'dired-advertised-find-file 'dired-find-file)
-(defun dired-find-file ()
-  "In dired, visit the file or directory named on this line."
-  (interactive)
-  (let ((file-name (file-name-sans-versions (dired-get-filename) t)))
-    (if (file-exists-p file-name)
-	(find-file file-name)
-      (error "File no longer exists; type `g' to update Dired buffer"))))
-
-(defun dired-mouse-find-file-other-window (event)
-  "In dired, visit the file or directory name you click on."
-  (interactive "e")
-  (let (file)
-    (save-excursion
-      (set-buffer (window-buffer (posn-window (event-end event))))
-      (save-excursion
-	(goto-char (posn-point (event-end event)))
-	(setq file (dired-get-filename))))
-    (select-window (posn-window (event-end event)))
-    (find-file-other-window (file-name-sans-versions file t))))
-
-(defun dired-view-file ()
-  "In dired, examine a file in view mode, returning to dired when done.
-When file is a directory, show it in this buffer if it is inserted;
-otherwise, display it in another buffer."
-  (interactive)
-  (if (file-directory-p (dired-get-filename))
-      (or (and (cdr dired-subdir-alist)
-	       (dired-goto-subdir (dired-get-filename)))
-	  (dired (dired-get-filename)))
-    (view-file (dired-get-filename))))
-
-(defun dired-find-file-other-window ()
-  "In dired, visit this file or directory in another window."
-  (interactive)
-  (find-file-other-window (file-name-sans-versions (dired-get-filename) t)))
-
-(defun dired-display-file ()
-  "In dired, display this file or directory in another window."
-  (interactive)
-  (let ((file (file-name-sans-versions (dired-get-filename) t)))
-    (display-buffer (find-file-noselect file))))
-
-;;; Functions for extracting and manipulating file names in dired buffers.
-
-(defun dired-get-filename (&optional localp no-error-if-not-filep)
-  "In dired, return name of file mentioned on this line.
-Value returned normally includes the directory name.
-Optional arg LOCALP with value `no-dir' means don't include directory
-  name in result.  A value of t means construct name relative to
-  `default-directory', which still may contain slashes if in a subdirectory.
-Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on
-  this line, otherwise an error occurs."
-  (let (case-fold-search file p1 p2)
-    (save-excursion
-      (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
-	  (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
-    ;; nil if no file on this line, but no-error-if-not-filep is t:
-    (if (setq file (and p1 p2 (buffer-substring p1 p2)))
-	(progn
-	  ;; Get rid of the mouse-face property that file names have.
-	  (set-text-properties 0 (length file) nil file)
-	  ;; Unquote names quoted by ls or by dired-insert-directory.
-	  ;; Using read to unquote is much faster than substituting
-	  ;; \007 (4 chars) -> ^G  (1 char) etc. in a lisp loop.
-	  (setq file
-		(read
-		 (concat "\""
-			 ;; some ls -b don't escape quotes, argh!
-			 ;; This is not needed for GNU ls, though.
-			 (or (dired-string-replace-match
-			      "\\([^\\]\\|\\`\\)\"" file "\\1\\\\\"" nil t)
-			     file)
-			 "\"")))))
-    (if (eq localp 'no-dir)
-	file
-      (and file (concat (dired-current-directory localp) file)))))
-
-(defun dired-string-replace-match (regexp string newtext
-					  &optional literal global)
-  "Replace first match of REGEXP in STRING with NEWTEXT.
-If it does not match, nil is returned instead of the new string.
-Optional arg LITERAL means to take NEWTEXT literally.
-Optional arg GLOBAL means to replace all matches."
-  (if global
-      (let ((start 0))
-	(while (string-match regexp string start)
-	  (let ((from-end (- (length string) (match-end 0))))
-	    (setq string (replace-match newtext t literal string))
-	    (setq start (- (length string) from-end))))
-	  string)
-    (if (not (string-match regexp string 0))
-	nil
-      (replace-match newtext t literal string))))
-
-(defun dired-make-absolute (file &optional dir)
-  ;;"Convert FILE (a pathname relative to DIR) to an absolute pathname."
-  ;; We can't always use expand-file-name as this would get rid of `.'
-  ;; or expand in / instead default-directory if DIR=="".
-  ;; This should be good enough for ange-ftp, but might easily be
-  ;; redefined (for VMS?).
-  ;; It should be reasonably fast, though, as it is called in
-  ;; dired-get-filename.
-  (concat (or dir default-directory) file))
-
-(defun dired-make-relative (file &optional dir ignore)
-  "Convert FILE (an absolute file name) to a name relative to DIR.
-If this is impossible, return FILE unchanged.
-DIR must be a directory name, not a file name."
-  (or dir (setq dir default-directory))
-  ;; This case comes into play if default-directory is set to
-  ;; use ~.
-  (if (and (> (length dir) 0) (= (aref dir 0) ?~))
-      (setq dir (expand-file-name dir)))
-  (if (string-match (concat "^" (regexp-quote dir)) file)
-      (substring file (match-end 0))
-;;; (or no-error
-;;;	(error "%s: not in directory tree growing at %s" file dir))
-    file))
-
-;;; Functions for finding the file name in a dired buffer line.
-
-(defvar dired-move-to-filename-regexp
-  " [A-Za-z\xa0-\xff][A-Za-z\xa0-\xff][A-Za-z\xa0-\xff] [0-3 ][0-9]\
- [ 0-9][0-9][:0-9][0-9][ 0-9] "
-  "Regular expression to match a month abbreviation followed date/time.")
-
-(defvar dired-permission-flags-regexp
-  "\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"
-  "Regular expression to match the permission flags in `ls -l'.")
-
-;; Move to first char of filename on this line.
-;; Returns position (point) or nil if no filename on this line."
-(defun dired-move-to-filename (&optional raise-error eol)
-  ;; This is the UNIX version.
-  (or eol (setq eol (progn (end-of-line) (point))))
-  (beginning-of-line)
-  (if (re-search-forward dired-move-to-filename-regexp eol t)
-      (goto-char (match-end 0))
-    (if raise-error
-	(error "No file on this line"))))
-
-(defun dired-move-to-end-of-filename (&optional no-error)
-  ;; Assumes point is at beginning of filename,
-  ;; thus the rwx bit re-search-backward below will succeed in *this*
-  ;; line if at all.  So, it should be called only after
-  ;; (dired-move-to-filename t).
-  ;; On failure, signals an error (with non-nil NO-ERROR just returns nil).
-  ;; This is the UNIX version.
-  (let (opoint file-type executable symlink hidden case-fold-search used-F eol)
-    ;; case-fold-search is nil now, so we can test for capital F:
-    (setq used-F (string-match "F" dired-actual-switches)
-	  opoint (point)
-          eol (save-excursion (end-of-line) (point))
-	  hidden (and selective-display
-		      (save-excursion (search-forward "\r" eol t))))
-    (if hidden
-	nil
-      (save-excursion;; Find out what kind of file this is:
-	;; Restrict perm bits to be non-blank,
-	;; otherwise this matches one char to early (looking backward):
-	;; "l---------" (some systems make symlinks that way)
-	;; "----------" (plain file with zero perms)
-	(if (re-search-backward
-	     dired-permission-flags-regexp nil t)
-	    (setq file-type (char-after (match-beginning 1))
-		  symlink (eq file-type ?l)
-		  ;; Only with -F we need to know whether it's an executable
-		  executable (and
-			      used-F
-			      (string-match
-			       "[xst]";; execute bit set anywhere?
-			       (concat
-				(buffer-substring (match-beginning 2)
-						  (match-end 2))
-				(buffer-substring (match-beginning 3)
-						  (match-end 3))
-				(buffer-substring (match-beginning 4)
-						  (match-end 4))))))
-	  (or no-error (error "No file on this line"))))
-      ;; Move point to end of name:
-      (if symlink
-	  (if (search-forward " ->" eol t)
-	      (progn
-		(forward-char -3)
-		(and used-F
-		     dired-ls-F-marks-symlinks
-		     (eq (preceding-char) ?@);; did ls really mark the link?
-		     (forward-char -1))))
-	(goto-char eol);; else not a symbolic link
-	;; ls -lF marks dirs, sockets and executables with exactly one
-	;; trailing character. (Executable bits on symlinks ain't mean
-	;; a thing, even to ls, but we know it's not a symlink.)
-	(and used-F
-	     (or (memq file-type '(?d ?s))
-		 executable)
-	     (forward-char -1))))
-    (or no-error
-	(not (eq opoint (point)))
-	(error (if hidden
-		   (substitute-command-keys
-		    "File line is hidden, type \\[dired-hide-subdir] to unhide")
-		 "No file on this line")))
-    (if (eq opoint (point))
-	nil
-      (point))))
-
-
-;; Keeping Dired buffers in sync with the filesystem and with each other
-
-(defvar dired-buffers nil
-  ;; Enlarged by dired-advertise
-  ;; Queried by function dired-buffers-for-dir. When this detects a
-  ;; killed buffer, it is removed from this list.
-  "Alist of expanded directories and their associated dired buffers.")
-
-(defun dired-buffers-for-dir (dir)
-;; Return a list of buffers that dired DIR (top level or in-situ subdir).
-;; The list is in reverse order of buffer creation, most recent last.
-;; As a side effect, killed dired buffers for DIR are removed from
-;; dired-buffers.
-  (setq dir (file-name-as-directory dir))
-  (let ((alist dired-buffers) result elt buf)
-    (while alist
-      (setq elt (car alist)
-	    buf (cdr elt))
-      (if (buffer-name buf)
-	  (if (dired-in-this-tree dir (car elt))
-	      (if (assoc dir (save-excursion
-			       (set-buffer buf)
-			       dired-subdir-alist))
-		  (setq result (cons buf result))))
-	;; else buffer is killed - clean up:
-	(setq dired-buffers (delq elt dired-buffers)))
-      (setq alist (cdr alist)))
-    result))
-
-(defun dired-advertise ()
-  ;;"Advertise in variable `dired-buffers' that we dired `default-directory'."
-  ;; With wildcards we actually advertise too much.
-  (let ((expanded-default (expand-file-name default-directory)))
-    (if (memq (current-buffer) (dired-buffers-for-dir expanded-default))
-	t				; we have already advertised ourselves
-      (setq dired-buffers
-	    (cons (cons expanded-default (current-buffer))
-		  dired-buffers)))))
-
-(defun dired-unadvertise (dir)
-  ;; Remove DIR from the buffer alist in variable dired-buffers.
-  ;; This has the effect of removing any buffer whose main directory is DIR.
-  ;; It does not affect buffers in which DIR is a subdir.
-  ;; Removing is also done as a side-effect in dired-buffer-for-dir.
-  (setq dired-buffers
-	(delq (assoc (expand-file-name dir) dired-buffers) dired-buffers)))
-
-;; Tree Dired
-
-;;; utility functions
-
-(defun dired-in-this-tree (file dir)
-  ;;"Is FILE part of the directory tree starting at DIR?"
-  (let (case-fold-search)
-    (string-match (concat "^" (regexp-quote dir)) file)))
-
-(defun dired-normalize-subdir (dir)
-  ;; Prepend default-directory to DIR if relative path name.
-  ;; dired-get-filename must be able to make a valid filename from a
-  ;; file and its directory DIR.
-  (file-name-as-directory
-   (if (file-name-absolute-p dir)
-       dir
-     (expand-file-name dir default-directory))))
-
-(defun dired-get-subdir ()
-  ;;"Return the subdir name on this line, or nil if not on a headerline."
-  ;; Look up in the alist whether this is a headerline.
-  (save-excursion
-    (let ((cur-dir (dired-current-directory)))
-      (beginning-of-line)		; alist stores b-o-l positions
-      (and (zerop (- (point)
-		     (dired-get-subdir-min (assoc cur-dir
-						  dired-subdir-alist))))
-	   cur-dir))))
-
-;(defun dired-get-subdir-min (elt)
-;  (cdr elt))
-;; can't use macro,  must be redefinable for other alist format in dired-nstd.
-(defalias 'dired-get-subdir-min 'cdr)
-
-(defun dired-get-subdir-max (elt)
-  (save-excursion
-    (goto-char (dired-get-subdir-min elt))
-    (dired-subdir-max)))
-
-(defun dired-clear-alist ()
-  (while dired-subdir-alist
-    (set-marker (dired-get-subdir-min (car dired-subdir-alist)) nil)
-    (setq dired-subdir-alist (cdr dired-subdir-alist))))
-
-(defun dired-subdir-index (dir)
-  ;; Return an index into alist for use with nth
-  ;; for the sake of subdir moving commands.
-  (let (found (index 0) (alist dired-subdir-alist))
-    (while alist
-      (if (string= dir (car (car alist)))
-	  (setq alist nil found t)
-	(setq alist (cdr alist) index (1+ index))))
-    (if found index nil)))
-
-(defun dired-next-subdir (arg &optional no-error-if-not-found no-skip)
-  "Go to next subdirectory, regardless of level."
-  ;; Use 0 arg to go to this directory's header line.
-  ;; NO-SKIP prevents moving to end of header line, returning whatever
-  ;; position was found in dired-subdir-alist.
-  (interactive "p")
-  (let ((this-dir (dired-current-directory))
-	pos index)
-    ;; nth with negative arg does not return nil but the first element
-    (setq index (- (dired-subdir-index this-dir) arg))
-    (setq pos (if (>= index 0)
-		  (dired-get-subdir-min (nth index dired-subdir-alist))))
-    (if pos
-	(progn
-	  (goto-char pos)
-	  (or no-skip (skip-chars-forward "^\n\r"))
-	  (point))
-      (if no-error-if-not-found
-	  nil				; return nil if not found
-	(error "%s directory" (if (> arg 0) "Last" "First"))))))
-
-(defun dired-build-subdir-alist ()
-  "Build `dired-subdir-alist' by parsing the buffer.
-Returns the new value of the alist."
-  (interactive)
-  (dired-clear-alist)
-  (save-excursion
-    (let ((count 0)
-	  (buffer-read-only nil)
-	  new-dir-name)
-      (goto-char (point-min))
-      (setq dired-subdir-alist nil)
-      (while (and (re-search-forward dired-subdir-regexp nil t)
-		  ;; Avoid taking a file name ending in a colon
-		  ;; as a subdir name.
-		  (not (save-excursion
-			 (goto-char (match-beginning 0))
-			 (beginning-of-line)
-			 (forward-char 2)
-			 (save-match-data (looking-at dired-re-perms)))))
-	(save-excursion
-	  (goto-char (match-beginning 1))
-	  (setq new-dir-name
-		(expand-file-name (buffer-substring (point) (match-end 1))))
-	  (delete-region (point) (match-end 1))
-	  (insert new-dir-name))
-	(setq count (1+ count))
-	(dired-alist-add-1 new-dir-name
-			   ;; Place a sub directory boundary between lines.
-			   (save-excursion
-			     (goto-char (match-beginning 0))
-			     (beginning-of-line)
-			     (point-marker))))
-      (if (> count 1)
-	  (message "Buffer includes %d directories" count))
-      ;; We don't need to sort it because it is in buffer order per
-      ;; constructionem.  Return new alist:
-      dired-subdir-alist)))
-
-(defun dired-alist-add-1 (dir new-marker)
-  ;; Add new DIR at NEW-MARKER.  Don't sort.
-  (setq dired-subdir-alist
-	(cons (cons (dired-normalize-subdir dir) new-marker)
-	      dired-subdir-alist)))
-
-(defun dired-goto-next-nontrivial-file ()
-  ;; Position point on first nontrivial file after point.
-  (dired-goto-next-file);; so there is a file to compare with
-  (if (stringp dired-trivial-filenames)
-      (while (and (not (eobp))
-		  (string-match dired-trivial-filenames
-				(file-name-nondirectory
-				 (or (dired-get-filename nil t) ""))))
-	(forward-line 1)
-	(dired-move-to-filename))))
-
-(defun dired-goto-next-file ()
-  (let ((max (1- (dired-subdir-max))))
-    (while (and (not (dired-move-to-filename)) (< (point) max))
-      (forward-line 1))))
-
-(defun dired-goto-file (file)
-  "Go to file line of FILE in this dired buffer."
-  ;; Return value of point on success, else nil.
-  ;; FILE must be an absolute pathname.
-  ;; Loses if FILE contains control chars like "\007" for which ls
-  ;; either inserts "?" or "\\007" into the buffer, so we won't find
-  ;; it in the buffer.
-  (interactive
-   (prog1				; let push-mark display its message
-       (list (expand-file-name
-	      (read-file-name "Goto file: "
-			      (dired-current-directory))))
-     (push-mark)))
-  (setq file (directory-file-name file)) ; does no harm if no directory
-  (let (found case-fold-search dir)
-    (setq dir (or (file-name-directory file)
-		  (error "Need absolute pathname for %s" file)))
-    (save-excursion
-      ;; The hair here is to get the result of dired-goto-subdir
-      ;; without really calling it if we don't have any subdirs.
-      (if (if (string= dir (expand-file-name default-directory))
-	      (goto-char (point-min))
-	    (and (cdr dired-subdir-alist)
-		 (dired-goto-subdir dir)))
-	  (let ((base (file-name-nondirectory file))
-		(boundary (dired-subdir-max)))
-	    (while (and (not found)
-			;; filenames are preceded by SPC, this makes
-			;; the search faster (e.g. for the filename "-"!).
- 			(search-forward (concat " " base) boundary 'move))
-	      ;; Match could have BASE just as initial substring or
-	      ;; or in permission bits or date or
-	      ;; not be a proper filename at all:
-	      (if (equal base (dired-get-filename 'no-dir t))
-		    ;; Must move to filename since an (actually
-		    ;; correct) match could have been elsewhere on the
-		    ;; ;; line (e.g. "-" would match somewhere in the
-		    ;; permission bits).
-		  (setq found (dired-move-to-filename))
-		;; If this isn't the right line, move forward to avoid
-		;; trying this line again.
-		(forward-line 1))))))
-    (and found
-	 ;; return value of point (i.e., FOUND):
-	 (goto-char found))))
-
-(defun dired-initial-position (dirname)
-  ;; Where point should go in a new listing of DIRNAME.
-  ;; Point assumed at beginning of new subdir line.
-  ;; You may redefine this function as you wish, e.g. like in dired-x.el.
-  (end-of-line)
-  (if dired-trivial-filenames (dired-goto-next-nontrivial-file)))
-
-;; These are hooks which make tree dired work.
-;; They are in this file because other parts of dired need to call them.
-;; But they don't call the rest of tree dired unless there are subdirs loaded.
-
-;; This function is called for each retrieved filename.
-;; It could stand to be faster, though it's mostly function call
-;; overhead.  Avoiding the function call seems to save about 10% in
-;; dired-get-filename.  Make it a defsubst?
-(defun dired-current-directory (&optional localp)
-  "Return the name of the subdirectory to which this line belongs.
-This returns a string with trailing slash, like `default-directory'.
-Optional argument means return a file name relative to `default-directory'."
-  (let ((here (point))
-	(alist (or dired-subdir-alist
-		   ;; probably because called in a non-dired buffer
-		   (error "No subdir-alist in %s" (current-buffer))))
-	elt dir)
-    (while alist
-      (setq elt (car alist)
-	    dir (car elt)
-	    ;; use `<=' (not `<') as subdir line is part of subdir
-	    alist (if (<= (dired-get-subdir-min elt) here)
-		      nil		; found
-		    (cdr alist))))
-    (if localp
-	(dired-make-relative dir default-directory)
-      dir)))
-
-;; Subdirs start at the beginning of their header lines and end just
-;; before the beginning of the next header line (or end of buffer).
-
-(defun dired-subdir-max ()
-  (save-excursion
-    (if (or (null (cdr dired-subdir-alist)) (not (dired-next-subdir 1 t t)))
-	(point-max)
-      (point))))
-
-;; Deleting files
-
-(defun dired-do-flagged-delete (&optional nomessage)
-  "In dired, delete the files flagged for deletion.
-If NOMESSAGE is non-nil, we don't display any message
-if there are no flagged files."
-  (interactive)
-  (let* ((dired-marker-char dired-del-marker)
-	 (regexp (dired-marker-regexp))
-	 case-fold-search)
-    (if (save-excursion (goto-char (point-min))
-			(re-search-forward regexp nil t))
-	(dired-internal-do-deletions
-	 ;; this can't move point since ARG is nil
-	 (dired-map-over-marks (cons (dired-get-filename) (point))
-			       nil)
-	 nil)
-      (or nomessage
-	  (message "(No deletions requested)")))))
-
-(defun dired-do-delete (&optional arg)
-  "Delete all marked (or next ARG) files."
-  ;; This is more consistent with the file marking feature than
-  ;; dired-do-flagged-delete.
-  (interactive "P")
-  (dired-internal-do-deletions
-   ;; this may move point if ARG is an integer
-   (dired-map-over-marks (cons (dired-get-filename) (point))
-			 arg)
-   arg))
-
-(defvar dired-deletion-confirmer 'yes-or-no-p) ; or y-or-n-p?
-
-(defun dired-internal-do-deletions (l arg)
-  ;; L is an alist of files to delete, with their buffer positions.
-  ;; ARG is the prefix arg.
-  ;; Filenames are absolute (VMS needs this for logical search paths).
-  ;; (car L) *must* be the *last* (bottommost) file in the dired buffer.
-  ;; That way as changes are made in the buffer they do not shift the
-  ;; lines still to be changed, so the (point) values in L stay valid.
-  ;; Also, for subdirs in natural order, a subdir's files are deleted
-  ;; before the subdir itself - the other way around would not work.
-  (let ((files (mapcar (function car) l))
-	(count (length l))
-	(succ 0))
-    ;; canonicalize file list for pop up
-    (setq files (nreverse (mapcar (function dired-make-relative) files)))
-    (if (dired-mark-pop-up
-	 " *Deletions*" 'delete files dired-deletion-confirmer
-	 (format "Delete %s " (dired-mark-prompt arg files)))
-	(save-excursion
-	  (let (failures);; files better be in reverse order for this loop!
-	    (while l
-	      (goto-char (cdr (car l)))
-	      (let (buffer-read-only)
-		(condition-case err
-		    (let ((fn (car (car l))))
-		      ;; This test is equivalent to
-		      ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
-		      ;; but more efficient
-		      (if (eq t (car (file-attributes fn)))
-			  (delete-directory fn)
-			(delete-file fn))
-		      ;; if we get here, removing worked
-		      (setq succ (1+ succ))
-		      (message "%s of %s deletions" succ count)
-		      (delete-region (progn (beginning-of-line) (point))
-				     (progn (forward-line 1) (point)))
-		      (dired-clean-up-after-deletion fn))
-		  (error;; catch errors from failed deletions
-		   (dired-log "%s\n" err)
-		   (setq failures (cons (car (car l)) failures)))))
-	      (setq l (cdr l)))
-	    (if (not failures)
-		(message "%d deletion%s done" count (dired-plural-s count))
-	      (dired-log-summary
-	       (format "%d of %d deletion%s failed"
-		       (length failures) count
-		       (dired-plural-s count))
-	       failures))))
-      (message "(No deletions performed)")))
-  (dired-move-to-filename))
-
-;; This is a separate function for the sake of dired-x.el.
-(defun dired-clean-up-after-deletion (fn)
-  ;; Clean up after a deleted file or directory FN.
-  (save-excursion (and (cdr dired-subdir-alist)
-		       (dired-goto-subdir fn)
-		       (dired-kill-subdir))))
-
-;; Confirmation
-
-(defun dired-marker-regexp ()
-  (concat "^" (regexp-quote (char-to-string dired-marker-char))))
-
-(defun dired-plural-s (count)
-  (if (= 1 count) "" "s"))
-
-(defun dired-mark-prompt (arg files)
-  ;; Return a string for use in a prompt, either the current file
-  ;; name, or the marker and a count of marked files.
-  (let ((count (length files)))
-    (if (= count 1)
-	(car files)
-      ;; more than 1 file:
-      (if (integerp arg)
-	  ;; abs(arg) = count
-	  ;; Perhaps this is nicer, but it also takes more screen space:
-	  ;;(format "[%s %d files]" (if (> arg 0) "next" "previous")
-	  ;;                        count)
-	  (format "[next %d files]" arg)
-	(format "%c [%d files]" dired-marker-char count)))))
-
-(defun dired-pop-to-buffer (buf)
-  ;; Pop up buffer BUF.
-  ;; If dired-shrink-to-fit is t, make its window fit its contents.
-  (if (not dired-shrink-to-fit)
-      (pop-to-buffer (get-buffer-create buf))
-    ;; let window shrink to fit:
-    (let ((window (selected-window))
-	  target-lines w2)
-      (cond ;; if split-window-threshold is enabled, use the largest window
-            ((and (> (window-height (setq w2 (get-largest-window)))
-		     split-height-threshold)
-		  (= (frame-width) (window-width w2)))
-	     (setq window w2))
-	    ;; if the least-recently-used window is big enough, use it
-	    ((and (> (window-height (setq w2 (get-lru-window)))
-		     (* 2 window-min-height))
-		  (= (frame-width) (window-width w2)))
-	     (setq window w2)))
-      (save-excursion
-	(set-buffer buf)
-	(goto-char (point-max))
-	(skip-chars-backward "\n\r\t ")
-	(setq target-lines (count-lines (point-min) (point)))
-	;; Don't forget to count the last line.
-	(if (not (bolp))
-	    (setq target-lines (1+ target-lines))))
-      (if (<= (window-height window) (* 2 window-min-height))
-	  ;; At this point, every window on the frame is too small to split.
-	  (setq w2 (display-buffer buf))
-	(setq w2 (split-window window
-		  (max window-min-height
-		       (- (window-height window)
-			  (1+ (max window-min-height target-lines)))))))
-      (set-window-buffer w2 buf)
-      (if (< (1- (window-height w2)) target-lines)
-	  (progn
-	    (select-window w2)
-	    (enlarge-window (- target-lines (1- (window-height w2))))))
-      (set-window-start w2 1)
-      )))
-
-(defvar dired-no-confirm nil
-;;  "If non-nil, list of symbols for commands dired should not confirm.
-;;It can be a sublist of
-;;
-;;  '(byte-compile chgrp chmod chown compress copy delete hardlink load
-;;    move print shell symlink uncompress)"
-  )
-
-(defun dired-mark-pop-up (bufname op-symbol files function &rest args)
-  ;;"Args BUFNAME OP-SYMBOL FILES FUNCTION &rest ARGS.
-  ;;Return FUNCTION's result on ARGS after popping up a window (in a buffer
-  ;;named BUFNAME, nil gives \" *Marked Files*\") showing the marked
-  ;;files.  Uses function `dired-pop-to-buffer' to do that.
-  ;; FUNCTION should not manipulate files.
-  ;; It should only read input (an argument or confirmation).
-  ;;The window is not shown if there is just one file or
-  ;; OP-SYMBOL is a member of the list in `dired-no-confirm'.
-  ;;FILES is the list of marked files."
-  (or bufname (setq bufname  " *Marked Files*"))
-  (if (or (memq op-symbol dired-no-confirm)
-	  (= (length files) 1))
-      (apply function args)
-    (save-excursion
-      (set-buffer (get-buffer-create bufname))
-      (erase-buffer)
-      (dired-format-columns-of-files files)
-      (remove-text-properties (point-min) (point-max) '(mouse-face)))
-    (save-window-excursion
-      (dired-pop-to-buffer bufname)
-      (apply function args))))
-
-(defun dired-format-columns-of-files (files)
-  ;; Files should be in forward order for this loop.
-  ;; i.e., (car files) = first file in buffer.
-  ;; Returns the number of lines used.
-  (let* ((maxlen (+ 2 (apply 'max (mapcar 'length files))))
-	 (width (- (window-width (selected-window)) 2))
-	 (columns (max 1 (/ width maxlen)))
-	 (nfiles (length files))
-	 (rows (+ (/ nfiles columns)
-		  (if (zerop (% nfiles columns)) 0 1)))
-	 (i 0)
-	 (j 0))
-    (setq files (nconc (copy-sequence files) ; fill up with empty fns
-		       (make-list (- (* columns rows) nfiles) "")))
-    (setcdr (nthcdr (1- (length files)) files) files) ; make circular
-    (while (< j rows)
-      (while (< i columns)
-	(indent-to (* i maxlen))
-	(insert (car files))
-	(setq files (nthcdr rows files)
-	      i (1+ i)))
-      (insert "\n")
-      (setq i 0
-	    j (1+ j)
-	    files (cdr files)))
-    rows))
-
-;; Commands to mark or flag file(s) at or near current line.
-
-(defun dired-repeat-over-lines (arg function)
-  ;; This version skips non-file lines.
-  (let ((pos (make-marker)))
-    (beginning-of-line)
-    (while (and (> arg 0) (not (eobp)))
-      (setq arg (1- arg))
-      (beginning-of-line)
-      (while (and (not (eobp)) (dired-between-files)) (forward-line 1))
-      (save-excursion
-	(forward-line 1)
-	(move-marker pos (1+ (point))))
-      (save-excursion (funcall function))
-      ;; Advance to the next line--actually, to the line that *was* next.
-      ;; (If FUNCTION inserted some new lines in between, skip them.)
-      (goto-char pos))
-    (while (and (< arg 0) (not (bobp)))
-      (setq arg (1+ arg))
-      (forward-line -1)
-      (while (and (not (bobp)) (dired-between-files)) (forward-line -1))
-      (beginning-of-line)
-      (save-excursion (funcall function)))
-    (move-marker pos nil)
-    (dired-move-to-filename)))
-
-(defun dired-between-files ()
-  ;; Point must be at beginning of line
-  ;; Should be equivalent to (save-excursion (not (dired-move-to-filename)))
-  ;; but is about 1.5..2.0 times as fast. (Actually that's not worth it)
-  (or (looking-at "^$\\|^. *$\\|^. total\\|^. wildcard")
-      (and (looking-at dired-subdir-regexp)
-	   (save-excursion (not (dired-move-to-filename))))))
-
-(defun dired-next-marked-file (arg &optional wrap opoint)
-  "Move to the next marked file, wrapping around the end of the buffer."
-  (interactive "p\np")
-  (or opoint (setq opoint (point)));; return to where interactively started
-  (if (if (> arg 0)
-	  (re-search-forward dired-re-mark nil t arg)
-	(beginning-of-line)
-	(re-search-backward dired-re-mark nil t (- arg)))
-      (dired-move-to-filename)
-    (if (null wrap)
-	(progn
-	  (goto-char opoint)
-	  (error "No next marked file"))
-      (message "(Wraparound for next marked file)")
-      (goto-char (if (> arg 0) (point-min) (point-max)))
-      (dired-next-marked-file arg nil opoint))))
-
-(defun dired-prev-marked-file (arg &optional wrap)
-  "Move to the previous marked file, wrapping around the end of the buffer."
-  (interactive "p\np")
-  (dired-next-marked-file (- arg) wrap))
-
-(defun dired-file-marker (file)
-  ;; Return FILE's marker, or nil if unmarked.
-  (save-excursion
-    (and (dired-goto-file file)
-	 (progn
-	   (beginning-of-line)
-	   (if (not (equal ?\040 (following-char)))
-	       (following-char))))))
-
-(defun dired-mark-files-in-region (start end)
-  (let (buffer-read-only)
-    (if (> start end)
-	(error "start > end"))
-    (goto-char start)			; assumed at beginning of line
-    (while (< (point) end)
-      ;; Skip subdir line and following garbage like the `total' line:
-      (while (and (< (point) end) (dired-between-files))
-	(forward-line 1))
-      (if (and (not (looking-at dired-re-dot))
-	       (dired-get-filename nil t))
-	  (progn
-	    (delete-char 1)
-	    (insert dired-marker-char)))
-      (forward-line 1))))
-
-(defun dired-mark (arg)
-  "Mark the current (or next ARG) files.
-If on a subdir headerline, mark all its files except `.' and `..'.
-
-Use \\[dired-unmark-all-files] to remove all marks
-and \\[dired-unmark] on a subdir to remove the marks in
-this subdir."
-  (interactive "P")
-  (if (dired-get-subdir)
-      (save-excursion (dired-mark-subdir-files))
-    (let (buffer-read-only)
-      (dired-repeat-over-lines
-       (prefix-numeric-value arg)
-       (function (lambda () (delete-char 1) (insert dired-marker-char)))))))
-
-(defun dired-unmark (arg)
-  "Unmark the current (or next ARG) files.
-If looking at a subdir, unmark all its files except `.' and `..'."
-  (interactive "P")
-  (let ((dired-marker-char ?\040))
-    (dired-mark arg)))
-
-(defun dired-flag-file-deletion (arg)
-  "In dired, flag the current line's file for deletion.
-With prefix arg, repeat over several lines.
-
-If on a subdir headerline, mark all its files except `.' and `..'."
-  (interactive "P")
-  (let ((dired-marker-char dired-del-marker))
-    (dired-mark arg)))
-
-(defun dired-unmark-backward (arg)
-  "In dired, move up lines and remove deletion flag there.
-Optional prefix ARG says how many lines to unflag; default is one line."
-  (interactive "p")
-  (dired-unmark (- arg)))
-
-;;; Commands to mark or flag files based on their characteristics or names.
-
-(defvar dired-regexp-history nil
-  "History list of regular expressions used in Dired commands.")
-
-(defun dired-read-regexp (prompt)
-  (read-from-minibuffer prompt nil nil nil 'dired-regexp-history))
-
-(defun dired-mark-files-regexp (regexp &optional marker-char)
-  "Mark all files matching REGEXP for use in later commands.
-A prefix argument means to unmark them instead.
-`.' and `..' are never marked.
-
-REGEXP is an Emacs regexp, not a shell wildcard.  Thus, use `\\.o$' for
-object files--just `.o' will mark more than you might think."
-  (interactive
-   (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
-				    " files (regexp): "))
-	 (if current-prefix-arg ?\040)))
-  (let ((dired-marker-char (or marker-char dired-marker-char)))
-    (dired-mark-if
-     (and (not (looking-at dired-re-dot))
-	  (not (eolp))			; empty line
-	  (let ((fn (dired-get-filename nil t)))
-	    (and fn (string-match regexp (file-name-nondirectory fn)))))
-     "matching file")))
-
-(defun dired-flag-files-regexp (regexp)
-  "In dired, flag all files containing the specified REGEXP for deletion.
-The match is against the non-directory part of the filename.  Use `^'
-  and `$' to anchor matches.  Exclude subdirs by hiding them.
-`.' and `..' are never flagged."
-  (interactive (list (dired-read-regexp "Flag for deletion (regexp): ")))
-  (dired-mark-files-regexp regexp dired-del-marker))
-
-(defun dired-mark-symlinks (unflag-p)
-  "Mark all symbolic links.
-With prefix argument, unflag all those files."
-  (interactive "P")
-  (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
-    (dired-mark-if (looking-at dired-re-sym) "symbolic link")))
-
-(defun dired-mark-directories (unflag-p)
-  "Mark all directory file lines except `.' and `..'.
-With prefix argument, unflag all those files."
-  (interactive "P")
-  (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
-    (dired-mark-if (and (looking-at dired-re-dir)
-			(not (looking-at dired-re-dot)))
-		   "directory file")))
-
-(defun dired-mark-executables (unflag-p)
-  "Mark all executable files.
-With prefix argument, unflag all those files."
-  (interactive "P")
-  (let ((dired-marker-char (if unflag-p ?\040 dired-marker-char)))
-    (dired-mark-if (looking-at dired-re-exe) "executable file")))
-
-;; dired-x.el has a dired-mark-sexp interactive command: mark
-;; files for which PREDICATE returns non-nil.
-
-(defun dired-flag-auto-save-files (&optional unflag-p)
-  "Flag for deletion files whose names suggest they are auto save files.
-A prefix argument says to unflag those files instead."
-  (interactive "P")
-  (let ((dired-marker-char (if unflag-p ?\040 dired-del-marker)))
-    (dired-mark-if
-     ;; It is less than general to check for # here,
-     ;; but it's the only way this runs fast enough.
-     (and (save-excursion (end-of-line)
-                          (or
-                           (eq (preceding-char) ?#)
-                           ;; Handle executables in case of -F option.
-                           ;; We need not worry about the other kinds
-                           ;; of markings that -F makes, since they won't
-                           ;; appear on real auto-save files.
-                           (if (eq (preceding-char) ?*)
-                               (progn
-                                 (forward-char -1)
-                                 (eq (preceding-char) ?#)))))
-	  (not (looking-at dired-re-dir))
-	  (let ((fn (dired-get-filename t t)))
-	    (if fn (auto-save-file-name-p
-		    (file-name-nondirectory fn)))))
-     "auto save file")))
-
-(defvar dired-garbage-files-regexp
-  "\\.log$\\|\\.toc$\\|.dvi$|\\.bak$\\|\\.orig$\\|\\.rej$" 
-  "*Regular expression to match \"garbage\" files for `dired-flag-garbage-files'.")
-
-(defun dired-flag-garbage-files ()
-  (interactive)
-  "Flag for deletion all files that match `dired-garbage-files-regexp'."
-  (dired-flag-files-regexp dired-garbage-files-regexp))
-
-(defun dired-flag-backup-files (&optional unflag-p)
-  "Flag all backup files (names ending with `~') for deletion.
-With prefix argument, unflag these files."
-  (interactive "P")
-  (let ((dired-marker-char (if unflag-p ?\  dired-del-marker)))
-    (dired-mark-if
-     ;; Don't call backup-file-name-p unless the last character looks like
-     ;; it might be the end of a backup file name.  This isn't very general,
-     ;; but it's the only way this runs fast enough.
-     (and (save-excursion (end-of-line)
-			  ;; Handle executables in case of -F option.
-			  ;; We need not worry about the other kinds
-			  ;; of markings that -F makes, since they won't
-			  ;; appear on real backup files.
-			  (if (eq (preceding-char) ?*)
-			      (forward-char -1))
-			  (eq (preceding-char) ?~))
-	  (not (looking-at dired-re-dir))
-	  (let ((fn (dired-get-filename t t)))
-	    (if fn (backup-file-name-p fn))))
-     "backup file")))
-
-(defun dired-change-marks (&optional old new)
-  "Change all OLD marks to NEW marks.
-OLD and NEW are both characters used to mark files."
-  (interactive
-   (let* ((cursor-in-echo-area t)
-	  (old (progn (message "Change (old mark): ") (read-char)))
-	  (new (progn (message  "Change %c marks to (new mark): " old)
-		      (read-char))))
-     (list old new)))
-  (if (or (eq old ?\r) (eq new ?\r))
-      (ding)
-    (let ((string (format "\n%c" old))
-	  (buffer-read-only))
-      (save-excursion
-	(goto-char (point-min))
-	(while (search-forward string nil t)
-	  (if (if (= old ?\ )
-		  (save-match-data
-		    (dired-get-filename 'no-dir t))
-		t)
-	      (subst-char-in-region (match-beginning 0)
-				    (match-end 0) old new)))))))
-
-(defun dired-unmark-all-files-no-query ()
-  "Remove all marks from all files in the Dired buffer."
-  (interactive)
-  (dired-unmark-all-files ?\r))
-
-(defun dired-unmark-all-files (mark &optional arg)
-  "Remove a specific mark (or any mark) from every file.
-After this command, type the mark character to remove, 
-or type RET to remove all marks.
-With prefix arg, query for each marked file.
-Type \\[help-command] at that time for help."
-  (interactive "cRemove marks (RET means all): \nP")
-  (save-excursion
-    (let* ((count 0)
-	   buffer-read-only case-fold-search query
-	   (string (format "\n%c" mark))
-	   (help-form "\
-Type SPC or `y' to unmark one file, DEL or `n' to skip to next,
-`!' to unmark all remaining files with no more questions."))
-      (goto-char (point-min))
-      (while (if (eq mark ?\r)
-		 (re-search-forward dired-re-mark nil t)
-	       (search-forward string nil t))
-	(if (or (not arg)
-		(dired-query 'query "Unmark file `%s'? "
-			     (dired-get-filename t)))
-	    (progn (subst-char-in-region (1- (point)) (point)
-					 (preceding-char) ?\ )
-		   (setq count (1+ count)))))
-      (message (if (= count 1) "1 mark removed"
-		 "%d marks removed")
-	       count))))
-
-;; Logging failures operating on files, and showing the results.
-
-(defvar dired-log-buffer "*Dired log*")
-
-(defun dired-why ()
-  "Pop up a buffer with error log output from Dired.
-A group of errors from a single command ends with a formfeed.
-Thus, use \\[backward-page] to find the beginning of a group of errors."
-  (interactive)
-  (if (get-buffer dired-log-buffer)
-      (let ((owindow (selected-window))
-	    (window (display-buffer (get-buffer dired-log-buffer))))
-	(unwind-protect
-	    (progn
-	      (select-window window)
-	      (goto-char (point-max))
-	      (recenter -1))
-	  (select-window owindow)))))
-
-(defun dired-log (log &rest args)
-  ;; Log a message or the contents of a buffer.
-  ;; If LOG is a string and there are more args, it is formatted with
-  ;; those ARGS.  Usually the LOG string ends with a \n.
-  ;; End each bunch of errors with (dired-log t): this inserts
-  ;; current time and buffer, and a \f (formfeed).
-  (let ((obuf (current-buffer)))
-    (unwind-protect			; want to move point
-	(progn
-	  (set-buffer (get-buffer-create dired-log-buffer))
-	  (goto-char (point-max))
-	  (let (buffer-read-only)
-	    (cond ((stringp log)
-		   (insert (if args
-			       (apply (function format) log args)
-			     log)))
-		  ((bufferp log)
-		   (insert-buffer log))
-		  ((eq t log)
-		   (insert "\n\t" (current-time-string)
-			   "\tBuffer `" (buffer-name obuf) "'\n\f\n")))))
-      (set-buffer obuf))))
-
-(defun dired-log-summary (string failures)
-  (message (if failures "%s--type ? for details (%s)"
-	     "%s--type ? for details")
-	   string failures)
-  ;; Log a summary describing a bunch of errors.
-  (dired-log (concat "\n" string))
-  (dired-log t))
-
-;;; Sorting
-
-;; Most ls can only sort by name or by date (with -t), nothing else.
-;; GNU ls sorts on size with -S, on extension with -X, and unsorted with -U.
-;; So anything that does not contain these is sort "by name".
-
-(defvar dired-ls-sorting-switches "SXU"
-  "String of `ls' switches (single letters) except `t' that influence sorting.")
-
-(defvar dired-sort-by-date-regexp
-  (concat "^-[^" dired-ls-sorting-switches
-	  "]*t[^" dired-ls-sorting-switches "]*$")
-  "Regexp recognized by dired to set `by date' mode.")
-
-(defvar dired-sort-by-name-regexp
-  (concat "^-[^t" dired-ls-sorting-switches "]+$")
-  "Regexp recognized by dired to set `by name' mode.")
-
-(defun dired-sort-set-modeline ()
-  ;; Set modeline display according to dired-actual-switches.
-  ;; Modeline display of "by name" or "by date" guarantees the user a
-  ;; match with the corresponding regexps.  Non-matching switches are
-  ;; shown literally.
-  (setq mode-name
-	(let (case-fold-search)
-	  (cond ((string-match dired-sort-by-name-regexp dired-actual-switches)
-		 "Dired by name")
-		((string-match dired-sort-by-date-regexp dired-actual-switches)
-		 "Dired by date")
-		(t
-		 (concat "Dired " dired-actual-switches)))))
-  (force-mode-line-update))
-
-(defun dired-sort-toggle-or-edit (&optional arg)
-  "Toggle between sort by date/name and refresh the dired buffer.
-With a prefix argument you can edit the current listing switches instead."
-  (interactive "P")
-  (if arg
-      (dired-sort-other
-       (read-string "ls switches (must contain -l): " dired-actual-switches))
-    (dired-sort-toggle)))
-
-(defun dired-sort-toggle ()
-  ;; Toggle between sort by date/name.  Reverts the buffer.
-  (setq dired-actual-switches
-	(let (case-fold-search)
-	  (concat
-	   "-l"
-	   (dired-replace-in-string (concat "[-lt"
-					    dired-ls-sorting-switches "]")
-				    ""
-				    dired-actual-switches)
-	   (if (string-match (concat "[t" dired-ls-sorting-switches "]")
-			     dired-actual-switches)
-	       ""
-	     "t"))))
-  (dired-sort-set-modeline)
-  (revert-buffer))
-
-(defun dired-replace-in-string (regexp newtext string)
-  ;; Replace REGEXP with NEWTEXT everywhere in STRING and return result.
-  ;; NEWTEXT is taken literally---no \\DIGIT escapes will be recognized.
-  (let ((result "") (start 0) mb me)
-    (while (string-match regexp string start)
-      (setq mb (match-beginning 0)
-	    me (match-end 0)
-	    result (concat result (substring string start mb) newtext)
-	    start me))
-    (concat result (substring string start))))
-
-(defun dired-sort-other (switches &optional no-revert)
-  ;; Specify new ls SWITCHES for current dired buffer.  Values matching
-  ;; `dired-sort-by-date-regexp' or `dired-sort-by-name-regexp' set the
-  ;; minor mode accordingly, others appear literally in the mode line.
-  ;; With optional second arg NO-REVERT, don't refresh the listing afterwards.
-  (setq dired-actual-switches switches)
-  (if (eq major-mode 'dired-mode) (dired-sort-set-modeline))
-  (or no-revert (revert-buffer)))
-
-;; To make this file smaller, the less common commands
-;; go in a separate file.  But autoload them here
-;; to make the separation invisible.
-
-(autoload 'dired-diff "dired-aux"
-  "Compare file at point with file FILE using `diff'.
-FILE defaults to the file at the mark.
-The prompted-for file is the first file given to `diff'."
-  t)
-
-(autoload 'dired-backup-diff "dired-aux"
-  "Diff this file with its backup file or vice versa.
-Uses the latest backup, if there are several numerical backups.
-If this file is a backup, diff it with its original.
-The backup file is the first file given to `diff'."
-  t)
-
-(autoload 'dired-clean-directory "dired-aux"
-  "Flag numerical backups for deletion.
-Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
-Positive prefix arg KEEP overrides `dired-kept-versions';
-Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
-
-To clear the flags on these files, you can use \\[dired-flag-backup-files]
-with a prefix argument."
-  t)
-
-(autoload 'dired-do-chmod "dired-aux"
-  "Change the mode of the marked (or next ARG) files.
-This calls chmod, thus symbolic modes like `g+w' are allowed."
-  t)
-
-(autoload 'dired-do-chgrp "dired-aux"
-  "Change the group of the marked (or next ARG) files."
-  t)
-
-(autoload 'dired-do-chown "dired-aux"
-  "Change the owner of the marked (or next ARG) files."
-  t)
-
-(autoload 'dired-do-print "dired-aux"
-  "Print the marked (or next ARG) files.
-Uses the shell command coming from variables `lpr-command' and
-`lpr-switches' as default."
-  t)
-
-(autoload 'dired-do-shell-command "dired-aux"
-  "Run a shell command COMMAND on the marked files.
-If no files are marked or a specific numeric prefix arg is given,
-the next ARG files are used.  Just \\[universal-argument] means the current file.
-The prompt mentions the file(s) or the marker, as appropriate.
-
-If there is output, it goes to a separate buffer.
-
-Normally the command is run on each file individually.
-However, if there is a `*' in the command then it is run
-just once with the entire file list substituted there.
-
-No automatic redisplay of dired buffers is attempted, as there's no
-telling what files the command may have changed.  Type
-\\[dired-do-redisplay] to redisplay the marked files.
-
-The shell command has the top level directory as working directory, so
-output files usually are created there instead of in a subdir."
-  t)
-
-(autoload 'dired-do-kill-lines "dired-aux"
-  "Kill all marked lines (not the files).
-With a prefix arg, kill all lines not marked or flagged."
-  t)
-
-(autoload 'dired-do-compress "dired-aux"
-  "Compress or uncompress marked (or next ARG) files."
-  t)
-
-(autoload 'dired-do-byte-compile "dired-aux"
-  "Byte compile marked (or next ARG) Emacs Lisp files."
-  t)
-
-(autoload 'dired-do-load "dired-aux"
-  "Load the marked (or next ARG) Emacs Lisp files."
-  t)
-
-(autoload 'dired-do-redisplay "dired-aux"
-  "Redisplay all marked (or next ARG) files.
-If on a subdir line, redisplay that subdirectory.  In that case,
-a prefix arg lets you edit the `ls' switches used for the new listing."
-  t)
-
-(autoload 'dired-create-directory "dired-aux"
-  "Create a directory called DIRECTORY."
-  t)
-
-(autoload 'dired-do-copy "dired-aux"
-  "Copy all marked (or next ARG) files, or copy the current file.
-Thus, a zero prefix argument copies nothing.  But it toggles the
-variable `dired-copy-preserve-time' (which see)."
-  t)
-
-(autoload 'dired-do-symlink "dired-aux"
-  "Make symbolic links to current file or all marked (or next ARG) files.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory
-and new symbolic links are made in that directory
-with the same names that the files currently have."
-  t)
-
-(autoload 'dired-do-hardlink "dired-aux"
-  "Add names (hard links) current file or all marked (or next ARG) files.
-When operating on just the current file, you specify the new name.
-When operating on multiple or marked files, you specify a directory
-and new hard links are made in that directory
-with the same names that the files currently have."
-  t)
-
-(autoload 'dired-do-rename "dired-aux"
-  "Rename current file or all marked (or next ARG) files.
-When renaming just the current file, you specify the new name.
-When renaming multiple or marked files, you specify a directory."
-  t)
-
-(autoload 'dired-do-rename-regexp "dired-aux"
-  "Rename marked files containing REGEXP to NEWNAME.
-As each match is found, the user must type a character saying
-  what to do with it.  For directions, type \\[help-command] at that time.
-NEWNAME may contain \\=\\<n> or \\& as in `query-replace-regexp'.
-REGEXP defaults to the last regexp used.
-With a zero prefix arg, renaming by regexp affects the complete
-  pathname - usually only the non-directory part of file names is used
-  and changed."
-  t)
-
-(autoload 'dired-do-copy-regexp "dired-aux"
-  "Copy all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
-  t)
-
-(autoload 'dired-do-hardlink-regexp "dired-aux"
-  "Hardlink all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
-  t)
-
-(autoload 'dired-do-symlink-regexp "dired-aux"
-  "Symlink all marked files containing REGEXP to NEWNAME.
-See function `dired-rename-regexp' for more info."
-  t)
-
-(autoload 'dired-upcase "dired-aux"
-  "Rename all marked (or next ARG) files to upper case."
-  t)
-
-(autoload 'dired-downcase "dired-aux"
-  "Rename all marked (or next ARG) files to lower case."
-  t)
-
-(autoload 'dired-maybe-insert-subdir "dired-aux"
-  "Insert this subdirectory into the same dired buffer.
-If it is already present, just move to it (type \\[dired-do-redisplay] to refresh),
-  else inserts it at its natural place (as `ls -lR' would have done).
-With a prefix arg, you may edit the ls switches used for this listing.
-  You can add `R' to the switches to expand the whole tree starting at
-  this subdirectory.
-This function takes some pains to conform to `ls -lR' output."
-  t)
-
-(autoload 'dired-next-subdir "dired-aux"
-  "Go to next subdirectory, regardless of level."
-  t)
-
-(autoload 'dired-prev-subdir "dired-aux"
-  "Go to previous subdirectory, regardless of level.
-When called interactively and not on a subdir line, go to this subdir's line."
-  t)
-
-(autoload 'dired-goto-subdir "dired-aux"
-  "Go to end of header line of DIR in this dired buffer.
-Return value of point on success, otherwise return nil.
-The next char is either \\n, or \\r if DIR is hidden."
-  t)
-
-(autoload 'dired-mark-subdir-files "dired-aux"
-  "Mark all files except `.' and `..'."
-  t)
-
-(autoload 'dired-kill-subdir "dired-aux"
-  "Remove all lines of current subdirectory.
-Lower levels are unaffected."
-  t)
-
-(autoload 'dired-tree-up "dired-aux"
-  "Go up ARG levels in the dired tree."
-  t)
-
-(autoload 'dired-tree-down "dired-aux"
-  "Go down in the dired tree."
-  t)
-
-(autoload 'dired-hide-subdir "dired-aux"
-  "Hide or unhide the current subdirectory and move to next directory.
-Optional prefix arg is a repeat factor.
-Use \\[dired-hide-all] to (un)hide all directories."
-  t)
-
-(autoload 'dired-hide-all "dired-aux"
-  "Hide all subdirectories, leaving only their header lines.
-If there is already something hidden, make everything visible again.
-Use \\[dired-hide-subdir] to (un)hide a particular subdirectory."
-  t)
-
-(if (eq system-type 'vax-vms)
-    (load "dired-vms"))
-
-(provide 'dired)
-
-(run-hooks 'dired-load-hook)		; for your customizations
-
-;;; dired.el ends here
diff --git a/lisp/dirtrack.el b/lisp/dirtrack.el
deleted file mode 100644
index 9f289f31fba..00000000000
--- a/lisp/dirtrack.el
+++ /dev/null
@@ -1,244 +0,0 @@
-;;; dirtrack.el --- Directory Tracking by watching the prompt
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author:  Peter Breton
-;; Created: Sun Nov 17 1996
-;; Keywords: processes
-;; Time-stamp: <96/12/26 09:23:01 peter>
-
-;; 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:
-
-;; Shell directory tracking by watching the prompt.
-;;
-;; This is yet another attempt at a directory-tracking package for
-;; Emacs shell-mode. However, this package makes one strong assumption:
-;; that you can customize your shell's prompt to contain the
-;; current working directory. Most shells do support this, including
-;; almost every type of Bourne and C shell on Unix, the native shells on
-;; Windows95 (COMMAND.COM) and Windows NT (CMD.EXE), and most 3rd party
-;; Windows shells. If you cannot do this, or do not wish to, this package
-;; will be useless to you.
-;;
-;; Installation:
-;;
-;; 1) Set your shell's prompt to contain the current working directory.
-;; You may need to consult your shell's documentation to find out how to
-;; do this.
-;; 
-;; Note that directory tracking is done by matching regular expressions, 
-;; therefore it is *VERY IMPORTANT* for your prompt to be easily
-;; distinguishable from other output. If your prompt regexp is too general,
-;; you will see error messages from the dirtrack filter as it attempts to cd
-;; to non-existent directories.
-;;
-;; 2) Set the variable 'dirtrack-list' to an appropriate value. This
-;; should be a list of two elements: the first is a regular expression
-;; which matches your prompt up to and including the pathname part.
-;; The second is a number which tells which regular expression group to 
-;; match to extract only the pathname. If you use a multi-line prompt,
-;; add 't' as a third element. Note that some of the functions in
-;; 'comint.el' assume a single-line prompt (eg, comint-bol).
-;; 
-;; Determining this information may take some experimentation. Setting
-;; the variable 'dirtrack-debug' may help; it causes the directory-tracking
-;; filter to log messages to the buffer 'dirtrack-debug-buffer'.
-;;
-;; 3) Autoload directory tracking by adding the following to your .emacs:
-;; 
-;; (autoload 'dirtrack "dirtrack"
-;;  "Directory tracking by watching the prompt")
-;; 
-;; 4) Add a hook to shell-mode to enable the directory tracking:
-;;
-;; (add-hook 'shell-mode-hook
-;;   (function (lambda ()
-;; 	      (setq comint-output-filter-functions
-;; 		    (append (list 'dirtrack)
-;; 			    comint-output-filter-functions)))))
-;;
-;; You may wish to turn ordinary shell tracking off by calling
-;; 'shell-dirtrack-toggle' or setting 'shell-dirtrackp'.
-;;
-;; Examples:
-;;
-;; 1) On Windows NT, my prompt is set to emacs$S$P$G.
-;; 'dirtrack-list' is set to (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
-;;
-;; 2) On Solaris running bash, my prompt is set like this:
-;;    PS1="\w\012emacs@\h(\!) [\t]% "
-;;    'dirtrack-list' is set to (list "^\\([/~].*\\)\nemacs@[^%]+% *" 1 t)
-;;
-;; I'd appreciate other examples from people who use this package.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'comint)
-  (require 'shell))
-
-(defvar dirtrack-list (list "^emacs \\([a-zA-Z]:.*\\)>" 1)
-  "*List for directory tracking.
-First item is a regexp that describes where to find the path in a prompt.
-Second is a number, the regexp group to match. Optional third item is 
-whether the prompt is multi-line. If nil or omitted, prompt is assumed to 
-be on a single line.")
-
-(make-variable-buffer-local 'dirtrack-list)
-
-(defvar dirtrack-debug nil
-  "*If non-nil, the function 'dirtrack' will report debugging info.")
-
-(defvar dirtrack-debug-buffer "*Directory Tracking Log*"
-  "Buffer to write directory tracking debug information.")
-
-(defvar dirtrackp t
-  "*If non-nil, directory tracking via 'dirtrack' is enabled.")
-
-(make-variable-buffer-local 'dirtrackp)
-
-(defvar dirtrack-directory-function 
-  (if (memq system-type (list 'ms-dos 'windows-nt))
-      'dirtrack-windows-directory-function
-    'dirtrack-default-directory-function)
-  "*Function to apply to the prompt directory for comparison purposes.")
-
-(defvar dirtrack-canonicalize-function  
-  (if (memq system-type (list 'ms-dos 'windows-nt))
-      'downcase 'identity)
-  "*Function to apply to the default directory for comparison purposes.")
-
-(defun dirtrack-default-directory-function (dir)
-  "Return a canonical directory for comparison purposes.
-Such a directory ends with a forward slash."
-  (let ((directory dir))
-    (if (not (char-equal ?/ (string-to-char (substring directory -1))))
-	(concat directory "/")
-      directory)))
-
-(defun dirtrack-windows-directory-function (dir)
-  "Return a canonical directory for comparison purposes.
-Such a directory is all lowercase, has forward-slashes as delimiters, 
-and ends with a forward slash."
-  (let ((directory dir))
-    (setq directory (downcase (replace-slash directory t)))
-    (if (not (char-equal ?/ (string-to-char (substring directory -1))))
-	(concat directory "/")
-      directory)))
-
-(defconst forward-slash  (regexp-quote "/"))
-(defconst backward-slash (regexp-quote "\\"))
-
-(defun replace-slash (string &optional opposite)
-  "Replace forward slashes with backwards ones.
-If additional argument is non-nil, replace backwards slashes with 
-forward ones."
-  (let ((orig     (if opposite backward-slash forward-slash))
-	(replace  (if opposite forward-slash backward-slash))
-	(newstring string)
-	)
-    (while (string-match orig newstring)
-      (setq newstring (replace-match replace nil t newstring)))
-  newstring))
-
-;; Copied from shell.el
-(defun dirtrack-toggle ()
-  "Enable or disable Dirtrack directory tracking in a shell buffer."
-  (interactive)
-  (setq dirtrackp (not dirtrackp))
-  (message "Directory tracking %s" (if dirtrackp "ON" "OFF")))
-
-(defun dirtrack-debug-message (string)
-  (let ((buf (current-buffer))
-	(debug-buf (get-buffer-create dirtrack-debug-buffer))
-	)
-    (set-buffer debug-buf)
-    (insert (concat string "\n"))
-    (set-buffer buf)
-  ))
-
-;;;###autoload
-(defun dirtrack (input)
-  (if (null dirtrackp)
-      nil
-    (let ((prompt-path)
-	  (current-dir default-directory)
-	  (matched)
-	  (dirtrack-regexp (nth 0 dirtrack-list))
-	  (match-num	      (nth 1 dirtrack-list))
-	  (multi-line	      (nth 2 dirtrack-list))
-	  )
-      ;; No output?
-      (if (eq (point) (point-min))
-	  nil
-	(save-excursion
-	  (goto-char comint-last-output-start)
-	  ;; Look for the prompt
-	  (if multi-line
-	      (and
-	       (goto-char (point-max))
-	       (setq matched 
-		     (re-search-backward 
-		      dirtrack-regexp 
-		      comint-last-output-start
-		      t)))
-	    (beginning-of-line)
-	    (setq matched (looking-at dirtrack-regexp)))
-	  ;; No match
-	  (if (null matched)
-	      (and dirtrack-debug
-		   (dirtrack-debug-message 
-		    (format 
-		     "Failed to match regexp: %s" 
-		    dirtrack-regexp)))
-	    (setq prompt-path 
-		  (buffer-substring-no-properties
-		   (match-beginning match-num) (match-end match-num)))
-	    ;; Empty string
-	    (if (not (> (length prompt-path) 0))
-		(and dirtrack-debug
-		     (dirtrack-debug-message "Match is empty string")) 
-	      ;; Transform prompts into canonical forms
-	      (setq prompt-path (funcall dirtrack-directory-function
-					 prompt-path))
-	      (setq current-dir (funcall dirtrack-canonicalize-function
-					 current-dir))
-	      (and dirtrack-debug
-		   (dirtrack-debug-message 
-		    (format
-		     "Prompt is %s\nCurrent directory is %s"
-		     prompt-path current-dir))) 
-	      ;; Compare them
-	      (if (or (string= current-dir prompt-path)
-		      (string= current-dir 
-			       (abbreviate-file-name prompt-path)))
-		  (and dirtrack-debug
-		       (dirtrack-debug-message 
-			(format "Not changing directory")))
-		;; Change directory
-		(shell-process-cd prompt-path)
-		(and dirtrack-debug
-		     (dirtrack-debug-message 
-		      (format "Changing directory to %s" prompt-path))))
-	      )))))))
-
-(provide 'dirtrack)
-
-;;; dirtrack.el ends here
diff --git a/lisp/disp-table.el b/lisp/disp-table.el
deleted file mode 100644
index 193bf5fbb7d..00000000000
--- a/lisp/disp-table.el
+++ /dev/null
@@ -1,198 +0,0 @@
-;;; disp-table.el --- functions for dealing with char tables.
-
-;; Copyright (C) 1987, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Erik Naggum <erik@naggum.no>
-;; Based on a previous version by Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; 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.
-
-;;; Code:
-
-(put 'display-table 'char-table-extra-slots 6)
-
-;;;###autoload
-(defun make-display-table ()
-  "Return a new, empty display table."
-  (make-char-table 'display-table nil))
-
-(or standard-display-table
-    (setq standard-display-table (make-display-table)))
-
-;;; Display-table slot names.  The property value says which slot.
-
-(put 'truncation 'display-table-slot 0)
-(put 'wrap 'display-table-slot 1)
-(put 'escape 'display-table-slot 2)
-(put 'control 'display-table-slot 3)
-(put 'selective-display 'display-table-slot 4)
-(put 'vertical-border 'display-table-slot 5)
-
-;;;###autoload
-(defun display-table-slot (display-table slot)
-  "Return the value of the extra slot in DISPLAY-TABLE named SLOT.
-SLOT may be a number from 0 to 5 inclusive, or a slot name (symbol).
-Valid symbols are `truncation', `wrap', `escape', `control',
-`selective-display', and `vertical-border'."
-  (let ((slot-number
-	 (if (numberp slot) slot
-	   (or (get slot 'display-table-slot)
-	       (error "Invalid display-table slot name: %s" slot)))))
-    (char-table-extra-slot display-table slot-number)))
-
-;;;###autoload
-(defun set-display-table-slot (display-table slot value)
-  "Set the value of the extra slot in DISPLAY-TABLE named SLOT to VALUE.
-SLOT may be a number from 0 to 5 inclusive, or a name (symbol).
-Valid symbols are `truncation', `wrap', `escape', `control',
-`selective-display', and `vertical-border'."
-  (let ((slot-number
-	 (if (numberp slot) slot
-	   (or (get slot 'display-table-slot)
-	       (error "Invalid display-table slot name: %s" slot)))))
-    (set-char-table-extra-slot display-table slot-number value)))
-
-;;;###autoload
-(defun describe-display-table (dt)
-  "Describe the display table DT in a help buffer."
-  (with-output-to-temp-buffer "*Help*"
-    (princ "\nTruncation glyph: ")
-    (prin1 (display-table-slot dt 'truncation))
-    (princ "\nWrap glyph: ")
-    (prin1 (display-table-slot dt 'wrap))
-    (princ "\nEscape glyph: ")
-    (prin1 (display-table-slot dt 'escape))
-    (princ "\nCtrl glyph: ")
-    (prin1 (display-table-slot dt 'control))
-    (princ "\nSelective display glyph sequence: ")
-    (prin1 (display-table-slot dt 'selective-display))
-    (princ "\nVertical window border glyph: ")
-    (prin1 (display-table-slot dt 'vertical-border))
-    (princ "\nCharacter display glyph sequences:\n")
-    (save-excursion
-      (set-buffer standard-output)
-      (let ((vector (make-vector 256 nil))
-	    (i 0))
-	(while (< i 256)
-	  (aset vector i (aref dt i))
-	  (setq i (1+ i)))
-	(describe-vector vector))
-      (help-mode))
-    (print-help-return-message)))
-
-;;;###autoload
-(defun describe-current-display-table ()
-  "Describe the display table in use in the selected window and buffer."
-  (interactive)
-  (let ((disptab (or (window-display-table (selected-window))
-		     buffer-display-table
-		     standard-display-table)))
-    (if disptab
-	(describe-display-table disptab)
-      (message "No display table"))))
-
-;;;###autoload
-(defun standard-display-8bit (l h)
-  "Display characters in the range L to H literally."
-  (while (<= l h)
-    (if (and (>= l ?\ ) (< l 127))
-	(aset standard-display-table l nil)
-      (aset standard-display-table l (vector l)))
-    (setq l (1+ l))))
-
-;;;###autoload
-(defun standard-display-default (l h)
-  "Display characters in the range L to H using the default notation."
-  (while (<= l h)
-    (if (and (>= l ?\ ) (< l 127))
-	(aset standard-display-table l nil)
-      (aset standard-display-table l nil))
-    (setq l (1+ l))))
-
-;; This function does NOT take terminal-dependent escape sequences.
-;; For that, you need to go through create-glyph.  Use one of the
-;; other functions below, or roll your own.
-;;;###autoload
-(defun standard-display-ascii (c s)
-  "Display character C using printable string S."
-  (aset standard-display-table c (vconcat s)))
-
-;;;###autoload
-(defun standard-display-g1 (c sc)
-  "Display character C as character SC in the g1 character set.
-This function assumes that your terminal uses the SO/SI characters;
-it is meaningless for an X frame."
-  (if window-system
-      (error "Cannot use string glyphs in a windowing system"))
-  (aset standard-display-table c
-	(vector (create-glyph (concat "\016" (char-to-string sc) "\017")))))
-
-;;;###autoload
-(defun standard-display-graphic (c gc)
-  "Display character C as character GC in graphics character set.
-This function assumes VT100-compatible escapes; it is meaningless for an
-X frame."
-  (if window-system
-      (error "Cannot use string glyphs in a windowing system"))
-  (aset standard-display-table c
-	(vector (create-glyph (concat "\e(0" (char-to-string gc) "\e(B")))))
-
-;;;###autoload
-(defun standard-display-underline (c uc)
-  "Display character C as character UC plus underlining."
-  (if window-system (require 'faces))
-  (aset standard-display-table c
-	(vector 
-	 (if window-system
-	     (logior uc (lsh (face-id (internal-find-face 'underline)) 8))
-	   (create-glyph (concat "\e[4m" (char-to-string uc) "\e[m"))))))
-
-;; Allocate a glyph code to display by sending STRING to the terminal.
-;;;###autoload
-(defun create-glyph (string)
-  (if (= (length glyph-table) 65536)
-      (error "No free glyph codes remain"))
-  ;; Don't use slots that correspond to ASCII characters.
-  (if (= (length glyph-table) 32)
-      (setq glyph-table (vconcat glyph-table (make-vector 224 nil))))
-  (setq glyph-table (vconcat glyph-table (list string)))
-  (1- (length glyph-table)))
-
-;;;###autoload
-(defun standard-display-european (arg)
-  "Toggle display of European characters encoded with ISO 8859.
-When enabled, characters in the range of 160 to 255 display not
-as octal escapes, but as accented characters.
-With prefix argument, enable European character display iff arg is positive."
-  (interactive "P")
-  (if (or (<= (prefix-numeric-value arg) 0)
-	  (and (null arg)
-	       (char-table-p standard-display-table)
-	       ;; Test 161, because 160 displays as a space.
-	       (equal (aref standard-display-table 161) [161])))
-      (standard-display-default 160 255)
-    (standard-display-8bit 160 255)
-    ;; Make non-line-break space display as a plain space.
-    ;; Most X fonts do the wrong thing for code 160.
-    (aset standard-display-table 160 [32])))
-
-(provide 'disp-table)
-
-;;; disp-table.el ends here
diff --git a/lisp/docref.el b/lisp/docref.el
deleted file mode 100644
index 363ce6c33d5..00000000000
--- a/lisp/docref.el
+++ /dev/null
@@ -1,282 +0,0 @@
-;;; docref.el --- Simple cross references for Elisp documentation strings
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: Vadim Geshel <vadik@unas.cs.kiev.ua>
-;; Created: 12 Jul 1994
-;; Keywords: docs, help, lisp
-;; original name was cross-ref.el.
-
-;; 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 allows you to use a simple form of cross references in
-;; your Emacs Lisp documentation strings. Cross-references look like
-;; \\(type@[label@]data), where type defines a method for retrieving
-;; reference information, data is used by a method routine as an argument,
-;; and label "represents" the reference in text. If label is absent, data
-;; is used instead.
-;; 
-;; Special reference labeled `back', when present, can be used to return
-;; to the previous contents of help buffer.
-;;
-;; Cross-referencing currently is intended for use in doc strings only
-;; and works only in temporary buffers (created by `with-output-to-temp-buffer').
-;; List of temp buffers in which cross-referencing is to be active is specified
-;; by variable DOCREF-BUFFERS-LIST, which contains only "*Help*" by default.
-;;
-;; Documentation strings for this package's functions and variables can serve
-;; as examples of usage.
-;;
-;;; Customization:
-;; 
-;; See source. The main customization variable is `docref-methods-alist'.
-;; It consists of (type . function) pairs, where type is a string which
-;; corresponds to type in cross-references and function is called with
-;; one argument - reference `data' - when a reference is activated.
-;;
-;;; Installation:
-;;
-;; Place this file somewhere in your load-path, byte-compiled it, and add
-;; (require 'cross-ref)
-;; to your .emacs.
-
-;;; Code:
-
-;; User customizable variables
-
-(defvar docref-highlight-p t
-  "*If non-nil, \\(f@docref-subst) highlights cross-references.
-Under window system it highlights them with face defined by
-\\(v@docref-highlight-face), on character terminal highlighted references
-look like cross-references in info mode.")
-
-(defvar docref-highlight-face 'highlight
-  "*Face used to highlight cross-references (used by \\(f@docref-subst))")
-
-(defvar docref-methods-alist
-  '(("f" . docref-describe-function)	; reference to a function documentation
-    ("v" . docref-describe-variable)	; reference to a variable documentation
-    ("F" . docref-read-file)		; reference to a file contents
-    ("s" . docref-use-string)		; reference to a string 
-    ("V" . docref-use-variable-value)	; reference to variable value
-    ("0" . beep))			; just highlighted text
-  "Alist which maps cross-reference ``types'' to retrieval functions.
-
-The car of each element is a string that serves as `type' in cross-references.
-\(See \\(f@docref-subst)).  The cdr is a function of one argument,
-to be called to find this reference.")
-
-(defvar docref-back-label "\nback"
-  "Label to use by \\(f@docref-subst) for the go-back reference.")
-
-(defvar docref-back-reference nil
-  "If non-nil, this is a go-back reference to add to the current buffer.
-The value specifies how to go back.  It should be suitable for use
-as the second argument to \\(f@docref-insert-label).
-\\(f@docref-subst) uses this to set up the go-back reference.")
-
-(defvar docref-last-active-buffer)
-
-;;;###autoload
-(defun docref-setup ()
-  "Process docref cross-references in the current buffer.
-See also \\(f@docref-subst)."
-  (interactive)
-  (docref-subst (current-buffer))
-  (docref-mode))
-
-(defvar docref-mode-map nil)
-(or docref-mode-map
-    (let ((map (make-sparse-keymap)))
-      (define-key map [mouse-2] 'docref-follow-mouse)
-      (define-key map "\C-c\C-b" 'docref-go-back)
-      (define-key map "\C-c\C-c" 'docref-follow)
-      (setq docref-mode-map map)))
-
-(defun docref-mode ()
-  "Major mode for help buffers that contain cross references.
-To follow a reference, move to it and type \\[docref-follow], or use
-\\[docref-follow-mouse].  The command \\[docref-go-back] can used to go
-back to where you came from."
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'docref-mode)
-  (setq mode-name "Docref")
-  (use-local-map docref-mode-map)
-  (run-hooks 'docref-mode))
-
-(defun docref-subst (buf)
-  "Parse documentation cross-references in buffer BUF.
-
-Find cross-reference information in a buffer and
-highlight them with face defined by \\(v@docref-highlight-face).
-
-Cross-reference has the following format: \\ (TYPE[@LABEL]@DATA), where
-TYPE defines method used to retrieve xref data (like reading from file or
-calling \\(f@describe-function)), DATA is an argument to this method
-\(like file name or function name), and LABEL is displayed in text using
-\\(v@docref-highlight-face).
-
-The special reference `back' can be used to return back.
-The variable \\(v@docref-back-label) specifies the label to use for that.
-
-See \\(v@docref-methods-alist) for currently defined methods."
-  (interactive "b")
-  (save-excursion
-    (set-buffer buf)
-    (goto-char (point-min))
-    ;; The docref-seen property indicates that we have processed this
-    ;; buffer's contents already, so don't do it again.
-    (if (not (get-text-property (point-min) 'docref-seen))
-	(let ((old-modified (buffer-modified-p)))
-	  (while (re-search-forward "[\\](\\([^\)\@]+\\)\\(@[^\)\@]+\\)?@\\([^\)]*\\))"
-				    nil t)
-	    (let* ((start (match-beginning 0))
-		   (type (buffer-substring (match-beginning 1) (match-end 1)))
-		   (data (buffer-substring (match-beginning 3) (match-end 3)))
-		   (label
-		    (if (match-beginning 2)
-			(buffer-substring (+ (match-beginning 2) 1) (match-end 2))
-		      data)))
-	      (replace-match "" t)
-	      (docref-insert-label label (cons type data))))
-
-	  ;; Make a back-reference in this buffer, if desired.
-	  ;; (This is true if called from docref-follow.)
-	  (if docref-back-reference
-	      (progn
-		(goto-char (point-max))
-		(put-text-property (point-min) (1+ (point-min))
-				   'docref-back-position (point))
-		(docref-insert-label docref-back-label docref-back-reference)))
-	  (put-text-property (point-min) (1+ (point-min)) 'docref-seen t)
-	  (set-buffer-modified-p old-modified)))))
-
-(defun docref-insert-label (string ref)
-  (let ((label (concat string))
-	(pos (point)))
-    ;; decorate the label
-    (let ((leading-space-end (save-match-data
-			       (if (string-match "^\\([ \t\n]+\\)" label)
-				   (match-end 1)
-				 0)))
-	  (trailing-space-start (save-match-data
-				  (if (string-match "\\([ \t\n]+\\)$" label)
-				      (match-beginning 1)
-				    (length label)))))
-      (if docref-highlight-p	      
-	  (if (not window-system)
-	      (setq label
-		    (concat (substring label 0 leading-space-end)
-			    "(*note "
-			    (substring label leading-space-end trailing-space-start)
-			    ")"
-			    (substring label trailing-space-start)))
-	    ;; window-system
-	    (put-text-property leading-space-end
-			       trailing-space-start
-			       'face docref-highlight-face label)))
-      (put-text-property 0 (length label) 'docref ref label)
-      (insert label))))
-
-(defun docref-follow-mouse (click)
-  "Follow the cross-reference that you click on."
-  (interactive "e")
-  (save-excursion
-    (let* ((start (event-start click))
-	   (window (car start))
-	   (pos (car (cdr start)))
-	   (docref-last-active-buffer (current-buffer)))
-      (set-buffer (window-buffer window))
-      (docref-follow pos))))
-
-(defun docref-go-back ()
-  "Go back to the previous contents of help buffer."
-  (interactive)
-  (let ((pos (get-text-property (point-min) 'docref-back-position)))
-    (if	pos
-	(docref-follow pos)
-      (error "No go-back reference"))))
-
-(defun docref-follow (&optional pos)
-  "Follow cross-reference at point.
-For the cross-reference format, see \\(f@docref-subst).
-The special reference named `back' can be used to return back"
-  (interactive)
-  (or pos (setq pos (point)))
-  (let ((docref-data (get-text-property pos 'docref)))
-    (if docref-data
-	;; There is a reference at point.  Follow it.
-	(let* ((type (car docref-data))
-	       (name (cdr docref-data))
-	       (method (assoc type docref-methods-alist))
-	       (cur-contents (buffer-string))
-	       (opoint (point))
-	       (docref-back-reference (cons "s" cur-contents))
-	       success)
-	  (if (null method)
-	      (error "Unknown cross-reference type: %s" type))
-	  (unwind-protect
-	      (save-excursion
-		(funcall (cdr method) name)
-		(setq success t))
-	    (or success
-		(progn
-		  ;; (cdr method) got an error.
-		  ;; Put back the text that we had.
-		  (erase-buffer)
-		  (insert cur-contents)
-		  (goto-char opoint)))
-	    (set-buffer-modified-p nil))))))
-
-;; Builtin methods for accessing a reference.
-
-(defun docref-describe-function (data)
-  (save-excursion
-    (if (boundp 'docref-last-active-buffer)
-	(set-buffer docref-last-active-buffer))
-    (describe-function (intern data))))
-  
-(defun docref-describe-variable (data)
-  (save-excursion
-    (if (boundp 'docref-last-active-buffer)
-	(set-buffer docref-last-active-buffer))
-    (describe-variable (intern data))))
-
-(defun docref-read-file (data)
-  (with-output-to-temp-buffer (buffer-name)
-    (erase-buffer)
-    (insert-file-contents (expand-file-name data))))
-
-(defun docref-use-string (data)
-  (with-output-to-temp-buffer (buffer-name)
-    (erase-buffer)
-    (insert data)))
-
-(defun docref-use-variable-value (data)
-  (let ((sym (intern data)))
-    (with-output-to-temp-buffer (buffer-name)
-      (erase-buffer)
-      (princ (symbol-value sym)))))
-
-(provide 'docref)
-
-;;; docref.el ends here
-
diff --git a/lisp/dos-fns.el b/lisp/dos-fns.el
deleted file mode 100644
index 00d4a36d0e1..00000000000
--- a/lisp/dos-fns.el
+++ /dev/null
@@ -1,208 +0,0 @@
-;;; dos-fns.el --- MS-Dos specific functions.
-
-;; Copyright (C) 1991, 1993, 1995, 1996 Free Software Foundation, Inc.
-
-;; Maintainer: Morten Welinder (terra@diku.dk)
-;; 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:
-
-;; Part of this code is taken from (or derived from) demacs.
-
-;;; Code:
-
-;; This overrides a trivial definition in files.el.
-(defun convert-standard-filename (filename)
-  "Convert a standard file's name to something suitable for the current OS.
-This function's standard definition is trivial; it just returns the argument.
-However, on some systems, the function is redefined
-with a definition that really does change some file names."
-  (if (or (msdos-long-file-names)
-	  (not (stringp filename))
-	  (member (file-name-nondirectory filename) '("" "." "..")))
-      filename
-    (let* ((dir (file-name-directory filename))
-	   (string (copy-sequence (file-name-nondirectory filename)))
-	   (lastchar (aref string (1- (length string))))
-	   i firstdot)
-      ;; Change a leading period to a leading underscore.
-      (if (= (aref string 0) ?.)
-	  (aset string 0 ?_))
-      ;; Get rid of invalid characters.
-      (while (setq i (string-match
-		      "[^-a-zA-Z0-9_.%~^$!#&{}@`'()\200-\376]"
-		      string))
-	(aset string i ?_))
-      ;; If we don't have a period,
-      ;; and we have a dash or underscore that isn't the first char,
-      ;; change that to a period.
-      (if (and (not (string-match "\\." string))
-	       (setq i (string-match "[-_]" string 1)))
-	  (aset string i ?\.))
-      ;; If we don't have a period in the first 8 chars, insert one.
-      (if (> (or (string-match "\\." string)
-		 (length string))
-	     8)
-	  (setq string
-		(concat (substring string 0 8)
-			"."
-			(substring string 8))))
-      (setq firstdot (or (string-match "\\." string) (1- (length string))))
-      ;; Truncate to 3 chars after the first period.
-      (if (> (length string) (+ firstdot 4))
-	  (setq string (substring string 0 (+ firstdot 4))))
-      ;; Change all periods except the first one into underscores.
-      (while (string-match "\\." string (1+ firstdot))
-	(setq i (string-match "\\." string (1+ firstdot)))
-	(aset string i ?_))
-      ;; If the last character of the original filename was `~',
-      ;; make sure the munged name ends with it also.
-      (if (equal lastchar ?~)
-	  (aset string (1- (length string)) lastchar))
-      (concat dir string))))
-
-(defvar msdos-shells '("command.com" "4dos.com" "ndos.com")
-  "*List of shells that use `/c' instead of `-c' and a backslashed command.")
-
-(defvar register-name-alist
-  '((ax . 0) (bx . 1) (cx . 2) (dx . 3) (si . 4) (di . 5)
-    (cflag . 6) (flags . 7)
-    (al . (0 . 0)) (bl . (1 . 0)) (cl . (2 . 0)) (dl . (3 . 0))
-    (ah . (0 . 1)) (bh . (1 . 1)) (ch . (2 . 1)) (dh . (3 . 1))))
-
-(defun make-register ()
-  (make-vector 8 0))
-
-(defun register-value (regs name)
-  (let ((where (cdr (assoc name register-name-alist))))
-    (cond ((consp where)
-	   (let ((tem (aref regs (car where))))
-	     (if (zerop (cdr where))
-		 (% tem 256)
-	       (/ tem 256))))
-	  ((numberp where)
-	   (aref regs where))
-	  (t nil))))
-
-(defun set-register-value (regs name value)
-  (and (numberp value)
-       (>= value 0)
-       (let ((where (cdr (assoc name register-name-alist))))
-	 (cond ((consp where)
-		(let ((tem (aref regs (car where)))
-		      (value (logand value 255)))
-		  (aset regs
-			(car where)
-			(if (zerop (cdr where))
-			    (logior (logand tem 65280) value)
-			  (logior (logand tem 255) (lsh value 8))))))
-	       ((numberp where)
-		(aset regs where (logand value 65535))))))
-  regs)
-
-(defsubst intdos (regs)
-  (int86 33 regs))
-
-;; Support for printing under MS-DOS, see lpr.el and ps-print.el.
-(defvar dos-printer "PRN"
-  "*The name of a local MS-DOS device to which data is sent for printing.
-\(Note that PostScript files are sent to `dos-ps-printer', which see.\)
-
-Typical non-default settings would be \"LPT1\" to \"LPT3\" for
-parallel printers, or \"COM1\" to \"COM4\" or \"AUX\" for serial
-printers.  You can also set it to a name of a file, in which
-case the output gets appended to that file.
-If you want to discard the printed output, set this to \"NUL\".")
-
-(defun dos-print-region-function (start end
-					&optional lpr-prog
-					delete-text buf display rest)
-  "MS-DOS-specific function to print the region on a printer.
-Writes the region to the device or file which is a value of
-`dos-printer' \(which see\).  Ignores any arguments beyond
-START and END."
-
-  (write-region start end dos-printer t 0)
-  ;; Make each print-out start on a new page, but don't waste
-  ;; paper if there was a form-feed at the end of this file.
-  (if (not (char-equal (char-after (1- end)) ?\C-l))
-      (write-region "\f" nil dos-printer t 0)))
-
-;; Set this to nil if you have a port of the `lpr' program and
-;; you want to use it for printing.  If the default setting is
-;; in effect, `lpr-command' and its switches are ignored when
-;; printing with `lpr-xxx' and `print-xxx'.
-(setq print-region-function 'dos-print-region-function)
-
-;; Set this to nil if you have a port of the `pr' program
-;; (e.g., from GNU Textutils), or if you have an `lpr'
-;; program (see above) that can print page headers.
-;; If `lpr-headers-switches' is non-nil (the default) and
-;; `print-region-function' is set to `dos-print-region-function',
-;; then requests to print page headers will be silently
-;; ignored, and `print-buffer' and `print-region' produce
-;; the same output as `lpr-buffer' and `lpr-region', accordingly.
-(setq lpr-headers-switches "(page headers are not supported)")
-
-(defvar dos-ps-printer "PRN"
-  "*Method for printing PostScript files under MS-DOS.
-
-If the value is a string, then it is taken as the name of the
-device to which PostScript files are written.  By default it
-is the default printer device; typical non-default settings
-would be \"LPT1\" to \"LPT3\" for parallel printers, or \"COM1\"
-to \"COM4\" or \"AUX\" for serial printers.  You can also set it
-to a name of a file, in which case the output gets appended
-to that file.  \(Note that `ps-print' package already has
-facilities for printing to a file, so you might as well use
-them instead of changing the setting of this variable.\)  If
-you want to silently discard the printed output, set this to \"NUL\".
-
-If the value is anything but a string, PostScript files will be
-piped to the program given by `ps-lpr-command', with switches
-given by `ps-lpr-switches', which see.")
-
-(setq ps-lpr-command "gs")
-
-(setq ps-lpr-switches '("-q" "-dNOPAUSE" "-sDEVICE=epson" "-r240x60"
-			  "-sOutputFile=LPT1" "-"))
-
-;; Backward compatibility for obsolescent functions which
-;; set screen size.
-
-(defun mode25 ()
-  "Changes the number of screen rows to 25."
-  (interactive)
-  (set-frame-size (selected-frame) 80 25))
-
-(defun mode4350 ()
-  "Changes the number of rows to 43 or 50.
-Emacs always tries to set the screen height to 50 rows first.
-If this fails, it will try to set it to 43 rows, on the assumption
-that your video hardware might not support 50-line mode."
-  (interactive)
-  (set-frame-size (selected-frame) 80 50)
-  (if (eq (frame-height (selected-frame)) 50)
-      nil  ; the original built-in function returned nil
-    (set-frame-size (selected-frame) 80 43)))
-
-(provide 'dos-fns)
-
-; dos-fns.el ends here
diff --git a/lisp/dos-w32.el b/lisp/dos-w32.el
deleted file mode 100644
index 83de34749af..00000000000
--- a/lisp/dos-w32.el
+++ /dev/null
@@ -1,169 +0,0 @@
-;;; dos-w32.el --- Functions shared among MS-DOS and W32 (NT/95) platforms
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Maintainer: Geoff Voelker (voelker@cs.washington.edu)
-;; 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:
-
-;; Parts of this code are duplicated functions taken from dos-fns.el
-;; and winnt.el.
-
-;;; Code:
-
-;;; Add %t: into the mode line format just after the open-paren.
-(let ((tail (member "   %[(" mode-line-format)))
-  (setcdr tail (cons (purecopy "%t:")
-		     (cdr tail))))
-
-;; Use ";" instead of ":" as a path separator (from files.el).
-(setq path-separator ";")
-
-;; Set the null device (for compile.el).
-(setq grep-null-device "NUL")
-
-;; Set the grep regexp to match entries with drive letters.
-(setq grep-regexp-alist
-  '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
-
-;; For distinguishing file types based upon suffixes.
-(defvar file-name-buffer-file-type-alist
-  '(
-    ("[:/].*config.sys$" . nil)		; config.sys text
-    ("\\.elc$" . t)			; emacs stuff
-    ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
-					; MS-Dos stuff
-    ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
-					; Packers
-    ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
-					; Unix stuff
-    ("\\.tp[ulpw]$" . t)
-					; Borland Pascal stuff
-    ("[:/]tags$" . t)
-					; Emacs TAGS file
-    )
-  "*Alist for distinguishing text files from binary files.
-Each element has the form (REGEXP . TYPE), where REGEXP is matched
-against the file name, and TYPE is nil for text, t for binary.")
-
-(defun find-buffer-file-type (filename)
-  ;; First check if file is on an untranslated filesystem, then on the alist.
-  (if (untranslated-file-p filename)
-      t ; for binary
-    (let ((alist file-name-buffer-file-type-alist)
-	  (found nil)
-	  (code nil))
-      (let ((case-fold-search t))
-	(setq filename (file-name-sans-versions filename))
-	(while (and (not found) alist)
-	  (if (string-match (car (car alist)) filename)
-	      (setq code (cdr (car alist))
-		    found t))
-	  (setq alist (cdr alist))))
-      (if found
-	  (cond ((memq code '(nil t)) code)
-		((and (symbolp code) (fboundp code))
-		 (funcall code filename)))
-	default-buffer-file-type))))
-
-(defun find-file-binary (filename) 
-  "Visit file FILENAME and treat it as binary."
-  (interactive "FFind file binary: ")
-  (let ((file-name-buffer-file-type-alist '(("" . t))))
-    (find-file filename)))
-
-(defun find-file-text (filename) 
-  "Visit file FILENAME and treat it as a text file."
-  (interactive "FFind file text: ")
-  (let ((file-name-buffer-file-type-alist '(("" . nil))))
-    (find-file filename)))
-
-(defun find-file-not-found-set-buffer-file-type ()
-  (save-excursion
-    (set-buffer (current-buffer))
-    (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
-  nil)
-
-;;; To set the default file type on new files.
-(add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
-
-
-;;; To accomodate filesystems that do not require CR/LF translation.
-(defvar untranslated-filesystem-list nil
-  "List of filesystems that require no CR/LF translation when reading 
-and writing files.  Each filesystem in the list is a string naming
-the directory prefix corresponding to the filesystem.")
-
-(defun untranslated-canonical-name (filename)
-  "Return FILENAME in a canonicalized form for use with the functions
-dealing with untranslated filesystems."
-  (if (memq system-type '(ms-dos windows-nt))
-      ;; The canonical form for DOS/NT/Win95 is with A-Z downcased and all
-      ;; directory separators changed to directory-sep-char.
-      (let ((name nil))
-	(setq name (mapconcat 
-		    '(lambda (char) 
-		       (if (and (<= ?A char) (<= char ?Z))
-			   (char-to-string (+ (- char ?A) ?a))
-			 (char-to-string char)))
-		    filename nil))
-	;; Use expand-file-name to canonicalize directory separators, except
-	;; with bare drive letters (which would have the cwd appended).
-	(if (string-match "^.:$" name)
-	    name
-	  (expand-file-name name)))
-    filename))
-
-(defun untranslated-file-p (filename)
-  "Return t if FILENAME is on a filesystem that does not require 
-CR/LF translation, and nil otherwise."
-  (let ((fs (untranslated-canonical-name filename))
-	(ufs-list untranslated-filesystem-list)
-	(found nil))
-    (while (and (not found) ufs-list)
-      (if (string-match (concat "^" (car ufs-list)) fs)
-	  (setq found t)
-	(setq ufs-list (cdr ufs-list))))
-    found))
-
-(defun add-untranslated-filesystem (filesystem)
-  "Add FILESYSTEM to the list of filesystems that do not require
-CR/LF translation.  FILESYSTEM is a string containing the directory
-prefix corresponding to the filesystem.  For example, for a Unix 
-filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
-  (let ((fs (untranslated-canonical-name filesystem)))
-    (if (member fs untranslated-filesystem-list)
-	untranslated-filesystem-list
-      (setq untranslated-filesystem-list
-	    (cons fs untranslated-filesystem-list)))))
-
-(defun remove-untranslated-filesystem (filesystem)
-  "Remove FILESYSTEM from the list of filesystems that do not require 
-CR/LF translation.  FILESYSTEM is a string containing the directory
-prefix corresponding to the filesystem.  For example, for a Unix 
-filesystem mounted on drive Z:, FILESYSTEM could be \"Z:\"."
-  (setq untranslated-filesystem-list 
-	(delete (untranslated-canonical-name filesystem)
-		untranslated-filesystem-list)))
-
-(provide 'dos-w32)
-
-;;; dos-w32.el ends here
diff --git a/lisp/dos-win32.el b/lisp/dos-win32.el
deleted file mode 100644
index 89704c029c5..00000000000
--- a/lisp/dos-win32.el
+++ /dev/null
@@ -1,170 +0,0 @@
-;;; dos-win32.el --- Functions shared among MS-DOS and Win32 (NT/95) platforms
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Maintainer: Geoff Voelker (voelker@cs.washington.edu)
-;; 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:
-
-;; Parts of this code are duplicated functions taken from dos-fns.el
-;; and winnt.el.
-
-;;; Code:
-
-;;; Add %t: into the mode line format just after the open-paren.
-(let ((tail (member "   %[(" mode-line-format)))
-  (setcdr tail (cons (purecopy "%t:")
-		     (cdr tail))))
-
-;; Use ";" instead of ":" as a path separator (from files.el).
-(setq path-separator ";")
-
-;; Set the null device (for compile.el).
-(setq grep-null-device "NUL")
-
-;; Set the grep regexp to match entries with drive letters.
-(setq grep-regexp-alist
-  '(("^\\(\\([a-zA-Z]:\\)?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 3)))
-
-;; For distinguishing file types based upon suffixes.
-(defvar file-name-buffer-file-type-alist
-  '(
-    ("[:/].*config.sys$" . nil)		; config.sys text
-    ("\\.elc$" . t)			; emacs stuff
-    ("\\.\\(obj\\|exe\\|com\\|lib\\|sys\\|chk\\|out\\|bin\\|ico\\|pif\\)$" . t)
-					; MS-Dos stuff
-    ("\\.\\(arc\\|zip\\|pak\\|lzh\\|zoo\\)$" . t)
-					; Packers
-    ("\\.\\(a\\|o\\|tar\\|z\\|gz\\|taz\\)$" . t)
-					; Unix stuff
-    ("\\.tp[ulpw]$" . t)
-					; Borland Pascal stuff
-    ("[:/]tags$" . t)
-					; Emacs TAGS file
-    )
-  "*Alist for distinguishing text files from binary files.
-Each element has the form (REGEXP . TYPE), where REGEXP is matched
-against the file name, and TYPE is nil for text, t for binary.")
-
-(defun find-buffer-file-type (filename)
-  ;; First check if file is on an untranslated filesystem, then on the alist.
-  (if (untranslated-file-p filename)
-      t ; for binary
-    (let ((alist file-name-buffer-file-type-alist)
-	  (found nil)
-	  (code nil))
-      (let ((case-fold-search t))
-	(setq filename (file-name-sans-versions filename))
-	(while (and (not found) alist)
-	  (if (string-match (car (car alist)) filename)
-	      (setq code (cdr (car alist))
-		    found t))
-	  (setq alist (cdr alist))))
-      (if found
-	  (cond ((memq code '(nil t)) code)
-		((and (symbolp code) (fboundp code))
-		 (funcall code filename)))
-	default-buffer-file-type))))
-
-(defun find-file-binary (filename)
-  "Visit file FILENAME and treat it as binary."
-  (interactive "FFind file binary: ")
-  (let ((file-name-buffer-file-type-alist '(("" . t))))
-    (find-file filename)))
-
-(defun find-file-text (filename)
-  "Visit file FILENAME and treat it as a text file."
-  (interactive "FFind file text: ")
-  (let ((file-name-buffer-file-type-alist '(("" . nil))))
-    (find-file filename)))
-
-(defun find-file-not-found-set-buffer-file-type ()
-  (save-excursion
-    (set-buffer (current-buffer))
-    (setq buffer-file-type (find-buffer-file-type (buffer-file-name))))
-  nil)
-
-;;; To set the default file type on new files.
-(add-hook 'find-file-not-found-hooks 'find-file-not-found-set-buffer-file-type)
-
-
-;;; To accomodate filesystems that do not require CR/LF translation.
-(defvar untranslated-filesystem-list nil
-  "List of filesystems that require no CR/LF translation during file I/O.
-Each element in the list is a string naming the directory prefix
-corresponding to the filesystem.")
-
-(defun untranslated-canonical-name (filename)
-  "Return FILENAME in a canonicalized form.
-This is for use with the functions dealing with untranslated filesystems."
-  (if (memq system-type '(ms-dos windows-nt))
-      ;; The canonical form for DOS/NT/Win95 is with A-Z downcased and all
-      ;; directory separators changed to directory-sep-char.
-      (let ((name nil))
-	(setq name (mapconcat
-		    '(lambda (char)
-		       (if (and (<= ?A char) (<= char ?Z))
-			   (char-to-string (+ (- char ?A) ?a))
-			 (char-to-string char)))
-		    filename nil))
-	;; Use expand-file-name to canonicalize directory separators, except
-	;; with bare drive letters (which would have the cwd appended).
-	(if (string-match "^.:$" name)
-	    name
-	  (expand-file-name name)))
-    filename))
-
-(defun untranslated-file-p (filename)
-  "Test whether CR/LF translation should be disabled for FILENAME.
-Return t if FILENAME is on a filesystem that does not require
-CR/LF translation, and nil otherwise."
-  (let ((fs (untranslated-canonical-name filename))
-	(ufs-list untranslated-filesystem-list)
-	(found nil))
-    (while (and (not found) ufs-list)
-      (if (string-match (concat "^" (regexp-quote (car ufs-list))) fs)
-	  (setq found t)
-	(setq ufs-list (cdr ufs-list))))
-    found))
-
-(defun add-untranslated-filesystem (filesystem)
-  "Record that FILESYSTEM does not require CR/LF translation.
-FILESYSTEM is a string containing the directory prefix corresponding to
-the filesystem.  For example, for a Unix filesystem mounted on drive Z:,
-FILESYSTEM could be \"Z:\"."
-  (let ((fs (untranslated-canonical-name filesystem)))
-    (if (member fs untranslated-filesystem-list)
-	untranslated-filesystem-list
-      (setq untranslated-filesystem-list
-	    (cons fs untranslated-filesystem-list)))))
-
-(defun remove-untranslated-filesystem (filesystem)
-  "Record that FILESYSTEM requires CR/LF translation.
-FILESYSTEM is a string containing the directory prefix corresponding to
-the filesystem.  For example, for a Unix filesystem mounted on drive Z:,
-FILESYSTEM could be \"Z:\"."
-  (setq untranslated-filesystem-list
-	(delete (untranslated-canonical-name filesystem)
-		untranslated-filesystem-list)))
-
-(provide 'dos-win32)
-
-;;; dos-win32.el ends here
diff --git a/lisp/double.el b/lisp/double.el
deleted file mode 100644
index 0a422bedbf1..00000000000
--- a/lisp/double.el
+++ /dev/null
@@ -1,200 +0,0 @@
-;;; double.el --- Support for keyboard remapping with double clicking
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Keywords: i18n
-
-;; 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 mode is intended for use with languages that adds a small
-;; number of extra letters not available on the keyboard.
-;; 
-;; Examples includes Scandinavian and German with an US keyboard.
-;;
-;; The idea is that certain keys are overloaded.  When you press it
-;; once it will insert one string, and when you press it twice the
-;; string will be replaced by another.  This can be used for mapping
-;; keys on a US keyboard to generate characters according to the local
-;; keyboard convention when pressed once, and according to US keyboard
-;; convention when pressed twice. 
-;;
-;; To use this mode, you must define the variable `double-map' and
-;; then enable double mode with `M-x double-mode'.  Read the
-;; documentation for both of them.
-;;
-;; The default mapping is for getting Danish/Norwegian keyboard layout
-;; using ISO Latin 1 on a US keyboard.
-;;
-;; Important node: While I would like to hear comments, bug reports,
-;; suggestions, please do @strong{not} expect me to put other mappings
-;; than the default into this file.  There are billions and billions
-;; of such mappings, and just supporting the most common would
-;; increase the size of this nice small file manyfold.
-
-;;; ChangeLog: 
-
-;; * 1994-06-21         Per Abrahamsen
-;;      Added `double-prefix-only'.
-;; * 1994-02-28         Per Abrahamsen
-;;      Use 127 instead of 'delete to delete a character.
-;; * 1994-02-03		Per Abrahamsen
-;;	Created.
-
-;;; Code:
-
-(defvar double-map
-  '((?\; "\346" ";")
-    (?\' "\370" "'")
-    (?\[ "\345" "[")
-    (?\: "\306" ":")
-    (?\" "\330" "\"")
-    (?\{ "\305" "{"))
-  "Alist of key translations activated by double mode.
-
-Each entry is a list with three elements:
-1. The key activating the translation.
-2. The string to be inserted when the key is pressed once.
-3. The string to be inserted when the key is pressed twice.")
-
-(defvar double-prefix-only t
-  "*Non-nil means that Double mode mapping only works for prefix keys.
-That is, for any key `X' in `double-map',  `X' alone will be mapped
-but not `C-u X' or `ESC X' since the X is not the prefix key.")
-
-;;; Read Event
-
-(defvar double-last-event nil)
-;; The last key that generated a double key event.
-
-(defun double-read-event (prompt)
-  ;; Read an event
-  (if isearch-mode (isearch-update))
-  (if prompt
-      (prog2 (message "%s%c" prompt double-last-event)
-	  (read-event)
-	(message ""))
-    (read-event)))
-
-(global-set-key [ignore] '(lambda () (interactive)))
-
-(or (boundp 'isearch-mode-map)
-    (load-library "isearch"))
-
-(define-key isearch-mode-map [ignore] 
-  (function (lambda () (interactive) (isearch-update))))
-
-(defun double-translate-key (prompt)
-  ;; Translate input events using double map.
-  (let ((key last-input-char))
-    (cond (unread-command-events
-	   ;; Artificial event, ignore it.
-	   (vector key))
-	  ((and double-prefix-only
-		(> (length (this-command-keys)) 1))
-	   ;; This is not a prefix key, ignore it.
-	   (vector key))
-	  ((eq key 'magic-start)
-	   ;; End of generated event.  See if he will repeat it...
-	   (let ((new (double-read-event prompt))
-		 (entry (assoc double-last-event double-map)))
-	     (if (eq new double-last-event)
-		 (progn 
-		   (setq unread-command-events
-			 (append (make-list (1- (length (nth 1 entry)))
-					    127)
-				 (nth 2 entry)
-				 '(magic-end)))
-		   (vector 127))
-	       (setq unread-command-events (list new))
-	       [ignore])))
-	  ((eq key 'magic-end)
-	   ;; End of double event.  Ignore.
-	   [ignore])
-	  (t
-	   ;; New key.
-	   (let ((exp (nth 1 (assoc key double-map))))
-	     (setq double-last-event key)
-	     (setq unread-command-events
-		   (append (substring exp 1) '(magic-start)))
-	     (vector (aref exp 0)))))))
-
-;;; Key Translation Map
-
-(defvar default-key-translation-map
-  (or key-translation-map (make-sparse-keymap))
-  "Key translation you want to have effect, regardless of Double mode.
-This defaults to the value of `key-translation-map' when double was
-first loaded.")
-
-(make-variable-buffer-local 'key-translation-map)
-
-(defun double-setup ()
-  ;; Setup key-translation-map as indicated by `double-map'.
-  (setq key-translation-map (copy-keymap default-key-translation-map))
-  (mapcar (function (lambda (entry)
-            (define-key key-translation-map (vector (nth 0 entry))
-	                'double-translate-key)))
-	  (append double-map '((magic-start) (magic-end)))))
-
-;;; Mode
-
-(defvar double-mode nil)
-;; Indicator for the double mode.
-  (make-variable-buffer-local 'double-mode)
-
-(or (assq 'double-mode minor-mode-alist)
-    (setq minor-mode-alist
-	  (cons '(double-mode " Double") minor-mode-alist)))
-
-;; This feature seemed useless and it confused describe-mode,
-;;  so I deleted it.
-;;;(defvar double-mode-name "Double")
-;;;;; Name of current double mode.
-;;; (make-variable-buffer-local 'double-mode-name)
-
-;;;###autoload
-(defun double-mode (arg)
-  "Toggle Double mode.
-With prefix arg, turn Double mode on iff arg is positive.
-
-When Double mode is on, some keys will insert different strings
-when pressed twice.  See variable `double-map' for details."
-  (interactive "P")
-  (if (or (and (null arg) double-mode)
-	  (<= (prefix-numeric-value arg) 0))
-      ;; Turn it off
-      (if double-mode
-	  (progn
-	    (let ((double-map))
-	      (double-setup))
-	    (setq double-mode nil)
-	    (force-mode-line-update)))
-    ;;Turn it on
-    (if double-mode
-	()
-      (double-setup)
-      (setq double-mode t)
-      (force-mode-line-update))))
-
-(provide 'double)
-
-;;; double.el ends here
-
diff --git a/lisp/ebuff-menu.el b/lisp/ebuff-menu.el
deleted file mode 100644
index 907cc2d92e0..00000000000
--- a/lisp/ebuff-menu.el
+++ /dev/null
@@ -1,265 +0,0 @@
-;;; ebuff-menu.el --- electric-buffer-list mode
-
-;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik <mly@ai.mit.edu>
-
-;; 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:
-
-;; Who says one can't have typeout windows in GNU Emacs?   The entry
-;; point, `electric-buffer-list' works like ^r select buffer from the
-;; ITS Emacs lunar or tmacs libraries.
-
-;;; Code:
-
-(require 'electric)
-
-;; this depends on the format of list-buffers (from src/buffer.c) and
-;; on stuff in lisp/buff-menu.el
-
-(defvar electric-buffer-menu-mode-map nil)
-
-;;;###autoload
-(defun electric-buffer-list (arg)
-  "Pops up a buffer describing the set of Emacs buffers.
-Vaguely like ITS lunar select buffer; combining typeoutoid buffer
-listing with menuoid buffer selection.
-
-If the very next character typed is a space then the buffer list
-window disappears.  Otherwise, one may move around in the buffer list
-window, marking buffers to be selected, saved or deleted.
-
-To exit and select a new buffer, type a space when the cursor is on
-the appropriate line of the buffer-list window.  Other commands are
-much like those of buffer-menu-mode.
-
-Calls value of `electric-buffer-menu-mode-hook' on entry if non-nil.
-
-\\{electric-buffer-menu-mode-map}" 
-  (interactive "P")
-  (let (select buffer)
-    (save-window-excursion
-      (save-window-excursion (list-buffers arg))
-      (setq buffer (window-buffer (Electric-pop-up-window "*Buffer List*")))
-      (unwind-protect
-	  (progn
-	    (set-buffer buffer)
-	    (Electric-buffer-menu-mode)
-	    (setq select
-		  (catch 'electric-buffer-menu-select
-		    (message "<<< Press Return to bury the buffer list >>>")
-		    (if (eq (setq unread-command-events (list (read-event)))
-			    ?\ )
-			(progn (setq unread-command-events nil)
-			       (throw 'electric-buffer-menu-select nil)))
-		    (let ((start-point (point))
-			  (first (progn (goto-char (point-min))
-					(forward-line 2)
-					(point)))
-			  (last (progn (goto-char (point-max))
-				       (forward-line -1)
-				       (point)))
-			  (goal-column 0))
-		      ;; Use start-point if it is meaningful.
-		      (goto-char (if (or (< start-point first)
-					 (> start-point last))
-				     first
-				   start-point))
-		      (Electric-command-loop 'electric-buffer-menu-select
-					     nil
-					     t
-					     'electric-buffer-menu-looper
-					     (cons first last))))))
-	(set-buffer buffer)
-	(Buffer-menu-mode)
-	(bury-buffer buffer)
-	(message "")))
-    (if select
-	(progn (set-buffer buffer)
-	       (let ((opoint (point-marker)))
-		 (Buffer-menu-execute)
-		 (goto-char (point-min))
-		 (if (prog1 (search-forward "\n>" nil t)
-		       (goto-char opoint) (set-marker opoint nil))
-		     (Buffer-menu-select)
-		     (switch-to-buffer (Buffer-menu-buffer t))))))))
-
-(defun electric-buffer-menu-looper (state condition)
-  (cond ((and condition
-	      (not (memq (car condition) '(buffer-read-only
-					   end-of-buffer
-					   beginning-of-buffer))))
-	 (signal (car condition) (cdr condition)))
-	((< (point) (car state))
-	 (goto-char (point-min))
-	 (forward-line 2))
-	((> (point) (cdr state))
-	 (goto-char (point-max))
-	 (forward-line -1)
-	 (if (pos-visible-in-window-p (point-max))
-	     (recenter -1)))))
-
-(put 'Electric-buffer-menu-mode 'mode-class 'special)
-(defun Electric-buffer-menu-mode ()
-  "Major mode for editing a list of buffers.
-Each line describes one of the buffers in Emacs.
-Letters do not insert themselves; instead, they are commands.
-\\<electric-buffer-menu-mode-map>
-\\[keyboard-quit] or \\[Electric-buffer-menu-quit] -- exit buffer menu, returning to previous window and buffer
-  configuration.  If the very first character typed is a space, it
-  also has this effect.
-\\[Electric-buffer-menu-select] -- select buffer of line point is on.
-  Also show buffers marked with m in other windows,
-  deletes buffers marked with \"D\", and saves those marked with \"S\".
-\\[Buffer-menu-mark] -- mark buffer to be displayed.
-\\[Buffer-menu-not-modified] -- clear modified-flag on that buffer.
-\\[Buffer-menu-save] -- mark that buffer to be saved.
-\\[Buffer-menu-delete] or \\[Buffer-menu-delete-backwards] -- mark that buffer to be deleted.
-\\[Buffer-menu-unmark] -- remove all kinds of marks from current line.
-\\[Electric-buffer-menu-mode-view-buffer] -- view buffer, returning when done.
-\\[Buffer-menu-backup-unmark] -- back up a line and remove marks.
-
-\\{electric-buffer-menu-mode-map}
-
-Entry to this mode via command electric-buffer-list calls the value of
-electric-buffer-menu-mode-hook if it is non-nil."
-  (kill-all-local-variables)
-  (use-local-map electric-buffer-menu-mode-map)
-  (setq mode-name "Electric Buffer Menu")
-  (setq mode-line-buffer-identification "Electric Buffer List")
-  (make-local-variable 'Helper-return-blurb)
-  (setq Helper-return-blurb "return to buffer editing")
-  (setq truncate-lines t)
-  (setq buffer-read-only t)
-  (setq major-mode 'Electric-buffer-menu-mode)
-  (goto-char (point-min))
-  (if (search-forward "\n." nil t) (forward-char -1))
-  (run-hooks 'electric-buffer-menu-mode-hook))
-
-;; generally the same as Buffer-menu-mode-map
-;;  (except we don't indirect to global-map)
-(put 'Electric-buffer-menu-undefined 'suppress-keymap t)
-(if electric-buffer-menu-mode-map
-    nil
-  (let ((map (make-keymap)) (submap (make-keymap)))
-    (fillarray (car (cdr map)) 'Electric-buffer-menu-undefined)
-    (define-key map "\e" submap)
-    (fillarray (car (cdr submap)) 'Electric-buffer-menu-undefined)
-    (define-key map "\C-z" 'suspend-emacs)
-    (define-key map "v" 'Electric-buffer-menu-mode-view-buffer)
-    (define-key map (char-to-string help-char) 'Helper-help)
-    (define-key map "?" 'Helper-describe-bindings)
-    (define-key map "\C-c" nil)
-    (define-key map "\C-c\C-c" 'Electric-buffer-menu-quit)
-    (define-key map "\C-]" 'Electric-buffer-menu-quit)
-    (define-key map "q" 'Electric-buffer-menu-quit)
-    (define-key map " " 'Electric-buffer-menu-select)
-    (define-key map "\C-m" 'Electric-buffer-menu-select)
-    (define-key map "\C-l" 'recenter)
-    (define-key map "s" 'Buffer-menu-save)
-    (define-key map "d" 'Buffer-menu-delete)
-    (define-key map "k" 'Buffer-menu-delete)
-    (define-key map "\C-d" 'Buffer-menu-delete-backwards)
-    ;(define-key map "\C-k" 'Buffer-menu-delete)
-    (define-key map "\177" 'Buffer-menu-backup-unmark)
-    (define-key map "~" 'Buffer-menu-not-modified)
-    (define-key map "u" 'Buffer-menu-unmark)
-    (let ((i ?0))
-      (while (<= i ?9)
-	(define-key map (char-to-string i) 'digit-argument)
-	(define-key map (concat "\e" (char-to-string i)) 'digit-argument)
-	(setq i (1+ i))))
-    (define-key map "-" 'negative-argument)
-    (define-key map "\e-" 'negative-argument)
-    (define-key map "m" 'Buffer-menu-mark)
-    (define-key map "\C-u" 'universal-argument)
-    (define-key map "\C-p" 'previous-line)
-    (define-key map "\C-n" 'next-line)
-    (define-key map "p" 'previous-line)
-    (define-key map "n" 'next-line)
-    (define-key map "\C-v" 'scroll-up)
-    (define-key map "\ev" 'scroll-down)
-    (define-key map ">" 'scroll-right)
-    (define-key map "<" 'scroll-left)
-    (define-key map "\e\C-v" 'scroll-other-window)
-    (define-key map "\e>" 'end-of-buffer)
-    (define-key map "\e<" 'beginning-of-buffer)
-    (define-key map "\e\e" nil)
-    (define-key map "\e\e\e" 'Electric-buffer-menu-quit)
-    (define-key map [escape escape escape] 'Electric-buffer-menu-quit)
-    (define-key map [mouse-2] 'Electric-buffer-menu-mouse-select)
-    (setq electric-buffer-menu-mode-map map)))
- 
-(defun Electric-buffer-menu-exit ()
-  (interactive)
-  (setq unread-command-events (listify-key-sequence (this-command-keys)))
-  ;; for robustness
-  (condition-case ()
-      (throw 'electric-buffer-menu-select nil)
-    (error (Buffer-menu-mode)
-	   (other-buffer))))
-
-(defun Electric-buffer-menu-select ()
-  "Leave Electric Buffer Menu, selecting buffers and executing changes.
-Saves buffers marked \"S\".  Deletes buffers marked \"K\".
-Selects buffer at point and displays buffers marked \">\" in other windows."
-  (interactive)
-  (throw 'electric-buffer-menu-select (point)))
-
-(defun Electric-buffer-menu-mouse-select (event)
-  (interactive "e")
-  (select-window (posn-window (event-end event)))
-  (set-buffer (window-buffer (selected-window)))
-  (goto-char (posn-point (event-end event)))
-  (throw 'electric-buffer-menu-select (point)))
-
-(defun Electric-buffer-menu-quit ()
-  "Leave Electric Buffer Menu, restoring previous window configuration.
-Does not execute select, save, or delete commands."
-  (interactive)
-  (throw 'electric-buffer-menu-select nil))
-
-(defun Electric-buffer-menu-undefined ()
-  (interactive)
-  (ding)
-  (message "%s"
-	   (if (and (eq (key-binding "\C-c\C-c") 'Electric-buffer-menu-quit)
-		    (eq (key-binding " ") 'Electric-buffer-menu-select)
-		    (eq (key-binding (char-to-string help-char)) 'Helper-help)
-		    (eq (key-binding "?") 'Helper-describe-bindings))
-	       (substitute-command-keys "Type C-c C-c to exit, Space to select, \\[Helper-help] for help, ? for commands")
-	     (substitute-command-keys "\
-Type \\[Electric-buffer-menu-quit] to exit, \
-\\[Electric-buffer-menu-select] to select, \
-\\[Helper-help] for help, \\[Helper-describe-bindings] for commands.")))
-  (sit-for 4))
-
-(defun Electric-buffer-menu-mode-view-buffer ()
-  "View buffer on current line in Electric Buffer Menu.
-Returns to Electric Buffer Menu when done."
-  (interactive)
-  (let ((bufnam (Buffer-menu-buffer nil)))
-    (if bufnam
-	(view-buffer bufnam)
-      (ding)
-      (message "Buffer %s does not exist!" bufnam)
-      (sit-for 4))))
-
-;;; ebuff-menu.el ends here
diff --git a/lisp/echistory.el b/lisp/echistory.el
deleted file mode 100644
index 66e0b08c52b..00000000000
--- a/lisp/echistory.el
+++ /dev/null
@@ -1,150 +0,0 @@
-;;; echistory.el --- Electric Command History Mode
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; 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.
-
-;;; Code:
-
-(require 'electric)			; command loop
-(require 'chistory)			; history lister
-
-;;;###autoload
-(defun Electric-command-history-redo-expression (&optional noconfirm)
-  "Edit current history line in minibuffer and execute result.
-With prefix arg NOCONFIRM, execute current line as-is without editing."
-  (interactive "P")
-  (let (todo)
-    (save-excursion
-      (set-buffer "*Command History*")
-      (beginning-of-line)
-      (setq todo (read (current-buffer)))
-      (if (boundp 'electric-history-in-progress)
-	  (if todo (throw 'electric-history-quit (list noconfirm todo)))))))
-
-(defvar electric-history-map ())
-(if electric-history-map
-    ()
-  (setq electric-history-map (make-sparse-keymap))
-  (define-key electric-history-map [t] 'Electric-history-undefined)
-  (define-key electric-history-map "\e" (make-sparse-keymap))
-  (define-key electric-history-map [?\e t] 'Electric-history-undefined)
-  (define-key electric-history-map "\C-u" 'universal-argument)
-  (define-key electric-history-map " " 'Electric-command-history-redo-expression)
-  (define-key electric-history-map "!" 'Electric-command-history-redo-expression)
-  (define-key electric-history-map "\e\C-x" 'eval-sexp)
-  (define-key electric-history-map "\e\C-d" 'down-list)
-  (define-key electric-history-map "\e\C-u" 'backward-up-list)
-  (define-key electric-history-map "\e\C-b" 'backward-sexp)
-  (define-key electric-history-map "\e\C-f" 'forward-sexp)
-  (define-key electric-history-map "\e\C-a" 'beginning-of-defun)
-  (define-key electric-history-map "\e\C-e" 'end-of-defun)
-  (define-key electric-history-map "\e\C-n" 'forward-list)
-  (define-key electric-history-map "\e\C-p" 'backward-list)
-  (define-key electric-history-map "q" 'Electric-history-quit)
-  (define-key electric-history-map "\C-c" nil)
-  (define-key electric-history-map "\C-c\C-c" 'Electric-history-quit)
-  (define-key electric-history-map "\C-]" 'Electric-history-quit)
-  (define-key electric-history-map "\C-z" 'suspend-emacs)
-  (define-key electric-history-map (char-to-string help-char) 'Helper-help)
-  (define-key electric-history-map "?" 'Helper-describe-bindings)
-  (define-key electric-history-map "\e>" 'end-of-buffer)
-  (define-key electric-history-map "\e<" 'beginning-of-buffer)
-  (define-key electric-history-map "\n" 'next-line)
-  (define-key electric-history-map "\r" 'next-line)
-  (define-key electric-history-map "\177" 'previous-line)  
-  (define-key electric-history-map "\C-n" 'next-line)
-  (define-key electric-history-map "\C-p" 'previous-line)
-  (define-key electric-history-map "\ev" 'scroll-down)
-  (define-key electric-history-map "\C-v" 'scroll-up)
-  (define-key electric-history-map [home] 'beginning-of-buffer)
-  (define-key electric-history-map [down] 'next-line)
-  (define-key electric-history-map [up] 'previous-line)
-  (define-key electric-history-map [prior] 'scroll-down)
-  (define-key electric-history-map [next] 'scroll-up)
-  (define-key electric-history-map "\C-l" 'recenter)
-  (define-key electric-history-map "\e\C-v" 'scroll-other-window))
-
-(defvar electric-command-history-hook nil
-  "If non-nil, its value is called by `electric-command-history'.")
-
-(defun electric-command-history ()
-  "\\<electric-history-map>Major mode for examining and redoing commands from `command-history'.
-This pops up a window with the Command History listing.
-The number of command listed is controlled by `list-command-history-max'.
-The command history is filtered by `list-command-history-filter' if non-nil.
-Combines typeout Command History list window with menu like selection
-of an expression from the history for re-evaluation in the *original* buffer.
-
-The history displayed is filtered by `list-command-history-filter' if non-nil.
-
-Like Emacs-Lisp mode except that characters do not insert themselves and
-Tab and Linefeed do not indent.  Instead these commands are provided:
-\\{electric-history-map}
-
-Calls the value of `electric-command-history-hook' if that is non-nil.
-The Command History listing is recomputed each time this mode is invoked."
-  (interactive)
-  (let ((electric-history-in-progress t)
-	(old-buffer (current-buffer))
-	(todo))
-    (unwind-protect
-	(setq todo
-	      (catch 'electric-history-quit
-		(save-window-excursion
-		  (save-window-excursion
-		    (list-command-history)
-		    (set-buffer "*Command History*")
-		    (Command-history-setup 'electric-command-history
-					   "Electric History"
-					   electric-history-map))
-		  (Electric-pop-up-window "*Command History*")
-		  (run-hooks 'electric-command-history-hook)
-		  (if (eobp)
-		      (progn (ding)
-			     (message "No command history.")
-			     (throw 'electric-history-quit nil))
-		    (let ((Helper-return-blurb "return to History"))
-		      (Electric-command-loop 'electric-history-quit
-					     "->" t))))))
-      (set-buffer "*Command History*")
-      (Command-history-setup)
-      (bury-buffer (current-buffer)))
-    (if (consp todo)
-	(progn (set-buffer old-buffer)
-	       (if (car todo)
-		   (apply (car (car (cdr todo))) (cdr (car (cdr todo))))
-		 (edit-and-eval-command "Redo: " (car (cdr todo))))))))
-
-(defun Electric-history-undefined ()
-  (interactive)
-  (ding)
-  (message (substitute-command-keys "Type \\[Helper-help] for help, ? for commands, C-c C-c to quit, Space to execute"))
-  (sit-for 4))
-
-(defun Electric-history-quit ()
-  "Quit Electric Command History, restoring previous window configuration."
-  (interactive)
-  (if (boundp 'electric-history-in-progress)
-      (progn (message "")
-	     (throw 'electric-history-quit nil))))
-
-;;; echistory.el ends here
diff --git a/lisp/ediff-diff.el b/lisp/ediff-diff.el
deleted file mode 100644
index 31e126c2292..00000000000
--- a/lisp/ediff-diff.el
+++ /dev/null
@@ -1,1210 +0,0 @@
-;;; ediff-diff.el --- diff-related utilities
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; 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.
-
-;;; Code:
-
-(require 'ediff-init)
-
-
-(defvar ediff-shell
-  (cond ((eq system-type 'emx) "cmd") ; OS/2
-	((memq system-type '(ms-dos windows-nt windows-95))
-	 shell-file-name) ; no standard name on MS-DOS
-	((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VMS
-	(t  "sh")) ; UNIX
-  "*The shell used to run diff and patch.  If user's .profile or
-.cshrc files are set up correctly, any shell will do.  However, some people
-set $prompt or other things incorrectly, which leads to undesirable output
-messages.  These may cause Ediff to fail.  In such a case, set ediff-shell
-to a shell that you are not using or, better, fix your shell's startup file.")
-
-
-(defvar ediff-diff-program "diff"
-  "*Program to use for generating the differential of the two files.")
-(defvar ediff-diff-options ""  
-  "*Options to pass to `ediff-diff-program'. 
-If diff\(1\) is used as `ediff-diff-program', then the most useful options are
-`-w', to ignore space, and `-i', to ignore case of letters.
-At present, the option `-c' is ignored, since Ediff doesn't understand this
-type of output.")
-
-(defvar ediff-custom-diff-program ediff-diff-program
-  "*Program to use for generating custom diff output for saving it in a file.
-This output is not used by Ediff internally.")
-(defvar ediff-custom-diff-options "-c"
-  "*Options to pass to `ediff-custom-diff-program'.")
-
-;;; Support for diff3
-
-(defvar ediff-match-diff3-line "^====\\(.?\\)$"
-  "Pattern to match lines produced by diff3 that describe differences.")
-(defvar ediff-diff3-program "diff3"
-  "*Program to be used for three-way comparison.
-Must produce output compatible with Unix's diff3 program.")
-(defvar ediff-diff3-options ""  
-  "*Options to pass to `ediff-diff3-program'.")
-(defvar ediff-diff3-ok-lines-regexp
-  "^\\([1-3]:\\|====\\|  \\|.*Warning *:\\|.*No newline\\|.*missing newline\\|^\C-m$\\)"
-  "*Regexp that matches normal output lines from `ediff-diff3-program'.
-Lines that do not match are assumed to be error messages.")
-
-;; keeps the status of the current diff in 3-way jobs.
-;; the status can be =diff(A), =diff(B), or =diff(A+B)
-(ediff-defvar-local ediff-diff-status "" "")
-
-  
-;;; Fine differences 
-
-(ediff-defvar-local ediff-auto-refine (if (ediff-has-face-support-p) 'on 'nix)
-  "If `on', Ediff auto-highlights fine diffs for the current diff region.
-If `off', auto-highlighting is not used. If `nix', no fine diffs are shown
-at all, unless the user force-refines the region by hitting `*'.
-
-This variable can be set either in .emacs or toggled interactively.
-Use `setq-default' if setting it in .emacs")
-
-(ediff-defvar-local ediff-ignore-similar-regions nil
-  "*If t, skip over difference regions that differ only in the white space and line breaks.
-This variable can be set either in .emacs or toggled interactively.
-Use `setq-default' if setting it in .emacs")
-
-(ediff-defvar-local ediff-auto-refine-limit 1400
-  "*Auto-refine only the regions of this size \(in bytes\) or less.")
-  
-;;; General
-
-(defvar ediff-diff-ok-lines-regexp  
-  "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\|.*Warning *:\\|.*No +newline\\|.*missing +newline\\|^\C-m$\\)"
-  "Regexp that matches normal output lines from `ediff-diff-program'.
-This is mostly lifted from Emerge, except that Ediff also considers
-warnings and `Missing newline'-type messages to be normal output.
-Lines that do not match are assumed to be error messages.")
-
-(defvar ediff-match-diff-line (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)"))
-				(concat "^" x "\\([acd]\\)" x "$"))
-  "Pattern to match lines produced by diff that describe differences.")
-
-(ediff-defvar-local ediff-setup-diff-regions-function nil
-  "value is a function symbol depending on the kind of job is to be done.
-For 2-way jobs and for ediff-merge, it should be `ediff-setup-diff-regions'.
-For jobs requiring diff3, it should be `ediff-setup-diff-regions3'.
-
-The function should take three mandatory arguments, file-A, file-B, and
-file-C. It may ignore file C for diff2 jobs. It should also take
-one optional arguments, diff-number to refine.")
-
-  
-;;; Functions
-
-;; Generate the difference vector and overlays for the two files
-;; With optional arg REG-TO-REFINE, refine this region.
-;; File-C argument is not used here. It is there just because
-;; ediff-setup-diff-regions is called via a funcall to
-;; ediff-setup-diff-regions-function, which can also have the value
-;; ediff-setup-diff-regions3, which takes 4 arguments.
-(defun ediff-setup-diff-regions (file-A file-B file-C)
-;;;  ;; Force all minibuffers to display ediff's messages.
-;;;  ;; When xemacs implements minibufferless frames, this won't be necessary
-;;;  (if ediff-xemacs-p (setq synchronize-minibuffers t))
-						  
-  ;; create, if it doesn't exist
-  (or (ediff-buffer-live-p ediff-diff-buffer)
-      (setq ediff-diff-buffer
-	    (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*"))))
-  (ediff-make-diff2-buffer ediff-diff-buffer file-A file-B)
-  (ediff-prepare-error-list ediff-diff-ok-lines-regexp ediff-diff-buffer)
-  (ediff-convert-diffs-to-overlays
-   (ediff-extract-diffs
-    ediff-diff-buffer ediff-word-mode ediff-narrow-bounds)))
-
-;; Run the diff program on FILE1 and FILE2 and put the output in DIFF-BUFFER
-;; Return the size of DIFF-BUFFER
-(defun ediff-make-diff2-buffer (diff-buffer file1 file2)
-  (let ((file1-size (ediff-file-size file1))
-	(file2-size (ediff-file-size file2)))
-    (cond ((not (numberp file1-size))
-	   (message "Can't find file: %s"
-		    (ediff-abbreviate-file-name file1))
-	   (sit-for 2)
-	   ;; 1 is an error exit code
-	   1)
-	  ((not (numberp file2-size))
-	   (message "Can't find file: %s"
-		    (ediff-abbreviate-file-name file2))
-	   (sit-for 2)
-	   ;; 1 is an error exit code
-	   1)
-	  ((< file1-size 0)
-	   (message "Can't diff remote files: %s"
-		    (ediff-abbreviate-file-name file1))
-	   (sit-for 2)
-	   ;; 1 is an error exit code
-	   1)
-	  ((< file2-size 0)
-	   (message "Can't diff remote file: %s"
-		    (ediff-abbreviate-file-name file2))
-	   (sit-for 2)
-	   (message "")
-	   ;; 1 is an error exit code
-	   1)
-	  (t (message "Computing differences between %s and %s ..."
-		      (file-name-nondirectory file1)
-		      (file-name-nondirectory file2))
-	     ;; this erases the diff buffer automatically
-	     (ediff-exec-process ediff-diff-program
-				 diff-buffer
-				 'synchronize
-				 ediff-diff-options file1 file2)
-	     ;;(message "Computing differences ... done")
-	     (message "")
-	     (ediff-eval-in-buffer diff-buffer
-	       (buffer-size))))))
-  
-
-     
-;; If file-A/B/C is nil, do 2-way comparison with the non-nil buffers
-;; This function works for diff3 and diff2 jobs
-(defun ediff-setup-fine-diff-regions (file-A file-B file-C reg-num)
-  (or (ediff-buffer-live-p ediff-fine-diff-buffer)
-      (setq ediff-fine-diff-buffer
-	    (get-buffer-create
-	     (ediff-unique-buffer-name "*ediff-fine-diff" "*"))))
-  
-  (let (diff3-job diff-program diff-options ok-regexp diff-list)
-    (setq diff3-job ediff-3way-job
-	  diff-program (if diff3-job ediff-diff3-program ediff-diff-program)
-	  diff-options (if diff3-job ediff-diff3-options ediff-diff-options)
-	  ok-regexp (if diff3-job
-			ediff-diff3-ok-lines-regexp
-			ediff-diff-ok-lines-regexp))
-    
-    (ediff-message-if-verbose "Refining difference region %d ..." (1+ reg-num))
-    (ediff-exec-process diff-program ediff-fine-diff-buffer 'synchronize
-			diff-options
-			;; The shuffle below is because we can compare 3-way
-			;; or in several 2-way fashions, like fA fC, fA fB,
-			;; or fB fC.
-			(if file-A file-A file-B)
-			(if file-B file-B file-A)
-			(if diff3-job
-			    (if file-C file-C file-B))
-			) ; exec process
-  
-    (ediff-prepare-error-list ok-regexp ediff-fine-diff-buffer)
-    (ediff-message-if-verbose
-     "")
-    ;; "Refining difference region %d ... done" (1+ reg-num))
-    
-    (setq diff-list
-	  (if diff3-job
-	      (ediff-extract-diffs3
-	       ediff-fine-diff-buffer '3way-comparison 'word-mode)
-	    (ediff-extract-diffs ediff-fine-diff-buffer 'word-mode)))
-    ;; fixup diff-list
-    (if diff3-job
-	(cond ((not file-A)
-	       (mapcar (function (lambda (elt)
-				   (aset elt 0 nil)
-				   (aset elt 1 nil)))
-		       (cdr diff-list)))
-	      ((not file-B)
-	       (mapcar (function (lambda (elt)
-				   (aset elt 2 nil)
-				   (aset elt 3 nil)))
-		       (cdr diff-list)))
-	      ((not file-C)
-	       (mapcar (function (lambda (elt)
-				   (aset elt 4 nil)
-				   (aset elt 5 nil)))
-		       (cdr diff-list)))
-	  ))
-    
-    (ediff-convert-fine-diffs-to-overlays diff-list reg-num)
-    ))
-  
-    
-(defun ediff-prepare-error-list (ok-regexp diff-buff)
-  (or (ediff-buffer-live-p ediff-error-buffer)
-      (setq ediff-error-buffer
-	    (get-buffer-create (ediff-unique-buffer-name
-				"*ediff-errors" "*"))))
-  (ediff-eval-in-buffer ediff-error-buffer
-    (erase-buffer)
-    (insert (ediff-eval-in-buffer diff-buff (buffer-string)))
-    (goto-char (point-min))
-    (delete-matching-lines ok-regexp)
-    (if (memq system-type '(vax-vms axp-vms))
-	(delete-matching-lines "^$")))
-  ;; If diff reports errors, show them then quit.
-  (if (/= 0 (ediff-eval-in-buffer ediff-error-buffer (buffer-size)))
-      (let ((ctl-buf ediff-control-buffer)
-	    (error-buf ediff-error-buffer))
-	(ediff-skip-unsuitable-frames)
-	(switch-to-buffer error-buf)
-	(ediff-kill-buffer-carefully ctl-buf)
-	(error "Errors in diff output. Diff output is in %S" diff-buff))))
-
-;; BOUNDS specifies visibility bounds to use.
-;; WORD-MODE tells whether we are in the word-mode or not.
-;; If WORD-MODE, also construct vector of diffs using word numbers.
-;; Else, use point values.
-;; This function handles diff-2 jobs including the case of
-;; merging buffers and files without ancestor.
-(defun ediff-extract-diffs (diff-buffer word-mode &optional bounds)
-  (let ((A-buffer ediff-buffer-A)
-	(B-buffer ediff-buffer-B)
-	(C-buffer ediff-buffer-C)
-	(a-prev 1) ; this is needed to set the first diff line correctly
-	(b-prev 1)
-	(c-prev 1)
-	diff-list shift-A shift-B
-	)
- 
-    ;; diff list contains word numbers, unless changed later
-    (setq diff-list (cons (if word-mode 'words 'points)
-			  diff-list))
-    ;; we don't use visibility bounds for buffer C when merging
-    (if bounds
-	(setq shift-A
-	      (ediff-overlay-start
-	       (ediff-get-value-according-to-buffer-type 'A bounds))
-	      shift-B 
-	      (ediff-overlay-start
-	       (ediff-get-value-according-to-buffer-type 'B bounds))))
-    
-    ;; reset point in buffers A/B/C
-    (ediff-eval-in-buffer A-buffer
-      (goto-char (if shift-A shift-A (point-min))))
-    (ediff-eval-in-buffer B-buffer
-      (goto-char (if shift-B shift-B (point-min))))
-    (if (ediff-buffer-live-p C-buffer)
-	(ediff-eval-in-buffer C-buffer
-	  (goto-char (point-min))))
-    
-    (ediff-eval-in-buffer diff-buffer
-      (goto-char (point-min))
-      (while (re-search-forward ediff-match-diff-line nil t)
-       (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1)
-							(match-end 1))))
-	      (a-end  (let ((b (match-beginning 3))
-			    (e (match-end 3)))
-			(if b
-			    (string-to-int (buffer-substring b e))
-			  a-begin)))
-	      (diff-type (buffer-substring (match-beginning 4) (match-end 4)))
-	      (b-begin (string-to-int (buffer-substring (match-beginning 5)
-							(match-end 5))))
-	      (b-end (let ((b (match-beginning 7))
-			   (e (match-end 7)))
-		       (if b
-			   (string-to-int (buffer-substring b e))
-			 b-begin)))
-	      a-begin-pt a-end-pt b-begin-pt b-end-pt
-	      c-begin c-end c-begin-pt c-end-pt)
-	 ;; fix the beginning and end numbers, because diff is somewhat
-	 ;; strange about how it numbers lines
-	 (if (string-equal diff-type "a")
-	     (setq b-end (1+ b-end)
-		   a-begin (1+ a-begin)
-		   a-end a-begin)
-	   (if (string-equal diff-type "d")
-	       (setq a-end (1+ a-end)
-		     b-begin (1+ b-begin)
-		     b-end b-begin)
-	     ;; (string-equal diff-type "c")
-	     (setq a-end (1+ a-end)
-		   b-end (1+ b-end))))
-		   
-	 (if (eq ediff-default-variant 'default-B)
-	     (setq c-begin b-begin
-		   c-end b-end)
-	   (setq c-begin a-begin
-		 c-end a-end))
-	 
-	 ;; compute main diff vector
-	 (if word-mode
-	     ;; make diff-list contain word numbers
-	     (setq diff-list 
-		   (nconc diff-list
-			  (list
-			   (if (ediff-buffer-live-p C-buffer)
-			       (vector (- a-begin a-prev) (- a-end a-begin)
-				       (- b-begin b-prev) (- b-end b-begin)
-				       (- c-begin c-prev) (- c-end c-begin)
-				       nil nil ; dummy ancestor
-				       nil     ; state of diff
-				       nil     ; state of merge
-				       nil     ; state of ancestor
-				       )
-			     (vector (- a-begin a-prev) (- a-end a-begin)
-				     (- b-begin b-prev) (- b-end b-begin)
-				     nil nil ; dummy buf C
-				     nil nil ; dummy ancestor
-				     nil     ; state of diff
-				     nil     ; state of merge
-				     nil     ; state of ancestor
-				     ))
-			   ))
-		   a-prev a-end
-		   b-prev b-end
-		   c-prev c-end)
-	   ;; else convert lines to points
-	   (ediff-eval-in-buffer A-buffer
-	     (forward-line (- a-begin a-prev))
-	     (setq a-begin-pt (point))
-	     (forward-line (- a-end a-begin))
-	     (setq a-end-pt (point)
-		   a-prev a-end))
-	   (ediff-eval-in-buffer B-buffer
-	     (forward-line (- b-begin b-prev))
-	     (setq b-begin-pt (point))
-	     (forward-line (- b-end b-begin))
-	     (setq b-end-pt (point)
-		   b-prev b-end))
-	   (if (ediff-buffer-live-p C-buffer)
-	       (ediff-eval-in-buffer C-buffer
-		 (forward-line (- c-begin c-prev))
-		 (setq c-begin-pt (point))
-		 (forward-line (- c-end c-begin))
-		 (setq c-end-pt (point)
-		       c-prev c-end)))
-	   (setq diff-list 
-		 (nconc
-		  diff-list
-		  (list
-		   (if (ediff-buffer-live-p C-buffer)
-		       (vector
-			a-begin-pt a-end-pt b-begin-pt b-end-pt
-			c-begin-pt c-end-pt
-			nil nil	; dummy ancestor
-			;; state of diff
-			;; shows which buff is different from the other two
-			(if (eq ediff-default-variant 'default-B) 'A 'B)
-			ediff-default-variant	; state of merge
-			nil			; state of ancestor
-			)
-		     (vector a-begin-pt a-end-pt
-			     b-begin-pt b-end-pt
-			     nil nil	; dummy buf C
-			     nil nil	; dummy ancestor
-			     nil nil	; dummy state of diff & merge
-			     nil	; dummy state of ancestor
-			     ))) 
-		  )))
-		  
-	 ))) ; end ediff-eval-in-buffer
-    diff-list
-    ))
-    
-
-(defun ediff-convert-diffs-to-overlays (diff-list)
-  (ediff-set-diff-overlays-in-one-buffer 'A diff-list)
-  (ediff-set-diff-overlays-in-one-buffer 'B diff-list)
-  (if ediff-3way-job
-      (ediff-set-diff-overlays-in-one-buffer 'C diff-list))
-  (if ediff-merge-with-ancestor-job
-      (ediff-set-diff-overlays-in-one-buffer 'Ancestor diff-list))
-  ;; set up vector showing the status of merge regions
-  (if ediff-merge-job
-      (setq ediff-state-of-merge
-	    (vconcat
-	     (mapcar (function
-		      (lambda (elt)
-			(let ((state-of-merge (aref elt 9))
-			      (state-of-ancestor (aref elt 10)))
-			  (vector
-			   (if state-of-merge (format "%S" state-of-merge))
-			   state-of-ancestor))))
-		     ;; the first elt designates type of list
-		     (cdr diff-list))
-	     )))
-  (message "Processing difference regions ... done"))
-
-  
-(defun ediff-set-diff-overlays-in-one-buffer (buf-type diff-list)
-  (let* ((current-diff -1)
-	 (buff (ediff-get-buffer buf-type))
-	 ;; ediff-extract-diffs puts the type of diff-list as the first elt
-	 ;; of this list. The type is either 'points or 'words
-	 (diff-list-type (car diff-list))
-	 (shift (ediff-overlay-start
-		 (ediff-get-value-according-to-buffer-type
-		  buf-type ediff-narrow-bounds)))
-	 (limit (ediff-overlay-end
-		 (ediff-get-value-according-to-buffer-type 
-		  buf-type ediff-narrow-bounds)))
-	 diff-overlay-list list-element total-diffs
-	 begin end pt-saved overlay state-of-diff)
-
-    (setq diff-list (cdr diff-list)) ; discard diff list type
-    (setq total-diffs (length diff-list))
-      
-    ;; shift, if necessary
-    (ediff-eval-in-buffer buff (setq pt-saved shift))
-	   
-    (while diff-list
-      (setq current-diff (1+ current-diff)
-	    list-element (car diff-list)
-	    begin 	 (aref list-element (cond ((eq buf-type 'A) 0)
-						  ((eq buf-type 'B) 2)
-						  ((eq buf-type 'C) 4)
-						  (t 6)))  ; Ancestor
-	    end 	 (aref list-element (cond ((eq buf-type 'A) 1)
-						  ((eq buf-type 'B) 3)
-						  ((eq buf-type 'C) 5)
-						  (t 7)))  ; Ancestor
-	    state-of-diff (aref list-element 8)
-	    )
-		
-      (cond ((and (not (eq buf-type state-of-diff))
-		  (not (eq buf-type 'Ancestor))
-		  (memq state-of-diff '(A B C)))
-	     (setq state-of-diff
-		   (car (delq buf-type (delq state-of-diff (list 'A 'B 'C)))))
-	     (setq state-of-diff (format "=diff(%S)" state-of-diff))
-	     )
-	    (t (setq state-of-diff nil)))
-	    
-      ;; Put overlays at appropriate places in buffer
-      ;; convert word numbers to points, if necessary
-      (if (eq diff-list-type 'words)
-	  (progn
-	    (ediff-eval-in-buffer buff (goto-char pt-saved))
-	    (setq begin (ediff-goto-word (1+ begin) buff)
-		  end (ediff-goto-word end buff 'end))
-	    (if (> end limit) (setq end limit))
-	    (if (> begin end) (setq begin end))
-	    (setq pt-saved (ediff-eval-in-buffer buff (point)))))
-      (setq overlay (ediff-make-bullet-proof-overlay begin end buff))
-      
-      (ediff-overlay-put overlay 'priority ediff-shadow-overlay-priority)
-      (ediff-overlay-put overlay 'ediff-diff-num current-diff)
-      (if (and (ediff-has-face-support-p)
-	       ediff-use-faces ediff-highlight-all-diffs)
-	  (ediff-set-overlay-face
-	   overlay (ediff-background-face buf-type current-diff)))
-
-      (if (= 0 (mod current-diff 10))
-	  (message "Buffer %S: Processing difference region %d of %d"
-		   buf-type current-diff total-diffs))
-      ;; record all overlays for this difference
-      ;; the second elt, nil, is a place holder for the fine diff vector.
-      ;; the third elt, nil, is a place holder for no-fine-diffs flag.
-      (setq diff-overlay-list
-	    (nconc
-	     diff-overlay-list
-	     (list (vector overlay nil nil state-of-diff)))
-	    diff-list
-	    (cdr diff-list))
-      ) ; while
-      
-    (set (intern (format "ediff-difference-vector-%S" buf-type))
-	 (vconcat diff-overlay-list))
-    ))
-
-;; `n' is the diff region to work on.  Default is ediff-current-difference.
-;; if `flag' is 'noforce then make fine-diffs only if this region's fine
-;; diffs have not been computed before.
-;; if `flag' is 'skip then don't compute fine diffs for this region.
-(defun ediff-make-fine-diffs (&optional n flag)       
-  (or n  (setq n ediff-current-difference))
-  
-  (if (< ediff-number-of-differences 1)
-      (error ediff-NO-DIFFERENCES))
-      
-  (if ediff-word-mode
-      (setq flag 'skip
-	    ediff-auto-refine 'nix))
-  
-  (or (< n 0)
-      (>= n ediff-number-of-differences)
-      ;; n is within the range
-      (let ((tmp-buffer (get-buffer-create ediff-tmp-buffer))
-	    (file-A ediff-temp-file-A)
-	    (file-B ediff-temp-file-B)
-	    (file-C ediff-temp-file-C)
-	    (empty-A (ediff-empty-diff-region-p n 'A))
-	    (empty-B (ediff-empty-diff-region-p n 'B))
-	    (empty-C (ediff-empty-diff-region-p n 'C))
-	    (whitespace-A (ediff-whitespace-diff-region-p n 'A))
-	    (whitespace-B (ediff-whitespace-diff-region-p n 'B))
-	    (whitespace-C (ediff-whitespace-diff-region-p n 'C))
-	    cumulative-fine-diff-length)
-	
-	(cond ((and (eq flag 'noforce) (ediff-get-fine-diff-vector n 'A))
-	       ;; don't compute fine diffs if diff vector exists
-	       (if (ediff-no-fine-diffs-p n)
-		   ;;(ediff-message-if-verbose
-		   (message
-		    "Only white-space differences in region %d" (1+ n))))
-	      ;; If one of the regions is empty (or 2 in 3way comparison)
-	      ;; then don't refine.
-	      ;; If the region happens to be entirely whitespace or empty then
-	      ;; mark as such.
-	      ((> (length (delq nil (list empty-A empty-B empty-C))) 1)
-	       (if (and (ediff-looks-like-combined-merge n)
-			ediff-merge-job)
-		   (ediff-set-fine-overlays-in-one-buffer 'C nil n))
-	       (if ediff-3way-comparison-job
-		   (ediff-message-if-verbose
-		    "Region %d is empty in all buffers but %S"
-		    (1+ n) 
-		    (cond ((not empty-A) 'A)
-			  ((not empty-B) 'B)
-			  ((not empty-C) 'C)))
-		 (ediff-message-if-verbose
-		  "Region %d in buffer %S is empty"
-		  (1+ n) 
-		  (cond (empty-A 'A)
-			(empty-B 'B)
-			(empty-C 'C)))
-		 )
-	       ;; if all regions happen to be whitespace
-	       (if (and whitespace-A whitespace-B whitespace-C)
-		   ;; mark as space only
-		   (ediff-mark-diff-as-space-only n t)
-		 ;; if some regions are white and others don't, then mark as
-		 ;; non-white-space-only
-		 (ediff-mark-diff-as-space-only n nil)))
-	      ;; don't compute fine diffs for this region
-	      ((eq flag 'skip)
-	       (or (ediff-get-fine-diff-vector n 'A)
-		   (memq ediff-auto-refine '(off nix))
-		   (ediff-message-if-verbose
-		    "Region %d exceeds auto-refine limit. Type `%s' to refine"
-		    (1+ n)
-		    (substitute-command-keys
-		     "\\[ediff-make-or-kill-fine-diffs]")
-		    )))
-	      (t
-	       ;; recompute fine diffs
-	       (ediff-wordify
-		(ediff-get-diff-posn 'A 'beg n)
-		(ediff-get-diff-posn 'A 'end n)
-		ediff-buffer-A
-		tmp-buffer
-		ediff-control-buffer)
-	       (setq file-A
-		     (ediff-make-temp-file tmp-buffer "fineDiffA" file-A))
-	       
-	       (ediff-wordify
-		(ediff-get-diff-posn 'B 'beg n)
-		(ediff-get-diff-posn 'B 'end n)
-		ediff-buffer-B
-		tmp-buffer
-		ediff-control-buffer)
-	       (setq file-B
-		     (ediff-make-temp-file tmp-buffer "fineDiffB" file-B))
-	       
-	       (if ediff-3way-job
-		   (progn
-		     (ediff-wordify
-		      (ediff-get-diff-posn 'C 'beg n)
-		      (ediff-get-diff-posn 'C 'end n)
-		      ediff-buffer-C
-		      tmp-buffer
-		      ediff-control-buffer)
-		     (setq file-C
-			   (ediff-make-temp-file
-			    tmp-buffer "fineDiffC" file-C))))
-	       
-	       ;; save temp file names.
-	       (setq ediff-temp-file-A file-A
-		     ediff-temp-file-B file-B
-		     ediff-temp-file-C file-C)
-	       
-	       ;; set the new vector of fine diffs, if none exists
-	       (cond ((and ediff-3way-job whitespace-A)
-		      (ediff-setup-fine-diff-regions nil file-B file-C n))
-		     ((and ediff-3way-job whitespace-B)
-		      (ediff-setup-fine-diff-regions file-A nil file-C n))
-		     ((and ediff-3way-job
-			   ;; In merge-jobs, whitespace-C is t, since
-			   ;; ediff-empty-diff-region-p returns t in this case
-			   whitespace-C)
-		      (ediff-setup-fine-diff-regions file-A file-B nil n))
-		     (t
-		      (ediff-setup-fine-diff-regions file-A file-B file-C n)))
-		      
-	       (setq cumulative-fine-diff-length
-		     (+ (length (ediff-get-fine-diff-vector n 'A))
-			(length (ediff-get-fine-diff-vector n 'B))
-			;; in merge jobs, the merge buffer is never refined
-			(if (and file-C (not ediff-merge-job))
-			    (length (ediff-get-fine-diff-vector n 'C))
-			  0)))
-		      
-	       (cond ((or
-		       ;; all regions are white space
-		       (and whitespace-A whitespace-B whitespace-C)
-		       ;; none is white space and no fine diffs detected
-		       (and (not whitespace-A)
-			    (not whitespace-B)
-			    (not (and ediff-3way-job whitespace-C))
-			    (eq cumulative-fine-diff-length 0)))
-		      (ediff-mark-diff-as-space-only n t)
-		      (ediff-message-if-verbose
-		       "Only white-space differences in region %d" (1+ n)))
-		     ((eq cumulative-fine-diff-length 0)
-		      (ediff-mark-diff-as-space-only n t)
-		      (ediff-message-if-verbose
-		       "Only white-space differences in region %d %s"
-		       (1+ n)
-		       (cond (whitespace-A "in buffers B & C")
-			     (whitespace-B "in buffers A & C")
-			     (whitespace-C "in buffers A & B"))))
-		     (t 
-		      (ediff-mark-diff-as-space-only n nil)))
-	       )
-	      ) ; end cond
-	(ediff-set-fine-diff-properties n)
-	)))
-	
-;; Interface to ediff-make-fine-diffs. Checks for auto-refine limit, etc.
-(defun ediff-install-fine-diff-if-necessary (n)
-  (cond ((eq ediff-auto-refine 'on)
-	 (if (and
-	      (> ediff-auto-refine-limit
-		 (- (ediff-get-diff-posn 'A 'end n)
-		    (ediff-get-diff-posn 'A 'beg n)))
-	      (> ediff-auto-refine-limit
-		 (- (ediff-get-diff-posn 'B 'end n)
-		    (ediff-get-diff-posn 'B 'beg n))))
-	     (ediff-make-fine-diffs n 'noforce)
-	   (ediff-make-fine-diffs n 'skip)))
-	
-	;; highlight iff fine diffs already exist
-	((eq ediff-auto-refine 'off)
-	 (ediff-make-fine-diffs n 'skip))))
-    
-    
-;; if fine diff vector is not set for diff N, then do nothing
-(defun ediff-set-fine-diff-properties (n &optional default)
-  (or (not (ediff-has-face-support-p))
-      (< n 0)
-      (>= n ediff-number-of-differences)
-      ;; when faces are supported, set faces and priorities of fine overlays
-      (progn
-	(ediff-set-fine-diff-properties-in-one-buffer 'A n default)
-	(ediff-set-fine-diff-properties-in-one-buffer 'B n default)
-	(if ediff-3way-job
-	    (ediff-set-fine-diff-properties-in-one-buffer 'C n default)))))
-	
-(defun ediff-set-fine-diff-properties-in-one-buffer (buf-type
-						     n &optional default)
-  (let ((fine-diff-vector  (ediff-get-fine-diff-vector n buf-type))
-	(face (if default 
-		  'default
-		(face-name
-		 (intern (format "ediff-fine-diff-face-%S" buf-type)))))
-	(priority (if default
-		      0
-		    (1+ (or (ediff-overlay-get
-			     (symbol-value
-			      (intern
-			       (format
-				"ediff-current-diff-overlay-%S" buf-type)))
-			     'priority)
-			    0)))))
-    (mapcar
-     (function (lambda (overl)
-		 (ediff-set-overlay-face overl face)
-		 (ediff-overlay-put overl 'priority priority)))
-     fine-diff-vector)))
-     
-;; This assumes buffer C and that the region looks like a combination of
-;; regions in buffer A and C.
-(defun ediff-set-fine-overlays-for-combined-merge (diff-list reg-num)
-  (let (overlay1 overlay2 overlay3)
-    (setq overlay1 (ediff-make-bullet-proof-overlay (nth 0 diff-list)
-						    (nth 1 diff-list)
-						    ediff-buffer-C)
-	  overlay2 (ediff-make-bullet-proof-overlay (nth 2 diff-list)
-						    (nth 3 diff-list)
-						    ediff-buffer-C)
-	  overlay3 (ediff-make-bullet-proof-overlay (nth 4 diff-list)
-						    (nth 5 diff-list)
-						    ediff-buffer-C))
-    (ediff-set-fine-diff-vector reg-num 'C (vector overlay1 overlay2 overlay3))
-    ))
-	
-    
-;; Convert diff list to overlays for a given DIFF-REGION
-;; in buffer of type BUF-TYPE
-(defun ediff-set-fine-overlays-in-one-buffer (buf-type diff-list region-num)
-  (let* ((current-diff -1)
-	 (reg-start (ediff-get-diff-posn buf-type 'beg region-num))
-	 (buff (ediff-get-buffer buf-type))
-	 combined-merge-diff-list
-	 diff-overlay-list list-element
-	 begin end overlay)
-
-    (ediff-clear-fine-differences-in-one-buffer region-num buf-type)
-    (setq diff-list (cdr diff-list)) ; discard list type (words or points)
-    (ediff-eval-in-buffer buff (goto-char reg-start))
-    
-    ;; if it is a combined merge then set overlays in buff C specially
-    (if (and ediff-merge-job (eq buf-type 'C)
-	     (setq combined-merge-diff-list
-		   (ediff-looks-like-combined-merge region-num)))
-	(ediff-set-fine-overlays-for-combined-merge
-	 combined-merge-diff-list region-num)
-      ;; regular fine diff
-      (while diff-list
-	(setq current-diff (1+ current-diff)
-	      list-element (car diff-list)
-	      begin 	 (aref list-element (cond ((eq buf-type 'A) 0)
-						  ((eq buf-type 'B) 2)
-						  (t 4)))  ; buf C
-	      end 	 (aref list-element (cond ((eq buf-type 'A) 1)
-						  ((eq buf-type 'B) 3)
-						  (t 5)))) ; buf C
-	(if (not (or begin end))
-	    () ; skip this diff
-	  ;; Put overlays at appropriate places in buffers
-	  ;; convert lines to points, if necessary
-	  (setq begin (ediff-goto-word (1+ begin) buff)
-		end (ediff-goto-word end buff 'end))
-	  (setq overlay (ediff-make-bullet-proof-overlay begin end buff))
-	  ;; record all overlays for this difference region
-	  (setq diff-overlay-list (nconc diff-overlay-list (list overlay))))
-	
-	(setq diff-list (cdr diff-list))
-	) ; while
-      ;; convert the list of difference information into a vector
-      ;; for fast access
-      (ediff-set-fine-diff-vector 
-       region-num buf-type (vconcat diff-overlay-list))
-      )))
-
-
-;; Stolen from emerge.el
-(defun ediff-get-diff3-group (file)
-  ;; This save-excursion allows ediff-get-diff3-group to be called for the
-  ;; various groups of lines (1, 2, 3) in any order, and for the lines to
-  ;; appear in any order.  The reason this is necessary is that Gnu diff3
-  ;; can produce the groups in the order 1, 2, 3 or 1, 3, 2.
-  (save-excursion
-    (re-search-forward
-     (concat "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)$"))
-    (beginning-of-line 2)
-    ;; treatment depends on whether it is an "a" group or a "c" group
-    (if (string-equal (buffer-substring (match-beginning 4) (match-end 4)) "c")
-	;; it is a "c" group
-	(if (match-beginning 2)
-	    ;; it has two numbers
-	    (list (string-to-int
-		   (buffer-substring (match-beginning 1) (match-end 1)))
-		  (1+ (string-to-int
-		       (buffer-substring (match-beginning 3) (match-end 3)))))
-	  ;; it has one number
-	  (let ((x (string-to-int
-		    (buffer-substring (match-beginning 1) (match-end 1)))))
-	    (list x (1+ x))))
-      ;; it is an "a" group
-      (let ((x (1+ (string-to-int
-		    (buffer-substring (match-beginning 1) (match-end 1))))))
-	(list x x)))))
-
-
-;; If WORD-MODE, construct vector of diffs using word numbers.
-;; Else, use point values.
-;; WORD-MODE also tells if we are in the word-mode or not.
-;; If THREE-WAY-COMP, then it is a 3-way comparison. Else, it is merging
-;; with ancestor, in which case buffer-C contents is identical to buffer-A/B,
-;; contents (unless buffer-A is narrowed) depending on ediff-default-variant's
-;; value.
-;; BOUNDS specifies visibility bounds to use.
-(defun ediff-extract-diffs3 (diff-buffer word-mode three-way-comp
-					  &optional bounds)
-  (let ((A-buffer ediff-buffer-A)
-	(B-buffer ediff-buffer-B)
-	(C-buffer ediff-buffer-C)
-	(anc-buffer ediff-ancestor-buffer)
-	(a-prev 1) ; needed to set the first diff line correctly
-	(b-prev 1)
-	(c-prev 1)
-	(anc-prev 1)
-	diff-list shift-A shift-B shift-C
-	)
- 
-    ;; diff list contains word numbers or points, depending on word-mode
-    (setq diff-list (cons (if word-mode 'words 'points)
-			  diff-list))
-    (if bounds
-	(setq shift-A
-	      (ediff-overlay-start
-	       (ediff-get-value-according-to-buffer-type 'A bounds))
-	      shift-B 
-	      (ediff-overlay-start
-	       (ediff-get-value-according-to-buffer-type 'B bounds))
-	      shift-C 
-	      (if three-way-comp
-		  (ediff-overlay-start
-		   (ediff-get-value-according-to-buffer-type 'C bounds)))))
-    
-    ;; reset point in buffers A, B, C
-    (ediff-eval-in-buffer A-buffer
-      (goto-char (if shift-A shift-A (point-min))))
-    (ediff-eval-in-buffer B-buffer
-      (goto-char (if shift-B shift-B (point-min))))
-    (if three-way-comp
-	(ediff-eval-in-buffer C-buffer
-	  (goto-char (if shift-C shift-C (point-min)))))
-    (if (ediff-buffer-live-p anc-buffer)
-	(ediff-eval-in-buffer anc-buffer
-	  (goto-char (point-min))))
-    
-    (ediff-eval-in-buffer diff-buffer
-      (goto-char (point-min))
-      (while (re-search-forward ediff-match-diff3-line nil t)
-	;; leave point after matched line
-       (beginning-of-line 2)
-       (let ((agreement (buffer-substring (match-beginning 1) (match-end 1))))
-	 ;; if the files A and B are the same and not 3way-comparison,
-	 ;; ignore the difference
-	 (if (or three-way-comp (not (string-equal agreement "3")))
-	     (let* ((a-begin (car (ediff-get-diff3-group "1")))
-		    (a-end  (nth 1 (ediff-get-diff3-group "1")))
-		    (b-begin (car (ediff-get-diff3-group "2")))
-		    (b-end (nth 1 (ediff-get-diff3-group "2")))
-		    (c-or-anc-begin (car (ediff-get-diff3-group "3")))
-		    (c-or-anc-end (nth 1 (ediff-get-diff3-group "3")))
-		    (state-of-merge
-		     (cond ((string-equal agreement "1") 'prefer-A)
-			   ((string-equal agreement "2") 'prefer-B)
-			   (t ediff-default-variant)))
-		    (state-of-diff-merge
-		     (if (memq state-of-merge '(default-A prefer-A)) 'B 'A))
-		    (state-of-diff-comparison
-		     (cond ((string-equal agreement "1") 'A)
-			   ((string-equal agreement "2") 'B)
-			   ((string-equal agreement "3") 'C)))
-		    state-of-ancestor
-		    c-begin c-end
-		    a-begin-pt a-end-pt
-		    b-begin-pt b-end-pt
-		    c-begin-pt c-end-pt
-		    anc-begin-pt anc-end-pt)
-		    
-	       (setq state-of-ancestor
-		     (= c-or-anc-begin c-or-anc-end))
-
-	       (cond (three-way-comp
-		      (setq c-begin c-or-anc-begin
-			    c-end c-or-anc-end))
-		     ((eq ediff-default-variant 'default-B)
-		      (setq c-begin b-begin
-			    c-end b-end))
-		     (t
-		      (setq c-begin a-begin
-			    c-end a-end)))
-	 
-	       ;; compute main diff vector
-	       (if word-mode
-		   ;; make diff-list contain word numbers
-		   (setq diff-list 
-			 (nconc diff-list
-				(list (vector
-				       (- a-begin a-prev) (- a-end a-begin)
-				       (- b-begin b-prev) (- b-end b-begin)
-				       (- c-begin c-prev) (- c-end c-begin)
-				       nil nil ; dummy ancestor
-				       nil     ; state of diff
-				       nil     ; state of merge
-				       nil     ; state of ancestor
-				       )))
-			 a-prev a-end
-			 b-prev b-end
-			 c-prev c-end)
-		 ;; else convert lines to points
-		 (ediff-eval-in-buffer A-buffer
-		   (forward-line (- a-begin a-prev))
-		   (setq a-begin-pt (point))
-		   (forward-line (- a-end a-begin))
-		   (setq a-end-pt (point)
-			 a-prev a-end))
-		 (ediff-eval-in-buffer B-buffer
-		   (forward-line (- b-begin b-prev))
-		   (setq b-begin-pt (point))
-		   (forward-line (- b-end b-begin))
-		   (setq b-end-pt (point)
-			 b-prev b-end))
-		 (ediff-eval-in-buffer C-buffer
-		   (forward-line (- c-begin c-prev))
-		   (setq c-begin-pt (point))
-		   (forward-line (- c-end c-begin))
-		   (setq c-end-pt (point)
-			 c-prev c-end))
-		 (if (ediff-buffer-live-p anc-buffer)
-		     (ediff-eval-in-buffer anc-buffer
-		       (forward-line (- c-or-anc-begin anc-prev))
-		       (setq anc-begin-pt (point))
-		       (forward-line (- c-or-anc-end c-or-anc-begin))
-		       (setq anc-end-pt (point)
-			     anc-prev c-or-anc-end)))
-		 (setq diff-list 
-		       (nconc
-			diff-list
-			;; if comparing with ancestor, then there also is a
-			;; state-of-difference marker
-			(if three-way-comp
-			    (list (vector
-				   a-begin-pt a-end-pt
-				   b-begin-pt b-end-pt
-				   c-begin-pt c-end-pt
-				   nil nil ; ancestor begin/end
-				   state-of-diff-comparison
-				   nil	; state of merge
-				   nil  ; state of ancestor
-				   ))
-			  (list (vector a-begin-pt a-end-pt
-					b-begin-pt b-end-pt
-					c-begin-pt c-end-pt
-					anc-begin-pt anc-end-pt
-					state-of-diff-merge
-					state-of-merge
-					state-of-ancestor
-					)))
-			)))
-	       ))
-	       
-	 ))) ; end ediff-eval-in-buffer
-    diff-list
-    ))
-    
-;; Generate the difference vector and overlays for three files
-;; File-C is either the third file to compare (in case of 3-way comparison)
-;; or it is the ancestor file.
-(defun ediff-setup-diff-regions3 (file-A file-B file-C)
-  
-;;;  ;; force all minibuffers to display ediff's messages.
-;;;  ;; when xemacs implements minibufferless frames, this won't be necessary
-;;;  (if ediff-xemacs-p (setq synchronize-minibuffers t))
-						  
-  (or (ediff-buffer-live-p ediff-diff-buffer)
-      (setq ediff-diff-buffer
-	    (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*"))))
-  
-  (message "Computing differences ...")
-  (ediff-exec-process ediff-diff3-program ediff-diff-buffer 'synchronize
-		      ediff-diff3-options file-A file-B file-C)
-  
-  (ediff-prepare-error-list ediff-diff3-ok-lines-regexp ediff-diff-buffer)
-  ;;(message "Computing differences ... done")
-  (ediff-convert-diffs-to-overlays
-   (ediff-extract-diffs3
-    ediff-diff-buffer
-    ediff-word-mode ediff-3way-comparison-job ediff-narrow-bounds)
-   ))
-   
-
-;; Execute PROGRAM asynchronously, unless OS/2, Windows-*, or DOS, or unless
-;; SYNCH is non-nil.  BUFFER must be a buffer object, and must be alive.  All
-;; arguments in ARGS must be strings. The first arg may be a blank string, in
-;; which case we delete it from ARGS list. We also delete nil from args.
-(defun ediff-exec-process (program buffer synch &rest args)
-  (let ((data (match-data)))
-    (if (string-match "^[ \t]*$" (car args)) ; delete blank string
-	(setq args (cdr args)))
-    (setq args (delq nil args)) ; delete nil from arguments
-    (setq args (ediff-split-string (mapconcat 'identity args " ")))
-    (unwind-protect
-	(let ((directory default-directory)
-	      proc)
-	  (save-excursion
-	    (set-buffer buffer)
-	    (erase-buffer)
-	    (setq default-directory directory)
-	    (if (or (memq system-type '(emx ms-dos windows-nt windows-95))
-		    synch)
-		;; In OS/2 (emx) do it synchronously, since OS/2 doesn't let us
-		;; delete files used by other processes. Thus, in ediff-buffers
-		;; and similar functions, we can't delete temp files because
-		;; they might be used by the asynch process that computes
-		;; custom diffs. So, we have to wait till custom diff
-		;; subprocess is done.
-		;; Similarly for Windows-*
-		;; In DOS, must synchronize because DOS doesn't have
-		;; asynchronous processes.
-		(apply 'call-process program nil buffer nil args)
-	      ;; On other systems, do it asynchronously.
-	      (setq proc (get-buffer-process buffer))
-	      (if proc (kill-process proc))
-	      (setq proc
-		    (apply 'start-process "Custom Diff" buffer program args))
-	      (setq mode-line-process '(":%s"))
-	      (set-process-sentinel proc 'ediff-process-sentinel)
-	      (set-process-filter proc 'ediff-process-filter)
-	      )))
-      (store-match-data data))))
-      
-;; This is shell-command-filter from simple.el in FSF Emacs.
-;; Copied here because XEmacs doesn't have it.
-(defun ediff-process-filter (proc string)
-  ;; Do save-excursion by hand so that we can leave point numerically unchanged
-  ;; despite an insertion immediately after it.
-  (let* ((obuf (current-buffer))
-         (buffer (process-buffer proc))
-         opoint
-         (window (get-buffer-window buffer))
-         (pos (window-start window)))
-    (unwind-protect
-        (progn
-          (set-buffer buffer)
-          (or (= (point) (point-max))
-              (setq opoint (point)))
-          (goto-char (point-max))
-          (insert-before-markers string))
-      ;; insert-before-markers moved this marker: set it back.
-      (set-window-start window pos)
-      ;; Finish our save-excursion.
-      (if opoint
-          (goto-char opoint))
-      (set-buffer obuf))))
-      
-;; like shell-command-sentinel but doesn't print an exit status message
-;; we do this because diff always exits with status 1, if diffs are found
-;; so shell-command-sentinel displays a confusing message to the user
-(defun ediff-process-sentinel (process signal)
-  (if (and (memq (process-status process) '(exit signal))
-           (buffer-name (process-buffer process)))
-      (progn
-        (save-excursion
-          (set-buffer (process-buffer process))
-          (setq mode-line-process nil))
-        (delete-process process))))
-	
-
-;;; Word functions used to refine the current diff	    
-
-(defvar ediff-forward-word-function 'ediff-forward-word
-  "*Function to call to move to the next word.
-Used for splitting difference regions into individual words.")
-
-(defvar ediff-whitespace " \n\t\f"
-  "*Characters constituting white space.
-These characters are ignored when differing regions are split into words.")
-
-;;(defvar ediff-word-1 "a-zA-Z---_`'.?!:"
-(defvar ediff-word-1 "a-zA-Z---_"
-  "*Characters that constitute words of type 1.
-More precisely, [ediff-word-1] is a regexp that matches type 1 words.
-See `ediff-forward-word' for more details.")  
-
-(defvar ediff-word-2 "0-9.,"
-  "*Characters that constitute words of type 2.
-More precisely, [ediff-word-2] is a regexp that matches type 2 words.
-See `ediff-forward-word' for more details.")
-
-(defvar ediff-word-3 "`'?!:;\"{}[]()"
-  "*Characters that constitute words of type 3.
-More precisely, [ediff-word-3] is a regexp that matches type 3 words.
-See `ediff-forward-word' for more details.")
-
-(defvar ediff-word-4
-  (concat "^" ediff-word-1 ediff-word-2 ediff-word-3 ediff-whitespace)
-  "*Characters that constitute words of type 4.
-More precisely, [ediff-word-4] is a regexp that matches type 4 words.
-See `ediff-forward-word' for more details.")  
-
-;; Split region along word boundaries. Each word will be on its own line.
-;; Output to buffer out-buffer.
-(defun ediff-forward-word ()
-  "Move point one word forward.
-There are four types of words, each of which consists entirely of
-characters in `ediff-word-1', `ediff-word-2', `ediff-word-3', or
-`ediff-word-4'.  Words are recognized by passing these in turn as the
-argument to `skip-chars-forward'."
-  (or (> (skip-chars-forward ediff-word-1) 0)
-      (> (skip-chars-forward ediff-word-2) 0)
-      (> (skip-chars-forward ediff-word-3) 0)
-      (> (skip-chars-forward ediff-word-4) 0)
-      ))
-
-(defun ediff-wordify (beg end in-buffer out-buffer &optional control-buf)
-  (let (sv-point string)
-    (save-excursion
-     (set-buffer in-buffer)
-     (setq string (buffer-substring beg end))
-
-     (set-buffer out-buffer)
-     (erase-buffer)
-     (insert string)
-     (goto-char (point-min))
-     (skip-chars-forward ediff-whitespace)
-     (delete-region (point-min) (point))
-     
-     (while (not (eobp))
-       ;; eval incontrol buf to let user create local versions for
-       ;; different invocations
-       (if control-buf
-	   (funcall 
-	    (ediff-eval-in-buffer control-buf ediff-forward-word-function))
-	 (funcall ediff-forward-word-function))
-       (setq sv-point (point))
-       (skip-chars-forward ediff-whitespace)
-       (delete-region sv-point (point))
-       (insert "\n")))))
-       
-;; copy string from BEG END from IN-BUF to OUT-BUF
-(defun ediff-copy-to-buffer (beg end in-buffer out-buffer)
-  (let (string)
-    (save-excursion
-      (set-buffer in-buffer)
-     (setq string (buffer-substring beg end))
-
-     (set-buffer out-buffer)
-     (erase-buffer)
-     (insert string)
-     (goto-char (point-min)))))
-
-
-;; goto word #n starting at current position in buffer `buf'
-;; For ediff, a word is either a string of a-z,A-Z, incl `-' and `_';
-;; or a string of other non-blanks. A blank is a \n\t\f
-;; If `flag' is non-nil, goto the end of the n-th word.
-(defun ediff-goto-word (n buf &optional flag)
-  ;; remember val ediff-forward-word-function has in ctl buf
-  (let ((fwd-word-fun ediff-forward-word-function))
-    (ediff-eval-in-buffer buf
-      (skip-chars-forward ediff-whitespace)
-      (while (> n 1)
-	(funcall fwd-word-fun)
-	(skip-chars-forward ediff-whitespace)
-	(setq n (1- n)))
-      (if (and flag (> n 0))
-	  (funcall fwd-word-fun))
-      (point))))
-
-
-;;; Local Variables:
-;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
-;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
-;;; End:
-
-(provide 'ediff-diff)
-
-
-;; ediff-diff.el ends here
diff --git a/lisp/ediff-help.el b/lisp/ediff-help.el
deleted file mode 100644
index 6390b98e407..00000000000
--- a/lisp/ediff-help.el
+++ /dev/null
@@ -1,311 +0,0 @@
-;;; ediff-help.el --- Code related to the contents of Ediff help buffers
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; 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.
-
-;;; Code:
-
-(require 'ediff-init)
-
-;; Compiler pacifier start
-(defvar ediff-multiframe)
-(and noninteractive
-     (eval-when-compile
-       (let ((load-path (cons (expand-file-name ".") load-path)))
-	 (load-file "ediff-init.el"))))
-;; end pacifier
-
-;; Help messages
-
-(defconst ediff-long-help-message-head
-  "    Move around      |      Toggle features      |        Manipulate
-=====================|===========================|============================="
-  "The head of the full help message.")
-(defconst ediff-long-help-message-tail
-  "=====================|===========================|=============================
-    R -show registry |     = -compare regions    |  M   -show session group    
-    D -diff output   |     E -browse Ediff manual|  G   -send bug report       
-    i -status info   |     ? -help off           |  z/q -suspend/quit          
--------------------------------------------------------------------------------
-For help on a specific command:  Click Button 2 over it; or
-              			 Put the cursor over it and type RET."
-  "The tail of the full-help message.")
-
-(defconst ediff-long-help-message-compare3
-  "
-p,DEL -previous diff |     | -vert/horiz split   | xy -copy buf X's region to Y
-n,SPC -next diff     |     h -hilighting         | rx -restore buf X's old diff
-    j -jump to diff  |     @ -auto-refinement    |  * -refine current region   
-   gx -goto X's point|                           |  ! -update diff regions     
-  C-l -recenter      |    ## -ignore whitespace  |
-  v/V -scroll up/dn  | #f/#h -focus/hide regions | wx -save buf X              
-  </> -scroll lt/rt  |     X -read-only in buf X | wd -save diff output        
-    ~ -rotate buffers|     m -wide display       |
-"
-  "Help message usually used for 3-way comparison.
-Normally, not a user option. See `ediff-help-message' for details.")
-  
-(defconst ediff-long-help-message-compare2
-  "
-p,DEL -previous diff |     | -vert/horiz split   |a/b -copy A/B's region to B/A
-n,SPC -next diff     |     h -hilighting         | rx -restore buf X's old diff
-    j -jump to diff  |     @ -auto-refinement    |  * -refine current region   
-   gx -goto X's point|                           |  ! -update diff regions     
-  C-l -recenter      |    ## -ignore whitespace  |
-  v/V -scroll up/dn  | #f/#h -focus/hide regions | wx -save buf X              
-  </> -scroll lt/rt  |     X -read-only in buf X | wd -save diff output        
-    ~ -swap variants |     m -wide display       |  
-"
-  "Help message usually used for 2-way comparison.
-Normally, not a user option. See `ediff-help-message' for details.")
-  
-(defconst ediff-long-help-message-narrow2
-  "
-p,DEL -previous diff |     | -vert/horiz split   |a/b -copy A/B's region to B/A
-n,SPC -next diff     |     h -hilighting         | rx -restore buf X's old diff
-    j -jump to diff  |     @ -auto-refinement    |  * -refine current region   
-   gx -goto X's point|     % -narrow/widen buffs |  ! -update diff regions     
-  C-l -recenter      |    ## -ignore whitespace  |
-  v/V -scroll up/dn  | #f/#h -focus/hide regions | wx -save buf X              
-  </> -scroll lt/rt  |     X -read-only in buf X | wd -save diff output        
-    ~ -swap variants |     m -wide display       |  
-"
-  "Help message when comparing windows or regions line-by-line.
-Normally, not a user option. See `ediff-help-message' for details.")
-  
-(defconst ediff-long-help-message-word-mode
-  "
-p,DEL -previous diff |     | -vert/horiz split   | xy -copy buf X's region to Y
-n,SPC -next diff     |     h -hilighting         | rx -restore buf X's old diff
-    j -jump to diff  |                           |                   
-   gx -goto X's point|     % -narrow/widen buffs |  ! -recompute diffs         
-  C-l -recenter      |                           |
-  v/V -scroll up/dn  | #f/#h -focus/hide regions | wx -save buf X              
-  </> -scroll lt/rt  |     X -read-only in buf X | wd -save diff output        
-    ~ -swap variants |     m -wide display       |  
-"
-  "Help message when comparing windows or regions word-by-word.
-Normally, not a user option. See `ediff-help-message' for details.")
-  
-(defconst ediff-long-help-message-merge
-  "
-p,DEL -previous diff |     | -vert/horiz split   |  x -copy buf X's region to C
-n,SPC -next diff     |     h -hilighting         |  r -restore buf C's old diff
-    j -jump to diff  |     @ -auto-refinement    |  * -refine current region   
-   gx -goto X's point|    ## -ignore whitespace  |  ! -update diff regions     
-  C-l -recenter      | #f/#h -focus/hide regions |  + -combine diff regions    
-  v/V -scroll up/dn  |     X -read-only in buf X | wx -save buf X              
-  </> -scroll lt/rt  |     m -wide display       | wd -save diff output        
-    ~ -swap variants |     s -shrink window C    |  / -show ancestor buff      
-                     |     $ -show clashes only  |  & -merge w/new default     
-"
-  "Help message during merging.
-Normally, not a user option. See `ediff-help-message' for details.")
-
-;; The actual long help message.
-(ediff-defvar-local ediff-long-help-message ""
-  "Normally, not a user option. See `ediff-help-message' for details.")
-  
-(defconst ediff-brief-message-string
-  "? -quick help "
-  "Contents of the brief help message.")
-;; The actual brief help message
-(ediff-defvar-local ediff-brief-help-message ""
-  "Normally, not a user option. See `ediff-help-message' for details.")
-  
-(ediff-defvar-local ediff-brief-help-message-function nil
-  "The brief help message that the user can customize.
-If the user sets this to a parameter-less function, Ediff will use it to
-produce the brief help message. This function must return a string.")
-(ediff-defvar-local ediff-long-help-message-function nil
-  "The long help message that the user can customize.
-See `ediff-brief-help-message-function' for more.")
-
-(defvar ediff-use-long-help-message nil
-  "*If t, Ediff displays a long help message. Short help message otherwise.")
-
-;; The actual help message.
-(ediff-defvar-local ediff-help-message ""
-  "The actual help message.
-Normally, the user shouldn't touch this. However, if you want Ediff to
-start up with different help messages for different jobs, you can change
-the value of this variable and the variables `ediff-help-message-*' in
-`ediff-startup-hook'.") 
-
-
-;; the keymap that defines clicks over the quick help regions
-(defvar ediff-help-region-map (make-sparse-keymap))
-
-(define-key
-  ediff-help-region-map
-  (if ediff-emacs-p [mouse-2] [button2])
-  'ediff-help-for-quick-help)
-
-;; runs in the control buffer
-(defun ediff-set-help-overlays ()
-  (goto-char (point-min))
-  (let (overl beg end cmd)
-    (while (re-search-forward " *\\([^ \t\n|]+\\||\\) +-[^|\n]+" nil 'noerror)
-      (setq beg (match-beginning 0)
-	    end (match-end 0)
-	    cmd (buffer-substring (match-beginning 1) (match-end 1)))
-      (setq overl (ediff-make-overlay beg end))
-      (if ediff-emacs-p
-	  (ediff-overlay-put overl 'mouse-face 'highlight)
-	(ediff-overlay-put overl 'highlight t))
-      (ediff-overlay-put overl 'ediff-help-info cmd))))
-
-
-(defun ediff-help-for-quick-help ()
-  "Explain Ediff commands in more detail."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (let ((ctl-buf (current-buffer))
-	(pos (ediff-event-point last-command-event))
-	overl cmd)
-
-    (if ediff-xemacs-p
-	(setq overl (extent-at pos (current-buffer) 'ediff-help-info)
-	      cmd   (ediff-overlay-get overl 'ediff-help-info))
-      (setq cmd (car (mapcar (function (lambda (elt)
-					 (overlay-get elt 'ediff-help-info)))
-			     (overlays-at pos)))))
-    
-    (if (not (stringp cmd))
-	(error "Hmm... I don't see an Ediff command around here..."))
-    
-    (ediff-documentation "Quick Help Commands")
-    
-    (let (case-fold-search)
-      (cond ((string= cmd "?") (re-search-forward "^`\\?'"))
-	    ((string= cmd "G") (re-search-forward "^`G'"))
-	    ((string= cmd "E") (re-search-forward "^`E'"))
-	    ((string= cmd "wd") (re-search-forward "^`wd'"))
-	    ((string= cmd "wx") (re-search-forward "^`wa'"))
-	    ((string= cmd "a/b") (re-search-forward "^`a'"))
-	    ((string= cmd "x") (re-search-forward "^`a'"))
-	    ((string= cmd "xy") (re-search-forward "^`ab'"))
-	    ((string= cmd "p,DEL") (re-search-forward "^`p'"))
-	    ((string= cmd "n,SPC") (re-search-forward "^`n'"))
-	    ((string= cmd "j") (re-search-forward "^`j'"))
-	    ((string= cmd "gx") (re-search-forward "^`ga'"))
-	    ((string= cmd "!") (re-search-forward "^`!'"))
-	    ((string= cmd "*") (re-search-forward "^`\\*'"))
-	    ((string= cmd "m") (re-search-forward "^`m'"))
-	    ((string= cmd "|") (re-search-forward "^`|'"))
-	    ((string= cmd "@") (re-search-forward "^`@'"))
-	    ((string= cmd "h") (re-search-forward "^`h'"))
-	    ((string= cmd "r") (re-search-forward "^`r'"))
-	    ((string= cmd "rx") (re-search-forward "^`ra'"))
-	    ((string= cmd "##") (re-search-forward "^`##'"))
-	    ((string= cmd "#f/#h") (re-search-forward "^`#f'"))
-	    ((string= cmd "X") (re-search-forward "^`A'"))
-	    ((string= cmd "v/V") (re-search-forward "^`v'"))
-	    ((string= cmd "</>") (re-search-forward "^`<'"))
-	    ((string= cmd "~") (re-search-forward "^`~'"))
-	    ((string= cmd "i") (re-search-forward "^`i'"))
-	    ((string= cmd "D") (re-search-forward "^`D'"))
-	    ((string= cmd "R") (re-search-forward "^`R'"))
-	    ((string= cmd "M") (re-search-forward "^`M'"))
-	    ((string= cmd "z/q") (re-search-forward "^`z'"))
-	    ((string= cmd "%") (re-search-forward "^`%'"))
-	    ((string= cmd "C-l") (re-search-forward "^`C-l'"))
-	    ((string= cmd "$") (re-search-forward "^`\\$'"))
-	    ((string= cmd "/") (re-search-forward "^`/'"))
-	    ((string= cmd "&") (re-search-forward "^`&'"))
-	    ((string= cmd "s") (re-search-forward "^`s'"))
-	    ((string= cmd "+") (re-search-forward "^`\\+'"))
-	    ((string= cmd "=") (re-search-forward "^`='"))
-	    (t (error "Undocumented command! Type `G' in Ediff Control Panel to drop a note to the Ediff maintainer")))
-      ) ; let case-fold-search
-    ))
-
-
-;; assuming we are in control window, calculate length of the first line in
-;; help message
-(defun ediff-help-message-line-length ()
-  (save-excursion
-    (goto-char (point-min))
-    (if ediff-use-long-help-message
-	(next-line 1))
-    (end-of-line)
-    (current-column)))
-    
-
-(defun ediff-indent-help-message ()
-  (let* ((shift (/ (max 0 (- (window-width (selected-window))
-			     (ediff-help-message-line-length)))
-		   2))
-	 (str (make-string shift ?\ )))
-    (save-excursion
-      (goto-char (point-min))
-      (while (< (point) (point-max))
-	(insert str)
-	(beginning-of-line)
-	(forward-line 1)))))
-      
-
-;; compose the help message as a string
-(defun ediff-set-help-message ()
-  (setq ediff-long-help-message
-	(cond ((and ediff-long-help-message-function
-		    (or (symbolp ediff-long-help-message-function)
-			(consp ediff-long-help-message-function)))
-	       (funcall ediff-long-help-message-function))
-	      (ediff-word-mode 
-	       (concat ediff-long-help-message-head
-		       ediff-long-help-message-word-mode
-		       ediff-long-help-message-tail))
-	      (ediff-narrow-job
-	       (concat ediff-long-help-message-head
-		       ediff-long-help-message-narrow2
-		       ediff-long-help-message-tail))
-	      (ediff-merge-job 
-	       (concat ediff-long-help-message-head
-		       ediff-long-help-message-merge
-		       ediff-long-help-message-tail))
-	      (ediff-diff3-job
-	       (concat ediff-long-help-message-head
-		       ediff-long-help-message-compare3
-		       ediff-long-help-message-tail))
-	      (t 
-	       (concat ediff-long-help-message-head
-		       ediff-long-help-message-compare2
-		       ediff-long-help-message-tail))))
-  (setq ediff-brief-help-message 
-	(cond ((and ediff-brief-help-message-function
-		    (or (symbolp ediff-brief-help-message-function)
-			(consp ediff-brief-help-message-function)))
-	       (funcall ediff-brief-help-message-function))
-	      ((stringp ediff-brief-help-message-function)
-	       ediff-brief-help-message-function)
-	      ((ediff-multiframe-setup-p) ediff-brief-message-string)
-	      (t ; long brief msg, not multiframe --- put in the middle
-	       ediff-brief-message-string)
-	      ))
-  (setq ediff-help-message (if ediff-use-long-help-message
-			       ediff-long-help-message
-			     ediff-brief-help-message))
-  (run-hooks 'ediff-display-help-hook))
-
-(provide 'ediff-help)
-
-;;; ediff-help.el ends here
diff --git a/lisp/ediff-hook.el b/lisp/ediff-hook.el
deleted file mode 100644
index 25c5afc1d8b..00000000000
--- a/lisp/ediff-hook.el
+++ /dev/null
@@ -1,352 +0,0 @@
-;;; ediff-hook.el --- setup for Ediff's menus and autoloads
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; 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.
-
-;;; Code:
-
-;;;   These must be placed in menu-bar.el in Emacs
-;;
-;;      (define-key menu-bar-tools-menu [epatch]
-;;	'("Apply Patch" . menu-bar-epatch-menu))
-;;      (define-key menu-bar-tools-menu [ediff-merge]
-;;	'("Merge" . menu-bar-ediff-merge-menu))
-;;      (define-key menu-bar-tools-menu [ediff]
-;;	'("Compare" . menu-bar-ediff-menu))
-
-;; Compiler pacifier
-(defvar ediff-menu)
-(defvar ediff-merge-menu)
-(defvar epatch-menu)
-;; end pacifier
-
-
-(defun ediff-xemacs-init-menus ()
-  (if (featurep 'menubar)
-      (progn
-	(add-menu-button
-	 '("Tools")
-	 ["Use separate frame for Ediff control buffer"
-	  ediff-toggle-multiframe
-	  :style toggle
-	  :selected (eq ediff-window-setup-function 'ediff-setup-windows-multiframe)]
-	 "00-Browser...")
-	(add-menu-button
-	 '("Tools")
-	 ["Use a toolbar with Ediff control buffer"
-	  ediff-menu-toggle-use-toolbar
-	  :style toggle
-	  :selected (ediff-use-toolbar-p)]
-	 "00-Browser...")
-	(add-submenu
-	 '("Tools") ediff-menu "OO-Browser...")
-	(add-submenu
-	 '("Tools") ediff-merge-menu "OO-Browser...")
-	(add-submenu
-	 '("Tools") epatch-menu "OO-Browser...")
-	(add-menu-button
-	 '("Tools")
-	 ["-------" nil nil] "OO-Browser...")
-	)))
-
-
-;; explicit string-match is needed: ediff-xemacs-p is not defined at build time
-(cond ((string-match "XEmacs" emacs-version)
-       (defvar ediff-menu
-	 '("Compare"
-	   ["Two Files..."  ediff-files t]
-	   ["Two Buffers..." ediff-buffers t]
-	   ["Three Files..."  ediff-files3 t]
-	   ["Three Buffers..." ediff-buffers3 t]
-	   "---"
-	   ["Two Directories..." ediff-directories t]
-	   ["Three Directories..." ediff-directories3 t]
-	   "---"
-	   ["File with Revision..."  ediff-revision t]
-	   ["Directory Revisions..."  ediff-directory-revisions t]
-	   "---"
-	   ["Windows Word-by-word..." ediff-windows-wordwise t]
-	   ["Windows Line-by-line..." ediff-windows-linewise t]
-	   "---"
-	   ["Regions Word-by-word..." ediff-regions-wordwise t]
-	   ["Regions Line-by-line..." ediff-regions-linewise t]
-	   "---"
-	   ["List Ediff Sessions..." ediff-show-registry t]
-	   ["Ediff Manual..." ediff-documentation t]
-	   ))
-       (defvar ediff-merge-menu
-	 '("Merge"
-	   ["Files..."  ediff-merge-files t]
-	   ["Files with Ancestor..." ediff-merge-files-with-ancestor t]
-	   ["Buffers..."  ediff-merge-buffers t]
-	   ["Buffers with Ancestor..."
-	    ediff-merge-buffers-with-ancestor t]
-	   "---"
-	   ["Directories..."  ediff-merge-directories t]
-	   ["Directories with Ancestor..."
-	    ediff-merge-directories-with-ancestor t]
-	   "---"
-	   ["Revisions..."  ediff-merge-revisions t]
-	   ["Revisions with Ancestor..."
-	    ediff-merge-revisions-with-ancestor t]
-	   ["Directory Revisions..." ediff-merge-directory-revisions t]
-	   ["Directory Revisions with Ancestor..."
-	    ediff-merge-directory-revisions-with-ancestor t]
-	   "---"
-	   ["List Ediff Sessions..." ediff-show-registry t]
-	   ["Ediff Manual..." ediff-documentation t]
-	   ))
-       (defvar epatch-menu
-	 '("Apply Patch"
-	   ["To a file..."  ediff-patch-file t]
-	   ["To a buffer..." ediff-patch-buffer t]
-	   "---"
-	   ["List Ediff Sessions..." ediff-show-registry t]
-	   ["Ediff Manual..." ediff-documentation t]
-	   ))
-
-       ;; put these menus before Object-Oriented-Browser in Tools menu
-       (add-hook 'before-init-hook 'ediff-xemacs-init-menus)
-       (if (not purify-flag)
-	   (ediff-xemacs-init-menus))
-       )
-      
-      ;; Emacs--only if menu-bar is loaded
-      ((featurep 'menu-bar)
-       ;; initialize menu bar keymaps
-       (defvar menu-bar-epatch-menu (make-sparse-keymap "Apply Patch"))
-       (fset 'menu-bar-epatch-menu (symbol-value 'menu-bar-epatch-menu))
-       (defvar menu-bar-ediff-merge-menu (make-sparse-keymap "Merge"))
-       (fset 'menu-bar-ediff-merge-menu 
-	     (symbol-value 'menu-bar-ediff-merge-menu))
-       (defvar menu-bar-ediff-menu (make-sparse-keymap "Compare"))
-       (fset 'menu-bar-ediff-menu (symbol-value 'menu-bar-ediff-menu))
-
-       ;; define ediff-menu
-       (define-key menu-bar-ediff-menu [ediff-doc]
-	 '("Ediff Manual..." . ediff-documentation))
-       (define-key menu-bar-ediff-menu [emultiframe]
-	'("Toggle separate control buffer frame..."
-	  . ediff-toggle-multiframe))
-       (define-key menu-bar-ediff-menu [eregistry]
-	'("List Ediff Sessions..." . ediff-show-registry))
-       (define-key menu-bar-ediff-menu [separator-ediff-manual] '("--"))
-       (define-key menu-bar-ediff-menu [window]
-	 '("This Window and Next Window" . compare-windows))
-       (define-key menu-bar-ediff-menu [ediff-windows-linewise]
-	 '("Windows Line-by-line..." . ediff-windows-linewise))
-       (define-key menu-bar-ediff-menu [ediff-windows-wordwise]
-	 '("Windows Word-by-word..." . ediff-windows-wordwise))
-       (define-key menu-bar-ediff-menu [separator-ediff-windows] '("--"))
-       (define-key menu-bar-ediff-menu [ediff-regions-linewise]
-	 '("Regions Line-by-line..." . ediff-regions-linewise))
-       (define-key menu-bar-ediff-menu [ediff-regions-wordwise]
-	 '("Regions Word-by-word..." . ediff-regions-wordwise))
-       (define-key menu-bar-ediff-menu [separator-ediff-regions] '("--"))
-       (define-key menu-bar-ediff-menu [ediff-dir-revision]
-	 '("Directory Revisions..." . ediff-directory-revisions))
-       (define-key menu-bar-ediff-menu [ediff-revision]
-	 '("File with Revision..." . ediff-revision))
-       (define-key menu-bar-ediff-menu [separator-ediff-directories] '("--"))
-       (define-key menu-bar-ediff-menu [ediff-directories3]
-	 '("Three Directories..." . ediff-directories3))
-       (define-key menu-bar-ediff-menu [ediff-directories]
-	 '("Two Directories..." . ediff-directories))
-       (define-key menu-bar-ediff-menu [separator-ediff-files] '("--"))
-       (define-key menu-bar-ediff-menu [ediff-buffers3]
-	 '("Three Buffers..." . ediff-buffers3))
-       (define-key menu-bar-ediff-menu [ediff-files3]
-	 '("Three Files..." . ediff-files3))
-       (define-key menu-bar-ediff-menu [ediff-buffers]
-	 '("Two Buffers..." . ediff-buffers))
-       (define-key menu-bar-ediff-menu [ediff-files]
-	 '("Two Files..." . ediff-files))
-
-       ;; define merge menu
-       (define-key menu-bar-ediff-merge-menu [ediff-doc2]
-	 '("Ediff Manual..." . ediff-documentation))
-       (define-key menu-bar-ediff-merge-menu [emultiframe2]
-	'("Toggle separate control buffer frame..."
-	  . ediff-toggle-multiframe))
-       (define-key menu-bar-ediff-merge-menu [eregistry2]
-	'("List Ediff Sessions..." . ediff-show-registry))
-       (define-key
-	 menu-bar-ediff-merge-menu [separator-ediff-merge-manual] '("--"))
-       (define-key
-	 menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor]
-	 '("Directory Revisions with Ancestor..."
-	   . ediff-merge-directory-revisions-with-ancestor))
-       (define-key
-	 menu-bar-ediff-merge-menu [ediff-merge-dir-revisions]
-	 '("Directory Revisions..." . ediff-merge-directory-revisions))
-       (define-key
-	 menu-bar-ediff-merge-menu [ediff-merge-revisions-with-ancestor]
-	 '("Revisions with Ancestor..."
-	   . ediff-merge-revisions-with-ancestor))
-       (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions]
-	 '("Revisions..." . ediff-merge-revisions))
-       (define-key menu-bar-ediff-merge-menu [separator-ediff-merge] '("--"))
-       (define-key
-	 menu-bar-ediff-merge-menu [ediff-merge-directories-with-ancestor]
-	 '("Directories with Ancestor..."
-	   . ediff-merge-directories-with-ancestor))
-       (define-key menu-bar-ediff-merge-menu [ediff-merge-directories]
-	 '("Directories..." . ediff-merge-directories))
-       (define-key 
-	 menu-bar-ediff-merge-menu [separator-ediff-merge-dirs] '("--"))
-       (define-key
-	 menu-bar-ediff-merge-menu [ediff-merge-buffers-with-ancestor]
-	 '("Buffers with Ancestor..." . ediff-merge-buffers-with-ancestor))
-       (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers]
-	 '("Buffers..." . ediff-merge-buffers))
-       (define-key menu-bar-ediff-merge-menu [ediff-merge-files-with-ancestor]
-	 '("Files with Ancestor..." . ediff-merge-files-with-ancestor))
-       (define-key menu-bar-ediff-merge-menu [ediff-merge-files]
-	 '("Files..." . ediff-merge-files))
-
-       ;; define epatch menu
-       (define-key menu-bar-epatch-menu [ediff-doc3]
-	 '("Ediff Manual..." . ediff-documentation))
-       (define-key menu-bar-epatch-menu [emultiframe3]
-	'("Toggle separate control buffer frame..."
-	  . ediff-toggle-multiframe))
-       (define-key menu-bar-epatch-menu [eregistry3]
-	'("List Ediff Sessions..." . ediff-show-registry))
-       (define-key menu-bar-epatch-menu [separator-epatch] '("--"))
-       (define-key menu-bar-epatch-menu [ediff-patch-buffer]
-	 '("To a Buffer..." . ediff-patch-buffer))
-       (define-key menu-bar-epatch-menu [ediff-patch-file]
-	 '("To a File..." . ediff-patch-file)))
-      
-      ) ; cond
-
-;; arrange for autoloads
-(if purify-flag
-    () ; if dumping, autoloads are set up in loaddefs.el
-  ;; if the user decides to load this file, set up autoloads
-  ;; compare files and buffers
-  (autoload 'ediff "ediff" "Compare two files" t)
-  (autoload 'ediff-files "ediff" "Compare two files" t)
-  (autoload 'ediff-buffers "ediff" "Compare two bufers" t)
-  (autoload 'ebuffers "ediff" "Compare two bufers" t)
-  (autoload 'ediff3  "ediff"  "Compare three files" t)
-  (autoload 'ediff-files3 "ediff" "Compare three files" t)
-  (autoload 'ediff-buffers3 "ediff" "Compare three bufers" t)
-  (autoload 'ebuffers3 "ediff" "Compare three bufers" t)
-
-  (autoload 'ediff-revision "ediff" "Compare versions of a file" t)
-
-  ;; compare regions and windows
-  (autoload 'ediff-windows-wordwise 
-    "ediff" "Compare two windows word-by-word." t)
-  (autoload 'ediff-regions-wordwise 
-    "ediff" "Compare two regions word-by-word." t)
-  (autoload 'ediff-windows-linewise 
-    "ediff" "Compare two windows line-by-line." t)
-  (autoload 'ediff-regions-linewise 
-    "ediff" "Compare two regions line-by-line." t)
-
-  ;; patch
-  (autoload 'ediff-patch-file "ediff" "Patch a file." t)
-  (autoload 'epatch "ediff" "Patch a file." t)
-  (autoload 'ediff-patch-buffer "ediff" "Patch a buffer.")
-  (autoload 'epatch-buffer "ediff" "Patch a buffer." t)
-
-  ;; merge
-  (autoload 'ediff-merge "ediff" "Merge two files." t)
-  (autoload 'ediff-merge-files "ediff" "Merge two files." t)
-  (autoload 'ediff-merge-files-with-ancestor
-    "ediff" "Merge two files using a third file as an ancestor." t)
-  (autoload 'ediff-merge-buffers "ediff" "Merge two buffers." t)
-  (autoload 'ediff-merge-buffers-with-ancestor
-    "ediff" "Merge two buffers using a third buffer as an ancestor." t)
-
-  (autoload 'ediff-merge-revisions "ediff" "Merge two versions of a file." t)
-  (autoload 'ediff-merge-revisions-with-ancestor
-    "ediff" "Merge two versions of a file." t)
-
-  ;; compare directories
-  (autoload 'edirs "ediff" "Compare files in two directories." t)
-  (autoload 'ediff-directories "ediff" "Compare files in two directories." t)
-  (autoload 'edirs3 "ediff" "Compare files in three directories." t)
-  (autoload
-    'ediff-directories3 "ediff" "Compare files in three directories." t)
-
-  (autoload 'edir-revisions 
-    "ediff" "Compare two versions of a file." t)
-  (autoload 'ediff-directory-revisions 
-    "ediff" "Compare two versions of a file." t)
-
-  ;; merge directories
-  (autoload 'edirs-merge "ediff" "Merge files in two directories." t)
-  (autoload 'ediff-merge-directories
-    "ediff" "Merge files in two directories." t)
-  (autoload 'edirs-merge-with-ancestor
-    "ediff"
-    "Merge files in two directories using files in a third dir as ancestors."
-    t)
-  (autoload 'ediff-merge-directories-with-ancestor
-    "ediff"
-    "Merge files in two directories using files in a third dir as ancestors."
-    t)
-
-  (autoload 'edir-merge-revisions 
-    "ediff" "Merge versions of files in a directory." t)
-  (autoload 'ediff-merge-directory-revisions 
-    "ediff" "Merge versions of files in a directory." t)
-  (autoload 'ediff-merge-directory-revisions-with-ancestor
-    "ediff"
-    "Merge versions of files in a directory using other versions as ancestors."
-    t)
-  (autoload 'edir-merge-revisions-with-ancestor
-    "ediff"
-    "Merge versions of files in a directory using other versions as ancestors."
-    t)
-
-  ;; misc
-  (autoload 'ediff-show-registry
-    "ediff-mult"
-    "Display the registry of active Ediff sessions."
-    t)
-  (autoload 'ediff-documentation
-    "ediff"
-    "Display Ediff's manual."
-    t)
-  (autoload 'ediff-version
-    "ediff"
-    "Show Ediff's version and last modification date."
-    t)
-  (autoload 'ediff-toggle-multiframe
-    "ediff-util"
-    "Toggle the use of separate frame for Ediff control buffer."
-    t)
-  (if (string-match "XEmacs" emacs-version)
-      (autoload 'ediff-toggle-use-toolbar
-	"ediff-tbar"
-	"Toggle the use of Ediff toolbar."
-	t))
-  ) ; if purify-flag
-
-
-(provide 'ediff-hook)
-
-
-;;; ediff-hook.el ends here
diff --git a/lisp/ediff-init.el b/lisp/ediff-init.el
deleted file mode 100644
index 3da02d7242a..00000000000
--- a/lisp/ediff-init.el
+++ /dev/null
@@ -1,1612 +0,0 @@
-;;; ediff-init.el --- Macros, variables, and defsubsts used by Ediff
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; 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.
-
-;;; Code:
-
-;; Start compiler pacifier
-(defvar ediff-metajob-name)
-(defvar ediff-meta-buffer)
-(defvar pm-color-alist)
-(defvar ediff-grab-mouse)
-(defvar ediff-mouse-pixel-position)
-(defvar ediff-mouse-pixel-threshold)
-(defvar ediff-whitespace)
-(defvar ediff-multiframe)
-;; end pacifier
-
-;; Is it XEmacs?
-(defconst ediff-xemacs-p (string-match "XEmacs" emacs-version))
-;; Is it Emacs?
-(defconst ediff-emacs-p (not ediff-xemacs-p))
-
-(defvar ediff-force-faces nil
-  "If t, Ediff will think that it is running on a display that supports faces.
-This is provided as a temporary relief for users of face-capable displays
-that Ediff doesn't know about.")
-
-;; Are we running as a window application or on a TTY?
-(defsubst ediff-device-type ()
-  (if ediff-emacs-p
-      window-system
-    (device-type (selected-device))))
-
-;; in XEmacs: device-type is tty on tty and stream in batch.
-(defun ediff-window-display-p ()
-  (and (ediff-device-type) (not (memq (ediff-device-type) '(tty pc stream)))))
-
-;; test if supports faces
-;; ediff-force-faces is for those devices that support faces, but we don't know
-;; this yet
-(defun ediff-has-face-support-p ()
-  (cond ((ediff-window-display-p))
-	(ediff-force-faces)
-	(ediff-emacs-p (memq (ediff-device-type) '(pc)))
-	(ediff-xemacs-p (memq (ediff-device-type) '(tty pc)))))
-
-  
-;; Defines SYMBOL as an advertised local variable.  
-;; Performs a defvar, then executes `make-variable-buffer-local' on
-;; the variable.  Also sets the `permanent-local' property,
-;; so that `kill-all-local-variables' (called by major-mode setting
-;; commands) won't destroy Ediff control variables.
-;; 
-;; Plagiarised from `emerge-defvar-local' for XEmacs.
-(defmacro ediff-defvar-local (var value doc) 
-  (` (progn
-       (defvar (, var) (, value) (, doc))
-       (make-variable-buffer-local '(, var))
-       (put '(, var) 'permanent-local t))))
-    
-
-
-;; Variables that control each Ediff session---local to the control buffer.
-
-;; Mode variables
-;; The buffer in which the A variant is stored.
-(ediff-defvar-local ediff-buffer-A nil "")
-;; The buffer in which the B variant is stored.
-(ediff-defvar-local ediff-buffer-B nil "")
-;; The buffer in which the C variant is stored.
-(ediff-defvar-local ediff-buffer-C nil "")
-;; Ancestor buffer
-(ediff-defvar-local ediff-ancestor-buffer nil "")
-;; The control buffer of ediff.
-(ediff-defvar-local ediff-control-buffer nil "")
-
-;;; Macros
-(defmacro ediff-odd-p (arg)
-  (` (eq (logand (, arg) 1) 1)))
-
-(defmacro ediff-buffer-live-p (buf)
-  (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf))))))
-
-(defmacro ediff-get-buffer (arg)
-  (` (cond ((eq (, arg) 'A) ediff-buffer-A)
-	   ((eq (, arg) 'B) ediff-buffer-B)
-	   ((eq (, arg) 'C) ediff-buffer-C)
-	   ((eq (, arg) 'Ancestor) ediff-ancestor-buffer)
-	   )
-  ))
-  
-(defmacro ediff-get-value-according-to-buffer-type (buf-type list)
-  (` (cond ((eq (, buf-type) 'A) (nth 0 (, list)))
-	   ((eq (, buf-type) 'B) (nth 1 (, list)))
-	   ((eq (, buf-type) 'C) (nth 2 (, list))))))
-	   
-(defmacro ediff-char-to-buftype (arg)
-  (` (cond ((memq (, arg) '(?a ?A)) 'A)
-	   ((memq (, arg) '(?b ?B)) 'B)
-	   ((memq (, arg) '(?c ?C)) 'C)
-	   )
-  ))
-  
-(defmacro ediff-get-difference (n buf-type)
-  (` (aref
-      (symbol-value
-       (intern (format "ediff-difference-vector-%S" (, buf-type)))) (, n))))
-  
-;; tell if it has been previously determined that the region has
-;; no diffs other than the white space and newlines
-;; The argument, N, is the diff region number used by Ediff to index the
-;; diff vector. It is 1 less than the number seen by the user.
-;;
-;; A difference vector has the form:
-;; [diff diff diff ...]
-;; where each diff has the form:
-;; [overlay fine-diff-vector no-fine-diffs-flag]
-;; fine-diff-vector is a vector [fine-diff fine-diff fine-diff ...]
-(defmacro ediff-no-fine-diffs-p (n)
-  (` (aref (ediff-get-difference (, n) 'A) 2)))
-  
-(defmacro ediff-get-diff-overlay-from-diff-record (diff-rec)
-  (` (aref (, diff-rec) 0)))
-  
-(defmacro ediff-get-diff-overlay (n buf-type)  
-  (` (ediff-get-diff-overlay-from-diff-record
-      (ediff-get-difference (, n) (, buf-type)))))
-
-(defmacro ediff-get-fine-diff-vector-from-diff-record (diff-rec)
-  (` (aref (, diff-rec) 1)))
-      
-(defmacro ediff-set-fine-diff-vector (n buf-type fine-vec)
-  (` (aset (ediff-get-difference (, n) (, buf-type)) 1 (, fine-vec))))
-  
-(defmacro ediff-get-state-of-diff (n buf-type)
-  (` (if (ediff-buffer-live-p ediff-buffer-C)
-	 (aref (ediff-get-difference (, n) (, buf-type)) 3))))
-(defmacro ediff-set-state-of-diff (n buf-type val)
-  (` (aset (ediff-get-difference (, n) (, buf-type)) 3 (, val))))
-(defmacro ediff-get-state-of-merge (n)
-  (` (if ediff-state-of-merge
-	 (aref (aref ediff-state-of-merge (, n)) 0))))
-(defmacro ediff-get-state-of-ancestor (n)
-  (` (if ediff-state-of-merge
-	 (aref (aref ediff-state-of-merge (, n)) 1))))
-(defmacro ediff-set-state-of-merge (n val)
-  (` (if ediff-state-of-merge
-	 (aset (aref ediff-state-of-merge (, n)) 0 (, val)))))
-
-;; if flag is t, puts a mark on diff region saying that 
-;; the differences are in white space only. If flag is nil,
-;; the region is marked as essential (i.e., differences are
-;; not just in the white space and newlines.)
-(defmacro ediff-mark-diff-as-space-only (n flag)
-  (` (aset (ediff-get-difference (, n) 'A) 2 (, flag))))
-  
-(defmacro ediff-get-fine-diff-vector (n buf-type)
-  (` (ediff-get-fine-diff-vector-from-diff-record
-      (ediff-get-difference (, n) (, buf-type)))))
-  
-;; Macro to switch to BUFFER, evaluate FORMS, returns to original buffer.
-;; Differs from `save-excursion' in that it doesn't save the point and mark.
-;; This is essentially `emerge-eval-in-buffer' with the test for live buffers."
-(defmacro ediff-eval-in-buffer (buffer &rest forms)
-  (` (let ((StartBuffer (current-buffer)))
-       (if (ediff-buffer-live-p (, buffer))
-	   (unwind-protect
-	       (progn
-		 (set-buffer (, buffer))
-		 (,@ forms))
-	     (set-buffer StartBuffer))
-	 (or (eq this-command 'ediff-quit)
-	     (error ediff-KILLED-VITAL-BUFFER))
-	 ))))
-	 
-
-(defsubst ediff-multiframe-setup-p ()
-  (and (ediff-window-display-p) ediff-multiframe))
-			 
-(defmacro ediff-narrow-control-frame-p ()
-  (` (and (ediff-multiframe-setup-p)
-	  (equal ediff-help-message ediff-brief-message-string))))
-	  
-(defmacro ediff-3way-comparison-job ()
-  (` (memq
-      ediff-job-name
-      '(ediff-files3 ediff-buffers3))))
-(ediff-defvar-local ediff-3way-comparison-job nil "")
-      
-(defmacro ediff-merge-job ()
-  (` (memq
-      ediff-job-name
-      '(ediff-merge-files
-	ediff-merge-buffers
-	ediff-merge-files-with-ancestor
-	ediff-merge-buffers-with-ancestor
-	ediff-merge-revisions
-	ediff-merge-revisions-with-ancestor))))
-(ediff-defvar-local ediff-merge-job nil "")
-
-(defmacro ediff-merge-with-ancestor-job ()
-  (` (memq
-      ediff-job-name
-      '(ediff-merge-files-with-ancestor
-	ediff-merge-buffers-with-ancestor
-	ediff-merge-revisions-with-ancestor))))
-(ediff-defvar-local ediff-merge-with-ancestor-job nil "")
-
-(defmacro ediff-3way-job ()
-  (` (or ediff-3way-comparison-job ediff-merge-job)))
-(ediff-defvar-local ediff-3way-job nil "")
-
-;; A diff3 job is like a 3way job, but ediff-merge doesn't require the use
-;; of diff3.
-(defmacro ediff-diff3-job ()
-  (` (or ediff-3way-comparison-job
-	 ediff-merge-with-ancestor-job)))
-(ediff-defvar-local ediff-diff3-job nil "")
-	 
-(defmacro ediff-windows-job ()
-  (` (memq ediff-job-name '(ediff-windows-wordwise ediff-windows-linewise))))
-(ediff-defvar-local ediff-windows-job nil "")
-
-(defmacro ediff-word-mode-job ()
-  (` (memq ediff-job-name '(ediff-windows-wordwise  ediff-regions-wordwise))))
-(ediff-defvar-local ediff-word-mode-job nil "")
-
-(defmacro ediff-narrow-job ()
-  (` (memq ediff-job-name '(ediff-windows-wordwise
-			    ediff-regions-wordwise
-			    ediff-windows-linewise
-			    ediff-regions-linewise))))
-(ediff-defvar-local ediff-narrow-job nil "")
-
-;; Note: ediff-merge-directory-revisions-with-ancestor is not treated as an
-;; ancestor metajob, since it behaves differently.
-(defsubst ediff-ancestor-metajob (&optional metajob)
-  (memq (or metajob ediff-metajob-name)
-	'(ediff-merge-directories-with-ancestor
-	  ediff-merge-filegroups-with-ancestor)))
-(defsubst ediff-revision-metajob (&optional metajob)
-  (memq (or metajob ediff-metajob-name)
-	'(ediff-directory-revisions 
-	  ediff-merge-directory-revisions
-	  ediff-merge-directory-revisions-with-ancestor)))
-(defsubst ediff-patch-metajob (&optional metajob)
-  (memq (or metajob ediff-metajob-name)
-	'(ediff-multifile-patch)))
-;; metajob involving only one group of files, such as multipatch or directory
-;; revision
-(defsubst ediff-one-filegroup-metajob (&optional metajob)
-  (or (ediff-revision-metajob metajob)
-      (ediff-patch-metajob metajob)
-      ;; add more here
-      ))
-(defsubst ediff-collect-diffs-metajob (&optional metajob)
-  (memq (or metajob ediff-metajob-name)
-	'(ediff-directories
-	  ediff-directory-revisions
-	  ediff-merge-directories
-	  ediff-merge-directories-with-ancestor
-	  ediff-merge-directory-revisions
-	  ediff-merge-directory-revisions-with-ancestor
-	  ;; add more here
-	  )))
-(defsubst ediff-merge-metajob (&optional metajob)
-  (memq (or metajob ediff-metajob-name)
-	'(ediff-merge-directories
-	  ediff-merge-directories-with-ancestor
-	  ediff-merge-directory-revisions
-	  ediff-merge-directory-revisions-with-ancestor
-	  ediff-merge-filegroups-with-ancestor 
-	  ;; add more here
-	  )))
-
-(defsubst ediff-metajob3 (&optional metajob)
-  (memq (or metajob ediff-metajob-name)
-	'(ediff-merge-directories-with-ancestor
-	  ediff-merge-filegroups-with-ancestor 
-	  ediff-directories3
-	  ediff-filegroups3)))
-(defsubst ediff-comparison-metajob3 (&optional metajob)
-  (memq (or metajob ediff-metajob-name)
-	'(ediff-directories3 ediff-filegroups3)))
-
-;; with no argument, checks if we are in ediff-control-buffer
-;; with argument, checks if we are in ediff-meta-buffer
-(defun ediff-in-control-buffer-p (&optional meta-buf-p)
-  (and (boundp 'ediff-control-buffer)
-       (eq (if meta-buf-p ediff-meta-buffer ediff-control-buffer)
-	   (current-buffer))))
-
-(defsubst ediff-barf-if-not-control-buffer (&optional meta-buf-p)
-  (or (ediff-in-control-buffer-p meta-buf-p)
-      (error "%S: This command runs in Ediff Control Buffer only!"
-	     this-command)))
-
-;; Hook variables
-
-(defvar ediff-before-setup-windows-hook nil
-  "*Hooks to run before Ediff sets its window configuration. 
-This can be used to save the previous window config, which can be restored
-on ediff-quit or ediff-suspend.") 
-(defvar ediff-after-setup-windows-hook nil
-  "*Hooks to run after Ediff sets its window configuration. 
-This can be used to set up control window or icon in a desired place.")
-(defvar ediff-before-setup-control-frame-hook nil
-  "*Hooks run before setting up the frame to display Ediff Control Panel.
-Can be used to change control frame parameters to position it where it
-is desirable.")
-(defvar ediff-after-setup-control-frame-hook nil
-  "*Hooks run after setting up the frame to display Ediff Control Panel.
-Can be used to move the frame where it is desired.")
-(defvar ediff-startup-hook nil
-  "*Hooks to run in the control buffer after Ediff has been set up.")
-(defvar ediff-select-hook nil
-  "*Hooks to run after a difference has been selected.")
-(defvar ediff-unselect-hook nil
-  "*Hooks to run after a difference has been unselected.")
-(defvar ediff-prepare-buffer-hook  nil
-  "*Hooks called after buffers A, B, and C are set up.")
-(defvar ediff-load-hook nil
-  "*Hook run after Ediff is loaded.  Can be used to change defaults.")
-  
-(defvar ediff-mode-hook nil
-  "*Hook run just after ediff-mode is set up in the control buffer. 
-This is done before any windows or frames are created. One can use it to
-set local variables that determine how the display looks like.")
-(defvar ediff-keymap-setup-hook nil
-  "*Hook run just after the default bindings in Ediff keymap are set up.")
-  
-(defvar ediff-display-help-hook nil
-  "*Hooks run after preparing the help message.")
-
-(defvar ediff-suspend-hook (list 'ediff-default-suspend-function)
-  "*Hooks to run in the Ediff control buffer when Ediff is suspended.")
-(defvar ediff-quit-hook (list 'ediff-cleanup-mess)
-  "*Hooks to run in the Ediff control buffer after finishing Ediff.") 
-(defvar ediff-cleanup-hook nil
-  "*Hooks to run on exiting Ediff but before killing the control buffer.
-This is a place to do various cleanups, such as deleting the variant buffers.
-Ediff provides a function, `ediff-janitor', as one such possible hook.")
-(defvar ediff-quit-merge-hook 'ediff-maybe-save-and-delete-merge
-  "*Hooks to run before quitting a merge job.
-The most common use is to save and delete the merge buffer.")
-
-
-;; Error messages
-(defconst ediff-KILLED-VITAL-BUFFER
-  "You have killed a vital Ediff buffer---you must leave Ediff now!")
-(defconst ediff-NO-DIFFERENCES
-  "Sorry, comparison of identical variants is not what I am made for...")
-(defconst ediff-BAD-DIFF-NUMBER
-  ;; %S stands for this-command, %d - diff number, %d - max diff
-  "%S: Bad diff region number, %d. Valid numbers are 1 to %d")
-(defconst ediff-BAD-INFO (format "
-*** The Info file for Ediff, a part of the standard distribution
-*** of %sEmacs, does not seem to be properly installed.
-*** 
-*** Please contact your system administrator. "
-				 (if ediff-xemacs-p "X" "")))
- 
-;; Selective browsing
-
-(ediff-defvar-local ediff-skip-diff-region-function 'ediff-show-all-diffs
-  "Function that determines the next/previous diff region to show.
-Should return t for regions to be ignored and nil otherwise.
-This function gets a region number as an argument. The region number
-is the one used internally by Ediff. It is 1 less than the number seen
-by the user.")
-
-(ediff-defvar-local ediff-hide-regexp-matches-function
-  'ediff-hide-regexp-matches 
-  "Function to use in determining which regions to hide.
-See the documentation string of `ediff-hide-regexp-matches' for details.")
-(ediff-defvar-local ediff-focus-on-regexp-matches-function
-  'ediff-focus-on-regexp-matches
-  "Function to use in determining which regions to focus on.
-See the documentation string of `ediff-focus-on-regexp-matches' for details.")
-
-;; Regexp that determines buf A regions to focus on when skipping to diff
-(ediff-defvar-local ediff-regexp-focus-A "" "")
-;; Regexp that determines buf B regions to focus on when skipping to diff
-(ediff-defvar-local ediff-regexp-focus-B "" "")
-;; Regexp that determines buf C regions to focus on when skipping to diff
-(ediff-defvar-local ediff-regexp-focus-C "" "")
-;; connective that determines whether to focus regions that match both or
-;; one of the regexps
-(ediff-defvar-local ediff-focus-regexp-connective 'and "")
-  
-;; Regexp that determines buf A regions to ignore when skipping to diff
-(ediff-defvar-local ediff-regexp-hide-A "" "")
-;; Regexp that determines buf B regions to ignore when skipping to diff
-(ediff-defvar-local ediff-regexp-hide-B "" "")
-;; Regexp that determines buf C regions to ignore when skipping to diff
-(ediff-defvar-local ediff-regexp-hide-C "" "")
-;; connective that determines whether to hide regions that match both or
-;; one of the regexps
-(ediff-defvar-local ediff-hide-regexp-connective 'and "")
-  
-  
-;; Copying difference regions between buffers.    
-(ediff-defvar-local ediff-killed-diffs-alist nil
-  "A list of killed diffs. 
-A diff is saved here if it is replaced by a diff
-from another buffer.  This alist has the form:
-\((num (buff-object . diff) (buff-object . diff) (buff-object . diff)) ...),
-where some buffer-objects may be missing.")
-
-
-;; Highlighting
-;;(defvar ediff-before-flag-bol (if ediff-emacs-p "->>\n" (make-glyph "->>\n"))
-(defvar ediff-before-flag-bol (if ediff-xemacs-p (make-glyph "->>") "->>")
-  "*Flag placed above the highlighted block of differences. 
-Must end with newline.")
-;;(defvar ediff-after-flag-eol  (if ediff-emacs-p "<<-\n" (make-glyph "<<-"))
-(defvar ediff-after-flag-eol  (if ediff-xemacs-p (make-glyph "<<-") "<<-")
-  "*Flag placed below the highlighted block of differences.
-Must end with newline.")
-
-(defvar ediff-before-flag-mol (if ediff-xemacs-p (make-glyph "->>") "->>")
-  "*Like ediff-before-flag, used when a difference starts in mid-line.")
-(defvar ediff-after-flag-mol  (if ediff-xemacs-p (make-glyph "<<-") "<<-")
-  "*Like ediff-after-flag, used when a difference starts in mid-line.")
-
-  
-(ediff-defvar-local ediff-use-faces t 
-  "If t, differences are highlighted using faces, if device supports faces.
-If nil, differences are highlighted using ASCII flags, ediff-before-flag
-and ediff-after-flag.  On a non-window system, differences are always
-highlighted using ASCII flags.
-This variable can be set either in .emacs or toggled interactively.
-Use `setq-default' if setting it in .emacs")
-
-;; this indicates that diff regions are word-size, so fine diffs are
-;; permanently nixed; used in ediff-windows-wordwise and ediff-regions-wordwise
-(ediff-defvar-local ediff-word-mode nil "")
-;; Name of the job (ediff-files, ediff-windows, etc.)
-(ediff-defvar-local ediff-job-name nil "")
-
-;; Narrowing and ediff-region/windows support
-;; This is a list (overlay-A overlay-B overlay-C)
-;; If set, Ediff compares only those parts of buffers A/B/C that lie within
-;; the bounds of these overlays.
-(ediff-defvar-local ediff-narrow-bounds nil "")
-
-;; List (overlay-A overlay-B overlay-C), where each overlay spans the
-;; entire corresponding buffer.
-(ediff-defvar-local ediff-wide-bounds nil "")
-
-;; Current visibility boundaries in buffers A, B, and C.
-;; This is also a list of overlays. When the user toggles narrow/widen,
-;; this list changes from ediff-wide-bounds to ediff-narrow-bounds.
-;; and back.
-(ediff-defvar-local ediff-visible-bounds nil "")
-
-(ediff-defvar-local ediff-start-narrowed t
-  "Non-nil means start narrowed, if doing ediff-windows-* or ediff-regions-*")
-(ediff-defvar-local ediff-quit-widened t
-  "*Non-nil means: when finished, Ediff widens buffers A/B.
-Actually, Ediff restores the scope of visibility that existed at startup.")
-(defvar ediff-keep-variants t
-  "*Nil means that non-modified variant buffers should be removed after some
-interrogation.
-Supplying a prefix argument to the quit command `q' temporarily reverses the
-meaning of this variable.")
-
-(ediff-defvar-local ediff-highlight-all-diffs t
-  "If nil, only the selected differences are highlighted.
-This variable can be set either in .emacs or toggled interactively, using
-ediff-toggle-hilit. Use `setq-default' to set it.") 
-
-;; A var local to each control panel buffer.  Indicates highlighting style
-;; in effect for this buffer: `face', `ascii', nil -- temporarily
-;; unhighlighted, `off' -- turned off \(on a dumb terminal only\).
-(ediff-defvar-local ediff-highlighting-style nil "")
-
-  
-;; The suffix of the control buffer name.
-(ediff-defvar-local ediff-control-buffer-suffix nil "")
-;; Same as ediff-control-buffer-suffix, but without <,>. 
-;; It's a number rather than string.
-(ediff-defvar-local ediff-control-buffer-number nil "")
-
-
-;; The original values of ediff-protected-variables for buffer A
-(ediff-defvar-local ediff-buffer-values-orig-A nil "")
-;; The original values of ediff-protected-variables for buffer B
-(ediff-defvar-local ediff-buffer-values-orig-B nil "")
-;; The original values of ediff-protected-variables for buffer C
-(ediff-defvar-local ediff-buffer-values-orig-C nil "")
-;; The original values of ediff-protected-variables for buffer Ancestor
-(ediff-defvar-local ediff-buffer-values-orig-Ancestor nil "")
-;; Buffer-local variables to be saved then restored during Ediff sessions
-;; Buffer-local variables to be saved then restored during Ediff sessions
-(defconst ediff-protected-variables '(
-				      ;;buffer-read-only 
-				      mode-line-format))
-
-;; Vector of differences between the variants.  Each difference is
-;; represented by a vector of two overlays plus a vector of fine diffs,
-;; plus a no-fine-diffs flag.  The first overlay spans the
-;; difference region in the A buffer and the second overlays the diff in
-;; the B buffer. If a difference section is empty, the corresponding
-;; overlay's endpoints coincide.
-;;
-;; The precise form of a difference vector for one buffer is:
-;; [diff diff diff ...]
-;; where each diff has the form:
-;; [diff-overlay fine-diff-vector no-fine-diffs-flag state-of-difference]
-;; fine-diff-vector is a vector [fine-diff-overlay fine-diff-overlay ...]
-;; no-fine-diffs-flag says if there are fine differences.
-;; state-of-difference is A, B, C, or nil, indicating which buffer is
-;; different from the other two (used only in 3-way jobs.
-(ediff-defvar-local ediff-difference-vector-A nil "")
-(ediff-defvar-local ediff-difference-vector-B nil "")
-(ediff-defvar-local ediff-difference-vector-C nil "")
-(ediff-defvar-local ediff-difference-vector-Ancestor nil "")
-
-;; [ status status status ...]
-;; Each status: [state-of-merge state-of-ancestor]
-;; state-of-merge is default-A, default-B, prefer-A, or prefer-B. It
-;; indicates the way a diff region was created in buffer C.
-;; state-of-ancestor says if the corresponding region in ancestor buffer is
-;; empty.
-(ediff-defvar-local ediff-state-of-merge nil "")
-
-;; The difference that is currently selected.
-(ediff-defvar-local ediff-current-difference -1 "")
-;; Number of differences found.
-(ediff-defvar-local ediff-number-of-differences nil "")
-  
-;; Buffer containing the output of diff, which is used by Ediff to step
-;; through files.
-(ediff-defvar-local ediff-diff-buffer nil "")
-;; Like ediff-diff-buffer, but contains context diff. It is not used by
-;; Ediff, but it is saved in a file, if user requests so.
-(ediff-defvar-local ediff-custom-diff-buffer nil "")
-;; Buffer used for diff-style fine differences between regions.
-(ediff-defvar-local ediff-fine-diff-buffer nil "")
-;; Temporary buffer used for computing fine differences.
-(defconst ediff-tmp-buffer " *ediff-tmp*" "")
-;; Buffer used for messages
-(defconst ediff-msg-buffer " *ediff-message*" "")
-;; Buffer containing the output of diff when diff returns errors.
-(ediff-defvar-local ediff-error-buffer nil "")
-;; Buffer to display debug info
-(ediff-defvar-local ediff-debug-buffer "*ediff-debug*" "")
-
-;; List of ediff control panels associated with each buffer A/B/C/Ancestor.
-;; Not used any more, but may be needed in the future.
-(ediff-defvar-local ediff-this-buffer-ediff-sessions  nil "")
-
-;; to be deleted in due time
-;; List of difference overlays disturbed by working with the current diff.
-(defvar ediff-disturbed-overlays nil "")
-  
-;; Priority of non-selected overlays.
-(defvar ediff-shadow-overlay-priority  100 "")
-
-(defvar ediff-version-control-package 'vc
-  "Version control package used.
-Currently, Ediff supports vc.el, rcs.el, pcl-cvs.el, and generic-sc.el. The
-standard Emacs interface to RCS, CVS, SCCS, etc., is vc.el. However, some
-people find the other two packages more convenient. Set this variable to the
-appropriate symbol: `rcs', `pcl-cvs', or `generic-sc' if you so desire.")
-
-
-(if ediff-xemacs-p
-    (progn
-      (fset 'ediff-read-event (symbol-function 'next-command-event))
-      (fset 'ediff-overlayp (symbol-function 'extentp))
-      (fset 'ediff-make-overlay (symbol-function 'make-extent))
-      (fset 'ediff-delete-overlay (symbol-function 'delete-extent)))
-  (fset 'ediff-read-event (symbol-function 'read-event))
-  (fset 'ediff-overlayp (symbol-function 'overlayp))
-  (fset 'ediff-make-overlay (symbol-function 'make-overlay))
-  (fset 'ediff-delete-overlay (symbol-function 'delete-overlay)))
-  
-;; Check the current version against the major and minor version numbers
-;; using op: cur-vers op major.minor If emacs-major-version or
-;; emacs-minor-version are not defined, we assume that the current version
-;; is hopelessly outdated.  We assume that emacs-major-version and
-;; emacs-minor-version are defined.  Otherwise, for Emacs/XEmacs 19, if the
-;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value
-;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be
-;; incorrect. However, this gives correct result in our cases, since we are
-;; testing for sufficiently high Emacs versions.
-(defun ediff-check-version (op major minor &optional type-of-emacs)
-  (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
-      (and (cond ((eq type-of-emacs 'xemacs) ediff-xemacs-p)
-		 ((eq type-of-emacs 'emacs) ediff-emacs-p)
-		 (t t))
-	   (cond ((eq op '=) (and (= emacs-minor-version minor)
-				  (= emacs-major-version major)))
-		 ((memq op '(> >= < <=))
-		  (and (or (funcall op emacs-major-version major)
-			   (= emacs-major-version major))
-		       (if (= emacs-major-version major)
-			   (funcall op emacs-minor-version minor)
-			 t)))
-		 (t
-		  (error "%S: Invalid op in ediff-check-version" op))))
-    (cond ((memq op '(= > >=)) nil)
-	  ((memq op '(< <=)) t))))
-  
-  
-;;;; warn if it is a wrong version of emacs
-;;(if (or (ediff-check-version '< 19 29 'emacs)
-;;	(ediff-check-version '< 19 12 'xemacs))
-;;    (progn
-;;      (with-output-to-temp-buffer ediff-msg-buffer
-;;	(switch-to-buffer ediff-msg-buffer)
-;;	(insert
-;;	 (format "
-;;
-;;This version of Ediff requires 
-;;
-;;\t Emacs 19.29 and higher
-;;\t OR
-;;\t XEmacs 19.12 and higher
-;;
-;;It is unlikely to work under Emacs version %s
-;;that you are using... " emacs-version))
-;;	(if noninteractive
-;;	    ()
-;;	  (beep 1)
-;;	  (beep 1)
-;;	  (insert "\n\nType any key to continue...")
-;;	  (ediff-read-event)))
-;;      (kill-buffer ediff-msg-buffer)))
-
-;; A fix for NeXT Step
-;; Should probably be eliminated in later versions.
-(if (and (ediff-window-display-p) (eq (ediff-device-type) 'ns))
-    (progn
-      (fset 'x-display-color-p (symbol-function 'ns-display-color-p))
-      (fset 'x-color-defined-p (symbol-function 'ns-color-defined-p))
-      (fset 'x-display-pixel-height (symbol-function 'ns-display-pixel-height))
-      (fset 'x-display-pixel-width (symbol-function 'ns-display-pixel-width))
-      ))
-
-
-(defsubst ediff-color-display-p ()
-  (if ediff-emacs-p
-      (x-display-color-p)
-    (eq (device-class (selected-device)) 'color)))
-
-  
-(if (ediff-has-face-support-p)
-    (if ediff-xemacs-p
-	(progn
-	  (fset 'ediff-valid-color-p (symbol-function 'valid-color-name-p))
-	  (fset 'ediff-get-face (symbol-function 'get-face)))
-      ;; Temporary fix for OS/2 port of Emacs
-      ;; pm-win.el in PM-Emacs should be fixed.
-      (if (eq (ediff-device-type) 'pm)
-	  (fset 'ediff-valid-color-p 
-		(function (lambda (color) (assoc color pm-color-alist))))
-	(fset 'ediff-valid-color-p (symbol-function 'x-color-defined-p)))
-      (fset 'ediff-get-face (symbol-function 'internal-get-face))))
-
-(if (ediff-window-display-p)
-    (if ediff-xemacs-p
-	(progn
-	  (fset 'ediff-display-pixel-width
-		(symbol-function 'device-pixel-width))
-	  (fset 'ediff-display-pixel-height
-		(symbol-function 'device-pixel-height)))
-      (fset 'ediff-display-pixel-width 
-	    (symbol-function 'x-display-pixel-width))
-      (fset 'ediff-display-pixel-height
-	    (symbol-function 'x-display-pixel-height))))
-      
-
-(defun ediff-make-current-diff-overlay (type)
-  (if (ediff-has-face-support-p)
-      (let ((overlay (intern (format "ediff-current-diff-overlay-%S" type)))
-	    (buffer (ediff-get-buffer type))
-	    (face (face-name
-		   (symbol-value
-		    (intern (format "ediff-current-diff-face-%S" type))))))
-	(set overlay
-	     (ediff-make-bullet-proof-overlay (point-max) (point-max) buffer))
-	(ediff-set-overlay-face (symbol-value overlay) face)
-	(ediff-overlay-put (symbol-value overlay) 'ediff ediff-control-buffer))
-    ))
-
-(defun ediff-set-overlay-face (extent face)
-  (ediff-overlay-put extent 'face face)
-  (ediff-overlay-put extent 'help-echo 'ediff-region-help-echo))
- 
-;; This does nothing in Emacs, since overlays there have no help-echo property
-(defun ediff-region-help-echo (extent)
-  (let ((is-current (ediff-overlay-get extent 'ediff))
-	(face (ediff-overlay-get extent 'face))
-	(diff-num (ediff-overlay-get extent 'ediff-diff-num))
-	face-help)
-
-    ;; This happens only for refinement overlays
-    (setq face-help (and face (get face 'ediff-help-echo)))
-
-    (cond ((and is-current diff-num) ; current diff region
-	   (format "Difference region %S -- current" (1+ diff-num)))
-	  (face-help) ; refinement of current diff region
-	  (diff-num ; non-current
-	   (format "Difference region %S -- non-current" (1+ diff-num)))
-	  (t ""))   ; none
-    ))
-
-(defun ediff-set-face (ground face color)
-  "Set face foreground/background."
-  (if (ediff-has-face-support-p)
-      (if (ediff-valid-color-p color)
-	  (if (eq ground 'foreground)
-	      (set-face-foreground face color)
-	    (set-face-background face color))
-	(cond ((memq face
-		     '(ediff-current-diff-face-A
-		       ediff-current-diff-face-B
-		       ediff-current-diff-face-C
-		       ediff-current-diff-face-Ancestor))
-	       (copy-face 'highlight face))
-	      ((memq face
-		     '(ediff-fine-diff-face-A
-		       ediff-fine-diff-face-B
-		       ediff-fine-diff-face-C
-		       ediff-fine-diff-face-Ancestor))
-	       (copy-face 'secondary-selection face)
-	       (set-face-underline-p face t))
-	      ((memq face
-		     '(ediff-even-diff-face-A
-		       ediff-odd-diff-face-A 
-		       ediff-even-diff-face-B ediff-odd-diff-face-B
-		       ediff-even-diff-face-C ediff-odd-diff-face-C
-		       ediff-even-diff-face-Ancestor
-		       ediff-odd-diff-face-Ancestor))
-	       (copy-face 'secondary-selection face))))
-    ))
-
-(defun ediff-set-face-pixmap (face pixmap)
-  "Set face pixmap on a monochrome display."
-  (if (and (ediff-window-display-p) (not (ediff-color-display-p)))
-      (condition-case nil
-	  (set-face-background-pixmap face pixmap)
-	(error
-	 (message "Pixmap not found for %S: %s" (face-name face) pixmap)
-	 (sit-for 1)))))
-
-(defun ediff-hide-face (face)
-  (if (and (ediff-has-face-support-p) ediff-emacs-p)
-      (add-to-list 'facemenu-unlisted-faces face)))
-      
-(defvar ediff-current-diff-face-A
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-current-diff-face-A)
-	(ediff-hide-face 'ediff-current-diff-face-A)
-	(or (face-differs-from-default-p 'ediff-current-diff-face-A)
-	    (cond ((ediff-color-display-p)
-		   (ediff-set-face
-		    'foreground 'ediff-current-diff-face-A "firebrick")
-		   (ediff-set-face
-		    'background 'ediff-current-diff-face-A "pale green"))
-		  (t
-		   (if ediff-xemacs-p
-		       (copy-face 'modeline 'ediff-current-diff-face-A)
-		     (copy-face 'highlight 'ediff-current-diff-face-A))
-		   )))
-	'ediff-current-diff-face-A))
-  "Face for highlighting the selected difference in buffer A.")
-
-(defvar ediff-current-diff-face-B
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-current-diff-face-B)
-	(ediff-hide-face 'ediff-current-diff-face-B)
-	(or (face-differs-from-default-p 'ediff-current-diff-face-B)
-	    (cond ((ediff-color-display-p)
-		   (ediff-set-face
-		    'foreground 'ediff-current-diff-face-B "DarkOrchid")
-		   (ediff-set-face
-		    'background 'ediff-current-diff-face-B "Yellow"))
-		  (t 
-		   (if ediff-xemacs-p
-		       (copy-face 'modeline 'ediff-current-diff-face-B)
-		     (copy-face 'highlight 'ediff-current-diff-face-B))
-		   )))
-	'ediff-current-diff-face-B))
-  "Face for highlighting the selected difference in buffer B.")
-    
-
-(defvar ediff-current-diff-face-C
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-current-diff-face-C)
-	(ediff-hide-face 'ediff-current-diff-face-C)
-	(or (face-differs-from-default-p 'ediff-current-diff-face-C)
-	    (cond ((ediff-color-display-p)
-		   (ediff-set-face
-		    'foreground 'ediff-current-diff-face-C "Navy")
-		   (ediff-set-face
-		    'background 'ediff-current-diff-face-C "Pink"))
-		  (t 
-		   (if ediff-xemacs-p
-		       (copy-face 'modeline 'ediff-current-diff-face-C)
-		     (copy-face 'highlight 'ediff-current-diff-face-C))
-		   )))
-	'ediff-current-diff-face-C))
-  "Face for highlighting the selected difference in buffer C.")
-
-(defvar ediff-current-diff-face-Ancestor
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-current-diff-face-Ancestor)
-	(ediff-hide-face 'ediff-current-diff-face-Ancestor)
-	(or (face-differs-from-default-p 'ediff-current-diff-face-Ancestor)
-	    (copy-face 
-	     'ediff-current-diff-face-C 'ediff-current-diff-face-Ancestor))
-	'ediff-current-diff-face-Ancestor))
-  "Face for highlighting the selected difference in the ancestor buffer.")
-
-(defvar ediff-fine-diff-pixmap "gray3"
-  "Pixmap to use for highlighting fine differences.")
-(defvar ediff-odd-diff-pixmap "gray1"
-  "Pixmap to use for highlighting odd differences.")
-(defvar ediff-even-diff-pixmap "Stipple"
-  "Pixmap to use for highlighting even differences.")
-
-(defvar ediff-fine-diff-face-A
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-fine-diff-face-A)
-	(ediff-hide-face 'ediff-fine-diff-face-A)
-	(or (face-differs-from-default-p 'ediff-fine-diff-face-A)
-	    (cond ((ediff-color-display-p)
-		   (ediff-set-face 'foreground 'ediff-fine-diff-face-A
-				   "Navy")
-		   (ediff-set-face 'background 'ediff-fine-diff-face-A
-				   "sky blue"))
-		  (t
-		   (set-face-underline-p 'ediff-fine-diff-face-A t)
-		   (ediff-set-face-pixmap 'ediff-fine-diff-face-A
-					  ediff-fine-diff-pixmap)
-		   )))
-	'ediff-fine-diff-face-A))
-  "Face for highlighting the refinement of the selected diff in buffer A.")
-
-(defvar ediff-fine-diff-face-B
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-fine-diff-face-B)
-	(ediff-hide-face 'ediff-fine-diff-face-B)
-	(or (face-differs-from-default-p 'ediff-fine-diff-face-B)
-	    (cond ((ediff-color-display-p)
-		   (ediff-set-face 'foreground 'ediff-fine-diff-face-B "Black")
-		   (ediff-set-face 'background 'ediff-fine-diff-face-B "cyan"))
-		  (t
-		   (set-face-underline-p 'ediff-fine-diff-face-B t)
-		   (ediff-set-face-pixmap 'ediff-fine-diff-face-B
-					  ediff-fine-diff-pixmap)
-		   )))
-	'ediff-fine-diff-face-B))
-  "Face for highlighting the refinement of the selected diff in buffer B.")
-    
-(defvar ediff-fine-diff-face-C
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-fine-diff-face-C)
-	(ediff-hide-face 'ediff-fine-diff-face-C)
-	(or (face-differs-from-default-p 'ediff-fine-diff-face-C)
-	    (cond ((ediff-color-display-p)
-		   (ediff-set-face 'foreground 'ediff-fine-diff-face-C "black")
-		   (ediff-set-face
-		    'background 'ediff-fine-diff-face-C "Turquoise"))
-		  (t
-		   (set-face-underline-p 'ediff-fine-diff-face-C t)
-		   (ediff-set-face-pixmap 'ediff-fine-diff-face-C
-					  ediff-fine-diff-pixmap)
-		   )))
-	'ediff-fine-diff-face-C))
-  "Face for highlighting the refinement of the selected diff in buffer C.")
-
-(defvar ediff-fine-diff-face-Ancestor
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-fine-diff-face-Ancestor)
-	(ediff-hide-face 'ediff-fine-diff-face-Ancestor)
-	(or (face-differs-from-default-p 'ediff-fine-diff-face-Ancestor)
-	    (progn
-	      (copy-face
-	       'ediff-fine-diff-face-C 'ediff-fine-diff-face-Ancestor)
-	      (ediff-set-face-pixmap 'ediff-fine-diff-face-Ancestor
-				     ediff-fine-diff-pixmap))
-	    )))
-  "Face highlighting refinements of the selected diff in ancestor buffer.
-Presently, this is not used, as difference regions are not refined in the
-ancestor buffer.")
-    
-(defvar ediff-even-diff-face-A
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-even-diff-face-A)
-	(ediff-hide-face 'ediff-even-diff-face-A)
-	(or (face-differs-from-default-p 'ediff-even-diff-face-A)
-	    (cond ((ediff-color-display-p)
-		   (ediff-set-face
-		    'foreground 'ediff-even-diff-face-A "black")
-		   (ediff-set-face
-		    'background 'ediff-even-diff-face-A "light grey"))
-		  (t 
-		   (copy-face 'italic 'ediff-even-diff-face-A)
-		   (ediff-set-face-pixmap 'ediff-even-diff-face-A
-					  ediff-even-diff-pixmap)
-		   )))
-	'ediff-even-diff-face-A))
-  "Face used to highlight even-numbered differences in buffer A.")
-      
-(defvar ediff-even-diff-face-B
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-even-diff-face-B)
-	(ediff-hide-face 'ediff-even-diff-face-B)
-	(or (face-differs-from-default-p 'ediff-even-diff-face-B)
-	    (cond ((ediff-color-display-p)
-		   (ediff-set-face
-		    'foreground 'ediff-even-diff-face-B "White")
-		   (ediff-set-face
-		    'background 'ediff-even-diff-face-B "Gray"))
-		  (t 
-		   (copy-face 'italic 'ediff-even-diff-face-B)
-		   (ediff-set-face-pixmap 'ediff-even-diff-face-B
-					  ediff-even-diff-pixmap)
-		   )))
-	'ediff-even-diff-face-B))
-  "Face used to highlight even-numbered differences in buffer B.")
-    
-(defvar ediff-even-diff-face-C
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-even-diff-face-C)
-	(ediff-hide-face 'ediff-even-diff-face-C)
-	(or (face-differs-from-default-p 'ediff-even-diff-face-C)
-	    (progn
-	      (copy-face 'ediff-even-diff-face-A 'ediff-even-diff-face-C)
-	      (ediff-set-face-pixmap 'ediff-even-diff-face-C
-				     ediff-even-diff-pixmap)))
-	'ediff-even-diff-face-C))
-  "Face used to highlight even-numbered differences in buffer C.")
-
-(defvar ediff-even-diff-face-Ancestor
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-even-diff-face-Ancestor)
-	(ediff-hide-face 'ediff-even-diff-face-Ancestor)
-	(or (face-differs-from-default-p 'ediff-even-diff-face-Ancestor)
-	    (progn
-	      (copy-face
-	       'ediff-even-diff-face-C 'ediff-even-diff-face-Ancestor)
-	      (ediff-set-face-pixmap 'ediff-even-diff-face-Ancestor
-				     ediff-even-diff-pixmap)))
-	'ediff-even-diff-face-Ancestor))
-  "Face highlighting even-numbered differences in the ancestor buffer.")
-  
-(defvar ediff-odd-diff-face-A
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-odd-diff-face-A)
-	(ediff-hide-face 'ediff-odd-diff-face-A)
-	(or (face-differs-from-default-p 'ediff-odd-diff-face-A)
-	    (cond ((ediff-color-display-p)
-		   (ediff-set-face
-		    'foreground 'ediff-odd-diff-face-A "White")
-		   (ediff-set-face
-		    'background 'ediff-odd-diff-face-A "Gray"))
-		  (t 
-		   (copy-face 'italic 'ediff-odd-diff-face-A)
-		   (ediff-set-face-pixmap 'ediff-odd-diff-face-A
-					  ediff-odd-diff-pixmap)
-		   )))
-	'ediff-odd-diff-face-A))
-  "Face used to highlight odd-numbered differences in buffer A.")
-      
-(defvar ediff-odd-diff-face-B
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-odd-diff-face-B)
-	(ediff-hide-face 'ediff-odd-diff-face-B)
-	(or (face-differs-from-default-p 'ediff-odd-diff-face-B)
-	    (cond ((ediff-color-display-p)
-		   (ediff-set-face
-		    'foreground 'ediff-odd-diff-face-B "Black")
-		   (ediff-set-face
-		    'background 'ediff-odd-diff-face-B "light grey"))
-		  (t 
-		   (copy-face 'italic 'ediff-odd-diff-face-B)
-		   (ediff-set-face-pixmap 'ediff-odd-diff-face-B
-					  ediff-odd-diff-pixmap)
-		   )))
-	'ediff-odd-diff-face-B))
-  "Face used to highlight odd-numbered differences in buffer B.")
-    
-(defvar ediff-odd-diff-face-C
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-odd-diff-face-C)
-	(ediff-hide-face 'ediff-odd-diff-face-C)
-	(or (face-differs-from-default-p 'ediff-odd-diff-face-C)
-	    (progn
-	      (copy-face 'ediff-odd-diff-face-A 'ediff-odd-diff-face-C)
-	      (ediff-set-face-pixmap 'ediff-odd-diff-face-C
-				     ediff-odd-diff-pixmap)))
-	'ediff-odd-diff-face-C))
-  "Face used to highlight odd-numbered differences in buffer C.")
-
-(defvar ediff-odd-diff-face-Ancestor 
-  (if (ediff-has-face-support-p)
-      (progn
-	(make-face 'ediff-odd-diff-face-Ancestor)
-	(ediff-hide-face 'ediff-odd-diff-face-Ancestor)
-	(or (face-differs-from-default-p 'ediff-odd-diff-face-Ancestor)
-	    (progn
-	      (copy-face 'ediff-odd-diff-face-C 'ediff-odd-diff-face-Ancestor)
-	      (ediff-set-face-pixmap 'ediff-odd-diff-face-Ancestor
-				     ediff-odd-diff-pixmap)))
-	'ediff-odd-diff-face-Ancestor))
-  "Face used to highlight even-numbered differences in the ancestor buffer.")
-
-;; Help echo
-(put 'ediff-fine-diff-face-A 'ediff-help-echo
-     "A `refinement' of the current difference region")
-(put 'ediff-fine-diff-face-B 'ediff-help-echo
-     "A `refinement' of the current difference region")
-(put 'ediff-fine-diff-face-C 'ediff-help-echo
-     "A `refinement' of the current difference region")
-(put 'ediff-fine-diff-face-Ancestor 'ediff-help-echo
-     "A `refinement' of the current difference region")
-
-
-;;; Overlays
-
-(ediff-defvar-local ediff-current-diff-overlay-A nil
-  "Overlay for the current difference region in buffer A.")
-(ediff-defvar-local ediff-current-diff-overlay-B nil
-  "Overlay for the current difference region in buffer B.")
-(ediff-defvar-local ediff-current-diff-overlay-C nil
-  "Overlay for the current difference region in buffer C.")
-(ediff-defvar-local ediff-current-diff-overlay-Ancestor nil
-  "Overlay for the current difference region in the ancestor buffer.")
-  
-;; Compute priority of ediff overlay.
-(defun ediff-highest-priority (start end buffer)
-  (let ((pos (max 1 (1- start)))
-	ovr-list)
-    (if ediff-xemacs-p
-	(1+ ediff-shadow-overlay-priority)
-      (ediff-eval-in-buffer buffer
-	(while (< pos (min (point-max) (1+ end)))
-	  (setq ovr-list (append (overlays-at pos) ovr-list))
-	  (setq pos (next-overlay-change pos)))
-	(1+ (apply '+
-		   (mapcar (function
-			    (lambda (ovr)
-			      (if ovr
-				  (or (ediff-overlay-get ovr 'priority) 0)
-				0)))
-			   ovr-list)
-		   ))
-	))))
-  
-    
-(defvar ediff-toggle-read-only-function nil
-  "*Specifies the function to be used to toggle read-only.
-If nil, Ediff tries to deduce the function from the binding of C-x C-q.
-Normally, this is the `toggle-read-only' function, but, if version
-control is used, it could be `vc-toggle-read-only' or `rcs-toggle-read-only'.")
-
-
-;;; Misc
-
-;; if nil, this silences some messages
-(defconst ediff-verbose-p t)
-
-(ediff-defvar-local ediff-autostore-merges  'group-jobs-only
-  "*Save the results of merge jobs automatically.
-Nil means don't save automatically. t means always save. Anything but nil or t
-means save automatically only if the merge job is part of a group of jobs, such
-as `ediff-merge-directory' or `ediff-merge-directory-revisions'.")
-
-;; file where the result of the merge is to be saved. used internally
-(ediff-defvar-local ediff-merge-store-file nil "")
-  
-(defvar ediff-no-emacs-help-in-control-buffer nil
-  "*Non-nil means C-h should not invoke Emacs help in control buffer.
-Instead, C-h jumps to previous difference.")
-  
-(defvar ediff-temp-file-prefix
-  (let ((env (or (getenv "TMPDIR")
-		 (getenv "TMP")
-		 (getenv "TEMP")))
-	d)
-    (setq d (if (and env (> (length env) 0))
-		env
-	      (cond ((memq system-type '(vax-vms axp-vms)) "SYS$SCRATCH:")
- 		    ((eq system-type 'ms-dos) "c:/")
- 		    (t "/tmp"))))
-    ;; The following is to make sure we get something to which we can
-    ;; add directory levels on VMS.
-    (setq d (file-name-as-directory (directory-file-name d)))
-    )
-  "*Prefix to put on Ediff temporary file names.
-Do not start with `~/' or `~user-name/'.")  
-
-(defvar ediff-temp-file-mode 384	; u=rw only
-  "*Mode for Ediff temporary files.")
-  
-;; Metacharacters that have to be protected from the shell when executing
-;; a diff/diff3 command.
-(defvar ediff-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
-  "Characters that must be quoted with \\ when used in a shell command line.
-More precisely, a regexp to match any one such character.")
-
-;; needed to simulate frame-char-width in XEmacs.
-(defvar ediff-H-glyph (if ediff-xemacs-p (make-glyph "H")))
-
-  
-(ediff-defvar-local ediff-temp-file-A nil
-  "Temporary file used for refining difference regions in buffer A.")
-(ediff-defvar-local ediff-temp-file-B nil
-  "Temporary file used for refining difference regions in buffer B.")
-(ediff-defvar-local ediff-temp-file-C nil
-  "Temporary file used for refining difference regions in buffer C.")
-
-;;; In-line functions
-
-(defsubst ediff-file-remote-p (file-name)
-  (require 'ange-ftp)
-  (car (if ediff-xemacs-p
-	   (ange-ftp-ftp-path file-name)
-	 (ange-ftp-ftp-name file-name))))
-
-    
-(defsubst ediff-frame-unsplittable-p (frame)
-  (cdr (assq 'unsplittable (frame-parameters frame))))
-
-(defsubst ediff-get-next-window (wind prev-wind)
-  (or (window-live-p wind)
-      (setq wind (if prev-wind
-		     (next-window wind)
-		   (selected-window)))))
-
-
-(defsubst ediff-kill-buffer-carefully (buf)
-  "Kill buffer BUF if it exists."
-  (if (ediff-buffer-live-p buf)
-      (kill-buffer (get-buffer buf))))
-
-
-;; activate faces on diff regions in buffer
-(defun ediff-paint-background-regions-in-one-buffer (buf-type unhighlight)
-  (let ((diff-vector 
-	 (eval (intern (format "ediff-difference-vector-%S" buf-type))))
-	overl diff-num)
-    (mapcar (function
-	     (lambda (rec)
-	       (setq overl (ediff-get-diff-overlay-from-diff-record rec)
-		     diff-num (ediff-overlay-get overl 'ediff-diff-num))
-	       (ediff-set-overlay-face
-		overl
-		(if (not unhighlight)
-		    (ediff-background-face buf-type diff-num))
-		)))
-	    diff-vector)))
-
-
-;; activate faces on diff regions in all buffers
-(defun ediff-paint-background-regions (&optional unhighlight)
-  (ediff-paint-background-regions-in-one-buffer
-   'A unhighlight)
-  (ediff-paint-background-regions-in-one-buffer
-   'B unhighlight)
-  (ediff-paint-background-regions-in-one-buffer
-   'C unhighlight)
-  (ediff-paint-background-regions-in-one-buffer
-   'Ancestor unhighlight))
-
-(defun ediff-highlight-diff-in-one-buffer (n buf-type)
-  (if (ediff-buffer-live-p (ediff-get-buffer buf-type))
-      (let* ((buff (ediff-get-buffer buf-type))
-	     (last (ediff-eval-in-buffer buff (point-max)))
-	     (begin (ediff-get-diff-posn buf-type 'beg n))
-	     (end (ediff-get-diff-posn buf-type 'end n))
-	     (xtra (if (equal begin end) 1 0))
-	     (end-hilit (min last (+ end xtra)))
-	     (current-diff-overlay 
-	      (symbol-value
-	       (intern (format "ediff-current-diff-overlay-%S" buf-type)))))
-	
-	(if ediff-xemacs-p
-	    (ediff-move-overlay current-diff-overlay begin end-hilit)
-	  (ediff-move-overlay current-diff-overlay begin end-hilit buff))
-	(ediff-overlay-put current-diff-overlay 'priority  
-			   (ediff-highest-priority begin end-hilit buff))
-	(ediff-overlay-put current-diff-overlay 'ediff-diff-num n)
-	
-	;; unhighlight the background overlay for diff n so it won't
-	;; interfere with the current diff overlay
-	(ediff-set-overlay-face (ediff-get-diff-overlay n buf-type) nil)
-	)))
-
-
-(defun ediff-unhighlight-diff-in-one-buffer (buf-type)
-  (if (ediff-buffer-live-p (ediff-get-buffer buf-type))
-      (let ((current-diff-overlay 
-	     (symbol-value
-	      (intern (format "ediff-current-diff-overlay-%S" buf-type))))
-	    (overlay
-	     (ediff-get-diff-overlay ediff-current-difference buf-type))
-	    )
-    
-	(ediff-move-overlay current-diff-overlay 1 1)
-	
-	;; rehighlight the overlay in the background of the
-	;; current difference region
-	(ediff-set-overlay-face
-	 overlay
-	 (if (and (ediff-has-face-support-p)
-		  ediff-use-faces ediff-highlight-all-diffs)
-	     (ediff-background-face buf-type ediff-current-difference)))
-	)))
-
-(defun ediff-unhighlight-diffs-totally-in-one-buffer (buf-type)
-  (ediff-unselect-and-select-difference -1)
-  (if (and (ediff-has-face-support-p) ediff-use-faces)
-      (let* ((inhibit-quit t)
-	     (current-diff-overlay-var
-	      (intern (format "ediff-current-diff-overlay-%S" buf-type)))
-	     (current-diff-overlay (symbol-value current-diff-overlay-var)))
-	(ediff-paint-background-regions 'unhighlight)
-	(if (ediff-overlayp current-diff-overlay)
-	    (ediff-delete-overlay current-diff-overlay))
-	(set current-diff-overlay-var nil)
-	)))
-      
-
-(defsubst ediff-highlight-diff (n)
-  "Put face on diff N.  Invoked for X displays only."
-  (ediff-highlight-diff-in-one-buffer n 'A)
-  (ediff-highlight-diff-in-one-buffer n 'B)
-  (ediff-highlight-diff-in-one-buffer n 'C)
-  (ediff-highlight-diff-in-one-buffer n 'Ancestor)
-  )
-
-
-(defsubst ediff-unhighlight-diff ()
-  "Remove overlays from buffers A, B, and C."
-  (ediff-unhighlight-diff-in-one-buffer 'A)
-  (ediff-unhighlight-diff-in-one-buffer 'B)
-  (ediff-unhighlight-diff-in-one-buffer 'C)
-  (ediff-unhighlight-diff-in-one-buffer 'Ancestor)
-  )
-    
-;; delete highlighting overlays, restore faces to their original form
-(defsubst ediff-unhighlight-diffs-totally ()
-  (ediff-unhighlight-diffs-totally-in-one-buffer 'A)
-  (ediff-unhighlight-diffs-totally-in-one-buffer 'B)
-  (ediff-unhighlight-diffs-totally-in-one-buffer 'C)
-  (ediff-unhighlight-diffs-totally-in-one-buffer 'Ancestor)
-  )
-
-(defsubst ediff-background-face (buf-type dif-num)
-  ;; The value of dif-num is always 1- the one that user sees.
-  ;; This is why even face is used when dif-num is odd.
-  (intern (format (if (ediff-odd-p dif-num)
-		      "ediff-even-diff-face-%S"
-		    "ediff-odd-diff-face-%S")
-		  buf-type)))
-    
-      
-;; arg is a record for a given diff in a difference vector
-;; this record is itself a vector
-(defsubst ediff-clear-fine-diff-vector (diff-record)
-  (if diff-record
-      (mapcar 'ediff-delete-overlay
-	      (ediff-get-fine-diff-vector-from-diff-record diff-record))))
-	      
-(defsubst ediff-clear-fine-differences-in-one-buffer (n buf-type)
-  (ediff-clear-fine-diff-vector (ediff-get-difference n buf-type))
-  (ediff-set-fine-diff-vector n buf-type nil))
-  
-(defsubst ediff-clear-fine-differences (n)
-  (ediff-clear-fine-differences-in-one-buffer n 'A)
-  (ediff-clear-fine-differences-in-one-buffer n 'B)
-  (if ediff-3way-job
-      (ediff-clear-fine-differences-in-one-buffer n 'C)))
-	  
-
-(defsubst ediff-convert-fine-diffs-to-overlays (diff-list region-num)
-  (ediff-set-fine-overlays-in-one-buffer 'A diff-list region-num)
-  (ediff-set-fine-overlays-in-one-buffer 'B diff-list region-num)
-  (if ediff-3way-job
-      (ediff-set-fine-overlays-in-one-buffer 'C diff-list region-num)
-    ))
-  
-(defsubst ediff-mouse-event-p (event)
-  (if ediff-xemacs-p
-      (button-event-p event)
-    (string-match "mouse" (format "%S" (event-basic-type event)))
-    ))
-
-
-(defsubst ediff-key-press-event-p (event)
-  (if ediff-xemacs-p
-      (key-press-event-p event)
-    (or (char-or-string-p event) (symbolp event))))
-
-(defun ediff-event-point (event)
-  (cond ((ediff-mouse-event-p event)
-	 (if ediff-xemacs-p
-	     (event-point event)
-	   (posn-point (event-start event))))
-	((ediff-key-press-event-p event)
-	 (point))
-	(t (error))))
-
-(defun ediff-event-buffer (event)
-  (cond ((ediff-mouse-event-p event)
-	 (if ediff-xemacs-p
-	     (event-buffer event)
-	   (window-buffer (posn-window (event-start event)))))
-	((ediff-key-press-event-p event)
-	 (current-buffer))
-	(t (error))))
-   
-    
-(defsubst ediff-frame-iconified-p (frame)
-  (if (and (ediff-window-display-p) (frame-live-p frame))
-      (if ediff-xemacs-p
-	  (frame-iconified-p frame)
-	(eq (frame-visible-p frame) 'icon))))
-    
-(defsubst ediff-window-visible-p (wind)
-  ;; under TTY, window-live-p also means window is visible
-  (and (window-live-p wind)
-       (or (not (ediff-window-display-p))
-	   (frame-visible-p (window-frame wind)))))
-  
-
-(defsubst ediff-frame-char-width (frame)
-  (if ediff-xemacs-p
-      (/ (frame-pixel-width frame) (frame-width frame))
-    (frame-char-width frame)))
-    
-(defun ediff-reset-mouse (&optional frame do-not-grab-mouse)
-  (or frame (setq frame (selected-frame)))
-  (if (ediff-window-display-p)
-      (let ((frame-or-wind frame))
-	(if ediff-xemacs-p 
-	    (setq frame-or-wind (frame-selected-window frame)))
-	(or do-not-grab-mouse
-	    ;; don't set mouse if the user said to never do this
-	    (not ediff-grab-mouse) 
-	    ;; Don't grab on quit, if the user doesn't want to.
-	    ;; If ediff-grab-mouse = t, then mouse won't be grabbed for
-	    ;; sessions that are not part of a group (this is done in
-	    ;; ediff-recenter). The condition below affects only terminating
-	    ;; sessions in session groups (in which case mouse is warped into
-	    ;; a meta buffer).
-	    (and (eq ediff-grab-mouse 'maybe)
-		 (memq this-command '(ediff-quit ediff-update-diffs)))
-	    (set-mouse-position frame-or-wind 1 0))
-	)))
-
-(defsubst ediff-spy-after-mouse ()
-  (setq ediff-mouse-pixel-position (mouse-pixel-position)))
-
-;; It is not easy to find out when the user grabs the mouse, since emacs and
-;; xemacs behave differently when mouse is not in any frame. Also, this is
-;; sensitive to when the user grabbed mouse.  Not used for now.
-(defun ediff-user-grabbed-mouse ()
-  (if ediff-mouse-pixel-position
-      (cond ((not (eq (car ediff-mouse-pixel-position)
-		      (car (mouse-pixel-position)))))
-	    ((and (car (cdr ediff-mouse-pixel-position))
-		  (car (cdr (mouse-pixel-position)))
-		  (cdr (cdr ediff-mouse-pixel-position))
-		  (cdr (cdr (mouse-pixel-position))))
-	     (not (and (< (abs (- (car (cdr ediff-mouse-pixel-position))
-				  (car (cdr (mouse-pixel-position)))))
-			  ediff-mouse-pixel-threshold)
-		       (< (abs (- (cdr (cdr ediff-mouse-pixel-position))
-				  (cdr (cdr (mouse-pixel-position)))))
-			  ediff-mouse-pixel-threshold))))
-	    (t nil))))
-    
-(defsubst ediff-frame-char-height (frame)
-  (if ediff-xemacs-p
-      (glyph-height ediff-H-glyph (selected-window frame))
-    (frame-char-height frame)))
-    
-;; Some overlay functions
-
-(defsubst ediff-empty-overlay-p (overl)
-  (= (ediff-overlay-start overl) (ediff-overlay-end overl)))
-
-;; like overlay-buffer in Emacs. In XEmacs, returns nil if the extent is
-;; dead. Otherwise, works like extent-buffer
-(defun ediff-overlay-buffer (overl)
-  (if ediff-emacs-p
-      (overlay-buffer overl)
-    (and (extent-live-p overl) (extent-object overl))))
-
-;; like overlay-get in Emacs. In XEmacs, returns nil if the extent is
-;; dead. Otherwise, like extent-property
-(defun ediff-overlay-get (overl property)
-  (if ediff-emacs-p
-      (overlay-get overl property)
-    (and (extent-live-p overl) (extent-property overl property))))
-
-
-;; These two functions are here because XEmacs refuses to
-;; handle overlays whose buffers were deleted.
-(defun ediff-move-overlay (overlay beg end &optional buffer)
-  "Calls `move-overlay' in Emacs and `set-extent-endpoints' in Lemacs.
-Checks if overlay's buffer exists before actually doing the move."
-  (let ((buf (and overlay (ediff-overlay-buffer overlay))))
-    (if (ediff-buffer-live-p buf)
-	(if ediff-xemacs-p
-	    (set-extent-endpoints overlay beg end)
-	  (move-overlay overlay beg end buffer))
-      ;; buffer's dead
-      (if overlay
-	  (ediff-delete-overlay overlay)))))
-	  
-(defun ediff-overlay-put (overlay prop value)
-  "Calls `overlay-put' or `set-extent-property' depending on Emacs version.
-Checks if overlay's buffer exists."
-  (if (ediff-buffer-live-p (ediff-overlay-buffer overlay))
-      (if ediff-xemacs-p
-	  (set-extent-property overlay prop value)
-	(overlay-put overlay prop value))
-    (ediff-delete-overlay overlay)))
-
-;; Some diff region tests
-  
-;; t if diff region is empty.
-;; In case of buffer C, t also if it is not a 3way
-;; comparison job (merging jobs return t as well).
-(defun ediff-empty-diff-region-p (n buf-type)
-  (if (eq buf-type 'C)
-      (or (not ediff-3way-comparison-job)
-	  (= (ediff-get-diff-posn 'C 'beg n)
-	     (ediff-get-diff-posn 'C 'end n)))
-    (= (ediff-get-diff-posn buf-type 'beg n)
-       (ediff-get-diff-posn buf-type 'end n))))
-       
-;; Test if diff region is white space only.
-;; If 2-way job and buf-type = C, then returns t.
-(defun ediff-whitespace-diff-region-p (n buf-type)
-  (or (and (eq buf-type 'C) (not ediff-3way-job))
-      (ediff-empty-diff-region-p n buf-type)
-      (let ((beg (ediff-get-diff-posn buf-type 'beg n))
-	    (end (ediff-get-diff-posn buf-type 'end n)))
-	(ediff-eval-in-buffer (ediff-get-buffer buf-type)
-	  (save-excursion
-	    (goto-char beg)
-	    (skip-chars-forward ediff-whitespace)
-	    (>= (point) end))))))
-	    
-;; temporarily uses DIR to abbreviate file name
-;; if DIR is nil, use default-directory
-(defun ediff-abbreviate-file-name (file &optional dir)
-  (cond ((stringp dir)
-	 (let ((directory-abbrev-alist (list (cons dir ""))))
-	   (abbreviate-file-name file)))
-	(ediff-emacs-p (abbreviate-file-name file))
-	(t ; XEmacs requires addl argument
-	 (abbreviate-file-name file t))))
-
-;; Takes a directory and returns the parent directory.
-;; does nothing to `/'. If the ARG is a regular file,
-;; strip the file AND the last dir.
-(defun ediff-strip-last-dir (dir)
-  (if (not (stringp dir)) (setq dir default-directory))
-  (setq dir (expand-file-name dir))
-  (or (file-directory-p dir) (setq dir (file-name-directory dir)))
-  (let* ((pos (1- (length dir)))
-	 (last-char (aref dir pos)))
-    (if (and (> pos 0) (= last-char ?/))
-	(setq dir (substring dir 0 pos)))
-    (ediff-abbreviate-file-name (file-name-directory dir))))
-
-(defun ediff-truncate-string-left (str newlen)
-  ;; leave space for ... on the left
-  (let ((len (length str))
-	substr)
-    (if (<= len newlen)
-	str
-      (setq newlen (max 0 (- newlen 3)))
-      (setq substr (substring str (max 0 (- len 1 newlen))))
-      (concat "..." substr))))
-
-(defun ediff-abbrev-jobname (jobname)
-  (cond ((eq jobname 'ediff-directories)
-	 "Compare two directories")
-	((eq jobname 'ediff-files)
-	 "Compare two files")
-	((eq jobname 'ediff-buffers)
-	 "Compare two buffers")
-	((eq jobname 'ediff-directories3)
-	 "Compare three directories")
-	((eq jobname 'ediff-files3)
-	 "Compare three files")
-	((eq jobname 'ediff-buffers3)
-	 "Compare three buffers")
-	((eq jobname 'ediff-revision)
-	 "Compare file with a version")
-	((eq jobname 'ediff-directory-revisions)
-	 "Compare dir files with versions")
-	((eq jobname 'ediff-merge-directory-revisions)
-	 "Merge dir files with versions")
-	((eq jobname 'ediff-merge-directory-revisions-with-ancestor)
-	 "Merge dir versions via ancestors")
-	(t
-	 (let* ((str (substring (symbol-name jobname) 6))
-		(len (length str))
-		(pos 0))
-	   (while (< pos len)
-	     (if (= pos 0)
-		 (aset str pos (upcase (aref str pos))))
-	     (if (= (aref str pos) ?-)
-		 (aset str pos ?\ ))
-	     (setq pos (1+ pos)))
-	   str))))
-  
-
-    
-(defsubst ediff-get-region-contents (n buf-type ctrl-buf &optional start end)
-  (ediff-eval-in-buffer 
-      (ediff-eval-in-buffer ctrl-buf (ediff-get-buffer buf-type))
-    (buffer-substring
-     (or start (ediff-get-diff-posn buf-type 'beg n ctrl-buf))
-     (or end (ediff-get-diff-posn buf-type 'end n ctrl-buf)))))
-  
-;; If ediff modified mode line, strip the modification
-(defsubst ediff-strip-mode-line-format ()
-  (if (member (car mode-line-format) '(" A: " " B: " " C: " " Ancestor: "))
-      (setq mode-line-format (nth 2 mode-line-format))))
-
-;; Verify that we have a difference selected.
-(defsubst ediff-valid-difference-p (&optional n)
-  (or n (setq n ediff-current-difference))
-  (and (>= n 0) (< n ediff-number-of-differences)))
-  
-(defsubst ediff-show-all-diffs (n)
-  "Don't skip difference regions."
-  nil)
-
-(defsubst Xor (a b)
-  (or (and a (not b)) (and (not a) b)))
-
-(defsubst ediff-message-if-verbose (string &rest args)
-  (if ediff-verbose-p
-      (apply 'message string args)))
-
-(defun ediff-file-attributes (filename attr-number)
-  (let ((handler (find-file-name-handler filename 'find-file-noselect)))
-    (if (and handler (string-match "ange-ftp" (format "%S" handler)))
-	-1
-      (nth attr-number (file-attributes filename)))))
-(defsubst ediff-file-size (filename)
-  (ediff-file-attributes filename 7))
-(defsubst ediff-file-modtime (filename)
-  (ediff-file-attributes filename 5))
-
-
-(defun ediff-convert-standard-filename (fname)
-  (if ediff-emacs-p
-      (convert-standard-filename fname)
-    ;; hopefully, XEmacs adds this functionality
-    fname))
-
-
-;;; Local Variables:
-;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
-;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
-;;; End:
-     
-(provide 'ediff-init)
-
-
-;;; ediff-init.el  ends here
diff --git a/lisp/ediff-merg.el b/lisp/ediff-merg.el
deleted file mode 100644
index a07dc8d8c16..00000000000
--- a/lisp/ediff-merg.el
+++ /dev/null
@@ -1,275 +0,0 @@
-;;; ediff-merg.el --- merging utilities
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; 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.
-
-;;; Code:
-
-(require 'ediff-init)
-
-
-(defvar ediff-default-variant 'combined
-  "*The variant to be used as a default for buffer C in merging.
-Valid values are the symbols `default-A', `default-B', and `combined'.")
-
-(defvar ediff-combination-pattern 
-  '("<<<<<<<<<<<<<< variant A" ">>>>>>>>>>>>>> variant B" "======= end of combination")
-  "*Pattern to be used for combining difference regions in buffers A and B.
-The value is (STRING1 STRING2 STRING3). The combined text will look like this:
-
-STRING1
-diff region from variant A
-STRING2
-diff region from variant B
-STRING3
-")
-
-(ediff-defvar-local ediff-show-clashes-only  nil
-  "*If t, show only those diff regions where both buffers disagree with the ancestor.
-This means that regions that have status prefer-A or prefer-B will be
-skiped over. Nil means show all regions.")
-
-	
-(defsubst ediff-get-combined-region (n)
-  (concat (nth 0 ediff-combination-pattern) "\n"
-	  (ediff-get-region-contents n 'A ediff-control-buffer)
-	  (nth 1 ediff-combination-pattern) "\n"
-	  (ediff-get-region-contents n 'B ediff-control-buffer)
-	  (nth 2 ediff-combination-pattern) "\n"))
-
-(defsubst ediff-make-combined-diff (regA regB)
-  (concat (nth 0 ediff-combination-pattern) "\n"
-	  regA
-	  (nth 1 ediff-combination-pattern) "\n"
-	  regB
-	  (nth 2 ediff-combination-pattern) "\n"))
-
-(defsubst ediff-set-state-of-all-diffs-in-all-buffers (ctl-buf)
-  (let ((n 0))
-    (while (< n ediff-number-of-differences)
-      (ediff-set-state-of-diff-in-all-buffers n ctl-buf)
-      (setq n (1+ n)))))
-     
-(defun ediff-set-state-of-diff-in-all-buffers (n ctl-buf)
-  (let ((regA (ediff-get-region-contents n 'A ctl-buf))
-	(regB (ediff-get-region-contents n 'B ctl-buf))
-	(regC (ediff-get-region-contents n 'C ctl-buf)))
-    (cond ((and (string= regA regB) (string= regA  regC))
-	   (ediff-set-state-of-diff n 'A "=diff(B)")
-	   (ediff-set-state-of-diff n 'B "=diff(C)")
-	   (ediff-set-state-of-diff n 'C "=diff(A)"))
-	  ((string= regA regB)
-	   (ediff-set-state-of-diff n 'A "=diff(B)")
-	   (ediff-set-state-of-diff n 'B "=diff(A)")
-	   (ediff-set-state-of-diff n 'C nil))
-	  ((string= regA regC)
-	   (ediff-set-state-of-diff n 'A "=diff(C)")
-	   (ediff-set-state-of-diff n 'C "=diff(A)")
-	   (ediff-set-state-of-diff n 'B nil))
-	  ((string= regB regC)
-	   (ediff-set-state-of-diff n 'C "=diff(B)")
-	   (ediff-set-state-of-diff n 'B "=diff(C)")
-	   (ediff-set-state-of-diff n 'A nil))
-	  ((string= regC (ediff-get-combined-region n))
-	   (ediff-set-state-of-diff n 'A nil)
-	     (ediff-set-state-of-diff n 'B nil)
-	     (ediff-set-state-of-diff n 'C "=diff(A+B)"))
-	  (t (ediff-set-state-of-diff n 'A nil)
-	     (ediff-set-state-of-diff n 'B nil)
-	     (ediff-set-state-of-diff n 'C nil)))
-    ))
-    
-(defun ediff-set-merge-mode ()
-  ;; by Stig@hackvan.com
-  (normal-mode t)
-  (remove-hook 'local-write-file-hooks 'ediff-set-merge-mode))
-
-	
-;; Go over all diffs starting with DIFF-NUM and copy regions into buffer C
-;; according to the state of the difference.
-;; Since ediff-copy-diff refuses to copy identical diff regions, there is
-;; no need to optimize ediff-do-merge any further.
-;;
-;; If re-merging, change state of merge in all diffs starting with
-;; DIFF-NUM, except those where the state is prefer-* or where it is
-;; `default-*' or `combined' but the buf C region appears to be modified
-;; since last set by default.
-(defun ediff-do-merge (diff-num &optional remerging)
-  (if (< diff-num 0) (setq diff-num 0))
-  (let ((n diff-num)
-	;;(default-state-of-merge (format "%S" ediff-default-variant))
-	do-not-copy state-of-merge)
-    (while (< n ediff-number-of-differences)
-      (setq do-not-copy nil) ; reset after each cycle
-      (if (= (mod n 10) 0)
-	  (message "%s buffers A & B into C ... region %d of %d"
-		   (if remerging "Re-merging" "Merging")
-		   n
-		   ediff-number-of-differences))
-	     
-      (setq state-of-merge (ediff-get-state-of-merge n))
-
-      (if remerging
-	  (let ((reg-A (ediff-get-region-contents n 'A ediff-control-buffer))
-		(reg-B (ediff-get-region-contents n 'B ediff-control-buffer))
-		(reg-C (ediff-get-region-contents n 'C ediff-control-buffer)))
-		
-	    ;; if region was edited since it was first set by default
-	    (if (or (and (string= state-of-merge "default-A")
-			 (not (string= reg-A reg-C)))
-		    ;; was edited since first set by default
-		    (and (string= state-of-merge "default-B")
-			 (not (string= reg-B reg-C)))
-		    ;; was edited since first set by default
-		    (and (string= state-of-merge "combined")
-			 (not (string=
-			       (ediff-make-combined-diff reg-A reg-B) reg-C)))
-		    ;; was preferred--ignore
-		    (string-match "prefer" state-of-merge))
-		(setq do-not-copy t))
-		
-	    ;; change state of merge for this diff, if necessary
-	    (if (and (string-match "\\(default\\|combined\\)" state-of-merge)
-		     (not do-not-copy))
-		(ediff-set-state-of-merge
-		 n (format "%S" ediff-default-variant)))
-	    ))
-	  
-      ;; state-of-merge may have changed via ediff-set-state-of-merge, so
-      ;; check it once again
-      (setq state-of-merge (ediff-get-state-of-merge n))
-      
-      (or do-not-copy
-	  (if (string= state-of-merge "combined")
-	      ;; use n+1 because ediff-combine-diffs works via user numbering
-	      ;; of diffs, which is 1+ to what ediff uses internally
-	      (ediff-combine-diffs (1+ n) 'batch)
-	    (ediff-copy-diff 
-	     n (if (string-match "-A" state-of-merge) 'A 'B) 'C 'batch)))
-      (setq n (1+ n)))
-    (message "Merging buffers A & B into C ... Done")
-    ))
-    
-
-(defun ediff-re-merge ()
-  "Remerge unmodified diff regions using a new default. Start with the current region."
-  (interactive)
-  (let* ((default-variant-alist
-	   (list '("default-A") '("default-B") '("combined")))
-	 (actual-alist
-	  (delete (list (symbol-name ediff-default-variant))
-		  default-variant-alist)))
-    (setq ediff-default-variant
-	  (intern
-	   (completing-read 
-	    (format "Current merge default is `%S'. New default: "
-		    ediff-default-variant)
-	    actual-alist nil 'must-match)))
-    (ediff-do-merge ediff-current-difference 'remerge)
-    (ediff-recenter)
-  ))
-    
-(defun ediff-shrink-window-C (arg)
-  "Shrink window C to just one line.
-With a prefix argument, returns window C to its normal size.
-Used only for merging jobs."
-  (interactive "P")
-  (if (not ediff-merge-job)
-      (error "ediff-shrink-window-C can be used only for merging jobs"))
-  (cond ((eq arg '-) (setq arg -1))
-	((not (numberp arg)) (setq arg nil)))
-  (cond ((null arg)
-	 (let ((ediff-merge-window-share
-		(if (< (window-height ediff-window-C) 3)
-		    ediff-merge-window-share 0)))
-	   (setq ediff-window-config-saved "") ; force redisplay
-	   (ediff-recenter 'no-rehighlight)))
-	((and (< arg 0) (> (window-height ediff-window-C) 2))
-	 (setq ediff-merge-window-share (* ediff-merge-window-share 0.9))
-	 (setq ediff-window-config-saved "") ; force redisplay
-	 (ediff-recenter 'no-rehighlight))
-	((and (> arg 0) (> (window-height ediff-window-A) 2))
-	 (setq ediff-merge-window-share (* ediff-merge-window-share 1.1))
-	 (setq ediff-window-config-saved "") ; force redisplay
-	 (ediff-recenter 'no-rehighlight))))
-
-
-;; N here is the user's region number. It is 1+ what Ediff uses internally.
-(defun ediff-combine-diffs (n &optional batch-invocation)
-  "Combine Nth diff regions of buffers A and B and place the combination in C.
-N is a prefix argument. If nil, combine the current difference regions.
-Combining is done according to the specifications in variable
-`ediff-combination-pattern'."
-  (interactive "P")
-  (setq n (if (numberp n) (1- n) ediff-current-difference))
-  
-  (let (regA regB reg-combined)
-    (setq regA (ediff-get-region-contents n 'A ediff-control-buffer)
-	  regB (ediff-get-region-contents n 'B ediff-control-buffer))
-    
-    (setq reg-combined (ediff-make-combined-diff regA regB))
-    
-    (ediff-copy-diff n nil 'C batch-invocation reg-combined))
-    (or batch-invocation (ediff-jump-to-difference (1+ n))))
-    
-
-;; Checks if the region in buff C looks like a combination of the regions
-;; in buffers A and B. Returns a list (reg-a-beg reg-a-end reg-b-beg reg-b-end)
-;; These refer to where the copies of region A and B start and end in buffer C
-(defun ediff-looks-like-combined-merge (region-num)
-  (if ediff-merge-job
-      (let ((combined (string-match (regexp-quote "(A+B)")
-				    (or (ediff-get-state-of-diff region-num 'C)
-					"")))
-	    (reg-beg (ediff-get-diff-posn 'C 'beg region-num))
-	    (reg-end (ediff-get-diff-posn 'C 'end region-num))
-	    (pat1 (nth 0 ediff-combination-pattern))
-	    (pat2 (nth 1 ediff-combination-pattern))
-	    (pat3 (nth 2 ediff-combination-pattern))
-	    reg-a-beg reg-a-end reg-b-beg reg-b-end reg-c-beg reg-c-end)
-	
-	(if combined
-	    (ediff-eval-in-buffer ediff-buffer-C
-	      (goto-char reg-beg)
-	      (search-forward pat1 reg-end 'noerror)
-	      (setq reg-a-beg (match-beginning 0))
-	      (setq reg-a-end (match-end 0))
-	      (search-forward pat2 reg-end 'noerror)
-	      (setq reg-b-beg (match-beginning 0))
-	      (setq reg-b-end (match-end 0))
-	      (search-forward pat3 reg-end 'noerror)
-	      (setq reg-c-beg (match-beginning 0))
-	      (setq reg-c-end (match-end 0))))
-	
-	(if (and reg-a-beg reg-a-end reg-b-beg reg-b-end)
-	    (list reg-a-beg reg-a-end reg-b-beg reg-b-end reg-c-beg reg-c-end))
-	)))
-  
-
-;;; Local Variables:
-;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
-;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
-;;; End:
-
-(provide 'ediff-merg)
-
-;; ediff-merg.el ends here
diff --git a/lisp/ediff-mult.el b/lisp/ediff-mult.el
deleted file mode 100644
index 2920e250e86..00000000000
--- a/lisp/ediff-mult.el
+++ /dev/null
@@ -1,1724 +0,0 @@
-;;; ediff-mult.el --- support for multi-file/multi-buffer processing in Ediff
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; 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:
-
-;; Users are encouraged to add functionality to this file.
-;; The present file contains all the infrastructure needed for that.
-;;
-;; Generally, to to implement a new multisession capability within Ediff,
-;; you need to tell it 
-;;
-;;	1. How to display the session group buffer.
-;;	   This function must indicate which Ediff sessions are active (+) and
-;;	   which are finished (-).
-;;	   See ediff-redraw-directory-group-buffer for an example.
-;;	   In all likelihood, ediff-redraw-directory-group-buffer can be used
-;;	   directly or after a small modification.
-;;	2. What action to take when the user clicks button 2 or types v,e, or
-;;	   RET.  See ediff-filegroup-action.
-;;	3. Provide a list of pairs or triples of file names (or buffers,
-;;	   depending on the particular Ediff operation you want to invoke)
-;;	   in the following format:
-;;	  	(descriptor (obj1 obj2 obj3) (...) ...)
-;;	   Actually, the format of this list is pretty much up to the
-;;	   developer. The only thing is that it must be a list of lists,
-;;	   and the first list must describe the meta session, and subsequent
-;;	   elements must describe individual sessions.
-;;	   This descriptor must be a list of two, three, or four elements (nil
-;;	   or string). The function ediff-redraw-registry-buffer displays the
-;;	   second through last of these in the registry buffer. 
-;;	   Also, keep in mind that the function ediff-prepare-meta-buffer
-;;	   (which see) prepends the session group buffer to the descriptor and
-;;	   nil in front of each subsequent list (i.e., the above list 
-;;	   will become
-;;              ((meta-buf descriptor) (nil obj1 obj2 obj3) (nil ...) ...)
-;;	   Ediff expects that your function (in 2 above) will arrange to
-;;	   replace this prepended nil (via setcar) with the actual ediff
-;;	   control buffer associated with an appropriate Ediff session.
-;;	   This is arranged through internal startup hooks that can be passed
-;;	   to any of Ediff major entries (such as ediff-files, epatch, etc.).
-;;	   See how this is done in ediff-filegroup-action.
-;;
-;;	   Session descriptions are of the form (obj1 obj2 obj3), which
-;;	   describe objects relevant to the session. Usually they are names of
-;;	   files, but sometimes they may be other things. For instance, obj3 is
-;;	   nil for jobs that involve only two files. For patch jobs, obj2 and
-;;	   obj3 are markers that specify the patch corresponding to the file
-;;	   (whose name is obj1).
-;;	4. Write a function that makes a call to ediff-prepare-meta-buffer
-;;	   passing all this info. 
-;;	   You may be able to use ediff-directories-internal as a template.
-;;	5. If you intend to add several related pieces of functionality,
-;;	   you may want to keep the function in 4 as an internal version
-;;	   and then write several top-level interactive functions that call it
-;;	   with different parameters.
-;;	   See how ediff-directories, ediff-merge-directories, and
-;;	   ediff-merge-directories-with-ancestor all use
-;;	   ediff-directories-internal. 
-;;
-;; A useful addition here could be session groups selected by patterns
-;; (which are different in each directory). For instance, one may want to
-;; compare files of the form abc{something}.c to files old{something}.d
-;; which may be in the same or different directories. Or, one may want to
-;; compare all files of the form {something} to files of the form {something}~.
-;;
-;; Implementing this requires writing an collating function, which should pair
-;; up appropriate files. It will also require a generalization of the functions
-;; that do the layout of the meta- and differences buffers and of
-;; ediff-filegroup-action.
-
-;;; Code:
-
-(require 'ediff-init)
-
-;; meta-buffer
-(ediff-defvar-local ediff-meta-buffer nil "")
-(ediff-defvar-local ediff-parent-meta-buffer nil "")
-;; the registry buffer
-(defvar ediff-registry-buffer nil)
-
-(defconst ediff-meta-buffer-message "This is an Ediff Session Group Panel: %s
-
-Useful commands:
-     button2, `v', RET over a session line:   start that Ediff session
-     `M':\tin any session invoked from here, brings back this group panel
-     `R':\tdisplay the registry of active Ediff sessions
-     `h':\tmark session for hiding (toggle)
-     `x':\thide marked sessions; with prefix arg--unhide hidden sessions
-     `m':\tmark session for a non-hiding operation (toggle)
-     SPC:\tnext session
-     DEL:\tprevious session
-     `E':\tbrowse Ediff on-line manual
-     `q':\tquit this session group
-")
-
-(ediff-defvar-local ediff-meta-buffer-map nil
-  "The keymap for the meta buffer.")
-(defvar ediff-dir-diffs-buffer-map (make-sparse-keymap)
-  "The keymap to be installed in the buffer showing differences between
-directories.")
-
-;; Variable specifying the action to take when the use invokes ediff in the
-;; meta buffer. This is usually ediff-registry-action or ediff-filegroup-action
-(ediff-defvar-local ediff-meta-action-function nil "")
-;; Tells ediff-update-meta-buffer how to redraw it
-(ediff-defvar-local ediff-meta-redraw-function nil "")
-;; Tells ediff-filegroup-action and similar procedures how to invoke Ediff for
-;; the sessions in a given session group
-(ediff-defvar-local ediff-session-action-function nil "")
-
-(ediff-defvar-local ediff-metajob-name nil "")
-
-;; buffer used to collect custom diffs from individual sessions in the group
-(ediff-defvar-local ediff-meta-diff-buffer nil "")
-
-;; history var to use for filtering groups
-(defvar ediff-filtering-regexp-history nil "")
-
-;; This has the form ((ctl-buf file1 file2) (stl-buf file1 file2) ...)
-;; If ctl-buf is nil, the file-pair wasn't processed yet. If it is
-;; killed-buffer object, the file pair has been processed. If it is a live
-;; buffer, this means ediff is still working on the pair
-(ediff-defvar-local ediff-meta-list nil "")
-
-
-;; the difference list between directories in a directory session group
-(ediff-defvar-local ediff-dir-difference-list nil "")
-(ediff-defvar-local ediff-dir-diffs-buffer nil "")
-
-;; The registry of Ediff sessions. A list of control buffers.
-(defvar ediff-session-registry nil)
-
-(defvar ediff-registry-setup-hook nil
-  "*Hooks run just after the registry control panel is set up.")
-(defvar ediff-session-group-setup-hook nil
-  "*Hooks run just after a meta-buffer controlling a session group, such as
-ediff-directories, is run.")
-(defvar ediff-quit-session-group-hook nil
-  "*Hooks run just before exiting a session group.")
-(defvar ediff-show-registry-hook nil
-  "*Hooks run just after the registry buffer is shown.")
-(defvar ediff-show-session-group-hook nil
-  "*Hooks run just after a session group buffer is shown.")
-(defvar ediff-meta-buffer-keymap-setup-hook nil
-  "*Hooks run just after setting up the ediff-meta-buffer-map.
-This keymap controls key bindings in the meta buffer and is a local variable.
-This means that you can set different bindings for different kinds of meta
-buffers.")
-
-;; buffer holding the multi-file patch. local to the meta buffer
-(ediff-defvar-local ediff-meta-patchbufer nil "")
-
-;;; API for ediff-meta-list
-
-;; group buffer/regexp
-(defun ediff-get-group-buffer (meta-list)
-  (nth 0 (car meta-list)))
-
-(defun ediff-get-group-regexp (meta-list)
-  (nth 1 (car meta-list)))
-;; group objects
-(defun ediff-get-group-objA (meta-list)
-  (nth 2 (car meta-list)))
-(defun ediff-get-group-objB (meta-list)
-  (nth 3 (car meta-list)))
-(defun ediff-get-group-objC (meta-list)
-  (nth 4 (car meta-list)))
-(defun ediff-get-group-merge-autostore-dir (meta-list)
-  (nth 5 (car meta-list)))
-
-;; session buffer
-(defun ediff-get-session-buffer (elt)
-  (nth 0 elt))
-(defun ediff-get-session-status (elt)
-  (nth 1 elt))
-(defun ediff-set-session-status (session-info new-status)
-  (setcar (cdr session-info) new-status))
-;; session objects
-(defun ediff-get-session-objA (elt)
-  (nth 2 elt))
-(defun ediff-get-session-objB (elt)
-  (nth 3 elt))
-(defun ediff-get-session-objC (elt)
-  (nth 4 elt))
-(defun ediff-get-session-objA-name (elt)
-  (car (nth 2 elt)))
-(defun ediff-get-session-objB-name (elt)
-  (car (nth 3 elt)))
-(defun ediff-get-session-objC-name (elt)
-  (car (nth 4 elt)))
-;; equality indicators
-(defsubst ediff-get-file-eqstatus (elt)
-  (nth 1 elt))
-(defsubst ediff-set-file-eqstatus (elt value)
-  (setcar (cdr elt) value))
-
-;; set up the keymap in the meta buffer
-(defun ediff-setup-meta-map()
-  (setq ediff-meta-buffer-map (make-sparse-keymap))
-  (suppress-keymap ediff-meta-buffer-map)
-  (define-key ediff-meta-buffer-map "q" 'ediff-quit-meta-buffer)
-  (define-key ediff-meta-buffer-map "R" 'ediff-show-registry)
-  (define-key ediff-meta-buffer-map "E" 'ediff-documentation)
-  (define-key ediff-meta-buffer-map "v" ediff-meta-action-function)
-  (define-key ediff-meta-buffer-map "\C-m" ediff-meta-action-function)
-  (define-key ediff-meta-buffer-map  " "  'ediff-next-meta-item)
-  (define-key ediff-meta-buffer-map  "\C-?"  'ediff-previous-meta-item)
-  (define-key ediff-meta-buffer-map  [delete]  'ediff-previous-meta-item)
-  (define-key ediff-meta-buffer-map  [backspace]  'ediff-previous-meta-item)
-  (or (ediff-one-filegroup-metajob)
-      (define-key ediff-meta-buffer-map "=" 'ediff-meta-mark-equal-files))
-  (if ediff-no-emacs-help-in-control-buffer
-      (define-key ediff-meta-buffer-map  "\C-h"  'ediff-previous-meta-item))
-  (if ediff-emacs-p
-      (define-key ediff-meta-buffer-map [mouse-2] ediff-meta-action-function)
-    (define-key ediff-meta-buffer-map [button2] ediff-meta-action-function))
-
-  (use-local-map ediff-meta-buffer-map)
-  ;; modify ediff-meta-buffer-map here
-  (run-hooks 'ediff-meta-buffer-keymap-setup-hook))
-
-(defun ediff-meta-mode ()
-  "This mode controls all operations on Ediff session groups.
-It is entered through one of the following commands:
-	`ediff-directories'
-	`edirs'
-	`ediff-directories3'
-	`edirs3'
-	`ediff-merge-directories'
-	`edirs-merge'
-	`ediff-merge-directories-with-ancestor'
-	`edirs-merge-with-ancestor'
-	`ediff-directory-revisions'
-	`edir-revisions'
-	`ediff-merge-directory-revisions'
-	`edir-merge-revisions'
-	`ediff-merge-directory-revisions-with-ancestor'
-	`edir-merge-revisions-with-ancestor'
-
-Commands:
-\\{ediff-meta-buffer-map}"
-  (kill-all-local-variables)
-  (setq major-mode 'ediff-meta-mode)
-  (setq mode-name "MetaEdiff"))
-
-
-;; the keymap for the buffer showing directory differences
-(suppress-keymap ediff-dir-diffs-buffer-map)
-(define-key ediff-dir-diffs-buffer-map "q" 'ediff-bury-dir-diffs-buffer)
-(define-key ediff-dir-diffs-buffer-map " " 'next-line)
-(define-key ediff-dir-diffs-buffer-map "\C-?" 'previous-line)
-(define-key ediff-dir-diffs-buffer-map [delete] 'previous-line)
-(define-key ediff-dir-diffs-buffer-map [backspace] 'previous-line)
-
-(defun ediff-next-meta-item (count)
-  "Move to the next item in Ediff registry or session group buffer.
-Moves in circular fashion. With numeric prefix arg, skip this many items."
-  (interactive "p")
-  (or count (setq count 1))
-  (while (< 0 count)
-    (setq count (1- count))
-    (ediff-next-meta-item1)))
-
-;; Move to the next meta item
-(defun ediff-next-meta-item1 ()
-  (let (pos)
-    (setq pos (ediff-next-meta-overlay-start (point)))
-;;;	;; skip deleted
-;;;    (while (memq (ediff-get-session-status
-;;;	          (ediff-get-meta-info (current-buffer) pos 'noerror))
-;;;		 '(?H ?I))
-;;;      (setq pos (ediff-next-meta-overlay-start pos)))
-    
-    (if pos (goto-char pos))
-    (if (eq ediff-metajob-name 'ediff-registry)
-	(if (and (ediff-get-meta-info (current-buffer) pos 'noerror)
-		 (search-forward "*Ediff" nil t))
-	    (skip-chars-backward "a-zA-Z*"))
-      (if (> (skip-chars-forward "-+?H* \t0-9") 0)
-	  (backward-char 1)))))
-
-
-(defun ediff-previous-meta-item (count)
-  "Move to the previous item in Ediff registry or session group buffer.
-Moves in circular fashion. With numeric prefix arg, skip this many items."
-  (interactive "p")
-  (or count (setq count 1))
-  (while (< 0 count)
-    (setq count (1- count))
-    (ediff-previous-meta-item1)))
-
-(defun ediff-previous-meta-item1 ()
-  (let (pos)
-    (setq pos (ediff-previous-meta-overlay-start (point)))
-;;;	;; skip deleted
-;;;    (while (ediff-get-session-status
-;;;	    (ediff-get-meta-info (current-buffer) pos 'noerror))
-;;;      (setq pos (ediff-previous-meta-overlay-start pos)))
-    
-    (if pos (goto-char pos))
-    (if (eq ediff-metajob-name 'ediff-registry)
-	(if (and (ediff-get-meta-info (current-buffer) pos 'noerror)
-		 (search-forward "*Ediff" nil t))
-	    (skip-chars-backward "a-zA-Z*"))
-      (if (> (skip-chars-forward "-+?H* \t0-9") 0)
-	  (backward-char 1)))
-    ))
-
-(defsubst ediff-add-slash-if-directory (dir file)
-  (if (file-directory-p (concat dir file))
-      (file-name-as-directory file)
-    file))
-
-
-;; DIR1, DIR2, DIR3 are directories. DIR3 can be nil.
-;; OUTPUT-DIR is a directory for auto-storing the results of merge jobs.
-;;	      Can be nil.
-;; REGEXP is a regexp used to filter out files in the directories.
-;; If a file is a directory in dir1 but not dir2 (or vice versa), it is not
-;; included in the intersection. However, a regular file that is a dir in dir3
-;; is included, since dir3 files are supposed to be ancestors for merging.
-;; Returns a list of the form:
-;;	((dir1 dir2 dir3) (f1 f2 f3) (f1 f2 f3) ...)
-;; dir3, f3 can be nil if intersecting only 2 directories.
-;; If COMPARISON-FUNC is given, use it. Otherwise, use string=
-;; DIFF-VAR contains the name of the variable in which to return the
-;; difference list (which represents the differences among the contents of
-;; directories). The diff list is of the form:
-;;	((dir1 dir2 dir3) (file . num) (file . num)...)
-;; where num encodes the set of dirs where the file is found:
-;; 2 - only dir1; 3 - only dir2; 5 - only dir3; 6 - dir1&2; 10 - dir1&3; etc.
-(defun ediff-intersect-directories (jobname
-				    diff-var regexp dir1 dir2
-				    &optional
-				    dir3 merge-autostore-dir comparison-func)
-  (setq comparison-func (or comparison-func 'string=))
-  (let (lis1 lis2 lis3 common auxdir1 auxdir2 auxdir3 difflist)
-
-    (setq auxdir1	(file-name-as-directory dir1)
-	  lis1		(directory-files auxdir1 nil regexp)
-	  lis1 		(delete "."  lis1)
-	  lis1 		(delete ".." lis1)
-	  lis1 		(mapcar 
-			 (function 
-			  (lambda (elt)
-				  (ediff-add-slash-if-directory auxdir1 elt)))
-			 lis1)
-	  auxdir2	(file-name-as-directory dir2)
-	  lis2		(mapcar 
-			 (function
-			  (lambda (elt)
-				  (ediff-add-slash-if-directory auxdir2 elt)))
-			 (directory-files auxdir2 nil regexp)))
-
-    (if (stringp dir3)
-	(setq auxdir3	(file-name-as-directory dir3)
-	      lis3	(mapcar 
-			 (function
-			  (lambda (elt)
-				  (ediff-add-slash-if-directory auxdir3 elt)))
-			 (directory-files auxdir3 nil regexp))))
-
-    (if (stringp merge-autostore-dir)
-	(setq merge-autostore-dir
-	      (file-name-as-directory merge-autostore-dir)))
-    (setq common (ediff-intersection lis1 lis2 comparison-func))
-
-    ;; In merge with ancestor jobs, we don't intersect with lis3.
-    ;; If there is no ancestor, we'll offer to merge without the ancestor.
-    ;; So, we intersect with lis3 only when we are doing 3-way file comparison
-    (if (and lis3 (ediff-comparison-metajob3 jobname))
-	(setq common (ediff-intersection common lis3 comparison-func)))
-
-    ;; copying is needed because sort sorts via side effects
-    (setq common (sort (ediff-copy-list common) 'string-lessp))
-
-    ;; compute difference list
-    (setq difflist (ediff-set-difference
-		    (ediff-union (ediff-union lis1 lis2 comparison-func)
-				 lis3
-				 comparison-func)
-		    common
-		    comparison-func)
-	  difflist (delete "."  difflist)
-	  ;; copying is needed because sort sorts via side effects
-	  difflist (sort (ediff-copy-list (delete ".." difflist))
-			 'string-lessp))
-
-    (setq difflist (mapcar (function (lambda (elt) (cons elt 1))) difflist))
-
-    ;; check for files belonging to lis1/2/3
-    (mapcar (function (lambda (elt) 
-			(if (member (car elt) lis1)
-			    (setcdr elt (* (cdr elt) 2)))
-			(if (member (car elt) lis2)
-			    (setcdr elt (* (cdr elt) 3)))
-			(if (member (car elt) lis3)
-			    (setcdr elt (* (cdr elt) 5)))
-			))
-	    difflist)
-    (setq difflist (cons (list regexp auxdir1 auxdir2 auxdir3) difflist))
-    
-    ;; return the difference list back to the calling function
-    (set diff-var difflist)
-
-    ;; return result
-    (cons (list regexp auxdir1 auxdir2 auxdir3 merge-autostore-dir)
-	  (mapcar
-	   (function
-	    (lambda (elt) 
-	      (list (concat auxdir1 elt)
-		    (concat auxdir2 elt)
-		    (if lis3
-			(progn
-			  ;; The following is done because:
-			  ;;   In merging with ancestor, we don't intersect
-			  ;;   with lis3. So, it is possible that elt is a
-			  ;;   file in auxdir1/2 but a directory in auxdir3
-			  ;;   Or elt may not exist in auxdir3 at all.
-			  ;;   In the first case, we add a slash at the end.
-			  ;;   In the second case, we insert nil.
-			  (setq elt (ediff-add-slash-if-directory auxdir3 elt))
-			  (if (file-exists-p (concat auxdir3 elt))
-			      (concat auxdir3 elt)))))))
-	   common))
-    ))
-
-;; find directory files that are under revision.
-;; Include subdirectories, since we may visit them recursively.
-;; DIR1 is the directory to inspect.
-;; OUTPUT-DIR is the directory where to auto-store the results of merges. Can
-;; be nil.
-(defun ediff-get-directory-files-under-revision (jobname
-						 regexp dir1
-						 &optional merge-autostore-dir)
-  (let (lis1 elt common auxdir1)
-    (setq auxdir1 (file-name-as-directory dir1)
-	  lis1	  (directory-files auxdir1 nil regexp))
-
-    (if (stringp merge-autostore-dir)
-	(setq merge-autostore-dir
-	      (file-name-as-directory merge-autostore-dir)))
-
-    (while lis1
-      (setq elt  (car lis1)
-	    lis1 (cdr lis1))
-      ;; take files under revision control
-      (cond ((file-directory-p (concat auxdir1 elt))
-	     (setq common (cons elt common)))
-	    ((file-exists-p (concat auxdir1 elt ",v"))
-	     (setq common (cons elt common)))
-	    ((file-exists-p (concat auxdir1 "RCS/" elt ",v"))
-	     (setq common (cons elt common)))
-	    ) ; cond
-      ) ; while
-
-    (setq common (delete "."  common)
-	  common (delete ".." common)
-	  common (delete "RCS" common))
-
-    ;; copying is needed because sort sorts via side effects
-    (setq common (sort (ediff-copy-list common) 'string-lessp))
-
-    ;; return result
-    (cons (list regexp auxdir1 nil nil merge-autostore-dir)
-	  (mapcar (function (lambda (elt) 
-			      (list (concat auxdir1 elt)
-				    nil nil)))
-		  common))
-    ))
-      
-
-;; If file groups selected by patterns will ever be implemented, this
-;; comparison function might become useful.
-;;;; uses external variables PAT1 PAT2 to compare str1/2
-;;;; patterns must be of the form ???*???? where ??? are strings of chars
-;;;; containing no *.
-;;(defun ediff-pattern= (str1 str2)
-;;  (let (pos11 pos12 pos21 pos22 len1 len2)
-;;    (setq pos11 0
-;;	  len  (length epat1)
-;;	  pos12 len)
-;;    (while (and (< pos11 len) (not (= (aref epat1 pos11) ?*)))
-;;      (setq pos11 (1+ pos11)))
-;;    (while (and (> pos12 0) (not (= (aref epat1 (1- pos12)) ?*)))
-;;      (setq pos12 (1- pos12)))
-;;
-;;    (setq pos21 0
-;;	  len  (length epat2)
-;;	  pos22 len)
-;;    (while (and (< pos21 len) (not (= (aref epat2 pos21) ?*)))
-;;      (setq pos21 (1+ pos21)))
-;;    (while (and (> pos22 0) (not (= (aref epat2 (1- pos22)) ?*)))
-;;      (setq pos22 (1- pos22)))
-;;
-;;    (if (and (> (length str1) pos12) (>= pos12 pos11) (> pos11 -1)
-;;	     (> (length str2) pos22) (>= pos22 pos21) (> pos21 -1))
-;;	(string= (substring str1 pos11 pos12)
-;;		 (substring str2 pos21 pos22)))
-;;    ))
-
-
-;; Prepare meta-buffer in accordance with the argument-function and
-;; redraw-function. Must return the created  meta-buffer.
-(defun ediff-prepare-meta-buffer (action-func meta-list
-				  meta-buffer-name redraw-function
-				  jobname &optional startup-hooks)
-  (let* ((meta-buffer-name 
-	  (ediff-unique-buffer-name meta-buffer-name "*"))
-	 (meta-buffer (get-buffer-create meta-buffer-name)))
-    (ediff-eval-in-buffer meta-buffer
-
-      ;; comes first
-      (ediff-meta-mode)
-
-      (setq ediff-meta-action-function action-func
-	    ediff-meta-redraw-function redraw-function
-	    ediff-metajob-name jobname
-	    ediff-meta-buffer meta-buffer)
-
-      ;; comes after ediff-meta-action-function is set
-      (ediff-setup-meta-map)
-      
-      (if (eq ediff-metajob-name 'ediff-registry)
-	  (progn
-	    (setq ediff-registry-buffer meta-buffer
-		  ediff-meta-list meta-list)
-	    ;; this func is used only from registry buffer, not from other
-	    ;; meta-buffs.
-	    (define-key
-	      ediff-meta-buffer-map "M" 'ediff-show-meta-buff-from-registry))
-	;; Initialize the meta list -- don't do this for registry.
-	;;
-	;; We prepend '(nil nil) to all elts of meta-list, except the first.
-	;; The first nil will later be replaced by the session buffer. The
-	;; second is reserved for session status.
-	;;
-	;; (car ediff-meta-list) gets cons'ed with the session group buffer.
-	;; Also, session objects A/B/C are turned into lists of the form
-	;; (obj eq-indicator). Eq-indicator is either nil or =. Initialized to
-	;; nil. If later it is discovered that this file is = to some other
-	;; file in the same session, eq-indicator is changed to `='.
-	;; For now, the eq-indicator is used only for 2 and 3-file jobs.
-	(setq ediff-meta-list
-	      (cons (cons meta-buffer (car meta-list))
-		    (mapcar
-		     (function
-		      (lambda (elt)
-			(cons nil
-			      (cons nil
-				    ;; convert each obj to (obj nil),
-				    ;; where nil is the initial value
-				    ;; for eq-indicator -- see above
-				    (mapcar
-				     (function (lambda (obj) (list obj nil)))
-				     elt)))))
-		     (cdr meta-list)))))
-	
-      (or (eq meta-buffer ediff-registry-buffer)
-	  (setq ediff-session-registry
-		(cons meta-buffer ediff-session-registry)))
-	
-      ;; redraw-function uses ediff-meta-list
-      (funcall redraw-function ediff-meta-list)
-      
-      ;; set read-only/non-modified
-      (setq buffer-read-only t)
-      (set-buffer-modified-p nil)
-
-      (run-hooks 'startup-hooks)
-
-      ;; Arrange to show directory contents differences
-      ;; Must be after run startup-hooks, since ediff-dir-difference-list is
-      ;; set inside these hooks
-      (if (eq action-func 'ediff-filegroup-action)
-	  (progn
-	    ;; put meta buffer in (car ediff-dir-difference-list)
-	    (setq ediff-dir-difference-list
-		  (cons (cons meta-buffer (car ediff-dir-difference-list))
-			(cdr ediff-dir-difference-list)))
-
-	    (or (ediff-one-filegroup-metajob jobname)
-		(ediff-draw-dir-diffs ediff-dir-difference-list))
-	    (define-key ediff-meta-buffer-map "h" 'ediff-mark-for-hiding)
-	    (define-key
-	      ediff-meta-buffer-map "x" 'ediff-hide-marked-sessions)
-	    (define-key ediff-meta-buffer-map "m" 'ediff-mark-for-operation)
-	    (cond ((ediff-collect-diffs-metajob jobname)
-		   (define-key
-		     ediff-meta-buffer-map "P" 'ediff-collect-custom-diffs))
-		  ((ediff-patch-metajob jobname)
-		   (define-key
-		     ediff-meta-buffer-map "P" 'ediff-meta-show-patch)))
-	    (define-key ediff-meta-buffer-map "u" 'ediff-up-meta-hierarchy)
-	    (define-key ediff-meta-buffer-map "D" 'ediff-show-dir-diffs)))
-
-      (if (eq ediff-metajob-name 'ediff-registry)
-	  (run-hooks 'ediff-registry-setup-hook)
-	(run-hooks 'ediff-session-group-setup-hook))
-      ) ; eval in meta-buffer
-    meta-buffer))
-
-
-;; this is a setup function for ediff-directories
-;; must return meta-buffer
-(defun ediff-redraw-directory-group-buffer (meta-list)
-  ;; extract directories
-  (let ((meta-buf (ediff-get-group-buffer meta-list))
-	(empty t)
-	(sessionNum 0)
-	regexp elt session-buf f1 f2 f3 pt 
-	merge-autostore-dir
-	point tmp-list buffer-read-only)
-    (ediff-eval-in-buffer meta-buf
-      (setq point (point))
-      (erase-buffer)
-      (insert (format ediff-meta-buffer-message
-		      (ediff-abbrev-jobname ediff-metajob-name)))
-
-      (setq regexp (ediff-get-group-regexp meta-list)
-	    merge-autostore-dir (ediff-get-group-merge-autostore-dir meta-list))
-      
-      (cond ((ediff-collect-diffs-metajob)
-	     (insert
-	      "     `P':\tcollect custom diffs of all marked sessions\n"))
-	    ((ediff-patch-metajob)
-	     (insert
-	      "     `P':\tshow patch appropriately for the context (session or group)\n")))
-      (insert
-       "     `u':\tshow parent session group\n")
-      (or (ediff-one-filegroup-metajob)
-	  (insert
-	   "     `D':\tshow differences among directories\n"
-	   "     `=':\tmark identical files in each session\n\n"))
-
-      (if (and (stringp regexp) (> (length regexp) 0))
-	  (insert (format "Filter-through regular expression: %s\n" regexp)))
-      (if (and ediff-autostore-merges (ediff-merge-metajob)
-	       (stringp merge-autostore-dir))
-	  (insert (format
-		   "\nMerges are automatically stored in directory: %s\n"
-		   merge-autostore-dir)))
-      (insert "\n
-        Size   Last modified           Name
-    -----------------------------------------------------------------------
-
-")
-      
-      ;; discard info on directories and regexp
-      (setq meta-list (cdr meta-list)
-	    tmp-list meta-list)
-      (while (and tmp-list empty)
-	(if (and (car tmp-list)
-		 (not (eq (ediff-get-session-status (car tmp-list)) ?I)))
-	    (setq empty nil))
-	(setq tmp-list (cdr tmp-list)))
-
-      (if empty
-	  (insert
-	   "     ******   ******   This session group has no members\n"))
-      
-      ;; now organize file names like this:
-      ;;     use-mark sizeA dateA  sizeB dateB  filename
-      ;; make sure directories are displayed with a trailing slash.
-      (while meta-list
-	(setq elt (car meta-list)
-	      meta-list (cdr meta-list)
-	      sessionNum (1+ sessionNum))
-	(if (eq (ediff-get-session-status elt) ?I)
-	    ()
-	  (setq session-buf (ediff-get-session-buffer elt)
-		f1 (ediff-get-session-objA elt)
-		f2 (ediff-get-session-objB elt)
-		f3 (ediff-get-session-objC elt))
-	  (setq pt (point))
-	  ;; insert markers
-	  (insert (cond ((null session-buf) " ") ; virgin session
-			((ediff-buffer-live-p session-buf) "+") ;active session
-			(t "-"))) ; finished session
-	  (insert (cond ((ediff-get-session-status elt)) ; session has status,
-						       ;;; e.g., ?H, ?I
-			(t " "))) ; normal session
-	  (insert "  Session " (int-to-string sessionNum) ":\n")
-	  (ediff-meta-insert-file-info f1)
-	  (ediff-meta-insert-file-info f2)
-	  (ediff-meta-insert-file-info f3)
-	  (ediff-set-meta-overlay pt (point) elt)))
-      (set-buffer-modified-p nil)
-      (goto-char point)
-      meta-buf)))
-
-;; Check if this is a problematic session.
-;; Return nil if not. Otherwise, return symbol representing the problem
-;; At present, problematic sessions occur only in -with-ancestor comparisons
-;; when the ancestor is a directory rather than a file, or when there is no
-;; suitable ancestor file in the ancestor directory
-(defun ediff-problematic-session-p (session)
-  (let ((f1 (ediff-get-session-objA-name session))
-	(f2 (ediff-get-session-objB-name session))
-	(f3 (ediff-get-session-objC-name session)))
-    (cond ((and (stringp f1) (not (file-directory-p f1))
-		(stringp f2) (not (file-directory-p f2))
-		;; either invalid file name or a directory
-		(or (not (stringp f3)) (file-directory-p f3))
-		(ediff-ancestor-metajob))
-	   ;; more may be added later
-	   'ancestor-is-dir)
-	  (t nil))))
-
-(defun ediff-meta-insert-file-info (fileinfo)
-  (let ((fname (car fileinfo))
-	(feq (ediff-get-file-eqstatus fileinfo))
-	file-modtime file-size)
-
-    (cond ((not (stringp fname)) (setq file-size -2)) ; file doesn't exits
-	  ((not (ediff-file-remote-p fname))
-	   (if (file-exists-p fname)
-	       ;; set real size and modtime
-	       (setq file-size (ediff-file-size fname)
-		     file-modtime (ediff-file-modtime fname))
-	     (setq file-size -2)))  ; file doesn't exist
-	  ( t (setq file-size -1))) ; remote file
-    (if (stringp fname)
-	(insert
-	 (format
-	  "%s  %s   %-20s   %s\n"
-	  (if feq "=" " ") ; equality indicator
-	  (format "%10s" (cond ((= file-size -1) "--")
-			       ((< file-size -1) "--")
-			       (t file-size)))
-	  (cond ((= file-size -1) "*remote file*")
-		((< file-size -1) "*file doesn't exist*")
-		(t (ediff-format-date (decode-time file-modtime))))
-
-	  ;; dir names in meta lists have training slashes, so we just
-	  ;; abbreviate the file name, if file exists
-	  (if (and (not (stringp fname)) (< file-size -1))
-	      "-------"		; file doesn't exist
-	    (ediff-abbreviate-file-name fname)))))))
-
-(defconst ediff-months '((1 . "Jan") (2 . "Feb") (3 . "Mar") (4 . "Apr")
-			(5 . "May") (6 . "Jun") (7 . "Jul") (8 . "Aug")
-			(9 . "Sep") (10 . "Oct") (11 . "Nov") (12 . "Dec"))
-  "Months' associative array.")
-
-;; returns 2char string
-(defsubst ediff-fill-leading-zero (num)
-  (if (< num 10)
-      (format "0%d" num)
-    (number-to-string num)))
-
-;; TIME is like the output of decode-time
-(defun ediff-format-date (time)
-  (format "%s %2d %4d %s:%s:%s"
-	  (cdr (assoc (nth 4 time) ediff-months)) ; month
-	  (nth 3 time) ; day
-	  (nth 5 time) ; year
-	  (ediff-fill-leading-zero (nth 2 time)) ; hour
-	  (ediff-fill-leading-zero (nth 1 time)) ; min
-	  (ediff-fill-leading-zero (nth 0 time)) ; sec
-	  ))
-
-(defun ediff-draw-dir-diffs (diff-list)
-  (if (null diff-list) (error "Lost difference info on these directories"))
-  (let* ((buf-name (ediff-unique-buffer-name
-		    "*Ediff File Group Differences" "*"))
-	 (regexp (ediff-get-group-regexp diff-list))
-	 (dir1 (ediff-abbreviate-file-name (ediff-get-group-objA diff-list)))
-	 (dir2 (ediff-abbreviate-file-name (ediff-get-group-objB diff-list)))
-	 (dir3 (ediff-get-group-objC diff-list))
-	 (dir3 (if (stringp dir3) (ediff-abbreviate-file-name dir3)))
-	 (meta-buf (ediff-get-group-buffer diff-list))
-	 (underline (make-string 26 ?-))
-	 file code 
-	 buffer-read-only)
-    ;; skip the directory part
-    (setq diff-list (cdr diff-list))
-    (setq ediff-dir-diffs-buffer (get-buffer-create buf-name))
-    (ediff-eval-in-buffer ediff-dir-diffs-buffer
-      (use-local-map ediff-dir-diffs-buffer-map)
-      (erase-buffer)
-      (setq ediff-meta-buffer meta-buf)
-      (insert "\t\t*** Directory Differences ***\n")
-      (insert "
-Useful commands:
-     `q': hide this buffer
-     SPC: next line
-     DEL: previous line\n\n")
-
-      (if (and (stringp regexp) (> (length regexp) 0))
-	  (insert (format "Filter-through regular expression: %s\n" regexp)))
-      (insert "\n")
-      (insert (format "\n%-27s%-26s"
-		      (ediff-truncate-string-left
-		       (ediff-abbreviate-file-name
-			(file-name-as-directory dir1))
-		       25)
-		      (ediff-truncate-string-left
-		       (ediff-abbreviate-file-name
-			(file-name-as-directory dir2))
-		       25)))
-      (if dir3
-	  (insert (format " %-25s\n"
-			  (ediff-truncate-string-left
-			   (ediff-abbreviate-file-name
-			    (file-name-as-directory dir3))
-			   25)))
-	(insert "\n"))
-      (insert (format "%s%s" underline underline))
-      (if (stringp dir3)
-	  (insert (format "%s\n\n" underline))
-	(insert "\n\n"))
-
-      (if (null diff-list)
-	  (insert "\n\t***  No differences  ***\n"))
-
-      (while diff-list
-	(setq file (car (car diff-list))
-	      code (cdr (car diff-list))
-	      diff-list (cdr diff-list))
-	(if (= (mod code 2) 0) ; dir1
-	    (insert (format "%-27s"
-			    (ediff-truncate-string-left
-			     (ediff-abbreviate-file-name
-			      (if (file-directory-p (concat dir1 file))
-				  (file-name-as-directory file)
-				file))
-			     24)))
-	  (insert (format "%-27s" "---")))
-	(if (= (mod code 3) 0) ; dir2
-	    (insert (format "%-26s"
-			    (ediff-truncate-string-left
-			     (ediff-abbreviate-file-name
-			      (if (file-directory-p (concat dir2 file))
-				  (file-name-as-directory file)
-				file))
-			     24)))
-	  (insert (format "%-26s" "---")))
-	(if (stringp dir3)
-	    (if (= (mod code 5) 0) ; dir3
-		(insert (format " %-25s" 
-				(ediff-truncate-string-left
-				 (ediff-abbreviate-file-name
-				  (if (file-directory-p (concat dir3 file))
-				      (file-name-as-directory file)
-				    file))
-				 24)))
-	      (insert (format " %-25s" "---"))))
-	(insert "\n"))
-      (setq buffer-read-only t)
-      (set-buffer-modified-p nil)) ; eval in diff buffer
-  ))
-
-(defun ediff-bury-dir-diffs-buffer ()
-  "Bury the directory difference buffer. Display the meta buffer instead."
-  (interactive)
-  (let ((buf ediff-meta-buffer)
-	wind)
-    (bury-buffer)
-    (if (setq wind (ediff-get-visible-buffer-window buf))
-	(select-window wind)
-      (set-window-buffer (selected-window) buf))))
-
-;; executes in dir session group buffer
-;; show buffer differences
-(defun ediff-show-dir-diffs ()
-  "Display differences among the directories involved in session group."
-  (interactive)
-  (if (ediff-one-filegroup-metajob)
-      (error "This command is inapplicable in the present context"))
-  (or (ediff-buffer-live-p ediff-dir-diffs-buffer)
-      (ediff-draw-dir-diffs ediff-dir-difference-list))
-  (let ((buf ediff-dir-diffs-buffer))
-    (other-window 1)
-    (set-window-buffer (selected-window) buf)
-    (goto-char (point-min))))
-
-(defun ediff-up-meta-hierarchy ()
-  "Go to the parent session group buffer."
-  (interactive)
-  (if (ediff-buffer-live-p ediff-parent-meta-buffer)
-      (ediff-show-meta-buffer ediff-parent-meta-buffer)
-    (error "This session group has no parent")))
-  
-
-;; argument is ignored
-(defun ediff-redraw-registry-buffer (&optional ignore)
-  (ediff-eval-in-buffer ediff-registry-buffer
-    (let ((point (point))
-	  elt bufAname bufBname bufCname cur-diff total-diffs pt
-	  job-name meta-list registry-list buffer-read-only)
-      (erase-buffer)
-      (insert "This is a registry of all active Ediff sessions.
-
-Useful commands:
-     button2, `v', RET over a session record:  switch to that session
-     `M' over a session record:  display the associated session group
-     `R' in any Ediff session:   display session registry
-     SPC:\tnext session
-     DEL:\tprevious session
-     `E':\tbrowse Ediff on-line manual
-     `q':\tbury registry
-
-
-\t\tActive Ediff Sessions:
-\t\t----------------------
-
-")
-      ;; purge registry list from dead buffers
-      (mapcar (function (lambda (elt)
-			  (if (not (ediff-buffer-live-p elt))
-			      (setq ediff-session-registry
-				    (delq elt ediff-session-registry)))))
-	      ediff-session-registry)
-
-      (if (null ediff-session-registry)
-	  (insert "       ******* No active Ediff sessions *******\n"))
-
-      (setq registry-list ediff-session-registry)
-      (while registry-list
-	(setq elt (car registry-list)
-	      registry-list (cdr registry-list))
-	
-	(if (ediff-buffer-live-p elt)
-	    (if (ediff-eval-in-buffer elt
-		  (setq job-name ediff-metajob-name
-			meta-list ediff-meta-list)
-		  (and ediff-metajob-name
-		       (not (eq ediff-metajob-name 'ediff-registry))))
-		(progn
-		  (setq pt (point))
-		  (insert (format "  *group*\t%s: %s\n"
-				  (buffer-name elt)
-				  (ediff-abbrev-jobname job-name)))
-		  (insert (format "\t\t   %s   %s   %s\n"
-				  (ediff-abbreviate-file-name
-				   (ediff-get-group-objA meta-list))
-				  (ediff-abbreviate-file-name
-				   (if (stringp
-					(ediff-get-group-objB meta-list))
-				       (ediff-get-group-objB meta-list)
-				       ""))
-				  (ediff-abbreviate-file-name
-				   (if (stringp
-					(ediff-get-group-objC meta-list))
-				       (ediff-get-group-objC meta-list)
-				       ""))))
-		  (ediff-set-meta-overlay pt (point) elt))
-	      (progn
-		(ediff-eval-in-buffer elt
-		  (setq bufAname (if (ediff-buffer-live-p ediff-buffer-A)
-				     (buffer-name ediff-buffer-A)
-				   "!!!killed buffer!!!")
-			bufBname (if (ediff-buffer-live-p ediff-buffer-B)
-				     (buffer-name ediff-buffer-B)
-				   "!!!killed buffer!!!")
-			bufCname (cond ((not (ediff-3way-job))
-					"")
-				       ((ediff-buffer-live-p ediff-buffer-C)
-					(buffer-name ediff-buffer-C))
-				       (t "!!!killed buffer!!!")))
-		  (setq total-diffs (format "%-4d" ediff-number-of-differences)
-			cur-diff
-			(cond ((= ediff-current-difference -1) "   _")
-			      ((= ediff-current-difference
-				  ediff-number-of-differences)
-			       "   $")
-			      (t (format
-				  "%4d" (1+ ediff-current-difference))))
-			job-name ediff-job-name))
-		;; back in the meta buf
-		(setq pt (point))
-		(insert cur-diff "/" total-diffs "\t"
-			(buffer-name elt)
-			(format ": %s" 	(ediff-abbrev-jobname job-name)))
-		(insert
-		 "\n\t\t   " bufAname "   " bufBname "   " bufCname "\n")
-		(ediff-set-meta-overlay pt (point) elt))))
-	) ; while
-      (set-buffer-modified-p nil)
-      (goto-char point)
-      )))
-
-;; sets overlay around a meta record with 'ediff-meta-info property PROP
-(defun ediff-set-meta-overlay (b e prop)
-  (let (overl)
-    (setq overl (ediff-make-overlay b e))
-    (if ediff-emacs-p
-	(ediff-overlay-put overl 'mouse-face 'highlight)
-      (ediff-overlay-put overl 'highlight t))
-    (ediff-overlay-put overl 'ediff-meta-info prop)))
-
-(defun ediff-mark-for-hiding (unmark)
-  "Mark session for hiding. With prefix arg, unmark."
-  (interactive "P")
-  (let* ((pos (ediff-event-point last-command-event))
-	 (meta-buf (ediff-event-buffer last-command-event))
-	 ;; ediff-get-meta-info gives error if meta-buf or pos are invalid
-	 (info (ediff-get-meta-info meta-buf pos))
-	 (session-buf (ediff-get-session-buffer info)))
-
-    (if (eq (ediff-get-session-status info) ?H)
-	(setq unmark t))
-    (if unmark
-	(ediff-set-session-status info nil)
-      (if (ediff-buffer-live-p session-buf)
-	  (error "Can't hide active session, %s" (buffer-name session-buf)))
-      (ediff-set-session-status info ?H))
-    (or unmark
-	(ediff-next-meta-item 1))
-    (ediff-update-meta-buffer meta-buf)
-    ))
-
-(defun ediff-mark-for-operation (unmark)
-  "Mark session for a group operation. With prefix arg, unmark."
-  (interactive "P")
-  (let* ((pos (ediff-event-point last-command-event))
-	 (meta-buf (ediff-event-buffer last-command-event))
-	 ;; ediff-get-meta-info gives error if meta-buf or pos are invalid
-	 (info (ediff-get-meta-info meta-buf pos)))
-
-    (if (eq (ediff-get-session-status info) ?*)
-	(setq unmark t))
-    (if unmark
-	(ediff-set-session-status info nil)
-      (ediff-set-session-status info ?*))
-    (or unmark
-	(ediff-next-meta-item 1))
-    (ediff-update-meta-buffer meta-buf)
-    ))
-
-(defun ediff-hide-marked-sessions (unhide)
-  "Hide marked sessions. With prefix arg, unhide."
-  (interactive "P")
-  (let ((grp-buf (ediff-get-group-buffer ediff-meta-list))
-	(meta-list (cdr ediff-meta-list))
-	(from (if unhide ?I ?H))
-	(to (if unhide ?H ?I))
-	(numMarked 0)
-	active-sessions-exist session-buf elt)
-    (while meta-list
-      (setq elt (car meta-list)
-	    meta-list (cdr meta-list)
-	    session-buf (ediff-get-session-buffer elt))
-
-      (if (eq (ediff-get-session-status elt) from)
-	  (progn
-	    (setq numMarked (1+ numMarked))
-	    (if (and (eq to ?I) (buffer-live-p session-buf))
-		;; shouldn't hide active sessions
-		(setq active-sessions-exist t)
-	      (ediff-set-session-status elt to)))))
-    (if (> numMarked 0)
-	(ediff-update-meta-buffer grp-buf)
-      (beep)
-      (if unhide
-	  (message "Nothing to reveal...")
-	(message "Nothing to hide...")))
-    (if active-sessions-exist
-	(message "Note: didn't hide active sessions!"))
-    ))
-
-;; Apply OPERATION to marked sessions. Operation expects one argument of type
-;; meta-list member (not the first one), i.e., a regular session description.
-;; Returns number of marked sessions on which operation was performed
-(defun ediff-operate-on-marked-sessions (operation)
-  (let ((grp-buf (ediff-get-group-buffer ediff-meta-list))
-	(meta-list (cdr ediff-meta-list))
-	(marksym ?*)
-	(numMarked 0)
-	(sessionNum 0)
-	elt)
-    (while meta-list
-      (setq elt (car meta-list)
-	    meta-list (cdr meta-list)
-	    sessionNum (1+ sessionNum))
-      (if (eq (ediff-get-session-status elt) marksym)
-	  (save-excursion
-	    (setq numMarked (1+ numMarked))
-	    (funcall operation elt sessionNum))))
-    (ediff-update-meta-buffer grp-buf) ; just in case
-    numMarked
-    ))
-
-(defun ediff-append-custom-diff (session sessionNum)
-  (or (ediff-collect-diffs-metajob)
-      (error "Sorry, I don't do this for everyone..."))
-  (let ((session-buf (ediff-get-session-buffer session))
-	(meta-diff-buff ediff-meta-diff-buffer)
-	(metajob ediff-metajob-name)
-	tmp-buf custom-diff-buf)
-    (if (ediff-buffer-live-p session-buf)
-	(ediff-eval-in-buffer session-buf
-	  (if (eq ediff-control-buffer session-buf) ; individual session
-	      (progn
-		(ediff-compute-custom-diffs-maybe)
-		(setq custom-diff-buf ediff-custom-diff-buffer)))))
-
-    (or (ediff-buffer-live-p meta-diff-buff)
-	(error "Ediff: something wrong--no multiple diffs buffer"))
-
-    (cond ((ediff-buffer-live-p custom-diff-buf)
-	   (save-excursion
-	     (set-buffer meta-diff-buff)
-	     (goto-char (point-max))
-	     (insert-buffer custom-diff-buf)
-	     (insert "\n")))
-	  ((memq metajob '(ediff-directories 
-			   ediff-merge-directories
-			   ediff-merge-directories-with-ancestor))
-	   ;; get diffs by calling shell command on ediff-custom-diff-program
-	   (save-excursion
-	     (set-buffer (setq tmp-buf (get-buffer-create ediff-tmp-buffer)))
-	     (erase-buffer)
-	     (shell-command
-	      (format "%s %s %s %s"
-		      ediff-custom-diff-program ediff-custom-diff-options
-		      (ediff-get-session-objA-name session)
-		      (ediff-get-session-objB-name session))
-	      t))
-	   (save-excursion
-	     (set-buffer meta-diff-buff)
-	     (goto-char (point-max))
-	     (insert-buffer tmp-buf)
-	     (insert "\n")))
-	  (t
-	   (error "Can't make context diff for Session %d" sessionNum )))
-    ))
-
-(defun ediff-collect-custom-diffs ()
-  "Collect custom diffs of marked sessions in buffer `*Ediff Multifile Diffs*'.
-This operation is defined only for `ediff-directories' and
-`ediff-directory-revisions', since its intent is to produce
-multifile patches. For `ediff-directory-revisions', we insist that
-all marked sessions must be active."
-  (interactive)
-  (or (ediff-buffer-live-p ediff-meta-diff-buffer)
-      (setq ediff-meta-diff-buffer
-	    (get-buffer-create
-	     (ediff-unique-buffer-name "*Ediff Multifile Diffs" "*"))))
-  (ediff-eval-in-buffer ediff-meta-diff-buffer
-    (erase-buffer))
-  (if (> (ediff-operate-on-marked-sessions 'ediff-append-custom-diff) 0)
-      ;; did something
-      (display-buffer ediff-meta-diff-buffer 'not-this-window)
-    (beep)
-    (message "No marked sessions found")))
-
-(defun ediff-meta-show-patch ()
-  "Show the multi-file patch associated with this group session."
-  (interactive)
-  (let* ((pos (ediff-event-point last-command-event))
-	 (meta-buf (ediff-event-buffer last-command-event))
-	 (info (ediff-get-meta-info meta-buf pos 'noerror))
-	 (patchbuffer ediff-meta-patchbufer))
-    (if (ediff-buffer-live-p patchbuffer)
-	(ediff-eval-in-buffer patchbuffer
-	  (save-restriction
-	    (if (not info)
-		(widen)
-	      (narrow-to-region
-	       (ediff-get-session-objB-name info)
-	       (ediff-get-session-objC-name info)))
-	    (set-buffer (get-buffer-create ediff-tmp-buffer))
-	    (erase-buffer)
-	    (insert-buffer patchbuffer)
-	    (display-buffer ediff-tmp-buffer 'not-this-window)
-	    ))
-      (error "The patch buffer wasn't found"))))
-
-	      
-;; This function executes in meta buffer. It knows where event happened.
-(defun ediff-filegroup-action ()
-  "Execute appropriate action for the selected session."
-  (interactive)
-  (let* ((pos (ediff-event-point last-command-event))
-	 (meta-buf (ediff-event-buffer last-command-event))
-	 ;; ediff-get-meta-info gives error if meta-buf or pos are invalid
-	 (info (ediff-get-meta-info meta-buf pos))
-	 merge-autostore-dir
-	 session-buf file1 file2 file3 regexp)
-
-    (setq session-buf (ediff-get-session-buffer info)
-	  file1 (ediff-get-session-objA-name info)
-	  file2 (ediff-get-session-objB-name info)
-	  file3 (ediff-get-session-objC-name info))
-
-    ;; make sure we don't start on hidden sessions
-    ;; ?H means marked for hiding. ?I means invalid (hidden).
-    (if (memq (ediff-get-session-status info) '(?I))
-	(progn
-	  (beep)
-	  (if (y-or-n-p "This session is marked as hidden, unmark? ")
-	      (progn
-		(ediff-set-session-status info nil)
-		(ediff-update-meta-buffer meta-buf))
-	    (error "Aborted"))))
-
-    (ediff-eval-in-buffer meta-buf
-      (setq merge-autostore-dir
-	    (ediff-get-group-merge-autostore-dir ediff-meta-list))
-      (goto-char pos) ; if the user clicked on session--move point there
-      ;; First handle sessions involving directories (which are themselves
-      ;; session groups)
-      ;; After that handle individual sessions
-      (cond ((and (file-directory-p file1) 
-		  (stringp file2) (file-directory-p file2)
-		  (if (stringp file3) (file-directory-p file1) t))
-	     ;; do ediff/ediff-merge on subdirectories
-	     (if (ediff-buffer-live-p session-buf)
-		 (ediff-show-meta-buffer session-buf)
-	       (setq regexp (read-string "Filter through regular expression: " 
-					 nil 'ediff-filtering-regexp-history))
-	       (ediff-directories-internal
-		file1 file2 file3 regexp
-		ediff-session-action-function
-		ediff-metajob-name 
-		;; make it update car info after startup
-		(` (list (lambda () 
-			   ;; child session group should know its parent
-			   (setq ediff-parent-meta-buffer
-				 (quote (, ediff-meta-buffer)))
-			   ;; and parent will know its child
-			   (setcar (quote (, info)) ediff-meta-buffer)))))))
-
-	    ;; Do ediff-revision on a subdirectory
-	    ((and (ediff-one-filegroup-metajob)
-		  (ediff-revision-metajob)
-		  (file-directory-p file1))
-	     (if (ediff-buffer-live-p session-buf)
-		 (ediff-show-meta-buffer session-buf)
-	       (setq regexp (read-string "Filter through regular expression: " 
-					 nil 'ediff-filtering-regexp-history))
-	       (ediff-directory-revisions-internal
-		file1 regexp
-		ediff-session-action-function ediff-metajob-name
-		;; make it update car info after startup
-		(` (list (lambda () 
-			   ;; child session group should know its parent
-			   (setq ediff-parent-meta-buffer
-				 (quote (, ediff-meta-buffer)))
-			   ;; and parent will know its child
-			   (setcar (quote (, info)) ediff-meta-buffer)))))))
-
-	    ;; From here on---only individual session handlers
-
-	    ;; handle an individual session with a live control buffer
-	    ((ediff-buffer-live-p session-buf)
-	     (ediff-eval-in-buffer session-buf
-	       (setq ediff-mouse-pixel-position (mouse-pixel-position))
-	       (ediff-recenter 'no-rehighlight)))
-
-	    ((ediff-problematic-session-p info)
-	     (beep)
-	     (if (y-or-n-p
-		  "This session has no ancestor. Merge without the ancestor? ")
-		 (ediff-merge-files
-		  file1 file2
-		  ;; provide startup hooks 
-		  (` (list (lambda () 
-			     (setq ediff-meta-buffer (, (current-buffer)))
-			     (setq ediff-merge-store-file
-				   (, (concat
-				       merge-autostore-dir
-				       "mrg_"
-				       (file-name-nondirectory file1))))
-			     ;; make ediff-startup pass
-			     ;; ediff-control-buffer back to the meta
-			     ;; level; see below
-			     (setcar
-			      (quote (, info)) ediff-control-buffer)))))
-	       (error "Aborted")))
-	    ((ediff-one-filegroup-metajob) 	; needs 1 file arg
-	     (funcall ediff-session-action-function
-		      file1
-		      ;; provide startup hooks 
-		      (` (list (lambda () 
-				 (setq ediff-meta-buffer (, (current-buffer)))
-				 (setq ediff-merge-store-file
-				       (, (concat
-					   merge-autostore-dir
-					   "mrg_"
-					   (file-name-nondirectory file1))))
-				 ;; make ediff-startup pass
-				 ;; ediff-control-buffer back to the meta
-				 ;; level; see below
-				 (setcar
-				  (quote (, info)) ediff-control-buffer))))))
-	    ((not (ediff-metajob3))      ; need 2 file args
-	     (funcall ediff-session-action-function
-		      file1 file2
-		      ;; provide startup hooks 
-		      (` (list (lambda () 
-				 (setq ediff-meta-buffer (, (current-buffer)))
-				 (setq ediff-merge-store-file
-				       (, (concat
-					   merge-autostore-dir
-					   "mrg_"
-					   (file-name-nondirectory file1))))
-				 ;; make ediff-startup pass
-				 ;; ediff-control-buffer back to the meta
-				 ;; level; see below
-				 (setcar
-				  (quote (, info)) ediff-control-buffer))))))
-	    ((ediff-metajob3)      ; need 3 file args
-	     (funcall ediff-session-action-function
-		      file1 file2 file3
-		      ;; arrange startup hooks 
-		      (` (list (lambda () 
-				 (setq ediff-merge-store-file
-				       (, (concat
-					   merge-autostore-dir
-					   "mrg_"
-					   (file-name-nondirectory file1))))
-				 (setq ediff-meta-buffer (, (current-buffer)))
-				 ;; this arranges that ediff-startup will pass
-				 ;; the value of ediff-control-buffer back to
-				 ;; the meta level, to the record in the meta
-				 ;; list containing the information about the
-				 ;; session associated with that
-				 ;; ediff-control-buffer
-				 (setcar
-				  (quote (, info)) ediff-control-buffer))))))
-	    ) ; cond
-      ) ; eval in meta-buf
-    ))
-
-(defun ediff-registry-action ()
-  "Switch to a selected session."
-  (interactive)
-  (let* ((pos (ediff-event-point last-command-event))
-	 (buf (ediff-event-buffer last-command-event))
-	 (ctl-buf (ediff-get-meta-info buf pos)))
-
-    (if (ediff-buffer-live-p ctl-buf)
-	;; check if this is ediff-control-buffer or ediff-meta-buffer
-	(if (ediff-eval-in-buffer ctl-buf
-	      (eq (key-binding "q") 'ediff-quit-meta-buffer))
-	    ;; it's a meta-buffer -- last action should just display it
-	    (ediff-show-meta-buffer ctl-buf)
-	  ;; it's a session buffer -- invoke go back to session
-	  (ediff-eval-in-buffer ctl-buf
-	    (setq ediff-mouse-pixel-position (mouse-pixel-position))
-	    (ediff-recenter 'no-rehighlight)))
-      (beep)
-      (message "You've selected a stale session --- try again")
-      (ediff-update-registry))
-    (ediff-eval-in-buffer buf
-      (goto-char pos))
-    ))
-
-
-(defun ediff-show-meta-buffer (&optional meta-buf)
-  "Show the session group buffer."
-  (interactive)
-  (let (wind frame silent)
-    (if meta-buf (setq silent t))
-
-    (setq meta-buf (or meta-buf ediff-meta-buffer))
-    (cond ((not (bufferp meta-buf))
-	   (error "This Ediff session is not part of a session group"))
-	  ((not (ediff-buffer-live-p meta-buf))
-	   (error
-	    "Can't find this session's group panel -- session itself is ok")))
-
-    (ediff-cleanup-meta-buffer meta-buf)
-    (ediff-eval-in-buffer meta-buf
-      (save-excursion
-	(cond ((setq wind (ediff-get-visible-buffer-window meta-buf))
-	       (or silent
-		   (message
-		    "Already showing the group panel for this session"))
-	       (set-window-buffer wind meta-buf)
-	       (select-window wind))
-	      ((window-live-p (setq wind ediff-window-C)) ;in merge--merge buf
-	       (set-window-buffer ediff-window-C meta-buf)
-	       (select-window wind))
-	      ((window-live-p (setq wind ediff-window-A))
-	       (set-window-buffer ediff-window-A meta-buf)
-	       (select-window wind))
-	      ((window-live-p (setq wind ediff-window-B))
-	       (set-window-buffer ediff-window-B meta-buf)
-	       (select-window wind))
-	      ((and
-		(setq wind
-		      (ediff-get-visible-buffer-window ediff-registry-buffer))
-		(ediff-window-display-p))
-	       (select-window wind)
-	       (other-window 1)
-	       (set-window-buffer (selected-window) meta-buf))
-	      (t (ediff-skip-unsuitable-frames 'ok-unsplittable)
-		 (set-window-buffer (selected-window) meta-buf)))
-	))
-    (if (and (ediff-window-display-p)
-	     (window-live-p 
-	      (setq wind (ediff-get-visible-buffer-window meta-buf))))
-	(progn
-	  (setq frame (window-frame wind))
-	  (raise-frame frame)
-	  (ediff-reset-mouse frame)))
-    (run-hooks 'ediff-show-session-group-hook)
-    ))
-
-(defun ediff-show-meta-buff-from-registry ()
-  "Display the session group buffer for a selected session group."
-  (interactive)
-  (let* ((pos (ediff-event-point last-command-event))
-	 (meta-buf (ediff-event-buffer last-command-event))
-	 (info (ediff-get-meta-info meta-buf pos))
-	 (meta-or-session-buf info))
-    (ediff-eval-in-buffer meta-or-session-buf
-      (ediff-show-meta-buffer))))
-
-;;;###autoload
-(defun ediff-show-registry ()
-  "Display Ediff's registry."
-  (interactive)
-  (ediff-update-registry)
-  (if (not (ediff-buffer-live-p ediff-registry-buffer))
-      (error "No active Ediff sessions or corrupted session registry"))
-  (let (wind frame)
-    ;; for some reason, point moves in ediff-registry-buffer, so we preserve it
-    ;; explicitly
-    (ediff-eval-in-buffer ediff-registry-buffer
-      (save-excursion
-	(cond  ((setq wind
-		      (ediff-get-visible-buffer-window ediff-registry-buffer))
-		(message "Already showing the registry")
-		(set-window-buffer wind ediff-registry-buffer)
-		(select-window wind))
-	       ((window-live-p ediff-window-C)
-		(set-window-buffer ediff-window-C ediff-registry-buffer)
-		(select-window ediff-window-C))
-	       ((window-live-p ediff-window-A)
-		(set-window-buffer ediff-window-A ediff-registry-buffer)
-		(select-window ediff-window-A))
-	       ((window-live-p ediff-window-B)
-		(set-window-buffer ediff-window-B ediff-registry-buffer)
-		(select-window ediff-window-B))
-	       ((and (setq wind
-			   (ediff-get-visible-buffer-window ediff-meta-buffer))
-		     (ediff-window-display-p))
-		(select-window wind)
-		(other-window 1)
-		(set-window-buffer (selected-window) ediff-registry-buffer))
-	       (t (ediff-skip-unsuitable-frames 'ok-unsplittable)
-		  (set-window-buffer (selected-window) ediff-registry-buffer)))
-	))
-    (if (ediff-window-display-p)
-	(progn
-	  (setq frame 
-		(window-frame
-		 (ediff-get-visible-buffer-window ediff-registry-buffer)))
-	  (raise-frame frame)
-	  (ediff-reset-mouse frame)))
-    (run-hooks 'ediff-show-registry-hook)
-    ))
-
-;;;###autoload
-(defalias 'eregistry 'ediff-show-registry)
-
-;; If meta-buf doesn't exist, it is created. In that case, id doesn't have a
-;; parent meta-buf
-;; Check if META-BUF exists before calling this function
-(defun ediff-update-meta-buffer (meta-buf)
-  (ediff-eval-in-buffer (current-buffer)
-    (if (ediff-buffer-live-p meta-buf)
-	(ediff-eval-in-buffer meta-buf
-	  (funcall ediff-meta-redraw-function ediff-meta-list))
-      )))
-
-(defun ediff-update-registry ()
-  (ediff-eval-in-buffer (current-buffer)
-    (if (ediff-buffer-live-p ediff-registry-buffer)
-	(ediff-redraw-registry-buffer)
-      (ediff-prepare-meta-buffer 
-       'ediff-registry-action
-       ediff-session-registry
-       "*Ediff Registry"
-       'ediff-redraw-registry-buffer
-       'ediff-registry))
-    ))
-
-;; If meta-buf exists, it is redrawn along with parent. 
-;; Otherwise, nothing happens.
-(defun ediff-cleanup-meta-buffer (meta-buffer)
-  (if (ediff-buffer-live-p meta-buffer)
-      (ediff-eval-in-buffer meta-buffer
-	(ediff-update-meta-buffer meta-buffer)
-	(if (ediff-buffer-live-p ediff-parent-meta-buffer)
-	    (ediff-update-meta-buffer ediff-parent-meta-buffer)))))
-
-;; t if no session in progress
-(defun ediff-safe-to-quit (meta-buffer)
-  (if (ediff-buffer-live-p meta-buffer)
-      (let ((lis ediff-meta-list)
-	    (cont t)
-	    buffer-read-only)
-	(ediff-update-meta-buffer meta-buffer)
-	(ediff-eval-in-buffer meta-buffer
-	  (setq lis (cdr lis)) ; discard the description part of meta-list
-	  (while (and cont lis)
-	    (if (ediff-buffer-live-p
-		 (ediff-get-group-buffer lis)) ; in progress
-		(setq cont nil))
-	    (setq lis (cdr lis)))
-	  cont))))
-
-(defun ediff-quit-meta-buffer ()
-  "If the group has no active session, delete the meta buffer.
-If no session is in progress, ask to confirm before deleting meta buffer.
-Otherwise, bury the meta buffer.
-If this is a session registry buffer then just bury it."
-  (interactive)
-  (let* ((buf (current-buffer))
-	 (dir-diffs-buffer ediff-dir-diffs-buffer)
-	 (meta-diff-buffer ediff-meta-diff-buffer)
-	 (parent-buf ediff-parent-meta-buffer)
-	 (dont-show-registry (eq buf ediff-registry-buffer)))
-    (if dont-show-registry
-	(bury-buffer)
-      (ediff-cleanup-meta-buffer buf)
-      (cond ((and (ediff-safe-to-quit buf)
-		  (y-or-n-p "Quit this session group? "))
-	     (run-hooks 'ediff-quit-session-group-hook)
-	     (message "")
-	     (ediff-dispose-of-meta-buffer buf))
-	    ((ediff-safe-to-quit buf)
-	     (bury-buffer))
-	    (t
-	     (error
-	      "This session group has active sessions---cannot exit")))
-      (ediff-cleanup-meta-buffer parent-buf)
-      (ediff-kill-buffer-carefully dir-diffs-buffer)
-      (ediff-kill-buffer-carefully meta-diff-buffer)
-      (if (ediff-buffer-live-p parent-buf)
-	  (progn
-	    (setq dont-show-registry t)
-	    (ediff-show-meta-buffer parent-buf)))
-      )
-    (or dont-show-registry
-	(ediff-show-registry))))
-
-(defun ediff-dispose-of-meta-buffer (buf)
-  (setq ediff-session-registry (delq buf ediff-session-registry))
-  (ediff-eval-in-buffer buf
-    (if (ediff-buffer-live-p ediff-dir-diffs-buffer)
-	(kill-buffer ediff-dir-diffs-buffer)))
-  (kill-buffer buf))
-    
-
-;; Obtain information on a meta record where the user clicked or typed
-;; BUF is the buffer where this happened and POINT is the position
-;; If optional NOERROR arg is given, don't report error and return nil if no
-;; meta info is found on line.
-(defun ediff-get-meta-info (buf point &optional noerror)
-  (let (result olist tmp)
-    (if (and point (ediff-buffer-live-p buf))
-	(ediff-eval-in-buffer buf
-	  (if ediff-xemacs-p
-	      (setq result
-		    (if (setq tmp (extent-at point buf 'ediff-meta-info))
-			(ediff-overlay-get tmp 'ediff-meta-info)))
-	    (setq olist (overlays-at point))
-	    (setq olist
-		  (mapcar (function (lambda (elt)
-				      (overlay-get elt 'ediff-meta-info)))
-			  olist))
-	    (while (and olist (null (car olist))
-			(overlay-get (car olist) 'invisible))
-	      (setq olist (cdr olist)))
-	    (setq result (car olist)))))
-    (if result
-	result
-      (if noerror
-	  nil
-	(ediff-update-registry)
-	(error "No session info in this line")))))
-
-;; return location of the next meta overlay after point
-(defun ediff-next-meta-overlay-start (point)
-  (if (eobp)
-      (goto-char (point-min))
-    (let (overl)
-      (if ediff-xemacs-p
-	  (progn
-	    (setq overl (extent-at point (current-buffer) 'ediff-meta-info))
-	    (if overl
-		(setq overl (next-extent overl))
-	      (setq overl (next-extent (current-buffer))))
-	    (if overl
-		(extent-start-position overl)
-	      (point-max)))
-	(setq overl (car (overlays-at point)))
-	(if (and overl (overlay-get overl 'ediff-meta-info))
-	    ;; note: end of current overlay is the beginning of the next one
-	    (overlay-end overl)
-	  (next-overlay-change point))))
-    ))
-
-(defun ediff-previous-meta-overlay-start (point)
-  (if (bobp)
-      (goto-char (point-max))
-    (let (overl)
-      (if ediff-xemacs-p
-	  (progn
-	    (setq overl (extent-at point (current-buffer) 'ediff-meta-info))
-	    (if overl
-		(setq overl (previous-extent overl))
-	      (setq overl (previous-extent (current-buffer))))
-	    (if overl
-		(extent-start-position overl)
-	      (point-min)))
-	(setq overl (car (overlays-at point)))
-	(if (and overl (overlay-get overl 'ediff-meta-info))
-	    (setq point (overlay-start overl)))
-	;; to get to the beginning of prev overlay
-	(if (not (bobp))
-	    ;; trickery to overcome an emacs bug--doesn't always find previous
-	    ;; overlay change correctly
-	    (setq point (1- point)))
-	(setq point (previous-overlay-change point))
-	;; If we are not over an overlay after subtracting 1, it means we are
-	;; in the description area preceding session records. In this case,
-	;; goto the top of the registry buffer.
-	(or (car (overlays-at point))
-	    (setq point (point-min)))
-	point
-	))))
-
-;; this is the action invoked when the user selects a patch from the meta
-;; buffer.
-(defun ediff-patch-file-form-meta (file &optional startup-hooks)
-  (let* ((pos (ediff-event-point last-command-event))
-	 (meta-buf (ediff-event-buffer last-command-event))
-	 ;; ediff-get-meta-info gives error if meta-buf or pos are invalid
-	 (info (ediff-get-meta-info meta-buf pos))
-	 (meta-patchbuf ediff-meta-patchbufer)
-	 session-buf beg-marker end-marker)
-
-    (if (or (file-directory-p file) (string-match "/dev/null" file))
-	(error "`%s' is not an ordinary file" (file-name-as-directory file)))
-    (setq session-buf (ediff-get-session-buffer info)
-	  beg-marker (ediff-get-session-objB-name info)
-	  end-marker (ediff-get-session-objC-name info))
-
-    (or (ediff-buffer-live-p session-buf) ; either an active patch session
-	(null session-buf)  		  ; or it is a virgin session
-	(error
-	 "Patch has been already applied to this file--cannot be repeated!"))
-
-    (ediff-eval-in-buffer meta-patchbuf
-      (save-restriction
-	(widen)
-	(narrow-to-region beg-marker end-marker)
-	(ediff-patch-file-internal meta-patchbuf file startup-hooks)))))
-
-
-(defun ediff-meta-mark-equal-files ()
-  "Run though the session list and mark identical files.
-This is used only for sessions that involve 2 or 3 files at the same time."
-  (interactive)
-  (let ((list (cdr ediff-meta-list))
-	fileinfo1 fileinfo2 fileinfo3 elt)
-    (while (setq elt (car list))
-      (setq fileinfo1 (ediff-get-session-objA elt)
-	    fileinfo2 (ediff-get-session-objB elt)
-	    fileinfo3 (ediff-get-session-objC elt))
-      (ediff-set-file-eqstatus fileinfo1 nil)
-      (ediff-set-file-eqstatus fileinfo2 nil)
-      (ediff-set-file-eqstatus fileinfo3 nil)
-
-      (ediff-mark-if-equal fileinfo1 fileinfo2)
-      (if (ediff-metajob3)
-	  (progn
-	    (ediff-mark-if-equal fileinfo1 fileinfo3)
-	    (ediff-mark-if-equal fileinfo2 fileinfo3)))
-      (setq list (cdr list))))
-  (ediff-update-meta-buffer (current-buffer)))
-
-;; mark files 1 and 2 as equal, if they are.
-(defun ediff-mark-if-equal (fileinfo1 fileinfo2)
-  (get-buffer-create ediff-tmp-buffer)
-  (or (file-directory-p (car fileinfo1))
-      (file-directory-p (car fileinfo2))
-      (if (= (ediff-make-diff2-buffer
-	      ediff-tmp-buffer (car fileinfo1) (car fileinfo2))
-	     0)
-	  (progn
-	    (ediff-set-file-eqstatus fileinfo1 t)
-	    (ediff-set-file-eqstatus fileinfo2 t)))))
-
-
-
-;;; Local Variables:
-;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
-;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
-;;; End:
-
-(provide 'ediff-mult)
-(require 'ediff-util)
-
-;;; ediff-mult.el ends here
diff --git a/lisp/ediff-ptch.el b/lisp/ediff-ptch.el
deleted file mode 100644
index 309316d721e..00000000000
--- a/lisp/ediff-ptch.el
+++ /dev/null
@@ -1,630 +0,0 @@
-;;; ediff-ptch.el --- Ediff's  patch support
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; 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.
-
-
-;;; Code:
-
-(require 'ediff-init)
-
-(defvar ediff-last-dir-patch nil
-  "Last directory used by an Ediff command for file to patch.")
-
-(defvar ediff-backup-extension 
-  (if (memq system-type '(vax-vms axp-vms emx ms-dos windows-nt windows-95))
-      "_orig" ".orig")
-  "Backup extension used by the patch program.
-See also `ediff-backup-specs'.")
-
-(defvar ediff-backup-specs (format "-b %s" ediff-backup-extension)
-  "*Backup directives to pass to the patch program.
-Ediff requires that the old version of the file \(before applying the patch\)
-is saved in a file named `the-patch-file.extension'. Usually `extension' is
-`.orig', but this can be changed by the user and may depend on the system.
-Therefore, Ediff needs to know the backup extension used by the patch program.
-
-Some versions of the patch program let you specify `-b backup-extension'.
-Other versions only permit `-b', which assumes some canned extension 
- \(usually `.orig'\).
-
-Note that both `ediff-backup-extension' and `ediff-backup-specs'
-must be properly set. If your patch program takes the option `-b',
-but not `-b extension', the variable `ediff-backup-extension' must
-still be set so Ediff will know which extension to use.")
-
-
-(defvar ediff-patch-default-directory nil
-  "*Default directory to look for patches.")
-
-(defvar ediff-context-diff-label-regexp
-  (concat "\\(" 	; context diff 2-liner
-	  "^\\*\\*\\* \\([^ \t]+\\)[^*]+[\t ]*\n--- \\([^ \t]+\\)"
-	  "\\|" 	; GNU unified format diff 2-liner
-	  "^--- \\([^ \t]+\\)[\t ]+.*\n\\+\\+\\+ \\([^ \t]+\\)"
-	  "\\)")
-  "*Regexp matching filename 2-liners at the start of each context diff.")
-
-(defvar ediff-patch-program "patch"
-  "*Name of the program that applies patches.
-It is recommended to use GNU-compatible versions.")
-(defvar ediff-patch-options "-f"
-  "*Options to pass to ediff-patch-program.
-
-Note: the `-b' option should be specified in `ediff-backup-specs'.
-
-It is recommended to pass the `-f' option to the patch program, so it won't ask
-questions. However, some implementations don't accept this option, in which
-case the default value for this variable should be changed.")
-
-;; The buffer of the patch file. Local to control buffer.
-(ediff-defvar-local ediff-patchbufer nil "")
-
-;; The buffer where patch displays its diagnostics.
-(ediff-defvar-local ediff-patch-diagnostics nil "")
-
-;; Map of patch buffer. Has the form:
-;;    ((filename1 marker1 marker2) (filename2 marker1 marker2) ...)
-;; where filenames are files to which patch would have applied the patch;
-;; marker1 delimits the beginning of the corresponding patch and marker2 does
-;; it for the end.
-(ediff-defvar-local ediff-patch-map nil "")
-
-;; strip prefix from filename
-;; returns /dev/null, if can't strip prefix
-(defsubst ediff-file-name-sans-prefix (filename prefix)
-  (save-match-data
-    (if (string-match (concat "^" prefix) filename)
-	(substring filename (match-end 0))
-      (concat "/null/" filename))))
-
-
-
-;; no longer used
-;; return the number of matches of regexp in buf starting from the beginning
-(defun ediff-count-matches (regexp buf)
-  (ediff-eval-in-buffer buf
-    (let ((count 0) opoint)
-      (save-excursion
-	(goto-char (point-min))
-	(while (and (not (eobp))
-		    (progn (setq opoint (point))
-			   (re-search-forward regexp nil t)))
-	  (if (= opoint (point))
-	      (forward-char 1)
-	    (setq count (1+ count)))))
-      count)))
-
-;; Scan BUF (which is supposed to contain a patch) and make a list of the form 
-;;    ((filename1 marker1 marker2) (filename2 marker1 marker2) ...)
-;; where filenames are files to which patch would have applied the patch;
-;; marker1 delimits the beginning of the corresponding patch and marker2 does
-;; it for the end. This list is then assigned to ediff-patch-map.
-;; Returns the number of elements in the list ediff-patch-map
-(defun ediff-map-patch-buffer (buf)
-  (ediff-eval-in-buffer buf
-    (let ((count 0)
-	  (mark1 (move-marker (make-marker) (point-min)))
-	  (mark1-end (point-min))
-	  (possible-file-names '("/dev/null" . "/dev/null"))
-	  mark2-end mark2 filenames
-	  beg1 beg2 end1 end2
-	  patch-map opoint)
-      (save-excursion
-	(goto-char (point-min))
-	(setq opoint (point))
-	(while (and (not (eobp))
-		    (re-search-forward ediff-context-diff-label-regexp nil t))
-	  (if (= opoint (point))
-	      (forward-char 1) ; ensure progress towards the end
-	    (setq mark2 (move-marker (make-marker) (match-beginning 0))
-		  mark2-end (match-end 0)
-		  beg1 (or (match-beginning 2) (match-beginning 4))
- 		  end1 (or (match-end 2) (match-end 4))
- 		  beg2 (or (match-beginning 3) (match-beginning 5))
- 		  end2 (or (match-end 3) (match-end 5)))
-	    ;; possible-file-names is holding the new file names until we
-	    ;; insert the old file name in the patch map
-	    ;; It is a pair (filename from 1st header line . fn from 2nd line)
-	    (setq possible-file-names
-		  (cons (if (and beg1 end1)
-			    (buffer-substring beg1 end1)
-			  "/dev/null")
-			(if (and beg2 end2)
-			    (buffer-substring beg2 end2)
-			  "/dev/null")))
-	    ;; check for any `Index:' or `Prereq:' lines, but don't use them
-	    (if (re-search-backward "^Index:" mark1-end 'noerror)
-		(move-marker mark2 (match-beginning 0)))
-	    (if (re-search-backward "^Prereq:" mark1-end 'noerror)
-		(move-marker mark2 (match-beginning 0)))
-
-	    (goto-char mark2-end)
-	    
-	    (if filenames
-		(setq patch-map (cons (list filenames mark1 mark2) patch-map)))
-	    (setq mark1 mark2
-		  mark1-end mark2-end
-		  filenames possible-file-names))
-	  (setq opoint (point)
-		count (1+ count))))
-      (setq mark2 (point-max-marker)
-	    patch-map (cons (list possible-file-names mark1 mark2) patch-map))
-      (setq ediff-patch-map (nreverse patch-map))
-      count)))
-
-;; Fix up the file names in the list using the argument FILENAME
-;; Algorithm: find the first file's directory and cut it out from each file
-;; name in the patch. Prepend the directory of FILENAME to each file in the
-;; patch. In addition, the first file in the patch is replaced by FILENAME.
-;; Each file is actually a file-pair of files found in the context diff header
-;; In the end, for each pair, we select the shortest existing file.
-;; Note: Ediff doesn't recognize multi-file patches that are separated
-;; with the `Index:' line. It treats them as a single-file patch.
-;;
-;; Executes inside the patch buffer
-(defun ediff-fixup-patch-map (filename)
-  (setq filename (expand-file-name filename))
-  (let ((actual-dir (if (file-directory-p filename)
-			;; directory part of filename
-			(file-name-as-directory filename)
-		      (file-name-directory filename)))
-	;; directory part of the first file in the patch
-	(base-dir1 (file-name-directory (car (car (car ediff-patch-map)))))
-	(base-dir2 (file-name-directory (cdr (car (car ediff-patch-map)))))
-	)
-
-    ;; chop off base-dirs
-    (mapcar (function (lambda (triple)
-			(or (string= (car (car triple)) "/dev/null")
-			    (setcar (car triple)
-				    (ediff-file-name-sans-prefix
-				     (car (car triple)) base-dir1)))
-			(or (string= (cdr (car triple)) "/dev/null")
-			    (setcdr (car triple)
-				    (ediff-file-name-sans-prefix
-				     (cdr (car triple)) base-dir2)))
-			))
-	    ediff-patch-map)
-
-    ;; take the given file name into account
-    (or (file-directory-p filename)
-	(string= "/dev/null" filename)
-	(progn
-	  (setcar (car ediff-patch-map)
-		  (cons (file-name-nondirectory filename)
-			(file-name-nondirectory filename)))))
-
-    ;; prepend actual-dir
-    (mapcar (function (lambda (triple)
-			 (if (and (string-match "^/null/" (car (car triple)))
-				  (string-match "^/null/" (cdr (car triple))))
-			     ;; couldn't strip base-dir1 and base-dir2
-			     ;; hence, something wrong
-			     (progn
-			       (with-output-to-temp-buffer ediff-msg-buffer
-				 (princ
-				  (format "
-The patch file contains a context diff for
-
-	%s
-	%s
-
-However, Ediff cannot infer the name of the actual file
-to be patched on your system. If you know the correct file name,
-please enter it now.
-
-If you don't know and still would like to apply patches to
-other files, enter /dev/null
-"
-					  (substring (car (car triple)) 6)
-					  (substring (cdr (car triple)) 6))))
-			       (let ((directory t)
-				     user-file)
-				 (while directory
-				   (setq user-file
-					 (read-file-name
-					  "Please enter file name: "
-					  actual-dir actual-dir t))
-				   (if (not (file-directory-p user-file))
-				       (setq directory nil)
-				     (setq directory t)
-				     (beep)
-				     (message "%s is a directory" user-file)
-				     (sit-for 2)))
-				 (setcar triple (cons user-file user-file))))
-			   (setcar (car triple)
-				   (expand-file-name 
-				    (concat actual-dir (car (car triple)))))
-			   (setcdr (car triple)
-				   (expand-file-name 
-				    (concat actual-dir (cdr (car triple))))))
-			 ))
-	    ediff-patch-map)
-    ;; check for the shorter existing file in each pair and discard the other
-    ;; one
-    (mapcar (function (lambda (triple)
-			(let* ((file1 (car (car triple)))
-			       (file2 (cdr (car triple)))
-			       (f1-exists (file-exists-p file1))
-			       (f2-exists (file-exists-p file2)))
-			  (cond
-			   ((and (< (length file2) (length file1))
-				 f2-exists)
-			    (setcar triple file2))
-			   ((and (< (length file1) (length file2))
-				 f1-exists)
-			    (setcar triple file1))
-			   ((and f1-exists f2-exists
-				 (string= file1 file2))
-			    (setcar triple file1))
-			   ((and f1-exists f2-exists)
-			    (with-output-to-temp-buffer ediff-msg-buffer
-			      (princ (format "
-Ediff has inferred that
-	%s
-	%s
-are possible targets for applying the patch.
-Both files seem to be plausible alternatives.
-
-Please advice:
-    Type `y' to use %s as the target;
-    Type `n' to use %s as the target.
-"
-					     file1 file2 file2 file1)))
-			    (setcar triple
-				    (if (y-or-n-p (format "Use %s ? " file2))
-					file2 file1)))
-			   (f2-exists (setcar triple file2))
-			   (f1-exists (setcar triple file1))
-			   (t
-			    (with-output-to-temp-buffer ediff-msg-buffer
-			      (princ (format "
-Ediff inferred that 
-	%s
-	%s
-are possible alternative targets for this patch.
-
-However, these files do not exist.
-
-Please enter an alternative patch target ... 
-"
-					     file1 file2)))
-			    (let ((directory t)
-				  target)
-			      (while directory
-				(setq target (read-file-name 
-					      "Please enter a patch target: "
-					      actual-dir actual-dir t))
-				(if (not (file-directory-p target))
-				    (setq directory nil)
-				  (beep)
-				  (message "%s is a directory" target)
-				  (sit-for 2)))
-			      (setcar triple target)))))))
-	    ediff-patch-map)
-    ))
-
-(defun ediff-show-patch-diagnostics ()
-  (interactive)
-  (cond ((window-live-p ediff-window-A)
-	 (set-window-buffer ediff-window-A ediff-patch-diagnostics))
-	((window-live-p ediff-window-B)
-	 (set-window-buffer ediff-window-B ediff-patch-diagnostics))
-	(t (display-buffer ediff-patch-diagnostics 'not-this-window))))
-
-(defun ediff-get-patch-buffer ()
-  "Obtain patch buffer.  If patch is already in a buffer---use it.
-Else, read patch file into a new buffer."
-  (let ((dir (cond (ediff-patch-default-directory) ; try patch default dir
-		   (ediff-use-last-dir ediff-last-dir-patch)
-		   (t default-directory)))
-	patch-buf)
-    (if (y-or-n-p "Is the patch already in a buffer? ")
-	(setq patch-buf
-	      (get-buffer
-	       (read-buffer
-		"Which buffer contains the patch? "
-		(current-buffer) 'must-match)))
-      (setq patch-buf
-	    (find-file-noselect
-	     (read-file-name "Which file contains the patch? "
-			     dir nil 'must-match))))
-    
-    (ediff-eval-in-buffer patch-buf
-      (goto-char (point-min))
-      (or (ediff-get-visible-buffer-window patch-buf)
-	  (progn
-	    (pop-to-buffer patch-buf 'other-window)
-	    (select-window (previous-window)))))
-    (ediff-map-patch-buffer patch-buf)
-    patch-buf))
-
-;; Dispatch the right patch file function: regular or meta-level,
-;; depending on how many patches are in the patch file.
-;; At present, there is no support for meta-level patches.
-;; Should return either the ctl buffer or the meta-buffer
-(defun ediff-dispatch-file-patching-job (patch-buf filename
-						   &optional startup-hooks)
-  (ediff-eval-in-buffer patch-buf
-    ;; relativize names in the patch with respect to source-file
-    (ediff-fixup-patch-map filename)
-    (if (< (length ediff-patch-map) 2)
-	(ediff-patch-file-internal
-	 patch-buf
-	 (if (and (not (string-match "^/dev/null" (car (car ediff-patch-map))))
-		  (> (length (car (car ediff-patch-map))) 1))
-	     (car (car ediff-patch-map))
-	   filename)
-	 startup-hooks)
-      (ediff-multi-patch-internal patch-buf startup-hooks))
-    ))
-
-
-(defun ediff-patch-buffer-internal (patch-buf buf-to-patch-name
-					      &optional startup-hooks)
-  (let* ((buf-to-patch (get-buffer buf-to-patch-name))
-	 (file-name-ok (if buf-to-patch (buffer-file-name  buf-to-patch)))
-	 (buf-mod-status (buffer-modified-p buf-to-patch))
-	 (multifile-patch-p (> (length (ediff-eval-in-buffer patch-buf
-					 ediff-patch-map)) 1))
-	 default-dir file-name ctl-buf)
-    (if file-name-ok
-	(setq file-name file-name-ok)
-      (if multifile-patch-p
-	  (error
-	   "Can't apply multi-file patches to buffers that visit no files"))
-      (ediff-eval-in-buffer buf-to-patch
-	(setq default-dir default-directory)
-	(setq file-name (ediff-make-temp-file buf-to-patch))
-	(set-visited-file-name file-name)
-	(setq buffer-auto-save-file-name nil) ; don't create auto-save file
-	;;don't confuse the user with a new bufname
-	(rename-buffer buf-to-patch-name)
-	(set-buffer-modified-p nil)
-	(set-visited-file-modtime) ; sync buffer and temp file
-	(setq default-directory default-dir)
-	))
-    
-    ;; dispatch a patch function
-    (setq ctl-buf (ediff-dispatch-file-patching-job
-		   patch-buf file-name startup-hooks))
-    
-    (if file-name-ok
-	()
-      ;; buffer wasn't visiting any file,
-      ;; so we will not run meta-level ediff here
-      (ediff-eval-in-buffer ctl-buf
-	(delete-file (buffer-file-name ediff-buffer-A))
-	(delete-file (buffer-file-name ediff-buffer-B))
-	(ediff-eval-in-buffer ediff-buffer-A
-	  (if default-dir (setq default-directory default-dir))
-	  (set-visited-file-name nil)
-	  (rename-buffer buf-to-patch-name)
-	  (set-buffer-modified-p buf-mod-status))
-	(ediff-eval-in-buffer ediff-buffer-B
-	  (setq buffer-auto-save-file-name nil) ; don't create auto-save file
-	  (if default-dir (setq default-directory default-dir))
-	  (set-visited-file-name nil)
-	  (rename-buffer (ediff-unique-buffer-name 
-			  (concat buf-to-patch-name "_patched") ""))
-	  (set-buffer-modified-p t))))
-    ))
-
-(defun ediff-patch-file-internal (patch-buf source-filename
-					    &optional startup-hooks)
-  (setq source-filename (expand-file-name source-filename))
-  
-  (let* ((shell-file-name ediff-shell)
-	 (patch-diagnostics (get-buffer-create "*ediff patch diagnostics*"))
-	 ;; ediff-find-file may use a temp file to do the patch
-	 ;; so, we save source-filename and true-source-filename as a var
-	 ;; that initially is source-filename but may be changed to a temp
-	 ;; file for the purpose of patching.
-	 (true-source-filename source-filename)
-	 (target-filename source-filename)
-	 target-buf buf-to-patch file-name-magic-p 
-	 patch-return-code ctl-buf backup-style aux-wind)
-	  
-    (if (string-match "-V" ediff-patch-options)
-	(error
-	 "Ediff doesn't take the -V option in `ediff-patch-options'--sorry"))
-					
-    ;; Make a temp file, if source-filename has a magic file handler (or if
-    ;; it is handled via auto-mode-alist and similar magic).
-    ;; Check if there is a buffer visiting source-filename and if they are in
-    ;; sync; arrange for the deletion of temp file.
-    (ediff-find-file 'true-source-filename 'buf-to-patch
-		     'ediff-last-dir-patch 'startup-hooks)
-
-    ;; Check if source file name has triggered black magic, such as file name
-    ;; handlers or auto mode alist, and make a note of it.
-    ;; true-source-filename should be either the original name or a
-    ;; temporary file where we put the after-product of the file handler.
-    (setq file-name-magic-p (not (equal (file-truename true-source-filename)
-					(file-truename source-filename))))
-    
-    ;; Checkout orig file, if necessary, so that the patched file 
-    ;; could be checked back in.
-    (ediff-maybe-checkout buf-to-patch)
-
-    (ediff-eval-in-buffer patch-diagnostics
-      (insert-buffer patch-buf)
-      (message "Applying patch ... ")
-      ;; fix environment for gnu patch, so it won't make numbered extensions
-      (setq backup-style (getenv "VERSION_CONTROL"))
-      (setenv "VERSION_CONTROL" nil)
-      (setq patch-return-code
-	    (call-process-region
-	     (point-min) (point-max)
-	     shell-file-name
-	     t   ; delete region (which contains the patch
-	     t   ; insert output (patch diagnostics) in current buffer
-	     nil ; don't redisplay
-	     shell-command-switch   ; usually -c
-	     (format "%s %s %s %s"
-		     ediff-patch-program
-		     ediff-patch-options
-		     ediff-backup-specs
-		     (expand-file-name true-source-filename))
-	     ))
-
-      ;; restore environment for gnu patch
-      (setenv "VERSION_CONTROL" backup-style))
-
-    (message "Applying patch ... done")
-    (message "")
-
-    (switch-to-buffer patch-diagnostics)
-    (sit-for 0) ; synchronize - let the user see diagnostics
-    
-    (or (and (eq patch-return-code 0) ; patch reported success
-	     (file-exists-p
-	      (concat true-source-filename ediff-backup-extension)))
-	(progn
-	  (with-output-to-temp-buffer ediff-msg-buffer
-	    (princ (format "
-Patch has failed OR the backup version of the patched file was not created by
-the patch program.
-
-One reason may be that the values of the variables
-
-    ediff-patch-options    = %S
-    ediff-backup-extension = %S
-    ediff-backup-specs     = %S
-
-are not appropriate for the program specified in the variable
-
-    ediff-patch-program    = %S
-
-Another reason could be that the %S program doesn't understand
-the format of the patch file you used.
-
-See Ediff on-line manual for more details on these variables.
-\(Or use a GNU-compatible patch program and stay out of trouble.\)
-
-Type any key to continue... 
-"
-			   ediff-patch-options
-			   ediff-backup-extension
-			   ediff-backup-specs
-			   ediff-patch-program
-			   ediff-patch-program)))
-	  (beep 1)
-	  (if (setq aux-wind (get-buffer-window ediff-msg-buffer))
-	      (progn
-		(select-window aux-wind)
-		(goto-char (point-max))))
-	  (read-char-exclusive)
-	  (if aux-wind (bury-buffer)) ; ediff-msg-buffer
-	  (if (setq aux-wind (get-buffer-window patch-diagnostics))
-	      (progn
-		(select-window aux-wind)
-		(bury-buffer)))
-	  (error "Patch appears to have failed")))
-    
-    ;; If black magic is involved, apply patch to a temp copy of the
-    ;; file. Otherwise, apply patch to the orig copy.  If patch is applied
-    ;; to temp copy, we name the result old-name_patched for local files
-    ;; and temp-copy_patched for remote files. The orig file name isn't
-    ;; changed, and the temp copy of the original is later deleted.
-    ;; Without magic, the original file is renamed (usually into
-    ;; old-name_orig) and the result of patching will have the same name as
-    ;; the original.
-    (if (not file-name-magic-p)
-	(ediff-eval-in-buffer buf-to-patch
-	  (set-visited-file-name
-	   (concat source-filename ediff-backup-extension))
-	  (set-buffer-modified-p nil))
-      
-      ;; Black magic in effect.
-      ;; If orig file was remote, put the patched file in the temp directory.
-      ;; If orig file is local, put the patched file in the directory of
-      ;; the orig file.
-      (setq target-filename
-	    (concat
-	     (if (ediff-file-remote-p (file-truename source-filename))
-		 true-source-filename
-	       source-filename)
-	     "_patched"))
-      
-      (rename-file true-source-filename target-filename t)
-      
-      ;; arrange that the temp copy of orig will be deleted
-      (rename-file (concat true-source-filename ediff-backup-extension)
-		   true-source-filename t))
-    
-    ;; make orig buffer read-only
-    (setq startup-hooks
-	  (cons 'ediff-set-read-only-in-buf-A startup-hooks))
-    
-    ;; set up a buf for the patched file
-    (setq target-buf (find-file-noselect target-filename))
-    
-    (setq ctl-buf
-	  (ediff-buffers-internal
-	   buf-to-patch target-buf nil
-	   startup-hooks 'epatch))
-    (ediff-eval-in-buffer ctl-buf
-      (setq ediff-patchbufer patch-buf
-	    ediff-patch-diagnostics patch-diagnostics))
-  
-    (bury-buffer patch-diagnostics)
-    (message "Type `P', if you need to see patch diagnostics")
-    ctl-buf))
-
-(defun ediff-multi-patch-internal (patch-buf &optional startup-hooks)
-  (let (meta-buf)
-    (setq startup-hooks
-	  ;; this sets various vars in the meta buffer inside
-	  ;; ediff-prepare-meta-buffer
-	  (cons (` (lambda ()
-		     ;; tell what to do if the user clicks on a session record
-		     (setq ediff-session-action-function
-			   'ediff-patch-file-form-meta
-			   ediff-meta-patchbufer patch-buf)
-		     ))
-		startup-hooks))
-    (setq meta-buf (ediff-prepare-meta-buffer 
-		    'ediff-filegroup-action
-		    (ediff-eval-in-buffer patch-buf
-		      ;; nil replaces a regular expression
-		      (cons (list nil (format "%S" patch-buf))
-			    ediff-patch-map))
-		    "*Ediff Session Group Panel"
-		    'ediff-redraw-directory-group-buffer
-		    'ediff-multifile-patch
-		    startup-hooks))
-    (ediff-show-meta-buffer meta-buf)
-    ))
-
-  
-      
-
-;;; Local Variables:
-;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
-;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
-;;; End:
-
-(provide 'ediff-ptch)
-
-;;; ediff-ptch.el ends here
diff --git a/lisp/ediff-util.el b/lisp/ediff-util.el
deleted file mode 100644
index 0a625aa14df..00000000000
--- a/lisp/ediff-util.el
+++ /dev/null
@@ -1,3599 +0,0 @@
-;;; ediff-util.el --- the core commands and utilities of ediff
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; 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.
-
-;;; Code:
-
-;; Pacify compiler and avoid the need in checking for boundp
-(defvar ediff-patch-diagnostics nil)
-(defvar ediff-patchbufer nil)
-(and noninteractive
-     (eval-when-compile
-       (let ((load-path (cons (expand-file-name ".") load-path)))
-	 (load-file "ediff-init.el")
-	 (load-file "ediff-help.el"))))
-;; end pacifier
-
-(require 'ediff-init)
-(require 'ediff-help)
-(require 'ediff-mult)
-
-;;(if ediff-xemacs-p
-;;    (require 'ediff-tbar)
-;;  (defun ediff-use-toolbar-p () nil))
-;;
-;; for the time being
-(defun ediff-use-toolbar-p () nil)
-
-
-;;; Functions
-
-(defun ediff-mode ()
-  "Ediff mode controls all operations in a single Ediff session.
-This mode is entered through one of the following commands:
-	`ediff'
-	`ediff-files'
-	`ediff-buffers'
-	`ebuffers'
-	`ediff3'
-	`ediff-files3'
-	`ediff-buffers3'
-	`ebuffers3'
-	`ediff-merge'
-	`ediff-merge-files'
-	`ediff-merge-files-with-ancestor'
-	`ediff-merge-buffers'
-	`ediff-merge-buffers-with-ancestor'
-	`ediff-merge-revisions'
-	`ediff-merge-revisions-with-ancestor'
-	`ediff-windows-wordwise'
-	`ediff-windows-linewise'
-	`ediff-regions-wordwise'
-	`ediff-regions-linewise'
-	`epatch'
-	`ediff-patch-file'
-	`ediff-patch-buffer'
-	`epatch-buffer'
-	`ediff-revision'
-
-Commands:
-\\{ediff-mode-map}"
-  (kill-all-local-variables)
-  (setq major-mode 'ediff-mode)
-  (setq mode-name "Ediff")
-  (run-hooks 'ediff-mode-hook))
-
-    
-(require 'ediff-diff)
-(require 'ediff-merg)
-  
-
-;;; Build keymaps
-
-(ediff-defvar-local ediff-mode-map nil
-  "Local keymap used in Ediff mode.
-This is local to each Ediff Control Panel, so they may vary from invocation
-to invocation.")
-
-;; Set up the keymap in the control buffer
-(defun ediff-set-keys ()
-  "Set up Ediff keymap, if necessary."
-  (if (null ediff-mode-map)
-      (ediff-setup-keymap))
-  (use-local-map ediff-mode-map))
-  
-;; Reload Ediff keymap.  For debugging only.
-(defun ediff-reload-keymap ()
-  (interactive)
-  (setq ediff-mode-map nil)
-  (ediff-set-keys))
-  
-
-(defun ediff-setup-keymap ()
-  "Set up the keymap used in the control buffer of Ediff."
-  (setq ediff-mode-map (make-sparse-keymap))
-  (suppress-keymap ediff-mode-map)
-  
-  (define-key ediff-mode-map
-    (if ediff-emacs-p [mouse-2] [button2]) 'ediff-help-for-quick-help)
-  (define-key ediff-mode-map "\C-m"  'ediff-help-for-quick-help)
-
-  (define-key ediff-mode-map "p" 'ediff-previous-difference)
-  (define-key ediff-mode-map "\C-?" 'ediff-previous-difference)
-  (define-key ediff-mode-map [backspace] 'ediff-previous-difference)
-  (define-key ediff-mode-map [delete] 'ediff-previous-difference)
-  (define-key ediff-mode-map "\C-h" (if ediff-no-emacs-help-in-control-buffer
-					'ediff-previous-difference nil))
-  (define-key ediff-mode-map "n" 'ediff-next-difference)
-  (define-key ediff-mode-map " " 'ediff-next-difference)
-  (define-key ediff-mode-map "j" 'ediff-jump-to-difference)
-  (define-key ediff-mode-map "g"  nil)
-  (define-key ediff-mode-map "ga" 'ediff-jump-to-difference-at-point)
-  (define-key ediff-mode-map "gb" 'ediff-jump-to-difference-at-point)
-  (define-key ediff-mode-map "q" 'ediff-quit)
-  (define-key ediff-mode-map "D" 'ediff-show-diff-output)
-  (define-key ediff-mode-map "z" 'ediff-suspend)
-  (define-key ediff-mode-map "\C-l" 'ediff-recenter)
-  (define-key ediff-mode-map "|" 'ediff-toggle-split)
-  (define-key ediff-mode-map "h" 'ediff-toggle-hilit)
-  (or ediff-word-mode
-      (define-key ediff-mode-map "@" 'ediff-toggle-autorefine))
-  (if ediff-narrow-job
-      (define-key ediff-mode-map "%" 'ediff-toggle-narrow-region))
-  (define-key ediff-mode-map "~" 'ediff-swap-buffers)
-  (define-key ediff-mode-map "v" 'ediff-scroll-vertically)
-  (define-key ediff-mode-map "\C-v" 'ediff-scroll-vertically)
-  (define-key ediff-mode-map "^" 'ediff-scroll-vertically)
-  (define-key ediff-mode-map "\M-v" 'ediff-scroll-vertically)
-  (define-key ediff-mode-map "V" 'ediff-scroll-vertically)
-  (define-key ediff-mode-map "<" 'ediff-scroll-horizontally)
-  (define-key ediff-mode-map ">" 'ediff-scroll-horizontally)
-  (define-key ediff-mode-map "i" 'ediff-status-info)
-  (define-key ediff-mode-map "E" 'ediff-documentation)
-  (define-key ediff-mode-map "?" 'ediff-toggle-help)
-  (define-key ediff-mode-map "!" 'ediff-update-diffs)
-  (define-key ediff-mode-map "M" 'ediff-show-meta-buffer)
-  (define-key ediff-mode-map "R" 'ediff-show-registry)
-  (or ediff-word-mode
-      (define-key ediff-mode-map "*" 'ediff-make-or-kill-fine-diffs))
-  (define-key ediff-mode-map "a"  nil)
-  (define-key ediff-mode-map "b"  nil)
-  (define-key ediff-mode-map "r"  nil)
-  (cond (ediff-merge-job
-	 ;; Will barf if no ancestor
-	 (define-key ediff-mode-map "/" 'ediff-show-ancestor)
-	 ;; In merging, we allow only A->C and B->C copying.
-	 (define-key ediff-mode-map "a" 'ediff-copy-A-to-C)
-	 (define-key ediff-mode-map "b" 'ediff-copy-B-to-C)
-	 (define-key ediff-mode-map "r" 'ediff-restore-diff-in-merge-buffer)
-	 (define-key ediff-mode-map "s" 'ediff-shrink-window-C)
-	 (define-key ediff-mode-map "+" 'ediff-combine-diffs)
-	 (define-key ediff-mode-map "$" 'ediff-toggle-show-clashes-only)
-	 (define-key ediff-mode-map "&" 'ediff-re-merge))
-	(ediff-3way-comparison-job
-	 (define-key ediff-mode-map "ab" 'ediff-copy-A-to-B)
-	 (define-key ediff-mode-map "ba" 'ediff-copy-B-to-A)
-	 (define-key ediff-mode-map "ac" 'ediff-copy-A-to-C)
-	 (define-key ediff-mode-map "bc" 'ediff-copy-B-to-C)
-	 (define-key ediff-mode-map "c" nil)
-	 (define-key ediff-mode-map "ca" 'ediff-copy-C-to-A)
-	 (define-key ediff-mode-map "cb" 'ediff-copy-C-to-B)
-	 (define-key ediff-mode-map "ra" 'ediff-restore-diff)
-	 (define-key ediff-mode-map "rb" 'ediff-restore-diff)
-	 (define-key ediff-mode-map "rc" 'ediff-restore-diff)
-	 (define-key ediff-mode-map "C"  'ediff-toggle-read-only))
-	(t ; 2-way comparison
-	 (define-key ediff-mode-map "a"  'ediff-copy-A-to-B)
-	 (define-key ediff-mode-map "b"  'ediff-copy-B-to-A)
-	 (define-key ediff-mode-map "ra" 'ediff-restore-diff)
-	 (define-key ediff-mode-map "rb" 'ediff-restore-diff))
-	) ; cond
-  (define-key ediff-mode-map "G" 'ediff-submit-report)
-  (define-key ediff-mode-map "#"  nil)
-  (define-key ediff-mode-map "#h"  'ediff-toggle-regexp-match)
-  (define-key ediff-mode-map "#f"  'ediff-toggle-regexp-match)
-  (or ediff-word-mode
-      (define-key ediff-mode-map "##"  'ediff-toggle-skip-similar))
-  (define-key ediff-mode-map "o"   nil)
-  (define-key ediff-mode-map "A"  'ediff-toggle-read-only)
-  (define-key ediff-mode-map "B"  'ediff-toggle-read-only)
-  (define-key ediff-mode-map "w"   nil)
-  (define-key ediff-mode-map "wa"  'ediff-save-buffer)
-  (define-key ediff-mode-map "wb"  'ediff-save-buffer)
-  (define-key ediff-mode-map "wd"  'ediff-save-buffer)
-  (define-key ediff-mode-map "="   'ediff-inferior-compare-regions)
-  (if (fboundp 'ediff-show-patch-diagnostics)
-      (define-key ediff-mode-map "P"  'ediff-show-patch-diagnostics))
-  (if ediff-3way-job
-      (progn
-	(define-key ediff-mode-map "wc" 'ediff-save-buffer)
-	(define-key ediff-mode-map "gc" 'ediff-jump-to-difference-at-point)
-	))
-
-  (define-key ediff-mode-map "m" 'ediff-toggle-wide-display)
-	
-  ;; Allow ediff-mode-map to be referenced indirectly
-  (fset 'ediff-mode-map ediff-mode-map)
-  (run-hooks 'ediff-keymap-setup-hook))
-
-
-;;; Setup functions
-
-(require 'ediff-wind)
-
-;; No longer needed: XEmacs has surrogate minibuffers now.
-;;(or (boundp 'synchronize-minibuffers)
-;;    (defvar synchronize-minibuffers nil))
-
-;; Common startup entry for all Ediff functions
-;; It now returns control buffer so other functions can do post-processing
-(defun ediff-setup (buffer-A file-A buffer-B file-B buffer-C file-C
-			     startup-hooks setup-parameters)
-  ;; ediff-convert-standard-filename puts file names in the form appropriate
-  ;; for the OS at hand.
-  (setq file-A (ediff-convert-standard-filename (expand-file-name file-A)))
-  (setq file-B (ediff-convert-standard-filename (expand-file-name file-B)))
-  (if (stringp file-C)
-      (setq file-C
-	    (ediff-convert-standard-filename (expand-file-name file-C))))
-  (let* ((control-buffer-name 
-	  (ediff-unique-buffer-name "*Ediff Control Panel" "*"))
-	 (control-buffer (ediff-eval-in-buffer buffer-A
-			   (get-buffer-create control-buffer-name))))
-    (ediff-eval-in-buffer control-buffer
-      (ediff-mode)                 
-      
-      ;; unwrap set up parameters passed as argument
-      (while setup-parameters
-	(set (car (car setup-parameters)) (cdr (car setup-parameters)))
-	(setq setup-parameters (cdr setup-parameters)))
-	
-      ;; set variables classifying the current ediff job
-      (setq ediff-3way-comparison-job (ediff-3way-comparison-job)
-	    ediff-merge-job (ediff-merge-job)
-	    ediff-merge-with-ancestor-job (ediff-merge-with-ancestor-job)
-	    ediff-3way-job (ediff-3way-job)
-	    ediff-diff3-job (ediff-diff3-job)
-	    ediff-narrow-job (ediff-narrow-job)
-	    ediff-windows-job (ediff-windows-job)
-	    ediff-word-mode-job (ediff-word-mode-job))
-	
-      (make-local-variable 'ediff-use-long-help-message)
-      (make-local-variable 'ediff-prefer-iconified-control-frame)
-      (make-local-variable 'ediff-split-window-function)
-      (make-local-variable 'ediff-default-variant)
-      (make-local-variable 'ediff-merge-window-share)
-      (make-local-variable 'ediff-window-setup-function)
-      (make-local-variable 'ediff-keep-variants)
-
-      ;; Don't delete variants in case of ediff-buffer-* jobs without asking.
-      ;; This is because u may loose work---dangerous.
-      (if (string-match "buffer" (symbol-name ediff-job-name))
-	  (setq ediff-keep-variants t))
-
-      (make-local-hook 'pre-command-hook)
-      (if (ediff-window-display-p)
-	  (add-hook 'pre-command-hook 'ediff-spy-after-mouse nil t))
-      (setq ediff-mouse-pixel-position (mouse-pixel-position))
-      
-      ;; adjust for merge jobs
-      (if ediff-merge-job
-	  (let ((buf
-		 ;; If default variant is `combined', the right stuff is
-		 ;; inserted by ediff-do-merge
-		 ;; Note: at some point, we tried to put ancestor buffer here
-		 ;; (which is currently buffer C. This didn't work right
-		 ;; because the merge buffer will contain lossage: diff regions
-		 ;; in the ancestor, which correspond to revisions that agree
-		 ;; in both buf A and B.
-		 (cond ((eq ediff-default-variant 'default-B)
-			buffer-B)
-		       (t buffer-A))))
-		 
-	    (setq ediff-split-window-function
-		  ediff-merge-split-window-function) 
-	    
-	    ;; remember the ancestor buffer, if any
-	    (setq ediff-ancestor-buffer buffer-C)
-	    
-	    (setq buffer-C
-		  (get-buffer-create
-		   (ediff-unique-buffer-name "*ediff-merge" "*")))
-	    (save-excursion
-	      (set-buffer buffer-C)
-	      (insert-buffer buf)
-	      (funcall (ediff-eval-in-buffer buf major-mode))
-	      ;; after Stig@hackvan.com
-	      (add-hook 'local-write-file-hooks 'ediff-set-merge-mode nil t)
-	      )))
-      (setq buffer-read-only nil    
-	    ediff-buffer-A buffer-A
-	    ediff-buffer-B buffer-B
-	    ediff-buffer-C buffer-C
-	    ediff-control-buffer control-buffer)
-	   
-      (setq ediff-control-buffer-suffix
-	    (if (string-match "<[0-9]*>" control-buffer-name)
-		(substring control-buffer-name
-			   (match-beginning 0) (match-end 0))
-	      "")
-	    ediff-control-buffer-number
-	    (max
-	     0
-	     (1-
-	      (string-to-number
-	       (substring
-		ediff-control-buffer-suffix
-		(or
-		 (string-match "[0-9]+" ediff-control-buffer-suffix)
-		 0))))))
-	   
-      (setq ediff-error-buffer
-	    (get-buffer-create (ediff-unique-buffer-name "*ediff-errors" "*")))
-      
-      (ediff-eval-in-buffer buffer-A (ediff-strip-mode-line-format))
-      (ediff-eval-in-buffer buffer-B (ediff-strip-mode-line-format))
-      (if ediff-3way-job
-	  (ediff-eval-in-buffer buffer-C (ediff-strip-mode-line-format)))
-      (if (ediff-buffer-live-p ediff-ancestor-buffer)
-	  (ediff-eval-in-buffer ediff-ancestor-buffer
-	    (ediff-strip-mode-line-format)))
-      
-      (ediff-save-protected-variables) ; save variables to be restored on exit
-      
-      ;; ediff-setup-diff-regions-function must be set after setup
-      ;; parameters are processed.
-      (setq ediff-setup-diff-regions-function
-	    (if ediff-diff3-job
-		'ediff-setup-diff-regions3
-	      'ediff-setup-diff-regions))
-	
-      (setq ediff-wide-bounds
-	    (list (ediff-make-bullet-proof-overlay
-		   '(point-min) '(point-max) ediff-buffer-A)
-		  (ediff-make-bullet-proof-overlay
-		   '(point-min) '(point-max) ediff-buffer-B)
-		  (ediff-make-bullet-proof-overlay
-		   '(point-min) '(point-max) ediff-buffer-C)))
-      
-      ;; This has effect only on ediff-windows/regions
-      ;; In all other cases, ediff-visible-region sets visibility bounds to
-      ;; ediff-wide-bounds, and ediff-narrow-bounds are ignored.
-      (if ediff-start-narrowed
-	  (setq ediff-visible-bounds ediff-narrow-bounds)
-	(setq ediff-visible-bounds ediff-wide-bounds))
-      
-      (ediff-set-keys) ; comes after parameter setup
-      
-      ;; set up ediff-narrow-bounds, if not set
-      (or ediff-narrow-bounds
-	  (setq ediff-narrow-bounds ediff-wide-bounds))
-      
-      ;; All these must be inside ediff-eval-in-buffer control-buffer,
-      ;; since these vars are local to control-buffer
-      ;; These won't run if there are errors in diff
-      (ediff-eval-in-buffer ediff-buffer-A
-	(ediff-nuke-selective-display)
-	(run-hooks 'ediff-prepare-buffer-hook)
-	(if (ediff-eval-in-buffer control-buffer ediff-merge-job)
-	    (setq buffer-read-only t))
-	;; add control-buffer to the list of sessions--no longer used, but may
-	;; be used again in the future
-	(or (memq control-buffer ediff-this-buffer-ediff-sessions)
-	    (setq ediff-this-buffer-ediff-sessions
-		  (cons control-buffer ediff-this-buffer-ediff-sessions)))
-	)
-      (ediff-eval-in-buffer ediff-buffer-B
-	(ediff-nuke-selective-display)
-	(run-hooks 'ediff-prepare-buffer-hook)
-	(if (ediff-eval-in-buffer control-buffer ediff-merge-job)
-	    (setq buffer-read-only t))
-	;; add control-buffer to the list of sessions
-	(or (memq control-buffer ediff-this-buffer-ediff-sessions)
-	    (setq ediff-this-buffer-ediff-sessions
-		  (cons control-buffer ediff-this-buffer-ediff-sessions)))
-	)
-      (if ediff-3way-job
-	  (ediff-eval-in-buffer ediff-buffer-C
-	    (ediff-nuke-selective-display)
-	    (run-hooks 'ediff-prepare-buffer-hook)
-	    ;; add control-buffer to the list of sessions
-	    (or (memq control-buffer ediff-this-buffer-ediff-sessions)
-		(setq ediff-this-buffer-ediff-sessions
-		      (cons control-buffer
-			    ediff-this-buffer-ediff-sessions))) 
-	    ))
-
-      (if (ediff-buffer-live-p ediff-ancestor-buffer)
-	  (ediff-eval-in-buffer ediff-ancestor-buffer
-	    (ediff-nuke-selective-display)
-	    (setq buffer-read-only t)
-	    (run-hooks 'ediff-prepare-buffer-hook)
-	    (or (memq control-buffer ediff-this-buffer-ediff-sessions)
-		(setq ediff-this-buffer-ediff-sessions
-		      (cons control-buffer
-			    ediff-this-buffer-ediff-sessions)))
-	    ))
-      
-      ;; must come after setting up  ediff-narrow-bounds AND after
-      ;; nuking selective display
-      (funcall ediff-setup-diff-regions-function file-A file-B file-C)
-      (setq ediff-number-of-differences (length ediff-difference-vector-A))
-      (setq ediff-current-difference -1)
-      
-      (ediff-make-current-diff-overlay 'A)
-      (ediff-make-current-diff-overlay 'B)
-      (if ediff-3way-job
-	  (ediff-make-current-diff-overlay 'C))
-      (if ediff-merge-with-ancestor-job
-	  (ediff-make-current-diff-overlay 'Ancestor))
-	  
-      (ediff-setup-windows buffer-A buffer-B buffer-C control-buffer)
-      
-      (let ((shift-A (ediff-overlay-start
-		      (ediff-get-value-according-to-buffer-type
-		       'A ediff-narrow-bounds)))
-	    (shift-B (ediff-overlay-start
-		      (ediff-get-value-according-to-buffer-type
-		       'B ediff-narrow-bounds)))
-	    (shift-C (ediff-overlay-start
-		      (ediff-get-value-according-to-buffer-type
-		       'C ediff-narrow-bounds))))
-	;; position point in buf A
-	(save-excursion
-	  (select-window ediff-window-A)
-	  (goto-char shift-A))
-	;; position point in buf B
-	(save-excursion
-	  (select-window ediff-window-B)
-	  (goto-char shift-B))
-	(if ediff-3way-job
-	    (save-excursion
-	      (select-window ediff-window-C)
-	      (goto-char shift-C)))
-	)
-      
-      (select-window ediff-control-window)
-      (ediff-visible-region)
-      
-      (run-hooks 'startup-hooks)
-      (ediff-refresh-mode-lines)
-      (setq buffer-read-only t)
-      (setq ediff-session-registry
-	    (cons control-buffer ediff-session-registry))
-      (ediff-update-registry)
-      (if (ediff-buffer-live-p ediff-meta-buffer)
-	  (ediff-update-meta-buffer ediff-meta-buffer))
-      (run-hooks 'ediff-startup-hook)
-      ) ; eval in control-buffer
-    control-buffer))
-      
-      
-;; This function assumes that we are in the window where control buffer is
-;; to reside. 
-(defun ediff-setup-control-buffer (ctl-buf)
-  "Set up window for control buffer."
-  (if (window-dedicated-p (selected-window))
-      (set-buffer ctl-buf) ; we are in control frame but just in case
-    (switch-to-buffer ctl-buf))
-  (let ((window-min-height 2))
-    (erase-buffer)
-    (ediff-set-help-message)
-    (insert ediff-help-message)
-    (shrink-window-if-larger-than-buffer)
-    (or (ediff-multiframe-setup-p)
-	(ediff-indent-help-message))
-    (ediff-set-help-overlays)
-
-    (set-buffer-modified-p nil)
-    (ediff-refresh-mode-lines)
-    (setq ediff-control-window (selected-window))
-    (setq ediff-window-config-saved
-	  (format "%S%S%S%S%S%S%S"
-		  ediff-control-window
-		  ediff-window-A
-		  ediff-window-B
-		  ediff-window-C
-		  ediff-split-window-function
-		  (ediff-multiframe-setup-p)
-		  ediff-wide-display-p))
-    (if (not (ediff-multiframe-setup-p))
-	(ediff-make-bottom-toolbar))    ; checks if toolbar is requested
-    (goto-char (point-min))
-    (skip-chars-forward ediff-whitespace)))
-    
-    
-
-
-;;; Commands for working with Ediff
-     
-(defun ediff-update-diffs ()
-  "Recompute difference regions in buffers A, B, and C.
-Buffers are not synchronized with their respective files, so changes done
-to these buffers are not saved at this point---the user can do this later,
-if necessary."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (if (and (ediff-buffer-live-p ediff-ancestor-buffer)
-	   (not (y-or-n-p "Recompute differences during merge, really? ")))
-      (error "God forbid!"))
-      
-  (let ((point-A (ediff-eval-in-buffer ediff-buffer-A (point)))
-	;;(point-B (ediff-eval-in-buffer ediff-buffer-B (point)))
-	(tmp-buffer (get-buffer-create ediff-tmp-buffer))
-	(buf-A-file-name
-	 (file-name-nondirectory (or (buffer-file-name ediff-buffer-A)
-				     (buffer-name ediff-buffer-A)
-				     )))
-	(buf-B-file-name
-	 (file-name-nondirectory (or (buffer-file-name ediff-buffer-B)
-				     (buffer-name ediff-buffer-B)
-				     )))
-	(buf-C-file-name
-	 (file-name-nondirectory (or (buffer-file-name ediff-buffer-C)
-				     ;; if (null ediff-buffer-C), there is
-				     ;; no danger, since we later check if
-				     ;; ediff-buffer-C is alive
-				     (buffer-name ediff-buffer-C)
-				     )))
-	(overl-A (ediff-get-value-according-to-buffer-type
-		  'A ediff-narrow-bounds))
-	(overl-B (ediff-get-value-according-to-buffer-type
-		  'B ediff-narrow-bounds))
-	(overl-C (ediff-get-value-according-to-buffer-type
-		  'C ediff-narrow-bounds))
-	beg-A end-A beg-B end-B beg-C end-C
-	file-A file-B file-C)
-    (ediff-unselect-and-select-difference -1)
-    
-    (setq beg-A (ediff-overlay-start overl-A)
-	  beg-B (ediff-overlay-start overl-B)
-	  beg-C (ediff-overlay-start overl-C)
-	  end-A (ediff-overlay-end overl-A)
-	  end-B (ediff-overlay-end overl-B)
-	  end-C (ediff-overlay-end overl-C))
-	  
-    (if ediff-word-mode
-	(progn
-	  (ediff-wordify beg-A end-A ediff-buffer-A tmp-buffer)
-	  (setq file-A (ediff-make-temp-file tmp-buffer "regA"))
-	  (ediff-wordify beg-B end-B ediff-buffer-B tmp-buffer)
-	  (setq file-B (ediff-make-temp-file tmp-buffer "regB"))
-	  (if ediff-3way-job
-	      (progn
-		(ediff-wordify beg-C end-C ediff-buffer-C tmp-buffer)
-		(setq file-C (ediff-make-temp-file tmp-buffer "regC"))))
-	  )
-      ;; not word-mode
-      (setq file-A (ediff-make-temp-file ediff-buffer-A buf-A-file-name))
-      (setq file-B (ediff-make-temp-file ediff-buffer-B buf-B-file-name))
-      (if ediff-3way-job
-	  (setq file-C (ediff-make-temp-file ediff-buffer-C buf-C-file-name)))
-      )
-	
-    (ediff-clear-diff-vector 'ediff-difference-vector-A 'fine-diffs-also)
-    (ediff-clear-diff-vector 'ediff-difference-vector-B 'fine-diffs-also)
-    (ediff-clear-diff-vector 'ediff-difference-vector-C 'fine-diffs-also)
-    (ediff-clear-diff-vector
-     'ediff-difference-vector-Ancestor 'fine-diffs-also)
-    ;; let them garbage collect. we can't use the ancestor after recomputing
-    ;; the diffs.
-    (setq ediff-difference-vector-Ancestor nil
-	  ediff-ancestor-buffer nil
-	  ediff-state-of-merge nil)
-
-    (setq ediff-killed-diffs-alist nil) ; invalidate saved killed diff regions
-    
-    ;; In case of merge job, fool it into thinking that it is just doing
-    ;; comparison
-    (let ((ediff-setup-diff-regions-function ediff-setup-diff-regions-function)
-	  (ediff-3way-comparison-job ediff-3way-comparison-job)
-	  (ediff-merge-job ediff-merge-job)
-	  (ediff-merge-with-ancestor-job ediff-merge-with-ancestor-job)
-	  (ediff-job-name ediff-job-name))
-      (if ediff-merge-job
-	  (setq ediff-setup-diff-regions-function 'ediff-setup-diff-regions3
-		ediff-3way-comparison-job t
-		ediff-merge-job nil
-		ediff-merge-with-ancestor-job nil
-		ediff-job-name 'ediff-files3))
-      (funcall ediff-setup-diff-regions-function file-A file-B file-C))
-	    
-    (setq ediff-number-of-differences (length ediff-difference-vector-A))
-    (delete-file file-A)
-    (delete-file file-B)
-    (if file-C
-	(delete-file file-C))
-	
-    (if ediff-3way-job
-	(ediff-set-state-of-all-diffs-in-all-buffers ediff-control-buffer))
-	
-    (ediff-jump-to-difference (ediff-diff-at-point 'A point-A))
-    (message "")
-    ))
-    
-;; Not bound to any key---to dangerous. A user can do it if necessary.
-(defun ediff-revert-buffers-then-recompute-diffs (noconfirm)
-  "Revert buffers A, B and C. Then rerun Ediff on file A and file B."
-  (interactive "P")
-  (ediff-barf-if-not-control-buffer)
-  (let ((bufA ediff-buffer-A)
-	(bufB ediff-buffer-B)
-	(bufC ediff-buffer-C)
-	(ctl-buf ediff-control-buffer)
-	(keep-variants ediff-keep-variants)
-	(ancestor-buf ediff-ancestor-buffer)
-	(ancestor-job ediff-merge-with-ancestor-job)
-	(merge ediff-merge-job)
-	(comparison ediff-3way-comparison-job))
-    (ediff-eval-in-buffer bufA
-      (revert-buffer t noconfirm))
-    (ediff-eval-in-buffer bufB
-      (revert-buffer t noconfirm))
-    ;; this should only be executed in a 3way comparison, not in merge
-    (if comparison
-	(ediff-eval-in-buffer bufC
-	  (revert-buffer t noconfirm)))
-    (if merge
-	(progn
-	  (set-buffer ctl-buf)
-	  ;; the argument says whether to reverse the meaning of
-	  ;; ediff-keep-variants, i.e., ediff-really-quit runs here with
-	  ;; variants kept.
-	  (ediff-really-quit (not keep-variants))
-	  (kill-buffer bufC)
-	  (if ancestor-job
-	      (ediff-merge-buffers-with-ancestor bufA bufB ancestor-buf)
-	    (ediff-merge-buffers bufA bufB)))
-      (ediff-update-diffs))))
-
-
-;; optional NO-REHIGHLIGHT says to not rehighlight buffers 
-(defun ediff-recenter (&optional no-rehighlight)
-  "Bring the highlighted region of all buffers being compared into view.
-Reestablish the default three-window display."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  
-;;  ;; No longer needed: XEmacs has surrogate minibuffers now.
-;;  (if ediff-xemacs-p (setq synchronize-minibuffers t))
-  
-  (let (buffer-read-only)
-    (if (and (ediff-buffer-live-p ediff-buffer-A)
-	     (ediff-buffer-live-p ediff-buffer-B)
-	     (or (not ediff-3way-job)
-		 (ediff-buffer-live-p ediff-buffer-C)))
-	(ediff-setup-windows
-	 ediff-buffer-A ediff-buffer-B ediff-buffer-C ediff-control-buffer)
-      (or (eq this-command 'ediff-quit)
-	  (message ediff-KILLED-VITAL-BUFFER
-		   (beep 1)))
-      ))
-  
-  ;; set visibility range appropriate to this invocation of Ediff.
-  (ediff-visible-region)
-  ;; raise
-  (if (and (ediff-window-display-p)
-	   (symbolp this-command)
-	   (symbolp last-command)
-	   ;; Either one of the display-changing commands
-	   (or (memq this-command
-		     '(ediff-recenter
-		       ediff-dir-action ediff-registry-action
-		       ediff-patch-action
-		       ediff-toggle-wide-display ediff-toggle-multiframe))
-	       ;; Or one of the movement cmds and prev cmd was an Ediff cmd
-	       ;; This avoids raising frames unnecessarily.
-	       (and (memq this-command
-			  '(ediff-next-difference
-			    ediff-previous-difference
-			    ediff-jump-to-difference
-			    ediff-jump-to-difference-at-point))
-		    (not (string-match "^ediff-" (symbol-name last-command)))
-		    )))
-      (progn
-	(if (window-live-p ediff-window-A)
-	    (raise-frame (window-frame ediff-window-A)))
-	(if (window-live-p ediff-window-B)
-	    (raise-frame (window-frame ediff-window-B)))
-	(if (window-live-p ediff-window-C)
-	    (raise-frame (window-frame ediff-window-C)))))
-  (if (and (ediff-window-display-p)
-	   (frame-live-p ediff-control-frame)
-	   (not ediff-use-long-help-message)
-	   (not (ediff-frame-iconified-p ediff-control-frame)))
-      (raise-frame ediff-control-frame))
-  
-  ;; Redisplay whatever buffers are showing, if there is a selected difference
-  (let ((control-frame ediff-control-frame)
-	(control-buf ediff-control-buffer))
-    (if (and (ediff-buffer-live-p ediff-buffer-A)
-	     (ediff-buffer-live-p ediff-buffer-B)
-	     (or (not ediff-3way-job)
-		 (ediff-buffer-live-p ediff-buffer-C)))
-	(progn
-	  (or no-rehighlight
-	      (ediff-select-difference ediff-current-difference))
-	  
-	  (ediff-recenter-one-window 'A)
-	  (ediff-recenter-one-window 'B)
-	  (if ediff-3way-job
-	      (ediff-recenter-one-window 'C))
-	  
-	  (ediff-eval-in-buffer control-buf
-	    (ediff-recenter-ancestor) ; check if ancestor is alive
-	    
-	    (if (and (ediff-multiframe-setup-p)
-		     (not ediff-use-long-help-message)
-		     (not (ediff-frame-iconified-p ediff-control-frame)))
-		;; never grab mouse on quit in this place
-		(ediff-reset-mouse
-		 control-frame
-		 (eq this-command 'ediff-quit))))
-	  ))
-
-    (ediff-restore-highlighting)
-    (ediff-eval-in-buffer control-buf (ediff-refresh-mode-lines))
-    ))
-  
-;; this function returns to the window it was called from
-;; (which was the control window)
-(defun ediff-recenter-one-window (buf-type)
-  (if (ediff-valid-difference-p)
-      ;; context must be saved before switching to windows A/B/C
-      (let* ((ctl-wind (selected-window))
-	     (shift (ediff-overlay-start
-		     (ediff-get-value-according-to-buffer-type 
-		      buf-type ediff-narrow-bounds)))
-	     (job-name ediff-job-name)
-	     (control-buf ediff-control-buffer)
-	     (window-name (intern (format "ediff-window-%S" buf-type)))
-	     (window (if (window-live-p (symbol-value window-name))
-			 (symbol-value window-name))))
-	
-	(if (and window ediff-windows-job)
-	    (set-window-start window shift))
-	(if window
-	    (progn
-	      (select-window window)
-	      (ediff-deactivate-mark)
-	      (ediff-position-region
-	       (ediff-get-diff-posn buf-type 'beg nil control-buf)
-	       (ediff-get-diff-posn buf-type 'end nil control-buf)
-	       (ediff-get-diff-posn buf-type 'beg nil control-buf)
-	       job-name
-	       )))
-	(select-window ctl-wind)
-	)))
-
-(defun ediff-recenter-ancestor ()
-  ;; do half-hearted job by recentering the ancestor buffer, if it is alive and
-  ;; visible.
-  (if (and (ediff-buffer-live-p ediff-ancestor-buffer)
-	   (ediff-valid-difference-p))
-      (let ((window (ediff-get-visible-buffer-window ediff-ancestor-buffer))
-	    (ctl-wind (selected-window))
-	    (job-name ediff-job-name)
-	    (ctl-buf ediff-control-buffer))
-	(ediff-eval-in-buffer ediff-ancestor-buffer
-	  (goto-char (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf))
-	  (if window
-	      (progn
-		(select-window window)
-		(ediff-position-region
-		 (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf)
-		 (ediff-get-diff-posn 'Ancestor 'end nil ctl-buf)
-		 (ediff-get-diff-posn 'Ancestor 'beg nil ctl-buf)
-		 job-name))))
-	(select-window ctl-wind)
-	)))
-
-	
-;; This will have to be refined for 3way jobs
-(defun ediff-toggle-split ()
-  "Toggle vertical/horizontal window split. 
-Does nothing if file-A and file-B are in different frames."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (let* ((wind-A (if (window-live-p ediff-window-A) ediff-window-A))
-	 (wind-B (if (window-live-p ediff-window-B) ediff-window-B))
-	 (wind-C (if (window-live-p ediff-window-C) ediff-window-C))
-	 (frame-A (if wind-A (window-frame wind-A)))
-	 (frame-B (if wind-B (window-frame wind-B)))
-	 (frame-C (if wind-C (window-frame wind-C))))
-    (if (or (eq frame-A frame-B)
-	    (not (frame-live-p frame-A))
-	    (not (frame-live-p frame-B))
-	    (if ediff-3way-comparison-job
-		(or (not (frame-live-p frame-C))
-		    (eq frame-A frame-C) (eq frame-B frame-C))))
-	(setq ediff-split-window-function
-	      (if (eq ediff-split-window-function 'split-window-vertically)
-		  'split-window-horizontally
-		'split-window-vertically))
-      (message "Buffers being compared are in different frames"))
-    (ediff-recenter 'no-rehighlight)))
-  
-(defun ediff-toggle-hilit ()
-  "Switch between highlighting using ASCII flags and highlighting using faces.
-On a dumb terminal, switches between ASCII highlighting and no highlighting." 
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (if (not (ediff-has-face-support-p))
-      (if (eq ediff-highlighting-style 'ascii)
-	  (progn
-	    (message "ASCII highlighting flags removed")
-	    (ediff-unselect-and-select-difference ediff-current-difference
-						  'unselect-only)
-	    (setq ediff-highlighting-style 'off))
-	(ediff-unselect-and-select-difference ediff-current-difference
-					      'select-only))
-    (ediff-unselect-and-select-difference ediff-current-difference
-					  'unselect-only)
-    ;; cycle through highlighting
-    (cond ((and ediff-use-faces ediff-highlight-all-diffs)
-	   (message "Unhighlighting unselected difference regions")
-	   (setq ediff-highlight-all-diffs nil))
-	  (ediff-use-faces
-	   (message "Highlighting with ASCII flags")
-	   (setq ediff-use-faces nil))
-	  (t
-	   (message "Re-highlighting all difference regions")
-	   (setq ediff-use-faces t
-		 ediff-highlight-all-diffs t)))
-		 
-    (if (and ediff-use-faces ediff-highlight-all-diffs)
-	(ediff-paint-background-regions)
-      (ediff-paint-background-regions 'unhighlight))
-    
-    (ediff-unselect-and-select-difference
-     ediff-current-difference 'select-only))
-  )
-
-  
-(defun ediff-toggle-autorefine ()
-  "Toggle auto-refine mode."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (if ediff-word-mode
-      (error "No fine differences in this mode"))
-  (cond ((eq ediff-auto-refine 'nix)
-	 (setq ediff-auto-refine 'on)
-	 (ediff-make-fine-diffs ediff-current-difference 'noforce)
-	 (message "Auto-refining is ON"))
-	((eq ediff-auto-refine 'on)
-	 (message "Auto-refining is OFF")
-	 (setq ediff-auto-refine 'off))
-	(t ;; nix 'em
-	 (ediff-set-fine-diff-properties ediff-current-difference 'default)
-	 (message "Refinements are HIDDEN")
-	 (setq ediff-auto-refine 'nix))
-	))
-
-(defun ediff-show-ancestor ()
-  "Show the ancestor buffer in a suitable window."
-  (interactive)
-  (ediff-recenter)
-  (or (ediff-buffer-live-p ediff-ancestor-buffer)
-      (if ediff-merge-with-ancestor-job
-	  (error "Lost connection to ancestor buffer...sorry")
-	(error "Not merging with ancestor")))
-  (let (wind)
-    (cond ((setq wind (ediff-get-visible-buffer-window ediff-ancestor-buffer))
-	   (raise-frame (window-frame wind)))
-	  (t (set-window-buffer ediff-window-C ediff-ancestor-buffer)))))
-	
-(defun ediff-make-or-kill-fine-diffs (arg)
-  "Compute fine diffs. With negative prefix arg, kill fine diffs.
-In both cases, operates on the currrent difference region." 
-  (interactive "P")
-  (ediff-barf-if-not-control-buffer)
-  (cond ((eq arg '-)
-	 (ediff-clear-fine-differences ediff-current-difference))
-	((and (numberp arg) (< arg 0))
-	 (ediff-clear-fine-differences ediff-current-difference))
-	(t (ediff-make-fine-diffs))))
-	 
-  
-(defun ediff-toggle-help ()
-  "Toggle short/long help message."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (let (buffer-read-only)
-    (erase-buffer)
-    (setq ediff-use-long-help-message (not ediff-use-long-help-message))
-    (ediff-set-help-message))
-  ;; remember the icon status of the control frame when the user requested
-  ;; full control message
-  (if (and ediff-use-long-help-message (ediff-multiframe-setup-p))
-      (setq ediff-prefer-iconified-control-frame
-	    (ediff-frame-iconified-p ediff-control-frame)))
-	    
-  (setq ediff-window-config-saved "") ; force redisplay
-  (ediff-recenter 'no-rehighlight))
-  
-  
-;; If BUF, this is the buffer to toggle, not current buffer.
-(defun ediff-toggle-read-only (&optional buf)
-  "Toggle read-only in current buffer.
-If buffer is under version control and locked, check it out first.
-If optional argument BUF is specified, toggle read-only in that buffer instead
-of the current buffer."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (let ((ctl-buf (if (null buf) (current-buffer)))
-	(buf-type (ediff-char-to-buftype last-command-char)))
-    (or buf (ediff-recenter))
-    (or buf
-	(setq buf (ediff-get-buffer buf-type)))
-	      
-    (ediff-eval-in-buffer buf     ; eval in buf A/B/C
-      (let* ((file (buffer-file-name buf))
-	     (file-writable (and file
-				 (file-exists-p file)
-				 (file-writable-p file)))
-	     (toggle-ro-cmd (cond (ediff-toggle-read-only-function)
-				  ((ediff-file-checked-out-p file)
-				   'toggle-read-only)
-				  (file-writable 'toggle-read-only)
-				  (t (key-binding "\C-x\C-q")))))
-	;; If the file is checked in, make sure we don't make buffer modifiable
-	;; without warning the user. The user can fool our checks by making the
-	;; buffer non-RO without checking the file out. We regard this as a
-	;; user problem.
-	(if (and (ediff-file-checked-in-p file)
-		 ;; If ctl-buf is null, this means we called this
-		 ;; non-interactively, in which case don't ask questions
-		 ctl-buf)
-	    (cond ((not buffer-read-only)
-		   (setq toggle-ro-cmd 'toggle-read-only))
-		  ((and (or (beep 1) t) ; always beep
-			(y-or-n-p
-			 (format
-			  "File %s is under version control. Check it out? "
-			  (ediff-abbreviate-file-name file))))
-		   ;; if we checked the file out, we should also change the
-		   ;; original state of buffer-read-only to nil.  If we don't
-		   ;; do this, the mode line will show %%, since the file was
-		   ;; RO before ediff started, so the user will think the file
-		   ;; is checked in.
-		   (ediff-eval-in-buffer ctl-buf
-		     (ediff-change-saved-variable
-		      'buffer-read-only nil buf-type)))
-		  (t
-		   (setq toggle-ro-cmd 'toggle-read-only)
-		   (beep 1) (beep 1)
-		   (message
-		    "Boy, this is risky! Don't modify this file...")
-		   (sit-for 3)))) ; let the user see the warning
-	(if (and toggle-ro-cmd 
-		 (string-match "toggle-read-only" (symbol-name toggle-ro-cmd)))
-	    (save-excursion
-	      (save-window-excursion
-		(select-window (ediff-get-visible-buffer-window buf))
-		(command-execute toggle-ro-cmd)))
-	  (error "Don't know how to toggle read-only in buffer %S" buf))
-	
-	;; Check if we made the current buffer updatable, but its file is RO.
-	;; Signal a warning in this case.
-	(if (and file (not buffer-read-only)
-		 (eq this-command 'ediff-toggle-read-only)
-		 (file-exists-p file)
-		 (not (file-writable-p file)))
-	    (message "Warning: file %s is read-only"
-		     (ediff-abbreviate-file-name file) (beep 1)))
-	))))
-
-;; checkout if visited file is checked in
-(defun ediff-maybe-checkout (buf)
-  (let ((file (buffer-file-name buf))
-	(checkout-function (key-binding "\C-x\C-q")))
-    (if (and (ediff-file-checked-in-p file)
-	     (or (beep 1) t)
-	     (y-or-n-p
-	      (format
-	       "File %s is under version control. Check it out? "
-	       (ediff-abbreviate-file-name file))))
-	(ediff-eval-in-buffer buf
-	  (command-execute checkout-function)))))
-	   
-
-;; This is a simple-minded check for whether a file is under version control.
-;; If file,v exists but file doesn't, this file is considered to be not checked
-;; in and not checked out for the purpose of patching (since patch won't be
-;; able to read such a file anyway).
-;; FILE is a string representing file name
-(defun ediff-file-under-version-control (file)
-  (let* ((filedir (file-name-directory file))
-	 (file-nondir (file-name-nondirectory file))
-	 (trial (concat file-nondir ",v"))
-	 (full-trial (concat filedir trial))
-	 (full-rcs-trial (concat filedir "RCS/" trial)))
-    (and (stringp file)
-	 (file-exists-p file)
-	 (or
-	  (and
-	   (file-exists-p full-trial)
-	   ;; in FAT FS, `file,v' and `file' may turn out to be the same!
-	   ;; don't be fooled by this!
-	   (not (equal (file-attributes file)
-		       (file-attributes full-trial))))
-	  ;; check if a version is in RCS/ directory
-	  (file-exists-p full-rcs-trial)))
-       ))
-
-(defun ediff-file-checked-out-p (file)
-  (and (ediff-file-under-version-control file)
-       (file-writable-p file)))
-(defun ediff-file-checked-in-p (file)
-  (and (ediff-file-under-version-control file)
-       (not (file-writable-p file))))
-      
-(defun ediff-swap-buffers ()
-  "Rotate the display of buffers A, B, and C."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (if (and (window-live-p ediff-window-A) (window-live-p ediff-window-B))
-      (let ((buf ediff-buffer-A)
-	    (values ediff-buffer-values-orig-A)
-	    (diff-vec ediff-difference-vector-A)
-	    (hide-regexp ediff-regexp-hide-A)
-	    (focus-regexp ediff-regexp-focus-A)
-	    (wide-visibility-p (eq ediff-visible-bounds ediff-wide-bounds))
-	    (overlay (if (ediff-has-face-support-p)
-			 ediff-current-diff-overlay-A)))
-	(if ediff-3way-comparison-job
-	    (progn
-	      (set-window-buffer ediff-window-A ediff-buffer-C)
-	      (set-window-buffer ediff-window-B ediff-buffer-A)
-	      (set-window-buffer ediff-window-C ediff-buffer-B)
-	      )
-	  (set-window-buffer ediff-window-A ediff-buffer-B)
-	  (set-window-buffer ediff-window-B ediff-buffer-A))
-	;; swap diff buffers
-	(if ediff-3way-comparison-job
-	    (setq ediff-buffer-A ediff-buffer-C
-		  ediff-buffer-C ediff-buffer-B
-		  ediff-buffer-B buf)
-	  (setq ediff-buffer-A ediff-buffer-B
-		ediff-buffer-B buf))
-		
-	;; swap saved buffer characteristics
-	(if ediff-3way-comparison-job
-	    (setq ediff-buffer-values-orig-A ediff-buffer-values-orig-C
-		  ediff-buffer-values-orig-C ediff-buffer-values-orig-B
-		  ediff-buffer-values-orig-B values)
-	  (setq ediff-buffer-values-orig-A ediff-buffer-values-orig-B
-		ediff-buffer-values-orig-B values))
-	
-	;; swap diff vectors
-	(if ediff-3way-comparison-job
-	    (setq ediff-difference-vector-A ediff-difference-vector-C
-		  ediff-difference-vector-C ediff-difference-vector-B
-		  ediff-difference-vector-B diff-vec)
-	  (setq ediff-difference-vector-A ediff-difference-vector-B
-		ediff-difference-vector-B diff-vec))
-		
-	;; swap hide/focus regexp
-	(if ediff-3way-comparison-job
-	    (setq ediff-regexp-hide-A ediff-regexp-hide-C
-		  ediff-regexp-hide-C ediff-regexp-hide-B
-		  ediff-regexp-hide-B hide-regexp
-		  ediff-regexp-focus-A ediff-regexp-focus-C
-		  ediff-regexp-focus-C ediff-regexp-focus-B
-		  ediff-regexp-focus-B focus-regexp)
-	  (setq ediff-regexp-hide-A ediff-regexp-hide-B
-		ediff-regexp-hide-B hide-regexp
-		ediff-regexp-focus-A ediff-regexp-focus-B
-		ediff-regexp-focus-B focus-regexp))
-	
-	;; The following is needed for XEmacs, since there one can't move
-	;; overlay to another buffer. In Emacs, this swap is redundant.
-	(if (ediff-has-face-support-p)
-	    (if ediff-3way-comparison-job
-		(setq ediff-current-diff-overlay-A ediff-current-diff-overlay-C
-		      ediff-current-diff-overlay-C ediff-current-diff-overlay-B
-		      ediff-current-diff-overlay-B overlay)
-	      (setq ediff-current-diff-overlay-A ediff-current-diff-overlay-B
-		    ediff-current-diff-overlay-B overlay)))
-		    
-	;; swap wide bounds
-	(setq ediff-wide-bounds
-	      (cond (ediff-3way-comparison-job
-		     (list (nth 2 ediff-wide-bounds)
-			   (nth 0 ediff-wide-bounds)
-			   (nth 1 ediff-wide-bounds)))
-		    (ediff-3way-job
-		     (list (nth 1 ediff-wide-bounds)
-			   (nth 0 ediff-wide-bounds)
-			   (nth 2 ediff-wide-bounds)))
-		    (t 
-		     (list (nth 1 ediff-wide-bounds)
-			   (nth 0 ediff-wide-bounds)))))
-	;; swap narrow bounds
-	(setq ediff-narrow-bounds
-	      (cond (ediff-3way-comparison-job
-		     (list (nth 2 ediff-narrow-bounds)
-			   (nth 0 ediff-narrow-bounds)
-			   (nth 1 ediff-narrow-bounds)))
-		    (ediff-3way-job
-		     (list (nth 1 ediff-narrow-bounds)
-			   (nth 0 ediff-narrow-bounds)
-			   (nth 2 ediff-narrow-bounds)))
-		    (t 
-		     (list (nth 1 ediff-narrow-bounds)
-			   (nth 0 ediff-narrow-bounds)))))
-	(if wide-visibility-p
-	    (setq ediff-visible-bounds ediff-wide-bounds)
-	  (setq ediff-visible-bounds ediff-narrow-bounds))
-	))
-  (if ediff-3way-job
-      (ediff-set-state-of-all-diffs-in-all-buffers ediff-control-buffer))
-  (ediff-recenter 'no-rehighlight)
-  )
-  
-
-(defun ediff-toggle-wide-display ()
-  "Toggle wide/regular display.
-This is especially useful when comparing buffers side-by-side."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (or (ediff-window-display-p)
-      (error "%sEmacs is not running as a window application"
-	     (if ediff-emacs-p "" "X")))
-  (ediff-recenter 'no-rehighlight) ; make sure buffs are displayed in windows
-  (let ((ctl-buf ediff-control-buffer))
-    (setq ediff-wide-display-p (not ediff-wide-display-p))
-    (if (not ediff-wide-display-p)
-	(ediff-eval-in-buffer ctl-buf
-	  (modify-frame-parameters
-	   ediff-wide-display-frame ediff-wide-display-orig-parameters)
-	  ;;(sit-for (if ediff-xemacs-p 0.4 0))
-	  ;; restore control buf, since ctl window may have been deleted
-	  ;; during resizing
-	  (set-buffer ctl-buf)
-	  (setq ediff-wide-display-orig-parameters nil
-		ediff-window-B nil) ; force update of window config
-	  (ediff-recenter 'no-rehighlight))
-      (funcall ediff-make-wide-display-function)
-      ;;(sit-for (if ediff-xemacs-p 0.4 0))
-      (ediff-eval-in-buffer ctl-buf
-	(setq ediff-window-B nil) ; force update of window config
-	(ediff-recenter 'no-rehighlight)))))
-	
-;;;###autoload
-(defun ediff-toggle-multiframe ()
-  "Switch from the multiframe display to single-frame display and back.
-For a permanent change, set the variable `ediff-window-setup-function',
-which see."
-  (interactive)
-  (let (set-func)
-  (or (ediff-window-display-p)
-      (error "%sEmacs is not running as a window application"
-	     (if ediff-emacs-p "" "X")))
-
-  (setq set-func (if (ediff-in-control-buffer-p) 'setq 'setq-default))
-
-  (cond ((eq ediff-window-setup-function 'ediff-setup-windows-multiframe)
-	 (eval
-	  (list
-	   set-func
-	   'ediff-window-setup-function ''ediff-setup-windows-plain)))
-	((eq ediff-window-setup-function 'ediff-setup-windows-plain)
-	 (if (ediff-in-control-buffer-p)
-	     (ediff-kill-bottom-toolbar))
-	 (eval
-	  (list
-	   set-func
-	   'ediff-window-setup-function ''ediff-setup-windows-multiframe))))
-  (if (ediff-in-control-buffer-p)
-      (progn
-	(setq ediff-window-B nil)
-	(ediff-recenter 'no-rehighlight)))))
-
-;; if was using toolbar, kill it
-(defun ediff-kill-bottom-toolbar ()
-  ;; Using ctl-buffer or ediff-control-window for LOCALE does not
-  ;; work properly in XEmacs 19.14: we have to use
-  ;;(selected-frame).
-  ;; The problem with this is that any previous bottom-toolbar
-  ;; will not re-appear after our cleanup here.  Is there a way
-  ;; to do "push" and "pop" toolbars ?  --marcpa  
-  (if (ediff-use-toolbar-p)
-      (progn
-	(set-specifier bottom-toolbar (list (selected-frame) nil))
-	(set-specifier bottom-toolbar-visible-p (list (selected-frame) nil)))))
-
-;; if wants to use toolbar, make it
-(defun ediff-make-bottom-toolbar ()
-  (if (ediff-use-toolbar-p)
-      (progn
-	(set-specifier bottom-toolbar (list (selected-frame) ediff-toolbar))
-	(set-specifier bottom-toolbar-visible-p (list (selected-frame) t)) 
-	(set-specifier bottom-toolbar-height (list (selected-frame) 34)))))
-	       
-;; Merging
-
-(defun ediff-toggle-show-clashes-only ()
-  "Toggle the mode where only the regions where both buffers differ with the ancestor are shown."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (if (not ediff-merge-with-ancestor-job)
-      (error "This command makes sense only when merging with an ancestor"))
-  (setq ediff-show-clashes-only (not ediff-show-clashes-only))
-  (if ediff-show-clashes-only
-      (message "Focus on regions where both buffers differ from the ancestor")
-    (message "Canceling focus on regions where changes clash")))
-	       
-;; Widening/narrowing
-
-(defun ediff-toggle-narrow-region ()
-  "Toggle narrowing in buffers A, B, and C.
-Used in ediff-windows/regions only."
-  (interactive)
-  (if (eq ediff-buffer-A ediff-buffer-B)
-      (error ediff-NO-DIFFERENCES))
-  (if (eq ediff-visible-bounds ediff-wide-bounds)
-      (setq ediff-visible-bounds ediff-narrow-bounds)
-    (setq ediff-visible-bounds ediff-wide-bounds))
-  (ediff-recenter 'no-rehighlight))
-  
-;; Narrow bufs A/B/C to ediff-visible-bounds. If this is currently set to
-;; ediff-wide-bounds, then this actually widens.
-;; This function does nothing if job-name is not
-;; ediff-regions-wordwise/linewise or ediff-windows-wordwise/linewise. 
-;; Does nothing if buffer-A  = buffer-B since we can't narrow
-;; to two different regions in one buffer.
-(defun ediff-visible-region ()
-  (if (or (eq ediff-buffer-A ediff-buffer-B)
-	  (eq ediff-buffer-A ediff-buffer-C)
-	  (eq ediff-buffer-C ediff-buffer-B))
-      ()
-    ;; If ediff-*-regions/windows, ediff-visible-bounds is already set
-    ;; Otherwise, always use full range.
-    (if (not ediff-narrow-job)
-	(setq ediff-visible-bounds ediff-wide-bounds))
-    (let ((overl-A (ediff-get-value-according-to-buffer-type
-		    'A  ediff-visible-bounds))
-	  (overl-B (ediff-get-value-according-to-buffer-type
-		    'B  ediff-visible-bounds))
-	  (overl-C (ediff-get-value-according-to-buffer-type
-		    'C  ediff-visible-bounds))
-	  )
-      (ediff-eval-in-buffer ediff-buffer-A
-	(narrow-to-region
-	 (ediff-overlay-start overl-A) (ediff-overlay-end overl-A)))
-      (ediff-eval-in-buffer ediff-buffer-B
-	(narrow-to-region
-	 (ediff-overlay-start overl-B) (ediff-overlay-end overl-B)))
-      
-      (if ediff-3way-comparison-job
-	  (ediff-eval-in-buffer ediff-buffer-C
-	    (narrow-to-region
-	     (ediff-overlay-start overl-C) (ediff-overlay-end overl-C))))
-      )))
-  
-
-;; Window scrolling operations
-
-;; Performs some operation on the two file windows (if they are showing).
-;; Traps all errors on the operation in windows A/B/C.
-;; Usually, errors come from scrolling off the
-;; beginning or end of the buffer, and this gives error messages.
-(defun ediff-operate-on-windows (operation arg)
-	 
-  ;; make sure windows aren't dead
-  (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B)))
-      (ediff-recenter 'no-rehighlight))
-  (if (not (and (ediff-buffer-live-p ediff-buffer-A)
-		(ediff-buffer-live-p ediff-buffer-B)
-		(or (not ediff-3way-job) ediff-buffer-C)
-		))
-      (error ediff-KILLED-VITAL-BUFFER))
-	
-  (let* ((wind (selected-window))
-	 (wind-A ediff-window-A)
-	 (wind-B ediff-window-B)
-	 (wind-C ediff-window-C)
-	 (coefA (ediff-get-region-size-coefficient 'A operation))
-	 (coefB (ediff-get-region-size-coefficient 'B operation))
-	 (three-way ediff-3way-job)
-	 (coefC (if three-way
-		    (ediff-get-region-size-coefficient 'C operation))))
-	     
-    (select-window wind-A)
-    (condition-case nil
-	(funcall operation (round (* coefA arg)))
-      (error))
-    (select-window wind-B)
-    (condition-case nil
-	(funcall operation (round (* coefB arg)))
-      (error))
-    (if three-way
-	(progn
-	  (select-window wind-C)
-	  (condition-case nil
-	      (funcall operation (round (* coefC arg)))
-	    (error))))
-    (select-window wind)))
-
-(defun ediff-scroll-vertically (&optional arg)
-  "Vertically scroll buffers A, B \(and C if appropriate\).
-With optional argument ARG, scroll ARG lines; otherwise scroll by nearly
-the one half of the height of window-A."
-  (interactive "P")
-  (ediff-barf-if-not-control-buffer)
-  
-  ;; make sure windows aren't dead
-  (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B)))
-      (ediff-recenter 'no-rehighlight))
-  (if (not (and (ediff-buffer-live-p ediff-buffer-A)
-		(ediff-buffer-live-p ediff-buffer-B)
-		(or (not ediff-3way-job)
-		    (ediff-buffer-live-p ediff-buffer-C))
-		))
-      (error ediff-KILLED-VITAL-BUFFER))
-      
-  (ediff-operate-on-windows
-   (if (memq last-command-char '(?v ?\C-v))
-       'scroll-up 
-     'scroll-down)
-   ;; calculate argument to scroll-up/down
-   ;; if there is an explicit argument
-   (if (and arg (not (equal arg '-)))
-       ;; use it
-       (prefix-numeric-value arg)
-     ;; if not, see if we can determine a default amount (the window height)
-     (let (default-amount)
-       (setq default-amount 
-	     (- (/ (min (window-height ediff-window-A)
-			(window-height ediff-window-B)
-			(if ediff-3way-job
-			    (window-height ediff-window-C)
-			  500)) ; some large number
-		   2)
-		1 next-screen-context-lines))
-       ;; window found
-       (if arg
-	   ;; C-u as argument means half of default amount
-	   (/ default-amount 2)
-	 ;; no argument means default amount
-	 default-amount)))))
-
-
-(defun ediff-scroll-horizontally (&optional arg)
-  "Horizontally scroll buffers A, B \(and C if appropriate\).
-If an argument is given, that is how many columns are scrolled, else nearly
-the width of the A/B/C windows."
-  (interactive "P")
-  (ediff-barf-if-not-control-buffer)
-  
-  ;; make sure windows aren't dead
-  (if (not (and (window-live-p ediff-window-A) (window-live-p ediff-window-B)))
-      (ediff-recenter 'no-rehighlight))
-  (if (not (and (ediff-buffer-live-p ediff-buffer-A)
-		(ediff-buffer-live-p ediff-buffer-B)
-		(or (not ediff-3way-job)
-		    (ediff-buffer-live-p ediff-buffer-C))
-		))
-      (error ediff-KILLED-VITAL-BUFFER))
-    
-  (ediff-operate-on-windows
-   (if (= last-command-char ?<)
-       'scroll-left
-     'scroll-right)
-   ;; calculate argument to scroll-left/right
-   ;; if there is an explicit argument
-   (if (and arg (not (equal arg '-)))
-       ;; use it
-       (prefix-numeric-value arg)
-     ;; if not, see if we can determine a default amount
-     ;; (half the window width)
-     (if (null ediff-control-window)
-	 ;; no control window, use nil
-	 nil
-       (let ((default-amount
-	       (- (/ (min (window-width ediff-window-A)
-			  (window-width ediff-window-B)
-			  (if ediff-3way-comparison-job
-			      (window-width ediff-window-C)
-			    500) ; some large number
-			  )
-		     2)
-		  3)))
-	 ;; window found
-	 (if arg
-	     ;; C-u as argument means half of default amount
-	     (/ default-amount 2)
-	   ;; no argument means default amount
-	   default-amount))))))
-
-
-;;BEG, END show the region to be positioned.
-;;JOB-NAME holds ediff-job-name. The ediff-windows job positions regions
-;;differently. 
-(defun ediff-position-region (beg end pos job-name)
-  (if (> end (point-max))
-      (setq end (point-max)))
-  (if ediff-windows-job
-      (if (pos-visible-in-window-p end)
-	  () ; do nothing, wind is already positioned
-	;; at this point, windows are positioned at the beginning of the
-	;; file regions (not diff-regions)  being compared.
-	(save-excursion
-	  (move-to-window-line (- (window-height) 2))
-	  (let ((amount (+ 2 (count-lines (point) end))))
-	    (scroll-up amount))))
-    (set-window-start (selected-window) beg)
-    (if (pos-visible-in-window-p end)
-	;; Determine the number of lines that the region occupies
-	(let ((lines 0)
-	      (prev-point 0))
-	  (while ( and (> end (progn
-				(move-to-window-line lines)
-				(point)))
-		       ;; `end' may be beyond the window bottom, so check
-		       ;; that we are making progress
-		       (< prev-point (point)))
-	    (setq prev-point (point))
-	    (setq lines (1+ lines)))
-	  ;; And position the beginning on the right line
-	  (goto-char beg)
-	  (recenter (/ (1+ (max (- (1- (window-height (selected-window)))
-				   lines)
-				1)
-			   )
-		       2))))
-    (goto-char pos)
-    ))
-
-;; get number of lines from window start to region end
-(defun ediff-get-lines-to-region-end (buf-type &optional n ctl-buf)
-  (or n (setq n ediff-current-difference))
-  (or ctl-buf (setq ctl-buf ediff-control-buffer))
-  (ediff-eval-in-buffer ctl-buf
-    (let* ((buf (ediff-get-buffer buf-type))
-	   (wind (eval (intern (format "ediff-window-%S" buf-type))))
-	   (beg (window-start wind))
-	   (end (ediff-get-diff-posn buf-type 'end))
-	   lines)
-      (ediff-eval-in-buffer buf
-	(if (< beg end)
-	    (setq lines (count-lines beg end))
-	  (setq lines 0))
-	lines
-	))))
-
-;; get number of lines from window end to region start
-(defun ediff-get-lines-to-region-start (buf-type &optional n ctl-buf)
-  (or n (setq n ediff-current-difference))
-  (or ctl-buf (setq ctl-buf ediff-control-buffer))
-  (ediff-eval-in-buffer ctl-buf
-    (let* ((buf (ediff-get-buffer buf-type))
-	   (wind (eval (intern (format "ediff-window-%S" buf-type))))
-	   (end (window-end wind))
-	   (beg (ediff-get-diff-posn buf-type 'beg)))
-      (ediff-eval-in-buffer buf
-	(if (< beg end) (count-lines beg end) 0))
-      )))
-
-
-;; region size coefficient is a coefficient by which to adjust scrolling
-;; up/down of the window displaying buffer of type BUFTYPE.
-;; The purpose of this coefficient is to make the windows scroll in sync, so
-;; that it won't happen that one diff region is scrolled off while the other is
-;; still seen.
-;;
-;; If the difference region is invalid, the coefficient is 1
-(defun ediff-get-region-size-coefficient (buf-type op &optional n ctl-buf)
-  (ediff-eval-in-buffer (or ctl-buf ediff-control-buffer)
-    (if (ediff-valid-difference-p n)
-	(let* ((func (cond ((eq op 'scroll-down)
-			    'ediff-get-lines-to-region-start)
-			   ((eq op 'scroll-up)
-			    'ediff-get-lines-to-region-end)
-			   (t '(lambda (a b c) 0))))
-	       (max-lines (max (funcall func 'A n ctl-buf)
-			       (funcall func 'B n ctl-buf)
-			       (if (ediff-buffer-live-p ediff-buffer-C)
-				   (funcall func 'C n ctl-buf)
-				 0))))
-	  ;; this covers the horizontal coefficient as well:
-	  ;; if max-lines = 0 then coef = 1
-	  (if (> max-lines 0)
-	      (/ (+ (funcall func buf-type n ctl-buf) 0.0)
-		 (+ max-lines 0.0))
-	    1))
-      1)))
-
-
-(defun ediff-next-difference (&optional arg)
-  "Advance to the next difference. 
-With a prefix argument, go forward that many differences."
-  (interactive "p")
-  (ediff-barf-if-not-control-buffer)
-  (if (< ediff-current-difference ediff-number-of-differences)
-      (let ((n (min ediff-number-of-differences
-		    (+ ediff-current-difference arg)))
-	    regexp-skip)
-	    
-	(or (>= n ediff-number-of-differences)
-	    (setq regexp-skip (funcall ediff-skip-diff-region-function n))
-	    (ediff-install-fine-diff-if-necessary n))
-	(while (and (< n ediff-number-of-differences)
-		    (or
-		     ;; regexp skip
-		     regexp-skip
-		     ;; skip clashes, if necessary
-		     (and ediff-show-clashes-only
-			  (string-match "prefer"
-					(or (ediff-get-state-of-merge n) "")))
-		     ;; skip difference regions that differ in white space
-		     (and ediff-ignore-similar-regions
-			  (ediff-no-fine-diffs-p n))))
-	  (setq n (1+ n))
-	  (if (= 0 (mod n 20))
-	      (message "Skipped over region %d and counting ..."  n))
-	  (or (>= n ediff-number-of-differences)
-	      (setq regexp-skip (funcall ediff-skip-diff-region-function n))
-	      (ediff-install-fine-diff-if-necessary n))
-	  )
-	(message "")
-	(ediff-unselect-and-select-difference n)
-	) ; let
-    (ediff-visible-region)
-    (error "At end of the difference list")))
-
-(defun ediff-previous-difference (&optional arg)
-  "Go to the previous difference. 
-With a prefix argument, go back that many differences."
-  (interactive "p")
-  (ediff-barf-if-not-control-buffer)
-  (if (> ediff-current-difference -1)
-      (let ((n (max -1 (- ediff-current-difference arg)))
-	    regexp-skip)
-	    
-	(or (< n 0)
-	    (setq regexp-skip (funcall ediff-skip-diff-region-function n))
-	    (ediff-install-fine-diff-if-necessary n))
-	(while (and (> n -1)
-		    (or
-		     ;; regexp skip
-		     regexp-skip
-		     ;; skip clashes, if necessary
-		     (and ediff-show-clashes-only
-			  (string-match "prefer"
-					(or (ediff-get-state-of-merge n) "")))
-		     ;; skip difference regions that differ in white space
-		     (and ediff-ignore-similar-regions
-			  (ediff-no-fine-diffs-p n))))
-	  (if (= 0 (mod (1+ n) 20))
-	      (message "Skipped over region %d and counting ..."  (1+ n)))
-	  (setq n (1- n))
-	  (or (< n 0)
-	      (setq regexp-skip (funcall ediff-skip-diff-region-function n))
-	      (ediff-install-fine-diff-if-necessary n))
-	  )
-	(message "")
-	(ediff-unselect-and-select-difference n)
-	) ; let
-    (ediff-visible-region)
-    (error "At beginning of the difference list")))
-
-;; The diff number is as perceived by the user (i.e., 1+ the internal
-;; representation)
-(defun ediff-jump-to-difference (difference-number)
-  "Go to the difference specified as a prefix argument.
-If the prefix is negative, count differences from the end."
-  (interactive "p")
-  (ediff-barf-if-not-control-buffer)
-  (setq difference-number
-	(cond ((< difference-number 0)
-	       (+ ediff-number-of-differences difference-number))
-	      ((> difference-number 0) (1- difference-number))
-	      (t -1)))
-  ;; -1 is allowed by ediff-unselect-and-select-difference --- it is the
-  ;; position before the first one.
-  (if (and (>= difference-number -1)
-	   (<= difference-number ediff-number-of-differences))
-      (ediff-unselect-and-select-difference difference-number)
-    (error ediff-BAD-DIFF-NUMBER
-	   this-command (1+ difference-number) ediff-number-of-differences)))
-      
-(defun ediff-jump-to-difference-at-point (arg)
-  "Go to difference closest to the point in buffer A, B, or C.
-The buffer depends on last command character \(a, b, or c\) that invoked this
-command. For instance, if the command was `ga' then the point value in buffer A
-is used.
-With a prefix argument, synchronize all files around the current point position
-in the specified buffer."
-  (interactive "P")
-  (ediff-barf-if-not-control-buffer)
-  (let* ((buf-type (ediff-char-to-buftype last-command-char))
-	 (buffer (ediff-get-buffer buf-type))
-	 (pt (ediff-eval-in-buffer buffer (point)))
-	 (diff-no (ediff-diff-at-point buf-type nil (if arg 'after)))
-	 (past-last-diff (< ediff-number-of-differences diff-no))
-	 (beg (if past-last-diff
-		  (ediff-eval-in-buffer buffer (point-max))
-		(ediff-get-diff-posn buf-type 'beg (1- diff-no))))
-	 ctl-wind wind-A wind-B wind-C
-	 shift)
-    (if past-last-diff
-	(ediff-jump-to-difference -1)
-      (ediff-jump-to-difference diff-no))
-    (setq ctl-wind (selected-window)
-	  wind-A ediff-window-A
-	  wind-B ediff-window-B
-	  wind-C ediff-window-C)
-    (if arg
-	(progn
-	  (ediff-eval-in-buffer buffer
-	    (setq shift (- beg pt)))
-	  (select-window wind-A)
-	  (if past-last-diff (goto-char (point-max)))
-	  (condition-case nil
-	      (backward-char shift) ; noerror, if beginning of buffer
-	    (error))
-	  (recenter)
-	  (select-window wind-B)
-	  (if past-last-diff (goto-char (point-max)))
-	  (condition-case nil
-	      (backward-char shift) ; noerror, if beginning of buffer
-	    (error))
-	  (recenter)
-	  (if (window-live-p wind-C)
-	      (progn
-		(select-window wind-C)
-		(if past-last-diff (goto-char (point-max)))
-		(condition-case nil
-		    (backward-char shift) ; noerror, if beginning of buffer
-		  (error))
-		(recenter)
-		))
-	  (select-window ctl-wind)
-	  ))
-    ))
-	
-      
-;; find region most related to the current point position (or POS, if given)
-;; returns diff number as seen by the user (i.e., 1+ the internal
-;; representation) 
-;; The optional argument WHICH-DIFF can be `after' or `before'. If `after',
-;; find the diff after the point. If `before', find the diff before the
-;; point. If the point is inside a diff, return that diff.
-(defun ediff-diff-at-point (buf-type &optional pos which-diff)
-  (let ((buffer (ediff-get-buffer buf-type))
-	(ctl-buffer ediff-control-buffer)
-	(max-dif-num (1- ediff-number-of-differences))
-	(diff-no -1)
-	(prev-beg 0)
-	(prev-end 0)
-	(beg 0)
-	(end 0))
-	
-    (ediff-eval-in-buffer buffer
-      (setq pos (or pos (point)))
-      (while (and (or (< pos prev-beg) (> pos beg))
-		  (< diff-no max-dif-num))
-	(setq diff-no (1+ diff-no))
-	(setq prev-beg beg
-	      prev-end end)
-	(setq beg (ediff-get-diff-posn buf-type 'beg diff-no ctl-buffer)
-	      end (ediff-get-diff-posn buf-type 'end diff-no ctl-buffer))
-	)
-      
-      ;; boost diff-no by 1, if past the last diff region
-      (if (and (memq which-diff '(after before))
-	       (> pos beg) (= diff-no max-dif-num))
-	  (setq diff-no (1+ diff-no)))
-
-      (cond ((eq which-diff 'after) (1+ diff-no))
-	    ((eq which-diff 'before) diff-no)
-	    ((< (abs (count-lines pos (max 1 prev-end)))
-		(abs (count-lines pos (max 1 beg))))
-	     diff-no) 	    ; choose prev difference
-	    (t
-	     (1+ diff-no))) ; choose next difference
-     )))
-
-
-;;; Copying diffs.
-
-(defun ediff-diff-to-diff (arg &optional keys)
-  "Copy buffer-X'th difference region to buffer Y \(X,Y are A, B, or C\).
-If numerical prefix argument, copy the difference specified in the arg.
-Otherwise, copy the difference given by `ediff-current-difference'.
-This command assumes it is bound to a 2-character key sequence, `ab', `ba',
-`ac', etc., which is used to determine the types of buffers to be used for
-copying difference regions. The first character in the sequence specifies
-the source buffer and the second specifies the target.
-
-If the second optional argument, a 2-character string, is given, use it to
-determine the source and the target buffers instead of the command keys."
-  (interactive "P")
-  (ediff-barf-if-not-control-buffer)
-  (or keys (setq keys (this-command-keys)))
-  (if (eq arg '-) (setq arg -1)) ; translate neg arg to -1
-  (if (numberp arg) (ediff-jump-to-difference arg))
-
-  (let* ((key1 (aref keys 0))
-	 (key2 (aref keys 1))
-	 (char1 (if (and ediff-xemacs-p (eventp key1)) (event-key key1) key1))
-	 (char2 (if (and ediff-xemacs-p (eventp key1)) (event-key key2) key2))
-	 ediff-verbose-p)
-    (ediff-copy-diff ediff-current-difference
-		     (ediff-char-to-buftype char1)
-		     (ediff-char-to-buftype char2))
-    ;; recenter with rehighlighting, but no messages
-    (ediff-recenter)))
-
-(defun ediff-copy-A-to-B (arg)
-  "Copy ARGth difference region from buffer A to B.
-ARG is a prefix argument. If nil, copy the current difference region."
-  (interactive "P")
-  (ediff-diff-to-diff arg "ab"))
-
-(defun ediff-copy-B-to-A (arg)
-  "Copy ARGth difference region from buffer B to A.
-ARG is a prefix argument. If nil, copy the current difference region."
-  (interactive "P")
-  (ediff-diff-to-diff arg "ba"))
-
-(defun ediff-copy-A-to-C (arg)
-  "Copy ARGth difference region from buffer A to buffer C.
-ARG is a prefix argument. If nil, copy the current difference region."
-  (interactive "P")
-  (ediff-diff-to-diff arg "ac"))
-
-(defun ediff-copy-B-to-C (arg)
-  "Copy ARGth difference region from buffer B to buffer C.
-ARG is a prefix argument. If nil, copy the current difference region."
-  (interactive "P")
-  (ediff-diff-to-diff arg "bc"))
-
-(defun ediff-copy-C-to-B (arg)
-  "Copy ARGth difference region from buffer C to B.
-ARG is a prefix argument. If nil, copy the current difference region."
-  (interactive "P")
-  (ediff-diff-to-diff arg "cb"))
-
-(defun ediff-copy-C-to-A (arg)
-  "Copy ARGth difference region from buffer C to A.
-ARG is a prefix argument. If nil, copy the current difference region."
-  (interactive "P")
-  (ediff-diff-to-diff arg "ca"))
-
-
-
-;; Copy diff N from FROM-BUF-TYPE \(given as A, B or C\) to TO-BUF-TYPE.
-;; If optional DO-NOT-SAVE is non-nil, do not save the old value of the
-;; target diff. This is used in merging, when constructing the merged
-;; version.
-(defun ediff-copy-diff (n from-buf-type to-buf-type
-			  &optional batch-invocation reg-to-copy)
-  (let* ((to-buf (ediff-get-buffer to-buf-type))
-	 ;;(from-buf (if (not reg-to-copy) (ediff-get-buffer from-buf-type)))
-	 (ctrl-buf ediff-control-buffer)
-	 (saved-p t)
-	 (three-way ediff-3way-job)
-	 messg
-	 ediff-verbose-p
-	 reg-to-delete reg-to-delete-beg reg-to-delete-end)
-	
-    (setq reg-to-delete-beg
-	  (ediff-get-diff-posn to-buf-type 'beg n ctrl-buf))
-    (setq reg-to-delete-end
-	  (ediff-get-diff-posn to-buf-type 'end n ctrl-buf))
-	  
-    (if reg-to-copy
-	(setq from-buf-type nil)
-      (setq reg-to-copy (ediff-get-region-contents n from-buf-type ctrl-buf)))
-    
-    (setq reg-to-delete (ediff-get-region-contents
-			 n to-buf-type ctrl-buf
-			 reg-to-delete-beg reg-to-delete-end))
-    
-    (if (string= reg-to-delete reg-to-copy)
-	(setq saved-p nil) ; don't copy identical buffers
-      ;; seems ok to copy
-      (if (or batch-invocation (ediff-test-save-region n to-buf-type))
-	  (condition-case conds
-	      (progn
-		(ediff-eval-in-buffer to-buf
-		  ;; to prevent flags from interfering if buffer is writable
-		  (let ((inhibit-read-only (null buffer-read-only)))
-		    
-		    (goto-char reg-to-delete-end)
-		    (insert reg-to-copy)
-		    
-		    (if (> reg-to-delete-end reg-to-delete-beg)
-			(kill-region reg-to-delete-beg reg-to-delete-end))
-		    ))
-		(or batch-invocation
-		    (setq 
-		     messg
-		     (ediff-save-diff-region n to-buf-type reg-to-delete))))
-	    (error (message "ediff-copy-diff: %s %s"
-			    (car conds)
-			    (mapconcat 'prin1-to-string (cdr conds) " "))
-		   (beep 1)
-		   (sit-for 2) ; let the user see the error msg
-		   (setq saved-p nil)
-		   )))
-      )
-    
-    ;; adjust state of difference in case 3-way and diff was copied ok
-    (if (and saved-p three-way)
-	(ediff-set-state-of-diff-in-all-buffers n ctrl-buf))
-
-    (if batch-invocation
-	(ediff-clear-fine-differences n)
-      ;; If diff3 job, we should recompute fine diffs so we clear them
-      ;; before reinserting flags (and thus before ediff-recenter).
-      (if (and saved-p three-way)
-	  (ediff-clear-fine-differences n))
-      
-      (ediff-refresh-mode-lines)
-      
-      ;; For diff2 jobs, don't recompute fine diffs, since we know there
-      ;; aren't any. So we clear diffs after ediff-recenter.
-      (if (and saved-p (not three-way))
-	  (ediff-clear-fine-differences n))
-      ;; Make sure that the message about saving and how to restore is seen
-      ;; by the user
-      (message messg))
-    ))
-     
-;; Save Nth diff of buffer BUF-TYPE \(A, B, or C\).
-;; That is to say, the Nth diff on the `ediff-killed-diffs-alist'.  REG
-;; is the region to save.  It is redundant here, but is passed anyway, for
-;; convenience.
-(defun ediff-save-diff-region (n buf-type reg)
-  (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist))
-	 (buf (ediff-get-buffer buf-type))
-	 (this-buf-n-th-diff-saved (assoc buf (cdr n-th-diff-saved))))
-	 
-    (if this-buf-n-th-diff-saved
-	;; either nothing saved for n-th diff and buffer or we OK'ed
-	;; overriding
-	(setcdr this-buf-n-th-diff-saved reg)
-      (if n-th-diff-saved ;; n-th diff saved, but for another buffer
-	  (nconc n-th-diff-saved  (list (cons buf reg)))
-	(setq ediff-killed-diffs-alist  ;; create record for n-th diff
-	      (cons (list n (cons buf reg))
-		    ediff-killed-diffs-alist))))
-    (message "Saving old diff region #%d of buffer %S. To recover, type `r%s'"
-	     (1+ n) buf-type
-	     (if ediff-merge-job
-		 "" (downcase (symbol-name buf-type))))
-    ))
-    
-;; Test if saving Nth difference region of buffer BUF-TYPE is possible.
-(defun ediff-test-save-region (n buf-type)
-  (let* ((n-th-diff-saved (assoc n ediff-killed-diffs-alist))
-	 (buf (ediff-get-buffer buf-type))
-	 (this-buf-n-th-diff-saved (assoc buf (cdr n-th-diff-saved))))
-	 
-    (if this-buf-n-th-diff-saved
-	(if (yes-or-no-p
-	     (format 
-	      "You've previously copied diff region %d to buffer %S. Confirm "
-	      (1+ n) buf-type))
-	    t
-	  (error "Quit"))
-      t)))
-	  
-(defun ediff-pop-diff (n buf-type)
-  "Pop last killed Nth diff region from buffer BUF-TYPE."
-  (let* ((n-th-record (assoc n ediff-killed-diffs-alist))
-	 (buf (ediff-get-buffer buf-type))
-	 (saved-rec (assoc buf (cdr n-th-record)))
-	 (three-way ediff-3way-job)
-	 (ctl-buf ediff-control-buffer)
-	 ediff-verbose-p
-	 saved-diff reg-beg reg-end recovered)
-	
-    (if (cdr saved-rec)
-	(setq saved-diff (cdr saved-rec))
-      (if (> ediff-number-of-differences 0)
-	  (error "Nothing saved for diff %d in buffer %S" (1+ n) buf-type)
-	(error ediff-NO-DIFFERENCES)))
-    
-    (setq reg-beg (ediff-get-diff-posn buf-type 'beg n ediff-control-buffer))
-    (setq reg-end (ediff-get-diff-posn buf-type 'end n ediff-control-buffer))
-    
-    (condition-case conds
-	(ediff-eval-in-buffer buf
-	  (let ((inhibit-read-only (null buffer-read-only)))
-	    
-	    (goto-char reg-end)
-	    (insert saved-diff)
-	    
-	    (if (> reg-end reg-beg)
-		(kill-region reg-beg reg-end))
-	    
-	    (setq recovered t)
-	    ))
-      (error (message "ediff-pop-diff: %s %s"
-		      (car conds)
-		      (mapconcat 'prin1-to-string (cdr conds) " "))
-	     (beep 1)))
-    
-    ;; Clearing fine diffs is necessary for
-    ;; ediff-unselect-and-select-difference to properly recompute them. We
-    ;; can't rely on ediff-copy-diff to clear this vector, as the user might
-    ;; have modified diff regions after copying and, thus, may have recomputed
-    ;; fine diffs.
-    (if recovered
-	(ediff-clear-fine-differences n))
-	  
-    ;; adjust state of difference
-    (if (and three-way recovered)
-	(ediff-set-state-of-diff-in-all-buffers n ctl-buf))
-	
-    (ediff-refresh-mode-lines)
-    
-    (if recovered
-	(progn
-	  (setq n-th-record (delq saved-rec n-th-record))
-	  (message "Diff region %d in buffer %S restored" (1+ n) buf-type)
-	  ))
-    ))
-      
-(defun ediff-restore-diff  (arg &optional key)
-  "Restore ARGth diff from `ediff-killed-diffs-alist'.
-ARG is a prefix argument.  If ARG is nil, restore the current-difference.
-If the second optional argument, a character, is given, use it to
-determine the target buffer instead of last-command-char"
-  (interactive "P")
-  (ediff-barf-if-not-control-buffer)
-  (if (numberp arg)
-      (ediff-jump-to-difference arg))
-  (ediff-pop-diff ediff-current-difference 
-		  (ediff-char-to-buftype (or key last-command-char)))
-  ;; recenter with rehighlighting, but no messages
-  (let (ediff-verbose-p)
-    (ediff-recenter)))
-
-(defun ediff-restore-diff-in-merge-buffer (arg)
-  "Restore ARGth diff in the merge buffer.
-ARG is a prefix argument. If nil, restore the current diff."
-  (interactive "P")
-  (ediff-restore-diff arg ?c))
-  
-  
-(defun ediff-toggle-regexp-match ()
-  "Toggle between focusing and hiding of difference regions that match
-a regular expression typed in by the user."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (let ((regexp-A "")
-	(regexp-B "")
-	(regexp-C "")
-	msg-connective alt-msg-connective alt-connective)
-    (cond
-     ((or (and (eq ediff-skip-diff-region-function
-		   ediff-focus-on-regexp-matches-function)
-	       (eq last-command-char ?f))
-	  (and (eq ediff-skip-diff-region-function
-		   ediff-hide-regexp-matches-function)
-	       (eq last-command-char ?h)))
-      (message "Selective browsing by regexp turned off")
-      (setq ediff-skip-diff-region-function 'ediff-show-all-diffs))
-     ((eq last-command-char ?h)
-      (setq ediff-skip-diff-region-function ediff-hide-regexp-matches-function
-	    regexp-A 
-	    (read-string
-	     (format 
-	      "Ignore A-regions matching this regexp (default \"%s\"): "
-	      ediff-regexp-hide-A))
-	    regexp-B
-	    (read-string
-	     (format 
-	      "Ignore B-regions matching this regexp (default \"%s\"): "
-	      ediff-regexp-hide-B)))
-      (if ediff-3way-comparison-job
-	  (setq regexp-C
-		(read-string
-		 (format 
-		  "Ignore C-regions matching this regexp (default \"%s\"): "
-		  ediff-regexp-hide-C))))
-      (if (eq ediff-hide-regexp-connective 'and)
-	  (setq msg-connective "BOTH"
-		alt-msg-connective "ONE OF"
-		alt-connective 'or)
-	(setq msg-connective "ONE OF"
-	      alt-msg-connective "BOTH"
-	      alt-connective 'and))
-      (if (y-or-n-p
-	   (format
-	    "Ignore regions that match %s regexps, OK? "
-	    msg-connective alt-msg-connective))
-	  (message "Will ignore regions that match %s regexps" msg-connective)
-	(setq ediff-hide-regexp-connective alt-connective)
-	(message "Will ignore regions that match %s regexps"
-		 alt-msg-connective)) 
-
-      (or (string= regexp-A "") (setq ediff-regexp-hide-A regexp-A))
-      (or (string= regexp-B "") (setq ediff-regexp-hide-B regexp-B))
-      (or (string= regexp-C "") (setq ediff-regexp-hide-C regexp-C)))
-
-     ((eq last-command-char ?f)
-      (setq ediff-skip-diff-region-function
-	    ediff-focus-on-regexp-matches-function
-	    regexp-A 
-	    (read-string
-	     (format 
-	      "Focus on A-regions matching this regexp (default \"%s\"): "
-	      ediff-regexp-focus-A))
-	    regexp-B
-	    (read-string
-	     (format 
-	      "Focus on B-regions matching this regexp (default \"%s\"): "
-	      ediff-regexp-focus-B)))
-      (if ediff-3way-comparison-job
-	  (setq regexp-C
-		(read-string
-		 (format 
-		  "Focus on C-regions matching this regexp (default \"%s\"): "
-		  ediff-regexp-focus-C))))
-      (if (eq ediff-focus-regexp-connective 'and)
-	  (setq msg-connective "BOTH"
-		alt-msg-connective "ONE OF"
-		alt-connective 'or)
-	(setq msg-connective "ONE OF"
-	      alt-msg-connective "BOTH"
-	      alt-connective 'and))
-      (if (y-or-n-p
-	   (format
-	    "Focus on regions that match %s regexps, OK? "
-	    msg-connective alt-msg-connective))
-	  (message "Will focus on regions that match %s regexps"
-		   msg-connective)
-	(setq ediff-focus-regexp-connective alt-connective)
-	(message "Will focus on regions that match %s regexps" 
-		 alt-msg-connective))
-
-      (or (string= regexp-A "") (setq ediff-regexp-focus-A regexp-A))
-      (or (string= regexp-B "") (setq ediff-regexp-focus-B regexp-B))
-      (or (string= regexp-C "") (setq ediff-regexp-focus-C regexp-C))))))
-      
-(defun ediff-toggle-skip-similar ()
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (if (not (eq ediff-auto-refine 'on))
-      (error
-       "Can't skip over whitespace regions: first turn auto-refining on"))
-  (setq ediff-ignore-similar-regions (not ediff-ignore-similar-regions))
-  (if ediff-ignore-similar-regions
-      (message
-       "Skipping regions that differ only in white space & line breaks")
-    (message "Skipping over white-space differences turned off")))
-  
-(defun ediff-focus-on-regexp-matches (n)
-  "Focus on diffs that match regexp `ediff-regexp-focus-A/B'.
-Regions to be ignored according to this function are those where   
-buf A region doesn't match `ediff-regexp-focus-A' and buf B region
-doesn't match `ediff-regexp-focus-B'.
-This function returns nil if the region number N (specified as
-an argument) is not to be ignored and t if region N is to be ignored.
-
-N is a region number used by Ediff internally. It is 1 less
-the number seen by the user."
-  (if (ediff-valid-difference-p n)
-      (let* ((ctl-buf ediff-control-buffer)
-	     (regex-A ediff-regexp-focus-A)
-	     (regex-B ediff-regexp-focus-B)
-	     (regex-C ediff-regexp-focus-C)
-	     (reg-A-match (ediff-eval-in-buffer ediff-buffer-A
-			    (save-restriction
-			      (narrow-to-region
-			       (ediff-get-diff-posn 'A 'beg n ctl-buf)
-			       (ediff-get-diff-posn 'A 'end n ctl-buf))
-			      (goto-char (point-min))
-			      (re-search-forward regex-A nil t))))
-	     (reg-B-match (ediff-eval-in-buffer ediff-buffer-B
-			    (save-restriction
-			      (narrow-to-region
-			       (ediff-get-diff-posn 'B 'beg n ctl-buf)
-			       (ediff-get-diff-posn 'B 'end n ctl-buf))
-			      (re-search-forward regex-B nil t))))
-	     (reg-C-match (if ediff-3way-comparison-job
-			      (ediff-eval-in-buffer ediff-buffer-C
-				(save-restriction
-				  (narrow-to-region
-				   (ediff-get-diff-posn 'C 'beg n ctl-buf)
-				   (ediff-get-diff-posn 'C 'end n ctl-buf))
-				  (re-search-forward regex-C nil t))))))
-	(not (eval (if ediff-3way-comparison-job
-		       (list ediff-focus-regexp-connective
-			     reg-A-match reg-B-match reg-C-match)
-		     (list ediff-focus-regexp-connective
-			   reg-A-match reg-B-match))))
-	)))
-  
-(defun ediff-hide-regexp-matches (n)  
-  "Hide diffs that match regexp `ediff-regexp-hide-A/B/C'.
-Regions to be ignored are those where buf A region matches
-`ediff-regexp-hide-A' and buf B region matches `ediff-regexp-hide-B'.
-This function returns nil if the region number N (specified as
-an argument) is not to be ignored and t if region N is to be ignored.
-
-N is a region number used by Ediff internally. It is 1 less
-the number seen by the user."
-  (if (ediff-valid-difference-p n)
-      (let* ((ctl-buf ediff-control-buffer)
-	     (regex-A ediff-regexp-hide-A)
-	     (regex-B ediff-regexp-hide-B)
-	     (regex-C ediff-regexp-hide-C)
-	     (reg-A-match (ediff-eval-in-buffer ediff-buffer-A
-			    (save-restriction
-			      (narrow-to-region
-			       (ediff-get-diff-posn 'A 'beg n ctl-buf)
-			       (ediff-get-diff-posn 'A 'end n ctl-buf))
-			      (goto-char (point-min))
-			      (re-search-forward regex-A nil t))))
-	     (reg-B-match (ediff-eval-in-buffer ediff-buffer-B
-			    (save-restriction
-			      (narrow-to-region
-			       (ediff-get-diff-posn 'B 'beg n ctl-buf)
-			       (ediff-get-diff-posn 'B 'end n ctl-buf))
-			      (goto-char (point-min))
-			      (re-search-forward regex-B nil t))))
-	     (reg-C-match (if ediff-3way-comparison-job
-			      (ediff-eval-in-buffer ediff-buffer-C
-				(save-restriction
-				  (narrow-to-region
-				   (ediff-get-diff-posn 'C 'beg n ctl-buf)
-				   (ediff-get-diff-posn 'C 'end n ctl-buf))
-				  (goto-char (point-min))
-				  (re-search-forward regex-C nil t))))))
-	(eval (if ediff-3way-comparison-job
-		  (list ediff-hide-regexp-connective
-			reg-A-match reg-B-match reg-C-match)
-		(list ediff-hide-regexp-connective reg-A-match reg-B-match)))
-	)))
-    
-
-
-;;; Quitting, suspending, etc.
-
-(defun ediff-quit (reverse-default-keep-variants)
-  "Finish an Ediff session and exit Ediff.
-Unselects the selected difference, if any, restores the read-only and modified
-flags of the compared file buffers, kills Ediff buffers for this session
-\(but not buffers A, B, C\).
-
-If `ediff-keep-variants' is nil, the user will be asked whether the buffers
-containing the variants should be removed \(if they haven't been modified\). 
-If it is t, they will be preserved unconditionally. A prefix argument, 
-temporarily reverses the meaning of this variable."
-  (interactive "P")
-  (ediff-barf-if-not-control-buffer)
-  (if (y-or-n-p (format "Quit this Ediff session%s? "
-			(if (ediff-buffer-live-p ediff-meta-buffer)
-			    " & show containing session group" "")))
-      (progn
-	(message "")
-	(ediff-really-quit reverse-default-keep-variants))
-    (message "")))
-
-
-;; Perform the quit operations.
-(defun ediff-really-quit (reverse-default-keep-variants)
-  (ediff-unhighlight-diffs-totally)
-  (ediff-clear-diff-vector 'ediff-difference-vector-A 'fine-diffs-also)
-  (ediff-clear-diff-vector 'ediff-difference-vector-B 'fine-diffs-also)
-  (ediff-clear-diff-vector 'ediff-difference-vector-C 'fine-diffs-also)
-  (ediff-clear-diff-vector 'ediff-difference-vector-Ancestor 'fine-diffs-also)
-
-  (ediff-delete-temp-files)
-				  
-  ;; Restore visibility range. This affects only ediff-*-regions/windows.
-  ;; Since for other job names ediff-visible-region sets
-  ;; ediff-visible-bounds to ediff-wide-bounds, the settings below are
-  ;; ignored for such jobs.
-  (if ediff-quit-widened
-      (setq ediff-visible-bounds ediff-wide-bounds)
-    (setq ediff-visible-bounds ediff-narrow-bounds))
-  
-  ;; Apply selective display to narrow or widen
-  (ediff-visible-region)
-  (mapcar (function (lambda (overl)
-		      (if (ediff-overlayp overl)
-			  (ediff-delete-overlay overl))))
-	  ediff-wide-bounds)
-  (mapcar (function (lambda (overl)
-		      (if (ediff-overlayp overl)
-			  (ediff-delete-overlay overl))))
-	  ediff-narrow-bounds)
-
-  ;; restore buffer mode line id's in buffer-A/B/C
-  (let ((control-buffer ediff-control-buffer)
-	(meta-buffer ediff-meta-buffer)
-	;; suitable working frame
-	(warp-frame (if (and (ediff-window-display-p) (eq ediff-grab-mouse t))
-			(cond ((window-live-p ediff-window-A) 
-			       (window-frame ediff-window-A))
-			      ((window-live-p ediff-window-B) 
-			       (window-frame ediff-window-B))
-			      (t (next-frame))))))
-    (condition-case nil
-	(ediff-eval-in-buffer ediff-buffer-A
-	  (setq ediff-this-buffer-ediff-sessions 
-		(delq control-buffer ediff-this-buffer-ediff-sessions))
-	  (kill-local-variable 'mode-line-buffer-identification)
-	  (kill-local-variable 'mode-line-format)
-	  )
-      (error))
-      
-    (condition-case nil
-	(ediff-eval-in-buffer ediff-buffer-B
-	  (setq ediff-this-buffer-ediff-sessions 
-		(delq control-buffer ediff-this-buffer-ediff-sessions))
-	  (kill-local-variable 'mode-line-buffer-identification)
-	  (kill-local-variable 'mode-line-format)
-	  )
-      (error))
-    
-    (condition-case nil
-	(ediff-eval-in-buffer ediff-buffer-C
-	  (setq ediff-this-buffer-ediff-sessions 
-		(delq control-buffer ediff-this-buffer-ediff-sessions))
-	  (kill-local-variable 'mode-line-buffer-identification)
-	  (kill-local-variable 'mode-line-format)
-	  )
-      (error))
-
-    (condition-case nil
-	(ediff-eval-in-buffer ediff-ancestor-buffer
-	  (setq ediff-this-buffer-ediff-sessions 
-		(delq control-buffer ediff-this-buffer-ediff-sessions))
-	  (kill-local-variable 'mode-line-buffer-identification)
-	  (kill-local-variable 'mode-line-format)
-	  )
-      (error))
-
-  (setq ediff-session-registry
-	(delq ediff-control-buffer ediff-session-registry))
-  (ediff-update-registry)
-  ;; restore state of buffers to what it was before ediff
-  (ediff-restore-protected-variables)
-
-  ;; If the user interrupts (canceling saving the merge buffer), continue
-  ;; normally.
-  (condition-case nil
-      (if (ediff-merge-job)
-	  (run-hooks 'ediff-quit-merge-hook))
-    (quit))
-
-  ;; good place to kill buffers A/B/C
-  (run-hooks 'ediff-cleanup-hook)
-  (let ((ediff-keep-variants ediff-keep-variants))
-    (if reverse-default-keep-variants
-	(setq ediff-keep-variants (not ediff-keep-variants)))
-    (or ediff-keep-variants (ediff-janitor 'ask)))
-
-  (run-hooks 'ediff-quit-hook)
-  (ediff-cleanup-meta-buffer meta-buffer)
-
-  ;; warp mouse into a working window
-  (setq warp-frame  ; if mouse is over a reasonable frame, use it
-	(cond ((and ediff-xemacs-p (window-live-p (car (mouse-position))))
-	       (window-frame (car (mouse-position))))
-	      ((frame-live-p (car (mouse-position)))
-	       (car (mouse-position)))
-	      (t warp-frame)))
-  (if (frame-live-p warp-frame)
-      (set-mouse-position (if ediff-emacs-p
-			      warp-frame
-			    (frame-selected-window warp-frame))
-			  2 1))
-
-  (if (ediff-buffer-live-p meta-buffer)
-      (ediff-show-meta-buffer meta-buffer))
-  ))
-  
-  
-(defun ediff-delete-temp-files ()
-  (if (stringp ediff-temp-file-A)
-      (delete-file ediff-temp-file-A))
-  (if (stringp ediff-temp-file-B)
-      (delete-file ediff-temp-file-B))
-  (if (stringp ediff-temp-file-C)
-      (delete-file ediff-temp-file-C)))
-  
-
-;; Kill control buffer, other auxiliary Ediff buffers.
-;; Leave one of the frames split between buffers A/B/C
-(defun ediff-cleanup-mess ()
-  (let ((buff-A ediff-buffer-A)
-	(buff-B ediff-buffer-B)
-	(buff-C ediff-buffer-C)
-	(ctl-buf  ediff-control-buffer)
-	(ctl-frame ediff-control-frame)
-	(three-way-job ediff-3way-job))
-	
-    (ediff-kill-buffer-carefully ediff-diff-buffer)
-    (ediff-kill-buffer-carefully ediff-custom-diff-buffer)
-    (ediff-kill-buffer-carefully ediff-fine-diff-buffer)
-    (ediff-kill-buffer-carefully ediff-tmp-buffer)
-    (ediff-kill-buffer-carefully ediff-error-buffer)
-    (ediff-kill-buffer-carefully ediff-patch-diagnostics)
-    (ediff-kill-buffer-carefully ediff-msg-buffer)
-    (ediff-kill-buffer-carefully ediff-debug-buffer)
-
-    (if (and (ediff-window-display-p) (frame-live-p ctl-frame))
-	(delete-frame ctl-frame))
-    ;; Hide bottom toolbar.  --marcpa
-    (if (not (ediff-multiframe-setup-p))
-	(ediff-kill-bottom-toolbar))
-
-    (ediff-kill-buffer-carefully ctl-buf)
-      
-    (delete-other-windows)
-    
-    ;; display only if not visible
-    (condition-case nil
-	(or (ediff-get-visible-buffer-window buff-B)
-	    (switch-to-buffer buff-B))
-      (error))
-    (condition-case nil
-	(or (ediff-get-visible-buffer-window buff-A)
-	    (progn
-	      (if (ediff-get-visible-buffer-window buff-B)
-		  (funcall ediff-split-window-function))
-	      (switch-to-buffer buff-A)))
-      (error))
-    (if three-way-job
-	(condition-case nil
-	    (or (ediff-get-visible-buffer-window buff-C)
-		(progn
-		  (if (or (ediff-get-visible-buffer-window buff-A)
-			  (ediff-get-visible-buffer-window buff-B))
-		      (funcall ediff-split-window-function))
-		  (switch-to-buffer buff-C)
-		  (balance-windows)))
-	  (error)))
-    (message "")
-    ))
-
-(defun ediff-janitor (&optional ask)
-  "Kill buffers A, B, and, possibly, C, if these buffers aren't modified.
-In merge jobs, buffer C is never deleted.
-However, the side effect of cleaning up may be that you cannot compare the same
-buffer in two separate Ediff sessions: quitting one of them will delete this
-buffer in another session as well."
-  (or (not (ediff-buffer-live-p ediff-buffer-A))
-      (buffer-modified-p ediff-buffer-A)
-      (and ask
-	   (not (y-or-n-p (format "Kill buffer A [%s]? "
-				  (buffer-name ediff-buffer-A)))))
-      (ediff-kill-buffer-carefully ediff-buffer-A))
-  (or (not (ediff-buffer-live-p ediff-buffer-B))
-      (buffer-modified-p ediff-buffer-B)
-      (and ask
-	   (not (y-or-n-p (format "Kill buffer B [%s]? "
-				  (buffer-name ediff-buffer-B)))))
-      (ediff-kill-buffer-carefully ediff-buffer-B))
-  (if ediff-merge-job  ; don't del buf C if merging--del ancestor buf instead
-      (or (not (ediff-buffer-live-p ediff-ancestor-buffer))
-	  (buffer-modified-p ediff-ancestor-buffer)
-	  (and ask
-	       (not (y-or-n-p (format "Kill the ancestor buffer [%s]? "
-				      (buffer-name ediff-ancestor-buffer)))))
-	  (ediff-kill-buffer-carefully ediff-ancestor-buffer))
-    (or (not (ediff-buffer-live-p ediff-buffer-C))
-	(buffer-modified-p ediff-buffer-C)
-	(and ask (not (y-or-n-p (format "Kill buffer C [%s]? "
-					(buffer-name ediff-buffer-C)))))
-	(ediff-kill-buffer-carefully ediff-buffer-C))))
-
-(defun ediff-maybe-save-and-delete-merge ()
-  "Default hook to run on quitting a merge job.
-If `ediff-autostore-merges' is nil, this does nothing.
-If it is t, it saves the merge buffer in the file `ediff-merge-store-file'
-or asks the user, if the latter is nil. It then then asks the user whether to
-delete the merge buffer.
-If `ediff-autostore-merges' is neither nil nor t, the merge buffer is saved
-only if this merge job is part of a group, i.e., was invoked from within
-`ediff-merge-directories', `ediff-merge-directory-revisions', and such."
-  (let ((merge-store-file ediff-merge-store-file))
-    (if ediff-autostore-merges
-	(cond ((stringp ediff-merge-store-file)
-	       ;; store, ask to delete
-	       (ediff-write-merge-buffer-then-kill
-		ediff-buffer-C merge-store-file 'show-file))
-	      ((eq ediff-autostore-merges t)
-	       ;; ask for file name
-	       (setq merge-store-file
-		     (read-file-name "Save the result of the merge in: "))
-	       (ediff-write-merge-buffer-then-kill
-		ediff-buffer-C merge-store-file))
-	      ((and (ediff-buffer-live-p ediff-meta-buffer)
-		    (ediff-eval-in-buffer ediff-meta-buffer
-		      (ediff-merge-metajob)))
-	       ;; This case shouldn't occur, as the parent metajob must pass on
-	       ;; a file name, ediff-merge-store-file, where to save the result
-	       ;; of the merge.
-	       ;; Ask where to save anyway--will decide what to do here later.
-	       (setq merge-store-file
-		     (read-file-name "The result of the merge goes into: "))
-	       (ediff-write-merge-buffer-then-kill
-		ediff-buffer-C merge-store-file))))
-    ))
-
-(defun ediff-write-merge-buffer-then-kill (buf file &optional show-file)
-  (ediff-eval-in-buffer buf
-    (if (or (not (file-exists-p file))
-	    (y-or-n-p (format "File %s exists, overwrite? " file)))
-	(progn
-	  (write-region (point-min) (point-max) file)
-	  (if show-file
-	      (progn
-		(message "Merge buffer saved in: %s" file)
-		(sit-for 2)))
-	  (if (y-or-n-p "Merge buffer saved in file. Now kill the buffer? ")
-	      (ediff-kill-buffer-carefully buf))))))
-
-;; The default way of suspending Ediff.
-;; Buries Ediff buffers, kills all windows.
-(defun ediff-default-suspend-function ()
-  (let* ((buf-A ediff-buffer-A)
-	 (buf-B ediff-buffer-B)
-	 (buf-C ediff-buffer-C)
-	 (buf-A-wind (ediff-get-visible-buffer-window buf-A))
-	 (buf-B-wind (ediff-get-visible-buffer-window buf-B))
-	 (buf-C-wind (ediff-get-visible-buffer-window buf-C))
-	 (buf-patch  ediff-patchbufer)
-	 (buf-patch-diag ediff-patch-diagnostics)
-	 (buf-err  ediff-error-buffer)
-	 (buf-diff ediff-diff-buffer)
-	 (buf-custom-diff ediff-custom-diff-buffer)
-	 (buf-fine-diff ediff-fine-diff-buffer))
-    
-    ;; hide the control panel
-    (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame))
-	(iconify-frame ediff-control-frame)
-      (bury-buffer)) 
-    (if buf-err (bury-buffer buf-err))
-    (if buf-diff (bury-buffer buf-diff))
-    (if buf-custom-diff (bury-buffer buf-custom-diff))
-    (if buf-fine-diff (bury-buffer buf-fine-diff))
-    (if buf-patch (bury-buffer buf-patch))
-    (if buf-patch-diag (bury-buffer buf-patch-diag))
-    (if (window-live-p buf-A-wind)
-	(progn
-	  (select-window buf-A-wind)
-	  (delete-other-windows)
-	  (bury-buffer))
-      (if (ediff-buffer-live-p buf-A) (bury-buffer buf-A)))
-    (if (window-live-p buf-B-wind)
-	(progn
-	  (select-window buf-B-wind)
-	  (delete-other-windows)
-	  (bury-buffer))
-      (if (ediff-buffer-live-p buf-B) (bury-buffer buf-B)))
-    (if (window-live-p buf-C-wind)
-	(progn
-	  (select-window buf-C-wind)
-	  (delete-other-windows)
-	  (bury-buffer))
-      (if (ediff-buffer-live-p buf-C) (bury-buffer buf-C)))
-
-    ))
-
-     
-(defun ediff-suspend ()
-  "Suspend Ediff.
-To resume, switch to the appropriate `Ediff Control Panel'
-buffer and then type \\[ediff-recenter].  Ediff will automatically set
-up an appropriate window config."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (run-hooks 'ediff-suspend-hook)
-  (message
-   "To resume, type M-x eregistry and select the desired Ediff session"))
-
-
-(defun ediff-status-info ()
-  "Show the names of the buffers or files being operated on by Ediff.
-Hit \\[ediff-recenter] to reset the windows afterward."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (save-excursion
-    (ediff-skip-unsuitable-frames))
-  (with-output-to-temp-buffer ediff-msg-buffer
-    (raise-frame (selected-frame))
-    (princ (ediff-version))
-    (princ "\n\n")
-    (ediff-eval-in-buffer ediff-buffer-A
-      (if buffer-file-name
-	  (princ
-	   (format "File A = %S\n" buffer-file-name))
-	(princ 
-	 (format "Buffer A = %S\n" (buffer-name)))))
-    (ediff-eval-in-buffer ediff-buffer-B
-      (if buffer-file-name
-	  (princ
-	   (format "File B = %S\n" buffer-file-name))
-	(princ 
-	 (format "Buffer B = %S\n" (buffer-name)))))
-    (if ediff-3way-job
-	(ediff-eval-in-buffer ediff-buffer-C
-	  (if buffer-file-name
-	      (princ
-	       (format "File C = %S\n" buffer-file-name))
-	    (princ 
-	     (format "Buffer C = %S\n" (buffer-name))))))
-    (princ (format "Customized diff output %s\n"
-		   (if (ediff-buffer-live-p ediff-custom-diff-buffer)
-		       (concat "\tin buffer "
-			       (buffer-name ediff-custom-diff-buffer))
-		     "is not available")))
-    (princ (format "Plain diff output %s\n"
-		   (if (ediff-buffer-live-p ediff-diff-buffer)
-		       (concat "\tin buffer "
-			       (buffer-name ediff-diff-buffer))
-		     "is not available")))
-			      
-    (let* ((A-line (ediff-eval-in-buffer ediff-buffer-A
-		     (1+ (count-lines (point-min) (point)))))
-	   (B-line (ediff-eval-in-buffer ediff-buffer-B
-		     (1+ (count-lines (point-min) (point)))))
-	   C-line)
-      (princ (format "\Buffer A's point is on line %d\n" A-line))
-      (princ (format "Buffer B's point is on line %d\n" B-line))
-      (if ediff-3way-job
-	  (progn
-	    (setq C-line (ediff-eval-in-buffer ediff-buffer-C
-			   (1+ (count-lines (point-min) (point)))))
-	    (princ (format "Buffer C's point is on line %d\n" C-line)))))
-      
-    (princ (format "\nCurrent difference number = %S\n"
-		   (cond ((< ediff-current-difference 0) 'start)
-			 ((>= ediff-current-difference
-			      ediff-number-of-differences) 'end)
-			 (t (1+ ediff-current-difference)))))
-
-    (princ
-     (format "\n%s regions that differ only in white space & line breaks"
-	     (if ediff-ignore-similar-regions
-		 "Skipping" "Not skipping")))
-    (if (and ediff-merge-job ediff-show-clashes-only)
-	(princ
-	 "\nFocusing on regions where both buffers differ from the ancestor"))
-    
-    (cond ((eq ediff-skip-diff-region-function 'ediff-show-all-diffs)
-	   (princ "\nSelective browsing by regexp is off\n"))
-	  ((eq ediff-skip-diff-region-function
-	       ediff-hide-regexp-matches-function)
-	   (princ
-	    "\nIgnoring regions that match")
-	   (princ
-	    (format 
-	     "\n\t regexp `%s' in buffer A  %S\n\t regexp `%s' in buffer B\n"
-	     ediff-regexp-hide-A ediff-hide-regexp-connective
-	     ediff-regexp-hide-B)))
-	  ((eq ediff-skip-diff-region-function
-	       ediff-focus-on-regexp-matches-function)
-	   (princ
-	    "\nFocusing on regions that match")
-	   (princ
-	    (format
-	     "\n\t regexp `%s' in buffer A  %S\n\t regexp `%s' in buffer B\n"
-	     ediff-regexp-focus-A ediff-focus-regexp-connective
-	     ediff-regexp-focus-B)))
-	  (t (princ "\nSelective browsing via a user-defined method.\n")))
-    
-    (princ
-     (format "\nBugs/suggestions: type `%s' while in Ediff Control Panel."
-	     (substitute-command-keys "\\[ediff-submit-report]")))
-    ) ; with output
-  (if (frame-live-p ediff-control-frame)
-      (ediff-reset-mouse ediff-control-frame))
-  (if (window-live-p ediff-control-window)
-      (select-window ediff-control-window)))
-    
-
-
-
-;;; Support routines
-
-;; Select a difference by placing the ASCII flags around the appropriate
-;; group of lines in the A, B buffers
-;; This may have to be modified for buffer C, when it will be supported.
-(defun ediff-select-difference (n)
-  (if (and (ediff-buffer-live-p ediff-buffer-A)
-	   (ediff-buffer-live-p ediff-buffer-B)
-	   (ediff-valid-difference-p n))
-      (progn
-	(if (and (ediff-has-face-support-p) ediff-use-faces)
-	    (progn
-	      (ediff-highlight-diff n)
-	      (setq ediff-highlighting-style 'face))
-	  (setq ediff-highlighting-style 'ascii)
-	  (ediff-place-flags-in-buffer
-	   'A ediff-buffer-A ediff-control-buffer n)
-	  (ediff-place-flags-in-buffer
-	   'B ediff-buffer-B ediff-control-buffer n)
-	  (if ediff-3way-job
-	      (ediff-place-flags-in-buffer
-	       'C ediff-buffer-C ediff-control-buffer n))
-	  (if (ediff-buffer-live-p ediff-ancestor-buffer)
-	      (ediff-place-flags-in-buffer
-	       'Ancestor ediff-ancestor-buffer
-	       ediff-control-buffer n))
-	  ) 
-				       
-	(ediff-install-fine-diff-if-necessary n)
-	(run-hooks 'ediff-select-hook))))
-	
-
-;; Unselect a difference by removing the ASCII flags in the buffers.
-;; This may have to be modified for buffer C, when it will be supported.
-(defun ediff-unselect-difference (n)
-  (if (ediff-valid-difference-p n)
-      (progn 
-	(cond ((and (ediff-has-face-support-p) ediff-use-faces)
-	       (ediff-unhighlight-diff))
-	      ((eq ediff-highlighting-style 'ascii)
-	       (ediff-remove-flags-from-buffer
-		ediff-buffer-A
-		(ediff-get-diff-overlay n 'A))
-	       (ediff-remove-flags-from-buffer
-		ediff-buffer-B
-		(ediff-get-diff-overlay n 'B))
-	       (if ediff-3way-job
-		   (ediff-remove-flags-from-buffer
-		    ediff-buffer-C
-		    (ediff-get-diff-overlay n 'C)))
-	       (if (ediff-buffer-live-p ediff-ancestor-buffer)
-		   (ediff-remove-flags-from-buffer
-		    ediff-ancestor-buffer
-		    (ediff-get-diff-overlay n 'Ancestor)))
-	       ))
-	(setq ediff-highlighting-style nil)
-	
-	;; unhighlight fine diffs
-	(ediff-set-fine-diff-properties ediff-current-difference 'default)
-	(run-hooks 'ediff-unselect-hook))))
-  
-
-;; Unselects prev diff and selects a new one, if FLAG has value other than
-;; 'select-only or 'unselect-only.  If FLAG is 'select-only, the
-;; next difference is selected, but the current selection is not
-;; unselected.  If FLAG is 'unselect-only then the current selection is
-;; unselected, but the next one is not selected.  If NO-RECENTER is non-nil,
-;; don't recenter buffers after selecting/unselecting.
-(defun ediff-unselect-and-select-difference (n &optional flag no-recenter)
-  (let ((ediff-current-difference n))
-    (or no-recenter
-	(ediff-recenter 'no-rehighlight)))
-	  
-  (let ((control-buf ediff-control-buffer))
-    (unwind-protect    
-	(progn
-	  (or (eq flag 'select-only)
-	      (ediff-unselect-difference ediff-current-difference))
-	  
-	  (or (eq flag 'unselect-only)
-	      (ediff-select-difference n))
-	  (setq ediff-current-difference n)
-	  ) ; end protected section
-      
-      (ediff-eval-in-buffer control-buf (ediff-refresh-mode-lines))
-      )))
-
-
-(defun ediff-read-file-name (prompt default-dir default-file)
-; This is a modified version of a similar function in `emerge.el'.
-; PROMPT should not have trailing ': ', so that it can be modified
-; according to context.
-; If default-file is set, it should be used as the default value.
-; If default-dir is non-nil, use it as the default directory.
-; Otherwise, use the value of Emacs' variable `default-directory.'
-
-  ;; hack default-dir if it is not set
-  (setq default-dir
-	(file-name-as-directory
-	 (ediff-abbreviate-file-name
-	  (expand-file-name (or default-dir
-				(and default-file
-				     (file-name-directory default-file))
-				default-directory)))))
-
-  ;; strip the directory from default-file
-  (if default-file
-      (setq default-file (file-name-nondirectory default-file)))
-  (if (string= default-file "")
-      (setq default-file nil))
-
-  (let (f)
-    (setq f (expand-file-name
-	     (read-file-name
-	      (format "%s%s "
-		      prompt
-		      (cond (default-file
-			      (concat " (default " default-file "):"))
-			    (t (concat " (default " default-dir "):"))))
-	      default-dir
-	      (or default-file default-dir)
-	      t  ; must match, no-confirm
-	      (if default-file (file-name-directory default-file))
-	      )
-	     default-dir
-	     ))
-    ;; If user enters a directory name, expand the default file in that
-    ;; directory.  This allows the user to enter a directory name for the
-    ;; B-file and diff against the default-file in that directory instead
-    ;; of a DIRED listing!
-    (if (and (file-directory-p f) default-file)
-	(setq f (expand-file-name
-		 (file-name-nondirectory default-file) f)))
-    f)) 
-  
-;; If PREFIX is given, then it is used as a prefix for the temp file
-;; name. Otherwise, `ediff_' is used. If FILE is given, use this
-;; file and don't create a new one.
-;; On MS-DOS, make sure the prefix isn't longer than 7 characters, or
-;; else `make-temp-name' isn't guaranteed to return a unique filename.
-;; Also, save buffer from START to END in the file.
-;; START defaults to (point-min), END to (point-max)
-(defun ediff-make-temp-file (buff &optional prefix given-file start end)
-  (let ((p (or prefix "ediff"))
-	f)
-    (if (and (eq system-type 'ms-dos) (> (length p) 7))
-	(setq p (substring p 0 7)))
-
-    (setq f (concat ediff-temp-file-prefix p)
-	  f (cond (given-file)
-		  ((find-file-name-handler f 'find-file-noselect)
-		   ;; to thwart file handlers in write-region, e.g., if file
-		   ;; name ends with .Z or .gz
-		   ;; This is needed so that patches produced by ediff will
-		   ;; have more meaningful names
-		   (make-temp-name f))
-		  ;; Prefix is most often the same as the file name for the
-		  ;; variant. Here we are trying to use the original file name
-		  ;; but in the temp directory.
-		  ((and prefix (not (file-exists-p f))) f)
-		  ;; If a file with the orig name exists, add some random stuff
-		  ;; to it.
-		  (t (make-temp-name f))))
-    
-    ;; create the file
-    (ediff-eval-in-buffer buff
-      (write-region (if start start (point-min))
-		    (if end end (point-max))
-		    f
-		    nil          ; don't append---erase
-		    'no-message) 
-      (set-file-modes f ediff-temp-file-mode)
-      (ediff-convert-standard-filename (expand-file-name f)))))
-
-;; Quote metacharacters (using \) when executing diff in Unix, but not in
-;; EMX OS/2
-;;(defun ediff-protect-metachars (str)
-;;  (or (memq system-type '(emx vax-vms axp-vms))
-;;      (let ((limit 0))
-;;	(while (string-match ediff-metachars str limit)
-;;	  (setq str (concat (substring str 0 (match-beginning 0))
-;;			    "\\"
-;;			    (substring str (match-beginning 0))))
-;;	  (setq limit (1+ (match-end 0))))))
-;;  str)
-
-;; Make sure the current buffer (for a file) has the same contents as the
-;; file on disk, and attempt to remedy the situation if not.
-;; Signal an error if we can't make them the same, or the user doesn't want
-;; to do what is necessary to make them the same.
-;; Also, Ediff always offers to revert obsolete buffers, whether they
-;; are modified or not.
-(defun ediff-verify-file-buffer (&optional file-magic)
-  ;; First check if the file has been modified since the buffer visited it.
-  (if (verify-visited-file-modtime (current-buffer))
-      (if (buffer-modified-p)
-	  ;; If buffer is not obsolete and is modified, offer to save
-	  (if (yes-or-no-p 
-	       (format "Buffer out of sync with visited file. Save file %s? "
-		       buffer-file-name))
-	      (condition-case nil
-		  (save-buffer)
-		(error
-		 (beep)
-		 (message "Couldn't save %s" buffer-file-name)))
-	    (error "Buffer is out of sync for file %s" buffer-file-name))
-	;; If buffer is not obsolete and is not modified, do nothing
-	nil)
-    ;; If buffer is obsolete, offer to revert
-    (if (yes-or-no-p
-	 (format "Buffer is out of sync with visited file. REVERT file %s? "
-		 buffer-file-name))
-	(progn
-	  (if file-magic
-	      (erase-buffer))
-	  (revert-buffer t t))
-      (error "Buffer out of sync for file %s" buffer-file-name))))
-
-
-(defun ediff-save-buffer (arg)
-  "Safe way of saving buffers A, B, C, and the diff output.
-`wa' saves buffer A, `wb' saves buffer B, `wc' saves buffer C,
-and `wd' saves the diff output.
-
-With prefix argument, `wd' saves plain diff output.
-Without an argument, it saves customized diff argument, if available
-\(and plain output, if customized output was not generated\)."
-  (interactive "P")
-  (ediff-barf-if-not-control-buffer)
-  (ediff-compute-custom-diffs-maybe)
-  (ediff-eval-in-buffer
-      (cond ((memq last-command-char '(?a ?b ?c))
-	     (ediff-get-buffer
-	      (ediff-char-to-buftype last-command-char)))
-	    ((eq last-command-char ?d)
-	     (message "Saving diff output ...")
-	     (sit-for 1) ; let the user see the message
-	     (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer))
-		    ediff-diff-buffer)
-		   ((ediff-buffer-live-p ediff-custom-diff-buffer)
-		    ediff-custom-diff-buffer)
-		   ((ediff-buffer-live-p ediff-diff-buffer)
-		    ediff-diff-buffer)
-		   (t (error "Output from `diff' not found"))))
-	    )
-    (save-buffer)))
-
-(defun ediff-compute-custom-diffs-maybe ()
-  (let ((buf-A-file-name (buffer-file-name ediff-buffer-A))
-	(buf-B-file-name (buffer-file-name ediff-buffer-B))
-	file-A file-B)
-    (if (stringp buf-A-file-name)
-	(setq buf-A-file-name (file-name-nondirectory buf-A-file-name)))
-    (if (stringp buf-B-file-name)
-	(setq buf-B-file-name (file-name-nondirectory buf-B-file-name)))
-    (setq file-A (ediff-make-temp-file ediff-buffer-A buf-A-file-name)
-	  file-B (ediff-make-temp-file ediff-buffer-B buf-B-file-name))
-			 
-    (or (ediff-buffer-live-p ediff-custom-diff-buffer)
-	(setq ediff-custom-diff-buffer
-	      (get-buffer-create
-	       (ediff-unique-buffer-name "*ediff-custom-diff" "*"))))
-    (ediff-exec-process
-     ediff-custom-diff-program ediff-custom-diff-buffer 'synchronize
-     ediff-custom-diff-options file-A file-B)
-    (delete-file file-A)
-    (delete-file file-B)
-    ))
-
-(defun ediff-show-diff-output (arg)
-  (interactive "P")
-  (ediff-barf-if-not-control-buffer)
-  (ediff-compute-custom-diffs-maybe)
-  (save-excursion
-    (ediff-skip-unsuitable-frames ' ok-unsplittable))
-  (let ((buf (cond ((and arg (ediff-buffer-live-p ediff-diff-buffer))
-		    ediff-diff-buffer)
-		   ((ediff-buffer-live-p ediff-custom-diff-buffer)
-		    ediff-custom-diff-buffer)
-		   ((ediff-buffer-live-p ediff-diff-buffer)
-		    ediff-diff-buffer)
-		   (t
-		    (beep)
-		    (message "Output from `diff' not found")
-		    nil))))
-    (if buf
-	(progn
-	  (ediff-eval-in-buffer buf
-	    (goto-char (point-min)))
-	  (switch-to-buffer buf)
-	  (raise-frame (selected-frame)))))
-  (if (frame-live-p ediff-control-frame)
-      (ediff-reset-mouse ediff-control-frame))
-  (if (window-live-p ediff-control-window)
-      (select-window ediff-control-window)))
-
-
-(defun ediff-inferior-compare-regions ()
-  "Compare regions in an active Ediff session.
-Like ediff-regions-linewise but is called from under an active Ediff session on
-the files that belong to that session.
-
-After quitting the session invoked via this function, type C-l to the parent
-Ediff Control Panel to restore highlighting."
-  (interactive)
-  (let ((answer "")
-	(possibilities (list ?A ?B ?C))
-	(zmacs-regions t)
-	quit-now
-	begA begB endA endB bufA bufB)
-
-    (cond ((ediff-merge-job)
-	   (setq bufB ediff-buffer-C)
-	   (while (cond ((memq answer '(?A ?a))
-			 (setq bufA ediff-buffer-A)
-			 nil)
-			((memq answer '(?B ?b))
-			 (setq bufA ediff-buffer-B)
-			 nil)
-			((equal answer ""))
-			(t (beep 1)
-			   (message "Valid values are A or B")
-			   (sit-for 2)
-			   t))
-	     (let ((cursor-in-echo-area t))
-	       (message "Which buffer to compare to the merge buffer (A/B)? ")
-	       (setq answer (read-char-exclusive)))))
-
-	  ((ediff-3way-comparison-job)
-	   (while (cond ((memq answer possibilities)
-			 (setq possibilities (delq answer possibilities))
-			 (setq bufA
-			       (eval
-				(intern (format "ediff-buffer-%c" answer))))
-			 nil)
-			((equal answer ""))
-			(t (beep 1)
-			   (message 
-			    "Valid values are %s"
-			    (mapconcat 'char-to-string possibilities " or "))
-			   (sit-for 2)
-			   t))
-	     (let ((cursor-in-echo-area t))
-	       (message "Enter the 1st buffer you want to compare (%s): "
-			(mapconcat 'char-to-string possibilities "/"))
-	       (setq answer (capitalize (read-char-exclusive)))))
-	   (setq answer "") ; silence error msg
-	   (while (cond ((memq answer possibilities)
-			 (setq possibilities (delq answer possibilities))
-			 (setq bufB
-			       (eval
-				(intern (format "ediff-buffer-%c" answer))))
-			 nil)
-			((equal answer ""))
-			(t (beep 1)
-			   (message 
-			    "Valid values are %s"
-			    (mapconcat 'char-to-string possibilities " or "))
-			   (sit-for 2)
-			   t))
-	     (let ((cursor-in-echo-area t))
-	       (message "Enter the 2nd buffer you want to compare (%s): "
-			(mapconcat 'char-to-string possibilities "/"))
-	       (setq answer (capitalize (read-char-exclusive))))))
-	  (t ; 2way comparison
-	   (setq bufA ediff-buffer-A
-		 bufB ediff-buffer-B)))
-
-    (ediff-eval-in-buffer bufA
-      (or (mark t)
-	  (error "You forgot to specify a region in buffer %s" (buffer-name)))
-      (setq begA (region-beginning)
-	    endA (region-end))
-      (goto-char begA)
-      (beginning-of-line)
-      (setq begA (point))
-      (goto-char endA)
-      (end-of-line)
-      (or (eobp) (forward-char)) ; include the newline char
-      (setq endA (point)))
-    (ediff-eval-in-buffer bufB
-      (or (mark t)
-	  (error "You forgot to specify a region in buffer %s" (buffer-name)))
-      (setq begB (region-beginning)
-	    endB (region-end))
-      (goto-char begB)
-      (beginning-of-line)
-      (setq begB (point))
-      (goto-char endB)
-      (end-of-line)
-      (or (eobp) (forward-char)) ; include the newline char
-      (setq endB (point)))
-
-    (ediff-unselect-and-select-difference
-     ediff-current-difference 'unselect-only)
-    (ediff-paint-background-regions 'unhighlight)
-
-    (ediff-eval-in-buffer bufA
-      (goto-char begA)
-      (set-mark endA)
-      (narrow-to-region begA endA)
-      ;; (ediff-activate-mark)
-      )
-    ;; (sit-for 0)
-    (ediff-eval-in-buffer bufB
-      (goto-char begB)
-      (set-mark endB)
-      (narrow-to-region begB endB)
-      ;; (ediff-activate-mark)
-      )
-    ;; (sit-for 0)
-    
-    (or (y-or-n-p 
-	 "Please check the selected regions. Continue? ")
-	(setq quit-now t))
-    
-    (ediff-eval-in-buffer bufA
-      (widen))
-    (ediff-eval-in-buffer bufB
-      (widen))
-    (if quit-now
-	(error "Thank you. Come back another day..."))
-
-    (ediff-regions-internal
-     bufA begA endA bufB begB endB
-     nil  			; startup hook
-     'ediff-regions-linewise	; job name
-     nil)			; no word mode
-    ))
-      
-    
-
-(defun ediff-remove-flags-from-buffer (buffer overlay)
-  (ediff-eval-in-buffer buffer
-    (let ((inhibit-read-only t))
-      (if ediff-xemacs-p
-	  (ediff-overlay-put overlay 'begin-glyph nil)
-	(ediff-overlay-put overlay 'before-string nil))
-      
-      (if ediff-xemacs-p
-	  (ediff-overlay-put overlay 'end-glyph nil)
-	(ediff-overlay-put overlay 'after-string nil))
-      )))
-
-
-
-(defun ediff-place-flags-in-buffer (buf-type buffer ctl-buffer diff)
-  (ediff-eval-in-buffer buffer
-    (ediff-place-flags-in-buffer1 buf-type ctl-buffer diff)))
-
-
-(defun ediff-place-flags-in-buffer1 (buf-type ctl-buffer diff-no)
-  (let* ((curr-overl (ediff-eval-in-buffer ctl-buffer
-		       (ediff-get-diff-overlay diff-no buf-type)))
-	 (before (ediff-get-diff-posn buf-type 'beg diff-no ctl-buffer))
-	 after beg-of-line flag)
-	
-    ;; insert flag before the difference
-    (goto-char before)
-    (setq beg-of-line (bolp))
-    
-    (setq flag (ediff-eval-in-buffer ctl-buffer
-		 (if (eq ediff-highlighting-style 'ascii)
-		     (if beg-of-line
-			 ediff-before-flag-bol ediff-before-flag-mol))))
-    
-    ;; insert the flag itself
-    (if ediff-xemacs-p
-	(ediff-overlay-put curr-overl 'begin-glyph flag)
-      (ediff-overlay-put curr-overl 'before-string flag))
-    
-    ;; insert the flag after the difference
-    ;; `after' must be set here, after the before-flag was inserted
-    (setq after (ediff-get-diff-posn buf-type 'end diff-no ctl-buffer))
-    (goto-char after)
-    (setq beg-of-line (bolp))
-    
-    (setq flag (ediff-eval-in-buffer ctl-buffer
-		 (if (eq ediff-highlighting-style 'ascii)
-		     (if beg-of-line
-			 ediff-after-flag-eol ediff-after-flag-mol))))
-    
-    ;; insert the flag itself
-    (if ediff-xemacs-p
-	(ediff-overlay-put curr-overl 'end-glyph flag)
-      (ediff-overlay-put curr-overl 'after-string flag))
-    ))
-
-  
-;; Returns positions of difference sectors in the BUF-TYPE buffer.
-;; BUF-TYPE should be a symbol -- `A', `B', or `C'. 
-;; POS is either `beg' or `end'--it specifies whether you want the position at
-;; the beginning of a difference or at the end.
-;; 
-;; The optional argument N says which difference (default:
-;; `ediff-current-difference'). N is the internal difference number (1- what
-;; the user sees).  The optional argument CONTROL-BUF says
-;; which control buffer is in effect in case it is not the current
-;; buffer.
-(defun ediff-get-diff-posn (buf-type pos &optional n control-buf)
-  (let (diff-overlay)
-    (or control-buf
-	(setq control-buf (current-buffer)))
-
-    (ediff-eval-in-buffer control-buf
-      (or n  (setq n ediff-current-difference))
-      (if (or (< n 0) (>= n ediff-number-of-differences))
-	  (if (> ediff-number-of-differences 0)
-	      (error ediff-BAD-DIFF-NUMBER
-		     this-command (1+ n) ediff-number-of-differences)
-	    (error ediff-NO-DIFFERENCES)))
-      (setq diff-overlay (ediff-get-diff-overlay n buf-type)))
-    (if (not (ediff-buffer-live-p (ediff-overlay-buffer diff-overlay)))
-	(error ediff-KILLED-VITAL-BUFFER))
-    (if (eq pos 'beg)
-	(ediff-overlay-start diff-overlay)
-      (ediff-overlay-end diff-overlay))
-    ))
-
-
-;; Restore highlighting to what it should be according to ediff-use-faces,
-;; ediff-highlighting-style, and ediff-highlight-all-diffs variables.
-(defun ediff-restore-highlighting (&optional ctl-buf)
-  (ediff-eval-in-buffer (or ctl-buf (current-buffer))
-    (if (and (ediff-has-face-support-p) 
-	     ediff-use-faces
-	     ediff-highlight-all-diffs)
-	(ediff-paint-background-regions))
-    (ediff-select-difference ediff-current-difference)))
-
-
-    
-;; null out difference overlays so they won't slow down future
-;; editing operations
-;; VEC is either a difference vector or a fine-diff vector
-(defun ediff-clear-diff-vector (vec-var &optional fine-diffs-also)
-  (if (vectorp (symbol-value vec-var))
-      (mapcar (function
-	       (lambda (elt)
-		 (ediff-delete-overlay 
-		  (ediff-get-diff-overlay-from-diff-record elt))
-		 (if fine-diffs-also
-		     (ediff-clear-fine-diff-vector elt))
-		 ))
-	      (symbol-value vec-var)))
-  ;; allow them to be garbage collected
-  (set vec-var nil))
-
-       
-
-;;; Misc
-
-;; In Emacs, this just makes overlay. In the future, when Emacs will start
-;; supporting sticky overlays, this function will make a sticky overlay.
-;; BEG and END are expressions telling where overlay starts.
-;; If they are numbers or buffers, then all is well. Otherwise, they must
-;; be expressions to be evaluated in buffer BUF in order to get the overlay
-;; bounds.
-;; If BUFF is not a live buffer, then return nil; otherwise, return the
-;; newly created overlay.
-(defun ediff-make-bullet-proof-overlay (beg end buff)
-  (if (ediff-buffer-live-p buff)
-      (let (overl)
-	(ediff-eval-in-buffer buff
-	  (or (number-or-marker-p beg)
-	      (setq beg (eval beg)))
-	  (or (number-or-marker-p end)
-	      (setq end (eval end)))
-	  (setq overl 
-		(if ediff-xemacs-p
-		    (make-extent beg end buff)
-		  ;; advance front and rear of the overlay
-		  (make-overlay beg end buff nil 'rear-advance)))
-	  
-	  ;; never detach
-	  (ediff-overlay-put
-	   overl (if ediff-emacs-p 'evaporate 'detachable) nil)
-	  ;; make vip-minibuffer-overlay open-ended
-	  ;; In emacs, it is made open ended at creation time
-	  (if ediff-xemacs-p
-	      (progn
-		(ediff-overlay-put overl 'start-open nil) 
-		(ediff-overlay-put overl 'end-open nil)))
-	  (ediff-overlay-put overl 'ediff-diff-num 0)
-	  overl))))
-	  
-(defsubst ediff-overlay-start (overl)
-  (if (ediff-overlayp overl)
-      (if ediff-emacs-p
-	  (overlay-start overl)
-	(extent-start-position overl))))
-	
-(defsubst ediff-overlay-end  (overl)
-  (if (ediff-overlayp overl)
-      (if ediff-emacs-p
-	  (overlay-end overl)
-	(extent-end-position overl))))
-
-  
-;; Like other-buffer, but prefers visible buffers and ignores temporary or
-;; other insignificant buffers (those beginning with "^[ *]").
-;; Gets one arg--buffer name or a list of buffer names (it won't return
-;; these buffers).
-(defun ediff-other-buffer (buff)
-  (if (not (listp buff)) (setq buff (list buff)))
-  (let* ((frame-buffers (buffer-list))
-	 (significant-buffers
-	  (mapcar
-	   (function (lambda (x)
-		       (cond ((member (buffer-name x) buff)
-			      nil)
-			     ((not (ediff-get-visible-buffer-window x))
-			      nil)
-			     ((string-match "^ " (buffer-name x))
-			      nil)
-			     (t x))))
-	   frame-buffers))
-	 (buffers (delq nil significant-buffers))
-	 less-significant-buffers)
-	 
-    (cond (buffers (car buffers))
-	  ;; try also buffers that are not displayed in windows
-	  ((setq less-significant-buffers
-		 (delq nil
-		       (mapcar
-			(function
-			 (lambda (x)
-			   (cond ((member (buffer-name x) buff) nil)
-				 ((string-match "^[ *]" (buffer-name x)) nil)
-				 (t x))))
-			frame-buffers)))
-	   (car less-significant-buffers))
-	  (t (other-buffer (current-buffer))))
-    ))
-      
-      
-;; Construct a unique buffer name.
-;; The first one tried is prefixsuffix, then prefix<2>suffix, 
-;; prefix<3>suffix, etc.
-(defun ediff-unique-buffer-name (prefix suffix)
-  (if (null (get-buffer (concat prefix suffix)))
-      (concat prefix suffix)
-    (let ((n 2))
-      (while (get-buffer (format "%s<%d>%s" prefix n suffix))
-	(setq n (1+ n)))
-      (format "%s<%d>%s" prefix n suffix))))
-  
-
-;; splits at a white space, returns a list
-(defun ediff-split-string (string)
-  (let ((start 0)
-        (result '())
-	substr)
-    (while (string-match "[ \t]+" string start)
-      (let ((match (string-match "[ \t]+" string start)))
-	(setq substr (substring string start match))
-	(if (> (length substr) 0)
-	    (setq result (cons substr result)))
-        (setq start (match-end 0))))
-    (setq substr (substring string start nil))
-    (if (> (length substr) 0)
-	(setq result (cons substr result)))
-    (nreverse result)))
-
-(defun ediff-submit-report ()
-  "Submit bug report on Ediff."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (let ((reporter-prompt-for-summary-p t)
-	(ctl-buf ediff-control-buffer)
-	(ediff-device-type (ediff-device-type))
-	varlist salutation buffer-name)
-    (setq varlist '(ediff-diff-program ediff-diff-options
-		    ediff-patch-program ediff-patch-options
-		    ediff-shell
-		    ediff-use-faces 
-		    ediff-auto-refine ediff-highlighting-style
-		    ediff-buffer-A ediff-buffer-B ediff-control-buffer
-		    ediff-forward-word-function
-		    ediff-control-frame
-		    ediff-control-frame-parameters
-		    ediff-control-frame-position-function
-		    ediff-prefer-iconified-control-frame
-		    ediff-window-setup-function
-		    ediff-split-window-function
-		    ediff-job-name
-		    ediff-word-mode
-		    buffer-name
-		    ediff-device-type
-		    ))
-    (setq salutation "
-Congratulations! You may have unearthed a bug in Ediff!
-
-Please make a concise and accurate summary of what happened
-and mail it to the address above.
------------------------------------------------------------
-")
-    
-    (ediff-skip-unsuitable-frames)
-    (ediff-reset-mouse)
-    
-    (switch-to-buffer ediff-msg-buffer)
-    (erase-buffer)
-    (delete-other-windows)
-    (insert "
-Please read this first:
-----------------------
-
-Some ``bugs'' may actually be no bugs at all. For instance, if you are
-reporting that certain difference regions are not matched as you think they
-should, this is most likely due to the way Unix diff program decides what
-constitutes a difference region. Ediff is an Emacs interface to diff, and
-it has nothing to do with those decisions---it only takes the output from
-diff and presents it in a way that is better suited for human browsing and
-manipulation.
-
-If Emacs happens to dump core, this is NOT an Ediff problem---it is
-an Emacs bug. Report this to Emacs maintainers.
-
-Another popular topic for reports is compilation messages.  Because Ediff
-interfaces to several other packages and runs under Emacs and XEmacs,
-byte-compilation may produce output like this:
-
-       While compiling toplevel forms in file ediff.el:
-	 ** reference to free variable pm-color-alist
-	   ........................
-       While compiling the end of the data:
-	 ** The following functions are not known to be defined: 
-	   ediff-valid-color-p, ediff-set-face,
-	   ........................
-
-These are NOT errors, but inevitable warnings, which ought to be ignored.
-
-Please do not report those and similar things.  However, comments and
-suggestions are always welcome.
-
-Mail anyway? (y or n) ")
-      
-    (if (y-or-n-p "Mail anyway? ")
-	(progn
-	  (if (ediff-buffer-live-p ctl-buf)
-	      (set-buffer ctl-buf))
-	  (setq buffer-name (buffer-name))
-	  (require 'reporter)
-	  (reporter-submit-bug-report "kifer@cs.sunysb.edu"
-				      (ediff-version)
-				      varlist
-				      nil 
-				      'delete-other-windows
-				      salutation))
-      (bury-buffer)
-      (beep 1)(message "Bug report aborted")
-      (if (ediff-buffer-live-p ctl-buf)
-	  (ediff-eval-in-buffer ctl-buf
-	    (ediff-recenter 'no-rehighlight))))
-    ))
-			     
-       
-(defun ediff-deactivate-mark ()
-  (if ediff-xemacs-p
-	  (zmacs-deactivate-region)
-	(deactivate-mark)))
-(defun ediff-activate-mark ()
-  (if ediff-emacs-p
-      (setq mark-active t)
-    (zmacs-activate-region)))
-
-(cond ((fboundp 'nuke-selective-display)
-       ;; XEmacs 19.12 has nuke-selective-display
-       (fset 'ediff-nuke-selective-display 'nuke-selective-display))
-      (t
-       (defun ediff-nuke-selective-display ()
-	 (save-excursion
-	   (save-restriction
-	     (widen)
-	     (goto-char (point-min))
-	     (let ((mod-p (buffer-modified-p))
-		   buffer-read-only end)
-	       (and (eq t selective-display)
-		    (while (search-forward "\^M" nil t)
-		      (end-of-line)
-		      (setq end (point))
-		      (beginning-of-line)
-		      (while (search-forward "\^M" end t)
-			(delete-char -1)
-			(insert "\^J"))))
-	       (set-buffer-modified-p mod-p)
-	       (setq selective-display nil)))))
-       ))
-
-	 
-;; The next two are modified versions from emerge.el.
-;; VARS must be a list of symbols
-;; ediff-save-variables returns an association list: ((var . val) ...)
-(defsubst ediff-save-variables (vars)
-  (mapcar (function (lambda (v) (cons v (symbol-value v))))
-	  vars))
-;; VARS is a list of variable symbols.
-(defun ediff-restore-variables (vars assoc-list)
-  (while vars
-    (set (car vars) (cdr (assoc (car vars) assoc-list)))
-    (setq vars (cdr vars))))
-
-(defun ediff-change-saved-variable (var value buf-type)
-  (let* ((assoc-list
-	  (symbol-value (intern
-			 (concat "ediff-buffer-values-orig-"
-				 (symbol-name buf-type)))))
-	 (assoc-elt (assoc var assoc-list)))
-  (if assoc-elt
-      (setcdr assoc-elt value))))
-  
-  
-;; must execute in control buf
-(defun ediff-save-protected-variables ()
-  (setq ediff-buffer-values-orig-A
-	(ediff-eval-in-buffer ediff-buffer-A
-	  (ediff-save-variables ediff-protected-variables)))
-  (setq ediff-buffer-values-orig-B
-	(ediff-eval-in-buffer ediff-buffer-B
-	  (ediff-save-variables ediff-protected-variables)))
-  (if ediff-3way-comparison-job
-      (setq ediff-buffer-values-orig-C
-	    (ediff-eval-in-buffer ediff-buffer-C
-	      (ediff-save-variables ediff-protected-variables))))
-  (if (ediff-buffer-live-p ediff-ancestor-buffer)
-      (setq ediff-buffer-values-orig-Ancestor
-	    (ediff-eval-in-buffer ediff-ancestor-buffer
-	      (ediff-save-variables ediff-protected-variables)))))
-
-;; must execute in control buf
-(defun ediff-restore-protected-variables ()
-  (let ((values-A ediff-buffer-values-orig-A)
-	(values-B ediff-buffer-values-orig-B)
-	(values-C ediff-buffer-values-orig-C)
-	(values-Ancestor ediff-buffer-values-orig-Ancestor))
-    (ediff-eval-in-buffer ediff-buffer-A
-      (ediff-restore-variables ediff-protected-variables values-A))
-    (ediff-eval-in-buffer ediff-buffer-B
-      (ediff-restore-variables ediff-protected-variables values-B))
-    (if ediff-3way-comparison-job
-	(ediff-eval-in-buffer ediff-buffer-C
-	  (ediff-restore-variables ediff-protected-variables values-C)))
-    (if (ediff-buffer-live-p ediff-ancestor-buffer)
-	(ediff-eval-in-buffer ediff-ancestor-buffer
-	  (ediff-restore-variables ediff-protected-variables values-Ancestor)))
-    ))
-
-;; save BUFFER in FILE. used in hooks.
-(defun ediff-save-buffer-in-file (buffer file)
-  (ediff-eval-in-buffer buffer
-    (write-file file)))
-
-
-;;; Debug
-
-(ediff-defvar-local ediff-command-begin-time '(0 0 0) "")
-
-;; calculate time used by command
-(defun ediff-calc-command-time ()
-  (let ((end (current-time))
-	micro sec)
-    (setq micro
-	  (if (>= (nth 2 end) (nth 2 ediff-command-begin-time))
-	      (- (nth 2 end) (nth 2 ediff-command-begin-time))
-	    (+ (nth 2 end) (- 1000000 (nth 2 ediff-command-begin-time)))))
-    (setq sec (- (nth 1 end) (nth 1 ediff-command-begin-time)))
-    (or (equal ediff-command-begin-time '(0 0 0))
-	(message "Elapsed time: %d second(s) + %d microsecond(s)" sec micro))))
-
-(defsubst ediff-save-time ()
-  (setq ediff-command-begin-time (current-time)))
-    
-(defun ediff-profile ()
-  "Toggle profiling Ediff commands."
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (make-local-hook 'post-command-hook)
-  (let ((pre-hook 'pre-command-hook)
-	(post-hook 'post-command-hook))
-    (if (not (equal ediff-command-begin-time '(0 0 0)))
-	(progn (remove-hook pre-hook 'ediff-save-time)
-	       (remove-hook post-hook 'ediff-calc-command-time)
-	       (setq ediff-command-begin-time '(0 0 0))
-	       (message "Ediff profiling disabled"))
-      (add-hook pre-hook 'ediff-save-time t t)
-      (add-hook post-hook 'ediff-calc-command-time nil t)
-      (message "Ediff profiling enabled"))))
-    
-(defun ediff-print-diff-vector (diff-vector-var)
-  (princ (format "\n*** %S ***\n" diff-vector-var))
-  (mapcar (function
-	   (lambda (overl-vec)
-	     (princ
-	      (format
-	       "Diff %d: \tOverlay:    %S
-\t\tFine diffs: %s
-\t\tNo-fine-diff-flag: %S
-\t\tState-of-diff:\t   %S
-\t\tState-of-merge:\t   %S
-" 
-	       (1+ (ediff-overlay-get (aref overl-vec 0) 'ediff-diff-num))
-	       (aref overl-vec 0)
-	       ;; fine-diff-vector
-	       (if (= (length (aref overl-vec 1)) 0)
-		   "none\n"
-		 (mapconcat 'prin1-to-string
-			    (aref overl-vec 1) "\n\t\t\t    "))
-	       (aref overl-vec 2) ; no fine diff flag
-	       (aref overl-vec 3) ; state-of-diff
-	       (aref overl-vec 4) ; state-of-merge
-	       ))))
-	  (eval diff-vector-var)))
-
-  
-
-(defun ediff-debug-info ()
-  (interactive)
-  (ediff-barf-if-not-control-buffer)
-  (with-output-to-temp-buffer ediff-debug-buffer
-    (princ (format "\nCtl buffer: %S\n" ediff-control-buffer))
-    (ediff-print-diff-vector (intern "ediff-difference-vector-A"))
-    (ediff-print-diff-vector (intern "ediff-difference-vector-B"))
-    (ediff-print-diff-vector (intern "ediff-difference-vector-C"))
-    (ediff-print-diff-vector (intern "ediff-difference-vector-Ancestor"))
-    ))
-
-
-;;; General utilities
-
-;; this uses comparison-func to decide who is a member
-(defun ediff-member (elt lis comparison-func)
-  (while (and lis (not (funcall comparison-func (car lis) elt)))
-    (setq lis (cdr lis)))
-  lis)
-
-;; this uses comparison-func to decide who is a member, and this determines how
-;; intersection looks like
-(defun ediff-intersection (lis1 lis2 comparison-func)
-  (let ((result (list 'a)))
-    (while lis1
-      (if (ediff-member (car lis1) lis2 comparison-func)
-	  (nconc result (list (car lis1))))
-      (setq lis1 (cdr lis1)))
-    (cdr result)))
-    
-
-;; eliminates duplicates using comparison-func
-(defun ediff-union (lis1 lis2 comparison-func)
-  (let ((result (list 'a)))
-    (while lis1
-      (or (ediff-member (car lis1) (cdr result) comparison-func)
-	  (nconc result (list (car lis1))))
-      (setq lis1 (cdr lis1)))
-    (while lis2
-      (or (ediff-member (car lis2) (cdr result) comparison-func)
-	  (nconc result (list (car lis2))))
-      (setq lis2 (cdr lis2)))
-    (cdr result)))
-
-;; eliminates duplicates using comparison-func
-(defun ediff-set-difference (lis1 lis2 comparison-func)
-  (let ((result (list 'a)))
-    (while lis1
-      (or (ediff-member (car lis1) (cdr result) comparison-func)
-	  (ediff-member (car lis1) lis2 comparison-func)
-	  (nconc result (list (car lis1))))
-      (setq lis1 (cdr lis1)))
-    (cdr result)))
-
-(defun ediff-copy-list (list)
-  (if (consp list)
-      ;;;(let ((res nil))
-      ;;;  (while (consp list) (push (pop list) res))
-      ;;;  (prog1 (nreverse res) (setcdr res list)))
-      (let (res elt)
-	(while (consp list)
-	  (setq elt (car list)
-		res (cons elt res)
-		list (cdr list)))
-	(nreverse res))
-    (car list)))
-    
-
-;; don't report error if version control package wasn't found
-;;(ediff-load-version-control 'silent)
-
-(run-hooks 'ediff-load-hook)
-    
-
-;;; Local Variables:
-;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
-;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
-;;; End:
-
-(provide 'ediff-util)
-
-;;; ediff-util.el ends here
diff --git a/lisp/ediff-vers.el b/lisp/ediff-vers.el
deleted file mode 100644
index cec2d6f2ccf..00000000000
--- a/lisp/ediff-vers.el
+++ /dev/null
@@ -1,367 +0,0 @@
-;;; ediff-vers.el --- version control interface to Ediff
-
-;;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; 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.
-
-
-;;; Code:
-
-;; Compiler pacifier
-(defvar rcs-default-co-switches)
-(defvar sc-mode)
-(defvar cvs-shell)
-(defvar cvs-program)
-(defvar cvs-cookie-handle)
-
-(and noninteractive
-     (eval-when-compile
-       (load "pcl-cvs" 'noerror)
-       (load "rcs" 'noerror)
-       (load "generic-sc" 'noerror)
-       (load "vc" 'noerror)))
-;; end pacifier
-      
-;; VC.el support
-(defun ediff-vc-internal (rev1 rev2 &optional startup-hooks)
-;; Run Ediff on versions of the current buffer.
-;; If REV2 is "" then compare current buffer with REV1.
-;; If the current buffer is named `F', the version is named `F.~REV~'.
-;; If `F.~REV~' already exists, it is used instead of being re-created.
-  (let (file1 file2 rev1buf rev2buf)
-    (save-excursion
-      (vc-version-other-window rev1)
-      (setq rev1buf (current-buffer)
-	    file1 (buffer-file-name)))
-    (save-excursion
-      (or (string= rev2 "") 		; use current buffer
-	  (vc-version-other-window rev2))
-      (setq rev2buf (current-buffer)
-	    file2 (buffer-file-name)))
-    (setq startup-hooks
-	  (cons (` (lambda ()
-		     (delete-file (, file1))
-		     (or (, (string= rev2 "")) (delete-file (, file2)))
-		     ))
-		startup-hooks))
-    (ediff-buffers
-     rev1buf rev2buf
-     startup-hooks
-     'ediff-revision)))
-    
-;; RCS.el support
-(defun rcs-ediff-view-revision (&optional rev)
-;; View previous RCS revision of current file.
-;; With prefix argument, prompts for a revision name.
-  (interactive (list (if current-prefix-arg 
-			 (read-string "Revision: "))))
-  (let* ((filename (buffer-file-name (current-buffer)))
-	 (switches (append '("-p")
-			   (if rev (list (concat "-r" rev)) nil)))
-	 (buff (concat (file-name-nondirectory filename) ".~" rev "~")))
-    (message "Working ...")
-    (setq filename (expand-file-name filename))
-    (with-output-to-temp-buffer buff
-      (let ((output-buffer (ediff-rcs-get-output-buffer filename buff)))
-	(delete-windows-on output-buffer)
-	(save-excursion
-	  (set-buffer output-buffer)
-	  (apply 'call-process "co" nil t nil
-		 ;; -q: quiet (no diagnostics)
-		 (append switches rcs-default-co-switches
-			 (list "-q" filename))))) 
-      (message "")
-      buff)))    
-      
-(defun ediff-rcs-get-output-buffer (file name)
-  ;; Get a buffer for RCS output for FILE, make it writable and clean it up.
-  ;; Optional NAME is name to use instead of `*RCS-output*'.
-  ;; This is a modified version from rcs.el v1.1. I use it here to make
-  ;; Ediff immune to changes in rcs.el
-  (let* ((default-major-mode 'fundamental-mode) ; no frills!
-	 (buf (get-buffer-create name)))
-    (save-excursion
-      (set-buffer buf)
-      (setq buffer-read-only nil
-	    default-directory (file-name-directory (expand-file-name file)))
-      (erase-buffer))
-    buf))
-
-(defun ediff-rcs-internal (rev1 rev2 &optional startup-hooks)
-;; Run Ediff on versions of the current buffer.
-;; If REV2 is "" then use current buffer.
-  (let ((rev2buf (if (string= rev2 "")
-		     (current-buffer)
-		   (rcs-ediff-view-revision rev2)))
-	(rev1buf (rcs-ediff-view-revision rev1)))
-	
-    ;; rcs.el doesn't create temp version files, so we don't have to delete
-    ;; anything in startup hooks to ediff-buffers
-    (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision)
-    ))
-
-
-;; GENERIC-SC.el support
-
-(defun generic-sc-get-latest-rev ()
-  (cond ((eq sc-mode 'CCASE)
-	 (eval "main/LATEST"))
-	(t (eval ""))))
-
-(defun ediff-generic-sc-internal (rev1 rev2 &optional startup-hooks)
-;; Run Ediff on versions of the current buffer.
-;; If REV2 is "" then compare current buffer with REV1.
-;; If the current buffer is named `F', the version is named `F.~REV~'.
-;; If `F.~REV~' already exists, it is used instead of being re-created.
-  (let (rev1buf rev2buf)
-    (save-excursion
-      (if (or (not rev1) (string= rev1 ""))
-	  (setq rev1 (generic-sc-get-latest-rev)))
-      (sc-visit-previous-revision rev1)
-      (setq rev1buf (current-buffer)))
-    (save-excursion
-      (or (string= rev2 "") 		; use current buffer
-	  (sc-visit-previous-revision rev2))
-      (setq rev2buf (current-buffer)))
-    (ediff-buffers rev1buf rev2buf startup-hooks 'ediff-revision)))
-
-
-;;; Merge with Version Control
-
-(defun ediff-vc-merge-internal (rev1 rev2 ancestor-rev &optional startup-hooks)
-;; If ANCESTOR-REV non-nil, merge with ancestor
-  (let (buf1 buf2 ancestor-buf)
-    (save-excursion
-      (vc-version-other-window rev1)
-      (setq buf1 (current-buffer)))
-    (save-excursion
-      (or (string= rev2 "")
-	  (vc-version-other-window rev2))
-      (setq buf2 (current-buffer)))
-    (if ancestor-rev
-	(save-excursion
-	  (or (string= ancestor-rev "")
-	      (vc-version-other-window ancestor-rev))
-	  (setq ancestor-buf (current-buffer))))
-    (setq startup-hooks 
-	  (cons 
-	   (` (lambda () 
-		(delete-file (, (buffer-file-name buf1)))
-		(or (, (string= rev2 ""))
-		    (delete-file (, (buffer-file-name buf2))))
-		(or (, (string= ancestor-rev ""))
-		    (, (not ancestor-rev))
-		    (delete-file (, (buffer-file-name ancestor-buf))))
-		))
-	   startup-hooks))
-    (if ancestor-rev
-	(ediff-merge-buffers-with-ancestor
-	 buf1 buf2 ancestor-buf
-	 startup-hooks 'ediff-merge-revisions-with-ancestor)
-      (ediff-merge-buffers buf1 buf2 startup-hooks 'ediff-merge-revisions))
-    ))
-
-(defun ediff-rcs-merge-internal (rev1 rev2 ancestor-rev
-				      &optional startup-hooks)
-  ;; If ANCESTOR-REV non-nil, merge with ancestor
-  (let (buf1 buf2 ancestor-buf)
-    (setq buf1 (rcs-ediff-view-revision rev1)
-	  buf2 (if (string= rev2 "")
-		   (current-buffer)
-		 (rcs-ediff-view-revision rev2))
-	  ancestor-buf (if ancestor-rev
-			   (if (string= ancestor-rev "")
-			       (current-buffer)
-			     (rcs-ediff-view-revision ancestor-rev))))
-    ;; rcs.el doesn't create temp version files, so we don't have to delete
-    ;; anything in startup hooks to ediff-buffers
-    (if ancestor-rev
-	(ediff-merge-buffers-with-ancestor
-	 buf1 buf2 ancestor-buf
-	 startup-hooks 'ediff-merge-revisions-with-ancestor)
-      (ediff-merge-buffers buf1 buf2 startup-hooks 'ediff-merge-revisions))))
-
-(defun ediff-generic-sc-merge-internal (rev1 rev2 ancestor-rev
-					     &optional startup-hooks)
-  ;; If ANCESTOR-REV non-nil, merge with ancestor
-  (let (buf1 buf2 ancestor-buf)
-    (save-excursion
-      (if (string= rev1 "")
-	  (setq rev1 (generic-sc-get-latest-rev)))
-      (sc-visit-previous-revision rev1)
-      (setq buf1 (current-buffer)))
-    (save-excursion
-      (or (string= rev2 "")
-	  (sc-visit-previous-revision rev2))
-      (setq buf2 (current-buffer)))
-    (if ancestor-rev
-	(save-excursion
-	  (or (string= ancestor-rev "")
-	      (sc-visit-previous-revision ancestor-rev))
-	  (setq ancestor-buf (current-buffer))))
-    (if ancestor-rev
-	(ediff-merge-buffers-with-ancestor
-	 buf1 buf2 ancestor-buf
-	 startup-hooks 'ediff-merge-revisions-with-ancestor)
-      (ediff-merge-buffers buf1 buf2 startup-hooks 'ediff-merge-revisions))))
-
-
-;; PCL-CVS.el support
-
-(defun ediff-pcl-cvs-internal (rev1 rev2 &optional startup-hooks)
-;; Run Ediff on a pair of revisions of the current buffer.
-;; If REV1 is "", use the latest revision.
-;; If REV2 is "", use the current buffer as the second file to compare.
-  (let ((orig-buf (current-buffer))
-	orig-file-name buf1 buf2 file1 file2)
-    
-    (or (setq orig-file-name (buffer-file-name (current-buffer)))
-	(error "Current buffer is not visiting any file"))
-    (if (string= rev1 "") (setq rev1 nil)) ; latest revision
-    (setq buf1 (ediff-pcl-cvs-view-revision orig-file-name rev1)
-	  buf2 (if (string= rev2 "")
-		   orig-buf
-		 (ediff-pcl-cvs-view-revision orig-file-name rev2))
-	  file1 (buffer-file-name buf1)
-	  file2 (buffer-file-name buf2))
-    (setq startup-hooks
-	  (cons (` (lambda ()
-		     (delete-file (, file1))
-		     (or (, (string= rev2 "")) (delete-file (, file2)))
-		     ))
-		startup-hooks))
-    (ediff-buffers buf1 buf2 startup-hooks 'ediff-revision)))
-
-;; This function is the standard Ediff's interface to pcl-cvs.
-;; Works like with other interfaces: runs ediff on versions of the file in the
-;; current buffer.
-(defun ediff-pcl-cvs-merge-internal (rev1 rev2 ancestor-rev
-					  &optional startup-hooks)
-;; Ediff-merge appropriate revisions of the selected file.
-;; If REV1 is "" then use the latest revision.
-;; If REV2 is "" then merge current buffer's file with REV1.
-;; If ANCESTOR-REV is "" then use current buffer's file as ancestor.
-;; If ANCESTOR-REV is nil, then merge without the ancestor.
-  (let ((orig-buf (current-buffer))
-	orig-file-name buf1 buf2 ancestor-buf)
-
-    (or (setq orig-file-name (buffer-file-name (current-buffer)))
-	(error "Current buffer is not visiting any file"))
-    (if (string= rev1 "") (setq rev1 nil)) ; latest revision
-
-    (setq buf1 (ediff-pcl-cvs-view-revision orig-file-name rev1))
-    (setq buf2 (if (string= rev2 "")
-		   orig-buf
-		 (ediff-pcl-cvs-view-revision orig-file-name rev2)))
-    (if (stringp ancestor-rev)
-	(setq ancestor-buf
-	      (if (string= ancestor-rev "")
-		  orig-buf
-		(ediff-pcl-cvs-view-revision orig-file-name ancestor-rev))))
-
-    (setq startup-hooks 
-	  (cons 
-	   (` (lambda () 
-		(delete-file (, (buffer-file-name buf1)))
-		(or (, (string= rev2 ""))
-		    (delete-file (, (buffer-file-name buf2))))
-		(or (, (string= ancestor-rev ""))
-		    (, (not ancestor-rev))
-		    (delete-file (, (buffer-file-name ancestor-buf))))
-		))
-	   startup-hooks))
-
-    (if ancestor-buf
-	(ediff-merge-buffers-with-ancestor
-	 buf1 buf2 ancestor-buf startup-hooks 
-	 'ediff-merge-revisions-with-ancestor)
-      (ediff-merge-buffers
-       buf1 buf2 startup-hooks 'ediff-merge-revisions))
-    ))
-
-(defun ediff-pcl-cvs-view-revision (file rev)
-;; if rev = "", get the latest revision
-  (let ((temp-name (make-temp-name
-		    (concat ediff-temp-file-prefix
-			    "ediff_" rev))))
-    (cvs-kill-buffer-visiting temp-name)
-    (if rev
-	(message "Retrieving revision %s..." rev)
-      (message "Retrieving latest revision..."))
-    (let ((res (call-process cvs-shell nil nil nil "-c"
-			     (concat cvs-program " update -p "
-				     (if rev
-					 (concat "-r " rev " ")
-				       "")
-				     file
-				     " > " temp-name))))
-      (if (and res (not (and (integerp res) (zerop res))))
-	  (error "Failed to retrieve revision: %s" res))
-
-      (if rev
-	  (message "Retrieving revision %s... Done." rev)
-	(message "Retrieving latest revision... Done."))
-      (find-file-noselect temp-name))))
-
-
-(defun cvs-run-ediff-on-file-descriptor (tin)
-;; This is a replacement for cvs-emerge-mode
-;; Run after cvs-update.
-;; Ediff-merge appropriate revisions of the selected file.
-  (let* ((fileinfo (tin-cookie cvs-cookie-handle tin))
-	 (type (cvs-fileinfo->type fileinfo))
-	 (tmp-file
-	  (cvs-retrieve-revision-to-tmpfile fileinfo))
-	 ancestor-file)
-    
-    (or (memq type '(MERGED CONFLICT MODIFIED))
-	(error
-	 "Can only merge `Modified', `Merged' or `Conflict' files"))
-    
-    (cond ((memq type '(MERGED CONFLICT))
-	   (setq ancestor-file
-		 (cvs-retrieve-revision-to-tmpfile
-		  fileinfo
-		  ;; revision
-		  (cvs-fileinfo->base-revision fileinfo)))
-	   (ediff-merge-buffers-with-ancestor
-	    (find-file-noselect tmp-file)
-	    (find-file-noselect (cvs-fileinfo->backup-file fileinfo))
-	    (find-file-noselect ancestor-file)
-	    nil ; startup-hooks
-	    'ediff-merge-revisions-with-ancestor))
-	  ((eq type 'MODIFIED)
-	   (ediff-merge-buffers
-	    (find-file-noselect tmp-file)
-	    (find-file-noselect (cvs-fileinfo->full-path fileinfo))
-	    nil ; startup-hooks
-	    'ediff-merge-revisions)))
-    (if (stringp tmp-file) (delete-file tmp-file))
-    (if (stringp ancestor-file) (delete-file ancestor-file))))
-
-;;; Local Variables:
-;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
-;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
-;;; End:
-
-(provide 'ediff-vers)
-
-;;; ediff-vers.el ends here
diff --git a/lisp/ediff-wind.el b/lisp/ediff-wind.el
deleted file mode 100644
index 8edde2995df..00000000000
--- a/lisp/ediff-wind.el
+++ /dev/null
@@ -1,1210 +0,0 @@
-;;; ediff-wind.el --- window manipulation utilities
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; 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.
-
-;;; Code:
-
-(require 'ediff-init)
-(if ediff-xemacs-p
-    (require 'ediff-tbar)
-  (defun ediff-compute-toolbar-width () 0))
-
-;; Compiler pacifier
-(defvar icon-title-format)
-(defvar top-toolbar-height)
-(defvar bottom-toolbar-height)
-(defvar left-toolbar-height)
-(defvar right-toolbar-height)
-(defvar left-toolbar-width)
-(defvar right-toolbar-width)
-(defvar default-menubar)
-(defvar frame-icon-title-format)
-;; end pacifier
-
-
-(defvar ediff-window-setup-function (if (ediff-window-display-p)
-					'ediff-setup-windows-multiframe
-				      'ediff-setup-windows-plain)
-  "*Function called to set up windows.
-Ediff provides a choice of two functions: ediff-setup-windows-plain, for
-doing everything in one frame, and ediff-setup-windows-multiframe,
-which sets the control panel in a separate frame. Also, if the latter
-function detects that one of the buffers A/B is seen in some other frame,
-it will try to keep that buffer in that frame.
-
-If you don't like the two functions provided---write your own one.
-The basic guidelines:
-    1. It should leave the control buffer current and the control window
-       selected. 
-    2. It should set ediff-window-A, ediff-window-B, ediff-window-C,
-       and ediff-control-window to contain window objects that display
-       the corresponding buffers.
-    3. It should accept the following arguments:
-       buffer-A, buffer-B, buffer-C, control-buffer
-       Buffer C may not be used in jobs that compare only two buffers.
-If you plan to do something fancy, take a close look at how the two
-provided functions are written.")
-
-;; indicates if we are in a multiframe setup
-(ediff-defvar-local ediff-multiframe nil "")
-
-;; Share of the frame occupied by the merge window (buffer C)
-(ediff-defvar-local ediff-merge-window-share 0.45 "")
-
-;; The control window.
-(ediff-defvar-local ediff-control-window nil "")
-;; Official window for buffer A
-(ediff-defvar-local ediff-window-A nil "")
-;; Official window for buffer B
-(ediff-defvar-local ediff-window-B nil "")
-;; Official window for buffer C
-(ediff-defvar-local ediff-window-C nil "")
-;; Ediff's window configuration.
-;; Used to minimize the need to rearrange windows.
-(ediff-defvar-local ediff-window-config-saved "" "")
-
-
-(defvar ediff-split-window-function 'split-window-vertically
-  "*The function used to split the main window between buffer-A and buffer-B.
-You can set it to a horizontal split instead of the default vertical split
-by setting this variable to `split-window-horizontally'.
-You can also have your own function to do fancy splits.
-This variable has no effect when buffer-A/B are shown in different frames.
-In this case, Ediff will use those frames to display these buffers.")
-
-(defvar ediff-merge-split-window-function 'split-window-horizontally
-  "*The function used to split the main window between buffer-A and buffer-B.
-You can set it to a vertical split instead of the default horizontal split
-by setting this variable to `split-window-vertically'.
-You can also have your own function to do fancy splits.
-This variable has no effect when buffer-A/B/C are shown in different frames.
-In this case, Ediff will use those frames to display these buffers.")
-
-(defconst ediff-control-frame-parameters
-  (list 
-   '(name . "Ediff")
-   ;;'(unsplittable . t)
-   '(minibuffer . nil)
-   '(user-position . t)	      ; Emacs only
-   '(vertical-scroll-bars . nil)  ; Emacs only
-   '(scrollbar-width . 0)         ; XEmacs only
-   '(menu-bar-lines . 0)          ; Emacs only
-   ;; don't lower and auto-raise
-   '(auto-lower . nil)
-   '(auto-raise . t)
-   ;; this blocks queries from  window manager as to where to put
-   ;; ediff's control frame. we put the frame outside the display,
-   ;; so the initial frame won't jump all over the screen
-   (cons 'top  (if (fboundp 'ediff-display-pixel-height)
-		   (1+ (ediff-display-pixel-height))
-		 3000))
-   (cons 'left (if (fboundp 'ediff-display-pixel-width)
-		   (1+ (ediff-display-pixel-width))
-		 3000))
-   )
-  "Frame parameters for displaying Ediff Control Panel.
-Do not specify width and height here. These are computed automatically.")
-
-;; position of the mouse; used to decide whether to warp the mouse into ctl
-;; frame
-(ediff-defvar-local ediff-mouse-pixel-position nil "")
-
-;; not used for now
-(defvar ediff-mouse-pixel-threshold 30
-  "If the user moves mouse more than this many pixels, Ediff won't warp mouse into control window.")
-
-(defvar ediff-grab-mouse t
-  "*If t, Ediff will always grab the mouse and put it in the control frame.
-If 'maybe, Ediff will do it sometimes, but not after operations that require
-relatively long time. If nil, the mouse will be entirely user's
-responsibility.")
-
-(defvar ediff-control-frame-position-function 'ediff-make-frame-position
-  "Function to call to determine the desired location for the control panel.
-Expects three parameters: the control buffer, the desired width and height
-of the control frame. It returns an association list
-of the form \(\(top . <position>\) \(left . <position>\)\)")
-
-(defvar ediff-control-frame-upward-shift (if ediff-xemacs-p 42 14)
-  "*The upward shift of control frame from the top of buffer A's frame.
-Measured in pixels.
-This is used by the default control frame positioning function,
-`ediff-make-frame-position'. This variable is provided for easy
-customization of the default.")
-
-(defvar ediff-narrow-control-frame-leftward-shift (if ediff-xemacs-p 7 3)
-  "*The leftward shift of control frame from the right edge of buf A's frame.
-Measured in characters.
-This is used by the default control frame positioning function,
-`ediff-make-frame-position' to adjust the position of the control frame
-when it shows the short menu. This variable is provided for easy
-customization of the default.")
-
-(defvar ediff-wide-control-frame-rightward-shift 7
-  "*The rightward shift of control frame from the left edge of buf A's frame.
-Measured in characters.
-This is used by the default control frame positioning function,
-`ediff-make-frame-position' to adjust the position of the control frame
-when it shows the full menu. This variable is provided for easy
-customization of the default.")
-
-
-;; Wide frame display
-
-;; t means Ediff is using wide display
-(ediff-defvar-local ediff-wide-display-p nil "")
-;; keeps frame config for toggling wide display
-(ediff-defvar-local ediff-wide-display-orig-parameters nil 
-  "Frame parameters to be restored when the user wants to toggle the wide
-display off.")
-(ediff-defvar-local ediff-wide-display-frame nil
-  "Frame to be used for wide display.")
-(ediff-defvar-local ediff-make-wide-display-function 'ediff-make-wide-display
-  "The value is a function that is called to create a wide display.
-The function is called without arguments. It should resize the frame in
-which buffers A, B, and C are to be displayed, and it should save the old
-frame parameters in `ediff-wide-display-orig-parameters'.
-The variable `ediff-wide-display-frame' should be set to contain
-the frame used for the wide display.")
-
-;; Frame used for the control panel in a windowing system.
-(ediff-defvar-local ediff-control-frame nil "")
-
-(defvar ediff-prefer-iconified-control-frame nil
-  "*If t, keep control panel iconified when help message is off.
-This has effect only on a windowing system.
-If t, hitting `?' to toggle control panel off iconifies it.
-
-This is only useful in Emacs and only for certain kinds of window managers,
-such as TWM and its derivatives, since the window manager must permit
-keyboard input to go into icons. XEmacs completely ignores keyboard input
-into icons, regardless of the window manager.")
-
-;;; Functions
-
-(defun ediff-get-window-by-clicking (wind prev-wind wind-number)
-  (let (event)
-    (message
-     "Select windows by clicking. Please click on Window %d " wind-number)
-    (while (not (ediff-mouse-event-p (setq event (ediff-read-event))))
-      (if (sit-for 1) ; if sequence of events, wait till the final word
-	  (beep 1))
-      (message "Please click on Window %d " wind-number))
-    (ediff-read-event) ; discard event
-    (setq wind (if ediff-xemacs-p
-		   (event-window event)
-		 (posn-window (event-start event))))
-    ))
-      
-
-;; Select the lowest window on the frame.
-(defun ediff-select-lowest-window ()
-  (if ediff-xemacs-p
-      (select-window (frame-lowest-window))
-    (let* ((lowest-window (selected-window))
-	   (bottom-edge (car (cdr (cdr (cdr (window-edges))))))
-	   (last-window (save-excursion
-			  (other-window -1) (selected-window)))
-	   (window-search t))
-      (while window-search
-	(let* ((this-window (next-window))
-	       (next-bottom-edge
-		(car (cdr (cdr (cdr (window-edges this-window)))))))
-	  (if (< bottom-edge next-bottom-edge)
-	      (progn
-		(setq bottom-edge next-bottom-edge)
-		(setq lowest-window this-window)))
-	  
-	  (select-window this-window)
-	  (if (eq last-window this-window)
-	      (progn
-		(select-window lowest-window)
-		(setq window-search nil))))))))
-
-
-;;; Common window setup routines
-
-;; Set up the window configuration.  If POS is given, set the points to
-;; the beginnings of the buffers.
-;; When 3way comparison is added, this will have to choose the appropriate
-;; setup function based on ediff-job-name
-(defun ediff-setup-windows (buffer-A buffer-B buffer-C control-buffer)
-  ;; Make sure we are not in the minibuffer window when we try to delete
-  ;; all other windows.
-  (run-hooks 'ediff-before-setup-windows-hook)
-  (if (eq (selected-window) (minibuffer-window))
-      (other-window 1))
-      
-  ;; in case user did a no-no on a tty
-  (or (ediff-window-display-p)
-      (setq ediff-window-setup-function 'ediff-setup-windows-plain))
-  
-  (or (ediff-keep-window-config control-buffer)
-      (funcall 
-       (ediff-eval-in-buffer control-buffer ediff-window-setup-function)
-       buffer-A buffer-B buffer-C control-buffer))
-  (run-hooks 'ediff-after-setup-windows-hook))
-
-;; Just set up 3 windows.
-;; Usually used without windowing systems
-;; With windowing, we want to use dedicated frames.
-(defun ediff-setup-windows-plain (buffer-A buffer-B buffer-C control-buffer)
-  (ediff-eval-in-buffer control-buffer
-    (setq ediff-multiframe nil))
-  (if ediff-merge-job
-      (ediff-setup-windows-plain-merge
-       buffer-A buffer-B buffer-C control-buffer)
-    (ediff-setup-windows-plain-compare 
-     buffer-A buffer-B buffer-C control-buffer)))
-     
-(defun ediff-setup-windows-plain-merge (buf-A buf-B buf-C control-buffer)
-  ;; skip dedicated and unsplittable frames
-  (ediff-destroy-control-frame control-buffer)
-  (let ((window-min-height 1)
-	split-window-function 
-	merge-window-share merge-window-lines
-	wind-A wind-B wind-C)
-    (ediff-eval-in-buffer control-buffer
-      (setq merge-window-share ediff-merge-window-share
-	    ;; this lets us have local versions of ediff-split-window-function
-	    split-window-function ediff-split-window-function))
-    (delete-other-windows)
-    (split-window-vertically)
-    (ediff-select-lowest-window)
-    (ediff-setup-control-buffer control-buffer)
-    
-    ;; go to the upper window and split it betw A, B, and possibly C
-    (other-window 1) 
-    (setq merge-window-lines
-	  (max 2 (round (* (window-height) merge-window-share))))
-    (switch-to-buffer buf-A)
-    (setq wind-A (selected-window))
-    
-    ;; XEmacs used to have a lot of trouble with display
-    ;; It did't set things right unless we tell it to sit still
-    ;; 19.12 seems ok.
-    ;;(if ediff-xemacs-p (sit-for 0))
-    
-    (split-window-vertically (max 2 (- (window-height) merge-window-lines)))
-    (if (eq (selected-window) wind-A) 
-	(other-window 1))
-    (setq wind-C (selected-window))
-    (switch-to-buffer buf-C)
-    
-    (select-window wind-A)
-    (funcall split-window-function)
-		  
-    (if (eq (selected-window) wind-A)
-	(other-window 1))
-    (switch-to-buffer buf-B)
-    (setq wind-B (selected-window))
-	  
-    (ediff-eval-in-buffer control-buffer
-      (setq ediff-window-A wind-A
-	    ediff-window-B wind-B
-	    ediff-window-C wind-C))
-    
-    (ediff-select-lowest-window)
-    (ediff-setup-control-buffer control-buffer)
-    ))
-
-     
-;; This function handles all comparison jobs, including 3way jobs
-(defun ediff-setup-windows-plain-compare (buf-A buf-B buf-C control-buffer)
-  ;; skip dedicated and unsplittable frames
-  (ediff-destroy-control-frame control-buffer)
-  (let ((window-min-height 1)
-	split-window-function wind-width-or-height
-	three-way-comparison
-	wind-A-start wind-B-start wind-A wind-B wind-C)
-    (ediff-eval-in-buffer control-buffer
-      (setq wind-A-start (ediff-overlay-start
-			  (ediff-get-value-according-to-buffer-type
-			   'A ediff-narrow-bounds))
-	    wind-B-start (ediff-overlay-start
-			  (ediff-get-value-according-to-buffer-type
-			   'B  ediff-narrow-bounds))
-	    ;; this lets us have local versions of ediff-split-window-function
-	    split-window-function ediff-split-window-function
-	    three-way-comparison ediff-3way-comparison-job))
-    (delete-other-windows)
-    (split-window-vertically)
-    (ediff-select-lowest-window)
-    (ediff-setup-control-buffer control-buffer)
-    
-    ;; go to the upper window and split it betw A, B, and possibly C
-    (other-window 1) 
-    (switch-to-buffer buf-A)
-    (setq wind-A (selected-window))
-    (if three-way-comparison
-	(setq wind-width-or-height
-	      (/ (if (eq split-window-function 'split-window-vertically)
-		     (window-height wind-A)
-		   (window-width wind-A))
-		 3)))
-    
-    ;; XEmacs used to have a lot of trouble with display
-    ;; It did't set things right unless we told it to sit still
-    ;; 19.12 seems ok.
-    ;;(if ediff-xemacs-p (sit-for 0))
-    
-    (funcall split-window-function wind-width-or-height)
-		  
-    (if (eq (selected-window) wind-A)
-	(other-window 1))
-    (switch-to-buffer buf-B)
-    (setq wind-B (selected-window))
-	  
-    (if three-way-comparison
-	(progn
-	  (funcall split-window-function) ; equally
-	  (if (eq (selected-window) wind-B)
-	      (other-window 1))
-	  (switch-to-buffer buf-C)
-	  (setq wind-C (selected-window))))
-	  
-    (ediff-eval-in-buffer control-buffer
-      (setq ediff-window-A wind-A
-	    ediff-window-B wind-B
-	    ediff-window-C wind-C))
-    
-    ;; It is unlikely that we will want to implement 3way window comparison.
-    ;; So, only buffers A and B are used here.
-    (if ediff-windows-job
-	(progn
-	  (set-window-start wind-A wind-A-start)
-	  (set-window-start wind-B wind-B-start)))
-  
-    (ediff-select-lowest-window)
-    (ediff-setup-control-buffer control-buffer)
-    ))
-
-    
-;; dispatch an appropriate window setup function
-(defun ediff-setup-windows-multiframe (buf-A buf-B buf-C control-buf)
-  (ediff-eval-in-buffer control-buf
-    (setq ediff-multiframe t))
-  (if ediff-merge-job
-      (ediff-setup-windows-multiframe-merge buf-A buf-B buf-C control-buf)
-    (ediff-setup-windows-multiframe-compare buf-A buf-B buf-C control-buf)))
-    
-(defun ediff-setup-windows-multiframe-merge (buf-A buf-B buf-C control-buf)
-;;; Algorithm:
-;;;   1. Never use frames that have dedicated windows in them---it is bad to
-;;;      destroy dedicated windows.
-;;;   2. If A and B are in the same frame but C's frame is different--- use one
-;;;      frame for A and B and use a separate frame for C. 
-;;;   3. If C's frame is non-existent, then: if the first suitable
-;;;      non-dedicated frame  is different from A&B's, then use it for C.
-;;;      Otherwise, put A,B, and C in one frame.
-;;;   4. If buffers A, B, C are is separate frames, use them to display these
-;;;      buffers.
-
-  ;;   Skip dedicated or iconified frames. 
-  ;;   Unsplittable frames are taken care of later.
-  (ediff-skip-unsuitable-frames 'ok-unsplittable)
-  
-  (let* ((window-min-height 1)
-	 (wind-A (ediff-get-visible-buffer-window buf-A))
-	 (wind-B (ediff-get-visible-buffer-window buf-B))
-	 (wind-C (ediff-get-visible-buffer-window buf-C))
-	 (frame-A (if wind-A (window-frame wind-A)))
-	 (frame-B (if wind-B (window-frame wind-B)))
-	 (frame-C (if wind-C (window-frame wind-C)))
-	 ;; on wide display, do things in one frame
-	 (force-one-frame 
-	  (ediff-eval-in-buffer control-buf ediff-wide-display-p))
-	 ;; this lets us have local versions of ediff-split-window-function
-	 (split-window-function 
-	  (ediff-eval-in-buffer control-buf ediff-split-window-function))
-	 (orig-wind (selected-window))
-	 (orig-frame (selected-frame))
-	 (use-same-frame (or force-one-frame
-			     ;; A and C must be in one frame
-			     (eq frame-A (or frame-C orig-frame))
-			     ;; B and C must be in one frame
-			     (eq frame-B (or frame-C orig-frame))
-			     ;; A or B is not visible
-			     (not (frame-live-p frame-A))
-			     (not (frame-live-p frame-B))
-			     ;; A or B is not suitable for display
-			     (not (ediff-window-ok-for-display wind-A))
-			     (not (ediff-window-ok-for-display wind-B))
-			     ;; A and B in the same frame, and no good frame
-			     ;; for C
-			     (and (eq frame-A frame-B)
-				  (not (frame-live-p frame-C)))
-			     ))
-	 ;; use-same-frame-for-AB implies wind A and B are ok for display
-	 (use-same-frame-for-AB (and (not use-same-frame)
-				     (eq frame-A frame-B)))
-	 (merge-window-share (ediff-eval-in-buffer control-buf
-			       ediff-merge-window-share))
-	 merge-window-lines
-	 designated-minibuffer-frame
-	 done-A done-B done-C)
-    
-    ;; buf-A on its own
-    (if (and (window-live-p wind-A)
-	     (null use-same-frame) ; implies wind-A is suitable
-	     (null use-same-frame-for-AB))
-	(progn ; bug A on its own
-	  ;; buffer buf-A is seen in live wind-A
-	  (select-window wind-A)
-	  (delete-other-windows)
-	  (setq wind-A (selected-window))
-	  (setq done-A t)))
-    
-    ;; buf-B on its own
-    (if (and (window-live-p wind-B)
-	     (null use-same-frame) ; implies wind-B is suitable
-	     (null use-same-frame-for-AB))
-	(progn ; buf B on its own
-	  ;; buffer buf-B is seen in live wind-B
-	  (select-window wind-B)
-	  (delete-other-windows)
-	  (setq wind-B (selected-window))
-	  (setq done-B t)))
-	  
-    ;; buf-C on its own
-    (if (and (window-live-p wind-C)
-	     (ediff-window-ok-for-display wind-C)
-	     (null use-same-frame)) ; buf C on its own
-	(progn
-	  ;; buffer buf-C is seen in live wind-C
-	  (select-window wind-C)
-	  (delete-other-windows)
-	  (setq wind-C (selected-window))
-	  (setq done-C t)))
-    
-    (if (and use-same-frame-for-AB  ; implies wind A and B are suitable
-	     (window-live-p wind-A))
-	(progn 
-	  ;; wind-A must already be displaying buf-A
-	  (select-window wind-A)
-	  (delete-other-windows)
-	  (setq wind-A (selected-window))
-	  
-	  (funcall split-window-function)
-	  (if (eq (selected-window) wind-A) 
-	      (other-window 1))
-	  (switch-to-buffer buf-B)
-	  (setq wind-B (selected-window))
-	  
-	  (setq done-A t
-		done-B t)))
-    
-    (if use-same-frame
-	(let ((window-min-height 1))
-	  ;; avoid dedicated and non-splittable windows
-	  (ediff-skip-unsuitable-frames)
-	  (delete-other-windows)
-	  (setq merge-window-lines
-		(max 2 (round (* (window-height) merge-window-share))))
-	  (switch-to-buffer buf-A)
-	  (setq wind-A (selected-window))
-	  
-	  (split-window-vertically
-	   (max 2 (- (window-height) merge-window-lines)))
-	  (if (eq (selected-window) wind-A) 
-	      (other-window 1))
-	  (setq wind-C (selected-window))
-	  (switch-to-buffer buf-C)
-	  
-	  (select-window wind-A)
-	  
-	  (funcall split-window-function)
-	  (if (eq (selected-window) wind-A) 
-	      (other-window 1))
-	  (switch-to-buffer buf-B)
-	  (setq wind-B (selected-window))
-	  
-	  (setq done-A t
-		done-B t
-		done-C t)
-	  ))
-    
-    (or done-A  ; Buf A to be set in its own frame,
-	      ;;; or it was set before because use-same-frame = 1
-	(progn
-	  ;; Buf-A was not set up yet as it wasn't visible,
-	  ;; and use-same-frame = nil, use-same-frame-for-AB = nil
-	  (select-window orig-wind)
-	  (delete-other-windows)
-	  (switch-to-buffer buf-A)
-	  (setq wind-A (selected-window))
-	  ))
-    (or done-B  ; Buf B to be set in its own frame,
-	      ;;; or it was set before because use-same-frame = 1
-	(progn
-	  ;; Buf-B was not set up yet as it wasn't visible
-	  ;; and use-same-frame = nil, use-same-frame-for-AB = nil
-	  (select-window orig-wind)
-	  (delete-other-windows)
-	  (switch-to-buffer buf-B)
-	  (setq wind-B (selected-window))
-	  ))
-    
-    (or done-C  ; Buf C to be set in its own frame,
-	      ;;; or it was set before because use-same-frame = 1
-	(progn
-	  ;; Buf-C was not set up yet as it wasn't visible
-	  ;; and use-same-frame = nil
-	  (select-window orig-wind)
-	  (delete-other-windows)
-	  (switch-to-buffer buf-C)
-	  (setq wind-C (selected-window))
-	  ))
-    
-    (ediff-eval-in-buffer control-buf
-      (setq ediff-window-A wind-A
-	    ediff-window-B wind-B
-	    ediff-window-C wind-C)
-      (setq frame-A (window-frame ediff-window-A)
-	    designated-minibuffer-frame
-	    (window-frame (minibuffer-window frame-A))))
-    
-    (ediff-setup-control-frame control-buf designated-minibuffer-frame)
-    ))
-
-  
-;; Window setup for all comparison jobs, including 3way comparisons
-(defun ediff-setup-windows-multiframe-compare (buf-A buf-B buf-C control-buf)
-;;; Algorithm:
-;;;    If a buffer is seen in a frame, use that frame for that buffer.  
-;;;    If it is not seen, use the current frame.
-;;;    If both buffers are not seen, they share the current frame.  If one
-;;;    of the buffers is not seen, it is placed in the current frame (where
-;;;    ediff started). If that frame is displaying the other buffer, it is
-;;;    shared between the two buffers.
-;;;    However, if we decide to put both buffers in one frame
-;;;    and the selected frame isn't splittable, we create a new frame and
-;;;    put both buffers there, event if one of this buffers is visible in
-;;;    another frame.
-  
-  ;; Skip dedicated or iconified frames.
-  ;; Unsplittable frames are taken care of later.
-  (ediff-skip-unsuitable-frames 'ok-unsplittable)
-  
-  (let* ((window-min-height 1)
-	 (wind-A (ediff-get-visible-buffer-window buf-A))
-	 (wind-B (ediff-get-visible-buffer-window buf-B))
-	 (wind-C (ediff-get-visible-buffer-window buf-C))
-	 (frame-A (if wind-A (window-frame wind-A)))
-	 (frame-B (if wind-B (window-frame wind-B)))
-	 (frame-C (if wind-C (window-frame wind-C)))
-	 (ctl-frame-exists-p (ediff-eval-in-buffer control-buf
-			       (frame-live-p ediff-control-frame)))
-	 ;; on wide display, do things in one frame
-	 (force-one-frame 
-	  (ediff-eval-in-buffer control-buf ediff-wide-display-p))
-	 ;; this lets us have local versions of ediff-split-window-function
-	 (split-window-function 
-	  (ediff-eval-in-buffer control-buf ediff-split-window-function))
-	 (three-way-comparison
-	  (ediff-eval-in-buffer control-buf ediff-3way-comparison-job))
-	 (orig-wind (selected-window))
-	 (use-same-frame (or force-one-frame
-			     (eq frame-A frame-B)
-			     (not (ediff-window-ok-for-display wind-A))
-			     (not (ediff-window-ok-for-display wind-B))
-			     (if three-way-comparison
-				 (or (eq frame-A frame-C)
-				     (eq frame-B frame-C)
-				     (not (ediff-window-ok-for-display wind-C))
-				     (not (frame-live-p frame-A))
-				     (not (frame-live-p frame-B))
-				     (not (frame-live-p frame-C))))
-			     (and (not (frame-live-p frame-B))
-				  (or ctl-frame-exists-p
-				      (eq frame-A (selected-frame))))
-			     (and (not (frame-live-p frame-A))
-				  (or ctl-frame-exists-p
-				      (eq frame-B (selected-frame))))))
-	 wind-A-start wind-B-start 
-	 designated-minibuffer-frame
-	 done-A done-B done-C)
-    
-    (ediff-eval-in-buffer control-buf
-      (setq wind-A-start (ediff-overlay-start
-			  (ediff-get-value-according-to-buffer-type
-			   'A ediff-narrow-bounds))
-	    wind-B-start (ediff-overlay-start
-			  (ediff-get-value-according-to-buffer-type
-			   'B ediff-narrow-bounds))))
-    
-    (if (and (window-live-p wind-A) (null use-same-frame)) ; buf-A on its own
-	(progn
-	  ;; buffer buf-A is seen in live wind-A
-	  (select-window wind-A) ; must be displaying buf-A
-	  (delete-other-windows)
-	  (setq wind-A (selected-window))
-	  (setq done-A t)))
-    
-    (if (and (window-live-p wind-B) (null use-same-frame)) ; buf B on its own
-	(progn
-	  ;; buffer buf-B is seen in live wind-B
-	  (select-window wind-B) ; must be displaying buf-B
-	  (delete-other-windows)
-	  (setq wind-B (selected-window))
-	  (setq done-B t)))
-	  
-    (if (and (window-live-p wind-C) (null use-same-frame)) ; buf C on its own
-	(progn
-	  ;; buffer buf-C is seen in live wind-C
-	  (select-window wind-C) ; must be displaying buf-C
-	  (delete-other-windows)
-	  (setq wind-C (selected-window))
-	  (setq done-C t)))
-    
-    (if use-same-frame
-	(let (wind-width-or-height) ; this affects 3way setups only
-	  ;; avoid dedicated and non-splittable windows
-	  (ediff-skip-unsuitable-frames)
-	  (delete-other-windows)
-	  (switch-to-buffer buf-A)
-	  (setq wind-A (selected-window))
-	  
-	  (if three-way-comparison
-	      (setq wind-width-or-height
-		    (/
-		     (if (eq split-window-function 'split-window-vertically)
-			 (window-height wind-A)
-		       (window-width wind-A))
-		     3)))
-	  
-	  (funcall split-window-function wind-width-or-height)
-	  (if (eq (selected-window) wind-A) 
-	      (other-window 1))
-	  (switch-to-buffer buf-B)
-	  (setq wind-B (selected-window))
-	  
-	  (if three-way-comparison
-	      (progn
-		(funcall split-window-function) ; equally
-		(if (memq (selected-window) (list wind-A wind-B))
-		    (other-window 1))
-		(switch-to-buffer buf-C)
-		(setq wind-C (selected-window))))
-	  (setq done-A t
-		done-B t
-		done-C t)
-	  ))
-    
-    (or done-A  ; Buf A to be set in its own frame
-	      ;;; or it was set before because use-same-frame = 1
-	(progn  
-	  ;; Buf-A was not set up yet as it wasn't visible,
-	  ;; and use-same-frame = nil
-	  (select-window orig-wind)
-	  (delete-other-windows)
-	  (switch-to-buffer buf-A)
-	  (setq wind-A (selected-window))
-	  ))
-    (or done-B  ; Buf B to be set in its own frame
-	      ;;; or it was set before because use-same-frame = 1
-	(progn  
-	  ;; Buf-B was not set up yet as it wasn't visible,
-	  ;; and use-same-frame = nil
-	  (select-window orig-wind)
-	  (delete-other-windows)
-	  (switch-to-buffer buf-B)
-	  (setq wind-B (selected-window))
-	  ))
-    
-    (if three-way-comparison
-	(or done-C  ; Buf C to be set in its own frame
-		  ;;; or it was set before because use-same-frame = 1
-	    (progn  
-	      ;; Buf-C was not set up yet as it wasn't visible,
-	      ;; and use-same-frame = nil
-	      (select-window orig-wind)
-	      (delete-other-windows)
-	      (switch-to-buffer buf-C)
-	      (setq wind-C (selected-window))
-	      )))
-    
-    (ediff-eval-in-buffer control-buf
-      (setq ediff-window-A wind-A
-	    ediff-window-B wind-B
-	    ediff-window-C wind-C)
-      
-      (setq frame-A (window-frame ediff-window-A)
-	    designated-minibuffer-frame
-	    (window-frame (minibuffer-window frame-A))))
-    
-    ;; It is unlikely that we'll implement a version of ediff-windows that
-    ;; would compare 3 windows at once. So, we don't use buffer C here.
-    (if ediff-windows-job
-	(progn
-	  (set-window-start wind-A wind-A-start)
-	  (set-window-start wind-B wind-B-start)))
-    
-    (ediff-setup-control-frame control-buf designated-minibuffer-frame)
-    ))
-
-;; skip unsplittable frames and frames that have dedicated windows.
-;; create a new splittable frame if none is found
-(defun ediff-skip-unsuitable-frames (&optional ok-unsplittable)
-  (if (ediff-window-display-p)
-      (let (last-window)
-	(while (and (not (eq (selected-window) last-window))
-		    (or
-		     (ediff-frame-has-dedicated-windows (selected-frame))
-		     (ediff-frame-iconified-p (selected-frame))
-		     (< (frame-height (selected-frame))
-			(* 3 window-min-height))
-		     (if ok-unsplittable
-			 nil
-		       (ediff-frame-unsplittable-p (selected-frame)))))
-	  ;; remember where started
-	  (or last-window (setq last-window (selected-window)))
-	  ;; try new window
-	  (other-window 1 t))
-	(if (eq (selected-window) last-window)
-	    ;; fed up, no appropriate frame
-	    (progn
-	      (select-frame (make-frame '((unsplittable)))))))))
-
-(defun ediff-frame-has-dedicated-windows (frame)
-  (let ((cur-fr (selected-frame))
-	ans)
-    (select-frame frame)
-    (walk-windows 
-     (function (lambda (wind)
-		 (if (window-dedicated-p wind)
-		     (setq ans t))))
-     'ignore-minibuffer
-     frame)
-    (select-frame cur-fr)
-    ans))
-
-;; window is ok, if it is only one window on the frame, not counting the
-;; minibuffer, or none of the frame's windows is dedicated.
-;; The idea is that it is bad to destroy dedicated windows while creating an
-;; ediff window setup
-(defun ediff-window-ok-for-display (wind)
-  (and
-   (window-live-p wind)
-   (or 
-    ;; only one window
-    (eq wind (next-window wind 'ignore-minibuffer (window-frame wind)))
-    ;; none is dedicated
-    (not (ediff-frame-has-dedicated-windows (window-frame wind)))
-    )))
-
-;; Prepare or refresh control frame
-(defun ediff-setup-control-frame (ctl-buffer designated-minibuffer-frame)
-  (let ((window-min-height 1)
-	ctl-frame-iconified-p dont-iconify-ctl-frame deiconify-ctl-frame
-	ctl-frame old-ctl-frame lines 
-	;; user-grabbed-mouse
-	fheight fwidth adjusted-parameters) 
-	
-    (ediff-eval-in-buffer ctl-buffer
-      (if ediff-xemacs-p (set-buffer-menubar nil))
-      ;;(setq user-grabbed-mouse (ediff-user-grabbed-mouse))
-      (run-hooks 'ediff-before-setup-control-frame-hook))
-  
-    (setq old-ctl-frame (ediff-eval-in-buffer ctl-buffer ediff-control-frame))
-    (ediff-eval-in-buffer ctl-buffer
-      (setq ctl-frame (if (frame-live-p old-ctl-frame)
-			  old-ctl-frame
-			(make-frame ediff-control-frame-parameters))
-	    ediff-control-frame ctl-frame))
-    
-    (setq ctl-frame-iconified-p (ediff-frame-iconified-p ctl-frame))
-    (select-frame ctl-frame)
-    (if (window-dedicated-p (selected-window))
-	()
-      (delete-other-windows)
-      (switch-to-buffer ctl-buffer))
-      
-    ;; must be before ediff-setup-control-buffer
-    ;; just a precaution--we should be in ctl-buffer already
-    (ediff-eval-in-buffer ctl-buffer
-      (make-local-variable 'frame-title-format)
-      (make-local-variable 'frame-icon-title-format)	; XEmacs
-      (make-local-variable 'icon-title-format))  	; Emacs
-    
-    (ediff-setup-control-buffer ctl-buffer)
-    (setq dont-iconify-ctl-frame
-	  (not (string= ediff-help-message ediff-brief-help-message)))
-    (setq deiconify-ctl-frame 
-	  (and (eq this-command 'ediff-toggle-help)
-	       dont-iconify-ctl-frame))
-    
-    ;; 1 more line for the modeline
-    (setq lines (1+ (count-lines (point-min) (point-max)))
-	  fheight lines
-	  fwidth (max (+ (ediff-help-message-line-length) 2)
-		      (ediff-compute-toolbar-width))
-	  adjusted-parameters (append (list
-				       ;; possibly change surrogate minibuffer
-				       (cons 'minibuffer
-					     (minibuffer-window
-					      designated-minibuffer-frame))
-				       (cons 'width fwidth)
-				       (cons 'height fheight))
-				      (funcall
-				       ediff-control-frame-position-function
-				       ctl-buffer fwidth fheight)))
-    (if ediff-use-long-help-message
-	(setq adjusted-parameters
-	      (cons '(auto-raise . nil) adjusted-parameters)))
-    
-    ;; In XEmacs, buffer menubar needs to be killed before frame parameters
-    ;; are changed. 
-    (if ediff-xemacs-p
-	(progn
-	  (set-specifier top-toolbar-height (list ctl-frame 0))
-	  (set-specifier bottom-toolbar-height (list ctl-frame 0))
-	  (set-specifier left-toolbar-width (list ctl-frame 0))
-	  (set-specifier right-toolbar-width (list ctl-frame 0))
-	  ))
-    
-    ;; Under OS/2 (emx) we have to call modify frame parameters twice, in order
-    ;; to make sure that at least once we do it for non-iconified frame. If
-    ;; appears that in the OS/2 port of Emacs, one can't modify frame
-    ;; parameters of iconified frames. As a precaution, we do likewise for
-    ;; windows-nt.
-    (if (memq system-type '(emx windows-nt windows-95))
-	(modify-frame-parameters ctl-frame adjusted-parameters))
-      
-    (goto-char (point-min))
-    
-    (modify-frame-parameters ctl-frame adjusted-parameters)
-    (make-frame-visible ctl-frame)
-    (ediff-make-bottom-toolbar) ; no effect if the toolbar is not requested
-    
-    ;; This works around a bug in 19.25 and earlier. There, if frame gets
-    ;; iconified, the current buffer changes to that of the frame that
-    ;; becomes exposed as a result of this iconification.
-    ;; So, we make sure the current buffer doesn't change.
-    (select-frame ctl-frame)
-    (ediff-refresh-control-frame)
-    
-    (cond ((and ediff-prefer-iconified-control-frame
-		(not ctl-frame-iconified-p) (not dont-iconify-ctl-frame))
-	   (iconify-frame ctl-frame))
-	  ((or deiconify-ctl-frame (not ctl-frame-iconified-p))
-	   (raise-frame ctl-frame)))
-    
-    (set-window-dedicated-p (selected-window) t)
-      
-    ;; synchronize so the cursor will move to control frame
-    ;; per RMS suggestion
-    (if (ediff-window-display-p)
-	(let ((count 7))
-	  (sit-for .1)
-	  (while (and (not (frame-visible-p ctl-frame)) (> count 0))
-	    (setq count (1- count))
-	    (sit-for .3))))
-
-    (or (ediff-frame-iconified-p ctl-frame)
-	;; don't warp the mouse, unless ediff-grab-mouse = t
-	(ediff-reset-mouse ctl-frame
-			   (or (eq this-command 'ediff-quit)
-			       (not (eq ediff-grab-mouse t)))))
-	
-    (if ediff-xemacs-p
-	(ediff-eval-in-buffer ctl-buffer
-	  (make-local-hook 'select-frame-hook)
-	  (add-hook 'select-frame-hook 'ediff-xemacs-select-frame-hook nil t)
-	  ))
-	
-    (ediff-eval-in-buffer ctl-buffer
-      (run-hooks 'ediff-after-setup-control-frame-hook))
-    ))
-    
-(defun ediff-destroy-control-frame (ctl-buffer)
-  (ediff-eval-in-buffer ctl-buffer
-    (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame))
-	(let ((ctl-frame ediff-control-frame))
-	  (if ediff-xemacs-p
-	      (set-buffer-menubar default-menubar))
-	  (setq ediff-control-frame nil)
-	  (delete-frame ctl-frame)
-	  )))
-  (ediff-skip-unsuitable-frames)
-  ;;(ediff-reset-mouse nil)
-  )
-    
-
-;; finds a good place to clip control frame
-(defun ediff-make-frame-position (ctl-buffer ctl-frame-width ctl-frame-height)
-  (ediff-eval-in-buffer ctl-buffer
-    (let* ((frame-A (window-frame ediff-window-A))
-	   (frame-A-parameters (frame-parameters frame-A))
-	   (frame-A-top (eval (cdr (assoc 'top frame-A-parameters))))
-	   (frame-A-left (eval (cdr (assoc 'left frame-A-parameters))))
-	   (frame-A-width (frame-width frame-A))
-	   (ctl-frame ediff-control-frame)
-	   horizontal-adjustment upward-adjustment
-	   ctl-frame-top ctl-frame-left) 
-      
-      ;; Multiple control frames are clipped based on the value of
-      ;; ediff-control-buffer-number. This is done in order not to obscure
-      ;; other active control panels.
-      (setq horizontal-adjustment (* 2 ediff-control-buffer-number)
-	    upward-adjustment (* -14 ediff-control-buffer-number))
-
-      (setq ctl-frame-top
-	    (- frame-A-top upward-adjustment ediff-control-frame-upward-shift)
-	    ctl-frame-left
-	    (+ frame-A-left
-	       (if ediff-use-long-help-message
-		   (* (ediff-frame-char-width ctl-frame)
-		      (+ ediff-wide-control-frame-rightward-shift
-			 horizontal-adjustment))
-		 (- (* frame-A-width (ediff-frame-char-width frame-A))
-		    (* (ediff-frame-char-width ctl-frame)
-		       (+ ctl-frame-width
-			  ediff-narrow-control-frame-leftward-shift
-			  horizontal-adjustment))))))
-      (setq ctl-frame-top
-	    (min ctl-frame-top
-		 (- (ediff-display-pixel-height)
-		    (* 2 ctl-frame-height
-		       (ediff-frame-char-height ctl-frame))))
-	    ctl-frame-left
-	    (min ctl-frame-left
-		 (- (ediff-display-pixel-width)
-		    (* ctl-frame-width (ediff-frame-char-width ctl-frame)))))
-      ;; keep ctl frame within the visible bounds
-      (setq ctl-frame-top (max ctl-frame-top 1)
-	    ctl-frame-left (max ctl-frame-left 1))
-      
-      (list (cons 'top ctl-frame-top)
-	    (cons 'left ctl-frame-left))
-      )))
-			       
-(defun ediff-xemacs-select-frame-hook ()
-  (if (and (equal (selected-frame) ediff-control-frame)
-	   (not ediff-use-long-help-message))
-      (raise-frame ediff-control-frame)))
-	
-(defun ediff-make-wide-display ()
-  "Construct an alist of parameters for the wide display.
-Saves the old frame parameters in `ediff-wide-display-orig-parameters'.
-The frame to be resized is kept in `ediff-wide-display-frame'.
-This function modifies only the left margin and the width of the display.
-It assumes that it is called from within the control buffer."
-  (if (not (fboundp 'ediff-display-pixel-width))
-      (error "Can't determine display width."))
-  (let* ((frame-A (window-frame ediff-window-A))
-	 (frame-A-params (frame-parameters frame-A))
-	 (cw (ediff-frame-char-width frame-A))
-	 (wd (- (/ (ediff-display-pixel-width) cw) 5)))
-    (setq ediff-wide-display-orig-parameters 
-	  (list (cons 'left (max 0 (eval (cdr (assoc 'left frame-A-params)))))
-		(cons 'width (cdr (assoc 'width frame-A-params))))
-	  ediff-wide-display-frame frame-A)
-    (modify-frame-parameters frame-A (list (cons 'left cw)
-						 (cons 'width wd)))))
-  
-      
-
-;; Revise the mode line to display which difference we have selected
-;; Also resets modelines of buffers A/B, since they may be clobbered by
-;; anothe invocations of Ediff.
-(defun ediff-refresh-mode-lines ()
-  (let (buf-A-state-diff buf-B-state-diff buf-C-state-diff buf-C-state-merge)
-    
-    (if (ediff-valid-difference-p)
-	(setq
-	 buf-C-state-diff (ediff-get-state-of-diff ediff-current-difference 'C)
-	 buf-C-state-merge (ediff-get-state-of-merge ediff-current-difference)
-	 buf-A-state-diff (ediff-get-state-of-diff ediff-current-difference 'A)
-	 buf-B-state-diff (ediff-get-state-of-diff ediff-current-difference 'B)
-	 buf-A-state-diff (if buf-A-state-diff
-			      (format "[%s] " buf-A-state-diff)
-			    "")
-	 buf-B-state-diff (if buf-B-state-diff
-			      (format "[%s] " buf-B-state-diff)
-			    "")
-	 buf-C-state-diff (if (and (ediff-buffer-live-p ediff-buffer-C)
-				   (or buf-C-state-diff buf-C-state-merge))
-			      (format "[%s%s%s] "
-				      (or buf-C-state-diff "")
-				      (if buf-C-state-merge
-					  (concat " " buf-C-state-merge)
-					"")
-				      (if (ediff-get-state-of-ancestor 
-					   ediff-current-difference)
-					  " AncestorEmpty"
-					"")
-				      )
-			    ""))
-      (setq buf-A-state-diff ""
-	    buf-B-state-diff ""
-	    buf-C-state-diff ""))
-    
-    ;; control buffer format
-    (setq mode-line-format
-	  (list (if (ediff-narrow-control-frame-p) "   " "-- ")
-		mode-line-buffer-identification
-		"        Quick Help"))
-    ;; control buffer id
-    (setq mode-line-buffer-identification 
-	  (if (ediff-narrow-control-frame-p)
-	      (ediff-make-narrow-control-buffer-id 'skip-name)
-	    (ediff-make-wide-control-buffer-id)))
-    ;; Force mode-line redisplay
-    (force-mode-line-update)
-    
-    (if (and (ediff-window-display-p) (frame-live-p ediff-control-frame))
-	(ediff-refresh-control-frame))
-    
-    (ediff-eval-in-buffer ediff-buffer-A
-      (setq ediff-diff-status buf-A-state-diff)
-      (ediff-strip-mode-line-format)
-      (setq mode-line-format
-	    (list " A: " 'ediff-diff-status mode-line-format))
-      (force-mode-line-update))
-    (ediff-eval-in-buffer ediff-buffer-B
-      (setq ediff-diff-status buf-B-state-diff)
-      (ediff-strip-mode-line-format)
-      (setq mode-line-format
-	    (list " B: " 'ediff-diff-status mode-line-format))
-      (force-mode-line-update))
-    (if ediff-3way-job
-	(ediff-eval-in-buffer ediff-buffer-C
-	  (setq ediff-diff-status buf-C-state-diff)
-	  (ediff-strip-mode-line-format)
-	  (setq mode-line-format
-		(list " C: " 'ediff-diff-status mode-line-format))
-	  (force-mode-line-update)))
-    (if (ediff-buffer-live-p ediff-ancestor-buffer)
-	(ediff-eval-in-buffer ediff-ancestor-buffer
-	  (ediff-strip-mode-line-format)
-	  ;; we keep the second dummy string in the mode line format of the
-	  ;; ancestor, since for other buffers Ediff prepends 2 strings and
-	  ;; ediff-strip-mode-line-format expects that.
-	  (setq mode-line-format
-		(list " Ancestor: "
-		      (cond ((not (stringp buf-C-state-merge))
-			     "")
-			    ((string-match "prefer-A" buf-C-state-merge)
-			     "[=diff(B)] ")
-			    ((string-match "prefer-B" buf-C-state-merge)
-			     "[=diff(A)] ")
-			    (t ""))
-		      mode-line-format))))
-    ))
-    
-  
-(defun ediff-refresh-control-frame ()
-  (if ediff-emacs-p
-      ;; set frame/icon titles for Emacs
-      (modify-frame-parameters
-       ediff-control-frame
-       (list (cons 'title (ediff-make-base-title))
-	     (cons 'icon-name (ediff-make-narrow-control-buffer-id))
-	     ))
-    ;; set frame/icon titles for XEmacs
-    (setq frame-title-format (ediff-make-base-title)
-	  frame-icon-title-format (ediff-make-narrow-control-buffer-id))
-    ;; force an update of the frame title
-    (modify-frame-parameters ediff-control-frame '(()))))
-   
-  
-(defun ediff-make-narrow-control-buffer-id (&optional skip-name)
-  (concat
-   (if skip-name
-       " "
-     (ediff-make-base-title))
-   (cond ((< ediff-current-difference 0) 
-	  (format " _/%d" ediff-number-of-differences))
-	 ((>= ediff-current-difference ediff-number-of-differences)
-	  (format " $/%d" ediff-number-of-differences))
-	 (t
-	  (format " %d/%d"
-		  (1+ ediff-current-difference)
-		  ediff-number-of-differences)))))
-
-(defun ediff-make-base-title ()
-  (concat
-   (cdr (assoc 'name ediff-control-frame-parameters))
-   ediff-control-buffer-suffix))
-		  
-(defun ediff-make-wide-control-buffer-id ()
-  (cond ((< ediff-current-difference 0)
-	 (list (format "%%b   At start of %d diffs"
-		       ediff-number-of-differences)))
-	((>= ediff-current-difference ediff-number-of-differences)
-	 (list (format "%%b   At end of %d diffs"
-		       ediff-number-of-differences)))
-	(t
-	 (list (format "%%b   diff %d of %d"
-		       (1+ ediff-current-difference)
-		       ediff-number-of-differences)))))
-
-
-
-;; If buff is not live, return nil
-(defun ediff-get-visible-buffer-window (buff)
-  (if (ediff-buffer-live-p buff)
-      (if ediff-xemacs-p
-	  (get-buffer-window buff t)
-	(get-buffer-window buff 'visible))))
-	
-
-;;; Functions to decide when to redraw windows
-  
-(defun ediff-keep-window-config (control-buf)
-  (and (eq control-buf (current-buffer))
-       (/= (buffer-size) 0)
-       (ediff-eval-in-buffer control-buf
-	 (let ((ctl-wind ediff-control-window)
-	       (A-wind ediff-window-A)
-	       (B-wind ediff-window-B)
-	       (C-wind ediff-window-C))
-	  
-	   (and
-	    (ediff-window-visible-p A-wind)
-	    (ediff-window-visible-p B-wind)
-	    ;; if buffer C is defined then take it into account
-	    (or (not ediff-3way-job)
-		(ediff-window-visible-p C-wind))
-	    (eq (window-buffer A-wind) ediff-buffer-A)
-	    (eq (window-buffer B-wind) ediff-buffer-B)
-	    (or (not ediff-3way-job)
-		(eq (window-buffer C-wind) ediff-buffer-C))
-	    (string= ediff-window-config-saved
-		     (format "%S%S%S%S%S%S%S"
-			     ctl-wind A-wind B-wind C-wind
-			     ediff-split-window-function
-			     (ediff-multiframe-setup-p)
-			     ediff-wide-display-p)))))))
-
-
-;;; Local Variables:
-;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
-;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
-;;; End:
-
-(provide 'ediff-wind)
-
-
-;;; ediff-wind.el ends here
diff --git a/lisp/ediff.el b/lisp/ediff.el
deleted file mode 100644
index 9c4c8cec3e5..00000000000
--- a/lisp/ediff.el
+++ /dev/null
@@ -1,1279 +0,0 @@
-;;; ediff.el --- a comprehensive visual interface to diff & patch
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Kifer <kifer@cs.sunysb.edu>
-;; Created: February 2, 1994
-;; Keywords: comparing, merging, patching, version control.
-
-(defconst ediff-version "2.63" "The current version of Ediff")
-(defconst ediff-date "September 12, 1996" "Date of last update")  
-
-
-;; 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:
-
-;; Never read that diff output again!
-;; Apply patch interactively!
-;; Merge with ease!
-
-;; This package provides a convenient way of simultaneous browsing through
-;; the differences between a pair (or a triple) of files or buffers.  The
-;; files being compared, file-A, file-B, and file-C (if applicable) are
-;; shown in separate windows (side by side, one above the another, or in
-;; separate frames), and the differences are highlighted as you step
-;; through them.  You can also copy difference regions from one buffer to
-;; another (and recover old differences if you change your mind).
-
-;; Ediff also supports merging operations on files and buffers, including
-;; merging using ancestor versions. Both comparison and merging operations can
-;; be performed on directories, i.e., by pairwise comparison of files in those
-;; directories.
-
-;; In addition, Ediff can apply a patch to a file and then let you step
-;; though both files, the patched and the original one, simultaneously,
-;; difference-by-difference.  You can even apply a patch right out of a
-;; mail buffer, i.e., patches received by mail don't even have to be saved.
-;; Since Ediff lets you copy differences between buffers, you can, in
-;; effect, apply patches selectively (i.e., you can copy a difference
-;; region from file_orig to file, thereby undoing any particular patch that
-;; you don't like).
-
-;; Ediff is aware of version control, which lets the user compare
-;; files with their older versions. Ediff can also work with remote and
-;; compressed files. Details are given below.
-
-;; Finally, Ediff supports directory-level comparison, merging and patching.
-;; See the on-line manual for details.
-
-;; This package builds upon the ideas borrowed from emerge.el and several
-;; Ediff's functions are adaptations from emerge.el. Much of the functionality
-;; Ediff provides is also influenced by emerge.el.
-
-;; The present version of Ediff supersedes Emerge. It provides a superior user
-;; interface and has numerous major features not found in Emerge. In
-;; particular, it can do patching, and 2-way and 3-way file comparison,
-;; merging, and directory operations.
-
-
-
-;;; Bugs:
-
-;;  1. The undo command doesn't restore deleted regions well. That is, if
-;;  you delete all characters in a difference region and then invoke
-;;  `undo', the reinstated text will most likely be inserted outside of
-;;  what Ediff thinks is the current difference region. (This problem
-;;  doesn't seem to exist with XEmacs.)
-;;
-;;  If at any point you feel that difference regions are no longer correct,
-;;  you can hit '!' to recompute the differences.
-
-;;  2. On a monochrome display, the repertoire of faces with which to
-;;  highlight fine differences is limited. By default, Ediff is using
-;;  underlining. However, if the region is already underlined by some other
-;;  overlays, there is no simple way to temporarily remove that residual
-;;  underlining. This problem occurs when a buffer is highlighted with
-;;  hilit19.el or font-lock.el packages. If this residual highlighting gets
-;;  in the way, you can do the following. Both font-lock.el and hilit19.el
-;;  provide commands for unhighlighting buffers. You can either place these
-;;  commands in `ediff-prepare-buffer-hook' (which will unhighlight every
-;;  buffer used by Ediff) or you can execute them interactively, at any time
-;;  and on any buffer.
-
-
-;;; Acknowledgements:
-
-;; Ediff was inspired by Dale R. Worley's <drw@math.mit.edu> emerge.el.
-;; Ediff would not have been possible without the help and encouragement of
-;; its many users. See Ediff on-line Info for the full list of those who
-;; helped. Improved defaults in Ediff file-name reading commands.
-
-;;; Code:
-
-(require 'ediff-init)
-;; ediff-mult is always required, because of the registry stuff
-(require 'ediff-mult)
-
-(and noninteractive
-     (eval-when-compile
-       (let ((load-path (cons (expand-file-name ".") load-path)))
-	 (load-library "dired")
-	 (load-file "ediff-ptch.el")
-	 (load-file "ediff-vers.el")
-	 (load "pcl-cvs" 'noerror))))
-
-(defvar ediff-use-last-dir nil
-  "*If t, Ediff uses previous directory as default when reading file name.")
-  
-(defvar ediff-last-dir-A nil
-  "Last directory used by an Ediff command for file-A.")
-(defvar ediff-last-dir-B nil
-  "Last directory used by an Ediff command for file-B.")
-(defvar ediff-last-dir-C nil
-  "Last directory used by an Ediff command for file-C.")
-(defvar ediff-last-dir-ancestor nil
-  "Last directory used by an Ediff command for the ancestor file.")
-(defvar ediff-last-merge-autostore-dir
-  "Last directory used by an Ediff command as the output directory for merge.")
-
-;; Some defvars to reduce the number of compiler warnings
-(defvar cvs-cookie-handle)
-(defvar ediff-last-dir-patch)
-(defvar ediff-patch-default-directory)
-;; end of compiler pacifier
-
-
-;; Used as a startup hook to set `_orig' patch file read-only.
-(defun ediff-set-read-only-in-buf-A ()
-  (ediff-eval-in-buffer ediff-buffer-A
-    (toggle-read-only 1)))
-
-;; Return a plausible default for ediff's first file:
-;; In dired, return the file name under the point, unless it is a directory
-;; If the buffer has a file name, return that file name.
-(defun ediff-get-default-file-name ()
-  (cond ((eq major-mode 'dired-mode)
-	 (let ((f (dired-get-filename nil 'no-error)))
-	   (if (and (stringp f) (not (file-directory-p f)))
-	       f)))
-	((buffer-file-name (current-buffer))
-	 (file-name-nondirectory (buffer-file-name (current-buffer))))
-	))
-
-;;; Compare files/buffers
-
-;;;###autoload
-(defun ediff-files (file-A file-B &optional startup-hooks)
-  "Run Ediff on a pair of files, FILE-A and FILE-B."
-  (interactive
-   (let ((dir-A (if ediff-use-last-dir
-		    ediff-last-dir-A
-		  default-directory))
-	 dir-B f)
-     (list (setq f (ediff-read-file-name
-		    "File A to compare" dir-A 
-		    (ediff-get-default-file-name)))
-	   (ediff-read-file-name "File B to compare" 
-				 (setq dir-B
-				       (if ediff-use-last-dir
-					   ediff-last-dir-B 
-					 (file-name-directory f)))
-				 (progn
-				   (setq file-name-history
-					 (cons (ediff-abbreviate-file-name
-						(expand-file-name
-						 (file-name-nondirectory f)
-						 dir-B))
-					       file-name-history))
-				   f))
-	   )))
-  (ediff-files-internal file-A 
-			(if (file-directory-p file-B)
-			    (expand-file-name
-			     (file-name-nondirectory file-A) file-B)
-			  file-B)
-			nil ; file-C
-			startup-hooks
-			'ediff-files))
-  
-;;;###autoload
-(defun ediff-files3 (file-A file-B file-C &optional startup-hooks)
-  "Run Ediff on three files, FILE-A, FILE-B, and FILE-C."
-  (interactive
-   (let ((dir-A (if ediff-use-last-dir
-		    ediff-last-dir-A
-		  default-directory))
-	 dir-B dir-C f ff)
-     (list (setq f (ediff-read-file-name
-		    "File A to compare" dir-A
-		    (ediff-get-default-file-name)))
-	   (setq ff (ediff-read-file-name "File B to compare" 
-					  (setq dir-B
-						(if ediff-use-last-dir
-						    ediff-last-dir-B
-						  (file-name-directory f)))
-					  (progn
-					    (setq file-name-history
-						  (cons
-						   (ediff-abbreviate-file-name
-						    (expand-file-name
-						     (file-name-nondirectory f)
-						     dir-B))
-						   file-name-history))
-					    f)))
-	   (ediff-read-file-name "File C to compare" 
-				 (setq dir-C (if ediff-use-last-dir
-						 ediff-last-dir-C
-					       (file-name-directory ff)))
-				 (progn
-				   (setq file-name-history
-					 (cons (ediff-abbreviate-file-name
-						(expand-file-name
-						 (file-name-nondirectory ff)
-						 dir-C))
-					       file-name-history))
-				   ff))
-	   )))
-  (ediff-files-internal file-A 
-			(if (file-directory-p file-B)
-			    (expand-file-name
-			     (file-name-nondirectory file-A) file-B)
-			  file-B)
-			(if (file-directory-p file-C)
-			    (expand-file-name
-			     (file-name-nondirectory file-A) file-C)
-			  file-C)
-			startup-hooks
-			'ediff-files3))
-
-;;;###autoload
-(defalias 'ediff3 'ediff-files3)
-
-
-;; Visit FILE and arrange its buffer to Ediff's liking. 
-;; FILE is actually a variable symbol that must contain a true file name.
-;; BUFFER-NAME is a variable symbol, which will get the buffer object into
-;; which FILE is read.
-;; LAST-DIR is the directory variable symbol where FILE's
-;; directory name should be returned. HOOKS-VAR is a variable symbol that will
-;; be assigned the hook to be executed after `ediff-startup' is finished.
-;; `ediff-find-file' arranges that the temp files it might create will be
-;; deleted.
-(defun ediff-find-file (file-var buffer-name &optional last-dir hooks-var)
-  (let* ((file (symbol-value file-var))
-	 (file-magic (find-file-name-handler file 'find-file-noselect))
-	 (temp-file-name-prefix (file-name-nondirectory file)))
-    (cond ((not (file-readable-p file))
-	   (error "File `%s' does not exist or is not readable" file))
-	  ((file-directory-p file)
-	   (error "File `%s' is a directory" file)))
-	
-    ;; some of the commands, below, require full file name
-    (setq file (expand-file-name file))
-  
-    ;; Record the directory of the file
-    (if last-dir
-	(set last-dir (expand-file-name (file-name-directory file))))
-    
-    ;; Setup the buffer
-    (set buffer-name (find-file-noselect file))
-  
-    (ediff-eval-in-buffer (symbol-value buffer-name)
-      (widen) ; Make sure the entire file is seen
-      (cond (file-magic  ;; file has handler, such as jka-compr-handler or
-	     ;; ange-ftp-hook-function--arrange for temp file
-	     (ediff-verify-file-buffer 'magic)
-	     (setq file
-		   (ediff-make-temp-file
-		    (current-buffer) temp-file-name-prefix))
-	     (set hooks-var (cons (` (lambda () (delete-file (, file))))
-				  (symbol-value hooks-var))))
-	    ;; file processed via auto-mode-alist, a la uncompress.el
-	    ((not (equal (file-truename file)
-			 (file-truename (buffer-file-name))))
-	     (setq file
-		   (ediff-make-temp-file
-		    (current-buffer) temp-file-name-prefix))
-	     (set hooks-var (cons (` (lambda () (delete-file (, file))))
-				  (symbol-value hooks-var))))
-	    (t ;; plain file---just check that the file matches the buffer
-	     (ediff-verify-file-buffer))))
-    (set file-var file)))
-
-(defun ediff-files-internal (file-A file-B file-C startup-hooks job-name)
-  (let (buf-A buf-B buf-C)
-    (message "Reading file %s ... " file-A)
-    ;;(sit-for 0)
-    (ediff-find-file 'file-A 'buf-A 'ediff-last-dir-A 'startup-hooks)
-    (message "Reading file %s ... " file-B)
-    ;;(sit-for 0)
-    (ediff-find-file 'file-B 'buf-B 'ediff-last-dir-B 'startup-hooks)
-    (if (stringp file-C)
-	(progn
-	  (message "Reading file %s ... " file-C)
-	  ;;(sit-for 0)
-	  (ediff-find-file
-	   'file-C 'buf-C
-	   (if (eq job-name 'ediff-merge-files-with-ancestor)
-	       'ediff-last-dir-ancestor 'ediff-last-dir-C)
-	   'startup-hooks)))
-    (ediff-setup buf-A file-A
-		 buf-B file-B
-		 buf-C file-C
-		 startup-hooks
-		 (list (cons 'ediff-job-name job-name)))))
-  
-
-;;;###autoload
-(defalias 'ediff 'ediff-files)
-
-
-;;;###autoload
-(defun ediff-buffers (buffer-A buffer-B &optional startup-hooks job-name)
-  "Run Ediff on a pair of buffers, BUFFER-A and BUFFER-B."
-  (interactive 
-   (let (bf)
-     (list (setq bf (read-buffer "Buffer A to compare: "
-				 (ediff-other-buffer "") t))
-	   (read-buffer "Buffer B to compare: "
-			(progn
-			  ;; realign buffers so that two visible bufs will be
-			  ;; at the top
-			  (save-window-excursion (other-window 1))
-			  (ediff-other-buffer bf))
-			t))))
-  (or job-name (setq job-name 'ediff-buffers))
-  (ediff-buffers-internal buffer-A buffer-B nil startup-hooks job-name))
-
-;;;###autoload
-(defalias 'ebuffers 'ediff-buffers)
-
-      
-;;;###autoload
-(defun ediff-buffers3 (buffer-A buffer-B buffer-C
-				 &optional startup-hooks job-name)
-  "Run Ediff on three buffers, BUFFER-A, BUFFER-B, and BUFFER-C."
-  (interactive 
-   (let (bf bff)
-     (list (setq bf (read-buffer "Buffer A to compare: "
-				 (ediff-other-buffer "") t))
-	   (setq bff (read-buffer "Buffer B to compare: "
-				  (progn
-				    ;; realign buffers so that two visible
-				    ;; bufs will be at the top
-				    (save-window-excursion (other-window 1))
-				    (ediff-other-buffer bf))
-				  t))
-	   (read-buffer "Buffer C to compare: "
-				  (progn
-				    ;; realign buffers so that three visible
-				    ;; bufs will be at the top
-				    (save-window-excursion (other-window 1))
-				    (ediff-other-buffer (list bf bff)))
-				  t)
-	   )))
-  (or job-name (setq job-name 'ediff-buffers3))
-  (ediff-buffers-internal buffer-A buffer-B buffer-C startup-hooks job-name))
-
-;;;###autoload
-(defalias 'ebuffers3 'ediff-buffers3)
-      
-
-			
-(defun ediff-buffers-internal (buf-A buf-B buf-C startup-hooks job-name)
-  (let* ((buf-A-file-name (buffer-file-name (get-buffer buf-A)))
-	 (buf-B-file-name (buffer-file-name (get-buffer buf-B)))
-	 (buf-C-is-alive (ediff-buffer-live-p buf-C))
-	 (buf-C-file-name (if buf-C-is-alive
-			      (buffer-file-name (get-buffer buf-B))))
-	 file-A file-B file-C)
-    (if (not (ediff-buffer-live-p buf-A))
-	(error "Buffer %S doesn't exist" buf-A))
-    (if (not (ediff-buffer-live-p buf-B))
-	(error "Buffer %S doesn't exist" buf-B))
-    (let ((ediff-job-name job-name))
-      (if (and ediff-3way-comparison-job
-	       (not buf-C-is-alive))
-	  (error "Buffer %S doesn't exist" buf-C)))
-    (if (stringp buf-A-file-name)
-	(setq buf-A-file-name (file-name-nondirectory buf-A-file-name)))
-    (if (stringp buf-B-file-name)
-	(setq buf-B-file-name (file-name-nondirectory buf-B-file-name)))
-    (if (stringp buf-C-file-name)
-	(setq buf-C-file-name (file-name-nondirectory buf-C-file-name)))
-	
-    (setq file-A (ediff-make-temp-file buf-A buf-A-file-name)
-	  file-B (ediff-make-temp-file buf-B buf-B-file-name))
-    (if buf-C-is-alive
-	(setq file-C (ediff-make-temp-file buf-C buf-C-file-name)))
-	  
-    (ediff-setup (get-buffer buf-A) file-A
-		 (get-buffer buf-B) file-B
-		 (if buf-C-is-alive (get-buffer buf-C))
-		 file-C
-		 (cons (` (lambda ()
-			    (delete-file (, file-A))
-			    (delete-file (, file-B))
-			    (if (stringp (, file-C)) (delete-file (, file-C)))
-			    ))
-		       startup-hooks)
-		 (list (cons 'ediff-job-name job-name))
-		 )))
-
-
-;;; Directory and file group operations
-
-;; Get appropriate default name for directory:
-;; If ediff-use-last-dir, use ediff-last-dir-A.
-;; In dired mode, use the directory that is under the point (if any);
-;; otherwise, use default-directory
-(defun ediff-get-default-directory-name ()
-  (cond (ediff-use-last-dir ediff-last-dir-A)
-	((eq major-mode 'dired-mode)
-	 (let ((f (dired-get-filename nil 'noerror)))
-	   (if (and (stringp f) (file-directory-p f))
-	       f
-	     default-directory)))
-	(t default-directory)))
-
-
-;;;###autoload
-(defun ediff-directories (dir1 dir2 regexp)
-  "Run Ediff on a pair of directories, DIR1 and DIR2, comparing files that have
-the same name in both. The third argument, REGEXP, is a regular expression that
-can be used to filter out certain file names."
-  (interactive
-   (let ((dir-A (ediff-get-default-directory-name))
-	 f)
-     (list (setq f (ediff-read-file-name "Directory A to compare:" dir-A nil))
-	   (ediff-read-file-name "Directory B to compare:" 
-				 (if ediff-use-last-dir
-				     ediff-last-dir-B 
-				   (ediff-strip-last-dir f))
-				 nil)
-	   (read-string "Filter through regular expression: "
-			nil 'ediff-filtering-regexp-history)
-	   )))
-  (ediff-directories-internal
-   dir1 dir2 nil regexp 'ediff-files 'ediff-directories
-   ))
-
-;;;###autoload
-(defalias 'edirs 'ediff-directories)
-
-
-;;;###autoload
-(defun ediff-directory-revisions (dir1 regexp)
-  "Run Ediff on a directory, DIR1, comparing its files with their revisions.
-The second argument, REGEXP, is a regular expression that filters the file
-names. Only the files that are under revision control are taken into account."
-  (interactive
-   (let ((dir-A (ediff-get-default-directory-name)))
-     (list (ediff-read-file-name
-	    "Directory to compare with revision:" dir-A nil)
-	   (read-string "Filter through regular expression: "
-			nil 'ediff-filtering-regexp-history)
-	   )))
-  (ediff-directory-revisions-internal
-   dir1 regexp 'ediff-revision 'ediff-directory-revisions
-   ))
-
-;;;###autoload
-(defalias 'edir-revisions 'ediff-directory-revisions)
-
-
-;;;###autoload
-(defun ediff-directories3 (dir1 dir2 dir3 regexp)
-  "Run Ediff on three directories, DIR1, DIR2, and DIR3, comparing files that
-have the same name in all three. The last argument, REGEXP, is a regular
-expression that can be used to filter out certain file names."
-  (interactive
-   (let ((dir-A (ediff-get-default-directory-name))
-	 f)
-     (list (setq f (ediff-read-file-name "Directory A to compare:" dir-A nil))
-	   (setq f (ediff-read-file-name "Directory B to compare:" 
-					 (if ediff-use-last-dir
-					     ediff-last-dir-B 
-					   (ediff-strip-last-dir f))
-					 nil))
-	   (ediff-read-file-name "Directory C to compare:" 
-				 (if ediff-use-last-dir
-				     ediff-last-dir-C 
-				   (ediff-strip-last-dir f))
-				 nil)
-	   (read-string "Filter through regular expression: "
-			nil 'ediff-filtering-regexp-history)
-	   )))
-  (ediff-directories-internal
-   dir1 dir2 dir3 regexp 'ediff-files3 'ediff-directories3
-   ))
-
-;;;###autoload
-(defalias 'edirs3 'ediff-directories3)
-
-;;;###autoload
-(defun ediff-merge-directories (dir1 dir2 regexp)
-  "Run Ediff on a pair of directories, DIR1 and DIR2, merging files that have
-the same name in both. The third argument, REGEXP, is a regular expression that
-can be used to filter out certain file names."
-  (interactive
-   (let ((dir-A (ediff-get-default-directory-name))
-	 f)
-     (list (setq f (ediff-read-file-name "Directory A to merge:" dir-A nil))
-	   (ediff-read-file-name "Directory B to merge:" 
-				 (if ediff-use-last-dir
-				     ediff-last-dir-B 
-				   (ediff-strip-last-dir f))
-				 nil)
-	   (read-string "Filter through regular expression: "
-			nil 'ediff-filtering-regexp-history)
-	   )))
-  (ediff-directories-internal
-   dir1 dir2 nil regexp 'ediff-merge-files 'ediff-merge-directories
-   ))
-
-;;;###autoload
-(defalias 'edirs-merge 'ediff-merge-directories)
-
-;;;###autoload
-(defun ediff-merge-directories-with-ancestor (dir1 dir2 ancestor-dir regexp)
-  "Merge files in directories DIR1 and DIR2 using files in ANCESTOR-DIR as ancestors.
-Ediff merges files that have identical names in DIR1, DIR2. If a pair of files
-in DIR1 and DIR2 doesn't have an ancestor in ANCESTOR-DIR, Ediff will merge
-without ancestor. The fourth argument, REGEXP, is a regular expression that
-can be used to filter out certain file names."
-  (interactive
-   (let ((dir-A (ediff-get-default-directory-name))
-	 f)
-     (list (setq f (ediff-read-file-name "Directory A to merge:" dir-A nil))
-	   (setq f (ediff-read-file-name "Directory B to merge:" 
-				 (if ediff-use-last-dir
-				     ediff-last-dir-B 
-				   (ediff-strip-last-dir f))
-				 nil))
-	   (ediff-read-file-name "Ancestor directory:"
-				 (if ediff-use-last-dir
-				     ediff-last-dir-C 
-				   (ediff-strip-last-dir f))
-				 nil)
-	   (read-string "Filter through regular expression: "
-			nil 'ediff-filtering-regexp-history)
-	   )))
-  (ediff-directories-internal
-   dir1 dir2 ancestor-dir regexp
-   'ediff-merge-files-with-ancestor 'ediff-merge-directories-with-ancestor
-   ))
-
-;;;###autoload
-(defun ediff-merge-directory-revisions (dir1 regexp)
-  "Run Ediff on a directory, DIR1, merging its files with their revisions.
-The second argument, REGEXP, is a regular expression that filters the file
-names. Only the files that are under revision control are taken into account."
-  (interactive
-   (let ((dir-A (ediff-get-default-directory-name)))
-     (list (ediff-read-file-name
-	    "Directory to merge with revisions:" dir-A nil)
-	   (read-string "Filter through regular expression: "
-			nil 'ediff-filtering-regexp-history)
-	   )))
-  (ediff-directory-revisions-internal
-   dir1 regexp 'ediff-merge-revisions 'ediff-merge-directory-revisions
-   ))
-
-;;;###autoload
-(defalias 'edir-merge-revisions 'ediff-merge-directory-revisions)
-
-;;;###autoload
-(defun ediff-merge-directory-revisions-with-ancestor (dir1 regexp)
-  "Run Ediff on a directory, DIR1, merging its files with their revisions and ancestors.
-The second argument, REGEXP, is a regular expression that filters the file
-names. Only the files that are under revision control are taken into account."
-  (interactive
-   (let ((dir-A (ediff-get-default-directory-name)))
-     (list (ediff-read-file-name
-	    "Directory to merge with revisions and ancestors:" dir-A nil)
-	   (read-string "Filter through regular expression: "
-			nil 'ediff-filtering-regexp-history)
-	   )))
-  (ediff-directory-revisions-internal
-   dir1 regexp 'ediff-merge-revisions-with-ancestor
-   'ediff-merge-directory-revisions-with-ancestor
-   ))
-
-;;;###autoload
-(defalias
-  'edir-merge-revisions-with-ancestor
-  'ediff-merge-directory-revisions-with-ancestor) 
-
-;;;###autoload
-(defalias 'edirs-merge-with-ancestor 'ediff-merge-directories-with-ancestor)
-
-;; Run ediff-action (ediff-files, ediff-merge, ediff-merge-with-ancestors)
-;; on a pair of directories (three directories, in case of ancestor).
-;; The third argument, REGEXP, is a regular expression that can be used to
-;; filter out certain file names.
-;; JOBNAME is the symbol indicating the meta-job to be performed.
-;; MERGE-DIR is the directory in which to store merged files.
-(defun ediff-directories-internal (dir1 dir2 dir3 regexp action jobname 
-					&optional startup-hooks)
-  ;; ediff-read-file-name is set to attach a previously entered file name if
-  ;; the currently entered file is a directory. This code takes care of that.
-  (setq dir1 (if (file-directory-p dir1) dir1 (file-name-directory dir1))
-	dir2 (if (file-directory-p dir2) dir2 (file-name-directory dir2)))
-
-  (if (stringp dir3)
-      (setq dir3 (if (file-directory-p dir3) dir3 (file-name-directory dir3))))
-
-  (cond ((string= dir1 dir2)
-	 (error "Directories A and B are the same: %s" dir1))
-	((and (eq jobname 'ediff-directories3)
-	      (string= dir1 dir3))
-	 (error "Directories A and C are the same: %s" dir1))
-	((and (eq jobname 'ediff-directories3)
-	      (string= dir2 dir3))
-	 (error "Directories B and C are the same: %s" dir1)))
-
-  (let (diffs ; var where ediff-intersect-directories returns the diff list
-	merge-autostore-dir
-	file-list meta-buf)
-    (if (and ediff-autostore-merges (ediff-merge-metajob jobname))
-	(setq merge-autostore-dir 
-	      (ediff-read-file-name "Directory to save merged files:"
-				    (if ediff-use-last-dir
-					ediff-last-merge-autostore-dir
-				      (ediff-strip-last-dir dir1))
-				    nil)))
-    ;; verify we are not merging into an orig directory
-    (if (stringp merge-autostore-dir)
-	(cond ((and (stringp dir1) (string= merge-autostore-dir dir1))
-	       (or (y-or-n-p "Merge directory same as directory A, sure? ")
-		   (error "Directory merge aborted")))
-	      ((and (stringp dir2) (string= merge-autostore-dir dir2))
-	       (or (y-or-n-p "Merge directory same as directory B, sure? ")
-		   (error "Directory merge aborted")))
-	      ((and (stringp dir3) (string= merge-autostore-dir dir3))
-	       (or (y-or-n-p
-		    "Merge directory same as ancestor directory, sure? ")
-		   (error "Directory merge aborted")))))
-    
-    (setq file-list (ediff-intersect-directories 
-		     jobname 'diffs
-		     regexp dir1 dir2 dir3 merge-autostore-dir))
-    (setq startup-hooks
-	  ;; this sets various vars in the meta buffer inside
-	  ;; ediff-prepare-meta-buffer
-	  (cons (` (lambda ()
-		     ;; tell what to do if the user clicks on a session record
-		     (setq ediff-session-action-function (quote (, action)))
-		     ;; set ediff-dir-difference-list 
-		     (setq ediff-dir-difference-list (quote (, diffs)))))
-		startup-hooks))
-    (setq meta-buf (ediff-prepare-meta-buffer 
-		    'ediff-filegroup-action
-		    file-list
-		    "*Ediff Session Group Panel"
-		    'ediff-redraw-directory-group-buffer
-		    jobname
-		    startup-hooks))
-    (ediff-show-meta-buffer meta-buf)
-    ))
-
-(defun ediff-directory-revisions-internal (dir1 regexp action jobname 
-						&optional startup-hooks)
-  (setq dir1 (if (file-directory-p dir1) dir1 (file-name-directory dir1)))
-
-  (let (file-list meta-buf merge-autostore-dir)
-    (if (and ediff-autostore-merges (ediff-merge-metajob jobname))
-	(setq merge-autostore-dir 
-	      (ediff-read-file-name "Directory to save merged files:"
-				    (if ediff-use-last-dir
-					ediff-last-merge-autostore-dir
-				      (ediff-strip-last-dir dir1))
-				    nil)))
-    ;; verify merge-autostore-dir != dir1
-    (if (and (stringp merge-autostore-dir)
-	     (stringp dir1)
-	     (string= merge-autostore-dir dir1))
-	(or (y-or-n-p
-	     "Directory for saving merges is the same as directory A. Sure? ")
-	    (error "Merge of directory revisions aborted")))
-    
-    (setq file-list
-	  (ediff-get-directory-files-under-revision
-	   jobname regexp dir1 merge-autostore-dir))
-    (setq startup-hooks
-	  ;; this sets various vars in the meta buffer inside
-	  ;; ediff-prepare-meta-buffer
-	  (cons (` (lambda ()
-		     ;; tell what to do if the user clicks on a session record
-		     (setq ediff-session-action-function (quote (, action)))
-		     ))
-		startup-hooks))
-    (setq meta-buf (ediff-prepare-meta-buffer 
-		    'ediff-filegroup-action
-		    file-list
-		    "*Ediff Session Group Panel"
-		    'ediff-redraw-directory-group-buffer
-		    jobname
-		    startup-hooks))
-    (ediff-show-meta-buffer meta-buf)
-    ))
-
-
-;;; Compare regions and windows
-
-;;;###autoload
-(defun ediff-windows-wordwise (dumb-mode &optional wind-A wind-B startup-hooks)
-  "Compare WIND-A and WIND-B, which are selected by clicking, wordwise.
-With prefix argument, DUMB-MODE, or on a non-windowing display, works as
-follows:
-If WIND-A is nil, use selected window.
-If WIND-B is nil, use window next to WIND-A."
-  (interactive "P")
-  (ediff-windows dumb-mode wind-A wind-B
-		 startup-hooks 'ediff-windows-wordwise 'word-mode))
-		 
-;;;###autoload
-(defun ediff-windows-linewise (dumb-mode &optional wind-A wind-B startup-hooks)
-  "Compare WIND-A and WIND-B, which are selected by clicking, linewise.
-With prefix argument, DUMB-MODE, or on a non-windowing display, works as
-follows:
-If WIND-A is nil, use selected window.
-If WIND-B is nil, use window next to WIND-A."
-  (interactive "P")
-  (ediff-windows dumb-mode wind-A wind-B
-		 startup-hooks 'ediff-windows-linewise nil))
-      
-;; Compare WIND-A and WIND-B, which are selected by clicking.
-;; With prefix argument, DUMB-MODE, or on a non-windowing display,
-;; works as follows:
-;; If WIND-A is nil, use selected window.
-;; If WIND-B is nil, use window next to WIND-A.
-(defun ediff-windows (dumb-mode wind-A wind-B startup-hooks job-name word-mode)
-  (if (or dumb-mode (not (ediff-window-display-p)))
-      (setq wind-A (ediff-get-next-window wind-A nil)
-	    wind-B (ediff-get-next-window wind-B wind-A))
-    (setq wind-A (ediff-get-window-by-clicking wind-A nil 1)
-	  wind-B (ediff-get-window-by-clicking wind-B wind-A 2)))
-      
-  (let ((buffer-A (window-buffer wind-A))
-	(buffer-B (window-buffer wind-B))
-	beg-A end-A beg-B end-B)
-    
-    (save-excursion
-      (save-window-excursion
-	(sit-for 0) ; sync before using window-start/end -- a precaution
-	(select-window wind-A)
-	(setq beg-A (window-start)
-	      end-A (window-end))
-	(select-window wind-B)
-	(setq beg-B (window-start)
-	      end-B (window-end))))
-    (ediff-regions-internal
-     buffer-A beg-A end-A buffer-B beg-B end-B
-     startup-hooks job-name word-mode)))
-     
-;;;###autoload
-(defun ediff-regions-wordwise (buffer-A buffer-B &optional startup-hooks)
-  "Run Ediff on a pair of regions in two different buffers.
-Regions \(i.e., point and mark\) are assumed to be set in advance.
-This function is effective only for relatively small regions, up to 200
-lines. For large regions, use `ediff-regions-linewise'."
-  (interactive 
-   (let (bf)
-     (list (setq bf (read-buffer "Region's A buffer: "
-				 (ediff-other-buffer "") t))
-	   (read-buffer "Region's B buffer: "
-			(progn
-			  ;; realign buffers so that two visible bufs will be
-			  ;; at the top
-			  (save-window-excursion (other-window 1))
-			  (ediff-other-buffer bf))
-			t))))
-  (if (not (ediff-buffer-live-p buffer-A))
-      (error "Buffer %S doesn't exist" buffer-A))
-  (if (not (ediff-buffer-live-p buffer-B))
-      (error "Buffer %S doesn't exist" buffer-B))
-  
-  
-  (let (reg-A-beg reg-A-end reg-B-beg reg-B-end)
-    (save-excursion
-      (set-buffer buffer-A)
-      (setq reg-A-beg (region-beginning)
-	    reg-A-end (region-end))
-      (set-buffer buffer-B)
-      (setq reg-B-beg (region-beginning)
-	    reg-B-end (region-end)))
-	    
-    (ediff-regions-internal
-     (get-buffer buffer-A) reg-A-beg reg-A-end
-     (get-buffer buffer-B) reg-B-beg reg-B-end
-     startup-hooks 'ediff-regions-wordwise 'word-mode)))
-     
-;;;###autoload
-(defun ediff-regions-linewise (buffer-A buffer-B &optional startup-hooks)
-  "Run Ediff on a pair of regions in two different buffers.
-Regions \(i.e., point and mark\) are assumed to be set in advance.
-Each region is enlarged to contain full lines.
-This function is effective for large regions, over 100-200
-lines. For small regions, use `ediff-regions-wordwise'."
-  (interactive 
-   (let (bf)
-     (list (setq bf (read-buffer "Region A's buffer: "
-				 (ediff-other-buffer "") t))
-	   (read-buffer "Region B's buffer: "
-			(progn
-			  ;; realign buffers so that two visible bufs will be
-			  ;; at the top
-			  (save-window-excursion (other-window 1))
-			  (ediff-other-buffer bf))
-			t))))
-  (if (not (ediff-buffer-live-p buffer-A))
-      (error "Buffer %S doesn't exist" buffer-A))
-  (if (not (ediff-buffer-live-p buffer-B))
-      (error "Buffer %S doesn't exist" buffer-B))
-  
-  (let (reg-A-beg reg-A-end reg-B-beg reg-B-end)
-    (save-excursion
-      (set-buffer buffer-A)
-      (setq reg-A-beg (region-beginning)
-	    reg-A-end (region-end))
-      ;; enlarge the region to hold full lines
-      (goto-char reg-A-beg) 
-      (beginning-of-line)
-      (setq reg-A-beg (point))
-      (goto-char reg-A-end) 
-      (end-of-line)
-      (or (eobp) (forward-char)) ; include the newline char
-      (setq reg-A-end (point))
-      
-      (set-buffer buffer-B)
-      (setq reg-B-beg (region-beginning)
-	    reg-B-end (region-end))
-      ;; enlarge the region to hold full lines
-      (goto-char reg-B-beg) 
-      (beginning-of-line)
-      (setq reg-B-beg (point))
-      (goto-char reg-B-end) 
-      (end-of-line)
-      (or (eobp) (forward-char)) ; include the newline char
-      (setq reg-B-end (point))
-      ) ; save excursion
-	    
-    (ediff-regions-internal
-     (get-buffer buffer-A) reg-A-beg reg-A-end
-     (get-buffer buffer-B) reg-B-beg reg-B-end
-     startup-hooks 'ediff-regions-linewise nil))) ; no word mode
-	
-;; compare region beg-A to end-A of buffer-A
-;; to regions beg-B -- end-B in buffer-B. 
-(defun ediff-regions-internal (buffer-A beg-A end-A buffer-B beg-B end-B
-					startup-hooks job-name word-mode)
-  (let ((tmp-buffer (get-buffer-create ediff-tmp-buffer))
-	overl-A overl-B
-	file-A file-B)
-	
-    ;; in case beg/end-A/B aren't markers--make them into markers
-    (ediff-eval-in-buffer buffer-A
-      (setq beg-A (move-marker (make-marker) beg-A)
-	    end-A (move-marker (make-marker) end-A)))
-    (ediff-eval-in-buffer buffer-B
-      (setq beg-B (move-marker (make-marker) beg-B)
-	    end-B (move-marker (make-marker) end-B)))
-	
-    (if (and (eq buffer-A buffer-B)
-	     (or (and (< beg-A end-B) (<= beg-B beg-A))   ; b-B b-A e-B
-		 (and (< beg-B end-A) (<= end-A end-B)))) ; b-B e-A e-B
-	(progn
-	  (with-output-to-temp-buffer ediff-msg-buffer
-	    (princ "
-You have requested to compare overlapping regions of the same buffer.
-
-In this case, Ediff's highlighting may be confusing---in the same window,
-you may see highlighted regions that belong to different regions.
-
-Continue anyway? (y/n) "))
-
-	  (if (y-or-n-p "Continue anyway? ")
-	      ()
-	    (error "%S aborted" job-name))))
-	    
-    ;; make file-A
-    (if word-mode
-	(ediff-wordify beg-A end-A buffer-A tmp-buffer)
-      (ediff-copy-to-buffer beg-A end-A buffer-A tmp-buffer))
-    (setq file-A (ediff-make-temp-file tmp-buffer "regA"))
-    
-    ;; make file-B
-    (if word-mode
-	(ediff-wordify beg-B end-B buffer-B tmp-buffer)
-      (ediff-copy-to-buffer beg-B end-B buffer-B tmp-buffer))
-    (setq file-B (ediff-make-temp-file tmp-buffer "regB"))
-     
-    (setq overl-A (ediff-make-bullet-proof-overlay beg-A end-A buffer-A))
-    (setq overl-B (ediff-make-bullet-proof-overlay beg-B end-B buffer-B))
-    (ediff-setup buffer-A file-A
-		 buffer-B file-B
-		 nil nil	    ; buffer & file C
-		 (cons (` (lambda ()
-			    (delete-file (, file-A))
-			    (delete-file (, file-B))))
-		       startup-hooks)
-		 (list (cons 'ediff-word-mode  word-mode)
-		       (cons 'ediff-narrow-bounds (list overl-A overl-B))
-		       (cons 'ediff-job-name job-name))
-		 )
-    ))
-    
- 
-;;; Merge files and buffers
-  
-;;;###autoload
-(defalias 'ediff-merge 'ediff-merge-files)
-  
-(defsubst ediff-merge-on-startup ()
-  (ediff-do-merge 0)
-  (ediff-eval-in-buffer ediff-buffer-C
-    (set-buffer-modified-p nil)))
-
-;;;###autoload
-(defun ediff-merge-files (file-A file-B &optional startup-hooks)
-  "Merge two files without ancestor."
-  (interactive
-   (let ((dir-A (if ediff-use-last-dir
-		    ediff-last-dir-A
-		  default-directory))
-	 dir-B f)
-     (list (setq f (ediff-read-file-name
-		    "File A to merge" dir-A
-		    (ediff-get-default-file-name)))
-	   (ediff-read-file-name "File B to merge" 
-				 (setq dir-B
-				       (if ediff-use-last-dir
-					   ediff-last-dir-B 
-					 (file-name-directory f)))
-				 (progn
-				   (setq file-name-history
-					 (cons (ediff-abbreviate-file-name
-						(expand-file-name
-						 (file-name-nondirectory f)
-						 dir-B))
-					       file-name-history))
-				   f))
-	   )))
-  (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks))
-  (ediff-files-internal file-A 
-			(if (file-directory-p file-B)
-			    (expand-file-name
-			     (file-name-nondirectory file-A) file-B)
-			  file-B)
-			  nil ; file-C
-			  startup-hooks
-			  'ediff-merge-files))
-			  
-;;;###autoload
-(defun ediff-merge-files-with-ancestor (file-A file-B file-ancestor
-					       &optional startup-hooks)
-  "Merge two files with ancestor."
-  (interactive
-   (let ((dir-A (if ediff-use-last-dir
-		    ediff-last-dir-A
-		  default-directory))
-	 dir-B dir-ancestor f ff)
-     (list (setq f (ediff-read-file-name
-		    "File A to merge" dir-A
-		    (ediff-get-default-file-name)))
-	   (setq ff (ediff-read-file-name "File B to merge" 
-					  (setq dir-B
-						(if ediff-use-last-dir
-						    ediff-last-dir-B 
-						  (file-name-directory f)))
-					  (progn
-					    (setq file-name-history
-						  (cons
-						   (ediff-abbreviate-file-name
-						    (expand-file-name
-						     (file-name-nondirectory f)
-						     dir-B))
-						   file-name-history))
-					    f)))
-	   (ediff-read-file-name "Ancestor file" 
-				 (setq dir-ancestor
-				       (if ediff-use-last-dir
-					   ediff-last-dir-ancestor
-					 (file-name-directory ff)))
-				 (progn
-				   (setq file-name-history
-					 (cons (ediff-abbreviate-file-name
-						(expand-file-name
-						 (file-name-nondirectory ff)
-						 dir-ancestor))
-					       file-name-history))
-				   ff))
-	   )))
-  (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks))
-  (ediff-files-internal file-A 
-			(if (file-directory-p file-B)
-			    (expand-file-name
-			     (file-name-nondirectory file-A) file-B)
-			  file-B)
-			  file-ancestor
-			  startup-hooks
-			  'ediff-merge-files-with-ancestor))
-			  
-;;;###autoload
-(defalias 'ediff-merge-with-ancestor 'ediff-merge-files-with-ancestor)
-			  
-;;;###autoload
-(defun ediff-merge-buffers (buffer-A buffer-B &optional startup-hooks job-name)
-  "Merge buffers without ancestor."
-  (interactive 
-   (let (bf)
-     (list (setq bf (read-buffer "Buffer A to merge: "
-				 (ediff-other-buffer "") t))
-	   (read-buffer "Buffer B to merge: "
-			(progn
-			  ;; realign buffers so that two visible bufs will be
-			  ;; at the top
-			  (save-window-excursion (other-window 1))
-			  (ediff-other-buffer bf))
-			t))))
-  
-  (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks))
-  (or job-name (setq job-name 'ediff-merge-buffers))
-  (ediff-buffers-internal
-   buffer-A buffer-B nil startup-hooks job-name))
-   
-;;;###autoload
-(defun ediff-merge-buffers-with-ancestor (buffer-A 
-					  buffer-B buffer-ancestor
-					  &optional startup-hooks job-name)
-  "Merge buffers with ancestor."
-  (interactive 
-   (let (bf bff)
-     (list (setq bf (read-buffer "Buffer A to merge: "
-				 (ediff-other-buffer "") t))
-	   (setq bff (read-buffer "Buffer B to merge: "
-				  (progn
-				    ;; realign buffers so that two visible
-				    ;; bufs will be at the top
-				    (save-window-excursion (other-window 1))
-				    (ediff-other-buffer bf))
-				  t))
-	   (read-buffer "Ancestor buffer: "
-				  (progn
-				    ;; realign buffers so that three visible
-				    ;; bufs will be at the top
-				    (save-window-excursion (other-window 1))
-				    (ediff-other-buffer (list bf bff)))
-				  t)
-	   )))
-  
-  (setq startup-hooks (cons 'ediff-merge-on-startup startup-hooks))
-  (or job-name (setq job-name 'ediff-merge-buffers-with-ancestor))
-  (ediff-buffers-internal
-   buffer-A buffer-B buffer-ancestor startup-hooks job-name))
-      
-
-;;;###autoload
-(defun ediff-merge-revisions (&optional file startup-hooks)
-  "Run Ediff by merging two revisions of a file.
-The file is the optional FILE argument or the file visited by the current
-buffer."
-  (interactive)
-  (if (stringp file) (find-file file))
-  (let (rev1 rev2)
-    (setq rev1
-	  (read-string
-	   (format
-	    "Version 1 to merge (default: %s's latest version): "
-	    (if (stringp file)
-		(file-name-nondirectory file) "current buffer")))
-	  rev2
-	  (read-string
-	   (format
-	    "Version 2 to merge (default: %s): "
-	    (if (stringp file)
-		(file-name-nondirectory file) "current buffer"))))
-    (ediff-load-version-control)
-    ;; ancestor-revision=nil
-    (funcall
-     (intern (format "ediff-%S-merge-internal" ediff-version-control-package))
-     rev1 rev2 nil startup-hooks)))
-    
-
-;;;###autoload
-(defun ediff-merge-revisions-with-ancestor (&optional file startup-hooks)
-  "Run Ediff by merging two revisions of a file with a common ancestor.
-The file is the the optional FILE argument or the file visited by the current
-buffer."
-  (interactive)
-  (if (stringp file) (find-file file))
-  (let (rev1 rev2 ancestor-rev)
-    (setq rev1
-	  (read-string
-	   (format
-	    "Version 1 to merge (default: %s's latest version): "
-	    (if (stringp file)
-		(file-name-nondirectory file) "current buffer")))
-	  rev2
-	  (read-string
-	   (format
-	    "Version 2 to merge (default: %s): "
-	    (if (stringp file)
-		(file-name-nondirectory file) "current buffer")))
-	  ancestor-rev
-	  (read-string
-	   (format
-	    "Ancestor version (default: %s): "
-	    (if (stringp file)
-		(file-name-nondirectory file) "current buffer"))))
-    (ediff-load-version-control)
-    (funcall
-     (intern (format "ediff-%S-merge-internal" ediff-version-control-package))
-     rev1 rev2 ancestor-rev startup-hooks)))
-
-;;;###autoload
-(defun run-ediff-from-cvs-buffer (pos)
-  "Run Ediff-merge on appropriate revisions of the selected file.
-First run after `M-x cvs-update'. Then place the cursor on a lide describing a
-file and then run `run-ediff-from-cvs-buffer'."
-  (interactive "d")
-  (ediff-load-version-control)
-  (let ((tin (tin-locate cvs-cookie-handle pos)))
-    (if tin
-	(cvs-run-ediff-on-file-descriptor tin)
-      (error "There is no file to merge"))))
-     
-     
-;;; Apply patch
-
-;;;###autoload
-(defun ediff-patch-file ()
-  "Run Ediff by patching SOURCE-FILENAME."
-  ;; This now returns the control buffer
-  (interactive)
-  (let (source-dir source-file patch-buf)
-    (require 'ediff-ptch)
-    (setq patch-buf (ediff-get-patch-buffer))
-    (setq source-dir (cond (ediff-use-last-dir ediff-last-dir-patch)
-			   ((and (not ediff-patch-default-directory)
-				 (buffer-file-name patch-buf))
-			    (file-name-directory
-			     (expand-file-name
-			      (buffer-file-name patch-buf))))
-			   (t default-directory)))
-    (setq source-file
-	  ;; the default is the directory, not the visited file name
-	  (ediff-read-file-name "Which file to patch? " source-dir source-dir))
-    (ediff-dispatch-file-patching-job patch-buf source-file)))
-
-;;;###autoload
-(defun ediff-patch-buffer ()
-  "Run Ediff by patching BUFFER-NAME."
-  (interactive)
-  (let (patch-buf)
-    (require 'ediff-ptch)
-    (setq patch-buf (ediff-get-patch-buffer))
-    (ediff-patch-buffer-internal
-     patch-buf
-     (read-buffer "Which buffer to patch? "
-		  (cond ((eq patch-buf (current-buffer))
-			 (window-buffer (other-window 1)))
-			(t (current-buffer)))
-		  'must-match))))
-  
-;;;###autoload
-(defalias 'epatch 'ediff-patch-file)
-;;;###autoload
-(defalias 'epatch-buffer 'ediff-patch-buffer)
-
-
-
-
-;;; Versions Control functions      
-      
-;;;###autoload
-(defun ediff-revision (&optional file startup-hooks)
-  "Run Ediff by comparing versions of a file.
-The file is an optional FILE argument or the file visited by the current
-buffer. Use `vc.el' or `rcs.el' depending on `ediff-version-control-package'."
-  ;; if buffer is non-nil, use that buffer instead of the current buffer
-  (interactive "P")
-  (if (stringp file) (find-file file))
-  (let (rev1 rev2)
-    (setq rev1
-	  (read-string
-	   (format "Version 1 to compare (default: %s's latest version): "
-		   (if (stringp file)
-		       (file-name-nondirectory file) "current buffer")))
-	  rev2
-	  (read-string 
-	   (format "Version 2 to compare (default: %s): "
-		   (if (stringp file)
-		       (file-name-nondirectory file) "current buffer"))))
-    (ediff-load-version-control)
-    (funcall
-     (intern (format "ediff-%S-internal" ediff-version-control-package))
-     rev1 rev2 startup-hooks)
-    ))
-   
-   
-;; Test if version control package is loaded and load if not
-;; Is SILENT is non-nil, don't report error if package is not found.
-(defun ediff-load-version-control (&optional silent)
-  (require 'ediff-vers)
-  (or (featurep ediff-version-control-package)
-      (if (locate-library (symbol-name ediff-version-control-package))
-	  (progn
-	    (message "") ; kill the message from `locate-library'
-	    (require ediff-version-control-package))
-	(or silent
-	    (error "Version control package %S.el not found. Use vc.el instead"
-		   ediff-version-control-package)))))
-
-
-;;;###autoload
-(defun ediff-version ()
-  "Return string describing the version of Ediff.
-When called interactively, displays the version."
-  (interactive)
-  (if (interactive-p)
-      (message (ediff-version))
-    (format "Ediff %s of %s" ediff-version ediff-date)))
-
-
-;;;###autoload
-(defun ediff-documentation (&optional node)
-  "Display Ediff's manual.
-With optional NODE, goes to that node."
-  (interactive)
-  (let ((ctl-window ediff-control-window)
-	(ctl-buf ediff-control-buffer))
-
-    (ediff-skip-unsuitable-frames)
-    (condition-case nil
-	(progn
-	  (pop-to-buffer (get-buffer-create "*info*"))
-	  (info (if ediff-xemacs-p "ediff.info" "ediff"))
-	  (if node
-	      (Info-goto-node node)
-	    (message "Type `i' to search for a specific topic"))
-	  (raise-frame (selected-frame)))
-      (error (beep 1)
-	     (with-output-to-temp-buffer ediff-msg-buffer
-	       (princ ediff-BAD-INFO))
-	     (if (window-live-p ctl-window)
-		 (progn
-		   (select-window ctl-window)
-		   (set-window-buffer ctl-window ctl-buf)))))))
-    
-
-
-
-;;; Local Variables:
-;;; eval: (put 'ediff-defvar-local 'lisp-indent-hook 'defun)
-;;; eval: (put 'ediff-eval-in-buffer 'lisp-indent-hook 1)
-;;; eval: (put 'ediff-eval-in-buffer 'edebug-form-spec '(form body))
-;;; End:
-
-(provide 'ediff)
-(require 'ediff-util)
-
-;;; ediff.el ends here
diff --git a/lisp/edmacro.el b/lisp/edmacro.el
deleted file mode 100644
index 973ef680f80..00000000000
--- a/lisp/edmacro.el
+++ /dev/null
@@ -1,723 +0,0 @@
-;;; edmacro.el --- keyboard macro editor
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Maintainer: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.01
-;; Keywords: abbrev
-
-;; 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:
-
-;;; Usage:
-;;
-;; The `C-x C-k' (`edit-kbd-macro') command edits a keyboard macro
-;; in a special buffer.  It prompts you to type a key sequence,
-;; which should be one of:
-;;
-;;  * RET or `C-x e' (call-last-kbd-macro), to edit the most 
-;;    recently defined keyboard macro.
-;;
-;;  * `M-x' followed by a command name, to edit a named command
-;;    whose definition is a keyboard macro.
-;;
-;;  * `C-h l' (view-lossage), to edit the 100 most recent keystrokes
-;;    and install them as the "current" macro.
-;;
-;;  * any key sequence whose definition is a keyboard macro.
-;;
-;; This file includes a version of `insert-kbd-macro' that uses the
-;; more readable format defined by these routines.
-;;
-;; Also, the `read-kbd-macro' command parses the region as
-;; a keyboard macro, and installs it as the "current" macro.
-;; This and `format-kbd-macro' can also be called directly as
-;; Lisp functions.
-
-;; Type `C-h m', or see the documentation for `edmacro-mode' below,
-;; for information about the format of written keyboard macros.
-
-;; `edit-kbd-macro' formats the macro with one command per line,
-;; including the command names as comments on the right.  If the
-;; formatter gets confused about which keymap was used for the
-;; characters, the command-name comments will be wrong but that
-;; won't hurt anything.
-
-;; With a prefix argument, `edit-kbd-macro' will format the
-;; macro in a more concise way that omits the comments.
-
-;; This package requires GNU Emacs 19 or later, and daveg's CL
-;; package 2.02 or later.  (CL 2.02 comes standard starting with
-;; Emacs 19.18.)  This package does not work with Emacs 18 or
-;; Lucid Emacs.
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-
-;;; The user-level commands for editing macros.
-
-;;;###autoload (define-key ctl-x-map "\C-k" 'edit-kbd-macro)
-
-;;;###autoload
-(defvar edmacro-eight-bits nil
-  "*Non-nil if edit-kbd-macro should leave 8-bit characters intact.
-Default nil means to write characters above \\177 in octal notation.")
-
-(defvar edmacro-mode-map nil)
-(unless edmacro-mode-map
-  (setq edmacro-mode-map (make-sparse-keymap))
-  (define-key edmacro-mode-map "\C-c\C-c" 'edmacro-finish-edit)
-  (define-key edmacro-mode-map "\C-c\C-q" 'edmacro-insert-key))
-
-(defvar edmacro-store-hook)
-(defvar edmacro-finish-hook)
-(defvar edmacro-original-buffer)
-
-;;;###autoload
-(defun edit-kbd-macro (keys &optional prefix finish-hook store-hook)
-  "Edit a keyboard macro.
-At the prompt, type any key sequence which is bound to a keyboard macro.
-Or, type `C-x e' or RET to edit the last keyboard macro, `C-h l' to edit
-the last 100 keystrokes as a keyboard macro, or `M-x' to edit a macro by
-its command name.
-With a prefix argument, format the macro in a more concise way."
-  (interactive "kKeyboard macro to edit (C-x e, M-x, C-h l, or keys): \nP")
-  (when keys
-    (let ((cmd (if (arrayp keys) (key-binding keys) keys))
-	  (mac nil))
-      (cond (store-hook
-	     (setq mac keys)
-	     (setq cmd nil))
-	    ((or (eq cmd 'call-last-kbd-macro)
-		 (member keys '("\r" [return])))
-	     (or last-kbd-macro
-		 (y-or-n-p "No keyboard macro defined.  Create one? ")
-		 (keyboard-quit))
-	     (setq mac (or last-kbd-macro ""))
-	     (setq cmd 'last-kbd-macro))
-	    ((eq cmd 'execute-extended-command)
-	     (setq cmd (read-command "Name of keyboard macro to edit: "))
-	     (if (string-equal cmd "")
-		 (error "No command name given"))
-	     (setq mac (symbol-function cmd)))
-	    ((eq cmd 'view-lossage)
-	     (setq mac (recent-keys))
-	     (setq cmd 'last-kbd-macro))
-	    ((null cmd)
-	     (error "Key sequence %s is not defined" (key-description keys)))
-	    ((symbolp cmd)
-	     (setq mac (symbol-function cmd)))
-	    (t
-	     (setq mac cmd)
-	     (setq cmd nil)))
-      (unless (arrayp mac)
-	(error "Key sequence %s is not a keyboard macro"
-	       (key-description keys)))
-      (message "Formatting keyboard macro...")
-      (let* ((oldbuf (current-buffer))
-	     (mmac (edmacro-fix-menu-commands mac))
-	     (fmt (edmacro-format-keys mmac 1))
-	     (fmtv (edmacro-format-keys mmac (not prefix)))
-	     (buf (get-buffer-create "*Edit Macro*")))
-	(message "Formatting keyboard macro...done")
-	(switch-to-buffer buf)
-	(kill-all-local-variables)
-	(use-local-map edmacro-mode-map)
-	(setq buffer-read-only nil)
-	(setq major-mode 'edmacro-mode)
-	(setq mode-name "Edit Macro")
-	(set (make-local-variable 'edmacro-original-buffer) oldbuf)
-	(set (make-local-variable 'edmacro-finish-hook) finish-hook)
-	(set (make-local-variable 'edmacro-store-hook) store-hook)
-	(erase-buffer)
-	(insert ";; Keyboard Macro Editor.  Press C-c C-c to finish; "
-		"press C-x k RET to cancel.\n")
-	(insert ";; Original keys: " fmt "\n")
-	(unless store-hook
-	  (insert "\nCommand: " (if cmd (symbol-name cmd) "none") "\n")
-	  (let ((keys (where-is-internal (or cmd mac) '(keymap))))
-	    (if keys
-		(while keys
-		  (insert "Key: " (edmacro-format-keys (pop keys) 1) "\n"))
-	      (insert "Key: none\n"))))
-	(insert "\nMacro:\n\n")
-	(save-excursion
-	  (insert fmtv "\n"))
-	(recenter '(4))
-	(when (eq mac mmac)
-	  (set-buffer-modified-p nil))
-	(run-hooks 'edmacro-format-hook)))))
-
-;;; The next two commands are provided for convenience and backward
-;;; compatibility.
-
-;;;###autoload
-(defun edit-last-kbd-macro (&optional prefix)
-  "Edit the most recently defined keyboard macro."
-  (interactive "P")
-  (edit-kbd-macro 'call-last-kbd-macro prefix))
-
-;;;###autoload
-(defun edit-named-kbd-macro (&optional prefix)
-  "Edit a keyboard macro which has been given a name by `name-last-kbd-macro'."
-  (interactive "P")
-  (edit-kbd-macro 'execute-extended-command prefix))
-
-;;;###autoload
-(defun read-kbd-macro (start &optional end)
-  "Read the region as a keyboard macro definition.
-The region is interpreted as spelled-out keystrokes, e.g., \"M-x abc RET\".
-See documentation for `edmacro-mode' for details.
-Leading/trailing \"C-x (\" and \"C-x )\" in the text are allowed and ignored.
-The resulting macro is installed as the \"current\" keyboard macro.
-
-In Lisp, may also be called with a single STRING argument in which case
-the result is returned rather than being installed as the current macro.
-The result will be a string if possible, otherwise an event vector.
-Second argument NEED-VECTOR means to return an event vector always."
-  (interactive "r")
-  (if (stringp start)
-      (edmacro-parse-keys start end)
-    (setq last-kbd-macro (edmacro-parse-keys (buffer-substring start end)))))
-
-;;;###autoload
-(defun format-kbd-macro (&optional macro verbose)
-  "Return the keyboard macro MACRO as a human-readable string.
-This string is suitable for passing to `read-kbd-macro'.
-Second argument VERBOSE means to put one command per line with comments.
-If VERBOSE is `1', put everything on one line.  If VERBOSE is omitted
-or nil, use a compact 80-column format."
-  (and macro (symbolp macro) (setq macro (symbol-function macro)))
-  (edmacro-format-keys (or macro last-kbd-macro) verbose))
-
-;;; Commands for *Edit Macro* buffer.
-
-(defun edmacro-finish-edit ()
-  (interactive)
-  (unless (eq major-mode 'edmacro-mode)
-    (error
-     "This command is valid only in buffers created by `edit-kbd-macro'"))
-  (run-hooks 'edmacro-finish-hook)
-  (let ((cmd nil) (keys nil) (no-keys nil)
-	(top (point-min)))
-    (goto-char top)
-    (let ((case-fold-search nil))
-      (while (cond ((looking-at "[ \t]*\\($\\|;;\\|REM[ \t\n]\\)")
-		    t)
-		   ((looking-at "Command:[ \t]*\\([^ \t\n]*\\)[ \t]*$")
-		    (when edmacro-store-hook
-		      (error "\"Command\" line not allowed in this context"))
-		    (let ((str (buffer-substring (match-beginning 1)
-						 (match-end 1))))
-		      (unless (equal str "")
-			(setq cmd (and (not (equal str "none"))
-				       (intern str)))
-			(and (fboundp cmd) (not (arrayp (symbol-function cmd)))
-			     (not (y-or-n-p
-				   (format "Command %s is already defined; %s"
-					   cmd "proceed? ")))
-			     (keyboard-quit))))
-		    t)
-		   ((looking-at "Key:\\(.*\\)$")
-		    (when edmacro-store-hook
-		      (error "\"Key\" line not allowed in this context"))
-		    (let ((key (edmacro-parse-keys
-				(buffer-substring (match-beginning 1)
-						  (match-end 1)))))
-		      (unless (equal key "")
-			(if (equal key "none")
-			    (setq no-keys t)
-			  (push key keys)
-			  (let ((b (key-binding key)))
-			    (and b (commandp b) (not (arrayp b))
-				 (or (not (fboundp b))
-				     (not (arrayp (symbol-function b))))
-				 (not (y-or-n-p
-				       (format "Key %s is already defined; %s"
-					       (edmacro-format-keys key 1)
-					       "proceed? ")))
-				 (keyboard-quit))))))
-		    t)
-		   ((looking-at "Macro:[ \t\n]*")
-		    (goto-char (match-end 0))
-		    nil)
-		   ((eobp) nil)
-		   (t (error "Expected a `Macro:' line")))
-	(forward-line 1))
-      (setq top (point)))
-    (let* ((buf (current-buffer))
-	   (str (buffer-substring top (point-max)))
-	   (modp (buffer-modified-p))
-	   (obuf edmacro-original-buffer)
-	   (store-hook edmacro-store-hook)
-	   (finish-hook edmacro-finish-hook))
-      (unless (or cmd keys store-hook (equal str ""))
-	(error "No command name or keys specified"))
-      (when modp
-	(when (buffer-name obuf)
-	  (set-buffer obuf))
-	(message "Compiling keyboard macro...")
-	(let ((mac (edmacro-parse-keys str)))
-	  (message "Compiling keyboard macro...done")
-	  (if store-hook
-	      (funcall store-hook mac)
-	    (when (eq cmd 'last-kbd-macro)
-	      (setq last-kbd-macro (and (> (length mac) 0) mac))
-	      (setq cmd nil))
-	    (when cmd
-	      (if (= (length mac) 0)
-		  (fmakunbound cmd)
-		(fset cmd mac)))
-	    (if no-keys
-		(when cmd
-		  (loop for key in (where-is-internal cmd '(keymap)) do
-			(global-unset-key key)))
-	      (when keys
-		(if (= (length mac) 0)
-		    (loop for key in keys do (global-unset-key key))
-		  (loop for key in keys do
-			(global-set-key key (or cmd mac)))))))))
-      (kill-buffer buf)
-      (when (buffer-name obuf)
-	(switch-to-buffer obuf))
-      (when finish-hook
-	(funcall finish-hook)))))
-
-(defun edmacro-insert-key (key)
-  "Insert the written name of a key in the buffer."
-  (interactive "kKey to insert: ")
-  (if (bolp)
-      (insert (edmacro-format-keys key t) "\n")
-    (insert (edmacro-format-keys key) " ")))
-
-(defun edmacro-mode ()
-  "\\<edmacro-mode-map>Keyboard Macro Editing mode.  Press
-\\[edmacro-finish-edit] to save and exit.
-To abort the edit, just kill this buffer with \\[kill-buffer] RET.
-
-Press \\[edmacro-insert-key] to insert the name of any key by typing the key.
-
-The editing buffer contains a \"Command:\" line and any number of
-\"Key:\" lines at the top.  These are followed by a \"Macro:\" line
-and the macro itself as spelled-out keystrokes: `C-x C-f foo RET'.
-
-The \"Command:\" line specifies the command name to which the macro
-is bound, or \"none\" for no command name.  Write \"last-kbd-macro\"
-to refer to the current keyboard macro (as used by \\[call-last-kbd-macro]).
-
-The \"Key:\" lines specify key sequences to which the macro is bound,
-or \"none\" for no key bindings.
-
-You can edit these lines to change the places where the new macro
-is stored.
-
-
-Format of keyboard macros during editing:
-
-Text is divided into \"words\" separated by whitespace.  Except for
-the words described below, the characters of each word go directly
-as characters of the macro.  The whitespace that separates words
-is ignored.  Whitespace in the macro must be written explicitly,
-as in \"foo SPC bar RET\".
-
- * The special words RET, SPC, TAB, DEL, LFD, ESC, and NUL represent
-   special control characters.  The words must be written in uppercase.
-
- * A word in angle brackets, e.g., <return>, <down>, or <f1>, represents
-   a function key.  (Note that in the standard configuration, the
-   function key <return> and the control key RET are synonymous.)
-   You can use angle brackets on the words RET, SPC, etc., but they
-   are not required there.
-
- * Keys can be written by their ASCII code, using a backslash followed
-   by up to six octal digits.  This is the only way to represent keys
-   with codes above \\377.
-
- * One or more prefixes M- (meta), C- (control), S- (shift), A- (alt),
-   H- (hyper), and s- (super) may precede a character or key notation.
-   For function keys, the prefixes may go inside or outside of the
-   brackets:  C-<down> = <C-down>.  The prefixes may be written in
-   any order:  M-C-x = C-M-x.
-
-   Prefixes are not allowed on multi-key words, e.g., C-abc, except
-   that the Meta prefix is allowed on a sequence of digits and optional
-   minus sign:  M--123 = M-- M-1 M-2 M-3.
-
- * The `^' notation for control characters also works:  ^M = C-m.
-
- * Double angle brackets enclose command names:  <<next-line>> is
-   shorthand for M-x next-line RET.
-
- * Finally, REM or ;; causes the rest of the line to be ignored as a
-   comment.
-
-Any word may be prefixed by a multiplier in the form of a decimal
-number and `*':  3*<right> = <right> <right> <right>, and
-10*foo = foofoofoofoofoofoofoofoofoofoo.
-
-Multiple text keys can normally be strung together to form a word,
-but you may need to add whitespace if the word would look like one
-of the above notations:  `; ; ;' is a keyboard macro with three
-semicolons, but `;;;' is a comment.  Likewise, `\\ 1 2 3' is four
-keys but `\\123' is a single key written in octal, and `< right >'
-is seven keys but `<right>' is a single function key.  When in
-doubt, use whitespace."
-  (interactive)
-  (error "This mode can be enabled only by `edit-kbd-macro'"))
-(put 'edmacro-mode 'mode-class 'special)
-
-;;; Formatting a keyboard macro as human-readable text.
-
-(defun edmacro-format-keys (macro &optional verbose)
-  (setq macro (edmacro-fix-menu-commands macro))
-  (let* ((maps (append (current-minor-mode-maps)
-		       (if (current-local-map)
-			   (list (current-local-map)))
-		       (list (current-global-map))))
-	 (pkeys '(end-macro ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?- ?\C-u
-		  ?\M-- ?\M-0 ?\M-1 ?\M-2 ?\M-3 ?\M-4 ?\M-5 ?\M-6
-		  ?\M-7 ?\M-8 ?\M-9))
-	 (mdigs (nthcdr 13 pkeys))
-	 (maxkey (if edmacro-eight-bits 255 127))
-	 (case-fold-search nil)
-	 (res-words '("NUL" "TAB" "LFD" "RET" "ESC" "SPC" "DEL" "REM"))
-	 (rest-mac (vconcat macro [end-macro]))
-	 (res "")
-	 (len 0)
-	 (one-line (eq verbose 1)))
-    (if one-line (setq verbose nil))
-    (when (stringp macro)
-      (loop for i below (length macro) do
-	    (when (>= (aref rest-mac i) 128)
-	      (incf (aref rest-mac i) (- ?\M-\^@ 128)))))
-    (while (not (eq (aref rest-mac 0) 'end-macro))
-      (let* ((prefix
-	      (or (and (integerp (aref rest-mac 0))
-		       (memq (aref rest-mac 0) mdigs)
-		       (memq (key-binding (edmacro-subseq rest-mac 0 1))
-			     '(digit-argument negative-argument))
-		       (let ((i 1))
-			 (while (memq (aref rest-mac i) (cdr mdigs))
-			   (incf i))
-			 (and (not (memq (aref rest-mac i) pkeys))
-			      (prog1 (concat "M-" (edmacro-subseq rest-mac 0 i) " ")
-				(callf edmacro-subseq rest-mac i)))))
-		  (and (eq (aref rest-mac 0) ?\C-u)
-		       (eq (key-binding [?\C-u]) 'universal-argument)
-		       (let ((i 1))
-			 (while (eq (aref rest-mac i) ?\C-u)
-			   (incf i))
-			 (and (not (memq (aref rest-mac i) pkeys))
-			      (prog1 (loop repeat i concat "C-u ")
-				(callf edmacro-subseq rest-mac i)))))
-		  (and (eq (aref rest-mac 0) ?\C-u)
-		       (eq (key-binding [?\C-u]) 'universal-argument)
-		       (let ((i 1))
-			 (when (eq (aref rest-mac i) ?-)
-			   (incf i))
-			 (while (memq (aref rest-mac i)
-				      '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
-			   (incf i))
-			 (and (not (memq (aref rest-mac i) pkeys))
-			      (prog1 (concat "C-u " (edmacro-subseq rest-mac 1 i) " ")
-				(callf edmacro-subseq rest-mac i)))))))
-	     (bind-len (apply 'max 1
-			      (loop for map in maps
-				    for b = (lookup-key map rest-mac)
-				    when b collect b)))
-	     (key (edmacro-subseq rest-mac 0 bind-len))
-	     (fkey nil) tlen tkey
-	     (bind (or (loop for map in maps for b = (lookup-key map key)
-			     thereis (and (not (integerp b)) b))
-		       (and (setq fkey (lookup-key function-key-map rest-mac))
-			    (setq tlen fkey tkey (edmacro-subseq rest-mac 0 tlen)
-				  fkey (lookup-key function-key-map tkey))
-			    (loop for map in maps
-				  for b = (lookup-key map fkey)
-				  when (and (not (integerp b)) b)
-				  do (setq bind-len tlen key tkey)
-				  and return b
-				  finally do (setq fkey nil)))))
-	     (first (aref key 0))
-	     (text (loop for i from bind-len below (length rest-mac)
-			 for ch = (aref rest-mac i)
-			 while (and (integerp ch)
-				    (> ch 32) (< ch maxkey) (/= ch 92)
-				    (eq (key-binding (char-to-string ch))
-					'self-insert-command)
-				    (or (> i (- (length rest-mac) 2))
-					(not (eq ch (aref rest-mac (+ i 1))))
-					(not (eq ch (aref rest-mac (+ i 2))))))
-			 finally return i))
-	     desc)
-	(if (stringp bind) (setq bind nil))
-	(cond ((and (eq bind 'self-insert-command) (not prefix)
-		    (> text 1) (integerp first)
-		    (> first 32) (<= first maxkey) (/= first 92)
-		    (progn
-		      (if (> text 30) (setq text 30))
-		      (setq desc (concat (edmacro-subseq rest-mac 0 text)))
-		      (when (string-match "^[ACHMsS]-." desc)
-			(setq text 2)
-			(callf substring desc 0 2))
-		      (not (string-match
-			    "^;;\\|^<.*>$\\|^\\\\[0-9]+$\\|^[0-9]+\\*."
-			    desc))))
-	       (when (or (string-match "^\\^.$" desc)
-			 (member desc res-words))
-		 (setq desc (mapconcat 'char-to-string desc " ")))
-	       (when verbose
-		 (setq bind (format "%s * %d" bind text)))
-	       (setq bind-len text))
-	      ((and (eq bind 'execute-extended-command)
-		    (> text bind-len)
-		    (memq (aref rest-mac text) '(return 13))
-		    (progn
-		      (setq desc (concat (edmacro-subseq rest-mac bind-len text)))
-		      (commandp (intern-soft desc))))
-	       (if (commandp (intern-soft desc)) (setq bind desc))
-	       (setq desc (format "<<%s>>" desc))
-	       (setq bind-len (1+ text)))
-	      (t
-	       (setq desc (mapconcat
-			   (function
-			    (lambda (ch)
-			      (cond
-			       ((integerp ch)
-				(concat
-				 (loop for pf across "ACHMsS"
-				       for bit in '(?\A-\^@ ?\C-\^@ ?\H-\^@
-						    ?\M-\^@ ?\s-\^@ ?\S-\^@)
-				       when (/= (logand ch bit) 0)
-				       concat (format "%c-" pf))
-				 (let ((ch2 (logand ch (1- (lsh 1 18)))))
-				   (cond ((<= ch2 32)
-					  (case ch2
-					    (0 "NUL") (9 "TAB") (10 "LFD")
-					    (13 "RET") (27 "ESC") (32 "SPC")
-					    (t
-					     (format "C-%c"
-						     (+ (if (<= ch2 26) 96 64)
-							ch2)))))
-					 ((= ch2 127) "DEL")
-					 ((<= ch2 maxkey) (char-to-string ch2))
-					 (t (format "\\%o" ch2))))))
-			       ((symbolp ch)
-				(format "<%s>" ch))
-			       (t
-				(error "Unrecognized item in macro: %s" ch)))))
-			   (or fkey key) " "))))
-	(if prefix (setq desc (concat prefix desc)))
-	(unless (string-match " " desc)
-	  (let ((times 1) (pos bind-len))
-	    (while (not (edmacro-mismatch rest-mac rest-mac
-					  0 bind-len pos (+ bind-len pos)))
-	      (incf times)
-	      (incf pos bind-len))
-	    (when (> times 1)
-	      (setq desc (format "%d*%s" times desc))
-	      (setq bind-len (* bind-len times)))))
-	(setq rest-mac (edmacro-subseq rest-mac bind-len))
-	(if verbose
-	    (progn
-	      (unless (equal res "") (callf concat res "\n"))
-	      (callf concat res desc)
-	      (when (and bind (or (stringp bind) (symbolp bind)))
-		(callf concat res
-		  (make-string (max (- 3 (/ (length desc) 8)) 1) 9)
-		  ";; " (if (stringp bind) bind (symbol-name bind))))
-	      (setq len 0))
-	  (if (and (> (+ len (length desc) 2) 72) (not one-line))
-	      (progn
-		(callf concat res "\n ")
-		(setq len 1))
-	    (unless (equal res "")
-	      (callf concat res " ")
-	      (incf len)))
-	  (callf concat res desc)
-	  (incf len (length desc)))))
-    res))
-
-(defun edmacro-mismatch (cl-seq1 cl-seq2 cl-start1 cl-end1 cl-start2 cl-end2)
-  "Compare SEQ1 with SEQ2, return index of first mismatching element.
-Return nil if the sequences match.  If one sequence is a prefix of the
-other, the return value indicates the end of the shorted sequence."
-  (let (cl-test cl-test-not cl-key cl-from-end)
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if cl-from-end
-	(progn
-	  (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		      (cl-check-match (elt cl-seq1 (1- cl-end1))
-				      (elt cl-seq2 (1- cl-end2))))
-	    (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
-	  (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	       (1- cl-end1)))
-      (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
-	    (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
-	(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		    (cl-check-match (if cl-p1 (car cl-p1)
-				      (aref cl-seq1 cl-start1))
-				    (if cl-p2 (car cl-p2)
-				      (aref cl-seq2 cl-start2))))
-	  (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
-		cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
-	(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	     cl-start1)))))
-
-(defun edmacro-subseq (seq start &optional end)
-  "Return the subsequence of SEQ from START to END.
-If END is omitted, it defaults to the length of the sequence.
-If START or END is negative, it counts from the end."
-  (if (stringp seq) (substring seq start end)
-    (let (len)
-      (and end (< end 0) (setq end (+ end (setq len (length seq)))))
-      (if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
-      (cond ((listp seq)
-	     (if (> start 0) (setq seq (nthcdr start seq)))
-	     (if end
-		 (let ((res nil))
-		   (while (>= (setq end (1- end)) start)
-		     (cl-push (cl-pop seq) res))
-		   (nreverse res))
-	       (copy-sequence seq)))
-	    (t
-	     (or end (setq end (or len (length seq))))
-	     (let ((res (make-vector (max (- end start) 0) nil))
-		   (i 0))
-	       (while (< start end)
-		 (aset res i (aref seq start))
-		 (setq i (1+ i) start (1+ start)))
-	       res))))))
-
-(defun edmacro-fix-menu-commands (macro)
-  (when (vectorp macro)
-    (let ((i 0) ev)
-      (while (< i (length macro))
-	(when (consp (setq ev (aref macro i)))
-	  (cond ((equal (cadadr ev) '(menu-bar))
-		 (setq macro (vconcat (edmacro-subseq macro 0 i)
-				      (vector 'menu-bar (car ev))
-				      (edmacro-subseq macro (1+ i))))
-		 (incf i))
-		;; It would be nice to do pop-up menus, too, but not enough
-		;; info is recorded in macros to make this possible.
-		(t
-		 (error "Macros with mouse clicks are not %s"
-			"supported by this command"))))
-	(incf i))))
-  macro)
-
-;;; Parsing a human-readable keyboard macro.
-
-(defun edmacro-parse-keys (string &optional need-vector)
-  (let ((case-fold-search nil)
-	(pos 0)
-	(res []))
-    (while (and (< pos (length string))
-		(string-match "[^ \t\n\f]+" string pos))
-      (let ((word (substring string (match-beginning 0) (match-end 0)))
-	    (key nil)
-	    (times 1))
-	(setq pos (match-end 0))
-	(when (string-match "\\([0-9]+\\)\\*." word)
-	  (setq times (string-to-int (substring word 0 (match-end 1))))
-	  (setq word (substring word (1+ (match-end 1)))))
-	(cond ((string-match "^<<.+>>$" word)
-	       (setq key (vconcat (if (eq (key-binding [?\M-x])
-					  'execute-extended-command)
-				      [?\M-x]
-				    (or (car (where-is-internal
-					      'execute-extended-command))
-					[?\M-x]))
-				  (substring word 2 -2) "\r")))
-	      ((and (string-match "^\\(\\([ACHMsS]-\\)*\\)<\\(.+\\)>$" word)
-		    (progn
-		      (setq word (concat (substring word (match-beginning 1)
-						    (match-end 1))
-					 (substring word (match-beginning 3)
-						    (match-end 3))))
-		      (not (string-match
-			    "\\<\\(NUL\\|RET\\|LFD\\|ESC\\|SPC\\|DEL\\)$"
-			    word))))
-	       (setq key (list (intern word))))
-	      ((or (equal word "REM") (string-match "^;;" word))
-	       (setq pos (string-match "$" string pos)))
-	      (t
-	       (let ((orig-word word) (prefix 0) (bits 0))
-		 (while (string-match "^[ACHMsS]-." word)
-		   (incf bits (cdr (assq (aref word 0)
-					 '((?A . ?\A-\^@) (?C . ?\C-\^@)
-					   (?H . ?\H-\^@) (?M . ?\M-\^@)
-					   (?s . ?\s-\^@) (?S . ?\S-\^@)))))
-		   (incf prefix 2)
-		   (callf substring word 2))
-		 (when (string-match "^\\^.$" word)
-		   (incf bits ?\C-\^@)
-		   (incf prefix)
-		   (callf substring word 1))
-		 (let ((found (assoc word '(("NUL" . "\0") ("RET" . "\r")
-					    ("LFD" . "\n") ("TAB" . "\t")
-					    ("ESC" . "\e") ("SPC" . " ")
-					    ("DEL" . "\177")))))
-		   (when found (setq word (cdr found))))
-		 (when (string-match "^\\\\[0-7]+$" word)
-		   (loop for ch across word
-			 for n = 0 then (+ (* n 8) ch -48)
-			 finally do (setq word (vector n))))
-		 (cond ((= bits 0)
-			(setq key word))
-		       ((and (= bits ?\M-\^@) (stringp word)
-			     (string-match "^-?[0-9]+$" word))
-			(setq key (loop for x across word collect (+ x bits))))
-		       ((/= (length word) 1)
-			(error "%s must prefix a single character, not %s"
-			       (substring orig-word 0 prefix) word))
-		       ((and (/= (logand bits ?\C-\^@) 0) (stringp word)
-			     (string-match "[@-_.a-z?]" word))
-			(setq key (list (+ bits (- ?\C-\^@)
-					   (if (equal word "?") 127
-					     (logand (aref word 0) 31))))))
-		       (t
-			(setq key (list (+ bits (aref word 0)))))))))
-	(when key
-	  (loop repeat times do (callf vconcat res key)))))
-    (when (and (>= (length res) 4)
-	       (eq (aref res 0) ?\C-x)
-	       (eq (aref res 1) ?\()
-	       (eq (aref res (- (length res) 2)) ?\C-x)
-	       (eq (aref res (- (length res) 1)) ?\)))
-      (setq res (edmacro-subseq res 2 -2)))
-    (if (and (not need-vector)
-	     (loop for ch across res
-		   always (and (integerp ch)
-			       (let ((ch2 (logand ch (lognot ?\M-\^@))))
-				 (and (>= ch2 0) (<= ch2 127))))))
-	(concat (loop for ch across res
-		      collect (if (= (logand ch ?\M-\^@) 0)
-				  ch (+ ch 128))))
-      res)))
-
-(provide 'edmacro)
-
-;;; edmacro.el ends here
-
diff --git a/lisp/ehelp.el b/lisp/ehelp.el
deleted file mode 100644
index c469c3d10f9..00000000000
--- a/lisp/ehelp.el
+++ /dev/null
@@ -1,396 +0,0 @@
-;;; ehelp.el --- bindings for electric-help mode
-
-;; Copyright (C) 1986, 1995 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: help, 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:
-
-;; This package provides a pre-packaged `Electric Help Mode' for
-;; browsing on-line help screens.  There is one entry point,
-;; `with-electric-help'; all you have to give it is a no-argument
-;; function that generates the actual text of the help into the current
-;; buffer.
-
-;; To make this the default, you must do
-;; (require 'ehelp)
-;; (define-key global-map "\C-h" 'ehelp-command)
-;; (define-key global-map [help] 'ehelp-command)
-;; (define-key global-map [f1] 'ehelp-command)
-
-;;; Code:
-
-(require 'electric)
-(defvar electric-help-map ()
-  "Keymap defining commands available in `electric-help-mode'.")
-
-(defvar electric-help-form-to-execute nil)
-
-(put 'electric-help-undefined 'suppress-keymap t)
-(if electric-help-map
-    ()
-  (let ((map (make-keymap)))
-    ;; allow all non-self-inserting keys - search, scroll, etc, but
-    ;; let M-x and C-x exit ehelp mode and retain buffer:
-    (suppress-keymap map)
-    (define-key map "\C-u" 'electric-help-undefined)
-    (define-key map [?\C-0] 'electric-help-undefined)
-    (define-key map [?\C-1] 'electric-help-undefined)
-    (define-key map [?\C-2] 'electric-help-undefined)
-    (define-key map [?\C-3] 'electric-help-undefined)
-    (define-key map [?\C-4] 'electric-help-undefined)
-    (define-key map [?\C-5] 'electric-help-undefined)
-    (define-key map [?\C-6] 'electric-help-undefined)
-    (define-key map [?\C-7] 'electric-help-undefined)
-    (define-key map [?\C-8] 'electric-help-undefined)
-    (define-key map [?\C-9] 'electric-help-undefined)
-    (define-key map (char-to-string help-char) 'electric-help-help)
-    (define-key map "?" 'electric-help-help)
-    (define-key map " " 'scroll-up)
-    (define-key map "\^?" 'scroll-down)
-    (define-key map "." 'beginning-of-buffer)
-    (define-key map "<" 'beginning-of-buffer)
-    (define-key map ">" 'end-of-buffer)
-    ;(define-key map "\C-g" 'electric-help-exit)
-    (define-key map "q" 'electric-help-exit)
-    (define-key map "Q" 'electric-help-exit)
-    ;;a better key than this?
-    (define-key map "r" 'electric-help-retain)
-    (define-key map "R" 'electric-help-retain)
-    (define-key map "\ex" 'electric-help-execute-extended)
-    (define-key map "\C-x" 'electric-help-ctrl-x-prefix)
-
-    (setq electric-help-map map)))
-
-(defun electric-help-mode ()
-  "`with-electric-help' temporarily places its buffer in this mode.
-\(On exit from `with-electric-help', the buffer is put in `default-major-mode'.)"
-  (setq buffer-read-only t)
-  (setq mode-name "Help")
-  (setq major-mode 'help)
-  (setq mode-line-buffer-identification '(" Help:  %b"))
-  (use-local-map electric-help-map)
-  (add-hook 'mouse-leave-buffer-hook 'electric-help-retain)
-  (view-mode -1)
-  ;; this is done below in with-electric-help
-  ;(run-hooks 'electric-help-mode-hook)
-  )
-
-;;;###autoload
-(defun with-electric-help (thunk &optional buffer noerase minheight)
-  "Pop up an \"electric\" help buffer.
-The arguments are THUNK &optional BUFFER NOERASE MINHEIGHT.
-THUNK is a function of no arguments which is called to initialize the
-contents of BUFFER.  BUFFER defaults to `*Help*'.  BUFFER will be
-erased before THUNK is called unless NOERASE is non-nil.  THUNK will
-be called while BUFFER is current and with `standard-output' bound to
-the buffer specified by BUFFER.
-
-If THUNK returns nil, we display BUFFER starting at the top, and
-shrink the window to fit.  If THUNK returns non-nil, we don't do those things.
-
-After THUNK has been called, this function \"electrically\" pops up a window
-in which BUFFER is displayed and allows the user to scroll through that buffer
-in electric-help-mode. The window's height will be at least MINHEIGHT if
-this value is non-nil.
-
-If THUNK returns nil, we display BUFFER starting at the top, and
-shrink the window to fit.  If THUNK returns non-nil, we don't do those
-things.
-
-When the user exits (with `electric-help-exit', or otherwise) the help
-buffer's window disappears (i.e., we use `save-window-excursion')
-BUFFER is put into `default-major-mode' (or `fundamental-mode') when we exit."
-  (setq buffer (get-buffer-create (or buffer "*Help*")))
-  (let ((one (one-window-p t))
-	(config (current-window-configuration))
-        (bury nil)
-        (electric-help-form-to-execute nil))
-    (unwind-protect
-         (save-excursion
-           (if one (goto-char (window-start (selected-window))))
-           (let ((pop-up-windows t))
-             (pop-to-buffer buffer))
-           (save-excursion
-             (set-buffer buffer)
-             (if (and minheight (< (window-height) minheight))
-                 (enlarge-window (- minheight (window-height))))
-             (electric-help-mode)
-	     (setq buffer-read-only nil)
-	     (or noerase
-		 (erase-buffer)))
-           (let ((standard-output buffer))
-             (if (not (funcall thunk))
-                 (progn
-                   (set-buffer buffer)
-                   (set-buffer-modified-p nil)
-                   (goto-char (point-min))
-                   (if one (shrink-window-if-larger-than-buffer (selected-window))))))
-           (set-buffer buffer)
-           (run-hooks 'electric-help-mode-hook)
-	   (setq buffer-read-only t)
-           (if (eq (car-safe (electric-help-command-loop))
-                   'retain)
-               (setq config (current-window-configuration))
-               (setq bury t)))
-      (message "")
-      (set-buffer buffer)
-      (setq buffer-read-only nil)
-      (condition-case ()
-          (funcall (or default-major-mode 'fundamental-mode))
-        (error nil))
-      (set-window-configuration config)
-      (if bury
-          (progn
-            ;;>> Perhaps this shouldn't be done.
-            ;; so that when we say "Press space to bury" we mean it
-            (replace-buffer-in-windows buffer)
-            ;; must do this outside of save-window-excursion
-            (bury-buffer buffer)))
-      (eval electric-help-form-to-execute))))
-
-(defun electric-help-command-loop ()
-  (catch 'exit
-    (if (pos-visible-in-window-p (point-max))
-	(progn (message "%s" (substitute-command-keys "<<< Press Space to bury the help buffer, Press \\[electric-help-retain] to retain it >>>"))
-	       (if (equal (setq unread-command-events (list (read-event)))
-			  '(?\ ))
-		   (progn (setq unread-command-events nil)
-			  (throw 'exit t)))))
-    (let (up down both neither
-	  (standard (and (eq (key-binding " ")
-			     'scroll-up)
-			 (eq (key-binding "\^?")
-			     'scroll-down)
-			 (eq (key-binding "q")
-			     'electric-help-exit)
-			 (eq (key-binding "r")
-			     'electric-help-retain))))
-      (Electric-command-loop
-        'exit
-	(function (lambda ()
-	  (sit-for 0) ;necessary if last command was end-of-buffer or 
-	              ;beginning-of-buffer - otherwise pos-visible-in-window-p 
-	              ;will yield a wrong result.
-	  (let ((min (pos-visible-in-window-p (point-min)))
-		(max (pos-visible-in-window-p (point-max))))
-	    (cond (isearch-mode 'noprompt)
-		  ((and min max)
-		   (cond (standard "Press q to exit, r to retain ")
-			 (neither)
-			 (t (setq neither (substitute-command-keys "Press \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
-		  (min
-		   (cond (standard "Press SPC to scroll, q to exit, r to retain ")
-			 (up)
-			 (t (setq up (substitute-command-keys "Press \\[scroll-up] to scroll, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
-		  (max
-		   (cond (standard "Press DEL to scroll back, q to exit, r to retain ")
-			 (down)
-			 (t (setq down (substitute-command-keys "Press \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))
-		  (t
-		   (cond (standard "Press SPC to scroll, DEL to scroll back, q to exit, r to retain ")
-			 (both)
-			 (t (setq both (substitute-command-keys "Press \\[scroll-up] to scroll, \\[scroll-down] to scroll back, \\[electric-help-exit] to exit, \\[electric-help-retain] to retain ")))))))))
-		    t))))
-
-
-
-;(defun electric-help-scroll-up (arg)
-;  ">>>Doc"
-;  (interactive "P")
-;  (if (and (null arg) (pos-visible-in-window-p (point-max)))
-;      (electric-help-exit)
-;    (scroll-up arg)))
-
-(defun electric-help-exit ()
-  ">>>Doc"
-  (interactive)
-  (throw 'exit t))
-
-(defun electric-help-retain ()
-  "Exit `electric-help', retaining the current window/buffer configuration.
-\(The *Help* buffer will not be selected, but \\[switch-to-buffer-other-window] RET
-will select it.)"
-  (interactive)
-  ;; Make sure that we don't throw twice, even if two events cause
-  ;; calling this function:
-  (if (memq 'electric-help-retain mouse-leave-buffer-hook)
-      (progn
-	(remove-hook 'mouse-leave-buffer-hook 'electric-help-retain)
-	(throw 'exit '(retain)))))
-
-
-(defun electric-help-undefined ()
-  (interactive)
-  (error "%s is undefined -- Press %s to exit"
-	 (mapconcat 'single-key-description (this-command-keys) " ")
-	 (if (eq (key-binding "q") 'electric-help-exit)
-	     "q"
-	   (substitute-command-keys "\\[electric-help-exit]"))))
-
-
-;>>> this needs to be hairified (recursive help, anybody?)
-(defun electric-help-help ()
-  (interactive)
-  (if (and (eq (key-binding "q") 'electric-help-exit)
-	   (eq (key-binding " ") 'scroll-up)
-	   (eq (key-binding "\^?") 'scroll-down)
-	   (eq (key-binding "r") 'electric-help-retain))
-      (message "SPC scrolls up, DEL scrolls down, q exits burying help buffer, r exits")
-    (message "%s" (substitute-command-keys "\\[scroll-up] scrolls up, \\[scroll-down] scrolls down, \\[electric-help-exit] exits burying help buffer, \\[electric-help-retain] exits")))
-  (sit-for 2))
-
-
-;;;###autoload
-(defun electric-helpify (fun &optional name)
-  (let ((name (or name "*Help*")))
-    (if (save-window-excursion
-	  ;; kludge-o-rama
-	  (let* ((p (symbol-function 'print-help-return-message))
-		 (b (get-buffer name))
-		 (m (buffer-modified-p b)))
-	    (and b (not (get-buffer-window b))
-		 (setq b nil))
-	    (unwind-protect
-		(progn
-		  (message "%s..." (capitalize (symbol-name fun)))
-		  ;; with-output-to-temp-buffer marks the buffer as unmodified.
-		  ;; kludging excessively and relying on that as some sort
-		  ;;  of indication leads to the following abomination...
-		  ;;>> This would be doable without such icky kludges if either
-		  ;;>> (a) there were a function to read the interactive
-		  ;;>>     args for a command and return a list of those args.
-		  ;;>>     (To which one would then just apply the command)
-		  ;;>>     (The only problem with this is that interactive-p
-		  ;;>>      would break, but that is such a misfeature in
-		  ;;>>      any case that I don't care)
-		  ;;>>     It is easy to do this for emacs-lisp functions;
-		  ;;>>     the only problem is getting the interactive spec
-		  ;;>>     for subrs
-		  ;;>> (b) there were a function which returned a
-		  ;;>>     modification-tick for a buffer.  One could tell
-		  ;;>>     whether a buffer had changed by whether the
-		  ;;>>     modification-tick were different.
-		  ;;>>     (Presumably there would have to be a way to either
-		  ;;>>      restore the tick to some previous value, or to
-		  ;;>>      suspend updating of the tick in order to allow
-		  ;;>>      things like momentary-string-display)
-		  (and b
-		       (save-excursion
-			 (set-buffer b)
-			 (set-buffer-modified-p t)))
-		  (fset 'print-help-return-message 'ignore)
-		  (call-interactively fun)
-		  (and (get-buffer name)
-		       (get-buffer-window (get-buffer name))
-		       (or (not b)
-			   (not (eq b (get-buffer name)))
-			   (not (buffer-modified-p b)))))
-	      (fset 'print-help-return-message p)
-	      (and b (buffer-name b)
-		   (save-excursion
-		     (set-buffer b)
-		     (set-buffer-modified-p m))))))
-	(with-electric-help 'ignore name t))))
-
-
-
-;; This is to be bound to M-x in ehelp mode. Retains ehelp buffer and then 
-;; continues with execute-extended-command.
-(defun electric-help-execute-extended (prefixarg)
-  (interactive "p")
-  (setq electric-help-form-to-execute '(execute-extended-command nil))
-  (electric-help-retain))
-
-;; This is to be buond to C-x in ehelp mode. Retains ehelp buffer and then
-;; continues with ctrl-x prefix.
-(defun electric-help-ctrl-x-prefix (prefixarg)
-  (interactive "p")
-  (setq electric-help-form-to-execute '(progn (message nil) (setq unread-command-char ?\C-x)))
-  (electric-help-retain))
-
-
-(defun electric-describe-key ()
-  (interactive)
-  (electric-helpify 'describe-key))
-
-(defun electric-describe-mode ()
-  (interactive)
-  (electric-helpify 'describe-mode))
-
-(defun electric-view-lossage ()
-  (interactive)
-  (electric-helpify 'view-lossage))
-
-;(defun electric-help-for-help ()
-;  "See help-for-help"
-;  (interactive)
-;  )
-
-(defun electric-describe-function ()
-  (interactive)
-  (electric-helpify 'describe-function))
-
-(defun electric-describe-variable ()
-  (interactive)
-  (electric-helpify 'describe-variable))
-
-(defun electric-describe-bindings ()
-  (interactive)
-  (electric-helpify 'describe-bindings))
-
-(defun electric-describe-syntax ()
-  (interactive)
-  (electric-helpify 'describe-syntax))
-
-(defun electric-command-apropos ()
-  (interactive)
-  (electric-helpify 'command-apropos "*Apropos*"))
-
-;(define-key help-map "a" 'electric-command-apropos)
-
-(defun electric-apropos ()
-  (interactive)
-  (electric-helpify 'apropos))
-
-
-;;;; ehelp-map
-
-(defvar ehelp-map ())
-(if ehelp-map
-    nil
-  (let ((map (copy-keymap help-map))) 
-    (substitute-key-definition 'apropos 'electric-apropos map)
-    (substitute-key-definition 'command-apropos 'electric-command-apropos map)
-    (substitute-key-definition 'describe-key 'electric-describe-key map)
-    (substitute-key-definition 'describe-mode 'electric-describe-mode map)
-    (substitute-key-definition 'view-lossage 'electric-view-lossage map)
-    (substitute-key-definition 'describe-function 'electric-describe-function map)
-    (substitute-key-definition 'describe-variable 'electric-describe-variable map)
-    (substitute-key-definition 'describe-bindings 'electric-describe-bindings map)
-    (substitute-key-definition 'describe-syntax 'electric-describe-syntax map)
-
-    (setq ehelp-map map)
-    (fset 'ehelp-command map)))
-
-(provide 'ehelp) 
-
-;;; ehelp.el ends here
diff --git a/lisp/electric.el b/lisp/electric.el
deleted file mode 100644
index 8a155b324d5..00000000000
--- a/lisp/electric.el
+++ /dev/null
@@ -1,178 +0,0 @@
-;;; electric.el --- window maker and Command loop for `electric' modes.
-
-;; Copyright (C) 1985, 1986, 1995 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; 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:
-
-; zaaaaaaap
-
-;;; Code:
-
-;; This loop is the guts for non-standard modes which retain control
-;; until some event occurs.  It is a `do-forever', the only way out is
-;; to throw.  It assumes that you have set up the keymap, window, and
-;; everything else: all it does is read commands and execute them -
-;; providing error messages should one occur (if there is no loop
-;; function - which see).  The required argument is a tag which should
-;; expect a value of nil if the user decides to punt. The second
-;; argument is the prompt to be used: if nil, use "->", if 'noprompt,
-;; don't use a prompt, if a string, use that string as prompt, and if
-;; a function of no variable, it will be evaluated in every iteration
-;; of the loop and its return value, which can be nil, 'noprompt or a
-;; string, will be used as prompt.  Given third argument non-nil, it
-;; INHIBITS quitting unless the user types C-g at toplevel.  This is
-;; so user can do things like C-u C-g and not get thrown out.  Fourth
-;; argument, if non-nil, should be a function of two arguments which
-;; is called after every command is executed.  The fifth argument, if
-;; provided, is the state variable for the function.  If the
-;; loop-function gets an error, the loop will abort WITHOUT throwing
-;; (moral: use unwind-protect around call to this function for any
-;; critical stuff).  The second argument for the loop function is the
-;; conditions for any error that occurred or nil if none.
-
-(defun Electric-command-loop (return-tag
-			      &optional prompt inhibit-quit
-					loop-function loop-state)
-
-  (let (cmd 
-        (err nil) 
-        (prompt-string prompt))
-    (while t
-      (if (not (or (stringp prompt) (eq prompt nil) (eq prompt 'noprompt)))
-          (setq prompt-string (funcall prompt)))
-      (if (not (stringp prompt-string))
-          (if (eq prompt-string 'noprompt)
-              (setq prompt-string nil)
-            (setq prompt-string "->")))
-      (setq cmd (read-key-sequence prompt-string))
-      (setq last-command-char (aref cmd (1- (length cmd)))
-	    this-command (key-binding cmd t)
-	    cmd this-command)
-      ;; This makes universal-argument-other-key work.
-      (setq universal-argument-num-events 0)
-      (if (or (prog1 quit-flag (setq quit-flag nil))
-	      (eq last-input-char ?\C-g))
-	  (progn (setq unread-command-events nil
-		       prefix-arg nil)
-		 ;; If it wasn't cancelling a prefix character, then quit.
-		 (if (or (= (length (this-command-keys)) 1)
-			 (not inhibit-quit)) ; safety
-		     (progn (ding)
-			    (message "Quit")
-			    (throw return-tag nil))
-		   (setq cmd nil))))
-      (setq current-prefix-arg prefix-arg)
-      (if cmd
-	  (condition-case conditions
-	      (progn (command-execute cmd)
-		     (setq last-command this-command)
-		     (if (or (prog1 quit-flag (setq quit-flag nil))
-			     (eq last-input-char ?\C-g))
-			 (progn (setq unread-command-events nil)
-				(if (not inhibit-quit)
-				    (progn (ding)
-					   (message "Quit")
-					   (throw return-tag nil))
-				  (ding)))))
-	    (buffer-read-only (if loop-function
-				  (setq err conditions)
-				(ding)
-				(message "Buffer is read-only")
-				(sit-for 2)))
-	    (beginning-of-buffer (if loop-function
-				     (setq err conditions)
-				   (ding)
-				   (message "Beginning of Buffer")
-				   (sit-for 2)))
-	    (end-of-buffer (if loop-function
-			       (setq err conditions)
-			     (ding)
-			     (message "End of Buffer")
-			     (sit-for 2)))
-	    (error (if loop-function
-		       (setq err conditions)
-		     (ding)
-		     (message "Error: %s"
-			      (if (eq (car conditions) 'error)
-				  (car (cdr conditions))
-				(prin1-to-string conditions)))
-		     (sit-for 2))))
-	(ding))
-      (if loop-function (funcall loop-function loop-state err))))
-  (ding)
-  (throw return-tag nil))
-
-;; This function is like pop-to-buffer, sort of. 
-;; The algorithm is
-;; If there is a window displaying buffer
-;; 	Select it
-;; Else if there is only one window
-;; 	Split it, selecting the window on the bottom with height being
-;; 	the lesser of max-height (if non-nil) and the number of lines in
-;;      the buffer to be displayed subject to window-min-height constraint.
-;; Else
-;; 	Switch to buffer in the current window.
-;;
-;; Then if max-height is nil, and not all of the lines in the buffer
-;; are displayed, grab the whole frame.
-;;
-;; Returns selected window on buffer positioned at point-min.
-
-(defun Electric-pop-up-window (buffer &optional max-height)
-  (let* ((win (or (get-buffer-window buffer) (selected-window)))
-	 (buf (get-buffer buffer))
-	 (one-window (one-window-p t))
-	 (pop-up-windows t)
-	 (target-height)
-	 (lines))
-    (if (not buf)
-	(error "Buffer %s does not exist" buffer)
-      (save-excursion
-	(set-buffer buf)
-	(setq lines (count-lines (point-min) (point-max)))
-	(setq target-height
-	      (min (max (if max-height (min max-height (1+ lines)) (1+ lines))
-			window-min-height)
-		   (save-window-excursion
-		     (delete-other-windows)
-		     (1- (window-height (selected-window)))))))
-      (cond ((and (eq (window-buffer win) buf))
-	     (select-window win))
-	    (one-window
-	     (goto-char (window-start win))
-	     (pop-to-buffer buffer)
-	     (setq win (selected-window))
-	     (enlarge-window (- target-height (window-height win))))
-	    (t
-	     (switch-to-buffer buf)))
-      (if (and (not max-height)
-	       (> target-height (window-height (selected-window))))
-	  (progn (goto-char (window-start win))
-		 (enlarge-window (- target-height (window-height win)))))
-      (goto-char (point-min))
-      win)))
-
-(provide 'electric)
-
-;;; electric.el ends here
diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el
deleted file mode 100644
index dabff28ae3a..00000000000
--- a/lisp/emacs-lisp/advice.el
+++ /dev/null
@@ -1,3960 +0,0 @@
-;;; advice.el --- an overloading mechanism for Emacs Lisp functions
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
-;; Created: 12 Dec 1992
-;; Version: advice.el,v 2.14 1994/08/05 03:42:04 hans Exp
-;; Keywords: extensions, lisp, 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.
-
-;; LCD Archive Entry:
-;; advice|Hans Chalupsky|hans@cs.buffalo.edu|
-;; Overloading mechanism for Emacs Lisp functions|
-;; 1994/08/05 03:42:04|2.14|~/packages/advice.el.Z|
-
-
-;;; Commentary:
-
-;; NOTE: This documentation is slightly out of date. In particular, all the
-;; references to Emacs-18 are obsolete now, because it is not any longer
-;; supported by this version of Advice. An up-to-date version will soon be
-;; available as an info file (thanks to the kind help of Jack Vinson and
-;; David M. Smith).
-
-;; @ Introduction:
-;; ===============
-;; This package implements a full-fledged Lisp-style advice mechanism
-;; for Emacs Lisp. Advice is a clean and efficient way to modify the 
-;; behavior of Emacs Lisp functions without having to keep  personal
-;; modified copies of such functions around. A great number of such 
-;; modifications can be achieved by treating the original function as a 
-;; black box and specifying a different execution environment for it 
-;; with a piece of advice. Think of a piece of advice as a kind of fancy
-;; hook that you can attach to any function/macro/subr.
-
-;; @ Highlights:
-;; =============
-;; - Clean definition of multiple, named before/around/after advices
-;;   for functions, macros, subrs and special forms
-;; - Full control over the arguments an advised function will receive,
-;;   the binding environment in which it will be executed, as well as the
-;;   value it will return.
-;; - Allows re/definition of interactive behavior for functions and subrs
-;; - Every piece of advice can have its documentation string which will be 
-;;   combined with the original documentation of the advised function at
-;;   call-time of `documentation' for proper command-key substitution.
-;; - The execution of every piece of advice can be protected against error
-;;   and non-local exits in preceding code or advices.
-;; - Simple argument access either by name, or, more portable but as
-;;   efficient, via access macros
-;; - Allows the specification of a different argument list for the advised
-;;   version of a function.
-;; - Advised functions can be byte-compiled either at file-compile time
-;;   (see preactivation) or activation time.
-;; - Separation of advice definition and activation
-;; - Forward advice is possible, that is
-;;   as yet undefined or autoload functions can be advised without having to
-;;   preload the file in which they are defined. 
-;; - Forward redefinition is possible because around advice can be used to
-;;   completely redefine a function.
-;; - A caching mechanism for advised definition provides for cheap deactivation
-;;   and reactivation of advised functions.
-;; - Preactivation allows efficient construction and compilation of advised
-;;   definitions at file compile time without giving up the flexibility of
-;;   the advice mechanism.
-;; - En/disablement mechanism allows the use of  different "views" of advised
-;;   functions depending on what pieces of advice are currently en/disabled
-;; - Provides manipulation mechanisms for sets of advised functions via 
-;;   regular expressions that match advice names
-
-;; @ How to get Advice for Emacs-18:
-;; =================================
-;; `advice18.el', a version of Advice that also works in Emacs-18 is available
-;; either via anonymous ftp from `ftp.cs.buffalo.edu (128.205.32.9)' with 
-;; pathname `/pub/Emacs/advice18.el', or from one of the Emacs Lisp archive
-;; sites, or send email to <hans@cs.buffalo.edu> and I'll mail it to you.
-
-;; @ Overview, or how to read this file:
-;; =====================================
-;; NOTE: This documentation is slightly out of date. In particular, all the
-;; references to Emacs-18 are obsolete now, because it is not any longer
-;; supported by this version of Advice. An up-to-date version will soon be
-;; available as an info file (thanks to the kind help of Jack Vinson and
-;; David M. Smith). Until then you can use `outline-mode' to help you read
-;; this documentation (set `outline-regexp' to `";; @+"').
-;;
-;; The four major sections of this file are:
-;;
-;;   @ This initial information       ...installation, customization etc.
-;;   @ Advice documentation:          ...general documentation
-;;   @ Foo games: An advice tutorial  ...teaches about Advice by example
-;;   @ Advice implementation:         ...actual code, yeah!!
-;;
-;; The latter three are actual headings which you can search for
-;; directly in case `outline-mode' doesn't work for you.
-
-;; @ Restrictions:
-;; ===============
-;; - This version of Advice only works for Emacs 19.26 and later. It uses
-;;   new versions of the built-in functions `fset/defalias' which are not
-;;   yet available in Lucid Emacs, hence, it won't work there.
-;; - Advised functions/macros/subrs will only exhibit their advised behavior
-;;   when they are invoked via their function cell. This means that advice will
-;;   not work for the following:
-;;   + advised subrs that are called directly from other subrs or C-code 
-;;   + advised subrs that got replaced with their byte-code during 
-;;     byte-compilation (e.g., car)
-;;   + advised macros which were expanded during byte-compilation before
-;;     their advice was activated.
-
-;; @ Credits:
-;; ==========
-;; This package is an extension and generalization of packages such as
-;; insert-hooks.el written by Noah S. Friedman, and advise.el written by
-;; Raul J. Acevedo. Some ideas used in here come from these packages,
-;; others come from the various Lisp advice mechanisms I've come across
-;; so far, and a few are simply mine.
-
-;; @ Comments, suggestions, bug reports:
-;; =====================================
-;; If you find any bugs, have suggestions for new advice features, find the
-;; documentation wrong, confusing, incomplete, or otherwise unsatisfactory,
-;; have any questions about Advice, or have otherwise enlightening
-;; comments feel free to send me email at <hans@cs.buffalo.edu>.
-
-;; @ Safety Rules and Emergency Exits:
-;; ===================================
-;; Before we begin: CAUTION!!
-;; Advice provides you with a lot of rope to hang yourself on very
-;; easily accessible trees, so, here are a few important things you
-;; should know: Once Advice has been started with `ad-start-advice'
-;; (which happens automatically when you load this file), it
-;; generates an advised definition of the `documentation' function, and
-;; it will enable automatic advice activation when functions get defined.
-;; All of this can be undone at any time with `M-x ad-stop-advice'.
-;; 
-;; If you experience any strange behavior/errors etc. that you attribute to
-;; Advice or to some ill-advised function do one of the following:
-
-;; - M-x ad-deactivate FUNCTION (if you have a definite suspicion what
-;;                               function gives you problems)
-;; - M-x ad-deactivate-all      (if you don't have a clue what's going wrong)
-;; - M-x ad-stop-advice         (if you think the problem is related to the
-;;                               advised functions used by Advice itself)
-;; - M-x ad-recover-normality   (for real emergencies)
-;; - If none of the above solves your Advice-related problem go to another
-;;   terminal, kill your Emacs process and send me some hate mail.
-
-;; The first three measures have restarts, i.e., once you've figured out
-;; the problem you can reactivate advised functions with either `ad-activate',
-;; `ad-activate-all', or `ad-start-advice'. `ad-recover-normality' unadvises
-;; everything so you won't be able to reactivate any advised functions, you'll
-;; have to stick with their standard incarnations for the rest of the session.
-
-;; IMPORTANT: With Advice loaded always do `M-x ad-deactivate-all' before
-;; you byte-compile a file, because advised special forms and macros can lead
-;; to unwanted compilation results. When you are done compiling use
-;; `M-x ad-activate-all' to go back to the advised state of all your 
-;; advised functions.
-
-;; RELAX: Advice is pretty safe even if you are oblivious to the above.
-;; I use it extensively and haven't run into any serious trouble in a long
-;; time. Just wanted you to be warned.
-
-;; @ Customization:
-;; ================
-
-;; Look at the documentation of `ad-redefinition-action' for possible values
-;; of this variable. Its default value is `warn' which will print a warning
-;; message when an already defined advised function gets redefined with a
-;; new original definition and de/activated.
-
-;; Look at the documentation of `ad-default-compilation-action' for possible
-;; values of this variable. Its default value is `maybe' which will compile
-;; advised definitions during activation in case the byte-compiler is already
-;; loaded. Otherwise, it will leave them uncompiled.
-
-;; @ Motivation:
-;; =============
-;; Before I go on explaining how advice works, here are four simple examples
-;; how this package can be used. The first three are very useful, the last one
-;; is just a joke:
-
-;;(defadvice switch-to-buffer (before existing-buffers-only activate)
-;;  "When called interactively switch to existing buffers only, unless 
-;;when called with a prefix argument."
-;;  (interactive 
-;;   (list (read-buffer "Switch to buffer: " (other-buffer) 
-;;                      (null current-prefix-arg)))))
-;;
-;;(defadvice switch-to-buffer (around confirm-non-existing-buffers activate)
-;;  "Switch to non-existing buffers only upon confirmation."
-;;  (interactive "BSwitch to buffer: ")
-;;  (if (or (get-buffer (ad-get-arg 0))
-;;          (y-or-n-p (format "`%s' does not exist, create? " (ad-get-arg 0))))
-;;      ad-do-it))
-;;
-;;(defadvice find-file (before existing-files-only activate)
-;;  "Find existing files only"
-;;  (interactive "fFind file: "))
-;;
-;;(defadvice car (around interactive activate)
-;;  "Make `car' an interactive function."
-;;   (interactive "xCar of list: ")
-;;   ad-do-it
-;;   (if (interactive-p)
-;;       (message "%s" ad-return-value)))
-
-
-;; @ Advice documentation:
-;; =======================
-;; Below is general documentation of the various features of advice. For more
-;; concrete examples check the corresponding sections in the tutorial part.
-
-;; @@ Terminology:
-;; ===============
-;; - Emacs, Emacs-19: FSF's version of Emacs with major version 19
-;; - Lemacs: Lucid's version of Emacs with major version 19
-;; - v18: Any Emacs with major version 18 or built as an extension to that
-;;        (such as Epoch)
-;; - v19: Any Emacs with major version 19
-;; - jwz: Jamie Zawinski - keeper of Lemacs and creator of the optimizing
-;;        byte-compiler used in v19s.
-;; - Advice: The name of this package.
-;; - advices: Short for "pieces of advice".
-
-;; @@ Defining a piece of advice with `defadvice':
-;; ===============================================
-;; The main means of defining a piece of advice is the macro `defadvice',
-;; there is no interactive way of specifying a piece of advice.  A call to
-;; `defadvice' has the following syntax which is similar to the syntax of
-;; `defun/defmacro':
-;;
-;; (defadvice <function> (<class> <name> [<position>] [<arglist>] {<flags>}*)
-;;   [ [<documentation-string>] [<interactive-form>] ]
-;;   {<body-form>}* )
-
-;; <function> is the name of the function/macro/subr to be advised.
-
-;; <class> is the class of the advice which has to be one of `before',
-;; `around', `after', `activation' or `deactivation' (the last two allow
-;; definition of special act/deactivation hooks).
-
-;; <name> is the name of the advice which has to be a non-nil symbol.
-;; Names uniquely identify a piece of advice in a certain advice class,
-;; hence, advices can be redefined by defining an advice with the same class
-;; and name. Advice names are global symbols, hence, the same name space
-;; conventions used for function names should be applied.
-
-;; An optional <position> specifies where in the current list of advices of
-;; the specified <class> this new advice will be placed. <position> has to
-;; be either `first', `last' or a number that specifies a zero-based
-;; position (`first' is equivalent to 0). If no position is specified
-;; `first' will be used as a default. If this call to `defadvice' redefines
-;; an already existing advice (see above) then the position argument will
-;; be ignored and the position of the already existing advice will be used.
-
-;; An optional <arglist> which has to be a list can be used to define the
-;; argument list of the advised function. This argument list should of
-;; course be compatible with the argument list of the original function,
-;; otherwise functions that call the advised function with the original
-;; argument list in mind will break. If more than one advice specify an
-;; argument list then the first one (the one with the smallest position)
-;; found in the list of before/around/after advices will be used.
-
-;; <flags> is a list of symbols that specify further information about the
-;; advice. All flags can be specified with unambiguous initial substrings.
-;;   `activate': Specifies that the advice information of the advised
-;;              function should be activated right after this advice has been
-;;              defined. In forward advices `activate' will be ignored. 
-;;   `protect': Specifies that this advice should be protected against
-;;              non-local exits and errors in preceding code/advices.
-;;   `compile': Specifies that the advised function should be byte-compiled.
-;;              This flag will be ignored unless `activate' is also specified.
-;;   `disable': Specifies that the defined advice should be disabled, hence,
-;;              it will not be used in an activation until somebody enables it.
-;;   `preactivate': Specifies that the advised function should get preactivated
-;;              at macro-expansion/compile time of this `defadvice'. This
-;;              generates a compiled advised definition according to the
-;;              current advice state which will be used during activation
-;;              if appropriate. Only use this if the `defadvice' gets
-;;              actually compiled (with a v18 byte-compiler put the `defadvice'
-;;              into the body of a `defun' to accomplish proper compilation).
-
-;; An optional <documentation-string> can be supplied to document the advice.
-;; On call of the `documentation' function it will be combined with the
-;; documentation strings of the original function and other advices.
-
-;; An optional <interactive-form> form can be supplied to change/add
-;; interactive behavior of the original function. If more than one advice
-;; has an `(interactive ...)' specification then the first one (the one
-;; with the smallest position) found in the list of before/around/after
-;; advices will be used.
-
-;; A possibly empty list of <body-forms> specifies the body of the advice in
-;; an implicit progn. The body of an advice can access/change arguments,
-;; the return value, the binding environment, and can have all sorts of 
-;; other side effects.
-
-;; @@ Assembling advised definitions:
-;; ==================================
-;; Suppose a function/macro/subr/special-form has N pieces of before advice,
-;; M pieces of around advice and K pieces of after advice. Assuming none of
-;; the advices is protected, its advised definition will look like this
-;; (body-form indices correspond to the position of the respective advice in
-;; that advice class):
-
-;;    ([macro] lambda <arglist>
-;;       [ [<advised-docstring>] [(interactive ...)] ]
-;;       (let (ad-return-value)
-;;         {<before-0-body-form>}*
-;;               ....
-;;         {<before-N-1-body-form>}*
-;;         {<around-0-body-form>}*
-;;            {<around-1-body-form>}*
-;;                  ....
-;;               {<around-M-1-body-form>}*
-;;                  (setq ad-return-value
-;;                        <apply original definition to <arglist>>)
-;;               {<other-around-M-1-body-form>}*
-;;                  ....
-;;            {<other-around-1-body-form>}*
-;;         {<other-around-0-body-form>}*
-;;         {<after-0-body-form>}*
-;;               ....
-;;         {<after-K-1-body-form>}*
-;;         ad-return-value))
-
-;; Macros and special forms will be redefined as macros, hence the optional
-;; [macro] in the beginning of the definition.
-
-;; <arglist> is either the argument list of the original function or the
-;; first argument list defined in the list of before/around/after advices.
-;; The values of <arglist> variables can be accessed/changed in the body of
-;; an advice by simply referring to them by their original name, however,
-;; more portable argument access macros are also provided (see below).  For
-;; subrs/special-forms for which neither explicit argument list definitions
-;; are available, nor their documentation strings contain such definitions
-;; (as they do v19s), `(&rest ad-subr-args)' will be used.
-
-;; <advised-docstring> is an optional, special documentation string which will
-;; be expanded into a proper documentation string upon call of `documentation'.
-
-;; (interactive ...) is an optional interactive form either taken from the
-;; original function or from a before/around/after advice. For advised
-;; interactive subrs that do not have an interactive form specified in any
-;; advice we have to use (interactive) and then call the subr interactively
-;; if the advised function was called interactively, because the
-;; interactive specification of subrs is not accessible. This is the only
-;; case where changing the values of arguments will not have an affect
-;; because they will be reset by the interactive specification of the subr.
-;; If this is a problem one can always specify an interactive form in a
-;; before/around/after advice to gain control over argument values that
-;; were supplied interactively.
-;; 
-;; Then the body forms of the various advices in the various classes of advice
-;; are assembled in order.  The forms of around advice L are normally part of
-;; one of the forms of around advice L-1. An around advice can specify where
-;; the forms of the wrapped or surrounded forms should go with the special
-;; keyword `ad-do-it', which will be substituted with a `progn' containing the
-;; forms of the surrounded code.
-
-;; The innermost part of the around advice onion is 
-;;      <apply original definition to <arglist>>
-;; whose form depends on the type of the original function. The variable
-;; `ad-return-value' will be set to its result. This variable is visible to
-;; all pieces of advice which can access and modify it before it gets returned.
-;; 
-;; The semantic structure of advised functions that contain protected pieces
-;; of advice is the same. The only difference is that `unwind-protect' forms
-;; make sure that the protected advice gets executed even if some previous
-;; piece of advice had an error or a non-local exit. If any around advice is
-;; protected then the whole around advice onion will be protected.
-
-;; @@ Argument access in advised functions:
-;; ========================================
-;; As already mentioned, the simplest way to access the arguments of an
-;; advised function in the body of an advice is to refer to them by name. To
-;; do that, the advice programmer needs to know either the names of the
-;; argument variables of the original function, or the names used in the
-;; argument list redefinition given in a piece of advice. While this simple
-;; method might be sufficient in many cases, it has the disadvantage that it
-;; is not very portable because it hardcodes the argument names into the
-;; advice. If the definition of the original function changes the advice
-;; might break even though the code might still be correct. Situations like
-;; that arise, for example, if one advises a subr like `eval-region' which
-;; gets redefined in a non-advice style into a function by the edebug
-;; package. If the advice assumes `eval-region' to be a subr it might break
-;; once edebug is loaded. Similar situations arise when one wants to use the
-;; same piece of advice across different versions of Emacs. Some subrs in a
-;; v18 Emacs are functions in v19 and vice versa, but for the most part the
-;; semantics remain the same, hence, the same piece of advice might be usable
-;; in both Emacs versions.
-
-;; As a solution to that advice provides argument list access macros that get
-;; translated into the proper access forms at activation time, i.e., when the
-;; advised definition gets constructed. Access macros access actual arguments
-;; by position regardless of how these actual argument get distributed onto
-;; the argument variables of a function. The rational behind this is that in
-;; Emacs Lisp the semantics of an argument is strictly determined by its
-;; position (there are no keyword arguments).
-
-;; Suppose the function `foo' is defined as
-;;
-;;    (defun foo (x y &optional z &rest r) ....)
-;;
-;; and is then called with
-;;
-;;    (foo 0 1 2 3 4 5 6)
-
-;; which means that X=0, Y=1, Z=2 and R=(3 4 5 6). The assumption is that
-;; the semantics of an actual argument is determined by its position. It is
-;; this semantics that has to be known by the advice programmer. Then s/he
-;; can access these arguments in a piece of advice with some of the
-;; following macros (the arrows indicate what value they will return):
-
-;;    (ad-get-arg 0) -> 0
-;;    (ad-get-arg 1) -> 1
-;;    (ad-get-arg 2) -> 2
-;;    (ad-get-arg 3) -> 3
-;;    (ad-get-args 2) -> (2 3 4 5 6)
-;;    (ad-get-args 4) -> (4 5 6)
-
-;; `(ad-get-arg <position>)' will return the actual argument that was supplied
-;; at <position>, `(ad-get-args <position>)' will return the list of actual
-;; arguments supplied starting at <position>. Note that these macros can be
-;; used without any knowledge about the form of the actual argument list of
-;; the original function.
-
-;; Similarly, `(ad-set-arg <position> <value-form>)' can be used to set the
-;; value of the actual argument at <position> to <value-form>. For example,
-;;
-;;   (ad-set-arg 5 "five")
-;;
-;; will have the effect that R=(3 4 "five" 6) once the original function is
-;; called. `(ad-set-args <position> <value-list-form>)' can be used to set
-;; the list of actual arguments starting at <position> to <value-list-form>.
-;; For example,
-;;
-;;   (ad-set-args 0 '(5 4 3 2 1 0))
-;;
-;; will have the effect that X=5, Y=4, Z=3 and R=(2 1 0) once the original
-;; function is called.
-
-;; All these access macros are text macros rather than real Lisp macros. When
-;; the advised definition gets constructed they get replaced with actual access
-;; forms depending on the argument list of the advised function, i.e., after
-;; that argument access is in most cases as efficient as using the argument
-;; variable names directly.
-
-;; @@@ Accessing argument bindings of arbitrary functions:
-;; =======================================================
-;; Some functions (such as `trace-function' defined in trace.el) need a
-;; method of accessing the names and bindings of the arguments of an
-;; arbitrary advised function. To do that within an advice one can use the
-;; special keyword `ad-arg-bindings' which is a text macro that will be
-;; substituted with a form that will evaluate to a list of binding
-;; specifications, one for every argument variable.  These binding
-;; specifications can then be examined in the body of the advice.  For
-;; example, somewhere in an advice we could do this:
-;;
-;;   (let* ((bindings ad-arg-bindings)
-;;          (firstarg (car bindings))
-;;          (secondarg (car (cdr bindings))))
-;;     ;; Print info about first argument
-;;     (print (format "%s=%s (%s)"
-;;                    (ad-arg-binding-field firstarg 'name)
-;;                    (ad-arg-binding-field firstarg 'value)
-;;                    (ad-arg-binding-field firstarg 'type)))
-;;     ....)
-;;
-;; The `type' of an argument is either `required', `optional' or `rest'.
-;; Wherever `ad-arg-bindings' appears a form will be inserted that evaluates
-;; to the list of bindings, hence, in order to avoid multiple unnecessary
-;; evaluations one should always bind it to some variable.
-
-;; @@@ Argument list mapping:
-;; ==========================
-;; Because `defadvice' allows the specification of the argument list of the
-;; advised function we need a mapping mechanism that maps this argument list
-;; onto that of the original function. For example, somebody might specify
-;; `(sym newdef)' as the argument list of `fset', while advice might use
-;; `(&rest ad-subr-args)' as the argument list of the original function
-;; (depending on what Emacs version is used). Hence SYM and NEWDEF have to
-;; be properly mapped onto the &rest variable when the original definition is
-;; called. Advice automatically takes care of that mapping, hence, the advice 
-;; programmer can specify an argument list without having to know about the
-;; exact structure of the original argument list as long as the new argument
-;; list takes a compatible number/magnitude of actual arguments.
-
-;; @@@ Definition of subr argument lists:
-;; ======================================
-;; When advice constructs the advised definition of a function it has to
-;; know the argument list of the original function. For functions and macros
-;; the argument list can be determined from the actual definition, however,
-;; for subrs there is no such direct access available. In Lemacs and for some
-;; subrs in Emacs-19 the argument list of a subr can be determined from
-;; its documentation string, in a v18 Emacs even that is not possible. If
-;; advice cannot at all determine the argument list of a subr it uses
-;; `(&rest ad-subr-args)' which will always work but is inefficient because
-;; it conses up arguments. The macro `ad-define-subr-args' can be used by
-;; the advice programmer to explicitly tell advice about the argument list
-;; of a certain subr, for example,
-;;
-;;    (ad-define-subr-args 'fset '(sym newdef))
-;;
-;; is used by advice itself to tell a v18 Emacs about the arguments of `fset'.
-;; The following can be used to undo such a definition:
-;;
-;;    (ad-undefine-subr-args 'fset)
-;;
-;; The argument list definition is stored on the property list of the subr
-;; name symbol. When an argument list could be determined from the
-;; documentation string it will be cached under that property. The general
-;; mechanism for looking up the argument list of a subr is the following:
-;; 1) look for a definition stored on the property list
-;; 2) if that failed try to infer it from the documentation string and
-;;    if successful cache it on the property list
-;; 3) otherwise use `(&rest ad-subr-args)'
-
-;; @@ Activation and deactivation:
-;; ===============================
-;; The definition of an advised function does not change until all its advice
-;; gets actually activated. Activation can either happen with the `activate'
-;; flag specified in the `defadvice', with an explicit call or interactive
-;; invocation of `ad-activate', or if forward advice is enabled (i.e., the
-;; value of `ad-activate-on-definition' is t) at the time an already advised
-;; function gets defined.
-
-;; When a function gets first activated its original definition gets saved,
-;; all defined and enabled pieces of advice will get combined with the
-;; original definition, the resulting definition might get compiled depending
-;; on some conditions described below, and then the function will get
-;; redefined with the advised definition.  This also means that undefined
-;; functions cannot get activated even though they might be already advised.
-
-;; The advised definition will get compiled either if `ad-activate' was called
-;; interactively with a prefix argument, or called explicitly with its second
-;; argument as t, or, if `ad-default-compilation-action' justifies it according
-;; to the current system state. If the advised definition was
-;; constructed during "preactivation" (see below) then that definition will
-;; be already compiled because it was constructed during byte-compilation of
-;; the file that contained the `defadvice' with the `preactivate' flag.
-
-;; `ad-deactivate' can be used to back-define an advised function to its
-;; original definition. It can be called interactively or directly. Because
-;; `ad-activate' caches the advised definition the function can be
-;; reactivated via `ad-activate' with only minor overhead (it is checked
-;; whether the current advice state is consistent with the cached
-;; definition, see the section on caching below).
-
-;; `ad-activate-regexp' and `ad-deactivate-regexp' can be used to de/activate
-;; all currently advised function that have a piece of advice with a name that
-;; contains a match for a regular expression. These functions can be used to
-;; de/activate sets of functions depending on certain advice naming
-;; conventions.
-
-;; Finally, `ad-activate-all' and `ad-deactivate-all' can be used to
-;; de/activate all currently advised functions. These are useful to
-;; (temporarily) return to an un/advised state.
-
-;; @@@ Reasons for the separation of advice definition and activation:
-;; ===================================================================
-;; As already mentioned, advising happens in two stages:
-
-;;   1) definition of various pieces of advice
-;;   2) activation of all advice currently defined and enabled
-
-;; The advantage of this is that various pieces of advice can be defined
-;; before they get combined into an advised definition which avoids
-;; unnecessary constructions of intermediate advised definitions. The more
-;; important advantage is that it allows the implementation of forward advice.
-;; Advice information for a certain function accumulates as the value of the
-;; `advice-info' property of the function symbol. This accumulation is
-;; completely independent of the fact that that function might not yet be
-;; defined. The special forms `defun' and `defmacro' have been advised to
-;; check whether the function/macro they defined had advice information
-;; associated with it. If so and forward advice is enabled, the original
-;; definition will be saved, and then the advice will be activated. When a
-;; file is loaded in a v18 Emacs the functions/macros it defines are also
-;; defined with calls to `defun/defmacro'.  Hence, we can forward advise
-;; functions/macros which will be defined later during a load/autoload of some
-;; file (for compiled files generated by jwz's byte-compiler in a v19 Emacs
-;; this is slightly more complicated but the basic idea is the same).
-
-;; @@ Enabling/disabling pieces or sets of advice:
-;; ===============================================
-;; A major motivation for the development of this advice package was to bring
-;; a little bit more structure into the function overloading chaos in Emacs
-;; Lisp. Many packages achieve some of their functionality by adding a little
-;; bit (or a lot) to the standard functionality of some Emacs Lisp function.
-;; ange-ftp is a very popular package that achieves its magic by overloading
-;; most Emacs Lisp functions that deal with files. A popular function that's
-;; overloaded by many packages is `expand-file-name'. The situation that one
-;; function is multiply overloaded can arise easily.
-
-;; Once in a while it would be desirable to be able to disable some/all
-;; overloads of a particular package while keeping all the rest.  Ideally -
-;; at least in my opinion - these overloads would all be done with advice,
-;; I know I am dreaming right now... In that ideal case the enable/disable
-;; mechanism of advice could be used to achieve just that.
-
-;; Every piece of advice is associated with an enablement flag. When the
-;; advised definition of a particular function gets constructed (e.g., during
-;; activation) only the currently enabled pieces of advice will be considered.
-;; This mechanism allows one to have different "views" of an advised function
-;; dependent on what pieces of advice are currently enabled.
-
-;; Another motivation for this mechanism is that it allows one to define a
-;; piece of advice for some function yet keep it dormant until a certain
-;; condition is met. Until then activation of the function will not make use
-;; of that piece of advice. Once the condition is met the advice can be
-;; enabled and a reactivation of the function will add its functionality as
-;; part of the new advised definition. For example, the advices of `defun'
-;; etc. used by advice itself will stay disabled until `ad-start-advice' is
-;; called and some variables have the proper values.  Hence, if somebody
-;; else advised these functions too and activates them the advices defined
-;; by advice will get used only if they are intended to be used.
-
-;; The main interface to this mechanism are the interactive functions
-;; `ad-enable-advice' and `ad-disable-advice'. For example, the following
-;; would disable a particular advice of the function `foo':
-;;
-;;    (ad-disable-advice 'foo 'before 'my-advice)
-;;
-;; This call by itself only changes the flag, to get the proper effect in
-;; the advised definition too one has to activate `foo' with
-;;
-;;    (ad-activate 'foo)
-;;
-;; or interactively. To disable whole sets of advices one can use a regular
-;; expression mechanism. For example, let us assume that ange-ftp actually
-;; used advice to overload all its functions, and that it used the
-;; "ange-ftp-" prefix for all its advice names, then we could temporarily
-;; disable all its advices with
-;;
-;;    (ad-disable-regexp "^ange-ftp-")
-;;
-;; and the following call would put that actually into effect:
-;;
-;;    (ad-activate-regexp "^ange-ftp-")
-;;
-;; A saver way would have been to use
-;;
-;;    (ad-update-regexp "^ange-ftp-")
-;;
-;; instead which would have only reactivated currently actively advised
-;; functions, but not functions that were currently deactivated. All these
-;; functions can also be called interactively.
-
-;; A certain piece of advice is considered a match if its name contains a
-;; match for the regular expression. To enable ange-ftp again we would use
-;; `ad-enable-regexp' and then activate or update again.
-
-;; @@ Forward advice, automatic advice activation:
-;; ===============================================
-;; Because most Emacs Lisp packages are loaded on demand via an autoload
-;; mechanism it is essential to be able to "forward advise" functions.
-;; Otherwise, proper advice definition and activation would make it necessary
-;; to preload every file that defines a certain function before it can be
-;; advised, which would partly defeat the purpose of the advice mechanism.
-
-;; In the following, "forward advice" always implies its automatic activation
-;; once a function gets defined, and not just the accumulation of advice
-;; information for a possibly undefined function.
-
-;; Advice implements forward advice mainly via the following: 1) Separation
-;; of advice definition and activation that makes it possible to accumulate
-;; advice information without having the original function already defined,
-;; 2) special versions of the built-in functions `fset/defalias' which check
-;; for advice information whenever they define a function. If advice
-;; information was found then the advice will immediately get activated when
-;; the function gets defined.
-
-;; Automatic advice activation means, that whenever a function gets defined
-;; with either `defun', `defmacro', `fset' or by loading a byte-compiled
-;; file, and the function has some advice-info stored with it then that
-;; advice will get activated right away.
-
-;; @@@ Enabling automatic advice activation:
-;; =========================================
-;; Automatic advice activation is enabled by default. It can be disabled by
-;; doint `M-x ad-stop-advice' and enabled again with `M-x ad-start-advice'.
-
-;; @@ Caching of advised definitions:
-;; ==================================
-;; After an advised definition got constructed it gets cached as part of the
-;; advised function's advice-info so it can be reused, for example, after an
-;; intermediate deactivation. Because the advice-info of a function might
-;; change between the time of caching and reuse a cached definition gets
-;; a cache-id associated with it so it can be verified whether the cached
-;; definition is still valid (the main application of this is preactivation
-;; - see below).
-
-;; When an advised function gets activated and a verifiable cached definition
-;; is available, then that definition will be used instead of creating a new
-;; advised definition from scratch. If you want to make sure that a new
-;; definition gets constructed then you should use `ad-clear-cache' before you
-;; activate the advised function.
-
-;; @@ Preactivation:
-;; =================
-;; Constructing an advised definition is moderately expensive. In a situation
-;; where one package defines a lot of advised functions it might be
-;; prohibitively expensive to do all the advised definition construction at
-;; runtime. Preactivation is a mechanism that allows compile-time construction
-;; of compiled advised definitions that can be activated cheaply during
-;; runtime. Preactivation uses the caching mechanism to do that. Here's how it
-;; works:
-
-;; When the byte-compiler compiles a `defadvice' that has the `preactivate'
-;; flag specified, it uses the current original definition of the advised
-;; function plus the advice specified in this `defadvice' (even if it is
-;; specified as disabled) and all other currently enabled pieces of advice to
-;; construct an advised definition and an identifying cache-id and makes them
-;; part of the `defadvice' expansion which will then be compiled by the
-;; byte-compiler (to ensure that in a v18 emacs you have to put the
-;; `defadvice' inside a `defun' to get it compiled and then you have to call
-;; that compiled `defun' in order to actually execute the `defadvice'). When
-;; the file with the compiled, preactivating `defadvice' gets loaded the
-;; precompiled advised definition will be cached on the advised function's
-;; advice-info. When it gets activated (can be immediately on execution of the
-;; `defadvice' or any time later) the cache-id gets checked against the
-;; current state of advice and if it is verified the precompiled definition
-;; will be used directly (the verification is pretty cheap). If it couldn't get
-;; verified a new advised definition for that function will be built from
-;; scratch, hence, the efficiency added by the preactivation mechanism does
-;; not at all impair the flexibility of the advice mechanism.
-
-;; MORAL: In order get all the efficiency out of preactivation the advice
-;;        state of an advised function at the time the file with the
-;;        preactivating `defadvice' gets byte-compiled should be exactly
-;;        the same as it will be when the advice of that function gets
-;;        actually activated. If it is not there is a high chance that the
-;;        cache-id will not match and hence a new advised definition will
-;;        have to be constructed at runtime.
-
-;; Preactivation and forward advice do not contradict each other. It is
-;; perfectly ok to load a file with a preactivating `defadvice' before the
-;; original definition of the advised function is available. The constructed
-;; advised definition will be used once the original function gets defined and
-;; its advice gets activated. The only constraint is that at the time the
-;; file with the preactivating `defadvice' got compiled the original function
-;; definition was available.
-
-;; TIPS: Here are some indications that a preactivation did not work the way
-;;       you intended it to work:
-;;       - Activation of the advised function takes longer than usual/expected
-;;       - The byte-compiler gets loaded while an advised function gets
-;;         activated
-;;       - `byte-compile' is part of the `features' variable even though you
-;;         did not use the byte-compiler
-;;       Right now advice does not provide an elegant way to find out whether
-;;       and why a preactivation failed. What you can do is to trace the
-;;       function `ad-cache-id-verification-code' (with the function
-;;       `trace-function-background' defined in my trace.el package) before
-;;       any of your advised functions get activated. After they got
-;;       activated check whether all calls to `ad-cache-id-verification-code'
-;;       returned `verified' as a result. Other values indicate why the
-;;       verification failed which should give you enough information to
-;;       fix your preactivation/compile/load/activation sequence.
-
-;; IMPORTANT: There is one case (that I am aware of) that can make 
-;; preactivation fail, i.e., a preconstructed advised definition that does
-;; NOT match the current state of advice gets used nevertheless. That case
-;; arises if one package defines a certain piece of advice which gets used
-;; during preactivation, and another package incompatibly redefines that 
-;; very advice (i.e., same function/class/name), and it is the second advice
-;; that is available when the preconstructed definition gets activated, and
-;; that was the only definition of that advice so far (`ad-add-advice' 
-;; catches advice redefinitions and clears the cache in such a case). 
-;; Catching that would make the cache verification too expensive.
-
-;; MORAL-II: Redefining somebody else's advice is BAAAAD (to speak with
-;; George Walker Bush), and why would you redefine your own advice anyway?
-;; Advice is a mechanism to facilitate function redefinition, not advice
-;; redefinition (wait until I write Meta-Advice :-). If you really have
-;; to undo somebody else's advice try to write a "neutralizing" advice.
-
-;; @@ Advising macros and special forms and other dangerous things:
-;; ================================================================
-;; Look at the corresponding tutorial sections for more information on
-;; these topics. Here it suffices to point out that the special treatment
-;; of macros and special forms by the byte-compiler can lead to problems
-;; when they get advised. Macros can create problems because they get
-;; expanded at compile time, hence, they might not have all the necessary
-;; runtime support and such advice cannot be de/activated or changed as
-;; it is possible for functions. Special forms create problems because they
-;; have to be advised "into" macros, i.e., an advised special form is a
-;; implemented as a macro, hence, in most cases the byte-compiler will
-;; not recognize it as a special form anymore which can lead to very strange
-;; results.
-;;
-;; MORAL: - Only advise macros or special forms when you are absolutely sure
-;;          what you are doing.
-;;        - As a safety measure, always do `ad-deactivate-all' before you
-;;          byte-compile a file to make sure that even if some inconsiderate
-;;          person advised some special forms you'll get proper compilation
-;;          results. After compilation do `ad-activate-all' to get back to
-;;          the previous state.
-
-;; @@ Adding a piece of advice with `ad-add-advice':
-;; =================================================
-;; The non-interactive function `ad-add-advice' can be used to add a piece of
-;; advice to some function without using `defadvice'. This is useful if advice
-;; has to be added somewhere by a function (also look at `ad-make-advice').
-
-;; @@ Activation/deactivation advices, file load hooks:
-;; ====================================================
-;; There are two special classes of advice called `activation' and
-;; `deactivation'. The body forms of these advices are not included into the
-;; advised definition of a function, rather they are assembled into a hook
-;; form which will be evaluated whenever the advice-info of the advised
-;; function gets activated or deactivated. One application of this mechanism
-;; is to define file load hooks for files that do not provide such hooks
-;; (v19s already come with a general file-load-hook mechanism, v18s don't).
-;; For example, suppose you want to print a message whenever `file-x' gets
-;; loaded, and suppose the last function defined in `file-x' is
-;; `file-x-last-fn'.  Then we can define the following advice:
-;;
-;;   (defadvice file-x-last-fn (activation file-x-load-hook)
-;;      "Executed whenever file-x is loaded"
-;;      (if load-in-progress (message "Loaded file-x")))
-;;
-;; This will constitute a forward advice for function `file-x-last-fn' which
-;; will get activated when `file-x' is loaded (only if forward advice is
-;; enabled of course). Because there are no "real" pieces of advice
-;; available for it, its definition will not be changed, but the activation
-;; advice will be run during its activation which is equivalent to having a
-;; file load hook for `file-x'.
-
-;; @@ Summary of main advice concepts:
-;; ===================================
-;; - Definition:
-;;     A piece of advice gets defined with `defadvice' and added to the
-;;     `advice-info' property of a function.
-;; - Enablement:
-;;     Every piece of advice has an enablement flag associated with it. Only
-;;     enabled advices are considered during construction of an advised
-;;     definition.
-;; - Activation:
-;;     Redefine an advised function with its advised definition. Constructs
-;;     an advised definition from scratch if no verifiable cached advised
-;;     definition is available and caches it.
-;; - Deactivation:
-;;     Back-define an advised function to its original definition.
-;; - Update:
-;;     Reactivate an advised function but only if its advice is currently 
-;;     active. This can be used to bring all currently advised function up
-;;     to date with the current state of advice without also activating
-;;     currently deactivated functions.
-;; - Caching:
-;;     Is the saving of an advised definition and an identifying cache-id so
-;;     it can be reused, for example, for activation after deactivation.
-;; - Preactivation:
-;;     Is the construction of an advised definition according to the current
-;;     state of advice during byte-compilation of a file with a preactivating
-;;     `defadvice'. That advised definition can then rather cheaply be used
-;;     during activation without having to construct an advised definition
-;;     from scratch at runtime.
-
-;; @@ Summary of interactive advice manipulation functions:
-;; ========================================================
-;; The following interactive functions can be used to manipulate the state
-;; of advised functions (all of them support completion on function names,
-;; advice classes and advice names):
-
-;; - ad-activate to activate the advice of a FUNCTION
-;; - ad-deactivate to deactivate the advice of a FUNCTION
-;; - ad-update   to activate the advice of a FUNCTION unless it was not
-;;               yet activated or is currently deactivated.
-;; - ad-unadvise deactivates a FUNCTION and removes all of its advice 
-;;               information, hence, it cannot be activated again
-;; - ad-recover  tries to redefine a FUNCTION to its original definition and
-;;               discards all advice information (a low-level `ad-unadvise').
-;;               Use only in emergencies.
-
-;; - ad-remove-advice removes a particular piece of advice of a FUNCTION.
-;;               You still have to do call `ad-activate' or `ad-update' to
-;;               activate the new state of advice.
-;; - ad-enable-advice enables a particular piece of advice of a FUNCTION.
-;; - ad-disable-advice disables a particular piece of advice of a FUNCTION.
-;; - ad-enable-regexp maps over all currently advised functions and enables
-;;               every advice whose name contains a match for a regular
-;;               expression.
-;; - ad-disable-regexp disables matching advices.
-
-;; - ad-activate-regexp   activates all advised function with a matching advice
-;; - ad-deactivate-regexp deactivates all advised function with matching advice
-;; - ad-update-regexp     updates all advised function with a matching advice
-;; - ad-activate-all      activates all advised functions
-;; - ad-deactivate-all    deactivates all advised functions
-;; - ad-update-all        updates all advised functions
-;; - ad-unadvise-all      unadvises all advised functions
-;; - ad-recover-all       recovers all advised functions
-
-;; - ad-compile byte-compiles a function/macro if it is compilable.
-
-;; @@ Summary of forms with special meanings when used within an advice:
-;; =====================================================================
-;;   ad-return-value   name of the return value variable (get/settable)
-;;   ad-subr-args      name of &rest argument variable used for advised
-;;                     subrs whose actual argument list cannot be
-;;                     determined (get/settable)
-;;   (ad-get-arg <pos>), (ad-get-args <pos>),
-;;   (ad-set-arg <pos> <value>), (ad-set-args <pos> <value-list>)
-;;                     argument access text macros to get/set the values of
-;;                     actual arguments at a certain position
-;;   ad-arg-bindings   text macro that returns the actual names, values
-;;                     and types of the arguments as a list of bindings. The
-;;                     order of the bindings corresponds to the order of the
-;;                     arguments. The individual fields of every binding (name,
-;;                     value and type) can be accessed with the function
-;;                     `ad-arg-binding-field' (see example above).
-;;   ad-do-it          text macro that identifies the place where the original
-;;                     or wrapped definition should go in an around advice
-
-
-;; @ Foo games: An advice tutorial
-;; ===============================
-;; The following tutorial was created in Emacs 18.59. Left-justified
-;; s-expressions are input forms followed by one or more result forms.
-;; First we have to start the advice magic:
-;;
-;; (ad-start-advice)
-;; nil
-;;
-;; We start by defining an innocent looking function `foo' that simply
-;; adds 1 to its argument X:
-;;  
-;; (defun foo (x)
-;;   "Add 1 to X."
-;;   (1+ x))
-;; foo
-;;
-;; (foo 3)
-;; 4
-;;
-;; @@ Defining a simple piece of advice:
-;; =====================================
-;; Now let's define the first piece of advice for `foo'.  To do that we
-;; use the macro `defadvice' which takes a function name, a list of advice
-;; specifiers and a list of body forms as arguments.  The first element of
-;; the advice specifiers is the class of the advice, the second is its name,
-;; the third its position and the rest are some flags. The class of our
-;; first advice is `before', its name is `fg-add2', its position among the
-;; currently defined before advices (none so far) is `first', and the advice
-;; will be `activate'ed immediately. Advice names are global symbols, hence,
-;; the name space conventions used for function names should be applied. All
-;; advice names in this tutorial will be prefixed with `fg' for `Foo Games'
-;; (because everybody has the right to be inconsistent all the function names
-;; used in this tutorial do NOT follow this convention).
-;;
-;; In the body of an advice we can refer to the argument variables of the
-;; original function by name. Here we add 1 to X so the effect of calling
-;; `foo' will be to actually add 2. All of the advice definitions below only
-;; have one body form for simplicity, but there is no restriction to that
-;; extent. Every piece of advice can have a documentation string which will
-;; be combined with the documentation of the original function.
-;;
-;; (defadvice foo (before fg-add2 first activate)
-;;   "Add 2 to X."
-;;   (setq x (1+ x)))
-;; foo
-;;
-;; (foo 3)
-;; 5
-;;
-;; @@ Specifying the position of an advice:
-;; ========================================
-;; Now we define the second before advice which will cancel the effect of
-;; the previous advice. This time we specify the position as 0 which is
-;; equivalent to `first'. A number can be used to specify the zero-based
-;; position of an advice among the list of advices in the same class. This
-;; time we already have one before advice hence the position specification
-;; actually has an effect. So, after the following definition the position
-;; of the previous advice will be 1 even though we specified it with `first'
-;; above, the reason for this is that the position argument is relative to
-;; the currently defined pieces of advice which by now has changed.
-;;
-;; (defadvice foo (before fg-cancel-add2 0 activate)
-;;   "Again only add 1 to X."
-;;   (setq x (1- x)))
-;; foo
-;;
-;; (foo 3)
-;; 4
-;;
-;; @@ Redefining a piece of advice:
-;; ================================
-;; Now we define an advice with the same class and same name but with a
-;; different position. Defining an advice in a class in which an advice with
-;; that name already exists is interpreted as a redefinition of that
-;; particular advice, in which case the position argument will be ignored
-;; and the previous position of the redefined piece of advice is used.
-;; Advice flags can be specified with non-ambiguous initial substrings, hence,
-;; from now on we'll use `act' instead of the verbose `activate'.
-;;
-;; (defadvice foo (before fg-cancel-add2 last act)
-;;   "Again only add 1 to X."
-;;   (setq x (1- x)))
-;; foo
-;;
-;; @@ Assembly of advised documentation:
-;; =====================================
-;; The documentation strings of the various pieces of advice are assembled
-;; in order which shows that advice `fg-cancel-add2' is still the first
-;; `before' advice even though we specified position `last' above:
-;;
-;; (documentation 'foo)
-;; "Add 1 to X.
-;;
-;; This function is advised with the following advice(s):
-;;
-;; fg-cancel-add2 (before):
-;; Again only add 1 to X.
-;;
-;; fg-add2 (before):
-;; Add 2 to X."
-;;
-;; @@ Advising interactive behavior:
-;; =================================
-;; We can make a function interactive (or change its interactive behavior)
-;; by specifying an interactive form in one of the before or around
-;; advices (there could also be body forms in this advice). The particular
-;; definition always assigns 5 as an argument to X which gives us 6 as a
-;; result when we call foo interactively:
-;;
-;; (defadvice foo (before fg-inter last act)
-;;   "Use 5 as argument when called interactively."
-;;   (interactive (list 5)))
-;; foo
-;;
-;; (call-interactively 'foo)
-;; 6
-;;
-;; If more than one advice have an interactive declaration, then the one of
-;; the advice with the smallest position will be used (before advices go
-;; before around and after advices), hence, the declaration below does
-;; not have any effect:
-;;
-;; (defadvice foo (before fg-inter2 last act)
-;;   (interactive (list 6)))
-;; foo
-;;
-;; (call-interactively 'foo)
-;; 6
-;;
-;; Let's have a look at what the definition of `foo' looks like now 
-;; (indentation added by hand for legibility):
-;;
-;; (symbol-function 'foo)
-;; (lambda (x)
-;;   "$ad-doc: foo$"
-;;   (interactive (list 5))
-;;   (let (ad-return-value) 
-;;     (setq x (1- x)) 
-;;     (setq x (1+ x)) 
-;;     (setq ad-return-value (ad-Orig-foo x)) 
-;;     ad-return-value))
-;;
-;; @@ Around advices:
-;; ==================
-;; Now we'll try some `around' advices. An around advice is a wrapper around
-;; the original definition. It can shadow or establish bindings for the
-;; original definition, and it can look at and manipulate the value returned
-;; by the original function. The position of the special keyword `ad-do-it'
-;; specifies where the code of the original function will be executed. The
-;; keyword can appear multiple times which will result in multiple calls of
-;; the original function in the resulting advised code. Note, that if we don't
-;; specify a position argument (i.e., `first', `last' or a number), then 
-;; `first' (or 0) is the default):
-;;
-;; (defadvice foo (around fg-times-2 act)
-;;   "First double X."
-;;   (let ((x (* x 2)))
-;;     ad-do-it))
-;; foo
-;;
-;; (foo 3)
-;; 7
-;;
-;; Around advices are assembled like onion skins where the around advice
-;; with position 0 is the outermost skin and the advice at the last position
-;; is the innermost skin which is directly wrapped around the call of the
-;; original definition of the function. Hence, after the next `defadvice' we
-;; will first multiply X by 2 then add 1 and then call the original
-;; definition (i.e., add 1 again):
-;;
-;; (defadvice foo (around fg-add-1 last act)
-;;   "Add 1 to X."
-;;   (let ((x (1+ x)))
-;;     ad-do-it))
-;; foo
-;;
-;; (foo 3)
-;; 8
-;;
-;; Again, let's see what the definition of `foo' looks like so far:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x) 
-;;   "$ad-doc: foo$"
-;;   (interactive (list 5)) 
-;;   (let (ad-return-value) 
-;;     (setq x (1- x)) 
-;;     (setq x (1+ x)) 
-;;     (let ((x (* x 2))) 
-;;       (let ((x (1+ x))) 
-;;         (setq ad-return-value (ad-Orig-foo x)))) 
-;;     ad-return-value))
-;;
-;; @@ Controlling advice activation:
-;; =================================
-;; In every `defadvice' so far we have used the flag `activate' to activate
-;; the advice immediately after its definition, and that's what we want in
-;; most cases. However, if we define multiple pieces of advice for a single
-;; function then activating every advice immediately is inefficient. A
-;; better way to do this is to only activate the last defined advice.
-;; For example:
-;;
-;; (defadvice foo (after fg-times-x)
-;;   "Multiply the result with X."
-;;   (setq ad-return-value (* ad-return-value x)))
-;; foo
-;;
-;; This still yields the same result as before:
-;; (foo 3)
-;; 8
-;;
-;; Now we define another advice and activate which will also activate the
-;; previous advice `fg-times-x'. Note the use of the special variable
-;; `ad-return-value' in the body of the advice which is set to the result of
-;; the original function. If we change its value then the value returned by
-;; the advised function will be changed accordingly:
-;;
-;; (defadvice foo (after fg-times-x-again act)
-;;   "Again multiply the result with X."
-;;   (setq ad-return-value (* ad-return-value x)))
-;; foo
-;;
-;; Now the advices have an effect:
-;;
-;; (foo 3)
-;; 72
-;;
-;; @@ Protecting advice execution:
-;; ===============================
-;; Once in a while we define an advice to perform some cleanup action, 
-;; for example:
-;;
-;; (defadvice foo (after fg-cleanup last act)
-;;   "Do some cleanup."
-;;   (print "Let's clean up now!"))
-;; foo
-;;
-;; However, in case of an error the cleanup won't be performed:
-;;
-;; (condition-case error
-;;     (foo t)
-;;   (error 'error-in-foo))
-;; error-in-foo
-;;
-;; To make sure a certain piece of advice gets executed even if some error or
-;; non-local exit occurred in any preceding code, we can protect it by using
-;; the `protect' keyword. (if any of the around advices is protected then the
-;; whole around advice onion will be protected):
-;;
-;; (defadvice foo (after fg-cleanup prot act)
-;;   "Do some protected cleanup."
-;;   (print "Let's clean up now!"))
-;; foo
-;;
-;; Now the cleanup form will be executed even in case of an error:
-;;
-;; (condition-case error
-;;     (foo t)
-;;   (error 'error-in-foo))
-;; "Let's clean up now!"
-;; error-in-foo
-;;
-;; Again, let's see what `foo' looks like:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x) 
-;;   "$ad-doc: foo$"
-;;   (interactive (list 5)) 
-;;   (let (ad-return-value) 
-;;     (unwind-protect 
-;;         (progn (setq x (1- x)) 
-;;                (setq x (1+ x)) 
-;;                (let ((x (* x 2))) 
-;;                  (let ((x (1+ x))) 
-;;                    (setq ad-return-value (ad-Orig-foo x)))) 
-;;                (setq ad-return-value (* ad-return-value x)) 
-;;                (setq ad-return-value (* ad-return-value x))) 
-;;       (print "Let's clean up now!")) 
-;;     ad-return-value))
-;;
-;; @@ Compilation of advised definitions:
-;; ======================================
-;; Finally, we can specify the `compile' keyword in a `defadvice' to say
-;; that we want the resulting advised function to be byte-compiled
-;; (`compile' will be ignored unless we also specified `activate'):
-;;
-;; (defadvice foo (after fg-cleanup prot act comp)
-;;   "Do some protected cleanup."
-;;   (print "Let's clean up now!"))
-;; foo
-;;
-;; Now `foo' is byte-compiled:
-;;
-;; (symbol-function 'foo)
-;; (lambda (x) 
-;;   "$ad-doc: foo$"
-;;   (interactive (byte-code "....." [5] 1)) 
-;;   (byte-code "....." [ad-return-value x nil ((byte-code "....." [print "Let's clean up now!"] 2)) * 2 ad-Orig-foo] 6))
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 72
-;;
-;; @@ Enabling and disabling pieces of advice:
-;; ===========================================
-;; Once in a while it is desirable to temporarily disable a piece of advice
-;; so that it won't be considered during activation, for example, if two
-;; different packages advise the same function and one wants to temporarily
-;; neutralize the effect of the advice of one of the packages.
-;;
-;; The following disables the after advice `fg-times-x' in the function `foo'.
-;; All that does is to change a flag for this particular advice. All the
-;; other information defining it will be left unchanged (e.g., its relative
-;; position in this advice class, etc.).
-;;
-;; (ad-disable-advice 'foo 'after 'fg-times-x)
-;; nil
-;;
-;; For this to have an effect we have to activate `foo':
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 24
-;;
-;; If we want to disable all multiplication advices in `foo' we can use a
-;; regular expression that matches the names of such advices. Actually, any
-;; advice name that contains a match for the regular expression will be
-;; called a match. A special advice class `any' can be used to consider
-;; all advice classes:
-;;
-;; (ad-disable-advice 'foo 'any "^fg-.*times")
-;; nil
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 5
-;;
-;; To enable the disabled advice we could use either `ad-enable-advice'
-;; similar to `ad-disable-advice', or as an alternative `ad-enable-regexp'
-;; which will enable matching advices in ALL currently advised functions.
-;; Hence, this can be used to dis/enable advices made by a particular
-;; package to a set of functions as long as that package obeys standard
-;; advice name conventions.  We prefixed all advice names with `fg-', hence
-;; the following will do the trick (`ad-enable-regexp' returns the number
-;; of matched advices):
-;;
-;; (ad-enable-regexp "^fg-")
-;; 9
-;;
-;; The following will activate all currently active advised functions that
-;; contain some advice matched by the regular expression. This is a save
-;; way to update the activation of advised functions whose advice changed
-;; in some way or other without accidentally also activating currently
-;; deactivated functions:
-;;
-;; (ad-update-regexp "^fg-")
-;; nil
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 72
-;;
-;; Another use for the dis/enablement mechanism is to define a piece of advice
-;; and keep it "dormant" until a particular condition is satisfied, i.e., until
-;; then the advice will not be used during activation. The `disable' flag lets
-;; one do that with `defadvice':
-;;
-;; (defadvice foo (before fg-1-more dis)
-;;   "Add yet 1 more."
-;;   (setq x (1+ x)))
-;; foo
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 72
-;;
-;; (ad-enable-advice 'foo 'before 'fg-1-more)
-;; nil
-;;
-;; (ad-activate 'foo)
-;; foo
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 160
-;;
-;; @@ Caching:
-;; ===========
-;; Advised definitions get cached to allow efficient activation/deactivation
-;; without having to reconstruct them if nothing in the advice-info of a
-;; function has changed. The following idiom can be used to temporarily
-;; deactivate functions that have a piece of advice defined by a certain
-;; package (we save the old definition to check out caching):
-;;
-;; (setq old-definition (symbol-function 'foo))
-;; (lambda (x) ....)
-;;
-;; (ad-deactivate-regexp "^fg-")
-;; nil
-;;
-;; (foo 3)
-;; 4
-;;
-;; (ad-activate-regexp "^fg-")
-;; nil
-;;
-;; (eq old-definition (symbol-function 'foo))
-;; t
-;;
-;; (foo 3)
-;; "Let's clean up now!"
-;; 160
-;;
-;; @@ Forward advice:
-;; ==================
-;; To enable automatic activation of forward advice we first have to set
-;; `ad-activate-on-definition' to t and restart advice:
-;;
-;; (setq ad-activate-on-definition t)
-;; t
-;;
-;; (ad-start-advice)
-;; (ad-activate-defined-function)
-;;
-;; Let's define a piece of advice for an undefined function:
-;;
-;; (defadvice bar (before fg-sub-1-more act)
-;;   "Subtract one more from X."
-;;   (setq x (1- x)))
-;; bar
-;;
-;; `bar' is not yet defined:
-;; (fboundp 'bar)
-;; nil
-;;
-;; Now we define it and the forward advice will get activated (only because
-;; `ad-activate-on-definition' was t when we started advice above with
-;; `ad-start-advice'):
-;;
-;; (defun bar (x)
-;;   "Subtract 1 from X."
-;;   (1- x))
-;; bar
-;;
-;; (bar 4)
-;; 2
-;;
-;; Redefinition will activate any available advice if the value of
-;; `ad-redefinition-action' is either `warn', `accept' or `discard':
-;;
-;; (defun bar (x)
-;;   "Subtract 2 from X."
-;;   (- x 2))
-;; bar
-;;
-;; (bar 4)
-;; 1
-;;
-;; @@ Preactivation:
-;; =================
-;; Constructing advised definitions is moderately expensive, hence, it is
-;; desirable to have a way to construct them at byte-compile time.
-;; Preactivation is a mechanism that allows one to do that.
-;;
-;; (defun fie (x)
-;;   "Multiply X by 2."
-;;   (* x 2))
-;; fie
-;;
-;; (defadvice fie (before fg-times-4 preact)
-;;   "Multiply X by 4."
-;;   (setq x (* x 2)))
-;; fie
-;;
-;; This advice did not affect `fie'...
-;;
-;; (fie 2)
-;; 4
-;;
-;; ...but it constructed a cached definition that will be used once `fie' gets
-;; activated as long as its current advice state is the same as it was during
-;; preactivation:
-;;
-;; (setq cached-definition (ad-get-cache-definition 'fie))
-;; (lambda (x) ....)
-;;
-;; (ad-activate 'fie)
-;; fie
-;;
-;; (eq cached-definition (symbol-function 'fie))
-;; t
-;;
-;; (fie 2)
-;; 8
-;;
-;; If you put a preactivating `defadvice' into a Lisp file that gets byte-
-;; compiled then the constructed advised definition will get compiled by
-;; the byte-compiler. For that to occur in a v18 emacs you have to put the
-;; `defadvice' inside a `defun' because the v18 compiler does not compile
-;; top-level forms other than `defun' or `defmacro', for example,
-;;
-;; (defun fg-defadvice-fum ()
-;;   (defadvice fum (before fg-times-4 preact act)
-;;     "Multiply X by 4."
-;;     (setq x (* x 2))))
-;; fg-defadvice-fum
-;;
-;; So far, no `defadvice' for `fum' got executed, but when we compile
-;; `fg-defadvice-fum' the `defadvice' will be expanded by the byte compiler.
-;; In order for preactivation to be effective we have to have a proper
-;; definition of `fum' around at preactivation time, hence, we define it now:
-;;
-;; (defun fum (x)
-;;   "Multiply X by 2."
-;;   (* x 2))
-;; fum
-;;
-;; Now we compile the defining function which will construct an advised
-;; definition during expansion of the `defadvice', compile it and store it
-;; as part of the compiled `fg-defadvice-fum':
-;;
-;; (ad-compile-function 'fg-defadvice-fum)
-;; (lambda nil (byte-code ...))
-;;
-;; `fum' is still completely unaffected:
-;;
-;; (fum 2)
-;; 4
-;;
-;; (ad-get-advice-info 'fum)
-;; nil
-;;
-;; (fg-defadvice-fum)
-;; fum
-;;
-;; Now the advised version of `fum' is compiled because the compiled definition
-;; constructed during preactivation was used, even though we did not specify
-;; the `compile' flag:
-;;
-;; (symbol-function 'fum)
-;; (lambda (x) 
-;;   "$ad-doc: fum$"
-;;   (byte-code "....." [ad-return-value x nil * 2 ad-Orig-fum] 4))
-;;
-;; (fum 2)
-;; 8
-;;
-;; A preactivated definition will only be used if it matches the current
-;; function definition and advice information. If it does not match it
-;; will simply be discarded and a new advised definition will be constructed
-;; from scratch. For example, let's first remove all advice-info for `fum':
-;;
-;; (ad-unadvise 'fum)
-;; (("fie") ("bar") ("foo") ...)
-;;
-;; And now define a new piece of advice:
-;;
-;; (defadvice fum (before fg-interactive act)
-;;   "Make fum interactive."
-;;   (interactive "nEnter x: "))
-;; fum
-;;
-;; When we now try to use a preactivation it will not be used because the
-;; current advice state is different from the one at preactivation time. This
-;; is no tragedy, everything will work as expected just not as efficient,
-;; because a new advised definition has to be constructed from scratch:
-;;
-;; (fg-defadvice-fum)
-;; fum
-;;
-;; A new uncompiled advised definition got constructed:
-;;
-;; (ad-compiled-p (symbol-function 'fum))
-;; nil
-;;
-;; (fum 2)
-;; 8
-;;
-;; MORAL: To get all the efficiency out of preactivation the function
-;; definition and advice state at preactivation time must be the same as the
-;; state at activation time. Preactivation does work with forward advice, all
-;; that's necessary is that the definition of the forward advised function is
-;; available when the `defadvice' with the preactivation gets compiled.
-;;
-;; @@ Portable argument access:
-;; ============================
-;; So far, we always used the actual argument variable names to access an
-;; argument in a piece of advice. For many advice applications this is
-;; perfectly ok and keeps advices simple. However, it decreases portability
-;; of advices because it assumes specific argument variable names. For example,
-;; if one advises a subr such as `eval-region' which then gets redefined by
-;; some package (e.g., edebug) into a function with different argument names,
-;; then a piece of advice written for `eval-region' that was written with
-;; the subr arguments in mind will break. Similar situations arise when one
-;; switches between major Emacs versions, e.g., certain subrs in v18 are
-;; functions in v19 and vice versa. Also, in v19s subr argument lists
-;; are available and will be used, while they are not available in v18.
-;;
-;; Argument access text macros allow one to access arguments of an advised
-;; function in a portable way without having to worry about all these
-;; possibilities. These macros will be translated into the proper access forms
-;; at activation time, hence, argument access will be as efficient as if
-;; the arguments had been used directly in the definition of the advice.
-;;
-;; (defun fuu (x y z)
-;;   "Add 3 numbers."
-;;   (+ x y z))
-;; fuu
-;;
-;; (fuu 1 1 1)
-;; 3
-;;
-;; Argument access macros specify actual arguments at a certain position.
-;; Position 0 access the first actual argument, position 1 the second etc.
-;; For example, the following advice adds 1 to each of the 3 arguments:
-;;
-;; (defadvice fuu (before fg-add-1-to-all act)
-;;   "Adds 1 to all arguments."
-;;   (ad-set-arg 0 (1+ (ad-get-arg 0)))
-;;   (ad-set-arg 1 (1+ (ad-get-arg 1)))
-;;   (ad-set-arg 2 (1+ (ad-get-arg 2))))
-;; fuu
-;;
-;; (fuu 1 1 1)
-;; 6
-;;
-;; Now suppose somebody redefines `fuu' with a rest argument. Our advice
-;; will still work because we used access macros (note, that automatic
-;; advice activation is still in effect, hence, the redefinition of `fuu'
-;; will automatically activate all its advice):
-;;
-;; (defun fuu (&rest numbers)
-;;   "Add NUMBERS."
-;;   (apply '+ numbers))
-;; fuu
-;;
-;; (fuu 1 1 1)
-;; 6
-;;
-;; (fuu 1 1 1 1 1 1)
-;; 9
-;;
-;; What's important to notice is that argument access macros access actual
-;; arguments regardless of how they got distributed onto argument variables.
-;; In Emacs Lisp the semantics of an actual argument is determined purely
-;; by position, hence, as long as nobody changes the semantics of what a
-;; certain actual argument at a certain position means the access macros
-;; will do the right thing.
-;;
-;; Because of &rest arguments we need a second kind of access macro that
-;; can access all actual arguments starting from a certain position:
-;;
-;; (defadvice fuu (before fg-print-args act)
-;;   "Print all arguments."
-;;   (print (ad-get-args 0)))
-;; fuu
-;;
-;; (fuu 1 2 3 4 5)
-;; (1 2 3 4 5)
-;; 18
-;;
-;; (defadvice fuu (before fg-set-args act)
-;;   "Swaps 2nd and 3rd arg and discards all the rest."
-;;   (ad-set-args 1 (list (ad-get-arg 2) (ad-get-arg 1))))
-;; fuu
-;;
-;; (fuu 1 2 3 4 4 4 4 4 4)
-;; (1 3 2)
-;; 9
-;;
-;; (defun fuu (x y z)
-;;   "Add 3 numbers."
-;;   (+ x y z))
-;;
-;; (fuu 1 2 3)
-;; (1 3 2)
-;; 9
-;;
-;; @@ Defining the argument list of an advised function:
-;; =====================================================
-;; Once in a while it might be desirable to advise a function and additionally
-;; give it an extra argument that controls the advised code, for example, one
-;; might want to make an interactive function sensitive to a prefix argument.
-;; For such cases `defadvice' allows the specification of an argument list
-;; for the advised function. Similar to the redefinition of interactive 
-;; behavior, the first argument list specification found in the list of before/
-;; around/after advices will be used. Of course, the specified argument list
-;; should be downward compatible with the original argument list, otherwise
-;; functions that call the advised function with the original argument list
-;; in mind will break.
-;;
-;; (defun fii (x)
-;;   "Add 1 to X."
-;;   (1+ x))
-;; fii
-;;
-;; Now we advise `fii' to use an optional second argument that controls the
-;; amount of incrementation. A list following the (optional) position
-;; argument of the advice will be interpreted as an argument list
-;; specification. This means you cannot specify an empty argument list, and
-;; why would you want to anyway?
-;;
-;; (defadvice fii (before fg-inc-x (x &optional incr) act)
-;;   "Increment X by INCR (default is 1)."
-;;   (setq x (+ x (1- (or incr 1)))))
-;; fii
-;;
-;; (fii 3)
-;; 4
-;;
-;; (fii 3 2)
-;; 5
-;;
-;; @@ Specifying argument lists of subrs:
-;; ======================================
-;; The argument lists of subrs cannot be determined directly from Lisp.
-;; This means that Advice has to use `(&rest ad-subr-args)' as the
-;; argument list of the advised subr which is not very efficient. In Lemacs
-;; subr argument lists can be determined from their documentation string, in
-;; Emacs-19 this is the case for some but not all subrs. To accommodate
-;; for the cases where the argument lists cannot be determined (e.g., in a
-;; v18 Emacs) Advice comes with a specification mechanism that allows the
-;; advice programmer to tell advice what the argument list of a certain subr
-;; really is.
-;;
-;; In a v18 Emacs the following will return the &rest idiom:
-;;
-;; (ad-arglist (symbol-function 'car))
-;; (&rest ad-subr-args)
-;;
-;; To tell advice what the argument list of `car' really is we
-;; can do the following:
-;;
-;; (ad-define-subr-args 'car '(list))
-;; ((list))
-;;
-;; Now `ad-arglist' will return the proper argument list (this method is
-;; actually used by advice itself for the advised definition of `fset'):
-;;
-;; (ad-arglist (symbol-function 'car))
-;; (list)
-;;
-;; The defined argument list will be stored on the property list of the
-;; subr name symbol. When advice looks for a subr argument list it first
-;; checks for a definition on the property list, if that fails it tries
-;; to infer it from the documentation string and caches it on the property
-;; list if it was successful, otherwise `(&rest ad-subr-args)' will be used.
-;;
-;; @@ Advising interactive subrs:
-;; ==============================
-;; For the most part there is no difference between advising functions and
-;; advising subrs. There is one situation though where one might have to write
-;; slightly different advice code for subrs than for functions. This case
-;; arises when one wants to access subr arguments in a before/around advice
-;; when the arguments were determined by an interactive call to the subr.
-;; Advice cannot determine what `interactive' form determines the interactive
-;; behavior of the subr, hence, when it calls the original definition in an
-;; interactive subr invocation it has to use `call-interactively' to generate
-;; the proper interactive behavior. Thus up to that call the arguments of the
-;; interactive subr will be nil. For example, the following advice for
-;; `kill-buffer' will not work in an interactive invocation...
-;;
-;; (defadvice kill-buffer (before fg-kill-buffer-hook first act preact comp)
-;;   (my-before-kill-buffer-hook (ad-get-arg 0)))
-;; kill-buffer
-;;
-;; ...because the buffer argument will be nil in that case. The way out of
-;; this dilemma is to provide an `interactive' specification that mirrors
-;; the interactive behavior of the unadvised subr, for example, the following
-;; will do the right thing even when `kill-buffer' is called interactively:
-;;
-;; (defadvice kill-buffer (before fg-kill-buffer-hook first act preact comp)
-;;   (interactive "bKill buffer: ")
-;;   (my-before-kill-buffer-hook (ad-get-arg 0)))
-;; kill-buffer
-;;
-;; @@ Advising macros:
-;; ===================
-;; Advising macros is slightly different because there are two significant
-;; time points in the invocation of a macro: Expansion and evaluation time.
-;; For an advised macro instead of evaluating the original definition we
-;; use `macroexpand', that is, changing argument values and binding
-;; environments by pieces of advice has an affect during macro expansion
-;; but not necessarily during evaluation. In particular, any side effects
-;; of pieces of advice will occur during macro expansion.  To also affect
-;; the behavior during evaluation time one has to change the value of
-;; `ad-return-value' in a piece of after advice. For example:
-;;
-;; (defmacro foom (x)
-;;   (` (list (, x))))
-;; foom
-;;
-;; (foom '(a))
-;; ((a))
-;;
-;; (defadvice foom (before fg-print-x act)
-;;   "Print the value of X."
-;;   (print x))
-;; foom
-;;
-;; The following works as expected because evaluation immediately follows
-;; macro expansion:
-;;
-;; (foom '(a))
-;; (quote (a))
-;; ((a))
-;;
-;; However, the printing happens during expansion (or byte-compile) time:
-;;
-;; (macroexpand '(foom '(a)))
-;; (quote (a))
-;; (list (quote (a)))
-;;
-;; If we want it to happen during evaluation time we have to do the 
-;; following (first remove the old advice):
-;;
-;; (ad-remove-advice 'foom 'before 'fg-print-x)
-;; nil
-;;
-;; (defadvice foom (after fg-print-x act)
-;;   "Print the value of X."
-;;   (setq ad-return-value
-;;         (` (progn (print (, x))
-;;                   (, ad-return-value)))))
-;; foom
-;;
-;; (macroexpand '(foom '(a)))
-;; (progn (print (quote (a))) (list (quote (a))))
-;;
-;; (foom '(a))
-;; (a)
-;; ((a))
-;;
-;; While this method might seem somewhat cumbersome, it is very general
-;; because it allows one to influence macro expansion as well as evaluation.
-;; In general, advising macros should be a rather rare activity anyway, in
-;; particular, because compile-time macro expansion takes away a lot of the
-;; flexibility and effectiveness of the advice mechanism. Macros that were
-;; compile-time expanded before the advice was activated will of course never
-;; exhibit the advised behavior.
-;;
-;; @@ Advising special forms:
-;; ==========================
-;; Now for something that should be even more rare than advising macros:
-;; Advising special forms. Because special forms are irregular in their
-;; argument evaluation behavior (e.g., `setq' evaluates the second but not
-;; the first argument) they have to be advised into macros. A dangerous
-;; consequence of this is that the byte-compiler will not recognize them
-;; as special forms anymore (well, in most cases) and use their expansion
-;; rather than the proper byte-code. Also, because the original definition
-;; of a special form cannot be `funcall'ed, `eval' has to be used instead
-;; which is less efficient.
-;;
-;; MORAL: Do not advise special forms unless you are completely sure about
-;;        what you are doing (some of the forward advice behavior is
-;;        implemented via advice of the special forms `defun' and `defmacro').
-;;        As a safety measure one should always do `ad-deactivate-all' before
-;;        one byte-compiles a file to avoid any interference of advised
-;;        special forms.
-;;
-;; Apart from the safety concerns advising special forms is not any different
-;; from advising plain functions or subrs.
-
-
-;;; Code:
-
-;; @ Advice implementation:
-;; ========================
-
-;; @@ Compilation idiosyncrasies:
-;; ==============================
-
-;; `defadvice' expansion needs quite a few advice functions and variables,
-;; hence, I need to preload the file before it can be compiled.  To avoid
-;; interference of bogus compiled files I always preload the source file:
-(provide 'advice-preload)
-;; During a normal load this is a noop:
-(require 'advice-preload "advice.el")
-
-
-(defmacro ad-lemacs-p ()
-  ;;Expands into Non-nil constant if we run Lucid's version of Emacs-19.
-  ;;Unselected conditional code will be optimized away during compilation.
-  (string-match "Lucid" emacs-version))
-
-
-;; @@ Variable definitions:
-;; ========================
-
-(defconst ad-version "2.14")
-
-;;;###autoload
-(defvar ad-redefinition-action 'warn
-  "*Defines what to do with redefinitions during Advice de/activation.
-Redefinition occurs if a previously activated function that already has an
-original definition associated with it gets redefined and then de/activated.
-In such a case we can either accept the current definition as the new
-original definition, discard the current definition and replace it with the
-old original, or keep it and raise an error.  The values `accept', `discard',
-`error' or `warn' govern what will be done.  `warn' is just like `accept' but
-it additionally prints a warning message.  All other values will be
-interpreted as `error'.")
-
-;;;###autoload
-(defvar ad-default-compilation-action 'maybe
-  "*Defines whether to compile advised definitions during activation.
-A value of `always' will result in unconditional compilation, `never' will
-always avoid compilation, `maybe' will compile if the byte-compiler is already
-loaded, and `like-original' will compile if the original definition of the
-advised function is compiled or a built-in function. Every other value will
-be interpreted as `maybe'. This variable will only be considered if the 
-COMPILE argument of `ad-activate' was supplied as nil.")
-
-
-;; @@ Some utilities:
-;; ==================
-
-;; We don't want the local arguments to interfere with anything
-;; referenced in the supplied functions => the cryptic casing:
-(defun ad-substitute-tree (sUbTrEe-TeSt fUnCtIoN tReE)
-  ;;"Substitutes qualifying subTREEs with result of FUNCTION(subTREE).
-  ;;Only proper subtrees are considered, for example, if TREE is (1 (2 (3)) 4)
-  ;;then the subtrees will be 1 (2 (3)) 2 (3) 3 4, dotted structures are
-  ;;allowed too.  Once a qualifying subtree has been found its subtrees will
-  ;;not be considered anymore.  (ad-substitute-tree 'atom 'identity tree)
-  ;;generates a copy of TREE."
-  (cond ((consp tReE)
-         (cons (if (funcall sUbTrEe-TeSt (car tReE))
-                   (funcall fUnCtIoN (car tReE))
-                 (if (consp (car tReE))
-                     (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (car tReE))
-                   (car tReE)))
-               (ad-substitute-tree sUbTrEe-TeSt fUnCtIoN (cdr tReE))))
-        ((funcall sUbTrEe-TeSt tReE)
-         (funcall fUnCtIoN tReE))
-        (t tReE)))
-
-;; this is just faster than `ad-substitute-tree':
-(defun ad-copy-tree (tree)
-  ;;"Returns a copy of the list structure of TREE."
-  (cond ((consp tree)
-	 (cons (ad-copy-tree (car tree))
-	       (ad-copy-tree (cdr tree))))
-	(t tree)))
-
-(defmacro ad-dolist (varform &rest body)
-  "A Common-Lisp-style dolist iterator with the following syntax:
-
-    (ad-dolist (VAR INIT-FORM [RESULT-FORM])
-       BODY-FORM...)
-
-which will iterate over the list yielded by INIT-FORM binding VAR to the
-current head at every iteration.  If RESULT-FORM is supplied its value will
-be returned at the end of the iteration, nil otherwise.  The iteration can be
-exited prematurely with `(ad-do-return [VALUE])'."
-  (let ((expansion
-         (` (let ((ad-dO-vAr (, (car (cdr varform))))
-		  (, (car varform)))
-	      (while ad-dO-vAr
-		(setq (, (car varform)) (car ad-dO-vAr))
-		(,@ body)
-		;;work around a backquote bug:
-		;;(` ((,@ '(foo)) (bar))) => (append '(foo) '(((bar)))) wrong
-		;;(` ((,@ '(foo)) (, '(bar)))) => (append '(foo) (list '(bar)))
-		(, '(setq ad-dO-vAr (cdr ad-dO-vAr))))
-	      (, (car (cdr (cdr varform))))))))
-    ;;ok, this wastes some cons cells but only during compilation:
-    (if (catch 'contains-return
-	  (ad-substitute-tree
-	   (function (lambda (subtree)
-		       (cond ((eq (car-safe subtree) 'ad-dolist))
-			     ((eq (car-safe subtree) 'ad-do-return)
-			      (throw 'contains-return t)))))
-	   'identity body)
-	  nil)
-	(` (catch 'ad-dO-eXiT (, expansion)))
-      expansion)))
-
-(defmacro ad-do-return (value)
-  (` (throw 'ad-dO-eXiT (, value))))
-
-(if (not (get 'ad-dolist 'lisp-indent-hook))
-    (put 'ad-dolist 'lisp-indent-hook 1))
-
-
-;; @@ Save real definitions of subrs used by Advice:
-;; =================================================
-;; Advice depends on the real, unmodified functionality of various subrs, 
-;; we save them here so advised versions will not interfere (eventually,
-;; we will save all subrs used in code generated by Advice):
-
-(defmacro ad-save-real-definition (function)
-  (let ((saved-function (intern (format "ad-real-%s" function))))
-    ;; Make sure the compiler is loaded during macro expansion:
-    (require 'byte-compile "bytecomp")
-    (` (if (not (fboundp '(, saved-function)))
-	   (progn (fset '(, saved-function) (symbol-function '(, function)))
-		  ;; Copy byte-compiler properties:
-		  (,@ (if (get function 'byte-compile)
-			  (` ((put '(, saved-function) 'byte-compile
-				   '(, (get function 'byte-compile)))))))
-		  (,@ (if (get function 'byte-opcode)
-			  (` ((put '(, saved-function) 'byte-opcode
-				   '(, (get function 'byte-opcode))))))))))))
-
-(defun ad-save-real-definitions ()
-  ;; Macro expansion will hardcode the values of the various byte-compiler
-  ;; properties into the compiled version of this function such that the
-  ;; proper values will be available at runtime without loading the compiler:
-  (ad-save-real-definition fset)
-  (ad-save-real-definition documentation))
-
-(ad-save-real-definitions)
-
-
-;; @@ Advice info access fns:
-;; ==========================
-
-;; Advice information for a particular function is stored on the
-;; advice-info property of the function symbol.  It is stored as an
-;; alist of the following format:
-;;
-;;      ((active . t/nil)
-;;       (before adv1 adv2 ...)
-;;       (around adv1 adv2 ...)
-;;       (after  adv1 adv2 ...)
-;;       (activation  adv1 adv2 ...)
-;;       (deactivation  adv1 adv2 ...)
-;;       (origname . <symbol fbound to origdef>)
-;;       (cache . (<advised-definition> . <id>)))
-
-;; List of currently advised though not necessarily activated functions
-;; (this list is maintained as a completion table):
-(defvar ad-advised-functions nil)
-
-(defmacro ad-pushnew-advised-function (function)
-  ;;"Add FUNCTION to `ad-advised-functions' unless its already there."
-  (` (if (not (assoc (symbol-name (, function)) ad-advised-functions))
-	 (setq ad-advised-functions
-	       (cons (list (symbol-name (, function)))
-		     ad-advised-functions)))))
-
-(defmacro ad-pop-advised-function (function)
-  ;;"Remove FUNCTION from `ad-advised-functions'."
-  (` (setq ad-advised-functions
-	   (delq (assoc (symbol-name (, function)) ad-advised-functions)
-		 ad-advised-functions))))
-
-(defmacro ad-do-advised-functions (varform &rest body)
-  ;;"`ad-dolist'-style iterator that maps over `ad-advised-functions'.
-  ;;     (ad-do-advised-functions (VAR [RESULT-FORM])
-  ;;         BODY-FORM...)
-  ;;Also see `ad-dolist'.  On each iteration VAR will be bound to the
-  ;;name of an advised function (a symbol)."
-  (` (ad-dolist ((, (car varform))
-		 ad-advised-functions
-		 (, (car (cdr varform))))
-       (setq (, (car varform)) (intern (car (, (car varform)))))
-       (,@ body))))
-
-(if (not (get 'ad-do-advised-functions 'lisp-indent-hook))
-    (put 'ad-do-advised-functions 'lisp-indent-hook 1))
-
-(defmacro ad-get-advice-info (function)
-  (` (get (, function) 'ad-advice-info)))
-
-(defmacro ad-set-advice-info (function advice-info)
-  (` (put (, function) 'ad-advice-info (, advice-info))))
-
-(defmacro ad-copy-advice-info (function)
-  (` (ad-copy-tree (get (, function) 'ad-advice-info))))
-
-(defmacro ad-is-advised (function)
-  ;;"Returns non-nil if FUNCTION has any advice info associated with it.
-  ;;This does not mean that the advice is also active."
-  (list 'ad-get-advice-info function))
-
-(defun ad-initialize-advice-info (function)
-  ;;"Initializes the advice info for FUNCTION.
-  ;;Assumes that FUNCTION has not yet been advised."
-  (ad-pushnew-advised-function function)
-  (ad-set-advice-info function (list (cons 'active nil))))
-
-(defmacro ad-get-advice-info-field (function field)
-  ;;"Retrieves the value of the advice info FIELD of FUNCTION."
-  (` (cdr (assq (, field) (ad-get-advice-info (, function))))))
-
-(defun ad-set-advice-info-field (function field value)
-  ;;"Destructively modifies VALUE of the advice info FIELD of FUNCTION."
-  (and (ad-is-advised function)
-       (cond ((assq field (ad-get-advice-info function))
-	      ;; A field with that name is already present:
-              (rplacd (assq field (ad-get-advice-info function)) value))
-	     (t;; otherwise, create a new field with that name:
-	      (nconc (ad-get-advice-info function)
-		     (list (cons field value)))))))
-
-;; Don't make this a macro so we can use it as a predicate:
-(defun ad-is-active (function)
-  ;;"non-nil if FUNCTION is advised and activated."
-  (ad-get-advice-info-field function 'active))
-
-
-;; @@ Access fns for single pieces of advice and related predicates:
-;; =================================================================
-
-(defun ad-make-advice (name protect enable definition)
-  "Constructs single piece of advice to be stored in some advice-info.
-NAME should be a non-nil symbol, PROTECT and ENABLE should each be
-either t or nil, and DEFINITION should be a list of the form
-`(advice lambda ARGLIST [DOCSTRING] [INTERACTIVE-FORM] BODY...)'."
-  (list name protect enable definition))
-
-;; ad-find-advice uses the alist structure directly ->
-;; change if this data structure changes!!
-(defmacro ad-advice-name (advice)
-  (list 'car advice))
-(defmacro ad-advice-protected (advice)
-  (list 'nth 1 advice))
-(defmacro ad-advice-enabled (advice)
-  (list 'nth 2 advice))
-(defmacro ad-advice-definition (advice)
-  (list 'nth 3 advice))
-
-(defun ad-advice-set-enabled (advice flag)
-  (rplaca (cdr (cdr advice)) flag))
-
-(defun ad-class-p (thing)
-  (memq thing ad-advice-classes))
-(defun ad-name-p (thing)
-  (and thing (symbolp thing)))
-(defun ad-position-p (thing)
-  (or (natnump thing)
-      (memq thing '(first last))))
-
-
-;; @@ Advice access functions:
-;; ===========================
-
-;; List of defined advice classes:
-(defvar ad-advice-classes '(before around after activation deactivation))
-
-(defun ad-has-enabled-advice (function class)
-  ;;"True if at least one of FUNCTION's advices in CLASS is enabled."
-  (ad-dolist (advice (ad-get-advice-info-field function class))
-    (if (ad-advice-enabled advice) (ad-do-return t))))
-
-(defun ad-has-redefining-advice (function)
-  ;;"True if FUNCTION's advice info defines at least 1 redefining advice.
-  ;;Redefining advices affect the construction of an advised definition."
-  (and (ad-is-advised function)
-       (or (ad-has-enabled-advice function 'before)
-	   (ad-has-enabled-advice function 'around)
-	   (ad-has-enabled-advice function 'after))))
-
-(defun ad-has-any-advice (function)
-  ;;"True if the advice info of FUNCTION defines at least one advice."
-  (and (ad-is-advised function)
-       (ad-dolist (class ad-advice-classes nil)
-	 (if (ad-get-advice-info-field function class)
-	     (ad-do-return t)))))
-
-(defun ad-get-enabled-advices (function class)
-  ;;"Returns the list of enabled advices of FUNCTION in CLASS."
-  (let (enabled-advices)
-    (ad-dolist (advice (ad-get-advice-info-field function class))
-      (if (ad-advice-enabled advice)
-	  (setq enabled-advices (cons advice enabled-advices))))
-    (reverse enabled-advices)))
-
-
-;; @@ Dealing with automatic advice activation via `fset/defalias':
-;; ================================================================
-
-;; Since Emacs 19.26 the built-in versions of `fset' and `defalias'
-;; take care of automatic advice activation, hence, we don't have to
-;; hack it anymore by advising `fset/defun/defmacro/byte-code/etc'.
-
-;; The functionality of the new `fset' is as follows:
-;;
-;;     fset(sym,newdef)
-;;       assign NEWDEF to SYM
-;;       if (get SYM 'ad-advice-info)
-;;          ad-activate(SYM, nil)
-;;       return (symbol-function SYM)
-;;
-;; Whether advised definitions created by automatic activations will be
-;; compiled depends on the value of `ad-default-compilation-action'.
-
-;; Since calling `ad-activate' in the built-in definition of `fset' can
-;; create major disasters we have to be a bit careful. One precaution is
-;; to provide a dummy definition for `ad-activate' which can be used to
-;; turn off automatic advice activation (e.g., when `ad-stop-advice' or
-;; `ad-recover-normality' are called). Another is to avoid recursive calls
-;; to `ad-activate-on' by using `ad-with-auto-activation-disabled' where
-;; appropriate, especially in a safe version of `fset'.
-
-;; For now define `ad-activate' to the dummy definition:
-(defun ad-activate (function &optional compile)
-  "Automatic advice activation is disabled. `ad-start-advice' enables it."
-  nil)
-
-;; This is just a copy of the above:
-(defun ad-activate-off (function &optional compile)
-  "Automatic advice activation is disabled. `ad-start-advice' enables it."
-  nil)
-
-;; This will be t for top-level calls to `ad-activate-on':
-(defvar ad-activate-on-top-level t)
-
-(defmacro ad-with-auto-activation-disabled (&rest body)
-  (` (let ((ad-activate-on-top-level nil))
-       (,@ body))))
-
-(defun ad-safe-fset (symbol definition)
-  ;; A safe `fset' which will never call `ad-activate' recursively.
-  (ad-with-auto-activation-disabled
-   (ad-real-fset symbol definition)))
-
-
-;; @@ Access functions for original definitions:
-;; ============================================
-;; The advice-info of an advised function contains its `origname' which is
-;; a symbol that is fbound to the original definition available at the first
-;; proper activation of the function after a legal re/definition.  If the
-;; original was defined via fcell indirection then `origname' will be defined
-;; just so.  Hence, to get hold of the actual original definition of a function
-;; we need to use `ad-real-orig-definition'.
-
-(defun ad-make-origname (function)
-  ;;"Makes name to be used to call the original FUNCTION."
-  (intern (format "ad-Orig-%s" function)))
-
-(defmacro ad-get-orig-definition (function)
-  (` (let ((origname (ad-get-advice-info-field (, function) 'origname)))
-       (if (fboundp origname)
-	   (symbol-function origname)))))
-
-(defmacro ad-set-orig-definition (function definition)
-  (` (ad-safe-fset
-      (ad-get-advice-info-field function 'origname) (, definition))))
-
-(defmacro ad-clear-orig-definition (function)
-  (` (fmakunbound (ad-get-advice-info-field (, function) 'origname))))
-
-
-;; @@ Interactive input functions:
-;; ===============================
-
-(defun ad-read-advised-function (&optional prompt predicate default)
-  ;;"Reads name of advised function with completion from the minibuffer.
-  ;;An optional PROMPT will be used to prompt for the function.  PREDICATE
-  ;;plays the same role as for `try-completion' (which see).  DEFAULT will
-  ;;be returned on empty input (defaults to the first advised function for
-  ;;which PREDICATE returns non-nil)."
-  (if (null ad-advised-functions)
-      (error "ad-read-advised-function: There are no advised functions"))
-  (setq default
-	(or default
-	    (ad-do-advised-functions (function)
-	      (if (or (null predicate)
-		      (funcall predicate function))
-		  (ad-do-return function)))
-	    (error "ad-read-advised-function: %s"
-		   "There are no qualifying advised functions")))
-  (let* ((ad-pReDiCaTe predicate)
-	 (function
-	  (completing-read
-	   (format "%s(default %s) " (or prompt "Function: ") default)
-	   ad-advised-functions
-	   (if predicate
-	       (function
-		(lambda (function)
-		  ;; Oops, no closures - the joys of dynamic scoping:
-		  ;; `predicate' clashed with the `predicate' argument
-		  ;; of Lemacs' `completing-read'.....
-		  (funcall ad-pReDiCaTe (intern (car function))))))
-	   t)))
-    (if (equal function "")
-	(if (ad-is-advised default)
-	    default
-	  (error "ad-read-advised-function: `%s' is not advised" default))
-      (intern function))))
-
-(defvar ad-advice-class-completion-table
-  (mapcar '(lambda (class) (list (symbol-name class)))
-	  ad-advice-classes))
-
-(defun ad-read-advice-class (function &optional prompt default)
-  ;;"Reads a legal advice class with completion from the minibuffer.
-  ;;An optional PROMPT will be used to prompt for the class.  DEFAULT will
-  ;;be returned on empty input (defaults to the first non-empty advice
-  ;;class of FUNCTION)."
-  (setq default
-	(or default
-	    (ad-dolist (class ad-advice-classes)
-	      (if (ad-get-advice-info-field function class)
-		  (ad-do-return class)))
-	    (error "ad-read-advice-class: `%s' has no advices" function)))
-  (let ((class (completing-read
-		(format "%s(default %s) " (or prompt "Class: ") default)
-		ad-advice-class-completion-table nil t)))
-    (if (equal class "")
-	default
-      (intern class))))
-
-(defun ad-read-advice-name (function class &optional prompt)
-  ;;"Reads name of existing advice of CLASS for FUNCTION with completion.
-  ;;An optional PROMPT is used to prompt for the name."
-  (let* ((name-completion-table
-          (mapcar (function (lambda (advice)
-			      (list (symbol-name (ad-advice-name advice)))))
-		  (ad-get-advice-info-field function class)))
-	 (default
-	   (if (null name-completion-table)
-	       (error "ad-read-advice-name: `%s' has no %s advice"
-		      function class)
-	     (car (car name-completion-table))))
-	 (prompt (format "%s(default %s) " (or prompt "Name: ") default))
-	 (name (completing-read prompt name-completion-table nil t)))
-    (if (equal name "")
-	(intern default)
-      (intern name))))
-
-(defun ad-read-advice-specification (&optional prompt)
-  ;;"Reads a complete function/class/name specification from minibuffer.
-  ;;The list of read symbols will be returned.  The optional PROMPT will
-  ;;be used to prompt for the function."
-  (let* ((function (ad-read-advised-function prompt))
-	 (class (ad-read-advice-class function))
-	 (name (ad-read-advice-name function class)))
-    (list function class name)))
-
-;; Use previous regexp as a default:
-(defvar ad-last-regexp "")
-
-(defun ad-read-regexp (&optional prompt)
-  ;;"Reads a regular expression from the minibuffer."
-  (let ((regexp (read-from-minibuffer
-		 (concat (or prompt "Regular expression: ")
-			 (if (equal ad-last-regexp "") ""
-			   (format "(default \"%s\") " ad-last-regexp))))))
-    (setq ad-last-regexp
-	  (if (equal regexp "") ad-last-regexp regexp))))
-
-
-;; @@ Finding, enabling, adding and removing pieces of advice:
-;; ===========================================================
-
-(defmacro ad-find-advice (function class name)
-  ;;"Finds the first advice of FUNCTION in CLASS with NAME."
-  (` (assq (, name) (ad-get-advice-info-field (, function) (, class)))))
-
-(defun ad-advice-position (function class name)
-  ;;"Returns position of first advice of FUNCTION in CLASS with NAME."
-  (let* ((found-advice (ad-find-advice function class name))
-	 (advices (ad-get-advice-info-field function class)))
-    (if found-advice
-	(- (length advices) (length (memq found-advice advices))))))
-
-(defun ad-find-some-advice (function class name)
-  "Finds the first of FUNCTION's advices in CLASS matching NAME.
-NAME can be a symbol or a regular expression matching part of an advice name.
-If CLASS is `any' all legal advice classes will be checked."
-  (if (ad-is-advised function)
-      (let (found-advice)
-	(ad-dolist (advice-class ad-advice-classes)
-	  (if (or (eq class 'any) (eq advice-class class))
-	      (setq found-advice
-		    (ad-dolist (advice (ad-get-advice-info-field
-					function advice-class))
-		      (if (or (and (stringp name)
-				   (string-match
-				    name (symbol-name
-					  (ad-advice-name advice))))
-			      (eq name (ad-advice-name advice)))
-			  (ad-do-return advice)))))
-	  (if found-advice (ad-do-return found-advice))))))
-
-(defun ad-enable-advice-internal (function class name flag)
-  ;;"Sets enable FLAG of FUNCTION's advices in CLASS matching NAME.
-  ;;If NAME is a string rather than a symbol then it's interpreted as a regular
-  ;;expression and all advices whose name contain a match for it will be 
-  ;;affected.  If CLASS is `any' advices in all legal advice classes will be 
-  ;;considered.  The number of changed advices will be returned (or nil if 
-  ;;FUNCTION was not advised)."
-  (if (ad-is-advised function)
-      (let ((matched-advices 0))
-	(ad-dolist (advice-class ad-advice-classes)
-	  (if (or (eq class 'any) (eq advice-class class))
-	      (ad-dolist (advice (ad-get-advice-info-field
-				  function advice-class))
-		(cond ((or (and (stringp name)
-				(string-match
-				 name (symbol-name (ad-advice-name advice))))
-			   (eq name (ad-advice-name advice)))
-		       (setq matched-advices (1+ matched-advices))
-		       (ad-advice-set-enabled advice flag))))))
-	matched-advices)))
-
-(defun ad-enable-advice (function class name)
-  "Enables the advice of FUNCTION with CLASS and NAME."
-  (interactive (ad-read-advice-specification "Enable advice of: "))
-  (if (ad-is-advised function)
-      (if (eq (ad-enable-advice-internal function class name t) 0)
-	  (error "ad-enable-advice: `%s' has no %s advice matching `%s'"
-		 function class name))
-    (error "ad-enable-advice: `%s' is not advised" function)))
-
-(defun ad-disable-advice (function class name)
-  "Disables the advice of FUNCTION with CLASS and NAME."
-  (interactive (ad-read-advice-specification "Disable advice of: "))
-  (if (ad-is-advised function)
-      (if (eq (ad-enable-advice-internal function class name nil) 0)
-	  (error "ad-disable-advice: `%s' has no %s advice matching `%s'"
-		 function class name))
-    (error "ad-disable-advice: `%s' is not advised" function)))
-
-(defun ad-enable-regexp-internal (regexp class flag)
-  ;;"Sets enable FLAGs of all CLASS advices whose name contains a REGEXP match.
-  ;;If CLASS is `any' all legal advice classes are considered.  The number of
-  ;;affected advices will be returned."
-  (let ((matched-advices 0))
-    (ad-do-advised-functions (advised-function)
-      (setq matched-advices
-	    (+ matched-advices
-	       (or (ad-enable-advice-internal
-		    advised-function class regexp flag)
-		   0))))
-    matched-advices))
-
-(defun ad-enable-regexp (regexp)
-  "Enables all advices with names that contain a match for REGEXP.
-All currently advised functions will be considered."
-  (interactive
-   (list (ad-read-regexp "Enable advices via regexp: ")))
-  (let ((matched-advices (ad-enable-regexp-internal regexp 'any t)))
-    (if (interactive-p)
-	(message "%d matching advices enabled" matched-advices))
-    matched-advices))
-
-(defun ad-disable-regexp (regexp)
-  "Disables all advices with names that contain a match for REGEXP.
-All currently advised functions will be considered."
-  (interactive
-   (list (ad-read-regexp "Disable advices via regexp: ")))
-  (let ((matched-advices (ad-enable-regexp-internal regexp 'any nil)))
-    (if (interactive-p)
-	(message "%d matching advices disabled" matched-advices))
-    matched-advices))
-
-(defun ad-remove-advice (function class name)
-  "Removes FUNCTION's advice with NAME from its advices in CLASS.
-If such an advice was found it will be removed from the list of advices
-in that CLASS."
-  (interactive (ad-read-advice-specification "Remove advice of: "))
-  (if (ad-is-advised function)
-      (let* ((advice-to-remove (ad-find-advice function class name)))
-	(if advice-to-remove
-	    (ad-set-advice-info-field
-	     function class
-	     (delq advice-to-remove (ad-get-advice-info-field function class)))
-	  (error "ad-remove-advice: `%s' has no %s advice `%s'"
-		 function class name)))
-    (error "ad-remove-advice: `%s' is not advised" function)))
-
-;;;###autoload
-(defun ad-add-advice (function advice class position)
-  "Adds a piece of ADVICE to FUNCTION's list of advices in CLASS.
-If FUNCTION already has one or more pieces of advice of the specified
-CLASS then POSITION determines where the new piece will go.  The value
-of POSITION can either be `first', `last' or a number where 0 corresponds
-to `first'.  Numbers outside the range will be mapped to the closest
-extreme position.  If there was already a piece of ADVICE with the same
-name, then the position argument will be ignored and the old advice
-will be overwritten with the new one.
-    If the FUNCTION was not advised already, then its advice info will be 
-initialized.  Redefining a piece of advice whose name is part of the cache-id
-will clear the cache."
-  (cond ((not (ad-is-advised function))
-         (ad-initialize-advice-info function)
-	 (ad-set-advice-info-field
-	  function 'origname (ad-make-origname function))))
-  (let* ((previous-position
-	  (ad-advice-position function class (ad-advice-name advice)))
-	 (advices (ad-get-advice-info-field function class))
-	 ;; Determine a numerical position for the new advice:
-	 (position (cond (previous-position)
-			 ((eq position 'first) 0)
-			 ((eq position 'last) (length advices))
-			 ((numberp position)
-			  (max 0 (min position (length advices))))
-			 (t 0))))
-    ;; Check whether we have to clear the cache:
-    (if (memq (ad-advice-name advice) (ad-get-cache-class-id function class))
-        (ad-clear-cache function))
-    (if previous-position
-	(setcar (nthcdr position advices) advice)
-      (if (= position 0)
-	  (ad-set-advice-info-field function class (cons advice advices))
-	(setcdr (nthcdr (1- position) advices)
-		(cons advice (nthcdr position advices)))))))
-
-
-;; @@ Accessing and manipulating function definitions:
-;; ===================================================
-
-(defmacro ad-macrofy (definition)
-  ;;"Takes a lambda function DEFINITION and makes a macro out of it."
-  (` (cons 'macro (, definition))))
-
-(defmacro ad-lambdafy (definition)
-  ;;"Takes a macro function DEFINITION and makes a lambda out of it."
-  (` (cdr (, definition))))
-
-;; There is no way to determine whether some subr is a special form or not,
-;; hence we need this list (which is probably out of date):
-(defvar ad-special-forms
-  (mapcar 'symbol-function
-	  '(and catch cond condition-case defconst defmacro
-			       defun defvar function if interactive let let*
-			       or prog1 prog2 progn quote save-excursion
-                               save-restriction save-window-excursion setq
-			       setq-default unwind-protect while
-			       with-output-to-temp-buffer)))
-
-(defmacro ad-special-form-p (definition)
-  ;;"non-nil if DEFINITION is a special form."
-  (list 'memq definition 'ad-special-forms))
-
-(defmacro ad-interactive-p (definition)
-  ;;"non-nil if DEFINITION can be called interactively."
-  (list 'commandp definition))
-
-(defmacro ad-subr-p (definition)
-  ;;"non-nil if DEFINITION is a subr."
-  (list 'subrp definition))
-
-(defmacro ad-macro-p (definition)
-  ;;"non-nil if DEFINITION is a macro."
-  (` (eq (car-safe (, definition)) 'macro)))
-
-(defmacro ad-lambda-p (definition)
-  ;;"non-nil if DEFINITION is a lambda expression."
-  (` (eq (car-safe (, definition)) 'lambda)))
-
-;; see ad-make-advice for the format of advice definitions:
-(defmacro ad-advice-p (definition)
-  ;;"non-nil if DEFINITION is a piece of advice."
-  (` (eq (car-safe (, definition)) 'advice)))
-
-;; Emacs/Lemacs cross-compatibility
-;; (compiled-function-p is an obsolete function in Emacs):
-(if (and (not (fboundp 'byte-code-function-p))
-	 (fboundp 'compiled-function-p))
-    (ad-safe-fset 'byte-code-function-p 'compiled-function-p))
-
-(defmacro ad-compiled-p (definition)
-  ;;"non-nil if DEFINITION is a compiled byte-code object."
-  (` (or (byte-code-function-p (, definition))
-	 (and (ad-macro-p (, definition))
-	      (byte-code-function-p (ad-lambdafy (, definition)))))))
-
-(defmacro ad-compiled-code (compiled-definition)
-  ;;"Returns the byte-code object of a COMPILED-DEFINITION."
-  (` (if (ad-macro-p (, compiled-definition))
-	 (ad-lambdafy (, compiled-definition))
-       (, compiled-definition))))
-
-(defun ad-lambda-expression (definition)
-  ;;"Returns the lambda expression of a function/macro/advice DEFINITION."
-  (cond ((ad-lambda-p definition)
-	 definition)
-	((ad-macro-p definition)
-	 (ad-lambdafy definition))
-	((ad-advice-p definition)
-	 (cdr definition))
-	(t nil)))
-
-(defun ad-arglist (definition &optional name)
-  ;;"Returns the argument list of DEFINITION.
-  ;;If DEFINITION could be from a subr then its NAME should be
-  ;;supplied to make subr arglist lookup more efficient."
-  (cond ((ad-compiled-p definition)
-	 (aref (ad-compiled-code definition) 0))
-	((consp definition)
-	 (car (cdr (ad-lambda-expression definition))))
-	((ad-subr-p definition)
-	 (if name
-	     (ad-subr-arglist name)
-	   ;; otherwise get it from its printed representation:
-	   (setq name (format "%s" definition))
-	   (string-match "^#<subr \\([^>]+\\)>$" name)
-	   (ad-subr-arglist
-	    (intern (substring name (match-beginning 1) (match-end 1))))))))
-
-;; Store subr-args as `((arg1 arg2 ...))' so I can distinguish
-;; a defined empty arglist `(nil)' from an undefined arglist:
-(defmacro ad-define-subr-args (subr arglist)
-  (` (put (, subr) 'ad-subr-arglist (list (, arglist)))))
-(defmacro ad-undefine-subr-args (subr)
-  (` (put (, subr) 'ad-subr-arglist nil)))
-(defmacro ad-subr-args-defined-p (subr)
-  (` (get (, subr) 'ad-subr-arglist)))
-(defmacro ad-get-subr-args (subr)
-  (` (car (get (, subr) 'ad-subr-arglist))))
-
-(defun ad-subr-arglist (subr-name)
-  ;;"Retrieve arglist of the subr with SUBR-NAME.
-  ;;Either use the one stored under the `ad-subr-arglist' property,
-  ;;or try to retrieve it from the docstring and cache it under
-  ;;that property, or otherwise use `(&rest ad-subr-args)'."
-  (cond ((ad-subr-args-defined-p subr-name)
-	 (ad-get-subr-args subr-name))
-	;; says jwz: Should use this for Lemacs 19.8 and above:
-	;;((fboundp 'subr-min-args)
-	;;  ...)
-	;; says hans: I guess what Jamie means is that I should use the values
-	;; of `subr-min-args' and `subr-max-args' to construct the subr arglist
-	;; without having to look it up via parsing the docstring, e.g.,
-	;; values 1 and 2 would suggest `(arg1 &optional arg2)' as an
-	;; argument list.  However, that won't work because there is no
-	;; way to distinguish a subr with args `(a &optional b &rest c)' from
-	;; one with args `(a &rest c)' using that mechanism. Also, the argument
-	;; names from the docstring are more meaningful. Hence, I'll stick with
-	;; the old way of doing things.
-	(t (let ((doc (or (ad-real-documentation subr-name t) "")))
-	     (cond ((string-match "^\\(([^\)]+)\\)\n?\\'" doc)
-		    (ad-define-subr-args
-		     subr-name
-		     (cdr (car (read-from-string
-				(downcase
-				 (substring doc
-					    (match-beginning 1)
-					    (match-end 1)))))))
-		    (ad-get-subr-args subr-name))
-		   ;; this is the old format used before Emacs 19.24:
-		   ((string-match
-		     "[\n\t ]*\narguments: ?\\((.*)\\)\n?\\'" doc)
-		    (ad-define-subr-args
-		     subr-name
-		     (car (read-from-string
-			   doc (match-beginning 1) (match-end 1))))
-		    (ad-get-subr-args subr-name))
-		   (t '(&rest ad-subr-args)))))))
-
-(defun ad-docstring (definition)
-  ;;"Returns the unexpanded docstring of DEFINITION."
-  (let ((docstring
-	 (if (ad-compiled-p definition)
-	     (ad-real-documentation definition t)
-	   (car (cdr (cdr (ad-lambda-expression definition)))))))
-    (if (or (stringp docstring)
-	    (natnump docstring))
-	docstring)))
-
-(defun ad-interactive-form (definition)
-  ;;"Returns the interactive form of DEFINITION."
-  (cond ((ad-compiled-p definition)
-	 (and (commandp definition)
-	      (list 'interactive (aref (ad-compiled-code definition) 5))))
-	((or (ad-advice-p definition)
-	     (ad-lambda-p definition))
-	 (commandp (ad-lambda-expression definition)))))
-
-(defun ad-body-forms (definition)
-  ;;"Returns the list of body forms of DEFINITION."
-  (cond ((ad-compiled-p definition)
-	 nil)
-	((consp definition)
-	 (nthcdr (+ (if (ad-docstring definition) 1 0)
-		    (if (ad-interactive-form definition) 1 0))
-		 (cdr (cdr (ad-lambda-expression definition)))))))
-
-;; Matches the docstring of an advised definition.
-;; The first group of the regexp matches the function name:
-(defvar ad-advised-definition-docstring-regexp "^\\$ad-doc: \\(.+\\)\\$$")
-
-(defun ad-make-advised-definition-docstring (function)
-  ;; Makes an identifying docstring for the advised definition of FUNCTION.
-  ;; Put function name into the documentation string so we can infer
-  ;; the name of the advised function from the docstring.  This is needed
-  ;; to generate a proper advised docstring even if we are just given a
-  ;; definition (also see the defadvice for `documentation'):
-  (format "$ad-doc: %s$" (prin1-to-string function)))
-
-(defun ad-advised-definition-p (definition)
-  ;;"non-nil if DEFINITION was generated from advice information."
-  (if (or (ad-lambda-p definition)
-	  (ad-macro-p definition)
-	  (ad-compiled-p definition))
-      (let ((docstring (ad-docstring definition)))
-	(and (stringp docstring)
-	     (string-match
-	      ad-advised-definition-docstring-regexp docstring)))))
-
-(defun ad-definition-type (definition)
-  ;;"Returns symbol that describes the type of DEFINITION."
-  (if (ad-macro-p definition)
-      'macro
-    (if (ad-subr-p definition)
-	(if (ad-special-form-p definition)
-	    'special-form
-	  'subr)
-      (if (or (ad-lambda-p definition)
-	      (ad-compiled-p definition))
-	  'function
-	(if (ad-advice-p definition)
-	    'advice)))))
-
-(defun ad-has-proper-definition (function)
-  ;;"True if FUNCTION is a symbol with a proper definition.
-  ;;For that it has to be fbound with a non-autoload definition."
-  (and (symbolp function)
-       (fboundp function)
-       (not (eq (car-safe (symbol-function function)) 'autoload))))
-
-;; The following two are necessary for the sake of packages such as
-;; ange-ftp which redefine functions via fcell indirection:
-(defun ad-real-definition (function)
-  ;;"Finds FUNCTION's definition at the end of function cell indirection."
-  (if (ad-has-proper-definition function)
-      (let ((definition (symbol-function function)))
-	(if (symbolp definition)
-	    (ad-real-definition definition)
-	  definition))))
-
-(defun ad-real-orig-definition (function)
-  ;;"Finds FUNCTION's real original definition starting from its `origname'."
-  (if (ad-is-advised function)
-      (ad-real-definition (ad-get-advice-info-field function 'origname))))
-
-(defun ad-is-compilable (function)
-  ;;"True if FUNCTION has an interpreted definition that can be compiled."
-  (and (ad-has-proper-definition function)
-       (or (ad-lambda-p (symbol-function function))
-	   (ad-macro-p (symbol-function function)))
-       (not (ad-compiled-p (symbol-function function)))))
-
-(defun ad-compile-function (function)
-  "Byte-compiles FUNCTION (or macro) if it is not yet compiled."
-  (interactive "aByte-compile function: ")
-  (if (ad-is-compilable function)
-      ;; Need to turn off auto-activation
-      ;; because `byte-compile' uses `fset':
-      (ad-with-auto-activation-disabled
-       (byte-compile function))))
-
-
-;; @@ Constructing advised definitions:
-;; ====================================
-;;
-;; Main design decisions about the form of advised definitions:
-;;
-;; A) How will original definitions be called?
-;; B) What will argument lists of advised functions look like?
-;;
-;; Ad A)
-;;    I chose to use function indirection for all four types of original
-;;    definitions (functions, macros, subrs and special forms), i.e., create
-;;    a unique symbol `ad-Orig-<name>' which is fbound to the original
-;;    definition and call it according to type and arguments.  Functions and
-;;    subrs that don't have any &rest arguments can be called directly in a
-;;    `(ad-Orig-<name> ....)' form.  If they have a &rest argument we have to
-;;    use `apply'.  Macros will be called with 
-;;    `(macroexpand '(ad-Orig-<name> ....))', and special forms also need a
-;;    form like that with `eval' instead of `macroexpand'.
-;;
-;; Ad B)
-;;    Use original arguments where possible and `(&rest ad-subr-args)'
-;;    otherwise, even though this seems to be more complicated and less
-;;    uniform than a general `(&rest args)' approach.  My reason to still
-;;    do it that way is that in most cases my approach leads to the more
-;;    efficient form for the advised function, and portability (e.g., to
-;;    make the same advice work regardless of whether something is a
-;;    function or a subr) can still be achieved with argument access macros.
-
-
-(defun ad-prognify (forms)
-  (cond ((<= (length forms) 1)
-	 (car forms))
-	(t (cons 'progn forms))))
-
-;; @@@ Accessing argument lists:
-;; =============================
-
-(defun ad-parse-arglist (arglist)
-  ;;"Parses ARGLIST into its required, optional and rest parameters.
-  ;;A three-element list is returned, where the 1st element is the list of
-  ;;required arguments, the 2nd is the list of optional arguments, and the 3rd
-  ;;is the name of an optional rest parameter (or nil)."
-  (let* (required optional rest)
-    (setq rest (car (cdr (memq '&rest arglist))))
-    (if rest (setq arglist (reverse (cdr (memq '&rest (reverse arglist))))))
-    (setq optional (cdr (memq '&optional arglist)))
-    (if optional
-	(setq required (reverse (cdr (memq '&optional (reverse arglist)))))
-      (setq required arglist))
-    (list required optional rest)))
-
-(defun ad-retrieve-args-form (arglist)
-  ;;"Generates a form which evaluates into names/values/types of ARGLIST.
-  ;;When the form gets evaluated within a function with that argument list
-  ;;it will result in a list with one entry for each argument, where the
-  ;;first element of each entry is the name of the argument, the second
-  ;;element is its actual current value, and the third element is either
-  ;;`required', `optional' or `rest' depending on the type of the argument."
-  (let* ((parsed-arglist (ad-parse-arglist arglist))
-	 (rest (nth 2 parsed-arglist)))
-    (` (list
-	(,@ (mapcar (function
-		     (lambda (req)
-		       (` (list '(, req) (, req) 'required))))
-		    (nth 0 parsed-arglist)))
-	(,@ (mapcar (function
-		     (lambda (opt)
-		       (` (list '(, opt) (, opt) 'optional))))
-		    (nth 1 parsed-arglist)))
-	(,@ (if rest (list (` (list '(, rest) (, rest) 'rest)))))
-	))))
-
-(defun ad-arg-binding-field (binding field)
-  (cond ((eq field 'name) (car binding))
-	((eq field 'value) (car (cdr binding)))
-	((eq field 'type) (car (cdr (cdr binding))))))
-
-(defun ad-list-access (position list)
-  (cond ((= position 0) list)
-	((= position 1) (list 'cdr list))
-	(t (list 'nthcdr position list))))
-
-(defun ad-element-access (position list)
-  (cond ((= position 0) (list 'car list))
-	((= position 1) (` (car (cdr (, list)))))
-	(t (list 'nth position list))))
-
-(defun ad-access-argument (arglist index)
-  ;;"Tells how to access ARGLIST's actual argument at position INDEX.
-  ;;For a required/optional arg it simply returns it, if a rest argument has
-  ;;to be accessed, it returns a list with the index and name."
-  (let* ((parsed-arglist (ad-parse-arglist arglist))
-	 (reqopt-args (append (nth 0 parsed-arglist)
-			      (nth 1 parsed-arglist)))
-	 (rest-arg (nth 2 parsed-arglist)))
-    (cond ((< index (length reqopt-args))
-	   (nth index reqopt-args))
-	  (rest-arg
-	   (list (- index (length reqopt-args)) rest-arg)))))
-
-(defun ad-get-argument (arglist index)
-  ;;"Returns form to access ARGLIST's actual argument at position INDEX."
-  (let ((argument-access (ad-access-argument arglist index)))
-    (cond ((consp argument-access)
-	   (ad-element-access
-	    (car argument-access) (car (cdr argument-access))))
-	  (argument-access))))
-
-(defun ad-set-argument (arglist index value-form)
-  ;;"Returns form to set ARGLIST's actual arg at INDEX to VALUE-FORM."
-  (let ((argument-access (ad-access-argument arglist index)))
-    (cond ((consp argument-access)
-	   ;; should this check whether there actually is something to set?
-	   (` (setcar (, (ad-list-access
-			  (car argument-access) (car (cdr argument-access))))
-		      (, value-form))))
-	  (argument-access
-	   (` (setq (, argument-access) (, value-form))))
-	  (t (error "ad-set-argument: No argument at position %d of `%s'"
-		    index arglist)))))
-
-(defun ad-get-arguments (arglist index)
-  ;;"Returns form to access all actual arguments starting at position INDEX."
-  (let* ((parsed-arglist (ad-parse-arglist arglist))
-	 (reqopt-args (append (nth 0 parsed-arglist)
-			      (nth 1 parsed-arglist)))
-	 (rest-arg (nth 2 parsed-arglist))
-	 args-form)
-    (if (< index (length reqopt-args))
-	(setq args-form (` (list (,@ (nthcdr index reqopt-args))))))
-    (if rest-arg
-	(if args-form
-	    (setq args-form (` (nconc (, args-form) (, rest-arg))))
-	  (setq args-form (ad-list-access (- index (length reqopt-args))
-					  rest-arg))))
-    args-form))
-
-(defun ad-set-arguments (arglist index values-form)
-  ;;"Makes form to assign elements of VALUES-FORM as actual ARGLIST args.
-  ;;The assignment starts at position INDEX."
-  (let ((values-index 0)
-	argument-access set-forms)
-    (while (setq argument-access (ad-access-argument arglist index))
-      (if (symbolp argument-access)
-	  (setq set-forms
-		(cons (ad-set-argument
-		       arglist index
-		       (ad-element-access values-index 'ad-vAlUeS))
-		      set-forms))
-	(setq set-forms
-	      (cons (if (= (car argument-access) 0)
-			(list 'setq
-			      (car (cdr argument-access))
-			      (ad-list-access values-index 'ad-vAlUeS))
-		      (list 'setcdr
-			    (ad-list-access (1- (car argument-access))
-					    (car (cdr argument-access)))
-			    (ad-list-access values-index 'ad-vAlUeS)))
-		    set-forms))
-	;; terminate loop
-	(setq arglist nil))
-      (setq index (1+ index))
-      (setq values-index (1+ values-index)))
-    (if (null set-forms)
-	(error "ad-set-arguments: No argument at position %d of `%s'"
-	       index arglist)
-      (if (= (length set-forms) 1)
-	  ;; For exactly one set-form we can use values-form directly,...
-	  (ad-substitute-tree
-	   (function (lambda (form) (eq form 'ad-vAlUeS)))
-	   (function (lambda (form) values-form))
-	   (car set-forms))
-	;; ...if we have more we have to bind it to a variable:
-	(` (let ((ad-vAlUeS (, values-form)))
-	     (,@ (reverse set-forms))
-	     ;; work around the old backquote bug:
-	     (, 'ad-vAlUeS)))))))
-
-(defun ad-insert-argument-access-forms (definition arglist)
-  ;;"Expands arg-access text macros in DEFINITION according to ARGLIST."
-  (ad-substitute-tree
-   (function
-    (lambda (form)
-      (or (eq form 'ad-arg-bindings)
-	  (and (memq (car-safe form)
-		     '(ad-get-arg ad-get-args ad-set-arg ad-set-args))
-	       (integerp (car-safe (cdr form)))))))
-   (function
-    (lambda (form)
-      (if (eq form 'ad-arg-bindings)
-	  (ad-retrieve-args-form arglist)
-	(let ((accessor (car form))
-	      (index (car (cdr form)))
-	      (val (car (cdr (ad-insert-argument-access-forms
-			      (cdr form) arglist)))))
-	  (cond ((eq accessor 'ad-get-arg)
-		 (ad-get-argument arglist index))
-		((eq accessor 'ad-set-arg)
-		 (ad-set-argument arglist index val))
-		((eq accessor 'ad-get-args)
-		 (ad-get-arguments arglist index))
-		((eq accessor 'ad-set-args)
-		 (ad-set-arguments arglist index val)))))))
-		   definition))
-
-;; @@@ Mapping argument lists:
-;; ===========================
-;; Here is the problem:
-;; Suppose function foo was called with (foo 1 2 3 4 5), and foo has the
-;; argument list (x y &rest z), and we want to call the function bar which
-;; has argument list (a &rest b) with a combination of x, y and z so that
-;; the effect is just as if we had called (bar 1 2 3 4 5) directly. 
-;; The mapping should work for any two argument lists.
-
-(defun ad-map-arglists (source-arglist target-arglist)
-  "Makes `funcall/apply' form to map SOURCE-ARGLIST to TARGET-ARGLIST.
-The arguments supplied to TARGET-ARGLIST will be taken from SOURCE-ARGLIST just
-as if they had been supplied to a function with TARGET-ARGLIST directly. 
-Excess source arguments will be neglected, missing source arguments will be 
-supplied as nil.  Returns a `funcall' or `apply' form with the second element
-being `function' which has to be replaced by an actual function argument.
-Example: `(ad-map-arglists '(a &rest args) '(w x y z))' will return
-         `(funcall function a (car args) (car (cdr args)) (nth 2 args))'."
-  (let* ((parsed-source-arglist (ad-parse-arglist source-arglist))
-	 (source-reqopt-args (append (nth 0 parsed-source-arglist)
-				     (nth 1 parsed-source-arglist)))
-	 (source-rest-arg (nth 2 parsed-source-arglist))
-	 (parsed-target-arglist (ad-parse-arglist target-arglist))
-	 (target-reqopt-args (append (nth 0 parsed-target-arglist)
-				     (nth 1 parsed-target-arglist)))
-	 (target-rest-arg (nth 2 parsed-target-arglist))
-	 (need-apply (and source-rest-arg target-rest-arg))
-	 (target-arg-index -1))
-    ;; This produces ``error-proof'' target function calls with the exception
-    ;; of a case like (&rest a) mapped onto (x &rest y) where the actual args
-    ;; supplied to A might not be enough to supply the required target arg X
-    (append (list (if need-apply 'apply 'funcall) 'function)
-	    (cond (need-apply
-		   ;; `apply' can take care of that directly:
-		   (append source-reqopt-args (list source-rest-arg)))
-		  (t (mapcar (function
-			      (lambda (arg)
-				(setq target-arg-index (1+ target-arg-index))
-				(ad-get-argument
-				 source-arglist target-arg-index)))
-			     (append target-reqopt-args
-				     (and target-rest-arg
-					  ;; If we have a rest arg gobble up
-					  ;; remaining source args:
-					  (nthcdr (length target-reqopt-args)
-						  source-reqopt-args)))))))))
-
-(defun ad-make-mapped-call (source-arglist target-arglist target-function)
-  ;;"Makes form to call TARGET-FUNCTION with args from SOURCE-ARGLIST."
-  (let* ((mapped-form (ad-map-arglists source-arglist target-arglist)))
-    (if (eq (car mapped-form) 'funcall)
-	(cons target-function (cdr (cdr mapped-form)))
-      (prog1 mapped-form
-	(setcar (cdr mapped-form) (list 'quote target-function))))))
-
-;; @@@ Making an advised documentation string:
-;; ===========================================
-;; New policy: The documentation string for an advised function will be built
-;; at the time the advised `documentation' function is called.  This has the
-;; following advantages:
-;;   1) command-key substitutions will automatically be correct
-;;   2) No wasted string space due to big advised docstrings in caches or
-;;      compiled files that contain preactivations
-;; The overall overhead for this should be negligible because people normally
-;; don't lookup documentation for the same function over and over again.
-
-(defun ad-make-single-advice-docstring (advice class &optional style)
-  (let ((advice-docstring (ad-docstring (ad-advice-definition advice))))
-    (cond ((eq style 'plain)
-	   advice-docstring)
-	  ((eq style 'freeze)
-	   (format "Permanent %s-advice `%s':%s%s"
-		   class (ad-advice-name advice)
-		   (if advice-docstring "\n" "")
-		   (or advice-docstring "")))
-	  (t (format "%s-advice `%s':%s%s"
-		     (capitalize (symbol-name class)) (ad-advice-name advice)
-		     (if advice-docstring "\n" "")
-		     (or advice-docstring ""))))))
-
-(defun ad-make-advised-docstring (function &optional style)
-  ;;"Constructs a documentation string for the advised FUNCTION.
-  ;;It concatenates the original documentation with the documentation
-  ;;strings of the individual pieces of advice which will be formatted
-  ;;according to STYLE.  STYLE can be `plain' or `freeze', everything else
-  ;;will be interpreted as `default'.  The order of the advice documentation
-  ;;strings corresponds to before/around/after and the individual ordering
-  ;;in any of these classes."
-  (let* ((origdef (ad-real-orig-definition function))
-	 (origtype (symbol-name (ad-definition-type origdef)))
-	 (origdoc
-	  ;; Retrieve raw doc, key substitution will be taken care of later:
-	  (ad-real-documentation origdef t))
-	 paragraphs advice-docstring)
-    (if origdoc (setq paragraphs (list origdoc)))
-    (if (not (eq style 'plain))
-	(setq paragraphs (cons (concat "This " origtype " is advised.")
-			       paragraphs)))
-    (ad-dolist (class ad-advice-classes)
-      (ad-dolist (advice (ad-get-enabled-advices function class))
-	(setq advice-docstring
-	      (ad-make-single-advice-docstring advice class style))
-	(if advice-docstring
-	    (setq paragraphs (cons advice-docstring paragraphs)))))
-    (if paragraphs
-	;; separate paragraphs with blank lines:
-	(mapconcat 'identity (nreverse paragraphs) "\n\n"))))
-
-(defun ad-make-plain-docstring (function)
-  (ad-make-advised-docstring function 'plain))
-(defun ad-make-freeze-docstring (function)
-  (ad-make-advised-docstring function 'freeze))
-
-;; @@@ Accessing overriding arglists and interactive forms:
-;; ========================================================
-
-(defun ad-advised-arglist (function)
-  ;;"Finds first defined arglist in FUNCTION's redefining advices."
-  (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
-			     (ad-get-enabled-advices function 'around)
-			     (ad-get-enabled-advices function 'after)))
-    (let ((arglist (ad-arglist (ad-advice-definition advice))))
-      (if arglist
-	  ;; We found the first one, use it:
-	  (ad-do-return arglist)))))
-
-(defun ad-advised-interactive-form (function)
-  ;;"Finds first interactive form in FUNCTION's redefining advices."
-  (ad-dolist (advice (append (ad-get-enabled-advices function 'before)
-			     (ad-get-enabled-advices function 'around)
-			     (ad-get-enabled-advices function 'after)))
-    (let ((interactive-form
-	   (ad-interactive-form (ad-advice-definition advice))))
-      (if interactive-form
-	  ;; We found the first one, use it:
-	  (ad-do-return interactive-form)))))
-
-;; @@@ Putting it all together:
-;; ============================
-
-(defun ad-make-advised-definition (function)
-  ;;"Generates an advised definition of FUNCTION from its advice info."
-  (if (and (ad-is-advised function)
-	   (ad-has-redefining-advice function))
-      (let* ((origdef (ad-real-orig-definition function))
-	     (origname (ad-get-advice-info-field function 'origname))
-	     (orig-interactive-p (ad-interactive-p origdef))
-	     (orig-subr-p (ad-subr-p origdef))
-	     (orig-special-form-p (ad-special-form-p origdef))
-	     (orig-macro-p (ad-macro-p origdef))
-	     ;; Construct the individual pieces that we need for assembly:
-	     (orig-arglist (ad-arglist origdef function))
-	     (advised-arglist (or (ad-advised-arglist function)
-				  orig-arglist))
-	     (advised-interactive-form (ad-advised-interactive-form function))
-	     (interactive-form
-	      (cond (orig-macro-p nil)
-		    (advised-interactive-form)
-		    ((ad-interactive-form origdef))
-		    ;; Otherwise we must have a subr: make it interactive if
-		    ;; we have to and initialize required arguments in case
-		    ;; it is called interactively:
-		    (orig-interactive-p
-		     (let ((reqargs (car (ad-parse-arglist advised-arglist))))
-		       (if reqargs
-			   (` (interactive
-			       '(, (make-list (length reqargs) nil))))
-			   '(interactive))))))
-	     (orig-form
-	      (cond ((or orig-special-form-p orig-macro-p)
-		     ;; Special forms and macros will be advised into macros.
-                     ;; The trick is to construct an expansion for the advised
-		     ;; macro that does the correct thing when it gets eval'ed.
-		     ;; For macros we'll just use the expansion of the original
-		     ;; macro and return that. This way compiled advised macros
-		     ;; will be expanded into something useful. Note that after
-		     ;; advices have full control over whether they want to
-		     ;; evaluate the expansion (the value of `ad-return-value')
-		     ;; at macro expansion time or not. For special forms there
-		     ;; is no solution that interacts reasonably with the
-		     ;; compiler, hence we just evaluate the original at macro
-		     ;; expansion time and return the result. The moral of that
-		     ;; is that one should always deactivate advised special
-		     ;; forms before one byte-compiles a file.
-		     (` ((, (if orig-macro-p
-				'macroexpand
-			      'eval))
-			 (cons '(, origname)
-			       (, (ad-get-arguments advised-arglist 0))))))
-		    ((and orig-subr-p
-			  orig-interactive-p
-			  (not advised-interactive-form))
-		     ;; Check whether we were called interactively
-		     ;; in order to do proper prompting:
-		     (` (if (interactive-p)
-			    (call-interactively '(, origname))
-			  (, (ad-make-mapped-call
-			      orig-arglist advised-arglist origname)))))
-		    ;; And now for normal functions and non-interactive subrs
-	            ;; (or subrs whose interactive behavior was advised):
-		    (t (ad-make-mapped-call
-			advised-arglist orig-arglist origname)))))
-
-	;; Finally, build the sucker:
-	(ad-assemble-advised-definition
-	 (cond (orig-macro-p 'macro)
-	       (orig-special-form-p 'special-form)
-	       (t 'function))
-	 advised-arglist
-         (ad-make-advised-definition-docstring function)
-	 interactive-form
-	 orig-form
-	 (ad-get-enabled-advices function 'before)
-	 (ad-get-enabled-advices function 'around)
-	 (ad-get-enabled-advices function 'after)))))
-
-(defun ad-assemble-advised-definition
-  (type args docstring interactive orig &optional befores arounds afters)
-
-  ;;"Assembles an original and its advices into an advised function.
-  ;;It constructs a function or macro definition according to TYPE which has to
-  ;;be either `macro', `function' or `special-form'.  ARGS is the argument list
-  ;;that has to be used, DOCSTRING if non-nil defines the documentation of the
-  ;;definition, INTERACTIVE if non-nil is the interactive form to be used,
-  ;;ORIG is a form that calls the body of the original unadvised function,
-  ;;and BEFORES, AROUNDS and AFTERS are the lists of advices with which ORIG
-  ;;should be modified.  The assembled function will be returned."
-
-  (let (before-forms around-form around-form-protected after-forms definition)
-    (ad-dolist (advice befores)
-      (cond ((and (ad-advice-protected advice)
-		  before-forms)
-	     (setq before-forms
-		   (` ((unwind-protect
-			   (, (ad-prognify before-forms))
-			 (,@ (ad-body-forms
-			      (ad-advice-definition advice))))))))
-	    (t (setq before-forms
-		     (append before-forms
-			     (ad-body-forms (ad-advice-definition advice)))))))
-
-    (setq around-form (` (setq ad-return-value (, orig))))
-    (ad-dolist (advice (reverse arounds))
-      ;; If any of the around advices is protected then we
-      ;; protect the complete around advice onion:
-      (if (ad-advice-protected advice)
-	  (setq around-form-protected t))
-      (setq around-form
-	    (ad-substitute-tree
-	     (function (lambda (form) (eq form 'ad-do-it)))
-	     (function (lambda (form) around-form))
-	     (ad-prognify (ad-body-forms (ad-advice-definition advice))))))
-
-    (setq after-forms
-	  (if (and around-form-protected before-forms)
-	      (` ((unwind-protect
-		      (, (ad-prognify before-forms))
-		    (, around-form))))
-	    (append before-forms (list around-form))))
-    (ad-dolist (advice afters)
-      (cond ((and (ad-advice-protected advice)
-		  after-forms)
-	     (setq after-forms
-		   (` ((unwind-protect
-			   (, (ad-prognify after-forms))
-			 (,@ (ad-body-forms
-			      (ad-advice-definition advice))))))))
-	    (t (setq after-forms
-		     (append after-forms
-			     (ad-body-forms (ad-advice-definition advice)))))))
-
-    (setq definition
-	  (` ((,@ (if (memq type '(macro special-form)) '(macro)))
-	      lambda
-	      (, args)
-	      (,@ (if docstring (list docstring)))
-	      (,@ (if interactive (list interactive)))
-	      (let (ad-return-value)
-		(,@ after-forms)
-		(, (if (eq type 'special-form)
-		       '(list 'quote ad-return-value)
-		     'ad-return-value))))))
-
-    (ad-insert-argument-access-forms definition args)))
-
-;; This is needed for activation/deactivation hooks:
-(defun ad-make-hook-form (function hook-name)
-  ;;"Makes hook-form from FUNCTION's advice bodies in class HOOK-NAME."
-  (let ((hook-forms
-	 (mapcar (function (lambda (advice)
-			     (ad-body-forms (ad-advice-definition advice))))
-		 (ad-get-enabled-advices function hook-name))))
-    (if hook-forms
-	(ad-prognify (apply 'append hook-forms)))))
-
-
-;; @@ Caching:
-;; ===========
-;; Generating an advised definition of a function is moderately expensive,
-;; hence, it makes sense to cache it so we can reuse it in appropriate
-;; circumstances.  Of course, it only makes sense to reuse a cached
-;; definition if the current advice and function definition state is the
-;; same as it was at the time when the cached definition was generated.
-;; For that purpose we associate every cache with an id so we can verify
-;; if it is still valid at a certain point in time.  This id mechanism
-;; makes it possible to preactivate advised functions, write the compiled
-;; advised definitions to a file and reuse them during the actual
-;; activation without having to risk that the resulting definition will be
-;; incorrect, well, almost.
-;;
-;; A cache id is a list with six elements:
-;; 1) the list of names of enabled before advices
-;; 2) the list of names of enabled around advices
-;; 3) the list of names of enabled after advices
-;; 4) the type of the original function (macro, subr, etc.)
-;; 5) the arglist of the original definition (or t if it was equal to the
-;;    arglist of the cached definition)
-;; 6) t if the interactive form of the original definition was equal to the
-;;    interactive form of the cached definition
-;;
-;; Here's how a cache can get invalidated or be incorrect:
-;; A) a piece of advice used in the cache gets redefined
-;; B) the current list of enabled advices is different from the ones used
-;;    for the cache
-;; C) the type of the original function changed, e.g., a function became a
-;;    macro, or a subr became a function
-;; D) the arglist of the original function changed
-;; E) the interactive form of the original function changed
-;; F) a piece of advice used in the cache got redefined before the
-;;    defadvice with the cached definition got loaded: This is a PROBLEM!
-;;
-;; Cases A and B are the normal ones.  A is taken care of by `ad-add-advice'
-;; which clears the cache in such a case, B is easily checked during
-;; verification at activation time.
-;;
-;; Cases C, D and E have to be considered if one is slightly paranoid, i.e.,
-;; if one considers the case that the original function could be different
-;; from the one available at caching time (e.g., for forward advice of
-;; functions that get redefined by some packages - such as `eval-region' gets
-;; redefined by edebug).  All these cases can be easily checked during
-;; verification.  Element 4 of the id lets one check case C, element 5 takes
-;; care of case D (using t in the equality case saves some space, because the
-;; arglist can be recovered at validation time from the cached definition),
-;; and element 6 takes care of case E which is only a problem if the original
-;; was actually a function whose interactive form was not overridden by a
-;; piece of advice.
-;;
-;; Case F is the only one which will lead to an incorrect advised function.
-;; There is no way to avoid this without storing the complete advice definition
-;; in the cache-id which is not feasible.
-;;
-;; The cache-id of a typical advised function with one piece of advice and
-;; no arglist redefinition takes 7 conses which is a small price to pay for
-;; the added efficiency.  The validation itself is also pretty cheap, certainly
-;; a lot cheaper than reconstructing an advised definition.
-
-(defmacro ad-get-cache-definition (function)
-  (` (car (ad-get-advice-info-field (, function) 'cache))))
-
-(defmacro ad-get-cache-id (function)
-  (` (cdr (ad-get-advice-info-field (, function) 'cache))))
-
-(defmacro ad-set-cache (function definition id)
-  (` (ad-set-advice-info-field
-      (, function) 'cache (cons (, definition) (, id)))))
-
-(defun ad-clear-cache (function)
-  "Clears a previously cached advised definition of FUNCTION.
-Clear the cache if you want to force `ad-activate' to construct a new
-advised definition from scratch."
-  (interactive
-   (list (ad-read-advised-function "Clear cached definition of: ")))
-  (ad-set-advice-info-field function 'cache nil))
-
-(defun ad-make-cache-id (function)
-  ;;"Generates an identifying image of the current advices of FUNCTION."
-  (let ((original-definition (ad-real-orig-definition function))
-	(cached-definition (ad-get-cache-definition function)))
-    (list (mapcar (function (lambda (advice) (ad-advice-name advice)))
-		  (ad-get-enabled-advices function 'before))
-	  (mapcar (function (lambda (advice) (ad-advice-name advice)))
-		  (ad-get-enabled-advices function 'around))
-	  (mapcar (function (lambda (advice) (ad-advice-name advice)))
-		  (ad-get-enabled-advices function 'after))
-	  (ad-definition-type original-definition)
-	  (if (equal (ad-arglist original-definition function)
-		     (ad-arglist cached-definition))
-	      t
-	    (ad-arglist original-definition function))
-	  (if (eq (ad-definition-type original-definition) 'function)
-	      (equal (ad-interactive-form original-definition)
-		     (ad-interactive-form cached-definition))))))
-
-(defun ad-get-cache-class-id (function class)
-  ;;"Returns the part of FUNCTION's cache id that identifies CLASS."
-  (let ((cache-id (ad-get-cache-id function)))
-    (if (eq class 'before)
-	(car cache-id)
-      (if (eq class 'around)
-	  (nth 1 cache-id)
-	(nth 2 cache-id)))))
-
-(defun ad-verify-cache-class-id (cache-class-id advices)
-  (ad-dolist (advice advices (null cache-class-id))
-    (if (ad-advice-enabled advice)
-	(if (eq (car cache-class-id) (ad-advice-name advice))
-	    (setq cache-class-id (cdr cache-class-id))
-	  (ad-do-return nil)))))
-
-;; There should be a way to monitor if and why a cache verification failed
-;; in order to determine whether a certain preactivation could be used or
-;; not.  Right now the only way to find out is to trace 
-;; `ad-cache-id-verification-code'.  The code it returns indicates where the
-;; verification failed.  Tracing `ad-verify-cache-class-id' might provide
-;; some additional useful information.
-
-(defun ad-cache-id-verification-code (function)
-  (let ((cache-id (ad-get-cache-id function))
-	(code 'before-advice-mismatch))
-    (and (ad-verify-cache-class-id
-	  (car cache-id) (ad-get-advice-info-field function 'before))
-	 (setq code 'around-advice-mismatch)
-	 (ad-verify-cache-class-id
-	  (nth 1 cache-id) (ad-get-advice-info-field function 'around))
-	 (setq code 'after-advice-mismatch)
-	 (ad-verify-cache-class-id
-	  (nth 2 cache-id) (ad-get-advice-info-field function 'after))
-	 (setq code 'definition-type-mismatch)
-	 (let ((original-definition (ad-real-orig-definition function))
-	       (cached-definition (ad-get-cache-definition function)))
-	   (and (eq (nth 3 cache-id) (ad-definition-type original-definition))
-		(setq code 'arglist-mismatch)
-		(equal (if (eq (nth 4 cache-id) t)
-			   (ad-arglist original-definition function)
-			 (nth 4 cache-id) )
-		       (ad-arglist cached-definition))
-		(setq code 'interactive-form-mismatch)
-		(or (null (nth 5 cache-id))
-		    (equal (ad-interactive-form original-definition)
-			   (ad-interactive-form cached-definition)))
-		(setq code 'verified))))
-    code))
-
-(defun ad-verify-cache-id (function)
-  ;;"True if FUNCTION's cache-id is compatible with its current advices."
-  (eq (ad-cache-id-verification-code function) 'verified))
-
-
-;; @@ Preactivation:
-;; =================
-;; Preactivation can be used to generate compiled advised definitions
-;; at compile time without having to give up the dynamic runtime flexibility
-;; of the advice mechanism.  Preactivation is a special feature of `defadvice',
-;; it involves the following steps:
-;;  - remembering the function's current state (definition and advice-info)
-;;  - advising it with the defined piece of advice
-;;  - clearing its cache
-;;  - generating an interpreted advised definition by activating it, this will
-;;    make use of all its current active advice and its current definition
-;;  - saving the so generated cached definition and id
-;;  - resetting the function's advice and definition state to what it was
-;;    before the preactivation
-;;  - Returning the saved definition and its id to be used in the expansion of
-;;    `defadvice' to assign it as an initial cache, hence it will be compiled
-;;    at time the `defadvice' gets compiled.
-;; Naturally, for preactivation to be effective it has to be applied/compiled
-;; at the right time, i.e., when the current state of advices and function
-;; definition exactly reflects the state at activation time.  Should that not
-;; be the case, the precompiled definition will just be discarded and a new
-;; advised definition will be generated.
-
-(defun ad-preactivate-advice (function advice class position)
-  ;;"Preactivates FUNCTION and returns the constructed cache."
-  (let* ((function-defined-p (fboundp function))
-	 (old-definition
-	  (if function-defined-p
-	      (symbol-function function)))
-	 (old-advice-info (ad-copy-advice-info function))
-	 (ad-advised-functions ad-advised-functions))
-    (unwind-protect
-	(progn
-	  (ad-add-advice function advice class position)
-	  (ad-enable-advice function class (ad-advice-name advice))
-	  (ad-clear-cache function)
-	  (ad-activate-on function -1)
-	  (if (and (ad-is-active function)
-	           (ad-get-cache-definition function))
-	      (list (ad-get-cache-definition function)
-		    (ad-get-cache-id function))))
-      (ad-set-advice-info function old-advice-info)
-      ;; Don't `fset' function to nil if it was previously unbound:
-      (if function-defined-p
-	  (ad-safe-fset function old-definition)
-	(fmakunbound function)))))
-
-
-;; @@ Freezing:
-;; ============
-;; Freezing transforms a `defadvice' into a redefining `defun/defmacro'
-;; for the advised function without keeping any advice information. This
-;; feature was jwz's idea: It generates a dumpable function definition
-;; whose documentation can be written to the DOC file, and the generated
-;; code does not need any Advice runtime support. Of course, frozen advices
-;; cannot be undone.
-
-;; Freezing only considers the advice of the particular `defadvice', other
-;; already existing advices for the same function will be ignored. To ensure
-;; proper interaction when an already advised function gets redefined with
-;; a frozen advice, frozen advices always use the actual original definition
-;; of the function, i.e., they are always at the core of the onion. E.g., if
-;; an already advised function gets redefined with a frozen advice and then
-;; unadvised, the frozen advice remains as the new definition of the function.
-
-;; While multiple freeze advices for a single function or freeze-advising
-;; of an already advised function are possible, they are better avoided,
-;; because definition/compile/load ordering is relevant, and it becomes
-;; incomprehensible pretty quickly.
-
-(defun ad-make-freeze-definition (function advice class position)
-  (if (not (ad-has-proper-definition function))
-      (error
-       "ad-make-freeze-definition: `%s' is not yet defined"
-       function))
-  (let* ((name (ad-advice-name advice))
-	 ;; With a unique origname we can have multiple freeze advices
-	 ;; for the same function, each overloading the previous one:
-	 (unique-origname
-	  (intern (format "%s-%s-%s" (ad-make-origname function) class name)))
-	 (orig-definition
-	  ;; If FUNCTION is already advised, we'll use its current origdef
-	  ;; as the original definition of the frozen advice:
-	  (or (ad-get-orig-definition function)
-	      (symbol-function function)))
-	 (old-advice-info
-	  (if (ad-is-advised function)
-	      (ad-copy-advice-info function)))
-	 (real-docstring-fn
-	  (symbol-function 'ad-make-advised-definition-docstring))
-	 (real-origname-fn
-	  (symbol-function 'ad-make-origname))
-	 (frozen-definition
-	  (unwind-protect
-	      (progn
-		;; Make sure we construct a proper docstring:
-		(ad-safe-fset 'ad-make-advised-definition-docstring
-			      'ad-make-freeze-docstring)
-		;; Make sure `unique-origname' is used as the origname:
-		(ad-safe-fset 'ad-make-origname '(lambda (x) unique-origname))
-		;; No we reset all current advice information to nil and
-		;; generate an advised definition that's solely determined
-		;; by ADVICE and the current origdef of FUNCTION:
-		(ad-set-advice-info function nil)
-		(ad-add-advice function advice class position)
-		;; The following will provide proper real docstrings as
-		;; well as a definition that will make the compiler happy:
-		(ad-set-orig-definition function orig-definition)
-		(ad-make-advised-definition function))
-	    ;; Restore the old advice state:
-	    (ad-set-advice-info function old-advice-info)
-	    ;; Restore functions:
-	    (ad-safe-fset
-	     'ad-make-advised-definition-docstring real-docstring-fn)
-	    (ad-safe-fset 'ad-make-origname real-origname-fn))))
-    (if frozen-definition
-	(let* ((macro-p (ad-macro-p frozen-definition))
-	       (body (cdr (if macro-p
-			      (ad-lambdafy frozen-definition)
-			    frozen-definition))))
-	  (` (progn
-	       (if (not (fboundp '(, unique-origname)))
-		   (fset '(, unique-origname)
-			 ;; avoid infinite recursion in case the function
-			 ;; we want to freeze is already advised:
-			 (or (ad-get-orig-definition '(, function))
-			     (symbol-function '(, function)))))
-	       ((, (if macro-p 'defmacro 'defun))
-		(, function)
-		(,@ body))))))))
-
-
-;; @@ Activation and definition handling:
-;; ======================================
-
-(defun ad-should-compile (function compile)
-  ;;"Returns non-nil if the advised FUNCTION should be compiled.
-  ;;If COMPILE is non-nil and not a negative number then it returns t.
-  ;;If COMPILE is a negative number then it returns nil.
-  ;;If COMPILE is nil then the result depends on the value of
-  ;;`ad-default-compilation-action' (which see)."
-  (if (integerp compile)
-      (>= compile 0)
-    (if compile
-	compile
-      (cond ((eq ad-default-compilation-action 'never)
-	     nil)
-	    ((eq ad-default-compilation-action 'always)
-	     t)
-	    ((eq ad-default-compilation-action 'like-original)
-	     (or (ad-subr-p (ad-get-orig-definition function))
-		 (ad-compiled-p (ad-get-orig-definition function))))
-	    ;; everything else means `maybe':
-	    (t (featurep 'byte-compile))))))
-
-(defun ad-activate-advised-definition (function compile)
-  ;;"Redefines FUNCTION with its advised definition from cache or scratch.
-  ;;The resulting FUNCTION will be compiled if `ad-should-compile' returns t.
-  ;;The current definition and its cache-id will be put into the cache."
-  (let ((verified-cached-definition
-	 (if (ad-verify-cache-id function)
-	     (ad-get-cache-definition function))))
-    (ad-safe-fset function
-		  (or verified-cached-definition
-		      (ad-make-advised-definition function)))
-    (if (ad-should-compile function compile)
-	(ad-compile-function function))
-    (if verified-cached-definition
-	(if (not (eq verified-cached-definition (symbol-function function)))
-	    ;; we must have compiled, cache the compiled definition:
-	    (ad-set-cache
-	     function (symbol-function function) (ad-get-cache-id function)))
-      ;; We created a new advised definition, cache it with a proper id:
-      (ad-clear-cache function)
-      ;; ad-make-cache-id needs the new cached definition:
-      (ad-set-cache function (symbol-function function) nil)
-      (ad-set-cache
-       function (symbol-function function) (ad-make-cache-id function)))))
-
-(defun ad-handle-definition (function)
-  "Handles re/definition of an advised FUNCTION during de/activation.
-If FUNCTION does not have an original definition associated with it and
-the current definition is usable, then it will be stored as FUNCTION's
-original definition.  If no current definition is available (even in the
-case of undefinition) nothing will be done.  In the case of redefinition
-the action taken depends on the value of `ad-redefinition-action' (which
-see).  Redefinition occurs when FUNCTION already has an original definition
-associated with it but got redefined with a new definition and then
-de/activated.  If you do not like the current redefinition action change
-the value of `ad-redefinition-action' and de/activate again."
-  (let ((original-definition (ad-get-orig-definition function))
-	(current-definition (if (ad-real-definition function)
-				(symbol-function function))))
-    (if original-definition
-	(if current-definition
-	    (if (and (not (eq current-definition original-definition))
-		     ;; Redefinition with an advised definition from a
-		     ;; different function won't count as such:
-		     (not (ad-advised-definition-p current-definition)))
-		;; we have a redefinition:
-		(if (not (memq ad-redefinition-action '(accept discard warn)))
-		    (error "ad-handle-definition (see its doc): `%s' %s"
-			   function "illegally redefined")
-		  (if (eq ad-redefinition-action 'discard)
-		      (ad-safe-fset function original-definition)
-		    (ad-set-orig-definition function current-definition)
-		    (if (eq ad-redefinition-action 'warn)
-			(message "ad-handle-definition: `%s' got redefined"
-				 function))))
-	      ;; either advised def or correct original is in place:
-	      nil)
-	  ;; we have an undefinition, ignore it:
-	  nil)
-      (if current-definition
-	  ;; we have a first definition, save it as original:
-	  (ad-set-orig-definition function current-definition)
-	;; we don't have anything noteworthy:
-	nil))))
-
-
-;; @@ The top-level advice interface:
-;; ==================================
-
-(defun ad-activate-on (function &optional compile)
-  "Activates all the advice information of an advised FUNCTION.
-If FUNCTION has a proper original definition then an advised
-definition will be generated from FUNCTION's advice info and the
-definition of FUNCTION will be replaced with it.  If a previously
-cached advised definition was available, it will be used.
-The optional COMPILE argument determines whether the resulting function
-or a compilable cached definition will be compiled.  If it is negative
-no compilation will be performed, if it is positive or otherwise non-nil
-the resulting function will be compiled, if it is nil the behavior depends
-on the value of `ad-default-compilation-action' (which see).
-Activation of an advised function that has an advice info but no actual
-pieces of advice is equivalent to a call to `ad-unadvise'.  Activation of
-an advised function that has actual pieces of advice but none of them are
-enabled is equivalent to a call to `ad-deactivate'.  The current advised
-definition will always be cached for later usage."
-  (interactive
-   (list (ad-read-advised-function "Activate advice of: ")
-	 current-prefix-arg))
-  (if ad-activate-on-top-level
-      ;; avoid recursive calls to `ad-activate-on':
-      (ad-with-auto-activation-disabled
-	(if (not (ad-is-advised function))
-	    (error "ad-activate: `%s' is not advised" function)
-	  (ad-handle-definition function)
-	  ;; Just return for forward advised and not yet defined functions:
-	  (if (ad-get-orig-definition function)
-	      (if (not (ad-has-any-advice function))
-		  (ad-unadvise function)
-		;; Otherwise activate the advice:
-		(cond ((ad-has-redefining-advice function)
-		       (ad-activate-advised-definition function compile)
-		       (ad-set-advice-info-field function 'active t)
-		       (eval (ad-make-hook-form function 'activation))
-		       function)
-		      ;; Here we are if we have all disabled advices:
-		      (t (ad-deactivate function)))))))))
-
-(defun ad-deactivate (function)
-  "Deactivates the advice of an actively advised FUNCTION.
-If FUNCTION has a proper original definition, then the current
-definition of FUNCTION will be replaced with it.  All the advice
-information will still be available so it can be activated again with
-a call to `ad-activate'."
-  (interactive
-   (list (ad-read-advised-function "Deactivate advice of: " 'ad-is-active)))
-  (if (not (ad-is-advised function))
-      (error "ad-deactivate: `%s' is not advised" function)
-    (cond ((ad-is-active function)
-	   (ad-handle-definition function)
-	   (if (not (ad-get-orig-definition function))
-	       (error "ad-deactivate: `%s' has no original definition"
-		      function)
-	     (ad-safe-fset function (ad-get-orig-definition function))
-	     (ad-set-advice-info-field function 'active nil)
-	     (eval (ad-make-hook-form function 'deactivation))
-	     function)))))
-
-(defun ad-update (function &optional compile)
-  "Update the advised definition of FUNCTION if its advice is active.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive
-   (list (ad-read-advised-function
-	  "Update advised definition of: " 'ad-is-active)))
-  (if (ad-is-active function)
-      (ad-activate-on function compile)))
-
-(defun ad-unadvise (function)
-  "Deactivates FUNCTION and then removes all its advice information. 
-If FUNCTION was not advised this will be a noop."
-  (interactive
-   (list (ad-read-advised-function "Unadvise function: ")))
-  (cond ((ad-is-advised function)
-	 (if (ad-is-active function)
-	     (ad-deactivate function))
-	 (ad-clear-orig-definition function)
-	 (ad-set-advice-info function nil)
-	 (ad-pop-advised-function function))))
-
-(defun ad-recover (function)
-  "Tries to recover FUNCTION's original definition and unadvises it.
-This is more low-level than `ad-unadvise' because it does not do any
-deactivation which might run hooks and get into other trouble.
-Use in emergencies."
-  ;; Use more primitive interactive behavior here: Accept any symbol that's
-  ;; currently defined in obarray, not necessarily with a function definition:
-  (interactive
-   (list (intern
-	  (completing-read "Recover advised function: " obarray nil t))))
-  (cond ((ad-is-advised function)
-	 (cond ((ad-get-orig-definition function)
-	        (ad-safe-fset function (ad-get-orig-definition function))
-		(ad-clear-orig-definition function)))
-	 (ad-set-advice-info function nil)
-	 (ad-pop-advised-function function))))
-
-(defun ad-activate-regexp (regexp &optional compile)
-  "Activates functions with an advice name containing a REGEXP match.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive
-   (list (ad-read-regexp "Activate via advice regexp: ")
-	 current-prefix-arg))
-  (ad-do-advised-functions (function)
-    (if (ad-find-some-advice function 'any regexp)
-	(ad-activate-on function compile))))
-
-(defun ad-deactivate-regexp (regexp)
-  "Deactivates functions with an advice name containing REGEXP match."
-  (interactive
-   (list (ad-read-regexp "Deactivate via advice regexp: ")))
-  (ad-do-advised-functions (function)
-    (if (ad-find-some-advice function 'any regexp)
-	(ad-deactivate function))))
-
-(defun ad-update-regexp (regexp &optional compile)
-  "Updates functions with an advice name containing a REGEXP match.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive
-   (list (ad-read-regexp "Update via advice regexp: ")
-	 current-prefix-arg))
-  (ad-do-advised-functions (function)
-    (if (ad-find-some-advice function 'any regexp)
-	(ad-update function compile))))
-
-(defun ad-activate-all (&optional compile)
-  "Activates all currently advised functions.
-See `ad-activate-on' for documentation on the optional COMPILE argument."
-  (interactive "P")
-  (ad-do-advised-functions (function)
-    (ad-activate-on function compile)))
-
-(defun ad-deactivate-all ()
-  "Deactivates all currently advised functions."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (ad-deactivate function)))
-
-(defun ad-update-all (&optional compile)
-  "Updates all currently advised functions.
-With prefix argument compiles resulting advised definitions."
-  (interactive "P")
-  (ad-do-advised-functions (function)
-    (ad-update function compile)))
-
-(defun ad-unadvise-all ()
-  "Unadvises all currently advised functions."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (ad-unadvise function)))
-
-(defun ad-recover-all ()
-  "Recovers all currently advised functions.  Use in emergencies."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (condition-case nil
-	(ad-recover function)
-      (error nil))))
-
-
-;; Completion alist of legal `defadvice' flags
-(defvar ad-defadvice-flags
-  '(("protect") ("disable") ("activate")
-    ("compile") ("preactivate") ("freeze")))
-
-;;;###autoload
-(defmacro defadvice (function args &rest body)
-  "Defines a piece of advice for FUNCTION (a symbol).
-The syntax of `defadvice' is as follows:
-
-  (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...)
-    [DOCSTRING] [INTERACTIVE-FORM]
-    BODY... )
-
-FUNCTION ::= Name of the function to be advised.
-CLASS ::= `before' | `around' | `after' | `activation' | `deactivation'.
-NAME ::= Non-nil symbol that names this piece of advice.
-POSITION ::= `first' | `last' | NUMBER. Optional, defaults to `first',
-    see also `ad-add-advice'.
-ARGLIST ::= An optional argument list to be used for the advised function
-    instead of the argument list of the original.  The first one found in
-    before/around/after-advices will be used.
-FLAG ::= `protect'|`disable'|`activate'|`compile'|`preactivate'|`freeze'.
-    All flags can be specified with unambiguous initial substrings.
-DOCSTRING ::= Optional documentation for this piece of advice.
-INTERACTIVE-FORM ::= Optional interactive form to be used for the advised
-    function.  The first one found in before/around/after-advices will be used.
-BODY ::= Any s-expression.
-
-Semantics of the various flags:
-`protect': The piece of advice will be protected against non-local exits in
-any code that precedes it.  If any around-advice of a function is protected
-then automatically all around-advices will be protected (the complete onion).
-
-`activate': All advice of FUNCTION will be activated immediately if
-FUNCTION has been properly defined prior to this application of `defadvice'.
-
-`compile': In conjunction with `activate' specifies that the resulting
-advised function should be compiled.
-
-`disable': The defined advice will be disabled, hence, it will not be used 
-during activation until somebody enables it.
-
-`preactivate': Preactivates the advised FUNCTION at macro-expansion/compile
-time.  This generates a compiled advised definition according to the current
-advice state that will be used during activation if appropriate.  Only use
-this if the `defadvice' gets actually compiled.
-
-`freeze': Expands the `defadvice' into a redefining `defun/defmacro' according
-to this particular single advice.  No other advice information will be saved.
-Frozen advices cannot be undone, they behave like a hard redefinition of
-the advised function.  `freeze' implies `activate' and `preactivate'.  The
-documentation of the advised function can be dumped onto the `DOC' file
-during preloading.
-
-Look at the file `advice.el' for comprehensive documentation."
-  (if (not (ad-name-p function))
-      (error "defadvice: Illegal function name: %s" function))
-  (let* ((class (car args))
-	 (name (if (not (ad-class-p class))
-		   (error "defadvice: Illegal advice class: %s" class)
-		 (nth 1 args)))
-	 (position (if (not (ad-name-p name))
-		       (error "defadvice: Illegal advice name: %s" name)
-		     (setq args (nthcdr 2 args))
-		     (if (ad-position-p (car args))
-			 (prog1 (car args)
-			   (setq args (cdr args))))))
-	 (arglist (if (listp (car args))
-		      (prog1 (car args)
-			(setq args (cdr args)))))
-	 (flags
-	  (mapcar
-	   (function
-	    (lambda (flag)
-	      (let ((completion
-		     (try-completion (symbol-name flag) ad-defadvice-flags)))
-		(cond ((eq completion t) flag)
-		      ((assoc completion ad-defadvice-flags)
-		       (intern completion))
-		      (t (error "defadvice: Illegal or ambiguous flag: %s"
-				flag))))))
-	   args))
-	 (advice (ad-make-advice
-		  name (memq 'protect flags)
-		  (not (memq 'disable flags))
-		  (` (advice lambda (, arglist) (,@ body)))))
-	 (preactivation (if (memq 'preactivate flags)
-			    (ad-preactivate-advice
-			     function advice class position))))
-    ;; Now for the things to be done at evaluation time:
-    (if (memq 'freeze flags)
-	;; jwz's idea: Freeze the advised definition into a dumpable
-	;; defun/defmacro whose docs can be written to the DOC file:
-	(ad-make-freeze-definition function advice class position)
-      ;; the normal case:	 
-      (` (progn
-	   (ad-add-advice '(, function) '(, advice) '(, class) '(, position))
-	   (,@ (if preactivation
-		   (` ((ad-set-cache
-			'(, function)
-			;; the function will get compiled:
-			(, (cond ((ad-macro-p (car preactivation))
-				  (` (ad-macrofy
-				      (function
-				       (, (ad-lambdafy
-					   (car preactivation)))))))
-				 (t (` (function
-					(, (car preactivation)))))))
-			'(, (car (cdr preactivation))))))))
-	   (,@ (if (memq 'activate flags)
-		   (` ((ad-activate-on '(, function)
-				       (, (if (memq 'compile flags) t)))))))
-	   '(, function))))))
-
-
-;; @@ Tools:
-;; =========
-
-(defmacro ad-with-originals (functions &rest body)
-  "Binds FUNCTIONS to their original definitions and executes BODY.
-For any members of FUNCTIONS that are not currently advised the rebinding will
-be a noop.  Any modifications done to the definitions of FUNCTIONS will be
-undone on exit of this macro."
-  (let* ((index -1)
-	 ;; Make let-variables to store current definitions:
-	 (current-bindings
-	  (mapcar (function
-		   (lambda (function)
-		     (setq index (1+ index))
-		     (list (intern (format "ad-oRiGdEf-%d" index))
-			   (` (symbol-function '(, function))))))
-		  functions)))
-    (` (let (, current-bindings)
-	 (unwind-protect
-	     (progn
-	       (,@ (progn
-		     ;; Make forms to redefine functions to their
-		     ;; original definitions if they are advised:
-		     (setq index -1)
-		     (mapcar
-		      (function
-		       (lambda (function)
-			 (setq index (1+ index))
-			 (` (ad-safe-fset
-			     '(, function)
-			     (or (ad-get-orig-definition '(, function))
-				 (, (car (nth index current-bindings))))))))
-		      functions)))
-	       (,@ body))
-	   (,@ (progn
-		 ;; Make forms to back-define functions to the definitions
-		 ;; they had outside this macro call:
-		 (setq index -1)
-		 (mapcar
-		  (function
-		   (lambda (function)
-		     (setq index (1+ index))
-		     (` (ad-safe-fset
-			 '(, function)
-			 (, (car (nth index current-bindings)))))))
-		  functions))))))))
-
-(if (not (get 'ad-with-originals 'lisp-indent-hook))
-    (put 'ad-with-originals 'lisp-indent-hook 1))
-
-
-;; @@ Advising `documentation':
-;; ============================
-;; Use the advice mechanism to advise `documentation' to make it
-;; generate proper documentation strings for advised definitions:
-
-(defadvice documentation (after ad-advised-docstring first disable preact)
-  "Builds an advised docstring if FUNCTION is advised."
-  ;; Because we get the function name from the advised docstring
-  ;; this will work for function names as well as for definitions:
-  (if (and (stringp ad-return-value)
-	   (string-match
-	    ad-advised-definition-docstring-regexp ad-return-value))
-      (let ((function
-	     (car (read-from-string
-		   ad-return-value (match-beginning 1) (match-end 1)))))
-	(cond ((ad-is-advised function)
-	       (setq ad-return-value (ad-make-advised-docstring function))
-	       ;; Handle optional `raw' argument: 
-	       (if (not (ad-get-arg 1))
-		   (setq ad-return-value
-			 (substitute-command-keys ad-return-value))))))))
-
-
-;; @@ Starting, stopping and recovering from the advice package magic:
-;; ===================================================================
-
-(defun ad-start-advice ()
-  "Starts the automatic advice handling magic."
-  (interactive)
-  ;; Advising `ad-activate' means death!!
-  (ad-set-advice-info 'ad-activate nil)
-  (ad-safe-fset 'ad-activate 'ad-activate-on)
-  (ad-enable-advice 'documentation 'after 'ad-advised-docstring)
-  (ad-activate-on 'documentation 'compile))
-
-(defun ad-stop-advice ()
-  "Stops the automatic advice handling magic.
-You should only need this in case of Advice-related emergencies."
-  (interactive)
-  ;; Advising `ad-activate' means death!!
-  (ad-set-advice-info 'ad-activate nil)
-  (ad-disable-advice 'documentation 'after 'ad-advised-docstring)
-  (ad-update 'documentation)
-  (ad-safe-fset 'ad-activate 'ad-activate-off))
-
-(defun ad-recover-normality ()
-  "Undoes all advice related redefinitions and unadvises everything. 
-Use only in REAL emergencies."
-  (interactive)
-  ;; Advising `ad-activate' means death!!
-  (ad-set-advice-info 'ad-activate nil)
-  (ad-safe-fset 'ad-activate 'ad-activate-off)
-  (ad-recover-all)
-  (setq ad-advised-functions nil))
-
-;; Until the Advice-related changes to `data.c' are part of Lemacs we
-;; have to load the old implementation of advice activation hooks:
-(if (ad-lemacs-p)
-    (require 'ad-hooks))
-
-(ad-start-advice)
-
-(provide 'advice)
-
-;;; advice.el ends here
diff --git a/lisp/emacs-lisp/assoc.el b/lisp/emacs-lisp/assoc.el
deleted file mode 100644
index 997badc1732..00000000000
--- a/lisp/emacs-lisp/assoc.el
+++ /dev/null
@@ -1,140 +0,0 @@
-;;; assoc.el --- insert/delete/sort functions on association lists
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Barry A. Warsaw <bwarsaw@cen.com>
-;; 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:
-
-;; Association list utilities providing insertion, deletion, sorting
-;; fetching off key-value pairs in association lists.
-
-;;; Code:
-
-(defun asort (alist-symbol key)
-  "Move a specified key-value pair to the head of an alist.
-The alist is referenced by ALIST-SYMBOL. Key-value pair to move to
-head is one matching KEY.  Returns the sorted list and doesn't affect
-the order of any other key-value pair.  Side effect sets alist to new
-sorted list."
-  (set alist-symbol
-       (sort (copy-alist (eval alist-symbol))
-	     (function (lambda (a b) (equal (car a) key))))))
-
-
-(defun aelement (key value)
-  "Makes a list of a cons cell containing car of KEY and cdr of VALUE.
-The returned list is suitable as an element of an alist."
-  (list (cons key value)))
-
-
-(defun aheadsym (alist)
-  "Return the key symbol at the head of ALIST."
-  (car (car alist)))
-
-
-(defun anot-head-p (alist key)
-  "Find out if a specified key-value pair is not at the head of an alist.
-The alist to check is specified by ALIST and the key-value pair is the
-one matching the supplied KEY.  Returns nil if ALIST is nil, or if
-key-value pair is at the head of the alist.  Returns t if key-value
-pair is not at the head of alist.  ALIST is not altered."
-  (not (equal (aheadsym alist) key)))
-
-
-(defun aput (alist-symbol key &optional value)
-  "Inserts a key-value pair into an alist.
-The alist is referenced by ALIST-SYMBOL. The key-value pair is made
-from KEY and optionally, VALUE. Returns the altered alist or nil if
-ALIST is nil.
-
-If the key-value pair referenced by KEY can be found in the alist, and
-VALUE is supplied non-nil, then the value of KEY will be set to VALUE.
-If VALUE is not supplied, or is nil, the key-value pair will not be
-modified, but will be moved to the head of the alist. If the key-value
-pair cannot be found in the alist, it will be inserted into the head
-of the alist (with value nil if VALUE is nil or not supplied)."
-  (let ((elem (aelement key value))
-	alist)
-    (asort alist-symbol key)
-    (setq alist (eval alist-symbol))
-    (cond ((null alist) (set alist-symbol elem))
-	  ((anot-head-p alist key) (set alist-symbol (nconc elem alist)))
-	  (value (setcar alist (car elem)))
-	  (t alist))))
-
-
-(defun adelete (alist-symbol key)
-  "Delete a key-value pair from the alist.
-Alist is referenced by ALIST-SYMBOL and the key-value pair to remove
-is pair matching KEY.  Returns the altered alist."
-  (asort alist-symbol key)
-  (let ((alist (eval alist-symbol)))
-    (cond ((null alist) nil)
-	  ((anot-head-p alist key) alist)
-	  (t (set alist-symbol (cdr alist))))))
-
-
-(defun aget (alist key &optional keynil-p)
-  "Returns the value in ALIST that is associated with KEY.
-Optional KEYNIL-P describes what to do if the value associated with
-KEY is nil.  If KEYNIL-P is not supplied or is nil, and the value is
-nil, then KEY is returned.  If KEYNIL-P is non-nil, then nil would be
-returned.
-
-If no key-value pair matching KEY could be found in ALIST, or ALIST is
-nil then nil is returned. ALIST is not altered."
-  (let ((copy (copy-alist alist)))
-    (cond ((null alist) nil)
-	  ((progn (asort 'copy key)
-		  (anot-head-p copy key)) nil)
-	  ((cdr (car copy)))
-	  (keynil-p nil)
-	  ((car (car copy)))
-	  (t nil))))
-
-
-(defun amake (alist-symbol keylist &optional valuelist)
-  "Make an association list.
-The association list is attached to the alist referenced by
-ALIST-SYMBOL. Each element in the KEYLIST becomes a key and is
-associated with the value in VALUELIST with the same index. If
-VALUELIST is not supplied or is nil, then each key in KEYLIST is
-associated with nil.
-
-KEYLIST and VALUELIST should have the same number of elements, but
-this isn't enforced.  If VALUELIST is smaller than KEYLIST, remaining
-keys are associated with nil.  If VALUELIST is larger than KEYLIST,
-extra values are ignored.  Returns the created alist."
-  (let ((keycar (car keylist))
-	(keycdr (cdr keylist))
-	(valcar (car valuelist))
-	(valcdr (cdr valuelist)))
-    (cond ((null keycdr)
-	   (aput alist-symbol keycar valcar))
-	  (t
-	   (amake alist-symbol keycdr valcdr)
-	   (aput alist-symbol keycar valcar))))
-  (eval alist-symbol))
-
-(provide 'assoc)
-
-;;; assoc.el ends here
diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el
deleted file mode 100644
index 4614a5c42cb..00000000000
--- a/lisp/emacs-lisp/autoload.el
+++ /dev/null
@@ -1,416 +0,0 @@
-;;; autoload.el --- maintain autoloads in loaddefs.el.
-
-;; Copyright (C) 1991, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
-
-;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
-;; Keywords: maint
-
-;; 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 code helps GNU Emacs maintainers keep the loaddefs.el file up to
-;; date.  It interprets magic cookies of the form ";;;###autoload" in
-;; lisp source files in various useful ways.  To learn more, read the
-;; source; if you're going to use this, you'd better be able to.
-
-;;; Code:
-
-(defun make-autoload (form file)
-  "Turn FORM, a defun or defmacro, into an autoload for source file FILE.
-Returns nil if FORM is not a defun, define-skeleton or defmacro."
-  (let ((car (car-safe form)))
-    (if (memq car '(defun define-skeleton defmacro))
-	(let ((macrop (eq car 'defmacro))
-	      name doc)
-	  (setq form (cdr form)
-		name (car form)
-		;; Ignore the arguments.
-		form (cdr (if (eq car 'define-skeleton)
-			      form
-			    (cdr form)))
-		doc (car form))
-	  (if (stringp doc)
-	      (setq form (cdr form))
-	    (setq doc nil))
-	  (list 'autoload (list 'quote name) file doc
-		(or (eq car 'define-skeleton)
-		    (eq (car-safe (car form)) 'interactive))
-		(if macrop (list 'quote 'macro) nil)))
-      nil)))
-
-(put 'define-skeleton 'doc-string-elt 3)
-
-(defconst generate-autoload-cookie ";;;###autoload"
-  "Magic comment indicating the following form should be autoloaded.
-Used by \\[update-file-autoloads].  This string should be
-meaningless to Lisp (e.g., a comment).
-
-This string is used:
-
-;;;###autoload
-\(defun function-to-be-autoloaded () ...)
-
-If this string appears alone on a line, the following form will be
-read and an autoload made for it.  If there is further text on the line,
-that text will be copied verbatim to `generated-autoload-file'.")
-
-(defconst generate-autoload-section-header "\f\n;;;### "
-  "String inserted before the form identifying
-the section of autoloads for a file.")
-
-(defconst generate-autoload-section-trailer "\n;;;***\n"
-  "String which indicates the end of the section of autoloads for a file.")
-
-;;; Forms which have doc-strings which should be printed specially.
-;;; A doc-string-elt property of ELT says that (nth ELT FORM) is
-;;; the doc-string in FORM.
-;;;
-;;; There used to be the following note here:
-;;; ;;; Note: defconst and defvar should NOT be marked in this way.
-;;; ;;; We don't want to produce defconsts and defvars that
-;;; ;;; make-docfile can grok, because then it would grok them twice,
-;;; ;;; once in foo.el (where they are given with ;;;###autoload) and
-;;; ;;; once in loaddefs.el.
-;;;
-;;; Counter-note: Yes, they should be marked in this way.
-;;; make-docfile only processes those files that are loaded into the
-;;; dumped Emacs, and those files should never have anything
-;;; autoloaded here.  The above-feared problem only occurs with files
-;;; which have autoloaded entries *and* are processed by make-docfile;
-;;; there should be no such files.
-
-(put 'autoload 'doc-string-elt 3)
-(put 'defun    'doc-string-elt 3)
-(put 'defvar   'doc-string-elt 3)
-(put 'defconst 'doc-string-elt 3)
-(put 'defmacro 'doc-string-elt 3)
-
-(defun autoload-trim-file-name (file)
-  ;; Returns a relative pathname of FILE
-  ;; starting from the directory that loaddefs.el is in.
-  ;; That is normally a directory in load-path,
-  ;; which means Emacs will be able to find FILE when it looks.
-  ;; Any extra directory names here would prevent finding the file.
-  (setq file (expand-file-name file))
-  (file-relative-name file
-		      (file-name-directory generated-autoload-file)))
-
-(defun generate-file-autoloads (file)
-  "Insert at point a loaddefs autoload section for FILE.
-autoloads are generated for defuns and defmacros in FILE
-marked by `generate-autoload-cookie' (which see).
-If FILE is being visited in a buffer, the contents of the buffer
-are used."
-  (interactive "fGenerate autoloads for file: ")
-  (let ((outbuf (current-buffer))
-	(autoloads-done '())
-	(load-name (let ((name (file-name-nondirectory file)))
-		     (if (string-match "\\.elc?$" name)
-			 (substring name 0 (match-beginning 0))
-		       name)))
-	(print-length nil)
-	(print-readably t)		; This does something in Lucid Emacs.
-	(float-output-format nil)
-	(done-any nil)
-	(visited (get-file-buffer file))
-	output-end)
-
-    ;; If the autoload section we create here uses an absolute
-    ;; pathname for FILE in its header, and then Emacs is installed
-    ;; under a different path on another system,
-    ;; `update-autoloads-here' won't be able to find the files to be
-    ;; autoloaded.  So, if FILE is in the same directory or a
-    ;; subdirectory of the current buffer's directory, we'll make it
-    ;; relative to the current buffer's directory.
-    (setq file (expand-file-name file))
-    (let* ((source-truename (file-truename file))
-	   (dir-truename (file-name-as-directory
-			  (file-truename default-directory)))
-	   (len (length dir-truename)))
-      (if (and (< len (length source-truename))
-	       (string= dir-truename (substring source-truename 0 len)))
-	  (setq file (substring source-truename len))))
-
-    (message "Generating autoloads for %s..." file)
-    (save-excursion
-      (unwind-protect
-	  (progn
-	    (if visited
-		(set-buffer visited)
-	      ;; It is faster to avoid visiting the file.
-	      (set-buffer (get-buffer-create " *generate-autoload-file*"))
-	      (kill-all-local-variables)
-	      (erase-buffer)
-	      (setq buffer-undo-list t
-		    buffer-read-only nil)
-	      (emacs-lisp-mode)
-	      (insert-file-contents file nil))
-	    (save-excursion
-	      (save-restriction
-		(widen)
-		(goto-char (point-min))
-		(while (not (eobp))
-		  (skip-chars-forward " \t\n\f")
-		  (cond
-		   ((looking-at (regexp-quote generate-autoload-cookie))
-		    (search-forward generate-autoload-cookie)
-		    (skip-chars-forward " \t")
-		    (setq done-any t)
-		    (if (eolp)
-			;; Read the next form and make an autoload.
-			(let* ((form (prog1 (read (current-buffer))
-				       (or (bolp) (forward-line 1))))
-			       (autoload (make-autoload form load-name))
-			       (doc-string-elt (get (car-safe form)
-						    'doc-string-elt)))
-			  (if autoload
-			      (setq autoloads-done (cons (nth 1 form)
-							 autoloads-done))
-			    (setq autoload form))
-			  (if (and doc-string-elt
-				   (stringp (nth doc-string-elt autoload)))
-			      ;; We need to hack the printing because the
-			      ;; doc-string must be printed specially for
-			      ;; make-docfile (sigh).
-			      (let* ((p (nthcdr (1- doc-string-elt)
-						autoload))
-				     (elt (cdr p)))
-				(setcdr p nil)
-				(princ "\n(" outbuf)
-				(let ((print-escape-newlines t))
-				  (mapcar (function (lambda (elt)
-						      (prin1 elt outbuf)
-						      (princ " " outbuf)))
-					  autoload))
-				(princ "\"\\\n" outbuf)
-				(let ((begin (save-excursion
-					       (set-buffer outbuf)
-					       (point))))
-				  (princ (substring
-					  (prin1-to-string (car elt)) 1)
-					 outbuf)
-				  ;; Insert a backslash before each ( that
-				  ;; appears at the beginning of a line in
-				  ;; the doc string.
-				  (save-excursion
-				    (set-buffer outbuf)
-				    (save-excursion
-				      (while (search-backward "\n(" begin t)
-					(forward-char 1)
-					(insert "\\"))))
-				  (if (null (cdr elt))
-				      (princ ")" outbuf)
-				    (princ " " outbuf)
-				    (princ (substring
-					    (prin1-to-string (cdr elt))
-					    1)
-					   outbuf))
-				  (terpri outbuf)))
-			    (let ((print-escape-newlines t))
-			      (print autoload outbuf))))
-			  ;; Copy the rest of the line to the output.
-		      (princ (buffer-substring
-			      (progn
-				;; Back up over whitespace, to preserve it.
-				(skip-chars-backward " \f\t")
-				(if (= (char-after (1+ (point))) ? )
-				    ;; Eat one space.
-				    (forward-char 1))
-				(point))
-			      (progn (forward-line 1) (point)))
-			     outbuf)))
-		   ((looking-at ";")
-		    ;; Don't read the comment.
-		    (forward-line 1))
-		   (t
-		    (forward-sexp 1)
-		    (forward-line 1)))))))
-	(or visited
-	    ;; We created this buffer, so we should kill it.
-	    (kill-buffer (current-buffer)))
-	(set-buffer outbuf)
-	(setq output-end (point-marker))))
-    (if done-any
-	(progn
-	  (insert generate-autoload-section-header)
-	  (prin1 (list 'autoloads autoloads-done load-name
-		       (autoload-trim-file-name file)
-		       (nth 5 (file-attributes file)))
-		 outbuf)
-	  (terpri outbuf)
-	  (insert ";;; Generated autoloads from "
-		  (autoload-trim-file-name file) "\n")
-	  ;; Warn if we put a line in loaddefs.el
-	  ;; that is long enough to cause trouble.
-	  (while (< (point) output-end)
-	    (let ((beg (point)))
-	      (end-of-line)
-	      (if (> (- (point) beg) 900)
-		  (progn
-		    (message "A line is too long--over 900 characters")
-		    (sleep-for 2)
-		    (goto-char output-end))))
-	    (forward-line 1))
-	  (goto-char output-end)
-	  (insert generate-autoload-section-trailer)))
-    (message "Generating autoloads for %s...done" file)))
-
-(defconst generated-autoload-file "loaddefs.el"
-   "*File \\[update-file-autoloads] puts autoloads into.
-A .el file can set this in its local variables section to make its
-autoloads go somewhere else.")
-
-;;;###autoload
-(defun update-file-autoloads (file)
-  "Update the autoloads for FILE in `generated-autoload-file'
-\(which FILE might bind in its local variables)."
-  (interactive "fUpdate autoloads for file: ")
-  (let ((load-name (let ((name (file-name-nondirectory file)))
-		     (if (string-match "\\.elc?$" name)
-			 (substring name 0 (match-beginning 0))
-		       name)))
-	(found nil)
-	(existing-buffer (get-file-buffer file)))
-    (save-excursion
-      ;; We want to get a value for generated-autoload-file from
-      ;; the local variables section if it's there.
-      (if existing-buffer
-	  (set-buffer existing-buffer))
-      (set-buffer (find-file-noselect generated-autoload-file))
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (goto-char (point-min))
-	  ;; Look for the section for LOAD-NAME.
-	  (while (and (not found)
-		      (search-forward generate-autoload-section-header nil t))
-	    (let ((form (condition-case ()
-			    (read (current-buffer))
-			  (end-of-file nil))))
-	      (cond ((string= (nth 2 form) load-name)
-		     ;; We found the section for this file.
-		     ;; Check if it is up to date.
-		     (let ((begin (match-beginning 0))
-			   (last-time (nth 4 form))
-			   (file-time (nth 5 (file-attributes file))))
-		       (if (and (or (null existing-buffer)
-				    (not (buffer-modified-p existing-buffer)))
-				(listp last-time) (= (length last-time) 2)
-				(or (> (car last-time) (car file-time))
-				    (and (= (car last-time) (car file-time))
-					 (>= (nth 1 last-time)
-					     (nth 1 file-time)))))
-			   (progn
-			     (if (interactive-p)
-				 (message "\
-Autoload section for %s is up to date."
-					  file))
-			     (setq found 'up-to-date))
-			 (search-forward generate-autoload-section-trailer)
-			 (delete-region begin (point))
-			 (setq found t))))
-		    ((string< load-name (nth 2 form))
-		     ;; We've come to a section alphabetically later than
-		     ;; LOAD-NAME.  We assume the file is in order and so
-		     ;; there must be no section for LOAD-NAME.  We will
-		     ;; insert one before the section here.
-		     (goto-char (match-beginning 0))
-		     (setq found 'new)))))
-	  (or found
-	      (progn
-		(setq found 'new)
-		;; No later sections in the file.  Put before the last page.
-		(goto-char (point-max))
-		(search-backward "\f" nil t)))
-	  (or (eq found 'up-to-date)
-	      (and (eq found 'new)
-		   ;; Check that FILE has any cookies before generating a
-		   ;; new section for it.
-		   (save-excursion
-		     (if existing-buffer
-			 (set-buffer existing-buffer)
-		       ;; It is faster to avoid visiting the file.
-		       (set-buffer (get-buffer-create " *autoload-file*"))
-		       (kill-all-local-variables)
-		       (erase-buffer)
-		       (setq buffer-undo-list t
-			     buffer-read-only nil)
-		       (emacs-lisp-mode)
-		       (insert-file-contents file nil))
-		     (save-excursion
-		       (save-restriction
-			 (widen)
-			 (goto-char (point-min))
-			 (prog1
-			     (if (search-forward
-				  (concat "\n" generate-autoload-cookie)
-				  nil t)
-				 nil
-			       (if (interactive-p)
-				   (message "%s has no autoloads" file))
-			       t)
-			   (or existing-buffer
-			       (kill-buffer (current-buffer))))))))
-	      (generate-file-autoloads file))))
-      (if (interactive-p) (save-buffer)))))
-
-;;;###autoload
-(defun update-autoloads-from-directory (dir)
-  "\
-Update loaddefs.el with all the current autoloads from DIR, and no old ones.
-This uses `update-file-autoloads' (which see) do its work."
-  (interactive "DUpdate autoloads from directory: ")
-  (setq dir (expand-file-name dir))
-  (let ((files (directory-files dir nil "^[^=].*\\.el$")))
-    (save-excursion
-      (set-buffer (find-file-noselect
-		   (if (file-exists-p generated-autoload-file)
-		       generated-autoload-file
-		     (expand-file-name generated-autoload-file
-				       dir))))
-      (save-excursion
-	(goto-char (point-min))
-	(while (search-forward generate-autoload-section-header nil t)
-	  (let* ((form (condition-case ()
-			   (read (current-buffer))
-			 (end-of-file nil)))
-		 (file (nth 3 form)))
-	    (cond ((not (stringp file)))
-		  ((not (file-exists-p (expand-file-name file dir)))
-		   ;; Remove the obsolete section.
-		   (let ((begin (match-beginning 0)))
-		     (search-forward generate-autoload-section-trailer)
-		     (delete-region begin (point))))
-		  (t
-		   (update-file-autoloads file)))
-	    (setq files (delete file files)))))
-      ;; Elements remaining in FILES have no existing autoload sections.
-      (mapcar 'update-file-autoloads files)
-      (save-buffer))))
-
-;;;###autoload
-(defun batch-update-autoloads ()
-  "Update loaddefs.el autoloads in batch mode.
-Calls `update-autoloads-from-directory' on each command line argument."
-  (mapcar 'update-autoloads-from-directory command-line-args-left)
-  (setq command-line-args-left nil))
-
-(provide 'autoload)
-
-;;; autoload.el ends here
diff --git a/lisp/emacs-lisp/backquote.el b/lisp/emacs-lisp/backquote.el
deleted file mode 100644
index 807b4bd1c50..00000000000
--- a/lisp/emacs-lisp/backquote.el
+++ /dev/null
@@ -1,212 +0,0 @@
-;;; backquote.el --- implement the ` Lisp construct
-
-;;; Copyright (C) 1990, 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Rick Sladkey <jrs@world.std.com>
-;; Maintainer: FSF
-;; Keywords: extensions, 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 backquote will generate calls to the backquote-list* form.
-;; Both a function version and a macro version are included.
-;; The macro version is used by default because it is faster
-;; and needs no run-time support.  It should really be a subr.
-
-;;; Code:
-
-(provide 'backquote)
-
-;; function and macro versions of backquote-list*
-
-(defun backquote-list*-function (first &rest list)
-  "Like `list' but the last argument is the tail of the new list.
-
-For example (backquote-list* 'a 'b 'c) => (a b . c)"
-  (if list
-      (let* ((rest list) (newlist (cons first nil)) (last newlist))
-	(while (cdr rest)
-	  (setcdr last (cons (car rest) nil))
-	  (setq last (cdr last)
-		rest (cdr rest)))
-	(setcdr last (car rest))
-	newlist)
-    first))
-
-(defmacro backquote-list*-macro (first &rest list)
-  "Like `list' but the last argument is the tail of the new list.
-
-For example (backquote-list* 'a 'b 'c) => (a b . c)"
-  (setq list (reverse (cons first list))
-	first (car list)
-	list (cdr list))
-  (if list
-      (let* ((second (car list))
-	     (rest (cdr list))
-	     (newlist (list 'cons second first)))
-	(while rest
-	  (setq newlist (list 'cons (car rest) newlist)
-		rest (cdr rest)))
-	newlist)
-    first))
-
-(defalias 'backquote-list* (symbol-function 'backquote-list*-macro))
-
-;; A few advertised variables that control which symbols are used
-;; to represent the backquote, unquote, and splice operations.
-
-(defvar backquote-backquote-symbol '\`
-  "*Symbol used to represent a backquote or nested backquote (e.g. `).")
-
-(defvar backquote-unquote-symbol ',
-  "*Symbol used to represent an unquote (e.g. `,') inside a backquote.")
-
-(defvar backquote-splice-symbol ',@
-  "*Symbol used to represent a splice (e.g. `,@') inside a backquote.")
-
-;;;###autoload
-(defmacro backquote (arg)
-  "Argument STRUCTURE describes a template to build.
-
-The whole structure acts as if it were quoted except for certain
-places where expressions are evaluated and inserted or spliced in.
-
-For example:
-
-b              => (ba bb bc)		; assume b has this value
-`(a b c)       => (a b c)		; backquote acts like quote
-`(a ,b c)      => (a (ba bb bc) c)	; insert the value of b
-`(a ,@b c)     => (a ba bb bc c)	; splice in the value of b
-
-Vectors work just like lists.  Nested backquotes are permitted."
-  (cdr (backquote-process arg)))
-
-;; GNU Emacs has no reader macros
-
-;;;###autoload
-(defalias '\` (symbol-function 'backquote))
-
-;; backquote-process returns a dotted-pair of a tag (0, 1, or 2) and
-;; the backquote-processed structure.  0 => the structure is
-;; constant, 1 => to be unquoted, 2 => to be spliced in.
-;; The top-level backquote macro just discards the tag.
-
-(defun backquote-process (s)
-  (cond
-   ((vectorp s)
-    (let ((n (backquote-process (append s ()))))
-      (if (= (car n) 0)
-	  (cons 0 s)
-	(cons 1 (cond
-		 ((eq (nth 1 n) 'list)
-		  (cons 'vector (nthcdr 2 n)))
-		 ((eq (nth 1 n) 'append)
-		  (cons 'vconcat (nthcdr 2 n)))
-		 (t
-		  (list 'apply '(function vector) (cdr n))))))))
-   ((atom s)
-    (cons 0 (if (or (null s) (eq s t) (not (symbolp s)))
-		s
-	      (list 'quote s))))
-   ((eq (car s) backquote-unquote-symbol)
-    (cons 1 (nth 1 s)))
-   ((eq (car s) backquote-splice-symbol)
-    (cons 2 (nth 1 s)))
-   ((eq (car s) backquote-backquote-symbol)
-    (backquote-process (cdr (backquote-process (nth 1 s)))))
-   (t
-    (let ((rest s)
-	  item firstlist list lists expression)
-      ;; Scan this list-level, setting LISTS to a list of forms,
-      ;; each of which produces a list of elements
-      ;; that should go in this level.
-      ;; The order of LISTS is backwards. 
-      ;; If there are non-splicing elements (constant or variable)
-      ;; at the beginning, put them in FIRSTLIST,
-      ;; as a list of tagged values (TAG . FORM).
-      ;; If there are any at the end, they go in LIST, likewise.
-      (while (consp rest)
-	;; Turn . (, foo) into (,@ foo).
-	(if (eq (car rest) backquote-unquote-symbol)
-	    (setq rest (list (list backquote-splice-symbol (nth 1 rest)))))
-	(setq item (backquote-process (car rest)))
-	(cond
-	 ((= (car item) 2)
-	  ;; Put the nonspliced items before the first spliced item
-	  ;; into FIRSTLIST.
-	  (if (null lists)
-	      (setq firstlist list
-		    list nil))
-	  ;; Otherwise, put any preceding nonspliced items into LISTS.
-	  (if list
-	      (setq lists (cons (backquote-listify list '(0 . nil)) lists)))
-	  (setq lists (cons (cdr item) lists))
-	  (setq list nil))
-	 (t
-	  (setq list (cons item list))))
-	(setq rest (cdr rest)))
-      ;; Handle nonsplicing final elements, and the tail of the list
-      ;; (which remains in REST).
-      (if (or rest list)
-	  (setq lists (cons (backquote-listify list (backquote-process rest))
-			    lists)))
-      ;; Turn LISTS into a form that produces the combined list. 
-      (setq expression
-	    (if (or (cdr lists)
-		    (eq (car-safe (car lists)) backquote-splice-symbol))
-		(cons 'append (nreverse lists))
-	      (car lists)))
-      ;; Tack on any initial elements.
-      (if firstlist
-	  (setq expression (backquote-listify firstlist (cons 1 expression))))
-      (if (eq (car-safe expression) 'quote)
-	  (cons 0 (list 'quote s))
-	(cons 1 expression))))))
-
-;; backquote-listify takes (tag . structure) pairs from backquote-process
-;; and decides between append, list, backquote-list*, and cons depending
-;; on which tags are in the list.
-
-(defun backquote-listify (list old-tail)
-  (let ((heads nil) (tail (cdr old-tail)) (list-tail list) (item nil))
-    (if (= (car old-tail) 0)
-	(setq tail (eval tail)
-	      old-tail nil))
-    (while (consp list-tail)
-      (setq item (car list-tail))
-      (setq list-tail (cdr list-tail))
-      (if (or heads old-tail (/= (car item) 0))
-	  (setq heads (cons (cdr item) heads))
-	(setq tail (cons (eval (cdr item)) tail))))
-    (cond
-     (tail
-      (if (null old-tail)
-	  (setq tail (list 'quote tail)))
-      (if heads
-	  (let ((use-list* (or (cdr heads)
-			       (and (consp (car heads))
-				    (eq (car (car heads))
-					backquote-splice-symbol)))))
-	    (cons (if use-list* 'backquote-list* 'cons)
-		  (append heads (list tail))))
-	tail))
-     (t (cons 'list heads)))))
-
-;; backquote.el ends here
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
deleted file mode 100644
index ef2880c7d9b..00000000000
--- a/lisp/emacs-lisp/byte-opt.el
+++ /dev/null
@@ -1,1872 +0,0 @@
-;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler.
-
-;;; Copyright (c) 1991, 1994 Free Software Foundation, Inc.
-
-;; Author: Jamie Zawinski <jwz@lucid.com>
-;;	Hallvard Furuseth <hbf@ulrik.uio.no>
-;; 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 has been censored by the Communications Decency Act.
-;;; That law was passed under the guise of a ban on pornography, but
-;;; it bans far more than that.  This file did not contain pornography,
-;;; but it was censored nonetheless.
-
-;;; For information on US government censorship of the Internet, and
-;;; what you can do to bring back freedom of the press, see the web
-;;; site http://www.vtw.org/
-
-;; ========================================================================
-;; "No matter how hard you try, you can't make a racehorse out of a pig.
-;; You can, however, make a faster pig."
-;;
-;; Or, to put it another way, the emacs byte compiler is a VW Bug.  This code
-;; makes it be a VW Bug with fuel injection and a turbocharger...  You're 
-;; still not going to make it go faster than 70 mph, but it might be easier
-;; to get it there.
-;;
-
-;; TO DO:
-;;
-;; (apply '(lambda (x &rest y) ...) 1 (foo))
-;;
-;; maintain a list of functions known not to access any global variables
-;; (actually, give them a 'dynamically-safe property) and then
-;;   (let ( v1 v2 ... vM vN ) <...dynamically-safe...> )  ==>
-;;   (let ( v1 v2 ... vM ) vN <...dynamically-safe...> )
-;; by recursing on this, we might be able to eliminate the entire let.
-;; However certain variables should never have their bindings optimized
-;; away, because they affect everything.
-;;   (put 'debug-on-error 'binding-is-magic t)
-;;   (put 'debug-on-abort 'binding-is-magic t)
-;;   (put 'debug-on-next-call 'binding-is-magic t)
-;;   (put 'mocklisp-arguments 'binding-is-magic t)
-;;   (put 'inhibit-quit 'binding-is-magic t)
-;;   (put 'quit-flag 'binding-is-magic t)
-;;   (put 't 'binding-is-magic t)
-;;   (put 'nil 'binding-is-magic t)
-;; possibly also
-;;   (put 'gc-cons-threshold 'binding-is-magic t)
-;;   (put 'track-mouse 'binding-is-magic t)
-;; others?
-;;
-;; Simple defsubsts often produce forms like
-;;    (let ((v1 (f1)) (v2 (f2)) ...)
-;;       (FN v1 v2 ...))
-;; It would be nice if we could optimize this to 
-;;    (FN (f1) (f2) ...)
-;; but we can't unless FN is dynamically-safe (it might be dynamically
-;; referring to the bindings that the lambda arglist established.)
-;; One of the uncountable lossages introduced by dynamic scope...
-;;
-;; Maybe there should be a control-structure that says "turn on 
-;; fast-and-loose type-assumptive optimizations here."  Then when
-;; we see a form like (car foo) we can from then on assume that
-;; the variable foo is of type cons, and optimize based on that.
-;; But, this won't win much because of (you guessed it) dynamic 
-;; scope.  Anything down the stack could change the value.
-;; (Another reason it doesn't work is that it is perfectly valid
-;; to call car with a null argument.)  A better approach might
-;; be to allow type-specification of the form
-;;   (put 'foo 'arg-types '(float (list integer) dynamic))
-;;   (put 'foo 'result-type 'bool)
-;; It should be possible to have these types checked to a certain
-;; degree.
-;;
-;; collapse common subexpressions
-;;
-;; It would be nice if redundant sequences could be factored out as well,
-;; when they are known to have no side-effects:
-;;   (list (+ a b c) (+ a b c))   -->  a b add c add dup list-2
-;; but beware of traps like
-;;   (cons (list x y) (list x y))
-;;
-;; Tail-recursion elimination is not really possible in Emacs Lisp.
-;; Tail-recursion elimination is almost always impossible when all variables
-;; have dynamic scope, but given that the "return" byteop requires the
-;; binding stack to be empty (rather than emptying it itself), there can be
-;; no truly tail-recursive Emacs Lisp functions that take any arguments or
-;; make any bindings.
-;;
-;; Here is an example of an Emacs Lisp function which could safely be
-;; byte-compiled tail-recursively:
-;;
-;;  (defun tail-map (fn list)
-;;    (cond (list
-;;           (funcall fn (car list))
-;;           (tail-map fn (cdr list)))))
-;;
-;; However, if there was even a single let-binding around the COND,
-;; it could not be byte-compiled, because there would be an "unbind"
-;; byte-op between the final "call" and "return."  Adding a 
-;; Bunbind_all byteop would fix this.
-;;
-;;   (defun foo (x y z) ... (foo a b c))
-;;   ... (const foo) (varref a) (varref b) (varref c) (call 3) END: (return)
-;;   ... (varref a) (varbind x) (varref b) (varbind y) (varref c) (varbind z) (goto 0) END: (unbind-all) (return)
-;;   ... (varref a) (varset x) (varref b) (varset y) (varref c) (varset z) (goto 0) END: (return)
-;;
-;; this also can be considered tail recursion:
-;;
-;;   ... (const foo) (varref a) (call 1) (goto X) ... X: (return)
-;; could generalize this by doing the optimization
-;;   (goto X) ... X: (return)  -->  (return)
-;;
-;; But this doesn't solve all of the problems: although by doing tail-
-;; recursion elimination in this way, the call-stack does not grow, the
-;; binding-stack would grow with each recursive step, and would eventually
-;; overflow.  I don't believe there is any way around this without lexical
-;; scope.
-;;
-;; Wouldn't it be nice if Emacs Lisp had lexical scope.
-;;
-;; Idea: the form (lexical-scope) in a file means that the file may be 
-;; compiled lexically.  This proclamation is file-local.  Then, within 
-;; that file, "let" would establish lexical bindings, and "let-dynamic"
-;; would do things the old way.  (Or we could use CL "declare" forms.)
-;; We'd have to notice defvars and defconsts, since those variables should
-;; always be dynamic, and attempting to do a lexical binding of them
-;; should simply do a dynamic binding instead.
-;; But!  We need to know about variables that were not necessarily defvarred
-;; in the file being compiled (doing a boundp check isn't good enough.)
-;; Fdefvar() would have to be modified to add something to the plist.
-;;
-;; A major disadvantage of this scheme is that the interpreter and compiler 
-;; would have different semantics for files compiled with (dynamic-scope).  
-;; Since this would be a file-local optimization, there would be no way to
-;; modify the interpreter to obey this (unless the loader was hacked 
-;; in some grody way, but that's a really bad idea.)
-
-;; Other things to consider:
-
-;;;;; Associative math should recognize subcalls to identical function:
-;;;(disassemble (lambda (x) (+ (+ (foo) 1) (+ (bar) 2))))
-;;;;; This should generate the same as (1+ x) and (1- x)
-
-;;;(disassemble (lambda (x) (cons (+ x 1) (- x 1))))
-;;;;; An awful lot of functions always return a non-nil value.  If they're
-;;;;; error free also they may act as true-constants.
-
-;;;(disassemble (lambda (x) (and (point) (foo))))
-;;;;; When 
-;;;;;   - all but one arguments to a function are constant
-;;;;;   - the non-constant argument is an if-expression (cond-expression?)
-;;;;; then the outer function can be distributed.  If the guarding
-;;;;; condition is side-effect-free [assignment-free] then the other
-;;;;; arguments may be any expressions.  Since, however, the code size
-;;;;; can increase this way they should be "simple".  Compare:
-
-;;;(disassemble (lambda (x) (eq (if (point) 'a 'b) 'c)))
-;;;(disassemble (lambda (x) (if (point) (eq 'a 'c) (eq 'b 'c))))
-
-;;;;; (car (cons A B)) -> (progn B A)
-;;;(disassemble (lambda (x) (car (cons (foo) 42))))
-
-;;;;; (cdr (cons A B)) -> (progn A B)
-;;;(disassemble (lambda (x) (cdr (cons 42 (foo)))))
-
-;;;;; (car (list A B ...)) -> (progn B ... A)
-;;;(disassemble (lambda (x) (car (list (foo) 42 (bar)))))
-
-;;;;; (cdr (list A B ...)) -> (progn A (list B ...))
-;;;(disassemble (lambda (x) (cdr (list 42 (foo) (bar)))))
-
-
-;;; Code:
-
-(defun byte-compile-log-lap-1 (format &rest args)
-  (if (aref byte-code-vector 0)
-      (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well."))
-  (byte-compile-log-1
-   (apply 'format format
-     (let (c a)
-       (mapcar '(lambda (arg)
-		  (if (not (consp arg))
-		      (if (and (symbolp arg)
-			       (string-match "^byte-" (symbol-name arg)))
-			  (intern (substring (symbol-name arg) 5))
-			arg)
-		    (if (integerp (setq c (car arg)))
-			(error "non-symbolic byte-op %s" c))
-		    (if (eq c 'TAG)
-			(setq c arg)
-		      (setq a (cond ((memq c byte-goto-ops)
-				     (car (cdr (cdr arg))))
-				    ((memq c byte-constref-ops)
-				     (car (cdr arg)))
-				    (t (cdr arg))))
-		      (setq c (symbol-name c))
-		      (if (string-match "^byte-." c)
-			  (setq c (intern (substring c 5)))))
-		    (if (eq c 'constant) (setq c 'const))
-		    (if (and (eq (cdr arg) 0)
-			     (not (memq c '(unbind call const))))
-			c
-		      (format "(%s %s)" c a))))
-	       args)))))
-
-(defmacro byte-compile-log-lap (format-string &rest args)
-  (list 'and
-	'(memq byte-optimize-log '(t byte))
-	(cons 'byte-compile-log-lap-1
-	      (cons format-string args))))
-
-
-;;; byte-compile optimizers to support inlining
-
-(put 'inline 'byte-optimizer 'byte-optimize-inline-handler)
-
-(defun byte-optimize-inline-handler (form)
-  "byte-optimize-handler for the `inline' special-form."
-  (cons 'progn
-	(mapcar
-	 '(lambda (sexp)
-	    (let ((fn (car-safe sexp)))
-	      (if (and (symbolp fn)
-		    (or (cdr (assq fn byte-compile-function-environment))
-		      (and (fboundp fn)
-			(not (or (cdr (assq fn byte-compile-macro-environment))
-				 (and (consp (setq fn (symbol-function fn)))
-				      (eq (car fn) 'macro))
-				 (subrp fn))))))
-		  (byte-compile-inline-expand sexp)
-		sexp)))
-	 (cdr form))))
-
-
-;; Splice the given lap code into the current instruction stream.
-;; If it has any labels in it, you're responsible for making sure there
-;; are no collisions, and that byte-compile-tag-number is reasonable
-;; after this is spliced in.  The provided list is destroyed.
-(defun byte-inline-lapcode (lap)
-  (setq byte-compile-output (nconc (nreverse lap) byte-compile-output)))
-
-
-(defun byte-compile-inline-expand (form)
-  (let* ((name (car form))
-	 (fn (or (cdr (assq name byte-compile-function-environment))
-		 (and (fboundp name) (symbol-function name)))))
-    (if (null fn)
-	(progn
-	  (byte-compile-warn "attempt to inline %s before it was defined" name)
-	  form)
-      ;; else
-      (if (and (consp fn) (eq (car fn) 'autoload))
-	  (load (nth 1 fn)))
-      (if (and (consp fn) (eq (car fn) 'autoload))
-	  (error "file \"%s\" didn't define \"%s\"" (nth 1 fn) name))
-      (if (symbolp fn)
-	  (byte-compile-inline-expand (cons fn (cdr form)))
-	(if (byte-code-function-p fn)
-	    (progn
-	      (fetch-bytecode fn)
-	      (cons (list 'lambda (aref fn 0)
-			  (list 'byte-code (aref fn 1) (aref fn 2) (aref fn 3)))
-		    (cdr form)))
-	  (if (not (eq (car fn) 'lambda)) (error "%s is not a lambda" name))
-	  (cons fn (cdr form)))))))
-
-;;; ((lambda ...) ...)
-;;; 
-(defun byte-compile-unfold-lambda (form &optional name)
-  (or name (setq name "anonymous lambda"))
-  (let ((lambda (car form))
-	(values (cdr form)))
-    (if (byte-code-function-p lambda)
-	(setq lambda (list 'lambda (aref lambda 0)
-			   (list 'byte-code (aref lambda 1)
-				 (aref lambda 2) (aref lambda 3)))))
-    (let ((arglist (nth 1 lambda))
-	  (body (cdr (cdr lambda)))
-	  optionalp restp
-	  bindings)
-      (if (and (stringp (car body)) (cdr body))
-	  (setq body (cdr body)))
-      (if (and (consp (car body)) (eq 'interactive (car (car body))))
-	  (setq body (cdr body)))
-      (while arglist
-	(cond ((eq (car arglist) '&optional)
-	       ;; ok, I'll let this slide because funcall_lambda() does...
-	       ;; (if optionalp (error "multiple &optional keywords in %s" name))
-	       (if restp (error "&optional found after &rest in %s" name))
-	       (if (null (cdr arglist))
-		   (error "nothing after &optional in %s" name))
-	       (setq optionalp t))
-	      ((eq (car arglist) '&rest)
-	       ;; ...but it is by no stretch of the imagination a reasonable
-	       ;; thing that funcall_lambda() allows (&rest x y) and
-	       ;; (&rest x &optional y) in arglists.
-	       (if (null (cdr arglist))
-		   (error "nothing after &rest in %s" name))
-	       (if (cdr (cdr arglist))
-		   (error "multiple vars after &rest in %s" name))
-	       (setq restp t))
-	      (restp
-	       (setq bindings (cons (list (car arglist)
-					  (and values (cons 'list values)))
-				    bindings)
-		     values nil))
-	      ((and (not optionalp) (null values))
-	       (byte-compile-warn "attempt to open-code %s with too few arguments" name)
-	       (setq arglist nil values 'too-few))
-	      (t
-	       (setq bindings (cons (list (car arglist) (car values))
-				    bindings)
-		     values (cdr values))))
-	(setq arglist (cdr arglist)))
-      (if values
-	  (progn
-	    (or (eq values 'too-few)
-		(byte-compile-warn
-		 "attempt to open-code %s with too many arguments" name))
-	    form)
-	(setq body (mapcar 'byte-optimize-form body))
-	(let ((newform 
-	       (if bindings
-		   (cons 'let (cons (nreverse bindings) body))
-		 (cons 'progn body))))
-	  (byte-compile-log "  %s\t==>\t%s" form newform)
-	  newform)))))
-
-
-;;; implementing source-level optimizers
-
-(defun byte-optimize-form-code-walker (form for-effect)
-  ;;
-  ;; For normal function calls, We can just mapcar the optimizer the cdr.  But
-  ;; we need to have special knowledge of the syntax of the special forms
-  ;; like let and defun (that's why they're special forms :-).  (Actually,
-  ;; the important aspect is that they are subrs that don't evaluate all of
-  ;; their args.)
-  ;;
-  (let ((fn (car-safe form))
-	tmp)
-    (cond ((not (consp form))
-	   (if (not (and for-effect
-			 (or byte-compile-delete-errors
-			     (not (symbolp form))
-			     (eq form t))))
-	     form))
-	  ((eq fn 'quote)
-	   (if (cdr (cdr form))
-	       (byte-compile-warn "malformed quote form: %s"
-				  (prin1-to-string form)))
-	   ;; map (quote nil) to nil to simplify optimizer logic.
-	   ;; map quoted constants to nil if for-effect (just because).
-	   (and (nth 1 form)
-		(not for-effect)
-		form))
-	  ((or (byte-code-function-p fn)
-	       (eq 'lambda (car-safe fn)))
-	   (byte-compile-unfold-lambda form))
-	  ((memq fn '(let let*))
-	   ;; recursively enter the optimizer for the bindings and body
-	   ;; of a let or let*.  This for depth-firstness: forms that
-	   ;; are more deeply nested are optimized first.
-	   (cons fn
-	     (cons
-	      (mapcar '(lambda (binding)
-			 (if (symbolp binding)
-			     binding
-			   (if (cdr (cdr binding))
-			       (byte-compile-warn "malformed let binding: %s"
-						  (prin1-to-string binding)))
-			   (list (car binding)
-				 (byte-optimize-form (nth 1 binding) nil))))
-		      (nth 1 form))
-	      (byte-optimize-body (cdr (cdr form)) for-effect))))
-	  ((eq fn 'cond)
-	   (cons fn
-		 (mapcar '(lambda (clause)
-			    (if (consp clause)
-				(cons
-				 (byte-optimize-form (car clause) nil)
-				 (byte-optimize-body (cdr clause) for-effect))
-			      (byte-compile-warn "malformed cond form: %s"
-						 (prin1-to-string clause))
-			      clause))
-			 (cdr form))))
-	  ((eq fn 'progn)
-	   ;; as an extra added bonus, this simplifies (progn <x>) --> <x>
-	   (if (cdr (cdr form))
-	       (progn
-		 (setq tmp (byte-optimize-body (cdr form) for-effect))
-		 (if (cdr tmp) (cons 'progn tmp) (car tmp)))
-	     (byte-optimize-form (nth 1 form) for-effect)))
-	  ((eq fn 'prog1)
-	   (if (cdr (cdr form))
-	       (cons 'prog1
-		     (cons (byte-optimize-form (nth 1 form) for-effect)
-			   (byte-optimize-body (cdr (cdr form)) t)))
-	     (byte-optimize-form (nth 1 form) for-effect)))
-	  ((eq fn 'prog2)
-	   (cons 'prog2
-	     (cons (byte-optimize-form (nth 1 form) t)
-	       (cons (byte-optimize-form (nth 2 form) for-effect)
-		     (byte-optimize-body (cdr (cdr (cdr form))) t)))))
-	  
-	  ((memq fn '(save-excursion save-restriction save-current-buffer))
-	   ;; those subrs which have an implicit progn; it's not quite good
-	   ;; enough to treat these like normal function calls.
-	   ;; This can turn (save-excursion ...) into (save-excursion) which
-	   ;; will be optimized away in the lap-optimize pass.
-	   (cons fn (byte-optimize-body (cdr form) for-effect)))
-	  
-	  ((eq fn 'with-output-to-temp-buffer)
-	   ;; this is just like the above, except for the first argument.
-	   (cons fn
-	     (cons
-	      (byte-optimize-form (nth 1 form) nil)
-	      (byte-optimize-body (cdr (cdr form)) for-effect))))
-	  
-	  ((eq fn 'if)
-	   (cons fn
-	     (cons (byte-optimize-form (nth 1 form) nil)
-	       (cons
-		(byte-optimize-form (nth 2 form) for-effect)
-		(byte-optimize-body (nthcdr 3 form) for-effect)))))
-	  
-	  ((memq fn '(and or))  ; remember, and/or are control structures.
-	   ;; take forms off the back until we can't any more.
-	   ;; In the future it could conceivably be a problem that the
-	   ;; subexpressions of these forms are optimized in the reverse
-	   ;; order, but it's ok for now.
-	   (if for-effect
-	       (let ((backwards (reverse (cdr form))))
-		 (while (and backwards
-			     (null (setcar backwards
-					   (byte-optimize-form (car backwards)
-							       for-effect))))
-		   (setq backwards (cdr backwards)))
-		 (if (and (cdr form) (null backwards))
-		     (byte-compile-log
-		      "  all subforms of %s called for effect; deleted" form))
-		 (and backwards
-		      (cons fn (nreverse backwards))))
-	     (cons fn (mapcar 'byte-optimize-form (cdr form)))))
-
-	  ((eq fn 'interactive)
-	   (byte-compile-warn "misplaced interactive spec: %s"
-			      (prin1-to-string form))
-	   nil)
-	  
-	  ((memq fn '(defun defmacro function
-		      condition-case save-window-excursion))
-	   ;; These forms are compiled as constants or by breaking out
-	   ;; all the subexpressions and compiling them separately.
-	   form)
-
-	  ((eq fn 'unwind-protect)
-	   ;; the "protected" part of an unwind-protect is compiled (and thus
-	   ;; optimized) as a top-level form, so don't do it here.  But the
-	   ;; non-protected part has the same for-effect status as the
-	   ;; unwind-protect itself.  (The protected part is always for effect,
-	   ;; but that isn't handled properly yet.)
-	   (cons fn
-		 (cons (byte-optimize-form (nth 1 form) for-effect)
-		       (cdr (cdr form)))))
-	   
-	  ((eq fn 'catch)
-	   ;; the body of a catch is compiled (and thus optimized) as a
-	   ;; top-level form, so don't do it here.  The tag is never
-	   ;; for-effect.  The body should have the same for-effect status
-	   ;; as the catch form itself, but that isn't handled properly yet.
-	   (cons fn
-		 (cons (byte-optimize-form (nth 1 form) nil)
-		       (cdr (cdr form)))))
-
-	  ;; If optimization is on, this is the only place that macros are
-	  ;; expanded.  If optimization is off, then macroexpansion happens
-	  ;; in byte-compile-form.  Otherwise, the macros are already expanded
-	  ;; by the time that is reached.
-	  ((not (eq form
-		    (setq form (macroexpand form
-					    byte-compile-macro-environment))))
-	   (byte-optimize-form form for-effect))
-	  
-	  ((not (symbolp fn))
-	   (or (eq 'mocklisp (car-safe fn)) ; ha!
-	       (byte-compile-warn "%s is a malformed function"
-				  (prin1-to-string fn)))
-	   form)
-
-	  ((and for-effect (setq tmp (get fn 'side-effect-free))
-		(or byte-compile-delete-errors
-		    (eq tmp 'error-free)
-		    (progn
-		      (byte-compile-warn "%s called for effect"
-					 (prin1-to-string form))
-		      nil)))
-	   (byte-compile-log "  %s called for effect; deleted" fn)
-	   ;; appending a nil here might not be necessary, but it can't hurt.
-	   (byte-optimize-form
-	    (cons 'progn (append (cdr form) '(nil))) t))
-	  
-	  (t
-	   ;; Otherwise, no args can be considered to be for-effect,
-	   ;; even if the called function is for-effect, because we
-	   ;; don't know anything about that function.
-	   (cons fn (mapcar 'byte-optimize-form (cdr form)))))))
-
-
-(defun byte-optimize-form (form &optional for-effect)
-  "The source-level pass of the optimizer."
-  ;;
-  ;; First, optimize all sub-forms of this one.
-  (setq form (byte-optimize-form-code-walker form for-effect))
-  ;;
-  ;; after optimizing all subforms, optimize this form until it doesn't
-  ;; optimize any further.  This means that some forms will be passed through
-  ;; the optimizer many times, but that's necessary to make the for-effect
-  ;; processing do as much as possible.
-  ;;
-  (let (opt new)
-    (if (and (consp form)
-	     (symbolp (car form))
-	     (or (and for-effect
-		      ;; we don't have any of these yet, but we might.
-		      (setq opt (get (car form) 'byte-for-effect-optimizer)))
-		 (setq opt (get (car form) 'byte-optimizer)))
-	     (not (eq form (setq new (funcall opt form)))))
-	(progn
-;;	  (if (equal form new) (error "bogus optimizer -- %s" opt))
-	  (byte-compile-log "  %s\t==>\t%s" form new)
-	  (setq new (byte-optimize-form new for-effect))
-	  new)
-      form)))
-
-
-(defun byte-optimize-body (forms all-for-effect)
-  ;; optimize the cdr of a progn or implicit progn; all forms is a list of
-  ;; forms, all but the last of which are optimized with the assumption that
-  ;; they are being called for effect.  the last is for-effect as well if
-  ;; all-for-effect is true.  returns a new list of forms.
-  (let ((rest forms)
-	(result nil)
-	fe new)
-    (while rest
-      (setq fe (or all-for-effect (cdr rest)))
-      (setq new (and (car rest) (byte-optimize-form (car rest) fe)))
-      (if (or new (not fe))
-	  (setq result (cons new result)))
-      (setq rest (cdr rest)))
-    (nreverse result)))
-
-
-;;; some source-level optimizers
-;;;
-;;; when writing optimizers, be VERY careful that the optimizer returns
-;;; something not EQ to its argument if and ONLY if it has made a change.
-;;; This implies that you cannot simply destructively modify the list;
-;;; you must return something not EQ to it if you make an optimization.
-;;;
-;;; It is now safe to optimize code such that it introduces new bindings.
-
-;; I'd like this to be a defsubst, but let's not be self-referential...
-(defmacro byte-compile-trueconstp (form)
-  ;; Returns non-nil if FORM is a non-nil constant.
-  (` (cond ((consp (, form)) (eq (car (, form)) 'quote))
-	   ((not (symbolp (, form))))
-	   ((eq (, form) t)))))
-
-;; If the function is being called with constant numeric args,
-;; evaluate as much as possible at compile-time.  This optimizer 
-;; assumes that the function is associative, like + or *.
-(defun byte-optimize-associative-math (form)
-  (let ((args nil)
-	(constants nil)
-	(rest (cdr form)))
-    (while rest
-      (if (numberp (car rest))
-	  (setq constants (cons (car rest) constants))
-	  (setq args (cons (car rest) args)))
-      (setq rest (cdr rest)))
-    (if (cdr constants)
-	(if args
-	    (list (car form)
-		  (apply (car form) constants)
-		  (if (cdr args)
-		      (cons (car form) (nreverse args))
-		      (car args)))
-	    (apply (car form) constants))
-	form)))
-
-;; If the function is being called with constant numeric args,
-;; evaluate as much as possible at compile-time.  This optimizer
-;; assumes that the function satisfies
-;;   (op x1 x2 ... xn) == (op ...(op (op x1 x2) x3) ...xn)
-;; like - and /.
-(defun byte-optimize-nonassociative-math (form)
-  (if (or (not (numberp (car (cdr form))))
-	  (not (numberp (car (cdr (cdr form))))))
-      form
-    (let ((constant (car (cdr form)))
-	  (rest (cdr (cdr form))))
-      (while (numberp (car rest))
-	(setq constant (funcall (car form) constant (car rest))
-	      rest (cdr rest)))
-      (if rest
-	  (cons (car form) (cons constant rest))
-	  constant))))
-
-;;(defun byte-optimize-associative-two-args-math (form)
-;;  (setq form (byte-optimize-associative-math form))
-;;  (if (consp form)
-;;      (byte-optimize-two-args-left form)
-;;      form))
-
-;;(defun byte-optimize-nonassociative-two-args-math (form)
-;;  (setq form (byte-optimize-nonassociative-math form))
-;;  (if (consp form)
-;;      (byte-optimize-two-args-right form)
-;;      form))
-
-(defun byte-optimize-approx-equal (x y)
-  (< (* (abs (- x y)) 100) (abs (+ x y))))
-
-;; Collect all the constants from FORM, after the STARTth arg,
-;; and apply FUN to them to make one argument at the end.
-;; For functions that can handle floats, that optimization
-;; can be incorrect because reordering can cause an overflow
-;; that would otherwise be avoided by encountering an arg that is a float.
-;; We avoid this problem by (1) not moving float constants and
-;; (2) not moving anything if it would cause an overflow.
-(defun byte-optimize-delay-constants-math (form start fun)
-  ;; Merge all FORM's constants from number START, call FUN on them
-  ;; and put the result at the end.
-  (let ((rest (nthcdr (1- start) form))
-	(orig form)
-	;; t means we must check for overflow.
-	(overflow (memq fun '(+ *))))
-    (while (cdr (setq rest (cdr rest)))
-      (if (integerp (car rest))
-	  (let (constants)
-	    (setq form (copy-sequence form)
-		  rest (nthcdr (1- start) form))
-	    (while (setq rest (cdr rest))
-	      (cond ((integerp (car rest))
-		     (setq constants (cons (car rest) constants))
-		     (setcar rest nil))))
-	    ;; If necessary, check now for overflow
-	    ;; that might be caused by reordering.
-	    (if (and overflow
-		     ;; We have overflow if the result of doing the arithmetic
-		     ;; on floats is not even close to the result
-		     ;; of doing it on integers.
-		     (not (byte-optimize-approx-equal
-			    (apply fun (mapcar 'float constants))
-			    (float (apply fun constants)))))
-		(setq form orig)
-	      (setq form (nconc (delq nil form)
-				(list (apply fun (nreverse constants)))))))))
-    form))
-
-(defun byte-optimize-plus (form)
-  (setq form (byte-optimize-delay-constants-math form 1 '+))
-  (if (memq 0 form) (setq form (delq 0 (copy-sequence form))))
-  ;;(setq form (byte-optimize-associative-two-args-math form))
-  (cond ((null (cdr form))
-	 (condition-case ()
-	     (eval form)
-	   (error form)))
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker).
-;;	((null (cdr (cdr form))) (nth 1 form))
-	(t form)))
-
-(defun byte-optimize-minus (form)
-  ;; Put constants at the end, except the last constant.
-  (setq form (byte-optimize-delay-constants-math form 2 '+))
-  ;; Now only first and last element can be a number.
-  (let ((last (car (reverse (nthcdr 3 form)))))
-    (cond ((eq 0 last)
-	   ;; (- x y ... 0)  --> (- x y ...)
-	   (setq form (copy-sequence form))
-	   (setcdr (cdr (cdr form)) (delq 0 (nthcdr 3 form))))
-	  ;; If form is (- CONST foo... CONST), merge first and last.
-	  ((and (numberp (nth 1 form))
-		(numberp last))
-	   (setq form (nconc (list '- (- (nth 1 form) last) (nth 2 form))
-			     (delq last (copy-sequence (nthcdr 3 form))))))))
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker).
-;;;  (if (eq (nth 2 form) 0)
-;;;      (nth 1 form)			; (- x 0)  -->  x
-    (byte-optimize-predicate
-     (if (and (null (cdr (cdr (cdr form))))
-	      (eq (nth 1 form) 0))	; (- 0 x)  -->  (- x)
-	 (cons (car form) (cdr (cdr form)))
-       form))
-;;;    )
-  )
-
-(defun byte-optimize-multiply (form)
-  (setq form (byte-optimize-delay-constants-math form 1 '*))
-  ;; If there is a constant in FORM, it is now the last element.
-  (cond ((null (cdr form)) 1)
-;;; It is not safe to delete the function entirely
-;;; (actually, it would be safe if we know the sole arg
-;;; is not a marker or if it appears in other arithmetic).
-;;;	((null (cdr (cdr form))) (nth 1 form))
-	((let ((last (car (reverse form))))
-	   (cond ((eq 0 last)  (cons 'progn (cdr form)))
-		 ((eq 1 last)  (delq 1 (copy-sequence form)))
-		 ((eq -1 last) (list '- (delq -1 (copy-sequence form))))
-		 ((and (eq 2 last)
-		       (memq t (mapcar 'symbolp (cdr form))))
-		  (prog1 (setq form (delq 2 (copy-sequence form)))
-		    (while (not (symbolp (car (setq form (cdr form))))))
-		    (setcar form (list '+ (car form) (car form)))))
-		 (form))))))
-
-(defsubst byte-compile-butlast (form)
-  (nreverse (cdr (reverse form))))
-
-(defun byte-optimize-divide (form)
-  (setq form (byte-optimize-delay-constants-math form 2 '*))
-  (let ((last (car (reverse (cdr (cdr form))))))
-    (if (numberp last)
-	(cond ((= (length form) 3)
-	       (if (and (numberp (nth 1 form))
-			(not (zerop last))
-			(condition-case nil
-			    (/ (nth 1 form) last)
-			  (error nil)))
-		   (setq form (list 'progn (/ (nth 1 form) last)))))
-	      ((= last 1)
-	       (setq form (byte-compile-butlast form)))
-	      ((numberp (nth 1 form))
-	       (setq form (cons (car form)
-				(cons (/ (nth 1 form) last)
-				      (byte-compile-butlast (cdr (cdr form)))))
-		     last nil))))
-    (cond 
-;;;	  ((null (cdr (cdr form)))
-;;;	   (nth 1 form))
-	  ((eq (nth 1 form) 0)
-	   (append '(progn) (cdr (cdr form)) '(0)))
-	  ((eq last -1)
-	   (list '- (if (nthcdr 3 form)
-			(byte-compile-butlast form)
-		      (nth 1 form))))
-	  (form))))
-
-(defun byte-optimize-logmumble (form)
-  (setq form (byte-optimize-delay-constants-math form 1 (car form)))
-  (byte-optimize-predicate
-   (cond ((memq 0 form)
-	  (setq form (if (eq (car form) 'logand)
-			 (cons 'progn (cdr form))
-		       (delq 0 (copy-sequence form)))))
-	 ((and (eq (car-safe form) 'logior)
-	       (memq -1 form))
-	  (cons 'progn (cdr form)))
-	 (form))))
-
-
-(defun byte-optimize-binary-predicate (form)
-  (if (byte-compile-constp (nth 1 form))
-      (if (byte-compile-constp (nth 2 form))
-	  (condition-case ()
-	      (list 'quote (eval form))
-	    (error form))
-	;; This can enable some lapcode optimizations.
-	(list (car form) (nth 2 form) (nth 1 form)))
-    form))
-
-(defun byte-optimize-predicate (form)
-  (let ((ok t)
-	(rest (cdr form)))
-    (while (and rest ok)
-      (setq ok (byte-compile-constp (car rest))
-	    rest (cdr rest)))
-    (if ok
-	(condition-case ()
-	    (list 'quote (eval form))
-	  (error form))
-	form)))
-
-(defun byte-optimize-identity (form)
-  (if (and (cdr form) (null (cdr (cdr form))))
-      (nth 1 form)
-    (byte-compile-warn "identity called with %d arg%s, but requires 1"
-		       (length (cdr form))
-		       (if (= 1 (length (cdr form))) "" "s"))
-    form))
-
-(put 'identity 'byte-optimizer 'byte-optimize-identity)
-
-(put '+   'byte-optimizer 'byte-optimize-plus)
-(put '*   'byte-optimizer 'byte-optimize-multiply)
-(put '-   'byte-optimizer 'byte-optimize-minus)
-(put '/   'byte-optimizer 'byte-optimize-divide)
-(put 'max 'byte-optimizer 'byte-optimize-associative-math)
-(put 'min 'byte-optimizer 'byte-optimize-associative-math)
-
-(put '=   'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'eq  'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'eql 'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'equal   'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'string= 'byte-optimizer 'byte-optimize-binary-predicate)
-(put 'string-equal 'byte-optimizer 'byte-optimize-binary-predicate)
-
-(put '<   'byte-optimizer 'byte-optimize-predicate)
-(put '>   'byte-optimizer 'byte-optimize-predicate)
-(put '<=  'byte-optimizer 'byte-optimize-predicate)
-(put '>=  'byte-optimizer 'byte-optimize-predicate)
-(put '1+  'byte-optimizer 'byte-optimize-predicate)
-(put '1-  'byte-optimizer 'byte-optimize-predicate)
-(put 'not 'byte-optimizer 'byte-optimize-predicate)
-(put 'null  'byte-optimizer 'byte-optimize-predicate)
-(put 'memq  'byte-optimizer 'byte-optimize-predicate)
-(put 'consp 'byte-optimizer 'byte-optimize-predicate)
-(put 'listp 'byte-optimizer 'byte-optimize-predicate)
-(put 'symbolp 'byte-optimizer 'byte-optimize-predicate)
-(put 'stringp 'byte-optimizer 'byte-optimize-predicate)
-(put 'string< 'byte-optimizer 'byte-optimize-predicate)
-(put 'string-lessp 'byte-optimizer 'byte-optimize-predicate)
-
-(put 'logand 'byte-optimizer 'byte-optimize-logmumble)
-(put 'logior 'byte-optimizer 'byte-optimize-logmumble)
-(put 'logxor 'byte-optimizer 'byte-optimize-logmumble)
-(put 'lognot 'byte-optimizer 'byte-optimize-predicate)
-
-(put 'car 'byte-optimizer 'byte-optimize-predicate)
-(put 'cdr 'byte-optimizer 'byte-optimize-predicate)
-(put 'car-safe 'byte-optimizer 'byte-optimize-predicate)
-(put 'cdr-safe 'byte-optimizer 'byte-optimize-predicate)
-
-
-;; I'm not convinced that this is necessary.  Doesn't the optimizer loop 
-;; take care of this? - Jamie
-;; I think this may some times be necessary to reduce ie (quote 5) to 5,
-;; so arithmetic optimizers recognize the numeric constant.  - Hallvard
-(put 'quote 'byte-optimizer 'byte-optimize-quote)
-(defun byte-optimize-quote (form)
-  (if (or (consp (nth 1 form))
-	  (and (symbolp (nth 1 form))
-	       (not (memq (nth 1 form) '(nil t)))))
-      form
-    (nth 1 form)))
-
-(defun byte-optimize-zerop (form)
-  (cond ((numberp (nth 1 form))
-	 (eval form))
-	(byte-compile-delete-errors
-	 (list '= (nth 1 form) 0))
-	(form)))
-
-(put 'zerop 'byte-optimizer 'byte-optimize-zerop)
-
-(defun byte-optimize-and (form)
-  ;; Simplify if less than 2 args.
-  ;; if there is a literal nil in the args to `and', throw it and following
-  ;; forms away, and surround the `and' with (progn ... nil).
-  (cond ((null (cdr form)))
-	((memq nil form)
-	 (list 'progn
-	       (byte-optimize-and
-		(prog1 (setq form (copy-sequence form))
-		  (while (nth 1 form)
-		    (setq form (cdr form)))
-		  (setcdr form nil)))
-	       nil))
-	((null (cdr (cdr form)))
-	 (nth 1 form))
-	((byte-optimize-predicate form))))
-
-(defun byte-optimize-or (form)
-  ;; Throw away nil's, and simplify if less than 2 args.
-  ;; If there is a literal non-nil constant in the args to `or', throw away all
-  ;; following forms.
-  (if (memq nil form)
-      (setq form (delq nil (copy-sequence form))))
-  (let ((rest form))
-    (while (cdr (setq rest (cdr rest)))
-      (if (byte-compile-trueconstp (car rest))
-	  (setq form (copy-sequence form)
-		rest (setcdr (memq (car rest) form) nil))))
-    (if (cdr (cdr form))
-	(byte-optimize-predicate form)
-      (nth 1 form))))
-
-(defun byte-optimize-cond (form)
-  ;; if any clauses have a literal nil as their test, throw them away.
-  ;; if any clause has a literal non-nil constant as its test, throw
-  ;; away all following clauses.
-  (let (rest)
-    ;; This must be first, to reduce (cond (t ...) (nil)) to (progn t ...)
-    (while (setq rest (assq nil (cdr form)))
-      (setq form (delq rest (copy-sequence form))))
-    (if (memq nil (cdr form))
-	(setq form (delq nil (copy-sequence form))))
-    (setq rest form)
-    (while (setq rest (cdr rest))
-      (cond ((byte-compile-trueconstp (car-safe (car rest)))
-	     (cond ((eq rest (cdr form))
-		    (setq form
-			  (if (cdr (car rest))
-			      (if (cdr (cdr (car rest)))
-				  (cons 'progn (cdr (car rest)))
-				(nth 1 (car rest)))
-			    (car (car rest)))))
-		   ((cdr rest)
-		    (setq form (copy-sequence form))
-		    (setcdr (memq (car rest) form) nil)))
-	     (setq rest nil)))))
-  ;;
-  ;; Turn (cond (( <x> )) ... ) into (or <x> (cond ... ))
-  (if (eq 'cond (car-safe form))
-      (let ((clauses (cdr form)))
-	(if (and (consp (car clauses))
-		 (null (cdr (car clauses))))
-	    (list 'or (car (car clauses))
-		  (byte-optimize-cond
-		   (cons (car form) (cdr (cdr form)))))
-	  form))
-    form))
-
-(defun byte-optimize-if (form)
-  ;; (if <true-constant> <then> <else...>) ==> <then>
-  ;; (if <false-constant> <then> <else...>) ==> (progn <else...>)
-  ;; (if <test> nil <else...>) ==> (if (not <test>) (progn <else...>))
-  ;; (if <test> <then> nil) ==> (if <test> <then>)
-  (let ((clause (nth 1 form)))
-    (cond ((byte-compile-trueconstp clause)
-	   (nth 2 form))
-	  ((null clause)
-	   (if (nthcdr 4 form)
-	       (cons 'progn (nthcdr 3 form))
-	     (nth 3 form)))
-	  ((nth 2 form)
-	   (if (equal '(nil) (nthcdr 3 form))
-	       (list 'if clause (nth 2 form))
-	     form))
-	  ((or (nth 3 form) (nthcdr 4 form))
-	   (list 'if
-		 ;; Don't make a double negative;
-		 ;; instead, take away the one that is there.
-		 (if (and (consp clause) (memq (car clause) '(not null))
-			  (= (length clause) 2)) ; (not xxxx) or (not (xxxx))
-		     (nth 1 clause)
-		   (list 'not clause))
-		 (if (nthcdr 4 form)
-		     (cons 'progn (nthcdr 3 form))
-		   (nth 3 form))))
-	  (t
-	   (list 'progn clause nil)))))
-
-(defun byte-optimize-while (form)
-  (if (nth 1 form)
-      form))
-
-(put 'and   'byte-optimizer 'byte-optimize-and)
-(put 'or    'byte-optimizer 'byte-optimize-or)
-(put 'cond  'byte-optimizer 'byte-optimize-cond)
-(put 'if    'byte-optimizer 'byte-optimize-if)
-(put 'while 'byte-optimizer 'byte-optimize-while)
-
-;; byte-compile-negation-optimizer lives in bytecomp.el
-(put '/= 'byte-optimizer 'byte-compile-negation-optimizer)
-(put 'atom 'byte-optimizer 'byte-compile-negation-optimizer)
-(put 'nlistp 'byte-optimizer 'byte-compile-negation-optimizer)
-
-
-(defun byte-optimize-funcall (form)
-  ;; (funcall '(lambda ...) ...) ==> ((lambda ...) ...)
-  ;; (funcall 'foo ...) ==> (foo ...)
-  (let ((fn (nth 1 form)))
-    (if (memq (car-safe fn) '(quote function))
-	(cons (nth 1 fn) (cdr (cdr form)))
-	form)))
-
-(defun byte-optimize-apply (form)
-  ;; If the last arg is a literal constant, turn this into a funcall.
-  ;; The funcall optimizer can then transform (funcall 'foo ...) -> (foo ...).
-  (let ((fn (nth 1 form))
-	(last (nth (1- (length form)) form))) ; I think this really is fastest
-    (or (if (or (null last)
-		(eq (car-safe last) 'quote))
-	    (if (listp (nth 1 last))
-		(let ((butlast (nreverse (cdr (reverse (cdr (cdr form)))))))
-		  (nconc (list 'funcall fn) butlast
-			 (mapcar '(lambda (x) (list 'quote x)) (nth 1 last))))
-	      (byte-compile-warn
-	       "last arg to apply can't be a literal atom: %s"
-	       (prin1-to-string last))
-	      nil))
-	form)))
-
-(put 'funcall 'byte-optimizer 'byte-optimize-funcall)
-(put 'apply   'byte-optimizer 'byte-optimize-apply)
-
-
-(put 'let 'byte-optimizer 'byte-optimize-letX)
-(put 'let* 'byte-optimizer 'byte-optimize-letX)
-(defun byte-optimize-letX (form)
-  (cond ((null (nth 1 form))
-	 ;; No bindings
-	 (cons 'progn (cdr (cdr form))))
-	((or (nth 2 form) (nthcdr 3 form))
-	 form)
-	 ;; The body is nil
-	((eq (car form) 'let)
-	 (append '(progn) (mapcar 'car-safe (mapcar 'cdr-safe (nth 1 form)))
-		 '(nil)))
-	(t
-	 (let ((binds (reverse (nth 1 form))))
-	   (list 'let* (reverse (cdr binds)) (nth 1 (car binds)) nil)))))
-
-
-(put 'nth 'byte-optimizer 'byte-optimize-nth)
-(defun byte-optimize-nth (form)
-  (if (and (= (safe-length form) 3) (memq (nth 1 form) '(0 1)))
-      (list 'car (if (zerop (nth 1 form))
-		     (nth 2 form)
-		   (list 'cdr (nth 2 form))))
-    (byte-optimize-predicate form)))
-
-(put 'nthcdr 'byte-optimizer 'byte-optimize-nthcdr)
-(defun byte-optimize-nthcdr (form)
-  (if (and (= (safe-length form) 3) (not (memq (nth 1 form) '(0 1 2))))
-      (byte-optimize-predicate form)
-    (let ((count (nth 1 form)))
-      (setq form (nth 2 form))
-      (while (>= (setq count (1- count)) 0)
-	(setq form (list 'cdr form)))
-      form)))
-
-;;; enumerating those functions which need not be called if the returned 
-;;; value is not used.  That is, something like
-;;;    (progn (list (something-with-side-effects) (yow))
-;;;           (foo))
-;;; may safely be turned into
-;;;    (progn (progn (something-with-side-effects) (yow))
-;;;           (foo))
-;;; Further optimizations will turn (progn (list 1 2 3) 'foo) into 'foo.
-
-;;; I wonder if I missed any :-\)
-(let ((side-effect-free-fns
-       '(% * + - / /= 1+ 1- < <= = > >= abs acos append aref ash asin atan
-	 assoc assq
-	 boundp buffer-file-name buffer-local-variables buffer-modified-p
-	 buffer-substring
-	 capitalize car-less-than-car car cdr ceiling concat coordinates-in-window-p
-	 copy-marker cos count-lines
-	 default-boundp default-value documentation downcase
-	 elt exp expt fboundp featurep
-	 file-directory-p file-exists-p file-locked-p file-name-absolute-p
-	 file-newer-than-file-p file-readable-p file-symlink-p file-writable-p
-	 float floor format
-	 get get-buffer get-buffer-window getenv get-file-buffer
-	 int-to-string
-	 length log log10 logand logb logior lognot logxor lsh
-	 marker-buffer max member memq min mod
-	 next-window nth nthcdr number-to-string
-	 parse-colon-path previous-window
-	 radians-to-degrees rassq regexp-quote reverse round
-	 sin sqrt string< string= string-equal string-lessp string-to-char
-	 string-to-int string-to-number substring symbol-plist
-	 tan upcase user-variable-p vconcat
-	 window-buffer window-dedicated-p window-edges window-height
-	 window-hscroll window-minibuffer-p window-width
-	 zerop))
-      (side-effect-and-error-free-fns
-       '(arrayp atom
-	 bobp bolp buffer-end buffer-list buffer-size buffer-string bufferp
-	 car-safe case-table-p cdr-safe char-or-string-p commandp cons consp
-	 current-buffer
-	 dot dot-marker eobp eolp eq eql equal eventp floatp framep
-	 get-largest-window get-lru-window
-	 identity ignore integerp integer-or-marker-p interactive-p
-	 invocation-directory invocation-name
-	 keymapp list listp
-	 make-marker mark mark-marker markerp memory-limit minibuffer-window
-	 mouse-movement-p
-	 natnump nlistp not null number-or-marker-p numberp
-	 one-window-p overlayp
-	 point point-marker point-min point-max processp
-	 selected-window sequencep stringp subrp symbolp syntax-table-p
-	 user-full-name user-login-name user-original-login-name
-	 user-real-login-name user-real-uid user-uid
-	 vector vectorp
-	 window-configuration-p window-live-p windowp)))
-  (while side-effect-free-fns
-    (put (car side-effect-free-fns) 'side-effect-free t)
-    (setq side-effect-free-fns (cdr side-effect-free-fns)))
-  (while side-effect-and-error-free-fns
-    (put (car side-effect-and-error-free-fns) 'side-effect-free 'error-free)
-    (setq side-effect-and-error-free-fns (cdr side-effect-and-error-free-fns)))
-  nil)
-
-
-(defun byte-compile-splice-in-already-compiled-code (form)
-  ;; form is (byte-code "..." [...] n)
-  (if (not (memq byte-optimize '(t lap)))
-      (byte-compile-normal-call form)
-    (byte-inline-lapcode
-     (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t))
-    (setq byte-compile-maxdepth (max (+ byte-compile-depth (nth 3 form))
-				     byte-compile-maxdepth))
-    (setq byte-compile-depth (1+ byte-compile-depth))))
-
-(put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code)
-
-
-(defconst byte-constref-ops
-  '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind))
-
-;;; This function extracts the bitfields from variable-length opcodes.
-;;; Originally defined in disass.el (which no longer uses it.)
-
-(defun disassemble-offset ()
-  "Don't call this!"
-  ;; fetch and return the offset for the current opcode.
-  ;; return NIL if this opcode has no offset
-  ;; OP, PTR and BYTES are used and set dynamically
-  (defvar op)
-  (defvar ptr)
-  (defvar bytes)
-  (cond ((< op byte-nth)
-	 (let ((tem (logand op 7)))
-	   (setq op (logand op 248))
-	   (cond ((eq tem 6)
-		  (setq ptr (1+ ptr))	;offset in next byte
-		  (aref bytes ptr))
-		 ((eq tem 7)
-		  (setq ptr (1+ ptr))	;offset in next 2 bytes
-		  (+ (aref bytes ptr)
-		     (progn (setq ptr (1+ ptr))
-			    (lsh (aref bytes ptr) 8))))
-		 (t tem))))		;offset was in opcode
-	((>= op byte-constant)
-	 (prog1 (- op byte-constant)	;offset in opcode
-	   (setq op byte-constant)))
-	((and (>= op byte-constant2)
-	      (<= op byte-goto-if-not-nil-else-pop))
-	 (setq ptr (1+ ptr))		;offset in next 2 bytes
-	 (+ (aref bytes ptr)
-	    (progn (setq ptr (1+ ptr))
-		   (lsh (aref bytes ptr) 8))))
-	((and (>= op byte-listN)
-	      (<= op byte-insertN))
-	 (setq ptr (1+ ptr))		;offset in next byte
-	 (aref bytes ptr))))
-
-
-;;; This de-compiler is used for inline expansion of compiled functions,
-;;; and by the disassembler.
-;;;
-;;; This list contains numbers, which are pc values,
-;;; before each instruction.
-(defun byte-decompile-bytecode (bytes constvec)
-  "Turns BYTECODE into lapcode, referring to CONSTVEC."
-  (let ((byte-compile-constants nil)
-	(byte-compile-variables nil)
-	(byte-compile-tag-number 0))
-    (byte-decompile-bytecode-1 bytes constvec)))
-
-;; As byte-decompile-bytecode, but updates
-;; byte-compile-{constants, variables, tag-number}.
-;; If MAKE-SPLICEABLE is true, then `return' opcodes are replaced
-;; with `goto's destined for the end of the code.
-;; That is for use by the compiler.
-;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler.
-;; In that case, we put a pc value into the list
-;; before each insn (or its label).
-(defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable)
-  (let ((length (length bytes))
-	(ptr 0) optr tag tags op offset
-	lap tmp
-	endtag
-	(retcount 0))
-    (while (not (= ptr length))
-      (or make-spliceable
-	  (setq lap (cons ptr lap)))
-      (setq op (aref bytes ptr)
-	    optr ptr
-	    offset (disassemble-offset)) ; this does dynamic-scope magic
-      (setq op (aref byte-code-vector op))
-      (cond ((memq op byte-goto-ops)
-	     ;; it's a pc
-	     (setq offset
-		   (cdr (or (assq offset tags)
-			    (car (setq tags
-				       (cons (cons offset
-						   (byte-compile-make-tag))
-					     tags)))))))
-	    ((cond ((eq op 'byte-constant2) (setq op 'byte-constant) t)
-		   ((memq op byte-constref-ops)))
-	     (setq tmp (aref constvec offset)
-		   offset (if (eq op 'byte-constant)
-			      (byte-compile-get-constant tmp)
-			    (or (assq tmp byte-compile-variables)
-				(car (setq byte-compile-variables
-					   (cons (list tmp)
-						 byte-compile-variables)))))))
-	    ((and make-spliceable
-		  (eq op 'byte-return))
-	     (if (= ptr (1- length))
-		 (setq op nil)
-	       (setq offset (or endtag (setq endtag (byte-compile-make-tag)))
-		     op 'byte-goto))))
-      ;; lap = ( [ (pc . (op . arg)) ]* )
-      (setq lap (cons (cons optr (cons op (or offset 0)))
-		      lap))
-      (setq ptr (1+ ptr)))
-    ;; take off the dummy nil op that we replaced a trailing "return" with.
-    (let ((rest lap))
-      (while rest
-	(cond ((numberp (car rest)))
-	      ((setq tmp (assq (car (car rest)) tags))
-	       ;; this addr is jumped to
-	       (setcdr rest (cons (cons nil (cdr tmp))
-				  (cdr rest)))
-	       (setq tags (delq tmp tags))
-	       (setq rest (cdr rest))))
-	(setq rest (cdr rest))))
-    (if tags (error "optimizer error: missed tags %s" tags))
-    (if (null (car (cdr (car lap))))
-	(setq lap (cdr lap)))
-    (if endtag
-	(setq lap (cons (cons nil endtag) lap)))
-    ;; remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* )
-    (mapcar (function (lambda (elt)
-			(if (numberp elt)
-			    elt
-			  (cdr elt))))
-	    (nreverse lap))))
-
-
-;;; peephole optimizer
-
-(defconst byte-tagref-ops (cons 'TAG byte-goto-ops))
-
-(defconst byte-conditional-ops
-  '(byte-goto-if-nil byte-goto-if-not-nil byte-goto-if-nil-else-pop
-    byte-goto-if-not-nil-else-pop))
-
-(defconst byte-after-unbind-ops
-   '(byte-constant byte-dup
-     byte-symbolp byte-consp byte-stringp byte-listp byte-numberp byte-integerp
-     byte-eq byte-equal byte-not
-     byte-cons byte-list1 byte-list2	; byte-list3 byte-list4
-     byte-interactive-p)
-   ;; How about other side-effect-free-ops?  Is it safe to move an
-   ;; error invocation (such as from nth) out of an unwind-protect?
-   "Byte-codes that can be moved past an unbind.")
-
-(defconst byte-compile-side-effect-and-error-free-ops
-  '(byte-constant byte-dup byte-symbolp byte-consp byte-stringp byte-listp
-    byte-integerp byte-numberp byte-eq byte-equal byte-not byte-car-safe
-    byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
-    byte-point-min byte-following-char byte-preceding-char
-    byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
-    byte-current-buffer byte-interactive-p))
-
-(defconst byte-compile-side-effect-free-ops
-  (nconc 
-   '(byte-varref byte-nth byte-memq byte-car byte-cdr byte-length byte-aref
-     byte-symbol-value byte-get byte-concat2 byte-concat3 byte-sub1 byte-add1
-     byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
-     byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
-     byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt
-     byte-member byte-assq byte-quo byte-rem)
-   byte-compile-side-effect-and-error-free-ops))
-
-;;; This crock is because of the way DEFVAR_BOOL variables work.
-;;; Consider the code
-;;;
-;;;	(defun foo (flag)
-;;;	  (let ((old-pop-ups pop-up-windows)
-;;;		(pop-up-windows flag))
-;;;	    (cond ((not (eq pop-up-windows old-pop-ups))
-;;;		   (setq old-pop-ups pop-up-windows)
-;;;		   ...))))
-;;;
-;;; Uncompiled, old-pop-ups will always be set to nil or t, even if FLAG is
-;;; something else.  But if we optimize
-;;;
-;;;	varref flag
-;;;	varbind pop-up-windows
-;;;	varref pop-up-windows
-;;;	not
-;;; to
-;;;	varref flag
-;;;	dup
-;;;	varbind pop-up-windows
-;;;	not
-;;;
-;;; we break the program, because it will appear that pop-up-windows and 
-;;; old-pop-ups are not EQ when really they are.  So we have to know what
-;;; the BOOL variables are, and not perform this optimization on them.
-;;;
-(defconst byte-boolean-vars
-  '(abbrev-all-caps abbrevs-changed byte-metering-on
-    cannot-suspend completion-auto-help completion-ignore-case
-    cursor-in-echo-area debug-on-next-call debug-on-quit
-    delete-exited-processes enable-recursive-minibuffers
-    highlight-nonselected-windows indent-tabs-mode inhibit-local-menu-bar-menus
-    insert-default-directory inverse-video load-force-doc-strings
-    load-in-progress menu-prompting minibuffer-auto-raise
-    mode-line-inverse-video multiple-frames no-redraw-on-reenter noninteractive
-    parse-sexp-ignore-comments pop-up-frames pop-up-windows
-    print-escape-newlines system-uses-terminfo truncate-partial-width-windows
-    visible-bell vms-stmlf-recfm words-include-escapes)
-  "DEFVAR_BOOL variables.  Giving these any non-nil value sets them to t.
-If this does not enumerate all DEFVAR_BOOL variables, the byte-optimizer
-may generate incorrect code.")
-
-(defun byte-optimize-lapcode (lap &optional for-effect)
-  "Simple peephole optimizer.  LAP is both modified and returned."
-  (let (lap0 off0
-	lap1 off1
-	lap2 off2
-	(keep-going 'first-time)
-	(add-depth 0)
-	rest tmp tmp2 tmp3
-	(side-effect-free (if byte-compile-delete-errors
-			      byte-compile-side-effect-free-ops
-			    byte-compile-side-effect-and-error-free-ops)))
-    (while keep-going
-      (or (eq keep-going 'first-time)
-	  (byte-compile-log-lap "  ---- next pass"))
-      (setq rest lap
-	    keep-going nil)
-      (while rest
-	(setq lap0 (car rest)
-	      lap1 (nth 1 rest)
-	      lap2 (nth 2 rest))
-
-	;; You may notice that sequences like "dup varset discard" are
-	;; optimized but sequences like "dup varset TAG1: discard" are not.
-	;; You may be tempted to change this; resist that temptation.
-	(cond ;;
-	      ;; <side-effect-free> pop -->  <deleted>
-	      ;;  ...including:
-	      ;; const-X pop   -->  <deleted>
-	      ;; varref-X pop  -->  <deleted>
-	      ;; dup pop       -->  <deleted>
-	      ;;
-	      ((and (eq 'byte-discard (car lap1))
-		    (memq (car lap0) side-effect-free))
-	       (setq keep-going t)
-	       (setq tmp (aref byte-stack+-info (symbol-value (car lap0))))
-	       (setq rest (cdr rest))
-	       (cond ((= tmp 1)
-		      (byte-compile-log-lap
- 		       "  %s discard\t-->\t<deleted>" lap0)
-		      (setq lap (delq lap0 (delq lap1 lap))))
-		     ((= tmp 0)
-		      (byte-compile-log-lap
-		       "  %s discard\t-->\t<deleted> discard" lap0)
-		      (setq lap (delq lap0 lap)))
-		     ((= tmp -1)
-		      (byte-compile-log-lap
-		       "  %s discard\t-->\tdiscard discard" lap0)
-		      (setcar lap0 'byte-discard)
-		      (setcdr lap0 0))
-		     ((error "Optimizer error: too much on the stack"))))
-	      ;;
-	      ;; goto*-X X:  -->  X:
-	      ;;
-	      ((and (memq (car lap0) byte-goto-ops)
-		    (eq (cdr lap0) lap1))
-	       (cond ((eq (car lap0) 'byte-goto)
-		      (setq lap (delq lap0 lap))
-		      (setq tmp "<deleted>"))
-		     ((memq (car lap0) byte-goto-always-pop-ops)
-		      (setcar lap0 (setq tmp 'byte-discard))
-		      (setcdr lap0 0))
-		     ((error "Depth conflict at tag %d" (nth 2 lap0))))
-	       (and (memq byte-optimize-log '(t byte))
-		    (byte-compile-log "  (goto %s) %s:\t-->\t%s %s:"
-				      (nth 1 lap1) (nth 1 lap1)
-				      tmp (nth 1 lap1)))
-	       (setq keep-going t))
-	      ;;
-	      ;; varset-X varref-X  -->  dup varset-X
-	      ;; varbind-X varref-X  -->  dup varbind-X
-	      ;; const/dup varset-X varref-X --> const/dup varset-X const/dup
-	      ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
-	      ;; The latter two can enable other optimizations.
-	      ;;
-	      ((and (eq 'byte-varref (car lap2))
-		    (eq (cdr lap1) (cdr lap2))
-		    (memq (car lap1) '(byte-varset byte-varbind)))
-	       (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars))
-			(not (eq (car lap0) 'byte-constant)))
-		   nil
-		 (setq keep-going t)
-		 (if (memq (car lap0) '(byte-constant byte-dup))
-		     (progn
-		       (setq tmp (if (or (not tmp)
-					 (memq (car (cdr lap0)) '(nil t)))
-				     (cdr lap0)
-				   (byte-compile-get-constant t)))
-		       (byte-compile-log-lap "  %s %s %s\t-->\t%s %s %s"
-					     lap0 lap1 lap2 lap0 lap1
-					     (cons (car lap0) tmp))
-		       (setcar lap2 (car lap0))
-		       (setcdr lap2 tmp))
-		   (byte-compile-log-lap "  %s %s\t-->\tdup %s" lap1 lap2 lap1)
-		   (setcar lap2 (car lap1))
-		   (setcar lap1 'byte-dup)
-		   (setcdr lap1 0)
-		   ;; The stack depth gets locally increased, so we will
-		   ;; increase maxdepth in case depth = maxdepth here.
-		   ;; This can cause the third argument to byte-code to
-		   ;; be larger than necessary.
-		   (setq add-depth 1))))
-	      ;;
-	      ;; dup varset-X discard  -->  varset-X
-	      ;; dup varbind-X discard  -->  varbind-X
-	      ;; (the varbind variant can emerge from other optimizations)
-	      ;;
-	      ((and (eq 'byte-dup (car lap0))
-		    (eq 'byte-discard (car lap2))
-		    (memq (car lap1) '(byte-varset byte-varbind)))
-	       (byte-compile-log-lap "  dup %s discard\t-->\t%s" lap1 lap1)
-	       (setq keep-going t
-		     rest (cdr rest))
-	       (setq lap (delq lap0 (delq lap2 lap))))
-	      ;;
-	      ;; not goto-X-if-nil              -->  goto-X-if-non-nil
-	      ;; not goto-X-if-non-nil          -->  goto-X-if-nil
-	      ;;
-	      ;; it is wrong to do the same thing for the -else-pop variants.
-	      ;;
-	      ((and (eq 'byte-not (car lap0))
-		    (or (eq 'byte-goto-if-nil (car lap1))
-			(eq 'byte-goto-if-not-nil (car lap1))))
-	       (byte-compile-log-lap "  not %s\t-->\t%s"
-				     lap1
-				     (cons
-				      (if (eq (car lap1) 'byte-goto-if-nil)
-					  'byte-goto-if-not-nil
-					'byte-goto-if-nil)
-				      (cdr lap1)))
-	       (setcar lap1 (if (eq (car lap1) 'byte-goto-if-nil)
-				'byte-goto-if-not-nil
-				'byte-goto-if-nil))
-	       (setq lap (delq lap0 lap))
-	       (setq keep-going t))
-	      ;;
-	      ;; goto-X-if-nil     goto-Y X:  -->  goto-Y-if-non-nil X:
-	      ;; goto-X-if-non-nil goto-Y X:  -->  goto-Y-if-nil     X:
-	      ;;
-	      ;; it is wrong to do the same thing for the -else-pop variants.
-	      ;; 
-	      ((and (or (eq 'byte-goto-if-nil (car lap0))
-			(eq 'byte-goto-if-not-nil (car lap0)))	; gotoX
-		    (eq 'byte-goto (car lap1))			; gotoY
-		    (eq (cdr lap0) lap2))			; TAG X
-	       (let ((inverse (if (eq 'byte-goto-if-nil (car lap0))
-				  'byte-goto-if-not-nil 'byte-goto-if-nil)))
-		 (byte-compile-log-lap "  %s %s %s:\t-->\t%s %s:"
-				       lap0 lap1 lap2
-				       (cons inverse (cdr lap1)) lap2)
-		 (setq lap (delq lap0 lap))
-		 (setcar lap1 inverse)
-		 (setq keep-going t)))
-	      ;;
-	      ;; const goto-if-* --> whatever
-	      ;;
-	      ((and (eq 'byte-constant (car lap0))
-		    (memq (car lap1) byte-conditional-ops))
-	       (cond ((if (or (eq (car lap1) 'byte-goto-if-nil)
-			      (eq (car lap1) 'byte-goto-if-nil-else-pop))
-			  (car (cdr lap0))
-			(not (car (cdr lap0))))
-		      (byte-compile-log-lap "  %s %s\t-->\t<deleted>"
-					    lap0 lap1)
-		      (setq rest (cdr rest)
-			    lap (delq lap0 (delq lap1 lap))))
-		     (t
-		      (if (memq (car lap1) byte-goto-always-pop-ops)
-			  (progn
-			    (byte-compile-log-lap "  %s %s\t-->\t%s"
-			     lap0 lap1 (cons 'byte-goto (cdr lap1)))
-			    (setq lap (delq lap0 lap)))
-			(byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1
-			 (cons 'byte-goto (cdr lap1))))
-		      (setcar lap1 'byte-goto)))
-	       (setq keep-going t))
-	      ;;
-	      ;; varref-X varref-X  -->  varref-X dup
-	      ;; varref-X [dup ...] varref-X  -->  varref-X [dup ...] dup
-	      ;; We don't optimize the const-X variations on this here,
-	      ;; because that would inhibit some goto optimizations; we
-	      ;; optimize the const-X case after all other optimizations.
-	      ;;
-	      ((and (eq 'byte-varref (car lap0))
-		    (progn
-		      (setq tmp (cdr rest))
-		      (while (eq (car (car tmp)) 'byte-dup)
-			(setq tmp (cdr tmp)))
-		      t)
-		    (eq (cdr lap0) (cdr (car tmp)))
-		    (eq 'byte-varref (car (car tmp))))
-	       (if (memq byte-optimize-log '(t byte))
-		   (let ((str ""))
-		     (setq tmp2 (cdr rest))
-		     (while (not (eq tmp tmp2))
-		       (setq tmp2 (cdr tmp2)
-			     str (concat str " dup")))
-		     (byte-compile-log-lap "  %s%s %s\t-->\t%s%s dup"
-					   lap0 str lap0 lap0 str)))
-	       (setq keep-going t)
-	       (setcar (car tmp) 'byte-dup)
-	       (setcdr (car tmp) 0)
-	       (setq rest tmp))
-	      ;;
-	      ;; TAG1: TAG2: --> TAG1: <deleted>
-	      ;; (and other references to TAG2 are replaced with TAG1)
-	      ;;
-	      ((and (eq (car lap0) 'TAG)
-		    (eq (car lap1) 'TAG))
-	       (and (memq byte-optimize-log '(t byte))
-		    (byte-compile-log "  adjacent tags %d and %d merged"
-				      (nth 1 lap1) (nth 1 lap0)))
-	       (setq tmp3 lap)
-	       (while (setq tmp2 (rassq lap0 tmp3))
-		 (setcdr tmp2 lap1)
-		 (setq tmp3 (cdr (memq tmp2 tmp3))))
-	       (setq lap (delq lap0 lap)
-		     keep-going t))
-	      ;;
-	      ;; unused-TAG: --> <deleted>
-	      ;;
-	      ((and (eq 'TAG (car lap0))
-		    (not (rassq lap0 lap)))
-	       (and (memq byte-optimize-log '(t byte))
-		    (byte-compile-log "  unused tag %d removed" (nth 1 lap0)))
-	       (setq lap (delq lap0 lap)
-		     keep-going t))
-	      ;;
-	      ;; goto   ... --> goto   <delete until TAG or end>
-	      ;; return ... --> return <delete until TAG or end>
-	      ;;
-	      ((and (memq (car lap0) '(byte-goto byte-return))
-		    (not (memq (car lap1) '(TAG nil))))
-	       (setq tmp rest)
-	       (let ((i 0)
-		     (opt-p (memq byte-optimize-log '(t lap)))
-		     str deleted)
-		 (while (and (setq tmp (cdr tmp))
-			     (not (eq 'TAG (car (car tmp)))))
-		   (if opt-p (setq deleted (cons (car tmp) deleted)
-				   str (concat str " %s")
-				   i (1+ i))))
-		 (if opt-p
-		     (let ((tagstr 
-			    (if (eq 'TAG (car (car tmp)))
-				(format "%d:" (car (cdr (car tmp))))
-			      (or (car tmp) ""))))
-		       (if (< i 6)
-			   (apply 'byte-compile-log-lap-1
-				  (concat "  %s" str
-					  " %s\t-->\t%s <deleted> %s")
-				  lap0
-				  (nconc (nreverse deleted)
-					 (list tagstr lap0 tagstr)))
-			 (byte-compile-log-lap
-			  "  %s <%d unreachable op%s> %s\t-->\t%s <deleted> %s"
-			  lap0 i (if (= i 1) "" "s")
-			  tagstr lap0 tagstr))))
-		 (rplacd rest tmp))
-	       (setq keep-going t))
-	      ;;
-	      ;; <safe-op> unbind --> unbind <safe-op>
-	      ;; (this may enable other optimizations.)
-	      ;;
-	      ((and (eq 'byte-unbind (car lap1))
-		    (memq (car lap0) byte-after-unbind-ops))
-	       (byte-compile-log-lap "  %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0)
-	       (setcar rest lap1)
-	       (setcar (cdr rest) lap0)
-	       (setq keep-going t))
-	      ;;
-	      ;; varbind-X unbind-N         -->  discard unbind-(N-1)
-	      ;; save-excursion unbind-N    -->  unbind-(N-1)
-	      ;; save-restriction unbind-N  -->  unbind-(N-1)
-	      ;;
-	      ((and (eq 'byte-unbind (car lap1))
-		    (memq (car lap0) '(byte-varbind byte-save-excursion
-				       byte-save-restriction))
-		    (< 0 (cdr lap1)))
-	       (if (zerop (setcdr lap1 (1- (cdr lap1))))
-		   (delq lap1 rest))
-	       (if (eq (car lap0) 'byte-varbind)
-		   (setcar rest (cons 'byte-discard 0))
-		 (setq lap (delq lap0 lap)))
-	       (byte-compile-log-lap "  %s %s\t-->\t%s %s"
-		 lap0 (cons (car lap1) (1+ (cdr lap1)))
-		 (if (eq (car lap0) 'byte-varbind)
-		     (car rest)
-		   (car (cdr rest)))
-		 (if (and (/= 0 (cdr lap1))
-			  (eq (car lap0) 'byte-varbind))
-		     (car (cdr rest))
-		   ""))
-	       (setq keep-going t))
-	      ;;
-	      ;; goto*-X ... X: goto-Y  --> goto*-Y
-	      ;; goto-X ...  X: return  --> return
-	      ;;
-	      ((and (memq (car lap0) byte-goto-ops)
-		    (memq (car (setq tmp (nth 1 (memq (cdr lap0) lap))))
-			  '(byte-goto byte-return)))
-	       (cond ((and (not (eq tmp lap0))
-			   (or (eq (car lap0) 'byte-goto)
-			       (eq (car tmp) 'byte-goto)))
-		      (byte-compile-log-lap "  %s [%s]\t-->\t%s"
-					    (car lap0) tmp tmp)
-		      (if (eq (car tmp) 'byte-return)
-			  (setcar lap0 'byte-return))
-		      (setcdr lap0 (cdr tmp))
-		      (setq keep-going t))))
-	      ;;
-	      ;; goto-*-else-pop X ... X: goto-if-* --> whatever
-	      ;; goto-*-else-pop X ... X: discard --> whatever
-	      ;;
-	      ((and (memq (car lap0) '(byte-goto-if-nil-else-pop
-				       byte-goto-if-not-nil-else-pop))
-		    (memq (car (car (setq tmp (cdr (memq (cdr lap0) lap)))))
-			  (eval-when-compile
-			   (cons 'byte-discard byte-conditional-ops)))
-		    (not (eq lap0 (car tmp))))
-	       (setq tmp2 (car tmp))
-	       (setq tmp3 (assq (car lap0) '((byte-goto-if-nil-else-pop
-					      byte-goto-if-nil)
-					     (byte-goto-if-not-nil-else-pop
-					      byte-goto-if-not-nil))))
-	       (if (memq (car tmp2) tmp3)
-		   (progn (setcar lap0 (car tmp2))
-			  (setcdr lap0 (cdr tmp2))
-			  (byte-compile-log-lap "  %s-else-pop [%s]\t-->\t%s"
-						(car lap0) tmp2 lap0))
-		 ;; Get rid of the -else-pop's and jump one step further.
-		 (or (eq 'TAG (car (nth 1 tmp)))
-		     (setcdr tmp (cons (byte-compile-make-tag)
-				       (cdr tmp))))
-		 (byte-compile-log-lap "  %s [%s]\t-->\t%s <skip>"
-				       (car lap0) tmp2 (nth 1 tmp3))
-		 (setcar lap0 (nth 1 tmp3))
-		 (setcdr lap0 (nth 1 tmp)))
-	       (setq keep-going t))
-	      ;;
-	      ;; const goto-X ... X: goto-if-* --> whatever
-	      ;; const goto-X ... X: discard   --> whatever
-	      ;;
-	      ((and (eq (car lap0) 'byte-constant)
-		    (eq (car lap1) 'byte-goto)
-		    (memq (car (car (setq tmp (cdr (memq (cdr lap1) lap)))))
-			  (eval-when-compile
-			    (cons 'byte-discard byte-conditional-ops)))
-		    (not (eq lap1 (car tmp))))
-	       (setq tmp2 (car tmp))
-	       (cond ((memq (car tmp2)
-			    (if (null (car (cdr lap0)))
-				'(byte-goto-if-nil byte-goto-if-nil-else-pop)
-			      '(byte-goto-if-not-nil
-				byte-goto-if-not-nil-else-pop)))
-		      (byte-compile-log-lap "  %s goto [%s]\t-->\t%s %s"
-					    lap0 tmp2 lap0 tmp2)
-		      (setcar lap1 (car tmp2))
-		      (setcdr lap1 (cdr tmp2))
-		      ;; Let next step fix the (const,goto-if*) sequence.
-		      (setq rest (cons nil rest)))
-		     (t
-		      ;; Jump one step further
-		      (byte-compile-log-lap
-		       "  %s goto [%s]\t-->\t<deleted> goto <skip>"
-		       lap0 tmp2)
-		      (or (eq 'TAG (car (nth 1 tmp)))
-			  (setcdr tmp (cons (byte-compile-make-tag)
-					    (cdr tmp))))
-		      (setcdr lap1 (car (cdr tmp)))
-		      (setq lap (delq lap0 lap))))
-	       (setq keep-going t))
-	      ;;
-	      ;; X: varref-Y    ...     varset-Y goto-X  -->
-	      ;; X: varref-Y Z: ... dup varset-Y goto-Z
-	      ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
-	      ;; (This is so usual for while loops that it is worth handling).
-	      ;;
-	      ((and (eq (car lap1) 'byte-varset)
-		    (eq (car lap2) 'byte-goto)
-		    (not (memq (cdr lap2) rest)) ;Backwards jump
-		    (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap)))))
-			'byte-varref)
-		    (eq (cdr (car tmp)) (cdr lap1))
-		    (not (memq (car (cdr lap1)) byte-boolean-vars)))
-	       ;;(byte-compile-log-lap "  Pulled %s to end of loop" (car tmp))
-	       (let ((newtag (byte-compile-make-tag)))
-		 (byte-compile-log-lap
-		  "  %s: %s ... %s %s\t-->\t%s: %s %s: ... %s %s %s"
-		  (nth 1 (cdr lap2)) (car tmp)
-                  lap1 lap2
-		  (nth 1 (cdr lap2)) (car tmp)
-		  (nth 1 newtag) 'byte-dup lap1
-		  (cons 'byte-goto newtag)
-		  )
-		 (setcdr rest (cons (cons 'byte-dup 0) (cdr rest)))
-		 (setcdr tmp (cons (setcdr lap2 newtag) (cdr tmp))))
-	       (setq add-depth 1)
-	       (setq keep-going t))
-	      ;;
-	      ;; goto-X Y: ... X: goto-if*-Y  -->  goto-if-not-*-X+1 Y:
-	      ;; (This can pull the loop test to the end of the loop)
-	      ;;
-	      ((and (eq (car lap0) 'byte-goto)
-		    (eq (car lap1) 'TAG)
-		    (eq lap1
-			(cdr (car (setq tmp (cdr (memq (cdr lap0) lap))))))
-		    (memq (car (car tmp))
-			  '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
-				      byte-goto-if-nil-else-pop)))
-;;	       (byte-compile-log-lap "  %s %s, %s %s  --> moved conditional"
-;;				     lap0 lap1 (cdr lap0) (car tmp))
-	       (let ((newtag (byte-compile-make-tag)))
-		 (byte-compile-log-lap
-		  "%s %s: ... %s: %s\t-->\t%s ... %s:"
-		  lap0 (nth 1 lap1) (nth 1 (cdr lap0)) (car tmp)
-		  (cons (cdr (assq (car (car tmp))
-				   '((byte-goto-if-nil . byte-goto-if-not-nil)
-				     (byte-goto-if-not-nil . byte-goto-if-nil)
-				     (byte-goto-if-nil-else-pop .
-				      byte-goto-if-not-nil-else-pop)
-				     (byte-goto-if-not-nil-else-pop .
-				      byte-goto-if-nil-else-pop))))
-			newtag)
-		  
-		  (nth 1 newtag)
-		  )
-		 (setcdr tmp (cons (setcdr lap0 newtag) (cdr tmp)))
-		 (if (eq (car (car tmp)) 'byte-goto-if-nil-else-pop)
-		     ;; We can handle this case but not the -if-not-nil case,
-		     ;; because we won't know which non-nil constant to push.
-		   (setcdr rest (cons (cons 'byte-constant
-					    (byte-compile-get-constant nil))
-				      (cdr rest))))
-	       (setcar lap0 (nth 1 (memq (car (car tmp))
-					 '(byte-goto-if-nil-else-pop
-					   byte-goto-if-not-nil
-					   byte-goto-if-nil
-					   byte-goto-if-not-nil
-					   byte-goto byte-goto))))
-	       )
-	       (setq keep-going t))
-	      )
-	(setq rest (cdr rest)))
-      )
-    ;; Cleanup stage:
-    ;; Rebuild byte-compile-constants / byte-compile-variables.
-    ;; Simple optimizations that would inhibit other optimizations if they
-    ;; were done in the optimizing loop, and optimizations which there is no
-    ;;  need to do more than once.
-    (setq byte-compile-constants nil
-	  byte-compile-variables nil)
-    (setq rest lap)
-    (while rest
-      (setq lap0 (car rest)
-	    lap1 (nth 1 rest))
-      (if (memq (car lap0) byte-constref-ops)
-	  (if (eq (cdr lap0) 'byte-constant)
-	      (or (memq (cdr lap0) byte-compile-variables)
-		  (setq byte-compile-variables (cons (cdr lap0)
-						     byte-compile-variables)))
-	    (or (memq (cdr lap0) byte-compile-constants)
-		(setq byte-compile-constants (cons (cdr lap0)
-						   byte-compile-constants)))))
-      (cond (;;
-	     ;; const-C varset-X const-C  -->  const-C dup varset-X
-	     ;; const-C varbind-X const-C  -->  const-C dup varbind-X
-	     ;;
-	     (and (eq (car lap0) 'byte-constant)
-		  (eq (car (nth 2 rest)) 'byte-constant)
-		  (eq (cdr lap0) (car (nth 2 rest)))
-		  (memq (car lap1) '(byte-varbind byte-varset)))
-	     (byte-compile-log-lap "  %s %s %s\t-->\t%s dup %s"
-				   lap0 lap1 lap0 lap0 lap1)
-	     (setcar (cdr (cdr rest)) (cons (car lap1) (cdr lap1)))
-	     (setcar (cdr rest) (cons 'byte-dup 0))
-	     (setq add-depth 1))
-	    ;;
-	    ;; const-X  [dup/const-X ...]   -->  const-X  [dup ...] dup
-	    ;; varref-X [dup/varref-X ...]  -->  varref-X [dup ...] dup
-	    ;;
-	    ((memq (car lap0) '(byte-constant byte-varref))
-	     (setq tmp rest
-		   tmp2 nil)
-	     (while (progn
-		      (while (eq 'byte-dup (car (car (setq tmp (cdr tmp))))))
-		      (and (eq (cdr lap0) (cdr (car tmp)))
-			   (eq (car lap0) (car (car tmp)))))
-	       (setcar tmp (cons 'byte-dup 0))
-	       (setq tmp2 t))
-	     (if tmp2
-		 (byte-compile-log-lap
-		  "  %s [dup/%s]...\t-->\t%s dup..." lap0 lap0 lap0)))
-	    ;;
-	    ;; unbind-N unbind-M  -->  unbind-(N+M)
-	    ;;
-	    ((and (eq 'byte-unbind (car lap0))
-		  (eq 'byte-unbind (car lap1)))
-	     (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1
-				   (cons 'byte-unbind
-					 (+ (cdr lap0) (cdr lap1))))
-	     (setq keep-going t)
-	     (setq lap (delq lap0 lap))
-	     (setcdr lap1 (+ (cdr lap1) (cdr lap0))))
-	    )
-      (setq rest (cdr rest)))
-    (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
-  lap)
-
-(provide 'byte-optimize)
-
-
-;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when this file compiles
-;; itself, compile some of its most used recursive functions (at load time).
-;;
-(eval-when-compile
- (or (byte-code-function-p (symbol-function 'byte-optimize-form))
-     (assq 'byte-code (symbol-function 'byte-optimize-form))
-     (let ((byte-optimize nil)
-	   (byte-compile-warnings nil))
-       (mapcar '(lambda (x)
-		  (or noninteractive (message "compiling %s..." x))
-		  (byte-compile x)
-		  (or noninteractive (message "compiling %s...done" x)))
-	       '(byte-optimize-form
-		 byte-optimize-body
-		 byte-optimize-predicate
-		 byte-optimize-binary-predicate
-		 ;; Inserted some more than necessary, to speed it up.
-		 byte-optimize-form-code-walker
-		 byte-optimize-lapcode))))
- nil)
-
-;;; byte-opt.el ends here
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
deleted file mode 100644
index 1ffd3cae2ca..00000000000
--- a/lisp/emacs-lisp/bytecomp.el
+++ /dev/null
@@ -1,3427 +0,0 @@
-;;; bytecomp.el --- compilation of Lisp code into byte code.
-
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Jamie Zawinski <jwz@lucid.com>
-;;	Hallvard Furuseth <hbf@ulrik.uio.no>
-;; Keywords: internal
-
-;; Subsequently modified by RMS.
-
-;;; This version incorporates changes up to version 2.10 of the 
-;;; Zawinski-Furuseth compiler.
-(defconst byte-compile-version "$Revision: 2.24 $")
-
-;; 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:
-
-;; The Emacs Lisp byte compiler.  This crunches lisp source into a sort
-;; of p-code which takes up less space and can be interpreted faster.
-;; The user entry points are byte-compile-file and byte-recompile-directory.
-
-;;; Code:
-
-;; ========================================================================
-;; Entry points:
-;;	byte-recompile-directory, byte-compile-file,
-;;     batch-byte-compile, batch-byte-recompile-directory,
-;;	byte-compile, compile-defun,
-;;	display-call-tree
-;; (byte-compile-buffer and byte-compile-and-load-file were turned off
-;;  because they are not terribly useful and get in the way of completion.)
-
-;; This version of the byte compiler has the following improvements:
-;;  + optimization of compiled code:
-;;    - removal of unreachable code;
-;;    - removal of calls to side-effectless functions whose return-value
-;;      is unused;
-;;    - compile-time evaluation of safe constant forms, such as (consp nil)
-;;      and (ash 1 6);
-;;    - open-coding of literal lambdas;
-;;    - peephole optimization of emitted code;
-;;    - trivial functions are left uncompiled for speed.
-;;  + support for inline functions;
-;;  + compile-time evaluation of arbitrary expressions;
-;;  + compile-time warning messages for:
-;;    - functions being redefined with incompatible arglists;
-;;    - functions being redefined as macros, or vice-versa;
-;;    - functions or macros defined multiple times in the same file;
-;;    - functions being called with the incorrect number of arguments;
-;;    - functions being called which are not defined globally, in the 
-;;      file, or as autoloads;
-;;    - assignment and reference of undeclared free variables;
-;;    - various syntax errors;
-;;  + correct compilation of nested defuns, defmacros, defvars and defsubsts;
-;;  + correct compilation of top-level uses of macros;
-;;  + the ability to generate a histogram of functions called.
-
-;; User customization variables:
-;;
-;; byte-compile-verbose	Whether to report the function currently being
-;;				compiled in the minibuffer;
-;; byte-optimize		Whether to do optimizations; this may be 
-;;				t, nil, 'source, or 'byte;
-;; byte-optimize-log		Whether to report (in excruciating detail) 
-;;				exactly which optimizations have been made.
-;;				This may be t, nil, 'source, or 'byte;
-;; byte-compile-error-on-warn	Whether to stop compilation when a warning is
-;;				produced;
-;; byte-compile-delete-errors	Whether the optimizer may delete calls or
-;;				variable references that are side-effect-free
-;;				except that they may return an error.
-;; byte-compile-generate-call-tree	Whether to generate a histogram of
-;;				function calls.  This can be useful for 
-;;				finding unused functions, as well as simple
-;;				performance metering.
-;; byte-compile-warnings	List of warnings to issue, or t.  May contain
-;;				'free-vars (references to variables not in the
-;;					    current lexical scope)
-;;				'unresolved (calls to unknown functions)
-;;				'callargs  (lambda calls with args that don't
-;;					    match the lambda's definition)
-;;				'redefine  (function cell redefined from
-;;					    a macro to a lambda or vice versa,
-;;					    or redefined to take other args)
-;;				'obsolete  (obsolete variables and functions)
-;; byte-compile-compatibility	Whether the compiler should
-;;				generate .elc files which can be loaded into
-;;				generic emacs 18.
-;; emacs-lisp-file-regexp	Regexp for the extension of source-files;
-;;				see also the function byte-compile-dest-file.
-
-;; New Features:
-;;
-;;  o	The form `defsubst' is just like `defun', except that the function
-;;	generated will be open-coded in compiled code which uses it.  This
-;;	means that no function call will be generated, it will simply be
-;;	spliced in.  Lisp functions calls are very slow, so this can be a
-;;	big win.
-;;
-;;	You can generally accomplish the same thing with `defmacro', but in
-;;	that case, the defined procedure can't be used as an argument to
-;;	mapcar, etc.
-;;
-;;  o	You can also open-code one particular call to a function without
-;;	open-coding all calls.  Use the 'inline' form to do this, like so:
-;;
-;;		(inline (foo 1 2 3))	;; `foo' will be open-coded
-;;	or...
-;;		(inline			;;  `foo' and `baz' will be 
-;;		 (foo 1 2 3 (bar 5))	;; open-coded, but `bar' will not.
-;;		 (baz 0))
-;;
-;;  o	It is possible to open-code a function in the same file it is defined
-;;	in without having to load that file before compiling it.  the
-;;	byte-compiler has been modified to remember function definitions in
-;;	the compilation environment in the same way that it remembers macro
-;;	definitions.
-;;
-;;  o  Forms like ((lambda ...) ...) are open-coded.
-;;
-;;  o  The form `eval-when-compile' is like progn, except that the body
-;;     is evaluated at compile-time.  When it appears at top-level, this
-;;     is analogous to the Common Lisp idiom (eval-when (compile) ...).
-;;     When it does not appear at top-level, it is similar to the
-;;     Common Lisp #. reader macro (but not in interpreted code).
-;;
-;;  o  The form `eval-and-compile' is similar to eval-when-compile, but
-;;	the whole form is evalled both at compile-time and at run-time.
-;;
-;;  o  The command compile-defun is analogous to eval-defun.
-;;
-;;  o  If you run byte-compile-file on a filename which is visited in a 
-;;     buffer, and that buffer is modified, you are asked whether you want
-;;     to save the buffer before compiling.
-;;
-;;  o  byte-compiled files now start with the string `;ELC'.
-;;     Some versions of `file' can be customized to recognize that.
-
-(require 'backquote)
-
-(or (fboundp 'defsubst)
-    ;; This really ought to be loaded already!
-    (load-library "byte-run"))
-
-;;; The feature of compiling in a specific target Emacs version
-;;; has been turned off because compile time options are a bad idea.
-(defmacro byte-compile-single-version () nil)
-(defmacro byte-compile-version-cond (cond) cond)
-
-;;; The crud you see scattered through this file of the form
-;;;   (or (and (boundp 'epoch::version) epoch::version)
-;;;	  (string-lessp emacs-version "19"))
-;;; is because the Epoch folks couldn't be bothered to follow the
-;;; normal emacs version numbering convention.
-
-;; (if (byte-compile-version-cond
-;;      (or (and (boundp 'epoch::version) epoch::version)
-;; 	 (string-lessp emacs-version "19")))
-;;     (progn
-;;       ;; emacs-18 compatibility.
-;;       (defvar baud-rate (baud-rate))	;Define baud-rate if it's undefined
-;; 
-;;       (if (byte-compile-single-version)
-;; 	  (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil)
-;; 	(defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil))
-;; 
-;;       (or (and (fboundp 'member)
-;; 	       ;; avoid using someone else's possibly bogus definition of this.
-;; 	       (subrp (symbol-function 'member)))
-;; 	  (defun member (elt list)
-;; 	    "like memq, but uses equal instead of eq.  In v19, this is a subr."
-;; 	    (while (and list (not (equal elt (car list))))
-;; 	      (setq list (cdr list)))
-;; 	    list))))
-
-
-(defvar emacs-lisp-file-regexp (if (eq system-type 'vax-vms)
-				   "\\.EL\\(;[0-9]+\\)?$"
-				 "\\.el$")
-  "*Regexp which matches Emacs Lisp source files.
-You may want to redefine `byte-compile-dest-file' if you change this.")
-
-;; This enables file name handlers such as jka-compr
-;; to remove parts of the file name that should not be copied
-;; through to the output file name.
-(defun byte-compiler-base-file-name (filename)
-  (let ((handler (find-file-name-handler filename
-					 'byte-compiler-base-file-name)))
-    (if handler
-	(funcall handler 'byte-compiler-base-file-name filename)
-      filename)))
-
-(or (fboundp 'byte-compile-dest-file)
-    ;; The user may want to redefine this along with emacs-lisp-file-regexp,
-    ;; so only define it if it is undefined.
-    (defun byte-compile-dest-file (filename)
-      "Convert an Emacs Lisp source file name to a compiled file name."
-      (setq filename (byte-compiler-base-file-name filename))
-      (setq filename (file-name-sans-versions filename))
-      (cond ((eq system-type 'vax-vms)
-		 (concat (substring filename 0 (string-match ";" filename)) "c"))
-		((string-match emacs-lisp-file-regexp filename)
-		 (concat (substring filename 0 (match-beginning 0)) ".elc"))
-		(t (concat filename ".elc")))))
-
-;; This can be the 'byte-compile property of any symbol.
-(autoload 'byte-compile-inline-expand "byte-opt")
-
-;; This is the entrypoint to the lapcode optimizer pass1.
-(autoload 'byte-optimize-form "byte-opt")
-;; This is the entrypoint to the lapcode optimizer pass2.
-(autoload 'byte-optimize-lapcode "byte-opt")
-(autoload 'byte-compile-unfold-lambda "byte-opt")
-
-;; This is the entry point to the decompiler, which is used by the
-;; disassembler.  The disassembler just requires 'byte-compile, but
-;; that doesn't define this function, so this seems to be a reasonable
-;; thing to do.
-(autoload 'byte-decompile-bytecode "byte-opt")
-
-(defvar byte-compile-verbose
-  (and (not noninteractive) (> baud-rate search-slow-speed))
-  "*Non-nil means print messages describing progress of byte-compiler.")
-
-(defvar byte-compile-compatibility nil
-  "*Non-nil means generate output that can run in Emacs 18.")
-
-;; (defvar byte-compile-generate-emacs19-bytecodes
-;;         (not (or (and (boundp 'epoch::version) epoch::version)
-;; 		 (string-lessp emacs-version "19")))
-;;   "*If this is true, then the byte-compiler will generate bytecode which 
-;; makes use of byte-ops which are present only in Emacs 19.  Code generated
-;; this way can never be run in Emacs 18, and may even cause it to crash.")
-
-(defvar byte-optimize t
-  "*Enables optimization in the byte compiler.
-nil means don't do any optimization.
-t means do all optimizations.
-`source' means do source-level optimizations only.
-`byte' means do code-level optimizations only.")
-
-(defvar byte-compile-delete-errors t
-  "*If non-nil, the optimizer may delete forms that may signal an error.
-This includes variable references and calls to functions such as `car'.")
-
-(defvar byte-compile-dynamic nil
-  "*If non-nil, compile function bodies so they load lazily.
-They are hidden comments in the compiled file, and brought into core when the
-function is called.
-
-To enable this option, make it a file-local variable
-in the source file you want it to apply to.
-For example, add  -*-byte-compile-dynamic: t;-*- on the first line.
-
-When this option is true, if you load the compiled file and then move it,
-the functions you loaded will not be able to run.")
-
-(defvar byte-compile-dynamic-docstrings t
-  "*If non-nil, compile doc strings for lazy access.
-We bury the doc strings of functions and variables
-inside comments in the file, and bring them into core only when they
-are actually needed.
-
-When this option is true, if you load the compiled file and then move it,
-you won't be able to find the documentation of anything in that file.
-
-To disable this option for a certain file, make it a file-local variable
-in the source file.  For example, add this to the first line:
-  -*-byte-compile-dynamic-docstrings:nil;-*-
-You can also set the variable globally.
-
-This option is enabled by default because it reduces Emacs memory usage.")
-
-(defvar byte-optimize-log nil
-  "*If true, the byte-compiler will log its optimizations into *Compile-Log*.
-If this is 'source, then only source-level optimizations will be logged.
-If it is 'byte, then only byte-level optimizations will be logged.")
-
-(defvar byte-compile-error-on-warn nil
-  "*If true, the byte-compiler reports warnings with `error'.")
-
-(defconst byte-compile-warning-types
-  '(redefine callargs free-vars unresolved obsolete))
-(defvar byte-compile-warnings t
-  "*List of warnings that the byte-compiler should issue (t for all).
-Elements of the list may be be:
-
-  free-vars   references to variables not in the current lexical scope.
-  unresolved  calls to unknown functions.
-  callargs    lambda calls with args that don't match the definition.
-  redefine    function cell redefined from a macro to a lambda or vice
-              versa, or redefined to take a different number of arguments.
-  obsolete      obsolete variables and functions.
-
-See also the macro `byte-compiler-options'.")
-
-(defvar byte-compile-generate-call-tree nil
-  "*Non-nil means collect call-graph information when compiling.
-This records functions were called and from where.
-If the value is t, compilation displays the call graph when it finishes.
-If the value is neither t nor nil, compilation asks you whether to display
-the graph.
-
-The call tree only lists functions called, not macros used. Those functions
-which the byte-code interpreter knows about directly (eq, cons, etc.) are
-not reported.
-
-The call tree also lists those functions which are not known to be called
-\(that is, to which no calls have been compiled).  Functions which can be
-invoked interactively are excluded from this list.")
-
-(defconst byte-compile-call-tree nil "Alist of functions and their call tree.
-Each element looks like
-
-  \(FUNCTION CALLERS CALLS\)
-
-where CALLERS is a list of functions that call FUNCTION, and CALLS
-is a list of functions for which calls were generated while compiling
-FUNCTION.")
-
-(defvar byte-compile-call-tree-sort 'name
-  "*If non-nil, sort the call tree.
-The values `name', `callers', `calls', `calls+callers'
-specify different fields to sort on.")
-
-;; (defvar byte-compile-overwrite-file t
-;;   "If nil, old .elc files are deleted before the new is saved, and .elc
-;; files will have the same modes as the corresponding .el file.  Otherwise,
-;; existing .elc files will simply be overwritten, and the existing modes
-;; will not be changed.  If this variable is nil, then an .elc file which 
-;; is a symbolic link will be turned into a normal file, instead of the file
-;; which the link points to being overwritten.")
-
-(defvar byte-compile-constants nil
-  "list of all constants encountered during compilation of this form")
-(defvar byte-compile-variables nil
-  "list of all variables encountered during compilation of this form")
-(defvar byte-compile-bound-variables nil
-  "list of variables bound in the context of the current form; this list
-lives partly on the stack.")
-(defvar byte-compile-free-references)
-(defvar byte-compile-free-assignments)
-
-(defvar byte-compiler-error-flag)
-
-(defconst byte-compile-initial-macro-environment
-  '(
-;;     (byte-compiler-options . (lambda (&rest forms)
-;; 			       (apply 'byte-compiler-options-handler forms)))
-    (eval-when-compile . (lambda (&rest body)
-			   (list 'quote (eval (byte-compile-top-level
-					       (cons 'progn body))))))
-    (eval-and-compile . (lambda (&rest body)
-			  (eval (cons 'progn body))
-			  (cons 'progn body))))
-  "The default macro-environment passed to macroexpand by the compiler.
-Placing a macro here will cause a macro to have different semantics when
-expanded by the compiler as when expanded by the interpreter.")
-
-(defvar byte-compile-macro-environment byte-compile-initial-macro-environment
-  "Alist of macros defined in the file being compiled.
-Each element looks like (MACRONAME . DEFINITION).  It is
-\(MACRONAME . nil) when a macro is redefined as a function.")
-
-(defvar byte-compile-function-environment nil
-  "Alist of functions defined in the file being compiled.
-This is so we can inline them when necessary.
-Each element looks like (FUNCTIONNAME . DEFINITION).  It is
-\(FUNCTIONNAME . nil) when a function is redefined as a macro.")
-
-(defvar byte-compile-unresolved-functions nil
-  "Alist of undefined functions to which calls have been compiled (used for
-warnings when the function is later defined with incorrect args).")
-
-(defvar byte-compile-tag-number 0)
-(defvar byte-compile-output nil
-  "Alist describing contents to put in byte code string.
-Each element is (INDEX . VALUE)")
-(defvar byte-compile-depth 0 "Current depth of execution stack.")
-(defvar byte-compile-maxdepth 0 "Maximum depth of execution stack.")
-
-
-;;; The byte codes; this information is duplicated in bytecomp.c
-
-(defconst byte-code-vector nil
-  "An array containing byte-code names indexed by byte-code values.")
-
-(defconst byte-stack+-info nil
-  "An array with the stack adjustment for each byte-code.")
-
-(defmacro byte-defop (opcode stack-adjust opname &optional docstring)
-  ;; This is a speed-hack for building the byte-code-vector at compile-time.
-  ;; We fill in the vector at macroexpand-time, and then after the last call
-  ;; to byte-defop, we write the vector out as a constant instead of writing
-  ;; out a bunch of calls to aset.
-  ;; Actually, we don't fill in the vector itself, because that could make
-  ;; it problematic to compile big changes to this compiler; we store the
-  ;; values on its plist, and remove them later in -extrude.
-  (let ((v1 (or (get 'byte-code-vector 'tmp-compile-time-value)
-		(put 'byte-code-vector 'tmp-compile-time-value
-		     (make-vector 256 nil))))
-	(v2 (or (get 'byte-stack+-info 'tmp-compile-time-value)
-		(put 'byte-stack+-info 'tmp-compile-time-value
-		     (make-vector 256 nil)))))
-    (aset v1 opcode opname)
-    (aset v2 opcode stack-adjust))
-  (if docstring
-      (list 'defconst opname opcode (concat "Byte code opcode " docstring "."))
-      (list 'defconst opname opcode)))
-
-(defmacro byte-extrude-byte-code-vectors ()
-  (prog1 (list 'setq 'byte-code-vector
-		     (get 'byte-code-vector 'tmp-compile-time-value)
-		     'byte-stack+-info
-		     (get 'byte-stack+-info 'tmp-compile-time-value))
-    ;; emacs-18 has no REMPROP.
-    (put 'byte-code-vector 'tmp-compile-time-value nil)
-    (put 'byte-stack+-info 'tmp-compile-time-value nil)))
-
-
-;; unused: 0-7
-
-;; These opcodes are special in that they pack their argument into the
-;; opcode word.
-;;
-(byte-defop   8  1 byte-varref	"for variable reference")
-(byte-defop  16 -1 byte-varset	"for setting a variable")
-(byte-defop  24 -1 byte-varbind	"for binding a variable")
-(byte-defop  32  0 byte-call	"for calling a function")
-(byte-defop  40  0 byte-unbind	"for unbinding special bindings")
-;; codes 8-47 are consumed by the preceding opcodes
-
-;; unused: 48-55
-
-(byte-defop  56 -1 byte-nth)
-(byte-defop  57  0 byte-symbolp)
-(byte-defop  58  0 byte-consp)
-(byte-defop  59  0 byte-stringp)
-(byte-defop  60  0 byte-listp)
-(byte-defop  61 -1 byte-eq)
-(byte-defop  62 -1 byte-memq)
-(byte-defop  63  0 byte-not)
-(byte-defop  64  0 byte-car)
-(byte-defop  65  0 byte-cdr)
-(byte-defop  66 -1 byte-cons)
-(byte-defop  67  0 byte-list1)
-(byte-defop  68 -1 byte-list2)
-(byte-defop  69 -2 byte-list3)
-(byte-defop  70 -3 byte-list4)
-(byte-defop  71  0 byte-length)
-(byte-defop  72 -1 byte-aref)
-(byte-defop  73 -2 byte-aset)
-(byte-defop  74  0 byte-symbol-value)
-(byte-defop  75  0 byte-symbol-function) ; this was commented out
-(byte-defop  76 -1 byte-set)
-(byte-defop  77 -1 byte-fset) ; this was commented out
-(byte-defop  78 -1 byte-get)
-(byte-defop  79 -2 byte-substring)
-(byte-defop  80 -1 byte-concat2)
-(byte-defop  81 -2 byte-concat3)
-(byte-defop  82 -3 byte-concat4)
-(byte-defop  83  0 byte-sub1)
-(byte-defop  84  0 byte-add1)
-(byte-defop  85 -1 byte-eqlsign)
-(byte-defop  86 -1 byte-gtr)
-(byte-defop  87 -1 byte-lss)
-(byte-defop  88 -1 byte-leq)
-(byte-defop  89 -1 byte-geq)
-(byte-defop  90 -1 byte-diff)
-(byte-defop  91  0 byte-negate)
-(byte-defop  92 -1 byte-plus)
-(byte-defop  93 -1 byte-max)
-(byte-defop  94 -1 byte-min)
-(byte-defop  95 -1 byte-mult) ; v19 only
-(byte-defop  96  1 byte-point)
-(byte-defop  97  0 byte-save-current-buffer
-  "To make a binding to record the current buffer")
-(byte-defop  98  0 byte-goto-char)
-(byte-defop  99  0 byte-insert)
-(byte-defop 100  1 byte-point-max)
-(byte-defop 101  1 byte-point-min)
-(byte-defop 102  0 byte-char-after)
-(byte-defop 103  1 byte-following-char)
-(byte-defop 104  1 byte-preceding-char)
-(byte-defop 105  1 byte-current-column)
-(byte-defop 106  0 byte-indent-to)
-(byte-defop 107  0 byte-scan-buffer-OBSOLETE) ; no longer generated as of v18
-(byte-defop 108  1 byte-eolp)
-(byte-defop 109  1 byte-eobp)
-(byte-defop 110  1 byte-bolp)
-(byte-defop 111  1 byte-bobp)
-(byte-defop 112  1 byte-current-buffer)
-(byte-defop 113  0 byte-set-buffer)
-(byte-defop 114  1 byte-read-char-OBSOLETE)
-(byte-defop 115  0 byte-set-mark-OBSOLETE)
-(byte-defop 116  1 byte-interactive-p)
-
-;; These ops are new to v19
-(byte-defop 117  0 byte-forward-char)
-(byte-defop 118  0 byte-forward-word)
-(byte-defop 119 -1 byte-skip-chars-forward)
-(byte-defop 120 -1 byte-skip-chars-backward)
-(byte-defop 121  0 byte-forward-line)
-(byte-defop 122  0 byte-char-syntax)
-(byte-defop 123 -1 byte-buffer-substring)
-(byte-defop 124 -1 byte-delete-region)
-(byte-defop 125 -1 byte-narrow-to-region)
-(byte-defop 126  1 byte-widen)
-(byte-defop 127  0 byte-end-of-line)
-
-;; unused: 128
-
-;; These store their argument in the next two bytes
-(byte-defop 129  1 byte-constant2
-   "for reference to a constant with vector index >= byte-constant-limit")
-(byte-defop 130  0 byte-goto "for unconditional jump")
-(byte-defop 131 -1 byte-goto-if-nil "to pop value and jump if it's nil")
-(byte-defop 132 -1 byte-goto-if-not-nil "to pop value and jump if it's not nil")
-(byte-defop 133 -1 byte-goto-if-nil-else-pop
-  "to examine top-of-stack, jump and don't pop it if it's nil, 
-otherwise pop it")
-(byte-defop 134 -1 byte-goto-if-not-nil-else-pop
-  "to examine top-of-stack, jump and don't pop it if it's non nil, 
-otherwise pop it")
-
-(byte-defop 135 -1 byte-return "to pop a value and return it from `byte-code'")
-(byte-defop 136 -1 byte-discard "to discard one value from stack")
-(byte-defop 137  1 byte-dup     "to duplicate the top of the stack")
-
-(byte-defop 138  0 byte-save-excursion
-  "to make a binding to record the buffer, point and mark")
-(byte-defop 139  0 byte-save-window-excursion
-  "to make a binding to record entire window configuration")
-(byte-defop 140  0 byte-save-restriction
-  "to make a binding to record the current buffer clipping restrictions")
-(byte-defop 141 -1 byte-catch
-  "for catch.  Takes, on stack, the tag and an expression for the body")
-(byte-defop 142 -1 byte-unwind-protect
-  "for unwind-protect.  Takes, on stack, an expression for the unwind-action")
-
-;; For condition-case.  Takes, on stack, the variable to bind, 
-;; an expression for the body, and a list of clauses.
-(byte-defop 143 -2 byte-condition-case)
-
-;; For entry to with-output-to-temp-buffer.
-;; Takes, on stack, the buffer name.
-;; Binds standard-output and does some other things.
-;; Returns with temp buffer on the stack in place of buffer name.
-(byte-defop 144  0 byte-temp-output-buffer-setup)
-
-;; For exit from with-output-to-temp-buffer.
-;; Expects the temp buffer on the stack underneath value to return.
-;; Pops them both, then pushes the value back on.
-;; Unbinds standard-output and makes the temp buffer visible.
-(byte-defop 145 -1 byte-temp-output-buffer-show)
-
-;; these ops are new to v19
-
-;; To unbind back to the beginning of this frame.
-;; Not used yet, but will be needed for tail-recursion elimination.
-(byte-defop 146  0 byte-unbind-all)
-
-;; these ops are new to v19
-(byte-defop 147 -2 byte-set-marker)
-(byte-defop 148  0 byte-match-beginning)
-(byte-defop 149  0 byte-match-end)
-(byte-defop 150  0 byte-upcase)
-(byte-defop 151  0 byte-downcase)
-(byte-defop 152 -1 byte-string=)
-(byte-defop 153 -1 byte-string<)
-(byte-defop 154 -1 byte-equal)
-(byte-defop 155 -1 byte-nthcdr)
-(byte-defop 156 -1 byte-elt)
-(byte-defop 157 -1 byte-member)
-(byte-defop 158 -1 byte-assq)
-(byte-defop 159  0 byte-nreverse)
-(byte-defop 160 -1 byte-setcar)
-(byte-defop 161 -1 byte-setcdr)
-(byte-defop 162  0 byte-car-safe)
-(byte-defop 163  0 byte-cdr-safe)
-(byte-defop 164 -1 byte-nconc)
-(byte-defop 165 -1 byte-quo)
-(byte-defop 166 -1 byte-rem)
-(byte-defop 167  0 byte-numberp)
-(byte-defop 168  0 byte-integerp)
-
-;; unused: 169-174
-(byte-defop 175 nil byte-listN)
-(byte-defop 176 nil byte-concatN)
-(byte-defop 177 nil byte-insertN)
-
-;; unused: 178-191
-
-(byte-defop 192  1 byte-constant	"for reference to a constant")
-;; codes 193-255 are consumed by byte-constant.
-(defconst byte-constant-limit 64
-  "Exclusive maximum index usable in the `byte-constant' opcode.")
-
-(defconst byte-goto-ops '(byte-goto byte-goto-if-nil byte-goto-if-not-nil
-			  byte-goto-if-nil-else-pop
-			  byte-goto-if-not-nil-else-pop)
-  "List of byte-codes whose offset is a pc.")
-
-(defconst byte-goto-always-pop-ops '(byte-goto-if-nil byte-goto-if-not-nil))
-
-(byte-extrude-byte-code-vectors)
-
-;;; lapcode generator
-;;;
-;;; the byte-compiler now does source -> lapcode -> bytecode instead of
-;;; source -> bytecode, because it's a lot easier to make optimizations
-;;; on lapcode than on bytecode.
-;;;
-;;; Elements of the lapcode list are of the form (<instruction> . <parameter>)
-;;; where instruction is a symbol naming a byte-code instruction,
-;;; and parameter is an argument to that instruction, if any.
-;;;
-;;; The instruction can be the pseudo-op TAG, which means that this position 
-;;; in the instruction stream is a target of a goto.  (car PARAMETER) will be
-;;; the PC for this location, and the whole instruction "(TAG pc)" will be the
-;;; parameter for some goto op.
-;;;
-;;; If the operation is varbind, varref, varset or push-constant, then the
-;;; parameter is (variable/constant . index_in_constant_vector).
-;;;
-;;; First, the source code is macroexpanded and optimized in various ways.
-;;; Then the resultant code is compiled into lapcode.  Another set of
-;;; optimizations are then run over the lapcode.  Then the variables and
-;;; constants referenced by the lapcode are collected and placed in the
-;;; constants-vector.  (This happens now so that variables referenced by dead
-;;; code don't consume space.)  And finally, the lapcode is transformed into
-;;; compacted byte-code.
-;;;
-;;; A distinction is made between variables and constants because the variable-
-;;; referencing instructions are more sensitive to the variables being near the
-;;; front of the constants-vector than the constant-referencing instructions.
-;;; Also, this lets us notice references to free variables.
-
-(defun byte-compile-lapcode (lap)
-  "Turns lapcode into bytecode.  The lapcode is destroyed."
-  ;; Lapcode modifications: changes the ID of a tag to be the tag's PC.
-  (let ((pc 0)			; Program counter
-	op off			; Operation & offset
-	(bytes '())		; Put the output bytes here
-	(patchlist nil)		; List of tags and goto's to patch
-	rest rel tmp)
-    (while lap
-      (setq op (car (car lap))
-	    off (cdr (car lap)))
-      (cond ((not (symbolp op))
-	     (error "Non-symbolic opcode `%s'" op))
-	    ((eq op 'TAG)
-	     (setcar off pc)
-	     (setq patchlist (cons off patchlist)))
-	    ((memq op byte-goto-ops)
-	     (setq pc (+ pc 3))
-	     (setq bytes (cons (cons pc (cdr off))
-			       (cons nil
-				     (cons (symbol-value op) bytes))))
-	     (setq patchlist (cons bytes patchlist)))
-	    (t
-	     (setq bytes
-		   (cond ((cond ((consp off)
-				 ;; Variable or constant reference
-				 (setq off (cdr off))
-				 (eq op 'byte-constant)))
-			  (cond ((< off byte-constant-limit)
-				 (setq pc (1+ pc))
-				 (cons (+ byte-constant off) bytes))
-				(t
-				 (setq pc (+ 3 pc))
-				 (cons (lsh off -8)
-				       (cons (logand off 255)
-					     (cons byte-constant2 bytes))))))
-			 ((<= byte-listN (symbol-value op))
-			  (setq pc (+ 2 pc))
-			  (cons off (cons (symbol-value op) bytes)))
-			 ((< off 6)
-			  (setq pc (1+ pc))
-			  (cons (+ (symbol-value op) off) bytes))
-			 ((< off 256)
-			  (setq pc (+ 2 pc))
-			  (cons off (cons (+ (symbol-value op) 6) bytes)))
-			 (t
-			  (setq pc (+ 3 pc))
-			  (cons (lsh off -8)
-				(cons (logand off 255)
-				      (cons (+ (symbol-value op) 7)
-					    bytes))))))))
-      (setq lap (cdr lap)))
-    ;;(if (not (= pc (length bytes)))
-    ;;    (error "Compiler error: pc mismatch - %s %s" pc (length bytes)))
-    ;; Patch PC into jumps
-    (let (bytes)
-      (while patchlist
-	(setq bytes (car patchlist))
-	(cond ((atom (car bytes)))	; Tag
-	      (t			; Absolute jump
-	       (setq pc (car (cdr (car bytes))))	; Pick PC from tag
-	       (setcar (cdr bytes) (logand pc 255))
-	       (setcar bytes (lsh pc -8))))
-	(setq patchlist (cdr patchlist))))
-    (concat (nreverse bytes))))
-
-
-;;; byte compiler messages
-
-(defvar byte-compile-current-form nil)
-(defvar byte-compile-current-file nil)
-(defvar byte-compile-dest-file nil)
-
-(defmacro byte-compile-log (format-string &rest args)
-  (list 'and
-	'byte-optimize
-	'(memq byte-optimize-log '(t source))
-	(list 'let '((print-escape-newlines t)
-		     (print-level 4)
-		     (print-length 4))
-	      (list 'byte-compile-log-1
-		    (cons 'format
-		      (cons format-string
-			(mapcar
-			 '(lambda (x)
-			    (if (symbolp x) (list 'prin1-to-string x) x))
-			 args)))))))
-
-(defconst byte-compile-last-warned-form nil)
-
-;; Log a message STRING in *Compile-Log*.
-;; Also log the current function and file if not already done.
-(defun byte-compile-log-1 (string &optional fill)
-  (cond (noninteractive
-	 (if (or byte-compile-current-file
-		 (and byte-compile-last-warned-form
-		      (not (eq byte-compile-current-form
-			       byte-compile-last-warned-form))))
-	     (message "While compiling %s%s:"
-		      (or byte-compile-current-form "toplevel forms")
-		      (if byte-compile-current-file
-			  (if (stringp byte-compile-current-file)
-			      (concat " in file " byte-compile-current-file)
-			    (concat " in buffer "
-				    (buffer-name byte-compile-current-file)))
-			"")))
-	 (message "  %s" string))
-	(t
-	 (save-excursion
-	   (set-buffer (get-buffer-create "*Compile-Log*"))
-	   (goto-char (point-max))
-	   (cond ((or byte-compile-current-file
-		      (and byte-compile-last-warned-form
-			   (not (eq byte-compile-current-form
-				    byte-compile-last-warned-form))))
-		  (if byte-compile-current-file
-		      (insert "\n\^L\n" (current-time-string) "\n"))
-		  (insert "While compiling "
-			  (if byte-compile-current-form
-			      (format "%s" byte-compile-current-form)
-			    "toplevel forms"))
-		  (if byte-compile-current-file
-		      (if (stringp byte-compile-current-file)
-			  (insert " in file " byte-compile-current-file)
-			(insert " in buffer "
-				(buffer-name byte-compile-current-file))))
-		  (insert ":\n")))
-	   (insert "  " string "\n")
-	   (if (and fill (not (string-match "\n" string)))
-	       (let ((fill-prefix "     ")
-		     (fill-column 78))
-		 (fill-paragraph nil)))
-	   )))
-  (setq byte-compile-current-file nil
-	byte-compile-last-warned-form byte-compile-current-form))
-
-;; Log the start of a file in *Compile-Log*, and mark it as done.
-;; But do nothing in batch mode.
-(defun byte-compile-log-file ()
-  (and byte-compile-current-file (not noninteractive)
-       (save-excursion
-	 (set-buffer (get-buffer-create "*Compile-Log*"))
-	 (goto-char (point-max))
-	 (insert "\n\^L\nCompiling "
-		 (if (stringp byte-compile-current-file)
-		     (concat "file " byte-compile-current-file)
-		   (concat "buffer " (buffer-name byte-compile-current-file)))
-		 " at " (current-time-string) "\n")
-	 (setq byte-compile-current-file nil))))
-
-(defun byte-compile-warn (format &rest args)
-  (setq format (apply 'format format args))
-  (if byte-compile-error-on-warn
-      (error "%s" format)		; byte-compile-file catches and logs it
-    (byte-compile-log-1 (concat "** " format) t)
-;;; It is useless to flash warnings too fast to be read.
-;;; Besides, they will all be shown at the end.
-;;;    (or noninteractive  ; already written on stdout.
-;;;	(message "Warning: %s" format))
-    ))
-
-;;; This function should be used to report errors that have halted
-;;; compilation of the current file.
-(defun byte-compile-report-error (error-info)
-  (setq byte-compiler-error-flag t)
-  (byte-compile-log-1
-   (concat "!! "
-	   (format (if (cdr error-info) "%s (%s)" "%s")
-		   (get (car error-info) 'error-message)
-		   (prin1-to-string (cdr error-info))))))
-
-;;; Used by make-obsolete.
-(defun byte-compile-obsolete (form)
-  (let ((new (get (car form) 'byte-obsolete-info)))
-    (if (memq 'obsolete byte-compile-warnings)
-	(byte-compile-warn "%s is an obsolete function; %s" (car form)
-			   (if (stringp (car new))
-			       (car new)
-			       (format "use %s instead." (car new)))))
-    (funcall (or (cdr new) 'byte-compile-normal-call) form)))
-
-;; Compiler options
-
-;; (defvar byte-compiler-valid-options
-;;   '((optimize byte-optimize (t nil source byte) val)
-;;     (file-format byte-compile-compatibility (emacs18 emacs19)
-;; 		 (eq val 'emacs18))
-;; ;;     (new-bytecodes byte-compile-generate-emacs19-bytecodes (t nil) val)
-;;     (delete-errors byte-compile-delete-errors (t nil) val)
-;;     (verbose byte-compile-verbose (t nil) val)
-;;     (warnings byte-compile-warnings ((callargs redefine free-vars unresolved))
-;; 	      val)))
-
-;; Inhibit v18/v19 selectors if the version is hardcoded.
-;; #### This should print a warning if the user tries to change something 
-;; than can't be changed because the running compiler doesn't support it.
-;; (cond
-;;  ((byte-compile-single-version)
-;;   (setcar (cdr (cdr (assq 'new-bytecodes byte-compiler-valid-options)))
-;; 	  (list (byte-compile-version-cond
-;; 		 byte-compile-generate-emacs19-bytecodes)))
-;;   (setcar (cdr (cdr (assq 'file-format byte-compiler-valid-options)))
-;; 	  (if (byte-compile-version-cond byte-compile-compatibility)
-;; 	      '(emacs18) '(emacs19)))))
-
-;; (defun byte-compiler-options-handler (&rest args)
-;;   (let (key val desc choices)
-;;     (while args
-;;       (if (or (atom (car args)) (nthcdr 2 (car args)) (null (cdr (car args))))
-;; 	  (error "Malformed byte-compiler option `%s'" (car args)))
-;;       (setq key (car (car args))
-;; 	    val (car (cdr (car args)))
-;; 	    desc (assq key byte-compiler-valid-options))
-;;       (or desc
-;; 	  (error "Unknown byte-compiler option `%s'" key))
-;;       (setq choices (nth 2 desc))
-;;       (if (consp (car choices))
-;; 	  (let (this
-;; 		(handler 'cons)
-;; 		(ret (and (memq (car val) '(+ -))
-;; 			  (copy-sequence (if (eq t (symbol-value (nth 1 desc)))
-;; 					     choices
-;; 					   (symbol-value (nth 1 desc)))))))
-;; 	    (setq choices (car  choices))
-;; 	    (while val
-;; 	      (setq this (car val))
-;; 	      (cond ((memq this choices)
-;; 		     (setq ret (funcall handler this ret)))
-;; 		    ((eq this '+) (setq handler 'cons))
-;; 		    ((eq this '-) (setq handler 'delq))
-;; 		    ((error "`%s' only accepts %s" key choices)))
-;; 	      (setq val (cdr val)))
-;; 	    (set (nth 1 desc) ret))
-;; 	(or (memq val choices)
-;; 	    (error "`%s' must be one of `%s'" key choices))
-;; 	(set (nth 1 desc) (eval (nth 3 desc))))
-;;       (setq args (cdr args)))
-;;     nil))
-
-;;; sanity-checking arglists
-
-(defun byte-compile-fdefinition (name macro-p)
-  (let* ((list (if macro-p
-		   byte-compile-macro-environment
-		 byte-compile-function-environment))
-	 (env (cdr (assq name list))))
-    (or env
-	(let ((fn name))
-	  (while (and (symbolp fn)
-		      (fboundp fn)
-		      (or (symbolp (symbol-function fn))
-			  (consp (symbol-function fn))
-			  (and (not macro-p)
-			       (byte-code-function-p (symbol-function fn)))))
-	    (setq fn (symbol-function fn)))
-	  (if (and (not macro-p) (byte-code-function-p fn))
-	      fn
-	    (and (consp fn)
-		 (if (eq 'macro (car fn))
-		     (cdr fn)
-		   (if macro-p
-		       nil
-		     (if (eq 'autoload (car fn))
-			 nil
-		       fn)))))))))
-
-(defun byte-compile-arglist-signature (arglist)
-  (let ((args 0)
-	opts
-	restp)
-    (while arglist
-      (cond ((eq (car arglist) '&optional)
-	     (or opts (setq opts 0)))
-	    ((eq (car arglist) '&rest)
-	     (if (cdr arglist)
-		 (setq restp t
-		       arglist nil)))
-	    (t
-	     (if opts
-		 (setq opts (1+ opts))
-		 (setq args (1+ args)))))
-      (setq arglist (cdr arglist)))
-    (cons args (if restp nil (if opts (+ args opts) args)))))
-
-
-(defun byte-compile-arglist-signatures-congruent-p (old new)
-  (not (or
-	 (> (car new) (car old))  ; requires more args now
-	 (and (null (cdr old))    ; took rest-args, doesn't any more
-	      (cdr new))
-	 (and (cdr new) (cdr old) ; can't take as many args now
-	      (< (cdr new) (cdr old)))
-	 )))
-
-(defun byte-compile-arglist-signature-string (signature)
-  (cond ((null (cdr signature))
-	 (format "%d+" (car signature)))
-	((= (car signature) (cdr signature))
-	 (format "%d" (car signature)))
-	(t (format "%d-%d" (car signature) (cdr signature)))))
-
-
-;; Warn if the form is calling a function with the wrong number of arguments.
-(defun byte-compile-callargs-warn (form)
-  (let* ((def (or (byte-compile-fdefinition (car form) nil)
-		  (byte-compile-fdefinition (car form) t)))
-	 (sig (and def (byte-compile-arglist-signature
-			 (if (eq 'lambda (car-safe def))
-			     (nth 1 def)
-			   (if (byte-code-function-p def)
-			       (aref def 0)
-			     '(&rest def))))))
-	 (ncall (length (cdr form))))
-    (if sig
-	(if (or (< ncall (car sig))
-		(and (cdr sig) (> ncall (cdr sig))))
-	    (byte-compile-warn
-	      "%s called with %d argument%s, but %s %s"
-	      (car form) ncall
-	      (if (= 1 ncall) "" "s")
-	      (if (< ncall (car sig))
-		  "requires"
-		  "accepts only")
-	      (byte-compile-arglist-signature-string sig)))
-      (or (fboundp (car form)) ; might be a subr or autoload.
-	  (eq (car form) byte-compile-current-form) ; ## this doesn't work with recursion.
-	  ;; It's a currently-undefined function.  Remember number of args in call.
-	  (let ((cons (assq (car form) byte-compile-unresolved-functions))
-		(n (length (cdr form))))
-	    (if cons
-		(or (memq n (cdr cons))
-		    (setcdr cons (cons n (cdr cons))))
-		(setq byte-compile-unresolved-functions
-		      (cons (list (car form) n)
-			    byte-compile-unresolved-functions))))))))
-
-;; Warn if the function or macro is being redefined with a different
-;; number of arguments.
-(defun byte-compile-arglist-warn (form macrop)
-  (let ((old (byte-compile-fdefinition (nth 1 form) macrop)))
-    (if old
-	(let ((sig1 (byte-compile-arglist-signature
-		      (if (eq 'lambda (car-safe old))
-			  (nth 1 old)
-			(if (byte-code-function-p old)
-			    (aref old 0)
-			  '(&rest def)))))
-	      (sig2 (byte-compile-arglist-signature (nth 2 form))))
-	  (or (byte-compile-arglist-signatures-congruent-p sig1 sig2)
-	      (byte-compile-warn "%s %s used to take %s %s, now takes %s"
-		(if (eq (car form) 'defun) "function" "macro")
-		(nth 1 form)
-		(byte-compile-arglist-signature-string sig1)
-		(if (equal sig1 '(1 . 1)) "argument" "arguments")
-		(byte-compile-arglist-signature-string sig2))))
-      ;; This is the first definition.  See if previous calls are compatible.
-      (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions))
-	    nums sig min max)
-	(if calls
-	    (progn
-	      (setq sig (byte-compile-arglist-signature (nth 2 form))
-		    nums (sort (copy-sequence (cdr calls)) (function <))
-		    min (car nums)
-		    max (car (nreverse nums)))
-	      (if (or (< min (car sig))
-		      (and (cdr sig) (> max (cdr sig))))
-		  (byte-compile-warn
-	    "%s being defined to take %s%s, but was previously called with %s"
-	            (nth 1 form)
-		    (byte-compile-arglist-signature-string sig)
-		    (if (equal sig '(1 . 1)) " arg" " args")
-		    (byte-compile-arglist-signature-string (cons min max))))
-	      
-	      (setq byte-compile-unresolved-functions
-		    (delq calls byte-compile-unresolved-functions)))))
-      )))
-
-;; If we have compiled any calls to functions which are not known to be 
-;; defined, issue a warning enumerating them.
-;; `unresolved' in the list `byte-compile-warnings' disables this.
-(defun byte-compile-warn-about-unresolved-functions ()
-  (if (memq 'unresolved byte-compile-warnings)
-   (let ((byte-compile-current-form "the end of the data"))
-    (if (cdr byte-compile-unresolved-functions)
-	(let* ((str "The following functions are not known to be defined: ")
-	       (L (length str))
-	       (rest (reverse byte-compile-unresolved-functions))
-	       s)
-	  (while rest
-	    (setq s (symbol-name (car (car rest)))
-		  L (+ L (length s) 2)
-		  rest (cdr rest))
-	    (if (< L (1- fill-column))
-		(setq str (concat str " " s (and rest ",")))
-	      (setq str (concat str "\n    " s (and rest ","))
-		    L (+ (length s) 4))))
-	  (byte-compile-warn "%s" str))
-	(if byte-compile-unresolved-functions
-	    (byte-compile-warn "the function %s is not known to be defined."
-	      (car (car byte-compile-unresolved-functions)))))))
-  nil)
-
-
-(defmacro byte-compile-constp (form)
-  ;; Returns non-nil if FORM is a constant.
-  (` (cond ((consp (, form)) (eq (car (, form)) 'quote))
-	   ((not (symbolp (, form))))
-	   ((memq (, form) '(nil t))))))
-
-(defmacro byte-compile-close-variables (&rest body)
-  (cons 'let
-	(cons '(;;
-		;; Close over these variables to encapsulate the
-		;; compilation state
-		;;
-		(byte-compile-macro-environment
-		 ;; Copy it because the compiler may patch into the
-		 ;; macroenvironment.
-		 (copy-alist byte-compile-initial-macro-environment))
-		(byte-compile-function-environment nil)
-		(byte-compile-bound-variables nil)
-		(byte-compile-free-references nil)
-		(byte-compile-free-assignments nil)
-		;;
-		;; Close over these variables so that `byte-compiler-options'
-		;; can change them on a per-file basis.
-		;;
-		(byte-compile-verbose byte-compile-verbose)
-		(byte-optimize byte-optimize)
-		(byte-compile-compatibility byte-compile-compatibility)
-		(byte-compile-dynamic byte-compile-dynamic)
-		(byte-compile-dynamic-docstrings
-		 byte-compile-dynamic-docstrings)
-;; 		(byte-compile-generate-emacs19-bytecodes
-;; 		 byte-compile-generate-emacs19-bytecodes)
-		(byte-compile-warnings (if (eq byte-compile-warnings t)
-					   byte-compile-warning-types
-					 byte-compile-warnings))
-		)
-	      body)))
-
-(defvar byte-compile-warnings-point-max nil)
-(defmacro displaying-byte-compile-warnings (&rest body)
-  (list 'let
-	'((byte-compile-warnings-point-max byte-compile-warnings-point-max))
-     ;; Log the file name.
-     '(byte-compile-log-file)
-     ;; Record how much is logged now.
-     ;; We will display the log buffer if anything more is logged
-     ;; before the end of BODY.
-     '(or byte-compile-warnings-point-max
-	  (save-excursion
-	    (set-buffer (get-buffer-create "*Compile-Log*"))
-	    (setq byte-compile-warnings-point-max (point-max))))
-     (list 'unwind-protect
-	   (list 'condition-case 'error-info
-		 (cons 'progn body)
-	       '(error
-		 (byte-compile-report-error error-info)))
-       '(save-excursion
-	  ;; If there were compilation warnings, display them.
-	  (set-buffer "*Compile-Log*")
-	  (if (= byte-compile-warnings-point-max (point-max))
-	      nil
-	    (select-window
-	     (prog1 (selected-window)
-	       (select-window (display-buffer (current-buffer)))
-	       (goto-char byte-compile-warnings-point-max)
-	       (recenter 1))))))))
-
-
-;;;###autoload
-(defun byte-force-recompile (directory)
-  "Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
-Files in subdirectories of DIRECTORY are processed also."
-  (interactive "DByte force recompile (directory): ")
-  (byte-recompile-directory directory nil t))
-
-;;;###autoload
-(defun byte-recompile-directory (directory &optional arg force)
-  "Recompile every `.el' file in DIRECTORY that needs recompilation.
-This is if a `.elc' file exists but is older than the `.el' file.
-Files in subdirectories of DIRECTORY are processed also.
-
-If the `.elc' file does not exist, normally the `.el' file is *not* compiled.
-But a prefix argument (optional second arg) means ask user,
-for each such `.el' file, whether to compile it.  Prefix argument 0 means
-don't ask and compile the file anyway.
-
-A nonzero prefix argument also means ask about each subdirectory.
-
-If the third argument FORCE is non-nil,
-recompile every `.el' file that already has a `.elc' file."
-  (interactive "DByte recompile directory: \nP")
-  (if arg
-      (setq arg (prefix-numeric-value arg)))
-  (if noninteractive
-      nil
-    (save-some-buffers)
-    (force-mode-line-update))
-  (let ((directories (list (expand-file-name directory)))
-	(file-count 0)
-	(dir-count 0)
-	last-dir)
-    (displaying-byte-compile-warnings
-     (while directories
-       (setq directory (car directories))
-       (or noninteractive (message "Checking %s..." directory))
-       (let ((files (directory-files directory))
-	     source dest)
-	 (while files
-	   (setq source (expand-file-name (car files) directory))
-	   (if (and (not (member (car files) '("." ".." "RCS" "CVS")))
-		    (file-directory-p source)
-		    (not (file-symlink-p source)))
-	       ;; This file is a subdirectory.  Handle them differently.
-	       (if (or (null arg)
-		       (eq 0 arg)
-		       (y-or-n-p (concat "Check " source "? ")))
-		   (setq directories
-			 (nconc directories (list source))))
-	     ;; It is an ordinary file.  Decide whether to compile it.
-	     (if (and (string-match emacs-lisp-file-regexp source)
-		      (not (auto-save-file-name-p source))
-		      (setq dest (byte-compile-dest-file source))
-		      (if (file-exists-p dest)
-			  ;; File was already compiled.
-			  (or force (file-newer-than-file-p source dest))
-			;; No compiled file exists yet.
-			(and arg
-			     (or (eq 0 arg)
-				 (y-or-n-p (concat "Compile " source "? "))))))
-		 (progn (if (and noninteractive (not byte-compile-verbose))
-			    (message "Compiling %s..." source))
-			(byte-compile-file source)
-			(or noninteractive
-			    (message "Checking %s..." directory))
-			(setq file-count (1+ file-count))
-			(if (not (eq last-dir directory))
-			    (setq last-dir directory
-				  dir-count (1+ dir-count)))
-			)))
-	   (setq files (cdr files))))
-       (setq directories (cdr directories))))
-    (message "Done (Total of %d file%s compiled%s)"
-	     file-count (if (= file-count 1) "" "s")
-	     (if (> dir-count 1) (format " in %d directories" dir-count) ""))))
-
-;;;###autoload
-(defun byte-compile-file (filename &optional load)
-  "Compile a file of Lisp code named FILENAME into a file of byte code.
-The output file's name is made by appending `c' to the end of FILENAME.
-With prefix arg (noninteractively: 2nd arg), load the file after compiling."
-;;  (interactive "fByte compile file: \nP")
-  (interactive
-   (let ((file buffer-file-name)
-	 (file-name nil)
-	 (file-dir nil))
-     (and file
-	  (eq (cdr (assq 'major-mode (buffer-local-variables)))
-	      'emacs-lisp-mode)
-	  (setq file-name (file-name-nondirectory file)
-		file-dir (file-name-directory file)))
-     (list (read-file-name (if current-prefix-arg
-			       "Byte compile and load file: "
-			     "Byte compile file: ")
-			   file-dir file-name nil)
-	   current-prefix-arg)))
-  ;; Expand now so we get the current buffer's defaults
-  (setq filename (expand-file-name filename))
-
-  ;; If we're compiling a file that's in a buffer and is modified, offer
-  ;; to save it first.
-  (or noninteractive
-      (let ((b (get-file-buffer (expand-file-name filename))))
-	(if (and b (buffer-modified-p b)
-		 (y-or-n-p (format "save buffer %s first? " (buffer-name b))))
-	    (save-excursion (set-buffer b) (save-buffer)))))
-
-  (if byte-compile-verbose
-      (message "Compiling %s..." filename))
-  (let ((byte-compile-current-file filename)
-	target-file input-buffer output-buffer
-	byte-compile-dest-file)
-    (setq target-file (byte-compile-dest-file filename))
-    (setq byte-compile-dest-file target-file)
-    (save-excursion
-      (setq input-buffer (get-buffer-create " *Compiler Input*"))
-      (set-buffer input-buffer)
-      (erase-buffer)
-      (insert-file-contents filename)
-      ;; Run hooks including the uncompression hook.
-      ;; If they change the file name, then change it for the output also.
-      (let ((buffer-file-name filename)
-	    (default-major-mode 'emacs-lisp-mode)
-	    (enable-local-eval nil))
-        (normal-mode)
-        (setq filename buffer-file-name))
-      ;; Set the default directory, in case an eval-when-compile uses it.
-      (setq default-directory (file-name-directory filename)))
-    (setq byte-compiler-error-flag nil)
-    ;; It is important that input-buffer not be current at this call,
-    ;; so that the value of point set in input-buffer
-    ;; within byte-compile-from-buffer lingers in that buffer.
-    (setq output-buffer (byte-compile-from-buffer input-buffer filename))
-    (if byte-compiler-error-flag
-	nil
-      (if byte-compile-verbose
-	  (message "Compiling %s...done" filename))
-      (kill-buffer input-buffer)
-      (save-excursion
-	(set-buffer output-buffer)
-	(goto-char (point-max))
-	(insert "\n")			; aaah, unix.
-	(let ((vms-stmlf-recfm t))
-	  (if (file-writable-p target-file)
-	      (let ((kanji-flag nil))	; for nemacs, from Nakagawa Takayuki
-		(if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
-		    (setq buffer-file-type t))
-		(write-region 1 (point-max) target-file))
-	    ;; This is just to give a better error message than
-	    ;; write-region
-	    (signal 'file-error
-		    (list "Opening output file"
-			  (if (file-exists-p target-file)
-			      "cannot overwrite file"
-			    "directory not writable or nonexistent")
-			  target-file))))
-	(kill-buffer (current-buffer)))
-      (if (and byte-compile-generate-call-tree
-	       (or (eq t byte-compile-generate-call-tree)
-		   (y-or-n-p (format "Report call tree for %s? " filename))))
-	  (save-excursion
-	    (display-call-tree filename)))
-      (if load
-	  (load target-file))
-      t)))
-
-;;(defun byte-compile-and-load-file (&optional filename)
-;;  "Compile a file of Lisp code named FILENAME into a file of byte code,
-;;and then load it.  The output file's name is made by appending \"c\" to 
-;;the end of FILENAME."
-;;  (interactive)
-;;  (if filename ; I don't get it, (interactive-p) doesn't always work
-;;      (byte-compile-file filename t)
-;;    (let ((current-prefix-arg '(4)))
-;;      (call-interactively 'byte-compile-file))))
-
-;;(defun byte-compile-buffer (&optional buffer)
-;;  "Byte-compile and evaluate contents of BUFFER (default: the current buffer)."
-;;  (interactive "bByte compile buffer: ")
-;;  (setq buffer (if buffer (get-buffer buffer) (current-buffer)))
-;;  (message "Compiling %s..." (buffer-name buffer))
-;;  (let* ((filename (or (buffer-file-name buffer)
-;;		       (concat "#<buffer " (buffer-name buffer) ">")))
-;;	 (byte-compile-current-file buffer))
-;;    (byte-compile-from-buffer buffer nil))
-;;  (message "Compiling %s...done" (buffer-name buffer))
-;;  t)
-
-;;; compiling a single function
-;;;###autoload
-(defun compile-defun (&optional arg)
-  "Compile and evaluate the current top-level form.
-Print the result in the minibuffer.
-With argument, insert value in current buffer after the form."
-  (interactive "P")
-  (save-excursion
-    (end-of-defun)
-    (beginning-of-defun)
-    (let* ((byte-compile-current-file nil)
-	   (byte-compile-last-warned-form 'nothing)
-	   (value (eval (displaying-byte-compile-warnings
-			 (byte-compile-sexp (read (current-buffer)))))))
-      (cond (arg
-	     (message "Compiling from buffer... done.")
-	     (prin1 value (current-buffer))
-	     (insert "\n"))
-	    ((message "%s" (prin1-to-string value)))))))
-
-
-(defun byte-compile-from-buffer (inbuffer &optional filename)
-  ;; Filename is used for the loading-into-Emacs-18 error message.
-  (let (outbuffer
-	;; Prevent truncation of flonums and lists as we read and print them
-	(float-output-format nil)
-	(case-fold-search nil)
-	(print-length nil)
-	(print-level nil)
-	;; Simulate entry to byte-compile-top-level
-	(byte-compile-constants nil)
-	(byte-compile-variables nil)
-	(byte-compile-tag-number 0)
-	(byte-compile-depth 0)
-	(byte-compile-maxdepth 0)
-	(byte-compile-output nil)
-	;;	  #### This is bound in b-c-close-variables.
-	;;	  (byte-compile-warnings (if (eq byte-compile-warnings t)
-	;;				     byte-compile-warning-types
-	;;				   byte-compile-warnings))
-	)
-    (byte-compile-close-variables
-     (save-excursion
-       (setq outbuffer
-	     (set-buffer (get-buffer-create " *Compiler Output*")))
-       (erase-buffer)
-       ;;	 (emacs-lisp-mode)
-       (setq case-fold-search nil)
-       (and filename (byte-compile-insert-header filename inbuffer outbuffer))
-
-       ;; This is a kludge.  Some operating systems (OS/2, DOS) need to
-       ;; write files containing binary information specially.
-       ;; Under most circumstances, such files will be in binary
-       ;; overwrite mode, so those OS's use that flag to guess how
-       ;; they should write their data.  Advise them that .elc files
-       ;; need to be written carefully.
-       (setq overwrite-mode 'overwrite-mode-binary))
-     (displaying-byte-compile-warnings
-      (save-excursion
-	(set-buffer inbuffer)
-	(goto-char 1)
-
-	;; Compile the forms from the input buffer.
-	(while (progn
-		 (while (progn (skip-chars-forward " \t\n\^l")
-			       (looking-at ";"))
-		   (forward-line 1))
-		 (not (eobp)))
-	  (byte-compile-file-form (read inbuffer)))
-
-	;; Compile pending forms at end of file.
-	(byte-compile-flush-pending)
-	(byte-compile-warn-about-unresolved-functions)
-	;; Should we always do this?  When calling multiple files, it
-	;; would be useful to delay this warning until all have
-	;; been compiled.
-	(setq byte-compile-unresolved-functions nil))))
-    outbuffer))
-
-(defun byte-compile-insert-header (filename inbuffer outbuffer)
-  (set-buffer inbuffer)
-  (let ((dynamic-docstrings byte-compile-dynamic-docstrings)
-	(dynamic byte-compile-dynamic))
-    (set-buffer outbuffer)
-    (goto-char 1)
-    ;;
-    ;; The magic number of .elc files is ";ELC", or 0x3B454C43.  After that is
-    ;; the file-format version number (18 or 19) as a byte, followed by some
-    ;; nulls.  The primary motivation for doing this is to get some binary
-    ;; characters up in the first line of the file so that `diff' will simply
-    ;; say "Binary files differ" instead of actually doing a diff of two .elc
-    ;; files.  An extra benefit is that you can add this to /etc/magic:
-    ;;
-    ;; 0	string		;ELC		GNU Emacs Lisp compiled file,
-    ;; >4	byte		x		version %d
-    ;;
-    (insert
-     ";ELC"
-     (if (byte-compile-version-cond byte-compile-compatibility) 18 19)
-     "\000\000\000\n"
-     )
-    (insert ";;; Compiled by "
-	    (or (and (boundp 'user-mail-address) user-mail-address)
-		(concat (user-login-name) "@" (system-name)))
-	    " on "
-	    (current-time-string) "\n;;; from file " filename "\n")
-    (insert ";;; in Emacs version " emacs-version "\n")
-    (insert ";;; with bytecomp version "
-	    (progn (string-match "[0-9.]+" byte-compile-version)
-		   (match-string 0 byte-compile-version))
-	    "\n;;; "
-	    (cond
-	     ((eq byte-optimize 'source) "with source-level optimization only")
-	     ((eq byte-optimize 'byte) "with byte-level optimization only")
-	     (byte-optimize "with all optimizations")
-	     (t "without optimization"))
-	    (if (byte-compile-version-cond byte-compile-compatibility)
-		"; compiled with Emacs 18 compatibility.\n"
-	      ".\n"))
-    (if dynamic
-	(insert ";;; Function definitions are lazy-loaded.\n"))
-    (if (not (byte-compile-version-cond byte-compile-compatibility))
-	(insert ";;; This file uses opcodes which do not exist in Emacs 18.\n"
-		;; Have to check if emacs-version is bound so that this works
-		;; in files loaded early in loadup.el.
-		"\n(if (and (boundp 'emacs-version)\n"
-		;; If there is a name at the end of emacs-version,
-		;; don't try to check the version number.
-		"\t (< (aref emacs-version (1- (length emacs-version))) ?A)\n"
-		"\t (or (and (boundp 'epoch::version) epoch::version)\n"
-		(if dynamic-docstrings
-		    "\t     (string-lessp emacs-version \"19.29\")))\n"
-		  "\t     (string-lessp emacs-version \"19\")))\n")
-		"    (error \"`"
-		;; prin1-to-string is used to quote backslashes.
-		(substring (prin1-to-string (file-name-nondirectory filename))
-			   1 -1)
-		(if dynamic-docstrings
-		    "' was compiled for Emacs 19.29 or later\"))\n\n"
-		  "' was compiled for Emacs 19\"))\n\n"))
-      (insert "(or (boundp 'current-load-list) (setq current-load-list nil))\n"
-	      "\n")
-      )))
-
-
-(defun byte-compile-output-file-form (form)
-  ;; writes the given form to the output buffer, being careful of docstrings
-  ;; in defun, defmacro, defvar, defconst and autoload because make-docfile is
-  ;; so amazingly stupid.
-  ;; defalias calls are output directly by byte-compile-file-form-defmumble;
-  ;; it does not pay to first build the defalias in defmumble and then parse
-  ;; it here.
-  (if (and (memq (car-safe form) '(defun defmacro defvar defconst autoload))
-	   (stringp (nth 3 form)))
-      (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil
-				   (eq (car form) 'autoload))
-    (let ((print-escape-newlines t)
-	  (print-length nil)
-	  (print-level nil)
-	  (print-quoted t)
-	  (print-gensym t))
-      (princ "\n" outbuffer)
-      (prin1 form outbuffer)
-      nil)))
-
-(defun byte-compile-output-docform (preface name info form specindex quoted)
-  "Print a form with a doc string.  INFO is (prefix doc-index postfix).
-If PREFACE and NAME are non-nil, print them too,
-before INFO and the FORM but after the doc string itself.
-If SPECINDEX is non-nil, it is the index in FORM
-of the function bytecode string.  In that case,
-we output that argument and the following argument (the constants vector)
-together, for lazy loading.
-QUOTED says that we have to put a quote before the
-list that represents a doc string reference.
-`autoload' needs that."
-  ;; We need to examine byte-compile-dynamic-docstrings
-  ;; in the input buffer (now current), not in the output buffer.
-  (let ((dynamic-docstrings byte-compile-dynamic-docstrings))
-    (set-buffer
-     (prog1 (current-buffer)
-       (set-buffer outbuffer)
-       (let (position)
-
-	 ;; Insert the doc string, and make it a comment with #@LENGTH.
-	 (and (>= (nth 1 info) 0)
-	      dynamic-docstrings
-	      (not byte-compile-compatibility)
-	      (progn
-		;; Make the doc string start at beginning of line
-		;; for make-docfile's sake.
-		(insert "\n")
-		(setq position
-		      (byte-compile-output-as-comment
-		       (nth (nth 1 info) form) nil))
-		;; If the doc string starts with * (a user variable),
-		;; negate POSITION.
-		(if (and (stringp (nth (nth 1 info) form))
-			 (> (length (nth (nth 1 info) form)) 0)
-			 (eq (aref (nth (nth 1 info) form) 0) ?*))
-		    (setq position (- position)))))
-
-	 (if preface
-	     (progn
-	       (insert preface)
-	       (prin1 name outbuffer)))
-	 (insert (car info))
-	 (let ((print-escape-newlines t)
-	       (print-quoted t)
-	       (print-gensym t)
-	       (index 0))
-	   (prin1 (car form) outbuffer)
-	   (while (setq form (cdr form))
-	     (setq index (1+ index))
-	     (insert " ")
-	     (cond ((and (numberp specindex) (= index specindex))
-		    (let ((position
-			   (byte-compile-output-as-comment
-			    (cons (car form) (nth 1 form))
-			    t)))
-		      (princ (format "(#$ . %d) nil" position) outbuffer)
-		      (setq form (cdr form))
-		      (setq index (1+ index))))
-		   ((= index (nth 1 info))
-		    (if position
-			(princ (format (if quoted "'(#$ . %d)"  "(#$ . %d)")
-				       position)
-			       outbuffer)
-		      (let ((print-escape-newlines nil))
-			(goto-char (prog1 (1+ (point))
-				     (prin1 (car form) outbuffer)))
-			(insert "\\\n")
-			(goto-char (point-max)))))
-		   (t
-		    (prin1 (car form) outbuffer)))))
-	 (insert (nth 2 info))))))
-  nil)
-
-(defun byte-compile-keep-pending (form &optional handler)
-  (if (memq byte-optimize '(t source))
-      (setq form (byte-optimize-form form t)))
-  (if handler
-      (let ((for-effect t))
-	;; To avoid consing up monstrously large forms at load time, we split
-	;; the output regularly.
-	(and (memq (car-safe form) '(fset defalias))
-	     (nthcdr 300 byte-compile-output)
-	     (byte-compile-flush-pending))
-	(funcall handler form)
-	(if for-effect
-	    (byte-compile-discard)))
-    (byte-compile-form form t))
-  nil)
-
-(defun byte-compile-flush-pending ()
-  (if byte-compile-output
-      (let ((form (byte-compile-out-toplevel t 'file)))
-	(cond ((eq (car-safe form) 'progn)
-	       (mapcar 'byte-compile-output-file-form (cdr form)))
-	      (form
-	       (byte-compile-output-file-form form)))
-	(setq byte-compile-constants nil
-	      byte-compile-variables nil
-	      byte-compile-depth 0
-	      byte-compile-maxdepth 0
-	      byte-compile-output nil))))
-
-(defun byte-compile-file-form (form)
-  (let ((byte-compile-current-form nil)	; close over this for warnings.
-	handler)
-    (cond
-     ((not (consp form))
-      (byte-compile-keep-pending form))
-     ((and (symbolp (car form))
-	   (setq handler (get (car form) 'byte-hunk-handler)))
-      (cond ((setq form (funcall handler form))
-	     (byte-compile-flush-pending)
-	     (byte-compile-output-file-form form))))
-     ((eq form (setq form (macroexpand form byte-compile-macro-environment)))
-      (byte-compile-keep-pending form))
-     (t
-      (byte-compile-file-form form)))))
-
-;; Functions and variables with doc strings must be output separately,
-;; so make-docfile can recognise them.  Most other things can be output
-;; as byte-code.
-
-(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst)
-(defun byte-compile-file-form-defsubst (form)
-  (cond ((assq (nth 1 form) byte-compile-unresolved-functions)
-	 (setq byte-compile-current-form (nth 1 form))
-	 (byte-compile-warn "defsubst %s was used before it was defined"
-			    (nth 1 form))))
-  (byte-compile-file-form
-   (macroexpand form byte-compile-macro-environment))
-  ;; Return nil so the form is not output twice.
-  nil)
-
-(put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload)
-(defun byte-compile-file-form-autoload (form)
-  (and (let ((form form))
-	 (while (if (setq form (cdr form)) (byte-compile-constp (car form))))
-	 (null form))			;Constants only
-       (eval (nth 5 form))		;Macro
-       (eval form))			;Define the autoload.
-  (if (stringp (nth 3 form))
-      form
-    ;; No doc string, so we can compile this as a normal form.
-    (byte-compile-keep-pending form 'byte-compile-normal-call)))
-
-(put 'defvar   'byte-hunk-handler 'byte-compile-file-form-defvar)
-(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
-(defun byte-compile-file-form-defvar (form)
-  (if (null (nth 3 form))
-      ;; Since there is no doc string, we can compile this as a normal form,
-      ;; and not do a file-boundary.
-      (byte-compile-keep-pending form)
-    (if (memq 'free-vars byte-compile-warnings)
-	(setq byte-compile-bound-variables
-	      (cons (nth 1 form) byte-compile-bound-variables)))
-    (cond ((consp (nth 2 form))
-	   (setq form (copy-sequence form))
-	   (setcar (cdr (cdr form))
-		   (byte-compile-top-level (nth 2 form) nil 'file))))
-    form))
-
-(put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary)
-(defun byte-compile-file-form-eval-boundary (form)
-  (eval form)
-  (byte-compile-keep-pending form 'byte-compile-normal-call))
-
-(put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn)
-(put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn)
-(put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn)
-(defun byte-compile-file-form-progn (form)
-  (mapcar 'byte-compile-file-form (cdr form))
-  ;; Return nil so the forms are not output twice.
-  nil)
-
-;; This handler is not necessary, but it makes the output from dont-compile
-;; and similar macros cleaner.
-(put 'eval 'byte-hunk-handler 'byte-compile-file-form-eval)
-(defun byte-compile-file-form-eval (form)
-  (if (eq (car-safe (nth 1 form)) 'quote)
-      (nth 1 (nth 1 form))
-    (byte-compile-keep-pending form)))
-
-(put 'defun 'byte-hunk-handler 'byte-compile-file-form-defun)
-(defun byte-compile-file-form-defun (form)
-  (byte-compile-file-form-defmumble form nil))
-
-(put 'defmacro 'byte-hunk-handler 'byte-compile-file-form-defmacro)
-(defun byte-compile-file-form-defmacro (form)
-  (byte-compile-file-form-defmumble form t))
-
-(defun byte-compile-file-form-defmumble (form macrop)
-  (let* ((name (car (cdr form)))
-	 (this-kind (if macrop 'byte-compile-macro-environment
-		      'byte-compile-function-environment))
-	 (that-kind (if macrop 'byte-compile-function-environment
-		      'byte-compile-macro-environment))
-	 (this-one (assq name (symbol-value this-kind)))
-	 (that-one (assq name (symbol-value that-kind)))
-	 (byte-compile-free-references nil)
-	 (byte-compile-free-assignments nil))
-
-    ;; When a function or macro is defined, add it to the call tree so that
-    ;; we can tell when functions are not used.
-    (if byte-compile-generate-call-tree
-	(or (assq name byte-compile-call-tree)
-	    (setq byte-compile-call-tree
-		  (cons (list name nil nil) byte-compile-call-tree))))
-
-    (setq byte-compile-current-form name) ; for warnings
-    (if (memq 'redefine byte-compile-warnings)
-	(byte-compile-arglist-warn form macrop))
-    (if byte-compile-verbose
-	(message "Compiling %s... (%s)" (or filename "") (nth 1 form)))
-    (cond (that-one
-	   (if (and (memq 'redefine byte-compile-warnings)
-		    ;; don't warn when compiling the stubs in byte-run...
-		    (not (assq (nth 1 form)
-			       byte-compile-initial-macro-environment)))
-	       (byte-compile-warn
-		 "%s defined multiple times, as both function and macro"
-		 (nth 1 form)))
-	   (setcdr that-one nil))
-	  (this-one
-	   (if (and (memq 'redefine byte-compile-warnings)
-		    ;; hack: don't warn when compiling the magic internal
-		    ;; byte-compiler macros in byte-run.el...
-		    (not (assq (nth 1 form)
-			       byte-compile-initial-macro-environment)))
-	       (byte-compile-warn "%s %s defined multiple times in this file"
-				  (if macrop "macro" "function")
-				  (nth 1 form))))
-	  ((and (fboundp name)
-		(eq (car-safe (symbol-function name))
-		    (if macrop 'lambda 'macro)))
-	   (if (memq 'redefine byte-compile-warnings)
-	       (byte-compile-warn "%s %s being redefined as a %s"
-				  (if macrop "function" "macro")
-				  (nth 1 form)
-				  (if macrop "macro" "function")))
-	   ;; shadow existing definition
-	   (set this-kind
-		(cons (cons name nil) (symbol-value this-kind))))
-	  )
-    (let ((body (nthcdr 3 form)))
-      (if (and (stringp (car body))
-	       (symbolp (car-safe (cdr-safe body)))
-	       (car-safe (cdr-safe body))
-	       (stringp (car-safe (cdr-safe (cdr-safe body)))))
-	  (byte-compile-warn "Probable `\"' without `\\' in doc string of %s"
-			     (nth 1 form))))
-    (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
-	   (code (byte-compile-byte-code-maker new-one)))
-      (if this-one
-	  (setcdr this-one new-one)
-	(set this-kind
-	     (cons (cons name new-one) (symbol-value this-kind))))
-      (if (and (stringp (nth 3 form))
-	       (eq 'quote (car-safe code))
-	       (eq 'lambda (car-safe (nth 1 code))))
-	  (cons (car form)
-		(cons name (cdr (nth 1 code))))
-	(byte-compile-flush-pending)
-	(if (not (stringp (nth 3 form)))
-	    ;; No doc string.  Provide -1 as the "doc string index"
-	    ;; so that no element will be treated as a doc string.
-	    (byte-compile-output-docform
-	     (if (byte-compile-version-cond byte-compile-compatibility)
-		 "\n(fset '" "\n(defalias '")
-	     name
-	     (cond ((atom code)
-		    (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")))
-		   ((eq (car code) 'quote)
-		    (setq code new-one)
-		    (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")")))
-		   ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")"))))
-	     (append code nil)
-	     (and (atom code) byte-compile-dynamic
-		  1)
-	     nil)
-	  ;; Output the form by hand, that's much simpler than having
-	  ;; b-c-output-file-form analyze the defalias.
-	  (byte-compile-output-docform
-	   (if (byte-compile-version-cond byte-compile-compatibility)
-	       "\n(fset '" "\n(defalias '")
-	   name
-	   (cond ((atom code)
-		  (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")))
-		 ((eq (car code) 'quote)
-		  (setq code new-one)
-		  (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")")))
-		 ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")"))))
-	   (append code nil)
-	   (and (atom code) byte-compile-dynamic
-		1)
-	   nil))
-	(princ ")" outbuffer)
-	nil))))
-
-;; Print Lisp object EXP in the output file, inside a comment,
-;; and return the file position it will have.
-;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting.
-(defun byte-compile-output-as-comment (exp quoted)
-  (let ((position (point)))
-    (set-buffer
-     (prog1 (current-buffer)
-       (set-buffer outbuffer)
-
-       ;; Insert EXP, and make it a comment with #@LENGTH.
-       (insert " ")
-       (if quoted
-	   (prin1 exp outbuffer)
-	 (princ exp outbuffer))
-       (goto-char position)
-       ;; Quote certain special characters as needed.
-       ;; get_doc_string in doc.c does the unquoting.
-       (while (search-forward "\^A" nil t)
-	 (replace-match "\^A\^A" t t))
-       (goto-char position)
-       (while (search-forward "\000" nil t)
-	 (replace-match "\^A0" t t))
-       (goto-char position)
-       (while (search-forward "\037" nil t)
-	 (replace-match "\^A_" t t))
-       (goto-char (point-max))
-       (insert "\037")
-       (goto-char position)
-       (insert "#@" (format "%d" (- (point-max) position)))
-
-       ;; Save the file position of the object.
-       ;; Note we should add 1 to skip the space
-       ;; that we inserted before the actual doc string,
-       ;; and subtract 1 to convert from an 1-origin Emacs position
-       ;; to a file position; they cancel.
-       (setq position (point))
-       (goto-char (point-max))))
-    position))
-
-
-
-;;;###autoload
-(defun byte-compile (form)
-  "If FORM is a symbol, byte-compile its function definition.
-If FORM is a lambda or a macro, byte-compile it as a function."
-  (displaying-byte-compile-warnings
-   (byte-compile-close-variables
-    (let* ((fun (if (symbolp form)
-		    (and (fboundp form) (symbol-function form))
-		  form))
-	   (macro (eq (car-safe fun) 'macro)))
-      (if macro
-	  (setq fun (cdr fun)))
-      (cond ((eq (car-safe fun) 'lambda)
-	     (setq fun (if macro
-			   (cons 'macro (byte-compile-lambda fun))
-			 (byte-compile-lambda fun)))
-	     (if (symbolp form)
-		 (defalias form fun)
-	       fun)))))))
-
-(defun byte-compile-sexp (sexp)
-  "Compile and return SEXP."
-  (displaying-byte-compile-warnings
-   (byte-compile-close-variables
-    (byte-compile-top-level sexp))))
-
-;; Given a function made by byte-compile-lambda, make a form which produces it.
-(defun byte-compile-byte-code-maker (fun)
-  (cond
-   ((byte-compile-version-cond byte-compile-compatibility)
-    ;; Return (quote (lambda ...)).
-    (list 'quote (byte-compile-byte-code-unmake fun)))
-   ;; ## atom is faster than compiled-func-p.
-   ((atom fun)				; compiled function.
-    ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda
-    ;; would have produced a lambda.
-    fun)
-   ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial
-   ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off.
-   ((let (tmp)
-      (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun))))
-	       (null (cdr (memq tmp fun))))
-	  ;; Generate a make-byte-code call.
-	  (let* ((interactive (assq 'interactive (cdr (cdr fun)))))
-	    (nconc (list 'make-byte-code
-			 (list 'quote (nth 1 fun)) ;arglist
-			 (nth 1 tmp)	;bytes
-			 (nth 2 tmp)	;consts
-			 (nth 3 tmp))	;depth
-		   (cond ((stringp (nth 2 fun))
-			  (list (nth 2 fun))) ;doc
-			 (interactive
-			  (list nil)))
-		   (cond (interactive
-			  (list (if (or (null (nth 1 interactive))
-					(stringp (nth 1 interactive)))
-				    (nth 1 interactive)
-				  ;; Interactive spec is a list or a variable
-				  ;; (if it is correct).
-				  (list 'quote (nth 1 interactive))))))))
-	;; a non-compiled function (probably trivial)
-	(list 'quote fun))))))
-
-;; Turn a function into an ordinary lambda.  Needed for v18 files.
-(defun byte-compile-byte-code-unmake (function)
-  (if (consp function)
-      function;;It already is a lambda.
-    (setq function (append function nil)) ; turn it into a list
-    (nconc (list 'lambda (nth 0 function))
-	   (and (nth 4 function) (list (nth 4 function)))
-	   (if (nthcdr 5 function)
-	       (list (cons 'interactive (if (nth 5 function)
-					    (nthcdr 5 function)))))
-	   (list (list 'byte-code
-		       (nth 1 function) (nth 2 function)
-		       (nth 3 function))))))
-
-
-;; Byte-compile a lambda-expression and return a valid function.
-;; The value is usually a compiled function but may be the original
-;; lambda-expression.
-(defun byte-compile-lambda (fun)
-  (let* ((arglist (nth 1 fun))
-	 (byte-compile-bound-variables
-	  (nconc (and (memq 'free-vars byte-compile-warnings)
-		      (delq '&rest (delq '&optional (copy-sequence arglist))))
-		 byte-compile-bound-variables))
-	 (body (cdr (cdr fun)))
-	 (doc (if (stringp (car body))
-		  (prog1 (car body)
-		    ;; Discard the doc string
-		    ;; unless it is the last element of the body.
-		    (if (nthcdr 2 body)
-			(setq body (cdr body))))))
-	 (int (assq 'interactive body)))
-    (cond (int
-	   ;; Skip (interactive) if it is in front (the most usual location).
-	   (if (eq int (car body))
-	       (setq body (cdr body)))
-	   (cond ((consp (cdr int))
-		  (if (cdr (cdr int))
-		      (byte-compile-warn "malformed interactive spec: %s"
-					 (prin1-to-string int)))
-		  ;; If the interactive spec is a call to `list',
-		  ;; don't compile it, because `call-interactively'
-		  ;; looks at the args of `list'.
-		  (let ((form (nth 1 int)))
-		    (while (or (eq (car-safe form) 'let)
-			       (eq (car-safe form) 'let*)
-			       (eq (car-safe form) 'save-excursion))
-		      (while (consp (cdr form))
-			(setq form (cdr form)))
-		      (setq form (car form)))
-		    (or (eq (car-safe form) 'list)
-			(setq int (list 'interactive
-					(byte-compile-top-level (nth 1 int)))))))
-		 ((cdr int)
-		  (byte-compile-warn "malformed interactive spec: %s"
-				     (prin1-to-string int))))))
-    (let ((compiled (byte-compile-top-level (cons 'progn body) nil 'lambda)))
-      (if (and (eq 'byte-code (car-safe compiled))
-	       (not (byte-compile-version-cond
-		     byte-compile-compatibility)))
-	  (apply 'make-byte-code
-		 (append (list arglist)
-			 ;; byte-string, constants-vector, stack depth
-			 (cdr compiled)
-			 ;; optionally, the doc string.
-			 (if (or doc int)
-			     (list doc))
-			 ;; optionally, the interactive spec.
-			 (if int
-			     (list (nth 1 int)))))
-	(setq compiled
-	      (nconc (if int (list int))
-		     (cond ((eq (car-safe compiled) 'progn) (cdr compiled))
-			   (compiled (list compiled)))))
-	(nconc (list 'lambda arglist)
-	       (if (or doc (stringp (car compiled)))
-		   (cons doc (cond (compiled)
-				   (body (list nil))))
-		 compiled))))))
-
-(defun byte-compile-constants-vector ()
-  ;; Builds the constants-vector from the current variables and constants.
-  ;;   This modifies the constants from (const . nil) to (const . offset).
-  ;; To keep the byte-codes to look up the vector as short as possible:
-  ;;   First 6 elements are vars, as there are one-byte varref codes for those.
-  ;;   Next up to byte-constant-limit are constants, still with one-byte codes.
-  ;;   Next variables again, to get 2-byte codes for variable lookup.
-  ;;   The rest of the constants and variables need 3-byte byte-codes.
-  (let* ((i -1)
-	 (rest (nreverse byte-compile-variables)) ; nreverse because the first
-	 (other (nreverse byte-compile-constants)) ; vars often are used most.
-	 ret tmp
-	 (limits '(5			; Use the 1-byte varref codes,
-		   63  ; 1-constlim	;  1-byte byte-constant codes,
-		   255			;  2-byte varref codes,
-		   65535))		;  3-byte codes for the rest.
-	 limit)
-    (while (or rest other)
-      (setq limit (car limits))
-      (while (and rest (not (eq i limit)))
-	(if (setq tmp (assq (car (car rest)) ret))
-	    (setcdr (car rest) (cdr tmp))
-	  (setcdr (car rest) (setq i (1+ i)))
-	  (setq ret (cons (car rest) ret)))
-	(setq rest (cdr rest)))
-      (setq limits (cdr limits)
-	    rest (prog1 other
-		   (setq other rest))))
-    (apply 'vector (nreverse (mapcar 'car ret)))))
-
-;; Given an expression FORM, compile it and return an equivalent byte-code
-;; expression (a call to the function byte-code).
-(defun byte-compile-top-level (form &optional for-effect output-type)
-  ;; OUTPUT-TYPE advises about how form is expected to be used:
-  ;;	'eval or nil	-> a single form,
-  ;;	'progn or t	-> a list of forms,
-  ;;	'lambda		-> body of a lambda,
-  ;;	'file		-> used at file-level.
-  (let ((byte-compile-constants nil)
-	(byte-compile-variables nil)
-	(byte-compile-tag-number 0)
-	(byte-compile-depth 0)
-	(byte-compile-maxdepth 0)
-	(byte-compile-output nil))
-     (if (memq byte-optimize '(t source))
-	 (setq form (byte-optimize-form form for-effect)))
-     (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
-       (setq form (nth 1 form)))
-     (if (and (eq 'byte-code (car-safe form))
-	      (not (memq byte-optimize '(t byte)))
-	      (stringp (nth 1 form)) (vectorp (nth 2 form))
-	      (natnump (nth 3 form)))
-	 form
-       (byte-compile-form form for-effect)
-       (byte-compile-out-toplevel for-effect output-type))))
-
-(defun byte-compile-out-toplevel (&optional for-effect output-type)
-  (if for-effect
-      ;; The stack is empty. Push a value to be returned from (byte-code ..).
-      (if (eq (car (car byte-compile-output)) 'byte-discard)
-	  (setq byte-compile-output (cdr byte-compile-output))
-	(byte-compile-push-constant
-	 ;; Push any constant - preferably one which already is used, and
-	 ;; a number or symbol - ie not some big sequence.  The return value
-	 ;; isn't returned, but it would be a shame if some textually large
-	 ;; constant was not optimized away because we chose to return it.
-	 (and (not (assq nil byte-compile-constants)) ; Nil is often there.
-	      (let ((tmp (reverse byte-compile-constants)))
-		(while (and tmp (not (or (symbolp (car (car tmp)))
-					 (numberp (car (car tmp))))))
-		  (setq tmp (cdr tmp)))
-		(car (car tmp)))))))
-  (byte-compile-out 'byte-return 0)
-  (setq byte-compile-output (nreverse byte-compile-output))
-  (if (memq byte-optimize '(t byte))
-      (setq byte-compile-output
-	    (byte-optimize-lapcode byte-compile-output for-effect)))
-  
-  ;; Decompile trivial functions:
-  ;; only constants and variables, or a single funcall except in lambdas.
-  ;; Except for Lisp_Compiled objects, forms like (foo "hi")
-  ;; are still quicker than (byte-code "..." [foo "hi"] 2).
-  ;; Note that even (quote foo) must be parsed just as any subr by the
-  ;; interpreter, so quote should be compiled into byte-code in some contexts.
-  ;; What to leave uncompiled:
-  ;;	lambda	-> never.  we used to leave it uncompiled if the body was
-  ;;		   a single atom, but that causes confusion if the docstring
-  ;;		   uses the (file . pos) syntax.  Besides, now that we have
-  ;;		   the Lisp_Compiled type, the compiled form is faster.
-  ;;	eval	-> atom, quote or (function atom atom atom)
-  ;;	progn	-> as <<same-as-eval>> or (progn <<same-as-eval>> atom)
-  ;;	file	-> as progn, but takes both quotes and atoms, and longer forms.
-  (let (rest
-	(maycall (not (eq output-type 'lambda))) ; t if we may make a funcall.
-	tmp body)
-    (cond
-     ;; #### This should be split out into byte-compile-nontrivial-function-p.
-     ((or (eq output-type 'lambda)
-	  (nthcdr (if (eq output-type 'file) 50 8) byte-compile-output)
-	  (assq 'TAG byte-compile-output) ; Not necessary, but speeds up a bit.
-	  (not (setq tmp (assq 'byte-return byte-compile-output)))
-	  (progn
-	    (setq rest (nreverse
-			(cdr (memq tmp (reverse byte-compile-output)))))
-	    (while (cond
-		    ((memq (car (car rest)) '(byte-varref byte-constant))
-		     (setq tmp (car (cdr (car rest))))
-		     (if (if (eq (car (car rest)) 'byte-constant)
-			     (or (consp tmp)
-				 (and (symbolp tmp)
-				      (not (memq tmp '(nil t))))))
-			 (if maycall
-			     (setq body (cons (list 'quote tmp) body)))
-		       (setq body (cons tmp body))))
-		    ((and maycall
-			  ;; Allow a funcall if at most one atom follows it.
-			  (null (nthcdr 3 rest))
-			  (setq tmp (get (car (car rest)) 'byte-opcode-invert))
-			  (or (null (cdr rest))
-			      (and (memq output-type '(file progn t))
-				   (cdr (cdr rest))
-				   (eq (car (nth 1 rest)) 'byte-discard)
-				   (progn (setq rest (cdr rest)) t))))
-		     (setq maycall nil)	; Only allow one real function call.
-		     (setq body (nreverse body))
-		     (setq body (list
-				 (if (and (eq tmp 'funcall)
-					  (eq (car-safe (car body)) 'quote))
-				     (cons (nth 1 (car body)) (cdr body))
-				   (cons tmp body))))
-		     (or (eq output-type 'file)
-			 (not (delq nil (mapcar 'consp (cdr (car body))))))))
-	      (setq rest (cdr rest)))
-	    rest))
-      (let ((byte-compile-vector (byte-compile-constants-vector)))
-	(list 'byte-code (byte-compile-lapcode byte-compile-output)
-	      byte-compile-vector byte-compile-maxdepth)))
-     ;; it's a trivial function
-     ((cdr body) (cons 'progn (nreverse body)))
-     ((car body)))))
-
-;; Given BODY, compile it and return a new body.
-(defun byte-compile-top-level-body (body &optional for-effect)
-  (setq body (byte-compile-top-level (cons 'progn body) for-effect t))
-  (cond ((eq (car-safe body) 'progn)
-	 (cdr body))
-	(body
-	 (list body))))
-
-;; This is the recursive entry point for compiling each subform of an 
-;; expression.
-;; If for-effect is non-nil, byte-compile-form will output a byte-discard
-;; before terminating (ie no value will be left on the stack).
-;; A byte-compile handler may, when for-effect is non-nil, choose output code
-;; which does not leave a value on the stack, and then set for-effect to nil
-;; (to prevent byte-compile-form from outputting the byte-discard).
-;; If a handler wants to call another handler, it should do so via
-;; byte-compile-form, or take extreme care to handle for-effect correctly.
-;; (Use byte-compile-form-do-effect to reset the for-effect flag too.)
-;;
-(defun byte-compile-form (form &optional for-effect)
-  (setq form (macroexpand form byte-compile-macro-environment))
-  (cond ((not (consp form))
-	 (cond ((or (not (symbolp form)) (memq form '(nil t)))
-		(byte-compile-constant form))
-	       ((and for-effect byte-compile-delete-errors)
-		(setq for-effect nil))
-	       (t (byte-compile-variable-ref 'byte-varref form))))
-	((symbolp (car form))
-	 (let* ((fn (car form))
-		(handler (get fn 'byte-compile)))
-	   (if (memq fn '(t nil))
-	       (byte-compile-warn "%s called as a function" fn))
-	   (if (and handler
-		    (or (not (byte-compile-version-cond
-			      byte-compile-compatibility))
-			(not (get (get fn 'byte-opcode) 'emacs19-opcode))))
-	       (funcall handler form)
-	     (if (memq 'callargs byte-compile-warnings)
-		 (byte-compile-callargs-warn form))
-	     (byte-compile-normal-call form))))
-	((and (or (byte-code-function-p (car form))
-		  (eq (car-safe (car form)) 'lambda))
-	      ;; if the form comes out the same way it went in, that's
-	      ;; because it was malformed, and we couldn't unfold it.
-	      (not (eq form (setq form (byte-compile-unfold-lambda form)))))
-	 (byte-compile-form form for-effect)
-	 (setq for-effect nil))
-	((byte-compile-normal-call form)))
-  (if for-effect
-      (byte-compile-discard)))
-
-(defun byte-compile-normal-call (form)
-  (if byte-compile-generate-call-tree
-      (byte-compile-annotate-call-tree form))
-  (byte-compile-push-constant (car form))
-  (mapcar 'byte-compile-form (cdr form)) ; wasteful, but faster.
-  (byte-compile-out 'byte-call (length (cdr form))))
-
-(defun byte-compile-variable-ref (base-op var)
-  (if (or (not (symbolp var)) (memq var '(nil t)))
-      (byte-compile-warn (if (eq base-op 'byte-varbind)
-			     "Attempt to let-bind %s %s"
-			   "Variable reference to %s %s")
-			 (if (symbolp var) "constant" "nonvariable")
-			 (prin1-to-string var))
-    (if (and (get var 'byte-obsolete-variable)
-	     (memq 'obsolete byte-compile-warnings))
-	(let ((ob (get var 'byte-obsolete-variable)))
-	  (byte-compile-warn "%s is an obsolete variable; %s" var
-			     (if (stringp ob)
-				 ob
-			       (format "use %s instead." ob)))))
-    (if (memq 'free-vars byte-compile-warnings)
-	(if (eq base-op 'byte-varbind)
-	    (setq byte-compile-bound-variables
-		  (cons var byte-compile-bound-variables))
-	  (or (boundp var)
-	      (memq var byte-compile-bound-variables)
-	      (if (eq base-op 'byte-varset)
-		  (or (memq var byte-compile-free-assignments)
-		      (progn
-			(byte-compile-warn "assignment to free variable %s" var)
-			(setq byte-compile-free-assignments
-			      (cons var byte-compile-free-assignments))))
-		(or (memq var byte-compile-free-references)
-		    (progn
-		      (byte-compile-warn "reference to free variable %s" var)
-		      (setq byte-compile-free-references
-			    (cons var byte-compile-free-references)))))))))
-  (let ((tmp (assq var byte-compile-variables)))
-    (or tmp
-	(setq tmp (list var)
-	      byte-compile-variables (cons tmp byte-compile-variables)))
-    (byte-compile-out base-op tmp)))
-
-(defmacro byte-compile-get-constant (const)
-  (` (or (if (stringp (, const))
-	     (assoc (, const) byte-compile-constants)
-	   (assq (, const) byte-compile-constants))
-	 (car (setq byte-compile-constants
-		    (cons (list (, const)) byte-compile-constants))))))
-
-;; Use this when the value of a form is a constant.  This obeys for-effect.
-(defun byte-compile-constant (const)
-  (if for-effect
-      (setq for-effect nil)
-    (byte-compile-out 'byte-constant (byte-compile-get-constant const))))
-
-;; Use this for a constant that is not the value of its containing form.
-;; This ignores for-effect.
-(defun byte-compile-push-constant (const)
-  (let ((for-effect nil))
-    (inline (byte-compile-constant const))))
-
-
-;; Compile those primitive ordinary functions
-;; which have special byte codes just for speed.
-
-(defmacro byte-defop-compiler (function &optional compile-handler)
-  ;; add a compiler-form for FUNCTION.
-  ;; If function is a symbol, then the variable "byte-SYMBOL" must name
-  ;; the opcode to be used.  If function is a list, the first element
-  ;; is the function and the second element is the bytecode-symbol.
-  ;; COMPILE-HANDLER is the function to use to compile this byte-op, or
-  ;; may be the abbreviations 0, 1, 2, 3, 0-1, or 1-2.
-  ;; If it is nil, then the handler is "byte-compile-SYMBOL."
-  (let (opcode)
-    (if (symbolp function)
-	(setq opcode (intern (concat "byte-" (symbol-name function))))
-      (setq opcode (car (cdr function))
-	    function (car function)))
-    (let ((fnform
-	   (list 'put (list 'quote function) ''byte-compile
-		 (list 'quote
-		       (or (cdr (assq compile-handler
-				      '((0 . byte-compile-no-args)
-					(1 . byte-compile-one-arg)
-					(2 . byte-compile-two-args)
-					(3 . byte-compile-three-args)
-					(0-1 . byte-compile-zero-or-one-arg)
-					(1-2 . byte-compile-one-or-two-args)
-					(2-3 . byte-compile-two-or-three-args)
-					)))
-			   compile-handler
-			   (intern (concat "byte-compile-"
-					   (symbol-name function))))))))
-      (if opcode
-	  (list 'progn fnform
-		(list 'put (list 'quote function)
-		      ''byte-opcode (list 'quote opcode))
-		(list 'put (list 'quote opcode)
-		      ''byte-opcode-invert (list 'quote function)))
-	fnform))))
-
-(defmacro byte-defop-compiler19 (function &optional compile-handler)
-  ;; Just like byte-defop-compiler, but defines an opcode that will only
-  ;; be used when byte-compile-compatibility is false.
-  (if (and (byte-compile-single-version)
-	   byte-compile-compatibility)
-      ;; #### instead of doing nothing, this should do some remprops,
-      ;; #### to protect against the case where a single-version compiler
-      ;; #### is loaded into a world that has contained a multi-version one.
-      nil
-    (list 'progn
-      (list 'put
-	(list 'quote
-	  (or (car (cdr-safe function))
-	      (intern (concat "byte-"
-		        (symbol-name (or (car-safe function) function))))))
-	''emacs19-opcode t)
-      (list 'byte-defop-compiler function compile-handler))))
-
-(defmacro byte-defop-compiler-1 (function &optional compile-handler)
-  (list 'byte-defop-compiler (list function nil) compile-handler))
-
-
-(put 'byte-call 'byte-opcode-invert 'funcall)
-(put 'byte-list1 'byte-opcode-invert 'list)
-(put 'byte-list2 'byte-opcode-invert 'list)
-(put 'byte-list3 'byte-opcode-invert 'list)
-(put 'byte-list4 'byte-opcode-invert 'list)
-(put 'byte-listN 'byte-opcode-invert 'list)
-(put 'byte-concat2 'byte-opcode-invert 'concat)
-(put 'byte-concat3 'byte-opcode-invert 'concat)
-(put 'byte-concat4 'byte-opcode-invert 'concat)
-(put 'byte-concatN 'byte-opcode-invert 'concat)
-(put 'byte-insertN 'byte-opcode-invert 'insert)
-
-(byte-defop-compiler (dot byte-point)		0)
-(byte-defop-compiler (dot-max byte-point-max)	0)
-(byte-defop-compiler (dot-min byte-point-min)	0)
-(byte-defop-compiler point		0)
-;;(byte-defop-compiler mark		0) ;; obsolete
-(byte-defop-compiler point-max		0)
-(byte-defop-compiler point-min		0)
-(byte-defop-compiler following-char	0)
-(byte-defop-compiler preceding-char	0)
-(byte-defop-compiler current-column	0)
-(byte-defop-compiler eolp		0)
-(byte-defop-compiler eobp		0)
-(byte-defop-compiler bolp		0)
-(byte-defop-compiler bobp		0)
-(byte-defop-compiler current-buffer	0)
-;;(byte-defop-compiler read-char	0) ;; obsolete
-(byte-defop-compiler interactive-p	0)
-(byte-defop-compiler19 widen		0)
-(byte-defop-compiler19 end-of-line    0-1)
-(byte-defop-compiler19 forward-char   0-1)
-(byte-defop-compiler19 forward-line   0-1)
-(byte-defop-compiler symbolp		1)
-(byte-defop-compiler consp		1)
-(byte-defop-compiler stringp		1)
-(byte-defop-compiler listp		1)
-(byte-defop-compiler not		1)
-(byte-defop-compiler (null byte-not)	1)
-(byte-defop-compiler car		1)
-(byte-defop-compiler cdr		1)
-(byte-defop-compiler length		1)
-(byte-defop-compiler symbol-value	1)
-(byte-defop-compiler symbol-function	1)
-(byte-defop-compiler (1+ byte-add1)	1)
-(byte-defop-compiler (1- byte-sub1)	1)
-(byte-defop-compiler goto-char		1)
-(byte-defop-compiler char-after		1)
-(byte-defop-compiler set-buffer		1)
-;;(byte-defop-compiler set-mark		1) ;; obsolete
-(byte-defop-compiler19 forward-word	1)
-(byte-defop-compiler19 char-syntax	1)
-(byte-defop-compiler19 nreverse		1)
-(byte-defop-compiler19 car-safe		1)
-(byte-defop-compiler19 cdr-safe		1)
-(byte-defop-compiler19 numberp		1)
-(byte-defop-compiler19 integerp		1)
-(byte-defop-compiler19 skip-chars-forward     1-2)
-(byte-defop-compiler19 skip-chars-backward    1-2)
-(byte-defop-compiler (eql byte-eq) 	2)
-(byte-defop-compiler eq 	 	2)
-(byte-defop-compiler memq		2)
-(byte-defop-compiler cons		2)
-(byte-defop-compiler aref		2)
-(byte-defop-compiler set		2)
-(byte-defop-compiler (= byte-eqlsign)	2)
-(byte-defop-compiler (< byte-lss)	2)
-(byte-defop-compiler (> byte-gtr)	2)
-(byte-defop-compiler (<= byte-leq)	2)
-(byte-defop-compiler (>= byte-geq)	2)
-(byte-defop-compiler get		2)
-(byte-defop-compiler nth		2)
-(byte-defop-compiler substring		2-3)
-(byte-defop-compiler19 (move-marker byte-set-marker) 2-3)
-(byte-defop-compiler19 set-marker	2-3)
-(byte-defop-compiler19 match-beginning	1)
-(byte-defop-compiler19 match-end	1)
-(byte-defop-compiler19 upcase		1)
-(byte-defop-compiler19 downcase		1)
-(byte-defop-compiler19 string=		2)
-(byte-defop-compiler19 string<		2)
-(byte-defop-compiler19 (string-equal byte-string=) 2)
-(byte-defop-compiler19 (string-lessp byte-string<) 2)
-(byte-defop-compiler19 equal		2)
-(byte-defop-compiler19 nthcdr		2)
-(byte-defop-compiler19 elt		2)
-(byte-defop-compiler19 member		2)
-(byte-defop-compiler19 assq		2)
-(byte-defop-compiler19 (rplaca byte-setcar) 2)
-(byte-defop-compiler19 (rplacd byte-setcdr) 2)
-(byte-defop-compiler19 setcar		2)
-(byte-defop-compiler19 setcdr		2)
-(byte-defop-compiler19 buffer-substring	2)
-(byte-defop-compiler19 delete-region	2)
-(byte-defop-compiler19 narrow-to-region	2)
-(byte-defop-compiler19 (% byte-rem)	2)
-(byte-defop-compiler aset		3)
-
-(byte-defop-compiler max		byte-compile-associative)
-(byte-defop-compiler min		byte-compile-associative)
-(byte-defop-compiler (+ byte-plus)	byte-compile-associative)
-(byte-defop-compiler19 (* byte-mult)	byte-compile-associative)
-
-;;####(byte-defop-compiler19 move-to-column	1)
-(byte-defop-compiler-1 interactive byte-compile-noop)
-
-
-(defun byte-compile-subr-wrong-args (form n)
-  (byte-compile-warn "%s called with %d arg%s, but requires %s"
-		     (car form) (length (cdr form))
-		     (if (= 1 (length (cdr form))) "" "s") n)
-  ;; get run-time wrong-number-of-args error.
-  (byte-compile-normal-call form))
-
-(defun byte-compile-no-args (form)
-  (if (not (= (length form) 1))
-      (byte-compile-subr-wrong-args form "none")
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
-
-(defun byte-compile-one-arg (form)
-  (if (not (= (length form) 2))
-      (byte-compile-subr-wrong-args form 1)
-    (byte-compile-form (car (cdr form)))  ;; Push the argument
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
-
-(defun byte-compile-two-args (form)
-  (if (not (= (length form) 3))
-      (byte-compile-subr-wrong-args form 2)
-    (byte-compile-form (car (cdr form)))  ;; Push the arguments
-    (byte-compile-form (nth 2 form))
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
-
-(defun byte-compile-three-args (form)
-  (if (not (= (length form) 4))
-      (byte-compile-subr-wrong-args form 3)
-    (byte-compile-form (car (cdr form)))  ;; Push the arguments
-    (byte-compile-form (nth 2 form))
-    (byte-compile-form (nth 3 form))
-    (byte-compile-out (get (car form) 'byte-opcode) 0)))
-
-(defun byte-compile-zero-or-one-arg (form)
-  (let ((len (length form)))
-    (cond ((= len 1) (byte-compile-one-arg (append form '(nil))))
-	  ((= len 2) (byte-compile-one-arg form))
-	  (t (byte-compile-subr-wrong-args form "0-1")))))
-
-(defun byte-compile-one-or-two-args (form)
-  (let ((len (length form)))
-    (cond ((= len 2) (byte-compile-two-args (append form '(nil))))
-	  ((= len 3) (byte-compile-two-args form))
-	  (t (byte-compile-subr-wrong-args form "1-2")))))
-
-(defun byte-compile-two-or-three-args (form)
-  (let ((len (length form)))
-    (cond ((= len 3) (byte-compile-three-args (append form '(nil))))
-	  ((= len 4) (byte-compile-three-args form))
-	  (t (byte-compile-subr-wrong-args form "2-3")))))
-
-(defun byte-compile-noop (form)
-  (byte-compile-constant nil))
-
-(defun byte-compile-discard ()
-  (byte-compile-out 'byte-discard 0))
-
-
-;; Compile a function that accepts one or more args and is right-associative.
-;; We do it by left-associativity so that the operations
-;; are done in the same order as in interpreted code.
-;; We treat the one-arg case, as in (+ x), like (+ x 0).
-;; in order to convert markers to numbers, and trigger expected errors.
-(defun byte-compile-associative (form)
-  (if (cdr form)
-      (let ((opcode (get (car form) 'byte-opcode))
-	    (args (copy-sequence (cdr form))))
-	(byte-compile-form (car args))
-	(setq args (cdr args))
-	(or args (setq args '(0)
-		       opcode (get '+ 'byte-opcode)))
-	(while args
-	  (byte-compile-form (car args))
-	  (byte-compile-out opcode 0)
-	  (setq args (cdr args))))
-    (byte-compile-constant (eval form))))
-
-
-;; more complicated compiler macros
-
-(byte-defop-compiler list)
-(byte-defop-compiler concat)
-(byte-defop-compiler fset)
-(byte-defop-compiler (indent-to-column byte-indent-to) byte-compile-indent-to)
-(byte-defop-compiler indent-to)
-(byte-defop-compiler insert)
-(byte-defop-compiler-1 function byte-compile-function-form)
-(byte-defop-compiler-1 - byte-compile-minus)
-(byte-defop-compiler19 (/ byte-quo) byte-compile-quo)
-(byte-defop-compiler19 nconc)
-(byte-defop-compiler-1 beginning-of-line)
-
-(defun byte-compile-list (form)
-  (let ((count (length (cdr form))))
-    (cond ((= count 0)
-	   (byte-compile-constant nil))
-	  ((< count 5)
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out
-	    (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- count)) 0))
-	  ((and (< count 256) (not (byte-compile-version-cond
-				    byte-compile-compatibility)))
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out 'byte-listN count))
-	  (t (byte-compile-normal-call form)))))
-
-(defun byte-compile-concat (form)
-  (let ((count (length (cdr form))))
-    (cond ((and (< 1 count) (< count 5))
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out
-	    (aref [byte-concat2 byte-concat3 byte-concat4] (- count 2))
-	    0))
-	  ;; Concat of one arg is not a no-op if arg is not a string.
-	  ((= count 0)
-	   (byte-compile-form ""))
-	  ((and (< count 256) (not (byte-compile-version-cond
-				    byte-compile-compatibility)))
-	   (mapcar 'byte-compile-form (cdr form))
-	   (byte-compile-out 'byte-concatN count))
-	  ((byte-compile-normal-call form)))))
-
-(defun byte-compile-minus (form)
-  (if (null (setq form (cdr form)))
-      (byte-compile-constant 0)
-    (byte-compile-form (car form))
-    (if (cdr form)
-	(while (setq form (cdr form))
-	  (byte-compile-form (car form))
-	  (byte-compile-out 'byte-diff 0))
-      (byte-compile-out 'byte-negate 0))))
-
-(defun byte-compile-quo (form)
-  (let ((len (length form)))
-    (cond ((<= len 2)
-	   (byte-compile-subr-wrong-args form "2 or more"))
-	  (t
-	   (byte-compile-form (car (setq form (cdr form))))
-	   (while (setq form (cdr form))
-	     (byte-compile-form (car form))
-	     (byte-compile-out 'byte-quo 0))))))
-
-(defun byte-compile-nconc (form)
-  (let ((len (length form)))
-    (cond ((= len 1)
-	   (byte-compile-constant nil))
-	  ((= len 2)
-	   ;; nconc of one arg is a noop, even if that arg isn't a list.
-	   (byte-compile-form (nth 1 form)))
-	  (t
-	   (byte-compile-form (car (setq form (cdr form))))
-	   (while (setq form (cdr form))
-	     (byte-compile-form (car form))
-	     (byte-compile-out 'byte-nconc 0))))))
-
-(defun byte-compile-fset (form)
-  ;; warn about forms like (fset 'foo '(lambda () ...))
-  ;; (where the lambda expression is non-trivial...)
-  (let ((fn (nth 2 form))
-	body)
-    (if (and (eq (car-safe fn) 'quote)
-	     (eq (car-safe (setq fn (nth 1 fn))) 'lambda))
-	(progn
-	  (setq body (cdr (cdr fn)))
-	  (if (stringp (car body)) (setq body (cdr body)))
-	  (if (eq 'interactive (car-safe (car body))) (setq body (cdr body)))
-	  (if (and (consp (car body))
-		   (not (eq 'byte-code (car (car body)))))
-	      (byte-compile-warn
-      "A quoted lambda form is the second argument of fset.  This is probably
-     not what you want, as that lambda cannot be compiled.  Consider using
-     the syntax (function (lambda (...) ...)) instead.")))))
-  (byte-compile-two-args form))
-
-(defun byte-compile-funarg (form)
-  ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..)
-  ;; for cases where it's guaranteed that first arg will be used as a lambda.
-  (byte-compile-normal-call
-   (let ((fn (nth 1 form)))
-     (if (and (eq (car-safe fn) 'quote)
-	      (eq (car-safe (nth 1 fn)) 'lambda))
-	 (cons (car form)
-	       (cons (cons 'function (cdr fn))
-		     (cdr (cdr form))))
-       form))))
-
-(defun byte-compile-funarg-2 (form)
-  ;; (sort ... '(lambda (x) ..)) ==> (sort ... (function (lambda (x) ..)))
-  ;; for cases where it's guaranteed that second arg will be used as a lambda.
-  (byte-compile-normal-call
-   (let ((fn (nth 2 form)))
-     (if (and (eq (car-safe fn) 'quote)
-	      (eq (car-safe (nth 1 fn)) 'lambda))
-	 (cons (car form)
-	       (cons (nth 1 form)
-		     (cons (cons 'function (cdr fn))
-			   (cdr (cdr (cdr form))))))
-       form))))
-
-;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
-;; Otherwise it will be incompatible with the interpreter,
-;; and (funcall (function foo)) will lose with autoloads.
-
-(defun byte-compile-function-form (form)
-  (byte-compile-constant
-   (cond ((symbolp (nth 1 form))
-	  (nth 1 form))
-	 ;; If we're not allowed to use #[] syntax, then output a form like
-	 ;; '(lambda (..) (byte-code ..)) instead of a call to make-byte-code.
-	 ;; In this situation, calling make-byte-code at run-time will usually
-	 ;; be less efficient than processing a call to byte-code.
-	 ((byte-compile-version-cond byte-compile-compatibility)
-	  (byte-compile-byte-code-unmake (byte-compile-lambda (nth 1 form))))
-	 ((byte-compile-lambda (nth 1 form))))))
-
-(defun byte-compile-indent-to (form)
-  (let ((len (length form)))
-    (cond ((= len 2)
-	   (byte-compile-form (car (cdr form)))
-	   (byte-compile-out 'byte-indent-to 0))
-	  ((= len 3)
-	   ;; no opcode for 2-arg case.
-	   (byte-compile-normal-call form))
-	  (t
-	   (byte-compile-subr-wrong-args form "1-2")))))
-
-(defun byte-compile-insert (form)
-  (cond ((null (cdr form))
-	 (byte-compile-constant nil))
-	((and (not (byte-compile-version-cond
-		    byte-compile-compatibility))
-	      (<= (length form) 256))
-	 (mapcar 'byte-compile-form (cdr form))
-	 (if (cdr (cdr form))
-	     (byte-compile-out 'byte-insertN (length (cdr form)))
-	   (byte-compile-out 'byte-insert 0)))
-	((memq t (mapcar 'consp (cdr (cdr form))))
-	 (byte-compile-normal-call form))
-	;; We can split it; there is no function call after inserting 1st arg.
-	(t
-	 (while (setq form (cdr form))
-	   (byte-compile-form (car form))
-	   (byte-compile-out 'byte-insert 0)
-	   (if (cdr form)
-	       (byte-compile-discard))))))
-
-(defun byte-compile-beginning-of-line (form)
-  (if (not (byte-compile-constp (nth 1 form)))
-      (byte-compile-normal-call form)
-    (byte-compile-form
-     (list 'forward-line
-	   (if (integerp (setq form (or (eval (nth 1 form)) 1)))
-	       (1- form)
-	     (byte-compile-warn "Non-numeric arg to beginning-of-line: %s"
-				form)
-	     (list '1- (list 'quote form))))
-     t)
-    (byte-compile-constant nil)))
-
-
-(byte-defop-compiler-1 setq)
-(byte-defop-compiler-1 setq-default)
-(byte-defop-compiler-1 quote)
-(byte-defop-compiler-1 quote-form)
-
-(defun byte-compile-setq (form)
-  (let ((args (cdr form)))
-    (if args
-	(while args
-	  (byte-compile-form (car (cdr args)))
-	  (or for-effect (cdr (cdr args))
-	      (byte-compile-out 'byte-dup 0))
-	  (byte-compile-variable-ref 'byte-varset (car args))
-	  (setq args (cdr (cdr args))))
-      ;; (setq), with no arguments.
-      (byte-compile-form nil for-effect))
-    (setq for-effect nil)))
-
-(defun byte-compile-setq-default (form)
-  (let ((args (cdr form))
-	setters)
-    (while args
-      (setq setters
-	    (cons (list 'set-default (list 'quote (car args)) (car (cdr args)))
-		  setters))
-      (setq args (cdr (cdr args))))
-    (byte-compile-form (cons 'progn (nreverse setters)))))
-
-(defun byte-compile-quote (form)
-  (byte-compile-constant (car (cdr form))))
-
-(defun byte-compile-quote-form (form)
-  (byte-compile-constant (byte-compile-top-level (nth 1 form))))
-
-
-;;; control structures
-
-(defun byte-compile-body (body &optional for-effect)
-  (while (cdr body)
-    (byte-compile-form (car body) t)
-    (setq body (cdr body)))
-  (byte-compile-form (car body) for-effect))
-
-(defsubst byte-compile-body-do-effect (body)
-  (byte-compile-body body for-effect)
-  (setq for-effect nil))
-
-(defsubst byte-compile-form-do-effect (form)
-  (byte-compile-form form for-effect)
-  (setq for-effect nil))
-
-(byte-defop-compiler-1 inline byte-compile-progn)
-(byte-defop-compiler-1 progn)
-(byte-defop-compiler-1 prog1)
-(byte-defop-compiler-1 prog2)
-(byte-defop-compiler-1 if)
-(byte-defop-compiler-1 cond)
-(byte-defop-compiler-1 and)
-(byte-defop-compiler-1 or)
-(byte-defop-compiler-1 while)
-(byte-defop-compiler-1 funcall)
-(byte-defop-compiler-1 apply byte-compile-funarg)
-(byte-defop-compiler-1 mapcar byte-compile-funarg)
-(byte-defop-compiler-1 mapatoms byte-compile-funarg)
-(byte-defop-compiler-1 mapconcat byte-compile-funarg)
-(byte-defop-compiler-1 sort byte-compile-funarg-2)
-(byte-defop-compiler-1 let)
-(byte-defop-compiler-1 let*)
-
-(defun byte-compile-progn (form)
-  (byte-compile-body-do-effect (cdr form)))
-
-(defun byte-compile-prog1 (form)
-  (byte-compile-form-do-effect (car (cdr form)))
-  (byte-compile-body (cdr (cdr form)) t))
-
-(defun byte-compile-prog2 (form)
-  (byte-compile-form (nth 1 form) t)
-  (byte-compile-form-do-effect (nth 2 form))
-  (byte-compile-body (cdr (cdr (cdr form))) t))
-
-(defmacro byte-compile-goto-if (cond discard tag)
-  (` (byte-compile-goto
-      (if (, cond)
-	  (if (, discard) 'byte-goto-if-not-nil 'byte-goto-if-not-nil-else-pop)
-	(if (, discard) 'byte-goto-if-nil 'byte-goto-if-nil-else-pop))
-      (, tag))))
-
-(defun byte-compile-if (form)
-  (byte-compile-form (car (cdr form)))
-  (if (null (nthcdr 3 form))
-      ;; No else-forms
-      (let ((donetag (byte-compile-make-tag)))
-	(byte-compile-goto-if nil for-effect donetag)
-	(byte-compile-form (nth 2 form) for-effect)
-	(byte-compile-out-tag donetag))
-    (let ((donetag (byte-compile-make-tag)) (elsetag (byte-compile-make-tag)))
-      (byte-compile-goto 'byte-goto-if-nil elsetag)
-      (byte-compile-form (nth 2 form) for-effect)
-      (byte-compile-goto 'byte-goto donetag)
-      (byte-compile-out-tag elsetag)
-      (byte-compile-body (cdr (cdr (cdr form))) for-effect)
-      (byte-compile-out-tag donetag)))
-  (setq for-effect nil))
-
-(defun byte-compile-cond (clauses)
-  (let ((donetag (byte-compile-make-tag))
-	nexttag clause)
-    (while (setq clauses (cdr clauses))
-      (setq clause (car clauses))
-      (cond ((or (eq (car clause) t)
-		 (and (eq (car-safe (car clause)) 'quote)
-		      (car-safe (cdr-safe (car clause)))))
-	     ;; Unconditional clause
-	     (setq clause (cons t clause)
-		   clauses nil))
-	    ((cdr clauses)
-	     (byte-compile-form (car clause))
-	     (if (null (cdr clause))
-		 ;; First clause is a singleton.
-		 (byte-compile-goto-if t for-effect donetag)
-	       (setq nexttag (byte-compile-make-tag))
-	       (byte-compile-goto 'byte-goto-if-nil nexttag)
-	       (byte-compile-body (cdr clause) for-effect)
-	       (byte-compile-goto 'byte-goto donetag)
-	       (byte-compile-out-tag nexttag)))))
-    ;; Last clause
-    (and (cdr clause) (not (eq (car clause) t))
-	 (progn (byte-compile-form (car clause))
-		(byte-compile-goto-if nil for-effect donetag)
-		(setq clause (cdr clause))))
-    (byte-compile-body-do-effect clause)
-    (byte-compile-out-tag donetag)))
-
-(defun byte-compile-and (form)
-  (let ((failtag (byte-compile-make-tag))
-	(args (cdr form)))
-    (if (null args)
-	(byte-compile-form-do-effect t)
-      (while (cdr args)
-	(byte-compile-form (car args))
-	(byte-compile-goto-if nil for-effect failtag)
-	(setq args (cdr args)))
-      (byte-compile-form-do-effect (car args))
-      (byte-compile-out-tag failtag))))
-
-(defun byte-compile-or (form)
-  (let ((wintag (byte-compile-make-tag))
-	(args (cdr form)))
-    (if (null args)
-	(byte-compile-form-do-effect nil)
-      (while (cdr args)
-	(byte-compile-form (car args))
-	(byte-compile-goto-if t for-effect wintag)
-	(setq args (cdr args)))
-      (byte-compile-form-do-effect (car args))
-      (byte-compile-out-tag wintag))))
-
-(defun byte-compile-while (form)
-  (let ((endtag (byte-compile-make-tag))
-	(looptag (byte-compile-make-tag)))
-    (byte-compile-out-tag looptag)
-    (byte-compile-form (car (cdr form)))
-    (byte-compile-goto-if nil for-effect endtag)
-    (byte-compile-body (cdr (cdr form)) t)
-    (byte-compile-goto 'byte-goto looptag)
-    (byte-compile-out-tag endtag)
-    (setq for-effect nil)))
-
-(defun byte-compile-funcall (form)
-  (mapcar 'byte-compile-form (cdr form))
-  (byte-compile-out 'byte-call (length (cdr (cdr form)))))
-
-
-(defun byte-compile-let (form)
-  ;; First compute the binding values in the old scope.
-  (let ((varlist (car (cdr form))))
-    (while varlist
-      (if (consp (car varlist))
-	  (byte-compile-form (car (cdr (car varlist))))
-	(byte-compile-push-constant nil))
-      (setq varlist (cdr varlist))))
-  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
-	(varlist (reverse (car (cdr form)))))
-    (while varlist
-      (byte-compile-variable-ref 'byte-varbind (if (consp (car varlist))
-						   (car (car varlist))
-						 (car varlist)))
-      (setq varlist (cdr varlist)))
-    (byte-compile-body-do-effect (cdr (cdr form)))
-    (byte-compile-out 'byte-unbind (length (car (cdr form))))))
-
-(defun byte-compile-let* (form)
-  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
-	(varlist (copy-sequence (car (cdr form)))))
-    (while varlist
-      (if (atom (car varlist))
-	  (byte-compile-push-constant nil)
-	(byte-compile-form (car (cdr (car varlist))))
-	(setcar varlist (car (car varlist))))
-      (byte-compile-variable-ref 'byte-varbind (car varlist))
-      (setq varlist (cdr varlist)))
-    (byte-compile-body-do-effect (cdr (cdr form)))
-    (byte-compile-out 'byte-unbind (length (car (cdr form))))))
-
-
-(byte-defop-compiler-1 /= byte-compile-negated)
-(byte-defop-compiler-1 atom byte-compile-negated)
-(byte-defop-compiler-1 nlistp byte-compile-negated)
-
-(put '/= 'byte-compile-negated-op '=)
-(put 'atom 'byte-compile-negated-op 'consp)
-(put 'nlistp 'byte-compile-negated-op 'listp)
-
-(defun byte-compile-negated (form)
-  (byte-compile-form-do-effect (byte-compile-negation-optimizer form)))
-
-;; Even when optimization is off, /= is optimized to (not (= ...)).
-(defun byte-compile-negation-optimizer (form)
-  ;; an optimizer for forms where <form1> is less efficient than (not <form2>)
-  (list 'not
-    (cons (or (get (car form) 'byte-compile-negated-op)
-	      (error
-	       "Compiler error: `%s' has no `byte-compile-negated-op' property"
-	       (car form)))
-	  (cdr form))))
-
-;;; other tricky macro-like special-forms
-
-(byte-defop-compiler-1 catch)
-(byte-defop-compiler-1 unwind-protect)
-(byte-defop-compiler-1 condition-case)
-(byte-defop-compiler-1 save-excursion)
-(byte-defop-compiler-1 save-current-buffer)
-(byte-defop-compiler-1 save-restriction)
-(byte-defop-compiler-1 save-window-excursion)
-(byte-defop-compiler-1 with-output-to-temp-buffer)
-(byte-defop-compiler-1 track-mouse)
-
-(defun byte-compile-catch (form)
-  (byte-compile-form (car (cdr form)))
-  (byte-compile-push-constant
-    (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect))
-  (byte-compile-out 'byte-catch 0))
-
-(defun byte-compile-unwind-protect (form)
-  (byte-compile-push-constant
-   (byte-compile-top-level-body (cdr (cdr form)) t))
-  (byte-compile-out 'byte-unwind-protect 0)
-  (byte-compile-form-do-effect (car (cdr form)))
-  (byte-compile-out 'byte-unbind 1))
-
-(defun byte-compile-track-mouse (form)
-  (byte-compile-form
-   (list
-    'funcall
-    (list 'quote
-	  (list 'lambda nil
-		(cons 'track-mouse
-		      (byte-compile-top-level-body (cdr form))))))))
-
-(defun byte-compile-condition-case (form)
-  (let* ((var (nth 1 form))
-	 (byte-compile-bound-variables
-	  (if var (cons var byte-compile-bound-variables)
-	    byte-compile-bound-variables)))
-    (or (symbolp var)
-	(byte-compile-warn
-	 "%s is not a variable-name or nil (in condition-case)" var))
-    (byte-compile-push-constant var)
-    (byte-compile-push-constant (byte-compile-top-level
-				 (nth 2 form) for-effect))
-    (let ((clauses (cdr (cdr (cdr form))))
-	  compiled-clauses)
-      (while clauses
-	(let* ((clause (car clauses))
-               (condition (car clause)))
-          (cond ((not (or (symbolp condition)
-			  (and (listp condition)
-			       (let ((syms condition) (ok t))
-				 (while syms
-				   (if (not (symbolp (car syms)))
-				       (setq ok nil))
-				   (setq syms (cdr syms)))
-				 ok))))
-                 (byte-compile-warn
-                   "%s is not a condition name or list of such (in condition-case)"
-                   (prin1-to-string condition)))
-;;                ((not (or (eq condition 't)
-;;			  (and (stringp (get condition 'error-message))
-;;			       (consp (get condition 'error-conditions)))))
-;;                 (byte-compile-warn
-;;                   "%s is not a known condition name (in condition-case)" 
-;;                   condition))
-		)
-	  (setq compiled-clauses
-		(cons (cons condition
-			    (byte-compile-top-level-body
-			     (cdr clause) for-effect))
-		      compiled-clauses)))
-	(setq clauses (cdr clauses)))
-      (byte-compile-push-constant (nreverse compiled-clauses)))
-    (byte-compile-out 'byte-condition-case 0)))
-
-
-(defun byte-compile-save-excursion (form)
-  (byte-compile-out 'byte-save-excursion 0)
-  (byte-compile-body-do-effect (cdr form))
-  (byte-compile-out 'byte-unbind 1))
-
-(defun byte-compile-save-restriction (form)
-  (byte-compile-out 'byte-save-restriction 0)
-  (byte-compile-body-do-effect (cdr form))
-  (byte-compile-out 'byte-unbind 1))
-
-(defun byte-compile-save-current-buffer (form)
-  (byte-compile-out 'byte-save-current-buffer 0)
-  (byte-compile-body-do-effect (cdr form))
-  (byte-compile-out 'byte-unbind 1))
-
-(defun byte-compile-save-window-excursion (form)
-  (byte-compile-push-constant
-   (byte-compile-top-level-body (cdr form) for-effect))
-  (byte-compile-out 'byte-save-window-excursion 0))
-
-(defun byte-compile-with-output-to-temp-buffer (form)
-  (byte-compile-form (car (cdr form)))
-  (byte-compile-out 'byte-temp-output-buffer-setup 0)
-  (byte-compile-body (cdr (cdr form)))
-  (byte-compile-out 'byte-temp-output-buffer-show 0))
-
-
-;;; top-level forms elsewhere
-
-(byte-defop-compiler-1 defun)
-(byte-defop-compiler-1 defmacro)
-(byte-defop-compiler-1 defvar)
-(byte-defop-compiler-1 defconst byte-compile-defvar)
-(byte-defop-compiler-1 autoload)
-(byte-defop-compiler-1 lambda byte-compile-lambda-form)
-(byte-defop-compiler-1 defalias)
-
-(defun byte-compile-defun (form)
-  ;; This is not used for file-level defuns with doc strings.
-  (byte-compile-two-args ; Use this to avoid byte-compile-fset's warning.
-   (list 'fset (list 'quote (nth 1 form))
-	 (byte-compile-byte-code-maker
-	  (byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
-  (byte-compile-discard)
-  (byte-compile-constant (nth 1 form)))
-
-(defun byte-compile-defmacro (form)
-  ;; This is not used for file-level defmacros with doc strings.
-  (byte-compile-body-do-effect
-   (list (list 'fset (list 'quote (nth 1 form))
-	       (let ((code (byte-compile-byte-code-maker
-			    (byte-compile-lambda
-			     (cons 'lambda (cdr (cdr form)))))))
-		 (if (eq (car-safe code) 'make-byte-code)
-		     (list 'cons ''macro code)
-		   (list 'quote (cons 'macro (eval code))))))
-	 (list 'quote (nth 1 form)))))
-
-(defun byte-compile-defvar (form)
-  ;; This is not used for file-level defvar/consts with doc strings.
-  (let ((var (nth 1 form))
-	(value (nth 2 form))
-	(string (nth 3 form)))
-    (if (memq 'free-vars byte-compile-warnings)
-	(setq byte-compile-bound-variables
-	      (cons var byte-compile-bound-variables)))
-    (byte-compile-body-do-effect
-     (list (if (cdr (cdr form))
-	       (if (eq (car form) 'defconst)
-		   (list 'setq var value)
-		 (list 'or (list 'boundp (list 'quote var))
-		       (list 'setq var value))))
-	   ;; Put the defined variable in this library's load-history entry
-	   ;; just as a real defvar would.
-	   (list 'setq 'current-load-list
-		 (list 'cons (list 'quote var)
-		       'current-load-list))
-	   (if string 
-	       (list 'put (list 'quote var) ''variable-documentation string))
-	   (list 'quote var)))))
-
-(defun byte-compile-autoload (form)
-  (and (byte-compile-constp (nth 1 form))
-       (byte-compile-constp (nth 5 form))
-       (eval (nth 5 form))  ; macro-p
-       (not (fboundp (eval (nth 1 form))))
-       (byte-compile-warn
-	"The compiler ignores `autoload' except at top level.  You should 
-     probably put the autoload of the macro `%s' at top-level."
-	(eval (nth 1 form))))
-  (byte-compile-normal-call form))
-
-;; Lambda's in valid places are handled as special cases by various code.
-;; The ones that remain are errors.
-(defun byte-compile-lambda-form (form)
-  (error "`lambda' used as function name is invalid"))
-
-;; Compile normally, but deal with warnings for the function being defined.
-(defun byte-compile-defalias (form)
-  (if (and (consp (cdr form)) (consp (nth 1 form))
-	   (eq (car (nth 1 form)) 'quote)
-	   (consp (cdr (nth 1 form)))
-	   (symbolp (nth 1 (nth 1 form)))
-	   (consp (nthcdr 2 form))
-	   (consp (nth 2 form))
-	   (eq (car (nth 2 form)) 'quote)
-	   (consp (cdr (nth 2 form)))
-	   (symbolp (nth 1 (nth 2 form))))
-      (progn
-	(byte-compile-defalias-warn (nth 1 (nth 1 form))
-				    (nth 1 (nth 2 form)))
-	(setq byte-compile-function-environment
-	      (cons (cons (nth 1 (nth 1 form))
-			  (nth 1 (nth 2 form)))
-		    byte-compile-function-environment))))
-  (byte-compile-normal-call form))
-
-;; Turn off warnings about prior calls to the function being defalias'd.
-;; This could be smarter and compare those calls with
-;; the function it is being aliased to.
-(defun byte-compile-defalias-warn (new alias)
-  (let ((calls (assq new byte-compile-unresolved-functions)))
-    (if calls
-	(setq byte-compile-unresolved-functions
-	      (delq calls byte-compile-unresolved-functions)))))
-
-;;; tags
-
-;; Note: Most operations will strip off the 'TAG, but it speeds up
-;; optimization to have the 'TAG as a part of the tag.
-;; Tags will be (TAG . (tag-number . stack-depth)).
-(defun byte-compile-make-tag ()
-  (list 'TAG (setq byte-compile-tag-number (1+ byte-compile-tag-number))))
-
-
-(defun byte-compile-out-tag (tag)
-  (setq byte-compile-output (cons tag byte-compile-output))
-  (if (cdr (cdr tag))
-      (progn
-	;; ## remove this someday
-	(and byte-compile-depth
-	  (not (= (cdr (cdr tag)) byte-compile-depth))
-	  (error "Compiler bug: depth conflict at tag %d" (car (cdr tag))))
-	(setq byte-compile-depth (cdr (cdr tag))))
-    (setcdr (cdr tag) byte-compile-depth)))
-
-(defun byte-compile-goto (opcode tag)
-  (setq byte-compile-output (cons (cons opcode tag) byte-compile-output))
-  (setcdr (cdr tag) (if (memq opcode byte-goto-always-pop-ops)
-			(1- byte-compile-depth)
-		      byte-compile-depth))
-  (setq byte-compile-depth (and (not (eq opcode 'byte-goto))
-				(1- byte-compile-depth))))
-
-(defun byte-compile-out (opcode offset)
-  (setq byte-compile-output (cons (cons opcode offset) byte-compile-output))
-  (cond ((eq opcode 'byte-call)
-	 (setq byte-compile-depth (- byte-compile-depth offset)))
-	((eq opcode 'byte-return)
-	 ;; This is actually an unnecessary case, because there should be
-	 ;; no more opcodes behind byte-return.
-	 (setq byte-compile-depth nil))
-	(t
-	 (setq byte-compile-depth (+ byte-compile-depth
-				     (or (aref byte-stack+-info
-					       (symbol-value opcode))
-					 (- (1- offset))))
-	       byte-compile-maxdepth (max byte-compile-depth
-					  byte-compile-maxdepth))))
-  ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
-  )
-
-
-;;; call tree stuff
-
-(defun byte-compile-annotate-call-tree (form)
-  (let (entry)
-    ;; annotate the current call
-    (if (setq entry (assq (car form) byte-compile-call-tree))
-	(or (memq byte-compile-current-form (nth 1 entry)) ;callers
-	    (setcar (cdr entry)
-		    (cons byte-compile-current-form (nth 1 entry))))
-      (setq byte-compile-call-tree
-	    (cons (list (car form) (list byte-compile-current-form) nil)
-		  byte-compile-call-tree)))
-    ;; annotate the current function
-    (if (setq entry (assq byte-compile-current-form byte-compile-call-tree))
-	(or (memq (car form) (nth 2 entry)) ;called
-	    (setcar (cdr (cdr entry))
-		    (cons (car form) (nth 2 entry))))
-      (setq byte-compile-call-tree
-	    (cons (list byte-compile-current-form nil (list (car form)))
-		  byte-compile-call-tree)))
-    ))
-
-;; Renamed from byte-compile-report-call-tree
-;; to avoid interfering with completion of byte-compile-file.
-;;;###autoload
-(defun display-call-tree (&optional filename)
-  "Display a call graph of a specified file.
-This lists which functions have been called, what functions called
-them, and what functions they call.  The list includes all functions
-whose definitions have been compiled in this Emacs session, as well as
-all functions called by those functions.
-
-The call graph does not include macros, inline functions, or
-primitives that the byte-code interpreter knows about directly \(eq,
-cons, etc.\).
-
-The call tree also lists those functions which are not known to be called
-\(that is, to which no calls have been compiled\), and which cannot be
-invoked interactively."
-  (interactive)
-  (message "Generating call tree...")
-  (with-output-to-temp-buffer "*Call-Tree*"
-    (set-buffer "*Call-Tree*")
-    (erase-buffer)
-    (message "Generating call tree... (sorting on %s)"
-	     byte-compile-call-tree-sort)
-    (insert "Call tree for "
-	    (cond ((null byte-compile-current-file) (or filename "???"))
-		  ((stringp byte-compile-current-file)
-		   byte-compile-current-file)
-		  (t (buffer-name byte-compile-current-file)))
-	    " sorted on "
-	    (prin1-to-string byte-compile-call-tree-sort)
-	    ":\n\n")
-    (if byte-compile-call-tree-sort
-	(setq byte-compile-call-tree
-	      (sort byte-compile-call-tree
-		    (cond ((eq byte-compile-call-tree-sort 'callers)
-			   (function (lambda (x y) (< (length (nth 1 x))
-						      (length (nth 1 y))))))
-			  ((eq byte-compile-call-tree-sort 'calls)
-			   (function (lambda (x y) (< (length (nth 2 x))
-						      (length (nth 2 y))))))
-			  ((eq byte-compile-call-tree-sort 'calls+callers)
-			   (function (lambda (x y) (< (+ (length (nth 1 x))
-							 (length (nth 2 x)))
-						      (+ (length (nth 1 y))
-							 (length (nth 2 y)))))))
-			  ((eq byte-compile-call-tree-sort 'name)
-			   (function (lambda (x y) (string< (car x)
-							    (car y)))))
-			  (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode"
-				    byte-compile-call-tree-sort))))))
-    (message "Generating call tree...")
-    (let ((rest byte-compile-call-tree)
-	  (b (current-buffer))
-	  f p
-	  callers calls)
-      (while rest
-	(prin1 (car (car rest)) b)
-	(setq callers (nth 1 (car rest))
-	      calls (nth 2 (car rest)))
-	(insert "\t"
-	  (cond ((not (fboundp (setq f (car (car rest)))))
-		 (if (null f)
-		     " <top level>";; shouldn't insert nil then, actually -sk
-		   " <not defined>"))
-		((subrp (setq f (symbol-function f)))
-		 " <subr>")
-		((symbolp f)
-		 (format " ==> %s" f))
-		((byte-code-function-p f)
-		 "<compiled function>")
-		((not (consp f))
-		 "<malformed function>")
-		((eq 'macro (car f))
-		 (if (or (byte-code-function-p (cdr f))
-			 (assq 'byte-code (cdr (cdr (cdr f)))))
-		     " <compiled macro>"
-		   " <macro>"))
-		((assq 'byte-code (cdr (cdr f)))
-		 "<compiled lambda>")
-		((eq 'lambda (car f))
-		 "<function>")
-		(t "???"))
-	  (format " (%d callers + %d calls = %d)"
-		  ;; Does the optimizer eliminate common subexpressions?-sk
-		  (length callers)
-		  (length calls)
-		  (+ (length callers) (length calls)))
-	  "\n")
-	(if callers
-	    (progn
-	      (insert "  called by:\n")
-	      (setq p (point))
-	      (insert "    " (if (car callers)
-				 (mapconcat 'symbol-name callers ", ")
-			       "<top level>"))
-	      (let ((fill-prefix "    "))
-		(fill-region-as-paragraph p (point)))))
-	(if calls
-	    (progn
-	      (insert "  calls:\n")
-	      (setq p (point))
-	      (insert "    " (mapconcat 'symbol-name calls ", "))
-	      (let ((fill-prefix "    "))
-		(fill-region-as-paragraph p (point)))))
-	(insert "\n")
-	(setq rest (cdr rest)))
-
-      (message "Generating call tree...(finding uncalled functions...)")
-      (setq rest byte-compile-call-tree)
-      (let ((uncalled nil))
-	(while rest
-	  (or (nth 1 (car rest))
-	      (null (setq f (car (car rest))))
-	      (byte-compile-fdefinition f t)
-	      (commandp (byte-compile-fdefinition f nil))
-	      (setq uncalled (cons f uncalled)))
-	  (setq rest (cdr rest)))
-	(if uncalled
-	    (let ((fill-prefix "  "))
-	      (insert "Noninteractive functions not known to be called:\n  ")
-	      (setq p (point))
-	      (insert (mapconcat 'symbol-name (nreverse uncalled) ", "))
-	      (fill-region-as-paragraph p (point)))))
-      )
-    (message "Generating call tree...done.")
-    ))
-
-
-;;; by crl@newton.purdue.edu
-;;;  Only works noninteractively.
-;;;###autoload
-(defun batch-byte-compile ()
-  "Run `byte-compile-file' on the files remaining on the command line.
-Use this from the command line, with `-batch';
-it won't work in an interactive Emacs.
-Each file is processed even if an error occurred previously.
-For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\""
-  ;; command-line-args-left is what is left of the command line (from startup.el)
-  (defvar command-line-args-left)	;Avoid 'free variable' warning
-  (if (not noninteractive)
-      (error "`batch-byte-compile' is to be used only with -batch"))
-  (let ((error nil))
-    (while command-line-args-left
-      (if (file-directory-p (expand-file-name (car command-line-args-left)))
-	  (let ((files (directory-files (car command-line-args-left)))
-		source dest)
-	    (while files
-	      (if (and (string-match emacs-lisp-file-regexp (car files))
-		       (not (auto-save-file-name-p (car files)))
-		       (setq source (expand-file-name (car files)
-						      (car command-line-args-left)))
-		       (setq dest (byte-compile-dest-file source))
-		       (file-exists-p dest)
-		       (file-newer-than-file-p source dest))
-		  (if (null (batch-byte-compile-file source))
-		      (setq error t)))
-	      (setq files (cdr files))))
-	(if (null (batch-byte-compile-file (car command-line-args-left)))
-	    (setq error t)))
-      (setq command-line-args-left (cdr command-line-args-left)))
-    (message "Done")
-    (kill-emacs (if error 1 0))))
-
-(defun batch-byte-compile-file (file)
-  (condition-case err
-      (progn (byte-compile-file file) t)
-    (error
-     (message (if (cdr err)
-		  ">>Error occurred processing %s: %s (%s)"
-		  ">>Error occurred processing %s: %s")
-	      file
-	      (get (car err) 'error-message)
-	      (prin1-to-string (cdr err)))
-     nil)))
-
-;;;###autoload
-(defun batch-byte-recompile-directory ()
-  "Runs `byte-recompile-directory' on the dirs remaining on the command line.
-Must be used only with `-batch', and kills Emacs on completion.
-For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
-  ;; command-line-args-left is what is left of the command line (startup.el)
-  (defvar command-line-args-left)	;Avoid 'free variable' warning
-  (if (not noninteractive)
-      (error "batch-byte-recompile-directory is to be used only with -batch"))
-  (or command-line-args-left
-      (setq command-line-args-left '(".")))
-  (while command-line-args-left
-    (byte-recompile-directory (car command-line-args-left))
-    (setq command-line-args-left (cdr command-line-args-left)))
-  (kill-emacs 0))
-
-
-(make-obsolete 'dot 'point)
-(make-obsolete 'dot-max 'point-max)
-(make-obsolete 'dot-min 'point-min)
-(make-obsolete 'dot-marker 'point-marker)
-
-(make-obsolete 'buffer-flush-undo 'buffer-disable-undo)
-(make-obsolete 'baud-rate "use the baud-rate variable instead")
-(make-obsolete 'compiled-function-p 'byte-code-function-p)
-(make-obsolete 'define-function 'defalias)
-(make-obsolete-variable 'auto-fill-hook 'auto-fill-function)
-(make-obsolete-variable 'blink-paren-hook 'blink-paren-function)
-(make-obsolete-variable 'lisp-indent-hook 'lisp-indent-function)
-(make-obsolete-variable 'temp-buffer-show-hook
-			'temp-buffer-show-function)
-(make-obsolete-variable 'inhibit-local-variables
-		"use enable-local-variables (with the reversed sense).")
-(make-obsolete-variable 'unread-command-char
-  "use unread-command-events instead.  That variable is a list of events to reread, so it now uses nil to mean `no event', instead of -1.")
-(make-obsolete-variable 'unread-command-event
-  "use unread-command-events; which is a list of events rather than a single event.")
-(make-obsolete-variable 'suspend-hooks 'suspend-hook)
-(make-obsolete-variable 'comment-indent-hook 'comment-indent-function)
-(make-obsolete-variable 'meta-flag "Use the set-input-mode function instead.")
-(make-obsolete-variable 'executing-macro 'executing-kbd-macro)
-(make-obsolete-variable 'before-change-function
-  "use before-change-functions; which is a list of functions rather than a single function.")
-(make-obsolete-variable 'after-change-function
-  "use after-change-functions; which is a list of functions rather than a single function.")
-(make-obsolete-variable 'font-lock-doc-string-face 'font-lock-string-face)
-(make-obsolete-variable 'post-command-idle-hook
-  "use timers instead, with `run-with-idle-timer'.")
-(make-obsolete-variable 'post-command-idle-delay
-  "use timers instead, with `run-with-idle-timer'.")
-
-(provide 'byte-compile)
-(provide 'bytecomp)
-
-
-;;; report metering (see the hacks in bytecode.c)
-
-(defun byte-compile-report-ops ()
-  (defvar byte-code-meter)
-  (with-output-to-temp-buffer "*Meter*"
-    (set-buffer "*Meter*")
-    (let ((i 0) n op off)
-      (while (< i 256)
-	(setq n (aref (aref byte-code-meter 0) i)
-	      off nil)
-	(if t				;(not (zerop n))
-	    (progn
-	      (setq op i)
-	      (setq off nil)
-	      (cond ((< op byte-nth)
-		     (setq off (logand op 7))
-		     (setq op (logand op 248)))
-		    ((>= op byte-constant)
-		     (setq off (- op byte-constant)
-			   op byte-constant)))
-	      (setq op (aref byte-code-vector op))
-	      (insert (format "%-4d" i))
-	      (insert (symbol-name op))
-	      (if off (insert " [" (int-to-string off) "]"))
-	      (indent-to 40)
-	      (insert (int-to-string n) "\n")))
-	(setq i (1+ i))))))
-
-;; To avoid "lisp nesting exceeds max-lisp-eval-depth" when bytecomp compiles
-;; itself, compile some of its most used recursive functions (at load time).
-;;
-(eval-when-compile
-  (or (byte-code-function-p (symbol-function 'byte-compile-form))
-      (assq 'byte-code (symbol-function 'byte-compile-form))
-      (let ((byte-optimize nil)		; do it fast
-	    (byte-compile-warnings nil))
-	(mapcar '(lambda (x)
-		   (or noninteractive (message "compiling %s..." x))
-		   (byte-compile x)
-		   (or noninteractive (message "compiling %s...done" x)))
-		'(byte-compile-normal-call
-		  byte-compile-form
-		  byte-compile-body
-		  ;; Inserted some more than necessary, to speed it up.
-		  byte-compile-top-level
-		  byte-compile-out-toplevel
-		  byte-compile-constant
-		  byte-compile-variable-ref))))
-  nil)
-
-;;; bytecomp.el ends here
diff --git a/lisp/emacs-lisp/cl-compat.el b/lisp/emacs-lisp/cl-compat.el
deleted file mode 100644
index 7d5b6492edf..00000000000
--- a/lisp/emacs-lisp/cl-compat.el
+++ /dev/null
@@ -1,192 +0,0 @@
-;;; cl-compat.el --- Common Lisp extensions for GNU Emacs Lisp (compatibility)
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; 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:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains emulations of internal routines of the older
-;; CL package which users may have called directly from their code.
-;; Use (require 'cl-compat) to get these routines.
-
-;; See cl.el for Change Log.
-
-
-;;; Code:
-
-;; Require at load-time, but not when compiling cl-compat.
-(or (featurep 'cl) (require 'cl))
-
-
-;;; Keyword routines not supported by new package.
-
-(defmacro defkeyword (x &optional doc)
-  (list* 'defconst x (list 'quote x) (and doc (list doc))))
-
-(defun keywordp (sym)
-  (and (symbolp sym) (eq (aref (symbol-name sym) 0) ?\:) (set sym sym)))
-
-(defun keyword-of (sym)
-  (or (keywordp sym) (keywordp (intern (format ":%s" sym)))))
-
-
-;;; Multiple values.  Note that the new package uses a different
-;;; convention for multiple values.  The following definitions
-;;; emulate the old convention; all function names have been changed
-;;; by capitalizing the first letter: Values, Multiple-value-*,
-;;; to avoid conflict with the new-style definitions in cl-macs.
-
-(put 'Multiple-value-bind  'lisp-indent-function 2)
-(put 'Multiple-value-setq  'lisp-indent-function 2)
-(put 'Multiple-value-call  'lisp-indent-function 1)
-(put 'Multiple-value-prog1 'lisp-indent-function 1)
-
-(defvar *mvalues-values* nil)
-
-(defun Values (&rest val-forms)
-  (setq *mvalues-values* val-forms)
-  (car val-forms))
-
-(defun Values-list (val-forms)
-  (apply 'values val-forms))
-
-(defmacro Multiple-value-list (form)
-  (list 'let* (list '(*mvalues-values* nil) (list '*mvalues-temp* form))
-	'(or (and (eq *mvalues-temp* (car *mvalues-values*)) *mvalues-values*)
-	     (list *mvalues-temp*))))
-
-(defmacro Multiple-value-call (function &rest args)
-  (list 'apply function
-	(cons 'append
-	      (mapcar (function (lambda (x) (list 'Multiple-value-list x)))
-		      args))))
-
-(defmacro Multiple-value-bind (vars form &rest body)
-  (list* 'multiple-value-bind vars (list 'Multiple-value-list form) body))
-
-(defmacro Multiple-value-setq (vars form)
-  (list 'multiple-value-setq vars (list 'Multiple-value-list form)))
-
-(defmacro Multiple-value-prog1 (form &rest body)
-  (list 'prog1 form (list* 'let '((*mvalues-values* nil)) body)))
-
-
-;;; Routines for parsing keyword arguments.
-
-(defun build-klist (arglist keys &optional allow-others)
-  (let ((res (Multiple-value-call 'mapcar* 'cons (unzip-lists arglist))))
-    (or allow-others
-	(let ((bad (set-difference (mapcar 'car res) keys)))
-	  (if bad (error "Bad keywords: %s not in %s" bad keys))))
-    res))
-
-(defun extract-from-klist (klist key &optional def)
-  (let ((res (assq key klist))) (if res (cdr res) def)))
-
-(defun keyword-argument-supplied-p (klist key)
-  (assq key klist))
-
-(defun elt-satisfies-test-p (item elt klist)
-  (let ((test-not (cdr (assq ':test-not klist)))
-	(test (cdr (assq ':test klist)))
-	(key (cdr (assq ':key klist))))
-    (if key (setq elt (funcall key elt)))
-    (if test-not (not (funcall test-not item elt))
-      (funcall (or test 'eql) item elt))))
-
-
-;;; Rounding functions with old-style multiple value returns.
-
-(defun cl-floor (a &optional b) (Values-list (floor* a b)))
-(defun cl-ceiling (a &optional b) (Values-list (ceiling* a b)))
-(defun cl-round (a &optional b) (Values-list (round* a b)))
-(defun cl-truncate (a &optional b) (Values-list (truncate* a b)))
-
-(defun safe-idiv (a b)
-  (let* ((q (/ (abs a) (abs b)))
-         (s (* (signum a) (signum b))))
-    (Values q (- a (* s q b)) s)))
-
-
-;; Internal routines.
-
-(defun pair-with-newsyms (oldforms)
-  (let ((newsyms (mapcar (function (lambda (x) (gensym))) oldforms)))
-    (Values (mapcar* 'list newsyms oldforms) newsyms)))
-
-(defun zip-lists (evens odds)
-  (mapcan 'list evens odds))
-
-(defun unzip-lists (list)
-  (let ((e nil) (o nil))
-    (while list
-      (setq e (cons (car list) e) o (cons (cadr list) o) list (cddr list)))
-    (Values (nreverse e) (nreverse o))))
-
-(defun reassemble-argslists (list)
-  (let ((n (apply 'min (mapcar 'length list))) (res nil))
-    (while (>= (setq n (1- n)) 0)
-      (setq res (cons (mapcar (function (lambda (x) (elt x n))) list) res)))
-    res))
-
-(defun duplicate-symbols-p (list)
-  (let ((res nil))
-    (while list
-      (if (memq (car list) (cdr list)) (setq res (cons (car list) res)))
-      (setq list (cdr list)))
-    res))
-
-
-;;; Setf internals.
-
-(defun setnth (n list x)
-  (setcar (nthcdr n list) x))
-
-(defun setnthcdr (n list x)
-  (setcdr (nthcdr (1- n) list) x))
-
-(defun setelt (seq n x)
-  (if (consp seq) (setcar (nthcdr n seq) x) (aset seq n x)))
-
-
-;;; Functions omitted: case-clausify, check-do-stepforms, check-do-endforms,
-;;; extract-do-inits, extract-do[*]-steps, select-stepping-forms,
-;;; elt-satisfies-if[-not]-p, with-keyword-args, mv-bind-clausify,
-;;; all names with embedded `$'.
-
-
-(provide 'cl-compat)
-
-;;; cl-compat.el ends here
-
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
deleted file mode 100644
index 2402d799108..00000000000
--- a/lisp/emacs-lisp/cl-extra.el
+++ /dev/null
@@ -1,924 +0,0 @@
-;;; cl-extra.el --- Common Lisp features, part 2 -*-byte-compile-dynamic: t;-*-
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; 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:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains portions of the Common Lisp extensions
-;; package which are autoloaded since they are relatively obscure.
-
-;; See cl.el for Change Log.
-
-
-;;; Code:
-
-(or (memq 'cl-19 features)
-    (error "Tried to load `cl-extra' before `cl'!"))
-
-
-;;; We define these here so that this file can compile without having
-;;; loaded the cl.el file already.
-
-(defmacro cl-push (x place) (list 'setq place (list 'cons x place)))
-(defmacro cl-pop (place)
-  (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))
-
-(defvar cl-emacs-type)
-
-
-;;; Type coercion.
-
-(defun coerce (x type)
-  "Coerce OBJECT to type TYPE.
-TYPE is a Common Lisp type specifier."
-  (cond ((eq type 'list) (if (listp x) x (append x nil)))
-	((eq type 'vector) (if (vectorp x) x (vconcat x)))
-	((eq type 'string) (if (stringp x) x (concat x)))
-	((eq type 'array) (if (arrayp x) x (vconcat x)))
-	((and (eq type 'character) (stringp x) (= (length x) 1)) (aref x 0))
-	((and (eq type 'character) (symbolp x)) (coerce (symbol-name x) type))
-	((eq type 'float) (float x))
-	((typep x type) x)
-	(t (error "Can't coerce %s to type %s" x type))))
-
-
-;;; Predicates.
-
-(defun equalp (x y)
-  "T if two Lisp objects have similar structures and contents.
-This is like `equal', except that it accepts numerically equal
-numbers of different types (float vs. integer), and also compares
-strings case-insensitively."
-  (cond ((eq x y) t)
-	((stringp x)
-	 (and (stringp y) (= (length x) (length y))
-	      (or (string-equal x y)
-		  (string-equal (downcase x) (downcase y)))))   ; lazy but simple!
-	((numberp x)
-	 (and (numberp y) (= x y)))
-	((consp x)
-	 (while (and (consp x) (consp y) (equalp (car x) (car y)))
-	   (setq x (cdr x) y (cdr y)))
-	 (and (not (consp x)) (equalp x y)))
-	((vectorp x)
-	 (and (vectorp y) (= (length x) (length y))
-	      (let ((i (length x)))
-		(while (and (>= (setq i (1- i)) 0)
-			    (equalp (aref x i) (aref y i))))
-		(< i 0))))
-	(t (equal x y))))
-
-
-;;; Control structures.
-
-(defun cl-mapcar-many (cl-func cl-seqs)
-  (if (cdr (cdr cl-seqs))
-      (let* ((cl-res nil)
-	     (cl-n (apply 'min (mapcar 'length cl-seqs)))
-	     (cl-i 0)
-	     (cl-args (copy-sequence cl-seqs))
-	     cl-p1 cl-p2)
-	(setq cl-seqs (copy-sequence cl-seqs))
-	(while (< cl-i cl-n)
-	  (setq cl-p1 cl-seqs cl-p2 cl-args)
-	  (while cl-p1
-	    (setcar cl-p2
-		    (if (consp (car cl-p1))
-			(prog1 (car (car cl-p1))
-			  (setcar cl-p1 (cdr (car cl-p1))))
-		      (aref (car cl-p1) cl-i)))
-	    (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)))
-	  (cl-push (apply cl-func cl-args) cl-res)
-	  (setq cl-i (1+ cl-i)))
-	(nreverse cl-res))
-    (let ((cl-res nil)
-	  (cl-x (car cl-seqs))
-	  (cl-y (nth 1 cl-seqs)))
-      (let ((cl-n (min (length cl-x) (length cl-y)))
-	    (cl-i -1))
-	(while (< (setq cl-i (1+ cl-i)) cl-n)
-	  (cl-push (funcall cl-func
-			    (if (consp cl-x) (cl-pop cl-x) (aref cl-x cl-i))
-			    (if (consp cl-y) (cl-pop cl-y) (aref cl-y cl-i)))
-		   cl-res)))
-      (nreverse cl-res))))
-
-(defun map (cl-type cl-func cl-seq &rest cl-rest)
-  "Map a function across one or more sequences, returning a sequence.
-TYPE is the sequence type to return, FUNC is the function, and SEQS
-are the argument sequences."
-  (let ((cl-res (apply 'mapcar* cl-func cl-seq cl-rest)))
-    (and cl-type (coerce cl-res cl-type))))
-
-(defun maplist (cl-func cl-list &rest cl-rest)
-  "Map FUNC to each sublist of LIST or LISTS.
-Like `mapcar', except applies to lists and their cdr's rather than to
-the elements themselves."
-  (if cl-rest
-      (let ((cl-res nil)
-	    (cl-args (cons cl-list (copy-sequence cl-rest)))
-	    cl-p)
-	(while (not (memq nil cl-args))
-	  (cl-push (apply cl-func cl-args) cl-res)
-	  (setq cl-p cl-args)
-	  (while cl-p (setcar cl-p (cdr (cl-pop cl-p)) )))
-	(nreverse cl-res))
-    (let ((cl-res nil))
-      (while cl-list
-	(cl-push (funcall cl-func cl-list) cl-res)
-	(setq cl-list (cdr cl-list)))
-      (nreverse cl-res))))
-
-(defun mapc (cl-func cl-seq &rest cl-rest)
-  "Like `mapcar', but does not accumulate values returned by the function."
-  (if cl-rest
-      (apply 'map nil cl-func cl-seq cl-rest)
-    (mapcar cl-func cl-seq))
-  cl-seq)
-
-(defun mapl (cl-func cl-list &rest cl-rest)
-  "Like `maplist', but does not accumulate values returned by the function."
-  (if cl-rest
-      (apply 'maplist cl-func cl-list cl-rest)
-    (let ((cl-p cl-list))
-      (while cl-p (funcall cl-func cl-p) (setq cl-p (cdr cl-p)))))
-  cl-list)
-
-(defun mapcan (cl-func cl-seq &rest cl-rest)
-  "Like `mapcar', but nconc's together the values returned by the function."
-  (apply 'nconc (apply 'mapcar* cl-func cl-seq cl-rest)))
-
-(defun mapcon (cl-func cl-list &rest cl-rest)
-  "Like `maplist', but nconc's together the values returned by the function."
-  (apply 'nconc (apply 'maplist cl-func cl-list cl-rest)))
-
-(defun some (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is true of any element of SEQ or SEQs.
-If so, return the true (non-nil) value returned by PREDICATE."
-  (if (or cl-rest (nlistp cl-seq))
-      (catch 'cl-some
-	(apply 'map nil
-	       (function (lambda (&rest cl-x)
-			   (let ((cl-res (apply cl-pred cl-x)))
-			     (if cl-res (throw 'cl-some cl-res)))))
-	       cl-seq cl-rest) nil)
-    (let ((cl-x nil))
-      (while (and cl-seq (not (setq cl-x (funcall cl-pred (cl-pop cl-seq))))))
-      cl-x)))
-
-(defun every (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is true of every element of SEQ or SEQs."
-  (if (or cl-rest (nlistp cl-seq))
-      (catch 'cl-every
-	(apply 'map nil
-	       (function (lambda (&rest cl-x)
-			   (or (apply cl-pred cl-x) (throw 'cl-every nil))))
-	       cl-seq cl-rest) t)
-    (while (and cl-seq (funcall cl-pred (car cl-seq)))
-      (setq cl-seq (cdr cl-seq)))
-    (null cl-seq)))
-
-(defun notany (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is false of every element of SEQ or SEQs."
-  (not (apply 'some cl-pred cl-seq cl-rest)))
-
-(defun notevery (cl-pred cl-seq &rest cl-rest)
-  "Return true if PREDICATE is false of some element of SEQ or SEQs."
-  (not (apply 'every cl-pred cl-seq cl-rest)))
-
-;;; Support for `loop'.
-(defun cl-map-keymap (cl-func cl-map)
-  (while (symbolp cl-map) (setq cl-map (symbol-function cl-map)))
-  (if (eq cl-emacs-type 'lucid) (funcall 'map-keymap cl-func cl-map)
-    (if (listp cl-map)
-	(let ((cl-p cl-map))
-	  (while (consp (setq cl-p (cdr cl-p)))
-	    (cond ((consp (car cl-p))
-		   (funcall cl-func (car (car cl-p)) (cdr (car cl-p))))
-		  ((vectorp (car cl-p))
-		   (cl-map-keymap cl-func (car cl-p)))
-		  ((eq (car cl-p) 'keymap)
-		   (setq cl-p nil)))))
-      (let ((cl-i -1))
-	(while (< (setq cl-i (1+ cl-i)) (length cl-map))
-	  (if (aref cl-map cl-i)
-	      (funcall cl-func cl-i (aref cl-map cl-i))))))))
-
-(defun cl-map-keymap-recursively (cl-func-rec cl-map &optional cl-base)
-  (or cl-base
-      (setq cl-base (copy-sequence (if (eq cl-emacs-type 18) "0" [0]))))
-  (cl-map-keymap
-   (function
-    (lambda (cl-key cl-bind)
-      (aset cl-base (1- (length cl-base)) cl-key)
-      (if (keymapp cl-bind)
-	  (cl-map-keymap-recursively
-	   cl-func-rec cl-bind
-	   (funcall (if (eq cl-emacs-type 18) 'concat 'vconcat)
-		    cl-base (list 0)))
-	(funcall cl-func-rec cl-base cl-bind))))
-   cl-map))
-
-(defun cl-map-intervals (cl-func &optional cl-what cl-prop cl-start cl-end)
-  (or cl-what (setq cl-what (current-buffer)))
-  (if (bufferp cl-what)
-      (let (cl-mark cl-mark2 (cl-next t) cl-next2)
-	(save-excursion
-	  (set-buffer cl-what)
-	  (setq cl-mark (copy-marker (or cl-start (point-min))))
-	  (setq cl-mark2 (and cl-end (copy-marker cl-end))))
-	(while (and cl-next (or (not cl-mark2) (< cl-mark cl-mark2)))
-	  (setq cl-next (and (fboundp 'next-property-change)
-			     (if cl-prop (next-single-property-change
-					  cl-mark cl-prop cl-what)
-			       (next-property-change cl-mark cl-what)))
-		cl-next2 (or cl-next (save-excursion
-				       (set-buffer cl-what) (point-max))))
-	  (funcall cl-func (prog1 (marker-position cl-mark)
-			     (set-marker cl-mark cl-next2))
-		   (if cl-mark2 (min cl-next2 cl-mark2) cl-next2)))
-	(set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil)))
-    (or cl-start (setq cl-start 0))
-    (or cl-end (setq cl-end (length cl-what)))
-    (while (< cl-start cl-end)
-      (let ((cl-next (or (and (fboundp 'next-property-change)
-			      (if cl-prop (next-single-property-change
-					   cl-start cl-prop cl-what)
-				(next-property-change cl-start cl-what)))
-			 cl-end)))
-	(funcall cl-func cl-start (min cl-next cl-end))
-	(setq cl-start cl-next)))))
-
-(defun cl-map-overlays (cl-func &optional cl-buffer cl-start cl-end cl-arg)
-  (or cl-buffer (setq cl-buffer (current-buffer)))
-  (if (fboundp 'overlay-lists)
-
-      ;; This is the preferred algorithm, though overlay-lists is undocumented.
-      (let (cl-ovl)
-	(save-excursion
-	  (set-buffer cl-buffer)
-	  (setq cl-ovl (overlay-lists))
-	  (if cl-start (setq cl-start (copy-marker cl-start)))
-	  (if cl-end (setq cl-end (copy-marker cl-end))))
-	(setq cl-ovl (nconc (car cl-ovl) (cdr cl-ovl)))
-	(while (and cl-ovl
-		    (or (not (overlay-start (car cl-ovl)))
-			(and cl-end (>= (overlay-start (car cl-ovl)) cl-end))
-			(and cl-start (<= (overlay-end (car cl-ovl)) cl-start))
-			(not (funcall cl-func (car cl-ovl) cl-arg))))
-	  (setq cl-ovl (cdr cl-ovl)))
-	(if cl-start (set-marker cl-start nil))
-	(if cl-end (set-marker cl-end nil)))
-
-    ;; This alternate algorithm fails to find zero-length overlays.
-    (let ((cl-mark (save-excursion (set-buffer cl-buffer)
-				   (copy-marker (or cl-start (point-min)))))
-	  (cl-mark2 (and cl-end (save-excursion (set-buffer cl-buffer)
-						(copy-marker cl-end))))
-	  cl-pos cl-ovl)
-      (while (save-excursion
-	       (and (setq cl-pos (marker-position cl-mark))
-		    (< cl-pos (or cl-mark2 (point-max)))
-		    (progn
-		      (set-buffer cl-buffer)
-		      (setq cl-ovl (overlays-at cl-pos))
-		      (set-marker cl-mark (next-overlay-change cl-pos)))))
-	(while (and cl-ovl
-		    (or (/= (overlay-start (car cl-ovl)) cl-pos)
-			(not (and (funcall cl-func (car cl-ovl) cl-arg)
-				  (set-marker cl-mark nil)))))
-	  (setq cl-ovl (cdr cl-ovl))))
-      (set-marker cl-mark nil) (if cl-mark2 (set-marker cl-mark2 nil)))))
-
-;;; Support for `setf'.
-(defun cl-set-frame-visible-p (frame val)
-  (cond ((null val) (make-frame-invisible frame))
-	((eq val 'icon) (iconify-frame frame))
-	(t (make-frame-visible frame)))
-  val)
-
-;;; Support for `progv'.
-(defvar cl-progv-save)
-(defun cl-progv-before (syms values)
-  (while syms
-    (cl-push (if (boundp (car syms))
-		 (cons (car syms) (symbol-value (car syms)))
-	       (car syms)) cl-progv-save)
-    (if values
-	(set (cl-pop syms) (cl-pop values))
-      (makunbound (cl-pop syms)))))
-
-(defun cl-progv-after ()
-  (while cl-progv-save
-    (if (consp (car cl-progv-save))
-	(set (car (car cl-progv-save)) (cdr (car cl-progv-save)))
-      (makunbound (car cl-progv-save)))
-    (cl-pop cl-progv-save)))
-
-
-;;; Numbers.
-
-(defun gcd (&rest args)
-  "Return the greatest common divisor of the arguments."
-  (let ((a (abs (or (cl-pop args) 0))))
-    (while args
-      (let ((b (abs (cl-pop args))))
-	(while (> b 0) (setq b (% a (setq a b))))))
-    a))
-
-(defun lcm (&rest args)
-  "Return the least common multiple of the arguments."
-  (if (memq 0 args)
-      0
-    (let ((a (abs (or (cl-pop args) 1))))
-      (while args
-	(let ((b (abs (cl-pop args))))
-	  (setq a (* (/ a (gcd a b)) b))))
-      a)))
-
-(defun isqrt (a)
-  "Return the integer square root of the argument."
-  (if (and (integerp a) (> a 0))
-      (let ((g (cond ((<= a 100) 10) ((<= a 10000) 100)
-		     ((<= a 1000000) 1000) (t a)))
-	    g2)
-	(while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
-	  (setq g g2))
-	g)
-    (if (eq a 0) 0 (signal 'arith-error nil))))
-
-(defun cl-expt (x y)
-  "Return X raised to the power of Y.  Works only for integer arguments."
-  (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) (cl-expt x (- y)) 0))
-    (* (if (= (% y 2) 0) 1 x) (cl-expt (* x x) (/ y 2)))))
-(or (and (fboundp 'expt) (subrp (symbol-function 'expt)))
-    (defalias 'expt 'cl-expt))
-
-(defun floor* (x &optional y)
-  "Return a list of the floor of X and the fractional part of X.
-With two arguments, return floor and remainder of their quotient."
-  (let ((q (floor x y)))
-    (list q (- x (if y (* y q) q)))))
-
-(defun ceiling* (x &optional y)
-  "Return a list of the ceiling of X and the fractional part of X.
-With two arguments, return ceiling and remainder of their quotient."
-  (let ((res (floor* x y)))
-    (if (= (car (cdr res)) 0) res
-      (list (1+ (car res)) (- (car (cdr res)) (or y 1))))))
-
-(defun truncate* (x &optional y)
-  "Return a list of the integer part of X and the fractional part of X.
-With two arguments, return truncation and remainder of their quotient."
-  (if (eq (>= x 0) (or (null y) (>= y 0)))
-      (floor* x y) (ceiling* x y)))
-
-(defun round* (x &optional y)
-  "Return a list of X rounded to the nearest integer and the remainder.
-With two arguments, return rounding and remainder of their quotient."
-  (if y
-      (if (and (integerp x) (integerp y))
-	  (let* ((hy (/ y 2))
-		 (res (floor* (+ x hy) y)))
-	    (if (and (= (car (cdr res)) 0)
-		     (= (+ hy hy) y)
-		     (/= (% (car res) 2) 0))
-		(list (1- (car res)) hy)
-	      (list (car res) (- (car (cdr res)) hy))))
-	(let ((q (round (/ x y))))
-	  (list q (- x (* q y)))))
-    (if (integerp x) (list x 0)
-      (let ((q (round x)))
-	(list q (- x q))))))
-
-(defun mod* (x y)
-  "The remainder of X divided by Y, with the same sign as Y."
-  (nth 1 (floor* x y)))
-
-(defun rem* (x y)
-  "The remainder of X divided by Y, with the same sign as X."
-  (nth 1 (truncate* x y)))
-
-(defun signum (a)
-  "Return 1 if A is positive, -1 if negative, 0 if zero."
-  (cond ((> a 0) 1) ((< a 0) -1) (t 0)))
-
-
-;; Random numbers.
-
-(defvar *random-state*)
-(defun random* (lim &optional state)
-  "Return a random nonnegative number less than LIM, an integer or float.
-Optional second arg STATE is a random-state object."
-  (or state (setq state *random-state*))
-  ;; Inspired by "ran3" from Numerical Recipes.  Additive congruential method.
-  (let ((vec (aref state 3)))
-    (if (integerp vec)
-	(let ((i 0) (j (- 1357335 (% (abs vec) 1357333))) (k 1) ii)
-	  (aset state 3 (setq vec (make-vector 55 nil)))
-	  (aset vec 0 j)
-	  (while (> (setq i (% (+ i 21) 55)) 0)
-	    (aset vec i (setq j (prog1 k (setq k (- j k))))))
-	  (while (< (setq i (1+ i)) 200) (random* 2 state))))
-    (let* ((i (aset state 1 (% (1+ (aref state 1)) 55)))
-	   (j (aset state 2 (% (1+ (aref state 2)) 55)))
-	   (n (logand 8388607 (aset vec i (- (aref vec i) (aref vec j))))))
-      (if (integerp lim)
-	  (if (<= lim 512) (% n lim)
-	    (if (> lim 8388607) (setq n (+ (lsh n 9) (random* 512 state))))
-	    (let ((mask 1023))
-	      (while (< mask (1- lim)) (setq mask (1+ (+ mask mask))))
-	      (if (< (setq n (logand n mask)) lim) n (random* lim state))))
-	(* (/ n '8388608e0) lim)))))
-
-(defun make-random-state (&optional state)
-  "Return a copy of random-state STATE, or of `*random-state*' if omitted.
-If STATE is t, return a new state object seeded from the time of day."
-  (cond ((null state) (make-random-state *random-state*))
-	((vectorp state) (cl-copy-tree state t))
-	((integerp state) (vector 'cl-random-state-tag -1 30 state))
-	(t (make-random-state (cl-random-time)))))
-
-(defun random-state-p (object)
-  "Return t if OBJECT is a random-state object."
-  (and (vectorp object) (= (length object) 4)
-       (eq (aref object 0) 'cl-random-state-tag)))
-
-
-;; Implementation limits.
-
-(defun cl-finite-do (func a b)
-  (condition-case err
-      (let ((res (funcall func a b)))   ; check for IEEE infinity
-	(and (numberp res) (/= res (/ res 2)) res))
-    (arith-error nil)))
-
-(defvar most-positive-float)
-(defvar most-negative-float)
-(defvar least-positive-float)
-(defvar least-negative-float)
-(defvar least-positive-normalized-float)
-(defvar least-negative-normalized-float)
-(defvar float-epsilon)
-(defvar float-negative-epsilon)
-
-(defun cl-float-limits ()
-  (or most-positive-float (not (numberp '2e1))
-      (let ((x '2e0) y z)
-	;; Find maximum exponent (first two loops are optimizations)
-	(while (cl-finite-do '* x x) (setq x (* x x)))
-	(while (cl-finite-do '* x (/ x 2)) (setq x (* x (/ x 2))))
-	(while (cl-finite-do '+ x x) (setq x (+ x x)))
-	(setq z x y (/ x 2))
-	;; Now fill in 1's in the mantissa.
-	(while (and (cl-finite-do '+ x y) (/= (+ x y) x))
-	  (setq x (+ x y) y (/ y 2)))
-	(setq most-positive-float x
-	      most-negative-float (- x))
-	;; Divide down until mantissa starts rounding.
-	(setq x (/ x z) y (/ 16 z) x (* x y))
-	(while (condition-case err (and (= x (* (/ x 2) 2)) (> (/ y 2) 0))
-		 (arith-error nil))
-	  (setq x (/ x 2) y (/ y 2)))
-	(setq least-positive-normalized-float y
-	      least-negative-normalized-float (- y))
-	;; Divide down until value underflows to zero.
-	(setq x (/ 1 z) y x)
-	(while (condition-case err (> (/ x 2) 0) (arith-error nil))
-	  (setq x (/ x 2)))
-	(setq least-positive-float x
-	      least-negative-float (- x))
-	(setq x '1e0)
-	(while (/= (+ '1e0 x) '1e0) (setq x (/ x 2)))
-	(setq float-epsilon (* x 2))
-	(setq x '1e0)
-	(while (/= (- '1e0 x) '1e0) (setq x (/ x 2)))
-	(setq float-negative-epsilon (* x 2))))
-  nil)
-
-
-;;; Sequence functions.
-
-(defun subseq (seq start &optional end)
-  "Return the subsequence of SEQ from START to END.
-If END is omitted, it defaults to the length of the sequence.
-If START or END is negative, it counts from the end."
-  (if (stringp seq) (substring seq start end)
-    (let (len)
-      (and end (< end 0) (setq end (+ end (setq len (length seq)))))
-      (if (< start 0) (setq start (+ start (or len (setq len (length seq))))))
-      (cond ((listp seq)
-	     (if (> start 0) (setq seq (nthcdr start seq)))
-	     (if end
-		 (let ((res nil))
-		   (while (>= (setq end (1- end)) start)
-		     (cl-push (cl-pop seq) res))
-		   (nreverse res))
-	       (copy-sequence seq)))
-	    (t
-	     (or end (setq end (or len (length seq))))
-	     (let ((res (make-vector (max (- end start) 0) nil))
-		   (i 0))
-	       (while (< start end)
-		 (aset res i (aref seq start))
-		 (setq i (1+ i) start (1+ start)))
-	       res))))))
-
-(defun concatenate (type &rest seqs)
-  "Concatenate, into a sequence of type TYPE, the argument SEQUENCES."
-  (cond ((eq type 'vector) (apply 'vconcat seqs))
-	((eq type 'string) (apply 'concat seqs))
-	((eq type 'list) (apply 'append (append seqs '(nil))))
-	(t (error "Not a sequence type name: %s" type))))
-
-
-;;; List functions.
-
-(defun revappend (x y)
-  "Equivalent to (append (reverse X) Y)."
-  (nconc (reverse x) y))
-
-(defun nreconc (x y)
-  "Equivalent to (nconc (nreverse X) Y)."
-  (nconc (nreverse x) y))
-
-(defun list-length (x)
-  "Return the length of a list.  Return nil if list is circular."
-  (let ((n 0) (fast x) (slow x))
-    (while (and (cdr fast) (not (and (eq fast slow) (> n 0))))
-      (setq n (+ n 2) fast (cdr (cdr fast)) slow (cdr slow)))
-    (if fast (if (cdr fast) nil (1+ n)) n)))
-
-(defun tailp (sublist list)
-  "Return true if SUBLIST is a tail of LIST."
-  (while (and (consp list) (not (eq sublist list)))
-    (setq list (cdr list)))
-  (if (numberp sublist) (equal sublist list) (eq sublist list)))
-
-(defun cl-copy-tree (tree &optional vecp)
-  "Make a copy of TREE.
-If TREE is a cons cell, this recursively copies both its car and its cdr.
-Contrast to copy-sequence, which copies only along the cdrs.  With second
-argument VECP, this copies vectors as well as conses."
-  (if (consp tree)
-      (let ((p (setq tree (copy-list tree))))
-	(while (consp p)
-	  (if (or (consp (car p)) (and vecp (vectorp (car p))))
-	      (setcar p (cl-copy-tree (car p) vecp)))
-	  (or (listp (cdr p)) (setcdr p (cl-copy-tree (cdr p) vecp)))
-	  (cl-pop p)))
-    (if (and vecp (vectorp tree))
-	(let ((i (length (setq tree (copy-sequence tree)))))
-	  (while (>= (setq i (1- i)) 0)
-	    (aset tree i (cl-copy-tree (aref tree i) vecp))))))
-  tree)
-(or (and (fboundp 'copy-tree) (subrp (symbol-function 'copy-tree)))
-    (defalias 'copy-tree 'cl-copy-tree))
-
-
-;;; Property lists.
-
-(defun get* (sym tag &optional def)    ; See compiler macro in cl-macs.el
-  "Return the value of SYMBOL's PROPNAME property, or DEFAULT if none."
-  (or (get sym tag)
-      (and def
-	   (let ((plist (symbol-plist sym)))
-	     (while (and plist (not (eq (car plist) tag)))
-	       (setq plist (cdr (cdr plist))))
-	     (if plist (car (cdr plist)) def)))))
-
-(defun getf (plist tag &optional def)
-  "Search PROPLIST for property PROPNAME; return its value or DEFAULT.
-PROPLIST is a list of the sort returned by `symbol-plist'."
-  (setplist '--cl-getf-symbol-- plist)
-  (or (get '--cl-getf-symbol-- tag)
-      (and def (get* '--cl-getf-symbol-- tag def))))
-
-(defun cl-set-getf (plist tag val)
-  (let ((p plist))
-    (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p))))
-    (if p (progn (setcar (cdr p) val) plist) (list* tag val plist))))
-
-(defun cl-do-remf (plist tag)
-  (let ((p (cdr plist)))
-    (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
-    (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
-
-(defun cl-remprop (sym tag)
-  "Remove from SYMBOL's plist the property PROP and its value."
-  (let ((plist (symbol-plist sym)))
-    (if (and plist (eq tag (car plist)))
-	(progn (setplist sym (cdr (cdr plist))) t)
-      (cl-do-remf plist tag))))
-(or (and (fboundp 'remprop) (subrp (symbol-function 'remprop)))
-    (defalias 'remprop 'cl-remprop))
-
-
-
-;;; Hash tables.
-
-(defun make-hash-table (&rest cl-keys)
-  "Make an empty Common Lisp-style hash-table.
-If :test is `eq', this can use Lucid Emacs built-in hash-tables.
-In non-Lucid Emacs, or with non-`eq' test, this internally uses a-lists.
-Keywords supported:  :test :size
-The Common Lisp keywords :rehash-size and :rehash-threshold are ignored."
-  (let ((cl-test (or (car (cdr (memq ':test cl-keys))) 'eql))
-	(cl-size (or (car (cdr (memq ':size cl-keys))) 20)))
-    (if (and (eq cl-test 'eq) (fboundp 'make-hashtable))
-	(funcall 'make-hashtable cl-size)
-      (list 'cl-hash-table-tag cl-test
-	    (if (> cl-size 1) (make-vector cl-size 0)
-	      (let ((sym (make-symbol "--hashsym--"))) (set sym nil) sym))
-	    0))))
-
-(defvar cl-lucid-hash-tag
-  (if (and (fboundp 'make-hashtable) (vectorp (make-hashtable 1)))
-      (aref (make-hashtable 1) 0) (make-symbol "--cl-hash-tag--")))
-
-(defun hash-table-p (x)
-  "Return t if OBJECT is a hash table."
-  (or (eq (car-safe x) 'cl-hash-table-tag)
-      (and (vectorp x) (= (length x) 4) (eq (aref x 0) cl-lucid-hash-tag))
-      (and (fboundp 'hashtablep) (funcall 'hashtablep x))))
-
-(defun cl-not-hash-table (x &optional y &rest z)
-  (signal 'wrong-type-argument (list 'hash-table-p (or y x))))
-
-(defun cl-hash-lookup (key table)
-  (or (eq (car-safe table) 'cl-hash-table-tag) (cl-not-hash-table table))
-  (let* ((array (nth 2 table)) (test (car (cdr table))) (str key) sym)
-    (if (symbolp array) (setq str nil sym (symbol-value array))
-      (while (or (consp str) (and (vectorp str) (> (length str) 0)))
-	(setq str (elt str 0)))
-      (cond ((stringp str) (if (eq test 'equalp) (setq str (downcase str))))
-	    ((symbolp str) (setq str (symbol-name str)))
-	    ((and (numberp str) (> str -8000000) (< str 8000000))
-	     (or (integerp str) (setq str (truncate str)))
-	     (setq str (aref ["0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "10"
-			      "11" "12" "13" "14" "15"] (logand str 15))))
-	    (t (setq str "*")))
-      (setq sym (symbol-value (intern-soft str array))))
-    (list (and sym (cond ((or (eq test 'eq)
-			      (and (eq test 'eql) (not (numberp key))))
-			  (assq key sym))
-			 ((memq test '(eql equal)) (assoc key sym))
-			 (t (assoc* key sym ':test test))))
-	  sym str)))
-
-(defvar cl-builtin-gethash
-  (if (and (fboundp 'gethash) (subrp (symbol-function 'gethash)))
-      (symbol-function 'gethash) 'cl-not-hash-table))
-(defvar cl-builtin-remhash
-  (if (and (fboundp 'remhash) (subrp (symbol-function 'remhash)))
-      (symbol-function 'remhash) 'cl-not-hash-table))
-(defvar cl-builtin-clrhash
-  (if (and (fboundp 'clrhash) (subrp (symbol-function 'clrhash)))
-      (symbol-function 'clrhash) 'cl-not-hash-table))
-(defvar cl-builtin-maphash
-  (if (and (fboundp 'maphash) (subrp (symbol-function 'maphash)))
-      (symbol-function 'maphash) 'cl-not-hash-table))
-
-(defun cl-gethash (key table &optional def)
-  "Look up KEY in HASH-TABLE; return corresponding value, or DEFAULT."
-  (if (consp table)
-      (let ((found (cl-hash-lookup key table)))
-	(if (car found) (cdr (car found)) def))
-    (funcall cl-builtin-gethash key table def)))
-(defalias 'gethash 'cl-gethash)
-
-(defun cl-puthash (key val table)
-  (if (consp table)
-      (let ((found (cl-hash-lookup key table)))
-	(if (car found) (setcdr (car found) val)
-	  (if (nth 2 found)
-	      (progn
-		(if (> (nth 3 table) (* (length (nth 2 table)) 3))
-		    (let ((new-table (make-vector (nth 3 table) 0)))
-		      (mapatoms (function
-				 (lambda (sym)
-				   (set (intern (symbol-name sym) new-table)
-					(symbol-value sym))))
-				(nth 2 table))
-		      (setcar (cdr (cdr table)) new-table)))
-		(set (intern (nth 2 found) (nth 2 table))
-		     (cons (cons key val) (nth 1 found))))
-	    (set (nth 2 table) (cons (cons key val) (nth 1 found))))
-	  (setcar (cdr (cdr (cdr table))) (1+ (nth 3 table)))))
-    (funcall 'puthash key val table)) val)
-
-(defun cl-remhash (key table)
-  "Remove KEY from HASH-TABLE."
-  (if (consp table)
-      (let ((found (cl-hash-lookup key table)))
-	(and (car found)
-	     (let ((del (delq (car found) (nth 1 found))))
-	       (setcar (cdr (cdr (cdr table))) (1- (nth 3 table)))
-	       (if (nth 2 found) (set (intern (nth 2 found) (nth 2 table)) del)
-		 (set (nth 2 table) del)) t)))
-    (prog1 (not (eq (funcall cl-builtin-gethash key table '--cl--) '--cl--))
-      (funcall cl-builtin-remhash key table))))
-(defalias 'remhash 'cl-remhash)
-
-(defun cl-clrhash (table)
-  "Clear HASH-TABLE."
-  (if (consp table)
-      (progn
-	(or (hash-table-p table) (cl-not-hash-table table))
-	(if (symbolp (nth 2 table)) (set (nth 2 table) nil)
-	  (setcar (cdr (cdr table)) (make-vector (length (nth 2 table)) 0)))
-	(setcar (cdr (cdr (cdr table))) 0))
-    (funcall cl-builtin-clrhash table))
-  nil)
-(defalias 'clrhash 'cl-clrhash)
-
-(defun cl-maphash (cl-func cl-table)
-  "Call FUNCTION on keys and values from HASH-TABLE."
-  (or (hash-table-p cl-table) (cl-not-hash-table cl-table))
-  (if (consp cl-table)
-      (mapatoms (function (lambda (cl-x)
-			    (setq cl-x (symbol-value cl-x))
-			    (while cl-x
-			      (funcall cl-func (car (car cl-x))
-				       (cdr (car cl-x)))
-			      (setq cl-x (cdr cl-x)))))
-		(if (symbolp (nth 2 cl-table))
-		    (vector (nth 2 cl-table)) (nth 2 cl-table)))
-    (funcall cl-builtin-maphash cl-func cl-table)))
-(defalias 'maphash 'cl-maphash)
-
-(defun hash-table-count (table)
-  "Return the number of entries in HASH-TABLE."
-  (or (hash-table-p table) (cl-not-hash-table table))
-  (if (consp table) (nth 3 table) (funcall 'hashtable-fullness table)))
-
-
-;;; Some debugging aids.
-
-(defun cl-prettyprint (form)
-  "Insert a pretty-printed rendition of a Lisp FORM in current buffer."
-  (let ((pt (point)) last)
-    (insert "\n" (prin1-to-string form) "\n")
-    (setq last (point))
-    (goto-char (1+ pt))
-    (while (search-forward "(quote " last t)
-      (delete-backward-char 7)
-      (insert "'")
-      (forward-sexp)
-      (delete-char 1))
-    (goto-char (1+ pt))
-    (cl-do-prettyprint)))
-
-(defun cl-do-prettyprint ()
-  (skip-chars-forward " ")
-  (if (looking-at "(")
-      (let ((skip (or (looking-at "((") (looking-at "(prog")
-		      (looking-at "(unwind-protect ")
-		      (looking-at "(function (")
-		      (looking-at "(cl-block-wrapper ")))
-	    (two (or (looking-at "(defun ") (looking-at "(defmacro ")))
-	    (let (or (looking-at "(let\\*? ") (looking-at "(while ")))
-	    (set (looking-at "(p?set[qf] ")))
-	(if (or skip let
-		(progn
-		  (forward-sexp)
-		  (and (>= (current-column) 78) (progn (backward-sexp) t))))
-	    (let ((nl t))
-	      (forward-char 1)
-	      (cl-do-prettyprint)
-	      (or skip (looking-at ")") (cl-do-prettyprint))
-	      (or (not two) (looking-at ")") (cl-do-prettyprint))
-	      (while (not (looking-at ")"))
-		(if set (setq nl (not nl)))
-		(if nl (insert "\n"))
-		(lisp-indent-line)
-		(cl-do-prettyprint))
-	      (forward-char 1))))
-    (forward-sexp)))
-
-(defvar cl-macroexpand-cmacs nil)
-(defvar cl-closure-vars nil)
-
-(defun cl-macroexpand-all (form &optional env)
-  "Expand all macro calls through a Lisp FORM.
-This also does some trivial optimizations to make the form prettier."
-  (while (or (not (eq form (setq form (macroexpand form env))))
-	     (and cl-macroexpand-cmacs
-		  (not (eq form (setq form (compiler-macroexpand form)))))))
-  (cond ((not (consp form)) form)
-	((memq (car form) '(let let*))
-	 (if (null (nth 1 form))
-	     (cl-macroexpand-all (cons 'progn (cddr form)) env)
-	   (let ((letf nil) (res nil) (lets (cadr form)))
-	     (while lets
-	       (cl-push (if (consp (car lets))
-			    (let ((exp (cl-macroexpand-all (caar lets) env)))
-			      (or (symbolp exp) (setq letf t))
-			      (cons exp (cl-macroexpand-body (cdar lets) env)))
-			  (let ((exp (cl-macroexpand-all (car lets) env)))
-			    (if (symbolp exp) exp
-			      (setq letf t) (list exp nil)))) res)
-	       (setq lets (cdr lets)))
-	     (list* (if letf (if (eq (car form) 'let) 'letf 'letf*) (car form))
-		    (nreverse res) (cl-macroexpand-body (cddr form) env)))))
-	((eq (car form) 'cond)
-	 (cons (car form)
-	       (mapcar (function (lambda (x) (cl-macroexpand-body x env)))
-		       (cdr form))))
-	((eq (car form) 'condition-case)
-	 (list* (car form) (nth 1 form) (cl-macroexpand-all (nth 2 form) env)
-		(mapcar (function
-			 (lambda (x)
-			   (cons (car x) (cl-macroexpand-body (cdr x) env))))
-			(cdddr form))))
-	((memq (car form) '(quote function))
-	 (if (eq (car-safe (nth 1 form)) 'lambda)
-	     (let ((body (cl-macroexpand-body (cddadr form) env)))
-	       (if (and cl-closure-vars (eq (car form) 'function)
-			(cl-expr-contains-any body cl-closure-vars))
-		   (let* ((new (mapcar 'gensym cl-closure-vars))
-			  (sub (pairlis cl-closure-vars new)) (decls nil))
-		     (while (or (stringp (car body))
-				(eq (car-safe (car body)) 'interactive))
-		       (cl-push (list 'quote (cl-pop body)) decls))
-		     (put (car (last cl-closure-vars)) 'used t)
-		     (append
-		      (list 'list '(quote lambda) '(quote (&rest --cl-rest--)))
-		      (sublis sub (nreverse decls))
-		      (list
-		       (list* 'list '(quote apply)
-			      (list 'list '(quote quote)
-				    (list 'function
-					  (list* 'lambda
-						 (append new (cadadr form))
-						 (sublis sub body))))
-			      (nconc (mapcar (function
-					      (lambda (x)
-						(list 'list '(quote quote) x)))
-					     cl-closure-vars)
-				     '((quote --cl-rest--)))))))
-		 (list (car form) (list* 'lambda (cadadr form) body))))
-	   (let ((found (assq (cadr form) env)))
-	     (if (eq (cadr (caddr found)) 'cl-labels-args)
-		 (cl-macroexpand-all (cadr (caddr (cadddr found))) env)
-	       form))))
-	((memq (car form) '(defun defmacro))
-	 (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env)))
-	((and (eq (car form) 'progn) (not (cddr form)))
-	 (cl-macroexpand-all (nth 1 form) env))
-	((eq (car form) 'setq)
-	 (let* ((args (cl-macroexpand-body (cdr form) env)) (p args))
-	   (while (and p (symbolp (car p))) (setq p (cddr p)))
-	   (if p (cl-macroexpand-all (cons 'setf args)) (cons 'setq args))))
-	(t (cons (car form) (cl-macroexpand-body (cdr form) env)))))
-
-(defun cl-macroexpand-body (body &optional env)
-  (mapcar (function (lambda (x) (cl-macroexpand-all x env))) body))
-
-(defun cl-prettyexpand (form &optional full)
-  (message "Expanding...")
-  (let ((cl-macroexpand-cmacs full) (cl-compiling-file full)
-	(byte-compile-macro-environment nil))
-    (setq form (cl-macroexpand-all form
-				   (and (not full) '((block) (eval-when)))))
-    (message "Formatting...")
-    (prog1 (cl-prettyprint form)
-      (message ""))))
-
-
-
-(run-hooks 'cl-extra-load-hook)
-
-;;; cl-extra.el ends here
diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el
deleted file mode 100644
index 8d199c14452..00000000000
--- a/lisp/emacs-lisp/cl-indent.el
+++ /dev/null
@@ -1,474 +0,0 @@
-;;; cl-indent.el --- enhanced lisp-indent mode
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik <mly@eddie.mit.edu>
-;; Created: July 1987
-;; Maintainer: FSF
-;; Keywords: lisp, 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 supplies a single entry point, common-lisp-indent-function,
-;; which performs indentation in the preferred style for Common Lisp code.
-;; To enable it:
-;;
-;; (setq lisp-indent-function 'common-lisp-indent-function)
-
-;;>> TODO
-;; :foo
-;;   bar
-;; :baz
-;;   zap
-;; &key (like &body)??
-
-;; &rest 1 in lambda-lists doesn't work
-;;  -- really want (foo bar
-;;                  baz)
-;;     not (foo bar
-;;              baz)
-;;  Need something better than &rest for such cases
-
-;;; Code:
-
-(defvar lisp-indent-maximum-backtracking 3
-  "*Maximum depth to backtrack out from a sublist for structured indentation.
-If this variable is  0, no backtracking will occur and forms such as flet
-may not be correctly indented.")
-
-(defvar lisp-tag-indentation 1
-  "*Indentation of tags relative to containing list.
-This variable is used by the function `lisp-indent-tagbody'.")
-
-(defvar lisp-tag-body-indentation 3
-  "*Indentation of non-tagged lines relative to containing list.
-This variable is used by the function `lisp-indent-tagbody' to indent normal
-lines (lines without tags).
-The indentation is relative to the indentation of the parenthesis enclosing
-the special form.  If the value is t, the body of tags will be indented
-as a block at the same indentation as the first s-expression following
-the tag.  In this case, any forms before the first tag are indented
-by `lisp-body-indent'.")
-
-
-;;;###autoload
-(defun common-lisp-indent-function (indent-point state)
-  (let ((normal-indent (current-column)))
-    ;; Walk up list levels until we see something
-    ;;  which does special things with subforms.
-    (let ((depth 0)
-          ;; Path describes the position of point in terms of
-          ;;  list-structure with respect to containing lists.
-          ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)'
-          (path ())
-          ;; set non-nil when somebody works out the indentation to use
-          calculated
-          (last-point indent-point)
-          ;; the position of the open-paren of the innermost containing list
-          (containing-form-start (elt state 1))
-          ;; the column of the above
-          sexp-column)
-      ;; Move to start of innermost containing list
-      (goto-char containing-form-start)
-      (setq sexp-column (current-column))
-      ;; Look over successively less-deep containing forms
-      (while (and (not calculated)
-                  (< depth lisp-indent-maximum-backtracking))
-        (let ((containing-sexp (point)))
-          (forward-char 1)
-          (parse-partial-sexp (point) indent-point 1 t)
-          ;; Move to the car of the relevant containing form
-          (let (tem function method)
-            (if (not (looking-at "\\sw\\|\\s_"))
-                ;; This form doesn't seem to start with a symbol
-                (setq function nil method nil)
-              (setq tem (point))
-              (forward-sexp 1)
-              (setq function (downcase (buffer-substring tem (point))))
-              (goto-char tem)
-              (setq tem (intern-soft function)
-                    method (get tem 'common-lisp-indent-function))
-              (cond ((and (null method)
-                          (string-match ":[^:]+" function))
-                     ;; The pleblisp package feature
-                     (setq function (substring function
-                                               (1+ (match-beginning 0)))
-                           method (get (intern-soft function)
-                                       'common-lisp-indent-function)))
-                    ((and (null method))
-                     ;; backwards compatibility
-                     (setq method (get tem 'lisp-indent-function)))))
-            (let ((n 0))
-              ;; How far into the containing form is the current form?
-              (if (< (point) indent-point)
-                  (while (condition-case ()
-                             (progn
-                               (forward-sexp 1)
-                               (if (>= (point) indent-point)
-                                   nil
-                                 (parse-partial-sexp (point)
-                                                     indent-point 1 t)
-                                 (setq n (1+ n))
-                                 t))
-                           (error nil))))
-              (setq path (cons n path)))
-
-            ;; backwards compatibility.
-            (cond ((null function))
-                  ((null method)
-                   (if (null (cdr path))
-                       ;; (package prefix was stripped off above)
-                       (setq method (cond ((string-match "\\`def"
-                                                         function)
-                                           '(4 (&whole 4 &rest 1) &body))
-                                          ((string-match "\\`\\(with\\|do\\)-"
-                                                         function)
-                                           '(4 &body))))))
-                  ;; backwards compatibility.  Bletch.
-                  ((eq method 'defun)
-                   (setq method '(4 (&whole 4 &rest 1) &body))))
-
-            (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`))
-                        (not (eql (char-after (- containing-sexp 2)) ?\#)))
-                   ;; No indentation for "'(...)" elements
-                   (setq calculated (1+ sexp-column)))
-		  ((or (eql (char-after (1- containing-sexp)) ?\,)
-		       (and (eql (char-after (1- containing-sexp)) ?\@)
-			    (eql (char-after (- containing-sexp 2)) ?\,)))
-		   ;; ",(...)" or ",@(...)"
-		   (setq calculated normal-indent))
-                  ((eql (char-after (1- containing-sexp)) ?\#)
-                   ;; "#(...)"
-                   (setq calculated (1+ sexp-column)))
-                  ((null method))
-                  ((integerp method)
-                   ;; convenient top-level hack.
-                   ;;  (also compatible with lisp-indent-function)
-                   ;; The number specifies how many `distinguished'
-                   ;;  forms there are before the body starts
-                   ;; Equivalent to (4 4 ... &body)
-                   (setq calculated (cond ((cdr path)
-                                           normal-indent)
-                                          ((<= (car path) method)
-                                           ;; `distinguished' form
-                                           (list (+ sexp-column 4)
-                                                 containing-form-start))
-                                          ((= (car path) (1+ method))
-                                           ;; first body form.
-                                           (+ sexp-column lisp-body-indent))
-                                          (t
-                                           ;; other body form
-                                           normal-indent))))
-                  ((symbolp method)
-                   (setq calculated (funcall method
-                                             path state indent-point
-                                             sexp-column normal-indent)))
-                  (t
-                   (setq calculated (lisp-indent-259
-                                      method path state indent-point
-                                      sexp-column normal-indent)))))
-          (goto-char containing-sexp)
-          (setq last-point containing-sexp)
-          (if (not calculated)
-              (condition-case ()
-                   (progn (backward-up-list 1)
-                          (setq depth (1+ depth)))
-                (error (setq depth lisp-indent-maximum-backtracking))))))
-      calculated)))
-
-
-(defun lisp-indent-report-bad-format (m)
-  (error "%s has a badly-formed %s property: %s"
-         ;; Love those free variable references!!
-         function 'common-lisp-indent-function m))
-
-;; Blame the crufty control structure on dynamic scoping
-;;  -- not on me!
-(defun lisp-indent-259 (method path state indent-point
-                        sexp-column normal-indent)
-  (catch 'exit
-    (let ((p path)
-          (containing-form-start (elt state 1))
-          n tem tail)
-      ;; Isn't tail-recursion wonderful?
-      (while p
-        ;; This while loop is for destructuring.
-        ;; p is set to (cdr p) each iteration.
-        (if (not (consp method)) (lisp-indent-report-bad-format method))
-        (setq n (1- (car p))
-              p (cdr p)
-              tail nil)
-        (while n
-          ;; This while loop is for advancing along a method
-          ;; until the relevant (possibly &rest/&body) pattern
-          ;; is reached.
-          ;; n is set to (1- n) and method to (cdr method)
-          ;; each iteration.
-          (setq tem (car method))
-
-          (or (eq tem 'nil)             ;default indentation
-;             (eq tem '&lambda)         ;abbrev for (&whole 4 (&rest 1))
-              (and (eq tem '&body) (null (cdr method)))
-              (and (eq tem '&rest)
-                   (consp (cdr method)) (null (cdr (cdr method))))
-              (integerp tem)            ;explicit indentation specified
-              (and (consp tem)          ;destructuring
-                   (eq (car tem) '&whole)
-                   (or (symbolp (car (cdr tem)))
-                       (integerp (car (cdr tem)))))
-              (and (symbolp tem)        ;a function to call to do the work.
-                   (null (cdr method)))
-              (lisp-indent-report-bad-format method))
-
-          (cond ((and tail (not (consp tem)))
-                 ;; indent tail of &rest in same way as first elt of rest
-                 (throw 'exit normal-indent))
-                ((eq tem '&body)
-                 ;; &body means (&rest <lisp-body-indent>)
-                 (throw 'exit
-                   (if (and (= n 0)     ;first body form
-                            (null p))   ;not in subforms
-                       (+ sexp-column
-                          lisp-body-indent)
-                       normal-indent)))
-                ((eq tem '&rest)
-                 ;; this pattern holds for all remaining forms
-                 (setq tail (> n 0)
-                       n 0
-                       method (cdr method)))
-                ((> n 0)
-                 ;; try next element of pattern
-                 (setq n (1- n)
-                       method (cdr method))
-                 (if (< n 0)
-                     ;; Too few elements in pattern.
-                     (throw 'exit normal-indent)))
-                ((eq tem 'nil)
-                 (throw 'exit (list normal-indent containing-form-start)))
-;               ((eq tem '&lambda)
-;                ;; abbrev for (&whole 4 &rest 1)
-;                (throw 'exit
-;                  (cond ((null p)
-;                         (list (+ sexp-column 4) containing-form-start))
-;                        ((null (cdr p))
-;                         (+ sexp-column 1))
-;                        (t normal-indent))))
-                ((integerp tem)
-                 (throw 'exit
-                   (if (null p)         ;not in subforms
-                       (list (+ sexp-column tem) containing-form-start)
-                       normal-indent)))
-                ((symbolp tem)          ;a function to call
-                 (throw 'exit
-                   (funcall tem path state indent-point
-                            sexp-column normal-indent)))
-                (t
-                 ;; must be a destructing frob
-                 (if (not (null p))
-                     ;; descend
-                     (setq method (cdr (cdr tem))
-                           n nil)
-                   (setq tem (car (cdr tem)))
-                   (throw 'exit
-                     (cond (tail
-                            normal-indent)
-                           ((eq tem 'nil)
-                            (list normal-indent
-                                  containing-form-start))
-                           ((integerp tem)
-                            (list (+ sexp-column tem)
-                                  containing-form-start))
-                           (t
-                            (funcall tem path state indent-point
-                                     sexp-column normal-indent))))))))))))
-
-(defun lisp-indent-tagbody (path state indent-point sexp-column normal-indent)
-  (if (not (null (cdr path)))
-      normal-indent
-    (save-excursion
-      (goto-char indent-point)
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (list (cond ((looking-at "\\sw\\|\\s_")
-                   ;; a tagbody tag
-                   (+ sexp-column lisp-tag-indentation))
-                  ((integerp lisp-tag-body-indentation)
-                   (+ sexp-column lisp-tag-body-indentation))
-                  ((eq lisp-tag-body-indentation 't)
-                   (condition-case ()
-                       (progn (backward-sexp 1) (current-column))
-                     (error (1+ sexp-column))))
-                  (t (+ sexp-column lisp-body-indent)))
-;            (cond ((integerp lisp-tag-body-indentation)
-;                   (+ sexp-column lisp-tag-body-indentation))
-;                  ((eq lisp-tag-body-indentation 't)
-;                   normal-indent)
-;                  (t
-;                   (+ sexp-column lisp-body-indent)))
-            (elt state 1)
-            ))))
-
-(defun lisp-indent-do (path state indent-point sexp-column normal-indent)
-  (if (>= (car path) 3)
-      (let ((lisp-tag-body-indentation lisp-body-indent))
-        (funcall (function lisp-indent-tagbody)
-		 path state indent-point sexp-column normal-indent))
-    (funcall (function lisp-indent-259)
-	     '((&whole nil &rest
- 		;; the following causes weird indentation
- 		;;(&whole 1 1 2 nil)
-		)
-	       (&whole nil &rest 1))
-	     path state indent-point sexp-column normal-indent)))
-
-(defun lisp-indent-function-lambda-hack (path state indent-point
-                                         sexp-column normal-indent)
-  ;; indent (function (lambda () <newline> <body-forms>)) kludgily.
-  (if (or (cdr path) ; wtf?
-          (> (car path) 3))
-      ;; line up under previous body form
-      normal-indent
-    ;; line up under function rather than under lambda in order to
-    ;;  conserve horizontal space.  (Which is what #' is for.)
-    (condition-case ()
-        (save-excursion
-          (backward-up-list 2)
-          (forward-char 1)
-          (if (looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)")
-              (+ lisp-body-indent -1 (current-column))
-              (+ sexp-column lisp-body-indent)))
-       (error (+ sexp-column lisp-body-indent)))))
-
-
-(let ((l '((block 1)
-	   (catch 1)
-           (case        (4 &rest (&whole 2 &rest 1)))
-           (ccase . case) (ecase . case)
-           (typecase . case) (etypecase . case) (ctypecase . case)
-           (catch 1)
-           (cond        (&rest (&whole 2 &rest 1)))
-           (block 1)
-           (defvar      (4 2 2))
-           (defconstant . defvar) (defparameter . defvar)
-           (define-modify-macro
-                        (4 &body))
-           (define-setf-method
-                        (4 (&whole 4 &rest 1) &body))
-           (defsetf     (4 (&whole 4 &rest 1) 4 &body))
-           (defun       (4 (&whole 4 &rest 1) &body))
-           (defmacro . defun) (deftype . defun)
-           (defstruct   ((&whole 4 &rest (&whole 2 &rest 1))
-                         &rest (&whole 2 &rest 1)))
-           (destructuring-bind
-                        ((&whole 6 &rest 1) 4 &body))
-           (do          lisp-indent-do)
-           (do* . do)
-           (dolist      ((&whole 4 2 1) &body))
-           (dotimes . dolist)
-           (eval-when	1)
-           (flet        ((&whole 4 &rest (&whole 1 (&whole 4 &rest 1) &body))
-                         &body))
-           (labels . flet)
-           (macrolet . flet)
-           ;; `else-body' style
-           (if          (nil nil &body))
-           ;; single-else style (then and else equally indented)
-           (if          (&rest nil))
-           ;(lambda     ((&whole 4 &rest 1) &body))
-           (lambda      ((&whole 4 &rest 1)
-                         &rest lisp-indent-function-lambda-hack))
-           (let         ((&whole 4 &rest (&whole 1 1 2)) &body))
-           (let* . let)
-           (compiler-let . let) ;barf
-           (locally	1)
-           ;(loop ...)
-           (multiple-value-bind
-                        ((&whole 6 &rest 1) 4 &body))
-           (multiple-value-call
-			(4 &body))
-           (multiple-value-list 1)
-           (multiple-value-prog1 1)
-           (multiple-value-setq
-			(4 2))
-           ;; Combines the worst features of BLOCK, LET and TAGBODY
-           (prog        ((&whole 4 &rest 1) &rest lisp-indent-tagbody))
-           (prog* . prog)
-           (prog1 1)
-           (prog2 2)
-           (progn 0)
-           (progv       (4 4 &body))
-           (return 0)
-           (return-from (nil &body))
-           (tagbody     lisp-indent-tagbody)
-           (throw 1)
-           (unless 1)
-           (unwind-protect
-                        (5 &body))
-           (when 1))))
-  (while l
-    (put (car (car l)) 'common-lisp-indent-function
-         (if (symbolp (cdr (car l)))
-             (get (cdr (car l)) 'common-lisp-indent-function)
-             (car (cdr (car l)))))
-    (setq l (cdr l))))
-
-
-;(defun foo (x)
-;  (tagbody
-;   foo
-;     (bar)
-;   baz
-;     (when (losing)
-;       (with-big-loser
-;           (yow)
-;         ((lambda ()
-;            foo)
-;          big)))
-;     (flet ((foo (bar baz zap)
-;              (zip))
-;            (zot ()
-;              quux))
-;       (do ()
-;           ((lose)
-;            (foo 1))
-;         (quux)
-;        foo
-;         (lose))
-;       (cond ((x)
-;              (win 1 2
-;                   (foo)))
-;             (t
-;              (lose
-;                3))))))
-          
-
-;(put 'while    'common-lisp-indent-function 1)
-;(put 'defwrapper'common-lisp-indent-function ...)
-;(put 'def 'common-lisp-indent-function ...)
-;(put 'defflavor        'common-lisp-indent-function ...)
-;(put 'defsubst 'common-lisp-indent-function ...)
-
-;(put 'with-restart 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body)))
-;(put 'restart-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (* 1)))))
-;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((* 1))) (3 4 ((* 1))) (4 &body)))
-;(put 'with-condition-handler 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body)))
-;(put 'condition-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (1 3) (2 &body)))))
-
-;;; cl-indent.el ends here
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
deleted file mode 100644
index 37d02b564cb..00000000000
--- a/lisp/emacs-lisp/cl-macs.el
+++ /dev/null
@@ -1,2635 +0,0 @@
-;;; cl-macs.el --- Common Lisp macros -*-byte-compile-dynamic: t;-*-
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; 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:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains the portions of the Common Lisp extensions
-;; package which should be autoloaded, but need only be present
-;; if the compiler or interpreter is used---this file is not
-;; necessary for executing compiled code.
-
-;; See cl.el for Change Log.
-
-
-;;; Code:
-
-(or (memq 'cl-19 features)
-    (error "Tried to load `cl-macs' before `cl'!"))
-
-
-;;; We define these here so that this file can compile without having
-;;; loaded the cl.el file already.
-
-(defmacro cl-push (x place) (list 'setq place (list 'cons x place)))
-(defmacro cl-pop (place)
-  (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))
-(defmacro cl-pop2 (place)
-  (list 'prog1 (list 'car (list 'cdr place))
-	(list 'setq place (list 'cdr (list 'cdr place)))))
-(put 'cl-push 'edebug-form-spec 'edebug-sexps)
-(put 'cl-pop 'edebug-form-spec 'edebug-sexps)
-(put 'cl-pop2 'edebug-form-spec 'edebug-sexps)
-
-(defvar cl-emacs-type)
-(defvar cl-optimize-safety)
-(defvar cl-optimize-speed)
-
-
-;;; This kludge allows macros which use cl-transform-function-property
-;;; to be called at compile-time.
-
-(require
- (progn
-   (or (fboundp 'defalias) (fset 'defalias 'fset))
-   (or (fboundp 'cl-transform-function-property)
-       (defalias 'cl-transform-function-property
-	 (function (lambda (n p f)
-		     (list 'put (list 'quote n) (list 'quote p)
-			   (list 'function (cons 'lambda f)))))))
-   (car (or features (setq features (list 'cl-kludge))))))
-
-
-;;; Initialization.
-
-(defvar cl-old-bc-file-form nil)
-
-;; Patch broken Emacs 18 compiler (re top-level macros).
-;; Emacs 19 compiler doesn't need this patch.
-;; Also, undo broken definition of `eql' that uses same bytecode as `eq'.
-(defun cl-compile-time-init ()
-  (setq cl-old-bc-file-form (symbol-function 'byte-compile-file-form))
-  (or (fboundp 'byte-compile-flush-pending)   ; Emacs 19 compiler?
-      (defalias 'byte-compile-file-form
-	(function
-	 (lambda (form)
-	   (setq form (macroexpand form byte-compile-macro-environment))
-	   (if (eq (car-safe form) 'progn)
-	       (cons 'progn (mapcar 'byte-compile-file-form (cdr form)))
-	     (funcall cl-old-bc-file-form form))))))
-  (put 'eql 'byte-compile 'cl-byte-compile-compiler-macro)
-  (run-hooks 'cl-hack-bytecomp-hook))
-
-
-;;; Symbols.
-
-(defvar *gensym-counter*)
-(defun gensym (&optional arg)
-  "Generate a new uninterned symbol.
-The name is made by appending a number to PREFIX, default \"G\"."
-  (let ((prefix (if (stringp arg) arg "G"))
-	(num (if (integerp arg) arg
-	       (prog1 *gensym-counter*
-		 (setq *gensym-counter* (1+ *gensym-counter*))))))
-    (make-symbol (format "%s%d" prefix num))))
-
-(defun gentemp (&optional arg)
-  "Generate a new interned symbol with a unique name.
-The name is made by appending a number to PREFIX, default \"G\"."
-  (let ((prefix (if (stringp arg) arg "G"))
-	name)
-    (while (intern-soft (setq name (format "%s%d" prefix *gensym-counter*)))
-      (setq *gensym-counter* (1+ *gensym-counter*)))
-    (intern name)))
-
-
-;;; Program structure.
-
-(defmacro defun* (name args &rest body)
-  "(defun* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
-Like normal `defun', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...)."
-  (let* ((res (cl-transform-lambda (cons args body) name))
-	 (form (list* 'defun name (cdr res))))
-    (if (car res) (list 'progn (car res) form) form)))
-
-(defmacro defmacro* (name args &rest body)
-  "(defmacro* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a macro.
-Like normal `defmacro', except ARGLIST allows full Common Lisp conventions,
-and BODY is implicitly surrounded by (block NAME ...)."
-  (let* ((res (cl-transform-lambda (cons args body) name))
-	 (form (list* 'defmacro name (cdr res))))
-    (if (car res) (list 'progn (car res) form) form)))
-
-(defmacro function* (func)
-  "(function* SYMBOL-OR-LAMBDA): introduce a function.
-Like normal `function', except that if argument is a lambda form, its
-ARGLIST allows full Common Lisp conventions."
-  (if (eq (car-safe func) 'lambda)
-      (let* ((res (cl-transform-lambda (cdr func) 'cl-none))
-	     (form (list 'function (cons 'lambda (cdr res)))))
-	(if (car res) (list 'progn (car res) form) form))
-    (list 'function func)))
-
-(defun cl-transform-function-property (func prop form)
-  (let ((res (cl-transform-lambda form func)))
-    (append '(progn) (cdr (cdr (car res)))
-	    (list (list 'put (list 'quote func) (list 'quote prop)
-			(list 'function (cons 'lambda (cdr res))))))))
-
-(defconst lambda-list-keywords
-  '(&optional &rest &key &allow-other-keys &aux &whole &body &environment))
-
-(defvar cl-macro-environment nil)
-(defvar bind-block) (defvar bind-defs) (defvar bind-enquote)
-(defvar bind-inits) (defvar bind-lets) (defvar bind-forms)
-
-(defun cl-transform-lambda (form bind-block)
-  (let* ((args (car form)) (body (cdr form))
-	 (bind-defs nil) (bind-enquote nil)
-	 (bind-inits nil) (bind-lets nil) (bind-forms nil)
-	 (header nil) (simple-args nil))
-    (while (or (stringp (car body)) (eq (car-safe (car body)) 'interactive))
-      (cl-push (cl-pop body) header))
-    (setq args (if (listp args) (copy-list args) (list '&rest args)))
-    (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
-    (if (setq bind-defs (cadr (memq '&cl-defs args)))
-	(setq args (delq '&cl-defs (delq bind-defs args))
-	      bind-defs (cadr bind-defs)))
-    (if (setq bind-enquote (memq '&cl-quote args))
-	(setq args (delq '&cl-quote args)))
-    (if (memq '&whole args) (error "&whole not currently implemented"))
-    (let* ((p (memq '&environment args)) (v (cadr p)))
-      (if p (setq args (nconc (delq (car p) (delq v args))
-			      (list '&aux (list v 'cl-macro-environment))))))
-    (while (and args (symbolp (car args))
-		(not (memq (car args) '(nil &rest &body &key &aux)))
-		(not (and (eq (car args) '&optional)
-			  (or bind-defs (consp (cadr args))))))
-      (cl-push (cl-pop args) simple-args))
-    (or (eq bind-block 'cl-none)
-	(setq body (list (list* 'block bind-block body))))
-    (if (null args)
-	(list* nil (nreverse simple-args) (nconc (nreverse header) body))
-      (if (memq '&optional simple-args) (cl-push '&optional args))
-      (cl-do-arglist args nil (- (length simple-args)
-				 (if (memq '&optional simple-args) 1 0)))
-      (setq bind-lets (nreverse bind-lets))
-      (list* (and bind-inits (list* 'eval-when '(compile load eval)
-				    (nreverse bind-inits)))
-	     (nconc (nreverse simple-args)
-		    (list '&rest (car (cl-pop bind-lets))))
-	     (nconc (nreverse header)
-		    (list (nconc (list 'let* bind-lets)
-				 (nreverse bind-forms) body)))))))
-
-(defun cl-do-arglist (args expr &optional num)   ; uses bind-*
-  (if (nlistp args)
-      (if (or (memq args lambda-list-keywords) (not (symbolp args)))
-	  (error "Invalid argument name: %s" args)
-	(cl-push (list args expr) bind-lets))
-    (setq args (copy-list args))
-    (let ((p (last args))) (if (cdr p) (setcdr p (list '&rest (cdr p)))))
-    (let ((p (memq '&body args))) (if p (setcar p '&rest)))
-    (if (memq '&environment args) (error "&environment used incorrectly"))
-    (let ((save-args args)
-	  (restarg (memq '&rest args))
-	  (safety (if (cl-compiling-file) cl-optimize-safety 3))
-	  (keys nil)
-	  (laterarg nil) (exactarg nil) minarg)
-      (or num (setq num 0))
-      (if (listp (cadr restarg))
-	  (setq restarg (gensym "--rest--"))
-	(setq restarg (cadr restarg)))
-      (cl-push (list restarg expr) bind-lets)
-      (if (eq (car args) '&whole)
-	  (cl-push (list (cl-pop2 args) restarg) bind-lets))
-      (let ((p args))
-	(setq minarg restarg)
-	(while (and p (not (memq (car p) lambda-list-keywords)))
-	  (or (eq p args) (setq minarg (list 'cdr minarg)))
-	  (setq p (cdr p)))
-	(if (memq (car p) '(nil &aux))
-	    (setq minarg (list '= (list 'length restarg)
-			       (length (ldiff args p)))
-		  exactarg (not (eq args p)))))
-      (while (and args (not (memq (car args) lambda-list-keywords)))
-	(let ((poparg (list (if (or (cdr args) (not exactarg)) 'pop 'car)
-			    restarg)))
-	  (cl-do-arglist
-	   (cl-pop args)
-	   (if (or laterarg (= safety 0)) poparg
-	     (list 'if minarg poparg
-		   (list 'signal '(quote wrong-number-of-arguments)
-			 (list 'list (and (not (eq bind-block 'cl-none))
-					  (list 'quote bind-block))
-			       (list 'length restarg)))))))
-	(setq num (1+ num) laterarg t))
-      (while (and (eq (car args) '&optional) (cl-pop args))
-	(while (and args (not (memq (car args) lambda-list-keywords)))
-	  (let ((arg (cl-pop args)))
-	    (or (consp arg) (setq arg (list arg)))
-	    (if (cddr arg) (cl-do-arglist (nth 2 arg) (list 'and restarg t)))
-	    (let ((def (if (cdr arg) (nth 1 arg)
-			 (or (car bind-defs)
-			     (nth 1 (assq (car arg) bind-defs)))))
-		  (poparg (list 'pop restarg)))
-	      (and def bind-enquote (setq def (list 'quote def)))
-	      (cl-do-arglist (car arg)
-			     (if def (list 'if restarg poparg def) poparg))
-	      (setq num (1+ num))))))
-      (if (eq (car args) '&rest)
-	  (let ((arg (cl-pop2 args)))
-	    (if (consp arg) (cl-do-arglist arg restarg)))
-	(or (eq (car args) '&key) (= safety 0) exactarg
-	    (cl-push (list 'if restarg
-			   (list 'signal '(quote wrong-number-of-arguments)
-				 (list 'list
-				       (and (not (eq bind-block 'cl-none))
-					    (list 'quote bind-block))
-				       (list '+ num (list 'length restarg)))))
-		     bind-forms)))
-      (while (and (eq (car args) '&key) (cl-pop args))
-	(while (and args (not (memq (car args) lambda-list-keywords)))
-	  (let ((arg (cl-pop args)))
-	    (or (consp arg) (setq arg (list arg)))
-	    (let* ((karg (if (consp (car arg)) (caar arg)
-			   (intern (format ":%s" (car arg)))))
-		   (varg (if (consp (car arg)) (cadar arg) (car arg)))
-		   (def (if (cdr arg) (cadr arg)
-			  (or (car bind-defs) (cadr (assq varg bind-defs)))))
-		   (look (list 'memq (list 'quote karg) restarg)))
-	      (and def bind-enquote (setq def (list 'quote def)))
-	      (if (cddr arg)
-		  (let* ((temp (or (nth 2 arg) (gensym)))
-			 (val (list 'car (list 'cdr temp))))
-		    (cl-do-arglist temp look)
-		    (cl-do-arglist varg
-				   (list 'if temp
-					 (list 'prog1 val (list 'setq temp t))
-					 def)))
-		(cl-do-arglist
-		 varg
-		 (list 'car
-		       (list 'cdr
-			     (if (null def)
-				 look
-			       (list 'or look
-				     (if (eq (cl-const-expr-p def) t)
-					 (list
-					  'quote
-					  (list nil (cl-const-expr-val def)))
-				       (list 'list nil def))))))))
-	      (cl-push karg keys)
-	      (if (= (aref (symbol-name karg) 0) ?:)
-		  (progn (set karg karg)
-			 (cl-push (list 'setq karg (list 'quote karg))
-				  bind-inits)))))))
-      (setq keys (nreverse keys))
-      (or (and (eq (car args) '&allow-other-keys) (cl-pop args))
-	  (null keys) (= safety 0)
-	  (let* ((var (gensym "--keys--"))
-		 (allow '(:allow-other-keys))
-		 (check (list
-			 'while var
-			 (list
-			  'cond
-			  (list (list 'memq (list 'car var)
-				      (list 'quote (append keys allow)))
-				(list 'setq var (list 'cdr (list 'cdr var))))
-			  (list (list 'car
-				      (list 'cdr
-					    (list 'memq (cons 'quote allow)
-						  restarg)))
-				(list 'setq var nil))
-			  (list t
-				(list
-				 'error
-				 (format "Keyword argument %%s not one of %s"
-					 keys)
-				 (list 'car var)))))))
-	    (cl-push (list 'let (list (list var restarg)) check) bind-forms)))
-      (while (and (eq (car args) '&aux) (cl-pop args))
-	(while (and args (not (memq (car args) lambda-list-keywords)))
-	  (if (consp (car args))
-	      (if (and bind-enquote (cadar args))
-		  (cl-do-arglist (caar args)
-				 (list 'quote (cadr (cl-pop args))))
-		(cl-do-arglist (caar args) (cadr (cl-pop args))))
-	    (cl-do-arglist (cl-pop args) nil))))
-      (if args (error "Malformed argument list %s" save-args)))))
-
-(defun cl-arglist-args (args)
-  (if (nlistp args) (list args)
-    (let ((res nil) (kind nil) arg)
-      (while (consp args)
-	(setq arg (cl-pop args))
-	(if (memq arg lambda-list-keywords) (setq kind arg)
-	  (if (eq arg '&cl-defs) (cl-pop args)
-	    (and (consp arg) kind (setq arg (car arg)))
-	    (and (consp arg) (cdr arg) (eq kind '&key) (setq arg (cadr arg)))
-	    (setq res (nconc res (cl-arglist-args arg))))))
-      (nconc res (and args (list args))))))
-
-(defmacro destructuring-bind (args expr &rest body)
-  (let* ((bind-lets nil) (bind-forms nil) (bind-inits nil)
-	 (bind-defs nil) (bind-block 'cl-none))
-    (cl-do-arglist (or args '(&aux)) expr)
-    (append '(progn) bind-inits
-	    (list (nconc (list 'let* (nreverse bind-lets))
-			 (nreverse bind-forms) body)))))
-
-
-;;; The `eval-when' form.
-
-(defvar cl-not-toplevel nil)
-
-(defmacro eval-when (when &rest body)
-  "(eval-when (WHEN...) BODY...): control when BODY is evaluated.
-If `compile' is in WHEN, BODY is evaluated when compiled at top-level.
-If `load' is in WHEN, BODY is evaluated when loaded after top-level compile.
-If `eval' is in WHEN, BODY is evaluated when interpreted or at non-top-level."
-  (if (and (fboundp 'cl-compiling-file) (cl-compiling-file)
-	   (not cl-not-toplevel) (not (boundp 'for-effect)))  ; horrible kludge
-      (let ((comp (or (memq 'compile when) (memq ':compile-toplevel when)))
-	    (cl-not-toplevel t))
-	(if (or (memq 'load when) (memq ':load-toplevel when))
-	    (if comp (cons 'progn (mapcar 'cl-compile-time-too body))
-	      (list* 'if nil nil body))
-	  (progn (if comp (eval (cons 'progn body))) nil)))
-    (and (or (memq 'eval when) (memq ':execute when))
-	 (cons 'progn body))))
-
-(defun cl-compile-time-too (form)
-  (or (and (symbolp (car-safe form)) (get (car-safe form) 'byte-hunk-handler))
-      (setq form (macroexpand
-		  form (cons '(eval-when) byte-compile-macro-environment))))
-  (cond ((eq (car-safe form) 'progn)
-	 (cons 'progn (mapcar 'cl-compile-time-too (cdr form))))
-	((eq (car-safe form) 'eval-when)
-	 (let ((when (nth 1 form)))
-	   (if (or (memq 'eval when) (memq ':execute when))
-	       (list* 'eval-when (cons 'compile when) (cddr form))
-	     form)))
-	(t (eval form) form)))
-
-(or (and (fboundp 'eval-when-compile)
-	 (not (eq (car-safe (symbol-function 'eval-when-compile)) 'autoload)))
-    (eval '(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."
-	     (list 'quote (eval (cons 'progn body))))))
-
-(defmacro load-time-value (form &optional read-only)
-  "Like `progn', but evaluates the body at load time.
-The result of the body appears to the compiler as a quoted constant."
-  (if (cl-compiling-file)
-      (let* ((temp (gentemp "--cl-load-time--"))
-	     (set (list 'set (list 'quote temp) form)))
-	(if (and (fboundp 'byte-compile-file-form-defmumble)
-		 (boundp 'this-kind) (boundp 'that-one))
-	    (fset 'byte-compile-file-form
-		  (list 'lambda '(form)
-			(list 'fset '(quote byte-compile-file-form)
-			      (list 'quote
-				    (symbol-function 'byte-compile-file-form)))
-			(list 'byte-compile-file-form (list 'quote set))
-			'(byte-compile-file-form form)))
-	  (print set (symbol-value 'outbuffer)))
-	(list 'symbol-value (list 'quote temp)))
-    (list 'quote (eval form))))
-
-
-;;; Conditional control structures.
-
-(defmacro case (expr &rest clauses)
-  "(case EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value.
-Each clause looks like (KEYLIST BODY...).  EXPR is evaluated and compared
-against each key in each KEYLIST; the corresponding BODY is evaluated.
-If no clause succeeds, case returns nil.  A single atom may be used in
-place of a KEYLIST of one atom.  A KEYLIST of `t' or `otherwise' is
-allowed only in the final clause, and matches if no other keys match.
-Key values are compared by `eql'."
-  (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym)))
-	 (head-list nil)
-	 (body (cons
-		'cond
-		(mapcar
-		 (function
-		  (lambda (c)
-		    (cons (cond ((memq (car c) '(t otherwise)) t)
-				((eq (car c) 'ecase-error-flag)
-				 (list 'error "ecase failed: %s, %s"
-				       temp (list 'quote (reverse head-list))))
-				((listp (car c))
-				 (setq head-list (append (car c) head-list))
-				 (list 'member* temp (list 'quote (car c))))
-				(t
-				 (if (memq (car c) head-list)
-				     (error "Duplicate key in case: %s"
-					    (car c)))
-				 (cl-push (car c) head-list)
-				 (list 'eql temp (list 'quote (car c)))))
-			  (or (cdr c) '(nil)))))
-		 clauses))))
-    (if (eq temp expr) body
-      (list 'let (list (list temp expr)) body))))
-
-(defmacro ecase (expr &rest clauses)
-  "(ecase EXPR CLAUSES...): like `case', but error if no case fits.
-`otherwise'-clauses are not allowed."
-  (list* 'case expr (append clauses '((ecase-error-flag)))))
-
-(defmacro typecase (expr &rest clauses)
-  "(typecase EXPR CLAUSES...): evals EXPR, chooses from CLAUSES on that value.
-Each clause looks like (TYPE BODY...).  EXPR is evaluated and, if it
-satisfies TYPE, the corresponding BODY is evaluated.  If no clause succeeds,
-typecase returns nil.  A TYPE of `t' or `otherwise' is allowed only in the
-final clause, and matches if no other keys match."
-  (let* ((temp (if (cl-simple-expr-p expr 3) expr (gensym)))
-	 (type-list nil)
-	 (body (cons
-		'cond
-		(mapcar
-		 (function
-		  (lambda (c)
-		    (cons (cond ((eq (car c) 'otherwise) t)
-				((eq (car c) 'ecase-error-flag)
-				 (list 'error "etypecase failed: %s, %s"
-				       temp (list 'quote (reverse type-list))))
-				(t
-				 (cl-push (car c) type-list)
-				 (cl-make-type-test temp (car c))))
-			  (or (cdr c) '(nil)))))
-		 clauses))))
-    (if (eq temp expr) body
-      (list 'let (list (list temp expr)) body))))
-
-(defmacro etypecase (expr &rest clauses)
-  "(etypecase EXPR CLAUSES...): like `typecase', but error if no case fits.
-`otherwise'-clauses are not allowed."
-  (list* 'typecase expr (append clauses '((ecase-error-flag)))))
-
-
-;;; Blocks and exits.
-
-(defmacro block (name &rest body)
-  "(block NAME BODY...): define a lexically-scoped block named NAME.
-NAME may be any symbol.  Code inside the BODY forms can call `return-from'
-to jump prematurely out of the block.  This differs from `catch' and `throw'
-in two respects:  First, the NAME is an unevaluated symbol rather than a
-quoted symbol or other form; and second, NAME is lexically rather than
-dynamically scoped:  Only references to it within BODY will work.  These
-references may appear inside macro expansions, but not inside functions
-called from BODY."
-  (if (cl-safe-expr-p (cons 'progn body)) (cons 'progn body)
-    (list 'cl-block-wrapper
-	  (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name)))
-		 body))))
-
-(defvar cl-active-block-names nil)
-
-(put 'cl-block-wrapper 'byte-compile 'cl-byte-compile-block)
-(defun cl-byte-compile-block (cl-form)
-  (if (fboundp 'byte-compile-form-do-effect)  ; Check for optimizing compiler
-      (progn
-	(let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil))
-	       (cl-active-block-names (cons cl-entry cl-active-block-names))
-	       (cl-body (byte-compile-top-level
-			 (cons 'progn (cddr (nth 1 cl-form))))))
-	  (if (cdr cl-entry)
-	      (byte-compile-form (list 'catch (nth 1 (nth 1 cl-form)) cl-body))
-	    (byte-compile-form cl-body))))
-    (byte-compile-form (nth 1 cl-form))))
-
-(put 'cl-block-throw 'byte-compile 'cl-byte-compile-throw)
-(defun cl-byte-compile-throw (cl-form)
-  (let ((cl-found (assq (nth 1 (nth 1 cl-form)) cl-active-block-names)))
-    (if cl-found (setcdr cl-found t)))
-  (byte-compile-normal-call (cons 'throw (cdr cl-form))))
-
-(defmacro return (&optional res)
-  "(return [RESULT]): return from the block named nil.
-This is equivalent to `(return-from nil RESULT)'."
-  (list 'return-from nil res))
-
-(defmacro return-from (name &optional res)
-  "(return-from NAME [RESULT]): return from the block named NAME.
-This jump out to the innermost enclosing `(block NAME ...)' form,
-returning RESULT from that form (or nil if RESULT is omitted).
-This is compatible with Common Lisp, but note that `defun' and
-`defmacro' do not create implicit blocks as they do in Common Lisp."
-  (let ((name2 (intern (format "--cl-block-%s--" name))))
-    (list 'cl-block-throw (list 'quote name2) res)))
-
-
-;;; The "loop" macro.
-
-(defvar args) (defvar loop-accum-var) (defvar loop-accum-vars)
-(defvar loop-bindings) (defvar loop-body) (defvar loop-destr-temps)
-(defvar loop-finally) (defvar loop-finish-flag) (defvar loop-first-flag)
-(defvar loop-initially) (defvar loop-map-form) (defvar loop-name)
-(defvar loop-result) (defvar loop-result-explicit)
-(defvar loop-result-var) (defvar loop-steps) (defvar loop-symbol-macs)
-
-(defmacro loop (&rest args)
-  "(loop CLAUSE...): The Common Lisp `loop' macro.
-Valid clauses are:
-  for VAR from/upfrom/downfrom NUM to/upto/downto/above/below NUM by NUM,
-  for VAR in LIST by FUNC, for VAR on LIST by FUNC, for VAR = INIT then EXPR,
-  for VAR across ARRAY, repeat NUM, with VAR = INIT, while COND, until COND,
-  always COND, never COND, thereis COND, collect EXPR into VAR,
-  append EXPR into VAR, nconc EXPR into VAR, sum EXPR into VAR,
-  count EXPR into VAR, maximize EXPR into VAR, minimize EXPR into VAR,
-  if COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
-  unless COND CLAUSE [and CLAUSE]... else CLAUSE [and CLAUSE...],
-  do EXPRS..., initially EXPRS..., finally EXPRS..., return EXPR,
-  finally return EXPR, named NAME."
-  (if (not (memq t (mapcar 'symbolp (delq nil (delq t (copy-list args))))))
-      (list 'block nil (list* 'while t args))
-    (let ((loop-name nil)	(loop-bindings nil)
-	  (loop-body nil)	(loop-steps nil)
-	  (loop-result nil)	(loop-result-explicit nil)
-	  (loop-result-var nil) (loop-finish-flag nil)
-	  (loop-accum-var nil)	(loop-accum-vars nil)
-	  (loop-initially nil)	(loop-finally nil)
-	  (loop-map-form nil)   (loop-first-flag nil)
-	  (loop-destr-temps nil) (loop-symbol-macs nil))
-      (setq args (append args '(cl-end-loop)))
-      (while (not (eq (car args) 'cl-end-loop)) (cl-parse-loop-clause))
-      (if loop-finish-flag
-	  (cl-push (list (list loop-finish-flag t)) loop-bindings))
-      (if loop-first-flag
-	  (progn (cl-push (list (list loop-first-flag t)) loop-bindings)
-		 (cl-push (list 'setq loop-first-flag nil) loop-steps)))
-      (let* ((epilogue (nconc (nreverse loop-finally)
-			      (list (or loop-result-explicit loop-result))))
-	     (ands (cl-loop-build-ands (nreverse loop-body)))
-	     (while-body (nconc (cadr ands) (nreverse loop-steps)))
-	     (body (append
-		    (nreverse loop-initially)
-		    (list (if loop-map-form
-			      (list 'block '--cl-finish--
-				    (subst
-				     (if (eq (car ands) t) while-body
-				       (cons (list 'or (car ands)
-						   '(return-from --cl-finish--
-						      nil))
-					     while-body))
-				     '--cl-map loop-map-form))
-			    (list* 'while (car ands) while-body)))
-		    (if loop-finish-flag
-			(if (equal epilogue '(nil)) (list loop-result-var)
-			  (list (list 'if loop-finish-flag
-				      (cons 'progn epilogue) loop-result-var)))
-		      epilogue))))
-	(if loop-result-var (cl-push (list loop-result-var) loop-bindings))
-	(while loop-bindings
-	  (if (cdar loop-bindings)
-	      (setq body (list (cl-loop-let (cl-pop loop-bindings) body t)))
-	    (let ((lets nil))
-	      (while (and loop-bindings
-			  (not (cdar loop-bindings)))
-		(cl-push (car (cl-pop loop-bindings)) lets))
-	      (setq body (list (cl-loop-let lets body nil))))))
-	(if loop-symbol-macs
-	    (setq body (list (list* 'symbol-macrolet loop-symbol-macs body))))
-	(list* 'block loop-name body)))))
-
-(defun cl-parse-loop-clause ()   ; uses args, loop-*
-  (let ((word (cl-pop args))
-	(hash-types '(hash-key hash-keys hash-value hash-values))
-	(key-types '(key-code key-codes key-seq key-seqs
-		     key-binding key-bindings)))
-    (cond
-
-     ((null args)
-      (error "Malformed `loop' macro"))
-
-     ((eq word 'named)
-      (setq loop-name (cl-pop args)))
-
-     ((eq word 'initially)
-      (if (memq (car args) '(do doing)) (cl-pop args))
-      (or (consp (car args)) (error "Syntax error on `initially' clause"))
-      (while (consp (car args))
-	(cl-push (cl-pop args) loop-initially)))
-
-     ((eq word 'finally)
-      (if (eq (car args) 'return)
-	  (setq loop-result-explicit (or (cl-pop2 args) '(quote nil)))
-	(if (memq (car args) '(do doing)) (cl-pop args))
-	(or (consp (car args)) (error "Syntax error on `finally' clause"))
-	(if (and (eq (caar args) 'return) (null loop-name))
-	    (setq loop-result-explicit (or (nth 1 (cl-pop args)) '(quote nil)))
-	  (while (consp (car args))
-	    (cl-push (cl-pop args) loop-finally)))))
-
-     ((memq word '(for as))
-      (let ((loop-for-bindings nil) (loop-for-sets nil) (loop-for-steps nil)
-	    (ands nil))
-	(while
-	    (let ((var (or (cl-pop args) (gensym))))
-	      (setq word (cl-pop args))
-	      (if (eq word 'being) (setq word (cl-pop args)))
-	      (if (memq word '(the each)) (setq word (cl-pop args)))
-	      (if (memq word '(buffer buffers))
-		  (setq word 'in args (cons '(buffer-list) args)))
-	      (cond
-
-	       ((memq word '(from downfrom upfrom to downto upto
-			     above below by))
-		(cl-push word args)
-		(if (memq (car args) '(downto above))
-		    (error "Must specify `from' value for downward loop"))
-		(let* ((down (or (eq (car args) 'downfrom)
-				 (memq (caddr args) '(downto above))))
-		       (excl (or (memq (car args) '(above below))
-				 (memq (caddr args) '(above below))))
-		       (start (and (memq (car args) '(from upfrom downfrom))
-				   (cl-pop2 args)))
-		       (end (and (memq (car args)
-				       '(to upto downto above below))
-				 (cl-pop2 args)))
-		       (step (and (eq (car args) 'by) (cl-pop2 args)))
-		       (end-var (and (not (cl-const-expr-p end)) (gensym)))
-		       (step-var (and (not (cl-const-expr-p step))
-				      (gensym))))
-		  (and step (numberp step) (<= step 0)
-		       (error "Loop `by' value is not positive: %s" step))
-		  (cl-push (list var (or start 0)) loop-for-bindings)
-		  (if end-var (cl-push (list end-var end) loop-for-bindings))
-		  (if step-var (cl-push (list step-var step)
-					loop-for-bindings))
-		  (if end
-		      (cl-push (list
-				(if down (if excl '> '>=) (if excl '< '<=))
-				var (or end-var end)) loop-body))
-		  (cl-push (list var (list (if down '- '+) var
-					   (or step-var step 1)))
-			   loop-for-steps)))
-
-	       ((memq word '(in in-ref on))
-		(let* ((on (eq word 'on))
-		       (temp (if (and on (symbolp var)) var (gensym))))
-		  (cl-push (list temp (cl-pop args)) loop-for-bindings)
-		  (cl-push (list 'consp temp) loop-body)
-		  (if (eq word 'in-ref)
-		      (cl-push (list var (list 'car temp)) loop-symbol-macs)
-		    (or (eq temp var)
-			(progn
-			  (cl-push (list var nil) loop-for-bindings)
-			  (cl-push (list var (if on temp (list 'car temp)))
-				   loop-for-sets))))
-		  (cl-push (list temp
-				 (if (eq (car args) 'by)
-				     (let ((step (cl-pop2 args)))
-				       (if (and (memq (car-safe step)
-						      '(quote function
-							      function*))
-						(symbolp (nth 1 step)))
-					   (list (nth 1 step) temp)
-					 (list 'funcall step temp)))
-				   (list 'cdr temp)))
-			   loop-for-steps)))
-
-	       ((eq word '=)
-		(let* ((start (cl-pop args))
-		       (then (if (eq (car args) 'then) (cl-pop2 args) start)))
-		  (cl-push (list var nil) loop-for-bindings)
-		  (if (or ands (eq (car args) 'and))
-		      (progn
-			(cl-push (list var
-				       (list 'if
-					     (or loop-first-flag
-						 (setq loop-first-flag
-						       (gensym)))
-					     start var))
-				 loop-for-sets)
-			(cl-push (list var then) loop-for-steps))
-		    (cl-push (list var
-				   (if (eq start then) start
-				     (list 'if
-					   (or loop-first-flag
-					       (setq loop-first-flag (gensym)))
-					   start then)))
-			     loop-for-sets))))
-
-	       ((memq word '(across across-ref))
-		(let ((temp-vec (gensym)) (temp-idx (gensym)))
-		  (cl-push (list temp-vec (cl-pop args)) loop-for-bindings)
-		  (cl-push (list temp-idx -1) loop-for-bindings)
-		  (cl-push (list '< (list 'setq temp-idx (list '1+ temp-idx))
-				 (list 'length temp-vec)) loop-body)
-		  (if (eq word 'across-ref)
-		      (cl-push (list var (list 'aref temp-vec temp-idx))
-			       loop-symbol-macs)
-		    (cl-push (list var nil) loop-for-bindings)
-		    (cl-push (list var (list 'aref temp-vec temp-idx))
-			     loop-for-sets))))
-
-	       ((memq word '(element elements))
-		(let ((ref (or (memq (car args) '(in-ref of-ref))
-			       (and (not (memq (car args) '(in of)))
-				    (error "Expected `of'"))))
-		      (seq (cl-pop2 args))
-		      (temp-seq (gensym))
-		      (temp-idx (if (eq (car args) 'using)
-				    (if (and (= (length (cadr args)) 2)
-					     (eq (caadr args) 'index))
-					(cadr (cl-pop2 args))
-				      (error "Bad `using' clause"))
-				  (gensym))))
-		  (cl-push (list temp-seq seq) loop-for-bindings)
-		  (cl-push (list temp-idx 0) loop-for-bindings)
-		  (if ref
-		      (let ((temp-len (gensym)))
-			(cl-push (list temp-len (list 'length temp-seq))
-				 loop-for-bindings)
-			(cl-push (list var (list 'elt temp-seq temp-idx))
-				 loop-symbol-macs)
-			(cl-push (list '< temp-idx temp-len) loop-body))
-		    (cl-push (list var nil) loop-for-bindings)
-		    (cl-push (list 'and temp-seq
-				   (list 'or (list 'consp temp-seq)
-					 (list '< temp-idx
-					       (list 'length temp-seq))))
-			     loop-body)
-		    (cl-push (list var (list 'if (list 'consp temp-seq)
-					     (list 'pop temp-seq)
-					     (list 'aref temp-seq temp-idx)))
-			     loop-for-sets))
-		  (cl-push (list temp-idx (list '1+ temp-idx))
-			   loop-for-steps)))
-
-	       ((memq word hash-types)
-		(or (memq (car args) '(in of)) (error "Expected `of'"))
-		(let* ((table (cl-pop2 args))
-		       (other (if (eq (car args) 'using)
-				  (if (and (= (length (cadr args)) 2)
-					   (memq (caadr args) hash-types)
-					   (not (eq (caadr args) word)))
-				      (cadr (cl-pop2 args))
-				    (error "Bad `using' clause"))
-				(gensym))))
-		  (if (memq word '(hash-value hash-values))
-		      (setq var (prog1 other (setq other var))))
-		  (setq loop-map-form
-			(list 'maphash (list 'function
-					     (list* 'lambda (list var other)
-						    '--cl-map)) table))))
-
-	       ((memq word '(symbol present-symbol external-symbol
-			     symbols present-symbols external-symbols))
-		(let ((ob (and (memq (car args) '(in of)) (cl-pop2 args))))
-		  (setq loop-map-form
-			(list 'mapatoms (list 'function
-					      (list* 'lambda (list var)
-						     '--cl-map)) ob))))
-
-	       ((memq word '(overlay overlays extent extents))
-		(let ((buf nil) (from nil) (to nil))
-		  (while (memq (car args) '(in of from to))
-		    (cond ((eq (car args) 'from) (setq from (cl-pop2 args)))
-			  ((eq (car args) 'to) (setq to (cl-pop2 args)))
-			  (t (setq buf (cl-pop2 args)))))
-		  (setq loop-map-form
-			(list 'cl-map-extents
-			      (list 'function (list 'lambda (list var (gensym))
-						    '(progn . --cl-map) nil))
-			      buf from to))))
-
-	       ((memq word '(interval intervals))
-		(let ((buf nil) (prop nil) (from nil) (to nil)
-		      (var1 (gensym)) (var2 (gensym)))
-		  (while (memq (car args) '(in of property from to))
-		    (cond ((eq (car args) 'from) (setq from (cl-pop2 args)))
-			  ((eq (car args) 'to) (setq to (cl-pop2 args)))
-			  ((eq (car args) 'property)
-			   (setq prop (cl-pop2 args)))
-			  (t (setq buf (cl-pop2 args)))))
-		  (if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
-		      (setq var1 (car var) var2 (cdr var))
-		    (cl-push (list var (list 'cons var1 var2)) loop-for-sets))
-		  (setq loop-map-form
-			(list 'cl-map-intervals
-			      (list 'function (list 'lambda (list var1 var2)
-						    '(progn . --cl-map)))
-			      buf prop from to))))
-
-	       ((memq word key-types)
-		(or (memq (car args) '(in of)) (error "Expected `of'"))
-		(let ((map (cl-pop2 args))
-		      (other (if (eq (car args) 'using)
-				 (if (and (= (length (cadr args)) 2)
-					  (memq (caadr args) key-types)
-					  (not (eq (caadr args) word)))
-				     (cadr (cl-pop2 args))
-				   (error "Bad `using' clause"))
-			       (gensym))))
-		  (if (memq word '(key-binding key-bindings))
-		      (setq var (prog1 other (setq other var))))
-		  (setq loop-map-form
-			(list (if (memq word '(key-seq key-seqs))
-				  'cl-map-keymap-recursively 'cl-map-keymap)
-			      (list 'function (list* 'lambda (list var other)
-						     '--cl-map)) map))))
-
-	       ((memq word '(frame frames screen screens))
-		(let ((temp (gensym)))
-		  (cl-push (list var (if (eq cl-emacs-type 'lucid)
-					 '(selected-screen) '(selected-frame)))
-			   loop-for-bindings)
-		  (cl-push (list temp nil) loop-for-bindings)
-		  (cl-push (list 'prog1 (list 'not (list 'eq var temp))
-				 (list 'or temp (list 'setq temp var)))
-			   loop-body)
-		  (cl-push (list var (list (if (eq cl-emacs-type 'lucid)
-					       'next-screen 'next-frame) var))
-			   loop-for-steps)))
-
-	       ((memq word '(window windows))
-		(let ((scr (and (memq (car args) '(in of)) (cl-pop2 args)))
-		      (temp (gensym)))
-		  (cl-push (list var (if scr
-					 (list (if (eq cl-emacs-type 'lucid)
-						   'screen-selected-window
-						 'frame-selected-window) scr)
-				       '(selected-window)))
-			   loop-for-bindings)
-		  (cl-push (list temp nil) loop-for-bindings)
-		  (cl-push (list 'prog1 (list 'not (list 'eq var temp))
-				 (list 'or temp (list 'setq temp var)))
-			   loop-body)
-		  (cl-push (list var (list 'next-window var)) loop-for-steps)))
-
-	       (t
-		(let ((handler (and (symbolp word)
-				    (get word 'cl-loop-for-handler))))
-		  (if handler
-		      (funcall handler var)
-		    (error "Expected a `for' preposition, found %s" word)))))
-	      (eq (car args) 'and))
-	  (setq ands t)
-	  (cl-pop args))
-	(if (and ands loop-for-bindings)
-	    (cl-push (nreverse loop-for-bindings) loop-bindings)
-	  (setq loop-bindings (nconc (mapcar 'list loop-for-bindings)
-				     loop-bindings)))
-	(if loop-for-sets
-	    (cl-push (list 'progn
-			   (cl-loop-let (nreverse loop-for-sets) 'setq ands)
-			   t) loop-body))
-	(if loop-for-steps
-	    (cl-push (cons (if ands 'psetq 'setq)
-			   (apply 'append (nreverse loop-for-steps)))
-		     loop-steps))))
-
-     ((eq word 'repeat)
-      (let ((temp (gensym)))
-	(cl-push (list (list temp (cl-pop args))) loop-bindings)
-	(cl-push (list '>= (list 'setq temp (list '1- temp)) 0) loop-body)))
-
-     ((eq word 'collect)
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum nil 'nreverse)))
-	(if (eq var loop-accum-var)
-	    (cl-push (list 'progn (list 'push what var) t) loop-body)
-	  (cl-push (list 'progn
-			 (list 'setq var (list 'nconc var (list 'list what)))
-			 t) loop-body))))
-
-     ((memq word '(nconc nconcing append appending))
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum nil 'nreverse)))
-	(cl-push (list 'progn
-		       (list 'setq var
-			     (if (eq var loop-accum-var)
-				 (list 'nconc
-				       (list (if (memq word '(nconc nconcing))
-						 'nreverse 'reverse)
-					     what)
-				       var)
-			       (list (if (memq word '(nconc nconcing))
-					 'nconc 'append)
-				     var what))) t) loop-body)))
-
-     ((memq word '(concat concating))
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum "")))
-	(cl-push (list 'progn (list 'callf 'concat var what) t) loop-body)))
-
-     ((memq word '(vconcat vconcating))
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum [])))
-	(cl-push (list 'progn (list 'callf 'vconcat var what) t) loop-body)))
-
-     ((memq word '(sum summing))
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum 0)))
-	(cl-push (list 'progn (list 'incf var what) t) loop-body)))
-
-     ((memq word '(count counting))
-      (let ((what (cl-pop args))
-	    (var (cl-loop-handle-accum 0)))
-	(cl-push (list 'progn (list 'if what (list 'incf var)) t) loop-body)))
-
-     ((memq word '(minimize minimizing maximize maximizing))
-      (let* ((what (cl-pop args))
-	     (temp (if (cl-simple-expr-p what) what (gensym)))
-	     (var (cl-loop-handle-accum nil))
-	     (func (intern (substring (symbol-name word) 0 3)))
-	     (set (list 'setq var (list 'if var (list func var temp) temp))))
-	(cl-push (list 'progn (if (eq temp what) set
-				(list 'let (list (list temp what)) set))
-		       t) loop-body)))
-
-     ((eq word 'with)
-      (let ((bindings nil))
-	(while (progn (cl-push (list (cl-pop args)
-				     (and (eq (car args) '=) (cl-pop2 args)))
-			       bindings)
-		      (eq (car args) 'and))
-	  (cl-pop args))
-	(cl-push (nreverse bindings) loop-bindings)))
-
-     ((eq word 'while)
-      (cl-push (cl-pop args) loop-body))
-
-     ((eq word 'until)
-      (cl-push (list 'not (cl-pop args)) loop-body))
-
-     ((eq word 'always)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
-      (cl-push (list 'setq loop-finish-flag (cl-pop args)) loop-body)
-      (setq loop-result t))
-
-     ((eq word 'never)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
-      (cl-push (list 'setq loop-finish-flag (list 'not (cl-pop args)))
-	       loop-body)
-      (setq loop-result t))
-
-     ((eq word 'thereis)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
-      (or loop-result-var (setq loop-result-var (gensym)))
-      (cl-push (list 'setq loop-finish-flag
-		     (list 'not (list 'setq loop-result-var (cl-pop args))))
-	       loop-body))
-
-     ((memq word '(if when unless))
-      (let* ((cond (cl-pop args))
-	     (then (let ((loop-body nil))
-		     (cl-parse-loop-clause)
-		     (cl-loop-build-ands (nreverse loop-body))))
-	     (else (let ((loop-body nil))
-		     (if (eq (car args) 'else)
-			 (progn (cl-pop args) (cl-parse-loop-clause)))
-		     (cl-loop-build-ands (nreverse loop-body))))
-	     (simple (and (eq (car then) t) (eq (car else) t))))
-	(if (eq (car args) 'end) (cl-pop args))
-	(if (eq word 'unless) (setq then (prog1 else (setq else then))))
-	(let ((form (cons (if simple (cons 'progn (nth 1 then)) (nth 2 then))
-			  (if simple (nth 1 else) (list (nth 2 else))))))
-	  (if (cl-expr-contains form 'it)
-	      (let ((temp (gensym)))
-		(cl-push (list temp) loop-bindings)
-		(setq form (list* 'if (list 'setq temp cond)
-				  (subst temp 'it form))))
-	    (setq form (list* 'if cond form)))
-	  (cl-push (if simple (list 'progn form t) form) loop-body))))
-
-     ((memq word '(do doing))
-      (let ((body nil))
-	(or (consp (car args)) (error "Syntax error on `do' clause"))
-	(while (consp (car args)) (cl-push (cl-pop args) body))
-	(cl-push (cons 'progn (nreverse (cons t body))) loop-body)))
-
-     ((eq word 'return)
-      (or loop-finish-flag (setq loop-finish-flag (gensym)))
-      (or loop-result-var (setq loop-result-var (gensym)))
-      (cl-push (list 'setq loop-result-var (cl-pop args)
-		     loop-finish-flag nil) loop-body))
-
-     (t
-      (let ((handler (and (symbolp word) (get word 'cl-loop-handler))))
-	(or handler (error "Expected a loop keyword, found %s" word))
-	(funcall handler))))
-    (if (eq (car args) 'and)
-	(progn (cl-pop args) (cl-parse-loop-clause)))))
-
-(defun cl-loop-let (specs body par)   ; uses loop-*
-  (let ((p specs) (temps nil) (new nil))
-    (while (and p (or (symbolp (car-safe (car p))) (null (cadar p))))
-      (setq p (cdr p)))
-    (and par p
-	 (progn
-	   (setq par nil p specs)
-	   (while p
-	     (or (cl-const-expr-p (cadar p))
-		 (let ((temp (gensym)))
-		   (cl-push (list temp (cadar p)) temps)
-		   (setcar (cdar p) temp)))
-	     (setq p (cdr p)))))
-    (while specs
-      (if (and (consp (car specs)) (listp (caar specs)))
-	  (let* ((spec (caar specs)) (nspecs nil)
-		 (expr (cadr (cl-pop specs)))
-		 (temp (cdr (or (assq spec loop-destr-temps)
-				(car (cl-push (cons spec (or (last spec 0)
-							     (gensym)))
-					      loop-destr-temps))))))
-	    (cl-push (list temp expr) new)
-	    (while (consp spec)
-	      (cl-push (list (cl-pop spec)
-			     (and expr (list (if spec 'pop 'car) temp)))
-		       nspecs))
-	    (setq specs (nconc (nreverse nspecs) specs)))
-	(cl-push (cl-pop specs) new)))
-    (if (eq body 'setq)
-	(let ((set (cons (if par 'psetq 'setq) (apply 'nconc (nreverse new)))))
-	  (if temps (list 'let* (nreverse temps) set) set))
-      (list* (if par 'let 'let*)
-	     (nconc (nreverse temps) (nreverse new)) body))))
-
-(defun cl-loop-handle-accum (def &optional func)   ; uses args, loop-*
-  (if (eq (car args) 'into)
-      (let ((var (cl-pop2 args)))
-	(or (memq var loop-accum-vars)
-	    (progn (cl-push (list (list var def)) loop-bindings)
-		   (cl-push var loop-accum-vars)))
-	var)
-    (or loop-accum-var
-	(progn
-	  (cl-push (list (list (setq loop-accum-var (gensym)) def))
-		   loop-bindings)
-	  (setq loop-result (if func (list func loop-accum-var)
-			      loop-accum-var))
-	  loop-accum-var))))
-
-(defun cl-loop-build-ands (clauses)
-  (let ((ands nil)
-	(body nil))
-    (while clauses
-      (if (and (eq (car-safe (car clauses)) 'progn)
-	       (eq (car (last (car clauses))) t))
-	  (if (cdr clauses)
-	      (setq clauses (cons (nconc (butlast (car clauses))
-					 (if (eq (car-safe (cadr clauses))
-						 'progn)
-					     (cdadr clauses)
-					   (list (cadr clauses))))
-				  (cddr clauses)))
-	    (setq body (cdr (butlast (cl-pop clauses)))))
-	(cl-push (cl-pop clauses) ands)))
-    (setq ands (or (nreverse ands) (list t)))
-    (list (if (cdr ands) (cons 'and ands) (car ands))
-	  body
-	  (let ((full (if body
-			  (append ands (list (cons 'progn (append body '(t)))))
-			ands)))
-	    (if (cdr full) (cons 'and full) (car full))))))
-
-
-;;; Other iteration control structures.
-
-(defmacro do (steps endtest &rest body)
-  "The Common Lisp `do' loop.
-Format is: (do ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
-  (cl-expand-do-loop steps endtest body nil))
-
-(defmacro do* (steps endtest &rest body)
-  "The Common Lisp `do*' loop.
-Format is: (do* ((VAR INIT [STEP])...) (END-TEST [RESULT...]) BODY...)"
-  (cl-expand-do-loop steps endtest body t))
-
-(defun cl-expand-do-loop (steps endtest body star)
-  (list 'block nil
-	(list* (if star 'let* 'let)
-	       (mapcar (function (lambda (c)
-				   (if (consp c) (list (car c) (nth 1 c)) c)))
-		       steps)
-	       (list* 'while (list 'not (car endtest))
-		      (append body
-			      (let ((sets (mapcar
-					   (function
-					    (lambda (c)
-					      (and (consp c) (cdr (cdr c))
-						   (list (car c) (nth 2 c)))))
-					   steps)))
-				(setq sets (delq nil sets))
-				(and sets
-				     (list (cons (if (or star (not (cdr sets)))
-						     'setq 'psetq)
-						 (apply 'append sets)))))))
-	       (or (cdr endtest) '(nil)))))
-
-(defmacro dolist (spec &rest body)
-  "(dolist (VAR LIST [RESULT]) BODY...): loop over a list.
-Evaluate BODY with VAR bound to each `car' from LIST, in turn.
-Then evaluate RESULT to get return value, default nil."
-  (let ((temp (gensym "--dolist-temp--")))
-    (list 'block nil
-	  (list* 'let (list (list temp (nth 1 spec)) (car spec))
-		 (list* 'while temp (list 'setq (car spec) (list 'car temp))
-			(append body (list (list 'setq temp
-						 (list 'cdr temp)))))
-		 (if (cdr (cdr spec))
-		     (cons (list 'setq (car spec) nil) (cdr (cdr spec)))
-		   '(nil))))))
-
-(defmacro dotimes (spec &rest body)
-  "(dotimes (VAR COUNT [RESULT]) BODY...): loop a certain number of times.
-Evaluate BODY with VAR bound to successive integers from 0, inclusive,
-to COUNT, exclusive.  Then evaluate RESULT to get return value, default
-nil."
-  (let ((temp (gensym "--dotimes-temp--")))
-    (list 'block nil
-	  (list* 'let (list (list temp (nth 1 spec)) (list (car spec) 0))
-		 (list* 'while (list '< (car spec) temp)
-			(append body (list (list 'incf (car spec)))))
-		 (or (cdr (cdr spec)) '(nil))))))
-
-(defmacro do-symbols (spec &rest body)
-  "(dosymbols (VAR [OBARRAY [RESULT]]) BODY...): loop over all symbols.
-Evaluate BODY with VAR bound to each interned symbol, or to each symbol
-from OBARRAY."
-  ;; Apparently this doesn't have an implicit block.
-  (list 'block nil
-	(list 'let (list (car spec))
-	      (list* 'mapatoms
-		     (list 'function (list* 'lambda (list (car spec)) body))
-		     (and (cadr spec) (list (cadr spec))))
-	      (caddr spec))))
-
-(defmacro do-all-symbols (spec &rest body)
-  (list* 'do-symbols (list (car spec) nil (cadr spec)) body))
-
-
-;;; Assignments.
-
-(defmacro psetq (&rest args)
-  "(psetq SYM VAL SYM VAL ...): set SYMs to the values VALs in parallel.
-This is like `setq', except that all VAL forms are evaluated (in order)
-before assigning any symbols SYM to the corresponding values."
-  (cons 'psetf args))
-
-
-;;; Binding control structures.
-
-(defmacro progv (symbols values &rest body)
-  "(progv SYMBOLS VALUES BODY...): bind SYMBOLS to VALUES dynamically in BODY.
-The forms SYMBOLS and VALUES are evaluated, and must evaluate to lists.
-Each SYMBOL in the first list is bound to the corresponding VALUE in the
-second list (or made unbound if VALUES is shorter than SYMBOLS); then the
-BODY forms are executed and their result is returned.  This is much like
-a `let' form, except that the list of symbols can be computed at run-time."
-  (list 'let '((cl-progv-save nil))
-	(list 'unwind-protect
-	      (list* 'progn (list 'cl-progv-before symbols values) body)
-	      '(cl-progv-after))))
-
-;;; This should really have some way to shadow 'byte-compile properties, etc.
-(defmacro flet (bindings &rest body)
-  "(flet ((FUNC ARGLIST BODY...) ...) FORM...): make temporary function defns.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell.  The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof)."
-  (list* 'letf*
-	 (mapcar
-	  (function
-	   (lambda (x)
-	     (if (or (and (fboundp (car x))
-			  (eq (car-safe (symbol-function (car x))) 'macro))
-		     (cdr (assq (car x) cl-macro-environment)))
-		 (error "Use `labels', not `flet', to rebind macro names"))
-	     (let ((func (list 'function*
-			       (list 'lambda (cadr x)
-				     (list* 'block (car x) (cddr x))))))
-	       (if (and (cl-compiling-file)
-			(boundp 'byte-compile-function-environment))
-		   (cl-push (cons (car x) (eval func))
-			    byte-compile-function-environment))
-	       (list (list 'symbol-function (list 'quote (car x))) func))))
-	  bindings)
-	 body))
-
-(defmacro labels (bindings &rest body)
-  "(labels ((FUNC ARGLIST BODY...) ...) FORM...): make temporary func bindings.
-This is like `flet', except the bindings are lexical instead of dynamic.
-Unlike `flet', this macro is fully complaint with the Common Lisp standard."
-  (let ((vars nil) (sets nil) (cl-macro-environment cl-macro-environment))
-    (while bindings
-      (let ((var (gensym)))
-	(cl-push var vars)
-	(cl-push (list 'function* (cons 'lambda (cdar bindings))) sets)
-	(cl-push var sets)
-	(cl-push (list (car (cl-pop bindings)) 'lambda '(&rest cl-labels-args)
-		       (list 'list* '(quote funcall) (list 'quote var)
-			     'cl-labels-args))
-		 cl-macro-environment)))
-    (cl-macroexpand-all (list* 'lexical-let vars (cons (cons 'setq sets) body))
-			cl-macro-environment)))
-
-;; The following ought to have a better definition for use with newer
-;; byte compilers.
-(defmacro macrolet (bindings &rest body)
-  "(macrolet ((NAME ARGLIST BODY...) ...) FORM...): make temporary macro defns.
-This is like `flet', but for macros instead of functions."
-  (if (cdr bindings)
-      (list 'macrolet
-	    (list (car bindings)) (list* 'macrolet (cdr bindings) body))
-    (if (null bindings) (cons 'progn body)
-      (let* ((name (caar bindings))
-	     (res (cl-transform-lambda (cdar bindings) name)))
-	(eval (car res))
-	(cl-macroexpand-all (cons 'progn body)
-			    (cons (list* name 'lambda (cdr res))
-				  cl-macro-environment))))))
-
-(defmacro symbol-macrolet (bindings &rest body)
-  "(symbol-macrolet ((NAME EXPANSION) ...) FORM...): make symbol macro defns.
-Within the body FORMs, references to the variable NAME will be replaced
-by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...)."
-  (if (cdr bindings)
-      (list 'symbol-macrolet
-	    (list (car bindings)) (list* 'symbol-macrolet (cdr bindings) body))
-    (if (null bindings) (cons 'progn body)
-      (cl-macroexpand-all (cons 'progn body)
-			  (cons (list (symbol-name (caar bindings))
-				      (cadar bindings))
-				cl-macro-environment)))))
-
-(defvar cl-closure-vars nil)
-(defmacro lexical-let (bindings &rest body)
-  "(lexical-let BINDINGS BODY...): like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp."
-  (let* ((cl-closure-vars cl-closure-vars)
-	 (vars (mapcar (function
-			(lambda (x)
-			  (or (consp x) (setq x (list x)))
-			  (cl-push (gensym (format "--%s--" (car x)))
-				   cl-closure-vars)
-			  (set (car cl-closure-vars) [bad-lexical-ref])
-			  (list (car x) (cadr x) (car cl-closure-vars))))
-		       bindings))
-	 (ebody 
-	  (cl-macroexpand-all
-	   (cons 'progn body)
-	   (nconc (mapcar (function (lambda (x)
-				      (list (symbol-name (car x))
-					    (list 'symbol-value (caddr x))
-					    t))) vars)
-		  (list '(defun . cl-defun-expander))
-		  cl-macro-environment))))
-    (if (not (get (car (last cl-closure-vars)) 'used))
-	(list 'let (mapcar (function (lambda (x)
-				       (list (caddr x) (cadr x)))) vars)
-	      (sublis (mapcar (function (lambda (x)
-					  (cons (caddr x)
-						(list 'quote (caddr x)))))
-			      vars)
-		      ebody))
-      (list 'let (mapcar (function (lambda (x)
-				     (list (caddr x)
-					   (list 'make-symbol
-						 (format "--%s--" (car x))))))
-			 vars)
-	    (apply 'append '(setf)
-		   (mapcar (function
-			    (lambda (x)
-			      (list (list 'symbol-value (caddr x)) (cadr x))))
-			   vars))
-	    ebody))))
-
-(defmacro lexical-let* (bindings &rest body)
-  "(lexical-let* BINDINGS BODY...): like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp."
-  (if (null bindings) (cons 'progn body)
-    (setq bindings (reverse bindings))
-    (while bindings
-      (setq body (list (list* 'lexical-let (list (cl-pop bindings)) body))))
-    (car body)))
-
-(defun cl-defun-expander (func &rest rest)
-  (list 'progn
-	(list 'defalias (list 'quote func)
-	      (list 'function (cons 'lambda rest)))
-	(list 'quote func)))
-
-
-;;; Multiple values.
-
-(defmacro multiple-value-bind (vars form &rest body)
-  "(multiple-value-bind (SYM SYM...) FORM BODY): collect multiple return values.
-FORM must return a list; the BODY is then executed with the first N elements
-of this list bound (`let'-style) to each of the symbols SYM in turn.  This
-is analogous to the Common Lisp `multiple-value-bind' macro, using lists to
-simulate true multiple return values.  For compatibility, (values A B C) is
-a synonym for (list A B C)."
-  (let ((temp (gensym)) (n -1))
-    (list* 'let* (cons (list temp form)
-		       (mapcar (function
-				(lambda (v)
-				  (list v (list 'nth (setq n (1+ n)) temp))))
-			       vars))
-	   body)))
-
-(defmacro multiple-value-setq (vars form)
-  "(multiple-value-setq (SYM SYM...) FORM): collect multiple return values.
-FORM must return a list; the first N elements of this list are stored in
-each of the symbols SYM in turn.  This is analogous to the Common Lisp
-`multiple-value-setq' macro, using lists to simulate true multiple return
-values.  For compatibility, (values A B C) is a synonym for (list A B C)."
-  (cond ((null vars) (list 'progn form nil))
-	((null (cdr vars)) (list 'setq (car vars) (list 'car form)))
-	(t
-	 (let* ((temp (gensym)) (n 0))
-	   (list 'let (list (list temp form))
-		 (list 'prog1 (list 'setq (cl-pop vars) (list 'car temp))
-		       (cons 'setq (apply 'nconc
-					  (mapcar (function
-						   (lambda (v)
-						     (list v (list
-							      'nth
-							      (setq n (1+ n))
-							      temp))))
-						  vars)))))))))
-
-
-;;; Declarations.
-
-(defmacro locally (&rest body) (cons 'progn body))
-(defmacro the (type form) form)
-
-(defvar cl-proclaim-history t)    ; for future compilers
-(defvar cl-declare-stack t)       ; for future compilers
-
-(defun cl-do-proclaim (spec hist)
-  (and hist (listp cl-proclaim-history) (cl-push spec cl-proclaim-history))
-  (cond ((eq (car-safe spec) 'special)
-	 (if (boundp 'byte-compile-bound-variables)
-	     (setq byte-compile-bound-variables
-		   (append (cdr spec) byte-compile-bound-variables))))
-
-	((eq (car-safe spec) 'inline)
-	 (while (setq spec (cdr spec))
-	   (or (memq (get (car spec) 'byte-optimizer)
-		     '(nil byte-compile-inline-expand))
-	       (error "%s already has a byte-optimizer, can't make it inline"
-		      (car spec)))
-	   (put (car spec) 'byte-optimizer 'byte-compile-inline-expand)))
-
-	((eq (car-safe spec) 'notinline)
-	 (while (setq spec (cdr spec))
-	   (if (eq (get (car spec) 'byte-optimizer)
-		   'byte-compile-inline-expand)
-	       (put (car spec) 'byte-optimizer nil))))
-
-	((eq (car-safe spec) 'optimize)
-	 (let ((speed (assq (nth 1 (assq 'speed (cdr spec)))
-			    '((0 nil) (1 t) (2 t) (3 t))))
-	       (safety (assq (nth 1 (assq 'safety (cdr spec)))
-			     '((0 t) (1 t) (2 t) (3 nil)))))
-	   (if speed (setq cl-optimize-speed (car speed)
-			   byte-optimize (nth 1 speed)))
-	   (if safety (setq cl-optimize-safety (car safety)
-			    byte-compile-delete-errors (nth 1 safety)))))
-
-	((and (eq (car-safe spec) 'warn) (boundp 'byte-compile-warnings))
-	 (if (eq byte-compile-warnings t)
-	     (setq byte-compile-warnings byte-compile-warning-types))
-	 (while (setq spec (cdr spec))
-	   (if (consp (car spec))
-	       (if (eq (cadar spec) 0)
-		   (setq byte-compile-warnings
-			 (delq (caar spec) byte-compile-warnings))
-		 (setq byte-compile-warnings
-		       (adjoin (caar spec) byte-compile-warnings)))))))
-  nil)
-
-;;; Process any proclamations made before cl-macs was loaded.
-(defvar cl-proclaims-deferred)
-(let ((p (reverse cl-proclaims-deferred)))
-  (while p (cl-do-proclaim (cl-pop p) t))
-  (setq cl-proclaims-deferred nil))
-
-(defmacro declare (&rest specs)
-  (if (cl-compiling-file)
-      (while specs
-	(if (listp cl-declare-stack) (cl-push (car specs) cl-declare-stack))
-	(cl-do-proclaim (cl-pop specs) nil)))
-  nil)
-
-
-
-;;; Generalized variables.
-
-(defmacro define-setf-method (func args &rest body)
-  "(define-setf-method NAME ARGLIST BODY...): define a `setf' method.
-This method shows how to handle `setf's to places of the form (NAME ARGS...).
-The argument forms ARGS are bound according to ARGLIST, as if NAME were
-going to be expanded as a macro, then the BODY forms are executed and must
-return a list of five elements: a temporary-variables list, a value-forms
-list, a store-variables list (of length one), a store-form, and an access-
-form.  See `defsetf' for a simpler way to define most setf-methods."
-  (append '(eval-when (compile load eval))
-	  (if (stringp (car body))
-	      (list (list 'put (list 'quote func) '(quote setf-documentation)
-			  (cl-pop body))))
-	  (list (cl-transform-function-property
-		 func 'setf-method (cons args body)))))
-
-(defmacro defsetf (func arg1 &rest args)
-  "(defsetf NAME FUNC): define a `setf' method.
-This macro is an easy-to-use substitute for `define-setf-method' that works
-well for simple place forms.  In the simple `defsetf' form, `setf's of
-the form (setf (NAME ARGS...) VAL) are transformed to function or macro
-calls of the form (FUNC ARGS... VAL).  Example: (defsetf aref aset).
-Alternate form: (defsetf NAME ARGLIST (STORE) BODY...).
-Here, the above `setf' call is expanded by binding the argument forms ARGS
-according to ARGLIST, binding the value form VAL to STORE, then executing
-BODY, which must return a Lisp form that does the necessary `setf' operation.
-Actually, ARGLIST and STORE may be bound to temporary variables which are
-introduced automatically to preserve proper execution order of the arguments.
-Example: (defsetf nth (n x) (v) (list 'setcar (list 'nthcdr n x) v))."
-  (if (listp arg1)
-      (let* ((largs nil) (largsr nil)
-	     (temps nil) (tempsr nil)
-	     (restarg nil) (rest-temps nil)
-	     (store-var (car (prog1 (car args) (setq args (cdr args)))))
-	     (store-temp (intern (format "--%s--temp--" store-var)))
-	     (lets1 nil) (lets2 nil)
-	     (docstr nil) (p arg1))
-	(if (stringp (car args))
-	    (setq docstr (prog1 (car args) (setq args (cdr args)))))
-	(while (and p (not (eq (car p) '&aux)))
-	  (if (eq (car p) '&rest)
-	      (setq p (cdr p) restarg (car p))
-	    (or (memq (car p) '(&optional &key &allow-other-keys))
-		(setq largs (cons (if (consp (car p)) (car (car p)) (car p))
-				  largs)
-		      temps (cons (intern (format "--%s--temp--" (car largs)))
-				  temps))))
-	  (setq p (cdr p)))
-	(setq largs (nreverse largs) temps (nreverse temps))
-	(if restarg
-	    (setq largsr (append largs (list restarg))
-		  rest-temps (intern (format "--%s--temp--" restarg))
-		  tempsr (append temps (list rest-temps)))
-	  (setq largsr largs tempsr temps))
-	(let ((p1 largs) (p2 temps))
-	  (while p1
-	    (setq lets1 (cons (list (car p2)
-				    (list 'gensym (format "--%s--" (car p1))))
-			      lets1)
-		  lets2 (cons (list (car p1) (car p2)) lets2)
-		  p1 (cdr p1) p2 (cdr p2))))
-	(if restarg (setq lets2 (cons (list restarg rest-temps) lets2)))
-	(append (list 'define-setf-method func arg1)
-		(and docstr (list docstr))
-		(list
-		 (list 'let*
-		       (nreverse
-			(cons (list store-temp
-				    (list 'gensym (format "--%s--" store-var)))
-			      (if restarg
-				  (append
-				   (list
-				    (list rest-temps
-					  (list 'mapcar '(quote gensym)
-						restarg)))
-				   lets1)
-				lets1)))
-		       (list 'list  ; 'values
-			     (cons (if restarg 'list* 'list) tempsr)
-			     (cons (if restarg 'list* 'list) largsr)
-			     (list 'list store-temp)
-			     (cons 'let*
-				   (cons (nreverse
-					  (cons (list store-var store-temp)
-						lets2))
-					 args))
-			     (cons (if restarg 'list* 'list)
-				   (cons (list 'quote func) tempsr)))))))
-    (list 'defsetf func '(&rest args) '(store)
-	  (let ((call (list 'cons (list 'quote arg1)
-			    '(append args (list store)))))
-	    (if (car args)
-		(list 'list '(quote progn) call 'store)
-	      call)))))
-
-;;; Some standard place types from Common Lisp.
-(defsetf aref aset)
-(defsetf car setcar)
-(defsetf cdr setcdr)
-(defsetf elt (seq n) (store)
-  (list 'if (list 'listp seq) (list 'setcar (list 'nthcdr n seq) store)
-	(list 'aset seq n store)))
-(defsetf get put)
-(defsetf get* (x y &optional d) (store) (list 'put x y store))
-(defsetf gethash (x h &optional d) (store) (list 'cl-puthash x store h))
-(defsetf nth (n x) (store) (list 'setcar (list 'nthcdr n x) store))
-(defsetf subseq (seq start &optional end) (new)
-  (list 'progn (list 'replace seq new ':start1 start ':end1 end) new))
-(defsetf symbol-function fset)
-(defsetf symbol-plist setplist)
-(defsetf symbol-value set)
-
-;;; Various car/cdr aliases.  Note that `cadr' is handled specially.
-(defsetf first setcar)
-(defsetf second (x) (store) (list 'setcar (list 'cdr x) store))
-(defsetf third (x) (store) (list 'setcar (list 'cddr x) store))
-(defsetf fourth (x) (store) (list 'setcar (list 'cdddr x) store))
-(defsetf fifth (x) (store) (list 'setcar (list 'nthcdr 4 x) store))
-(defsetf sixth (x) (store) (list 'setcar (list 'nthcdr 5 x) store))
-(defsetf seventh (x) (store) (list 'setcar (list 'nthcdr 6 x) store))
-(defsetf eighth (x) (store) (list 'setcar (list 'nthcdr 7 x) store))
-(defsetf ninth (x) (store) (list 'setcar (list 'nthcdr 8 x) store))
-(defsetf tenth (x) (store) (list 'setcar (list 'nthcdr 9 x) store))
-(defsetf rest setcdr)
-
-;;; Some more Emacs-related place types.
-(defsetf buffer-file-name set-visited-file-name t)
-(defsetf buffer-modified-p set-buffer-modified-p t)
-(defsetf buffer-name rename-buffer t)
-(defsetf buffer-string () (store)
-  (list 'progn '(erase-buffer) (list 'insert store)))
-(defsetf buffer-substring cl-set-buffer-substring)
-(defsetf current-buffer set-buffer)
-(defsetf current-case-table set-case-table)
-(defsetf current-column move-to-column t)
-(defsetf current-global-map use-global-map t)
-(defsetf current-input-mode () (store)
-  (list 'progn (list 'apply 'set-input-mode store) store))
-(defsetf current-local-map use-local-map t)
-(defsetf current-window-configuration set-window-configuration t)
-(defsetf default-file-modes set-default-file-modes t)
-(defsetf default-value set-default)
-(defsetf documentation-property put)
-(defsetf extent-data set-extent-data)
-(defsetf extent-face set-extent-face)
-(defsetf extent-priority set-extent-priority)
-(defsetf extent-end-position (ext) (store)
-  (list 'progn (list 'set-extent-endpoints (list 'extent-start-position ext)
-		     store) store))
-(defsetf extent-start-position (ext) (store)
-  (list 'progn (list 'set-extent-endpoints store
-		     (list 'extent-end-position ext)) store))
-(defsetf face-background (f &optional s) (x) (list 'set-face-background f x s))
-(defsetf face-background-pixmap (f &optional s) (x)
-  (list 'set-face-background-pixmap f x s))
-(defsetf face-font (f &optional s) (x) (list 'set-face-font f x s))
-(defsetf face-foreground (f &optional s) (x) (list 'set-face-foreground f x s))
-(defsetf face-underline-p (f &optional s) (x)
-  (list 'set-face-underline-p f x s))
-(defsetf file-modes set-file-modes t)
-(defsetf frame-height set-screen-height t)
-(defsetf frame-parameters modify-frame-parameters t)
-(defsetf frame-visible-p cl-set-frame-visible-p)
-(defsetf frame-width set-screen-width t)
-(defsetf getenv setenv t)
-(defsetf get-register set-register)
-(defsetf global-key-binding global-set-key)
-(defsetf keymap-parent set-keymap-parent)
-(defsetf local-key-binding local-set-key)
-(defsetf mark set-mark t)
-(defsetf mark-marker set-mark t)
-(defsetf marker-position set-marker t)
-(defsetf match-data store-match-data t)
-(defsetf mouse-position (scr) (store)
-  (list 'set-mouse-position scr (list 'car store) (list 'cadr store)
-	(list 'cddr store)))
-(defsetf overlay-get overlay-put)
-(defsetf overlay-start (ov) (store)
-  (list 'progn (list 'move-overlay ov store (list 'overlay-end ov)) store))
-(defsetf overlay-end (ov) (store)
-  (list 'progn (list 'move-overlay ov (list 'overlay-start ov) store) store))
-(defsetf point goto-char)
-(defsetf point-marker goto-char t)
-(defsetf point-max () (store)
-  (list 'progn (list 'narrow-to-region '(point-min) store) store))
-(defsetf point-min () (store)
-  (list 'progn (list 'narrow-to-region store '(point-max)) store))
-(defsetf process-buffer set-process-buffer)
-(defsetf process-filter set-process-filter)
-(defsetf process-sentinel set-process-sentinel)
-(defsetf read-mouse-position (scr) (store)
-  (list 'set-mouse-position scr (list 'car store) (list 'cdr store)))
-(defsetf screen-height set-screen-height t)
-(defsetf screen-width set-screen-width t)
-(defsetf selected-window select-window)
-(defsetf selected-screen select-screen)
-(defsetf selected-frame select-frame)
-(defsetf standard-case-table set-standard-case-table)
-(defsetf syntax-table set-syntax-table)
-(defsetf visited-file-modtime set-visited-file-modtime t)
-(defsetf window-buffer set-window-buffer t)
-(defsetf window-display-table set-window-display-table t)
-(defsetf window-dedicated-p set-window-dedicated-p t)
-(defsetf window-height () (store)
-  (list 'progn (list 'enlarge-window (list '- store '(window-height))) store))
-(defsetf window-hscroll set-window-hscroll)
-(defsetf window-point set-window-point)
-(defsetf window-start set-window-start)
-(defsetf window-width () (store)
-  (list 'progn (list 'enlarge-window (list '- store '(window-width)) t) store))
-(defsetf x-get-cutbuffer x-store-cutbuffer t)
-(defsetf x-get-cut-buffer x-store-cut-buffer t)   ; groan.
-(defsetf x-get-secondary-selection x-own-secondary-selection t)
-(defsetf x-get-selection x-own-selection t)
-
-;;; More complex setf-methods.
-;;; These should take &environment arguments, but since full arglists aren't
-;;; available while compiling cl-macs, we fake it by referring to the global
-;;; variable cl-macro-environment directly.
-
-(define-setf-method apply (func arg1 &rest rest)
-  (or (and (memq (car-safe func) '(quote function function*))
-	   (symbolp (car-safe (cdr-safe func))))
-      (error "First arg to apply in setf is not (function SYM): %s" func))
-  (let* ((form (cons (nth 1 func) (cons arg1 rest)))
-	 (method (get-setf-method form cl-macro-environment)))
-    (list (car method) (nth 1 method) (nth 2 method)
-	  (cl-setf-make-apply (nth 3 method) (cadr func) (car method))
-	  (cl-setf-make-apply (nth 4 method) (cadr func) (car method)))))
-
-(defun cl-setf-make-apply (form func temps)
-  (if (eq (car form) 'progn)
-      (list* 'progn (cl-setf-make-apply (cadr form) func temps) (cddr form))
-    (or (equal (last form) (last temps))
-	(error "%s is not suitable for use with setf-of-apply" func))
-    (list* 'apply (list 'quote (car form)) (cdr form))))
-
-(define-setf-method nthcdr (n place)
-  (let ((method (get-setf-method place cl-macro-environment))
-	(n-temp (gensym "--nthcdr-n--"))
-	(store-temp (gensym "--nthcdr-store--")))
-    (list (cons n-temp (car method))
-	  (cons n (nth 1 method))
-	  (list store-temp)
-	  (list 'let (list (list (car (nth 2 method))
-				 (list 'cl-set-nthcdr n-temp (nth 4 method)
-				       store-temp)))
-		(nth 3 method) store-temp)
-	  (list 'nthcdr n-temp (nth 4 method)))))
-
-(define-setf-method getf (place tag &optional def)
-  (let ((method (get-setf-method place cl-macro-environment))
-	(tag-temp (gensym "--getf-tag--"))
-	(def-temp (gensym "--getf-def--"))
-	(store-temp (gensym "--getf-store--")))
-    (list (append (car method) (list tag-temp def-temp))
-	  (append (nth 1 method) (list tag def))
-	  (list store-temp)
-	  (list 'let (list (list (car (nth 2 method))
-				 (list 'cl-set-getf (nth 4 method)
-				       tag-temp store-temp)))
-		(nth 3 method) store-temp)
-	  (list 'getf (nth 4 method) tag-temp def-temp))))
-
-(define-setf-method substring (place from &optional to)
-  (let ((method (get-setf-method place cl-macro-environment))
-	(from-temp (gensym "--substring-from--"))
-	(to-temp (gensym "--substring-to--"))
-	(store-temp (gensym "--substring-store--")))
-    (list (append (car method) (list from-temp to-temp))
-	  (append (nth 1 method) (list from to))
-	  (list store-temp)
-	  (list 'let (list (list (car (nth 2 method))
-				 (list 'cl-set-substring (nth 4 method)
-				       from-temp to-temp store-temp)))
-		(nth 3 method) store-temp)
-	  (list 'substring (nth 4 method) from-temp to-temp))))
-
-;;; Getting and optimizing setf-methods.
-(defun get-setf-method (place &optional env)
-  "Return a list of five values describing the setf-method for PLACE.
-PLACE may be any Lisp form which can appear as the PLACE argument to
-a macro like `setf' or `incf'."
-  (if (symbolp place)
-      (let ((temp (gensym "--setf--")))
-	(list nil nil (list temp) (list 'setq place temp) place))
-    (or (and (symbolp (car place))
-	     (let* ((func (car place))
-		    (name (symbol-name func))
-		    (method (get func 'setf-method))
-		    (case-fold-search nil))
-	       (or (and method
-			(let ((cl-macro-environment env))
-			  (setq method (apply method (cdr place))))
-			(if (and (consp method) (= (length method) 5))
-			    method
-			  (error "Setf-method for %s returns malformed method"
-				 func)))
-		   (and (save-match-data
-			  (string-match "\\`c[ad][ad][ad]?[ad]?r\\'" name))
-			(get-setf-method (compiler-macroexpand place)))
-		   (and (eq func 'edebug-after)
-			(get-setf-method (nth (1- (length place)) place)
-					 env)))))
-	(if (eq place (setq place (macroexpand place env)))
-	    (if (and (symbolp (car place)) (fboundp (car place))
-		     (symbolp (symbol-function (car place))))
-		(get-setf-method (cons (symbol-function (car place))
-				       (cdr place)) env)
-	      (error "No setf-method known for %s" (car place)))
-	  (get-setf-method place env)))))
-
-(defun cl-setf-do-modify (place opt-expr)
-  (let* ((method (get-setf-method place cl-macro-environment))
-	 (temps (car method)) (values (nth 1 method))
-	 (lets nil) (subs nil)
-	 (optimize (and (not (eq opt-expr 'no-opt))
-			(or (and (not (eq opt-expr 'unsafe))
-				 (cl-safe-expr-p opt-expr))
-			    (cl-setf-simple-store-p (car (nth 2 method))
-						    (nth 3 method)))))
-	 (simple (and optimize (consp place) (cl-simple-exprs-p (cdr place)))))
-    (while values
-      (if (or simple (cl-const-expr-p (car values)))
-	  (cl-push (cons (cl-pop temps) (cl-pop values)) subs)
-	(cl-push (list (cl-pop temps) (cl-pop values)) lets)))
-    (list (nreverse lets)
-	  (cons (car (nth 2 method)) (sublis subs (nth 3 method)))
-	  (sublis subs (nth 4 method)))))
-
-(defun cl-setf-do-store (spec val)
-  (let ((sym (car spec))
-	(form (cdr spec)))
-    (if (or (cl-const-expr-p val)
-	    (and (cl-simple-expr-p val) (eq (cl-expr-contains form sym) 1))
-	    (cl-setf-simple-store-p sym form))
-	(subst val sym form)
-      (list 'let (list (list sym val)) form))))
-
-(defun cl-setf-simple-store-p (sym form)
-  (and (consp form) (eq (cl-expr-contains form sym) 1)
-       (eq (nth (1- (length form)) form) sym)
-       (symbolp (car form)) (fboundp (car form))
-       (not (eq (car-safe (symbol-function (car form))) 'macro))))
-
-;;; The standard modify macros.
-(defmacro setf (&rest args)
-  "(setf PLACE VAL PLACE VAL ...): set each PLACE to the value of its VAL.
-This is a generalized version of `setq'; the PLACEs may be symbolic
-references such as (car x) or (aref x i), as well as plain symbols.
-For example, (setf (cadar x) y) is equivalent to (setcar (cdar x) y).
-The return value is the last VAL in the list."
-  (if (cdr (cdr args))
-      (let ((sets nil))
-	(while args (cl-push (list 'setf (cl-pop args) (cl-pop args)) sets))
-	(cons 'progn (nreverse sets)))
-    (if (symbolp (car args))
-	(and args (cons 'setq args))
-      (let* ((method (cl-setf-do-modify (car args) (nth 1 args)))
-	     (store (cl-setf-do-store (nth 1 method) (nth 1 args))))
-	(if (car method) (list 'let* (car method) store) store)))))
-
-(defmacro psetf (&rest args)
-  "(psetf PLACE VAL PLACE VAL ...): set PLACEs to the values VALs in parallel.
-This is like `setf', except that all VAL forms are evaluated (in order)
-before assigning any PLACEs to the corresponding values."
-  (let ((p args) (simple t) (vars nil))
-    (while p
-      (if (or (not (symbolp (car p))) (cl-expr-depends-p (nth 1 p) vars))
-	  (setq simple nil))
-      (if (memq (car p) vars)
-	  (error "Destination duplicated in psetf: %s" (car p)))
-      (cl-push (cl-pop p) vars)
-      (or p (error "Odd number of arguments to psetf"))
-      (cl-pop p))
-    (if simple
-	(list 'progn (cons 'setf args) nil)
-      (setq args (reverse args))
-      (let ((expr (list 'setf (cadr args) (car args))))
-	(while (setq args (cddr args))
-	  (setq expr (list 'setf (cadr args) (list 'prog1 (car args) expr))))
-	(list 'progn expr nil)))))
-
-(defun cl-do-pop (place)
-  (if (cl-simple-expr-p place)
-      (list 'prog1 (list 'car place) (list 'setf place (list 'cdr place)))
-    (let* ((method (cl-setf-do-modify place t))
-	   (temp (gensym "--pop--")))
-      (list 'let*
-	    (append (car method)
-		    (list (list temp (nth 2 method))))
-	    (list 'prog1
-		  (list 'car temp)
-		  (cl-setf-do-store (nth 1 method) (list 'cdr temp)))))))
-
-(defmacro remf (place tag)
-  "(remf PLACE TAG): remove TAG from property list PLACE.
-PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The form returns true if TAG was found and removed, nil otherwise."
-  (let* ((method (cl-setf-do-modify place t))
-	 (tag-temp (and (not (cl-const-expr-p tag)) (gensym "--remf-tag--")))
-	 (val-temp (and (not (cl-simple-expr-p place))
-			(gensym "--remf-place--")))
-	 (ttag (or tag-temp tag))
-	 (tval (or val-temp (nth 2 method))))
-    (list 'let*
-	  (append (car method)
-		  (and val-temp (list (list val-temp (nth 2 method))))
-		  (and tag-temp (list (list tag-temp tag))))
-	  (list 'if (list 'eq ttag (list 'car tval))
-		(list 'progn
-		      (cl-setf-do-store (nth 1 method) (list 'cddr tval))
-		      t)
-		(list 'cl-do-remf tval ttag)))))
-
-(defmacro shiftf (place &rest args)
-  "(shiftf PLACE PLACE... VAL): shift left among PLACEs.
-Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
-Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
-  (if (not (memq nil (mapcar 'symbolp (butlast (cons place args)))))
-      (list* 'prog1 place
-	     (let ((sets nil))
-	       (while args
-		 (cl-push (list 'setq place (car args)) sets)
-		 (setq place (cl-pop args)))
-	       (nreverse sets)))
-    (let* ((places (reverse (cons place args)))
-	   (form (cl-pop places)))
-      (while places
-	(let ((method (cl-setf-do-modify (cl-pop places) 'unsafe)))
-	  (setq form (list 'let* (car method)
-			   (list 'prog1 (nth 2 method)
-				 (cl-setf-do-store (nth 1 method) form))))))
-      form)))
-
-(defmacro rotatef (&rest args)
-  "(rotatef PLACE...): rotate left among PLACEs.
-Example: (rotatef A B C) sets A to B, B to C, and C to A.  It returns nil.
-Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
-  (if (not (memq nil (mapcar 'symbolp args)))
-      (and (cdr args)
-	   (let ((sets nil)
-		 (first (car args)))
-	     (while (cdr args)
-	       (setq sets (nconc sets (list (cl-pop args) (car args)))))
-	     (nconc (list 'psetf) sets (list (car args) first))))
-    (let* ((places (reverse args))
-	   (temp (gensym "--rotatef--"))
-	   (form temp))
-      (while (cdr places)
-	(let ((method (cl-setf-do-modify (cl-pop places) 'unsafe)))
-	  (setq form (list 'let* (car method)
-			   (list 'prog1 (nth 2 method)
-				 (cl-setf-do-store (nth 1 method) form))))))
-      (let ((method (cl-setf-do-modify (car places) 'unsafe)))
-	(list 'let* (append (car method) (list (list temp (nth 2 method))))
-	      (cl-setf-do-store (nth 1 method) form) nil)))))
-
-(defmacro letf (bindings &rest body)
-  "(letf ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs.
-This is the analogue of `let', but with generalized variables (in the
-sense of `setf') for the PLACEs.  Each PLACE is set to the corresponding
-VALUE, then the BODY forms are executed.  On exit, either normally or
-because of a `throw' or error, the PLACEs are set back to their original
-values.  Note that this macro is *not* available in Common Lisp.
-As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY."
-  (if (and (not (cdr bindings)) (cdar bindings) (symbolp (caar bindings)))
-      (list* 'let bindings body)
-    (let ((lets nil) (sets nil)
-	  (unsets nil) (rev (reverse bindings)))
-      (while rev
-	(let* ((place (if (symbolp (caar rev))
-			  (list 'symbol-value (list 'quote (caar rev)))
-			(caar rev)))
-	       (value (cadar rev))
-	       (method (cl-setf-do-modify place 'no-opt))
-	       (save (gensym "--letf-save--"))
-	       (bound (and (memq (car place) '(symbol-value symbol-function))
-			   (gensym "--letf-bound--")))
-	       (temp (and (not (cl-const-expr-p value)) (cdr bindings)
-			  (gensym "--letf-val--"))))
-	  (setq lets (nconc (car method)
-			    (if bound
-				(list (list bound
-					    (list (if (eq (car place)
-							  'symbol-value)
-						      'boundp 'fboundp)
-						  (nth 1 (nth 2 method))))
-				      (list save (list 'and bound
-						       (nth 2 method))))
-			      (list (list save (nth 2 method))))
-			    (and temp (list (list temp value)))
-			    lets)
-		body (list
-		      (list 'unwind-protect
-			    (cons 'progn
-				  (if (cdr (car rev))
-				      (cons (cl-setf-do-store (nth 1 method)
-							      (or temp value))
-					    body)
-				    body))
-			    (if bound
-				(list 'if bound
-				      (cl-setf-do-store (nth 1 method) save)
-				      (list (if (eq (car place) 'symbol-value)
-						'makunbound 'fmakunbound)
-					    (nth 1 (nth 2 method))))
-			      (cl-setf-do-store (nth 1 method) save))))
-		rev (cdr rev))))
-      (list* 'let* lets body))))
-
-(defmacro letf* (bindings &rest body)
-  "(letf* ((PLACE VALUE) ...) BODY...): temporarily bind to PLACEs.
-This is the analogue of `let*', but with generalized variables (in the
-sense of `setf') for the PLACEs.  Each PLACE is set to the corresponding
-VALUE, then the BODY forms are executed.  On exit, either normally or
-because of a `throw' or error, the PLACEs are set back to their original
-values.  Note that this macro is *not* available in Common Lisp.
-As a special case, if `(PLACE)' is used instead of `(PLACE VALUE)',
-the PLACE is not modified before executing BODY."
-  (if (null bindings)
-      (cons 'progn body)
-    (setq bindings (reverse bindings))
-    (while bindings
-      (setq body (list (list* 'letf (list (cl-pop bindings)) body))))
-    (car body)))
-
-(defmacro callf (func place &rest args)
-  "(callf FUNC PLACE ARGS...): set PLACE to (FUNC PLACE ARGS...).
-FUNC should be an unquoted function name.  PLACE may be a symbol,
-or any generalized variable allowed by `setf'."
-  (let* ((method (cl-setf-do-modify place (cons 'list args)))
-	 (rargs (cons (nth 2 method) args)))
-    (list 'let* (car method)
-	  (cl-setf-do-store (nth 1 method)
-			    (if (symbolp func) (cons func rargs)
-			      (list* 'funcall (list 'function func)
-				     rargs))))))
-
-(defmacro callf2 (func arg1 place &rest args)
-  "(callf2 FUNC ARG1 PLACE ARGS...): set PLACE to (FUNC ARG1 PLACE ARGS...).
-Like `callf', but PLACE is the second argument of FUNC, not the first."
-  (if (and (cl-safe-expr-p arg1) (cl-simple-expr-p place) (symbolp func))
-      (list 'setf place (list* func arg1 place args))
-    (let* ((method (cl-setf-do-modify place (cons 'list args)))
-	   (temp (and (not (cl-const-expr-p arg1)) (gensym "--arg1--")))
-	   (rargs (list* (or temp arg1) (nth 2 method) args)))
-      (list 'let* (append (and temp (list (list temp arg1))) (car method))
-	    (cl-setf-do-store (nth 1 method)
-			      (if (symbolp func) (cons func rargs)
-				(list* 'funcall (list 'function func)
-				       rargs)))))))
-
-(defmacro define-modify-macro (name arglist func &optional doc)
-  "(define-modify-macro NAME ARGLIST FUNC): define a `setf'-like modify macro.
-If NAME is called, it combines its PLACE argument with the other arguments
-from ARGLIST using FUNC: (define-modify-macro incf (&optional (n 1)) +)"
-  (if (memq '&key arglist) (error "&key not allowed in define-modify-macro"))
-  (let ((place (gensym "--place--")))
-    (list 'defmacro* name (cons place arglist) doc
-	  (list* (if (memq '&rest arglist) 'list* 'list)
-		 '(quote callf) (list 'quote func) place
-		 (cl-arglist-args arglist)))))
-
-
-;;; Structures.
-
-(defmacro defstruct (struct &rest descs)
-  "(defstruct (NAME OPTIONS...) (SLOT SLOT-OPTS...)...): define a struct type.
-This macro defines a new Lisp data type called NAME, which contains data
-stored in SLOTs.  This defines a `make-NAME' constructor, a `copy-NAME'
-copier, a `NAME-p' predicate, and setf-able `NAME-SLOT' accessors."
-  (let* ((name (if (consp struct) (car struct) struct))
-	 (opts (cdr-safe struct))
-	 (slots nil)
-	 (defaults nil)
-	 (conc-name (concat (symbol-name name) "-"))
-	 (constructor (intern (format "make-%s" name)))
-	 (constrs nil)
-	 (copier (intern (format "copy-%s" name)))
-	 (predicate (intern (format "%s-p" name)))
-	 (print-func nil) (print-auto nil)
-	 (safety (if (cl-compiling-file) cl-optimize-safety 3))
-	 (include nil)
-	 (tag (intern (format "cl-struct-%s" name)))
-	 (tag-symbol (intern (format "cl-struct-%s-tags" name)))
-	 (include-descs nil)
-	 (side-eff nil)
-	 (type nil)
-	 (named nil)
-	 (forms nil)
-	 pred-form pred-check)
-    (if (stringp (car descs))
-	(cl-push (list 'put (list 'quote name) '(quote structure-documentation)
-		       (cl-pop descs)) forms))
-    (setq descs (cons '(cl-tag-slot)
-		      (mapcar (function (lambda (x) (if (consp x) x (list x))))
-			      descs)))
-    (while opts
-      (let ((opt (if (consp (car opts)) (caar opts) (car opts)))
-	    (args (cdr-safe (cl-pop opts))))
-	(cond ((eq opt ':conc-name)
-	       (if args
-		   (setq conc-name (if (car args)
-				       (symbol-name (car args)) ""))))
-	      ((eq opt ':constructor)
-	       (if (cdr args)
-		   (cl-push args constrs)
-		 (if args (setq constructor (car args)))))
-	      ((eq opt ':copier)
-	       (if args (setq copier (car args))))
-	      ((eq opt ':predicate)
-	       (if args (setq predicate (car args))))
-	      ((eq opt ':include)
-	       (setq include (car args)
-		     include-descs (mapcar (function
-					    (lambda (x)
-					      (if (consp x) x (list x))))
-					   (cdr args))))
-	      ((eq opt ':print-function)
-	       (setq print-func (car args)))
-	      ((eq opt ':type)
-	       (setq type (car args)))
-	      ((eq opt ':named)
-	       (setq named t))
-	      ((eq opt ':initial-offset)
-	       (setq descs (nconc (make-list (car args) '(cl-skip-slot))
-				  descs)))
-	      (t
-	       (error "Slot option %s unrecognized" opt)))))
-    (if print-func
-	(setq print-func (list 'progn
-			       (list 'funcall (list 'function print-func)
-				     'cl-x 'cl-s 'cl-n) t))
-      (or type (and include (not (get include 'cl-struct-print)))
-	  (setq print-auto t
-		print-func (and (or (not (or include type)) (null print-func))
-				(list 'progn
-				      (list 'princ (format "#S(%s" name)
-					    'cl-s))))))
-    (if include
-	(let ((inc-type (get include 'cl-struct-type))
-	      (old-descs (get include 'cl-struct-slots)))
-	  (or inc-type (error "%s is not a struct name" include))
-	  (and type (not (eq (car inc-type) type))
-	       (error ":type disagrees with :include for %s" name))
-	  (while include-descs
-	    (setcar (memq (or (assq (caar include-descs) old-descs)
-			      (error "No slot %s in included struct %s"
-				     (caar include-descs) include))
-			  old-descs)
-		    (cl-pop include-descs)))
-	  (setq descs (append old-descs (delq (assq 'cl-tag-slot descs) descs))
-		type (car inc-type)
-		named (assq 'cl-tag-slot descs))
-	  (if (cadr inc-type) (setq tag name named t))
-	  (let ((incl include))
-	    (while incl
-	      (cl-push (list 'pushnew (list 'quote tag)
-			     (intern (format "cl-struct-%s-tags" incl)))
-		       forms)
-	      (setq incl (get incl 'cl-struct-include)))))
-      (if type
-	  (progn
-	    (or (memq type '(vector list))
-		(error "Illegal :type specifier: %s" type))
-	    (if named (setq tag name)))
-	(setq type 'vector named 'true)))
-    (or named (setq descs (delq (assq 'cl-tag-slot descs) descs)))
-    (cl-push (list 'defvar tag-symbol) forms)
-    (setq pred-form (and named
-			 (let ((pos (- (length descs)
-				       (length (memq (assq 'cl-tag-slot descs)
-						     descs)))))
-			   (if (eq type 'vector)
-			       (list 'and '(vectorp cl-x)
-				     (list '>= '(length cl-x) (length descs))
-				     (list 'memq (list 'aref 'cl-x pos)
-					   tag-symbol))
-			     (if (= pos 0)
-				 (list 'memq '(car-safe cl-x) tag-symbol)
-			       (list 'and '(consp cl-x)
-				     (list 'memq (list 'nth pos 'cl-x)
-					   tag-symbol))))))
-	  pred-check (and pred-form (> safety 0)
-			  (if (and (eq (caadr pred-form) 'vectorp)
-				   (= safety 1))
-			      (cons 'and (cdddr pred-form)) pred-form)))
-    (let ((pos 0) (descp descs))
-      (while descp
-	(let* ((desc (cl-pop descp))
-	       (slot (car desc)))
-	  (if (memq slot '(cl-tag-slot cl-skip-slot))
-	      (progn
-		(cl-push nil slots)
-		(cl-push (and (eq slot 'cl-tag-slot) (list 'quote tag))
-			 defaults))
-	    (if (assq slot descp)
-		(error "Duplicate slots named %s in %s" slot name))
-	    (let ((accessor (intern (format "%s%s" conc-name slot))))
-	      (cl-push slot slots)
-	      (cl-push (nth 1 desc) defaults)
-	      (cl-push (list*
-			'defsubst* accessor '(cl-x)
-			(append
-			 (and pred-check
-			      (list (list 'or pred-check
-					  (list 'error
-						(format "%s accessing a non-%s"
-							accessor name)
-						'cl-x))))
-			 (list (if (eq type 'vector) (list 'aref 'cl-x pos)
-				 (if (= pos 0) '(car cl-x)
-				   (list 'nth pos 'cl-x)))))) forms)
-	      (cl-push (cons accessor t) side-eff)
-	      (cl-push (list 'define-setf-method accessor '(cl-x)
-			     (if (cadr (memq ':read-only (cddr desc)))
-				 (list 'error (format "%s is a read-only slot"
-						      accessor))
-			       (list 'cl-struct-setf-expander 'cl-x
-				     (list 'quote name) (list 'quote accessor)
-				     (and pred-check (list 'quote pred-check))
-				     pos)))
-		       forms)
-	      (if print-auto
-		  (nconc print-func
-			 (list (list 'princ (format " %s" slot) 'cl-s)
-			       (list 'prin1 (list accessor 'cl-x) 'cl-s)))))))
-	(setq pos (1+ pos))))
-    (setq slots (nreverse slots)
-	  defaults (nreverse defaults))
-    (and predicate pred-form
-	 (progn (cl-push (list 'defsubst* predicate '(cl-x)
-			       (if (eq (car pred-form) 'and)
-				   (append pred-form '(t))
-				 (list 'and pred-form t))) forms)
-		(cl-push (cons predicate 'error-free) side-eff)))
-    (and copier
-	 (progn (cl-push (list 'defun copier '(x) '(copy-sequence x)) forms)
-		(cl-push (cons copier t) side-eff)))
-    (if constructor
-	(cl-push (list constructor
-		       (cons '&key (delq nil (copy-sequence slots))))
-		 constrs))
-    (while constrs
-      (let* ((name (caar constrs))
-	     (args (cadr (cl-pop constrs)))
-	     (anames (cl-arglist-args args))
-	     (make (mapcar* (function (lambda (s d) (if (memq s anames) s d)))
-			    slots defaults)))
-	(cl-push (list 'defsubst* name
-		       (list* '&cl-defs (list 'quote (cons nil descs)) args)
-		       (cons type make)) forms)
-	(if (cl-safe-expr-p (cons 'progn (mapcar 'second descs)))
-	    (cl-push (cons name t) side-eff))))
-    (if print-auto (nconc print-func (list '(princ ")" cl-s) t)))
-    (if print-func
-	(cl-push (list 'push
-		       (list 'function
-			     (list 'lambda '(cl-x cl-s cl-n)
-				   (list 'and pred-form print-func)))
-		       'custom-print-functions) forms))
-    (cl-push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms)
-    (cl-push (list* 'eval-when '(compile load eval)
-		    (list 'put (list 'quote name) '(quote cl-struct-slots)
-			  (list 'quote descs))
-		    (list 'put (list 'quote name) '(quote cl-struct-type)
-			  (list 'quote (list type (eq named t))))
-		    (list 'put (list 'quote name) '(quote cl-struct-include)
-			  (list 'quote include))
-		    (list 'put (list 'quote name) '(quote cl-struct-print)
-			  print-auto)
-		    (mapcar (function (lambda (x)
-					(list 'put (list 'quote (car x))
-					      '(quote side-effect-free)
-					      (list 'quote (cdr x)))))
-			    side-eff))
-	     forms)
-    (cons 'progn (nreverse (cons (list 'quote name) forms)))))
-
-(defun cl-struct-setf-expander (x name accessor pred-form pos)
-  (let* ((temp (gensym "--x--")) (store (gensym "--store--")))
-    (list (list temp) (list x) (list store)
-	  (append '(progn)
-		  (and pred-form
-		       (list (list 'or (subst temp 'cl-x pred-form)
-				   (list 'error
-					 (format
-					  "%s storing a non-%s" accessor name)
-					 temp))))
-		  (list (if (eq (car (get name 'cl-struct-type)) 'vector)
-			    (list 'aset temp pos store)
-			  (list 'setcar
-				(if (<= pos 5)
-				    (let ((xx temp))
-				      (while (>= (setq pos (1- pos)) 0)
-					(setq xx (list 'cdr xx)))
-				      xx)
-				  (list 'nthcdr pos temp))
-				store))))
-	  (list accessor temp))))
-
-
-;;; Types and assertions.
-
-(defmacro deftype (name args &rest body)
-  "(deftype NAME ARGLIST BODY...): define NAME as a new data type.
-The type name can then be used in `typecase', `check-type', etc."
-  (list 'eval-when '(compile load eval)
-	(cl-transform-function-property
-	 name 'cl-deftype-handler (cons (list* '&cl-defs ''('*) args) body))))
-
-(defun cl-make-type-test (val type)
-  (if (memq type '(character string-char)) (setq type '(integer 0 255)))
-  (if (symbolp type)
-      (cond ((get type 'cl-deftype-handler)
-	     (cl-make-type-test val (funcall (get type 'cl-deftype-handler))))
-	    ((memq type '(nil t)) type)
-	    ((eq type 'null) (list 'null val))
-	    ((eq type 'float) (list 'floatp-safe val))
-	    ((eq type 'real) (list 'numberp val))
-	    ((eq type 'fixnum) (list 'integerp val))
-	    (t
-	     (let* ((name (symbol-name type))
-		    (namep (intern (concat name "p"))))
-	       (if (fboundp namep) (list namep val)
-		 (list (intern (concat name "-p")) val)))))
-    (cond ((get (car type) 'cl-deftype-handler)
-	   (cl-make-type-test val (apply (get (car type) 'cl-deftype-handler)
-					 (cdr type))))
-	  ((memq (car-safe type) '(integer float real number))
-	   (delq t (list 'and (cl-make-type-test val (car type))
-			 (if (memq (cadr type) '(* nil)) t
-			   (if (consp (cadr type)) (list '> val (caadr type))
-			     (list '>= val (cadr type))))
-			 (if (memq (caddr type) '(* nil)) t
-			   (if (consp (caddr type)) (list '< val (caaddr type))
-			     (list '<= val (caddr type)))))))
-	  ((memq (car-safe type) '(and or not))
-	   (cons (car type)
-		 (mapcar (function (lambda (x) (cl-make-type-test val x)))
-			 (cdr type))))
-	  ((memq (car-safe type) '(member member*))
-	   (list 'and (list 'member* val (list 'quote (cdr type))) t))
-	  ((eq (car-safe type) 'satisfies) (list (cadr type) val))
-	  (t (error "Bad type spec: %s" type)))))
-
-(defun typep (val type)   ; See compiler macro below.
-  "Check that OBJECT is of type TYPE.
-TYPE is a Common Lisp-style type specifier."
-  (eval (cl-make-type-test 'val type)))
-
-(defmacro check-type (form type &optional string)
-  "Verify that FORM is of type TYPE; signal an error if not.
-STRING is an optional description of the desired type."
-  (and (or (not (cl-compiling-file))
-	   (< cl-optimize-speed 3) (= cl-optimize-safety 3))
-       (let* ((temp (if (cl-simple-expr-p form 3) form (gensym)))
-	      (body (list 'or (cl-make-type-test temp type)
-			  (list 'signal '(quote wrong-type-argument)
-				(list 'list (or string (list 'quote type))
-				      temp (list 'quote form))))))
-	 (if (eq temp form) (list 'progn body nil)
-	   (list 'let (list (list temp form)) body nil)))))
-
-(defmacro assert (form &optional show-args string &rest args)
-  "Verify that FORM returns non-nil; signal an error if not.
-Second arg SHOW-ARGS means to include arguments of FORM in message.
-Other args STRING and ARGS... are arguments to be passed to `error'.
-They are not evaluated unless the assertion fails.  If STRING is
-omitted, a default message listing FORM itself is used."
-  (and (or (not (cl-compiling-file))
-	   (< cl-optimize-speed 3) (= cl-optimize-safety 3))
-       (let ((sargs (and show-args (delq nil (mapcar
-					      (function
-					       (lambda (x)
-						 (and (not (cl-const-expr-p x))
-						      x))) (cdr form))))))
-	 (list 'progn
-	       (list 'or form
-		     (if string
-			 (list* 'error string (append sargs args))
-		       (list 'signal '(quote cl-assertion-failed)
-			     (list* 'list (list 'quote form) sargs))))
-	       nil))))
-
-(defmacro ignore-errors (&rest body)
-  "Execute FORMS; if an error occurs, return nil.
-Otherwise, return result of last FORM."
-  (let ((err (gensym)))
-    (list 'condition-case err (cons 'progn body) '(error nil))))
-
-
-;;; Some predicates for analyzing Lisp forms.  These are used by various
-;;; macro expanders to optimize the results in certain common cases.
-
-(defconst cl-simple-funcs '(car cdr nth aref elt if and or + - 1+ 1- min max
-			    car-safe cdr-safe progn prog1 prog2))
-(defconst cl-safe-funcs '(* / % length memq list vector vectorp
-			  < > <= >= = error))
-
-;;; Check if no side effects, and executes quickly.
-(defun cl-simple-expr-p (x &optional size)
-  (or size (setq size 10))
-  (if (and (consp x) (not (memq (car x) '(quote function function*))))
-      (and (symbolp (car x))
-	   (or (memq (car x) cl-simple-funcs)
-	       (get (car x) 'side-effect-free))
-	   (progn
-	     (setq size (1- size))
-	     (while (and (setq x (cdr x))
-			 (setq size (cl-simple-expr-p (car x) size))))
-	     (and (null x) (>= size 0) size)))
-    (and (> size 0) (1- size))))
-
-(defun cl-simple-exprs-p (xs)
-  (while (and xs (cl-simple-expr-p (car xs)))
-    (setq xs (cdr xs)))
-  (not xs))
-
-;;; Check if no side effects.
-(defun cl-safe-expr-p (x)
-  (or (not (and (consp x) (not (memq (car x) '(quote function function*)))))
-      (and (symbolp (car x))
-	   (or (memq (car x) cl-simple-funcs)
-	       (memq (car x) cl-safe-funcs)
-	       (get (car x) 'side-effect-free))
-	   (progn
-	     (while (and (setq x (cdr x)) (cl-safe-expr-p (car x))))
-	     (null x)))))
-
-;;; Check if constant (i.e., no side effects or dependencies).
-(defun cl-const-expr-p (x)
-  (cond ((consp x)
-	 (or (eq (car x) 'quote)
-	     (and (memq (car x) '(function function*))
-		  (or (symbolp (nth 1 x))
-		      (and (eq (car-safe (nth 1 x)) 'lambda) 'func)))))
-	((symbolp x) (and (memq x '(nil t)) t))
-	(t t)))
-
-(defun cl-const-exprs-p (xs)
-  (while (and xs (cl-const-expr-p (car xs)))
-    (setq xs (cdr xs)))
-  (not xs))
-
-(defun cl-const-expr-val (x)
-  (and (eq (cl-const-expr-p x) t) (if (consp x) (nth 1 x) x)))
-
-(defun cl-expr-access-order (x v)
-  (if (cl-const-expr-p x) v
-    (if (consp x)
-	(progn
-	  (while (setq x (cdr x)) (setq v (cl-expr-access-order (car x) v)))
-	  v)
-      (if (eq x (car v)) (cdr v) '(t)))))
-
-;;; Count number of times X refers to Y.  Return NIL for 0 times.
-(defun cl-expr-contains (x y)
-  (cond ((equal y x) 1)
-	((and (consp x) (not (memq (car-safe x) '(quote function function*))))
-	 (let ((sum 0))
-	   (while x
-	     (setq sum (+ sum (or (cl-expr-contains (cl-pop x) y) 0))))
-	   (and (> sum 0) sum)))
-	(t nil)))
-
-(defun cl-expr-contains-any (x y)
-  (while (and y (not (cl-expr-contains x (car y)))) (cl-pop y))
-  y)
-
-;;; Check whether X may depend on any of the symbols in Y.
-(defun cl-expr-depends-p (x y)
-  (and (not (cl-const-expr-p x))
-       (or (not (cl-safe-expr-p x)) (cl-expr-contains-any x y))))
-
-
-;;; Compiler macros.
-
-(defmacro define-compiler-macro (func args &rest body)
-  "(define-compiler-macro FUNC ARGLIST BODY...): Define a compiler-only macro.
-This is like `defmacro', but macro expansion occurs only if the call to
-FUNC is compiled (i.e., not interpreted).  Compiler macros should be used
-for optimizing the way calls to FUNC are compiled; the form returned by
-BODY should do the same thing as a call to the normal function called
-FUNC, though possibly more efficiently.  Note that, like regular macros,
-compiler macros are expanded repeatedly until no further expansions are
-possible.  Unlike regular macros, BODY can decide to \"punt\" and leave the
-original function call alone by declaring an initial `&whole foo' parameter
-and then returning foo."
-  (let ((p (if (listp args) args (list '&rest args))) (res nil))
-    (while (consp p) (cl-push (cl-pop p) res))
-    (setq args (nreverse res)) (setcdr res (and p (list '&rest p))))
-  (list 'eval-when '(compile load eval)
-	(cl-transform-function-property
-	 func 'cl-compiler-macro
-	 (cons (if (memq '&whole args) (delq '&whole args)
-		 (cons '--cl-whole-arg-- args)) body))
-	(list 'or (list 'get (list 'quote func) '(quote byte-compile))
-	      (list 'put (list 'quote func) '(quote byte-compile)
-		    '(quote cl-byte-compile-compiler-macro)))))
-
-(defun compiler-macroexpand (form)
-  (while
-      (let ((func (car-safe form)) (handler nil))
-	(while (and (symbolp func)
-		    (not (setq handler (get func 'cl-compiler-macro)))
-		    (fboundp func)
-		    (or (not (eq (car-safe (symbol-function func)) 'autoload))
-			(load (nth 1 (symbol-function func)))))
-	  (setq func (symbol-function func)))
-	(and handler
-	     (not (eq form (setq form (apply handler form (cdr form))))))))
-  form)
-
-(defun cl-byte-compile-compiler-macro (form)
-  (if (eq form (setq form (compiler-macroexpand form)))
-      (byte-compile-normal-call form)
-    (byte-compile-form form)))
-
-(defmacro defsubst* (name args &rest body)
-  "(defsubst* NAME ARGLIST [DOCSTRING] BODY...): define NAME as a function.
-Like `defun', except the function is automatically declared `inline',
-ARGLIST allows full Common Lisp conventions, and BODY is implicitly
-surrounded by (block NAME ...)."
-  (let* ((argns (cl-arglist-args args)) (p argns)
-	 (pbody (cons 'progn body))
-	 (unsafe (not (cl-safe-expr-p pbody))))
-    (while (and p (eq (cl-expr-contains args (car p)) 1)) (cl-pop p))
-    (list 'progn
-	  (if p nil   ; give up if defaults refer to earlier args
-	    (list 'define-compiler-macro name
-		  (list* '&whole 'cl-whole '&cl-quote args)
-		  (list* 'cl-defsubst-expand (list 'quote argns)
-			 (list 'quote (list* 'block name body))
-			 (not (or unsafe (cl-expr-access-order pbody argns)))
-			 (and (memq '&key args) 'cl-whole) unsafe argns)))
-	  (list* 'defun* name args body))))
-
-(defun cl-defsubst-expand (argns body simple whole unsafe &rest argvs)
-  (if (and whole (not (cl-safe-expr-p (cons 'progn argvs)))) whole
-    (if (cl-simple-exprs-p argvs) (setq simple t))
-    (let ((lets (delq nil
-		      (mapcar* (function
-				(lambda (argn argv)
-				  (if (or simple (cl-const-expr-p argv))
-				      (progn (setq body (subst argv argn body))
-					     (and unsafe (list argn argv)))
-				    (list argn argv))))
-			       argns argvs))))
-      (if lets (list 'let lets body) body))))
-
-
-;;; Compile-time optimizations for some functions defined in this package.
-;;; Note that cl.el arranges to force cl-macs to be loaded at compile-time,
-;;; mainly to make sure these macros will be present.
-
-(put 'eql 'byte-compile nil)
-(define-compiler-macro eql (&whole form a b)
-  (cond ((eq (cl-const-expr-p a) t)
-	 (let ((val (cl-const-expr-val a)))
-	   (if (and (numberp val) (not (integerp val)))
-	       (list 'equal a b)
-	     (list 'eq a b))))
-	((eq (cl-const-expr-p b) t)
-	 (let ((val (cl-const-expr-val b)))
-	   (if (and (numberp val) (not (integerp val)))
-	       (list 'equal a b)
-	     (list 'eq a b))))
-	((cl-simple-expr-p a 5)
-	 (list 'if (list 'numberp a)
-	       (list 'equal a b)
-	       (list 'eq a b)))
-	((and (cl-safe-expr-p a)
-	      (cl-simple-expr-p b 5))
-	 (list 'if (list 'numberp b)
-	       (list 'equal a b)
-	       (list 'eq a b)))
-	(t form)))
-
-(define-compiler-macro member* (&whole form a list &rest keys)
-  (let ((test (and (= (length keys) 2) (eq (car keys) ':test)
-		   (cl-const-expr-val (nth 1 keys)))))
-    (cond ((eq test 'eq) (list 'memq a list))
-	  ((eq test 'equal) (list 'member a list))
-	  ((or (null keys) (eq test 'eql))
-	   (if (eq (cl-const-expr-p a) t)
-	       (list (if (floatp-safe (cl-const-expr-val a)) 'member 'memq)
-		     a list)
-	     (if (eq (cl-const-expr-p list) t)
-		 (let ((p (cl-const-expr-val list)) (mb nil) (mq nil))
-		   (if (not (cdr p))
-		       (and p (list 'eql a (list 'quote (car p))))
-		     (while p
-		       (if (floatp-safe (car p)) (setq mb t)
-			 (or (integerp (car p)) (symbolp (car p)) (setq mq t)))
-		       (setq p (cdr p)))
-		     (if (not mb) (list 'memq a list)
-		       (if (not mq) (list 'member a list) form))))
-	       form)))
-	  (t form))))
-
-(define-compiler-macro assoc* (&whole form a list &rest keys)
-  (let ((test (and (= (length keys) 2) (eq (car keys) ':test)
-		   (cl-const-expr-val (nth 1 keys)))))
-    (cond ((eq test 'eq) (list 'assq a list))
-	  ((eq test 'equal) (list 'assoc a list))
-	  ((and (eq (cl-const-expr-p a) t) (or (null keys) (eq test 'eql)))
-	   (if (floatp-safe (cl-const-expr-val a))
-	       (list 'assoc a list) (list 'assq a list)))
-	  (t form))))
-
-(define-compiler-macro adjoin (&whole form a list &rest keys)
-  (if (and (cl-simple-expr-p a) (cl-simple-expr-p list)
-	   (not (memq ':key keys)))
-      (list 'if (list* 'member* a list keys) list (list 'cons a list))
-    form))
-
-(define-compiler-macro list* (arg &rest others)
-  (let* ((args (reverse (cons arg others)))
-	 (form (car args)))
-    (while (setq args (cdr args))
-      (setq form (list 'cons (car args) form)))
-    form))
-
-(define-compiler-macro get* (sym prop &optional def)
-  (if def
-      (list 'getf (list 'symbol-plist sym) prop def)
-    (list 'get sym prop)))
-
-(define-compiler-macro typep (&whole form val type)
-  (if (cl-const-expr-p type)
-      (let ((res (cl-make-type-test val (cl-const-expr-val type))))
-	(if (or (memq (cl-expr-contains res val) '(nil 1))
-		(cl-simple-expr-p val)) res
-	  (let ((temp (gensym)))
-	    (list 'let (list (list temp val)) (subst temp val res)))))
-    form))
-
-
-(mapcar (function
-	 (lambda (y)
-	   (put (car y) 'side-effect-free t)
-	   (put (car y) 'byte-compile 'cl-byte-compile-compiler-macro)
-	   (put (car y) 'cl-compiler-macro
-		(list 'lambda '(w x)
-		      (if (symbolp (cadr y))
-			  (list 'list (list 'quote (cadr y))
-				(list 'list (list 'quote (caddr y)) 'x))
-			(cons 'list (cdr y)))))))
-	'((first 'car x) (second 'cadr x) (third 'caddr x) (fourth 'cadddr x)
-	  (fifth 'nth 4 x) (sixth 'nth 5 x) (seventh 'nth 6 x)
-	  (eighth 'nth 7 x) (ninth 'nth 8 x) (tenth 'nth 9 x)
-	  (rest 'cdr x) (endp 'null x) (plusp '> x 0) (minusp '< x 0)
-	  (caar car car) (cadr car cdr) (cdar cdr car) (cddr cdr cdr)
-	  (caaar car caar) (caadr car cadr) (cadar car cdar)
-	  (caddr car cddr) (cdaar cdr caar) (cdadr cdr cadr)
-	  (cddar cdr cdar) (cdddr cdr cddr) (caaaar car caaar)
-	  (caaadr car caadr) (caadar car cadar) (caaddr car caddr)
-	  (cadaar car cdaar) (cadadr car cdadr) (caddar car cddar)
-	  (cadddr car cdddr) (cdaaar cdr caaar) (cdaadr cdr caadr)
-	  (cdadar cdr cadar) (cdaddr cdr caddr) (cddaar cdr cdaar)
-	  (cddadr cdr cdadr) (cdddar cdr cddar) (cddddr cdr cdddr) ))
-
-;;; Things that are inline.
-(proclaim '(inline floatp-safe acons map concatenate notany notevery
-		   cl-set-elt revappend nreconc gethash))
-
-;;; Things that are side-effect-free.
-(mapcar (function (lambda (x) (put x 'side-effect-free t)))
-	'(oddp evenp abs expt signum last butlast ldiff pairlis gcd lcm
-	  isqrt floor* ceiling* truncate* round* mod* rem* subseq
-	  list-length get* getf gethash hash-table-count))
-
-;;; Things that are side-effect-and-error-free.
-(mapcar (function (lambda (x) (put x 'side-effect-free 'error-free)))
-	'(eql floatp-safe list* subst acons equalp random-state-p
-	  copy-tree sublis hash-table-p))
-
-
-(run-hooks 'cl-macs-load-hook)
-
-;;; cl-macs.el ends here
diff --git a/lisp/emacs-lisp/cl-seq.el b/lisp/emacs-lisp/cl-seq.el
deleted file mode 100644
index eaac88a4e22..00000000000
--- a/lisp/emacs-lisp/cl-seq.el
+++ /dev/null
@@ -1,919 +0,0 @@
-;;; cl-seq.el --- Common Lisp features, part 3  -*-byte-compile-dynamic: t;-*-
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; 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:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains the Common Lisp sequence and list functions
-;; which take keyword arguments.
-
-;; See cl.el for Change Log.
-
-
-;;; Code:
-
-(or (memq 'cl-19 features)
-    (error "Tried to load `cl-seq' before `cl'!"))
-
-
-;;; We define these here so that this file can compile without having
-;;; loaded the cl.el file already.
-
-(defmacro cl-push (x place) (list 'setq place (list 'cons x place)))
-(defmacro cl-pop (place)
-  (list 'car (list 'prog1 place (list 'setq place (list 'cdr place)))))
-
-
-;;; Keyword parsing.  This is special-cased here so that we can compile
-;;; this file independent from cl-macs.
-
-(defmacro cl-parsing-keywords (kwords other-keys &rest body)
-  (cons
-   'let*
-   (cons (mapcar
-	  (function
-	   (lambda (x)
-	     (let* ((var (if (consp x) (car x) x))
-		    (mem (list 'car (list 'cdr (list 'memq (list 'quote var)
-						     'cl-keys)))))
-	       (if (eq var ':test-not)
-		   (setq mem (list 'and mem (list 'setq 'cl-test mem) t)))
-	       (if (eq var ':if-not)
-		   (setq mem (list 'and mem (list 'setq 'cl-if mem) t)))
-	       (list (intern
-		      (format "cl-%s" (substring (symbol-name var) 1)))
-		     (if (consp x) (list 'or mem (car (cdr x))) mem)))))
-	  kwords)
-	 (append
-	  (and (not (eq other-keys t))
-	       (list
-		(list 'let '((cl-keys-temp cl-keys))
-		      (list 'while 'cl-keys-temp
-			    (list 'or (list 'memq '(car cl-keys-temp)
-					    (list 'quote
-						  (mapcar
-						   (function
-						    (lambda (x)
-						      (if (consp x)
-							  (car x) x)))
-						   (append kwords
-							   other-keys))))
-				  '(car (cdr (memq (quote :allow-other-keys)
-						   cl-keys)))
-				  '(error "Bad keyword argument %s"
-					  (car cl-keys-temp)))
-			    '(setq cl-keys-temp (cdr (cdr cl-keys-temp)))))))
-	  body))))
-(put 'cl-parsing-keywords 'lisp-indent-function 2)
-(put 'cl-parsing-keywords 'edebug-form-spec '(sexp sexp &rest form))
-
-(defmacro cl-check-key (x)
-  (list 'if 'cl-key (list 'funcall 'cl-key x) x))
-
-(defmacro cl-check-test-nokey (item x)
-  (list 'cond
-	(list 'cl-test
-	      (list 'eq (list 'not (list 'funcall 'cl-test item x))
-		    'cl-test-not))
-	(list 'cl-if
-	      (list 'eq (list 'not (list 'funcall 'cl-if x)) 'cl-if-not))
-	(list 't (list 'if (list 'numberp item)
-		       (list 'equal item x) (list 'eq item x)))))
-
-(defmacro cl-check-test (item x)
-  (list 'cl-check-test-nokey item (list 'cl-check-key x)))
-
-(defmacro cl-check-match (x y)
-  (setq x (list 'cl-check-key x) y (list 'cl-check-key y))
-  (list 'if 'cl-test
-	(list 'eq (list 'not (list 'funcall 'cl-test x y)) 'cl-test-not)
-	(list 'if (list 'numberp x)
-	      (list 'equal x y) (list 'eq x y))))
-
-(put 'cl-check-key 'edebug-form-spec 'edebug-forms)
-(put 'cl-check-test 'edebug-form-spec 'edebug-forms)
-(put 'cl-check-test-nokey 'edebug-form-spec 'edebug-forms)
-(put 'cl-check-match 'edebug-form-spec 'edebug-forms)
-
-(defvar cl-test) (defvar cl-test-not)
-(defvar cl-if) (defvar cl-if-not)
-(defvar cl-key)
-
-
-(defun reduce (cl-func cl-seq &rest cl-keys)
-  "Reduce two-argument FUNCTION across SEQUENCE.
-Keywords supported:  :start :end :from-end :initial-value :key"
-  (cl-parsing-keywords (:from-end (:start 0) :end :initial-value :key) ()
-    (or (listp cl-seq) (setq cl-seq (append cl-seq nil)))
-    (setq cl-seq (subseq cl-seq cl-start cl-end))
-    (if cl-from-end (setq cl-seq (nreverse cl-seq)))
-    (let ((cl-accum (cond ((memq ':initial-value cl-keys) cl-initial-value)
-			  (cl-seq (cl-check-key (cl-pop cl-seq)))
-			  (t (funcall cl-func)))))
-      (if cl-from-end
-	  (while cl-seq
-	    (setq cl-accum (funcall cl-func (cl-check-key (cl-pop cl-seq))
-				    cl-accum)))
-	(while cl-seq
-	  (setq cl-accum (funcall cl-func cl-accum
-				  (cl-check-key (cl-pop cl-seq))))))
-      cl-accum)))
-
-(defun fill (seq item &rest cl-keys)
-  "Fill the elements of SEQ with ITEM.
-Keywords supported:  :start :end"
-  (cl-parsing-keywords ((:start 0) :end) ()
-    (if (listp seq)
-	(let ((p (nthcdr cl-start seq))
-	      (n (if cl-end (- cl-end cl-start) 8000000)))
-	  (while (and p (>= (setq n (1- n)) 0))
-	    (setcar p item)
-	    (setq p (cdr p))))
-      (or cl-end (setq cl-end (length seq)))
-      (if (and (= cl-start 0) (= cl-end (length seq)))
-	  (fillarray seq item)
-	(while (< cl-start cl-end)
-	  (aset seq cl-start item)
-	  (setq cl-start (1+ cl-start)))))
-    seq))
-
-(defun replace (cl-seq1 cl-seq2 &rest cl-keys)
-  "Replace the elements of SEQ1 with the elements of SEQ2.
-SEQ1 is destructively modified, then returned.
-Keywords supported:  :start1 :end1 :start2 :end2"
-  (cl-parsing-keywords ((:start1 0) :end1 (:start2 0) :end2) ()
-    (if (and (eq cl-seq1 cl-seq2) (<= cl-start2 cl-start1))
-	(or (= cl-start1 cl-start2)
-	    (let* ((cl-len (length cl-seq1))
-		   (cl-n (min (- (or cl-end1 cl-len) cl-start1)
-			      (- (or cl-end2 cl-len) cl-start2))))
-	      (while (>= (setq cl-n (1- cl-n)) 0)
-		(cl-set-elt cl-seq1 (+ cl-start1 cl-n)
-			    (elt cl-seq2 (+ cl-start2 cl-n))))))
-      (if (listp cl-seq1)
-	  (let ((cl-p1 (nthcdr cl-start1 cl-seq1))
-		(cl-n1 (if cl-end1 (- cl-end1 cl-start1) 4000000)))
-	    (if (listp cl-seq2)
-		(let ((cl-p2 (nthcdr cl-start2 cl-seq2))
-		      (cl-n (min cl-n1
-				 (if cl-end2 (- cl-end2 cl-start2) 4000000))))
-		  (while (and cl-p1 cl-p2 (>= (setq cl-n (1- cl-n)) 0))
-		    (setcar cl-p1 (car cl-p2))
-		    (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2))))
-	      (setq cl-end2 (min (or cl-end2 (length cl-seq2))
-				 (+ cl-start2 cl-n1)))
-	      (while (and cl-p1 (< cl-start2 cl-end2))
-		(setcar cl-p1 (aref cl-seq2 cl-start2))
-		(setq cl-p1 (cdr cl-p1) cl-start2 (1+ cl-start2)))))
-	(setq cl-end1 (min (or cl-end1 (length cl-seq1))
-			   (+ cl-start1 (- (or cl-end2 (length cl-seq2))
-					   cl-start2))))
-	(if (listp cl-seq2)
-	    (let ((cl-p2 (nthcdr cl-start2 cl-seq2)))
-	      (while (< cl-start1 cl-end1)
-		(aset cl-seq1 cl-start1 (car cl-p2))
-		(setq cl-p2 (cdr cl-p2) cl-start1 (1+ cl-start1))))
-	  (while (< cl-start1 cl-end1)
-	    (aset cl-seq1 cl-start1 (aref cl-seq2 cl-start2))
-	    (setq cl-start2 (1+ cl-start2) cl-start1 (1+ cl-start1))))))
-    cl-seq1))
-
-(defun remove* (cl-item cl-seq &rest cl-keys)
-  "Remove all occurrences of ITEM in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :test :test-not :key :count :start :end :from-end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
-			(:start 0) :end) ()
-    (if (<= (or cl-count (setq cl-count 8000000)) 0)
-	cl-seq
-      (if (or (nlistp cl-seq) (and cl-from-end (< cl-count 4000000)))
-	  (let ((cl-i (cl-position cl-item cl-seq cl-start cl-end
-				   cl-from-end)))
-	    (if cl-i
-		(let ((cl-res (apply 'delete* cl-item (append cl-seq nil)
-				     (append (if cl-from-end
-						 (list ':end (1+ cl-i))
-					       (list ':start cl-i))
-					     cl-keys))))
-		  (if (listp cl-seq) cl-res
-		    (if (stringp cl-seq) (concat cl-res) (vconcat cl-res))))
-	      cl-seq))
-	(setq cl-end (- (or cl-end 8000000) cl-start))
-	(if (= cl-start 0)
-	    (while (and cl-seq (> cl-end 0)
-			(cl-check-test cl-item (car cl-seq))
-			(setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
-			(> (setq cl-count (1- cl-count)) 0))))
-	(if (and (> cl-count 0) (> cl-end 0))
-	    (let ((cl-p (if (> cl-start 0) (nthcdr cl-start cl-seq)
-			  (setq cl-end (1- cl-end)) (cdr cl-seq))))
-	      (while (and cl-p (> cl-end 0)
-			  (not (cl-check-test cl-item (car cl-p))))
-		(setq cl-p (cdr cl-p) cl-end (1- cl-end)))
-	      (if (and cl-p (> cl-end 0))
-		  (nconc (ldiff cl-seq cl-p)
-			 (if (= cl-count 1) (cdr cl-p)
-			   (and (cdr cl-p)
-				(apply 'delete* cl-item
-				       (copy-sequence (cdr cl-p))
-				       ':start 0 ':end (1- cl-end)
-				       ':count (1- cl-count) cl-keys))))
-		cl-seq))
-	  cl-seq)))))
-
-(defun remove-if (cl-pred cl-list &rest cl-keys)
-  "Remove all items satisfying PREDICATE in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'remove* nil cl-list ':if cl-pred cl-keys))
-
-(defun remove-if-not (cl-pred cl-list &rest cl-keys)
-  "Remove all items not satisfying PREDICATE in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'remove* nil cl-list ':if-not cl-pred cl-keys))
-
-(defun delete* (cl-item cl-seq &rest cl-keys)
-  "Remove all occurrences of ITEM in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :test :test-not :key :count :start :end :from-end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count :from-end
-			(:start 0) :end) ()
-    (if (<= (or cl-count (setq cl-count 8000000)) 0)
-	cl-seq
-      (if (listp cl-seq)
-	  (if (and cl-from-end (< cl-count 4000000))
-	      (let (cl-i)
-		(while (and (>= (setq cl-count (1- cl-count)) 0)
-			    (setq cl-i (cl-position cl-item cl-seq cl-start
-						    cl-end cl-from-end)))
-		  (if (= cl-i 0) (setq cl-seq (cdr cl-seq))
-		    (let ((cl-tail (nthcdr (1- cl-i) cl-seq)))
-		      (setcdr cl-tail (cdr (cdr cl-tail)))))
-		  (setq cl-end cl-i))
-		cl-seq)
-	    (setq cl-end (- (or cl-end 8000000) cl-start))
-	    (if (= cl-start 0)
-		(progn
-		  (while (and cl-seq
-			      (> cl-end 0)
-			      (cl-check-test cl-item (car cl-seq))
-			      (setq cl-end (1- cl-end) cl-seq (cdr cl-seq))
-			      (> (setq cl-count (1- cl-count)) 0)))
-		  (setq cl-end (1- cl-end)))
-	      (setq cl-start (1- cl-start)))
-	    (if (and (> cl-count 0) (> cl-end 0))
-		(let ((cl-p (nthcdr cl-start cl-seq)))
-		  (while (and (cdr cl-p) (> cl-end 0))
-		    (if (cl-check-test cl-item (car (cdr cl-p)))
-			(progn
-			  (setcdr cl-p (cdr (cdr cl-p)))
-			  (if (= (setq cl-count (1- cl-count)) 0)
-			      (setq cl-end 1)))
-		      (setq cl-p (cdr cl-p)))
-		    (setq cl-end (1- cl-end)))))
-	    cl-seq)
-	(apply 'remove* cl-item cl-seq cl-keys)))))
-
-(defun delete-if (cl-pred cl-list &rest cl-keys)
-  "Remove all items satisfying PREDICATE in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'delete* nil cl-list ':if cl-pred cl-keys))
-
-(defun delete-if-not (cl-pred cl-list &rest cl-keys)
-  "Remove all items not satisfying PREDICATE in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'delete* nil cl-list ':if-not cl-pred cl-keys))
-
-(or (and (fboundp 'delete) (subrp (symbol-function 'delete)))
-    (defalias 'delete (function (lambda (x y) (delete* x y ':test 'equal)))))
-(defun remove (x y) (remove* x y ':test 'equal))
-(defun remq (x y) (if (memq x y) (delq x (copy-list y)) y))
-
-(defun remove-duplicates (cl-seq &rest cl-keys)
-  "Return a copy of SEQ with all duplicate elements removed.
-Keywords supported:  :test :test-not :key :start :end :from-end"
-  (cl-delete-duplicates cl-seq cl-keys t))
-
-(defun delete-duplicates (cl-seq &rest cl-keys)
-  "Remove all duplicate elements from SEQ (destructively).
-Keywords supported:  :test :test-not :key :start :end :from-end"
-  (cl-delete-duplicates cl-seq cl-keys nil))
-
-(defun cl-delete-duplicates (cl-seq cl-keys cl-copy)
-  (if (listp cl-seq)
-      (cl-parsing-keywords (:test :test-not :key (:start 0) :end :from-end :if)
-	  ()
-	(if cl-from-end
-	    (let ((cl-p (nthcdr cl-start cl-seq)) cl-i)
-	      (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
-	      (while (> cl-end 1)
-		(setq cl-i 0)
-		(while (setq cl-i (cl-position (cl-check-key (car cl-p))
-					       (cdr cl-p) cl-i (1- cl-end)))
-		  (if cl-copy (setq cl-seq (copy-sequence cl-seq)
-				    cl-p (nthcdr cl-start cl-seq) cl-copy nil))
-		  (let ((cl-tail (nthcdr cl-i cl-p)))
-		    (setcdr cl-tail (cdr (cdr cl-tail))))
-		  (setq cl-end (1- cl-end)))
-		(setq cl-p (cdr cl-p) cl-end (1- cl-end)
-		      cl-start (1+ cl-start)))
-	      cl-seq)
-	  (setq cl-end (- (or cl-end (length cl-seq)) cl-start))
-	  (while (and (cdr cl-seq) (= cl-start 0) (> cl-end 1)
-		      (cl-position (cl-check-key (car cl-seq))
-				   (cdr cl-seq) 0 (1- cl-end)))
-	    (setq cl-seq (cdr cl-seq) cl-end (1- cl-end)))
-	  (let ((cl-p (if (> cl-start 0) (nthcdr (1- cl-start) cl-seq)
-			(setq cl-end (1- cl-end) cl-start 1) cl-seq)))
-	    (while (and (cdr (cdr cl-p)) (> cl-end 1))
-	      (if (cl-position (cl-check-key (car (cdr cl-p)))
-			       (cdr (cdr cl-p)) 0 (1- cl-end))
-		  (progn
-		    (if cl-copy (setq cl-seq (copy-sequence cl-seq)
-				      cl-p (nthcdr (1- cl-start) cl-seq)
-				      cl-copy nil))
-		    (setcdr cl-p (cdr (cdr cl-p))))
-		(setq cl-p (cdr cl-p)))
-	      (setq cl-end (1- cl-end) cl-start (1+ cl-start)))
-	    cl-seq)))
-    (let ((cl-res (cl-delete-duplicates (append cl-seq nil) cl-keys nil)))
-      (if (stringp cl-seq) (concat cl-res) (vconcat cl-res)))))
-
-(defun substitute (cl-new cl-old cl-seq &rest cl-keys)
-  "Substitute NEW for OLD in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :test :test-not :key :count :start :end :from-end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count
-			(:start 0) :end :from-end) ()
-    (if (or (eq cl-old cl-new)
-	    (<= (or cl-count (setq cl-from-end nil cl-count 8000000)) 0))
-	cl-seq
-      (let ((cl-i (cl-position cl-old cl-seq cl-start cl-end)))
-	(if (not cl-i)
-	    cl-seq
-	  (setq cl-seq (copy-sequence cl-seq))
-	  (or cl-from-end
-	      (progn (cl-set-elt cl-seq cl-i cl-new)
-		     (setq cl-i (1+ cl-i) cl-count (1- cl-count))))
-	  (apply 'nsubstitute cl-new cl-old cl-seq ':count cl-count
-		 ':start cl-i cl-keys))))))
-
-(defun substitute-if (cl-new cl-pred cl-list &rest cl-keys)
-  "Substitute NEW for all items satisfying PREDICATE in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'substitute cl-new nil cl-list ':if cl-pred cl-keys))
-
-(defun substitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
-  "Substitute NEW for all items not satisfying PREDICATE in SEQ.
-This is a non-destructive function; it makes a copy of SEQ if necessary
-to avoid corrupting the original SEQ.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'substitute cl-new nil cl-list ':if-not cl-pred cl-keys))
-
-(defun nsubstitute (cl-new cl-old cl-seq &rest cl-keys)
-  "Substitute NEW for OLD in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :test :test-not :key :count :start :end :from-end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not :count
-			(:start 0) :end :from-end) ()
-    (or (eq cl-old cl-new) (<= (or cl-count (setq cl-count 8000000)) 0)
-	(if (and (listp cl-seq) (or (not cl-from-end) (> cl-count 4000000)))
-	    (let ((cl-p (nthcdr cl-start cl-seq)))
-	      (setq cl-end (- (or cl-end 8000000) cl-start))
-	      (while (and cl-p (> cl-end 0) (> cl-count 0))
-		(if (cl-check-test cl-old (car cl-p))
-		    (progn
-		      (setcar cl-p cl-new)
-		      (setq cl-count (1- cl-count))))
-		(setq cl-p (cdr cl-p) cl-end (1- cl-end))))
-	  (or cl-end (setq cl-end (length cl-seq)))
-	  (if cl-from-end
-	      (while (and (< cl-start cl-end) (> cl-count 0))
-		(setq cl-end (1- cl-end))
-		(if (cl-check-test cl-old (elt cl-seq cl-end))
-		    (progn
-		      (cl-set-elt cl-seq cl-end cl-new)
-		      (setq cl-count (1- cl-count)))))
-	    (while (and (< cl-start cl-end) (> cl-count 0))
-	      (if (cl-check-test cl-old (aref cl-seq cl-start))
-		  (progn
-		    (aset cl-seq cl-start cl-new)
-		    (setq cl-count (1- cl-count))))
-	      (setq cl-start (1+ cl-start))))))
-    cl-seq))
-
-(defun nsubstitute-if (cl-new cl-pred cl-list &rest cl-keys)
-  "Substitute NEW for all items satisfying PREDICATE in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'nsubstitute cl-new nil cl-list ':if cl-pred cl-keys))
-
-(defun nsubstitute-if-not (cl-new cl-pred cl-list &rest cl-keys)
-  "Substitute NEW for all items not satisfying PREDICATE in SEQ.
-This is a destructive function; it reuses the storage of SEQ whenever possible.
-Keywords supported:  :key :count :start :end :from-end"
-  (apply 'nsubstitute cl-new nil cl-list ':if-not cl-pred cl-keys))
-
-(defun find (cl-item cl-seq &rest cl-keys)
-  "Find the first occurrence of ITEM in LIST.
-Return the matching ITEM, or nil if not found.
-Keywords supported:  :test :test-not :key :start :end :from-end"
-  (let ((cl-pos (apply 'position cl-item cl-seq cl-keys)))
-    (and cl-pos (elt cl-seq cl-pos))))
-
-(defun find-if (cl-pred cl-list &rest cl-keys)
-  "Find the first item satisfying PREDICATE in LIST.
-Return the matching ITEM, or nil if not found.
-Keywords supported:  :key :start :end :from-end"
-  (apply 'find nil cl-list ':if cl-pred cl-keys))
-
-(defun find-if-not (cl-pred cl-list &rest cl-keys)
-  "Find the first item not satisfying PREDICATE in LIST.
-Return the matching ITEM, or nil if not found.
-Keywords supported:  :key :start :end :from-end"
-  (apply 'find nil cl-list ':if-not cl-pred cl-keys))
-
-(defun position (cl-item cl-seq &rest cl-keys)
-  "Find the first occurrence of ITEM in LIST.
-Return the index of the matching item, or nil if not found.
-Keywords supported:  :test :test-not :key :start :end :from-end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not
-			(:start 0) :end :from-end) ()
-    (cl-position cl-item cl-seq cl-start cl-end cl-from-end)))
-
-(defun cl-position (cl-item cl-seq cl-start &optional cl-end cl-from-end)
-  (if (listp cl-seq)
-      (let ((cl-p (nthcdr cl-start cl-seq)))
-	(or cl-end (setq cl-end 8000000))
-	(let ((cl-res nil))
-	  (while (and cl-p (< cl-start cl-end) (or (not cl-res) cl-from-end))
-	    (if (cl-check-test cl-item (car cl-p))
-		(setq cl-res cl-start))
-	    (setq cl-p (cdr cl-p) cl-start (1+ cl-start)))
-	  cl-res))
-    (or cl-end (setq cl-end (length cl-seq)))
-    (if cl-from-end
-	(progn
-	  (while (and (>= (setq cl-end (1- cl-end)) cl-start)
-		      (not (cl-check-test cl-item (aref cl-seq cl-end)))))
-	  (and (>= cl-end cl-start) cl-end))
-      (while (and (< cl-start cl-end)
-		  (not (cl-check-test cl-item (aref cl-seq cl-start))))
-	(setq cl-start (1+ cl-start)))
-      (and (< cl-start cl-end) cl-start))))
-
-(defun position-if (cl-pred cl-list &rest cl-keys)
-  "Find the first item satisfying PREDICATE in LIST.
-Return the index of the matching item, or nil if not found.
-Keywords supported:  :key :start :end :from-end"
-  (apply 'position nil cl-list ':if cl-pred cl-keys))
-
-(defun position-if-not (cl-pred cl-list &rest cl-keys)
-  "Find the first item not satisfying PREDICATE in LIST.
-Return the index of the matching item, or nil if not found.
-Keywords supported:  :key :start :end :from-end"
-  (apply 'position nil cl-list ':if-not cl-pred cl-keys))
-
-(defun count (cl-item cl-seq &rest cl-keys)
-  "Count the number of occurrences of ITEM in LIST.
-Keywords supported:  :test :test-not :key :start :end"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not (:start 0) :end) ()
-    (let ((cl-count 0) cl-x)
-      (or cl-end (setq cl-end (length cl-seq)))
-      (if (consp cl-seq) (setq cl-seq (nthcdr cl-start cl-seq)))
-      (while (< cl-start cl-end)
-	(setq cl-x (if (consp cl-seq) (cl-pop cl-seq) (aref cl-seq cl-start)))
-	(if (cl-check-test cl-item cl-x) (setq cl-count (1+ cl-count)))
-	(setq cl-start (1+ cl-start)))
-      cl-count)))
-
-(defun count-if (cl-pred cl-list &rest cl-keys)
-  "Count the number of items satisfying PREDICATE in LIST.
-Keywords supported:  :key :start :end"
-  (apply 'count nil cl-list ':if cl-pred cl-keys))
-
-(defun count-if-not (cl-pred cl-list &rest cl-keys)
-  "Count the number of items not satisfying PREDICATE in LIST.
-Keywords supported:  :key :start :end"
-  (apply 'count nil cl-list ':if-not cl-pred cl-keys))
-
-(defun mismatch (cl-seq1 cl-seq2 &rest cl-keys)
-  "Compare SEQ1 with SEQ2, return index of first mismatching element.
-Return nil if the sequences match.  If one sequence is a prefix of the
-other, the return value indicates the end of the shorted sequence.
-Keywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end"
-  (cl-parsing-keywords (:test :test-not :key :from-end
-			(:start1 0) :end1 (:start2 0) :end2) ()
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if cl-from-end
-	(progn
-	  (while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		      (cl-check-match (elt cl-seq1 (1- cl-end1))
-				      (elt cl-seq2 (1- cl-end2))))
-	    (setq cl-end1 (1- cl-end1) cl-end2 (1- cl-end2)))
-	  (and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	       (1- cl-end1)))
-      (let ((cl-p1 (and (listp cl-seq1) (nthcdr cl-start1 cl-seq1)))
-	    (cl-p2 (and (listp cl-seq2) (nthcdr cl-start2 cl-seq2))))
-	(while (and (< cl-start1 cl-end1) (< cl-start2 cl-end2)
-		    (cl-check-match (if cl-p1 (car cl-p1)
-				      (aref cl-seq1 cl-start1))
-				    (if cl-p2 (car cl-p2)
-				      (aref cl-seq2 cl-start2))))
-	  (setq cl-p1 (cdr cl-p1) cl-p2 (cdr cl-p2)
-		cl-start1 (1+ cl-start1) cl-start2 (1+ cl-start2)))
-	(and (or (< cl-start1 cl-end1) (< cl-start2 cl-end2))
-	     cl-start1)))))
-
-(defun search (cl-seq1 cl-seq2 &rest cl-keys)
-  "Search for SEQ1 as a subsequence of SEQ2.
-Return the index of the leftmost element of the first match found;
-return nil if there are no matches.
-Keywords supported:  :test :test-not :key :start1 :end1 :start2 :end2 :from-end"
-  (cl-parsing-keywords (:test :test-not :key :from-end
-			(:start1 0) :end1 (:start2 0) :end2) ()
-    (or cl-end1 (setq cl-end1 (length cl-seq1)))
-    (or cl-end2 (setq cl-end2 (length cl-seq2)))
-    (if (>= cl-start1 cl-end1)
-	(if cl-from-end cl-end2 cl-start2)
-      (let* ((cl-len (- cl-end1 cl-start1))
-	     (cl-first (cl-check-key (elt cl-seq1 cl-start1)))
-	     (cl-if nil) cl-pos)
-	(setq cl-end2 (- cl-end2 (1- cl-len)))
-	(while (and (< cl-start2 cl-end2)
-		    (setq cl-pos (cl-position cl-first cl-seq2
-					      cl-start2 cl-end2 cl-from-end))
-		    (apply 'mismatch cl-seq1 cl-seq2
-			   ':start1 (1+ cl-start1) ':end1 cl-end1
-			   ':start2 (1+ cl-pos) ':end2 (+ cl-pos cl-len)
-			   ':from-end nil cl-keys))
-	  (if cl-from-end (setq cl-end2 cl-pos) (setq cl-start2 (1+ cl-pos))))
-	(and (< cl-start2 cl-end2) cl-pos)))))
-
-(defun sort* (cl-seq cl-pred &rest cl-keys)
-  "Sort the argument SEQUENCE according to PREDICATE.
-This is a destructive function; it reuses the storage of SEQUENCE if possible.
-Keywords supported:  :key"
-  (if (nlistp cl-seq)
-      (replace cl-seq (apply 'sort* (append cl-seq nil) cl-pred cl-keys))
-    (cl-parsing-keywords (:key) ()
-      (if (memq cl-key '(nil identity))
-	  (sort cl-seq cl-pred)
-	(sort cl-seq (function (lambda (cl-x cl-y)
-				 (funcall cl-pred (funcall cl-key cl-x)
-					  (funcall cl-key cl-y)))))))))
-
-(defun stable-sort (cl-seq cl-pred &rest cl-keys)
-  "Sort the argument SEQUENCE stably according to PREDICATE.
-This is a destructive function; it reuses the storage of SEQUENCE if possible.
-Keywords supported:  :key"
-  (apply 'sort* cl-seq cl-pred cl-keys))
-
-(defun merge (cl-type cl-seq1 cl-seq2 cl-pred &rest cl-keys)
-  "Destructively merge the two sequences to produce a new sequence.
-TYPE is the sequence type to return, SEQ1 and SEQ2 are the two
-argument sequences, and PRED is a `less-than' predicate on the elements.
-Keywords supported:  :key"
-  (or (listp cl-seq1) (setq cl-seq1 (append cl-seq1 nil)))
-  (or (listp cl-seq2) (setq cl-seq2 (append cl-seq2 nil)))
-  (cl-parsing-keywords (:key) ()
-    (let ((cl-res nil))
-      (while (and cl-seq1 cl-seq2)
-	(if (funcall cl-pred (cl-check-key (car cl-seq2))
-		     (cl-check-key (car cl-seq1)))
-	    (cl-push (cl-pop cl-seq2) cl-res)
-	  (cl-push (cl-pop cl-seq1) cl-res)))
-      (coerce (nconc (nreverse cl-res) cl-seq1 cl-seq2) cl-type))))
-
-;;; See compiler macro in cl-macs.el
-(defun member* (cl-item cl-list &rest cl-keys)
-  "Find the first occurrence of ITEM in LIST.
-Return the sublist of LIST whose car is ITEM.
-Keywords supported:  :test :test-not :key"
-  (if cl-keys
-      (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-	(while (and cl-list (not (cl-check-test cl-item (car cl-list))))
-	  (setq cl-list (cdr cl-list)))
-	cl-list)
-    (if (and (numberp cl-item) (not (integerp cl-item)))
-	(member cl-item cl-list)
-      (memq cl-item cl-list))))
-
-(defun member-if (cl-pred cl-list &rest cl-keys)
-  "Find the first item satisfying PREDICATE in LIST.
-Return the sublist of LIST whose car matches.
-Keywords supported:  :key"
-  (apply 'member* nil cl-list ':if cl-pred cl-keys))
-
-(defun member-if-not (cl-pred cl-list &rest cl-keys)
-  "Find the first item not satisfying PREDICATE in LIST.
-Return the sublist of LIST whose car matches.
-Keywords supported:  :key"
-  (apply 'member* nil cl-list ':if-not cl-pred cl-keys))
-
-(defun cl-adjoin (cl-item cl-list &rest cl-keys)
-  (if (cl-parsing-keywords (:key) t
-	(apply 'member* (cl-check-key cl-item) cl-list cl-keys))
-      cl-list
-    (cons cl-item cl-list)))
-
-;;; See compiler macro in cl-macs.el
-(defun assoc* (cl-item cl-alist &rest cl-keys)
-  "Find the first item whose car matches ITEM in LIST.
-Keywords supported:  :test :test-not :key"
-  (if cl-keys
-      (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-	(while (and cl-alist
-		    (or (not (consp (car cl-alist)))
-			(not (cl-check-test cl-item (car (car cl-alist))))))
-	  (setq cl-alist (cdr cl-alist)))
-	(and cl-alist (car cl-alist)))
-    (if (and (numberp cl-item) (not (integerp cl-item)))
-	(assoc cl-item cl-alist)
-      (assq cl-item cl-alist))))
-
-(defun assoc-if (cl-pred cl-list &rest cl-keys)
-  "Find the first item whose car satisfies PREDICATE in LIST.
-Keywords supported:  :key"
-  (apply 'assoc* nil cl-list ':if cl-pred cl-keys))
-
-(defun assoc-if-not (cl-pred cl-list &rest cl-keys)
-  "Find the first item whose car does not satisfy PREDICATE in LIST.
-Keywords supported:  :key"
-  (apply 'assoc* nil cl-list ':if-not cl-pred cl-keys))
-
-(defun rassoc* (cl-item cl-alist &rest cl-keys)
-  "Find the first item whose cdr matches ITEM in LIST.
-Keywords supported:  :test :test-not :key"
-  (if (or cl-keys (numberp cl-item))
-      (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-	(while (and cl-alist
-		    (or (not (consp (car cl-alist)))
-			(not (cl-check-test cl-item (cdr (car cl-alist))))))
-	  (setq cl-alist (cdr cl-alist)))
-	(and cl-alist (car cl-alist)))
-    (rassq cl-item cl-alist)))
-
-(defun rassoc-if (cl-pred cl-list &rest cl-keys)
-  "Find the first item whose cdr satisfies PREDICATE in LIST.
-Keywords supported:  :key"
-  (apply 'rassoc* nil cl-list ':if cl-pred cl-keys))
-
-(defun rassoc-if-not (cl-pred cl-list &rest cl-keys)
-  "Find the first item whose cdr does not satisfy PREDICATE in LIST.
-Keywords supported:  :key"
-  (apply 'rassoc* nil cl-list ':if-not cl-pred cl-keys))
-
-(defun union (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-union operation.
-The result list contains all items that appear in either LIST1 or LIST2.
-This is a non-destructive function; it makes a copy of the data if necessary
-to avoid corrupting the original LIST1 and LIST2.
-Keywords supported:  :test :test-not :key"
-  (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
-	((equal cl-list1 cl-list2) cl-list1)
-	(t
-	 (or (>= (length cl-list1) (length cl-list2))
-	     (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
-	 (while cl-list2
-	   (if (or cl-keys (numberp (car cl-list2)))
-	       (setq cl-list1 (apply 'adjoin (car cl-list2) cl-list1 cl-keys))
-	     (or (memq (car cl-list2) cl-list1)
-		 (cl-push (car cl-list2) cl-list1)))
-	   (cl-pop cl-list2))
-	 cl-list1)))
-
-(defun nunion (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-union operation.
-The result list contains all items that appear in either LIST1 or LIST2.
-This is a destructive function; it reuses the storage of LIST1 and LIST2
-whenever possible.
-Keywords supported:  :test :test-not :key"
-  (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
-	(t (apply 'union cl-list1 cl-list2 cl-keys))))
-
-(defun intersection (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-intersection operation.
-The result list contains all items that appear in both LIST1 and LIST2.
-This is a non-destructive function; it makes a copy of the data if necessary
-to avoid corrupting the original LIST1 and LIST2.
-Keywords supported:  :test :test-not :key"
-  (and cl-list1 cl-list2
-       (if (equal cl-list1 cl-list2) cl-list1
-	 (cl-parsing-keywords (:key) (:test :test-not)
-	   (let ((cl-res nil))
-	     (or (>= (length cl-list1) (length cl-list2))
-		 (setq cl-list1 (prog1 cl-list2 (setq cl-list2 cl-list1))))
-	     (while cl-list2
-	       (if (if (or cl-keys (numberp (car cl-list2)))
-		       (apply 'member* (cl-check-key (car cl-list2))
-			      cl-list1 cl-keys)
-		     (memq (car cl-list2) cl-list1))
-		   (cl-push (car cl-list2) cl-res))
-	       (cl-pop cl-list2))
-	     cl-res)))))
-
-(defun nintersection (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-intersection operation.
-The result list contains all items that appear in both LIST1 and LIST2.
-This is a destructive function; it reuses the storage of LIST1 and LIST2
-whenever possible.
-Keywords supported:  :test :test-not :key"
-  (and cl-list1 cl-list2 (apply 'intersection cl-list1 cl-list2 cl-keys)))
-
-(defun set-difference (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-difference operation.
-The result list contains all items that appear in LIST1 but not LIST2.
-This is a non-destructive function; it makes a copy of the data if necessary
-to avoid corrupting the original LIST1 and LIST2.
-Keywords supported:  :test :test-not :key"
-  (if (or (null cl-list1) (null cl-list2)) cl-list1
-    (cl-parsing-keywords (:key) (:test :test-not)
-      (let ((cl-res nil))
-	(while cl-list1
-	  (or (if (or cl-keys (numberp (car cl-list1)))
-		  (apply 'member* (cl-check-key (car cl-list1))
-			 cl-list2 cl-keys)
-		(memq (car cl-list1) cl-list2))
-	      (cl-push (car cl-list1) cl-res))
-	  (cl-pop cl-list1))
-	cl-res))))
-
-(defun nset-difference (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-difference operation.
-The result list contains all items that appear in LIST1 but not LIST2.
-This is a destructive function; it reuses the storage of LIST1 and LIST2
-whenever possible.
-Keywords supported:  :test :test-not :key"
-  (if (or (null cl-list1) (null cl-list2)) cl-list1
-    (apply 'set-difference cl-list1 cl-list2 cl-keys)))
-
-(defun set-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-exclusive-or operation.
-The result list contains all items that appear in exactly one of LIST1, LIST2.
-This is a non-destructive function; it makes a copy of the data if necessary
-to avoid corrupting the original LIST1 and LIST2.
-Keywords supported:  :test :test-not :key"
-  (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
-	((equal cl-list1 cl-list2) nil)
-	(t (append (apply 'set-difference cl-list1 cl-list2 cl-keys)
-		   (apply 'set-difference cl-list2 cl-list1 cl-keys)))))
-
-(defun nset-exclusive-or (cl-list1 cl-list2 &rest cl-keys)
-  "Combine LIST1 and LIST2 using a set-exclusive-or operation.
-The result list contains all items that appear in exactly one of LIST1, LIST2.
-This is a destructive function; it reuses the storage of LIST1 and LIST2
-whenever possible.
-Keywords supported:  :test :test-not :key"
-  (cond ((null cl-list1) cl-list2) ((null cl-list2) cl-list1)
-	((equal cl-list1 cl-list2) nil)
-	(t (nconc (apply 'nset-difference cl-list1 cl-list2 cl-keys)
-		  (apply 'nset-difference cl-list2 cl-list1 cl-keys)))))
-
-(defun subsetp (cl-list1 cl-list2 &rest cl-keys)
-  "True if LIST1 is a subset of LIST2.
-I.e., if every element of LIST1 also appears in LIST2.
-Keywords supported:  :test :test-not :key"
-  (cond ((null cl-list1) t) ((null cl-list2) nil)
-	((equal cl-list1 cl-list2) t)
-	(t (cl-parsing-keywords (:key) (:test :test-not)
-	     (while (and cl-list1
-			 (apply 'member* (cl-check-key (car cl-list1))
-				cl-list2 cl-keys))
-	       (cl-pop cl-list1))
-	     (null cl-list1)))))
-
-(defun subst-if (cl-new cl-pred cl-tree &rest cl-keys)
-  "Substitute NEW for elements matching PREDICATE in TREE (non-destructively).
-Return a copy of TREE with all matching elements replaced by NEW.
-Keywords supported:  :key"
-  (apply 'sublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys))
-
-(defun subst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
-  "Substitute NEW for elts not matching PREDICATE in TREE (non-destructively).
-Return a copy of TREE with all non-matching elements replaced by NEW.
-Keywords supported:  :key"
-  (apply 'sublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys))
-
-(defun nsubst (cl-new cl-old cl-tree &rest cl-keys)
-  "Substitute NEW for OLD everywhere in TREE (destructively).
-Any element of TREE which is `eql' to OLD is changed to NEW (via a call
-to `setcar').
-Keywords supported:  :test :test-not :key"
-  (apply 'nsublis (list (cons cl-old cl-new)) cl-tree cl-keys))
-
-(defun nsubst-if (cl-new cl-pred cl-tree &rest cl-keys)
-  "Substitute NEW for elements matching PREDICATE in TREE (destructively).
-Any element of TREE which matches is changed to NEW (via a call to `setcar').
-Keywords supported:  :key"
-  (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if cl-pred cl-keys))
-
-(defun nsubst-if-not (cl-new cl-pred cl-tree &rest cl-keys)
-  "Substitute NEW for elements not matching PREDICATE in TREE (destructively).
-Any element of TREE which matches is changed to NEW (via a call to `setcar').
-Keywords supported:  :key"
-  (apply 'nsublis (list (cons nil cl-new)) cl-tree ':if-not cl-pred cl-keys))
-
-(defun sublis (cl-alist cl-tree &rest cl-keys)
-  "Perform substitutions indicated by ALIST in TREE (non-destructively).
-Return a copy of TREE with all matching elements replaced.
-Keywords supported:  :test :test-not :key"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-    (cl-sublis-rec cl-tree)))
-
-(defvar cl-alist)
-(defun cl-sublis-rec (cl-tree)   ; uses cl-alist/key/test*/if*
-  (let ((cl-temp (cl-check-key cl-tree)) (cl-p cl-alist))
-    (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
-      (setq cl-p (cdr cl-p)))
-    (if cl-p (cdr (car cl-p))
-      (if (consp cl-tree)
-	  (let ((cl-a (cl-sublis-rec (car cl-tree)))
-		(cl-d (cl-sublis-rec (cdr cl-tree))))
-	    (if (and (eq cl-a (car cl-tree)) (eq cl-d (cdr cl-tree)))
-		cl-tree
-	      (cons cl-a cl-d)))
-	cl-tree))))
-
-(defun nsublis (cl-alist cl-tree &rest cl-keys)
-  "Perform substitutions indicated by ALIST in TREE (destructively).
-Any matching element of TREE is changed via a call to `setcar'.
-Keywords supported:  :test :test-not :key"
-  (cl-parsing-keywords (:test :test-not :key :if :if-not) ()
-    (let ((cl-hold (list cl-tree)))
-      (cl-nsublis-rec cl-hold)
-      (car cl-hold))))
-
-(defun cl-nsublis-rec (cl-tree)   ; uses cl-alist/temp/p/key/test*/if*
-  (while (consp cl-tree)
-    (let ((cl-temp (cl-check-key (car cl-tree))) (cl-p cl-alist))
-      (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
-	(setq cl-p (cdr cl-p)))
-      (if cl-p (setcar cl-tree (cdr (car cl-p)))
-	(if (consp (car cl-tree)) (cl-nsublis-rec (car cl-tree))))
-      (setq cl-temp (cl-check-key (cdr cl-tree)) cl-p cl-alist)
-      (while (and cl-p (not (cl-check-test-nokey (car (car cl-p)) cl-temp)))
-	(setq cl-p (cdr cl-p)))
-      (if cl-p
-	  (progn (setcdr cl-tree (cdr (car cl-p))) (setq cl-tree nil))
-	(setq cl-tree (cdr cl-tree))))))
-
-(defun tree-equal (cl-x cl-y &rest cl-keys)
-  "T if trees X and Y have `eql' leaves.
-Atoms are compared by `eql'; cons cells are compared recursively.
-Keywords supported:  :test :test-not :key"
-  (cl-parsing-keywords (:test :test-not :key) ()
-    (cl-tree-equal-rec cl-x cl-y)))
-
-(defun cl-tree-equal-rec (cl-x cl-y)
-  (while (and (consp cl-x) (consp cl-y)
-	      (cl-tree-equal-rec (car cl-x) (car cl-y)))
-    (setq cl-x (cdr cl-x) cl-y (cdr cl-y)))
-  (and (not (consp cl-x)) (not (consp cl-y)) (cl-check-match cl-x cl-y)))
-
-
-(run-hooks 'cl-seq-load-hook)
-
-;;; cl-seq.el ends here
diff --git a/lisp/emacs-lisp/cl-specs.el b/lisp/emacs-lisp/cl-specs.el
deleted file mode 100644
index 38497b26765..00000000000
--- a/lisp/emacs-lisp/cl-specs.el
+++ /dev/null
@@ -1,472 +0,0 @@
-;;; cl-specs.el --- Edebug specs for cl.el
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
-;; Keywords: lisp, tools, maint
-
-;; LCD Archive Entry:
-;; cl-specs.el|Daniel LaLiberte|liberte@cs.uiuc.edu
-;; |Edebug specs for cl.el
-;; |$Date: 1996/01/05 21:56:25 $|1.1|
-
-;; 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:
-
-;; These specs are to be used with edebug.el version 3.3 or later and
-;; cl.el version 2.03 or later, by Dave Gillespie <daveg@synaptics.com>.
-
-;; This file need not be byte-compiled, but it shouldn't hurt.
-
-(provide 'cl-specs)
-;; Do the above provide before the following require.
-;; Otherwise if you load this before edebug if cl is already loaded
-;; an infinite loading loop would occur.
-(require 'edebug)
-
-;; Blocks
-
-(def-edebug-spec block (symbolp body))
-(def-edebug-spec return (&optional form))
-(def-edebug-spec return-from (symbolp &optional form))
-
-;; Loops
-
-(def-edebug-spec when t)
-(def-edebug-spec unless t)
-(def-edebug-spec case (form &rest (sexp body)))
-(def-edebug-spec ecase case)
-(def-edebug-spec do
-  ((&rest &or symbolp (symbolp &optional form form))
-   (form body) 
-   cl-declarations body))
-(def-edebug-spec do* do)
-(def-edebug-spec dolist 
-  ((symbolp form &optional form) cl-declarations body))
-(def-edebug-spec dotimes dolist)
-(def-edebug-spec do-symbols
-  ((symbolp &optional form form) cl-declarations body))
-(def-edebug-spec do-all-symbols 
-  ((symbolp &optional form) cl-declarations body))
-
-;; Multiple values
-
-(def-edebug-spec multiple-value-list (form))
-(def-edebug-spec multiple-value-call (function-form body))
-(def-edebug-spec multiple-value-bind 
-  ((&rest symbolp) form cl-declarations body))
-(def-edebug-spec multiple-value-setq ((&rest symbolp) form))
-(def-edebug-spec multiple-value-prog1 (form body))
-
-;; Bindings
-
-(def-edebug-spec lexical-let let)
-(def-edebug-spec lexical-let* let)
-
-(def-edebug-spec psetq setq)
-(def-edebug-spec progv (form form body))
-
-(def-edebug-spec flet ((&rest (defun*)) cl-declarations body))
-(def-edebug-spec labels flet)
-
-(def-edebug-spec macrolet 
-  ((&rest (&define name (&rest arg) cl-declarations-or-string def-body)) 
-   cl-declarations body))
-
-(def-edebug-spec symbol-macrolet 
-  ((&rest (symbol sexp)) cl-declarations body))
-
-(def-edebug-spec destructuring-bind
-  (&define cl-macro-list form cl-declarations def-body))
-
-;; Setf
-
-(def-edebug-spec setf (&rest [place form])) ;; sexp is not specific enough
-(def-edebug-spec psetf setf)
-
-(def-edebug-spec letf  ;; *not* available in Common Lisp
-  ((&rest (gate place &optional form))
-   body))
-(def-edebug-spec letf* letf)
-
-
-(def-edebug-spec defsetf 
-  (&define name 
-	   [&or [symbolp &optional stringp]
-		[cl-lambda-list (symbolp)]]
-	   cl-declarations-or-string def-body))
-
-(def-edebug-spec define-setf-method 
-  (&define name cl-lambda-list cl-declarations-or-string def-body))
-
-(def-edebug-spec define-modify-macro
-  (&define name cl-lambda-list ;; should exclude &key
-	   symbolp &optional stringp))
-
-(def-edebug-spec callf (function* place &rest form))
-(def-edebug-spec callf2 (function* form place &rest form))
-
-;; Other operations on places
-
-(def-edebug-spec remf (place form))
-
-(def-edebug-spec incf (place &optional form))
-(def-edebug-spec decf incf)
-(def-edebug-spec push (form place))
-(def-edebug-spec pushnew 
-  (form place &rest 
-	&or [[&or ":test" ":test-not" ":key"] function-form]
-	[edebug-keywordp form]))
-(def-edebug-spec pop (place))
-
-(def-edebug-spec shiftf (&rest place))  ;; really [&rest place] form
-(def-edebug-spec rotatef (&rest place))
-
-
-;; Functions with function args.  These are only useful if the
-;; function arg is quoted with ' instead of function.
-
-(def-edebug-spec some (function-form form &rest form))
-(def-edebug-spec every some)
-(def-edebug-spec notany some)
-(def-edebug-spec notevery some)
-
-;; Mapping
-
-(def-edebug-spec map (form function-form form &rest form))
-(def-edebug-spec maplist (function-form form &rest form))
-(def-edebug-spec mapc maplist)
-(def-edebug-spec mapl maplist)
-(def-edebug-spec mapcan maplist)
-(def-edebug-spec mapcon maplist)
-
-;; Sequences
-
-(def-edebug-spec reduce (function-form form &rest form))
-
-;; Types and assertions
-
-(def-edebug-spec cl-type-spec (sexp)) ;; not worth the trouble to specify, yet.
-
-(def-edebug-spec deftype defmacro*)
-(def-edebug-spec check-type (place cl-type-spec &optional stringp))
-;; (def-edebug-spec assert (form &optional form stringp &rest form))
-(def-edebug-spec assert (form &rest form))
-(def-edebug-spec typecase (form &rest ([&or cl-type-spec "otherwise"] body)))
-(def-edebug-spec etypecase typecase)
-
-(def-edebug-spec ignore-errors t)
-
-;; Time of Evaluation
-
-(def-edebug-spec eval-when
-  ((&rest &or "compile" "load" "eval") body))
-(def-edebug-spec load-time-value (form &optional &or "t" "nil"))
-
-;; Declarations
-
-(def-edebug-spec cl-decl-spec 
-  ((symbolp &rest sexp)))
-
-(def-edebug-spec cl-declarations
-  (&rest ("declare" &rest cl-decl-spec)))
-
-(def-edebug-spec cl-declarations-or-string
-  (&or stringp cl-declarations))
-
-(def-edebug-spec declaim (&rest cl-decl-spec))
-(def-edebug-spec declare (&rest cl-decl-spec))  ;; probably not needed.
-(def-edebug-spec locally (cl-declarations &rest form))
-(def-edebug-spec the (cl-type-spec form))
-
-;;======================================================
-;; Lambda things
-
-(def-edebug-spec cl-lambda-list
-  (([&rest arg]
-    [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
-    [&optional ["&rest" arg]]
-    [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
-		&optional "&allow-other-keywords"]]
-    [&optional ["&aux" &rest
-		&or (symbolp &optional def-form) symbolp]]
-    )))
-
-(def-edebug-spec cl-&optional-arg
-  (&or (arg &optional def-form arg) arg))
-
-(def-edebug-spec cl-&key-arg
-  (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
-
-;; The lambda list for macros is different from that of normal lambdas.
-;; Note that &environment is only allowed as first or last items in the 
-;; top level list.
-
-(def-edebug-spec cl-macro-list
-  (([&optional "&environment" arg]
-    [&rest cl-macro-arg]
-    [&optional ["&optional" &rest 
-		&or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
-    [&optional [[&or "&rest" "&body"] cl-macro-arg]]
-    [&optional ["&key" [&rest 
-			[&or ([&or (symbolp cl-macro-arg) arg] 
-			      &optional def-form cl-macro-arg)
-			     arg]]
-		&optional "&allow-other-keywords"]]
-    [&optional ["&aux" &rest
-		&or (symbolp &optional def-form) symbolp]]
-    [&optional "&environment" arg]
-    )))
-
-(def-edebug-spec cl-macro-arg
-  (&or arg cl-macro-list1))
-
-(def-edebug-spec cl-macro-list1
-  (([&optional "&whole" arg]  ;; only allowed at lower levels
-    [&rest cl-macro-arg]
-    [&optional ["&optional" &rest 
-		&or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
-    [&optional [[&or "&rest" "&body"] cl-macro-arg]]
-    [&optional ["&key" [&rest 
-			[&or ([&or (symbolp cl-macro-arg) arg] 
-			      &optional def-form cl-macro-arg)
-			     arg]]
-		&optional "&allow-other-keywords"]]
-    [&optional ["&aux" &rest
-		&or (symbolp &optional def-form) symbolp]]
-    . [&or arg nil])))
-
-
-(def-edebug-spec defun*
-  ;; Same as defun but use cl-lambda-list.
-  (&define [&or name
-		("setf" :name setf name)]
-	   cl-lambda-list
-	   cl-declarations-or-string
-	   [&optional ("interactive" interactive)]
-	   def-body))
-(def-edebug-spec defsubst* defun*)
-
-(def-edebug-spec defmacro* 
-  (&define name cl-macro-list cl-declarations-or-string def-body))
-(def-edebug-spec define-compiler-macro defmacro*)
-
-
-(def-edebug-spec function*
-  (&or symbolp cl-lambda-expr))
-
-(def-edebug-spec cl-lambda-expr
-  (&define ("lambda" cl-lambda-list
-	    ;;cl-declarations-or-string
-	    ;;[&optional ("interactive" interactive)]
-	    def-body)))
-
-;; Redefine function-form to also match function*
-(def-edebug-spec function-form
-  ;; form at the end could also handle "function",
-  ;; but recognize it specially to avoid wrapping function forms.
-  (&or ([&or "quote" "function"] &or symbolp lambda-expr) 
-       ("function*" cl-lambda-expr)
-       form))
-
-;;======================================================
-;; Structures
-;; (def-edebug-spec defstruct (&rest sexp)) would be sufficient, but...
-
-;; defstruct may contain forms that are evaluated when a structure is created.
-(def-edebug-spec defstruct
-  (&define  ; makes top-level form not be wrapped
-   [&or symbolp
-	(gate
-	 symbolp &rest 
-		 (&or [":conc-name" &or stringp "nil"]
-		      [":constructor" symbolp &optional cl-lambda-list]
-		      [":copier" symbolp]
-		      [":predicate" symbolp]
-		      [":include" symbolp &rest sexp];; not finished
-		      ;; The following are not supported.
-		      ;; [":print-function" ...]
-		      ;; [":type" ...]
-		      ;; [":initial-offset" ...]
-		      ))]
-   [&optional stringp]
-   ;; All the above is for the following def-form.
-   &rest &or symbolp (symbolp def-form &optional ":read-only" sexp)))
-
-;;======================================================
-;; Loop
-
-;; The loop macro is very complex, and a full spec is found below.
-;; The following spec only minimally specifies that
-;; parenthesized forms are executable, but single variables used as
-;; expressions will be missed.  You may want to use this if the full
-;; spec causes problems for you.
-
-(def-edebug-spec loop
-  (&rest &or symbolp form))
-
-;; Below is a complete spec for loop, in several parts that correspond
-;; to the syntax given in CLtL2.  The specs do more than specify where
-;; the forms are; it also specifies, as much as Edebug allows, all the
-;; syntactically legal loop clauses.  The disadvantage of this
-;; completeness is rigidity, but the "for ... being" clause allows
-;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
-
-(def-edebug-spec loop
-  ([&optional ["named" symbolp]]
-   [&rest 
-    &or
-    ["repeat" form]
-    loop-for-as
-    loop-with
-    loop-initial-final]
-   [&rest loop-clause]
-   ))
-
-(def-edebug-spec loop-with
-  ("with" loop-var
-   loop-type-spec
-   [&optional ["=" form]]
-   &rest ["and" loop-var
-	  loop-type-spec
-	  [&optional ["=" form]]]))
-
-(def-edebug-spec loop-for-as
-  ([&or "for" "as"] loop-for-as-subclause
-   &rest ["and" loop-for-as-subclause]))
-
-(def-edebug-spec loop-for-as-subclause
-  (loop-var 
-   loop-type-spec
-   &or 
-   [[&or "in" "on" "in-ref" "across-ref"]
-    form &optional ["by" function-form]]
-
-   ["=" form &optional ["then" form]]
-   ["across" form]
-   ["being" 
-    [&or "the" "each"]
-    &or 
-    [[&or "element" "elements"] 
-     [&or "of" "in" "of-ref"] form
-     &optional "using" ["index" symbolp]];; is this right?
-    [[&or "hash-key" "hash-keys"
-	  "hash-value" "hash-values"]
-     [&or "of" "in"]
-     hash-table-p &optional ["using" ([&or "hash-value" "hash-values" 
-					   "hash-key" "hash-keys"] sexp)]]
-					
-    [[&or "symbol" "present-symbol" "external-symbol"
-	  "symbols" "present-symbols" "external-symbols"]
-     [&or "in" "of"] package-p]
-     
-    ;; Extensions for Emacs Lisp, including Lucid Emacs.
-    [[&or "frame" "frames"
-	  "screen" "screens"
-	  "buffer" "buffers"]]
-
-    [[&or "window" "windows"] 
-     [&or "of" "in"] form]
-
-    [[&or "overlay" "overlays"
-	  "extent" "extents"]
-     [&or "of" "in"] form
-     &optional [[&or "from" "to"] form]]
-
-    [[&or "interval" "intervals"] 
-     [&or "in" "of"] form
-     &optional [[&or "from" "to"] form]
-     ["property" form]]
-     
-    [[&or "key-code" "key-codes"
-	  "key-seq" "key-seqs"
-	  "key-binding" "key-bindings"] 
-     [&or "in" "of"] form
-     &optional ["using" ([&or "key-code" "key-codes"
-			      "key-seq" "key-seqs"
-			      "key-binding" "key-bindings"] 
-			 sexp)]]
-    ;; For arbitrary extensions, recognize anything else.
-    [symbolp &rest &or symbolp form]
-    ]
-   
-   ;; arithmetic - must be last since all parts are optional.
-   [[&optional [[&or "from" "downfrom" "upfrom"] form]]
-    [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
-    [&optional ["by" form]]
-    ]))
-
-(def-edebug-spec loop-initial-final
-  (&or ["initially" 
-	;; [&optional &or "do" "doing"]  ;; CLtL2 doesn't allow this.
-	&rest loop-non-atomic-expr]
-       ["finally" &or 
-	[[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
-	["return" form]]))
-
-(def-edebug-spec loop-and-clause
-  (loop-clause &rest ["and" loop-clause]))
-
-(def-edebug-spec loop-clause
-  (&or
-   [[&or "while" "until" "always" "never" "thereis"] form]
-     
-   [[&or "collect" "collecting"
-	 "append" "appending"
-	 "nconc" "nconcing"
-	 "concat" "vconcat"] form 
-	 [&optional ["into" loop-var]]]
-
-   [[&or "count" "counting"
-	 "sum" "summing"
-	 "maximize" "maximizing"
-	 "minimize" "minimizing"] form
-	 [&optional ["into" loop-var]]
-	 loop-type-spec]
-
-   [[&or "if" "when" "unless"]
-    form loop-and-clause
-    [&optional ["else" loop-and-clause]]
-    [&optional "end"]]
-
-   [[&or "do" "doing"] &rest loop-non-atomic-expr]
-
-   ["return" form]
-   loop-initial-final
-   ))
-
-(def-edebug-spec loop-non-atomic-expr
-  ([&not atom] form))
-
-(def-edebug-spec loop-var
-  ;; The symbolp must be last alternative to recognize e.g. (a b . c)
-  ;; loop-var => 
-  ;; (loop-var . [&or nil loop-var])
-  ;; (symbolp . [&or nil loop-var])
-  ;; (symbolp . loop-var)
-  ;; (symbolp . (symbolp . [&or nil loop-var]))
-  ;; (symbolp . (symbolp . loop-var))
-  ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
-  (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
-
-(def-edebug-spec loop-type-spec
-  (&optional ["of-type" loop-d-type-spec]))
-
-(def-edebug-spec loop-d-type-spec
-  (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
-
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
deleted file mode 100644
index 29ec602f231..00000000000
--- a/lisp/emacs-lisp/cl.el
+++ /dev/null
@@ -1,765 +0,0 @@
-;;; cl.el --- Common Lisp extensions for Emacs -*-byte-compile-dynamic: t;-*-
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Dave Gillespie <daveg@synaptics.com>
-;; Version: 2.02
-;; 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:
-
-;; These are extensions to Emacs Lisp that provide a degree of
-;; Common Lisp compatibility, beyond what is already built-in
-;; in Emacs Lisp.
-;;
-;; This package was written by Dave Gillespie; it is a complete
-;; rewrite of Cesar Quiroz's original cl.el package of December 1986.
-;;
-;; This package works with Emacs 18, Emacs 19, and Lucid Emacs 19.
-;;
-;; Bug reports, comments, and suggestions are welcome!
-
-;; This file contains the portions of the Common Lisp extensions
-;; package which should always be present.
-
-
-;;; Future notes:
-
-;; Once Emacs 19 becomes standard, many things in this package which are
-;; messy for reasons of compatibility can be greatly simplified.  For now,
-;; I prefer to maintain one unified version.
-
-
-;;; Change Log:
-
-;; Version 2.02 (30 Jul 93):
-;;  * Added "cl-compat.el" file, extra compatibility with old package.
-;;  * Added `lexical-let' and `lexical-let*'.
-;;  * Added `define-modify-macro', `callf', and `callf2'.
-;;  * Added `ignore-errors'.
-;;  * Changed `(setf (nthcdr N PLACE) X)' to work when N is zero.
-;;  * Merged `*gentemp-counter*' into `*gensym-counter*'.
-;;  * Extended `subseq' to allow negative START and END like `substring'.
-;;  * Added `in-ref', `across-ref', `elements of-ref' loop clauses.
-;;  * Added `concat', `vconcat' loop clauses.
-;;  * Cleaned up a number of compiler warnings.
-
-;; Version 2.01 (7 Jul 93):
-;;  * Added support for FSF version of Emacs 19.
-;;  * Added `add-hook' for Emacs 18 users.
-;;  * Added `defsubst*' and `symbol-macrolet'.
-;;  * Added `maplist', `mapc', `mapl', `mapcan', `mapcon'.
-;;  * Added `map', `concatenate', `reduce', `merge'.
-;;  * Added `revappend', `nreconc', `tailp', `tree-equal'.
-;;  * Added `assert', `check-type', `typecase', `typep', and `deftype'.
-;;  * Added destructuring and `&environment' support to `defmacro*'.
-;;  * Added destructuring to `loop', and added the following clauses:
-;;      `elements', `frames', `overlays', `intervals', `buffers', `key-seqs'.
-;;  * Renamed `delete' to `delete*' and `remove' to `remove*'.
-;;  * Completed support for all keywords in `remove*', `substitute', etc.
-;;  * Added `most-positive-float' and company.
-;;  * Fixed hash tables to work with latest Lucid Emacs.
-;;  * `proclaim' forms are no longer compile-time-evaluating; use `declaim'.
-;;  * Syntax for `warn' declarations has changed.
-;;  * Improved implementation of `random*'.
-;;  * Moved most sequence functions to a new file, cl-seq.el.
-;;  * Moved `eval-when' into cl-macs.el.
-;;  * Moved `pushnew' and `adjoin' to cl.el for most common cases.
-;;  * Moved `provide' forms down to ends of files.
-;;  * Changed expansion of `pop' to something that compiles to better code.
-;;  * Changed so that no patch is required for Emacs 19 byte compiler.
-;;  * Made more things dependent on `optimize' declarations.
-;;  * Added a partial implementation of struct print functions.
-;;  * Miscellaneous minor changes.
-
-;; Version 2.00:
-;;  * First public release of this package.
-
-
-;;; Code:
-
-(defvar cl-emacs-type (cond ((or (and (fboundp 'epoch::version)
-				      (symbol-value 'epoch::version))
-				 (string-lessp emacs-version "19")) 18)
-			    ((string-match "Lucid" emacs-version) 'lucid)
-			    (t 19)))
-
-(or (fboundp 'defalias) (fset 'defalias 'fset))
-
-(defvar cl-optimize-speed 1)
-(defvar cl-optimize-safety 1)
-
-
-;;; Keywords used in this package.
-
-(defconst :test ':test)
-(defconst :test-not ':test-not)
-(defconst :key ':key)
-(defconst :start ':start)
-(defconst :start1 ':start1)
-(defconst :start2 ':start2)
-(defconst :end ':end)
-(defconst :end1 ':end1)
-(defconst :end2 ':end2)
-(defconst :count ':count)
-(defconst :initial-value ':initial-value)
-(defconst :size ':size)
-(defconst :from-end ':from-end)
-(defconst :rehash-size ':rehash-size)
-(defconst :rehash-threshold ':rehash-threshold)
-(defconst :allow-other-keys ':allow-other-keys)
-
-
-(defvar custom-print-functions nil
-  "This is a list of functions that format user objects for printing.
-Each function is called in turn with three arguments: the object, the
-stream, and the print level (currently ignored).  If it is able to
-print the object it returns true; otherwise it returns nil and the
-printer proceeds to the next function on the list.
-
-This variable is not used at present, but it is defined in hopes that
-a future Emacs interpreter will be able to use it.")
-
-
-;;; Predicates.
-
-(defun eql (a b)    ; See compiler macro in cl-macs.el
-  "T if the two args are the same Lisp object.
-Floating-point numbers of equal value are `eql', but they may not be `eq'."
-  (if (numberp a)
-      (equal a b)
-    (eq a b)))
-
-
-;;; Generalized variables.  These macros are defined here so that they
-;;; can safely be used in .emacs files.
-
-(defmacro incf (place &optional x)
-  "(incf PLACE [X]): increment PLACE by X (1 by default).
-PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the incremented value of PLACE."
-  (if (symbolp place)
-      (list 'setq place (if x (list '+ place x) (list '1+ place)))
-    (list 'callf '+ place (or x 1))))
-
-(defmacro decf (place &optional x)
-  "(decf PLACE [X]): decrement PLACE by X (1 by default).
-PLACE may be a symbol, or any generalized variable allowed by `setf'.
-The return value is the decremented value of PLACE."
-  (if (symbolp place)
-      (list 'setq place (if x (list '- place x) (list '1- place)))
-    (list 'callf '- place (or x 1))))
-
-(defmacro pop (place)
-  "(pop PLACE): remove and return the head of the list stored in PLACE.
-Analogous to (prog1 (car PLACE) (setf PLACE (cdr PLACE))), though more
-careful about evaluating each argument only once and in the right order.
-PLACE may be a symbol, or any generalized variable allowed by `setf'."
-  (if (symbolp place)
-      (list 'car (list 'prog1 place (list 'setq place (list 'cdr place))))
-    (cl-do-pop place)))
-
-(defmacro push (x place)
-  "(push X PLACE): insert X at the head of the list stored in PLACE.
-Analogous to (setf PLACE (cons X PLACE)), though more careful about
-evaluating each argument only once and in the right order.  PLACE may
-be a symbol, or any generalized variable allowed by `setf'."
-  (if (symbolp place) (list 'setq place (list 'cons x place))
-    (list 'callf2 'cons x place)))
-
-(defmacro pushnew (x place &rest keys)
-  "(pushnew X PLACE): insert X at the head of the list if not already there.
-Like (push X PLACE), except that the list is unmodified if X is `eql' to
-an element already on the list.
-Keywords supported:  :test :test-not :key"
-  (if (symbolp place) (list 'setq place (list* 'adjoin x place keys))
-    (list* 'callf2 'adjoin x place keys)))
-
-(defun cl-set-elt (seq n val)
-  (if (listp seq) (setcar (nthcdr n seq) val) (aset seq n val)))
-
-(defun cl-set-nthcdr (n list x)
-  (if (<= n 0) x (setcdr (nthcdr (1- n) list) x) list))
-
-(defun cl-set-buffer-substring (start end val)
-  (save-excursion (delete-region start end)
-		  (goto-char start)
-		  (insert val)
-		  val))
-
-(defun cl-set-substring (str start end val)
-  (if end (if (< end 0) (incf end (length str)))
-    (setq end (length str)))
-  (if (< start 0) (incf start str))
-  (concat (and (> start 0) (substring str 0 start))
-	  val
-	  (and (< end (length str)) (substring str end))))
-
-
-;;; Control structures.
-
-;;; These macros are so simple and so often-used that it's better to have
-;;; them all the time than to load them from cl-macs.el.
-
-(defmacro when (cond &rest body)
-  "(when COND BODY...): if COND yields non-nil, do BODY, else return nil."
-  (list 'if cond (cons 'progn body)))
-
-(defmacro unless (cond &rest body)
-  "(unless COND BODY...): if COND yields nil, do BODY, else return nil."
-  (cons 'if (cons cond (cons nil body))))
-
-(defun cl-map-extents (&rest cl-args)
-  (if (fboundp 'next-overlay-at) (apply 'cl-map-overlays cl-args)
-    (if (fboundp 'map-extents) (apply 'map-extents cl-args))))
-
-
-;;; Blocks and exits.
-
-(defalias 'cl-block-wrapper 'identity)
-(defalias 'cl-block-throw 'throw)
-
-
-;;; Multiple values.  True multiple values are not supported, or even
-;;; simulated.  Instead, multiple-value-bind and friends simply expect
-;;; the target form to return the values as a list.
-
-(defalias 'values 'list)
-(defalias 'values-list 'identity)
-(defalias 'multiple-value-list 'identity)
-(defalias 'multiple-value-call 'apply)  ; only works for one arg
-(defalias 'nth-value 'nth)
-
-
-;;; Macros.
-
-(defvar cl-macro-environment nil)
-(defvar cl-old-macroexpand (prog1 (symbol-function 'macroexpand)
-			     (defalias 'macroexpand 'cl-macroexpand)))
-
-(defun cl-macroexpand (cl-macro &optional cl-env)
-  "Return result of expanding macros at top level of FORM.
-If FORM is not a macro call, it is returned unchanged.
-Otherwise, the macro is expanded and the expansion is considered
-in place of FORM.  When a non-macro-call results, it is returned.
-
-The second optional arg ENVIRONMENT species an environment of macro
-definitions to shadow the loaded ones for use in file byte-compilation."
-  (let ((cl-macro-environment cl-env))
-    (while (progn (setq cl-macro (funcall cl-old-macroexpand cl-macro cl-env))
-		  (and (symbolp cl-macro)
-		       (cdr (assq (symbol-name cl-macro) cl-env))))
-      (setq cl-macro (cadr (assq (symbol-name cl-macro) cl-env))))
-    cl-macro))
-
-
-;;; Declarations.
-
-(defvar cl-compiling-file nil)
-(defun cl-compiling-file ()
-  (or cl-compiling-file
-      (and (boundp 'outbuffer) (bufferp (symbol-value 'outbuffer))
-	   (equal (buffer-name (symbol-value 'outbuffer))
-		  " *Compiler Output*"))))
-
-(defvar cl-proclaims-deferred nil)
-
-(defun proclaim (spec)
-  (if (fboundp 'cl-do-proclaim) (cl-do-proclaim spec t)
-    (push spec cl-proclaims-deferred))
-  nil)
-
-(defmacro declaim (&rest specs)
-  (let ((body (mapcar (function (lambda (x) (list 'proclaim (list 'quote x))))
-		      specs)))
-    (if (cl-compiling-file) (list* 'eval-when '(compile load eval) body)
-      (cons 'progn body))))   ; avoid loading cl-macs.el for eval-when
-
-
-;;; Symbols.
-
-(defun cl-random-time ()
-  (let* ((time (copy-sequence (current-time-string))) (i (length time)) (v 0))
-    (while (>= (decf i) 0) (setq v (+ (* v 3) (aref time i))))
-    v))
-
-(defvar *gensym-counter* (* (logand (cl-random-time) 1023) 100))
-
-
-;;; Numbers.
-
-(defun floatp-safe (x)
-  "T if OBJECT is a floating point number.
-On Emacs versions that lack floating-point support, this function
-always returns nil."
-  (and (numberp x) (not (integerp x))))
-
-(defun plusp (x)
-  "T if NUMBER is positive."
-  (> x 0))
-
-(defun minusp (x)
-  "T if NUMBER is negative."
-  (< x 0))
-
-(defun oddp (x)
-  "T if INTEGER is odd."
-  (eq (logand x 1) 1))
-
-(defun evenp (x)
-  "T if INTEGER is even."
-  (eq (logand x 1) 0))
-
-(defun cl-abs (x)
-  "Return the absolute value of ARG."
-  (if (>= x 0) x (- x)))
-(or (fboundp 'abs) (defalias 'abs 'cl-abs))   ; This is built-in to Emacs 19
-
-(defvar *random-state* (vector 'cl-random-state-tag -1 30 (cl-random-time)))
-
-;;; We use `eval' in case VALBITS differs from compile-time to load-time.
-(defconst most-positive-fixnum (eval '(lsh -1 -1)))
-(defconst most-negative-fixnum (eval '(- -1 (lsh -1 -1))))
-
-;;; The following are actually set by cl-float-limits.
-(defconst most-positive-float nil)
-(defconst most-negative-float nil)
-(defconst least-positive-float nil)
-(defconst least-negative-float nil)
-(defconst least-positive-normalized-float nil)
-(defconst least-negative-normalized-float nil)
-(defconst float-epsilon nil)
-(defconst float-negative-epsilon nil)
-
-
-;;; Sequence functions.
-
-(defalias 'copy-seq 'copy-sequence)
-
-(defun mapcar* (cl-func cl-x &rest cl-rest)
-  "Apply FUNCTION to each element of SEQ, and make a list of the results.
-If there are several SEQs, FUNCTION is called with that many arguments,
-and mapping stops as soon as the shortest list runs out.  With just one
-SEQ, this is like `mapcar'.  With several, it is like the Common Lisp
-`mapcar' function extended to arbitrary sequence types."
-  (if cl-rest
-      (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest)))
-	  (cl-mapcar-many cl-func (cons cl-x cl-rest))
-	(let ((cl-res nil) (cl-y (car cl-rest)))
-	  (while (and cl-x cl-y)
-	    (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res))
-	  (nreverse cl-res)))
-    (mapcar cl-func cl-x)))
-
-
-;;; List functions.
-
-(defalias 'first 'car)
-(defalias 'rest 'cdr)
-(defalias 'endp 'null)
-
-(defun second (x)
-  "Return the second element of the list LIST."
-  (car (cdr x)))
-
-(defun third (x)
-  "Return the third element of the list LIST."
-  (car (cdr (cdr x))))
-
-(defun fourth (x)
-  "Return the fourth element of the list LIST."
-  (nth 3 x))
-
-(defun fifth (x)
-  "Return the fifth element of the list LIST."
-  (nth 4 x))
-
-(defun sixth (x)
-  "Return the sixth element of the list LIST."
-  (nth 5 x))
-
-(defun seventh (x)
-  "Return the seventh element of the list LIST."
-  (nth 6 x))
-
-(defun eighth (x)
-  "Return the eighth element of the list LIST."
-  (nth 7 x))
-
-(defun ninth (x)
-  "Return the ninth element of the list LIST."
-  (nth 8 x))
-
-(defun tenth (x)
-  "Return the tenth element of the list LIST."
-  (nth 9 x))
-
-(defun caar (x)
-  "Return the `car' of the `car' of X."
-  (car (car x)))
-
-(defun cadr (x)
-  "Return the `car' of the `cdr' of X."
-  (car (cdr x)))
-
-(defun cdar (x)
-  "Return the `cdr' of the `car' of X."
-  (cdr (car x)))
-
-(defun cddr (x)
-  "Return the `cdr' of the `cdr' of X."
-  (cdr (cdr x)))
-
-(defun caaar (x)
-  "Return the `car' of the `car' of the `car' of X."
-  (car (car (car x))))
-
-(defun caadr (x)
-  "Return the `car' of the `car' of the `cdr' of X."
-  (car (car (cdr x))))
-
-(defun cadar (x)
-  "Return the `car' of the `cdr' of the `car' of X."
-  (car (cdr (car x))))
-
-(defun caddr (x)
-  "Return the `car' of the `cdr' of the `cdr' of X."
-  (car (cdr (cdr x))))
-
-(defun cdaar (x)
-  "Return the `cdr' of the `car' of the `car' of X."
-  (cdr (car (car x))))
-
-(defun cdadr (x)
-  "Return the `cdr' of the `car' of the `cdr' of X."
-  (cdr (car (cdr x))))
-
-(defun cddar (x)
-  "Return the `cdr' of the `cdr' of the `car' of X."
-  (cdr (cdr (car x))))
-
-(defun cdddr (x)
-  "Return the `cdr' of the `cdr' of the `cdr' of X."
-  (cdr (cdr (cdr x))))
-
-(defun caaaar (x)
-  "Return the `car' of the `car' of the `car' of the `car' of X."
-  (car (car (car (car x)))))
-
-(defun caaadr (x)
-  "Return the `car' of the `car' of the `car' of the `cdr' of X."
-  (car (car (car (cdr x)))))
-
-(defun caadar (x)
-  "Return the `car' of the `car' of the `cdr' of the `car' of X."
-  (car (car (cdr (car x)))))
-
-(defun caaddr (x)
-  "Return the `car' of the `car' of the `cdr' of the `cdr' of X."
-  (car (car (cdr (cdr x)))))
-
-(defun cadaar (x)
-  "Return the `car' of the `cdr' of the `car' of the `car' of X."
-  (car (cdr (car (car x)))))
-
-(defun cadadr (x)
-  "Return the `car' of the `cdr' of the `car' of the `cdr' of X."
-  (car (cdr (car (cdr x)))))
-
-(defun caddar (x)
-  "Return the `car' of the `cdr' of the `cdr' of the `car' of X."
-  (car (cdr (cdr (car x)))))
-
-(defun cadddr (x)
-  "Return the `car' of the `cdr' of the `cdr' of the `cdr' of X."
-  (car (cdr (cdr (cdr x)))))
-
-(defun cdaaar (x)
-  "Return the `cdr' of the `car' of the `car' of the `car' of X."
-  (cdr (car (car (car x)))))
-
-(defun cdaadr (x)
-  "Return the `cdr' of the `car' of the `car' of the `cdr' of X."
-  (cdr (car (car (cdr x)))))
-
-(defun cdadar (x)
-  "Return the `cdr' of the `car' of the `cdr' of the `car' of X."
-  (cdr (car (cdr (car x)))))
-
-(defun cdaddr (x)
-  "Return the `cdr' of the `car' of the `cdr' of the `cdr' of X."
-  (cdr (car (cdr (cdr x)))))
-
-(defun cddaar (x)
-  "Return the `cdr' of the `cdr' of the `car' of the `car' of X."
-  (cdr (cdr (car (car x)))))
-
-(defun cddadr (x)
-  "Return the `cdr' of the `cdr' of the `car' of the `cdr' of X."
-  (cdr (cdr (car (cdr x)))))
-
-(defun cdddar (x)
-  "Return the `cdr' of the `cdr' of the `cdr' of the `car' of X."
-  (cdr (cdr (cdr (car x)))))
-
-(defun cddddr (x)
-  "Return the `cdr' of the `cdr' of the `cdr' of the `cdr' of X."
-  (cdr (cdr (cdr (cdr x)))))
-
-(defun last (x &optional n)
-  "Returns the last link in the list LIST.
-With optional argument N, returns Nth-to-last link (default 1)."
-  (if n
-      (let ((m 0) (p x))
-	(while (consp p) (incf m) (pop p))
-	(if (<= n 0) p
-	  (if (< n m) (nthcdr (- m n) x) x)))
-    (while (consp (cdr x)) (pop x))
-    x))
-
-(defun butlast (x &optional n)
-  "Returns a copy of LIST with the last N elements removed."
-  (if (and n (<= n 0)) x
-    (nbutlast (copy-sequence x) n)))
-
-(defun nbutlast (x &optional n)
-  "Modifies LIST to remove the last N elements."
-  (let ((m (length x)))
-    (or n (setq n 1))
-    (and (< n m)
-	 (progn
-	   (if (> n 0) (setcdr (nthcdr (- (1- m) n) x) nil))
-	   x))))
-
-(defun list* (arg &rest rest)   ; See compiler macro in cl-macs.el
-  "Return a new list with specified args as elements, cons'd to last arg.
-Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to
-`(cons A (cons B (cons C D)))'."
-  (cond ((not rest) arg)
-	((not (cdr rest)) (cons arg (car rest)))
-	(t (let* ((n (length rest))
-		  (copy (copy-sequence rest))
-		  (last (nthcdr (- n 2) copy)))
-	     (setcdr last (car (cdr last)))
-	     (cons arg copy)))))
-
-(defun ldiff (list sublist)
-  "Return a copy of LIST with the tail SUBLIST removed."
-  (let ((res nil))
-    (while (and (consp list) (not (eq list sublist)))
-      (push (pop list) res))
-    (nreverse res)))
-
-(defun copy-list (list)
-  "Return a copy of a list, which may be a dotted list.
-The elements of the list are not copied, just the list structure itself."
-  (if (consp list)
-      (let ((res nil))
-	(while (consp list) (push (pop list) res))
-	(prog1 (nreverse res) (setcdr res list)))
-    (car list)))
-
-(defun cl-maclisp-member (item list)
-  (while (and list (not (equal item (car list)))) (setq list (cdr list)))
-  list)
-
-;;; Define an Emacs 19-compatible `member' for the benefit of Emacs 18 users.
-(or (and (fboundp 'member) (subrp (symbol-function 'member)))
-    (defalias 'member 'cl-maclisp-member))
-
-(defalias 'cl-member 'memq)   ; for compatibility with old CL package
-(defalias 'cl-floor 'floor*)
-(defalias 'cl-ceiling 'ceiling*)
-(defalias 'cl-truncate 'truncate*)
-(defalias 'cl-round 'round*)
-(defalias 'cl-mod 'mod*)
-
-(defun adjoin (cl-item cl-list &rest cl-keys)  ; See compiler macro in cl-macs
-  "Return ITEM consed onto the front of LIST only if it's not already there.
-Otherwise, return LIST unmodified.
-Keywords supported:  :test :test-not :key"
-  (cond ((or (equal cl-keys '(:test eq))
-	     (and (null cl-keys) (not (numberp cl-item))))
-	 (if (memq cl-item cl-list) cl-list (cons cl-item cl-list)))
-	((or (equal cl-keys '(:test equal)) (null cl-keys))
-	 (if (member cl-item cl-list) cl-list (cons cl-item cl-list)))
-	(t (apply 'cl-adjoin cl-item cl-list cl-keys))))
-
-(defun subst (cl-new cl-old cl-tree &rest cl-keys)
-  "Substitute NEW for OLD everywhere in TREE (non-destructively).
-Return a copy of TREE with all elements `eql' to OLD replaced by NEW.
-Keywords supported:  :test :test-not :key"
-  (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old))))
-      (apply 'sublis (list (cons cl-old cl-new)) cl-tree cl-keys)
-    (cl-do-subst cl-new cl-old cl-tree)))
-
-(defun cl-do-subst (cl-new cl-old cl-tree)
-  (cond ((eq cl-tree cl-old) cl-new)
-	((consp cl-tree)
-	 (let ((a (cl-do-subst cl-new cl-old (car cl-tree)))
-	       (d (cl-do-subst cl-new cl-old (cdr cl-tree))))
-	   (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree)))
-	       cl-tree (cons a d))))
-	(t cl-tree)))
-
-(defun acons (a b c) (cons (cons a b) c))
-(defun pairlis (a b &optional c) (nconc (mapcar* 'cons a b) c))
-
-
-;;; Miscellaneous.
-
-(put 'cl-assertion-failed 'error-conditions '(error))
-(put 'cl-assertion-failed 'error-message "Assertion failed")
-
-;;; This is defined in Emacs 19; define it here for Emacs 18 users.
-(defun cl-add-hook (hook func &optional append)
-  "Add to hook variable HOOK the function FUNC.
-FUNC is not added if it already appears on the list stored in HOOK."
-  (let ((old (and (boundp hook) (symbol-value hook))))
-    (and (listp old) (not (eq (car old) 'lambda))
-	 (setq old (list old)))
-    (and (not (member func old))
-	 (set hook (if append (nconc old (list func)) (cons func old))))))
-(or (fboundp 'add-hook) (defalias 'add-hook 'cl-add-hook))
-
-
-;;; Autoload the other portions of the package.
-(mapcar (function
-	 (lambda (set)
-	   (mapcar (function
-		    (lambda (func)
-		      (autoload func (car set) nil nil (nth 1 set))))
-		   (cddr set))))
-	'(("cl-extra" nil
-	   coerce equalp cl-map-keymap maplist mapc mapl mapcan mapcon
-	   cl-map-keymap cl-map-keymap-recursively cl-map-intervals
-	   cl-map-overlays cl-set-frame-visible-p cl-float-limits
-	   gcd lcm isqrt expt floor* ceiling* truncate* round*
-	   mod* rem* signum random* make-random-state random-state-p
-	   subseq concatenate cl-mapcar-many map some every notany
-	   notevery revappend nreconc list-length tailp copy-tree get* getf
-	   cl-set-getf cl-do-remf remprop make-hash-table cl-hash-lookup
-	   gethash cl-puthash remhash clrhash maphash hash-table-p
-	   hash-table-count cl-progv-before cl-prettyexpand
-	   cl-macroexpand-all)
-	  ("cl-seq" nil
-	   reduce fill replace remq remove remove* remove-if remove-if-not
-	   delete delete* delete-if delete-if-not remove-duplicates
-	   delete-duplicates substitute substitute-if substitute-if-not
-	   nsubstitute nsubstitute-if nsubstitute-if-not find find-if
-	   find-if-not position position-if position-if-not count count-if
-	   count-if-not mismatch search sort* stable-sort merge member*
-	   member-if member-if-not cl-adjoin assoc* assoc-if assoc-if-not
-	   rassoc* rassoc rassoc-if rassoc-if-not union nunion intersection
-	   nintersection set-difference nset-difference set-exclusive-or
-	   nset-exclusive-or subsetp subst-if subst-if-not nsubst nsubst-if
-	   nsubst-if-not sublis nsublis tree-equal)
-	  ("cl-macs" nil
-	   gensym gentemp typep cl-do-pop get-setf-method
-	   cl-struct-setf-expander compiler-macroexpand cl-compile-time-init)
-	  ("cl-macs" t
-	   defun* defmacro* function* destructuring-bind eval-when
-	   eval-when-compile load-time-value case ecase typecase etypecase
-	   block return return-from loop do do* dolist dotimes do-symbols
-	   do-all-symbols psetq progv flet labels macrolet symbol-macrolet
-	   lexical-let lexical-let* multiple-value-bind multiple-value-setq
-	   locally the declare define-setf-method defsetf define-modify-macro
-	   setf psetf remf shiftf rotatef letf letf* callf callf2 defstruct
-	   check-type assert ignore-errors define-compiler-macro)))
-
-;;; Define data for indentation and edebug.
-(mapcar (function
-	 (lambda (entry)
-	   (mapcar (function
-		    (lambda (func)
-		      (put func 'lisp-indent-function (nth 1 entry))
-		      (put func 'lisp-indent-hook (nth 1 entry))
-		      (or (get func 'edebug-form-spec)
-			  (put func 'edebug-form-spec (nth 2 entry)))))
-		   (car entry))))
-	'(((defun* defmacro*) 2)
-	  ((function*) nil
-	   (&or symbolp ([&optional 'macro] 'lambda (&rest sexp) &rest form)))
-	  ((eval-when) 1 (sexp &rest form))
-	  ((when unless) 1 (&rest form))
-	  ((declare) nil (&rest sexp))
-	  ((the) 1 (sexp &rest form))
-	  ((case ecase typecase etypecase) 1 (form &rest (sexp &rest form)))
-	  ((block return-from) 1 (sexp &rest form))
-	  ((return) nil (&optional form))
-	  ((do do*) 2 ((&rest &or symbolp (symbolp &optional form form))
-		       (form &rest form)
-		       &rest form))
-	  ((dolist dotimes) 1 ((symbolp form &rest form) &rest form))
-	  ((do-symbols) 1 ((symbolp form &optional form form) &rest form))
-	  ((do-all-symbols) 1 ((symbolp form &optional form) &rest form))
-	  ((psetq setf psetf) nil edebug-setq-form)
-	  ((progv) 2 (&rest form))
-	  ((flet labels macrolet) 1
-	   ((&rest (sexp sexp &rest form)) &rest form))
-	  ((symbol-macrolet lexical-let lexical-let*) 1
-	   ((&rest &or symbolp (symbolp form)) &rest form))
-	  ((multiple-value-bind) 2 ((&rest symbolp) &rest form))
-	  ((multiple-value-setq) 1 ((&rest symbolp) &rest form))
-	  ((incf decf remf pop push pushnew shiftf rotatef) nil (&rest form))
-	  ((letf letf*) 1 ((&rest (&rest form)) &rest form))
-	  ((callf destructuring-bind) 2 (sexp form &rest form))
-	  ((callf2) 3 (sexp form form &rest form))
-	  ((loop) nil (&rest &or symbolp form))
-	  ((ignore-errors) 0 (&rest form))))
-
-
-;;; This goes here so that cl-macs can find it if it loads right now.
-(provide 'cl-19)     ; usage: (require 'cl-19 "cl")
-
-
-;;; Things to do after byte-compiler is loaded.
-;;; As a side effect, we cause cl-macs to be loaded when compiling, so
-;;; that the compiler-macros defined there will be present.
-
-(defvar cl-hacked-flag nil)
-(defun cl-hack-byte-compiler ()
-  (if (and (not cl-hacked-flag) (fboundp 'byte-compile-file-form))
-      (progn
-	(cl-compile-time-init)   ; in cl-macs.el
-	(setq cl-hacked-flag t))))
-
-;;; Try it now in case the compiler has already been loaded.
-(cl-hack-byte-compiler)
-
-;;; Also make a hook in case compiler is loaded after this file.
-;;; The compiler doesn't call any hooks when it loads or runs, but
-;;; we can take advantage of the fact that emacs-lisp-mode will be
-;;; called when the compiler reads in the file to be compiled.
-;;; BUG: If the first compilation is `byte-compile' rather than
-;;; `byte-compile-file', we lose.  Oh, well.
-(add-hook 'emacs-lisp-mode-hook 'cl-hack-byte-compiler)
-
-
-;;; The following ensures that packages which expect the old-style cl.el
-;;; will be happy with this one.
-
-(provide 'cl)
-
-(provide 'mini-cl)   ; for Epoch
-
-(run-hooks 'cl-load-hook)
-
-;;; cl.el ends here
diff --git a/lisp/emacs-lisp/copyright.el b/lisp/emacs-lisp/copyright.el
deleted file mode 100644
index f8ba8c04404..00000000000
--- a/lisp/emacs-lisp/copyright.el
+++ /dev/null
@@ -1,143 +0,0 @@
-;;; copyright.el --- update the copyright notice in current buffer
-
-;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
-;; Keywords: maint, 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:
-
-;; Allows updating the copyright year and above mentioned GPL version manually
-;; or when saving a file.  Do (add-hook 'write-file-hooks 'copyright-update).
-
-;;; Code:
-
-(defvar copyright-limit 2000
-  "*Don't try to update copyright beyond this position unless interactive.
-`nil' means to search whole buffer.")
-
-
-(defvar copyright-regexp
-  "\\(\251\\|[Cc]opyright\\s *:?\\s *(C)\\)\\s *\\([1-9][-0-9, ']*[0-9]+\\) "
-  "*What your copyright notice looks like.
-The second \\( \\) construct must match the years.")
-
-
-(defvar copyright-query 'function
-  "*If non-`nil', ask user before changing copyright.
-When this is `function', only ask when called non-interactively.")
-
-
-(defconst copyright-current-year (substring (current-time-string) -4)
-  "String representing the current year.")
-
-
-;; when modifying this, also modify the comment generated by autoinsert.el
-(defconst copyright-current-gpl-version "2"
-  "String representing the current version of the GPL or `nil'.")
-
-(defvar copyright-update t)
-
-;;;###autoload
-(defun copyright-update (&optional arg)
-  "Update the copyright notice at the beginning of the buffer to indicate
-the current year.  If optional prefix ARG is given replace the years in the
-notice rather than adding the current year after them.  If necessary and
-`copyright-current-gpl-version' is set, the copying permissions following the
-copyright, if any, are updated as well."
-  (interactive "*P")
-  (if copyright-update
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (goto-char (point-min))
-	  (if (re-search-forward copyright-regexp copyright-limit t)
-	      (if (string= (buffer-substring (- (match-end 2) 2) (match-end 2))
-			   (substring copyright-current-year -2))
-		  ()
-		(backward-char 1)
-		(if (or (not copyright-query)
-			(and (eq copyright-query 'function)
-			     (eq this-command 'copyright-update))
-			(y-or-n-p (if arg
-				      (concat "Replace copyright year(s) by "
-					      copyright-current-year "? ")
-				    (concat "Add " copyright-current-year
-					    " to copyright? ")))) 
-		    (if arg
-			(progn
-			  (delete-region (match-beginning 1) (match-end 1))
-			  (insert copyright-current-year))
-		      (setq arg (save-excursion (skip-chars-backward "0-9")))
-		      (if (and (eq (% (- (string-to-number
-					  copyright-current-year)
-					 (string-to-number (buffer-substring
-							    (+ (point) arg)
-							    (point))))
-				      100)
-				   1)
-			       (or (eq (char-after (+ (point) arg -1)) ?-)
-				   (eq (char-after (+ (point) arg -2)) ?-)))
-			  (delete-char arg)
-			(insert ", ")
-			(if (eq (char-after (+ (point) arg -3)) ?')
-			    (insert ?')))
-		      (insert (substring copyright-current-year arg))))))
-	  (goto-char (point-min))
-	  (and copyright-current-gpl-version
-	       ;; match the GPL version comment in .el files, including the
-	       ;; bilingual Esperanto one in two-column, and in texinfo.tex
-	       (re-search-forward "\\(the Free Software Foundation; either \\|; a\\^u eldono \\([0-9]+\\)a, ? a\\^u (la\\^u via	 \\)version \\([0-9]+\\), or (at"
-				  copyright-limit t)
-	       (not (string= (buffer-substring (match-beginning 3) (match-end 3))
-			     copyright-current-gpl-version))
-	       (or (not copyright-query)
-		   (and (eq copyright-query 'function)
-			(eq this-command 'copyright-update))
-		   (y-or-n-p (concat "Replace GPL version by "
-				     copyright-current-gpl-version "? ")))
-	       (progn
-		 (if (match-end 2)
-		     ;; Esperanto bilingual comment in two-column.el
-		     (progn
-		       (delete-region (match-beginning 2) (match-end 2))
-		       (goto-char (match-beginning 2))
-		       (insert copyright-current-gpl-version)))
-		 (delete-region (match-beginning 3) (match-end 3))
-		 (goto-char (match-beginning 3))
-		 (insert copyright-current-gpl-version))))
-	(set (make-local-variable 'copyright-update) nil)))
-  ;; If a write-file-hook returns non-nil, the file is presumed to be written.
-  nil)
-
-
-;;;###autoload
-(define-skeleton copyright
-  "Insert a copyright by $ORGANIZATION notice at cursor."
-  "Company: "
-  comment-start
-  "Copyright (C) " copyright-current-year " by "
-  (or (getenv "ORGANIZATION")
-      str)
-  '(if (> (point) copyright-limit)
-       (message "Copyright extends beyond `copyright-limit' and won't be updated automatically."))
-  comment-end)
-
-;; copyright.el ends here
diff --git a/lisp/emacs-lisp/cust-print.el b/lisp/emacs-lisp/cust-print.el
deleted file mode 100644
index 0c80b6c8bdb..00000000000
--- a/lisp/emacs-lisp/cust-print.el
+++ /dev/null
@@ -1,725 +0,0 @@
-;;; cust-print.el --- handles print-level and print-circle.
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
-;; Adapted-By: ESR
-;; Keywords: extensions
-
-;; LCD Archive Entry:
-;; cust-print|Daniel LaLiberte|liberte@cs.uiuc.edu
-;; |Handle print-level, print-circle and more.
-;; |$Date: 1994/04/05 21:05:09 $|$Revision: 1.14 $|
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; ===============================
-;;; $Header:  $
-;;; $Log: cust-print.el,v $
-;;; Revision 1.14  1994/04/05  21:05:09  liberte
-;;; Change install- and uninstall- to -install and -uninstall.
-;;;
-;;; Revision 1.13  1994/03/24  20:26:05  liberte
-;;; Change "internal" to "original" throughout.
-;;;         (add-custom-printer, delete-custom-printer) replace customizers.
-;;;         (with-custom-print) new
-;;;         (custom-prin1-to-string) Made it more robust.
-;;;
-;;; Revision 1.4  1994/03/23  20:34:29  liberte
-;;; * Change "emacs" to "original" - I just can't decide. 
-;;;
-;;; Revision 1.3  1994/02/21  21:25:36  liberte
-;;; * Make custom-prin1-to-string more robust when errors occur.
-;;; * Change "internal" to "emacs".
-;;;
-;;; Revision 1.2  1993/11/22  22:36:36  liberte
-;;; * Simplified and generalized printer customization.
-;;;     custom-printers is an alist of (PREDICATE . PRINTER) pairs
-;;;     for any data types.  The PRINTER function should print to
-;;;     `standard-output'  add-custom-printer and delete-custom-printer
-;;;     change custom-printers.
-;;;
-;;; * Installation function now called install-custom-print.  The
-;;;     old name is still around for now.
-;;;
-;;; * New macro with-custom-print (added earlier) - executes like
-;;;     progn but with custom-print activated temporarily.
-;;;
-;;; * Cleaned up comments for replacements of standardard printers.
-;;;
-;;; * Changed custom-prin1-to-string to use a temporary buffer.
-;;;
-;;; * Option custom-print-vectors (added earlier) - controls whether
-;;;     vectors should be printed according to print-length and
-;;;     print-length.  Emacs doesnt do this, but cust-print would
-;;;     otherwise do it only if custom printing is required.
-;;;
-;;; * Uninterned symbols are treated as non-read-equivalent.
-;;;
-
-
-;;; Commentary:
-
-;; This package provides a general print handler for prin1 and princ
-;; that supports print-level and print-circle, and by the way,
-;; print-length since the standard routines are being replaced.  Also,
-;; to print custom types constructed from lists and vectors, use
-;; custom-print-list and custom-print-vector.  See the documentation
-;; strings of these variables for more details.  
-
-;; If the results of your expressions contain circular references to
-;; other parts of the same structure, the standard Emacs print
-;; subroutines may fail to print with an untrappable error,
-;; "Apparently circular structure being printed".  If you only use cdr
-;; circular lists (where cdrs of lists point back; what is the right
-;; term here?), you can limit the length of printing with
-;; print-length.  But car circular lists and circular vectors generate
-;; the above mentioned error in Emacs version 18.  Version
-;; 19 supports print-level, but it is often useful to get a better
-;; print representation of circular and shared structures; the print-circle
-;; option may be used to print more concise representations.
-
-;; There are three main ways to use this package.  First, you may
-;; replace prin1, princ, and some subroutines that use them by calling
-;; install-custom-print so that any use of these functions in
-;; Lisp code will be affected; you can later reset with
-;; uninstall-custom-print.  Second, you may temporarily install
-;; these functions with the macro with-custom-print.  Third, you
-;; could call the custom routines directly, thus only affecting the
-;; printing that requires them.
-
-;; Note that subroutines which call print subroutines directly will
-;; not use the custom print functions.  In particular, the evaluation
-;; functions like eval-region call the print subroutines directly.
-;; Therefore, if you evaluate (aref circ-list 0), where circ-list is a
-;; circular list rather than an array, aref calls error directly which
-;; will jump to the top level instead of printing the circular list.
-
-;; Uninterned symbols are recognized when print-circle is non-nil,
-;; but they are not printed specially here.  Use the cl-packages package
-;; to print according to print-gensym.
-
-;; Obviously the right way to implement this custom-print facility is
-;; in C or with hooks into the standard printer.  Please volunteer
-;; since I don't have the time or need.  More CL-like printing
-;; capabilities could be added in the future.
-
-;; Implementation design: we want to use the same list and vector
-;; processing algorithm for all versions of prin1 and princ, since how
-;; the processing is done depends on print-length, print-level, and
-;; print-circle.  For circle printing, a preprocessing step is
-;; required before the final printing.  Thanks to Jamie Zawinski
-;; for motivation and algorithms.
-
-
-;;; Code:
-;;=========================================================
-
-;; If using cl-packages:
-
-'(defpackage "cust-print"
-   (:nicknames "CP" "custom-print")
-   (:use "el")
-   (:export
-    print-level
-    print-circle
-
-    custom-print-install
-    custom-print-uninstall
-    custom-print-installed-p
-    with-custom-print
-
-    custom-prin1
-    custom-princ
-    custom-prin1-to-string
-    custom-print
-    custom-format
-    custom-message
-    custom-error
-
-    custom-printers
-    add-custom-printer
-    ))
-
-'(in-package cust-print)
-
-(require 'backquote)
-
-;; Emacs 18 doesnt have defalias.
-;; Provide def for byte compiler.
-(eval-and-compile
-  (or (fboundp 'defalias) (fset 'defalias 'fset)))
-
-
-;; Variables:
-;;=========================================================
-
-;;(defvar print-length nil
-;;  "*Controls how many elements of a list, at each level, are printed.
-;;This is defined by emacs.")
-
-(defvar print-level nil
-  "*Controls how many levels deep a nested data object will print.  
-
-If nil, printing proceeds recursively and may lead to
-max-lisp-eval-depth being exceeded or an error may occur:
-`Apparently circular structure being printed.'
-Also see `print-length' and `print-circle'.
-
-If non-nil, components at levels equal to or greater than `print-level'
-are printed simply as `#'.  The object to be printed is at level 0,
-and if the object is a list or vector, its top-level components are at
-level 1.")
-
-
-(defvar print-circle nil
-  "*Controls the printing of recursive structures.  
-
-If nil, printing proceeds recursively and may lead to
-`max-lisp-eval-depth' being exceeded or an error may occur:
-\"Apparently circular structure being printed.\"  Also see
-`print-length' and `print-level'.
-
-If non-nil, shared substructures anywhere in the structure are printed
-with `#N=' before the first occurrence (in the order of the print
-representation) and `#N#' in place of each subsequent occurrence,
-where N is a positive decimal integer.
-
-There is no way to read this representation in standard Emacs,
-but if you need to do so, try the cl-read.el package.")
-
-
-(defvar custom-print-vectors nil
-  "*Non-nil if printing of vectors should obey print-level and print-length.
-
-For Emacs 18, setting print-level, or adding custom print list or
-vector handling will make this happen anyway.  Emacs 19 obeys
-print-level, but not for vectors.")
-
-
-;; Custom printers
-;;==========================================================
-
-(defconst custom-printers nil
-  ;; e.g. '((symbolp . pkg::print-symbol))
-  "An alist for custom printing of any type.
-Pairs are of the form (PREDICATE . PRINTER).  If PREDICATE is true
-for an object, then PRINTER is called with the object.
-PRINTER should print to `standard-output' using cust-print-original-princ
-if the standard printer is sufficient, or cust-print-prin for complex things.
-The PRINTER should return the object being printed.
-
-Don't modify this variable directly.  Use `add-custom-printer' and
-`delete-custom-printer'")
-;; Should cust-print-original-princ and cust-print-prin be exported symbols?
-;; Or should the standard printers functions be replaced by
-;; CP ones in elisp so that CP internal functions need not be called?
-
-(defun add-custom-printer (pred printer)
-  "Add a pair of PREDICATE and PRINTER to `custom-printers'.
-Any pair that has the same PREDICATE is first removed."
-  (setq custom-printers (cons (cons pred printer) 
-			      (delq (assq pred custom-printers)
-				    custom-printers)))
-  ;; Rather than updating here, we could wait until cust-print-top-level is called.
-  (cust-print-update-custom-printers))
-
-(defun delete-custom-printer (pred)
-  "Delete the custom printer associated with PREDICATE."
-  (setq custom-printers (delq (assq pred custom-printers)
-			      custom-printers))
-  (cust-print-update-custom-printers))
-
-
-(defun cust-print-use-custom-printer (object)
-  ;; Default function returns nil.
-  nil)
-
-(defun cust-print-update-custom-printers ()
-  ;; Modify the definition of cust-print-use-custom-printer
-  (defalias 'cust-print-use-custom-printer
-    ;; We dont really want to require the byte-compiler.
-    ;; (byte-compile
-     (` (lambda (object)
-	  (cond
-	   (,@ (mapcar (function 
-			(lambda (pair)
-			  (` (((, (car pair)) object) 
-			      ((, (cdr pair)) object)))))
-		       custom-printers))
-	   ;; Otherwise return nil.
-	   (t nil)
-	   )))
-     ;; )
-  ))
-
-
-;; Saving and restoring emacs printing routines.
-;;====================================================
-
-(defun cust-print-set-function-cell (symbol-pair)
-  (defalias (car symbol-pair) 
-    (symbol-function (car (cdr symbol-pair)))))
-
-(defun cust-print-original-princ (object &optional stream)) ; dummy def
-
-;; Save emacs routines.
-(if (not (fboundp 'cust-print-original-prin1))
-    (mapcar 'cust-print-set-function-cell
-	    '((cust-print-original-prin1 prin1)
-	      (cust-print-original-princ princ)
-	      (cust-print-original-print print)
-	      (cust-print-original-prin1-to-string prin1-to-string)
-	      (cust-print-original-format format)
-	      (cust-print-original-message message)
-	      (cust-print-original-error error))))
-
-
-(defun custom-print-install ()
-  "Replace print functions with general, customizable, Lisp versions.
-The emacs subroutines are saved away, and you can reinstall them
-by running `custom-print-uninstall'."
-  (interactive)
-  (mapcar 'cust-print-set-function-cell
-	  '((prin1 custom-prin1)
-	    (princ custom-princ)
-	    (print custom-print)
-	    (prin1-to-string custom-prin1-to-string)
-	    (format custom-format)
-	    (message custom-message)
-	    (error custom-error)
-	    ))
-  t)
-  
-(defun custom-print-uninstall ()
-  "Reset print functions to their emacs subroutines."
-  (interactive)
-  (mapcar 'cust-print-set-function-cell
-	  '((prin1 cust-print-original-prin1)
-	    (princ cust-print-original-princ)
-	    (print cust-print-original-print)
-	    (prin1-to-string cust-print-original-prin1-to-string)
-	    (format cust-print-original-format)
-	    (message cust-print-original-message)
-	    (error cust-print-original-error)
-	    ))
-  t)
-
-(defalias 'custom-print-funcs-installed-p 'custom-print-installed-p)
-(defun custom-print-installed-p ()
-  "Return t if custom-print is currently installed, nil otherwise."
-  (eq (symbol-function 'custom-prin1) (symbol-function 'prin1)))
-
-(put 'with-custom-print-funcs 'edebug-form-spec '(body))
-(put 'with-custom-print 'edebug-form-spec '(body))
-
-(defalias 'with-custom-print-funcs 'with-custom-print)
-(defmacro with-custom-print (&rest body)
-  "Temporarily install the custom print package while executing BODY."
-  (` (unwind-protect
-	 (progn
-	   (custom-print-install)
-	   (,@ body))
-       (custom-print-uninstall))))
-
-
-;; Lisp replacements for prin1 and princ, and for some subrs that use them
-;;===============================================================
-;; - so far only the printing and formatting subrs.
-
-(defun custom-prin1 (object &optional stream)
-  "Output the printed representation of OBJECT, any Lisp object.
-Quoting characters are printed when needed to make output that `read'
-can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see).
-
-This is the custom-print replacement for the standard `prin1'.  It
-uses the appropriate printer depending on the values of `print-level'
-and `print-circle' (which see)."
-  (cust-print-top-level object stream 'cust-print-original-prin1))
-
-
-(defun custom-princ (object &optional stream)
-  "Output the printed representation of OBJECT, any Lisp object.
-No quoting characters are used; no delimiters are printed around
-the contents of strings.
-Output stream is STREAM, or value of `standard-output' (which see).
-
-This is the custom-print replacement for the standard `princ'."
-  (cust-print-top-level object stream 'cust-print-original-princ))
-
-
-(defun custom-prin1-to-string (object)
-  "Return a string containing the printed representation of OBJECT,
-any Lisp object.  Quoting characters are used when needed to make output
-that `read' can handle, whenever this is possible.
-
-This is the custom-print replacement for the standard `prin1-to-string'."
-  (let ((buf (get-buffer-create " *custom-print-temp*")))
-    ;; We must erase the buffer before printing in case an error 
-    ;; occured during the last prin1-to-string and we are in debugger.
-    (save-excursion
-      (set-buffer buf)
-      (erase-buffer))
-    ;; We must be in the current-buffer when the print occurs.
-    (custom-prin1 object buf)
-    (save-excursion
-      (set-buffer buf)
-      (buffer-string)
-      ;; We could erase the buffer again, but why bother?
-      )))
-
-
-(defun custom-print (object &optional stream)
-  "Output the printed representation of OBJECT, with newlines around it.
-Quoting characters are printed when needed to make output that `read'
-can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see).
-
-This is the custom-print replacement for the standard `print'."
-  (cust-print-original-princ "\n" stream)
-  (custom-prin1 object stream)
-  (cust-print-original-princ "\n" stream))
-
-
-(defun custom-format (fmt &rest args)
-  "Format a string out of a control-string and arguments.  
-The first argument is a control string.  It, and subsequent arguments
-substituted into it, become the value, which is a string.
-It may contain %s or %d or %c to substitute successive following arguments.
-%s means print an argument as a string, %d means print as number in decimal,
-%c means print a number as a single character.
-The argument used by %s must be a string or a symbol;
-the argument used by %d, %b, %o, %x or %c must be a number.
-
-This is the custom-print replacement for the standard `format'.  It
-calls the emacs `format' after first making strings for list,
-vector, or symbol args.  The format specification for such args should
-be `%s' in any case, so a string argument will also work.  The string
-is generated with `custom-prin1-to-string', which quotes quotable
-characters."
-  (apply 'cust-print-original-format fmt
-	 (mapcar (function (lambda (arg)
-			     (if (or (listp arg) (vectorp arg) (symbolp arg))
-				 (custom-prin1-to-string arg)
-			       arg)))
-		 args)))
-	    
-  
-(defun custom-message (fmt &rest args)
-  "Print a one-line message at the bottom of the screen.
-The first argument is a control string.
-It may contain %s or %d or %c to print successive following arguments.
-%s means print an argument as a string, %d means print as number in decimal,
-%c means print a number as a single character.
-The argument used by %s must be a string or a symbol;
-the argument used by %d or %c must be a number.
-
-This is the custom-print replacement for the standard `message'.
-See `custom-format' for the details."
-  ;; It doesn't work to princ the result of custom-format as in:
-  ;; (cust-print-original-princ (apply 'custom-format fmt args))
-  ;; because the echo area requires special handling
-  ;; to avoid duplicating the output.  
-  ;; cust-print-original-message does it right.
-  (apply 'cust-print-original-message  fmt
-	 (mapcar (function (lambda (arg)
-			     (if (or (listp arg) (vectorp arg) (symbolp arg))
-				 (custom-prin1-to-string arg)
-			       arg)))
-		 args)))
-	    
-
-(defun custom-error (fmt &rest args)
-  "Signal an error, making error message by passing all args to `format'.
-
-This is the custom-print replacement for the standard `error'.
-See `custom-format' for the details."
-  (signal 'error (list (apply 'custom-format fmt args))))
-
-
-
-;; Support for custom prin1 and princ
-;;=========================================
-
-;; Defs to quiet byte-compiler.
-(defvar circle-table)
-(defvar cust-print-current-level)
-
-(defun cust-print-original-printer (object))  ; One of the standard printers.
-(defun cust-print-low-level-prin (object))    ; Used internally.
-(defun cust-print-prin (object))              ; Call this to print recursively.
-
-(defun cust-print-top-level (object stream emacs-printer)
-  ;; Set up for printing.
-  (let ((standard-output (or stream standard-output))
-	;; circle-table will be non-nil if anything is circular.
-	(circle-table (and print-circle 
-			   (cust-print-preprocess-circle-tree object)))
-	(cust-print-current-level (or print-level -1)))
-
-    (defalias 'cust-print-original-printer emacs-printer)
-    (defalias 'cust-print-low-level-prin 
-      (cond
-       ((or custom-printers
-	    circle-table
-	    print-level			; comment out for version 19
-	    ;; Emacs doesn't use print-level or print-length
-	    ;; for vectors, but custom-print can.
-	    (if custom-print-vectors
-		(or print-level print-length)))
-	'cust-print-print-object)
-       (t 'cust-print-original-printer)))
-    (defalias 'cust-print-prin 
-      (if circle-table 'cust-print-print-circular 'cust-print-low-level-prin))
-
-    (cust-print-prin object)
-    object))
-
-
-(defun cust-print-print-object (object)
-  ;; Test object type and print accordingly.
-  ;; Could be called as either cust-print-low-level-prin or cust-print-prin.
-  (cond 
-   ((null object) (cust-print-original-printer object))
-   ((cust-print-use-custom-printer object) object)
-   ((consp object) (cust-print-list object))
-   ((vectorp object) (cust-print-vector object))
-   ;; All other types, just print.
-   (t (cust-print-original-printer object))))
-
-
-(defun cust-print-print-circular (object)
-  ;; Printer for `prin1' and `princ' that handles circular structures.
-  ;; If OBJECT appears multiply, and has not yet been printed,
-  ;; prefix with label; if it has been printed, use `#N#' instead.
-  ;; Otherwise, print normally.
-  (let ((tag (assq object circle-table)))
-    (if tag
-	(let ((id (cdr tag)))
-	  (if (> id 0)
-	      (progn
-		;; Already printed, so just print id.
-		(cust-print-original-princ "#")
-		(cust-print-original-princ id)
-		(cust-print-original-princ "#"))
-	    ;; Not printed yet, so label with id and print object.
-	    (setcdr tag (- id)) ; mark it as printed
-	    (cust-print-original-princ "#")
-	    (cust-print-original-princ (- id))
-	    (cust-print-original-princ "=")
-	    (cust-print-low-level-prin object)
-	    ))
-      ;; Not repeated in structure.
-      (cust-print-low-level-prin object))))
-
-
-;;================================================
-;; List and vector processing for print functions.
-
-(defun cust-print-list (list)
-  ;; Print a list using print-length, print-level, and print-circle.
-  (if (= cust-print-current-level 0)
-      (cust-print-original-princ "#")
-    (let ((cust-print-current-level (1- cust-print-current-level)))
-      (cust-print-original-princ "(")
-      (let ((length (or print-length 0)))
-
-	;; Print the first element always (even if length = 0).
-	(cust-print-prin (car list))
-	(setq list (cdr list))
-	(if list (cust-print-original-princ " "))
-	(setq length (1- length))
-
-	;; Print the rest of the elements.
-	(while (and list (/= 0 length))
-	  (if (and (listp list)
-		   (not (assq list circle-table)))
-	      (progn
-		(cust-print-prin (car list))
-		(setq list (cdr list)))
-
-	    ;; cdr is not a list, or it is in circle-table.
-	    (cust-print-original-princ ". ")
-	    (cust-print-prin list)
-	    (setq list nil))
-
-	  (setq length (1- length))
-	  (if list (cust-print-original-princ " ")))
-
-	(if (and list (= length 0)) (cust-print-original-princ "..."))
-	(cust-print-original-princ ")"))))
-  list)
-
-
-(defun cust-print-vector (vector)
-  ;; Print a vector according to print-length, print-level, and print-circle.
-  (if (= cust-print-current-level 0)
-      (cust-print-original-princ "#")
-    (let ((cust-print-current-level (1- cust-print-current-level))
-	  (i 0)
-	  (len (length vector)))
-      (cust-print-original-princ "[")
-
-      (if print-length
-	  (setq len (min print-length len)))
-      ;; Print the elements
-      (while (< i len)
-	(cust-print-prin (aref vector i))
-	(setq i (1+ i))
-	(if (< i (length vector)) (cust-print-original-princ " ")))
-
-      (if (< i (length vector)) (cust-print-original-princ "..."))
-      (cust-print-original-princ "]")
-      ))
-  vector)
-
-
-
-;; Circular structure preprocessing
-;;==================================
-
-(defun cust-print-preprocess-circle-tree (object)
-  ;; Fill up the table.  
-  (let (;; Table of tags for each object in an object to be printed.
-	;; A tag is of the form:
-	;; ( <object> <nil-t-or-id-number> )
-	;; The id-number is generated after the entire table has been computed.
-	;; During walk through, the real circle-table lives in the cdr so we
-	;; can use setcdr to add new elements instead of having to setq the
-	;; variable sometimes (poor man's locf).
-	(circle-table (list nil)))
-    (cust-print-walk-circle-tree object)
-
-    ;; Reverse table so it is in the order that the objects will be printed.
-    ;; This pass could be avoided if we always added to the end of the
-    ;; table with setcdr in walk-circle-tree.
-    (setcdr circle-table (nreverse (cdr circle-table)))
-
-    ;; Walk through the table, assigning id-numbers to those
-    ;; objects which will be printed using #N= syntax.  Delete those
-    ;; objects which will be printed only once (to speed up assq later).
-    (let ((rest circle-table)
-	  (id -1))
-      (while (cdr rest)
-	(let ((tag (car (cdr rest))))
-	  (cond ((cdr tag)
-		 (setcdr tag id)
-		 (setq id (1- id))
-		 (setq rest (cdr rest)))
-		;; Else delete this object.
-		(t (setcdr rest (cdr (cdr rest))))))
-	))
-    ;; Drop the car.
-    (cdr circle-table)
-    ))
-
-
-
-(defun cust-print-walk-circle-tree (object)
-  (let (read-equivalent-p tag)
-    (while object
-      (setq read-equivalent-p 
-	    (or (numberp object) 
-		(and (symbolp object)
-		     ;; Check if it is uninterned.
-		     (eq object (intern-soft (symbol-name object)))))
-	    tag (and (not read-equivalent-p)
-		     (assq object (cdr circle-table))))
-      (cond (tag
-	     ;; Seen this object already, so note that.
-	     (setcdr tag t))
-
-	    ((not read-equivalent-p)
-	     ;; Add a tag for this object.
-	     (setcdr circle-table
-		     (cons (list object)
-			   (cdr circle-table)))))
-      (setq object
-	    (cond 
-	     (tag ;; No need to descend since we have already.
-	      nil)
-
-	     ((consp object)
-	      ;; Walk the car of the list recursively.
-	      (cust-print-walk-circle-tree (car object))
-	      ;; But walk the cdr with the above while loop
-	      ;; to avoid problems with max-lisp-eval-depth.
-	      ;; And it should be faster than recursion.
-	      (cdr object))
-
-	     ((vectorp object)
-	      ;; Walk the vector.
-	      (let ((i (length object))
-		    (j 0))
-		(while (< j i)
-		  (cust-print-walk-circle-tree (aref object j))
-		  (setq j (1+ j))))))))))
-
-
-;; Example.
-;;=======================================
-
-'(progn
-   (progn
-     ;; Create some circular structures.
-     (setq circ-sym (let ((x (make-symbol "FOO"))) (list x x)))
-     (setq circ-list (list 'a 'b (vector 1 2 3 4) 'd 'e 'f))
-     (setcar (nthcdr 3 circ-list) circ-list)
-     (aset (nth 2 circ-list) 2 circ-list)
-     (setq dotted-circ-list (list 'a 'b 'c))
-     (setcdr (cdr (cdr dotted-circ-list)) dotted-circ-list)
-     (setq circ-vector (vector 1 2 3 4 (list 'a 'b 'c 'd) 6 7))
-     (aset circ-vector 5 (make-symbol "-gensym-"))
-     (setcar (cdr (aref circ-vector 4)) (aref circ-vector 5))
-     nil)
-
-   (install-custom-print)
-   ;; (setq print-circle t)
-
-   (let ((print-circle t))
-     (or (equal (prin1-to-string circ-list) "#1=(a b [1 2 #1# 4] #1# e f)")
-	 (error "circular object with array printing")))
-
-   (let ((print-circle t))
-     (or (equal (prin1-to-string dotted-circ-list) "#1=(a b c . #1#)")
-	 (error "circular object with array printing")))
-
-   (let* ((print-circle t)
-	  (x (list 'p 'q))
-	  (y (list (list 'a 'b) x 'foo x)))
-     (setcdr (cdr (cdr (cdr y))) (cdr y))
-     (or (equal (prin1-to-string y) "((a b) . #1=(#2=(p q) foo #2# . #1#))"
-		)
-	 (error "circular list example from CL manual")))
-
-   (let ((print-circle nil))
-     ;; cl-packages.el is required to print uninterned symbols like #:FOO.
-     ;; (require 'cl-packages)
-     (or (equal (prin1-to-string circ-sym) "(#:FOO #:FOO)")
-	 (error "uninterned symbols in list")))
-   (let ((print-circle t))
-     (or (equal (prin1-to-string circ-sym) "(#1=FOO #1#)")
-	 (error "circular uninterned symbols in list")))
-
-   (uninstall-custom-print)
-   )
-
-(provide 'cust-print)
-
-;;; cust-print.el ends here
-
diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el
deleted file mode 100644
index fb2a1324331..00000000000
--- a/lisp/emacs-lisp/debug.el
+++ /dev/null
@@ -1,491 +0,0 @@
-;;; debug.el --- debuggers and related commands for Emacs
-
-;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: lisp, tools, maint
-
-;; 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 is a major mode documented in the Emacs manual.
-
-;;; Code:
-
-(defvar debug-function-list nil
-  "List of functions currently set for debug on entry.")
-
-(defvar debugger-step-after-exit nil
-  "Non-nil means \"single-step\" after the debugger exits.")
-
-(defvar debugger-value nil
-  "This is the value for the debugger to return, when it returns.")
-
-(defvar debugger-old-buffer nil
-  "This is the buffer that was current when the debugger was entered.")
-
-(defvar debugger-outer-match-data)
-(defvar debugger-outer-load-read-function)
-(defvar debugger-outer-overriding-local-map)
-(defvar debugger-outer-track-mouse)
-(defvar debugger-outer-last-command)
-(defvar debugger-outer-this-command)
-(defvar debugger-outer-unread-command-char)
-(defvar debugger-outer-unread-command-events)
-(defvar debugger-outer-last-input-event)
-(defvar debugger-outer-last-command-event)
-(defvar debugger-outer-last-nonmenu-event)
-(defvar debugger-outer-last-event-frame)
-(defvar debugger-outer-standard-input)
-(defvar debugger-outer-standard-output)
-(defvar debugger-outer-cursor-in-echo-area)
-
-;;;###autoload
-(setq debugger 'debug)
-;;;###autoload
-(defun debug (&rest debugger-args)
-  "Enter debugger.  To return, type \\<debugger-mode-map>`\\[debugger-continue]'.
-Arguments are mainly for use when this is called from the internals
-of the evaluator.
-
-You may call with no args, or you may pass nil as the first arg and
-any other args you like.  In that case, the list of args after the
-first will be printed into the backtrace buffer."
-  (interactive)
-  (message "Entering debugger...")
-  (let (debugger-value
-	(debug-on-error nil)
-	(debug-on-quit nil)
-	(debugger-buffer (let ((default-major-mode 'fundamental-mode))
-			   (get-buffer-create "*Backtrace*")))
-	(debugger-old-buffer (current-buffer))
-	(debugger-step-after-exit nil)
-	;; Don't keep reading from an executing kbd macro!
-	(executing-kbd-macro nil)
-	;; Save the outer values of these vars for the `e' command
-	;; before we replace the values.
-	(debugger-outer-match-data (match-data))
-	(debugger-outer-load-read-function load-read-function)
-	(debugger-outer-overriding-local-map overriding-local-map)
-	(debugger-outer-track-mouse track-mouse)
-	(debugger-outer-last-command last-command)
-	(debugger-outer-this-command this-command)
-	(debugger-outer-unread-command-char unread-command-char)
-	(debugger-outer-unread-command-events unread-command-events)
-	(debugger-outer-last-input-event last-input-event)
-	(debugger-outer-last-command-event last-command-event)
-	(debugger-outer-last-nonmenu-event last-nonmenu-event)
-	(debugger-outer-last-event-frame last-event-frame)
-	(debugger-outer-standard-input standard-input)
-	(debugger-outer-standard-output standard-output)
-	(debugger-outer-cursor-in-echo-area cursor-in-echo-area))
-    ;; Don't let these magic variables affect the debugger itself.
-    (let ((last-command nil) this-command track-mouse
-	  (unread-command-char -1) unread-command-events
-	  last-input-event last-command-event last-nonmenu-event
-	  last-event-frame
-	  overriding-local-map
-	  load-read-function
-	  (standard-input t) (standard-output t)
-	  (cursor-in-echo-area nil))
-      (unwind-protect
-	  (save-excursion
-	    (save-window-excursion
-	      (pop-to-buffer debugger-buffer)
-	      (erase-buffer)
-	      (let ((standard-output (current-buffer))
-		    (print-escape-newlines t)
-		    (print-length 50))
-		(backtrace))
-	      (goto-char (point-min))
-	      (debugger-mode)
-	      (delete-region (point)
-			     (progn
-			       (search-forward "\n  debug(")
-			       (forward-line 1)
-			       (point)))
-	      (debugger-reenable)
-	      ;; lambda is for debug-on-call when a function call is next.
-	      ;; debug is for debug-on-entry function called.
-	      (cond ((memq (car debugger-args) '(lambda debug))
-		     (insert "Entering:\n")
-		     (if (eq (car debugger-args) 'debug)
-			 (progn
-			   ;; Skip the frames for backtrace-debug, byte-code,
-			   ;; and debug.
-			   (backtrace-debug 3 t)
-			   (delete-char 1)
-			   (insert ?*)
-			   (beginning-of-line))))
-		    ;; Exiting a function.
-		    ((eq (car debugger-args) 'exit)
-		     (insert "Return value: ")
-		     (setq debugger-value (nth 1 debugger-args))
-		     (prin1 debugger-value (current-buffer))
-		     (insert ?\n)
-		     (delete-char 1)
-		     (insert ? )
-		     (beginning-of-line))
-		    ;; Debugger entered for an error.
-		    ((eq (car debugger-args) 'error)
-		     (insert "Signaling: ")
-		     (prin1 (nth 1 debugger-args) (current-buffer))
-		     (insert ?\n))
-		    ;; debug-on-call, when the next thing is an eval.
-		    ((eq (car debugger-args) t)
-		     (insert "Beginning evaluation of function call form:\n"))
-		    ;; User calls debug directly.
-		    (t
-		     (prin1 (if (eq (car debugger-args) 'nil)
-				(cdr debugger-args) debugger-args)
-			    (current-buffer))
-		     (insert ?\n)))
-	      (message "")
-	      (let ((inhibit-trace t)
-		    (standard-output nil)
-		    (buffer-read-only t))
-		(message "")
-		(recursive-edit))))
-	;; Kill or at least neuter the backtrace buffer, so that users
-	;; don't try to execute debugger commands in an invalid context.
-	(if (get-buffer-window debugger-buffer 'visible)
-	    ;; Still visible despite the save-window-excursion?  Maybe it
-	    ;; it's in a pop-up frame.  It would be annoying to delete and
-	    ;; recreate it every time the debugger stops, so instead we'll
-	    ;; erase it but leave it visible.
-	    (save-excursion
-	      (set-buffer debugger-buffer)
-	      (erase-buffer)
-	      (fundamental-mode))
-	  (kill-buffer debugger-buffer))
-	(store-match-data debugger-outer-match-data)))
-    ;; Put into effect the modified values of these variables
-    ;; in case the user set them with the `e' command.
-    (setq load-read-function debugger-outer-load-read-function)
-    (setq overriding-local-map debugger-outer-overriding-local-map)
-    (setq track-mouse debugger-outer-track-mouse)
-    (setq last-command debugger-outer-last-command)
-    (setq this-command debugger-outer-this-command)
-    (setq unread-command-char debugger-outer-unread-command-char)
-    (setq unread-command-events debugger-outer-unread-command-events)
-    (setq last-input-event debugger-outer-last-input-event)
-    (setq last-command-event debugger-outer-last-command-event)
-    (setq last-nonmenu-event debugger-outer-last-nonmenu-event)
-    (setq last-event-frame debugger-outer-last-event-frame)
-    (setq standard-input debugger-outer-standard-input)
-    (setq standard-output debugger-outer-standard-output)
-    (setq cursor-in-echo-area debugger-outer-cursor-in-echo-area)
-    (setq debug-on-next-call debugger-step-after-exit)
-    debugger-value))
-
-(defun debugger-step-through ()
-  "Proceed, stepping through subexpressions of this expression.
-Enter another debugger on next entry to eval, apply or funcall."
-  (interactive)
-  (setq debugger-step-after-exit t)
-  (message "Proceeding, will debug on next eval or call.")
-  (exit-recursive-edit))
-
-(defun debugger-continue ()
-  "Continue, evaluating this expression without stopping."
-  (interactive)
-  (message "Continuing.")
-  (exit-recursive-edit))
-
-(defun debugger-return-value (val)
-  "Continue, specifying value to return.
-This is only useful when the value returned from the debugger
-will be used, such as in a debug on exit from a frame."
-  (interactive "XReturn value (evaluated): ")
-  (setq debugger-value val)
-  (princ "Returning " t)
-  (prin1 debugger-value)
-  (exit-recursive-edit))
-
-(defun debugger-jump ()
-  "Continue to exit from this frame, with all debug-on-entry suspended."
-  (interactive)
-  ;; Compensate for the two extra stack frames for debugger-jump.
-  (let ((debugger-frame-offset (+ debugger-frame-offset 2)))
-    (debugger-frame))
-  ;; Turn off all debug-on-entry functions
-  ;; but leave them in the list.
-  (let ((list debug-function-list))
-    (while list
-      (fset (car list)
-	    (debug-on-entry-1 (car list) (symbol-function (car list)) nil))
-      (setq list (cdr list))))
-  (message "Continuing through this frame")
-  (exit-recursive-edit))
-
-(defun debugger-reenable ()
-  "Turn all debug-on-entry functions back on."
-  (let ((list debug-function-list))
-    (while list
-      (or (consp (symbol-function (car list)))
-	  (debug-convert-byte-code (car list)))
-      (fset (car list)
-	    (debug-on-entry-1 (car list) (symbol-function (car list)) t))
-      (setq list (cdr list)))))
-
-(defun debugger-frame-number ()
-  "Return number of frames in backtrace before the one point points at."
-  (save-excursion
-    (beginning-of-line)
-    (let ((opoint (point))
-	  (count 0))
-      (goto-char (point-min))
-      (if (or (equal (buffer-substring (point) (+ (point) 6))
-		     "Signal")
-	      (equal (buffer-substring (point) (+ (point) 6))
-		     "Return"))
-	  (progn
-	    (search-forward ":")
-	    (forward-sexp 1)))
-      (forward-line 1)
-      (while (progn
-	       (forward-char 2)
-	       (if (= (following-char) ?\()
-		   (forward-sexp 1)
-		 (forward-sexp 2))
-	       (forward-line 1)
-	       (<= (point) opoint))
-	(setq count (1+ count)))
-      count)))
-
-;; Chosen empirically to account for all the frames
-;; that will exist when debugger-frame is called
-;; within the first one that appears in the backtrace buffer.
-;; Assumes debugger-frame is called from a key;
-;; will be wrong if it is called with Meta-x.
-(defconst debugger-frame-offset 8 "")
-
-(defun debugger-frame ()
-  "Request entry to debugger when this frame exits.
-Applies to the frame whose line point is on in the backtrace."
-  (interactive)
-  (beginning-of-line)
-  (let ((level (debugger-frame-number)))
-    (backtrace-debug (+ level debugger-frame-offset) t))
-  (if (= (following-char) ? )
-      (let ((buffer-read-only nil))
-	(delete-char 1)
-	(insert ?*)))
-  (beginning-of-line))
-
-(defun debugger-frame-clear ()
-  "Do not enter to debugger when this frame exits.
-Applies to the frame whose line point is on in the backtrace."
-  (interactive)
-  (beginning-of-line)
-  (let ((level (debugger-frame-number)))
-    (backtrace-debug (+ level debugger-frame-offset) nil))
-  (if (= (following-char) ?*)
-      (let ((buffer-read-only nil))
-	(delete-char 1)
-	(insert ? )))
-  (beginning-of-line))
-
-(defun debugger-eval-expression (exp)
-  "Eval an expression, in an environment like that outside the debugger."
-  (interactive
-   (list (read-from-minibuffer "Eval: "
-			       nil read-expression-map t
-			       'read-expression-history)))
-  (save-excursion
-    (if (null (buffer-name debugger-old-buffer))
-	;; old buffer deleted
-	(setq debugger-old-buffer (current-buffer)))
-    (set-buffer debugger-old-buffer)
-    (let ((track-mouse debugger-outer-track-mouse)
-	  (last-command debugger-outer-last-command)
-	  (this-command debugger-outer-this-command)
-	  (unread-command-char debugger-outer-unread-command-char)
-	  (unread-command-events debugger-outer-unread-command-events)
-	  (last-input-event debugger-outer-last-input-event)
-	  (last-command-event debugger-outer-last-command-event)
-	  (last-nonmenu-event debugger-outer-last-nonmenu-event)
-	  (last-event-frame debugger-outer-last-event-frame)
-	  (standard-input debugger-outer-standard-input)
-	  (standard-output debugger-outer-standard-output)
-	  (cursor-in-echo-area debugger-outer-cursor-in-echo-area)
-	  (overriding-local-map debugger-outer-overriding-local-map)
-	  (load-read-function debugger-outer-load-read-function))
-      (store-match-data debugger-outer-match-data)
-      (prog1 (eval-expression exp)
-	(setq debugger-outer-match-data (match-data))
-	(setq debugger-outer-load-read-function load-read-function)
-	(setq debugger-outer-overriding-local-map overriding-local-map)
-	(setq debugger-outer-track-mouse track-mouse)
-	(setq debugger-outer-last-command last-command)
-	(setq debugger-outer-this-command this-command)
-	(setq debugger-outer-unread-command-char unread-command-char)
-	(setq debugger-outer-unread-command-events unread-command-events)
-	(setq debugger-outer-last-input-event last-input-event)
-	(setq debugger-outer-last-command-event last-command-event)
-	(setq debugger-outer-last-nonmenu-event last-nonmenu-event)
-	(setq debugger-outer-last-event-frame last-event-frame)
-	(setq debugger-outer-standard-input standard-input)
-	(setq debugger-outer-standard-output standard-output)
-	(setq debugger-outer-cursor-in-echo-area cursor-in-echo-area)))))
-
-(defvar debugger-mode-map nil)
-(if debugger-mode-map
-    nil
-  (let ((loop ? ))
-    (setq debugger-mode-map (make-keymap))
-    (suppress-keymap debugger-mode-map)
-    (define-key debugger-mode-map "-" 'negative-argument)
-    (define-key debugger-mode-map "b" 'debugger-frame)
-    (define-key debugger-mode-map "c" 'debugger-continue)
-    (define-key debugger-mode-map "j" 'debugger-jump)
-    (define-key debugger-mode-map "r" 'debugger-return-value)
-    (define-key debugger-mode-map "u" 'debugger-frame-clear)
-    (define-key debugger-mode-map "d" 'debugger-step-through)
-    (define-key debugger-mode-map "l" 'debugger-list-functions)
-    (define-key debugger-mode-map "h" 'describe-mode)
-    (define-key debugger-mode-map "q" 'top-level)
-    (define-key debugger-mode-map "e" 'debugger-eval-expression)
-    (define-key debugger-mode-map " " 'next-line)))
-
-(put 'debugger-mode 'mode-class 'special)
-
-(defun debugger-mode ()
-  "Mode for backtrace buffers, selected in debugger.
-\\<debugger-mode-map>
-A line starts with `*' if exiting that frame will call the debugger.
-Type \\[debugger-frame] or \\[debugger-frame-clear] to set or remove the `*'.
-
-When in debugger due to frame being exited,
-use the \\[debugger-return-value] command to override the value
-being returned from that frame.
-
-Use \\[debug-on-entry] and \\[cancel-debug-on-entry] to control
-which functions will enter the debugger when called.
-
-Complete list of commands:
-\\{debugger-mode-map}"
-  (kill-all-local-variables)    
-  (setq major-mode 'debugger-mode)
-  (setq mode-name "Debugger")
-  (setq truncate-lines t)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (use-local-map debugger-mode-map))
-
-;;;###autoload
-(defun debug-on-entry (function)
-  "Request FUNCTION to invoke debugger each time it is called.
-If you tell the debugger to continue, FUNCTION's execution proceeds.
-This works by modifying the definition of FUNCTION,
-which must be written in Lisp, not predefined.
-Use \\[cancel-debug-on-entry] to cancel the effect of this command.
-Redefining FUNCTION also cancels it."
-  (interactive "aDebug on entry (to function): ")
-  (debugger-reenable)
-  (if (subrp (symbol-function function))
-      (error "Function %s is a primitive" function))
-  (or (consp (symbol-function function))
-      (debug-convert-byte-code function))
-  (or (consp (symbol-function function))
-      (error "Definition of %s is not a list" function))
-  (fset function (debug-on-entry-1 function (symbol-function function) t))
-  (or (memq function debug-function-list)
-      (setq debug-function-list (cons function debug-function-list)))
-  function)
-
-;;;###autoload
-(defun cancel-debug-on-entry (&optional function)
-  "Undo effect of \\[debug-on-entry] on FUNCTION.
-If argument is nil or an empty string, cancel for all functions."
-  (interactive
-   (list (let ((name
-		(completing-read "Cancel debug on entry (to function): "
-				 ;; Make an "alist" of the functions
-				 ;; that now have debug on entry.
-				 (mapcar 'list
-					 (mapcar 'symbol-name
-						 debug-function-list))
-				 nil t nil)))
-	   (if name (intern name)))))
-  (debugger-reenable)
-  (if (and function (not (string= function "")))
-      (progn
-	(fset function
-	      (debug-on-entry-1 function (symbol-function function) nil))
-	(setq debug-function-list (delq function debug-function-list))
-	function)
-    (message "Cancelling debug-on-entry for all functions")
-    (mapcar 'cancel-debug-on-entry debug-function-list)))
-
-(defun debug-convert-byte-code (function)
-  (let ((defn (symbol-function function)))
-    (if (not (consp defn))
-	;; Assume a compiled code object.
-	(let* ((contents (append defn nil))
-	       (body
-		(list (list 'byte-code (nth 1 contents)
-			    (nth 2 contents) (nth 3 contents)))))
-	  (if (nthcdr 5 contents)
-	      (setq body (cons (list 'interactive (nth 5 contents)) body)))
-	  (if (nth 4 contents)
-	      ;; Use `documentation' here, to get the actual string,
-	      ;; in case the compiled function has a reference
-	      ;; to the .elc file.
-	      (setq body (cons (documentation function) body)))
-	  (fset function (cons 'lambda (cons (car contents) body)))))))
-
-(defun debug-on-entry-1 (function defn flag)
-  (if (subrp defn)
-      (error "%s is a built-in function" function)
-    (if (eq (car defn) 'macro)
-	(debug-on-entry-1 function (cdr defn) flag)
-      (or (eq (car defn) 'lambda)
-	  (error "%s not user-defined Lisp function" function))
-      (let (tail prec)
-	(if (stringp (car (nthcdr 2 defn)))
-	    (setq tail (nthcdr 3 defn)
-		  prec (list (car defn) (car (cdr defn))
-			     (car (cdr (cdr defn)))))
-	  (setq tail (nthcdr 2 defn)
-		prec (list (car defn) (car (cdr defn)))))
-	(if (eq flag (equal (car tail) '(debug 'debug)))
-	    defn
-	  (if flag
-	      (nconc prec (cons '(debug 'debug) tail))
-	    (nconc prec (cdr tail))))))))
-
-(defun debugger-list-functions ()
-  "Display a list of all the functions now set to debug on entry."
-  (interactive)
-  (with-output-to-temp-buffer "*Help*"
-    (if (null debug-function-list)
-	(princ "No debug-on-entry functions now\n")
-      (princ "Functions set to debug on entry:\n\n")
-      (let ((list debug-function-list))
-	(while list
-	  (prin1 (car list))
-	  (terpri)
-	  (setq list (cdr list))))
-      (princ "Note: if you have redefined a function, then it may no longer\n")
-      (princ "be set to debug on entry, even if it is in the list."))
-    (save-excursion
-      (set-buffer standard-output)
-      (help-mode))))
-
-;;; debug.el ends here
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
deleted file mode 100644
index 4199728888e..00000000000
--- a/lisp/emacs-lisp/disass.el
+++ /dev/null
@@ -1,266 +0,0 @@
-;;; disass.el --- disassembler for compiled Emacs Lisp code
-
-;; Copyright (C) 1986, 1991 Free Software Foundation, Inc.
-
-;; Author: Doug Cutting <doug@csli.stanford.edu>
-;;	Jamie Zawinski <jwz@lucid.com>
-;; Maintainer: Jamie Zawinski <jwz@lucid.com>
-;; 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:
-
-;; The single entry point, `disassemble', disassembles a code object generated
-;; by the Emacs Lisp byte-compiler.  This doesn't invert the compilation
-;; operation, not by a long shot, but it's useful for debugging.
-
-;;
-;; Original version by Doug Cutting (doug@csli.stanford.edu)
-;; Substantially modified by Jamie Zawinski <jwz@lucid.com> for
-;; the new lapcode-based byte compiler.
-
-;;; Code:
-
-;;; The variable byte-code-vector is defined by the new bytecomp.el.
-;;; The function byte-decompile-lapcode is defined in byte-opt.el.
-;;; Since we don't use byte-decompile-lapcode, let's try not loading byte-opt.
-(require 'byte-compile "bytecomp")
-
-(defvar disassemble-column-1-indent 8 "*")
-(defvar disassemble-column-2-indent 10 "*")
-
-(defvar disassemble-recursive-indent 3 "*")
-
-;;;###autoload
-(defun disassemble (object &optional buffer indent interactive-p)
-  "Print disassembled code for OBJECT in (optional) BUFFER.
-OBJECT can be a symbol defined as a function, or a function itself
-\(a lambda expression or a compiled-function object).
-If OBJECT is not already compiled, we compile it, but do not
-redefine OBJECT if it is a symbol."
-  (interactive (list (intern (completing-read "Disassemble function: "
-					      obarray 'fboundp t))
-		     nil 0 t))
-  (if (eq (car-safe object) 'byte-code)
-      (setq object (list 'lambda () object)))
-  (or indent (setq indent 0))		;Default indent to zero
-  (save-excursion
-    (if (or interactive-p (null buffer))
-	(with-output-to-temp-buffer "*Disassemble*"
-	  (set-buffer "*Disassemble*")
-	  (disassemble-internal object indent (not interactive-p)))
-      (set-buffer buffer)
-      (disassemble-internal object indent nil)))
-  nil)
-
-
-(defun disassemble-internal (obj indent interactive-p)
-  (let ((macro 'nil)
-	(name 'nil)
-	(doc 'nil)
-	args)
-    (while (symbolp obj)
-      (setq name obj
-	    obj (symbol-function obj)))
-    (if (subrp obj)
-	(error "Can't disassemble #<subr %s>" name))
-    (if (and (listp obj) (eq (car obj) 'autoload))
-	(progn
-	  (load (nth 1 obj))
-	  (setq obj (symbol-function name))))
-    (if (eq (car-safe obj) 'macro)	;handle macros
-	(setq macro t
-	      obj (cdr obj)))
-    (if (and (listp obj) (eq (car obj) 'byte-code))
-	(setq obj (list 'lambda nil obj)))	
-    (if (and (listp obj) (not (eq (car obj) 'lambda)))
-	(error "not a function"))
-    (if (consp obj)
-	(if (assq 'byte-code obj)
-	    nil
-	  (if interactive-p (message (if name
-					 "Compiling %s's definition..."
-				       "Compiling definition...")
-				     name))
-	  (setq obj (byte-compile obj))
-	  (if interactive-p (message "Done compiling.  Disassembling..."))))
-    (cond ((consp obj)
-	   (setq obj (cdr obj))		;throw lambda away
-	   (setq args (car obj))	;save arg list
-	   (setq obj (cdr obj)))
-	  ((byte-code-function-p obj)
-	   (setq args (aref obj 0)))
-          (t (error "Compilation failed")))
-    (if (zerop indent) ; not a nested function
-	(progn
-	  (indent-to indent)
-	  (insert (format "byte code%s%s%s:\n"
-			  (if (or macro name) " for" "")
-			  (if macro " macro" "")
-			  (if name (format " %s" name) "")))))
-    (let ((doc (if (consp obj)
-		   (and (stringp (car obj)) (car obj))
-		 ;; Use documentation to get lazy-loaded doc string
-		 (documentation obj t))))
-      (if (and doc (stringp doc))
-	  (progn (and (consp obj) (setq obj (cdr obj)))
-		 (indent-to indent)
-		 (princ "  doc:  " (current-buffer))
-		 (if (string-match "\n" doc)
-		     (setq doc (concat (substring doc 0 (match-beginning 0))
-				       " ...")))
-		 (insert doc "\n"))))
-    (indent-to indent)
-    (insert "  args: ")
-    (prin1 args (current-buffer))
-    (insert "\n")
-    (let ((interactive (cond ((consp obj)
-			      (assq 'interactive obj))
-			     ((> (length obj) 5)
-			      (list 'interactive (aref obj 5))))))
-      (if interactive
-	  (progn
-	    (setq interactive (nth 1 interactive))
-	    (if (eq (car-safe (car-safe obj)) 'interactive)
-		(setq obj (cdr obj)))
-	    (indent-to indent)
-	    (insert " interactive: ")
-	    (if (eq (car-safe interactive) 'byte-code)
-		(progn
-		  (insert "\n")
-		  (disassemble-1 interactive
-				 (+ indent disassemble-recursive-indent)))
-	      (let ((print-escape-newlines t))
-		(prin1 interactive (current-buffer))))
-	    (insert "\n"))))
-    (cond ((and (consp obj) (assq 'byte-code obj))
-	   (disassemble-1 (assq 'byte-code obj) indent))
-	  ((byte-code-function-p obj)
-	   (disassemble-1 obj indent))
-	  (t
-	   (insert "Uncompiled body:  ")
-	   (let ((print-escape-newlines t))
-	     (prin1 (if (cdr obj) (cons 'progn obj) (car obj))
-		    (current-buffer))))))
-  (if interactive-p
-      (message "")))
-
-
-(defun disassemble-1 (obj indent)
-  "Prints the byte-code call OBJ in the current buffer.
-OBJ should be a call to BYTE-CODE generated by the byte compiler."
-  (let (bytes constvec)
-    (if (consp obj)
-	(setq bytes (car (cdr obj))		;the byte code
-	      constvec (car (cdr (cdr obj))))	;constant vector
-      ;; If it is lazy-loaded, load it now
-      (fetch-bytecode obj)
-      (setq bytes (aref obj 1)
-	    constvec (aref obj 2)))
-    (let ((lap (byte-decompile-bytecode bytes constvec))
-	  op arg opname pc-value)
-      (let ((tagno 0)
-	    tmp
-	    (lap lap))
-	(while (setq tmp (assq 'TAG lap))
-	  (setcar (cdr tmp) (setq tagno (1+ tagno)))
-	  (setq lap (cdr (memq tmp lap)))))
-      (while lap
-	;; Take off the pc value of the next thing
-	;; and put it in pc-value.
-	(setq pc-value nil)
-	(if (numberp (car lap))
-	    (setq pc-value (car lap)
-		  lap (cdr lap)))
-	;; Fetch the next op and its arg.
-	(setq op (car (car lap))
-	      arg (cdr (car lap)))
-	(setq lap (cdr lap))
-	(indent-to indent)
-	(if (eq 'TAG op)
-	    (progn
-	      ;; We have a label.  Display it, but first its pc value.
-	      (if pc-value
-		  (insert (format "%d:" pc-value)))
-	      (insert (int-to-string (car arg))))
-	  ;; We have an instruction.  Display its pc value first.
-	  (if pc-value
-	      (insert (format "%d" pc-value)))
-	  (indent-to (+ indent disassemble-column-1-indent))
-	  (if (and op
-		   (string-match "^byte-" (setq opname (symbol-name op))))
-	      (setq opname (substring opname 5))
-	    (setq opname "<not-an-opcode>"))
-	  (if (eq op 'byte-constant2)
-	      (insert " #### shouldn't have seen constant2 here!\n  "))
-	  (insert opname)
-	  (indent-to (+ indent disassemble-column-1-indent
-			disassemble-column-2-indent
-			-1))
-	  (insert " ")
-	  (cond ((memq op byte-goto-ops)
-		 (insert (int-to-string (nth 1 arg))))
-		((memq op '(byte-call byte-unbind
-			    byte-listN byte-concatN byte-insertN))
-		 (insert (int-to-string arg)))
-		((memq op '(byte-varref byte-varset byte-varbind))
-		 (prin1 (car arg) (current-buffer)))
-		((memq op '(byte-constant byte-constant2))
-		 ;; it's a constant
-		 (setq arg (car arg))
-		 ;; but if the value of the constant is compiled code, then
-		 ;; recursively disassemble it.
-		 (cond ((or (byte-code-function-p arg)
-			    (and (eq (car-safe arg) 'lambda)
-				 (assq 'byte-code arg))
-			    (and (eq (car-safe arg) 'macro)
-				 (or (byte-code-function-p (cdr arg))
-				     (and (eq (car-safe (cdr arg)) 'lambda)
-					  (assq 'byte-code (cdr arg))))))
-			(cond ((byte-code-function-p arg)
-			       (insert "<compiled-function>\n"))
-			      ((eq (car-safe arg) 'lambda)
-			       (insert "<compiled lambda>"))
-			      (t (insert "<compiled macro>\n")))
-			(disassemble-internal
-			 arg
-			 (+ indent disassemble-recursive-indent 1)
-			 nil))
-		       ((eq (car-safe arg) 'byte-code)
-			(insert "<byte code>\n")
-			(disassemble-1	;recurse on byte-code object
-			 arg
-			 (+ indent disassemble-recursive-indent)))
-		       ((eq (car-safe (car-safe arg)) 'byte-code)
-			(insert "(<byte code>...)\n")
-			(mapcar ;recurse on list of byte-code objects
-			 '(lambda (obj)
-			    (disassemble-1
-			     obj
-			     (+ indent disassemble-recursive-indent)))
-			 arg))
-		       (t
-			;; really just a constant
-			(let ((print-escape-newlines t))
-			  (prin1 arg (current-buffer))))))
-		)
-	  (insert "\n")))))
-  nil)
-
-;;; disass.el ends here
diff --git a/lisp/emacs-lisp/easymenu.el b/lisp/emacs-lisp/easymenu.el
deleted file mode 100644
index b172e131763..00000000000
--- a/lisp/emacs-lisp/easymenu.el
+++ /dev/null
@@ -1,244 +0,0 @@
-;;; easymenu.el --- support the easymenu interface for defining a menu.
-
-;; Copyright (C) 1994, 1996 Free Software Foundation, Inc.
-
-;; Keywords: emulations
-;; Author: rms
-
-;; 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 is compatible with easymenu.el by Per Abrahamsen
-;; but it is much simpler as it doesn't try to support other Emacs versions.
-;; The code was mostly derived from lmenu.el.
-
-;;; Code:
-
-;;;###autoload
-(defmacro easy-menu-define (symbol maps doc menu)
-  "Define a menu bar submenu in maps MAPS, according to MENU.
-The menu keymap is stored in symbol SYMBOL, both as its value
-and as its function definition.   DOC is used as the doc string for SYMBOL.
-
-The first element of MENU must be a string.  It is the menu bar item name.
-The rest of the elements are menu items.
-
-A menu item is usually a vector of three elements:  [NAME CALLBACK ENABLE]
-
-NAME is a string--the menu item name.
-
-CALLBACK is a command to run when the item is chosen,
-or a list to evaluate when the item is chosen.
-
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
-
-Alternatively, a menu item may have the form: 
-
-   [ NAME CALLBACK [ KEYWORD ARG ] ... ]
-
-Where KEYWORD is one of the symbol defined below.
-
-   :keys KEYS
-
-KEYS is a string; a complex keyboard equivalent to this menu item.
-This is normally not needed because keyboard equivalents are usually
-computed automatically.
-
-   :active ENABLE
-
-ENABLE is an expression; the item is enabled for selection
-whenever this expression's value is non-nil.
-
-   :suffix NAME
-
-NAME is a string; the name of an argument to CALLBACK.
-
-   :style STYLE
-   
-STYLE is a symbol describing the type of menu item.  The following are
-defined:  
-
-toggle: A checkbox.
-        Prepend the name with '(*) ' or '( ) ' depending on if selected or not.
-radio: A radio button.
-       Prepend the name with '[X] ' or '[ ] ' depending on if selected or not.
-nil: An ordinary menu item.
-
-   :selected SELECTED
-
-SELECTED is an expression; the checkbox or radio button is selected
-whenever this expression's value is non-nil.
-
-A menu item can be a string.  Then that string appears in the menu as
-unselectable text.  A string consisting solely of hyphens is displayed
-as a solid horizontal line.
-
-A menu item can be a list.  It is treated as a submenu.
-The first element should be the submenu name.  That's used as the
-menu item in the top-level menu.  The cdr of the submenu list
-is a list of menu items, as above."
-  (` (progn
-       (defvar (, symbol) nil (, doc))
-       (easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu)))))
-
-;;;###autoload
-(defun easy-menu-do-define (symbol maps doc menu)
-  ;; We can't do anything that might differ between Emacs dialects in
-  ;; `easy-menu-define' in order to make byte compiled files
-  ;; compatible.  Therefore everything interesting is done in this
-  ;; function. 
-  (set symbol (easy-menu-create-keymaps (car menu) (cdr menu)))
-  (fset symbol (` (lambda (event) (, doc) (interactive "@e")
-		    (x-popup-menu event (, symbol)))))
-  (mapcar (function (lambda (map) 
-	    (define-key map (vector 'menu-bar (intern (car menu)))
-	      (cons (car menu) (symbol-value symbol)))))
-	  (if (keymapp maps) (list maps) maps)))
-
-(defvar easy-menu-item-count 0)
-
-;; Return a menu keymap corresponding to a Lucid-style menu list
-;; MENU-ITEMS, and with name MENU-NAME.
-;;;###autoload
-(defun easy-menu-create-keymaps (menu-name menu-items)
-  (let ((menu (make-sparse-keymap menu-name)) old-items have-buttons)
-    ;; Process items in reverse order,
-    ;; since the define-key loop reverses them again.
-    (setq menu-items (reverse menu-items))
-    (while menu-items
-      (let* ((item (car menu-items))
-	     (callback (if (vectorp item) (aref item 1)))
-	     (not-button t)
-	     command enabler item-string name)
-	(cond ((stringp item)
-	       (setq command nil)
-	       (setq item-string (if (string-match "^-+$" item) "" item)))
-	      ((consp item)
-	       (setq command (easy-menu-create-keymaps (car item) (cdr item)))
-	       (setq name (setq item-string (car item))))
-	      ((vectorp item)
-	       (setq command (make-symbol (format "menu-function-%d"
-						  easy-menu-item-count)))
-	       (setq easy-menu-item-count (1+ easy-menu-item-count))
-	       (setq name (setq item-string (aref item 0)))
-	       (let ((keyword (aref item 2)))
-		 (if (and (symbolp keyword)
-			  (= ?: (aref (symbol-name keyword) 0)))
-		     (let ((count 2)
-			   style selected active keys
-			   arg)
-		       (while (> (length item) count)
-			 (setq keyword (aref item count))
-			 (setq arg (aref item (1+ count)))
-			 (setq count (+ 2 count))
-			 (cond ((eq keyword ':keys)
-				(setq keys arg))
-			       ((eq keyword ':active)
-				(setq active arg))
-			       ((eq keyword ':suffix)
-				(setq item-string
-				      (concat item-string " " arg)))
-			       ((eq keyword ':style)
-				(setq style arg))
-			       ((eq keyword ':selected)
-				(setq selected arg))))
-		       (if keys
-			   (setq item-string
-				 (concat item-string "  (" keys ")")))
-		       (if (and selected
-				(or (eq style 'radio) (eq style 'toggle)))
-			   ;; Simulate checkboxes and radio buttons.
-			   (progn
-			     (setq item-string
-				   (concat
-				    (if (eval selected)
-					(if (eq style 'radio) "(*) " "[X] ")
-				      (if (eq style 'radio) "( ) " "[ ] "))
-				    item-string))
-			     (put command 'menu-enable
-				  (list 'easy-menu-update-button
-					item-string
-					(if (eq style 'radio) ?* ?X)
-					selected
-					(or active t)))
-			     (setq not-button nil
-				   active     nil
-				   have-buttons t)
-			     (while old-items ; Fix items aleady defined.
-			       (setcar (car old-items)
-				       (concat "    " (car (car old-items))))
-			       (setq old-items (cdr old-items)))))
-		       (if active (put command 'menu-enable active)))
-		   (put command 'menu-enable keyword)))
-	       (if (symbolp callback)
-		   (fset command callback)
-		 (fset command (list 'lambda () '(interactive) callback)))
-	       (put command 'menu-alias t)))
-	(if (null command)
-	    ;; Handle inactive strings specially--allow any number
-	    ;; of identical ones.
-	    (setcdr menu (cons (list nil item-string) (cdr menu)))
-	  (if (and not-button have-buttons)
-	      (setq item-string (concat "    " item-string)))
-	  (setq command (cons item-string command))
-	  (if (not have-buttons)	; Save all items so that we can fix
-	      (setq old-items (cons command old-items))) ; if we have buttons.
-	  (if name (define-key menu (vector (intern name)) command))))
-      (setq menu-items (cdr menu-items)))
-    menu))
-
-(defun easy-menu-update-button (item ch selected active)
-  "Used as menu-enable property to update buttons.
-A call to this function is used as the menu-enable property for buttons.
-ITEM is the item-string into wich CH or ` ' is inserted depending on if
-SELECTED is true or not. The menu entry in enabled iff ACTIVE is true."
-  (let ((new (if selected ch ? ))
-	(old (aref item 1)))
-    (if (eq new old)
-	;; No change, just use the active value.
-	active
-      ;; It has changed.  Update the entry.
-      (aset item 1 new)
-      ;; If the entry is active, make sure the menu gets updated by
-      ;; returning a different value than last time to cheat the cache. 
-      (and active
-	   (random)))))
-
-(defun easy-menu-change (path name items)
-  "Change menu found at PATH as item NAME to contain ITEMS.
-PATH is a list of strings for locating the menu containing NAME in the
-menu bar.  ITEMS is a list of menu items, as in `easy-menu-define'.
-These items entirely replace the previous items in that map.
-
-Call this from `menu-bar-update-hook' to implement dynamic menus."
-  (let ((map (key-binding (apply 'vector
-				 'menu-bar
-				 (mapcar 'intern (append path (list name)))))))
-    (if (keymapp map)
-	(setcdr map (cdr (easy-menu-create-keymaps name items)))
-      (error "Malformed menu in `easy-menu-change'"))))
-
-(defun easy-menu-remove (menu))
-
-(defun easy-menu-add (menu &optional map))
-
-(provide 'easymenu)
-
-;;; easymenu.el ends here
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
deleted file mode 100644
index f6831f6f29d..00000000000
--- a/lisp/emacs-lisp/edebug.el
+++ /dev/null
@@ -1,4515 +0,0 @@
-;;; edebug.el --- a source-level debugger for Emacs Lisp
-
-;; Copyright (C) 1988,'89,'90,'91,'92,'93,'94,'95 Free Software Foundation, Inc
-
-;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
-;; Keywords: lisp, tools, maint
-
-;; LCD Archive Entry:
-;; edebug|Daniel LaLiberte|liberte@cs.uiuc.edu
-;; |A source level debugger for Emacs Lisp.
-;; |$Date: 1996/11/09 21:48:07 $|$Revision: 3.12 $|~/modes/edebug.el|
-
-;; 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 minor mode allows programmers to step through Emacs Lisp
-;; source code while executing functions.  You can also set
-;; breakpoints, trace (stopping at each expression), evaluate
-;; expressions as if outside Edebug, reevaluate and display a list of
-;; expressions, trap errors normally caught by debug, and display a
-;; debug style backtrace.
-
-;;; Installation
-;; =============
-
-;; Put edebug.el in some directory in your load-path and
-;; byte-compile it.  Also read the beginning of edebug-epoch.el, 
-;; cl-specs.el, and edebug-cl-read.el if they apply to you.
-
-;; Unless you are using Emacs 19 which is already set up to use Edebug,
-;; put the following forms in your .emacs file.
-;; (define-key emacs-lisp-mode-map "\C-xx" 'edebug-eval-top-level-form)
-;; (autoload 'edebug-eval-top-level-form "edebug")
-
-;; If you wish to change the default edebug global command prefix, change:
-;; (setq edebug-global-prefix "\C-xX")
-
-;; Other options, are described in the manual.
-
-;; In previous versions of Edebug, users were directed to set
-;; `debugger' to `edebug-debug'.  This is no longer necessary
-;; since Edebug automatically sets it whenever Edebug is active.
-
-;;; Minimal Instructions
-;; =====================
-
-;; First evaluate a defun with C-xx, then run the function.  Step
-;; through the code with SPC, mark breakpoints with b, go until a
-;; breakpoint is reached with g, and quit execution with q.  Use the
-;; "?" command in edebug to describe other commands.  See edebug.tex
-;; or the Emacs 19 Lisp Reference Manual for more instructions.
-
-;; Send me your enhancements, ideas, bugs, or fixes.
-;; For bugs, you can call edebug-submit-bug-report if you have reporter.el.
-;; There is an edebug mailing list if you want to keep up
-;; with the latest developments. Requests to: edebug-request@cs.uiuc.edu
-
-;; Daniel LaLiberte   217-398-4114
-;; University of Illinois, Urbana-Champaign
-;; Department of Computer Science
-;; 1304 W Springfield
-;; Urbana, IL  61801
-
-;; uiucdcs!liberte
-;; liberte@cs.uiuc.edu
-
-;; For the early revision history, see edebug-history.
-
-;;; Code:
-
-(defconst edebug-version
-  (let ((raw-version "$Revision: 3.12 $"))
-    (substring raw-version (string-match "[0-9.]*" raw-version)
-	       (match-end 0))))
-     
-(require 'backquote)
-
-;; Emacs 18 doesn't have defalias.
-(eval-and-compile
-  (or (fboundp 'defalias) (fset 'defalias 'fset)))
-
-
-;;; Bug reporting
-
-(defconst edebug-maintainer-address "liberte@cs.uiuc.edu")
-
-(defun edebug-submit-bug-report ()
-  "Submit, via mail, a bug report on edebug."
-  (interactive)
-  (require 'reporter)
-  (and (y-or-n-p "Do you really want to submit a report on edebug? ")
-       (reporter-submit-bug-report
-         edebug-maintainer-address
-         (concat "edebug.el " edebug-version)
-         (list 'edebug-setup-hook
-               'edebug-all-defs
-               'edebug-all-forms
-               'edebug-eval-macro-args
-               'edebug-stop-before-symbols
-               'edebug-save-windows
-               'edebug-save-displayed-buffer-points
-               'edebug-initial-mode
-               'edebug-trace
-               'edebug-test-coverage
-               'edebug-continue-kbd-macro
-               'edebug-print-length
-               'edebug-print-level
-               'edebug-print-circle
-	       ))))
-
-;;; Options
-
-(defvar edebug-setup-hook nil
-  "*Functions to call before edebug is used.
-Each time it is set to a new value, Edebug will call those functions
-once and then `edebug-setup-hook' is reset to nil.  You could use this
-to load up Edebug specifications associated with a package you are
-using but only when you also use Edebug.")
-
-(defvar edebug-all-defs nil
-  "*If non-nil, evaluation of any defining forms will instrument for Edebug.
-This applies to `eval-defun', `eval-region', `eval-buffer', and
-`eval-current-buffer'.  `eval-region' is also called by
-`eval-last-sexp', and `eval-print-last-sexp'.
-
-You can use the command `edebug-all-defs' to toggle the value of this
-variable.  You may wish to make it local to each buffer with
-\(make-local-variable 'edebug-all-defs) in your
-`emacs-lisp-mode-hook'.")
-
-(defvar edebug-all-forms nil
-  "*Non-nil evaluation of all forms will instrument for Edebug.
-This doesn't apply to loading or evaluations in the minibuffer.
-Use the command `edebug-all-forms' to toggle the value of this option.")
-
-(defvar edebug-eval-macro-args nil
-  "*Non-nil means all macro call arguments may be evaluated.  
-If this variable is nil, the default, Edebug will *not* wrap
-macro call arguments as if they will be evaluated.  
-For each macro, a `edebug-form-spec' overrides this option.
-So to specify exceptions for macros that have some arguments evaluated
-and some not, you should specify an `edebug-form-spec'.
-
-This option is going away soon.")
-
-(defvar edebug-stop-before-symbols nil
-  "*Non-nil causes Edebug to stop before symbols as well as after.  
-In any case, a breakpoint or interrupt may stop before a symbol.
-
-This option is going away soon.")
-
-(defvar edebug-save-windows t
-  "*If non-nil, Edebug saves and restores the window configuration.
-That takes some time, so if your program does not care what happens to
-the window configurations, it is better to set this variable to nil.
-
-If the value is a list, only the listed windows are saved and
-restored.  
-
-`edebug-toggle-save-windows' may be used to change this variable.")
-
-(defvar edebug-save-displayed-buffer-points nil
-  "*If non-nil, save and restore point in all displayed buffers.
-
-Saving and restoring point in other buffers is necessary if you are
-debugging code that changes the point of a buffer which is displayed
-in a non-selected window.  If Edebug or the user then selects the
-window, the buffer's point will be changed to the window's point.
-
-Saving and restoring point in all buffers is expensive, since it
-requires selecting each window twice, so enable this only if you need
-it.")
-
-(defvar edebug-initial-mode 'step
-  "*Initial execution mode for Edebug, if non-nil.  If this variable
-is non-@code{nil}, it specifies the initial execution mode for Edebug
-when it is first activated.  Possible values are step, next, go,
-Go-nonstop, trace, Trace-fast, continue, and Continue-fast.")
-
-(defvar edebug-trace nil
-  "*Non-nil means display a trace of function entry and exit.
-Tracing output is displayed in a buffer named `*edebug-trace*', one
-function entry or exit per line, indented by the recursion level.  
-
-You can customize by replacing functions `edebug-print-trace-before'
-and `edebug-print-trace-after'.")
-
-(defvar edebug-test-coverage nil
-  "*If non-nil, Edebug tests coverage of all expressions debugged.
-This is done by comparing the result of each expression
-with the previous result. Coverage is considered OK if two different
-results are found.
-
-Use `edebug-display-freq-count' to display the frequency count and
-coverage information for a definition.")
-
-(defvar edebug-continue-kbd-macro nil
-  "*If non-nil, continue defining or executing any keyboard macro.
-Use this with caution since it is not debugged.")
-
-
-(defvar edebug-print-length 50
-  "*Default value of `print-length' to use while printing results in Edebug.")
-(defvar edebug-print-level 50
-  "*Default value of `print-level' to use while printing results in Edebug.")
-(defvar edebug-print-circle t
-  "*Default value of `print-circle' to use while printing results in Edebug.")
-
-(defvar edebug-unwrap-results nil
-  "*Non-nil if Edebug should unwrap results of expressions.
-This is useful when debugging macros where the results of expressions
-are instrumented expressions.  But don't do this when results might be
-circular or an infinite loop will result.")
-
-(defvar edebug-on-error t
-  "*Value bound to `debug-on-error' while Edebug is active.
-
-If `debug-on-error' is non-nil, that value is still used.
-
-If the value is a list of signal names, Edebug will stop when any of
-these errors are signaled from Lisp code whether or not the signal is
-handled by a `condition-case'.  This option is useful for debugging
-signals that *are* handled since they would otherwise be missed.
-After execution is resumed, the error is signaled again.")
-
-(defvar edebug-on-quit t
-  "*Value bound to `debug-on-quit' while Edebug is active.")
-
-(defvar edebug-global-break-condition nil
-  "*If non-nil, an expression to test for at every stop point.
-If the result is non-nil, then break.  Errors are ignored.")
-
-;;; Form spec utilities.
-
-;;;###autoload
-(defmacro def-edebug-spec (symbol spec)
-  "Set the edebug-form-spec property of SYMBOL according to SPEC.
-Both SYMBOL and SPEC are unevaluated. The SPEC can be 0, t, a symbol
-\(naming a function), or a list."
-  (` (put (quote (, symbol)) 'edebug-form-spec (quote (, spec)))))
-
-(defmacro def-edebug-form-spec (symbol spec-form)
-  "For compatibility with old version.  Use `def-edebug-spec' instead."
-  (message "Obsolete: use def-edebug-spec instead.")
-  (def-edebug-spec symbol (eval spec-form)))
-
-(defun get-edebug-spec (symbol)
-  ;; Get the spec of symbol resolving all indirection.
-  (let ((edebug-form-spec (get symbol 'edebug-form-spec))
-	indirect)
-    (while (and (symbolp edebug-form-spec)
-		(setq indirect (get edebug-form-spec 'edebug-form-spec)))
-      ;; (edebug-trace "indirection: %s" edebug-form-spec)
-      (setq edebug-form-spec indirect))
-    edebug-form-spec
-    ))
-
-;;; Utilities
-
-;; Define edebug-gensym - from old cl.el
-(defvar edebug-gensym-index 0
-  "Integer used by `edebug-gensym' to produce new names.")
-
-(defun edebug-gensym (&optional prefix)
-  "Generate a fresh uninterned symbol.
-There is an  optional argument, PREFIX.  PREFIX is the
-string that begins the new name. Most people take just the default,
-except when debugging needs suggest otherwise."
-  (if (null prefix)
-      (setq prefix "G"))
-  (let ((newsymbol nil)
-        (newname   ""))
-    (while (not newsymbol)
-      (setq newname (concat prefix (int-to-string edebug-gensym-index)))
-      (setq edebug-gensym-index (+ edebug-gensym-index 1))
-      (if (not (intern-soft newname))
-          (setq newsymbol (make-symbol newname))))
-    newsymbol))
-
-;; Only used by CL-like code.
-(defun edebug-keywordp (object)
-  "Return t if OBJECT is a keyword.
-A keyword is a symbol that starts with `:'."
-  (and (symbolp object)
-       (= ?: (aref (symbol-name object) 0))))
-
-(defun edebug-lambda-list-keywordp (object)
-  "Return t if OBJECT is a lambda list keyword.
-A lambda list keyword is a symbol that starts with `&'."
-  (and (symbolp object)
-       (= ?& (aref (symbol-name object) 0))))
-
-
-(defun edebug-last-sexp ()
-  ;; Return the last sexp before point in current buffer.
-  ;; Assumes Emacs Lisp syntax is active.
-  (car
-   (read-from-string
-    (buffer-substring
-     (save-excursion
-       (forward-sexp -1)
-       (point))
-     (point)))))
-
-(defun edebug-window-list ()
-  "Return a list of windows, in order of `next-window'."
-  ;; This doesn't work for epoch.
-  (let* ((first-window (selected-window))
-	 (window-list (list first-window))
-	 (next (next-window first-window)))
-    (while (not (eq next first-window))
-      (setq window-list (cons next window-list))
-      (setq next (next-window next)))
-    (nreverse window-list)))
-
-(defun edebug-window-live-p (window)
-  "Return non-nil if WINDOW is visible."
-  (let* ((first-window (selected-window))
-	 (next (next-window first-window t)))
-    (while (not (or (eq next window) 
-		    (eq next first-window)))
-      (setq next (next-window next t)))
-    (eq next window)))
-
-;; Not used.
-'(defun edebug-two-window-p ()
-  "Return t if there are two windows."
-  (and (not (one-window-p))
-       (eq (selected-window)
-	   (next-window (next-window (selected-window))))))
-
-(defsubst edebug-lookup-function (object)
-  (while (and (symbolp object) (fboundp object))
-    (setq object (symbol-function object)))
-  object)
-  
-(defun edebug-macrop (object)
-  "Return the macro named by OBJECT, or nil if it is not a macro."
-  (setq object (edebug-lookup-function object))
-  (if (and (listp object)
-	   (eq 'macro (car object))
-	   (edebug-functionp (cdr object)))
-      object))
-
-(defun edebug-functionp (object)
-  "Returns the function named by OBJECT, or nil if it is not a function."
-  (setq object (edebug-lookup-function object))
-  (if (or (subrp object)
-	  (byte-code-function-p object)
-	  (and (listp object)
-	       (eq (car object) 'lambda)
-	       (listp (car (cdr object)))))
-      object))
-
-(defun edebug-sort-alist (alist function)
-  ;; Return the ALIST sorted with comparison function FUNCTION.
-  ;; This uses 'sort so the sorting is destructive.
-  (sort alist (function
-	       (lambda (e1 e2)
-		 (funcall function (car e1) (car e2))))))
-
-;;(def-edebug-spec edebug-save-restriction t)
-
-;; Not used.  If it is used, def-edebug-spec must be defined before use.
-'(defmacro edebug-save-restriction (&rest body)
-  "Evaluate BODY while saving the current buffers restriction.
-BODY may change buffer outside of current restriction, unlike
-save-restriction.  BODY may change the current buffer,
-and the restriction will be restored to the original buffer,
-and the current buffer remains current.
-Return the result of the last expression in BODY."
-  (` (let ((edebug:s-r-beg (point-min-marker))
-	   (edebug:s-r-end (point-max-marker)))
-       (unwind-protect
-	   (progn (,@ body))
-	 (save-excursion
-	   (set-buffer (marker-buffer edebug:s-r-beg))
-	   (narrow-to-region edebug:s-r-beg edebug:s-r-end))))))
-
-;;; Display
-
-(defconst edebug-trace-buffer "*edebug-trace*"
-  "Name of the buffer to put trace info in.")
-
-(defun edebug-pop-to-buffer (buffer &optional window)
-  ;; Like pop-to-buffer, but select window where BUFFER was last shown.
-  ;; Select WINDOW if it provided and it still exists.  Otherwise, 
-  ;; if buffer is currently shown in several windows, choose one.
-  ;; Otherwise, find a new window, possibly splitting one.
-  (setq window (if (and (windowp window) (edebug-window-live-p window)
-			(eq (window-buffer window) buffer))
-		   window
-		 (if (eq (window-buffer (selected-window)) buffer)
-		     (selected-window)
-		   (edebug-get-buffer-window buffer))))
-  (if window
-      (select-window window)
-    (if (one-window-p)
-	(split-window))
-    ;;      (message "next window: %s" (next-window)) (sit-for 1)
-    (if (eq (get-buffer-window edebug-trace-buffer) (next-window))
-	;; Don't select trace window
-	nil
-      (select-window (next-window))))
-  (set-window-buffer (selected-window) buffer)
-  (set-window-hscroll (selected-window) 0);; should this be??
-  ;; Selecting the window does not set the buffer until command loop.
-  ;;(set-buffer buffer)
-  )
-
-
-(defun edebug-get-displayed-buffer-points ()
-  ;; Return a list of buffer point pairs, for all displayed buffers.
-  (save-excursion
-    (let* ((first-window (selected-window))
-	   (next (next-window first-window))
-	   (buffer-point-list nil)
-	   buffer)
-      (while (not (eq next first-window))
-	(set-buffer (setq buffer (window-buffer next)))
-	(setq buffer-point-list
-	      (cons (cons buffer (point)) buffer-point-list))
-	(setq next (next-window next)))
-      buffer-point-list)))
-
-
-(defun edebug-set-buffer-points (buffer-points)
-  ;; Restore the buffer-points created by edebug-get-displayed-buffer-points.
-  (let ((current-buffer (current-buffer)))
-    (mapcar (function (lambda (buf-point)
-			(if (buffer-name (car buf-point)) ; still exists
-			    (progn
-			      (set-buffer (car buf-point))
-			      (goto-char (cdr buf-point))))))
-	    buffer-points)
-    (set-buffer current-buffer)))
-
-(defun edebug-current-windows (which-windows)
-  ;; Get either a full window configuration or some window information.
-  (if (listp which-windows)
-      (mapcar (function (lambda (window)
-			  (if (edebug-window-live-p window)
-			      (list window
-				    (window-buffer window)
-				    (window-point window)
-				    (window-start window)
-				    (window-hscroll window)))))
-	      which-windows)
-    (current-window-configuration)))
-
-(defun edebug-set-windows (window-info)
-  ;; Set either a full window configuration or some window information.
-  (if (listp window-info)
-      (mapcar (function 
-	       (lambda (one-window-info)
-		 (if one-window-info
-		     (apply (function 
-			     (lambda (window buffer point start hscroll)
-			       (if (edebug-window-live-p window)
-				   (progn
-				     (set-window-buffer window buffer)
-				     (set-window-point window point)
-				     (set-window-start window start)
-				     (set-window-hscroll window hscroll)))))
-			    one-window-info))))
-	      window-info)
-    (set-window-configuration window-info)))
-
-(defalias 'edebug-get-buffer-window 'get-buffer-window)
-(defalias 'edebug-sit-for 'sit-for)
-(defalias 'edebug-input-pending-p 'input-pending-p)
-
-
-;;; Redefine read and eval functions
-;; read is redefined to maybe instrument forms.
-;; eval-defun is redefined to check edebug-all-forms and edebug-all-defs.
-
-;; Use the Lisp version of eval-region.
-(require 'eval-reg "eval-reg")
-
-;; Save the original read function
-(or (fboundp 'edebug-original-read)
-    (defalias 'edebug-original-read  (symbol-function 'read)))
-
-(defun edebug-read (&optional stream)
-  "Read one Lisp expression as text from STREAM, return as Lisp object.
-If STREAM is nil, use the value of `standard-input' (which see).
-STREAM or the value of `standard-input' may be:
- a buffer (read from point and advance it)
- a marker (read from where it points and advance it)
- a function (call it with no arguments for each character,
-     call it with a char as argument to push a char back)
- a string (takes text from string, starting at the beginning)
- t (read text line using minibuffer and use it).
-
-This version, from Edebug, maybe instruments the expression. But the
-STREAM must be the current buffer to do so.  Whether it instruments is
-also dependent on the values of `edebug-all-defs' and
-`edebug-all-forms'."
-  (or stream (setq stream standard-input))
-  (if (eq stream (current-buffer))
-      (edebug-read-and-maybe-wrap-form)
-    (edebug-original-read stream)))
-
-(or (fboundp 'edebug-original-eval-defun)
-    (defalias 'edebug-original-eval-defun (symbol-function 'eval-defun)))
-
-;; We should somehow arrange to be able to do this
-;; without actually replacing the eval-defun command.
-(defun edebug-eval-defun (edebug-it)
-  "Evaluate the top-level form containing point, or after point.
-
-This version, from Edebug, has the following differences: With a
-prefix argument instrument the code for Edebug.  If `edebug-all-defs' is
-non-nil, then the code is instrumented *unless* there is a prefix
-argument.  If instrumenting, it prints: `Edebug: FUNCTIONNAME'.
-Otherwise, it prints in the minibuffer."
-  (interactive "P")
-  (let* ((edebugging (not (eq (not edebug-it) (not edebug-all-defs))))
-	 (edebug-result)
-	 (form
-	  (let ((edebug-all-forms edebugging)
-		(edebug-all-defs (eq edebug-all-defs (not edebug-it))))
-	    (edebug-read-top-level-form))))
-    (if (and (eq (car form) 'defvar)
-	     (cdr-safe (cdr-safe form)))
-	(setq form (cons 'defconst (cdr form))))
-    (setq edebug-result (eval form))
-    (if (not edebugging)
-	(princ edebug-result)
-      edebug-result)))
-
-
-;;;###autoload
-(defalias 'edebug-defun 'edebug-eval-top-level-form)
-
-;;;###autoload
-(defun edebug-eval-top-level-form ()
-  "Evaluate a top level form, such as a defun or defmacro.
-This is like `eval-defun', but the code is always instrumented for Edebug.
-Print its name in the minibuffer and leave point where it is,
-or if an error occurs, leave point after it with mark at the original point."
-  (interactive)
-  (eval 
-   ;; Bind edebug-all-forms only while reading, not while evalling
-   ;; but this causes problems while edebugging edebug.
-   (let ((edebug-all-forms t)
-	 (edebug-all-defs t))
-     (edebug-read-top-level-form))))
-
-
-(defun edebug-read-top-level-form ()
-  (let ((starting-point (point)))
-    (end-of-defun)
-    (beginning-of-defun)
-    (prog1
-	(edebug-read-and-maybe-wrap-form)
-      ;; Recover point, but only if no error occurred.
-      (goto-char starting-point))))
-
-
-;; Compatibility with old versions.
-(defalias 'edebug-all-defuns 'edebug-all-defs)
-
-(defun edebug-all-defs ()
-  "Toggle edebugging of all definitions."
-  (interactive)
-  (setq edebug-all-defs (not edebug-all-defs))
-  (message "Edebugging all definitions is %s." 
-	   (if edebug-all-defs "on" "off")))
-
-
-(defun edebug-all-forms ()
-  "Toggle edebugging of all forms."
-  (interactive)
-  (setq edebug-all-forms (not edebug-all-forms))
-  (message "Edebugging all forms is %s." 
-	   (if edebug-all-forms "on" "off")))
-
-
-(defun edebug-install-read-eval-functions ()
-  (interactive)
-  ;; Don't install if already installed.
-  (if (eq (symbol-function 'read) 'edebug-read) nil
-    (elisp-eval-region-install)
-    (defalias 'read 'edebug-read)
-    (defalias 'eval-defun 'edebug-eval-defun)))
-
-(defun edebug-uninstall-read-eval-functions ()
-  (interactive)
-  (elisp-eval-region-uninstall)
-  (defalias 'read (symbol-function 'edebug-original-read))
-  (defalias 'eval-defun (symbol-function 'edebug-original-eval-defun)))
-
-
-;;; Edebug internal data
-
-;; The internal data that is needed for edebugging is kept in the
-;; buffer-local variable `edebug-form-data'. 
-
-(make-variable-buffer-local 'edebug-form-data)
-
-(defconst edebug-form-data nil)
-;; A list of entries associating symbols with buffer regions.
-;; This is an automatic buffer local variable.  Each entry looks like:
-;; @code{(@var{symbol} @var{begin-marker} @var{end-marker}).  The markers
-;; are at the beginning and end of an entry level form and @var{symbol} is
-;; a symbol that holds all edebug related information for the form on its
-;; property list.
-
-;; In the future, the symbol will be irrelevant and edebug data will
-;; be stored in the definitions themselves rather than in the property
-;; list of a symbol.
-
-(defun edebug-make-form-data-entry (symbol begin end)
-  (list symbol begin end))
-
-(defsubst edebug-form-data-name (entry)
-  (car entry))
-
-(defsubst edebug-form-data-begin (entry)
-  (nth 1 entry))
-
-(defsubst edebug-form-data-end (entry)
-  (nth 2 entry))
-
-(defsubst edebug-set-form-data-entry (entry name begin end)
-  (setcar entry name);; in case name is changed
-  (set-marker (nth 1 entry) begin)
-  (set-marker (nth 2 entry) end))
-
-(defun edebug-get-form-data-entry (pnt &optional end-point)
-  ;; Find the edebug form data entry which is closest to PNT.
-  ;; If END-POINT is supplied, match must be exact.
-  ;; Return `nil' if none found.
-  (let ((rest edebug-form-data)
-	closest-entry
-	(closest-dist 999999))  ;; need maxint here
-    (while (and rest (< 0 closest-dist))
-      (let* ((entry (car rest))
-	     (begin (edebug-form-data-begin entry))
-	     (dist (- pnt begin)))
-	(setq rest (cdr rest))
-	(if (and (<= 0 dist)
-		 (< dist closest-dist)
-		 (or (not end-point)
-		     (= end-point (edebug-form-data-end entry)))
-		 (<= pnt (edebug-form-data-end entry)))
-	    (setq closest-dist dist
-		  closest-entry entry))))
-    closest-entry))
-
-;; Also need to find all contained entries,
-;; and find an entry given a symbol, which should be just assq.
-
-(defun edebug-form-data-symbol ()
-;; Return the edebug data symbol of the form where point is in.
-;; If point is not inside a edebuggable form, cause error.
-  (or (edebug-form-data-name (edebug-get-form-data-entry (point)))
-      (error "Not inside instrumented form")))
-
-(defun edebug-make-top-form-data-entry (new-entry)
-  ;; Make NEW-ENTRY the first element in the `edebug-form-data' list.
-  (edebug-clear-form-data-entry new-entry)
-  (setq edebug-form-data (cons new-entry edebug-form-data)))
-
-(defun edebug-clear-form-data-entry (entry)
-;; If non-nil, clear ENTRY out of the form data.  
-;; Maybe clear the markers and delete the symbol's edebug property?
-  (if entry
-      (progn
-	;; Instead of this, we could just find all contained forms. 
-	;; (put (car entry) 'edebug nil)   ; 
-	;; (mapcar 'edebug-clear-form-data-entry   ; dangerous
-	;;   (get (car entry) 'edebug-dependents))
-	;; (set-marker (nth 1 entry) nil)
-	;; (set-marker (nth 2 entry) nil)
-	(setq edebug-form-data (delq entry edebug-form-data)))))
-
-;;; Parser utilities
-
-(defun edebug-syntax-error (&rest args)
-  ;; Signal an invalid-read-syntax with ARGS.
-  (signal 'invalid-read-syntax args))
-
-
-(defconst edebug-read-syntax-table
-  ;; Lookup table for significant characters indicating the class of the
-  ;; token that follows.  This is not a \"real\" syntax table.
-  (let ((table (make-vector 256 'symbol))
-	(i 0))
-    (while (< i ?!)
-      (aset table i 'space)
-      (setq i (1+ i)))
-    (aset table ?\( 'lparen)
-    (aset table ?\) 'rparen)
-    (aset table ?\' 'quote)
-    (aset table ?\` 'backquote)
-    (aset table ?\, 'comma)
-    (aset table ?\" 'string)
-    (aset table ?\? 'char)
-    (aset table ?\[ 'lbracket)
-    (aset table ?\] 'rbracket)
-    (aset table ?\. 'dot)
-    (aset table ?\# 'hash)
-    ;; We treat numbers as symbols, because of confusion with -, -1, and 1-.
-    ;; We don't care about any other chars since they won't be seen.
-    table))
-
-(defun edebug-next-token-class ()
-  ;; Move to the next token and return its class.  We only care about
-  ;; lparen, rparen, dot, quote, backquote, comma, string, char, vector,
-  ;; or symbol.
-  (edebug-skip-whitespace)
-  (aref edebug-read-syntax-table (following-char)))
-
-
-(defun edebug-skip-whitespace ()
-  ;; Leave point before the next token, skipping white space and comments.
-  (skip-chars-forward " \t\r\n\f")
-  (while (= (following-char) ?\;)
-    ;; \r is counted as a comment terminator to support selective display.
-    (skip-chars-forward "^\n\r")  ; skip the comment
-    (skip-chars-forward " \t\r\n\f")))
-
-
-;; Mostly obsolete reader; still used in one case.
-
-(defun edebug-read-sexp ()
-  ;; Read one sexp from the current buffer starting at point.
-  ;; Leave point immediately after it.  A sexp can be a list or atom.
-  ;; An atom is a symbol (or number), character, string, or vector.
-  ;; This works for reading anything legitimate, but it
-  ;; is gummed up by parser inconsistencies (bugs?)
-  (let ((class (edebug-next-token-class)))
-    (cond
-     ;; read goes one too far if a (possibly quoted) string or symbol
-     ;; is immediately followed by non-whitespace.
-     ((eq class 'symbol) (edebug-original-read (current-buffer)))
-     ((eq class 'string) (edebug-original-read (current-buffer)))
-     ((eq class 'quote) (forward-char 1)
-      (list 'quote (edebug-read-sexp)))
-     ((eq class 'backquote)
-      (list '\` (edebug-read-sexp)))
-     ((eq class 'comma)
-      (list '\, (edebug-read-sexp)))
-     (t ; anything else, just read it.
-      (edebug-original-read (current-buffer))))))
-
-;;; Offsets for reader
-
-;; Define a structure to represent offset positions of expressions.
-;; Each offset structure looks like: (before . after) for constituents,
-;; or for structures that have elements: (before <subexpressions> . after)
-;; where the <subexpressions> are the offset structures for subexpressions
-;; including the head of a list.
-(defconst edebug-offsets nil)
-
-;; Stack of offset structures in reverse order of the nesting.
-;; This is used to get back to previous levels.
-(defconst edebug-offsets-stack nil)
-(defconst edebug-current-offset nil) ; Top of the stack, for convenience.
-
-;; We must store whether we just read a list with a dotted form that
-;; is itself a list.  This structure will be condensed, so the offsets
-;; must also be condensed.
-(defconst edebug-read-dotted-list nil)
-
-(defsubst edebug-initialize-offsets ()
-  ;; Reinitialize offset recording.
-  (setq edebug-current-offset nil))
-
-(defun edebug-store-before-offset (point)
-  ;; Add a new offset pair with POINT as the before offset.
-  (let ((new-offset (list point)))
-    (if edebug-current-offset
-	(setcdr edebug-current-offset
-		(cons new-offset (cdr edebug-current-offset)))
-      ;; Otherwise, we are at the top level, so initialize.
-      (setq edebug-offsets new-offset
-	    edebug-offsets-stack nil
-	    edebug-read-dotted-list nil))
-    ;; Cons the new offset to the front of the stack.
-    (setq edebug-offsets-stack (cons new-offset edebug-offsets-stack)
-	  edebug-current-offset new-offset)
-    ))
-
-(defun edebug-store-after-offset (point)
-  ;; Finalize the current offset struct by reversing it and
-  ;; store POINT as the after offset.
-  (if (not edebug-read-dotted-list)
-      ;; Just reverse the offsets of all subexpressions.
-      (setcdr edebug-current-offset (nreverse (cdr edebug-current-offset)))
-
-    ;; We just read a list after a dot, which will be abbreviated out.
-    (setq edebug-read-dotted-list nil)
-    ;; Drop the corresponding offset pair.
-    ;; That is, nconc the reverse of the rest of the offsets 
-    ;; with the cdr of last offset.
-    (setcdr edebug-current-offset
-	    (nconc (nreverse (cdr (cdr edebug-current-offset)))
-		   (cdr (car (cdr edebug-current-offset))))))
-
-  ;; Now append the point using nconc.
-  (setq edebug-current-offset (nconc edebug-current-offset point))
-  ;; Pop the stack.
-  (setq edebug-offsets-stack (cdr edebug-offsets-stack)
-	edebug-current-offset (car edebug-offsets-stack)))
-
-(defun edebug-ignore-offset ()
-  ;; Ignore the last created offset pair.
-  (setcdr edebug-current-offset (cdr (cdr edebug-current-offset))))
-
-(def-edebug-spec edebug-storing-offsets (form body))
-(put 'edebug-storing-offsets 'lisp-indent-hook 1)
-
-(defmacro edebug-storing-offsets (point &rest body)
-  (` (unwind-protect
-	 (progn 
-	   (edebug-store-before-offset (, point))
-	   (,@ body)) 
-       (edebug-store-after-offset (point)))))
-
-
-;;; Reader for Emacs Lisp.
-
-;; Uses edebug-next-token-class (and edebug-skip-whitespace) above.
-
-(defconst edebug-read-alist
-  '((symbol . edebug-read-symbol)
-    (lparen . edebug-read-list)
-    (string . edebug-read-string)
-    (quote . edebug-read-quote)
-    (backquote . edebug-read-backquote)
-    (comma . edebug-read-comma)
-    (lbracket . edebug-read-vector)
-    (hash . edebug-read-function)
-    ))
-
-(defun edebug-read-storing-offsets (stream)
-  (let ((class (edebug-next-token-class))
-	func
-	edebug-read-dotted-list) ; see edebug-store-after-offset
-    (edebug-storing-offsets (point)
-      (if (setq func (assq class edebug-read-alist))
-	  (funcall (cdr func) stream)
-	;; anything else, just read it.
-	(edebug-original-read stream))
-      )))
-
-(defun edebug-read-symbol (stream)
-  (edebug-original-read stream))
-
-(defun edebug-read-string (stream)
-  (edebug-original-read stream))
-
-(defun edebug-read-quote (stream)
-  ;; Turn 'thing into (quote thing)
-  (forward-char 1)
-  (list
-   (edebug-storing-offsets (point)  'quote)
-   (edebug-read-storing-offsets stream)))
-
-(defun edebug-read-backquote (stream)
-  ;; Turn `thing into (\` thing)
-  (let ((opoint (point)))
-    (forward-char 1)
-    ;; Generate the same structure of offsets we would have
-    ;; if the resulting list appeared verbatim in the input text.
-    (edebug-storing-offsets opoint
-      (list
-       (edebug-storing-offsets opoint  '\`)
-       (edebug-read-storing-offsets stream)))))
-
-(defvar edebug-read-backquote-new nil
-  "Non-nil if reading the inside of a new-style backquote with no parens around it.
-Value of nil means reading the inside of an old-style backquote construct
-which is surrounded by an extra set of parentheses.
-This controls how we read comma constructs.")
-
-(defun edebug-read-comma (stream)
-  ;; Turn ,thing into (\, thing).  Handle ,@ and ,. also.
-  (let ((opoint (point)))
-    (forward-char 1)
-    (let ((symbol '\,))
-      (cond ((eq (following-char) ?\.)
-	     (setq symbol '\,\.)
-	     (forward-char 1))
-	    ((eq (following-char) ?\@)
-	     (setq symbol '\,@)
-	     (forward-char 1)))
-      ;; Generate the same structure of offsets we would have
-      ;; if the resulting list appeared verbatim in the input text.
-      (if edebug-read-backquote-new
-	  (list
-	   (edebug-storing-offsets opoint symbol)
-	   (edebug-read-storing-offsets stream))
-	(edebug-storing-offsets opoint symbol)))))
-
-(defun edebug-read-function (stream)
-  ;; Turn #'thing into (function thing)
-  (forward-char 1)
-  (if (/= ?\' (following-char)) (edebug-syntax-error "Bad char"))
-  (forward-char 1)
-  (list 
-   (edebug-storing-offsets (point)  
-     (if (featurep 'cl) 'function* 'function))
-   (edebug-read-storing-offsets stream)))
-
-(defun edebug-read-list (stream)
-  (forward-char 1)			; skip \(
-  (prog1 
-      (let ((elements))
-	(while (not (memq (edebug-next-token-class) '(rparen dot)))
-	  (if (eq (edebug-next-token-class) 'backquote)
-	      (let ((edebug-read-backquote-new (not (null elements)))
-		    (opoint (point)))
-		(if edebug-read-backquote-new
-		    (setq elements (cons (edebug-read-backquote stream) elements))
-		  (forward-char 1)	; Skip backquote.
-		  ;; Call edebug-storing-offsets here so that we
-		  ;; produce the same offsets we would have had
-		  ;; if the backquote were an ordinary symbol.
-		  (setq elements (cons (edebug-storing-offsets opoint '\`)
-				       elements))))
-	    (setq elements (cons (edebug-read-storing-offsets stream) elements))))
-	(setq elements (nreverse elements))
-	(if (eq 'dot (edebug-next-token-class))
-	    (let (dotted-form)
-	      (forward-char 1)		; skip \.
-	      (setq dotted-form (edebug-read-storing-offsets stream))
-		    elements (nconc elements dotted-form)
-	      (if (not (eq (edebug-next-token-class) 'rparen))
-		  (edebug-syntax-error "Expected `)'"))
-	      (setq edebug-read-dotted-list (listp dotted-form))
-	      ))
-	elements)
-    (forward-char 1)			; skip \)
-    ))
-
-(defun edebug-read-vector (stream)
-  (forward-char 1)			; skip \[
-  (prog1 
-      (let ((elements))
-	(while (not (eq 'rbracket (edebug-next-token-class)))
-	  (setq elements (cons (edebug-read-storing-offsets stream) elements)))
-	(apply 'vector (nreverse elements)))
-    (forward-char 1)			; skip \]
-    ))
-
-;;; Cursors for traversal of list and vector elements with offsets.
-
-(defvar edebug-dotted-spec nil)
-
-(defun edebug-new-cursor (expressions offsets)
-  ;; Return a new cursor for EXPRESSIONS with OFFSETS.
-  (if (vectorp expressions) 
-      (setq expressions (append expressions nil)))
-  (cons expressions offsets))
-
-(defsubst edebug-set-cursor (cursor expressions offsets)
-  ;; Set the CURSOR's EXPRESSIONS and OFFSETS to the given.
-  ;; Return the cursor.
-  (setcar cursor expressions)
-  (setcdr cursor offsets)
-  cursor)
-
-'(defun edebug-copy-cursor (cursor)
-  ;; Copy the cursor using the same object and offsets.
-  (cons (car cursor) (cdr cursor)))
-
-(defsubst edebug-cursor-expressions (cursor)
-  (car cursor))
-(defsubst edebug-cursor-offsets (cursor)
-  (cdr cursor))
-
-(defsubst edebug-empty-cursor (cursor)
-  ;; Return non-nil if CURSOR is empty - meaning no more elements.
-  (null (car cursor)))
-
-(defsubst edebug-top-element (cursor)
-  ;; Return the top element at the cursor.
-  ;; Assumes not empty.
-  (car (car cursor)))
-
-(defun edebug-top-element-required (cursor &rest error)
-  ;; Check if a dotted form is required.
-  (if edebug-dotted-spec (edebug-no-match cursor "Dot expected."))
-  ;; Check if there is at least one more argument.
-  (if (edebug-empty-cursor cursor) (apply 'edebug-no-match cursor error))
-  ;; Return that top element.
-  (edebug-top-element cursor))
-
-(defsubst edebug-top-offset (cursor)
-  ;; Return the top offset pair corresponding to the top element.
-  (car (cdr cursor)))
-
-(defun edebug-move-cursor (cursor)
-  ;; Advance and return the cursor to the next element and offset.
-  ;; throw no-match if empty before moving.
-  ;; This is a violation of the cursor encapsulation, but
-  ;; there is plenty of that going on while matching.
-  ;; The following test should always fail.
-  (if (edebug-empty-cursor cursor) 
-      (edebug-no-match cursor "Not enough arguments."))
-  (setcar cursor (cdr (car cursor)))
-  (setcdr cursor (cdr (cdr cursor)))
-  cursor)
-
-
-(defun edebug-before-offset (cursor)
-  ;; Return the before offset of the cursor.
-  ;; If there is nothing left in the offsets,
-  ;; return one less than the offset itself, 
-  ;; which is the after offset for a list.
-  (let ((offset (edebug-cursor-offsets cursor)))
-    (if (consp offset)
-	(car (car offset))
-      (1- offset))))
-
-(defun edebug-after-offset (cursor)
-  ;; Return the after offset of the cursor object.
-  (let ((offset (edebug-top-offset cursor)))
-    (while (consp offset)
-      (setq offset (cdr offset)))
-    offset))
-
-;;; The Parser
-
-;; The top level function for parsing forms is
-;; edebug-read-and-maybe-wrap-form; it calls all the rest.  It checks the
-;; syntax a bit and leaves point at any error it finds, but otherwise
-;; should appear to work like eval-defun.
-
-;; The basic plan is to surround each expression with a call to
-;; the edebug debugger together with indexes into a table of positions of
-;; all expressions.  Thus an expression "exp" becomes:
-
-;; (edebug-after (edebug-before 1) 2 exp)
-
-;; When this is evaluated, first point is moved to the beginning of
-;; exp at offset 1 of the current function.  The expression is
-;; evaluated, which may cause more edebug calls, and then point is
-;; moved to offset 2 after the end of exp.
-
-;; The highest level expressions of the function are wrapped in a call to
-;; edebug-enter, which supplies the function name and the actual
-;; arguments to the function.  See functions edebug-enter, edebug-before,
-;; and edebug-after for more details.
-
-;; Dynamically bound vars, left unbound, but globally declared.
-;; This is to quiet the byte compiler.
-
-;; Window data of the highest definition being wrapped.
-;; This data is shared by all embedded definitions.
-(defvar edebug-top-window-data)
-
-(defvar edebug-&optional)
-(defvar edebug-&rest)
-(defvar edebug-gate nil) ;; whether no-match forces an error.
-
-(defconst edebug-def-name nil) ; name of definition, used by interactive-form
-(defconst edebug-old-def-name nil) ; previous name of containing definition.
-
-(defconst edebug-error-point nil)
-(defconst edebug-best-error nil)
-
-
-(defun edebug-read-and-maybe-wrap-form ()
-  ;; Read a form and wrap it with edebug calls, if the conditions are right.
-  ;; Here we just catch any no-match not caught below and signal an error.
-
-  ;; Run the setup hook.
-  (run-hooks 'edebug-setup-hook)
-  (setq edebug-setup-hook nil)
-
-  (let (result
-	edebug-top-window-data
-	edebug-def-name;; make sure it is locally nil
-	;; I don't like these here!!
-	edebug-&optional
-	edebug-&rest
-	edebug-gate
-	edebug-best-error
-	edebug-error-point
-	no-match
-	;; Do this once here instead of several times.
-	(max-lisp-eval-depth (+ 800 max-lisp-eval-depth))
-	(max-specpdl-size (+ 2000 max-specpdl-size)))
-    (setq no-match
-	  (catch 'no-match
-	    (setq result (edebug-read-and-maybe-wrap-form1))
-	    nil))
-    (if no-match
-	(apply 'edebug-syntax-error no-match))
-    result))
-
-
-(defun edebug-read-and-maybe-wrap-form1 ()
-  (let (spec
-	def-kind
-	defining-form-p
-	def-name
-	;; These offset things don't belong here, but to support recursive
-	;; calls to edebug-read, they need to be here.
-	edebug-offsets
-	edebug-offsets-stack
-	edebug-current-offset ; reset to nil
-	)
-    (save-excursion
-      (if (and (eq 'lparen (edebug-next-token-class))
-	       (eq 'symbol (progn (forward-char 1) (edebug-next-token-class))))
-	  ;; Find out if this is a defining form from first symbol
-	  (setq def-kind (edebug-original-read (current-buffer))
-		spec (and (symbolp def-kind) (get-edebug-spec def-kind))
-		defining-form-p (and (listp spec)
-				     (eq '&define (car spec)))
-		;; This is incorrect in general!! But OK most of the time.
-		def-name (if (and defining-form-p 
-				  (eq 'name (car (cdr spec)))
-				  (eq 'symbol (edebug-next-token-class)))
-			     (edebug-original-read (current-buffer))))))
-;;;(message "all defs: %s   all forms: %s"  edebug-all-defs edebug-all-forms)
-    (cond
-     (defining-form-p
-       (if (or edebug-all-defs edebug-all-forms)
-	   ;; If it is a defining form and we are edebugging defs,
-	   ;; then let edebug-list-form start it.
-	   (let ((cursor (edebug-new-cursor 
-			  (list (edebug-read-storing-offsets (current-buffer)))
-			  (list edebug-offsets))))
-	     (car
-	      (edebug-make-form-wrapper
-	       cursor
-	       (edebug-before-offset cursor) 
-	       (1- (edebug-after-offset cursor))
-	       (list (cons (symbol-name def-kind) (cdr spec))))))
-
-	 ;; Not edebugging this form, so reset the symbol's edebug
-	 ;; property to be just a marker at the definition's source code.
-	 ;; This only works for defs with simple names.
-	 (put def-name 'edebug (point-marker))
-	 ;; Also nil out dependent defs.
-	 '(mapcar (function 
-		   (lambda (def)
-		     (put def-name 'edebug nil)))
-		  (get def-name 'edebug-dependents))
-	 (edebug-read-sexp)))
-
-     ;; If all forms are being edebugged, explicitly wrap it.
-     (edebug-all-forms
-      (let ((cursor (edebug-new-cursor 
-		     (list (edebug-read-storing-offsets (current-buffer)))
-		     (list edebug-offsets))))
-	(edebug-make-form-wrapper 
-	 cursor
-	 (edebug-before-offset cursor) 
-	 (edebug-after-offset cursor) 
-	 nil)))
-
-     ;; Not a defining form, and not edebugging.
-     (t (edebug-read-sexp)))
-    ))
-
-
-(defvar edebug-def-args) ; args of defining form.
-(defvar edebug-def-interactive) ; is it an emacs interactive function?
-(defvar edebug-inside-func)  ;; whether code is inside function context.
-;; Currently def-form sets this to nil; def-body sets it to t.
-
-(defun edebug-interactive-p-name ()
-  ;; Return a unique symbol for the variable used to store the
-  ;; status of interactive-p for this function.
-  (intern (format "edebug-%s-interactive-p" edebug-def-name)))
-
-
-(defun edebug-wrap-def-body (forms)
-  "Wrap the FORMS of a definition body."
-  (if edebug-def-interactive
-      (` (let (((, (edebug-interactive-p-name))
-		(interactive-p)))
-	   (, (edebug-make-enter-wrapper forms))))
-    (edebug-make-enter-wrapper forms)))
-
-
-(defun edebug-make-enter-wrapper (forms)
-  ;; Generate the enter wrapper for some forms of a definition.
-  ;; This is not to be used for the body of other forms, e.g. `while',
-  ;; since it wraps the list of forms with a call to `edebug-enter'.
-  ;; Uses the dynamically bound vars edebug-def-name and edebug-def-args.
-  ;; Do this after parsing since that may find a name.
-  (setq edebug-def-name 
-	(or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
-  (` (edebug-enter
-      (quote (, edebug-def-name))
-      (, (if edebug-inside-func  
-	     (` (list (,@ 
-		       ;; Doesn't work with more than one def-body!!
-		       ;; But the list will just be reversed.
-		       (nreverse edebug-def-args))))
-	   'nil))
-      (function (lambda () (,@ forms)))
-      )))
-
-
-(defvar edebug-form-begin-marker) ; the mark for def being instrumented
-  
-(defvar edebug-offset-index) ; the next available offset index.
-(defvar edebug-offset-list) ; the list of offset positions.
-
-(defun edebug-inc-offset (offset)
-  ;; modifies edebug-offset-index and edebug-offset-list
-  ;; accesses edebug-func-marc and buffer point
-  (prog1
-      edebug-offset-index
-    (setq edebug-offset-list (cons (- offset edebug-form-begin-marker)
-				   edebug-offset-list)
-	  edebug-offset-index (1+ edebug-offset-index))))
-
-
-(defun edebug-make-before-and-after-form (before-index form after-index)
-  ;; Return the edebug form for the current function at offset BEFORE-INDEX
-  ;; given FORM.  Looks like: 
-  ;; (edebug-after (edebug-before BEFORE-INDEX) AFTER-INDEX FORM)
-  ;; Also increment the offset index for subsequent use.
-  ;; if (not edebug-stop-before-symbols) and form is a symbol,
-  ;; then don't call edebug-before.
-  (list 'edebug-after 
-	(list 'edebug-before before-index)
-	after-index form))
-
-(defun edebug-make-after-form (form after-index)
-  ;; Like edebug-make-before-and-after-form, but only after.
-  (list 'edebug-after 0 after-index form))
-
-
-(defun edebug-unwrap (sexp)
-  "Return the unwrapped SEXP or return it as is if it is not wrapped.
-The SEXP might be the result of wrapping a body, which is a list of 
-expressions; a `progn' form will be returned enclosing these forms."
-  (if (consp sexp)
-      (cond 
-       ((eq 'edebug-after (car sexp))
-	(nth 3 sexp))
-       ((eq 'edebug-enter (car sexp))
-	(let ((forms (nthcdr 2 (nth 1 (nth 3 sexp)))))
-	  (if (> (length forms) 1)
-	      (cons 'progn forms)  ;; could return (values forms) instead.
-	    (car forms))))
-       (t sexp);; otherwise it is not wrapped, so just return it.
-       )
-    sexp))
-
-(defun edebug-unwrap* (sexp)
-  "Return the sexp recursively unwrapped."
-  (let ((new-sexp (edebug-unwrap sexp)))
-    (while (not (eq sexp new-sexp))
-      (setq sexp new-sexp
-	    new-sexp (edebug-unwrap sexp)))
-    (if (consp new-sexp)
-	(mapcar 'edebug-unwrap* new-sexp)
-      new-sexp)))
-
-
-(defun edebug-defining-form (cursor form-begin form-end speclist)
-  ;; Process the defining form, starting outside the form.
-  ;; The speclist is a generated list spec that looks like:
-  ;;   (("def-symbol" defining-form-spec-sans-&define))
-  ;; Skip the first offset.
-  (edebug-set-cursor cursor (edebug-cursor-expressions cursor)
-		     (cdr (edebug-cursor-offsets cursor)))
-  (edebug-make-form-wrapper 
-   cursor 
-   form-begin (1- form-end)
-   speclist))
-
-(defun edebug-make-form-wrapper (cursor form-begin form-end
-					&optional speclist)
-  ;; Wrap a form, usually a defining form, but any evaluated one.
-  ;; If speclist is non-nil, this is being called by edebug-defining-form.
-  ;; Otherwise it is being called from edebug-read-and-maybe-wrap-form1.
-  ;; This is a hack, but I havent figured out a simpler way yet.
-  (let* ((form-data-entry (edebug-get-form-data-entry form-begin form-end))
-	 ;; Set this marker before parsing.
-	 (edebug-form-begin-marker 	       
-	  (if form-data-entry 
-	      (edebug-form-data-begin form-data-entry)
-	    ;; Buffer must be current-buffer for this to work:
-	    (set-marker (make-marker) form-begin))))
-
-    (let (edebug-offset-list
-	  (edebug-offset-index 0)
-	  result
-	  ;; For definitions.
-	  ;; (edebug-containing-def-name edebug-def-name)
-	  ;; Get name from form-data, if any.
-	  (edebug-old-def-name (edebug-form-data-name form-data-entry))
-	  edebug-def-name
-	  edebug-def-args
-	  edebug-def-interactive
-	  edebug-inside-func;; whether wrapped code executes inside a function.
-	  )
-    
-      (setq result
-	    (if speclist
-		(edebug-match cursor speclist)
-
-	      ;; else wrap as an enter-form.
-	      (edebug-make-enter-wrapper (list (edebug-form cursor)))))
-    
-      ;; Set the name here if it was not set by edebug-make-enter-wrapper.
-      (setq edebug-def-name 
-	    (or edebug-def-name edebug-old-def-name (edebug-gensym "edebug-anon")))
-
-      ;; Add this def as a dependent of containing def.  Buggy.
-      '(if (and edebug-containing-def-name
-		(not (get edebug-containing-def-name 'edebug-dependents)))
-	   (put edebug-containing-def-name 'edebug-dependents
-		(cons edebug-def-name 
-		      (get edebug-containing-def-name 
-			   'edebug-dependents))))
-
-      ;; Create a form-data-entry or modify existing entry's markers.
-      ;; In the latter case, pointers to the entry remain eq.
-      (if (not form-data-entry)
-	  (setq form-data-entry 
-		(edebug-make-form-data-entry
-		 edebug-def-name 
-		 edebug-form-begin-marker
-		 ;; Buffer must be current-buffer.
-		 (set-marker (make-marker) form-end)
-		 ))
-	(edebug-set-form-data-entry 
-	 form-data-entry edebug-def-name ;; in case name is changed
-	 form-begin form-end))
-
-      ;;    (message "defining: %s" edebug-def-name) (sit-for 2)
-      (edebug-make-top-form-data-entry form-data-entry)
-      (message "Edebug: %s" edebug-def-name)
-      ;;(debug edebug-def-name)
-
-      ;; Destructively reverse edebug-offset-list and make vector from it.
-      (setq edebug-offset-list (vconcat (nreverse edebug-offset-list)))
-
-      ;; Side effects on the property list of edebug-def-name.
-      (edebug-clear-frequency-count edebug-def-name)
-      (edebug-clear-coverage edebug-def-name)
-
-      ;; Set up the initial window data.
-      (if (not edebug-top-window-data) ;; if not already set, do it now.
-	  (let ((window ;; Find the best window for this buffer.
-		 (or (get-buffer-window (current-buffer))
-		     (selected-window))))
-	    (setq edebug-top-window-data 
-		  (cons window (window-start window)))))
-
-      ;; Store the edebug data in symbol's property list.
-      (put edebug-def-name 'edebug
-	   ;; A struct or vector would be better here!!
-	   (list edebug-form-begin-marker
-		 nil			; clear breakpoints
-		 edebug-offset-list
-		 edebug-top-window-data
-		 ))
-      result
-      )))
-
-
-(defun edebug-clear-frequency-count (name)
-  ;; Create initial frequency count vector.
-  ;; For each stop point, the counter is incremented each time it is visited.
-  (put name 'edebug-freq-count
-       (make-vector (length edebug-offset-list) 0)))
-
-
-(defun edebug-clear-coverage (name)
-  ;; Create initial coverage vector.  
-  ;; Only need one per expression, but it is simpler to use stop points.
-  (put name 'edebug-coverage 
-       (make-vector (length edebug-offset-list) 'unknown)))
-
-
-(defun edebug-form (cursor)
-  ;; Return the instrumented form for the following form.  
-  ;; Add the point offsets to the edebug-offset-list for the form.
-  (let* ((form (edebug-top-element-required cursor "Expected form"))
-	 (offset (edebug-top-offset cursor)))
-    (prog1
-	(cond
-	 ((consp form)
-	  ;; The first offset for a list form is for the list form itself.
-	  (if (eq 'quote (car form))
-	      form
-	    (let* ((head (car form))
-		   (spec (and (symbolp head) (get-edebug-spec head)))
-		   (new-cursor (edebug-new-cursor form offset)))
-	      ;; Find out if this is a defining form from first symbol.
-	      ;; An indirect spec would not work here, yet.
-	      (if (and (consp spec) (eq '&define (car spec)))
-		  (edebug-defining-form 
-		   new-cursor 
-		   (car offset);; before the form
-		   (edebug-after-offset cursor) 
-		   (cons (symbol-name head) (cdr spec)))
-		;; Wrap a regular form.
-		(edebug-make-before-and-after-form 
-		 (edebug-inc-offset (car offset))
-		 (edebug-list-form new-cursor)
-		 ;; After processing the list form, the new-cursor is left
-		 ;; with the offset after the form.
-		 (edebug-inc-offset (edebug-cursor-offsets new-cursor))))
-	      )))
-
-	 ((symbolp form)
-	  (cond
-	   ;; Check for constant symbols that don't get wrapped.
-	   ((or (memq form '(t nil))
-		(and (fboundp 'edebug-keywordp) (edebug-keywordp form)))
-	    form)
-
-	   ;; This option may go away.
-	   (edebug-stop-before-symbols
-	    (edebug-make-before-and-after-form 
-	     (edebug-inc-offset (car offset))
-	     form
-	     (edebug-inc-offset (cdr offset))
-	     ))
-
-	   (t ;; just a variable
-	    (edebug-make-after-form form (edebug-inc-offset (cdr offset))))))
-
-	 ;; Anything else is self-evaluating.
-	 (t form))
-    (edebug-move-cursor cursor))))
-
-
-(defsubst edebug-forms (cursor)  (edebug-match cursor '(&rest form)))
-(defsubst edebug-sexps (cursor)  (edebug-match cursor '(&rest sexp)))
-
-(defsubst edebug-list-form-args (head cursor)
-  ;; Process the arguments of a list form given that head of form is a symbol.
-  ;; Helper for edebug-list-form
-  (let ((spec (get-edebug-spec head)))
-    (cond
-     (spec
-      (cond
-       ((consp spec)
-	;; It is a speclist.
-	(let (edebug-best-error
-	      edebug-error-point);; This may not be needed.
-	  (edebug-match-sublist cursor spec)))
-       ((eq t spec) (edebug-forms cursor))
-       ((eq 0 spec) (edebug-sexps cursor))
-       ((symbolp spec) (funcall spec cursor));; Not used by edebug,
-					; but leave it in for compatibility.
-       ))
-     ;; No edebug-form-spec provided.
-     ((edebug-macrop head)
-      (if edebug-eval-macro-args
-	  (edebug-forms cursor)
-	(edebug-sexps cursor)))
-     (t ;; Otherwise it is a function call.
-      (edebug-forms cursor)))))
-
-
-(defun edebug-list-form (cursor)
-  ;; Return an instrumented form built from the list form.
-  ;; The after offset will be left in the cursor after processing the form.
-  (let ((head (edebug-top-element-required cursor "Expected elements"))
-	;; Prevent backtracking whenever instrumenting.
-	(edebug-gate t)
-	;; A list form is never optional because it matches anything.
-	(edebug-&optional nil)
-	(edebug-&rest nil))
-    ;; Skip the first offset.
-    (edebug-set-cursor cursor (edebug-cursor-expressions cursor)
-		       (cdr (edebug-cursor-offsets cursor)))
-    (cond
-     ((null head) nil) ; () is legal.
-
-     ((symbolp head)
-      (cond
-       ((null head)
-	(edebug-syntax-error "nil head"))
-       ((eq head 'interactive-p)
-	;; Special case: replace (interactive-p) with variable
-	(setq edebug-def-interactive 'check-it)
-	(edebug-move-cursor cursor)
-	(edebug-interactive-p-name))
-       (t
-	(cons head (edebug-list-form-args 
-		    head (edebug-move-cursor cursor))))))
-
-     ((consp head)
-      (if (and (listp head) (eq (car head) ',))
-	  (edebug-match cursor '(("," def-form) body))
-	;; Process anonymous function and args.
-	;; This assumes no anonymous macros.
-	(edebug-match-specs cursor '(lambda-expr body) 'edebug-match-specs)))
-
-     (t (edebug-syntax-error
-	 "Head of list form must be a symbol or lambda expression.")))
-      ))
-
-;;; Matching of specs.
-
-(defvar edebug-after-dotted-spec nil)
-
-(defvar edebug-matching-depth 0)  ;; initial value
-(defconst edebug-max-depth 150)  ;; maximum number of matching recursions.
-
-
-;;; Failure to match 
-
-;; This throws to no-match, if there are higher alternatives.
-;; Otherwise it signals an error.  The place of the error is found
-;; with the two before- and after-offset functions.
-
-(defun edebug-no-match (cursor &rest edebug-args)
-  ;; Throw a no-match, or signal an error immediately if gate is active.
-  ;; Remember this point in case we need to report this error.
-  (setq edebug-error-point (or edebug-error-point
-			       (edebug-before-offset cursor))
-	edebug-best-error (or edebug-best-error edebug-args))
-  (if (and edebug-gate (not edebug-&optional))
-      (progn
-	(if edebug-error-point
-	    (goto-char edebug-error-point))
-	(apply 'edebug-syntax-error edebug-args))
-    (funcall 'throw 'no-match edebug-args)))
-
-
-(defun edebug-match (cursor specs)
-  ;; Top level spec matching function.
-  ;; Used also at each lower level of specs.
-  (let (edebug-&optional
-	edebug-&rest
-	edebug-best-error
-	edebug-error-point
-	(edebug-gate edebug-gate)  ;; locally bound to limit effect
-	)
-    (edebug-match-specs cursor specs 'edebug-match-specs)))
-
-
-(defun edebug-match-one-spec (cursor spec)
-  ;; Match one spec, which is not a keyword &-spec.
-  (cond
-   ((symbolp spec) (edebug-match-symbol cursor spec))
-   ((vectorp spec) (edebug-match cursor (append spec nil)))
-   ((stringp spec) (edebug-match-string cursor spec))
-   ((listp spec) (edebug-match-list cursor spec))
-   ))
-
-
-(defun edebug-match-specs (cursor specs remainder-handler)
-  ;; Append results of matching the list of specs.
-  ;; The first spec is handled and the remainder-handler handles the rest.
-  (let ((edebug-matching-depth 
-	 (if (> edebug-matching-depth edebug-max-depth)
-	     (error "too deep - perhaps infinite loop in spec?")
-	   (1+ edebug-matching-depth))))
-    (cond
-     ((null specs) nil)
-  
-     ;; Is the spec dotted?
-     ((atom specs)  
-      (let ((edebug-dotted-spec t));; Containing spec list was dotted.
-	(edebug-match-specs cursor (list specs) remainder-handler)))
-
-     ;; Is the form dotted?
-     ((not (listp (edebug-cursor-expressions cursor)));; allow nil
-      (if (not edebug-dotted-spec)
-	  (edebug-no-match cursor "Dotted spec required."))
-      ;; Cancel dotted spec and dotted form.
-      (let ((edebug-dotted-spec)
-	    (this-form (edebug-cursor-expressions cursor))
-	    (this-offset (edebug-cursor-offsets cursor)))
-	;; Wrap the form in a list, (by changing the cursor??)...
-	(edebug-set-cursor cursor (list this-form) this-offset)
-	;; and process normally, then unwrap the result.
-	(car (edebug-match-specs cursor specs remainder-handler))))
-
-     (t;; Process normally.
-      (let* ((spec (car specs))
-	     (rest)	  
-	     (first-char (and (symbolp spec) (aref (symbol-name spec) 0))))
-	;;(message "spec = %s  first char = %s" spec first-char) (sit-for 1)
-	(nconc
-	 (cond
-	  ((eq ?& first-char);; "&" symbols take all following specs.
-	   (funcall (get-edebug-spec spec) cursor (cdr specs)))
-	  ((eq ?: first-char);; ":" symbols take one following spec.
-	   (setq rest (cdr (cdr specs)))
-	   (funcall (get-edebug-spec spec) cursor (car (cdr specs))))
-	  (t;; Any other normal spec.
-	   (setq rest (cdr specs))
-	   (edebug-match-one-spec cursor spec)))
-	 (funcall remainder-handler cursor rest remainder-handler)))))))
-
-
-;; Define specs for all the symbol specs with functions used to process them.
-;; Perhaps we shouldn't be doing this with edebug-form-specs since the
-;; user may want to define macros or functions with the same names.
-;; We could use an internal obarray for these primitive specs.
-
-(mapcar 
- (function (lambda (pair)
-	     (put (car pair) 'edebug-form-spec (cdr pair))))
- '((&optional . edebug-match-&optional)
-   (&rest . edebug-match-&rest)
-   (&or . edebug-match-&or)
-   (form . edebug-match-form)
-   (sexp . edebug-match-sexp)
-   (body . edebug-match-body)
-   (&define . edebug-match-&define)
-   (name . edebug-match-name)
-   (:name . edebug-match-colon-name)
-   (arg . edebug-match-arg)
-   (def-body . edebug-match-def-body)
-   (def-form . edebug-match-def-form)
-   ;; Less frequently used:
-   ;; (function . edebug-match-function)
-   (lambda-expr . edebug-match-lambda-expr)
-   (&not . edebug-match-&not)
-   (&key . edebug-match-&key)
-   (place . edebug-match-place)
-   (gate . edebug-match-gate)
-   ;;   (nil . edebug-match-nil)  not this one - special case it.
-   ))
-
-(defun edebug-match-symbol (cursor symbol)
-  ;; Match a symbol spec.
-  (let* ((spec (get-edebug-spec symbol)))
-    (cond
-     (spec 
-      (if (consp spec)
-	  ;; It is an indirect spec.
-	  (edebug-match cursor spec)
-	;; Otherwise it should be the symbol name of a function.
-	;; There could be a bug here - maybe need to do edebug-match bindings.
-	(funcall spec cursor)))
-	   
-     ((null symbol)  ;; special case this.
-      (edebug-match-nil cursor))
-
-     ((fboundp symbol)			; is it a predicate? 
-      (let ((sexp (edebug-top-element-required cursor "Expected" symbol)))
-	;; Special case for edebug-`.
-	(if (and (listp sexp) (eq (car sexp) ',))
-	    (edebug-match cursor '(("," def-form)))
-	  (if (not (funcall symbol sexp))
-	      (edebug-no-match cursor symbol "failed"))
-	  (edebug-move-cursor cursor)
-	  (list sexp))))
-     (t (error "%s is not a form-spec or function" symbol))
-     )))
-
-
-(defun edebug-match-sexp (cursor)
-  (list (prog1 (edebug-top-element-required cursor "Expected sexp")
-	  (edebug-move-cursor cursor))))
-
-(defun edebug-match-form (cursor)
-  (list (edebug-form cursor)))
-
-(defalias 'edebug-match-place 'edebug-match-form)
-  ;; Currently identical to edebug-match-form.
-  ;; This is for common lisp setf-style place arguments.
-
-(defsubst edebug-match-body (cursor) (edebug-forms cursor))
-
-(defun edebug-match-&optional (cursor specs)
-  ;; Keep matching until one spec fails.
-  (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper))
-
-(defun edebug-&optional-wrapper (cursor specs remainder-handler)
-  (let (result
-	(edebug-&optional specs)
-	(edebug-gate nil)
-	(this-form (edebug-cursor-expressions cursor))
-	(this-offset (edebug-cursor-offsets cursor)))
-    (if (null (catch 'no-match
-		(setq result
-		      (edebug-match-specs cursor specs remainder-handler))
-		;; Returning nil means no no-match was thrown.
-		nil))
-	result
-      ;; no-match, but don't fail; just reset cursor and return nil.
-      (edebug-set-cursor cursor this-form this-offset)
-      nil)))
-
-
-(defun edebug-&rest-wrapper (cursor specs remainder-handler)
-  (if (null specs) (setq specs edebug-&rest))
-  ;; Reuse the &optional handler with this as the remainder handler.
-  (edebug-&optional-wrapper cursor specs remainder-handler))
-  
-(defun edebug-match-&rest (cursor specs)
-  ;; Repeatedly use specs until failure.
-  (let ((edebug-&rest specs) ;; remember these
-	edebug-best-error
-	edebug-error-point)
-    (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper)))
-
-
-(defun edebug-match-&or (cursor specs)
-  ;; Keep matching until one spec succeeds, and return its results.
-  ;; If none match, fail.
-  ;; This needs to be optimized since most specs spend time here.
-  (let ((original-specs specs)
-	(this-form (edebug-cursor-expressions cursor))
-	(this-offset (edebug-cursor-offsets cursor)))
-    (catch 'matched
-      (while specs
-	(catch 'no-match
-	  (throw 'matched
-		 (let (edebug-gate ;; only while matching each spec
-		       edebug-best-error
-		       edebug-error-point)
-		   ;; Doesn't support e.g. &or symbolp &rest form
-		   (edebug-match-one-spec cursor (car specs)))))
-	;; Match failed, so reset and try again.
-	(setq specs (cdr specs))
-	;; Reset the cursor for the next match.
-	(edebug-set-cursor cursor this-form this-offset))
-      ;; All failed.
-      (apply 'edebug-no-match cursor "Expected one of" original-specs))
-    ))
-
-
-(defun edebug-match-&not (cursor specs)
-  ;; If any specs match, then fail
-  (if (null (catch 'no-match
-	      (let ((edebug-gate nil))
-		(save-excursion
-		  (edebug-match-&or cursor specs)))
-	      nil))
-      ;; This means something matched, so it is a no match.
-      (edebug-no-match cursor "Unexpected"))
-  ;; This means nothing matched, so it is OK.
-  nil) ;; So, return nothing
-  
-
-(def-edebug-spec &key edebug-match-&key)
-
-(defun edebug-match-&key (cursor specs)
-  ;; Following specs must look like (<name> <spec>) ...
-  ;; where <name> is the name of a keyword, and spec is its spec.
-  ;; This really doesn't save much over the expanded form and takes time.
-  (edebug-match-&rest 
-   cursor
-   (cons '&or 
-	 (mapcar (function (lambda (pair)
-			     (vector (format ":%s" (car pair)) 
-				     (car (cdr pair)))))
-		 specs))))
-
-
-(defun edebug-match-gate (cursor)
-  ;; Simply set the gate to prevent backtracking at this level.
-  (setq edebug-gate t)
-  nil)
-
-
-(defun edebug-match-list (cursor specs)
-  ;; The spec is a list, but what kind of list, and what context?
-  (if edebug-dotted-spec
-      ;; After dotted spec but form did not contain dot, 
-      ;; so match list spec elements as if spliced in.
-      (prog1
-	  (let ((edebug-dotted-spec))
-	    (edebug-match-specs cursor specs 'edebug-match-specs))
-	;; If it matched, really clear the dotted-spec flag.
-	(setq edebug-dotted-spec nil))
-    (let ((spec (car specs))
-	  (form (edebug-top-element-required cursor "Expected" specs)))
-      (cond
-       ((eq 'quote spec)
-	(let ((spec (car (cdr specs))))
-	  (cond
-	   ((symbolp spec)
-	    ;; Special case: spec quotes a symbol to match.
-	    ;; Change in future.  Use "..." instead.
-	    (if (not (eq spec form))
-		(edebug-no-match cursor "Expected" spec))
-	    (edebug-move-cursor cursor)
-	    (setq edebug-gate t)
-	    form)
-	   (t 
-	    (error "Bad spec: %s" specs)))))
-
-       ((listp form)
-	(prog1
-	    (list (edebug-match-sublist 
-		   ;; First offset is for the list form itself.
-		   ;; Treat nil as empty list.
-		   (edebug-new-cursor form (cdr (edebug-top-offset cursor))) 
-		   specs))
-	  (edebug-move-cursor cursor)))
-
-       ((and (eq 'vector spec) (vectorp form))
-	;; Special case: match a vector with the specs.
-	(let ((result (edebug-match-sublist
-		       (edebug-new-cursor 
-			form (cdr (edebug-top-offset cursor)))
-		       (cdr specs))))
-	  (edebug-move-cursor cursor)
-	  (list (apply 'vector result))))
-     
-       (t (edebug-no-match cursor "Expected" specs)))
-      )))
-
-
-(defun edebug-match-sublist (cursor specs)
-  ;; Match a sublist of specs.
-  (let (edebug-&optional
-	;;edebug-best-error
-	;;edebug-error-point
-	)
-    (prog1 
-	;; match with edebug-match-specs so edebug-best-error is not bound.
-	(edebug-match-specs cursor specs 'edebug-match-specs)
-      (if (not (edebug-empty-cursor cursor))
-	  (if edebug-best-error 
-	      (apply 'edebug-no-match cursor edebug-best-error)
-	    ;; A failed &rest or &optional spec may leave some args.
-	    (edebug-no-match cursor "Failed matching" specs)
-	    )))))
-
-
-(defun edebug-match-string (cursor spec)
-  (let ((sexp (edebug-top-element-required cursor "Expected" spec)))
-    (if (not (eq (intern spec) sexp))
-	(edebug-no-match cursor "Expected" spec)
-      ;; Since it matched, failure means immediate error, unless &optional.
-      (setq edebug-gate t)
-      (edebug-move-cursor cursor)
-      (list sexp)
-      )))
-
-(defun edebug-match-nil (cursor)
-  ;; There must be nothing left to match a nil.
-  (if (not (edebug-empty-cursor cursor))
-      (edebug-no-match cursor "Unmatched argument(s)")
-    nil))
-
-
-(defun edebug-match-function (cursor)
-  (error "Use function-form instead of function in edebug spec"))
-
-(defun edebug-match-&define (cursor specs)
-  ;; Match a defining form.
-  ;; Normally, &define is interpreted specially other places.
-  ;; This should only be called inside of a spec list to match the remainder
-  ;; of the current list.  e.g. ("lambda" &define args def-body)
-   (edebug-make-form-wrapper
-    cursor 
-    (edebug-before-offset cursor)
-    ;; Find the last offset in the list.
-    (let ((offsets (edebug-cursor-offsets cursor)))
-      (while (consp offsets) (setq offsets (cdr offsets)))
-      offsets)
-    specs))
-
-(defun edebug-match-lambda-expr (cursor)
-  ;; The expression must be a function.
-  ;; This will match any list form that begins with a symbol
-  ;; that has an edebug-form-spec beginning with &define.  In
-  ;; practice, only lambda expressions should be used.  
-  ;; I could add a &lambda specification to avoid confusion.
-  (let* ((sexp (edebug-top-element-required 
-		cursor "Expected lambda expression"))
-	 (offset (edebug-top-offset cursor))
-	 (head (and (consp sexp) (car sexp)))
-	 (spec (and (symbolp head) (get-edebug-spec head)))
-	 (edebug-inside-func nil))
-    ;; Find out if this is a defining form from first symbol.
-    (if (and (consp spec) (eq '&define (car spec)))
-	(prog1
-	    (list
-	     (edebug-defining-form 
-	      (edebug-new-cursor sexp offset)
-	      (car offset);; before the sexp
-	      (edebug-after-offset cursor) 
-	      (cons (symbol-name head) (cdr spec))))
-	  (edebug-move-cursor cursor))
-      (edebug-no-match cursor "Expected lambda expression")
-      )))
-
-
-(defun edebug-match-name (cursor)
-  ;; Set the edebug-def-name bound in edebug-defining-form.
-  (let ((name (edebug-top-element-required cursor "Expected name")))
-    ;; Maybe strings and numbers could be used.
-    (if (not (symbolp name))
-	(edebug-no-match cursor "Symbol expected for name of definition"))
-    (setq edebug-def-name
-	  (if edebug-def-name
-	      ;; Construct a new name by appending to previous name.
-	      (intern (format "%s@%s" edebug-def-name name))
-	    name))
-    (edebug-move-cursor cursor)
-    (list name)))
-
-(defun edebug-match-colon-name (cursor spec)
-  ;; Set the edebug-def-name to the spec.
-  (setq edebug-def-name
-	(if edebug-def-name
-	    ;; Construct a new name by appending to previous name.
-	    (intern (format "%s@%s" edebug-def-name spec))
-	  spec))
-  nil)
-
-(defun edebug-match-arg (cursor)
-  ;; set the def-args bound in edebug-defining-form
-  (let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
-    (if (or (not (symbolp edebug-arg))
-	    (edebug-lambda-list-keywordp edebug-arg))
-      (edebug-no-match cursor "Bad argument:" edebug-arg))
-    (edebug-move-cursor cursor)
-    (setq edebug-def-args (cons edebug-arg edebug-def-args))
-    (list edebug-arg)))
-
-(defun edebug-match-def-form (cursor)
-  ;; Like form but the form is wrapped in edebug-enter form.
-  ;; The form is assumed to be executing outside of the function context.
-  ;; This is a hack for now, since a def-form might execute inside as well.
-  ;; Not to be used otherwise.
-  (let ((edebug-inside-func nil))
-    (list (edebug-make-enter-wrapper (list (edebug-form cursor))))))
-
-(defun edebug-match-def-body (cursor)
-  ;; Like body but body is wrapped in edebug-enter form.
-  ;; The body is assumed to be executing inside of the function context.
-  ;; Not to be used otherwise.
-  (let ((edebug-inside-func t))
-    (list (edebug-wrap-def-body (edebug-forms cursor)))))
-
-
-;;;; Edebug Form Specs
-;;; ==========================================================
-;;; See cl-specs.el for common lisp specs.
-
-;;;;* Spec for def-edebug-spec
-;;; Out of date.
-
-(defun edebug-spec-p (object)
-  "Return non-nil if OBJECT is a symbol with an edebug-form-spec property."
-  (and (symbolp object)
-       (get object 'edebug-form-spec)))
-
-(def-edebug-spec def-edebug-spec
-  ;; Top level is different from lower levels.
-  (&define :name edebug-spec name 
-	   &or "nil" edebug-spec-p "t" "0" (&rest edebug-spec)))
-
-(def-edebug-spec edebug-spec-list
-  ;; A list must have something in it, or it is nil, a symbolp
-  ((edebug-spec . [&or nil edebug-spec])))
-
-(def-edebug-spec edebug-spec
-  (&or
-   (vector &rest edebug-spec)		; matches a vector
-   ("vector" &rest edebug-spec)		; matches a vector spec
-   ("quote" symbolp)
-   edebug-spec-list
-   stringp
-   [edebug-lambda-list-keywordp &rest edebug-spec]
-   ;; [edebug-keywordp gate edebug-spec] ;; need edebug-keywordp for this.
-   edebug-spec-p  ;; Including all the special ones e.g. form.
-   symbolp;; a predicate
-   ))
-
-
-;;;* Emacs special forms and some functions.
-
-;; quote expects only one argument, although it allows any number.
-(def-edebug-spec quote sexp)
-
-;; The standard defining forms.
-(def-edebug-spec defconst defvar)
-(def-edebug-spec defvar (symbolp &optional form stringp))
-
-(def-edebug-spec defun
-  (&define name lambda-list
-	   [&optional stringp]
-	   [&optional ("interactive" interactive)]
-	   def-body))
-(def-edebug-spec defmacro
-  (&define name lambda-list def-body))
-
-(def-edebug-spec arglist lambda-list)  ;; deprecated - use lambda-list.
-
-(def-edebug-spec lambda-list
-  (([&rest arg]
-    [&optional ["&optional" arg &rest arg]]
-    &optional ["&rest" arg]
-    )))
-
-(def-edebug-spec interactive
-  (&optional &or stringp def-form))
-
-;; A function-form is for an argument that may be a function or a form.
-;; This specially recognizes anonymous functions quoted with quote.
-(def-edebug-spec function-form
-  ;; form at the end could also handle "function",
-  ;; but recognize it specially to avoid wrapping function forms.
-  (&or ([&or "quote" "function"] &or symbolp lambda-expr) form))
-
-;; function expects a symbol or a lambda or macro expression
-;; A macro is allowed by Emacs.
-(def-edebug-spec function (&or symbolp lambda-expr))
-
-;; lambda is a macro in emacs 19.
-(def-edebug-spec lambda (&define lambda-list
-				 [&optional stringp]
-				 [&optional ("interactive" interactive)]
-				 def-body))
-
-;; A macro expression is a lambda expression with "macro" prepended.
-(def-edebug-spec macro (&define "lambda" lambda-list def-body))
-
-;; (def-edebug-spec anonymous-form ((&or ["lambda" lambda] ["macro" macro])))
-
-;; Standard functions that take function-forms arguments.
-(def-edebug-spec mapcar (function-form form))
-(def-edebug-spec mapconcat (function-form form form))
-(def-edebug-spec mapatoms (function-form &optional form))
-(def-edebug-spec apply (function-form &rest form))
-(def-edebug-spec funcall (function-form &rest form))
-
-(def-edebug-spec let
-  ((&rest &or (symbolp &optional form) symbolp)
-   body))
-
-(def-edebug-spec let* let)
-
-(def-edebug-spec setq (&rest symbolp form))
-(def-edebug-spec setq-default setq)
-
-(def-edebug-spec cond (&rest (&rest form)))
-
-(def-edebug-spec condition-case
-  (symbolp
-   form
-   &rest (symbolp body)))
-
-
-(def-edebug-spec \` (backquote-form))
-
-;; Supports quotes inside backquotes, 
-;; but only at the top level inside unquotes.
-(def-edebug-spec backquote-form
-  (&or
-   ([&or "," ",@"] &or ("quote" backquote-form) form)
-   (backquote-form &rest backquote-form)
-   ;; If you use dotted forms in backquotes, replace the previous line
-   ;; with the following.  This takes quite a bit more stack space, however.
-   ;; (backquote-form . [&or nil backquote-form])
-   (vector &rest backquote-form)
-   sexp))
-
-;; Special version of backquote that instruments backquoted forms
-;; destined to be evaluated, usually as the result of a
-;; macroexpansion.  Backquoted code can only have unquotes (, and ,@)
-;; in places where list forms are allowed, and predicates. If the
-;; backquote is used in a macro, unquoted code that come from
-;; arguments must be instrumented, if at all, with def-form not def-body.
-
-;; We could assume that all forms (not nested in other forms)
-;; in arguments of macros should be def-forms, whether or not the macros
-;; are defined with edebug-` but this would be expensive.
-
-;; ,@ might have some problems.
-
-(defalias 'edebug-\` '\`)  ;; same macro as regular backquote.
-(def-edebug-spec edebug-\` (def-form))
-
-;; Assume immediate quote in unquotes mean backquote at next higher level.
-(def-edebug-spec , (&or ("quote" edebug-`) def-form))
-(def-edebug-spec ,@ (&define  ;; so (,@ form) is never wrapped.
-		     &or ("quote" edebug-`) def-form))
-
-;; New byte compiler.
-(def-edebug-spec defsubst defun)
-(def-edebug-spec dont-compile t)
-(def-edebug-spec eval-when-compile t)
-(def-edebug-spec eval-and-compile t)
-
-(def-edebug-spec save-selected-window t)
-(def-edebug-spec save-current-buffer t)
-(def-edebug-spec save-match-data t)
-(def-edebug-spec with-output-to-string t)
-(def-edebug-spec with-current-buffer t)
-(def-edebug-spec combine-after-change-calls t)
-(def-edebug-spec with-temp-file t)
-(def-edebug-spec with-temp-buffer t)
-
-;; Anything else?
-
-
-;; Some miscellaneous specs for macros in public packages.
-;; Send me yours.
-
-;; advice.el by Hans Chalupsky (hans@cs.buffalo.edu)
-
-(def-edebug-spec ad-dolist ((symbolp form &optional form) body))
-(def-edebug-spec defadvice 
-  (&define name   ;; thing being advised.
-	   (name  ;; class is [&or "before" "around" "after" 
-	          ;;               "activation" "deactivation"] 
-	    name  ;; name of advice
-	    &rest sexp  ;; optional position and flags
-	    )
-	   [&optional stringp]
-	   [&optional ("interactive" interactive)]
-	   def-body))
-
-;;; The debugger itself
-
-(defvar edebug-active nil)  ;; Non-nil when edebug is active
-
-;;; add minor-mode-alist entry
-(or (assq 'edebug-active minor-mode-alist)
-    (setq minor-mode-alist (cons (list 'edebug-active " *Debugging*")
-				 minor-mode-alist)))
-
-(defvar edebug-stack nil)
-;; Stack of active functions evaluated via edebug.
-;; Should be nil at the top level.
-
-(defvar edebug-stack-depth -1)
-;; Index of last edebug-stack item.
-
-(defvar edebug-offset-indices nil)
-;; Stack of offset indices of visited edebug sexps.
-;; Should be nil at the top level.
-;; Each function adds one cons.  Top is modified with setcar.
-
-
-(defvar edebug-entered nil
-  ;; Non-nil if edebug has already been entered at this recursive edit level.
-  ;; This should stay nil at the top level.
-  )
-
-;; Should these be options?
-(defconst edebug-debugger 'edebug
-  ;; Name of function to use for debugging when error or quit occurs.
-  ;; Set this to 'debug if you want to debug edebug.
-  )
-
-
-;; Dynamically bound variables, declared globally but left unbound.
-(defvar edebug-function) ; the function being executed. change name!!
-(defvar edebug-args) ; the arguments of the function
-(defvar edebug-data) ; the edebug data for the function
-(defvar edebug-value) ; the result of the expression
-(defvar edebug-after-index)
-(defvar edebug-def-mark) ; the mark for the definition
-(defvar edebug-freq-count) ; the count of expression visits.
-(defvar edebug-coverage) ; the coverage results of each expression of function.
-
-(defvar edebug-buffer) ; which buffer the function is in.
-(defvar edebug-result) ; the result of the function call returned by body
-(defvar edebug-outside-executing-macro)
-(defvar edebug-outside-defining-kbd-macro)
-
-(defvar edebug-execution-mode 'step) ; Current edebug mode set by user.
-(defvar edebug-next-execution-mode nil) ; Use once instead of initial mode.
-
-(defvar edebug-outside-debug-on-error) ; the value of debug-on-error outside
-(defvar edebug-outside-debug-on-quit) ; the value of debug-on-quit outside
-
-(defvar edebug-outside-pre-command-hook)
-(defvar edebug-outside-post-command-hook)
-
-(defvar cl-lexical-debug)  ;; Defined in cl.el
-
-;;; Handling signals
-
-(defun edebug-signal (edebug-signal-name edebug-signal-data)
-  "Signal an error.  Args are SIGNAL-NAME, and associated DATA.
-A signal name is a symbol with an `error-conditions' property
-that is a list of condition names.
-A handler for any of those names will get to handle this signal.
-The symbol `error' should always be one of them.
-
-DATA should be a list.  Its elements are printed as part of the error message.
-If the signal is handled, DATA is made available to the handler.
-See `condition-case'.
-
-This is the Edebug replacement for the standard `signal'.  It should
-only be active while Edebug is.  It checks `debug-on-error' to see
-whether it should call the debugger.  When execution is resumed, the
-error is signaled again."
-  (if (and (listp debug-on-error) (memq edebug-signal-name debug-on-error))
-      (edebug 'error (cons edebug-signal-name edebug-signal-data)))
-  ;; If we reach here without another non-local exit, then send signal again.
-  ;; i.e. the signal is not continuable, yet.
-  (signal edebug-signal-name edebug-signal-data))
-
-;;; Entering Edebug
-
-(defun edebug-enter (edebug-function edebug-args edebug-body)
-  ;; Entering FUNC.  The arguments are ARGS, and the body is BODY.
-  ;; Setup edebug variables and evaluate BODY.  This function is called
-  ;; when a function evaluated with edebug-eval-top-level-form is entered.  
-  ;; Return the result of BODY.
-
-  ;; Is this the first time we are entering edebug since
-  ;; lower-level recursive-edit command?
-  ;; More precisely, this tests whether Edebug is currently active.
-  (if (not edebug-entered)
-      (let ((edebug-entered t)
-	    ;; Binding max-lisp-eval-depth here is OK, 
-	    ;; but not inside an unwind-protect.
-	    ;; Doing it here also keeps it from growing too large.
-	    (max-lisp-eval-depth (+ 100 max-lisp-eval-depth)) ; too much??
-	    (max-specpdl-size (+ 200 max-specpdl-size))
-
-	    (debugger edebug-debugger)  ; only while edebug is active.
-	    (edebug-outside-debug-on-error debug-on-error)
-	    (edebug-outside-debug-on-quit debug-on-quit)
-	    ;; Binding these may not be the right thing to do.
-	    ;; We want to allow the global values to be changed.
-	    (debug-on-error (or debug-on-error edebug-on-error))
-	    (debug-on-quit edebug-on-quit)
-
-	    ;; Lexical bindings must be uncompiled for this to work.
-	    (cl-lexical-debug t)
-
-	    ;; Save the outside value of executing macro.  (here??)
-	    (edebug-outside-executing-macro executing-kbd-macro)
-	    (edebug-outside-pre-command-hook pre-command-hook)
-	    (edebug-outside-post-command-hook post-command-hook))
-	(unwind-protect
-	    (let (;; Don't keep reading from an executing kbd macro
-		  ;; within edebug unless edebug-continue-kbd-macro is
-		  ;; non-nil.  Again, local binding may not be best.
-		  (executing-kbd-macro 
-		   (if edebug-continue-kbd-macro executing-kbd-macro))
-
-		  (signal-hook-function 'edebug-signal)
-
-		  ;; Disable command hooks.  This is essential when
-		  ;; a hook function is instrumented - to avoid infinite loop.
-		  ;; This may be more than we need, however.
-		  (pre-command-hook nil)
-		  (post-command-hook nil))
-	      (setq edebug-execution-mode (or edebug-next-execution-mode 
-					      edebug-initial-mode 
-					      edebug-execution-mode)
-		    edebug-next-execution-mode nil)
-	      (edebug-enter edebug-function edebug-args edebug-body))
-	  ;; Reset global variables in case outside value was changed.
-	  (setq executing-kbd-macro edebug-outside-executing-macro
-		pre-command-hook edebug-outside-pre-command-hook
-		post-command-hook edebug-outside-post-command-hook
-		)))
-    
-    (let* ((edebug-data (get edebug-function 'edebug))
-	   (edebug-def-mark (car edebug-data)) ; mark at def start
-	   (edebug-freq-count (get edebug-function 'edebug-freq-count))
-	   (edebug-coverage (get edebug-function 'edebug-coverage))
-	   (edebug-buffer (marker-buffer edebug-def-mark))
-
-	   (edebug-stack (cons edebug-function edebug-stack))
-	   (edebug-offset-indices (cons 0 edebug-offset-indices))
-	   )
-      (if (get edebug-function 'edebug-on-entry)
-	  (progn
-	    (setq edebug-execution-mode 'step)
-	    (if (eq (get edebug-function 'edebug-on-entry) 'temp)
-		(put edebug-function 'edebug-on-entry nil))))
-      (if edebug-trace
-	  (edebug-enter-trace edebug-body)
-	(funcall edebug-body))
-      )))
-
-
-(defun edebug-enter-trace (edebug-body)
-  (let ((edebug-stack-depth (1+ edebug-stack-depth))
-	edebug-result)
-    (edebug-print-trace-before 
-     (format "%s args: %s" edebug-function edebug-args))
-    (prog1 (setq edebug-result (funcall edebug-body))
-      (edebug-print-trace-after
-       (format "%s result: %s" edebug-function edebug-result)))))
-
-(def-edebug-spec edebug-tracing (form body))
-
-(defmacro edebug-tracing (msg &rest body)
-  "Print MSG in *edebug-trace* before and after evaluating BODY.
-The result of BODY is also printed."
-  (` (let ((edebug-stack-depth (1+ edebug-stack-depth))
-	   edebug-result)
-       (edebug-print-trace-before (, msg))
-       (prog1 (setq edebug-result (progn (,@ body)))
-	 (edebug-print-trace-after 
-	  (format "%s result: %s" (, msg) edebug-result))))))
-
-(defun edebug-print-trace-before (msg)
-  "Function called to print trace info before expression evaluation.
-MSG is printed after `::::{ '."
-  (edebug-trace-display
-   edebug-trace-buffer "%s{ %s" (make-string edebug-stack-depth ?\:) msg))
-
-(defun edebug-print-trace-after (msg)
-  "Function called to print trace info after expression evaluation.
-MSG is printed after `::::} '."
-  (edebug-trace-display
-   edebug-trace-buffer "%s} %s" (make-string edebug-stack-depth ?\:) msg))
-
-
-
-(defun edebug-slow-before (edebug-before-index)
-  ;; Debug current function given BEFORE position.
-  ;; Called from functions compiled with edebug-eval-top-level-form.  
-  ;; Return the before index.
-  (setcar edebug-offset-indices edebug-before-index)
-
-  ;; Increment frequency count 
-  (aset edebug-freq-count edebug-before-index
-	(1+ (aref edebug-freq-count edebug-before-index)))
-
-  (if (or (not (memq edebug-execution-mode '(Go-nonstop next)))
-	  (edebug-input-pending-p))
-      (edebug-debugger edebug-before-index 'before nil))
-  edebug-before-index)
-
-(defun edebug-fast-before (edebug-before-index)
-  ;; Do nothing.
-  )
-
-(defun edebug-slow-after (edebug-before-index edebug-after-index edebug-value)
-  ;; Debug current function given AFTER position and VALUE.
-  ;; Called from functions compiled with edebug-eval-top-level-form.
-  ;; Return VALUE.
-  (setcar edebug-offset-indices edebug-after-index)
-
-  ;; Increment frequency count 
-  (aset edebug-freq-count edebug-after-index
-	(1+ (aref edebug-freq-count edebug-after-index)))
-  (if edebug-test-coverage (edebug-update-coverage))
-
-  (if (and (eq edebug-execution-mode 'Go-nonstop)
-	   (not (edebug-input-pending-p)))
-      ;; Just return result.
-      edebug-value
-    (edebug-debugger edebug-after-index 'after edebug-value)
-    ))
-
-(defun edebug-fast-after (edebug-before-index edebug-after-index edebug-value)
-  ;; Do nothing but return the value.
-  edebug-value)
-
-(defun edebug-run-slow ()
-  (defalias 'edebug-before 'edebug-slow-before)
-  (defalias 'edebug-after 'edebug-slow-after))
-
-;; This is not used, yet.
-(defun edebug-run-fast ()
-  (defalias 'edebug-before 'edebug-fast-before)
-  (defalias 'edebug-after 'edebug-fast-after))
-
-(edebug-run-slow)
-
-
-(defun edebug-update-coverage ()
-  (let ((old-result (aref edebug-coverage edebug-after-index)))
-    (cond
-     ((eq 'ok-coverage old-result))
-     ((eq 'unknown old-result)
-      (aset edebug-coverage edebug-after-index edebug-value))
-     ;; Test if a different result.
-     ((not (eq edebug-value old-result))
-      (aset edebug-coverage edebug-after-index 'ok-coverage)))))
-
-
-;; Dynamically declared unbound variables.
-(defvar edebug-arg-mode)  ; the mode, either before, after, or error
-(defvar edebug-breakpoints)
-(defvar edebug-break-data) ; break data for current function.
-(defvar edebug-break) ; whether a break occurred.
-(defvar edebug-global-break) ; whether a global break occurred.
-(defvar edebug-break-condition) ; whether the breakpoint is conditional.
-
-(defvar edebug-break-result nil)
-(defvar edebug-global-break-result nil)
-
-
-(defun edebug-debugger (edebug-offset-index edebug-arg-mode edebug-value)
-  ;; Check breakpoints and pending input.
-  ;; If edebug display should be updated, call edebug-display.
-  ;; Return edebug-value.
-  (let* (;; This needs to be here since breakpoints may be changed.
-	 (edebug-breakpoints (car (cdr edebug-data))) ; list of breakpoints
-	 (edebug-break-data (assq edebug-offset-index edebug-breakpoints))
-	 (edebug-break-condition (car (cdr edebug-break-data)))
-	 (edebug-global-break
-	  (if edebug-global-break-condition
-	      (condition-case nil
-		  (setq edebug-global-break-result
-			(eval edebug-global-break-condition))
-		(error nil))))
-	 (edebug-break))
-
-;;;    (edebug-trace "exp: %s" edebug-value)
-    ;; Test whether we should break.
-    (setq edebug-break 
-	  (or edebug-global-break
-	      (and edebug-break-data
-		   (or (not edebug-break-condition)
-		       (setq edebug-break-result
-			     (eval edebug-break-condition))))))
-    (if (and edebug-break
-	     (nth 2 edebug-break-data)) ; is it temporary?
-	;; Delete the breakpoint.
-	(setcdr edebug-data
-		(cons (delq edebug-break-data edebug-breakpoints)
-		      (cdr (cdr edebug-data)))))
-
-    ;; Display if mode is not go, continue, or Continue-fast
-    ;; or break, or input is pending, 
-    (if (or (not (memq edebug-execution-mode '(go continue Continue-fast)))
-	    edebug-break
-	    (edebug-input-pending-p))
-	(edebug-display))   ; <--------------- display
-    
-    edebug-value
-    ))
-
-
-;; window-start now stored with each function.
-;;(defvar edebug-window-start nil)
-;; Remember where each buffers' window starts between edebug calls.
-;; This is to avoid spurious recentering.
-;; Does this still need to be buffer-local??
-;;(setq-default edebug-window-start nil)
-;;(make-variable-buffer-local 'edebug-window-start)
-
-
-;; Dynamically declared unbound vars
-(defvar edebug-point) ; the point in edebug buffer
-(defvar edebug-outside-buffer) ; the current-buffer outside of edebug
-(defvar edebug-outside-point) ; the point outside of edebug
-(defvar edebug-outside-mark) ; the mark outside of edebug
-(defvar edebug-window-data)  ; window and window-start for current function
-(defvar edebug-outside-windows) ; outside window configuration
-(defvar edebug-eval-buffer) ; for the evaluation list.
-(defvar edebug-outside-o-a-p) ; outside overlay-arrow-position
-(defvar edebug-outside-o-a-s) ; outside overlay-arrow-string
-(defvar edebug-outside-c-i-e-a) ; outside cursor-in-echo-area
-
-(defvar edebug-eval-list nil) ;; List of expressions to evaluate.
-
-(defvar edebug-previous-result nil) ;; Last result returned.
-
-;; Emacs 19 adds an arg to mark and mark-marker.
-(defalias 'edebug-mark 'mark)
-(defalias 'edebug-mark-marker 'mark-marker)
-
-
-(defun edebug-display ()
-  ;; Setup windows for edebug, determine mode, maybe enter recursive-edit.
-  ;; Uses local variables of edebug-enter, edebug-before, edebug-after
-  ;; and edebug-debugger.
-  (let ((edebug-active t)		; for minor mode alist
-	edebug-stop			; should we enter recursive-edit
-	(edebug-point (+ edebug-def-mark
-			 (aref (nth 2 edebug-data) edebug-offset-index)))
-	edebug-buffer-outside-point     ; current point in edebug-buffer
-	;; window displaying edebug-buffer
-	(edebug-window-data (nth 3 edebug-data))
-	(edebug-outside-window (selected-window))
-	(edebug-outside-buffer (current-buffer))
-	(edebug-outside-point (point))
- 	(edebug-outside-mark (edebug-mark))
-	edebug-outside-windows		; window or screen configuration
-	edebug-buffer-points
-	
-	edebug-eval-buffer		; declared here so we can kill it below
-	(edebug-eval-result-list (and edebug-eval-list
-				      (edebug-eval-result-list)))
-	edebug-trace-window
-	edebug-trace-window-start
-
-	(edebug-outside-o-a-p overlay-arrow-position)
-	(edebug-outside-o-a-s overlay-arrow-string)
-	(edebug-outside-c-i-e-a cursor-in-echo-area))
-    (unwind-protect
-	(let ((overlay-arrow-position overlay-arrow-position)
-	      (overlay-arrow-string overlay-arrow-string)
-	      (cursor-in-echo-area nil)
-	      ;; any others??
-	      )
-	  (if (not (buffer-name edebug-buffer))
-	      (let ((debug-on-error nil))
-		(error "Buffer defining %s not found" edebug-function)))
-    
-	  (if (eq 'after edebug-arg-mode)
-	      ;; Compute result string now before windows are modified.
-	      (edebug-compute-previous-result edebug-value))
-
-	  (if edebug-save-windows
-	      ;; Save windows now before we modify them.
-	      (setq edebug-outside-windows 
-		    (edebug-current-windows edebug-save-windows)))
-    
-	  (if edebug-save-displayed-buffer-points
-	      (setq edebug-buffer-points (edebug-get-displayed-buffer-points)))
-
-	  ;; First move the edebug buffer point to edebug-point
-	  ;; so that window start doesn't get changed when we display it.
-	  ;; I don't know if this is going to help.
-	  ;;(set-buffer edebug-buffer)
-	  ;;(goto-char edebug-point)
-
-	  ;; If edebug-buffer is not currently displayed,
-	  ;; first find a window for it.
-	  (edebug-pop-to-buffer edebug-buffer (car edebug-window-data))
-	  (setcar edebug-window-data (selected-window))
-
-	  ;; Now display eval list, if any.
-	  ;; This is done after the pop to edebug-buffer 
-	  ;; so that buffer-window correspondence is correct after quitting.
-	  (edebug-eval-display edebug-eval-result-list)
-	  ;; The evaluation list better not have deleted edebug-window-data.
-	  (select-window (car edebug-window-data))
-	  (set-buffer edebug-buffer)
-
-	  (setq edebug-buffer-outside-point (point))
-	  (goto-char edebug-point)
-	    
-	  (if (eq 'before edebug-arg-mode)
-	      ;; Check whether positions are up-to-date.
-	      ;; This assumes point is never before symbol.
-	      (if (not (memq (following-char) '(?\( ?\# ?\` )))
-		  (let ((debug-on-error nil))
-		    (error "Source has changed - reevaluate definition of %s" 
-			   edebug-function)
-		    )))
-
-	  (setcdr edebug-window-data
-		  (edebug-adjust-window (cdr edebug-window-data)))
-	    
-	  ;; Test if there is input, not including keyboard macros.
-	  (if (edebug-input-pending-p) 
-	      (progn
-		(setq edebug-execution-mode 'step
-		      edebug-stop t)
-		(edebug-stop)
-		;;	    (discard-input)		; is this unfriendly??
-		))
-	  ;; Now display arrow based on mode.
-	  (edebug-overlay-arrow)
-	    
-	  (cond
-	   ((eq 'error edebug-arg-mode)
-	    ;; Display error message
-	    (setq edebug-execution-mode 'step)
-	    (edebug-overlay-arrow)
-	    (beep)
-	    (if (eq 'quit (car edebug-value))
-		(message "Quit")
-	      (edebug-report-error edebug-value)))
-	   (edebug-break
-	    (cond
-	     (edebug-global-break
-	      (message "Global Break: %s => %s" 
-		       edebug-global-break-condition
-		       edebug-global-break-result))
-	     (edebug-break-condition
-	      (message "Break: %s => %s" 
-		       edebug-break-condition 
-		       edebug-break-result))
-	     ((not (eq edebug-execution-mode 'Continue-fast))
-	      (message "Break"))
-	     (t)))
-
-	   (t (message "")))
-
-	  (if (eq 'after edebug-arg-mode)
-	      (progn
-		;; Display result of previous evaluation.
-		(if (and edebug-break
-			 (not (eq edebug-execution-mode 'Continue-fast)))
-		    (sit-for 1))	; Show break message.
-		(edebug-previous-result)))
-    
-	  (cond
-	   (edebug-break
-	    (cond
-	     ((eq edebug-execution-mode 'continue) (edebug-sit-for 1))
-	     ((eq edebug-execution-mode 'Continue-fast) (edebug-sit-for 0))
-	     (t (setq edebug-stop t))))
-	   ;; not edebug-break
-	   ((eq edebug-execution-mode 'trace)
-	    (edebug-sit-for 1))		; Force update and pause.
-	   ((eq edebug-execution-mode 'Trace-fast)
-	    (edebug-sit-for 0))		; Force update and continue.
-	   )
-    
-	  (unwind-protect
-	      (if (or edebug-stop
-		      (memq edebug-execution-mode '(step next))
-		      (eq edebug-arg-mode 'error)) 
-		  (progn
-		    ;; (setq edebug-execution-mode 'step)
-		    ;; (edebug-overlay-arrow)	; This doesn't always show up.
-		    (edebug-recursive-edit))) ; <---------- Recursive edit
-
-	    ;; Reset the edebug-window-data to whatever it is now.
-	    (let ((window (if (eq (window-buffer) edebug-buffer)
-			      (selected-window)
-			    (edebug-get-buffer-window edebug-buffer))))
-	      ;; Remember window-start for edebug-buffer, if still displayed.
-	      (if window
-		  (progn
-		    (setcar edebug-window-data window)
-		    (setcdr edebug-window-data (window-start window)))))
-
-	    ;; Save trace window point before restoring outside windows.
-	    ;; Could generalize this for other buffers.
-	    (setq edebug-trace-window (get-buffer-window edebug-trace-buffer))
-	    (if edebug-trace-window
-		(setq edebug-trace-window-start
-		      (and edebug-trace-window 
-			   (window-start edebug-trace-window))))
-
-	    ;; Restore windows before continuing.
-	    (if edebug-save-windows
-		(progn
-		  (edebug-set-windows edebug-outside-windows)
-
-		  ;; Restore displayed buffer points.
-		  ;; Needed even if restoring windows because
-		  ;; window-points are not restored. (should they be??)
-		  (if edebug-save-displayed-buffer-points
-		      (edebug-set-buffer-points edebug-buffer-points))
-
-		  ;; Unrestore trace window's window-point.
-		  (if edebug-trace-window
-		      (set-window-start edebug-trace-window 
-					edebug-trace-window-start))
-
-		  ;; Unrestore edebug-buffer's window-start, if displayed.
-		  (let ((window (car edebug-window-data)))
-		    (if (and window (edebug-window-live-p window) 
-			     (eq (window-buffer) edebug-buffer))
-			(progn
-			  (set-window-start window (cdr edebug-window-data) 
-					    'no-force)
-			  ;; Unrestore edebug-buffer's window-point.
-			  ;; Needed in addition to setting the buffer point
-			  ;; - otherwise quitting doesn't leave point as is.
-			  ;; But this causes point to not be restored at times.
-			  ;; Also, it may not be a visible window.
-			  ;; (set-window-point window edebug-point)
-			  )))
-
-		  ;; Unrestore edebug-buffer's point.   Rerestored below.
-		  ;;  (goto-char edebug-point) ;; in edebug-buffer
-		  )
-	      ;; Since we may be in a save-excursion, in case of quit,
-	      ;; reselect the outside window only.
-	      ;; Only needed if we are not recovering windows??
-	      (if (edebug-window-live-p edebug-outside-window)
-		  (select-window edebug-outside-window))
-	      )				; if edebug-save-windows
-
-	    ;; Restore current buffer always, in case application needs it.
-	    (set-buffer edebug-outside-buffer)
-	    ;; Restore point, and mark.
-	    ;; Needed even if restoring windows because
-	    ;; that doesn't restore point and mark in the current buffer.
-	    ;; But don't restore point if edebug-buffer is current buffer.
-	    (if (not (eq edebug-buffer edebug-outside-buffer))
-		(goto-char edebug-outside-point))
-	    (if (marker-buffer (edebug-mark-marker))
-		;; Does zmacs-regions need to be nil while doing set-marker?
-		(set-marker (edebug-mark-marker) edebug-outside-mark))
-	    )				; unwind-protect
-	  ;; None of the following is done if quit or signal occurs.
-
-	  ;; Restore edebug-buffer's outside point.
-	  ;;    (edebug-trace "restore edebug-buffer point: %s" 
-	  ;;		  edebug-buffer-outside-point)
-	  (let ((current-buffer (current-buffer)))
-	    (set-buffer edebug-buffer)
-	    (goto-char edebug-buffer-outside-point)
-	    (set-buffer current-buffer))
-	  ;; ... nothing more.
-	  )
-      ;; Reset global variables to outside values in case they were changed.
-      (setq
-       overlay-arrow-position edebug-outside-o-a-p
-       overlay-arrow-string edebug-outside-o-a-s
-       cursor-in-echo-area edebug-outside-c-i-e-a)
-      )))
-
-
-(defvar edebug-number-of-recursions 0)
-;; Number of recursive edits started by edebug.
-;; Should be 0 at the top level.
-
-(defvar edebug-recursion-depth 0)
-;; Value of recursion-depth when edebug was called.
-
-;; Dynamically declared unbound vars
-(defvar edebug-outside-match-data) ; match data outside of edebug
-(defvar edebug-backtrace-buffer) ; each recursive edit gets its own
-(defvar edebug-inside-windows) 
-(defvar edebug-interactive-p)
-
-(defvar edebug-outside-map)
-(defvar edebug-outside-standard-output)
-(defvar edebug-outside-standard-input)
-(defvar edebug-outside-last-command-char)
-(defvar edebug-outside-last-command)
-(defvar edebug-outside-this-command)
-(defvar edebug-outside-last-input-char)
-
-;; Note: here we have defvars for variables that are
-;; built-in in certain versions.
-;; Each defvar makes a difference
-;; in versions where the variable is *not* built-in.
-
-;; Emacs 18
-(defvar edebug-outside-unread-command-char)
-
-;; Lucid Emacs
-(defvar edebug-outside-unread-command-event)  ;; like unread-command-events
-(defvar unread-command-event nil)
-
-;; Emacs 19.
-(defvar edebug-outside-last-command-event)
-(defvar edebug-outside-unread-command-events)
-(defvar edebug-outside-last-input-event)
-(defvar edebug-outside-last-event-frame)
-(defvar edebug-outside-last-nonmenu-event)
-(defvar edebug-outside-track-mouse)
-
-;; Disable byte compiler warnings about unread-command-char and -event
-;; (maybe works with byte-compile-version 2.22 at least)
-(defvar edebug-unread-command-char-warning)
-(defvar edebug-unread-command-event-warning)
-(eval-when-compile
-  (setq edebug-unread-command-char-warning
-	(get 'unread-command-char 'byte-obsolete-variable))
-  (put 'unread-command-char 'byte-obsolete-variable nil)
-  (setq edebug-unread-command-event-warning
-	(get 'unread-command-event 'byte-obsolete-variable))
-  (put 'unread-command-event 'byte-obsolete-variable nil))
-
-(defun edebug-recursive-edit ()
-  ;; Start up a recursive edit inside of edebug.
-  ;; The current buffer is the edebug-buffer, which is put into edebug-mode.
-  ;; Assume that none of the variables below are buffer-local.
-  (let ((edebug-buffer-read-only buffer-read-only)
-	;; match-data must be done in the outside buffer
-	(edebug-outside-match-data
-	 (save-excursion  ; might be unnecessary now??
-	   (set-buffer edebug-outside-buffer)  ; in case match buffer different
-	   (match-data)))
-
-	;;(edebug-number-of-recursions (1+ edebug-number-of-recursions))
-	(edebug-recursion-depth (recursion-depth))
-	edebug-entered			; bind locally to nil
-	(edebug-interactive-p nil)      ; again non-interactive
-	edebug-backtrace-buffer		; each recursive edit gets its own
-	;; The window configuration may be saved and restored
-	;; during a recursive-edit
-	edebug-inside-windows
-
-	(edebug-outside-map (current-local-map))
-
-	(edebug-outside-standard-output standard-output)
-	(edebug-outside-standard-input standard-input)
-	(edebug-outside-defining-kbd-macro defining-kbd-macro)
-
-	(edebug-outside-last-command-char last-command-char)
-	(edebug-outside-last-command last-command)
-	(edebug-outside-this-command this-command)
-	(edebug-outside-last-input-char last-input-char)
-
-	(edebug-outside-unread-command-char unread-command-char)
-
-	(edebug-outside-last-input-event last-input-event)
-	(edebug-outside-last-command-event last-command-event)
-	(edebug-outside-unread-command-event unread-command-event)
-	(edebug-outside-unread-command-events unread-command-events)
-	(edebug-outside-last-event-frame last-event-frame)
-	(edebug-outside-last-nonmenu-event last-nonmenu-event)
-	(edebug-outside-track-mouse track-mouse)
-	)
-
-    (unwind-protect
-	(let (
-	      ;; Declare global values local but using the same global value.
-	      ;; We could set these to the values for previous edebug call.
-	      (last-command-char last-command-char)
-	      (last-command last-command) 
-	      (this-command this-command)
-	      (last-input-char last-input-char)
-
-	      ;; Assume no edebug command sets unread-command-char.
-	      (unread-command-char -1)
-
-	      ;; More for Emacs 19
-	      (last-input-event nil)
-	      (last-command-event nil)
-	      (unread-command-event nil);; lemacs
-	      (unread-command-events nil)
-	      (last-event-frame nil)
-	      (last-nonmenu-event nil)
-	      (track-mouse nil)
-
-	      ;; Bind again to outside values.
-	      (debug-on-error edebug-outside-debug-on-error)
-	      (debug-on-quit edebug-outside-debug-on-quit)
-
-	      ;; Don't keep defining a kbd macro.
-	      (defining-kbd-macro 
-		(if edebug-continue-kbd-macro defining-kbd-macro))
-
-	      ;; others??
-	      )
-
-	  (if (fboundp 'zmacs-deactivate-region);; for lemacs
-	      (zmacs-deactivate-region))
-	  (if (and (eq edebug-execution-mode 'go)
-		   (not (memq edebug-arg-mode '(after error))))
-	      (message "Break"))
-
-	  (setq buffer-read-only t)
-	  (setq signal-hook-function nil)
-
-	  (edebug-mode)
-	  (unwind-protect
-	      (recursive-edit)		;  <<<<<<<<<< Recursive edit
-
-	    ;; Do the following, even if quit occurs.
-	    (setq signal-hook-function 'edebug-signal)
-	    (if edebug-backtrace-buffer
-		(kill-buffer edebug-backtrace-buffer))
-	    ;; Could be an option to keep eval display up.
-	    (if edebug-eval-buffer (kill-buffer edebug-eval-buffer))
-
-	    ;; Remember selected-window after recursive-edit.
-	    ;;      (setq edebug-inside-window (selected-window))
-
-	    (store-match-data edebug-outside-match-data)
-
-	    ;; Recursive edit may have changed buffers,
-	    ;; so set it back before exiting let.
-	    (if (buffer-name edebug-buffer) ; if it still exists
-		(progn
-		  (set-buffer edebug-buffer)
-		  (if (memq edebug-execution-mode '(go Go-nonstop))
-		      (edebug-overlay-arrow))
-		  (setq buffer-read-only edebug-buffer-read-only)
-		  (use-local-map edebug-outside-map)
-		  )
-	      ;; gotta have a buffer to let its buffer local variables be set
-	      (get-buffer-create " bogus edebug buffer"))
-	    ));; inner let
-
-      ;; Reset global vars to outside values, in case they have been changed.
-      (setq 
-       last-command-char edebug-outside-last-command-char
-       last-command-event edebug-outside-last-command-event
-       last-command edebug-outside-last-command
-       this-command edebug-outside-this-command
-       unread-command-char edebug-outside-unread-command-char
-       unread-command-event edebug-outside-unread-command-event
-       unread-command-events edebug-outside-unread-command-events
-       last-input-char edebug-outside-last-input-char
-       last-input-event edebug-outside-last-input-event
-       last-event-frame edebug-outside-last-event-frame
-       last-nonmenu-event edebug-outside-last-nonmenu-event
-       track-mouse edebug-outside-track-mouse
-
-       standard-output edebug-outside-standard-output
-       standard-input edebug-outside-standard-input
-       defining-kbd-macro edebug-outside-defining-kbd-macro
-       ))
-    ))
-
-
-;;; Display related functions
-
-(defun edebug-adjust-window (old-start)
-  ;; If pos is not visible, adjust current window to fit following context.
-;;;  (message "window: %s old-start: %s window-start: %s pos: %s" 
-;;;	   (selected-window) old-start (window-start) (point)) (sit-for 5)
-  (if (not (pos-visible-in-window-p))
-      (progn
-	;; First try old-start
-	(if old-start
-	    (set-window-start (selected-window) old-start))
-	(if (not (pos-visible-in-window-p))
-	    (progn
-;;	(message "resetting window start") (sit-for 2)
-	(set-window-start
-	 (selected-window)
-	 (save-excursion
-	   (forward-line
-	    (if (< (point) (window-start)) -1	; one line before if in back
-	      (- (/ (window-height) 2)) ; center the line moving forward
-	      ))
-	   (beginning-of-line)
-	   (point)))))))
-  (window-start))
-  
-
-
-(defconst edebug-arrow-alist
-  '((Continue-fast . "=")
-    (Trace-fast . "-")
-    (continue . ">")
-    (trace . "->")
-    (step . "=>")
-    (next . "=>")
-    (go . "<>")
-    (Go-nonstop . "..")  ; not used
-    )
-  "Association list of arrows for each edebug mode.")
-
-(defun edebug-overlay-arrow ()
-  ;; Set up the overlay arrow at beginning-of-line in current buffer.
-  ;; The arrow string is derived from edebug-arrow-alist and 
-  ;; edebug-execution-mode.
-  (let ((pos (save-excursion (beginning-of-line) (point))))
-    (setq overlay-arrow-string
-	  (cdr (assq edebug-execution-mode edebug-arrow-alist)))
-    (setq overlay-arrow-position (make-marker))
-    (set-marker overlay-arrow-position pos (current-buffer))))
-
-
-(defun edebug-toggle-save-all-windows ()
-  "Toggle the saving and restoring of all windows.
-Also, each time you toggle it on, the inside and outside window
-configurations become the same as the current configuration."
-  (interactive)
-  (setq edebug-save-windows (not edebug-save-windows))
-  (if edebug-save-windows
-      (setq edebug-inside-windows
-	    (setq edebug-outside-windows
-		  (edebug-current-windows
-		   edebug-save-windows))))
-  (message "Window saving is %s for all windows."
-	   (if edebug-save-windows "on" "off")))
-
-(defmacro edebug-changing-windows (&rest body)
-  (` (let ((window (selected-window)))
-       (setq edebug-inside-windows (edebug-current-windows t))
-       (edebug-set-windows edebug-outside-windows)
-       (,@ body) ;; Code to change edebug-save-windows
-       (setq edebug-outside-windows (edebug-current-windows 
-				     edebug-save-windows))
-       ;; Problem: what about outside windows that are deleted inside?
-       (edebug-set-windows edebug-inside-windows))))
-
-(defun edebug-toggle-save-selected-window ()
-  "Toggle the saving and restoring of the selected window. 
-Also, each time you toggle it on, the inside and outside window
-configurations become the same as the current configuration."
-  (interactive)
-  (cond
-   ((eq t edebug-save-windows)
-    ;; Save all outside windows except the selected one.
-    ;; Remove (selected-window) from outside-windows.
-    (edebug-changing-windows
-     (setq edebug-save-windows (delq window (edebug-window-list)))))
-
-   ((memq (selected-window) edebug-save-windows)
-    (setq edebug-outside-windows
-	  (delq (assq (selected-window) edebug-outside-windows)
-		edebug-outside-windows))
-    (setq edebug-save-windows
-	  (delq (selected-window) edebug-save-windows)))
-   (t					; Save a new window.
-    (edebug-changing-windows
-     (setq edebug-save-windows (cons window edebug-save-windows)))))
-
-  (message "Window saving is %s for %s."
-	   (if (memq (selected-window) edebug-save-windows)
-	       "on" "off")
-	   (selected-window)))
-
-(defun edebug-toggle-save-windows (arg)
-  "Toggle the saving and restoring of windows.
-With prefix, toggle for just the selected window.
-Otherwise, toggle for all windows."
-  (interactive "P")
-  (if arg
-      (edebug-toggle-save-selected-window)
-    (edebug-toggle-save-all-windows)))
-
-
-(defun edebug-where ()
-  "Show the debug windows and where we stopped in the program."
-  (interactive)
-  (if (not edebug-active)
-      (error "Edebug is not active"))
-  ;; Restore the window configuration to what it last was inside.
-  ;; But it is not always set.   - experiment
-  ;;(if edebug-inside-windows
-  ;;  (edebug-set-windows edebug-inside-windows))
-  (edebug-pop-to-buffer edebug-buffer)
-  (goto-char edebug-point))
-
-(defun edebug-view-outside ()
-  "Change to the outside window configuration."
-  (interactive)
-  (if (not edebug-active)
-      (error "Edebug is not active"))
-  (setq edebug-inside-windows 
-	(edebug-current-windows edebug-save-windows))
-  (edebug-set-windows edebug-outside-windows)
-  (goto-char edebug-outside-point)
-  (message "Window configuration outside of Edebug.  Return with %s"
-	   (substitute-command-keys "\\<global-map>\\[edebug-where]")))
-
-
-(defun edebug-bounce-point (arg)
-  "Bounce the point in the outside current buffer.
-If prefix arg is supplied, sit for that many seconds before returning.
-The default is one second."
-  (interactive "p")
-  (if (not edebug-active)
-      (error "Edebug is not active"))
-  (save-excursion
-    ;; If the buffer's currently displayed, avoid set-window-configuration.
-    (save-window-excursion
-      (edebug-pop-to-buffer edebug-outside-buffer)
-      (goto-char edebug-outside-point)
-      (message "Current buffer: %s Point: %s Mark: %s" 
-	       (current-buffer) (point) 
-	       (if (marker-buffer (edebug-mark-marker))
-		   (marker-position (edebug-mark-marker)) "<not set>"))
-      (edebug-sit-for arg)
-      (edebug-pop-to-buffer edebug-buffer (car edebug-window-data)))))
-
-
-;; Joe Wells, here is a start at your idea of adding a buffer to the internal 
-;; display list.  Still need to use this list in edebug-display.
-
-'(defvar edebug-display-buffer-list nil
-  "List of buffers that edebug will display when it is active.")
-
-'(defun edebug-display-buffer (buffer)
-  "Toggle display of a buffer inside of edebug."
-  (interactive "bBuffer: ")
-  (let ((already-displaying (memq buffer edebug-display-buffer-list)))
-    (setq edebug-display-buffer-list
-	  (if already-displaying
-	      (delq buffer edebug-display-buffer-list)
-	    (cons buffer edebug-display-buffer-list)))
-    (message "Displaying %s %s" buffer
-	     (if already-displaying "off" "on"))))
-
-;;; Breakpoint related functions
-
-(defun edebug-find-stop-point ()
-  ;; Return (function . index) of the nearest edebug stop point.
-  (let* ((edebug-def-name (edebug-form-data-symbol))
-	 (edebug-data
-	   (let ((data (get edebug-def-name 'edebug)))
-	     (if (or (null data) (markerp data))
-		 (error "%s is not instrumented for Edebug" edebug-def-name))
-	     data))  ; we could do it automatically, if data is a marker.
-	 ;; pull out parts of edebug-data.
-	 (edebug-def-mark (car edebug-data))
-	 ;; (edebug-breakpoints (car (cdr edebug-data)))
-
-	 (offset-vector (nth 2 edebug-data))
-	 (offset (- (save-excursion
-		      (if (looking-at "[ \t]")
-			  ;; skip backwards until non-whitespace, or bol
-			  (skip-chars-backward " \t"))
-		      (point))
-		    edebug-def-mark))
-	 len i)
-    ;; the offsets are in order so we can do a linear search
-    (setq len (length offset-vector))
-    (setq i 0)
-    (while (and (< i len) (> offset (aref offset-vector i)))
-      (setq i (1+ i)))
-    (if (and (< i len)
-	     (<= offset (aref offset-vector i)))
-	;; return the relevant info
-	(cons edebug-def-name i)
-      (message "Point is not on an expression in %s."
-	       edebug-def-name)
-      )))
-
-
-(defun edebug-next-breakpoint ()
-  "Move point to the next breakpoint, or first if none past point."
-  (interactive)
-  (let ((edebug-stop-point (edebug-find-stop-point)))
-    (if edebug-stop-point
-	(let* ((edebug-def-name (car edebug-stop-point))
-	       (index (cdr edebug-stop-point))
-	       (edebug-data (get edebug-def-name 'edebug))
-	       
-	       ;; pull out parts of edebug-data
-	       (edebug-def-mark (car edebug-data))
-	       (edebug-breakpoints (car (cdr edebug-data)))
-	       (offset-vector (nth 2 edebug-data))
-	       breakpoint)
-	  (if (not edebug-breakpoints)
-	      (message "No breakpoints in this function.")
-	    (let ((breaks edebug-breakpoints))
-	      (while (and breaks
-			  (<= (car (car breaks)) index))
-		(setq breaks (cdr breaks)))
-	      (setq breakpoint
-		    (if breaks
-			(car breaks)
-		      ;; goto the first breakpoint
-		      (car edebug-breakpoints)))
-	      (goto-char (+ edebug-def-mark
-			    (aref offset-vector (car breakpoint))))
-	      
-	      (message "%s"
-		       (concat (if (nth 2 breakpoint)
-				   "Temporary " "")
-			       (if (car (cdr breakpoint))
-				   (format "Condition: %s"
-					   (edebug-safe-prin1-to-string
-					    (car (cdr breakpoint))))
-				 "")))
-	      ))))))
-
-
-(defun edebug-modify-breakpoint (flag &optional condition temporary)
-  "Modify the breakpoint for the form at point or after it according
-to FLAG: set if t, clear if nil.  Then move to that point.
-If CONDITION or TEMPORARY are non-nil, add those attributes to
-the breakpoint.  "  
-  (let ((edebug-stop-point (edebug-find-stop-point)))
-    (if edebug-stop-point
-	(let* ((edebug-def-name (car edebug-stop-point))
-	       (index (cdr edebug-stop-point))
-	       (edebug-data (get edebug-def-name 'edebug))
-	       
-	       ;; pull out parts of edebug-data
-	       (edebug-def-mark (car edebug-data))
-	       (edebug-breakpoints (car (cdr edebug-data)))
-	       (offset-vector (nth 2 edebug-data))
-	       present)
-	  ;; delete it either way
-	  (setq present (assq index edebug-breakpoints))
-	  (setq edebug-breakpoints (delq present edebug-breakpoints))
-	  (if flag
-	      (progn
-		;; add it to the list and resort
-		(setq edebug-breakpoints
-		      (edebug-sort-alist
-		       (cons
-			(list index condition temporary)
-			edebug-breakpoints) '<))
-		(if condition
-		    (message "Breakpoint set in %s with condition: %s"
-			     edebug-def-name condition)
-		  (message "Breakpoint set in %s" edebug-def-name)))
-	    (if present
-		(message "Breakpoint unset in %s" edebug-def-name)
-	      (message "No breakpoint here")))
-	  
-	  (setcar (cdr edebug-data) edebug-breakpoints)
-	  (goto-char (+ edebug-def-mark (aref offset-vector index)))
-	  ))))
-
-(defun edebug-set-breakpoint (arg)
-  "Set the breakpoint of nearest sexp.
-With prefix argument, make it a temporary breakpoint."
-  (interactive "P")
-  (edebug-modify-breakpoint t nil arg))
-
-(defun edebug-unset-breakpoint ()
-  "Clear the breakpoint of nearest sexp."
-  (interactive)
-  (edebug-modify-breakpoint nil))
-
-
-;; For emacs 18, no read-expression-history
-(defun edebug-set-conditional-breakpoint (arg condition)
-  "Set a conditional breakpoint at nearest sexp.
-The condition is evaluated in the outside context.
-With prefix argument, make it a temporary breakpoint."
-  ;; (interactive "P\nxCondition: ")
-  (interactive 
-   (list
-    current-prefix-arg
-    ;; Edit previous condition as follows, but it is cumbersome:
-    (let ((edebug-stop-point (edebug-find-stop-point)))
-      (if edebug-stop-point
-          (let* ((edebug-def-name (car edebug-stop-point))
-                 (index (cdr edebug-stop-point))
-                 (edebug-data (get edebug-def-name 'edebug))
-                 (edebug-breakpoints (car (cdr edebug-data)))
-                 (edebug-break-data (assq index edebug-breakpoints))
-                 (edebug-break-condition (car (cdr edebug-break-data))))
-            (read-minibuffer 
-             (format "Condition in %s: " edebug-def-name)
-             (if edebug-break-condition
-                 (format "%s" edebug-break-condition)
-               (format ""))))))))
-  (edebug-modify-breakpoint t condition arg))
-
-
-(defun edebug-set-global-break-condition (expression)
-  (interactive (list (read-minibuffer 
-		      "Global Condition: " 
-		      (format "%s" edebug-global-break-condition))))
-  (setq edebug-global-break-condition expression))
-
-
-;;; Mode switching functions
-
-(defun edebug-set-mode (mode shortmsg msg)
-  ;; Set the edebug mode to MODE.
-  ;; Display SHORTMSG, or MSG if not within edebug.
-  (if (eq (1+ edebug-recursion-depth) (recursion-depth))
-      (progn
-	(setq edebug-execution-mode mode)
-	(message shortmsg)
-	;; Continue execution
-	(exit-recursive-edit))
-    ;; This is not terribly useful!!
-    (setq edebug-next-execution-mode mode)
-    (message msg)))
-
-
-(defalias 'edebug-step-through-mode 'edebug-step-mode)
-
-(defun edebug-step-mode ()
-  "Proceed to next stop point."
-  (interactive)
-  (edebug-set-mode 'step "" "Edebug will stop at next stop point."))
-
-(defun edebug-next-mode ()
-  "Proceed to next `after' stop point."
-  (interactive)
-  (edebug-set-mode 'next "" "Edebug will stop after next eval."))
-
-(defun edebug-go-mode (arg)
-  "Go, evaluating until break.
-With prefix ARG, set temporary break at current point and go."
-  (interactive "P")
-  (if arg
-      (edebug-set-breakpoint t))
-  (edebug-set-mode 'go "Go..." "Edebug will go until break."))
-
-(defun edebug-Go-nonstop-mode ()
-  "Go, evaluating without debugging."
-  (interactive)
-  (edebug-set-mode 'Go-nonstop "Go-Nonstop..."
-		   "Edebug will not stop at breaks."))
-
-
-(defun edebug-trace-mode ()
-  "Begin trace mode."
-  (interactive)
-  (edebug-set-mode 'trace "Tracing..." "Edebug will trace with pause."))
-
-(defun edebug-Trace-fast-mode ()
-  "Trace with no wait at each step."
-  (interactive)
-  (edebug-set-mode 'Trace-fast
-		   "Trace fast..." "Edebug will trace without pause."))
-
-(defun edebug-continue-mode ()
-  "Begin continue mode."
-  (interactive)
-  (edebug-set-mode 'continue "Continue..."
-		   "Edebug will pause at breakpoints."))
-
-(defun edebug-Continue-fast-mode ()
-  "Trace with no wait at each step."
-  (interactive)
-  (edebug-set-mode 'Continue-fast "Continue fast..."
-		   "Edebug will stop and go at breakpoints."))
-
-;; ------------------------------------------------------------
-;; The following use the mode changing commands and breakpoints.
-
-
-(defun edebug-goto-here ()
-  "Proceed to this stop point."
-  (interactive)
-  (edebug-go-mode t))
-
-
-(defun edebug-stop ()
-  "Stop execution and do not continue.
-Useful for exiting from trace or continue loop."
-  (interactive)
-  (message "Stop"))
-
-
-'(defun edebug-forward ()
-  "Proceed to the exit of the next expression to be evaluated."
-  (interactive)
-  (edebug-set-mode 
-   'forward "Forward"
-   "Edebug will stop after exiting the next expression."))
-
-
-(defun edebug-forward-sexp (arg)
-  "Proceed from the current point to the end of the ARGth sexp ahead.
-If there are not ARG sexps ahead, then do edebug-step-out."
-  (interactive "p")
-  (condition-case nil
-      (let ((parse-sexp-ignore-comments t))
-	;; Call forward-sexp repeatedly until done or failure.
-	(forward-sexp arg)
-	(edebug-go-mode t))
-    (error
-     (edebug-step-out)
-     )))
-
-(defun edebug-step-out ()
-  "Proceed from the current point to the end of the containing sexp.
-If there is no containing sexp that is not the top level defun,
-go to the end of the last sexp, or if that is the same point, then step."
-  (interactive)
-  (condition-case nil
-      (let ((parse-sexp-ignore-comments t))
-	(up-list 1)
-	(save-excursion
-	  ;; Is there still a containing expression?
-	  (up-list 1))
-	(edebug-go-mode t))
-    (error
-     ;; At top level - 1, so first check if there are more sexps at this level.
-     (let ((start-point (point)))
-;;       (up-list 1)
-       (down-list -1)
-       (if (= (point) start-point)
-	   (edebug-step-mode)	; No more at this level, so step.
-	 (edebug-go-mode t)
-	 )))))
-
-(defun edebug-instrument-function (func)
-  ;; Func should be a function symbol.
-  ;; Return the function symbol, or nil if not instrumented.
-  (let ((func-marker))
-    (setq func-marker (get func 'edebug))
-    (cond
-     ((markerp func-marker)
-      ;; It is uninstrumented, so instrument it.
-      (save-excursion
-	(set-buffer (marker-buffer func-marker))
-	(goto-char func-marker)
-	(edebug-eval-top-level-form)
-	func))
-     ((consp func-marker)
-      (message "%s is already instrumented." func)
-      func)
-     (t 
-      ;; We could try harder, e.g. do a tags search.
-      (error "Don't know where %s is defined" func)
-      nil))))
-
-(defun edebug-instrument-callee ()
-  "Instrument the definition of the function or macro about to be called.  
-Do this when stopped before the form or it will be too late.
-One side effect of using this command is that the next time the
-function or macro is called, Edebug will be called there as well."
-  (interactive)
-  (if (not (looking-at "\("))
-      (error "You must be before a list form")
-    (let ((func
-	   (save-excursion
-	     (down-list 1)
-	     (if (looking-at "\(")
-		 (edebug-form-data-name
-		  (edebug-get-form-data-entry (point)))
-	       (edebug-original-read (current-buffer))))))
-      (edebug-instrument-function func))))
-
-
-(defun edebug-step-in ()
-  "Step into the definition of the function or macro about to be called.  
-This first does `edebug-instrument-callee' to ensure that it is 
-instrumented.  Then it does `edebug-on-entry' and switches to `go' mode."
-  (interactive)
-  (let ((func (edebug-instrument-callee)))
-    (if func
-	(progn
-	  (edebug-on-entry func 'temp)
-	  (edebug-go-mode nil)))))
-
-(defun edebug-on-entry (function &optional flag)
-  "Cause Edebug to stop when FUNCTION is called.
-With prefix argument, make this temporary so it is automatically
-cancelled the first time the function is entered."
-  (interactive "aEdebug on entry to: \nP")
-  ;; Could store this in the edebug data instead.
-  (put function 'edebug-on-entry (if flag 'temp t)))
-
-(defun cancel-edebug-on-entry (function)
-  (interactive "aEdebug on entry to: ")
-  (put function 'edebug-on-entry nil))
-
-    
-(if (not (fboundp 'edebug-original-debug-on-entry))
-    (fset 'edebug-original-debug-on-entry (symbol-function 'debug-on-entry)))
-'(fset 'debug-on-entry 'edebug-debug-on-entry)  ;; Should we do this?
-;; Also need edebug-cancel-debug-on-entry
-
-'(defun edebug-debug-on-entry (function)
-  "Request FUNCTION to invoke debugger each time it is called.
-If the user continues, FUNCTION's execution proceeds.
-Works by modifying the definition of FUNCTION,
-which must be written in Lisp, not predefined.
-Use `cancel-debug-on-entry' to cancel the effect of this command.
-Redefining FUNCTION also does that.
-
-This version is from Edebug.  If the function is instrumented for
-Edebug, it calls `edebug-on-entry'"
-  (interactive "aDebug on entry (to function): ")
-  (let ((func-data (get function 'edebug)))
-    (if (or (null func-data) (markerp func-data))
-	(edebug-original-debug-on-entry function)
-      (edebug-on-entry function))))
-
-
-(defun edebug-top-level-nonstop ()
-  "Set mode to Go-nonstop, and exit to top-level.
-This is useful for exiting even if unwind-protect code may be executed."
-  (interactive)
-  (setq edebug-execution-mode 'Go-nonstop)
-  (top-level))
-
-
-;;(defun edebug-exit-out ()
-;;  "Go until the current function exits."
-;;  (interactive)
-;;  (edebug-set-mode 'exiting "Exit..."))
-
-
-;;; The following initial mode setting definitions are not used yet.
-
-'(defconst edebug-initial-mode-alist
-  '((edebug-Continue-fast . Continue-fast)
-    (edebug-Trace-fast . Trace-fast)
-    (edebug-continue . continue)
-    (edebug-trace . trace)
-    (edebug-go . go)
-    (edebug-step-through . step)
-    (edebug-Go-nonstop . Go-nonstop)
-    )
-  "Association list between commands and the modes they set.")
-
-
-'(defun edebug-set-initial-mode ()
-  "Ask for the initial mode of the enclosing function.
-The mode is requested via the key that would be used to set the mode in
-edebug-mode."
-  (interactive)
-  (let* ((this-function (edebug-which-function))
-	 (keymap (if (eq edebug-mode-map (current-local-map))
-		     edebug-mode-map))
-	 (old-mode (or (get this-function 'edebug-initial-mode)
-		       edebug-initial-mode))
-	 (key (read-key-sequence
-	       (format
-		"Change initial edebug mode for %s from %s (%s) to (enter key): "
-		       this-function
-		       old-mode
-		       (where-is-internal
-			(car (rassq old-mode edebug-initial-mode-alist))
-			keymap 'firstonly
-			))))
-	 (mode (cdr (assq (key-binding key) edebug-initial-mode-alist)))
-	 )
-    (if (and mode
-	     (or (get this-function 'edebug-initial-mode)
-		 (not (eq mode edebug-initial-mode))))
-	(progn
-	  (put this-function 'edebug-initial-mode mode)
-	  (message "Initial mode for %s is now: %s"
-		   this-function mode))
-      (error "Key must map to one of the mode changing commands")
-      )))
-
-;;; Evaluation of expressions
-
-(def-edebug-spec edebug-outside-excursion t)
-
-(defmacro edebug-outside-excursion (&rest body)
-  "Evaluate an expression list in the outside context.
-Return the result of the last expression."
-  (` (save-excursion			; of current-buffer
-       (if edebug-save-windows
-	   (progn
-	     ;; After excursion, we will 
-	     ;; restore to current window configuration.
-	     (setq edebug-inside-windows
-		   (edebug-current-windows edebug-save-windows))
-	     ;; Restore outside windows.
-	     (edebug-set-windows edebug-outside-windows)))
-
-       (set-buffer edebug-buffer)  ; why?
-       ;; (use-local-map edebug-outside-map)
-       (store-match-data edebug-outside-match-data)
-       ;; Restore outside context.
-       (let (;; (edebug-inside-map (current-local-map)) ;; restore map??
-	     (last-command-char edebug-outside-last-command-char)
-	     (last-command-event edebug-outside-last-command-event)
-	     (last-command edebug-outside-last-command)
-	     (this-command edebug-outside-this-command)
-	     (unread-command-char edebug-outside-unread-command-char)
-	     (unread-command-event edebug-outside-unread-command-event)
-	     (unread-command-events edebug-outside-unread-command-events)
-	     (last-input-char edebug-outside-last-input-char)
-	     (last-input-event edebug-outside-last-input-event)
-	     (last-event-frame edebug-outside-last-event-frame)
-	     (last-nonmenu-event edebug-outside-last-nonmenu-event)
-	     (track-mouse edebug-outside-track-mouse)
-	     (standard-output edebug-outside-standard-output)
-	     (standard-input edebug-outside-standard-input)
-
-	     (executing-kbd-macro edebug-outside-executing-macro)
-	     (defining-kbd-macro edebug-outside-defining-kbd-macro)
-	     (pre-command-hook edebug-outside-pre-command-hook)
-	     (post-command-hook edebug-outside-post-command-hook)
-
-	     ;; See edebug-display
-	     (overlay-arrow-position edebug-outside-o-a-p)
-	     (overlay-arrow-string edebug-outside-o-a-s)
-	     (cursor-in-echo-area edebug-outside-c-i-e-a)
-	     )
-	 (unwind-protect
-	     (save-excursion		; of edebug-buffer
-	       (set-buffer edebug-outside-buffer)
-	       (goto-char edebug-outside-point)
-	       (if (marker-buffer (edebug-mark-marker))
-		   (set-marker (edebug-mark-marker) edebug-outside-mark))
-	       (,@ body))
-
-	   ;; Back to edebug-buffer.  Restore rest of inside context.
-	   ;; (use-local-map edebug-inside-map)
-	   (if edebug-save-windows
-	       ;; Restore inside windows.
-	       (edebug-set-windows edebug-inside-windows))
-
-	   ;; Save values that may have been changed.
-	   (setq 
-	    edebug-outside-last-command-char last-command-char
-	    edebug-outside-last-command-event last-command-event
-	    edebug-outside-last-command last-command
-	    edebug-outside-this-command this-command
-	    edebug-outside-unread-command-char unread-command-char
-	    edebug-outside-unread-command-event unread-command-event
-	    edebug-outside-unread-command-events unread-command-events
-	    edebug-outside-last-input-char last-input-char
-	    edebug-outside-last-input-event last-input-event
-	    edebug-outside-last-event-frame last-event-frame
-	    edebug-outside-last-nonmenu-event last-nonmenu-event
-	    edebug-outside-track-mouse track-mouse
-	    edebug-outside-standard-output standard-output
-	    edebug-outside-standard-input standard-input
-
-	    edebug-outside-executing-macro executing-kbd-macro
-	    edebug-outside-defining-kbd-macro defining-kbd-macro
-	    edebug-outside-pre-command-hook pre-command-hook
-	    edebug-outside-post-command-hook post-command-hook
-
-	    edebug-outside-o-a-p overlay-arrow-position
-	    edebug-outside-o-a-s overlay-arrow-string
-	    edebug-outside-c-i-e-a cursor-in-echo-area
-	    )))				; let
-       )))
-
-(defvar cl-debug-env nil) ;; defined in cl; non-nil when lexical env used.
-
-(defun edebug-eval (edebug-expr)
-  ;; Are there cl lexical variables active?
-  (if cl-debug-env
-      (eval (cl-macroexpand-all edebug-expr cl-debug-env))
-    (eval edebug-expr)))
-
-(defun edebug-safe-eval (edebug-expr)
-  ;; Evaluate EXPR safely. 
-  ;; If there is an error, a string is returned describing the error.
-  (condition-case edebug-err
-      (edebug-eval edebug-expr)
-    (error (edebug-format "%s: %s"  ;; could 
-			  (get (car edebug-err) 'error-message)
-			  (car (cdr edebug-err))))))
-
-;;; Printing
-
-;; Replace printing functions.
-
-;; obsolete names
-(defalias 'edebug-install-custom-print-funcs 'edebug-install-custom-print)
-(defalias 'edebug-reset-print-funcs 'edebug-uninstall-custom-print)
-(defalias 'edebug-uninstall-custom-print-funcs 'edebug-uninstall-custom-print)
-
-(defun edebug-install-custom-print ()
-  "Replace print functions used by Edebug with custom versions."
-  ;; Modifying the custom print functions, or changing print-length,
-  ;; print-level, print-circle, custom-print-list or custom-print-vector
-  ;; have immediate effect.
-  (interactive)
-  (require 'cust-print)
-  (defalias 'edebug-prin1 'custom-prin1)
-  (defalias 'edebug-print 'custom-print)
-  (defalias 'edebug-prin1-to-string 'custom-prin1-to-string)
-  (defalias 'edebug-format 'custom-format)
-  (defalias 'edebug-message 'custom-message)
-  "Installed")
-
-(eval-and-compile
-  (defun edebug-uninstall-custom-print ()
-    "Replace edebug custom print functions with internal versions."
-    (interactive)
-    (defalias 'edebug-prin1 'prin1)
-    (defalias 'edebug-print 'print)
-    (defalias 'edebug-prin1-to-string 'prin1-to-string)
-    (defalias 'edebug-format 'format)
-    (defalias 'edebug-message 'message)
-    "Uninstalled")
-
-  ;; Default print functions are the same as Emacs'.
-  (edebug-uninstall-custom-print))
-
-
-(defun edebug-report-error (edebug-value)
-  ;; Print an error message like command level does.
-  ;; This also prints the error name if it has no error-message.
-  (message "%s: %s" 
-	   (or (get (car edebug-value) 'error-message)
-	       (format "peculiar error (%s)" (car edebug-value)))
-	   (mapconcat (function (lambda (edebug-arg) 
-				  ;; continuing after an error may
-				  ;; complain about edebug-arg. why??
-				  (prin1-to-string edebug-arg)))
-		      (cdr edebug-value) ", ")))
-
-;; Define here in case they are not already defined.
-(defvar print-level nil)
-(defvar print-circle nil)
-(defvar print-readably) ;; defined by lemacs
-;; Alternatively, we could change the definition of 
-;; edebug-safe-prin1-to-string to only use these if defined.
-
-(defun edebug-safe-prin1-to-string (value)
-  (let ((print-escape-newlines t)
-	(print-length (or edebug-print-length print-length))
-	(print-level (or edebug-print-level print-level))
-	(print-circle (or edebug-print-circle print-circle))
-	(print-readably nil)) ;; lemacs uses this.
-    (edebug-prin1-to-string value)))
-
-(defun edebug-compute-previous-result (edebug-previous-value)
-  (setq edebug-previous-result
-	(if (and (numberp edebug-previous-value)
-		 (< edebug-previous-value 256)
-		 (>= edebug-previous-value 0))
-	    (format "Result: %s = %s" edebug-previous-value
-		    (single-key-description edebug-previous-value))
-	  (if edebug-unwrap-results
-	      (setq edebug-previous-value 
-		    (edebug-unwrap* edebug-previous-value)))
-	  (concat "Result: " 
-		  (edebug-safe-prin1-to-string edebug-previous-value)))))
-
-(defun edebug-previous-result ()
-  "Print the previous result."
-  (interactive)
-  (message "%s" edebug-previous-result))
-
-;;; Read, Eval and Print
-
-(defun edebug-eval-expression (edebug-expr)
-  "Evaluate an expression in the outside environment.  
-If interactive, prompt for the expression.
-Print result in minibuffer."
-  (interactive "xEval: ")
-  (princ
-   (edebug-outside-excursion
-    (setq values (cons (edebug-eval edebug-expr) values))
-    (edebug-safe-prin1-to-string (car values)))))
-
-(defun edebug-eval-last-sexp ()
-  "Evaluate sexp before point in the outside environment;
-print value in minibuffer."
-  (interactive)
-  (edebug-eval-expression (edebug-last-sexp)))
-
-(defun edebug-eval-print-last-sexp ()
-  "Evaluate sexp before point in the outside environment; 
-print value into current buffer."
-  (interactive)
-  (let* ((edebug-form (edebug-last-sexp))
-	 (edebug-result-string
-	  (edebug-outside-excursion 
-	   (edebug-safe-prin1-to-string (edebug-safe-eval edebug-form))))
-	 (standard-output (current-buffer)))
-    (princ "\n")
-    ;; princ the string to get rid of quotes.
-    (princ edebug-result-string)
-    (princ "\n")
-    ))
-
-;;; Edebug Minor Mode 
-
-;; Global GUD bindings for all emacs-lisp-mode buffers.
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-s" 'edebug-step-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-n" 'edebug-next-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-c" 'edebug-go-mode)
-(define-key emacs-lisp-mode-map "\C-x\C-a\C-l" 'edebug-where)
-    
-
-(defvar edebug-mode-map nil)
-(if edebug-mode-map
-    nil
-  (progn
-    (setq edebug-mode-map (copy-keymap emacs-lisp-mode-map))
-    ;; control
-    (define-key edebug-mode-map " " 'edebug-step-mode)
-    (define-key edebug-mode-map "n" 'edebug-next-mode)
-    (define-key edebug-mode-map "g" 'edebug-go-mode)
-    (define-key edebug-mode-map "G" 'edebug-Go-nonstop-mode)
-    (define-key edebug-mode-map "t" 'edebug-trace-mode)
-    (define-key edebug-mode-map "T" 'edebug-Trace-fast-mode)
-    (define-key edebug-mode-map "c" 'edebug-continue-mode)
-    (define-key edebug-mode-map "C" 'edebug-Continue-fast-mode)
-
-    ;;(define-key edebug-mode-map "f" 'edebug-forward) not implemented
-    (define-key edebug-mode-map "f" 'edebug-forward-sexp)
-    (define-key edebug-mode-map "h" 'edebug-goto-here)
-
-    (define-key edebug-mode-map "I" 'edebug-instrument-callee)
-    (define-key edebug-mode-map "i" 'edebug-step-in)
-    (define-key edebug-mode-map "o" 'edebug-step-out)
-    
-    ;; quitting and stopping
-    (define-key edebug-mode-map "q" 'top-level)
-    (define-key edebug-mode-map "Q" 'edebug-top-level-nonstop)
-    (define-key edebug-mode-map "a" 'abort-recursive-edit)
-    (define-key edebug-mode-map "S" 'edebug-stop)
-
-    ;; breakpoints
-    (define-key edebug-mode-map "b" 'edebug-set-breakpoint)
-    (define-key edebug-mode-map "u" 'edebug-unset-breakpoint)
-    (define-key edebug-mode-map "B" 'edebug-next-breakpoint)
-    (define-key edebug-mode-map "x" 'edebug-set-conditional-breakpoint)
-    (define-key edebug-mode-map "X" 'edebug-set-global-break-condition)
-    
-    ;; evaluation
-    (define-key edebug-mode-map "r" 'edebug-previous-result)
-    (define-key edebug-mode-map "e" 'edebug-eval-expression)
-    (define-key edebug-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
-    (define-key edebug-mode-map "E" 'edebug-visit-eval-list)
-    
-    ;; views
-    (define-key edebug-mode-map "w" 'edebug-where)
-    (define-key edebug-mode-map "v" 'edebug-view-outside)  ;; maybe obsolete??
-    (define-key edebug-mode-map "p" 'edebug-bounce-point)
-    (define-key edebug-mode-map "P" 'edebug-view-outside) ;; same as v
-    (define-key edebug-mode-map "W" 'edebug-toggle-save-windows)
-
-    ;; misc
-    (define-key edebug-mode-map "?" 'edebug-help)
-    (define-key edebug-mode-map "d" 'edebug-backtrace)
-    
-    (define-key edebug-mode-map "-" 'negative-argument)
-
-    ;; statistics
-    (define-key edebug-mode-map "=" 'edebug-temp-display-freq-count)
-
-    ;; GUD bindings
-    (define-key edebug-mode-map "\C-c\C-s" 'edebug-step-mode)
-    (define-key edebug-mode-map "\C-c\C-n" 'edebug-next-mode)
-    (define-key edebug-mode-map "\C-c\C-c" 'edebug-go-mode)
-
-    (define-key edebug-mode-map "\C-x " 'edebug-set-breakpoint)
-    (define-key edebug-mode-map "\C-c\C-d" 'edebug-unset-breakpoint)
-    (define-key edebug-mode-map "\C-c\C-t" 
-      (function (lambda () (edebug-set-breakpoint t))))
-    (define-key edebug-mode-map "\C-c\C-l" 'edebug-where)
-    ))
-
-;; Autoloading these global bindings doesn't make sense because
-;; they cannot be used anyway unless Edebug is already loaded and active.
-
-(defvar global-edebug-prefix "\^XX"
-  "Prefix key for global edebug commands, available from any buffer.")
-
-(defvar global-edebug-map nil
-  "Global map of edebug commands, available from any buffer.")
-
-(if global-edebug-map
-    nil
-  (setq global-edebug-map (make-sparse-keymap))
-
-  (global-unset-key global-edebug-prefix)
-  (global-set-key global-edebug-prefix global-edebug-map)
-
-  (define-key global-edebug-map " " 'edebug-step-mode)
-  (define-key global-edebug-map "g" 'edebug-go-mode)
-  (define-key global-edebug-map "G" 'edebug-Go-nonstop-mode)
-  (define-key global-edebug-map "t" 'edebug-trace-mode)
-  (define-key global-edebug-map "T" 'edebug-Trace-fast-mode)
-  (define-key global-edebug-map "c" 'edebug-continue-mode)
-  (define-key global-edebug-map "C" 'edebug-Continue-fast-mode)
-
-  ;; breakpoints
-  (define-key global-edebug-map "b" 'edebug-set-breakpoint)
-  (define-key global-edebug-map "u" 'edebug-unset-breakpoint)
-  (define-key global-edebug-map "x" 'edebug-set-conditional-breakpoint)
-  (define-key global-edebug-map "X" 'edebug-set-global-break-condition)
-
-  ;; views
-  (define-key global-edebug-map "w" 'edebug-where)
-  (define-key global-edebug-map "W" 'edebug-toggle-save-windows)
-
-  ;; quitting
-  (define-key global-edebug-map "q" 'top-level)
-  (define-key global-edebug-map "Q" 'edebug-top-level-nonstop)
-  (define-key global-edebug-map "a" 'abort-recursive-edit)
-
-  ;; statistics
-  (define-key global-edebug-map "=" 'edebug-display-freq-count)
-  )
-
-(defun edebug-help ()
-  (interactive)
-  (describe-function 'edebug-mode))
-
-(defun edebug-mode ()
-  "Mode for Emacs Lisp buffers while in Edebug.
-
-In addition to all Emacs Lisp commands (except those that modify the
-buffer) there are local and global key bindings to several Edebug
-specific commands.  E.g. `edebug-step-mode' is bound to \\[edebug-step-mode] 
-in the Edebug buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
-
-Also see bindings for the eval list buffer, *edebug*.
-
-The edebug buffer commands:
-\\{edebug-mode-map}
-
-Global commands prefixed by `global-edebug-prefix':
-\\{global-edebug-map}
-
-Options:
-edebug-setup-hook
-edebug-all-defs
-edebug-all-forms
-edebug-save-windows
-edebug-save-displayed-buffer-points
-edebug-initial-mode
-edebug-trace
-edebug-test-coverage
-edebug-continue-kbd-macro
-edebug-print-length
-edebug-print-level
-edebug-print-circle
-edebug-on-error
-edebug-on-quit
-edebug-on-signal
-edebug-unwrap-results
-edebug-global-break-condition
-"
-  (use-local-map edebug-mode-map))
-
-;;; edebug eval list mode
-
-;; A list of expressions and their evaluations is displayed in *edebug*.
-
-(defun edebug-eval-result-list ()
-  "Return a list of evaluations of edebug-eval-list"
-  ;; Assumes in outside environment.
-  ;; Don't do any edebug things now.
-  (let ((edebug-execution-mode 'Go-nonstop)
-	(edebug-trace nil)) 
-    (mapcar 'edebug-safe-eval edebug-eval-list)))
-
-(defun edebug-eval-display-list (edebug-eval-result-list)
-  ;; Assumes edebug-eval-buffer exists.
-  (let ((edebug-eval-list-temp edebug-eval-list)
-	(standard-output edebug-eval-buffer)
-	(edebug-comment-line
-	 (format ";%s\n" (make-string (- (window-width) 2) ?-))))
-    (set-buffer edebug-eval-buffer)
-    (erase-buffer)
-    (while edebug-eval-list-temp
-      (prin1 (car edebug-eval-list-temp)) (terpri)
-      (prin1 (car edebug-eval-result-list)) (terpri)
-      (princ edebug-comment-line)
-      (setq edebug-eval-list-temp (cdr edebug-eval-list-temp))
-      (setq edebug-eval-result-list (cdr edebug-eval-result-list)))
-    (edebug-pop-to-buffer edebug-eval-buffer)
-    ))
-
-(defun edebug-create-eval-buffer ()
-  (if (not (and edebug-eval-buffer (buffer-name edebug-eval-buffer)))
-      (progn
-	(set-buffer (setq edebug-eval-buffer (get-buffer-create "*edebug*")))
-	(edebug-eval-mode))))
-
-;; Should generalize this to be callable outside of edebug
-;; with calls in user functions, e.g. (edebug-eval-display)
-
-(defun edebug-eval-display (edebug-eval-result-list)
-  "Display expressions and evaluations in EVAL-LIST.
-It modifies the context by popping up the eval display."
-  (if edebug-eval-result-list
-      (progn
-	(edebug-create-eval-buffer)
-	(edebug-eval-display-list edebug-eval-result-list)
-	)))
-
-(defun edebug-eval-redisplay ()
-  "Redisplay eval list in outside environment.
-May only be called from within edebug-recursive-edit."
-  (edebug-create-eval-buffer)
-  (edebug-outside-excursion
-   (edebug-eval-display-list (edebug-eval-result-list))
-   ))
-
-(defun edebug-visit-eval-list ()
-  (interactive)
-  (edebug-eval-redisplay)
-  (edebug-pop-to-buffer edebug-eval-buffer))
-
-
-(defun edebug-update-eval-list ()
-  "Replace the evaluation list with the sexps now in the eval buffer."
-  (interactive)
-  (let ((starting-point (point))
-	new-list)
-    (goto-char (point-min))
-    ;; get the first expression
-    (edebug-skip-whitespace)
-    (if (not (eobp))
-	(progn
-	  (forward-sexp 1)
-	  (setq new-list (cons (edebug-last-sexp) new-list))))
-    
-    (while (re-search-forward "^;" nil t)
-      (forward-line 1)
-      (skip-chars-forward " \t\n\r")
-      (if (and (/= ?\; (following-char))
-	       (not (eobp)))
-	  (progn
-	    (forward-sexp 1)
-	    (setq new-list (cons (edebug-last-sexp) new-list)))))
-    
-    (setq edebug-eval-list (nreverse new-list))
-    (edebug-eval-redisplay)
-    (goto-char starting-point)))
-
-
-(defun edebug-delete-eval-item ()
-  "Delete the item under point and redisplay."
-  ;; could add arg to do repeatedly
-  (interactive)
-  (if (re-search-backward "^;" nil 'nofail)
-      (forward-line 1))
-  (delete-region
-   (point) (progn (re-search-forward "^;" nil 'nofail)
-		  (beginning-of-line)
-		  (point)))
-  (edebug-update-eval-list))
-
-
-
-(defvar edebug-eval-mode-map nil
-  "Keymap for edebug-eval-mode.  Superset of lisp-interaction-mode.")
-
-(if edebug-eval-mode-map
-    nil
-  (setq edebug-eval-mode-map (copy-keymap lisp-interaction-mode-map))
-  
-  (define-key edebug-eval-mode-map "\C-c\C-w" 'edebug-where)
-  (define-key edebug-eval-mode-map "\C-c\C-d" 'edebug-delete-eval-item)
-  (define-key edebug-eval-mode-map "\C-c\C-u" 'edebug-update-eval-list)
-  (define-key edebug-eval-mode-map "\C-x\C-e" 'edebug-eval-last-sexp)
-  (define-key edebug-eval-mode-map "\C-j" 'edebug-eval-print-last-sexp)
-  )
-
-
-(defun edebug-eval-mode ()
-  "Mode for evaluation list buffer while in Edebug.
-
-In addition to all Interactive Emacs Lisp commands there are local and
-global key bindings to several Edebug specific commands.  E.g.
-`edebug-step-mode' is bound to \\[edebug-step-mode] in the Edebug
-buffer and \\<global-map>\\[edebug-step-mode] in any buffer.
-
-Eval list buffer commands:
-\\{edebug-eval-mode-map}
-
-Global commands prefixed by global-edebug-prefix:
-\\{global-edebug-map}
-"
-  (lisp-interaction-mode)
-  (setq major-mode 'edebug-eval-mode)
-  (setq mode-name "Edebug-Eval")
-  (use-local-map edebug-eval-mode-map))
-
-;;; Interface with standard debugger.
-
-;; (setq debugger 'edebug) ; to use the edebug debugger
-;; (setq debugger 'debug)  ; use the standard debugger
-
-;; Note that debug and its utilities must be byte-compiled to work,
-;; since they depend on the backtrace looking a certain way.  But
-;; edebug is not dependent on this, yet.
-
-(defun edebug (&optional edebug-arg-mode &rest debugger-args)
-  "Replacement for debug.  
-If we are running an edebugged function,
-show where we last were.  Otherwise call debug normally."
-;;  (message "entered: %s  depth: %s  edebug-recursion-depth: %s"
-;;	   edebug-entered (recursion-depth) edebug-recursion-depth) (sit-for 1)
-  (if (and edebug-entered  ; anything active?
-	   (eq (recursion-depth) edebug-recursion-depth))
-      (let (;; Where were we before the error occurred?
-	    (edebug-offset-index (car edebug-offset-indices))
-	    ;; Bind variables required by edebug-display
-	    (edebug-value (car debugger-args))
-	    edebug-breakpoints
-	    edebug-break-data
-	    edebug-break-condition
-	    edebug-global-break
-	    (edebug-break (null edebug-arg-mode)) ;; if called explicitly
-	    )
-	(edebug-display)
-	(if (eq edebug-arg-mode 'error) 
-	    nil
-	  edebug-value))
-
-    ;; Otherwise call debug normally.
-    ;; Still need to remove extraneous edebug calls from stack.
-    (apply 'debug edebug-arg-mode debugger-args)
-    ))
-
-
-(defun edebug-backtrace ()
-  "Display a non-working backtrace.  Better than nothing..."
-  (interactive)
-  (if (or (not edebug-backtrace-buffer)
-	  (null (buffer-name edebug-backtrace-buffer)))
-      (setq edebug-backtrace-buffer
-	    (generate-new-buffer "*Backtrace*"))
-    ;; else, could just display edebug-backtrace-buffer
-    )
-  (with-output-to-temp-buffer (buffer-name edebug-backtrace-buffer)
-    (setq edebug-backtrace-buffer standard-output)
-    (let ((print-escape-newlines t)
-	  (print-length 50)
-	  last-ok-point)
-      (backtrace)
-
-      ;; Clean up the backtrace.  
-      ;; Not quite right for current edebug scheme.
-      (set-buffer edebug-backtrace-buffer)
-      (setq truncate-lines t)
-      (goto-char (point-min))
-      (setq last-ok-point (point))
-      (if t (progn
-
-      ;; Delete interspersed edebug internals.
-      (while (re-search-forward "^  \(?edebug" nil t)
-	(beginning-of-line)
-	(cond 
-	 ((looking-at "^  \(edebug-after")
-	  ;; Previous lines may contain code, so just delete this line
-	  (setq last-ok-point (point))
-	  (forward-line 1)
-	  (delete-region last-ok-point (point)))
-
-	 ((looking-at "^  edebug")
-	  (forward-line 1)
-	  (delete-region last-ok-point (point))
-	  )))
-      )))))
-
-
-;;; Trace display
-
-(defun edebug-trace-display (buf-name fmt &rest args)
-  "In buffer BUF-NAME, display FMT and ARGS at the end and make it visible.
-The buffer is created if it does not exist.
-You must include newlines in FMT to break lines, but one newline is appended."
-;; e.g.
-;;	 (edebug-trace-display "*trace-point*"
-;;	  "saving: point = %s  window-start = %s"
-;;	  (point) (window-start))
-  (let* ((oldbuf (current-buffer))
-	 (selected-window (selected-window))
-	 (buffer (get-buffer-create buf-name))
-	 buf-window)
-;;    (message "before pop-to-buffer") (sit-for 1)
-    (edebug-pop-to-buffer buffer)
-    (setq truncate-lines t)
-    (setq buf-window (selected-window))
-    (goto-char (point-max))
-    (insert (apply 'edebug-format fmt args) "\n")
-    ;; Make it visible.
-    (vertical-motion (- 1 (window-height)))
-    (set-window-start buf-window (point))
-    (goto-char (point-max))
-;;    (set-window-point buf-window (point))
-;;    (edebug-sit-for 0)
-    (bury-buffer buffer)
-    (select-window selected-window)
-    (set-buffer oldbuf))
-  buf-name)
-
-
-(defun edebug-trace (fmt &rest args)
-  "Convenience call to edebug-trace-display using edebug-trace-buffer"
-  (apply 'edebug-trace-display edebug-trace-buffer fmt args))
-
-
-;;; Frequency count and coverage
-
-(defun edebug-display-freq-count ()
-  "Display the frequency count data for each line of the current
-definition.  The frequency counts are inserted as comment lines after
-each line, and you can undo all insertions with one `undo' command.
-
-The counts are inserted starting under the `(' before an expression
-or the `)' after an expression, or on the last char of a symbol.
-The counts are only displayed when they differ from previous counts on
-the same line.
-
-If coverage is being tested, whenever all known results of an expression
-are `eq', the char `=' will be appended after the count
-for that expression.  Note that this is always the case for an
-expression only evaluated once.
-
-To clear the frequency count and coverage data for a definition,
-reinstrument it."
-  (interactive)
-  (let* ((function (edebug-form-data-symbol))
-	 (counts (get function 'edebug-freq-count))
-	 (coverages (get function 'edebug-coverage))
-	 (data (get function 'edebug))
-	 (def-mark (car data))	; mark at def start
-	 (edebug-points (nth 2 data))
-	 (i (1- (length edebug-points)))
-	 (last-index)
-	 (first-index)
-	 (start-of-line)
-	 (start-of-count-line)
-	 (last-count)
-	 )
-    (save-excursion
-      ;; Traverse in reverse order so offsets are correct.
-      (while (<= 0 i)
-	;; Start at last expression in line.
-	(goto-char (+ def-mark (aref edebug-points i)))
-	(beginning-of-line)
-	(setq start-of-line (- (point) def-mark)
-	      last-index i)
-
-	;; Find all indexes on same line.
-	(while (and (<= 0 (setq i (1- i))) 
-		    (<= start-of-line (aref edebug-points i))))
-	;; Insert all the indices for this line.
-	(forward-line 1)
-	(setq start-of-count-line (point)
-	      first-index i   ; really last index for line above this one.
-	      last-count -1)  ; cause first count to always appear.
-	(insert ";#")
-	;; i == first-index still
-	(while (<= (setq i (1+ i)) last-index)
-	  (let ((count (aref counts i))
-		(coverage (aref coverages i))
-		(col (save-excursion
-		       (goto-char (+ (aref edebug-points i) def-mark))
-		       (- (current-column)
-			  (if (= ?\( (following-char)) 0 1)))))
-	    (insert (make-string 
-		     (max 0 (- col (- (point) start-of-count-line))) ?\ )
-		    (if (and (< 0 count)
-			     (not (memq coverage 
-					'(unknown ok-coverage))))
-			"=" "")
-		    (if (= count last-count) "" (int-to-string count))
-		    " ")
-	    (setq last-count count)))
-	(insert "\n")
-	(setq i first-index)))))
-
-(defun edebug-temp-display-freq-count ()
-  "Temporarily display the frequency count data for the current definition.
-It is removed when you hit any char."
-  ;; This seems not to work with Emacs 18.59. It undoes too far.
-  (interactive)
-  (let ((buffer-read-only nil))
-    (undo-boundary)
-    (edebug-display-freq-count)
-    (setq unread-command-char (read-char))
-    (undo)))
-
-
-;;; Menus
-
-(defun edebug-toggle (variable)
-  (set variable (not (eval variable)))
-  (message "%s: %s" variable (eval variable)))
-
-;; We have to require easymenu (even for Emacs 18) just so
-;; the easy-menu-define macro call is compiled correctly.
-(require 'easymenu)
-
-(defconst edebug-mode-menus
-  '("Edebug"
-     "----"
-     ["Stop" edebug-stop t]
-     ["Step" edebug-step-mode t]
-     ["Next" edebug-next-mode t]
-     ["Trace" edebug-trace-mode t]
-     ["Trace Fast" edebug-Trace-fast-mode t]
-     ["Continue" edebug-continue-mode t]
-     ["Continue Fast" edebug-Continue-fast-mode t]
-     ["Go" edebug-go-mode t]
-     ["Go Nonstop" edebug-Go-nonstop-mode t]
-     "----"
-     ["Help" edebug-help t]
-     ["Abort" abort-recursive-edit t]
-     ["Quit to Top Level"  top-level t]
-     ["Quit Nonstop" edebug-top-level-nonstop t]
-     "----"
-    ("Jumps"
-     ["Forward Sexp" edebug-forward-sexp t]
-     ["Step In" edebug-step-in t]
-     ["Step Out" edebug-step-out t]
-     ["Goto Here" edebug-goto-here t])
-
-    ("Breaks"
-     ["Set Breakpoint" edebug-set-breakpoint t]
-     ["Unset Breakpoint" edebug-unset-breakpoint t]
-     ["Set Conditional Breakpoint" edebug-set-conditional-breakpoint t]
-     ["Set Global Break Condition" edebug-set-global-break-condition t]
-     ["Show Next Breakpoint" edebug-next-breakpoint t])
-
-    ("Views"
-     ["Where am I?" edebug-where t]
-     ["Bounce to Current Point" edebug-bounce-point t]
-     ["View Outside Windows" edebug-view-outside t]
-     ["Previous Result" edebug-previous-result t]
-     ["Show Backtrace" edebug-backtrace t]
-     ["Display Freq Count" edebug-display-freq-count t])
-
-    ("Eval"
-     ["Expression" edebug-eval-expression t]
-     ["Last Sexp" edebug-eval-last-sexp t]
-     ["Visit Eval List" edebug-visit-eval-list t])
-
-    ("Options"
-     ["Edebug All Defs" edebug-all-defs t]
-     ["Edebug All Forms" edebug-all-forms t]
-     "----"
-     ["Toggle Tracing" (edebug-toggle 'edebug-trace) t]
-     ["Toggle Coverage Testing" (edebug-toggle 'edebug-test-coverage) t]
-     ["Toggle Window Saving" edebug-toggle-save-windows t]
-     ["Toggle Point Saving" 
-      (edebug-toggle 'edebug-save-displayed-buffer-points) t]
-     ))
-  "Lemacs style menus for Edebug.")
-
-
-;;; Emacs version specific code
-
-;;; The default for all above is Emacs 18, because it is easier to compile
-;;; Emacs 18 code in Emacs 19 than vice versa.  This default will
-;;; change once most people are using Emacs 19 or derivatives.
-
-;; Epoch specific code is in a separate file: edebug-epoch.el.
-
-;; The byte-compiler will complain about changes in number of arguments
-;; to functions like mark and read-from-minibuffer.  These warnings
-;; may be ignored because the right call should always be made.
-
-(defun edebug-emacs-19-specific ()
-
-  (defalias 'edebug-window-live-p 'window-live-p)
-
-  ;; Mark takes an argument in Emacs 19.
-  (defun edebug-mark ()
-    (mark t));; Does this work for lemacs too?
-
-  (defun edebug-set-conditional-breakpoint (arg condition)
-    "Set a conditional breakpoint at nearest sexp.
-The condition is evaluated in the outside context.
-With prefix argument, make it a temporary breakpoint."
-    ;; (interactive "P\nxCondition: ")
-    (interactive 
-     (list
-      current-prefix-arg
-      ;; Read condition as follows; getting previous condition is cumbersome:
-      (let ((edebug-stop-point (edebug-find-stop-point)))
-	(if edebug-stop-point
-	    (let* ((edebug-def-name (car edebug-stop-point))
-		   (index (cdr edebug-stop-point))
-		   (edebug-data (get edebug-def-name 'edebug))
-		   (edebug-breakpoints (car (cdr edebug-data)))
-		   (edebug-break-data (assq index edebug-breakpoints))
-		   (edebug-break-condition (car (cdr edebug-break-data)))
-		   (edebug-expression-history
-		    ;; Prepend the current condition, if any.
-		    (if edebug-break-condition
-			(cons edebug-break-condition read-expression-history)
-		      read-expression-history)))
-	      (prog1
-		  (read-from-minibuffer 
-		   "Condition: " nil read-expression-map t
-		   'edebug-expression-history)
-		(setq read-expression-history edebug-expression-history)
-		))))))
-    (edebug-modify-breakpoint t condition arg))
-
-  (defun edebug-eval-expression (edebug-expr)
-    "Evaluate an expression in the outside environment.  
-If interactive, prompt for the expression.
-Print result in minibuffer."
-    (interactive (list (read-from-minibuffer 
-			"Eval: " nil read-expression-map t
-			'read-expression-history)))
-    (princ
-     (edebug-outside-excursion
-      (setq values (cons (edebug-eval edebug-expr) values))
-      (edebug-safe-prin1-to-string (car values)))))
-
-  (easy-menu-define edebug-menu edebug-mode-map "Edebug menus" edebug-mode-menus)
-  (if window-system
-      (x-popup-menu nil (lookup-key edebug-mode-map [menu-bar Edebug])))
-  )
-
-
-(defun edebug-lemacs-specific ()
-
-  ;; We need to bind zmacs-regions to nil around all calls to `mark' and
-  ;; `mark-marker' but don't bind it to nil before entering a recursive edit,
-  ;; that is, don't interfere with the binding the user might see while 
-  ;; executing a command.
-
-  (defvar zmacs-regions)
-  
-  (defun edebug-mark ()
-    (let ((zmacs-regions nil))
-      (mark)))
-
-  (defun edebug-mark-marker ()
-    (let ((zmacs-regions nil));; for lemacs
-      (mark-marker)))
-
-
-  (defun edebug-mode-menu (event)
-    (interactive "@event")
-    (popup-menu edebug-mode-menus))
-
-  (define-key edebug-mode-map 'button3 'edebug-mode-menu)
-  )
-
-(defun edebug-emacs-version-specific ()
-  (cond 
-   ((string-match "Lucid" emacs-version);; Lucid Emacs
-    (edebug-lemacs-specific))
-
-   ((and (boundp 'epoch::version) epoch::version)
-    (require 'edebug-epoch))
-
-   ((not (string-match "^18" emacs-version))
-    (edebug-emacs-19-specific))))
-
-(edebug-emacs-version-specific)
-
-
-;;; Byte-compiler
-
-;; Extension for bytecomp to resolve undefined function references.
-;; Requires new byte compiler.
-
-;; Reenable byte compiler warnings about unread-command-char and -event.
-;; Disabled before edebug-recursive-edit.
-(eval-when-compile
-  (if edebug-unread-command-char-warning
-      (put 'unread-command-char 'byte-obsolete-variable 
-	   edebug-unread-command-char-warning))
-  (if edebug-unread-command-event-warning
-      (put 'unread-command-event 'byte-obsolete-variable 
-	   edebug-unread-command-event-warning)))
-
-(eval-when-compile
-  ;; The body of eval-when-compile seems to get evaluated with eval-defun.
-  ;; We only want to evaluate when actually byte compiling.
-  ;; But it is OK to evaluate as long as byte-compiler has been loaded.
-  (if (featurep 'byte-compile) (progn
-
-  (defun byte-compile-resolve-functions (funcs)
-    "Say it is OK for the named functions to be unresolved."
-    (mapcar 
-     (function 
-      (lambda (func)
-	(setq byte-compile-unresolved-functions
-	      (delq (assq func byte-compile-unresolved-functions)
-		    byte-compile-unresolved-functions))))
-     funcs)
-    nil)
-  
-  '(defun byte-compile-resolve-free-references (vars)
-     "Say it is OK for the named variables to be referenced."
-     (mapcar 
-      (function 
-       (lambda (var)
-	 (setq byte-compile-free-references
-	       (delq var byte-compile-free-references))))
-      vars)
-     nil)
-
-  '(defun byte-compile-resolve-free-assignments (vars)
-     "Say it is OK for the named variables to be assigned."
-     (mapcar 
-      (function 
-       (lambda (var)
-	 (setq byte-compile-free-assignments
-	       (delq var byte-compile-free-assignments))))
-      vars)
-     nil)
-
-  (byte-compile-resolve-functions 
-   '(reporter-submit-bug-report 
-     edebug-gensym ;; also in cl.el
-     ;; Interfaces to standard functions.
-     edebug-original-eval-defun 
-     edebug-original-read
-     edebug-get-buffer-window
-     edebug-mark
-     edebug-mark-marker
-     edebug-input-pending-p 
-     edebug-sit-for
-     edebug-prin1-to-string 
-     edebug-format
-     ;; lemacs
-     zmacs-deactivate-region
-     popup-menu
-     ;; CL
-     cl-macroexpand-all
-     ;; And believe it or not, the byte compiler doesn't know about:
-     byte-compile-resolve-functions
-     ))
-
-  '(byte-compile-resolve-free-references
-    '(read-expression-history
-      read-expression-map))
-
-  '(byte-compile-resolve-free-assignments
-    '(read-expression-history))
-
-  )))
-
-
-;;; Autoloading of Edebug accessories
-
-(if (featurep 'cl)
-    (add-hook 'edebug-setup-hook
-	      (function (lambda () (require 'cl-specs))))
-  ;; The following causes cl-specs to be loaded if you load cl.el.
-  (add-hook 'cl-load-hook
-	    (function (lambda () (require 'cl-specs)))))
-
-;;; edebug-cl-read and cl-read are available from liberte@cs.uiuc.edu 
-(if (featurep 'cl-read)
-    (add-hook 'edebug-setup-hook
-	      (function (lambda () (require 'edebug-cl-read))))
-  ;; The following causes edebug-cl-read to be loaded when you load cl-read.el.
-  (add-hook 'cl-read-load-hooks
-	    (function (lambda () (require 'edebug-cl-read)))))
-
-
-;;; Finalize Loading
-
-;;; Finally, hook edebug into the rest of Emacs.
-;;; There are probably some other things that could go here.
-
-;; Install edebug read and eval functions.
-(edebug-install-read-eval-functions)
-
-(provide 'edebug)
-
-;;; edebug.el ends here
diff --git a/lisp/emacs-lisp/eldoc.el b/lisp/emacs-lisp/eldoc.el
deleted file mode 100644
index ff84819c748..00000000000
--- a/lisp/emacs-lisp/eldoc.el
+++ /dev/null
@@ -1,458 +0,0 @@
-;;; eldoc.el --- show function arglist or variable docstring in echo area
-
-;; Copyright (C) 1995 Noah S. Friedman
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: extensions
-;; Status: Works in Emacs 19 and XEmacs.
-;; Created: 1995-10-06
-
-;; LCD Archive Entry:
-;; eldoc|Noah Friedman|friedman@prep.ai.mit.edu|
-;; show function arglist or variable docstring in echo area|
-;; $Date: 1996/07/14 16:46:25 $|$Revision: 1.6 $|~/misc/eldoc.el.gz|
-
-;; $Id: eldoc.el,v 1.6 1996/07/14 16:46:25 friedman Exp friedman $
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; This program was inspired by the behavior of the Lisp Machine "mouse
-;; documentation window"; as you type a function's symbol name as part of a
-;; sexp, it will print the argument list for that function.  However, this
-;; program's behavior is different in a couple of significant ways.  For
-;; one, you need not actually type the function name; you need only move
-;; point around in a sexp that calls it.  However, if point is over a
-;; documented variable, it will print the one-line documentation for that
-;; variable instead, to remind you of that variable's purpose.
-
-;; One useful way to enable this minor mode is to put the following in your
-;; .emacs:
-;;
-;;      (autoload 'turn-on-eldoc-mode "eldoc" nil t)
-;;      (add-hook 'emacs-lisp-mode-hook 'turn-on-eldoc-mode)
-;;      (add-hook 'lisp-interaction-mode-hook 'turn-on-eldoc-mode)
-
-;;; Code:
-
-;;;###autoload
-(defvar eldoc-mode nil
-  "*If non-nil, show the defined parameters for the elisp function near point.
-
-For the emacs lisp function at the beginning of the sexp which point is
-within, show the defined parameters for the function in the echo area.
-This information is extracted directly from the function or macro if it is
-in pure lisp.
-
-If the emacs function is a subr, the parameters are obtained from the
-documentation string if possible.
-
-If point is over a documented variable, print that variable's docstring
-instead; see function `eldoc-print-var-docstring'.
-
-This variable is buffer-local.")
-(make-variable-buffer-local 'eldoc-mode)
-
-(defvar eldoc-idle-delay 0.50
-  "*Number of seconds of idle time to wait before printing.
-If user input arrives before this interval of time has elapsed after the
-last input, no documentation will be printed.
-
-If this variable is set to 0, no idle time is required.")
-
-(defvar eldoc-argument-case 'upcase
-  "Case to display argument names of functions, as a symbol.
-This has two preferred values: `upcase' or `downcase'.
-Actually, any name of a function which takes a string as an argument and
-returns another string is acceptable.")
-
-(defvar eldoc-mode-message-commands nil
-  "*Obarray of command names where it is appropriate to print in the echo area.
-
-This is not done for all commands since some print their own
-messages in the echo area, and these functions would instantly overwrite
-them.  But self-insert-command as well as most motion commands are good
-candidates.
-
-It is probably best to manipulate this data structure with the commands
-`eldoc-add-command' and `eldoc-remove-command'.")
-
-(cond ((null eldoc-mode-message-commands)
-       ;; If you increase the number of buckets, keep it a prime number.
-       (setq eldoc-mode-message-commands (make-vector 31 0))
-       (let ((list '("self-insert-command"
-                     "next-"         "previous-"
-                     "forward-"      "backward-"
-                     "beginning-of-" "end-of-"
-                     "goto-"
-                     "recenter"
-                     "scroll-"))
-             (syms nil))
-         (while list
-           (setq syms (all-completions (car list) obarray 'fboundp))
-           (setq list (cdr list))
-           (while syms
-             (set (intern (car syms) eldoc-mode-message-commands) t)
-             (setq syms (cdr syms)))))))
-
-;; Bookkeeping; the car contains the last symbol read from the buffer.
-;; The cdr contains the string last displayed in the echo area, so it can
-;; be printed again if necessary without reconsing.
-(defvar eldoc-last-data '(nil . nil))
-
-(defvar eldoc-minor-mode-string " ElDoc"
-  "*String to display in mode line when Eldoc Mode is enabled.")
-
-;; Put this minor mode on the global minor-mode-alist.
-(or (assq 'eldoc-mode (default-value 'minor-mode-alist))
-    (setq-default minor-mode-alist
-                  (append (default-value 'minor-mode-alist)
-                          '((eldoc-mode eldoc-minor-mode-string)))))
-
-;; In emacs 19.29 and later, and XEmacs 19.13 and later, all messages are
-;; recorded in a log.  Do not put eldoc messages in that log since
-;; they are Legion.
-(defmacro eldoc-message (&rest args)
-  (if (fboundp 'display-message)
-      ;; XEmacs 19.13 way of preventing log messages.
-      (list 'display-message '(quote no-log) (apply 'list 'format args))
-    (list 'let (list (list 'message-log-max 'nil))
-          (apply 'list 'message args))))
-
-
-;;;###autoload
-(defun eldoc-mode (&optional prefix)
-  "*If non-nil, then enable eldoc-mode (see variable docstring)."
-  (interactive "P")
-
-  ;; Make sure it's on the post-command-idle-hook if defined, otherwise put
-  ;; it on post-command-hook.  The former first appeared in Emacs 19.30.
-  (add-hook (if (boundp 'post-command-idle-hook)
-                'post-command-idle-hook
-              'post-command-hook)
-            'eldoc-mode-print-current-symbol-info)
-
-  (setq eldoc-mode (if prefix
-                       (>= (prefix-numeric-value prefix) 0)
-                     (not eldoc-mode)))
-
-  (and (interactive-p)
-       (if eldoc-mode
-           (message "eldoc-mode is enabled")
-         (message "eldoc-mode is disabled")))
-  eldoc-mode)
-
-;;;###autoload
-(defun turn-on-eldoc-mode ()
-  "Unequivocally turn on eldoc-mode (see variable documentation)."
-  (interactive)
-  (eldoc-mode 1))
-
-(defun eldoc-add-command (cmd)
-  "Add COMMAND to the list of commands which causes function arg display.
-If called interactively, completion matches any bound function.
-
-When point is in a sexp, the function args are not reprinted in the echo
-area after every possible interactive command because some of them print
-their own messages in the echo area; the eldoc functions would instantly
-overwrite them unless it is more restrained."
-  (interactive "aAdd function to eldoc message commands list: ")
-  (and (fboundp cmd)
-       (set (intern (symbol-name cmd) eldoc-mode-message-commands) t)))
-
-(defun eldoc-remove-command (cmd)
-  "Remove COMMAND from the list of commands which causes function arg display.
-If called interactively, completion matches only those functions currently
-in the list.
-
-When point is in a sexp, the function args are not reprinted in the echo
-area after every possible interactive command because some of them print
-their own messages in the echo area; the eldoc functions would instantly
-overwrite them unless it is more restrained."
-  (interactive (list (completing-read
-                      "Remove function from eldoc message commands list: "
-                      eldoc-mode-message-commands 'boundp t)))
-  (and (symbolp cmd)
-       (setq cmd (symbol-name cmd)))
-  (if (fboundp 'unintern)
-      (unintern cmd eldoc-mode-message-commands)
-    (let ((s (intern-soft cmd eldoc-mode-message-commands)))
-      (and s
-           (makunbound s)))))
-
-(defun eldoc-mode-print-current-symbol-info ()
-  (and eldoc-mode
-       (not executing-macro)
-       ;; Having this mode operate in the minibuffer makes it impossible to
-       ;; see what you're doing.
-       (not (eq (selected-window) (minibuffer-window)))
-       (sit-for eldoc-idle-delay)
-       (symbolp this-command)
-       (intern-soft (symbol-name this-command) eldoc-mode-message-commands)
-       (let ((current-symbol (eldoc-current-symbol))
-             (current-fnsym  (eldoc-fnsym-in-current-sexp)))
-         (cond ((eq current-symbol current-fnsym)
-                (eldoc-print-fnsym-args current-fnsym))
-               (t
-                (or (eldoc-print-var-docstring current-symbol)
-                    (eldoc-print-fnsym-args current-fnsym)))))))
-
-
-(defun eldoc-print-var-docstring (&optional sym)
-  "Print the brief (one-line) documentation string for the variable at point.
-If called with no argument, print the first line of the variable
-documentation string for the symbol at point in the echo area.
-If called with a symbol, print the line for that symbol.
-
-If the entire line cannot fit in the echo area, the variable name may be
-truncated or eliminated entirely from the output to make room.
-Any leading `*' in the docstring (which indicates the variable is a user
-option) is not printed."
-  (interactive)
-  (let* ((s (or sym (eldoc-current-symbol)))
-         (name (symbol-name s))
-         (doc (and s (documentation-property s 'variable-documentation t))))
-    (and doc
-         (save-match-data
-           (and (string-match "\n" doc)
-                (setq doc (substring doc 0 (match-beginning 0))))
-           (and (string-match "^\\*" doc)
-                (setq doc (substring doc 1)))
-           (let* ((doclen (+ (length name) (length ": ") (length doc)))
-                  ;; Subtract 1 from window width since emacs seems not to
-                  ;; write any chars to the last column, at least for some
-                  ;; terminal types.
-                  (strip (- doclen (1- (window-width (minibuffer-window))))))
-             (cond ((> strip 0)
-                    (let* ((len (length name)))
-                      (cond ((>= strip len)
-                             (eldoc-message "%s" doc))
-                            (t
-                             (setq name (substring name 0 (- len strip)))
-                             (eldoc-message "%s: %s" name doc)))))
-                   (t
-                    (eldoc-message "%s: %s" s doc))))
-           t))))
-
-
-;;;###autoload
-(defun eldoc-print-fnsym-args (&optional symbol)
-  "*Show the defined parameters for the function near point.
-For the function at the beginning of the sexp which point is within, show
-the defined parameters for the function in the echo area.
-This information is extracted directly from the function or macro if it is
-in pure lisp.
-If the emacs function is a subr, the parameters are obtained from the
-documentation string if possible."
-  (interactive)
-  (let ((sym (or symbol (eldoc-fnsym-in-current-sexp)))
-        (printit t)
-        (args nil))
-    (cond ((not (and (symbolp sym)
-                     (fboundp sym))))
-          ((eq sym (car eldoc-last-data))
-           (setq printit nil)
-           (setq args (cdr eldoc-last-data)))
-          ((subrp (eldoc-symbol-function sym))
-           (setq args (eldoc-function-argstring-from-docstring sym))
-           (setcdr eldoc-last-data args))
-          (t
-           (setq args (eldoc-function-argstring sym))
-           (setcdr eldoc-last-data args)))
-    (and args
-         printit
-         (eldoc-message "%s: %s" sym args))))
-
-(defun eldoc-fnsym-in-current-sexp ()
-  (let* ((p (point))
-         (sym (progn
-                (while (and (eldoc-forward-sexp-safe -1)
-                            (> (point) (point-min))))
-                (cond ((or (= (point) (point-min))
-                           (memq (or (char-after (point)) 0)
-                                 '(?\( ?\"))
-                           ;; If we hit a quotation mark before a paren, we
-                           ;; are inside a specific string, not a list of
-                           ;; symbols.
-                           (eq (or (char-after (1- (point))) 0) ?\"))
-                       nil)
-                      (t (condition-case nil
-                             (read (current-buffer))
-                           (error nil)))))))
-    (goto-char p)
-    (and (symbolp sym)
-         sym)))
-
-(defun eldoc-function-argstring (fn)
-  (let* ((prelim-def (eldoc-symbol-function fn))
-         (def (if (eq (car-safe prelim-def) 'macro)
-                  (cdr prelim-def)
-                prelim-def))
-         (arglist (cond ((null def) nil)
-                        ((byte-code-function-p def)
-                         (if (fboundp 'compiled-function-arglist)
-                             (funcall 'compiled-function-arglist def)
-                           (aref def 0)))
-                        ((eq (car-safe def) 'lambda)
-                         (nth 1 def))
-                        (t t))))
-    (eldoc-function-argstring-format arglist)))
-
-(defun eldoc-function-argstring-from-docstring (fn)
-  (let ((docstring (documentation fn 'raw))
-        (doc nil)
-        (doclist nil)
-        (end nil))
-    (save-match-data
-      ;; TODO: Move these into a separate table that is iterated over until
-      ;; a match is found.
-      (cond
-       ;; Try first searching for args starting with symbol name.
-       ;; This is to avoid matching parenthetical remarks in e.g. sit-for.
-       ((string-match (format "^(%s[^\n)]*)$" fn) docstring)
-        ;; end does not include trailing ")" sequence.
-        (setq end (- (match-end 0) 1))
-        (if (string-match " +" docstring (match-beginning 0))
-            (setq doc (substring docstring (match-end 0) end))
-          (setq doc "")))
-
-       ;; Try again not requiring this symbol name in the docstring.
-       ;; This will be the case when looking up aliases.
-       ((string-match (format "^([^\n)]+)$" fn) docstring)
-        ;; end does not include trailing ")" sequence.
-        (setq end (- (match-end 0) 1))
-        (if (string-match " +" docstring (match-beginning 0))
-            (setq doc (substring docstring (match-end 0) end))
-          (setq doc "")))
-
-       ;; Emacs subr docstring style:
-       ;;   (fn arg1 arg2 ...): description...
-       ((string-match "^([^\n)]+):" docstring)
-        ;; end does not include trailing "):" sequence.
-        (setq end (- (match-end 0) 2))
-        (if (string-match " +" docstring (match-beginning 0))
-            (setq doc (substring docstring (match-end 0) end))
-          (setq doc "")))
-
-       ;; XEmacs subr docstring style:
-       ;;   "arguments: (arg1 arg2 ...)
-       ((string-match "^arguments: (\\([^\n)]+\\))" docstring)
-        ;; Also, skip leading paren, but the first word is actually an
-        ;; argument, not the function name.
-        (setq doc (substring docstring
-                             (match-beginning 1)
-                             (match-end 1))))
-
-       ;; This finds the argstring for `condition-case'.
-       ;; I don't know if there are any others with the same pattern.
-       ((string-match (format "^Usage looks like \\((%s[^\n)]*)\\)\\.$" fn)
-                      docstring)
-        ;; end does not include trailing ")" sequence.
-        (setq end (- (match-end 1) 1))
-        (if (string-match " +" docstring (match-beginning 1))
-            (setq doc (substring docstring (match-end 0) end))
-          (setq doc "")))
-
-       ;; This finds the argstring for `setq-default'.
-       ;; I don't know if there are any others with the same pattern.
-       ((string-match (format "^[ \t]+\\((%s[^\n)]*)\\)$" fn) docstring)
-        ;; end does not include trailing ")" sequence.
-        (setq end (- (match-end 1) 1))
-        (if (string-match " +" docstring (match-beginning 1))
-            (setq doc (substring docstring (match-end 0) end))
-          (setq doc "")))
-
-       ;; This finds the argstring for `start-process'.
-       ;; I don't know if there are any others with the same pattern.
-       ((string-match "^Args are +\\([^\n]+\\)$" docstring)
-        (setq doc (substring docstring (match-beginning 1) (match-end 1))))
-       )
-
-      (cond ((not (stringp doc))
-             nil)
-            ((string-match "&" doc)
-             (let ((p 0)
-                   (l (length doc)))
-               (while (< p l)
-                 (cond ((string-match "[ \t\n]+" doc p)
-                        (setq doclist
-                              (cons (substring doc p (match-beginning 0))
-                                    doclist))
-                        (setq p (match-end 0)))
-                       (t
-                        (setq doclist (cons (substring doc p) doclist))
-                        (setq p l))))
-               (eldoc-function-argstring-format (nreverse doclist))))
-            (t
-             (concat "(" (funcall eldoc-argument-case doc) ")"))))))
-
-(defun eldoc-function-argstring-format (arglist)
-  (cond ((not (listp arglist))
-         (setq arglist nil))
-        ((symbolp (car arglist))
-         (setq arglist
-               (mapcar (function (lambda (s)
-                                   (if (memq s '(&optional &rest))
-                                       (symbol-name s)
-                                     (funcall eldoc-argument-case
-                                              (symbol-name s)))))
-                       arglist)))
-        ((stringp (car arglist))
-         (setq arglist
-               (mapcar (function (lambda (s)
-                                   (if (member s '("&optional" "&rest"))
-                                       s
-                                     (funcall eldoc-argument-case s))))
-                       arglist))))
-  (concat "(" (mapconcat 'identity arglist " ") ")"))
-
-
-;; forward-sexp calls scan-sexps, which returns an error if it hits the
-;; beginning or end of the sexp.  This returns nil instead.
-(defun eldoc-forward-sexp-safe (&optional count)
-  "Move forward across one balanced expression (sexp).
-With argument, do it that many times.  Negative arg -COUNT means
-move backward across COUNT balanced expressions.
-Return distance in buffer moved, or nil."
-  (or count (setq count 1))
-  (condition-case err
-      (- (- (point) (progn
-                      (let ((parse-sexp-ignore-comments t))
-                        (forward-sexp count))
-                      (point))))
-    (error nil)))
-
-;; Do indirect function resolution if possible.
-(defun eldoc-symbol-function (fsym)
-  (let ((defn (and (fboundp fsym)
-                   (symbol-function fsym))))
-    (and (symbolp defn)
-         (condition-case err
-             (setq defn (indirect-function fsym))
-           (error (setq defn nil))))
-    defn))
-
-(defun eldoc-current-symbol ()
-  (let ((c (char-after (point))))
-    (and c
-         (memq (char-syntax c) '(?w ?_))
-         (intern-soft (current-word)))))
-
-(provide 'eldoc)
-
-;;; eldoc.el ends here
diff --git a/lisp/emacs-lisp/elp.el b/lisp/emacs-lisp/elp.el
deleted file mode 100644
index 7c07e900b38..00000000000
--- a/lisp/emacs-lisp/elp.el
+++ /dev/null
@@ -1,563 +0,0 @@
-;;; elp.el --- Emacs Lisp Profiler
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: 1994 Barry A. Warsaw <bwarsaw@cnri.reston.va.us>
-;; Maintainer:    tools-help@anthem.nlm.nih.gov
-;; Created:       26-Feb-1994
-;; Version:       2.23
-;; Last Modified: 1994/12/28 22:39:31
-;; Keywords:      Emacs Lisp Profile Timing
-
-;; 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:
-;;
-;; If you want to profile a bunch of functions, set elp-function-list
-;; to the list of symbols, then do a M-x elp-instrument-list.  This
-;; hacks those functions so that profiling information is recorded
-;; whenever they are called.  To print out the current results, use
-;; M-x elp-results.  With elp-reset-after-results set to non-nil,
-;; profiling information will be reset whenever the results are
-;; displayed.  You can also reset all profiling info at any time with
-;; M-x elp-reset-all.
-;;
-;; You can also instrument all functions in a package, provided that
-;; the package follows the GNU coding standard of a common textural
-;; prefix.  Use M-x elp-instrument-package for this.
-;;
-;; If you want to sort the results, set elp-sort-by-function to some
-;; predicate function.  The three most obvious choices are predefined:
-;; elp-sort-by-call-count, elp-sort-by-average-time, and
-;; elp-sort-by-total-time.  Also, you can prune from the output, all
-;; functions that have been called fewer than a given number of times
-;; by setting elp-report-limit.
-;;
-;; Elp can instrument byte-compiled functions just as easily as
-;; interpreted functions, but it cannot instrument macros.  However,
-;; when you redefine a function (e.g. with eval-defun), you'll need to
-;; re-instrument it with M-x elp-instrument-function.  This will also
-;; reset profiling information for that function.  Elp can handle
-;; interactive functions (i.e. commands), but of course any time spent
-;; idling for user prompts will show up in the timing results.
-;;
-;; You can also designate a `master' function.  Profiling times will
-;; be gathered for instrumented functions only during execution of
-;; this master function.  Thus, if you have some defuns like:
-;;
-;;  (defun foo () (do-something-time-intensive))
-;;  (defun bar () (foo))
-;;  (defun baz () (bar) (foo))
-;;
-;; and you want to find out the amount of time spent in bar and foo,
-;; but only during execution of bar, make bar the master.  The call of
-;; foo from baz will not add to foo's total timing sums.  Use M-x
-;; elp-set-master and M-x elp-unset-master to utilize this feature.
-;; Only one master function can be set at a time.
-
-;; You can restore any function's original function definition with
-;; elp-restore-function.  The other instrument, restore, and reset
-;; functions are provided for symmetry.
-
-;; Note that there are plenty of factors that could make the times
-;; reported unreliable, including the accuracy and granularity of your
-;; system clock, and the overhead spent in lisp calculating and
-;; recording the intervals.  The latter I figure is pretty constant
-;; so, while the times may not be entirely accurate, I think they'll
-;; give you a good feel for the relative amount of work spent in the
-;; various lisp routines you are profiling.  Note further that times
-;; are calculated using wall-clock time, so other system load will
-;; affect accuracy too.
-
-;; Here is a list of variable you can use to customize elp:
-;;   elp-function-list
-;;   elp-reset-after-results
-;;   elp-sort-by-function
-;;   elp-report-limit
-;;
-;; Here is a list of the interactive commands you can use:
-;;   elp-instrument-function
-;;   elp-restore-function
-;;   elp-instrument-list
-;;   elp-restore-list
-;;   elp-instrument-package
-;;   elp-restore-all
-;;   elp-reset-function
-;;   elp-reset-list
-;;   elp-reset-all
-;;   elp-set-master
-;;   elp-unset-master
-;;   elp-results
-;;   elp-submit-bug-report
-
-;; Note that there are plenty of factors that could make the times
-;; reported unreliable, including the accuracy and granularity of your
-;; system clock, and the overhead spent in lisp calculating and
-;; recording the intervals.  I figure the latter is pretty constant,
-;; so while the times may not be entirely accurate, I think they'll
-;; give you a good feel for the relative amount of work spent in the
-;; various lisp routines you are profiling.  Note further that times
-;; are calculated using wall-clock time, so other system load will
-;; affect accuracy too.  You cannot profile anything longer than ~18
-;; hours since I throw away the most significant 16 bits of seconds
-;; returned by current-time: 2^16 == 65536 seconds == ~1092 minutes ==
-;; ~18 hours.  I doubt you will ever want to profile stuff on the
-;; order of 18 hours anyway.
-
-;;; Background:
-
-;; This program is based on the only two existing Emacs Lisp profilers
-;; that I'm aware of, Boaz Ben-Zvi's profile.el, and Root Boy Jim's
-;; profiler.el. Both were written for Emacs 18 and both were pretty
-;; good first shots at profiling, but I found that they didn't provide
-;; the functionality or interface that I wanted.  So I wrote this.
-;; I've tested elp in GNU Emacs 19 and in GNU XEmacs.  There's no
-;; point in even trying to make this work with Emacs 18.
-
-;; Unlike previous profilers, elp uses Emacs 19's built-in function
-;; current-time to return interval times.  This obviates the need for
-;; both an external C program and Emacs processes to communicate with
-;; such a program, and thus simplifies the package as a whole.
-
-;;; Code:
-
-
-;; start user configuration variables
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-
-(defvar elp-function-list nil
-  "*List of function to profile.")
-
-(defvar elp-reset-after-results t
-  "*Non-nil means reset all profiling info after results are displayed.
-Results are displayed with the `elp-results' command.")
-
-(defvar elp-sort-by-function nil
-  "*Non-nil specifies elp results sorting function.
-These functions are currently available:
-
-  elp-sort-by-call-count   -- sort by the highest call count
-  elp-sort-by-total-time   -- sort by the highest total time
-  elp-sort-by-average-time -- sort by the highest average times
-
-You can write you're own sort function. It should adhere to the
-interface specified by the PRED argument for the `sort' defun.  Each
-\"element of LIST\" is really a 4 element vector where element 0 is
-the call count, element 1 is the total time spent in the function,
-element 2 is the average time spent in the function, and element 3 is
-the symbol's name string.")
-
-(defvar elp-report-limit nil
-  "*Prevents some functions from being displayed in the results buffer.
-If a number, no function that has been called fewer than that number
-of times will be displayed in the output buffer.  If nil, all
-functions will be displayed.")
-
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end user configuration variables
-
-
-(defconst elp-version "2.23"
-  "ELP version number.")
-
-(defconst elp-help-address "tools-help@anthem.nlm.nih.gov"
-  "Address accepting submissions of bug reports and questions.")
-
-(defvar elp-results-buffer "*ELP Profiling Results*"
-  "Buffer name for outputting profiling results.")
-
-(defconst elp-timer-info-property 'elp-info
-  "ELP information property name.")
-
-(defvar elp-all-instrumented-list nil
-  "List of all functions currently being instrumented.")
-
-(defvar elp-record-p t
-  "Controls whether functions should record times or not.
-This variable is set by the master function.")
-
-(defvar elp-master nil
-  "Master function symbol.")
-
-
-;;;###autoload
-(defun elp-instrument-function (funsym)
-  "Instrument FUNSYM for profiling.
-FUNSYM must be a symbol of a defined function."
-  (interactive "aFunction to instrument: ")
-  ;; TBD what should we do if the function is already instrumented???
-  (let* ((funguts (symbol-function funsym))
-	 (infovec (vector 0 0 funguts))
-	 (newguts '(lambda (&rest args))))
-    ;; we cannot profile macros
-    (and (eq (car-safe funguts) 'macro)
-	 (error "ELP cannot profile macro %s" funsym))
-    ;; put rest of newguts together
-    (if (commandp funsym)
-	(setq newguts (append newguts '((interactive)))))
-    (setq newguts (append newguts (list
-				   (list 'elp-wrapper
-					 (list 'quote funsym)
-					 (list 'and
-					       '(interactive-p)
-					       (not (not (commandp funsym))))
-					 'args))))
-    ;; to record profiling times, we set the symbol's function
-    ;; definition so that it runs the elp-wrapper function with the
-    ;; function symbol as an argument.  We place the old function
-    ;; definition on the info vector.
-    ;;
-    ;; The info vector data structure is a 3 element vector.  The 0th
-    ;; element is the call-count, i.e. the total number of times this
-    ;; function has been entered.  This value is bumped up on entry to
-    ;; the function so that non-local exists are still recorded. TBD:
-    ;; I haven't tested non-local exits at all, so no guarantees.
-    ;;
-    ;; The 1st element is the total amount of time in usecs that have
-    ;; been spent inside this function.  This number is added to on
-    ;; function exit.
-    ;;
-    ;; The 2nd element is the old function definition list.  This gets
-    ;; funcall'd in between start/end time retrievals. I believe that
-    ;; this lets us profile even byte-compiled functions.
-
-    ;; put the info vector on the property list
-    (put funsym elp-timer-info-property infovec)
-
-    ;; set the symbol's new profiling function definition to run
-    ;; elp-wrapper
-    (fset funsym newguts)
-
-    ;; add this function to the instrumentation list
-    (or (memq funsym elp-all-instrumented-list)
-	(setq elp-all-instrumented-list
-	      (cons funsym elp-all-instrumented-list)))
-    ))
-
-;;;###autoload
-(defun elp-restore-function (funsym)
-  "Restore an instrumented function to its original definition.
-Argument FUNSYM is the symbol of a defined function."
-  (interactive "aFunction to restore: ")
-  (let ((info (get funsym elp-timer-info-property)))
-    ;; delete the function from the all instrumented list
-    (setq elp-all-instrumented-list
-	  (delq funsym elp-all-instrumented-list))
-
-    ;; if the function was the master, reset the master
-    (if (eq funsym elp-master)
-	(setq elp-master nil
-	      elp-record-p t))
-
-    ;; zap the properties
-    (put funsym elp-timer-info-property nil)
-
-    ;; restore the original function definition, but if the function
-    ;; wasn't instrumented do nothing.  we do this after the above
-    ;; because its possible the function got un-instrumented due to
-    ;; circumstances beyond our control.  Also, check to make sure
-    ;; that the current function symbol points to elp-wrapper.  If
-    ;; not, then the user probably did an eval-defun while the
-    ;; function was instrumented and we don't want to destroy the new
-    ;; definition.
-    (and info
-	 (assq 'elp-wrapper (symbol-function funsym))
-	 (fset funsym (aref info 2)))))
-
-;;;###autoload
-(defun elp-instrument-list (&optional list)
-  "Instrument for profiling, all functions in `elp-function-list'.
-Use optional LIST if provided instead."
-  (interactive "PList of functions to instrument: ")
-  (let ((list (or list elp-function-list)))
-    (mapcar 'elp-instrument-function list)))
-
-;;;###autoload
-(defun elp-instrument-package (prefix)
-  "Instrument for profiling, all functions which start with PREFIX.
-For example, to instrument all ELP functions, do the following:
-
-    \\[elp-instrument-package] RET elp- RET"
-  (interactive "sPrefix of package to instrument: ")
-  (elp-instrument-list
-   (mapcar 'intern (all-completions prefix obarray
-				    (function
-				     (lambda (sym)
-				       (and (fboundp sym)
-					    (not (memq (car-safe
-							(symbol-function sym))
-						       '(macro keymap autoload))))))))))
-
-(defun elp-restore-list (&optional list)
-  "Restore the original definitions for all functions in `elp-function-list'.
-Use optional LIST if provided instead."
-  (interactive "PList of functions to restore: ")
-  (let ((list (or list elp-function-list)))
-    (mapcar 'elp-restore-function list)))
-
-(defun elp-restore-all ()
-  "Restores the original definitions of all functions being profiled."
-  (interactive)
-  (elp-restore-list elp-all-instrumented-list))
-
-
-(defun elp-reset-function (funsym)
-  "Reset the profiling information for FUNSYM."
-  (interactive "aFunction to reset: ")
-  (let ((info (get funsym elp-timer-info-property)))
-    (or info
-	(error "%s is not instrumented for profiling." funsym))
-    (aset info 0 0)			;reset call counter
-    (aset info 1 0.0)			;reset total time
-    ;; don't muck with aref 2 as that is the old symbol definition
-    ))
-
-(defun elp-reset-list (&optional list)
-  "Reset the profiling information for all functions in `elp-function-list'.
-Use optional LIST if provided instead."
-  (interactive "PList of functions to reset: ")
-  (let ((list (or list elp-function-list)))
-    (mapcar 'elp-reset-function list)))
-
-(defun elp-reset-all ()
-  "Reset the profiling information for all functions being profiled."
-  (interactive)
-  (elp-reset-list elp-all-instrumented-list))
-
-(defun elp-set-master (funsym)
-  "Set the master function for profiling."
-  (interactive "aMaster function: ")
-  ;; when there's a master function, recording is turned off by
-  ;; default
-  (setq elp-master funsym
-	elp-record-p nil)
-  ;; make sure master function is instrumented
-  (or (memq funsym elp-all-instrumented-list)
-      (elp-instrument-function funsym)))
-
-(defun elp-unset-master ()
-  "Unsets the master function."
-  (interactive)
-  ;; when there's no master function, recording is turned on by default.
-  (setq elp-master nil
-	elp-record-p t))
-
-
-(defsubst elp-get-time ()
-  ;; get current time in seconds and microseconds. I throw away the
-  ;; most significant 16 bits of seconds since I doubt we'll ever want
-  ;; to profile lisp on the order of 18 hours. See notes at top of file.
-  (let ((now (current-time)))
-    (+ (float (nth 1 now)) (/ (float (nth 2 now)) 1000000.0))))
-
-(defun elp-wrapper (funsym interactive-p args)
-  "This function has been instrumented for profiling by the ELP.
-ELP is the Emacs Lisp Profiler.  To restore the function to its
-original definition, use \\[elp-restore-function] or \\[elp-restore-all]."
-  ;; turn on recording if this is the master function
-  (if (and elp-master
-	   (eq funsym elp-master))
-      (setq elp-record-p t))
-  ;; get info vector and original function symbol
-  (let* ((info (get funsym elp-timer-info-property))
-	 (func (aref info 2))
-	 result)
-    (or func
-	(error "%s is not instrumented for profiling." funsym))
-    (if (not elp-record-p)
-	;; when not recording, just call the original function symbol
-	;; and return the results.
-	(setq result
-	      (if interactive-p
-		  (call-interactively func)
-		(apply func args)))
-      ;; we are recording times
-      (let ((enter-time (elp-get-time)))
-	;; increment the call-counter
-	(aset info 0 (1+ (aref info 0)))
-	;; now call the old symbol function, checking to see if it
-	;; should be called interactively.  make sure we return the
-	;; correct value
-	(setq result
-	      (if interactive-p
-		  (call-interactively func)
-		(apply func args)))
-	;; calculate total time in function
-	(aset info 1 (+ (aref info 1) (- (elp-get-time) enter-time)))
-	))
-    ;; turn off recording if this is the master function
-    (if (and elp-master
-	     (eq funsym elp-master))
-	(setq elp-record-p nil))
-    result))
-
-
-;; shut the byte-compiler up
-(defvar elp-field-len nil)
-(defvar elp-cc-len nil)
-(defvar elp-at-len nil)
-(defvar elp-et-len nil)
-
-(defun elp-sort-by-call-count (vec1 vec2)
-  ;; sort by highest call count.  See `sort'.
-  (>= (aref vec1 0) (aref vec2 0)))
-
-(defun elp-sort-by-total-time (vec1 vec2)
-  ;; sort by highest total time spent in function. See `sort'.
-  (>= (aref vec1 1) (aref vec2 1)))
-
-(defun elp-sort-by-average-time (vec1 vec2)
-  ;; sort by highest average time spent in function. See `sort'.
-  (>= (aref vec1 2) (aref vec2 2)))
-
-(defsubst elp-pack-number (number width)
-  ;; pack the NUMBER string into WIDTH characters, watching out for
-  ;; very small or large numbers
-  (if (<= (length number) width)
-      number
-    ;; check for very large or small numbers
-    (if (string-match "^\\(.*\\)\\(e[+-].*\\)$" number)
-	(concat (substring
-		 (substring number (match-beginning 1) (match-end 1))
-		 0
-		 (- width (match-end 2) (- (match-beginning 2)) 3))
-		"..."
-		(substring number (match-beginning 2) (match-end 2)))
-      (concat (substring number 0 width)))))
-
-(defun elp-output-result (resultvec)
-  ;; output the RESULTVEC into the results buffer. RESULTVEC is a 4 or
-  ;; more element vector where aref 0 is the call count, aref 1 is the
-  ;; total time spent in the function, aref 2 is the average time
-  ;; spent in the function, and aref 3 is the symbol's string
-  ;; name. All other elements in the vector are ignored.
-  (let* ((cc (aref resultvec 0))
-	 (tt (aref resultvec 1))
-	 (at (aref resultvec 2))
-	 (symname (aref resultvec 3))
-	 callcnt totaltime avetime)
-    (setq callcnt (number-to-string cc)
-	  totaltime (number-to-string tt)
-	  avetime (number-to-string at))
-    ;; possibly prune the results
-    (if (and elp-report-limit
-	     (numberp elp-report-limit)
-	     (< cc elp-report-limit))
-	nil
-      (insert symname)
-      (insert-char 32 (+ elp-field-len (- (length symname)) 2))
-      ;; print stuff out, formatting it nicely
-      (insert callcnt)
-      (insert-char 32 (+ elp-cc-len (- (length callcnt)) 2))
-      (let ((ttstr (elp-pack-number totaltime elp-et-len))
-	    (atstr (elp-pack-number avetime elp-at-len)))
-	(insert ttstr)
-	(insert-char 32 (+ elp-et-len (- (length ttstr)) 2))
-	(insert atstr))
-      (insert "\n"))))
-
-;;;###autoload
-(defun elp-results ()
-  "Display current profiling results.
-If `elp-reset-after-results' is non-nil, then current profiling
-information for all instrumented functions are reset after results are
-displayed."
-  (interactive)
-  (let ((curbuf (current-buffer))
-	(resultsbuf (get-buffer-create elp-results-buffer)))
-    (set-buffer resultsbuf)
-    (erase-buffer)
-    (beginning-of-buffer)
-    ;; get the length of the longest function name being profiled
-    (let* ((longest 0)
-	   (title "Function Name")
-	   (titlelen (length title))
-	   (elp-field-len titlelen)
-	   (cc-header "Call Count")
-	   (elp-cc-len    (length cc-header))
-	   (et-header "Elapsed Time")
-	   (elp-et-len    (length et-header))
-	   (at-header "Average Time")
-	   (elp-at-len    (length at-header))
-	   (resvec
-	    (mapcar
-	     (function
-	      (lambda (funsym)
-		(let* ((info (get funsym elp-timer-info-property))
-		       (symname (format "%s" funsym))
-		       (cc (aref info 0))
-		       (tt (aref info 1)))
-		  (if (not info)
-		      (insert "No profiling information found for: "
-			      symname)
-		    (setq longest (max longest (length symname)))
-		    (vector cc tt (if (zerop cc)
-				      0.0 ;avoid arithmetic div-by-zero errors
-				    (/ (float tt) (float cc)))
-			    symname)))))
-	     elp-all-instrumented-list))
-	   )				; end let*
-      (insert title)
-      (if (> longest titlelen)
-	  (progn
-	    (insert-char 32 (- longest titlelen))
-	    (setq elp-field-len longest)))
-      (insert "  " cc-header "  " et-header "  " at-header "\n")
-      (insert-char ?= elp-field-len)
-      (insert "  ")
-      (insert-char ?= elp-cc-len)
-      (insert "  ")
-      (insert-char ?= elp-et-len)
-      (insert "  ")
-      (insert-char ?= elp-at-len)
-      (insert "\n")
-      ;; if sorting is enabled, then sort the results list. in either
-      ;; case, call elp-output-result to output the result in the
-      ;; buffer
-      (if elp-sort-by-function
-	  (setq resvec (sort resvec elp-sort-by-function)))
-      (mapcar 'elp-output-result resvec))
-    ;; now pop up results buffer
-    (set-buffer curbuf)
-    (pop-to-buffer resultsbuf)
-    ;; reset profiling info if desired
-    (and elp-reset-after-results
-	 (elp-reset-all))))
-
-
-(eval-when-compile
- (require 'reporter))
-
-;;;###autoload
-(defun elp-submit-bug-report ()
-  "Submit via mail, a bug report on elp."
-  (interactive)
-  (and
-   (y-or-n-p "Do you want to submit a report on elp? ")
-   (require 'reporter)
-   (reporter-submit-bug-report
-    elp-help-address (concat "elp " elp-version)
-    '(elp-report-limit
-      elp-reset-after-results
-      elp-sort-by-function))))
-
-
-(provide 'elp)
-
-;; elp.el ends here
diff --git a/lisp/emacs-lisp/eval-reg.el b/lisp/emacs-lisp/eval-reg.el
deleted file mode 100644
index d97a4ea46de..00000000000
--- a/lisp/emacs-lisp/eval-reg.el
+++ /dev/null
@@ -1,219 +0,0 @@
-;;; eval-reg.el --- Redefine eval-region, and subrs that use it, in Lisp
-
-;; Copyright (C) 1994, 1996 Daniel LaLiberte
-
-;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
-;; Keywords: lisp
-
-;; 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:
-
-;; eval-region, eval-buffer, and eval-current-buffer are redefined in
-;; Lisp to allow customizations by Lisp code.  eval-region calls
-;; `read', `eval', and `prin1', so Lisp replacements of these
-;; functions will affect eval-region and anything else that calls it.
-;; eval-buffer and eval-current-buffer are redefined in Lisp to call
-;; eval-region on the buffer.  
-
-;; Because of dynamic binding, all local variables are protected from
-;; being seen by eval by giving them funky names.  But variables in
-;; routines that call eval-region are similarly exposed.
-
-;; Perhaps this should be one of several files in an `elisp' package
-;; that replaces Emacs Lisp subroutines with Lisp versions of the
-;; same.
-
-;; Eval-region may be installed, after loading, by calling:
-;; (elisp-eval-region-install).  Installation can be undone with:
-;; (elisp-eval-region-uninstall).
-
-;;; Code:
-
-'(defpackage "elisp-eval-region"
-   (:nicknames "elisp")
-   (:use "elisp")
-   (:export
-    elisp-eval-region-install
-    elisp-eval-region-uninstall
-    elisp-eval-region-level
-    with-elisp-eval-region
-    eval-region
-    eval-buffer
-    eval-current-buffer
-    ))
-'(in-package elisp-eval-region)
-
-;; Save standard versions.
-(if (not (fboundp 'original-eval-region))
-    (defalias 'original-eval-region (symbol-function 'eval-region)))
-(if (not (fboundp 'original-eval-buffer))
-    (defalias 'original-eval-buffer 
-	  (if (fboundp 'eval-buffer)  ;; only in Emacs 19
-	      (symbol-function 'eval-buffer)
-	    'undefined)))
-(if (not (fboundp 'original-eval-current-buffer))
-    (defalias 'original-eval-current-buffer
-	  (symbol-function 'eval-current-buffer)))
-
-(defvar elisp-eval-region-level 0
-  "If the value is 0, use the original version of `elisp-eval-region'.
-Callers of `elisp-eval-region' should increment `elisp-eval-region-level'
-while the Lisp version should be used.  Installing `elisp-eval-region'
-increments it once, and uninstalling decrements it.")
-
-;; Installing and uninstalling should always be used in pairs, 
-;; or just install once and never uninstall. 
-(defun elisp-eval-region-install ()
-  (interactive)
-  (defalias 'eval-region 'elisp-eval-region)
-  (defalias 'eval-buffer 'elisp-eval-buffer)
-  (defalias 'eval-current-buffer 'elisp-eval-current-buffer)
-  (setq elisp-eval-region-level (1+ elisp-eval-region-level)))
-
-(defun elisp-eval-region-uninstall ()
-  (interactive)
-  (if (> 1 elisp-eval-region-level)
-      (setq elisp-eval-region-level (1- elisp-eval-region-level))
-    (setq elisp-eval-region-level 0)
-    (defalias 'eval-region (symbol-function 'original-eval-region))
-    (defalias 'eval-buffer (symbol-function 'original-eval-buffer))
-    (defalias 'eval-current-buffer 
-      (symbol-function 'original-eval-current-buffer))
-    ))
-
-(put 'with-elisp-eval-region 'lisp-indent-function 1)
-(put 'with-elisp-eval-region 'lisp-indent-hook 1)
-(put 'with-elisp-eval-region 'edebug-form-spec t)
-
-(defmacro with-elisp-eval-region (flag &rest body)
-  "If FLAG is nil, decrement `eval-region-level' while executing BODY.
-The effect of decrementing all the way to zero is that `eval-region'
-will use the original `eval-region', which may be the Emacs subr or some
-previous redefinition.  Before calling this macro, this package should
-already have been installed, using `elisp-eval-region-install', which
-increments the count once.  So if another package still requires the
-Lisp version of the code, the count will still be non-zero.
-
-The count is not bound locally by this macro, so changes by BODY to
-its value will not be lost."
-  (` (let ((elisp-code (function (lambda () (,@ body)))))
-       (if (not (, flag))
-	   (unwind-protect
-	       (progn
-		 (setq elisp-eval-region-level (1- elisp-eval-region-level))
-		 (funcall elisp-code))
-	     (setq elisp-eval-region-level (1+ elisp-eval-region-level)))
-	 (funcall elisp-code)))))
-
-
-(defun elisp-eval-region (elisp-start elisp-end &optional elisp-output)
-  "Execute the region as Lisp code.
-When called from programs, expects two arguments,
-giving starting and ending indices in the current buffer
-of the text to be executed.
-Programs can pass third argument PRINTFLAG which controls printing of output:
-nil means discard it; anything else is stream for print.
-
-This version, from `eval-reg.el', allows Lisp customization of read,
-eval, and the printer."
-
-  ;; Because this doesn't narrow to the region, one other difference 
-  ;; concerns inserting whitespace after the expression being evaluated.
-
-  (interactive "r")
-  (if (= 0 elisp-eval-region-level)
-      (original-eval-region elisp-start elisp-end elisp-output)
-    (let ((elisp-pnt (point))
-	  (elisp-buf (current-buffer));; Outside buffer
-	  (elisp-inside-buf (current-buffer));; Buffer current while evalling
-	  ;; Mark the end because it may move.
-	  (elisp-end-marker (set-marker (make-marker) elisp-end))
-	  elisp-form
-	  elisp-val)
-      (goto-char elisp-start)
-      (elisp-skip-whitespace)
-      (while (< (point) elisp-end-marker)
-	(setq elisp-form (read elisp-buf))
-
-	(let ((elisp-current-buffer (current-buffer)))
-	  ;; Restore the inside current-buffer.
-	  (set-buffer elisp-inside-buf)
-	  (setq elisp-val (eval elisp-form))
-	  ;; Remember current buffer for next time.
-	  (setq elisp-inside-buf (current-buffer))
-	  ;; Should this be protected?
-	  (set-buffer elisp-current-buffer))
-
-	(if elisp-output
-	    (let ((standard-output (or elisp-output t)))
-	      (setq values (cons elisp-val values))
-	      (if (eq standard-output t)
-		  (prin1 elisp-val)
-		(princ "\n")
-		(prin1 elisp-val)
-		(princ "\n")
-		)))
-	(goto-char (min (max elisp-end-marker (point))
-			(progn (elisp-skip-whitespace) (point))))
-	)				; while
-      (if elisp-output nil
-	;; like save-excursion recovery, but done only if no error occurs
-	;; but mark is not restored
-	(set-buffer elisp-buf)
-	(goto-char elisp-pnt))
-      nil)))
-
-
-(defun elisp-skip-whitespace ()
-  ;; Leave point before the next token, skipping white space and comments.
-  (skip-chars-forward " \t\r\n\f")
-  (while (= (following-char) ?\;)
-    (skip-chars-forward "^\n\r")  ; skip the comment
-    (skip-chars-forward " \t\r\n\f")))
-
-
-(defun elisp-eval-current-buffer (&optional elisp-output)
-  "Execute the current buffer as Lisp code.
-Programs can pass argument PRINTFLAG which controls printing of output:
-nil means discard it; anything else is stream for print.
-
-This version calls `eval-region' on the whole buffer."
-  ;; The standard eval-current-buffer doesn't use eval-region.
-  (interactive)
-  (eval-region (point-min) (point-max) elisp-output))
-
-
-(defun elisp-eval-buffer (&optional elisp-bufname elisp-printflag)
-  "Execute BUFFER as Lisp code.  Use current buffer if BUFFER is nil.
-Programs can pass argument PRINTFLAG which controls printing of
-output: nil means discard it; anything else is stream for print.
-
-This version calls `eval-region' on the whole buffer."
-  (interactive)
-  (if (null elisp-bufname)
-      (setq elisp-bufname (current-buffer)))
-  (save-excursion
-    (set-buffer (or (get-buffer elisp-bufname) 
-		    (error "No such buffer: %s" elisp-bufname)))
-    (eval-region (point-min) (point-max) elisp-printflag)))
-
-
-(provide 'eval-reg)
-
-;;; eval-reg.el ends here
diff --git a/lisp/emacs-lisp/float.el b/lisp/emacs-lisp/float.el
deleted file mode 100644
index f4fd9ae0ec9..00000000000
--- a/lisp/emacs-lisp/float.el
+++ /dev/null
@@ -1,458 +0,0 @@
-;;; float.el --- floating point arithmetic package.
-
-;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; Author: Bill Rosenblatt
-;; 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:
-
-;; Floating point numbers are represented by dot-pairs (mant . exp)
-;; where mant is the 24-bit signed integral mantissa and exp is the
-;; base 2 exponent.
-;;
-;; Emacs LISP supports a 24-bit signed integer data type, which has a
-;; range of -(2**23) to +(2**23)-1, or -8388608 to 8388607 decimal.
-;; This gives six significant decimal digit accuracy.  Exponents can
-;; be anything in the range -(2**23) to +(2**23)-1.
-;;
-;; User interface:
-;; function f converts from integer to floating point
-;; function string-to-float converts from string to floating point
-;; function fint converts a floating point to integer (with truncation)
-;; function float-to-string converts from floating point to string
-;;                   
-;; Caveats:
-;; -  Exponents outside of the range of +/-100 or so will cause certain 
-;;    functions (especially conversion routines) to take forever.
-;; -  Very little checking is done for fixed point overflow/underflow.
-;; -  No checking is done for over/underflow of the exponent
-;;    (hardly necessary when exponent can be 2**23).
-;; 
-;;
-;; Bill Rosenblatt
-;; June 20, 1986
-;;
-
-;;; Code:
-
-;; fundamental implementation constants
-(defconst exp-base 2
-  "Base of exponent in this floating point representation.")
-
-(defconst mantissa-bits 24
-  "Number of significant bits in this floating point representation.")
-
-(defconst decimal-digits 6
-  "Number of decimal digits expected to be accurate.")
-
-(defconst expt-digits 2
-  "Maximum permitted digits in a scientific notation exponent.")
-
-;; other constants
-(defconst maxbit (1- mantissa-bits)
-  "Number of highest bit")
-
-(defconst mantissa-maxval (1- (ash 1 maxbit))
-  "Maximum permissible value of mantissa")
-
-(defconst mantissa-minval (ash 1 maxbit)
-  "Minimum permissible value of mantissa")
-
-(defconst floating-point-regexp
-  "^[ \t]*\\(-?\\)\\([0-9]*\\)\
-\\(\\.\\([0-9]*\\)\\|\\)\
-\\(\\(\\([Ee]\\)\\(-?\\)\\([0-9][0-9]*\\)\\)\\|\\)[ \t]*$"
-  "Regular expression to match floating point numbers.  Extract matches:
-1 - minus sign
-2 - integer part
-4 - fractional part
-8 - minus sign for power of ten
-9 - power of ten
-")
-
-(defconst high-bit-mask (ash 1 maxbit)
-  "Masks all bits except the high-order (sign) bit.")
-
-(defconst second-bit-mask (ash 1 (1- maxbit))
-  "Masks all bits except the highest-order magnitude bit")
-
-;; various useful floating point constants
-(setq _f0 '(0 . 1))
-
-(setq _f1/2 '(4194304 . -23))
-
-(setq _f1 '(4194304 . -22))
-
-(setq _f10 '(5242880 . -19))
-
-;; support for decimal conversion routines
-(setq powers-of-10 (make-vector (1+ decimal-digits) _f1))
-(aset powers-of-10 1 _f10)
-(aset powers-of-10 2 '(6553600 . -16))
-(aset powers-of-10 3 '(8192000 . -13))
-(aset powers-of-10 4 '(5120000 . -9))
-(aset powers-of-10 5 '(6400000 . -6))
-(aset powers-of-10 6 '(8000000 . -3))
-
-(setq all-decimal-digs-minval (aref powers-of-10 (1- decimal-digits))
-      highest-power-of-10 (aref powers-of-10 decimal-digits))
-
-(defun fashl (fnum)			; floating-point arithmetic shift left
-  (cons (ash (car fnum) 1) (1- (cdr fnum))))
-
-(defun fashr (fnum)			; floating point arithmetic shift right
-  (cons (ash (car fnum) -1) (1+ (cdr fnum))))
-
-(defun normalize (fnum)
-  (if (> (car fnum) 0)			; make sure next-to-highest bit is set
-      (while (zerop (logand (car fnum) second-bit-mask))
-	(setq fnum (fashl fnum)))
-    (if (< (car fnum) 0)		; make sure highest bit is set
-	(while (zerop (logand (car fnum) high-bit-mask))
-	  (setq fnum (fashl fnum)))
-      (setq fnum _f0)))			; "standard 0"
-  fnum)
-      
-(defun abs (n)				; integer absolute value
-  (if (>= n 0) n (- n)))
-
-(defun fabs (fnum)			; re-normalize after taking abs value
-  (normalize (cons (abs (car fnum)) (cdr fnum))))
-
-(defun xor (a b)			; logical exclusive or
-  (and (or a b) (not (and a b))))
-
-(defun same-sign (a b)			; two f-p numbers have same sign?
-  (not (xor (natnump (car a)) (natnump (car b)))))
-
-(defun extract-match (str i)		; used after string-match
-  (condition-case ()
-      (substring str (match-beginning i) (match-end i))
-    (error "")))
-
-;; support for the multiplication function
-(setq halfword-bits (/ mantissa-bits 2)	; bits in a halfword
-      masklo (1- (ash 1 halfword-bits)) ; isolate the lower halfword
-      maskhi (lognot masklo)		; isolate the upper halfword
-      round-limit (ash 1 (/ halfword-bits 2)))
-
-(defun hihalf (n)			; return high halfword, shifted down
-  (ash (logand n maskhi) (- halfword-bits)))
-
-(defun lohalf (n)			; return low halfword
-  (logand n masklo))
-
-;; Visible functions
-
-;; Arithmetic functions
-(defun f+ (a1 a2)
-  "Returns the sum of two floating point numbers."
-  (let ((f1 (fmax a1 a2))
-	(f2 (fmin a1 a2)))
-    (if (same-sign a1 a2)
-	(setq f1 (fashr f1)		; shift right to avoid overflow
-	      f2 (fashr f2)))
-    (normalize
-     (cons (+ (car f1) (ash (car f2) (- (cdr f2) (cdr f1))))
-	   (cdr f1)))))
-
-(defun f- (a1 &optional a2)		; unary or binary minus
-  "Returns the difference of two floating point numbers."
-  (if a2
-      (f+ a1 (f- a2))
-    (normalize (cons (- (car a1)) (cdr a1)))))
-
-(defun f* (a1 a2)			; multiply in halfword chunks
-  "Returns the product of two floating point numbers."
-  (let* ((i1 (car (fabs a1)))
-	 (i2 (car (fabs a2)))
-	 (sign (not (same-sign a1 a2)))
-	 (prodlo (+ (hihalf (* (lohalf i1) (lohalf i2)))
-		    (lohalf (* (hihalf i1) (lohalf i2)))
-		    (lohalf (* (lohalf i1) (hihalf i2)))))
-	 (prodhi (+ (* (hihalf i1) (hihalf i2))
-		    (hihalf (* (hihalf i1) (lohalf i2)))
-		    (hihalf (* (lohalf i1) (hihalf i2)))
-		    (hihalf prodlo))))
-    (if (> (lohalf prodlo) round-limit)
-	(setq prodhi (1+ prodhi)))	; round off truncated bits
-    (normalize
-     (cons (if sign (- prodhi) prodhi)
-	   (+ (cdr (fabs a1)) (cdr (fabs a2)) mantissa-bits)))))
-
-(defun f/ (a1 a2)			; SLOW subtract-and-shift algorithm
-  "Returns the quotient of two floating point numbers."
-  (if (zerop (car a2))			; if divide by 0
-      (signal 'arith-error (list "attempt to divide by zero" a1 a2))
-    (let ((bits (1- maxbit))
-	  (quotient 0) 
-	  (dividend (car (fabs a1)))
-	  (divisor (car (fabs a2)))
-	  (sign (not (same-sign a1 a2))))
-      (while (natnump bits)
-	(if (< (- dividend divisor) 0)
-	    (setq quotient (ash quotient 1))
-	  (setq quotient (1+ (ash quotient 1))
-		dividend (- dividend divisor)))
-	(setq dividend (ash dividend 1)
-	      bits (1- bits)))
-      (normalize
-       (cons (if sign (- quotient) quotient)
-	     (- (cdr (fabs a1)) (cdr (fabs a2)) (1- maxbit)))))))
-  
-(defun f% (a1 a2)
-  "Returns the remainder of first floating point number divided by second."
-  (f- a1 (f* (ftrunc (f/ a1 a2)) a2)))
-	  
-
-;; Comparison functions
-(defun f= (a1 a2)
-  "Returns t if two floating point numbers are equal, nil otherwise."
-  (equal a1 a2))
-
-(defun f> (a1 a2)
-  "Returns t if first floating point number is greater than second,
-nil otherwise."
-  (cond ((and (natnump (car a1)) (< (car a2) 0)) 
-	 t)				; a1 nonnegative, a2 negative
-	((and (> (car a1) 0) (<= (car a2) 0))
-	 t)				; a1 positive, a2 nonpositive
-	((and (<= (car a1) 0) (natnump (car a2)))
-	 nil)				; a1 nonpos, a2 nonneg
-	((/= (cdr a1) (cdr a2))		; same signs.  exponents differ
-	 (> (cdr a1) (cdr a2)))		; compare the mantissas.
-	(t
-	 (> (car a1) (car a2)))))	; same exponents.
-
-(defun f>= (a1 a2)
-  "Returns t if first floating point number is greater than or equal to 
-second, nil otherwise."
-  (or (f> a1 a2) (f= a1 a2)))
-
-(defun f< (a1 a2)
-  "Returns t if first floating point number is less than second,
-nil otherwise."
-  (not (f>= a1 a2)))
-
-(defun f<= (a1 a2)
-  "Returns t if first floating point number is less than or equal to
-second, nil otherwise."
-  (not (f> a1 a2)))
-
-(defun f/= (a1 a2)
-  "Returns t if first floating point number is not equal to second,
-nil otherwise."
-  (not (f= a1 a2)))
-
-(defun fmin (a1 a2)
-  "Returns the minimum of two floating point numbers."
-  (if (f< a1 a2) a1 a2))
-
-(defun fmax (a1 a2)
-  "Returns the maximum of two floating point numbers."
-  (if (f> a1 a2) a1 a2))
-      
-(defun fzerop (fnum)
-  "Returns t if the floating point number is zero, nil otherwise."
-  (= (car fnum) 0))
-
-(defun floatp (fnum)
-  "Returns t if the arg is a floating point number, nil otherwise."
-  (and (consp fnum) (integerp (car fnum)) (integerp (cdr fnum))))
-
-;; Conversion routines
-(defun f (int)
-  "Convert the integer argument to floating point, like a C cast operator."
-  (normalize (cons int '0)))
-
-(defun int-to-hex-string (int)
-  "Convert the integer argument to a C-style hexadecimal string."
-  (let ((shiftval -20)
-	(str "0x")
-	(hex-chars "0123456789ABCDEF"))
-    (while (<= shiftval 0)
-      (setq str (concat str (char-to-string 
-			(aref hex-chars
-			      (logand (lsh int shiftval) 15))))
-	    shiftval (+ shiftval 4)))
-    str))
-
-(defun ftrunc (fnum)			; truncate fractional part
-  "Truncate the fractional part of a floating point number."
-  (cond ((natnump (cdr fnum))		; it's all integer, return number as is
-	 fnum)
-	((<= (cdr fnum) (- maxbit))	; it's all fractional, return 0
-	 '(0 . 1))
-	(t				; otherwise mask out fractional bits
-	 (let ((mant (car fnum)) (exp (cdr fnum)))
-	   (normalize 
-	    (cons (if (natnump mant)	; if negative, use absolute value
-		      (ash (ash mant exp) (- exp))
-		    (- (ash (ash (- mant) exp) (- exp))))
-		  exp))))))
-
-(defun fint (fnum)			; truncate and convert to integer
-  "Convert the floating point number to integer, with truncation, 
-like a C cast operator."
-  (let* ((tf (ftrunc fnum)) (tint (car tf)) (texp (cdr tf)))
-    (cond ((>= texp mantissa-bits)	; too high, return "maxint"
-	   mantissa-maxval)
-	  ((<= texp (- mantissa-bits))	; too low, return "minint"
-	   mantissa-minval)
-	  (t				; in range
-	   (ash tint texp)))))		; shift so that exponent is 0
-
-(defun float-to-string (fnum &optional sci)
-  "Convert the floating point number to a decimal string.
-Optional second argument non-nil means use scientific notation."
-  (let* ((value (fabs fnum)) (sign (< (car fnum) 0))
-	 (power 0) (result 0) (str "") 
-	 (temp 0) (pow10 _f1))
-
-    (if (f= fnum _f0)
-	"0"
-      (if (f>= value _f1)			; find largest power of 10 <= value
-	  (progn				; value >= 1, power is positive
-	    (while (f<= (setq temp (f* pow10 highest-power-of-10)) value)
-	      (setq pow10 temp
-		    power (+ power decimal-digits)))
-	    (while (f<= (setq temp (f* pow10 _f10)) value)
-	      (setq pow10 temp
-		    power (1+ power))))
-	(progn				; value < 1, power is negative
-	  (while (f> (setq temp (f/ pow10 highest-power-of-10)) value)
-	    (setq pow10 temp
-		  power (- power decimal-digits)))
-	  (while (f> pow10 value)
-	    (setq pow10 (f/ pow10 _f10)
-		  power (1- power)))))
-					  ; get value in range 100000 to 999999
-      (setq value (f* (f/ value pow10) all-decimal-digs-minval)
-	    result (ftrunc value))
-      (let (int)
-	(if (f> (f- value result) _f1/2)	; round up if remainder > 0.5
-	    (setq int (1+ (fint result)))
-	  (setq int (fint result)))
-	(setq str (int-to-string int))
-	(if (>= int 1000000)
-	    (setq power (1+ power))))
-
-      (if sci				; scientific notation
-	  (setq str (concat (substring str 0 1) "." (substring str 1)
-			    "E" (int-to-string power)))
-
-					  ; regular decimal string
-	(cond ((>= power (1- decimal-digits))
-					  ; large power, append zeroes
-	       (let ((zeroes (- power decimal-digits)))
-		 (while (natnump zeroes)
-		   (setq str (concat str "0")
-			 zeroes (1- zeroes)))))
-
-					  ; negative power, prepend decimal
-	      ((< power 0)		; point and zeroes
-	       (let ((zeroes (- (- power) 2)))
-		 (while (natnump zeroes)
-		   (setq str (concat "0" str)
-			 zeroes (1- zeroes)))
-		 (setq str (concat "0." str))))
-
-	      (t				; in range, insert decimal point
-	       (setq str (concat
-			  (substring str 0 (1+ power))
-			  "."
-			  (substring str (1+ power)))))))
-
-      (if sign				; if negative, prepend minus sign
-	  (concat "-" str)
-	str))))
-
-    
-;; string to float conversion.
-;; accepts scientific notation, but ignores anything after the first two
-;; digits of the exponent.
-(defun string-to-float (str)
-  "Convert the string to a floating point number.
-Accepts a decimal string in scientific notation,  with exponent preceded
-by either E or e.  Only the six most significant digits of the integer
-and fractional parts are used; only the first two digits of the exponent
-are used.  Negative signs preceding both the decimal number and the exponent
-are recognized."
-
-  (if (string-match floating-point-regexp str 0)
-      (let (power)
-	(f*
-	 ; calculate the mantissa
-	 (let* ((int-subst (extract-match str 2))
-		(fract-subst (extract-match str 4))
-		(digit-string (concat int-subst fract-subst))
-		(mant-sign (equal (extract-match str 1) "-"))
-		(leading-0s 0) (round-up nil))
-
-	   ; get rid of leading 0's
-	   (setq power (- (length int-subst) decimal-digits))
-	   (while (and (< leading-0s (length digit-string))
-		       (= (aref digit-string leading-0s) ?0))
-	     (setq leading-0s (1+ leading-0s)))
-	   (setq power (- power leading-0s)
-		 digit-string (substring digit-string leading-0s))
-	   
-	   ; if more than 6 digits, round off
-	   (if (> (length digit-string) decimal-digits)
-	       (setq round-up (>= (aref digit-string decimal-digits) ?5)
-		     digit-string (substring digit-string 0 decimal-digits))
-	     (setq power (+ power (- decimal-digits (length digit-string)))))
-
-	   ; round up and add minus sign, if necessary
-	   (f (* (+ (string-to-int digit-string)
-		    (if round-up 1 0))
-		 (if mant-sign -1 1))))
-	   
-	 ; calculate the exponent (power of ten)
-	 (let* ((expt-subst (extract-match str 9))
-		(expt-sign (equal (extract-match str 8) "-"))
-		(expt 0) (chunks 0) (tens 0) (exponent _f1)
-		(func 'f*))
- 
-	   (setq expt (+ (* (string-to-int
-			     (substring expt-subst 0
-					(min expt-digits (length expt-subst))))
-			    (if expt-sign -1 1))
-			 power))
-	   (if (< expt 0)		; if power of 10 negative
-	       (setq expt (- expt)	; take abs val of exponent
-		     func 'f/))		; and set up to divide, not multiply
-
-	   (setq chunks (/ expt decimal-digits)
-		 tens (% expt decimal-digits))
-	   ; divide or multiply by "chunks" of 10**6
-	   (while (> chunks 0)	
-	     (setq exponent (funcall func exponent highest-power-of-10)
-		   chunks (1- chunks)))
-	   ; divide or multiply by remaining power of ten
-	   (funcall func exponent (aref powers-of-10 tens)))))
-		  
-    _f0))				; if invalid, return 0
-
-(provide 'float)
-
-;;; float.el ends here
diff --git a/lisp/emacs-lisp/gulp.el b/lisp/emacs-lisp/gulp.el
deleted file mode 100644
index 0020f720b60..00000000000
--- a/lisp/emacs-lisp/gulp.el
+++ /dev/null
@@ -1,152 +0,0 @@
-;;; gulp.el --- Ask for updates for Lisp packages
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Sam Shteingold <shteingd@math.ucla.edu>
-;; Maintainer: FSF
-;; Keywords: maintenance
-
-;; 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:
-
-;; Search the emacs/{version}/lisp directory for *.el files, extract the
-;; name of the author or maintainer and send him e-mail requesting
-;; update.
-
-;;; Code:
-
-(defvar gulp-discard "^;+ *Maintainer: *FSF *$"
-  "*The regexp matching the packages not requiring the request for updates.")
-
-(defvar gulp-tmp-buffer "*gulp*" "The name of the temporary buffer.")
-
-(defvar gulp-max-len 2000
-  "*Distance into a Lisp source file to scan for keywords.")
-
-(defvar gulp-request-header
-  (concat
-   "This message was created automatically.
-A new version of GNU Emacs, "
-   (format "%d.%d" emacs-major-version (+ emacs-minor-version 1))
-   ", is entering the pretest state,
-and it is high time to submit the updates to the various emacs packages.
-You're listed as the maintainer of the following package(s):\n\n")
-  "*The starting text of a gulp message.")
-
-(defvar gulp-request-end
-  (concat
-   "\nIf you have any changes since the version in the previous release ("
-   (format "%d.%d" emacs-major-version emacs-minor-version)
-   "),
-please send them to me ASAP.
-
-Thanks.")
-  "*The closing text in a gulp message.")
-
-(defun gulp-send-requests (dir &optional time)
-  "Send requests for updates to the authors of Lisp packages in directory DIR.
-For each maintainer, the message consists of `gulp-request-header',
-followed by the list of packages (with modification times if the optional
-prefix argument TIME is non-nil), concluded with `gulp-request-end'.
-
-You can't edit the messages, but you can confirm whether to send each one.
-
-The list of addresses for which you decided not to send mail
-is left in the `*gulp*' buffer at the end."
-  (interactive "DRequest updates for Lisp directory: \nP")
-  (save-excursion
-    (set-buffer (get-buffer-create gulp-tmp-buffer))
-    (let ((m-p-alist (gulp-create-m-p-alist
-		      (directory-files dir nil "^[^=].*\\.el$" t)
-		      dir))
-	  ;; Temporarily inhibit undo in the *gulp* buffer.
-	  (buffer-undo-list t)
-	  mail-setup-hook msg node)
-      (while (setq node (car m-p-alist))
-	(setq msg (gulp-create-message (cdr node) time))
-	(setq mail-setup-hook
-	      '(lambda () 
-		 (mail-subject)
-		 (insert "It's time for Emacs updates again")
-		 (goto-char (point-max))
-		 (insert msg)))
-	(mail nil (car node))
-	(if (y-or-n-p "Send? ") (mail-send)
-	  (kill-this-buffer)
-	  (set-buffer gulp-tmp-buffer)
-	  (insert (format "%s\n\n" node)))
-	(setq m-p-alist (cdr m-p-alist))))
-    (set-buffer gulp-tmp-buffer)
-    (setq buffer-undo-list nil)))
-
-
-(defun gulp-create-message (rec time)
-  "Return the message string for REC, which is a list like (FILE TIME)."
-  (let (node (str gulp-request-header))
-    (while (setq node (car rec))
-      (setq str (concat str "\t" (car node)
-			(if time (concat "\tLast modified:\t" (cdr node)))
-			"\n"))
-      (setq rec (cdr rec)))
-    (concat str gulp-request-end)))
-
-
-(defun gulp-create-m-p-alist (flist dir)
-  "Create the maintainer/package alist for files in FLIST in DIR.
-That is a list of elements, each of the form (MAINTAINER PACKAGES...)."
-  (save-excursion
-    (let (mplist filen node mnt-tm mnt tm)
-      (get-buffer-create gulp-tmp-buffer)
-      (set-buffer gulp-tmp-buffer)
-      (setq buffer-undo-list t)
-      (while flist
-	(setq fl-tm (gulp-maintainer (setq filen (car flist)) dir))
-	(if (setq tm (cdr fl-tm) mnt (car fl-tm));; there is a definite maintainer
-	    (if (setq node (assoc mnt mplist));; this is not a new maintainer
-		(setq mplist (cons (cons mnt (cons (cons filen tm) (cdr node)))
-				   (delete node mplist)))
-	      (setq mplist (cons (list mnt (cons filen (cdr fl-tm))) mplist))))
-	(message "%s -- %s" filen fl-tm)
-	(setq flist (cdr flist)))
-      (erase-buffer)
-      mplist)))
-
-(defun gulp-maintainer (filenm dir)
-  "Return a list (MAINTAINER TIMESTAMP) for the package FILENM in directory DIR."
-  (save-excursion
-    (let* ((fl (concat dir filenm)) mnt
-	   (timest (format-time-string "%Y-%m-%d %a %T %Z"
-				       (elt (file-attributes fl) 5))))
-      (set-buffer gulp-tmp-buffer)
-      (erase-buffer)
-      (insert-file-contents fl nil 0 gulp-max-len)
-      (goto-char 1)
-      (if (re-search-forward gulp-discard nil t)
-	  (setq mnt nil) ;; do nothing, return nil
-	(goto-char 1)
-	(if (and (re-search-forward "^;+ *Maintainer: \\(.*\\)$" nil t)
-		 (> (length (setq mnt (match-string 1))) 0))
-	    () ;; found!
-	  (goto-char 1)
-	  (if (re-search-forward "^;+ *Author: \\(.*\\)$" nil t)
-	      (setq mnt (match-string 1))))
-	(if (= (length mnt) 0) (setq mnt nil))) ;; "^;; Author: $" --> nil
-      (cons mnt timest))))
-
-;;; gulp.el ends here
diff --git a/lisp/emacs-lisp/helper.el b/lisp/emacs-lisp/helper.el
deleted file mode 100644
index b1f3cfdbd65..00000000000
--- a/lisp/emacs-lisp/helper.el
+++ /dev/null
@@ -1,157 +0,0 @@
-;;; helper.el --- utility help package supporting help in electric modes
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; Maintainer: FSF
-;; Keywords: help
-
-;; 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.
-
-;;; Code:
-
-;; hey, here's a helping hand.
-
-;; Bind this to a string for <blank> in "... Other keys <blank>".
-;; Helper-help uses this to construct help string when scrolling.
-;; Defaults to "return"
-(defvar Helper-return-blurb nil)
-
-;; Keymap implementation doesn't work too well for non-standard loops.
-;; But define it anyway for those who can use it.  Non-standard loops
-;; will probably have to use Helper-help.  You can't autoload the
-;; keymap either.
-
-
-(defvar Helper-help-map nil)
-(if Helper-help-map
-    nil
-  (setq Helper-help-map (make-keymap))
-  ;(fillarray Helper-help-map 'undefined)
-  (define-key Helper-help-map "m" 'Helper-describe-mode)
-  (define-key Helper-help-map "b" 'Helper-describe-bindings)
-  (define-key Helper-help-map "c" 'Helper-describe-key-briefly)
-  (define-key Helper-help-map "k" 'Helper-describe-key)
-  ;(define-key Helper-help-map "f" 'Helper-describe-function)
-  ;(define-key Helper-help-map "v" 'Helper-describe-variable)
-  (define-key Helper-help-map "?" 'Helper-help-options)
-  (define-key Helper-help-map (char-to-string help-char) 'Helper-help-options)
-  (fset 'Helper-help-map Helper-help-map))
-
-(defun Helper-help-scroller ()
-  (let ((blurb (or (and (boundp 'Helper-return-blurb)
-			Helper-return-blurb)
-		   "return")))
-    (save-window-excursion
-      (goto-char (window-start (selected-window)))
-      (if (get-buffer-window "*Help*")
-	  (pop-to-buffer "*Help*")
-	(switch-to-buffer "*Help*"))
-      (goto-char (point-min))
-      (let ((continue t) state)
-	(while continue
-	  (setq state (+ (* 2 (if (pos-visible-in-window-p (point-max)) 1 0))
-			 (if (pos-visible-in-window-p (point-min)) 1 0)))
-	  (message
-	    (nth state
-		 '("Space forward, Delete back. Other keys %s"
-		   "Space scrolls forward. Other keys %s"
-		   "Delete scrolls back. Other keys %s"
-		   "Type anything to %s"))
-	    blurb)
-	  (setq continue (read-char))
-	  (cond ((and (memq continue '(?\ ?\C-v)) (< state 2))
-		 (scroll-up))
-		((= continue ?\C-l)
-		 (recenter))
-		((and (= continue ?\177) (zerop (% state 2)))
-		 (scroll-down))
-		(t (setq continue nil))))))))
-
-(defun Helper-help-options ()
-  "Describe help options."
-  (interactive)
-  (message "c (key briefly), m (mode), k (key), b (bindings)")
-  ;(message "c (key briefly), m (mode), k (key), v (variable), f (function)")
-  (sit-for 4))
-
-(defun Helper-describe-key-briefly (key)
-  "Briefly describe binding of KEY."
-  (interactive "kDescribe key briefly: ")
-  (describe-key-briefly key)
-  (sit-for 4))
-
-(defun Helper-describe-key (key)
-  "Describe binding of KEY."
-  (interactive "kDescribe key: ")
-  (save-window-excursion (describe-key key))
-  (Helper-help-scroller))
-
-(defun Helper-describe-function ()
-  "Describe a function.  Name read interactively."
-  (interactive)
-  (save-window-excursion (call-interactively 'describe-function))
-  (Helper-help-scroller))
-
-(defun Helper-describe-variable ()
-  "Describe a variable.  Name read interactively."
-  (interactive)
-  (save-window-excursion (call-interactively 'describe-variable))
-  (Helper-help-scroller))
-
-(defun Helper-describe-mode ()
-  "Describe the current mode."
-  (interactive)
-  (let ((name mode-name)
-	(documentation (documentation major-mode)))
-    (save-excursion
-      (set-buffer (get-buffer-create "*Help*"))
-      (erase-buffer)
-      (insert name " Mode\n" documentation)
-      (help-mode)))
-  (Helper-help-scroller))
-
-;;;###autoload
-(defun Helper-describe-bindings ()
-  "Describe local key bindings of current mode."
-  (interactive)
-  (message "Making binding list...")
-  (save-window-excursion (describe-bindings))
-  (Helper-help-scroller))
-
-;;;###autoload
-(defun Helper-help ()
-  "Provide help for current mode."
-  (interactive)
-  (let ((continue t) c)
-    (while continue
-      (message "Help (Type ? for further options)")
-      (setq c (read-key-sequence nil))
-      (setq c (lookup-key Helper-help-map c))
-      (cond ((eq c 'Helper-help-options)
-	     (Helper-help-options))
-	    ((commandp c)
-	     (call-interactively c)
-	     (setq continue nil))
-	    (t
-	     (ding)
-	     (setq continue nil))))))
-
-(provide 'helper)
-
-;;; helper.el ends here
diff --git a/lisp/emacs-lisp/levents.el b/lisp/emacs-lisp/levents.el
deleted file mode 100644
index bc5c06c9cbc..00000000000
--- a/lisp/emacs-lisp/levents.el
+++ /dev/null
@@ -1,233 +0,0 @@
-;;; levents.el --- emulate the Lucid event data type and associated functions.
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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:
-
-;; Things we cannot emulate in Lisp:
-;; It is not possible to emulate current-mouse-event as a variable,
-;; though it is not hard to obtain the data from (this-command-keys).
-
-;; We do not have a variable unread-command-event;
-;; instead, we have the more general unread-command-events.
-
-;; Our read-key-sequence and read-char are not precisely
-;; compatible with those in Lucid Emacs, but they should work ok.
-
-;;; Code:
-
-(defun next-command-event (event)
-  (error "You must rewrite to use `read-command-event' instead of `next-command-event'"))
-
-(defun next-event (event)
-  (error "You must rewrite to use `read-event' instead of `next-event'"))
-
-(defun dispatch-event (event)
-  (error "`dispatch-event' not supported"))
-
-;; Make events of type eval, menu and timeout
-;; execute properly.
-
-(define-key global-map [menu] 'execute-eval-event)
-(define-key global-map [timeout] 'execute-eval-event)
-(define-key global-map [eval] 'execute-eval-event)
-
-(defun execute-eval-event (event)
-  (interactive "e")
-  (funcall (nth 1 event) (nth 2 event)))
-
-(put 'eval 'event-symbol-elements '(eval))
-(put 'menu 'event-symbol-elements '(eval))
-(put 'timeout 'event-symbol-elements '(eval))
-
-(defun allocate-event ()
-  "Returns an empty event structure.
-In this emulation, it returns nil."
-  nil)
-
-(defun button-press-event-p (obj)
-  "True if the argument is a mouse-button-press event object."
-  (and (consp obj) (symbolp (car obj))
-       (memq 'down (get (car obj) 'event-symbol-elements))))
-
-(defun button-release-event-p (obj)
-  "True if the argument is a mouse-button-release event object."
-  (and (consp obj) (symbolp (car obj))
-       (or (memq 'click (get (car obj) 'event-symbol-elements))
-	   (memq 'drag (get (car obj) 'event-symbol-elements)))))
-
-(defun character-to-event (ch &optional event)
-  "Converts a numeric ASCII value to an event structure, replete with
-bucky bits.  The character is the first argument, and the event to fill
-in is the second.  This function contains knowledge about what the codes
-mean -- for example, the number 9 is converted to the character Tab,
-not the distinct character Control-I.
-
-Beware that character-to-event and event-to-character are not strictly 
-inverse functions, since events contain much more information than the 
-ASCII character set can encode."
-  ch)
-
-(defun copy-event (event1 &optional event2)
-  "Make a copy of the given event object.
-In this emulation, `copy-event' just returns its argument."
-  event1)
-
-(defun deallocate-event (event)
-  "Allow the given event structure to be reused.
-In actual Lucid Emacs, you MUST NOT use this event object after
-calling this function with it.  You will lose.  It is not necessary to
-call this function, as event objects are garbage- collected like all
-other objects; however, it may be more efficient to explicitly
-deallocate events when you are sure that that is safe.
-
-This emulation does not actually deallocate or reuse events
-except via garbage collection and `cons'."
-  nil)
-
-(defun enqueue-eval-event: (function object)
-  "Add an eval event to the back of the queue.
-It will be the next event read after all pending events."
-  (setq unread-command-events
-	(nconc unread-command-events
-	       (list (list 'eval function object)))))
-
-(defun eval-event-p (obj)
-  "True if the argument is an eval or menu event object."
-  (eq (car-safe obj) 'eval))
-
-(defun event-button (event)
-  "Return the button-number of the given mouse-button-press event."
-  (let ((sym (car (get (car event) 'event-symbol-elements))))
-    (cdr (assq sym '((mouse-1 . 1) (mouse-2 . 2) (mouse-3 . 3)
-		     (mouse-4 . 4) (mouse-5 . 5))))))
-
-(defun event-function (event)
-  "Return the callback function of the given timeout, menu, or eval event."
-  (nth 1 event))
-
-(defun event-key (event)
-  "Returns the KeySym of the given key-press event.
-The value is an ASCII printing character (not upper case) or a symbol."
-  (if (symbolp event)
-      (car (get event 'event-symbol-elements))
-    (let ((base (logand event (1- (lsh 1 18)))))
-      (downcase (if (< base 32) (logior base 64) base)))))
-
-(defun event-object (event)
-  "Returns the function argument of the given timeout, menu, or eval event."
-  (nth 2 event))
-
-(defun event-point (event)
-  "Returns the character position of the given mouse-related event.
-If the event did not occur over a window, or did
-not occur over text, then this returns nil.  Otherwise, it returns an index
-into the buffer visible in the event's window."
-  (posn-point (event-end event)))
-
-(defun event-process (event)
-  "Returns the process of the given process-output event."
-  (nth 1 event))
-
-(defun event-timestamp (event)
-  "Returns the timestamp of the given event object.
-In Lucid Emacs, this works for any kind of event.
-In this emulation, it returns nil for non-mouse-related events."
-  (and (listp event)
-       (posn-timestamp (event-end event))))
-
-(defun event-to-character (event &optional lenient)
-  "Returns the closest ASCII approximation to the given event object.
-If the event isn't a keypress, this returns nil.
-If the second argument is non-nil, then this is lenient in its 
-translation; it will ignore modifier keys other than control and meta,
-and will ignore the shift modifier on those characters which have no 
-shifted ASCII equivalent (Control-Shift-A for example, will be mapped to 
-the same ASCII code as Control-A.)  If the second arg is nil, then nil 
-will be returned for events which have no direct ASCII equivalent."
-  (if (symbolp event)
-      (and lenient
-	   (cdr (assq event '((backspace . 8) (delete . 127) (tab . 9)
-			      (return . 10) (enter . 10)))))
-    ;; Our interpretation is, ASCII means anything a number can represent.
-    (if (integerp event)
-	event nil)))
-
-(defun event-window (event)
-  "Returns the window of the given mouse-related event object."
-  (posn-window (event-end event)))
-
-(defun event-x (event)
-  "Returns the X position in characters of the given mouse-related event."
-  (/ (car (posn-col-row (event-end event)))
-     (frame-char-width (window-frame (event-window event)))))
-
-(defun event-x-pixel (event)
-  "Returns the X position in pixels of the given mouse-related event."
-  (car (posn-col-row (event-end event))))
-
-(defun event-y (event)
-  "Returns the Y position in characters of the given mouse-related event."
-  (/ (cdr (posn-col-row (event-end event)))
-     (frame-char-height (window-frame (event-window event)))))
-
-(defun event-y-pixel (event)
-  "Returns the Y position in pixels of the given mouse-related event."
-  (cdr (posn-col-row (event-end event))))
-
-(defun key-press-event-p (obj)
-  "True if the argument is a keyboard event object."
-  (or (integerp obj)
-      (and (symbolp obj)
-	   (get obj 'event-symbol-elements))))
-
-(defun menu-event-p (obj)
-  "True if the argument is a menu event object."
-  (eq (car-safe obj) 'menu))
-
-(defun motion-event-p (obj)
-  "True if the argument is a mouse-motion event object."
-  (eq (car-safe obj) 'mouse-movement))
-
-(defun read-command-event ()
-  "Return the next keyboard or mouse event; execute other events.
-This is similar to the function `next-command-event' of Lucid Emacs,
-but different in that it returns the event rather than filling in
-an existing event object."
-  (let (event)
-    (while (progn
-	     (setq event (read-event))
-	     (not (or (key-press-event-p event)
-		      (button-press-event-p event)
-		      (button-release-event-p event)
-		      (menu-event-p event))))
-      (let ((type (car-safe event)))
-	(cond ((eq type 'eval)
-	       (funcall (nth 1 event) (nth 2 event)))
-	      ((eq type 'switch-frame)
-	       (select-frame (nth 1 event))))))
-    event))
-
-(defun process-event-p (obj)
-  "True if the argument is a process-output event object.
-GNU Emacs 19 does not currently generate process-output events."
-  (eq (car-safe obj) 'process))
-
-;;; levents.el ends here
diff --git a/lisp/emacs-lisp/lisp-mnt.el b/lisp/emacs-lisp/lisp-mnt.el
deleted file mode 100644
index 8a6af05993f..00000000000
--- a/lisp/emacs-lisp/lisp-mnt.el
+++ /dev/null
@@ -1,554 +0,0 @@
-;;; lisp-mnt.el --- minor mode for Emacs Lisp maintainers
-
-;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Created: 14 Jul 1992
-;; Version: $Id: lisp-mnt.el,v 1.16 1996/02/06 21:35:20 erik Exp rms $
-;; Keywords: docs
-;; X-Bogus-Bureaucratic-Cruft: Gruad will get you if you don't watch out!
-
-;; 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 minor mode adds some services to Emacs-Lisp editing mode.
-;;
-;; First, it knows about the header conventions for library packages.
-;; One entry point supports generating synopses from a library directory.
-;; Another can be used to check for missing headers in library files.
-;; 
-;; Another entry point automatically addresses bug mail to a package's
-;; maintainer or author.
-
-;; This file can be loaded by your lisp-mode-hook.  Have it (require 'lisp-mnt)
-
-;; This file is an example of the header conventions.  Note the following
-;; features:
-;; 
-;;    * Header line --- makes it possible to extract a one-line summary of
-;; the package's uses automatically for use in library synopses, KWIC
-;; indexes and the like.
-;; 
-;;    Format is three semicolons, followed by the filename, followed by
-;; three dashes, followed by the summary.  All fields space-separated.
-;; 
-;;    * Author line --- contains the name and net address of at least
-;; the principal author.
-;; 
-;;    If there are multiple authors, they should be listed on continuation
-;; lines led by ;;<TAB>, like this:
-;; 
-;; ;; Author: Ashwin Ram <Ram-Ashwin@cs.yale.edu>
-;; ;;	Dave Sill <de5@ornl.gov>
-;; ;;	David Lawrence <tale@pawl.rpi.edu>
-;; ;;	Noah Friedman <friedman@ai.mit.edu>
-;; ;;	Joe Wells <jbw@maverick.uswest.com>
-;; ;;	Dave Brennan <brennan@hal.com>
-;; ;;	Eric Raymond <esr@snark.thyrsus.com>
-;; 
-;; This field may have some special values; notably "FSF", meaning
-;; "Free Software Foundation".
-;; 
-;;    * Maintainer line --- should be a single name/address as in the Author
-;; line, or an address only, or the string "FSF".  If there is no maintainer
-;; line, the person(s) in the Author field are presumed to be it.  The example
-;; in this file is mildly bogus because the maintainer line is redundant.
-;;    The idea behind these two fields is to be able to write a Lisp function
-;; that does "send mail to the author" without having to mine the name out by
-;; hand. Please be careful about surrounding the network address with <> if
-;; there's also a name in the field.
-;; 
-;;    * Created line --- optional, gives the original creation date of the
-;; file.  For historical interest, basically.
-;; 
-;;    * Version line --- intended to give the reader a clue if they're looking
-;; at a different version of the file than the one they're accustomed to.  This
-;; may be an RCS or SCCS header.
-;; 
-;;    * Adapted-By line --- this is for FSF's internal use.  The person named
-;; in this field was the one responsible for installing and adapting the
-;; package for the distribution.  (This file doesn't have one because the
-;; author *is* one of the maintainers.)
-;; 
-;;    * Keywords line --- used by the finder code (now under construction)
-;; for finding Emacs Lisp code related to a topic.
-;;
-;;    * X-Bogus-Bureaucratic-Cruft line --- this is a joke and an example
-;; of a comment header.  Headers starting with `X-' should never be used
-;; for any real purpose; this is the way to safely add random headers
-;; without invoking the wrath of any program.
-;;
-;;    * Commentary line --- enables Lisp code to find the developer's and
-;; maintainers' explanations of the package internals.
-;; 
-;;    * Change log line --- optional, exists to terminate the commentary
-;; section and start a change-log part, if one exists.
-;; 
-;;    * Code line --- exists so Lisp can know where commentary and/or
-;; change-log sections end.
-;; 
-;;    * Footer line --- marks end-of-file so it can be distinguished from
-;; an expanded formfeed or the results of truncation.
-
-;;; Change Log:
-
-;; Tue Jul 14 23:44:17 1992	ESR
-;;	* Created.
-
-;;; Code:
-
-(require 'picture)		; provides move-to-column-force
-(require 'emacsbug)
-
-;;; Variables:
-
-(defvar lm-header-prefix "^;;*[ \t]+\\(@\(#\)\\)?[ \t]*\\([\$]\\)?"
-  "Prefix that is ignored before the tag.
-For example, you can write the 1st line synopsis string and headers like this
-in your Lisp package:
-
-   ;; @(#) package.el -- pacakge description
-   ;;
-   ;; @(#) $Maintainer:   Person Foo Bar $
-
-The @(#) construct is used by unix what(1) and
-then $identifier: doc string $ is used by GNU ident(1)")
-
-(defvar lm-comment-column 16
-  "Column used for placing formatted output.")
-
-(defvar lm-commentary-header "Commentary\\|Documentation"
-  "Regexp which matches start of documentation section.")
-
-(defvar lm-history-header "Change Log\\|History"
-  "Regexp which matches the start of code log section.")
-
-;;; Functions:
-
-;; These functions all parse the headers of the current buffer
-
-(defsubst lm-get-header-re (header &optional mode)
-  "Returns regexp for matching HEADER.
-If called with optional MODE and with value `section',
-return section regexp instead."
-  (cond ((eq mode 'section)
-	 (concat "^;;;;* " header ":[ \t]*$"))
-	(t
-	 (concat lm-header-prefix header ":[ \t]*"))))
-
-(defsubst lm-get-package-name ()
-  "Returns package name by looking at the first line."
-  (save-excursion
-    (goto-char (point-min))
-    (if (and (looking-at (concat lm-header-prefix))
-	     (progn (goto-char (match-end 0))
-		    (looking-at "\\([^\t ]+\\)")
-		    (match-end 1)))
-	(buffer-substring (match-beginning 1) (match-end 1))
-      )))
-
-(defun lm-section-mark (header &optional after)
-  "Return the buffer location of a given section start marker.
-The HEADER is the section mark string to search for.
-If AFTER is non-nil, return the location of the next line."
-  (save-excursion
-    (let ((case-fold-search t))
-      (goto-char (point-min))
-      (if (re-search-forward (lm-get-header-re header 'section) nil t)
-	  (progn
-	    (beginning-of-line)
-	    (if after (forward-line 1))
-	    (point))
-	nil))))
-
-(defsubst lm-code-mark ()
-  "Return the buffer location of the `Code' start marker."
-  (lm-section-mark "Code"))
-
-(defsubst lm-commentary-mark ()
-  "Return the buffer location of the `Commentary' start marker."
-  (lm-section-mark lm-commentary-header))
-
-(defsubst lm-history-mark ()
-  "Return the buffer location of the `History' start marker."
-  (lm-section-mark lm-history-header))
-
-(defun lm-header (header)
-  "Return the contents of the header named HEADER."
-  (goto-char (point-min))
-  (let ((case-fold-search t))
-    (if (and (re-search-forward (lm-get-header-re header) (lm-code-mark) t)
-	     ;;   RCS ident likes format "$identifier: data$"
-	     (looking-at "\\([^$\n]+\\)")
-	     (match-end 1))
-	(buffer-substring (match-beginning 1) (match-end 1))
-      nil)))
-
-(defun lm-header-multiline (header)
-  "Return the contents of the header named HEADER, with continuation lines.
-The returned value is a list of strings, one per line."
-  (save-excursion
-    (goto-char (point-min))
-    (let ((res (lm-header header)))
-      (cond
-       (res
-	(setq res (list res))
-	(forward-line 1)
-
-	(while (and (looking-at (concat lm-header-prefix "[\t ]+"))
-		    (progn
-		      (goto-char (match-end 0))
-		      (looking-at "\\(.*\\)"))
-		    (match-end 1))
-	  (setq res (cons (buffer-substring
-			   (match-beginning 1)
-			   (match-end 1))
-			  res))
-	  (forward-line 1))
-	))
-      res
-      )))
-
-;; These give us smart access to the header fields and commentary
-
-(defun lm-summary (&optional file)
-  "Return the one-line summary of file FILE, or current buffer if FILE is nil."
-  (save-excursion
-    (if file
-	(find-file file))
-    (goto-char (point-min))
-    (prog1
-      (if (and
-	   (looking-at lm-header-prefix)
-	   (progn (goto-char (match-end 0))
-		  (looking-at "[^ ]+[ \t]+--+[ \t]+\\(.*\\)")))
-	  (buffer-substring (match-beginning 1) (match-end 1)))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-crack-address (x)
-  "Split up an email address into full name and real email address.
-The value is a cons of the form (FULLNAME . ADDRESS)."
-  (cond ((string-match "\\(.+\\) [(<]\\(\\S-+@\\S-+\\)[>)]" x)
-	 (cons (substring x (match-beginning 1) (match-end 1))
-	       (substring x (match-beginning 2) (match-end 2))))
-	((string-match "\\(\\S-+@\\S-+\\) [(<]\\(.*\\)[>)]" x)
-	 (cons (substring x (match-beginning 2) (match-end 2))
-	       (substring x (match-beginning 1) (match-end 1))))
-	((string-match "\\S-+@\\S-+" x)
-	 (cons nil x))
-	(t
-	 (cons x nil))))
-
-(defun lm-authors (&optional file)
-  "Return the author list of file FILE, or current buffer if FILE is nil.
-Each element of the list is a cons; the car is the full name,
-the cdr is an email address."
-  (save-excursion
-    (if file
-	(find-file file))
-    (let ((authorlist (lm-header-multiline "author")))
-      (prog1
-	 (mapcar 'lm-crack-address authorlist)
-	  (if file
-	      (kill-buffer (current-buffer)))
-	))))
-
-(defun lm-maintainer (&optional file)
-  "Return the maintainer of file FILE, or current buffer if FILE is nil.
-The return value has the form (NAME . ADDRESS)."
-  (save-excursion
-    (if file
-	(find-file file))
-    (prog1
-	(let ((maint (lm-header "maintainer")))
-	  (if maint
-	      (lm-crack-address maint)
-	    (car (lm-authors))))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-creation-date (&optional file)
-  "Return the created date given in file FILE, or current buffer if FILE is nil."
-  (save-excursion
-    (if file
-	(find-file file))
-    (prog1
-	(lm-header "created")
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-
-(defun lm-last-modified-date (&optional file)
-  "Return the modify-date given in file FILE, or current buffer if FILE is nil."
-  (save-excursion 
-    (if file
-	(find-file file))
-    (prog1
-	(if (progn
-	      (goto-char (point-min))
-	      (re-search-forward
-	       "\\$Id: [^ ]+ [^ ]+ \\([^/]+\\)/\\([^/]+\\)/\\([^ ]+\\) "
-	       (lm-code-mark) t))
-	    (format "%s %s %s"
-		    (buffer-substring (match-beginning 3) (match-end 3))
-		    (nth (string-to-int 
-			  (buffer-substring (match-beginning 2) (match-end 2)))
-			 '("" "Jan" "Feb" "Mar" "Apr" "May" "Jun"
-			   "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))
-		    (buffer-substring (match-beginning 1) (match-end 1))
-		    ))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-version (&optional file)
-  "Return the version listed in file FILE, or current buffer if FILE is nil.
-This can befound in an RCS or SCCS header to crack it out of."
-  (save-excursion 
-    (if file
-	(find-file file))
-    (prog1
-	(or
-	 (lm-header "version")
-	 (let ((header-max (lm-code-mark)))
-	   (goto-char (point-min))
-	   (cond
-	    ;; Look for an RCS header
-	    ((re-search-forward "\\$Id: [^ ]+ \\([^ ]+\\) " header-max t)
-	     (buffer-substring (match-beginning 1) (match-end 1)))
-
-	    ;; Look for an SCCS header
-	    ((re-search-forward 
-	      (concat
-	       (regexp-quote "@(#)")
-	       (regexp-quote (file-name-nondirectory (buffer-file-name)))
-	       "\t\\([012345679.]*\\)")
-	      header-max t)
-	     (buffer-substring (match-beginning 1) (match-end 1)))
-
-	    (t nil))))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-keywords (&optional file)
-  "Return the keywords given in file FILE, or current buffer if FILE is nil."
-  (save-excursion
-    (if file
-	(find-file file))
-    (prog1
-	(let ((keywords (lm-header "keywords")))
-	  (and keywords (downcase keywords)))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-adapted-by (&optional file)
-  "Return the adapted-by names in file FILE, or current buffer if FILE is nil.
-This is the name of the person who cleaned up this package for
-distribution."
-  (save-excursion
-    (if file
-	(find-file file))
-    (prog1
-	(lm-header "adapted-by")
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-(defun lm-commentary (&optional file)
-  "Return the commentary in file FILE, or current buffer if FILE is nil.
-The value is returned as a string.  In the text, the commentary starts
-with tag `Commentary' and ends with tag `Change Log' or `History'."
-  (save-excursion
-    (if file
-	(find-file file))
-    (prog1
-	(let ((commentary	(lm-commentary-mark))
-	      (change-log	(lm-history-mark))
-	      (code		(lm-code-mark))
-	      )
-	  (cond
-	   ((and commentary change-log)
-	    (buffer-substring commentary change-log))
-	   ((and commentary code)
-	    (buffer-substring commentary code))
-	   (t
-	    nil)))
-      (if file
-	  (kill-buffer (current-buffer)))
-      )))
-
-;;; Verification and synopses
-
-(defun lm-insert-at-column (col &rest strings)
-  "Insert list of STRINGS, at column COL."
-  (if (> (current-column) col) (insert "\n"))
-  (move-to-column-force col)
-  (apply 'insert strings))
-
-(defun lm-verify (&optional file showok &optional verb)
-  "Check that the current buffer (or FILE if given) is in proper format.
-If FILE is a directory, recurse on its files and generate a report in
-a temporary buffer."
-  (interactive)
-  (let* ((verb    (or verb (interactive-p)))
-	 ret
-	 name
-	 )
-    (if verb
-	(setq ret "Ok."))		;init value
-
-    (if (and file (file-directory-p file))
-	(setq
-	 ret
-	 (progn
-	   (switch-to-buffer (get-buffer-create "*lm-verify*"))
-	   (erase-buffer)
-	   (mapcar
-	    '(lambda (f)
-	       (if (string-match ".*\\.el$" f)
-		   (let ((status (lm-verify f)))
-		     (if status
-			 (progn
-			   (insert f ":")
-			   (lm-insert-at-column lm-comment-column status "\n"))
-		       (and showok
-			    (progn
-			      (insert f ":")
-			      (lm-insert-at-column lm-comment-column "OK\n")))))))
-	    (directory-files file))
-	   ))
-      (save-excursion
-	(if file
-	    (find-file file))
-	(setq name (lm-get-package-name))
-
-	(setq
-	 ret
-	 (prog1
-	     (cond
-	      ((null name)
-	       "Can't find a package NAME")
-
-	      ((not (lm-authors))
-	       "Author: tag missing.")
-
-	      ((not (lm-maintainer))
-	       "Maintainer: tag missing.")
-
-	      ((not (lm-summary))
-	       "Can't find a one-line 'Summary' description")
-
-	      ((not (lm-keywords))
-	       "Keywords: tag missing.")
-
-	      ((not (lm-commentary-mark))
-	       "Can't find a 'Commentary' section marker.")
-
-	      ((not (lm-history-mark))
-	       "Can't find a 'History' section marker.")
-
-	      ((not (lm-code-mark))
-	       "Can't find a 'Code' section marker")
-
-	      ((progn
-		 (goto-char (point-max))
-		 (not
-		  (re-search-backward
-		   (concat "^;;;[ \t]+" name "[ \t]+ends here[ \t]*$"
-			   "\\|^;;;[ \t]+ End of file[ \t]+" name)
-		   nil t
-		   )))
-	       (format "Can't find a footer line for [%s]" name))
-	      (t
-	       ret))
-	   (if file
-	       (kill-buffer (current-buffer)))
-	  ))))
-    (if verb
-	(message ret))
-    ret
-    ))
-
-(defun lm-synopsis (&optional file showall)
-  "Generate a synopsis listing for the buffer or the given FILE if given.
-If FILE is a directory, recurse on its files and generate a report in
-a temporary buffer.  If SHOWALL is non-nil, also generate a line for files
-which do not include a recognizable synopsis."
-  (interactive
-   (list
-    (read-file-name "Synopsis for (file or dir): ")))
-
-  (if (and file (file-directory-p file))
-      (progn
-	(switch-to-buffer (get-buffer-create "*lm-verify*"))
-	(erase-buffer)
-	(mapcar
-	 '(lambda (f)
-	    (if (string-match ".*\\.el$" f)
-		(let ((syn (lm-synopsis f)))
-		  (if syn
-		      (progn
-			(insert f ":")
-			(lm-insert-at-column lm-comment-column syn "\n"))
-		    (and showall
-			 (progn
-			   (insert f ":")
-			   (lm-insert-at-column lm-comment-column "NA\n")))))))
-	 (directory-files file))
-	)
-    (save-excursion
-      (if file
-	  (find-file file))
-      (prog1
-	  (lm-summary)
-	(if file
-	    (kill-buffer (current-buffer)))
-	))))
-
-(defun lm-report-bug (topic)
-  "Report a bug in the package currently being visited to its maintainer.
-Prompts for bug subject.  Leaves you in a mail buffer."
-  (interactive "sBug Subject: ")
-  (let ((package	(lm-get-package-name))
-	(addr		(lm-maintainer))
-	(version	(lm-version)))
-    (mail nil
-	  (if addr
-	      (concat (car addr) " <" (cdr addr) ">")
-	    bug-gnu-emacs)
-	  topic)
-    (goto-char (point-max))
-    (insert "\nIn "
-	    package
-	    (if version (concat " version " version) "")
-	    "\n\n")
-    (message
-     (substitute-command-keys "Type \\[mail-send] to send bug report."))))
-
-(provide 'lisp-mnt)
-
-;;; lisp-mnt.el ends here
-
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
deleted file mode 100644
index 26eab753c38..00000000000
--- a/lisp/emacs-lisp/lisp-mode.el
+++ /dev/null
@@ -1,838 +0,0 @@
-;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands.
-
-;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: lisp, languages
-
-;; 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:
-
-;; The base major mode for editing Lisp code (used also for Emacs Lisp).
-;; This mode is documented in the Emacs manual
-
-;;; Code:
-
-(defvar lisp-mode-syntax-table nil "")
-(defvar emacs-lisp-mode-syntax-table nil "")
-(defvar lisp-mode-abbrev-table nil "")
-
-(if (not emacs-lisp-mode-syntax-table)
-    (let ((i 0))
-      (setq emacs-lisp-mode-syntax-table (make-syntax-table))
-      (while (< i ?0)
-	(modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
-	(setq i (1+ i)))
-      (setq i (1+ ?9))
-      (while (< i ?A)
-	(modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
-	(setq i (1+ i)))
-      (setq i (1+ ?Z))
-      (while (< i ?a)
-	(modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
-	(setq i (1+ i)))
-      (setq i (1+ ?z))
-      (while (< i 128)
-	(modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
-	(setq i (1+ i)))
-      (modify-syntax-entry ?  "    " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\t "    " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\n ">   " emacs-lisp-mode-syntax-table)
-      ;; Give CR the same syntax as newline, for selective-display.
-      (modify-syntax-entry ?\^m ">   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\; "<   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?` "'   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?' "'   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?, "'   " emacs-lisp-mode-syntax-table)
-      ;; Used to be singlequote; changed for flonums.
-      (modify-syntax-entry ?. "_   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?# "'   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\" "\"    " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\\ "\\   " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\( "()  " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\) ")(  " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\[ "(]  " emacs-lisp-mode-syntax-table)
-      (modify-syntax-entry ?\] ")[  " emacs-lisp-mode-syntax-table)))
-
-(if (not lisp-mode-syntax-table)
-    (progn (setq lisp-mode-syntax-table
-		 (copy-syntax-table emacs-lisp-mode-syntax-table))
-	   (modify-syntax-entry ?\| "\"   " lisp-mode-syntax-table)
-	   (modify-syntax-entry ?\[ "_   " lisp-mode-syntax-table)
-	   (modify-syntax-entry ?\] "_   " lisp-mode-syntax-table)))
-
-(define-abbrev-table 'lisp-mode-abbrev-table ())
-
-(defvar lisp-imenu-generic-expression
-      '(
-	(nil 
-	 "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2)
-	("Variables" 
-	 "^\\s-*(def\\(var\\|const\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2)
-	("Types" 
-	 "^\\s-*(def\\(type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+]+\\)" 
-	 2))
-
-  "Imenu generic expression for Lisp mode.  See `imenu-generic-expression'.")
-
-(defun lisp-mode-variables (lisp-syntax)
-  (cond (lisp-syntax
-	  (set-syntax-table lisp-mode-syntax-table)))
-  (setq local-abbrev-table lisp-mode-abbrev-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat page-delimiter "\\|$" ))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'lisp-fill-paragraph)
-  ;; Adaptive fill mode gets in the way of auto-fill,
-  ;; and should make no difference for explicit fill
-  ;; because lisp-fill-paragraph should do the job.
-  (make-local-variable 'adaptive-fill-mode)
-  (setq adaptive-fill-mode nil)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'lisp-indent-line)
-  (make-local-variable 'indent-region-function)
-  (setq indent-region-function 'lisp-indent-region)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (make-local-variable 'outline-regexp)
-  (setq outline-regexp ";;; \\|(....")
-  (make-local-variable 'comment-start)
-  (setq comment-start ";")
-  (make-local-variable 'comment-start-skip)
-  ;; Look within the line for a ; following an even number of backslashes
-  ;; after either a non-backslash or the line beginning.
-  (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'lisp-comment-indent)
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression lisp-imenu-generic-expression))
-
-(defvar shared-lisp-mode-map ()
-  "Keymap for commands shared by all sorts of Lisp modes.")
-
-(if shared-lisp-mode-map
-    ()
-   (setq shared-lisp-mode-map (make-sparse-keymap))
-   (define-key shared-lisp-mode-map "\e\C-q" 'indent-sexp)
-   (define-key shared-lisp-mode-map "\177" 'backward-delete-char-untabify))
-
-(defvar emacs-lisp-mode-map ()
-  "Keymap for Emacs Lisp mode.
-All commands in `shared-lisp-mode-map' are inherited by this map.")
-
-(if emacs-lisp-mode-map
-    ()
-  (let ((map (make-sparse-keymap "Emacs-Lisp")))
-    (setq emacs-lisp-mode-map
-	  (nconc (make-sparse-keymap) shared-lisp-mode-map))
-    (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol)
-    (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun)
-    (define-key emacs-lisp-mode-map [menu-bar] (make-sparse-keymap))
-    (define-key emacs-lisp-mode-map [menu-bar emacs-lisp]
-      (cons "Emacs-Lisp" map))
-    (define-key map [edebug-defun]
-      '("Instrument Function for Debugging" . edebug-defun))
-    (define-key map [byte-recompile]
-      '("Byte-recompile Directory..." . byte-recompile-directory))
-    (define-key map [emacs-byte-compile-and-load]
-      '("Byte-compile And Load" . emacs-lisp-byte-compile-and-load))
-    (define-key map [byte-compile]
-      '("Byte-compile This File" . emacs-lisp-byte-compile))
-    (define-key map [separator-eval] '("--"))
-    (define-key map [eval-buffer] '("Evaluate Buffer" . eval-current-buffer))
-    (define-key map [eval-region] '("Evaluate Region" . eval-region))
-    (define-key map [eval-sexp] '("Evaluate Last S-expression" . eval-last-sexp))
-    (define-key map [separator-format] '("--"))
-    (define-key map [comment-region] '("Comment Out Region" . comment-region))
-    (define-key map [indent-region] '("Indent Region" . indent-region))
-    (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
-    (put 'eval-region 'menu-enable 'mark-active)
-    (put 'comment-region 'menu-enable 'mark-active)
-    (put 'indent-region 'menu-enable 'mark-active)))
-
-(defun emacs-lisp-byte-compile ()
-  "Byte compile the file containing the current buffer."
-  (interactive)
-  (if buffer-file-name
-      (byte-compile-file buffer-file-name)
-    (error "The buffer must be saved in a file first")))
-
-(defun emacs-lisp-byte-compile-and-load ()
-  "Byte-compile the current file (if it has changed), then load compiled code."
-  (interactive)
-  (or buffer-file-name
-      (error "The buffer must be saved in a file first"))
-  (require 'bytecomp)
-  ;; Recompile if file or buffer has changed since last compilation.
-  (if (and (buffer-modified-p)
-	   (y-or-n-p (format "save buffer %s first? " (buffer-name))))
-      (save-buffer))
-  (let ((compiled-file-name (byte-compile-dest-file buffer-file-name)))
-    (if (file-newer-than-file-p compiled-file-name buffer-file-name)
-	(load-file compiled-file-name)
-      (byte-compile-file buffer-file-name t))))
-
-(defun emacs-lisp-mode ()
-  "Major mode for editing Lisp code to run in Emacs.
-Commands:
-Delete converts tabs to spaces as it moves back.
-Blank lines separate paragraphs.  Semicolons start comments.
-\\{emacs-lisp-mode-map}
-Entry to this mode calls the value of `emacs-lisp-mode-hook'
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map emacs-lisp-mode-map)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (setq major-mode 'emacs-lisp-mode)
-  (setq mode-name "Emacs-Lisp")
-  (lisp-mode-variables nil)
-  (run-hooks 'emacs-lisp-mode-hook))
-
-(defvar lisp-mode-map ()
-  "Keymap for ordinary Lisp mode.
-All commands in `shared-lisp-mode-map' are inherited by this map.")
-
-(if lisp-mode-map
-    ()
-  (setq lisp-mode-map
-	(nconc (make-sparse-keymap) shared-lisp-mode-map))
-  (define-key lisp-mode-map "\e\C-x" 'lisp-eval-defun)
-  (define-key lisp-mode-map "\C-c\C-z" 'run-lisp))
-
-(defun lisp-mode ()
-  "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
-Commands:
-Delete converts tabs to spaces as it moves back.
-Blank lines separate paragraphs.  Semicolons start comments.
-\\{lisp-mode-map}
-Note that `run-lisp' may be used either to start an inferior Lisp job
-or to switch back to an existing one.
-
-Entry to this mode calls the value of `lisp-mode-hook'
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map lisp-mode-map)
-  (setq major-mode 'lisp-mode)
-  (setq mode-name "Lisp")
-  (lisp-mode-variables t)
-  (set-syntax-table lisp-mode-syntax-table)
-  (run-hooks 'lisp-mode-hook))
-
-;; This will do unless shell.el is loaded.
-(defun lisp-eval-defun nil
-  "Send the current defun to the Lisp process made by \\[run-lisp]."
-  (interactive)
-  (error "Process lisp does not exist"))
-
-(defvar lisp-interaction-mode-map ()
-  "Keymap for Lisp Interaction moe.
-All commands in `shared-lisp-mode-map' are inherited by this map.")
-
-(if lisp-interaction-mode-map
-    ()
-  (setq lisp-interaction-mode-map
-	(nconc (make-sparse-keymap) shared-lisp-mode-map))
-  (define-key lisp-interaction-mode-map "\e\C-x" 'eval-defun)
-  (define-key lisp-interaction-mode-map "\e\t" 'lisp-complete-symbol)
-  (define-key lisp-interaction-mode-map "\n" 'eval-print-last-sexp))
-
-(defun lisp-interaction-mode ()
-  "Major mode for typing and evaluating Lisp forms.
-Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
-before point, and prints its value into the buffer, advancing point.
-
-Commands:
-Delete converts tabs to spaces as it moves back.
-Paragraphs are separated only by blank lines.
-Semicolons start comments.
-\\{lisp-interaction-mode-map}
-Entry to this mode calls the value of `lisp-interaction-mode-hook'
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map lisp-interaction-mode-map)
-  (setq major-mode 'lisp-interaction-mode)
-  (setq mode-name "Lisp Interaction")
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (lisp-mode-variables nil)
-  (run-hooks 'lisp-interaction-mode-hook))
-
-(defun eval-print-last-sexp ()
-  "Evaluate sexp before point; print value into current buffer."
-  (interactive)
-  (let ((standard-output (current-buffer)))
-    (terpri)
-    (eval-last-sexp t)
-    (terpri)))
-
-(defun eval-last-sexp (eval-last-sexp-arg-internal)
-  "Evaluate sexp before point; print value in minibuffer.
-With argument, print output into current buffer."
-  (interactive "P")
-  (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))
-	(opoint (point)))
-    (prin1 (let ((stab (syntax-table)))
-	     (eval (unwind-protect
-		       (save-excursion
-			 (set-syntax-table emacs-lisp-mode-syntax-table)
-			 (forward-sexp -1)
-			 (save-restriction
-			   (narrow-to-region (point-min) opoint)
-			   (read (current-buffer))))
-		     (set-syntax-table stab)))))))
-
-(defun eval-defun (eval-defun-arg-internal)
-  "Evaluate defun that point is in or before.
-Print value in minibuffer.
-With argument, insert value in current buffer after the defun."
-  (interactive "P")
-  (let ((standard-output (if eval-defun-arg-internal (current-buffer) t))
-	(form (save-excursion
-		(end-of-defun)
-		(beginning-of-defun)
-		(read (current-buffer)))))
-    (if (and (eq (car form) 'defvar)
-	     (cdr-safe (cdr-safe form)))
-	(setq form (cons 'defconst (cdr form))))
-    (prin1 (eval form))))
-
-(defun lisp-comment-indent ()
-  (if (looking-at "\\s<\\s<\\s<")
-      (current-column)
-    (if (looking-at "\\s<\\s<")
-	(let ((tem (calculate-lisp-indent)))
-	  (if (listp tem) (car tem) tem))
-      (skip-chars-backward " \t")
-      (max (if (bolp) 0 (1+ (current-column)))
-	   comment-column))))
-
-(defvar lisp-indent-offset nil "")
-(defvar lisp-indent-function 'lisp-indent-function "")
-
-(defun lisp-indent-line (&optional whole-exp)
-  "Indent current line as Lisp code.
-With argument, indent any additional lines of the same expression
-rigidly along with this one."
-  (interactive "P")
-  (let ((indent (calculate-lisp-indent)) shift-amt beg end
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (skip-chars-forward " \t")
-    (if (looking-at "\\s<\\s<\\s<")
-	;; Don't alter indentation of a ;;; comment line.
-	(goto-char (- (point-max) pos))
-      (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
-	  ;; Single-semicolon comment lines should be indented
-	  ;; as comment lines, not as code.
-	  (progn (indent-for-comment) (forward-char -1))
-	(if (listp indent) (setq indent (car indent)))
-	(setq shift-amt (- indent (current-column)))
-	(if (zerop shift-amt)
-	    nil
-	  (delete-region beg (point))
-	  (indent-to indent)))
-      ;; If initial point was within line's indentation,
-      ;; position after the indentation.  Else stay at same point in text.
-      (if (> (- (point-max) pos) (point))
-	  (goto-char (- (point-max) pos)))
-      ;; If desired, shift remaining lines of expression the same amount.
-      (and whole-exp (not (zerop shift-amt))
-	   (save-excursion
-	     (goto-char beg)
-	     (forward-sexp 1)
-	     (setq end (point))
-	     (goto-char beg)
-	     (forward-line 1)
-	     (setq beg (point))
-	     (> end beg))
-	   (indent-code-rigidly beg end shift-amt)))))
-
-(defvar calculate-lisp-indent-last-sexp)
-
-(defun calculate-lisp-indent (&optional parse-start)
-  "Return appropriate indentation for current line as Lisp code.
-In usual case returns an integer: the column to indent to.
-Can instead return a list, whose car is the column to indent to.
-This means that following lines at the same level of indentation
-should not necessarily be indented the same way.
-The second element of the list is the buffer position
-of the start of the containing expression."
-  (save-excursion
-    (beginning-of-line)
-    (let ((indent-point (point))
-          state paren-depth
-          ;; setting this to a number inhibits calling hook
-          (desired-indent nil)
-          (retry t)
-          calculate-lisp-indent-last-sexp containing-sexp)
-      (if parse-start
-          (goto-char parse-start)
-          (beginning-of-defun))
-      ;; Find outermost containing sexp
-      (while (< (point) indent-point)
-        (setq state (parse-partial-sexp (point) indent-point 0)))
-      ;; Find innermost containing sexp
-      (while (and retry
-		  state
-                  (> (setq paren-depth (elt state 0)) 0))
-        (setq retry nil)
-        (setq calculate-lisp-indent-last-sexp (elt state 2))
-        (setq containing-sexp (elt state 1))
-        ;; Position following last unclosed open.
-        (goto-char (1+ containing-sexp))
-        ;; Is there a complete sexp since then?
-        (if (and calculate-lisp-indent-last-sexp
-		 (> calculate-lisp-indent-last-sexp (point)))
-            ;; Yes, but is there a containing sexp after that?
-            (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp
-					    indent-point 0)))
-              (if (setq retry (car (cdr peek))) (setq state peek)))))
-      (if retry
-          nil
-        ;; Innermost containing sexp found
-        (goto-char (1+ containing-sexp))
-        (if (not calculate-lisp-indent-last-sexp)
-	    ;; indent-point immediately follows open paren.
-	    ;; Don't call hook.
-            (setq desired-indent (current-column))
-	  ;; Find the start of first element of containing sexp.
-	  (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
-	  (cond ((looking-at "\\s(")
-		 ;; First element of containing sexp is a list.
-		 ;; Indent under that list.
-		 )
-		((> (save-excursion (forward-line 1) (point))
-		    calculate-lisp-indent-last-sexp)
-		 ;; This is the first line to start within the containing sexp.
-		 ;; It's almost certainly a function call.
-		 (if (= (point) calculate-lisp-indent-last-sexp)
-		     ;; Containing sexp has nothing before this line
-		     ;; except the first element.  Indent under that element.
-		     nil
-		   ;; Skip the first element, find start of second (the first
-		   ;; argument of the function call) and indent under.
-		   (progn (forward-sexp 1)
-			  (parse-partial-sexp (point)
-					      calculate-lisp-indent-last-sexp
-					      0 t)))
-		 (backward-prefix-chars))
-		(t
-		 ;; Indent beneath first sexp on same line as
-		 ;; calculate-lisp-indent-last-sexp.  Again, it's
-		 ;; almost certainly a function call.
-		 (goto-char calculate-lisp-indent-last-sexp)
-		 (beginning-of-line)
-		 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp
-				     0 t)
-		 (backward-prefix-chars)))))
-      ;; Point is at the point to indent under unless we are inside a string.
-      ;; Call indentation hook except when overridden by lisp-indent-offset
-      ;; or if the desired indentation has already been computed.
-      (let ((normal-indent (current-column)))
-        (cond ((elt state 3)
-               ;; Inside a string, don't change indentation.
-               (goto-char indent-point)
-               (skip-chars-forward " \t")
-               (current-column))
-              ((and (integerp lisp-indent-offset) containing-sexp)
-               ;; Indent by constant offset
-               (goto-char containing-sexp)
-               (+ (current-column) lisp-indent-offset))
-              (desired-indent)
-              ((and (boundp 'lisp-indent-function)
-                    lisp-indent-function
-                    (not retry))
-               (or (funcall lisp-indent-function indent-point state)
-                   normal-indent))
-              (t
-               normal-indent))))))
-
-(defun lisp-indent-function (indent-point state)
-  (let ((normal-indent (current-column)))
-    (goto-char (1+ (elt state 1)))
-    (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
-    (if (and (elt state 2)
-             (not (looking-at "\\sw\\|\\s_")))
-        ;; car of form doesn't seem to be a a symbol
-        (progn
-          (if (not (> (save-excursion (forward-line 1) (point))
-                      calculate-lisp-indent-last-sexp))
-              (progn (goto-char calculate-lisp-indent-last-sexp)
-                     (beginning-of-line)
-                     (parse-partial-sexp (point)
-					 calculate-lisp-indent-last-sexp 0 t)))
-          ;; Indent under the list or under the first sexp on the same
-          ;; line as calculate-lisp-indent-last-sexp.  Note that first
-          ;; thing on that line has to be complete sexp since we are
-          ;; inside the innermost containing sexp.
-          (backward-prefix-chars)
-          (current-column))
-      (let ((function (buffer-substring (point)
-					(progn (forward-sexp 1) (point))))
-	    method)
-	(setq method (or (get (intern-soft function) 'lisp-indent-function)
-			 (get (intern-soft function) 'lisp-indent-hook)))
-	(cond ((or (eq method 'defun)
-		   (and (null method)
-			(> (length function) 3)
-			(string-match "\\`def" function)))
-	       (lisp-indent-defform state indent-point))
-	      ((integerp method)
-	       (lisp-indent-specform method state
-				     indent-point normal-indent))
-	      (method
-		(funcall method state indent-point)))))))
-
-(defvar lisp-body-indent 2
-  "Number of columns to indent the second line of a `(def...)' form.")
-
-(defun lisp-indent-specform (count state indent-point normal-indent)
-  (let ((containing-form-start (elt state 1))
-        (i count)
-        body-indent containing-form-column)
-    ;; Move to the start of containing form, calculate indentation
-    ;; to use for non-distinguished forms (> count), and move past the
-    ;; function symbol.  lisp-indent-function guarantees that there is at
-    ;; least one word or symbol character following open paren of containing
-    ;; form.
-    (goto-char containing-form-start)
-    (setq containing-form-column (current-column))
-    (setq body-indent (+ lisp-body-indent containing-form-column))
-    (forward-char 1)
-    (forward-sexp 1)
-    ;; Now find the start of the last form.
-    (parse-partial-sexp (point) indent-point 1 t)
-    (while (and (< (point) indent-point)
-                (condition-case ()
-                    (progn
-                      (setq count (1- count))
-                      (forward-sexp 1)
-                      (parse-partial-sexp (point) indent-point 1 t))
-                  (error nil))))
-    ;; Point is sitting on first character of last (or count) sexp.
-    (if (> count 0)
-        ;; A distinguished form.  If it is the first or second form use double
-        ;; lisp-body-indent, else normal indent.  With lisp-body-indent bound
-        ;; to 2 (the default), this just happens to work the same with if as
-        ;; the older code, but it makes unwind-protect, condition-case,
-        ;; with-output-to-temp-buffer, et. al. much more tasteful.  The older,
-        ;; less hacked, behavior can be obtained by replacing below with
-        ;; (list normal-indent containing-form-start).
-        (if (<= (- i count) 1)
-            (list (+ containing-form-column (* 2 lisp-body-indent))
-                  containing-form-start)
-            (list normal-indent containing-form-start))
-      ;; A non-distinguished form.  Use body-indent if there are no
-      ;; distinguished forms and this is the first undistinguished form,
-      ;; or if this is the first undistinguished form and the preceding
-      ;; distinguished form has indentation at least as great as body-indent.
-      (if (or (and (= i 0) (= count 0))
-              (and (= count 0) (<= body-indent normal-indent)))
-          body-indent
-          normal-indent))))
-
-(defun lisp-indent-defform (state indent-point)
-  (goto-char (car (cdr state)))
-  (forward-line 1)
-  (if (> (point) (car (cdr (cdr state))))
-      (progn
-	(goto-char (car (cdr state)))
-	(+ lisp-body-indent (current-column)))))
-
-
-;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented
-;; like defun if the first form is placed on the next line, otherwise
-;; it is indented like any other form (i.e. forms line up under first).
-
-(put 'lambda 'lisp-indent-function 'defun)
-(put 'autoload 'lisp-indent-function 'defun)
-(put 'progn 'lisp-indent-function 0)
-(put 'prog1 'lisp-indent-function 1)
-(put 'prog2 'lisp-indent-function 2)
-(put 'save-excursion 'lisp-indent-function 0)
-(put 'save-window-excursion 'lisp-indent-function 0)
-(put 'save-selected-window 'lisp-indent-function 0)
-(put 'save-restriction 'lisp-indent-function 0)
-(put 'save-match-data 'lisp-indent-function 0)
-(put 'save-current-buffer 'lisp-indent-function 0)
-(put 'with-current-buffer 'lisp-indent-function 1)
-(put 'combine-after-change-calls 'lisp-indent-function 0)
-(put 'with-output-to-string 'lisp-indent-function 0)
-(put 'with-temp-file 'lisp-indent-function 1)
-(put 'with-temp-buffer 'lisp-indent-function 0)
-(put 'let 'lisp-indent-function 1)
-(put 'let* 'lisp-indent-function 1)
-(put 'while 'lisp-indent-function 1)
-(put 'if 'lisp-indent-function 2)
-(put 'catch 'lisp-indent-function 1)
-(put 'condition-case 'lisp-indent-function 2)
-(put 'unwind-protect 'lisp-indent-function 1)
-(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
-(put 'eval-after-load 'lisp-indent-function 1)
-
-(defun indent-sexp (&optional endpos)
-  "Indent each line of the list starting just after point.
-If optional arg ENDPOS is given, indent each line, stopping when
-ENDPOS is encountered."
-  (interactive)
-  (let ((indent-stack (list nil))
-	(next-depth 0)
-	;; If ENDPOS is non-nil, use nil as STARTING-POINT
-	;; so that calculate-lisp-indent will find the beginning of
-	;; the defun we are in.
-	;; If ENDPOS is nil, it is safe not to scan before point
-	;; since every line we indent is more deeply nested than point is.
-	(starting-point (if endpos nil (point)))
-	(last-point (point))
-	last-depth bol outer-loop-done inner-loop-done state this-indent)
-    (or endpos
-	;; Get error now if we don't have a complete sexp after point.
-	(save-excursion (forward-sexp 1)))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (if endpos (< (point) endpos)
-	       (not outer-loop-done))
-	(setq last-depth next-depth
-	      inner-loop-done nil)
-	;; Parse this line so we can learn the state
-	;; to indent the next line.
-	;; This inner loop goes through only once
-	;; unless a line ends inside a string.
-	(while (and (not inner-loop-done)
-		    (not (setq outer-loop-done (eobp))))
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  ;; If the line contains a comment other than the sort
-	  ;; that is indented like code,
-	  ;; indent it now with indent-for-comment.
-	  ;; Comments indented like code are right already.
-	  ;; In any case clear the in-comment flag in the state
-	  ;; because parse-partial-sexp never sees the newlines.
-	  (if (car (nthcdr 4 state))
-	      (progn (indent-for-comment)
-		     (end-of-line)
-		     (setcar (nthcdr 4 state) nil)))
-	  ;; If this line ends inside a string,
-	  ;; go straight to next line, remaining within the inner loop,
-	  ;; and turn off the \-flag.
-	  (if (car (nthcdr 3 state))
-	      (progn
-		(forward-line 1)
-		(setcar (nthcdr 5 state) nil))
-	    (setq inner-loop-done t)))
-	(and endpos
-	     (<= next-depth 0)
-	     (progn
-	       (setq indent-stack (append indent-stack
-					  (make-list (- next-depth) nil))
-		     last-depth (- last-depth next-depth)
-		     next-depth 0)))
-	(or outer-loop-done endpos
-	    (setq outer-loop-done (<= next-depth 0)))
-	(if outer-loop-done
-	    (forward-line 1)
-	  (while (> last-depth next-depth)
-	    (setq indent-stack (cdr indent-stack)
-		  last-depth (1- last-depth)))
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  last-depth (1+ last-depth)))
-	  ;; Now go to the next line and indent it according
-	  ;; to what we learned from parsing the previous one.
-	  (forward-line 1)
-	  (setq bol (point))
-	  (skip-chars-forward " \t")
-	  ;; But not if the line is blank, or just a comment
-	  ;; (except for double-semi comments; indent them as usual).
-	  (if (or (eobp) (looking-at "\\s<\\|\n"))
-	      nil
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		(setq this-indent (car indent-stack))
-	      (let ((val (calculate-lisp-indent
-			  (if (car indent-stack) (- (car indent-stack))
-			    starting-point))))
-		(if (integerp val)
-		    (setcar indent-stack
-			    (setq this-indent val))
-		  (setcar indent-stack (- (car (cdr val))))
-		  (setq this-indent (car val)))))
-	    (if (/= (current-column) this-indent)
-		(progn (delete-region bol (point))
-		       (indent-to this-indent)))))
-	(or outer-loop-done
-	    (setq outer-loop-done (= (point) last-point))
-	    (setq last-point (point)))))))
-
-;; Indent every line whose first char is between START and END inclusive.
-(defun lisp-indent-region (start end)
-  (save-excursion
-    (let ((endmark (copy-marker end)))
-      (goto-char start)
-      (and (bolp) (not (eolp))
-	   (lisp-indent-line))
-      (indent-sexp endmark)
-      (set-marker endmark nil))))
-
-;;;; Lisp paragraph filling commands.
-
-(defun lisp-fill-paragraph (&optional justify)
-  "Like \\[fill-paragraph], but handle Emacs Lisp comments.
-If any of the current line is a comment, fill the comment or the
-paragraph of it that point is in, preserving the comment's indentation
-and initial semicolons."
-  (interactive "P")
-  (let (
-	;; Non-nil if the current line contains a comment.
-	has-comment
-
-	;; Non-nil if the current line contains code and a comment.
-	has-code-and-comment
-
-	;; If has-comment, the appropriate fill-prefix for the comment.
-	comment-fill-prefix
-	)
-
-    ;; Figure out what kind of comment we are looking at.
-    (save-excursion
-      (beginning-of-line)
-      (cond
-
-       ;; A line with nothing but a comment on it?
-       ((looking-at "[ \t]*;[; \t]*")
-	(setq has-comment t
-	      comment-fill-prefix (buffer-substring (match-beginning 0)
-						    (match-end 0))))
-
-       ;; A line with some code, followed by a comment?  Remember that the
-       ;; semi which starts the comment shouldn't be part of a string or
-       ;; character.
-       ((condition-case nil
-	    (save-restriction
-	      (narrow-to-region (point-min)
-				(save-excursion (end-of-line) (point)))
-	      (while (not (looking-at ";\\|$"))
-		(skip-chars-forward "^;\n\"\\\\?")
-		(cond
-		 ((eq (char-after (point)) ?\\) (forward-char 2))
-		 ((memq (char-after (point)) '(?\" ??)) (forward-sexp 1))))
-	      (looking-at ";+[\t ]*"))
-	  (error nil))
-	(setq has-comment t has-code-and-comment t)
-	(setq comment-fill-prefix
-	      (concat (make-string (/ (current-column) 8) ?\t)
-		      (make-string (% (current-column) 8) ?\ )
-		      (buffer-substring (match-beginning 0) (match-end 0)))))))
-
-    (if (not has-comment)
-	(fill-paragraph justify)
-
-      ;; Narrow to include only the comment, and then fill the region.
-      (save-excursion
-	(save-restriction
-	  (beginning-of-line)
-	  (narrow-to-region
-	   ;; Find the first line we should include in the region to fill.
-	   (save-excursion
-	     (while (and (zerop (forward-line -1))
-			 (looking-at "^[ \t]*;")))
-	     ;; We may have gone too far.  Go forward again.
-	     (or (looking-at ".*;")
-		 (forward-line 1))
-	     (point))
-	   ;; Find the beginning of the first line past the region to fill.
-	   (save-excursion
-	     (while (progn (forward-line 1)
-			   (looking-at "^[ \t]*;")))
-	     (point)))
-
-	  ;; Lines with only semicolons on them can be paragraph boundaries.
-	  (let* ((paragraph-start (concat paragraph-start "\\|[ \t;]*$"))
-		 (paragraph-separate (concat paragraph-start "\\|[ \t;]*$"))
-		 (paragraph-ignore-fill-prefix nil)
-		 (fill-prefix comment-fill-prefix)
-		 (after-line (if has-code-and-comment
-				 (save-excursion
-				   (forward-line 1) (point))))
-		 (end (progn
-			(forward-paragraph)
-			(or (bolp) (newline 1))
-			(point)))
-		 ;; If this comment starts on a line with code,
-		 ;; include that like in the filling.
-		 (beg (progn (backward-paragraph)
-			     (if (eq (point) after-line)
-				 (forward-line -1))
-			     (point))))
-	    (fill-region-as-paragraph beg end
-				      justify nil
-				      (save-excursion
-					(goto-char beg)
-					(if (looking-at fill-prefix)
-					    nil
-					  (re-search-forward comment-start-skip)
-					  (point))))))))
-    t))
-
-(defun indent-code-rigidly (start end arg &optional nochange-regexp)
-  "Indent all lines of code, starting in the region, sideways by ARG columns.
-Does not affect lines starting inside comments or strings, assuming that
-the start of the region is not inside them.
-
-Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP.
-The last is a regexp which, if matched at the beginning of a line,
-means don't indent that line."
-  (interactive "r\np")
-  (let (state)
-    (save-excursion
-      (goto-char end)
-      (setq end (point-marker))
-      (goto-char start)
-      (or (bolp)
-	  (setq state (parse-partial-sexp (point)
-					  (progn
-					    (forward-line 1) (point))
-					  nil nil state)))
-      (while (< (point) end)
-	(or (car (nthcdr 3 state))
-	    (and nochange-regexp
-		 (looking-at nochange-regexp))
-	    ;; If line does not start in string, indent it
-	    (let ((indent (current-indentation)))
-	      (delete-region (point) (progn (skip-chars-forward " \t") (point)))
-	      (or (eolp)
-		  (indent-to (max 0 (+ indent arg)) 0))))
-	(setq state (parse-partial-sexp (point)
-					(progn
-					  (forward-line 1) (point))
-					nil nil state))))))
-
-(provide 'lisp-mode)
-
-;;; lisp-mode.el ends here
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
deleted file mode 100644
index 767c96e620b..00000000000
--- a/lisp/emacs-lisp/lisp.el
+++ /dev/null
@@ -1,316 +0,0 @@
-;;; lisp.el --- Lisp editing commands for Emacs
-
-;; Copyright (C) 1985, 1986, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: lisp, languages
-
-;; 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:
-
-;; Lisp editing commands to go with Lisp major mode.
-
-;;; Code:
-
-;; Note that this variable is used by non-lisp modes too.
-(defvar defun-prompt-regexp nil
-  "*Non-nil => regexp to ignore, before the character that starts a defun.
-This is only necessary if the opening paren or brace is not in column 0.
-See `beginning-of-defun'.")
-(make-variable-buffer-local 'defun-prompt-regexp)
-
-(defvar parens-require-spaces t
-  "Non-nil => `insert-parentheses' should insert whitespace as needed.")
-
-(defun forward-sexp (&optional arg)
-  "Move forward across one balanced expression (sexp).
-With argument, do it that many times.  Negative arg -N means
-move backward across N balanced expressions."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
-  (if (< arg 0) (backward-prefix-chars)))
-
-(defun backward-sexp (&optional arg)
-  "Move backward across one balanced expression (sexp).
-With argument, do it that many times.  Negative arg -N means
-move forward across N balanced expressions."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (forward-sexp (- arg)))
-
-(defun mark-sexp (arg)
-  "Set mark ARG sexps from point.
-The place mark goes is the same place \\[forward-sexp] would
-move to with the same argument."
-  (interactive "p")
-  (push-mark
-    (save-excursion
-      (forward-sexp arg)
-      (point))
-    nil t))
-
-(defun forward-list (&optional arg)
-  "Move forward across one balanced group of parentheses.
-With argument, do it that many times.
-Negative arg -N means move backward across N groups of parentheses."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
-
-(defun backward-list (&optional arg)
-  "Move backward across one balanced group of parentheses.
-With argument, do it that many times.
-Negative arg -N means move forward across N groups of parentheses."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (forward-list (- arg)))
-
-(defun down-list (arg)
-  "Move forward down one level of parentheses.
-With argument, do this that many times.
-A negative argument means move backward but still go down a level.
-In Lisp programs, an argument is required."
-  (interactive "p")
-  (let ((inc (if (> arg 0) 1 -1)))
-    (while (/= arg 0)
-      (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
-      (setq arg (- arg inc)))))
-
-(defun backward-up-list (arg)
-  "Move backward out of one level of parentheses.
-With argument, do this that many times.
-A negative argument means move forward but still to a less deep spot.
-In Lisp programs, an argument is required."
-  (interactive "p")
-  (up-list (- arg)))
-
-(defun up-list (arg) 
-  "Move forward out of one level of parentheses.
-With argument, do this that many times.
-A negative argument means move backward but still to a less deep spot.
-In Lisp programs, an argument is required."
-  (interactive "p")
-  (let ((inc (if (> arg 0) 1 -1)))
-    (while (/= arg 0)
-      (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
-      (setq arg (- arg inc)))))
-
-(defun kill-sexp (arg)
-  "Kill the sexp (balanced expression) following the cursor.
-With argument, kill that many sexps after the cursor.
-Negative arg -N means kill N sexps before the cursor."
-  (interactive "p")
-  (let ((opoint (point)))
-    (forward-sexp arg)
-    (kill-region opoint (point))))
-
-(defun backward-kill-sexp (arg)
-  "Kill the sexp (balanced expression) preceding the cursor.
-With argument, kill that many sexps before the cursor.
-Negative arg -N means kill N sexps after the cursor."
-  (interactive "p")
-  (kill-sexp (- arg)))
-
-(defun beginning-of-defun (&optional arg)
-  "Move backward to the beginning of a defun.
-With argument, do it that many times.  Negative arg -N
-means move forward to Nth following beginning of defun.
-Returns t unless search stops due to beginning or end of buffer.
-
-Normally a defun starts when there is an char with open-parenthesis
-syntax at the beginning of a line.  If `defun-prompt-regexp' is
-non-nil, then a string which matches that regexp may precede the
-open-parenthesis, and point ends up at the beginning of the line."
-  (interactive "p")
-  (and (beginning-of-defun-raw arg)
-       (progn (beginning-of-line) t)))
-
-(defun beginning-of-defun-raw (&optional arg)
-  "Move point to the character that starts a defun.
-This is identical to beginning-of-defun, except that point does not move
-to the beginning of the line when `defun-prompt-regexp' is non-nil."
-  (interactive "p")
-  (and arg (< arg 0) (not (eobp)) (forward-char 1))
-  (and (re-search-backward (if defun-prompt-regexp
-			       (concat "^\\s(\\|"
-				       "\\(" defun-prompt-regexp "\\)\\s(")
-			     "^\\s(")
-			   nil 'move (or arg 1))
-       (progn (goto-char (1- (match-end 0)))) t))
-
-(defun buffer-end (arg)
-  (if (> arg 0) (point-max) (point-min)))
-
-(defun end-of-defun (&optional arg)
-  "Move forward to next end of defun.  With argument, do it that many times.
-Negative argument -N means move back to Nth preceding end of defun.
-
-An end of a defun occurs right after the close-parenthesis that matches
-the open-parenthesis that starts a defun; see `beginning-of-defun'."
-  (interactive "p")
-  (if (or (null arg) (= arg 0)) (setq arg 1))
-  (let ((first t))
-    (while (and (> arg 0) (< (point) (point-max)))
-      (let ((pos (point)) npos)
-	(while (progn
-		(if (and first
-			 (progn
-			  (end-of-line 1)
-			  (beginning-of-defun-raw 1)))
-		    nil
-		  (or (bobp) (forward-char -1))
-		  (beginning-of-defun-raw -1))
-		(setq first nil)
-		(forward-list 1)
-		(skip-chars-forward " \t")
-		(if (looking-at "\\s<\\|\n")
-		    (forward-line 1))
-		(<= (point) pos))))
-      (setq arg (1- arg)))
-    (while (< arg 0)
-      (let ((pos (point)))
-	(beginning-of-defun-raw 1)
-	(forward-sexp 1)
-	(forward-line 1)
-	(if (>= (point) pos)
-	    (if (beginning-of-defun-raw 2)
-		(progn
-		  (forward-list 1)
-		  (skip-chars-forward " \t")
-		  (if (looking-at "\\s<\\|\n")
-		      (forward-line 1)))
-	      (goto-char (point-min)))))
-      (setq arg (1+ arg)))))
-
-(defun mark-defun ()
-  "Put mark at end of this defun, point at beginning.
-The defun marked is the one that contains point or follows point."
-  (interactive)
-  (push-mark (point))
-  (end-of-defun)
-  (push-mark (point) nil t)
-  (beginning-of-defun)
-  (re-search-backward "^\n" (- (point) 1) t))
-
-(defun narrow-to-defun (&optional arg)
-  "Make text outside current defun invisible.
-The defun visible is the one that contains point or follows point."
-  (interactive)
-  (save-excursion
-    (widen)
-    (end-of-defun)
-    (let ((end (point)))
-      (beginning-of-defun)
-      (narrow-to-region (point) end))))
-
-(defun insert-parentheses (arg)
-  "Enclose following ARG sexps in parentheses.  Leave point after open-paren.
-A negative ARG encloses the preceding ARG sexps instead.
-No argument is equivalent to zero: just insert `()' and leave point between.
-If `parens-require-spaces' is non-nil, this command also inserts a space
-before and after, depending on the surrounding characters."
-  (interactive "P")
-  (if arg (setq arg (prefix-numeric-value arg))
-    (setq arg 0))
-  (cond ((> arg 0) (skip-chars-forward " \t"))
-	((< arg 0) (forward-sexp arg) (setq arg (- arg))))
-  (and parens-require-spaces
-       (not (bobp))
-       (memq (char-syntax (preceding-char)) '(?w ?_ ?\) ))
-       (insert " "))
-  (insert ?\()
-  (save-excursion
-    (or (eq arg 0) (forward-sexp arg))
-    (insert ?\))
-    (and parens-require-spaces
-	 (not (eobp))
-	 (memq (char-syntax (following-char)) '(?w ?_ ?\( ))
-	 (insert " "))))
-
-(defun move-past-close-and-reindent ()
-  "Move past next `)', delete indentation before it, then indent after it."
-  (interactive)
-  (up-list 1)
-  (forward-char -1)
-  (while (save-excursion		; this is my contribution
-	   (let ((before-paren (point)))
-	     (back-to-indentation)
-	     (= (point) before-paren)))
-    (delete-indentation))
-  (forward-char 1)
-  (newline-and-indent))
-
-(defun lisp-complete-symbol ()
-  "Perform completion on Lisp symbol preceding point.
-Compare that symbol against the known Lisp symbols.
-
-The context determines which symbols are considered.
-If the symbol starts just after an open-parenthesis, only symbols
-with function definitions are considered.  Otherwise, all symbols with
-function definitions, values or properties are considered."
-  (interactive)
-  (let* ((end (point))
-	 (buffer-syntax (syntax-table))
-	 (beg (unwind-protect
-		  (save-excursion
-		    (set-syntax-table emacs-lisp-mode-syntax-table)
-		    (backward-sexp 1)
-		    (while (= (char-syntax (following-char)) ?\')
-		      (forward-char 1))
-		    (point))
-		(set-syntax-table buffer-syntax)))
-	 (pattern (buffer-substring beg end))
-	 (predicate
-	  (if (eq (char-after (1- beg)) ?\()
-	      'fboundp
-	    (function (lambda (sym)
-			(or (boundp sym) (fboundp sym)
-			    (symbol-plist sym))))))
-	 (completion (try-completion pattern obarray predicate)))
-    (cond ((eq completion t))
-	  ((null completion)
-	   (message "Can't find completion for \"%s\"" pattern)
-	   (ding))
-	  ((not (string= pattern completion))
-	   (delete-region beg end)
-	   (insert completion))
-	  (t
-	   (message "Making completion list...")
-	   (let ((list (all-completions pattern obarray predicate))
-		 (completion-fixup-function
-		  (function (lambda () (if (save-excursion
-					     (goto-char (max (point-min) (- (point) 4)))
-					     (looking-at " <f>"))
-					   (forward-char -4))))))
-	     (setq list (sort list 'string<))
-	     (or (eq predicate 'fboundp)
-		 (let (new)
-		   (while list
-		     (setq new (cons (if (fboundp (intern (car list)))
-					 (list (car list) " <f>")
-				       (car list))
-				     new))
-		     (setq list (cdr list)))
-		   (setq list (nreverse new))))
-	     (with-output-to-temp-buffer "*Completions*"
-	       (display-completion-list list)))
-	   (message "Making completion list...%s" "done")))))
-
-;;; lisp.el ends here
diff --git a/lisp/emacs-lisp/lmenu.el b/lisp/emacs-lisp/lmenu.el
deleted file mode 100644
index a878f6ca206..00000000000
--- a/lisp/emacs-lisp/lmenu.el
+++ /dev/null
@@ -1,506 +0,0 @@
-;;; lmenu.el --- emulate Lucid's menubar support
-
-;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
-
-;; Keywords: emulations
-
-;; 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.
-
-;;; Code:
-
-
-;; First, emulate the Lucid menubar support in GNU Emacs 19.
-
-;; Arrange to use current-menubar to set up part of the menu bar.
-
-(defvar current-menubar)
-
-(setq recompute-lucid-menubar 'recompute-lucid-menubar)
-(defun recompute-lucid-menubar ()
-  (define-key lucid-menubar-map [menu-bar]
-    (condition-case nil
-	(make-lucid-menu-keymap "menu-bar" current-menubar)
-      (error (message "Invalid data in current-menubar moved to lucid-failing-menubar")
-	     (sit-for 1)
-	     (setq lucid-failing-menubar current-menubar
-		   current-menubar nil))))
-  (setq lucid-menu-bar-dirty-flag nil))
-
-(defvar lucid-menubar-map (make-sparse-keymap))
-(or (assq 'current-menubar minor-mode-map-alist)
-    (setq minor-mode-map-alist
-	  (cons (cons 'current-menubar lucid-menubar-map)
-		minor-mode-map-alist)))
-
-(defun set-menubar-dirty-flag ()
-  (force-mode-line-update)
-  (setq lucid-menu-bar-dirty-flag t))
-
-(defvar add-menu-item-count 0)
-
-;; This is a variable whose value is always nil.
-(defvar make-lucid-menu-keymap-disable nil)
-
-;; Return a menu keymap corresponding to a Lucid-style menu list
-;; MENU-ITEMS, and with name MENU-NAME.
-(defun make-lucid-menu-keymap (menu-name menu-items)
-  (let ((menu (make-sparse-keymap menu-name)))
-    ;; Process items in reverse order,
-    ;; since the define-key loop reverses them again.
-    (setq menu-items (reverse menu-items))
-    (while menu-items
-      (let ((item (car menu-items))
-	    command name callback)
-	(cond ((stringp item)
-	       (setq command nil)
-	       (setq name (if (string-match "^-+$" item) "" item)))
-	      ((consp item)
-	       (setq command (make-lucid-menu-keymap (car item) (cdr item)))
-	       (setq name (car item)))
-	      ((vectorp item)
-	       (setq command (make-symbol (format "menu-function-%d"
-						  add-menu-item-count))
-		     add-menu-item-count (1+ add-menu-item-count)
-		     name (aref item 0)
-		     callback (aref item 1))
-	       (if (symbolp callback)
-		   (fset command callback)
-		 (fset command (list 'lambda () '(interactive) callback)))
-	       (put command 'menu-alias t)
-	       (let ((i 2))
-		 (while (< i (length item))
-		   (cond
-		    ((eq (aref item i) ':active)
-		     (put command 'menu-enable
-			  (or (aref item (1+ i))
-			      'make-lucid-menu-keymap-disable))
-		     (setq i (+ 2 i)))
-		    ((eq (aref item i) ':suffix)
-		     ;; unimplemented
-		     (setq i (+ 2 i)))
-		    ((eq (aref item i) ':keys)
-		     ;; unimplemented
-		     (setq i (+ 2 i)))
-		    ((eq (aref item i) ':style)
-		     ;; unimplemented
-		     (setq i (+ 2 i)))
-		    ((eq (aref item i) ':selected)
-		     ;; unimplemented
-		     (setq i (+ 2 i)))
-		    ((and (symbolp (aref item i))
-			  (= ?: (string-to-char (symbol-name (aref item i)))))
-		     (error "Unrecognized menu item keyword: %S"
-			    (aref item i)))
-		    ((= i 2)
-		     ;; old-style format: active-p &optional suffix
-		     (put command 'menu-enable
-			  (or (aref item i) 'make-lucid-menu-keymap-disable))
-		     ;; suffix is unimplemented
-		     (setq i (length item)))
-		    (t
-		     (error "Unexpected menu item value: %S"
-			    (aref item i))))))))
-	(if (null command)
-	    ;; Handle inactive strings specially--allow any number
-	    ;; of identical ones.
-	    (setcdr menu (cons (list nil name) (cdr menu)))
-	  (if name
-	      (define-key menu (vector (intern name)) (cons name command)))))
-      (setq menu-items (cdr menu-items)))
-    menu))
-
-(defun popup-menu (menu-desc)
-  "Pop up the given menu.
-A menu is a list of menu items, strings, and submenus.
-
-The first element of a menu must be a string, which is the name of the
-menu.  This is the string that will be displayed in the parent menu, if
-any.  For toplevel menus, it is ignored.  This string is not displayed
-in the menu itself.
-
-A menu item is a vector containing:
-
- - the name of the menu item (a string);
- - the `callback' of that item;
- - a list of keywords with associated values:
-   - :active active-p	a form specifying whether this item is selectable;
-   - :suffix suffix	a string to be appended to the name as an `argument'
-			to the command, like `Kill Buffer NAME';
-   - :keys command-keys	a string, suitable for `substitute-command-keys',
-			to specify the keyboard equivalent of a command
-			when the callback is a form (this is not necessary
-			when the callback is a symbol, as the keyboard
-			equivalent is computed automatically in that case);
-   - :style style	a symbol: nil for a normal menu item, `toggle' for
-			a toggle button (a single option that can be turned
-			on or off), or `radio' for a radio button (one of a
-			group of mutually exclusive options);
-   - :selected form	for `toggle' or `radio' style, a form that specifies
-			whether the button will be in the selected state.
-
-Alternately, the vector may contain exactly 3 or 4 elements, with the third
-element specifying `active-p' and the fourth specifying `suffix'.
-
-If the `callback' of a menu item is a symbol, then it must name a command.
-It will be invoked with `call-interactively'.  If it is a list, then it is
-evaluated with `eval'.
-
-If an element of a menu is a string, then that string will be presented in
-the menu as unselectable text.
-
-If an element of a menu is a string consisting solely of hyphens, then that
-item will be presented as a solid horizontal line.
-
-If an element of a menu is a list, it is treated as a submenu.  The name of
-that submenu (the first element in the list) will be used as the name of the
-item representing this menu on the parent.
-
-The syntax, more precisely:
-
-   form		:=  <something to pass to `eval'>
-   command	:=  <a symbol or string, to pass to `call-interactively'>
-   callback 	:=  command | form
-   active-p	:=  <t or nil, whether this thing is selectable>
-   text		:=  <string, non selectable>
-   name		:=  <string>
-   suffix	:=  <string>
-   command-keys	:=  <string>
-   object-style	:=  'nil' | 'toggle' | 'radio'
-   keyword	:=  ':active' active-p
-		 |  ':suffix' suffix
-		 |  ':keys' command-keys
-		 |  ':style' object-style
-		 |  ':selected' form
-   menu-item	:=  '['  name callback active-p [ suffix ]  ']'
-		 |  '['  name callback [ keyword ]+  ']'
-   menu		:=  '(' name [ menu-item | menu | text ]+ ')'"
-  (let ((menu (make-lucid-menu-keymap (car menu-desc) (cdr menu-desc)))
-	(pos (mouse-pixel-position))
-	answer cmd)
-    (while (and menu
-		(setq answer (x-popup-menu (list (list (nth 1 pos)
-						       (nthcdr 2 pos))
-						 (car pos))
-					   menu)))
-      (setq cmd (lookup-key menu (apply 'vector answer)))
-      (setq menu nil)
-      (and cmd
-	   (if (keymapp cmd)
-	       (setq menu cmd)
-	     (call-interactively cmd))))))
-
-(defun popup-dialog-box (data)
-  "Pop up a dialog box.
-A dialog box description is a list.
-
- - The first element of the list is a string to display in the dialog box.
- - The rest of the elements are descriptions of the dialog box's buttons.
-   Each one is a vector of three elements:
-   - The first element is the text of the button.
-   - The second element is the `callback'.
-   - The third element is t or nil, whether this button is selectable.
-
-If the `callback' of a button is a symbol, then it must name a command.
-It will be invoked with `call-interactively'.  If it is a list, then it is
-evaluated with `eval'.
-
-One (and only one) of the buttons may be `nil'.  This marker means that all
-following buttons should be flushright instead of flushleft.
-
-The syntax, more precisely:
-
-   form		:=  <something to pass to `eval'>
-   command	:=  <a symbol or string, to pass to `call-interactively'>
-   callback 	:=  command | form
-   active-p	:=  <t, nil, or a form to evaluate to decide whether this
-		    button should be selectable>
-   name		:=  <string>
-   partition	:=  'nil'
-   button	:=  '['  name callback active-p ']'
-   dialog	:=  '(' name [ button ]+ [ partition [ button ]+ ] ')'"
-  (let ((name (car data))
-	(tail (cdr data))
-	converted
-	choice meaning)
-    (while tail
-      (if (null (car tail))
-	  (setq converted (cons nil converted))
-	(let ((item (aref (car tail) 0))
-	      (callback (aref (car tail) 1))
-	      (enable (aref (car tail) 2)))
-	  (setq converted
-		(cons (if enable (cons item callback) item)
-		      converted))))
-      (setq tail (cdr tail)))
-    (setq choice (x-popup-dialog t (cons name (nreverse converted))))
-    (if choice
-	(if (symbolp choice)
-	    (call-interactively choice)
-	  (eval choice)))))
-
-;; This is empty because the usual elements of the menu bar
-;; are provided by menu-bar.el instead.
-;; It would not make sense to duplicate them here.
-(defconst default-menubar nil)
-
-(defun set-menubar (menubar)
-  "Set the default menubar to be menubar."
-  (setq-default current-menubar (copy-sequence menubar))
-  (set-menubar-dirty-flag))
-
-(defun set-buffer-menubar (menubar)
-  "Set the buffer-local menubar to be menubar."
-  (make-local-variable 'current-menubar)
-  (setq current-menubar (copy-sequence menubar))
-  (set-menubar-dirty-flag))
-
-
-;;; menu manipulation functions
-
-(defun find-menu-item (menubar item-path-list &optional parent)
-  "Searches MENUBAR for item given by ITEM-PATH-LIST.
-Returns (ITEM . PARENT), where PARENT is the immediate parent of
- the item found.
-Signals an error if the item is not found."
-  (or parent (setq item-path-list (mapcar 'downcase item-path-list)))
-  (if (not (consp menubar))
-      nil
-    (let ((rest menubar)
-	  result)
-      (while rest
-	(if (and (car rest)
-		 (equal (car item-path-list)
-			(downcase (if (vectorp (car rest))
-				      (aref (car rest) 0)
-				    (if (stringp (car rest))
-					(car rest)
-				      (car (car rest)))))))
-	    (setq result (car rest) rest nil)
-	  (setq rest (cdr rest))))
-      (if (cdr item-path-list)
-	  (if (consp result)
-	      (find-menu-item (cdr result) (cdr item-path-list) result)
-	    (if result
-		(signal 'error (list "not a submenu" result))
-	      (signal 'error (list "no such submenu" (car item-path-list)))))
-	(cons result parent)))))
-
-
-(defun disable-menu-item (path)
-  "Make the named menu item be unselectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
-  (let* ((menubar current-menubar)
-	 (pair (find-menu-item menubar path))
-	 (item (car pair))
-	 (menu (cdr pair)))
-    (or item
-	(signal 'error (list (if menu "No such menu item" "No such menu")
-			     path)))
-    (if (consp item) (error "can't disable menus, only menu items"))
-    (aset item 2 nil)
-    (set-menubar-dirty-flag)
-    item))
-
-
-(defun enable-menu-item (path)
-  "Make the named menu item be selectable.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
-  (let* ((menubar current-menubar)
-	 (pair (find-menu-item menubar path))
-	 (item (car pair))
-	 (menu (cdr pair)))
-    (or item
-	(signal 'error (list (if menu "No such menu item" "No such menu")
-			     path)))
-    (if (consp item) (error "%S is a menu, not a menu item" path))
-    (aset item 2 t)
-    (set-menubar-dirty-flag)
-    item))
-
-
-(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
-  (if before (setq before (downcase before)))
-  (let* ((menubar current-menubar)
-	 (menu (condition-case ()
-		   (car (find-menu-item menubar menu-path))
-		 (error nil)))
-	 (item (if (listp menu)
-		   (car (find-menu-item (cdr menu) (list item-name)))
-		 (signal 'error (list "not a submenu" menu-path)))))
-    (or menu
-	(let ((rest menu-path)
-	      (so-far menubar))
-	  (while rest
-;;;	    (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
-	    (setq menu
-		  (if (eq so-far menubar)
-		      (car (find-menu-item so-far (list (car rest))))
-		    (car (find-menu-item (cdr so-far) (list (car rest))))))
-	    (or menu
-		(let ((rest2 so-far))
-		  (or rest2
-		      (error "Trying to modify a menu that doesn't exist"))
-		  (while (and (cdr rest2) (car (cdr rest2)))
-		    (setq rest2 (cdr rest2)))
-		  (setcdr rest2
-			  (nconc (list (setq menu (list (car rest))))
-				 (cdr rest2)))))
-	    (setq so-far menu)
-	    (setq rest (cdr rest)))))
-    (or menu (setq menu menubar))
-    (if item
-	nil	; it's already there
-      (if item-p
-	  (setq item (vector item-name item-data enabled-p))
-	(setq item (cons item-name item-data)))
-      ;; if BEFORE is specified, try to add it there.
-      (if before
-	  (setq before (car (find-menu-item menu (list before)))))
-      (let ((rest menu)
-	    (added-before nil))
-	(while rest
-	  (if (eq before (car (cdr rest)))
-	      (progn
-		(setcdr rest (cons item (cdr rest)))
-		(setq rest nil added-before t))
-	    (setq rest (cdr rest))))
-	(if (not added-before)
-	    ;; adding before the first item on the menubar itself is harder
-	    (if (and (eq menu menubar) (eq before (car menu)))
-		(setq menu (cons item menu)
-		      current-menubar menu)
-	      ;; otherwise, add the item to the end.
-	      (nconc menu (list item))))))
-    (if item-p
-	(progn
-	  (aset item 1 item-data)
-	  (aset item 2 (not (null enabled-p))))
-      (setcar item item-name)
-      (setcdr item item-data))
-    (set-menubar-dirty-flag)
-    item))
-
-(defun add-menu-item (menu-path item-name function enabled-p &optional before)
-  "Add a menu item to some menu, creating the menu first if necessary.
-If the named item exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu item should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
-ITEM-NAME is the string naming the menu item to be added.
-FUNCTION is the command to invoke when this menu item is selected.
- If it is a symbol, then it is invoked with `call-interactively', in the same
- way that functions bound to keys are invoked.  If it is a list, then the
- list is simply evaluated.
-ENABLED-P controls whether the item is selectable or not.
-BEFORE, if provided, is the name of a menu item before which this item should
- be added, if this item is not on the menu already.  If the item is already
- present, it will not be moved."
-  (or menu-path (error "must specify a menu path"))
-  (or item-name (error "must specify an item name"))
-  (add-menu-item-1 t menu-path item-name function enabled-p before))
-
-
-(defun delete-menu-item (path)
-  "Remove the named menu item from the menu hierarchy.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
-  (let* ((menubar current-menubar)
-	 (pair (find-menu-item menubar path))
-	 (item (car pair))
-	 (menu (or (cdr pair) menubar)))
-    (if (not item)
-	nil
-      ;; the menubar is the only special case, because other menus begin
-      ;; with their name.
-      (if (eq menu current-menubar)
-	  (setq current-menubar (delq item menu))
-	(delq item menu))
-      (set-menubar-dirty-flag)
-      item)))
-
-
-(defun relabel-menu-item (path new-name)
-  "Change the string of the specified menu item.
-PATH is a list of strings which identify the position of the menu item in
-the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
-under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the
-menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
-NEW-NAME is the string that the menu item will be printed as from now on."
-  (or (stringp new-name)
-      (setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
-  (let* ((menubar current-menubar)
-	 (pair (find-menu-item menubar path))
-	 (item (car pair))
-	 (menu (cdr pair)))
-    (or item
-	(signal 'error (list (if menu "No such menu item" "No such menu")
-			     path)))
-    (if (and (consp item)
-	     (stringp (car item)))
-	(setcar item new-name)
-      (aset item 0 new-name))
-    (set-menubar-dirty-flag)
-    item))
-
-(defun add-menu (menu-path menu-name menu-items &optional before)
-  "Add a menu to the menubar or one of its submenus.
-If the named menu exists already, it is changed.
-MENU-PATH identifies the menu under which the new menu should be inserted.
- It is a list of strings; for example, (\"File\") names the top-level \"File\"
- menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
- If MENU-PATH is nil, then the menu will be added to the menubar itself.
-MENU-NAME is the string naming the menu to be added.
-MENU-ITEMS is a list of menu item descriptions.
- Each menu item should be a vector of three elements:
-   - a string, the name of the menu item;
-   - a symbol naming a command, or a form to evaluate;
-   - and a form whose value determines whether this item is selectable.
-BEFORE, if provided, is the name of a menu before which this menu should
- be added, if this menu is not on its parent already.  If the menu is already
- present, it will not be moved."
-  (or menu-name (error "must specify a menu name"))
-  (or menu-items (error "must specify some menu items"))
-  (add-menu-item-1 nil menu-path menu-name menu-items t before))
-
-
-
-(defvar put-buffer-names-in-file-menu t)
-
-
-;; Don't unconditionally enable menu bars; leave that up to the user.
-;;(let ((frames (frame-list)))
-;;  (while frames
-;;    (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
-;;    (setq frames (cdr frames))))
-;;(or (assq 'menu-bar-lines default-frame-alist)
-;;    (setq default-frame-alist
-;;	  (cons '(menu-bar-lines . 1) default-frame-alist)))
-
-(set-menubar default-menubar)
-
-(provide 'lmenu)
-
-;;; lmenu.el ends here
diff --git a/lisp/emacs-lisp/lselect.el b/lisp/emacs-lisp/lselect.el
deleted file mode 100644
index c6c64a909f8..00000000000
--- a/lisp/emacs-lisp/lselect.el
+++ /dev/null
@@ -1,230 +0,0 @@
-;;; lselect.el --- Lucid interface to X Selections
-
-;; Copyright (C) 1990, 1993 Free Software Foundation, Inc.
-
-;; Keywords: emulations
-
-;; This won't completely work until we support or emulate Lucid-style extents.
-;; Based on Lucid's selection code.
-
-;; 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.
-
-;;; Code:
-
-;;; The selection code requires us to use certain symbols whose names are
-;;; all upper-case; this may seem tasteless, but it makes there be a 1:1
-;;; correspondence between these symbols and X Atoms (which are upcased.)
-
-(defalias 'x-get-cutbuffer 'x-get-cut-buffer)
-(defalias 'x-store-cutbuffer 'x-set-cut-buffer)
-
-(or (find-face 'primary-selection)
-    (make-face 'primary-selection))
-
-(or (find-face 'secondary-selection)
-    (make-face 'secondary-selection))
-
-(defun x-get-secondary-selection ()
-  "Return text selected from some X window."
-  (x-get-selection-internal 'SECONDARY 'STRING))
-
-(defvar primary-selection-extent nil
-  "The extent of the primary selection; don't use this.")
-
-(defvar secondary-selection-extent nil
-  "The extent of the secondary selection; don't use this.")
-
-
-(defun x-select-make-extent-for-selection (selection previous-extent face)
-  ;; Given a selection, this makes an extent in the buffer which holds that
-  ;; selection, for highlighting purposes.  If the selection isn't associated
-  ;; with a buffer, this does nothing.
-  (let ((buffer nil)
-	(valid (and (extentp previous-extent)
-		    (extent-buffer previous-extent)
-		    (buffer-name (extent-buffer previous-extent))))
-	start end)
-    (cond ((stringp selection)
-	   ;; if we're selecting a string, lose the previous extent used
-	   ;; to highlight the selection.
-	   (setq valid nil))
-	  ((consp selection)
-	   (setq start (min (car selection) (cdr selection))
-		 end (max (car selection) (cdr selection))
-		 valid (and valid
-			    (eq (marker-buffer (car selection))
-				(extent-buffer previous-extent)))
-		 buffer (marker-buffer (car selection))))
-	  ((extentp selection)
-	   (setq start (extent-start-position selection)
-		 end (extent-end-position selection)
-		 valid (and valid
-			    (eq (extent-buffer selection)
-				(extent-buffer previous-extent)))
-		 buffer (extent-buffer selection)))
-	  )
-    (if (and (not valid)
-	     (extentp previous-extent)
-	     (extent-buffer previous-extent)
-	     (buffer-name (extent-buffer previous-extent)))
-	(delete-extent previous-extent))
-    (if (not buffer)
-	;; string case
-	nil
-      ;; normal case
-      (if valid
-	  (set-extent-endpoints previous-extent start end)
-	(setq previous-extent (make-extent start end buffer))
-	;; use same priority as mouse-highlighting so that conflicts between
-	;; the selection extent and a mouse-highlighted extent are resolved
-	;; by the usual size-and-endpoint-comparison method.
-	(set-extent-priority previous-extent mouse-highlight-priority)
-	(set-extent-face previous-extent face)))))
-
-
-(defun x-own-selection (selection &optional type)
-  "Make a primary X Selection of the given argument.  
-The argument may be a string, a cons of two markers, or an extent.  
-In the latter cases the selection is considered to be the text 
-between the markers, or the between extents endpoints."
-  (interactive (if (not current-prefix-arg)
-		   (list (read-string "Store text for pasting: "))
-		 (list (cons ;; these need not be ordered.
-			(copy-marker (point-marker))
-			(copy-marker (mark-marker))))))
-  (or type (setq type 'PRIMARY))
-  (x-set-selection selection type)
-  (cond ((eq type 'PRIMARY)
-	 (setq primary-selection-extent
-	       (x-select-make-extent-for-selection
-		selection primary-selection-extent 'primary-selection)))
-	((eq type 'SECONDARY)
-	 (setq secondary-selection-extent
-	       (x-select-make-extent-for-selection
-		selection secondary-selection-extent 'secondary-selection))))
-  selection)
-
-
-(defun x-own-secondary-selection (selection &optional type)
-  "Make a secondary X Selection of the given argument.  The argument may be a 
-string or a cons of two markers (in which case the selection is considered to
-be the text between those markers.)"
-  (interactive (if (not current-prefix-arg)
-		   (list (read-string "Store text for pasting: "))
-		 (list (cons ;; these need not be ordered.
-			(copy-marker (point-marker))
-			(copy-marker (mark-marker))))))
-  (x-own-selection selection 'SECONDARY))
-
-
-(defun x-own-clipboard (string)
-  "Paste the given string to the X Clipboard."
-  (x-own-selection string 'CLIPBOARD))
-
-
-(defun x-disown-selection (&optional secondary-p)
-  "Assuming we own the selection, disown it.  With an argument, discard the
-secondary selection instead of the primary selection."
-  (x-disown-selection-internal (if secondary-p 'SECONDARY 'PRIMARY)))
-
-(defun x-dehilight-selection (selection)
-  "for use as a value of x-lost-selection-hooks."
-  (cond ((eq selection 'PRIMARY)
-	 (if primary-selection-extent
-	     (let ((inhibit-quit t))
-	       (delete-extent primary-selection-extent)
-	       (setq primary-selection-extent nil)))
-	 (if zmacs-regions (zmacs-deactivate-region)))
-	((eq selection 'SECONDARY)
-	 (if secondary-selection-extent
-	     (let ((inhibit-quit t))
-	       (delete-extent secondary-selection-extent)
-	       (setq secondary-selection-extent nil)))))
-  nil)
-
-(setq x-lost-selection-hooks 'x-dehilight-selection)
-
-(defun x-notice-selection-requests (selection type successful)
-  "for possible use as the value of x-sent-selection-hooks."
-  (if (not successful)
-      (message "Selection request failed to convert %s to %s"
-	       selection type)
-    (message "Sent selection %s as %s" selection type)))
-
-(defun x-notice-selection-failures (selection type successful)
-  "for possible use as the value of x-sent-selection-hooks."
-  (or successful
-      (message "Selection request failed to convert %s to %s"
-	       selection type)))
-
-;(setq x-sent-selection-hooks 'x-notice-selection-requests)
-;(setq x-sent-selection-hooks 'x-notice-selection-failures)
-
-
-;;; Random utility functions
-
-(defun x-kill-primary-selection ()
-  "If there is a selection, delete the text it covers, and copy it to 
-both the kill ring and the Clipboard."
-  (interactive)
-  (or (x-selection-owner-p) (error "emacs does not own the primary selection"))
-  (setq last-command nil)
-  (or primary-selection-extent
-      (error "the primary selection is not an extent?"))
-  (save-excursion
-    (set-buffer (extent-buffer primary-selection-extent))
-    (kill-region (extent-start-position primary-selection-extent)
-		 (extent-end-position primary-selection-extent)))
-  (x-disown-selection nil))
-
-(defun x-delete-primary-selection ()
-  "If there is a selection, delete the text it covers *without* copying it to
-the kill ring or the Clipboard."
-  (interactive)
-  (or (x-selection-owner-p) (error "emacs does not own the primary selection"))
-  (setq last-command nil)
-  (or primary-selection-extent
-      (error "the primary selection is not an extent?"))
-  (save-excursion
-    (set-buffer (extent-buffer primary-selection-extent))
-    (delete-region (extent-start-position primary-selection-extent)
-		   (extent-end-position primary-selection-extent)))
-  (x-disown-selection nil))
-
-(defun x-copy-primary-selection ()
-  "If there is a selection, copy it to both the kill ring and the Clipboard."
-  (interactive)
-  (setq last-command nil)
-  (or (x-selection-owner-p) (error "emacs does not own the primary selection"))
-  (or primary-selection-extent
-      (error "the primary selection is not an extent?"))
-  (save-excursion
-    (set-buffer (extent-buffer primary-selection-extent))
-    (copy-region-as-kill (extent-start-position primary-selection-extent)
-			 (extent-end-position primary-selection-extent))))
-
-(defun x-yank-clipboard-selection ()
-  "If someone owns a Clipboard selection, insert it at point."
-  (interactive)
-  (setq last-command nil)
-  (let ((clip (x-get-clipboard)))
-    (or clip (error "there is no clipboard selection"))
-    (push-mark)
-    (insert clip)))
-
-;;; lselect.el ends here.
diff --git a/lisp/emacs-lisp/lucid.el b/lisp/emacs-lisp/lucid.el
deleted file mode 100644
index 5c609137ffe..00000000000
--- a/lisp/emacs-lisp/lucid.el
+++ /dev/null
@@ -1,223 +0,0 @@
-;;; lucid.el --- Emulate some Lucid Emacs functions.
-
-;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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.
-
-;;; Code:
-
-(defun copy-tree (tree)
-  (if (consp tree)
-      (cons (copy-tree (car tree))
-	    (copy-tree (cdr tree)))
-    (if (vectorp tree)
-	(let* ((new (copy-sequence tree))
-	       (i (1- (length new))))
-	  (while (>= i 0)
-	    (aset new i (copy-tree (aref new i)))
-	    (setq i (1- i)))
-	  new)
-      tree)))
-
-(defalias 'current-time-seconds 'current-time)
-
-(defun remprop (symbol prop)
-  (let ((plist (symbol-plist symbol)))
-    (while (eq (car plist) prop)
-      (setplist symbol (setq plist (cdr (cdr plist)))))
-    (while plist
-      (if (eq (nth 2 plist) prop)
-	  (setcdr (cdr plist) (nthcdr 4 plist)))
-      (setq plist (cdr (cdr plist))))))
-
-(defun map-keymap (function keymap &optional sort-first)
-  "Call FUNCTION for every binding in KEYMAP.
-This includes bindings inherited from a parent keymap.
-FUNCTION receives two arguments each time it is called:
-the character (more generally, the event type) that is bound,
-and the binding it has.
-
-Note that passing the event type directly to `define-key' does not work
-in Emacs 19.  We do not emulate that particular feature of Lucid Emacs.
-If your code does that, modify it to make a vector containing the event
-type that you get.  That will work in both versions of Emacs."
-  (if sort-first
-      (let (list)
-	(map-keymap (function (lambda (a b)
-				(setq list (cons (cons a b) list))))
-		    keymap)
-	(setq list (sort list
-			 (function (lambda (a b)
-				     (setq a (car a) b (car b))
-				     (if (integerp a)
-					 (if (integerp b) (< a b)
-					   t)
-				       (if (integerp b) t
-					 (string< a b)))))))
-	(while list
-	  (funcall function (car (car list)) (cdr (car list)))
-	  (setq list (cdr list))))
-    (while (consp keymap)
-      (if (consp (car keymap))
-	  (funcall function (car (car keymap)) (cdr (car keymap)))
-	(if (vectorp (car keymap))
-	    (let ((i (1- (length (car keymap))))
-		  (vector (car keymap)))
-	      (while (>= i 0)
-		(funcall function i (aref vector i))
-		(setq i (1- i))))))
-      (setq keymap (cdr keymap)))))
-
-(defun read-number (prompt &optional integers-only)
-  "Read a number from the minibuffer.
-Keep reentering the minibuffer until we get suitable input.
-If optional argument INTEGERS-ONLY is non-nil, insist on an integer."
-  (interactive)
-  (let (success
-	(number nil)
-	(predicate (if integers-only 'integerp 'numberp)))
-    (while (not success)
-      (let ((input-string (read-string prompt)))
-	(condition-case ()
-	    (setq number (read input-string))
-	  (error))
-	(if (funcall predicate number)
-	    (setq success t)
-	  (let ((cursor-in-echo-area t))
-	    (message "Please type %s"
-		     (if integers-only "an integer" "a number"))
-	    (sit-for 1)))))
-    number))
-
-(defun real-path-name (name &optional default)
-  (file-truename (expand-file-name name default)))
-
-;; It's not clear what to return if the mouse is not in FRAME.
-(defun read-mouse-position (frame)
-  (let ((pos (mouse-position)))
-    (if (eq (car pos) frame)
-	(cdr pos))))
-
-(defun switch-to-other-buffer (arg)
-  "Switch to the previous buffer.
-With a numeric arg N, switch to the Nth most recent buffer.
-With an arg of 0, buries the current buffer at the
-bottom of the buffer stack."
-  (interactive "p")
-  (if (eq arg 0)
-      (bury-buffer (current-buffer)))
-  (switch-to-buffer
-   (if (<= arg 1) (other-buffer (current-buffer))
-     (nth arg
-	  (apply 'nconc
-		 (mapcar
-		  (lambda (buf)
-		    (if (= ?\  (string-to-char (buffer-name buf)))
-			nil
-		      (list buf)))
-		  (buffer-list)))))))
-
-(defalias 'find-face 'internal-find-face)
-(defalias 'get-face 'internal-get-face)
-(defalias 'try-face-font 'internal-try-face-font)
-
-(defalias 'exec-to-string 'shell-command-to-string)
-
-(defun make-extent (beg end &optional buffer)
-  (make-overlay beg end buffer))
-
-(defun set-extent-property (extent prop value)
-  (if (eq prop 'duplicable)
-      (cond ((and value (not (overlay-get extent prop)))
-	     ;; If becoming duplicable, copy all overlayprops to text props.
-	     (add-text-properties (overlay-start extent)
-				  (overlay-end extent)
-				  (overlay-properties extent)
-				  (overlay-buffer extent)))
-	    ;; If becoming no longer duplicable, remove these text props.
-	    ((and (not value) (overlay-get extent prop))
-	     (remove-text-properties (overlay-start extent)
-				     (overlay-end extent)
-				     (overlay-properties extent)
-				     (overlay-buffer extent))))
-    ;; If extent is already duplicable, put this property
-    ;; on the text as well as on the overlay.
-    (if (overlay-get extent 'duplicable)
-	(put-text-property  (overlay-start extent)
-			    (overlay-end extent)
-			    prop value (overlay-buffer extent))))
-  (overlay-put extent prop value))
-
-(defun set-extent-face (extent face)
-  (set-extent-property extent 'face face))
-
-(defun delete-extent (extent)
-  (set-extent-property extent 'duplicable nil)
-  (delete-overlay extent))
-
-;; Support the Lucid names with `screen' instead of `frame'.
-
-(defalias 'current-screen-configuration 'current-frame-configuration)
-(defalias 'delete-screen 'delete-frame)
-(defalias 'find-file-new-screen 'find-file-other-frame)
-(defalias 'find-file-read-only-new-screen 'find-file-read-only-other-frame)
-(defalias 'find-tag-new-screen 'find-tag-other-frame)
-;;(defalias 'focus-screen 'focus-frame)
-(defalias 'iconify-screen 'iconify-frame)
-(defalias 'mail-new-screen 'mail-other-frame)
-(defalias 'make-screen-invisible 'make-frame-invisible)
-(defalias 'make-screen-visible 'make-frame-visible)
-;; (defalias 'minibuffer-screen-list 'minibuffer-frame-list)
-(defalias 'modify-screen-parameters 'modify-frame-parameters)
-(defalias 'next-screen 'next-frame)
-;; (defalias 'next-multiscreen-window 'next-multiframe-window)
-;; (defalias 'previous-multiscreen-window 'previous-multiframe-window)
-;; (defalias 'redirect-screen-focus 'redirect-frame-focus)
-(defalias 'redraw-screen 'redraw-frame)
-;; (defalias 'screen-char-height 'frame-char-height)
-;; (defalias 'screen-char-width 'frame-char-width)
-;; (defalias 'screen-configuration-to-register 'frame-configuration-to-register)
-;; (defalias 'screen-focus 'frame-focus)
-(defalias 'screen-list 'frame-list)
-;; (defalias 'screen-live-p 'frame-live-p)
-(defalias 'screen-parameters 'frame-parameters)
-(defalias 'screen-pixel-height 'frame-pixel-height)
-(defalias 'screen-pixel-width 'frame-pixel-width)
-(defalias 'screen-root-window 'frame-root-window)
-(defalias 'screen-selected-window 'frame-selected-window)
-(defalias 'lower-screen 'lower-frame)
-(defalias 'raise-screen 'raise-frame)
-(defalias 'screen-visible-p 'frame-visible-p)
-(defalias 'screenp 'framep)
-(defalias 'select-screen 'select-frame)
-(defalias 'selected-screen 'selected-frame)
-;; (defalias 'set-screen-configuration 'set-frame-configuration)
-;; (defalias 'set-screen-height 'set-frame-height)
-(defalias 'set-screen-position 'set-frame-position)
-(defalias 'set-screen-size 'set-frame-size)
-;; (defalias 'set-screen-width 'set-frame-width)
-(defalias 'switch-to-buffer-new-screen 'switch-to-buffer-other-frame)
-;; (defalias 'unfocus-screen 'unfocus-frame)
-(defalias 'visible-screen-list 'visible-frame-list)
-(defalias 'window-screen 'window-frame)
-(defalias 'x-create-screen 'x-create-frame)
-(defalias 'x-new-screen 'make-frame)
-
-(provide 'lucid)
-
-;;; end of lucid.el
diff --git a/lisp/emacs-lisp/pp.el b/lisp/emacs-lisp/pp.el
deleted file mode 100644
index 013ce8402d3..00000000000
--- a/lisp/emacs-lisp/pp.el
+++ /dev/null
@@ -1,181 +0,0 @@
-;;; pp.el --- pretty printer for Emacs Lisp
-
-;; Copyright (C) 1989, 1993 Free Software Foundation, Inc.
-
-;; Author: Randal Schwartz <merlyn@stonehenge.com>
-
-;; 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.
-
-;;; Code:
-
-(defvar pp-escape-newlines t 
-  "*Value of print-escape-newlines used by pp-* functions.")
-
-(defun pp-to-string (object)
-  "Return a string containing the pretty-printed representation of OBJECT,
-any Lisp object.  Quoting characters are used when needed to make output
-that `read' can handle, whenever this is possible."
-  (save-excursion
-    (set-buffer (generate-new-buffer " pp-to-string"))
-    (unwind-protect
-	(progn
-	  (lisp-mode-variables t)
-	  (let ((print-escape-newlines pp-escape-newlines))
-	    (prin1 object (current-buffer)))
-	  (goto-char (point-min))
-	  (while (not (eobp))
-	    ;; (message "%06d" (- (point-max) (point)))
-	    (cond
-	     ((looking-at "\\s(\\|#\\s(")
-	      (while (looking-at "\\s(\\|#\\s(")
-		(forward-char 1)))
-	     ((and (looking-at "\\(quote[ \t]+\\)\\([^.)]\\)")
-		   (> (match-beginning 1) 1)
-		   (= ?\( (char-after (1- (match-beginning 1))))
-		   ;; Make sure this is a two-element list.
-		   (save-excursion
-		     (goto-char (match-beginning 2))
-		     (forward-sexp)
-		     ;; (looking-at "[ \t]*\)")
-		     ;; Avoid mucking with match-data; does this test work?
-		     (char-equal ?\) (char-after (point)))))
-	      ;; -1 gets the paren preceding the quote as well.
-	      (delete-region (1- (match-beginning 1)) (match-end 1))
-	      (insert "'")
-	      (forward-sexp 1)
-	      (if (looking-at "[ \t]*\)")
-		  (delete-region (match-beginning 0) (match-end 0))
-		(error "Malformed quote"))
-	      (backward-sexp 1))	      
-	     ((condition-case err-var
-		  (prog1 t (down-list 1))
-		(error nil))
-	      (backward-char 1)
-	      (skip-chars-backward " \t")
-	      (delete-region
-	       (point)
-	       (progn (skip-chars-forward " \t") (point)))
-	      (if (not (char-equal ?' (char-after (1- (point)))))
-		  (insert ?\n)))
-	     ((condition-case err-var
-		  (prog1 t (up-list 1))
-		(error nil))
-	      (while (looking-at "\\s)")
-		(forward-char 1))
-	      (skip-chars-backward " \t")
-	      (delete-region
-	       (point)
-	       (progn (skip-chars-forward " \t") (point)))
-	      (if (not (char-equal ?' (char-after (1- (point)))))
-		  (insert ?\n)))
-	     (t (goto-char (point-max)))))
-	  (goto-char (point-min))
-	  (indent-sexp)
-	  (buffer-string))
-      (kill-buffer (current-buffer)))))
-
-;;;###autoload
-(defun pp (object &optional stream)
-  "Output the pretty-printed representation of OBJECT, any Lisp object.
-Quoting characters are printed when needed to make output that `read'
-can handle, whenever this is possible.
-Output stream is STREAM, or value of `standard-output' (which see)."
-  (princ (pp-to-string object) (or stream standard-output)))
-
-;;;###autoload
-(defun pp-eval-expression (expression)
-  "Evaluate EXPRESSION and pretty-print value into a new display buffer.
-If the pretty-printed value fits on one line, the message line is used
-instead.  Value is also consed on to front of variable  values 's
-value."
-  (interactive "xPp-eval: ")
-  (setq values (cons (eval expression) values))
-  (let* ((old-show-function temp-buffer-show-function)
-	 ;; Use this function to display the buffer.
-	 ;; This function either decides not to display it at all
-	 ;; or displays it in the usual way.
-	 (temp-buffer-show-function
-	  (function
-	   (lambda (buf)
-	     (save-excursion
-	       (set-buffer buf)
-	       (goto-char (point-min))
-	       (end-of-line 1)
-	       (if (or (< (1+ (point)) (point-max))
-		       (>= (- (point) (point-min)) (frame-width)))
-		   (let ((temp-buffer-show-function old-show-function)
-			 (old-selected (selected-window))
-			 (window (display-buffer buf)))
-		     (goto-char (point-min)) ; expected by some hooks ...
-		     (make-frame-visible (window-frame window))
-		     (unwind-protect
-			 (progn
-			   (select-window window)
-			   (run-hooks 'temp-buffer-show-hook))
-		       (select-window old-selected)))
-		 (message "%s" (buffer-substring (point-min) (point)))
-		 ))))))
-    (with-output-to-temp-buffer "*Pp Eval Output*"
-      (pp (car values)))
-    (save-excursion
-      (set-buffer "*Pp Eval Output*")
-      (emacs-lisp-mode)
-      (make-local-variable 'font-lock-verbose)
-      (setq font-lock-verbose nil))))
-
-;;;###autoload
-(defun pp-eval-last-sexp (arg)
-  "Run `pp-eval-expression' on sexp before point (which see).
-With argument, pretty-print output into current buffer.
-Ignores leading comment characters."
-  (interactive "P")
-  (let ((stab (syntax-table)) (pt (point)) start exp)
-    (set-syntax-table emacs-lisp-mode-syntax-table)
-    (save-excursion
-      (forward-sexp -1)
-      ;; If first line is commented, ignore all leading comments:
-      (if (save-excursion (beginning-of-line) (looking-at "[ \t]*;"))
-	  (progn
-	    (setq exp (buffer-substring (point) pt))
-	    (while (string-match "\n[ \t]*;+" exp start)
-	      (setq start (1+ (match-beginning 0))
-		    exp (concat (substring exp 0 start)
-				(substring exp (match-end 0)))))
-	    (setq exp (read exp)))
-	(setq exp (read (current-buffer)))))
-    (set-syntax-table stab)
-    (if arg
-	(insert (pp-to-string (eval exp)))
-      (pp-eval-expression exp))))
-
-;;; Test cases for quote
-;; (pp-eval-expression ''(quote quote))
-;; (pp-eval-expression ''((quote a) (quote b)))
-;; (pp-eval-expression ''('a 'b))	; same as above
-;; (pp-eval-expression ''((quote (quote quote)) (quote quote)))
-;; These do not satisfy the quote test.
-;; (pp-eval-expression ''quote)
-;; (pp-eval-expression ''(quote))
-;; (pp-eval-expression ''(quote . quote))
-;; (pp-eval-expression ''(quote a b))
-;; (pp-eval-expression ''(quotefoo))
-;; (pp-eval-expression ''(a b))
-
-(provide 'pp)				; so (require 'pp) works
-
-;;; pp.el ends here.
diff --git a/lisp/emacs-lisp/profile.el b/lisp/emacs-lisp/profile.el
deleted file mode 100644
index d8f8b5f86fa..00000000000
--- a/lisp/emacs-lisp/profile.el
+++ /dev/null
@@ -1,325 +0,0 @@
-;;; profile.el --- generate run time measurements of Emacs Lisp functions
-
-;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Boaz Ben-Zvi <boaz@lcs.mit.edu>
-;; Created: 07 Feb 1992
-;; Version: 1.0
-;; Adapted-By: ESR
-;; Keywords: lisp, 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:
-
-;; DESCRIPTION:
-;; ------------
-;;   This program can be used to monitor running time performance of Emacs Lisp
-;; functions. It takes a list of functions and report the real time spent 
-;; inside these functions. It runs a process with a separate timer program.
-;;   Caveat: the C code in ../lib-src/profile.c requires BSD-compatible
-;; time-of-day functions.  If you're running an AT&T version prior to SVr4,
-;; you may have difficulty getting it to work.  Your X library may supply
-;; the required routines if the standard C library does not.
-
-;; HOW TO USE:
-;; -----------
-;;   Set the variable  profile-functions-list  to the list of functions
-;; (as symbols) You want to profile. Call  M-x  profile-functions to set 
-;; this list on and start using your program.  Note that profile-functions 
-;; MUST be called AFTER all the functions in profile-functions-list have 
-;; been loaded !!   (This call modifies the code of the profiled functions.
-;; Hence if you reload these functions, you need to call  profile-functions  
-;; again! ).
-;;   To display the results do  M-x  profile-results .  For example:
-;;-------------------------------------------------------------------
-;;  (setq profile-functions-list '(sokoban-set-mode-line sokoban-load-game 
-;;	                          sokoban-move-vertical sokoban-move))
-;;  (load "sokoban")
-;;  M-x profile-functions
-;;     ...  I play the sokoban game ..........
-;;  M-x profile-results
-;;
-;;      Function                     Time (Seconds.Useconds)
-;;      ========                     =======================
-;;      sokoban-move                     0.539088
-;;      sokoban-move-vertical            0.410130
-;;      sokoban-load-game                0.453235
-;;      sokoban-set-mode-line            1.949203
-;;-----------------------------------------------------
-;; To clear all the settings to profile use profile-finish. 
-;; To set one function at a time (instead of or in addition to setting the 
-;; above list and  M-x profile-functions) use M-x profile-a-function.
-
-;;; Code:
-
-;;;
-;;;  User modifiable VARIABLES
-;;;
-
-(defvar profile-functions-list nil "*List of functions to profile.")
-(defvar profile-timer-program
-  (concat exec-directory "profile")
-  "*Name of the profile timer program.")
-
-;;;
-;;; V A R I A B L E S
-;;;
-
-(defvar profile-timer-process nil "Process running the timer.")
-(defvar profile-time-list nil 
-    "List of cumulative calls and time for each profiled function.")
-(defvar profile-init-list nil
-    "List of entry time for each function. 
-Both how many times invoked and real time of start.")
-(defvar profile-max-fun-name 0 "Max length of name of any function profiled.")
-(defvar profile-temp-result- nil "Should NOT be used anywhere else.")
-(defvar profile-time (cons 0 0) "Used to return result from a filter.")
-(defvar profile-buffer "*profile*" "Name of profile buffer.")
-
-;;;
-;;; F U N C T I O N S
-;;;
-
-(defun profile-functions (&optional flist)
-  "Profile all the functions listed in `profile-functions-list'.
-With argument FLIST, use the list FLIST instead."
-  (interactive "P")
-  (if (null flist) (setq flist profile-functions-list))
-  (mapcar 'profile-a-function flist))
-
-(defun profile-filter (process input)
-  "Filter for the timer process.  Sets `profile-time' to the returned time."
-  (if (zerop (string-match "\\." input)) 
-      (error "Bad output from %s" profile-timer-program)
-    (setcar profile-time 
-	    (string-to-int (substring input 0 (match-beginning 0))))
-    (setcdr profile-time 
-	    (string-to-int (substring input (match-end 0))))))
-
-
-(defun profile-print (entry)
-  "Print one ENTRY (from `profile-time-list')."
-  (let* ((calls (car (cdr entry)))
-	 (timec (cdr (cdr entry)))
-	 (time (+ (car timec) (/ (cdr timec) (float profile-million))))
-	 (avgtime 0.0))
-    (insert (format (concat "%-"
-			    (int-to-string profile-max-fun-name)
-			    "s%8d%11d.%06d")
-		    (car entry) calls (car timec) (cdr timec))
-	    (if (zerop calls)
-		"\n"
-	      (format "%12d.%06d\n"
-		      (truncate (setq avgtime (/ time calls)))
-		      (truncate (* (- avgtime (ftruncate avgtime))
-				   profile-million))))
-	    )))
-
-(defun profile-results ()
-  "Display profiling results in the buffer `*profile*'.
-\(The buffer name comes from `profile-buffer'.)"
-  (interactive)
-  (switch-to-buffer profile-buffer)
-  (erase-buffer)
-  (insert "Function" (make-string (- profile-max-fun-name 6) ? ))
-  (insert " Calls  Total time (sec)  Avg time per call\n")
-  (insert (make-string profile-max-fun-name ?=) "  ")
-  (insert "======  ================  =================\n")
-  (mapcar 'profile-print profile-time-list))
-    
-(defun profile-reset-timer ()
-  (process-send-string profile-timer-process "z\n"))
-
-(defun profile-check-zero-init-times (entry)
-  "If ENTRY has non zero time, give an error."
-  (let ((time (cdr (cdr entry))))
-    (if (and (zerop (car time)) (zerop (cdr time))) nil ; OK
-      (error "Process timer died while making performance profile."))))
-
-(defun profile-get-time ()
-  "Get time from timer process into `profile-time'."
-  ;; first time or if process dies
-  (if (and (processp profile-timer-process)
-	   (eq 'run (process-status profile-timer-process))) nil
-    (setq profile-timer-process;; [re]start the timer process
-	  (start-process "timer" 
-			 (get-buffer-create profile-buffer) 
-			 profile-timer-program))
-    (set-process-filter profile-timer-process 'profile-filter)
-    (process-kill-without-query profile-timer-process)
-    (profile-reset-timer)
-    ;; check if timer died during time measurement
-    (mapcar 'profile-check-zero-init-times profile-init-list)) 
-  ;; make timer process return current time
-  (process-send-string profile-timer-process "p\n")
-  (accept-process-output))
-
-(defun profile-find-function (fun flist)
-  "Linear search for FUN in FLIST."
-  (if (null flist) nil
-    (if (eq fun (car (car flist))) (cdr (car flist))
-      (profile-find-function fun (cdr flist)))))
-
-(defun profile-start-function (fun)
-  "On entry, keep current time for function FUN."
-  ;; assumes that profile-time contains the current time
-  (let ((init-time (profile-find-function fun profile-init-list)))
-    (if (null init-time) (error "Function %s missing from list" fun))
-    (if (not (zerop (car init-time)));; is it a recursive call ?
-	(setcar init-time (1+ (car init-time)))
-      (setcar init-time 1)		; mark first entry
-      (setq init-time (cdr init-time))
-      (setcar init-time (car profile-time))
-      (setcdr init-time (cdr profile-time)))
-    ))
-	
-(defconst profile-million 1000000)
-
-(defun profile-update-function (fun)
-  "When the call to the function FUN is finished, add its run time."
-  ;; assumes that profile-time contains the current time
-  (let ((init-time (profile-find-function fun profile-init-list))
-	(accum (profile-find-function fun profile-time-list))
-	calls time sec usec)
-    (if (or (null init-time)
-	    (null accum)) (error "Function %s missing from list" fun))
-    (setq calls (car accum))
-    (setq time (cdr accum))
-    (setcar init-time (1- (car init-time))) ; pop one level in recursion
-    (if (not (zerop (car init-time))) 
-	nil				; in some recursion level,
-					; do not update cumulated time
-      (setcar accum (1+ calls))
-      (setq init-time (cdr init-time))
-      (setq sec (- (car profile-time) (car init-time))
-	    usec (- (cdr profile-time) (cdr init-time)))
-      (setcar init-time 0)		;  reset time to check for error
-      (setcdr init-time 0)		;  in case timer process dies
-      (if (>= usec 0) nil
-	(setq usec (+ usec profile-million))
-	(setq sec (1- sec)))
-      (setcar time (+ sec (car time)))
-      (setcdr time (+ usec (cdr time)))
-      (if (< (cdr time) profile-million) nil
-	(setcar time (1+ (car time)))
-	(setcdr time (- (cdr time) profile-million)))
-      )))
-
-(defun profile-convert-byte-code (function)
-  (let ((defn (symbol-function function)))
-    (if (byte-code-function-p defn)
-	;; It is a compiled code object.
-	(let* ((contents (append defn nil))
-	       (body
-		(list (list 'byte-code (nth 1 contents)
-			    (nth 2 contents) (nth 3 contents)))))
-	  (if (nthcdr 5 contents)
-	      (setq body (cons (list 'interactive (nth 5 contents)) body)))
-	  (if (nth 4 contents)
-	      ;; Use `documentation' here, to get the actual string,
-	      ;; in case the compiled function has a reference
-	      ;; to the .elc file.
-	      (setq body (cons (documentation function) body)))
-	  (fset function (cons 'lambda (cons (car contents) body)))))))
-
-(defun profile-a-function (fun)
-  "Profile the function FUN."
-  (interactive "aFunction to profile: ")
-  (profile-convert-byte-code fun)
-  (let ((def (symbol-function fun)) (funlen (length (symbol-name fun))))
-    (if (eq (car def) 'lambda) nil
-      (error "To profile: %s must be a user-defined function" fun))
-    (setq profile-time-list		; add a new entry
-	  (cons (cons fun (cons 0 (cons 0 0))) profile-time-list))
-    (setq profile-init-list		; add a new entry
-	  (cons (cons fun (cons 0 (cons 0 0))) profile-init-list))
-    (if (< profile-max-fun-name funlen) (setq profile-max-fun-name funlen))
-    (fset fun (profile-fix-fun fun def))))
-
-(defun profile-fix-fun (fun def)
-  "Take function FUN and return it fixed for profiling.
-DEF is (symbol-function FUN)."
-  (let (prefix first second third (count 2) inter suffix)
-    (if (< (length def) 3)
-	nil		; nothing to see
-      (setq first (car def) second (car (cdr def))
-	    third (car (nthcdr 2 def)))
-      (setq prefix (list first second))
-      ;; Skip the doc string, if there is a string
-      ;; which serves only as a doc string,
-      ;; and put it in PREFIX.
-      (if (or (not (stringp third)) (not (nthcdr 3 def)))
-	  ;; Either no doc string, or it is also the function value.
-	  (setq inter third) 
-	;; Skip the doc string,
-	(setq count 3
-	      prefix (nconc prefix (list third))
-	      inter (car (nthcdr 3 def))))
-      ;; Check for an interactive spec.
-      ;; If found, put it inu  PREFIX and skip it.
-      (if (not (and (listp inter) 
-		    (eq (car inter) 'interactive)))
-	  nil
-	(setq prefix (nconc prefix (list inter)))
-	(setq count (1+ count)))	; skip this sexp for suffix
-      ;; Set SUFFIX to the function body forms.
-      (setq suffix (nthcdr count def))
-      (if (equal (car suffix) '(profile-get-time))
-	  nil
-	;; Prepare new function definition.
-	(nconc prefix
-	       (list '(profile-get-time)) ; read time
-	       (list (list 'profile-start-function 
-			   (list 'quote fun)))
-	       (list (list 'setq 'profile-temp-result- 
-			   (nconc (list 'progn) suffix)))
-	       (list '(profile-get-time)) ; read time
-	       (list (list 'profile-update-function 
-			   (list 'quote fun)))
-	       (list 'profile-temp-result-)
-	       )))))
-
-(defun profile-restore-fun (fun)
-  "Restore profiled function FUN to its original state."
-  (let ((def (symbol-function (car fun))) body index)
-    ;; move index beyond header
-    (setq index (cdr def))
-    (if (stringp (car (cdr index))) (setq index (cdr index)))
-    (if (and (listp (car (cdr index)))
-	     (eq (car (car (cdr index))) 'interactive))
-	(setq index (cdr index)))
-    (setq body (car (nthcdr 3 index)))
-    (if (and (listp body)		; the right element ?
-	     (eq (car (cdr body)) 'profile-temp-result-))
-	(setcdr index (cdr (car (cdr (cdr body))))))))
-
-(defun profile-finish ()
-  "Stop profiling functions.  Clear all the settings."
-  (interactive)
-  (mapcar 'profile-restore-fun profile-time-list)
-  (setq profile-max-fun-name 0)
-  (setq profile-time-list nil)
-  (setq profile-init-list nil))
-
-(defun profile-quit ()
-  "Kill the timer process."
-  (interactive)
-  (process-send-string profile-timer-process "q\n"))
-
-;;; profile.el ends here
diff --git a/lisp/emacs-lisp/ring.el b/lisp/emacs-lisp/ring.el
deleted file mode 100644
index ac5a72a8e67..00000000000
--- a/lisp/emacs-lisp/ring.el
+++ /dev/null
@@ -1,135 +0,0 @@
-;;; ring.el --- handle rings of items
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; 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:
-
-;; This code defines a ring data structure. A ring is a 
-;;     (hd-index length . vector) 
-;; list. You can insert to, remove from, and rotate a ring. When the ring
-;; fills up, insertions cause the oldest elts to be quietly dropped.
-;;
-;; In ring-ref, 0 is the index of the newest element.  Higher indexes
-;; correspond to older elements until they wrap.
-;;
-;; hd-index = index of the newest item on the ring.
-;; length = number of ring items.
-;;
-;; These functions are used by the input history mechanism, but they can
-;; be used for other purposes as well.
-
-;;; Code:
-
-;;;###autoload
-(defun ring-p (x) 
-  "Returns t if X is a ring; nil otherwise."
-  (and (consp x) (integerp (car x))
-       (consp (cdr x)) (integerp (car (cdr x)))
-       (vectorp (cdr (cdr x)))))
-
-;;;###autoload
-(defun make-ring (size)
-  "Make a ring that can contain SIZE elements."
-  (cons 0 (cons 0 (make-vector size nil))))
-
-(defun ring-insert-at-beginning (ring item)
-  "Add to RING the item ITEM.  Add it at the front (the early end)."
-  (let* ((vec (cdr (cdr ring))) 
-	 (veclen (length vec))
-	 (hd (car ring))
-	 (ln (car (cdr ring))))
-    (setq ln (min veclen (1+ ln))
-	  hd (ring-minus1 hd veclen))
-    (aset vec hd item)
-    (setcar ring hd)
-    (setcar (cdr ring) ln)))
-
-(defun ring-plus1 (index veclen)
-  "INDEX+1, with wraparound"
-  (let ((new-index (+ index 1)))
-    (if (= new-index veclen) 0 new-index)))
-
-(defun ring-minus1 (index veclen)
-  "INDEX-1, with wraparound"
-  (- (if (= 0 index) veclen index) 1))
-
-(defun ring-length (ring)
-  "Number of elements in the ring."
-  (car (cdr ring)))
-
-(defun ring-empty-p (ring)
-  (= 0 (car (cdr ring))))
-
-(defun ring-index (index head ringlen veclen)
-  (setq index (mod index ringlen))
-  (mod (1- (+ head (- ringlen index))) veclen))
-
-(defun ring-insert (ring item)
-  "Insert onto ring RING the item ITEM, as the newest (last) item.
-If the ring is full, dump the oldest item to make room."       
-  (let* ((vec (cdr (cdr ring))) 
-	 (veclen (length vec))
-	 (hd (car ring))
-	 (ln (car (cdr ring))))
-    (prog1
-	(aset vec (mod (+ hd ln) veclen) item)
-      (if (= ln veclen)
-	  (setcar ring (ring-plus1 hd veclen))
-	(setcar (cdr ring) (1+ ln))))))
-
-(defun ring-remove (ring &optional index)
-  "Remove an item from the RING.  Return the removed item.
-If optional INDEX is nil, remove the oldest item.  If it's
-numeric, remove the element indexed."
-  (if (ring-empty-p ring)
-      (error "Ring empty")
-    (let* ((hd (car ring))
-	  (ln (car (cdr ring)))
-	  (vec (cdr (cdr ring)))
-	  (veclen (length vec))
-	  (tl (mod (1- (+ hd ln)) veclen))
-	  oldelt)
-      (if (null index)
-	  (setq index (1- ln)))
-      (setq index (ring-index index hd ln veclen))
-      (setq oldelt (aref vec index))
-      (while (/= index tl)
-	(aset vec index (aref vec (ring-plus1 index veclen)))
-	(setq index (ring-plus1 index veclen)))
-      (aset vec tl nil)
-      (setcar (cdr ring) (1- ln))
-      oldelt)))
-
-(defun ring-ref (ring index)
-  "Returns RING's INDEX element.
-INDEX need not be <= the ring length, the appropriate modulo operation
-will be performed.  Element 0 is the most recently inserted; higher indices
-correspond to older elements until they wrap."
-  (if (ring-empty-p ring)
-      (error "indexed empty ring")
-    (let* ((hd (car ring))  (ln (car (cdr ring)))  (vec (cdr (cdr ring))))
-      (aref vec (ring-index index hd ln (length vec))))))
-
-(provide 'ring)
-
-;;; ring.el ends here
diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el
deleted file mode 100644
index 73650de88c8..00000000000
--- a/lisp/emacs-lisp/shadow.el
+++ /dev/null
@@ -1,203 +0,0 @@
-;;; shadow.el --- Locate Emacs Lisp file shadowings.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Terry Jones <terry@santafe.edu>
-;; Keywords: lisp
-;; Created: 15 December 1995
-
-;; 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:
-
-;; The functions in this file detect (`find-emacs-lisp-shadows')
-;; and display (`list-load-path-shadows') potential load-path
-;; problems that arise when Emacs Lisp files "shadow" each other.
-;;
-;; For example, a file XXX.el early in one's load-path will shadow
-;; a file with the same name in a later load-path directory.  When
-;; this is unintentional, it may result in problems that could have
-;; been easily avoided.  This occurs often (to me) when installing a
-;; new version of emacs and something in the site-lisp directory
-;; has been updated and added to the emacs distribution.  The old
-;; version, now outdated, shadows the new one. This is obviously
-;; undesirable.
-;;
-;; The `list-load-path-shadows' function was run when you installed
-;; this version of emacs. To run it by hand in emacs:
-;;
-;;     M-x load-library RET shadow RET
-;;     M-x list-load-path-shadows
-;;
-;; or run it non-interactively via:
-;;
-;;     emacs -batch -l shadow.el -f list-load-path-shadows
-;;
-;; Thanks to Francesco Potorti` <pot@cnuce.cnr.it> for suggestions,
-;; rewritings & speedups.
-
-;;; Code:
-
-(defun find-emacs-lisp-shadows (&optional path)
-  "Return a list of Emacs Lisp files that create shadows.
-This function does the work for `list-load-path-shadows'.
-
-We traverse PATH looking for shadows, and return a \(possibly empty\)
-even-length list of files.  A file in this list at position 2i shadows
-the file in position 2i+1.  Emacs Lisp file suffixes \(.el and .elc\)
-are stripped from the file names in the list.
-
-See the documentation for `list-load-path-shadows' for further information."
-  
-  (or path (setq path load-path))
-
-  (let (true-names			; List of dirs considered.
-	shadows				; List of shadowings, to be returned.
-	files				; File names ever seen, with dirs.
-	dir				; The dir being currently scanned.
-	curr-files			; This dir's Emacs Lisp files.
-	orig-dir			; Where the file was first seen.
-	files-seen-this-dir		; Files seen so far in this dir.
-	file)				; The current file.
-
-  
-    (while path
-
-      (setq dir (file-truename (or (car path) ".")))
-      (if (member dir true-names)
-	  ;; We have already considered this PATH redundant directory.
-	  ;; Show the redundancy if we are interactiver, unless the PATH
-	  ;; dir is nil or "." (these redundant directories are just a
-	  ;; result of the current working directory, and are therefore
-	  ;; not always redundant).
-	  (or noninteractive
-	      (and (car path)
-		   (not (string= (car path) "."))
-		   (message "Ignoring redundant directory %s" (car path))))
-	
-	(setq true-names (append true-names (list dir)))
-	(setq dir (or (car path) "."))
-	(setq curr-files (if (file-accessible-directory-p dir)
-                               (directory-files dir nil ".\\.elc?$" t)))
-	(and curr-files
-	     (not noninteractive)
-	     (message "Checking %d files in %s..." (length curr-files) dir))
-	
-	(setq files-seen-this-dir nil)
-
-	(while curr-files
-
-	  (setq file (car curr-files))
-	  (setq file (substring
-		      file 0 (if (string= (substring file -1) "c") -4 -3)))
-
-	  ;; 'file' now contains the current file name, with no suffix.
-	  (if (member file files-seen-this-dir)
-	      nil
-	  	    
-	    ;; File has not been seen yet in this directory.
-	    ;; This test prevents us declaring that XXX.el shadows
-	    ;; XXX.elc (or vice-versa) when they are in the same directory.
-	    (setq files-seen-this-dir (cons file files-seen-this-dir))
-	      
-	    (if (setq orig-dir (assoc file files))
-		;; This file was seen before, we have a shadowing.
-		(setq shadows
-		      (append shadows
-			      (list (concat (cdr orig-dir) "/" file)
-				    (concat dir "/" file))))
-
-	      ;; Not seen before, add it to the list of seen files.
-	      (setq files (cons (cons file dir) files))))
-
-	  (setq curr-files (cdr curr-files))))
-	(setq path (cdr path)))
-
-    ;; Return the list of shadowings.
-    shadows))
-
-
-;;;###autoload
-(defun list-load-path-shadows ()
-  
-  "Display a list of Emacs Lisp files that shadow other files.
-
-This function lists potential load-path problems.  Directories in the
-`load-path' variable are searched, in order, for Emacs Lisp
-files.  When a previously encountered file name is found again, a
-message is displayed indicating that the later file is \"hidden\" by
-the earlier.
-
-For example, suppose `load-path' is set to
-
-\(\"/usr/gnu/emacs/site-lisp\" \"/usr/gnu/emacs/share/emacs/19.30/lisp\"\)
-
-and that each of these directories contains a file called XXX.el.  Then
-XXX.el in the site-lisp directory is referred to by all of:
-\(require 'XXX\), \(autoload .... \"XXX\"\), \(load-library \"XXX\"\) etc.
-
-The first XXX.el file prevents emacs from seeing the second \(unless
-the second is loaded explicitly via load-file\).
-
-When not intended, such shadowings can be the source of subtle
-problems.  For example, the above situation may have arisen because the
-XXX package was not distributed with versions of emacs prior to
-19.30.  An emacs maintainer downloaded XXX from elsewhere and installed
-it.  Later, XXX was updated and included in the emacs distribution.
-Unless the emacs maintainer checks for this, the new version of XXX
-will be hidden behind the old \(which may no longer work with the new
-emacs version\).
-
-This function performs these checks and flags all possible
-shadowings.  Because a .el file may exist without a corresponding .elc
-\(or vice-versa\), these suffixes are essentially ignored.  A file
-XXX.elc in an early directory \(that does not contain XXX.el\) is
-considered to shadow a later file XXX.el, and vice-versa.
-
-When run interactively, the shadowings \(if any\) are displayed in a
-buffer called `*Shadows*'.  Shadowings are located by calling the
-\(non-interactive\) companion function, `find-emacs-lisp-shadows'."
-  
-  (interactive)
-  (let* ((shadows (find-emacs-lisp-shadows))
-	 (n (/ (length shadows) 2))
-	 (msg (format "%s Emacs Lisp load-path shadowing%s found"
-		      (if (zerop n) "No" (concat "\n" (number-to-string n)))
-		      (if (= n 1) " was" "s were"))))
-    (if (interactive-p)
-	(save-excursion
-	  ;; We are interactive.
-	  ;; Create the *Shadows* buffer and display shadowings there.
-	  (let ((output-buffer (get-buffer-create "*Shadows*")))
-	    (display-buffer output-buffer)
-	    (set-buffer output-buffer)
-	    (erase-buffer)
-	    (while shadows
-	      (insert (format "%s hides %s\n" (car shadows)
-			      (car (cdr shadows))))
-	      (setq shadows (cdr (cdr shadows))))
-	    (insert msg "\n")))
-      ;; We are non-interactive, print shadows via message.
-      (while shadows
-	(message "%s hides %s" (car shadows) (car (cdr shadows)))
-	(setq shadows (cdr (cdr shadows))))
-      (message "%s" msg))))
-
-(provide 'shadow)
-
-;;; shadow.el ends here
diff --git a/lisp/emacs-lisp/tq.el b/lisp/emacs-lisp/tq.el
deleted file mode 100644
index 0de2c48e638..00000000000
--- a/lisp/emacs-lisp/tq.el
+++ /dev/null
@@ -1,123 +0,0 @@
-;;; tq.el --- utility to maintain a transaction queue
-
-;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
-
-;; Author: Scott Draves <spot@cs.cmu.edu>
-;; Adapted-By: ESR
-;; 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:
- 
-;;; manages receiving a stream asynchronously, 
-;;; parsing it into transactions, and then calling
-;;; handler functions
-
-;;; Our basic structure is the queue/process/buffer triple.  Each entry
-;;; of the queue is a regexp/closure/function triple.  We buffer
-;;; bytes from the process until we see the regexp at the head of the
-;;; queue.  Then we call the function with the closure and the
-;;; collected bytes.
-
-;;; Code:
-
-;;;###autoload
-(defun tq-create (process)
-  "Create and return a transaction queue communicating with PROCESS.
-PROCESS should be a subprocess capable of sending and receiving
-streams of bytes.  It may be a local process, or it may be connected
-to a tcp server on another machine."
-  (let ((tq (cons nil (cons process
-			    (generate-new-buffer
-			     (concat " tq-temp-"
-				     (process-name process)))))))
-    (set-process-filter process
-			(`(lambda (proc string)
-			   (tq-filter  '(, tq) string))))
-    tq))
-
-;;; accessors
-(defun tq-queue   (tq) (car tq))
-(defun tq-process (tq) (car (cdr tq)))
-(defun tq-buffer  (tq) (cdr (cdr tq)))
-
-(defun tq-queue-add (tq re closure fn)
-  (setcar tq (nconc (tq-queue tq)
-		    (cons (cons re (cons closure fn)) nil)))
-  'ok)
-
-(defun tq-queue-head-regexp  (tq) (car (car (tq-queue tq))))
-(defun tq-queue-head-fn      (tq) (cdr (cdr (car (tq-queue tq)))))
-(defun tq-queue-head-closure (tq) (car (cdr (car (tq-queue tq)))))
-(defun tq-queue-empty        (tq) (not (tq-queue tq)))
-(defun tq-queue-pop          (tq) (setcar tq (cdr (car tq))) (null (car tq)))
- 
-
-;;; must add to queue before sending!
-(defun tq-enqueue (tq question regexp closure fn)
-  "Add a transaction to transaction queue TQ.
-This sends the string QUESTION to the process that TQ communicates with.
-When the corresponding answer comes back, we call FN
-with two arguments: CLOSURE, and the answer to the question.
-REGEXP is a regular expression to match the entire answer;
-that's how we tell where the answer ends."
-  (tq-queue-add tq regexp closure fn)
-  (process-send-string (tq-process tq) question))
-
-(defun tq-close (tq)
-  "Shut down transaction queue TQ, terminating the process."
-  (delete-process (tq-process tq))
-  (kill-buffer (tq-buffer tq)))
-
-(defun tq-filter (tq string)
-  "Append STRING to the TQ's buffer; then process the new data."
-  (let ((old-buffer (current-buffer)))
-    (unwind-protect
-	(progn
-	  (set-buffer (tq-buffer tq))
-	  (goto-char (point-max))
-	  (insert string)
-	  (tq-process-buffer tq))
-      (set-buffer old-buffer))))
-
-(defun tq-process-buffer (tq)
-  "Check TQ's buffer for the regexp at the head of the queue."
-  (set-buffer (tq-buffer tq))
-  (if (= 0 (buffer-size)) ()
-    (if (tq-queue-empty tq)
-	(let ((buf (generate-new-buffer "*spurious*")))
-	  (copy-to-buffer buf (point-min) (point-max))
-	  (delete-region (point-min) (point))
-	  (pop-to-buffer buf nil)
-	  (error "Spurious communication from process %s, see buffer %s"
-		 (process-name (tq-process tq))
-		 (buffer-name buf)))
-      (goto-char (point-min))
-      (if (re-search-forward (tq-queue-head-regexp tq) nil t)
-	  (let ((answer (buffer-substring (point-min) (point))))
-	    (delete-region (point-min) (point))
-	    (funcall (tq-queue-head-fn tq)
-		     (tq-queue-head-closure tq)
-		     answer)
-	    (tq-queue-pop tq)
-	    (tq-process-buffer tq))))))
-
-(provide 'tq)
-
-;;; tq.el ends here
diff --git a/lisp/emacs-lisp/trace.el b/lisp/emacs-lisp/trace.el
deleted file mode 100644
index 40008e29a19..00000000000
--- a/lisp/emacs-lisp/trace.el
+++ /dev/null
@@ -1,314 +0,0 @@
-;;; trace.el --- tracing facility for Emacs Lisp functions
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Hans Chalupsky <hans@cs.buffalo.edu>
-;; Created: 15 Dec 1992
-;; Keywords: tools, lisp
-
-;; 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.
-
-;; LCD Archive Entry:
-;; trace|Hans Chalupsky|hans@cs.buffalo.edu|
-;; Tracing facility for Emacs Lisp functions|
-;; 1993/05/18 00:41:16|2.0|~/packages/trace.el.Z|
-
-
-;;; Commentary:
-
-;; Introduction:
-;; =============
-;; A simple trace package that utilizes advice.el. It generates trace 
-;; information in a Lisp-style fashion and inserts it into a trace output
-;; buffer. Tracing can be done in the background (or silently) so that
-;; generation of trace output won't interfere with what you are currently
-;; doing.
-
-;; How to get the latest trace.el:
-;; ===============================
-;; You can get the latest version of this file either via anonymous ftp from 
-;; ftp.cs.buffalo.edu (128.205.32.9) with pathname /pub/Emacs/trace.el,
-;; or send email to hans@cs.buffalo.edu and I'll mail it to you.
-
-;; Requirement:
-;; ============
-;; trace.el needs advice.el version 2.0 or later which you can get from the
-;; same place from where you got trace.el.
-
-;; Restrictions:
-;; =============
-;; - Traced subrs when called interactively will always show nil as the
-;;   value of their arguments.
-;; - Only functions/macros/subrs that are called via their function cell will
-;;   generate trace output, hence, you won't get trace output for:
-;;   + Subrs called directly from other subrs/C-code
-;;   + Compiled calls to subrs that have special byte-codes associated
-;;     with them (e.g., car, cdr, ...)
-;;   + Macros that were expanded during compilation
-;; - All the restrictions that apply to advice.el
-
-;; Installation:
-;; =============
-;; Put this file together with advice.el (version 2.0 or later) somewhere
-;; into your Emacs `load-path', byte-compile it/them for efficiency, and
-;; put the following autoload declarations into your .emacs
-;;
-;;    (autoload 'trace-function "trace" "Trace a function" t)
-;;    (autoload 'trace-function-background "trace" "Trace a function" t)
-;;
-;; or explicitly load it with (require 'trace) or (load "trace").
-
-;; Comments, suggestions, bug reports
-;; ==================================
-;; are strongly appreciated, please email them to hans@cs.buffalo.edu.
-
-;; Usage:
-;; ======
-;; - To trace a function say `M-x trace-function' which will ask you for the
-;;   name of the function/subr/macro to trace, as well as for the buffer
-;;   into which trace output should go.
-;; - If you want to trace a function that switches buffers or does other
-;;   display oriented stuff use `M-x trace-function-background' which will
-;;   generate the trace output silently in the background without popping
-;;   up windows and doing other irritating stuff.
-;; - To untrace a function say `M-x untrace-function'.
-;; - To untrace all currently traced functions say `M-x untrace-all'.
-
-;; Examples:
-;; =========
-;;
-;;  (defun fact (n)
-;;    (if (= n 0) 1
-;;      (* n (fact (1- n)))))
-;;  fact
-;;  
-;;  (trace-function 'fact)
-;;  fact
-;;
-;;  Now, evaluating this...
-;;
-;;  (fact 4)
-;;  24
-;;
-;;  ...will generate the following in *trace-buffer*:
-;;
-;;  1 -> fact: n=4
-;;  | 2 -> fact: n=3
-;;  | | 3 -> fact: n=2
-;;  | | | 4 -> fact: n=1
-;;  | | | | 5 -> fact: n=0
-;;  | | | | 5 <- fact: 1
-;;  | | | 4 <- fact: 1
-;;  | | 3 <- fact: 2
-;;  | 2 <- fact: 6
-;;  1 <- fact: 24
-;;
-;;
-;;  (defun ack (x y z)
-;;    (if (= x 0) 
-;;        (+ y z)
-;;      (if (and (<= x 2) (= z 0)) 
-;;          (1- x)
-;;        (if (and (> x 2) (= z 0)) 
-;;            y
-;;          (ack (1- x) y (ack x y (1- z)))))))
-;;  ack
-;;
-;;  (trace-function 'ack)
-;;  ack
-;;
-;;  Try this for some interesting trace output:
-;;
-;;  (ack 3 3 1)
-;;  27
-;;
-;; 
-;; The following does something similar to the functionality of the package
-;; log-message.el by Robert Potter, which is giving you a chance to look at
-;; messages that might have whizzed by too quickly (you won't see subr
-;; generated messages though):
-;;
-;; (trace-function-background 'message "*Message Log*")
-
-
-;;; Change Log:
-
-;; Revision 2.0 1993/05/18 00:41:16 hans
-;;	* Adapted for advice.el 2.0; it now also works
-;;	  for GNU Emacs-19 and Lemacs
-;;	* Separate function `trace-function-background'
-;;	* Separate pieces of advice for foreground and background tracing
-;;	* Less insane handling of interactive trace buffer specification
-;;	* String arguments and values are now printed properly
-;;
-;; Revision 1.1 1992/12/15 22:45:15 hans
-;;	* Created, first public release
-
-
-;;; Code:
-
-(require 'advice)
-
-;;;###autoload
-(defvar trace-buffer "*trace-output*"
-  "*Trace output will by default go to that buffer.")
-
-;; Current level of traced function invocation:
-(defvar trace-level 0)
-
-;; Semi-cryptic name used for a piece of trace advice:
-(defvar trace-advice-name 'trace-function\ )
-
-;; Used to separate new trace output from previous traced runs:
-(defvar trace-separator (format "%s\n" (make-string 70 ?=)))
-
-(defun trace-entry-message (function level argument-bindings)
-  ;; Generates a string that describes that FUNCTION has been entered at
-  ;; trace LEVEL with ARGUMENT-BINDINGS.
-  (format "%s%s%d -> %s: %s\n"
-	  (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
-	  (if (> level 1) " " "")
-	  level
-	  function
-	  (mapconcat (function
-		      (lambda (binding)
-			(concat
-			 (symbol-name (ad-arg-binding-field binding 'name))
-			 "="
-			 ;; do this so we'll see strings:
-			 (prin1-to-string
-			  (ad-arg-binding-field binding 'value)))))
-		     argument-bindings
-		     " ")))
-
-(defun trace-exit-message (function level value)
-  ;; Generates a string that describes that FUNCTION has been exited at
-  ;; trace LEVEL and that it returned VALUE.
-  (format "%s%s%d <- %s: %s\n"
-	  (mapconcat 'char-to-string (make-string (1- level) ?|) " ")
-	  (if (> level 1) " " "")
-	  level
-	  function
-	  ;; do this so we'll see strings:
-	  (prin1-to-string value)))
-
-(defun trace-make-advice (function buffer background)
-  ;; Builds the piece of advice to be added to FUNCTION's advice info
-  ;; so that it will generate the proper trace output in BUFFER
-  ;; (quietly if BACKGROUND is t).
-  (ad-make-advice
-   trace-advice-name nil t
-   (cond (background
-	  (` (advice
-	      lambda ()
-	      (let ((trace-level (1+ trace-level))
-		    (trace-buffer (get-buffer-create (, buffer))))
-		(save-excursion
-		  (set-buffer trace-buffer)
-		  (goto-char (point-max))
-		  ;; Insert a separator from previous trace output:
-		  (if (= trace-level 1) (insert trace-separator))
-		  (insert
-		   (trace-entry-message
-		    '(, function) trace-level ad-arg-bindings)))
-		ad-do-it
-		(save-excursion
-		  (set-buffer trace-buffer)
-		  (goto-char (point-max))
-		  (insert
-		   (trace-exit-message
-		    '(, function) trace-level ad-return-value)))))))
-	 (t (` (advice
-		lambda ()
-		(let ((trace-level (1+ trace-level))
-		      (trace-buffer (get-buffer-create (, buffer))))
-		  (pop-to-buffer trace-buffer)
-		  (goto-char (point-max))
-		  ;; Insert a separator from previous trace output:
-		  (if (= trace-level 1) (insert trace-separator))
-		  (insert
-		   (trace-entry-message
-		    '(, function) trace-level ad-arg-bindings))
-		  ad-do-it
-		  (pop-to-buffer trace-buffer)
-		  (goto-char (point-max))
-		  (insert
-		   (trace-exit-message
-		    '(, function) trace-level ad-return-value)))))))))
-
-(defun trace-function-internal (function buffer background)
-  ;; Adds trace advice for FUNCTION and activates it.
-  (ad-add-advice
-   function
-   (trace-make-advice function (or buffer trace-buffer) background)
-   'around 'last)
-  (ad-activate function nil))
-
-(defun trace-is-traced (function)
-  (ad-find-advice function 'around trace-advice-name))
-
-;;;###autoload
-(defun trace-function (function &optional buffer)
-  "Traces FUNCTION with trace output going to BUFFER.
-For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
-trace advice for FUNCTION and activates it together with any other advice
-there might be!! The trace BUFFER will popup whenever FUNCTION is called.
-Do not use this to trace functions that switch buffers or do any other
-display oriented stuff, use `trace-function-background' instead."
-  (interactive
-   (list
-    (intern (completing-read "Trace function: " obarray 'fboundp t))
-    (read-buffer "Output to buffer: " trace-buffer)))
-  (trace-function-internal function buffer nil))
-
-;;;###autoload
-(defun trace-function-background (function &optional buffer)
-  "Traces FUNCTION with trace output going quietly to BUFFER.
-For every call of FUNCTION Lisp-style trace messages that display argument
-and return values will be inserted into BUFFER. This function generates the
-trace advice for FUNCTION and activates it together with any other advice
-there might be!! Trace output will quietly go to BUFFER without changing
-the window or buffer configuration at all."
-  (interactive
-   (list
-    (intern
-     (completing-read "Trace function in background: " obarray 'fboundp t))
-    (read-buffer "Output to buffer: " trace-buffer)))
-  (trace-function-internal function buffer t))
-
-(defun untrace-function (function)
-  "Untraces FUNCTION and possibly activates all remaining advice.
-Activation is performed with `ad-update', hence remaining advice will get
-activated only if the advice of FUNCTION is currently active. If FUNCTION
-was not traced this is a noop."
-  (interactive
-   (list (ad-read-advised-function "Untrace function: " 'trace-is-traced)))
-  (cond ((trace-is-traced function)
-	 (ad-remove-advice function 'around trace-advice-name)
-	 (ad-update function))))
-
-(defun untrace-all ()
-  "Untraces all currently traced functions."
-  (interactive)
-  (ad-do-advised-functions (function)
-    (untrace-function function)))
-
-(provide 'trace)
-
-;;; trace.el ends here
diff --git a/lisp/emacs-lock.el b/lisp/emacs-lock.el
deleted file mode 100644
index 724fa034429..00000000000
--- a/lisp/emacs-lock.el
+++ /dev/null
@@ -1,68 +0,0 @@
-;;; emacs-lock.el --- prevents you from exiting emacs if a buffer is locked
-
-;; Copyright (C) 1994 Free Software Foundation, Inc
-
-;; Author: Tom Wurgler <twurgler@goodyear.com>
-;; Created: 12/8/94
-;; Version: 1.3
-;; Keywords: 
-
-;; 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 code sets a buffer-local variable to t if toggle-emacs-lock is run,
-;; then if the user attempts to exit emacs, the locked buffer name will be
-;; displayed and the exit aborted.  This is just a way of protecting
-;; yourself from yourself.  For example, if you have a shell running a big
-;; program and exiting emacs would abort that program, you may want to lock
-;; that buffer, then if you forget about it after a while, you won't
-;; accidentally exit emacs.  To unlock the buffer, just goto the buffer and
-;; run toggle-emacs-lock again.
-
-;;; Code:
-
-(defvar lock-emacs-from-exiting nil
-  "Whether emacs is locked to prevent exiting.  See `check-emacs-lock'.")
-(make-variable-buffer-local 'lock-emacs-from-exiting)
-
-(defun check-emacs-lock ()
-  "Check if variable `lock-emacs-from-exiting' is t for any buffer.
-If any t is found, signal error and display the locked buffer name."
-  (let ((buffers (buffer-list)))
-    (save-excursion
-      (while buffers 
-	(set-buffer (car buffers))
-	(if lock-emacs-from-exiting
-	    (error "Emacs is locked from exit due to buffer: %s" (buffer-name))
-	  (setq buffers (cdr buffers)))))))
-
-(defun toggle-emacs-lock ()
-  "Toggle `lock-emacs-from-exiting' between t and nil for the current buffer.
-See `check-emacs-lock'."
-  (interactive)
-  (if lock-emacs-from-exiting
-      (setq lock-emacs-from-exiting nil)
-    (setq lock-emacs-from-exiting t))
-  (if lock-emacs-from-exiting
-      (message "Emacs is now locked from exiting.")
-    (message "Emacs is now unlocked.")))
-
-(add-hook 'kill-emacs-hook 'check-emacs-lock)
-
-;; emacs-lock.el ends here
diff --git a/lisp/emerge.el b/lisp/emerge.el
deleted file mode 100644
index b8b085f64e5..00000000000
--- a/lisp/emerge.el
+++ /dev/null
@@ -1,3173 +0,0 @@
-;;; emerge.el --- merge diffs under Emacs control
-
-;;; The author has placed this file in the public domain.
-
-;; Author: Dale R. Worley <worley@world.std.com>
-;; Version: 5fsf
-;; Keywords: unix, tools
-
-;; This software was created by Dale R. Worley and is
-;; distributed free of charge.  It is placed in the public domain and
-;; permission is granted to anyone to use, duplicate, modify and redistribute
-;; it provided that this notice is attached.
-
-;; Dale R. Worley provides absolutely NO WARRANTY OF ANY KIND
-;; with respect to this software.  The entire risk as to the quality and
-;; performance of this software is with the user.  IN NO EVENT WILL DALE
-;; R. WORLEY BE LIABLE TO ANYONE FOR ANY DAMAGES ARISING OUT THE
-;; USE OF THIS SOFTWARE, INCLUDING, WITHOUT LIMITATION, DAMAGES RESULTING FROM
-;; LOST DATA OR LOST PROFITS, OR FOR ANY SPECIAL, INCIDENTAL OR CONSEQUENTIAL
-;; DAMAGES.
-
-;;; Code:
-
-;;;###autoload
-(defvar menu-bar-emerge-menu (make-sparse-keymap "Emerge"))
-;;;###autoload
-(fset 'menu-bar-emerge-menu (symbol-value 'menu-bar-emerge-menu))
-
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-merge-directories]
-  '("Merge Directories..." . emerge-merge-directories))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-revisions-with-ancestor]
-  '("Revisions with Ancestor..." . emerge-revisions-with-ancestor))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-revisions]
-  '("Revisions..." . emerge-revisions))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-files-with-ancestor]
-  '("Files with Ancestor..." . emerge-files-with-ancestor))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-files]
-  '("Files..." . emerge-files))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-buffers-with-ancestor]
-  '("Buffers with Ancestor..." . emerge-buffers-with-ancestor))
-;;;###autoload
-(define-key menu-bar-emerge-menu [emerge-buffers]
-  '("Buffers..." . emerge-buffers))
-
-;;; Macros
-
-(defmacro emerge-eval-in-buffer (buffer &rest forms)
-  "Macro to switch to BUFFER, evaluate FORMS, returns to original buffer.
-Differs from `save-excursion' in that it doesn't save the point and mark."
-  (` (let ((StartBuffer (current-buffer)))
-    (unwind-protect
-	(progn
-	  (set-buffer (, buffer))
-	  (,@ forms))
-      (set-buffer StartBuffer)))))
-
-(defmacro emerge-defvar-local (var value doc) 
-  "Defines SYMBOL as an advertised variable.  
-Performs a defvar, then executes `make-variable-buffer-local' on
-the variable.  Also sets the `preserved' property, so that
-`kill-all-local-variables' (called by major-mode setting commands) 
-won't destroy Emerge control variables."
-  (` (progn
-       (defvar (, var) (, value) (, doc))
-       (make-variable-buffer-local '(, var))
-       (put '(, var) 'preserved t))))
-
-;; Add entries to minor-mode-alist so that emerge modes show correctly
-(defvar emerge-minor-modes-list
-  '((emerge-mode " Emerge")
-    (emerge-fast-mode " F")
-    (emerge-edit-mode " E")
-    (emerge-auto-advance " A")
-    (emerge-skip-prefers " S")))
-(if (not (assq 'emerge-mode minor-mode-alist))
-    (setq minor-mode-alist (append emerge-minor-modes-list
-				   minor-mode-alist)))
-
-;; We need to define this function so describe-mode can describe Emerge mode.
-(defun emerge-mode ()
-  "Emerge mode is used by the Emerge file-merging package.
-It is entered only through one of the functions:
-	`emerge-files'
-	`emerge-files-with-ancestor'
-	`emerge-buffers'
-	`emerge-buffers-with-ancestor'
-	`emerge-files-command'
-	`emerge-files-with-ancestor-command'
-	`emerge-files-remote'
-	`emerge-files-with-ancestor-remote'
-
-Commands:
-\\{emerge-basic-keymap}
-Commands must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode,
-but can be invoked directly in `fast' mode.")
-
-(defvar emerge-version "5fsf"
-  "The version of Emerge.")
-
-(defun emerge-version ()
-  "Return string describing the version of Emerge.
-When called interactively, displays the version."
-  (interactive)
-  (if (interactive-p)
-      (message "Emerge version %s" (emerge-version))
-    emerge-version))
-
-;;; Emerge configuration variables
-
-;; Commands that produce difference files
-;; All that can be configured is the name of the programs to execute
-;; (emerge-diff-program and emerge-diff3-program) and the options
-;; to be provided (emerge-diff-options).  The order in which the file names
-;; are given is fixed.
-;; The file names are always expanded (see expand-file-name) before being
-;; passed to diff, thus they need not be invoked under a shell that 
-;; understands `~'.
-;; The code which processes the diff/diff3 output depends on all the
-;; finicky details of their output, including the somewhat strange
-;; way they number lines of a file.
-(defvar emerge-diff-program "diff"
-  "*Name of the program which compares two files.")
-(defvar emerge-diff3-program "diff3"
-  "*Name of the program which compares three files.
-Its arguments are the ancestor file and the two variant files.")
-(defvar emerge-diff-options ""
-  "*Options to pass to `emerge-diff-program' and `emerge-diff3-program'.")
-(defvar emerge-match-diff-line (let ((x "\\([0-9]+\\)\\(\\|,\\([0-9]+\\)\\)"))
-				 (concat "^" x "\\([acd]\\)" x "$"))
-  "*Pattern to match lines produced by diff that describe differences.
-This is as opposed to lines from the source files.")
-(defvar emerge-diff-ok-lines-regexp
-  "^\\([0-9,]+[acd][0-9,]+$\\|[<>] \\|---\\)"
-  "*Regexp that matches normal output lines from `emerge-diff-program'.
-Lines that do not match are assumed to be error messages.")
-(defvar emerge-diff3-ok-lines-regexp
-  "^\\([1-3]:\\|====\\|  \\)"
-  "*Regexp that matches normal output lines from `emerge-diff3-program'.
-Lines that do not match are assumed to be error messages.")
-
-(defvar emerge-rcs-ci-program "ci"
-  "*Name of the program that checks in RCS revisions.")
-(defvar emerge-rcs-co-program "co"
-  "*Name of the program that checks out RCS revisions.")
-
-(defvar emerge-process-local-variables nil
-  "*Non-nil if Emerge should process local-variables lists in merge buffers.
-\(You can explicitly request processing the local-variables
-by executing `(hack-local-variables)'.)")
-(defvar emerge-execute-line-deletions nil
-  "*If non-nil: `emerge-execute-line' makes no output if an input was deleted.
-It concludes that an input version has been deleted when an ancestor entry
-is present, only one A or B entry is present, and an output entry is present.
-If nil: In such circumstances, the A or B file that is present will be
-copied to the designated output file.")
-
-(defvar emerge-before-flag "vvvvvvvvvvvvvvvvvvvv\n"
-  "*Flag placed above the highlighted block of code.  Must end with newline.
-Must be set before Emerge is loaded, or  emerge-new-flags  must be run
-after setting.")
-(defvar emerge-after-flag "^^^^^^^^^^^^^^^^^^^^\n"
-  "*Flag placed below the highlighted block of code.  Must end with newline.
-Must be set before Emerge is loaded, or  emerge-new-flags  must be run
-after setting.")
-
-;; Hook variables
-
-(defvar emerge-startup-hook nil
-  "*Hook to run in the merge buffer after the merge has been set up.")
-(defvar emerge-select-hook nil
-  "*Hook to run after a difference has been selected.
-The variable `n' holds the (internal) number of the difference.")
-(defvar emerge-unselect-hook nil
-  "*Hook to run after a difference has been unselected.
-The variable `n' holds the (internal) number of the difference.")
-
-;; Variables to control the default directories of the arguments to
-;; Emerge commands.
-
-(defvar emerge-default-last-directories nil
-  "*If nil, default dir for filenames in emerge is `default-directory'.
-If non-nil, filenames complete in the directory of the last argument of the
-same type to an `emerge-files...' command.")
-
-(defvar emerge-last-dir-A nil
-  "Last directory for the first file of an `emerge-files...' command.")
-(defvar emerge-last-dir-B nil
-  "Last directory for the second file of an `emerge-files...' command.")
-(defvar emerge-last-dir-ancestor nil
-  "Last directory for the ancestor file of an `emerge-files...' command.")
-(defvar emerge-last-dir-output nil
-  "Last directory for the output file of an `emerge-files...' command.")
-(defvar emerge-last-revision-A nil
-  "Last RCS revision used for first file of an `emerge-revisions...' command.")
-(defvar emerge-last-revision-B nil
-  "Last RCS revision used for second file of an `emerge-revisions...' command.")
-(defvar emerge-last-revision-ancestor nil
-  "Last RCS revision used for ancestor file of an `emerge-revisions...' command.")
-
-(defvar emerge-before-flag-length)
-(defvar emerge-before-flag-lines)
-(defvar emerge-before-flag-match)
-(defvar emerge-after-flag-length)
-(defvar emerge-after-flag-lines)
-(defvar emerge-after-flag-match)
-(defvar emerge-diff-buffer)
-(defvar emerge-diff-error-buffer)
-(defvar emerge-prefix-argument)
-(defvar emerge-file-out)
-(defvar emerge-exit-func)
-(defvar emerge-globalized-difference-list)
-(defvar emerge-globalized-number-of-differences)
-
-;; The flags used to mark differences in the buffers.
-
-;; These function definitions need to be up here, because they are used
-;; during loading.
-(defun emerge-new-flags ()
-  "Function to be called after `emerge-{before,after}-flag'.
-This is called after these functions are changed to compute values that
-depend on the flags."
-  (setq emerge-before-flag-length (length emerge-before-flag))
-  (setq emerge-before-flag-lines
-	(emerge-count-matches-string emerge-before-flag "\n"))
-  (setq emerge-before-flag-match (regexp-quote emerge-before-flag))
-  (setq emerge-after-flag-length (length emerge-after-flag))
-  (setq emerge-after-flag-lines
-	(emerge-count-matches-string emerge-after-flag "\n"))
-  (setq emerge-after-flag-match (regexp-quote emerge-after-flag)))
-
-(defun emerge-count-matches-string (string regexp)
-  "Return the number of matches in STRING for REGEXP."
-  (let ((i 0)
-	(count 0))
-    (while (string-match regexp string i)
-      (setq count (1+ count))
-      (setq i (match-end 0)))
-    count))
-
-;; Calculate dependent variables
-(emerge-new-flags)
-
-(defvar emerge-min-visible-lines 3
-  "*Number of lines that we want to show above and below the flags when we are
-displaying a difference.")
-
-(defvar emerge-temp-file-prefix
-  (let ((env (or (getenv "TMPDIR")
-		 (getenv "TMP")
-		 (getenv "TEMP")))
-	d)
-    (setq d (if (and env (> (length env) 0))
-		env
-	      "/tmp"))
-    (if (= (aref d (1- (length d))) ?/)
-	(setq d (substring d 0 -1)))
-    (concat d "/emerge"))
-  "*Prefix to put on Emerge temporary file names.
-Do not start with `~/' or `~user-name/'.")
-
-(defvar emerge-temp-file-mode 384	; u=rw only
-  "*Mode for Emerge temporary files.")
-
-(defvar emerge-combine-versions-template
-  "#ifdef NEW\n%b#else /* not NEW */\n%a#endif /* not NEW */\n"
-  "*Template for `emerge-combine-versions' to combine the two versions.
-The template is inserted as a string, with the following interpolations:
-	%a	the A version of the difference
-	%b	the B version of the difference
-	%%	the character `%'
-Don't forget to end the template with a newline.
-Note that this variable can be made local to a particular merge buffer by
-giving a prefix argument to `emerge-set-combine-versions-template'.")
-
-;; Build keymaps
-
-(defvar emerge-basic-keymap nil
-  "Keymap of Emerge commands.
-Directly available in `fast' mode;
-must be prefixed by \\<emerge-fast-keymap>\\[emerge-basic-keymap] in `edit' mode.")
-
-(defvar emerge-fast-keymap nil
-  "Local keymap used in Emerge `fast' mode.
-Makes Emerge commands directly available.")
-
-(defvar emerge-options-menu
-  (make-sparse-keymap "Options"))
-
-(defvar emerge-merge-menu
-  (make-sparse-keymap "Merge"))
-
-(defvar emerge-move-menu
-  (make-sparse-keymap "Move"))
-
-(defvar emerge-command-prefix "\C-c\C-c"
-  "*Command prefix for Emerge commands in `edit' mode.
-Must be set before Emerge is loaded.")
-
-;; This function sets up the fixed keymaps.  It is executed when the first
-;; Emerge is done to allow the user maximum time to set up the global keymap.
-(defun emerge-setup-fixed-keymaps ()
-  ;; Set up the basic keymap
-  (setq emerge-basic-keymap (make-keymap))
-  (suppress-keymap emerge-basic-keymap)	; this sets 0..9 to digit-argument and
-					; - to negative-argument
-  (define-key emerge-basic-keymap "p" 'emerge-previous-difference)
-  (define-key emerge-basic-keymap "n" 'emerge-next-difference)
-  (define-key emerge-basic-keymap "a" 'emerge-select-A)
-  (define-key emerge-basic-keymap "b" 'emerge-select-B)
-  (define-key emerge-basic-keymap "j" 'emerge-jump-to-difference)
-  (define-key emerge-basic-keymap "." 'emerge-find-difference)
-  (define-key emerge-basic-keymap "q" 'emerge-quit)
-  (define-key emerge-basic-keymap "\C-]" 'emerge-abort)
-  (define-key emerge-basic-keymap "f" 'emerge-fast-mode)
-  (define-key emerge-basic-keymap "e" 'emerge-edit-mode)
-  (define-key emerge-basic-keymap "s" nil)
-  (define-key emerge-basic-keymap "sa" 'emerge-auto-advance)
-  (define-key emerge-basic-keymap "ss" 'emerge-skip-prefers)
-  (define-key emerge-basic-keymap "l" 'emerge-recenter)
-  (define-key emerge-basic-keymap "d" nil)
-  (define-key emerge-basic-keymap "da" 'emerge-default-A)
-  (define-key emerge-basic-keymap "db" 'emerge-default-B)
-  (define-key emerge-basic-keymap "c" nil)
-  (define-key emerge-basic-keymap "ca" 'emerge-copy-as-kill-A)
-  (define-key emerge-basic-keymap "cb" 'emerge-copy-as-kill-B)
-  (define-key emerge-basic-keymap "i" nil)
-  (define-key emerge-basic-keymap "ia" 'emerge-insert-A)
-  (define-key emerge-basic-keymap "ib" 'emerge-insert-B)
-  (define-key emerge-basic-keymap "m" 'emerge-mark-difference)
-  (define-key emerge-basic-keymap "v" 'emerge-scroll-up)
-  (define-key emerge-basic-keymap "^" 'emerge-scroll-down)
-  (define-key emerge-basic-keymap "<" 'emerge-scroll-left)
-  (define-key emerge-basic-keymap ">" 'emerge-scroll-right)
-  (define-key emerge-basic-keymap "|" 'emerge-scroll-reset)
-  (define-key emerge-basic-keymap "x" nil)
-  (define-key emerge-basic-keymap "x1" 'emerge-one-line-window)
-  (define-key emerge-basic-keymap "xc" 'emerge-combine-versions)
-  (define-key emerge-basic-keymap "xC" 'emerge-combine-versions-register)
-  (define-key emerge-basic-keymap "xf" 'emerge-file-names)
-  (define-key emerge-basic-keymap "xj" 'emerge-join-differences)
-  (define-key emerge-basic-keymap "xl" 'emerge-line-numbers)
-  (define-key emerge-basic-keymap "xm" 'emerge-set-merge-mode)
-  (define-key emerge-basic-keymap "xs" 'emerge-split-difference)
-  (define-key emerge-basic-keymap "xt" 'emerge-trim-difference)
-  (define-key emerge-basic-keymap "xx" 'emerge-set-combine-versions-template)
-  ;; Allow emerge-basic-keymap to be referenced indirectly
-  (fset 'emerge-basic-keymap emerge-basic-keymap)
-  ;; Set up the fast mode keymap
-  (setq emerge-fast-keymap (copy-keymap emerge-basic-keymap))
-  ;; Allow prefixed commands to work in fast mode
-  (define-key emerge-fast-keymap emerge-command-prefix 'emerge-basic-keymap)
-  ;; Allow emerge-fast-keymap to be referenced indirectly
-  (fset 'emerge-fast-keymap emerge-fast-keymap)
-  ;; Suppress write-file and save-buffer
-  (substitute-key-definition 'write-file 'emerge-query-write-file
-			     emerge-fast-keymap (current-global-map))
-  (substitute-key-definition 'save-buffer 'emerge-query-save-buffer
-			     emerge-fast-keymap (current-global-map))
-
-  (define-key emerge-basic-keymap [menu-bar] (make-sparse-keymap))
-
-  (define-key emerge-fast-keymap [menu-bar options]
-    (cons "Options" emerge-options-menu))
-  (define-key emerge-fast-keymap [menu-bar merge]
-    (cons "Merge" emerge-merge-menu))
-  (define-key emerge-fast-keymap [menu-bar move]
-    (cons "Move" emerge-move-menu))
-
-  (define-key emerge-move-menu [emerge-scroll-reset]
-    '("Scroll Reset" . emerge-scroll-reset))
-  (define-key emerge-move-menu [emerge-scroll-right]
-    '("Scroll Right" . emerge-scroll-right))
-  (define-key emerge-move-menu [emerge-scroll-left]
-    '("Scroll Left" . emerge-scroll-left))
-  (define-key emerge-move-menu [emerge-scroll-down]
-    '("Scroll Down" . emerge-scroll-down))
-  (define-key emerge-move-menu [emerge-scroll-up]
-    '("Scroll Up" . emerge-scroll-up))
-  (define-key emerge-move-menu [emerge-recenter]
-    '("Recenter" . emerge-recenter))
-  (define-key emerge-move-menu [emerge-mark-difference]
-    '("Mark Difference" . emerge-mark-difference))
-  (define-key emerge-move-menu [emerge-jump-to-difference]
-    '("Jump To Difference" . emerge-jump-to-difference))
-  (define-key emerge-move-menu [emerge-find-difference]
-    '("Find Difference" . emerge-find-difference))
-  (define-key emerge-move-menu [emerge-previous-difference]
-    '("Previous Difference" . emerge-previous-difference))
-  (define-key emerge-move-menu [emerge-next-difference]
-    '("Next Difference" . emerge-next-difference))
-
-
-  (define-key emerge-options-menu [emerge-one-line-window]
-    '("One Line Window" . emerge-one-line-window))
-  (define-key emerge-options-menu [emerge-set-merge-mode]
-    '("Set Merge Mode" . emerge-set-merge-mode))
-  (define-key emerge-options-menu [emerge-set-combine-template]
-    '("Set Combine Template..." . emerge-set-combine-template))
-  (define-key emerge-options-menu [emerge-default-B]
-    '("Default B" . emerge-default-B))
-  (define-key emerge-options-menu [emerge-default-A]
-    '("Default A" . emerge-default-A))
-  (define-key emerge-options-menu [emerge-skip-prefers]
-    '("Skip Prefers" . emerge-skip-prefers))
-  (define-key emerge-options-menu [emerge-auto-advance]
-    '("Auto Advance" . emerge-auto-advance))
-  (define-key emerge-options-menu [emerge-edit-mode]
-    '("Edit Mode" . emerge-edit-mode))
-  (define-key emerge-options-menu [emerge-fast-mode]
-    '("Fast Mode" . emerge-fast-mode))
-
-  (define-key emerge-merge-menu [emerge-abort] '("Abort" . emerge-abort))
-  (define-key emerge-merge-menu [emerge-quit] '("Quit" . emerge-quit))
-  (define-key emerge-merge-menu [emerge-split-difference]
-    '("Split Difference" . emerge-split-difference))
-  (define-key emerge-merge-menu [emerge-join-differences]
-    '("Join Differences" . emerge-join-differences))
-  (define-key emerge-merge-menu [emerge-trim-difference]
-    '("Trim Difference" . emerge-trim-difference))
-  (define-key emerge-merge-menu [emerge-combine-versions]
-    '("Combine Versions" . emerge-combine-versions))
-  (define-key emerge-merge-menu [emerge-copy-as-kill-B]
-    '("Copy B as Kill" . emerge-copy-as-kill-B))
-  (define-key emerge-merge-menu [emerge-copy-as-kill-A]
-    '("Copy A as Kill" . emerge-copy-as-kill-A))
-  (define-key emerge-merge-menu [emerge-insert-B]
-    '("Insert B" . emerge-insert-B))
-  (define-key emerge-merge-menu [emerge-insert-A]
-    '("Insert A" . emerge-insert-A))
-  (define-key emerge-merge-menu [emerge-select-B]
-    '("Select B" . emerge-select-B))
-  (define-key emerge-merge-menu [emerge-select-A]
-    '("Select A" . emerge-select-A)))
-
-
-;; Variables which control each merge.  They are local to the merge buffer.
-
-;; Mode variables
-(emerge-defvar-local emerge-mode nil
-  "Indicator for emerge-mode.")
-(emerge-defvar-local emerge-fast-mode nil
-  "Indicator for emerge-mode fast submode.")
-(emerge-defvar-local emerge-edit-mode nil
-  "Indicator for emerge-mode edit submode.")
-(emerge-defvar-local emerge-A-buffer nil
-  "The buffer in which the A variant is stored.")
-(emerge-defvar-local emerge-B-buffer nil
-  "The buffer in which the B variant is stored.")
-(emerge-defvar-local emerge-merge-buffer nil
-  "The buffer in which the merged file is manipulated.")
-(emerge-defvar-local emerge-ancestor-buffer nil
-  "The buffer in which the ancestor variant is stored,
-or nil if there is none.")
-
-(defconst emerge-saved-variables
-  '((buffer-modified-p set-buffer-modified-p)
-    buffer-read-only
-    buffer-auto-save-file-name)
-  "Variables and properties of a buffer which are saved, modified and restored
-during a merge.")
-(defconst emerge-merging-values '(nil t nil)
-  "Values to be assigned to emerge-saved-variables during a merge.")
-
-(emerge-defvar-local emerge-A-buffer-values nil
-  "Remembers emerge-saved-variables for emerge-A-buffer.")
-(emerge-defvar-local emerge-B-buffer-values nil
-  "Remembers emerge-saved-variables for emerge-B-buffer.")
-
-(emerge-defvar-local emerge-difference-list nil
-  "Vector of differences between the variants, and markers in the buffers to
-show where they are.  Each difference is represented by a vector of seven
-elements.  The first two are markers to the beginning and end of the difference
-section in the A buffer, the second two are markers for the B buffer, the third
-two are markers for the merge buffer, and the last element is the \"state\" of
-that difference in the merge buffer.
-  A section of a buffer is described by two markers, one to the beginning of
-the first line of the section, and one to the beginning of the first line
-after the section.  (If the section is empty, both markers point to the same
-point.)  If the section is part of the selected difference, then the markers
-are moved into the flags, so the user can edit the section without disturbing
-the markers.
-  The \"states\" are:
-	A		the merge buffer currently contains the A variant
-	B		the merge buffer currently contains the B variant
-	default-A	the merge buffer contains the A variant by default,
-			but this difference hasn't been selected yet, so
-			change-default commands can alter it
-	default-B	the merge buffer contains the B variant by default,
-			but this difference hasn't been selected yet, so
-			change-default commands can alter it
-	prefer-A	in a three-file merge, the A variant is the preferred
-			choice
-	prefer-B	in a three-file merge, the B variant is the preferred
-			choice")
-(emerge-defvar-local emerge-current-difference -1
-  "The difference that is currently selected.")
-(emerge-defvar-local emerge-number-of-differences nil
-  "Number of differences found.")
-(emerge-defvar-local emerge-edit-keymap nil
-  "The local keymap for the merge buffer, with the emerge commands defined in
-it.  Used to save the local keymap during fast mode, when the local keymap is
-replaced by emerge-fast-keymap.")
-(emerge-defvar-local emerge-old-keymap nil
-  "The original local keymap for the merge buffer.")
-(emerge-defvar-local emerge-auto-advance nil
-  "*If non-nil, emerge-select-A and emerge-select-B automatically advance to
-the next difference.")
-(emerge-defvar-local emerge-skip-prefers nil
-  "*If non-nil, differences for which there is a preference are automatically
-skipped.")
-(emerge-defvar-local emerge-quit-hook nil
-  "Hooks to run in the merge buffer after the merge has been finished.
-`emerge-prefix-argument' will hold the prefix argument of the `emerge-quit'
-command.
-This is *not* a user option, since Emerge uses it for its own processing.")
-(emerge-defvar-local emerge-output-description nil
-  "Describes output destination of emerge, for `emerge-file-names'.")
-
-;;; Setup functions for two-file mode.
-
-(defun emerge-files-internal (file-A file-B &optional startup-hooks quit-hooks
-				     output-file)
-  (if (not (file-readable-p file-A))
-      (error "File `%s' does not exist or is not readable" file-A))
-  (if (not (file-readable-p file-B))
-      (error "File `%s' does not exist or is not readable" file-B))
-  (let ((buffer-A (find-file-noselect file-A))
-	(buffer-B (find-file-noselect file-B)))
-    ;; Record the directories of the files
-    (setq emerge-last-dir-A (file-name-directory file-A))
-    (setq emerge-last-dir-B (file-name-directory file-B))
-    (if output-file
-	(setq emerge-last-dir-output (file-name-directory output-file)))
-    ;; Make sure the entire files are seen, and they reflect what is on disk
-    (emerge-eval-in-buffer 
-     buffer-A
-     (widen)
-     (let ((temp (file-local-copy file-A)))
-       (if temp
-	   (setq file-A temp
-		 startup-hooks
-		 (cons (` (lambda () (delete-file (, file-A))))
-		       startup-hooks))
-	 ;; Verify that the file matches the buffer
-	 (emerge-verify-file-buffer))))
-    (emerge-eval-in-buffer
-     buffer-B
-     (widen)
-     (let ((temp (file-local-copy file-B)))
-       (if temp
-	   (setq file-B temp
-		 startup-hooks
-		 (cons (` (lambda () (delete-file (, file-B))))
-		       startup-hooks))
-	 ;; Verify that the file matches the buffer
-	 (emerge-verify-file-buffer))))
-    (emerge-setup buffer-A file-A buffer-B file-B startup-hooks quit-hooks
-		  output-file)))
-
-;; Start up Emerge on two files
-(defun emerge-setup (buffer-A file-A buffer-B file-B startup-hooks quit-hooks
-			      output-file)
-  (setq file-A (expand-file-name file-A))
-  (setq file-B (expand-file-name file-B))
-  (setq output-file (and output-file (expand-file-name output-file)))
-  (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*"))
-	 ;; create the merge buffer from buffer A, so it inherits buffer A's
-	 ;; default directory, etc.
-	 (merge-buffer (emerge-eval-in-buffer
-			buffer-A
-			(get-buffer-create merge-buffer-name))))
-    (emerge-eval-in-buffer
-     merge-buffer
-     (emerge-copy-modes buffer-A)
-     (setq buffer-read-only nil)
-     (auto-save-mode 1)
-     (setq emerge-mode t)
-     (setq emerge-A-buffer buffer-A)
-     (setq emerge-B-buffer buffer-B)
-     (setq emerge-ancestor-buffer nil)
-     (setq emerge-merge-buffer merge-buffer)
-     (setq emerge-output-description
-	   (if output-file
-	       (concat "Output to file: " output-file)
-	     (concat "Output to buffer: " (buffer-name merge-buffer))))
-     (insert-buffer emerge-A-buffer)
-     (emerge-set-keys)
-     (setq emerge-difference-list (emerge-make-diff-list file-A file-B))
-     (setq emerge-number-of-differences (length emerge-difference-list))
-     (setq emerge-current-difference -1)
-     (setq emerge-quit-hook quit-hooks)
-     (emerge-remember-buffer-characteristics)
-     (emerge-handle-local-variables))
-    (emerge-setup-windows buffer-A buffer-B merge-buffer t)
-    (emerge-eval-in-buffer merge-buffer
-			   (run-hooks 'startup-hooks 'emerge-startup-hook)
-			   (setq buffer-read-only t))))
-
-;; Generate the Emerge difference list between two files
-(defun emerge-make-diff-list (file-A file-B)
-  (setq emerge-diff-buffer (get-buffer-create "*emerge-diff*"))
-  (emerge-eval-in-buffer
-   emerge-diff-buffer
-   (erase-buffer)
-   (shell-command
-    (format "%s %s %s %s"
-	    emerge-diff-program emerge-diff-options
-	    (emerge-protect-metachars file-A)
-	    (emerge-protect-metachars file-B))
-    t))
-  (emerge-prepare-error-list emerge-diff-ok-lines-regexp)
-  (emerge-convert-diffs-to-markers
-   emerge-A-buffer emerge-B-buffer emerge-merge-buffer
-   (emerge-extract-diffs emerge-diff-buffer)))
-
-(defun emerge-extract-diffs (diff-buffer)
-  (let (list)
-    (emerge-eval-in-buffer
-     diff-buffer
-     (goto-char (point-min))
-     (while (re-search-forward emerge-match-diff-line nil t)
-       (let* ((a-begin (string-to-int (buffer-substring (match-beginning 1)
-							(match-end 1))))
-	      (a-end  (let ((b (match-beginning 3))
-			    (e (match-end 3)))
-			(if b
-			    (string-to-int (buffer-substring b e))
-			  a-begin)))
-	      (diff-type (buffer-substring (match-beginning 4) (match-end 4)))
-	      (b-begin (string-to-int (buffer-substring (match-beginning 5)
-							(match-end 5))))
-	      (b-end (let ((b (match-beginning 7))
-			   (e (match-end 7)))
-		       (if b
-			   (string-to-int (buffer-substring b e))
-			 b-begin))))
-	 ;; fix the beginning and end numbers, because diff is somewhat
-	 ;; strange about how it numbers lines
-	 (if (string-equal diff-type "a")
-	     (progn
-	       (setq b-end (1+ b-end))
-	       (setq a-begin (1+ a-begin))
-	       (setq a-end a-begin))
-	   (if (string-equal diff-type "d")
-	       (progn
-		 (setq a-end (1+ a-end))
-		 (setq b-begin (1+ b-begin))
-		 (setq b-end b-begin))
-	     ;; (string-equal diff-type "c")
-	     (progn
-	       (setq a-end (1+ a-end))
-	       (setq b-end (1+ b-end)))))
-	 (setq list (cons (vector a-begin a-end
-				  b-begin b-end
-				  'default-A)
-			  list)))))
-    (nreverse list)))
-
-;; Set up buffer of diff/diff3 error messages.
-(defun emerge-prepare-error-list (ok-regexp)
-  (setq emerge-diff-error-buffer (get-buffer-create "*emerge-diff-errors*"))
-  (emerge-eval-in-buffer
-   emerge-diff-error-buffer
-   (erase-buffer)
-   (insert-buffer emerge-diff-buffer)
-   (delete-matching-lines ok-regexp)))
-
-;;; Top-level and setup functions for three-file mode.
-
-(defun emerge-files-with-ancestor-internal (file-A file-B file-ancestor
-					    &optional startup-hooks quit-hooks
-					    output-file)
-  (if (not (file-readable-p file-A))
-      (error "File `%s' does not exist or is not readable" file-A))
-  (if (not (file-readable-p file-B))
-      (error "File `%s' does not exist or is not readable" file-B))
-  (if (not (file-readable-p file-ancestor))
-      (error "File `%s' does not exist or is not readable" file-ancestor))
-  (let ((buffer-A (find-file-noselect file-A))
-	(buffer-B (find-file-noselect file-B))
-	(buffer-ancestor (find-file-noselect file-ancestor)))
-    ;; Record the directories of the files
-    (setq emerge-last-dir-A (file-name-directory file-A))
-    (setq emerge-last-dir-B (file-name-directory file-B))
-    (setq emerge-last-dir-ancestor (file-name-directory file-ancestor))
-    (if output-file
-	(setq emerge-last-dir-output (file-name-directory output-file)))
-    ;; Make sure the entire files are seen, and they reflect what is on disk
-    (emerge-eval-in-buffer
-     buffer-A
-     (widen)
-     (let ((temp (file-local-copy file-A)))
-       (if temp
-	   (setq file-A temp
-		 startup-hooks
-		 (cons (` (lambda () (delete-file (, file-A))))
-		       startup-hooks))
-	 ;; Verify that the file matches the buffer
-	 (emerge-verify-file-buffer))))
-    (emerge-eval-in-buffer
-     buffer-B
-     (widen)
-     (let ((temp (file-local-copy file-B)))
-       (if temp
-	   (setq file-B temp
-		 startup-hooks
-		 (cons (` (lambda () (delete-file (, file-B))))
-		       startup-hooks))
-	 ;; Verify that the file matches the buffer
-	 (emerge-verify-file-buffer))))
-    (emerge-eval-in-buffer
-     buffer-ancestor
-     (widen)
-     (let ((temp (file-local-copy file-ancestor)))
-       (if temp
-	   (setq file-ancestor temp
-		 startup-hooks
-		 (cons (` (lambda () (delete-file (, file-ancestor))))
-		       startup-hooks))
-	 ;; Verify that the file matches the buffer
-	 (emerge-verify-file-buffer))))
-    (emerge-setup-with-ancestor buffer-A file-A buffer-B file-B
-				buffer-ancestor file-ancestor
-				startup-hooks quit-hooks output-file)))
-
-;; Start up Emerge on two files with an ancestor
-(defun emerge-setup-with-ancestor (buffer-A file-A buffer-B file-B
-					    buffer-ancestor file-ancestor
-					    &optional startup-hooks quit-hooks
-					    output-file)
-  (setq file-A (expand-file-name file-A))
-  (setq file-B (expand-file-name file-B))
-  (setq file-ancestor (expand-file-name file-ancestor))
-  (setq output-file (and output-file (expand-file-name output-file)))
-  (let* ((merge-buffer-name (emerge-unique-buffer-name "*merge" "*"))
-	 ;; create the merge buffer from buffer A, so it inherits buffer A's
-	 ;; default directory, etc.
-	 (merge-buffer (emerge-eval-in-buffer
-			buffer-A
-			(get-buffer-create merge-buffer-name))))
-    (emerge-eval-in-buffer
-     merge-buffer
-     (emerge-copy-modes buffer-A)
-     (setq buffer-read-only nil)
-     (auto-save-mode 1)
-     (setq emerge-mode t)
-     (setq emerge-A-buffer buffer-A)
-     (setq emerge-B-buffer buffer-B)
-     (setq emerge-ancestor-buffer buffer-ancestor)
-     (setq emerge-merge-buffer merge-buffer)
-     (setq emerge-output-description
-	   (if output-file
-	       (concat "Output to file: " output-file)
-	     (concat "Output to buffer: " (buffer-name merge-buffer))))
-     (insert-buffer emerge-A-buffer)
-     (emerge-set-keys)
-     (setq emerge-difference-list
-	   (emerge-make-diff3-list file-A file-B file-ancestor))
-     (setq emerge-number-of-differences (length emerge-difference-list))
-     (setq emerge-current-difference -1)
-     (setq emerge-quit-hook quit-hooks)
-     (emerge-remember-buffer-characteristics)
-     (emerge-select-prefer-Bs)
-     (emerge-handle-local-variables))
-    (emerge-setup-windows buffer-A buffer-B merge-buffer t)
-    (emerge-eval-in-buffer merge-buffer
-			   (run-hooks 'startup-hooks 'emerge-startup-hook)
-			   (setq buffer-read-only t))))
-
-;; Generate the Emerge difference list between two files with an ancestor
-(defun emerge-make-diff3-list (file-A file-B file-ancestor)
-  (setq emerge-diff-buffer (get-buffer-create "*emerge-diff*"))
-  (emerge-eval-in-buffer
-   emerge-diff-buffer
-   (erase-buffer)
-   (shell-command
-    (format "%s %s %s %s %s"
-	    emerge-diff3-program emerge-diff-options
-	    (emerge-protect-metachars file-A)
-	    (emerge-protect-metachars file-ancestor)
-	    (emerge-protect-metachars file-B))
-    t))
-  (emerge-prepare-error-list emerge-diff3-ok-lines-regexp)
-  (emerge-convert-diffs-to-markers
-   emerge-A-buffer emerge-B-buffer emerge-merge-buffer
-   (emerge-extract-diffs3 emerge-diff-buffer)))
-
-(defun emerge-extract-diffs3 (diff-buffer)
-  (let (list)
-    (emerge-eval-in-buffer
-     diff-buffer
-     (while (re-search-forward "^====\\(.?\\)$" nil t)
-       ;; leave point after matched line
-       (beginning-of-line 2)
-       (let ((agreement (buffer-substring (match-beginning 1) (match-end 1))))
-	 ;; if the A and B files are the same, ignore the difference
-	 (if (not (string-equal agreement "2"))
-	     (setq list
-		   (cons 
-		    (let (group-1 group-3 pos)
-		      (setq pos (point))
-		      (setq group-1 (emerge-get-diff3-group "1"))
-		      (goto-char pos)
-		      (setq group-3 (emerge-get-diff3-group "3"))
-		      (vector (car group-1) (car (cdr group-1))
-			      (car group-3) (car (cdr group-3))
-			      (cond ((string-equal agreement "1") 'prefer-A)
-				    ((string-equal agreement "3") 'prefer-B)
-				    (t 'default-A))))
-		    list))))))
-    (nreverse list)))
-
-(defun emerge-get-diff3-group (file)
-  ;; This save-excursion allows emerge-get-diff3-group to be called for the
-  ;; various groups of lines (1, 2, 3) in any order, and for the lines to
-  ;; appear in any order.  The reason this is necessary is that Gnu diff3
-  ;; can produce the groups in the order 1, 2, 3 or 1, 3, 2.
-  (save-excursion
-    (re-search-forward
-     (concat "^" file ":\\([0-9]+\\)\\(,\\([0-9]+\\)\\)?\\([ac]\\)$"))
-    (beginning-of-line 2)
-    ;; treatment depends on whether it is an "a" group or a "c" group
-    (if (string-equal (buffer-substring (match-beginning 4) (match-end 4)) "c")
-	;; it is a "c" group
-	(if (match-beginning 2)
-	    ;; it has two numbers
-	    (list (string-to-int
-		   (buffer-substring (match-beginning 1) (match-end 1)))
-		  (1+ (string-to-int
-		       (buffer-substring (match-beginning 3) (match-end 3)))))
-	  ;; it has one number
-	  (let ((x (string-to-int
-		    (buffer-substring (match-beginning 1) (match-end 1)))))
-	    (list x (1+ x))))
-      ;; it is an "a" group
-      (let ((x (1+ (string-to-int
-		    (buffer-substring (match-beginning 1) (match-end 1))))))
-	(list x x)))))
-
-;;; Functions to start Emerge on files
-
-;;;###autoload
-(defun emerge-files (arg file-A file-B file-out &optional startup-hooks
-		     quit-hooks)
-  "Run Emerge on two files."
-  (interactive
-   (let (f)
-     (list current-prefix-arg
-	   (setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A
-					  nil nil t))
-	   (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f t)
-	   (and current-prefix-arg
-		(emerge-read-file-name "Output file" emerge-last-dir-output
-				       f f nil)))))
-  (if file-out
-      (add-hook 'quit-hooks (` (lambda () (emerge-files-exit (, file-out))))))
-  (emerge-files-internal
-   file-A file-B startup-hooks
-   quit-hooks
-   file-out))
-
-;;;###autoload
-(defun emerge-files-with-ancestor (arg file-A file-B file-ancestor file-out
-				   &optional startup-hooks quit-hooks)
-  "Run Emerge on two files, giving another file as the ancestor."
-  (interactive
-   (let (f)
-     (list current-prefix-arg
-	   (setq f (emerge-read-file-name "File A to merge" emerge-last-dir-A
-					  nil nil t))
-	   (emerge-read-file-name "File B to merge" emerge-last-dir-B nil f t)
-	   (emerge-read-file-name "Ancestor file" emerge-last-dir-ancestor
-				  nil f t)
-	   (and current-prefix-arg
-		(emerge-read-file-name "Output file" emerge-last-dir-output
-				       f f nil)))))
-  (if file-out
-      (add-hook 'quit-hooks (` (lambda () (emerge-files-exit (, file-out))))))
-  (emerge-files-with-ancestor-internal
-   file-A file-B file-ancestor startup-hooks
-   quit-hooks
-   file-out))
-
-;; Write the merge buffer out in place of the file the A buffer is visiting.
-(defun emerge-files-exit (file-out)
-  ;; if merge was successful was given, save to disk
-  (if (not emerge-prefix-argument)
-      (emerge-write-and-delete file-out)))
-
-;;; Functions to start Emerge on buffers
-
-;;;###autoload
-(defun emerge-buffers (buffer-A buffer-B &optional startup-hooks quit-hooks)
-  "Run Emerge on two buffers."
-  (interactive "bBuffer A to merge: \nbBuffer B to merge: ")
-  (let ((emerge-file-A (emerge-make-temp-file "A"))
-	(emerge-file-B (emerge-make-temp-file "B")))
-    (emerge-eval-in-buffer
-     buffer-A
-     (write-region (point-min) (point-max) emerge-file-A nil 'no-message))
-    (emerge-eval-in-buffer
-     buffer-B
-     (write-region (point-min) (point-max) emerge-file-B nil 'no-message))
-    (emerge-setup (get-buffer buffer-A) emerge-file-A
-		  (get-buffer buffer-B) emerge-file-B
-		  (cons (` (lambda ()
-			     (delete-file (, emerge-file-A))
-			     (delete-file (, emerge-file-B))))
-			startup-hooks)
-		  quit-hooks
-		  nil)))
-
-;;;###autoload
-(defun emerge-buffers-with-ancestor (buffer-A buffer-B buffer-ancestor
-					      &optional startup-hooks
-					      quit-hooks)
-  "Run Emerge on two buffers, giving another buffer as the ancestor."
-  (interactive
-   "bBuffer A to merge: \nbBuffer B to merge: \nbAncestor buffer: ")
-  (let ((emerge-file-A (emerge-make-temp-file "A"))
-	(emerge-file-B (emerge-make-temp-file "B"))
-	(emerge-file-ancestor (emerge-make-temp-file "anc")))
-    (emerge-eval-in-buffer
-     buffer-A
-     (write-region (point-min) (point-max) emerge-file-A nil 'no-message))
-    (emerge-eval-in-buffer
-     buffer-B
-     (write-region (point-min) (point-max) emerge-file-B nil 'no-message))
-    (emerge-eval-in-buffer
-     buffer-ancestor
-     (write-region (point-min) (point-max) emerge-file-ancestor nil
-		   'no-message))
-    (emerge-setup-with-ancestor (get-buffer buffer-A) emerge-file-A
-				(get-buffer buffer-B) emerge-file-B
-				(get-buffer buffer-ancestor)
-				emerge-file-ancestor
-				(cons (` (lambda ()
-					   (delete-file (, emerge-file-A))
-					   (delete-file (, emerge-file-B))
-					   (delete-file
-					    (, emerge-file-ancestor))))
-				      startup-hooks)
-				quit-hooks
-				nil)))
-
-;;; Functions to start Emerge from the command line
-
-;;;###autoload
-(defun emerge-files-command ()
-  (let ((file-a (nth 0 command-line-args-left))
-	(file-b (nth 1 command-line-args-left))
-	(file-out (nth 2 command-line-args-left)))
-    (setq command-line-args-left (nthcdr 3 command-line-args-left))
-    (emerge-files-internal
-     file-a file-b nil
-     (list (` (lambda () (emerge-command-exit (, file-out))))))))
-
-;;;###autoload
-(defun emerge-files-with-ancestor-command ()
-  (let (file-a file-b file-anc file-out)
-    ;; check for a -a flag, for filemerge compatibility
-    (if (string= (car command-line-args-left) "-a")
-	;; arguments are "-a ancestor file-a file-b file-out"
-	(progn
-	  (setq file-a (nth 2 command-line-args-left))
-	  (setq file-b (nth 3 command-line-args-left))
-	  (setq file-anc (nth 1 command-line-args-left))
-	  (setq file-out (nth 4 command-line-args-left))
-	  (setq command-line-args-left (nthcdr 5 command-line-args-left)))
-      ;; arguments are "file-a file-b ancestor file-out"
-      (setq file-a (nth 0 command-line-args-left))
-      (setq file-b (nth 1 command-line-args-left))
-      (setq file-anc (nth 2 command-line-args-left))
-      (setq file-out (nth 3 command-line-args-left))
-      (setq command-line-args-left (nthcdr 4 command-line-args-left)))
-    (emerge-files-with-ancestor-internal
-     file-a file-b file-anc nil
-     (list (` (lambda () (emerge-command-exit (, file-out))))))))
-      
-(defun emerge-command-exit (file-out)
-  (emerge-write-and-delete file-out)
-  (kill-emacs (if emerge-prefix-argument 1 0)))
-
-;;; Functions to start Emerge via remote request
-
-;;;###autoload
-(defun emerge-files-remote (file-a file-b file-out)
-  (setq emerge-file-out file-out)
-  (emerge-files-internal
-   file-a file-b nil
-   (list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func)))))
-   file-out)
-  (throw 'client-wait nil))
-
-;;;###autoload
-(defun emerge-files-with-ancestor-remote (file-a file-b file-anc file-out)
-  (setq emerge-file-out file-out)
-  (emerge-files-with-ancestor-internal
-   file-a file-b file-anc nil
-   (list (` (lambda () (emerge-remote-exit (, file-out) '(, emerge-exit-func)))))
-   file-out)
-  (throw 'client-wait nil))
-
-(defun emerge-remote-exit (file-out emerge-exit-func)
-  (emerge-write-and-delete file-out)
-  (kill-buffer emerge-merge-buffer)
-  (funcall emerge-exit-func (if emerge-prefix-argument 1 0)))
-
-;;; Functions to start Emerge on RCS versions
-
-;;;###autoload
-(defun emerge-revisions (arg file revision-A revision-B
-			 &optional startup-hooks quit-hooks)
-  "Emerge two RCS revisions of a file."
-  (interactive
-   (list current-prefix-arg
-	 (read-file-name "File to merge: " nil nil 'confirm)
-	 (read-string "Revision A to merge: " emerge-last-revision-A)
-	 (read-string "Revision B to merge: " emerge-last-revision-B)))
-  (setq emerge-last-revision-A revision-A
-	emerge-last-revision-B revision-B)
-  (emerge-revisions-internal
-   file revision-A revision-B startup-hooks
-   (if arg
-       (cons (` (lambda ()
-		  (shell-command
-		   (, (format "%s %s" emerge-rcs-ci-program file)))))
-	     quit-hooks)
-     quit-hooks)))
-
-;;;###autoload
-(defun emerge-revisions-with-ancestor (arg file revision-A
-					   revision-B ancestor
-					   &optional
-					   startup-hooks quit-hooks)
-  "Emerge two RCS revisions of a file, with another revision as ancestor."
-  (interactive
-   (list current-prefix-arg
-	 (read-file-name "File to merge: " nil nil 'confirm)
-	 (read-string "Revision A to merge: " emerge-last-revision-A)
-	 (read-string "Revision B to merge: " emerge-last-revision-B)
-	 (read-string "Ancestor: " emerge-last-revision-ancestor)))
-  (setq emerge-last-revision-A revision-A
-	emerge-last-revision-B revision-B
-	emerge-last-revision-ancestor ancestor)
-  (emerge-revision-with-ancestor-internal
-   file revision-A revision-B ancestor startup-hooks
-   (if arg
-       (let ((cmd ))
-	 (cons (` (lambda ()
-		    (shell-command
-		     (, (format "%s %s" emerge-rcs-ci-program file)))))
-	       quit-hooks))
-     quit-hooks)))
-
-(defun emerge-revisions-internal (file revision-A revision-B &optional
-				      startup-hooks quit-hooks output-file)
-  (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A)))
-	(buffer-B (get-buffer-create (format "%s,%s" file revision-B)))
-	(emerge-file-A (emerge-make-temp-file "A"))
-	(emerge-file-B (emerge-make-temp-file "B")))
-    ;; Get the revisions into buffers
-    (emerge-eval-in-buffer
-     buffer-A
-     (erase-buffer)
-     (shell-command
-      (format "%s -q -p%s %s" emerge-rcs-co-program revision-A file)
-      t)
-     (write-region (point-min) (point-max) emerge-file-A nil 'no-message)
-     (set-buffer-modified-p nil))
-    (emerge-eval-in-buffer
-     buffer-B
-     (erase-buffer)
-     (shell-command
-      (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file)
-      t)
-     (write-region (point-min) (point-max) emerge-file-B nil 'no-message)
-     (set-buffer-modified-p nil))
-    ;; Do the merge
-    (emerge-setup buffer-A emerge-file-A
-		  buffer-B emerge-file-B
-		  (cons (` (lambda ()
-			     (delete-file (, emerge-file-A))
-			     (delete-file (, emerge-file-B))))
-			startup-hooks)
-		  (cons (` (lambda () (emerge-files-exit (, file))))
-			quit-hooks)
-		  nil)))
-
-(defun emerge-revision-with-ancestor-internal (file revision-A revision-B
-						    ancestor
-						    &optional startup-hooks
-						    quit-hooks output-file)
-  (let ((buffer-A (get-buffer-create (format "%s,%s" file revision-A)))
-	(buffer-B (get-buffer-create (format "%s,%s" file revision-B)))
-	(buffer-ancestor (get-buffer-create (format "%s,%s" file ancestor)))
-	(emerge-file-A (emerge-make-temp-file "A"))
-	(emerge-file-B (emerge-make-temp-file "B"))
-	(emerge-ancestor (emerge-make-temp-file "ancestor")))
-    ;; Get the revisions into buffers
-    (emerge-eval-in-buffer
-     buffer-A
-     (erase-buffer)
-     (shell-command
-      (format "%s -q -p%s %s" emerge-rcs-co-program
-	      revision-A file)
-      t)
-     (write-region (point-min) (point-max) emerge-file-A nil 'no-message)
-     (set-buffer-modified-p nil))
-    (emerge-eval-in-buffer
-     buffer-B
-     (erase-buffer)
-     (shell-command
-      (format "%s -q -p%s %s" emerge-rcs-co-program revision-B file)
-      t)
-     (write-region (point-min) (point-max) emerge-file-B nil 'no-message)
-     (set-buffer-modified-p nil))
-    (emerge-eval-in-buffer
-     buffer-ancestor
-     (erase-buffer)
-     (shell-command
-      (format "%s -q -p%s %s" emerge-rcs-co-program ancestor file)
-      t)
-     (write-region (point-min) (point-max) emerge-ancestor nil 'no-message)
-     (set-buffer-modified-p nil))
-    ;; Do the merge
-    (emerge-setup-with-ancestor
-     buffer-A emerge-file-A buffer-B emerge-file-B
-     buffer-ancestor emerge-ancestor
-     (cons (` (lambda ()
-		(delete-file (, emerge-file-A))
-		(delete-file (, emerge-file-B))
-		(delete-file (, emerge-ancestor))))
-	   startup-hooks)
-     (cons (` (lambda () (emerge-files-exit (, file))))
-	   quit-hooks)
-     output-file)))
-
-;;; Function to start Emerge based on a line in a file
-
-(defun emerge-execute-line ()
-  "Run Emerge using files named in current text line.
-Looks in that line for whitespace-separated entries of these forms:
-	a=file1
-	b=file2
-	ancestor=file3
-	output=file4
-to specify the files to use in Emerge.
-
-In addition, if only one of `a=file' or `b=file' is present, and `output=file'
-is present:
-If `emerge-execute-line-deletions' is non-nil and `ancestor=file' is present,
-it is assumed that the file in question has been deleted, and it is
-not copied to the output file.
-Otherwise, the A or B file present is copied to the output file."
-  (interactive)
-  (let (file-A file-B file-ancestor file-out
-	       (case-fold-search t))
-    ;; Stop if at end of buffer (even though we might be in a line, if
-    ;; the line does not end with newline)
-    (if (eobp)
-	(error "At end of buffer"))
-    ;; Go to the beginning of the line
-    (beginning-of-line)
-    ;; Skip any initial whitespace
-    (if (looking-at "[ \t]*")
-	(goto-char (match-end 0)))
-    ;; Process the entire line
-    (while (not (eolp))
-      ;; Get the next entry
-      (if (looking-at "\\([a-z]+\\)=\\([^ \t\n]+\\)[ \t]*")
-	  ;; Break apart the tab (before =) and the filename (after =)
-	  (let ((tag (downcase
-		      (buffer-substring (match-beginning 1) (match-end 1))))
-		(file (buffer-substring (match-beginning 2) (match-end 2))))
-	    ;; Move point after the entry
-	    (goto-char (match-end 0))
-	    ;; Store the filename in the right variable
-	    (cond
-	     ((string-equal tag "a")
-	      (if file-A
-		  (error "This line has two `A' entries"))
-	      (setq file-A file))
-	     ((string-equal tag "b")
-	      (if file-B
-		  (error "This line has two `B' entries"))
-	      (setq file-B file))
-	     ((or (string-equal tag "anc") (string-equal tag "ancestor"))
-	      (if file-ancestor
-		  (error "This line has two `ancestor' entries"))
-	      (setq file-ancestor file))
-	     ((or (string-equal tag "out") (string-equal tag "output"))
-	      (if file-out
-		  (error "This line has two `output' entries"))
-	      (setq file-out file))
-	     (t
-	      (error "Unrecognized entry"))))
-	;; If the match on the entry pattern failed
-	(error "Unparsable entry")))
-    ;; Make sure that file-A and file-B are present
-    (if (not (or (and file-A file-B) file-out))
-	(error "Must have both `A' and `B' entries"))
-    (if (not (or file-A file-B))
-	(error "Must have `A' or `B' entry"))
-    ;; Go to the beginning of the next line, so next execution will use
-    ;; next line in buffer.
-    (beginning-of-line 2)
-    ;; Execute the correct command
-    (cond
-     ;; Merge of two files with ancestor
-     ((and file-A file-B file-ancestor)
-      (message "Merging %s and %s..." file-A file-B)
-      (emerge-files-with-ancestor (not (not file-out)) file-A file-B
-				  file-ancestor file-out
-				  nil
-				  ;; When done, return to this buffer.
-				  (list
-				   (` (lambda ()
-					(switch-to-buffer (, (current-buffer)))
-					(message "Merge done."))))))
-     ;; Merge of two files without ancestor
-     ((and file-A file-B)
-      (message "Merging %s and %s..." file-A file-B)
-      (emerge-files (not (not file-out)) file-A file-B file-out
-		    nil
-		    ;; When done, return to this buffer.
-		    (list 
-		     (` (lambda ()
-			  (switch-to-buffer (, (current-buffer)))
-			  (message "Merge done."))))))
-     ;; There is an output file (or there would have been an error above),
-     ;; but only one input file.
-     ;; The file appears to have been deleted in one version; do nothing.
-     ((and file-ancestor emerge-execute-line-deletions)
-      (message "No action."))
-     ;; The file should be copied from the version that contains it
-     (t (let ((input-file (or file-A file-B)))
-	  (message "Copying...")
-	  (copy-file input-file file-out)
-	  (message "%s copied to %s." input-file file-out))))))
-
-;;; Sample function for creating information for emerge-execute-line
-
-(defvar emerge-merge-directories-filename-regexp "[^.]"
-  "Regexp describing files to be processed by `emerge-merge-directories'.")
-
-;;;###autoload
-(defun emerge-merge-directories (a-dir b-dir ancestor-dir output-dir)
-  (interactive 
-   (list
-    (read-file-name "A directory: " nil nil 'confirm)
-    (read-file-name "B directory: " nil nil 'confirm)
-    (read-file-name "Ancestor directory (null for none): " nil nil 'confirm)
-    (read-file-name "Output directory (null for none): " nil nil 'confirm)))
-  ;; Check that we're not on a line
-  (if (not (and (bolp) (eolp)))
-      (error "There is text on this line"))
-  ;; Turn null strings into nil to indicate directories not used.
-  (if (and ancestor-dir (string-equal ancestor-dir ""))
-      (setq ancestor-dir nil))
-  (if (and output-dir (string-equal output-dir ""))
-      (setq output-dir nil))
-  ;; Canonicalize the directory names
-  (setq a-dir (expand-file-name a-dir))
-  (if (not (string-equal (substring a-dir -1) "/"))
-      (setq a-dir (concat a-dir "/")))
-  (setq b-dir (expand-file-name b-dir))
-  (if (not (string-equal (substring b-dir -1) "/"))
-      (setq b-dir (concat b-dir "/")))
-  (if ancestor-dir
-      (progn
-	(setq ancestor-dir (expand-file-name ancestor-dir))
-	(if (not (string-equal (substring ancestor-dir -1) "/"))
-	    (setq ancestor-dir (concat ancestor-dir "/")))))
-  (if output-dir
-      (progn
-	(setq output-dir (expand-file-name output-dir))
-	(if (not (string-equal (substring output-dir -1) "/"))
-	    (setq output-dir (concat output-dir "/")))))
-  ;; Set the mark to where we start
-  (push-mark)
-  ;; Find out what files are in the directories.
-  (let* ((a-dir-files
-	  (directory-files a-dir nil emerge-merge-directories-filename-regexp))
-	 (b-dir-files
-	  (directory-files b-dir nil emerge-merge-directories-filename-regexp))
-	 (ancestor-dir-files
-	  (and ancestor-dir
-	       (directory-files ancestor-dir nil
-				emerge-merge-directories-filename-regexp)))
-	 (all-files (sort (nconc (copy-sequence a-dir-files)
-				 (copy-sequence b-dir-files)
-				 (copy-sequence ancestor-dir-files))
-			  (function string-lessp))))
-    ;; Remove duplicates from all-files.
-    (let ((p all-files))
-      (while p
-	(if (and (cdr p) (string-equal (car p) (car (cdr p))))
-	    (setcdr p (cdr (cdr p)))
-	  (setq p (cdr p)))))
-    ;; Generate the control lines for the various files.
-    (while all-files
-      (let ((f (car all-files)))
-	(setq all-files (cdr all-files))
-	(if (and a-dir-files (string-equal (car a-dir-files) f))
-	    (progn
-	      (insert "A=" a-dir f "\t")
-	      (setq a-dir-files (cdr a-dir-files))))
-	(if (and b-dir-files (string-equal (car b-dir-files) f))
-	    (progn
-	      (insert "B=" b-dir f "\t")
-	      (setq b-dir-files (cdr b-dir-files))))
-	(if (and ancestor-dir-files (string-equal (car ancestor-dir-files) f))
-	    (progn
-	      (insert "ancestor=" ancestor-dir f "\t")
-	      (setq ancestor-dir-files (cdr ancestor-dir-files))))
-	(if output-dir
-	    (insert "output=" output-dir f "\t"))
-	(backward-delete-char 1)
-	(insert "\n")))))
-
-;;; Common setup routines
-
-;; Set up the window configuration.  If POS is given, set the points to
-;; the beginnings of the buffers.
-(defun emerge-setup-windows (buffer-A buffer-B merge-buffer &optional pos)
-  ;; Make sure we are not in the minibuffer window when we try to delete
-  ;; all other windows.
-  (if (eq (selected-window) (minibuffer-window))
-      (other-window 1))
-  (delete-other-windows)
-  (switch-to-buffer merge-buffer)
-  (emerge-refresh-mode-line)
-  (split-window-vertically)
-  (split-window-horizontally)
-  (switch-to-buffer buffer-A)
-  (if pos
-      (goto-char (point-min)))
-  (other-window 1)
-  (switch-to-buffer buffer-B)
-  (if pos
-      (goto-char (point-min)))
-  (other-window 1)
-  (if pos
-      (goto-char (point-min)))
-  ;; If diff/diff3 reports errors, display them rather than the merge buffer.
-  (if (/= 0 (emerge-eval-in-buffer emerge-diff-error-buffer (buffer-size)))
-      (progn
-	(ding)
-	(message "Errors found in diff/diff3 output.  Merge buffer is %s."
-		 (buffer-name emerge-merge-buffer))
-	(switch-to-buffer emerge-diff-error-buffer))))
-
-;; Set up the keymap in the merge buffer
-(defun emerge-set-keys ()
-  ;; Set up fixed keymaps if necessary
-  (if (not emerge-basic-keymap)
-      (emerge-setup-fixed-keymaps))
-  ;; Save the old local map
-  (setq emerge-old-keymap (current-local-map))
-  ;; Construct the edit keymap
-  (setq emerge-edit-keymap (if emerge-old-keymap
-			       (copy-keymap emerge-old-keymap)
-			     (make-sparse-keymap)))
-  ;; Install the Emerge commands
-  (emerge-force-define-key emerge-edit-keymap emerge-command-prefix
-			   'emerge-basic-keymap)
-  (define-key emerge-edit-keymap [menu-bar] (make-sparse-keymap))
-
-  ;; Create the additional menu bar items.
-  (define-key emerge-edit-keymap [menu-bar options]
-    (cons "Options" emerge-options-menu))
-  (define-key emerge-edit-keymap [menu-bar merge]
-    (cons "Merge" emerge-merge-menu))
-  (define-key emerge-edit-keymap [menu-bar move]
-    (cons "Move" emerge-move-menu))
-
-  ;; Suppress write-file and save-buffer
-  (substitute-key-definition 'write-file
-			     'emerge-query-write-file
-			     emerge-edit-keymap)
-  (substitute-key-definition 'save-buffer
-			     'emerge-query-save-buffer
-			     emerge-edit-keymap)
-  (substitute-key-definition 'write-file 'emerge-query-write-file
-			     emerge-edit-keymap (current-global-map))
-  (substitute-key-definition 'save-buffer 'emerge-query-save-buffer
-			     emerge-edit-keymap (current-global-map))
-  (use-local-map emerge-fast-keymap)
-  (setq emerge-edit-mode nil)
-  (setq emerge-fast-mode t))
-
-(defun emerge-remember-buffer-characteristics ()
-  "Record certain properties of the buffers being merged.
-Must be called in the merge buffer.  Remembers read-only, modified,
-auto-save, and saves them in buffer local variables.  Sets the buffers
-read-only and turns off `auto-save-mode'.
-These characteristics are restored by `emerge-restore-buffer-characteristics'."
-  ;; force auto-save, because we will turn off auto-saving in buffers for the
-  ;; duration
-  (do-auto-save)
-  ;; remember and alter buffer characteristics
-  (setq emerge-A-buffer-values
-	(emerge-eval-in-buffer
-	 emerge-A-buffer
-	 (prog1
-	     (emerge-save-variables emerge-saved-variables)
-	   (emerge-restore-variables emerge-saved-variables
-				     emerge-merging-values))))
-  (setq emerge-B-buffer-values
-	(emerge-eval-in-buffer
-	 emerge-B-buffer
-	 (prog1
-	     (emerge-save-variables emerge-saved-variables)
-	   (emerge-restore-variables emerge-saved-variables
-				     emerge-merging-values)))))
-
-(defun emerge-restore-buffer-characteristics ()
-  "Restores characteristics saved by `emerge-remember-buffer-characteristics'."
-  (let ((A-values emerge-A-buffer-values)
-	(B-values emerge-B-buffer-values))
-    (emerge-eval-in-buffer emerge-A-buffer
-			   (emerge-restore-variables emerge-saved-variables
-						     A-values))
-    (emerge-eval-in-buffer emerge-B-buffer
-			   (emerge-restore-variables emerge-saved-variables
-						     B-values))))
-
-;; Move to line DESIRED-LINE assuming we are at line CURRENT-LINE.
-;; Return DESIRED-LINE.
-(defun emerge-goto-line (desired-line current-line)
-  (forward-line (- desired-line current-line))
-  desired-line)
-
-(defun emerge-convert-diffs-to-markers (A-buffer
-					B-buffer
-					merge-buffer
-					lineno-list)
-  (let* (marker-list
-	 (A-point-min (emerge-eval-in-buffer A-buffer (point-min)))
-	 (offset (1- A-point-min))
-	 (B-point-min (emerge-eval-in-buffer B-buffer (point-min)))
-	 ;; Record current line number in each buffer
-	 ;; so we don't have to count from the beginning.
-	 (a-line 1)
-	 (b-line 1))
-    (emerge-eval-in-buffer A-buffer (goto-char (point-min)))
-    (emerge-eval-in-buffer B-buffer (goto-char (point-min)))
-    (while lineno-list
-      (let* ((list-element (car lineno-list))
-	     a-begin-marker
-	     a-end-marker
-	     b-begin-marker
-	     b-end-marker
-	     merge-begin-marker
-	     merge-end-marker
-	     (a-begin (aref list-element 0))
-	     (a-end (aref list-element 1))
-	     (b-begin (aref list-element 2))
-	     (b-end (aref list-element 3))
-	     (state (aref list-element 4)))
-	;; place markers at the appropriate places in the buffers
-	(emerge-eval-in-buffer
-	 A-buffer
-	 (setq a-line (emerge-goto-line a-begin a-line))
-	 (setq a-begin-marker (point-marker))
-	 (setq a-line (emerge-goto-line a-end a-line))
-	 (setq a-end-marker (point-marker)))
-	(emerge-eval-in-buffer
-	 B-buffer
-	 (setq b-line (emerge-goto-line b-begin b-line))
-	 (setq b-begin-marker (point-marker))
-	 (setq b-line (emerge-goto-line b-end b-line))
-	 (setq b-end-marker (point-marker)))
-	(setq merge-begin-marker (set-marker
-				  (make-marker)
-				  (- (marker-position a-begin-marker)
-				     offset)
-				  merge-buffer))
-	(setq merge-end-marker (set-marker
-				(make-marker)
-				(- (marker-position a-end-marker)
-				   offset)
-				merge-buffer))
-	;; record all the markers for this difference
-	(setq marker-list (cons (vector a-begin-marker a-end-marker
-					b-begin-marker b-end-marker
-					merge-begin-marker merge-end-marker
-					state)
-				marker-list)))
-      (setq lineno-list (cdr lineno-list)))
-    ;; convert the list of difference information into a vector for
-    ;; fast access
-    (setq emerge-difference-list (apply 'vector (nreverse marker-list)))))
-
-;; If we have an ancestor, select all B variants that we prefer 
-(defun emerge-select-prefer-Bs ()
-  (let ((n 0))
-    (while (< n emerge-number-of-differences)
-      (if (eq (aref (aref emerge-difference-list n) 6) 'prefer-B)
-	  (progn
-	    (emerge-unselect-and-select-difference n t)
-	    (emerge-select-B)
-	    (aset (aref emerge-difference-list n) 6 'prefer-B)))
-      (setq n (1+ n))))
-  (emerge-unselect-and-select-difference -1))
-
-;; Process the local-variables list at the end of the merged file, if
-;; requested.
-(defun emerge-handle-local-variables ()
-  (if emerge-process-local-variables
-      (condition-case err
-	  (hack-local-variables)
-	(error (message "Local-variables error in merge buffer: %s"
-			(prin1-to-string err))))))
-
-;;; Common exit routines
-
-(defun emerge-write-and-delete (file-out)
-  ;; clear screen format
-  (delete-other-windows)
-  ;; delete A, B, and ancestor buffers, if they haven't been changed
-  (if (not (buffer-modified-p emerge-A-buffer))
-      (kill-buffer emerge-A-buffer))
-  (if (not (buffer-modified-p emerge-B-buffer))
-      (kill-buffer emerge-B-buffer))
-  (if (and emerge-ancestor-buffer
-	   (not (buffer-modified-p emerge-ancestor-buffer)))
-      (kill-buffer emerge-ancestor-buffer))
-  ;; Write merge buffer to file
-  (and file-out
-       (write-file file-out)))
-
-;;; Commands
-
-(defun emerge-recenter (&optional arg)
-  "Bring the highlighted region of all three merge buffers into view.
-This brings the buffers into view if they are in windows.
-With an argument, reestablish the default three-window display."
-  (interactive "P")
-  ;; If there is an argument, rebuild the window structure
-  (if arg
-      (emerge-setup-windows emerge-A-buffer emerge-B-buffer
-			    emerge-merge-buffer))
-  ;; Redisplay whatever buffers are showing, if there is a selected difference
-  (if (and (>= emerge-current-difference 0)
-	   (< emerge-current-difference emerge-number-of-differences))
-      (let* ((merge-buffer emerge-merge-buffer)
-	     (buffer-A emerge-A-buffer)
-	     (buffer-B emerge-B-buffer)
-	     (window-A (get-buffer-window buffer-A 'visible))
-	     (window-B (get-buffer-window buffer-B 'visible))
-	     (merge-window (get-buffer-window merge-buffer))
-	     (diff-vector
-	      (aref emerge-difference-list emerge-current-difference)))
-	(if window-A (progn
-		       (select-window window-A)
-		       (emerge-position-region
-			(- (aref diff-vector 0)
-			   (1- emerge-before-flag-length))
-			(+ (aref diff-vector 1)
-			   (1- emerge-after-flag-length))
-			(1+ (aref diff-vector 0)))))
-	(if window-B (progn
-		       (select-window window-B)
-		       (emerge-position-region
-			(- (aref diff-vector 2)
-			   (1- emerge-before-flag-length))
-			(+ (aref diff-vector 3)
-			   (1- emerge-after-flag-length))
-			(1+ (aref diff-vector 2)))))
-	(if merge-window (progn
-			   (select-window merge-window)
-			   (emerge-position-region
-			    (- (aref diff-vector 4)
-			       (1- emerge-before-flag-length))
-			    (+ (aref diff-vector 5)
-			       (1- emerge-after-flag-length))
-			    (1+ (aref diff-vector 4))))))))
-
-;;; Window scrolling operations
-;; These operations are designed to scroll all three windows the same amount,
-;; so as to keep the text in them aligned.
-
-;; Perform some operation on all three windows (if they are showing).
-;; Catches all errors on the operation in the A and B windows, but not
-;; in the merge window.  Usually, errors come from scrolling off the
-;; beginning or end of the buffer, and this gives a nice error message:
-;; End of buffer is reported in the merge buffer, but if the scroll was
-;; possible in the A or B windows, it is performed there before the error
-;; is reported.
-(defun emerge-operate-on-windows (operation arg)
-  (let* ((merge-buffer emerge-merge-buffer)
-	 (buffer-A emerge-A-buffer)
-	 (buffer-B emerge-B-buffer)
-	 (window-A (get-buffer-window buffer-A 'visible))
-	 (window-B (get-buffer-window buffer-B 'visible))
-	 (merge-window (get-buffer-window merge-buffer)))
-    (if window-A (progn
-		   (select-window window-A)
-		   (condition-case nil
-		       (funcall operation arg)
-		     (error))))
-    (if window-B (progn
-		   (select-window window-B)
-		   (condition-case nil
-		       (funcall operation arg)
-		     (error))))
-    (if merge-window (progn
-		       (select-window merge-window)
-		       (funcall operation arg)))))
-
-(defun emerge-scroll-up (&optional arg)
-  "Scroll up all three merge buffers, if they are in windows.
-With argument N, scroll N lines; otherwise scroll by nearly
-the height of the merge window.
-`C-u -' alone as argument scrolls half the height of the merge window."
-  (interactive "P")
-  (emerge-operate-on-windows
-   'scroll-up 
-   ;; calculate argument to scroll-up
-   ;; if there is an explicit argument
-   (if (and arg (not (equal arg '-)))
-       ;; use it
-       (prefix-numeric-value arg)
-     ;; if not, see if we can determine a default amount (the window height)
-     (let ((merge-window (get-buffer-window emerge-merge-buffer)))
-       (if (null merge-window)
-	   ;; no window, use nil
-	   nil
-	 (let ((default-amount
-		 (- (window-height merge-window) 1 next-screen-context-lines)))
-	   ;; the window was found
-	   (if arg
-	       ;; C-u as argument means half of default amount
-	       (/ default-amount 2)
-	     ;; no argument means default amount
-	     default-amount)))))))
-
-(defun emerge-scroll-down (&optional arg)
-  "Scroll down all three merge buffers, if they are in windows.
-With argument N, scroll N lines; otherwise scroll by nearly
-the height of the merge window.
-`C-u -' alone as argument scrolls half the height of the merge window."
-  (interactive "P")
-  (emerge-operate-on-windows
-   'scroll-down
-   ;; calculate argument to scroll-down
-   ;; if there is an explicit argument
-   (if (and arg (not (equal arg '-)))
-       ;; use it
-       (prefix-numeric-value arg)
-     ;; if not, see if we can determine a default amount (the window height)
-     (let ((merge-window (get-buffer-window emerge-merge-buffer)))
-       (if (null merge-window)
-	   ;; no window, use nil
-	   nil
-	 (let ((default-amount
-		 (- (window-height merge-window) 1 next-screen-context-lines)))
-	   ;; the window was found
-	   (if arg
-	       ;; C-u as argument means half of default amount
-	       (/ default-amount 2)
-	     ;; no argument means default amount
-	     default-amount)))))))
-
-(defun emerge-scroll-left (&optional arg)
-  "Scroll left all three merge buffers, if they are in windows.
-If an argument is given, that is how many columns are scrolled, else nearly
-the width of the A and B windows.  `C-u -' alone as argument scrolls half the
-width of the A and B windows."
-  (interactive "P")
-  (emerge-operate-on-windows
-   'scroll-left
-   ;; calculate argument to scroll-left
-   ;; if there is an explicit argument
-   (if (and arg (not (equal arg '-)))
-       ;; use it
-       (prefix-numeric-value arg)
-     ;; if not, see if we can determine a default amount
-     ;; (half the window width)
-     (let ((merge-window (get-buffer-window emerge-merge-buffer)))
-       (if (null merge-window)
-	   ;; no window, use nil
-	   nil
-	 (let ((default-amount
-		 (- (/ (window-width merge-window) 2) 3)))
-	   ;; the window was found
-	   (if arg
-	       ;; C-u as argument means half of default amount
-	       (/ default-amount 2)
-	     ;; no argument means default amount
-	     default-amount)))))))
-
-(defun emerge-scroll-right (&optional arg)
-  "Scroll right all three merge buffers, if they are in windows.
-If an argument is given, that is how many columns are scrolled, else nearly
-the width of the A and B windows.  `C-u -' alone as argument scrolls half the
-width of the A and B windows."
-  (interactive "P")
-  (emerge-operate-on-windows
-   'scroll-right
-   ;; calculate argument to scroll-right
-   ;; if there is an explicit argument
-   (if (and arg (not (equal arg '-)))
-       ;; use it
-       (prefix-numeric-value arg)
-     ;; if not, see if we can determine a default amount
-     ;; (half the window width)
-     (let ((merge-window (get-buffer-window emerge-merge-buffer)))
-       (if (null merge-window)
-	   ;; no window, use nil
-	   nil
-	 (let ((default-amount
-		 (- (/ (window-width merge-window) 2) 3)))
-	   ;; the window was found
-	   (if arg
-	       ;; C-u as argument means half of default amount
-	       (/ default-amount 2)
-	     ;; no argument means default amount
-	     default-amount)))))))
-
-(defun emerge-scroll-reset ()
-  "Reset horizontal scrolling in Emerge.
-This resets the horizontal scrolling of all three merge buffers
-to the left margin, if they are in windows."
-  (interactive)
-  (emerge-operate-on-windows
-   (function (lambda (x) (set-window-hscroll (selected-window) 0)))
-   nil))
-
-;; Attempt to show the region nicely.
-;; If there are min-lines lines above and below the region, then don't do
-;; anything.
-;; If not, recenter the region to make it so.
-;; If that isn't possible, remove context lines balancedly from top and bottom
-;; so the entire region shows.
-;; If that isn't possible, show the top of the region.
-;; BEG must be at the beginning of a line.
-(defun emerge-position-region (beg end pos)
-  ;; First test whether the entire region is visible with
-  ;; emerge-min-visible-lines above and below it
-  (if (not (and (<= (progn
-		      (move-to-window-line emerge-min-visible-lines)
-		      (point))
-		    beg)
-		(<= end (progn
-			  (move-to-window-line
-			   (- (1+ emerge-min-visible-lines)))
-			  (point)))))
-      ;; We failed that test, see if it fits at all
-      ;; Meanwhile positioning it correctly in case it doesn't fit
-      (progn
-	(set-window-start (selected-window) beg)
-	(if (pos-visible-in-window-p end)
-	    ;; Determine the number of lines that the region occupies
-	    (let ((lines 0))
-	      (while (> end (progn
-			      (move-to-window-line lines)
-			      (point)))
-		(setq lines (1+ lines)))
-	      ;; And position the beginning on the right line
-	      (goto-char beg)
-	      (recenter (/ (1+ (- (1- (window-height (selected-window)))
-				  lines))
-			   2))))))
-  (goto-char pos))
-
-(defun emerge-next-difference ()
-  "Advance to the next difference."
-  (interactive)
-  (if (< emerge-current-difference emerge-number-of-differences)
-      (let ((n (1+ emerge-current-difference)))
-	(while (and emerge-skip-prefers
-		    (< n emerge-number-of-differences)
-		    (memq (aref (aref emerge-difference-list n) 6)
-			  '(prefer-A prefer-B)))
-	  (setq n (1+ n)))
-	(let ((buffer-read-only nil))
-	  (emerge-unselect-and-select-difference n)))
-    (error "At end")))
-
-(defun emerge-previous-difference ()
-  "Go to the previous difference."
-  (interactive)
-  (if (> emerge-current-difference -1)
-      (let ((n (1- emerge-current-difference)))
-	(while (and emerge-skip-prefers
-		    (> n -1)
-		    (memq (aref (aref emerge-difference-list n) 6)
-			  '(prefer-A prefer-B)))
-	  (setq n (1- n)))
-	(let ((buffer-read-only nil))
-	  (emerge-unselect-and-select-difference n)))
-    (error "At beginning")))
-
-(defun emerge-jump-to-difference (difference-number)
-  "Go to the N-th difference."
-  (interactive "p")
-  (let ((buffer-read-only nil))
-    (setq difference-number (1- difference-number))
-    (if (and (>= difference-number -1)
-	     (< difference-number (1+ emerge-number-of-differences)))
-	(emerge-unselect-and-select-difference difference-number)
-      (error "Bad difference number"))))
-
-(defun emerge-abort ()
-  "Abort the Emerge session."
-  (interactive)
-  (emerge-quit t))
-
-(defun emerge-quit (arg)
-  "Finish the Emerge session and exit Emerge.
-Prefix argument means to abort rather than successfully finish.
-The difference depends on how the merge was started,
-but usually means to not write over one of the original files, or to signal
-to some process which invoked Emerge a failure code.
-
-Unselects the selected difference, if any, restores the read-only and modified
-flags of the merged file buffers, restores the local keymap of the merge
-buffer, and sets off various emerge flags.  Using Emerge commands in this
-buffer after this will cause serious problems."
-  (interactive "P")
-  (if (prog1
-	  (y-or-n-p
-	   (if (not arg)
-	       "Do you really want to successfully finish this merge? "
-	     "Do you really want to abort this merge? "))
-	(message ""))
-      (emerge-really-quit arg)))
-
-;; Perform the quit operations.
-(defun emerge-really-quit (arg)
-  (setq buffer-read-only nil)
-  (emerge-unselect-and-select-difference -1)
-  (emerge-restore-buffer-characteristics)
-  ;; null out the difference markers so they don't slow down future editing
-  ;; operations
-  (mapcar (function (lambda (d)
-		      (set-marker (aref d 0) nil)
-		      (set-marker (aref d 1) nil)
-		      (set-marker (aref d 2) nil)
-		      (set-marker (aref d 3) nil)
-		      (set-marker (aref d 4) nil)
-		      (set-marker (aref d 5) nil)))
-	  emerge-difference-list)
-  ;; allow them to be garbage collected
-  (setq emerge-difference-list nil)
-  ;; restore the local map
-  (use-local-map emerge-old-keymap)
-  ;; turn off all the emerge modes
-  (setq emerge-mode nil)
-  (setq emerge-fast-mode nil)
-  (setq emerge-edit-mode nil)
-  (setq emerge-auto-advance nil)
-  (setq emerge-skip-prefers nil)
-  ;; restore mode line
-  (kill-local-variable 'mode-line-buffer-identification)
-  (let ((emerge-prefix-argument arg))
-    (run-hooks 'emerge-quit-hook)))
-
-(defun emerge-select-A (&optional force)
-  "Select the A variant of this difference.  
-Refuses to function if this difference has been edited, i.e., if it
-is neither the A nor the B variant.
-A prefix argument forces the variant to be selected
-even if the difference has been edited."
-  (interactive "P")
-  (let ((operate
-	 (function (lambda ()
-		     (emerge-select-A-edit merge-begin merge-end A-begin A-end)
-		     (if emerge-auto-advance
-			 (emerge-next-difference)))))
-	(operate-no-change
-	 (function (lambda ()
-		     (if emerge-auto-advance
-			 (emerge-next-difference))))))
-    (emerge-select-version force operate-no-change operate operate)))
-
-;; Actually select the A variant
-(defun emerge-select-A-edit (merge-begin merge-end A-begin A-end)
-  (emerge-eval-in-buffer
-   emerge-merge-buffer
-   (delete-region merge-begin merge-end)
-   (goto-char merge-begin)
-   (insert-buffer-substring emerge-A-buffer A-begin A-end)
-   (goto-char merge-begin)
-   (aset diff-vector 6 'A)
-   (emerge-refresh-mode-line)))
-
-(defun emerge-select-B (&optional force)
-  "Select the B variant of this difference.
-Refuses to function if this difference has been edited, i.e., if it
-is neither the A nor the B variant.
-A prefix argument forces the variant to be selected
-even if the difference has been edited."
-  (interactive "P")
-  (let ((operate
-	 (function (lambda ()
-		     (emerge-select-B-edit merge-begin merge-end B-begin B-end)
-		     (if emerge-auto-advance
-			 (emerge-next-difference)))))
-	(operate-no-change
-	 (function (lambda ()
-		     (if emerge-auto-advance
-			 (emerge-next-difference))))))
-    (emerge-select-version force operate operate-no-change operate)))
-
-;; Actually select the B variant
-(defun emerge-select-B-edit (merge-begin merge-end B-begin B-end)
-  (emerge-eval-in-buffer
-   emerge-merge-buffer
-   (delete-region merge-begin merge-end)
-   (goto-char merge-begin)
-   (insert-buffer-substring emerge-B-buffer B-begin B-end)
-   (goto-char merge-begin)
-   (aset diff-vector 6 'B)
-   (emerge-refresh-mode-line)))
-
-(defun emerge-default-A ()
-  "Make the A variant the default from here down.
-This selects the A variant for all differences from here down in the buffer
-which are still defaulted, i.e., which the user has not selected and for
-which there is no preference."
-  (interactive)
-  (let ((buffer-read-only nil))
-    (let ((selected-difference emerge-current-difference)
-	  (n (max emerge-current-difference 0)))
-      (while (< n emerge-number-of-differences)
-	(let ((diff-vector (aref emerge-difference-list n)))
-	  (if (eq (aref diff-vector 6) 'default-B)
-	      (progn
-		(emerge-unselect-and-select-difference n t)
-		(emerge-select-A)
-		(aset diff-vector 6 'default-A))))
-	(setq n (1+ n))
-	(if (zerop (% n 10))
-	    (message "Setting default to A...%d" n)))
-      (emerge-unselect-and-select-difference selected-difference)))
-  (message "Default choice is now A"))
-
-(defun emerge-default-B ()
-  "Make the B variant the default from here down.
-This selects the B variant for all differences from here down in the buffer
-which are still defaulted, i.e., which the user has not selected and for
-which there is no preference."
-  (interactive)
-  (let ((buffer-read-only nil))
-    (let ((selected-difference emerge-current-difference)
-	  (n (max emerge-current-difference 0)))
-      (while (< n emerge-number-of-differences)
-	(let ((diff-vector (aref emerge-difference-list n)))
-	  (if (eq (aref diff-vector 6) 'default-A)
-	      (progn
-		(emerge-unselect-and-select-difference n t)
-		(emerge-select-B)
-		(aset diff-vector 6 'default-B))))
-	(setq n (1+ n))
-	(if (zerop (% n 10))
-	    (message "Setting default to B...%d" n)))
-      (emerge-unselect-and-select-difference selected-difference)))
-  (message "Default choice is now B"))
-
-(defun emerge-fast-mode ()
-  "Set fast mode, for Emerge.
-In this mode ordinary Emacs commands are disabled, and Emerge commands
-need not be prefixed with \\<emerge-fast-keymap>\\[emerge-basic-keymap]."
-  (interactive)
-  (setq buffer-read-only t)
-  (use-local-map emerge-fast-keymap)
-  (setq emerge-mode t)
-  (setq emerge-fast-mode t)
-  (setq emerge-edit-mode nil)
-  (message "Fast mode set")
-  (force-mode-line-update))
-
-(defun emerge-edit-mode ()
-  "Set edit mode, for Emerge.
-In this mode ordinary Emacs commands are available, and Emerge commands
-must be prefixed with \\<emerge-fast-keymap>\\[emerge-basic-keymap]."
-  (interactive)
-  (setq buffer-read-only nil)
-  (use-local-map emerge-edit-keymap)
-  (setq emerge-mode t)
-  (setq emerge-fast-mode nil)
-  (setq emerge-edit-mode t)
-  (message "Edit mode set")
-  (force-mode-line-update))
-
-(defun emerge-auto-advance (arg)
-  "Toggle Auto-Advance mode, for Emerge.
-This mode causes `emerge-select-A' and `emerge-select-B' to automatically
-advance to the next difference.
-With a positive argument, turn on Auto-Advance mode.
-With a negative argument, turn off Auto-Advance mode."
-  (interactive "P")
-  (setq emerge-auto-advance (if (null arg)
-				(not emerge-auto-advance)
-			      (> (prefix-numeric-value arg) 0)))
-  (message (if emerge-auto-advance
-	       "Auto-advance set"
-	     "Auto-advance cleared"))
-  (force-mode-line-update))
-
-(defun emerge-skip-prefers (arg)
-  "Toggle Skip-Prefers mode, for Emerge.
-This mode causes `emerge-next-difference' and `emerge-previous-difference'
-to automatically skip over differences for which there is a preference.
-With a positive argument, turn on Skip-Prefers mode.
-With a negative argument, turn off Skip-Prefers mode."
-  (interactive "P")
-  (setq emerge-skip-prefers (if (null arg)
-				(not emerge-skip-prefers)
-			      (> (prefix-numeric-value arg) 0)))
-  (message (if emerge-skip-prefers
-	       "Skip-prefers set"
-	     "Skip-prefers cleared"))
-  (force-mode-line-update))
-
-(defun emerge-copy-as-kill-A ()
-  "Put the A variant of this difference in the kill ring."
-  (interactive)
-  (emerge-validate-difference)
-  (let* ((diff-vector
-	  (aref emerge-difference-list emerge-current-difference))
-	 (A-begin (1+ (aref diff-vector 0)))
-	 (A-end (1- (aref diff-vector 1)))
-	 ;; so further kills don't append
-	 this-command)
-    (save-excursion
-      (set-buffer emerge-A-buffer)
-      (copy-region-as-kill A-begin A-end))))
-
-(defun emerge-copy-as-kill-B ()
-  "Put the B variant of this difference in the kill ring."
-  (interactive)
-  (emerge-validate-difference)
-  (let* ((diff-vector
-	  (aref emerge-difference-list emerge-current-difference))
-	 (B-begin (1+ (aref diff-vector 2)))
-	 (B-end (1- (aref diff-vector 3)))
-	 ;; so further kills don't append
-	 this-command)
-    (save-excursion
-      (set-buffer emerge-B-buffer)
-      (copy-region-as-kill B-begin B-end))))
-
-(defun emerge-insert-A (arg)
-  "Insert the A variant of this difference at the point.
-Leaves point after text, mark before.
-With prefix argument, puts point before, mark after."
-  (interactive "P")
-  (emerge-validate-difference)
-  (let* ((diff-vector
-	  (aref emerge-difference-list emerge-current-difference))
-	 (A-begin (1+ (aref diff-vector 0)))
-	 (A-end (1- (aref diff-vector 1)))
-	 (opoint (point))
-	 (buffer-read-only nil))
-    (insert-buffer-substring emerge-A-buffer A-begin A-end)
-    (if (not arg)
-	(set-mark opoint)
-      (set-mark (point))
-      (goto-char opoint))))
-
-(defun emerge-insert-B (arg)
-  "Insert the B variant of this difference at the point.
-Leaves point after text, mark before.
-With prefix argument, puts point before, mark after."
-  (interactive "P")
-  (emerge-validate-difference)
-  (let* ((diff-vector
-	  (aref emerge-difference-list emerge-current-difference))
-	 (B-begin (1+ (aref diff-vector 2)))
-	 (B-end (1- (aref diff-vector 3)))
-	 (opoint (point))
-	 (buffer-read-only nil))
-    (insert-buffer-substring emerge-B-buffer B-begin B-end)
-    (if (not arg)
-	(set-mark opoint)
-      (set-mark (point))
-      (goto-char opoint))))
-
-(defun emerge-mark-difference (arg)
-  "Leaves the point before this difference and the mark after it.
-With prefix argument, puts mark before, point after."
-  (interactive "P")
-  (emerge-validate-difference)
-  (let* ((diff-vector
-	  (aref emerge-difference-list emerge-current-difference))
-	 (merge-begin (1+ (aref diff-vector 4)))
-	 (merge-end (1- (aref diff-vector 5))))
-    (if (not arg)
-	(progn
-	  (goto-char merge-begin)
-	  (set-mark merge-end))
-      (goto-char merge-end)
-      (set-mark merge-begin))))
-
-(defun emerge-file-names ()
-  "Show the names of the buffers or files being operated on by Emerge.
-Use C-u l to reset the windows afterward."
-  (interactive)
-  (delete-other-windows)
-  (let ((temp-buffer-show-function
-	 (function (lambda (buf)
-		     (split-window-vertically)
-		     (switch-to-buffer buf)
-		     (other-window 1)))))
-    (with-output-to-temp-buffer "*Help*"
-      (emerge-eval-in-buffer emerge-A-buffer
-			     (if buffer-file-name
-				 (progn
-				   (princ "File A is: ")
-				   (princ buffer-file-name))
-			       (progn
-				 (princ "Buffer A is: ")
-				 (princ (buffer-name))))
-			     (princ "\n"))
-      (emerge-eval-in-buffer emerge-B-buffer
-			     (if buffer-file-name
-				 (progn
-				   (princ "File B is: ")
-				   (princ buffer-file-name))
-			       (progn
-				 (princ "Buffer B is: ")
-				 (princ (buffer-name))))
-			     (princ "\n"))
-      (if emerge-ancestor-buffer
-	    (emerge-eval-in-buffer emerge-ancestor-buffer
-				   (if buffer-file-name
-				       (progn
-					 (princ "Ancestor file is: ")
-					 (princ buffer-file-name))
-				     (progn
-				       (princ "Ancestor buffer is: ")
-				       (princ (buffer-name))))
-				   (princ "\n")))
-      (princ emerge-output-description)
-      (save-excursion
-	(set-buffer standard-output)
-	(help-mode)))))
-
-(defun emerge-join-differences (arg)
-  "Join the selected difference with the following one.
-With a prefix argument, join with the preceding one."
-  (interactive "P")
-  (let ((n emerge-current-difference))
-    ;; adjust n to be first difference to join
-    (if arg
-	(setq n (1- n)))
-    ;; n and n+1 are the differences to join
-    ;; check that they are both differences
-    (if (or (< n 0) (>= n (1- emerge-number-of-differences)))
-	(error "Incorrect differences to join"))
-    ;; remove the flags
-    (emerge-unselect-difference emerge-current-difference)
-    ;; decrement total number of differences
-    (setq emerge-number-of-differences (1- emerge-number-of-differences))
-    ;; build new differences vector
-    (let ((i 0)
-	  (new-differences (make-vector emerge-number-of-differences nil)))
-      (while (< i emerge-number-of-differences)
-	(aset new-differences i
-	      (cond
-	       ((< i n) (aref emerge-difference-list i))
-	       ((> i n) (aref emerge-difference-list (1+ i)))
-	       (t (let ((prev (aref emerge-difference-list i))
-			(next (aref emerge-difference-list (1+ i))))
-		    (vector (aref prev 0)
-			    (aref next 1)
-			    (aref prev 2)
-			    (aref next 3)
-			    (aref prev 4)
-			    (aref next 5)
-			    (let ((ps (aref prev 6))
-				  (ns (aref next 6)))
-			      (cond
-			       ((eq ps ns)
-				ps)
-			       ((and (or (eq ps 'B) (eq ps 'prefer-B))
-				     (or (eq ns 'B) (eq ns 'prefer-B)))
-				'B)
-			       (t 'A))))))))
-	(setq i (1+ i)))
-      (setq emerge-difference-list new-differences))
-    ;; set the current difference correctly
-    (setq emerge-current-difference n)
-    ;; fix the mode line
-    (emerge-refresh-mode-line)
-    ;; reinsert the flags
-    (emerge-select-difference emerge-current-difference)
-    (emerge-recenter)))
-
-(defun emerge-split-difference ()
-  "Split the current difference where the points are in the three windows."
-  (interactive)
-  (let ((n emerge-current-difference))
-    ;; check that this is a valid difference
-    (emerge-validate-difference)
-    ;; get the point values and old difference
-    (let ((A-point (emerge-eval-in-buffer emerge-A-buffer
-					  (point-marker)))
-	  (B-point (emerge-eval-in-buffer emerge-B-buffer
-					  (point-marker)))
-	  (merge-point (point-marker))
-	  (old-diff (aref emerge-difference-list n)))
-      ;; check location of the points, give error if they aren't in the
-      ;; differences
-      (if (or (< A-point (aref old-diff 0))
-	      (> A-point (aref old-diff 1)))
-	  (error "Point outside of difference in A buffer"))
-      (if (or (< B-point (aref old-diff 2))
-	      (> B-point (aref old-diff 3)))
-	  (error "Point outside of difference in B buffer"))
-      (if (or (< merge-point (aref old-diff 4))
-	      (> merge-point (aref old-diff 5)))
-	  (error "Point outside of difference in merge buffer"))
-      ;; remove the flags
-      (emerge-unselect-difference emerge-current-difference)
-      ;; increment total number of differences
-      (setq emerge-number-of-differences (1+ emerge-number-of-differences))
-      ;; build new differences vector
-      (let ((i 0)
-	    (new-differences (make-vector emerge-number-of-differences nil)))
-	(while (< i emerge-number-of-differences)
-	  (aset new-differences i
-		(cond
-		 ((< i n)
-		  (aref emerge-difference-list i))
-		 ((> i (1+ n))
-		  (aref emerge-difference-list (1- i)))
-		 ((= i n)
-		  (vector (aref old-diff 0)
-			  A-point
-			  (aref old-diff 2)
-			  B-point
-			  (aref old-diff 4)
-			  merge-point
-			  (aref old-diff 6)))
-		 (t
-		  (vector (copy-marker A-point)
-			  (aref old-diff 1)
-			  (copy-marker B-point)
-			  (aref old-diff 3)
-			  (copy-marker merge-point)
-			  (aref old-diff 5)
-			  (aref old-diff 6)))))
-	  (setq i (1+ i)))
-	(setq emerge-difference-list new-differences))
-      ;; set the current difference correctly
-      (setq emerge-current-difference n)
-      ;; fix the mode line
-      (emerge-refresh-mode-line)
-      ;; reinsert the flags
-      (emerge-select-difference emerge-current-difference)
-      (emerge-recenter))))
-
-(defun emerge-trim-difference ()
-  "Trim lines off top and bottom of difference that are the same.
-If lines are the same in both the A and the B versions, strip them off.
-\(This can happen when the A and B versions have common lines that the
-ancestor version does not share.)"
-  (interactive)
-  ;; make sure we are in a real difference
-  (emerge-validate-difference)
-  ;; remove the flags
-  (emerge-unselect-difference emerge-current-difference)
-  (let* ((diff (aref emerge-difference-list emerge-current-difference))
-	 (top-a (marker-position (aref diff 0)))
-	 (bottom-a (marker-position (aref diff 1)))
-	 (top-b (marker-position (aref diff 2)))
-	 (bottom-b (marker-position (aref diff 3)))
-	 (top-m (marker-position (aref diff 4)))
-	 (bottom-m (marker-position (aref diff 5)))
-	 size success sa sb sm)
-    ;; move down the tops of the difference regions as much as possible
-    ;; Try advancing comparing 1000 chars at a time.
-    ;; When that fails, go 500 chars at a time, and so on.
-    (setq size 1000)
-    (while (> size 0)
-      (setq success t)
-      (while success
-	(setq size (min size (- bottom-a top-a) (- bottom-b top-b)
-			(- bottom-m top-m)))
-	(setq sa (emerge-eval-in-buffer emerge-A-buffer
-					(buffer-substring top-a
-							  (+ size top-a))))
-	(setq sb (emerge-eval-in-buffer emerge-B-buffer
-					(buffer-substring top-b
-							  (+ size top-b))))
-	(setq sm (buffer-substring top-m (+ size top-m)))
-	(setq success (and (> size 0) (equal sa sb) (equal sb sm)))
-	(if success
-	    (setq top-a (+ top-a size)
-		  top-b (+ top-b size)
-		  top-m (+ top-m size))))
-      (setq size (/ size 2)))
-    ;; move up the bottoms of the difference regions as much as possible
-    ;; Try advancing comparing 1000 chars at a time.
-    ;; When that fails, go 500 chars at a time, and so on.
-    (setq size 1000)
-    (while (> size 0)
-      (setq success t)
-      (while success
-	(setq size (min size (- bottom-a top-a) (- bottom-b top-b)
-			(- bottom-m top-m)))
-	(setq sa (emerge-eval-in-buffer emerge-A-buffer
-					(buffer-substring (- bottom-a size)
-							  bottom-a)))
-	(setq sb (emerge-eval-in-buffer emerge-B-buffer
-					(buffer-substring (- bottom-b size)
-							  bottom-b)))
-	(setq sm (buffer-substring (- bottom-m size) bottom-m))
-	(setq success (and (> size 0) (equal sa sb) (equal sb sm)))
-	(if success
-	    (setq bottom-a (- bottom-a size)
-		  bottom-b (- bottom-b size)
-		  bottom-m (- bottom-m size))))
-      (setq size (/ size 2)))
-    ;; {top,bottom}-{a,b,m} are now set at the new beginnings and ends
-    ;; of the difference regions.  Move them to the beginning of lines, as
-    ;; appropriate.
-    (emerge-eval-in-buffer emerge-A-buffer
-			   (goto-char top-a)
-			   (beginning-of-line)
-			   (aset diff 0 (point-marker))
-			   (goto-char bottom-a)
-			   (beginning-of-line 2)
-			   (aset diff 1 (point-marker)))
-    (emerge-eval-in-buffer emerge-B-buffer
-			   (goto-char top-b)
-			   (beginning-of-line)
-			   (aset diff 2 (point-marker))
-			   (goto-char bottom-b)
-			   (beginning-of-line 2)
-			   (aset diff 3 (point-marker)))
-    (goto-char top-m)
-    (beginning-of-line)
-    (aset diff 4 (point-marker))
-    (goto-char bottom-m)
-    (beginning-of-line 2)
-    (aset diff 5 (point-marker))
-    ;; put the flags back in, recenter the display
-    (emerge-select-difference emerge-current-difference)
-    (emerge-recenter)))
-
-(defun emerge-find-difference (arg)
-  "Find the difference containing the current position of the point.
-If there is no containing difference and the prefix argument is positive,
-it finds the nearest following difference.  A negative prefix argument finds
-the nearest previous difference."
-  (interactive "P")
-  (cond ((eq (current-buffer) emerge-A-buffer)
-	 (emerge-find-difference-A arg))
-	((eq (current-buffer) emerge-B-buffer)
-	 (emerge-find-difference-B arg))
-	(t (emerge-find-difference-merge arg))))
-
-(defun emerge-find-difference-merge (arg)
-  "Find the difference containing point, in the merge buffer.
-If there is no containing difference and the prefix argument is positive,
-it finds the nearest following difference.  A negative prefix argument finds
-the nearest previous difference."
-  (interactive "P")
-  ;; search for the point in the merge buffer, using the markers
-  ;; for the beginning and end of the differences in the merge buffer
-  (emerge-find-difference1 arg (point) 4 5))
-
-(defun emerge-find-difference-A (arg)
-  "Find the difference containing point, in the A buffer.
-This command must be executed in the merge buffer.
-If there is no containing difference and the prefix argument is positive,
-it finds the nearest following difference.  A negative prefix argument finds
-the nearest previous difference."
-  (interactive "P")
-  ;; search for the point in the A buffer, using the markers
-  ;; for the beginning and end of the differences in the A buffer
-  (emerge-find-difference1 arg
-			   (emerge-eval-in-buffer emerge-A-buffer (point))
-			   0 1))
-
-(defun emerge-find-difference-B (arg)
-  "Find the difference containing point, in the B buffer.
-This command must be executed in the merge buffer.
-If there is no containing difference and the prefix argument is positive,
-it finds the nearest following difference.  A negative prefix argument finds
-the nearest previous difference."
-  (interactive "P")
-  ;; search for the point in the B buffer, using the markers
-  ;; for the beginning and end of the differences in the B buffer
-  (emerge-find-difference1 arg
-			   (emerge-eval-in-buffer emerge-B-buffer (point))
-			   2 3))
-
-(defun emerge-find-difference1 (arg location begin end)
-  (let* ((index
-	  ;; find first difference containing or after the current position
-	  (catch 'search
-	    (let ((n 0))
-	      (while (< n emerge-number-of-differences)
-		(let ((diff-vector (aref emerge-difference-list n)))
-		  (if (<= location (marker-position (aref diff-vector end)))
-		      (throw 'search n)))
-		(setq n (1+ n))))
-	    emerge-number-of-differences))
-	 (contains
-	  ;; whether the found difference contains the current position
-	  (and (< index emerge-number-of-differences)
-	       (<= (marker-position (aref (aref emerge-difference-list index)
-					  begin))
-		   location)))
-	 (arg-value
-	  ;; numeric value of prefix argument
-	  (prefix-numeric-value arg)))
-    (emerge-unselect-and-select-difference
-     (cond
-      ;; if the point is in a difference, select it
-      (contains index)
-      ;; if the arg is nil and the point is not in a difference, error
-      ((null arg) (error "No difference contains point"))
-      ;; if the arg is positive, select the following difference
-      ((> arg-value 0)
-       (if (< index emerge-number-of-differences)
-	   index
-	 (error "No difference contains or follows point")))
-      ;; if the arg is negative, select the preceding difference
-      (t
-       (if (> index 0)
-	   (1- index)
-	 (error "No difference contains or precedes point")))))))
-
-(defun emerge-line-numbers ()
-  "Display the current line numbers.
-This function displays the line numbers of the points in the A, B, and
-merge buffers."
-  (interactive)
-  (let* ((valid-diff
-	 (and (>= emerge-current-difference 0)
-	      (< emerge-current-difference emerge-number-of-differences)))
-	(diff (and valid-diff
-		   (aref emerge-difference-list emerge-current-difference)))
-	(merge-line (emerge-line-number-in-buf 4 5))
-	(A-line (emerge-eval-in-buffer emerge-A-buffer
-				       (emerge-line-number-in-buf 0 1)))
-	(B-line (emerge-eval-in-buffer emerge-B-buffer
-				       (emerge-line-number-in-buf 2 3))))
-    (message "At lines: merge = %d, A = %d, B = %d"
-	     merge-line A-line B-line)))
-
-(defun emerge-line-number-in-buf (begin-marker end-marker)
-  (let (temp)
-    (setq temp (save-excursion
-		 (beginning-of-line)
-		 (1+ (count-lines 1 (point)))))
-    (if valid-diff
-	(progn
-	  (if (> (point) (aref diff begin-marker))
-	      (setq temp (- temp emerge-before-flag-lines)))
-	  (if (> (point) (aref diff end-marker))
-	      (setq temp (- temp emerge-after-flag-lines)))))
-    temp))
-
-(defun emerge-set-combine-template (string &optional localize)
-  "Set `emerge-combine-versions-template' to STRING.
-This value controls how `emerge-combine-versions' combines the two versions.
-With prefix argument, `emerge-combine-versions-template' is made local to this
-merge buffer.  Localization is permanent for any particular merge buffer."
-  (interactive "s\nP")
-  (if localize
-      (make-local-variable 'emerge-combine-versions-template))
-  (setq emerge-combine-versions-template string)
-  (message
-   (if (assq 'emerge-combine-versions-template (buffer-local-variables))
-       "emerge-set-combine-versions-template set locally"
-     "emerge-set-combine-versions-template set")))
-
-(defun emerge-set-combine-versions-template (start end &optional localize)
-  "Copy region into `emerge-combine-versions-template'.
-This controls how `emerge-combine-versions' will combine the two versions.
-With prefix argument, `emerge-combine-versions-template' is made local to this
-merge buffer.  Localization is permanent for any particular merge buffer."
-  (interactive "r\nP")
-  (if localize
-      (make-local-variable 'emerge-combine-versions-template))
-  (setq emerge-combine-versions-template (buffer-substring start end))
-  (message
-   (if (assq 'emerge-combine-versions-template (buffer-local-variables))
-       "emerge-set-combine-versions-template set locally."
-     "emerge-set-combine-versions-template set.")))
-
-(defun emerge-combine-versions (&optional force)
-  "Combine versions using the template in `emerge-combine-versions-template'.
-Refuses to function if this difference has been edited, i.e., if it is
-neither the A nor the B variant.
-An argument forces the variant to be selected even if the difference has
-been edited."
-  (interactive "P")
-  (emerge-combine-versions-internal emerge-combine-versions-template force))
-
-(defun emerge-combine-versions-register (char &optional force)
-  "Combine the two versions using the template in register REG.
-See documentation of the variable `emerge-combine-versions-template'
-for how the template is interpreted.
-Refuses to function if this difference has been edited, i.e., if it is
-neither the A nor the B variant.
-An argument forces the variant to be selected even if the difference has
-been edited."
-  (interactive "cRegister containing template: \nP")
-  (let ((template (get-register char)))
-    (if (not (stringp template))
-	(error "Register does not contain text"))
-    (emerge-combine-versions-internal template force)))
-
-(defun emerge-combine-versions-internal (template force)
-  (let ((operate
-	 (function (lambda ()
-		     (emerge-combine-versions-edit merge-begin merge-end
-						   A-begin A-end B-begin B-end)
-		     (if emerge-auto-advance
-			 (emerge-next-difference))))))
-    (emerge-select-version force operate operate operate)))
-
-(defun emerge-combine-versions-edit (merge-begin merge-end
-				     A-begin A-end B-begin B-end)
-  (emerge-eval-in-buffer
-   emerge-merge-buffer
-   (delete-region merge-begin merge-end)
-   (goto-char merge-begin)
-   (let ((i 0))
-     (while (< i (length template))
-       (let ((c (aref template i)))
-	 (if (= c ?%)
-	     (progn
-	       (setq i (1+ i))
-	       (setq c 
-		     (condition-case nil
-			 (aref template i)
-		       (error ?%)))
-	       (cond ((= c ?a)
-		      (insert-buffer-substring emerge-A-buffer A-begin A-end))
-		     ((= c ?b) 
-		      (insert-buffer-substring emerge-B-buffer B-begin B-end))
-		     ((= c ?%) 
-		      (insert ?%))
-		     (t
-		      (insert c))))
-	   (insert c)))
-       (setq i (1+ i))))
-   (goto-char merge-begin)
-   (aset diff-vector 6 'combined)
-   (emerge-refresh-mode-line)))
-
-(defun emerge-set-merge-mode (mode)
-  "Set the major mode in a merge buffer.
-Overrides any change that the mode might make to the mode line or local
-keymap.  Leaves merge in fast mode."
-  (interactive
-   (list (intern (completing-read "New major mode for merge buffer: "
-				  obarray 'commandp t nil))))
-  (funcall mode)
-  (emerge-refresh-mode-line)
-  (if emerge-fast-mode
-      (emerge-fast-mode)
-    (emerge-edit-mode)))
-
-(defun emerge-one-line-window ()
-  (interactive)
-  (let ((window-min-height 1))
-    (shrink-window (- (window-height) 2))))
-
-;;; Support routines
-
-;; Select a difference by placing the visual flags around the appropriate
-;; group of lines in the A, B, and merge buffers
-(defun emerge-select-difference (n)
-  (let ((emerge-globalized-difference-list emerge-difference-list)
-	(emerge-globalized-number-of-differences emerge-number-of-differences))
-    (emerge-place-flags-in-buffer emerge-A-buffer n 0 1)
-    (emerge-place-flags-in-buffer emerge-B-buffer n 2 3)
-    (emerge-place-flags-in-buffer nil n 4 5))
-  (run-hooks 'emerge-select-hook))
-
-(defun emerge-place-flags-in-buffer (buffer difference before-index
-					    after-index)
-  (if buffer
-      (emerge-eval-in-buffer
-       buffer
-       (emerge-place-flags-in-buffer1 difference before-index after-index))
-    (emerge-place-flags-in-buffer1 difference before-index after-index)))
-
-(defun emerge-place-flags-in-buffer1 (difference before-index after-index)
-  (let ((buffer-read-only nil))
-    ;; insert the flag before the difference
-    (let ((before (aref (aref emerge-globalized-difference-list difference)
-			before-index))
-	  here)
-      (goto-char before)
-      ;; insert the flag itself
-      (insert-before-markers emerge-before-flag)
-      (setq here (point))
-      ;; Put the marker(s) referring to this position 1 character before the
-      ;; end of the flag, so it won't be damaged by the user.
-      ;; This gets a bit tricky, as there could be a number of markers
-      ;; that have to be moved.
-      (set-marker before (1- before))
-      (let ((n (1- difference)) after-marker before-marker diff-list)
-	(while (and
-		(>= n 0)
-		(progn
-		  (setq diff-list (aref emerge-globalized-difference-list n)
-			after-marker (aref diff-list after-index))
-		  (= after-marker here)))
-	  (set-marker after-marker (1- after-marker))
-	  (setq before-marker (aref diff-list before-index))
-	  (if (= before-marker here)
-	      (setq before-marker (1- before-marker)))
-	  (setq n (1- n)))))
-    ;; insert the flag after the difference
-    (let* ((after (aref (aref emerge-globalized-difference-list difference)
-			after-index))
-	   (here (marker-position after)))
-      (goto-char here)
-      ;; insert the flag itself
-      (insert emerge-after-flag)
-      ;; Put the marker(s) referring to this position 1 character after the
-      ;; beginning of the flag, so it won't be damaged by the user.
-      ;; This gets a bit tricky, as there could be a number of markers
-      ;; that have to be moved.
-      (set-marker after (1+ after))
-      (let ((n (1+ difference)) before-marker after-marker diff-list)
-	(while (and
-		(< n emerge-globalized-number-of-differences)
-		(progn
-		  (setq diff-list (aref emerge-globalized-difference-list n)
-			before-marker (aref diff-list before-index))
-		  (= before-marker here)))
-	  (set-marker before-marker (1+ before-marker))
-	  (setq after-marker (aref diff-list after-index))
-	  (if (= after-marker here)
-	      (setq after-marker (1+ after-marker)))
-	  (setq n (1+ n)))))))
-
-;; Unselect a difference by removing the visual flags in the buffers.
-(defun emerge-unselect-difference (n)
-  (let ((diff-vector (aref emerge-difference-list n)))
-    (emerge-remove-flags-in-buffer emerge-A-buffer
-				   (aref diff-vector 0) (aref diff-vector 1))
-    (emerge-remove-flags-in-buffer emerge-B-buffer
-				   (aref diff-vector 2) (aref diff-vector 3))
-    (emerge-remove-flags-in-buffer emerge-merge-buffer
-				   (aref diff-vector 4) (aref diff-vector 5)))
-  (run-hooks 'emerge-unselect-hook))
-
-(defun emerge-remove-flags-in-buffer (buffer before after)
-  (emerge-eval-in-buffer
-   buffer
-   (let ((buffer-read-only nil))
-     ;; remove the flags, if they're there
-     (goto-char (- before (1- emerge-before-flag-length)))
-     (if (looking-at emerge-before-flag-match)
-	 (delete-char emerge-before-flag-length)
-       ;; the flag isn't there
-       (ding)
-       (message "Trouble removing flag"))
-     (goto-char (1- after))
-     (if (looking-at emerge-after-flag-match)
-	 (delete-char emerge-after-flag-length)
-       ;; the flag isn't there
-       (ding)
-       (message "Trouble removing flag")))))
-
-;; Select a difference, removing any flags that exist now.
-(defun emerge-unselect-and-select-difference (n &optional suppress-display)
-  (if (and (>= emerge-current-difference 0)
-	   (< emerge-current-difference emerge-number-of-differences))
-      (emerge-unselect-difference emerge-current-difference))
-  (if (and (>= n 0) (< n emerge-number-of-differences))
-      (progn
-	(emerge-select-difference n)
-	(let* ((diff-vector (aref emerge-difference-list n))
-	       (selection-type (aref diff-vector 6)))
-	  (if (eq selection-type 'default-A)
-	      (aset diff-vector 6 'A)
-	    (if (eq selection-type 'default-B)
-		(aset diff-vector 6 'B))))))
-  (setq emerge-current-difference n)
-  (if (not suppress-display)
-      (progn
-	(emerge-recenter)
-	(emerge-refresh-mode-line))))
-
-;; Perform tests to see whether user should be allowed to select a version
-;; of this difference:
-;;   a valid difference has been selected; and
-;;   the difference text in the merge buffer is:
-;;     the A version (execute a-version), or
-;;     the B version (execute b-version), or
-;;     empty (execute neither-version), or
-;;     argument FORCE is true (execute neither-version)
-;; Otherwise, signal an error.
-(defun emerge-select-version (force a-version b-version neither-version)
-  (emerge-validate-difference)
-  (let ((buffer-read-only nil))
-    (let* ((diff-vector
-	    (aref emerge-difference-list emerge-current-difference))
-	   (A-begin (1+ (aref diff-vector 0)))
-	   (A-end (1- (aref diff-vector 1)))
-	   (B-begin (1+ (aref diff-vector 2)))
-	   (B-end (1- (aref diff-vector 3)))
-	   (merge-begin (1+ (aref diff-vector 4)))
-	   (merge-end (1- (aref diff-vector 5))))
-      (if (emerge-compare-buffers emerge-A-buffer A-begin A-end
-				  emerge-merge-buffer merge-begin
-				  merge-end)
-	  (funcall a-version)
-	(if (emerge-compare-buffers emerge-B-buffer B-begin B-end
-				    emerge-merge-buffer merge-begin
-				    merge-end)
-	    (funcall b-version)
-	  (if (or force (= merge-begin merge-end))
-	      (funcall neither-version)
-	    (error "This difference region has been edited")))))))
-
-;; Read a file name, handling all of the various defaulting rules.
-
-(defun emerge-read-file-name (prompt alternative-default-dir default-file
-			      A-file must-match)
-  ;; `prompt' should not have trailing ": ", so that it can be modified
-  ;; according to context.
-  ;; If alternative-default-dir is non-nil, it should be used as the default
-  ;; directory instead if default-directory, if emerge-default-last-directories
-  ;; is set.
-  ;; If default-file is set, it should be used as the default value.
-  ;; If A-file is set, and its directory is different from
-  ;; alternative-default-dir, and if emerge-default-last-directories is set,
-  ;; the default file should be the last part of A-file in the default
-  ;; directory.  (Overriding default-file.)
-  (cond
-   ;; If this is not the A-file argument (shown by non-nil A-file), and
-   ;; if emerge-default-last-directories is set, and
-   ;; the default directory exists but is not the same as the directory of the
-   ;; A-file,
-   ;; then make the default file have the same name as the A-file, but in
-   ;; the default directory.
-   ((and emerge-default-last-directories
-	 A-file
-	 alternative-default-dir
-	 (not (string-equal alternative-default-dir
-			    (file-name-directory A-file))))
-    (read-file-name (format "%s (default %s): "
-			    prompt (file-name-nondirectory A-file))
-		    alternative-default-dir
-		    (concat alternative-default-dir
-			    (file-name-nondirectory A-file))
-		    (and must-match 'confirm)))
-   ;; If there is a default file, use it.
-   (default-file
-     (read-file-name (format "%s (default %s): " prompt default-file)
-		     ;; If emerge-default-last-directories is set, use the
-		     ;; directory from the same argument of the last call of
-		     ;; Emerge as the default for this argument.
-		     (and emerge-default-last-directories
-			  alternative-default-dir)
-		     default-file (and must-match 'confirm)))
-   (t
-    (read-file-name (concat prompt ": ")
-		    ;; If emerge-default-last-directories is set, use the
-		    ;; directory from the same argument of the last call of
-		    ;; Emerge as the default for this argument.
-		    (and emerge-default-last-directories
-			 alternative-default-dir)
-		    nil (and must-match 'confirm)))))
-
-;; Revise the mode line to display which difference we have selected
-
-(defun emerge-refresh-mode-line ()
-  (setq mode-line-buffer-identification
-	(list (format "Emerge: %%b   diff %d of %d%s"
-		      (1+ emerge-current-difference)
-		      emerge-number-of-differences
-		      (if (and (>= emerge-current-difference 0)
-			       (< emerge-current-difference
-				  emerge-number-of-differences))
-			  (cdr (assq (aref (aref emerge-difference-list
-						 emerge-current-difference)
-					   6)
-				     '((A . " - A")
-				       (B . " - B")
-				       (prefer-A . " - A*")
-				       (prefer-B . " - B*")
-				       (combined . " - comb"))))
-			""))))
-  (force-mode-line-update))
-
-;; compare two regions in two buffers for containing the same text
-(defun emerge-compare-buffers (buffer-x x-begin x-end buffer-y y-begin y-end)
-  ;; first check that the two regions are the same length
-  (if (not (and (= (- x-end x-begin) (- y-end y-begin))))
-      nil
-    (catch 'exit
-      (while (< x-begin x-end)
-	;; bite off and compare no more than 1000 characters at a time
-	(let* ((compare-length (min (- x-end x-begin) 1000))
-	       (x-string (emerge-eval-in-buffer 
-			  buffer-x
-			  (buffer-substring x-begin
-					    (+ x-begin compare-length))))
-	       (y-string (emerge-eval-in-buffer
-			  buffer-y
-			  (buffer-substring y-begin
-					    (+ y-begin compare-length)))))
-	  (if (not (string-equal x-string y-string))
-	      (throw 'exit nil)
-	    (setq x-begin (+ x-begin compare-length))
-	    (setq y-begin (+ y-begin compare-length)))))
-      t)))
-
-;; Construct a unique buffer name.
-;; The first one tried is prefixsuffix, then prefix<2>suffix, 
-;; prefix<3>suffix, etc.
-(defun emerge-unique-buffer-name (prefix suffix)
-  (if (null (get-buffer (concat prefix suffix)))
-      (concat prefix suffix)
-    (let ((n 2))
-      (while (get-buffer (format "%s<%d>%s" prefix n suffix))
-	(setq n (1+ n)))
-      (format "%s<%d>%s" prefix n suffix))))
-
-;; Verify that we have a difference selected.
-(defun emerge-validate-difference ()
-  (if (not (and (>= emerge-current-difference 0)
-		(< emerge-current-difference emerge-number-of-differences)))
-      (error "No difference selected")))
-
-;;; Functions for saving and restoring a batch of variables
-
-;; These functions save (get the values of) and restore (set the values of)
-;; a list of variables.  The argument is a list of symbols (the names of
-;; the variables).  A list element can also be a list of two functions,
-;; the first of which (when called with no arguments) gets the value, and
-;; the second (when called with a value as an argument) sets the value.
-;; A "function" is anything that funcall can handle as an argument.
-
-(defun emerge-save-variables (vars)
-  (mapcar (function (lambda (v) (if (symbolp v)
-				    (symbol-value v)
-				  (funcall (car v)))))
-	  vars))
-
-(defun emerge-restore-variables (vars values)
-  (while vars
-    (let ((var (car vars))
-	  (value (car values)))
-      (if (symbolp var)
-	  (set var value)
-	(funcall (car (cdr var)) value)))
-    (setq vars (cdr vars))
-    (setq values (cdr values))))
-
-;; Make a temporary file that only we have access to.
-;; PREFIX is appended to emerge-temp-file-prefix to make the filename prefix.
-(defun emerge-make-temp-file (prefix)
-  (let ((f (make-temp-name (concat emerge-temp-file-prefix prefix))))
-    ;; create the file
-    (write-region (point-min) (point-min) f nil 'no-message)
-    (set-file-modes f emerge-temp-file-mode)
-    f))
-
-;;; Functions that query the user before he can write out the current buffer.
-
-(defun emerge-query-write-file ()
-  "Ask the user whether to write out an incomplete merge.
-If answer is yes, call `write-file' to do so.  See `emerge-query-and-call'
-for details of the querying process."
-  (interactive)
-  (emerge-query-and-call 'write-file))
-
-(defun emerge-query-save-buffer ()
-  "Ask the user whether to save an incomplete merge.
-If answer is yes, call `save-buffer' to do so.  See `emerge-query-and-call'
-for details of the querying process."
-  (interactive)
-  (emerge-query-and-call 'save-buffer))
-
-(defun emerge-query-and-call (command)
-  "Ask the user whether to save or write out the incomplete merge.
-If answer is yes, call COMMAND interactively.  During the call, the flags
-around the current difference are removed."
-  (if (yes-or-no-p "Do you really write to write out this unfinished merge? ")
-      ;; He really wants to do it -- unselect the difference for the duration
-      (progn
-	(if (and (>= emerge-current-difference 0)
-		 (< emerge-current-difference emerge-number-of-differences))
-	    (emerge-unselect-difference emerge-current-difference))
-	;; call-interactively takes the value of current-prefix-arg as the
-	;; prefix argument value to be passed to the command.  Thus, we have
-	;; to do nothing special to make sure the prefix argument is
-	;; transmitted to the command.
-	(call-interactively command)
-	(if (and (>= emerge-current-difference 0)
-		 (< emerge-current-difference emerge-number-of-differences))
-	    (progn
-	      (emerge-select-difference emerge-current-difference)
-	      (emerge-recenter))))
-    ;; He's being smart and not doing it
-    (message "Not written")))
-
-;; Make sure the current buffer (for a file) has the same contents as the
-;; file on disk, and attempt to remedy the situation if not.
-;; Signal an error if we can't make them the same, or the user doesn't want
-;; to do what is necessary to make them the same.
-(defun emerge-verify-file-buffer ()
-  ;; First check if the file has been modified since the buffer visited it.
-  (if (verify-visited-file-modtime (current-buffer))
-      (if (buffer-modified-p)
-	  ;; If buffer is not obsolete and is modified, offer to save
-	  (if (yes-or-no-p (format "Save file %s? " buffer-file-name))
-	      (save-buffer)
-	    (error "Buffer out of sync for file %s" buffer-file-name))
-	;; If buffer is not obsolete and is not modified, do nothing
-	nil)
-    (if (buffer-modified-p)
-	;; If buffer is obsolete and is modified, give error
-	(error "Buffer out of sync for file %s" buffer-file-name)
-      ;; If buffer is obsolete and is not modified, offer to revert
-      (if (yes-or-no-p (format "Revert file %s? " buffer-file-name))
-	      (revert-buffer t t)
-	(error "Buffer out of sync for file %s" buffer-file-name)))))
-
-;; Utilities that might have value outside of Emerge.
-
-;; Set up the mode in the current buffer to duplicate the mode in another
-;; buffer.
-(defun emerge-copy-modes (buffer)
-  ;; Set the major mode
-  (funcall (emerge-eval-in-buffer buffer major-mode)))
-
-;; Define a key, even if a prefix of it is defined
-(defun emerge-force-define-key (keymap key definition)
-  "Like `define-key', but forcibly creates prefix characters as needed.
-If some prefix of KEY has a non-prefix definition, it is redefined."
-  ;; Find out if a prefix of key is defined
-  (let ((v (lookup-key keymap key)))
-    ;; If so, undefine it
-    (if (integerp v)
-	(define-key keymap (substring key 0 v) nil)))
-  ;; Now define the key
-  (define-key keymap key definition))
-
-;;;;; Improvements to describe-mode, so that it describes minor modes as well
-;;;;; as the major mode
-;;(defun describe-mode (&optional minor)
-;;  "Display documentation of current major mode.
-;;If optional arg MINOR is non-nil (or prefix argument is given if interactive),
-;;display documentation of active minor modes as well.
-;;For this to work correctly for a minor mode, the mode's indicator variable
-;;\(listed in `minor-mode-alist') must also be a function whose documentation
-;;describes the minor mode."
-;;  (interactive)
-;;  (with-output-to-temp-buffer "*Help*"
-;;    (princ mode-name)
-;;    (princ " Mode:\n")
-;;    (princ (documentation major-mode))
-;;    (let ((minor-modes minor-mode-alist)
-;;	  (locals (buffer-local-variables)))
-;;      (while minor-modes
-;;	(let* ((minor-mode (car (car minor-modes)))
-;;	       (indicator (car (cdr (car minor-modes))))
-;;	       (local-binding (assq minor-mode locals)))
-;;	  ;; Document a minor mode if it is listed in minor-mode-alist,
-;;	  ;; bound locally in this buffer, non-nil, and has a function
-;;	  ;; definition.
-;;	  (if (and local-binding
-;;		   (cdr local-binding)
-;;		   (fboundp minor-mode))
-;;	      (progn
-;;		(princ (format "\n\n\n%s minor mode (indicator%s):\n"
-;;			       minor-mode indicator))
-;;		(princ (documentation minor-mode)))))
-;;	(setq minor-modes (cdr minor-modes))))
-;;    (save-excursion
-;;      (set-buffer standard-output)
-;;      (help-mode))
-;;    (print-help-return-message)))
-
-;; This goes with the redefinition of describe-mode.
-;;;; Adjust things so that keyboard macro definitions are documented correctly.
-;;(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
-
-;; substitute-key-definition should work now.
-;;;; Function to shadow a definition in a keymap with definitions in another.
-;;(defun emerge-shadow-key-definition (olddef newdef keymap shadowmap)
-;;  "Shadow OLDDEF with NEWDEF for any keys in KEYMAP with entries in SHADOWMAP.
-;;In other words, SHADOWMAP will now shadow all definitions of OLDDEF in KEYMAP
-;;with NEWDEF.  Does not affect keys that are already defined in SHADOWMAP,
-;;including those whose definition is OLDDEF."
-;;  ;; loop through all keymaps accessible from keymap
-;;  (let ((maps (accessible-keymaps keymap)))
-;;    (while maps
-;;      (let ((prefix (car (car maps)))
-;;	    (map (cdr (car maps))))
-;;	;; examine a keymap
-;;	(if (arrayp map)
-;;	    ;; array keymap
-;;	    (let ((len (length map))
-;;		  (i 0))
-;;	      (while (< i len)
-;;		(if (eq (aref map i) olddef)
-;;		    ;; set the shadowing definition
-;;		    (let ((key (concat prefix (char-to-string i))))
-;;		      (emerge-define-key-if-possible shadowmap key newdef)))
-;;		(setq i (1+ i))))
-;;	  ;; sparse keymap
-;;	  (while map
-;;	    (if (eq (cdr-safe (car-safe map)) olddef)
-;;		;; set the shadowing definition
-;;		(let ((key
-;;		       (concat prefix (char-to-string (car (car map))))))
-;;		      (emerge-define-key-if-possible shadowmap key newdef)))
-;;	    (setq map (cdr map)))))
-;;      (setq maps (cdr maps)))))
-
-;; Define a key if it (or a prefix) is not already defined in the map.
-(defun emerge-define-key-if-possible (keymap key definition)
-  ;; look up the present definition of the key
-  (let ((present (lookup-key keymap key)))
-    (if (integerp present)
-	;; if it is "too long", look up the valid prefix
-	(if (not (lookup-key keymap (substring key 0 present)))
-	    ;; if the prefix isn't defined, define it
-	    (define-key keymap key definition))
-      ;; if there is no present definition, define it
-      (if (not present)
-	  (define-key keymap key definition)))))
-
-;; Ordinary substitute-key-definition should do this now.
-;;(defun emerge-recursively-substitute-key-definition (olddef newdef keymap)
-;;  "Like `substitute-key-definition', but act recursively on subkeymaps.
-;;Make sure that subordinate keymaps aren't shared with other keymaps!
-;;\(`copy-keymap' will suffice.)"
-;;  ;; Loop through all keymaps accessible from keymap
-;;  (let ((maps (accessible-keymaps keymap)))
-;;    (while maps
-;;      ;; Substitute in this keymap
-;;      (substitute-key-definition olddef newdef (cdr (car maps)))
-;;      (setq maps (cdr maps)))))
-
-;; Show the name of the file in the buffer.
-(defun emerge-show-file-name ()
-  "Displays the name of the file loaded into the current buffer.
-If the name won't fit on one line, the minibuffer is expanded to hold it,
-and the command waits for a keystroke from the user.  If the keystroke is
-SPC, it is ignored; if it is anything else, it is processed as a command."
-  (interactive)
-  (let ((name (buffer-file-name)))
-    (or name
-	(setq name "Buffer has no file name."))
-    (save-window-excursion
-      (select-window (minibuffer-window))
-      (erase-buffer)
-      (insert name)
-      (if (not (pos-visible-in-window-p))
-	  (let ((echo-keystrokes 0))
-	    (while (and (not (pos-visible-in-window-p))
-			(> (1- (screen-height)) (window-height)))
-	      (enlarge-window 1))
-	    (let ((c (read-event)))
-	      (if (not (eq c 32))
-		  (setq unread-command-events (list c)))))))))
-
-;; Improved auto-save file names.
-;; This function fixes many problems with the standard auto-save file names:
-;; Auto-save files for non-file buffers get put in the default directory
-;; for the buffer, whether that makes sense or not.
-;; Auto-save files for file buffers get put in the directory of the file,
-;; regardless of whether we can write into it or not.
-;; Auto-save files for non-file buffers don't use the process id, so if a
-;; user runs more than on Emacs, they can make auto-save files that overwrite
-;; each other.
-;; To use this function, do:
-;;	(fset 'make-auto-save-file-name
-;;	      (symbol-function 'emerge-make-auto-save-file-name))
-(defun emerge-make-auto-save-file-name ()
-  "Return file name to use for auto-saves of current buffer.
-Does not consider `auto-save-visited-file-name';
-that is checked before calling this function.
-You can redefine this for customization.
-See also `auto-save-file-name-p'."
-  (if buffer-file-name
-      ;; if buffer has a file, try the format <file directory>/#<file name>#
-      (let ((f (concat (file-name-directory buffer-file-name)
-		       "#"
-		       (file-name-nondirectory buffer-file-name)
-		       "#")))
-	(if (file-writable-p f)
-	    ;; the file is writable, so use it
-	    f
-	  ;; the file isn't writable, so use the format
-	  ;; ~/#&<file name>&<hash of directory>#
-	  (concat (getenv "HOME")
-		  "/#&"
-		  (file-name-nondirectory buffer-file-name)
-		  "&"
-		  (emerge-hash-string-into-string
-		   (file-name-directory buffer-file-name))
-		  "#")))
-    ;; if buffer has no file, use the format ~/#%<buffer name>%<process id>#
-    (expand-file-name (concat (getenv "HOME")
-			      "/#%"
-			      ;; quote / into \! and \ into \\
-			      (emerge-unslashify-name (buffer-name))
-			      "%"
-			      (make-temp-name "")
-			      "#"))))
-
-;; Hash a string into five characters more-or-less suitable for use in a file
-;; name.  (Allowed characters are ! through ~, except /.)
-(defun emerge-hash-string-into-string (s)
-  (let ((bins (vector 0 0 0 0 0))
-	(i 0))
-    (while (< i (length s))
-      (aset bins (% i 5) (% (+ (* (aref bins (% i 5)) 35)
-			       (aref s i))
-			    65536))
-      (setq i (1+ i)))
-    (mapconcat (function (lambda (b)
-			   (setq b (+ (% b 93) ?!))
-			   (if (>= b ?/)
-			       (setq b (1+ b)))
-			   (char-to-string b)))
-	       bins "")))
-
-;; Quote any /s in a string by replacing them with \!.
-;; Also, replace any \s by \\, to make it one-to-one.
-(defun emerge-unslashify-name (s)
-  (let ((limit 0))
-    (while (string-match "[/\\]" s limit)
-      (setq s (concat (substring s 0 (match-beginning 0))
-		      (if (string= (substring s (match-beginning 0)
-					      (match-end 0))
-				   "/")
-			  "\\!"
-			"\\\\")
-		      (substring s (match-end 0))))
-      (setq limit (1+ (match-end 0)))))
-  s)
-
-;; Metacharacters that have to be protected from the shell when executing
-;; a diff/diff3 command.
-(defvar emerge-metachars "[ \t\n!\"#$&'()*;<=>?[\\^`{|~]"
-  "Characters that must be quoted with \\ when used in a shell command line.
-More precisely, a [...] regexp to match any one such character.")
-
-;; Quote metacharacters (using \) when executing a diff/diff3 command.
-(defun emerge-protect-metachars (s)
-  (let ((limit 0))
-    (while (string-match emerge-metachars s limit)
-      (setq s (concat (substring s 0 (match-beginning 0))
-		      "\\"
-		      (substring s (match-beginning 0))))
-      (setq limit (1+ (match-end 0)))))
-  s)
-
-(provide 'emerge)
-
-;;; emerge.el ends here
diff --git a/lisp/emulation/edt-lk201.el b/lisp/emulation/edt-lk201.el
deleted file mode 100644
index 8695914579a..00000000000
--- a/lisp/emulation/edt-lk201.el
+++ /dev/null
@@ -1,55 +0,0 @@
-;;; edt-lk201.el --- Enhanced EDT Keypad Mode Emulation for LK-201 Keyboards
-
-;; Copyright (C) 1986, 1992, 1993, 1995 Free Software Foundation, Inc.
-
-;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com>
-;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com>
-;; Keywords: emulations
-
-;; 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.
-
-;;; Usage:
-
-;;  See edt-user.doc in the Emacs etc directory.
-
-;; ====================================================================
-
-;;;;
-;;;; KEY TRANSLATIONS
-;;;;
-
-;; Associate EDT keynames with Emacs terminal function vector names.
-;; (Function key vector names for LK-201 are found in lisp/term/lk201.el.)
-;;
-;; F1 - F5 are not available on many DEC VT series terminals.
-;; However, this is not always the case.  So support for F1 - F5 is
-;; provided here and in lisp/term/lk201.el.
-(defconst *EDT-keys*
-  '(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3]) 
-    ("KP4" . [kp-4]) ("KP5" . [kp-5]) ("KP6" . [kp-6]) ("KP7" . [kp-7])
-    ("KP8" . [kp-8]) ("KP9" . [kp-9]) ("KP," . [kp-separator])
-    ("KP-" . [kp-subtract]) ("KPP" . [kp-decimal]) ("KPE" . [kp-enter])
-    ("PF1" . [kp-f1]) ("PF2" . [kp-f2]) ("PF3" . [kp-f3]) ("PF4" . [kp-f4])
-    ("UP" . [up]) ("DOWN" . [down]) ("RIGHT" . [right]) ("LEFT" . [left])
-    ("FIND" . [find]) ("INSERT" . [insert]) ("REMOVE" . [delete])
-    ("SELECT" . [select]) ("PREVIOUS" . [prior]) ("NEXT" . [next])
-    ("F1" . [f1]) ("F2" . [f2]) ("F3" . [f3]) ("F4" . [f4]) ("F5" . [f5])
-    ("F6" . [f6]) ("F7" . [f7]) ("F8" . [f8]) ("F9" . [f9]) ("F10" . [f10])
-    ("F11" . [f11]) ("F12" . [f12]) ("F13" . [f13]) ("F14" . [f14])
-    ("HELP" . [help]) ("DO" . [menu]) ("F17" . [f17]) ("F18" . [f18])
-    ("F19" . [f19]) ("F20" . [f20])))
diff --git a/lisp/emulation/edt-mapper.el b/lisp/emulation/edt-mapper.el
deleted file mode 100644
index ebebb92ad25..00000000000
--- a/lisp/emulation/edt-mapper.el
+++ /dev/null
@@ -1,405 +0,0 @@
-;;; edt-mapper.el --- Create an EDT LK-201 Map File for X-Windows Emacs
-
-;; Copyright (C) 1994, 1995  Free Software Foundation, Inc.
-
-;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com>
-;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com>
-;; Keywords: emulations
-
-;; 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 emacs lisp program can be used to create an emacs lisp file
-;;  that defines the mapping of the user's keyboard under X-Windows to
-;;  the LK-201 keyboard function keys and keypad keys (around which
-;;  EDT has been designed).  Please read the "Usage" AND "Known
-;;  Problems" sections before attempting to run this program.  (The
-;;  design of this file, edt-mapper.el, was heavily influenced by
-;;  tpu-mapper.el.) 
-
-;;; Usage:
-
-;;  Simply load this file into the X-Windows version of emacs (version 19)
-;;  using the following command.
-
-;;    emacs -q -l edt-mapper.el
-
-;;  The "-q" option prevents loading of your .emacs file (commands therein
-;;  might confuse this program).
-
-;;  An instruction screen showing the typical LK-201 terminal functions keys
-;;  will be displayed, and you will be prompted to press the keys on your
-;;  keyboard which you want to emulate the corresponding LK-201 keys.
-
-;;  Finally, you will be prompted for the name of the file to store
-;;  the key definitions.  If you chose the default, it will be found
-;;  and loaded automatically when the EDT emulation is started.  If
-;;  you specify a different file name, you will need to set the
-;;  variable "edt-xkeys-file" before starting the EDT emulation.
-;;  Here's how you might go about doing that in your .emacs file.
-
-;;    (setq edt-xkeys-file (expand-file-name "~/.my-emacs-x-keys"))
-
-;;; Known Problems:
-
-;;  Sometimes, edt-mapper will ignore a key you press, and just continue to
-;;  prompt for the same key.  This can happen when your window manager sucks
-;;  up the key and doesn't pass it on to emacs, or it could be an emacs bug.
-;;  Either way, there's nothing that edt-mapper can do about it.  You must
-;;  press RETURN, to skip the current key and continue.  Later, you and/or
-;;  your local X guru can try to figure out why the key is being ignored.
-
-;; ====================================================================
-
-;;;
-;;;  Make sure we're running X-windows and Emacs version 19
-;;;
-(cond
- ((not (and window-system (not (string-lessp emacs-version "19"))))
-  (insert "
-
-    Whoa!  This isn't going to work...
-
-    You must run edt-mapper.el under X-windows and Emacs version 19.
-
-    Press any key to exit.  ")
-  (sit-for 600)
-  (kill-emacs t)))
-
-
-;;;
-;;;  Decide whether we're running GNU or Lucid emacs.
-;;;
-(defconst edt-lucid-emacs19-p (string-match "Lucid" emacs-version)
-  "Non-NIL if we are running Lucid Emacs version 19.")
-
-
-;;;
-;;;  Key variables
-;;;
-(defvar edt-key nil)
-(defvar edt-enter nil)
-(defvar edt-return nil)
-(defvar edt-key-seq nil)
-(defvar edt-enter-seq nil)
-(defvar edt-return-seq nil)
-
-
-;;;
-;;;  Make sure the window is big enough to display the instructions
-;;;
-(if edt-lucid-emacs19-p (set-screen-size nil 80 36)
-  (set-frame-size (selected-frame) 80 36))
-
-
-;;;
-;;;  Create buffers - Directions and Keys
-;;;
-(if (not (get-buffer "Directions")) (generate-new-buffer "Directions"))
-(if (not (get-buffer "Keys")) (generate-new-buffer "Keys"))
-
-;;;
-;;;  Put header in the Keys buffer
-;;;
-(set-buffer "Keys")
-(insert "\
-;;
-;;  Key definitions for the EDT emulation within GNU Emacs
-;;
-
-(defconst *EDT-keys*
-  '(
-")
-
-;;;
-;;;   Display directions
-;;;
-(switch-to-buffer "Directions")
-(insert "
-                                  EDT MAPPER
-
-    You will be asked to press keys to create a custom mapping (under
-    X-Windows) of your keypad keys and function keys so that they can emulate
-    the LK-201 keypad and function keys or the subset of keys found on a 
-    VT-100 series terminal keyboard.  (The LK-201 keyboard is the standard
-    keyboard attached to VT-200 series terminals, and above.)  
-
-    Sometimes, edt-mapper will ignore a key you press, and just continue to
-    prompt for the same key.  This can happen when your window manager sucks
-    up the key and doesn't pass it on to emacs, or it could be an emacs bug.
-    Either way, there's nothing that edt-mapper can do about it.  You must
-    press RETURN, to skip the current key and continue.  Later, you and/or
-    your local X guru can try to figure out why the key is being ignored.
-
-    Start by pressing the RETURN key, and continue by pressing the keys
-    specified in the mini-buffer.  If you want to entirely omit a key, 
-    because your keyboard does not have a corresponding key, for example, 
-    just press RETURN at the prompt.
-
-")
-(delete-other-windows)
-
-;;;
-;;;  Save <CR> for future reference
-;;;
-(cond
- (edt-lucid-emacs19-p
-  (setq edt-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
-  (setq edt-return (concat "[" (format "%s" (event-key (aref edt-return-seq 0))) "]")))
- (t
-  (message "Hit carriage-return <CR> to continue ")
-  (setq edt-return-seq (read-event))
-  (setq edt-return (concat "[" (format "%s" edt-return-seq) "]")))) 
-
-;;;
-;;;   Display Keypad Diagram and Begin Prompting for Keys
-;;;
-(set-buffer "Directions")
-(delete-region (point-min) (point-max))
-(insert "
-
-
-
-          PRESS THE KEY SPECIFIED IN THE MINIBUFFER BELOW.
-
-
-
-
-    Here's a picture of the standard LK-201 keypad for reference:
-
-          _______________________    _______________________________
-         | HELP  |      DO       |  |  F17  |  F18  |  F19  |  F20  |
-         |       |               |  |       |       |       |       |
-         |_______|_______________|  |_______|_______|_______|_______|
-          _______________________    _______________________________
-         | FIND  |INSERT |REMOVE |  |  PF1  |  PF2  |  PF3  |  PF4  |
-         |       |       |       |  |       |       |       |       |
-         |_______|_______|_______|  |_______|_______|_______|_______|
-         |SELECT |PREVIOU| NEXT  |  |  KP7  |  KP8  |  KP9  |  KP-  |
-         |       |       |       |  |       |       |       |       |
-         |_______|_______|_______|  |_______|_______|_______|_______|
-                 |   UP  |          |  KP4  |  KP5  |  KP6  |  KP,  |
-                 |       |          |       |       |       |       |
-          _______|_______|_______   |_______|_______|_______|_______|
-         |  LEFT |  DOWN | RIGHT |  |  KP1  |  KP2  |  KP3  |       |
-         |       |       |       |  |       |       |       |       |
-         |_______|_______|_______|  |_______|_______|_______|  KPE  |
-                                    |      KP0      |  KPP  |       |
-                                    |               |       |       |
-                                    |_______________|_______|_______|
-
-")
-
-;;;
-;;;  Key mapping functions
-;;;
-(defun edt-lucid-map-key (ident descrip func gold-func)
-  (interactive)
-  (setq edt-key-seq (read-key-sequence (format "Press %s%s: " ident descrip)))
-  (setq edt-key (concat "[" (format "%s" (event-key (aref edt-key-seq 0))) "]"))
-  (cond ((not (equal edt-key edt-return))
-	 (set-buffer "Keys")
-	 (insert (format "    (\"%s\" . %s)\n" ident edt-key))
-	 (set-buffer "Directions"))
-	;; bogosity to get next prompt to come up, if the user hits <CR>!
-	;; check periodically to see if this is still needed...
-	(t
-	 (format "%s" edt-key)))
-  edt-key)
-
-(defun edt-gnu-map-key (ident descrip)
-  (interactive)
-  (message "Press %s%s: " ident descrip)
-  (setq edt-key-seq (read-event))
-  (setq edt-key (concat "[" (format "%s" edt-key-seq) "]"))
-  (cond ((not (equal edt-key edt-return))
-	 (set-buffer "Keys")
-	 (insert (format "    (\"%s\" . %s)\n" ident edt-key))
-	 (set-buffer "Directions"))
-	;; bogosity to get next prompt to come up, if the user hits <CR>!
-	;; check periodically to see if this is still needed...
-	(t
-	 (set-buffer "Keys")
-	 (insert (format "    (\"%s\" . \"\" )\n" ident))
-	 (set-buffer "Directions")))
-  edt-key)
-
-(fset 'edt-map-key (if edt-lucid-emacs19-p 'edt-lucid-map-key 'edt-gnu-map-key))
-(set-buffer "Keys")
-(insert "
-;;
-;;  Arrows
-;;
-")
-(set-buffer "Directions")
-
-(edt-map-key "UP"     " - The Up Arrow Key")
-(edt-map-key "DOWN"   " - The Down Arrow Key")
-(edt-map-key "LEFT"   " - The Left Arrow Key")
-(edt-map-key "RIGHT"  " - The Right Arrow Key")
-
-
-(set-buffer "Keys")
-(insert "
-;;
-;;  PF keys
-;;
-")
-(set-buffer "Directions")
-
-(edt-map-key "PF1"  " - The PF1 (GOLD) Key")
-(edt-map-key "PF2"  " - The Keypad PF2 Key")
-(edt-map-key "PF3"  " - The Keypad PF3 Key")
-(edt-map-key "PF4"  " - The Keypad PF4 Key")
-
-(set-buffer "Keys")
-(insert "
-;;
-;;  KP0-9 KP- KP, KPP and KPE
-;;
-")
-(set-buffer "Directions")
-
-(edt-map-key "KP0"      " - The Keypad 0 Key")
-(edt-map-key "KP1"      " - The Keypad 1 Key")
-(edt-map-key "KP2"      " - The Keypad 2 Key")
-(edt-map-key "KP3"      " - The Keypad 3 Key")
-(edt-map-key "KP4"      " - The Keypad 4 Key")
-(edt-map-key "KP5"      " - The Keypad 5 Key")
-(edt-map-key "KP6"      " - The Keypad 6 Key")
-(edt-map-key "KP7"      " - The Keypad 7 Key")
-(edt-map-key "KP8"      " - The Keypad 8 Key")
-(edt-map-key "KP9"      " - The Keypad 9 Key")
-(edt-map-key "KP-"      " - The Keypad - Key")
-(edt-map-key "KP,"      " - The Keypad , Key")
-(edt-map-key "KPP"      " - The Keypad . Key")
-(edt-map-key "KPE"      " - The Keypad Enter Key")
-;; Save the enter key
-(setq edt-enter edt-key)
-(setq edt-enter-seq edt-key-seq)
-
-
-(set-buffer "Keys")
-(insert "
-;;
-;;  Editing keypad (FIND, INSERT, REMOVE)
-;;                 (SELECT, PREVIOUS, NEXT)
-;;
-")
-(set-buffer "Directions")
-
-(edt-map-key "FIND"      " - The Find key on the editing keypad")
-(edt-map-key "INSERT"    " - The Insert key on the editing keypad")
-(edt-map-key "REMOVE"    " - The Remove key on the editing keypad")
-(edt-map-key "SELECT"    " - The Select key on the editing keypad")
-(edt-map-key "PREVIOUS"  " - The Prev Scr key on the editing keypad")
-(edt-map-key "NEXT"      " - The Next Scr key on the editing keypad")
-
-(set-buffer "Keys")
-(insert "
-;;
-;;  F1-14 Help Do F17-F20
-;;
-")
-(set-buffer "Directions")
-
-(edt-map-key "F1"        " - F1 Function Key")
-(edt-map-key "F2"        " - F2 Function Key")
-(edt-map-key "F3"        " - F3 Function Key")
-(edt-map-key "F4"        " - F4 Function Key")
-(edt-map-key "F5"        " - F5 Function Key")
-(edt-map-key "F6"        " - F6 Function Key")
-(edt-map-key "F7"        " - F7 Function Key")
-(edt-map-key "F8"        " - F8 Function Key")
-(edt-map-key "F9"        " - F9 Function Key")
-(edt-map-key "F10"       " - F10 Function Key")
-(edt-map-key "F11"       " - F11 Function Key")
-(edt-map-key "F12"       " - F12 Function Key")
-(edt-map-key "F13"       " - F13 Function Key")
-(edt-map-key "F14"       " - F14 Function Key")
-(edt-map-key "HELP"      " - HELP Function Key")
-(edt-map-key "DO"        " - DO Function Key")
-(edt-map-key "F17"       " - F17 Function Key")
-(edt-map-key "F18"       " - F18 Function Key")
-(edt-map-key "F19"       " - F19 Function Key")
-(edt-map-key "F20"       " - F20 Function Key")
-
-(set-buffer "Directions")
-(delete-region (point-min) (point-max))
-(insert "
-		       ADDITIONAL FUNCTION KEYS
-
-    Your keyboard may have additional function keys which do not
-    correspond to any LK-201 keys.  The EDT Emulation can be
-    configured to recognize those keys, since you may wish to add your
-    own key bindings to those keys.
-    
-    For example, suppose your keyboard has a keycap marked \"Line Del\"
-    and you wish to add it to the list of keys which can be customized
-    by the EDT Emulation.  First, assign a unique single-word name to
-    the key for use by the EDT Emulation, let's say \"linedel\", in this
-    example.  Then, at the \"EDT Key Name:\" prompt, enter \"linedel\",
-    followed by a press of the RETURN key.  Finally, when prompted,
-    press the \"Line Del\" key.  You now will be able to bind functions
-    to \"linedel\" and \"Gold-linedel\" in edt-user.el in just the same way
-    you can customize bindings of the standard LK-201 keys.
-
-    When you have no additional function keys to specify, just press
-    RETURN at the \"EDT Key Name:\" prompt.  (If you change your mind
-    AFTER you enter an EDT Key Name and before you press a key at the
-    \"Press\" prompt, you may omit the key by simply pressing RETURN at
-    the prompt.)
-")
-(switch-to-buffer "Directions")
-;;;
-;;;  Add support for extras keys
-;;;
-(set-buffer "Keys")
-(insert "\
-;;
-;;  Extra Keys 
-;;
-")
-(setq EDT-key-name "")
-(while (not 
-	(string-equal (setq EDT-key-name (read-string "EDT Key Name: ")) ""))
-  (edt-map-key EDT-key-name ""))
-
-;
-; No more keys to add, so wrap up.
-;
-(set-buffer "Keys")
-(insert "\
-    )
-  )
-")
-
-;;;
-;;;  Save the key mapping program and blow this pop stand
-;;;
-(let ((file (if edt-lucid-emacs19-p "~/.edt-lucid-keys" "~/.edt-gnu-keys")))
-  (set-visited-file-name
-   (read-file-name (format "Save key mapping to file (default %s): " file) nil file)))
-(save-buffer)
-
-(message "That's it!  Press any key to exit")
-(sit-for 600)
-(kill-emacs t)
-
-;;; edt-mapper.el ends here
diff --git a/lisp/emulation/edt-pc.el b/lisp/emulation/edt-pc.el
deleted file mode 100644
index 0130c98919c..00000000000
--- a/lisp/emulation/edt-pc.el
+++ /dev/null
@@ -1,85 +0,0 @@
-;;; edt-pc.el --- Enhanced EDT Keypad Mode Emulation for PC 101 Keyboards
-
-;; Copyright (C) 1986, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com>
-;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com>
-;; Keywords: emulations
-
-;; 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.
-
-;;; Usage:
-
-;;  See edt-user.doc in the Emacs etc directory.
-
-;; ====================================================================
-
-;;;;
-;;;; KEY TRANSLATIONS
-;;;;
-
-;; Associate EDT keynames with Emacs terminal function vector names.
-;;
-;; To emulate the DEC LK-201 keypad keys on the PC 101 keyboard,
-;; NumLock must be ON.
-;;
-;; The PC keypad keys are mapped to the corresponding DEC LK-201
-;; keypad keys according to the corresponding physical position on
-;; the keyboard.  Thus, the physical position of the PC keypad key
-;; determines its function, not the PC keycap name.
-;;
-;; There are two LK-201 keypad keys needing special handling: PF1 and
-;; the keypad comma key.
-;;
-;; PF1:
-;;  Most PC software does not see a press of the NumLock key.  A TSR
-;;  program distributed with MS-Kermit to support its VT-100 emulation
-;;  solves this problem.  The TSR, called GOLD, causes a press of the
-;;  keypad NumLock key to look as if the PC F1 key were pressed.  So
-;;  the PC F1 key is mapped here to behave as the PF1 (GOLD) key.
-;;  Then with GOLD loaded, the NumLock key will behave as the GOLD key.
-;;
-;;  By the way, with GOLD loaded, you can still toggle numlock on/off.
-;;  GOLD binds this to Shift-NumLock.
-;;
-;; Keypad Comma:
-;;  There is no physical PC keypad key to correspond to the LK-201
-;;  keypad comma key.  So, the EDT Emulation is configured below to
-;;  ignore attempts to bind functions to the keypad comma key.
-;;
-;; Finally, F2 through F12 are also available for making key bindings
-;; in the EDT Emulation on the PC.  F1 is reserved for the GOLD key,
-;; so don't attempt to bind anything to it.  Also, F13, F14, HELP, DO,
-;; and F17 through F20 do not exist on the PC, so the EDT emulation is
-;; configured below to ignore attempts to bind functions to those keys.
-;;
-(defconst *EDT-keys*
-  '(("KP0" . [kp-0]) ("KP1" . [kp-1]) ("KP2" . [kp-2]) ("KP3" . [kp-3]) 
-    ("KP4" . [kp-4]) ("KP5" . [kp-5]) ("KP6" . [kp-6]) ("KP7" . [kp-7])
-    ("KP8" . [kp-8]) ("KP9" . [kp-9]) ("KP," . "" )
-    ("KP-" . [kp-add]) ("KPP" . [kp-decimal]) ("KPE" . [kp-enter])
-    ("PF1" . [f1]) ("PF2" . [kp-divide]) ("PF3" . [kp-multiply])
-    ("PF4" . [kp-subtract])
-    ("UP" . [up]) ("DOWN" . [down]) ("RIGHT" . [right]) ("LEFT" . [left])
-    ("FIND" . [insert]) ("INSERT" . [home]) ("REMOVE" . [prior])
-    ("SELECT" . [delete]) ("PREVIOUS" . [end]) ("NEXT" . [next])
-    ("F1" . "" ) ("F2" . [f2]) ("F3" . [f3]) ("F4" . [f4]) ("F5" . [f5])
-    ("F6" . [f6]) ("F7" . [f7]) ("F8" . [f8]) ("F9" . [f9]) ("F10" . [f10])
-    ("F11" . [f11]) ("F12" . [f12]) ("F13" . "" ) ("F14" . "" )
-    ("HELP" . "" ) ("DO" . "" ) ("F17" . "" ) ("F18" . "" )
-    ("F19" . "" ) ("F20" . "" )))
diff --git a/lisp/emulation/edt-vt100.el b/lisp/emulation/edt-vt100.el
deleted file mode 100644
index 4c2d225127b..00000000000
--- a/lisp/emulation/edt-vt100.el
+++ /dev/null
@@ -1,44 +0,0 @@
-;;; edt-vt100.el --- Enhanced EDT Keypad Mode Emulation for VT Series Terminals
-
-;; Copyright (C) 1986, 1992, 1993, 1995 Free Software Foundation, Inc.
-
-;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com>
-;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com>
-;; Keywords: emulations
-
-;; 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.
-
-;;; Usage:
-
-;;  See edt-user.doc in the Emacs etc directory.
-
-;; ====================================================================
-
-;; Get keyboard function key mapping to EDT keys.
-(load "edt-lk201" nil t)
-
-;; The following functions are called by the EDT screen width commands defined
-;; in edt.el.
-
-(defun edt-set-term-width-80 ()
-  "Set terminal width to 80 columns."
-  (vt100-wide-mode -1))
-
-(defun edt-set-term-width-132 ()
-  "Set terminal width to 132 columns."
-  (vt100-wide-mode 1))
diff --git a/lisp/emulation/edt.el b/lisp/emulation/edt.el
deleted file mode 100644
index 6ec3dbc3f1e..00000000000
--- a/lisp/emulation/edt.el
+++ /dev/null
@@ -1,2018 +0,0 @@
-;;; edt.el --- Enhanced EDT Keypad Mode Emulation for GNU Emacs 19
-
-;; Copyright (C) 1986, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Kevin Gallagher <kgallagh@spd.dsccc.com>
-;; Maintainer: Kevin Gallagher <kgallagh@spd.dsccc.com>
-;; Keywords: emulations
-
-;; 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.
-
-;;; Usage:
-
-;;  See edt-user.doc in the Emacs etc directory.
-
-;; ====================================================================
-
-;;;  Electric Help functions are used for keypad help displays.  A few
-;;;  picture functions are used in rectangular cut and paste commands.
-(require 'ehelp)
-(require 'picture)
-
-;;;;
-;;;; VARIABLES and CONSTANTS
-;;;;
-
-(defvar edt-last-deleted-lines ""
-  "Last text deleted by an EDT emulation line delete command.")
-
-(defvar edt-last-deleted-words ""
-  "Last text deleted by an EDT emulation word delete command.")
-
-(defvar edt-last-deleted-chars ""
-  "Last text deleted by an EDT emulation character delete command.")
-
-(defvar edt-last-replaced-key-definition ""
-  "Key definition replaced with edt-define-key or edt-learn command.")
-
-(defvar edt-direction-string ""
-  "String indicating current direction of movement.")
-
-(defvar edt-select-mode nil
-  "Non-nil means select mode is active.")
-
-(defvar edt-select-mode-text ""
-  "Text displayed in mode line when select mode is active.")
-
-(defconst edt-select-mode-string " Select"
-  "String to indicate select mode is active.")
-
-(defconst edt-forward-string " ADVANCE"
-  "Direction string in mode line to indicate forward movement.")
-
-(defconst edt-backward-string "  BACKUP"
-  "Direction string in mode line to indicate backward movement.")
-
-(defvar edt-default-map-active nil
-  "Non-nil indicates that default EDT emulation key bindings are active.
-Nil means user-defined custom bindings are active.")
-
-(defvar edt-user-map-configured nil
-  "Non-nil indicates that user custom EDT key bindings are configured.
-This means that an edt-user.el file was found in the user's load-path.")
-
-(defvar edt-keep-current-page-delimiter nil
-  "Non-nil leaves current value of page-delimiter unchanged.
-Nil causes the page-delimiter variable to be set to to \"\\f\"
-when edt-emulation-on is first invoked.  Original value is restored
-when edt-emulation-off is called.")
-
-(defvar edt-use-EDT-control-key-bindings nil
-  "Non-nil causes the control key bindings to be replaced with EDT bindings.
-Nil (the default) means EDT control key bindings are not used and the current
-control key bindings are retained for use in the EDT emulation.")
-
-(defvar edt-word-entities '(?\t)
-  "*Specifies the list of EDT word entity characters.")
-
-;;;
-;;;  Emacs version identifiers - currently referenced by
-;;;
-;;;     o edt-emulation-on      o edt-load-xkeys
-;;;
-(defconst edt-emacs19-p (not (string-lessp emacs-version "19"))
-  "Non-nil if we are running Lucid or GNU Emacs version 19.")
-
-(defconst edt-lucid-emacs19-p
-  (and edt-emacs19-p (string-match "Lucid" emacs-version))
-  "Non-nil if we are running Lucid Emacs version 19.")
-
-(defconst edt-gnu-emacs19-p (and edt-emacs19-p (not edt-lucid-emacs19-p))
-  "Non-nil if we are running GNU Emacs version 19.")
-
-(defvar edt-xkeys-file nil
-  "File mapping X function keys to LK-201 keyboard function and keypad keys.")
-
-;;;;
-;;;; EDT Emulation Commands
-;;;;
-
-;;; Almost all of EDT's keypad mode commands have equivalent
-;;; counterparts in Emacs.  Some behave the same way in Emacs as they
-;;; do in EDT, but most do not.
-;;;
-;;; The following Emacs functions emulate, where practical, the exact
-;;; behavior of the corresponding EDT keypad mode commands.  In a few
-;;; cases, the emulation is not exact, but it is close enough for most
-;;; EDT die-hards.
-;;;
-;;; In a very few cases, we chose to use the superior Emacs way of
-;;; handling things.  For example, we do not emulate the EDT SUBS
-;;; command.  Instead, we chose to use the superior Emacs
-;;; query-replace function.
-;;;
-
-;;;
-;;; PAGE
-;;;
-;;; Emacs uses the regexp assigned to page-delimiter to determine what
-;;; marks a page break.  This is normally "^\f", which causes the
-;;; edt-page command to ignore form feeds not located at the beginning
-;;; of a line.  To emulate the EDT PAGE command exactly,
-;;; page-delimiter is set to "\f" when EDT emulation is turned on, and
-;;; restored to its original value when EDT emulation is turned off.
-;;; But this can be overridden if the EDT definition is not desired by
-;;; placing
-;;;
-;;;         (setq edt-keep-current-page-delimiter t)
-;;;
-;;; in your .emacs file.
-
-(defun edt-page-forward (num)
-  "Move forward to just after next page delimiter.
-Accepts a positive prefix argument for the number of page delimiters to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (if (eobp)
-      (error "End of buffer")
-      (progn
-        (forward-page num)
-	(if (eobp)
-	    (edt-line-to-bottom-of-window)
-	    (edt-line-to-top-of-window)))))
-
-(defun edt-page-backward (num)
-  "Move backward to just after previous page delimiter.
-Accepts a positive prefix argument for the number of page delimiters to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (if (bobp)
-      (error "Beginning of buffer")
-      (progn
-        (backward-page num)
-        (edt-line-to-top-of-window))))
-
-(defun edt-page (num)
-  "Move in current direction to next page delimiter.
-Accepts a positive prefix argument for the number of page delimiters to move."
-  (interactive "p")
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-page-forward num)
-      (edt-page-backward num)))
-
-;;;
-;;; SECT
-;;;
-;;; EDT defaults a section size to be 16 lines of its one and only
-;;; 24-line window.  That's two-thirds of the window at a time.  The
-;;; EDT SECT commands moves the cursor, not the window.  
-;;; 
-;;; This emulation of EDT's SECT moves the cursor approximately two-thirds
-;;; of the current window at a time.
-
-(defun edt-sect-forward (num)
-  "Move cursor forward two-thirds of a window.
-Accepts a positive prefix argument for the number of sections to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (edt-line-forward (* (* (/ (- (window-height) 1) 3) 2) num)))
-
-(defun edt-sect-backward (num)
-  "Move cursor backward two-thirds of a window.
-Accepts a positive prefix argument for the number of sections to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (edt-line-backward (* (* (/ (- (window-height) 1) 3) 2) num)))
-
-(defun edt-sect (num)
-  "Move in current direction a full window.
-Accepts a positive prefix argument for the number windows to move."
-  (interactive "p")
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-sect-forward num)
-      (edt-sect-backward num)))
-
-;;;
-;;; BEGINNING OF LINE
-;;;
-;;; EDT's beginning-of-line command is not affected by current
-;;; direction, for some unknown reason.
-
-(defun edt-beginning-of-line (num)
-  "Move backward to next beginning of line mark.
-Accepts a positive prefix argument for the number of BOL marks to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (if (bolp)
-      (forward-line (* -1 num))
-      (progn
-        (setq num (1- num))
-        (forward-line (* -1 num)))))
-
-;;;
-;;; EOL (End of Line)
-;;;
-
-(defun edt-end-of-line-forward (num)
-  "Move forward to next end of line mark.
-Accepts a positive prefix argument for the number of EOL marks to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (forward-char)
-  (end-of-line num))
-
-(defun edt-end-of-line-backward (num)
-  "Move backward to next end of line mark.
-Accepts a positive prefix argument for the number of EOL marks to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (end-of-line (1- num)))
-
-(defun edt-end-of-line (num)
-  "Move in current direction to next end of line mark.
-Accepts a positive prefix argument for the number of EOL marks to move."
-  (interactive "p")
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-end-of-line-forward num)
-      (edt-end-of-line-backward num)))
-
-;;;
-;;; WORD
-;;;
-;;; This one is a tad messy.  To emulate EDT's behavior everywhere in
-;;; the file (beginning of file, end of file, beginning of line, end
-;;; of line, etc.) it takes a bit of special handling.  
-;;; 
-;;; The variable edt-word-entities contains a list of characters which
-;;; are to be viewed as distinct words where ever they appear in the
-;;; buffer.  This emulates the EDT line mode command SET ENTITY WORD. 
-
-
-(defun edt-one-word-forward ()
-  "Move forward to first character of next word."
-  (interactive)
-  (if (eobp)
-      (error "End of buffer"))
-  (if (eolp)
-      (forward-char)
-      (progn
-        (if (memq (following-char) edt-word-entities)
-            (forward-char)
-            (while (and 
-                     (not (eolp))
-                     (not (eobp))
-                     (not (eq ?\  (char-syntax (following-char))))
-                     (not (memq (following-char) edt-word-entities)))
-              (forward-char)))
-        (while (and 
-                 (not (eolp))
-                 (not (eobp))
-                 (eq ?\  (char-syntax (following-char)))
-                 (not (memq (following-char) edt-word-entities)))
-          (forward-char)))))
-
-(defun edt-one-word-backward ()
-  "Move backward to first character of previous word."
-  (interactive)
-  (if (bobp)
-      (error "Beginning of buffer"))
-  (if (bolp)
-      (backward-char)
-      (progn
-        (backward-char)
-        (while (and 
-                 (not (bolp))
-                 (not (bobp))
-                 (eq ?\  (char-syntax (following-char)))
-                 (not (memq (following-char) edt-word-entities)))
-          (backward-char))
-        (if (not (memq (following-char) edt-word-entities))
-            (while (and 
-                     (not (bolp))
-                     (not (bobp))
-                     (not (eq ?\  (char-syntax (preceding-char))))
-                     (not (memq (preceding-char) edt-word-entities)))
-              (backward-char))))))
-
-(defun edt-word-forward (num)
-  "Move forward to first character of next word.
-Accepts a positive prefix argument for the number of words to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (while (> num 0)
-    (edt-one-word-forward)
-    (setq num (1- num))))
-
-(defun edt-word-backward (num)
-  "Move backward to first character of previous word.
-Accepts a positive prefix argument for the number of words to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (while (> num 0)
-    (edt-one-word-backward)
-    (setq num (1- num))))
-
-(defun edt-word (num)
-  "Move in current direction to first character of next word.
-Accepts a positive prefix argument for the number of words to move."
-  (interactive "p")
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-word-forward num)
-      (edt-word-backward num)))
-
-;;;
-;;; CHAR
-;;;
-
-(defun edt-character (num)
-  "Move in current direction to next character.
-Accepts a positive prefix argument for the number of characters to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (if (equal edt-direction-string edt-forward-string)
-      (forward-char num)
-      (backward-char num)))
-
-;;;
-;;; LINE
-;;;
-;;; When direction is set to BACKUP, LINE behaves just like BEGINNING
-;;; OF LINE in EDT.  So edt-line-backward is not really needed as a
-;;; separate function.
-
-(defun edt-line-backward (num)
-  "Move backward to next beginning of line mark.
-Accepts a positive prefix argument for the number of BOL marks to move."
-  (interactive "p")
-  (edt-beginning-of-line num))
-
-(defun edt-line-forward (num)
-  "Move forward to next beginning of line mark.
-Accepts a positive prefix argument for the number of BOL marks to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (forward-line num))
-
-(defun edt-line (num)
-  "Move in current direction to next beginning of line mark.
-Accepts a positive prefix argument for the number of BOL marks to move."
-  (interactive "p")
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-line-forward num)
-      (edt-line-backward num)))
-
-;;;
-;;; TOP
-;;;
-
-(defun edt-top ()
-  "Move cursor to the beginning of buffer."
-  (interactive)
-  (goto-char (point-min)))
-
-;;;
-;;; BOTTOM
-;;;
-
-(defun edt-bottom ()
-  "Move cursor to the end of buffer."
-  (interactive)
-  (goto-char (point-max))
-  (edt-line-to-bottom-of-window))
-
-;;;
-;;; FIND
-;;;
-
-(defun edt-find-forward (&optional find)
-  "Find first occurrence of a string in forward direction and save it."
-  (interactive)
-  (if (not find)
-      (set 'search-last-string (read-string "Search forward: ")))
-  (if (search-forward search-last-string)
-      (search-backward search-last-string)))
-
-(defun edt-find-backward (&optional find)
-  "Find first occurrence of a string in the backward direction and save it."
-  (interactive)
-  (if (not find)
-      (set 'search-last-string (read-string "Search backward: ")))
-  (search-backward search-last-string))
-
-(defun edt-find ()
-  "Find first occurrence of string in current direction and save it."
-  (interactive)
-  (set 'search-last-string (read-string "Search: "))
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-find-forward t)
-      (edt-find-backward t)))
-  
-
-;;;
-;;; FNDNXT
-;;;
-
-(defun edt-find-next-forward ()
-  "Find next occurrence of a string in forward direction."
-  (interactive)
-  (forward-char 1)
-  (if (search-forward search-last-string nil t)
-      (search-backward search-last-string)
-      (progn
-        (backward-char 1)
-        (error "Search failed: \"%s\"." search-last-string))))
-
-(defun edt-find-next-backward ()
-  "Find next occurrence of a string in backward direction."
-  (interactive)
-  (if (eq (search-backward search-last-string nil t) nil)
-      (progn
-        (error "Search failed: \"%s\"." search-last-string))))
-
-(defun edt-find-next ()
-  "Find next occurrence of a string in current direction."
-  (interactive)
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-find-next-forward)
-      (edt-find-next-backward)))
-  
-;;;
-;;; APPEND
-;;;
-
-(defun edt-append ()
-  "Append this kill region to last killed region."
-  (interactive "*")
-  (edt-check-selection)
-  (append-next-kill)
-  (kill-region (mark) (point))
-  (message "Selected text APPENDED to kill ring"))
-
-;;;
-;;; DEL L
-;;;
-
-(defun edt-delete-line (num)
-  "Delete from cursor up to and including the end of line mark.
-Accepts a positive prefix argument for the number of lines to delete."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (let ((beg (point)))
-    (forward-line num)
-    (if (not (eq (preceding-char) ?\n))
-        (insert "\n"))
-    (setq edt-last-deleted-lines
-          (buffer-substring beg (point)))
-    (delete-region beg (point))))
-
-;;;
-;;; DEL EOL
-;;;
-
-(defun edt-delete-to-end-of-line (num)
-  "Delete from cursor up to but excluding the end of line mark.
-Accepts a positive prefix argument for the number of lines to delete."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (let ((beg (point)))
-    (forward-char 1)
-    (end-of-line num)
-    (setq edt-last-deleted-lines
-          (buffer-substring beg (point)))
-    (delete-region beg (point))))
-
-;;;
-;;; SELECT
-;;;
-
-(defun edt-select-mode (arg)
-  "Turn EDT select mode off if ARG is nil; otherwise, turn EDT select mode on.
-In select mode, selected text is highlighted."
-  (if arg
-      (progn
-	(make-local-variable 'edt-select-mode)
-	(setq edt-select-mode 'edt-select-mode-text)
-	(setq rect-start-point (window-point)))
-    (progn
-      (kill-local-variable 'edt-select-mode)))
-  (force-mode-line-update))
-
-(defun edt-select ()
-  "Set mark at cursor and start text selection."
-  (interactive)   
-  (set-mark-command nil)) 
-
-(defun edt-reset ()
-  "Cancel text selection."
-  (interactive)
-  (deactivate-mark))
-
-;;;
-;;; CUT
-;;;
-
-(defun edt-cut ()
-  "Deletes selected text but copies to kill ring."
-  (interactive "*")
-  (edt-check-selection)
-  (kill-region (mark) (point))
-  (message "Selected text CUT to kill ring"))
-
-;;;
-;;; DELETE TO BEGINNING OF LINE
-;;;
-
-(defun edt-delete-to-beginning-of-line (num)
-  "Delete from cursor to beginning of line.
-Accepts a positive prefix argument for the number of lines to delete."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (let ((beg (point)))
-    (edt-beginning-of-line num)
-    (setq edt-last-deleted-lines
-          (buffer-substring (point) beg))
-    (delete-region beg (point))))
-
-;;;
-;;; DEL W
-;;;
-
-(defun edt-delete-word (num)
-  "Delete from cursor up to but excluding first character of next word.
-Accepts a positive prefix argument for the number of words to delete."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (let ((beg (point)))
-    (edt-word-forward num)
-    (setq edt-last-deleted-words (buffer-substring beg (point)))
-    (delete-region beg (point))))
-
-;;;
-;;; DELETE TO BEGINNING OF WORD
-;;;
-
-(defun edt-delete-to-beginning-of-word (num)
-  "Delete from cursor to beginning of word.
-Accepts a positive prefix argument for the number of words to delete."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (let ((beg (point)))
-    (edt-word-backward num)
-    (setq edt-last-deleted-words (buffer-substring (point) beg))
-    (delete-region beg (point))))
-
-;;;
-;;; DEL C
-;;;
-
-(defun edt-delete-character (num)
-  "Delete character under cursor.
-Accepts a positive prefix argument for the number of characters to delete."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (setq edt-last-deleted-chars
-        (buffer-substring (point) (min (point-max) (+ (point) num))))
-  (delete-region (point) (min (point-max) (+ (point) num))))
-
-;;;
-;;; DELETE CHAR
-;;;
-
-(defun edt-delete-previous-character (num)
-  "Delete character in front of cursor.
-Accepts a positive prefix argument for the number of characters to delete."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (setq edt-last-deleted-chars
-        (buffer-substring (max (point-min) (- (point) num)) (point)))
-  (delete-region (max (point-min) (- (point) num)) (point)))
-
-;;;
-;;; UND L
-;;;
-
-(defun edt-undelete-line ()
-  "Undelete previous deleted line(s)."
-  (interactive "*")
-  (point-to-register 1)
-  (insert edt-last-deleted-lines)
-  (register-to-point 1))
-
-;;;
-;;; UND W
-;;;
-
-(defun edt-undelete-word ()
-  "Undelete previous deleted word(s)."
-  (interactive "*")
-  (point-to-register 1)
-  (insert edt-last-deleted-words)
-  (register-to-point 1))
-
-;;;
-;;; UND C
-;;;
-
-(defun edt-undelete-character ()
-  "Undelete previous deleted character(s)."
-  (interactive "*")
-  (point-to-register 1)
-  (insert edt-last-deleted-chars)
-  (register-to-point 1))
-
-;;;
-;;; REPLACE
-;;;
-
-(defun edt-replace ()
-  "Replace marked section with last CUT (killed) text."
-  (interactive "*")
-  (exchange-point-and-mark)
-  (let ((beg (point)))
-    (exchange-point-and-mark)
-    (delete-region beg (point)))
-  (yank))
-
-;;;
-;;; ADVANCE
-;;;
-
-(defun edt-advance ()
-  "Set movement direction forward.
-Also, execute command specified if in Minibuffer."
-  (interactive)
-  (setq edt-direction-string edt-forward-string)
-  (force-mode-line-update)
-  (if (string-equal " *Minibuf" 
-                    (substring (buffer-name) 0 (min (length (buffer-name)) 9)))
-      (exit-minibuffer)))
-  
-;;;
-;;; BACKUP
-;;;
-
-(defun edt-backup ()
-  "Set movement direction backward.
-Also, execute command specified if in Minibuffer."
-  (interactive)
-  (setq edt-direction-string edt-backward-string)
-  (force-mode-line-update)
-  (if (string-equal " *Minibuf" 
-                    (substring (buffer-name) 0 (min (length (buffer-name)) 9)))
-      (exit-minibuffer)))
-
-;;;
-;;; CHNGCASE
-;;;
-;; This function is based upon Jeff Kowalski's case-flip function in his 
-;; tpu.el.
-
-(defun edt-change-case (num)
-  "Change the case of specified characters.
-If text selection IS active, then characters between the cursor and mark are
-changed.  If text selection is NOT active, there are two cases.  First, if the
-current direction is ADVANCE, then the prefix number of character(s) under and
-following cursor are changed.  Second, if the current direction is BACKUP, then
-the prefix number of character(s) before the cursor are changed.  Accepts a
-positive prefix for the number of characters to change, but the prefix is
-ignored if text selection is active."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (if edt-select-mode
-      (let ((end (max (mark) (point)))
-            (point-save (point)))
-        (goto-char (min (point) (mark)))
-        (while (not (eq (point) end))
-          (funcall (if (<= ?a (following-char))
-                       'upcase-region 'downcase-region)
-                   (point) (1+ (point)))
-          (forward-char 1))
-        (goto-char point-save))
-      (progn
-        (if (string= edt-direction-string edt-backward-string)
-            (backward-char num))
-        (while (> num 0)
-          (funcall (if (<= ?a (following-char))
-                       'upcase-region 'downcase-region)
-                   (point) (1+ (point)))
-          (forward-char 1)
-          (setq num (1- num))))))
-
-;;;
-;;; DEFINE KEY
-;;;
-
-(defun edt-define-key ()
-  "Assign an interactively-callable function to a specified key sequence.
-The current key definition is saved in edt-last-replaced-key-definition.
-Use edt-restore-key to restore last replaced key definition."
-  (interactive)
-  (let (edt-function
-    edt-key-definition-string)
-    (setq edt-key-definition-string
-         (read-key-sequence "Press the key to be defined: "))
-    (if (string-equal "\C-m" edt-key-definition-string) 
-        (message "Key not defined") 
-        (progn
-          (setq edt-function (read-command "Enter command name: "))
-          (if (string-equal "" edt-function)
-              (message "Key not defined") 
-              (progn
-                (setq edt-last-replaced-key-definition
-                   (lookup-key (current-global-map) edt-key-definition-string))
-                (define-key (current-global-map) 
-                    edt-key-definition-string edt-function)))))))
-
-;;;
-;;; FORM FEED INSERT
-;;;
-
-(defun edt-form-feed-insert (num)
-  "Insert form feed character at cursor position.
-Accepts a positive prefix argument for the number of form feeds to insert."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (while (> num 0)
-    (insert ?\f)
-    (setq num (1- num))))
-
-;;;
-;;; TAB INSERT
-;;;
-
-(defun edt-tab-insert (num)
-  "Insert tab character at cursor position.
-Accepts a positive prefix argument for the number of tabs to insert."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (while (> num 0)
-    (insert ?\t)
-    (setq num (1- num))))
-
-;;;
-;;; Check Prefix
-;;;
-
-(defun edt-check-prefix (num)
-  "Indicate error if prefix is not positive."
-  (if (<= num 0)
-      (error "Prefix must be positive")))
-      
-;;;
-;;; Check Selection
-;;;
-
-(defun edt-check-selection ()
-  "Indicate error if EDT selection is not active."
-  (if (not edt-select-mode)
-      (error "Selection NOT active")))
-
-;;;;
-;;;; ENHANCEMENTS AND ADDITIONS FOR EDT KEYPAD MODE
-;;;;
-
-;;; 
-;;; Several enhancements and additions to EDT keypad mode commands are
-;;; provided here.  Some of these have been motivated by similar
-;;; TPU/EVE and EVE-Plus commands.  Others are new.
-
-;;;
-;;; CHANGE DIRECTION
-;;;
-
-(defun edt-change-direction ()
-  "Toggle movement direction."
-  (interactive)
-  (if (equal edt-direction-string edt-forward-string) 
-      (edt-backup)
-      (edt-advance)))
-
-;;;
-;;; TOGGLE SELECT
-;;;
-
-(defun edt-toggle-select ()
-  "Toggle to start (or cancel) text selection."
-  (interactive)
-  (if edt-select-mode
-      (edt-reset)
-    (edt-select)))
-
-;;;
-;;; SENTENCE
-;;;
-
-(defun edt-sentence-forward (num)
-  "Move forward to start of next sentence.
-Accepts a positive prefix argument for the number of sentences to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (if (eobp)
-      (progn
-        (error "End of buffer"))
-      (progn
-        (forward-sentence num)
-        (edt-one-word-forward))))
-
-(defun edt-sentence-backward (num)
-  "Move backward to next sentence beginning.
-Accepts a positive prefix argument for the number of sentences to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (if (eobp)
-      (progn
-        (error "End of buffer"))
-      (backward-sentence num)))
-
-(defun edt-sentence (num)
-  "Move in current direction to next sentence.
-Accepts a positive prefix argument for the number of sentences to move."
-  (interactive "p")
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-sentence-forward num)
-      (edt-sentence-backward num)))
-
-;;;
-;;; PARAGRAPH
-;;;
-
-(defun edt-paragraph-forward (num)
-  "Move forward to beginning of paragraph.
-Accepts a positive prefix argument for the number of paragraphs to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (while (> num 0)
-    (next-line 1)
-    (forward-paragraph)
-    (previous-line 1)
-    (if (eolp)
-        (next-line 1))
-    (setq num (1- num))))
-
-(defun edt-paragraph-backward (num)
-  "Move backward to beginning of paragraph.
-Accepts a positive prefix argument for the number of paragraphs to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (while (> num 0)
-    (backward-paragraph)
-    (previous-line 1)
-    (if (eolp) (next-line 1))
-    (setq num (1- num))))
-
-(defun edt-paragraph (num)
-  "Move in current direction to next paragraph.
-Accepts a positive prefix argument for the number of paragraph to move."
-  (interactive "p")
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-paragraph-forward num)
-      (edt-paragraph-backward num)))
-
-;;;
-;;; RESTORE KEY
-;;;
-
-(defun edt-restore-key ()
-  "Restore last replaced key definition.
-Definition is stored in edt-last-replaced-key-definition."
-  (interactive)
-  (if edt-last-replaced-key-definition
-      (progn
-        (let (edt-key-definition-string)
-          (set 'edt-key-definition-string
-               (read-key-sequence "Press the key to be restored: "))
-          (if (string-equal "\C-m" edt-key-definition-string) 
-              (message "Key not restored") 
-              (define-key (current-global-map) 
-                 edt-key-definition-string edt-last-replaced-key-definition))))
-      (error "No replaced key definition to restore!")))
-
-;;;
-;;; WINDOW TOP
-;;;
-
-(defun edt-window-top ()
-  "Move the cursor to the top of the window."
-  (interactive)
-  (let ((start-column (current-column)))
-    (move-to-window-line 0)
-    (move-to-column start-column)))
-
-;;;
-;;; WINDOW BOTTOM
-;;;
-
-(defun edt-window-bottom ()
-  "Move the cursor to the bottom of the window."
-  (interactive)
-  (let ((start-column (current-column)))
-    (move-to-window-line (- (window-height) 2))
-    (move-to-column start-column)))
-
-;;;
-;;; SCROLL WINDOW LINE
-;;;
-
-(defun edt-scroll-window-forward-line ()
-  "Move window forward one line leaving cursor at position in window."
-  (interactive)
-  (scroll-up 1))
-
-(defun edt-scroll-window-backward-line ()
-  "Move window backward one line leaving cursor at position in window."
-  (interactive)
-  (scroll-down 1))
-
-(defun edt-scroll-line ()
-  "Move window one line in current direction."
-  (interactive)
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-scroll-window-forward-line)
-      (edt-scroll-window-backward-line)))
-
-;;;
-;;; SCROLL WINDOW
-;;;
-;;; Scroll a window (less one line) at a time.  Leave cursor in center of 
-;;; window. 
-
-(defun edt-scroll-window-forward (num)
-  "Scroll forward one window in buffer, less one line.
-Accepts a positive prefix argument for the number of windows to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (scroll-up (- (* (window-height) num) 2))
-  (edt-line-forward (/ (- (window-height) 1) 2)))
-
-(defun edt-scroll-window-backward (num)
-  "Scroll backward one window in buffer, less one line.
-Accepts a positive prefix argument for the number of windows to move."
-  (interactive "p")
-  (edt-check-prefix num)
-  (scroll-down (- (* (window-height) num) 2))
-  (edt-line-backward (/ (- (window-height) 1) 2)))
-
-(defun edt-scroll-window (num)
-  "Scroll one window in buffer, less one line, in current direction.
-Accepts a positive prefix argument for the number windows to move."
-  (interactive "p")
-  (if (equal edt-direction-string edt-forward-string)
-      (edt-scroll-window-forward num)
-      (edt-scroll-window-backward num)))
-
-;;;
-;;; LINE TO BOTTOM OF WINDOW
-;;;
-
-(defun edt-line-to-bottom-of-window ()
-  "Move the current line to the bottom of the window."
-  (interactive)
-  (recenter -1))
-
-;;;
-;;; LINE TO TOP OF WINDOW
-;;;
-
-(defun edt-line-to-top-of-window ()
-  "Move the current line to the top of the window."
-  (interactive)
-  (recenter 0))
-
-;;;
-;;; LINE TO MIDDLE OF WINDOW
-;;;
-
-(defun edt-line-to-middle-of-window ()
-  "Move window so line with cursor is in the middle of the window."
-  (interactive)
-  (recenter '(4)))
-
-;;;
-;;; GOTO PERCENTAGE
-;;;
-
-(defun edt-goto-percentage (num)
-  "Move to specified percentage in buffer from top of buffer."
-  (interactive "NGoto-percentage: ")
-  (if (or (> num 100) (< num 0))
-      (error "Percentage %d out of range 0 < percent < 100" num)
-      (goto-char (/ (* (point-max) num) 100))))
-
-;;;
-;;; FILL REGION
-;;;
-
-(defun edt-fill-region ()
-  "Fill selected text."
-  (interactive "*")         
-  (edt-check-selection)
-  (fill-region (point) (mark)))
-
-;;;
-;;; INDENT OR FILL REGION
-;;;
-
-(defun edt-indent-or-fill-region ()
-  "Fill region in text modes, indent region in programming language modes."
-  (interactive "*")         
-  (if (string= paragraph-start "$\\|\f")
-      (indent-region (point) (mark) nil)
-      (fill-region (point) (mark))))
-
-;;;
-;;; MARK SECTION WISELY
-;;;
-
-(defun edt-mark-section-wisely ()
-  "Mark the section in a manner consistent with the major-mode.
-Uses mark-defun for emacs-lisp and lisp,
-mark-c-function for C,
-mark-fortran-subsystem for fortran,
-and mark-paragraph for other modes."
-  (interactive)
-  (if edt-select-mode
-      (progn
-        (edt-reset))
-      (progn
-	(cond  ((or (eq major-mode 'emacs-lisp-mode)
-		    (eq major-mode 'lisp-mode))
-		(mark-defun)
-		(message "Lisp defun selected"))
-	       ((eq major-mode 'c-mode)
-		(mark-c-function)
-		(message "C function selected"))
-	       ((eq major-mode 'fortran-mode)
-		(mark-fortran-subprogram)
-		(message "Fortran subprogram selected"))
-	       (t (mark-paragraph)
-		  (message "Paragraph selected"))))))
-
-;;;
-;;; COPY
-;;;
-
-(defun edt-copy ()
-  "Copy selected region to kill ring, but don't delete it!"
-  (interactive)
-  (edt-check-selection)
-  (copy-region-as-kill (mark) (point))
-  (edt-reset)
-  (message "Selected text COPIED to kill ring"))
-
-;;;
-;;; CUT or COPY
-;;;
-
-(defun edt-cut-or-copy ()
-  "Cuts (or copies) selected text to kill ring.
-Cuts selected text if buffer-read-only is nil.
-Copies selected text if buffer-read-only is t."
-  (interactive)
-  (if buffer-read-only
-      (edt-copy)
-      (edt-cut)))
-
-;;;
-;;; DELETE ENTIRE LINE
-;;;
-
-(defun edt-delete-entire-line ()
-  "Delete entire line regardless of cursor position in the line."
-  (interactive "*")
-  (beginning-of-line)
-  (edt-delete-line 1))
-
-;;;
-;;; DUPLICATE LINE
-;;;
-
-(defun edt-duplicate-line (num)
-  "Duplicate a line of text.
-Accepts a positive prefix argument for the number times to duplicate the line."
-  (interactive "*p")
-  (edt-check-prefix num)
-  (let ((old-column (current-column))
-        (count num))
-    (edt-delete-entire-line)
-    (edt-undelete-line)
-    (while (> count 0)
-      (edt-undelete-line)
-      (setq count (1- count)))
-    (edt-line-forward num)
-    (move-to-column old-column)))
-
-;;;
-;;; DUPLICATE WORD
-;;;
-
-(defun edt-duplicate-word()
-  "Duplicate word (or rest of word) found directly above cursor, if any."
-  (interactive "*")
-  (let ((start (point))
-        (start-column (current-column)))
-    (forward-line -1)
-    (move-to-column start-column)
-    (if (and (not (equal start (point)))
-             (not (eolp)))
-        (progn
-          (if (and (equal ?\t (preceding-char))
-                   (< start-column (current-column)))
-              (backward-char))
-          (let ((beg (point)))
-            (edt-one-word-forward)
-            (setq edt-last-copied-word (buffer-substring beg (point))))
-          (forward-line)
-          (move-to-column start-column)
-          (insert edt-last-copied-word))
-        (progn
-	  (if (not (equal start (point)))
-	      (forward-line))
-          (move-to-column start-column)
-          (error "Nothing to duplicate!")))))
-
-;;;
-;;; KEY NOT ASSIGNED
-;;;
-
-(defun edt-key-not-assigned ()
-  "Displays message that key has not been assigned to a function."
-  (interactive)
-  (error "Key not assigned"))
-
-;;;
-;;; TOGGLE CAPITALIZATION OF WORD
-;;;
-
-(defun edt-toggle-capitalization-of-word ()
-  "Toggle the capitalization of the current word and move forward to next."
-  (interactive "*")
-  (edt-one-word-forward)
-  (edt-one-word-backward)
-  (edt-change-case 1)
-  (edt-one-word-backward)
-  (edt-one-word-forward))
-
-;;;
-;;; ELIMINATE ALL TABS
-;;;
-
-(defun edt-eliminate-all-tabs ()
-  "Convert all tabs to spaces in the entire buffer."
-  (interactive "*")
-  (untabify (point-min) (point-max))
-  (message "TABS converted to SPACES"))
-
-;;;
-;;; DISPLAY THE TIME
-;;;
-
-(defun edt-display-the-time ()
-  "Display the current time."
-  (interactive)
-  (set 'time-string (current-time-string))
-  (message "%s" time-string))
-
-;;;
-;;; LEARN
-;;;
-
-(defun edt-learn ()
-  "Learn a sequence of key strokes to bind to a key."
-  (interactive)
-  (if (eq defining-kbd-macro t)
-      (edt-remember)
-      (start-kbd-macro nil)))
-
-;;;
-;;; REMEMBER
-;;;
-
-(defun edt-remember ()
-  "Store the sequence of key strokes started by edt-learn to a key."
-  (interactive)
-  (if (eq defining-kbd-macro nil)
-      (error "Nothing to remember!")
-      (progn
-        (end-kbd-macro nil)
-        (let (edt-key-definition-string)
-          (set 'edt-key-definition-string
-               (read-key-sequence "Enter key for binding: "))
-          (if (string-equal "\C-m" edt-key-definition-string) 
-              (message "Key sequence not remembered") 
-              (progn
-                (set 'edt-learn-macro-count (+ edt-learn-macro-count 1))
-                (setq edt-last-replaced-key-definition
-                      (lookup-key (current-global-map)
-                                  edt-key-definition-string))
-                (define-key (current-global-map) edt-key-definition-string
-                  (name-last-kbd-macro
-                    (intern (concat "last-learned-sequence-"
-                                  (int-to-string edt-learn-macro-count)))))))))))
-
-;;;
-;;; EXIT
-;;;
-
-(defun edt-exit ()
-  "Save current buffer, ask to save other buffers, and then exit Emacs."
-  (interactive)
-  (save-buffer)
-  (save-buffers-kill-emacs))
-
-;;; 
-;;; QUIT
-;;;
-
-(defun edt-quit ()
-  "Quit Emacs without saving changes."
-  (interactive)
-  (kill-emacs))
-
-;;; 
-;;; SPLIT WINDOW
-;;;
-
-(defun edt-split-window ()
-  "Split current window and place cursor in the new window."
-  (interactive)
-  (split-window)
-  (other-window 1))
-
-;;;
-;;; COPY RECTANGLE
-;;;
-
-(defun edt-copy-rectangle ()
-  "Copy a rectangle of text between mark and cursor to register."
-  (interactive)
-  (edt-check-selection)
-  (copy-rectangle-to-register 3 (region-beginning) (region-end) nil)
-  (edt-reset)
-  (message "Selected rectangle COPIED to register"))
-
-;;;
-;;; CUT RECTANGLE
-;;;
-
-(defun edt-cut-rectangle-overstrike-mode ()
-  "Cut a rectangle of text between mark and cursor to register.
-Replace cut characters with spaces and moving cursor back to
-upper left corner."
-  (interactive "*")
-  (edt-check-selection)
-  (setq edt-rect-start-point (region-beginning))
-  (picture-clear-rectangle-to-register (region-beginning) (region-end) 3)
-  (set-window-point (get-buffer-window (window-buffer)) edt-rect-start-point)
-  (message "Selected rectangle CUT to register"))
-
-(defun edt-cut-rectangle-insert-mode ()
-  "Cut a rectangle of text between mark and cursor to register.
-Move cursor back to upper left corner."
-  (interactive "*")         
-  (edt-check-selection)
-  (setq edt-rect-start-point (region-beginning))
-  (picture-clear-rectangle-to-register (region-beginning) (region-end) 3 t)
-  (fixup-whitespace)
-  (set-window-point (get-buffer-window (window-buffer)) edt-rect-start-point)
-  (message "Selected rectangle CUT to register"))
-
-(defun edt-cut-rectangle ()
-  "Cut a rectangular region of text to register.
-If overwrite mode is active, cut text is replaced with whitespace."
-  (interactive "*")
-  (if overwrite-mode
-      (edt-cut-rectangle-overstrike-mode)
-      (edt-cut-rectangle-insert-mode)))
-
-;;;
-;;; PASTE RECTANGLE
-;;;
-
-(defun edt-paste-rectangle-overstrike-mode ()
-  "Paste a rectangular region of text from register, replacing text at cursor."
-  (interactive "*")    
-  (picture-yank-rectangle-from-register 3))
-
-(defun edt-paste-rectangle-insert-mode ()
-  "Paste previously deleted rectangular region, inserting text at cursor."
-  (interactive "*")
-  (picture-yank-rectangle-from-register 3 t))
-
-(defun edt-paste-rectangle ()
-  "Paste a rectangular region of text.
-If overwrite mode is active, existing text is replace with text from register."
-  (interactive)
-  (if overwrite-mode
-      (edt-paste-rectangle-overstrike-mode)
-      (edt-paste-rectangle-insert-mode)))
-
-;;;
-;;; DOWNCASE REGION
-;;;
-
-(defun edt-lowercase ()
-  "Change specified characters to lower case.
-If text selection IS active, then characters between the cursor and
-mark are changed.  If text selection is NOT active, there are two
-situations.  If the current direction is ADVANCE, then the word under
-the cursor is changed to lower case and the cursor is moved to rest at
-the beginning of the next word.  If the current direction is BACKUP,
-the word prior to the word under the cursor is changed to lower case
-and the cursor is left to rest at the beginning of that word."
-  (interactive "*")
-  (if edt-select-mode
-      (progn
-	(downcase-region (mark) (point)))
-      (progn
-	;; Move to beginning of current word.
-	(if (and
-	      (not (bobp))
-	      (not (eobp))
-	      (not (bolp))
-	      (not (eolp))
-	      (not (eq ?\  (char-syntax (preceding-char))))
-	      (not (memq (preceding-char) edt-word-entities))
-	      (not (memq (following-char) edt-word-entities)))
-	    (edt-one-word-backward))
-	(if (equal edt-direction-string edt-backward-string)
-	    (edt-one-word-backward))
-	(let ((beg (point)))
-	  (edt-one-word-forward)
-	  (downcase-region beg (point)))
-	(if (equal edt-direction-string edt-backward-string)
-	    (edt-one-word-backward)))))
-
-;;;
-;;; UPCASE REGION
-;;;
-
-(defun edt-uppercase ()
-  "Change specified characters to upper case.
-If text selection IS active, then characters between the cursor and
-mark are changed.  If text selection is NOT active, there are two
-situations.  If the current direction is ADVANCE, then the word under
-the cursor is changed to upper case and the cursor is moved to rest at
-the beginning of the next word.  If the current direction is BACKUP,
-the word prior to the word under the cursor is changed to upper case
-and the cursor is left to rest at the beginning of that word."
-  (interactive "*")
-  (if edt-select-mode
-      (progn
-	(upcase-region (mark) (point)))
-      (progn
-	;; Move to beginning of current word.
-	(if (and
-	      (not (bobp))
-	      (not (eobp))
-	      (not (bolp))
-	      (not (eolp))
-	      (not (eq ?\  (char-syntax (preceding-char))))
-	      (not (memq (preceding-char) edt-word-entities))
-	      (not (memq (following-char) edt-word-entities)))
-	    (edt-one-word-backward))
-	(if (equal edt-direction-string edt-backward-string)
-	    (edt-one-word-backward))
-	(let ((beg (point)))
-	  (edt-one-word-forward)
-	  (upcase-region beg (point)))
-	(if (equal edt-direction-string edt-backward-string)
-	    (edt-one-word-backward)))))
-
-
-;;;
-;;; INITIALIZATION COMMANDS.
-;;;
-
-;;;
-;;;  Emacs version 19 X-windows key definition support
-;;;
-(defvar edt-last-answer nil 
-  "Most recent response to edt-y-or-n-p.")
-
-(defun edt-y-or-n-p (prompt &optional not-yes)
-  "Prompt for a y or n answer with positive default.
-Optional second argument NOT-YES changes default to negative.
-Like emacs y-or-n-p, also accepts space as y and DEL as n."
-  (message "%s[%s]" prompt (if not-yes "n" "y"))
-  (let ((doit t))
-    (while doit
-      (setq doit nil)
-      (let ((ans (read-char)))
-	(cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ ))
-	       (setq edt-last-answer t))
-	      ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
-	       (setq edt-last-answer nil))
-	      ((= ans ?\r) (setq edt-last-answer (not not-yes)))
-	      (t
-	       (setq doit t) (beep)
-	       (message "Please answer y or n.  %s[%s]"
-			prompt (if not-yes "n" "y")))))))
-  edt-last-answer)
-
-(defun edt-load-xkeys (file)
-  "Load the EDT X-windows key definitions FILE.
-If FILE is nil, try to load a default file.  The default file names are
-~/.edt-lucid-keys for Lucid emacs, and ~/.edt-gnu-keys for GNU emacs."
-  (interactive "fX key definition file: ")
-  (cond (file
-	 (setq file (expand-file-name file)))
-	(edt-xkeys-file
-	 (setq file (expand-file-name edt-xkeys-file)))
-	(edt-gnu-emacs19-p
-	 (setq file (expand-file-name "~/.edt-gnu-keys")))
-	(edt-lucid-emacs19-p
-	 (setq file (expand-file-name "~/.edt-lucid-keys"))))
-  (cond ((file-readable-p file)
-	 (load-file file))
-	(t
-	 (switch-to-buffer "*scratch*")
-	 (erase-buffer)
-	 (insert "
-
-     Ack!!  You're running the Enhanced EDT Emulation under X-windows
-     without loading an EDT X key definition file.  To create an EDT X
-     key definition file, run the edt-mapper.el program.  But ONLY run
-     it from an Emacs loaded without any of your own customizations
-     found in your .emacs file, etc.  Some user customization confuse
-     the edt-mapper function.  To do this, you need to invoke Emacs
-     as follows:
-
-          emacs -q -l edt-mapper.el
-     
-     The file edt-mapper.el includes these same directions on how to
-     use it!  Perhaps it's lying around here someplace. \n     ")
-	 (let ((file "edt-mapper.el")
-	       (found nil)
-	       (path nil)
-	       (search-list (append (list (expand-file-name ".")) load-path)))
-	   (while (and (not found) search-list)
-	     (setq path (concat (car search-list)
-				(if (string-match "/$" (car search-list)) "" "/")
-				file))
-	     (if (and (file-exists-p path) (not (file-directory-p path)))
-		 (setq found t))
-	     (setq search-list (cdr search-list)))
-	   (cond (found
-		  (insert (format
-			   "Ah yes, there it is, in \n\n       %s \n\n" path))
-		  (if (edt-y-or-n-p "Do you want to run it now? ")
-		      (load-file path)
-		    (error "EDT Emulation not configured.")))
-		 (t
-		  (insert "Nope, I can't seem to find it.  :-(\n\n")
-		  (sit-for 20)
-		  (error "EDT Emulation not configured.")))))))
-
-;;;###autoload
-(defun edt-emulation-on ()
-  "Turn on EDT Emulation."
-  (interactive)
-  ;; If using MS-DOS, need to load edt-pc.el
-  (if (eq system-type 'ms-dos)
-      (setq edt-term "pc")
-    (setq edt-term (getenv "TERM")))
-  ;; All DEC VT series terminals are supported by loading edt-vt100.el
-  (if (string-equal "vt" (substring edt-term 0 (min (length edt-term) 2)))
-      (setq edt-term "vt100"))
-  ;; Load EDT terminal specific configuration file.
-  (let ((term edt-term)
-        hyphend)
-    (while (and term
-                (not (load (concat "edt-" term) t t)))
-      ;; Strip off last hyphen and what follows, then try again
-      (if (setq hyphend (string-match "[-_][^-_]+$" term))
-          (setq term (substring term 0 hyphend))
-          (setq term nil)))
-    ;; Override terminal-specific file if running X Windows.  X Windows support
-    ;; is handled differently in edt-load-xkeys
-    (if (eq window-system 'x)
-	(edt-load-xkeys nil)
-      (if (null term)
-	  (error "Unable to load EDT terminal specific file for %s" edt-term)))
-    (setq edt-term term))
-  (setq edt-orig-transient-mark-mode transient-mark-mode)
-  (add-hook 'activate-mark-hook
-	    (function
-	     (lambda ()
-	       (edt-select-mode t))))
-  (add-hook 'deactivate-mark-hook
-	    (function
-	     (lambda ()
-	       (edt-select-mode nil))))
-  (if (load "edt-user" t t)
-      (edt-user-emulation-setup)
-      (edt-default-emulation-setup)))
-
-(defun edt-emulation-off()
-  "Select original global key bindings, disabling EDT Emulation."
-  (interactive)
-  (use-global-map global-map)
-  (if (not edt-keep-current-page-delimiter)
-      (setq page-delimiter edt-orig-page-delimiter))
-  (setq edt-direction-string "")
-  (setq edt-select-mode-text nil)
-  (edt-reset)
-  (force-mode-line-update t)
-  (setq transient-mark-mode edt-orig-transient-mark-mode)
-  (message "Original key bindings restored; EDT Emulation disabled"))
-
-(defun edt-default-emulation-setup (&optional user-setup)
-  "Setup emulation of DEC's EDT editor."
-  ;; Setup default EDT global map by copying global map bindings.
-  ;; This preserves ESC and C-x prefix bindings and other bindings we
-  ;; wish to retain in EDT emulation mode keymaps.  It also permits
-  ;; customization of these bindings in the EDT global maps without
-  ;; disturbing the original bindings in global-map.
-  (fset 'edt-default-ESC-prefix (copy-keymap 'ESC-prefix))
-  (setq edt-default-global-map (copy-keymap (current-global-map)))
-  (define-key edt-default-global-map "\e" 'edt-default-ESC-prefix)
-  (define-prefix-command 'edt-default-gold-map)
-  (edt-setup-default-bindings)
-  ;; If terminal has additional function keys, the terminal-specific
-  ;; initialization file can assign bindings to them via the optional
-  ;; function edt-setup-extra-default-bindings.
-  (if (fboundp 'edt-setup-extra-default-bindings)
-      (edt-setup-extra-default-bindings))
-  ;; Variable needed by edt-learn.
-  (setq edt-learn-macro-count 0)
-  ;; Display EDT text selection active within the mode line
-  (or (assq 'edt-select-mode minor-mode-alist)
-      (setq minor-mode-alist 
-	    (cons '(edt-select-mode edt-select-mode) minor-mode-alist)))
-  ;; Display EDT direction of motion within the mode line
-  (or (assq 'edt-direction-string minor-mode-alist)
-      (setq minor-mode-alist
-	    (cons
-	      '(edt-direction-string edt-direction-string) minor-mode-alist)))
-  (if user-setup
-      (progn
-        (setq edt-user-map-configured t)
-        (fset 'edt-emulation-on (symbol-function 'edt-select-user-global-map)))
-      (progn
-        (fset 'edt-emulation-on (symbol-function 'edt-select-default-global-map))
-        (edt-select-default-global-map))))
-
-(defun edt-user-emulation-setup ()
-  "Setup user custom emulation of DEC's EDT editor."
-  ;; Initialize EDT default bindings.
-  (edt-default-emulation-setup t)
-  ;; Setup user EDT global map by copying default EDT global map bindings.
-  (fset 'edt-user-ESC-prefix (copy-keymap 'edt-default-ESC-prefix))
-  (setq edt-user-global-map (copy-keymap edt-default-global-map))
-  (define-key edt-user-global-map "\e" 'edt-user-ESC-prefix)
-  ;; If terminal has additional function keys, the user's initialization
-  ;; file can assign bindings to them via the optional
-  ;; function edt-setup-extra-default-bindings.
-  (define-prefix-command 'edt-user-gold-map)
-  (fset 'edt-user-gold-map (copy-keymap 'edt-default-gold-map))
-  (edt-setup-user-bindings)
-  (edt-select-user-global-map))
-
-(defun edt-select-default-global-map()
-  "Select default EDT emulation key bindings."
-  (interactive)
-  (transient-mark-mode 1)
-  (use-global-map edt-default-global-map)
-  (if (not edt-keep-current-page-delimiter)
-      (progn
-        (setq edt-orig-page-delimiter page-delimiter)
-        (setq page-delimiter "\f")))
-  (setq edt-default-map-active t)
-  (edt-advance)
-  (setq edt-select-mode-text 'edt-select-mode-string)
-  (edt-reset)
-  (message "Default EDT keymap active"))
-
-(defun edt-select-user-global-map()
-  "Select user EDT emulation custom key bindings."
-  (interactive)
-  (if edt-user-map-configured
-      (progn
-	(transient-mark-mode 1)
-        (use-global-map edt-user-global-map)
-        (if (not edt-keep-current-page-delimiter)
-            (progn
-              (setq edt-orig-page-delimiter page-delimiter)
-              (setq page-delimiter "\f")))
-        (setq edt-default-map-active nil)
-        (edt-advance)
-	(setq edt-select-mode-text 'edt-select-mode-string)
-        (edt-reset)
-        (message "User EDT custom keymap active"))
-      (error "User EDT custom keymap NOT configured!")))
-
-(defun edt-switch-global-maps ()
-  "Toggle between default EDT keymap and user EDT keymap."
-  (interactive)
-  (if edt-default-map-active 
-    (edt-select-user-global-map)
-    (edt-select-default-global-map)))
-
-;; There are three key binding functions needed: one for standard keys
-;; (used to bind control keys, primarily), one for Gold sequences of
-;; standard keys, and one for function keys.  
-
-(defun edt-bind-gold-key (key gold-binding &optional default)
-  "Binds commands to a gold key sequence in the EDT Emulator."
-  (if default
-      (define-key 'edt-default-gold-map key gold-binding)
-      (define-key 'edt-user-gold-map key gold-binding)))
-
-(defun edt-bind-standard-key (key gold-binding &optional default)
-  "Bind commands to a gold key sequence in the default EDT keymap."
-  (if default
-      (define-key edt-default-global-map key gold-binding)
-      (define-key edt-user-global-map key gold-binding)))
-
-(defun edt-bind-function-key 
-    (function-key binding gold-binding &optional default)
-  "Binds function keys in the EDT Emulator."
-  (catch 'edt-key-not-supported
-    (let ((key-vector (cdr (assoc function-key *EDT-keys*))))
-      (if (stringp key-vector)
-	  (throw 'edt-key-not-supported t))
-      (if (not (null key-vector))
-	  (progn
-	    (if default
-		(progn
-		  (define-key edt-default-global-map key-vector binding)
-		  (define-key 'edt-default-gold-map key-vector gold-binding))
-              (progn
-                (define-key edt-user-global-map key-vector binding)
-                (define-key 'edt-user-gold-map key-vector gold-binding))))
-	(error "%s is not a legal function key name" function-key)))))
-
-(defun edt-setup-default-bindings ()
-  "Assigns default EDT Emulation keyboard bindings."
-
-  ;; Function Key Bindings:  Regular and GOLD.
-
-  ;; VT100/VT200/VT300 PF1 (GOLD), PF2, PF3, PF4 Keys
-  (edt-bind-function-key "PF1" 'edt-default-gold-map 'edt-mark-section-wisely t)
-  (edt-bind-function-key "PF2" 'edt-electric-keypad-help 'describe-function t)
-  (edt-bind-function-key "PF3" 'edt-find-next 'edt-find t)
-  (edt-bind-function-key "PF4" 'edt-delete-line 'edt-undelete-line t)
-
-  ;; VT100/VT200/VT300 Arrow Keys
-  (edt-bind-function-key "UP" 'previous-line 'edt-window-top t)
-  (edt-bind-function-key "DOWN" 'next-line 'edt-window-bottom t)
-  (edt-bind-function-key "LEFT" 'backward-char 'edt-sentence-backward t)
-  (edt-bind-function-key "RIGHT" 'forward-char 'edt-sentence-forward t)
-
-  ;; VT100/VT200/VT300 Keypad Keys
-  (edt-bind-function-key "KP0" 'edt-line 'open-line t)
-  (edt-bind-function-key "KP1" 'edt-word 'edt-change-case t)
-  (edt-bind-function-key "KP2" 'edt-end-of-line 'edt-delete-to-end-of-line t)
-  (edt-bind-function-key "KP3" 'edt-character 'quoted-insert t)
-  (edt-bind-function-key "KP4" 'edt-advance 'edt-bottom t)
-  (edt-bind-function-key "KP5" 'edt-backup 'edt-top t)
-  (edt-bind-function-key "KP6" 'edt-cut 'yank t)
-  (edt-bind-function-key "KP7" 'edt-page 'execute-extended-command t)
-  (edt-bind-function-key "KP8" 'edt-sect 'edt-fill-region t)
-  (edt-bind-function-key "KP9" 'edt-append 'edt-replace t)
-  (edt-bind-function-key "KP-" 'edt-delete-word 'edt-undelete-word t)
-  (edt-bind-function-key "KP," 'edt-delete-character 'edt-undelete-character t)
-  (edt-bind-function-key "KPP" 'edt-select 'edt-reset t)
-  (edt-bind-function-key "KPE" 'other-window 'query-replace t)
-
-  ;; VT200/VT300 Function Keys
-  ;; (F1 through F5, on the VT220, are not programmable, so we skip
-  ;; making default bindings to those keys.  
-  (edt-bind-function-key "FIND" 'edt-find-next 'edt-find t)
-  (edt-bind-function-key "INSERT" 'yank 'edt-key-not-assigned t)
-  (edt-bind-function-key "REMOVE" 'edt-cut 'edt-copy t)
-  (edt-bind-function-key "SELECT" 'edt-toggle-select 'edt-key-not-assigned t)
-  (edt-bind-function-key "NEXT" 'edt-sect-forward 'edt-key-not-assigned t)
-  (edt-bind-function-key "PREVIOUS" 'edt-sect-backward 'edt-key-not-assigned t)
-  (edt-bind-function-key "F6" 'edt-key-not-assigned 'edt-key-not-assigned t)
-  (edt-bind-function-key "F7" 'edt-copy-rectangle 'edt-key-not-assigned t)
-  (edt-bind-function-key "F8" 
-       'edt-cut-rectangle-overstrike-mode 'edt-paste-rectangle-overstrike-mode t)
-  (edt-bind-function-key "F9" 
-       'edt-cut-rectangle-insert-mode 'edt-paste-rectangle-insert-mode t)
-  (edt-bind-function-key "F10" 'edt-cut-rectangle 'edt-paste-rectangle t)
-  ;; Under X, the F11 key can be bound.  If using a VT-200 or higher terminal,
-  ;; the default emacs terminal support causes the VT F11 key to seem as if it 
-  ;; is an ESC key when in emacs.
-  (edt-bind-function-key "F11" 
-       'edt-key-not-assigned 'edt-key-not-assigned t)
-  (edt-bind-function-key "F12" 
-       'edt-beginning-of-line 'delete-other-windows t) ;BS
-  (edt-bind-function-key "F13" 
-       'edt-delete-to-beginning-of-word 'edt-key-not-assigned t) ;LF
-  (edt-bind-function-key "F14" 'edt-key-not-assigned 'edt-key-not-assigned t)
-  (edt-bind-function-key "HELP" 'edt-electric-keypad-help 'edt-key-not-assigned t)
-  (edt-bind-function-key "DO" 'execute-extended-command 'edt-key-not-assigned t)
-  (edt-bind-function-key "F17" 'edt-key-not-assigned 'edt-key-not-assigned t)
-  (edt-bind-function-key "F18" 'edt-key-not-assigned 'edt-key-not-assigned t)
-  (edt-bind-function-key "F19" 'edt-key-not-assigned 'edt-key-not-assigned t)
-  (edt-bind-function-key "F20" 'edt-key-not-assigned 'edt-key-not-assigned t)
-
-  ;; Control key bindings:  Regular and GOLD
-  ;; 
-  ;; Standard EDT control key bindings conflict with standard Emacs
-  ;; control key bindings.  Normally, the standard Emacs control key
-  ;; bindings are left unchanged in the default EDT mode.  However, if
-  ;; the variable edt-use-EDT-control-key-bindings is set to true
-  ;; before invoking edt-emulation-on for the first time, then the
-  ;; standard EDT bindings (with some enhancements) as defined here are
-  ;; used, instead.
-  (if edt-use-EDT-control-key-bindings
-      (progn
-        (edt-bind-standard-key "\C-a" 'edt-key-not-assigned t)
-        (edt-bind-standard-key "\C-b" 'edt-key-not-assigned t)
-        ;; Leave binding of C-c as original prefix key.
-        (edt-bind-standard-key "\C-d" 'edt-key-not-assigned t)
-        (edt-bind-standard-key "\C-e" 'edt-key-not-assigned t)
-        (edt-bind-standard-key "\C-f" 'edt-key-not-assigned t)
-        ;; Leave binding of C-g to keyboard-quit
-;        (edt-bind-standard-key "\C-g" 'keyboard-quit t)
-        ;; Standard EDT binding of C-h.  To invoke Emacs help, use
-        ;; GOLD-C-h instead.
-        (edt-bind-standard-key "\C-h" 'edt-beginning-of-line t)
-        (edt-bind-standard-key "\C-i" 'edt-tab-insert t)
-        (edt-bind-standard-key "\C-j" 'edt-delete-to-beginning-of-word t)
-        (edt-bind-standard-key "\C-k" 'edt-define-key t)
-        (edt-bind-gold-key  "\C-k" 'edt-restore-key t)
-        (edt-bind-standard-key "\C-l" 'edt-form-feed-insert t)
-        ;; Leave binding of C-m to newline.
-        (edt-bind-standard-key "\C-n" 'edt-set-screen-width-80 t)
-        (edt-bind-standard-key "\C-o" 'edt-key-not-assigned t)
-        (edt-bind-standard-key "\C-p" 'edt-key-not-assigned t)
-        (edt-bind-standard-key "\C-q" 'edt-key-not-assigned t)
-        ;; Leave binding of C-r to isearch-backward.
-        ;; Leave binding of C-s to isearch-forward.
-        (edt-bind-standard-key "\C-t" 'edt-display-the-time t)
-        (edt-bind-standard-key "\C-u" 'edt-delete-to-beginning-of-line t)
-        (edt-bind-standard-key "\C-v" 'redraw-display t)
-        (edt-bind-standard-key "\C-w" 'edt-set-screen-width-132 t)
-        ;; Leave binding of C-x as original prefix key.
-        (edt-bind-standard-key "\C-y" 'edt-key-not-assigned t)
-;        (edt-bind-standard-key "\C-z" 'suspend-emacs t)
-        )
-      )
-
-  ;; GOLD bindings for a few Control keys.
-  (edt-bind-gold-key  "\C-g" 'keyboard-quit t); Just in case.
-  (edt-bind-gold-key  "\C-h" 'help-for-help t)
-  (edt-bind-gold-key  [f1] 'help-for-help t)
-  (edt-bind-gold-key  [help] 'help-for-help t)
-  (edt-bind-gold-key  "\C-\\" 'split-window-vertically t)
-
-  ;; GOLD bindings for regular keys.
-  (edt-bind-gold-key "a" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "A" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "b" 'buffer-menu t)
-  (edt-bind-gold-key "B" 'buffer-menu t)
-  (edt-bind-gold-key "c" 'compile t)
-  (edt-bind-gold-key "C" 'compile t)
-  (edt-bind-gold-key "d" 'delete-window t)
-  (edt-bind-gold-key "D" 'delete-window t)
-  (edt-bind-gold-key "e" 'edt-exit t)
-  (edt-bind-gold-key "E" 'edt-exit t)
-  (edt-bind-gold-key "f" 'find-file t)
-  (edt-bind-gold-key "F" 'find-file t)
-  (edt-bind-gold-key "g" 'find-file-other-window t)
-  (edt-bind-gold-key "G" 'find-file-other-window t)
-  (edt-bind-gold-key "h" 'edt-electric-keypad-help t)
-  (edt-bind-gold-key "H" 'edt-electric-keypad-help t)
-  (edt-bind-gold-key "i" 'insert-file t)
-  (edt-bind-gold-key "I" 'insert-file t)
-  (edt-bind-gold-key "j" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "J" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "k" 'edt-toggle-capitalization-of-word t)
-  (edt-bind-gold-key "K" 'edt-toggle-capitalization-of-word t)
-  (edt-bind-gold-key "l" 'edt-lowercase t)
-  (edt-bind-gold-key "L" 'edt-lowercase t)
-  (edt-bind-gold-key "m" 'save-some-buffers t)
-  (edt-bind-gold-key "M" 'save-some-buffers t)
-  (edt-bind-gold-key "n" 'next-error t)
-  (edt-bind-gold-key "N" 'next-error t)
-  (edt-bind-gold-key "o" 'switch-to-buffer-other-window t)
-  (edt-bind-gold-key "O" 'switch-to-buffer-other-window t)
-  (edt-bind-gold-key "p" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "P" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "q" 'edt-quit t)
-  (edt-bind-gold-key "Q" 'edt-quit t)
-  (edt-bind-gold-key "r" 'revert-buffer t)
-  (edt-bind-gold-key "R" 'revert-buffer t)
-  (edt-bind-gold-key "s" 'save-buffer t)
-  (edt-bind-gold-key "S" 'save-buffer t)
-  (edt-bind-gold-key "t" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "T" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "u" 'edt-uppercase t)
-  (edt-bind-gold-key "U" 'edt-uppercase t)
-  (edt-bind-gold-key "v" 'find-file-other-window t)
-  (edt-bind-gold-key "V" 'find-file-other-window t)
-  (edt-bind-gold-key "w" 'write-file t)
-  (edt-bind-gold-key "W" 'write-file t)
-  (edt-bind-gold-key "x" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "X" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "y" 'edt-emulation-off t)
-  (edt-bind-gold-key "Y" 'edt-emulation-off t)
-  (edt-bind-gold-key "z" 'edt-switch-global-maps t)
-  (edt-bind-gold-key "Z" 'edt-switch-global-maps t)
-  (edt-bind-gold-key "1" 'delete-other-windows t)
-  (edt-bind-gold-key "!" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "2" 'edt-split-window t)
-  (edt-bind-gold-key "@" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "3" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "#" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "4" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "$" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "5" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "%" 'edt-goto-percentage t)
-  (edt-bind-gold-key "6" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "^" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "7" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "&" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "8" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "*" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "9" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "(" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "0" 'edt-key-not-assigned t)
-  (edt-bind-gold-key ")" 'edt-key-not-assigned t)
-  (edt-bind-gold-key " " 'undo t)
-  (edt-bind-gold-key "," 'edt-key-not-assigned t)
-  (edt-bind-gold-key "<" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "." 'edt-key-not-assigned t)
-  (edt-bind-gold-key ">" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "/" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "?" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "\\" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "|" 'edt-key-not-assigned t)
-  (edt-bind-gold-key ";" 'edt-key-not-assigned t)
-  (edt-bind-gold-key ":" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "'" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "\"" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "-" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "_" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "=" 'goto-line t)
-  (edt-bind-gold-key "+" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "[" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "{" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "]" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "}" 'edt-key-not-assigned t)
-  (edt-bind-gold-key "`" 'what-line t)
-  (edt-bind-gold-key "~" 'edt-key-not-assigned t)
-)
-
-;;;
-;;; DEFAULT EDT KEYPAD HELP
-;;;
-
-;;;
-;;; Upper case commands in the keypad diagram below indicate that the
-;;; emulation should look and feel very much like EDT.  Lower case
-;;; commands are enhancements and/or additions to the EDT keypad
-;;; commands or are native Emacs commands.
-;;;
-
-(defun edt-keypad-help ()
-  "
-                              DEFAULT EDT Keypad Active
-
-   F7: Copy Rectangle             +----------+----------+----------+----------+
-   F8: Cut Rect Overstrike        |Prev Line |Next Line |Bkwd Char |Frwd Char |
- G-F8: Paste Rect Overstrike      |   (UP)   |  (DOWN)  |  (LEFT)  | (RIGHT)  |
-   F9: Cut Rect Insert            |Window Top|Window Bot|Bkwd Sent |Frwd Sent |
- G-F9: Paste Rect Insert          +----------+----------+----------+----------+
-  F10: Cut Rectangle
-G-F10: Paste Rectangle
-  F11: ESC                       
-  F12: Begining of Line           +----------+----------+----------+----------+
-G-F12: Delete Other Windows       |   GOLD   |   HELP   |  FNDNXT  |  DEL L   |
-  F13: Delete to Begin of Word    |   (PF1)  |   (PF2)  |   (PF3)  |  (PF4)   |
- HELP: Keypad Help                |Mark Wisel|Desc Funct|   FIND   |  UND L   |
-   DO: Execute extended command   +----------+----------+----------+----------+
-                                  |   PAGE   |   SECT   |  APPEND  |  DEL W   |
-  C-g: Keyboard Quit              |    (7)   |    (8)   |    (9)   |   (-)    |
-G-C-g: Keyboard Quit              |Ex Ext Cmd|Fill Regio| REPLACE  |  UND W   |
-  C-h: Beginning of Line          +----------+----------+----------+----------+
-G-C-h: Emacs Help                 |  ADVANCE |  BACKUP  |   CUT    |  DEL C   |
-  C-i: Tab Insert                 |    (4)   |    (5)   |    (6)   |   (,)    |
-  C-j: Delete to Begin of Word    |   BOTTOM |    TOP   |   Yank   |  UND C   |
-  C-k: Define Key                 +----------+----------+----------+----------+
-G-C-k: Restore Key                |   WORD   |    EOL   |   CHAR   |   Next   |
-  C-l: Form Feed Insert           |    (1)   |    (2)   |    (3)   |  Window  |
-  C-n: Set Screen Width 80        | CHNGCASE |  DEL EOL |Quoted Ins|          !
-  C-r: Isearch Backward           +---------------------+----------+  (ENTER) |
-  C-s: Isearch Forward            |         LINE        |  SELECT  |          !
-  C-t: Display the Time           |         (0)         |    (.)   |   Query  |
-  C-u: Delete to Begin of Line    |      Open Line      |   RESET  |  Replace |
-  C-v: Redraw Display             +---------------------+----------+----------+
-  C-w: Set Screen Width 132       
-  C-z: Suspend Emacs                    +----------+----------+----------+
-G-C-\\: Split Window                     |  FNDNXT  |   Yank   |   CUT    |
-                                        |  (FIND)  | (INSERT) | (REMOVE) |
-  G-b: Buffer Menu                      |   FIND   |          |   COPY   |
-  G-c: Compile                          +----------+----------+----------+
-  G-d: Delete Window                    |SELECT/RES|SECT BACKW|SECT FORWA|
-  G-e: Exit                             | (SELECT) |(PREVIOUS)|  (NEXT)  |
-  G-f: Find File                        |          |          |          |
-  G-g: Find File Other Window           +----------+----------+----------+
-  G-h: Keypad Help             
-  G-i: Insert File                
-  G-k: Toggle Capitalization Word 
-  G-l: Downcase Region             
-  G-m: Save Some Buffers           
-  G-n: Next Error                  
-  G-o: Switch to Next Window
-  G-q: Quit                                                           
-  G-r: Revert File                                                    
-  G-s: Save Buffer                                                    
-  G-u: Upcase Region                                                  
-  G-v: Find File Other Window                                        
-  G-w: Write file                                                  
-  G-y: EDT Emulation OFF          
-  G-z: Switch to User EDT Key Bindings
-  G-1: Delete Other Windows       
-  G-2: Split Window               
-  G-%: Go to Percentage           
-  G- : Undo  (GOLD Spacebar)      
-  G-=: Go to Line                 
-  G-`: What line"
-
-  (interactive)
-  (describe-function 'edt-keypad-help))
-
-(defun edt-electric-helpify (fun)
-  (let ((name "*Help*"))
-    (if (save-window-excursion
-          (let* ((p (symbol-function 'print-help-return-message))
-                 (b (get-buffer name))
-                 (m (buffer-modified-p b)))
-            (and b (not (get-buffer-window b))
-                 (setq b nil))
-            (unwind-protect
-                (progn
-                  (message "%s..." (capitalize (symbol-name fun)))
-                  (and b
-                       (save-excursion
-                         (set-buffer b)
-                         (set-buffer-modified-p t)))
-                  (fset 'print-help-return-message 'ignore)
-                  (call-interactively fun)
-                  (and (get-buffer name)
-                       (get-buffer-window (get-buffer name))
-                       (or (not b)
-                           (not (eq b (get-buffer name)))
-                           (not (buffer-modified-p b)))))
-              (fset 'print-help-return-message p)
-              (and b (buffer-name b)
-                   (save-excursion
-                     (set-buffer b)
-                     (set-buffer-modified-p m))))))
-        (with-electric-help 'delete-other-windows name t))))
-
-(defun edt-electric-keypad-help ()
-  "Display default EDT bindings."
-  (interactive)
-  (edt-electric-helpify 'edt-keypad-help))
-
-(defun edt-electric-user-keypad-help ()
-  "Display user custom EDT bindings."
-  (interactive)
-  (edt-electric-helpify 'edt-user-keypad-help))
-
-;;;
-;;; EDT emulation screen width commands.
-;;;
-;; Some terminals require modification of terminal attributes when changing the
-;; number of columns displayed, hence the fboundp tests below.  These functions
-;; are defined in the corresponding terminal specific file, if needed.
-
-(defun edt-set-screen-width-80 ()
-  "Set screen width to 80 columns."
-  (interactive)
-  (if (fboundp 'edt-set-term-width-80)
-      (edt-set-term-width-80))
-  (set-screen-width 80)
-  (message "Screen width 80"))
-
-(defun edt-set-screen-width-132 ()
-  "Set screen width to 132 columns."
-  (interactive)
-  (if (fboundp 'edt-set-term-width-132)
-      (edt-set-term-width-132))
-  (set-screen-width 132)
-  (message "Screen width 132"))
-
-(provide 'edt)
-
-;;; edt.el ends here
diff --git a/lisp/emulation/mlconvert.el b/lisp/emulation/mlconvert.el
deleted file mode 100644
index 3ded26469ff..00000000000
--- a/lisp/emulation/mlconvert.el
+++ /dev/null
@@ -1,288 +0,0 @@
-;;; mlconvert.el --- convert buffer of Mocklisp code to real lisp.
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: emulations
-
-;; 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 converts Mocklisp code written under a Gosling or UniPress
-;; Emacs for use with GNU Emacs.  The translated code will require runtime
-;; support from the mlsupport.el equivalent.
-
-;;; Code:
-
-;;;###autoload
-(defun convert-mocklisp-buffer ()
-  "Convert buffer of Mocklisp code to real Lisp that GNU Emacs can run."
-  (interactive)
-  (emacs-lisp-mode)
-  (set-syntax-table (copy-sequence (syntax-table)))
-  (modify-syntax-entry ?\| "w")
-  (message "Converting mocklisp (ugh!)...")
-  (goto-char (point-min))
-  (fix-mlisp-syntax)
-
-  ;; Emulation of mocklisp is accurate only within a mocklisp-function
-  ;; so turn any non-function into a defun and then call it.
-  (goto-char (point-min))
-  (condition-case ignore
-      (while t
-	(let ((opt (point))
-	      (form (read (current-buffer))))
-	  (and (listp form)
-	       (not (eq (car form) 'defun))
-	       (progn (insert "))\n\n(ml-foo)\n\n")
-		      (save-excursion
-			(goto-char opt)
-			(skip-chars-forward "\n")
-			(insert "(defun (ml-foo \n "))))))
-    (end-of-file nil))
-
-  (goto-char (point-min))
-  (insert ";;; GNU Emacs code converted from Mocklisp\n")
-  (insert "(require 'mlsupport)\n\n")
-  (fix-mlisp-symbols)
-
-  (goto-char (point-min))
-  (message "Converting mocklisp...done"))
-
-(defun fix-mlisp-syntax ()
-  (while (re-search-forward "['\"]" nil t)
-    (if (= (preceding-char) ?\")
-	(progn (forward-char -1)
-	       (forward-sexp 1))
-      (delete-char -1)
-      (insert "?")
-    (if (or (= (following-char) ?\\) (= (following-char) ?^))
-	  (forward-char 1)
-	(if (looking-at "[^a-zA-Z]")
-	    (insert ?\\)))
-      (forward-char 1)
-      (delete-char 1))))
-
-(defun fix-mlisp-symbols ()
-  (while (progn
-	   (skip-chars-forward " \t\n()")
-	   (not (eobp)))
-    (cond ((or (= (following-char) ?\?)
-	       (= (following-char) ?\"))
-	   (forward-sexp 1))
-	  ((= (following-char) ?\;)
-	   (forward-line 1))
-	  (t
-	   (let ((start (point)) prop)
-	     (forward-sexp 1)
-	     (setq prop (get (intern-soft (buffer-substring start (point)))
-			     'mocklisp))
-	     (cond ((null prop))
-		   ((stringp prop)
-		    (delete-region start (point))
-		    (insert prop))
-		   (t
-		    (save-excursion
-		      (goto-char start)
-		      (funcall prop)))))))))
-
-(defun ml-expansion (ml-name lisp-string)
-  (put ml-name 'mocklisp lisp-string))
-
-(ml-expansion 'defun "ml-defun")
-(ml-expansion 'if "ml-if")
-(ml-expansion 'setq '(lambda ()
-		       (if (looking-at "setq[ \t\n]+buffer-modified-p")
-			   (replace-match "set-buffer-modified-p"))))
-
-;;(ml-expansion 'while '(lambda ()
-;;			 (let ((end (progn (forward-sexp 2) (point-marker)))
-;;			       (start (progn (forward-sexp -1) (point))))
-;;			   (let ((cond (buffer-substring start end)))
-;;			     (cond ((equal cond "1")
-;;				    (delete-region (point) end)
-;;				    (insert "t"))
-;;				   (t
-;;				    (insert "(not (zerop ")
-;;				    (goto-char end)
-;;				    (insert "))")))
-;;			     (set-marker end nil)
-;;			     (goto-char start)))))
-
-(ml-expansion 'arg "ml-arg")
-(ml-expansion 'nargs "ml-nargs")
-(ml-expansion 'interactive "ml-interactive")
-(ml-expansion 'message "ml-message")
-(ml-expansion 'print "ml-print")
-(ml-expansion 'set "ml-set")
-(ml-expansion 'set-default "ml-set-default")
-(ml-expansion 'provide-prefix-argument "ml-provide-prefix-argument")
-(ml-expansion 'prefix-argument-loop "ml-prefix-argument-loop")
-(ml-expansion 'prefix-argument "ml-prefix-arg")
-(ml-expansion 'use-local-map "ml-use-local-map")
-(ml-expansion 'use-global-map "ml-use-global-map")
-(ml-expansion 'modify-syntax-entry "ml-modify-syntax-entry")
-(ml-expansion 'error-message "error")
-
-(ml-expansion 'dot "point-marker")
-(ml-expansion 'mark "mark-marker")
-(ml-expansion 'beginning-of-file "beginning-of-buffer")
-(ml-expansion 'end-of-file "end-of-buffer")
-(ml-expansion 'exchange-dot-and-mark "exchange-point-and-mark")
-(ml-expansion 'set-mark "set-mark-command")
-(ml-expansion 'argument-prefix "universal-arg")
-
-(ml-expansion 'previous-page "ml-previous-page")
-(ml-expansion 'next-page "ml-next-page")
-(ml-expansion 'next-window "ml-next-window")
-(ml-expansion 'previous-window "ml-previous-window")
-
-(ml-expansion 'newline "ml-newline")
-(ml-expansion 'next-line "ml-next-line")
-(ml-expansion 'previous-line "ml-previous-line")
-(ml-expansion 'self-insert "self-insert-command")
-(ml-expansion 'meta-digit "digit-argument")
-(ml-expansion 'meta-minus "negative-argument")
-
-(ml-expansion 'newline-and-indent "ml-newline-and-indent")
-(ml-expansion 'yank-from-killbuffer "yank")
-(ml-expansion 'yank-buffer "insert-buffer")
-(ml-expansion 'copy-region "copy-region-as-kill")
-(ml-expansion 'delete-white-space "delete-horizontal-space")
-(ml-expansion 'widen-region "widen")
-
-(ml-expansion 'forward-word '(lambda ()
-			       (if (looking-at "forward-word[ \t\n]*)")
-				   (replace-match "forward-word 1)"))))
-(ml-expansion 'backward-word '(lambda ()
-			       (if (looking-at "backward-word[ \t\n]*)")
-				   (replace-match "backward-word 1)"))))
-
-(ml-expansion 'forward-paren "forward-list")
-(ml-expansion 'backward-paren "backward-list")
-(ml-expansion 'search-reverse "ml-search-backward")
-(ml-expansion 're-search-reverse "ml-re-search-backward")
-(ml-expansion 'search-forward "ml-search-forward")
-(ml-expansion 're-search-forward "ml-re-search-forward")
-(ml-expansion 'quote "regexp-quote")
-(ml-expansion 're-query-replace "query-replace-regexp")
-(ml-expansion 're-replace-string "replace-regexp")
-
-; forward-paren-bl, backward-paren-bl
-
-(ml-expansion 'get-tty-character "read-char")
-(ml-expansion 'get-tty-input "read-input")
-(ml-expansion 'get-tty-string "read-string")
-(ml-expansion 'get-tty-buffer "read-buffer")
-(ml-expansion 'get-tty-command "read-command")
-(ml-expansion 'get-tty-variable "read-variable")
-(ml-expansion 'get-tty-no-blanks-input "read-no-blanks-input")
-(ml-expansion 'get-tty-key "read-key")
-
-(ml-expansion 'concat "ml-concat")
-(ml-expansion 'c= "char-equal")
-(ml-expansion 'goto-character "goto-char")
-(ml-expansion 'substr "ml-substr")
-(ml-expansion 'variable-apropos "apropos")
-(ml-expansion 'execute-mlisp-buffer "eval-current-buffer")
-(ml-expansion 'execute-mlisp-file "load")
-(ml-expansion 'visit-file "find-file")
-(ml-expansion 'read-file "find-file")
-(ml-expansion 'write-modified-files "save-some-buffers")
-(ml-expansion 'backup-before-writing "make-backup-files")
-(ml-expansion 'write-file-exit "save-buffers-kill-emacs")
-(ml-expansion 'write-named-file "write-file")
-(ml-expansion 'change-file-name "set-visited-file-name")
-(ml-expansion 'change-buffer-name "rename-buffer")
-(ml-expansion 'buffer-exists "get-buffer")
-(ml-expansion 'delete-buffer "kill-buffer")
-(ml-expansion 'unlink-file "delete-file")
-(ml-expansion 'unlink-checkpoint-files "delete-auto-save-files")
-(ml-expansion 'file-exists "file-exists-p")
-(ml-expansion 'write-current-file "save-buffer")
-(ml-expansion 'change-directory "cd")
-(ml-expansion 'temp-use-buffer "set-buffer")
-(ml-expansion 'fast-filter-region "filter-region")
-
-(ml-expansion 'pending-input "input-pending-p")
-(ml-expansion 'execute-keyboard-macro "call-last-kbd-macro")
-(ml-expansion 'start-remembering "start-kbd-macro")
-(ml-expansion 'end-remembering "end-kbd-macro")
-(ml-expansion 'define-keyboard-macro "name-last-kbd-macro")
-(ml-expansion 'define-string-macro "ml-define-string-macro")
-
-(ml-expansion 'current-column "ml-current-column")
-(ml-expansion 'current-indent "ml-current-indent")
-(ml-expansion 'insert-character "insert")
-
-(ml-expansion 'users-login-name "user-login-name")
-(ml-expansion 'users-full-name "user-full-name")
-(ml-expansion 'current-time "current-time-string")
-(ml-expansion 'current-numeric-time "current-numeric-time-you-lose")
-(ml-expansion 'current-buffer-name "buffer-name")
-(ml-expansion 'current-file-name "buffer-file-name")
-
-(ml-expansion 'local-binding-of "local-key-binding")
-(ml-expansion 'global-binding-of "global-key-binding")
-
-;defproc (ProcedureType, "procedure-type");
-
-(ml-expansion 'remove-key-binding "global-unset-key")
-(ml-expansion 'remove-binding "global-unset-key")
-(ml-expansion 'remove-local-binding "local-unset-key")
-(ml-expansion 'remove-all-local-bindings "use-local-map nil")
-(ml-expansion 'autoload "ml-autoload")
-
-(ml-expansion 'checkpoint-frequency "auto-save-interval")
-
-(ml-expansion 'mode-string "mode-name")
-(ml-expansion 'right-margin "fill-column")
-(ml-expansion 'tab-size "tab-width")
-(ml-expansion 'default-right-margin "default-fill-column")
-(ml-expansion 'default-tab-size "default-tab-width")
-(ml-expansion 'buffer-is-modified "(buffer-modified-p)")
-
-(ml-expansion 'file-modified-time "you-lose-on-file-modified-time")
-(ml-expansion 'needs-checkpointing "you-lose-on-needs-checkpointing")
-
-(ml-expansion 'lines-on-screen "set-frame-height")
-(ml-expansion 'columns-on-screen "set-frame-width")
-
-(ml-expansion 'dumped-emacs "t")
-
-(ml-expansion 'buffer-size "ml-buffer-size")
-(ml-expansion 'dot-is-visible "pos-visible-in-window-p")
-
-(ml-expansion 'track-eol-on-^N-^P "track-eol")
-(ml-expansion 'ctlchar-with-^ "ctl-arrow")
-(ml-expansion 'help-on-command-completion-error "completion-auto-help")
-(ml-expansion 'dump-stack-trace "backtrace")
-(ml-expansion 'pause-emacs "suspend-emacs")
-(ml-expansion 'compile-it "compile")
-
-(ml-expansion '!= "/=")
-(ml-expansion '& "logand")
-(ml-expansion '| "logior")
-(ml-expansion '^ "logxor")
-(ml-expansion '! "ml-not")
-(ml-expansion '<< "lsh")
-
-;Variable pause-writes-files
-
-;;; mlconvert.el ends here
diff --git a/lisp/emulation/mlsupport.el b/lisp/emulation/mlsupport.el
deleted file mode 100644
index 7f7a357cc3c..00000000000
--- a/lisp/emulation/mlsupport.el
+++ /dev/null
@@ -1,435 +0,0 @@
-;;; mlsupport.el --- run-time support for mocklisp code.
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; 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:
-
-;; This package provides equivalents of certain primitives from Gosling
-;; Emacs (including the commercial UniPress versions).  These have an
-;; ml- prefix to distinguish them from native GNU Emacs functions with
-;; similar names.  The package mlconvert.el translates Mocklisp code
-;; to use these names.
-
-;;; Code:
-
-(defmacro ml-defun (&rest defs)
-  (list 'ml-defun-1 (list 'quote defs)))
-
-(defun ml-defun-1 (args)
-  (while args
-    (fset (car (car args)) (cons 'mocklisp (cdr (car args))))
-    (setq args (cdr args))))
-
-(defmacro declare-buffer-specific (&rest vars)
-  (cons 'progn (mapcar (function (lambda (var) (list 'make-variable-buffer-local (list 'quote var)))) vars)))
-
-(defun ml-set-default (varname value)
-  (set-default (intern varname) value))
-
-; Lossage: must make various things default missing args to the prefix arg
-; Alternatively, must make provide-prefix-argument do something hairy.
-
-(defun >> (val count) (lsh val (- count)))
-(defun novalue () nil)
-
-(defun ml-not (arg) (if (zerop arg) 1 0))
-
-(defun provide-prefix-arg (arg form)
-  (funcall (car form) arg))
-
-(defun define-keymap (name)
-  (fset (intern name) (make-keymap)))
-
-;; Make it work to use ml-use-...-map on "esc" and such.
-(fset 'esc-map esc-map)
-(fset 'ctl-x-map ctl-x-map)
-
-(defun ml-use-local-map (name)
-  (use-local-map (intern (concat name "-map"))))
-
-(defun ml-use-global-map (name)
-  (use-global-map (intern (concat name "-map"))))
-
-(defun local-bind-to-key (name key)
-  (or (current-local-map)
-      (use-local-map (make-keymap)))
-  (define-key (current-local-map)
-    (if (integerp key)
-	(if (>= key 128)
-	    (concat (char-to-string meta-prefix-char)
-		    (char-to-string (- key 128)))
-	  (char-to-string key))
-      key)
-    (intern name)))
-
-(defun bind-to-key (name key)
-  (define-key global-map (if (integerp key) (char-to-string key) key)
-    (intern name)))
-
-(defun ml-autoload (name file)
-  (autoload (intern name) file))
-
-(defun ml-define-string-macro (name defn)
-  (fset (intern name) defn))
-
-(defun push-back-character (char)
-  (setq unread-command-events (list char)))
-
-(defun to-col (column)
-  (indent-to column 0))
-
-(defmacro is-bound (&rest syms)
-  (cons 'and (mapcar (function (lambda (sym) (list 'boundp (list 'quote sym)))) syms)))
-
-(defmacro declare-global (&rest syms)
-  (cons 'progn (mapcar (function (lambda (sym) (list 'defvar sym nil))) syms)))
-
-(defmacro error-occurred (&rest body)
-  (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
-
-(defun return-prefix-argument (value)
-  (setq prefix-arg value))
-
-(defun ml-prefix-argument ()
-  (if (null current-prefix-arg) 1
-    (if (listp current-prefix-arg) (car current-prefix-arg)
-      (if (eq current-prefix-arg '-) -1
-	current-prefix-arg))))
-
-(defun ml-print (varname)
-  (interactive "vPrint variable: ")
-  (if (boundp varname)
-    (message "%s => %s" (symbol-name varname) (symbol-value varname))
-    (message "%s has no value" (symbol-name varname))))
-
-(defun ml-set (str val) (set (intern str) val))
-
-(defun ml-message (&rest args) (message "%s" (apply 'concat args)))
-
-(defun kill-to-end-of-line ()
-  (ml-prefix-argument-loop
-    (if (eolp)
-	(kill-region (point) (1+ (point)))
-      (kill-region (point) (if (search-forward ?\n nil t)
-			       (1- (point)) (point-max))))))
-
-(defun set-auto-fill-hook (arg)
-  (setq auto-fill-function (intern arg)))
-
-(defun auto-execute (function pattern)
-  (if (/= (aref pattern 0) ?*)
-      (error "Only patterns starting with * supported in auto-execute"))
-  (setq auto-mode-alist (cons (cons (concat "\\." (substring pattern 1)
-					    "\\'")
-				    function)
-			      auto-mode-alist)))
-
-(defun move-to-comment-column ()
-  (indent-to comment-column))
-
-(defun erase-region ()
-  (delete-region (point) (mark)))
-
-(defun delete-region-to-buffer (bufname)
-  (copy-to-buffer bufname (point) (mark))
-  (delete-region (point) (mark)))
-
-(defun copy-region-to-buffer (bufname)
-  (copy-to-buffer bufname (point) (mark)))
-
-(defun append-region-to-buffer (bufname)
-  (append-to-buffer bufname (point) (mark)))
-
-(defun prepend-region-to-buffer (bufname)
-  (prepend-to-buffer bufname (point) (mark)))
-
-(defun delete-next-character ()
-  (delete-char (ml-prefix-argument)))
-
-(defun delete-next-word ()
-  (delete-region (point) (progn (forward-word (ml-prefix-argument)) (point))))
-
-(defun delete-previous-word ()
-  (delete-region (point) (progn (backward-word (ml-prefix-argument)) (point))))
-
-(defun delete-previous-character ()
-  (delete-backward-char (ml-prefix-argument)))
-
-(defun forward-character ()
-  (forward-char (ml-prefix-argument)))
-
-(defun backward-character ()
-  (backward-char (ml-prefix-argument)))
-
-(defun ml-newline ()
-  (newline (ml-prefix-argument)))
-
-(defun ml-next-line ()
-  (next-line (ml-prefix-argument)))
-
-(defun ml-previous-line ()
-  (previous-line (ml-prefix-argument)))
-
-(defun delete-to-kill-buffer ()
-  (kill-region (point) (mark)))
-
-(defun narrow-region ()
-  (narrow-to-region (point) (mark)))
-
-(defun ml-newline-and-indent ()
-  (let ((column (current-indentation)))
-    (newline (ml-prefix-argument))
-    (indent-to column)))
-
-(defun newline-and-backup ()
-  (open-line (ml-prefix-argument)))
-
-(defun quote-char ()
-  (quoted-insert (ml-prefix-argument)))
-
-(defun ml-current-column ()
-  (1+ (current-column)))
-
-(defun ml-current-indent ()
-  (1+ (current-indentation)))
-
-(defun region-around-match (&optional n)
-  (set-mark (match-beginning n))
-  (goto-char (match-end n)))
-
-(defun region-to-string ()
-  (buffer-substring (min (point) (mark)) (max (point) (mark))))
-
-(defun use-abbrev-table (name)
-  (let ((symbol (intern (concat name "-abbrev-table"))))
-    (or (boundp symbol)
-	(define-abbrev-table symbol nil))
-    (symbol-value symbol)))
-
-(defun define-hooked-local-abbrev (name exp hook)
-  (define-local-abbrev name exp (intern hook)))
-
-(defun define-hooked-global-abbrev (name exp hook)
-  (define-global-abbrev name exp (intern hook)))
-
-(defun case-word-lower ()
-  (ml-casify-word 'downcase-region))
-
-(defun case-word-upper ()
-  (ml-casify-word 'upcase-region))
-
-(defun case-word-capitalize ()
-  (ml-casify-word 'capitalize-region))
-
-(defun ml-casify-word (fun)
-  (save-excursion
-   (forward-char 1)
-   (forward-word -1)
-   (funcall fun (point)
-	    (progn (forward-word (ml-prefix-argument))
-		   (point)))))
-
-(defun case-region-lower ()
-  (downcase-region (point) (mark)))
-
-(defun case-region-upper ()
-  (upcase-region (point) (mark)))
-
-(defun case-region-capitalize ()
-  (capitalize-region (point) (mark)))
-
-(defvar saved-command-line-args nil)
-
-(defun argc ()
-  (or saved-command-line-args
-      (setq saved-command-line-args command-line-args
-	    command-line-args ()))
-  (length command-line-args))
-
-(defun argv (i)
-  (or saved-command-line-args
-      (setq saved-command-line-args command-line-args
-	    command-line-args ()))
-  (nth i saved-command-line-args))
-
-(defun invisible-argc ()
-  (length (or saved-command-line-args
-	      command-line-args)))
-
-(defun invisible-argv (i)
-  (nth i (or saved-command-line-args
-	     command-line-args)))
-
-(defun exit-emacs ()
-  (interactive)
-  (condition-case ()
-      (exit-recursive-edit)
-    (error (kill-emacs))))
-
-;; Lisp function buffer-size returns total including invisible;
-;; mocklisp wants just visible.
-(defun ml-buffer-size ()
-  (- (point-max) (point-min)))
-
-(defun previous-command ()
-  last-command)
-
-(defun beginning-of-window ()
-  (goto-char (window-start)))
-
-(defun end-of-window ()
-  (goto-char (window-start))
-  (vertical-motion (- (window-height) 2)))
-
-(defun ml-search-forward (string)
-  (search-forward string nil nil (ml-prefix-argument)))
-
-(defun ml-re-search-forward (string)
-  (re-search-forward string nil nil (ml-prefix-argument)))
-
-(defun ml-search-backward (string)
-  (search-backward string nil nil (ml-prefix-argument)))
-
-(defun ml-re-search-backward (string)
-  (re-search-backward string nil nil (ml-prefix-argument)))
-
-(defvar use-users-shell 1
-  "Mocklisp compatibility variable; 1 means use shell from SHELL env var.
-0 means use /bin/sh.")
-
-(defvar use-csh-option-f 1
-  "Mocklisp compatibility variable; 1 means pass -f when calling csh.")
-
-(defun filter-region (command)
-  (let ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh"))
-	(csh (equal (file-name-nondirectory shell) "csh")))
-    (call-process-region (point) (mark) shell t t nil
-			 (if (and csh use-csh-option-f) "-cf" "-c")
-			 (concat "exec " command))))
-
-(defun execute-monitor-command (command)
-  (let ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh"))
-	(csh (equal (file-name-nondirectory shell) "csh")))
-    (call-process shell nil t t
-		  (if (and csh use-csh-option-f) "-cf" "-c")
-		  (concat "exec " command))))
-
-(defun use-syntax-table (name)
-  (set-syntax-table (symbol-value (intern (concat name "-syntax-table")))))
-
-(defun line-to-top-of-window ()
-  (recenter (1- (ml-prefix-argument))))
-
-(defun ml-previous-page (&optional arg)
-  (let ((count (or arg (ml-prefix-argument))))
-    (while (> count 0)
-      (scroll-down nil)
-      (setq count (1- count)))
-    (while (< count 0)
-      (scroll-up nil)
-      (setq count (1+ count)))))
-
-(defun ml-next-page ()
-  (previous-page (- (ml-prefix-argument))))
-
-(defun page-next-window (&optional arg)
-  (let ((count (or arg (ml-prefix-argument))))
-    (while (> count 0)
-      (scroll-other-window nil)
-      (setq count (1- count)))
-    (while (< count 0)
-      (scroll-other-window '-)
-      (setq count (1+ count)))))
-
-(defun ml-next-window ()
-  (select-window (next-window)))
-
-(defun ml-previous-window ()
-  (select-window (previous-window)))
-
-(defun scroll-one-line-up ()
-  (scroll-up (ml-prefix-argument)))
-
-(defun scroll-one-line-down ()
-  (scroll-down (ml-prefix-argument)))
-
-(defun split-current-window ()
-  (split-window (selected-window)))
-
-(defun last-key-struck () last-command-char)
-
-(defun execute-mlisp-line (string)
-  (eval (read string)))
-
-(defun move-dot-to-x-y (x y)
-  (goto-char (window-start (selected-window)))
-  (vertical-motion (1- y))
-  (move-to-column (1- x)))
-
-(defun ml-modify-syntax-entry (string)
-  (let ((i 5)
-	(len (length string))
-	(datastring (substring string 0 2)))
-    (if (= (aref string 0) ?\-)
-	(aset datastring 0 ?\ ))
-    (if (= (aref string 2) ?\{)
-	(if (= (aref string 4) ?\ )
-	    (aset datastring 0 ?\<)
-	  (error "Two-char comment delimiter: use modify-syntax-entry directly")))
-    (if (= (aref string 3) ?\})
-	(if (= (aref string 4) ?\ )
-	    (aset datastring 0 ?\>)
-	  (error "Two-char comment delimiter: use modify-syntax-entry directly")))
-    (while (< i len)
-      (modify-syntax-entry (aref string i) datastring)
-      (setq i (1+ i))
-      (if (and (< i len)
-	       (= (aref string i) ?\-))
-	  (let ((c (aref string (1- i)))
-		(lim (aref string (1+ i))))
-	    (while (<= c lim)
-	      (modify-syntax-entry c datastring)
-	      (setq c (1+ c)))
-	    (setq i (+ 2 i)))))))
-
-
-
-(defun ml-substr (string from to)
-  (let ((length (length string)))
-    (if (< from 0) (setq from (+ from length)))
-    (if (< to 0) (setq to (+ to length)))
-    (substring string from (+ from to))))
-
-(defun ml-concat (&rest args)
-  (let ((newargs nil) this)
-    (while args
-      (setq this (car args))
-      (if (numberp this)
-	  (setq this (number-to-string this)))
-      (setq newargs (cons this newargs)
-	    args (cdr args)))
-    (apply 'concat (nreverse newargs))))
-
-(provide 'mlsupport)
-
-;;; mlsupport.el ends here
diff --git a/lisp/emulation/pc-mode.el b/lisp/emulation/pc-mode.el
deleted file mode 100644
index c7db52ba567..00000000000
--- a/lisp/emulation/pc-mode.el
+++ /dev/null
@@ -1,52 +0,0 @@
-;;; pc-mode.el --- emulate certain key bindings used on PCs.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Keywords: emulations
-
-;; 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.
-
-;;; Code:
-
-;;;###autoload
-(defun pc-bindings-mode ()
-  "Set up certain key bindings for PC compatibility.
-The keys affected are:
-Delete (and its variants) delete forward instead of backward.
-C-Backspace kills backward a word (as C-Delete normally would).
-M-Backspace does undo.
-Home and End move to beginning and end of line
-C-Home and C-End move to beginning and end of buffer.
-C-Escape does list-buffers."
-
-  (interactive)
-  (define-key function-key-map [delete] "\C-d")
-  (define-key function-key-map [M-delete] [?\M-d])
-  (define-key function-key-map [C-delete] [?\M-d])
-  (global-set-key [C-M-delete] 'kill-sexp)
-  (global-set-key [C-backspace] 'backward-kill-word)
-  (global-set-key [M-backspace] 'undo)
-
-  (global-set-key [C-escape] 'list-buffers)
-
-  (global-set-key [home] 'beginning-of-line)
-  (global-set-key [end] 'end-of-line)
-  (global-set-key [C-home] 'beginning-of-buffer)
-  (global-set-key [C-end] 'end-of-buffer))
-
-;; pc-mode.el ends here
diff --git a/lisp/emulation/pc-select.el b/lisp/emulation/pc-select.el
deleted file mode 100644
index a9ca7048243..00000000000
--- a/lisp/emulation/pc-select.el
+++ /dev/null
@@ -1,689 +0,0 @@
-;;; pc-select.el --- emulate mark, cut, copy and paste from motif
-;;;		     (or MAC GUI) or MS-windoze (bah)) look-and-feel
-;;;		     including key bindings
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michael Staats <michael@thp.Uni-Duisburg.DE>
-;; Created: 26 Sep 1995
-
-;; 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 emulates the mark, copy, cut and paste look-and-feel of motif
-;; programs (which is the same as the MAC gui and (sorry for that) MS-Windows).
-;; It modifies the keybindings of the cursor keys and the next, prior,
-;; home and end keys. They will modify mark-active.
-;; You can still get the old behaviour of cursor moving with the
-;; control sequences C-f, C-b, etc.
-;; This package uses transient-mark-mode and
-;; delete-selection-mode.
-;;
-;; In addition to that all key-bindings from the pc-mode are 
-;; done here too (as suggested by RMS).
-;;
-;; As I found out after I finished the first version, s-region.el tries
-;; to do the same.... But my code is a little more complete and using
-;; delete-selection-mode is very important for the look-and-feel.
-;; Pete Forman <pete.forman@airgun.wg.waii.com> provided some motif
-;; compliant keybindings which I added. I had to modify them a little
-;; to add the -mark and -nomark functionality of cursor moving.
-;;
-;; Credits:
-;; Many thanks to all who made comments.
-;; Thanks to RMS and Ralf Muschall <prm@rz.uni-jena.de> for criticism.
-;; Kevin Cutts <cutts@ukraine.corp.mot.com> added the beginning-of-buffer
-;; and end-of-buffer functions which I modified a little.
-;; David Biesack <sasdjb@unx.sas.com> suggested some more cleanup.
-;; Thanks to Pete Forman <pete.forman@airgun.wg.waii.com>
-;; for additional motif keybindings.
-;; Thanks to jvromans@squirrel.nl (Johan Vromans) for a bug report
-;; concerning setting of this-command.
-;; Dan Nicolaescu <done@nexus.sorostm.ro> suggested suppressing the
-;; scroll-up/scroll-down error.
-;;
-;; Ok, some details about the idea of pc-selection-mode:
-;;
-;;  o The standard keys for moving around (right, left, up, down, home, end,
-;;    prior, next, called "move-keys" from now on) will always de-activate
-;;    the mark.
-;;  o If you press "Shift" together with the "move-keys", the region
-;;    you pass along is activated
-;;  o You have the copy, cut and paste functions (as in many other programs)
-;;    which will operate on the active region
-;;    It was not possible to bind them to C-v, C-x and C-c for obvious
-;;    emacs reasons.
-;;    They will be bound according to the "old" behaviour to S-delete (cut),
-;;    S-insert (paste) and C-insert (copy). These keys do the same in many
-;;    other programs.
-;;
-
-;;;; Customization:
-
-(defvar pc-select-override-scroll-error t
-  "*Non-nil means don't generate error on scrolling past edge of buffer.
-This variable applies in PC Selection mode only.
-The scroll commands normally generate an error if you try to scroll
-past the top or bottom of the buffer.  This is annoying when selecting
-text with these commands.  If you set this variable to non-nil, these
-errors are suppressed.")
-
-;;;;
-;; misc
-;;;;
-
-(provide 'pc-select)
-
-(defun copy-region-as-kill-nomark (beg end)
-  "Save the region as if killed; but don't kill it; deactivate mark.
-If `interprogram-cut-function' is non-nil, also save the text for a window
-system cut and paste.
-
-Deactivating mark is to avoid confusion with delete-selection-mode
-and transient-mark-mode."
- (interactive "r")
- (copy-region-as-kill beg end)
- (setq mark-active nil)
- (message "Region saved"))
-
-;;;;
-;; non-interactive
-;;;;
-(defun ensure-mark()
-  ;; make sure mark is active
-  ;; test if it is active, if it isn't, set it and activate it
-  (or mark-active (set-mark-command nil)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;; forward and mark
-;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun forward-char-mark (&optional arg)
-  "Ensure mark is active; move point right ARG characters (left if ARG negative).
-On reaching end of buffer, stop and signal error."
-  (interactive "p")
-  (ensure-mark)
-  (forward-char arg))
-
-(defun forward-word-mark (&optional arg)
-  "Ensure mark is active; move point right ARG words (backward if ARG is negative).
-Normally returns t.
-If an edge of the buffer is reached, point is left there
-and nil is returned."
-  (interactive "p")
-  (ensure-mark)
-  (forward-word arg))
-
-(defun forward-line-mark (&optional arg)
-  "Ensure mark is active; move cursor vertically down ARG lines."
-  (interactive "p")
-  (ensure-mark)
-  (forward-line arg)
-  (setq this-command 'forward-line)
-)
-
-(defun forward-paragraph-mark (&optional arg)
-  "Ensure mark is active; move forward to end of paragraph.
-With arg N, do it N times; negative arg -N means move backward N paragraphs.
-
-A line which `paragraph-start' matches either separates paragraphs
-\(if `paragraph-separate' matches it also) or is the first line of a paragraph.
-A paragraph end is the beginning of a line which is not part of the paragraph
-to which the end of the previous line belongs, or the end of the buffer."
-  (interactive "p")
-  (ensure-mark)
-  (forward-paragraph arg))
-
-(defun next-line-mark (&optional arg)
-  "Ensure mark is active; move cursor vertically down ARG lines.
-If there is no character in the target line exactly under the current column,
-the cursor is positioned after the character in that line which spans this
-column, or at the end of the line if it is not long enough.
-If there is no line in the buffer after this one, behavior depends on the
-value of `next-line-add-newlines'.  If non-nil, it inserts a newline character
-to create a line, and moves the cursor to that line.  Otherwise it moves the
-cursor to the end of the buffer \(if already at the end of the buffer, an error
-is signaled).
-
-The command C-x C-n can be used to create
-a semipermanent goal column to which this command always moves.
-Then it does not try to move vertically.  This goal column is stored
-in `goal-column', which is nil when there is none."
-  (interactive "p")
-  (ensure-mark)
-  (next-line arg)
-  (setq this-command 'next-line))
-
-(defun end-of-line-mark (&optional arg)
-  "Ensure mark is active; move point to end of current line.
-With argument ARG not nil or 1, move forward ARG - 1 lines first.
-If scan reaches end of buffer, stop there without error."
-  (interactive "p")
-  (ensure-mark)
-  (end-of-line arg)
-  (setq this-command 'end-of-line))
-
-(defun backward-line-mark (&optional arg)
-  "Ensure mark is active; move cursor vertically up ARG lines."
-  (interactive "p")
-  (ensure-mark)
-  (if (null arg)
-      (setq arg 1))
-  (forward-line (- arg))
-  (setq this-command 'forward-line)
-)
-
-(defun scroll-down-mark (&optional arg)
-  "Ensure mark is active; scroll down ARG lines; or near full screen if no ARG.
-A near full screen is `next-screen-context-lines' less than a full screen.
-Negative ARG means scroll upward.
-When calling from a program, supply a number as argument or nil."
-  (interactive "P") 
-  (ensure-mark)
-  (cond (pc-select-override-scroll-error
-	 (condition-case nil (scroll-down arg)
-	   (beginning-of-buffer (goto-char (point-min)))))
-	(t (scroll-down arg))))
-
-(defun end-of-buffer-mark (&optional arg)
-  "Ensure mark is active; move point to the end of the buffer.
-With arg N, put point N/10 of the way from the end.
-
-If the buffer is narrowed, this command uses the beginning and size
-of the accessible part of the buffer.
-
-Don't use this command in Lisp programs!
-\(goto-char \(point-max)) is faster and avoids clobbering the mark."
-  (interactive "P")
-  (ensure-mark)
-  (let ((size (- (point-max) (point-min))))
-    (goto-char (if arg
-		   (- (point-max)
-		      (if (> size 10000)
-			  ;; Avoid overflow for large buffer sizes!
-			  (* (prefix-numeric-value arg)
-			     (/ size 10))
-			(/ (* size (prefix-numeric-value arg)) 10)))
-		 (point-max))))
-  ;; If we went to a place in the middle of the buffer,
-  ;; adjust it to the beginning of a line.
-  (if arg (forward-line 1)
-    ;; If the end of the buffer is not already on the screen,
-    ;; then scroll specially to put it near, but not at, the bottom.
-    (if (let ((old-point (point)))
-	  (save-excursion
-		    (goto-char (window-start))
-		    (vertical-motion (window-height))
-		    (< (point) old-point)))
-	(progn
-	  (overlay-recenter (point))
-	  (recenter -3)))))
-
-;;;;;;;;;
-;;;;; no mark
-;;;;;;;;;
-
-(defun forward-char-nomark (&optional arg)
-  "Deactivate mark; move point right ARG characters \(left if ARG negative).
-On reaching end of buffer, stop and signal error."
-  (interactive "p")
-  (setq mark-active nil)
-  (forward-char arg))
-
-(defun forward-word-nomark (&optional arg)
-  "Deactivate mark; move point right ARG words \(backward if ARG is negative).
-Normally returns t.
-If an edge of the buffer is reached, point is left there
-and nil is returned."
-  (interactive "p")
-  (setq mark-active nil)
-  (forward-word arg))
-
-(defun forward-line-nomark (&optional arg)
-  "Deactivate mark; move cursor vertically down ARG lines."
-  (interactive "p")
-  (setq mark-active nil)
-  (forward-line arg)
-  (setq this-command 'forward-line)
-)
-
-(defun forward-paragraph-nomark (&optional arg)
-  "Deactivate mark; move forward to end of paragraph.
-With arg N, do it N times; negative arg -N means move backward N paragraphs.
-
-A line which `paragraph-start' matches either separates paragraphs
-\(if `paragraph-separate' matches it also) or is the first line of a paragraph.
-A paragraph end is the beginning of a line which is not part of the paragraph
-to which the end of the previous line belongs, or the end of the buffer."
-  (interactive "p")
-  (setq mark-active nil)
-  (forward-paragraph arg))
-
-(defun next-line-nomark (&optional arg)
-  "Deactivate mark; move cursor vertically down ARG lines.
-If there is no character in the target line exactly under the current column,
-the cursor is positioned after the character in that line which spans this
-column, or at the end of the line if it is not long enough.
-If there is no line in the buffer after this one, behavior depends on the
-value of `next-line-add-newlines'.  If non-nil, it inserts a newline character
-to create a line, and moves the cursor to that line.  Otherwise it moves the
-cursor to the end of the buffer (if already at the end of the buffer, an error
-is signaled).
-
-The command C-x C-n can be used to create
-a semipermanent goal column to which this command always moves.
-Then it does not try to move vertically.  This goal column is stored
-in `goal-column', which is nil when there is none."
-  (interactive "p")
-  (setq mark-active nil)
-  (next-line arg)
-  (setq this-command 'next-line))
-
-(defun end-of-line-nomark (&optional arg)
-  "Deactivate mark; move point to end of current line.
-With argument ARG not nil or 1, move forward ARG - 1 lines first.
-If scan reaches end of buffer, stop there without error."
-  (interactive "p")
-  (setq mark-active nil)
-  (end-of-line arg)
-  (setq this-command 'end-of-line))
-
-(defun backward-line-nomark (&optional arg)
-  "Deactivate mark; move cursor vertically up ARG lines."
-  (interactive "p")
-  (setq mark-active nil)
-  (if (null arg)
-      (setq arg 1))
-  (forward-line (- arg))
-  (setq this-command 'forward-line)
-)
-
-(defun scroll-down-nomark (&optional arg)
-  "Deactivate mark; scroll down ARG lines; or near full screen if no ARG.
-A near full screen is `next-screen-context-lines' less than a full screen.
-Negative ARG means scroll upward.
-When calling from a program, supply a number as argument or nil."
-  (interactive "P")
-  (setq mark-active nil)
-  (cond (pc-select-override-scroll-error
-	 (condition-case nil (scroll-down arg)
-	   (beginning-of-buffer (goto-char (point-min)))))
-	(t (scroll-down arg))))
-
-(defun end-of-buffer-nomark (&optional arg)
-  "Deactivate mark; move point to the end of the buffer.
-With arg N, put point N/10 of the way from the end.
-
-If the buffer is narrowed, this command uses the beginning and size
-of the accessible part of the buffer.
-
-Don't use this command in Lisp programs!
-\(goto-char (point-max)) is faster and avoids clobbering the mark."
-  (interactive "P")
-  (setq mark-active nil)
-  (let ((size (- (point-max) (point-min))))
-    (goto-char (if arg
-		   (- (point-max)
-		      (if (> size 10000)
-			  ;; Avoid overflow for large buffer sizes!
-			  (* (prefix-numeric-value arg)
-			     (/ size 10))
-			(/ (* size (prefix-numeric-value arg)) 10)))
-		 (point-max))))
-  ;; If we went to a place in the middle of the buffer,
-  ;; adjust it to the beginning of a line.
-  (if arg (forward-line 1)
-    ;; If the end of the buffer is not already on the screen,
-    ;; then scroll specially to put it near, but not at, the bottom.
-    (if (let ((old-point (point)))
-	  (save-excursion
-		    (goto-char (window-start))
-		    (vertical-motion (window-height))
-		    (< (point) old-point)))
-	(progn
-	  (overlay-recenter (point))
-	  (recenter -3)))))
-
-
-;;;;;;;;;;;;;;;;;;;;
-;;;;;; backwards and mark
-;;;;;;;;;;;;;;;;;;;;
-
-(defun backward-char-mark (&optional arg)
-"Ensure mark is active; move point left ARG characters (right if ARG negative).
-On attempt to pass beginning or end of buffer, stop and signal error."
-  (interactive "p")
-  (ensure-mark)
-  (backward-char arg))
-
-(defun backward-word-mark (&optional arg)
-  "Ensure mark is active; move backward until encountering the end of a word.
-With argument, do this that many times."
-  (interactive "p")
-  (ensure-mark)
-  (backward-word arg))
-
-(defun backward-paragraph-mark (&optional arg)
-  "Ensure mark is active; move backward to start of paragraph.
-With arg N, do it N times; negative arg -N means move forward N paragraphs.
-
-A paragraph start is the beginning of a line which is a
-`first-line-of-paragraph' or which is ordinary text and follows a
-paragraph-separating line; except: if the first real line of a
-paragraph is preceded by a blank line, the paragraph starts at that
-blank line.
-
-See `forward-paragraph' for more information."
-  (interactive "p")
-  (ensure-mark)
-  (backward-paragraph arg))
-
-(defun previous-line-mark (&optional arg)
-  "Ensure mark is active; move cursor vertically up ARG lines.
-If there is no character in the target line exactly over the current column,
-the cursor is positioned after the character in that line which spans this
-column, or at the end of the line if it is not long enough.
-
-The command C-x C-n can be used to create
-a semipermanent goal column to which this command always moves.
-Then it does not try to move vertically.
-
-If you are thinking of using this in a Lisp program, consider using
-`forward-line' with a negative argument instead.  It is usually easier
-to use and more reliable (no dependence on goal column, etc.)."
-  (interactive "p")
-  (ensure-mark)
-  (previous-line arg)
-  (setq this-command 'previous-line))
-
-(defun beginning-of-line-mark (&optional arg)
-  "Ensure mark is active; move point to beginning of current line.
-With argument ARG not nil or 1, move forward ARG - 1 lines first.
-If scan reaches end of buffer, stop there without error."
-  (interactive "p")
-  (ensure-mark)
-  (beginning-of-line arg))
-
-
-(defun scroll-up-mark (&optional arg)
-"Ensure mark is active; scroll upward ARG lines; or near full screen if no ARG.
-A near full screen is `next-screen-context-lines' less than a full screen.
-Negative ARG means scroll downward.
-When calling from a program, supply a number as argument or nil."
-  (interactive "P")
-  (ensure-mark)
-  (cond (pc-select-override-scroll-error
-	 (condition-case nil (scroll-up arg)
-	   (end-of-buffer (goto-char (point-max)))))
-	(t (scroll-up arg))))
-
-(defun beginning-of-buffer-mark (&optional arg)
-  "Ensure mark is active; move point to the beginning of the buffer.
-With arg N, put point N/10 of the way from the beginning.
-
-If the buffer is narrowed, this command uses the beginning and size
-of the accessible part of the buffer.
-
-Don't use this command in Lisp programs!
-\(goto-char (p\oint-min)) is faster and avoids clobbering the mark."
-  (interactive "P")
-  (ensure-mark) 
-  (let ((size (- (point-max) (point-min))))
-    (goto-char (if arg
-		   (+ (point-min)
-		      (if (> size 10000)
-			  ;; Avoid overflow for large buffer sizes!
-			  (* (prefix-numeric-value arg)
-			     (/ size 10))
-			(/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
-		 (point-min))))
-  (if arg (forward-line 1)))
-
-;;;;;;;;
-;;; no mark
-;;;;;;;;
-
-(defun backward-char-nomark (&optional arg)
-  "Deactivate mark; move point left ARG characters (right if ARG negative).
-On attempt to pass beginning or end of buffer, stop and signal error."
-  (interactive "p")
-  (setq mark-active nil)
-  (backward-char arg))
-
-(defun backward-word-nomark (&optional arg)
-  "Deactivate mark; move backward until encountering the end of a word.
-With argument, do this that many times."
-  (interactive "p")
-  (setq mark-active nil)
-  (backward-word arg))
-
-(defun backward-paragraph-nomark (&optional arg)
-  "Deactivate mark; move backward to start of paragraph.
-With arg N, do it N times; negative arg -N means move forward N paragraphs.
-
-A paragraph start is the beginning of a line which is a
-`first-line-of-paragraph' or which is ordinary text and follows a
-paragraph-separating line; except: if the first real line of a
-paragraph is preceded by a blank line, the paragraph starts at that
-blank line.
-
-See `forward-paragraph' for more information."
-  (interactive "p")
-  (setq mark-active nil)
-  (backward-paragraph arg))
-
-(defun previous-line-nomark (&optional arg)
-  "Deactivate mark; move cursor vertically up ARG lines.
-If there is no character in the target line exactly over the current column,
-the cursor is positioned after the character in that line which spans this
-column, or at the end of the line if it is not long enough.
-
-The command C-x C-n can be used to create
-a semipermanent goal column to which this command always moves.
-Then it does not try to move vertically."
-  (interactive "p")
-  (setq mark-active nil)
-  (previous-line arg)
-  (setq this-command 'previous-line))
-
-(defun beginning-of-line-nomark (&optional arg)
-  "Deactivate mark; move point to beginning of current line.
-With argument ARG not nil or 1, move forward ARG - 1 lines first.
-If scan reaches end of buffer, stop there without error."
-  (interactive "p")
-  (setq mark-active nil)
-  (beginning-of-line arg))
-
-(defun scroll-up-nomark (&optional arg)
-  "Deactivate mark; scroll upward ARG lines; or near full screen if no ARG.
-A near full screen is `next-screen-context-lines' less than a full screen.
-Negative ARG means scroll downward.
-When calling from a program, supply a number as argument or nil."
-  (interactive "P")
-  (setq mark-active nil)
-  (cond (pc-select-override-scroll-error
-	 (condition-case nil (scroll-up arg)
-	   (end-of-buffer (goto-char (point-max)))))
-	(t (scroll-up arg))))
-
-(defun beginning-of-buffer-nomark (&optional arg)
-  "Deactivate mark; move point to the beginning of the buffer.
-With arg N, put point N/10 of the way from the beginning.
-
-If the buffer is narrowed, this command uses the beginning and size
-of the accessible part of the buffer.
-
-Don't use this command in Lisp programs!
-\(goto-char (point-min)) is faster and avoids clobbering the mark."
-  (interactive "P")
-  (setq mark-active nil)
-  (let ((size (- (point-max) (point-min))))
-    (goto-char (if arg
-		   (+ (point-min)
-		      (if (> size 10000)
-			  ;; Avoid overflow for large buffer sizes!
-			  (* (prefix-numeric-value arg)
-			     (/ size 10))
-			(/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
-		 (point-min))))
-  (if arg (forward-line 1)))
-
-;;;###autoload
-(defun pc-selection-mode ()
-  "Change mark behaviour to emulate Motif, MAC or MS-Windows cut and paste style.
-
-This mode enables Delete Selection mode and Transient Mark mode.
-
-The arrow keys (and others) are bound to new functions
-which modify the status of the mark.
-
-The ordinary arrow keys disable the mark.
-The shift-arrow keys move, leaving the mark behind.
-
-C-LEFT and C-RIGHT move back or forward one word, disabling the mark.
-S-C-LEFT and S-C-RIGHT move back or forward one word, leaving the mark behind.
-
-C-DOWN and C-UP move back or forward a paragraph, disabling the mark.
-S-C-DOWN and S-C-UP move back or forward a paragraph, leaving the mark behind.
-
-HOME moves to beginning of line, disabling the mark.
-S-HOME moves to beginning of line, leaving the mark behind.
-With Ctrl or Meta, these keys move to beginning of buffer instead.
-
-END moves to end of line, disabling the mark.
-S-END moves to end of line, leaving the mark behind.
-With Ctrl or Meta, these keys move to end of buffer instead.
-
-PRIOR or PAGE-UP scrolls and disables the mark.
-S-PRIOR or S-PAGE-UP scrolls and leaves the mark behind.
-
-S-DELETE kills the region (`kill-region').
-S-INSERT yanks text from the kill ring (`yank').
-C-INSERT copies the region into the kill ring (`copy-region-as-kill').
-
-In addition, certain other PC bindings are imitated:
-
-  F6           other-window
-  DELETE       delete-char
-  C-DELETE     kill-line
-  M-DELETE     kill-word
-  C-M-DELETE   kill-sexp
-  C-BACKSPACE  backward-kill-word
-  M-BACKSPACE  undo"
-
-  (interactive)
-  ;;
-  ;; keybindings
-  ;;
-
-  ;; This is to avoid confusion with the delete-selection-mode
-  ;; On simple displays you can't see that a region is active and
-  ;; will be deleted on the next keypress. IMHO especially for
-  ;; copy-region-as-kill this is confusing
-  (define-key global-map "\M-w" 'copy-region-as-kill-nomark) 
-
-
-  ;; The following keybindings are for standard ISO keyboards
-  ;; as they are used with IBM compatible PCs, IBM RS/6000,
-  ;; MACs, many X-Stations and probably more
-  (define-key global-map [S-right]   'forward-char-mark)
-  (define-key global-map [right]     'forward-char-nomark)
-  (define-key global-map [C-S-right] 'forward-word-mark)
-  (define-key global-map [C-right]   'forward-word-nomark)
-  (define-key global-map [M-S-right] 'forward-word-mark)
-  (define-key global-map [M-right]   'forward-word-nomark)
-
-  (define-key global-map [S-down]    'next-line-mark)
-  (define-key global-map [down]      'next-line-nomark)
-
-  (define-key global-map [S-end]     'end-of-line-mark)
-  (define-key global-map [end]       'end-of-line-nomark)
-  (global-set-key [S-C-end]          'end-of-buffer-mark)
-  (global-set-key [C-end]            'end-of-buffer-nomark)
-  (global-set-key [S-M-end]          'end-of-buffer-mark)
-  (global-set-key [M-end]            'end-of-buffer-nomark)
-
-  (define-key global-map [S-next]    'scroll-up-mark)
-  (define-key global-map [next]      'scroll-up-nomark)
-
-  (define-key global-map [S-left]    'backward-char-mark)
-  (define-key global-map [left]      'backward-char-nomark)
-  (define-key global-map [C-S-left]  'backward-word-mark)
-  (define-key global-map [C-left]    'backward-word-nomark)
-  (define-key global-map [M-S-left]  'backward-word-mark)
-  (define-key global-map [M-left]    'backward-word-nomark)
-
-  (define-key global-map [S-up]      'previous-line-mark)
-  (define-key global-map [up]        'previous-line-nomark)
-
-  (define-key global-map [S-home]    'beginning-of-line-mark)
-  (define-key global-map [home]      'beginning-of-line-nomark)
-  (global-set-key [S-C-home]         'beginning-of-buffer-mark)
-  (global-set-key [C-home]           'beginning-of-buffer-nomark)
-  (global-set-key [S-M-home]         'beginning-of-buffer-mark)
-  (global-set-key [M-home]           'beginning-of-buffer-nomark)
-
-  (define-key global-map [S-prior]   'scroll-down-mark)
-  (define-key global-map [prior]     'scroll-down-nomark)
-
-  (define-key global-map [S-insert]  'yank)
-  (define-key global-map [C-insert]  'copy-region-as-kill)
-  (define-key global-map [S-delete]  'kill-region)
-
-  (define-key global-map [M-S-down]  'forward-line-mark)
-  (define-key global-map [M-down]    'forward-line-nomark)
-  (define-key global-map [M-S-up]    'backward-line-mark)
-  (define-key global-map [M-up]      'backward-line-nomark)
-
-  ;; The following bindings are useful on Sun Type 3 keyboards
-  ;; They implement the Get-Delete-Put (copy-cut-paste)
-  ;; functions from sunview on the L6, L8 and L10 keys
-  (define-key global-map [f16]  'yank)
-  (define-key global-map [f18]  'copy-region-as-kill)
-  (define-key global-map [f20]  'kill-region)
-
-  ;; The following bindings are from Pete Forman.
-  ;; I modified them a little to work together with the
-  ;; mark functionality I added.
-
-  (global-set-key [f6] 'other-window)	; KNextPane     F6
-  (global-set-key [delete] 'delete-char) ; KDelete       Del
-  (global-set-key [C-delete] 'kill-line) ; KEraseEndLine cDel
-  (global-set-key [M-backspace] 'undo)	; KUndo         aBS
-  (global-set-key [C-down] 'forward-paragraph-nomark) ; KNextPara     cDn
-  (global-set-key [C-up] 'backward-paragraph-nomark) ; KPrevPara     cUp
-  (global-set-key [S-C-down] 'forward-paragraph-mark)
-  (global-set-key [S-C-up] 'backward-paragraph-mark) 
-
-  ;; The following bindings are taken from pc-mode.el
-  ;; as suggested by RMS.
-  ;; I only used the ones that are not covered above.
-  (define-key function-key-map  [M-delete] [?\M-d])
-  (global-set-key [C-M-delete]  'kill-sexp)
-  (global-set-key [C-backspace] 'backward-kill-word)
-  (global-set-key [C-escape]    'list-buffers)
-
-  ;;        
-  ;; setup
-  ;;
-  (setq transient-mark-mode t)
-  (setq mark-even-if-inactive t)
-  (delete-selection-mode 1)
-)
-;;; pc-select.el ends here
diff --git a/lisp/emulation/tpu-edt.el b/lisp/emulation/tpu-edt.el
deleted file mode 100644
index 7388e5144c0..00000000000
--- a/lisp/emulation/tpu-edt.el
+++ /dev/null
@@ -1,2490 +0,0 @@
-;;; tpu-edt.el --- Emacs emulating TPU emulating EDT
-
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Rob Riepel <riepel@networking.stanford.edu>
-;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
-;; Version: 4.2
-;; Keywords: emulations
-
-;; 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.
-
-;; TPU-edt is based on tpu.el by Jeff Kowalski and Bob Covey.
-
-;;; Commentary:
-
-;; %% TPU-edt -- Emacs emulating TPU emulating EDT
-
-;; %% Contents
-
-;;  % Introduction
-;;  % Differences Between TPU-edt and DEC TPU/edt
-;;  % Starting TPU-edt
-;;  % Customizing TPU-edt using the Emacs Initialization File
-;;  % Regular Expressions in TPU-edt
-
-
-;; %% Introduction
-
-;;    TPU-edt emulates the popular DEC VMS editor EDT (actually, it emulates
-;;    DEC TPU's EDT emulation, hence the name TPU-edt).  TPU-edt features the
-;;    following TPU/edt functionality:
-
-;;     .  EDT keypad
-;;     .  On-line help
-;;     .  Repeat counts
-;;     .  Scroll margins
-;;     .  Learn sequences
-;;     .  Free cursor mode
-;;     .  Rectangular cut and paste
-;;     .  Multiple windows and buffers
-;;     .  TPU line-mode REPLACE command
-;;     .  Wild card search and substitution
-;;     .  Configurable through an initialization file
-;;     .  History recall of search strings, file names, and commands
-
-;;    Please note that TPU-edt does NOT emulate TPU.  It emulates TPU's EDT
-;;    emulation.  Very few TPU line-mode commands are supported.
-
-;;    TPU-edt, like its VMS cousin, works on VT-series terminals with DEC
-;;    style keyboards.  VT terminal emulators, including xterm with the
-;;    appropriate key translations, work just fine too.
-
-;;    TPU-edt works with X-windows.  This is accomplished through a TPU-edt X
-;;    key map.  The TPU-edt module tpu-mapper creates this map and stores it
-;;    in a file.  Tpu-mapper will be run automatically the first time you
-;;    invoke the X-windows version of emacs, or you can run it by hand.  See
-;;    the commentary in tpu-mapper.el for details.
-
-
-;; %% Differences Between TPU-edt and DEC TPU/edt
-
-;;    In some cases, Emacs doesn't support text highlighting, so selected
-;;    regions are not shown in inverse video.  Emacs uses the concept of "the
-;;    mark".  The mark is set at one end of a selected region; the cursor is
-;;    at the other.  The letter "M" appears in the mode line when the mark is
-;;    set.  The native emacs command ^X^X (Control-X twice) exchanges the
-;;    cursor with the mark; this provides a handy way to find the location of
-;;    the mark.
-
-;;    In TPU the cursor can be either bound or free.  Bound means the cursor
-;;    cannot wander outside the text of the file being edited.  Free means
-;;    the arrow keys can move the cursor past the ends of lines.  Free is the
-;;    default mode in TPU; bound is the only mode in EDT.  Bound is the only
-;;    mode in the base version of TPU-edt; optional extensions add an
-;;    approximation of free mode, see the commentary in tpu-extras.el for
-;;    details.
-
-;;    Like TPU, emacs uses multiple buffers.  Some buffers are used to hold
-;;    files you are editing; other "internal" buffers are used for emacs' own
-;;    purposes (like showing you help).  Here are some commands for dealing
-;;    with buffers.
-
-;;       Gold-B   moves to next buffer, including internal buffers
-;;       Gold-N   moves to next buffer containing a file
-;;       Gold-M   brings up a buffer menu (like TPU "show buffers")
-
-;;    Emacs is very fond of throwing up new windows.  Dealing with all these
-;;    windows can be a little confusing at first, so here are a few commands
-;;    to that may help:
-
-;;       Gold-Next_Scr  moves to the next window on the screen
-;;       Gold-Prev_Scr  moves to the previous window on the screen
-;;       Gold-TAB       also moves to the next window on the screen
-
-;;       Control-x 1    deletes all but the current window
-;;       Control-x 0    deletes the current window
-
-;;    Note that the buffers associated with deleted windows still exist!
-
-;;    Like TPU, TPU-edt has a "command" function, invoked with Gold-KP7 or
-;;    Do.  Most of the commands available are emacs commands.  Some TPU
-;;    commands are available, they are: replace, exit, quit, include, and
-;;    Get (unfortunately, "get" is an internal emacs function, so we are
-;;    stuck with "Get" - to make life easier, Get is available as Gold-g).
-
-;;    TPU-edt supports the recall of commands, file names, and search
-;;    strings.  The history of strings recalled differs slightly from
-;;    TPU/edt, but it is still very convenient.
-
-;;    Help is available!  The traditional help keys (Help and PF2) display
-;;    a small help file showing the default keypad layout, control key
-;;    functions, and Gold key functions.  Pressing any key inside of help
-;;    splits the screen and prints a description of the function of the
-;;    pressed key.  Gold-PF2 invokes the native emacs help, with its
-;;    zillions of options.
-
-;;    Thanks to emacs, TPU-edt has some extensions that may make your life
-;;    easier, or at least more interesting.  For example, Gold-r toggles
-;;    TPU-edt rectangular mode.  In rectangular mode, Remove and Insert work
-;;    on rectangles.  Likewise, Gold-* toggles TPU-edt regular expression
-;;    mode.  In regular expression mode Find, Find Next, and the line-mode
-;;    replace command work with regular expressions.  [A regular expression
-;;    is a pattern that denotes a set of strings; like VMS wildcards.]
-
-;;    Emacs also gives TPU-edt the undo and occur functions.  Undo does
-;;    what it says; it undoes the last change.  Multiple undos in a row
-;;    undo multiple changes.  For your convenience, undo is available on
-;;    Gold-u.  Occur shows all the lines containing a specific string in
-;;    another window.  Moving to that window, and typing ^C^C (Control-C
-;;    twice) on a particular line moves you back to the original window
-;;    at that line.  Occur is on Gold-o.
-
-;;    Finally, as you edit, remember that all the power of emacs is at
-;;    your disposal.  It really is a fantastic tool.  You may even want to
-;;    take some time and read the emacs tutorial; perhaps not to learn the
-;;    native emacs key bindings, but to get a feel for all the things
-;;    emacs can do for you.  The emacs tutorial is available from the
-;;    emacs help function: "Gold-PF2 t"
-
-
-;; %% Starting TPU-edt
-
-;;    All you have to do to start TPU-edt, is turn it on.  This can be
-;;    done from the command line when running emacs.
-
-;;        prompt> emacs -f tpu-edt
-
-;;    If you've already started emacs, turn on TPU-edt using the tpu-edt
-;;    command.  First press `M-x' (that's usually `ESC' followed by `x')
-;;    and type `tpu-edt' followed by a carriage return.
-
-;;    If you like TPU-edt and want to use it all the time, you can start
-;;    TPU-edt using the emacs initialization file, .emacs.  Simply create
-;;    a .emacs file in your home directory containing the line:
-
-;;        (tpu-edt)
-
-;;    That's all you need to do to start TPU-edt.
-
-
-;; %% Customizing TPU-edt using the Emacs Initialization File
-
-;;    The following is a sample emacs initialization file.  It shows how to
-;;    invoke TPU-edt, and how to customize it.
-
-;;    ; .emacs - a sample emacs initialization file
-
-;;    ; Turn on TPU-edt
-;;    (tpu-edt)
-
-;;    ; Set scroll margins 10% (top) and 15% (bottom).
-;;    (tpu-set-scroll-margins "10%" "15%")       
-
-;;    ; Load the vtxxx terminal control functions.
-;;    (load "vt-control" t)
-
-;;    ; TPU-edt treats words like EDT; here's how to add word separators.
-;;    ; Note that backslash (\) and double quote (") are quoted with '\'.
-;;    (tpu-add-word-separators "]\\[-_,.\"=+()'/*#:!&;$")
-
-;;    ; Emacs is happy to save files without a final newline; other Unix
-;;    ; programs hate that!  Here we make sure that files end with newlines.
-;;    (setq require-final-newline t)
-
-;;    ; Emacs uses Control-s and Control-q.  Problems can occur when using
-;;    ; emacs on terminals that use these codes for flow control (Xon/Xoff
-;;    ; flow control).  These lines disable emacs' use of these characters.
-;;    (global-unset-key "\C-s")
-;;    (global-unset-key "\C-q")
-
-;;    ; The emacs universal-argument function is very useful.
-;;    ; This line maps universal-argument to Gold-PF1.
-;;    (define-key GOLD-SS3-map "P" 'universal-argument)          ; Gold-PF1
-
-;;    ; Make KP7 move by paragraphs, instead of pages.
-;;    (define-key SS3-map "w" 'tpu-paragraph)                    ; KP7
-
-;;    ; Repeat the preceding mappings for X-windows.
-;;    (cond
-;;     (window-system
-;;      (global-set-key [kp_7] 'tpu-paragraph)                   ; KP7
-;;      (define-key GOLD-map [kp_f1] 'universal-argument)))      ; GOLD-PF1
-
-;;    ; Display the TPU-edt version.
-;;    (tpu-version)
-
-
-;; %% Regular Expressions in TPU-edt
-
-;;    Gold-* toggles TPU-edt regular expression mode.  In regular expression
-;;    mode, find, find next, replace, and substitute accept emacs regular
-;;    expressions.  A complete list of emacs regular expressions can be found
-;;    using the emacs "info" command (it's somewhat like the VMS help
-;;    command).  Try the following sequence of commands:
-
-;;        DO info             <enter info mode>
-;;        m emacs             <select the "emacs" topic>
-;;        m regexs            <select the "regular expression" topic>
-
-;;    Type "q" to quit out of info mode.
-
-;;    There is a problem in regular expression mode when searching for empty
-;;    strings, like beginning-of-line (^) and end-of-line ($).  When searching
-;;    for these strings, find-next may find the current string, instead of the
-;;    next one.  This can cause global replace and substitute commands to loop
-;;    forever in the same location.  For this reason, commands like
-
-;;        replace "^" "> "       <add "> " to beginning of line>
-;;        replace "$" "00711"    <add "00711" to end of line>
-
-;;    may not work properly.
-
-;;    Commands like those above are very useful for adding text to the
-;;    beginning or end of lines.  They might work on a line-by-line basis, but
-;;    go into an infinite loop if the "all" response is specified.  If the
-;;    goal is to add a string to the beginning or end of a particular set of
-;;    lines TPU-edt provides functions to do this.
-
-;;        Gold-^  Add a string at BOL in region or buffer
-;;        Gold-$  Add a string at EOL in region or buffer
-
-;;    There is also a TPU-edt interface to the native emacs string replacement
-;;    commands.  Gold-/ invokes this command.  It accepts regular expressions
-;;    if TPU-edt is in regular expression mode.  Given a repeat count, it will
-;;    perform the replacement without prompting for confirmation.
-
-;;    This command replaces empty strings correctly, however, it has its
-;;    drawbacks.  As a native emacs command, it has a different interface
-;;    than the emulated TPU commands.  Also, it works only in the forward
-;;    direction, regardless of the current TPU-edt direction.
-
-;;; Code:
-
-
-;;;
-;;;  Version Information
-;;;
-(defconst tpu-version "4.2" "TPU-edt version number.")
-
-
-;;;
-;;;  User Configurable Variables
-;;;
-(defconst tpu-have-ispell t
-  "*If non-nil (default), TPU-edt uses ispell for spell checking.")
-
-(defconst tpu-kill-buffers-silently nil
-  "*If non-nil, TPU-edt kills modified buffers without asking.")
-
-(defvar tpu-percent-scroll 75
-  "*Percentage of the screen to scroll for next/previous screen commands.")
-
-(defvar tpu-pan-columns 16
-  "*Number of columns the tpu-pan functions scroll left or right.")
-
-
-;;;
-;;;  Emacs version identifiers - currently referenced by
-;;;
-;;;     o tpu-mark              o tpu-set-mark
-;;;     o tpu-string-prompt     o tpu-regexp-prompt
-;;;     o tpu-edt-on            o tpu-load-xkeys
-;;;     o tpu-update-mode-line  o mode line section
-;;;
-(defconst tpu-emacs19-p (not (string-lessp emacs-version "19"))
-  "Non-nil if we are running Lucid Emacs or version 19.")
-
-(defconst tpu-lucid-emacs19-p
-  (and tpu-emacs19-p (string-match "Lucid" emacs-version))
-  "Non-nil if we are running Lucid Emacs version 19.")
-
-
-;;;
-;;;  Global Keymaps
-;;;
-(defvar CSI-map (make-sparse-keymap)
-  "Maps the CSI function keys on the VT100 keyboard.
-CSI is DEC's name for the sequence <ESC>[.")
-
-(defvar SS3-map (make-sparse-keymap)
-  "Maps the SS3 function keys on the VT100 keyboard.
-SS3 is DEC's name for the sequence <ESC>O.")
-
-(defvar GOLD-map (make-keymap)
-  "Maps the function keys on the VT100 keyboard preceded by PF1.
-GOLD is the ASCII 7-bit escape sequence <ESC>OP.")
-
-(defvar GOLD-CSI-map (make-sparse-keymap)
-  "Maps the function keys on the VT100 keyboard preceded by GOLD-CSI.")
-
-(defvar GOLD-SS3-map (make-sparse-keymap)
-  "Maps the function keys on the VT100 keyboard preceded by GOLD-SS3.")
-
-(defvar tpu-global-map nil "TPU-edt global keymap.")
-(defvar tpu-original-global-map (copy-keymap global-map)
-  "Original global keymap.")
-
-(and tpu-lucid-emacs19-p
-     (defvar minibuffer-local-ns-map (make-sparse-keymap)
-       "Hack to give Lucid Emacs the same maps as ordinary Emacs."))
-
-
-;;;
-;;;  Global Variables
-;;;
-(defvar tpu-edt-mode nil
-  "If non-nil, TPU-edt mode is active.")
-
-(defvar tpu-last-replaced-text ""
-  "Last text deleted by a TPU-edt replace command.")
-(defvar tpu-last-deleted-region ""
-  "Last text deleted by a TPU-edt remove command.")
-(defvar tpu-last-deleted-lines ""
-  "Last text deleted by a TPU-edt line-delete command.")
-(defvar tpu-last-deleted-words ""
-  "Last text deleted by a TPU-edt word-delete command.")
-(defvar tpu-last-deleted-char ""
-  "Last character deleted by a TPU-edt character-delete command.")
-
-(defvar tpu-searching-forward t
-  "If non-nil, TPU-edt is searching in the forward direction.")
-(defvar tpu-search-last-string ""
-  "Last text searched for by the TPU-edt search commands.")
-
-(defvar tpu-regexp-p nil
-  "If non-nil, TPU-edt uses regexp search and replace routines.")
-(defvar tpu-rectangular-p nil
-  "If non-nil, TPU-edt removes and inserts rectangles.")
-(defvar tpu-advance t
-  "True when TPU-edt is operating in the forward direction.")
-(defvar tpu-reverse nil
-  "True when TPU-edt is operating in the backward direction.")
-(defvar tpu-control-keys nil
-  "If non-nil, control keys are set to perform TPU functions.")
-(defvar tpu-xkeys-file nil
-  "File containing TPU-edt X key map.")
-
-(defvar tpu-rectangle-string nil
-  "Mode line string to identify rectangular mode.")
-(defvar tpu-direction-string nil
-  "Mode line string to identify current direction.")
-
-(defvar tpu-add-at-bol-hist nil
-  "History variable for tpu-edt-add-at-bol function.")
-(defvar tpu-add-at-eol-hist nil
-  "History variable for tpu-edt-add-at-eol function.")
-(defvar tpu-regexp-prompt-hist  nil
-  "History variable for search and replace functions.")
-
-
-;;;
-;;;  Buffer Local Variables
-;;;
-(defvar tpu-newline-and-indent-p nil
-  "If non-nil, Return produces a newline and indents.")
-(make-variable-buffer-local 'tpu-newline-and-indent-p)
-
-(defvar tpu-newline-and-indent-string nil
-  "Mode line string to identify AutoIndent mode.")
-(make-variable-buffer-local 'tpu-newline-and-indent-string)
-
-(defvar tpu-saved-delete-func nil
-  "Saved value of the delete key.")
-(make-variable-buffer-local 'tpu-saved-delete-func)
-
-(defvar tpu-buffer-local-map nil
-  "TPU-edt buffer local key map.")
-(make-variable-buffer-local 'tpu-buffer-local-map)
-
-
-;;;
-;;;  Mode Line - Modify the mode line to show the following
-;;;
-;;;     o  If the mark is set.
-;;;     o  Direction of motion.
-;;;     o  Active rectangle mode.
-;;;
-(defvar tpu-original-mode-line mode-line-format)
-(defvar tpu-original-mm-alist minor-mode-alist)
-
-(defvar tpu-mark-flag " ")
-(make-variable-buffer-local 'tpu-mark-flag)
-
-(defun tpu-set-mode-line (for-tpu)
-  "Set the mode for TPU-edt, or reset it to default Emacs."
-  (cond ((not for-tpu)
-	 (setq mode-line-format tpu-original-mode-line)
-	 (setq minor-mode-alist tpu-original-mm-alist))
-	(t
-	 (setq-default mode-line-format
-		       (list (purecopy "")
-			     'mode-line-modified
-			     'mode-line-buffer-identification
-			     (purecopy "  ")
-			     'global-mode-string
-			     (purecopy "  ")
-			     'tpu-mark-flag
-			     (purecopy " %[(")
-			     'mode-name 'mode-line-process 'minor-mode-alist
-			     (purecopy "%n")
-			     (purecopy ")%]--")
-			     (purecopy '(line-number-mode "L%l--"))
-			     (purecopy '(column-number-mode "C%c--"))
-			     (purecopy '(-3 . "%p"))
-			     (purecopy "-%-")))
-	 (or (assq 'tpu-newline-and-indent-p minor-mode-alist)
-	     (setq minor-mode-alist
-		   (cons '(tpu-newline-and-indent-p
-			   tpu-newline-and-indent-string)
-			 minor-mode-alist)))
-	 (or (assq 'tpu-rectangular-p minor-mode-alist)
-	     (setq minor-mode-alist
-		   (cons '(tpu-rectangular-p tpu-rectangle-string)
-			 minor-mode-alist)))
-	 (or (assq 'tpu-direction-string minor-mode-alist)
-	     (setq minor-mode-alist
-		   (cons '(tpu-direction-string tpu-direction-string)
-			 minor-mode-alist))))))
-
-(defun tpu-update-mode-line nil
-  "Make sure mode-line in the current buffer reflects all changes."
-  (setq tpu-mark-flag (if (tpu-mark) "M" " "))
-  (cond (tpu-emacs19-p (force-mode-line-update))
-	(t (set-buffer-modified-p (buffer-modified-p)) (sit-for 0))))
-
-(cond (tpu-lucid-emacs19-p
-       (add-hook 'zmacs-deactivate-region-hook 'tpu-update-mode-line)
-       (add-hook 'zmacs-activate-region-hook 'tpu-update-mode-line))
-      (tpu-emacs19-p
-       (add-hook 'activate-mark-hook 'tpu-update-mode-line)
-       (add-hook 'deactivate-mark-hook 'tpu-update-mode-line)))
-
-
-;;;
-;;;  Match Markers -
-;;;
-;;;     Set in:  Search
-;;;
-;;;     Used in: Replace, Substitute, Store-Text, Cut/Remove,
-;;;              Append, and Change-Case
-;;;
-(defvar tpu-match-beginning-mark (make-marker))
-(defvar tpu-match-end-mark (make-marker))
-
-(defun tpu-set-match nil
-  "Set markers at match beginning and end."
-  ;; Add one to beginning mark so it stays with the first character of
-  ;;   the string even if characters are added just before the string.
-  (setq tpu-match-beginning-mark (copy-marker (1+ (match-beginning 0))))
-  (setq tpu-match-end-mark (copy-marker (match-end 0))))
-
-(defun tpu-unset-match nil
-  "Unset match beginning and end markers."
-  (set-marker tpu-match-beginning-mark nil)
-  (set-marker tpu-match-end-mark nil))
-
-(defun tpu-match-beginning nil
-  "Returns the location of the last match beginning."
-  (1- (marker-position tpu-match-beginning-mark)))
-
-(defun tpu-match-end nil
-  "Returns the location of the last match end."
-  (marker-position tpu-match-end-mark))
-
-(defun tpu-check-match nil
-  "Returns t if point is between tpu-match markers.
-Otherwise sets the tpu-match markers to nil and returns nil."
-  ;; make sure 1- marker is in this buffer
-  ;;           2- point is at or after beginning marker
-  ;;           3- point is before ending marker, or in the case of
-  ;;              zero length regions (like bol, or eol) that the
-  ;;              beginning, end, and point are equal.
-  (cond ((and
-	  (equal (marker-buffer tpu-match-beginning-mark) (current-buffer))
-	  (>= (point) (1- (marker-position tpu-match-beginning-mark)))
-	  (or
-	   (< (point) (marker-position tpu-match-end-mark))
-	   (and (= (1- (marker-position tpu-match-beginning-mark))
-		   (marker-position tpu-match-end-mark))
-		(= (marker-position tpu-match-end-mark) (point))))) t)
-	(t
-	 (tpu-unset-match) nil)))
-
-(defun tpu-show-match-markers nil
-  "Show the values of the match markers."
-  (interactive)
-  (if (markerp tpu-match-beginning-mark)
-      (let ((beg (marker-position tpu-match-beginning-mark)))
-	(message "(%s, %s) in %s -- current %s in %s"
-		 (if beg (1- beg) nil)
-		 (marker-position tpu-match-end-mark)
-		 (marker-buffer tpu-match-end-mark)
-		 (point) (current-buffer)))))
-
-
-;;;
-;;;  Utilities
-;;;
-(defun tpu-caar (thingy) (car (car thingy)))
-(defun tpu-cadr (thingy) (car (cdr thingy)))
-
-(defun tpu-mark nil
-  "TPU-edt version of the mark function.
-Return the appropriate value of the mark for the current
-version of Emacs."
-  (cond (tpu-lucid-emacs19-p (mark (not zmacs-regions)))
-	(tpu-emacs19-p (and mark-active (mark (not transient-mark-mode))))
-	(t (mark))))
-
-(defun tpu-set-mark (pos)
-  "TPU-edt verion of the `set-mark' function.
-Sets the mark at POS and activates the region according to the
-current version of Emacs."
-  (set-mark pos)
-  (and tpu-lucid-emacs19-p pos (zmacs-activate-region)))
-
-(defun tpu-string-prompt (prompt history-symbol)
-  "Read a string with PROMPT."
-  (if tpu-emacs19-p
-      (read-from-minibuffer prompt nil nil nil history-symbol)
-    (read-string prompt)))
-
-(defvar tpu-last-answer nil "Most recent response to tpu-y-or-n-p.")
-
-(defun tpu-y-or-n-p (prompt &optional not-yes)
-  "Prompt for a y or n answer with positive default.
-Optional second argument NOT-YES changes default to negative.
-Like Emacs `y-or-n-p', but also accepts space as y and DEL as n."
-  (message "%s[%s]" prompt (if not-yes "n" "y"))
-  (let ((doit t))
-    (while doit
-      (setq doit nil)
-      (let ((ans (read-char)))
-	(cond ((or (= ans ?y) (= ans ?Y) (= ans ?\ ))
-	       (setq tpu-last-answer t))
-	      ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
-	       (setq tpu-last-answer nil))
-	      ((= ans ?\r) (setq tpu-last-answer (not not-yes)))
-	      (t
-	       (setq doit t) (beep)
-	       (message "Please answer y or n.  %s[%s]"
-			prompt (if not-yes "n" "y")))))))
-  tpu-last-answer)
-
-(defun tpu-local-set-key (key func)
-  "Replace a key in the TPU-edt local key map.
-Create the key map if necessary."
-  (cond ((not (keymapp tpu-buffer-local-map))
-	 (setq tpu-buffer-local-map (if (current-local-map)
-					(copy-keymap (current-local-map))
-				      (make-sparse-keymap)))
-	 (use-local-map tpu-buffer-local-map)))
-  (local-set-key key func))
-
-(defun tpu-current-line nil
-  "Return the vertical position of point in the selected window.
-Top line is 0.  Counts each text line only once, even if it wraps."
-  (+ (count-lines (window-start) (point)) (if (= (current-column) 0) 1 0) -1))
-
-
-;;;
-;;;  Breadcrumbs
-;;;
-(defvar tpu-breadcrumb-plist nil
-  "The set of user-defined markers (breadcrumbs), as a plist.")
-
-(defun tpu-drop-breadcrumb (num)
-  "Drops a breadcrumb that can be returned to later with goto-breadcrumb."
-  (interactive "p")
-  (put tpu-breadcrumb-plist num (list (current-buffer) (point)))
-  (message "Mark %d set." num))
-
-(defun tpu-goto-breadcrumb (num)
-  "Returns to a breadcrumb set with drop-breadcrumb."
-  (interactive "p")
-  (cond ((get tpu-breadcrumb-plist num)
-	 (switch-to-buffer (car (get tpu-breadcrumb-plist num)))
-	 (goto-char (tpu-cadr (get tpu-breadcrumb-plist num)))
-	 (message "mark %d found." num))
-	(t
-	 (message "mark %d not found." num))))
-
-
-;;;
-;;;  Miscellaneous
-;;;
-(defun tpu-change-case (num)
-  "Change the case of the character under the cursor or region.
-Accepts a prefix argument of the number of characters to invert."
-  (interactive "p")
-  (cond ((tpu-mark)
-	 (let ((beg (region-beginning)) (end (region-end)))
-	   (while (> end beg)
-	     (funcall (if (= (downcase (char-after beg)) (char-after beg))
-			  'upcase-region 'downcase-region)
-		      beg (1+ beg))
-	     (setq beg (1+ beg)))
-	   (tpu-unselect t)))
-	((tpu-check-match)
-	 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
-	   (while (> end beg)
-	     (funcall (if (= (downcase (char-after beg)) (char-after beg))
-			  'upcase-region 'downcase-region)
-		      beg (1+ beg))
-	     (setq beg (1+ beg)))
-	   (tpu-unset-match)))
-	(t
-	 (while (> num 0)
-	   (funcall (if (= (downcase (following-char)) (following-char))
-			'upcase-region 'downcase-region)
-		    (point) (1+ (point)))
-	   (forward-char (if tpu-reverse -1 1))
-	   (setq num (1- num))))))
-
-(defun tpu-fill (num)
-  "Fill paragraph or marked region.
-With argument, fill and justify."
-  (interactive "P")
-  (cond ((tpu-mark)
-	 (fill-region (point) (tpu-mark) num)
-	 (tpu-unselect t))
-	(t
-	 (fill-paragraph num))))
-
-(defun tpu-version nil
-  "Print the TPU-edt version number."
-  (interactive)
-  (message
-   "TPU-edt version %s by Rob Riepel (riepel@networking.stanford.edu)"
-   tpu-version))
-
-(defun tpu-reset-screen-size (height width)
-  "Sets the screen size."
-  (interactive "nnew screen height: \nnnew screen width: ")
-  (set-screen-height height)
-  (set-screen-width width))
-
-(defun tpu-toggle-newline-and-indent nil
-  "Toggle between 'newline and indent' and 'simple newline'."
-  (interactive)
-  (cond (tpu-newline-and-indent-p
-         (setq tpu-newline-and-indent-string "")
-         (setq tpu-newline-and-indent-p nil)
-         (tpu-local-set-key "\C-m" 'newline))
-        (t
-         (setq tpu-newline-and-indent-string " AutoIndent")
-         (setq tpu-newline-and-indent-p t)
-         (tpu-local-set-key "\C-m" 'newline-and-indent)))
-  (tpu-update-mode-line)
-  (and (interactive-p)
-       (message "Carriage return inserts a newline%s"
-		(if tpu-newline-and-indent-p " and indents." "."))))
-
-(defun tpu-spell-check nil
-  "Checks the spelling of the region, or of the entire buffer if no
- region is selected."
-  (interactive)
-  (cond (tpu-have-ispell
-	 (if (tpu-mark) (ispell-region (tpu-mark) (point)) (ispell-buffer)))
-	(t
-	 (if (tpu-mark) (spell-region (tpu-mark) (point)) (spell-buffer))))
-  (if (tpu-mark) (tpu-unselect t)))
-
-(defun tpu-toggle-overwrite-mode nil
-  "Switches in and out of overwrite mode"
-  (interactive)
-  (cond (overwrite-mode
-	 (tpu-local-set-key "\177" tpu-saved-delete-func)
-	 (overwrite-mode 0))
-	(t
-	 (setq tpu-saved-delete-func (local-key-binding "\177"))
-	 (tpu-local-set-key "\177" 'picture-backward-clear-column)
-	 (overwrite-mode 1))))
-
-(defun tpu-special-insert (num)
-  "Insert a character or control code according to
-its ASCII decimal value."
-  (interactive "P")
-  (if overwrite-mode (delete-char 1))
-  (insert (if num num 0)))
-
-(defun tpu-quoted-insert (num)
-  "Read next input character and insert it.
-This is useful for inserting control characters."
-  (interactive "*p")
-  (let ((char (read-char)) )
-    (if overwrite-mode (delete-char num))
-    (insert-char char num)))
-
-
-;;;
-;;;  TPU line-mode commands
-;;;
-(defun tpu-include (file)
-  "TPU-like include file"
-  (interactive "fInclude file: ")
-  (save-excursion
-    (insert-file file)
-    (message "")))
-
-(defun tpu-get (file)
-  "TPU-like get file"
-  (interactive "FFile to get: ")
-  (find-file file))
-
-(defun tpu-what-line nil
-  "Tells what line the point is on,
- and the total number of lines in the buffer."
-  (interactive)
-  (if (eobp)
-      (message "You are at the End of Buffer.  The last line is %d."
-	       (count-lines 1 (point-max)))
-    (message "Line %d of %d"
-	     (count-lines 1 (1+ (point)))
-	     (count-lines 1 (point-max)))))
-
-(defun tpu-exit nil
-  "Exit the way TPU does, save current buffer and ask about others."
-  (interactive)
-  (if (not (eq (recursion-depth) 0))
-      (exit-recursive-edit)
-    (progn (save-buffer) (save-buffers-kill-emacs))))
-
-(defun tpu-quit nil
-  "Quit the way TPU does, ask to make sure changes should be abandoned."
-  (interactive)
-  (let ((list (buffer-list))
-	(working t))
-    (while (and list working)
-      (let ((buffer (car list)))
-	(if (and (buffer-file-name buffer) (buffer-modified-p buffer))
-            (if (tpu-y-or-n-p
-		 "Modifications will not be saved, continue quitting? ")
-		(kill-emacs t) (setq working nil)))
-	(setq list (cdr list))))
-    (if working (kill-emacs t))))
-
-
-;;;
-;;;  Command and Function Aliases
-;;;
-;;;###autoload
-(fset 'tpu-edt-mode 'tpu-edt-on)
-(fset 'TPU-EDT-MODE 'tpu-edt-on)
-
-;;;###autoload
-(fset 'tpu-edt 'tpu-edt-on)
-(fset 'TPU-EDT 'tpu-edt-on)
-
-(fset 'exit 'tpu-exit)
-(fset 'EXIT 'tpu-exit)
-
-(fset 'Get 'tpu-get)
-(fset 'GET 'tpu-get)
-
-(fset 'include 'tpu-include)
-(fset 'INCLUDE 'tpu-include)
-
-(fset 'quit 'tpu-quit)
-(fset 'QUIT 'tpu-quit)
-
-(fset 'spell 'tpu-spell-check)
-(fset 'SPELL 'tpu-spell-check)
-
-(fset 'what\ line 'tpu-what-line)
-(fset 'WHAT\ LINE 'tpu-what-line)
-
-(fset 'replace 'tpu-lm-replace)
-(fset 'REPLACE 'tpu-lm-replace)
-
-;; Apparently TPU users really expect to do M-x help RET to get help.
-;; So it is really necessary to redefine this.
-(fset 'help 'tpu-help)
-(fset 'HELP 'tpu-help)
-
-(fset 'set\ cursor\ free 'tpu-set-cursor-free)
-(fset 'SET\ CURSOR\ FREE 'tpu-set-cursor-free)
-
-(fset 'set\ cursor\ bound 'tpu-set-cursor-bound)
-(fset 'SET\ CURSOR\ BOUND 'tpu-set-cursor-bound)
-
-(fset 'set\ scroll\ margins 'tpu-set-scroll-margins)
-(fset 'SET\ SCROLL\ MARGINS 'tpu-set-scroll-margins)
-
-
-;; Around emacs version 18.57, function line-move was renamed to
-;; next-line-internal.  If we're running under an older emacs,
-;; make next-line-internal equivalent to line-move.
-
-(if (not (fboundp 'next-line-internal)) (fset 'next-line-internal 'line-move))
-
-
-;;;
-;;;  Help
-;;;
-(defconst tpu-help-keypad-map "\f
-          _______________________    _______________________________
-         | HELP  |      Do       |  |       |       |       |       |
-         |KeyDefs|               |  |       |       |       |       |
-         |_______|_______________|  |_______|_______|_______|_______|
-          _______________________    _______________________________
-         | Find  |Insert |Remove |  | Gold  | HELP  |FndNxt | Del L |
-         |       |       |Sto Tex|  |  key  |E-Help | Find  |Undel L|
-         |_______|_______|_______|  |_______|_______|_______|_______|
-         |Select |Pre Scr|Nex Scr|  | Page  | Sect  |Append | Del W |
-         | Reset |Pre Win|Nex Win|  |  Do   | Fill  |Replace|Undel W|
-         |_______|_______|_______|  |_______|_______|_______|_______|
-                 |Move up|          |Forward|Reverse|Remove | Del C |
-                 |  Top  |          |Bottom |  Top  |Insert |Undel C|
-          _______|_______|_______   |_______|_______|_______|_______|
-         |Mov Lef|Mov Dow|Mov Rig|  | Word  |  EOL  | Char  |       |
-         |StaOfLi|Bottom |EndOfLi|  |ChngCas|Del EOL|SpecIns| Enter |
-         |_______|_______|_______|  |_______|_______|_______|       |
-                                    |     Line      |Select | Subs  |
-                                    |   Open Line   | Reset |       |
-                                    |_______________|_______|_______|
-")
-
-(defconst tpu-help-text "
-\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
-
-      Control Characters
-
-      ^A  toggle insert and overwrite
-      ^B  recall
-      ^E  end of line
-
-      ^G  Cancel current operation
-      ^H  beginning of line
-      ^J  delete previous word
-
-      ^K  learn
-      ^L  insert page break
-      ^R  remember (during learn), re-center
-
-      ^U  delete to beginning of line
-      ^V  quote
-      ^W  refresh
-
-      ^Z  exit
-    ^X^X  exchange point and mark - useful for checking region boundaries
-
-\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
-       Gold-<key> Functions
-
-       B     Next Buffer - display the next buffer (all buffers)
-       C     Recall - edit and possibly repeat previous commands
-       E     Exit - save current buffer and ask about others
-       G     Get - load a file into a new edit buffer
-
-       I     Include - include a file in this buffer
-       K     Kill Buffer - abandon edits and delete buffer
-       M     Buffer Menu - display a list of all buffers
-       N     Next File Buffer - display next buffer containing a file
-
-       O     Occur - show following lines containing REGEXP
-       Q     Quit - exit without saving anything
-       R     Toggle rectangular mode for remove and insert
-       S     Search and substitute - line mode REPLACE command
-
-      ^T     Toggle control key bindings between TPU and emacs
-       U     Undo - undo the last edit
-       W     Write - save current buffer
-       X     Exit - save all modified buffers and exit
-
-\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
-
-  More extensive documentation on TPU-edt can be found in the `Commentary'
-  section of tpu-edt.el.  This section can be accessed through the standard
-  Emacs help facility using the `p' option.  Once you exit TPU-edt Help, one
-  of the following key sequences is sure to get you there.
-
-    ^h p        if you're not yet using TPU-edt
-    Gold-PF2 p  if you're using TPU-edt
-
-  Alternatively, fire up Emacs help from the command prompt, with
-
-    M-x help-for-help <CR> p <CR>
-
-  Where `M-x' might be any of `Gold-KP7', 'Do', or 'ESC-x'.
-
-  When you successfully invoke this part of the Emacs help facility, you
-  will see a buffer named `*Finder*' listing a number of topics.  Look for
-  tpu-edt under `emulations'.
-
-\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\n\f
-
-   *** No more help, use P to view previous screen")
-
-(defvar tpu-help-enter (format "%s" "\eOM"))    ; tpu-help enter key symbol
-(defvar tpu-help-return (format "%s" "\r"))     ; tpu-help enter key symbol
-(defvar tpu-help-N "N")                         ; tpu-help "N" symbol
-(defvar tpu-help-n "n")                         ; tpu-help "n" symbol
-(defvar tpu-help-P "P")                         ; tpu-help "P" symbol
-(defvar tpu-help-p "p")                         ; tpu-help "p" symbol
-
-(defun tpu-help nil
-  "Display TPU-edt help."
-  (interactive)
-  ;; Save current window configuration
-  (save-window-excursion
-    ;; Create and fill help buffer if necessary
-    (if (not (get-buffer "*TPU-edt Help*"))
-	(progn (generate-new-buffer "*TPU-edt Help*")
-	       (switch-to-buffer "*TPU-edt Help*")
-	       (insert tpu-help-keypad-map)
-	       (insert tpu-help-text)
-	       (setq buffer-read-only t)))
-
-    ;; Display the help buffer
-    (switch-to-buffer "*TPU-edt Help*")
-    (delete-other-windows)
-    (tpu-move-to-beginning)
-    (forward-line 1)
-    (tpu-line-to-top-of-window)
-
-    ;; Prompt for keys to describe, based on screen state (split/not split)
-    (let ((key nil) (fkey nil) (split nil))
-      (while (not (equal tpu-help-return fkey))
-	(if split
-	    (setq key
-		  (read-key-sequence
-		   "Press the key you want help on (RET=exit, ENTER=redisplay, N=next, P=prev): "))
-	  (setq key
-		(read-key-sequence
-		 "Press the key you want help on (RET to exit, N next screen, P prev screen): ")))
-
-	;; Process the read key
-	;;
-	;;    ENTER   -  Display just the help window
-	;;    N or n  -  Next help or describe-key screen
-	;;    P or p  -  Previous help or describe-key screen
-	;;    RETURN  -  Exit from TPU-help
-	;;    default -  describe the key
-	;;
-	(setq fkey (format "%s" key))
-	(cond ((equal tpu-help-enter fkey)
-	       (setq split nil)
-	       (delete-other-windows))
-	      ((or (equal tpu-help-N fkey) (equal tpu-help-n fkey))
-	       (cond (split
-	              (condition-case nil
-	        	  (scroll-other-window 8)
-	        	(error nil)))
-	             (t
-	              (forward-page)
-	              (forward-line 1)
-	              (tpu-line-to-top-of-window))))
-	      ((or (equal tpu-help-P fkey) (equal tpu-help-p fkey))
-	       (cond (split
-	              (condition-case nil
-	        	  (scroll-other-window -8)
-	        	(error nil)))
-	             (t
-	              (backward-page)
-	              (forward-line 1)
-	              (tpu-line-to-top-of-window))))
-	      ((not (equal tpu-help-return fkey))
-	       (setq split t)
-	       (describe-key key)
-	       ;; If the key is undefined, leave the
-	       ;;   message in the mini-buffer for 3 seconds
-	       (if (not (key-binding key)) (sit-for 3))))))))
-
-
-;;;
-;;;  Auto-insert
-;;;
-(defun tpu-insert-escape nil
-  "Inserts an escape character, and so becomes the escape-key alias."
-  (interactive)
-  (insert "\e"))
-
-(defun tpu-insert-formfeed nil
-  "Inserts a formfeed character."
-  (interactive)
-  (insert "\C-L"))
-
-
-;;;
-;;;  Define key
-;;;
-(defvar tpu-saved-control-r nil "Saved value of Control-r.")
-
-(defun tpu-end-define-macro-key (key)
-  "Ends the current macro definition"
-  (interactive "kPress the key you want to use to do what was just learned: ")
-  (end-kbd-macro nil)
-  (global-set-key key last-kbd-macro)
-  (global-set-key "\C-r" tpu-saved-control-r))
-
-(defun tpu-define-macro-key nil
-  "Bind a set of keystrokes to a single key, or key combination."
-  (interactive)
-  (setq tpu-saved-control-r (global-key-binding "\C-r"))
-  (global-set-key "\C-r" 'tpu-end-define-macro-key)
-  (start-kbd-macro nil))
-
-
-;;;
-;;;  Buffers and Windows
-;;;
-(defun tpu-kill-buffer nil
-  "Kills the current buffer.  If tpu-kill-buffers-silently is non-nil,
-kills modified buffers without asking."
-  (interactive)
-  (if tpu-kill-buffers-silently (set-buffer-modified-p nil))
-  (kill-buffer (current-buffer)))
-
-(defun tpu-save-all-buffers-kill-emacs nil
-  "Save all buffers and exit emacs."
-  (interactive)
-  (let ((delete-old-versions t))
-    (save-buffers-kill-emacs t)))
-
-(defun tpu-write-current-buffers nil
-  "Save all modified buffers without exiting."
-  (interactive)
-  (save-some-buffers t))
-
-(defun tpu-next-buffer nil
-  "Go to next buffer in ring."
-  (interactive)
-  (switch-to-buffer (car (reverse (buffer-list)))))
-
-(defun tpu-next-file-buffer nil
-  "Go to next buffer in ring that is visiting a file or directory."
-  (interactive)
-  (let ((list (tpu-make-file-buffer-list (buffer-list))))
-    (setq list (delq (current-buffer) list))
-    (if (not list) (error "No other buffers."))
-    (switch-to-buffer (car (reverse list)))))
-
-(defun tpu-make-file-buffer-list (buffer-list)
-  "Returns names from BUFFER-LIST excluding those beginning with a space or star."
-  (delq nil (mapcar '(lambda (b)
-                       (if (or (= (aref (buffer-name b) 0) ? )
-                               (= (aref (buffer-name b) 0) ?*)) nil b))
-                    buffer-list)))
-
-(defun tpu-next-window nil
-  "Move to the next window."
-  (interactive)
-  (if (one-window-p) (message "There is only one window on screen.")
-    (other-window 1)))
-
-(defun tpu-previous-window nil
-  "Move to the previous window."
-  (interactive)
-  (if (one-window-p) (message "There is only one window on screen.")
-    (select-window (previous-window))))
-
-
-;;;
-;;;  Search
-;;;
-(defun tpu-toggle-regexp nil
-  "Switches in and out of regular expression search and replace mode."
-  (interactive)
-  (setq tpu-regexp-p (not tpu-regexp-p))
-  (tpu-set-search)
-  (and (interactive-p)
-       (message "Regular expression search and substitute %sabled."
-		(if tpu-regexp-p "en" "dis"))))
-
-(defun tpu-regexp-prompt (prompt)
-  "Read a string, adding 'RE' to the prompt if tpu-regexp-p is set."
-  (let ((re-prompt (concat (if tpu-regexp-p "RE ") prompt)))
-    (if tpu-emacs19-p
-	(read-from-minibuffer re-prompt nil nil nil 'tpu-regexp-prompt-hist)
-      (read-string re-prompt))))
-
-(defun tpu-search nil
-  "Search for a string or regular expression.
-The search is performed in the current direction."
-  (interactive)
-  (tpu-set-search)
-  (tpu-search-internal ""))
-
-(defun tpu-search-forward nil
-  "Search for a string or regular expression.
-The search is begins in the forward direction."
-  (interactive)
-  (setq tpu-searching-forward t)
-  (tpu-set-search t)
-  (tpu-search-internal ""))
-
-(defun tpu-search-reverse nil
-  "Search for a string or regular expression.
-The search is begins in the reverse direction."
-  (interactive)
-  (setq tpu-searching-forward nil)
-  (tpu-set-search t)
-  (tpu-search-internal ""))
-
-(defun tpu-search-again nil
-  "Search for the same string or regular expression as last time.
-The search is performed in the current direction."
-  (interactive)
-  (tpu-search-internal tpu-search-last-string))
-
-;;  tpu-set-search defines the search functions used by the TPU-edt internal
-;;  search function.  It should be called whenever the direction changes, or
-;;  the regular expression mode is turned on or off.  It can also be called
-;;  to ensure that the next search will be in the current direction.  It is
-;;  called from:
-
-;;       tpu-advance                   tpu-backup
-;;       tpu-toggle-regexp             tpu-toggle-search-direction (t)
-;;       tpu-search                    tpu-lm-replace
-;;       tpu-search-forward (t)        tpu-search-reverse (t)
-;;       tpu-search-forward-exit (t)   tpu-search-backward-exit (t)
-
-(defun tpu-set-search (&optional arg)
-  "Set the search functions and set the search direction to the current
-direction.  If an argument is specified, don't set the search direction."
-  (if (not arg) (setq tpu-searching-forward (if tpu-advance t nil)))
-  (cond (tpu-searching-forward
-	 (cond (tpu-regexp-p
-		(fset 'tpu-emacs-search 're-search-forward)
-		(fset 'tpu-emacs-rev-search 're-search-backward))
-	       (t
-		(fset 'tpu-emacs-search 'search-forward)
-		(fset 'tpu-emacs-rev-search 'search-backward))))
-	(t
-	 (cond (tpu-regexp-p
-		(fset 'tpu-emacs-search 're-search-backward)
-		(fset 'tpu-emacs-rev-search 're-search-forward))
-	       (t
-		(fset 'tpu-emacs-search 'search-backward)
-		(fset 'tpu-emacs-rev-search 'search-forward))))))
-
-(defun tpu-search-internal (pat &optional quiet)
-  "Search for a string or regular expression."
-  (setq tpu-search-last-string
-	(if (not (string= "" pat)) pat (tpu-regexp-prompt "Search: ")))
-
-  (tpu-unset-match)
-  (tpu-adjust-search)
-
-  (let ((case-fold-search
-	 (and case-fold-search (tpu-check-search-case tpu-search-last-string))))
-
-    (cond ((tpu-emacs-search tpu-search-last-string nil t)
-	   (tpu-set-match) (goto-char (tpu-match-beginning)))
-
-	  (t
-	   (tpu-adjust-search t)
-	   (let ((found nil) (pos nil))
-	     (save-excursion
-	       (let ((tpu-searching-forward (not tpu-searching-forward)))
-		 (tpu-adjust-search)
-		 (setq found (tpu-emacs-rev-search tpu-search-last-string nil t))
-		 (setq pos (match-beginning 0))))
-
-	     (cond
-	      (found
-	       (cond ((tpu-y-or-n-p
-		       (format "Found in %s direction.  Go there? "
-			       (if tpu-searching-forward "reverse" "forward")))
-		      (goto-char pos) (tpu-set-match)
-		      (tpu-toggle-search-direction))))
-
-	      (t
-	       (if (not quiet)
-		   (message
-		    "%sSearch failed: \"%s\""
-		    (if tpu-regexp-p "RE " "") tpu-search-last-string)))))))))
-
-(fset 'tpu-search-internal-core (symbol-function 'tpu-search-internal))
-
-(defun tpu-check-search-case (string)
-  "Returns t if string contains upper case."
-  ;; if using regexp, eliminate upper case forms (\B \W \S.)
-  (if tpu-regexp-p
-      (let ((pat (copy-sequence string)) (case-fold-search nil) (pos 0))
-	(while (setq pos (string-match "\\\\\\\\" pat)) (aset pat (+ 1 pos) ?.))
-	(while (setq pos (string-match "\\\\B" pat)) (aset pat (+ 1 pos) ?.))
-	(while (setq pos (string-match "\\\\W" pat)) (aset pat (+ 1 pos) ?.))
-	(while (setq pos (string-match "\\\\S." pat))
-	  (aset pat (+ 1 pos) ?.) (aset pat (+ 2 pos) ?.))
-	(string-equal pat (downcase pat)))
-    (string-equal string (downcase string))))
-
-(defun tpu-adjust-search (&optional arg)
-  "For forward searches, move forward a character before searching,
-and backward a character after a failed search.  Arg means end of search."
-  (if tpu-searching-forward
-      (cond (arg (if (not (bobp)) (forward-char -1)))
-	    (t (if (not (eobp)) (forward-char 1))))))
-
-(defun tpu-toggle-search-direction nil
-  "Toggle the TPU-edt search direction.
-Used for reversing a search in progress."
-  (interactive)
-  (setq tpu-searching-forward (not tpu-searching-forward))
-  (tpu-set-search t)
-  (and (interactive-p)
-       (message "Searching %sward."
-		(if tpu-searching-forward "for" "back"))))
-
-(defun tpu-search-forward-exit nil
-  "Set search direction forward and exit minibuffer."
-  (interactive)
-  (setq tpu-searching-forward t)
-  (tpu-set-search t)
-  (exit-minibuffer))
-
-(defun tpu-search-backward-exit nil
-  "Set search direction backward and exit minibuffer."
-  (interactive)
-  (setq tpu-searching-forward nil)
-  (tpu-set-search t)
-  (exit-minibuffer))
-
-
-;;;
-;;;  Select / Unselect
-;;;
-(defun tpu-select (&optional quiet)
-  "Sets the mark to define one end of a region."
-  (interactive "P")
-  (cond ((tpu-mark)
-	 (tpu-unselect quiet))
-	(t
-	 (tpu-set-mark (point))
-	 (tpu-update-mode-line)
-	 (if (not quiet) (message "Move the text cursor to select text.")))))
-
-(defun tpu-unselect (&optional quiet)
-  "Removes the mark to unselect the current region."
-  (interactive "P")
-  (setq mark-ring nil)
-  (tpu-set-mark nil)
-  (tpu-update-mode-line)
-  (if (not quiet) (message "Selection canceled.")))
-
-
-;;;
-;;;  Delete / Cut
-;;;
-(defun tpu-toggle-rectangle nil
-  "Toggle rectangular mode for remove and insert."
-  (interactive)
-  (setq tpu-rectangular-p (not tpu-rectangular-p))
-  (setq tpu-rectangle-string (if tpu-rectangular-p " Rect" ""))
-  (tpu-update-mode-line)
-  (and (interactive-p)
-       (message "Rectangular cut and paste %sabled."
-		(if tpu-rectangular-p "en" "dis"))))
-
-(defun tpu-arrange-rectangle nil
-  "Adjust point and mark to mark upper left and lower right
-corners of a rectangle."
-  (let ((mc (current-column))
-	(pc (progn (exchange-point-and-mark) (current-column))))
-
-    (cond ((> (point) (tpu-mark))                  ; point on lower line
-	   (cond ((> pc mc)                        ; point @  lower-right
-		  (exchange-point-and-mark))       ; point -> upper-left
-
-		 (t	                           ; point @  lower-left
-		  (move-to-column-force mc)        ; point -> lower-right
-		  (exchange-point-and-mark)        ; point -> upper-right
-		  (move-to-column-force pc))))     ; point -> upper-left
-
-	  (t                                       ; point on upper line
-	   (cond ((> pc mc)                        ; point @  upper-right
-		  (move-to-column-force mc)        ; point -> upper-left
-		  (exchange-point-and-mark)        ; point -> lower-left
-		  (move-to-column-force pc)        ; point -> lower-right
-		  (exchange-point-and-mark)))))))  ; point -> upper-left
-
-(defun tpu-cut-text nil
-  "Delete the selected region.
-The text is saved for the tpu-paste command."
-  (interactive)
-  (cond ((tpu-mark)
-	 (cond (tpu-rectangular-p
-		(tpu-arrange-rectangle)
-		(picture-clear-rectangle (point) (tpu-mark) (not overwrite-mode))
-		(tpu-unselect t))
-	       (t
-		(setq tpu-last-deleted-region
-		      (buffer-substring (tpu-mark) (point)))
-		(delete-region (tpu-mark) (point))
-		(tpu-unselect t))))
-	((tpu-check-match)
-	 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
-	   (setq tpu-last-deleted-region (buffer-substring beg end))
-	   (delete-region beg end)
-	   (tpu-unset-match)))
-	(t
-	 (error "No selection active."))))
-
-(defun tpu-store-text nil
-  "Copy the selected region to the cut buffer without deleting it.
-The text is saved for the tpu-paste command."
-  (interactive)
-  (cond ((tpu-mark)
-	 (cond (tpu-rectangular-p
-		(save-excursion
-		  (tpu-arrange-rectangle)
-		  (setq picture-killed-rectangle
-			(extract-rectangle (point) (tpu-mark))))
-		(tpu-unselect t))
-	       (t
-		(setq tpu-last-deleted-region
-		      (buffer-substring (tpu-mark) (point)))
-		(tpu-unselect t))))
-	((tpu-check-match)
-	 (setq tpu-last-deleted-region
-	       (buffer-substring (tpu-match-beginning) (tpu-match-end)))
-	 (tpu-unset-match))
-	(t
-	 (error "No selection active."))))
-
-(defun tpu-cut (arg)
-  "Copy selected region to the cut buffer.  In the absence of an
-argument, delete the selected region too."
-  (interactive "P")
-  (if arg (tpu-store-text) (tpu-cut-text)))
-
-(defun tpu-append-region (arg)
-  "Append selected region to the tpu-cut buffer.  In the absence of an
-argument, delete the selected region too."
-  (interactive "P")
-  (cond ((tpu-mark)
-	 (let ((beg (region-beginning)) (end (region-end)))
-	   (setq tpu-last-deleted-region
-		 (concat tpu-last-deleted-region
-			 (buffer-substring beg end)))
-	   (if (not arg) (delete-region beg end))
-	   (tpu-unselect t)))
-	((tpu-check-match)
-	 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
-	   (setq tpu-last-deleted-region
-		 (concat tpu-last-deleted-region
-			 (buffer-substring beg end)))
-	   (if (not arg) (delete-region beg end))
-	   (tpu-unset-match)))
-	(t
-	 (error "No selection active."))))
-
-(defun tpu-delete-current-line (num)
-  "Delete one or specified number of lines after point.
-This includes the newline character at the end of each line.
-They are saved for the TPU-edt undelete-lines command."
-  (interactive "p")
-  (let ((beg (point)))
-    (forward-line num)
-    (if (not (eq (preceding-char) ?\n))
-        (insert "\n"))
-    (setq tpu-last-deleted-lines
-          (buffer-substring beg (point)))
-    (delete-region beg (point))))
-
-(defun tpu-delete-to-eol (num)
-  "Delete text up to end of line.
-With argument, delete up to to Nth line-end past point.
-They are saved for the TPU-edt undelete-lines command."
-  (interactive "p")
-  (let ((beg (point)))
-    (forward-char 1)
-    (end-of-line num)
-    (setq tpu-last-deleted-lines
-          (buffer-substring beg (point)))
-    (delete-region beg (point))))
-
-(defun tpu-delete-to-bol (num)
-  "Delete text back to beginning of line.
-With argument, delete up to to Nth line-end past point.
-They are saved for the TPU-edt undelete-lines command."
-  (interactive "p")
-  (let ((beg (point)))
-    (tpu-next-beginning-of-line num)
-    (setq tpu-last-deleted-lines
-          (buffer-substring (point) beg))
-    (delete-region (point) beg)))
-
-(defun tpu-delete-current-word (num)
-  "Delete one or specified number of words after point.
-They are saved for the TPU-edt undelete-words command."
-  (interactive "p")
-  (let ((beg (point)))
-    (tpu-forward-to-word num)
-    (setq tpu-last-deleted-words
-          (buffer-substring beg (point)))
-    (delete-region beg (point))))
-
-(defun tpu-delete-previous-word (num)
-  "Delete one or specified number of words before point.
-They are saved for the TPU-edt undelete-words command."
-  (interactive "p")
-  (let ((beg (point)))
-    (tpu-backward-to-word num)
-    (setq tpu-last-deleted-words
-          (buffer-substring (point) beg))
-    (delete-region beg (point))))
-
-(defun tpu-delete-current-char (num)
-  "Delete one or specified number of characters after point.  The last
-character deleted is saved for the TPU-edt undelete-char command."
-  (interactive "p")
-  (while (and (> num 0) (not (eobp)))
-    (setq tpu-last-deleted-char (char-after (point)))
-    (cond (overwrite-mode
-	   (picture-clear-column 1)
-	   (forward-char 1))
-	  (t
-	   (delete-char 1)))
-    (setq num (1- num))))
-
-
-;;;
-;;;  Undelete / Paste
-;;;
-(defun tpu-paste (num)
-  "Insert the last region or rectangle of killed text.
-With argument reinserts the text that many times."
-  (interactive "p")
-  (while (> num 0)
-    (cond (tpu-rectangular-p
-	   (let ((beg (point)))
-	     (save-excursion
-	       (picture-yank-rectangle (not overwrite-mode))
-	       (message ""))
-	     (goto-char beg)))
-	  (t
-	   (insert tpu-last-deleted-region)))
-    (setq num (1- num))))
-
-(defun tpu-undelete-lines (num)
-  "Insert lines deleted by last TPU-edt line-deletion command.
-With argument reinserts lines that many times."
-  (interactive "p")
-  (let ((beg (point)))
-    (while (> num 0)
-      (insert tpu-last-deleted-lines)
-      (setq num (1- num)))
-    (goto-char beg)))
-
-(defun tpu-undelete-words (num)
-  "Insert words deleted by last TPU-edt word-deletion command.
-With argument reinserts words that many times."
-  (interactive "p")
-  (let ((beg (point)))
-    (while (> num 0)
-      (insert tpu-last-deleted-words)
-      (setq num (1- num)))
-    (goto-char beg)))
-
-(defun tpu-undelete-char (num)
-  "Insert character deleted by last TPU-edt character-deletion command.
-With argument reinserts the character that many times."
-  (interactive "p")
-  (while (> num 0)
-    (if overwrite-mode (prog1 (forward-char -1) (delete-char 1)))
-    (insert tpu-last-deleted-char)
-    (forward-char -1)
-    (setq num (1- num))))
-
-
-;;;
-;;;  Replace and Substitute
-;;;
-(defun tpu-replace nil
-  "Replace the selected region with the contents of the cut buffer."
-  (interactive)
-  (cond ((tpu-mark)
-	 (let ((beg (region-beginning)) (end (region-end)))
-	   (setq tpu-last-replaced-text (buffer-substring beg end))
-	   (delete-region beg end)
-	   (insert tpu-last-deleted-region)
-	   (tpu-unselect t)))
-	((tpu-check-match)
-	 (let ((beg (tpu-match-beginning)) (end (tpu-match-end)))
-	   (setq tpu-last-replaced-text (buffer-substring beg end))
-	   (replace-match tpu-last-deleted-region
-			  (not case-replace) (not tpu-regexp-p))
-	   (tpu-unset-match)))
-	(t
-	 (error "No selection active."))))
-
-(defun tpu-substitute (num)
-  "Replace the selected region with the contents of the cut buffer, and
-repeat most recent search.  A numeric argument serves as a repeat count.
-A negative argument means replace all occurrences of the search string."
-  (interactive "p")
-  (cond ((or (tpu-mark) (tpu-check-match))
-	 (while (and (not (= num 0)) (or (tpu-mark) (tpu-check-match)))
-	   (let ((beg (point)))
-	     (tpu-replace)
-	     (if tpu-searching-forward (forward-char -1) (goto-char beg))
-	     (if (= num 1) (tpu-search-internal tpu-search-last-string)
-	       (tpu-search-internal-core tpu-search-last-string)))
-	   (setq num (1- num))))
-	(t
-	 (error "No selection active."))))
-
-(defun tpu-lm-replace (from to)
-  "Interactively search for OLD-string and substitute NEW-string."
-  (interactive (list (tpu-regexp-prompt "Old String: ")
-		     (tpu-regexp-prompt "New String: ")))
-
-  (let ((doit t) (strings 0))
-
-    ;; Can't replace null strings
-    (if (string= "" from) (error "No string to replace."))
-
-    ;; Find the first occurrence
-    (tpu-set-search)
-    (tpu-search-internal from t)
-
-    ;; Loop on replace question - yes, no, all, last, or quit.
-    (while doit
-      (if (not (tpu-check-match)) (setq doit nil)
-	(progn (message "Replace? Type Yes, No, All, Last, or Quit: ")
-	       (let ((ans (read-char)))
-
-		 (cond ((or (= ans ?y) (= ans ?Y) (= ans ?\r) (= ans ?\ ))
-			(let ((beg (point)))
-			  (replace-match to (not case-replace) (not tpu-regexp-p))
-			  (setq strings (1+ strings))
-			  (if tpu-searching-forward (forward-char -1) (goto-char beg)))
-			(tpu-search-internal from t))
-
-		       ((or (= ans ?n) (= ans ?N) (= ans ?\C-?))
-			(tpu-search-internal from t))
-
-		       ((or (= ans ?a) (= ans ?A))
-			(save-excursion
-			  (let ((beg (point)))
-			    (replace-match to (not case-replace) (not tpu-regexp-p))
-			    (setq strings (1+ strings))
-			    (if tpu-searching-forward (forward-char -1) (goto-char beg)))
-			  (tpu-search-internal-core from t)
-			  (while (tpu-check-match)
-			    (let ((beg (point)))
-			      (replace-match to (not case-replace) (not tpu-regexp-p))
-			      (setq strings (1+ strings))
-			      (if tpu-searching-forward (forward-char -1) (goto-char beg)))
-			    (tpu-search-internal-core from t)))
-			(setq doit nil))
-
-		       ((or (= ans ?l) (= ans ?L))
-			(let ((beg (point)))
-			  (replace-match to (not case-replace) (not tpu-regexp-p))
-			  (setq strings (1+ strings))
-			  (if tpu-searching-forward (forward-char -1) (goto-char beg)))
-			(setq doit nil))
-
-		       ((or (= ans ?q) (= ans ?Q))
-			(setq doit nil)))))))
-
-    (message "Replaced %s occurrence%s." strings
-	     (if (not (= 1 strings)) "s" ""))))
-
-(defun tpu-emacs-replace (&optional dont-ask)
-  "A TPU-edt interface to the emacs replace functions.  If TPU-edt is
-currently in regular expression mode, the emacs regular expression
-replace functions are used.  If an argument is supplied, replacements
-are performed without asking.  Only works in forward direction."
-  (interactive "P")
-  (cond (dont-ask
-	 (setq current-prefix-arg nil)
-	 (call-interactively
-	  (if tpu-regexp-p 'replace-regexp 'replace-string)))
-	(t
-	 (call-interactively
-	  (if tpu-regexp-p 'query-replace-regexp 'query-replace)))))
-
-(defun tpu-add-at-bol (text)
-  "Add text to the beginning of each line in a region,
-or each line in the entire buffer if no region is selected."
-  (interactive
-   (list (tpu-string-prompt "String to add: " 'tpu-add-at-bol-hist)))
-  (if (string= "" text) (error "No string specified."))
-  (cond ((tpu-mark)
-	 (save-excursion
-	   (if (> (point) (tpu-mark)) (exchange-point-and-mark))
-	   (while (and (< (point) (tpu-mark)) (re-search-forward "^" (tpu-mark) t))
-	     (if (< (point) (tpu-mark)) (replace-match text))))
-	 (tpu-unselect t))
-	(t
-	 (save-excursion
-	   (goto-char (point-min))
-	   (while (and (re-search-forward "^" nil t) (not (eobp)))
-	     (replace-match text))))))
-
-(defun tpu-add-at-eol (text)
-  "Add text to the end of each line in a region,
-or each line of the entire buffer if no region is selected."
-  (interactive
-   (list (tpu-string-prompt "String to add: " 'tpu-add-at-eol-hist)))
-  (if (string= "" text) (error "No string specified."))
-  (cond ((tpu-mark)
-	 (save-excursion
-	   (if (> (point) (tpu-mark)) (exchange-point-and-mark))
-	   (while (< (point) (tpu-mark))
-	     (end-of-line)
-	     (if (<= (point) (tpu-mark)) (insert text))
-	     (forward-line)))
-	 (tpu-unselect t))
-	(t
-	 (save-excursion
-	   (goto-char (point-min))
-	   (while (not (eobp))
-	     (end-of-line) (insert text) (forward-line))))))
-
-(defun tpu-trim-line-ends nil
-  "Removes trailing whitespace from every line in the buffer."
-  (interactive)
-  (picture-clean))
-
-
-;;;
-;;;  Movement by character
-;;;
-(defun tpu-char (num)
-  "Move to the next character in the current direction.
-A repeat count means move that many characters."
-  (interactive "p")
-  (if tpu-advance (tpu-forward-char num) (tpu-backward-char num)))
-
-(defun tpu-forward-char (num)
-  "Move right ARG characters (left if ARG is negative)."
-  (interactive "p")
-  (forward-char num))
-
-(defun tpu-backward-char (num)
-  "Move left ARG characters (right if ARG is negative)."
-  (interactive "p")
-  (backward-char num))
-
-
-;;;
-;;;  Movement by word
-;;;
-(defconst tpu-word-separator-list '()
-  "List of additional word separators.")
-(defconst tpu-skip-chars "^ \t"
-  "Characters to skip when moving by word.
-Additional word separators are added to this string.")
-
-(defun tpu-word (num)
-  "Move to the beginning of the next word in the current direction.
-A repeat count means move that many words."
-  (interactive "p")
-  (if tpu-advance (tpu-forward-to-word num) (tpu-backward-to-word num)))
-
-(defun tpu-forward-to-word (num)
-  "Move forward until encountering the beginning of a word.
-With argument, do this that many times."
-  (interactive "p")
-  (while (and (> num 0) (not (eobp)))
-    (let* ((beg (point))
-	   (end (prog2 (end-of-line) (point) (goto-char beg))))
-      (cond ((eolp)
-	     (forward-char 1))
-	    ((memq (char-after (point)) tpu-word-separator-list)
-	     (forward-char 1)
-	     (skip-chars-forward " \t" end))
-	    (t
-	     (skip-chars-forward tpu-skip-chars end)
-	     (skip-chars-forward " \t" end))))
-    (setq num (1- num))))
-
-(defun tpu-backward-to-word (num)
-  "Move backward until encountering the beginning of a word.
-With argument, do this that many times."
-  (interactive "p")
-  (while (and (> num 0) (not (bobp)))
-    (let* ((beg (point))
-	   (end (prog2 (beginning-of-line) (point) (goto-char beg))))
-      (cond ((bolp)
-	     ( forward-char -1))
-	    ((memq (char-after (1- (point)))  tpu-word-separator-list)
-	     (forward-char -1))
-	    (t
-	     (skip-chars-backward " \t" end)
-	     (skip-chars-backward tpu-skip-chars end)
-	     (if (and (not (bolp)) (= ?  (char-syntax (char-after (point)))))
-		 (forward-char -1)))))
-    (setq num (1- num))))
-
-(defun tpu-add-word-separators (separators)
-  "Add new word separators for TPU-edt word commands."
-  (interactive "sSeparators: ")
-  (let* ((n 0) (length (length separators)))
-    (while (< n length)
-      (let ((char (aref separators n))
-	    (ss (substring separators n (1+ n))))
-	(cond ((not (memq char tpu-word-separator-list))
-	       (setq tpu-word-separator-list
-		     (append ss tpu-word-separator-list))
-	       (cond ((= char ?-)
-		      (setq tpu-skip-chars (concat tpu-skip-chars "\\-")))
-		     ((= char ?\\)
-		      (setq tpu-skip-chars (concat tpu-skip-chars "\\\\")))
-		     ((= char ?^)
-		      (setq tpu-skip-chars (concat tpu-skip-chars "\\^")))
-		     (t
-		      (setq tpu-skip-chars (concat tpu-skip-chars ss))))))
-	(setq n (1+ n))))))
-
-(defun tpu-reset-word-separators nil
-  "Reset word separators to default value."
-  (interactive)
-  (setq tpu-word-separator-list nil)
-  (setq tpu-skip-chars "^ \t"))
-
-(defun tpu-set-word-separators (separators)
-  "Set new word separators for TPU-edt word commands."
-  (interactive "sSeparators: ")
-  (tpu-reset-word-separators)
-  (tpu-add-word-separators separators))
-
-
-;;;
-;;;  Movement by line
-;;;
-(defun tpu-next-line (num)
-  "Move to next line.
-Prefix argument serves as a repeat count."
-  (interactive "p")
-  (next-line-internal num)
-  (setq this-command 'next-line))
-
-(defun tpu-previous-line (num)
-  "Move to previous line.
-Prefix argument serves as a repeat count."
-  (interactive "p")
-  (next-line-internal (- num))
-  (setq this-command 'previous-line))
-
-(defun tpu-next-beginning-of-line (num)
-  "Move to beginning of line; if at beginning, move to beginning of next line.
-Accepts a prefix argument for the number of lines to move."
-  (interactive "p")
-  (backward-char 1)
-  (forward-line (- 1 num)))
-
-(defun tpu-end-of-line (num)
-  "Move to the next end of line in the current direction.
-A repeat count means move that many lines."
-  (interactive "p")
-  (if tpu-advance (tpu-next-end-of-line num) (tpu-previous-end-of-line num)))
-
-(defun tpu-next-end-of-line (num)
-  "Move to end of line; if at end, move to end of next line.
-Accepts a prefix argument for the number of lines to move."
-  (interactive "p")
-  (forward-char 1)
-  (end-of-line num))
-
-(defun tpu-previous-end-of-line (num)
-  "Move EOL upward.
-Accepts a prefix argument for the number of lines to move."
-  (interactive "p")
-  (end-of-line (- 1 num)))
-
-(defun tpu-current-end-of-line nil
-  "Move point to end of current line."
-  (interactive)
-  (let ((beg (point)))
-    (end-of-line)
-    (if (= beg (point)) (message "You are already at the end of a line."))))
-
-(defun tpu-line (num)
-  "Move to the beginning of the next line in the current direction.
-A repeat count means move that many lines."
-  (interactive "p")
-  (if tpu-advance (tpu-forward-line num) (tpu-backward-line num)))
-
-(defun tpu-forward-line (num)
-  "Move to beginning of next line.
-Prefix argument serves as a repeat count."
-  (interactive "p")
-  (forward-line num))
-
-(defun tpu-backward-line (num)
-  "Move to beginning of previous line.
-Prefix argument serves as repeat count."
-  (interactive "p")
-  (or (bolp) (>= 0 num) (setq num (- num 1)))
-  (forward-line (- num)))
-
-
-;;;
-;;;  Movement by paragraph
-;;;
-(defun tpu-paragraph (num)
-  "Move to the next paragraph in the current direction.
-A repeat count means move that many paragraphs."
-  (interactive "p")
-  (if tpu-advance
-      (tpu-next-paragraph num) (tpu-previous-paragraph num)))
-
-(defun tpu-next-paragraph (num)
-  "Move to beginning of the next paragraph.
-Accepts a prefix argument for the number of paragraphs."
-  (interactive "p")
-  (beginning-of-line)
-  (while (and (not (eobp)) (> num 0))
-    (if (re-search-forward "^[ \t]*$" nil t)
-	(if (re-search-forward "[^ \t\n]" nil t)
-	    (goto-char (match-beginning 0))
-	  (goto-char (point-max))))
-    (setq num (1- num)))
-  (beginning-of-line))
-
-
-(defun tpu-previous-paragraph (num)
-  "Move to beginning of previous paragraph.
-Accepts a prefix argument for the number of paragraphs."
-  (interactive "p")
-  (end-of-line)
-  (while (and (not (bobp)) (> num 0))
-    (if (not (and (re-search-backward "^[ \t]*$" nil t)
-		  (re-search-backward "[^ \t\n]" nil t)
-		  (re-search-backward "^[ \t]*$" nil t)
-		  (progn (re-search-forward "[^ \t\n]" nil t)
-			 (goto-char (match-beginning 0)))))
-	(goto-char (point-min)))
-    (setq num (1- num)))
-  (beginning-of-line))
-
-
-;;;
-;;;  Movement by page
-;;;
-(defun tpu-page (num)
-  "Move to the next page in the current direction.
-A repeat count means move that many pages."
-  (interactive "p")
-  (if tpu-advance (forward-page num) (backward-page num))
-  (if (eobp) (recenter -1)))
-
-
-;;;
-;;;  Scrolling and movement within the buffer
-;;;
-(defun tpu-scroll-window (num)
-  "Scroll the display to the next section in the current direction.
-A repeat count means scroll that many sections."
-  (interactive "p")
-  (if tpu-advance (tpu-scroll-window-up num) (tpu-scroll-window-down num)))
-
-(defun tpu-scroll-window-down (num)
-  "Scroll the display down to the next section.
-A repeat count means scroll that many sections."
-  (interactive "p")
-  (let* ((beg (tpu-current-line))
-	 (height (1- (window-height)))
-	 (lines (* num (/ (* height tpu-percent-scroll) 100))))
-    (next-line-internal (- lines))
-    (if (> lines beg) (recenter 0))))
-
-(defun tpu-scroll-window-up (num)
-  "Scroll the display up to the next section.
-A repeat count means scroll that many sections."
-  (interactive "p")
-  (let* ((beg (tpu-current-line))
-	 (height (1- (window-height)))
-	 (lines (* num (/ (* height tpu-percent-scroll) 100))))
-    (next-line-internal lines)
-    (if (>= (+ lines beg) height) (recenter -1))))
-
-(defun tpu-pan-right (num)
-  "Pan right tpu-pan-columns (16 by default).
-Accepts a prefix argument for the number of tpu-pan-columns to scroll."
-  (interactive "p")
-  (scroll-left (* tpu-pan-columns num)))
-
-(defun tpu-pan-left (num)
-  "Pan left tpu-pan-columns (16 by default).
-Accepts a prefix argument for the number of tpu-pan-columns to scroll."
-  (interactive "p")
-  (scroll-right (* tpu-pan-columns num)))
-
-(defun tpu-move-to-beginning nil
-  "Move cursor to the beginning of buffer, but don't set the mark."
-  (interactive)
-  (goto-char (point-min)))
-
-(defun tpu-move-to-end nil
-  "Move cursor to the end of buffer, but don't set the mark."
-  (interactive)
-  (goto-char (point-max))
-  (recenter -1))
-
-(defun tpu-goto-percent (perc)
-  "Move point to ARG percentage of the buffer."
-  (interactive "NGoto-percentage: ")
-  (if (or (> perc 100) (< perc 0))
-      (error "Percentage %d out of range 0 < percent < 100" perc)
-    (goto-char (/ (* (point-max) perc) 100))))
-
-(defun tpu-beginning-of-window nil
-  "Move cursor to top of window."
-  (interactive)
-  (move-to-window-line 0))
-
-(defun tpu-end-of-window nil
-  "Move cursor to bottom of window."
-  (interactive)
-  (move-to-window-line -1))
-
-(defun tpu-line-to-bottom-of-window nil
-  "Move the current line to the bottom of the window."
-  (interactive)
-  (recenter -1))
-
-(defun tpu-line-to-top-of-window nil
-  "Move the current line to the top of the window."
-  (interactive)
-  (recenter 0))
-
-
-;;;
-;;;  Direction
-;;;
-(defun tpu-advance-direction nil
-  "Set TPU Advance mode so keypad commands move forward."
-  (interactive)
-  (setq tpu-direction-string " Advance")
-  (setq tpu-advance t)
-  (setq tpu-reverse nil)
-  (tpu-set-search)
-  (tpu-update-mode-line))
-
-(defun tpu-backup-direction nil
-  "Set TPU Backup mode so keypad commands move backward."
-  (interactive)
-  (setq tpu-direction-string " Reverse")
-  (setq tpu-advance nil)
-  (setq tpu-reverse t)
-  (tpu-set-search)
-  (tpu-update-mode-line))
-
-
-;;;
-;;;  Define keymaps
-;;;
-(define-key global-map "\e[" CSI-map)                         ; CSI map
-(define-key global-map "\eO" SS3-map)                         ; SS3 map
-(define-key SS3-map "P" GOLD-map)                             ; GOLD map
-(define-key GOLD-map "\e[" GOLD-CSI-map)                      ; GOLD-CSI map
-(define-key GOLD-map "\eO" GOLD-SS3-map)                      ; GOLD-SS3 map
-
-
-;;;
-;;;  CSI-map key definitions
-;;;
-(define-key CSI-map "A" 'tpu-previous-line)                   ; up
-(define-key CSI-map "B" 'tpu-next-line)                       ; down
-(define-key CSI-map "D" 'tpu-backward-char)                   ; left
-(define-key CSI-map "C" 'tpu-forward-char)                    ; right
-
-(define-key CSI-map "1~" 'tpu-search)                         ; Find
-(define-key CSI-map "2~" 'tpu-paste)                          ; Insert Here
-(define-key CSI-map "3~" 'tpu-cut)                            ; Remove
-(define-key CSI-map "4~" 'tpu-select)                         ; Select
-(define-key CSI-map "5~" 'tpu-scroll-window-down)             ; Prev Screen
-(define-key CSI-map "6~" 'tpu-scroll-window-up)               ; Next Screen
-
-(define-key CSI-map "11~" 'nil)                               ; F1
-(define-key CSI-map "12~" 'nil)                               ; F2
-(define-key CSI-map "13~" 'nil)                               ; F3
-(define-key CSI-map "14~" 'nil)                               ; F4
-(define-key CSI-map "15~" 'nil)                               ; F5
-(define-key CSI-map "17~" 'nil)                               ; F6
-(define-key CSI-map "18~" 'nil)                               ; F7
-(define-key CSI-map "19~" 'nil)                               ; F8
-(define-key CSI-map "20~" 'nil)                               ; F9
-(define-key CSI-map "21~" 'tpu-exit)                          ; F10
-(define-key CSI-map "23~" 'tpu-insert-escape)                 ; F11 (ESC)
-(define-key CSI-map "24~" 'tpu-next-beginning-of-line)        ; F12 (BS)
-(define-key CSI-map "25~" 'tpu-delete-previous-word)          ; F13 (LF)
-(define-key CSI-map "26~" 'tpu-toggle-overwrite-mode)         ; F14
-(define-key CSI-map "28~" 'tpu-help)                          ; HELP
-(define-key CSI-map "29~" 'execute-extended-command)          ; DO
-(define-key CSI-map "31~" 'tpu-goto-breadcrumb)               ; F17
-(define-key CSI-map "32~" 'nil)                               ; F18
-(define-key CSI-map "33~" 'nil)                               ; F19
-(define-key CSI-map "34~" 'nil)                               ; F20
-
-
-;;;
-;;;  SS3-map key definitions
-;;;
-(define-key SS3-map "A" 'tpu-previous-line)                   ; up
-(define-key SS3-map "B" 'tpu-next-line)                       ; down
-(define-key SS3-map "C" 'tpu-forward-char)                    ; right
-(define-key SS3-map "D" 'tpu-backward-char)                   ; left
-
-(define-key SS3-map "Q" 'tpu-help)                            ; PF2
-(define-key SS3-map "R" 'tpu-search-again)                    ; PF3
-(define-key SS3-map "S" 'tpu-delete-current-line)             ; PF4
-(define-key SS3-map "p" 'tpu-line)                            ; KP0
-(define-key SS3-map "q" 'tpu-word)                            ; KP1
-(define-key SS3-map "r" 'tpu-end-of-line)                     ; KP2
-(define-key SS3-map "s" 'tpu-char)                            ; KP3
-(define-key SS3-map "t" 'tpu-advance-direction)               ; KP4
-(define-key SS3-map "u" 'tpu-backup-direction)                ; KP5
-(define-key SS3-map "v" 'tpu-cut)                             ; KP6
-(define-key SS3-map "w" 'tpu-page)                            ; KP7
-(define-key SS3-map "x" 'tpu-scroll-window)                   ; KP8
-(define-key SS3-map "y" 'tpu-append-region)                   ; KP9
-(define-key SS3-map "m" 'tpu-delete-current-word)             ; KP-
-(define-key SS3-map "l" 'tpu-delete-current-char)             ; KP,
-(define-key SS3-map "n" 'tpu-select)                          ; KP.
-(define-key SS3-map "M" 'newline)                             ; KPenter
-
-
-;;;
-;;;  GOLD-map key definitions
-;;;
-(define-key GOLD-map "\C-A" 'tpu-toggle-overwrite-mode)       ; ^A
-(define-key GOLD-map "\C-B" 'nil)                             ; ^B
-(define-key GOLD-map "\C-C" 'nil)                             ; ^C
-(define-key GOLD-map "\C-D" 'nil)                             ; ^D
-(define-key GOLD-map "\C-E" 'nil)                             ; ^E
-(define-key GOLD-map "\C-F" 'set-visited-file-name)           ; ^F
-(define-key GOLD-map "\C-g" 'keyboard-quit)                   ; safety first
-(define-key GOLD-map "\C-h" 'delete-other-windows)            ; BS
-(define-key GOLD-map "\C-i" 'other-window)                    ; TAB
-(define-key GOLD-map "\C-J" 'nil)                             ; ^J
-(define-key GOLD-map "\C-K" 'tpu-define-macro-key)            ; ^K
-(define-key GOLD-map "\C-l" 'downcase-region)                 ; ^L
-(define-key GOLD-map "\C-M" 'nil)                             ; ^M
-(define-key GOLD-map "\C-N" 'nil)                             ; ^N
-(define-key GOLD-map "\C-O" 'nil)                             ; ^O
-(define-key GOLD-map "\C-P" 'nil)                             ; ^P
-(define-key GOLD-map "\C-Q" 'nil)                             ; ^Q
-(define-key GOLD-map "\C-R" 'nil)                             ; ^R
-(define-key GOLD-map "\C-S" 'nil)                             ; ^S
-(define-key GOLD-map "\C-T" 'tpu-toggle-control-keys)         ; ^T
-(define-key GOLD-map "\C-u" 'upcase-region)                   ; ^U
-(define-key GOLD-map "\C-V" 'nil)                             ; ^V
-(define-key GOLD-map "\C-w" 'tpu-write-current-buffers)       ; ^W
-(define-key GOLD-map "\C-X" 'nil)                             ; ^X
-(define-key GOLD-map "\C-Y" 'nil)                             ; ^Y
-(define-key GOLD-map "\C-Z" 'nil)                             ; ^Z
-(define-key GOLD-map " " 'undo)                               ; SPC
-(define-key GOLD-map "!" 'nil)                                ; !
-(define-key GOLD-map "#" 'nil)                                ; #
-(define-key GOLD-map "$" 'tpu-add-at-eol)                     ; $
-(define-key GOLD-map "%" 'tpu-goto-percent)                   ; %
-(define-key GOLD-map "&" 'nil)                                ; &
-(define-key GOLD-map "(" 'nil)                                ; (
-(define-key GOLD-map ")" 'nil)                                ; )
-(define-key GOLD-map "*" 'tpu-toggle-regexp)                  ; *
-(define-key GOLD-map "+" 'nil)                                ; +
-(define-key GOLD-map "," 'tpu-goto-breadcrumb)                ; ,
-(define-key GOLD-map "-" 'negative-argument)                  ; -
-(define-key GOLD-map "." 'tpu-drop-breadcrumb)                ; .
-(define-key GOLD-map "/" 'tpu-emacs-replace)                  ; /
-(define-key GOLD-map "0" 'digit-argument)                     ; 0
-(define-key GOLD-map "1" 'digit-argument)                     ; 1
-(define-key GOLD-map "2" 'digit-argument)                     ; 2
-(define-key GOLD-map "3" 'digit-argument)                     ; 3
-(define-key GOLD-map "4" 'digit-argument)                     ; 4
-(define-key GOLD-map "5" 'digit-argument)                     ; 5
-(define-key GOLD-map "6" 'digit-argument)                     ; 6
-(define-key GOLD-map "7" 'digit-argument)                     ; 7
-(define-key GOLD-map "8" 'digit-argument)                     ; 8
-(define-key GOLD-map "9" 'digit-argument)                     ; 9
-(define-key GOLD-map ":" 'nil)                                ; :
-(define-key GOLD-map ";" 'tpu-trim-line-ends)                 ; ;
-(define-key GOLD-map "<" 'nil)                                ; <
-(define-key GOLD-map "=" 'nil)                                ; =
-(define-key GOLD-map ">" 'nil)                                ; >
-(define-key GOLD-map "?" 'tpu-spell-check)                    ; ?
-(define-key GOLD-map "A" 'tpu-toggle-newline-and-indent)      ; A
-(define-key GOLD-map "B" 'tpu-next-buffer)                    ; B
-(define-key GOLD-map "C" 'repeat-complex-command)             ; C
-(define-key GOLD-map "D" 'shell-command)                      ; D
-(define-key GOLD-map "E" 'tpu-exit)                           ; E
-(define-key GOLD-map "F" 'tpu-set-cursor-free)                ; F
-(define-key GOLD-map "G" 'tpu-get)                            ; G
-(define-key GOLD-map "H" 'nil)                                ; H
-(define-key GOLD-map "I" 'tpu-include)                        ; I
-(define-key GOLD-map "K" 'tpu-kill-buffer)                    ; K
-(define-key GOLD-map "L" 'tpu-what-line)                      ; L
-(define-key GOLD-map "M" 'buffer-menu)                        ; M
-(define-key GOLD-map "N" 'tpu-next-file-buffer)               ; N
-(define-key GOLD-map "O" 'occur)                              ; O
-(define-key GOLD-map "P" 'lpr-buffer)                         ; P
-(define-key GOLD-map "Q" 'tpu-quit)                           ; Q
-(define-key GOLD-map "R" 'tpu-toggle-rectangle)               ; R
-(define-key GOLD-map "S" 'replace)                            ; S
-(define-key GOLD-map "T" 'tpu-line-to-top-of-window)          ; T
-(define-key GOLD-map "U" 'undo)                               ; U
-(define-key GOLD-map "V" 'tpu-version)                        ; V
-(define-key GOLD-map "W" 'save-buffer)                        ; W
-(define-key GOLD-map "X" 'tpu-save-all-buffers-kill-emacs)    ; X
-(define-key GOLD-map "Y" 'copy-region-as-kill)                ; Y
-(define-key GOLD-map "Z" 'suspend-emacs)                      ; Z
-(define-key GOLD-map "[" 'blink-matching-open)                ; [
-(define-key GOLD-map "\\" 'nil)                               ; \
-(define-key GOLD-map "]" 'blink-matching-open)                ; ]
-(define-key GOLD-map "^" 'tpu-add-at-bol)                     ; ^
-(define-key GOLD-map "_" 'split-window-vertically)            ; -
-(define-key GOLD-map "`" 'what-line)                          ; `
-(define-key GOLD-map "a" 'tpu-toggle-newline-and-indent)      ; a
-(define-key GOLD-map "b" 'tpu-next-buffer)                    ; b
-(define-key GOLD-map "c" 'repeat-complex-command)             ; c
-(define-key GOLD-map "d" 'shell-command)                      ; d
-(define-key GOLD-map "e" 'tpu-exit)                           ; e
-(define-key GOLD-map "f" 'tpu-set-cursor-free)                ; f
-(define-key GOLD-map "g" 'tpu-get)                            ; g
-(define-key GOLD-map "h" 'nil)                                ; h
-(define-key GOLD-map "i" 'tpu-include)                        ; i
-(define-key GOLD-map "k" 'tpu-kill-buffer)                    ; k
-(define-key GOLD-map "l" 'goto-line)                          ; l
-(define-key GOLD-map "m" 'buffer-menu)                        ; m
-(define-key GOLD-map "n" 'tpu-next-file-buffer)               ; n
-(define-key GOLD-map "o" 'occur)                              ; o
-(define-key GOLD-map "p" 'lpr-region)                         ; p
-(define-key GOLD-map "q" 'tpu-quit)                           ; q
-(define-key GOLD-map "r" 'tpu-toggle-rectangle)               ; r
-(define-key GOLD-map "s" 'replace)                            ; s
-(define-key GOLD-map "t" 'tpu-line-to-top-of-window)          ; t
-(define-key GOLD-map "u" 'undo)                               ; u
-(define-key GOLD-map "v" 'tpu-version)                        ; v
-(define-key GOLD-map "w" 'save-buffer)                        ; w
-(define-key GOLD-map "x" 'tpu-save-all-buffers-kill-emacs)    ; x
-(define-key GOLD-map "y" 'copy-region-as-kill)                ; y
-(define-key GOLD-map "z" 'suspend-emacs)                      ; z
-(define-key GOLD-map "{" 'nil)                                ; {
-(define-key GOLD-map "|" 'split-window-horizontally)          ; |
-(define-key GOLD-map "}" 'nil)                                ; }
-(define-key GOLD-map "~" 'exchange-point-and-mark)            ; ~
-(define-key GOLD-map "\177" 'delete-window)                   ; <X]
-
-
-;;;
-;;;  GOLD-CSI-map key definitions
-;;;
-(define-key GOLD-CSI-map "A" 'tpu-move-to-beginning)          ; up-arrow
-(define-key GOLD-CSI-map "B" 'tpu-move-to-end)                ; down-arrow
-(define-key GOLD-CSI-map "C" 'end-of-line)                    ; right-arrow
-(define-key GOLD-CSI-map "D" 'beginning-of-line)              ; left-arrow
-
-(define-key GOLD-CSI-map "1~" 'nil)                           ; Find
-(define-key GOLD-CSI-map "2~" 'nil)                           ; Insert Here
-(define-key GOLD-CSI-map "3~" 'tpu-store-text)                ; Remove
-(define-key GOLD-CSI-map "4~" 'tpu-unselect)                  ; Select
-(define-key GOLD-CSI-map "5~" 'tpu-previous-window)           ; Prev Screen
-(define-key GOLD-CSI-map "6~" 'tpu-next-window)               ; Next Screen
-
-(define-key GOLD-CSI-map "11~" 'nil)                          ; F1
-(define-key GOLD-CSI-map "12~" 'nil)                          ; F2
-(define-key GOLD-CSI-map "13~" 'nil)                          ; F3
-(define-key GOLD-CSI-map "14~" 'nil)                          ; F4
-(define-key GOLD-CSI-map "16~" 'nil)                          ; F5
-(define-key GOLD-CSI-map "17~" 'nil)                          ; F6
-(define-key GOLD-CSI-map "18~" 'nil)                          ; F7
-(define-key GOLD-CSI-map "19~" 'nil)                          ; F8
-(define-key GOLD-CSI-map "20~" 'nil)                          ; F9
-(define-key GOLD-CSI-map "21~" 'nil)                          ; F10
-(define-key GOLD-CSI-map "23~" 'nil)                          ; F11
-(define-key GOLD-CSI-map "24~" 'nil)                          ; F12
-(define-key GOLD-CSI-map "25~" 'nil)                          ; F13
-(define-key GOLD-CSI-map "26~" 'nil)                          ; F14
-(define-key GOLD-CSI-map "28~" 'describe-bindings)            ; HELP
-(define-key GOLD-CSI-map "29~" 'nil)                          ; DO
-(define-key GOLD-CSI-map "31~" 'tpu-drop-breadcrumb)          ; F17
-(define-key GOLD-CSI-map "32~" 'nil)                          ; F18
-(define-key GOLD-CSI-map "33~" 'nil)                          ; F19
-(define-key GOLD-CSI-map "34~" 'nil)                          ; F20
-
-
-;;;
-;;;  GOLD-SS3-map key definitions
-;;;
-(define-key GOLD-SS3-map "A" 'tpu-move-to-beginning)          ; up-arrow
-(define-key GOLD-SS3-map "B" 'tpu-move-to-end)                ; down-arrow
-(define-key GOLD-SS3-map "C" 'end-of-line)                    ; right-arrow
-(define-key GOLD-SS3-map "D" 'beginning-of-line)              ; left-arrow
-
-(define-key GOLD-SS3-map "P" 'keyboard-quit)                  ; PF1
-(define-key GOLD-SS3-map "Q" 'help-for-help)                  ; PF2
-(define-key GOLD-SS3-map "R" 'tpu-search)                     ; PF3
-(define-key GOLD-SS3-map "S" 'tpu-undelete-lines)             ; PF4
-(define-key GOLD-SS3-map "p" 'open-line)                      ; KP0
-(define-key GOLD-SS3-map "q" 'tpu-change-case)                ; KP1
-(define-key GOLD-SS3-map "r" 'tpu-delete-to-eol)              ; KP2
-(define-key GOLD-SS3-map "s" 'tpu-special-insert)             ; KP3
-(define-key GOLD-SS3-map "t" 'tpu-move-to-end)                ; KP4
-(define-key GOLD-SS3-map "u" 'tpu-move-to-beginning)          ; KP5
-(define-key GOLD-SS3-map "v" 'tpu-paste)                      ; KP6
-(define-key GOLD-SS3-map "w" 'execute-extended-command)       ; KP7
-(define-key GOLD-SS3-map "x" 'tpu-fill)                       ; KP8
-(define-key GOLD-SS3-map "y" 'tpu-replace)                    ; KP9
-(define-key GOLD-SS3-map "m" 'tpu-undelete-words)             ; KP-
-(define-key GOLD-SS3-map "l" 'tpu-undelete-char)              ; KP,
-(define-key GOLD-SS3-map "n" 'tpu-unselect)                   ; KP.
-(define-key GOLD-SS3-map "M" 'tpu-substitute)                 ; KPenter
-
-
-;;;
-;;;  Repeat complex command map additions to make arrows work
-;;;
-(cond ((boundp 'repeat-complex-command-map)
-       (define-key repeat-complex-command-map "\e[A" 'previous-complex-command)
-       (define-key repeat-complex-command-map "\e[B" 'next-complex-command)
-       (define-key repeat-complex-command-map "\eOA" 'previous-complex-command)
-       (define-key repeat-complex-command-map "\eOB" 'next-complex-command)))
-
-
-;;;
-;;;  Minibuffer map additions to make KP_enter = RET
-;;;
-(define-key minibuffer-local-map "\eOM" 'exit-minibuffer)
-(define-key minibuffer-local-ns-map "\eOM" 'exit-minibuffer)
-(define-key minibuffer-local-completion-map "\eOM" 'exit-minibuffer)
-(define-key minibuffer-local-must-match-map "\eOM" 'minibuffer-complete-and-exit)
-(and (boundp 'repeat-complex-command-map)
-     (define-key repeat-complex-command-map "\eOM" 'exit-minibuffer))
-
-
-;;;
-;;;  Minibuffer map additions to set search direction
-;;;
-(define-key minibuffer-local-map "\eOt" 'tpu-search-forward-exit)
-(define-key minibuffer-local-map "\eOu" 'tpu-search-backward-exit)
-
-
-;;;
-;;;  Functions to set, reset, and toggle the control key bindings
-;;;
-(defun tpu-set-control-keys nil
-  "Set control keys to TPU style functions."
-  (define-key global-map "\C-\\" 'quoted-insert)                ; ^\
-  (define-key global-map "\C-a" 'tpu-toggle-overwrite-mode)     ; ^A
-  (define-key global-map "\C-b" 'repeat-complex-command)        ; ^B
-  (define-key global-map "\C-e" 'tpu-current-end-of-line)       ; ^E
-  (define-key global-map "\C-h" 'tpu-next-beginning-of-line)    ; ^H (BS)
-  (define-key global-map "\C-j" 'tpu-delete-previous-word)      ; ^J (LF)
-  (define-key global-map "\C-k" 'tpu-define-macro-key)          ; ^K
-  (define-key global-map "\C-l" 'tpu-insert-formfeed)           ; ^L (FF)
-  (define-key global-map "\C-r" 'recenter)                      ; ^R
-  (define-key global-map "\C-u" 'tpu-delete-to-bol)             ; ^U
-  (define-key global-map "\C-v" 'tpu-quoted-insert)             ; ^V
-  (define-key global-map "\C-w" 'redraw-display)                ; ^W
-  (define-key global-map "\C-z" 'tpu-exit)                      ; ^Z
-  (setq tpu-control-keys t))
-
-(defun tpu-reset-control-keys (tpu-style)
-  "Set control keys to TPU or emacs style functions."
-  (let* ((tpu   (and tpu-style (not tpu-control-keys)))
-	 (emacs (and (not tpu-style) tpu-control-keys))
-	 (doit  (or tpu emacs)))
-    (cond (doit
-	   (if emacs (setq tpu-global-map (copy-keymap global-map)))
-	   (let ((map (if tpu
-			  (copy-keymap tpu-global-map)
-			(copy-keymap tpu-original-global-map))))
-
- 	     (define-key global-map "\C-\\" (lookup-key map "\C-\\"))   ; ^\
- 	     (define-key global-map "\C-a" (lookup-key map "\C-a"))     ; ^A
- 	     (define-key global-map "\C-b" (lookup-key map "\C-b"))     ; ^B
- 	     (define-key global-map "\C-e" (lookup-key map "\C-e"))     ; ^E
-	     (define-key global-map "\C-h" (lookup-key map "\C-h"))     ; ^H (BS)
-	     (define-key global-map "\C-j" (lookup-key map "\C-j"))     ; ^J (LF)
-	     (define-key global-map "\C-k" (lookup-key map "\C-k"))     ; ^K
-	     (define-key global-map "\C-l" (lookup-key map "\C-l"))     ; ^L (FF)
-	     (define-key global-map "\C-r" (lookup-key map "\C-r"))     ; ^R
-	     (define-key global-map "\C-u" (lookup-key map "\C-u"))     ; ^U
-	     (define-key global-map "\C-v" (lookup-key map "\C-v"))     ; ^V
-	     (define-key global-map "\C-w" (lookup-key map "\C-w"))     ; ^W
-	     (define-key global-map "\C-z" (lookup-key map "\C-z"))     ; ^Z
-	     (setq tpu-control-keys tpu-style))))))
-
-(defun tpu-toggle-control-keys nil
-  "Toggles control key bindings between TPU-edt and Emacs."
-  (interactive)
-  (tpu-reset-control-keys (not tpu-control-keys))
-  (and (interactive-p)
-       (message "Control keys function with %s bindings."
-		(if tpu-control-keys "TPU-edt" "Emacs"))))
-
-
-;;;
-;;;  Emacs version 19 minibuffer history support
-;;;
-(defun tpu-next-history-element (n)
-  "Insert the next element of the minibuffer history into the minibuffer."
-  (interactive "p")
-  (next-history-element n)
-  (goto-char (point-max)))
-
-(defun tpu-previous-history-element (n)
-  "Insert the previous element of the minibuffer history into the minibuffer."
-  (interactive "p")
-  (previous-history-element n)
-  (goto-char (point-max)))
-
-(defun tpu-arrow-history nil
-  "Modify minibuffer maps to use arrows for history recall."
-  (interactive)
-  (let ((loc (where-is-internal 'tpu-previous-line)) (cur nil))
-    (while (setq cur (car loc))
-      (define-key read-expression-map cur 'tpu-previous-history-element)
-      (define-key minibuffer-local-map cur 'tpu-previous-history-element)
-      (define-key minibuffer-local-ns-map cur 'tpu-previous-history-element)
-      (define-key minibuffer-local-completion-map cur 'tpu-previous-history-element)
-      (define-key minibuffer-local-must-match-map cur 'tpu-previous-history-element)
-      (setq loc (cdr loc)))
-
-    (setq loc (where-is-internal 'tpu-next-line))
-    (while (setq cur (car loc))
-      (define-key read-expression-map cur 'tpu-next-history-element)
-      (define-key minibuffer-local-map cur 'tpu-next-history-element)
-      (define-key minibuffer-local-ns-map cur 'tpu-next-history-element)
-      (define-key minibuffer-local-completion-map cur 'tpu-next-history-element)
-      (define-key minibuffer-local-must-match-map cur 'tpu-next-history-element)
-      (setq loc (cdr loc)))))
-
-
-;;;
-;;;  Emacs version 19 X-windows key definition support
-;;;
-(defun tpu-load-xkeys (file)
-  "Load the TPU-edt X-windows key definitions FILE.
-If FILE is nil, try to load a default file.  The default file names are
-`~/.tpu-lucid-keys' for Lucid emacs, and `~/.tpu-keys' for Emacs."
-  (interactive "fX key definition file: ")
-  (cond (file
-	 (setq file (expand-file-name file)))
-	(tpu-xkeys-file
-	 (setq file (expand-file-name tpu-xkeys-file)))
-	(tpu-lucid-emacs19-p
-	 (setq file (convert-standard-filename
-		     (expand-file-name "~/.tpu-lucid-keys"))))
-	(tpu-emacs19-p
-	 (setq file (convert-standard-filename
-		     (expand-file-name "~/.tpu-keys")))
-	 (and (not (file-exists-p file))
-	      (file-exists-p
-	       (convert-standard-filename
-		(expand-file-name "~/.tpu-gnu-keys")))
-	      (tpu-copy-keyfile
-	       (convert-standard-filename
-		(expand-file-name "~/.tpu-gnu-keys")) file))))
-  (cond ((file-readable-p file)
-	 (load-file file))
-	(t
-	 (switch-to-buffer "*scratch*")
-	 (erase-buffer)
-	 (insert "
-
-     Ack!!  You're running TPU-edt under X-windows without loading an
-     X  key definition file.   To create a  TPU-edt X  key definition
-     file, run the tpu-mapper.el program.  It  came with TPU-edt.  It
-     even includes directions on how to  use it!   Perhaps it's lying
-     around here someplace.  ")
-	 (let ((file "tpu-mapper.el")
-	       (found nil)
-	       (path nil)
-	       (search-list (append (list (expand-file-name ".")) load-path)))
-	   (while (and (not found) search-list)
-	     (setq path (concat (car search-list)
-				(if (string-match "/$" (car search-list)) "" "/")
-				file))
-	     (if (and (file-exists-p path) (not (file-directory-p path)))
-		 (setq found t))
-	     (setq search-list (cdr search-list)))
-	   (cond (found
-		  (insert (format
-			   "Ah yes, there it is, in \n\n       %s \n\n" path))
-		  (if (tpu-y-or-n-p "Do you want to run it now? ")
-		      (load-file path)))
-		 (t
-		  (insert "Nope, I can't seem to find it.  :-(\n\n")
-		  (sit-for 120)))))))
-
-(defun tpu-copy-keyfile (oldname newname)
-  "Copy the TPU-edt X key definitions file to the new default name."
-  (interactive "fOld name: \nFNew name: ")
-  (if (not (get-buffer "*TPU-Notice*")) (generate-new-buffer "*TPU-Notice*"))
-  (set-buffer "*TPU-Notice*")
-  (erase-buffer)
-  (insert "
-  NOTICE --
-
-  The default name of the TPU-edt key definition file has changed
-  from `~/.tpu-gnu-keys' to `~/.tpu-keys'.  With your permission,
-  your key definitions will be copied to the new file.  If you'll
-  never use older versions of Emacs, you can remove the old file.
-  If the copy fails, you'll be asked if you want to create a new
-  key definitions file.  Do you want to copy your key definition
-  file now?
-  ")
-  (save-window-excursion
-    (switch-to-buffer-other-window "*TPU-Notice*")
-    (shrink-window-if-larger-than-buffer)
-    (goto-char (point-min))
-    (beep)
-    (and (tpu-y-or-n-p "Copy key definitions to the new file now? ")
-	 (condition-case conditions
-             (copy-file oldname newname)
-	   (error (message "Sorry, couldn't copy - %s" (cdr conditions)))))
-    (kill-buffer "*TPU-Notice*")))
-
-
-;;;
-;;;  Start and Stop TPU-edt
-;;;
-;;;###autoload
-(defun tpu-edt-on nil
-  "Turn on TPU/edt emulation."
-  (interactive)
-  (cond
-   ((not tpu-edt-mode)
-    ;; we use picture-mode functions
-    (require 'picture)
-    (tpu-set-control-keys)
-    (cond (tpu-emacs19-p
-	   (and window-system (tpu-load-xkeys nil))
-	   (tpu-arrow-history))
-	  (t
-	   ;; define ispell functions
-	   (autoload 'ispell-word "ispell" "Check spelling of word at or before point" t)
-	   (autoload 'ispell-complete-word "ispell" "Complete word at or before point" t)
-	   (autoload 'ispell-buffer "ispell" "Check spelling of entire buffer" t)
-	   (autoload 'ispell-region "ispell" "Check spelling of region" t)))
-    (tpu-set-mode-line t)
-    (tpu-advance-direction)
-    ;; set page delimiter, display line truncation, and scrolling like TPU
-    (setq-default page-delimiter "\f")
-    (setq-default truncate-lines t)
-    (setq scroll-step 1)
-    (setq tpu-edt-mode t))))
-
-(defun tpu-edt-off nil
-  "Turn off TPU/edt emulation.  Note that the keypad is left on."
-  (interactive)
-  (cond
-   (tpu-edt-mode
-    (tpu-reset-control-keys nil)
-    (tpu-set-mode-line nil)
-    (setq-default page-delimiter "^\f")
-    (setq-default truncate-lines nil)
-    (setq scroll-step 0)
-    (setq global-map (copy-keymap tpu-original-global-map))
-    (use-global-map global-map)
-    (setq tpu-edt-mode nil))))
-
-(provide 'tpu-edt)
-
-;;; tpu-edt.el ends here
diff --git a/lisp/emulation/tpu-extras.el b/lisp/emulation/tpu-extras.el
deleted file mode 100644
index dbaf20ce3aa..00000000000
--- a/lisp/emulation/tpu-extras.el
+++ /dev/null
@@ -1,477 +0,0 @@
-;;; tpu-extras.el --- Scroll margins and free cursor mode for TPU-edt
-
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Rob Riepel <riepel@networking.stanford.edu>
-;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
-;; Keywords: emulations
-
-;; 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:
-
-;;  Use the functions defined here to customize TPU-edt to your tastes by
-;;  setting scroll margins and/or turning on free cursor mode.  Here's an
-;;  example for your .emacs file.
-
-;;     (tpu-set-cursor-free)                   ; Set cursor free.
-;;     (tpu-set-scroll-margins "10%" "15%")    ; Set scroll margins.
-
-;;  Scroll margins and cursor binding can be changed from within emacs using
-;;  the following commands:
-
-;;     tpu-set-scroll-margins  or   set scroll margins
-;;     tpu-set-cursor-bound    or   set cursor bound
-;;     tpu-set-cursor-free     or   set cursor free
-
-;;  Additionally, Gold-F toggles between bound and free cursor modes.
-
-;;  Note that switching out of free cursor mode or exiting TPU-edt while in
-;;  free cursor mode strips trailing whitespace from every line in the file.
-
-
-;;; Details:
-
-;;  The functions contained in this file implement scroll margins and free
-;;  cursor mode.  The following keys and commands are affected.
-
-;;       key/command   function                        scroll   cursor
-
-;;       Up-Arrow      previous line                     x        x
-;;       Down-Arrow    next line                         x        x
-;;       Right-Arrow   next character                             x
-;;       Left-Arrow    previous character                         x
-;;       KP0           next or previous line             x
-;;       KP7           next or previous page             x
-;;       KP8           next or previous screen           x
-;;       KP2           next or previous end-of-line      x        x
-;;       Control-e     current end-of-line                        x
-;;       Control-h     previous beginning-of-line        x
-;;       Next Scr      next screen                       x
-;;       Prev Scr      previous screen                   x
-;;       Search        find a string                     x
-;;       Replace       find and replace a string         x
-;;       Newline       insert a newline                  x
-;;       Paragraph     next or previous paragraph        x
-;;       Auto-Fill     break lines on spaces             x
-
-;;  These functions are not part of the base TPU-edt for the following
-;;  reasons:
-
-;;  Free cursor mode is implemented with the emacs picture-mode functions.
-;;  These functions support moving the cursor all over the screen, however,
-;;  when the cursor is moved past the end of a line, spaces or tabs are
-;;  appended to the line - even if no text is entered in that area.  In
-;;  order for a free cursor mode to work exactly like TPU/edt, this trailing
-;;  whitespace needs to be dealt with in every function that might encounter
-;;  it.  Such global changes are impractical, however, free cursor mode is
-;;  too valuable to abandon completely, so it has been implemented in those
-;;  functions where it serves best.
-
-;;  The implementation of scroll margins adds overhead to previously
-;;  simple and often used commands.  These commands are now responsible
-;;  for their normal operation and part of the display function.  There
-;;  is a possibility that this display overhead could adversely affect the
-;;  performance of TPU-edt on slower computers.  In order to support the
-;;  widest range of computers, scroll margin support is optional.
-
-;;  It's actually not known whether the overhead associated with scroll
-;;  margin support is significant.  If you find that it is, please send
-;;  a note describing the extent of the performance degradation.  Be sure
-;;  to include a description of the platform where you're running TPU-edt.
-;;  Send your note to the address provided by Gold-V.
-
-;;  Even with these differences and limitations, these functions implement
-;;  important aspects of the real TPU/edt.  Those who miss free cursor mode
-;;  and/or scroll margins will appreciate these implementations.
-
-;;; Code:
-
-
-;;;  Gotta have tpu-edt
-
-(require 'tpu-edt)
-
-
-;;;  Customization variables
-
-(defconst tpu-top-scroll-margin 0
-  "*Scroll margin at the top of the screen.
-Interpreted as a percent of the current window size.")
-(defconst tpu-bottom-scroll-margin 0
-  "*Scroll margin at the bottom of the screen.
-Interpreted as a percent of the current window size.")
-
-(defvar tpu-backward-char-like-tpu t
-  "*If non-nil, in free cursor mode backward-char (left-arrow) works
-just like TPU/edt.  Otherwise, backward-char will move to the end of
-the previous line when starting from a line beginning.")
-
-
-;;;  Global variables
-
-(defvar tpu-cursor-free nil
-  "If non-nil, let the cursor roam free.")
-
-
-;;;  Hooks  --  Set cursor free in picture mode.
-;;;             Clean up when writing a file from cursor free mode.
-
-(add-hook 'picture-mode-hook 'tpu-set-cursor-free)
-
-(defun tpu-write-file-hook nil
-  "Eliminate whitespace at ends of lines, if the cursor is free."
-  (if (and (buffer-modified-p) tpu-cursor-free) (picture-clean)))
-
-(or (memq 'tpu-write-file-hook write-file-hooks)
-    (setq write-file-hooks
-	  (cons 'tpu-write-file-hook write-file-hooks)))
-
-
-;;;  Utility routines for implementing scroll margins
-
-(defun tpu-top-check (beg lines)
-  "Enforce scroll margin at the top of screen."
-  (let ((margin	 (/ (* (window-height) tpu-top-scroll-margin) 100)))
-    (cond ((< beg margin) (recenter beg))
-	  ((< (- beg lines) margin) (recenter margin)))))
-
-(defun tpu-bottom-check (beg lines)
-  "Enforce scroll margin at the bottom of screen."
-  (let* ((height (window-height))
-	 (margin (+ 1 (/ (* height tpu-bottom-scroll-margin) 100)))
-	 ;; subtract 1 from height because it includes mode line
-	 (difference (- height margin 1)))
-    (cond ((> beg difference) (recenter beg))
-	  ((> (+ beg lines) difference) (recenter (- margin))))))
-
-
-;;;  Movement by character
-
-(defun tpu-forward-char (num)
-  "Move right ARG characters (left if ARG is negative)."
-  (interactive "p")
-  (if tpu-cursor-free (picture-forward-column num) (forward-char num)))
-
-(defun tpu-backward-char (num)
-  "Move left ARG characters (right if ARG is negative)."
-  (interactive "p")
-  (cond ((not tpu-cursor-free)
-	 (backward-char num))
-	(tpu-backward-char-like-tpu
-	 (picture-backward-column num))
-	((bolp)
-	 (backward-char 1)
-	 (picture-end-of-line)
-	 (picture-backward-column (1- num)))
-	(t
-	 (picture-backward-column num))))
-
-
-;;;  Movement by line
-
-(defun tpu-next-line (num)
-  "Move to next line.
-Prefix argument serves as a repeat count."
-  (interactive "p")
-  (let ((beg (tpu-current-line)))
-    (if tpu-cursor-free (or (eobp) (picture-move-down num))
-      (next-line-internal num))
-    (tpu-bottom-check beg num)
-    (setq this-command 'next-line)))
-
-(defun tpu-previous-line (num)
-  "Move to previous line.
-Prefix argument serves as a repeat count."
-  (interactive "p")
-  (let ((beg (tpu-current-line)))
-    (if tpu-cursor-free (picture-move-up num) (next-line-internal (- num)))
-    (tpu-top-check beg num)
-    (setq this-command 'previous-line)))
-
-(defun tpu-next-beginning-of-line (num)
-  "Move to beginning of line; if at beginning, move to beginning of next line.
-Accepts a prefix argument for the number of lines to move."
-  (interactive "p")
-  (let ((beg (tpu-current-line)))
-    (backward-char 1)
-    (forward-line (- 1 num))
-    (tpu-top-check beg num)))
-
-(defun tpu-next-end-of-line (num)
-  "Move to end of line; if at end, move to end of next line.
-Accepts a prefix argument for the number of lines to move."
-  (interactive "p")
-  (let ((beg (tpu-current-line)))
-    (cond (tpu-cursor-free
-	   (let ((beg (point)))
-	     (if (< 1 num) (forward-line num))
-	     (picture-end-of-line)
-	     (if (<= (point) beg) (progn (forward-line) (picture-end-of-line)))))
-	  (t
-	   (forward-char)
-	   (end-of-line num)))
-    (tpu-bottom-check beg num)))
-
-(defun tpu-previous-end-of-line (num)
-  "Move EOL upward.
-Accepts a prefix argument for the number of lines to move."
-  (interactive "p")
-  (let ((beg (tpu-current-line)))
-    (cond (tpu-cursor-free
-	   (picture-end-of-line (- 1 num)))
-	  (t
-	   (end-of-line (- 1 num))))
-    (tpu-top-check beg num)))
-
-(defun tpu-current-end-of-line nil
-  "Move point to end of current line."
-  (interactive)
-  (let ((beg (point)))
-    (if tpu-cursor-free (picture-end-of-line) (end-of-line))
-    (if (= beg (point)) (message "You are already at the end of a line."))))
-
-(defun tpu-forward-line (num)
-  "Move to beginning of next line.
-Prefix argument serves as a repeat count."
-  (interactive "p")
-  (let ((beg (tpu-current-line)))
-    (next-line-internal num)
-    (tpu-bottom-check beg num)
-    (beginning-of-line)))
-
-(defun tpu-backward-line (num)
-  "Move to beginning of previous line.
-Prefix argument serves as repeat count."
-  (interactive "p")
-  (let ((beg (tpu-current-line)))
-    (or (bolp) (>= 0 num) (setq num (- num 1)))
-    (next-line-internal (- num))
-    (tpu-top-check beg num)
-    (beginning-of-line)))
-
-
-;;;  Movement by paragraph
-
-(defun tpu-paragraph (num)
-  "Move to the next paragraph in the current direction.
-A repeat count means move that many paragraphs."
-  (interactive "p")
-  (let* ((left nil)
-	 (beg (tpu-current-line))
-	 (height (window-height))
-	 (top-percent
-	  (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
-	 (bottom-percent
-	  (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
-	 (top-margin (/ (* height top-percent) 100))
-	 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
-	 (bottom-margin (max beg (- height bottom-up-margin 1)))
-	 (top (save-excursion (move-to-window-line top-margin) (point)))
-	 (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
-	 (far (save-excursion
-		(goto-char bottom) (forward-line (- height 2)) (point))))
-    (cond (tpu-advance
-	   (tpu-next-paragraph num)
-	   (cond((> (point) far)
-		 (setq left (save-excursion (forward-line height)))
-		 (if (= 0 left) (recenter top-margin)
-		   (recenter (- left bottom-up-margin))))
-		(t
-		 (and (> (point) bottom) (recenter bottom-margin)))))
-	  (t
-	   (tpu-previous-paragraph num)
-	   (and (< (point) top) (recenter (min beg top-margin)))))))
-
-
-;;;  Movement by page
-
-(defun tpu-page (num)
-  "Move to the next page in the current direction.
-A repeat count means move that many pages."
-  (interactive "p")
-  (let* ((left nil)
-	 (beg (tpu-current-line))
-	 (height (window-height))
-	 (top-percent
-	  (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
-	 (bottom-percent
-	  (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
-	 (top-margin (/ (* height top-percent) 100))
-	 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
-	 (bottom-margin (max beg (- height bottom-up-margin 1)))
-	 (top (save-excursion (move-to-window-line top-margin) (point)))
-	 (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
-	 (far (save-excursion
-		(goto-char bottom) (forward-line (- height 2)) (point))))
-    (cond (tpu-advance
-	   (forward-page num)
-	   (cond((> (point) far)
-		 (setq left (save-excursion (forward-line height)))
-		 (if (= 0 left) (recenter top-margin)
-		   (recenter (- left bottom-up-margin))))
-		(t
-		 (and (> (point) bottom) (recenter bottom-margin)))))
-	  (t
-	   (backward-page num)
-	   (and (< (point) top) (recenter (min beg top-margin)))))))
-
-
-;;;  Scrolling
-
-(defun tpu-scroll-window-down (num)
-  "Scroll the display down to the next section.
-A repeat count means scroll that many sections."
-  (interactive "p")
-  (let* ((beg (tpu-current-line))
-	 (height (1- (window-height)))
-	 (lines (* num (/ (* height tpu-percent-scroll) 100))))
-    (next-line-internal (- lines))
-    (tpu-top-check beg lines)))
-
-(defun tpu-scroll-window-up (num)
-  "Scroll the display up to the next section.
-A repeat count means scroll that many sections."
-  (interactive "p")
-  (let* ((beg (tpu-current-line))
-	 (height (1- (window-height)))
-	 (lines (* num (/ (* height tpu-percent-scroll) 100))))
-    (next-line-internal lines)
-    (tpu-bottom-check beg lines)))
-
-
-;;;  Replace the TPU-edt internal search function
-
-(defun tpu-search-internal (pat &optional quiet)
-  "Search for a string or regular expression."
-  (let* ((left nil)
-	 (beg (tpu-current-line))
-	 (height (window-height))
-	 (top-percent
-	  (if (= 0 tpu-top-scroll-margin) 10 tpu-top-scroll-margin))
-	 (bottom-percent
-	  (if (= 0 tpu-bottom-scroll-margin) 15 tpu-bottom-scroll-margin))
-	 (top-margin (/ (* height top-percent) 100))
-	 (bottom-up-margin (+ 1 (/ (* height bottom-percent) 100)))
-	 (bottom-margin (max beg (- height bottom-up-margin 1)))
-	 (top (save-excursion (move-to-window-line top-margin) (point)))
-	 (bottom (save-excursion (move-to-window-line bottom-margin) (point)))
-	 (far (save-excursion
-		(goto-char bottom) (forward-line (- height 2)) (point))))
-    (tpu-search-internal-core pat quiet)
-    (if tpu-searching-forward
-	(cond((> (point) far)
-	      (setq left (save-excursion (forward-line height)))
-	      (if (= 0 left) (recenter top-margin)
-		(recenter (- left bottom-up-margin))))
-	     (t
-	      (and (> (point) bottom) (recenter bottom-margin))))
-      (and (< (point) top) (recenter (min beg top-margin))))))
-
-
-
-;;;  Replace the newline, newline-and-indent, and do-auto-fill functions
-
-(or (fboundp 'tpu-old-newline)
-    (fset 'tpu-old-newline (symbol-function 'newline)))
-(or (fboundp 'tpu-old-do-auto-fill)
-    (fset 'tpu-old-do-auto-fill (symbol-function 'do-auto-fill)))
-(or (fboundp 'tpu-old-newline-and-indent)
-    (fset 'tpu-old-newline-and-indent (symbol-function 'newline-and-indent)))
-
-(defun newline (&optional num)
-  "Insert a newline.  With arg, insert that many newlines.
-In Auto Fill mode, can break the preceding line if no numeric arg.
-This is the TPU-edt version that respects the bottom scroll margin."
-  (interactive "p")
-  (let ((beg (tpu-current-line)))
-    (or num (setq num 1))
-    (tpu-old-newline num)
-    (tpu-bottom-check beg num)))
-
-(defun newline-and-indent nil
-  "Insert a newline, then indent according to major mode.
-Indentation is done using the current indent-line-function.
-In programming language modes, this is the same as TAB.
-In some text modes, where TAB inserts a tab, this indents
-to the specified left-margin column.  This is the TPU-edt
-version that respects the bottom scroll margin."
-  (interactive)
-  (let ((beg (tpu-current-line)))
-    (tpu-old-newline-and-indent)
-    (tpu-bottom-check beg 1)))
-
-(defun do-auto-fill nil
-  "TPU-edt version that respects the bottom scroll margin."
-  (let ((beg (tpu-current-line)))
-    (tpu-old-do-auto-fill)
-    (tpu-bottom-check beg 1)))
-
-
-;;;  Function to set scroll margins
-
-;;;###autoload
-(defun tpu-set-scroll-margins (top bottom)
-  "Set scroll margins."
-  (interactive
-   "sEnter top scroll margin (N lines or N%% or RETURN for current value): \
-\nsEnter bottom scroll margin (N lines or N%% or RETURN for current value): ")
-  ;; set top scroll margin
-  (or (string= top "")
-      (if (string= "%" (substring top -1))
-	  (setq tpu-top-scroll-margin (string-to-int top))
-	(setq tpu-top-scroll-margin
-	      (/ (1- (+ (* (string-to-int top) 100) (window-height)))
-		 (window-height)))))
-  ;; set bottom scroll margin
-  (or (string= bottom "")
-      (if (string= "%" (substring bottom -1))
-	  (setq tpu-bottom-scroll-margin (string-to-int bottom))
-	(setq tpu-bottom-scroll-margin
-	      (/ (1- (+ (* (string-to-int bottom) 100) (window-height)))
-		 (window-height)))))
-  ;; report scroll margin settings if running interactively
-  (and (interactive-p)
-       (message "Scroll margins set.  Top = %s%%, Bottom = %s%%"
-		tpu-top-scroll-margin tpu-bottom-scroll-margin)))
-
-
-;;;  Functions to set cursor bound or free
-
-;;;###autoload
-(defun tpu-set-cursor-free nil
-  "Allow the cursor to move freely about the screen."
-  (interactive)
-  (setq tpu-cursor-free t)
-  (substitute-key-definition 'tpu-set-cursor-free
-			     'tpu-set-cursor-bound
-			     GOLD-map)
-  (message "The cursor will now move freely about the screen."))
-
-;;;###autoload
-(defun tpu-set-cursor-bound nil
-  "Constrain the cursor to the flow of the text."
-  (interactive)
-  (picture-clean)
-  (setq tpu-cursor-free nil)
-  (substitute-key-definition 'tpu-set-cursor-bound
-			     'tpu-set-cursor-free
-			     GOLD-map)
-  (message "The cursor is now bound to the flow of your text."))
-
-;;; tpu-extras.el ends here
diff --git a/lisp/emulation/tpu-mapper.el b/lisp/emulation/tpu-mapper.el
deleted file mode 100644
index ba6d032fd6a..00000000000
--- a/lisp/emulation/tpu-mapper.el
+++ /dev/null
@@ -1,395 +0,0 @@
-;;; tpu-mapper.el --- Create a TPU-edt X-windows keymap file
-
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Rob Riepel <riepel@networking.stanford.edu>
-;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
-;; Keywords: emulations
-
-;; 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 emacs lisp program can be used to create an emacs lisp file that
-;;  defines the TPU-edt keypad for emacs running on x-windows.  Please read
-;;  the "Usage" AND "Known Problems" sections before attempting to run this
-;;  program.
-
-;;; Usage:
-
-;;  Simply load this file into the X-windows version of emacs using the
-;;  following command.
-
-;;    emacs -q -l tpu-mapper
-
-;;  The "-q" option prevents loading of your .emacs file (commands therein
-;;  might confuse this program).
-
-;;  An instruction screen showing the TPU-edt keypad will be displayed, and
-;;  you will be prompted to press the TPU-edt editing keys.  Tpu-mapper uses
-;;  the keys you press to create an Emacs Lisp file that will define a
-;;  TPU-edt keypad for your X server.  You can even re-arrange the standard
-;;  EDT keypad to suit your tastes (or to cope with those silly Sun and PC
-;;  keypads).
-
-;;  Finally, you will be prompted for the name of the file to store the key
-;;  definitions.  If you chose the default, TPU-edt will find it and load it
-;;  automatically.  If you specify a different file name, you will need to
-;;  set the variable "tpu-xkeys-file" before starting TPU-edt.  Here's how
-;;  you might go about doing that in your .emacs file.
-
-;;    (setq tpu-xkeys-file (expand-file-name "~/.my-emacs-x-keys"))
-;;    (tpu-edt)
-
-;;; Known Problems:
-
-;;  Sometimes, tpu-mapper will ignore a key you press, and just continue to
-;;  prompt for the same key.  This can happen when your window manager sucks
-;;  up the key and doesn't pass it on to Emacs, or it could be an Emacs bug.
-;;  Either way, there's nothing that tpu-mapper can do about it.  You must
-;;  press RETURN, to skip the current key and continue.  Later, you and/or
-;;  your local X guru can try to figure out why the key is being ignored.
-
-;;; Code:
-
-
-;;;
-;;;  Make sure we're running X-windows and Emacs version 19
-;;;
-(cond
- ((not (and window-system (not (string-lessp emacs-version "19"))))
-  (error "tpu-mapper requires running in Emacs 19, with an X display")))
-
-
-;;;
-;;;  Decide whether we're running Lucid Emacs or Emacs itself.
-;;;
-(defconst tpu-lucid-emacs19-p (string-match "Lucid" emacs-version)
-  "Non-NIL if we are running Lucid Emacs version 19.")
-
-
-;;;
-;;;  Key variables
-;;;
-(defvar tpu-kp4 nil)
-(defvar tpu-kp5 nil)
-(defvar tpu-key nil)
-(defvar tpu-enter nil)
-(defvar tpu-return nil)
-(defvar tpu-key-seq nil)
-(defvar tpu-enter-seq nil)
-(defvar tpu-return-seq nil)
-
-
-;;;
-;;;  Make sure the window is big enough to display the instructions
-;;;
-(if tpu-lucid-emacs19-p (set-screen-size (selected-screen) 80 36)
-  (set-frame-size (selected-frame) 80 36))
-
-
-;;;
-;;;  Create buffers - Directions, Keys, Gold-Keys
-;;;
-(if (not (get-buffer "Directions")) (generate-new-buffer "Directions"))
-(if (not (get-buffer "Keys")) (generate-new-buffer "Keys"))
-(if (not (get-buffer "Gold-Keys")) (generate-new-buffer "Gold-Keys"))
-
-
-;;;
-;;;  Put headers in the Keys buffer
-;;;
-(set-buffer "Keys")
-(insert "\
-;;  Key definitions for TPU-edt
-;;
-")
-
-
-;;;
-;;;   Display directions
-;;;
-(switch-to-buffer "Directions")
-(insert "
-    This program prompts you to press keys to create a custom keymap file
-    for use with the x-windows version of Emacs and TPU-edt.
-
-    Start by pressing the RETURN key, and continue by pressing the keys
-    specified in the mini-buffer.  You can re-arrange the TPU-edt keypad
-    by pressing any key you want at any prompt.  If you want to entirely
-    omit a key, just press RETURN at the prompt.
-
-    Here's a picture of the standard TPU/edt keypad for reference:
-
-          _______________________    _______________________________
-         | HELP  |      Do       |  |       |       |       |       |
-         |KeyDefs|               |  |       |       |       |       |
-         |_______|_______________|  |_______|_______|_______|_______|
-          _______________________    _______________________________
-         | Find  |Insert |Remove |  | Gold  | HELP  |FndNxt | Del L |
-         |       |       |Sto Tex|  |  key  |E-Help | Find  |Undel L|
-         |_______|_______|_______|  |_______|_______|_______|_______|
-         |Select |Pre Scr|Nex Scr|  | Page  | Sect  |Append | Del W |
-         | Reset |Pre Win|Nex Win|  |  Do   | Fill  |Replace|Undel W|
-         |_______|_______|_______|  |_______|_______|_______|_______|
-                 |Move up|          |Forward|Reverse|Remove | Del C |
-                 |  Top  |          |Bottom |  Top  |Insert |Undel C|
-          _______|_______|_______   |_______|_______|_______|_______|
-         |Mov Lef|Mov Dow|Mov Rig|  | Word  |  EOL  | Char  |       |
-         |StaOfLi|Bottom |EndOfLi|  |ChngCas|Del EOL|SpecIns| Enter |
-         |_______|_______|_______|  |_______|_______|_______|       |
-                                    |     Line      |Select | Subs  |
-                                    |   Open Line   | Reset |       |
-                                    |_______________|_______|_______|
-
-
-")
-(delete-other-windows)
-(goto-char (point-min))
-
-;;;
-;;;  Save <CR> for future reference
-;;;
-(cond
- (tpu-lucid-emacs19-p
-  (setq tpu-return-seq (read-key-sequence "Hit carriage-return <CR> to continue "))
-  (setq tpu-return (concat "[" (format "%s" (event-key (aref tpu-return-seq 0))) "]")))
- (t
-  (message "Hit carriage-return <CR> to continue ")
-  (setq tpu-return-seq (read-event))
-  (setq tpu-return (concat "[" (format "%s" tpu-return-seq) "]"))))
-
-
-;;;
-;;;  Key mapping functions
-;;;
-(defun tpu-lucid-map-key (ident descrip func gold-func)
-  (interactive)
-  (setq tpu-key-seq (read-key-sequence (format "Press %s%s: " ident descrip)))
-  (setq tpu-key (concat "[" (format "%s" (event-key (aref tpu-key-seq 0))) "]"))
-  (cond ((not (equal tpu-key tpu-return))
-	 (set-buffer "Keys")
-	 (insert (format"(global-set-key %s %s)\n" tpu-key func))
-	 (set-buffer "Gold-Keys")
-	 (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func))
-	 (set-buffer "Directions"))
-	;; bogosity to get next prompt to come up, if the user hits <CR>!
-	;; check periodically to see if this is still needed...
-	(t
-	 (format "%s" tpu-key)))
-  tpu-key)
-
-(defun tpu-emacs-map-key (ident descrip func gold-func)
-  (interactive)
-  (message "Press %s%s: " ident descrip)
-  (setq tpu-key-seq (read-event))
-  (setq tpu-key (concat "[" (format "%s" tpu-key-seq) "]"))
-  (cond ((not (equal tpu-key tpu-return))
-	 (set-buffer "Keys")
-	 (insert (format"(global-set-key %s %s)\n" tpu-key func))
-	 (set-buffer "Gold-Keys")
-	 (insert (format "(define-key GOLD-map %s %s)\n" tpu-key gold-func))
-	 (set-buffer "Directions"))
-	;; bogosity to get next prompt to come up, if the user hits <CR>!
-	;; check periodically to see if this is still needed...
-	(t
-	 (format "%s" tpu-key)))
-  tpu-key)
-
-(fset 'tpu-map-key (if tpu-lucid-emacs19-p 'tpu-lucid-map-key 'tpu-emacs-map-key))
-
-
-(set-buffer "Keys")
-(insert "
-;;  Arrows
-;;
-")
-(set-buffer "Gold-Keys")
-(insert "
-;;  GOLD Arrows
-;;
-")
-(set-buffer "Directions")
-
-(tpu-map-key "Up-Arrow"     ""  "'tpu-previous-line"  "'tpu-move-to-beginning")
-(tpu-map-key "Down-arrow"   ""  "'tpu-next-line"      "'tpu-move-to-end")
-(tpu-map-key "Right-arrow"  ""  "'tpu-forward-char"   "'end-of-line")
-(tpu-map-key "Left-arrow"   ""  "'tpu-backward-char"  "'beginning-of-line")
-
-
-(set-buffer "Keys")
-(insert "
-;;  PF keys
-;;
-")
-(set-buffer "Gold-Keys")
-(insert "
-;;  GOLD PF keys
-;;
-")
-(set-buffer "Directions")
-
-(tpu-map-key "PF1"  " - The GOLD key"               "GOLD-map"                 "'keyboard-quit")
-(tpu-map-key "PF2"  " - The Keypad Help key"        "'tpu-help"                 "'help-for-help")
-(tpu-map-key "PF3"  " - The Find/Find-Next key"     "'tpu-search-again"         "'tpu-search")
-(tpu-map-key "PF4"  " - The Del/Undelete Line key"  "'tpu-delete-current-line"  "'tpu-undelete-lines")
-
-(set-buffer "Keys")
-(insert "
-;;  KP0-9 KP- KP, KP. and KPenter
-;;
-")
-(set-buffer "Gold-Keys")
-(insert "
-;;  GOLD KP0-9 KP- KP, and KPenter
-;;
-")
-(set-buffer "Directions")
-
-(tpu-map-key "KP-0"      " - The Line/Open-Line key"               "'tpu-line"                 "'open-line")
-(tpu-map-key "KP-1"      " - The Word/Change-Case key"             "'tpu-word"                 "'tpu-change-case")
-(tpu-map-key "KP-2"      " - The EOL/Delete-EOL key"               "'tpu-end-of-line"          "'tpu-delete-to-eol")
-(tpu-map-key "KP-3"      " - The Character/Special-Insert key"     "'tpu-char"                 "'tpu-special-insert")
-(setq tpu-kp4 (tpu-map-key "KP-4"      " - The Forward/Bottom key"               "'tpu-advance-direction"    "'tpu-move-to-end"))
-(setq tpu-kp5 (tpu-map-key "KP-5"      " - The Reverse/Top key"                  "'tpu-backup-direction"     "'tpu-move-to-beginning"))
-(tpu-map-key "KP-6"      " - The Remove/Insert key"                "'tpu-cut"                  "'tpu-paste")
-(tpu-map-key "KP-7"      " - The Page/Do key"                      "'tpu-page"                 "'execute-extended-command")
-(tpu-map-key "KP-8"      " - The Section/Fill key"                 "'tpu-scroll-window"        "'tpu-fill")
-(tpu-map-key "KP-9"      " - The Append/Replace key"               "'tpu-append-region"        "'tpu-replace")
-(tpu-map-key "KP--"      " - The Delete/Undelete Word key"         "'tpu-delete-current-word"  "'tpu-undelete-words")
-(tpu-map-key "KP-,"      " - The Delete/Undelete Character key"    "'tpu-delete-current-char"  "'tpu-undelete-char")
-(tpu-map-key "KP-."      " - The Select/Reset key"                 "'tpu-select"               "'tpu-unselect")
-(tpu-map-key "KP-Enter"  " - The Enter key on the numeric keypad"  "'newline"                  "'tpu-substitute")
-;; Save the enter key
-(setq tpu-enter tpu-key)
-(setq tpu-enter-seq tpu-key-seq)
-
-(set-buffer "Keys")
-(insert "
-;;  Editing keypad (find, insert, remove)
-;;                 (select, prev, next)
-;;
-")
-(set-buffer "Gold-Keys")
-(insert "
-;;  GOLD Editing keypad (find, insert, remove)
-;;                      (select, prev, next)
-;;
-")
-(set-buffer "Directions")
-
-(tpu-map-key "Find"      " - The Find key on the editing keypad"       "'tpu-search"              "'nil")
-(tpu-map-key "Insert"    " - The Insert key on the editing keypad"     "'tpu-paste"               "'nil")
-(tpu-map-key "Remove"    " - The Remove key on the editing keypad"     "'tpu-cut"                 "'tpu-store-text")
-(tpu-map-key "Select"    " - The Select key on the editing keypad"     "'tpu-select"              "'tpu-unselect")
-(tpu-map-key "Prev Scr"  " - The Prev Scr key on the editing keypad"   "'tpu-scroll-window-down"  "'tpu-previous-window")
-(tpu-map-key "Next Scr"  " - The Next Scr key on the editing keypad"   "'tpu-scroll-window-up"    "'tpu-next-window")
-
-(set-buffer "Keys")
-(insert "
-;;  F10-14 Help Do F17
-;;
-")
-(set-buffer "Gold-Keys")
-(insert "
-;;  GOLD F10-14 Help Do F17
-;;
-")
-(set-buffer "Directions")
-
-(tpu-map-key "F10"       " - Invokes the Exit function on VT200+ terminals"  "'tpu-exit"                    "'nil")
-(tpu-map-key "F11"       " - Inserts an Escape character into the text"      "'tpu-insert-escape"           "'nil")
-(tpu-map-key "Backspace" " - Not Delete nor ^H!  Sometimes on the F12 key"   "'tpu-next-beginning-of-line" "'nil")
-(tpu-map-key "F13"       " - Invokes the delete previous word function"      "'tpu-delete-previous-word"   "'nil")
-(tpu-map-key "F14"       " - Toggles insert/overstrike modes"                "'tpu-toggle-overwrite-mode"  "'nil")
-(tpu-map-key "Help"      " - Brings up the help screen, same as PF2"         "'tpu-help"                   "'describe-bindings")
-(tpu-map-key "Do"        " - Invokes the COMMAND function"                   "'execute-extended-command"   "'nil")
-(tpu-map-key "F17"       ""                                                  "'tpu-goto-breadcrumb"        "'tpu-drop-breadcrumb")
-
-(set-buffer "Gold-Keys")
-(cond
- ((not (equal tpu-enter tpu-return))
-  (insert "
-;;  Minibuffer map additions to make KP_enter = RET
-;;
-")
-
-  (insert (format "(define-key minibuffer-local-map %s 'exit-minibuffer)\n" tpu-enter))
-  (insert (format "(define-key minibuffer-local-ns-map %s 'exit-minibuffer)\n" tpu-enter))
-  (insert (format "(define-key minibuffer-local-completion-map %s 'exit-minibuffer)\n" tpu-enter))
-  (insert (format "(define-key minibuffer-local-must-match-map %s 'minibuffer-complete-and-exit)\n" tpu-enter))))
-
-(cond
- ((not (or (equal tpu-kp4 tpu-return) (equal tpu-kp5 tpu-return)))
-  (insert "
-;;  Minibuffer map additions to allow KP-4/5 termination of search strings.
-;;
-")
-
-  (insert (format "(define-key minibuffer-local-map %s 'tpu-search-forward-exit)\n" tpu-kp4))
-  (insert (format "(define-key minibuffer-local-map %s 'tpu-search-backward-exit)\n" tpu-kp5))))
-
-(insert "
-;;  Define the tpu-help-enter/return symbols
-;;
-")
-
-(cond (tpu-lucid-emacs19-p
-       (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter-seq))
-       (insert (format "(setq tpu-help-return \"%s\")\n" tpu-return-seq))
-       (insert "(setq tpu-help-N \"[#<keypress-event N>]\")\n")
-       (insert "(setq tpu-help-n \"[#<keypress-event n>]\")\n")
-       (insert "(setq tpu-help-P \"[#<keypress-event P>]\")\n")
-       (insert "(setq tpu-help-p \"[#<keypress-event p>]\")\n"))
-      (t
-       (insert (format "(setq tpu-help-enter \"%s\")\n" tpu-enter))))
-
-(append-to-buffer "Keys" 1 (point))
-(set-buffer "Keys")
-
-;;;
-;;;  Save the key mapping program
-;;;
-(let ((file
-       (convert-standard-filename
-	(if tpu-lucid-emacs19-p "~/.tpu-lucid-keys" "~/.tpu-keys"))))
-  (set-visited-file-name
-   (read-file-name (format "Save key mapping to file (default %s): " file) "" file)))
-(save-buffer)
-
-;;;
-;;;  Load the newly defined keys and clean up
-;;;
-(eval-current-buffer)
-(kill-buffer (current-buffer))
-(kill-buffer "*scratch*")
-(kill-buffer "Gold-Keys")
-
-;;;
-;;;  Let them know it worked.
-;;;
-(switch-to-buffer "Directions")
-(erase-buffer)
-(insert "
-    A custom TPU-edt keymap file has been created.
-
-    Press GOLD-k to remove this buffer and continue editing.
-")
-(goto-char (point-min))
-
-;;; tpu-mapper.el ends here
diff --git a/lisp/emulation/vi.el b/lisp/emulation/vi.el
deleted file mode 100644
index 265ab94f43f..00000000000
--- a/lisp/emulation/vi.el
+++ /dev/null
@@ -1,1467 +0,0 @@
-;;; vi.el --- major mode for emulating "vi" editor under GNU Emacs.
-
-; This file is in the public domain because the authors distributed it
-; without a copyright notice before the US signed the Bern Convention.
-
-;; Author: Neal Ziring <nz@rsch.wisc.edu>
-;;	Felix S. T. Wu <wu@crys.wisc.edu>
-;; Keywords: emulations
-
-;;; Commentary: 
-
-; Originally written by : seismo!wucs!nz@rsch.wisc.edu (Neal Ziring)
-; Extensively redesigned and rewritten by wu@crys.wisc.edu (Felix S.T. Wu)
-; Last revision: 01/07/87 Wed (for GNU Emacs 18.33)
-
-; INSTALLATION PROCEDURE:
-; 1) Add a global key binding for command "vi-mode" (I use ESC ESC instead of
-;    the single ESC used in real "vi", so I can access other ESC prefixed emacs
-;    commands while I'm in "vi"), say, by putting the following line in your
-;    ".emacs" file:
-;    (define-key global-map "\e\e" 'vi-mode) ;quick switch into vi-mode
-; 2) If you wish you can define "find-file-hooks" to enter "vi" automatically
-;    after a file is loaded into the buffer. For example, I defined it as:
-;    (setq find-file-hooks (list
-;                            (function (lambda ()
-;                                (if (not (or (eq major-mode 'Info-mode)
-;	                                      (eq major-mode 'vi-mode)))
-;                                    (vi-mode))))))
-; 3) In your .emacs file you can define the command "vi-mode" to be "autoload"
-;    or you can execute the "load" command to load "vi" directly.
-; 4) Read the comments for command "vi-mode" before you start using it.   
-;
-; COULD DO
-; 1). A general 'define-operator' function to replace current hack
-; 2). In operator handling, should allow other point moving Emacs commands
-;     (such as ESC <, ESC >) to be used as arguments.
-;
-;;; Code:
-
-(defun vi-switch-mode (arg mode-char)
-  "Switch the major mode of current buffer as specified by the following char \\{vi-tilde-map}"
-  (interactive "P\nc")
-  (let ((mode-cmd (lookup-key vi-tilde-map (char-to-string mode-char))))
-    (if (null mode-cmd)
-	(with-output-to-temp-buffer "*Help*"
-	  (princ (substitute-command-keys "Possible major modes to switch to: \\{vi-tilde-map}"))
-	  (save-excursion
-	    (set-buffer standard-output)
-	    (help-mode)))
-      (setq prefix-arg arg)		; prefix arg will be passed down
-      (command-execute mode-cmd nil)	; may need to save mode-line-format etc
-      (force-mode-line-update))))	; just in case
-
-
-(if (null (where-is-internal 'vi-switch-mode (current-local-map)))
-    (define-key ctl-x-map "~" 'vi-switch-mode))
-
-(defvar vi-tilde-map nil
-  "Keymap used for \\[vi-switch-mode] prefix key.  Link to various major modes.")
-
-(if vi-tilde-map
-    nil
-  (setq vi-tilde-map (make-keymap))
-  (define-key vi-tilde-map "a" 'abbrev-mode)
-  (define-key vi-tilde-map "c" 'c-mode)
-  (define-key vi-tilde-map "d" 'vi-debugging)
-  (define-key vi-tilde-map "e" 'emacs-lisp-mode)
-  (define-key vi-tilde-map "f" 'auto-fill-mode)
-  (define-key vi-tilde-map "g" 'prolog-mode)
-  (define-key vi-tilde-map "h" 'hanoi)
-  (define-key vi-tilde-map "i" 'info-mode)
-  (define-key vi-tilde-map "l" 'lisp-mode)
-  (define-key vi-tilde-map "n" 'nroff-mode)
-  (define-key vi-tilde-map "o" 'overwrite-mode)
-  (define-key vi-tilde-map "O" 'outline-mode)
-  (define-key vi-tilde-map "P" 'picture-mode)
-  (define-key vi-tilde-map "r" 'vi-readonly-mode)
-  (define-key vi-tilde-map "t" 'text-mode)
-  (define-key vi-tilde-map "v" 'vi-mode)
-  (define-key vi-tilde-map "x" 'tex-mode)
-  (define-key vi-tilde-map "~" 'vi-back-to-old-mode))
-
-(defun vi-debugging (arg)
-  "Toggle debug-on-error flag.  If prefix arg is given, set t."
-  (interactive "P")
-  (if arg
-      (setq debug-on-error t)
-    (setq debug-on-error (not debug-on-error)))
-  (if debug-on-error
-      (message "Debug-on-error ...")
-    (message "NO more debug-on-error")))
-
-(defun vi-back-to-old-mode ()
-  "Go back to the previous mode without setting up for insertion."
-  (interactive)
-  (if vi-mode-old-major-mode
-      (progn
-	(setq mode-name vi-mode-old-mode-name)
-	(use-local-map vi-mode-old-local-map)
-	(setq major-mode vi-mode-old-major-mode)
-	(setq case-fold-search vi-mode-old-case-fold)
-	(force-mode-line-update))))
-
-(defun vi-readonly-mode ()
-  "Toggle current buffer's readonly flag."
-  (interactive)
-  (setq buffer-read-only (not buffer-read-only)))
-
-(defvar vi-com-map nil
-   "Keymap used in Evi's command state
-Command state includes most of the vi editing commands, with some Emacs
-command extensions.")
-
-(put 'vi-undefined 'suppress-keymap t)
-(if vi-com-map nil
-  (setq vi-com-map (make-keymap))
-;;(fillarray vi-com-map 'vi-undefined)
-  (define-key vi-com-map "\C-@" 'vi-mark-region) ; extension
-  (define-key vi-com-map "\C-a" 'vi-ask-for-info)  ; extension
-  (define-key vi-com-map "\C-b" 'vi-backward-windowful)
-  (define-key vi-com-map "\C-c" 'vi-do-old-mode-C-c-command) ; extension
-  (define-key vi-com-map "\C-d" 'vi-scroll-down-window)
-  (define-key vi-com-map "\C-e" 'vi-expose-line-below)
-  (define-key vi-com-map "\C-f" 'vi-forward-windowful)
-  (define-key vi-com-map "\C-g" 'keyboard-quit)
-  (define-key vi-com-map "\C-i" 'indent-relative-maybe) ; TAB
-  (define-key vi-com-map "\C-j" 'vi-next-line) ; LFD
-  (define-key vi-com-map "\C-k" 'vi-kill-line) ; extension
-  (define-key vi-com-map "\C-l" 'recenter)
-  (define-key vi-com-map "\C-m" 'vi-next-line-first-nonwhite) ; RET
-  (define-key vi-com-map "\C-n" 'vi-next-line)
-  (define-key vi-com-map "\C-o" 'vi-split-open-line)
-  (define-key vi-com-map "\C-p" 'previous-line)
-  (define-key vi-com-map "\C-q" 'vi-query-replace) ; extension
-  (define-key vi-com-map "\C-r" 'vi-isearch-backward) ; modification
-  (define-key vi-com-map "\C-s" 'vi-isearch-forward)  ; extension
-  (define-key vi-com-map "\C-t" 'vi-transpose-objects) ; extension
-  (define-key vi-com-map "\C-u" 'vi-scroll-up-window)
-  (define-key vi-com-map "\C-v" 'scroll-up) ; extension
-  (define-key vi-com-map "\C-w" 'vi-kill-region)   ; extension
-  (define-key vi-com-map "\C-x" 'Control-X-prefix) ; extension
-  (define-key vi-com-map "\C-y" 'vi-expose-line-above)
-  (define-key vi-com-map "\C-z" 'suspend-emacs)
-
-  (define-key vi-com-map "\e"   'ESC-prefix); C-[ (ESC)
-  (define-key vi-com-map "\C-\\" 'vi-unimplemented)
-  (define-key vi-com-map "\C-]" 'find-tag)
-  (define-key vi-com-map "\C-^" 'vi-locate-def)  ; extension
-  (define-key vi-com-map "\C-_" 'vi-undefined) 
-
-  (define-key vi-com-map " " 'forward-char)
-  (define-key vi-com-map "!"  'vi-operator)
-  (define-key vi-com-map "\"" 'vi-char-argument)
-  (define-key vi-com-map "#"  'universal-argument) ; extension
-  (define-key vi-com-map "$"  'end-of-line)
-  (define-key vi-com-map "%"  'vi-find-matching-paren)
-  (define-key vi-com-map "&"  'vi-unimplemented)
-  (define-key vi-com-map "'"  'vi-goto-line-mark)
-  (define-key vi-com-map "("  'backward-sexp)
-  (define-key vi-com-map ")"  'forward-sexp)
-  (define-key vi-com-map "*"  'vi-name-last-change-or-macro) ; extension
-  (define-key vi-com-map "+"  'vi-next-line-first-nonwhite)
-  (define-key vi-com-map ","  'vi-reverse-last-find-char)
-  (define-key vi-com-map "-"  'vi-previous-line-first-nonwhite)
-  (define-key vi-com-map "."  'vi-redo-last-change-command)
-  (define-key vi-com-map "/"  'vi-search-forward)
-  (define-key vi-com-map "0"  'beginning-of-line)
-
-  (define-key vi-com-map "1"  'vi-digit-argument)
-  (define-key vi-com-map "2"  'vi-digit-argument)
-  (define-key vi-com-map "3"  'vi-digit-argument)
-  (define-key vi-com-map "4"  'vi-digit-argument)
-  (define-key vi-com-map "5"  'vi-digit-argument)
-  (define-key vi-com-map "6"  'vi-digit-argument)
-  (define-key vi-com-map "7"  'vi-digit-argument)
-  (define-key vi-com-map "8"  'vi-digit-argument)
-  (define-key vi-com-map "9"  'vi-digit-argument)
-
-  (define-key vi-com-map ":"  'vi-ex-cmd)
-  (define-key vi-com-map ";"  'vi-repeat-last-find-char)
-  (define-key vi-com-map "<"  'vi-operator)
-  (define-key vi-com-map "="  'vi-operator)
-  (define-key vi-com-map ">"  'vi-operator)
-  (define-key vi-com-map "?"  'vi-search-backward)
-  (define-key vi-com-map "@"  'vi-call-named-change-or-macro) ; extension
-
-  (define-key vi-com-map "A"  'vi-append-at-end-of-line)
-  (define-key vi-com-map "B"  'vi-backward-blank-delimited-word)
-  (define-key vi-com-map "C"  'vi-change-rest-of-line)
-  (define-key vi-com-map "D"  'vi-kill-line)
-  (define-key vi-com-map "E"  'vi-end-of-blank-delimited-word)
-  (define-key vi-com-map "F"  'vi-backward-find-char)
-  (define-key vi-com-map "G"  'vi-goto-line)
-  (define-key vi-com-map "H"  'vi-home-window-line)
-  (define-key vi-com-map "I"  'vi-insert-before-first-nonwhite)
-  (define-key vi-com-map "J"  'vi-join-lines)
-  (define-key vi-com-map "K"  'vi-undefined) 
-  (define-key vi-com-map "L"  'vi-last-window-line)
-  (define-key vi-com-map "M"  'vi-middle-window-line)
-  (define-key vi-com-map "N"  'vi-reverse-last-search)
-  (define-key vi-com-map "O"  'vi-open-above)
-  (define-key vi-com-map "P"  'vi-put-before)
-  (define-key vi-com-map "Q"  'vi-quote-words) ; extension
-  (define-key vi-com-map "R"  'vi-replace-chars)
-  (define-key vi-com-map "S"  'vi-substitute-lines)
-  (define-key vi-com-map "T"  'vi-backward-upto-char)
-  (define-key vi-com-map "U"  'vi-unimplemented)
-  (define-key vi-com-map "V"  'vi-undefined) 
-  (define-key vi-com-map "W"  'vi-forward-blank-delimited-word)
-  (define-key vi-com-map "X"  'call-last-kbd-macro) ; modification/extension
-  (define-key vi-com-map "Y"  'vi-yank-line)
-  (define-key vi-com-map "Z" (make-sparse-keymap)) ;allow below prefix command
-  (define-key vi-com-map "ZZ" 'vi-save-all-and-exit)
-
-  (define-key vi-com-map "["  'vi-unimplemented)
-  (define-key vi-com-map "\\" 'vi-operator) ; extension for vi-narrow-op
-  (define-key vi-com-map "]"  'vi-unimplemented)
-  (define-key vi-com-map "^"  'back-to-indentation)
-  (define-key vi-com-map "_"  'vi-undefined)
-  (define-key vi-com-map "`"  'vi-goto-char-mark)
-
-  (define-key vi-com-map "a"  'vi-insert-after)
-  (define-key vi-com-map "b"  'backward-word)
-  (define-key vi-com-map "c"  'vi-operator)
-  (define-key vi-com-map "d"  'vi-operator)
-  (define-key vi-com-map "e"  'vi-end-of-word)
-  (define-key vi-com-map "f"  'vi-forward-find-char)
-  (define-key vi-com-map "g"  'vi-beginning-of-buffer) ; extension
-  (define-key vi-com-map "h"  'backward-char)
-  (define-key vi-com-map "i"  'vi-insert-before)
-  (define-key vi-com-map "j"  'vi-next-line)
-  (define-key vi-com-map "k"  'previous-line)
-  (define-key vi-com-map "l"  'forward-char)
-  (define-key vi-com-map "m"  'vi-set-mark)
-  (define-key vi-com-map "n"  'vi-repeat-last-search)
-  (define-key vi-com-map "o"  'vi-open-below)
-  (define-key vi-com-map "p"  'vi-put-after)
-  (define-key vi-com-map "q"  'vi-replace)
-  (define-key vi-com-map "r"  'vi-replace-1-char)
-  (define-key vi-com-map "s"  'vi-substitute-chars)
-  (define-key vi-com-map "t"  'vi-forward-upto-char)
-  (define-key vi-com-map "u"  'undo)
-  (define-key vi-com-map "v"  'vi-verify-spelling) 
-  (define-key vi-com-map "w"  'vi-forward-word)
-  (define-key vi-com-map "x"  'vi-kill-char)
-  (define-key vi-com-map "y"  'vi-operator)
-  (define-key vi-com-map "z"  'vi-adjust-window)
-
-  (define-key vi-com-map "{"  'backward-paragraph)
-  (define-key vi-com-map "|"  'vi-goto-column)
-  (define-key vi-com-map "}"  'forward-paragraph)
-  (define-key vi-com-map "~"  'vi-change-case)
-  (define-key vi-com-map "\177" 'delete-backward-char))
-
-(put 'backward-char 'point-moving-unit 'char)
-(put 'vi-next-line 'point-moving-unit 'line)
-(put 'next-line 'point-moving-unit 'line)
-(put 'forward-line 'point-moving-unit 'line)
-(put 'previous-line 'point-moving-unit 'line)
-(put 'vi-isearch-backward 'point-moving-unit 'search)
-(put 'vi-search-backward 'point-moving-unit 'search)
-(put 'vi-isearch-forward 'point-moving-unit 'search)
-(put 'vi-search-forward 'point-moving-unit 'search)
-(put 'forward-char 'point-moving-unit 'char)
-(put 'end-of-line 'point-moving-unit 'char)
-(put 'vi-find-matching-paren 'point-moving-unit 'match)
-(put 'vi-goto-line-mark 'point-moving-unit 'line)
-(put 'backward-sexp 'point-moving-unit 'sexp)
-(put 'forward-sexp 'point-moving-unit 'sexp)
-(put 'vi-next-line-first-nonwhite 'point-moving-unit 'line)
-(put 'vi-previous-line-first-nonwhite 'point-moving-unit 'line)
-(put 'vi-reverse-last-find-char 'point-moving-unit 'rev-find)
-(put 'vi-re-search-forward 'point-moving-unit 'search)
-(put 'beginning-of-line 'point-moving-unit 'char)
-(put 'vi-beginning-of-buffer 'point-moving-unit 'char)
-(put 'vi-repeat-last-find-char 'point-moving-unit 'find)
-(put 'vi-re-search-backward 'point-moving-unit 'search)
-(put 'vi-backward-blank-delimited-word 'point-moving-unit 'WORD)
-(put 'vi-end-of-blank-delimited-word 'point-moving-unit 'match)
-(put 'vi-backward-find-char 'point-moving-unit 'find)
-(put 'vi-goto-line 'point-moving-unit 'line)
-(put 'vi-home-window-line 'point-moving-unit 'line)
-(put 'vi-last-window-line 'point-moving-unit 'line)
-(put 'vi-middle-window-line 'point-moving-unit 'line)
-(put 'vi-reverse-last-search 'point-moving-unit 'rev-search)
-(put 'vi-backward-upto-char 'point-moving-unit 'find)
-(put 'vi-forward-blank-delimited-word 'point-moving-unit 'WORD)
-(put 'back-to-indentation 'point-moving-unit 'char)
-(put 'vi-goto-char-mark 'point-moving-unit 'char)
-(put 'backward-word 'point-moving-unit 'word)
-(put 'vi-end-of-word 'point-moving-unit 'match)
-(put 'vi-forward-find-char 'point-moving-unit 'find)
-(put 'backward-char 'point-moving-unit 'char)
-(put 'vi-forward-char 'point-moving-unit 'char)
-(put 'vi-repeat-last-search 'point-moving-unit 'search)
-(put 'vi-forward-upto-char 'point-moving-unit 'find)
-(put 'vi-forward-word 'point-moving-unit 'word)
-(put 'vi-goto-column 'point-moving-unit 'match)
-(put 'forward-paragraph 'point-moving-unit 'paragraph)
-(put 'backward-paragraph 'point-moving-unit 'paragraph)
-
-;;; region mark commands
-(put 'mark-page 'point-moving-unit 'region)
-(put 'mark-paragraph 'point-moving-unit 'region)
-(put 'mark-word 'point-moving-unit 'region)
-(put 'mark-sexp 'point-moving-unit 'region)
-(put 'mark-defun 'point-moving-unit 'region)
-(put 'mark-whole-buffer 'point-moving-unit 'region)
-(put 'mark-end-of-sentence 'point-moving-unit 'region)
-(put 'mark-c-function 'point-moving-unit 'region)
-;;;
-
-(defvar vi-mark-alist nil
-  "Alist of (NAME . MARK), marks are local to each buffer.")
-
-(defvar vi-scroll-amount (/ (window-height) 2)
-  "Default amount of lines for scrolling (used by \"^D\"/\"^U\").")
-
-(defvar vi-shift-width 4
-  "Shift amount for \"<\"/\">\" operators.")
-
-(defvar vi-ins-point nil		; integer
-  "Last insertion point.  Should use `mark' instead.")
-
-(defvar vi-ins-length nil		; integer
-  "Length of last insertion.")
-
-(defvar vi-ins-repetition nil		; integer
-  "The repetition required for last insertion.")
-
-(defvar vi-ins-overwrt-p nil		; boolean
-  "T if last insertion was a replace actually.")
-
-(defvar vi-ins-prefix-code nil		; ready-to-eval sexp
-  "Code to be eval'ed before (redo-)insertion begins.")
-
-(defvar vi-last-find-char nil		; cons cell
-  "Save last direction, char and upto-flag used for char finding.")
-
-(defvar vi-last-change-command nil	; cons cell
-  "Save commands for redoing last changes.  Each command is in (FUNC . ARGS)
-form that is ready to be `apply'ed.")
-
-(defvar vi-last-shell-command nil	; last shell op command line
-  "Save last shell command given for \"!\" operator.")
-
-(defvar vi-insert-state nil             ; boolean
-  "Non-nil if it is in insert state.")
-
-; in "loaddefs.el"
-;(defvar search-last-string "" 
-;  "Last string search for by a search command.")
-
-(defvar vi-search-last-command nil	; (re-)search-forward(backward)
-  "Save last search command for possible redo.")
-
-(defvar vi-mode-old-local-map nil
-  "Save the local-map used before entering vi-mode.")
-
-(defvar vi-mode-old-mode-name nil
-  "Save the mode-name before entering vi-mode.")
-  
-(defvar vi-mode-old-major-mode nil
-  "Save the major-mode before entering vi-mode.")
-
-(defvar vi-mode-old-case-fold nil)
-  
-;(defconst vi-add-to-mode-line-1
-;  '(overwrite-mode nil " Insert"))
-
-;; Value is same as vi-add-to-mode-line-1 when in vi mode,
-;; but nil in other buffers.
-;(defvar vi-add-to-mode-line nil)
-
-(defun vi-mode-setup ()
-  "Setup a buffer for vi-mode by creating necessary buffer-local variables."
-;  (make-local-variable 'vi-add-to-mode-line)
-;  (setq vi-add-to-mode-line vi-add-to-mode-line-1)
-;  (or (memq vi-add-to-mode-line minor-mode-alist)
-;      (setq minor-mode-alist (cons vi-add-to-mode-line minor-mode-alist)))
-  (make-local-variable 'vi-scroll-amount)
-  (setq vi-scroll-amount (/ (window-height) 2))
-  (make-local-variable 'vi-shift-width)
-  (setq vi-shift-width 4)
-  (make-local-variable 'vi-ins-point)
-  (make-local-variable 'vi-ins-length)
-  (make-local-variable 'vi-ins-repetition)
-  (make-local-variable 'vi-ins-overwrt-p)
-  (make-local-variable 'vi-ins-prefix-code)
-  (make-local-variable 'vi-last-change-command)
-  (make-local-variable 'vi-last-shell-command)
-  (make-local-variable 'vi-last-find-char)
-  (make-local-variable 'vi-mark-alist)
-  (make-local-variable 'vi-insert-state)
-  (make-local-variable 'vi-mode-old-local-map)
-  (make-local-variable 'vi-mode-old-mode-name)
-  (make-local-variable 'vi-mode-old-major-mode)
-  (make-local-variable 'vi-mode-old-case-fold)
-  (run-hooks 'vi-mode-hook))
-      
-;;;###autoload
-(defun vi-mode ()
-  "Major mode that acts like the `vi' editor.
-The purpose of this mode is to provide you the combined power of vi (namely,
-the \"cross product\" effect of commands and repeat last changes) and Emacs.
-
-This command redefines nearly all keys to look like vi commands.
-It records the previous major mode, and any vi command for input
-\(`i', `a', `s', etc.) switches back to that mode.
-Thus, ordinary Emacs (in whatever major mode you had been using)
-is \"input\" mode as far as vi is concerned.
-
-To get back into vi from \"input\" mode, you must issue this command again.
-Therefore, it is recommended that you assign it to a key.
-
-Major differences between this mode and real vi :
-
-* Limitations and unsupported features
-  - Search patterns with line offset (e.g. /pat/+3 or /pat/z.) are
-    not supported.
-  - Ex commands are not implemented; try ':' to get some hints.
-  - No line undo (i.e. the 'U' command), but multi-undo is a standard feature.
-
-* Modifications
-  - The stopping positions for some point motion commands (word boundary,
-    pattern search) are slightly different from standard 'vi'.
-    Also, no automatic wrap around at end of buffer for pattern searching.
-  - Since changes are done in two steps (deletion then insertion), you need
-    to undo twice to completely undo a change command.  But this is not needed
-    for undoing a repeated change command.
-  - No need to set/unset 'magic', to search for a string with regular expr
-    in it just put a prefix arg for the search commands.  Replace cmds too.
-  - ^R is bound to incremental backward search, so use ^L to redraw screen.
-
-* Extensions
-  - Some standard (or modified) Emacs commands were integrated, such as
-    incremental search, query replace, transpose objects, and keyboard macros.
-  - In command state, ^X links to the 'ctl-x-map', and ESC can be linked to
-    esc-map or set undefined.  These can give you the full power of Emacs.
-  - See vi-com-map for those keys that are extensions to standard vi, e.g.
-    `vi-name-last-change-or-macro', `vi-verify-spelling', `vi-locate-def',
-    `vi-mark-region', and 'vi-quote-words'.  Some of them are quite handy.
-  - Use \\[vi-switch-mode] to switch among different modes quickly.
-  
-Syntax table and abbrevs while in vi mode remain as they were in Emacs."
-   (interactive)
-   (if (null vi-mode-old-major-mode)	; very first call for current buffer
-       (vi-mode-setup))
-
-   (if (eq major-mode 'vi-mode)
-       (message "Already in vi-mode." (ding))
-     (setq vi-mode-old-local-map (current-local-map))
-     (setq vi-mode-old-mode-name mode-name)
-     (setq vi-mode-old-major-mode major-mode)
-     (setq vi-mode-old-case-fold case-fold-search) ; this is needed !!
-     (setq case-fold-search nil)	; exact case match in searching
-     (use-local-map vi-com-map)
-     (setq major-mode 'vi-mode)
-     (setq mode-name "VI")
-     (force-mode-line-update)		; force mode line update
-     (if vi-insert-state	        ; this is a return from insertion
-         (vi-end-of-insert-state))))
-
-(defun vi-ding()
-  "Ding !"
-  (interactive)
-  (ding))
-
-(defun vi-save-all-and-exit ()
-  "Save all modified buffers without asking, then exits emacs."
-  (interactive)
-  (save-some-buffers t)
-  (kill-emacs))
-
-;; to be used by "ex" commands
-(defvar vi-replaced-string nil)
-(defvar vi-replacing-string nil)
-
-(defun vi-ex-cmd ()
-  "Ex commands are not implemented in Evi mode.  For some commonly used ex
-commands, you can use the following alternatives for similar effect :
-w            C-x C-s (save-buffer)
-wq           C-x C-c (save-buffers-kill-emacs)
-w fname      C-x C-w (write-file)
-e fname      C-x C-f (find-file)
-r fname      C-x i   (insert-file)
-s/old/new    use q (vi-replace) to do unconditional replace
-             use C-q (vi-query-replace) to do query replace
-set sw=n     M-x set-variable vi-shift-width n "
-  (interactive)
-;; (let ((cmd (read-string ":")) (lines 1))
-;;  (cond ((string-match "s"))))
-  (with-output-to-temp-buffer "*Help*"
-    (princ (documentation 'vi-ex-cmd))
-    (save-excursion
-      (set-buffer standard-output)
-      (help-mode))))
-
-(defun vi-undefined ()
-  (interactive)
-  (message "Command key \"%s\" is undefined in Evi."
-	   (single-key-description last-command-char))
-  (ding))
-
-(defun vi-unimplemented ()
-  (interactive)
-  (message "Command key \"%s\" is not implemented in Evi."
-	   (single-key-description last-command-char))
-  (ding))
-
-;;;;;
-(defun vi-goto-insert-state (repetition &optional prefix-code do-it-now-p)
-  "Go into insert state, the text entered will be repeated if REPETITION > 1.
-If PREFIX-CODE is given, do it before insertion begins if DO-IT-NOW-P is T.
-In any case, the prefix-code will be done before each 'redo-insert'.
-This function expects 'overwrite-mode' being set properly beforehand."
-  (if do-it-now-p (apply (car prefix-code) (cdr prefix-code)))
-  (setq vi-ins-point (point))
-  (setq vi-ins-repetition repetition)
-  (setq vi-ins-prefix-code prefix-code)
-  (setq mode-name vi-mode-old-mode-name)
-  (setq case-fold-search vi-mode-old-case-fold)
-  (use-local-map vi-mode-old-local-map)
-  (setq major-mode vi-mode-old-major-mode)
-  (force-mode-line-update)
-  (setq vi-insert-state t))
-
-(defun vi-end-of-insert-state ()
-  "Terminate insertion and set up last change command."
-  (if (or (< (point) vi-ins-point)    ;Check if there is any effective change
-	  (and (= (point) vi-ins-point) (null vi-ins-prefix-code))
-	  (<= vi-ins-repetition 0))
-      (vi-goto-command-state t)
-    (if (> vi-ins-repetition 1)
-	(progn 
-	  (let ((str (buffer-substring vi-ins-point (point))))
-	    (while (> vi-ins-repetition 1)
-	      (insert str)
-	      (setq vi-ins-repetition (1- vi-ins-repetition))))))
-    (vi-set-last-change-command 'vi-first-redo-insertion vi-ins-point (point)
-			     overwrite-mode vi-ins-prefix-code)
-    (vi-goto-command-state t)))
-
-(defun vi-first-redo-insertion (begin end &optional overwrite-p prefix-code)
-  "Redo last insertion the first time.  Extract the string and save it for
-future redoes.  Do prefix-code if it's given, use overwrite mode if asked."
-  (let ((str (buffer-substring begin end)))
-    (if prefix-code (apply (car prefix-code) (cdr prefix-code)))
-    (if overwrite-p (delete-region (point) (+ (point) (length str))))
-    (insert str)
-    (vi-set-last-change-command 'vi-more-redo-insertion str overwrite-p prefix-code)))
-
-(defun vi-more-redo-insertion (str &optional overwrite-p prefix-code)
-  "Redo more insertion : copy string from STR to point, use overwrite mode
-if overwrite-p is T; apply prefix-code first if it's non-nil."
-  (if prefix-code (apply (car prefix-code) (cdr prefix-code)))
-  (if overwrite-p (delete-region (point) (+ (point) (length str))))
-  (insert str))
-
-(defun vi-goto-command-state (&optional from-insert-state-p)
-  "Go to vi-mode command state.  If optional arg exists, means return from
-insert state."
-  (use-local-map vi-com-map)
-  (setq vi-insert-state nil)
-  (if from-insert-state-p
-      (if overwrite-mode
-	  (overwrite-mode 0)
-;	(set-minor-mode 'ins "Insert" nil)
-	)))
-
-(defun vi-kill-line (arg)
-   "kill specified number of lines (=d$), text saved in the kill ring."
-   (interactive "*P")
-   (kill-line arg)
-   (vi-set-last-change-command 'kill-line arg))
-
-(defun vi-kill-region (start end)
-  (interactive "*r")
-  (kill-region start end)
-  (vi-set-last-change-command 'kill-region))
-  
-(defun vi-append-at-end-of-line (arg)
-   "go to end of line and then go into vi insert state."
-   (interactive "*p")
-   (vi-goto-insert-state arg '(end-of-line) t))
-
-(defun vi-change-rest-of-line (arg)
-  "Change the rest of (ARG) lines (= c$ in vi)."
-  (interactive "*P")
-  (vi-goto-insert-state 1 (list 'kill-line arg) t))
-
-(defun vi-insert-before-first-nonwhite (arg)
-  "(= ^i in vi)"
-  (interactive "*p")
-  (vi-goto-insert-state arg '(back-to-indentation) t))
-
-(defun vi-open-above (arg)
-  "open new line(s) above current line and enter insert state."
-  (interactive "*p")
-  (vi-goto-insert-state 1
-			(list (function (lambda (x)
-					  (or (beginning-of-line)
-					      (open-line x)))) arg)
-			t))
-
-(defun vi-open-below (arg)
-  "open new line(s) and go into insert mode on the last line."
-  (interactive "*p")
-  (vi-goto-insert-state 1
-			(list (function (lambda (x)
-					  (or (end-of-line)
-					    (open-line x)
-					    (forward-line x)))) arg)
-			t))
-
-(defun vi-insert-after (arg)
-   "start vi insert state after cursor."
-   (interactive "*p")
-   (vi-goto-insert-state arg
-			 (list (function (lambda ()
-					   (if (not (eolp)) (forward-char)))))
-			 t))
-
-(defun vi-insert-before (arg)
-  "enter insert state before the cursor."
-  (interactive "*p")
-  (vi-goto-insert-state arg))
-
-(defun vi-goto-line (arg)
-   "Go to ARGth line."
-   (interactive "P")
-   (if (null (vi-raw-numeric-prefix arg))
-       (end-of-buffer)
-     (goto-line (vi-prefix-numeric-value arg))))
-
-(defun vi-beginning-of-buffer ()
-  "Move point to the beginning of current buffer."
-  (interactive)
-  (goto-char (point-min)))
-
-;;;;; not used now
-;;(defvar regexp-search t		; string
-;;  "*T if search string can contain regular expressions. (= set magic in vi)")
-;;;;;
-
-(defun vi-isearch-forward (arg)
-  "Incremental search forward.  Use regexp version if ARG is non-nil." 
-  (interactive "P")
-  (let ((scmd (if arg 'isearch-forward-regexp 'isearch-forward))
-	(opoint (point)))
-    (call-interactively scmd)
-    (if (= opoint (point))
-	nil
-      (setq vi-search-last-command (if arg 're-search-forward 'search-forward)))))
-
-(defun vi-isearch-backward (arg)
-  "Incremental search backward.  Use regexp version if ARG is non-nil."
-  (interactive "P")
-  (let ((scmd (if arg 'isearch-backward-regexp 'isearch-backward))
-	(opoint (point)))
-    (call-interactively scmd)
-    (if (= opoint (point))
-	nil
-      (setq vi-search-last-command (if arg 're-search-backward 'search-backward)))))
-
-(defun vi-search-forward (arg string)
-   "Nonincremental search forward. Use regexp version if ARG is non-nil."
-   (interactive (if current-prefix-arg
-		    (list t (read-string "regexp/" nil))
-		  (list nil (read-string "/" nil))))
-   (setq vi-search-last-command (if arg 're-search-forward 'search-forward))
-   (if (> (length string) 0) (setq search-last-string string)) 
-   (funcall vi-search-last-command search-last-string nil nil 1))
-
-(defun vi-search-backward (arg string)
-   "Nonincremental search backward.  Use regexp version if ARG is non-nil."
-   (interactive (if current-prefix-arg
-		    (list t (read-string "regexp?" nil))
-		  (list nil (read-string "?" nil))))
-   (setq vi-search-last-command (if arg 're-search-backward 'search-backward))
-   (if (> (length string) 0) (setq search-last-string string)) 
-   (funcall vi-search-last-command search-last-string nil nil 1))
-
-(defun vi-repeat-last-search (arg &optional search-command search-string)
-   "Repeat last search command.  If optional search-command/string are given,
-use those instead of the ones saved."
-   (interactive "p")
-   (if (null search-command) (setq search-command vi-search-last-command))
-   (if (null search-string) (setq search-string search-last-string))
-   (if (null search-command)
-       (message "No last search command to repeat." (ding))
-     (funcall search-command search-string nil nil arg)))
-
-(defun vi-reverse-last-search (arg &optional search-command search-string)
-  "Redo last search command in reverse direction. If the optional search args
-are given, use those instead of the ones saved."
-  (interactive "p")
-  (if (null search-command) (setq search-command vi-search-last-command))
-  (if (null search-string) (setq search-string search-last-string))
-  (if (null search-command)
-      (message "No last search command to repeat." (ding))
-    (funcall (cond ((eq search-command 're-search-forward) 're-search-backward)
-		   ((eq search-command 're-search-backward) 're-search-forward)
-		   ((eq search-command 'search-forward) 'search-backward)
-		   ((eq search-command 'search-backward) 'search-forward))
-	     search-string nil nil arg)))
-       
-(defun vi-join-lines (arg)
-   "join ARG lines from current line (default 2), cleaning up white space."
-   (interactive "P")
-   (if (null (vi-raw-numeric-prefix arg))
-       (delete-indentation t)
-     (setq count (vi-prefix-numeric-value arg))
-     (while (>= count 2)
-       (delete-indentation t)
-       (setq count (1- count))))
-   (vi-set-last-change-command 'vi-join-lines arg))
-
-(defun vi-backward-kill-line ()
-   "kill the current line.  Only works in insert state."
-   (interactive)
-   (if (not vi-insert-state)
-       nil
-     (beginning-of-line 1)
-     (kill-line nil)))
-
-(defun vi-abort-ins ()
-  "abort insert state, kill inserted text and go back to command state."
-  (interactive)
-  (if (not vi-insert-state)
-      nil
-    (if (> (point) vi-ins-point)
-	   (kill-region vi-ins-point (point)))
-    (vi-goto-command-state t)))
-
-(defun vi-backward-windowful (count)
-  "Backward COUNT windowfuls. Default is one."
-  (interactive "p")
-; (set-mark-command nil)
-  (while (> count 0)
-    (scroll-down nil)
-    (setq count (1- count))))
-
-(defun vi-scroll-down-window (count)
-  "Scrolls down window COUNT lines.
-If COUNT is nil (actually, non-integer), scrolls default amount.
-The given COUNT is remembered for future scrollings."
-  (interactive "P")
-  (if (integerp count)
-      (setq vi-scroll-amount count))
-  (scroll-up vi-scroll-amount))
-
-(defun vi-expose-line-below (count)
-  "Expose COUNT more lines below the current window.  Default COUNT is 1."
-  (interactive "p")
-  (scroll-up count))
-
-(defun vi-forward-windowful (count)
-  "Forward COUNT windowfuls. Default is one."
-  (interactive "p")
-; (set-mark-command nil)
-  (while (> count 0)
-    (scroll-up nil)
-    (setq count (1- count))))
-
-(defun vi-next-line (count)
-  "Go down count lines, try to keep at the same column."
-  (interactive "p")
-  (setq this-command 'next-line)	; this is a needed trick
-  (if (= (point) (or (line-move count) (point)))
-      (ding)				; no moving, already at end of buffer
-    (setq last-command 'next-line)))
-
-(defun vi-next-line-first-nonwhite (count)
-  "Go down COUNT lines.  Stop at first non-white."
-  (interactive "p")
-  (if (= (point) (progn (forward-line count) (back-to-indentation) (point)))
-      (ding)))				; no moving, already at end of buffer
-
-(defun vi-previous-line-first-nonwhite (count)
-  "Go up COUNT lines.  Stop at first non-white."
-  (interactive "p")
-  (previous-line count)
-  (back-to-indentation))
-
-(defun vi-scroll-up-window (count)
-  "Scrolls up window COUNT lines.
-If COUNT is nil (actually, non-integer), scrolls default amount.
-The given COUNT is remembered for future scrollings."
-  (interactive "P")
-  (if (integerp count)
-      (setq vi-scroll-amount count))
-  (scroll-down vi-scroll-amount))
-
-(defun vi-expose-line-above (count)
-  "Expose COUNT more lines above the current window.  Default COUNT is 1."
-  (interactive "p")
-  (scroll-down count))
-
-(defun vi-char-argument (arg)
-  "Get following character (could be any CHAR) as part of the prefix argument.
-Possible prefix-arg cases are NIL, INTEGER, (NIL . CHAR) or (INTEGER . CHAR)."
-  (interactive "P")
-  (let ((char (read-char)))
-    (cond ((null arg) (setq prefix-arg (cons nil char)))
-	  ((integerp arg) (setq prefix-arg (cons arg char)))
-	  ; This can happen only if the user changed his/her mind for CHAR,
-	  ; Or there are some leading "universal-argument"s
-	  (t (setq prefix-arg (cons (car arg) char))))))
-
-(defun vi-goto-mark (mark-char &optional line-flag)
-  "Go to marked position or line (if line-flag is given).
-Goto mark '@' means jump into and pop the top mark on the mark ring."
-  (cond ((char-equal mark-char last-command-char)	; `` or ''
-	 (exchange-point-and-mark) (if line-flag (back-to-indentation)))
-	((char-equal mark-char ?@)	; jump and pop mark
-	 (set-mark-command t) (if line-flag (back-to-indentation)))
-	(t
-	 (let ((mark (vi-get-mark mark-char)))
-	   (if (null mark)
-	       (message "Mark register undefined." (vi-ding))
-	     (set-mark-command nil)
-	     (goto-char mark)
-	     (if line-flag (back-to-indentation)))))))
-		     
-(defun vi-goto-line-mark (char)
-  "Go to the line (at first non-white) marked by next char."
-  (interactive "c")
-  (vi-goto-mark char t))
-
-(defun vi-goto-char-mark (char)
-  "Go to the char position marked by next mark-char."
-  (interactive "c")
-  (vi-goto-mark char))
-
-(defun vi-digit-argument (arg)
-  "Set numeric prefix argument."
-  (interactive "P")
-  (cond ((null arg) (digit-argument arg))
-	((integerp arg) (digit-argument nil)
-	                 (setq prefix-arg (* prefix-arg arg)))
-	(t (digit-argument nil)		; in (NIL . CHAR) or (NUM . CHAR) form
-	   (setq prefix-arg (cons (* prefix-arg
-				     (if (null (car arg)) 1 (car arg)))
-				  (cdr arg))))))
-
-(defun vi-raw-numeric-prefix (arg)
-  "Return the raw value of numeric part prefix argument."
-  (if (consp arg) (car arg) arg))
-
-(defun vi-prefix-numeric-value (arg)
-  "Return numeric meaning of the raw prefix argument.  This is a modification
-to the standard one provided in `callint.c' to handle (_ . CHAR) cases."
-  (cond ((null arg) 1)
-	((integerp arg) arg)
-	((consp arg) (if (car arg) (car arg) 1))))
-
-(defun vi-reverse-last-find-char (count &optional find-arg)
-  "Reverse last f F t T operation COUNT times.  If the optional FIND-ARG
-is given, it is used instead of the saved one."
-  (interactive "p")
-  (if (null find-arg) (setq find-arg vi-last-find-char))
-  (if (null find-arg)
-      (message "No last find char to repeat." (ding))
-    (vi-find-char (cons (* (car find-arg) -1) (cdr find-arg)) count))) ;6/13/86
-
-(defun vi-find-char (arg count)
-  "Find in DIRECTION (1/-1) for CHAR of COUNT'th times on current line.
-If UPTO-FLAG is T, stop before the char. ARG = (DIRECTION.CHAR.UPTO-FLAG."
-  (let* ((direction (car arg)) (char (car (cdr arg)))
-	 (upto-flag (cdr (cdr arg))) (pos (+ (point) direction)))
-    (if (catch 'exit-find-char
-	  (while t
-	    (cond ((null (char-after pos)) (throw 'exit-find-char nil))
-		  ((char-equal (char-after pos) ?\n) (throw 'exit-find-char nil))
-		  ((char-equal char (char-after pos)) (setq count (1- count))
-		   (if (= count 0)
-		       (throw 'exit-find-char
-			      (if upto-flag
-				  (setq pos (- pos direction))
-				pos)))))
-	    (setq pos (+ pos direction))))
-      (goto-char pos)
-    (ding))))
-
-(defun vi-repeat-last-find-char (count &optional find-arg)
-  "Repeat last f F t T operation COUNT times.  If optional FIND-ARG is given,
-it is used instead of the saved one."
-  (interactive "p")
-  (if (null find-arg) (setq find-arg vi-last-find-char))
-  (if (null find-arg)
-      (message "No last find char to repeat." (ding))
-    (vi-find-char find-arg count)))
-
-(defun vi-backward-find-char (count char)
-  "Find the COUNT'th CHAR backward on current line."
-  (interactive "p\nc")
-  (setq vi-last-find-char (cons -1 (cons char nil)))
-  (vi-repeat-last-find-char count))
-
-(defun vi-forward-find-char (count char)
-  "Find the COUNT'th CHAR forward on current line."
-  (interactive "p\nc")
-  (setq vi-last-find-char (cons 1 (cons char nil)))
-  (vi-repeat-last-find-char count))
-
-(defun vi-backward-upto-char (count char)
-  "Find upto the COUNT'th CHAR backward on current line."
-  (interactive "p\nc")
-  (setq vi-last-find-char (cons -1 (cons char t)))
-  (vi-repeat-last-find-char count))
-
-(defun vi-forward-upto-char (count char)
-  "Find upto the COUNT'th CHAR forward on current line."
-  (interactive "p\nc")
-  (setq vi-last-find-char (cons 1 (cons char t)))
-  (vi-repeat-last-find-char count))
-
-(defun vi-end-of-word (count)
-  "Move forward until encountering the end of a word.
-With argument, do this that many times."
-  (interactive "p")
-  (if (not (eobp)) (forward-char))
-  (if (re-search-forward "\\W*\\w+\\>" nil t count)
-      (backward-char)))
-
-(defun vi-replace-1-char (count char)
-  "Replace char after point by CHAR.  Repeat COUNT times."
-  (interactive "p\nc")
-  (delete-char count nil)       ; don't save in kill ring
-  (setq last-command-char char)
-  (self-insert-command count)
-  (vi-set-last-change-command 'vi-replace-1-char count char))
-
-(defun vi-replace-chars (arg)
-  "Replace chars over old ones."
-  (interactive "*p")
-  (overwrite-mode 1)
-  (vi-goto-insert-state arg))
-
-(defun vi-substitute-chars (count)
-  "Substitute COUNT chars by the input chars, enter insert state."
-  (interactive "*p")
-  (vi-goto-insert-state 1 (list (function (lambda (c) ; this is a bit tricky
-					    (delete-region (point)
-							   (+ (point) c))))
-				count) t))
-
-(defun vi-substitute-lines (count)
-  "Substitute COUNT lines by the input chars. (=cc in vi)"
-  (interactive "*p")
-  (vi-goto-insert-state 1 (list 'vi-delete-op 'next-line (1- count)) t))
-
-(defun vi-prefix-char-value (arg)
-  "Get the char part of the current prefix argument."
-  (cond ((null arg) nil)
-	((integerp arg) nil)
-	((consp arg) (cdr arg))
-	(t nil)))
-
-(defun vi-operator (arg)
-  "Handling vi operators (d/c/</>/!/=/y).  Current implementation requires
-the key bindings of the operators being fixed."
-  (interactive "P")
-  (catch 'vi-exit-op
-    (let ((this-op-char last-command-char))
-      (setq last-command-char (read-char))
-      (setq this-command (lookup-key vi-com-map (char-to-string last-command-char)))
-      (if (not (eq this-command 'vi-digit-argument))
-	  (setq prefix-arg arg)
-	(vi-digit-argument arg)
-	(setq last-command-char (read-char))
-	(setq this-command (lookup-key vi-com-map (char-to-string last-command-char))))
-      (cond ((char-equal this-op-char last-command-char) ; line op
-	     (vi-execute-op this-op-char 'next-line
-			    (cons (1- (vi-prefix-numeric-value prefix-arg))
-				  (vi-prefix-char-value prefix-arg))))
-	    ;; We assume any command that has no property 'point-moving-unit'
-	    ;; as having that property with the value 'CHAR'.  3/12/86
-	    (t   ;;  (get this-command 'point-moving-unit)
-	     (vi-execute-op this-op-char this-command prefix-arg))))))
-	    ;;   (t (throw 'vi-exit-op (ding)))))))
-
-(defun vi-execute-op (op-char motion-command arg)
-  "Execute vi edit operator as specified by OP-CHAR, the operand is the region
-determined by the MOTION-COMMAND with ARG."
-  (cond ((= op-char ?d)
-	 (if (vi-delete-op motion-command arg)
-	     (vi-set-last-change-command 'vi-delete-op (vi-repeat-command-of motion-command) arg)))
-	 ((= op-char ?c)
-	  (if (vi-delete-op motion-command arg)
-	      (vi-goto-insert-state 1 (list 'vi-delete-op
-			      (vi-repeat-command-of motion-command) arg) nil)))
-	 ((= op-char ?y)
-	  (if (vi-yank-op motion-command arg)
-	      (vi-set-last-change-command 'vi-yank-op (vi-repeat-command-of motion-command) arg)))
-	 ((= op-char ?!)
-	  (if (vi-shell-op motion-command arg)
-	      (vi-set-last-change-command 'vi-shell-op (vi-repeat-command-of motion-command) arg vi-last-shell-command)))
-	 ((= op-char ?<)
-	  (if (vi-shift-op motion-command arg (- vi-shift-width))
-	      (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg (- vi-shift-width))))
-	 ((= op-char ?>)
-	  (if (vi-shift-op motion-command arg vi-shift-width)
-	      (vi-set-last-change-command 'vi-shift-op (vi-repeat-command-of motion-command) arg vi-shift-width)))
-	 ((= op-char ?=)
-	  (if (vi-indent-op motion-command arg)
-	      (vi-set-last-change-command 'vi-indent-op (vi-repeat-command-of motion-command) arg)))
-	 ((= op-char ?\\)
-	  (vi-narrow-op motion-command arg))))
-
-(defun vi-repeat-command-of (command)
-  "Return the command for redo the given command."
-  (let ((cmd-type (get command 'point-moving-unit)))
-    (cond ((eq cmd-type 'search) 'vi-repeat-last-search)
-	  ((eq cmd-type 'find) 'vi-repeat-last-find-char)
-	  (t command))))
-
-(defun vi-effective-range (motion-command arg)
-  "Return (begin . end) of the range spanned by executing the given
-MOTION-COMMAND with ARG.
-   MOTION-COMMAND in ready-to-eval list form is not yet supported."
-  (save-excursion
-    (let ((begin (point)) end opoint
-	  (moving-unit (get motion-command 'point-moving-unit)))
-      (setq prefix-arg arg)
-      (setq opoint (point))
-      (command-execute motion-command nil)
-;; Check if there is any effective motion. Note that for single line operation
-;; the motion-command causes no effective point movement (since it moves up or
-;; down zero lines), but it should be counted as effectively moved.
-      (if (and (= (point) opoint) (not (eq moving-unit 'line)))
-	  (cons opoint opoint)		; no effective motion
-	(if (eq moving-unit 'region)
-	    (setq begin (or (mark) (point))))
-	(if (<= begin (point))
-	    (setq end (point))
-	  (setq end begin)
-	  (setq begin (point)))
-	(cond ((or (eq moving-unit 'match) (eq moving-unit 'find))
-	       (setq end (1+ end)))
-	      ((eq moving-unit 'line)
-	       (goto-char begin) (beginning-of-line) (setq begin (point))
-	       (goto-char end) (next-line 1) (beginning-of-line) (setq end (point))))
-	(if (> end (point-max)) (setq end (point-max))) ; force in buffer region 
-	(cons begin end)))))
-
-(defun vi-delete-op (motion-command arg)
-  "Delete range specified by MOTION-COMMAND with ARG."
-  (let* ((range (vi-effective-range motion-command arg))
-	 (begin (car range)) (end (cdr range)) reg)
-    (if (= begin end)
-	nil				; point not moved, abort op
-      (setq reg (vi-prefix-char-value arg))
-      (if (null reg)
-	  (kill-region begin end)	; kill ring as unnamed registers
-	(if (and (>= reg ?A) (<= reg ?Z))
-	    (append-to-register (downcase reg) begin end t)
-	  (copy-to-register reg begin end t)))
-      t)))
-
-(defun vi-yank-op (motion-command arg)
-  "Yank (in vi sense) range specified by MOTION-COMMAND with ARG."
-  (let* ((range (vi-effective-range motion-command arg))
-	 (begin (car range)) (end (cdr range)) reg)
-    (if (= begin end)
-	nil				; point not moved, abort op
-      (setq reg (vi-prefix-char-value arg))
-      (if (null reg)
-	  (copy-region-as-kill begin end); kill ring as unnamed registers
-	(if (and (>= reg ?A) (<= reg ?Z))
-	    (append-to-register (downcase reg) begin end nil)
-	  (copy-to-register reg begin end nil)))
-      t)))
-
-(defun vi-yank-line (arg)
-  "Yank (in vi sense) lines (= `yy' command)."
-  (interactive "*P")
-  (setq arg (cons (1- (vi-prefix-numeric-value arg)) (vi-prefix-char-value arg)))
-  (if (vi-yank-op 'next-line arg)
-      (vi-set-last-change-command 'vi-yank-op 'next-line arg)))
-
-(defun vi-string-end-with-nl-p (string)
-  "See if STRING ends with a newline char.
-Used in checking whether the yanked text should be put back as lines or not."
-  (= (aref string (1- (length string))) ?\n))
-
-(defun vi-put-before (arg &optional after-p)
-  "Put yanked (in vi sense) text back before/above cursor.  
-If a numeric prefix value (currently it should be >1) is given, put back
-text as lines.  If the optional after-p is given, put after/below the cursor."
-  (interactive "P")
-  (let ((reg (vi-prefix-char-value arg)) put-text)
-    (if (and reg (or (< reg ?1) (> reg ?9)) (null (get-register reg)))
-	(error "Nothing in register %c" reg)
-      (if (null reg) (setq reg ?1))	; the default is the last text killed
-      (setq put-text
-	    (cond
-	     ((and (>= reg ?1) (<= reg ?9))
-	      (setq this-command 'yank) ; So we may yank-pop !!
-	      (current-kill (- reg ?0 1) 'do-not-rotate))
-	     ((stringp (get-register reg)) (get-register reg))
-	     (t (error "Register %c is not containing text string" reg))))
-      (if (vi-string-end-with-nl-p put-text) ; put back text as lines
-	  (if after-p
-	      (progn (next-line 1) (beginning-of-line))
-	    (beginning-of-line))
-	(if after-p (forward-char 1)))
-      (push-mark (point))
-      (insert put-text)
-      (exchange-point-and-mark)
-;;    (back-to-indentation)      ; this is not allowed if we allow yank-pop
-      (vi-set-last-change-command 'vi-put-before arg after-p))))
-
-(defun vi-put-after (arg)
-  "Put yanked (in vi sense) text back after/below cursor."
-  (interactive "P")
-  (vi-put-before arg t))
-
-(defun vi-shell-op (motion-command arg &optional shell-command)
-  "Perform shell command (as filter).
-Performs command on range specified by MOTION-COMMAND
-with ARG. If SHELL-COMMAND is not given, ask for one from minibuffer.
-If char argument is given, it directs the output to a *temp* buffer."
-  (let* ((range (vi-effective-range motion-command arg))
-	 (begin (car range)) (end (cdr range)))
-    (if (= begin end)
-	nil				; point not moved, abort op
-      (cond ((null shell-command)
-	     (setq shell-command (read-string "!" nil))
-	     (setq vi-last-shell-command shell-command)))
-      (shell-command-on-region begin end shell-command (not (vi-prefix-char-value arg)))
-      t)))
-
-(defun vi-shift-op (motion-command arg amount)
-  "Perform shift command on range specified by MOTION-COMMAND with ARG for
-AMOUNT on each line.  Negative amount means shift left.
-SPECIAL FEATURE: char argument can be used to specify shift amount(1-9)."
-  (let* ((range (vi-effective-range motion-command arg))
-	 (begin (car range)) (end (cdr range)))
-    (if (= begin end)
-	nil				; point not moved, abort op
-      (if (vi-prefix-char-value arg)
-	  (setq amount (if (> amount 0)
-			   (- (vi-prefix-char-value arg) ?0)
-			 (- ?0 (vi-prefix-char-value arg)))))
-      (indent-rigidly begin end amount)
-      t)))
-
-(defun vi-indent-op (motion-command arg)
-  "Perform indent command on range specified by MOTION-COMMAND with ARG."
-  (let* ((range (vi-effective-range motion-command arg))
-	 (begin (car range)) (end (cdr range)))
-    (if (= begin end)
-	nil				; point not moved, abort op
-      (indent-region begin end nil)	; insert TAB as indent command
-      t)))
-
-(defun vi-narrow-op (motion-command arg)
-  "Narrow to region specified by MOTION-COMMAND with ARG."
-  (let* ((range (vi-effective-range motion-command arg))
-	 (begin (car range)) (end (cdr range)) reg)
-    (if (= begin end)
-	nil				; point not moved, abort op
-      (narrow-to-region begin end))))
-
-(defun vi-get-mark (char)
-  "Return contents of vi mark register named CHAR, or nil if undefined."
-  (cdr (assq char vi-mark-alist)))
-
-(defun vi-set-mark (char)
-  "Set contents of vi mark register named CHAR to current point.
-'@' is the special anonymous mark register."
-  (interactive "c")
-  (if (char-equal char ?@)
-      (set-mark-command nil)
-    (let ((aelt (assq char vi-mark-alist)))
-      (if aelt
-	  (move-marker (cdr aelt) (point)) ; fixed 6/12/86
-	(setq aelt (cons char (copy-marker (point))))
-	(setq vi-mark-alist (cons aelt vi-mark-alist))))))
-
-(defun vi-find-matching-paren ()
-  "Locate the matching paren.  It's a hack right now."
-  (interactive)
-  (cond ((looking-at "[[({]") (forward-sexp 1) (backward-char 1))
-	((looking-at "[])}]") (forward-char 1) (backward-sexp 1))
-        (t (ding))))
-
-(defun vi-backward-blank-delimited-word (count)
-  "Backward COUNT blank-delimited words."
-  (interactive "p")
-  (if (re-search-backward "[ \t\n\`][^ \t\n\`]+" nil t count)
-      (if (not (bobp)) (forward-char 1))))
-
-(defun vi-forward-blank-delimited-word (count)
-  "Forward COUNT blank-delimited words."
-  (interactive "p")
-  (if (re-search-forward "[^ \t\n]*[ \t\n]+[^ \t\n]" nil t count)
-      (if (not (eobp)) (backward-char 1))))
-
-(defun vi-end-of-blank-delimited-word (count)
-  "Forward to the end of the COUNT'th blank-delimited word."
-  (interactive "p")
-  (if (re-search-forward "[^ \t\n\']+[ \t\n\']" nil t count)
-      (if (not (eobp)) (backward-char 2))))
-
-(defun vi-home-window-line (arg)
-  "To window home or arg'th line from the top of the window."
-  (interactive "p")
-  (move-to-window-line (1- arg))
-  (back-to-indentation))
-
-(defun vi-last-window-line (arg)
-  "To window last line or arg'th line from the bottom of the window."
-  (interactive "p")
-  (move-to-window-line (- arg))
-  (back-to-indentation))
-
-(defun vi-middle-window-line ()
-  "To the middle line of the window."
-  (interactive)
-  (move-to-window-line nil)
-  (back-to-indentation))
-
-(defun vi-forward-word (count)
-  "Stop at the beginning of the COUNT'th words from point."
-  (interactive "p")
-  (if (re-search-forward "\\w*\\W+\\<" nil t count)
-      t
-    (vi-ding)))
-
-(defun vi-set-last-change-command (fun &rest args)
-  "Set (FUN . ARGS) as the `last-change-command'."
-  (setq vi-last-change-command (cons fun args)))
-
-(defun vi-redo-last-change-command (count &optional command)
-  "Redo last change command COUNT times.  If the optional COMMAND is given,
-it is used instead of the current `last-change-command'."
-  (interactive "p")
-  (if (null command)
-      (setq command vi-last-change-command))
-  (if (null command)
-      (message "No last change command available.")
-    (while (> count 0)
-      (apply (car command) (cdr command))
-      (setq count (1- count)))))
-
-(defun vi-kill-char (count)
-  "Kill COUNT chars from current point."
-  (interactive "*p")
-  (delete-char count t)			; save in kill ring
-  (vi-set-last-change-command 'delete-char count t))
-
-(defun vi-transpose-objects (arg unit)
-  "Transpose objects.
-The following char specifies unit of objects to be
-transposed -- \"c\" for chars, \"l\" for lines, \"w\" for words, \"s\" for
- sexp, \"p\" for paragraph.
-For the use of the prefix-arg, refer to individual functions called."
-  (interactive "*P\nc")
-  (if (char-equal unit ??)
-      (progn
-	(message "Transpose: c(har), l(ine), p(aragraph), s(-exp), w(ord),")
-	(setq unit (read-char))))
-  (vi-set-last-change-command 'vi-transpose-objects arg unit)
-  (cond ((char-equal unit ?c) (transpose-chars arg))
-	((char-equal unit ?l) (transpose-lines (vi-prefix-numeric-value arg)))
-	((char-equal unit ?p) (transpose-paragraphs (vi-prefix-numeric-value arg)))
-	((char-equal unit ?s) (transpose-sexps (vi-prefix-numeric-value arg)))
-	((char-equal unit ?w) (transpose-words (vi-prefix-numeric-value arg)))
-	(t (vi-transpose-objects arg ??))))
-
-(defun vi-query-replace (arg)
-  "Query replace, use regexp version if ARG is non-nil."
-  (interactive "*P")
-  (let ((rcmd (if arg 'query-replace-regexp 'query-replace)))
-    (call-interactively rcmd nil)))
-
-(defun vi-replace (arg)
-  "Replace strings, use regexp version if ARG is non-nil."
-  (interactive "*P")
-  (let ((rcmd (if arg 'replace-regexp 'replace-string)))
-    (call-interactively rcmd nil)))
-       
-(defun vi-adjust-window (arg position)
-  "Move current line to the top/center/bottom of the window."
-  (interactive "p\nc")
-  (cond ((char-equal position ?\r) (recenter 0))
-	((char-equal position ?-) (recenter -1))
-	((char-equal position ?.) (recenter (/ (window-height) 2)))
-	(t (message "Move current line to: \\r(top) -(bottom) .(middle)")
-	   (setq position (read-char))
-	   (vi-adjust-window arg position))))
-
-(defun vi-goto-column (col)
-  "Go to given column of the current line."
-  (interactive "p")
-  (let ((opoint (point)))
-    (beginning-of-line)
-    (while (> col 1)
-      (if (eolp)
-	  (setq col 0)
-	(forward-char 1)
-	(setq col (1- col))))
-    (if (= col 1)
-	t
-      (goto-char opoint)
-      (ding))))
-
-(defun vi-name-last-change-or-macro (arg char)
-  "Give name to the last change command or just defined kbd macro.  
-If prefix ARG is given, name last macro, otherwise name last change command.
-The following CHAR will be the name for the command or macro."
-  (interactive "P\nc")
-  (if arg
-      (name-last-kbd-macro (intern (char-to-string char)))
-    (if (eq (car vi-last-change-command) 'vi-first-redo-insertion)
-	(let* ((args (cdr vi-last-change-command)) ; save the insertion text
-	       (str (buffer-substring (nth 0 args) (nth 1 args)))
-	       (overwrite-p (nth 2 args))
-	       (prefix-code (nth 3 args)))
-	  (vi-set-last-change-command 'vi-more-redo-insertion str
-				   overwrite-p prefix-code)))
-    (fset (intern (char-to-string char)) vi-last-change-command)))
-  
-(defun vi-call-named-change-or-macro (count char)
-  "Execute COUNT times the keyboard macro definition named by the following CHAR."
-  (interactive "p\nc")
-  (if (stringp (symbol-function (intern (char-to-string char))))
-      (execute-kbd-macro (intern (char-to-string char)) count)
-    (vi-redo-last-change-command count (symbol-function (intern (char-to-string char))))))
-
-(defun vi-change-case (arg)		; could be made as an operator ?
-  "Change the case of the char after point."
-  (interactive "*p")
-  (catch 'exit
-    (if (looking-at "[a-z]")
-	(upcase-region (point) (+ (point) arg))
-      (if (looking-at "[A-Z]")
-	  (downcase-region (point) (+ (point) arg))
-	(ding)
-	(throw 'exit nil)))
-    (vi-set-last-change-command 'vi-change-case arg) ;should avoid redundant save
-    (forward-char arg)))
-
-(defun vi-ask-for-info (char)
-  "Inquire status info. The next CHAR will specify the particular info requested."
-  (interactive "c")
-  (cond ((char-equal char ?l) (what-line))
-	((char-equal char ?c) (what-cursor-position))
-	((char-equal char ?p) (what-page))
-	(t (message "Ask for: l(ine number), c(ursor position), p(age number)")
-	   (setq char (read-char))
-	   (vi-ask-for-info char))))
-
-(defun vi-mark-region (arg region)
-  "Mark region appropriately.  The next char REGION is d(efun),s(-exp),b(uffer),
-p(aragraph), P(age), f(unction in C/Pascal etc.), w(ord), e(nd of sentence),
-l(ines)."
-  (interactive "p\nc")
-  (cond ((char-equal region ?d) (mark-defun))
-	((char-equal region ?s) (mark-sexp arg))
-	((char-equal region ?b) (mark-whole-buffer))
-	((char-equal region ?p) (mark-paragraph))
-	((char-equal region ?P) (mark-page arg))
-	((char-equal region ?f) (mark-c-function))
-	((char-equal region ?w) (mark-word arg))
-	((char-equal region ?e) (mark-end-of-sentence arg))
-	((char-equal region ?l) (vi-mark-lines arg))
-	(t (message "Mark: d(efun),s(-exp),b(uf),p(arag),P(age),f(unct),w(ord),e(os),l(ines)")
-	   (setq region (read-char))
-	   (vi-mark-region arg region))))
-
-(defun vi-mark-lines (num)
-  "Mark NUM of lines from current line as current region."
-  (beginning-of-line 1)
-  (push-mark)
-  (end-of-line num))
-
-(defun vi-verify-spelling (arg unit)
-  "Verify spelling for the objects specified by char UNIT : [b(uffer),
-r(egion), s(tring), w(ord) ]."
-  (interactive "P\nc")
-  (setq prefix-arg arg)			; seems not needed
-  (cond ((char-equal unit ?b) (call-interactively 'spell-buffer))
-	((char-equal unit ?r) (call-interactively 'spell-region))
-	((char-equal unit ?s) (call-interactively 'spell-string))
-	((char-equal unit ?w) (call-interactively 'spell-word))
-	(t (message "Spell check: b(uffer), r(egion), s(tring), w(ord)")
-	   (setq unit (read-char))
-	   (vi-verify-spelling arg unit))))
-
-(defun vi-do-old-mode-C-c-command (arg)
-  "This is a hack for accessing mode specific C-c commands in vi-mode."
-  (interactive "P")
-  (let ((cmd (lookup-key vi-mode-old-local-map
-			 (concat "\C-c" (char-to-string (read-char))))))
-    (if (catch 'exit-vi-mode	; kludge hack due to dynamic binding
-				; of case-fold-search
-	  (if (null cmd)
-	      (progn (ding) nil)
-	    (let ((case-fold-search vi-mode-old-case-fold)) ; a hack
-	      (setq prefix-arg arg)
-	      (command-execute cmd nil)
-	      nil)))
-	(progn
-	  (vi-back-to-old-mode)
-	  (setq prefix-arg arg)
-	  (command-execute cmd nil)))))
-
-(defun vi-quote-words (arg char)
-  "Quote ARG words from the word point is on with pattern specified by CHAR.
-Currently, CHAR could be [,{,(,\",',`,<,*, etc."
-  (interactive "*p\nc")
-  (while (not (string-match "[[({<\"'`*]" (char-to-string char)))
-    (message "Enter any of [,{,(,<,\",',`,* as quoting character.")
-    (setq char (read-char)))
-  (vi-set-last-change-command 'vi-quote-words arg char)
-  (if (not (looking-at "\\<")) (forward-word -1))
-  (insert char)
-  (cond ((char-equal char ?[) (setq char ?]))
-	((char-equal char ?{) (setq char ?}))
-	((char-equal char ?<) (setq char ?>))
-	((char-equal char ?() (setq char ?)))
-	((char-equal char ?`) (setq char ?')))
-  (vi-end-of-word arg)
-  (forward-char 1)
-  (insert char))
-
-(defun vi-locate-def ()
-  "Locate definition in current file for the name before the point.
-It assumes a `(def..' always starts at the beginning of a line."
-  (interactive)
-  (let (name)
-    (save-excursion
-      (setq name (buffer-substring (progn (vi-backward-blank-delimited-word 1)
-					  (skip-chars-forward "^a-zA-Z")
-					  (point))
-				   (progn (vi-end-of-blank-delimited-word 1)
-					  (forward-char)
-					  (skip-chars-backward "^a-zA-Z")
-					  (point)))))
-    (set-mark-command nil)
-    (goto-char (point-min))
-    (if (re-search-forward (concat "^(def[unvarconst ]*" name) nil t)
-	nil
-      (message "No definition for \"%s\" in current file." name (ding))
-      (set-mark-command t))))
-
-(defun vi-split-open-line (arg)
-  "Insert a newline and leave point before it.
-With ARG, inserts that many newlines."
-  (interactive "*p")
-  (vi-goto-insert-state 1
-    (list (function (lambda (arg)
-		      (let ((flag (and (bolp) (not (bobp)))))
-			(if flag (forward-char -1))
-			(while (> arg 0)
-			  (save-excursion
-			    (insert ?\n)
-			    (if fill-prefix (insert fill-prefix)))
-			  (setq arg (1- arg)))
-			(if flag (forward-char 1))))) arg)
-    t))
-
-;;; vi.el ends here
diff --git a/lisp/emulation/vip.el b/lisp/emulation/vip.el
deleted file mode 100644
index a8739f2350b..00000000000
--- a/lisp/emulation/vip.el
+++ /dev/null
@@ -1,3045 +0,0 @@
-;;; vip.el --- a VI Package for GNU Emacs
-
-;; Author: Masahiko Sato <ms@sail.stanford.edu>
-;; Version: 3.5
-;; Keywords: emulations
-
-;; 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:
-
-;; A full-featured vi(1) emulator.
-;;
-;; In Japan, the author's address is: masahiko@sato.riec.tohoku.junet
-;;
-;; Send suggestions and bug reports to one of the above addresses.
-;; When you report a bug, be sure to include the version number of VIP and
-;; Emacs you are using.
-
-;; Execute info command by typing "M-x info" to get information on VIP.
-
-;;; Code:
-
-;; external variables
-
-(defvar vip-emacs-local-map nil
-  "Local map used in emacs mode.  (Buffer-specific.)")
-
-(defvar vip-insert-local-map nil
-  "Local map used in insert command mode.  (Buffer-specific.)")
-  
-(make-variable-buffer-local 'vip-emacs-local-map)
-(make-variable-buffer-local 'vip-insert-local-map)
-
-(defvar vip-insert-point nil
-  "Remember insert point as a marker.  (Buffer-specific.)")
-
-(set-default 'vip-insert-point (make-marker))
-(make-variable-buffer-local 'vip-insert-point)
-
-(defvar vip-com-point nil
-  "Remember com point as a marker.  (Buffer-specific.)")
-
-(set-default 'vip-com-point (make-marker))
-(make-variable-buffer-local 'vip-com-point)
-
-(defvar vip-current-mode nil
-  "Current mode.  One of `emacs-mode', `vi-mode', `insert-mode'.")
-
-(make-variable-buffer-local 'vip-current-mode)
-(setq-default vip-current-mode 'emacs-mode)
-
-(defvar vip-emacs-mode-line-buffer-identification nil
-  "Value of mode-line-buffer-identification in Emacs mode within vip.")
-(make-variable-buffer-local 'vip-emacs-mode-line-buffer-identification)
-(setq-default vip-emacs-mode-line-buffer-identification
-	      '("Emacs: %17b"))
-
-(defvar vip-current-major-mode nil
-  "vip-current-major-mode is the major-mode vi considers it is now.
-\(buffer specific\)")
-
-(make-variable-buffer-local 'vip-current-major-mode)
-
-(defvar vip-last-shell-com nil
-  "Last shell command executed by ! command.")
-
-(defvar vip-use-register nil
-  "Name of register to store deleted or yanked strings.")
-
-(defvar vip-d-com nil
-  "How to reexecute last destructive command.  Value is list (M-COM VAL COM).")
-
-(defconst vip-shift-width 8
-  "*The number of columns shifted by > and < command.")
-
-(defconst vip-re-replace nil
-  "*If t then do regexp replace, if nil then do string replace.")
-
-(defvar vip-d-char nil
-  "The character remembered by the vi \"r\" command.")
-
-(defvar vip-f-char nil
-  "For use by \";\" command.")
-
-(defvar vip-F-char nil
-  "For use by \".\" command.")
-
-(defvar vip-f-forward nil
-  "For use by \";\" command.")
-  
-(defvar vip-f-offset nil
-  "For use by \";\" command.")
-
-(defconst vip-search-wrap-around t
-  "*if t, search wraps around.")
-
-(defconst vip-re-search nil
-  "*if t, search is reg-exp search, otherwise vanilla search.")
-
-(defvar vip-s-string nil
-  "Last vip search string.")
-
-(defvar vip-s-forward nil
-  "If t, search is forward.")
-
-(defconst vip-case-fold-search nil
-  "*If t, search ignores cases.")
-
-(defconst vip-re-query-replace nil
-  "*If t then do regexp replace, if nil then do string replace.")
-
-(defconst vip-open-with-indent nil
-  "*If t, indent when open a new line.")
-
-(defconst vip-help-in-insert-mode nil
-  "*If t then C-h is bound to help-command in insert mode.
-If nil then it is bound to `delete-backward-char'.")
-
-(defvar vip-quote-string "> "
-  "String inserted at the beginning of region.")
-
-(defvar vip-tags-file-name "TAGS")
-
-(defvar vip-inhibit-startup-message nil)
-
-(defvar vip-startup-file (convert-standard-filename "~/.vip")
-  "Filename used as startup file for vip.")
-
-;; basic set up
-
-(global-set-key "\C-z" 'vip-change-mode-to-vi)
-
-(defmacro vip-loop (count body)
-  "(COUNT BODY) Execute BODY COUNT times."
-  (list 'let (list (list 'count count))
-	(list 'while (list '> 'count 0)
-	      body
-	      (list 'setq 'count (list '1- 'count)))))
-
-(defun vip-push-mark-silent (&optional location)
-  "Set mark at LOCATION (point, by default) and push old mark on mark ring.
-No message."
-  (if (null (mark t))
-      nil
-    (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
-    (if (> (length mark-ring) mark-ring-max)
-	(progn
-	  (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
-	  (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
-  (set-mark (or location (point))))
-
-(defun vip-goto-col (arg)
-  "Go to ARG's column."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (save-excursion
-      (end-of-line)
-      (if (> val (1+ (current-column))) (error "")))
-    (if com (move-marker vip-com-point (point)))
-    (beginning-of-line)
-    (forward-char (1- val))
-    (if com (vip-execute-com 'vip-goto-col val com))))
-
-(defun vip-copy-keymap (map)
-  (if (null map) (make-sparse-keymap) (copy-keymap map)))
-
-
-;; changing mode
-
-(defun vip-change-mode (new-mode)
-  "Change mode to NEW-MODE---either emacs-mode, vi-mode, or insert-mode."
-  (or (eq new-mode vip-current-mode)
-      (progn
-	(cond ((eq new-mode 'vi-mode)
-	       (if (eq vip-current-mode 'insert-mode)
-		   (progn
-		     (vip-copy-region-as-kill (point) vip-insert-point)
-		     (vip-repeat-insert-command))
-		 (setq vip-emacs-local-map (current-local-map)
-		       vip-emacs-mode-line-buffer-identification
-		       mode-line-buffer-identification
-		       vip-insert-local-map (vip-copy-keymap
-					     (current-local-map))))
-	       (vip-change-mode-line "Vi:   ")
-	       (use-local-map vip-mode-map))
-	      ((eq new-mode 'insert-mode)
-	       (move-marker vip-insert-point (point))
-	       (if (eq vip-current-mode 'emacs-mode)
-		   (setq vip-emacs-local-map (current-local-map)
-			 vip-emacs-mode-line-buffer-identification
-			 mode-line-buffer-identification
-			 vip-insert-local-map (vip-copy-keymap
-					       (current-local-map)))
-		 (setq vip-insert-local-map (vip-copy-keymap
-					     vip-emacs-local-map)))
-	       (vip-change-mode-line "Insert")
-	       (use-local-map vip-insert-local-map)
-	       (define-key vip-insert-local-map "\e" 'vip-change-mode-to-vi)
-	       (define-key vip-insert-local-map "\C-z" 'vip-ESC)
-	       (define-key vip-insert-local-map "\C-h"
-		 (if vip-help-in-insert-mode 'help-command
-		   'delete-backward-char))
-	       (define-key vip-insert-local-map "\C-w"
-		 'vip-delete-backward-word))
-	      ((eq new-mode 'emacs-mode) 
-	       (vip-change-mode-line "Emacs:")
-	       (use-local-map vip-emacs-local-map)))
-	(setq vip-current-mode new-mode)
-	(force-mode-line-update))))
-
-(defun vip-copy-region-as-kill (beg end)
-  "If BEG and END do not belong to the same buffer, it copies empty region."
-  (condition-case nil
-      (copy-region-as-kill beg end)
-    (error (copy-region-as-kill beg beg))))
-
-(defun vip-change-mode-line (string)
-  "Assuming that the mode line format contains the string \"Emacs:\", this
-function replaces the string by \"Vi:   \" etc."
-  (setq mode-line-buffer-identification
-	(if (string= string "Emacs:")
-	    vip-emacs-mode-line-buffer-identification
-	  (list (concat string " %17b")))))
-
-;;;###autoload
-(defun vip-mode ()
-  "Turn on VIP emulation of VI."
-  (interactive)
-  (if (not vip-inhibit-startup-message)
-      (progn
-	(switch-to-buffer "VIP Startup Message")
-	(erase-buffer)
-	(insert
-	 "VIP is a Vi emulation package for GNU Emacs.  VIP provides most Vi commands
-including Ex commands.  VIP is however different from Vi in several points.
-You can get more information on VIP by:
-    1.  Typing `M-x info' and selecting menu item \"vip\".
-    2.  Typing `C-h k' followed by a key whose description you want.
-    3.  Printing VIP manual which can be found as GNU/man/vip.texinfo
-    4.  Printing VIP Reference Card which can be found as GNU/etc/vipcard.tex
-
-This startup message appears whenever you load VIP unless you type `y' now.
-Type `n' to quit this window for now.\n")
-	(goto-char (point-min))
-	(if (y-or-n-p "Inhibit VIP startup message? ")
-	    (progn
-	      (save-excursion
-		(set-buffer
-		 (find-file-noselect
-		  (substitute-in-file-name vip-startup-file)))
-		(goto-char (point-max))
-		(insert "\n(setq vip-inhibit-startup-message t)\n")
-		(save-buffer)
-		(kill-buffer (current-buffer)))
-	      (message "VIP startup message inhibited.")
-	      (sit-for 2)))
-	(kill-buffer (current-buffer))
-	(message "")
-	(setq vip-inhibit-startup-message t)))
-  (vip-change-mode-to-vi))
-
-(defun vip-change-mode-to-vi ()
-  "Change mode to vi mode."
-  (interactive)
-  (vip-change-mode 'vi-mode))
-
-(defun vip-change-mode-to-insert ()
-  "Change mode to insert mode."
-  (interactive)
-  (vip-change-mode 'insert-mode))
-
-(defun vip-change-mode-to-emacs ()
-  "Change mode to emacs mode."
-  (interactive)
-  (vip-change-mode 'emacs-mode))
-
-
-;; escape to emacs mode temporarily
-
-(defun vip-escape-to-emacs (arg &optional events)
-  "Escape to Emacs mode for one Emacs command.
-ARG is used as the prefix value for the executed command.  If
-EVENTS is a list of events, which become the beginning of the command."
-  (interactive "P")
-  (let (com key (old-map (current-local-map)))
-    (if events (setq unread-command-events events))
-    (setq prefix-arg arg)
-    (use-local-map vip-emacs-local-map)
-    (unwind-protect
-	(setq com (key-binding (setq key (read-key-sequence nil))))
-      (use-local-map old-map))
-    (command-execute com prefix-arg)
-    (setq prefix-arg nil)  ;; reset prefix arg
-    ))
-
-(defun vip-message-conditions (conditions)
-  "Print CONDITIONS as a message."
-  (let ((case (car conditions)) (msg (cdr conditions)))
-    (if (null msg)
-	(message "%s" case)
-      (message "%s %s" case (prin1-to-string msg)))
-    (ding)))
-
-(defun vip-ESC (arg)
-  "Emulate ESC key in Emacs mode."
-  (interactive "P")
-  (vip-escape-to-emacs arg '(?\e)))
-
-(defun vip-ctl-c (arg)
-  "Emulate C-c key in Emacs mode."
-  (interactive "P")
-  (vip-escape-to-emacs arg '(?\C-c)))
-
-(defun vip-ctl-x (arg)
-  "Emulate C-x key in Emacs mode."
-  (interactive "P")
-  (vip-escape-to-emacs arg '(?\C-x)))
-
-(defun vip-ctl-h (arg)
-  "Emulate C-h key in Emacs mode."
-  (interactive "P")
-  (vip-escape-to-emacs arg '(?\C-h)))
-
-
-;; prefix argument for vi mode
-
-;; In vi mode, prefix argument is a dotted pair (NUM . COM) where NUM
-;; represents the numeric value of the prefix argument and COM represents
-;; command prefix such as "c", "d", "m" and "y".
-
-(defun vip-prefix-arg-value (char value com)
-  "Compute numeric prefix arg value.  Invoked by CHAR.  VALUE is the value
-obtained so far, and COM is the command part obtained so far."
-  (while (and (>= char ?0) (<= char ?9))
-    (setq value (+ (* (if (numberp value) value 0) 10) (- char ?0)))	    
-    (setq char (read-char)))
-  (setq prefix-arg value)
-  (if com (setq prefix-arg (cons prefix-arg com)))
-  (while (= char ?U)
-    (vip-describe-arg prefix-arg)
-    (setq char (read-char)))
-  (setq unread-command-events (list char)))
-
-(defun vip-prefix-arg-com (char value com)
-  "Vi operator as prefix argument."
-  (let ((cont t))
-    (while (and cont
-		(or (= char ?c) (= char ?d) (= char ?y)
-		    (= char ?!) (= char ?<) (= char ?>) (= char ?=)
-		    (= char ?#) (= char ?r) (= char ?R) (= char ?\")))
-      (if com
-	  ;; this means that we already have a command character, so we
-	  ;; construct a com list and exit while.  however, if char is "
-	  ;; it is an error.
-	  (progn
-	    ;; new com is (CHAR . OLDCOM)
-	    (if (or (= char ?#) (= char ?\")) (error ""))
-	    (setq com (cons char com))
-	    (setq cont nil))
-	;; if com is nil we set com as char, and read more.  again, if char
-	;; is ", we read the name of register and store it in vip-use-register.
-	;; if char is !, =, or #, a complete com is formed so we exit while.
-	(cond ((or (= char ?!) (= char ?=))
-	       (setq com char)
-	       (setq char (read-char))
-	       (setq cont nil))
-	      ((= char ?#)
-	       ;; read a char and encode it as com
-	       (setq com (+ 128 (read-char)))
-	       (setq char (read-char))
-	       (setq cont nil))
-	      ((or (= char ?<) (= char ?>))
-	       (setq com char)
-	       (setq char (read-char))
-	       (if (= com char) (setq com (cons char com)))
-	       (setq cont nil))
-	      ((= char ?\")
-	       (let ((reg (read-char)))
-		 (if (or (and (<= ?A reg) (<= reg ?z))
-			 (and (<= ?1 reg) (<= reg ?9)))
-		     (setq vip-use-register reg)
-		   (error ""))
-		 (setq char (read-char))))
-	      (t
-	       (setq com char)
-	       (setq char (read-char)))))))
-  (if (atom com)
-      ;; com is a single char, so we construct prefix-arg 
-      ;; and if char is ?, describe prefix arg, otherwise exit by
-      ;; pushing the char back
-      (progn
-	(setq prefix-arg (cons value com))
-	(while (= char ?U)
-	  (vip-describe-arg prefix-arg)
-	  (setq char (read-char)))
-	(setq unread-command-events (list char)))
-    ;; as com is non-nil, this means that we have a command to execute
-    (if (or (= (car com) ?r) (= (car com) ?R))
-	;; execute appropriate region command.
-	(let ((char (car com)) (com (cdr com)))
-	  (setq prefix-arg (cons value com))
-	  (if (= char ?r) (vip-region prefix-arg)
-	    (vip-Region prefix-arg))
-	  ;; reset prefix-arg
-	  (setq prefix-arg nil))
-      ;; otherwise, reset prefix arg and call appropriate command
-      (setq value (if (null value) 1 value))
-      (setq prefix-arg nil)
-      (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C)))
-	    ((equal com '(?d . ?d)) (vip-line (cons value ?D)))
-	    ((equal com '(?d . ?y)) (vip-yank-defun))
-	    ((equal com '(?y . ?y)) (vip-line (cons value ?Y)))
-	    ((equal com '(?< . ?<)) (vip-line (cons value ?<)))
-	    ((equal com '(?> . ?>)) (vip-line (cons value ?>)))
-	    ((equal com '(?! . ?!)) (vip-line (cons value ?!)))
-	    ((equal com '(?= . ?=)) (vip-line (cons value ?=)))
-	    (t (error ""))))))
-
-(defun vip-describe-arg (arg)
-  (let (val com)
-    (setq val (vip-P-val arg)
-	  com (vip-getcom arg))
-    (if (null val)
-	(if (null com)
-	    (message "Value is nil, and command is nil.")
-	  (message "Value is nil, and command is %c." com))
-      (if (null com)
-	  (message "Value is %d, and command is nil." val)
-	(message "Value is %d, and command is %c." val com)))))
-
-(defun vip-digit-argument (arg)
-  "Begin numeric argument for the next command."
-  (interactive "P")
-  (vip-prefix-arg-value last-command-char nil
-			(if (consp arg) (cdr arg) nil)))
-
-(defun vip-command-argument (arg)
-  "Accept a motion command as an argument."
-  (interactive "P")
-  (condition-case conditions
-      (vip-prefix-arg-com
-       last-command-char   
-       (cond ((null arg) nil)
-	     ((consp arg) (car arg))
-	     ((numberp arg) arg)
-	     (t (error "strange arg")))
-       (cond ((null arg) nil)
-	     ((consp arg) (cdr arg))
-	     ((numberp arg) nil)
-	     (t (error "strange arg"))))
-    (quit
-     (setq vip-use-register nil)
-     (signal 'quit nil))))
-
-(defun vip-p-val (arg)
-  "Get value part of prefix-argument ARG."
-  (cond ((null arg) 1)
-	((consp arg) (if (null (car arg)) 1 (car arg)))
-	(t arg)))
-
-(defun vip-P-val (arg)
-  "Get value part of prefix-argument ARG."
-  (cond ((consp arg) (car arg))
-	(t arg)))
-
-(defun vip-getcom (arg)
-  "Get com part of prefix-argument ARG."
-  (cond ((null arg) nil)
-	((consp arg) (cdr arg))
-	(t nil)))
-
-(defun vip-getCom (arg)
-  "Get com part of prefix-argument ARG and modify it."
-  (let ((com (vip-getcom arg)))
-    (cond ((equal com ?c) ?C)
-	  ((equal com ?d) ?D)
-	  ((equal com ?y) ?Y)
-	  (t com))))
-
-
-;; repeat last destructive command
-
-(defun vip-append-to-register (reg start end)
-  "Append region to text in register REG.
-START and END are buffer positions indicating what to append."
-  (set-register reg (concat (or (get-register reg) "")
-			    (buffer-substring start end))))
-
-(defun vip-execute-com (m-com val com)
-  "(M-COM VAL COM)  Execute command COM. The list (M-COM VAL COM) is set
-to vip-d-com for later use by vip-repeat"
-  (let ((reg vip-use-register))
-    (if com
-	(cond ((= com ?c) (vip-change vip-com-point (point)))
-	      ((= com (- ?c)) (vip-change-subr vip-com-point (point)))
-	      ((or (= com ?C) (= com (- ?C)))
-	       (save-excursion
-		 (set-mark vip-com-point)
-		 (vip-enlarge-region (mark) (point))
-		 (if vip-use-register
-		     (progn
-		       (cond ((and (<= ?a vip-use-register)
-				   (<= vip-use-register ?z))
-			      (copy-to-register
-			       vip-use-register (mark) (point) nil))
-			     ((and (<= ?A vip-use-register)
-				   (<= vip-use-register ?Z))
-			      (vip-append-to-register
-			       (+ vip-use-register 32) (mark) (point)))
-			     (t (setq vip-use-register nil)
-				(error "")))
-		       (setq vip-use-register nil)))
-		 (delete-region (mark) (point)))
-	       (open-line 1)
-	       (if (= com ?C) (vip-change-mode-to-insert) (yank)))
-	      ((= com ?d)
-	       (if vip-use-register
-		   (progn
-		     (cond ((and (<= ?a vip-use-register)
-				 (<= vip-use-register ?z))
-			    (copy-to-register
-			     vip-use-register vip-com-point (point) nil))
-			   ((and (<= ?A vip-use-register)
-				 (<= vip-use-register ?Z))
-			    (vip-append-to-register
-			     (+ vip-use-register 32) vip-com-point (point)))
-			   (t (setq vip-use-register nil)
-			      (error "")))
-		     (setq vip-use-register nil)))
-	       (setq last-command
-		     (if (eq last-command 'd-command) 'kill-region nil))
-	       (kill-region vip-com-point (point))
-	       (setq this-command 'd-command))
-	      ((= com ?D)
-	       (save-excursion
-		 (set-mark vip-com-point)
-		 (vip-enlarge-region (mark) (point))
-		 (if vip-use-register
-		     (progn
-		       (cond ((and (<= ?a vip-use-register)
-				   (<= vip-use-register ?z))
-			      (copy-to-register
-			       vip-use-register (mark) (point) nil))
-			     ((and (<= ?A vip-use-register)
-				   (<= vip-use-register ?Z))
-			      (vip-append-to-register
-			       (+ vip-use-register 32) (mark) (point)))
-			     (t (setq vip-use-register nil)
-				(error "")))
-		       (setq vip-use-register nil)))
-		 (setq last-command
-		       (if (eq last-command 'D-command) 'kill-region nil))
-		 (kill-region (mark) (point))
-		 (if (eq m-com 'vip-line) (setq this-command 'D-command)))
-	       (back-to-indentation))
-	      ((= com ?y)
-	       (if vip-use-register
-		   (progn
-		     (cond ((and (<= ?a vip-use-register)
-				 (<= vip-use-register ?z))
-			    (copy-to-register
-			     vip-use-register vip-com-point (point) nil))
-			   ((and (<= ?A vip-use-register)
-				 (<= vip-use-register ?Z))
-			    (vip-append-to-register
-			     (+ vip-use-register 32) vip-com-point (point)))
-			   (t (setq vip-use-register nil)
-			      (error "")))
-		     (setq vip-use-register nil)))
-	       (setq last-command nil)
-	       (copy-region-as-kill vip-com-point (point))
-	       (goto-char vip-com-point))
-	      ((= com ?Y)
-	       (save-excursion
-		 (set-mark vip-com-point)
-		 (vip-enlarge-region (mark) (point))
-		 (if vip-use-register
-		     (progn
-		       (cond ((and (<= ?a vip-use-register)
-				   (<= vip-use-register ?z))
-			      (copy-to-register
-			       vip-use-register (mark) (point) nil))
-			     ((and (<= ?A vip-use-register)
-				   (<= vip-use-register ?Z))
-			      (vip-append-to-register
-			       (+ vip-use-register 32) (mark) (point)))
-			     (t (setq vip-use-register nil)
-				(error "")))
-		       (setq vip-use-register nil)))
-		 (setq last-command nil)
-		 (copy-region-as-kill (mark) (point)))
-	       (goto-char vip-com-point))
-	      ((or (= com ?!) (= com (- ?!)))
-	       (save-excursion
-		 (set-mark vip-com-point)
-		 (vip-enlarge-region (mark) (point))
-		 (shell-command-on-region
-		  (mark) (point)
-		  (if (= com ?!)
-		      (setq vip-last-shell-com (vip-read-string "!"))
-		    vip-last-shell-com)
-		  t)))
-	      ((= com ?=)
-	       (save-excursion
-		 (set-mark vip-com-point)
-		 (vip-enlarge-region (mark) (point))
-		 (if (> (mark) (point)) (exchange-point-and-mark))
-		 (indent-region (mark) (point) nil)))
-	      ((= com ?<)
-	       (save-excursion
-		 (set-mark vip-com-point)
-		 (vip-enlarge-region (mark) (point))
-		 (indent-rigidly (mark) (point) (- vip-shift-width)))
-	       (goto-char vip-com-point))
-	      ((= com ?>)
-	       (save-excursion
-		 (set-mark vip-com-point)
-		 (vip-enlarge-region (mark) (point))
-		 (indent-rigidly (mark) (point) vip-shift-width))
-	       (goto-char vip-com-point))
-	      ((>= com 128)
-	       ;; this is special command #
-	       (vip-special-prefix-com (- com 128)))))
-    (setq vip-d-com (list m-com val (if (or (= com ?c) (= com ?C) (= com ?!))
-					(- com) com)
-			  reg))))
-
-(defun vip-repeat (arg)
-  "(ARG)  Re-execute last destructive command.  vip-d-com has the form
-\(COM ARG CH REG), where COM is the command to be re-executed, ARG is the
-argument for COM, CH is a flag for repeat, and REG is optional and if exists
-is the name of the register for COM."
-  (interactive "P")
-  (if (eq last-command 'vip-undo)
-      ;; if the last command was vip-undo, then undo-more
-      (vip-undo-more)
-    ;; otherwise execute the command stored in vip-d-com.  if arg is non-nil
-    ;; its prefix value is used as new prefix value for the command.
-    (let ((m-com (car vip-d-com))
-	  (val (vip-P-val arg))
-	  (com (car (cdr (cdr vip-d-com))))
-	  (reg (nth 3 vip-d-com)))
-      (if (null val) (setq val (car (cdr vip-d-com))))
-      (if (null m-com) (error "No previous command to repeat."))
-      (setq vip-use-register reg)
-      (funcall m-com (cons val com)))))
-
-(defun vip-special-prefix-com (char)
-  "This command is invoked interactively by the key sequence #<char>"
-  (cond ((= char ?c)
-	 (downcase-region (min vip-com-point (point))
-			  (max vip-com-point (point))))
-	((= char ?C)
-	 (upcase-region (min vip-com-point (point))
-			(max vip-com-point (point))))
-	((= char ?g)
-	 (set-mark vip-com-point)
-	 (vip-global-execute))
-	((= char ?q)
-	 (set-mark vip-com-point)
-	 (vip-quote-region))
-	((= char ?s) (spell-region vip-com-point (point)))))
-
-
-;; undoing
-
-(defun vip-undo ()
-  "Undo previous change."
-  (interactive)
-  (message "undo!")
-  (undo-start)
-  (undo-more 2)
-  (setq this-command 'vip-undo))
-
-(defun vip-undo-more ()
-  "Continue undoing previous changes."
-  (message "undo more!")
-  (undo-more 1)
-  (setq this-command 'vip-undo))
-
-
-;; utilities
-
-(defun vip-string-tail (str)
-  (if (or (null str) (string= str "")) nil
-    (substring str 1)))
-
-(defun vip-yank-defun ()
-  (mark-defun)
-  (copy-region-as-kill (point) (mark)))
-
-(defun vip-enlarge-region (beg end)
-  "Enlarge region between BEG and END."
-  (if (< beg end)
-      (progn (goto-char beg) (set-mark end))
-    (goto-char end)
-    (set-mark beg))
-  (beginning-of-line)
-  (exchange-point-and-mark)
-  (if (or (not (eobp)) (not (bolp))) (next-line 1))
-  (beginning-of-line)
-  (if (> beg end) (exchange-point-and-mark)))
-
-(defun vip-global-execute ()
-  "Call last keyboad macro for each line in the region."
-  (if (> (point) (mark)) (exchange-point-and-mark))
-  (beginning-of-line)
-  (call-last-kbd-macro)
-  (while (< (point) (mark))
-    (forward-line 1)
-    (beginning-of-line)
-    (call-last-kbd-macro)))
-
-(defun vip-quote-region ()
-  "Quote region by inserting the user supplied string at the beginning of
-each line in the region."
-  (setq vip-quote-string
-	(let ((str
-	       (vip-read-string (format "quote string \(default \"%s\"\): "
-					vip-quote-string))))
-	  (if (string= str "") vip-quote-string str)))
-  (vip-enlarge-region (point) (mark))
-  (if (> (point) (mark)) (exchange-point-and-mark))
-  (insert vip-quote-string)
-  (beginning-of-line)
-  (forward-line 1)
-  (while (and (< (point) (mark)) (bolp))
-    (insert vip-quote-string)
-    (beginning-of-line)
-    (forward-line 1)))
-
-(defun vip-end-with-a-newline-p (string)
-  "Check if the string ends with a newline."
-  (or (string= text "")
-      (= (aref string (1- (length string))) ?\n)))
-
-(defun vip-read-string (prompt &optional init)
-  (setq save-minibuffer-local-map (copy-keymap minibuffer-local-map))
-  (define-key minibuffer-local-map "\C-h" 'backward-char)
-  (define-key minibuffer-local-map "\C-w" 'backward-word)
-  (define-key minibuffer-local-map "\e" 'exit-minibuffer)
-  (let (str)
-    (condition-case conditions
-	(setq str (read-string prompt init))
-      (quit
-       (setq minibuffer-local-map save-minibuffer-local-map)
-       (signal 'quit nil)))
-    (setq minibuffer-local-map save-minibuffer-local-map)
-    str))
-
-
-;; insertion commands
-
-(defun vip-repeat-insert-command ()
-  "This function is called when mode changes from insertion mode to
-vi command mode.  It will repeat the insertion command if original insertion
-command was invoked with argument > 1."
-  (let ((i-com (car vip-d-com)) (val (car (cdr vip-d-com))))
-    (if (and val (> val 1)) ;; first check that val is non-nil
-	(progn        
-	  (setq vip-d-com (list i-com (1- val) ?r))
-	  (vip-repeat nil)
-	  (setq vip-d-com (list i-com val ?r))))))
-
-(defun vip-insert (arg) ""
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (setq vip-d-com (list 'vip-insert val ?r))
-    (if com (vip-loop val (yank))
-      (vip-change-mode-to-insert))))
-
-(defun vip-append (arg)
-  "Append after point."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (setq vip-d-com (list 'vip-append val ?r))
-    (if (not (eolp)) (forward-char))
-    (if (equal com ?r)
-	(vip-loop val (yank))
-      (vip-change-mode-to-insert))))
-
-(defun vip-Append (arg)
-  "Append at end of line."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (setq vip-d-com (list 'vip-Append val ?r))
-    (end-of-line)
-    (if (equal com ?r)
-	(vip-loop val (yank))
-      (vip-change-mode-to-insert))))
-
-(defun vip-Insert (arg)
-  "Insert before first non-white."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (setq vip-d-com (list 'vip-Insert val ?r))
-    (back-to-indentation)
-    (if (equal com ?r)
-	(vip-loop val (yank))
-      (vip-change-mode-to-insert))))
-
-(defun vip-open-line (arg)
-  "Open line below."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (setq vip-d-com (list 'vip-open-line val ?r))
-    (let ((col (current-indentation)))
-      (if (equal com ?r)
-	  (vip-loop val
-		(progn
-		  (end-of-line)
-		  (newline 1)
-		  (if vip-open-with-indent (indent-to col))
-		  (yank)))
-	(end-of-line)
-	(newline 1)
-	(if vip-open-with-indent (indent-to col))
-	(vip-change-mode-to-insert)))))
-
-(defun vip-Open-line (arg)
-  "Open line above."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-  (setq vip-d-com (list 'vip-Open-line val ?r))
-  (let ((col (current-indentation)))
-    (if (equal com ?r)
-	(vip-loop val
-	      (progn
-		(beginning-of-line)
-		(open-line 1)
-		(if vip-open-with-indent (indent-to col))
-		(yank)))
-      (beginning-of-line)
-      (open-line 1)
-      (if vip-open-with-indent (indent-to col))
-      (vip-change-mode-to-insert)))))
-
-(defun vip-open-line-at-point (arg)
-  "Open line at point."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (setq vip-d-com (list 'vip-open-line-at-point val ?r))
-    (if (equal com ?r)
-	(vip-loop val
-	      (progn
-		(open-line 1)
-		(yank)))
-      (open-line 1)
-      (vip-change-mode-to-insert))))
-
-(defun vip-substitute (arg)
-  "Substitute characters."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (save-excursion
-      (set-mark (point))
-      (forward-char val)
-      (if (equal com ?r)
-	  (vip-change-subr (mark) (point))
-	(vip-change (mark) (point))))
-    (setq vip-d-com (list 'vip-substitute val ?r))))
-  
-(defun vip-substitute-line (arg)
-  "Substitute lines."
-  (interactive "p")
-  (vip-line (cons arg ?C)))
-
-
-;; line command
-
-(defun vip-line (arg)
-  (let ((val (car arg)) (com (cdr arg)))
-    (move-marker vip-com-point (point))
-    (next-line (1- val))
-    (vip-execute-com 'vip-line val com)))
-
-(defun vip-yank-line (arg)
-  "Yank ARG lines (in vi's sense)"
-  (interactive "P")
-  (let ((val (vip-p-val arg)))
-    (vip-line (cons val ?Y))))
-    
-
-;; region command
-
-(defun vip-region (arg)
-  (interactive "P")
-  (let ((val (vip-P-val arg))
-	(com (vip-getcom arg)))
-    (move-marker vip-com-point (point))
-    (exchange-point-and-mark)
-    (vip-execute-com 'vip-region val com)))
-
-(defun vip-Region (arg)
-  (interactive "P")
-  (let ((val (vip-P-val arg))
-	(com (vip-getCom arg)))
-    (move-marker vip-com-point (point))
-    (exchange-point-and-mark)
-    (vip-execute-com 'vip-Region val com)))
-  
-(defun vip-replace-char (arg)
-  "Replace the following ARG chars by the character read."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (setq vip-d-com (list 'vip-replace-char val ?r))
-    (vip-replace-char-subr (if (equal com ?r) vip-d-char (read-char)) val)))
-
-(defun vip-replace-char-subr (char arg)
-  (delete-char arg t)
-  (setq vip-d-char char)
-  (vip-loop (if (> arg 0) arg (- arg)) (insert char))
-  (backward-char arg))
-
-(defun vip-replace-string ()
-  "Replace string.  If you supply null string as the string to be replaced,
-the query replace mode will toggle between string replace and regexp replace."
-  (interactive)
-  (let (str)
-    (setq str (vip-read-string
-	       (if vip-re-replace "Replace regexp: " "Replace string: ")))
-    (if (string= str "")
-	(progn
-	  (setq vip-re-replace (not vip-re-replace))
-	  (message "Replace mode changed to %s."
-		   (if vip-re-replace "regexp replace"
-		     "string replace")))
-      (if vip-re-replace
-	  ;; (replace-regexp
-	  ;;  str
-	  ;;  (vip-read-string (format "Replace regexp \"%s\" with: " str)))
-	  (while (re-search-forward str nil t)
-	    (replace-match (vip-read-string
-			    (format "Replace regexp \"%s\" with: " str))
-			   nil nil))
-	(replace-string
-	 str
-	 (vip-read-string (format "Replace \"%s\" with: " str)))))))
-
-
-;; basic cursor movement.  j, k, l, m commands.
-
-(defun vip-forward-char (arg)
-  "Move point right ARG characters (left if ARG negative).On reaching end
-of buffer, stop and signal error."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (forward-char val)
-    (if com (vip-execute-com 'vip-forward-char val com))))
-
-(defun vip-backward-char (arg)
-  "Move point left ARG characters (right if ARG negative).  On reaching
-beginning of buffer, stop and signal error."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (backward-char val)
-    (if com (vip-execute-com 'vip-backward-char val com))))
-
-
-;; word command
-
-(defun vip-forward-word (arg)
-  "Forward word."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (forward-word val)
-    (skip-chars-forward " \t\n")
-    (if com
-	(progn
-	  (if (or (= com ?c) (= com (- ?c)))
-	      (progn (backward-word 1) (forward-word 1)))
-	  (if (or (= com ?d) (= com ?y))
-	      (progn
-		(backward-word 1)
-		(forward-word 1)
-		(skip-chars-forward " \t")))
-	  (vip-execute-com 'vip-forward-word val com)))))
-
-(defun vip-end-of-word (arg)
-  "Move point to end of current word."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (forward-char)
-    (forward-word val)
-    (backward-char)
-    (if com
-	(progn
-	  (forward-char)
-	  (vip-execute-com 'vip-end-of-word val com)))))
-			 
-(defun vip-backward-word (arg)
-  "Backward word."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (backward-word val)
-    (if com (vip-execute-com 'vip-backward-word val com))))
-
-(defun vip-forward-Word (arg)
-  "Forward word delimited by white character."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (re-search-forward "[^ \t\n]*[ \t\n]+" nil t val)
-    (if com
-	(progn
-	  (if (or (= com ?c) (= com (- ?c)))
-	      (progn (backward-word 1) (forward-word 1)))
-	  (if (or (= com ?d) (= com ?y))
-	      (progn
-		(backward-word 1)
-		(forward-word 1)
-		(skip-chars-forward " \t")))
-	  (vip-execute-com 'vip-forward-Word val com)))))
-
-(defun vip-end-of-Word (arg)
-  "Move forward to end of word delimited by white character."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (forward-char)
-    (if (re-search-forward "[^ \t\n]+" nil t val) (backward-char))
-    (if com
-	(progn
-	  (forward-char)
-	  (vip-execute-com 'vip-end-of-Word val com)))))
-
-(defun vip-backward-Word (arg)
-  "Backward word delimited by white character."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (if (re-search-backward "[ \t\n]+[^ \t\n]+" nil t val)
-	(forward-char)
-      (goto-char (point-min)))
-    (if com (vip-execute-com 'vip-backward-Word val com))))
-
-(defun vip-beginning-of-line (arg)
-  "Go to beginning of line."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (beginning-of-line val)
-    (if com (vip-execute-com 'vip-beginning-of-line val com))))
-
-(defun vip-bol-and-skip-white (arg)
-  "Beginning of line at first non-white character."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (back-to-indentation)
-    (if com (vip-execute-com 'vip-bol-and-skip-white val com))))
-
-(defun vip-goto-eol (arg)
-  "Go to end of line."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (end-of-line val)
-    (if com (vip-execute-com 'vip-goto-eol val com))))
-
-(defun vip-next-line (arg)
-  "Go to next line."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (line-move val)
-    (setq this-command 'next-line)
-    (if com (vip-execute-com 'vip-next-line val com))))
-
-(defun vip-next-line-at-bol (arg)
-  "Next line at beginning of line."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (next-line val)
-    (back-to-indentation)
-    (if com (vip-execute-com 'vip-next-line-at-bol val com))))
-
-(defun vip-previous-line (arg)
-  "Go to previous line."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (next-line (- val))
-    (setq this-command 'previous-line)
-    (if com (vip-execute-com 'vip-previous-line val com))))
-
-(defun vip-previous-line-at-bol (arg)
-  "Previous line at beginning of line."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getCom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (next-line (- val))
-    (back-to-indentation)
-    (if com (vip-execute-com 'vip-previous-line val com))))
-
-(defun vip-change-to-eol (arg)
-  "Change to end of line."
-  (interactive "P")
-  (vip-goto-eol (cons arg ?c)))
-
-(defun vip-kill-line (arg)
-  "Delete line."
-  (interactive "P")
-  (vip-goto-eol (cons arg ?d)))
-
-
-;; moving around
-
-(defun vip-goto-line (arg)
-  "Go to ARG's line.  Without ARG go to end of buffer."
-  (interactive "P")
-  (let ((val (vip-P-val arg)) (com (vip-getCom arg)))
-    (move-marker vip-com-point (point))
-    (set-mark (point))
-    (if (null val)
-	(goto-char (point-max))
-      (goto-char (point-min))
-      (forward-line (1- val)))
-    (back-to-indentation)
-    (if com (vip-execute-com 'vip-goto-line val com))))
-
-(defun vip-find-char (arg char forward offset)
-  "Find ARG's occurrence of CHAR on the current line.  If FORWARD then
-search is forward, otherwise backward.  OFFSET is used to adjust point
-after search."
-  (let ((arg (if forward arg (- arg))) point)
-    (save-excursion
-      (save-restriction
-	(if (> arg 0)
-	    (narrow-to-region
-	     ;; forward search begins here
-	     (if (eolp) (error "") (point))
-	     ;; forward search ends here
-	     (progn (next-line 1) (beginning-of-line) (point)))
-	  (narrow-to-region
-	   ;; backward search begins from here
-	   (if (bolp) (error "") (point))
-	   ;; backward search ends here
-	   (progn (beginning-of-line) (point))))
-	;; if arg > 0, point is forwarded before search.
-	(if (> arg 0) (goto-char (1+ (point-min)))
-	  (goto-char (point-max)))
-	(let ((case-fold-search nil))
-	  (search-forward (char-to-string char) nil 0 arg))
-	(setq point (point))
-	(if (or (and (> arg 0) (= point (point-max)))
-		(and (< arg 0) (= point (point-min))))
-	    (error ""))))
-    (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0))))))
-
-(defun vip-find-char-forward (arg)
-  "Find char on the line.  If called interactively read the char to find
-from the terminal, and if called from vip-repeat, the char last used is
-used.  This behaviour is controlled by the sign of prefix numeric value."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if (> val 0)
-	;; this means that the function was called interactively
-	(setq vip-f-char (read-char)
-	      vip-f-forward t
-	      vip-f-offset nil)
-      (setq val (- val)))
-    (if com (move-marker vip-com-point (point)))
-    (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil)
-    (setq val (- val))
-    (if com
-	(progn
-	  (setq vip-F-char vip-f-char);; set new vip-F-char
-	  (forward-char)
-	  (vip-execute-com 'vip-find-char-forward val com)))))
-
-(defun vip-goto-char-forward (arg)
-  "Go up to char ARG forward on line."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if (> val 0)
-	;; this means that the function was called interactively
-	(setq vip-f-char (read-char)
-	      vip-f-forward t
-	      vip-f-offset t)
-      (setq val (- val)))
-    (if com (move-marker vip-com-point (point)))
-    (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t)
-    (setq val (- val))
-    (if com
-	(progn
-	  (setq vip-F-char vip-f-char);; set new vip-F-char
-	  (forward-char)
-	  (vip-execute-com 'vip-goto-char-forward val com)))))
-
-(defun vip-find-char-backward (arg)
-  "Find char ARG on line backward."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if (> val 0)
-	;; this means that the function was called interactively
-	(setq vip-f-char (read-char)
-	      vip-f-forward nil
-	      vip-f-offset nil)
-      (setq val (- val)))
-    (if com (move-marker vip-com-point (point)))
-    (vip-find-char
-     val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil)
-    (setq val (- val))
-    (if com
-	(progn
-	  (setq vip-F-char vip-f-char);; set new vip-F-char
-	  (vip-execute-com 'vip-find-char-backward val com)))))
-
-(defun vip-goto-char-backward (arg)
-  "Go up to char ARG backward on line."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if (> val 0)
-	;; this means that the function was called interactively
-	(setq vip-f-char (read-char)
-	      vip-f-forward nil
-	      vip-f-offset t)
-      (setq val (- val)))
-    (if com (move-marker vip-com-point (point)))
-    (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t)
-    (setq val (- val))
-    (if com
-	(progn
-	  (setq vip-F-char vip-f-char);; set new vip-F-char
-	  (vip-execute-com 'vip-goto-char-backward val com)))))
-
-(defun vip-repeat-find (arg)
-  "Repeat previous find command."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (vip-find-char val vip-f-char vip-f-forward vip-f-offset)
-    (if com
-	(progn
-	  (if vip-f-forward (forward-char))
-	  (vip-execute-com 'vip-repeat-find val com)))))
-
-(defun vip-repeat-find-opposite (arg)
-  "Repeat previous find command in the opposite direction."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset)
-    (if com
-	(progn
-	  (if vip-f-forward (forward-char))
-	  (vip-execute-com 'vip-repeat-find-opposite val com)))))
-
-
-;; window scrolling etc.
-
-(defun vip-other-window (arg)
-  "Switch to other window."
-  (interactive "p")
-  (other-window arg)
-  (or (not (eq vip-current-mode 'emacs-mode))
-      (string= (buffer-name (current-buffer)) " *Minibuf-1*")
-      (vip-change-mode-to-vi)))
-
-(defun vip-window-top (arg)
-  "Go to home window line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (move-to-window-line (1- val))
-    (if com (vip-execute-com 'vip-window-top val com))))
-
-(defun vip-window-middle (arg)
-  "Go to middle window line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
-    (if com (vip-execute-com 'vip-window-middle val com))))
-
-(defun vip-window-bottom (arg)
-  "Go to last window line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (move-to-window-line (- val))
-    (if com (vip-execute-com 'vip-window-bottom val com))))
-
-(defun vip-line-to-top (arg)
-  "Put current line on the home line."
-  (interactive "p")
-  (recenter (1- arg)))
-
-(defun vip-line-to-middle (arg)
-  "Put current line on the middle line."
-  (interactive "p")
-  (recenter (+ (1- arg) (/ (1- (window-height)) 2))))
-
-(defun vip-line-to-bottom (arg)
-  "Put current line on the last line."
-  (interactive "p")
-  (recenter (- (window-height) (1+ arg))))
-
-
-;; paren match
-
-(defun vip-paren-match (arg)
-  "Go to the matching parenthesis."
-  (interactive "P")
-  (let ((com (vip-getcom arg)))
-    (if (numberp arg)
-	(if (or (> arg 99) (< arg 1))
-	    (error "Prefix must be between 1 and 99.")
-	  (goto-char
-	   (if (> (point-max) 80000)
-	       (* (/ (point-max) 100) arg)
-	     (/ (* (point-max) arg) 100)))
-	  (back-to-indentation))
-    (cond ((looking-at "[\(\[{]")
-	   (if com (move-marker vip-com-point (point)))
-	   (forward-sexp 1)
-	   (if com
-	       (vip-execute-com 'vip-paren-match nil com)
-	     (backward-char)))
-	  ((looking-at "[])}]")
-	   (forward-char)
-	   (if com (move-marker vip-com-point (point)))
-	   (backward-sexp 1)
-	   (if com (vip-execute-com 'vip-paren-match nil com)))
-	  (t (error ""))))))
-
-
-;; sentence and paragraph
-
-(defun vip-forward-sentence (arg)
-  "Forward sentence."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (forward-sentence val)
-    (if com (vip-execute-com 'vip-forward-sentence nil com))))
-
-(defun vip-backward-sentence (arg)
-  "Backward sentence."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (backward-sentence val)
-    (if com (vip-execute-com 'vip-backward-sentence nil com))))
-
-(defun vip-forward-paragraph (arg)
-  "Forward paragraph."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (forward-paragraph val)
-    (if com (vip-execute-com 'vip-forward-paragraph nil com))))
-
-(defun vip-backward-paragraph (arg)
-  "Backward paragraph."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (move-marker vip-com-point (point)))
-    (backward-paragraph val)
-    (if com (vip-execute-com 'vip-backward-paragraph nil com))))
-
-
-;; scrolling
-
-(defun vip-scroll (arg)
-  "Scroll to next screen."
-  (interactive "p")
-  (if (> arg 0)
-      (while (> arg 0)
-	(scroll-up)
-	(setq arg (1- arg)))
-    (while (> 0 arg)
-      (scroll-down)
-      (setq arg (1+ arg)))))
-
-(defun vip-scroll-back (arg)
-  "Scroll to previous screen."
-  (interactive "p")
-  (vip-scroll (- arg)))
-
-(defun vip-scroll-down (arg)
-  "Scroll up half screen."
-  (interactive "P")
-  (if (null arg) (scroll-down (/ (window-height) 2))
-    (scroll-down arg)))
-
-(defun vip-scroll-down-one (arg)
-  "Scroll up one line."
-  (interactive "p")
-  (scroll-down arg))
-
-(defun vip-scroll-up (arg)
-  "Scroll down half screen."
-  (interactive "P")
-  (if (null arg) (scroll-up (/ (window-height) 2))
-    (scroll-up arg)))
-
-(defun vip-scroll-up-one (arg)
-  "Scroll down one line."
-  (interactive "p")
-  (scroll-up arg))
-
-
-;; splitting window
-
-(defun vip-buffer-in-two-windows ()
-  "Show current buffer in two windows."
-  (interactive)
-  (delete-other-windows)
-  (split-window-vertically nil))
-
-
-;; searching
-
-(defun vip-search-forward (arg)
-  "Search a string forward.  ARG is used to find the ARG's occurrence
-of the string.  Default is vanilla search.  Search mode can be toggled by
-giving null search string."
-  (interactive "P")
-  (let ((val (vip-P-val arg)) (com (vip-getcom arg)))
-    (setq vip-s-forward t
-	  vip-s-string (vip-read-string (if vip-re-search "RE-/" "/")))
-    (if (string= vip-s-string "")
-	(progn
-	  (setq vip-re-search (not vip-re-search))
-	  (message "Search mode changed to %s search."
-		   (if vip-re-search "regular expression"
-		     "vanilla")))
-      (vip-search vip-s-string t val)
-      (if com
-	  (progn
-	    (move-marker vip-com-point (mark))
-	    (vip-execute-com 'vip-search-next val com))))))
-
-(defun vip-search-backward (arg)
-  "Search a string backward.  ARG is used to find the ARG's occurrence
-of the string.  Default is vanilla search.  Search mode can be toggled by
-giving null search string."
-  (interactive "P")
-  (let ((val (vip-P-val arg)) (com (vip-getcom arg)))
-    (setq vip-s-forward nil
-	  vip-s-string (vip-read-string (if vip-re-search "RE-?" "?")))
-    (if (string= vip-s-string "")
-	(progn
-	  (setq vip-re-search (not vip-re-search))
-	  (message "Search mode changed to %s search."
-		   (if vip-re-search "regular expression"
-		     "vanilla")))
-      (vip-search vip-s-string nil val)
-      (if com
-	  (progn
-	    (move-marker vip-com-point (mark))
-	    (vip-execute-com 'vip-search-next val com))))))
-
-(defun vip-search (string forward arg &optional no-offset init-point)
-  "(STRING FORWARD COUNT &optional NO-OFFSET) Search COUNT's occurrence of
-STRING.  Search will be forward if FORWARD, otherwise backward."
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg))
-	(null-arg (null (vip-P-val arg))) (offset (not no-offset))
-	(case-fold-search vip-case-fold-search)
-	(start-point (or init-point (point))))
-    (if forward
-	(condition-case conditions
-	    (progn
-	      (if (and offset (not (eobp))) (forward-char))
-	      (if vip-re-search
-		  (progn
-		    (re-search-forward string nil nil val)
-		    (re-search-backward string))
-		(search-forward string nil nil val)
-		(search-backward string))
-	      (push-mark start-point))
-	  (search-failed
-	   (if (and null-arg vip-search-wrap-around)
-	       (progn
-		 (goto-char (point-min))
-		 (vip-search string forward (cons 1 com) t start-point))
-	     (goto-char start-point)
-	     (signal 'search-failed (cdr conditions)))))
-      (condition-case conditions
-	    (progn
-	      (if vip-re-search
-		    (re-search-backward string nil nil val)
-		(search-backward string nil nil val))
-	      (push-mark start-point))
-	  (search-failed
-	   (if (and null-arg vip-search-wrap-around)
-	       (progn
-		 (goto-char (point-max))
-		 (vip-search string forward (cons 1 com) t start-point))
-	     (goto-char start-point)
-	     (signal 'search-failed (cdr conditions))))))))
-
-(defun vip-search-next (arg)
-  "Repeat previous search."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if (null vip-s-string) (error "No previous search string."))
-    (vip-search vip-s-string vip-s-forward arg)
-    (if com (vip-execute-com 'vip-search-next val com))))
-
-(defun vip-search-Next (arg)
-  "Repeat previous search in the reverse direction."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (com (vip-getcom arg)))
-    (if (null vip-s-string) (error "No previous search string."))
-    (vip-search vip-s-string (not vip-s-forward) arg)
-    (if com (vip-execute-com 'vip-search-Next val com))))
-
-
-;; visiting and killing files, buffers
-
-(defun vip-switch-to-buffer ()
-  "Switch to buffer in the current window."
-  (interactive)
-  (let (buffer)
-    (setq buffer
-	  (read-buffer
-	   (format "switch to buffer \(%s\): "
-		   (buffer-name (other-buffer (current-buffer))))))
-    (switch-to-buffer buffer)
-    (vip-change-mode-to-vi)))
-
-(defun vip-switch-to-buffer-other-window ()
-  "Switch to buffer in another window."
-  (interactive)
-  (let (buffer)
-    (setq buffer
-	  (read-buffer
-	   (format "Switch to buffer \(%s\): "
-		   (buffer-name (other-buffer (current-buffer))))))
-    (switch-to-buffer-other-window buffer)
-    (vip-change-mode-to-vi)))
-
-(defun vip-kill-buffer ()
-  "Kill a buffer."
-  (interactive)
-  (let (buffer buffer-name)
-    (setq buffer-name
-	  (read-buffer
-	   (format "Kill buffer \(%s\): "
-		   (buffer-name (current-buffer)))))
-    (setq buffer
-	  (if (null buffer-name)
-	      (current-buffer)
-	    (get-buffer buffer-name)))
-    (if (null buffer) (error "Buffer %s nonexistent." buffer-name))
-    (if (or (not (buffer-modified-p buffer))
-	    (y-or-n-p "Buffer is modified, are you sure? "))
-	(kill-buffer buffer)
-      (error "Buffer not killed."))))
-
-(defun vip-find-file ()
-  "Visit file in the current window."
-  (interactive)
-  (let (file)
-    (setq file (read-file-name "visit file: "))
-    (switch-to-buffer (find-file-noselect file))
-    (vip-change-mode-to-vi)))
-
-(defun vip-find-file-other-window ()
-  "Visit file in another window."
-  (interactive)
-  (let (file)
-    (setq file (read-file-name "Visit file: "))
-    (switch-to-buffer-other-window (find-file-noselect file))
-    (vip-change-mode-to-vi)))
-
-(defun vip-info-on-file ()
-  "Give information of the file associated to the current buffer."
-  (interactive)
-  (message "\"%s\" line %d of %d"
-	   (if (buffer-file-name) (buffer-file-name) "")
-	   (1+ (count-lines (point-min) (point)))
-	   (1+ (count-lines (point-min) (point-max)))))
-
-
-;; yank and pop
-
-(defun vip-yank (text)
-  "yank TEXT silently."
-  (save-excursion
-    (vip-push-mark-silent (point))
-    (insert text)
-    (exchange-point-and-mark))
-  (skip-chars-forward " \t"))
-
-(defun vip-put-back (arg)
-  "Put back after point/below line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(text (if vip-use-register
-		  (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9))
-		      (current-kill (- vip-use-register ?1) 'do-not-rotate)
-		    (get-register vip-use-register))
-		(current-kill 0))))
-    (if (null text)
-	(if vip-use-register
-	    (let ((reg vip-use-register))
-	      (setq vip-use-register nil)
-	      (error "Nothing in register %c" reg))
-	  (error "")))
-    (setq vip-use-register nil)
-    (if (vip-end-with-a-newline-p text)
-	(progn
-	  (next-line 1)
-	  (beginning-of-line))
-      (if (and (not (eolp)) (not (eobp))) (forward-char)))
-    (setq vip-d-com (list 'vip-put-back val nil vip-use-register))
-    (vip-loop val (vip-yank text))))
-
-(defun vip-Put-back (arg)
-  "Put back at point/above line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(text (if vip-use-register
-		  (if (and (<= ?1 vip-use-register) (<= vip-use-register ?9))
-		      (current-kill (- vip-use-register ?1) 'do-not-rotate)
-		    (get-register vip-use-register))
-		(current-kill 0))))
-    (if (null text)
-	(if vip-use-register
-	    (let ((reg vip-use-register))
-	      (setq vip-use-register nil)
-	      (error "Nothing in register %c" reg))
-	  (error "")))
-    (setq vip-use-register nil)
-    (if (vip-end-with-a-newline-p text) (beginning-of-line))
-    (setq vip-d-com (list 'vip-Put-back val nil vip-use-register))
-    (vip-loop val (vip-yank text))))
-
-(defun vip-delete-char (arg)
-  "Delete character."
-  (interactive "P")
-  (let ((val (vip-p-val arg)))
-    (setq vip-d-com (list 'vip-delete-char val nil))
-    (if vip-use-register
-	(progn
-	  (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z))
-	      (vip-append-to-register
-	       (+ vip-use-register 32) (point) (- (point) val))
-	    (copy-to-register vip-use-register (point) (- (point) val) nil))
-	  (setq vip-use-register nil)))
-    (delete-char val t)))
-
-(defun vip-delete-backward-char (arg)
-  "Delete previous character."
-  (interactive "P")
-  (let ((val (vip-p-val arg)))
-    (setq vip-d-com (list 'vip-delete-backward-char val nil))
-    (if vip-use-register
-	(progn
-	  (if (and (<= ?A vip-use-register) (<= vip-use-register ?Z))
-	      (vip-append-to-register
-	       (+ vip-use-register 32) (point) (+ (point) val))
-	    (copy-to-register vip-use-register (point) (+ (point) val) nil))
-	  (setq vip-use-register nil)))
-    (delete-backward-char val t)))
-
-
-;; join lines.
-
-(defun vip-join-lines (arg)
-  "Join this line to next, if ARG is nil.  Otherwise, join ARG lines"
-  (interactive "*P")
-  (let ((val (vip-P-val arg)))
-    (setq vip-d-com (list 'vip-join-lines val nil))
-    (vip-loop (if (null val) 1 (1- val))
-	  (progn
-	    (end-of-line)
-	    (if (not (eobp))
-		(progn
-		  (forward-line 1)
-		  (delete-region (point) (1- (point)))
-		  (fixup-whitespace)))))))
-
-
-;; making small changes
-
-(defun vip-change (beg end)
-  (setq c-string
-	(vip-read-string (format "%s => " (buffer-substring beg end))))
-  (vip-change-subr beg end))
-
-(defun vip-change-subr (beg end)
-  (if vip-use-register
-      (progn
-	(copy-to-register vip-use-register beg end nil)
-	(setq vip-use-register nil)))
-  (kill-region beg end)
-  (setq this-command 'vip-change)
-  (insert c-string))
-
-
-;; query replace
-
-(defun vip-query-replace ()
-  "Query replace.  If you supply null string as the string to be replaced,
-the query replace mode will toggle between string replace and regexp replace."
-  (interactive)
-  (let (str)
-    (setq str (vip-read-string
-	       (if vip-re-query-replace "Query replace regexp: "
-		 "Query replace: ")))
-    (if (string= str "")
-	(progn
-	  (setq vip-re-query-replace (not vip-re-query-replace))
-	  (message "Query replace mode changed to %s."
-		   (if vip-re-query-replace "regexp replace"
-		     "string replace")))
-      (if vip-re-query-replace
-	  (query-replace-regexp
-	   str
-	   (vip-read-string (format "Query replace regexp \"%s\" with: " str)))
-	(query-replace
-	 str
-	 (vip-read-string (format "Query replace \"%s\" with: " str)))))))
-
-
-;; marking
-
-(defun vip-mark-beginning-of-buffer ()
-  (interactive)
-  (set-mark (point))
-  (goto-char (point-min))
-  (exchange-point-and-mark)
-  (message "mark set at the beginning of buffer"))
-
-(defun vip-mark-end-of-buffer ()
-  (interactive)
-  (set-mark (point))
-  (goto-char (point-max))
-  (exchange-point-and-mark)
-  (message "mark set at the end of buffer"))
-
-(defun vip-mark-point (char)
-  (interactive "c")
-  (cond ((and (<= ?a char) (<= char ?z))
-	 (point-to-register (- char (- ?a ?\C-a)) nil))
-	((= char ?<) (vip-mark-beginning-of-buffer))
-	((= char ?>) (vip-mark-end-of-buffer))
-	((= char ?.) (push-mark))
-	((= char ?,) (set-mark-command 1))
-	((= char ?D) (mark-defun))
-	(t (error ""))))
-
-(defun vip-goto-mark (arg)
-  "Go to mark."
-  (interactive "P")
-  (let ((char (read-char)) (com (vip-getcom arg)))
-    (vip-goto-mark-subr char com nil)))
-
-(defun vip-goto-mark-and-skip-white (arg)
-  "Go to mark and skip to first non-white on line."
-  (interactive "P")
-  (let ((char (read-char)) (com (vip-getCom arg)))
-    (vip-goto-mark-subr char com t)))
-
-(defun vip-goto-mark-subr (char com skip-white)
-  (cond ((and (<= ?a char) (<= char ?z))
-	 (let ((buff (current-buffer)))
-	   (if com (move-marker vip-com-point (point)))
-	   (goto-char (register-to-point (- char (- ?a ?\C-a))))
-	   (if skip-white (back-to-indentation))
-	   (vip-change-mode-to-vi)
-	   (if com
-	       (if (equal buff (current-buffer))
-		   (vip-execute-com (if skip-white
-					'vip-goto-mark-and-skip-white
-				      'vip-goto-mark)
-				    nil com)
-		 (switch-to-buffer buff)
-		 (goto-char vip-com-point)
-		 (vip-change-mode-to-vi)
-		 (error "")))))
-	((and (not skip-white) (= char ?`))
-	 (if com (move-marker vip-com-point (point)))
-	 (exchange-point-and-mark)
-	 (if com (vip-execute-com 'vip-goto-mark nil com)))
-	((and skip-white (= char ?'))
-	 (if com (move-marker vip-com-point (point)))
-	 (exchange-point-and-mark)
-	 (back-to-indentation)
-	 (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com)))
-	(t (error ""))))
-
-(defun vip-exchange-point-and-mark ()
-  (interactive)
-  (exchange-point-and-mark)
-  (back-to-indentation))
-
-(defun vip-keyboard-quit ()
-  "Abort partially formed or running command."
-  (interactive)
-  (setq vip-use-register nil)
-  (keyboard-quit))
-
-(defun vip-ctl-c-equivalent (arg)
-  "Emulate C-c in Emacs mode."
-  (interactive "P")
-  (vip-ctl-key-equivalent "\C-c" arg))
-
-(defun vip-ctl-x-equivalent (arg)
-  "Emulate C-x in Emacs mode."
-  (interactive "P")
-  (vip-ctl-key-equivalent "\C-x" arg))
-
-(defun vip-ctl-key-equivalent (key arg)
-  (let ((char (read-char)))
-    (if (and (<= ?A char) (<= char ?Z))
-	(setq char (- char (- ?A ?\C-a))))
-    (vip-escape-to-emacs arg (list (aref key 0) char))))
-
-;; commands in insertion mode
-
-(defun vip-delete-backward-word (arg)
-  "Delete previous word."
-  (interactive "p")
-  (save-excursion
-    (set-mark (point))
-    (backward-word arg)
-    (delete-region (point) (mark))))
-
-
-;; key bindings
-
-(set 'vip-mode-map (make-keymap))
-
-(define-key vip-mode-map "\C-a" 'beginning-of-line)
-(define-key vip-mode-map "\C-b" 'vip-scroll-back)
-(define-key vip-mode-map "\C-c" 'vip-ctl-c)
-(define-key vip-mode-map "\C-d" 'vip-scroll-up)
-(define-key vip-mode-map "\C-e" 'vip-scroll-up-one)
-(define-key vip-mode-map "\C-f" 'vip-scroll)
-(define-key vip-mode-map "\C-g" 'vip-keyboard-quit)
-(define-key vip-mode-map "\C-h" 'help-command)
-(define-key vip-mode-map "\C-m" 'vip-scroll-back)
-(define-key vip-mode-map "\C-n" 'vip-other-window)
-(define-key vip-mode-map "\C-o" 'vip-open-line-at-point)
-(define-key vip-mode-map "\C-u" 'vip-scroll-down)
-(define-key vip-mode-map "\C-x" 'vip-ctl-x)
-(define-key vip-mode-map "\C-y" 'vip-scroll-down-one)
-(define-key vip-mode-map "\C-z" 'vip-change-mode-to-emacs)
-(define-key vip-mode-map "\e" 'vip-ESC)
-
-(define-key vip-mode-map " " 'vip-scroll)
-(define-key vip-mode-map "!" 'vip-command-argument)
-(define-key vip-mode-map "\"" 'vip-command-argument)
-(define-key vip-mode-map "#" 'vip-command-argument)
-(define-key vip-mode-map "$" 'vip-goto-eol)
-(define-key vip-mode-map "%" 'vip-paren-match)
-(define-key vip-mode-map "&" 'vip-nil)
-(define-key vip-mode-map "'" 'vip-goto-mark-and-skip-white)
-(define-key vip-mode-map "(" 'vip-backward-sentence)
-(define-key vip-mode-map ")" 'vip-forward-sentence)
-(define-key vip-mode-map "*" 'call-last-kbd-macro)
-(define-key vip-mode-map "+" 'vip-next-line-at-bol)
-(define-key vip-mode-map "," 'vip-repeat-find-opposite)
-(define-key vip-mode-map "-" 'vip-previous-line-at-bol)
-(define-key vip-mode-map "." 'vip-repeat)
-(define-key vip-mode-map "/" 'vip-search-forward)
-
-(define-key vip-mode-map "0" 'vip-beginning-of-line)
-(define-key vip-mode-map "1" 'vip-digit-argument)
-(define-key vip-mode-map "2" 'vip-digit-argument)
-(define-key vip-mode-map "3" 'vip-digit-argument)
-(define-key vip-mode-map "4" 'vip-digit-argument)
-(define-key vip-mode-map "5" 'vip-digit-argument)
-(define-key vip-mode-map "6" 'vip-digit-argument)
-(define-key vip-mode-map "7" 'vip-digit-argument)
-(define-key vip-mode-map "8" 'vip-digit-argument)
-(define-key vip-mode-map "9" 'vip-digit-argument)
-
-(define-key vip-mode-map ":" 'vip-ex)
-(define-key vip-mode-map ";" 'vip-repeat-find)
-(define-key vip-mode-map "<" 'vip-command-argument)
-(define-key vip-mode-map "=" 'vip-command-argument)
-(define-key vip-mode-map ">" 'vip-command-argument)
-(define-key vip-mode-map "?" 'vip-search-backward)
-(define-key vip-mode-map "@" 'vip-nil)
-
-(define-key vip-mode-map "A" 'vip-Append)
-(define-key vip-mode-map "B" 'vip-backward-Word)
-(define-key vip-mode-map "C" 'vip-ctl-c-equivalent)
-(define-key vip-mode-map "D" 'vip-kill-line)
-(define-key vip-mode-map "E" 'vip-end-of-Word)
-(define-key vip-mode-map "F" 'vip-find-char-backward)
-(define-key vip-mode-map "G" 'vip-goto-line)
-(define-key vip-mode-map "H" 'vip-window-top)
-(define-key vip-mode-map "I" 'vip-Insert)
-(define-key vip-mode-map "J" 'vip-join-lines)
-(define-key vip-mode-map "K" 'vip-kill-buffer)
-(define-key vip-mode-map "L" 'vip-window-bottom)
-(define-key vip-mode-map "M" 'vip-window-middle)
-(define-key vip-mode-map "N" 'vip-search-Next)
-(define-key vip-mode-map "O" 'vip-Open-line)
-(define-key vip-mode-map "P" 'vip-Put-back)
-(define-key vip-mode-map "Q" 'vip-query-replace)
-(define-key vip-mode-map "R" 'vip-replace-string)
-(define-key vip-mode-map "S" 'vip-switch-to-buffer-other-window)
-(define-key vip-mode-map "T" 'vip-goto-char-backward)
-(define-key vip-mode-map "U" 'vip-nil)
-(define-key vip-mode-map "V" 'vip-find-file-other-window)
-(define-key vip-mode-map "W" 'vip-forward-Word)
-(define-key vip-mode-map "X" 'vip-ctl-x-equivalent)
-(define-key vip-mode-map "Y" 'vip-yank-line)
-(define-key vip-mode-map "ZZ" 'save-buffers-kill-emacs)
-
-(define-key vip-mode-map "[" 'vip-nil)
-(define-key vip-mode-map "\\" 'vip-escape-to-emacs)
-(define-key vip-mode-map "]" 'vip-nil)
-(define-key vip-mode-map "^" 'vip-bol-and-skip-white)
-(define-key vip-mode-map "_" 'vip-nil)
-(define-key vip-mode-map "`" 'vip-goto-mark)
-
-(define-key vip-mode-map "a" 'vip-append)
-(define-key vip-mode-map "b" 'vip-backward-word)
-(define-key vip-mode-map "c" 'vip-command-argument)
-(define-key vip-mode-map "d" 'vip-command-argument)
-(define-key vip-mode-map "e" 'vip-end-of-word)
-(define-key vip-mode-map "f" 'vip-find-char-forward)
-(define-key vip-mode-map "g" 'vip-info-on-file)
-(define-key vip-mode-map "h" 'vip-backward-char)
-(define-key vip-mode-map "i" 'vip-insert)
-(define-key vip-mode-map "j" 'vip-next-line)
-(define-key vip-mode-map "k" 'vip-previous-line)
-(define-key vip-mode-map "l" 'vip-forward-char)
-(define-key vip-mode-map "m" 'vip-mark-point)
-(define-key vip-mode-map "n" 'vip-search-next)
-(define-key vip-mode-map "o" 'vip-open-line)
-(define-key vip-mode-map "p" 'vip-put-back)
-(define-key vip-mode-map "q" 'vip-nil)
-(define-key vip-mode-map "r" 'vip-replace-char)
-(define-key vip-mode-map "s" 'vip-switch-to-buffer)
-(define-key vip-mode-map "t" 'vip-goto-char-forward)
-(define-key vip-mode-map "u" 'vip-undo)
-(define-key vip-mode-map "v" 'vip-find-file)
-(define-key vip-mode-map "w" 'vip-forward-word)
-(define-key vip-mode-map "x" 'vip-delete-char)
-(define-key vip-mode-map "y" 'vip-command-argument)
-(define-key vip-mode-map "zH" 'vip-line-to-top)
-(define-key vip-mode-map "zM" 'vip-line-to-middle)
-(define-key vip-mode-map "zL" 'vip-line-to-bottom)
-(define-key vip-mode-map "z\C-m" 'vip-line-to-top)
-(define-key vip-mode-map "z." 'vip-line-to-middle)
-(define-key vip-mode-map "z-" 'vip-line-to-bottom)
-
-(define-key vip-mode-map "{" 'vip-backward-paragraph)
-(define-key vip-mode-map "|" 'vip-goto-col)
-(define-key vip-mode-map "}" 'vip-forward-paragraph)
-(define-key vip-mode-map "~" 'vip-nil)
-(define-key vip-mode-map "\177" 'vip-delete-backward-char)
-
-(define-key ctl-x-map "3" 'vip-buffer-in-two-windows)
-(define-key ctl-x-map "\C-i" 'insert-file)
-
-(defun vip-version ()
-  (interactive)
-  (message "VIP version 3.5 of September 15, 1987"))
-
-
-;; implement ex commands
-
-(defvar ex-token-type nil
-  "type of token.  if non-nil, gives type of address.  if nil, it
-is a command.")
-
-(defvar ex-token nil
-  "value of token.")
-
-(defvar ex-addresses nil
-  "list of ex addresses")
-
-(defvar ex-flag nil
-  "flag for ex flag")
-
-(defvar ex-buffer nil
-  "name of ex buffer")
-
-(defvar ex-count nil
-  "value of ex count")
-
-(defvar ex-g-flag nil
-  "flag for global command")
-
-(defvar ex-g-variant nil
-  "if t global command is executed on lines not matching ex-g-pat")
-
-(defvar ex-reg-exp nil
-  "save reg-exp used in substitute")
-
-(defvar ex-repl nil
-  "replace pattern for substitute")
-
-(defvar ex-g-pat nil
-  "pattern for global command")
-
-(defvar ex-map (make-sparse-keymap)
-  "save commands for mapped keys")
-
-(defvar ex-tag nil
-  "save ex tag")
-
-(defvar ex-file nil)
-
-(defvar ex-variant nil)
-
-(defvar ex-offset nil)
-
-(defvar ex-append nil)
-
-(defun vip-nil ()
-  (interactive)
-  (error ""))
-
-(defun vip-looking-back (str)
-  "returns t if looking back reg-exp STR before point."
-  (and (save-excursion (re-search-backward str nil t))
-       (= (point) (match-end 0))))
-
-(defun vip-check-sub (str)
-  "check if ex-token is an initial segment of STR"
-  (let ((length (length ex-token)))
-    (if (and (<= length (length str))
-	     (string= ex-token (substring str 0 length)))
-	(setq ex-token str)
-      (setq ex-token-type "non-command"))))
-
-(defun vip-get-ex-com-subr ()
-  "get a complete ex command"
-  (set-mark (point))
-  (re-search-forward "[a-z][a-z]*")
-  (setq ex-token-type "command")
-  (setq ex-token (buffer-substring (point) (mark)))
-  (exchange-point-and-mark)
-  (cond ((looking-at "a")
-	 (cond ((looking-at "ab") (vip-check-sub "abbreviate"))
-	       ((looking-at "ar") (vip-check-sub "args"))
-	       (t (vip-check-sub "append"))))
-	((looking-at "[bh]") (setq ex-token-type "non-command"))
-	((looking-at "c")
-	 (if (looking-at "co") (vip-check-sub "copy")
-	   (vip-check-sub "change")))
-	((looking-at "d") (vip-check-sub "delete"))
-	((looking-at "e")
-	 (if (looking-at "ex") (vip-check-sub "ex")
-	   (vip-check-sub "edit")))
-	((looking-at "f") (vip-check-sub "file"))
-	((looking-at "g") (vip-check-sub "global"))
-	((looking-at "i") (vip-check-sub "insert"))
-	((looking-at "j") (vip-check-sub "join"))
-	((looking-at "l") (vip-check-sub "list"))
-	((looking-at "m")
-	 (cond ((looking-at "map") (vip-check-sub "map"))
-	       ((looking-at "mar") (vip-check-sub "mark"))
-	       (t (vip-check-sub "move"))))
-	((looking-at "n")
-	 (if (looking-at "nu") (vip-check-sub "number")
-	   (vip-check-sub "next")))
-	((looking-at "o") (vip-check-sub "open"))
-	((looking-at "p")
-	 (cond ((looking-at "pre") (vip-check-sub "preserve"))
-	       ((looking-at "pu") (vip-check-sub "put"))
-	       (t (vip-check-sub "print"))))
-	((looking-at "q") (vip-check-sub "quit"))
-	((looking-at "r")
-	 (cond ((looking-at "rec") (vip-check-sub "recover"))
-	       ((looking-at "rew") (vip-check-sub "rewind"))
-	       (t (vip-check-sub "read"))))
-	((looking-at "s")
-	 (cond ((looking-at "se") (vip-check-sub "set"))
-	       ((looking-at "sh") (vip-check-sub "shell"))
-	       ((looking-at "so") (vip-check-sub "source"))
-	       ((looking-at "st") (vip-check-sub "stop"))
-	       (t (vip-check-sub "substitute"))))
-	((looking-at "t")
-	 (if (looking-at "ta") (vip-check-sub "tag")
-	   (vip-check-sub "t")))
-	((looking-at "u")
-	 (cond ((looking-at "una") (vip-check-sub "unabbreviate"))
-	       ((looking-at "unm") (vip-check-sub "unmap"))
-	       (t (vip-check-sub "undo"))))
-	((looking-at "v")
-	 (cond ((looking-at "ve") (vip-check-sub "version"))
-	       ((looking-at "vi") (vip-check-sub "visual"))
-	       (t (vip-check-sub "v"))))
-	((looking-at "w")
-	 (if (looking-at "wq") (vip-check-sub "wq")
-	   (vip-check-sub "write")))
-	((looking-at "x") (vip-check-sub "xit"))
-	((looking-at "y") (vip-check-sub "yank"))
-	((looking-at "z") (vip-check-sub "z")))
-  (exchange-point-and-mark))
-
-(defun vip-get-ex-token ()
-  "get an ex-token which is either an address or a command.
-a token has type \(command, address, end-mark\) and value."
-  (save-window-excursion
-    (set-buffer " *ex-working-space*")
-    (skip-chars-forward " \t")
-    (cond ((looking-at "[k#]")
-	   (setq ex-token-type "command")
-	   (setq ex-token (char-to-string (following-char)))
-	   (forward-char 1))
-	  ((looking-at "[a-z]") (vip-get-ex-com-subr))
-	  ((looking-at "\\.")
-	   (forward-char 1)
-	   (setq ex-token-type "dot"))
-	  ((looking-at "[0-9]")
-	   (set-mark (point))
-	   (re-search-forward "[0-9]*")
-	   (setq ex-token-type
-		 (cond ((string= ex-token-type "plus") "add-number")
-		       ((string= ex-token-type "minus") "sub-number")
-		       (t "abs-number")))
-	   (setq ex-token (string-to-int (buffer-substring (point) (mark)))))
-	  ((looking-at "\\$")
-	   (forward-char 1)
-	   (setq ex-token-type "end"))
-	  ((looking-at "%")
-	   (forward-char 1)
-	   (setq ex-token-type "whole"))
-	  ((looking-at "+")
-	   (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
-		  (forward-char 1)
-		  (insert "1")
-		  (backward-char 1)
-		  (setq ex-token-type "plus"))
-		 ((looking-at "+[0-9]")
-		  (forward-char 1)
-		  (setq ex-token-type "plus"))
-		 (t
-		  (error "Badly formed address"))))
-	  ((looking-at "-")
-	   (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
-		  (forward-char 1)
-		  (insert "1")
-		  (backward-char 1)
-		  (setq ex-token-type "minus"))
-		 ((looking-at "-[0-9]")
-		  (forward-char 1)
-		  (setq ex-token-type "minus"))
-		 (t
-		  (error "Badly formed address"))))
-	  ((looking-at "/")
-	   (forward-char 1)
-	   (set-mark (point))
-	   (let ((cont t))
-	     (while (and (not (eolp)) cont)
-	       ;;(re-search-forward "[^/]*/")
-	       (re-search-forward "[^/]*\\(/\\|\n\\)")
-	       (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
-		   (setq cont nil))))
-	   (backward-char 1)
-	   (setq ex-token (buffer-substring (point) (mark)))
-	   (if (looking-at "/") (forward-char 1))
-	   (setq ex-token-type "search-forward"))
-	  ((looking-at "\\?")
-	   (forward-char 1)
-	   (set-mark (point))
-	   (let ((cont t))
-	     (while (and (not (eolp)) cont)
-	       ;;(re-search-forward "[^\\?]*\\?")
-	       (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
-	       (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
-		   (setq cont nil))
-	       (backward-char 1)
-	       (if (not (looking-at "\n")) (forward-char 1))))
-	   (setq ex-token-type "search-backward")
-	   (setq ex-token (buffer-substring (1- (point)) (mark))))
-	  ((looking-at ",")
-	   (forward-char 1)
-	   (setq ex-token-type "comma"))
-	  ((looking-at ";")
-	   (forward-char 1)
-	   (setq ex-token-type "semi-colon"))
-	  ((looking-at "[!=><&~]")
-	   (setq ex-token-type "command")
-	   (setq ex-token (char-to-string (following-char)))
-	   (forward-char 1))
-	  ((looking-at "'")
-	   (setq ex-token-type "goto-mark")
-	   (forward-char 1)
-	   (cond ((looking-at "'") (setq ex-token nil))
-		 ((looking-at "[a-z]") (setq ex-token (following-char)))
-		 (t (error "Marks are ' and a-z")))
-	   (forward-char 1))
-	  ((looking-at "\n")
-	   (setq ex-token-type "end-mark")
-	   (setq ex-token "goto"))
-	  (t
-	   (error "illegal token")))))
-
-(defun vip-ex (&optional string)
-  "ex commands within VIP."
-  (interactive)
-  (or string
-      (setq ex-g-flag nil
-	    ex-g-variant nil))
-  (let ((com-str (or string (vip-read-string ":")))
-	(address nil) (cont t) (dot (point)))
-    (save-window-excursion
-      (set-buffer (get-buffer-create " *ex-working-space*"))
-      (delete-region (point-min) (point-max))
-      (insert com-str "\n")
-      (goto-char (point-min)))
-    (setq ex-token-type "")
-    (setq ex-addresses nil)
-    (while cont
-      (vip-get-ex-token)
-      (cond ((or (string= ex-token-type "command")
-		 (string= ex-token-type "end-mark"))
-	     (if address (setq ex-addresses (cons address ex-addresses)))
-	     (cond ((string= ex-token "global")
-		    (ex-global nil)
-		    (setq cont nil))
-		   ((string= ex-token "v")
-		    (ex-global t)
-		    (setq cont nil))
-		   (t
-		    (vip-execute-ex-command)
-		    (save-window-excursion
-		      (set-buffer " *ex-working-space*")
-		      (skip-chars-forward " \t")
-		      (cond ((looking-at "|")
-			     (forward-char 1))
-			    ((looking-at "\n")
-			     (setq cont nil))
-			    (t (error "Extra character at end of a command")))))))
-	    ((string= ex-token-type "non-command")
-	     (error (format "%s: Not an editor command" ex-token)))
-	    ((string= ex-token-type "whole")
-	     (setq ex-addresses
-		   (cons (point-max) (cons (point-min) ex-addresses))))
-	    ((string= ex-token-type "comma")
-	     (setq ex-addresses
-		   (cons (if (null address) (point) address) ex-addresses)))
-	    ((string= ex-token-type "semi-colon")
-	     (if address (setq dot address))
-	     (setq ex-addresses
-		   (cons (if (null address) (point) address) ex-addresses)))
-	    (t (let ((ans (vip-get-ex-address-subr address dot)))
-		 (if ans (setq address ans))))))))
-
-(defun vip-get-ex-pat ()
-  "get a regular expression and set ex-variant if found"
-  (save-window-excursion
-    (set-buffer " *ex-working-space*")
-    (skip-chars-forward " \t")
-    (if (looking-at "!")
-	(progn
-	  (setq ex-g-variant (not ex-g-variant)
-		ex-g-flag (not ex-g-flag))
-	  (forward-char 1)
-	  (skip-chars-forward " \t")))
-    (if (looking-at "/")
-	(progn
-	  (forward-char 1)
-	  (set-mark (point))
-	  (let ((cont t))
-	    (while (and (not (eolp)) cont)
-	      (re-search-forward "[^/]*\\(/\\|\n\\)")
-	      ;;(re-search-forward "[^/]*/")
-	      (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
-		  (setq cont nil))))
-	  (setq ex-token
-		(if (= (mark) (point)) ""
-		  (buffer-substring (1- (point)) (mark))))
-	  (backward-char 1))
-      (setq ex-token nil))))
-
-(defun vip-get-ex-command ()
-  "get an ex command"
-  (save-window-excursion
-    (set-buffer " *ex-working-space*")
-    (if (looking-at "/") (forward-char 1))
-    (skip-chars-forward " \t")
-    (cond ((looking-at "[a-z]")
-	   (vip-get-ex-com-subr)
-	   (if (string= ex-token-type "non-command")
-	       (error "%s: not an editor command" ex-token)))
-	  ((looking-at "[!=><&~]")
-	   (setq ex-token (char-to-string (following-char)))
-	   (forward-char 1))
-	  (t (error "Could not find an ex command")))))
-
-(defun vip-get-ex-opt-gc ()
-  "get an ex option g or c"
-  (save-window-excursion
-    (set-buffer " *ex-working-space*")
-    (if (looking-at "/") (forward-char 1))
-    (skip-chars-forward " \t")
-    (cond ((looking-at "g")
-	   (setq ex-token "g")
-	   (forward-char 1)
-	   t)
-	  ((looking-at "c")
-	   (setq ex-token "c")
-	   (forward-char 1)
-	   t)
-	  (t nil))))
-
-(defun vip-default-ex-addresses (&optional whole-flag)
-  "compute default addresses.  whole-flag means whole buffer."
-  (cond ((null ex-addresses)
-	 (setq ex-addresses
-	       (if whole-flag
-		   (cons (point-max) (cons (point-min) nil))
-		 (cons (point) (cons (point) nil)))))
-	((null (cdr ex-addresses))
-	 (setq ex-addresses
-	       (cons (car ex-addresses) ex-addresses)))))
-
-(defun vip-get-ex-address ()
-  "get an ex-address as a marker and set ex-flag if a flag is found"
-  (let ((address (point-marker)) (cont t))
-    (setq ex-token "")
-    (setq ex-flag nil)
-    (while cont
-      (vip-get-ex-token)
-      (cond ((string= ex-token-type "command")
-	     (if (or (string= ex-token "print") (string= ex-token "list")
-		     (string= ex-token "#"))
-		 (progn
-		   (setq ex-flag t)
-		   (setq cont nil))
-	     (error "address expected")))
-	    ((string= ex-token-type "end-mark")
-	     (setq cont nil))
-	    ((string= ex-token-type "whole")
-	     (error "a trailing address is expected"))
-	    ((string= ex-token-type "comma")
-	     (error "Extra characters after an address"))
-	    (t (let ((ans (vip-get-ex-address-subr address (point-marker))))
-		 (if ans (setq address ans))))))
-    address))
-
-(defun vip-get-ex-address-subr (old-address dot)
-  "returns an address as a point"
-  (let ((address nil))
-    (if (null old-address) (setq old-address dot))
-    (cond ((string= ex-token-type "dot")
-	   (setq address dot))
-	  ((string= ex-token-type "add-number")
-	   (save-excursion
-	     (goto-char old-address)
-	     (forward-line (if (= old-address 0) (1- ex-token) ex-token))
-	     (setq address (point-marker))))
-	  ((string= ex-token-type "sub-number")
-	   (save-excursion
-	     (goto-char old-address)
-	     (forward-line (- ex-token))
-	     (setq address (point-marker))))
-	  ((string= ex-token-type "abs-number")
-	   (save-excursion
-	     (goto-char (point-min))
-	     (if (= ex-token 0) (setq address 0)
-	       (forward-line (1- ex-token))
-	       (setq address (point-marker)))))
-	  ((string= ex-token-type "end")
-	   (setq address (point-max-marker)))
-	  ((string= ex-token-type "plus") t);; do nothing
-	  ((string= ex-token-type "minus") t);; do nothing
-	  ((string= ex-token-type "search-forward")
-	   (save-excursion
-	     (ex-search-address t)
-	     (setq address (point-marker))))
-	  ((string= ex-token-type "search-backward")
-	   (save-excursion
-	     (ex-search-address nil)
-	     (setq address (point-marker))))
-	  ((string= ex-token-type "goto-mark")
-	   (save-excursion
-	     (if (null ex-token)
-		 (exchange-point-and-mark)
-	       (goto-char (register-to-point (- ex-token (- ?a ?\C-a)))))
-	     (setq address (point-marker)))))
-    address))
-
-(defun ex-search-address (forward)
-  "search pattern and set address"
-  (if (string= ex-token "")
-      (if (null vip-s-string) (error "No previous search string")
-	(setq ex-token vip-s-string))
-    (setq vip-s-string ex-token))
-  (if forward
-      (progn
-	(forward-line 1)
-	(re-search-forward ex-token))
-    (forward-line -1)
-    (re-search-backward ex-token)))
-
-(defun vip-get-ex-buffer ()
-  "get a buffer name and set ex-count and ex-flag if found"
-  (setq ex-buffer nil)
-  (setq ex-count nil)
-  (setq ex-flag nil)
-  (save-window-excursion
-    (set-buffer " *ex-working-space*")
-    (skip-chars-forward " \t")
-    (if (looking-at "[a-zA-Z]")
-	(progn
-	  (setq ex-buffer (following-char))
-	  (forward-char 1)
-	  (skip-chars-forward " \t")))
-    (if (looking-at "[0-9]")
-	(progn
-	  (set-mark (point))
-	  (re-search-forward "[0-9][0-9]*")
-	  (setq ex-count (string-to-int (buffer-substring (point) (mark))))
-	  (skip-chars-forward " \t")))
-    (if (looking-at "[pl#]")
-	(progn
-	  (setq ex-flag t)
-	  (forward-char 1)))
-    (if (not (looking-at "[\n|]"))
-	(error "Illegal extra characters"))))
-
-(defun vip-get-ex-count ()
-  (setq ex-variant nil
-	ex-count nil
-	ex-flag nil)
-  (save-window-excursion
-    (set-buffer " *ex-working-space*")
-    (skip-chars-forward " \t")
-    (if (looking-at "!")
-	(progn
-	  (setq ex-variant t)
-	  (forward-char 1)))
-    (skip-chars-forward " \t")
-    (if (looking-at "[0-9]")
-	(progn
-	  (set-mark (point))
-	  (re-search-forward "[0-9][0-9]*")
-	  (setq ex-count (string-to-int (buffer-substring (point) (mark))))
-	  (skip-chars-forward " \t")))
-    (if (looking-at "[pl#]")
-	(progn
-	  (setq ex-flag t)
-	  (forward-char 1)))
-    (if (not (looking-at "[\n|]"))
-	(error "Illegal extra characters"))))
-
-(defun vip-get-ex-file ()
-  "get a file name and set ex-variant, ex-append and ex-offset if found"
-  (setq ex-file nil
-	ex-variant nil
-	ex-append nil
-	ex-offset nil)
-  (save-window-excursion
-    (set-buffer " *ex-working-space*")
-    (skip-chars-forward " \t")
-    (if (looking-at "!")
-	(progn
-	  (setq ex-variant t)
-	  (forward-char 1)
-	  (skip-chars-forward " \t")))
-    (if (looking-at ">>")
-	(progn
-	  (setq ex-append t
-		ex-variant t)
-	  (forward-char 2)
-	  (skip-chars-forward " \t")))
-    (if (looking-at "+")
-	(progn
-	  (forward-char 1)
-	  (set-mark (point))
-	  (re-search-forward "[ \t\n]")
-	  (backward-char 1)
-	  (setq ex-offset (buffer-substring (point) (mark)))
-	  (forward-char 1)
-	  (skip-chars-forward " \t")))
-    (set-mark (point))
-    (re-search-forward "[ \t\n]")
-    (backward-char 1)
-    (setq ex-file (buffer-substring (point) (mark)))))
-
-(defun vip-execute-ex-command ()
-  "execute ex command using the value of addresses."
-  (cond ((string= ex-token "goto") (ex-goto))
-	((string= ex-token "copy") (ex-copy nil))
-	((string= ex-token "delete") (ex-delete))
-	((string= ex-token "edit") (ex-edit))
-	((string= ex-token "file") (vip-info-on-file))
-	;((string= ex-token "global") (ex-global nil))
-	((string= ex-token "join") (ex-line "join"))
-	((string= ex-token "k") (ex-mark))
-	((string= ex-token "mark") (ex-mark))
-	((string= ex-token "map") (ex-map))
-	((string= ex-token "move") (ex-copy t))
-	((string= ex-token "put") (ex-put))
-	((string= ex-token "quit") (ex-quit))
-	((string= ex-token "read") (ex-read))
-	((string= ex-token "set") (ex-set))
-	((string= ex-token "shell") (ex-shell))
-	((string= ex-token "substitute") (ex-substitute))
-	((string= ex-token "stop") (suspend-emacs))
-	((string= ex-token "t") (ex-copy nil))
-	((string= ex-token "tag") (ex-tag))
-	((string= ex-token "undo") (vip-undo))
-	((string= ex-token "unmap") (ex-unmap))
-	;((string= ex-token "v") (ex-global t))
-	((string= ex-token "version") (vip-version))
-	((string= ex-token "visual") (ex-edit))
-	((string= ex-token "write") (ex-write nil))
-	((string= ex-token "wq") (ex-write t))
-	((string= ex-token "yank") (ex-yank))
-	((string= ex-token "!") (ex-command))
-	((string= ex-token "=") (ex-line-no))
-	((string= ex-token ">") (ex-line "right"))
-	((string= ex-token "<") (ex-line "left"))
-	((string= ex-token "&") (ex-substitute t))
-	((string= ex-token "~") (ex-substitute t t))
-	((or (string= ex-token "append")
-	     (string= ex-token "args")
-	     (string= ex-token "change")
-	     (string= ex-token "insert")
-	     (string= ex-token "open")
-	     )
-	 (error "%s: no such command from VIP" ex-token))
-	((or (string= ex-token "abbreviate")
-	     (string= ex-token "list")
-	     (string= ex-token "next")
-	     (string= ex-token "print")
-	     (string= ex-token "preserve")
-	     (string= ex-token "recover")
-	     (string= ex-token "rewind")
-	     (string= ex-token "source")
-	     (string= ex-token "unabbreviate")
-	     (string= ex-token "xit")
-	     (string= ex-token "z")
-	     )
-	 (error "%s: not implemented in VIP" ex-token))
-	(t (error "%s: Not an editor command" ex-token))))
-
-(defun ex-goto ()
-  "ex goto command"
-  (if (null ex-addresses)
-      (setq ex-addresses (cons (point) nil)))
-  (push-mark (point))
-  (goto-char (car ex-addresses))
-  (beginning-of-line))
-
-(defun ex-copy (del-flag)
-  "ex copy and move command.  DEL-FLAG means delete."
-  (vip-default-ex-addresses)
-  (let ((address (vip-get-ex-address))
-	(end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-    (goto-char end)
-    (save-excursion
-      (set-mark beg)
-      (vip-enlarge-region (mark) (point))
-      (if del-flag (kill-region (point) (mark))
-	(copy-region-as-kill (point) (mark)))
-      (if ex-flag
-	  (progn
-	    (with-output-to-temp-buffer "*copy text*"
-	      (princ
-	       (if (or del-flag ex-g-flag ex-g-variant)
-		   (current-kill 0)
-		 (buffer-substring (point) (mark)))))
-	    (condition-case nil
-		(progn
-		  (vip-read-string "[Hit return to continue] ")
-		  (save-excursion (kill-buffer "*copy text*")))
-	      (quit
-	       (save-excursion (kill-buffer "*copy text*"))
-	       (signal 'quit nil))))))
-      (if (= address 0)
-	  (goto-char (point-min))
-	(goto-char address)
-	(forward-line 1))
-      (insert (current-kill 0))))
-
-(defun ex-delete ()
-  "ex delete"
-  (vip-default-ex-addresses)
-  (vip-get-ex-buffer)
-  (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-    (if (> beg end) (error "First address exceeds second"))
-    (save-excursion
-      (vip-enlarge-region beg end)
-      (exchange-point-and-mark)
-      (if ex-count
-	  (progn
-	    (set-mark (point))
-	    (forward-line (1- ex-count)))
-	(set-mark end))
-      (vip-enlarge-region (point) (mark))
-      (if ex-flag
-	  ;; show text to be deleted and ask for confirmation
-	  (progn
-	    (with-output-to-temp-buffer " *delete text*"
-	      (princ (buffer-substring (point) (mark))))
-	    (condition-case conditions
-		(vip-read-string "[Hit return to continue] ")
-	      (quit
-	       (save-excursion (kill-buffer " *delete text*"))
-	       (error "")))
-	    (save-excursion (kill-buffer " *delete text*")))
-	(if ex-buffer
-	    (if (and (<= ?A ex-buffer) (<= ex-buffer ?Z))
-		(vip-append-to-register
-		 (+ ex-buffer 32) (point) (mark))
-	      (copy-to-register ex-buffer (point) (mark) nil)))
-	(delete-region (point) (mark))))))
-
-(defun ex-edit ()
-  "ex-edit"
-  (vip-get-ex-file)
-  (if (and (not ex-variant) (buffer-modified-p) buffer-file-name)
-      (error "No write since last change \(:e! overrides\)"))
-  (vip-change-mode-to-emacs)
-  (set-buffer
-   (find-file-noselect (concat default-directory ex-file)))
-  (vip-change-mode-to-vi)
-  (goto-char (point-min))
-  (if ex-offset
-      (progn
-	(save-window-excursion
-	  (set-buffer " *ex-working-space*")
-	  (delete-region (point-min) (point-max))
-	  (insert ex-offset "\n")
-	  (goto-char (point-min)))
-	(goto-char (vip-get-ex-address))
-	(beginning-of-line))))
-
-(defun ex-global (variant)
-  "ex global command"
-  (if (or ex-g-flag ex-g-variant)
-      (error "Global within global not allowed")
-    (if variant
-	(setq ex-g-flag nil
-	      ex-g-variant t)
-      (setq ex-g-flag t
-	    ex-g-variant nil)))
-  (vip-get-ex-pat)
-  (if (null ex-token)
-      (error "Missing regular expression for global command"))
-  (if (string= ex-token "")
-      (if (null vip-s-string) (error "No previous search string")
-	(setq ex-g-pat vip-s-string))
-    (setq ex-g-pat ex-token
-	  vip-s-string ex-token))
-  (if (null ex-addresses)
-      (setq ex-addresses (list (point-max) (point-min))))
-  (let ((marks nil) (mark-count 0)
-	com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-    (if (> beg end) (error "First address exceeds second"))
-    (save-excursion
-      (vip-enlarge-region beg end)
-      (exchange-point-and-mark)
-      (let ((cont t) (limit (point-marker)))
-	(exchange-point-and-mark)
-	;; skip the last line if empty
-	(beginning-of-line)
-	(if (and (eobp) (not (bobp))) (backward-char 1))
-	(while (and cont (not (bobp)) (>= (point) limit))
-	  (beginning-of-line)
-	  (set-mark (point))
-	  (end-of-line)
-	  (let ((found (re-search-backward ex-g-pat (mark) t)))
-	    (if (or (and ex-g-flag found)
-		    (and ex-g-variant (not found)))
-		(progn
-		  (end-of-line)
-		  (setq mark-count (1+ mark-count))
-		  (setq marks (cons (point-marker) marks)))))
-	  (beginning-of-line)
-	  (if (bobp) (setq cont nil)
-	    (forward-line -1)
-	    (end-of-line)))))
-  (save-window-excursion
-    (set-buffer " *ex-working-space*")
-    (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
-  (while marks
-    (goto-char (car marks))
-    ; report progress of execution on a slow machine.
-    ;(message "Executing global command...")
-    ;(if (zerop (% mark-count 10))
-	;(message "Executing global command...%d" mark-count))
-    (vip-ex com-str)
-    (setq mark-count (1- mark-count))
-    (setq marks (cdr marks)))))
-  ;(message "Executing global command...done")))
-
-(defun ex-line (com)
-  "ex line commands.  COM is join, shift-right or shift-left."
-  (vip-default-ex-addresses)
-  (vip-get-ex-count)
-  (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point)
-    (if (> beg end) (error "First address exceeds second"))
-    (save-excursion
-      (vip-enlarge-region beg end)
-      (exchange-point-and-mark)
-      (if ex-count
-	  (progn
-	    (set-mark (point))
-	    (forward-line ex-count)))
-      (if ex-flag
-	  ;; show text to be joined and ask for confirmation
-	  (progn
-	    (with-output-to-temp-buffer " *text*"
-	      (princ (buffer-substring (point) (mark))))
-	    (condition-case conditions
-		(progn
-		  (vip-read-string "[Hit return to continue] ")
-		  (ex-line-subr com (point) (mark)))
-	      (quit
-	       (ding)))
-	    (save-excursion (kill-buffer " *text*")))
-	(ex-line-subr com (point) (mark)))
-      (setq point (point)))
-    (goto-char (1- point))
-    (beginning-of-line)))
-
-(defun ex-line-subr (com beg end)
-  (cond ((string= com "join")
-	 (goto-char (min beg end))
-	 (while (and (not (eobp)) (< (point) (max beg end)))
-	   (end-of-line)
-	   (if (and (<= (point) (max beg end)) (not (eobp)))
-	       (progn
-		 (forward-line 1)
-		 (delete-region (point) (1- (point)))
-		 (if (not ex-variant) (fixup-whitespace))))))
-	((or (string= com "right") (string= com "left"))
-	 (indent-rigidly
-	  (min beg end) (max beg end)
-	  (if (string= com "right") vip-shift-width (- vip-shift-width)))
-	 (goto-char (max beg end))
-	 (end-of-line)
-	 (forward-char 1))))
-
-(defun ex-mark ()
-  "ex mark"
-  (let (char)
-    (if (null ex-addresses)
-	(setq ex-addresses
-	      (cons (point) nil)))
-    (save-window-excursion
-      (set-buffer " *ex-working-space*")
-      (skip-chars-forward " \t")
-      (if (looking-at "[a-z]")
-	  (progn
-	    (setq char (following-char))
-	    (forward-char 1)
-	    (skip-chars-forward " \t")
-	    (if (not (looking-at "[\n|]"))
-		(error "Extra characters at end of \"k\" command")))
-	(if (looking-at "[\n|]")
-	    (error "\"k\" requires a following letter")
-	  (error "Mark must specify a letter"))))
-    (save-excursion
-      (goto-char (car ex-addresses))
-      (point-to-register (- char (- ?a ?\C-a)) nil))))
-
-(defun ex-map ()
-  "ex map"
-  (let (char string)
-    (save-window-excursion
-      (set-buffer " *ex-working-space*")
-      (skip-chars-forward " \t")
-      (setq char (char-to-string (following-char)))
-      (forward-char 1)
-      (skip-chars-forward " \t")
-      (if (looking-at "[\n|]") (error "Missing rhs"))
-      (set-mark (point))
-      (end-of-buffer)
-      (backward-char 1)
-      (setq string (buffer-substring (mark) (point))))
-    (if (not (lookup-key ex-map char))
-	(define-key ex-map char
-	  (or (lookup-key vip-mode-map char) 'vip-nil)))
-    (define-key vip-mode-map char
-      (eval
-       (list 'quote
-	     (cons 'lambda
-		   (list '(count)
-			 '(interactive "p")
-			 (list 'execute-kbd-macro string 'count))))))))
-
-(defun ex-unmap ()
-  "ex unmap"
-  (let (char)
-    (save-window-excursion
-      (set-buffer " *ex-working-space*")
-      (skip-chars-forward " \t")
-      (setq char (char-to-string (following-char)))
-      (forward-char 1)
-      (skip-chars-forward " \t")
-      (if (not (looking-at "[\n|]")) (error "Macro must be a character")))
-    (if (not (lookup-key ex-map char))
-	(error "That macro wasn't mapped"))
-    (define-key vip-mode-map char (lookup-key ex-map char))
-    (define-key ex-map char nil)))
-
-(defun ex-put ()
-  "ex put"
-  (let ((point (if (null ex-addresses) (point) (car ex-addresses))))
-    (vip-get-ex-buffer)
-    (setq vip-use-register ex-buffer)
-    (goto-char point)
-    (if (= point 0) (vip-Put-back 1) (vip-put-back 1))))
-
-(defun ex-quit ()
-  "ex quit"
-  (let (char)
-    (save-window-excursion
-      (set-buffer " *ex-working-space*")
-      (skip-chars-forward " \t")
-      (setq char (following-char)))
-    (if (= char ?!) (kill-emacs t) (save-buffers-kill-emacs))))
-
-(defun ex-read ()
-  "ex read"
-  (let ((point (if (null ex-addresses) (point) (car ex-addresses)))
-	(variant nil) command file)
-    (goto-char point)
-    (if (not (= point 0)) (next-line 1))
-    (beginning-of-line)
-    (save-window-excursion
-      (set-buffer " *ex-working-space*")
-      (skip-chars-forward " \t")
-      (if (looking-at "!")
-	  (progn
-	    (setq variant t)
-	    (forward-char 1)
-	    (skip-chars-forward " \t")
-	    (set-mark (point))
-	    (end-of-line)
-	    (setq command (buffer-substring (mark) (point))))
-	(set-mark (point))
-	(re-search-forward "[ \t\n]")
-	(backward-char 1)
-	(setq file (buffer-substring (point) (mark)))))
-      (if variant
-	  (shell-command command t)
-	(insert-file file))))
-
-(defun ex-set ()
-  (eval (list 'setq
-	      (read-variable "Variable: ")
-	      (eval (read-minibuffer "Value: ")))))
-
-(defun ex-shell ()
-  "ex shell"
-  (vip-change-mode-to-emacs)
-  (shell))
-
-(defun ex-substitute (&optional repeat r-flag) 
-  "ex substitute.
-If REPEAT use previous reg-exp which is ex-reg-exp or
-vip-s-string"
-  (let (pat repl (opt-g nil) (opt-c nil) (matched-pos nil))
-    (if repeat (setq ex-token nil) (vip-get-ex-pat))
-    (if (null ex-token)
-	(setq pat (if r-flag vip-s-string ex-reg-exp)
-	      repl ex-repl)
-      (setq pat (if (string= ex-token "") vip-s-string ex-token))
-      (setq vip-s-string pat
-	    ex-reg-exp pat)
-      (vip-get-ex-pat)
-      (if (null ex-token)
-	  (setq ex-token ""
-		ex-repl "")
-	(setq repl ex-token
-	      ex-repl ex-token)))
-    (while (vip-get-ex-opt-gc)
-      (if (string= ex-token "g") (setq opt-g t) (setq opt-c t)))
-    (vip-get-ex-count)
-    (if ex-count
-	(save-excursion
-	  (if ex-addresses (goto-char (car ex-addresses)))
-	  (set-mark (point))
-	  (forward-line (1- ex-count))
-	  (setq ex-addresses (cons (point) (cons (mark) nil))))
-      (if (null ex-addresses)
-	  (setq ex-addresses (cons (point) (cons (point) nil)))
-	(if (null (cdr ex-addresses))
-	    (setq ex-addresses (cons (car ex-addresses) ex-addresses)))))
-    ;(setq G opt-g)
-    (let ((beg (car ex-addresses)) (end (car (cdr ex-addresses)))
-	  (cont t) eol-mark)
-      (save-excursion
-	(vip-enlarge-region beg end)
-	(let ((limit (save-excursion
-		       (goto-char (max (point) (mark)))
-		       (point-marker))))
-	  (goto-char (min (point) (mark)))
-	  (while (< (point) limit)
-	    (end-of-line)
-	    (setq eol-mark (point-marker))
-	    (beginning-of-line)
-	    (if opt-g
-		(progn
-		  (while (and (not (eolp))
-			      (re-search-forward pat eol-mark t))
-		    (if (or (not opt-c) (y-or-n-p "Replace? "))
-			(progn
-			  (setq matched-pos (point))
-			  (replace-match repl))))
-		  (end-of-line)
-		  (forward-char))
-	      (if (and (re-search-forward pat eol-mark t)
-		       (or (not opt-c) (y-or-n-p "Replace? ")))
-		  (progn
-		    (setq matched-pos (point))
-		    (replace-match repl)))
-	      (end-of-line)
-	      (forward-char))))))
-    (if matched-pos (goto-char matched-pos))
-    (beginning-of-line)
-    (if opt-c (message "done"))))
-
-(defun ex-tag ()
-  "ex tag"
-  (let (tag)
-    (save-window-excursion
-      (set-buffer " *ex-working-space*")
-      (skip-chars-forward " \t")
-      (set-mark (point))
-      (skip-chars-forward "^ |\t\n")
-      (setq tag (buffer-substring (mark) (point))))
-    (if (not (string= tag "")) (setq ex-tag tag))
-    (vip-change-mode-to-emacs)
-    (condition-case conditions
-	(progn
-	  (if (string= tag "")
-	      (find-tag ex-tag t)
-	    (find-tag-other-window ex-tag))
-	  (vip-change-mode-to-vi))
-      (error
-       (vip-change-mode-to-vi)
-       (vip-message-conditions conditions)))))
-
-(defun ex-write (q-flag)
-  "ex write"
-  (vip-default-ex-addresses t)
-  (vip-get-ex-file)
-  (if (string= ex-file "")
-      (progn
-	(if (null buffer-file-name)
-	    (error "No file associated with this buffer"))
-	(setq ex-file buffer-file-name))
-    (setq ex-file (expand-file-name ex-file)))
-  (if (and (not (string= ex-file (buffer-file-name)))
-	   (file-exists-p ex-file)
-	   (not ex-variant))
-      (error "\"%s\" File exists - use w! to override" ex-file))
-  (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-    (if (> beg end) (error "First address exceeds second"))
-    (save-excursion
-      (vip-enlarge-region beg end)
-      (write-region (point) (mark) ex-file ex-append t)))
-  (if (null buffer-file-name) (setq buffer-file-name ex-file))
-  (if q-flag (save-buffers-kill-emacs)))
-
-(defun ex-yank ()
-  "ex yank"
-  (vip-default-ex-addresses)
-  (vip-get-ex-buffer)
-  (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-    (if (> beg end) (error "First address exceeds second"))
-    (save-excursion
-      (vip-enlarge-region beg end)
-      (exchange-point-and-mark)
-      (if (or ex-g-flag ex-g-variant) (error "Can't yank within global"))
-      (if ex-count
-	  (progn
-	    (set-mark (point))
-	    (forward-line (1- ex-count)))
-	(set-mark end))
-      (vip-enlarge-region (point) (mark))
-      (if ex-flag (error "Extra characters at end of command"))
-      (if ex-buffer
-	  (copy-to-register ex-buffer (point) (mark) nil))
-      (copy-region-as-kill (point) (mark)))))
-
-(defun ex-command ()
-  "execute shell command"
-  (let (command)
-    (save-window-excursion
-      (set-buffer " *ex-working-space*")
-      (skip-chars-forward " \t")
-      (set-mark (point))
-      (end-of-line)
-      (setq command (buffer-substring (mark) (point))))
-    (if (null ex-addresses)
-	(shell-command command)
-      (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-	(if (null beg) (setq beg end))
-	(save-excursion
-	  (goto-char beg)
-	  (set-mark end)
-	  (vip-enlarge-region (point) (mark))
-	  (shell-command-on-region (point) (mark) command t))
-	(goto-char beg)))))
-
-(defun ex-line-no ()
-  "print line number"
-  (message "%d"
-	   (1+ (count-lines
-		(point-min)
-		(if (null ex-addresses) (point-max) (car ex-addresses))))))
-
-(if (file-exists-p vip-startup-file) (load vip-startup-file))
-
-;;; vip.el ends here
diff --git a/lisp/emulation/viper-ex.el b/lisp/emulation/viper-ex.el
deleted file mode 100644
index 93846321476..00000000000
--- a/lisp/emulation/viper-ex.el
+++ /dev/null
@@ -1,2029 +0,0 @@
-;;; viper-ex.el --- functions implementing the Ex commands for Viper
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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.
-
-
-;; Code
-
-(require 'viper-util)
-
-;; Compiler pacifier
-(defvar read-file-name-map)
-;; end compiler pacifier
-
-;;; Variables
-
-(defconst vip-ex-work-buf-name " *ex-working-space*")
-(defconst vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
-(defconst vip-ex-tmp-buf-name " *ex-tmp*")
-
-
-;;; Variable completion in :set command
-  
-;; The list of Ex commands. Used for completing command names.
-(defconst ex-token-alist
-  '(("!") ("=") (">") ("&") ("~")
-    ("yank") ("xit") ("WWrite") ("Write") ("write") ("wq") ("visual") 
-    ("version") ("vglobal") ("unmap") ("undo") ("tag") ("transfer") ("suspend")
-    ("substitute") ("submitReport") ("stop")  ("sr") ("source") ("shell")
-    ("set") ("rewind") ("recover") ("read") ("quit") ("pwd")
-    ("put") ("preserve") ("PreviousRelatedFile") ("RelatedFile")
-    ("next") ("Next") ("move") ("mark") ("map") ("kmark") ("join")
-    ("help") ("goto") ("global") ("file") ("edit") ("delete") ("copy")
-    ("chdir") ("cd") ("Buffer") ("buffer") ("args"))  )
-
-;; A-list of Ex variables that can be set using the :set command.
-(defconst ex-variable-alist 
-  '(("wrapscan") ("ws") ("wrapmargin") ("wm")
-    ("global-tabstop") ("gts") ("tabstop") ("ts")
-    ("showmatch") ("sm") ("shiftwidth") ("sw") ("shell") ("sh")
-    ("readonly") ("ro") 
-    ("nowrapscan") ("nows") ("noshowmatch") ("nosm")
-    ("noreadonly") ("noro") ("nomagic") ("noma")
-    ("noignorecase") ("noic")
-    ("global-noautoindent") ("gnoai") ("noautoindent") ("noai")
-    ("magic") ("ma") ("ignorecase") ("ic")
-    ("global-autoindent") ("gai") ("autoindent") ("ai")
-    ))
-
-  
-
-;; Token recognized during parsing of Ex commands (e.g., "read", "comma")
-(defvar ex-token nil)
-
-;; Type of token. 
-;; If non-nil, gives type of address; if nil, it is a command.
-(defvar ex-token-type nil)
-
-;; List of addresses passed to Ex command
-(defvar ex-addresses nil)
-
-;; It seems that this flag is used only for `#', `print', and `list', which
-;; aren't implemented. Check later.
-(defvar ex-flag nil)
-
-;; "buffer" where Ex commands keep deleted data.
-;; In Emacs terms, this is a register.
-(defvar ex-buffer nil)
-
-;; Value of ex count.
-(defvar ex-count nil)
-
-;; Flag for global command.
-(defvar ex-g-flag nil)
-
-;; If t, global command is executed on lines not matching ex-g-pat.
-(defvar ex-g-variant nil)
-
-;; Save reg-exp used in substitute.
-(defvar ex-reg-exp nil)
-
-
-;; Replace pattern for substitute.
-(defvar ex-repl nil)
-
-;; Pattern for global command.
-(defvar ex-g-pat nil)
-
-
-(defvar ex-unix-type-shell
-  (let ((case-fold-search t))
-    (and (stringp shell-file-name)
-	 (string-match
-	  (concat
-	   "\\("
-	   "csh$\\|csh.exe$"
-	   "\\|"
-	   "ksh$\\|ksh.exe$"
-	   "\\|"
-	   "^sh$\\|sh.exe$"
-	   "\\|"
-	   "[^a-z]sh$\\|[^a-z]sh.exe$"
-	   "\\|"
-	   "bash$\\|bash.exe$"
-	   "\\)")
-	  shell-file-name)))
-  "Is the user using a unix-type shell?")
-
-(defvar ex-unix-type-shell-options
-  (let ((case-fold-search t))
-    (if ex-unix-type-shell
-	(cond ((string-match "\\(csh$\\|csh.exe$\\)" shell-file-name)
-	       "-f") ; csh: do it fast
-	      ((string-match "\\(bash$\\|bash.exe$\\)" shell-file-name)
-	       "-noprofile") ; bash: ignore .profile
-	      )))
-  "Options to pass to the Unix-style shell. 
-Don't put `-c' here, as it is added automatically.")
-
-(defvar ex-nontrivial-find-file-function
-  (cond (ex-unix-type-shell 'vip-ex-nontrivial-find-file-unix)
-	((eq system-type 'emx) 'vip-ex-nontrivial-find-file-ms) ; OS/2
-	(vip-ms-style-os-p 'vip-ex-nontrivial-find-file-ms) ; a Microsoft OS
-	(vip-vms-os-p 'vip-ex-nontrivial-find-file-unix) ; VMS
-	(t  'vip-ex-nontrivial-find-file-unix) ; presumably UNIX
-	))
-
-;; Remembers the previous Ex tag.
-(defvar ex-tag nil)
-
-;; file used by Ex commands like :r, :w, :n
-(defvar ex-file nil)
-
-;; If t, tells Ex that this is a variant-command, i.e., w>>, r!, etc.
-(defvar ex-variant nil)
-
-;; Specified the offset of an Ex command, such as :read.
-(defvar ex-offset nil)
-
-;; Tells Ex that this is a w>> command.
-(defvar ex-append nil)
-
-;; File containing the shell command to be executed at Ex prompt,
-;; e.g., :r !date
-(defvar ex-cmdfile nil)
-  
-;; flag used in vip-ex-read-file-name to indicate that we may be reading
-;; multiple file names. Used for :edit and :next
-(defvar vip-keep-reading-filename nil)
-
-(defconst ex-cycle-other-window t
-  "*If t, :n and :b cycles through files and buffers in other window.
-Then :N and :B cycles in the current window. If nil, this behavior is
-reversed.")
-
-(defconst ex-cycle-through-non-files nil
-  "*Cycle through *scratch* and other buffers that don't visit any file.")
-
-;; Last shell command executed with :! command.
-(defvar vip-ex-last-shell-com nil)
-  
-;; Indicates if Minibuffer was exited temporarily in Ex-command.
-(defvar vip-incomplete-ex-cmd nil)
-  
-;; Remembers the last ex-command prompt.
-(defvar vip-last-ex-prompt "")
-
-
-;;; Code
-  
-;; Check if ex-token is an initial segment of STR
-(defun vip-check-sub (str)
-  (let ((length (length ex-token)))
-    (if (and (<= length (length str))
-  	     (string= ex-token (substring str 0 length)))
-	(setq ex-token str)
-      (setq ex-token-type 'non-command))))
-
-;; Get a complete ex command
-(defun vip-get-ex-com-subr ()
-  (let (case-fold-search)
-    (set-mark (point))
-    (re-search-forward "[a-zA-Z][a-zA-Z]*")
-    (setq ex-token-type 'command)
-    (setq ex-token (buffer-substring (point) (mark t)))
-    (exchange-point-and-mark)
-    (cond ((looking-at "a")
-	   (cond ((looking-at "ab") (vip-check-sub "abbreviate"))
-		 ((looking-at "ar") (vip-check-sub "args"))
-		 (t (vip-check-sub "append"))))
-	  ((looking-at "h") (vip-check-sub "help"))
-	  ((looking-at "c")
-	   (cond ((looking-at "cd") (vip-check-sub "cd"))
-		 ((looking-at "ch") (vip-check-sub "chdir"))
-		 ((looking-at "co") (vip-check-sub "copy"))
-		 (t (vip-check-sub "change"))))
-	  ((looking-at "d") (vip-check-sub "delete"))
-	  ((looking-at "b") (vip-check-sub "buffer"))
-	  ((looking-at "B") (vip-check-sub "Buffer"))
-	  ((looking-at "e")
-	   (if (looking-at "ex") (vip-check-sub "ex")
-	     (vip-check-sub "edit")))
-	  ((looking-at "f") (vip-check-sub "file"))
-	  ((looking-at "g") (vip-check-sub "global"))
-	  ((looking-at "i") (vip-check-sub "insert"))
-	  ((looking-at "j") (vip-check-sub "join"))
-	  ((looking-at "l") (vip-check-sub "list"))
-	  ((looking-at "m")
-	   (cond ((looking-at "map") (vip-check-sub "map"))
-		 ((looking-at "mar") (vip-check-sub "mark"))
-		 (t (vip-check-sub "move"))))
-	  ((looking-at "k[a-z][^a-z]")
-	   (setq ex-token "kmark")
-	   (forward-char 1)
-	   (exchange-point-and-mark))   ; this is canceled out by another
-					; exchange-point-and-mark at the end
-	  ((looking-at "k") (vip-check-sub "kmark"))
-	  ((looking-at "n") (if (looking-at "nu")
-				(vip-check-sub "number")
-			      (vip-check-sub "next")))
-	  ((looking-at "N") (vip-check-sub "Next"))
-	  ((looking-at "o") (vip-check-sub "open"))
-	  ((looking-at "p")
-	   (cond ((looking-at "pre") (vip-check-sub "preserve"))
-		 ((looking-at "pu") (vip-check-sub "put"))
-		 ((looking-at "pw") (vip-check-sub "pwd"))
-		 (t (vip-check-sub "print"))))
-	  ((looking-at "P") (vip-check-sub "PreviousRelatedFile"))
-	  ((looking-at "R") (vip-check-sub "RelatedFile"))
-	  ((looking-at "q") (vip-check-sub "quit"))
-	  ((looking-at "r")
-	   (cond ((looking-at "rec") (vip-check-sub "recover"))
-		 ((looking-at "rew") (vip-check-sub "rewind"))
-		 (t (vip-check-sub "read"))))
-	  ((looking-at "s")
-	   (cond ((looking-at "se") (vip-check-sub "set"))
-		 ((looking-at "sh") (vip-check-sub "shell"))
-		 ((looking-at "so") (vip-check-sub "source"))
-		 ((looking-at "sr") (vip-check-sub "sr"))
-		 ((looking-at "st") (vip-check-sub "stop"))
-		 ((looking-at "sus") (vip-check-sub "suspend"))
-		 ((looking-at "subm") (vip-check-sub "submitReport"))
-		 (t (vip-check-sub "substitute"))))
-	  ((looking-at "t")
-	   (if (looking-at "ta") (vip-check-sub "tag")
-	     (vip-check-sub "transfer")))
-	  ((looking-at "u")
-	   (cond ((looking-at "una") (vip-check-sub "unabbreviate"))
-		 ((looking-at "unm") (vip-check-sub "unmap"))
-		 (t (vip-check-sub "undo"))))
-	  ((looking-at "v")
-	   (cond ((looking-at "ve") (vip-check-sub "version"))
-		 ((looking-at "vi") (vip-check-sub "visual"))
-		 (t (vip-check-sub "vglobal"))))
-	  ((looking-at "w")
-	   (if (looking-at "wq") (vip-check-sub "wq")
-	     (vip-check-sub "write")))
-	  ((looking-at "W")
-	   (if (looking-at "WW") 
-	       (vip-check-sub "WWrite")
-	     (vip-check-sub "Write")))
-	  ((looking-at "x") (vip-check-sub "xit"))
-	  ((looking-at "y") (vip-check-sub "yank"))
-	  ((looking-at "z") (vip-check-sub "z")))
-    (exchange-point-and-mark)
-    ))
-
-;; Get an ex-token which is either an address or a command.
-;; A token has a type, \(command, address, end-mark\), and a value
-(defun vip-get-ex-token ()
-  (save-window-excursion
-    (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-    (set-buffer vip-ex-work-buf)
-    (skip-chars-forward " \t|")
-    (cond ((looking-at "#")
-	   (setq ex-token-type 'command)
-	   (setq ex-token (char-to-string (following-char)))
-	   (forward-char 1))
-	  ((looking-at "[a-z]") (vip-get-ex-com-subr))
-	  ((looking-at "\\.")
-	   (forward-char 1)
-	   (setq ex-token-type 'dot))
-	  ((looking-at "[0-9]")
-	   (set-mark (point))
-	   (re-search-forward "[0-9]*")
-	   (setq ex-token-type
-		 (cond ((eq ex-token-type 'plus) 'add-number)
-		       ((eq ex-token-type 'minus) 'sub-number)
-		       (t 'abs-number)))
-	   (setq ex-token (string-to-int (buffer-substring (point) (mark t)))))
-	  ((looking-at "\\$")
-	   (forward-char 1)
-	   (setq ex-token-type 'end))
-	  ((looking-at "%")
-	   (forward-char 1)
-	   (setq ex-token-type 'whole))
-	  ((looking-at "+")
-	   (cond ((or (looking-at "+[-+]") (looking-at "+[\n|]"))
-		  (forward-char 1)
-		  (insert "1")
-		  (backward-char 1)
-		  (setq ex-token-type 'plus))
-		 ((looking-at "+[0-9]")
-		  (forward-char 1)
-		  (setq ex-token-type 'plus))
-		 (t
-		  (error vip-BadAddress))))
-	  ((looking-at "-")
-	   (cond ((or (looking-at "-[-+]") (looking-at "-[\n|]"))
-		  (forward-char 1)
-		  (insert "1")
-		  (backward-char 1)
-		  (setq ex-token-type 'minus))
-		 ((looking-at "-[0-9]")
-		  (forward-char 1)
-		  (setq ex-token-type 'minus))
-		 (t
-		  (error vip-BadAddress))))
-	  ((looking-at "/")
-	   (forward-char 1)
-	   (set-mark (point))
-	   (let ((cont t))
-	     (while (and (not (eolp)) cont)
-	       ;;(re-search-forward "[^/]*/")
-	       (re-search-forward "[^/]*\\(/\\|\n\\)")
-	       (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\/"))
-		   (setq cont nil))))
-	   (backward-char 1)
-	   (setq ex-token (buffer-substring (point) (mark t)))
-	   (if (looking-at "/") (forward-char 1))
-	   (setq ex-token-type 'search-forward))
-	  ((looking-at "\\?")
-	   (forward-char 1)
-	   (set-mark (point))
-	   (let ((cont t))
-	     (while (and (not (eolp)) cont)
-	       ;;(re-search-forward "[^\\?]*\\?")
-	       (re-search-forward "[^\\?]*\\(\\?\\|\n\\)")
-	       (if (not (vip-looking-back "[^\\\\]\\(\\\\\\\\\\)*\\\\\\?"))
-		   (setq cont nil))
-	       (backward-char 1)
-	       (if (not (looking-at "\n")) (forward-char 1))))
-	   (setq ex-token-type 'search-backward)
-	   (setq ex-token (buffer-substring (1- (point)) (mark t))))
-	  ((looking-at ",")
-	   (forward-char 1)
-	   (setq ex-token-type 'comma))
-	  ((looking-at ";")
-	   (forward-char 1)
-	   (setq ex-token-type 'semi-colon))
-	  ((looking-at "[!=><&~]")
-	   (setq ex-token-type 'command)
-	   (setq ex-token (char-to-string (following-char)))
-	   (forward-char 1))
-	  ((looking-at "'")
-	   (setq ex-token-type 'goto-mark)
-	   (forward-char 1)
-	   (cond ((looking-at "'") (setq ex-token nil))
-		 ((looking-at "[a-z]") (setq ex-token (following-char)))
-		 (t (error "Marks are ' and a-z")))
-	   (forward-char 1))
-	  ((looking-at "\n")
-	   (setq ex-token-type 'end-mark)
-	   (setq ex-token "goto"))
-	  (t
-	   (error vip-BadExCommand)))))
-
-;; Reads Ex command. Tries to determine if it has to exit because command
-;; is complete or invalid. If not, keeps reading command.
-(defun ex-cmd-read-exit ()
-  (interactive)
-  (setq vip-incomplete-ex-cmd t)
-  (let ((quit-regex1 (concat
-		      "\\(" "set[ \t]*"
-		      "\\|" "edit[ \t]*"
-		      "\\|" "[nN]ext[ \t]*"
-		      "\\|" "unm[ \t]*"
-		      "\\|" "^[ \t]*rep"
-		      "\\)"))
-	(quit-regex2 (concat
-		      "[a-zA-Z][ \t]*"
-		      "\\(" "!" "\\|" ">>"
-		      "\\|" "\\+[0-9]+"
-		      "\\)"
-		      "*[ \t]*$"))
-	(stay-regex (concat
-		     "\\(" "^[ \t]*$"
-		     "\\|" "[?/].*[?/].*"
-		     "\\|" "[ktgjmsz][ \t]*$"
-		     "\\|" "^[ \t]*ab.*"
-		     "\\|" "tr[ansfer \t]*"
-		     "\\|" "sr[ \t]*"
-		     "\\|" "mo.*"
-		     "\\|" "^[ \t]*k?ma[^p]*"
-		     "\\|" "^[ \t]*fi.*"
-		     "\\|" "v?gl.*"
-		     "\\|" "[vg][ \t]*$"
-		     "\\|" "jo.*"
-		     "\\|" "^[ \t]*ta.*"
-		     "\\|" "^[ \t]*una.*"
-		     "\\|" "^[ \t]*su.*"
-		     "\\|['`][a-z][ \t]*"
-		     "\\|" "![ \t]*[a-zA-Z].*"
-		     "\\)"
-		     "!*")))
-	
-    (save-window-excursion ;; put cursor at the end of the Ex working buffer
-      (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-      (set-buffer vip-ex-work-buf)
-      (goto-char (point-max)))
-    (cond ((vip-looking-back quit-regex1) (exit-minibuffer))
-	  ((vip-looking-back stay-regex)  (insert " "))
-	  ((vip-looking-back quit-regex2) (exit-minibuffer))
-	  (t (insert " ")))))
-  
-;; complete Ex command
-(defun ex-cmd-complete ()
-  (interactive)
-  (let (save-pos dist compl-list string-to-complete completion-result)
-    
-    (save-excursion
-      (setq dist (skip-chars-backward "[a-zA-Z!=>&~]")
-	    save-pos (point)))
-	
-    (if (or (= dist 0)
-	    (vip-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
-	    (vip-looking-back
-	     "^[ \t]*[a-zA-Z!=>&~][ \t]*[/?]*+[ \t]+[a-zA-Z!=>&~]+"))
-	;; Preceding characters are not the ones allowed in an Ex command
-	;; or we have typed past command name.
-	;; Note: we didn't do parsing, so there may be surprises.
-	(if (or (vip-looking-back "[a-zA-Z!=>&~][ \t]*[/?]*[ \t]*")
-		(vip-looking-back "\\([ \t]*['`][ \t]*[a-z]*\\)")
-		(looking-at "[^ \t\n\C-m]"))
-	    nil
-	  (with-output-to-temp-buffer "*Completions*" 
-	    (display-completion-list
-	     (vip-alist-to-list ex-token-alist))))
-      ;; Preceding chars may be part of a command name
-      (setq string-to-complete (buffer-substring save-pos (point)))
-      (setq completion-result
-	    (try-completion string-to-complete ex-token-alist))
-      
-      (cond ((eq completion-result t)  ; exact match--do nothing
-	     (vip-tmp-insert-at-eob " (Sole completion)"))
-	    ((eq completion-result nil)
-	     (vip-tmp-insert-at-eob " (No match)"))
-	    (t  ;; partial completion
-	     (goto-char save-pos)
-	     (delete-region (point) (point-max))
-	     (insert completion-result)
-	     (let (case-fold-search)
-	       (setq compl-list
-		     (vip-filter-alist (concat "^" completion-result)
-				       ex-token-alist)))
-	     (if (> (length compl-list) 1)
-		 (with-output-to-temp-buffer "*Completions*" 
-		   (display-completion-list
-		    (vip-alist-to-list (reverse compl-list)))))))
-      )))
-    
-
-;; Read Ex commands 
-;; Ex commands themselves are implemented in viper-ex.el
-(defun vip-ex (&optional string)
-  (interactive)
-  (or string
-      (setq ex-g-flag nil
-	    ex-g-variant nil))
-  (let* ((map (copy-keymap minibuffer-local-map))
-	 (address nil)
-	 (cont t)
-	 (dot (point))
-	 prev-token-type com-str)
-	 
-    (vip-add-keymap vip-ex-cmd-map map)
-    
-    (setq com-str (or string (vip-read-string-with-history
-			      ":" 
-			      nil
-			      'vip-ex-history
-			      (car vip-ex-history)
-			      map)))
-    (save-window-excursion
-      ;; just a precaution
-      (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-      (set-buffer vip-ex-work-buf)
-      (delete-region (point-min) (point-max))
-      (insert com-str "\n")
-      (goto-char (point-min)))
-    (setq ex-token-type nil
-	  ex-addresses nil)
-    (while cont
-      (vip-get-ex-token)
-      (cond ((memq ex-token-type '(command end-mark))
-	     (if address (setq ex-addresses (cons address ex-addresses)))
-	     (cond ((string= ex-token "global")
-		    (ex-global nil)
-		    (setq cont nil))
-		   ((string= ex-token "vglobal")
-		    (ex-global t)
-		    (setq cont nil))
-		   (t
-		    (vip-execute-ex-command)
-		    (save-window-excursion
-		      (setq vip-ex-work-buf
-			    (get-buffer-create vip-ex-work-buf-name))
-		      (set-buffer vip-ex-work-buf)
-		      (skip-chars-forward " \t")
-		      (cond ((looking-at "|")
-			     (forward-char 1))
-			    ((looking-at "\n")
-			     (setq cont nil))
-			    (t (error "`%s': %s" ex-token vip-SpuriousText)))
-		      ))
-		   ))
-	    ((eq ex-token-type 'non-command)
-	     (error "`%s': %s" ex-token vip-BadExCommand))
-	    ((eq ex-token-type 'whole)
-	     (setq address nil)
-	     (setq ex-addresses
-		   (if ex-addresses
-		       (cons (point-max) ex-addresses)
-		     (cons (point-max) (cons (point-min) ex-addresses)))))
-	    ((eq ex-token-type 'comma)
-	     (if (eq prev-token-type 'whole)
-		 (setq address (point-min)))
-	     (setq ex-addresses
-		   (cons (if (null address) (point) address) ex-addresses)))
-	    ((eq ex-token-type 'semi-colon)
-	     (if (eq prev-token-type 'whole)
-		 (setq address (point-min)))
-	     (if address (setq dot address))
-	     (setq ex-addresses
-		   (cons (if (null address) (point) address) ex-addresses)))
-	    (t (let ((ans (vip-get-ex-address-subr address dot)))
-		 (if ans (setq address ans)))))
-      (setq prev-token-type ex-token-type))))
-      
-
-;; Get a regular expression and set `ex-variant', if found
-(defun vip-get-ex-pat ()
-  (save-window-excursion
-    (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name))
-    (set-buffer vip-ex-work-buf)
-    (skip-chars-forward " \t")
-    (if (looking-at "!")
-	(progn
-	  (setq ex-g-variant (not ex-g-variant)
-		ex-g-flag (not ex-g-flag))
-	  (forward-char 1)
-	  (skip-chars-forward " \t")))
-    (let ((c (following-char)))
-      (if (string-match "[0-9A-Za-z]" (format "%c" c))
-	  (error
-	   "Global regexp must be inside matching non-alphanumeric chars"))
-      (if (looking-at "[^\\\\\n]")
-	  (progn
-	    (forward-char 1)
-	    (set-mark (point))
-	    (let ((cont t))
-	      (while (and (not (eolp)) cont)
-		(if (not (re-search-forward (format "[^%c]*%c" c c) nil t))
-		    (if (member ex-token '("global" "vglobal"))
-			(error
-			 "Missing closing delimiter for global regexp")
-		      (goto-char (point-max))))
-		(if (not (vip-looking-back
-			  (format "[^\\\\]\\(\\\\\\\\\\)*\\\\%c" c)))
-		    (setq cont nil))))
-	    (setq ex-token
-		  (if (= (mark t) (point)) ""
-		    (buffer-substring (1- (point)) (mark t))))
-	    (backward-char 1))
-	(setq ex-token nil))
-      c)))
-
-;; get an ex command
-(defun vip-get-ex-command ()
-  (save-window-excursion
-    (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-    (set-buffer vip-ex-work-buf)
-    (if (looking-at "/") (forward-char 1))
-    (skip-chars-forward " \t")
-    (cond ((looking-at "[a-z]")
-	   (vip-get-ex-com-subr)
-	   (if (eq ex-token-type 'non-command)
-	       (error "`%s': %s" ex-token vip-BadExCommand)))
-	  ((looking-at "[!=><&~]")
-	   (setq ex-token (char-to-string (following-char)))
-	   (forward-char 1))
-	  (t (error vip-BadExCommand)))))
-
-;; Get an Ex option g or c
-(defun vip-get-ex-opt-gc (c)
-  (save-window-excursion
-    (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-    (set-buffer vip-ex-work-buf)
-    (if (looking-at (format "%c" c)) (forward-char 1))
-    (skip-chars-forward " \t")
-    (cond ((looking-at "g")
-	   (setq ex-token "g")
-	   (forward-char 1)
-	   t)
-	  ((looking-at "c")
-	   (setq ex-token "c")
-	   (forward-char 1)
-	   t)
-	  (t nil))))
-
-;; Compute default addresses.  WHOLE-FLAG means use the whole buffer
-(defun vip-default-ex-addresses (&optional whole-flag)
-  (cond ((null ex-addresses)
-	 (setq ex-addresses
-	       (if whole-flag
-		   (cons (point-max) (cons (point-min) nil))
-		 (cons (point) (cons (point) nil)))))
-	((null (cdr ex-addresses))
-	 (setq ex-addresses
-	       (cons (car ex-addresses) ex-addresses)))))
-
-;; Get an ex-address as a marker and set ex-flag if a flag is found
-(defun vip-get-ex-address ()
-  (let ((address (point-marker)) (cont t))
-    (setq ex-token "")
-    (setq ex-flag nil)
-    (while cont
-      (vip-get-ex-token)
-      (cond ((eq ex-token-type 'command)
-	     (if (member ex-token '("print" "list" "#"))
-		 (progn
-		   (setq ex-flag t
-			 cont nil))
-	       (error "Address expected in this Ex command")))
-	    ((eq ex-token-type 'end-mark)
-	     (setq cont nil))
-	    ((eq ex-token-type 'whole)
-	     (error "Trailing address expected"))
-	    ((eq ex-token-type 'comma)
-	     (error "`%s': %s" ex-token vip-SpuriousText))
-	    (t (let ((ans (vip-get-ex-address-subr address (point-marker))))
-		 (if ans (setq address ans))))))
-    address))
-
-;; Returns an address as a point
-(defun vip-get-ex-address-subr (old-address dot)
-  (let ((address nil))
-    (if (null old-address) (setq old-address dot))
-    (cond ((eq ex-token-type 'dot)
-	   (setq address dot))
-	  ((eq ex-token-type 'add-number)
-	   (save-excursion
-	     (goto-char old-address)
-	     (forward-line (if (= old-address 0) (1- ex-token) ex-token))
-	     (setq address (point-marker))))
-	  ((eq ex-token-type 'sub-number)
-	   (save-excursion
-	     (goto-char old-address)
-	     (forward-line (- ex-token))
-	     (setq address (point-marker))))
-	  ((eq ex-token-type 'abs-number)
-	   (save-excursion
-	     (goto-char (point-min))
-	     (if (= ex-token 0) (setq address 0)
-	       (forward-line (1- ex-token))
-	       (setq address (point-marker)))))
-	  ((eq ex-token-type 'end)
-	   (setq address (point-max-marker)))
-	  ((eq ex-token-type 'plus) t)  ; do nothing
-	  ((eq ex-token-type 'minus) t) ; do nothing
-	  ((eq ex-token-type 'search-forward)
-	   (save-excursion
-	     (ex-search-address t)
-	     (setq address (point-marker))))
-	  ((eq ex-token-type 'search-backward)
-	   (save-excursion
-	     (ex-search-address nil)
-	     (setq address (point-marker))))
-	  ((eq ex-token-type 'goto-mark)
-	   (save-excursion
-	     (if (null ex-token)
-		 (exchange-point-and-mark)
-	       (goto-char (vip-register-to-point
-			   (1+ (- ex-token ?a)) 'enforce-buffer)))
-	     (setq address (point-marker)))))
-    address))
-
-
-;; Search pattern and set address
-(defun ex-search-address (forward)
-  (if (string= ex-token "")
-      (if (null vip-s-string)
-	  (error vip-NoPrevSearch)
-	(setq ex-token vip-s-string))
-    (setq vip-s-string ex-token))
-  (if forward
-      (progn
-	(forward-line 1)
-	(re-search-forward ex-token))
-    (forward-line -1)
-    (re-search-backward ex-token)))
-
-;; Get a buffer name and set `ex-count' and `ex-flag' if found
-(defun vip-get-ex-buffer ()
-  (setq ex-buffer nil)
-  (setq ex-count nil)
-  (setq ex-flag nil)
-  (save-window-excursion
-    (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-    (set-buffer vip-ex-work-buf)
-    (skip-chars-forward " \t")
-    (if (looking-at "[a-zA-Z]")
-	(progn
-	  (setq ex-buffer (following-char))
-	  (forward-char 1)
-	  (skip-chars-forward " \t")))
-    (if (looking-at "[0-9]")
-	(progn
-	  (set-mark (point))
-	  (re-search-forward "[0-9][0-9]*")
-	  (setq ex-count (string-to-int (buffer-substring (point) (mark t))))
-	  (skip-chars-forward " \t")))
-    (if (looking-at "[pl#]")
-	(progn
-	  (setq ex-flag t)
-	  (forward-char 1)))
-    (if (not (looking-at "[\n|]"))
-	(error "`%s': %s" ex-token vip-SpuriousText))))
-
-(defun vip-get-ex-count ()
-  (setq ex-variant nil
-	ex-count nil
-	ex-flag nil)
-  (save-window-excursion
-    (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-    (set-buffer vip-ex-work-buf)
-    (skip-chars-forward " \t")
-    (if (looking-at "!")
-	(progn
-	  (setq ex-variant t)
-	  (forward-char 1)))
-    (skip-chars-forward " \t")
-    (if (looking-at "[0-9]")
-	(progn
-	  (set-mark (point))
-	  (re-search-forward "[0-9][0-9]*")
-	  (setq ex-count (string-to-int (buffer-substring (point) (mark t))))
-	  (skip-chars-forward " \t")))
-    (if (looking-at "[pl#]")
-	(progn
-	  (setq ex-flag t)
-	  (forward-char 1)))
-    (if (not (looking-at "[\n|]"))
-	(error "`%s': %s"
-	       (buffer-substring (point-min) (1- (point-max))) vip-BadExCommand))))
-
-;; Expand \% and \# in ex command
-(defun ex-expand-filsyms (cmd buf)
-  (let (cf pf ret)
-    (save-excursion 
-      (set-buffer buf)
-      (setq cf buffer-file-name)
-      (setq pf (ex-next nil t))) ; this finds alternative file name
-    (if (and (null cf) (string-match "[^\\]%\\|\\`%" cmd))
-	(error "No current file to substitute for `%%'"))
-    (if (and (null pf) (string-match "[^\\]#\\|\\`#" cmd))
-	(error "No alternate file to substitute for `#'"))
-    (save-excursion
-      (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
-      (erase-buffer)
-      (insert cmd)
-      (goto-char (point-min))
-      (while (re-search-forward "%\\|#" nil t)
-	(let ((data (match-data)) 
-	      (char (buffer-substring (match-beginning 0) (match-end 0))))
-	  (if (vip-looking-back (concat "\\\\" char))
-	      (replace-match char)
-	    (store-match-data data)
-	    (if (string= char "%")
-		(replace-match cf)
-	      (replace-match pf)))))
-      (end-of-line)
-      (setq ret (buffer-substring (point-min) (point)))
-      (message "%s" ret))
-    ret))
-
-;; Get a file name and set ex-variant, `ex-append' and `ex-offset' if found
-(defun vip-get-ex-file ()
-  (let (prompt)
-    (setq ex-file nil
-	  ex-variant nil
-	  ex-append nil
-	  ex-offset nil
-	  ex-cmdfile nil)
-    (save-excursion
-      (save-window-excursion
-	(setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-	(set-buffer vip-ex-work-buf)
-	(skip-chars-forward " \t")
-	(if (looking-at "!")
-	    (if (and (not (vip-looking-back "[ \t]"))
-		     ;; read doesn't have a corresponding :r! form, so ! is
-		     ;; immediately interpreted as a shell command.
-		     (not (string= ex-token "read")))
-		(progn
-		  (setq ex-variant t)
-		  (forward-char 1)
-		  (skip-chars-forward " \t"))
-	      (setq ex-cmdfile t)
-	      (forward-char 1)
-	      (skip-chars-forward " \t")))
-	(if (looking-at ">>")
-	    (progn
-	      (setq ex-append t
-		    ex-variant t)
-	      (forward-char 2)
-	      (skip-chars-forward " \t")))
-	(if (looking-at "+")
-	    (progn
-	      (forward-char 1)
-	      (set-mark (point))
-	      (re-search-forward "[ \t\n]")
-	      (backward-char 1)
-	      (setq ex-offset (buffer-substring (point) (mark t)))
-	      (forward-char 1)
-	      (skip-chars-forward " \t")))
-	;; this takes care of :r, :w, etc., when they get file names
-	;; from the history list
-	(if (member ex-token '("read" "write" "edit" "visual" "next"))
-	    (progn
-	      (setq ex-file (buffer-substring (point)  (1- (point-max))))
-	      (setq ex-file
-		    ;; For :e, match multiple non-white strings separated
-		    ;; by white. For others, find the first non-white string
-		    (if (string-match
-			 (if (string= ex-token "edit")
-			     "[^ \t\n]+\\([ \t]+[^ \t\n]+\\)*"
-			   "[^ \t\n]+")
-			 ex-file)
-			(progn
-			  ;; if file name comes from history, don't leave
-			  ;; minibuffer when the user types space
-			  (setq vip-incomplete-ex-cmd nil)
-			  ;; this must be the last clause in this progn
-			  (substring ex-file (match-beginning 0) (match-end 0))
-			  )
-		      ""))
-	      ;; this leaves only the command name in the work area
-	      ;; file names are gone
-	      (delete-region (point) (1- (point-max)))
-	      ))
-	(goto-char (point-max))
-	(skip-chars-backward " \t\n")
-	(setq prompt (buffer-substring (point-min) (point)))
-	))
-    
-    (setq vip-last-ex-prompt prompt)
-    
-    ;; If we just finished reading command, redisplay prompt
-    (if vip-incomplete-ex-cmd
-	(setq ex-file (vip-ex-read-file-name (format ":%s " prompt)))
-      ;; file was typed in-line
-      (setq ex-file (or ex-file "")))
-    ))
-
-
-;; Completes file name or exits minibuffer. If Ex command accepts multiple
-;; file names, arranges to re-enter the minibuffer.
-(defun vip-complete-filename-or-exit ()
-  (interactive)
-  (setq vip-keep-reading-filename t) 
-  ;; don't exit if directory---ex-commands don't 
-  (cond ((ex-cmd-accepts-multiple-files-p ex-token) (exit-minibuffer))
-	;; apparently the argument to an Ex command is
-	;; supposed to be a shell command
-	((vip-looking-back "^[ \t]*!.*")
-	 (setq ex-cmdfile t)
-	 (insert " "))
-	(t
-	 (setq ex-cmdfile nil)
-	 (minibuffer-complete-word))))
-
-(defun vip-handle-! ()
-  (interactive)
-  (if (and (string=
-	    (buffer-string) (vip-abbreviate-file-name default-directory))
-	   (member ex-token '("read" "write")))
-      (erase-buffer))
-  (insert "!"))
-
-(defun ex-cmd-accepts-multiple-files-p (token)
-  (member token '("edit" "next" "Next")))
-
-;; If user doesn't enter anything, then "" is returned, i.e., the
-;; prompt-directory is not returned.
-(defun vip-ex-read-file-name (prompt)
-  (let* ((str "")
-	 (minibuffer-local-completion-map
-	  (copy-keymap minibuffer-local-completion-map))
-	 beg end cont val)
-    
-    (vip-add-keymap ex-read-filename-map
-		    (if vip-emacs-p 
-			minibuffer-local-completion-map
-		      read-file-name-map)) 
-		    
-    (setq cont (setq vip-keep-reading-filename t))
-    (while cont
-      (setq vip-keep-reading-filename nil
-	    val (read-file-name (concat prompt str) nil default-directory))
-      (if (string-match " " val)
-	  (setq val (concat "\\\"" val "\\\"")))
-      (setq str  (concat str (if (equal val "") "" " ")
-			 val (if (equal val "") "" " ")))
-			 
-      ;; Only edit, next, and Next commands accept multiple files.
-      ;; vip-keep-reading-filename is set in the anonymous function that is
-      ;; bound to " " in ex-read-filename-map.
-      (setq cont (and vip-keep-reading-filename
-		      (ex-cmd-accepts-multiple-files-p ex-token)))
-      )
-    
-    (setq beg (string-match "[^ \t]" str)   ; delete leading blanks
-	  end (string-match "[ \t]*$" str)) ; delete trailing blanks
-    (if (member ex-token '("read" "write"))
-	  (if (string-match "[\t ]*!" str)
-	      ;; this is actually a shell command
-	      (progn
-		(setq ex-cmdfile t)
-		(setq beg (1+ beg))
-		(setq vip-last-ex-prompt (concat vip-last-ex-prompt " !")))))
-    (substring str (or beg 0) end)))
-
-;; Execute ex command using the value of addresses
-(defun vip-execute-ex-command ()
-  (vip-deactivate-mark)
-  (cond ((string= ex-token "args") (ex-args))
-	((string= ex-token "copy") (ex-copy nil))
-	((string= ex-token "cd") (ex-cd))
-	((string= ex-token "chdir") (ex-cd))
-	((string= ex-token "delete") (ex-delete))
-	((string= ex-token "edit") (ex-edit))
-	((string= ex-token "file") (vip-info-on-file))
-	((string= ex-token "goto") (ex-goto))
-	((string= ex-token "help") (ex-help))
-	((string= ex-token "join") (ex-line "join"))
-	((string= ex-token "kmark") (ex-mark))
-	((string= ex-token "mark") (ex-mark))
-	((string= ex-token "map") (ex-map))
-	((string= ex-token "move") (ex-copy t))
-	((string= ex-token "next") (ex-next ex-cycle-other-window))
-	((string= ex-token "Next") (ex-next (not ex-cycle-other-window)))
-	((string= ex-token "RelatedFile") (ex-next-related-buffer 1))
-	((string= ex-token "put") (ex-put))
-	((string= ex-token "pwd") (ex-pwd))
-	((string= ex-token "preserve") (ex-preserve))
-	((string= ex-token "PreviousRelatedFile") (ex-next-related-buffer -1))
-	((string= ex-token "quit") (ex-quit))
-	((string= ex-token "read") (ex-read))
-	((string= ex-token "recover") (ex-recover))
-	((string= ex-token "rewind") (ex-rewind))
-	((string= ex-token "submitReport") (vip-submit-report))
-	((string= ex-token "set") (ex-set))
-	((string= ex-token "shell") (ex-shell))
-	((string= ex-token "source") (ex-source))
-	((string= ex-token "sr") (ex-substitute t t))
-	((string= ex-token "substitute") (ex-substitute))
-	((string= ex-token "suspend") (suspend-emacs))
-	((string= ex-token "stop") (suspend-emacs))
-	((string= ex-token "transfer") (ex-copy nil))
-	((string= ex-token "buffer") (if ex-cycle-other-window
-					 (vip-switch-to-buffer-other-window)
-					 (vip-switch-to-buffer)))
-	((string= ex-token "Buffer") (if ex-cycle-other-window
-					 (vip-switch-to-buffer)
-					 (vip-switch-to-buffer-other-window)))
-	((string= ex-token "tag") (ex-tag))
-	((string= ex-token "undo") (vip-undo))
-	((string= ex-token "unmap") (ex-unmap))
-	((string= ex-token "version") (vip-version))
-	((string= ex-token "visual") (ex-edit))
-	((string= ex-token "write") (ex-write nil))
-	((string= ex-token "Write") (save-some-buffers))
-	((string= ex-token "wq") (ex-write t))
-	((string= ex-token "WWrite") (save-some-buffers t)) ; don't ask
-	((string= ex-token "xit") (ex-write t))
-	((string= ex-token "yank") (ex-yank))
-	((string= ex-token "!") (ex-command))
-	((string= ex-token "=") (ex-line-no))
-	((string= ex-token ">") (ex-line "right"))
-	((string= ex-token "<") (ex-line "left"))
-	((string= ex-token "&") (ex-substitute t))
-	((string= ex-token "~") (ex-substitute t t))
-	((or (string= ex-token "append")
-	     (string= ex-token "change")
-	     (string= ex-token "insert")
-	     (string= ex-token "open"))
-	 (error "`%s': Obsolete command, not supported by Viper" ex-token))
-	((or (string= ex-token "abbreviate")
-	     (string= ex-token "unabbreviate"))
-	 (error
-	  "`%s': Vi abbrevs are obsolete. Use the more powerful Emacs abbrevs"
-	  ex-token))
-	((or (string= ex-token "list")
-	     (string= ex-token "print")
-	     (string= ex-token "z")
-	     (string= ex-token "#"))
-	 (error "`%s': Command not implemented in Viper" ex-token))
-	(t (error "`%s': %s" ex-token vip-BadExCommand))))
-
-(defun vip-undisplayed-files ()
-  (mapcar
-   (function 
-    (lambda (b) 
-      (if (null (get-buffer-window b))
-	  (let ((f (buffer-file-name b)))
-	    (if f f
-	      (if ex-cycle-through-non-files 
-		  (let ((s (buffer-name b)))
-		    (if (string= " " (substring s 0 1))
-			nil
-		      s))
-		nil)))
-	nil)))
-   (buffer-list)))
-
-
-(defun ex-args ()
-  (let ((l (vip-undisplayed-files))
-	(args "")
-	(file-count 1))
-    (while (not (null l))
-      (if (car l) 
-	  (setq args (format "%s %d) %s\n" args file-count (car l))
-		file-count (1+ file-count)))
-      (setq l (cdr l)))
-    (if (string= args "")
-	(message "All files are already displayed")
-      (save-excursion
-	(save-window-excursion
-	  (with-output-to-temp-buffer " *vip-info*"
-	    (princ "\n\nThese files are not displayed in any window.\n")
-	    (princ "\n=============\n")
-	    (princ args)
-	    (princ "\n=============\n")
-	    (princ "\nThe numbers can be given as counts to :next. ")
-	    (princ "\n\nPress any key to continue...\n\n"))
-	  (vip-read-event))))))
-
-;; Ex cd command. Default directory of this buffer changes
-(defun ex-cd ()
-  (vip-get-ex-file)
-  (if (string= ex-file "")
-      (setq ex-file "~"))
-  (setq default-directory (file-name-as-directory (expand-file-name ex-file))))
-
-;; Ex copy and move command.  DEL-FLAG means delete
-(defun ex-copy (del-flag)
-  (vip-default-ex-addresses)
-  (let ((address (vip-get-ex-address))
-	(end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-    (goto-char end)
-    (save-excursion
-      (push-mark beg t)
-      (vip-enlarge-region (mark t) (point))
-      (if del-flag
-	  (kill-region (point) (mark t))
-	(copy-region-as-kill (point) (mark t)))
-      (if ex-flag
-	  (progn
-	    (with-output-to-temp-buffer "*copy text*"
-	      (princ
-	       (if (or del-flag ex-g-flag ex-g-variant)
-		   (current-kill 0)
-		 (buffer-substring (point) (mark t)))))
-	    (condition-case nil
-		(progn
-		  (read-string "[Hit return to continue] ")
-		  (save-excursion (kill-buffer "*copy text*")))
-	      (quit (save-excursion (kill-buffer "*copy text*"))
-		    (signal 'quit nil))))))
-    (if (= address 0)
-	(goto-char (point-min))
-      (goto-char address)
-      (forward-line 1))
-      (insert (current-kill 0))))
-
-;; Ex delete command
-(defun ex-delete ()
-  (vip-default-ex-addresses)
-  (vip-get-ex-buffer)
-  (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-    (if (> beg end) (error vip-FirstAddrExceedsSecond))
-    (save-excursion
-      (vip-enlarge-region beg end)
-      (exchange-point-and-mark)
-      (if ex-count
-	  (progn
-	    (set-mark (point))
-	    (forward-line (1- ex-count)))
-	(set-mark end))
-      (vip-enlarge-region (point) (mark t))
-      (if ex-flag
-	  ;; show text to be deleted and ask for confirmation
-	  (progn
-	    (with-output-to-temp-buffer " *delete text*"
-	      (princ (buffer-substring (point) (mark t))))
-	    (condition-case nil
-		(read-string "[Hit return to continue] ")
-	      (quit
-	       (save-excursion (kill-buffer " *delete text*"))
-	       (error "")))
-	    (save-excursion (kill-buffer " *delete text*")))
-	(if ex-buffer
-	    (cond ((vip-valid-register ex-buffer '(Letter))
-		   (vip-append-to-register
-		    (downcase ex-buffer) (point) (mark t)))
-		  ((vip-valid-register ex-buffer)
-		   (copy-to-register ex-buffer (point) (mark t) nil))
-		  (t (error vip-InvalidRegister ex-buffer))))
-	(kill-region (point) (mark t))))))
-
-
-
-;; Ex edit command
-;; In Viper, `e' and `e!' behave identically. In both cases, the user is
-;; asked if current buffer should really be discarded.
-;; This command can take multiple file names. It replaces the current buffer
-;; with the first file in its argument list
-(defun ex-edit (&optional file)
-  (if (not file)
-      (vip-get-ex-file))
-  (cond ((and (string= ex-file "") buffer-file-name)
-	 (setq ex-file  (vip-abbreviate-file-name (buffer-file-name))))
-	((string= ex-file "")
-	 (error vip-NoFileSpecified)))
-      
-  (let (msg do-edit)
-    (if buffer-file-name
-	(cond ((buffer-modified-p)
-	       (setq msg
-		     (format "Buffer %s is modified. Discard changes? "
-			     (buffer-name))
-		     do-edit t))
-	      ((not (verify-visited-file-modtime (current-buffer)))
-	       (setq msg
-		     (format "File %s changed on disk.  Reread from disk? "
-			     buffer-file-name)
-		     do-edit t))
-	      (t (setq do-edit nil))))
-      
-    (if do-edit
-	(if (yes-or-no-p msg)
-	    (progn
-	      (set-buffer-modified-p nil)
-	      (kill-buffer (current-buffer)))
-	  (message "Buffer %s was left intact" (buffer-name))))
-    ) ; let
-  
-  (if (null (setq file (get-file-buffer ex-file)))
-      (progn 
-	(ex-find-file ex-file)
-	(or (eq major-mode 'dired-mode)
-	    (vip-change-state-to-vi))
-	(goto-char (point-min)))
-    (switch-to-buffer file))
-  (if ex-offset
-      (progn
-	(save-window-excursion
-	  (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-	  (set-buffer vip-ex-work-buf)
-	  (delete-region (point-min) (point-max))
-	  (insert ex-offset "\n")
-	  (goto-char (point-min)))
-	(goto-char (vip-get-ex-address))
-	(beginning-of-line)))
-  (ex-fixup-history vip-last-ex-prompt ex-file))
-
-;; Find-file FILESPEC if it appears to specify a single file.
-;; Otherwise, assume that FILES{EC is a wildcard.
-;; In this case, split it into substrings separated by newlines.
-;; Each line is assumed to be a file name. find-file's each file thus obtained.
-(defun ex-find-file (filespec)
-  (let ((nonstandard-filename-chars "[^-a-zA-Z0-9_./,~$\\]"))
-    (cond ((file-exists-p filespec) (find-file filespec))
-	  ((string-match nonstandard-filename-chars  filespec)
-	   (funcall ex-nontrivial-find-file-function filespec))
-	  (t (find-file filespec)))
-    ))
-
-
-;; Ex global command
-(defun ex-global (variant)
-  (let ((gcommand ex-token))
-    (if (or ex-g-flag ex-g-variant)
-	(error "`%s' within `global' is not allowed" gcommand)
-      (if variant
-	  (setq ex-g-flag nil
-		ex-g-variant t)
-	(setq ex-g-flag t
-	      ex-g-variant nil)))
-    (vip-get-ex-pat)
-    (if (null ex-token)
-	(error "`%s': Missing regular expression" gcommand)))
-  
-  (if (string= ex-token "")
-      (if (null vip-s-string)
-	  (error vip-NoPrevSearch)
-	(setq ex-g-pat vip-s-string))
-    (setq ex-g-pat ex-token
-	  vip-s-string ex-token))
-  (if (null ex-addresses)
-      (setq ex-addresses (list (point-max) (point-min)))
-    (vip-default-ex-addresses))
-  (let ((marks nil) (mark-count 0)
-	com-str (end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-    (if (> beg end) (error vip-FirstAddrExceedsSecond))
-    (save-excursion
-      (vip-enlarge-region beg end)
-      (exchange-point-and-mark)
-      (let ((cont t) (limit (point-marker)))
-	(exchange-point-and-mark)
-	;; skip the last line if empty
-	(beginning-of-line)
-	(if (eobp) (vip-backward-char-carefully))
-	(while (and cont (not (bobp)) (>= (point) limit))
-	  (beginning-of-line)
-	  (set-mark (point))
-	  (end-of-line)
-	  (let ((found (re-search-backward ex-g-pat (mark t) t)))
-	    (if (or (and ex-g-flag found)
-		    (and ex-g-variant (not found)))
-		(progn
-		  (end-of-line)
-		  (setq mark-count (1+ mark-count))
-		  (setq marks (cons (point-marker) marks)))))
-	  (beginning-of-line)
-	  (if (bobp) (setq cont nil)
-	    (forward-line -1)
-	    (end-of-line)))))
-    (save-window-excursion
-      (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-      (set-buffer vip-ex-work-buf)
-      (setq com-str (buffer-substring (1+ (point)) (1- (point-max)))))
-    (while marks
-      (goto-char (car marks))
-      (vip-ex com-str)
-      (setq mark-count (1- mark-count))
-      (setq marks (cdr marks)))))
-
-;; Ex goto command
-(defun ex-goto ()
-  (if (null ex-addresses)
-      (setq ex-addresses (cons (point) nil)))
-  (push-mark (point) t)
-  (goto-char (car ex-addresses))
-  (beginning-of-line))
-
-;; Ex line commands.  COM is join, shift-right or shift-left
-(defun ex-line (com)
-  (vip-default-ex-addresses)
-  (vip-get-ex-count)
-  (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) point)
-    (if (> beg end) (error vip-FirstAddrExceedsSecond))
-    (save-excursion
-      (vip-enlarge-region beg end)
-      (exchange-point-and-mark)
-      (if ex-count
-	  (progn
-	    (set-mark (point))
-	    (forward-line ex-count)))
-      (if ex-flag
-	  ;; show text to be joined and ask for confirmation
-	  (progn
-	    (with-output-to-temp-buffer " *text*"
-	      (princ (buffer-substring (point) (mark t))))
-	    (condition-case nil
-		(progn
-		  (read-string "[Hit return to continue] ")
-		  (ex-line-subr com (point) (mark t)))
-	      (quit (ding)))
-	    (save-excursion (kill-buffer " *text*")))
-	(ex-line-subr com (point) (mark t)))
-      (setq point (point)))
-    (goto-char (1- point))
-    (beginning-of-line)))
-
-(defun ex-line-subr (com beg end)
-  (cond ((string= com "join")
-	 (goto-char (min beg end))
-	 (while (and (not (eobp)) (< (point) (max beg end)))
-	   (end-of-line)
-	   (if (and (<= (point) (max beg end)) (not (eobp)))
-	       (progn
-		 (forward-line 1)
-		 (delete-region (point) (1- (point)))
-		 (if (not ex-variant) (fixup-whitespace))))))
-	((or (string= com "right") (string= com "left"))
-	 (indent-rigidly
-	  (min beg end) (max beg end)
-	  (if (string= com "right") vip-shift-width (- vip-shift-width)))
-	 (goto-char (max beg end))
-	 (end-of-line)
-	 (vip-forward-char-carefully))))
-
-
-;; Ex mark command
-(defun ex-mark ()
-  (let (char)
-    (if (null ex-addresses)
-	(setq ex-addresses
-	      (cons (point) nil)))
-    (save-window-excursion
-      (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-      (set-buffer vip-ex-work-buf)
-      (skip-chars-forward " \t")
-      (if (looking-at "[a-z]")
-	  (progn
-	    (setq char (following-char))
-	    (forward-char 1)
-	    (skip-chars-forward " \t")
-	    (if (not (looking-at "[\n|]"))
-		(error "`%s': %s" ex-token vip-SpuriousText)))
-	(error "`%s' requires a following letter" ex-token)))
-    (save-excursion
-      (goto-char (car ex-addresses))
-      (point-to-register (1+ (- char ?a))))))
-
-    
-      
-;; Alternate file is the file next to the first one in the buffer ring
-(defun ex-next (cycle-other-window &optional find-alt-file)
-  (catch 'ex-edit
-    (let (count l)
-      (if (not find-alt-file) 
-	  (progn
-	    (vip-get-ex-file)
-	    (if (or (char-or-string-p ex-offset)
-		    (and (not (string= "" ex-file)) 
-		         (not (string-match "^[0-9]+$" ex-file))))
-		(progn
-		  (ex-edit t)
-		  (throw 'ex-edit nil))
-	      (setq count (string-to-int ex-file))
-	      (if (= count 0) (setq count 1))
-	      (if (< count 0) (error "Usage: `next <count>' (count >= 0)"))))
-	(setq count 1))
-      (setq l (vip-undisplayed-files))
-      (while (> count 0)
-	(while (and (not (null l)) (null (car l)))
-	  (setq l (cdr l)))
-	(setq count (1- count))
-	(if (> count 0)
-	    (setq l (cdr l))))
-      (if find-alt-file (car l)
-	(progn
-	  (if (and (car l) (get-file-buffer (car l)))
-	      (let* ((w (if cycle-other-window
-			    (get-lru-window) (selected-window)))
-		     (b (window-buffer w)))
-		(set-window-buffer w (get-file-buffer (car l)))
-		(bury-buffer b)
-		;; this puts "next <count>" in the ex-command history
-		(ex-fixup-history vip-last-ex-prompt ex-file))
-	    (error "Not that many undisplayed files")))))))
-
-
-(defun ex-next-related-buffer (direction &optional no-recursion)
-  
-  (vip-ring-rotate1 vip-related-files-and-buffers-ring direction)
-  
-  (let ((file-or-buffer-name 
-	 (vip-current-ring-item vip-related-files-and-buffers-ring))
-	(old-ring vip-related-files-and-buffers-ring)
-	(old-win (selected-window))
-	skip-rest buf wind)
-    
-    (or (and (ring-p vip-related-files-and-buffers-ring)
-	     (> (ring-length vip-related-files-and-buffers-ring) 0))
-	(error "This buffer has no related files or buffers"))
-	
-    (or (stringp file-or-buffer-name)
-	(error
-	 "File and buffer names must be strings, %S" file-or-buffer-name))
-    
-    (setq buf (cond ((get-buffer file-or-buffer-name))
-		    ((file-exists-p file-or-buffer-name)
-		     (find-file-noselect file-or-buffer-name))
-		    ))
-    
-    (if (not (vip-buffer-live-p buf))
-	(error "Didn't find buffer %S or file %S"
-	       file-or-buffer-name
-	       (vip-abbreviate-file-name
-		(expand-file-name file-or-buffer-name))))
-	  
-    (if (equal buf (current-buffer))
-	(or no-recursion
-	    ;; try again
-	    (progn
-	      (setq skip-rest t)
-	      (ex-next-related-buffer direction 'norecursion))))
-	
-    (if skip-rest
-	()
-      ;; setup buffer
-      (if (setq wind (vip-get-visible-buffer-window buf))
-	  ()
-	(setq wind (get-lru-window (if vip-xemacs-p nil 'visible)))
-	(set-window-buffer wind buf))
-	    
-      (if (vip-window-display-p)
-	  (progn
-	    (raise-frame (window-frame wind))
-	    (if (equal (window-frame wind) (window-frame old-win))
-		(save-window-excursion (select-window wind) (sit-for 1))
-	      (select-window wind)))
-	(save-window-excursion (select-window wind) (sit-for 1)))
-	
-      (save-excursion
-	(set-buffer buf)
-	(setq vip-related-files-and-buffers-ring old-ring))
-      
-      (setq vip-local-search-start-marker (point-marker))
-      )))
-  
-    
-;; Force auto save
-(defun ex-preserve ()
-  (message "Autosaving all buffers that need to be saved...")
-  (do-auto-save t))
-
-;; Ex put
-(defun ex-put ()
-  (let ((point (if (null ex-addresses) (point) (car ex-addresses))))
-    (vip-get-ex-buffer)
-    (setq vip-use-register ex-buffer)
-    (goto-char point)
-    (if (bobp) (vip-Put-back 1) (vip-put-back 1))))
-
-;; Ex print working directory
-(defun ex-pwd ()
-  (message default-directory))
-
-;; Ex quit command
-(defun ex-quit ()
-  ;; skip "!", if it is q!. In Viper q!, w!, etc., behave as q, w, etc.
-  (save-excursion
-    (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-    (set-buffer vip-ex-work-buf)
-    (if (looking-at "!") (forward-char 1)))
-  (if (< vip-expert-level 3)
-      (save-buffers-kill-emacs)
-    (kill-buffer (current-buffer))))
-
-
-;; Ex read command
-(defun ex-read ()
-  (vip-get-ex-file)
-  (let ((point (if (null ex-addresses) (point) (car ex-addresses)))
-	command)
-    (goto-char point)
-    (vip-add-newline-at-eob-if-necessary)
-    (if (not (or (bobp) (eobp))) (forward-line 1))
-    (if (and (not ex-variant) (string= ex-file ""))
-	(progn
-	  (if (null buffer-file-name)
-	      (error vip-NoFileSpecified))
-	  (setq ex-file buffer-file-name)))
-    (if ex-cmdfile
-	(progn
-	  (setq command (ex-expand-filsyms ex-file (current-buffer)))
-	  (shell-command command t))
-      (insert-file-contents ex-file)))
-  (ex-fixup-history vip-last-ex-prompt ex-file))
-  
-;; this function fixes ex-history for some commands like ex-read, ex-edit
-(defun ex-fixup-history (&rest args)  
-  (setq vip-ex-history
-	(cons (mapconcat 'identity args " ") (cdr vip-ex-history))))
-  
-
-;; Ex recover from emacs \#file\#
-(defun ex-recover ()
-  (vip-get-ex-file)
-  (if (or ex-append ex-offset)
-      (error "`recover': %s" vip-SpuriousText))
-  (if (string= ex-file "")
-      (progn
-	(if (null buffer-file-name)
-	    (error "This buffer isn't visiting any file"))
-	(setq ex-file buffer-file-name))
-    (setq ex-file (expand-file-name ex-file)))
-  (if (and (not (string= ex-file (buffer-file-name)))
-	   (buffer-modified-p)
-	   (not ex-variant))
-      (error "No write since last change \(:rec! overrides\)"))
-  (recover-file ex-file))
-
-;; Tell that `rewind' is obsolete and to use `:next count' instead
-(defun ex-rewind ()
-  (message
-   "Use `:n <count>' instead. Counts are obtained from the `:args' command"))
-
-
-;; read variable name for ex-set
-(defun ex-set-read-variable ()
-  (let ((minibuffer-local-completion-map
-	 (copy-keymap minibuffer-local-completion-map))
-	(cursor-in-echo-area t)
-	str batch)
-    (define-key
-      minibuffer-local-completion-map " " 'minibuffer-complete-and-exit)
-    (define-key minibuffer-local-completion-map "=" 'exit-minibuffer)
-    (if (vip-set-unread-command-events
-	 (ex-get-inline-cmd-args "[ \t]*[a-zA-Z]*[ \t]*" nil "\C-m"))
-	(progn
-	  (setq batch t)
-	  (vip-set-unread-command-events ?\C-m)))
-    (message ":set  <Variable> [= <Value>]")
-    (or batch (sit-for 2))
-    
-    (while (string-match "^[ \\t\\n]*$"
-			 (setq str
-			       (completing-read ":set " ex-variable-alist)))
-      (message ":set <Variable> ")
-      ;; if there are unread events, don't wait
-      (or (vip-set-unread-command-events "") (sit-for 2))
-      ) ; while
-    str))
-
-
-(defun ex-set ()
-  (let ((var (ex-set-read-variable))
-	(val 0)
-	(set-cmd "setq")
-	(ask-if-save t)
-	(auto-cmd-label "; don't touch or else...")
-	(delete-turn-on-auto-fill-pattern
-	 "([ \t]*add-hook[ \t]+'vip-insert-state-hooks[ \t]+'turn-on-auto-fill.*)")
-	actual-lisp-cmd lisp-cmd-del-pattern
-	val2 orig-var)
-    (setq orig-var var)
-    (cond ((member var '("ai" "autoindent"))
-	   (setq var "vip-auto-indent"
-		 set-cmd "setq"
-		 ask-if-save nil
-		 val "t"))
-	  ((member var '("gai" "global-autoindent"))
-	   (kill-local-variable 'vip-auto-indent)
-	   (setq var "vip-auto-indent"
-		 set-cmd "setq-default"
-		 val "t"))
-	  ((member var '("noai" "noautoindent"))
-	   (setq var "vip-auto-indent"
-		 ask-if-save nil
-		 val "nil"))
-	  ((member var '("gnoai" "global-noautoindent"))
-	   (kill-local-variable 'vip-auto-indent)
-	   (setq var "vip-auto-indent"
-		 set-cmd "setq-default"
-		 val "nil"))
-	  ((member var '("ic" "ignorecase"))
-	   (setq var "vip-case-fold-search"
-		 val "t"))
-	  ((member var '("noic" "noignorecase"))
-	   (setq var "vip-case-fold-search"
-		 val "nil"))
-	  ((member var '("ma" "magic"))
-	   (setq var "vip-re-search"
-		 val "t"))
-	  ((member var '("noma" "nomagic"))
-	   (setq var "vip-re-search"
-		 val "nil"))
-	  ((member var '("ro" "readonly"))
-	   (setq var "buffer-read-only"
-		 val "t"))
-	  ((member var '("noro" "noreadonly"))
-	   (setq var "buffer-read-only"
-		 val "nil"))
-	  ((member var '("sm" "showmatch"))
-	   (setq var "blink-matching-paren"
-		 val "t"))
-	  ((member var '("nosm" "noshowmatch"))
-	   (setq var "blink-matching-paren"
-		 val "nil"))
-	  ((member var '("ws" "wrapscan"))
-	   (setq var "vip-search-wrap-around-t"
-		 val "t"))
-	  ((member var '("nows" "nowrapscan"))
-	   (setq var "vip-search-wrap-around-t"
-		 val "nil")))
-    (if (eq val 0) ; value must be set by the user
-	(let ((cursor-in-echo-area t))
-	  (message ":set %s = <Value>" var)
-	  ;; if there are unread events, don't wait
-	  (or (vip-set-unread-command-events "") (sit-for 2))
-	  (setq val (read-string (format ":set %s = " var)))
-	  (ex-fixup-history "set" orig-var val)
-	  
-	  ;; check numerical values
-	  (if (member var
-		      '("sw" "shiftwidth"
-			"ts" "tabstop"
-			"gts" "global-tabstop"
-			"wm" "wrapmargin")) 
-	      (condition-case nil
-		  (or (numberp (setq val2 (car (read-from-string val))))
-		      (error "%s: Invalid value, numberp, %S" var val))
-		(error
-		 (error "%s: Invalid value, numberp, %S" var val))))
-		  
-	  (cond
-	   ((member var '("sw" "shiftwidth"))
-	    (setq var "vip-shift-width"))
-	   ((member var '("ts" "tabstop"))
-	    ;; make it take effect in curr buff and new bufs
-	    (setq var "tab-width"
-		  set-cmd "setq"
-		  ask-if-save nil))
-	   ((member var '("gts" "global-tabstop"))
-	    (kill-local-variable 'tab-width)
-	    (setq var "tab-width"
-		  set-cmd "setq-default"))
-	   ((member var '("wm" "wrapmargin"))
-	    ;; make it take effect in curr buff and new bufs
-	    (kill-local-variable 'fill-column) 
-	    (setq var "fill-column" 
-		  val (format "(- (window-width) %s)" val)
-		  set-cmd "setq-default"))
-	   ((member var '("sh" "shell"))
-	    (setq var "explicit-shell-file-name"
-		  val (format "\"%s\"" val)))))
-      (ex-fixup-history "set" orig-var))
-    
-    (setq actual-lisp-cmd (format "\n(%s %s %s) %s"
-				  set-cmd var val auto-cmd-label))
-    (setq lisp-cmd-del-pattern
-	  (format "^\n?[ \t]*([ \t]*%s[ \t]+%s[ \t].*)[ \t]*%s"
-		  set-cmd var auto-cmd-label))
-    
-    (if (and ask-if-save
-	     (y-or-n-p (format "Do you want to save this setting in %s "
-			       vip-custom-file-name)))
-	(progn
-	  (vip-save-string-in-file 
-	   actual-lisp-cmd vip-custom-file-name
-	   ;; del pattern
-	   lisp-cmd-del-pattern)
-	  (if (string= var "fill-column")
-	      (if (> val2 0)
-		  (vip-save-string-in-file
-		   (concat
-		    "(add-hook 'vip-insert-state-hooks 'turn-on-auto-fill) "
-		    auto-cmd-label)
-		   vip-custom-file-name
-		   delete-turn-on-auto-fill-pattern)
-		(vip-save-string-in-file
-		 nil vip-custom-file-name delete-turn-on-auto-fill-pattern)
-		(vip-save-string-in-file
-		 nil vip-custom-file-name
-		 ;; del pattern
-		 lisp-cmd-del-pattern)
-		))
-	  ))
-    
-    (message "%s %s %s" set-cmd var (if (string-match "^[ \t]*$" val)
-					(format "%S" val)
-				      val))
-    (eval (car (read-from-string actual-lisp-cmd)))
-	(if (string= var "fill-column")
-		(if (> val2 0)
-			(auto-fill-mode 1)
-		  (auto-fill-mode -1)))
-		
-    ))
-
-;; In inline args, skip regex-forw and (optionally) chars-back.
-;; Optional 3d arg is a string that should replace ' ' to prevent its
-;; special meaning
-(defun ex-get-inline-cmd-args (regex-forw &optional chars-back replace-str)
-  (save-excursion
-    (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-    (set-buffer vip-ex-work-buf)
-    (goto-char (point-min))
-    (re-search-forward regex-forw nil t)
-    (let ((beg (point))
-	  end)
-      (goto-char (point-max))
-      (if chars-back
-	  (skip-chars-backward chars-back)
-	(skip-chars-backward " \t\n\C-m"))
-      (setq end (point))
-      ;; replace SPC with `=' to suppress the special meaning SPC has
-      ;; in Ex commands
-      (goto-char beg)
-      (if replace-str
-	  (while (re-search-forward " +" nil t)
-	    (replace-match replace-str nil t)
-	    (vip-forward-char-carefully)))
-      (goto-char end)
-      (buffer-substring beg end))))
-
-
-;; Ex shell command
-(defun ex-shell ()
-  (shell))
-  
-;; Viper help. Invokes Info
-(defun ex-help ()
-  (condition-case nil
-      (progn
-	(pop-to-buffer (get-buffer-create "*info*"))
-	(info (if vip-xemacs-p "viper.info" "viper"))
-	(message "Type `i' to search for a specific topic"))
-    (error (beep 1)
-	   (with-output-to-temp-buffer " *vip-info*"
-	     (princ (format "
-The Info file for Viper does not seem to be installed.
-
-This file is part of the standard distribution of %sEmacs.
-Please contact your system administrator. "
-			    (if vip-xemacs-p "X" "")
-			    ))))))
-
-;; Ex source command. Loads the file specified as argument or `~/.vip'
-(defun ex-source ()
-  (vip-get-ex-file)
-  (if (string= ex-file "")
-      (load vip-custom-file-name)
-    (load ex-file)))
-
-;; Ex substitute command
-;; If REPEAT use previous regexp which is ex-reg-exp or vip-s-string
-(defun ex-substitute (&optional repeat r-flag) 
-  (let ((opt-g nil)
-	(opt-c nil)
-	(matched-pos nil)
-	(case-fold-search vip-case-fold-search)
-	delim pat repl)
-    (if repeat (setq ex-token nil) (setq delim (vip-get-ex-pat)))
-    (if (null ex-token)
-	(progn
-	  (setq pat (if r-flag vip-s-string ex-reg-exp))
-	  (or (stringp pat)
-	      (error "No previous pattern to use in substitution"))
-	  (setq repl ex-repl
-		delim (string-to-char pat)))
-      (setq pat (if (string= ex-token "") vip-s-string ex-token))
-      (setq vip-s-string pat
-	    ex-reg-exp pat)
-      (setq delim (vip-get-ex-pat))
-      (if (null ex-token)
-	  (setq ex-token ""
-		ex-repl "")
-	(setq repl ex-token
-	      ex-repl ex-token)))
-    (while (vip-get-ex-opt-gc delim)
-      (if (string= ex-token "g") (setq opt-g t) (setq opt-c t)))
-    (vip-get-ex-count)
-    (if ex-count
-	(save-excursion
-	  (if ex-addresses (goto-char (car ex-addresses)))
-	  (set-mark (point))
-	  (forward-line (1- ex-count))
-	  (setq ex-addresses (cons (point) (cons (mark t) nil))))
-      (if (null ex-addresses)
-	  (setq ex-addresses (cons (point) (cons (point) nil)))
-	(if (null (cdr ex-addresses))
-	    (setq ex-addresses (cons (car ex-addresses) ex-addresses)))))
-					;(setq G opt-g)
-    (let ((beg (car ex-addresses))
-	  (end (car (cdr ex-addresses)))
-	  eol-mark)
-      (save-excursion
-	(vip-enlarge-region beg end)
-	(let ((limit (save-excursion
-		       (goto-char (max (point) (mark t)))
-		       (point-marker))))
-	  (goto-char (min (point) (mark t)))
-	  (while (< (point) limit)
-	    (end-of-line)
-	    (setq eol-mark (point-marker))
-	    (beginning-of-line)
-	    (if opt-g
-		(progn
-		  (while (and (not (eolp))
-			      (re-search-forward pat eol-mark t))
-		    (if (or (not opt-c) (y-or-n-p "Replace? "))
-			(progn
-			  (setq matched-pos (point))
-			  (if (not (stringp repl))
-			      (error "Can't perform Ex substitution: No previous replacement pattern"))
-			  (replace-match repl t))))
-		  (end-of-line)
-		  (vip-forward-char-carefully))
-	      (if (null pat)
-		  (error
-		   "Can't repeat Ex substitution: No previous regular expression"))
-	      (if (and (re-search-forward pat eol-mark t)
-		       (or (not opt-c) (y-or-n-p "Replace? ")))
-		  (progn
-		    (setq matched-pos (point))
-		    (if (not (stringp repl))
-			(error "Can't perform Ex substitution: No previous replacement pattern"))
-		    (replace-match repl t)))
-	      (end-of-line)
-	      (vip-forward-char-carefully))))))
-    (if matched-pos (goto-char matched-pos))
-    (beginning-of-line)
-    (if opt-c (message "done"))))
-
-;; Ex tag command
-(defun ex-tag ()
-  (let (tag)
-    (save-window-excursion
-      (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-      (set-buffer vip-ex-work-buf)
-      (skip-chars-forward " \t")
-      (set-mark (point))
-      (skip-chars-forward "^ |\t\n")
-      (setq tag (buffer-substring (mark t) (point))))
-    (if (not (string= tag "")) (setq ex-tag tag))
-    (vip-change-state-to-emacs)
-    (condition-case conds
-	(progn
-	  (if (string= tag "")
-	      (find-tag ex-tag t)
-	    (find-tag-other-window ex-tag))
-	  (vip-change-state-to-vi))
-      (error
-       (vip-change-state-to-vi)
-       (vip-message-conditions conds)))))
-
-;; Ex write command
-(defun ex-write (q-flag)
-  (vip-default-ex-addresses t)
-  (vip-get-ex-file)
-  (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))) 
-	temp-buf writing-same-file region
-	file-exists writing-whole-file)
-    (if (> beg end) (error vip-FirstAddrExceedsSecond))
-    (if ex-cmdfile
-	(progn
-	  (vip-enlarge-region beg end)
-	  (shell-command-on-region (point) (mark t) ex-file))
-      (if (and (string= ex-file "") (not (buffer-file-name)))
-	  (setq ex-file
-		(read-file-name
-		 (format "Buffer %s isn't visiting any file. File to save in: "
-			 (buffer-name)))))
-      
-      (setq writing-whole-file (and (= (point-min) beg) (= (point-max) end))
-	    ex-file (if (string= ex-file "")
-			(buffer-file-name)
-		      (expand-file-name ex-file)))
-      ;; if ex-file is a directory use the file portion of the buffer file name
-      (if (and (file-directory-p ex-file)
-	       buffer-file-name
-	       (not (file-directory-p buffer-file-name)))
-	  (setq ex-file
-		(concat ex-file (file-name-nondirectory buffer-file-name))))
-
-      (setq file-exists (file-exists-p ex-file)
-	    writing-same-file (string= ex-file (buffer-file-name)))
-
-      (if (and writing-whole-file writing-same-file)
-	  (if (not (buffer-modified-p))
-	      (message "(No changes need to be saved)")
-	    (save-buffer)
-	    (ex-write-info file-exists ex-file beg end))
-	;; writing some other file or portion of the currents
-	;; file---create temp buffer for it
-	;; disable undo in that buffer, for efficiency
-	(buffer-disable-undo (setq temp-buf (create-file-buffer ex-file)))
-	(unwind-protect 
-	    (save-excursion
-	      (if (and file-exists
-		       (not writing-same-file)
-		       (not (yes-or-no-p
-			     (format "File %s exists. Overwrite? " ex-file))))
-		  (error "Quit")
-		(vip-enlarge-region beg end)
-		(setq region (buffer-substring (point) (mark t)))
-		(set-buffer temp-buf)
-		(set-visited-file-name ex-file)
-		(erase-buffer)
-		(if (and file-exists ex-append)
-		    (insert-file-contents ex-file))
-		(goto-char (point-max))
-		(insert region)
-		(save-buffer)
-		(ex-write-info file-exists ex-file (point-min) (point-max))
-		)
-	      (set-buffer temp-buf)
-	      (set-buffer-modified-p nil)
-	      (kill-buffer temp-buf)
-	      ))
-	)
-      ;; this prevents the loss of data if writing part of the buffer
-      (if (and (buffer-file-name) writing-same-file)
-	  (set-visited-file-modtime))
-      (or writing-whole-file 
-	  (not writing-same-file)
-	  (set-buffer-modified-p t))
-      (if q-flag
-	  (if (< vip-expert-level 2)
-	      (save-buffers-kill-emacs)
-	    (kill-buffer (current-buffer))))
-      )))
-	  
-
-(defun ex-write-info (exists file-name beg end)
-  (message "`%s'%s %d lines, %d characters"
-	   (vip-abbreviate-file-name file-name)
-	   (if exists "" " [New file]")
-	   (count-lines beg (min (1+ end) (point-max)))
-	   (- end beg)))
-
-;; Ex yank command
-(defun ex-yank ()
-  (vip-default-ex-addresses)
-  (vip-get-ex-buffer)
-  (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-    (if (> beg end) (error vip-FirstAddrExceedsSecond))
-    (save-excursion
-      (vip-enlarge-region beg end)
-      (exchange-point-and-mark)
-      (if (or ex-g-flag ex-g-variant)
-	  (error "Can't execute `yank' within `global'"))
-      (if ex-count
-	  (progn
-	    (set-mark (point))
-	    (forward-line (1- ex-count)))
-	(set-mark end))
-      (vip-enlarge-region (point) (mark t))
-      (if ex-flag (error "`yank': %s" vip-SpuriousText))
-      (if ex-buffer
-	  (cond ((vip-valid-register ex-buffer '(Letter))
-		 (vip-append-to-register
-		  (downcase ex-buffer) (point) (mark t)))
-		((vip-valid-register ex-buffer)
-		 (copy-to-register ex-buffer (point) (mark t) nil))
-		(t (error vip-InvalidRegister ex-buffer))))
-      (copy-region-as-kill (point) (mark t)))))
-
-;; Execute shell command
-(defun ex-command ()
-  (let (command)
-    (save-window-excursion
-      (setq vip-ex-work-buf (get-buffer-create vip-ex-work-buf-name)) 
-      (set-buffer vip-ex-work-buf)
-      (skip-chars-forward " \t")
-      (setq command (buffer-substring (point) (point-max)))
-      (end-of-line))
-    (setq command (ex-expand-filsyms command (current-buffer)))
-    (if (and (> (length command) 0) (string= "!" (substring command 0 1)))
-	(if vip-ex-last-shell-com
-	    (setq command (concat vip-ex-last-shell-com (substring command 1)))
-	  (error "No previous shell command")))
-    (setq vip-ex-last-shell-com command)
-    (if (null ex-addresses)
-	(shell-command command)
-      (let ((end (car ex-addresses)) (beg (car (cdr ex-addresses))))
-	(if (null beg) (setq beg end))
-	(save-excursion
-	  (goto-char beg)
-	  (set-mark end)
-	  (vip-enlarge-region (point) (mark t))
-	  (shell-command-on-region (point) (mark t) command t))
-	(goto-char beg)))))
-
-;; Print line number
-(defun ex-line-no ()
-  (message "%d"
-	   (1+ (count-lines
-		(point-min)
-		(if (null ex-addresses) (point-max) (car ex-addresses))))))
-
-;; Give information on the file visited by the current buffer
-(defun vip-info-on-file ()
-  (interactive)
-  (let ((pos1 (vip-line-pos 'start))
-	(pos2 (vip-line-pos 'end))
-	lines file info)
-    (setq lines (count-lines (point-min) (vip-line-pos 'end))
-	  file (if (buffer-file-name)
-		   (concat (vip-abbreviate-file-name (buffer-file-name)) ":")
-		 (concat (buffer-name) " [Not visiting any file]:"))
-	  info (format "line=%d/%d pos=%d/%d col=%d %s"
-		       (if (= pos1 pos2)
-			   (1+ lines)
-			 lines)
-		       (count-lines (point-min) (point-max))
-		       (point) (1- (point-max))
-		       (1+ (current-column))
-		       (if (buffer-modified-p) "[Modified]" "[Unchanged]")))
-    (if (< (+ 1 (length info) (length file))
-	   (window-width (minibuffer-window)))
-	(message (concat file " " info))
-      (save-window-excursion
-	(with-output-to-temp-buffer " *vip-info*"
-	  (princ (concat "\n"
-			 file "\n\n\t" info
-			 "\n\n\nPress any key to continue...\n\n")))
-	(vip-read-event)
-	(kill-buffer " *vip-info*")))
-    ))
-
-
-(provide 'viper-ex)
-
-;;;  viper-ex.el ends here
diff --git a/lisp/emulation/viper-keym.el b/lisp/emulation/viper-keym.el
deleted file mode 100644
index f9c09514d79..00000000000
--- a/lisp/emulation/viper-keym.el
+++ /dev/null
@@ -1,584 +0,0 @@
-;;; viper-keym.el --- Viper keymaps
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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.
-
-;; Code
-
-(require 'viper-util)
-
-;;; Variables
-
-(defvar vip-toggle-key "\C-z"
-  "The key used to change states from emacs to Vi and back.
-In insert mode, this key also functions as Meta. 
-Must be set in .vip file or prior to loading Viper.
-This setting cannot be changed interactively.")
-
-(defvar vip-ESC-key "\e" 
-  "Key used to ESC. 
-Must be set in .vip file or prior to loading Viper.
-This setting cannot be changed interactively.")
-
-
-;;; Keymaps
-
-;; Keymaps for vital things like \e and C-z.
-;; Not for users
-(defvar vip-vi-intercept-map (make-sparse-keymap))
-(defvar vip-insert-intercept-map (make-sparse-keymap))
-(defvar vip-emacs-intercept-map (make-sparse-keymap))
-
-;; keymap used to zap all keymaps other than function-key-map,
-;; device-function-key-map, etc.
-(defvar vip-overriding-map (make-sparse-keymap))
-  
-(vip-deflocalvar vip-vi-local-user-map (make-sparse-keymap)
-  "Keymap for user-defined local bindings.
-Useful for changing bindings such as ZZ in certain major modes.
-For instance, in letter-mode, one may want to bind ZZ to
-mh-send-letter. In a newsreader such as gnus, tin, or rn, ZZ could be bound
-to save-buffers-kill-emacs then post article, etc.")
-(put 'vip-vi-local-user-map 'permanent-local t)	
-
-(defvar vip-vi-global-user-map (make-sparse-keymap)
-  "Keymap for user-defined global bindings.
-These bindings are seen in all Viper buffers.")
-
-(defvar vip-vi-basic-map (make-keymap)
-  "This is the main keymap in effect in Viper's Vi state.
-This map is global, shared by all buffers.")
-
-(defvar  vip-vi-kbd-map (make-sparse-keymap)
-  "This keymap keeps keyboard macros defined via the :map command.")
-
-(defvar vip-vi-diehard-map (make-sparse-keymap)
-  "This keymap is in use when the user asks Viper to simulate Vi very closely.
-This happens when vip-expert-level is 1 or 2. See vip-set-expert-level.")
-  
-
-(vip-deflocalvar vip-insert-local-user-map (make-sparse-keymap)
-  "Auxiliary map for per-buffer user-defined keybindings in Insert state.")
-(put 'vip-insert-local-user-map 'permanent-local t)	
-
-(defvar vip-insert-global-user-map (make-sparse-keymap)
-  "Auxiliary map for global user-defined bindings in Insert state.")
-
-(defvar vip-insert-basic-map (make-sparse-keymap)
-  "The basic insert-mode keymap.")
-
-(defvar vip-insert-diehard-map (make-keymap)
-  "Map used when user wants vi-style keys in insert mode.
-Most of the Emacs keys are suppressed. This map overshadows
-vip-insert-basic-map. Not recommended, except for novice users.")
-
-(defvar  vip-insert-kbd-map  (make-sparse-keymap)
-  "This keymap keeps VI-style kbd macros for insert mode.")
-
-(defvar vip-replace-map (make-sparse-keymap)
-  "Map used in Viper's replace state.")
-  
-(defvar vip-emacs-global-user-map (make-sparse-keymap)
-  "Auxiliary map for global user-defined bindings in Emacs state.")
-
-(defvar  vip-emacs-kbd-map  (make-sparse-keymap)
-  "This keymap keeps Vi-style kbd macros for emacs mode.")
-  
-(vip-deflocalvar vip-emacs-local-user-map  (make-sparse-keymap)
-  "Auxiliary map for local user-defined bindings in Emacs state.")
-(put 'vip-emacs-local-user-map 'permanent-local t)  
-
-;; This keymap should stay empty
-(defvar vip-empty-keymap (make-sparse-keymap))
-
-;; This was the main Vi mode in old versions of VIP which may have been
-;; extensively used by VIP users. We declare it as a global var
-;; and, after .vip is loaded, we add this keymap to vip-vi-basic-map.
-(defvar vip-mode-map (make-sparse-keymap))
-
-
-;;; Variables used by minor modes
-
-;; Association list of the form 
-;; ((major-mode . keymap) (major-mode . keymap) ...)
-;; Viper uses these keymaps to make user-requested adjustments
-;; to its Vi state in various major modes.")
-(defvar vip-vi-state-modifier-alist nil)
-
-;; Association list of the form 
-;; ((major-mode . keymap) (major-mode . keymap) ...)
-;; Viper uses these keymaps to make user-requested adjustments
-;; to its Insert state in various major modes.")
-(defvar vip-insert-state-modifier-alist nil)
-
-;; Association list of the form 
-;; ((major-mode . keymap) (major-mode . keymap) ...)
-;; Viper uses these keymaps to make user-requested adjustments
-;; to its Emacs state in various major modes.
-(defvar vip-emacs-state-modifier-alist nil)
-
-;; Tells vip-add-local-keys to create a new vip-vi-local-user-map for new
-;; buffers. Not a user option.
-(vip-deflocalvar vip-need-new-vi-local-map t "")
-(put 'vip-need-new-vi-local-map  'permanent-local t)
-
-;; Tells vip-add-local-keys to create a new vip-insert-local-user-map for new
-;; buffers. Not a user option.
-(vip-deflocalvar vip-need-new-insert-local-map t "")
-(put 'vip-need-new-insert-local-map  'permanent-local t)
-
-;; Tells vip-add-local-keys to create a new vip-emacs-local-user-map for new
-;; buffers. Not a user option.
-(vip-deflocalvar vip-need-new-emacs-local-map t "")
-(put 'vip-need-new-emacs-local-map  'permanent-local t)
-
-
-
-;; Insert mode keymap
-
-;; for novice users, pretend you are the real vi.
-(define-key vip-insert-diehard-map "\t"   'vip-insert-tab)
-(define-key vip-insert-diehard-map "\C-a" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-b" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-c" 'vip-change-state-to-vi)
-(define-key vip-insert-diehard-map "\C-e" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-f" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-g" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-i" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-k" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-l" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-n" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-o" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-p" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-q" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-r" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-s" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-u" 'vip-erase-line)
-(define-key vip-insert-diehard-map "\C-x" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-y" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-z" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-]" 'self-insert-command)
-(define-key vip-insert-diehard-map "\C-_" 'self-insert-command)
-
-(let ((i ?\ ))
-  (while (<= i ?~)
-    (define-key vip-insert-diehard-map (make-string 1 i) 'self-insert-command)
-    (setq i (1+ i))))
-
-;; Insert mode map when user wants emacs style
-(define-key vip-insert-basic-map "\C-d" 'vip-backward-indent)
-(define-key vip-insert-basic-map "\C-w" 'vip-delete-backward-word)
-(define-key vip-insert-basic-map "\C-t" 'vip-forward-indent)
-(define-key vip-insert-basic-map 
-  (if vip-xemacs-p [(shift tab)] [S-tab]) 'vip-insert-tab)
-(define-key vip-insert-basic-map "\C-v" 'quoted-insert)
-(define-key vip-insert-basic-map "\C-?" 'vip-del-backward-char-in-insert)
-(define-key vip-insert-basic-map "\C-\\" 'vip-alternate-Meta-key)
-(define-key vip-insert-basic-map vip-toggle-key 'vip-escape-to-vi)
-(define-key vip-insert-basic-map "\C-c\M-p"
-  'vip-insert-prev-from-insertion-ring)
-(define-key vip-insert-basic-map "\C-c\M-n"
-  'vip-insert-next-from-insertion-ring)
-
-
-;; Replace keymap
-(define-key vip-replace-map "\C-t" 'vip-forward-indent)
-(define-key vip-replace-map "\C-j" 'vip-replace-state-exit-cmd)
-(define-key vip-replace-map "\C-m" 'vip-replace-state-exit-cmd)
-(define-key vip-replace-map "\C-?" 'vip-del-backward-char-in-replace)
-
-
-
-;; Vi keymaps
-
-(define-key vip-vi-basic-map "\C-^" 
-  (function (lambda () (interactive) (vip-ex "e#"))))
-(define-key vip-vi-basic-map "\C-b" 'vip-scroll-screen-back)
-(define-key vip-vi-basic-map "\C-d" 'vip-scroll-up)
-(define-key vip-vi-basic-map "\C-e" 'vip-scroll-up-one)
-(define-key vip-vi-basic-map "\C-f" 'vip-scroll-screen)
-(define-key vip-vi-basic-map "\C-m" 'vip-next-line-at-bol)
-(define-key vip-vi-basic-map "\C-u" 'vip-scroll-down)
-(define-key vip-vi-basic-map "\C-y" 'vip-scroll-down-one)
-(define-key vip-vi-basic-map "\C-s" 'vip-isearch-forward)
-(define-key vip-vi-basic-map "\C-r" 'vip-isearch-backward)
-(define-key vip-vi-basic-map "\C-c/" 'vip-toggle-search-style)
-(define-key vip-vi-basic-map "\C-cg" 'vip-info-on-file)
-
-(define-key vip-vi-basic-map "\C-c\M-p" 'vip-prev-destructive-command)
-(define-key vip-vi-basic-map "\C-c\M-n" 'vip-next-destructive-command)
-
-
-(define-key vip-vi-basic-map " " 'vip-forward-char)
-(define-key vip-vi-basic-map "!" 'vip-command-argument)
-(define-key vip-vi-basic-map "\"" 'vip-command-argument)
-(define-key vip-vi-basic-map "#" 'vip-command-argument)
-(define-key vip-vi-basic-map "$" 'vip-goto-eol)
-(define-key vip-vi-basic-map "%" 'vip-paren-match)
-(define-key vip-vi-basic-map "&"
-  (function (lambda () (interactive) (vip-ex "&"))))
-(define-key vip-vi-basic-map "'" 'vip-goto-mark-and-skip-white)
-(define-key vip-vi-basic-map "(" 'vip-backward-sentence)
-(define-key vip-vi-basic-map ")" 'vip-forward-sentence)
-(define-key vip-vi-basic-map "*" 'call-last-kbd-macro)
-(define-key vip-vi-basic-map "+" 'vip-next-line-at-bol)
-(define-key vip-vi-basic-map "," 'vip-repeat-find-opposite)
-(define-key vip-vi-basic-map "-" 'vip-previous-line-at-bol)
-(define-key vip-vi-basic-map "." 'vip-repeat)
-(define-key vip-vi-basic-map "/" 'vip-search-forward)
-
-(define-key vip-vi-basic-map "0" 'vip-beginning-of-line)
-(define-key vip-vi-basic-map "1" 'vip-digit-argument)
-(define-key vip-vi-basic-map "2" 'vip-digit-argument)
-(define-key vip-vi-basic-map "3" 'vip-digit-argument)
-(define-key vip-vi-basic-map "4" 'vip-digit-argument)
-(define-key vip-vi-basic-map "5" 'vip-digit-argument)
-(define-key vip-vi-basic-map "6" 'vip-digit-argument)
-(define-key vip-vi-basic-map "7" 'vip-digit-argument)
-(define-key vip-vi-basic-map "8" 'vip-digit-argument)
-(define-key vip-vi-basic-map "9" 'vip-digit-argument)
-
-(define-key vip-vi-basic-map ":" 'vip-ex)
-(define-key vip-vi-basic-map ";" 'vip-repeat-find)
-(define-key vip-vi-basic-map "<" 'vip-command-argument)
-(define-key vip-vi-basic-map "=" 'vip-command-argument)
-(define-key vip-vi-basic-map ">" 'vip-command-argument)
-(define-key vip-vi-basic-map "?" 'vip-search-backward)
-(define-key vip-vi-basic-map "@" 'vip-register-macro)
-
-(define-key vip-vi-basic-map "A" 'vip-Append)
-(define-key vip-vi-basic-map "B" 'vip-backward-Word)
-(define-key vip-vi-basic-map "C" 'vip-change-to-eol)
-(define-key vip-vi-basic-map "D" 'vip-kill-line)
-(define-key vip-vi-basic-map "E" 'vip-end-of-Word)
-(define-key vip-vi-basic-map "F" 'vip-find-char-backward)
-(define-key vip-vi-basic-map "G" 'vip-goto-line)
-(define-key vip-vi-basic-map "H" 'vip-window-top)
-(define-key vip-vi-basic-map "I" 'vip-Insert)
-(define-key vip-vi-basic-map "J" 'vip-join-lines)
-(define-key vip-vi-basic-map "K" 'vip-nil)
-(define-key vip-vi-basic-map "L" 'vip-window-bottom)
-(define-key vip-vi-basic-map "M" 'vip-window-middle)
-(define-key vip-vi-basic-map "N" 'vip-search-Next)
-(define-key vip-vi-basic-map "O" 'vip-Open-line)
-(define-key vip-vi-basic-map "P" 'vip-Put-back)
-(define-key vip-vi-basic-map "Q" 'vip-query-replace)
-(define-key vip-vi-basic-map "R" 'vip-overwrite)
-(define-key vip-vi-basic-map "S" 'vip-substitute-line)
-(define-key vip-vi-basic-map "T" 'vip-goto-char-backward)
-(define-key vip-vi-basic-map "U" 'vip-undo)
-(define-key vip-vi-basic-map "V" 'find-file-other-window)
-(define-key vip-vi-basic-map "W" 'vip-forward-Word)
-(define-key vip-vi-basic-map "X" 'vip-delete-backward-char)
-(define-key vip-vi-basic-map "Y" 'vip-yank-line)
-(define-key vip-vi-basic-map "ZZ" 'vip-save-kill-buffer)
-
-(define-key vip-vi-basic-map "\\" 'vip-escape-to-emacs)
-(define-key vip-vi-basic-map "[" 'vip-brac-function)
-(define-key vip-vi-basic-map "]" 'vip-ket-function)
-(define-key vip-vi-basic-map "\C-\\" 'vip-alternate-Meta-key)
-(define-key vip-vi-basic-map "^" 'vip-bol-and-skip-white)
-(define-key vip-vi-basic-map "`" 'vip-goto-mark)
-
-(define-key vip-vi-basic-map "a" 'vip-append)
-(define-key vip-vi-basic-map "b" 'vip-backward-word)
-(define-key vip-vi-basic-map "c" 'vip-command-argument)
-(define-key vip-vi-basic-map "d" 'vip-command-argument)
-(define-key vip-vi-basic-map "e" 'vip-end-of-word)
-(define-key vip-vi-basic-map "f" 'vip-find-char-forward)
-(define-key vip-vi-basic-map "g" 'vip-nil)
-(define-key vip-vi-basic-map "h" 'vip-backward-char)
-(define-key vip-vi-basic-map "i" 'vip-insert)
-(define-key vip-vi-basic-map "j" 'vip-next-line)
-(define-key vip-vi-basic-map "k" 'vip-previous-line)
-(define-key vip-vi-basic-map "l" 'vip-forward-char)
-(define-key vip-vi-basic-map "m" 'vip-mark-point)
-(define-key vip-vi-basic-map "n" 'vip-search-next)
-(define-key vip-vi-basic-map "o" 'vip-open-line)
-(define-key vip-vi-basic-map "p" 'vip-put-back)
-(define-key vip-vi-basic-map "q" 'vip-nil)
-(define-key vip-vi-basic-map "r" 'vip-replace-char)
-(define-key vip-vi-basic-map "s" 'vip-substitute)
-(define-key vip-vi-basic-map "t" 'vip-goto-char-forward)
-(define-key vip-vi-basic-map "u" 'vip-undo)
-(define-key vip-vi-basic-map "v" 'find-file)
-(define-key vip-vi-basic-map "\C-v" 'find-file-other-frame)
-(define-key vip-vi-basic-map "w" 'vip-forward-word)
-(define-key vip-vi-basic-map "x" 'vip-delete-char)
-(define-key vip-vi-basic-map "y" 'vip-command-argument)
-(define-key vip-vi-basic-map "zH" 'vip-line-to-top)
-(define-key vip-vi-basic-map "zM" 'vip-line-to-middle)
-(define-key vip-vi-basic-map "zL" 'vip-line-to-bottom)
-(define-key vip-vi-basic-map "z\C-m" 'vip-line-to-top)
-(define-key vip-vi-basic-map "z." 'vip-line-to-middle)
-(define-key vip-vi-basic-map "z-" 'vip-line-to-bottom)
-
-(define-key vip-vi-basic-map "{" 'vip-backward-paragraph)
-(define-key vip-vi-basic-map "|" 'vip-goto-col)
-(define-key vip-vi-basic-map "}" 'vip-forward-paragraph)
-(define-key vip-vi-basic-map "~" 'vip-toggle-case)
-(define-key vip-vi-basic-map "\C-?" 'vip-backward-char)
-(define-key vip-vi-basic-map "_" 'vip-nil)
-  
-;;; Escape from Emacs to Vi for one command
-(global-set-key "\C-c\\" 'vip-escape-to-vi)  ; everywhere
-
-;;; This is vip-vi-diehard-map. Used when vip-vi-diehard-minor-mode is on.
-
-(define-key vip-vi-diehard-map "\C-a" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-c" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-g" 'vip-info-on-file)
-(define-key vip-vi-diehard-map "\C-i" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-k" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-l" 'redraw-display)
-(define-key vip-vi-diehard-map "\C-n" 'vip-next-line)
-(define-key vip-vi-diehard-map "\C-o" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-p" 'vip-previous-line)
-(define-key vip-vi-diehard-map "\C-q" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-r" 'redraw-display)
-(define-key vip-vi-diehard-map "\C-s" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-t" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-v" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-w" 'vip-nil)
-(define-key vip-vi-diehard-map "@" 'vip-nil)
-(define-key vip-vi-diehard-map "_" 'vip-nil)
-(define-key vip-vi-diehard-map "*" 'vip-nil)
-(define-key vip-vi-diehard-map "#" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-_" 'vip-nil)
-(define-key vip-vi-diehard-map "\C-]" 'vip-nil) ; This is actually tags.
-
-
-;;; Minibuffer keymap
-  
-
-(defvar vip-minibuffer-map (make-sparse-keymap)
-  "Keymap used to modify keys when Minibuffer is in Insert state.")
-  
-(define-key vip-minibuffer-map "\C-m" 'vip-exit-minibuffer)
-(define-key vip-minibuffer-map "\C-j" 'vip-exit-minibuffer)
-
-;; Map used to read Ex-style commands.
-(defvar vip-ex-cmd-map (make-sparse-keymap))
-(define-key vip-ex-cmd-map " "  'ex-cmd-read-exit)
-(define-key vip-ex-cmd-map "\t" 'ex-cmd-complete)
-
-;; Keymap for reading file names in Ex-style commands.
-(defvar ex-read-filename-map (make-sparse-keymap))
-(define-key ex-read-filename-map " " 'vip-complete-filename-or-exit)
-(define-key ex-read-filename-map "!" 'vip-handle-!)
-
-;; Some other maps
-(defvar vip-slash-and-colon-map (make-sparse-keymap)
-  "This map redefines `/' and `:' to behave as in Vi.
-Useful in some modes, such as Gnus, MH, etc.")
-(define-key vip-slash-and-colon-map ":" 'vip-ex)
-(define-key vip-slash-and-colon-map "/" 'vip-search-forward)
-
-(defvar vip-comint-mode-modifier-map (make-sparse-keymap)
-  "This map modifies comint mode.")
-(define-key vip-comint-mode-modifier-map "\C-m" 'comint-send-input)
-(define-key vip-comint-mode-modifier-map "\C-d" 'comint-delchar-or-maybe-eof)
-
-(defvar vip-dired-modifier-map (make-sparse-keymap)
-  "This map modifies Dired behavior.")
-(define-key vip-dired-modifier-map ":" 'vip-ex)
-(define-key vip-dired-modifier-map "/" 'vip-search-forward)
-
-
-
-;;; Code
-
-(defun vip-add-local-keys (state alist)
-  "Override some vi-state or insert-state bindings in the current buffer.
-The effect is seen in the current buffer only.
-Useful for customizing  mailer buffers, gnus, etc.
-STATE is 'vi-state, 'insert-state, or 'emacs-state
-ALIST is of the form ((key . func) (key . func) ...)
-Normally, this would be called from a hook to a major mode or
-on a per buffer basis.
-Usage:
-      (vip-add-local-keys state '((key-str . func) (key-str . func)...))   "
-      
-  (let (map)
-    (cond ((eq state 'vi-state)
-	   (if vip-need-new-vi-local-map
-	       (setq vip-vi-local-user-map (make-sparse-keymap)))
-	   (setq vip-need-new-vi-local-map nil
-		 map vip-vi-local-user-map))
-	  ((eq state 'insert-state)
-	   (if vip-need-new-insert-local-map
-	       (setq vip-insert-local-user-map (make-sparse-keymap)))
-	   (setq vip-need-new-insert-local-map nil
-		 map vip-insert-local-user-map))
-	  ((eq state 'emacs-state)
-	   (if vip-need-new-emacs-local-map
-	       (setq vip-emacs-local-user-map (make-sparse-keymap)))
-	   (setq vip-need-new-emacs-local-map nil
-		 map vip-emacs-local-user-map))
-	  (t 
-	   (error
-	    "Invalid state in vip-add-local-keys: %S. Valid states: vi-state, insert-state or emacs-state" state)))
-
-    (vip-modify-keymap map alist)
-    (vip-normalize-minor-mode-map-alist)
-    (vip-set-mode-vars-for vip-current-state)))
-
-(defun vip-zap-local-keys ()
-  "Unconditionally reset Viper vip-*-local-user-map's.
-Rarely useful, but if u made a mistake by switching to a mode that adds
-undesirable local keys, e.g., comint-mode, then this function can restore
-sanity."
-  (interactive)
-  (setq vip-vi-local-user-map (make-sparse-keymap)
-	vip-need-new-vi-local-map nil
-	vip-insert-local-user-map (make-sparse-keymap)
-	vip-need-new-insert-local-map nil
-	vip-emacs-local-user-map (make-sparse-keymap)
-	vip-need-new-emacs-local-map nil)
-  (vip-normalize-minor-mode-map-alist))
-    
-
-(defun vip-modify-major-mode (mode state keymap)
-  "Modify key bindings in a major-mode in a Viper state using a keymap.
-
-If the default for a major mode is emacs-state, then modifications to this
-major mode may not take effect until the buffer switches state to Vi,
-Insert or Emacs. If this happens, add vip-change-state-to-emacs to this
-major mode's hook. If no such hook exists, you may have to put an advice on
-the function that invokes the major mode. See vip-set-hooks for hints.
-
-The above needs not to be done for major modes that come up in Vi or Insert
-state by default.
-
-Arguments: (major-mode vip-state keymap)"
-  (let ((alist
-	 (cond ((eq state 'vi-state) 'vip-vi-state-modifier-alist)
-	       ((eq state 'insert-state) 'vip-insert-state-modifier-alist)
-	       ((eq state 'emacs-state) 'vip-emacs-state-modifier-alist)))
-	elt)
-    (if (setq elt (assoc mode (eval alist)))
-	(set alist (delq elt (eval alist))))
-    (set alist (cons (cons mode keymap) (eval alist)))
-    
-    ;; Normalization usually doesn't help here, since one needs to
-    ;; normalize in the actual buffer where changes to the keymap are
-    ;; to take place. However, it doesn't hurt, and it helps whenever this
-    ;; function is actually called from within the right buffer.
-    (vip-normalize-minor-mode-map-alist)
-    
-    (vip-set-mode-vars-for vip-current-state)))
-
-    
-;; Displays variables that control Viper's keymaps
-(defun vip-debug-keymaps ()
-  (interactive)
-  (with-output-to-temp-buffer " *vip-debug*"
-    (princ (format "Buffer name:  %s\n\n" (buffer-name)))
-    (princ "Variables:  \n")
-    (princ (format "major-mode:  %S\n" major-mode))
-    (princ (format "vip-current-state:  %S\n" vip-current-state))
-    (princ (format "vip-mode-string:  %S\n\n" vip-mode-string))
-    (princ (format "vip-vi-intercept-minor-mode:  %S\n"
-		   vip-vi-intercept-minor-mode))
-    (princ (format "vip-insert-intercept-minor-mode:  %S\n"
-		   vip-insert-intercept-minor-mode))
-    (princ (format "vip-emacs-intercept-minor-mode:  %S\n"
-		   vip-emacs-intercept-minor-mode))
-    (princ (format "vip-vi-minibuffer-minor-mode:  %S\n"
-		   vip-vi-minibuffer-minor-mode))
-    (princ (format "vip-insert-minibuffer-minor-mode:  %S\n\n"
-		   vip-insert-minibuffer-minor-mode))
-    (princ (format "vip-vi-local-user-minor-mode:  %S\n"
-		   vip-vi-local-user-minor-mode))
-    (princ (format "vip-vi-global-user-minor-mode:  %S\n"
-		   vip-vi-global-user-minor-mode))
-    (princ (format "vip-vi-kbd-minor-mode:  %S\n" vip-vi-kbd-minor-mode))
-    (princ (format "vip-vi-state-modifier-minor-mode:  %S\n"
-		   vip-vi-state-modifier-minor-mode))
-    (princ (format "vip-vi-diehard-minor-mode:  %S\n"
-		   vip-vi-diehard-minor-mode))
-    (princ (format "vip-vi-basic-minor-mode:  %S\n" vip-vi-basic-minor-mode))
-    (princ (format "vip-replace-minor-mode:  %S\n" vip-replace-minor-mode))
-    (princ (format "vip-insert-local-user-minor-mode:  %S\n"
-		   vip-insert-local-user-minor-mode))
-    (princ (format "vip-insert-global-user-minor-mode:  %S\n"
-		   vip-insert-global-user-minor-mode))
-    (princ (format "vip-insert-kbd-minor-mode:  %S\n"
-		   vip-insert-kbd-minor-mode)) 
-    (princ (format "vip-insert-state-modifier-minor-mode:  %S\n"
-		   vip-insert-state-modifier-minor-mode))
-    (princ (format "vip-insert-diehard-minor-mode:  %S\n"
-		   vip-insert-diehard-minor-mode))
-    (princ (format "vip-insert-basic-minor-mode:  %S\n"
-		   vip-insert-basic-minor-mode))
-    (princ (format "vip-emacs-local-user-minor-mode:  %S\n"
-		   vip-emacs-local-user-minor-mode))
-    (princ (format "vip-emacs-kbd-minor-mode:  %S\n"
-		   vip-emacs-kbd-minor-mode))
-    (princ (format "vip-emacs-global-user-minor-mode:  %S\n"
-		   vip-emacs-global-user-minor-mode))
-    (princ (format "vip-emacs-state-modifier-minor-mode:  %S\n"
-		   vip-emacs-state-modifier-minor-mode))
-    
-    (princ (format "\nvip-expert-level  %S\n" vip-expert-level))
-    (princ (format "vip-no-multiple-ESC  %S\n" vip-no-multiple-ESC))
-    (princ (format "vip-always  %S\n" vip-always))
-    (princ (format "vip-ex-style-motion  %S\n"
-		   vip-ex-style-motion))
-    (princ (format "vip-ex-style-editing-in-insert  %S\n"
-		   vip-ex-style-editing-in-insert))
-    (princ (format "vip-want-emacs-keys-in-vi  %S\n"
-		   vip-want-emacs-keys-in-vi)) 
-    (princ (format "vip-want-emacs-keys-in-insert  %S\n"
-		   vip-want-emacs-keys-in-insert)) 
-    (princ (format "vip-want-ctl-h-help  %S\n" vip-want-ctl-h-help))
-    
-    (princ "\n\n\n")
-    (princ (format "Default value for minor-mode-map-alist:  \n%S\n\n"
-		   (default-value 'minor-mode-map-alist)))
-    (princ (format "Actual value for minor-mode-map-alist:  \n%S\n"
-		   minor-mode-map-alist))
-    ))
-   
-
-;;; Keymap utils
-	     
-(defun vip-add-keymap (mapsrc mapdst) 
-  "Add contents of mapsrc to mapdst. It is assumed that mapsrc is sparse."
-  (if vip-xemacs-p
-      (map-keymap (function (lambda (key binding)
-			      (define-key mapdst key binding)))
-		  mapsrc)
-    (mapcar 
-     (function (lambda (p) 
-		 (define-key mapdst (vector (car p)) (cdr p))
-		 ))
-     (cdr mapsrc))))
-  
-(defun vip-modify-keymap (map alist)
-   "Modifies MAP with bindings specified in the ALIST. The alist has the
-form ((key . function) (key . function) ... )."
-   (mapcar (function (lambda (p)
-		       (define-key map (eval (car p)) (cdr p)))) 
-	   alist))
-
-
-(provide 'viper-keym)
-
-;;;  viper-keym.el ends here
diff --git a/lisp/emulation/viper-macs.el b/lisp/emulation/viper-macs.el
deleted file mode 100644
index 6b0b2fb99ea..00000000000
--- a/lisp/emulation/viper-macs.el
+++ /dev/null
@@ -1,943 +0,0 @@
-;;; viper-macs.el --- functions implementing keyboard macros for Viper
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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.
-
-;; Code
-
-(require 'viper-util)
-(require 'viper-keym)
-
-
-;;; Variables
-
-;; Register holding last macro.
-(defvar vip-last-macro-reg nil)
-
-;; format of the elements of kbd alists: 
-;; (name ((buf . macr)...(buf . macr)) ((maj-mode . macr)...) (t . macr))
-;; kbd macro alist for Vi state
-(defvar vip-vi-kbd-macro-alist nil)
-;; same for insert/replace state
-(defvar vip-insert-kbd-macro-alist nil)
-;; same for emacs state
-(defvar vip-emacs-kbd-macro-alist nil)
-
-;; Internal var that passes info between start-kbd-macro and end-kbd-macro
-;; in :map and :map!
-(defvar vip-kbd-macro-parameters nil)
-
-(defvar vip-this-kbd-macro nil
-  "Vector of keys representing the name of currently running Viper kbd macro.")
-(defvar vip-last-kbd-macro nil
-  "Vector of keys representing the name of last Viper keyboard macro.")
-
-(defconst vip-fast-keyseq-timeout 200
-  "*Key sequence separated by no more than this many milliseconds is viewed as a macro, if such a macro is defined.
-This also controls ESC-keysequences generated by keyboard function keys.")
-
-
-(defvar vip-repeat-from-history-key 'f12
-  "Prefix key for invocation of vip-repeat-from-history function,
-which repeats previous destructive commands from the history of such
-commands.
-This function can then be invoked as <this-key> 1 or <this-key> 2.
-The notation for these keys is borrowed from XEmacs. Basically,
-a key is a symbol, e.g., `a', `\\1', `f2', etc., or a list, e.g.,
-`(meta control f1)'.")
-
-
-
-;;; Code
-
-;; Ex map command
-(defun ex-map ()
-  (let ((mod-char "")
-	macro-name macro-body map-args ins)
-    (save-window-excursion
-      (set-buffer vip-ex-work-buf)
-      (if (looking-at "!")
-	  (progn
-	    (setq ins t
-		  mod-char "!")
-	    (forward-char 1))))
-    (setq map-args (ex-map-read-args mod-char)
-	  macro-name (car map-args)
-	  macro-body (cdr map-args))
-    (setq vip-kbd-macro-parameters (list ins mod-char macro-name macro-body))
-    (if macro-body
-	(vip-end-mapping-kbd-macro 'ignore)
-      (ex-fixup-history (format "map%s %S" mod-char
-				(vip-display-macro macro-name)))
-      ;; if defining macro for insert, switch there for authentic WYSIWYG
-      (if ins (vip-change-state-to-insert))
-      (start-kbd-macro nil)
-      (define-key vip-vi-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro)
-      (define-key vip-insert-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro)
-      (define-key vip-emacs-intercept-map "\C-x)" 'vip-end-mapping-kbd-macro)
-      (message "Mapping %S in %s state. Hit `C-x )' to complete the mapping"
-	       (vip-display-macro macro-name)
-	       (if ins "Insert" "Vi")))
-    ))
-    
-
-;; Ex unmap
-(defun ex-unmap ()
-  (let ((mod-char "")
-	temp macro-name ins)
-    (save-window-excursion
-      (set-buffer vip-ex-work-buf)
-      (if (looking-at "!")
-	  (progn
-	    (setq ins t
-		  mod-char "!")
-	    (forward-char 1))))
-
-    (setq macro-name (ex-unmap-read-args mod-char))
-    (setq temp (vip-fixup-macro (vconcat macro-name))) ;; copy and fixup
-    (ex-fixup-history (format "unmap%s %S" mod-char
-			      (vip-display-macro temp)))
-    (vip-unrecord-kbd-macro macro-name (if ins 'insert-state 'vi-state))
-    ))
-    
-
-;; read arguments for ex-map
-(defun ex-map-read-args (variant)
-  (let ((cursor-in-echo-area t)
-	(key-seq [])
-	temp key event message
-	macro-name macro-body args)
-	
-    (condition-case nil
-	(setq args (concat (ex-get-inline-cmd-args ".*map[!]*[ \t]?" "\n\C-m")
-			   " nil nil ")
-	      temp (read-from-string args)
-	      macro-name (car temp)
-	      macro-body (car (read-from-string args (cdr temp))))
-      (error
-       (signal
-	'error 
-	'("map: Macro name and body must be a quoted string or a vector"))))
-    
-    ;; We expect macro-name to be a vector, a string, or a quoted string.
-    ;; In the second case, it will emerge as a symbol when read from
-    ;; the above read-from-string. So we need to convert it into a string
-    (if macro-name
-        (cond ((vectorp macro-name) nil)
-	      ((stringp macro-name) 
-	       (setq macro-name (vconcat macro-name)))
-	      (t (setq macro-name (vconcat (prin1-to-string macro-name)))))
-      (message ":map%s <Name>" variant)(sit-for 2)
-      (while
-	  (not (member key
-		       '(?\C-m ?\n (control m) (control j) return linefeed)))
-	(setq key-seq (vconcat key-seq (if key (vector key) [])))
-	;; the only keys available for editing are these-- no help while there
-	(if (member
-	     key
-	     '(?\b ?\d '^? '^H (control h) (control \?) backspace delete))
-	    (setq key-seq (subseq key-seq 0 (- (length key-seq) 2))))
-	(setq message
-	      (format
-	       ":map%s %s"
-	       variant (if (> (length key-seq) 0)
-			   (prin1-to-string (vip-display-macro key-seq))
-			 "")))
-	(message message)
-	(setq event (vip-read-key))
-	;;(setq event (vip-read-event))
-	(setq key
-	      (if (vip-mouse-event-p event)
-		  (progn
-		    (message "%s (No mouse---only keyboard keys, please)"
-			     message)
-		    (sit-for 2)
-		    nil)
-		(vip-event-key event)))
-	)
-      (setq macro-name key-seq))
-    
-    (if (= (length macro-name) 0)
-	(error "Can't map an empty macro name"))
-    (setq macro-name (vip-fixup-macro macro-name))
-    (if (vip-char-array-p macro-name)
-	(setq macro-name (vip-char-array-to-macro macro-name)))
-    
-    (if macro-body
-	(cond ((vip-char-array-p macro-body)
-	       (setq macro-body (vip-char-array-to-macro macro-body)))
-	      ((vectorp macro-body) nil)
-	      (t (error "map: Invalid syntax in macro definition"))))
-    (setq cursor-in-echo-area nil)(sit-for 0) ; this overcomes xemacs tty bug
-    (cons macro-name macro-body)))
-    
-
-
-;; read arguments for ex-unmap
-(defun ex-unmap-read-args (variant)
-  (let ((cursor-in-echo-area t)
-	(macro-alist (if (string= variant "!")
-			 vip-insert-kbd-macro-alist
-		       vip-vi-kbd-macro-alist))
-	;; these are disabled just in case, to avoid surprises when doing
-	;; completing-read
-	vip-vi-kbd-minor-mode vip-insert-kbd-minor-mode
-	vip-emacs-kbd-minor-mode
-	vip-vi-intercept-minor-mode vip-insert-intercept-minor-mode
-	vip-emacs-intercept-minor-mode
-	event message
-	key key-seq macro-name)
-    (setq macro-name (ex-get-inline-cmd-args ".*unma?p?[!]*[ \t]*"))
-	  
-    (if (> (length macro-name) 0)
-	()
-      (message ":unmap%s <Name>" variant) (sit-for 2)
-      (while
-	  (not
-	   (member key '(?\C-m ?\n (control m) (control j) return linefeed)))
-	(setq key-seq (vconcat key-seq (if key (vector key) [])))
-	;; the only keys available for editing are these-- no help while there
-	(cond ((member
-		key
-		'(?\b ?\d '^? '^H (control h) (control \?) backspace delete))
-	       (setq key-seq (subseq key-seq 0 (- (length key-seq) 2))))
-	      ((member key '(tab (control i) ?\t))
-	       (setq key-seq (subseq key-seq 0 (1- (length key-seq))))
-	       (setq message 
-		     (format
-		      ":unmap%s %s"
-		      variant (if (> (length key-seq) 0)
-				  (prin1-to-string
-				   (vip-display-macro key-seq))
-				"")))
-	       (setq key-seq
-		     (vip-do-sequence-completion key-seq macro-alist message))
-	       ))
-	(setq message 
-	      (format
-	       ":unmap%s %s"
-	       variant (if (> (length key-seq) 0)
-			   (prin1-to-string
-			    (vip-display-macro key-seq))
-			 "")))
-	(message message)
-	(setq event (vip-read-key))
-	;;(setq event (vip-read-event))
-	(setq key
-	      (if (vip-mouse-event-p event)
-		  (progn
-		    (message "%s (No mouse---only keyboard keys, please)"
-			     message)
-		    (sit-for 2)
-		    nil)
-		(vip-event-key event)))
-	)
-      (setq macro-name key-seq))
-
-    (if (= (length macro-name) 0)
-	(error "Can't unmap an empty macro name"))
-				  
-    ;; convert macro names into vector, if starts with a `['
-    (if (memq (elt macro-name 0) '(?\[ ?\"))
-	(car (read-from-string macro-name))
-      (vconcat macro-name))
-    ))
-    
-    
-;; Terminate a Vi kbd macro.
-;; optional argument IGNORE, if t, indicates that we are dealing with an
-;; existing macro that needs to be registered, but there is no need to
-;; terminate a kbd macro.
-(defun vip-end-mapping-kbd-macro (&optional ignore)
-  (interactive)
-  (define-key vip-vi-intercept-map "\C-x)" nil)
-  (define-key vip-insert-intercept-map "\C-x)" nil)
-  (define-key vip-emacs-intercept-map "\C-x)" nil)
-  (if (and (not ignore)
-	   (or (not vip-kbd-macro-parameters)
-	       (not defining-kbd-macro)))
-      (error "Not mapping a kbd-macro"))
-  (let ((mod-char (nth 1 vip-kbd-macro-parameters))
-	(ins (nth 0 vip-kbd-macro-parameters))
-	(macro-name (nth 2 vip-kbd-macro-parameters))
-	(macro-body (nth 3 vip-kbd-macro-parameters)))
-    (setq vip-kbd-macro-parameters nil)
-    (or ignore
-	(progn
-	  (end-kbd-macro nil)
-	  (setq macro-body (vip-events-to-macro last-kbd-macro))
-	  ;; always go back to Vi, since this is where we started
-	  ;; defining macro
-	  (vip-change-state-to-vi)))
-    
-    (vip-record-kbd-macro macro-name
-			  (if ins 'insert-state 'vi-state)
-			  (vip-display-macro macro-body))
-    
-    (ex-fixup-history (format "map%s %S %S" mod-char
-			      (vip-display-macro macro-name)
-			      (vip-display-macro macro-body)))
-    ))
-
-
-
-(defadvice start-kbd-macro (after vip-kbd-advice activate)
-  "Remove Viper's intercepting bindings for C-x ).
-This may be needed if the previous `:map' command terminated abnormally."
-  (define-key vip-vi-intercept-map "\C-x)" nil)
-  (define-key vip-insert-intercept-map "\C-x)" nil)
-  (define-key vip-emacs-intercept-map "\C-x)" nil))
-
-
-
-;;; Recording, unrecording, executing
-
-;; accepts as macro names: strings and vectors.
-;; strings must be strings of characters; vectors must be vectors of keys
-;; in canonic form. the canonic form is essentially the form used in XEmacs
-(defun vip-record-kbd-macro (macro-name state macro-body &optional scope)
-  "Record a Vi macro. Can be used in `.vip' file to define permanent macros.
-MACRO-NAME is a string of characters or a vector of keys. STATE is
-either `vi-state' or `insert-state'. It specifies the Viper state in which to
-define the macro. MACRO-BODY is a string that represents the keyboard macro.
-Optional SCOPE says whether the macro should be global \(t\), mode-specific
-\(a major-mode symbol\), or buffer-specific \(buffer name, a string\).
-If SCOPE is nil, the user is asked to specify the scope."
-  (let* (state-name keymap 
-	 (macro-alist-var
-	  (cond ((eq state 'vi-state)
-		 (setq state-name "Vi state"
-		       keymap vip-vi-kbd-map)
-		 'vip-vi-kbd-macro-alist)
-		((memq state '(insert-state replace-state))
-		 (setq state-name "Insert state"
-		       keymap vip-insert-kbd-map)
-		 'vip-insert-kbd-macro-alist)
-		(t
-		 (setq state-name "Emacs state"
-		       keymap vip-emacs-kbd-map)
-		 'vip-emacs-kbd-macro-alist)
-		 ))
-	 new-elt old-elt old-sub-elt msg
-	 temp lis lis2)
-	 
-    (if (= (length macro-name) 0)
-	(error "Can't map an empty macro name"))
-	
-    ;; Macro-name is usually a vector. However, command history or macros
-    ;; recorded in ~/.vip may be recorded as strings. So, convert to vectors.
-    (setq macro-name (vip-fixup-macro macro-name))
-    (if (vip-char-array-p macro-name)
-	(setq macro-name (vip-char-array-to-macro macro-name)))
-    (setq macro-body (vip-fixup-macro macro-body))
-    (if (vip-char-array-p macro-body)
-	(setq macro-body (vip-char-array-to-macro macro-body)))
-	
-    ;; don't ask if scope is given and is of the right type
-    (or (eq scope t)
-	(stringp scope)
-	(and scope (symbolp scope))
-	(progn
-	  (setq scope
-		(cond
-		 ((y-or-n-p
-		   (format
-		    "Map this macro for buffer `%s' only? "
-		    (buffer-name)))
-		  (setq msg
-			(format
-			 "%S is mapped to %s for %s in `%s'"
-			 (vip-display-macro macro-name)
-			 (vip-abbreviate-string
-			  (format
-			   "%S"
-			   (setq temp (vip-display-macro macro-body)))
-			  14 "" ""
-			  (if (stringp temp) "  ....\"" "  ....]"))
-			 state-name (buffer-name)))
-		  (buffer-name))
-		 ((y-or-n-p
-		   (format
-		    "Map this macro for the major mode `%S' only? "
-		    major-mode))
-		  (setq msg
-			(format
-			 "%S is mapped to %s for %s in `%S'"
-			 (vip-display-macro macro-name)
-			 (vip-abbreviate-string
-			  (format
-			   "%S"
-			   (setq temp (vip-display-macro macro-body)))
-			  14 "" ""
-			  (if (stringp macro-body) "  ....\"" "  ....]"))
-			 state-name major-mode))
-		  major-mode)
-		 (t
-		  (setq msg
-			(format
-			 "%S is globally mapped to %s in %s"
-			 (vip-display-macro macro-name)
-			 (vip-abbreviate-string
-			  (format
-			   "%S"
-			   (setq temp (vip-display-macro macro-body)))
-			  14 "" ""
-			  (if (stringp macro-body) "  ....\"" "  ....]"))
-			 state-name))
-		  t)))
-	  (if (y-or-n-p
-	       (format "Save this macro in %s? "
-		       (vip-abbreviate-file-name vip-custom-file-name)))
-	      (vip-save-string-in-file 
-	       (format "\n(vip-record-kbd-macro %S '%S %s '%S)"
-		       (vip-display-macro macro-name)
-		       state
-		       ;; if we don't let vector macro-body through %S,
-		       ;; the symbols `\.' `\[' etc will be converted into
-		       ;; characters, causing invalid read  error on recorded
-		       ;; macros in .vip.
-		       ;; I am not sure is macro-body can still be a string at
-		       ;; this point, but I am preserving this option anyway.
-		       (if (vectorp macro-body)
-			   (format "%S" macro-body)
-			 macro-body)
-		       scope) 
-	       vip-custom-file-name))
-	  
-	  (message msg)
-	  ))
-	
-    (setq new-elt
-	  (cons macro-name
-		(cond ((eq scope t) (list nil nil (cons t nil)))
-		      ((symbolp scope)
-		       (list nil (list (cons scope nil)) (cons t nil)))
-		      ((stringp scope)
-		       (list (list (cons scope nil)) nil (cons t nil))))))
-    (setq old-elt (assoc macro-name (eval macro-alist-var)))
-
-      (if (null old-elt)
-	  (progn
-	    ;; insert new-elt in macro-alist-var and keep the list sorted
-	    (define-key
-	      keymap
-	      (vector (vip-key-to-emacs-key (aref macro-name 0)))
-	      'vip-exec-mapped-kbd-macro)
-	    (setq lis (eval macro-alist-var))
-	    (while (and lis (string< (vip-array-to-string (car (car lis)))
-				     (vip-array-to-string macro-name)))
-	      (setq lis2 (cons (car lis) lis2))
-	      (setq lis (cdr lis)))
-	    
-	    (setq lis2 (reverse lis2))
-	    (set macro-alist-var (append lis2 (cons new-elt lis)))
-	    (setq old-elt new-elt)))
-    (setq old-sub-elt
-	  (cond ((eq scope t) (vip-kbd-global-pair old-elt))
-		((symbolp scope) (assoc scope (vip-kbd-mode-alist old-elt)))
-		((stringp scope) (assoc scope (vip-kbd-buf-alist old-elt)))))
-    (if old-sub-elt 
-	(setcdr old-sub-elt macro-body)
-      (cond ((symbolp scope) (setcar (cdr (cdr old-elt))
-				     (cons (cons scope macro-body)
-					   (vip-kbd-mode-alist old-elt))))
-	    ((stringp scope) (setcar (cdr old-elt)
-				     (cons (cons scope macro-body)
-					   (vip-kbd-buf-alist old-elt))))))
-    ))
-  
-
-    
-;; macro name must be a vector of vip-style keys
-(defun vip-unrecord-kbd-macro (macro-name state)
-  "Delete macro MACRO-NAME from Viper STATE.
-MACRO-NAME must be a vector of vip-style keys. This command is used by Viper
-internally, but the user can also use it in ~/.vip to delete pre-defined macros
-supplied with Viper. The best way to avoid mistakes in macro names to be passed
-to this function is to use vip-describe-kbd-macros and copy the name from
-there."
-  (let* (state-name keymap 
-	 (macro-alist-var
-	  (cond ((eq state 'vi-state)
-		 (setq state-name "Vi state"
-		       keymap vip-vi-kbd-map)
-		 'vip-vi-kbd-macro-alist)
-		((memq state '(insert-state replace-state))
-		 (setq state-name "Insert state"
-		       keymap vip-insert-kbd-map)
-		 'vip-insert-kbd-macro-alist)
-		(t
-		 (setq state-name "Emacs state"
-		       keymap vip-emacs-kbd-map)
-		 'vip-emacs-kbd-macro-alist)
-		))
-	 buf-mapping mode-mapping global-mapping
-	 macro-pair macro-entry)
-	 	
-    ;; Macro-name is usually a vector. However, command history or macros
-    ;; recorded in ~/.vip may appear as strings. So, convert to vectors.
-    (setq macro-name (vip-fixup-macro macro-name))
-    (if (vip-char-array-p macro-name)
-	(setq macro-name (vip-char-array-to-macro macro-name)))
-
-    (setq macro-entry (assoc macro-name (eval macro-alist-var)))
-    (if (= (length macro-name) 0)
-	(error "Can't unmap an empty macro name"))
-    (if (null macro-entry)
-	(error "%S is not mapped to a macro for %s in `%s'"
-	       (vip-display-macro macro-name)
-	       state-name (buffer-name)))
-	
-    (setq buf-mapping (vip-kbd-buf-pair macro-entry)
-	  mode-mapping (vip-kbd-mode-pair macro-entry)
-	  global-mapping (vip-kbd-global-pair macro-entry))
-	
-    (cond ((and (cdr buf-mapping)
-		(or (and (not (cdr mode-mapping)) (not (cdr global-mapping)))
-		    (y-or-n-p
-		     (format "Unmap %S for `%s' only? "
-			     (vip-display-macro macro-name)
-			     (buffer-name)))))
-	   (setq macro-pair buf-mapping)
-	   (message "%S is unmapped for %s in `%s'" 
-		    (vip-display-macro macro-name)
-		    state-name (buffer-name)))
-	  ((and (cdr mode-mapping)
-		(or (not (cdr global-mapping))
-		    (y-or-n-p
-		     (format "Unmap %S for the major mode `%S' only? "
-			     (vip-display-macro macro-name)
-			     major-mode))))
-	   (setq macro-pair mode-mapping)
-	   (message "%S is unmapped for %s in %S"
-		    (vip-display-macro macro-name) state-name major-mode))
-	  ((cdr (setq macro-pair (vip-kbd-global-pair macro-entry)))
-	   (message
-	    "Global mapping of %S for %s is removed"
-	    (vip-display-macro macro-name) state-name))
-	  (t (error "%S is not mapped to a macro for %s in `%s'"
-		    (vip-display-macro macro-name)
-		    state-name (buffer-name))))
-    (setcdr macro-pair nil)
-    (or (cdr buf-mapping)
-	(cdr mode-mapping)
-	(cdr global-mapping)
-	(progn
-	  (set macro-alist-var (delq macro-entry (eval macro-alist-var)))
-	  (if (vip-can-release-key (aref macro-name 0) 
-				   (eval macro-alist-var))
-	      (define-key
-		keymap
-		(vector (vip-key-to-emacs-key (aref macro-name 0)))
-		nil))
-	  ))
-    ))
-    
-;; Check if MACRO-ALIST has an entry for a macro name starting with
-;; CHAR. If not, this indicates that the binding for this char
-;; in vip-vi/insert-kbd-map can be released.
-(defun vip-can-release-key (char macro-alist)
-  (let ((lis macro-alist)
-	(can-release t)
-	macro-name)
-    
-    (while (and lis can-release)
-      (setq macro-name (car (car lis)))
-      (if (eq char (aref macro-name 0))
-	  (setq can-release nil))
-      (setq lis (cdr lis)))
-    can-release))
-
-
-(defun vip-exec-mapped-kbd-macro (count)
-  "Dispatch kbd macro."
-  (interactive "P")
-  (let* ((macro-alist (cond ((eq vip-current-state 'vi-state)
-			     vip-vi-kbd-macro-alist)
-			    ((memq vip-current-state
-				   '(insert-state replace-state))
-			     vip-insert-kbd-macro-alist)
-			    (t
-			     vip-emacs-kbd-macro-alist)))
-	(unmatched-suffix "")
-	;; Macros and keys are executed with other macros turned off
-	;; For macros, this is done to avoid macro recursion
-	vip-vi-kbd-minor-mode vip-insert-kbd-minor-mode
-	vip-emacs-kbd-minor-mode
-	next-best-match keyseq event-seq
-	macro-first-char macro-alist-elt macro-body
-	command)
-    
-    (setq macro-first-char last-command-event
-	  event-seq (vip-read-fast-keysequence macro-first-char macro-alist)
-	  keyseq (vip-events-to-macro event-seq)
-	  macro-alist-elt (assoc keyseq macro-alist)
-	  next-best-match (vip-find-best-matching-macro macro-alist keyseq))
-	  
-    (if (null macro-alist-elt)
-	(setq macro-alist-elt (car next-best-match)
-	      unmatched-suffix (subseq event-seq (cdr next-best-match))))
-
-    (cond ((null macro-alist-elt))
-	  ((setq macro-body (vip-kbd-buf-definition macro-alist-elt)))
-	  ((setq macro-body (vip-kbd-mode-definition macro-alist-elt)))
-	  ((setq macro-body (vip-kbd-global-definition macro-alist-elt))))
-				 
-    ;; when defining keyboard macro, don't use the macro mappings
-    (if (and macro-body (not defining-kbd-macro))
-	;; block cmd executed as part of a macro from entering command history
-	(let ((command-history command-history))
-	  (setq vip-this-kbd-macro (car macro-alist-elt))
-	  (execute-kbd-macro (vip-macro-to-events macro-body) count)
-	  (setq vip-this-kbd-macro nil
-		vip-last-kbd-macro (car macro-alist-elt))
-	  (vip-set-unread-command-events unmatched-suffix))
-      ;; If not a macro, or the macro is suppressed while defining another
-      ;; macro, put keyseq back on the event queue
-      (vip-set-unread-command-events event-seq)
-      ;; if the user typed arg, then use it if prefix arg is not set by
-      ;; some other command (setting prefix arg can happen if we do, say,
-      ;; 2dw and there is a macro starting with 2. Then control will go to
-      ;; this routine
-      (or prefix-arg (setq  prefix-arg count)) 
-      (setq command (key-binding (read-key-sequence nil)))
-      (if (commandp command)
-	  (command-execute command)
-	(beep 1)))
-    ))
-
-
-
-;;; Displaying and completing macros
-    
-(defun vip-describe-kbd-macros ()
-  "Show currently defined keyboard macros."
-  (interactive)
-  (with-output-to-temp-buffer " *vip-info*"
-    (princ "Macros in Vi state:\n===================\n")
-    (mapcar 'vip-describe-one-macro vip-vi-kbd-macro-alist)
-    (princ "\n\nMacros in Insert and Replace states:\n====================================\n")
-    (mapcar 'vip-describe-one-macro vip-insert-kbd-macro-alist)
-    (princ "\n\nMacros in Emacs state:\n======================\n")
-    (mapcar 'vip-describe-one-macro vip-emacs-kbd-macro-alist)
-    ))
-    
-(defun vip-describe-one-macro (macro)
-  (princ (format "\n  *** Mappings for %S:\n      ------------\n"
-		 (vip-display-macro (car macro))))
-  (princ "   ** Buffer-specific:")
-  (if (vip-kbd-buf-alist macro)
-      (mapcar 'vip-describe-one-macro-elt (vip-kbd-buf-alist macro))
-    (princ "  none\n"))
-  (princ "\n   ** Mode-specific:")
-  (if (vip-kbd-mode-alist macro)
-      (mapcar 'vip-describe-one-macro-elt (vip-kbd-mode-alist macro))
-    (princ "  none\n"))
-  (princ "\n   ** Global:")
-  (if (vip-kbd-global-definition macro)
-      (princ (format "\n           %S" (cdr (vip-kbd-global-pair macro))))
-    (princ "  none"))
-  (princ "\n"))
-  
-(defun vip-describe-one-macro-elt (elt)
-  (let ((name (car elt))
-	(defn (cdr elt)))
-    (princ (format "\n       * %S:\n           %S\n" name defn))))
-    
-    
-    
-;; check if SEQ is a prefix of some car of an element in ALIST
-(defun vip-keyseq-is-a-possible-macro (seq alist)
-  (let ((converted-seq (vip-events-to-macro seq)))
-    (eval (cons 'or 
-		(mapcar
-		 (function (lambda (elt)
-			     (vip-prefix-subseq-p converted-seq elt)))
-		 (vip-this-buffer-macros alist))))))
-		 
-;; whether SEQ1 is a prefix of SEQ2
-(defun vip-prefix-subseq-p (seq1 seq2)
-  (let ((len1 (length seq1))
-	(len2 (length seq2)))
-    (if (<= len1 len2)
-	(equal seq1 (subseq seq2 0 len1)))))
-	
-;; find the longest common prefix
-(defun vip-common-seq-prefix (&rest seqs)
-  (let* ((first (car seqs))
-	 (rest (cdr seqs))
-	 (pref [])
-	 (idx 0)
-	 len)
-    (if (= (length seqs) 0)
-	(setq len 0)
-      (setq len (apply 'min (mapcar 'length seqs))))
-    (while (< idx len)
-      (if (eval (cons 'and 
-		      (mapcar (function (lambda (s)
-					  (equal (elt first idx)
-						 (elt s idx))))
-			      rest)))
-	  (setq pref (vconcat pref (vector (elt first idx)))))
-      (setq idx (1+ idx)))
-    pref))
-    
-;; get all sequences that match PREFIX from a given A-LIST
-(defun vip-extract-matching-alist-members (pref alist)
-  (delq nil (mapcar (function (lambda (elt)
-				(if (vip-prefix-subseq-p pref elt)
-				    elt)))
-		    (vip-this-buffer-macros alist))))
-		    
-(defun vip-do-sequence-completion (seq alist compl-message)
-  (let* ((matches (vip-extract-matching-alist-members seq alist))
-	 (new-seq (apply 'vip-common-seq-prefix matches))
-	 )
-    (cond ((and (equal seq new-seq) (= (length matches) 1))
-	   (message "%s (Sole completion)" compl-message)
-	   (sit-for 2))
-	  ((null matches) 
-	   (message "%s (No match)" compl-message)
-	   (sit-for 2)
-	   (setq new-seq seq))
-	  ((member seq matches) 
-	   (message "%s (Complete, but not unique)" compl-message)
-	   (sit-for 2)
-	   (vip-display-vector-completions matches))
-	  ((equal seq new-seq)
-	   (vip-display-vector-completions matches)))
-    new-seq))
-	
-	 
-(defun vip-display-vector-completions (list)
-  (with-output-to-temp-buffer "*Completions*"
-    (display-completion-list 
-     (mapcar 'prin1-to-string
-	     (mapcar 'vip-display-macro list)))))
-  
-				  
-    
-;; alist is the alist of macros
-;; str is the fast key sequence entered
-;; returns: (matching-macro-def . unmatched-suffix-start-index)
-(defun vip-find-best-matching-macro (alist str)
-  (let ((lis alist)
-	(def-len 0)
-	(str-len (length str))
-	match unmatched-start-idx found macro-def)
-    (while (and (not found) lis)
-      (setq macro-def (car lis)
-	    def-len (length (car macro-def)))
-      (if (and (>= str-len def-len)
-	       (equal (car macro-def) (subseq str 0 def-len)))
-	  (if (or (vip-kbd-buf-definition macro-def)
-		  (vip-kbd-mode-definition macro-def)
-		  (vip-kbd-global-definition macro-def))
-	      (setq found t))
-	)
-      (setq lis (cdr lis)))
-    
-    (if found
-	(setq match macro-def
-	      unmatched-start-idx def-len)
-      (setq match nil
-	    unmatched-start-idx 0))
-    
-    (cons match unmatched-start-idx)))
-  
-    
-    
-;; returns a list of names of macros defined for the current buffer
-(defun vip-this-buffer-macros (macro-alist)
-  (let (candidates)
-    (setq candidates
-	  (mapcar (function
-		   (lambda (elt)
-		     (if (or (vip-kbd-buf-definition elt)
-			     (vip-kbd-mode-definition elt)
-			     (vip-kbd-global-definition elt))
-			 (car elt))))
-		  macro-alist))
-    (setq candidates (delq nil candidates))))
-    
-  
-;; if seq of Viper key symbols (representing a macro) can be converted to a
-;; string--do so. Otherwise, do nothing.
-(defun vip-display-macro (macro-name-or-body)
-  (cond ((vip-char-symbol-sequence-p macro-name-or-body)
-	 (mapconcat 'symbol-name macro-name-or-body ""))
-	((vip-char-array-p macro-name-or-body)
-	 (mapconcat 'char-to-string macro-name-or-body ""))
-	(t macro-name-or-body)))
-    
-;; convert sequence of events (that came presumably from emacs kbd macro) into
-;; Viper's macro, which is a vector of the form
-;; [ desc desc ... ]
-;; Each desc is either a symbol of (meta symb), (shift symb), etc.
-;; Here we purge events that happen to be lists. In most cases, these events
-;; got into a macro definition unintentionally; say, when the user moves mouse
-;; during a macro definition, then something like (switch-frame ...) might get
-;; in. Another reason for purging lists-events is that we can't store them in
-;; textual form (say, in .emacs) and then read them back.
-(defun vip-events-to-macro (event-seq)
-  (vconcat (delq nil (mapcar (function (lambda (elt)
-					 (if (consp elt)
-					     nil
-					   (vip-event-key elt))))
-			     event-seq))))
-  
-;; convert strings or arrays of characters to Viper macro form
-(defun vip-char-array-to-macro (array)
-  (let ((vec (vconcat array))
-	macro)
-    (if vip-xemacs-p
-	(setq macro (mapcar 'character-to-event vec))
-      (setq macro vec))
-    (vconcat (mapcar 'vip-event-key macro))))
-    
-;; For macros bodies and names, goes over MACRO and checks if all members are
-;; names of keys (actually, it only checks if they are symbols or lists
-;; if a digit is found, it is converted into a symbol (e.g., 0 -> \0, etc).
-;; If MACRO is not a list or vector -- doesn't change MACRO.
-(defun vip-fixup-macro (macro)
-  (let ((len (length macro))
-	(idx 0)
-	elt break)
-    (if (or (vectorp macro) (listp macro))
-	(while (and (< idx len) (not break))
-	  (setq elt (elt macro idx))
-	  (cond ((numberp elt)
-		 ;; fix number
-		 (if (and (<= 0 elt) (<= elt 9))
-		     (cond ((arrayp macro)
-			    (aset macro
-				  idx
-				  (intern (char-to-string (+ ?0 elt)))))
-			   ((listp macro)
-			    (setcar (nthcdr idx macro)
-				    (intern (char-to-string (+ ?0 elt)))))
-			   )))
-		((listp elt)
-		 (vip-fixup-macro elt))
-		((symbolp elt) nil)
-		(t (setq break t)))
-	  (setq idx (1+ idx))))
-      
-      (if break
-	  (error "Wrong type macro component, symbol-or-listp, %S" elt)
-	macro)))
-  
-(defun vip-char-array-p (array)
-  (eval (cons 'and (mapcar 'vip-characterp array))))
-  
-(defun vip-macro-to-events (macro-body)
-  (vconcat (mapcar 'vip-key-to-emacs-key macro-body)))
-	    
-			 
-;; check if vec is a vector of character symbols
-(defun vip-char-symbol-sequence-p (vec)
-  (and
-   (sequencep vec)
-   (eval
-    (cons 'and
-	  (mapcar
-	   (function (lambda (elt)
-		       (and (symbolp elt) (= (length (symbol-name elt)) 1))))
-	   vec)))))
-	       
-
-;; Check if vec is a vector of key-press events representing characters
-;; XEmacs only
-(defun vip-event-vector-p (vec)
-  (and (vectorp vec)
-       (eval (cons 'and (mapcar '(lambda (elt) (if (eventp elt) t)) vec)))))
-    
-
-;;; Reading fast key sequences
-    
-;; Assuming that CHAR was the first character in a fast succession of key
-;; strokes, read the rest. Return the vector of keys that was entered in
-;; this fast succession of key strokes.
-;; A fast keysequence is one that is terminated by a pause longer than
-;; vip-fast-keyseq-timeout.
-(defun vip-read-fast-keysequence (event macro-alist)
-  (let ((lis (vector event))
-	next-event)
-    (while (and (vip-fast-keysequence-p)
-		(vip-keyseq-is-a-possible-macro lis macro-alist))
-      (setq next-event (vip-read-key))
-      ;;(setq next-event (vip-read-event))
-      (or (vip-mouse-event-p next-event)
-	  (setq lis (vconcat lis (vector next-event)))))
-    lis))
-
-
-;;; Keyboard macros in registers
-
-;; sets register to last-kbd-macro carefully.
-(defun vip-set-register-macro (reg)
-  (if (get-register reg)
-      (if (y-or-n-p "Register contains data. Overwrite? ")
-	  ()
-	(error
-	 "Macro not saved in register. Can still be invoked via `C-x e'")))
-  (set-register reg last-kbd-macro))
-
-(defun vip-register-macro (count)
-  "Keyboard macros in registers - a modified \@ command."
-  (interactive "P")
-  (let ((reg (downcase (read-char))))
-    (cond ((or (and (<= ?a reg) (<= reg ?z)))
-	   (setq vip-last-macro-reg reg)
-	   (if defining-kbd-macro
-	       (progn
-		 (end-kbd-macro)
-		 (vip-set-register-macro reg))
-	     (execute-kbd-macro (get-register reg) count)))
-	  ((or (= ?@ reg) (= ?\^j reg) (= ?\^m reg))
-	   (if vip-last-macro-reg 
-	       nil
-	       (error "No previous kbd macro"))
-	   (execute-kbd-macro (get-register vip-last-macro-reg) count))
-	  ((= ?\# reg)
-	   (start-kbd-macro count))
-	  ((= ?! reg)
-	   (setq reg (downcase (read-char)))
-	   (if (or (and (<= ?a reg) (<= reg ?z)))
-	       (progn
-	       (setq vip-last-macro-reg reg)
-	       (vip-set-register-macro reg))))
-	  (t
-	   (error "`%c': Unknown register" reg)))))
-	   
-
-(defun vip-global-execute ()
-  "Call last keyboad macro for each line in the region."
-  (if (> (point) (mark t)) (exchange-point-and-mark))
-  (beginning-of-line)
-  (call-last-kbd-macro)
-  (while (< (point) (mark t))
-    (forward-line 1)
-    (beginning-of-line)
-    (call-last-kbd-macro)))
-
-
-(provide 'viper-macs)
-
-;;;  viper-macs.el ends here
diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el
deleted file mode 100644
index 73cef2eef85..00000000000
--- a/lisp/emulation/viper-mous.el
+++ /dev/null
@@ -1,459 +0,0 @@
-;;; viper-mous.el --- mouse support for Viper
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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.
-
-;; Code
-
-(require 'viper-util)
-
-;; compiler pacifier
-(defvar double-click-time)
-(defvar mouse-track-multi-click-time)
-;; end compiler pacifier
-
-
-;;; Variables
-  
-;; Variable used for catching the switch-frame event.
-;; If non-nil, indicates that previous-frame should be the selected
-;; one. Used by vip-mouse-click-get-word. Not a user option.
-(defvar vip-frame-of-focus nil)
-    
-;; Frame that was selected before the switch-frame event.
-(defconst vip-current-frame-saved (selected-frame))
-  
-(defvar vip-surrounding-word-function 'vip-surrounding-word
-  "*Function that determines what constitutes a word for clicking events.
-Takes two parameters: a COUNT, indicating how many words to return, 
-and CLICK-COUNT, telling whether this is the first click, a double-click,
-or a tripple-click.")
-       
-;; time interval in millisecond within which successive clicks are
-;; considered related
-(defconst vip-multiclick-timeout (if vip-xemacs-p
-				     mouse-track-multi-click-time
-				   double-click-time)
-  "*Time interval in millisecond within which successive clicks are
-considered related.")
-
-;; current event click count; XEmacs only
-(defvar vip-current-click-count 0)
-;; time stamp of the last click event; XEmacs only
-(defvar vip-last-click-event-timestamp 0)
-
-;; Local variable used to toggle wraparound search on click.
-(vip-deflocalvar  vip-mouse-click-search-noerror t)
-	
-;; Local variable used to delimit search after wraparound.
-(vip-deflocalvar  vip-mouse-click-search-limit nil)
-	
-;; remembers prefix argument to pass along to commands invoked by second
-;; click.
-;; This is needed because in Emacs (not XEmacs), assigning to preix-arg
-;; causes Emacs to count the second click as if it was a single click
-(defvar vip-global-prefix-argument nil)
-
-
-
-;;; Code
-
-(defsubst vip-multiclick-p ()
-  (not (vip-sit-for-short vip-multiclick-timeout t)))
-
-;; Returns window where click occurs
-(defsubst vip-mouse-click-window (click)
-  (if vip-xemacs-p
-      (event-window click)
-    (posn-window (event-start click))))
-
-;; Returns window where click occurs
-(defsubst vip-mouse-click-frame (click)
-  (window-frame (vip-mouse-click-window click)))
-
-;; Returns the buffer of the window where click occurs
-(defsubst vip-mouse-click-window-buffer (click)
-  (window-buffer (vip-mouse-click-window click)))
-
-;; Returns the name of the buffer in the window where click occurs
-(defsubst vip-mouse-click-window-buffer-name (click)
-  (buffer-name (vip-mouse-click-window-buffer click)))
-
-;; Returns position of a click
-(defsubst vip-mouse-click-posn (click)
-  (if vip-xemacs-p
-      (event-point click)
-    (posn-point (event-start click))))
-	     
-
-(defun vip-surrounding-word (count click-count)
-   "Returns word surrounding point according to a heuristic.
-COUNT indicates how many regions to return.
-If CLICK-COUNT is 1, `word' is a word in Vi sense.
-If CLICK-COUNT is 2,then `word' is a Word in Vi sense.
-If the character clicked on is a non-separator and is non-alphanumeric but
-is adjacent to an alphanumeric symbol, then it is considered alphanumeric
-for the purpose of this command. If this character has a matching
-character, such as `\(' is a match for `\)', then the matching character is
-also considered alphanumeric.
-For convenience, in Lisp modes, `-' is considered alphanumeric.
-
-If CLICK-COUNT is 3 or more, returns the line clicked on with leading and
-trailing space and tabs removed. In that case, the first argument, COUNT,
-is ignored."
-   (let ((modifiers "")
-	 beg skip-flag result
-	 word-beg)
-     (if (> click-count 2)
-	 (save-excursion
-	   (beginning-of-line)
-	   (vip-skip-all-separators-forward 'within-line)
-	   (setq beg (point))
-	   (end-of-line)
-	   (setq result (buffer-substring beg (point))))
-       
-       (if (and (not (vip-looking-at-alphasep))
-		(or (save-excursion (vip-backward-char-carefully)
-				    (vip-looking-at-alpha))
-		    (save-excursion (vip-forward-char-carefully)
-				    (vip-looking-at-alpha))))
-	   (setq modifiers
-		 (cond ((looking-at "\\\\") "\\\\")
-		       ((looking-at "-") "C-C-")
-		       ((looking-at "[][]") "][")
-		       ((looking-at "[()]") ")(")
-		       ((looking-at "[{}]") "{}")
-		       ((looking-at "[<>]") "<>")
-		       ((looking-at "[`']") "`'")
-		       ((looking-at "\\^") "\\^")
-		       ((vip-looking-at-separator) "")
-		       (t (char-to-string (following-char))))
-		 ))
-       
-       ;; Add `-' to alphanum, if it wasn't added and if we are in Lisp
-       (or (looking-at "-")
-	   (not (string-match "lisp" (symbol-name major-mode)))
-	   (setq modifiers (concat modifiers "C-C-")))
-       
-       
-       (save-excursion
-	 (cond ((> click-count 1) (vip-skip-nonseparators 'backward))
-	       ((vip-looking-at-alpha modifiers)
-		(vip-skip-alpha-backward modifiers))
-	       ((not (vip-looking-at-alphasep modifiers))
-		(vip-skip-nonalphasep-backward))
-	       (t (if (> click-count 1)
-		      (vip-skip-nonseparators 'backward)
-		    (vip-skip-alpha-backward modifiers))))
-
-	 (setq word-beg (point))
-	 
-	 (setq skip-flag nil) ; don't move 1 char forw the first time
-	 (while (> count 0)
-	   (if skip-flag (vip-forward-char-carefully 1))
-	   (setq skip-flag t) ; now always move 1 char forward
-	   (if (> click-count 1)
-	       (vip-skip-nonseparators 'forward)
-	     (vip-skip-alpha-forward modifiers))
-	   (setq count (1- count)))
-
-	 (setq result (buffer-substring word-beg (point))))
-       ) ; if
-     ;; XEmacs doesn't have set-text-properties, but there buffer-substring
-     ;; doesn't return properties together with the string, so it's not needed.
-     (if vip-emacs-p
-	 (set-text-properties 0 (length result) nil result))
-     result
-     ))
-
-
-(defun vip-mouse-click-get-word (click count click-count)
-  "Returns word surrounding the position of a mouse click.
-Click may be in another window. Current window and buffer isn't changed.
-On single or double click, returns the word as determined by
-`vip-surrounding-word-function'."
-     
-  (let ((click-word "")
-	(click-pos (vip-mouse-click-posn click))
-	(click-buf (vip-mouse-click-window-buffer click)))
-    (or (natnump count) (setq count 1))
-    (or (natnump click-count) (setq click-count 1))
-     
-    (save-excursion
-      (save-window-excursion
-	(if click-pos
-	    (progn
-	      (set-buffer click-buf)
-	
-	      (goto-char click-pos)
-	      (setq click-word
-		    (funcall vip-surrounding-word-function count click-count)))
-	  (error "Click must be over a window."))
-	click-word))))
-
-
-(defun vip-mouse-click-insert-word (click arg)
-  "Insert word clicked or double-clicked on.
-With prefix argument, N, insert that many words.
-This command must be bound to a mouse click.
-The double-click action of the same mouse button must not be bound
-\(or it must be bound to the same function\).
-See `vip-surrounding-word' for the definition of a word in this case."
-  (interactive "e\nP")
-  (if vip-frame-of-focus	;; to handle clicks in another frame
-      (select-frame vip-frame-of-focus))
-      
-  ;; turn arg into a number
-  (cond ((integerp arg) nil)
-	;; prefix arg is a list when one hits C-u then command
-	((and (listp arg) (integerp (car arg)))
-	 (setq arg (car arg)))
-	(t (setq arg 1)))
-      
-  (let (click-count interrupting-event)
-    (if (and
-	 (vip-multiclick-p)
-	 ;; This trick checks if there is a pending mouse event
-	 ;; if so, we use this latter event and discard the current mouse click
-	 ;; If the next pending event is not a mouse event, we execute
-	 ;; the current mouse event
-	 (progn
-	   (setq interrupting-event (vip-read-event))
-	   (vip-mouse-event-p last-input-event)))
-	(progn ;; interrupted wait
-	  (setq vip-global-prefix-argument arg)
-	  ;; count this click for XEmacs
-	  (vip-event-click-count click))
-      ;; uninterrupted wait or the interrupting event wasn't a mouse event
-      (setq click-count (vip-event-click-count click))
-      (if (> click-count 1)
-	  (setq arg vip-global-prefix-argument
-		vip-global-prefix-argument nil))
-      (insert (vip-mouse-click-get-word click arg click-count))
-      (if (and interrupting-event
-	       (eventp interrupting-event)
-	       (not (vip-mouse-event-p interrupting-event)))
-	  (vip-set-unread-command-events interrupting-event))
-      )))
-  
-;; arg is an event. accepts symbols and numbers, too
-(defun vip-mouse-event-p (event)
-  (if (eventp event)
-      (string-match "\\(mouse-\\|frame\\|screen\\|track\\)"
-		    (prin1-to-string (vip-event-key event)))))
-  
-;; XEmacs has no double-click events. So, we must simulate.
-;; So, we have to simulate event-click-count.
-(defun vip-event-click-count (click)
-  (if vip-xemacs-p
-      (progn
-	;; if more than 1 second
-	(if (> (- (event-timestamp click) vip-last-click-event-timestamp)
-	       vip-multiclick-timeout)
-	    (setq vip-current-click-count 0))
-	(setq vip-last-click-event-timestamp (event-timestamp click)
-	      vip-current-click-count (1+ vip-current-click-count)))
-    (event-click-count click)))
-    
-
-
-(defun vip-mouse-click-search-word (click arg)
-   "Find the word clicked or double-clicked on. Word may be in another window.
-With prefix argument, N, search for N-th occurrence.
-This command must be bound to a mouse click. The double-click action of the
-same button must not be bound \(or it must be bound to the same function\).
-See `vip-surrounding-word' for the details on what constitutes a word for
-this command."
-  (interactive "e\nP")
-  (if vip-frame-of-focus	;; to handle clicks in another frame
-      (select-frame vip-frame-of-focus))
-  (let (click-word click-count
-	(previous-search-string vip-s-string))
-    
-    (if (and
-	 (vip-multiclick-p)
-	 ;; This trick checks if there is a pending mouse event
-	 ;; if so, we use this latter event and discard the current mouse click
-	 ;; If the next pending event is not a mouse event, we execute
-	 ;; the current mouse event
-	 (progn
-	   (vip-read-event)
-	   (vip-mouse-event-p last-input-event)))
-	(progn ;; interrupted wait
-	  (setq vip-global-prefix-argument 
-		(or vip-global-prefix-argument arg))
-	  ;; remember command that was before the multiclick
-	  (setq this-command last-command)
-	  ;; make sure we counted this event---needed for XEmacs only
-	  (vip-event-click-count click))
-      ;; uninterrupted wait
-      (setq click-count (vip-event-click-count click))
-      (setq click-word (vip-mouse-click-get-word click nil click-count))
-    
-      (if (> click-count 1)
-	  (setq arg vip-global-prefix-argument
-		vip-global-prefix-argument nil))
-      (setq arg (or arg 1))
-    
-      (vip-deactivate-mark)
-      (if (or (not (string= click-word vip-s-string))
-	      (not (markerp vip-search-start-marker))
-	      (not (equal (marker-buffer vip-search-start-marker)
-			  (current-buffer)))
-	      (not (eq last-command 'vip-mouse-click-search-word)))
-	  (progn
-	    (setq  vip-search-start-marker (point-marker)
-		   vip-local-search-start-marker vip-search-start-marker
-		   vip-mouse-click-search-noerror t
-		   vip-mouse-click-search-limit nil)
-	    
-	    ;; make search string known to Viper
-	    (setq vip-s-string (if vip-re-search
-				   (regexp-quote click-word)
-				 click-word))
-	    (if (not (string= vip-s-string (car vip-search-history)))
-		(setq vip-search-history
-		      (cons vip-s-string vip-search-history)))
-	    ))
-      
-      (push-mark nil t)
-      (while (> arg 0)
-	(vip-forward-word 1)
-	(condition-case nil
-	    (progn
-	      (if (not (search-forward click-word vip-mouse-click-search-limit
-				       vip-mouse-click-search-noerror))
-		  (progn
-		    (setq vip-mouse-click-search-noerror nil)
-		    (setq vip-mouse-click-search-limit
-			  (save-excursion
-			    (if (and
-				 (markerp vip-local-search-start-marker)
-				 (marker-buffer vip-local-search-start-marker))
-				(goto-char vip-local-search-start-marker))
-			    (vip-line-pos 'end)))
-			    
-		    (goto-char (point-min))
-		    (search-forward click-word
-				    vip-mouse-click-search-limit nil)))
-	      (goto-char (match-beginning 0))
-	      (message "Searching for: %s" vip-s-string)
-	      (if (<= arg 1) ; found the right occurrence of the pattern
-		  (progn
-		    (vip-adjust-window)
-		    (vip-flash-search-pattern)))
-	      )
-	  (error (beep 1)
-		 (if (or (not (string= click-word previous-search-string))
-			 (not (eq  last-command 'vip-mouse-click-search-word)))
-		     (message "`%s': String not found in %s"
-			      vip-s-string (buffer-name (current-buffer)))
-		   (message
-		    "`%s': Last occurrence in %s. Back to beginning of search"
-		    click-word (buffer-name (current-buffer)))
-		   (setq arg 1) ;; to terminate the loop
-		   (sit-for 2))
-		 (setq  vip-mouse-click-search-noerror t) 
-		 (setq  vip-mouse-click-search-limit nil)
-		 (if (and (markerp vip-local-search-start-marker)
-			  (marker-buffer vip-local-search-start-marker))
-		     (goto-char vip-local-search-start-marker))))
-	(setq arg (1- arg)))
-      )))
-  
-(defun vip-mouse-catch-frame-switch (event arg)
-  "Catch the event of switching frame.
-Usually is bound to a 'down-mouse' event to work properly. See sample
-bindings in viper.el and in the Viper manual."
-  (interactive "e\nP")
-  (setq vip-frame-of-focus nil)
-  ;; pass prefix arg along to vip-mouse-click-search/insert-word
-  (setq prefix-arg arg)
-  (if (eq last-command 'handle-switch-frame)
-      (setq vip-frame-of-focus vip-current-frame-saved))
-  ;; make Emacs forget that it executed vip-mouse-catch-frame-switch
-  (setq this-command last-command))
-      
-;; Called just before switching frames. Saves the old selected frame.
-;; Sets last-command to handle-switch-frame (this is done automatically in
-;; Emacs. 
-;; The semantics of switching frames is different in Emacs and XEmacs.
-;; In Emacs, if you select-frame A while mouse is over frame B and then
-;; start typing, input goes to frame B, which becomes selected.
-;; In XEmacs, input will go to frame A. This may be a bug in one of the
-;; Emacsen, but also may be a design decision.
-;; Also, in Emacs sending input to frame B generates handle-switch-frame
-;; event, while in XEmacs it doesn't.
-;; All this accounts for the difference in the behavior of
-;; vip-mouse-click-* commands when you click in a frame other than the one
-;; that was the last to receive input. In Emacs, focus will be in frame A
-;; until you do something other than vip-mouse-click-* command.
-;; In XEmacs, you have to manually select frame B (with the mouse click) in
-;; order to shift focus to frame B.
-(defsubst vip-remember-current-frame (frame)
-  (setq last-command 'handle-switch-frame
-	vip-current-frame-saved (selected-frame)))
-
-
-(cond ((vip-window-display-p)
-       (let* ((search-key (if vip-xemacs-p
-			      [(meta shift button1up)] [M-S-mouse-1]))
-	      (search-key-catch (if vip-xemacs-p
-				    [(meta shift button1)] [M-S-down-mouse-1]))
-	      (insert-key (if vip-xemacs-p
-			      [(meta shift button2up)] [M-S-mouse-2]))
-	      (insert-key-catch (if vip-xemacs-p
-				    [(meta shift button2)] [M-S-down-mouse-2]))
-	      (search-key-unbound (and (not (key-binding search-key))
-				       (not (key-binding search-key-catch))))
-	      (insert-key-unbound (and (not (key-binding insert-key))
-				       (not (key-binding insert-key-catch))))
-	      )
-	     
-	 (if search-key-unbound
-	     (global-set-key search-key 'vip-mouse-click-search-word))
-	 (if insert-key-unbound
-	     (global-set-key insert-key 'vip-mouse-click-insert-word))
-    
-	 ;; The following would be needed if you want to use the above two
-	 ;; while clicking in another frame. If you only want to use them
-	 ;; by clicking in another window, not frame, the bindings below
-	 ;; aren't necessary.
-	 
-	 ;; These must be bound to mouse-down event for the same mouse
-	 ;; buttons as 'vip-mouse-click-search-word and
-	 ;; 'vip-mouse-click-insert-word
-	 (if search-key-unbound
-	     (global-set-key search-key-catch   'vip-mouse-catch-frame-switch))
-	 (if insert-key-unbound
-	     (global-set-key insert-key-catch   'vip-mouse-catch-frame-switch))
-	 
-	 (if vip-xemacs-p
-	     (add-hook 'mouse-leave-frame-hook
-		       'vip-remember-current-frame)
-	   (defadvice handle-switch-frame (before vip-frame-advice activate)
-	     "Remember the selected frame before the switch-frame event." 
-	     (vip-remember-current-frame (selected-frame))))
-       )))
-
-
-
-(provide 'viper-mous)
-
-;;;  viper-mous.el ends here
diff --git a/lisp/emulation/viper-util.el b/lisp/emulation/viper-util.el
deleted file mode 100644
index 059e840d3a4..00000000000
--- a/lisp/emulation/viper-util.el
+++ /dev/null
@@ -1,1269 +0,0 @@
-;;; viper-util.el --- Utilities used by viper.el
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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.
-
-
-;; Code
-
-(require 'ring)
-
-;; Compiler pacifier
-(defvar vip-overriding-map)
-(defvar pm-color-alist)
-(defvar zmacs-region-stays)
-(defvar vip-search-face)
-(defvar vip-minibuffer-current-face)
-(defvar vip-minibuffer-insert-face)
-(defvar vip-minibuffer-vi-face)
-(defvar vip-minibuffer-emacs-face)
-(defvar vip-replace-overlay-face)
-(defvar vip-minibuffer-overlay)
-(defvar vip-replace-overlay)
-(defvar vip-search-overlay)
-(defvar vip-replace-overlay-cursor-color)
-(defvar vip-intermediate-command)
-(defvar vip-use-replace-region-delimiters)
-(defvar vip-fast-keyseq-timeout)
-(defvar vip-related-files-and-buffers-ring)
-;; end compiler pacifier
-
-;; Is it XEmacs?
-(defconst vip-xemacs-p (string-match "\\(Lucid\\|XEmacs\\)" emacs-version))
-;; Is it Emacs?
-(defconst vip-emacs-p (not vip-xemacs-p))
-;; Tell whether we are running as a window application or on a TTY
-(defsubst vip-device-type ()
-  (if vip-emacs-p
-      window-system
-    (device-type (selected-device))))
-;; in XEmacs: device-type is tty on tty and stream in batch.
-(defun vip-window-display-p ()
-  (and (vip-device-type) (not (memq (vip-device-type) '(tty stream pc)))))
-
-(defvar vip-ms-style-os-p (memq system-type '(ms-dos windows-nt windows-95))
-  "Tells if Emacs is running under an MS-style OS: ms-dos, windows-nt, W95.")
-(defvar vip-vms-os-p (memq system-type '(vax-vms axp-vms))
-  "Tells if Emacs is running under VMS.")
-
-(defvar vip-force-faces nil
-  "If t, Viper will think that it is running on a display that supports faces.
-This is provided as a temporary relief for users of face-capable displays
-that Viper doesn't know about.")
-
-(defun vip-has-face-support-p ()
-  (cond ((vip-window-display-p))
-	(vip-force-faces)
-	(vip-emacs-p (memq (vip-device-type) '(pc)))
-	(vip-xemacs-p (memq (vip-device-type) '(tty pc)))))
-
-
-;;; Macros
-
-(defmacro vip-deflocalvar (var default-value &optional documentation)
-  (` (progn
-       (defvar (, var) (, default-value)
-	       (, (format "%s\n\(buffer local\)" documentation)))
-       (make-variable-buffer-local '(, var))
-     )))
-
-(defmacro vip-loop (count body)
-  "(vip-loop COUNT BODY) Execute BODY COUNT times."
-  (list 'let (list (list 'count count))
-	(list 'while '(> count 0)
-	      body
-	      '(setq count (1- count))
-	      )))
-
-(defmacro vip-buffer-live-p (buf)
-  (` (and (, buf) (get-buffer (, buf)) (buffer-name (get-buffer (, buf))))))
-  
-;; return buffer-specific macro definition, given a full macro definition
-(defmacro vip-kbd-buf-alist (macro-elt)
-  (` (nth 1 (, macro-elt))))
-;; get a pair: (curr-buffer . macro-definition)
-(defmacro vip-kbd-buf-pair (macro-elt)
-  (` (assoc (buffer-name) (vip-kbd-buf-alist (, macro-elt)))))
-;; get macro definition for current buffer
-(defmacro vip-kbd-buf-definition (macro-elt)
-  (` (cdr (vip-kbd-buf-pair (, macro-elt)))))
-  
-;; return mode-specific macro definitions, given a full macro definition
-(defmacro vip-kbd-mode-alist (macro-elt)
-  (` (nth 2 (, macro-elt))))
-;; get a pair: (major-mode . macro-definition)
-(defmacro vip-kbd-mode-pair (macro-elt)
-  (` (assoc major-mode (vip-kbd-mode-alist (, macro-elt)))))
-;; get macro definition for the current major mode
-(defmacro vip-kbd-mode-definition (macro-elt)
-  (` (cdr (vip-kbd-mode-pair (, macro-elt)))))
-  
-;; return global macro definition, given a full macro definition
-(defmacro vip-kbd-global-pair (macro-elt)
-  (` (nth 3 (, macro-elt))))
-;; get global macro definition from an elt of macro-alist
-(defmacro vip-kbd-global-definition (macro-elt)
-  (` (cdr (vip-kbd-global-pair (, macro-elt)))))
-  
-;; last elt of a sequence
-(defsubst vip-seq-last-elt (seq)
-  (elt seq (1- (length seq))))
-  
-;; Check if arg is a valid character for register
-;; TYPE is a list that can contain `letter', `Letter', and `digit'.
-;; Letter means lowercase letters, Letter means uppercase letters, and
-;; digit means digits from 1 to 9.
-;; If TYPE is nil, then down/uppercase letters and digits are allowed.
-(defun vip-valid-register (reg &optional type)
-  (or type (setq type '(letter Letter digit)))
-  (or (if (memq 'letter type)
-	  (and (<= ?a reg) (<= reg ?z)))
-      (if (memq 'digit type)
-	  (and (<= ?1 reg) (<= reg ?9)))
-      (if (memq 'Letter type)
-	  (and (<= ?A reg) (<= reg ?Z)))
-      ))
-      
-;; checks if object is a marker, has a buffer, and points to within that buffer
-(defun vip-valid-marker (marker)
-  (if (and (markerp marker) (marker-buffer marker))
-      (let ((buf (marker-buffer marker))
-	    (pos (marker-position marker)))
-	(save-excursion
-	  (set-buffer buf)
-	  (and (<= pos (point-max)) (<= (point-min) pos))))))
-  
-
-(defvar vip-minibuffer-overlay-priority 300)
-(defvar vip-replace-overlay-priority 400)
-(defvar vip-search-overlay-priority 500)
-  
-
-;;; XEmacs support
-
-(if vip-xemacs-p
-    (progn
-      (fset 'vip-read-event (symbol-function 'next-command-event))
-      (fset 'vip-make-overlay (symbol-function 'make-extent))
-      (fset 'vip-overlay-start (symbol-function 'extent-start-position))
-      (fset 'vip-overlay-end (symbol-function 'extent-end-position))
-      (fset 'vip-overlay-put (symbol-function 'set-extent-property))
-      (fset 'vip-overlay-p (symbol-function 'extentp))
-      (fset 'vip-overlay-get (symbol-function 'extent-property))
-      (fset 'vip-move-overlay (symbol-function 'set-extent-endpoints))
-      (if (vip-window-display-p)
-	  (fset 'vip-iconify (symbol-function 'iconify-frame)))
-      (cond ((vip-has-face-support-p)
-	     (fset 'vip-get-face (symbol-function 'get-face))
-	     (fset 'vip-color-defined-p
-		   (symbol-function 'valid-color-name-p))
-	     )))
-  (fset 'vip-read-event (symbol-function 'read-event))
-  (fset 'vip-make-overlay (symbol-function 'make-overlay))
-  (fset 'vip-overlay-start (symbol-function 'overlay-start))
-  (fset 'vip-overlay-end (symbol-function 'overlay-end))
-  (fset 'vip-overlay-put (symbol-function 'overlay-put))
-  (fset 'vip-overlay-p (symbol-function 'overlayp))
-  (fset 'vip-overlay-get (symbol-function 'overlay-get))
-  (fset 'vip-move-overlay (symbol-function 'move-overlay))
-  (if (vip-window-display-p)
-      (fset 'vip-iconify (symbol-function 'iconify-or-deiconify-frame)))
-  (cond ((vip-has-face-support-p)
-	 (fset 'vip-get-face (symbol-function 'internal-get-face))
-	 (fset 'vip-color-defined-p (symbol-function 'x-color-defined-p))
-	 )))
-
-(fset 'vip-characterp
-      (symbol-function
-       (if vip-xemacs-p 'characterp 'integerp)))
-
-(defsubst vip-color-display-p ()
-  (if vip-emacs-p
-      (x-display-color-p)
-    (eq (device-class (selected-device)) 'color)))
-   
-(defsubst vip-get-cursor-color ()
-  (if vip-emacs-p
-      (cdr (assoc 'cursor-color (frame-parameters)))
-    (color-instance-name (frame-property (selected-frame) 'cursor-color))))
-  
-(defun vip-set-face-pixmap (face pixmap)
-  "Set face pixmap on a monochrome display."
-  (if (and (vip-window-display-p) (not (vip-color-display-p)))
-      (condition-case nil
-	  (set-face-background-pixmap face pixmap)
-	(error
-	 (message "Pixmap not found for %S: %s" (face-name face) pixmap)
-	 (sit-for 1)))))
-
-  
-;; OS/2
-(cond ((eq (vip-device-type) 'pm)
-       (fset 'vip-color-defined-p
-	     (function (lambda (color) (assoc color pm-color-alist))))))
-    
-;; needed to smooth out the difference between Emacs and XEmacs
-(defsubst vip-italicize-face (face)
-  (if vip-xemacs-p
-      (make-face-italic face)
-    (make-face-italic face nil 'noerror)))
-    
-;; test if display is color and the colors are defined
-(defsubst vip-can-use-colors (&rest colors)
-  (if (vip-color-display-p)
-      (not (memq nil (mapcar 'vip-color-defined-p colors)))
-    ))
-
-(defun vip-hide-face (face)
-  (if (and (vip-has-face-support-p) vip-emacs-p)
-      (add-to-list 'facemenu-unlisted-faces face)))
-
-;; cursor colors
-(defun vip-change-cursor-color (new-color)
-  (if (and (vip-window-display-p)  (vip-color-display-p)
-	   (stringp new-color) (vip-color-defined-p new-color)
-	   (not (string= new-color (vip-get-cursor-color))))
-      (modify-frame-parameters
-       (selected-frame) (list (cons 'cursor-color new-color)))))
-	 
-(defsubst vip-save-cursor-color ()
-  (if (and (vip-window-display-p) (vip-color-display-p))
-      (let ((color (vip-get-cursor-color)))
-	(if (and (stringp color) (vip-color-defined-p color)
-		 (not (string= color vip-replace-overlay-cursor-color)))
-	    (vip-overlay-put vip-replace-overlay 'vip-cursor-color color)))))
-	
-;; restore cursor color from replace overlay
-(defsubst vip-restore-cursor-color-after-replace ()
-  (vip-change-cursor-color
-   (vip-overlay-get vip-replace-overlay 'vip-cursor-color)))
-(defsubst vip-restore-cursor-color-after-insert ()
-  (vip-change-cursor-color vip-saved-cursor-color))
-	 
-
-;; Check the current version against the major and minor version numbers
-;; using op: cur-vers op major.minor If emacs-major-version or
-;; emacs-minor-version are not defined, we assume that the current version
-;; is hopelessly outdated.  We assume that emacs-major-version and
-;; emacs-minor-version are defined.  Otherwise, for Emacs/XEmacs 19, if the
-;; current minor version is < 10 (xemacs) or < 23 (emacs) the return value
-;; will be nil (when op is =, >, or >=) and t (when op is <, <=), which may be
-;; incorrect. However, this gives correct result in our cases, since we are
-;; testing for sufficiently high Emacs versions.
-(defun vip-check-version (op major minor &optional type-of-emacs)
-  (if (and (boundp 'emacs-major-version) (boundp 'emacs-minor-version))
-      (and (cond ((eq type-of-emacs 'xemacs) vip-xemacs-p)
-		 ((eq type-of-emacs 'emacs) vip-emacs-p)
-		 (t t))
-	   (cond ((eq op '=) (and (= emacs-minor-version minor)
-				  (= emacs-major-version major)))
-		 ((memq op '(> >= < <=))
-		  (and (or (funcall op emacs-major-version major)
-			   (= emacs-major-version major))
-		       (if (= emacs-major-version major)
-			   (funcall op emacs-minor-version minor)
-			 t)))
-		 (t
-		  (error "%S: Invalid op in vip-check-version" op))))
-    (cond ((memq op '(= > >=)) nil)
-	  ((memq op '(< <=)) t))))
-	  
-;;;; warn if it is a wrong version of emacs
-;;(if (or (vip-check-version '< 19 29 'emacs)
-;;	(vip-check-version '< 19 12 'xemacs))
-;;    (progn
-;;      (with-output-to-temp-buffer " *vip-info*"
-;;	(switch-to-buffer " *vip-info*")
-;;	(insert
-;;	 (format "
-;;
-;;This version of Viper requires 
-;;
-;;\t Emacs 19.29 and higher
-;;\t OR
-;;\t XEmacs 19.12 and higher
-;;
-;;It is unlikely to work under Emacs version %s
-;;that you are using... " emacs-version))
-;;
-;;	(if noninteractive
-;;	    ()
-;;	  (beep 1)
-;;	  (beep 1)
-;;	  (insert "\n\nType any key to continue... ")
-;;	  (vip-read-event)))
-;;      (kill-buffer " *vip-info*")))
-  
-
-(defun vip-get-visible-buffer-window (wind)
-  (if vip-xemacs-p
-      (get-buffer-window wind t)
-    (get-buffer-window wind 'visible)))
-    
-    
-;; Return line position.
-;; If pos is 'start then returns position of line start.
-;; If pos is 'end, returns line end. If pos is 'mid, returns line center.
-;; Pos = 'indent returns beginning of indentation.
-;; Otherwise, returns point. Current point is not moved in any case."
-(defun vip-line-pos (pos)
-  (let ((cur-pos (point))
-        (result))
-    (cond
-     ((equal pos 'start)
-      (beginning-of-line))
-     ((equal pos 'end)
-      (end-of-line))
-     ((equal pos 'mid)
-      (goto-char (+ (vip-line-pos 'start) (vip-line-pos 'end) 2)))
-     ((equal pos 'indent)
-      (back-to-indentation))
-     (t   nil))
-    (setq result (point))
-    (goto-char cur-pos)
-    result))
-
-
-;; Like move-marker but creates a virgin marker if arg isn't already a marker.
-;; The first argument must eval to a variable name.
-;; Arguments: (var-name position &optional buffer).
-;; 
-;; This is useful for moving markers that are supposed to be local.
-;; For this, VAR-NAME should be made buffer-local with nil as a default.
-;; Then, each time this var is used in `vip-move-marker-locally' in a new
-;; buffer, a new marker will be created.
-(defun vip-move-marker-locally (var pos &optional buffer)
-  (if (markerp (eval var))
-      ()
-    (set var (make-marker)))
-  (move-marker (eval var) pos buffer))
-
-
-;; Print CONDITIONS as a message.
-(defun vip-message-conditions (conditions)
-  (let ((case (car conditions)) (msg (cdr conditions)))
-    (if (null msg)
-	(message "%s" case)
-      (message "%s: %s" case (mapconcat 'prin1-to-string msg " ")))
-    (beep 1)))
-
-
-
-;;; List/alist utilities
-	
-;; Convert LIST to an alist
-(defun vip-list-to-alist (lst)
-  (let ((alist))
-    (while lst
-      (setq alist (cons (list (car lst)) alist))
-      (setq lst (cdr lst)))
-    alist))	
-
-;; Convert ALIST to a list.
-(defun vip-alist-to-list (alst)
-  (let ((lst))
-    (while alst
-      (setq lst (cons (car (car alst)) lst))
-      (setq alst (cdr alst)))
-    lst))
-
-;; Filter ALIST using REGEXP. Return alist whose elements match the regexp.
-(defun vip-filter-alist (regexp alst)
-  (interactive "s x")
-  (let ((outalst) (inalst alst))
-    (while (car inalst)
-      (if (string-match regexp (car (car inalst)))
-	  (setq outalst (cons (car inalst) outalst)))
-      (setq inalst (cdr inalst)))
-    outalst))    
-       
-;; Filter LIST using REGEXP. Return list whose elements match the regexp.
-(defun vip-filter-list (regexp lst)
-  (interactive "s x")
-  (let ((outlst) (inlst lst))
-    (while (car inlst)
-      (if (string-match regexp (car inlst))
-	  (setq outlst (cons (car inlst) outlst)))
-      (setq inlst (cdr inlst)))
-    outlst))    
-
-   
-;; Append LIS2 to LIS1, both alists, by side-effect and returns LIS1
-;; LIS2 is modified by filtering it: deleting its members of the form
-;; \(car elt\) such that (car elt') is in LIS1.
-(defun vip-append-filter-alist (lis1 lis2)
-  (let ((temp lis1)
-	elt)
-  
-    ;;filter-append the second list
-    (while temp
-      ;; delete all occurrences
-      (while (setq elt (assoc (car (car temp)) lis2))
-	(setq lis2 (delq elt lis2)))
-      (setq temp (cdr temp)))
-    
-    (nconc lis1 lis2)))
-
-
-;;; Support for :e and file globbing
-
-(defun vip-ex-nontrivial-find-file-unix (filespec)
-  "Glob the file spec and visit all files matching the spec.
-This function is designed to work under Unix. It may also work under VMS.
-
-Users who prefer other types of shells should write their own version of this
-function and set the variable `ex-nontrivial-find-file-function'
-appropriately." 
-  (let ((gshell
-	 (cond (ex-unix-type-shell shell-file-name)
-	       ((memq system-type '(vax-vms axp-vms)) "*dcl*") ; VAX VMS
-	       (t "sh"))) ; probably Unix anyway
-	(gshell-options
-	 ;; using cond in anticipation of further additions
-	 (cond (ex-unix-type-shell-options)
-	       ))
-	(command (cond (vip-ms-style-os-p (format "\"ls -1 -d %s\"" filespec))
-		       (t (format "ls -1 -d %s" filespec))))
-	file-list status)
-    (save-excursion 
-      (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
-      (erase-buffer)
-      (setq status
-	    (if gshell-options
-		(call-process gshell nil t nil
-			      gshell-options
-			      "-c"
-			      command)
-	      (call-process gshell nil t nil
-			    "-c"
-			    command)))
-      (goto-char (point-min))
-      ;; Issue an error, if no match.
-      (if (> status 0)
-	  (save-excursion
-	    (skip-chars-forward " \t\n\j")
-	    (if (looking-at "ls:")
-		(vip-forward-Word 1))
-	    (error "%s: %s"
-		   (if (stringp  gshell)
-		       gshell
-		     "shell")
-		   (buffer-substring (point) (vip-line-pos 'end)))
-	    ))
-      (goto-char (point-min))
-      (setq file-list (vip-get-filenames-from-buffer 'one-per-line)))
-
-    (mapcar 'find-file file-list)
-    ))
-
-(defun vip-ex-nontrivial-find-file-ms (filespec)
-  "Glob the file spec and visit all files matching the spec.
-This function is designed to work under MS type systems, such as NT, W95, and
-DOS. It may also work under OS/2.
-
-The users of Unix-type shells should be able to use
-`vip-ex-nontrivial-find-file-unix', making it into the value of the variable 
-`ex-nontrivial-find-file-function'. If this doesn't work, the user may have
-to write a custom function, similar to `vip-ex-nontrivial-find-file-unix'."
-  (save-excursion 
-    (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
-    (erase-buffer)
-    (insert filespec)
-    (goto-char (point-min))
-    (mapcar 'find-file
-	    (vip-glob-ms-windows-files (vip-get-filenames-from-buffer)))
-    ))
-
-
-;; Interpret the stuff in the buffer as a list of file names
-;; return a list of file names listed in the buffer beginning at point
-;; If optional arg is supplied, assume each filename is listed on a separate
-;; line
-(defun vip-get-filenames-from-buffer (&optional one-per-line)
-  (let ((skip-chars (if one-per-line "\t\n" " \t\n"))
-	 result fname delim)
-    (skip-chars-forward skip-chars)
-    (while (not (eobp))
-      (if (cond ((looking-at "\"")
-		 (setq delim ?\")
-		 (re-search-forward "[^\"]+" nil t)) ; noerror
-		((looking-at "'")
-		 (setq delim ?')
-		 (re-search-forward "[^']+" nil t)) ; noerror
-		(t 
-		 (re-search-forward
-		  (concat "[^" skip-chars "]+") nil t))) ;noerror
-	  (setq fname
-		(buffer-substring (match-beginning 0) (match-end 0))))
-      (if delim
-	  (forward-char 1))
-      (skip-chars-forward " \t\n")
-      (setq result (cons fname result)))
-    result))
-
-;; convert MS-DOS wildcards to regexp
-(defun vip-wildcard-to-regexp (wcard)
-  (save-excursion
-    (set-buffer (get-buffer-create vip-ex-tmp-buf-name))
-    (erase-buffer)
-    (insert wcard)
-    (goto-char (point-min))
-    (while (not (eobp))
-      (skip-chars-forward "^*?.\\\\")
-      (cond ((eq (char-after (point)) ?*) (insert ".")(forward-char 1))
-	    ((eq (char-after (point)) ?.) (insert "\\")(forward-char 1))
-	    ((eq (char-after (point)) ?\\) (insert "\\")(forward-char 1))
-	    ((eq (char-after (point)) ??) (delete-char 1)(insert ".")))
-      )
-    (buffer-string)
-    ))
-
-
-;; glob windows files
-;; LIST is expected to be in reverse order
-(defun vip-glob-ms-windows-files (list)
-  (let ((tmp list)
-	(case-fold-search t)
-	tmp2)
-    (while tmp
-      (setq tmp2 (cons (directory-files 
-			;; the directory part
-			(or (file-name-directory (car tmp))
-			    "")
-			t  ; return full names
-			;; the regexp part: globs the file names
-			(concat "^"
-				(vip-wildcard-to-regexp
-				 (file-name-nondirectory (car tmp)))
-				"$"))
-		       tmp2))
-      (setq tmp (cdr tmp)))
-    (reverse (apply 'append tmp2))))
-
-(defun vip-convert-standard-file-name (fname)
-  (if vip-emacs-p
-      (convert-standard-filename fname)
-    ;; hopefully, XEmacs adds this functionality
-    fname))
-
-
-
-;;; Insertion ring
-
-;; Rotate RING's index. DIRection can be positive or negative.
-(defun vip-ring-rotate1 (ring dir)
-  (if (and (ring-p ring) (> (ring-length ring) 0))
-      (progn
-	(setcar ring (cond ((> dir 0)
-			    (ring-plus1 (car ring) (ring-length ring)))
-			   ((< dir 0)
-			    (ring-minus1 (car ring) (ring-length ring)))
-			   ;; don't rotate if dir = 0
-			   (t (car ring))))
-	(vip-current-ring-item ring)
-	)))
-	
-(defun vip-special-ring-rotate1 (ring dir)
-  (if (memq vip-intermediate-command
-	    '(repeating-display-destructive-command
-	      repeating-insertion-from-ring))
-      (vip-ring-rotate1 ring dir)
-    ;; don't rotate otherwise
-    (vip-ring-rotate1 ring 0)))
-    
-;; current ring item; if N is given, then so many items back from the
-;; current
-(defun vip-current-ring-item (ring &optional n)
-  (setq n (or n 0))
-  (if (and (ring-p ring) (> (ring-length ring) 0))
-      (aref (cdr (cdr ring)) (mod (- (car ring) 1 n) (ring-length ring)))))
-    
-;; push item onto ring. the second argument is a ring-variable, not value.
-(defun vip-push-onto-ring (item ring-var)
-  (or (ring-p (eval ring-var))
-      (set ring-var (make-ring (eval (intern (format "%S-size" ring-var))))))
-  (or (null item) ; don't push nil
-      (and (stringp item) (string= item "")) ; or empty strings
-      (equal item (vip-current-ring-item (eval ring-var))) ; or old stuff
-      ;; Since vip-set-destructive-command checks if we are inside vip-repeat,
-      ;;    we don't check whether this-command-keys is a `.'.
-      ;;    The cmd vip-repeat makes a call to the current function only if
-      ;;    `.' is executing a command from the command history. It doesn't
-      ;;    call the push-onto-ring function if `.' is simply repeating the
-      ;;    last destructive command.
-      ;; We only check for ESC (which happens when we do insert with a
-      ;;    prefix argument, or if this-command-keys doesn't give anything
-      ;;    meaningful (in that case we don't know what to show to the user).
-      (and (eq ring-var 'vip-command-ring)
-	   (string-match "\\([0-9]*\e\\|^[ \t]*$\\|escape\\)"
-			 (vip-array-to-string (this-command-keys))))
-      (vip-ring-insert (eval ring-var) item))
-  )
-  
-
-;; removing elts from ring seems to break it
-(defun vip-cleanup-ring (ring)
-  (or (< (ring-length ring) 2)
-      (null (vip-current-ring-item ring))
-      ;; last and previous equal
-      (if (equal (vip-current-ring-item ring) (vip-current-ring-item ring 1))
-	  (vip-ring-pop ring))))
-	  
-;; ring-remove seems to be buggy, so we concocted this for our purposes.
-(defun vip-ring-pop (ring)
-  (let* ((ln (ring-length ring))
-	 (vec (cdr (cdr ring)))
-	 (veclen (length vec))
-	 (hd (car ring))
-	 (idx (max 0 (ring-minus1 hd ln)))
-	 (top-elt (aref vec idx)))
-	
-	;; shift elements
-	(while (< (1+ idx) veclen)
-	  (aset vec idx (aref vec (1+ idx)))
-	  (setq idx (1+ idx)))
-	(aset vec idx nil)
-	
-	(setq hd (max 0 (ring-minus1 hd ln)))
-	(if (= hd (1- ln)) (setq hd 0))
-	(setcar ring hd) ; move head
-	(setcar (cdr ring) (max 0 (1- ln))) ; adjust length
-	top-elt
-	))
-	
-(defun vip-ring-insert (ring item)
-  (let* ((ln (ring-length ring))
-	 (vec (cdr (cdr ring)))
-	 (veclen (length vec))
-	 (hd (car ring))
-	 (vecpos-after-hd (if (= hd 0) ln hd))
-	 (idx ln))
-	 
-    (if (= ln veclen)
-	(progn
-	  (aset vec hd item) ; hd is always 1+ the actual head index in vec
-	  (setcar ring (ring-plus1 hd ln)))
-      (setcar (cdr ring) (1+ ln))
-      (setcar ring (ring-plus1 vecpos-after-hd (1+ ln)))
-      (while (and (>= idx vecpos-after-hd) (> ln 0))
-	(aset vec idx (aref vec (1- idx)))
-	(setq idx (1- idx)))
-      (aset vec vecpos-after-hd item))
-    item))
-	
-
-;;; String utilities
-
-;; If STRING is longer than MAX-LEN, truncate it and print ...... instead
-;; PRE-STRING is a string to prepend to the abbrev string.
-;; POST-STRING is a string to append to the abbrev string.
-;; ABBREV_SIGN is a string to be inserted before POST-STRING
-;; if the orig string was truncated. 
-(defun vip-abbreviate-string (string max-len
-				     pre-string post-string abbrev-sign)
-  (let (truncated-str)
-    (setq truncated-str
-	  (if (stringp string) 
-	      (substring string 0 (min max-len (length string)))))
-    (cond ((null truncated-str) "")
-	  ((> (length string) max-len)
-	   (format "%s%s%s%s"
-		   pre-string truncated-str abbrev-sign post-string))
-	  (t (format "%s%s%s" pre-string truncated-str post-string)))))
-
-;; tells if we are over a whitespace-only line
-(defsubst vip-over-whitespace-line ()
-  (save-excursion
-    (beginning-of-line)
-    (looking-at "^[ \t]*$")))
-	  
-
-;;; Saving settings in custom file
-
-;; Save the current setting of VAR in CUSTOM-FILE.
-;; If given, MESSAGE is a message to be displayed after that.
-;; This message is erased after 2 secs, if erase-msg is non-nil.
-;; Arguments: var message custom-file &optional erase-message
-(defun vip-save-setting (var message custom-file &optional erase-msg)
-  (let* ((var-name (symbol-name var))
-	 (var-val (if (boundp var) (eval var)))
-	 (regexp (format "^[^;]*%s[ \t\n]*[a-zA-Z---_']*[ \t\n)]" var-name))
-	 (buf (find-file-noselect (substitute-in-file-name custom-file)))
-	)
-    (message message)
-    (save-excursion
-      (set-buffer buf)
-      (goto-char (point-min))
-      (if (re-search-forward regexp nil t)
-	  (let ((reg-end (1- (match-end 0))))
-	    (search-backward var-name)
-	    (delete-region (match-beginning 0) reg-end)
-	    (goto-char (match-beginning 0))
-	    (insert (format "%s  '%S" var-name var-val)))
-	(goto-char (point-max))
-	(if (not (bolp)) (insert "\n"))
-	(insert (format "(setq %s '%S)\n" var-name var-val)))
-      (save-buffer))
-      (kill-buffer buf)
-      (if erase-msg
-	  (progn
-	    (sit-for 2)
-	    (message "")))
-      ))
-      
-;; Save STRING in CUSTOM-FILE. If PATTERN is non-nil, remove strings that
-;; match this pattern.
-(defun vip-save-string-in-file (string custom-file &optional pattern)
-  (let ((buf (find-file-noselect (substitute-in-file-name custom-file))))
-    (save-excursion
-      (set-buffer buf)
-      (goto-char (point-min))
-      (if pattern (delete-matching-lines pattern))
-      (goto-char (point-max))
-      (if string (insert string))
-      (save-buffer))
-    (kill-buffer buf)
-    ))
-    
-
-;;; Overlays
-
-;; Search
-
-(defun vip-flash-search-pattern ()
-  (if (vip-overlay-p vip-search-overlay)
-      (vip-move-overlay vip-search-overlay (match-beginning 0) (match-end 0))
-    (setq vip-search-overlay
-	  (vip-make-overlay
-	   (match-beginning 0) (match-end 0) (current-buffer))))
-  
-  (vip-overlay-put vip-search-overlay 'priority vip-search-overlay-priority)
-  (if (vip-has-face-support-p)
-      (progn
-	(vip-overlay-put vip-search-overlay 'face vip-search-face)
-	(sit-for 2)
-	(vip-overlay-put vip-search-overlay 'face nil))))
-
-
-;; Replace state
-
-(defsubst vip-move-replace-overlay (beg end)
-  (vip-move-overlay vip-replace-overlay beg end))
-  
-(defun vip-set-replace-overlay (beg end)
-  (if (vip-overlay-p vip-replace-overlay)
-      (vip-move-replace-overlay beg end)
-    (setq vip-replace-overlay (vip-make-overlay beg end (current-buffer)))
-    ;; never detach
-    (vip-overlay-put
-     vip-replace-overlay (if vip-emacs-p 'evaporate 'detachable) nil)
-    (vip-overlay-put 
-     vip-replace-overlay 'priority vip-replace-overlay-priority)) 
-  (if (vip-has-face-support-p)
-      (vip-overlay-put vip-replace-overlay 'face vip-replace-overlay-face))
-  (vip-save-cursor-color)
-  (vip-change-cursor-color vip-replace-overlay-cursor-color)
-  )
-  
-      
-(defsubst vip-set-replace-overlay-glyphs (before-glyph after-glyph)
-  (if (or (not (vip-has-face-support-p))
-	  vip-use-replace-region-delimiters)
-      (let ((before-name (if vip-xemacs-p 'begin-glyph 'before-string))
-	    (after-name (if vip-xemacs-p 'end-glyph 'after-string)))
-	(vip-overlay-put vip-replace-overlay before-name before-glyph)
-	(vip-overlay-put vip-replace-overlay after-name after-glyph))))
-  
-(defsubst vip-hide-replace-overlay ()
-  (vip-set-replace-overlay-glyphs nil nil)
-  (vip-restore-cursor-color-after-replace)
-  (vip-restore-cursor-color-after-insert)
-  (if (vip-has-face-support-p)
-      (vip-overlay-put vip-replace-overlay 'face nil)))
-
-    
-(defsubst vip-replace-start ()
-  (vip-overlay-start vip-replace-overlay))
-(defsubst vip-replace-end ()
-  (vip-overlay-end vip-replace-overlay))
- 
-
-;; Minibuffer
-
-(defun vip-set-minibuffer-overlay ()
-  (vip-check-minibuffer-overlay)
-  (if (vip-has-face-support-p)
-      (progn
-	(vip-overlay-put
-	 vip-minibuffer-overlay 'face vip-minibuffer-current-face)
-	(vip-overlay-put 
-	 vip-minibuffer-overlay 'priority vip-minibuffer-overlay-priority)
-	;; never detach
-	(vip-overlay-put
-	 vip-minibuffer-overlay (if vip-emacs-p 'evaporate 'detachable) nil)
-	;; make vip-minibuffer-overlay open-ended
-	;; In emacs, it is made open ended at creation time
-	(if vip-xemacs-p
-	    (progn
-	      (vip-overlay-put vip-minibuffer-overlay 'start-open nil)
-	      (vip-overlay-put vip-minibuffer-overlay 'end-open nil)))
-	)))
-       
-(defun vip-check-minibuffer-overlay ()
-  (or (vip-overlay-p vip-minibuffer-overlay)
-      (setq vip-minibuffer-overlay
-	    (if vip-xemacs-p
-		(vip-make-overlay 1 (1+ (buffer-size)) (current-buffer))
-	      ;; make overlay open-ended
-	      (vip-make-overlay
-	       1 (1+ (buffer-size)) (current-buffer) nil 'rear-advance)))
-      ))
-
-
-(defsubst vip-is-in-minibuffer ()
-  (string-match "\*Minibuf-" (buffer-name)))
-  
-
-
-;;; XEmacs compatibility
-
-(defun vip-abbreviate-file-name (file)
-  (if vip-emacs-p
-      (abbreviate-file-name file)
-    ;; XEmacs requires addl argument
-    (abbreviate-file-name file t)))
-    
-;; Sit for VAL milliseconds. XEmacs doesn't support the millisecond arg 
-;; in sit-for, so this function smoothes out the differences.
-(defsubst vip-sit-for-short (val &optional nodisp)
-  (if vip-xemacs-p
-      (sit-for (/ val 1000.0) nodisp)
-    (sit-for 0 val nodisp)))
-
-;; EVENT may be a single event of a sequence of events
-(defsubst vip-ESC-event-p (event)
-  (let ((ESC-keys '(?\e (control \[) escape))
-	(key (vip-event-key event)))
-    (member key ESC-keys)))
-	
-  
-(defsubst vip-mark-marker ()
-  (if vip-xemacs-p
-      (mark-marker t)
-    (mark-marker)))
-
-;; like (set-mark-command nil) but doesn't push twice, if (car mark-ring)
-;; is the same as (mark t).
-(defsubst vip-set-mark-if-necessary ()
-  (setq mark-ring (delete (vip-mark-marker) mark-ring))
-  (set-mark-command nil))
-       
-;; In transient mark mode (zmacs mode), it is annoying when regions become
-;; highlighted due to Viper's pushing marks. So, we deactivate marks, unless
-;; the user explicitly wants highlighting, e.g., by hitting '' or ``
-(defun vip-deactivate-mark ()
-  (if vip-xemacs-p
-      (zmacs-deactivate-region)
-    (deactivate-mark)))
-
-(defsubst vip-leave-region-active ()
-  (if vip-xemacs-p
-      (setq zmacs-region-stays t)))
-
-    
-(defsubst vip-events-to-keys (events)
-  (cond (vip-xemacs-p (events-to-keys events))
-	(t events)))
-		  
-	
-(defun vip-eval-after-load (file form)
-  (if vip-emacs-p
-      (eval-after-load file form)
-    (or (assoc file after-load-alist)
-	(setq after-load-alist (cons (list file) after-load-alist)))
-    (let ((elt (assoc file after-load-alist)))
-      (or (member form (cdr elt))
-	  (setq elt (nconc elt (list form)))))
-    form
-    ))
-
-;; This is here because Emacs changed the way local hooks work.
-;;
-;;Add to the value of HOOK the function FUNCTION.
-;;FUNCTION is not added if already present.
-;;FUNCTION is added (if necessary) at the beginning of the hook list
-;;unless the optional argument APPEND is non-nil, in which case
-;;FUNCTION is added at the end.
-;;
-;;HOOK should be a symbol, and FUNCTION may be any valid function.  If
-;;HOOK is void, it is first set to nil.  If HOOK's value is a single
-;;function, it is changed to a list of functions."
-(defun vip-add-hook (hook function &optional append)
-  (if (not (boundp hook)) (set hook nil))
-  ;; If the hook value is a single function, turn it into a list.
-  (let ((old (symbol-value hook)))
-    (if (or (not (listp old)) (eq (car old) 'lambda))
-	(setq old (list old)))
-    (if (member function old)
-	nil
-      (set hook (if append
-		    (append old (list function)) ; don't nconc
-		  (cons function old))))))
-
-;; This is here because of Emacs's changes in the semantics of add/remove-hooks
-;; and due to the bugs they introduced.
-;;
-;; Remove from the value of HOOK the function FUNCTION.
-;; HOOK should be a symbol, and FUNCTION may be any valid function.  If
-;; FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
-;; list of hooks to run in HOOK, then nothing is done.  See `vip-add-hook'."
-(defun vip-remove-hook (hook function)
-  (if (or (not (boundp hook))		;unbound symbol, or
-	  (null (symbol-value hook))	;value is nil, or
-	  (null function))		;function is nil, then
-      nil				;Do nothing.
-    (let ((hook-value (symbol-value hook)))
-      (if (consp hook-value)
-	  ;; don't side-effect the list
-	  (setq hook-value (delete function (copy-sequence hook-value)))
-	(if (equal hook-value function)
-	    (setq hook-value nil)))
-      (set hook hook-value))))
-
-    
-    
-;; like read-event, but in XEmacs also try to convert to char, if possible
-(defun vip-read-event-convert-to-char ()
-  (let (event)
-    (if vip-emacs-p
-	(read-event)
-      (setq event (next-command-event))
-      (or (event-to-character event)
-	  event))
-    ))
-
-;; This function lets function-key-map convert key sequences into logical
-;; keys. This does a better job than vip-read-event when it comes to kbd
-;; macros, since it enables certain macros to be shared between X and TTY modes
-;; by correctly mapping key sequences for Left/Right/... (one an ascii
-;; terminal) into logical keys left, right, etc.
-(defun vip-read-key () 
-  (let ((overriding-local-map vip-overriding-map) 
-	(inhibit-quit t)
-        key) 
-    (use-global-map vip-overriding-map) 
-    (setq key (elt (read-key-sequence nil) 0)) 
-    (use-global-map global-map) 
-    key))
-
-
-;; Emacs has a bug in eventp, which causes (eventp nil) to return (nil)
-;; instead of nil, if '(nil) was previously inadvertently assigned to
-;; unread-command-events
-(defun vip-event-key (event)
-  (or (and event (eventp event))
-      (error "vip-event-key: Wrong type argument, eventp, %S" event))
-  (let ((mod (event-modifiers event))
-	basis)
-    (setq basis
-	  (cond
-	   (vip-xemacs-p
-	    (cond ((key-press-event-p event)
-		   (event-key event))
-		  ((button-event-p event)
-		   (concat "mouse-" (prin1-to-string (event-button event))))
-		  (t 
-		   (error "vip-event-key: Unknown event, %S" event))))
-	   (t 
-	    ;; Emacs doesn't handle capital letters correctly, since
-	    ;; \S-a isn't considered the same as A (it behaves as
-	    ;; plain `a' instead). So we take care of this here
-	    (cond ((and (vip-characterp event) (<= ?A event) (<= event ?Z))
-		   (setq mod nil
-			 event event))
-		  ;; Emacs has the oddity whereby characters 128+char
-		  ;; represent M-char *if* this appears inside a string.
-		  ;; So, we convert them manually to (meta char).
-		  ((and (vip-characterp event) (< ?\C-? event) (<= event 255))
-		   (setq mod '(meta)
-			 event (- event ?\C-? 1)))
-		  (t (event-basic-type event)))
-	    )))
-    (if (vip-characterp basis)
-	(setq basis
-	      (if (= basis ?\C-?)
-		  (list 'control '\?) ; taking care of an emacs bug
-		(intern (char-to-string basis)))))
-    (if mod
-	(append mod (list basis))
-      basis)))
-    
-(defun vip-key-to-emacs-key (key)
-  (let (key-name char-p modifiers mod-char-list base-key base-key-name)
-    (cond (vip-xemacs-p key)
-	  ((symbolp key)
-	   (setq key-name (symbol-name key))
-	   (if (= (length key-name) 1) ; character event
-	       (string-to-char key-name)
-	     key))
-	  ((listp key)
-	   (setq modifiers (subseq key 0 (1- (length key)))
-		 base-key (vip-seq-last-elt key)
-		 base-key-name (symbol-name base-key)
-		 char-p (= (length base-key-name) 1))
-	   (setq mod-char-list
-		 (mapcar
-		  '(lambda (elt) (upcase (substring (symbol-name elt) 0 1)))
-		  modifiers))
-	   (if char-p
-	       (setq key-name
-		     (car (read-from-string
-			   (concat
-			    "?\\"
-			    (mapconcat 'identity mod-char-list "-\\")
-			    "-"
-			    base-key-name))))
-	     (setq key-name
-		   (intern
-		    (concat
-		     (mapconcat 'identity mod-char-list "-")
-		     "-"
-		     base-key-name))))))
-    ))
-
-
-;; Args can be a sequence of events, a string, or a Viper macro.  Will try to
-;; convert events to keys and, if all keys are regular printable
-;; characters, will return a string. Otherwise, will return a string
-;; representing a vector of converted events. If the input was a Viper macro,
-;; will return a string that represents this macro as a vector.
-(defun vip-array-to-string (event-seq)
-  (let (temp temp2)
-    (cond ((stringp event-seq) event-seq)
-	  ((vip-event-vector-p event-seq)
-	    (setq temp (mapcar 'vip-event-key event-seq))
-	    (cond ((vip-char-symbol-sequence-p temp)
-		   (mapconcat 'symbol-name temp ""))
-		  ((and (vip-char-array-p
-			 (setq temp2 (mapcar 'vip-key-to-character temp))))
-		   (mapconcat 'char-to-string temp2 ""))
-		  (t (prin1-to-string (vconcat temp)))))
-	  ((vip-char-symbol-sequence-p event-seq)
-	   (mapconcat 'symbol-name event-seq ""))
-	  ((and (vectorp event-seq) 
-		(vip-char-array-p
-		 (setq temp (mapcar 'vip-key-to-character event-seq))))
-	   (mapconcat 'char-to-string temp ""))
-	  (t (prin1-to-string event-seq)))))
-
-(defun vip-key-press-events-to-chars (events)
-  (mapconcat (if vip-emacs-p
-		 'char-to-string
-	       (function
-		(lambda (elt) (char-to-string (event-to-character elt)))))
-	     events
-	     ""))
-	   
-    
-(defsubst vip-fast-keysequence-p ()
-  (not (vip-sit-for-short vip-fast-keyseq-timeout t)))
-    
-(defun vip-read-char-exclusive ()
-  (let (char
-	(echo-keystrokes 1))
-    (while (null char)
-      (condition-case nil
-	  (setq char (read-char))
-	(error
-	 ;; skip event if not char
-	 (vip-read-event))))
-    char))
-
-;; key is supposed to be in viper's representation, e.g., (control l), a
-;; character, etc.
-(defun vip-key-to-character (key)
-  (cond ((eq key 'space) ?\ )
-	((eq key 'delete) ?\C-?)
-	((eq key 'backspace) ?\C-h)
-	((and (symbolp key)
-	      (= 1 (length (symbol-name key))))
-	 (string-to-char (symbol-name key)))
-	((and (listp key)
-	      (eq (car key) 'control)
-	      (symbol-name (nth 1 key))
-	      (= 1 (length (symbol-name (nth 1 key)))))
-	 (read (format "?\\C-%s" (symbol-name (nth 1 key)))))
-	(t key)))
-    
-      
-(defun vip-setup-master-buffer (&rest other-files-or-buffers)
-  "Set up the current buffer as a master buffer.
-Arguments become related buffers. This function should normally be used in
-the `Local variables' section of a file."
-  (setq vip-related-files-and-buffers-ring 
-	(make-ring (1+ (length other-files-or-buffers))))
-  (mapcar '(lambda (elt)
-	     (vip-ring-insert vip-related-files-and-buffers-ring elt))
-	  other-files-or-buffers)
-  (vip-ring-insert vip-related-files-and-buffers-ring (buffer-name))
-  )
-
-;;; Movement utilities
-
-(defvar vip-syntax-preference 'strict-vi
-  "*Syntax type characterizing Viper's alphanumeric symbols.
-`emacs' means only word constituents are considered to be alphanumeric.
-Word constituents are symbols specified as word constituents by the current
-syntax table.
-`extended' means word and symbol constituents.
-`reformed-vi' means Vi-ish behavior: word constituents and the symbol `_'.
-However, word constituents are determined according to Emacs syntax tables,
-which may be different from Vi in some major modes.
-`strict-vi' means Viper words are exactly as in Vi.")
-
-(vip-deflocalvar vip-ALPHA-char-class "w"
-  "String of syntax classes characterizing Viper's alphanumeric symbols.
-In addition, the symbol `_' may be considered alphanumeric if
-`vip-syntax-preference'is `reformed-vi'.")
-
-(vip-deflocalvar vip-strict-ALPHA-chars "a-zA-Z0-9_"
-  "Regexp matching the set of alphanumeric characters acceptable to strict
-Vi.")
-(vip-deflocalvar vip-strict-SEP-chars " \t\n"
-  "Regexp matching the set of alphanumeric characters acceptable to strict
-Vi.")
-
-(vip-deflocalvar vip-SEP-char-class " -"
-  "String of syntax classes for Vi separators.
-Usually contains ` ', linefeed, TAB or formfeed.")
-
-(defun vip-update-alphanumeric-class ()
-  "Set the syntax class of Viper alphanumerals according to `vip-syntax-preference'.
-Must be called in order for changes to `vip-syntax-preference' to take effect."
-  (interactive)
-  (setq-default
-   vip-ALPHA-char-class
-   (cond ((eq vip-syntax-preference 'emacs) "w")     ; only word constituents
-	 ((eq vip-syntax-preference 'extended) "w_") ; word & symbol chars
-	 (t "w"))))     ; vi syntax: word constituents and the symbol `_'
-
-;; addl-chars are characters to be temporarily considered as alphanumerical
-(defun vip-looking-at-alpha (&optional addl-chars)
-  (or (stringp addl-chars) (setq addl-chars ""))
-  (if (eq vip-syntax-preference 'reformed-vi)
-      (setq addl-chars (concat addl-chars "_")))
-  (let ((char (char-after (point))))
-    (if char
-	(if (eq vip-syntax-preference 'strict-vi)
-	    (looking-at (concat "[" vip-strict-ALPHA-chars addl-chars "]"))
-	  (or (memq char
-		    ;; convert string to list
-		    (append (vconcat addl-chars) nil))
-	      (memq (char-syntax char)
-		    (append (vconcat vip-ALPHA-char-class) nil)))))
-    ))
-
-(defsubst vip-looking-at-separator ()
-  (let ((char (char-after (point))))
-    (if char
-	(or (eq char ?\n) ; RET is always a separator in Vi
-	    (memq (char-syntax char)
-		  (append (vconcat vip-SEP-char-class) nil))))))
-
-(defsubst vip-looking-at-alphasep (&optional addl-chars)
-  (or (vip-looking-at-separator) (vip-looking-at-alpha addl-chars)))
-
-(defsubst vip-skip-alpha-forward (&optional addl-chars)
-  (or (stringp addl-chars) (setq addl-chars ""))
-  (vip-skip-syntax
-   'forward 
-   (cond ((eq vip-syntax-preference 'strict-vi)
-	  "")
-	 (t vip-ALPHA-char-class ))
-   (cond ((eq vip-syntax-preference 'strict-vi)
-	  (concat vip-strict-ALPHA-chars addl-chars))
-	 (t addl-chars))))
-
-(defsubst vip-skip-alpha-backward (&optional addl-chars)
-  (or (stringp addl-chars) (setq addl-chars ""))
-  (vip-skip-syntax
-   'backward 
-   (cond ((eq vip-syntax-preference 'strict-vi)
-	  "")
-	 (t vip-ALPHA-char-class ))
-   (cond ((eq vip-syntax-preference 'strict-vi)
-	  (concat vip-strict-ALPHA-chars addl-chars))
-	 (t addl-chars))))
-
-;; weird syntax tables may confuse strict-vi style
-(defsubst vip-skip-all-separators-forward (&optional within-line)
-  (vip-skip-syntax 'forward
-		   vip-SEP-char-class
-		   (or within-line "\n")
-		   (if within-line (vip-line-pos 'end))))
-(defsubst vip-skip-all-separators-backward (&optional within-line)
-  (vip-skip-syntax 'backward
-		   vip-SEP-char-class
-		   (or within-line "\n")
-		   (if within-line (vip-line-pos 'start))))
-(defun vip-skip-nonseparators (direction)
-  (let ((func (intern (format "skip-syntax-%S" direction))))
-    (funcall func (concat "^" vip-SEP-char-class)
-	     (vip-line-pos (if (eq direction 'forward) 'end 'start)))))
-
-(defsubst vip-skip-nonalphasep-forward ()
-  (if (eq vip-syntax-preference 'strict-vi)
-      (skip-chars-forward
-       (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars))
-    (skip-syntax-forward
-     (concat
-      "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'end))))
-(defsubst vip-skip-nonalphasep-backward ()
-  (if (eq vip-syntax-preference 'strict-vi)
-      (skip-chars-backward
-       (concat "^" vip-strict-SEP-chars vip-strict-ALPHA-chars))
-    (skip-syntax-backward
-     (concat
-      "^" vip-ALPHA-char-class vip-SEP-char-class) (vip-line-pos 'start))))
-
-;; Skip SYNTAX like skip-syntax-* and ADDL-CHARS like skip-chars-*
-;; Return the number of chars traveled.
-;; Either SYNTAX or ADDL-CHARS can be nil, in which case they are interpreted
-;; as an empty string.
-(defun vip-skip-syntax (direction syntax addl-chars &optional limit)
-  (let ((total 0)
-	(local 1)
-	(skip-chars-func (intern (format "skip-chars-%S" direction)))
-	(skip-syntax-func (intern (format "skip-syntax-%S" direction))))
-    (or (stringp addl-chars) (setq addl-chars ""))
-    (or (stringp syntax) (setq syntax ""))
-    (while (and (not (= local 0)) (not (eobp)))
-      (setq local
-	    (+ (funcall skip-syntax-func syntax limit)
-	       (funcall skip-chars-func addl-chars limit)))
-      (setq total (+ total local)))
-    total
-    ))
-  
-
-  
-  
-(provide 'viper-util)
-
-;;;  viper-util.el ends here
diff --git a/lisp/emulation/viper.el b/lisp/emulation/viper.el
deleted file mode 100644
index 592f15021ac..00000000000
--- a/lisp/emulation/viper.el
+++ /dev/null
@@ -1,5892 +0,0 @@
-;;; viper.el --- A full-featured Vi emulator for GNU Emacs 19 and XEmacs 19,
-;;		 a VI Plan for Emacs Rescue,
-;;		 and a venomous VI PERil.
-;;		 Viper Is also a Package for Emacs Rebels.
-;;
-;;  Keywords: emulations
-;;  Author: Michael Kifer <kifer@cs.sunysb.edu>
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-(defconst viper-version "2.91 of August 5, 1996"
-  "The current version of Viper")
-
-;; 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:
-
-;; Viper is a full-featured Vi emulator for Emacs 19.  It emulates and
-;; improves upon the standard features of Vi and, at the same time, allows
-;; full access to all Emacs facilities.  Viper supports multiple undo,
-;; file name completion, command, file, and search history and it extends
-;; Vi in many other ways. Viper is highly customizable through the various
-;; hooks, user variables, and keymaps.  It is implemented as a collection
-;; of minor modes and it is designed to provide full access to all Emacs
-;; major and minor modes.
-;;
-;;; History
-;;
-;; Viper is a new name for a package formerly known as VIP-19,
-;; which was a successor of VIP version 3.5 by Masahiko Sato
-;; <ms@sail.stanford.edu> and VIP version 4.2 by Aamod Sane
-;; <sane@cs.uiuc.edu>. Some ideas from vip 4.4.2 by Aamod Sane
-;; were also shamelessly plagiarized.
-;;
-;; Viper maintains some degree of compatibility with these older
-;; packages. See the documentation for customization.
-;;
-;; The main difference between Viper and these older packages are:
-;;
-;; 1. Viper emulates Vi at several levels, from almost complete conformity
-;;    to a rather loose Vi-compliance.
-;;
-;; 2. Viper provides full access to all major and minor modes of Emacs
-;;    without the need to type extra keys.
-;;    The older versions of VIP (and other Vi emulators) do not work with
-;;    some major and minor modes.
-;;
-;; 3. Viper supports vi-style undo.
-;;
-;; 4. Viper fully emulates (and improves upon) vi's replacement mode.
-;;
-;; 5. Viper has a better interface to ex, including command, variable, and
-;;    file name completion.
-;;
-;; 6. Viper uses native Emacs history and completion features; it doesn't
-;;    rely on other packages (such as gmhist.el and completer.el) to provide
-;;    these features.
-;;
-;; 7. Viper supports Vi-style editing in the minibuffer, by allowing the
-;;    user to switch from Insert state to Vi state to Replace state, etc.
-;;
-;; 8. Viper keeps history of recently inserted pieces of text and recently
-;;    executed Vi-style destructive commands, such as `i', `d', etc.
-;;    These pieces of text can be inserted in later insertion commands;
-;;    the previous destructive commands can be re-executed.
-;;
-;; 9. Viper has Vi-style keyboard macros, which enhances the similar
-;;    facility in the original Vi.
-;;    First, one can execute any Emacs command while defining a
-;;    macro, not just the Vi commands. Second, macros are defined in a
-;;    WYSYWYG mode, using an interface to Emacs' WYSIWYG style of defining
-;;    macros. Third, in Viper, one can define macros that are specific to
-;;    a given buffer, a given major mode, or macros defined for all buffers.
-;;    The same macro name can have several different definitions:
-;;    one global, several definitions for various major modes, and
-;;    definitions for specific buffers.
-;;    Buffer-specific definitions override mode-specific
-;;    definitions, which, in turn, override global definitions.
-;;
-;;
-;;; Installation:
-;;  -------------
-;;
-;;  (require 'viper)
-;;
-
-;;; Acknowledgements:
-;;  -----------------
-;;  Bug reports and ideas contributed by many users have helped
-;;  improve Viper and the various versions of VIP.
-;;  See the on-line manual for a complete list of contributors. 
-;;
-;;
-;;; Notes:
-;;
-;; 1. Major modes.
-;; In most cases, Viper handles major modes correctly, i.e., they come up
-;; in the right state (either  vi-state or emacs-state). For instance, text
-;; files come up in vi-state, while, say, Dired appears in emacs-state by
-;; default. 
-;; However, some modes do not appear in the right mode in the beginning,
-;; usually because they neglect to follow Emacs conventions (e.g., they don't
-;; use kill-all-local-variables when they start). Some major modes
-;; may fail to come up in emacs-state if they call hooks, such as
-;; text-hook, for no good reason. 
-;; 
-;; As an immediate solution, you can hit C-z to bring about the right mode.
-;; An interim solution is to add an appropriate hook to the mode like this:
-;; 
-;;     (add-hook 'your-favorite-mode 'viper-mode)
-;; or    
-;;     (add-hook 'your-favorite-mode 'vip-change-state-to-emacs)
-;; 
-;; whichever applies. The right thing to do, however, is to complain to the
-;; author of the respective package. (Sometimes they also neglect to equip
-;; their  modes with hooks, which is one more reason for complaining.)
-;; 
-;; 2. Keymap handling
-;;    Because Emacs 19 has an elegant mechanism for turning minor mode keymaps
-;;    on and off, implementation of Viper has been greatly simplified. Viper
-;;    has several minor modes.
-;;
-;; Viper's  Vi state consists of seven minor modes:
-;;
-;;  vip-vi-intercept-minor-mode
-;;  vip-vi-local-user-minor-mode
-;;  vip-vi-global-user-minor-mode
-;;  vip-vi-kbd-minor-mode
-;;  vip-vi-state-modifier-minor-mode
-;;  vip-vi-diehard-minor-mode
-;;  vip-vi-basic-minor-mode
-;;
-;;  Bindings done to the keymap of the first mode overshadow those done to
-;;  the second, which, in turn, overshadows those done to the third, etc.
-;;
-;;  The last vip-vi-basic-minor-mode contains most of the usual Vi bindings
-;;  in its edit mode. This mode provides access to all Emacs facilities.
-;;  Novice users, however, may want to set their vip-expert-level to 1
-;;  in their .vip file. This will enable vip-vi-diehard-minor-mode. This
-;;  minor mode's bindings make Viper simulate the usual Vi very closely.
-;;  For instance,  C-c will not have its standard Emacs binding
-;;  and so many of the goodies of Emacs are not available.
-;;
-;;  A skilled user should set vip-expert-level to at least 3. This will
-;;  enable `C-c' and many Emacs facilities will become available.
-;;  In this case, vip-vi-diehard-minor-mode is inactive.
-;;
-;;  Viper gurus should have at least
-;;      (setq vip-expert-level 4)
-;;  in their ~/.vip files. This will unsuppress all Emacs keys that are not
-;;  essential for VI-style editing.
-;;  Pick-and-choose users may want to put
-;;      (setq vip-expert-level 5)
-;;  in ~/.vip. Viper will then leave it up to the user to set the variables
-;;  vip-want-*  See vip-set-expert-level for details.
-;;
-;;  The very first minor mode, vip-vi-intercept-minor-mode, is of no
-;;  concern for the user. It is needed to bind Viper's vital keys, such as
-;;  ESC and C-z.
-;;
-;;  The second mode,  vip-vi-local-user-minor-mode, usually has an
-;;  empty keymap. However, the user can set bindings in this keymap, which
-;;  will overshadow the corresponding bindings in the other two minor
-;;  modes. This is useful, for example, for setting up ZZ in gnus,
-;;  rmail, mh-e, etc., to send  message instead of saving it in a file.
-;;  Likewise, in Dired mode, you may want to bind ZN and ZP to commands
-;;  that would visit the next or the previous file in the Dired buffer.
-;;  Setting local keys is tricky, so don't do it directly. Instead, use
-;;  vip-add-local-keys function (see its doc).
-;;
-;;  The third minor mode, vip-vi-global-user-minor-mode, is also intended
-;;  for the users but, unlike vip-vi-local-user-minor-mode, its key
-;;  bindings are seen in all Viper buffers. This mode keys can be done
-;;  with define-key command.
-;;
-;;  The fourth minor mode, vip-vi-kbd-minor-mode, is used by keyboard
-;;  macros. Users are NOT supposed to modify this keymap directly.
-;;
-;;  The fifth mode, vip-vi-state-modifier-minor-mode, can be used to set
-;;  key bindings that are visible in some major modes but not in others.
-;;
-;;  Users are allowed to modify keymaps that belong to
-;;  vip-vi-local-user-minor-mode, vip-vi-global-user-minor-mode,
-;;  and vip-vi-state-modifier-minor-mode only.
-;;
-;;  Viper's Insert state also has seven minor modes:
-;;
-;;      vip-insert-intercept-minor-mode
-;;  	vip-insert-local-user-minor-mode
-;;  	vip-insert-global-user-minor-mode
-;;  	vip-insert-kbd-minor-mode
-;;      vip-insert-state-modifier-minor-mode
-;;  	vip-insert-diehard-minor-mode
-;;  	vip-insert-basic-minor-mode
-;;
-;;  As with VI's editing modes, the first mode, vip-insert-intercept-minor-mode
-;;  is used to bind vital keys that are not to be changed by the user.
-;;
-;;  The next mode, vip-insert-local-user-minor-mode, is used to customize
-;;  bindings in the insert state of Viper. The third mode,
-;;  vip-insert-global-user-minor-mode is like
-;;  vip-insert-local-user-minor-mode, except that its bindings are seen in 
-;;  all Viper buffers. As with vip-vi-local-user-minor-mode, its bindings
-;;  should be done via the function vip-add-local-keys. Bindings for
-;;  vip-insert-global-user-minor-mode can be set with the define-key command.
-;;
-;;  The next minor mode, vip-insert-kbd-minor-mode,
-;;  is used for keyboard VI-style macros defined with :map!. 
-;;
-;;  The fifth minor mode, vip-insert-state-modifier-minor-mode, is like
-;;  vip-vi-state-modifier-minor-mode, except that it is used in the Insert
-;;  state; it can be used to modify keys in a mode-specific fashion. 
-;;
-;;  The minor mode vip-insert-diehard-minor-mode is in effect when
-;;  the user wants a high degree of Vi compatibility (a bad idea, really!).
-;;  The last minor mode, vip-insert-basic-minor-mode, is always in effect
-;;  when Viper is in insert state. It binds a small number of keys needed for
-;;  Viper's operation. 
-;;
-;;  Finally, Viper provides minor modes for overriding bindings set by Emacs
-;;  modes when Viper is in Emacs state:
-;;
-;; 	vip-emacs-local-user-minor-mode
-;;  	vip-emacs-global-user-minor-mode
-;;      vip-emacs-kbd-minor-mode
-;;      vip-emacs-state-modifier-minor-mode
-;;
-;;  These minor modes are in effect when Viper is in Emacs state. The keymap
-;;  associated with vip-emacs-global-user-minor-mode,
-;;  vip-emacs-global-user-map, overrides the global and local keymaps as
-;;  well as the minor mode keymaps set by other modes. The keymap of
-;;  vip-emacs-local-user-minor-mode, vip-emacs-local-user-map, overrides
-;;  everything, but it is used on a per buffer basis.
-;;  The keymap associated with vip-emacs-state-modifier-minor-mode
-;;  overrides keys on a per-major-mode basis. The mode
-;;  vip-emacs-kbd-minor-mode is used to define Vi-style macros in Emacs
-;;  state.
-;;
-;;  3. There is also one minor mode that is used when Viper is in its
-;;     replace-state (used for commands like cw, C, etc.). This mode is
-;;     called
-;;
-;;       vip-replace-minor-mode
-;;
-;;     and its keymap is vip-replace-map. Replace minor mode is always
-;;     used in conjunction with the minor modes for insert-state, and its
-;;     keymap overshadows the keymaps for insert minor modes.
-;;
-;;  4. Defining buffer-local bindings in Vi and Insert modes. 
-;;  As mentioned before, sometimes, it is convenient to have
-;;  buffer-specific of mode-specific key bindings in Vi and insert modes.
-;;  Viper provides a special function, vip-add-local-keys, to do precisely
-;;  this. For instance, is you need to add couple of mode-specific bindings
-;;  to Insert mode, you can put 
-;;
-;;       (vip-add-local-keys 'insert-state '((key1 . func1) (key2 .func2))) 
-;;
-;;  somewhere in a hook of this major mode. If you put something like this
-;;  in your own elisp function, this will define bindings specific to the
-;;  buffer that was current at the time of the call to vip-add-local-keys.
-;;  The only thing to make sure here is that the major mode of this buffer
-;;  is written according to Emacs conventions, which includes a call to
-;;  (kill-all-local-variables). See vip-add-local-keys for more details.
-;;
-;;
-;;  TO DO (volunteers?):
-;;
-;; 1. Some of the code that is inherited from VIP-3.5 is rather
-;;    convoluted. Instead of vip-command-argument, keymaps should bind the
-;;    actual commands. E.g., "dw" should be bound to a generic command
-;;    vip-delete that will delete things based on the value of
-;;    last-command-char. This would greatly simplify the logic and the code.
-;;
-;; 2. Somebody should venture to write a customization package a la
-;;    options.el that would allow the user to change values of variables
-;;    that meet certain specs (e.g., match a regexp) and whose doc string
-;;    starts with a '*'. Then, the user should be offered to save
-;;    variables that were changed. This will make user's customization job
-;;    much easier.
-;;
-
-;; Code
-
-(require 'advice)
-(require 'cl)
-(require 'ring)
-
-(require 'viper-util)
-
-;; Compiler pacifier
-(defvar vip-minibuffer-current-face)
-(defvar vip-minibuffer-insert-face)
-(defvar vip-minibuffer-vi-face)
-(defvar vip-minibuffer-emacs-face)
-(defvar iso-accents-mode)
-(defvar zmacs-region-stays)
-;; end pacifier
-
-
-;;; Variables
-	      
-;; Is t until viper-mode executes for the very first time. 
-;; Prevents recursive descend into startup messages.
-(defvar vip-first-time t)
-
-(defvar vip-expert-level 0
-  "User's expert level.
-The minor mode vip-vi-diehard-minor-mode is in effect when
-vip-expert-level is 1 or 2 or when vip-want-emacs-keys-in-vi is t.
-The minor mode vip-insert-diehard-minor-mode is in effect when
-vip-expert-level is 1 or 2 or if vip-want-emacs-keys-in-insert is t.
-Use `M-x vip-set-expert-level' to change this.")
-
-;; Max expert level supported by Viper. This is NOT a user option.
-;; It is here to make it hard for the user from resetting it.
-(defconst vip-max-expert-level 5)
-
-;; Contains user settings for vars affected by vip-set-expert-level function.
-;; Not a user option.
-(defvar vip-saved-user-settings nil)
-	       
-
-;;; Viper minor modes
-
-;; This is not local in Emacs, so we make it local.
-;; This must be local because although the stack of minor modes can be the same
-;; for all buffers, the associated *keymaps* can be different. In Viper,
-;; vip-vi-local-user-map, vip-insert-local-user-map, and others can have
-;; different keymaps for different buffers.
-;; Also, the keymaps associated with vip-vi/insert-state-modifier-minor-mode
-;; can be different.
-(make-variable-buffer-local 'minor-mode-map-alist)
-
-;; Mode for vital things like \e, C-z.
-(vip-deflocalvar vip-vi-intercept-minor-mode nil)
-
-(vip-deflocalvar vip-vi-basic-minor-mode nil
-  "Viper's minor mode for Vi bindings.")
-  
-(vip-deflocalvar vip-vi-local-user-minor-mode nil
-  "Auxiliary minor mode for user-defined local bindings in Vi state.")
-
-(vip-deflocalvar vip-vi-global-user-minor-mode nil
-  "Auxiliary minor mode for user-defined global bindings in Vi state.")
-
-(vip-deflocalvar vip-vi-state-modifier-minor-mode nil
-  "Minor mode used to make major-mode-specific modification to Vi state.")
-
-(vip-deflocalvar vip-vi-diehard-minor-mode nil
-  "This minor mode is in effect when the user wants Viper to be Vi.")
-
-(vip-deflocalvar vip-vi-kbd-minor-mode nil
-  "Minor mode for Ex command macros in Vi state.
-The corresponding keymap stores key bindings of Vi macros defined with
-the Ex command :map.")
-
-;; Mode for vital things like \e, C-z.
-(vip-deflocalvar vip-insert-intercept-minor-mode nil)
-
-(vip-deflocalvar vip-insert-basic-minor-mode nil
-  "Viper's minor mode for bindings in Insert mode.")
-
-(vip-deflocalvar vip-insert-local-user-minor-mode nil
-  "Auxiliary minor mode for buffer-local user-defined bindings in Insert state.
-This is a way to overshadow normal Insert mode bindings locally to certain
-designated buffers.")
-
-(vip-deflocalvar vip-insert-global-user-minor-mode nil
-  "Auxiliary minor mode for global user-defined bindings in Insert state.")
-
-(vip-deflocalvar vip-insert-state-modifier-minor-mode nil
-  "Minor mode used to make major-mode-specific modification to Insert state.")
-
-(vip-deflocalvar vip-insert-diehard-minor-mode nil
-  "Minor mode that simulates Vi very closely.
-Not recommened, except for the novice user.")
-
-(vip-deflocalvar vip-insert-kbd-minor-mode nil
-"Minor mode for Ex command macros Insert state.
-The corresponding keymap stores key bindings of Vi macros defined with
-the Ex command :map!.")
-
-(vip-deflocalvar vip-replace-minor-mode nil
-  "Minor mode in effect in replace state (cw, C, and the like commands).")
-
-;; Mode for vital things like \C-z and \C-x)
-;; This is t, by default. So, any new buffer will have C-z defined as
-;; switch to Vi, unless we switched states in this buffer
-(vip-deflocalvar vip-emacs-intercept-minor-mode t)
-  
-(vip-deflocalvar vip-emacs-local-user-minor-mode t
-  "Minor mode for local user bindings effective in Emacs state.
-Users can use it to override Emacs bindings when Viper is in its Emacs
-state.")  
-  
-(vip-deflocalvar vip-emacs-global-user-minor-mode t
-  "Minor mode for global user bindings in effect in Emacs state.
-Users can use it to override Emacs bindings when Viper is in its Emacs
-state.")  
-
-(vip-deflocalvar vip-emacs-kbd-minor-mode t
-  "Minor mode for Vi style macros in Emacs state.
-The corresponding keymap stores key bindings of Vi macros defined with
-`vip-record-kbd-macro' command. There is no Ex-level command to do this
-interactively.")
-
-(vip-deflocalvar vip-emacs-state-modifier-minor-mode t
-  "Minor mode used to make major-mode-specific modification to Emacs state.
-For instance, a Vi purist may want to bind `dd' in Dired mode to a function
-that deletes a file.")
-
-
-
-;;; ISO characters
-  
-(vip-deflocalvar vip-automatic-iso-accents nil
-  "*If non-nil, ISO accents will be turned on in insert/replace emacs states and turned off in vi-state. 
-For some users, this behavior may be too primitive. In this case, use
-insert/emacs/vi state hooks.")
-  
-  
-;;; Emacs keys in other states.  
-
-(defvar vip-want-emacs-keys-in-insert t
-  "*Set to nil if you want complete Vi compatibility in insert mode.
-Complete compatibility with Vi is not recommended for power use of Viper.")
-
-(defvar vip-want-emacs-keys-in-vi t
-  "*Set to nil if you want complete Vi compatibility in Vi mode.
-Full Vi compatibility is not recommended for power use of Viper.")
-
-
-
-;; VI-style Undo
-
-;; Used to 'undo' complex commands, such as replace and insert commands.
-(vip-deflocalvar vip-undo-needs-adjustment nil)
-(put 'vip-undo-needs-adjustment 'permanent-local t)
-
-;; A mark that Viper puts on buffer-undo-list.  Marks the beginning of a
-;; complex command that must be undone atomically. If inserted, it is
-;; erased by vip-change-state-to-vi and vip-repeat.
-(defconst vip-buffer-undo-list-mark 'viper)
-
-(defvar vip-keep-point-on-undo nil
-  "*Non-nil means not to move point while undoing commands.
-This style is different from Emacs and Vi. Try it to see if
-it better fits your working style.")  
-
-;; Replace mode and changing text
-
-;; Viper's own after/before change functions, which get vip-add-hook'ed to
-;; Emacs's
-(vip-deflocalvar vip-after-change-functions nil "")
-(vip-deflocalvar vip-before-change-functions nil "")
-(vip-deflocalvar vip-post-command-hooks nil "")
-(vip-deflocalvar vip-pre-command-hooks nil "")
-
-;; Can be used to pass global states around for short period of time
-(vip-deflocalvar vip-intermediate-command nil "")
-
-;; Indicates that the current destructive command has started in replace mode.
-(vip-deflocalvar vip-began-as-replace nil "")
-
-(defvar vip-replace-overlay-cursor-color "Red"
-  "*Cursor color to use in Replace state")
-(defvar vip-insert-state-cursor-color nil
-  "Cursor color for Viper insert state.")
-(put 'vip-insert-state-cursor-color 'permanent-local t)
-;; place to save cursor colow when switching to insert mode
-(vip-deflocalvar vip-saved-cursor-color nil "")
-  
-(vip-deflocalvar vip-replace-overlay nil "")
-(put 'vip-replace-overlay 'permanent-local t)
-
-(defvar vip-replace-overlay-pixmap "gray3"
-  "Pixmap to use for search face on non-color displays.")
-(defvar vip-search-face-pixmap "gray3"
-  "Pixmap to use for search face on non-color displays.")
-
-
-(defun vip-set-replace-overlay-face ()
-  (if (vip-has-face-support-p)
-      (defvar vip-replace-overlay-face
-	(progn
-	  (make-face 'vip-replace-overlay-face)
-	  (vip-hide-face 'vip-replace-overlay-face)
-	(or (face-differs-from-default-p 'vip-replace-overlay-face)
-	    (progn
-	      (if (vip-can-use-colors "darkseagreen2" "Black")
-		  (progn
-		    (set-face-background
-		     'vip-replace-overlay-face "darkseagreen2")
-		    (set-face-foreground 'vip-replace-overlay-face "Black")))
-	      (set-face-underline-p 'vip-replace-overlay-face t)
-	      (vip-set-face-pixmap
-	       'vip-replace-overlay-face vip-replace-overlay-pixmap)))
-	'vip-replace-overlay-face)
-	"*Face for highlighting replace regions on a window display.")
-    ))
-  
-(defvar vip-replace-region-end-delimiter "$"
-  "A string marking the end of replacement regions.
-It is used only with TTYs or if `vip-use-replace-region-delimiters'
-is non-nil.")
-(defvar vip-replace-region-start-delimiter ""
-  "A string marking the beginning of replacement regions.
-It is used only with TTYs or if `vip-use-replace-region-delimiters'
-is non-nil.")
-(defvar vip-use-replace-region-delimiters (not (vip-has-face-support-p))
-  "*If non-nil, Viper will always use `vip-replace-region-end-delimiter' and
-`vip-replace-region-start-delimiter' to delimit replacement regions, even on
-color displays. By default, the delimiters are used only on TTYs.")
-  
-;; XEmacs requires glyphs
-(if vip-xemacs-p
-    (progn
-      (or (glyphp vip-replace-region-end-delimiter)
-	  (setq vip-replace-region-end-delimiter
-		(make-glyph vip-replace-region-end-delimiter)))
-      (or (glyphp vip-replace-region-start-delimiter)
-	  (setq vip-replace-region-start-delimiter
-		(make-glyph vip-replace-region-start-delimiter)))
-      ))
-      
-  
-;; These are local marker that must be initialized to nil and moved with
-;; `vip-move-marker-locally'
-;;
-;; Remember the last position inside the replace region.
-(vip-deflocalvar vip-last-posn-in-replace-region nil)
-;; Remember the last position while inserting
-(vip-deflocalvar vip-last-posn-while-in-insert-state nil)
-(put 'vip-last-posn-in-replace-region 'permanent-local t)
-(put 'vip-last-posn-while-in-insert-state 'permanent-local t)
-
-(vip-deflocalvar vip-sitting-in-replace nil "")
-(put 'vip-sitting-in-replace 'permanent-local t)
-  
-;; Remember the number of characters that have to be deleted in replace
-;; mode to compensate for the inserted characters.
-(vip-deflocalvar vip-replace-chars-to-delete 0 "")
-(vip-deflocalvar vip-replace-chars-deleted 0 "")
-
-;; Insertion ring and command ring
-(defvar vip-insertion-ring-size 14
-  "The size of the insertion ring.")
-;; The insertion ring.
-(defvar vip-insertion-ring nil)
-;; This is temp insertion ring. Used to do rotation for display purposes.
-;; When rotation just started, it is initialized to vip-insertion-ring.
-(defvar vip-temp-insertion-ring nil)
-(defvar vip-last-inserted-string-from-insertion-ring "")
-
-(defvar vip-command-ring-size 14
-  "The size of the command ring.")
-;; The command ring.
-(defvar vip-command-ring nil)
-;; This is temp command ring. Used to do rotation for display purposes.
-;; When rotation just started, it is initialized to vip-command-ring.
-(defvar vip-temp-command-ring nil)
-
-;; Modes and related variables
-
-;; Current mode.  One of: `emacs-state', `vi-state', `insert-state'
-(vip-deflocalvar vip-current-state 'emacs-state)
-
-(defvar vip-no-multiple-ESC  t
-  "*If true, multiple ESC in Vi mode will cause bell to ring.
-This is set to t on a windowing terminal and to 'twice on a dumb
-terminal (unless the user level is 1, 2, or 5). On a dumb terminal, this
-enables cursor keys and is generally more convenient, as terminals usually
-don't have a convenient Meta key.
-Setting vip-no-multiple-ESC to nil will allow as many multiple ESC,
-as is allowed by the major mode in effect.") 
-
-
-(defvar vip-want-ctl-h-help nil
-  "*If t then C-h is bound to help-command in insert mode, if nil then it is
-bound to delete-backward-char.")
-
-;; Autoindent in insert
-
-;; Variable that keeps track of whether C-t has been pressed.
-(vip-deflocalvar vip-cted nil "")
-
-;; Preserve the indent value, used by C-d in insert mode.
-(vip-deflocalvar vip-current-indent 0)
-
-;; Whether to preserve the indent, used by C-d in insert mode.
-(vip-deflocalvar vip-preserve-indent nil)
-
-(vip-deflocalvar vip-auto-indent nil
-  "*Autoindent if t.")
-(vip-deflocalvar vip-electric-mode t
-  "*If t, enable electric behavior. 
-Currently only enables auto-indentation `according to mode'.")
-
-(defconst vip-shift-width 8
-  "*The shiftwidth variable.")
-
-;; Variables for repeating destructive commands
-
-(defconst vip-keep-point-on-repeat t
-  "*If t, don't move point when repeating previous command.
-This is useful for doing repeated changes with the '.' key.
-The user can change this to nil, if she likes when the cursor moves
-to a new place after repeating previous Vi command.") 
-
-;; Remember insert point as a marker.  This is a local marker that must be
-;; initialized to nil and moved with `vip-move-marker-locally'.
-(vip-deflocalvar vip-insert-point nil)
-(put 'vip-insert-point 'permanent-local t)
-
-;; This remembers the point before dabbrev-expand was called.
-;; If vip-insert-point turns out to be bigger than that, it is reset
-;; back to vip-pre-command-point.
-;; The reason this is needed is because dabbrev-expand (and possibly
-;; others) may jump to before the insertion point, delete something and
-;; then reinsert a bigger piece. For instance:  bla^blo
-;; If dabbrev-expand is called after `blo' and ^ undicates vip-insert-point,
-;; then point jumps to the beginning of `blo'. If expansion is found, `blablo'
-;; is deleted, and we have |^, where | denotes point. Next, dabbrev-expand
-;; will insert the expansion, and we get: blablo^
-;; Whatever we insert next goes before the ^, i.e., before the
-;; vip-insert-point marker. So, Viper will think that nothing was
-;; inserted. Remembering the orig position of the marker circumvents the
-;; problem.
-;; We don't know of any command, except dabbrev-expand, that has the same
-;; problem. However, the same trick can be used if such a command is
-;; discovered later.
-;;
-(vip-deflocalvar vip-pre-command-point nil)
-(put 'vip-pre-command-point 'permanent-local t) ; this is probably an overkill
-
-;; This is used for saving inserted text.
-(defvar vip-last-insertion  nil)
-  
-;; Remembers the last replaced region.
-(defvar vip-last-replace-region "")
-  
-;; Remember com point as a marker.
-;; This is a local marker. Should be moved with `vip-move-marker-locally'
-(vip-deflocalvar vip-com-point nil)
-
-;; If non-nil, the value is a list (M-COM VAL COM REG inserted-text cmd-keys)
-;; It is used to re-execute last destructive command.
-;; M-COM is a Lisp symbol representing the function to be executed.
-;; VAL is the prefix argument that was used with that command.
-;; COM is an internal descriptor, such as ?r, ?c, ?C, which contains
-;; additional information on how the function in M-COM is to be handled.
-;; REG is the register used by command
-;; INSERTED-TEXT is text inserted by that command (in case of o, c, C, i, r
-;; commands).
-;; COMMAND-KEYS are the keys that were typed to invoke the command.
-(defvar vip-d-com nil)
-
-;; The character remembered by the Vi `r' command.
-(defvar vip-d-char nil)
-
-;; Name of register to store deleted or yanked strings
-(defvar vip-use-register nil)
-
-
-
-;; Variables for Moves and Searches
-
-;; For use by `;' command.
-(defvar vip-f-char nil)
-
-;; For use by `.' command.
-(defvar vip-F-char nil)
-
-;; For use by `;' command.
-(defvar vip-f-forward nil)
-
-;; For use by `;' command.
-(defvar vip-f-offset nil)
-
-;; Last search string
-(defvar vip-s-string "")
-
-(defvar vip-quote-string "> "
-  "String inserted at the beginning of quoted region.")
-
-;; If t, search is forward.
-(defvar vip-s-forward nil)
-
-(defconst vip-case-fold-search nil
-  "*If not nil, search ignores cases.")
-
-(defconst vip-re-search t
-  "*If not nil, search is reg-exp search, otherwise vanilla search.")
-
-(defvar vip-adjust-window-after-search t
-  "*If not nil, pull the window up or down, depending on the direction of the
-search, if search ends up near the bottom or near the top of the window.")
-
-(defconst vip-re-query-replace t
-  "*If t then do regexp replace, if nil then do string replace.")
-
-(defconst vip-re-replace t
-  "*If t, do regexp replace. nil means do string replace.")
-
-(vip-deflocalvar vip-ex-style-motion t
-  "*Ex-style: the commands l,h do not cross lines, etc.")
-
-(vip-deflocalvar vip-ex-style-editing-in-insert t
-  "*The keys ^H, ^? don't jump lines in insert, ESC moves cursor back, etc.
-Note: this doesn't preclude ^H and ^? from deleting characters by moving
-past the insertion point. This is a feature, not a bug. ")
-
-(vip-deflocalvar vip-delete-backwards-in-replace nil
-  "*If t, DEL key will delete characters while moving the cursor backwards.
-If nil, the cursor will move backwards without deleting anything.")
-
-(defconst vip-buffer-search-char nil
-  "*Key bound for buffer-searching.")
-
-(defconst vip-search-wrap-around-t t
-  "*If t, search wraps around.")
-  
-(vip-deflocalvar vip-related-files-and-buffers-ring nil
-  "*Ring of file and buffer names that are considered to be related to the
-current buffer.
-These buffers can be cycled through via :R and :P commands.")
-(put 'vip-related-files-and-buffers-ring 'permanent-local t)
-
-;; Used to find out if we are done with searching the current buffer.
-(vip-deflocalvar vip-local-search-start-marker nil)
-;; As above, but global
-(defvar vip-search-start-marker (make-marker))
-
-;; the search overlay
-(vip-deflocalvar vip-search-overlay nil)
-
-
-(defvar vip-heading-start 
-  (concat "^\\s-*(\\s-*defun\\s-\\|"			        ; lisp
-	  "^{\\s-*$\\|^[_a-zA-Z][^()]*[()].*{\\s-*$\\|"	        ; C/C++
-	  "^\\s-*class.*{\\|^\\s-*struct.*{\\|^\\s-*enum.*{\\|"
-	  "^\\\\[sb][a-z]*{.*}\\s-*$\\|"	    		; latex
-	  "^@node\\|@table\\|^@m?enu\\|^@itemize\\|^@if\\|"	; texinfo
-	  "^.+:-")			                        ; prolog
-  "*Regexps for Headings. Used by \[\[ and \]\].")
-
-(defvar vip-heading-end 
-  (concat "^}\\|"						; C/C++
-	  "^\\\\end{\\|"					; latex
-	  "^@end \\|"						; texinfo
-	  ")\n\n[ \t\n]*\\|"					; lisp
-	  "\\.\\s-*$")						; prolog
-      "*Regexps to end Headings/Sections. Used by \[\].")
-
-
-;; These two vars control the interaction of jumps performed by ' and `.
-;; In this new version, '' doesn't erase the marks set by ``, so one can
-;; use both kinds of jumps interchangeably and without loosing positions
-;; inside the lines.
-
-;; Remembers position of the last jump done using ``'.
-(vip-deflocalvar vip-last-jump  nil)
-;; Remembers position of the last jump done using `''.
-(vip-deflocalvar vip-last-jump-ignore 0)
-
-;; Some common error messages
-
-(defconst vip-SpuriousText "Spurious text after command"  "")
-(defconst vip-BadExCommand "Not an editor command"   "")
-(defconst vip-InvalidCommandArgument "Invalid command argument"   "")
-(defconst vip-NoPrevSearch "No previous search string"   "")
-(defconst vip-EmptyRegister "`%c': Nothing in this register"   "")
-(defconst vip-InvalidRegister "`%c': Invalid register"   "")
-(defconst vip-EmptyTextmarker "`%c': Text marker doesn't point anywhere"   "")
-(defconst vip-InvalidTextmarker "`%c': Invalid text marker"   "")
-(defconst vip-InvalidViCommand "Invalid command"   "")
-(defconst vip-BadAddress "Ill-formed address"   "")
-(defconst vip-FirstAddrExceedsSecond "First address exceeds second"   "")
-(defconst vip-NoFileSpecified "No file specified"   "")
-
-
-;; History variables
-
-;; History of search strings.
-(defvar vip-search-history  (list ""))
-;; History of query-replace strings used as a source.
-(defvar vip-replace1-history nil)
-;; History of query-replace strings used as replacement.
-(defvar vip-replace2-history nil)
-;; History of region quoting strings.
-(defvar vip-quote-region-history (list vip-quote-string))
-;; History of Ex-style commands.
-(defvar vip-ex-history nil)
-;; History of shell commands.
-(defvar vip-shell-history nil)
-
-
-;; Last shell command. There are two of these, one for Ex (in viper-ex)
-;; and one for Vi.
-
-;; Last shell command executed with ! command.
-(defvar vip-last-shell-com nil)
-
-
-
-;;; Miscellaneous
-
-;; don't bark when mark is inactive
-(setq mark-even-if-inactive t)
-
-(defvar vip-inhibit-startup-message nil
-  "Whether Viper startup message should be inhibited.")
-
-(defvar vip-always t
-  "t means, arrange that vi-state will be a default.")
-
-(defvar vip-custom-file-name (vip-convert-standard-file-name "~/.vip")
-  "Viper customisation file.
-This variable must be set _before_ loading Viper.")
-
-
-(defvar vip-spell-function 'ispell-region
-  "Spell function used by #s<move> command to spell.")
-
-(defvar vip-tags-file-name "TAGS"
-  "The tags file used by Viper.")
-
-;; Minibuffer
-
-(defvar vip-vi-style-in-minibuffer t
-  "If t, use vi-style editing in minibuffer.
-Should be set in `~/.vip' file.")
-  
-;; overlay used in the minibuffer to indicate which state it is in
-(vip-deflocalvar vip-minibuffer-overlay nil)
-
-;; Hook, specific to Viper, which is run just *before* exiting the minibuffer.
-;; Beginning with Emacs 19.26, the standard `minibuffer-exit-hook' is run
-;; *after* exiting the minibuffer
-(defvar vip-minibuffer-exit-hook nil)
-
-(vip-deflocalvar vip-vi-minibuffer-minor-mode nil
-   "Minor mode that forces Vi-style when the Minibuffer is in Vi state.")
-(vip-deflocalvar vip-insert-minibuffer-minor-mode nil
-   "Minor mode that forces Vi-style when the Minibuffer is in Insert state.")
-  
-;; setup emacs-supported vi-style feel
-(setq next-line-add-newlines nil
-      require-final-newline t)
-
-(make-variable-buffer-local 'require-final-newline)
-       
-
-;; Mode line
-(defconst vip-vi-state-id  	"<V> "
-  "Mode line tag identifying the Vi mode of Viper.")
-(defconst vip-emacs-state-id	"<E> "
-  "Mode line tag identifying the Emacs mode of Viper.")
-(defconst vip-insert-state-id	"<I> "
-  "Mode line tag identifying the Insert mode of Viper.")
-(defconst vip-replace-state-id	"<R> "
-  "Mode line tag identifying the Replace mode of Viper.")
-
-;; Viper changes the default mode-line-buffer-identification
-(setq-default mode-line-buffer-identification '(" %b"))
-
-;; Variable displaying the current Viper state in the mode line.
-(vip-deflocalvar vip-mode-string vip-emacs-state-id)
-(or (memq 'vip-mode-string global-mode-string)
-    (setq global-mode-string
-	  (append '("" vip-mode-string) (cdr global-mode-string))))
-
-
-(defvar vip-vi-state-hook nil
-  "*Hooks run just before the switch to Vi mode is completed.")
-(defvar vip-insert-state-hook nil
-  "*Hooks run just before the switch to Insert mode is completed.")
-(defvar vip-replace-state-hook nil
-  "*Hooks run just before the switch to Replace mode is completed.")
-(defvar vip-emacs-state-hook nil
-  "*Hooks run just before the switch to Emacs mode is completed.")
-  
-(defvar vip-load-hook nil
-  "Hooks run just after loading Viper.")
-  
-
-;; Generic predicates
-
-;; These test functions are shamelessly lifted from vip 4.4.2 by Aamod Sane
-
-;; generate test functions
-;; given symbol foo, foo-p is the test function, foos is the set of
-;; Viper command keys
-;; (macroexpand '(vip-test-com-defun foo))
-;; (defun foo-p (com) (consp (memq (if (< com 0) (- com) com) foos)))
-
-(defmacro vip-test-com-defun (name)
-  (let* ((snm (symbol-name name))
-	 (nm-p (intern (concat snm "-p")))
-	 (nms (intern (concat snm "s"))))
-    (` (defun (, nm-p) (com) 
-	 (consp (memq (if (< com 0) (- com) com) (, nms)))))))
-  
-;; Variables for defining VI commands
-
-;; Modifying commands that can be prefixes to movement commands
-(defconst vip-prefix-commands '(?c ?d ?y ?! ?= ?# ?< ?> ?\"))
-(vip-test-com-defun vip-prefix-command)
-  
-;; Commands that are pairs eg. dd. r and R here are a hack
-(defconst vip-charpair-commands '(?c ?d ?y ?! ?= ?< ?> ?r ?R))
-(vip-test-com-defun vip-charpair-command)
-
-(defconst vip-movement-commands '(?b ?B ?e ?E ?f ?F ?G ?h ?H ?j ?k ?l
-				     ?H ?M ?n ?t ?T ?w ?W ?$ ?%
-				     ?^ ?( ?) ?- ?+ ?| ?{ ?} ?[ ?] ?' ?`
-				     ?; ?, ?0 ?? ?/
-				     )
-				     "Movement commands")
-(vip-test-com-defun vip-movement-command)
-
-;; Commands that can be repeated by . (dotted)
-(defconst vip-dotable-commands '(?c ?d ?C ?D ?> ?<))
-(vip-test-com-defun vip-dotable-command)
-
-;; Commands that can follow a #
-(defconst vip-hash-cmds '(?c ?C ?g ?q ?S))
-(vip-test-com-defun vip-hash-cmd)
-
-;; Commands that may have registers as prefix
-(defconst vip-regsuffix-commands '(?d ?y ?Y ?D ?p ?P ?x ?X))
-(vip-test-com-defun vip-regsuffix-command)
-
-(defconst vip-vi-commands (append vip-movement-commands
-				  vip-dotable-commands
-				  vip-charpair-commands
-				  vip-hash-cmds
-				  vip-prefix-commands
-				  vip-regsuffix-commands)
-  "The list of all commands in Vi-state.")
-(vip-test-com-defun vip-vi-command)
-
-
-;;; Arrange the keymaps
-(require 'viper-keym)
-
-
-;;; CODE
-
-;; sentinels
-
-;; Runs vip-after-change-functions inside after-change-functions
-(defun vip-after-change-sentinel (beg end len)
-  (let ((list vip-after-change-functions))
-    (while list
-      (funcall (car list) beg end len)
-      (setq list (cdr list)))))
-      
-;; Runs vip-before-change-functions inside before-change-functions
-(defun vip-before-change-sentinel (beg end)
-  (let ((list vip-before-change-functions))
-    (while list
-      (funcall (car list) beg end)
-      (setq list (cdr list)))))
-
-(defsubst vip-post-command-sentinel ()
-  (run-hooks 'vip-post-command-hooks))
-  
-(defsubst vip-pre-command-sentinel ()
-  (run-hooks 'vip-pre-command-hooks))
-  
-;; Needed so that Viper will be able to figure the last inserted
-;; chunk of text with reasonable accuracy.
-(defsubst vip-insert-state-post-command-sentinel ()
-  (if (and (memq vip-current-state '(insert-state replace-state))
-	   vip-insert-point
-	   (>= (point) vip-insert-point))
-      (setq vip-last-posn-while-in-insert-state (point-marker)))
-  (if (eq vip-current-state 'insert-state)
-      (progn
-	(or (stringp vip-saved-cursor-color)
-	    (string= (vip-get-cursor-color) vip-insert-state-cursor-color)
-	    (setq vip-saved-cursor-color (vip-get-cursor-color)))
-	(if (stringp vip-saved-cursor-color)
-	    (vip-change-cursor-color vip-insert-state-cursor-color))
-	))
-  (if (and (eq this-command 'dabbrev-expand)
-	   (integerp vip-pre-command-point)
-	   (> vip-insert-point vip-pre-command-point))
-      (move-marker vip-insert-point vip-pre-command-point))
-  )
-  
-(defsubst vip-insert-state-pre-command-sentinel ()
-  (or (memq this-command '(self-insert-command))
-      (memq (vip-event-key last-command-event)
-	    '(up down left right (meta f) (meta b)
-		 (control n) (control p) (control f) (control b)))
-      (vip-restore-cursor-color-after-insert))
-  (if (and (eq this-command 'dabbrev-expand)
-	   (markerp vip-insert-point)
-	   (marker-position vip-insert-point))
-      (setq vip-pre-command-point (marker-position vip-insert-point))))
-	
-(defsubst vip-R-state-post-command-sentinel ()
-  ;; Restoring cursor color is needed despite
-  ;; vip-replace-state-pre-command-sentinel: When you jump to another buffer in
-  ;; another frame, the pre-command hook won't change cursor color to default
-  ;; in that other frame.  So, if the second frame cursor was red and we set
-  ;; the point outside the replacement region, then the cursor color will
-  ;; remain red. Restoring the default, below, prevents this.
-  (if (and (<= (vip-replace-start) (point))
-	   (<=  (point) (vip-replace-end)))
-      (vip-change-cursor-color vip-replace-overlay-cursor-color)
-    (vip-restore-cursor-color-after-replace)
-    ))
-
-;; to speed up, don't change cursor color before self-insert
-;; and common move commands
-(defsubst vip-replace-state-pre-command-sentinel ()
-  (or (memq this-command '(self-insert-command))
-      (memq (vip-event-key last-command-event)
-	    '(up down left right (meta f) (meta b)
-		 (control n) (control p) (control f) (control b)))
-      (vip-restore-cursor-color-after-replace)))
-  
-(defun vip-replace-state-post-command-sentinel ()
-  ;; Restoring cursor color is needed despite
-  ;; vip-replace-state-pre-command-sentinel: When one jumps to another buffer
-  ;; in another frame, the pre-command hook won't change cursor color to
-  ;; default in that other frame.  So, if the second frame cursor was red and
-  ;; we set the point outside the replacement region, then the cursor color
-  ;; will remain red. Restoring the default, below, fixes this problem.
-  ;;
-  ;; We optimize for self-insert-command's here, since they either don't change
-  ;; cursor color or, if they terminate replace mode, the color will be changed
-  ;; in vip-finish-change
-  (or (memq this-command '(self-insert-command))
-      (vip-restore-cursor-color-after-replace))
-  (cond 
-   ((eq vip-current-state 'replace-state)
-    ;; delete characters to compensate for inserted chars.
-    (let ((replace-boundary (vip-replace-end)))
-      (save-excursion
-	(goto-char vip-last-posn-in-replace-region)
-	(delete-char vip-replace-chars-to-delete)
-	(setq vip-replace-chars-to-delete 0
-	      vip-replace-chars-deleted 0)
-	;; terminate replace mode if reached replace limit
-	(if (= vip-last-posn-in-replace-region 
-	       (vip-replace-end))
-	    (vip-finish-change vip-last-posn-in-replace-region)))
-      
-      (if (and (<= (vip-replace-start) (point))
-	       (<=  (point) replace-boundary))
-	  (progn
-	    ;; the state may have changed in vip-finish-change above
-	    (if (eq vip-current-state 'replace-state)
-		(vip-change-cursor-color vip-replace-overlay-cursor-color))
-	    (setq vip-last-posn-in-replace-region (point-marker))))
-      ))
-   
-   (t ;; terminate replace mode if changed Viper states.
-    (vip-finish-change vip-last-posn-in-replace-region))))
-
-
-;; changing mode
-
-;; Change state to NEW-STATE---either emacs-state, vi-state, or insert-state.
-(defun vip-change-state (new-state)
-  ;; Keep vip-post/pre-command-hooks fresh.
-  ;; We remove then add vip-post/pre-command-sentinel since it is very
-  ;; desirable that vip-pre-command-sentinel is the last hook and
-  ;; vip-post-command-sentinel is the first hook.
-  (remove-hook 'post-command-hook 'vip-post-command-sentinel)
-  (add-hook 'post-command-hook 'vip-post-command-sentinel)
-  (remove-hook 'pre-command-hook 'vip-pre-command-sentinel)
-  (add-hook 'pre-command-hook 'vip-pre-command-sentinel t)
-  ;; These hooks will be added back if switching to insert/replace mode
-  (vip-remove-hook 'vip-post-command-hooks
-		   'vip-insert-state-post-command-sentinel)
-  (vip-remove-hook 'vip-pre-command-hooks
-		   'vip-insert-state-pre-command-sentinel)
-  (cond ((eq new-state 'vi-state)
-	 (cond ((member vip-current-state '(insert-state replace-state))
-		    
-		;; move vip-last-posn-while-in-insert-state
-		;; This is a normal hook that is executed in insert/replace
-		;; states after each command. In Vi/Emacs state, it does
-		;; nothing. We need to execute it here to make sure that
-		;; the last posn was recorded when we hit ESC.
-		;; It may be left unrecorded if the last thing done in
-		;; insert/repl state was dabbrev-expansion or abbrev
-		;; expansion caused by hitting ESC
-		(vip-insert-state-post-command-sentinel)
-		
-		(condition-case conds
-		    (progn
-		      (vip-save-last-insertion
-		       vip-insert-point 
-		       vip-last-posn-while-in-insert-state)
-		      (if vip-began-as-replace
-			  (setq vip-began-as-replace nil)
-			;; repeat insert commands if numerical arg > 1
-			(save-excursion
-			  (vip-repeat-insert-command))))
-		  (error
-		   (vip-message-conditions conds)))
-		     
-		(if (> (length vip-last-insertion) 0)
-		    (vip-push-onto-ring vip-last-insertion
-					'vip-insertion-ring))
-		
-		(if vip-ex-style-editing-in-insert
-		    (or (bolp) (backward-char 1))))
-	       ))
-	 
-	;; insert or replace
-	((memq new-state '(insert-state replace-state))
-	 (if (memq vip-current-state '(emacs-state vi-state))
-	     (vip-move-marker-locally 'vip-insert-point (point)))
-	 (vip-move-marker-locally 'vip-last-posn-while-in-insert-state (point))
-	 (vip-add-hook 'vip-post-command-hooks
-		       'vip-insert-state-post-command-sentinel t)
-	 (vip-add-hook 'vip-pre-command-hooks
-		       'vip-insert-state-pre-command-sentinel t))
-	) ; outermost cond
-  
-  ;; Nothing needs to be done to switch to emacs mode! Just set some
-  ;; variables, which is already done in vip-change-state-to-emacs!
-
-  (setq vip-current-state new-state)
-  (vip-normalize-minor-mode-map-alist)
-  (vip-adjust-keys-for new-state)
-  (vip-set-mode-vars-for new-state)
-  (vip-refresh-mode-line)
-  )
-
-
-    
-(defun vip-adjust-keys-for (state)
-  "Make necessary adjustments to keymaps before entering STATE."
-  (cond ((memq state '(insert-state replace-state))
-	 (if vip-auto-indent
-	     (progn
-	       (define-key vip-insert-basic-map "\C-m" 'vip-autoindent)
-	       (if vip-want-emacs-keys-in-insert
-		   ;; expert
-		   (define-key vip-insert-basic-map "\C-j" nil)
-		 ;; novice
-		 (define-key vip-insert-basic-map "\C-j" 'vip-autoindent))))
-		    
-	 (setq vip-insert-diehard-minor-mode
-	       (not vip-want-emacs-keys-in-insert))
-		   
-	 (if vip-want-ctl-h-help
-	     (progn 
-	       (define-key vip-insert-basic-map [(control h)] 'help-command)
-	       (define-key vip-replace-map [(control h)] 'help-command))
-	   (define-key vip-insert-basic-map 
-	     [(control h)] 'vip-del-backward-char-in-insert)
-	   (define-key vip-replace-map
-	     [(control h)] 'vip-del-backward-char-in-replace)))
-		     
-	(t ; Vi state
-	 (setq vip-vi-diehard-minor-mode (not vip-want-emacs-keys-in-vi))
-	 (if vip-want-ctl-h-help
-	     (define-key vip-vi-basic-map [(control h)] 'help-command)
-	   (define-key vip-vi-basic-map [(control h)] 'vip-backward-char)))
-	))
-	     
-    
-;; Normalizes minor-mode-map-alist by putting Viper keymaps first.
-;; This ensures that Viper bindings are in effect, regardless of which minor
-;; modes were turned on by the user or by other packages.
-(defun vip-normalize-minor-mode-map-alist ()
-  (setq minor-mode-map-alist 
-	(vip-append-filter-alist
-	 (list
-	       (cons 'vip-vi-intercept-minor-mode vip-vi-intercept-map)
-	       (cons 'vip-vi-minibuffer-minor-mode vip-minibuffer-map) 
-	       (cons 'vip-vi-local-user-minor-mode vip-vi-local-user-map)
-	       (cons 'vip-vi-kbd-minor-mode vip-vi-kbd-map)
-	       (cons 'vip-vi-global-user-minor-mode vip-vi-global-user-map)
-	       (cons 'vip-vi-state-modifier-minor-mode
-		     (if (keymapp
-			  (cdr (assoc major-mode vip-vi-state-modifier-alist)))
-			 (cdr (assoc major-mode vip-vi-state-modifier-alist))
-		       vip-empty-keymap))
-	       (cons 'vip-vi-diehard-minor-mode  vip-vi-diehard-map)
-	       (cons 'vip-vi-basic-minor-mode     vip-vi-basic-map)
-	       (cons 'vip-insert-intercept-minor-mode vip-insert-intercept-map)
-	       (cons 'vip-replace-minor-mode  vip-replace-map)
-	       ;; vip-insert-minibuffer-minor-mode must come after
-	       ;; vip-replace-minor-mode 
-	       (cons 'vip-insert-minibuffer-minor-mode
-		     vip-minibuffer-map) 
-	       (cons 'vip-insert-local-user-minor-mode
-		     vip-insert-local-user-map)
-	       (cons 'vip-insert-kbd-minor-mode vip-insert-kbd-map)
-	       (cons 'vip-insert-global-user-minor-mode
-		     vip-insert-global-user-map)
-	       (cons 'vip-insert-state-modifier-minor-mode
-		     (if (keymapp
-			  (cdr
-			   (assoc major-mode vip-insert-state-modifier-alist)))
-			 (cdr
-			  (assoc major-mode vip-insert-state-modifier-alist))
-		       vip-empty-keymap))
-	       (cons 'vip-insert-diehard-minor-mode vip-insert-diehard-map)
-	       (cons 'vip-insert-basic-minor-mode vip-insert-basic-map)
-	       (cons 'vip-emacs-intercept-minor-mode
-		     vip-emacs-intercept-map)
-	       (cons 'vip-emacs-local-user-minor-mode
-		     vip-emacs-local-user-map)
-	       (cons 'vip-emacs-kbd-minor-mode vip-emacs-kbd-map)
-	       (cons 'vip-emacs-global-user-minor-mode
-		     vip-emacs-global-user-map)
-	       (cons 'vip-emacs-state-modifier-minor-mode
-		     (if (keymapp
-			  (cdr
-			   (assoc major-mode vip-emacs-state-modifier-alist)))
-			 (cdr
-			  (assoc major-mode vip-emacs-state-modifier-alist))
-		       vip-empty-keymap))
-	       )
-	 minor-mode-map-alist)))
-	 
- 
-
-
-
-;; Viper mode-changing commands and utilities
-
-;; Modifies mode-line-buffer-identification.
-(defun vip-refresh-mode-line ()
-  (setq vip-mode-string	
-	(cond ((eq vip-current-state 'emacs-state) vip-emacs-state-id)
-	      ((eq vip-current-state 'vi-state) vip-vi-state-id)
-	      ((eq vip-current-state 'replace-state) vip-replace-state-id)
-	      ((eq vip-current-state 'insert-state) vip-insert-state-id)))
-    
-  ;; Sets Viper mode string in global-mode-string
-  (force-mode-line-update))
-  
-;;;###autoload
-(defun viper-mode ()
-  "Turn on Viper emulation of Vi."
-  (interactive)
-  (if (not noninteractive)
-      (progn
-	(if vip-first-time ; This check is important. Without it, startup and 
-	    (progn	   ; expert-level msgs mix up when viper-mode recurses
-	      (setq vip-first-time nil)
-	      (if (not vip-inhibit-startup-message)
-		  (save-window-excursion
-		    (setq vip-inhibit-startup-message t)
-		    (delete-other-windows)
-		    (switch-to-buffer "Viper Startup Message")
-		    (erase-buffer)
-		    (insert
-		     (substitute-command-keys
-		      "Viper Is a Package for Emacs Rebels.
-It is also a VI Plan for Emacs Rescue and a venomous VI PERil.
-
-Technically speaking, Viper is a Vi emulation package for GNU Emacs 19 and
-XEmacs 19.  It supports virtually all of Vi and Ex functionality, extending
-and improving upon much of it.
-
-   1. Viper supports Vi at several levels. Level 1 is the closest to Vi,
-      level 5 provides the most flexibility to depart from many Vi conventions.
-      
-      You will be asked to specify your user level in a following screen.
-   
-      If you select user level 1 then the keys ^X, ^C, ^Z, and ^G will behave
-      as in VI, to smooth transition to Viper for the beginners. However, to
-      use Emacs productively, you are advised to reach user level 3 or higher. 
-      
-      If your user level is 2 or higher, ^X and ^C will invoke Emacs
-      functions,as usual in Emacs; ^Z will toggle vi/emacs modes, and 
-      ^G will be the usual Emacs's keyboard-quit (something like ^C in VI).
-   
-   2. Vi exit functions (e.g., :wq, ZZ) work on INDIVIDUAL files -- they
-      do not cause Emacs to quit, except at user level 1 (a novice).
-   3. ^X^C EXITS EMACS.
-   4. Viper supports multiple undo: `u' will undo. Typing `.' will repeat
-      undo. Another `u' changes direction.
-   
-   6. Emacs Meta functions are invoked by typing `C-\\' or `\\ ESC'.
-      On a window system, the best way is to use the Meta-key.
-   7. Try \\[keyboard-quit] and \\[abort-recursive-edit] repeatedly,if
-      something funny happens. This would abort the current editing command. 
-      
-You can get more information on Viper by:
-
-   a. Typing `:help' in Vi state
-   b. Printing Viper manual, found in ./etc/viper.dvi
-   c. Printing ViperCard, the Quick Reference, found in ./etc/viperCard.dvi
-    
-This startup message appears whenever you load Viper, unless you type `y' now."
-		      ))
-		    (goto-char (point-min))
-		    (if (y-or-n-p "Inhibit Viper startup message? ")
-			(vip-save-setting
-			 'vip-inhibit-startup-message
-			 "Viper startup message inhibited"
-			 vip-custom-file-name t))
-		    ;;(kill-buffer (current-buffer))
-		    (message
-		     "The last message is in buffer `Viper Startup Message'")
-		    (sit-for 4)
-		    ))
-	      (vip-set-expert-level 'dont-change-unless)))
-	(vip-change-state-to-vi))))
-	
-;;;###autoload
-(defalias 'vip-mode 'viper-mode)
-
-
-;; Switch from Insert state to Vi state.
-(defun vip-exit-insert-state ()
-  (interactive)
-  (vip-change-state-to-vi))
-
-(defun vip-set-mode-vars-for (state)
-  "Sets Viper minor mode variables to put Viper's state STATE in effect."
-  
-  ;; Emacs state
-  (setq vip-vi-minibuffer-minor-mode	   nil
-        vip-insert-minibuffer-minor-mode   nil
-	vip-vi-intercept-minor-mode	   nil
-	vip-insert-intercept-minor-mode	   nil
-	
-	vip-vi-local-user-minor-mode       nil
-	vip-vi-kbd-minor-mode        	   nil
-	vip-vi-global-user-minor-mode      nil
-	vip-vi-state-modifier-minor-mode   nil
-	vip-vi-diehard-minor-mode     	   nil
-        vip-vi-basic-minor-mode       	   nil
-	
-	vip-replace-minor-mode 	      	   nil
-	
-	vip-insert-local-user-minor-mode     nil
-	vip-insert-kbd-minor-mode     	     nil
-	vip-insert-global-user-minor-mode    nil
-	vip-insert-state-modifier-minor-mode nil
-	vip-insert-diehard-minor-mode 	     nil
-	vip-insert-basic-minor-mode   	     nil
-	vip-emacs-intercept-minor-mode       t
-	vip-emacs-local-user-minor-mode      t
-	vip-emacs-kbd-minor-mode             (not (vip-is-in-minibuffer))
-	vip-emacs-global-user-minor-mode     t
-	vip-emacs-state-modifier-minor-mode  t
-	)
-  
-  ;; Vi state
-  (if (eq state 'vi-state) ; adjust for vi-state
-      (setq 
-       vip-vi-intercept-minor-mode	   t 
-       vip-vi-minibuffer-minor-mode	   (vip-is-in-minibuffer)
-       vip-vi-local-user-minor-mode	   t
-       vip-vi-kbd-minor-mode        	   (not (vip-is-in-minibuffer))
-       vip-vi-global-user-minor-mode	   t
-       vip-vi-state-modifier-minor-mode    t
-       ;; don't let the diehard keymap block command completion 
-       ;; and other things in the minibuffer
-       vip-vi-diehard-minor-mode    	   (not
-					    (or vip-want-emacs-keys-in-vi
-						(vip-is-in-minibuffer)))
-       vip-vi-basic-minor-mode      	    t 
-       vip-emacs-intercept-minor-mode       nil
-       vip-emacs-local-user-minor-mode      nil
-       vip-emacs-kbd-minor-mode     	    nil
-       vip-emacs-global-user-minor-mode     nil
-       vip-emacs-state-modifier-minor-mode  nil
-       ))
-  
-  ;; Insert and Replace states
-  (if (member state '(insert-state replace-state))
-      (setq 
-       vip-insert-intercept-minor-mode	    t 
-       vip-replace-minor-mode	     	    (eq state 'replace-state)
-       vip-insert-minibuffer-minor-mode	    (vip-is-in-minibuffer)
-       vip-insert-local-user-minor-mode     t
-       vip-insert-kbd-minor-mode     	    (not (vip-is-in-minibuffer))
-       vip-insert-global-user-minor-mode    t
-       vip-insert-state-modifier-minor-mode  t
-       ;; don't let the diehard keymap block command completion 
-       ;; and other things in the minibuffer
-       vip-insert-diehard-minor-mode 	    (not
-					     (or vip-want-emacs-keys-in-insert
-						 (vip-is-in-minibuffer)))
-       vip-insert-basic-minor-mode   	    t
-       vip-emacs-intercept-minor-mode       nil
-       vip-emacs-local-user-minor-mode      nil
-       vip-emacs-kbd-minor-mode     	    nil
-       vip-emacs-global-user-minor-mode     nil
-       vip-emacs-state-modifier-minor-mode  nil
-       ))
-       
-  ;; minibuffer faces
-  (if (vip-has-face-support-p)
-      (setq vip-minibuffer-current-face
-	    (cond ((eq state 'emacs-state) vip-minibuffer-emacs-face)
-		  ((eq state 'vi-state) vip-minibuffer-vi-face)
-		  ((memq state '(insert-state replace-state))
-		   vip-minibuffer-insert-face))))
-  
-  (if (vip-is-in-minibuffer)
-      (vip-set-minibuffer-overlay))
-  )
-
-;; This also takes care of the annoying incomplete lines in files.
-;; Also, this fixes `undo' to work vi-style for complex commands.
-(defun vip-change-state-to-vi ()
-  "Change Viper state to Vi."
-  (interactive)
-  (if (and vip-first-time (not (vip-is-in-minibuffer)))
-      (viper-mode)
-    (if overwrite-mode (overwrite-mode nil))
-    (if abbrev-mode (expand-abbrev))
-    (if (and auto-fill-function (> (current-column) fill-column))
-	(funcall auto-fill-function))
-    ;; don't leave whitespace lines around
-    (if (and (memq last-command
-		   '(vip-autoindent
-		     vip-open-line vip-Open-line
-		     vip-replace-state-exit-cmd))
-	     (vip-over-whitespace-line))
-	(indent-to-left-margin))
-    (vip-add-newline-at-eob-if-necessary)
-    (if vip-undo-needs-adjustment  (vip-adjust-undo))
-    (vip-change-state 'vi-state)
-
-    ;; always turn off iso-accents-mode, or else we won't be able to use the
-    ;; keys `,',^ in Vi state, as they will do accents instead of Vi actions.
-    (if (and (boundp 'iso-accents-mode) iso-accents-mode)
-	(iso-accents-mode -1))
-
-    (vip-restore-cursor-color-after-insert)
-    
-    ;; Protection against user errors in hooks
-    (condition-case conds
-	(run-hooks 'vip-vi-state-hook)
-      (error
-       (vip-message-conditions conds)))))
-
-(defun vip-change-state-to-insert ()
-  "Change Viper state to Insert."
-  (interactive)
-  (vip-change-state 'insert-state)
-  (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode))
-      (iso-accents-mode 1)) ; turn iso accents on
-  
-  (or (stringp vip-saved-cursor-color)
-      (string= (vip-get-cursor-color) vip-insert-state-cursor-color)
-      (setq vip-saved-cursor-color (vip-get-cursor-color)))
-  ;; Commented out, because if vip-change-state-to-insert is executed
-  ;; non-interactively then the old cursor color may get lost. Same old Emacs
-  ;; bug related to local variables?
-;;;(if (stringp vip-saved-cursor-color)
-;;;      (vip-change-cursor-color vip-insert-state-cursor-color))
-  ;; Protection against user errors in hooks
-  (condition-case conds
-      (run-hooks 'vip-insert-state-hook)
-    (error
-     (vip-message-conditions conds))))
-     
-(defsubst vip-downgrade-to-insert ()
- (setq vip-current-state 'insert-state
-       vip-replace-minor-mode nil)
- )
-
-    
-  
-;; Change to replace state. When the end of replacement region is reached,
-;; replace state changes to insert state.
-(defun vip-change-state-to-replace (&optional non-R-cmd)
-  (vip-change-state 'replace-state)
-  (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode))
-      (iso-accents-mode 1)) ; turn iso accents on
-  ;; Run insert-state-hook
-  (condition-case conds
-      (run-hooks 'vip-insert-state-hook 'vip-replace-state-hook)
-    (error
-     (vip-message-conditions conds)))
-  
-  (if non-R-cmd
-      (vip-start-replace)
-    ;; 'R' is implemented using Emacs's overwrite-mode
-    (vip-start-R-mode))
-  )
-
-    
-(defun vip-change-state-to-emacs ()
-  "Change Viper state to Emacs."
-  (interactive)
-  (vip-change-state 'emacs-state)
-  (if (and vip-automatic-iso-accents (fboundp 'iso-accents-mode))
-      (iso-accents-mode 1)) ; turn iso accents on
-  
-  ;; Protection agains user errors in hooks
-  (condition-case conds
-      (run-hooks 'vip-emacs-state-hook)
-    (error
-     (vip-message-conditions conds))))
-  
-;; escape to emacs mode termporarily
-(defun vip-escape-to-emacs (arg &optional events)
-  "Escape to Emacs state from Vi state for one Emacs command.
-ARG is used as the prefix value for the executed command.  If
-EVENTS is a list of events, which become the beginning of the command."
-  (interactive "P")
-  (if (= last-command-char ?\\)
-      (message "Switched to EMACS state for the next command..."))
-  (vip-escape-to-state arg events 'emacs-state))
-  
-;; escape to Vi mode termporarily
-(defun vip-escape-to-vi (arg)
-  "Escape from Emacs state to Vi state for one Vi 1-character command.
-If the Vi command that the user types has a prefix argument, e.g., `d2w', then
-Vi's prefix argument will be used. Otherwise, the prefix argument passed to
-`vip-escape-to-vi' is used."
-  (interactive "P")
-  (message "Switched to VI state for the next command...")
-  (vip-escape-to-state arg nil 'vi-state))
-  
-;; Escape to STATE mode for one Emacs command.
-(defun vip-escape-to-state (arg events state)
-  ;;(let (com key prefix-arg)
-  (let (com key)
-    ;; this temporarily turns off Viper's minor mode keymaps
-    (vip-set-mode-vars-for state)
-    (vip-normalize-minor-mode-map-alist)
-    (if events (vip-set-unread-command-events events))
-    
-    ;; protect against keyboard quit and other errors
-    (condition-case nil
-	(let (vip-vi-kbd-minor-mode 
-	      vip-insert-kbd-minor-mode
-	      vip-emacs-kbd-minor-mode)
-	  (unwind-protect
-	      (progn
-		(setq com (key-binding (setq key 
-					     (if vip-xemacs-p
-						 (read-key-sequence nil)
-					       (read-key-sequence nil t)))))
-		;; In case of binding indirection--chase definitions.
-		;; Have to do it here because we execute this command under
-		;; different keymaps, so command-execute may not do the
-		;; right thing there
-		(while (vectorp com) (setq com (key-binding com))))
-	    nil)
-	  ;; Execute command com in the original Viper state, not in state
-	  ;; `state'. Otherwise, if we switch buffers while executing the
-	  ;; escaped to command, Viper's mode vars will remain those of
-	  ;; `state'. When we return to the orig buffer, the bindings will be
-	  ;; screwed up.
-	  (vip-set-mode-vars-for vip-current-state)
-	  
-	  ;; this-command, last-command-char, last-command-event
-	  (setq this-command com)
-	  (if vip-xemacs-p ; XEmacs represents key sequences as vectors
-	      (setq last-command-event (vip-seq-last-elt key)
-		    last-command-char (event-to-character last-command-event))
-	    ;; Emacs represents them as sequences (str or vec)
-	    (setq last-command-event (vip-seq-last-elt key)
-		  last-command-char last-command-event))
-	    
-	  (if (commandp com)
-	      (progn
-		(setq prefix-arg (or prefix-arg arg))
-		(command-execute com)))
-	  )
-      (quit (ding))
-      (error (beep 1))))
-  ;; set state in the new buffer
-  (vip-set-mode-vars-for vip-current-state))
-      
-(defun vip-exec-form-in-vi  (form)
-  "Execute FORM in Vi state, regardless of the Ccurrent Vi state."
-  (let ((buff (current-buffer))
-	result)
-    (vip-set-mode-vars-for 'vi-state)
-    (setq result (eval form))
-    (if (not (equal buff (current-buffer))) ; cmd switched buffer
-	(save-excursion
-	  (set-buffer buff)
-	  (vip-set-mode-vars-for vip-current-state)))
-    (vip-set-mode-vars-for vip-current-state)
-    result))
-
-(defun vip-exec-form-in-emacs  (form)
-  "Execute FORM in Emacs, temporarily disabling Viper's minor modes.
-Similar to vip-escape-to-emacs, but accepts forms rather than keystrokes."
-  (let ((buff (current-buffer))
-	result)
-    (vip-set-mode-vars-for 'emacs-state)
-    (setq result (eval form))
-    (if (not (equal buff (current-buffer))) ; cmd switched buffer
-	(save-excursion
-	  (set-buffer buff)
-	  (vip-set-mode-vars-for vip-current-state)))
-    (vip-set-mode-vars-for vip-current-state)
-    result))
-
-  
-;; This is needed because minor modes sometimes override essential Viper
-;; bindings. By letting Viper know which files these modes are in, it will
-;; arrange to reorganize minor-mode-map-alist so that things will work right.
-(defun vip-harness-minor-mode (load-file)
-  "Familiarize Viper with a minor mode defined in LOAD_FILE.
-Minor modes that have their own keymaps may overshadow Viper keymaps.
-This function is designed to make Viper aware of the packages that define
-such minor modes.
-Usage:
-    (vip-harness-minor-mode load-file)
-
-LOAD-FILE is a name of the file where the specific minor mode is defined.
-Suffixes such as .el or .elc should be stripped."
-
-  (interactive "sEnter name of the load file: ")
-  
-  (vip-eval-after-load load-file '(vip-normalize-minor-mode-map-alist))
-  
-  ;; Change the default for minor-mode-map-alist each time a harnessed minor
-  ;; mode adds its own keymap to the a-list.
-  (vip-eval-after-load
-   load-file '(setq-default minor-mode-map-alist minor-mode-map-alist))
-  )
-
-
-(defun vip-ESC (arg)
-  "Emulate ESC key in Emacs.
-Prevents multiple escape keystrokes if vip-no-multiple-ESC is true.
-If vip-no-multiple-ESC is 'twice double ESC would ding in vi-state.
-Other ESC sequences are emulated via the current Emacs's major mode
-keymap. This is more convenient on TTYs, since this won't block
-function keys such as up,down, etc. ESC will also will also work as
-a Meta key in this case. When vip-no-multiple-ESC is nil, ESC functions
-as a Meta key and any number of multiple escapes is allowed."
-  (interactive "P")
-  (let (char)
-    (cond ((and (not vip-no-multiple-ESC) (eq vip-current-state 'vi-state))
-	   (setq char (vip-read-char-exclusive))
-	   (vip-escape-to-emacs arg (list ?\e char) ))
-	  ((and (eq vip-no-multiple-ESC 'twice) 
-		(eq vip-current-state 'vi-state))
-	   (setq char (vip-read-char-exclusive))
-	   (if (= char (string-to-char vip-ESC-key))
-	       (ding)
-	     (vip-escape-to-emacs arg (list ?\e char) )))
-	  (t (ding)))
-    ))
-
-(defun vip-alternate-Meta-key (arg)
-  "Simulate Emacs Meta key."
-  (interactive "P")
-  (sit-for 1) (message "ESC-")
-  (vip-escape-to-emacs arg '(?\e)))
-
-(defun vip-toggle-key-action ()
-  "Action bound to `vip-toggle-key'."
-  (interactive)
-  (if (and (< vip-expert-level 2) (equal vip-toggle-key "\C-z"))
-      (if (vip-window-display-p)
-	  (vip-iconify)
-	(suspend-emacs))
-    (vip-change-state-to-emacs)))
-
-
-;; Intercept ESC sequences on dumb terminals.
-;; Based on the idea contributed by Marcelino Veiga Tuimil <mveiga@dit.upm.es>
-
-;; Check if last key was ESC and if so try to reread it as a function key.
-;; But only if there are characters to read during a very short time.
-;; Returns the last event, if any.
-(defun vip-envelop-ESC-key ()
-  (let ((event last-input-event)
-	(keyseq [nil])
-	inhibit-quit)
-    (if (vip-ESC-event-p event)
-	(progn 
-	  (if (vip-fast-keysequence-p)
-	      (progn
-		(let (minor-mode-map-alist)
-		  (vip-set-unread-command-events event)
-		  (setq keyseq
-			(funcall
-			 (ad-get-orig-definition 'read-key-sequence) nil))
-		  ) ; let
-		;; If keyseq translates into something that still has ESC
-		;; at the beginning, separate ESC from the rest of the seq.
-		;; In XEmacs we check for events that are keypress meta-key
-		;; and convert them into [escape key]
-		;;
-		;; This is needed for the following reason:
-		;; If ESC is the first symbol, we interpret it as if the
-		;; user typed ESC and then quickly some other symbols.
-		;; If ESC is not the first one, then the key sequence
-		;; entered was apparently translated into a function key or
-		;; something (e.g., one may have
-		;; (define-key function-key-map "\e[192z" [f11])
-		;; which would translate the escape-sequence generated by
-		;; f11 in an xterm window into the symbolic key f11.
-		;;
-		;; If `first-key' is not an ESC event, we make it into the
-		;; last-command-event in order to pretend that this key was
-		;; pressed. This is needed to allow arrow keys to be bound to
-		;; macros. Otherwise, vip-exec-mapped-kbd-macro will think that
-		;; the last event was ESC and so it'll execute whatever is
-		;; bound to ESC. (Viper macros can't be bound to
-		;; ESC-sequences).
-		(let* ((first-key (elt keyseq 0))
-		       (key-mod (event-modifiers first-key)))
-		  (cond ((vip-ESC-event-p first-key)
-			 ;; put keys following ESC on the unread list
-			 ;; and return ESC as the key-sequence
-			 (vip-set-unread-command-events (subseq keyseq 1))
-			 (setq last-input-event event
-			       keyseq (if vip-emacs-p
-					  "\e"
-					(vector (character-to-event ?\e)))))
-			((and vip-xemacs-p
-			      (key-press-event-p first-key)
-			      (equal '(meta) key-mod))
-			 (vip-set-unread-command-events 
-			  (vconcat (vector
-				    (character-to-event (event-key first-key)))
-				   (subseq keyseq 1)))
-			 (setq last-input-event event
-			       keyseq (vector (character-to-event ?\e))))
-			((eventp first-key)
-			 (setq last-command-event first-key))
-			))
-		) ; end progn
-		
-	    ;; this is escape event with nothing after it
-	    ;; put in unread-command-event and then re-read
-	    (vip-set-unread-command-events event)
-	    (setq keyseq
-		  (funcall (ad-get-orig-definition 'read-key-sequence) nil))
-	    ))
-      ;; not an escape event
-      (setq keyseq (vector event)))
-    keyseq))
-
-    
-    
-(defadvice read-key-sequence (around vip-read-keyseq-ad activate)
-  "Harness to work for Viper. This advice is harmless---don't worry!"
-  (let (inhibit-quit event keyseq)
-    (setq keyseq ad-do-it)
-    (setq event (if vip-xemacs-p
-		    (elt keyseq 0) ; XEmacs returns vector of events
-		  (elt (listify-key-sequence keyseq) 0)))
-    (if (vip-ESC-event-p event)
-	(let (unread-command-events)
-	  (vip-set-unread-command-events keyseq)
-	  (if (vip-fast-keysequence-p)
-	      (let ((vip-vi-global-user-minor-mode  nil)
-		    (vip-vi-local-user-minor-mode  nil)
-		    (vip-replace-minor-mode nil) ; actually unnecessary
-		    (vip-insert-global-user-minor-mode  nil)
-		    (vip-insert-local-user-minor-mode  nil))
-		(setq keyseq ad-do-it)) 
-	    (setq keyseq ad-do-it))))
-    keyseq))
-    
-(defadvice describe-key (before vip-read-keyseq-ad protect activate)
-  "Force to read key via `read-key-sequence'."
-  (interactive (list (vip-events-to-keys
-		      (read-key-sequence "Describe key: ")))))
-
-(defadvice describe-key-briefly (before vip-read-keyseq-ad protect activate)
-  "Force to read key via `read-key-sequence'."
-  (interactive (list (vip-events-to-keys
-		      (read-key-sequence "Describe key briefly: ")))))
-
-;; Listen to ESC key.
-;; If a sequence of keys starting with ESC is issued with very short delays,
-;; interpret these keys in Emacs mode, so ESC won't be interpreted as a Vi key.
-(defun vip-intercept-ESC-key ()
-  "Function that implements ESC key in Viper emulation of Vi."
-  (interactive)
-  (let ((cmd (or (key-binding (vip-envelop-ESC-key)) 
-		 '(lambda () (interactive) (error "")))))
-    
-    ;; call the actual function to execute ESC (if no other symbols followed)
-    ;; or the key bound to the ESC sequence (if the sequence was issued
-    ;; with very short delay between characters.
-    (if (eq cmd 'vip-intercept-ESC-key)
-	(setq cmd
-	      (cond ((eq vip-current-state 'vi-state)
-		     'vip-ESC)
-		    ((eq vip-current-state 'insert-state)
-		     'vip-exit-insert-state) 
-		    ((eq vip-current-state 'replace-state)
-		     'vip-replace-state-exit-cmd)
-		    (t 'vip-change-state-to-vi)
-		    )))
-    (call-interactively cmd)))
-	   
-
-
-;; prefix argument for Vi mode
-
-;; In Vi mode, prefix argument is a dotted pair (NUM . COM) where NUM
-;; represents the numeric value of the prefix argument and COM represents
-;; command prefix such as "c", "d", "m" and "y".
-
-;; Get value part of prefix-argument ARG.
-(defsubst vip-p-val (arg)
-  (cond ((null arg) 1)
-	((consp arg)
-	 (if (or (null (car arg)) (equal (car arg) '(nil)))
-	     1 (car arg)))
-	(t arg)))
-
-;; Get raw value part of prefix-argument ARG.
-(defsubst vip-P-val (arg)
-  (cond ((consp arg) (car arg))
-	(t arg)))
-
-;; Get com part of prefix-argument ARG.
-(defsubst vip-getcom (arg)
-  (cond ((null arg) nil)
-	((consp arg) (cdr arg))
-	(t nil)))
-
-;; Get com part of prefix-argument ARG and modify it.
-(defun vip-getCom (arg)
-  (let ((com (vip-getcom arg)))
-    (cond ((equal com ?c) ?C)
-	  ((equal com ?d) ?D)
-	  ((equal com ?y) ?Y)
-	  (t com))))
-
-
-;; Compute numeric prefix arg value. 
-;; Invoked by EVENT. COM is the command part obtained so far.
-(defun vip-prefix-arg-value (event com)
-  (let (value func)
-    ;; read while number
-    (while (and (vip-characterp event) (>= event ?0) (<= event ?9))
-      (setq value (+ (* (if (vip-characterp value) value 0) 10) (- event ?0)))
-      (setq event (vip-read-event-convert-to-char)))
-    
-    (setq prefix-arg value)
-    (if com (setq prefix-arg (cons prefix-arg com)))
-    (while (eq event ?U)
-      (vip-describe-arg prefix-arg)
-      (setq event (vip-read-event-convert-to-char)))
-    
-    (if (or com (and (not (eq vip-current-state 'vi-state))
-		     ;; make sure it is a Vi command
-		     (vip-characterp event) (vip-vi-command-p event)
-		     ))
-	;; If appears to be one of the vi commands,
-	;; then execute it with funcall and clear prefix-arg in order to not
-	;; confuse subsequent commands
-	(progn
-	  ;; last-command-char is the char we want emacs to think was typed
-	  ;; last. If com is not nil, the vip-digit-argument command was called
-	  ;; from within vip-prefix-arg command, such as `d', `w', etc., i.e., 
-	  ;; the user typed, say, d2. In this case, `com' would be `d', `w',
-	  ;; etc.
-	  ;; If vip-digit-argument was invoked by vip-escape-to-vi (which is
-	  ;; indicated by the fact that the current state is not vi-state,
-	  ;; then `event' represents the vi command to be executed (e.g., `d',
-	  ;; `w', etc. Again, last-command-char must make emacs believe that
-	  ;; this is the command we typed.
-	  (setq last-command-char (or com event))
-	  (setq func (vip-exec-form-in-vi 
-		      (` (key-binding (char-to-string (, event))))))
-	  (funcall func prefix-arg)
-	  (setq prefix-arg nil))
-      ;; some other command -- let emacs do it in its own way
-      (vip-set-unread-command-events event))
-    ))
-		     
-
-;; Vi operator as prefix argument."
-(defun vip-prefix-arg-com (char value com)
-  (let ((cont t)
-	cmd-info mv-or-digit-cmd)
-    (while (and cont
-		(memq char
-		      (list ?c ?d ?y ?! ?< ?> ?= ?# ?r ?R ?\"
-			    vip-buffer-search-char)))
-      (if com
-	  ;; this means that we already have a command character, so we
-	  ;; construct a com list and exit while.  however, if char is "
-	  ;; it is an error.
-	  (progn
-	    ;; new com is (CHAR . OLDCOM)
-	    (if (memq char '(?# ?\")) (error ""))
-	    (setq com (cons char com))
-	    (setq cont nil))
-	;; If com is nil we set com as char, and read more.  Again, if char
-	;; is ", we read the name of register and store it in vip-use-register.
-	;; if char is !, =, or #, a complete com is formed so we exit the
-	;; while loop.
-	(cond ((memq char '(?! ?=))
-	       (setq com char)
-	       (setq char (read-char))
-	       (setq cont nil))
-	      ((= char ?#)
-	       ;; read a char and encode it as com
-	       (setq com (+ 128 (read-char)))
-	       (setq char (read-char)))
-	      ((= char ?\")
-	       (let ((reg (read-char)))
-		 (if (vip-valid-register reg)
-		     (setq vip-use-register reg)
-		   (error ""))
-		 (setq char (read-char))))
-	      (t
-	       (setq com char)
-	       (setq char (vip-read-char-exclusive))))))
-
-  (if (atom com)
-      ;; `com' is a single char, so we construct the command argument
-      ;; and if `char' is `?', we describe the arg; otherwise 
-      ;; we prepare the command that will be executed at the end.
-      (progn
-	(setq cmd-info (cons value com))
-	(while (= char ?U)
-	  (vip-describe-arg cmd-info)
-	  (setq char (read-char)))
-	;; `char' is a movement command or a digit arg command---so we execute
-	;; it at the very end 
-	(setq mv-or-digit-cmd
-	      (vip-exec-form-in-vi 
-	       (` (key-binding (char-to-string (, char)))))))
-    
-    ;; as com is non-nil, this means that we have a command to execute
-    (if (memq (car com) '(?r ?R))
-	;; execute apropriate region command.
-	(let ((char (car com)) (com (cdr com)))
-	  (setq prefix-arg (cons value com))
-	  (if (= char ?r) (vip-region prefix-arg)
-	    (vip-Region prefix-arg))
-	  ;; reset prefix-arg
-	  (setq prefix-arg nil))
-      ;; otherwise, reset prefix arg and call appropriate command
-      (setq value (if (null value) 1 value))
-      (setq prefix-arg nil)
-      (cond ((equal com '(?c . ?c)) (vip-line (cons value ?C)))
-	    ((equal com '(?d . ?d)) (vip-line (cons value ?D)))
-	    ((equal com '(?d . ?y)) (vip-yank-defun))
-	    ((equal com '(?y . ?y)) (vip-line (cons value ?Y)))
-	    ((equal com '(?< . ?<)) (vip-line (cons value ?<)))
-	    ((equal com '(?> . ?>)) (vip-line (cons value ?>)))
-	    ((equal com '(?! . ?!)) (vip-line (cons value ?!)))
-	    ((equal com '(?= . ?=)) (vip-line (cons value ?=)))
-	    (t (error "")))))
-  
-  (if mv-or-digit-cmd
-      (progn
-	(setq last-command-char char)
-	(funcall mv-or-digit-cmd cmd-info)))
-  ))
-
-(defun vip-describe-arg (arg)
-  (let (val com)
-    (setq val (vip-P-val arg)
-	  com (vip-getcom arg))
-    (if (null val)
-	(if (null com)
-	    (message "Value is nil, and command is nil")
-	  (message "Value is nil, and command is `%c'" com))
-      (if (null com)
-	  (message "Value is `%d', and command is nil" val)
-	(message "Value is `%d', and command is `%c'" val com)))))
-
-(defun vip-digit-argument (arg)
-  "Begin numeric argument for the next command."
-  (interactive "P")
-  (vip-leave-region-active)
-  (vip-prefix-arg-value
-   last-command-char (if (consp arg) (cdr arg) nil)))
-
-(defun vip-command-argument (arg)
-  "Accept a motion command as an argument."
-  (interactive "P")
-  (condition-case nil
-      (vip-prefix-arg-com
-       last-command-char   
-       (cond ((null arg) nil)
-	     ((consp arg) (car arg))
-	     ((integerp arg) arg)
-	     (t (error vip-InvalidCommandArgument)))
-       (cond ((null arg) nil)
-	     ((consp arg) (cdr arg))
-	     ((integerp arg) nil)
-	     (t (error vip-InvalidCommandArgument))))
-    (quit (setq vip-use-register nil)
-	  (signal 'quit nil)))
-  (vip-deactivate-mark))
-
-
-;; repeat last destructive command
-
-;; Append region to text in register REG.
-;; START and END are buffer positions indicating what to append.
-(defsubst vip-append-to-register (reg start end)
-  (set-register reg (concat (if (stringp (get-register reg))
-				(get-register reg) "")
-			    (buffer-substring start end))))
-
-;; Saves last inserted text for possible use by vip-repeat command.
-(defun vip-save-last-insertion (beg end)
-  (setq vip-last-insertion (buffer-substring beg end))
-  (or (< (length vip-d-com) 5)
-      (setcar (nthcdr 4 vip-d-com) vip-last-insertion))
-  (or (null vip-command-ring)
-      (ring-empty-p vip-command-ring)
-      (progn
-	(setcar (nthcdr 4 (vip-current-ring-item vip-command-ring))
-		vip-last-insertion)
-	;; del most recent elt, if identical to the second most-recent
-	(vip-cleanup-ring vip-command-ring)))
-  )
-    
-(defsubst vip-yank-last-insertion ()
-  "Inserts the text saved by the previous vip-save-last-insertion command."
-  (condition-case nil
-      (insert vip-last-insertion)
-    (error nil)))
-  
-			    
-;; define functions to be executed
-
-;; invoked by the `C' command
-(defun vip-exec-change (m-com com) 
-  ;; handle C cmd at the eol and at eob.
-  (if (or (and (eolp) (= vip-com-point (point)))
-	  (= vip-com-point (point-max)))
-      (progn
-	(insert " ")(backward-char 1)))
-  (if (= vip-com-point (point))
-      (vip-forward-char-carefully))
-  (if (= com ?c)
-      (vip-change vip-com-point (point))
-    (vip-change-subr vip-com-point (point))))
-
-;; this is invoked by vip-substitute-line
-(defun vip-exec-Change (m-com com)
-  (save-excursion
-    (set-mark vip-com-point)
-    (vip-enlarge-region (mark t) (point))
-    (if vip-use-register
-	(progn
-	  (cond ((vip-valid-register vip-use-register '(letter digit))
-		 ;;(vip-valid-register vip-use-register '(letter)
-		 (copy-to-register
-		  vip-use-register (mark t) (point) nil))
-		((vip-valid-register vip-use-register '(Letter))
-		 (vip-append-to-register
-		  (downcase vip-use-register) (mark t) (point)))
-		(t (setq vip-use-register nil)
-		   (error vip-InvalidRegister vip-use-register)))
-	  (setq vip-use-register nil)))
-    (delete-region (mark t) (point)))
-  (open-line 1)
-  (if (= com ?C) (vip-change-mode-to-insert) (vip-yank-last-insertion)))
-
-(defun vip-exec-delete (m-com com)
-  (if vip-use-register
-      (progn
-	(cond ((vip-valid-register vip-use-register '(letter digit))
-	       ;;(vip-valid-register vip-use-register '(letter))
-	       (copy-to-register
-		vip-use-register vip-com-point (point) nil))
-	      ((vip-valid-register vip-use-register '(Letter))
-	       (vip-append-to-register
-		(downcase vip-use-register) vip-com-point (point)))
-	      (t (setq vip-use-register nil)
-		 (error vip-InvalidRegister vip-use-register)))
-	(setq vip-use-register nil)))
-  (setq last-command
-	(if (eq last-command 'd-command) 'kill-region nil))
-  (kill-region vip-com-point (point))
-  (setq this-command 'd-command)
-  (if vip-ex-style-motion
-      (if (and (eolp) (not (bolp))) (backward-char 1))))
-
-(defun vip-exec-Delete (m-com com)
-  (save-excursion
-    (set-mark vip-com-point)
-    (vip-enlarge-region (mark t) (point))
-    (if vip-use-register
-	(progn
-	  (cond ((vip-valid-register vip-use-register '(letter digit))
-		 ;;(vip-valid-register vip-use-register '(letter))
-		 (copy-to-register
-		  vip-use-register (mark t) (point) nil))
-		((vip-valid-register vip-use-register '(Letter))
-		 (vip-append-to-register
-		  (downcase vip-use-register) (mark t) (point)))
-		(t (setq vip-use-register nil)
-		   (error vip-InvalidRegister vip-use-register)))
-	  (setq vip-use-register nil)))
-    (setq last-command
-	  (if (eq last-command 'D-command) 'kill-region nil))
-    (kill-region (mark t) (point))
-    (if (eq m-com 'vip-line) (setq this-command 'D-command)))
-  (back-to-indentation))
-
-(defun vip-exec-yank (m-com com)
-  (if vip-use-register
-      (progn
-	(cond ((vip-valid-register vip-use-register '(letter digit))
-	       ;; (vip-valid-register vip-use-register '(letter))
-	       (copy-to-register
-		vip-use-register vip-com-point (point) nil))
-	      ((vip-valid-register vip-use-register '(Letter))
-	       (vip-append-to-register
-		(downcase vip-use-register) vip-com-point (point)))
-	      (t (setq vip-use-register nil)
-		 (error vip-InvalidRegister vip-use-register)))
-	(setq vip-use-register nil)))
-  (setq last-command nil)
-  (copy-region-as-kill vip-com-point (point))
-  (goto-char vip-com-point))
-
-(defun vip-exec-Yank (m-com com)
-  (save-excursion
-    (set-mark vip-com-point)
-    (vip-enlarge-region (mark t) (point))
-    (if vip-use-register
-	(progn
-	  (cond ((vip-valid-register vip-use-register '(letter digit))
-		 (copy-to-register
-		  vip-use-register (mark t) (point) nil))
-		((vip-valid-register vip-use-register '(Letter))
-		 (vip-append-to-register
-		  (downcase vip-use-register) (mark t) (point)))
-		(t (setq vip-use-register nil)
-		   (error vip-InvalidRegister  vip-use-register)))
-	  (setq vip-use-register nil)))
-    (setq last-command nil)
-    (copy-region-as-kill (mark t) (point)))
-  (vip-deactivate-mark)
-  (goto-char vip-com-point))
-
-(defun vip-exec-bang (m-com com)
-  (save-excursion
-    (set-mark vip-com-point)
-    (vip-enlarge-region (mark t) (point))
-    (shell-command-on-region
-     (mark t) (point)
-     (if (= com ?!)
-	 (setq vip-last-shell-com
-	       (vip-read-string-with-history 
-		"!"
-		nil
-		'vip-shell-history
-		(car vip-shell-history)
-		))
-       vip-last-shell-com)
-     t)))
-
-(defun vip-exec-equals (m-com com)
-  (save-excursion
-    (set-mark vip-com-point)
-    (vip-enlarge-region (mark t) (point))
-    (if (> (mark t) (point)) (exchange-point-and-mark))
-    (indent-region (mark t) (point) nil)))
-
-(defun vip-exec-shift (m-com com)
-  (save-excursion
-    (set-mark vip-com-point)
-    (vip-enlarge-region (mark t) (point))
-    (if (> (mark t) (point)) (exchange-point-and-mark))
-    (indent-rigidly (mark t) (point) 
-		    (if (= com ?>)
-			vip-shift-width
-		      (- vip-shift-width))))
-  ;; return point to where it was before shift
-  (goto-char vip-com-point))
-
-;; this is needed because some commands fake com by setting it to ?r, which
-;; denotes repeated insert command.
-(defsubst vip-exec-dummy (m-com com)
-  nil)
-
-(defun vip-exec-buffer-search (m-com com)
-  (setq vip-s-string (buffer-substring (point) vip-com-point))
-  (setq vip-s-forward t)
-  (setq vip-search-history (cons vip-s-string vip-search-history))
-  (vip-search vip-s-string vip-s-forward 1))
-
-(defvar vip-exec-array (make-vector 128 nil))
-
-;; Using a dispatch array allows adding functions like buffer search
-;; without affecting other functions. Buffer search can now be bound
-;; to any character.
-
-(aset vip-exec-array ?c 'vip-exec-change)
-(aset vip-exec-array ?C 'vip-exec-Change)
-(aset vip-exec-array ?d 'vip-exec-delete)
-(aset vip-exec-array ?D 'vip-exec-Delete)
-(aset vip-exec-array ?y 'vip-exec-yank)
-(aset vip-exec-array ?Y 'vip-exec-Yank)
-(aset vip-exec-array ?r 'vip-exec-dummy)
-(aset vip-exec-array ?! 'vip-exec-bang)
-(aset vip-exec-array ?< 'vip-exec-shift)
-(aset vip-exec-array ?> 'vip-exec-shift)
-(aset vip-exec-array ?= 'vip-exec-equals)
-
-
-
-;; This function is called by various movement commands to execute a
-;; destructive command on the region specified by the movement command. For
-;; instance, if the user types cw, then the command vip-forward-word will
-;; call vip-execute-com to execute vip-exec-change, which eventually will
-;; call vip-change to invoke the replace mode on the region.
-;;
-;; The list (M-COM VAL COM REG INSETED-TEXT COMMAND-KEYS) is set to
-;; vip-d-com for later use by vip-repeat.
-(defun vip-execute-com (m-com val com)
-  (let ((reg vip-use-register))
-    ;; this is the special command `#'
-    (if (> com 128)
-	(vip-special-prefix-com (- com 128))
-      (let ((fn (aref vip-exec-array (if (< com 0) (- com) com))))
-	(if (null fn)
-	    (error "%c: %s" com vip-InvalidViCommand)
-	  (funcall fn m-com com))))
-    (if (vip-dotable-command-p com)
-	(vip-set-destructive-command
-	 (list m-com val
-	       (if (memq com (list ?c ?C ?!)) (- com) com)
-	       reg nil nil)))
-    ))
-
-
-(defun vip-repeat (arg)
-  "Re-execute last destructive command.
-Use the info in vip-d-com, which has the form
-\(com val ch reg inserted-text command-keys\),
-where `com' is the command to be re-executed, `val' is the
-argument to `com', `ch' is a flag for repeat, and `reg' is optional;
-if it exists, it is the name of the register for `com'.
-If the prefix argument, ARG, is non-nil, it is used instead of `val'."
-  (interactive "P")
-  (let ((save-point (point)) ; save point before repeating prev cmd
-	;; Pass along that we are repeating a destructive command
-	;; This tells vip-set-destructive-command not to update
-	;; vip-command-ring
-	(vip-intermediate-command 'vip-repeat))
-    (if (eq last-command 'vip-undo)
-	;; if the last command was vip-undo, then undo-more
-	(vip-undo-more)
-      ;; otherwise execute the command stored in vip-d-com.  if arg is non-nil
-      ;; its prefix value is used as new prefix value for the command.
-      (let ((m-com (car vip-d-com))
-	    (val (vip-P-val arg))
-	    (com (nth 2 vip-d-com))
-	    (reg (nth 3 vip-d-com)))
-        (if (null val) (setq val (nth 1 vip-d-com)))
-        (if (null m-com) (error "No previous command to repeat."))
-        (setq vip-use-register reg)
-	(if (nth 4 vip-d-com) ; text inserted by command
-	    (setq vip-last-insertion (nth 4 vip-d-com)
-		  vip-d-char (nth 4 vip-d-com)))
-        (funcall m-com (cons val com))
-        (if (and vip-keep-point-on-repeat (< save-point (point)))
-	    (goto-char save-point)) ; go back to before repeat.
-	(if (and (eolp) (not (bolp)))
-	    (backward-char 1))
-     ))
-  (if vip-undo-needs-adjustment (vip-adjust-undo)) ; take care of undo
-  ;; If the prev cmd was rotating the command ring, this means that `.' has
-  ;; just executed a command from that ring. So, push it on the ring again.
-  ;; If we are just executing previous command , then don't push vip-d-com
-  ;; because vip-d-com is not fully constructed in this case (its keys and
-  ;; the inserted text may be nil). Besides, in this case, the command
-  ;; executed by `.' is already on the ring.
-  (if (eq last-command 'vip-display-current-destructive-command)
-      (vip-push-onto-ring vip-d-com 'vip-command-ring))
-  (vip-deactivate-mark)
-  ))
-  
-(defun vip-repeat-from-history ()
-  "Repeat a destructive command from history.
-Doesn't change vip-command-ring in any way, so `.' will work as before
-executing this command.
-This command is supposed to be bound to a two-character Vi macro where
-the second character is a digit 0 to 9. The digit indicates which
-history command to execute. `<char>0' is equivalent to `.', `<char>1'
-invokes the command before that, etc."
-  (interactive)
-  (let* ((vip-intermediate-command 'repeating-display-destructive-command)
-	 (idx (cond (vip-this-kbd-macro
-		      (string-to-number
-		       (symbol-name (elt vip-this-kbd-macro 1))))
-		    (t 0)))
-	 (num idx)
-	 (vip-d-com vip-d-com))
-
-    (or (and (numberp num) (<= 0 num) (<= num 9))
-	(progn
-	  (setq idx 0
-		num 0)
-	  (message
-	   "`vip-repeat-from-history' must be invoked as a Vi macro bound to `<key><digit>'")))
-    (while (< 0 num)
-      (setq vip-d-com (vip-special-ring-rotate1 vip-command-ring -1))
-      (setq num (1- num)))
-    (vip-repeat nil)
-    (while (> idx num)
-      (vip-special-ring-rotate1 vip-command-ring 1)
-      (setq num (1+ num)))
-    ))
-      
-
-;; This command is invoked interactively by the key sequence #<char>
-(defun vip-special-prefix-com (char)
-  (cond ((= char ?c)
-	 (downcase-region (min vip-com-point (point))
-			  (max vip-com-point (point))))
-	((= char ?C)
-	 (upcase-region (min vip-com-point (point))
-			(max vip-com-point (point))))
-	((= char ?g)
-	 (push-mark vip-com-point t)
-	 (vip-global-execute))
-	((= char ?q)
-	 (push-mark vip-com-point t)
-	 (vip-quote-region))
-	((= char ?s) (funcall vip-spell-function vip-com-point (point)))
-	(t (error "#%c: %s" char vip-InvalidViCommand))))
-
-
-;; undoing
-
-(defun vip-undo ()
-  "Undo previous change."
-  (interactive)
-  (message "undo!")
-  (let ((modified (buffer-modified-p))
-        (before-undo-pt (point-marker))
-	(after-change-functions after-change-functions)
-	undo-beg-posn undo-end-posn)
-	
-    ;; no need to remove this hook, since this var has scope inside a let.
-    (add-hook 'after-change-functions
-	      '(lambda (beg end len)
-		 (setq undo-beg-posn beg
-		       undo-end-posn (or end beg))))
-  
-    (undo-start)
-    (undo-more 2)
-    (setq undo-beg-posn (or undo-beg-posn before-undo-pt)
-	  undo-end-posn (or undo-end-posn undo-beg-posn))
-    
-    (goto-char undo-beg-posn)
-    (sit-for 0)
-    (if (and vip-keep-point-on-undo
-	     (pos-visible-in-window-p before-undo-pt))
-	(progn
-	  (push-mark (point-marker) t) 
-	  (vip-sit-for-short 300)
-	  (goto-char undo-end-posn)
-	  (vip-sit-for-short 300)
-	  (if (and (> (abs (- undo-beg-posn before-undo-pt)) 1)
-		  (> (abs (- undo-end-posn before-undo-pt)) 1))
-	      (goto-char before-undo-pt)
-	    (goto-char undo-beg-posn)))
-      (push-mark before-undo-pt t))
-    (if (and (eolp) (not (bolp))) (backward-char 1))
-    (if (not modified) (set-buffer-modified-p t)))
-  (setq this-command 'vip-undo))
-
-;; Continue undoing previous changes.
-(defun vip-undo-more ()
-  (message "undo more!")
-  (condition-case nil
-      (undo-more 1)
-    (error (beep)
-	   (message "No further undo information in this buffer")))
-  (if (and (eolp) (not (bolp))) (backward-char 1))
-  (setq this-command 'vip-undo))
-
-;; The following two functions are used to set up undo properly.
-;; In VI, unlike Emacs, if you open a line, say, and add a bunch of lines,
-;; they are undone all at once.  
-(defun vip-adjust-undo ()
-  (let ((inhibit-quit t)
-	tmp tmp2)
-    (setq vip-undo-needs-adjustment nil)
-    (if (listp buffer-undo-list)
-	(if (setq tmp (memq vip-buffer-undo-list-mark buffer-undo-list))
-	    (progn
-	      (setq tmp2 (cdr tmp)) ; the part after mark
-	      
-	      ;; cut tail from buffer-undo-list temporarily by direct
-	      ;; manipulation with pointers in buffer-undo-list
-	      (setcdr tmp nil)
-	      
-	      (setq buffer-undo-list (delq nil buffer-undo-list))
-	      (setq buffer-undo-list
-		    (delq vip-buffer-undo-list-mark buffer-undo-list))
-	      ;; restore tail of buffer-undo-list
-	      (setq buffer-undo-list (nconc buffer-undo-list tmp2)))
-	  (setq buffer-undo-list (delq nil buffer-undo-list))))))
-  
-
-(defun vip-set-complex-command-for-undo ()  
-  (if (listp buffer-undo-list)
-      (if (not vip-undo-needs-adjustment)
-	  (let ((inhibit-quit t))
-	    (setq buffer-undo-list 
-		  (cons vip-buffer-undo-list-mark buffer-undo-list))
-	    (setq vip-undo-needs-adjustment t)))))
-
-
-
-      
-(defun vip-display-current-destructive-command ()
-  (let ((text (nth 4 vip-d-com))
-	(keys (nth 5 vip-d-com))
-	(max-text-len 30))
-    
-    (setq this-command 'vip-display-current-destructive-command)
-	
-    (message " `.' runs  %s%s"
-	     (concat "`" (vip-array-to-string keys) "'")
-	     (vip-abbreviate-string text max-text-len
-				    "  inserting  `" "'" "    ......."))
-    ))
-    
-    
-;; don't change vip-d-com if it was vip-repeat command invoked with `.'
-;; or in some other way (non-interactively).
-(defun vip-set-destructive-command (list)
-  (or (eq vip-intermediate-command 'vip-repeat)
-      (progn
-	(setq vip-d-com list)
-	(setcar (nthcdr 5 vip-d-com)
-		(vip-array-to-string (this-command-keys)))
-	(vip-push-onto-ring vip-d-com 'vip-command-ring))))
-    
-(defun vip-prev-destructive-command (next)
-  "Find previous destructive command in the history of destructive commands.
-With prefix argument, find next destructive command."
-  (interactive "P")
-  (let (cmd vip-intermediate-command)
-    (if (eq last-command 'vip-display-current-destructive-command)
-	;; repeated search through command history
-	(setq vip-intermediate-command 'repeating-display-destructive-command)
-      ;; first search through command history--set temp ring
-      (setq vip-temp-command-ring (copy-list vip-command-ring))) 
-    (setq cmd (if next
-		  (vip-special-ring-rotate1 vip-temp-command-ring 1)
-		(vip-special-ring-rotate1 vip-temp-command-ring -1)))
-    (if (null cmd)
-	()
-      (setq vip-d-com cmd))
-    (vip-display-current-destructive-command)))
-      
-(defun vip-next-destructive-command ()
-  "Find next destructive command in the history of destructive commands."
-  (interactive)
-  (vip-prev-destructive-command 'next))
-  
-(defun vip-insert-prev-from-insertion-ring (arg)
-  "Cycle through insertion ring in the direction of older insertions.
-Undoes previous insertion and inserts new.
-With prefix argument, cycles in the direction of newer elements.
-In minibuffer, this command executes whatever the invocation key is bound
-to in the global map, instead of cycling through the insertion ring."
-  (interactive "P")
-  (let (vip-intermediate-command)
-    (if (eq last-command 'vip-insert-from-insertion-ring)
-	(progn  ; repeated search through insertion history
-	  (setq vip-intermediate-command 'repeating-insertion-from-ring)
-	  (if (eq vip-current-state 'replace-state)
-	      (undo 1)
-	    (if vip-last-inserted-string-from-insertion-ring
-		(backward-delete-char
-		 (length vip-last-inserted-string-from-insertion-ring))))
-	  )
-      ;;first search through insertion history
-      (setq vip-temp-insertion-ring (copy-list vip-insertion-ring)))
-    (setq this-command 'vip-insert-from-insertion-ring)
-    ;; so that things will be undone properly
-    (setq buffer-undo-list (cons nil buffer-undo-list))
-    (setq vip-last-inserted-string-from-insertion-ring
-	  (vip-special-ring-rotate1 vip-temp-insertion-ring (if arg 1 -1)))
-    
-    ;; this change of vip-intermediate-command must come after
-    ;; vip-special-ring-rotate1, so that the ring will rotate, but before the
-    ;; insertion.
-    (setq vip-intermediate-command nil)
-    (if vip-last-inserted-string-from-insertion-ring
-	(insert vip-last-inserted-string-from-insertion-ring))
-    ))
-
-(defun vip-insert-next-from-insertion-ring ()
-  "Cycle through insertion ring in the direction of older insertions.
-Undo previous insertion and inserts new."
-  (interactive)
-  (vip-insert-prev-from-insertion-ring 'next))
-    
-
-;; some region utilities
-
-;; If at the last line of buffer, add \\n before eob, if newline is missing.
-(defun vip-add-newline-at-eob-if-necessary ()
-  (save-excursion
-      (end-of-line)
-      ;; make sure all lines end with newline, unless in the minibuffer or
-      ;; when requested otherwise (require-final-newline is nil)
-      (if (and (eobp)
-	       (not (bolp))
-	       require-final-newline
-	       (not (vip-is-in-minibuffer))
-	       (not buffer-read-only))
-	  (insert "\n"))))
-
-(defun vip-yank-defun ()
-  (mark-defun)
-  (copy-region-as-kill (point) (mark t)))
-
-;; Enlarge region between BEG and END.
-(defun vip-enlarge-region (beg end)
-  (or beg (setq beg end)) ; if beg is nil, set to end
-  (or end (setq end beg)) ; if end is nil, set to beg
-  
-  (if (< beg end)
-      (progn (goto-char beg) (set-mark end))
-    (goto-char end)
-    (set-mark beg))
-  (beginning-of-line)
-  (exchange-point-and-mark)
-  (if (or (not (eobp)) (not (bolp))) (forward-line 1))
-  (if (not (eobp)) (beginning-of-line))
-  (if (> beg end) (exchange-point-and-mark)))
-
-
-;; Quote region by each line with a user supplied string.
-(defun vip-quote-region ()
-  (setq vip-quote-string
-	(vip-read-string-with-history
-	 "Quote string: "
-	 nil
-	 'vip-quote-region-history
-	 vip-quote-string))
-  (vip-enlarge-region (point) (mark t))
-  (if (> (point) (mark t)) (exchange-point-and-mark))
-  (insert vip-quote-string)
-  (beginning-of-line)
-  (forward-line 1)
-  (while (and (< (point) (mark t)) (bolp))
-    (insert vip-quote-string)
-    (beginning-of-line)
-    (forward-line 1)))
-
-;;  Tells whether BEG is on the same line as END.
-;;  If one of the args is nil, it'll return nil.
-(defun vip-same-line (beg end)
-   (let ((selective-display nil)
-	 (incr 0)
-	 temp)
-     (if (and beg end (> beg end))
-	 (setq temp beg
-	       beg end
-	       end temp))
-     (if (and beg end)
-	 (cond ((or (> beg (point-max)) (> end (point-max))) ; out of range
-		nil)
-	       (t
-		;; This 'if' is needed because Emacs treats the next empty line
-		;; as part of the previous line.
-		(if (= (vip-line-pos 'start) end)
-		    (setq incr 1))
-		(<= (+ incr (count-lines beg end)) 1))))
-     ))
-	 
-	 
-;; Check if the string ends with a newline.
-(defun vip-end-with-a-newline-p (string)
-  (or (string= string "")
-      (= (vip-seq-last-elt string) ?\n)))
-
-(defun vip-tmp-insert-at-eob (msg)
-  (let ((savemax (point-max)))
-      (goto-char savemax)
-      (insert msg)
-      (sit-for 2)
-      (goto-char savemax) (delete-region (point) (point-max))
-      ))  
-      
-
-
-;;; Minibuffer business
-	    
-(defsubst vip-set-minibuffer-style ()
-  (add-hook 'minibuffer-setup-hook 'vip-minibuffer-setup-sentinel))
-  
-  
-(defun vip-minibuffer-setup-sentinel ()
-  (let ((hook (if vip-vi-style-in-minibuffer
-		  'vip-change-state-to-insert
-		'vip-change-state-to-emacs)))
-    (funcall hook)
-    ))
-  
-;; Interpret last event in the local map
-(defun vip-exit-minibuffer ()
-  (interactive)
-  (let (command)
-    (setq command (local-key-binding (char-to-string last-command-char)))
-    (if command
-	(command-execute command)
-      (exit-minibuffer))))
-  
-
-(defun vip-set-search-face ()
-  (if (vip-has-face-support-p)
-      (defvar vip-search-face
-	(progn
-	  (make-face 'vip-search-face)
-	  (vip-hide-face 'vip-search-face)
-	  (or (face-differs-from-default-p 'vip-search-face)
-	      ;; face wasn't set in .vip or .Xdefaults
-	      (if (vip-can-use-colors "Black" "khaki")
-		  (progn
-		    (set-face-background 'vip-search-face "khaki")
-		    (set-face-foreground 'vip-search-face "Black"))
-		(set-face-underline-p 'vip-search-face t)
-		(vip-set-face-pixmap 'vip-search-face vip-search-face-pixmap)))
-	  'vip-search-face)
-        "*Face used to flash out the search pattern.")
-    ))
-  
-  
-(defun vip-set-minibuffer-faces ()
-  (if (not (vip-has-face-support-p))
-      ()
-    (defvar vip-minibuffer-emacs-face
-      (progn
-	(make-face 'vip-minibuffer-emacs-face)
-	(vip-hide-face 'vip-minibuffer-emacs-face)
-	(or (face-differs-from-default-p 'vip-minibuffer-emacs-face)
-	    ;; face wasn't set in .vip or .Xdefaults
-	    (if vip-vi-style-in-minibuffer
-		;; emacs state is an exception in the minibuffer
-		(if (vip-can-use-colors "darkseagreen2" "Black")
-		    (progn
-		      (set-face-background
-		       'vip-minibuffer-emacs-face "darkseagreen2")
-		      (set-face-foreground
-		       'vip-minibuffer-emacs-face "Black"))
-		  (copy-face 'modeline 'vip-minibuffer-emacs-face))
-	      ;; emacs state is the main state in the minibuffer
-	      (if (vip-can-use-colors "Black" "pink")
-		  (progn
-		    (set-face-background 'vip-minibuffer-emacs-face "pink") 
-		    (set-face-foreground
-		     'vip-minibuffer-emacs-face "Black"))
-		(copy-face 'italic 'vip-minibuffer-emacs-face))
-	      ))
-	'vip-minibuffer-emacs-face)
-      "Face used in the Minibuffer when it is in Emacs state.")
-    
-    (defvar vip-minibuffer-insert-face
-      (progn
-	(make-face 'vip-minibuffer-insert-face)
-	(vip-hide-face 'vip-minibuffer-insert-face)
-	(or (face-differs-from-default-p 'vip-minibuffer-insert-face)
-	    (if vip-vi-style-in-minibuffer
-		(if (vip-can-use-colors "Black" "pink")
-		    (progn
-		      (set-face-background 'vip-minibuffer-insert-face "pink") 
-		      (set-face-foreground
-		       'vip-minibuffer-insert-face "Black"))
-		  (copy-face 'italic 'vip-minibuffer-insert-face))
-	      ;; If Insert state is an exception
-	      (if (vip-can-use-colors "darkseagreen2" "Black")
-		  (progn
-		    (set-face-background
-		     'vip-minibuffer-insert-face "darkseagreen2")
-		    (set-face-foreground
-		     'vip-minibuffer-insert-face "Black"))
-		(copy-face 'modeline 'vip-minibuffer-insert-face))
-	      (vip-italicize-face 'vip-minibuffer-insert-face)))
-	'vip-minibuffer-insert-face)
-      "Face used in the Minibuffer when it is in Insert state.")
-    
-    (defvar vip-minibuffer-vi-face
-      (progn
-	(make-face 'vip-minibuffer-vi-face)
-	(vip-hide-face 'vip-minibuffer-vi-face)
-	(or (face-differs-from-default-p 'vip-minibuffer-vi-face)
-	    (if vip-vi-style-in-minibuffer
-		(if (vip-can-use-colors "Black" "grey")
-		    (progn
-		      (set-face-background 'vip-minibuffer-vi-face "grey")
-		      (set-face-foreground 'vip-minibuffer-vi-face "Black"))
-		  (copy-face 'bold 'vip-minibuffer-vi-face))
-	      (copy-face 'bold 'vip-minibuffer-vi-face)
-	      (invert-face 'vip-minibuffer-vi-face)))
-	'vip-minibuffer-vi-face)
-      "Face used in the Minibuffer when it is in Vi state.")
-    
-    ;; the current face used in the minibuffer
-    (vip-deflocalvar vip-minibuffer-current-face vip-minibuffer-emacs-face "")
-    ))
-    
-  
-
-;;; Reading string with history  
-    
-(defun vip-read-string-with-history (prompt &optional initial 
-					    history-var default keymap)
-  ;; Read string, prompting with PROMPT and inserting the INITIAL
-  ;; value. Uses HISTORY-VAR. DEFAULT is the default value to accept if the
-  ;; input is an empty string. Use KEYMAP, if given, or the
-  ;; minibuffer-local-map.
-  ;; Default value is displayed until the user types something in the
-  ;; minibuffer. 
-  (let ((minibuffer-setup-hook 
-	 '(lambda ()
-	    (if (stringp initial)
-		(progn
-		  ;; don't wait if we have unread events or in kbd macro
-		  (or unread-command-events
-		      executing-kbd-macro
-		      (sit-for 840))
-		  (erase-buffer)
-		  (insert initial)))
-	    (vip-minibuffer-setup-sentinel)))
-	(val "")
-	(padding "")
-	temp-msg)
-    
-    (setq keymap (or keymap minibuffer-local-map)
-	  initial (or initial "")
-	  temp-msg (if default
-		       (format "(default: %s) " default)
-		     ""))
-		   
-    (setq vip-incomplete-ex-cmd nil)
-    (setq val (read-from-minibuffer prompt 
-				    (concat temp-msg initial val padding)
-				    keymap nil history-var))
-    (setq minibuffer-setup-hook nil
-	  padding (vip-array-to-string (this-command-keys))
-	  temp-msg "")
-    ;; the following tries to be smart about what to put in history
-    (if (not (string= val (car (eval history-var))))
-	(set history-var (cons val (eval history-var))))
-    (if (or (string= (nth 0 (eval history-var)) (nth 1 (eval history-var)))
-	    (string= (nth 0 (eval history-var)) ""))
-	(set history-var (cdr (eval history-var))))
-    ;; If the user enters nothing but the prev cmd wasn't vip-ex,
-    ;; vip-command-argument, or `! shell-command', this probably means 
-    ;; that the user typed something then erased. Return "" in this case, not
-    ;; the default---the default is too confusing in this case.
-    (cond ((and (string= val "")
-		(not (string= prompt "!")) ; was a `! shell-command'
-		(not (memq last-command
-			   '(vip-ex
-			     vip-command-argument
-			     t)
-			   )))
-	   "")
-	  ((string= val "") (or default ""))
-	  (t val))
-    ))
-  
-
-
-;; insertion commands
-
-;; Called when state changes from Insert Vi command mode.
-;; Repeats the insertion command if Insert state was entered with prefix
-;; argument > 1.
-(defun vip-repeat-insert-command ()
-  (let ((i-com (car vip-d-com))
-	(val   (nth 1 vip-d-com))
-	(char  (nth 2 vip-d-com)))
-    (if (and val (> val 1)) ; first check that val is non-nil
-	(progn        
-	  (setq vip-d-com (list i-com (1- val) ?r nil nil nil))
-	  (vip-repeat nil)
-	  (setq vip-d-com (list i-com val char nil nil nil))
-	  ))))
-
-(defun vip-insert (arg)
-  "Insert before point."
-  (interactive "P")
-  (vip-set-complex-command-for-undo)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (vip-set-destructive-command (list 'vip-insert val ?r nil nil nil))
-    (if com
-	(vip-loop val (vip-yank-last-insertion))
-      (vip-change-state-to-insert))))
-
-(defun vip-append (arg)
-  "Append after point."
-  (interactive "P")
-  (vip-set-complex-command-for-undo)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (vip-set-destructive-command (list 'vip-append val ?r nil nil nil))
-    (if (not (eolp)) (forward-char))
-    (if (equal com ?r)
-	(vip-loop val (vip-yank-last-insertion))
-      (vip-change-state-to-insert))))
-
-(defun vip-Append (arg)
-  "Append at end of line."
-  (interactive "P")
-  (vip-set-complex-command-for-undo)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (vip-set-destructive-command (list 'vip-Append val ?r nil nil nil))
-    (end-of-line)
-    (if (equal com ?r)
-	(vip-loop val (vip-yank-last-insertion))
-      (vip-change-state-to-insert))))
-
-(defun vip-Insert (arg)
-  "Insert before first non-white."
-  (interactive "P")
-  (vip-set-complex-command-for-undo)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (vip-set-destructive-command (list 'vip-Insert val ?r nil nil nil))
-    (back-to-indentation)
-    (if (equal com ?r)
-	(vip-loop val (vip-yank-last-insertion))
-      (vip-change-state-to-insert))))
-
-(defun vip-open-line (arg)
-  "Open line below."
-  (interactive "P")
-  (vip-set-complex-command-for-undo)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (vip-set-destructive-command (list 'vip-open-line val ?r nil nil nil))
-    (let ((col (current-indentation)))
-      (if (equal com ?r)
-	  (vip-loop val
-		    (progn
-		      (end-of-line)
-		      (newline 1)
-		      (if vip-auto-indent 
-			  (progn
-			    (setq vip-cted t)
-			    (if vip-electric-mode
-				(indent-according-to-mode)
-			      (indent-to col))
-			    ))
-		      (vip-yank-last-insertion)))
-	(end-of-line)
-	(newline 1)
-	(if vip-auto-indent
-	    (progn
-	      (setq vip-cted t)
-	      (if vip-electric-mode
-		  (indent-according-to-mode)
-		(indent-to col))))
-	(vip-change-state-to-insert)))))
-
-(defun vip-Open-line (arg)
-  "Open line above."
-  (interactive "P")
-  (vip-set-complex-command-for-undo)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (vip-set-destructive-command (list 'vip-Open-line val ?r nil nil nil))
-    (let ((col (current-indentation)))
-      (if (equal com ?r)
-	  (vip-loop val
-		    (progn
-		      (beginning-of-line)
-		      (open-line 1)
-		      (if vip-auto-indent 
-			  (progn
-			    (setq vip-cted t)
-			    (if vip-electric-mode
-				(indent-according-to-mode)
-			      (indent-to col))
-			    ))
-		      (vip-yank-last-insertion)))
-	(beginning-of-line)
-	(open-line 1)
-	(if vip-auto-indent
-	    (progn
-	      (setq vip-cted t)
-	      (if vip-electric-mode
-		  (indent-according-to-mode)
-		(indent-to col))
-	      ))
-	(vip-change-state-to-insert)))))
-
-(defun vip-open-line-at-point (arg)
-  "Open line at point."
-  (interactive "P")
-  (vip-set-complex-command-for-undo)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (vip-set-destructive-command
-     (list 'vip-open-line-at-point val ?r nil nil nil))
-    (if (equal com ?r)
-	(vip-loop val
-		  (progn
-		    (open-line 1)
-		    (vip-yank-last-insertion)))
-      (open-line 1)
-      (vip-change-state-to-insert))))
-
-(defun vip-substitute (arg)
-  "Substitute characters."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (push-mark nil t)
-    (forward-char val)
-    (if (equal com ?r)
-	(vip-change-subr (mark t) (point))
-      (vip-change (mark t) (point)))
-    (vip-set-destructive-command (list 'vip-substitute val ?r nil nil nil))
-    ))
-
-(defun vip-substitute-line (arg)
-  "Substitute lines."
-  (interactive "p")
-  (vip-set-complex-command-for-undo)
-  (vip-line (cons arg ?C)))
-
-;; Prepare for replace
-(defun vip-start-replace ()
-  (setq vip-began-as-replace t
-	vip-sitting-in-replace t
-	vip-replace-chars-to-delete 0
-	vip-replace-chars-deleted 0)
-  (vip-add-hook 'vip-after-change-functions 'vip-replace-mode-spy-after t)
-  (vip-add-hook 'vip-before-change-functions 'vip-replace-mode-spy-before t)
-  ;; this will get added repeatedly, but no harm
-  (add-hook 'after-change-functions 'vip-after-change-sentinel t)
-  (add-hook 'before-change-functions 'vip-before-change-sentinel t)
-  (vip-move-marker-locally 'vip-last-posn-in-replace-region
-			   (vip-replace-start))
-  (vip-add-hook
-   'vip-post-command-hooks 'vip-replace-state-post-command-sentinel t)
-  (vip-add-hook
-   'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t)
-  )
-  
-
-;; checks how many chars were deleted by the last change
-(defun vip-replace-mode-spy-before (beg end)
-  (setq vip-replace-chars-deleted
-	(- end beg
-	   (max 0 (- end (vip-replace-end)))
-	   (max 0 (- (vip-replace-start) beg))
-	   )))
-
-;; Invoked as an after-change-function to set up parameters of the last change
-(defun vip-replace-mode-spy-after (beg end length)
-  (if (memq vip-intermediate-command '(repeating-insertion-from-ring))
-      (progn
-	(setq vip-replace-chars-to-delete 0)
-	(vip-move-marker-locally 
-	 'vip-last-posn-in-replace-region (point)))
-    
-    (let (beg-col end-col real-end chars-to-delete)
-      (setq real-end (min end (vip-replace-end)))
-      (save-excursion
-	(goto-char beg)
-	(setq beg-col (current-column))
-	(goto-char real-end)
-	(setq end-col (current-column)))
-      
-      ;; If beg of change is outside the replacement region, then don't
-      ;; delete anything in the repl region (set chars-to-delete to 0).
-      ;;
-      ;; This works fine except that we have to take special care of
-      ;; dabbrev-expand.  The problem stems from new-dabbrev.el, which
-      ;; sometimes simply shifts the repl region rightwards, without
-      ;; deleting an equal amount of characters.
-      ;;
-      ;; The reason why new-dabbrev.el causes this are this:
-      ;; if one dinamically completes a partial word that starts before the
-      ;; replacement region (but ends inside) then new-dabbrev.el first
-      ;; moves cursor backwards, to the beginning of the word to be
-      ;; completed (say, pt A). Then it inserts the 
-      ;; completed word and then deletes the old, incomplete part.
-      ;; Since the complete word is inserted at position before the repl
-      ;; region, the next If-statement would have set chars-to-delete to 0
-      ;; unless we check for the current command, which must be
-      ;; dabbrev-expand.
-      ;;
-      ;; In fact, it might be also useful to have overlays for insert
-      ;; regions as well, since this will let us capture the situation when
-      ;; dabbrev-expand goes back past the insertion point to find the
-      ;; beginning of the word to be expanded.
-      (if (or (and (<= (vip-replace-start) beg)
-		   (<= beg (vip-replace-end)))
-	      (and (= length 0) (eq this-command 'dabbrev-expand)))
-	  (setq chars-to-delete
-		(max (- end-col beg-col) (- real-end beg) 0))
-	(setq chars-to-delete 0))
-      
-      ;; if beg = last change position, it means that we are within the
-      ;; same command that does multiple changes. Moreover, it means
-      ;; that we have two subsequent changes (insert/delete) that
-      ;; complement each other.
-      (if (= beg (marker-position vip-last-posn-in-replace-region))
-	  (setq vip-replace-chars-to-delete 
-		(- (+ chars-to-delete vip-replace-chars-to-delete)
-		   vip-replace-chars-deleted)) 
-	(setq vip-replace-chars-to-delete chars-to-delete))
-      
-      (vip-move-marker-locally 
-       'vip-last-posn-in-replace-region
-       (max (if (> end (vip-replace-end)) (vip-replace-start) end)
-	    (or (marker-position vip-last-posn-in-replace-region)
-		(vip-replace-start)) 
-	    ))
-      
-      (setq vip-replace-chars-to-delete
-	    (max 0 (min vip-replace-chars-to-delete
-			(- (vip-replace-end)
-			   vip-last-posn-in-replace-region))))
-      )))
-
-
-;; Delete stuff between posn and the end of vip-replace-overlay-marker, if
-;; posn is within the overlay.
-(defun vip-finish-change (posn)
-  (vip-remove-hook 'vip-after-change-functions 'vip-replace-mode-spy-after)
-  (vip-remove-hook 'vip-before-change-functions 'vip-replace-mode-spy-before)
-  (vip-remove-hook 'vip-post-command-hooks
-		   'vip-replace-state-post-command-sentinel) 
-  (vip-remove-hook
-   'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel) 
-  (vip-restore-cursor-color-after-replace)
-  (setq vip-sitting-in-replace nil) ; just in case we'll need to know it
-  (save-excursion
-    (if (and 
-	 vip-replace-overlay
-	 (>= posn (vip-replace-start))
-	 (<  posn (vip-replace-end)))
-	   (delete-region posn (vip-replace-end)))
-    )
-  
-  (if (eq vip-current-state 'replace-state)
-      (vip-downgrade-to-insert))
-  ;; replace mode ended => nullify vip-last-posn-in-replace-region
-  (vip-move-marker-locally 'vip-last-posn-in-replace-region nil)
-  (vip-hide-replace-overlay)
-  (vip-refresh-mode-line)
-  (vip-put-string-on-kill-ring vip-last-replace-region)
-  )
-
-;; Make STRING be the first element of the kill ring.
-(defun vip-put-string-on-kill-ring (string)
-  (setq kill-ring (cons string kill-ring))
-  (if (> (length kill-ring) kill-ring-max)
-      (setcdr (nthcdr (1- kill-ring-max) kill-ring) nil))
-  (setq kill-ring-yank-pointer kill-ring))
-
-(defun vip-finish-R-mode ()
-  (vip-remove-hook 'vip-post-command-hooks 'vip-R-state-post-command-sentinel)
-  (vip-remove-hook
-   'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel)
-  (vip-downgrade-to-insert))
-  
-(defun vip-start-R-mode ()
-  ;; Leave arg as 1, not t: XEmacs insists that it must be a pos number
-  (overwrite-mode 1)
-  (vip-add-hook
-   'vip-post-command-hooks 'vip-R-state-post-command-sentinel t)
-  (vip-add-hook
-   'vip-pre-command-hooks 'vip-replace-state-pre-command-sentinel t)
-  )
-
-
-  
-(defun vip-replace-state-exit-cmd ()
-  "Binding for keys that cause Replace state to switch to Vi or to Insert.
-These keys are ESC, RET, and LineFeed"
-  (interactive)
-  (if overwrite-mode  ;; If you are in replace mode invoked via 'R'
-      (vip-finish-R-mode)
-    (vip-finish-change vip-last-posn-in-replace-region))
-  (let (com)
-    (if (eq this-command 'vip-intercept-ESC-key)
-	(setq com 'vip-exit-insert-state)
-      (vip-set-unread-command-events last-input-char)
-      (setq com (key-binding (read-key-sequence nil))))
-      
-    (condition-case conds
-	(command-execute com)
-      (error
-       (vip-message-conditions conds)))
-    )
-  (vip-hide-replace-overlay))
-
-  
-;; This is the function bound to 'R'---unlimited replace.
-;; Similar to Emacs's own overwrite-mode.
-(defun vip-overwrite (arg) 
-  "Begin overwrite mode."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)) (len))
-    (vip-set-destructive-command (list 'vip-overwrite val ?r nil nil nil))
-    (if com
-	(progn 
-	  ;; Viper saves inserted text in vip-last-insertion
-	  (setq len (length vip-last-insertion))
-	  (delete-char len)	
-	  (vip-loop val (vip-yank-last-insertion)))
-      (setq last-command 'vip-overwrite)
-      (vip-set-complex-command-for-undo)
-      (vip-set-replace-overlay (point) (vip-line-pos 'end))
-      (vip-change-state-to-replace)
-      )))
-
-
-;; line commands
-
-(defun vip-line (arg)
-  (let ((val (car arg))
-	(com (cdr arg)))
-    (vip-move-marker-locally 'vip-com-point (point))
-    (if (not (eobp))
-	(vip-next-line-carefully (1- val)))
-    ;; this ensures that dd, cc, D, yy will do the right thing on the last
-    ;; line of buffer when this line has no \n.
-    (vip-add-newline-at-eob-if-necessary)
-    (vip-execute-com 'vip-line val com))
-  (if (and (eobp) (not (bobp))) (forward-line -1))
-  )
-
-(defun vip-yank-line (arg)
-  "Yank ARG lines (in Vi's sense)."
-  (interactive "P")
-  (let ((val (vip-p-val arg)))
-    (vip-line (cons val ?Y))))
-
-
-;; region commands
-
-(defun vip-region (arg)
-  "Execute command on a region."
-  (interactive "P")
-  (let ((val (vip-P-val arg))
-	(com (vip-getcom arg)))
-    (vip-move-marker-locally 'vip-com-point (point))
-    (exchange-point-and-mark)
-    (vip-execute-com 'vip-region val com)))
-
-(defun vip-Region (arg)
-  "Execute command on a Region."
-  (interactive "P")
-  (let ((val (vip-P-val arg))
-	(com (vip-getCom arg)))
-    (vip-move-marker-locally 'vip-com-point (point))
-    (exchange-point-and-mark)
-    (vip-execute-com 'vip-Region val com)))
-
-(defun vip-replace-char (arg)
-  "Replace the following ARG chars by the character read."
-  (interactive "P")
-  (if (and (eolp) (bolp)) (error "No character to replace here"))
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (vip-replace-char-subr com val)
-    (if (and (eolp) (not (bolp))) (forward-char 1))
-    (vip-set-destructive-command
-     (list 'vip-replace-char val ?r nil vip-d-char nil))
-  ))
-
-(defun vip-replace-char-subr (com arg)
-  (let ((take-care-of-iso-accents
-	 (and (boundp 'iso-accents-mode) vip-automatic-iso-accents))
-	char)
-    (setq char (if (equal com ?r)
-		   vip-d-char
-		 (read-char)))
-    (if (and  take-care-of-iso-accents (memq char '(?' ?\" ?^ ?~)))
-	;; get European characters
-	(progn
-	  (iso-accents-mode 1)
-	  (vip-set-unread-command-events char)
-	  (setq char (aref (read-key-sequence nil) 0))
-	  (iso-accents-mode -1)))
-    (delete-char arg t)
-    (setq vip-d-char char)
-    (vip-loop (if (> arg 0) arg (- arg)) 
-	    (if (eq char ?\C-m) (insert "\n") (insert char)))
-    (backward-char arg)))
-
-
-;; basic cursor movement.  j, k, l, h commands.
-
-(defun vip-forward-char (arg)
-  "Move point right ARG characters (left if ARG negative).
-On reaching end of line, stop and signal error."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (if vip-ex-style-motion
-	(progn
-	  ;; the boundary condition check gets weird here because
-	  ;; forward-char may be the parameter of a delete, and 'dl' works
-	  ;; just like 'x' for the last char on a line, so we have to allow
-	  ;; the forward motion before the 'vip-execute-com', but, of
-	  ;; course, 'dl' doesn't work on an empty line, so we have to
-	  ;; catch that condition before 'vip-execute-com'
-	  (if (and (eolp) (bolp)) (error "") (forward-char val))
-	  (if com (vip-execute-com 'vip-forward-char val com))
-	  (if (eolp) (progn (backward-char 1) (error ""))))
-      (forward-char val)
-      (if com (vip-execute-com 'vip-forward-char val com)))))
-
-(defun vip-backward-char (arg)
-  "Move point left ARG characters (right if ARG negative). 
-On reaching beginning of line, stop and signal error."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (if vip-ex-style-motion
-	(progn
-	  (if (bolp) (error "") (backward-char val))
-	  (if com (vip-execute-com 'vip-backward-char val com)))
-      (backward-char val)
-      (if com (vip-execute-com 'vip-backward-char val com)))))
-      
-;; Like forward-char, but doesn't move at end of buffer.
-(defun vip-forward-char-carefully (&optional arg)      
-  (setq arg (or arg 1))
-  (if (>= (point-max) (+ (point) arg))
-      (forward-char arg)
-    (goto-char (point-max))))
-      
-;; Like backward-char, but doesn't move at end of buffer.
-(defun vip-backward-char-carefully (&optional arg)      
-  (setq arg (or arg 1))
-  (if (<= (point-min) (- (point) arg))
-      (backward-char arg)
-    (goto-char (point-min))))
-
-(defun vip-next-line-carefully (arg)
-  (condition-case nil
-      (next-line arg)
-    (error nil)))
-
-
-
-;;; Word command
-
-;; Words are formed from alpha's and nonalphas - <sp>,\t\n are separators
-;; for word movement. When executed with a destructive command, \n is
-;; usually left untouched for the last word.
-;; Viper uses syntax table to determine what is a word and what is a
-;; separator. However, \n is always a separator. Also, if vip-syntax-preference
-;; is 'vi, then `_' is part of the word.
-
-;; skip only one \n
-(defun vip-skip-separators (forward)
-  (if forward
-      (progn
-	(vip-skip-all-separators-forward 'within-line)
-	(if (looking-at "\n")
-	    (progn
-	      (forward-char)
-	      (vip-skip-all-separators-forward  'within-line))))
-    (vip-skip-all-separators-backward 'within-line)
-    (backward-char)
-    (if (looking-at "\n")
-	(vip-skip-all-separators-backward 'within-line)
-      (forward-char))))
-      
-(defun vip-forward-word-kernel (val)
-  (while (> val 0)
-    (cond ((vip-looking-at-alpha)
-	   (vip-skip-alpha-forward "_")
-	   (vip-skip-separators t))
-	  ((vip-looking-at-separator)
-	   (vip-skip-separators t))
-	  ((not (vip-looking-at-alphasep))
-	   (vip-skip-nonalphasep-forward)
-	   (vip-skip-separators t)))
-    (setq val (1- val))))
-
-;; first search backward for pat. Then skip chars backwards using aux-pat
-(defun vip-fwd-skip (pat aux-pat lim)
-  (if (and (save-excursion 
-	     (re-search-backward pat lim t))
-	   (= (point) (match-end 0)))
-      (goto-char (match-beginning 0)))
-  (skip-chars-backward aux-pat lim)
-  (if (= (point) lim)
-      (vip-forward-char-carefully))
-  )
-
-	  
-(defun vip-forward-word (arg)
-  "Forward word."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (vip-forward-word-kernel val)
-    (if com (progn
-	      (cond ((memq com (list ?c (- ?c)))
-		     (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point))
-		    ;; Yank words including the whitespace, but not newline
-		    ((memq com (list ?y (- ?y)))
-		     (vip-fwd-skip "\n[ \t]*" "" vip-com-point))
-		    ((vip-dotable-command-p com)
-		     (vip-fwd-skip "\n[ \t]*" "" vip-com-point)))
-	      (vip-execute-com 'vip-forward-word val com)))))
-	  
-
-(defun vip-forward-Word (arg)
-  "Forward word delimited by white characters."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (vip-loop val
-	      (progn
-		(vip-skip-nonseparators 'forward)
-		(vip-skip-separators t)))
-    (if com (progn
-	      (cond ((memq com (list ?c (- ?c)))
-		     (vip-fwd-skip "\n[ \t]*" " \t" vip-com-point))
-		    ;; Yank words including the whitespace, but not newline
-		    ((memq com (list ?y (- ?y)))
-		     (vip-fwd-skip "\n[ \t]*" "" vip-com-point))
-		    ((vip-dotable-command-p com)
-		     (vip-fwd-skip "\n[ \t]*" "" vip-com-point)))
-	      (vip-execute-com 'vip-forward-Word val com)))))
-
-
-;; this is a bit different from Vi, but Vi's end of word 
-;; makes no sense whatsoever
-(defun vip-end-of-word-kernel ()
-  (if (vip-end-of-word-p) (forward-char))
-  (if (vip-looking-at-separator)
-      (vip-skip-all-separators-forward))
-  
-  (cond ((vip-looking-at-alpha) (vip-skip-alpha-forward "_"))
-	((not (vip-looking-at-alphasep)) (vip-skip-nonalphasep-forward)))
-  (vip-backward-char-carefully))
-
-(defun vip-end-of-word-p ()
-  (or (eobp) 
-      (save-excursion
-	(cond ((vip-looking-at-alpha)
-	       (forward-char)
-	       (not (vip-looking-at-alpha)))
-	      ((not (vip-looking-at-alphasep))
-	       (forward-char)
-	       (vip-looking-at-alphasep))))))
-
-
-(defun vip-end-of-word (arg &optional careful)
-  "Move point to end of current word."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (vip-loop val (vip-end-of-word-kernel))
-    (if com 
-	(progn
-	  (forward-char)
-	  (vip-execute-com 'vip-end-of-word val com)))))
-
-(defun vip-end-of-Word (arg)
-  "Forward to end of word delimited by white character."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (vip-loop val
-	      (progn
-		(vip-end-of-word-kernel)
-		(vip-skip-nonseparators 'forward)
-		(backward-char)))
-    (if com 
-	(progn
-	  (forward-char)
-	  (vip-execute-com 'vip-end-of-Word val com)))))
-
-(defun vip-backward-word-kernel (val)
-  (while (> val 0)
-    (backward-char)
-    (cond ((vip-looking-at-alpha)
-	   (vip-skip-alpha-backward "_"))
-	  ((vip-looking-at-separator)
-	   (forward-char)
-	   (vip-skip-separators nil)
-	   (backward-char)
-	   (cond ((vip-looking-at-alpha)
-		  (vip-skip-alpha-backward "_"))
-		 ((not (vip-looking-at-alphasep))
-		  (vip-skip-nonalphasep-backward))
-		 (t (forward-char))))
-	  ((not (vip-looking-at-alphasep))
-	   (vip-skip-nonalphasep-backward)))
-    (setq val (1- val))))
-
-(defun vip-backward-word (arg)
-  "Backward word."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com
-	(let (i)
-	  (if (setq i (save-excursion (backward-char) (looking-at "\n")))
-	      (backward-char))
-	  (vip-move-marker-locally 'vip-com-point (point))
-	  (if i (forward-char))))
-    (vip-backward-word-kernel val)
-    (if com (vip-execute-com 'vip-backward-word val com))))
-
-(defun vip-backward-Word (arg)
-  "Backward word delimited by white character."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com
-	(let (i)
-	  (if (setq i (save-excursion (backward-char) (looking-at "\n")))
-	      (backward-char))
-	  (vip-move-marker-locally 'vip-com-point (point))
-	  (if i (forward-char))))
-    (vip-loop val
-	      (progn 
-		(vip-skip-separators nil)
-		(vip-skip-nonseparators 'backward)))
-    (if com (vip-execute-com 'vip-backward-Word val com))))
-
-
-
-;; line commands
-
-(defun vip-beginning-of-line (arg)
-  "Go to beginning of line."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (beginning-of-line val)
-    (if com (vip-execute-com 'vip-beginning-of-line val com))))
-
-(defun vip-bol-and-skip-white (arg)
-  "Beginning of line at first non-white character."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (forward-to-indentation (1- val))
-    (if com (vip-execute-com 'vip-bol-and-skip-white val com))))
-
-(defun vip-goto-eol (arg)
-  "Go to end of line."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (end-of-line val)
-    (if com (vip-execute-com 'vip-goto-eol val com))
-    (if vip-ex-style-motion
-	(if (and (eolp) (not (bolp)) 
-		 ;; a fix for vip-change-to-eol
-		 (not (equal vip-current-state 'insert-state)))
-	    (backward-char 1)
-    ))))
-
-
-(defun vip-goto-col (arg)
-  "Go to ARG's column."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (save-excursion
-      (end-of-line)
-      (if (> val (1+ (current-column))) (error "")))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (beginning-of-line)
-    (forward-char (1- val))
-    (if com (vip-execute-com 'vip-goto-col val com))))
-    
-
-(defun vip-next-line (arg)
-  "Go to next line."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (next-line val)
-    (if vip-ex-style-motion
-	(if (and (eolp) (not (bolp))) (backward-char 1)))
-    (setq this-command 'next-line)
-    (if com (vip-execute-com 'vip-next-line val com))))
-
-(defun vip-next-line-at-bol (arg)
-  "Next line at beginning of line."
-  (interactive "P")
-  (vip-leave-region-active)
-  (save-excursion
-    (end-of-line)
-    (if (eobp) (error "Last line in buffer")))
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (forward-line val)
-    (back-to-indentation)
-    (if com (vip-execute-com 'vip-next-line-at-bol val com))))
-
-(defun vip-previous-line (arg)	 
-  "Go to previous line."    	
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (previous-line val)
-    (if vip-ex-style-motion
-	(if (and (eolp) (not (bolp))) (backward-char 1)))
-    (setq this-command 'previous-line)
-    (if com (vip-execute-com 'vip-previous-line val com))))
-
-
-(defun vip-previous-line-at-bol (arg)
-  "Previous line at beginning of line."
-  (interactive "P")
-  (vip-leave-region-active)
-  (save-excursion
-    (beginning-of-line)
-    (if (bobp) (error "First line in buffer")))
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (forward-line (- val))
-    (back-to-indentation)
-    (if com (vip-execute-com 'vip-previous-line val com))))
-
-(defun vip-change-to-eol (arg)
-  "Change to end of line."
-  (interactive "P")
-  (vip-goto-eol (cons arg ?c)))
-
-(defun vip-kill-line (arg)
-  "Delete line."
-  (interactive "P")
-  (vip-goto-eol (cons arg ?d)))
-
-(defun vip-erase-line (arg)
-  "Erase line."
-  (interactive "P")
-  (vip-beginning-of-line (cons arg ?d)))
-
-
-;;; Moving around
-
-(defun vip-goto-line (arg)
-  "Go to ARG's line.  Without ARG go to end of buffer."
-  (interactive "P")
-  (let ((val (vip-P-val arg))
-	(com (vip-getCom arg)))
-    (vip-move-marker-locally 'vip-com-point (point))
-    (vip-deactivate-mark)
-    (push-mark nil t)
-    (if (null val)
-	(goto-char (point-max))
-      (goto-char (point-min))
-      (forward-line (1- val)))
-    
-    ;; positioning is done twice: before and after command execution
-    (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
-    (back-to-indentation)
-    
-    (if com (vip-execute-com 'vip-goto-line val com))
-    
-    (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
-    (back-to-indentation)
-    ))
-
-;; Find ARG's occurrence of CHAR on the current line. 
-;; If FORWARD then search is forward, otherwise backward.  OFFSET is used to
-;; adjust point after search.
-(defun vip-find-char (arg char forward offset)
-  (or (char-or-string-p char) (error ""))
-  (let ((arg (if forward arg (- arg)))
-	(cmd (if (eq vip-intermediate-command 'vip-repeat)
-		 (nth 5 vip-d-com)
-	       (vip-array-to-string (this-command-keys))))
-	point)
-    (save-excursion
-      (save-restriction
-	(if (> arg 0)
-	    (narrow-to-region
-	     ;; forward search begins here
-	     (if (eolp) (error "Command `%s':  At end of line" cmd) (point))
-	     ;; forward search ends here
-	     (progn (end-of-line) (point)))
-	  (narrow-to-region
-	   ;; backward search begins from here
-	   (if (bolp)
-	       (error "Command `%s':  At beginning of line" cmd) (point))
-	   ;; backward search ends here
-	   (progn (beginning-of-line) (point))))
-	;; if arg > 0, point is forwarded before search.
-	(if (> arg 0) (goto-char (1+ (point-min)))
-	  (goto-char (point-max)))
-	(if (let ((case-fold-search nil))
-	      (search-forward (char-to-string char) nil 0 arg))
-	    (setq point (point))
-	  (error "Command `%s':  `%c' not found" cmd char))))
-    (goto-char (+ point (if (> arg 0) (if offset -2 -1) (if offset 1 0))))))
-
-(defun vip-find-char-forward (arg)
-  "Find char on the line. 
-If called interactively read the char to find from the terminal, and if
-called from vip-repeat, the char last used is used.  This behaviour is
-controlled by the sign of prefix numeric value."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg))
-	(cmd-representation (nth 5 vip-d-com)))
-    (if (> val 0)
-	;; this means that the function was called interactively
-	(setq vip-f-char (read-char)
-	      vip-f-forward t
-	      vip-f-offset nil)
-      ;; vip-repeat --- set vip-F-char from command-keys
-      (setq vip-F-char (if (stringp cmd-representation)
-			   (vip-seq-last-elt cmd-representation)
-			 vip-F-char)
-	    vip-f-char vip-F-char)
-      (setq val (- val)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t nil)
-    (setq val (- val))
-    (if com
-	(progn
-	  (setq vip-F-char vip-f-char) ; set new vip-F-char
-	  (forward-char)
-	  (vip-execute-com 'vip-find-char-forward val com)))))
-
-(defun vip-goto-char-forward (arg)
-  "Go up to char ARG forward on line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg))
-	(cmd-representation (nth 5 vip-d-com)))
-    (if (> val 0)
-	;; this means that the function was called interactively
-	(setq vip-f-char (read-char)
-	      vip-f-forward t
-	      vip-f-offset t)
-      ;; vip-repeat --- set vip-F-char from command-keys
-      (setq vip-F-char (if (stringp cmd-representation)
-			   (vip-seq-last-elt cmd-representation)
-			 vip-F-char)
-	    vip-f-char vip-F-char)
-      (setq val (- val)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) t t)
-    (setq val (- val))
-    (if com
-	(progn
-	  (setq vip-F-char vip-f-char) ; set new vip-F-char
-	  (forward-char)
-	  (vip-execute-com 'vip-goto-char-forward val com)))))
-
-(defun vip-find-char-backward (arg)
-  "Find char ARG on line backward."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg))
-	(cmd-representation (nth 5 vip-d-com)))
-    (if (> val 0)
-	;; this means that the function was called interactively
-	(setq vip-f-char (read-char)
-	      vip-f-forward nil
-	      vip-f-offset nil)
-      ;; vip-repeat --- set vip-F-char from command-keys
-      (setq vip-F-char (if (stringp cmd-representation)
-			   (vip-seq-last-elt cmd-representation)
-			 vip-F-char)
-	    vip-f-char vip-F-char)
-      (setq val (- val)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (vip-find-char
-     val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil nil)
-    (setq val (- val))
-    (if com
-	(progn
-	  (setq vip-F-char vip-f-char) ; set new vip-F-char
-	  (vip-execute-com 'vip-find-char-backward val com)))))
-
-(defun vip-goto-char-backward (arg)
-  "Go up to char ARG backward on line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg))
-	(cmd-representation (nth 5 vip-d-com)))
-    (if (> val 0)
-	;; this means that the function was called interactively
-	(setq vip-f-char (read-char)
-	      vip-f-forward nil
-	      vip-f-offset t)
-      ;; vip-repeat --- set vip-F-char from command-keys
-      (setq vip-F-char (if (stringp cmd-representation)
-			   (vip-seq-last-elt cmd-representation)
-			 vip-F-char)
-	    vip-f-char vip-F-char)
-      (setq val (- val)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (vip-find-char val (if (> (vip-p-val arg) 0) vip-f-char vip-F-char) nil t)
-    (setq val (- val))
-    (if com
-	(progn
-	  (setq vip-F-char vip-f-char) ; set new vip-F-char
-	  (vip-execute-com 'vip-goto-char-backward val com)))))
-
-(defun vip-repeat-find (arg)
-  "Repeat previous find command."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (vip-deactivate-mark)
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (vip-find-char val vip-f-char vip-f-forward vip-f-offset)
-    (if com
-	(progn
-	  (if vip-f-forward (forward-char))
-	  (vip-execute-com 'vip-repeat-find val com)))))
-
-(defun vip-repeat-find-opposite (arg)
-  "Repeat previous find command in the opposite direction."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (vip-deactivate-mark)
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (vip-find-char val vip-f-char (not vip-f-forward) vip-f-offset)
-    (if com
-	(progn
-	  (if vip-f-forward (forward-char))
-	  (vip-execute-com 'vip-repeat-find-opposite val com)))))
-
-
-;; window scrolling etc.
-
-(defun vip-other-window (arg)
-  "Switch to other window."
-  (interactive "p")
-  (other-window arg)
-  (or (not (eq vip-current-state 'emacs-state))
-      (string= (buffer-name (current-buffer)) " *Minibuf-1*")
-      (vip-change-state-to-vi)))
-
-(defun vip-window-top (arg)
-  "Go to home window line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (push-mark nil t) 
-    (move-to-window-line (1- val))
-
-    ;; positioning is done twice: before and after command execution
-    (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
-    (back-to-indentation)
-    
-    (if com (vip-execute-com 'vip-window-top val com))
-    
-    (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
-    (back-to-indentation)
-    ))
-
-(defun vip-window-middle (arg)
-  "Go to middle window line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg))
-	lines)
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (push-mark nil t) 
-    (if (not (pos-visible-in-window-p (point-max)))
-	(move-to-window-line (+ (/ (1- (window-height)) 2) (1- val)))
-      (setq lines (count-lines (window-start) (point-max)))
-      (move-to-window-line (+ (/ lines 2) (1- val))))
-      
-    ;; positioning is done twice: before and after command execution
-    (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
-    (back-to-indentation)
-
-    (if com (vip-execute-com 'vip-window-middle val com))
-    
-    (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
-    (back-to-indentation)
-    ))
-
-(defun vip-window-bottom (arg)
-  "Go to last window line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (push-mark nil t) 
-    (move-to-window-line (- val))
-    
-    ;; positioning is done twice: before and after command execution
-    (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
-    (back-to-indentation)
-
-    (if com (vip-execute-com 'vip-window-bottom val com))
-    
-    (if (and (eobp) (bolp) (not (bobp))) (forward-line -1))
-    (back-to-indentation)
-    ))
-
-(defun vip-line-to-top (arg)
-  "Put current line on the home line."
-  (interactive "p")
-  (recenter (1- arg)))
-
-(defun vip-line-to-middle (arg)
-  "Put current line on the middle line."
-  (interactive "p")
-  (recenter (+ (1- arg) (/ (1- (window-height)) 2))))
-
-(defun vip-line-to-bottom (arg)
-  "Put current line on the last line."
-  (interactive "p")
-  (recenter (- (window-height) (1+ arg))))
-
-;; If vip-adjust-window-after-search is t, scroll up or down 1/4 of window
-;; height, depending on whether we are at the bottom or at the top of the
-;; window. This function is called by vip-search (which is called from
-;; vip-search-forward/backward/next)
-(defun vip-adjust-window ()
-  (let ((win-height (if vip-emacs-p
-			(1- (window-height)) ; adjust for modeline
-		      (window-displayed-height)))
-	(pt (point))
-	at-top-p at-bottom-p
-	min-scroll direction)
-    (save-excursion
-      (move-to-window-line 0) ; top
-      (setq at-top-p (<= (count-lines pt (point)) 2))
-      (move-to-window-line -1) ; bottom
-      (setq at-bottom-p (<= (count-lines pt (point)) 2))
-      )
-    (cond (at-top-p (setq min-scroll 1
-			  direction  1))
-	  (at-bottom-p (setq min-scroll 2
-			     direction -1)))
-    (if (and vip-adjust-window-after-search min-scroll)
-	(recenter
-	 (* (max min-scroll (/ win-height 7)) direction)))
-    ))
-
-
-;; paren match
-;; must correct this to only match ( to ) etc. On the other hand
-;; it is good that paren match gets confused, because that way you
-;; catch _all_ imbalances. 
-
-(defun vip-paren-match (arg)
-  "Go to the matching parenthesis."
-  (interactive "P")
-  (vip-leave-region-active)
-  (let ((com (vip-getcom arg))
-	parse-sexp-ignore-comments anchor-point)
-    (if (integerp arg)
-	(if (or (> arg 99) (< arg 1))
-	    (error "Prefix must be between 1 and 99")
-	  (goto-char
-	   (if (> (point-max) 80000)
-	       (* (/ (point-max) 100) arg)
-	     (/ (* (point-max) arg) 100)))
-	  (back-to-indentation))
-      (let (beg-lim end-lim)
-	(if (and (eolp) (not (bolp))) (forward-char -1))
-	(if (not (looking-at "[][(){}]"))
-	    (setq anchor-point (point)))
-	(save-excursion
-	  (beginning-of-line)
-	  (setq beg-lim (point))
-	  (end-of-line)
-	  (setq end-lim (point)))
-	(cond ((re-search-forward "[][(){}]" end-lim t) 
-	       (backward-char) )
-	      ((re-search-backward "[][(){}]" beg-lim t))
-	      (t
-	       (error "No matching character on line"))))
-      (cond ((looking-at "[\(\[{]")
-	     (if com (vip-move-marker-locally 'vip-com-point (point)))
-	     (forward-sexp 1)
-	     (if com
-		 (vip-execute-com 'vip-paren-match nil com)
-	       (backward-char)))
-	    (anchor-point
-	     (if com
-		 (progn
-		   (vip-move-marker-locally 'vip-com-point anchor-point)
-		   (forward-char 1)
-		   (vip-execute-com 'vip-paren-match nil com)
-		   )))
-	    ((looking-at "[])}]")
-	     (forward-char)
-	     (if com (vip-move-marker-locally 'vip-com-point (point)))
-	     (backward-sexp 1)
-	     (if com (vip-execute-com 'vip-paren-match nil com)))
-	    (t (error ""))))))
-
-
-;; sentence ,paragraph and heading
-
-(defun vip-forward-sentence (arg)
-  "Forward sentence."
-  (interactive "P")
-  (push-mark nil t) 
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (forward-sentence val)
-    (if com (vip-execute-com 'vip-forward-sentence nil com))))
-
-(defun vip-backward-sentence (arg)
-  "Backward sentence."
-  (interactive "P")
-  (push-mark nil t) 
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (backward-sentence val)
-    (if com (vip-execute-com 'vip-backward-sentence nil com))))
-
-(defun vip-forward-paragraph (arg)
-  "Forward paragraph."
-  (interactive "P")
-  (push-mark nil t) 
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (forward-paragraph val)
-    (if com
-	(progn
-	  (backward-char 1)
-	  (vip-execute-com 'vip-forward-paragraph nil com)))))
-
-(defun vip-backward-paragraph (arg)
-  "Backward paragraph."
-  (interactive "P")
-  (push-mark nil t) 
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (backward-paragraph val)
-    (if com
-	(progn
-	  (forward-char 1)
-	  (vip-execute-com 'vip-backward-paragraph nil com)
-	  (backward-char 1)))))
-
-;; should be mode-specific etc.
-
-(defun vip-prev-heading (arg)
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (re-search-backward vip-heading-start nil t val)
-    (goto-char (match-beginning 0))
-    (if com (vip-execute-com 'vip-prev-heading nil com))))
-
-(defun vip-heading-end (arg)
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (re-search-forward vip-heading-end nil t val)
-    (goto-char (match-beginning 0))
-    (if com (vip-execute-com 'vip-heading-end nil com))))
-
-(defun vip-next-heading (arg)
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getCom arg)))
-    (if com (vip-move-marker-locally 'vip-com-point (point)))
-    (end-of-line)
-    (re-search-forward vip-heading-start nil t val)
-    (goto-char (match-beginning 0))
-    (if com (vip-execute-com 'vip-next-heading nil com))))
-
-
-;; scrolling
-
-(setq scroll-step 1)
-
-(defun vip-scroll-screen (arg)
-  "Scroll to next screen."
-  (interactive "p")
-  (condition-case nil
-      (if (> arg 0)
-	  (while (> arg 0)
-	    (scroll-up)
-	    (setq arg (1- arg)))
-	(while (> 0 arg)
-	  (scroll-down)
-	  (setq arg (1+ arg))))
-    (error (beep 1)
-	   (if (> arg 0)
-	       (progn
-		 (message "End of buffer")
-		 (goto-char (point-max)))
-	     (message "Beginning of buffer")
-	     (goto-char (point-min))))
-    ))
-
-(defun vip-scroll-screen-back (arg)
-  "Scroll to previous screen."
-  (interactive "p")
-  (vip-scroll-screen (- arg)))
-
-(defun vip-scroll-down (arg)
-  "Pull down half screen."
-  (interactive "P")
-  (condition-case nil
-      (if (null arg)
-	  (scroll-down (/ (window-height) 2))
-	(scroll-down arg))
-    (error (beep 1)
-	   (message "Beginning of buffer")
-	   (goto-char (point-min)))))
-
-(defun vip-scroll-down-one (arg)
-  "Scroll up one line."
-  (interactive "p")
-  (scroll-down arg))
-
-(defun vip-scroll-up (arg)
-  "Pull up half screen."
-  (interactive "P")
-  (condition-case nil
-      (if (null arg)
-	  (scroll-up (/ (window-height) 2))
-	(scroll-up arg))
-    (error (beep 1)
-	   (message "End of buffer")
-	   (goto-char (point-max)))))
-
-(defun vip-scroll-up-one (arg)
-  "Scroll down one line."
-  (interactive "p")
-  (scroll-up arg))
-
-
-;; searching
-
-(defun vip-if-string (prompt)
-  (let ((s (vip-read-string-with-history
-	    prompt
-	    nil ; no initial
-	    'vip-search-history
-	    (car vip-search-history))))
-    (if (not (string= s ""))
-	(setq vip-s-string s))))  
-	
-    
-(defun vip-toggle-search-style (arg) 
-  "Toggle the value of vip-case-fold-search/vip-re-search.
-Without prefix argument, will ask which search style to toggle. With prefix
-arg 1,toggles vip-case-fold-search; with arg 2 toggles vip-re-search.
-
-Although this function is bound to \\[vip-toggle-search-style], the most
-convenient way to use it is to bind `//' to the macro
-`1 M-x vip-toggle-search-style' and `///' to
-`2 M-x vip-toggle-search-style'. In this way, hitting `//' quickly will
-toggle case-fold-search and hitting `/' three times witth toggle regexp
-search. Macros are more convenient in this case because they don't affect
-the Emacs binding of `/'."
-  (interactive "P")
-  (let (msg)
-    (cond ((or (eq arg 1)
-	       (and (null arg)
-		    (y-or-n-p (format "Search style: '%s'. Want '%s'? "
-				      (if vip-case-fold-search
-					  "case-insensitive" "case-sensitive")
-				      (if vip-case-fold-search
-					  "case-sensitive"
-					"case-insensitive")))))
-	   (setq vip-case-fold-search (null vip-case-fold-search))
-	   (if vip-case-fold-search
-	       (setq msg "Search becomes case-insensitive")
-	     (setq msg "Search becomes case-sensitive")))
-	  ((or (eq arg 2)
-	       (and (null arg)
-		    (y-or-n-p (format "Search style: '%s'. Want '%s'? "
-				      (if vip-re-search
-					  "regexp-search" "vanilla-search")
-				      (if vip-re-search
-					  "vanilla-search"
-					"regexp-search")))))
-	   (setq vip-re-search (null vip-re-search))
-	   (if vip-re-search
-	       (setq msg "Search becomes regexp-style")
-	     (setq msg "Search becomes vanilla-style")))
-	  (t
-	   (setq msg "Search style remains unchanged")))
-    (prin1 msg t)))
-
-(defun vip-set-vi-search-style-macros (unset)
-  "Set the macros for toggling the search style in Viper's vi-state.
-The macro that toggles case sensitivity is bound to `//', and the one that
-toggles regexp search is bound to `///'.
-With a prefix argument, this function unsets the macros. "
-  (interactive "P")
-  (or noninteractive
-      (if (not unset)
-	  (progn
-	    ;; toggle case sensitivity in search
-	    (vip-record-kbd-macro
-	     "//" 'vi-state
-	     [1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
-	     't)
-	    ;; toggle regexp/vanila search
-	    (vip-record-kbd-macro
-	     "///" 'vi-state
-	     [2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
-	     't)
-	    (if (interactive-p)
-		(message
-		 "// and /// now toggle case-sensitivity and regexp search.")))
-	(vip-unrecord-kbd-macro "//" 'vi-state)
-	(sit-for 2)
-	(vip-unrecord-kbd-macro "///" 'vi-state))))
-
-(defun vip-set-emacs-search-style-macros (unset &optional arg-majormode)
-  "Set the macros for toggling the search style in Viper's emacs-state.
-The macro that toggles case sensitivity is bound to `//', and the one that
-toggles regexp search is bound to `///'.
-With a prefix argument, this function unsets the macros. 
-If the optional prefix argument is non-nil and specifies a valid major mode,
-this sets the macros only in the macros in that major mode. Otherwise,
-the macros are set in the current major mode.
-\(When unsetting the macros, the second argument has no effect.\)"
-  (interactive "P")
-  (or noninteractive
-      (if (not unset)
-	  (progn
-	    ;; toggle case sensitivity in search
-	    (vip-record-kbd-macro
-	     "//" 'emacs-state
-	     [1 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return] 
-	     (or arg-majormode major-mode))
-	    ;; toggle regexp/vanila search
-	    (vip-record-kbd-macro
-	     "///" 'emacs-state
-	     [2 (meta x) v i p - t o g g l e - s e a r c h - s t y l e return]
-	     (or arg-majormode major-mode))
-	    (if (interactive-p)
-		(message
-		 "// and /// now toggle case-sensitivity and regexp search.")))
-	(vip-unrecord-kbd-macro "//" 'emacs-state)
-	(sit-for 2)
-	(vip-unrecord-kbd-macro "///" 'emacs-state))))
-
-
-(defun vip-search-forward (arg)
-  "Search a string forward. 
-ARG is used to find the ARG's occurrence of the string.
-Null string will repeat previous search."
-  (interactive "P")
-  (let ((val (vip-P-val arg))
-	(com (vip-getcom arg))
-	(old-str vip-s-string))
-    (setq vip-s-forward t)
-    (vip-if-string "/")
-    ;; this is not used at present, but may be used later
-    (if (or (not (equal old-str vip-s-string))
-	    (not (markerp vip-local-search-start-marker))
-	    (not (marker-buffer vip-local-search-start-marker)))
-	(setq vip-local-search-start-marker (point-marker)))
-    (vip-search vip-s-string t val)
-    (if com
-	(progn
-	  (vip-move-marker-locally 'vip-com-point (mark t))
-	  (vip-execute-com 'vip-search-next val com)))))
-
-(defun vip-search-backward (arg)
-  "Search a string backward. 
-ARG is used to find the ARG's occurrence of the string.
-Null string will repeat previous search."
-  (interactive "P")
-  (let ((val (vip-P-val arg))
-	(com (vip-getcom arg))
-	(old-str vip-s-string))
-    (setq vip-s-forward nil)
-    (vip-if-string "?")
-    ;; this is not used at present, but may be used later
-    (if (or (not (equal old-str vip-s-string))
-	    (not (markerp vip-local-search-start-marker))
-	    (not (marker-buffer vip-local-search-start-marker)))
-	(setq vip-local-search-start-marker (point-marker)))
-    (vip-search vip-s-string nil val)
-    (if com
-	(progn
-	  (vip-move-marker-locally 'vip-com-point (mark t))
-	  (vip-execute-com 'vip-search-next val com)))))
-	  
-
-;; Search for COUNT's occurrence of STRING.
-;; Search is forward if FORWARD is non-nil, otherwise backward.
-;; INIT-POINT is the position where search is to start.
-;; Arguments:
-;;   (STRING FORW COUNT &optional NO-OFFSET INIT-POINT LIMIT FAIL-IF-NOT-FOUND)
-(defun vip-search (string forward arg
-			  &optional no-offset init-point fail-if-not-found)
-  (if (not (equal string ""))
-    (let ((val (vip-p-val arg))
-	  (com (vip-getcom arg))
-	  (offset (not no-offset))
-	  (case-fold-search vip-case-fold-search)
-	  (start-point (or init-point (point))))
-      (vip-deactivate-mark)
-      (if forward
-	  (condition-case nil
-	      (progn
-	        (if offset (vip-forward-char-carefully))
-	        (if vip-re-search
-		    (progn
-		      (re-search-forward string nil nil val)
-		      (re-search-backward string))
-		  (search-forward string nil nil val)
-		  (search-backward string))
-		(if (not (equal start-point (point)))
-		    (push-mark start-point t))) 
-	    (search-failed
-	     (if (and (not fail-if-not-found) vip-search-wrap-around-t)
-	         (progn
-		   (message "Search wrapped around BOTTOM of buffer")
-		   (goto-char (point-min))
-		   (vip-search string forward (cons 1 com) t start-point 'fail)
-		   ;; don't wait in macros
-		   (or executing-kbd-macro (sit-for 2))
-		   ;; delete the wrap-around message
-		   (message "")
-		   )
-	       (goto-char start-point)
-	       (error "`%s': %s not found"
-		      string
-		      (if vip-re-search "Pattern" "String"))
-	       )))
-	;; backward
-        (condition-case nil
-	    (progn
-	      (if vip-re-search
-		  (re-search-backward string nil nil val)
-	        (search-backward string nil nil val))
-	      (if (not (equal start-point (point)))
-		  (push-mark start-point t))) 
-	  (search-failed
-	   (if (and (not fail-if-not-found) vip-search-wrap-around-t)
-	       (progn
-		 (message "Search wrapped around TOP of buffer")
-	         (goto-char (point-max))
-	         (vip-search string forward (cons 1 com) t start-point 'fail)
-		 ;; don't wait in macros
-		 (or executing-kbd-macro (sit-for 2))
-		 ;; delete the wrap-around message
-		 (message "")
-		 )
-	     (goto-char start-point)
-	     (error "`%s': %s not found"
-		    string
-		    (if vip-re-search "Pattern" "String"))
-	     ))))
-      ;; pull up or down if at top/bottom of window
-      (vip-adjust-window)
-      ;; highlight the result of search
-      ;; don't wait and don't highlight in macros
-      (or executing-kbd-macro
-	  (vip-flash-search-pattern))
-      )))
-
-(defun vip-search-next (arg)
-  "Repeat previous search."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if (null vip-s-string) (error vip-NoPrevSearch))
-    (vip-search vip-s-string vip-s-forward arg)
-    (if com
-	(progn
-	  (vip-move-marker-locally 'vip-com-point (mark t))
-	  (vip-execute-com 'vip-search-next val com)))))
-
-(defun vip-search-Next (arg)
-  "Repeat previous search in the reverse direction."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(com (vip-getcom arg)))
-    (if (null vip-s-string) (error vip-NoPrevSearch))
-    (vip-search vip-s-string (not vip-s-forward) arg)
-    (if com
-	(progn
-	  (vip-move-marker-locally 'vip-com-point (mark t))
-	  (vip-execute-com 'vip-search-Next val com)))))
-
-
-;; Search contents of buffer defined by one of Viper's motion commands.
-;; Repeatable via `n' and `N'.
-(defun vip-buffer-search-enable (&optional c)
-  (cond (c (setq vip-buffer-search-char c))
-	((null vip-buffer-search-char)
-	 (setq vip-buffer-search-char ?g)))
-  (define-key vip-vi-basic-map
-    (char-to-string vip-buffer-search-char) 'vip-command-argument)
-  (aset vip-exec-array vip-buffer-search-char 'vip-exec-buffer-search)
-  (setq vip-prefix-commands (cons vip-buffer-search-char vip-prefix-commands)))
-
-;; This is a Viper wraper for isearch-forward.
-(defun vip-isearch-forward (arg)
-  "Do incremental search forward."
-  (interactive "P")
-  ;; emacs bug workaround
-  (if (listp arg) (setq arg (car arg)))
-  (vip-exec-form-in-emacs (list 'isearch-forward arg)))
-
-;; This is a Viper wraper for isearch-backward."
-(defun vip-isearch-backward (arg)
-  "Do incremental search backward."
-  (interactive "P")
-  ;; emacs bug workaround
-  (if (listp arg) (setq arg (car arg)))
-  (vip-exec-form-in-emacs (list 'isearch-backward arg)))
-
-
-;; visiting and killing files, buffers
-
-(defun vip-switch-to-buffer ()
-  "Switch to buffer in the current window."
-  (interactive)
-  (let (buffer)
-    (setq buffer
-	  (read-buffer
-	   (format "Switch to buffer in this window \(%s\): "
-		   (buffer-name (other-buffer (current-buffer))))))
-    (switch-to-buffer buffer)
-    ))
-
-(defun vip-switch-to-buffer-other-window ()
-  "Switch to buffer in another window."
-  (interactive)
-  (let (buffer)
-    (setq buffer
-	  (read-buffer
-	   (format "Switch to buffer in another window \(%s\): "
-		   (buffer-name (other-buffer (current-buffer))))))
-    (switch-to-buffer-other-window buffer)
-    ))
-
-(defun vip-kill-buffer ()
-  "Kill a buffer."
-  (interactive)
-  (let (buffer buffer-name)
-    (setq buffer-name
-	  (read-buffer
-	   (format "Kill buffer \(%s\): "
-		   (buffer-name (current-buffer)))))
-    (setq buffer
-	  (if (null buffer-name)
-	      (current-buffer)
-	    (get-buffer buffer-name)))
-    (if (null buffer) (error "`%s': No such buffer" buffer-name))
-    (if (or (not (buffer-modified-p buffer))
-	    (y-or-n-p 
-	     (format
-	      "Buffer `%s' is modified, are you sure you want to kill it? "
-	      buffer-name)))
-	(kill-buffer buffer)
-      (error "Buffer not killed"))))
-
-
-(defvar vip-smart-suffix-list '("" "tex" "c" "cc" "el" "p")
-  "*List of suffixes that Viper automatically tries to append to filenames ending with a `.'.
-This is useful when you the current directory contains files with the same
-prefix and many different suffixes. Usually, only one of the suffixes
-represents an editable file. However, file completion will stop at the `.'
-The smart suffix feature lets you hit RET in such a case, and Viper will
-select the appropriate suffix.
-
-Suffixes are tried in the order given and the first suffix for which a
-corresponding file exists is selected. If no file exists for any of the
-suffixes, the user is asked to confirm.
-
-To turn this feature off, set this variable to nil.")
-    
-;; Try to add suffix to files ending with a `.'
-;; Useful when the user hits RET on a non-completed file name.
-(defun vip-file-add-suffix ()
-  (let ((count 0)
-	(len (length vip-smart-suffix-list))
-	(file (buffer-string))
-	found key cmd suff)
-    (goto-char (point-max))
-    (if (and vip-smart-suffix-list (string-match "\\.$" file))
-	(progn
-	  (while (and (not found) (< count len))
-	    (setq suff (nth count vip-smart-suffix-list)
-		  count (1+ count))
-	    (if (file-exists-p (format "%s%s" file suff))
-		(progn
-		  (setq found t)
-		  (insert suff))))
-      
-	  (if found
-	      ()
-	    (vip-tmp-insert-at-eob " [Please complete file name]")
-	    (unwind-protect 
-		(while (not (memq cmd '(exit-minibuffer vip-exit-minibuffer)))
-		  (setq cmd
-			(key-binding (setq key (read-key-sequence nil))))
-		  (cond ((eq cmd 'self-insert-command)
-			 (if vip-xemacs-p
-			     (insert (events-to-keys key))
-			   (insert key)))
-			((memq cmd '(exit-minibuffer vip-exit-minibuffer))
-			 nil)
-			(t (command-execute cmd)))
-		  )))
-	      ))
-    ))
-
-
-;; Advice for use in find-file and read-file-name commands.
-(defadvice exit-minibuffer (before vip-exit-minibuffer-advice activate)
-  "Run `vip-minibuffer-exit-hook' just before exiting the minibuffer."
-  (run-hooks 'vip-minibuffer-exit-hook))
-
-(defadvice find-file (before vip-add-suffix-advice activate)
-  "Use `read-file-name' for reading arguments."
-  (interactive (list (read-file-name "Find file: "
-				     nil default-directory))))
-    
-(defadvice find-file-other-window (before vip-add-suffix-advice activate)
-  "Use `read-file-name' for reading arguments."
-  (interactive (list (read-file-name "Find file in other window: "
-				     nil default-directory))))
-    
-(defadvice find-file-other-frame (before vip-add-suffix-advice activate)
-  "Use `read-file-name' for reading arguments."
-  (interactive (list (read-file-name "Find file in other frame: "
-				     nil default-directory))))
-
-(defadvice read-file-name (around vip-suffix-advice activate)
-  "Tell `exit-minibuffer' to run `vip-file-add-suffix' as a hook."
-  (let ((vip-minibuffer-exit-hook 'vip-file-add-suffix))
-    ad-do-it))
-
-     
-
-;; yank and pop
-
-(defsubst vip-yank (text)
-  "Yank TEXT silently. This works correctly with Emacs's yank-pop command."
-    (insert text)
-    (setq this-command 'yank))
-
-(defun vip-put-back (arg)
-  "Put back after point/below line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(text (if vip-use-register
-		  (cond ((vip-valid-register vip-use-register '(digit))
-			 (current-kill (- vip-use-register ?1) 'do-not-rotate))
-			((vip-valid-register vip-use-register)
-			 (get-register (downcase vip-use-register)))
-			(t (error vip-InvalidRegister vip-use-register)))
-		(current-kill 0))))
-    (if (null text)
-	(if vip-use-register
-	    (let ((reg vip-use-register))
-	      (setq vip-use-register nil)
-	      (error vip-EmptyRegister reg))
-	  (error "")))
-    (setq vip-use-register nil)
-    (if (vip-end-with-a-newline-p text)
-	(progn
-	  (end-of-line)
-	  (if (eobp)
-	      (insert "\n")
-	    (forward-line 1))
-	  (beginning-of-line))
-      (if (not (eolp)) (vip-forward-char-carefully)))
-    (set-marker (vip-mark-marker) (point) (current-buffer))
-    (vip-set-destructive-command
-     (list 'vip-put-back val nil vip-use-register nil nil))
-    (vip-loop val (vip-yank text)))
-  ;; Vi puts cursor on the last char when the yanked text doesn't contain a
-  ;; newline; it leaves the cursor at the beginning when the text contains 
-  ;; a newline
-  (if (vip-same-line (point) (mark))
-      (or (= (point) (mark)) (vip-backward-char-carefully))
-    (exchange-point-and-mark)
-    (if (bolp)
-	(back-to-indentation)))
-  (vip-deactivate-mark))
-
-(defun vip-Put-back (arg)
-  "Put back at point/above line."
-  (interactive "P")
-  (let ((val (vip-p-val arg))
-	(text (if vip-use-register
-		  (cond ((vip-valid-register vip-use-register '(digit))
-			 (current-kill (- vip-use-register ?1) 'do-not-rotate))
-			((vip-valid-register vip-use-register)
-			 (get-register (downcase vip-use-register)))
-			(t (error vip-InvalidRegister vip-use-register)))
-		(current-kill 0))))
-    (if (null text)
-	(if vip-use-register
-	    (let ((reg vip-use-register))
-	      (setq vip-use-register nil)
-	      (error vip-EmptyRegister reg))
-	  (error "")))
-    (setq vip-use-register nil)
-    (if (vip-end-with-a-newline-p text) (beginning-of-line))
-    (vip-set-destructive-command
-     (list 'vip-Put-back val nil vip-use-register nil nil))
-    (set-marker (vip-mark-marker) (point) (current-buffer))
-    (vip-loop val (vip-yank text)))
-  ;; Vi puts cursor on the last char when the yanked text doesn't contain a
-  ;; newline; it leaves the cursor at the beginning when the text contains 
-  ;; a newline
-  (if (vip-same-line (point) (mark))
-      (or (= (point) (mark)) (vip-backward-char-carefully))
-    (exchange-point-and-mark)
-    (if (bolp)
-	(back-to-indentation)))
-  (vip-deactivate-mark))
-    
-
-;; Copy region to kill-ring.
-;; If BEG and END do not belong to the same buffer, copy empty region.
-(defun vip-copy-region-as-kill (beg end)
-  (condition-case nil
-      (copy-region-as-kill beg end)
-    (error (copy-region-as-kill beg beg))))
-    
-
-(defun vip-delete-char (arg)
-  "Delete character."
-  (interactive "P")
-  (let ((val (vip-p-val arg)))
-    (vip-set-destructive-command (list 'vip-delete-char val nil nil nil nil))
-    (if (> val 1)
-	(save-excursion
-	  (let ((here (point)))
-	    (end-of-line)
-	    (if (> val (- (point) here))
-		(setq val (- (point) here))))))
-    (if (and (eq val 0) (not vip-ex-style-motion)) (setq val 1))
-    (if (and vip-ex-style-motion (eolp))
-	(if (bolp) (error "") (setq val 0))) ; not bol---simply back 1 ch
-    (if vip-use-register
-	(progn
-	  (cond ((vip-valid-register vip-use-register '((Letter)))
-		 (vip-append-to-register
-		  (downcase vip-use-register) (point) (- (point) val)))
-		((vip-valid-register vip-use-register)
-		 (copy-to-register
-		  vip-use-register (point) (- (point) val) nil))
-		(t (error vip-InvalidRegister vip-use-register)))
-	  (setq vip-use-register nil)))
-    (if vip-ex-style-motion
-	(progn
-	  (delete-char val t)
-	  (if (and (eolp) (not (bolp))) (backward-char 1)))
-      (if (eolp)
-          (delete-backward-char val t)
-        (delete-char val t)))))
-
-(defun vip-delete-backward-char (arg)
-  "Delete previous character. On reaching beginning of line, stop and beep."
-  (interactive "P")
-  (let ((val (vip-p-val arg)))
-    (vip-set-destructive-command
-     (list 'vip-delete-backward-char val nil nil nil nil))
-    (if (> val 1)
-	(save-excursion
-	  (let ((here (point)))
-	    (beginning-of-line)
-	    (if (> val (- here (point)))
-		(setq val (- here (point)))))))
-    (if vip-use-register
-	(progn
-	  (cond ((vip-valid-register vip-use-register '(Letter))
-		 (vip-append-to-register
-		  (downcase vip-use-register) (point) (+ (point) val)))
-		((vip-valid-register vip-use-register)
-		 (copy-to-register
-		  vip-use-register (point) (+ (point) val) nil))
-		(t (error vip-InvalidRegister vip-use-register)))
-	  (setq vip-use-register nil)))
-    (if (bolp) (ding)
-      (delete-backward-char val t))))
-      
-(defun vip-del-backward-char-in-insert ()
-  "Delete 1 char backwards while in insert mode."
-  (interactive)      
-  (if (and vip-ex-style-editing-in-insert (bolp))
-      (beep 1)
-    (delete-backward-char 1 t)))
-      
-(defun vip-del-backward-char-in-replace ()
-  "Delete one character in replace mode.
-If `vip-delete-backwards-in-replace' is t, then DEL key actually deletes
-charecters. If it is nil, then the cursor just moves backwards, similarly
-to Vi. The variable `vip-ex-style-editing-in-insert', if t, doesn't let the
-cursor move past the beginning of line."
-  (interactive)
-  (cond (vip-delete-backwards-in-replace
-	 (cond ((not (bolp))
-		(delete-backward-char 1 t))
-	       (vip-ex-style-editing-in-insert
-		(beep 1))
-	       ((bobp)
-		(beep 1))
-	       (t
-		(delete-backward-char 1 t))))
-	(vip-ex-style-editing-in-insert
-	 (if (bolp)
-	     (beep 1)
-	   (backward-char 1)))
-	(t 
-	 (backward-char 1))))
-
-
-
-;; join lines.
-
-(defun vip-join-lines (arg)
-  "Join this line to next, if ARG is nil.  Otherwise, join ARG lines."
-  (interactive "*P")
-  (let ((val (vip-P-val arg)))
-    (vip-set-destructive-command (list 'vip-join-lines val nil nil nil nil))
-    (vip-loop (if (null val) 1 (1- val))
-	      (progn
-		(end-of-line)
-		(if (not (eobp))
-		    (progn
-		      (forward-line 1)
-		      (delete-region (point) (1- (point)))
-		      (fixup-whitespace)))))))
-
-
-;; Replace state
-
-(defun vip-change (beg end)
-  (if (markerp beg) (setq beg (marker-position beg)))
-  (if (markerp end) (setq end (marker-position end)))
-  ;; beg is sometimes (mark t), which may be nil
-  (or beg (setq beg end))
-  
-  (vip-set-complex-command-for-undo)
-  (if vip-use-register
-      (progn
-	(copy-to-register vip-use-register beg end nil)
-	(setq vip-use-register nil)))
-  (vip-set-replace-overlay beg end)
-  (setq last-command nil) ; separate repl text from prev kills
-  
-  (if (= (vip-replace-start) (point-max))
-      (error "End of buffer"))
-      
-  (setq vip-last-replace-region
-	(buffer-substring (vip-replace-start)
-			  (vip-replace-end)))
-  
-  ;; protect against error while inserting "@" and other disasters
-  ;; (e.g., read-only buff)
-  (condition-case conds
-      (if (vip-same-line (vip-replace-start)
-			 (vip-replace-end))
-	  (progn
-	    ;; tabs cause problems in replace, so untabify
-	    (goto-char (vip-replace-end))
-	    (insert-before-markers "@") ; put placeholder after the TAB
-	    (untabify (vip-replace-start) (point))
-	    ;; del @, don't put on kill ring 
-	    (delete-backward-char 1)
-	    
-	    (vip-set-replace-overlay-glyphs
-	     vip-replace-region-start-delimiter
-	     vip-replace-region-end-delimiter)
-	    ;; this move takes care of the last posn in the overlay, which
-	    ;; has to be shifted because of insert. We can't simply insert
-	    ;; "$" before-markers because then overlay-start will shift the
-	    ;; beginning of the overlay in case we are replacing a single
-	    ;; character. This fixes the bug with `s' and `cl' commands.
-	    (vip-move-replace-overlay (vip-replace-start) (point))
-	    (goto-char (vip-replace-start))
-	    (vip-change-state-to-replace t))
-	(kill-region (vip-replace-start)
-		     (vip-replace-end))
-	(vip-hide-replace-overlay)
-	(vip-change-state-to-insert))
-    (error ;; make sure that the overlay doesn't stay.
-           ;; go back to the original point
-     (goto-char (vip-replace-start))
-     (vip-hide-replace-overlay)
-     (vip-message-conditions conds))))
-
-
-(defun vip-change-subr (beg end)
-  ;; beg is sometimes (mark t), which may be nil
-  (or beg (setq beg end))
-  
-  (if vip-use-register
-      (progn
-	(copy-to-register vip-use-register beg end nil)
-	(setq vip-use-register nil)))
-  (kill-region beg end)
-  (setq this-command 'vip-change)
-  (vip-yank-last-insertion))
-
-(defun vip-toggle-case (arg)
-  "Toggle character case."
-  (interactive "P")
-  (let ((val (vip-p-val arg)) (c))
-    (vip-set-destructive-command (list 'vip-toggle-case val nil nil nil nil))
-    (while (> val 0)
-      (setq c (following-char))
-      (delete-char 1 nil)
-      (if (eq c (upcase c))
-	  (insert-char (downcase c) 1)
-	(insert-char (upcase c) 1))
-      (if (eolp) (backward-char 1))
-      (setq val (1- val)))))
-
-
-;; query replace
-
-(defun vip-query-replace ()
-  "Query replace. 
-If a null string is suplied as the string to be replaced,
-the query replace mode will toggle between string replace
-and regexp replace."
-  (interactive)
-  (let (str)
-    (setq str (vip-read-string-with-history
-	       (if vip-re-query-replace "Query replace regexp: "
-		 "Query replace: ")
-	       nil  ; no initial
-	       'vip-replace1-history
-	       (car vip-replace1-history) ; default
-	       ))
-    (if (string= str "")
-	(progn
-	  (setq vip-re-query-replace (not vip-re-query-replace))
-	  (message "Query replace mode changed to %s"
-		   (if vip-re-query-replace "regexp replace"
-		     "string replace")))
-      (if vip-re-query-replace
-	  (query-replace-regexp
-	   str
-	   (vip-read-string-with-history
-	    (format "Query replace regexp `%s' with: " str)
-	    nil  ; no initial
-	    'vip-replace1-history
-	    (car vip-replace1-history) ; default
-	    ))
-	(query-replace
-	 str
-	 (vip-read-string-with-history
-	  (format "Query replace `%s' with: " str)
-	  nil  ; no initial
-	  'vip-replace1-history
-	  (car vip-replace1-history) ; default
-	  ))))))
-
-
-;; marking
-
-(defun vip-mark-beginning-of-buffer ()
-  "Mark beginning of buffer."
-  (interactive)
-  (push-mark (point))
-  (goto-char (point-min))
-  (exchange-point-and-mark)
-  (message "Mark set at the beginning of buffer"))
-
-(defun vip-mark-end-of-buffer ()
-  "Mark end of buffer."
-  (interactive)
-  (push-mark (point))
-  (goto-char (point-max))
-  (exchange-point-and-mark)
-  (message "Mark set at the end of buffer"))
-
-(defun vip-mark-point ()
-  "Set mark at point of buffer."
-  (interactive)
-  (let ((char (vip-read-char-exclusive)))
-  (cond ((and (<= ?a char) (<= char ?z))
-	 (point-to-register (1+ (- char ?a))))
-	((= char ?<) (vip-mark-beginning-of-buffer))
-	((= char ?>) (vip-mark-end-of-buffer))
-	((= char ?.) (vip-set-mark-if-necessary))
-	((= char ?,) (vip-cycle-through-mark-ring))
-	((= char ?D) (mark-defun))
-	(t (error ""))
-	)))
-	
-;; Algorithm: If first invocation of this command save mark on ring, goto
-;; mark, M0, and pop the most recent elt from the mark ring into mark,
-;; making it into the new mark, M1.
-;; Push this mark back and set mark to the original point position, p1.
-;; So, if you hit '' or `` then you can return to p1.
-;;
-;; If repeated command, pop top elt from the ring into mark and
-;; jump there. This forgets the position, p1, and puts M1 back into mark.
-;; Then we save the current pos, which is M0, jump to M1 and pop M2 from
-;; the ring into mark.  Push M2 back on the ring and set mark to M0.
-;; etc.
-(defun vip-cycle-through-mark-ring ()
-  "Visit previous locations on the mark ring.
-One can use `` and '' to temporarily jump 1 step back."
-  (let* ((sv-pt (point)))
-       ;; if repeated `m,' command, pop the previously saved mark.
-       ;; Prev saved mark is actually prev saved point. It is used if the
-       ;; user types `` or '' and is discarded 
-       ;; from the mark ring by the next `m,' command. 
-       ;; In any case, go to the previous or previously saved mark.
-       ;; Then push the current mark (popped off the ring) and set current
-       ;; point to be the mark. Current pt as mark is discarded by the next
-       ;; m, command.
-       (if (eq last-command 'vip-cycle-through-mark-ring)
-	   ()
-	 ;; save current mark if the first iteration
-	 (setq mark-ring (delete (vip-mark-marker) mark-ring))
-	 (if (mark t)
-	     (push-mark (mark t) t)) )
-       (pop-mark)
-       (set-mark-command 1)
-       ;; don't duplicate mark on the ring
-       (setq mark-ring (delete (vip-mark-marker) mark-ring))
-       (push-mark sv-pt t)
-       (vip-deactivate-mark)
-       (setq this-command 'vip-cycle-through-mark-ring)
-       ))
-       
-
-(defun vip-goto-mark (arg)
-  "Go to mark."
-  (interactive "P")
-  (let ((char (read-char))
-	(com (vip-getcom arg)))
-    (vip-goto-mark-subr char com nil)))
-
-(defun vip-goto-mark-and-skip-white (arg)
-  "Go to mark and skip to first non-white character on line."
-  (interactive "P")
-  (let ((char (read-char))
-	(com (vip-getCom arg)))
-    (vip-goto-mark-subr char com t)))
-
-(defun vip-goto-mark-subr (char com skip-white)
-  (if (eobp) 
-      (if (bobp)
-	  (error "Empty buffer")
-	(backward-char 1)))
-  (cond ((vip-valid-register char '(letter))
-	 (let* ((buff (current-buffer))
-	        (reg (1+ (- char ?a)))
-	        (text-marker (get-register reg)))
-	   (if com (vip-move-marker-locally 'vip-com-point (point)))
-	   (if (not (vip-valid-marker text-marker))
-	       (error vip-EmptyTextmarker char))
-	   (if (and (vip-same-line (point) vip-last-jump)
-		    (= (point) vip-last-jump-ignore))
-	       (push-mark vip-last-jump t) 
-	     (push-mark nil t)) ; no msg
-	   (vip-register-to-point reg)
-	   (setq vip-last-jump (point-marker))
-	   (cond (skip-white 
-		  (back-to-indentation)
-		  (setq vip-last-jump-ignore (point))))
-	   (if com
-	       (if (equal buff (current-buffer))
-		   (vip-execute-com (if skip-white
-					'vip-goto-mark-and-skip-white
-				      'vip-goto-mark)
-				    nil com)
-		 (switch-to-buffer buff)
-		 (goto-char vip-com-point)
-		 (vip-change-state-to-vi)
-		 (error "")))))
-	((and (not skip-white) (= char ?`))
-	 (if com (vip-move-marker-locally 'vip-com-point (point)))
-	 (if (and (vip-same-line (point) vip-last-jump)
-		  (= (point) vip-last-jump-ignore))
-	     (goto-char vip-last-jump))
-	 (if (null (mark t)) (error "Mark is not set in this buffer"))
-	 (if (= (point) (mark t)) (pop-mark))
-	 (exchange-point-and-mark)
-	 (setq vip-last-jump (point-marker)
-	       vip-last-jump-ignore 0)
-	 (if com (vip-execute-com 'vip-goto-mark nil com)))
-	((and skip-white (= char ?'))
-	 (if com (vip-move-marker-locally 'vip-com-point (point)))
-	 (if (and (vip-same-line (point) vip-last-jump)
-		  (= (point) vip-last-jump-ignore))
-	     (goto-char vip-last-jump))
-	 (if (= (point) (mark t)) (pop-mark))
-	 (exchange-point-and-mark)
-	 (setq vip-last-jump (point))
-	 (back-to-indentation)
-	 (setq vip-last-jump-ignore (point))
-	 (if com (vip-execute-com 'vip-goto-mark-and-skip-white nil com)))
-	(t (error vip-InvalidTextmarker char))))
-	
-(defun vip-insert-tab ()
-  (interactive)
-  (insert-tab))
-
-(defun vip-exchange-point-and-mark ()
-  (interactive)
-  (exchange-point-and-mark)
-  (back-to-indentation))
-
-;; Input Mode Indentation
-
-;; Returns t, if the string before point matches the regexp STR.
-(defsubst vip-looking-back (str)
-  (and (save-excursion (re-search-backward str nil t))
-       (= (point) (match-end 0))))
-
-
-(defun vip-forward-indent ()
-  "Indent forward -- `C-t' in Vi."
-  (interactive)
-  (setq vip-cted t)
-  (indent-to (+ (current-column) vip-shift-width)))
-
-(defun vip-backward-indent ()
-  "Backtab, C-d in VI"
-  (interactive)
-  (if vip-cted
-      (let ((p (point)) (c (current-column)) bol (indent t))
-	(if (vip-looking-back "[0^]")
-	    (progn
-	      (if (eq ?^ (preceding-char))
-		  (setq vip-preserve-indent t))
-	      (delete-backward-char 1)
-	      (setq p (point))
-	      (setq indent nil)))
-	(save-excursion
-	  (beginning-of-line)
-	  (setq bol (point)))
-	(if (re-search-backward "[^ \t]" bol 1) (forward-char))
-	(delete-region (point) p)
-	(if indent
-	    (indent-to (- c vip-shift-width)))
-	(if (or (bolp) (vip-looking-back "[^ \t]"))
-	    (setq vip-cted nil)))))
-
-(defun vip-autoindent ()
-  "Auto Indentation, Vi-style."
-  (interactive)
-  (let ((col (current-indentation)))
-    (if vip-preserve-indent
-	(setq vip-preserve-indent nil)
-      (setq vip-current-indent col))
-    ;; don't leave whitespace lines around
-    (if (memq last-command
-	      '(vip-autoindent
-		vip-open-line vip-Open-line
-		vip-replace-state-exit-cmd))
-	(indent-to-left-margin))
-    ;; use \n instead of newline, or else <Return> will move the insert point
-    ;;(newline 1)
-    (insert "\n")
-    (if vip-auto-indent
-	(progn
-	  (setq vip-cted t)
-	  (if vip-electric-mode
-	      (indent-according-to-mode)
-	    (indent-to vip-current-indent))
-	  ))
-    ))
-
-	   
-;; Viewing registers
-
-(defun vip-ket-function (arg)
-  "Function called by \], the ket. View registers and call \]\]."
-  (interactive "P")
-  (let ((reg (read-char)))
-    (cond ((vip-valid-register reg '(letter Letter))
-	   (view-register (downcase reg)))
-	  ((vip-valid-register reg '(digit))
-	   (let ((text (current-kill (- reg ?1) 'do-not-rotate)))
-	     (save-excursion 
-	       (set-buffer (get-buffer-create "*Output*"))
-	       (delete-region (point-min) (point-max))
-	       (insert (format "Register %c contains the string:\n" reg))
-	       (insert text)
-	       (goto-char (point-min)))
-	     (display-buffer "*Output*")))
-	  ((= ?\] reg)
-	   (vip-next-heading arg))
-	  (t (error
-	      vip-InvalidRegister reg)))))
-
-(defun vip-brac-function (arg)
-  "Function called by \[, the brac. View textmarkers and call \[\["
-  (interactive "P")
-  (let ((reg (read-char)))
-    (cond ((= ?\[ reg)
-	   (vip-prev-heading arg))
-	  ((= ?\] reg)
-	   (vip-heading-end arg))
-	  ((vip-valid-register reg '(letter))
-	   (let* ((val (get-register (1+ (- reg ?a))))
-		  (buf (if (not val) 
-			   (error vip-EmptyTextmarker reg)
-			 (marker-buffer val)))
-		  (pos (marker-position val))
-		  line-no text (s pos) (e pos))
-	     (save-excursion 
-	       (set-buffer (get-buffer-create "*Output*"))
-	       (delete-region (point-min) (point-max))
-	       (if (and buf pos)
-		   (progn
-		     (save-excursion 
-		       (set-buffer buf)
-		       (setq line-no (1+ (count-lines (point-min) val)))
-		       (goto-char pos)
-		       (beginning-of-line)
-		       (if (re-search-backward "[^ \t]" nil t)
-			   (progn
-			     (beginning-of-line)
-			     (setq s (point))))
-		       (goto-char pos)
-		       (forward-line 1)
-		       (if (re-search-forward "[^ \t]" nil t)
-			   (progn
-			     (end-of-line)
-			     (setq e (point))))
-		       (setq text (buffer-substring s e))
-		       (setq text (format "%s<%c>%s" 
-					  (substring text 0 (- pos s)) 
-					  reg (substring text (- pos s)))))
-		     (insert
-		      (format
-		       "Textmarker `%c' is in buffer `%s' at line %d.\n"
-				     reg (buffer-name buf) line-no))
-		     (insert (format "Here is some text around %c:\n\n %s" 
-				     reg text)))
-		 (insert (format vip-EmptyTextmarker reg)))
-	       (goto-char (point-min)))
-	     (display-buffer "*Output*")))
-	  (t (error vip-InvalidTextmarker reg)))))
-  
-
-
-;; commands in insertion mode
-
-(defun vip-delete-backward-word (arg)
-  "Delete previous word."
-  (interactive "p")
-  (save-excursion
-    (push-mark nil t)
-    (backward-word arg)
-    (delete-region (point) (mark t))
-    (pop-mark)))
-
-
-(defun vip-set-expert-level (&optional dont-change-unless)
-  "Sets the expert level for a Viper user.
-Can be called interactively to change (temporarily or permanently) the
-current expert level.
-
-The optional argument DONT-CHANGE-UNLESS if not nil, says that
-the level should not be changed, unless its current value is
-meaningless (i.e., not one of 1,2,3,4,5).
-
-User level determines the setting of Viper variables that are most
-sensitive for VI-style look-and-feel."
-  
-  (interactive)
-  
-  (if (not (natnump vip-expert-level)) (setq vip-expert-level 0))
-  
-  (save-window-excursion
-    (delete-other-windows)
-    ;; if 0 < vip-expert-level < vip-max-expert-level
-    ;;    & dont-change-unless = t -- use it; else ask
-    (vip-ask-level dont-change-unless))
-  
-  (setq vip-always          	    	t
-	vip-ex-style-motion 	    	t
-	vip-ex-style-editing-in-insert  t
-	vip-want-ctl-h-help nil)
-
-  (cond ((eq vip-expert-level 1) ; novice or beginner
-	 (global-set-key   ; in emacs-state 
-	  vip-toggle-key
-	  (if (vip-window-display-p) 'vip-iconify 'suspend-emacs))
-	 (setq vip-no-multiple-ESC	     t
-	       vip-re-search	    	     t
-	       vip-vi-style-in-minibuffer    t
-	       vip-search-wrap-around-t	     t
-	       vip-want-emacs-keys-in-vi     nil
-	       vip-want-emacs-keys-in-insert nil))
-	
-	((and (> vip-expert-level 1) (< vip-expert-level 5))
-	 ;; intermediate to guru
-	 (setq vip-no-multiple-ESC     (if (vip-window-display-p) t 'twice)
-	       vip-want-emacs-keys-in-vi     t
-	       vip-want-emacs-keys-in-insert (> vip-expert-level 2))
-
-	 (if (eq vip-expert-level 4) ; respect user's ex-style motions
-	     	    	    	     ; and vip-no-multiple-ESC
-	     (progn
-	       (setq-default vip-ex-style-editing-in-insert
-			     (cdr (assoc 'vip-ex-style-editing-in-insert
-					 vip-saved-user-settings))
-			     vip-ex-style-motion
-			     (cdr (assoc 'vip-ex-style-motion
-					 vip-saved-user-settings)))
-	       (setq vip-ex-style-motion 
-		     (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings))
-		     vip-ex-style-editing-in-insert
-		     (cdr (assoc 'vip-ex-style-editing-in-insert
-				 vip-saved-user-settings))
-		     vip-re-search
-		     (cdr (assoc 'vip-re-search vip-saved-user-settings))
-		     vip-no-multiple-ESC 
-		     (cdr (assoc 'vip-no-multiple-ESC
-				 vip-saved-user-settings))))))
-	       
-	;; A wizard!!
-	;; Ideally, if 5 is selected, a buffer should pop up to let the
-	;; user toggle the values of variables.
-	(t (setq-default vip-ex-style-editing-in-insert
-			 (cdr (assoc 'vip-ex-style-editing-in-insert
-				     vip-saved-user-settings))
-			 vip-ex-style-motion
-			 (cdr (assoc 'vip-ex-style-motion
-				     vip-saved-user-settings)))
-	   (setq  vip-want-ctl-h-help 
-		  (cdr (assoc 'vip-want-ctl-h-help vip-saved-user-settings))
-		  vip-always
-		  (cdr (assoc 'vip-always vip-saved-user-settings))
-		  vip-no-multiple-ESC 
-		  (cdr (assoc 'vip-no-multiple-ESC vip-saved-user-settings))
-		  vip-ex-style-motion 
-		  (cdr (assoc 'vip-ex-style-motion vip-saved-user-settings))
-		  vip-ex-style-editing-in-insert
-		  (cdr (assoc 'vip-ex-style-editing-in-insert
-			      vip-saved-user-settings))
-		  vip-re-search
-		  (cdr (assoc 'vip-re-search vip-saved-user-settings))
-		  vip-want-emacs-keys-in-vi 
-		  (cdr (assoc 'vip-want-emacs-keys-in-vi
-			      vip-saved-user-settings))
-		  vip-want-emacs-keys-in-insert
-		  (cdr (assoc 'vip-want-emacs-keys-in-insert
-			      vip-saved-user-settings)))))
-  (vip-set-mode-vars-for vip-current-state)
-  (if (or vip-always
-	  (and (> vip-expert-level 0) (> 5 vip-expert-level)))
-      (vip-set-hooks)))
-
-;; Ask user expert level.
-(defun vip-ask-level (dont-change-unless)
-  (let ((ask-buffer " *vip-ask-level*")
-	level-changed repeated)
-    (save-window-excursion
-      (switch-to-buffer ask-buffer)
-	      
-      (or (eq this-command 'vip-set-expert-level)
-	  (and
-	   (<= vip-expert-level vip-max-expert-level)
-	   (>= vip-expert-level 1))
-	  (progn
-	    (insert "
-	      
-	      *** Important Notice for VIP users***
-	      
-			  This is VIPER
-	      
-@joke
-Viper Is a Package for Emacs Rebels,
-a VI Plan for Emacs Rescue,
-and a venomous VI PERil.
-@end joke
-
-Technically speaking, Viper is a new Vi emulator that replaces
-the old VIP package.
-
-Viper emulates Vi much better than VIP.  It also significantly
-extends and improves upon Vi in many useful ways.
-
-Although many VIP settings in your ~/.vip are compatible with Viper,
-you may have to change some of them. Please refer to the documentation,
-which can be obtained by executing
-
-:help
-
-when Viper is in Vi state.
-
-If you will be so lucky as to find a bug, report it via the command
-
-:submitReport
-
-Type any key to continue... ")
-	    
-	    (read-char)
-	    (erase-buffer)))
-	      
-      (while (or (> vip-expert-level vip-max-expert-level)
-		 (< vip-expert-level 1)
-		 (null dont-change-unless))
-	(erase-buffer)
-	(if repeated
-	    (progn
-	      (message "Invalid user level")
-	      (beep 1))
-	  (setq repeated t))
-	(setq dont-change-unless t
-	      level-changed t)
-	(insert "
-Please specify your level of familiarity with the venomous VI PERil
-(and the VI Plan for Emacs Rescue).
-You can change it at any time by typing `M-x vip-set-expert-level RET'
-	
- 1 -- BEGINNER: Almost all Emacs features are suppressed.
-          Feels almost like straight Vi. File name completion and
-          command history in the minibuffer are thrown in as a bonus. 
-          To use Emacs productively, you must reach level 3 or higher.
- 2 -- MASTER: C-c now has its standard Emacs meaning in Vi command state,
-	  so most Emacs commands can be used when Viper is in Vi state.
-	  Good progress---you are well on the way to level 3!
- 3 -- GRAND MASTER: Like 3, but most Emacs commands are available also
-          in Viper's insert state.
- 4 -- GURU: Like 3, but user settings are respected for vip-no-multiple-ESC,
-	  vip-re-search, vip-ex-style-motion, & vip-ex-style-editing-in-insert
-	  variables. Adjust these settings to your taste.
- 5 -- WIZARD: Like 4, but user settings are also respected for vip-always,
-	  vip-want-ctl-h-help, vip-want-emacs-keys-in-vi, and 
-	  vip-want-emacs-keys-in-insert. Adjust these to your taste.
-      
-Please, specify your level now: ")
-	  
-	(setq vip-expert-level (- (vip-read-char-exclusive) ?0))
-	) ; end while
-      
-      ;; tell the user if level was changed
-      (and level-changed
-	   (progn
-	     (insert
-	      (format "\n\n\n\n\n\t\tYou have selected user level %d"
-		      vip-expert-level))
-	     (if (y-or-n-p "Do you wish to make this change permanent? ")
-		 ;; save the setting for vip-expert-level
-		 (vip-save-setting
-		  'vip-expert-level
-		  (format "Saving user level %d ..." vip-expert-level)
-		  vip-custom-file-name))
-	     ))
-      (bury-buffer) ; remove ask-buffer from screen
-      (message "")
-      )))
-
-
-(defun viper-version ()
-  (interactive)
-  (message "Viper version is %s" viper-version)) 
-  
-(defalias 'vip-version 'viper-version)
-
-(defun vip-nil ()
-  (interactive)
-  (beep 1))
-  
-    
-;; if ENFORCE-BUFFER is not nil, error if CHAR is a marker in another buffer
-(defun vip-register-to-point (char &optional enforce-buffer)
-  "Like jump-to-register, but switches to another buffer in another window."
-  (interactive "cViper register to point: ")
-  (let ((val (get-register char)))
-    (cond
-     ((and (fboundp 'frame-configuration-p)
-	   (frame-configuration-p val))
-      (set-frame-configuration val))
-     ((window-configuration-p val)
-      (set-window-configuration val))
-     ((vip-valid-marker val)
-      (if (and enforce-buffer
-	       (not (equal (current-buffer) (marker-buffer val))))
-	  (error (concat vip-EmptyTextmarker " in this buffer")
-		 (1- (+ char ?a))))
-      (pop-to-buffer  (marker-buffer val))
-      (goto-char val))
-     ((and (consp val) (eq (car val) 'file))
-      (find-file (cdr val)))
-     (t
-      (error vip-EmptyTextmarker (1- (+ char ?a)))))))
-
-
-(defun vip-save-kill-buffer ()
-  "Save then kill current buffer. "
-  (interactive)
-  (if (< vip-expert-level 2)
-      (save-buffers-kill-emacs)
-    (save-buffer)
-    (kill-buffer (current-buffer))))
-
-
-
-;;; Bug Report
-
-(defun vip-submit-report ()
-  "Submit bug report on Viper."
-  (interactive)
-  (let ((reporter-prompt-for-summary-p t)
-	(vip-device-type (vip-device-type))
-	color-display-p frame-parameters
-	minibuffer-emacs-face minibuffer-vi-face minibuffer-insert-face
-	varlist salutation window-config)
-    
-    ;; If mode info is needed, add variable to `let' and then set it below,
-    ;; like we did with color-display-p.
-    (setq color-display-p (if (vip-window-display-p) 
-			      (vip-color-display-p)
-			    'non-x)
-	  minibuffer-vi-face (if (vip-has-face-support-p)
-				 (vip-get-face vip-minibuffer-vi-face)
-			       'non-x)
-	  minibuffer-insert-face (if (vip-has-face-support-p)
-				     (vip-get-face vip-minibuffer-insert-face)
-				   'non-x)
-	  minibuffer-emacs-face (if (vip-has-face-support-p)
-				    (vip-get-face vip-minibuffer-emacs-face)
-				  'non-x)
-	  frame-parameters (if (fboundp 'frame-parameters)
-			       (frame-parameters (selected-frame))))
-    
-    (setq varlist (list 'vip-vi-minibuffer-minor-mode
-		        'vip-insert-minibuffer-minor-mode
-		        'vip-vi-intercept-minor-mode
-		        'vip-vi-local-user-minor-mode     
-		        'vip-vi-kbd-minor-mode        	
-		        'vip-vi-global-user-minor-mode
-		        'vip-vi-state-modifier-minor-mode
-		        'vip-vi-diehard-minor-mode   
-		        'vip-vi-basic-minor-mode    
-		        'vip-replace-minor-mode 	  
-		        'vip-insert-intercept-minor-mode
-		        'vip-insert-local-user-minor-mode 
-		        'vip-insert-kbd-minor-mode     	
-		        'vip-insert-global-user-minor-mode
-		        'vip-insert-state-modifier-minor-mode
-		        'vip-insert-diehard-minor-mode 	
-		        'vip-insert-basic-minor-mode   
-		        'vip-emacs-intercept-minor-mode 
-		        'vip-emacs-local-user-minor-mode 
-		        'vip-emacs-kbd-minor-mode 
-		        'vip-emacs-global-user-minor-mode
-		        'vip-emacs-state-modifier-minor-mode
-		        'vip-automatic-iso-accents
-		        'vip-want-emacs-keys-in-insert
-		        'vip-want-emacs-keys-in-vi
-		        'vip-keep-point-on-undo
-		        'vip-no-multiple-ESC
-		        'vip-ESC-key
-		        'vip-want-ctl-h-help
-		        'vip-ex-style-editing-in-insert
-		        'vip-delete-backwards-in-replace
-		        'vip-vi-style-in-minibuffer
-		        'vip-vi-state-hook
-		        'vip-insert-state-hook
-		        'vip-replace-state-hook
-		        'vip-emacs-state-hook
-		        'ex-cycle-other-window
-		        'ex-cycle-through-non-files
-		        'vip-expert-level
-		        'major-mode
-		        'vip-device-type
-			'color-display-p
-			'frame-parameters
-			'minibuffer-vi-face
-			'minibuffer-insert-face
-			'minibuffer-emacs-face
-			))
-	  (setq salutation "
-Congratulations! You may have unearthed a bug in Viper!
-Please mail a concise, accurate summary of the problem to the address above.
-
--------------------------------------------------------------------")
-	  (setq window-config (current-window-configuration))
-	  (with-output-to-temp-buffer " *vip-info*"
-	    (switch-to-buffer " *vip-info*")
-	    (delete-other-windows)
-	    (princ "
-PLEASE FOLLOW THESE PROCEDURES
-------------------------------
-
-Before reporting a bug, please verify that it is related to Viper, and is
-not cause by other packages you are using.
-
-Don't report compilation warnings, unless you are certain that there is a
-problem. These warnings are normal and unavoidable.
-
-Please note that users should not modify variables and keymaps other than
-those advertised in the manual. Such `customization' is likely to crash
-Viper, as it would any other improperly customized Emacs package.
-
-If you are reporting an error message received while executing one of the
-Viper commands, type:
-
-    M-x set-variable <Return> debug-on-error <Return> t <Return>
-	
-Then reproduce the error. The above command will cause Emacs to produce a
-back trace of the execution that leads to the error. Please include this
-trace in your bug report.
-
-If you believe that one of Viper's commands goes into an infinite loop
-\(e.g., Emacs freezes\), type:
-
-    M-x set-variable <Return> debug-on-quit <Return> t <Return>
-	
-Then reproduce the problem. Wait for a few seconds, then type C-g to abort
-the current command. Include the resulting back trace in the bug report.
-
-Mail anyway (y or n)? ")
-	    (if (y-or-n-p "Mail anyway? ")
-		()
-	      (set-window-configuration window-config)
-	      (error "Bug report aborted")))
-
-	  (require 'reporter)
-	  (set-window-configuration window-config)
-    
-	  (reporter-submit-bug-report "kifer@cs.sunysb.edu"
-				      (vip-version)
-				      varlist
-				      nil 'delete-other-windows
-				      salutation)
-	  ))
-		    
-
-    
-		
-;; Smoothes out the difference between Emacs' unread-command-events
-;; and XEmacs unread-command-event. Arg is a character, an event, a list of
-;; events or a sequence of keys.
-;;
-;; Due to the way unread-command-events in Emacs (not XEmacs), a non-event
-;; symbol in unread-command-events list may cause Emacs to turn this symbol
-;; into an event. Below, we delete nil from event lists, since nil is the most
-;; common symbol that might appear in this wrong context.
-(defun vip-set-unread-command-events (arg)
-  (if vip-emacs-p
-      (setq
-       unread-command-events
-       (let ((new-events
-	      (cond ((eventp arg) (list arg))
-		    ((listp arg) arg)
-		    ((sequencep arg)
-		     (listify-key-sequence arg))
-		    (t (error
-			"vip-set-unread-command-events: Invalid argument, %S"
-			arg)))))
-	 (if (not (eventp nil))
-	     (setq new-events (delq nil new-events)))
-	 (append new-events unread-command-events)))
-    ;; XEmacs
-    (setq
-     unread-command-events
-     (append
-      (cond ((vip-characterp arg) (list (character-to-event arg)))
-	    ((eventp arg)  (list arg))
-	    ((stringp arg) (mapcar 'character-to-event arg))
-	    ((vectorp arg) (append arg nil)) ; turn into list
-	    ((listp arg) (vip-eventify-list-xemacs arg))
-	    (t (error
-		"vip-set-unread-command-events: Invalid argument, %S" arg)))
-      unread-command-events))))
-
-;; list is assumed to be a list of events of characters
-(defun vip-eventify-list-xemacs (lis)
-  (mapcar
-   (function (lambda (elt)
-	       (cond ((vip-characterp elt) (character-to-event elt))
-		     ((eventp elt)  elt)
-		     (t (error
-			 "vip-eventify-list-xemacs: can't convert to event, %S"
-			 elt)))))
-   lis))
-  
-  
-
-;;; Bring in the rest of the files
-(require 'viper-mous)
-(require 'viper-macs)
-(require 'viper-ex)
-
-
-
-;; The following is provided for compatibility with older VIP's
-
-(defalias 'vip-change-mode-to-vi 'vip-change-state-to-vi)
-(defalias 'vip-change-mode-to-insert 'vip-change-state-to-insert)
-(defalias 'vip-change-mode-to-emacs 'vip-change-state-to-emacs)
-   
-
-
-;;; Load .vip and set up hooks
-
-;; This hook designed to enable Vi-style editing in comint-based modes."
-(defun vip-comint-mode-hook ()
-  (setq require-final-newline nil
-	vip-ex-style-editing-in-insert nil
-	vip-ex-style-motion nil)
-  (vip-change-state-to-insert))
-
-
-;; This sets major mode hooks to make them come up in vi-state.
-(defun vip-set-hooks ()
-  
-  ;; It is of course a misnomer to call viper-mode a `major mode'.
-  ;; However, this has the effect that if the user didn't specify the
-  ;; default mode, new buffers that fall back on the default will come up
-  ;; in Fundamental Mode and Vi state.
-  (setq default-major-mode 'viper-mode)
-  
-  ;; The following major modes should come up in vi-state
-  (defadvice fundamental-mode (after vip-fundamental-mode-ad activate)
-    "Run `vip-change-state-to-vi' on entry."
-    (vip-change-state-to-vi))
-
-  (defvar makefile-mode-hook)
-  (add-hook 'makefile-mode-hook 'viper-mode)
-
-  (defvar help-mode-hook)
-  (add-hook 'help-mode-hook 'viper-mode)
-
-  (defvar awk-mode-hook)
-  (add-hook 'awk-mode-hook 'viper-mode)
-  
-  (defvar html-mode-hook)
-  (add-hook 'html-mode-hook 'viper-mode)
-  (defvar html-helper-mode-hook)
-  (add-hook 'html-helper-mode-hook 'viper-mode)
-  (defvar java-mode-hook)
-  (add-hook 'java-mode-hook 'viper-mode)
-  
-  (defvar emacs-lisp-mode-hook)
-  (add-hook 'emacs-lisp-mode-hook 'viper-mode)
-
-  (defvar lisp-mode-hook)
-  (add-hook 'lisp-mode-hook 'viper-mode)
-  
-  (defvar bibtex-mode-hook)
-  (add-hook 'bibtex-mode-hook 'viper-mode) 	  
-      
-  (defvar cc-mode-hook)
-  (add-hook 'cc-mode-hook 'viper-mode)
-      
-  (defvar c-mode-hook)
-  (add-hook 'c-mode-hook 'viper-mode)
-      
-  (defvar c++-mode-hook)
-  (add-hook 'c++-mode-hook 'viper-mode)
-  
-  (defvar lisp-interaction-mode-hook)
-  (add-hook 'lisp-interaction-mode-hook 'viper-mode)
-
-  (defvar fortran-mode-hook)
-  (add-hook 'fortran-mode-hook 'vip-mode)
-
-  (defvar basic-mode-hook)
-  (add-hook 'basic-mode-hook 'vip-mode)
-  (defvar bat-mode-hook)
-  (add-hook 'bat-mode-hook 'vip-mode)
-      
-  (defvar text-mode-hook)
-  (add-hook 'text-mode-hook 'viper-mode)
-      
-  (add-hook 'completion-list-mode-hook 'viper-mode)  
-  (add-hook 'compilation-mode-hook     'viper-mode)  
-
-  (add-hook 'perl-mode-hook     'viper-mode)  
-  (add-hook 'tcl-mode-hook     'viper-mode)  
-  
-  (defvar emerge-startup-hook)
-  (add-hook 'emerge-startup-hook 'vip-change-state-to-emacs)
-
-  ;; Tell vc-diff to put *vc* in Vi mode
-  (if (featurep 'vc)
-      (defadvice vc-diff (after vip-vc-ad activate)
-	"Force Vi state in VC diff buffer."
-	(vip-change-state-to-vi))
-    (vip-eval-after-load
-     "vc"
-     '(defadvice vc-diff (after vip-vc-ad activate)
-	"Force Vi state in VC diff buffer."
-	(vip-change-state-to-vi))))
-    
-  (vip-eval-after-load
-   "emerge"
-   '(defadvice emerge-quit (after vip-emerge-advice activate)
-      "Run `vip-change-state-to-vi' after quitting emerge."
-      (vip-change-state-to-vi)))
-  ;; In case Emerge was loaded before Viper.
-  (defadvice emerge-quit (after vip-emerge-advice activate)
-    "Run `vip-change-state-to-vi' after quitting emerge."
-    (vip-change-state-to-vi))
-  
-  (vip-eval-after-load
-   "asm-mode"
-   '(defadvice asm-mode (after vip-asm-mode-ad activate)
-      "Run `vip-change-state-to-vi' on entry."
-      (vip-change-state-to-vi)))
-  
-  ;; passwd.el sets up its own buffer, which turns up in Vi mode,
-  ;; thus overriding the local map. We don't need Vi mode here.
-  (vip-eval-after-load
-   "passwd"
-   '(defadvice read-passwd-1 (before vip-passwd-ad activate)
-      "Switch to emacs state while reading password."
-      (vip-change-state-to-emacs)))
-
-  (vip-eval-after-load
-   "prolog"
-   '(defadvice prolog-mode (after vip-prolog-ad activate)
-      "Switch to Vi state in Prolog mode."
-      (vip-change-state-to-vi)))
-  
-  ;; Emacs shell, ange-ftp, and comint-based modes
-  (defvar comint-mode-hook)
-  (vip-modify-major-mode 
-   'comint-mode 'insert-state vip-comint-mode-modifier-map)
-  (vip-modify-major-mode 
-   'comint-mode 'vi-state vip-comint-mode-modifier-map)
-  (vip-modify-major-mode 
-   'shell-mode 'insert-state vip-comint-mode-modifier-map)
-  (vip-modify-major-mode 
-   'shell-mode 'vi-state vip-comint-mode-modifier-map)
-  ;; ange-ftp in XEmacs
-  (vip-modify-major-mode 
-   'ange-ftp-shell-mode 'insert-state vip-comint-mode-modifier-map)
-  (vip-modify-major-mode 
-   'ange-ftp-shell-mode 'vi-state vip-comint-mode-modifier-map)
-  ;; ange-ftp in Emacs
-  (vip-modify-major-mode 
-   'internal-ange-ftp-mode 'insert-state vip-comint-mode-modifier-map)
-  (vip-modify-major-mode 
-   'internal-ange-ftp-mode 'vi-state vip-comint-mode-modifier-map)
-  ;; set hook
-  (add-hook 'comint-mode-hook 'vip-comint-mode-hook)
-  
-  ;; Shell scripts
-  (defvar sh-mode-hook)
-  (add-hook 'sh-mode-hook 'viper-mode)
-  (defvar ksh-mode-hook)
-  (add-hook 'ksh-mode-hook 'viper-mode)
-  
-  ;; Dired
-  (vip-modify-major-mode 'dired-mode 'emacs-state vip-dired-modifier-map)
-  (vip-set-emacs-search-style-macros nil 'dired-mode)
-  (add-hook 'dired-mode-hook 'vip-change-state-to-emacs)
-
-  ;; Tar
-  (vip-modify-major-mode 'tar-mode 'emacs-state vip-slash-and-colon-map)
-  (vip-set-emacs-search-style-macros nil 'tar-mode)
-
-  ;; MH-E
-  (vip-modify-major-mode 'mh-folder-mode 'emacs-state vip-slash-and-colon-map)
-  (vip-set-emacs-search-style-macros nil 'mh-folder-mode)
-  ;; changing state to emacs is needed so the preceding will take hold
-  (add-hook 'mh-folder-mode-hook 'vip-change-state-to-emacs)
-  (add-hook 'mh-show-mode-hook 'viper-mode)
-
-  ;; Gnus
-  (vip-modify-major-mode 'gnus-group-mode 'emacs-state vip-slash-and-colon-map)
-  (vip-set-emacs-search-style-macros nil 'gnus-group-mode)
-  (vip-modify-major-mode 
-   'gnus-summary-mode 'emacs-state vip-slash-and-colon-map)
-  (vip-set-emacs-search-style-macros nil 'gnus-summary-mode)
-  ;; changing state to emacs is needed so the preceding will take hold
-  (add-hook 'gnus-group-mode-hook 'vip-change-state-to-emacs)
-  (add-hook 'gnus-summary-mode-hook 'vip-change-state-to-emacs)
-  (add-hook 'gnus-article-mode-hook 'viper-mode)
-
-  ;; Info
-  (vip-modify-major-mode 'Info-mode 'emacs-state vip-slash-and-colon-map)
-  (vip-set-emacs-search-style-macros nil 'Info-mode)
-  ;; Switching to emacs is needed  so the above will take hold
-  (defadvice Info-mode (after vip-Info-ad activate)
-    "Switch to emacs mode."
-    (vip-change-state-to-emacs))
-
-  ;; Buffer menu
-  (vip-modify-major-mode 
-   'Buffer-menu-mode 'emacs-state vip-slash-and-colon-map)
-  (vip-set-emacs-search-style-macros nil 'Buffer-menu-mode)
-  ;; Switching to emacs is needed  so the above will take hold
-  (defadvice Buffer-menu-mode (after vip-Buffer-menu-ad activate)
-    "Switch to emacs mode."
-    (vip-change-state-to-emacs))
-
-  ;; View mode
-  (if vip-emacs-p
-      (progn
-	(defvar view-mode-hook)
-	(add-hook 'view-mode-hook 'vip-change-state-to-emacs))
-    (defadvice view-minor-mode (after vip-view-ad activate)
-      "Switch to Emacs state in View mode."
-      (vip-change-state-to-emacs))
-    (defvar view-hook)
-    (add-hook 'view-hook 'vip-change-state-to-emacs))
-  
-  ;; For VM users.
-  ;; Put summary and other VM buffers in Emacs state.
-  (defvar vm-mode-hooks)
-  (defvar vm-summary-mode-hooks)
-  (add-hook 'vm-mode-hooks   'vip-change-state-to-emacs)
-  (add-hook 'vm-summary-mode-hooks   'vip-change-state-to-emacs)
-  
-  ;; For RMAIL users.
-  ;; Put buf in Emacs state after edit.
-  (vip-eval-after-load
-   "rmailedit"
-   '(defadvice rmail-cease-edit (after vip-rmail-advice activate)
-      "Switch to emacs state when done editing message."
-      (vip-change-state-to-emacs)))
-  ;; In case RMAIL was loaded before Viper.
-  (defadvice rmail-cease-edit (after vip-rmail-advice activate)
-    "Switch to emacs state when done editing message."
-    (vip-change-state-to-emacs))
-  ) ; vip-set-hooks
-      
-;; Set some useful macros
-;; These must be before we load .vip, so the user can unrecord them.
-
-;; repeat the 2nd previous command without rotating the command history
-(vip-record-kbd-macro
- (vector vip-repeat-from-history-key '\1) 'vi-state
- [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't)
-;; repeat the 3d previous command without rotating the command history
-(vip-record-kbd-macro
- (vector vip-repeat-from-history-key '\2) 'vi-state
- [(meta x) v i p - r e p e a t - f r o m - h i s t o r y return] 't)
- 
-;; set the toggle case sensitivity and regexp search macros
-(vip-set-vi-search-style-macros nil)
- 
-
-;; ~/.vip is loaded if it exists
-(if (and (file-exists-p vip-custom-file-name)
-	 (not noninteractive))
-    (load vip-custom-file-name))
-
-;; VIP compatibility: merge whatever the user has in vip-mode-map into
-;; Viper's basic map.
-(vip-add-keymap vip-mode-map vip-vi-global-user-map)
-
-
-;; Applying Viper customization -- runs after (load .vip)
-
-;; Save user settings or Viper defaults for vars controled by vip-expert-level
-(setq vip-saved-user-settings 
-      (list (cons 'vip-want-ctl-h-help vip-want-ctl-h-help)
-	    (cons 'vip-always vip-always)
-	    (cons 'vip-no-multiple-ESC vip-no-multiple-ESC)
-	    (cons 'vip-ex-style-motion vip-ex-style-motion)
-	    (cons 'vip-ex-style-editing-in-insert
-		    	    	    	    vip-ex-style-editing-in-insert) 
-	    (cons 'vip-want-emacs-keys-in-vi vip-want-emacs-keys-in-vi)
-	    (cons 'vip-want-emacs-keys-in-insert vip-want-emacs-keys-in-insert)
-	    (cons 'vip-re-search vip-re-search)))
-	      
-
-(vip-set-minibuffer-style)
-(vip-set-minibuffer-faces)
-(vip-set-search-face)
-(vip-set-replace-overlay-face)
-(if vip-buffer-search-char
-    (vip-buffer-search-enable))
-(vip-update-alphanumeric-class)
-   
-;;; Familiarize Viper with some minor modes that have their own keymaps
-(vip-harness-minor-mode "compile")
-(vip-harness-minor-mode "outline")
-(vip-harness-minor-mode "allout")
-(vip-harness-minor-mode "xref")
-(vip-harness-minor-mode "lmenu")
-(vip-harness-minor-mode "vc")
-(vip-harness-minor-mode "ltx-math") ; LaTeX-math-mode in AUC-TeX
-(vip-harness-minor-mode "latex")    ; which is in one of these two files
-(vip-harness-minor-mode "cyrillic")
-(vip-harness-minor-mode "russian")
-(vip-harness-minor-mode "view-less")
-(vip-harness-minor-mode "view")
-
-
-;; Intercept maps could go in viper-keym.el
-;; We keep them here in case someone redefines them in ~/.vip
-
-(define-key vip-vi-intercept-map vip-ESC-key 'vip-intercept-ESC-key)
-(define-key vip-insert-intercept-map vip-ESC-key 'vip-intercept-ESC-key)
-
-;; This is taken care of by vip-insert-global-user-map.
-;;(define-key vip-replace-map vip-ESC-key 'vip-intercept-ESC-key)
-
-
-;; The default vip-toggle-key is \C-z; for the novice, it suspends or
-;; iconifies Emacs
-(define-key vip-vi-intercept-map vip-toggle-key 'vip-toggle-key-action)
-(define-key vip-emacs-intercept-map vip-toggle-key 'vip-change-state-to-vi)
-
-
-(if (or vip-always 
-	(and (< vip-expert-level 5) (> vip-expert-level 0)))
-    (vip-set-hooks))
-    
-;; Let all minor modes take effect after loading
-;; this may not be enough, so we also set default minor-mode-alist.
-;; Without setting the default, new buffers that come up in emacs mode have
-;; minor-mode-map-alist = nil, unless we call vip-change-state-*
-(if (eq vip-current-state 'emacs-state)
-    (progn
-      (vip-change-state-to-emacs)
-      (setq-default minor-mode-map-alist minor-mode-map-alist)
-      ))
-    
-
-(run-hooks 'vip-load-hook) ; the last chance to change something
-
-(provide 'viper)
-(provide 'vip19)
-(provide 'vip)
-
-;;;  viper.el ends here
diff --git a/lisp/emulation/ws-mode.el b/lisp/emulation/ws-mode.el
deleted file mode 100644
index 91f8b0170fc..00000000000
--- a/lisp/emulation/ws-mode.el
+++ /dev/null
@@ -1,753 +0,0 @@
-;;; ws-mode.el --- WordStar emulation mode for GNU Emacs
-
-;; Copyright (C) 1991 Free Software Foundation, Inc.
-
-;; Author: Juergen Nickelsen <nickel@cs.tu-berlin.de>
-;; Version: 0.7
-;; Keywords: emulations
-
-;; 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 emulates WordStar, with a major mode.
-
-;;; Code:
-
-(defvar wordstar-mode-map nil "")
-(defvar wordstar-C-j-map nil "")
-(defvar wordstar-C-k-map nil "")
-(defvar wordstar-C-o-map nil "")
-(defvar wordstar-C-q-map nil "")
-
-(if wordstar-mode-map
-    ()
-  (setq wordstar-mode-map (make-keymap))
-  ;;  (setq wordstar-C-j-map (make-keymap)) ; later, perhaps
-  (setq wordstar-C-k-map (make-keymap))
-  (setq wordstar-C-o-map (make-keymap))
-  (setq wordstar-C-q-map (make-keymap))
-  
-  (define-key wordstar-mode-map "\C-a" 'backward-word)
-  (define-key wordstar-mode-map "\C-b" 'fill-paragraph)
-  (define-key wordstar-mode-map "\C-c" 'scroll-up)
-  (define-key wordstar-mode-map "\C-d" 'forward-char)
-  (define-key wordstar-mode-map "\C-e" 'previous-line)
-  (define-key wordstar-mode-map "\C-f" 'forward-word)
-  (define-key wordstar-mode-map "\C-g" 'delete-char)
-  (define-key wordstar-mode-map "\C-h" 'backward-char)
-  (define-key wordstar-mode-map "\C-i" 'indent-for-tab-command)
-  (define-key wordstar-mode-map "\C-j" 'help-for-help)
-  (define-key wordstar-mode-map "\C-k" wordstar-C-k-map)
-  (define-key wordstar-mode-map "\C-l" 'ws-repeat-search)
-  (define-key wordstar-mode-map "\C-n" 'open-line)
-  (define-key wordstar-mode-map "\C-o" wordstar-C-o-map)
-  (define-key wordstar-mode-map "\C-p" 'quoted-insert)
-  (define-key wordstar-mode-map "\C-q" wordstar-C-q-map)
-  (define-key wordstar-mode-map "\C-r" 'scroll-down)
-  (define-key wordstar-mode-map "\C-s" 'backward-char)
-  (define-key wordstar-mode-map "\C-t" 'kill-word)
-  (define-key wordstar-mode-map "\C-u" 'keyboard-quit)
-  (define-key wordstar-mode-map "\C-v" 'overwrite-mode)
-  (define-key wordstar-mode-map "\C-w" 'scroll-down-line)
-  (define-key wordstar-mode-map "\C-x" 'next-line)
-  (define-key wordstar-mode-map "\C-y" 'kill-complete-line)
-  (define-key wordstar-mode-map "\C-z" 'scroll-up-line)
-  
-  ;; wordstar-C-k-map
-  
-  (define-key wordstar-C-k-map " " ())
-  (define-key wordstar-C-k-map "0" 'ws-set-marker-0)
-  (define-key wordstar-C-k-map "1" 'ws-set-marker-1)
-  (define-key wordstar-C-k-map "2" 'ws-set-marker-2)
-  (define-key wordstar-C-k-map "3" 'ws-set-marker-3)
-  (define-key wordstar-C-k-map "4" 'ws-set-marker-4)
-  (define-key wordstar-C-k-map "5" 'ws-set-marker-5)
-  (define-key wordstar-C-k-map "6" 'ws-set-marker-6)
-  (define-key wordstar-C-k-map "7" 'ws-set-marker-7)
-  (define-key wordstar-C-k-map "8" 'ws-set-marker-8)
-  (define-key wordstar-C-k-map "9" 'ws-set-marker-9)
-  (define-key wordstar-C-k-map "b" 'ws-begin-block)
-  (define-key wordstar-C-k-map "\C-b" 'ws-begin-block)
-  (define-key wordstar-C-k-map "c" 'ws-copy-block)
-  (define-key wordstar-C-k-map "\C-c" 'ws-copy-block)
-  (define-key wordstar-C-k-map "d" 'save-buffers-kill-emacs)
-  (define-key wordstar-C-k-map "\C-d" 'save-buffers-kill-emacs)
-  (define-key wordstar-C-k-map "f" 'find-file)
-  (define-key wordstar-C-k-map "\C-f" 'find-file)
-  (define-key wordstar-C-k-map "h" 'ws-show-markers)
-  (define-key wordstar-C-k-map "\C-h" 'ws-show-markers)
-  (define-key wordstar-C-k-map "i" 'ws-indent-block)
-  (define-key wordstar-C-k-map "\C-i" 'ws-indent-block)
-  (define-key wordstar-C-k-map "k" 'ws-end-block)
-  (define-key wordstar-C-k-map "\C-k" 'ws-end-block)
-  (define-key wordstar-C-k-map "p" 'ws-print-block)
-  (define-key wordstar-C-k-map "\C-p" 'ws-print-block)
-  (define-key wordstar-C-k-map "q" 'kill-emacs)
-  (define-key wordstar-C-k-map "\C-q" 'kill-emacs)
-  (define-key wordstar-C-k-map "r" 'insert-file)
-  (define-key wordstar-C-k-map "\C-r" 'insert-file)
-  (define-key wordstar-C-k-map "s" 'save-some-buffers)
-  (define-key wordstar-C-k-map "\C-s" 'save-some-buffers)
-  (define-key wordstar-C-k-map "t" 'ws-mark-word)
-  (define-key wordstar-C-k-map "\C-t" 'ws-mark-word)
-  (define-key wordstar-C-k-map "u" 'ws-exdent-block)
-  (define-key wordstar-C-k-map "\C-u" 'keyboard-quit)
-  (define-key wordstar-C-k-map "v" 'ws-move-block)
-  (define-key wordstar-C-k-map "\C-v" 'ws-move-block)
-  (define-key wordstar-C-k-map "w" 'ws-write-block)
-  (define-key wordstar-C-k-map "\C-w" 'ws-write-block)
-  (define-key wordstar-C-k-map "x" 'save-buffers-kill-emacs)
-  (define-key wordstar-C-k-map "\C-x" 'save-buffers-kill-emacs)
-  (define-key wordstar-C-k-map "y" 'ws-delete-block)
-  (define-key wordstar-C-k-map "\C-y" 'ws-delete-block)
-  
-  ;; wordstar-C-j-map not yet implemented
-  
-  ;; wordstar-C-o-map
-  
-  (define-key wordstar-C-o-map " " ())
-  (define-key wordstar-C-o-map "c" 'wordstar-center-line)
-  (define-key wordstar-C-o-map "\C-c" 'wordstar-center-line)
-  (define-key wordstar-C-o-map "b" 'switch-to-buffer)
-  (define-key wordstar-C-o-map "\C-b" 'switch-to-buffer)
-  (define-key wordstar-C-o-map "j" 'justify-current-line)
-  (define-key wordstar-C-o-map "\C-j" 'justify-current-line)
-  (define-key wordstar-C-o-map "k" 'kill-buffer)
-  (define-key wordstar-C-o-map "\C-k" 'kill-buffer)
-  (define-key wordstar-C-o-map "l" 'list-buffers)
-  (define-key wordstar-C-o-map "\C-l" 'list-buffers)
-  (define-key wordstar-C-o-map "m" 'auto-fill-mode)
-  (define-key wordstar-C-o-map "\C-m" 'auto-fill-mode)
-  (define-key wordstar-C-o-map "r" 'set-fill-column)
-  (define-key wordstar-C-o-map "\C-r" 'set-fill-column)
-  (define-key wordstar-C-o-map "\C-u" 'keyboard-quit)
-  (define-key wordstar-C-o-map "wd" 'delete-other-windows)
-  (define-key wordstar-C-o-map "wh" 'split-window-horizontally)
-  (define-key wordstar-C-o-map "wo" 'other-window)
-  (define-key wordstar-C-o-map "wv" 'split-window-vertically)
-  
-  ;; wordstar-C-q-map
-  (define-key wordstar-C-q-map " " ())
-  (define-key wordstar-C-q-map "0" 'ws-find-marker-0)
-  (define-key wordstar-C-q-map "1" 'ws-find-marker-1)
-  (define-key wordstar-C-q-map "2" 'ws-find-marker-2)
-  (define-key wordstar-C-q-map "3" 'ws-find-marker-3)
-  (define-key wordstar-C-q-map "4" 'ws-find-marker-4)
-  (define-key wordstar-C-q-map "5" 'ws-find-marker-5)
-  (define-key wordstar-C-q-map "6" 'ws-find-marker-6)
-  (define-key wordstar-C-q-map "7" 'ws-find-marker-7)
-  (define-key wordstar-C-q-map "8" 'ws-find-marker-8)
-  (define-key wordstar-C-q-map "9" 'ws-find-marker-9)
-  (define-key wordstar-C-q-map "a" 'ws-query-replace)
-  (define-key wordstar-C-q-map "\C-a" 'ws-query-replace)
-  (define-key wordstar-C-q-map "b" 'ws-goto-block-begin)
-  (define-key wordstar-C-q-map "\C-b" 'ws-goto-block-begin)
-  (define-key wordstar-C-q-map "c" 'end-of-buffer)
-  (define-key wordstar-C-q-map "\C-c" 'end-of-buffer)
-  (define-key wordstar-C-q-map "d" 'end-of-line)
-  (define-key wordstar-C-q-map "\C-d" 'end-of-line)
-  (define-key wordstar-C-q-map "f" 'ws-search)
-  (define-key wordstar-C-q-map "\C-f" 'ws-search)
-  (define-key wordstar-C-q-map "k" 'ws-goto-block-end)
-  (define-key wordstar-C-q-map "\C-k" 'ws-goto-block-end)
-  (define-key wordstar-C-q-map "l" 'ws-undo)
-  (define-key wordstar-C-q-map "\C-l" 'ws-undo)
-  (define-key wordstar-C-q-map "p" 'ws-last-cursorp)
-  (define-key wordstar-C-q-map "\C-p" 'ws-last-cursorp)
-  (define-key wordstar-C-q-map "r" 'beginning-of-buffer)
-  (define-key wordstar-C-q-map "\C-r" 'beginning-of-buffer)
-  (define-key wordstar-C-q-map "s" 'beginning-of-line)
-  (define-key wordstar-C-q-map "\C-s" 'beginning-of-line)
-  (define-key wordstar-C-q-map "\C-u" 'keyboard-quit)
-  (define-key wordstar-C-q-map "w" 'ws-last-error)
-  (define-key wordstar-C-q-map "\C-w" 'ws-last-error)
-  (define-key wordstar-C-q-map "y" 'ws-kill-eol)
-  (define-key wordstar-C-q-map "\C-y" 'ws-kill-eol)
-  (define-key wordstar-C-q-map "\177" 'ws-kill-bol))
-
-;;;###autoload
-(defun wordstar-mode ()
-  "Major mode with WordStar-like key bindings.
-
-BUGS:
- - Help menus with WordStar commands (C-j just calls help-for-help)
-   are not implemented
- - Options for search and replace
- - Show markers (C-k h) is somewhat strange
- - Search and replace (C-q a) is only available in forward direction
-
-No key bindings beginning with ESC are installed, they will work
-Emacs-like.
-
-The key bindings are:
-
-  C-a		backward-word
-  C-b		fill-paragraph
-  C-c		scroll-up-line
-  C-d		forward-char
-  C-e		previous-line
-  C-f		forward-word
-  C-g		delete-char
-  C-h		backward-char
-  C-i		indent-for-tab-command
-  C-j		help-for-help
-  C-k		ordstar-C-k-map
-  C-l		ws-repeat-search
-  C-n		open-line
-  C-p		quoted-insert
-  C-r		scroll-down-line
-  C-s		backward-char
-  C-t		kill-word
-  C-u		keyboard-quit
-  C-v		overwrite-mode
-  C-w		scroll-down
-  C-x		next-line
-  C-y		kill-complete-line
-  C-z		scroll-up
-
-  C-k 0		ws-set-marker-0
-  C-k 1		ws-set-marker-1
-  C-k 2		ws-set-marker-2
-  C-k 3		ws-set-marker-3
-  C-k 4		ws-set-marker-4
-  C-k 5		ws-set-marker-5
-  C-k 6		ws-set-marker-6
-  C-k 7		ws-set-marker-7
-  C-k 8		ws-set-marker-8
-  C-k 9		ws-set-marker-9
-  C-k b		ws-begin-block
-  C-k c		ws-copy-block
-  C-k d		save-buffers-kill-emacs
-  C-k f		find-file
-  C-k h		ws-show-markers
-  C-k i		ws-indent-block
-  C-k k		ws-end-block
-  C-k p		ws-print-block
-  C-k q		kill-emacs
-  C-k r		insert-file
-  C-k s		save-some-buffers
-  C-k t		ws-mark-word
-  C-k u		ws-exdent-block
-  C-k C-u	keyboard-quit
-  C-k v		ws-move-block
-  C-k w		ws-write-block
-  C-k x		kill-emacs
-  C-k y		ws-delete-block
-
-  C-o c		wordstar-center-line
-  C-o b		switch-to-buffer
-  C-o j		justify-current-line
-  C-o k		kill-buffer
-  C-o l		list-buffers
-  C-o m		auto-fill-mode
-  C-o r		set-fill-column
-  C-o C-u	keyboard-quit
-  C-o wd	delete-other-windows
-  C-o wh	split-window-horizontally
-  C-o wo	other-window
-  C-o wv	split-window-vertically
-
-  C-q 0		ws-find-marker-0
-  C-q 1		ws-find-marker-1
-  C-q 2		ws-find-marker-2
-  C-q 3		ws-find-marker-3
-  C-q 4		ws-find-marker-4
-  C-q 5		ws-find-marker-5
-  C-q 6		ws-find-marker-6
-  C-q 7		ws-find-marker-7
-  C-q 8		ws-find-marker-8
-  C-q 9		ws-find-marker-9
-  C-q a		ws-query-replace
-  C-q b		ws-to-block-begin
-  C-q c		end-of-buffer
-  C-q d		end-of-line
-  C-q f		ws-search
-  C-q k		ws-to-block-end
-  C-q l		ws-undo
-  C-q p		ws-last-cursorp
-  C-q r		beginning-of-buffer
-  C-q C-u	keyboard-quit
-  C-q w		ws-last-error
-  C-q y		ws-kill-eol
-  C-q DEL	ws-kill-bol
-"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map wordstar-mode-map)
-  (setq mode-name "WordStar")
-  (setq major-mode 'wordstar-mode))
-
-
-(defun wordstar-center-paragraph ()
-  "Center each line in the paragraph at or after point.
-See `wordstar-center-line' for more info."
-  (interactive)
-  (save-excursion
-    (forward-paragraph)
-    (or (bolp) (newline 1))
-    (let ((end (point)))
-      (backward-paragraph)
-      (wordstar-center-region (point) end))))
-
-(defun wordstar-center-region (from to)
-  "Center each line starting in the region.
-See `wordstar-center-line' for more info."
-  (interactive "r")
-  (if (> from to)
-      (let ((tem to))
-	(setq to from from tem)))
-  (save-excursion
-    (save-restriction
-      (narrow-to-region from to)
-      (goto-char from)
-      (while (not (eobp))
-	(wordstar-center-line)
-	(forward-line 1)))))
-
-(defun wordstar-center-line ()
-  "Center the line point is on, within the width specified by `fill-column'.
-This means adjusting the indentation to match
-the distance between the end of the text and `fill-column'."
-  (interactive)
-  (save-excursion
-    (let (line-length)
-      (beginning-of-line)
-      (delete-horizontal-space)
-      (end-of-line)
-      (delete-horizontal-space)
-      (setq line-length (current-column))
-      (beginning-of-line)
-      (indent-to 
-       (+ left-margin 
-	  (/ (- fill-column left-margin line-length) 2))))))
-
-(defun scroll-down-line ()
-  "Scroll one line down."
-  (interactive)
-  (scroll-down 1))
-
-(defun scroll-up-line ()
-  "Scroll one line up."
-  (interactive)
-  (scroll-up 1))
-
-;;;;;;;;;;;
-;; wordstar special variables:
-
-(defvar ws-marker-0 nil "Position marker 0 in WordStar mode.")
-(defvar ws-marker-1 nil "Position marker 1 in WordStar mode.")
-(defvar ws-marker-2 nil "Position marker 2 in WordStar mode.")
-(defvar ws-marker-3 nil "Position marker 3 in WordStar mode.")
-(defvar ws-marker-4 nil "Position marker 4 in WordStar mode.")
-(defvar ws-marker-5 nil "Position marker 5 in WordStar mode.")
-(defvar ws-marker-6 nil "Position marker 6 in WordStar mode.")
-(defvar ws-marker-7 nil "Position marker 7 in WordStar mode.")
-(defvar ws-marker-8 nil "Position marker 8 in WordStar mode.")
-(defvar ws-marker-9 nil "Position marker 9 in WordStar mode.")
-
-(defvar ws-block-begin-marker nil "Beginning of \"Block\" in WordStar mode.")
-(defvar ws-block-end-marker nil "End of \"Block\" in WordStar mode.")
-
-(defvar ws-search-string nil "String of last search in WordStar mode.")
-(defvar ws-search-direction t 
-  "Direction of last search in WordStar mode. T if forward, NIL if backward.")
-
-(defvar ws-last-cursorposition nil 
-  "Position before last search etc. in WordStar mode.")
-
-(defvar ws-last-errormessage nil 
-  "Last error message issued by a WordStar mode function.")
-
-;;;;;;;;;;;
-;; wordstar special functions:
-
-(defun ws-error (string)
-  "Report error of a WordStar special function. Error message is saved
-in ws-last-errormessage for recovery with C-q w."
-  (setq ws-last-errormessage string)
-  (error string))
-
-(defun ws-set-marker-0 ()
-  "In WordStar mode: Set marker 0 to current cursor position."
-  (interactive)
-  (setq ws-marker-0 (point-marker))
-  (message "Marker 0 set"))
-
-(defun ws-set-marker-1 ()
-  "In WordStar mode: Set marker 1 to current cursor position."
-  (interactive)
-  (setq ws-marker-1 (point-marker))
-  (message "Marker 1 set"))
-
-(defun ws-set-marker-2 ()
-  "In WordStar mode: Set marker 2 to current cursor position."
-  (interactive)
-  (setq ws-marker-2 (point-marker))
-  (message "Marker 2 set"))
-
-(defun ws-set-marker-3 ()
-  "In WordStar mode: Set marker 3 to current cursor position."
-  (interactive)
-  (setq ws-marker-3 (point-marker))
-  (message "Marker 3 set"))
-
-(defun ws-set-marker-4 ()
-  "In WordStar mode: Set marker 4 to current cursor position."
-  (interactive)
-  (setq ws-marker-4 (point-marker))
-  (message "Marker 4 set"))
-
-(defun ws-set-marker-5 ()
-  "In WordStar mode: Set marker 5 to current cursor position."
-  (interactive)
-  (setq ws-marker-5 (point-marker))
-  (message "Marker 5 set"))
-
-(defun ws-set-marker-6 ()
-  "In WordStar mode: Set marker 6 to current cursor position."
-  (interactive)
-  (setq ws-marker-6 (point-marker))
-  (message "Marker 6 set"))
-
-(defun ws-set-marker-7 ()
-  "In WordStar mode: Set marker 7 to current cursor position."
-  (interactive)
-  (setq ws-marker-7 (point-marker))
-  (message "Marker 7 set"))
-
-(defun ws-set-marker-8 ()
-  "In WordStar mode: Set marker 8 to current cursor position."
-  (interactive)
-  (setq ws-marker-8 (point-marker))
-  (message "Marker 8 set"))
-
-(defun ws-set-marker-9 ()
-  "In WordStar mode: Set marker 9 to current cursor position."
-  (interactive)
-  (setq ws-marker-9 (point-marker))
-  (message "Marker 9 set"))
-
-(defun ws-begin-block ()
-  "In WordStar mode: Set block begin marker to current cursor position."
-  (interactive)
-  (setq ws-block-begin-marker (point-marker))
-  (message "Block begin marker set"))
-
-(defun ws-show-markers ()
-  "In WordStar mode: Show block markers."
-  (interactive)
-  (if (or ws-block-begin-marker ws-block-end-marker)
-      (save-excursion
-	(if ws-block-begin-marker
-	    (let ()
-	      (goto-char ws-block-begin-marker)
-	      (message "Block begin marker")
-	      (sit-for 2))
-	  (message "Block begin marker not set")
-	  (sit-for 2))
-	(if ws-block-end-marker
-	    (let ()
-	      (goto-char ws-block-end-marker)
-	      (message "Block end marker")
-	      (sit-for 2))
-	  (message "Block end marker not set"))
-	(message ""))
-    (message "Block markers not set")))
-
-
-(defun ws-indent-block ()
-  "In WordStar mode: Indent block (not yet implemented)."
-  (interactive)
-  (ws-error "Indent block not yet implemented"))
-
-(defun ws-end-block ()
-  "In WordStar mode: Set block end marker to current cursor position."
-  (interactive)
-  (setq ws-block-end-marker (point-marker))
-  (message "Block end marker set"))
-
-(defun ws-print-block ()
-  "In WordStar mode: Print block."
-  (interactive)
-  (message "Don't do this. Write block to a file (C-k w) and print this file."))
-
-(defun ws-mark-word ()
-  "In WordStar mode: Mark current word as block."
-  (interactive)
-  (save-excursion
-    (forward-word 1)
-    (sit-for 1)
-    (ws-end-block)
-    (forward-word -1)
-    (sit-for 1)
-    (ws-begin-block)))
-
-(defun ws-exdent-block ()
-  "I don't know what this (C-k u) should do."
-  (interactive)
-  (ws-error "This won't be done -- not yet implemented."))
-
-(defun ws-move-block ()
-  "In WordStar mode: Move block to current cursor position."
-  (interactive)
-  (if (and ws-block-begin-marker ws-block-end-marker)
-      (let () 
-	(kill-region ws-block-begin-marker ws-block-end-marker)
-	(yank)
-	(save-excursion
-	  (goto-char (region-beginning))
-	  (setq ws-block-begin-marker (point-marker))
-	  (goto-char (region-end))
-	  (setq ws-block-end-marker (point-marker))))
-    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
-		    (ws-block-end-marker "Block begin marker not set")
-		    (t "Block markers not set")))))
-
-(defun ws-write-block ()
-  "In WordStar mode: Write block to file."
-  (interactive)
-  (if (and ws-block-begin-marker ws-block-end-marker)
-      (let ((filename (read-file-name "Write block to file: ")))
-	(write-region ws-block-begin-marker ws-block-end-marker filename))
-    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
-		    (ws-block-end-marker "Block begin marker not set")
-		    (t "Block markers not set")))))
-
-
-(defun ws-delete-block ()
-  "In WordStar mode: Delete block."
-  (interactive)
-  (if (and ws-block-begin-marker ws-block-end-marker)
-      (let ()
-	(kill-region ws-block-begin-marker ws-block-end-marker)
-	(setq ws-block-end-marker nil)
-	(setq ws-block-begin-marker nil))
-    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
-		    (ws-block-end-marker "Block begin marker not set")
-		    (t "Block markers not set")))))
-
-(defun ws-find-marker-0 ()
-  "In WordStar mode: Go to marker 0."
-  (interactive)
-  (if ws-marker-0
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-0))
-    (ws-error "Marker 0 not set")))
-
-(defun ws-find-marker-1 ()
-  "In WordStar mode: Go to marker 1."
-  (interactive)
-  (if ws-marker-1
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-1))
-    (ws-error "Marker 1 not set")))
-
-(defun ws-find-marker-2 ()
-  "In WordStar mode: Go to marker 2."
-  (interactive)
-  (if ws-marker-2
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-2))
-    (ws-error "Marker 2 not set")))
-
-(defun ws-find-marker-3 ()
-  "In WordStar mode: Go to marker 3."
-  (interactive)
-  (if ws-marker-3
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-3))
-    (ws-error "Marker 3 not set")))
-
-(defun ws-find-marker-4 ()
-  "In WordStar mode: Go to marker 4."
-  (interactive)
-  (if ws-marker-4
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-4))
-    (ws-error "Marker 4 not set")))
-
-(defun ws-find-marker-5 ()
-  "In WordStar mode: Go to marker 5."
-  (interactive)
-  (if ws-marker-5
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-5))
-    (ws-error "Marker 5 not set")))
-
-(defun ws-find-marker-6 ()
-  "In WordStar mode: Go to marker 6."
-  (interactive)
-  (if ws-marker-6
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-6))
-    (ws-error "Marker 6 not set")))
-
-(defun ws-find-marker-7 ()
-  "In WordStar mode: Go to marker 7."
-  (interactive)
-  (if ws-marker-7
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-7))
-    (ws-error "Marker 7 not set")))
-
-(defun ws-find-marker-8 ()
-  "In WordStar mode: Go to marker 8."
-  (interactive)
-  (if ws-marker-8
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-8))
-    (ws-error "Marker 8 not set")))
-
-(defun ws-find-marker-9 ()
-  "In WordStar mode: Go to marker 9."
-  (interactive)
-  (if ws-marker-9
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-marker-9))
-    (ws-error "Marker 9 not set")))
-
-(defun ws-goto-block-begin ()
-  "In WordStar mode: Go to block begin marker."
-  (interactive)
-  (if ws-block-begin-marker
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-block-begin-marker))
-    (ws-error "Block begin marker not set")))
-
-(defun ws-search (string)
-  "In WordStar mode: Search string, remember string for repetition."
-  (interactive "sSearch for: ")
-  (message "Forward (f) or backward (b)")
-  (let ((direction
-	 (read-char)))
-    (cond ((equal (upcase direction) ?F)
-	   (setq ws-search-string string)
-	   (setq ws-search-direction t)
-	   (setq ws-last-cursorposition (point-marker))
-	   (search-forward string))
-	  ((equal (upcase direction) ?B)
-	   (setq ws-search-string string)
-	   (setq ws-search-direction nil)
-	   (setq ws-last-cursorposition (point-marker))
-	   (search-backward string))
-	  (t (keyboard-quit)))))
-
-(defun ws-goto-block-end ()
-  "In WordStar mode: Go to block end marker."
-  (interactive)
-  (if ws-block-end-marker
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-block-end-marker))
-    (ws-error "Block end marker not set")))
-
-(defun ws-undo ()
-  "In WordStar mode: Undo and give message about undoing more changes."
-  (interactive)
-  (undo)
-  (message "Repeat C-q l to undo more changes."))
-
-(defun ws-goto-last-cursorposition ()
-  "In WordStar mode: "
-  (interactive)
-  (if ws-last-cursorposition
-      (let ()
-	(setq ws-last-cursorposition (point-marker))
-	(goto-char ws-last-cursorposition))
-    (ws-error "No last cursor position available.")))
-
-(defun ws-last-error ()
-  "In WordStar mode: repeat last error message.
-This will only work for errors raised by WordStar mode functions."
-  (interactive)
-  (if ws-last-errormessage
-      (message ws-last-errormessage)
-    (message "No WordStar error yet.")))
-
-(defun ws-kill-eol ()
-  "In WordStar mode: Kill to end of line (like WordStar, not like Emacs)."
-  (interactive)
-  (let ((p (point)))
-    (end-of-line)
-    (kill-region p (point))))
-
-(defun ws-kill-bol ()
-  "In WordStar mode: Kill to beginning of line 
-\(like WordStar, not like Emacs)."
-  (interactive)
-  (let ((p (point)))
-    (beginning-of-line)
-    (kill-region (point) p)))
-
-(defun kill-complete-line ()
-  "Kill the complete line."
-  (interactive)
-  (beginning-of-line)
-  (if (eobp) (error "End of buffer"))
-  (let ((beg (point)))
-    (forward-line 1)
-    (kill-region beg (point))))
-
-(defun ws-repeat-search ()
-  "In WordStar mode: Repeat last search."
-  (interactive)
-  (setq ws-last-cursorposition (point-marker))
-  (if ws-search-string
-      (if ws-search-direction
-	  (search-forward ws-search-string)
-	(search-backward ws-search-string))
-    (ws-error "No search to repeat")))
-
-(defun ws-query-replace (from to)
-  "In WordStar mode: Search string, remember string for repetition."
-  (interactive "sReplace: 
-sWith: " )
-  (setq ws-search-string from)
-  (setq ws-search-direction t)
-  (setq ws-last-cursorposition (point-marker))
-  (query-replace from to))
-
-(defun ws-copy-block ()
-  "In WordStar mode: Copy block to current cursor position."
-  (interactive)
-  (if (and ws-block-begin-marker ws-block-end-marker)
-      (let ()
-	(copy-region-as-kill ws-block-begin-marker ws-block-end-marker)
-	(yank)
-	(save-excursion
-	  (goto-char (region-beginning))
-	  (setq ws-block-begin-marker (point-marker))
-	  (goto-char (region-end))
-	  (setq ws-block-end-marker (point-marker))))
-    (ws-error (cond (ws-block-begin-marker "Block end marker not set")
-		    (ws-block-end-marker "Block begin marker not set")
-		    (t "Block markers not set")))))
-
-;;; ws-mode.el ends here
diff --git a/lisp/enriched.el b/lisp/enriched.el
deleted file mode 100644
index 362a537d846..00000000000
--- a/lisp/enriched.el
+++ /dev/null
@@ -1,447 +0,0 @@
-;;; enriched.el --- read and save files in text/enriched format
-
-;; Copyright (c) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
-;; 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
-;;;
-
-(defvar enriched-verbose t
-  "*If non-nil, give status messages when reading and writing files.")
-
-;;;
-;;; Set up faces & display table
-;;;
-
-;; A slight cheat - all emacs's faces are fixed-width.  
-;; The idea is just to pick one that looks different from the default.
-(if (internal-find-face 'fixed)
-    nil
-  (make-face 'fixed)
-  (if window-system
-      (set-face-font 'fixed
-		     (car (or (x-list-fonts "*fixed-medium*" 
-					    'default (selected-frame))
-			      (x-list-fonts "*fixed*" 
-					    'default (selected-frame)))))))
-			      
-(if (internal-find-face 'excerpt)
-    nil
-  (make-face 'excerpt)
-  (if window-system
-      (make-face-italic 'excerpt nil t)))
-
-(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"))
-    (read-only     (t           "x-read-only"))
-    (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
-
-(defvar enriched-mode nil
-  "True if Enriched mode is in use.")
-(make-variable-buffer-local 'enriched-mode)
-
-(if (not (assq 'enriched-mode minor-mode-alist))
-    (setq minor-mode-alist
-	  (cons '(enriched-mode " Enriched")
-		minor-mode-alist)))
-
-(defvar enriched-mode-hook nil
-  "Functions to run when entering 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'.")
-
-(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
-;;;
-
-;;;###autoload
-(defun enriched-mode (&optional arg)
-  "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>\\{enriched-mode-map}"
-  (interactive "P")
-  (let ((mod (buffer-modified-p)))
-    (cond ((or (<= (prefix-numeric-value arg) 0)
-	       (and enriched-mode (null arg)))
-	   ;; Turn mode off
-	   (setq enriched-mode nil)
-	   (setq buffer-file-format (delq 'text/enriched buffer-file-format))
-	   ;; restore old variable values
-	   (while enriched-old-bindings
-	     (funcall 'set (car enriched-old-bindings)
-		      (car (cdr enriched-old-bindings)))
-	     (setq enriched-old-bindings (cdr (cdr enriched-old-bindings)))))
-
-	  (enriched-mode nil)		; Mode already on; do nothing.
-
-	  (t (setq enriched-mode t)	; Turn mode on
-	     (add-to-list 'buffer-file-format 'text/enriched)
-	     ;; 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
-		   buffer-display-table  enriched-display-table)
-	     (use-hard-newlines 1 nil)
-	     (let ((sticky (plist-get default-text-properties 'front-sticky))
-		   (p enriched-par-props))
-	       (while p
-		 (add-to-list 'sticky (car p))
-		 (setq p (cdr p)))
-	       (if sticky
-		   (setq default-text-properties
-			 (plist-put default-text-properties
-				    'front-sticky sticky))))
-	     (run-hooks 'enriched-mode-hook)))
-    (set-buffer-modified-p mod)
-    (force-mode-line-update)))
-
-;;;
-;;; 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 (name positive)
-  "Format an annotation called NAME.
-If POSITIVE is non-nil, this is the opening annotation, if nil, this is the
-matching close."
-  (cond ((stringp name)
-	 (format enriched-annotation-format (if positive "" "/") name))
-	;; Otherwise it is an annotation with parameters, represented as a list
-	(positive
-	 (let ((item (car name))
-	       (params (cdr name)))
-	   (concat (format enriched-annotation-format "" item)
-		   (mapconcat (lambda (i) (concat "<param>" i "</param>"))
-			      params ""))))
-	(t (format enriched-annotation-format "/" (car name)))))
-
-(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."
-  (cond ((string-match "^fg:" (symbol-name face))
-	 (list (list "x-color" (substring (symbol-name face) 3))))
-	((string-match "^bg:" (symbol-name face))
-	 (list (list "x-bg-color" (substring (symbol-name face) 3))))
-	((let* ((fg (face-foreground face))
-		(bg (face-background face))
-		(props (face-font face t))
-		(ans (cdr (format-annotate-single-property-change
-			   'face nil props enriched-translations))))
-	   (if fg (setq ans (cons (list "x-color" fg) ans)))
-	   (if bg (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 color)
-  (let ((face (intern (concat "fg:" color))))
-    (cond ((internal-find-face face))
-	  ((and window-system (facemenu-get-face face)))
-	  (window-system
-	   (message "Warning: color \"%s\" is not defined." color))
-	  ((make-face face)
-	   (message "Warning: Color \"%s\" can't be displayed." color)))
-    (list from to 'face face)))
-
-(defun enriched-decode-background (from to color)
-  (let ((face (intern (concat "bg:" color))))
-    (cond ((internal-find-face face))
-	  ((and window-system (facemenu-get-face face)))
-	  (window-system
-	   (message "Warning: color \"%s\" is not defined." color))
-	  ((make-face face)
-	   (message "Warning: Color \"%s\" can't be displayed." color)))
-    (list from to 'face face)))
-
-;;; enriched.el ends here
diff --git a/lisp/env.el b/lisp/env.el
deleted file mode 100644
index c0e68f63412..00000000000
--- a/lisp/env.el
+++ /dev/null
@@ -1,114 +0,0 @@
-;;; env.el --- functions to manipulate environment variables.
-
-;; Copyright (C) 1991, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: processes, unix
-
-;; 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:
-
-;; UNIX processes inherit a list of name-to-string associations from their
-;; parents called their `environment'; these are commonly used to control
-;; program options.  This package permits you to set environment variables
-;; to be passed to any sub-process run under Emacs.
-
-;;; Code:
-
-;; History list for environment variable names.
-(defvar read-envvar-name-history nil)
-
-(defun read-envvar-name (prompt &optional mustmatch)
-  "Read environment variable name, prompting with PROMPT.
-Optional second arg MUSTMATCH, if non-nil, means require existing envvar name.
-If it is also not t, RET does not exit if it does non-null completion."
-  (completing-read prompt
-		   (mapcar (function
-			    (lambda (enventry)
-			      (list (substring enventry 0
-					       (string-match "=" enventry)))))
-			   process-environment)
-		   nil mustmatch nil 'read-envvar-name-history))
-
-;; History list for VALUE argument to setenv.
-(defvar setenv-history nil)
-
-;;;###autoload
-(defun setenv (variable &optional value unset)
-  "Set the value of the environment variable named VARIABLE to VALUE.
-VARIABLE should be a string.  VALUE is optional; if not provided or is
-`nil', the environment variable VARIABLE will be removed.  
-
-Interactively, a prefix argument means to unset the variable.
-Interactively, the current value (if any) of the variable
-appears at the front of the history list when you type in the new value.
-
-This function works by modifying `process-environment'."
-  (interactive
-   (if current-prefix-arg
-       (list (read-envvar-name "Clear environment variable: " 'exact) nil t)
-     (let* ((var (read-envvar-name "Set environment variable: " nil))
-	    (oldval (getenv var))
-	    newval
-	    oldhist)
-       ;; Don't put the current value on the history
-       ;; if it is already there.
-       (if (equal oldval (car setenv-history))
-	   (setq oldval nil))
-       ;; Now if OLDVAL is non-nil, we should add it to the history.
-       (if oldval
-	   (setq setenv-history (cons oldval setenv-history)))
-       (setq oldhist setenv-history)
-       (setq newval (read-from-minibuffer (format "Set %s to value: " var)
-					  nil nil nil 'setenv-history))
-       ;; If we added the current value to the history, remove it.
-       ;; Note that read-from-minibuffer may have added the new value.
-       ;; Don't remove that!
-       (if oldval
-	   (if (eq oldhist setenv-history)
-	       (setq setenv-history (cdr setenv-history))
-	     (setcdr setenv-history (cdr (cdr setenv-history)))))
-       ;; Here finally we specify the args to give call setenv with.
-       (list var newval))))
-  (if unset (setq value nil))
-  (if (string-match "=" variable)
-      (error "Environment variable name `%s' contains `='" variable)
-    (let ((pattern (concat "\\`" (regexp-quote (concat variable "="))))
-	  (case-fold-search nil)
-	  (scan process-environment)
-	  found)
-      (if (string-equal "TZ" variable)
-	  (set-time-zone-rule value))
-      (while scan
-	(cond ((string-match pattern (car scan))
-	       (setq found t)
-	       (if (eq nil value)
-		   (setq process-environment (delq (car scan) process-environment))
-		 (setcar scan (concat variable "=" value)))
-	       (setq scan nil)))
-	(setq scan (cdr scan)))
-      (or found
-	  (if value
-	      (setq process-environment
-		    (cons (concat variable "=" value)
-			  process-environment)))))))
-
-(provide 'env)
-
-;;; env.el ends here
diff --git a/lisp/expand.el b/lisp/expand.el
deleted file mode 100644
index 1b46d4b3f68..00000000000
--- a/lisp/expand.el
+++ /dev/null
@@ -1,496 +0,0 @@
-;; expand.el --- make abbreviations more usable.
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
-;; Maintainer: Frederic Lepied <Frederic.Lepied@sugix.frmug.org>
-;; Keywords: abbrev
-
-;; 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 defines abbrevs which expand into structured constructs
-;; for certain languages.  The construct is indented for you,
-;; and contains slots for you to fill in other text.
-
-;; These abbrevs expand only at the end of a line and when not in a comment
-;; or a string.
-;;
-;;   Look at the Sample: section for emacs-lisp, perl and c expand lists.
-;; For example for c-mode, you could declare your abbrev table with :
-;;
-;; (defconst c-expand-list
-;;   '(("if" "if () {\n \n} else {\n \n}" (5 10 21))
-;;     ("ifn" "if () {}" (5 8))
-;;     ("uns" "unsigned ")
-;;     ("for" "for(; ; ) {\n\n}" (5 7 9 13))
-;;     ("switch" "switch () {\n\n}" (9 13))
-;;     ("case" "case :\n\nbreak;\n" (6 8 16))
-;;     ("do" "do {\n\n} while ();" (6 16))
-;;     ("while" "while () {\n\n}" (8 12))
-;;     ("default" "default:\n\nbreak;" 10)
-;;     ("main" "int\nmain(int argc, char * argv[])\n{\n\n}\n" 37))
-;;   "Expansions for C mode")
-;; 
-;;   and enter Abbrev mode with the following hook :
-;;
-;; (add-hook 'c-mode-hook (function (lambda ()
-;; 				   (expand-add-abbrevs c-mode-abbrev-table c-expand-list)
-;; 				   (abbrev-mode))))
-;;
-;;   you can also init some post-process hooks :
-;;
-;; (add-hook 'expand-load-hook
-;; 	  (function
-;; 	   (lambda ()
-;; 	     (add-hook 'expand-expand-hook 'indent-according-to-mode)
-;; 	     (add-hook 'expand-jump-hook 'indent-according-to-mode))))
-;;
-;; Remarks:
-;;
-;;   Many thanks to Heddy Boubaker <boubaker@cenatls.cena.dgac.fr>,
-;;                  Jerome Santini <santini@chambord.univ-orleans.fr>,
-;;                  Jari Aalto <jaalto@tre.tele.nokia.fi>.
-;;
-;;   Please send me a word to give me your feeling about this feature or
-;; to explain me how you use it (your expansions table for example) using
-;; the function expand-submit-report.
-
-;;; Constants:
-
-(defvar expand-load-hook nil
-  "Hooks run when `expand.el' is loaded.")
-
-(defvar expand-expand-hook nil
-  "Hooks run when an abbrev made by `expand-add-abbrevs' is expanded.")
-
-(defvar expand-jump-hook nil
-  "Hooks run by `expand-jump-to-previous-slot' and `expand-jump-to-next-slot'.")
-
-;;; Samples:
-
-(define-skeleton expand-c-for-skeleton "For loop skeleton"
-  "Loop var: "
-  "for(" str _ @ "=0; " str @ "; " str @ ") {" \n
-  @ _ \n
-  "}" >
-  )
-
-(defconst expand-c-sample-expand-list
-  '(("if" "if () {\n \n} else {\n \n}" (5 10 21))
-    ("ifn" "if () {}" (5 8))
-    ("uns" "unsigned ")
-    ("for" expand-c-for-skeleton)
-    ("switch" "switch () {\n\n}" (9 13))
-    ("case" "case :\n\nbreak;\n" (6 8 16))
-    ("do" "do {\n\n} while ();" (6 16))
-    ("while" "while () {\n\n}" (8 12))
-    ("default" "default:\n\nbreak;" 10)
-    ("main" "int\nmain(int argc, char * argv[])\n{\n\n}\n" 37))
-  "Expansions for C mode. See `expand-add-abbrevs'.")
-
-;; lisp example from Jari Aalto <jaalto@tre.tele.nokia.fi>
-(defconst expand-sample-lisp-mode-expand-list
-  (list
-   (list
-    "defu"
-    (concat
-     "(defun   ()\n"
-     "  \"\"\n"
-     "  (interactive)\n"
-     "  (let* (\n"
-     "         )\n"
-     "    \n"
-     "    ))")
-    (list 8 11 16 32 43 59))
-
-   (list
-    "defs"
-    (concat
-     "(defsubst   ()\n"
-     "  \"\"\n"
-     "  (interactive)\n"
-     "  )")
-    (list 11 14 19 23 39))
-
-   (list
-    "defm"
-    (concat
-     "(defmacro  ()\n"
-     "  \"\"\n"
-     "  (` \n"
-     "    ))")
-    (list 11 13 18 25))
-
-   (list
-    "defa"
-    (concat
-     "(defadvice   (around   act)\n"
-     "  \"\"\n"
-     "  \n"
-     "  )")
-    (list 12 22 32 36))
-
-    (list
-     "defc"
-     "(defconst   nil\n  \"\")\n"
-     (list 11 13 20))
-
-    (list
-     "defv"
-     "(defvar   nil\n  \"\")\n"
-     (list 9 11 18))
-
-    (list
-     "let"
-     "(let* (\n)\n    "
-     (list 8 13))
-
-     (list
-     "sav"
-     "(save-excursion\n \n)"
-     (list 18))
-
-     (list
-     "aut"
-     "(autoload ' \"\" t t)\n"
-     (list 12 14))
-
-    )
-   "Expansions for Lisp mode. See `expand-add-abbrevs'.")
- 
-;; perl example from Jari Aalto <jaalto@tre.tele.nokia.fi>
-(defconst expand-sample-perl-mode-expand-list
-  (list
-   (list
-    ;;   This is default perl4 subroutine template
-    ;;
-    "sub"
-    (concat
-     "#" (make-string 70 ?-) "\n"
-     "sub   {\n"
-     "    # DESCRIPTION\n"
-     "    #   \n"
-     "    #   \n"
-     "    # INPUT\n"
-     "    #   \n"
-     "    #   \n"
-     "    # RETURN\n"
-     "    #   \n"
-     "\n"
-     "    local( $f ) = \"$lib.\";\n"   ;; Function name AFTER period
-     "    local() = @_;\n"              ;; func arguments here
-     "    \n"
-     "    \n}\n"
-     )
-    (list 77 88 120 146 159 176))
-
-   (list
-    "for"                               ; foreach
-    (concat
-     "for (  )\n"
-     "{\n\n\}"
-     )
-    (list 7 12))
-
-   (list
-    "whi"                               ; foreach
-    (concat
-     "while (  )\n"
-     "{\n\n\}"
-     )
-    (list 9 15))
-
-
-   ;;   The normal "if" can be used like
-   ;;   print $F "xxxxxx"  if defined @arr;
-   ;;
-   (list
-    "iff"
-    (concat
-     "if (  )\n"
-     "{\n\n\}"
-     )
-    (list 6 12))
-
-   (list "loc"  "local( $ );"   (list 9))
-   (list "my"   "my( $ );"      (list 6))
-   (list "ope"  "open(,\"\")\t|| die \"$f: Can't open [$]\";" (list 6 8 36))
-   (list "clo"  "close ;"       7)
-   (list "def"  "defined  "     (list 9))
-   (list "und"  "undef ;"       (list 7))
-
-   ;;   There is no ending colon, because they can be in statement
-   ;;    defined $REXP_NOT_NEW && (print "xxxxx" );
-   ;;
-   (list "pr"  "print "         7)
-   (list "pf"  "printf "        8)
-
-
-   (list "gre"  "grep( //, );"  (list 8 11))
-   (list "pus"  "push( , );"    (list 7 9))
-   (list "joi"  "join( '', );"  (list 7 11))
-   (list "rtu"  "return ;"      (list 8))
-
-   )
-  "Expansions for Perl mode. See `expand-add-abbrevs'.")
-
-;;; Code:
-
-;;;###autoload
-(defun expand-add-abbrevs (table abbrevs)
-  "Add a list of abbrev to abbrev table TABLE.
-ABBREVS is a list of abbrev definitions; each abbrev description entry
-has the form (ABBREV EXPANSION ARG).
-
-ABBREV is the abbreviation to replace.
-
-EXPANSION is the replacement string or a function which will make the
-expansion.  For example you, could use the DMacros or skeleton packages
-to generate such functions.
-
-ARG is an optional argument which can be a number or a list of
-numbers.  If ARG is a number, point is placed ARG chars from the
-beginning of the expanded text.
-
-If ARG is a list of numbers, point is placed according to the first
-member of the list, but you can visit the other specified positions
-cyclicaly with the functions `expand-jump-to-previous-slot' and
-`expand-jump-to-next-slot'.
-
-If ARG is omitted, point is placed at the end of the expanded text."
-
-  (if (null abbrevs)
-      table
-    (expand-add-abbrev table (nth 0 (car abbrevs)) (nth 1 (car abbrevs))
-		       (nth 2 (car abbrevs)))
-    (expand-add-abbrevs table (cdr abbrevs))))
-
-(defvar expand-list nil "Temporary variable used by the Expand package.")
-
-(defvar expand-pos nil
-  "If non nil, stores a vector containing markers to positions defined by the last expansion.
-This variable is local to a buffer.")
-(make-variable-buffer-local 'expand-pos)
-
-(defvar expand-index 0
-  "Index of the last marker used in `expand-pos'.
-This variable is local to a buffer.")
-(make-variable-buffer-local 'expand-index)
-
-(defvar expand-point nil
-  "End of the expanded region.
-This variable is local to a buffer.")
-(make-variable-buffer-local 'expand-point)
-
-(defun expand-add-abbrev (table abbrev expansion arg)
-  "Add one abbreviation and provide the hook to move to the specified positions."
-  (let* ((string-exp (if (and (symbolp expansion) (fboundp expansion))
-			 nil
-		       expansion))
-         (position   (if (and arg string-exp)
-			 (if (listp arg)
-			     (- (length expansion) (1- (car arg)))
-			   (- (length expansion) (1- arg)))
-		       0)))
-    (define-abbrev
-      table
-      abbrev
-      (vector string-exp
-	      position
-	      (if (and (listp arg)
-		       (not (null arg)))
-		  (cons (length string-exp) arg)
-		nil)
-	      (if (and (symbolp expansion) (fboundp expansion))
-		  expansion
-		nil)
-	      )
-      'expand-abbrev-hook)))
-
-(put 'expand-abbrev-hook 'no-self-insert t)
-(defun expand-abbrev-hook ()
-  "Abbrev hook used to do the expansion job of expand abbrevs.
-See `expand-add-abbrevs'."
-  ;; Expand only at the end of a line if we are near a word that has
-  ;; an abbrev built from expand-add-abbrev.
-  (if (and (eolp)
-	   (not (expand-in-literal)))
-      (let ((p (point)))
-	(setq expand-point nil)
-	;; don't expand if the preceding char isn't a word constituent
-	(if (and (eq (char-syntax (preceding-char))
-		     ?w)
-		 (expand-do-expansion))
-	    (progn
-	      ;; expand-point tells us if we have inserted the text
-	      ;; ourself or if it is the hook which has done the job.
-	      (if expand-point
-		  (progn
-		    (if (vectorp expand-list)
-			(expand-build-marks expand-point))
-		    (indent-region p expand-point nil))
-		;; an outside function can set expand-list to a list of
-		;; markers in reverse order.
-		(if (listp expand-list)
-		    (setq expand-index 0
-			  expand-pos (expand-list-to-markers expand-list)
-			  expand-list nil)))
-	      (run-hooks 'expand-expand-hook)
-	      t))))
-  )
-
-(defun expand-do-expansion ()
-  (delete-backward-char (length last-abbrev-text))
-  (let* ((vect (symbol-value last-abbrev))
-	 (text (aref vect 0))
-	 (position (aref vect 1))
-	 (jump-args (aref vect 2))
-	 (hook (aref vect 3)))
-    (cond (text
-	   (insert text)
-	   (setq expand-point (point))))
-    (if jump-args
-	(funcall 'expand-build-list (car jump-args) (cdr jump-args)))
-    (if position
-	(backward-char position))
-    (if hook
-	(funcall hook))
-    t)
-  )
-
-(defun expand-abbrev-from-expand (word)
-  "Test if an abbrev has a hook."
-  (or
-   (and (intern-soft word local-abbrev-table)
-	(symbol-function (intern-soft word local-abbrev-table)))
-   (and (intern-soft word global-abbrev-table)
-	(symbol-function (intern-soft word global-abbrev-table)))))
-
-(defun expand-previous-word ()
-  "Return the previous word."
-  (save-excursion
-    (let ((p (point)))
-      (backward-word 1)
-      (buffer-substring p (point)))))
-
-;;;###autoload
-(defun expand-jump-to-previous-slot ()
-  "Move the cursor to the previous slot in the last abbrev expansion.
-This is used only in conjunction with `expand-add-abbrevs'."
-  (interactive)
-  (if expand-pos
-      (progn
-	(setq expand-index (1- expand-index))
-	(if (< expand-index 0)
-	    (setq expand-index (1- (length expand-pos))))
-	(goto-char (aref expand-pos expand-index))
-	(run-hooks 'expand-jump-hook))))
-
-;;;###autoload
-(defun expand-jump-to-next-slot ()
-  "Move the cursor to the next slot in the last abbrev expansion.
-This is used only in conjunction with `expand-add-abbrevs'."
-  (interactive)
-  (if expand-pos
-      (progn
-	(setq expand-index (1+ expand-index))
-	(if (>= expand-index (length expand-pos))
-	    (setq expand-index 0))
-	(goto-char (aref expand-pos expand-index))
-	(run-hooks 'expand-jump-hook))))
-
-;;;###autoload (define-key ctl-x-map "ap" 'expand-jump-to-previous-slot)
-;;;###autoload (define-key ctl-x-map "an" 'expand-jump-to-next-slot)
-
-(defun expand-build-list (len l)
-  "Build a vector of offset positions from the list of positions."
-  (expand-clear-markers)
-  (setq expand-list (vconcat l))
-  (let ((i 0)
-	(lenlist (length expand-list)))
-    (while (< i lenlist)
-      (aset expand-list i (- len (1- (aref expand-list i))))
-      (setq i (1+ i))))
-  )
-
-(defun expand-build-marks (p)
-  "Transform the offsets vector into a marker vector."
-  (if expand-list
-      (progn
-	(setq expand-index 0)
-	(setq expand-pos (make-vector (length expand-list) nil))
-	(let ((i (1- (length expand-list))))
-	  (while (>= i 0)
-	    (aset expand-pos i (copy-marker (- p (aref expand-list i))))
-	    (setq i (1- i))))
-	(setq expand-list nil))))
-
-(defun expand-clear-markers ()
-  "Make the markers point nowhere."
-  (if expand-pos
-      (progn
-    (let ((i (1- (length expand-pos))))
-      (while (>= i 0)
-	(set-marker (aref expand-pos i) nil)
-	(setq i (1- i))))
-    (setq expand-pos nil))))
-
-(defun expand-in-literal ()
-  "Test if we are in a comment or in a string."
-  (save-excursion
-    (let* ((lim (or (save-excursion
-		      (beginning-of-defun)
-		      (point))
-		    (point-min)))
-	   (here (point))
-	   (state (parse-partial-sexp lim (point))))
-      (cond
-       ((nth 3 state) 'string)
-       ((nth 4 state) 'comment)
-       (t nil)))))
-
-;; support functions to add marks to jump from outside function
-
-(defun expand-list-to-markers (l)
-  "Transform a list of markers in reverse order into a vector in the correct order."
-  (let* ((len (1- (length l)))
-	 (loop len)
-	 (v (make-vector (+ len 1) nil)))
-    (while (>= loop 0)
-      (aset v loop (if (markerp (car l)) (car l) (copy-marker (car l))))
-      (setq l (cdr l)
-	    loop (1- loop)))
-    v))
-
-;; integration with skeleton.el
-;; Used in `skeleton-end-hook' to fetch the positions for  @ skeleton tags.
-;; See `skeleton-insert'.
-(defun expand-skeleton-end-hook ()
-  (if skeleton-positions
-      (setq expand-list skeleton-positions)))
-  
-(add-hook 'skeleton-end-hook (function expand-skeleton-end-hook))
-
-(provide 'expand)
-
-;; run load hooks
-(run-hooks 'expand-load-hook)
-
-;;; expand.el ends here
diff --git a/lisp/facemenu.el b/lisp/facemenu.el
deleted file mode 100644
index 07d5f52c628..00000000000
--- a/lisp/facemenu.el
+++ /dev/null
@@ -1,658 +0,0 @@
-;;; facemenu.el --- create a face menu for interactively adding fonts to text
-
-;; Copyright (c) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
-;; Keywords: 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 defines a menu of faces (bold, italic, etc) which allows you to
-;; set the face used for a region of the buffer.  Some faces also have
-;; keybindings, which are shown in the menu.  Faces with names beginning with
-;; "fg:" or "bg:", as in "fg:red", are treated specially.
-;; Such faces are assumed to consist only of a foreground (if "fg:") or
-;; background (if "bg:") color.  They are thus put into the color submenus
-;; rather than the general Face submenu.  These faces can also be
-;; automatically created by selecting the "Other..." menu items in the
-;; "Foreground" and "Background" submenus.
-;;
-;; The menu also contains submenus for indentation and justification-changing
-;; commands.
-
-;;; Usage:
-;; Selecting a face from the menu or typing the keyboard equivalent will
-;; change the region to use that face.  If you use transient-mark-mode and the
-;; region is not active, the face will be remembered and used for the next
-;; insertion.  It will be forgotten if you move point or make other
-;; modifications before inserting or typing anything.
-;;
-;; Faces can be selected from the keyboard as well.  
-;; The standard keybindings are M-g (or ESC g) + letter:
-;; M-g i = "set italic",  M-g b = "set bold", etc.
-
-;;; Customization:
-;; An alternative set of keybindings that may be easier to type can be set up
-;; using "Alt" or "Hyper" keys.  This requires that you either have or create
-;; an Alt or Hyper key on your keyboard.  On my keyboard, there is a key
-;; labeled "Alt", but to make it act as an Alt key I have to put this command
-;; into my .xinitrc:
-;;    xmodmap -e "add Mod3 = Alt_L"
-;; Or, I can make it into a Hyper key with this:
-;;    xmodmap -e "keysym Alt_L = Hyper_L" -e "add Mod2 = Hyper_L"
-;; Check with local X-perts for how to do it on your system.
-;; Then you can define your keybindings with code like this in your .emacs:
-;;   (setq facemenu-keybindings
-;;    '((default     . [?\H-d])
-;;      (bold        . [?\H-b])
-;;      (italic      . [?\H-i])
-;;      (bold-italic . [?\H-l])
-;;      (underline   . [?\H-u])))
-;;   (setq facemenu-keymap global-map)
-;;   (setq facemenu-key nil)
-;;   (define-key global-map [?\H-c] 'facemenu-set-foreground) ; set fg color
-;;   (define-key global-map [?\H-C] 'facemenu-set-background) ; set bg color
-;;   (require 'facemenu)
-;;
-;; The order of the faces that appear in the menu and their keybindings can be
-;; controlled by setting the variables `facemenu-keybindings' and
-;; `facemenu-new-faces-at-end'.  List faces that you don't use in documents
-;; (eg, `region') in `facemenu-unlisted-faces'.
-
-;;; Known Problems:
-;; Bold and Italic do not combine to create bold-italic if you select them
-;; both, although most other combinations (eg bold + underline + some color)
-;; do the intuitive thing.
-;;
-;; There is at present no way to display what the faces look like in
-;; the menu itself.
-;;
-;; `list-faces-display' shows the faces in a different order than
-;; this menu, which could be confusing.  I do /not/ sort the list
-;; alphabetically, because I like the default order: it puts the most
-;; basic, common fonts first.
-;;
-;; Please send me any other problems, comments or ideas.
-
-;;; Code:
-
-(provide 'facemenu)
-
-;;; Provide some binding for startup:
-;;;###autoload (define-key global-map "\M-g" 'facemenu-keymap)
-;;;###autoload (autoload 'facemenu-keymap "facemenu" "Keymap for face-changing commands." t 'keymap)
-
-(defvar facemenu-key "\M-g"
-  "Prefix key to use for facemenu commands.")
-
-(defvar facemenu-keybindings
-  '((default     . "d")
-    (bold        . "b")
-    (italic      . "i")
-    (bold-italic . "l") ; {bold} intersect {italic} = {l}
-    (underline   . "u"))
-  "Alist of interesting faces and keybindings. 
-Each element is itself a list: the car is the name of the face,
-the next element is the key to use as a keyboard equivalent of the menu item;
-the binding is made in facemenu-keymap.
-
-The faces specifically mentioned in this list are put at the top of
-the menu, in the order specified.  All other faces which are defined,
-except for those in `facemenu-unlisted-faces', are listed after them, 
-but get no keyboard equivalents.
-
-If you change this variable after loading facemenu.el, you will need to call
-`facemenu-update' to make it take effect.")
-
-(defvar facemenu-new-faces-at-end t
-  "Where in the menu to insert newly-created faces.
-This should be nil to put them at the top of the menu, or t to put them
-just before \"Other\" at the end.")
-
-(defvar facemenu-unlisted-faces
-  '(modeline region secondary-selection highlight scratch-face)
-  "List of faces not to include in the Face menu.
-You can set this list before loading facemenu.el, or add a face to it before
-creating that face if you do not want it to be listed.  If you change the
-variable so as to eliminate faces that have already been added to the menu,
-call `facemenu-update' to recalculate the menu contents.
-
-If this variable is t, no faces will be added to the menu.  This is useful for
-temporarily turning off the feature that automatically adds faces to the menu
-when they are created.")
-
-;;;###autoload
-(defvar facemenu-face-menu
-  (let ((map (make-sparse-keymap "Face")))
-    (define-key map "o" (cons "Other..." 'facemenu-set-face))
-    map)
-  "Menu keymap for faces.")
-;;;###autoload
-(defalias 'facemenu-face-menu facemenu-face-menu)
-
-;;;###autoload
-(defvar facemenu-foreground-menu 
-  (let ((map (make-sparse-keymap "Foreground Color")))
-    (define-key map "o" (cons "Other..." 'facemenu-set-foreground))
-    map)
-  "Menu keymap for foreground colors.")
-;;;###autoload
-(defalias 'facemenu-foreground-menu facemenu-foreground-menu)
-
-;;;###autoload
-(defvar facemenu-background-menu
-  (let ((map (make-sparse-keymap "Background Color")))
-    (define-key map "o" (cons "Other..." 'facemenu-set-background))
-    map)
-  "Menu keymap for background colors")
-;;;###autoload
-(defalias 'facemenu-background-menu facemenu-background-menu)
-
-;;;###autoload
-(defvar facemenu-special-menu 
-  (let ((map (make-sparse-keymap "Special")))
-    (define-key map [?s] (cons "Remove Special" 'facemenu-remove-special))
-    (define-key map [?t] (cons "Intangible" 'facemenu-set-intangible))
-    (define-key map [?v] (cons "Invisible" 'facemenu-set-invisible))
-    (define-key map [?r] (cons "Read-Only" 'facemenu-set-read-only))
-    map)
-  "Menu keymap for non-face text-properties.")
-;;;###autoload
-(defalias 'facemenu-special-menu facemenu-special-menu)
-
-;;;###autoload
-(defvar facemenu-justification-menu
-  (let ((map (make-sparse-keymap "Justification")))
-    (define-key map [?c] (cons "Center" 'set-justification-center))
-    (define-key map [?b] (cons "Full" 'set-justification-full))
-    (define-key map [?r] (cons "Right" 'set-justification-right))
-    (define-key map [?l] (cons "Left" 'set-justification-left))
-    (define-key map [?u] (cons "Unfilled" 'set-justification-none))
-    map)
-  "Submenu for text justification commands.")
-;;;###autoload
-(defalias 'facemenu-justification-menu facemenu-justification-menu)
-
-;;;###autoload
-(defvar facemenu-indentation-menu
-  (let ((map (make-sparse-keymap "Indentation")))
-    (define-key map [decrease-right-margin] 
-      (cons "Indent Right Less" 'decrease-right-margin))
-    (define-key map [increase-right-margin]
-      (cons "Indent Right More" 'increase-right-margin))
-    (define-key map [decrease-left-margin]
-      (cons "Indent Less" 'decrease-left-margin))
-    (define-key map [increase-left-margin]
-      (cons "Indent More" 'increase-left-margin))
-    map)
-  "Submenu for indentation commands.")
-;;;###autoload
-(defalias 'facemenu-indentation-menu facemenu-indentation-menu)
-
-;; This is split up to avoid an overlong line in loaddefs.el.
-;;;###autoload
-(defvar facemenu-menu nil
-  "Facemenu top-level menu keymap.")
-;;;###autoload
-(setq facemenu-menu (make-sparse-keymap "Text Properties"))
-;;;###autoload
-(let ((map facemenu-menu))
-  (define-key map [dc] (cons "Display Colors" 'list-colors-display))
-  (define-key map [df] (cons "Display Faces" 'list-faces-display))
-  (define-key map [dp] (cons "List Properties" 'list-text-properties-at))
-  (define-key map [ra] (cons "Remove All" 'facemenu-remove-all))
-  (define-key map [rm] (cons "Remove Properties" 'facemenu-remove-props))
-  (define-key map [s1] (list "-----------------")))
-;;;###autoload
-(let ((map facemenu-menu))
-  (define-key map [in] (cons "Indentation" 'facemenu-indentation-menu))
-  (define-key map [ju] (cons "Justification" 'facemenu-justification-menu))
-  (define-key map [s2] (list "-----------------"))
-  (define-key map [sp] (cons "Special Properties" 'facemenu-special-menu))
-  (define-key map [bg] (cons "Background Color" 'facemenu-background-menu))
-  (define-key map [fg] (cons "Foreground Color" 'facemenu-foreground-menu))
-  (define-key map [fc] (cons "Face" 'facemenu-face-menu)))
-;;;###autoload
-(defalias 'facemenu-menu facemenu-menu)
-
-(defvar facemenu-keymap 
-  (let ((map (make-sparse-keymap "Set face")))
-    (define-key map "o" (cons "Other..." 'facemenu-set-face))
-    map)
-  "Keymap for face-changing commands.
-`Facemenu-update' fills in the keymap according to the bindings
-requested in `facemenu-keybindings'.")
-(defalias 'facemenu-keymap facemenu-keymap)
-
-
-(defvar facemenu-add-face-function nil
-  "Function called at beginning of text to change or `nil'.
-This function is passed the FACE to set and END of text to change, and must
-return a string which is inserted.  It may set `facemenu-end-add-face'.")
-
-(defvar facemenu-end-add-face nil
-  "String to insert or function called at end of text to change or `nil'.
-This function is passed the FACE to set, and must return a string which is
-inserted.")
-
-(defvar facemenu-remove-face-function nil
-  "When non-`nil' function called to remove faces.
-This function is passed the START and END of text to change.
-May also be `t' meaning to use `facemenu-add-face-function'.")
-
-;;; Internal Variables
-
-(defvar facemenu-color-alist nil
-  ;; Don't initialize here; that doesn't work if preloaded.
-  "Alist of colors, used for completion.
-If null, `facemenu-read-color' will set it.")
-
-(defun facemenu-update ()
-  "Add or update the \"Face\" menu in the menu bar.
-You can call this to update things if you change any of the menu configuration
-variables."
-  (interactive)
-  
-  ;; Global bindings:
-  (define-key global-map [C-down-mouse-2] 'facemenu-menu)
-  (if facemenu-key (define-key global-map facemenu-key 'facemenu-keymap))
-
-  ;; Add each defined face to the menu.
-  (facemenu-iterate 'facemenu-add-new-face
-		    (facemenu-complete-face-list facemenu-keybindings)))
-
-;;;###autoload
-(defun facemenu-set-face (face &optional start end)
-  "Add FACE to the region or next character typed.
-It will be added to the top of the face list; any faces lower on the list that
-will not show through at all will be removed.
-
-Interactively, the face to be used is read with the minibuffer.
-
-If the region is active and there is no prefix argument,
-this command sets the region to the requested face.
-
-Otherwise, this command specifies the face for the next character
-inserted.  Moving point or switching buffers before
-typing a character to insert cancels the specification." 
-  (interactive (list (read-face-name "Use face: ")))
-  (barf-if-buffer-read-only)
-  (facemenu-add-new-face face)
-  (if (and mark-active (not current-prefix-arg))
-      (let ((start (or start (region-beginning)))
-	    (end (or end (region-end))))
-	(facemenu-add-face face start end))
-    (facemenu-add-face face)))
-
-;;;###autoload
-(defun facemenu-set-foreground (color &optional start end)
-  "Set the foreground color of the region or next character typed.
-The color is prompted for.  A face named `fg:color' is used \(or created).
-If the region is active, it will be set to the requested face.  If
-it is inactive \(even if mark-even-if-inactive is set) the next
-character that is typed \(via `self-insert-command') will be set to
-the selected face.  Moving point or switching buffers before
-typing a character cancels the request." 
-  (interactive (list (facemenu-read-color "Foreground color: ")))
-  (let ((face (intern (concat "fg:" color))))
-    (or (facemenu-get-face face)
-	(error "Unknown color: %s" color))
-    (facemenu-set-face face start end)))
-
-;;;###autoload
-(defun facemenu-set-background (color &optional start end)
-  "Set the background color of the region or next character typed.
-The color is prompted for.  A face named `bg:color' is used \(or created).
-If the region is active, it will be set to the requested face.  If
-it is inactive \(even if mark-even-if-inactive is set) the next
-character that is typed \(via `self-insert-command') will be set to
-the selected face.  Moving point or switching buffers before
-typing a character cancels the request." 
-  (interactive (list (facemenu-read-color "Background color: ")))
-  (let ((face (intern (concat "bg:" color))))
-    (or (facemenu-get-face face)
-	(error "Unknown color: %s" color))
-    (facemenu-set-face face start end)))
-
-;;;###autoload
-(defun facemenu-set-face-from-menu (face start end)
-  "Set the face of the region or next character typed.
-This function is designed to be called from a menu; the face to use
-is the menu item's name.
-
-If the region is active and there is no prefix argument,
-this command sets the region to the requested face.
-
-Otherwise, this command specifies the face for the next character
-inserted.  Moving point or switching buffers before
-typing a character to insert cancels the specification." 
-  (interactive (list last-command-event
-		     (if (and mark-active (not current-prefix-arg))
-			 (region-beginning))
-		     (if (and mark-active (not current-prefix-arg))
-			 (region-end))))
-  (barf-if-buffer-read-only)
-  (facemenu-get-face face)
-  (if start 
-      (facemenu-add-face face start end)
-    (facemenu-add-face face)))
-
-;;;###autoload
-(defun facemenu-set-invisible (start end)
-  "Make the region invisible.
-This sets the `invisible' text property; it can be undone with
-`facemenu-remove-special'."
-  (interactive "r")
-  (put-text-property start end 'invisible t))
-
-;;;###autoload
-(defun facemenu-set-intangible (start end)
-  "Make the region intangible: disallow moving into it.
-This sets the `intangible' text property; it can be undone with
-`facemenu-remove-special'."
-  (interactive "r")
-  (put-text-property start end 'intangible t))
-
-;;;###autoload
-(defun facemenu-set-read-only (start end)
-  "Make the region unmodifiable.
-This sets the `read-only' text property; it can be undone with
-`facemenu-remove-special'."
-  (interactive "r")
-  (put-text-property start end 'read-only t))
-
-;;;###autoload
-(defun facemenu-remove-props (start end)
-  "Remove all text properties that facemenu added to region."
-  (interactive "*r") ; error if buffer is read-only despite the next line.
-  (let ((inhibit-read-only t))
-    (remove-text-properties 
-     start end '(face nil invisible nil intangible nil 
-		      read-only nil category nil))))
-
-;;;###autoload
-(defun facemenu-remove-all (start end)
-  "Remove all text properties from the region."
-  (interactive "*r") ; error if buffer is read-only despite the next line.
-  (let ((inhibit-read-only t))
-    (set-text-properties start end nil)))
-
-;;;###autoload
-(defun facemenu-remove-special (start end)
-  "Remove all the \"special\" text properties from the region.
-These special properties include `invisible', `intangible' and `read-only'."
-  (interactive "*r") ; error if buffer is read-only despite the next line.
-  (let ((inhibit-read-only t))
-    (remove-text-properties 
-     start end '(invisible nil intangible nil read-only nil))))
-
-;;;###autoload
-(defun list-text-properties-at (p)
-  "Pop up a buffer listing text-properties at LOCATION."
-  (interactive "d")
-  (let ((props (text-properties-at p))
-	category
-	str)
-    (if (null props)
-	(message "None")
-      (if (and (not (cdr (cdr props)))
-	       (not (eq (car props) 'category))
-	       (< (length (setq str (format "Text property at %d:  %s  %S"
-					    p (car props) (car (cdr props)))))
-		  (frame-width)))
-	  (message "%s" str)
-	(with-output-to-temp-buffer "*Text Properties*"
-	  (princ (format "Text properties at %d:\n\n" p))
-	  (while props
-	    (if (eq (car props) 'category)
-		(setq category (car (cdr props))))
-	    (princ (format "%-20s %S\n"
-			   (car props) (car (cdr props))))
-	    (setq props (cdr (cdr props))))
-	  (if category
-	      (progn
-		(setq props (symbol-plist category))
-		(princ (format "\nCategory %s:\n\n" category))
-		(while props
-		  (princ (format "%-20s %S\n"
-				 (car props) (car (cdr props))))
-		  (if (eq (car props) 'category)
-		      (setq category (car (cdr props))))
-		  (setq props (cdr (cdr props)))))))))))
-
-;;;###autoload
-(defun facemenu-read-color (&optional prompt)
-  "Read a color using the minibuffer."
-  (let ((col (completing-read (or prompt "Color: ") 
-			      (or facemenu-color-alist
-				  (if window-system
-				      (mapcar 'list (x-defined-colors))))
-			      nil t)))
-    (if (equal "" col)
-	nil
-      col)))
-
-;;;###autoload
-(defun list-colors-display (&optional list)
-  "Display names of defined colors, and show what they look like.
-If the optional argument LIST is non-nil, it should be a list of
-colors to display.  Otherwise, this command computes a list
-of colors that the current display can handle."
-  (interactive)
-  (if (and (null list) window-system)
-      (progn
-	(setq list (x-defined-colors))
-	;; Delete duplicate colors.
-	(let ((l list))
-	  (while (cdr l)
-	    (if (facemenu-color-equal (car l) (car (cdr l)))
-		(setcdr l (cdr (cdr l)))
-	      (setq l (cdr l)))))))
-  (with-output-to-temp-buffer "*Colors*"
-    (save-excursion
-      (set-buffer standard-output)
-      (let ((facemenu-unlisted-faces t)
-	    s)
-	(while list
-	  (setq s (point))
-	  (insert (car list))
-	  (indent-to 20)
-	  (put-text-property s (point) 'face 
-			     (facemenu-get-face 
-			      (intern (concat "bg:" (car list)))))
-	  (setq s (point))
-	  (insert "  " (car list) "\n")
-	  (put-text-property s (point) 'face 
-			     (facemenu-get-face 
-			      (intern (concat "fg:" (car list)))))
-	  (setq list (cdr list)))))))
-
-(defun facemenu-color-equal (a b)
-  "Return t if colors A and B are the same color.
-A and B should be strings naming colors.
-This function queries the window-system server to find out what the
-color names mean.  It returns nil if the colors differ or if it can't
-determine the correct answer."
-  (cond ((equal a b) t)
-	((and (memq window-system '(x w32))
-	      (equal (x-color-values a) (x-color-values b))))
-	((eq window-system 'pc)
-	 (and (x-color-defined-p a) (x-color-defined-p b)
-	      (eq (msdos-color-translate a) (msdos-color-translate b))))))
-
-(defun facemenu-add-face (face &optional start end)
-  "Add FACE to text between START and END.
-If START is `nil' or START to END is empty, add FACE to next typed character
-instead.  For each section of that region that has a different face property,
-FACE will be consed onto it, and other faces that are completely hidden by
-that will be removed from the list.
-If `facemenu-add-face-function' and maybe `facemenu-end-add-face' are non-`nil'
-they are used to set the face information.
-
-As a special case, if FACE is `default', then the region is left with NO face
-text property.  Otherwise, selecting the default face would not have any
-effect.  See `facemenu-remove-face-function'."
-  (interactive "*xFace: \nr")
-  (if (and (eq face 'default)
-	   (not (eq facemenu-remove-face-function t)))
-      (if facemenu-remove-face-function
-	  (funcall facemenu-remove-face-function start end)
-	(if (and start (< start end))
-	    (remove-text-properties start end '(face default))
-	  (setq self-insert-face 'default
-		self-insert-face-command this-command)))
-    (if facemenu-add-face-function
-	(save-excursion
-	  (if end (goto-char end))
-	  (save-excursion
-	    (if start (goto-char start))
-	    (insert-before-markers
-	     (funcall facemenu-add-face-function face end)))
-	  (if facemenu-end-add-face
-	      (insert (if (stringp facemenu-end-add-face)
-			  facemenu-end-add-face
-			(funcall facemenu-end-add-face face)))))
-      (if (and start (< start end))
-	  (let ((part-start start) part-end)
-	    (while (not (= part-start end))
-	      (setq part-end (next-single-property-change part-start 'face
-							  nil end))
-	      (let ((prev (get-text-property part-start 'face)))
-		(put-text-property part-start part-end 'face
-				   (if (null prev)
-				       face
-				     (facemenu-active-faces
-				      (cons face
-					    (if (listp prev)
-						prev
-					      (list prev)))))))
-	      (setq part-start part-end)))
-	(setq self-insert-face (if (eq last-command self-insert-face-command)
-				   (cons face (if (listp self-insert-face)
-						  self-insert-face
-						(list self-insert-face)))
-				 face)
-	      self-insert-face-command this-command)))))
-
-(defun facemenu-active-faces (face-list &optional frame)
-  "Return from FACE-LIST those faces that would be used for display.
-This means each face attribute is not specified in a face earlier in FACE-LIST
-and such a face is therefore active when used to display text.
-If the optional argument FRAME is given, use the faces in that frame; otherwise
-use the selected frame.  If t, then the global, non-frame faces are used."
-  (let* ((mask-atts (copy-sequence (internal-get-face (car face-list) frame)))
-	 (active-list (list (car face-list)))
-	 (face-list (cdr face-list))
-	 (mask-len (length mask-atts)))
-    (while face-list
-      (if (let ((face-atts (internal-get-face (car face-list) frame))
-		(i mask-len) (useful nil))
-	    (while (> (setq i (1- i)) 1)
-	      (and (aref face-atts i) (not (aref mask-atts i))
-		   (aset mask-atts i (setq useful t))))
-	    useful)
-	  (setq active-list (cons (car face-list) active-list)))
-      (setq face-list (cdr face-list)))
-    (nreverse active-list)))
-
-(defun facemenu-get-face (symbol)
-  "Make sure FACE exists.
-If not, it is created.  If it is created and is of the form `fg:color', then
-set the foreground to that color. If of the form `bg:color', set the
-background.  In any case, add it to the appropriate menu.  Returns the face,
-or nil if given a bad color."
-  (if (or (internal-find-face symbol)
-	  (let* ((face (make-face symbol))
-		 (name (symbol-name symbol))
-		 (color (substring name 3)))
-	    (cond ((string-match "^fg:" name)
-		   (set-face-foreground face color)
-		   (and window-system
-			(x-color-defined-p color)))
-		  ((string-match "^bg:" name)
-		   (set-face-background face color)
-		   (and window-system
-			(x-color-defined-p color)))
-		  (t))))
-      symbol))
-
-(defun facemenu-add-new-face (face)
-  "Add a FACE to the appropriate Face menu.
-Automatically called when a new face is created."
-  (let* ((name (symbol-name face))
-	 (menu (cond ((string-match "^fg:" name) 
-		      (setq name (substring name 3))
-		      'facemenu-foreground-menu)
-		     ((string-match "^bg:" name) 
-		      (setq name (substring name 3))
-		      'facemenu-background-menu)
-		     (t 'facemenu-face-menu)))
-	 (key (cdr (assoc face facemenu-keybindings)))
-	 function menu-val)
-    (cond ((eq t facemenu-unlisted-faces))
-	  ((memq face facemenu-unlisted-faces))
-	  (key ; has a keyboard equivalent.  These go at the front.
-	   (setq function (intern (concat "facemenu-set-" name)))
-	   (fset function
-		 (` (lambda () (interactive)
-		      (facemenu-set-face (quote (, face))))))
-	   (define-key 'facemenu-keymap key (cons name function))
-	   (define-key menu key (cons name function)))
-	  ((facemenu-iterate ; check if equivalent face is already in the menu
-	    (lambda (m) (and (listp m) 
-			     (symbolp (car m))
-			     (face-equal (car m) face)))
-	    (cdr (symbol-function menu))))
-	  (t   ; No keyboard equivalent.  Figure out where to put it:
-	   (setq key (vector face)
-		 function 'facemenu-set-face-from-menu
-		 menu-val (symbol-function menu))
-	   (if (and facemenu-new-faces-at-end
-		   (> (length menu-val) 3))
-	       (define-key-after menu-val key (cons name function)
-		 (car (nth (- (length menu-val) 3) menu-val)))
-	     (define-key menu key (cons name function))))))
-  nil) ; Return nil for facemenu-iterate
-
-(defun facemenu-complete-face-list (&optional oldlist)
-  "Return list of all faces that look different.
-Starts with given ALIST of faces, and adds elements only if they display 
-differently from any face already on the list.
-The faces on ALIST will end up at the end of the returned list, in reverse 
-order."
-  (let ((list (nreverse (mapcar 'car oldlist))))
-    (facemenu-iterate 
-     (lambda (new-face) 
-       (if (not (memq new-face list))
-	   (setq list (cons new-face list)))
-       nil)
-     (nreverse (face-list)))
-    list))
-
-(defun facemenu-iterate (func iterate-list)
-  "Apply FUNC to each element of LIST until one returns non-nil.
-Returns the non-nil value it found, or nil if all were nil."
-  (while (and iterate-list (not (funcall func (car iterate-list))))
-    (setq iterate-list (cdr iterate-list)))
-  (car iterate-list))
-
-(facemenu-update)
-
-;;; facemenu.el ends here
diff --git a/lisp/faces.el b/lisp/faces.el
deleted file mode 100644
index 6d1e195b140..00000000000
--- a/lisp/faces.el
+++ /dev/null
@@ -1,1313 +0,0 @@
-;;; faces.el --- Lisp interface to the c "face" structure
-
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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:
-
-;; Mostly derived from Lucid.
-
-;;; Code:
-
-(eval-when-compile
- ;; These used to be defsubsts, now they're subrs.  Avoid losing if we're
- ;; being compiled with an old Emacs that still has defsubrs in it.
- (put 'face-name 'byte-optimizer nil)
- (put 'face-id 'byte-optimizer nil)
- (put 'face-font 'byte-optimizer nil)
- (put 'face-foreground 'byte-optimizer nil)
- (put 'face-background 'byte-optimizer nil)
- (put 'face-stipple 'byte-optimizer nil)
- (put 'face-underline-p 'byte-optimizer nil)
- (put 'set-face-font 'byte-optimizer nil)
- (put 'set-face-foreground 'byte-optimizer nil)
- (put 'set-face-background 'byte-optimizer nil)
- (put 'set-face-stipple 'byte-optimizer nil)
- (put 'set-face-underline-p 'byte-optimizer nil))
-
-;;;; Functions for manipulating face vectors.
-
-;;; A face vector is a vector of the form:
-;;;    [face NAME ID FONT FOREGROUND BACKGROUND STIPPLE UNDERLINE]
-
-;;; Type checkers.
-(defsubst internal-facep (x)
-  (and (vectorp x) (= (length x) 8) (eq (aref x 0) 'face)))
-
-(defun facep (x)
-  "Return t if X is a face name or an internal face vector."
-  (and (or (internal-facep x)
-	   (and (symbolp x) (assq x global-face-data)))
-       t))
-      
-(defmacro internal-check-face (face)
-  (` (or (internal-facep (, face))
-	 (signal 'wrong-type-argument (list 'internal-facep (, face))))))
-
-;;; Accessors.
-(defun face-name (face)
-  "Return the name of face FACE."
-  (aref (internal-get-face face) 1))
-
-(defun face-id (face)
-  "Return the internal ID number of face FACE."
-  (aref (internal-get-face face) 2))
-
-(defun face-font (face &optional frame)
-  "Return the font name of face FACE, or nil if it is unspecified.
-If the optional argument FRAME is given, report on face FACE in that frame.
-If FRAME is t, report on the defaults for face FACE (for new frames).
-  The font default for a face is either nil, or a list
-  of the form (bold), (italic) or (bold italic).
-If FRAME is omitted or nil, use the selected frame."
-  (aref (internal-get-face face frame) 3))
-
-(defun face-foreground (face &optional frame)
-  "Return the foreground color name of face FACE, or nil if unspecified.
-If the optional argument FRAME is given, report on face FACE in that frame.
-If FRAME is t, report on the defaults for face FACE (for new frames).
-If FRAME is omitted or nil, use the selected frame."
-  (aref (internal-get-face face frame) 4))
-
-(defun face-background (face &optional frame)
-  "Return the background color name of face FACE, or nil if unspecified.
-If the optional argument FRAME is given, report on face FACE in that frame.
-If FRAME is t, report on the defaults for face FACE (for new frames).
-If FRAME is omitted or nil, use the selected frame."
-  (aref (internal-get-face face frame) 5))
-
-(defun face-stipple (face &optional frame)
- "Return the stipple pixmap name of face FACE, or nil if unspecified.
-If the optional argument FRAME is given, report on face FACE in that frame.
-If FRAME is t, report on the defaults for face FACE (for new frames).
-If FRAME is omitted or nil, use the selected frame."
- (aref (internal-get-face face frame) 6))
-
-(defalias 'face-background-pixmap 'face-stipple)
-
-(defun face-underline-p (face &optional frame)
- "Return t if face FACE is underlined.
-If the optional argument FRAME is given, report on face FACE in that frame.
-If FRAME is t, report on the defaults for face FACE (for new frames).
-If FRAME is omitted or nil, use the selected frame."
- (aref (internal-get-face face frame) 7))
-
-
-;;; Mutators.
-
-(defun set-face-font (face font &optional frame)
-  "Change the font of face FACE to FONT (a string).
-If the optional FRAME argument is provided, change only
-in that frame; otherwise change each frame."
-  (interactive (internal-face-interactive "font"))
-  (if (stringp font) (setq font (x-resolve-font-name font 'default frame)))
-  (internal-set-face-1 face 'font font 3 frame))
-
-(defun set-face-foreground (face color &optional frame)
-  "Change the foreground color of face FACE to COLOR (a string).
-If the optional FRAME argument is provided, change only
-in that frame; otherwise change each frame."
-  (interactive (internal-face-interactive "foreground"))
-  (internal-set-face-1 face 'foreground color 4 frame))
-
-(defvar face-default-stipple "gray3" 
-  "Default stipple pattern used on monochrome displays.
-This stipple pattern is used on monochrome displays
-instead of shades of gray for a face background color.
-See `set-face-stipple' for possible values for this variable.")
-
-(defun face-color-gray-p (color &optional frame)
-  "Return t if COLOR is a shade of gray (or white or black).
-FRAME specifies the frame and thus the display for interpreting COLOR."
-  (let* ((values (x-color-values color frame))
-	 (r (nth 0 values))
-	 (g (nth 1 values))
-	 (b (nth 2 values)))
-    (and values
-	 (< (abs (- r g)) (/ (max 1 (abs r) (abs g)) 20))
-	 (< (abs (- g b)) (/ (max 1 (abs g) (abs b)) 20))
-	 (< (abs (- b r)) (/ (max 1 (abs b) (abs r)) 20)))))
-
-(defun set-face-background (face color &optional frame)
-  "Change the background color of face FACE to COLOR (a string).
-If the optional FRAME argument is provided, change only
-in that frame; otherwise change each frame."
-  (interactive (internal-face-interactive "background"))
-  ;; For a specific frame, use gray stipple instead of gray color
-  ;; if the display does not support a gray color.
-  (if (and frame (not (eq frame t)) color
-	   ;; Check for support for foreground, not for background!
-	   ;; face-color-supported-p is smart enough to know
-	   ;; that grays are "supported" as background
-	   ;; because we are supposed to use stipple for them!
-	   (not (face-color-supported-p frame color nil)))
-      (set-face-stipple face face-default-stipple frame)
-    (if (null frame)
-	(let ((frames (frame-list)))
-	  (while frames
-	    (set-face-background (face-name face) color (car frames))
-	    (setq frames (cdr frames)))
-	  (set-face-background face color t)
-	  color)
-      (internal-set-face-1 face 'background color 5 frame))))
-
-(defun set-face-stipple (face pixmap &optional frame)
-  "Change the stipple pixmap of face FACE to PIXMAP.
-PIXMAP should be a string, the name of a file of pixmap data.
-The directories listed in the `x-bitmap-file-path' variable are searched.
-
-Alternatively, PIXMAP may be a list of the form (WIDTH HEIGHT DATA)
-where WIDTH and HEIGHT are the size in pixels,
-and DATA is a string, containing the raw bits of the bitmap.  
-
-If the optional FRAME argument is provided, change only
-in that frame; otherwise change each frame."
-  (interactive (internal-face-interactive-stipple "stipple"))
-  (internal-set-face-1 face 'background-pixmap pixmap 6 frame))
-
-(defalias 'set-face-background-pixmap 'set-face-stipple)
-
-(defun set-face-underline-p (face underline-p &optional frame)
-  "Specify whether face FACE is underlined.  (Yes if UNDERLINE-P is non-nil.)
-If the optional FRAME argument is provided, change only
-in that frame; otherwise change each frame."
-  (interactive (internal-face-interactive "underline-p" "underlined"))
-  (internal-set-face-1 face 'underline underline-p 7 frame))
-
-(defun modify-face-read-string (face default name alist)
-  (let ((value
-	 (completing-read
-	  (if default
-	      (format "Set face %s %s (default %s): "
-		      face name (downcase default))
-	    (format "Set face %s %s: " face name))
-	  alist)))
-    (cond ((equal value "none")
-	   nil)
-	  ((equal value "")
-	   default)
-	  (t value))))
-
-(defun modify-face (face foreground background stipple
-		    bold-p italic-p underline-p &optional frame)
-  "Change the display attributes for face FACE.
-If the optional FRAME argument is provided, change only
-in that frame; otherwise change each frame.
-
-FOREGROUND and BACKGROUND should be a colour name string (or list of strings to
-try) or nil.  STIPPLE should be a stipple pattern name string or nil.
-If nil, means do not change the display attribute corresponding to that arg.
-
-BOLD-P, ITALIC-P, and UNDERLINE-P specify whether the face should be set bold,
-in italic, and underlined, respectively.  If neither nil or t, means do not
-change the display attribute corresponding to that arg.
-
-If called interactively, prompts for a face name and face attributes."
-  (interactive
-   (let* ((completion-ignore-case t)
-	  (face		(symbol-name (read-face-name "Modify face: ")))
-	  (colors	(mapcar 'list x-colors))
-	  (stipples	(mapcar 'list (apply 'nconc
-					    (mapcar 'directory-files
-						    x-bitmap-file-path))))
-	  (foreground	(modify-face-read-string
-			 face (face-foreground (intern face))
-			 "foreground" colors))
-	  (background	(modify-face-read-string
-			 face (face-background (intern face))
-			 "background" colors))
-	  ;; If the stipple value is a list (WIDTH HEIGHT DATA),
-	  ;; represent that as a string by printing it out.
-	  (old-stipple-string
-	   (if (stringp (face-stipple (intern face)))
-	       (face-stipple (intern face))
-	     (if (face-stipple (intern face))
-		 (prin1-to-string (face-stipple (intern face))))))
-	  (new-stipple-string
-	   (modify-face-read-string
-	    face old-stipple-string
-	    "stipple" stipples))
-	  ;; Convert the stipple value text we read
-	  ;; back to a list if it looks like one.
-	  ;; This makes the assumption that a pixmap file name
-	  ;; won't start with an open-paren.
-	  (stipple
-	   (and new-stipple-string
-		(if (string-match "^(" new-stipple-string)
-		    (read new-stipple-string)
-		  new-stipple-string)))
-	  (bold-p	(y-or-n-p (concat "Should face " face " be bold ")))
-	  (italic-p	(y-or-n-p (concat "Should face " face " be italic ")))
-	  (underline-p	(y-or-n-p (concat "Should face " face " be underlined ")))
-	  (all-frames-p	(y-or-n-p (concat "Modify face " face " in all frames "))))
-     (message "Face %s: %s" face
-      (mapconcat 'identity
-       (delq nil
-	(list (and foreground (concat (downcase foreground) " foreground"))
-	      (and background (concat (downcase background) " background"))
-	      (and stipple (concat (downcase new-stipple-string) " stipple"))
-	      (and bold-p "bold") (and italic-p "italic")
-	      (and underline-p "underline"))) ", "))
-     (list (intern face) foreground background stipple
-	   bold-p italic-p underline-p
-	   (if all-frames-p nil (selected-frame)))))
-  (condition-case nil
-      (face-try-color-list 'set-face-foreground face foreground frame)
-    (error nil))
-  (condition-case nil
-      (face-try-color-list 'set-face-background face background frame)
-    (error nil))
-  (condition-case nil
-      (set-face-stipple face stipple frame)
-    (error nil))
-  (cond ((eq bold-p nil) (make-face-unbold face frame t))
-	((eq bold-p t) (make-face-bold face frame t)))
-  (cond ((eq italic-p nil) (make-face-unitalic face frame t))
-	((eq italic-p t) (make-face-italic face frame t)))
-  (if (memq underline-p '(nil t))
-      (set-face-underline-p face underline-p frame))
-  (and (interactive-p) (redraw-display)))
-
-;;;; Associating face names (symbols) with their face vectors.
-
-(defvar global-face-data nil
-  "Internal data for face support functions.  Not for external use.
-This is an alist associating face names with the default values for
-their parameters.  Newly created frames get their data from here.")
-
-(defun face-list ()
-  "Returns a list of all defined face names."
-  (mapcar 'car global-face-data))
-
-(defun internal-find-face (name &optional frame)
-  "Retrieve the face named NAME.  Return nil if there is no such face.
-If the optional argument FRAME is given, this gets the face NAME for
-that frame; otherwise, it uses the selected frame.
-If FRAME is the symbol t, then the global, non-frame face is returned.
-If NAME is already a face, it is simply returned."
-  (if (and (eq frame t) (not (symbolp name)))
-      (setq name (face-name name)))
-  (if (symbolp name)
-      (cdr (assq name
-		 (if (eq frame t)
-		     global-face-data
-		   (frame-face-alist (or frame (selected-frame))))))
-    (internal-check-face name)
-    name))
-
-(defun internal-get-face (name &optional frame)
-  "Retrieve the face named NAME; error if there is none.
-If the optional argument FRAME is given, this gets the face NAME for
-that frame; otherwise, it uses the selected frame.
-If FRAME is the symbol t, then the global, non-frame face is returned.
-If NAME is already a face, it is simply returned."
-  (or (internal-find-face name frame)
-      (internal-check-face name)))
-
-
-(defun internal-set-face-1 (face name value index frame)
-  (let ((inhibit-quit t))
-    (if (null frame)
-	(let ((frames (frame-list)))
-	  (while frames
-	    (internal-set-face-1 (face-name face) name value index (car frames))
-	    (setq frames (cdr frames)))
-	  (aset (internal-get-face (if (symbolp face) face (face-name face)) t)
-		index value)
-	  value)
-      (or (eq frame t)
-	  (set-face-attribute-internal (face-id face) name value frame))
-      (aset (internal-get-face face frame) index value))))
-
-
-(defun read-face-name (prompt)
-  (let (face)
-    (while (= (length face) 0)
-      (setq face (completing-read prompt
-				  (mapcar '(lambda (x) (list (symbol-name x)))
-					  (face-list))
-				  nil t)))
-    (intern face)))
-
-(defun internal-face-interactive (what &optional bool)
-  (let* ((fn (intern (concat "face-" what)))
-	 (prompt (concat "Set " what " of face"))
-	 (face (read-face-name (concat prompt ": ")))
-	 (default (if (fboundp fn)
-		      (or (funcall fn face (selected-frame))
-			  (funcall fn 'default (selected-frame)))))
-	 (value (if bool
-		    (y-or-n-p (concat "Should face " (symbol-name face)
-				      " be " bool "? "))
-		  (read-string (concat prompt " " (symbol-name face) " to: ")
-			       default))))
-    (list face (if (equal value "") nil value))))
-
-(defun internal-face-interactive-stipple (what)
-  (let* ((fn (intern (concat "face-" what)))
-	 (prompt (concat "Set " what " of face"))
-	 (face (read-face-name (concat prompt ": ")))
-	 (default (if (fboundp fn)
-		      (or (funcall fn face (selected-frame))
-			  (funcall fn 'default (selected-frame)))))
-	 ;; If the stipple value is a list (WIDTH HEIGHT DATA),
-	 ;; represent that as a string by printing it out.
-	 (old-stipple-string
-	  (if (stringp (face-stipple face))
-	      (face-stipple face)
-	    (if (null (face-stipple face))
-		nil
-	      (prin1-to-string (face-stipple face)))))
-	 (new-stipple-string
-	  (read-string
-	   (concat prompt " " (symbol-name face) " to: ")
-	   old-stipple-string))
-	 ;; Convert the stipple value text we read
-	 ;; back to a list if it looks like one.
-	 ;; This makes the assumption that a pixmap file name
-	 ;; won't start with an open-paren.
-	 (stipple
-	  (if (string-match "^(" new-stipple-string)
-	      (read new-stipple-string)
-	    new-stipple-string)))
-    (list face (if (equal stipple "") nil stipple))))
-
-(defun make-face (name)
-  "Define a new FACE on all frames.  
-You can modify the font, color, etc of this face with the set-face- functions.
-If the face already exists, it is unmodified."
-  (interactive "SMake face: ")
-  (or (internal-find-face name)
-      (let ((face (make-vector 8 nil)))
-	(aset face 0 'face)
-	(aset face 1 name)
-	(let* ((frames (frame-list))
-	       (inhibit-quit t)
-	       (id (internal-next-face-id)))
-	  (make-face-internal id)
-	  (aset face 2 id)
-	  (while frames
-	    (set-frame-face-alist (car frames)
-				  (cons (cons name (copy-sequence face))
-					(frame-face-alist (car frames))))
-	    (setq frames (cdr frames)))
-	  (setq global-face-data (cons (cons name face) global-face-data)))
-	;; when making a face after frames already exist
-	(if (memq window-system '(x w32))
-	    (make-face-x-resource-internal face))
-	;; add to menu
-	(if (fboundp 'facemenu-add-new-face)
-	    (facemenu-add-new-face name))
-	face))
-  name)
-
-;; Fill in a face by default based on X resources, for all existing frames.
-;; This has to be done when a new face is made.
-(defun make-face-x-resource-internal (face &optional frame set-anyway)
-  (cond ((null frame)
-	 (let ((frames (frame-list)))
-	   (while frames
-	     (if (memq (framep (car frames)) '(x w32))
-		 (make-face-x-resource-internal (face-name face)
-						(car frames) set-anyway))
-	     (setq frames (cdr frames)))))
-	(t
-	 (setq face (internal-get-face (face-name face) frame))
-	 ;;
-	 ;; These are things like "attributeForeground" instead of simply
-	 ;; "foreground" because people tend to do things like "*foreground",
-	 ;; which would cause all faces to be fully qualified, making faces
-	 ;; inherit attributes in a non-useful way.  So we've made them slightly
-	 ;; less obvious to specify in order to make them work correctly in
-	 ;; more random environments.
-	 ;;
-	 ;; I think these should be called "face.faceForeground" instead of
-	 ;; "face.attributeForeground", but they're the way they are for
-	 ;; hysterical reasons.
-	 ;; 
-	 (let* ((name (symbol-name (face-name face)))
-		(fn  (or (x-get-resource (concat name ".attributeFont")
-					 "Face.AttributeFont")
-			 (and set-anyway (face-font face))))
-		(fg  (or (x-get-resource (concat name ".attributeForeground")
-					 "Face.AttributeForeground")
-			 (and set-anyway (face-foreground face))))
-		(bg  (or (x-get-resource (concat name ".attributeBackground")
-					 "Face.AttributeBackground")
-			 (and set-anyway (face-background face))))
-		(bgp (or (x-get-resource (concat name ".attributeStipple")
-					 "Face.AttributeStipple")
-			 (x-get-resource (concat name ".attributeBackgroundPixmap")
-					 "Face.AttributeBackgroundPixmap")
-			 (and set-anyway (face-stipple face))))
-		(ulp (let ((resource (x-get-resource
-				      (concat name ".attributeUnderline")
-				      "Face.AttributeUnderline")))
-		       (if resource
-			   (member (downcase resource) '("on" "true"))
-			 (and set-anyway (face-underline-p face)))))
-		)
-	   (if fn
-	       (condition-case ()
-		   (cond ((string= fn "italic")
-			  (make-face-italic face))
-			 ((string= fn "bold")
-			  (make-face-bold face))
-			 ((string= fn "bold-italic")
-			  (make-face-bold-italic face))
-			 (t
-			  (set-face-font face fn frame)))
-		 (error
-		  (if (member fn '("italic" "bold" "bold-italic"))
-		      (message "no %s version found for face `%s'" fn name)
-		    (message "font `%s' not found for face `%s'" fn name)))))
-	   (if fg
-	       (condition-case ()
-		   (set-face-foreground face fg frame)
-		 (error (message "color `%s' not allocated for face `%s'" fg name))))
-	   (if bg
-	       (condition-case ()
-		   (set-face-background face bg frame)
-		 (error (message "color `%s' not allocated for face `%s'" bg name))))
-	   (if bgp
-	       (condition-case ()
-		   (set-face-stipple face bgp frame)
-		 (error (message "pixmap `%s' not found for face `%s'" bgp name))))
-	   (if (or ulp set-anyway)
-	       (set-face-underline-p face ulp frame))
-	   )))
-  face)
-
-(defun copy-face (old-face new-face &optional frame new-frame)
-  "Define a face just like OLD-FACE, with name NEW-FACE.
-If NEW-FACE already exists as a face, it is modified to be like OLD-FACE.
-If it doesn't already exist, it is created.
-
-If the optional argument FRAME is given as a frame,
-NEW-FACE is changed on FRAME only.
-If FRAME is t, the frame-independent default specification for OLD-FACE
-is copied to NEW-FACE.
-If FRAME is nil, copying is done for the frame-independent defaults
-and for each existing frame.
-If the optional fourth argument NEW-FRAME is given, 
-copy the information from face OLD-FACE on frame FRAME
-to NEW-FACE on frame NEW-FRAME."
-  (or new-frame (setq new-frame frame))
-  (let ((inhibit-quit t))
-    (if (null frame)
-	(let ((frames (frame-list)))
-	  (while frames
-	    (copy-face old-face new-face (car frames))
-	    (setq frames (cdr frames)))
-	  (copy-face old-face new-face t))
-      (setq old-face (internal-get-face old-face frame))
-      (setq new-face (or (internal-find-face new-face new-frame)
-			 (make-face new-face)))
-      (condition-case nil
-	  ;; A face that has a global symbolic font modifier such as `bold'
-	  ;; might legitimately get an error here.
-	  ;; Use the frame's default font in that case.
-	  (set-face-font new-face (face-font old-face frame) new-frame)
-	(error
-	 (set-face-font new-face nil new-frame)))
-      (set-face-foreground new-face (face-foreground old-face frame) new-frame)
-      (set-face-background new-face (face-background old-face frame) new-frame)
-      (set-face-stipple new-face
-			(face-stipple old-face frame)
-			new-frame)
-      (set-face-underline-p new-face (face-underline-p old-face frame)
-			    new-frame))
-    new-face))
-
-(defun face-equal (face1 face2 &optional frame)
-  "True if the faces FACE1 and FACE2 display in the same way."
-  (setq face1 (internal-get-face face1 frame)
-	face2 (internal-get-face face2 frame))
-  (and (equal (face-foreground face1 frame) (face-foreground face2 frame))
-       (equal (face-background face1 frame) (face-background face2 frame))
-       (equal (face-font face1 frame) (face-font face2 frame))
-       (eq (face-underline-p face1 frame) (face-underline-p face2 frame))
-       (equal (face-stipple face1 frame)
-	      (face-stipple face2 frame))))
-
-(defun face-differs-from-default-p (face &optional frame)
-  "True if face FACE displays differently from the default face, on FRAME.
-A face is considered to be ``the same'' as the default face if it is 
-actually specified in the same way (equivalent fonts, etc) or if it is 
-fully unspecified, and thus inherits the attributes of any face it 
-is displayed on top of.
-
-The optional argument FRAME specifies which frame to test;
-if FRAME is t, test the default for new frames.
-If FRAME is nil or omitted, test the selected frame."
-  (let ((default (internal-get-face 'default frame)))
-    (setq face (internal-get-face face frame))
-    (not (and (or (equal (face-foreground default frame)
-			 (face-foreground face frame))
-		  (null (face-foreground face frame)))
-	      (or (equal (face-background default frame)
-			 (face-background face frame))
-		  (null (face-background face frame)))
-	      (or (equal (face-font default frame) (face-font face frame))
-		  (null (face-font face frame)))
-	      (or (equal (face-stipple default frame)
-			 (face-stipple face frame))
-		  (null (face-stipple face frame)))
-	      (equal (face-underline-p default frame)
-		     (face-underline-p face frame))
-	      ))))
-
-(defun face-nontrivial-p (face &optional frame)
-  "True if face FACE has some non-nil attribute.
-The optional argument FRAME specifies which frame to test;
-if FRAME is t, test the default for new frames.
-If FRAME is nil or omitted, test the selected frame."
-  (setq face (internal-get-face face frame))
-  (or (face-foreground face frame)
-      (face-background face frame)
-      (face-font face frame)
-      (face-stipple face frame)
-      (face-underline-p face frame)))
-
-
-(defun invert-face (face &optional frame)
-  "Swap the foreground and background colors of face FACE.
-If the face doesn't specify both foreground and background, then
-set its foreground and background to the default background and foreground."
-  (interactive (list (read-face-name "Invert face: ")))
-  (setq face (internal-get-face face frame))
-  (let ((fg (face-foreground face frame))
-	(bg (face-background face frame)))
-    (if (or fg bg)
-	(progn
-	  (set-face-foreground face bg frame)
-	  (set-face-background face fg frame))
-      (let* ((frame-bg (cdr (assq 'background-color (frame-parameters frame))))
-	     (default-bg (or (face-background 'default frame)
-			     frame-bg))
-	     (frame-fg (cdr (assq 'foreground-color (frame-parameters frame))))
-	     (default-fg (or (face-foreground 'default frame)
-			     frame-fg)))
-	(set-face-foreground face default-bg frame)
-	(set-face-background face default-fg frame))))
-  face)
-
-
-(defun internal-try-face-font (face font &optional frame)
-  "Like set-face-font, but returns nil on failure instead of an error."
-  (condition-case ()
-      (set-face-font face font frame)
-    (error nil)))
-
-;; Manipulating font names.
-
-(defvar x-font-regexp nil)
-(defvar x-font-regexp-head nil)
-(defvar x-font-regexp-weight nil)
-(defvar x-font-regexp-slant nil)
-
-(defconst x-font-regexp-weight-subnum 1)
-(defconst x-font-regexp-slant-subnum 2)
-(defconst x-font-regexp-swidth-subnum 3)
-(defconst x-font-regexp-adstyle-subnum 4)
-
-;;; Regexps matching font names in "Host Portable Character Representation."
-;;;
-(let ((- 		"[-?]")
-      (foundry		"[^-]+")
-      (family 		"[^-]+")
-      (weight		"\\(bold\\|demibold\\|medium\\)")		; 1
-;     (weight\?		"\\(\\*\\|bold\\|demibold\\|medium\\|\\)")	; 1
-      (weight\?		"\\([^-]*\\)")					; 1
-      (slant		"\\([ior]\\)")					; 2
-;     (slant\?		"\\([ior?*]?\\)")				; 2
-      (slant\?		"\\([^-]?\\)")					; 2
-;     (swidth		"\\(\\*\\|normal\\|semicondensed\\|\\)")	; 3
-      (swidth		"\\([^-]*\\)")					; 3
-;     (adstyle		"\\(\\*\\|sans\\|\\)")				; 4
-      (adstyle		"\\([^-]*\\)")					; 4
-      (pixelsize	"[0-9]+")
-      (pointsize	"[0-9][0-9]+")
-      (resx		"[0-9][0-9]+")
-      (resy		"[0-9][0-9]+")
-      (spacing		"[cmp?*]")
-      (avgwidth		"[0-9]+")
-      (registry		"[^-]+")
-      (encoding		"[^-]+")
-      )
-  (setq x-font-regexp
-	(concat "\\`\\*?[-?*]"
-		foundry - family - weight\? - slant\? - swidth - adstyle -
-		pixelsize - pointsize - resx - resy - spacing - avgwidth -
-		registry - encoding "\\*?\\'"
-		))
-  (setq x-font-regexp-head
-	(concat "\\`[-?*]" foundry - family - weight\? - slant\?
-		"\\([-*?]\\|\\'\\)"))
-  (setq x-font-regexp-slant (concat - slant -))
-  (setq x-font-regexp-weight (concat - weight -))
-  nil)	    
-
-(defun x-resolve-font-name (pattern &optional face frame)
-  "Return a font name matching PATTERN.
-All wildcards in PATTERN become substantiated.
-If PATTERN is nil, return the name of the frame's base font, which never
-contains wildcards.
-Given optional arguments FACE and FRAME, return a font which is
-also the same size as FACE on FRAME, or fail."
-  (or (symbolp face)
-      (setq face (face-name face)))
-  (and (eq frame t)
-       (setq frame nil))
-  (if pattern
-      ;; Note that x-list-fonts has code to handle a face with nil as its font.
-      (let ((fonts (x-list-fonts pattern face frame 1)))
-	(or fonts
-	    (if face
-		(if (string-match "\\*" pattern)
-		    (if (null (face-font face))
-			(error "No matching fonts are the same height as the frame default font")
-		      (error "No matching fonts are the same height as face `%s'" face))
-		  (if (null (face-font face))
-		      (error "Height of font `%s' doesn't match the frame default font"
-			     pattern)
-		    (error "Height of font `%s' doesn't match face `%s'"
-			   pattern face)))
-	      (error "No fonts match `%s'" pattern)))
-	(car fonts))
-    (cdr (assq 'font (frame-parameters (selected-frame))))))
-
-(defun x-frob-font-weight (font which)
-  (let ((case-fold-search t))
-    (cond ((string-match x-font-regexp font)
-	   (concat (substring font 0
-			      (match-beginning x-font-regexp-weight-subnum))
-		   which
-		   (substring font (match-end x-font-regexp-weight-subnum)
-			      (match-beginning x-font-regexp-adstyle-subnum))
-		   ;; Replace the ADD_STYLE_NAME field with *
-		   ;; because the info in it may not be the same
-		   ;; for related fonts.
-		   "*"
-		   (substring font (match-end x-font-regexp-adstyle-subnum))))
-	  ((string-match x-font-regexp-head font)
-	   (concat (substring font 0 (match-beginning 1)) which
-		   (substring font (match-end 1))))
-	  ((string-match x-font-regexp-weight font)
-	   (concat (substring font 0 (match-beginning 1)) which
-		   (substring font (match-end 1)))))))
-
-(defun x-frob-font-slant (font which)
-  (let ((case-fold-search t))
-    (cond ((string-match x-font-regexp font)
-	   (concat (substring font 0
-			      (match-beginning x-font-regexp-slant-subnum))
-		   which
-		   (substring font (match-end x-font-regexp-slant-subnum)
-			      (match-beginning x-font-regexp-adstyle-subnum))
-		   ;; Replace the ADD_STYLE_NAME field with *
-		   ;; because the info in it may not be the same
-		   ;; for related fonts.
-		   "*"
-		   (substring font (match-end x-font-regexp-adstyle-subnum))))
-	  ((string-match x-font-regexp-head font)
-	   (concat (substring font 0 (match-beginning 2)) which
-		   (substring font (match-end 2))))
-	  ((string-match x-font-regexp-slant font)
-	   (concat (substring font 0 (match-beginning 1)) which
-		   (substring font (match-end 1)))))))
-
-(defun x-make-font-bold (font)
-  "Given an X font specification, make a bold version of it.
-If that can't be done, return nil."
-  (x-frob-font-weight font "bold"))
-
-(defun x-make-font-demibold (font)
-  "Given an X font specification, make a demibold version of it.
-If that can't be done, return nil."
-  (x-frob-font-weight font "demibold"))
-
-(defun x-make-font-unbold (font)
-  "Given an X font specification, make a non-bold version of it.
-If that can't be done, return nil."
-  (x-frob-font-weight font "medium"))
-
-(defun x-make-font-italic (font)
-  "Given an X font specification, make an italic version of it.
-If that can't be done, return nil."
-  (x-frob-font-slant font "i"))
-
-(defun x-make-font-oblique (font) ; you say tomayto...
-  "Given an X font specification, make an oblique version of it.
-If that can't be done, return nil."
-  (x-frob-font-slant font "o"))
-
-(defun x-make-font-unitalic (font)
-  "Given an X font specification, make a non-italic version of it.
-If that can't be done, return nil."
-  (x-frob-font-slant font "r"))
-
-;;; non-X-specific interface
-
-(defun make-face-bold (face &optional frame noerror)
-  "Make the font of the given face be bold, if possible.  
-If NOERROR is non-nil, return nil on failure."
-  (interactive (list (read-face-name "Make which face bold: ")))
-  (if (and (eq frame t) (listp (face-font face t)))
-      (set-face-font face (if (memq 'italic (face-font face t))
-			      '(bold italic) '(bold))
-		     t)
-    (let (font)
-      (if (null frame)
-	  (let ((frames (frame-list)))
-	    ;; Make this face bold in global-face-data.
-	    (make-face-bold face t noerror)
-	    ;; Make this face bold in each frame.
-	    (while frames
-	      (make-face-bold face (car frames) noerror)
-	      (setq frames (cdr frames))))
-	(setq face (internal-get-face face frame))
-	(setq font (or (face-font face frame)
-		       (face-font face t)))
-	(if (listp font)
-	    (setq font nil))
-	(setq font (or font
-		       (face-font 'default frame)
-		       (cdr (assq 'font (frame-parameters frame)))))
-	(or (and font (make-face-bold-internal face frame font))
-	    ;; We failed to find a bold version of the font.
-	    noerror
-	    (error "No bold version of %S" font))))))
-
-(defun make-face-bold-internal (face frame font)
-  (let (f2)
-    (or (and (setq f2 (x-make-font-bold font))
-	     (internal-try-face-font face f2 frame))
-	(and (setq f2 (x-make-font-demibold font))
-	     (internal-try-face-font face f2 frame)))))
-
-(defun make-face-italic (face &optional frame noerror)
-  "Make the font of the given face be italic, if possible.  
-If NOERROR is non-nil, return nil on failure."
-  (interactive (list (read-face-name "Make which face italic: ")))
-  (if (and (eq frame t) (listp (face-font face t)))
-      (set-face-font face (if (memq 'bold (face-font face t))
-			      '(bold italic) '(italic))
-		     t)
-    (let (font)
-      (if (null frame)
-	  (let ((frames (frame-list)))
-	    ;; Make this face italic in global-face-data.
-	    (make-face-italic face t noerror)
-	    ;; Make this face italic in each frame.
-	    (while frames
-	      (make-face-italic face (car frames) noerror)
-	      (setq frames (cdr frames))))
-	(setq face (internal-get-face face frame))
-	(setq font (or (face-font face frame)
-		       (face-font face t)))
-	(if (listp font)
-	    (setq font nil))
-	(setq font (or font
-		       (face-font 'default frame)
-		       (cdr (assq 'font (frame-parameters frame)))))
-	(or (and font (make-face-italic-internal face frame font))
-	    ;; We failed to find an italic version of the font.
-	    noerror
-	    (error "No italic version of %S" font))))))
-
-(defun make-face-italic-internal (face frame font)
-  (let (f2)
-    (or (and (setq f2 (x-make-font-italic font))
-	     (internal-try-face-font face f2 frame))
-	(and (setq f2 (x-make-font-oblique font))
-	     (internal-try-face-font face f2 frame)))))
-
-(defun make-face-bold-italic (face &optional frame noerror)
-  "Make the font of the given face be bold and italic, if possible.  
-If NOERROR is non-nil, return nil on failure."
-  (interactive (list (read-face-name "Make which face bold-italic: ")))
-  (if (and (eq frame t) (listp (face-font face t)))
-      (set-face-font face '(bold italic) t)
-    (let (font)
-      (if (null frame)
-	  (let ((frames (frame-list)))
-	    ;; Make this face bold-italic in global-face-data.
-	    (make-face-bold-italic face t noerror)
-	    ;; Make this face bold in each frame.
-	    (while frames
-	      (make-face-bold-italic face (car frames) noerror)
-	      (setq frames (cdr frames))))
-	(setq face (internal-get-face face frame))
-	(setq font (or (face-font face frame)
-		       (face-font face t)))
-	(if (listp font)
-	    (setq font nil))
-	(setq font (or font
-		       (face-font 'default frame)
-		       (cdr (assq 'font (frame-parameters frame)))))
-	(or (and font (make-face-bold-italic-internal face frame font))
-	    ;; We failed to find a bold italic version.
-	    noerror
-	    (error "No bold italic version of %S" font))))))
-
-(defun make-face-bold-italic-internal (face frame font)
-  (let (f2 f3)
-    (or (and (setq f2 (x-make-font-italic font))
-	     (not (equal font f2))
-	     (setq f3 (x-make-font-bold f2))
-	     (not (equal f2 f3))
-	     (internal-try-face-font face f3 frame))
-	(and (setq f2 (x-make-font-oblique font))
-	     (not (equal font f2))
-	     (setq f3 (x-make-font-bold f2))
-	     (not (equal f2 f3))
-	     (internal-try-face-font face f3 frame))
-	(and (setq f2 (x-make-font-italic font))
-	     (not (equal font f2))
-	     (setq f3 (x-make-font-demibold f2))
-	     (not (equal f2 f3))
-	     (internal-try-face-font face f3 frame))
-	(and (setq f2 (x-make-font-oblique font))
-	     (not (equal font f2))
-	     (setq f3 (x-make-font-demibold f2))
-	     (not (equal f2 f3))
-	     (internal-try-face-font face f3 frame)))))
-
-(defun make-face-unbold (face &optional frame noerror)
-  "Make the font of the given face be non-bold, if possible.  
-If NOERROR is non-nil, return nil on failure."
-  (interactive (list (read-face-name "Make which face non-bold: ")))
-  (if (and (eq frame t) (listp (face-font face t)))
-      (set-face-font face (if (memq 'italic (face-font face t))
-			      '(italic) nil)
-		     t)
-    (let (font font1)
-      (if (null frame)
-	  (let ((frames (frame-list)))
-	    ;; Make this face unbold in global-face-data.
-	    (make-face-unbold face t noerror)
-	    ;; Make this face unbold in each frame.
-	    (while frames
-	      (make-face-unbold face (car frames) noerror)
-	      (setq frames (cdr frames))))
-	(setq face (internal-get-face face frame))
-	(setq font1 (or (face-font face frame)
-			(face-font face t)))
-	(if (listp font1)
-	    (setq font1 nil))
-	(setq font1 (or font1
-			(face-font 'default frame)
-			(cdr (assq 'font (frame-parameters frame)))))
-	(setq font (and font1 (x-make-font-unbold font1)))
-	(or (if font (internal-try-face-font face font frame))
-	    noerror
-	    (error "No unbold version of %S" font1))))))
-
-(defun make-face-unitalic (face &optional frame noerror)
-  "Make the font of the given face be non-italic, if possible.  
-If NOERROR is non-nil, return nil on failure."
-  (interactive (list (read-face-name "Make which face non-italic: ")))
-  (if (and (eq frame t) (listp (face-font face t)))
-      (set-face-font face (if (memq 'bold (face-font face t))
-			      '(bold) nil)
-		     t)
-    (let (font font1)
-      (if (null frame)
-	  (let ((frames (frame-list)))
-	    ;; Make this face unitalic in global-face-data.
-	    (make-face-unitalic face t noerror)
-	    ;; Make this face unitalic in each frame.
-	    (while frames
-	      (make-face-unitalic face (car frames) noerror)
-	      (setq frames (cdr frames))))
-	(setq face (internal-get-face face frame))
-	(setq font1 (or (face-font face frame)
-			(face-font face t)))
-	(if (listp font1)
-	    (setq font1 nil))
-	(setq font1 (or font1
-			(face-font 'default frame)
-			(cdr (assq 'font (frame-parameters frame)))))
-	(setq font (and font1 (x-make-font-unitalic font1)))
-	(or (if font (internal-try-face-font face font frame))
-	    noerror
-	    (error "No unitalic version of %S" font1))))))
-
-(defvar list-faces-sample-text
-  "abcdefghijklmnopqrstuvwxyz ABCDEFGHIJKLMNOPQRSTUVWXYZ"
-  "*Text string to display as the sample text for `list-faces-display'.")
-
-;; The name list-faces would be more consistent, but let's avoid a conflict
-;; with Lucid, which uses that name differently.
-(defun list-faces-display ()
-  "List all faces, using the same sample text in each.
-The sample text is a string that comes from the variable
-`list-faces-sample-text'.
-
-It is possible to give a particular face name different appearances in
-different frames.  This command shows the appearance in the
-selected frame."
-  (interactive)
-  (let ((faces (sort (face-list) (function string-lessp)))
-	(face nil)
-	(frame (selected-frame))
-	disp-frame window)
-    (with-output-to-temp-buffer "*Faces*"
-      (save-excursion
-	(set-buffer standard-output)
-	(setq truncate-lines t)
-	(while faces
-	  (setq face (car faces))
-	  (setq faces (cdr faces))
-	  (insert (format "%25s " (symbol-name face)))
-	  (let ((beg (point)))
-	    (insert list-faces-sample-text)
-	    (insert "\n")
-	    (put-text-property beg (1- (point)) 'face face)
-	    ;; If the sample text has multiple lines, line up all of them.
-	    (goto-char beg)
-	    (forward-line 1)
-	    (while (not (eobp))
-	      (insert "                          ")
-	      (forward-line 1))))
-	(goto-char (point-min))))
-    ;; If the *Faces* buffer appears in a different frame,
-    ;; copy all the face definitions from FRAME,
-    ;; so that the display will reflect the frame that was selected.
-    (setq window (get-buffer-window (get-buffer "*Faces*") t))
-    (setq disp-frame (if window (window-frame window)
-		       (car (frame-list))))
-    (or (eq frame disp-frame)
-	(let ((faces (face-list)))
-	  (while faces
-	    (copy-face (car faces) (car faces) frame disp-frame)
-	    (setq faces (cdr faces)))))))
-
-(defun describe-face (face)
-  "Display the properties of face FACE."
-  (interactive (list (read-face-name "Describe face: ")))
-  (with-output-to-temp-buffer "*Help*"
-    (princ "Properties of face `")
-    (princ (face-name face))
-    (princ "':") (terpri)
-    (princ "Foreground: ") (princ (face-foreground face)) (terpri)
-    (princ "Background: ") (princ (face-background face)) (terpri)
-    (princ "      Font: ") (princ (face-font face)) (terpri)
-    (princ "Underlined: ") (princ (if (face-underline-p face) "yes" "no")) (terpri)
-    (princ "   Stipple: ") (princ (or (face-stipple face) "none"))))
-
-;;; Make the standard faces.
-;;; The C code knows the default and modeline faces as faces 0 and 1,
-;;; so they must be the first two faces made.
-(defun face-initialize ()
-  (make-face 'default)
-  (make-face 'modeline)
-  (make-face 'highlight)
-
-  ;; These aren't really special in any way, but they're nice to have around.
-
-  (make-face 'bold)
-  (make-face 'italic)
-  (make-face 'bold-italic)
-  (make-face 'region)
-  (make-face 'secondary-selection)
-  (make-face 'underline)
-
-  (setq region-face (face-id 'region))
-
-  ;; Specify the global properties of these faces
-  ;; so they will come out right on new frames.
-
-  (make-face-bold 'bold t)
-  (make-face-italic 'italic t)
-  (make-face-bold-italic 'bold-italic t)
-
-  (set-face-background 'highlight '("darkseagreen2" "green" t) t)
-  (set-face-background 'region '("gray" underline) t)
-  (set-face-background 'secondary-selection '("paleturquoise" "green" t) t)
-  (set-face-background 'modeline '(t) t)
-  (set-face-underline-p 'underline t t)
-
-  ;; Set up the faces of all existing X Window frames
-  ;; from those global properties, unless already set in a given frame.
-
-  (let ((frames (frame-list)))
-    (while frames
-      (if (not (memq (framep (car frames)) '(t nil)))
-	  (let ((frame (car frames))
-		(rest global-face-data))
-	    (while rest
-	      (let ((face (car (car rest))))
-		(or (face-differs-from-default-p face)
-		    (face-fill-in face (cdr (car rest)) frame)))
-	      (setq rest (cdr rest)))))
-      (setq frames (cdr frames)))))
-
-
-;; Like x-create-frame but also set up the faces.
-
-(defun x-create-frame-with-faces (&optional parameters)
-  ;; Read this frame's geometry resource, if it has an explicit name,
-  ;; and put the specs into PARAMETERS.
-  (let* ((name (or (cdr (assq 'name parameters))
-		   (cdr (assq 'name default-frame-alist))))
-	 (x-resource-name name)
-	 (res-geometry (if name (x-get-resource "geometry" "Geometry")))
-	 parsed)
-    (if res-geometry
-	(progn
-	  (setq parsed (x-parse-geometry res-geometry))
-	  ;; If the resource specifies a position,
-	  ;; call the position and size "user-specified".
-	  (if (or (assq 'top parsed) (assq 'left parsed))
-	      (setq parsed (cons '(user-position . t)
-				 (cons '(user-size . t) parsed))))
-	  ;; Put the geometry parameters at the end.
-	  ;; Copy default-frame-alist so that they go after it.
-	  (setq parameters (append parameters
-				   default-frame-alist
-				   parsed)))))
-  (let (frame)
-    (if (null global-face-data)
-	(setq frame (x-create-frame parameters))
-      (let* ((visibility-spec (assq 'visibility parameters))
-	     (faces (copy-alist global-face-data))
-	     success
-	     (rest faces))
-	(setq frame (x-create-frame (cons '(visibility . nil) parameters)))
-	(unwind-protect
-	    (progn
-	      (set-frame-face-alist frame faces)
-
-	      (if (cdr (or (assq 'reverse parameters)
-			   (assq 'reverse default-frame-alist)
-			   (let ((resource (x-get-resource "reverseVideo"
-							   "ReverseVideo")))
-			     (if resource
-				 (cons nil (member (downcase resource)
-						   '("on" "true")))))))
-		  (let* ((params (frame-parameters frame))
-			 (bg (cdr (assq 'foreground-color params)))
-			 (fg (cdr (assq 'background-color params))))
-		    (modify-frame-parameters frame
-					     (list (cons 'foreground-color fg)
-						   (cons 'background-color bg)))
-		    (if (equal bg (cdr (assq 'border-color params)))
-			(modify-frame-parameters frame
-						 (list (cons 'border-color fg))))
-		    (if (equal bg (cdr (assq 'mouse-color params)))
-			(modify-frame-parameters frame
-						 (list (cons 'mouse-color fg))))
-		    (if (equal bg (cdr (assq 'cursor-color params)))
-			(modify-frame-parameters frame
-						 (list (cons 'cursor-color fg))))))
-	      ;; Copy the vectors that represent the faces.
-	      ;; Also fill them in from X resources.
-	      (while rest
-		(let ((global (cdr (car rest))))
-		  (setcdr (car rest) (vector 'face
-					     (face-name (cdr (car rest)))
-					     (face-id (cdr (car rest)))
-					     nil nil nil nil nil))
-		  (face-fill-in (car (car rest)) global frame))
-		(make-face-x-resource-internal (cdr (car rest)) frame t)
-		(setq rest (cdr rest)))
-	      (if (null visibility-spec)
-		  (make-frame-visible frame)
-		(modify-frame-parameters frame (list visibility-spec)))
-	      (setq success t))
-	  (or success
-	      (delete-frame frame)))))
-    ;; Set up the background-mode frame parameter
-    ;; so that programs can decide good ways of highlighting
-    ;; on this frame.
-    (let ((bg-resource (x-get-resource ".backgroundMode"
-				       "BackgroundMode"))
-	  (params (frame-parameters frame))
-	  (bg-mode))
-      (setq bg-mode
-	    (cond (bg-resource (intern (downcase bg-resource)))
-		  ((< (apply '+ (x-color-values
-				 (cdr (assq 'background-color params))
-				 frame))
-		      ;; Just looking at the screen,
-		      ;; colors whose values add up to .6 of the white total
-		      ;; still look dark to me.
-		      (* (apply '+ (x-color-values "white" frame)) .6))
-		   'dark)
-		  (t 'light)))
-      (modify-frame-parameters frame
-			       (list (cons 'background-mode bg-mode)
-				     (cons 'display-type
-					   (cond ((x-display-color-p frame)
-						  'color)
-						 ((x-display-grayscale-p frame)
-						  'grayscale)
-						 (t 'mono))))))
-    frame))
-
-;; Update a frame's faces when we change its default font.
-(defun frame-update-faces (frame)
-  (let* ((faces global-face-data)
-	 (rest faces))
-    (while rest
-      (let* ((face (car (car rest)))
-	     (font (face-font face t)))
-	(if (listp font)
-	    (let ((bold (memq 'bold font))
-		  (italic (memq 'italic font)))
-	      ;; Ignore any previous (string-valued) font, it might not even
-	      ;; be the right size anymore.
-	      (set-face-font face nil frame)
-	      (cond ((and bold italic)
-		     (make-face-bold-italic face frame t))
-		    (bold
-		     (make-face-bold face frame t))
-		    (italic
-		     (make-face-italic face frame t)))))
-      (setq rest (cdr rest)))
-    frame)))
-
-;; Update the colors of FACE, after FRAME's own colors have been changed.
-;; This applies only to faces with global color specifications
-;; that are not simple constants.
-(defun frame-update-face-colors (frame)
-  (let ((faces global-face-data))
-    (while faces
-      (condition-case nil
-	  (let* ((data (cdr (car faces)))
-		 (face (car (car faces)))
-		 (foreground (face-foreground data))
-		 (background (face-background data)))
-	    ;; If the global spec is a specific color,
-	    ;; which doesn't depend on the frame's attributes,
-	    ;; we don't need to recalculate it now.
-	    (or (listp foreground)
-		(setq foreground nil))
-	    (or (listp background)
-		(setq background nil))
-	    ;; If we are going to frob this face at all,
-	    ;; reinitialize it first.
-	    (if (or foreground background)
-		(progn (set-face-foreground face nil frame)
-		       (set-face-background face nil frame)))
-	    (if foreground
-		(face-try-color-list 'set-face-foreground
-				     face foreground frame))
-	    (if background
-		(face-try-color-list 'set-face-background
-				     face background frame)))
-	(error nil))
-      (setq faces (cdr faces)))))
-
-;; Fill in the face FACE from frame-independent face data DATA.
-;; DATA should be the non-frame-specific ("global") face vector
-;; for the face.  FACE should be a face name or face object.
-;; FRAME is the frame to act on; it must be an actual frame, not nil or t.
-(defun face-fill-in (face data frame)
-  (condition-case nil
-      (let ((foreground (face-foreground data))
-	    (background (face-background data))
-	    (font (face-font data))
-	    (stipple (face-stipple data)))
-	(set-face-underline-p face (face-underline-p data) frame)
-	(if foreground
-	    (face-try-color-list 'set-face-foreground
-				 face foreground frame))
-	(if background
-	    (face-try-color-list 'set-face-background
-				 face background frame))
-	(if (listp font)
-	    (let ((bold (memq 'bold font))
-		  (italic (memq 'italic font)))
-	      (cond ((and bold italic)
-		     (make-face-bold-italic face frame))
-		    (bold
-		     (make-face-bold face frame))
-		    (italic
-		     (make-face-italic face frame))))
-	  (if font
-	      (set-face-font face font frame)))
-	(if stipple
-	    (set-face-stipple face stipple frame)))
-    (error nil)))
-
-;; Assuming COLOR is a valid color name,
-;; return t if it can be displayed on FRAME.
-(defun face-color-supported-p (frame color background-p)
-  (and window-system
-       (or (x-display-color-p frame)
-	   ;; A black-and-white display can implement these.
-	   (member color '("black" "white"))
-	   ;; A black-and-white display can fake gray for background.
-	   (and background-p
-		(face-color-gray-p color frame))
-	   ;; A grayscale display can implement colors that are gray (more or less).
-	   (and (x-display-grayscale-p frame)
-		(face-color-gray-p color frame)))))
-
-;; Use FUNCTION to store a color in FACE on FRAME.
-;; COLORS is either a single color or a list of colors.
-;; If it is a list, try the colors one by one until one of them
-;; succeeds.  We signal an error only if all the colors failed.
-;; t as COLORS or as an element of COLORS means to invert the face.
-;; That can't fail, so any subsequent elements after the t are ignored.
-(defun face-try-color-list (function face colors frame)
-  (if (stringp colors)
-      (if (face-color-supported-p frame colors
-				  (eq function 'set-face-background))
-	  (funcall function face colors frame))
-    (if (eq colors t)
-	(invert-face face frame)
-      (let (done)
-	(while (and colors (not done))
-	  (if (or (memq (car colors) '(t underline))
-		  (face-color-supported-p frame (car colors)
-					  (eq function 'set-face-background)))
-	      (if (cdr colors)
-		  ;; If there are more colors to try, catch errors
-		  ;; and set `done' if we succeed.
-		  (condition-case nil
-		      (progn
-			(cond ((eq (car colors) t)
-			       (invert-face face frame))
-			      ((eq (car colors) 'underline)
-			       (set-face-underline-p face t frame))
-			      (t
-			       (funcall function face (car colors) frame)))
-			(setq done t))
-		    (error nil))
-		;; If this is the last color, let the error get out if it fails.
-		;; If it succeeds, we will exit anyway after this iteration.
-		(cond ((eq (car colors) t)
-		       (invert-face face frame))
-		      ((eq (car colors) 'underline)
-		       (set-face-underline-p face t frame))
-		      (t
-		       (funcall function face (car colors) frame)))))
-	  (setq colors (cdr colors)))))))
-
-;; If we are already using x-window frames, initialize faces for them.
-(if (memq (framep (selected-frame)) '(x w32))
-    (face-initialize))
-
-(provide 'faces)
-
-;;; faces.el ends here
diff --git a/lisp/fast-lock.el b/lisp/fast-lock.el
deleted file mode 100644
index aa3a57b9e41..00000000000
--- a/lisp/fast-lock.el
+++ /dev/null
@@ -1,735 +0,0 @@
-;;; fast-lock.el --- Automagic text properties caching for fast Font Lock mode.
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Simon Marshall <simon@gnu.ai.mit.edu>
-;; Keywords: faces files
-;; Version: 3.11
-
-;;; 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:
-
-;; Lazy Lock mode is a Font Lock support mode.
-;; It makes visiting a file in Font Lock mode faster by restoring its face text
-;; properties from automatically saved associated Font Lock cache files.
-;;
-;; See caveats and feedback below.
-;; See also the lazy-lock package.  (But don't use the two at the same time!)
-
-;; Installation:
-;; 
-;; Put in your ~/.emacs:
-;;
-;; (setq font-lock-support-mode 'fast-lock-mode)
-;;
-;; Start up a new Emacs and use font-lock as usual (except that you can use the
-;; so-called "gaudier" fontification regexps on big files without frustration).
-;;
-;; When you visit a file (which has `font-lock-mode' enabled) that has a
-;; corresponding Font Lock cache file associated with it, the Font Lock cache
-;; will be loaded from that file instead of being generated by Font Lock code.
-
-;; Caveats:
-;;
-;; A cache will be saved when visiting a compressed file using crypt++, but not
-;; be read.  This is a "feature"/"consequence"/"bug" of crypt++.
-;;
-;; Version control packages are likely to stamp all over file modification
-;; times.  Therefore the act of checking out may invalidate a cache.
-
-;; History:
-;;
-;; 0.02--1.00:
-;; - Changed name from turbo-prop to fast-lock.  Automagic for font-lock only
-;; - Made `fast-lock-mode' a minor mode, like G. Dinesh Dutt's fss-mode
-;; 1.00--1.01:
-;; - Turn on `fast-lock-mode' only if `buffer-file-name' or `interactive-p'
-;; - Made `fast-lock-file-name' use `buffer-name' if `buffer-file-name' is nil
-;; - Moved save-all conditions to `fast-lock-save-cache'
-;; - Added `fast-lock-save-text-properties' to `kill-buffer-hook'
-;; 1.01--2.00: complete rewrite---not worth the space to document
-;; - Changed structure of text properties cache and threw out file mod checks
-;; 2.00--2.01:
-;; - Made `condition-case' forms understand `quit'. 
-;; - Made `fast-lock' require `font-lock'
-;; - Made `fast-lock-cache-name' chase links (from Ben Liblit)
-;; 2.01--3.00:
-;; - Changed structure of cache to include `font-lock-keywords' (from rms)
-;; - Changed `fast-lock-cache-mechanisms' to `fast-lock-cache-directories'
-;; - Removed `fast-lock-read-others'
-;; - Made `fast-lock-read-cache' ignore cache owner
-;; - Made `fast-lock-save-cache-external' create cache directory
-;; - Made `fast-lock-save-cache-external' save `font-lock-keywords'
-;; - Made `fast-lock-cache-data' check `font-lock-keywords'
-;; 3.00--3.01: incorporated port of 2.00 to Lucid, made by Barry Warsaw
-;; - Package now provides itself
-;; - Lucid: Use `font-lock-any-extents-p' for `font-lock-any-properties-p'
-;; - Lucid: Use `list-faces' for `face-list'
-;; - Lucid: Added `set-text-properties'
-;; - Lucid: Made `turn-on-fast-lock' pass 1 not t to `fast-lock-mode'
-;; - Removed test for `fast-lock-mode' from `fast-lock-read-cache'
-;; - Lucid: Added Lucid-specific `fast-lock-get-face-properties'
-;; 3.01--3.02: now works with Lucid Emacs, thanks to Barry Warsaw
-;; - Made `fast-lock-cache-name' map ":" to ";" for OS/2 (from Serganova Vera)
-;; - Made `fast-lock-cache-name' use abbreviated file name (from Barry Warsaw)
-;; - Lucid: Separated handlers for `error' and `quit' for `condition-case'
-;; 3.02--3.03:
-;; - Changed `fast-lock-save-cache-external' to `fast-lock-save-cache-data'
-;; - Lucid: Added Lucid-specific `fast-lock-set-face-properties'
-;; 3.03--3.04:
-;; - Corrected `subrp' test of Lucid code
-;; - Replaced `font-lock-any-properties-p' with `text-property-not-all'
-;; - Lucid: Made `fast-lock-set-face-properties' put `text-prop' on extents
-;; - Made `fast-lock-cache-directories' a regexp alist (from Colin Rafferty)
-;; - Made `fast-lock-cache-directory' to return a usable cache file directory
-;; 3.04--3.05:
-;; - Lucid: Fix for XEmacs 19.11 `text-property-not-all'
-;; - Replaced `subrp' test of Lucid code with `emacs-version' `string-match'
-;; - Made `byte-compile-warnings' omit `unresolved' on compilation
-;; - Made `fast-lock-save-cache-data' use a buffer (from Rick Sladkey)
-;; - Reverted to old `fast-lock-get-face-properties' (from Rick Sladkey)
-;; 3.05--3.06: incorporated hack of 3.03, made by Jonathan Stigelman (Stig)
-;; - Reverted to 3.04 version of `fast-lock-get-face-properties'
-;; - XEmacs: Removed `list-faces' `defalias'
-;; - Made `fast-lock-mode' and `turn-on-fast-lock' succeed `autoload' cookies
-;; - Added `fast-lock-submit-bug-report'
-;; - Renamed `fast-lock-save-size' to `fast-lock-minimum-size'
-;; - Made `fast-lock-save-cache' output a message if no save ever attempted
-;; - Made `fast-lock-save-cache-data' output a message if save attempted
-;; - Made `fast-lock-cache-data' output a message if load attempted
-;; - Made `fast-lock-save-cache-data' do `condition-case' not `unwind-protect'
-;; - Made `fast-lock-save-cache' and `fast-lock-read-cache' return nothing
-;; - Made `fast-lock-save-cache' check `buffer-modified-p' (Stig)
-;; - Added `fast-lock-save-events'
-;; - Added `fast-lock-after-save-hook' to `after-save-hook' (Stig)
-;; - Added `fast-lock-kill-buffer-hook' to `kill-buffer-hook'
-;; - Changed `fast-lock-save-caches' to `fast-lock-kill-emacs-hook'
-;; - Added `fast-lock-kill-emacs-hook' to `kill-emacs-hook'
-;; - Made `fast-lock-save-cache' check `verify-visited-file-modtime' (Stig)
-;; - Made `visited-file-modtime' be the basis of the timestamp (Stig)
-;; - Made `fast-lock-save-cache-1' and `fast-lock-cache-data' use/reformat it
-;; - Added `fast-lock-cache-filename' to keep track of the cache file name
-;; - Added `fast-lock-after-fontify-buffer'
-;; - Added `fast-lock-save-faces' list of faces to save (idea from Stig/Tibor)
-;; - Made `fast-lock-get-face-properties' functions use it
-;; - XEmacs: Made `fast-lock-set-face-properties' do extents the Font Lock way
-;; - XEmacs: Removed fix for `text-property-not-all' (19.11 support dropped)
-;; - Made `fast-lock-mode' ensure `font-lock-mode' is on
-;; - Made `fast-lock-save-cache' do `cdr-safe' not `cdr' (from Dave Foster)
-;; - Made `fast-lock-save-cache' do `set-buffer' first (from Dave Foster)
-;; - Made `fast-lock-save-cache' loop until saved or quit (from Georg Nikodym)
-;; - Made `fast-lock-cache-data' check `buffer-modified-p'
-;; - Made `fast-lock-cache-data' do `font-lock-compile-keywords' if necessary
-;; - XEmacs: Made `font-lock-compile-keywords' `defalias'
-;; 3.06--3.07:
-;; - XEmacs: Add `fast-lock-after-fontify-buffer' to the Font Lock hook
-;; - Made `fast-lock-cache-name' explain the use of `directory-abbrev-alist'
-;; - Made `fast-lock-mode' use `buffer-file-truename' not `buffer-file-name'
-;; 3.07--3.08:
-;; - Made `fast-lock-read-cache' set `fast-lock-cache-filename'
-;; 3.08--3.09:
-;; - Made `fast-lock-save-cache' cope if `fast-lock-minimum-size' is an a list
-;; - Made `fast-lock-mode' respect the value of `font-lock-inhibit-thing-lock'
-;; - Added `fast-lock-after-unfontify-buffer'
-;; 3.09--3.10:
-;; - Rewrite for Common Lisp macros
-;; - Made fast-lock.el barf on a crap 8+3 pseudo-OS (Eli Zaretskii help)
-;; - XEmacs: Made `add-minor-mode' succeed `autoload' cookie
-;; - XEmacs: Made `fast-lock-save-faces' default to `font-lock-face-list'
-;; - Made `fast-lock-save-cache' use `font-lock-value-in-major-mode'
-;; - Wrap with `save-buffer-state' (Ray Van Tassle report)
-;; - Made `fast-lock-mode' wrap `font-lock-support-mode'
-;; 3.10--3.11:
-;; - Made `fast-lock-get-face-properties' cope with face lists
-;; - Added `fast-lock-verbose'
-;; - XEmacs: Add `font-lock-value-in-major-mode' if necessary
-;; - Removed `fast-lock-submit-bug-report' and bade farewell
-
-;;; Code:
-
-(require 'font-lock)
-
-;; Make sure fast-lock.el is supported.
-(if (and (eq system-type 'ms-dos) (not (msdos-long-file-names)))
-    (error "`fast-lock' was written for long file name systems"))
-
-(eval-when-compile
-  ;;
-  ;; We don't do this at the top-level as we only use non-autoloaded macros.
-  (require 'cl)
-  ;;
-  ;; I prefer lazy code---and lazy mode.
-  (setq byte-compile-dynamic t byte-compile-dynamic-docstrings t)
-  ;; But, we make sure that the code is as zippy as can be.
-  (setq byte-optimize t)
-  ;;
-  ;; We use this to preserve or protect things when modifying text properties.
-  (defmacro save-buffer-state (varlist &rest body)
-    "Bind variables according to VARLIST and eval BODY restoring buffer state."
-    (` (let* ((,@ (append varlist
-		   '((modified (buffer-modified-p))
-		     (inhibit-read-only t) (buffer-undo-list t)
-		     before-change-functions after-change-functions
-		     deactivate-mark buffer-file-name buffer-file-truename))))
-	 (,@ body)
-	 (when (and (not modified) (buffer-modified-p))
-	   (set-buffer-modified-p nil)))))
-  (put 'save-buffer-state 'lisp-indent-function 1)
-  ;;
-  ;; We use this to verify that a face should be saved.
-  (defmacro fast-lock-save-facep (face)
-    "Return non-nil if FACE is one of `fast-lock-save-faces'."
-    (` (or (null fast-lock-save-faces)
-	   (if (symbolp (, face))
-	       (memq (, face) fast-lock-save-faces)
-	     (let ((faces (, face)))
-	       (while (unless (memq (car faces) fast-lock-save-faces)
-			(setq faces (cdr faces))))
-	       faces))))))
-
-;(defun fast-lock-submit-bug-report ()
-;  "Submit via mail a bug report on fast-lock.el."
-;  (interactive)
-;  (let ((reporter-prompt-for-summary-p t))
-;    (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "fast-lock 3.11"
-;     '(fast-lock-cache-directories fast-lock-minimum-size
-;       fast-lock-save-others fast-lock-save-events fast-lock-save-faces
-;       fast-lock-verbose)
-;     nil nil
-;     (concat "Hi Si.,
-;
-;I want to report a bug.  I've read the `Bugs' section of `Info' on Emacs, so I
-;know how to make a clear and unambiguous report.  To reproduce the bug:
-;
-;Start a fresh editor via `" invocation-name " -no-init-file -no-site-file'.
-;In the `*scratch*' buffer, evaluate:"))))
-
-(defvar fast-lock-mode nil)
-(defvar fast-lock-cache-timestamp nil)	; for saving/reading
-(defvar fast-lock-cache-filename nil)	; for deleting
-
-;; User Variables:
-
-(defvar fast-lock-cache-directories '("." "~/.emacs-flc")
-; - `internal', keep each file's Font Lock cache file in the same file.
-; - `external', keep each file's Font Lock cache file in the same directory.
-  "*Directories in which Font Lock cache files are saved and read.
-Each item should be either DIR or a cons pair of the form (REGEXP . DIR) where
-DIR is a directory name (relative or absolute) and REGEXP is a regexp.
-
-An attempt will be made to save or read Font Lock cache files using these items
-until one succeeds (i.e., until a readable or writable one is found).  If an
-item contains REGEXP, DIR is used only if the buffer file name matches REGEXP.
-For example:
-
- (let ((home (expand-file-name (abbreviate-file-name (file-truename \"~/\")))))
-   (list (cons (concat \"^\" (regexp-quote home)) \".\") \"~/.emacs-flc\"))
-    =>
- ((\"^/your/true/home/directory/\" . \".\") \"~/.emacs-flc\")
-
-would cause a file's current directory to be used if the file is under your
-home directory hierarchy, or otherwise the absolute directory `~/.emacs-flc'.")
-
-(defvar fast-lock-minimum-size (* 25 1024)
-  "*Minimum size of a buffer for cached fontification.
-Only buffers more than this can have associated Font Lock cache files saved.
-If nil, means cache files are never created.
-If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
-where MAJOR-MODE is a symbol or t (meaning the default).  For example:
- ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576))
-means that the minimum size is 25K for buffers in C or C++ modes, one megabyte
-for buffers in Rmail mode, and size is irrelevant otherwise.")
-
-(defvar fast-lock-save-events '(kill-buffer kill-emacs)
-  "*Events under which caches will be saved.
-Valid events are `save-buffer', `kill-buffer' and `kill-emacs'.
-If concurrent editing sessions use the same associated cache file for a file's
-buffer, then you should add `save-buffer' to this list.")
-
-(defvar fast-lock-save-others t
-  "*If non-nil, save Font Lock cache files irrespective of file owner.
-If nil, means only buffer files known to be owned by you can have associated
-Font Lock cache files saved.  Ownership may be unknown for networked files.")
-
-(defvar fast-lock-save-faces
-  (when (save-match-data (string-match "XEmacs" (emacs-version)))
-    ;; XEmacs uses extents for everything, so we have to pick the right ones.
-    font-lock-face-list)
-  "Faces that will be saved in a Font Lock cache file.
-If nil, means information for all faces will be saved.")
-
-(defvar fast-lock-verbose font-lock-verbose
-  "*If non-nil, means show status messages for cache processing.
-If a number, only buffers greater than this size have processing messages.")
-
-;; User Functions:
-
-;;;###autoload
-(defun fast-lock-mode (&optional arg)
-  "Toggle Fast Lock mode.
-With arg, turn Fast Lock mode on if and only if arg is positive and the buffer
-is associated with a file.  Enable it automatically in your `~/.emacs' by:
-
- (setq font-lock-support-mode 'fast-lock-mode)
-
-If Fast Lock mode is enabled, and the current buffer does not contain any text
-properties, any associated Font Lock cache is used if its timestamp matches the
-buffer's file, and its `font-lock-keywords' match those that you are using.
-
-Font Lock caches may be saved:
-- When you save the file's buffer.
-- When you kill an unmodified file's buffer.
-- When you exit Emacs, for all unmodified or saved buffers.
-Depending on the value of `fast-lock-save-events'.
-See also the commands `fast-lock-read-cache' and `fast-lock-save-cache'.
-
-Use \\[font-lock-fontify-buffer] to fontify the buffer if the cache is bad.
-
-Various methods of control are provided for the Font Lock cache.  In general,
-see variable `fast-lock-cache-directories' and function `fast-lock-cache-name'.
-For saving, see variables `fast-lock-minimum-size', `fast-lock-save-events',
-`fast-lock-save-others' and `fast-lock-save-faces'."
-  (interactive "P")
-  ;; Only turn on if we are visiting a file.  We could use `buffer-file-name',
-  ;; but many packages temporarily wrap that to nil when doing their own thing.
-  (set (make-local-variable 'fast-lock-mode)
-       (and buffer-file-truename
-	    (not (memq 'fast-lock-mode font-lock-inhibit-thing-lock))
-	    (if arg (> (prefix-numeric-value arg) 0) (not fast-lock-mode))))
-  (if (and fast-lock-mode (not font-lock-mode))
-      ;; Turned on `fast-lock-mode' rather than `font-lock-mode'.
-      (let ((font-lock-support-mode 'fast-lock-mode))
-	(font-lock-mode t))
-    ;; Let's get down to business.
-    (set (make-local-variable 'fast-lock-cache-timestamp) nil)
-    (set (make-local-variable 'fast-lock-cache-filename) nil)
-    (when (and fast-lock-mode (not font-lock-fontified))
-      (fast-lock-read-cache))))
-
-(defun fast-lock-read-cache ()
-  "Read the Font Lock cache for the current buffer.
-
-The following criteria must be met for a Font Lock cache file to be read:
-- Fast Lock mode must be turned on in the buffer.
-- The buffer must not be modified.
-- The buffer's `font-lock-keywords' must match the cache's.
-- The buffer file's timestamp must match the cache's.
-- Criteria imposed by `fast-lock-cache-directories'.
-
-See `fast-lock-mode'."
-  (interactive)
-  (let ((directories fast-lock-cache-directories)
-	(modified (buffer-modified-p)) (inhibit-read-only t)
-	(fontified font-lock-fontified))
-    (set (make-local-variable 'font-lock-fontified) nil)
-    ;; Keep trying directories until fontification is turned off.
-    (while (and directories (not font-lock-fontified))
-      (let ((directory (fast-lock-cache-directory (car directories) nil)))
-	(condition-case nil
-	    (when directory
-	      (setq fast-lock-cache-filename (fast-lock-cache-name directory))
-	      (when (file-readable-p fast-lock-cache-filename)
-		(load fast-lock-cache-filename t t t)))
-	  (error nil) (quit nil))
-	(setq directories (cdr directories))))
-    ;; Unset `fast-lock-cache-filename', and restore `font-lock-fontified', if
-    ;; we don't use a cache.  (Note that `fast-lock-cache-data' sets the value
-    ;; of `fast-lock-cache-timestamp'.)
-    (set-buffer-modified-p modified)
-    (unless font-lock-fontified
-      (setq fast-lock-cache-filename nil font-lock-fontified fontified))))
-
-(defun fast-lock-save-cache (&optional buffer)
-  "Save the Font Lock cache of BUFFER or the current buffer.
-
-The following criteria must be met for a Font Lock cache file to be saved:
-- Fast Lock mode must be turned on in the buffer.
-- The event must be one of `fast-lock-save-events'.
-- The buffer must be at least `fast-lock-minimum-size' bytes long.
-- The buffer file must be owned by you, or `fast-lock-save-others' must be t.
-- The buffer must contain at least one `face' text property.
-- The buffer must not be modified.
-- The buffer file's timestamp must be the same as the file's on disk.
-- The on disk file's timestamp must be different than the buffer's cache.
-- Criteria imposed by `fast-lock-cache-directories'.
-
-See `fast-lock-mode'."
-  (interactive)
-  (save-excursion
-    (when buffer
-      (set-buffer buffer))
-    (let ((min-size (font-lock-value-in-major-mode fast-lock-minimum-size))
-	  (file-timestamp (visited-file-modtime)) (saved nil))
-      (when (and fast-lock-mode
-	     ;;
-	     ;; "Only save if the buffer matches the file, the file has
-	     ;; changed, and it was changed by the current emacs session."
-	     ;;
-	     ;; Only save if the buffer is not modified,
-	     ;; (i.e., so we don't save for something not on disk)
-	     (not (buffer-modified-p))
-	     ;; and the file's timestamp is the same as the buffer's,
-	     ;; (i.e., someone else hasn't written the file in the meantime)
-	     (verify-visited-file-modtime (current-buffer))
-	     ;; and the file's timestamp is different from the cache's.
-	     ;; (i.e., a save has occurred since the cache was read)
-	     (not (equal fast-lock-cache-timestamp file-timestamp))
-	     ;;
-	     ;; Only save if user's restrictions are satisfied.
-	     (and min-size (>= (buffer-size) min-size))
-	     (or fast-lock-save-others
-		 (eq (user-uid) (nth 2 (file-attributes buffer-file-name))))
-	     ;;
-	     ;; Only save if there are `face' properties to save.
-	     (text-property-not-all (point-min) (point-max) 'face nil))
-	;;
-	;; Try each directory until we manage to save or the user quits.
-	(let ((directories fast-lock-cache-directories))
-	  (while (and directories (memq saved '(nil error)))
-	    (let* ((dir (fast-lock-cache-directory (car directories) t))
-		   (file (and dir (fast-lock-cache-name dir))))
-	      (when (and file (file-writable-p file))
-		(setq saved (fast-lock-save-cache-1 file file-timestamp)))
-	      (setq directories (cdr directories)))))))))
-
-;;;###autoload
-(defun turn-on-fast-lock ()
-  "Unconditionally turn on Fast Lock mode."
-  (fast-lock-mode t))
-
-;;; API Functions:
-
-(defun fast-lock-after-fontify-buffer ()
-  ;; Delete the Font Lock cache file used to restore fontification, if any.
-  (when fast-lock-cache-filename
-    (if (file-writable-p fast-lock-cache-filename)
-	(delete-file fast-lock-cache-filename)
-      (message "File %s font lock cache cannot be deleted" (buffer-name))))
-  ;; Flag so that a cache will be saved later even if the file is never saved.
-  (setq fast-lock-cache-timestamp nil))
-
-(defalias 'fast-lock-after-unfontify-buffer
-  'ignore)
-
-;; Miscellaneous Functions:
-
-(defun fast-lock-save-cache-after-save-file ()
-  ;; Do `fast-lock-save-cache' if `save-buffer' is on `fast-lock-save-events'.
-  (when (memq 'save-buffer fast-lock-save-events)
-    (fast-lock-save-cache)))
-
-(defun fast-lock-save-cache-before-kill-buffer ()
-  ;; Do `fast-lock-save-cache' if `kill-buffer' is on `fast-lock-save-events'.
-  (when (memq 'kill-buffer fast-lock-save-events)
-    (fast-lock-save-cache)))
-
-(defun fast-lock-save-caches-before-kill-emacs ()
-  ;; Do `fast-lock-save-cache's if `kill-emacs' is on `fast-lock-save-events'.
-  (when (memq 'kill-emacs fast-lock-save-events)
-    (mapcar 'fast-lock-save-cache (buffer-list))))
-
-(defun fast-lock-cache-directory (directory create)
-  "Return usable directory based on DIRECTORY.
-Returns nil if the directory does not exist, or, if CREATE non-nil, cannot be
-created.  DIRECTORY may be a string or a cons pair of the form (REGEXP . DIR).
-See `fast-lock-cache-directories'."
-  (let ((dir
-	 (cond ((not buffer-file-name)
-		;; Should never be nil, but `crypt++' screws it up.
-		nil)
-	       ((stringp directory)
-		;; Just a directory.
-		directory)
-	       (t
-		;; A directory iff the file name matches the regexp.
-		(let ((bufile (expand-file-name buffer-file-truename))
-		      (case-fold-search nil))
-		  (when (save-match-data (string-match (car directory) bufile))
-		    (cdr directory)))))))
-    (cond ((not dir)
-	   nil)
-	  ((file-accessible-directory-p dir)
-	   dir)
-	  (create
-	   (condition-case nil
-	       (progn (make-directory dir t) dir)
-	     (error nil))))))
-
-;; If you are wondering why we only hash if the directory is not ".", rather
-;; than if `file-name-absolute-p', it is because if we just appended ".flc" for
-;; relative cache directories (that are not ".") then it is possible that more
-;; than one file would have the same cache name in that directory, if the luser
-;; made a link from one relative cache directory to another.  (Phew!)
-(defun fast-lock-cache-name (directory)
-  "Return full cache path name using caching DIRECTORY.
-If DIRECTORY is `.', the path is the buffer file name appended with `.flc'.
-Otherwise, the path name is constructed from DIRECTORY and the buffer's true
-abbreviated file name, with all `/' characters in the name replaced with `#'
-characters, and appended with `.flc'.
-
-If the same file has different cache path names when edited on different
-machines, e.g., on one machine the cache file name has the prefix `#home',
-perhaps due to automount, try putting in your `~/.emacs' something like:
-
- (setq directory-abbrev-alist (cons '(\"^/home/\" . \"/\") directory-abbrev-alist))
-
-Emacs automagically removes the common `/tmp_mnt' automount prefix by default.
-
-See `fast-lock-cache-directory'."
-  (if (string-equal directory ".")
-      (concat buffer-file-name ".flc")
-    (let* ((bufile (expand-file-name buffer-file-truename))
-	   (chars-alist
-	    (if (eq system-type 'emx)
-		'((?/ . (?#)) (?# . (?# ?#)) (?: . (?\;)) (?\; . (?\; ?\;)))
-	      '((?/ . (?#)) (?# . (?# ?#)))))
-	   (mapchars
-	    (function (lambda (c) (or (cdr (assq c chars-alist)) (list c))))))
-      (concat
-       (file-name-as-directory (expand-file-name directory))
-       (mapconcat 'char-to-string (apply 'append (mapcar mapchars bufile)) "")
-       ".flc"))))
-
-;; Font Lock Cache Processing Functions:
-
-(defun fast-lock-save-cache-1 (file timestamp)
-  ;; Save the FILE with the TIMESTAMP as:
-  ;; (fast-lock-cache-data Version=2 TIMESTAMP font-lock-keywords PROPERTIES).
-  ;; Returns non-nil if a save was attempted to a writable cache file.
-  (let ((tpbuf (generate-new-buffer " *fast-lock*"))
-	(verbose (if (numberp fast-lock-verbose)
-		     (> (buffer-size) fast-lock-verbose)
-		   fast-lock-verbose))
-	(saved t))
-    (if verbose (message "Saving %s font lock cache..." (buffer-name)))
-    (condition-case nil
-	(save-excursion
-	  (print (list 'fast-lock-cache-data 2
-		       (list 'quote timestamp)
-		       (list 'quote font-lock-keywords)
-		       (list 'quote (fast-lock-get-face-properties)))
-		 tpbuf)
-	  (set-buffer tpbuf)
-	  (write-region (point-min) (point-max) file nil 'quietly)
-	  (setq fast-lock-cache-timestamp timestamp
-		fast-lock-cache-filename file))
-      (error (setq saved 'error)) (quit (setq saved 'quit)))
-    (kill-buffer tpbuf)
-    (if verbose (message "Saving %s font lock cache...%s" (buffer-name)
-			 (cond ((eq saved 'error) "failed")
-			       ((eq saved 'quit) "aborted")
-			       (t "done"))))
-    ;; We return non-nil regardless of whether a failure occurred.
-    saved))
-
-(defun fast-lock-cache-data (version timestamp keywords properties
-			     &rest ignored)
-  ;; Change from (HIGH LOW) for back compatibility.  Remove for version 3!
-  (when (consp (cdr-safe timestamp))
-    (setcdr timestamp (nth 1 timestamp)))
-  ;; Compile KEYWORDS and `font-lock-keywords' in case one is and one isn't.
-  (let ((current font-lock-keywords))
-    (setq keywords (font-lock-compile-keywords keywords)
-	  font-lock-keywords (font-lock-compile-keywords current)))
-  ;; Use the Font Lock cache PROPERTIES if we're using cache VERSION format 2,
-  ;; the current buffer's file timestamp matches the TIMESTAMP, and the current
-  ;; buffer's font-lock-keywords are the same as KEYWORDS.
-  (let ((buf-timestamp (visited-file-modtime))
-	(verbose (if (numberp fast-lock-verbose)
-		     (> (buffer-size) fast-lock-verbose)
-		   fast-lock-verbose))
-	(loaded t))
-    (if (or (/= version 2)
-	    (buffer-modified-p)
-	    (not (equal timestamp buf-timestamp))
-	    (not (equal keywords font-lock-keywords)))
-	(setq loaded nil)
-      (if verbose (message "Loading %s font lock cache..." (buffer-name)))
-      (condition-case nil
-	  (fast-lock-set-face-properties properties)
-	(error (setq loaded 'error)) (quit (setq loaded 'quit)))
-      (if verbose (message "Loading %s font lock cache...%s" (buffer-name)
-			   (cond ((eq loaded 'error) "failed")
-				 ((eq loaded 'quit) "aborted")
-				 (t "done")))))
-    (setq font-lock-fontified (eq loaded t)
-	  fast-lock-cache-timestamp (and (eq loaded t) timestamp))))
-
-;; Text Properties Processing Functions:
-
-;; This is fast, but fails if adjacent characters have different `face' text
-;; properties.  Maybe that's why I dropped it in the first place?
-;(defun fast-lock-get-face-properties ()
-;  "Return a list of all `face' text properties in the current buffer.
-;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
-;where VALUE is a `face' property value and STARTx and ENDx are positions."
-;  (save-restriction
-;    (widen)
-;    (let ((start (text-property-not-all (point-min) (point-max) 'face nil))
-;	  (limit (point-max)) end properties value cell)
-;      (while start
-;	(setq end (next-single-property-change start 'face nil limit)
-;	      value (get-text-property start 'face))
-;	;; Make, or add to existing, list of regions with same `face'.
-;	(if (setq cell (assq value properties))
-;	    (setcdr cell (cons start (cons end (cdr cell))))
-;	  (setq properties (cons (list value start end) properties)))
-;	(setq start (next-single-property-change end 'face)))
-;      properties)))
-
-;; This is slow, but copes if adjacent characters have different `face' text
-;; properties, but fails if they are lists.
-;(defun fast-lock-get-face-properties ()
-;  "Return a list of all `face' text properties in the current buffer.
-;Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
-;where VALUE is a `face' property value and STARTx and ENDx are positions.
-;Only those `face' VALUEs in `fast-lock-save-faces' are returned."
-;  (save-restriction
-;    (widen)
-;    (let ((faces (or fast-lock-save-faces (face-list))) (limit (point-max))
-;	  properties regions face start end)
-;      (while faces
-;	(setq face (car faces) faces (cdr faces) regions () end (point-min))
-;	;; Make a list of start/end regions with `face' property face.
-;	(while (setq start (text-property-any end limit 'face face))
-;	  (setq end (or (text-property-not-all start limit 'face face) limit)
-;		regions (cons start (cons end regions))))
-;	;; Add `face' face's regions, if any, to properties.
-;	(when regions
-;	  (push (cons face regions) properties)))
-;      properties)))
-
-(defun fast-lock-get-face-properties ()
-  "Return a list of all `face' text properties in the current buffer.
-Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
-where VALUE is a `face' property value and STARTx and ENDx are positions."
-  (save-restriction
-    (widen)
-    (let ((start (text-property-not-all (point-min) (point-max) 'face nil))
-	  end properties value cell)
-      (while start
-	(setq end (next-single-property-change start 'face nil (point-max))
-	      value (get-text-property start 'face))
-	;; Make, or add to existing, list of regions with same `face'.
-	(cond ((setq cell (assoc value properties))
-	       (setcdr cell (cons start (cons end (cdr cell)))))
-	      ((fast-lock-save-facep value)
-	       (push (list value start end) properties)))
-	(setq start (text-property-not-all end (point-max) 'face nil)))
-      properties)))
-
-(defun fast-lock-set-face-properties (properties)
-  "Set all `face' text properties to PROPERTIES in the current buffer.
-Any existing `face' text properties are removed first.
-See `fast-lock-get-face-properties' for the format of PROPERTIES."
-  (save-buffer-state (plist regions)
-    (save-restriction
-      (widen)
-      (font-lock-unfontify-region (point-min) (point-max))
-      (while properties
-	(setq plist (list 'face (car (car properties)))
-	      regions (cdr (car properties))
-	      properties (cdr properties))
-	;; Set the `face' property for each start/end region.
-	(while regions
-	  (set-text-properties (nth 0 regions) (nth 1 regions) plist)
-	  (setq regions (nthcdr 2 regions)))))))
-
-;; Functions for XEmacs:
-
-(when (save-match-data (string-match "XEmacs" (emacs-version)))
-  ;;
-  ;; It would be better to use XEmacs' `map-extents' over extents with a
-  ;; `font-lock' property, but `face' properties are on different extents.
-  (defun fast-lock-get-face-properties ()
-    "Return a list of all `face' text properties in the current buffer.
-Each element of the list is of the form (VALUE START1 END1 START2 END2 ...)
-where VALUE is a `face' property value and STARTx and ENDx are positions.
-Only those `face' VALUEs in `fast-lock-save-faces' are returned."
-    (save-restriction
-      (widen)
-      (let ((properties ()) cell)
-	(map-extents
-	 (function (lambda (extent ignore)
-	    (let ((value (extent-face extent)))
-	      ;; We're only interested if it's one of `fast-lock-save-faces'.
-	      (when (and value (fast-lock-save-facep value))
-		(let ((start (extent-start-position extent))
-		      (end (extent-end-position extent)))
-		  ;; Make or add to existing list of regions with the same
-		  ;; `face' property value.
-		  (if (setq cell (assoc value properties))
-		      (setcdr cell (cons start (cons end (cdr cell))))
-		    (push (list value start end) properties))))
-	      ;; Return nil to keep `map-extents' going.
-	      nil))))
-	properties)))
-  ;;
-  ;; Make extents just like XEmacs' font-lock.el does.
-  (defun fast-lock-set-face-properties (properties)
-    "Set all `face' text properties to PROPERTIES in the current buffer.
-Any existing `face' text properties are removed first.
-See `fast-lock-get-face-properties' for the format of PROPERTIES."
-    (save-restriction
-      (widen)
-      (font-lock-unfontify-region (point-min) (point-max))
-      (while properties
-	(let ((face (car (car properties)))
-	      (regions (cdr (car properties))))
-	  ;; Set the `face' property, etc., for each start/end region.
-	  (while regions
-	    (font-lock-set-face (nth 0 regions) (nth 1 regions) face)
-	    (setq regions (nthcdr 2 regions)))
-	  (setq properties (cdr properties))))))
-  ;;
-  ;; XEmacs 19.12 font-lock.el's `font-lock-fontify-buffer' runs a hook.
-  (add-hook 'font-lock-after-fontify-buffer-hook
-	    'fast-lock-after-fontify-buffer))
-
-(unless (boundp 'font-lock-inhibit-thing-lock)
-  (defvar font-lock-inhibit-thing-lock nil
-    "List of Font Lock mode related modes that should not be turned on."))
-
-(unless (fboundp 'font-lock-value-in-major-mode)
-  (defun font-lock-value-in-major-mode (alist)
-    ;; Return value in ALIST for `major-mode'.
-    (if (consp alist)
-	(cdr (or (assq major-mode alist) (assq t alist)))
-      alist)))
-
-(unless (fboundp 'font-lock-compile-keywords)
-  (defalias 'font-lock-compile-keywords 'identity))
-
-;; Install ourselves:
-
-(add-hook 'after-save-hook 'fast-lock-save-cache-after-save-file)
-(add-hook 'kill-buffer-hook 'fast-lock-save-cache-before-kill-buffer)
-(add-hook 'kill-emacs-hook 'fast-lock-save-caches-before-kill-emacs)
-
-;;;###autoload
-(if (fboundp 'add-minor-mode) (add-minor-mode 'fast-lock-mode nil))
-;;;###dont-autoload
-(unless (assq 'fast-lock-mode minor-mode-alist)
-  (setq minor-mode-alist (append minor-mode-alist '((fast-lock-mode nil)))))
-
-;; Provide ourselves:
-
-(provide 'fast-lock)
-
-;;; fast-lock.el ends here
diff --git a/lisp/ffap.el b/lisp/ffap.el
deleted file mode 100644
index a4d69ec0eb6..00000000000
--- a/lisp/ffap.el
+++ /dev/null
@@ -1,1433 +0,0 @@
-;;; ffap.el --- find file or url at point
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
-;; Created: 29 Mar 1993
-;; Keywords: files, hypermedia, matching, mouse
-;; X-Latest: ftp://ftp.mathcs.emory.edu:/pub/mic/emacs/
-
-;; 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:
-;;
-;; Command find-file-at-point replaces find-file.  With a prefix, it
-;; behaves exactly like find-file.  Without a prefix, it first tries
-;; to guess a default file or url from the text around the point
-;; (`ffap-require-prefix' swaps these behaviors).  This is useful for
-;; following references in situations such as mail or news buffers,
-;; README's, MANIFEST's, and so on.  Submit bugs or suggestions with
-;; M-x ffap-bug.
-;;
-;; For the default installation, byte-compile ffap.el somewhere in
-;; your `load-path' and add these two lines to your .emacs file:
-;;
-;; (require 'ffap)                      ; load the package
-;; (ffap-bindings)                      ; do default key bindings
-;;
-;; ffap-bindings makes the following global key bindings:
-;;
-;; C-x C-f       find-file-at-point (abbreviated as ffap)
-;; C-x 4 f       ffap-other-window
-;; C-x 5 f       ffap-other-frame
-;; S-mouse-3     ffap-at-mouse
-;;
-;; ffap-bindings also adds hooks to make the following local bindings
-;; in vm, gnus, and rmail:
-;;
-;; M-l         ffap-next, or ffap-gnus-next in gnus
-;; M-m         ffap-menu, or ffap-gnus-menu in gnus
-;;
-;; If you do not like these bindings, modify the variable
-;; `ffap-bindings', or write your own.
-;;
-;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best
-;; to load or autoload them before ffap.  If you use ff-paths, load it
-;; afterwards.  Try apropos {C-h a ffap RET} to get a list of the many
-;; option variables.  In particular, if ffap is slow, try these:
-;;
-;; (setq ffap-alist nil)                ; faster, dumber prompting
-;; (setq ffap-machine-p-known 'accept)  ; no pinging
-;; (setq ffap-url-regexp nil)           ; disable url features in ffap
-;;
-;; ffap uses w3 (if found) or else browse-url to fetch url's.  For
-;; a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
-;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
-;; the file and url references within a buffer.
-
-;;; Todo list:
-;; * recognize paths inside /usr/bin:/bin:/etc, ./ffap.el:80:
-;; * let "/path/file#key" jump to key (offset or regexp) in /path/file
-;; * find file of symbol if TAGS is loaded (like above)
-;; * break up long menus into multiple panes (like imenu?)
-;; * notice node in "(dired)Virtual Dired" (handle the space?)
-;; * notice "machine.dom blah blah blah path/file" (how?)
-;; * if w3 becomes standard, could rewrite to use its functions
-;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
-;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
-;; * support for custom.el
-;; + handle "$(HOME)" in Makefiles?
-;; + modify `font-lock-keywords' to do fontification
-
-
-;;; Code:
-
-(provide 'ffap)
-
-;; Versions: This file is tested with Emacs 19.30.  It mostly works
-;; with XEmacs, but get ffap-xe.el for the popup menu.  Emacs 18 is
-;; now abandoned (get ffap-15.el instead).
-
-(defvar ffap-xemacs (and (string-match "X[Ee]macs" emacs-version) t)
-  "Whether ffap thinks it is running under XEmacs.")
-
-
-
-;;; User Variables:
-
-;; This function is used inside defvars:
-(defun ffap-soft-value (name &optional default)
-  "Return value of symbol with NAME, if it is interned.
-Otherwise return nil (or the optional DEFAULT value)."
-  ;; Bug: (ffap-soft-value "nil" 5) --> 5
-  (let ((sym (intern-soft name)))
-    (if (and sym (boundp sym)) (symbol-value sym) default)))
-
-
-(defvar ffap-ftp-regexp
-  (and
-   (or (featurep 'ange-ftp)
-       (featurep 'efs)
-       (and (boundp 'file-name-handler-alist) ; v19
-	    (or (rassq 'ange-ftp-hook-function file-name-handler-alist)
-		(rassq 'efs-file-handler-function file-name-handler-alist))))
-   ;; Apparently this is good enough for both ange-ftp and efs:
-   "\\`/[^/:]+:")
-  "*Treat paths matching this as remote ftp paths.  Nil to disable.
-Nil also disables the generation of such paths by ffap.")
-
-(defvar ffap-url-unwrap-local t
-  "*If non-nil, convert \"file:\" url to local path before prompting.")
-
-(defvar ffap-url-unwrap-remote t
-  "*If non-nil, convert \"ftp:\" url to remote path before prompting.
-This is ignored if `ffap-ftp-regexp' is nil.")
-
-(defvar ffap-ftp-default-user
-  (if (or (equal (ffap-soft-value "ange-ftp-default-user") "anonymous")
-	  (equal (ffap-soft-value "efs-default-user") "anonymous"))
-      nil
-    "anonymous")
-  "*User name in ftp paths generated by `ffap-host-to-path'.
-Nil to rely on `efs-default-user' or `ange-ftp-default-user'.")
-
-(defvar ffap-rfs-regexp
-  ;; Remote file access built into file system?  HP rfa or Andrew afs:
-  "\\`/\\(afs\\|net\\)/."
-  ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
-  "*Matching paths are treated as remote.  Nil to disable.")
-
-(defvar ffap-url-regexp
-  ;; Could just use `url-nonrelative-link' of w3, if loaded.
-  ;; This regexp is not exhaustive, it just matches common cases.
-  (concat
-   "\\`\\("
-   "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok
-   "\\|"
-   "\\(ftp\\|http\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host
-   "\\)."				; require one more character
-   )
-   "Regexp matching url's.  Nil to disable url features in ffap.")
-
-(defvar ffap-foo-at-bar-prefix "mailto"
-  "*Presumed url prefix type of strings like \"<foo.9z@bar>\".
-Sensible values are nil, \"news\", or \"mailto\".")
-
-
-;;; Peanut Gallery:
-;;
-;; Users of ffap occasionally suggest new features.  If I consider
-;; those features interesting but not clear winners (a matter of
-;; personal taste) I try to leave options to enable them.  Read
-;; through this section for features that you like, put an appropriate
-;; enabler in your .emacs file.
-
-(defvar ffap-dired-wildcards nil	; "[*?][^/]*$"
-  ;; Suggestion from RHOGEE, 07 Jul 1994.  Disabled, dired is still
-  ;; available by "C-x C-d <pattern>", and valid filenames may
-  ;; sometimes contain wildcard characters.
-  "*A regexp matching filename wildcard characters, or nil.
-If `find-file-at-point' gets a filename matching this pattern,
-it passes it on to `dired' instead of `find-file'.")
-
-(defvar ffap-newfile-prompt nil		; t
-  ;; Suggestion from RHOGEE, 11 Jul 1994.  Disabled, I think this is
-  ;; better handled by `find-file-not-found-hooks'.
-  "*Whether `find-file-at-point' prompts about a nonexistent file.")
-
-(defvar ffap-require-prefix nil
-  ;; Suggestion from RHOGEE, 20 Oct 1994.
-  "*If set, reverses the prefix argument to `find-file-at-point'.
-This is nil so neophytes notice ffap.  Experts may prefer to disable
-ffap most of the time.")
-
-(defvar ffap-file-finder 'find-file
-  "*The command called by `find-file-at-point' to find a file.")
-(put 'ffap-file-finder 'risky-local-variable t)
-
-(defvar ffap-url-fetcher
-  (cond ((fboundp 'w3-fetch) 'w3-fetch)
-	((fboundp 'browse-url-netscape) 'browse-url-netscape)
-	(t 'w3-fetch))
-  ;; Remote control references:
-  ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html
-  ;; http://home.netscape.com/newsref/std/x-remote.html
-  "*A function of one argument, called by ffap to fetch an URL.
-Reasonable choices are `w3-fetch' or `browse-url-netscape'.
-For a fancier alternative, get ffap-url.el.")
-(put 'ffap-url-fetcher 'risky-local-variable t)
-
-
-;;; Command ffap-next:
-;;
-;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995.  Since
-;; then, broke it up into ffap-next-guess (noninteractive) and
-;; ffap-next (a command).  It now work on files as well as url's.
-
-(defvar ffap-next-regexp
-  ;; If you want ffap-next to find URL's only, try this:
-  ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp)
-  ;;	  (concat "\\<" (substring ffap-url-regexp 2))))
-  ;;
-  ;; It pays to put a big fancy regexp here, since ffap-guesser is
-  ;; much more time-consuming than regexp searching:
-  "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\."
-  "*Regular expression governing movements of `ffap-next'.")
-
-(defvar ffap-next-guess nil "Last value returned by `ffap-next-guess'.")
-(defun ffap-next-guess (&optional back lim)
-  "Move point to next file or url, and return it as a string.
-If nothing is found, leave point at limit and return nil.
-Optional BACK argument makes search backwards.
-Optional LIM argument limits the search.
-Only considers strings that match `ffap-next-regexp'."
-  (or lim (setq lim (if back (point-min) (point-max))))
-  (let (guess)
-    (while (not (or guess (eq (point) lim)))
-      (funcall (if back 're-search-backward 're-search-forward)
-	       ffap-next-regexp lim 'move)
-      (setq guess (ffap-guesser)))
-    ;; Go to end, so we do not get same guess twice:
-    (goto-char (nth (if back 0 1) ffap-string-at-point-region))
-    (setq ffap-next-guess guess)))
-
-;;;###autoload
-(defun ffap-next (&optional back wrap)
-  "Search buffer for next file or url, and run ffap.
-Optional argument BACK says to search backwards.
-Optional argument WRAP says to try wrapping around if necessary.
-Interactively: use a single prefix to search backwards,
-double prefix to wrap forward, triple to wrap backwards.
-Actual search is done by `ffap-next-guess'."
-  (interactive
-   (cdr (assq (prefix-numeric-value current-prefix-arg)
-	      '((1) (4 t) (16 nil t) (64 t t)))))
-  (let ((pt (point))
-	(guess (ffap-next-guess back)))
-    ;; Try wraparound if necessary:
-    (and (not guess) wrap
-	 (goto-char (if back (point-max) (point-min)))
-	 (setq guess (ffap-next-guess back pt)))
-    (if guess
-	(progn
-	  (sit-for 0)			; display point movement
-	  (find-file-at-point (ffap-prompter guess)))
-      (goto-char pt)			; restore point
-      (message "No %sfiles or URL's found."
-	       (if wrap "" "more ")))))
-
-(defun ffap-next-url (&optional back wrap)
-  "Like `ffap-next', but search with `ffap-url-regexp'."
-  (interactive)
-  (let ((ffap-next-regexp ffap-url-regexp))
-    (if (interactive-p)
-	(call-interactively 'ffap-next)
-      (ffap-next back wrap))))
-
-
-;;; Remote machines and paths:
-
-(defun ffap-replace-path-component (fullname name)
-  "In remote FULLNAME, replace path with NAME.  May return nil."
-  ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
-  (let (found)
-    (mapcar
-     (function (lambda (sym) (and (fboundp sym) (setq found sym))))
-     '(
-       efs-replace-path-component
-       ange-ftp-replace-path-component
-       ange-ftp-replace-name-component
-       ))
-    (and found
-	 (fset 'ffap-replace-path-component found)
-	 (funcall found fullname name))))
-;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new")
-
-(defun ffap-file-exists-string (file)
-  ;; With certain packages (ange-ftp, jka-compr?) file-exists-p
-  ;; sometimes returns a nicer string than it is given.  Otherwise, it
-  ;; just returns nil or t.
-  "Return FILE \(maybe modified\) if it exists, else nil."
-  (and file				; quietly reject nil
-       (let ((exists (file-exists-p file)))
-	 (and exists (if (stringp exists) exists file)))))
-
-;; I cannot decide a "best" strategy here, so these are variables.  In
-;; particular, if `Pinging...' is broken or takes too long on your
-;; machine, try setting these all to accept or reject.
-(defvar ffap-machine-p-local 'reject	; this happens often
-  "*A symbol, one of: ping, accept, reject.
-What `ffap-machine-p' does with hostnames that have no domain.")
-(defvar ffap-machine-p-known 'ping	; 'accept for speed
-  "*A symbol, one of: ping, accept, reject.
-What `ffap-machine-p' does with hostnames that have a known domain
-\(see mail-extr.el for the known domains\).")
-(defvar ffap-machine-p-unknown 'reject
-  "*A symbol, one of: ping, accept, reject.
-What `ffap-machine-p' does with hostnames that have an unknown domain
-\(see mail-extr.el for the known domains\).")
-
-(defun ffap-what-domain (domain)
-  ;; Like what-domain in mail-extr.el, returns string or nil.
-  (require 'mail-extr)
-  (defvar mail-extr-all-top-level-domains
-    (ffap-soft-value "all-top-level-domains" obarray)) ; XEmacs, old Emacs
-  (get (intern-soft (downcase domain) mail-extr-all-top-level-domains)
-       'domain-name))
-
-(defun ffap-machine-p (host &optional service quiet strategy)
-  "Decide whether HOST is the name of a real, reachable machine.
-Depending on the domain (none, known, or unknown), follow the strategy
-named by the variable `ffap-machine-p-local', `ffap-machine-p-known',
-or `ffap-machine-p-unknown'.  Pinging uses `open-network-stream'.
-Optional SERVICE specifies the port used \(default \"discard\"\).
-Optional QUIET flag suppresses the \"Pinging...\" message.
-Optional STRATEGY overrides the three variables above.
-Returned values:
- t      means that HOST answered.
-'accept means the relevant variable told us to accept.
-\"mesg\"  means HOST exists, but does not respond for some reason."
-  ;; Try some (Emory local):
-  ;; (ffap-machine-p "ftp" nil nil 'ping)
-  ;; (ffap-machine-p "nonesuch" nil nil 'ping)
-  ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping)
-  ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
-  ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
-  ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
-  (if (or (string-match "[^-a-zA-Z0-9.]" host) ; Illegal chars (?)
-	  (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject
-      nil
-    (let* ((domain
-	    (and (string-match "\\.[^.]*$" host)
-		 (downcase (substring host (1+ (match-beginning 0))))))
-	   (what-domain (if domain (ffap-what-domain domain) "Local")))
-      (or strategy
-	  (setq strategy
-		(cond ((not domain) ffap-machine-p-local)
-		      ((not what-domain) ffap-machine-p-unknown)
-		      (t ffap-machine-p-known))))
-      (cond
-       ((eq strategy 'accept) 'accept)
-       ((eq strategy 'reject) nil)
-       ;; assume (eq strategy 'ping)
-       (t
-	(or quiet
-	    (if (stringp what-domain)
-		(message "Pinging %s (%s)..." host what-domain)
-	      (message "Pinging %s ..." host)))
-	(condition-case error
-	    (progn
-	      (delete-process
-	       (open-network-stream
-		"ffap-machine-p" nil host (or service "discard")))
-	      t)
-	  (error
-	   (let ((mesg (car (cdr error))))
-	     (cond
-	      ;; v18:
-	      ((string-match "^Unknown host" mesg) nil)
-	      ((string-match "not responding$" mesg) mesg)
-	      ;; v19:
-	      ;; (file-error "connection failed" "permission denied"
-	      ;;             "nonesuch" "ffap-machine-p")
-	      ;; (file-error "connection failed" "host is unreachable"
-	      ;;	     "gopher.house.gov" "ffap-machine-p")
-	      ;; (file-error "connection failed" "address already in use"
-	      ;;	     "ftp.uu.net" "ffap-machine-p")
-	      ((equal mesg "connection failed")
-	       (if (equal (nth 2 error) "permission denied")
-		   nil			; host does not exist
-		 ;; Other errors mean the host exists:
-		 (nth 2 error)))
-	      ;; Could be "Unknown service":
-	      (t (signal (car error) (cdr error))))))))))))
-
-(defun ffap-file-remote-p (filename)
-  "If FILENAME looks remote, return it \(maybe slightly improved\)."
-  ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
-  ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path")
-  ;; (ffap-file-remote-p "/ffap.el:80")
-  (or (and ffap-ftp-regexp
-	   (string-match ffap-ftp-regexp filename)
-	   ;; Convert "/host.com://path" to "/host:/path", to handle a dieing
-	   ;; practice of advertising ftp paths as "host.dom://path".
-	   (if (string-match "//" filename)
-	       ;; (replace-match "/" nil nil filename)
-	       (concat (substring filename 0 (1+ (match-beginning 0)))
-		       (substring filename (match-end 0)))
-	     filename))
-      (and ffap-rfs-regexp
-	   (string-match ffap-rfs-regexp filename)
-	   filename)))
-
-(defun ffap-machine-at-point nil
-  "Return machine name at point if it exists, or nil."
-  (let ((mach (ffap-string-at-point 'machine)))
-    (and (ffap-machine-p mach) mach)))
-
-(defsubst ffap-host-to-path (host)
-  "Convert HOST to something like \"/anonymous@HOST:\".
-Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
-  (if (equal host "localhost") ""
-    (concat "/"
-	    ffap-ftp-default-user (and ffap-ftp-default-user "@")
-	    host ":")))
-
-(defun ffap-fixup-machine (mach)
-  ;; Convert a hostname into an url, an ftp path, or nil.
-  (cond
-   ((not (and ffap-url-regexp (stringp mach))) nil)
-   ;; gopher.well.com
-   ((string-match "\\`gopher[-.]" mach)	; or "info"?
-    (concat "gopher://" mach "/"))
-   ;; www.ncsa.uiuc.edu
-   ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))
-    (concat "http://" mach "/"))
-   ;; More cases?  Maybe "telnet:" for archie?
-   (ffap-ftp-regexp (ffap-host-to-path mach))
-   ))
-
-(defun ffap-newsgroup-p (string)
-  "Return STRING if it looks like a newsgroup name, else nil."
-  (and
-   (string-match ffap-newsgroup-regexp string)
-   (let ((htbs '(gnus-active-hashtb gnus-newsrc-hashtb gnus-killed-hashtb))
-	 (heads ffap-newsgroup-heads)
-	 htb ret)
-     (while htbs
-       (setq htb (car htbs) htbs (cdr htbs))
-       (condition-case nil
-	   (progn
-	     ;; errs: htb symbol may be unbound, or not a hash-table.
-	     ;; gnus-gethash is just a macro for intern-soft.
-	     (and (intern-soft string (symbol-value htb))
-		  (setq ret string htbs nil))
-	     ;; If we made it this far, gnus is running, so ignore "heads":
-	     (setq heads nil))
-	 (error nil)))
-     (or ret (not heads)
-	 (let ((head (string-match "\\`\\([a-z]+\\)\\." string)))
-	   (and head (setq head (substring string 0 (match-end 1)))
-		(member head heads)
-		(setq ret string))))
-     ;; Is there ever a need to modify string as a newsgroup name?
-     ret)))
-(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
-  "Strings not matching this fail `ffap-newsgroup-p'.")
-(defvar ffap-newsgroup-heads		; entirely inadequate
-  '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")
-  "Used by `ffap-newsgroup-p' if gnus is not running.")
-
-(defsubst ffap-url-p (string)
-  "If STRING looks like an url, return it (maybe improved), else nil."
-  (let ((case-fold-search t))
-    (and ffap-url-regexp (string-match ffap-url-regexp string)
-	 ;; I lied, no improvement:
-	 string)))
-
-;; Broke these out of ffap-fixup-url, for use of ffap-url package.
-(defsubst ffap-url-unwrap-local (url)
-  "Return URL as a local file, or nil.  Ignores `ffap-url-regexp'."
-  (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url)
-       (substring url (1+ (match-end 1)))))
-(defsubst ffap-url-unwrap-remote (url)
-  "Return URL as a remote file, or nil.  Ignores `ffap-url-regexp'."
-  (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
-       (concat
-	(ffap-host-to-path (substring url (match-beginning 2) (match-end 2)))
-	(substring url (match-beginning 3) (match-end 3)))))
-;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
-
-(defun ffap-fixup-url (url)
-  "Clean up URL and return it, maybe as a file name."
-  (cond
-   ((not (stringp url)) nil)
-   ((and ffap-url-unwrap-local (ffap-url-unwrap-local url)))
-   ((and ffap-url-unwrap-remote ffap-ftp-regexp
-	 (ffap-url-unwrap-remote url)))
-   ;; Do not load w3 just for this:
-   (t (let ((normal (and (fboundp 'url-normalize-url)
-			 (url-normalize-url url))))
-	;; In case url-normalize-url is confused:
-	(or (and normal (not (zerop (length normal))) normal)
-	    url)))))
-
-
-;;; `ffap-alist':
-;;
-;; Search actions depending on the major-mode or extensions of the
-;; current name.  Note all the little defun's could be broken out, at
-;; some loss of locality.  A good example of featuritis.
-
-;; First, some helpers for functions in `ffap-alist':
-
-(defun ffap-list-env (env &optional empty)
-  ;; Replace this with parse-colon-path (lisp/files.el)?
-  "Directory list parsed from path envinronment variable ENV.
-Optional EMPTY is default if (getenv ENV) is undefined, and is also
-substituted for the first empty-string component, if there is one.
-Uses `path-separator' to separate the path into directories."
-  ;; Derived from psg-list-env in RHOGEE's ff-paths and
-  ;; bib-cite packages.  The `empty' argument is intended to mimic
-  ;; the semantics of TeX/BibTeX variables, it is substituted for
-  ;; any empty string entry.
-  (if (or empty (getenv env))		; should return something
-      (let ((start 0) match dir ret)
-	(setq env (concat (getenv env) path-separator))
-	(while (setq match (string-match path-separator env start))
-	  (setq dir (substring env start match) start (1+ match))
-	  ;;(and (file-directory-p dir) (not (member dir ret)) ...)
-	  (setq ret (cons dir ret)))
-	(setq ret (nreverse ret))
-	(and empty (setq match (member "" ret))
-	     (progn
-	       (setcdr match (append (cdr-safe empty) (cdr match)))
-	       (setcar match (or (car-safe empty) empty))))
-	ret)))
-
-(defun ffap-reduce-path (path)
-  "Remove duplicates and non-directories from PATH list."
-  (let (ret tem)
-    (while path
-      (setq tem path path (cdr path))
-      (if (equal (car tem) ".") (setcar tem ""))
-      (or (member (car tem) ret)
-	  (not (file-directory-p (car tem)))
-	  (progn (setcdr tem ret) (setq ret tem))))
-    (nreverse ret)))
-
-(defun ffap-add-subdirs (path)
-  "Return PATH augmented with its immediate subdirectories."
-  ;; (ffap-add-subdirs '("/notexist" "~"))
-  (let (ret subs)
-    (while path
-      (mapcar
-       (function
-	(lambda (f) (and (file-directory-p f) (setq ret (cons f ret)))))
-       (condition-case nil
-	   (directory-files (car path) t "[^.]")
-	 (error nil)))
-      (setq ret (cons (car path) ret)
-	    path (cdr path)))
-    (nreverse ret)))
-
-(defvar ffap-alist
-  ;; A big mess!  Parts are probably useless.
-  (list
-   (cons "\\.info\\'"
-	 (defun ffap-info (name)
-	   (locate-library
-	    name '("" ".info")
-	    (or (ffap-soft-value "Info-directory-list")
-		(ffap-soft-value "Info-default-directory-list")
-		;; v18:
-		(list (ffap-soft-value "Info-directory" "~/info/"))))))
-   ;; Since so many info files do not have .info extension, also do this:
-   (cons "\\`info/"
-	 (defun ffap-info-2 (name) (ffap-info (substring name 5))))
-   (cons "\\`[-a-z]+\\'"
-	 ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro"
-	 (defun ffap-info-3 (name)
-	   (and (equal (ffap-string-around) "()") (ffap-info name))))
-   (cons "\\.elc?\\'"
-	 (defun ffap-el (name) (locate-library name t)))
-   (cons 'emacs-lisp-mode
-	 (defun ffap-el-mode (name)
-	   ;; We do not bother with "" here, since it was considered above.
-	   ;; Also ignore "elc", for speed (who else reads elc files?)
-	   (and (not (string-match "\\.el\\'" name))
-		(locate-library name '(".el")))))
-   '(finder-mode . ffap-el-mode)	; v19: {C-h p}
-   '(help-mode . ffap-el-mode)		; v19.29
-   (cons 'c-mode
-	 (progn
-	   ;; Need better defaults here!
-	   (defvar ffap-c-path '("/usr/include" "/usr/local/include"))
-	   (defun ffap-c-mode (name)
-	     (locate-library name t ffap-c-path))))
-   '(c++-mode . ffap-c-mode)
-   '(cc-mode . ffap-c-mode)
-   '("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode)
-   (cons 'tex-mode
-	 ;; Complicated because auctex may not be loaded yet.
-	 (progn
-	   (defvar ffap-tex-path
-	     t				; delayed initialization
-	     "Path where `ffap-tex-mode' looks for tex files.
-If t, `ffap-tex-init' will initialize this when needed.")
-	   (defun ffap-tex-init nil
-	     ;; Compute ffap-tex-path if it is now t.
-	     (and (eq t ffap-tex-path)
-		  (message "Initializing ffap-tex-path ...")
-		  (setq ffap-tex-path
-			(ffap-reduce-path
-			 (append
-			  (list ".")
-			  (ffap-list-env "TEXINPUTS")
-			  ;; (ffap-list-env "BIBINPUTS")
-			  (ffap-add-subdirs
-			   (ffap-list-env "TEXINPUTS_SUBDIR"
-					  (ffap-soft-value
-					   "TeX-macro-global"
-					   '("/usr/local/lib/tex/macros"
-					     "/usr/local/lib/tex/inputs")
-					   ))))))))
-	   (defun ffap-tex-mode (name)
-	     (ffap-tex-init)
-	     (locate-library name '(".tex" "") ffap-tex-path))))
-   (cons 'latex-mode
-	   (defun ffap-latex-mode (name)
-	     (ffap-tex-init)
-	     ;; Any real need for "" here?
-	     (locate-library name '(".cls" ".sty" ".tex" "")
-			     ffap-tex-path)))
-   (cons "\\.\\(tex\\|sty\\|doc\\|cls\\)\\'"
-	 (defun ffap-tex (name)
-	   (ffap-tex-init)
-	   (locate-library name t ffap-tex-path)))
-   (cons "\\.bib\\'"
-	 (defun ffap-bib (name)
-	   (locate-library
-	    name t
-	    (ffap-list-env "BIBINPUTS" '("/usr/local/lib/tex/macros/bib")))))
-   (cons 'math-mode
-	 (defun ffap-math-mode (name)
-	   (while (string-match "`" name)
-	     (setq name (concat (substring name 0 (match-beginning 0))
-				"/"
-				(substring name (match-end 0)))))
-	   (locate-library
-	    name '(".m" "") (ffap-soft-value "Mathematica-search-path"))))
-   (cons "\\`\\." (defun ffap-home (name) (locate-library name t '("~"))))
-   (cons "\\`~/"
-	 ;; Maybe a "Lisp Code Directory" reference:
-	 (defun ffap-lcd (name)
-	   (and
-	    (or
-	     ;; lisp-dir-apropos output buffer:
-	     (string-match "Lisp Code Dir" (buffer-name))
-	     ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
-	     ;; or maybe the holy LCD-Datafile itself:
-	     (member (ffap-string-around) '("||" "|\n")))
-	    (concat
-	     ;; lispdir.el may not be loaded yet:
-	     (ffap-host-to-path
-	      (ffap-soft-value "elisp-archive-host"
-			       "archive.cis.ohio-state.edu"))
-	     (file-name-as-directory
-	      (ffap-soft-value "elisp-archive-directory"
-			       "/pub/gnu/emacs/elisp-archive/"))
-	     (substring name 2)))))
-   (cons "^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $
-	 (progn
-	   (defvar ffap-rfc-path
-	     (concat (ffap-host-to-path "ds.internic.net") "/rfc/rfc%s.txt"))
-	   (defun ffap-rfc (name)
-	     (format ffap-rfc-path
-		     (substring name (match-beginning 1) (match-end 1))))))
-   (cons "\\`[^/]*\\'"
-	 (defun ffap-dired (name)
-	   (let ((pt (point)) dir try)
-	     (save-excursion
-	       (and (progn
-		      (beginning-of-line)
-		      (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] "))
-		    (re-search-backward "^ *$" nil t)
-		    (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t)
-		    (file-exists-p
-		     (setq try
-			   (expand-file-name
-			    name
-			    (buffer-substring
-			     (match-beginning 1) (match-end 1)))))
-		    try)))))
-   )
-  "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'.
-If string NAME at point (maybe \"\") is not a file or url, these pairs
-specify actions to try creating such a string.  A pair matches if either
-  KEY is a symbol, and it equals `major-mode', or
-  KEY is a string, it should matches NAME as a regexp.
-On a match, \(FUNCTION NAME\) is called and should return a file, an
-url, or nil. If nil, search the alist for further matches.")
-
-(put 'ffap-alist 'risky-local-variable t)
-
-
-;;; At-Point Functions:
-
-(defvar ffap-string-at-point-mode-alist
-  '(
-    ;; The default, used when the `major-mode' is not found.
-    ;; Slightly controversial decisions:
-    ;; * strip trailing "@" and ":"
-    ;; * no commas (good for latex)
-    (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")
-    ;; An url, or maybe a email/news message-id:
-    (url "--:?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")
-    ;; Find a string that does *not* contain a colon:
-    (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
-    ;; A machine:
-    (machine "-a-zA-Z0-9." "" ".")
-    ;; Mathematica paths: allow backquotes
-    (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:")
-    )
-  "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
-possibly a `major-mode' or some symbol internal to ffap
-\(such as 'file, 'url, 'machine, and 'nocolon\).
-`ffap-string-at-point' uses the data fields as follows:
-1. find a maximal string of CHARS around point,
-2. strip BEG chars before point from the beginning,
-3. Strip END chars after point from the end.")
-
-(defvar ffap-string-at-point-region '(1 1)
-  "List (BEG END), last region returned by `ffap-string-at-point'.")
-
-(defvar ffap-string-at-point nil
-  ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95.
-  "Last string returned by `ffap-string-at-point'.")
-
-(defun ffap-string-at-point (&optional mode)
-  "Return a string of characters from around point.
-MODE (defaults to `major-mode') is a symbol used to lookup string
-syntax parameters in `ffap-string-at-point-mode-alist'.
-If MODE is not found, we fall back on the symbol 'file.
-Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
-  (let* ((args
-	  (cdr
-	   (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
-	       (assq 'file ffap-string-at-point-mode-alist))))
-	 (pt (point))
-	 (str
-	  (buffer-substring
-	   (save-excursion
-	     (skip-chars-backward (car args))
-	     (skip-chars-forward (nth 1 args) pt)
-	     (setcar ffap-string-at-point-region (point)))
-	   (save-excursion
-	     (skip-chars-forward (car args))
-	     (skip-chars-backward (nth 2 args) pt)
-	     (setcar (cdr ffap-string-at-point-region) (point))))))
-    (or ffap-xemacs (set-text-properties 0 (length str) nil str))
-    (setq ffap-string-at-point str)))
-
-(defun ffap-string-around nil
-  ;; Sometimes useful to decide how to treat a string.
-  "Return string of two chars around last `ffap-string-at-point'.
-Assumes the buffer has not changed."
-  (save-excursion
-    (format "%c%c"
-	    (progn
-	      (goto-char (car ffap-string-at-point-region))
-	      (preceding-char))		; maybe 0
-	    (progn
-	      (goto-char (nth 1 ffap-string-at-point-region))
-	      (following-char))		; maybe 0
-	    )))
-
-(defun ffap-copy-string-as-kill (&optional mode)
-  ;; Requested by MCOOK.  Useful?
-  "Call `ffap-string-at-point', and copy result to `kill-ring'."
-  (interactive)
-  (let ((str (ffap-string-at-point mode)))
-    (if (equal "" str)
-	(message "No string found around point.")
-      (kill-new str)
-      ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region)
-      (message "Copied to kill ring: %s"  str))))
-
-(defun ffap-url-at-point nil
-  "Return url from around point if it exists, or nil."
-  ;; Could use w3's url-get-url-at-point instead.  Both handle "URL:",
-  ;; ignore non-relative links, trim punctuation.  The other will
-  ;; actually look back if point is in whitespace, but I would rather
-  ;; ffap be non-rabid in such situations.
-  (and
-   ffap-url-regexp
-   (or
-    ;; In a w3 buffer button zone?
-    (let (tem)
-      (and (eq major-mode 'w3-mode)
-	   ;; assume: (boundp 'w3-zone-at) (boundp 'w3-zone-data)
-	   (setq tem (w3-zone-at (point)))
-	   (consp (setq tem (w3-zone-data tem)))
-	   (nth 2 tem)))
-    ;; Is there a reason not to strip trailing colon?
-    (let ((name (ffap-string-at-point 'url)))
-      ;; (case-fold-search t), why?
-      (cond
-       ((string-match "^url:" name) (setq name (substring name 4)))
-       ((and (string-match "\\`[^:</>@]+@[^:</>@]+[a-zA-Z]\\'" name)
-	     ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
-	     ;; If not adorned with "<>", it must be "mailto".
-	     ;;	Otherwise could be either, so consult `ffap-foo-at-bar-prefix'.
-	     (let ((prefix (if (and (equal (ffap-string-around) "<>")
-				    ;; At least a couple of odd characters:
-				    (string-match "[$.0-9].*[$.0-9].*@" name))
-			       ;; Could be news:
-			       ffap-foo-at-bar-prefix
-			     "mailto")))
-	       (and prefix (setq name (concat prefix ":" name))))))
-       ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
-       ((and (string-match "\\`[a-z0-9]+\\'" name) ; <mic> <root> <nobody>
-	     (equal (ffap-string-around) "<>")
-	     ;;	(ffap-user-p name):
-	     (not (string-match "~" (expand-file-name (concat "~" name))))
-	     )
-	(setq name (concat "mailto:" name)))
-       )
-      (and (ffap-url-p name) name)
-      ))))
-
-(defvar ffap-gopher-regexp
-  "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$"
-  "Regexp Matching a line in a gopher bookmark (maybe indented).
-The two subexpressions are the KEY and VALUE.")
-
-(defun ffap-gopher-at-point nil
-  "If point is inside a gopher bookmark block, return its url."
-  ;; `gopher-parse-bookmark' from gopher.el is not so robust
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at ffap-gopher-regexp)
-	(progn
-	  (while (and (looking-at ffap-gopher-regexp) (not (bobp)))
-	    (forward-line -1))
-	  (or (looking-at ffap-gopher-regexp) (forward-line 1))
-	  (let ((type "1") name path host (port "70"))
-	    (while (looking-at ffap-gopher-regexp)
-	      (let ((var (intern
-			  (downcase
-			   (buffer-substring (match-beginning 1)
-					     (match-end 1)))))
-		    (val (buffer-substring (match-beginning 2)
-					   (match-end 2))))
-		(set var val)
-		(forward-line 1)))
-	    (if (and path (string-match "^ftp:.*@" path))
-		(concat "ftp://"
-			(substring path 4 (1- (match-end 0)))
-			(substring path (match-end 0)))
-	      (and (= (length type) 1)
-		   host;; (ffap-machine-p host)
-		   (concat "gopher://" host
-			   (if (equal port "70") "" (concat ":" port))
-			   "/" type path))))))))
-
-(defvar ffap-ftp-sans-slash-regexp
-  (and
-   ffap-ftp-regexp
-   ;; Note: by now, we know it is not an url.
-   ;; Icky regexp avoids: default: 123: foo::bar cs:pub
-   ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
-   "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
-  "Strings matching this are coerced to ftp paths by ffap.
-That is, ffap just prepends \"/\".  Set to nil to disable.")
-
-(defun ffap-file-at-point nil
-  "Return filename from around point if it exists, or nil.
-Existence test is skipped for names that look remote.
-If the filename is not obvious, it also tries `ffap-alist',
-which may actually result in an url rather than a filename."
-  ;; Note: this function does not need to look for url's, just
-  ;; filenames.  On the other hand, it is responsible for converting
-  ;; a pseudo-url "site.com://path" to an ftp path
-  (let* ((case-fold-search t)		; url prefixes are case-insensitive
-	 (data (match-data))
-	 (string (ffap-string-at-point)) ; uses mode alist
-	 (name
-	  (or (condition-case nil
-		  (and (not (string-match "//" string)) ; foo.com://bar
-		       (substitute-in-file-name string))
-		(error nil))
-	      string))
-	 (abs (file-name-absolute-p name))
-	 (default-directory default-directory))
-    (unwind-protect
-	(cond
-	 ;; Immediate rejects (/ and // are too common in C++):
-	 ((member name '("" "/" "//")) nil)
-	 ;; Immediately test local filenames.  If default-directory is
-	 ;; remote, you probably already have a connection.
-	 ((and (not abs) (ffap-file-exists-string name)))
-	 ;; Accept remote names without actual checking (too slow):
-	 ((if abs
-	      (ffap-file-remote-p name)
-	    ;; Try adding a leading "/" (common omission in ftp paths):
-	    (and
-	     ffap-ftp-sans-slash-regexp
-	     (string-match ffap-ftp-sans-slash-regexp name)
-	     (ffap-file-remote-p (concat "/" name)))))
-	 ;; Ok, not remote, try the existence test even if it is absolute:
-	 ((and abs (ffap-file-exists-string name)))
-	 ;; If it contains a colon, get rid of it (and return if exists)
-	 ((and (string-match path-separator name)
-	       (setq name (ffap-string-at-point 'nocolon))
-	       (ffap-file-exists-string name)))
-	 ;; File does not exist, try the alist:
-	 ((let ((alist ffap-alist) tem try case-fold-search)
-	    (while (and alist (not try))
-	      (setq tem (car alist) alist (cdr alist))
-	      (if (or (eq major-mode (car tem))
-		      (and (stringp (car tem))
-			   (string-match (car tem) name)))
-		  (and (setq try (funcall (cdr tem) name))
-		       (setq try (or
-				  (ffap-url-p try) ; not a file!
-				  (ffap-file-remote-p try)
-				  (ffap-file-exists-string try))))))
-	    try))
-	 ;; Alist failed?  Try to guess an active remote connection
-	 ;; from buffer variables, and try once more, both as an
-	 ;; absolute and relative path on that remote host.
-	 ((let* (ffap-rfs-regexp	; suppress
-		 (remote-dir
-		  (cond
-		   ((ffap-file-remote-p default-directory))
-		   ((and (eq major-mode 'internal-ange-ftp-mode)
-			 (string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$"
-				       (buffer-name)))
-		    (concat "/" (substring (buffer-name) 5 -1) ":"))
-		   ;; This is too often a bad idea:
-		   ;;((and (eq major-mode 'w3-mode)
-		   ;;	   (stringp url-current-server))
-		   ;; (host-to-ange-path url-current-server))
-		   )))
-	    (and remote-dir
-		 (or
-		  (and (string-match "\\`\\(/?~?ftp\\)/" name)
-		       (ffap-file-exists-string
-			(ffap-replace-path-component
-			 remote-dir (substring name (match-end 1)))))
-		  (ffap-file-exists-string
-		   (ffap-replace-path-component remote-dir name))))))
-	 )
-      (store-match-data data))))
-
-
-;;; ffap-read-file-or-url:
-;;
-;; We want to complete filenames as in read-file-name, but also url's
-;; which read-file-name-internal would truncate at the "//" string.
-;; The solution here is to replace read-file-name-internal with
-;; `ffap-read-file-or-url-internal', which checks the minibuffer
-;; contents before attempting to complete filenames.
-
-(defun ffap-read-file-or-url (prompt guess)
-  "Read file or url from minibuffer, with PROMPT and initial GUESS."
-  (or guess (setq guess default-directory))
-  (let (dir)
-    ;; Tricky: guess may have or be a local directory, like "w3/w3.elc"
-    ;; or "w3/" or "../el/ffap.el" or "../../../"
-    (or (ffap-url-p guess)
-	(progn
-	  (or (ffap-file-remote-p guess)
-	      (setq guess (abbreviate-file-name (expand-file-name guess))))
-	  (setq dir (file-name-directory guess))))
-    (setq guess
-	  (completing-read
-	   prompt
-	   'ffap-read-file-or-url-internal
-	   dir
-	   nil
-	   (if dir (cons guess (length dir)) guess)
-	   (list 'file-name-history)
-	   ))
-    ;; Do file substitution like (interactive "F"), suggested by MCOOK.
-    (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))
-    ;; Should not do it on url's, where $ is a common (VMS?) character.
-    ;; Note: upcoming url.el package ought to handle this automatically.
-    guess))
-
-(defun ffap-read-url-internal (string dir action)
-  "Complete url's from history, treating given string as valid."
-  (let ((hist (ffap-soft-value "url-global-history-hash-table")))
-    (cond
-     ((not action)
-      (or (try-completion string hist) string))
-     ((eq action t)
-      (or (all-completions string hist) (list string)))
-     ;; action == lambda, documented where?  Tests whether string is a
-     ;; valid "match".  Let us always say yes.
-     (t t))))
-
-(defun ffap-read-file-or-url-internal (string dir action)
-  (if (ffap-url-p string)
-      (ffap-read-url-internal string dir action)
-    (read-file-name-internal string dir action)))
-
-;; The rest of this page is just to work with package complete.el.
-;; This code assumes that you load ffap.el after complete.el.
-;;
-;; We must inform complete about whether our completion function
-;; will do filename style completion.  For earlier versions of
-;; complete.el, this requires a defadvice.  For recent versions
-;; there may be a special variable for this purpose.
-
-(defun ffap-complete-as-file-p nil
-  ;; Will `minibuffer-completion-table' complete the minibuffer
-  ;; contents as a filename?  Assumes the minibuffer is current.
-  ;; Note: t and non-nil mean somewhat different reasons.
-  (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
-      (not (ffap-url-p (buffer-string))) ; t
-    (memq minibuffer-completion-table
-	  '(read-file-name-internal read-directory-name-internal)) ; list
-    ))
-
-(and
- (featurep 'complete)
- (if (boundp 'PC-completion-as-file-name-predicate)
-     ;; modern version of complete.el, just set the variable:
-     (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)
-   (require 'advice)
-   (defadvice PC-do-completion (around ffap-fix act)
-     "Work with ffap."
-     (let ((minibuffer-completion-table
-	    (if (eq t (ffap-complete-as-file-p))
-		'read-file-name-internal
-	      minibuffer-completion-table)))
-       ad-do-it))))
-
-
-;;; Highlighting:
-;;
-;; Based on overlay highlighting in Emacs 19.28 isearch.el.
-
-(defvar ffap-highlight (and window-system t)
-  "If non-nil, ffap highlights the current buffer substring.")
-
-(defvar ffap-highlight-overlay nil "Overlay used by `ffap-highlight'.")
-
-(defun ffap-highlight (&optional remove)
-  "If `ffap-highlight' is set, highlight the guess in this buffer.
-That is, the last buffer substring found by `ffap-string-at-point'.
-Optional argument REMOVE means to remove any such highlighting.
-Uses the face `ffap' if it is defined, or else `highlight'."
-  (cond
-   (remove (and ffap-highlight-overlay (delete-overlay ffap-highlight-overlay)))
-   ((not ffap-highlight) nil)
-   (ffap-highlight-overlay
-    (move-overlay ffap-highlight-overlay
-		  (car ffap-string-at-point-region)
-		  (nth 1 ffap-string-at-point-region)
-		  (current-buffer)))
-   (t
-    (setq ffap-highlight-overlay (apply 'make-overlay ffap-string-at-point-region))
-    (overlay-put ffap-highlight-overlay 'face
-		 (if (internal-find-face 'ffap nil)
-		     'ffap 'highlight)))))
-
-
-;;; The big enchilada:
-
-(defun ffap-guesser nil
-  "Return file or url or nil, guessed from text around point."
-  (or (and ffap-url-regexp
-	   (ffap-fixup-url (or (ffap-url-at-point)
-			       (ffap-gopher-at-point))))
-      (ffap-file-at-point)		; may yield url!
-      (ffap-fixup-machine (ffap-machine-at-point))))
-
-(defun ffap-prompter (&optional guess)
-  ;; Does guess and prompt step for find-file-at-point.
-  ;; Extra complication for the temporary highlighting.
-  (unwind-protect
-      (ffap-read-file-or-url
-       (if ffap-url-regexp "Find file or URL: " "Find file: ")
-       (prog1
-	   (setq guess (or guess (ffap-guesser)))
-	 (and guess (ffap-highlight))
-	 ))
-    (ffap-highlight t)))
-
-;;;###autoload
-(defun find-file-at-point (&optional filename)
-  "Find FILENAME (or url), guessing default from text around point.
-If `ffap-dired-wildcards' is set, wildcard patterns are passed to dired.
-See also the functions `ffap-file-at-point', `ffap-url-at-point'.
-With a prefix, this command behaves *exactly* like `ffap-file-finder'.
-If `ffap-require-prefix' is set, the prefix meaning is reversed.
-
-See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
-  (interactive)
-  (if (and (interactive-p)
-	   (if ffap-require-prefix (not current-prefix-arg)
-	     current-prefix-arg))
-      ;; Do exactly the ffap-file-finder command, even the prompting:
-      (let (current-prefix-arg)		; we already interpreted it
-	(call-interactively ffap-file-finder))
-    (or filename (setq filename (ffap-prompter)))
-    (cond
-     ((ffap-url-p filename)
-      (let (current-prefix-arg)		; w3 2.3.25 bug, reported by KPC
-	(funcall ffap-url-fetcher filename)))
-     ;; This junk more properly belongs in a modified ffap-file-finder:
-     ((and ffap-dired-wildcards
-	   (string-match ffap-dired-wildcards filename))
-      (dired filename))
-     ((or (not ffap-newfile-prompt)
-	  (file-exists-p filename)
-	  (y-or-n-p "File does not exist, create buffer? "))
-      (funcall ffap-file-finder
-	       ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.
-	       (expand-file-name filename)))
-     ;; User does not want to find a non-existent file:
-     ((signal 'file-error (list "Opening file buffer"
-				"no such file or directory"
-				filename))))))
-
-;; M-x shortcut:
-;;###autoload
-(defalias 'ffap 'find-file-at-point)
-
-
-;;; Menu support:
-;;
-;; Bind ffap-menu to a key if you want, since it also works in tty mode.
-;; Or just use it through the ffap-at-mouse binding (next section).
-
-(defvar ffap-menu-regexp nil
-  "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'.
-Make this more restrictive for faster menu building.
-For example, try \":/\" for url (and some ftp) references.")
-
-(defvar ffap-menu-alist nil
-  "Buffer local cache of menu presented by `ffap-menu'.")
-(make-variable-buffer-local 'ffap-menu-alist)
-
-(defvar ffap-menu-text-plist
-  (and window-system
-       ;; These choices emulate goto-addr:
-       (if ffap-xemacs
-	   '(face bold highlight t) ; keymap <map>
-	 '(face bold mouse-face highlight) ; keymap <mousy-map>
-	 ))
-  "Text properties applied to strings found by `ffap-menu-rescan'.
-These properties may be used to fontify the menu references.")
-
-;;;###autoload
-(defun ffap-menu (&optional rescan)
-  "Put up a menu of files and urls mentioned in this buffer.
-Then set mark, jump to choice, and try to fetch it.  The menu is
-cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'.
-The optional RESCAN argument \(a prefix, interactively\) forces
-a rebuild.  Searches with `ffap-menu-regexp'."
-  (interactive "P")
-  ;; (require 'imenu) -- no longer used, but roughly emulated
-  (if (or (not ffap-menu-alist) rescan
-	  ;; or if the first entry is wrong:
-	  (and ffap-menu-alist
-	       (let ((first (car ffap-menu-alist)))
-		 (save-excursion
-		   (goto-char (cdr first))
-		   (not (equal (car first) (ffap-guesser)))))))
-      (ffap-menu-rescan))
-  ;; Tail recursive:
-  (ffap-menu-ask
-   (if ffap-url-regexp "Find file or URL" "Find file")
-   (cons (cons "*Rescan Buffer*" -1) ffap-menu-alist)
-   'ffap-menu-cont))
-
-(defun ffap-menu-cont (choice)		; continuation of ffap-menu
-  (if (< (cdr choice) 0)
-      (ffap-menu t)			; *Rescan*
-    (push-mark)
-    (goto-char (cdr choice))
-    ;; Momentary highlight:
-    (unwind-protect
-	(progn
-	  (and ffap-highlight (ffap-guesser) (ffap-highlight))
-	  (sit-for 0)			; display
-	  (find-file-at-point (car choice)))
-      (ffap-highlight t))))
-
-(defun ffap-menu-ask (title alist cont)
-  "Prompt from a menu of choices, and then apply some action.
-Arguments are TITLE, ALIST, and CONT (a continuation).
-This uses either a menu or the minibuffer depending on invocation.
-The TITLE string is used as either the prompt or menu title.
-Each \(string . data\) ALIST entry defines a choice \(data is ignored\).
-Once the user makes a choice, function CONT is applied to the entry.
-Always returns nil."
-  ;; Bug: minibuffer prompting assumes the strings are unique.
-  (let ((choice
-	 (if (and (fboundp 'x-popup-menu) ; Emacs 19 or XEmacs 19.13
-		  (boundp 'last-nonmenu-event) ; not in XEmacs 19.13
-		  (listp last-nonmenu-event))
-	     (x-popup-menu
-	      t
-	      (list ""
-		    (cons title
-			  (mapcar
-			   (function (lambda (i) (cons (car i) i)))
-			   alist))))
-	   ;; Immediately popup completion buffer:
-	   (prog1
-	       (let ((minibuffer-setup-hook 'minibuffer-completion-help))
-		 ;; BUG: this code assumes that "" is not a valid choice
-		 (completing-read
-		  (format "%s (default %s): " title (car (car alist)))
-		  alist nil t
-		  ;; (cons (car (car alist)) 0)
-		  nil
-		  ))
-	     ;; Redraw original screen:
-	     (sit-for 0)))))
-    ;; Defaulting: convert "" to (car (car alist))
-    (and (equal choice "") (setq choice (car (car alist))))
-    (and (stringp choice) (setq choice (assoc choice alist)))
-    (if choice (funcall cont choice) (message "No choice made!")))
-  nil)					; return nothing
-
-(defun ffap-menu-rescan nil
-  "Search buffer for `ffap-menu-regexp' to build `ffap-menu-alist'.
-Applies `ffap-menu-text-plist' text properties at all matches."
-  (interactive)
-  (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp))
-	(range (- (point-max) (point-min))) item
-	buffer-read-only		; to set text-properties
-	;; Avoid repeated searches of the *mode-alist:
-	(major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
-			major-mode
-		      'file))
-	)
-    (setq ffap-menu-alist nil)
-    (save-excursion
-      (goto-char (point-min))
-      (while (setq item (ffap-next-guess))
-	(setq ffap-menu-alist (cons (cons item (point)) ffap-menu-alist))
-	(add-text-properties (car ffap-string-at-point-region) (point)
-			     ffap-menu-text-plist)
-	(message "Scanning...%2d%% <%s>"
-		 (/ (* 100 (- (point) (point-min))) range) item))))
-  (message "Scanning...done")
-  ;; Remove duplicates.
-  (setq ffap-menu-alist			; sort by item
-	(sort ffap-menu-alist
-	      (function
-	       (lambda (a b) (string-lessp (car a) (car b))))))
-  (let ((ptr ffap-menu-alist))
-    (while (cdr ptr)
-      (if (equal (car (car ptr)) (car (car (cdr ptr))))
-	  (setcdr ptr (cdr (cdr ptr)))
-	(setq ptr (cdr ptr)))))
-  (setq ffap-menu-alist			; sort by position
-	(sort ffap-menu-alist
-	      (function
-	       (lambda (a b) (< (cdr a) (cdr b)))))))
-
-
-;;; Mouse Support:
-;;
-;; See the suggested binding in ffap-bindings (near eof).
-
-(defvar ffap-at-mouse-fallback 'ffap-menu
-  "Invoked by `ffap-at-mouse' if no file or url at click.
-A command symbol, or nil for nothing.")
-(put 'ffap-at-mouse-fallback 'risky-local-variable t)
-
-(defun ffap-at-mouse (e)
-  "Find file or url guessed from text around mouse point.
-If none is found, call `ffap-at-mouse-fallback'."
-  (interactive "e")
-  (let ((guess
-	 ;; Maybe less surprising without the save-excursion?
-	 (save-excursion
-	   (mouse-set-point e)
-	   ;; Would like to do nothing unless click was *on* text.  How?
-	   ;; (cdr (posn-col-row (event-start e))) is always same as
-	   ;; current column.  For posn-x-y, need pixel-width!
-	   (ffap-guesser))))
-    (cond
-     (guess
-      (ffap-highlight)
-      (unwind-protect
-	  (progn
-	    (sit-for 0)			; display
-	    (message "Guessing `%s'" guess)
-	    (find-file-at-point guess))
-	(ffap-highlight t)))
-     ((and (interactive-p)
-	   ffap-at-mouse-fallback)
-      (call-interactively ffap-at-mouse-fallback))
-     ((message "No file or URL found at mouse click.")))))
-
-
-;;; ffap-other-* commands
-;; Suggested by KPC.
-
-(defun ffap-other-window nil
-  "Like `ffap', but put buffer in another window."
-  (interactive)
-  (switch-to-buffer-other-window
-   (save-window-excursion (call-interactively 'ffap) (current-buffer))))
-
-(defun ffap-other-frame nil
-  "Like `ffap', but put buffer in another frame."
-  (interactive)
-  (switch-to-buffer-other-frame
-   (save-window-excursion (call-interactively 'ffap) (current-buffer))))
-
-
-;;; Bug Reporter:
-
-(defun ffap-bug nil
-  "Submit a bug report for the ffap package."
-  ;; Important: keep the version string here in synch with that at top
-  ;; of file!  Could use lisp-mnt from Emacs 19, but that would depend
-  ;; on being able to find the ffap.el source file.
-  (interactive)
-  (require 'reporter)
-  (let ((reporter-prompt-for-summary-p t))
-    (reporter-submit-bug-report
-     "Michelangelo Grigni <mic@mathcs.emory.edu>"
-     "ffap 1.6"
-     (mapcar 'intern (all-completions "ffap-" obarray 'boundp)))))
-
-(fset 'ffap-submit-bug 'ffap-bug)	; another likely name
-
-
-;;; Hooks for Gnus, VM, Rmail:
-;;
-;; If you do not like these bindings, write versions with whatever
-;; bindings you would prefer.
-
-(defun ffap-ro-mode-hook nil
-  "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp."
-  (local-set-key "\M-l" 'ffap-next)
-  (local-set-key "\M-m" 'ffap-menu)
-  )
-
-(defun ffap-gnus-hook nil
-  "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
-  (set (make-local-variable 'ffap-foo-at-bar-prefix) "news") ; message-id's
-  ;; Note "l", "L", "m", "M" are taken:
-  (local-set-key "\M-l" 'ffap-gnus-next)
-  (local-set-key "\M-m" 'ffap-gnus-menu))
-
-(defun ffap-gnus-wrapper (form)		; used by both commands below
-  (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
-       (gnus-summary-select-article))	; get article of current line
-  ;; Preserve selected buffer, but do not do save-window-excursion,
-  ;; since we want to see any window created by the form.  Temporarily
-  ;; select the article buffer, so we can see any point movement.
-  (let ((sb (window-buffer (selected-window))))
-    (gnus-configure-windows 'article)
-    (pop-to-buffer gnus-article-buffer)
-    (widen)
-    ;; Skip headers for ffap-gnus-next (which will wrap around)
-    (if (eq (point) (point-min)) (search-forward "\n\n" nil t))
-    (unwind-protect
-	(eval form)
-      (pop-to-buffer sb))))
-
-(defun ffap-gnus-next nil
-  "Run `ffap-next' in the gnus article buffer."
-  (interactive) (ffap-gnus-wrapper '(ffap-next nil t)))
-
-(defun ffap-gnus-menu nil
-  "Run `ffap-menu' in the gnus article buffer."
-  (interactive) (ffap-gnus-wrapper '(ffap-menu)))
-
-
-;;; ffap-bindings: offer default global bindings
-
-(defvar ffap-bindings
-  (nconc
-   (cond
-    ((not (eq window-system 'x))
-     nil)
-    ;; GNU coding standards say packages should not bind S-mouse-*.
-    ;; Is it ok to simply suggest such a binding to the user?
-    (ffap-xemacs
-     '((global-set-key '(shift button3) 'ffap-at-mouse)))
-    (t
-     '((global-set-key [S-down-mouse-3] 'ffap-at-mouse))))
-   '(
-     (global-set-key "\C-x\C-f" 'find-file-at-point)
-     (global-set-key "\C-x4f"   'ffap-other-window)
-     (global-set-key "\C-x5f"   'ffap-other-frame)
-     (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
-     (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
-     (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
-     (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
-     ;; (setq dired-x-hands-off-my-keys t) ; the default
-     ))
-  "List of forms evaluated by function `ffap-bindings'.
-A reasonable ffap installation needs just these two lines:
-  (require 'ffap)
-  (ffap-bindings)
-These are only suggestions, they may be modified or ignored.")
-
-(defun ffap-bindings nil
-  "Evaluate the forms in variable `ffap-bindings'."
-  (eval (cons 'progn ffap-bindings)))
-
-;; Example modifications:
-;;
-;; (setq ffap-alist                   ; remove a feature in `ffap-alist'
-;;	 (delete (assoc 'c-mode ffap-alist) ffap-alist))
-;;
-;; (setq ffap-alist                   ; add something to `ffap-alist'
-;;	 (cons
-;;	  (cons "^[Yy][Ss][Nn][0-9]+$"
-;;		(defun ffap-ysn (name)
-;;		  (concat
-;;		   "http://snorri.chem.washington.edu/ysnarchive/issuefiles/"
-;;		   (substring name 3) ".html")))
-;;	  ffap-alist))
-
-
-;;; XEmacs:
-;; Extended suppport in another file, for copyright reasons.
-(or (not ffap-xemacs)
-    (load "ffap-xe" t t)
-    (message "ffap warning: ffap-xe.el not found"))
-
-
-;;; ffap.el ends here
diff --git a/lisp/files.el b/lisp/files.el
deleted file mode 100644
index 3d605384344..00000000000
--- a/lisp/files.el
+++ /dev/null
@@ -1,2863 +0,0 @@
-;;; files.el --- file input and output commands for Emacs
-
-;; Copyright (C) 1985, 86, 87, 92, 93,
-;;		 94, 95, 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:
-
-;; Defines most of Emacs's file- and directory-handling functions,
-;; including basic file visiting, backup generation, link handling,
-;; ITS-id version control, load- and write-hook handling, and the like.
-
-;;; Code:
-
-(defvar delete-auto-save-files t
-  "*Non-nil means delete auto-save file when a buffer is saved or killed.")
-
-(defvar directory-abbrev-alist
-  nil
-  "*Alist of abbreviations for file directories.
-A list of elements of the form (FROM . TO), each meaning to replace
-FROM with TO when it appears in a directory name.  This replacement is
-done when setting up the default directory of a newly visited file.
-*Every* FROM string should start with `^'.
-
-Do not use `~' in the TO strings.
-They should be ordinary absolute directory names.
-
-Use this feature when you have directories which you normally refer to
-via absolute symbolic links.  Make TO the name of the link, and FROM
-the name it is linked to.")
-
-;;; Turn off backup files on VMS since it has version numbers.
-(defvar make-backup-files (not (eq system-type 'vax-vms))
-  "*Non-nil means make a backup of a file the first time it is saved.
-This can be done by renaming the file or by copying.
-
-Renaming means that Emacs renames the existing file so that it is a
-backup file, then writes the buffer into a new file.  Any other names
-that the old file had will now refer to the backup file.  The new file
-is owned by you and its group is defaulted.
-
-Copying means that Emacs copies the existing file into the backup
-file, then writes the buffer on top of the existing file.  Any other
-names that the old file had will now refer to the new (edited) file.
-The file's owner and group are unchanged.
-
-The choice of renaming or copying is controlled by the variables
-`backup-by-copying', `backup-by-copying-when-linked' and
-`backup-by-copying-when-mismatch'.  See also `backup-inhibited'.")
-
-;; Do this so that local variables based on the file name
-;; are not overridden by the major mode.
-(defvar backup-inhibited nil
-  "Non-nil means don't make a backup, regardless of the other parameters.
-This variable is intended for use by making it local to a buffer.
-But it is local only if you make it local.")
-(put 'backup-inhibited 'permanent-local t)
-
-(defvar backup-by-copying nil
- "*Non-nil means always use copying to create backup files.
-See documentation of variable `make-backup-files'.")
-
-(defvar backup-by-copying-when-linked nil
- "*Non-nil means use copying to create backups for files with multiple names.
-This causes the alternate names to refer to the latest version as edited.
-This variable is relevant only if `backup-by-copying' is nil.")
-
-(defvar backup-by-copying-when-mismatch nil
-  "*Non-nil means create backups by copying if this preserves owner or group.
-Renaming may still be used (subject to control of other variables)
-when it would not result in changing the owner or group of the file;
-that is, for files which are owned by you and whose group matches
-the default for a new file created there by you.
-This variable is relevant only if `backup-by-copying' is nil.")
-
-(defvar backup-enable-predicate
-  '(lambda (name)
-     (or (< (length name) 5)
-	 (not (string-equal "/tmp/" (substring name 0 5)))))
-  "Predicate that looks at a file name and decides whether to make backups.
-Called with an absolute file name as argument, it returns t to enable backup.")
-
-(defvar buffer-offer-save nil
-  "*Non-nil in a buffer means offer to save the buffer on exit
-even if the buffer is not visiting a file.
-Automatically local in all buffers.")
-(make-variable-buffer-local 'buffer-offer-save)
-
-(defvar find-file-existing-other-name t
-  "*Non-nil means find a file under alternative names, in existing buffers.
-This means if any existing buffer is visiting the file you want
-under another name, you get the existing buffer instead of a new buffer.")
-
-(defvar find-file-visit-truename nil
-  "*Non-nil means visit a file under its truename.
-The truename of a file is found by chasing all links
-both at the file level and at the levels of the containing directories.")
-
-(defvar find-file-revert-without-query
-  nil
-  "*Specify which files should be reverted without query.
-The value is a list of regular expressions.
-If the file name matches one of these regular expressions,
-then `find-file' reverts the file without querying
-if the file has changed on disk and you have not edited the buffer.")
-
-(defvar buffer-file-number nil
-  "The device number and file number of the file visited in the current buffer.
-The value is a list of the form (FILENUM DEVNUM).
-This pair of numbers uniquely identifies the file.
-If the buffer is visiting a new file, the value is nil.")
-(make-variable-buffer-local 'buffer-file-number)
-(put 'buffer-file-number 'permanent-local t)
-
-(defvar buffer-file-numbers-unique (not (memq system-type '(windows-nt)))
-  "Non-nil means that buffer-file-number uniquely identifies files.")
-
-(defvar file-precious-flag nil
-  "*Non-nil means protect against I/O errors while saving files.
-Some modes set this non-nil in particular buffers.
-
-This feature works by writing the new contents into a temporary file
-and then renaming the temporary file to replace the original.
-In this way, any I/O error in writing leaves the original untouched,
-and there is never any instant where the file is nonexistent.
-
-Note that this feature forces backups to be made by copying.
-Yet, at the same time, saving a precious file
-breaks any hard links between it and other files.")
-
-(defvar version-control nil
-  "*Control use of version numbers for backup files.
-t means make numeric backup versions unconditionally.
-nil means make them for files that have some already.
-`never' means do not make them.")
-
-(defvar dired-kept-versions 2
-  "*When cleaning directory, number of versions to keep.")
-
-(defvar delete-old-versions nil
-  "*If t, delete excess backup versions silently.
-If nil, ask confirmation.  Any other value prevents any trimming.")
-
-(defvar kept-old-versions 2
-  "*Number of oldest versions to keep when a new numbered backup is made.")
-
-(defvar kept-new-versions 2
-  "*Number of newest versions to keep when a new numbered backup is made.
-Includes the new backup.  Must be > 0")
-
-(defvar require-final-newline nil
-  "*Value of t says silently ensure a file ends in a newline when it is saved.
-Non-nil but not t says ask user whether to add a newline when there isn't one.
-nil means don't add newlines.")
-
-(defvar auto-save-default t
-  "*Non-nil says by default do auto-saving of every file-visiting buffer.")
-
-(defvar auto-save-visited-file-name nil
-  "*Non-nil says auto-save a buffer in the file it is visiting, when practical.
-Normally auto-save files are written under other names.")
-
-(defvar save-abbrevs nil
-  "*Non-nil means save word abbrevs too when files are saved.
-Loading an abbrev file sets this to t.")
-
-(defvar find-file-run-dired t
-  "*Non-nil says run dired if `find-file' is given the name of a directory.")
-
-;;;It is not useful to make this a local variable.
-;;;(put 'find-file-not-found-hooks 'permanent-local t)
-(defvar find-file-not-found-hooks nil
-  "List of functions to be called for `find-file' on nonexistent file.
-These functions are called as soon as the error is detected.
-`buffer-file-name' is already set up.
-The functions are called in the order given until one of them returns non-nil.")
-
-;;;It is not useful to make this a local variable.
-;;;(put 'find-file-hooks 'permanent-local t)
-(defvar find-file-hooks nil
-  "List of functions to be called after a buffer is loaded from a file.
-The buffer's local variables (if any) will have been processed before the
-functions are called.")
-
-(defvar write-file-hooks nil
-  "List of functions to be called before writing out a buffer to a file.
-If one of them returns non-nil, the file is considered already written
-and the rest are not called.
-These hooks are considered to pertain to the visited file.
-So this list is cleared if you change the visited file name.
-
-Don't make this variable buffer-local; instead, use `local-write-file-hooks'.
-See also `write-contents-hooks'.")
-;;; However, in case someone does make it local...
-(put 'write-file-hooks 'permanent-local t)
-
-(defvar local-write-file-hooks nil
-  "Just like `write-file-hooks', except intended for per-buffer use.
-The functions in this list are called before the ones in
-`write-file-hooks'.
-
-This variable is meant to be used for hooks that have to do with a
-particular visited file.  Therefore, it is a permanent local, so that
-changing the major mode does not clear it.  However, calling
-`set-visited-file-name' does clear it.")
-(make-variable-buffer-local 'local-write-file-hooks)
-(put 'local-write-file-hooks 'permanent-local t)
-
-(defvar write-contents-hooks nil
-  "List of functions to be called before writing out a buffer to a file.
-If one of them returns non-nil, the file is considered already written
-and the rest are not called.
-
-This variable is meant to be used for hooks that pertain to the
-buffer's contents, not to the particular visited file; thus,
-`set-visited-file-name' does not clear this variable; but changing the
-major mode does clear it.
-
-This variable automatically becomes buffer-local whenever it is set.
-If you use `add-hook' to add elements to the list, use nil for the
-LOCAL argument.
-
-See also `write-file-hooks'.")
-(make-variable-buffer-local 'write-contents-hooks)
-
-(defvar enable-local-variables t
-  "*Control use of local variables in files you visit.
-The value can be t, nil or something else.
-A value of t means file local variables specifications are obeyed;
-nil means they are ignored; anything else means query.
-
-The command \\[normal-mode] always obeys file local variable
-specifications and ignores this variable.")
-
-(defvar enable-local-eval 'maybe
-  "*Control processing of the \"variable\" `eval' in a file's local variables.
-The value can be t, nil or something else.
-A value of t means obey `eval' variables;
-nil means ignore them; anything else means query.
-
-The command \\[normal-mode] always obeys local-variables lists
-and ignores this variable.")
-
-;; Avoid losing in versions where CLASH_DETECTION is disabled.
-(or (fboundp 'lock-buffer)
-    (defalias 'lock-buffer 'ignore))
-(or (fboundp 'unlock-buffer)
-    (defalias 'unlock-buffer 'ignore))
-(or (fboundp 'file-locked-p)
-    (defalias 'file-locked-p 'ignore))
-
-;; This hook function provides support for ange-ftp host name
-;; completion.  It runs the usual ange-ftp hook, but only for
-;; completion operations.  Having this here avoids the need
-;; to load ange-ftp when it's not really in use.
-(defun ange-ftp-completion-hook-function (op &rest args)
-  (if (memq op '(file-name-completion file-name-all-completions))
-      (apply 'ange-ftp-hook-function op args)
-    (let ((inhibit-file-name-handlers
-	   (cons 'ange-ftp-completion-hook-function
-		 (and (eq inhibit-file-name-operation op)
-		      inhibit-file-name-handlers)))
-	  (inhibit-file-name-operation op))
-      (apply op args))))
-
-(defun convert-standard-filename (filename)
-  "Convert a standard file's name to something suitable for the current OS.
-This function's standard definition is trivial; it just returns the argument.
-However, on some systems, the function is redefined
-with a definition that really does change some file names."
-  filename)
-
-(defun pwd ()
-  "Show the current default directory."
-  (interactive nil)
-  (message "Directory %s" default-directory))
-
-(defvar cd-path nil
-  "Value of the CDPATH environment variable, as a list.
-Not actually set up until the first time you you use it.")
-
-(defvar path-separator ":"
-  "Character used to separate concatenated paths.")
-
-(defun parse-colon-path (cd-path)
-  "Explode a colon-separated list of paths into a string list."
-  (and cd-path
-       (let (cd-prefix cd-list (cd-start 0) cd-colon)
-	 (setq cd-path (concat cd-path path-separator))
-	 (while (setq cd-colon (string-match path-separator cd-path cd-start))
-	   (setq cd-list
-		 (nconc cd-list
-			(list (if (= cd-start cd-colon)
-				   nil
-				(substitute-in-file-name
-				 (file-name-as-directory
-				  (substring cd-path cd-start cd-colon)))))))
-	   (setq cd-start (+ cd-colon 1)))
-	 cd-list)))
-
-(defun cd-absolute (dir)
-  "Change current directory to given absolute file name DIR."
-  ;; Put the name into directory syntax now,
-  ;; because otherwise expand-file-name may give some bad results.
-  (if (not (eq system-type 'vax-vms))
-      (setq dir (file-name-as-directory dir)))
-  (setq dir (abbreviate-file-name (expand-file-name dir)))
-  (if (not (file-directory-p dir))
-      (error "%s is not a directory" dir)
-    (if (file-executable-p dir)
-	(setq default-directory dir)
-      (error "Cannot cd to %s:  Permission denied" dir))))
-
-(defun cd (dir)
-  "Make DIR become the current buffer's default directory.
-If your environment includes a `CDPATH' variable, try each one of that
-colon-separated list of directories when resolving a relative directory name."
-  (interactive
-   (list (read-file-name "Change default directory: "
-			 default-directory default-directory
-			 (and (member cd-path '(nil ("./")))
-			      (null (getenv "CDPATH"))))))
-  (if (file-name-absolute-p dir)
-      (cd-absolute (expand-file-name dir))
-    (if (null cd-path)
-	(let ((trypath (parse-colon-path (getenv "CDPATH"))))
-	  (setq cd-path (or trypath (list "./")))))
-    (if (not (catch 'found
-	       (mapcar
-		(function (lambda (x)
-			    (let ((f (expand-file-name (concat x dir))))
-			      (if (file-directory-p f)
-				  (progn
-				    (cd-absolute f)
-				    (throw 'found t))))))
-		cd-path)
-	       nil))
-	(error "No such directory found via CDPATH environment variable"))))
-
-(defun load-file (file)
-  "Load the Lisp file named FILE."
-  (interactive "fLoad file: ")
-  (load (expand-file-name file) nil nil t))
-
-(defun load-library (library)
-  "Load the library named LIBRARY.
-This is an interface to the function `load'."
-  (interactive "sLoad library: ")
-  (load library))
-
-(defun file-local-copy (file &optional buffer)
-  "Copy the file FILE into a temporary file on this machine.
-Returns the name of the local copy, or nil, if FILE is directly
-accessible."
-  (let ((handler (find-file-name-handler file 'file-local-copy)))
-    (if handler
-	(funcall handler 'file-local-copy file)
-      nil)))
-
-(defun file-truename (filename &optional counter prev-dirs)
-  "Return the truename of FILENAME, which should be absolute.
-The truename of a file name is found by chasing symbolic links
-both at the level of the file and at the level of the directories
-containing it, until no links are left at any level.
-
-The arguments COUNTER and PREV-DIRS are used only in recursive calls.
-Do not specify them in other calls."
-  ;; COUNTER can be a cons cell whose car is the count of how many more links
-  ;; to chase before getting an error.
-  ;; PREV-DIRS can be a cons cell whose car is an alist
-  ;; of truenames we've just recently computed.
-
-  ;; The last test looks dubious, maybe `+' is meant here?  --simon.
-  (if (or (string= filename "") (string= filename "~")
-	  (and (string= (substring filename 0 1) "~")
-	       (string-match "~[^/]*" filename)))
-      (progn
-	(setq filename (expand-file-name filename))
-	(if (string= filename "")
-	    (setq filename "/"))))
-  (or counter (setq counter (list 100)))
-  (let (done
-	;; For speed, remove the ange-ftp completion handler from the list.
-	;; We know it's not needed here.
-	;; For even more speed, do this only on the outermost call.
-	(file-name-handler-alist
-	 (if prev-dirs file-name-handler-alist
-	   (let ((tem (copy-sequence file-name-handler-alist)))
-	     (delq (rassq 'ange-ftp-completion-hook-function tem) tem)))))
-    (or prev-dirs (setq prev-dirs (list nil)))
-    ;; If this file directly leads to a link, process that iteratively
-    ;; so that we don't use lots of stack.
-    (while (not done)
-      (setcar counter (1- (car counter)))
-      (if (< (car counter) 0)
-	  (error "Apparent cycle of symbolic links for %s" filename))
-      (let ((handler (find-file-name-handler filename 'file-truename)))
-	;; For file name that has a special handler, call handler.
-	;; This is so that ange-ftp can save time by doing a no-op.
-	(if handler
-	    (setq filename (funcall handler 'file-truename filename)
-		  done t)
-	  (let ((dir (or (file-name-directory filename) default-directory))
-		target dirfile)
-	    ;; Get the truename of the directory.
-	    (setq dirfile (directory-file-name dir))
-	    ;; If these are equal, we have the (or a) root directory.
-	    (or (string= dir dirfile)
-		;; If this is the same dir we last got the truename for,
-		;; save time--don't recalculate.
-		(if (assoc dir (car prev-dirs))
-		    (setq dir (cdr (assoc dir (car prev-dirs))))
-		  (let ((old dir)
-			(new (file-name-as-directory (file-truename dirfile counter prev-dirs))))
-		    (setcar prev-dirs (cons (cons old new) (car prev-dirs)))
-		    (setq dir new))))
-	    (if (equal ".." (file-name-nondirectory filename))
-		(setq filename
-		      (directory-file-name (file-name-directory (directory-file-name dir)))
-		      done t)
-	      (if (equal "." (file-name-nondirectory filename))
-		  (setq filename (directory-file-name dir)
-			done t)
-		;; Put it back on the file name.
-		(setq filename (concat dir (file-name-nondirectory filename)))
-		;; Is the file name the name of a link?
-		(setq target (file-symlink-p filename))
-		(if target
-		    ;; Yes => chase that link, then start all over
-		    ;; since the link may point to a directory name that uses links.
-		    ;; We can't safely use expand-file-name here
-		    ;; since target might look like foo/../bar where foo
-		    ;; is itself a link.  Instead, we handle . and .. above.
-		    (setq filename
-			  (if (file-name-absolute-p target)
-			      target
-			    (concat dir target))
-			  done nil)
-		  ;; No, we are done!
-		  (setq done t))))))))
-    filename))
-
-(defun file-chase-links (filename)
-  "Chase links in FILENAME until a name that is not a link.
-Does not examine containing directories for links,
-unlike `file-truename'."
-  (let (tem (count 100) (newname filename))
-    (while (setq tem (file-symlink-p newname))
-      (if (= count 0)
-	  (error "Apparent cycle of symbolic links for %s" filename))
-      ;; In the context of a link, `//' doesn't mean what Emacs thinks.
-      (while (string-match "//+" tem)
-	(setq tem (concat (substring tem 0 (1+ (match-beginning 0)))
-			  (substring tem (match-end 0)))))
-      ;; Handle `..' by hand, since it needs to work in the
-      ;; target of any directory symlink.
-      ;; This code is not quite complete; it does not handle
-      ;; embedded .. in some cases such as ./../foo and foo/bar/../../../lose.
-      (while (string-match "\\`\\.\\./" tem)
-	(setq tem (substring tem 3))
-	(setq newname (file-name-as-directory
-		       ;; Do the .. by hand.
-		       (directory-file-name
-			(file-name-directory
-			 ;; Chase links in the default dir of the symlink.
-			 (file-chase-links
-			  (directory-file-name
-			   (file-name-directory newname))))))))
-      (setq newname (expand-file-name tem (file-name-directory newname)))
-      (setq count (1- count)))
-    newname))
-
-(defun switch-to-buffer-other-window (buffer &optional norecord)
-  "Select buffer BUFFER in another window.
-Optional second arg NORECORD non-nil means
-do not put this buffer at the front of the list of recently selected ones."
-  (interactive "BSwitch to buffer in other window: ")
-  (let ((pop-up-windows t))
-    (pop-to-buffer buffer t norecord)))
-
-(defun switch-to-buffer-other-frame (buffer &optional norecord)
-  "Switch to buffer BUFFER in another frame.
-Optional second arg NORECORD non-nil means
-do not put this buffer at the front of the list of recently selected ones."
-  (interactive "BSwitch to buffer in other frame: ")
-  (let ((pop-up-frames t))
-    (pop-to-buffer buffer t norecord)
-    (raise-frame (window-frame (selected-window)))))
-
-(defun find-file (filename)
-  "Edit file FILENAME.
-Switch to a buffer visiting file FILENAME,
-creating one if none already exists."
-  (interactive "FFind file: ")
-  (switch-to-buffer (find-file-noselect filename)))
-
-(defun find-file-other-window (filename)
-  "Edit file FILENAME, in another window.
-May create a new window, or reuse an existing one.
-See the function `display-buffer'."
-  (interactive "FFind file in other window: ")
-  (switch-to-buffer-other-window (find-file-noselect filename)))
-
-(defun find-file-other-frame (filename)
-  "Edit file FILENAME, in another frame.
-May create a new frame, or reuse an existing one.
-See the function `display-buffer'."
-  (interactive "FFind file in other frame: ")
-  (switch-to-buffer-other-frame (find-file-noselect filename)))
-
-(defun find-file-read-only (filename)
-  "Edit file FILENAME but don't allow changes.
-Like \\[find-file] but marks buffer as read-only.
-Use \\[toggle-read-only] to permit editing."
-  (interactive "fFind file read-only: ")
-  (find-file filename)
-  (setq buffer-read-only t)
-  (current-buffer))
-
-(defun find-file-read-only-other-window (filename)
-  "Edit file FILENAME in another window but don't allow changes.
-Like \\[find-file-other-window] but marks buffer as read-only.
-Use \\[toggle-read-only] to permit editing."
-  (interactive "fFind file read-only other window: ")
-  (find-file-other-window filename)
-  (setq buffer-read-only t)
-  (current-buffer))
-
-(defun find-file-read-only-other-frame (filename)
-  "Edit file FILENAME in another frame but don't allow changes.
-Like \\[find-file-other-frame] but marks buffer as read-only.
-Use \\[toggle-read-only] to permit editing."
-  (interactive "fFind file read-only other frame: ")
-  (find-file-other-frame filename)
-  (setq buffer-read-only t)
-  (current-buffer))
-
-(defun find-alternate-file-other-window (filename)
-  "Find file FILENAME as a replacement for the file in the next window.
-This command does not select that window."
-  (interactive
-   (save-selected-window
-     (other-window 1)
-     (let ((file buffer-file-name)
-	   (file-name nil)
-	   (file-dir nil))
-       (and file
-	    (setq file-name (file-name-nondirectory file)
-		  file-dir (file-name-directory file)))
-       (list (read-file-name
-	      "Find alternate file: " file-dir nil nil file-name)))))
-  (if (one-window-p)
-      (find-file-other-window filename)
-    (save-selected-window
-      (other-window 1)
-      (find-alternate-file filename))))
-
-(defun find-alternate-file (filename)
-  "Find file FILENAME, select its buffer, kill previous buffer.
-If the current buffer now contains an empty file that you just visited
-\(presumably by mistake), use this command to visit the file you really want."
-  (interactive
-   (let ((file buffer-file-name)
-	 (file-name nil)
-	 (file-dir nil))
-     (and file
-	  (setq file-name (file-name-nondirectory file)
-		file-dir (file-name-directory file)))
-     (list (read-file-name
-	    "Find alternate file: " file-dir nil nil file-name))))
-  (and (buffer-modified-p) (buffer-file-name)
-       ;; (not buffer-read-only)
-       (not (yes-or-no-p (format "Buffer %s is modified; kill anyway? "
-				 (buffer-name))))
-       (error "Aborted"))
-  (let ((obuf (current-buffer))
-	(ofile buffer-file-name)
-	(onum buffer-file-number)
-	(otrue buffer-file-truename)
-	(oname (buffer-name)))
-    (if (get-buffer " **lose**")
-	(kill-buffer " **lose**"))
-    (rename-buffer " **lose**")
-    (unwind-protect
-	(progn
-	  (unlock-buffer)
-	  (setq buffer-file-name nil)
-	  (setq buffer-file-number nil)
-	  (setq buffer-file-truename nil)
-	  (find-file filename))
-      (cond ((eq obuf (current-buffer))
-	     (setq buffer-file-name ofile)
-	     (setq buffer-file-number onum)
-	     (setq buffer-file-truename otrue)
-	     (lock-buffer)
-	     (rename-buffer oname))))
-    (or (eq (current-buffer) obuf)
-	(kill-buffer obuf))))
-
-(defun create-file-buffer (filename)
-  "Create a suitably named buffer for visiting FILENAME, and return it.
-FILENAME (sans directory) is used unchanged if that name is free;
-otherwise a string <2> or <3> or ... is appended to get an unused name."
-  (let ((lastname (file-name-nondirectory filename)))
-    (if (string= lastname "")
-	(setq lastname filename))
-    (generate-new-buffer lastname)))
-
-(defun generate-new-buffer (name)
-  "Create and return a buffer with a name based on NAME.
-Choose the buffer's name using `generate-new-buffer-name'."
-  (get-buffer-create (generate-new-buffer-name name)))
-
-(defvar automount-dir-prefix "^/tmp_mnt/"
-  "Regexp to match the automounter prefix in a directory name.")
-
-(defvar abbreviated-home-dir nil
-  "The user's homedir abbreviated according to `directory-abbrev-list'.")
-
-(defun abbreviate-file-name (filename)
-  "Return a version of FILENAME shortened using `directory-abbrev-alist'.
-This also substitutes \"~\" for the user's home directory.
-Type \\[describe-variable] directory-abbrev-alist RET for more information."
-  ;; Get rid of the prefixes added by the automounter.
-  (if (and automount-dir-prefix
-	   (string-match automount-dir-prefix filename)
-	   (file-exists-p (file-name-directory
-			   (substring filename (1- (match-end 0))))))
-      (setq filename (substring filename (1- (match-end 0)))))
-  (let ((tail directory-abbrev-alist))
-    ;; If any elt of directory-abbrev-alist matches this name,
-    ;; abbreviate accordingly.
-    (while tail
-      (if (string-match (car (car tail)) filename)
-	  (setq filename
-		(concat (cdr (car tail)) (substring filename (match-end 0)))))
-      (setq tail (cdr tail)))
-    ;; Compute and save the abbreviated homedir name.
-    ;; We defer computing this until the first time it's needed, to
-    ;; give time for directory-abbrev-alist to be set properly.
-    ;; We include a slash at the end, to avoid spurious matches
-    ;; such as `/usr/foobar' when the home dir is `/usr/foo'.
-    (or abbreviated-home-dir
-	(setq abbreviated-home-dir
-	      (let ((abbreviated-home-dir "$foo"))
-		(concat "^" (abbreviate-file-name (expand-file-name "~"))
-			"\\(/\\|$\\)"))))
-
-    ;; If FILENAME starts with the abbreviated homedir,
-    ;; make it start with `~' instead.
-    (if (and (string-match abbreviated-home-dir filename)
-	     ;; If the home dir is just /, don't change it.
-	     (not (and (= (match-end 0) 1)
-		       (= (aref filename 0) ?/)))
-	     ;; MS-DOS root directories can come with a drive letter;
-	     ;; Novell Netware allows drive letters beyond `Z:'.
-	     (not (and (or (eq system-type 'ms-dos)
-			   (eq system-type 'windows-nt))
-		       (save-match-data
-			 (string-match "^[a-zA-`]:/$" filename)))))
-	(setq filename
-	      (concat "~"
-		      (substring filename (match-beginning 1) (match-end 1))
-		      (substring filename (match-end 0)))))
-    filename))
-
-(defvar find-file-not-true-dirname-list nil
-  "*List of logical names for which visiting shouldn't save the true dirname.
-On VMS, when you visit a file using a logical name that searches a path,
-you may or may not want the visited file name to record the specific
-directory where the file was found.  If you *do not* want that, add the logical
-name to this list as a string.")
-
-(defun find-buffer-visiting (filename)
-  "Return the buffer visiting file FILENAME (a string).
-This is like `get-file-buffer', except that it checks for any buffer
-visiting the same file, possibly under a different name.
-If there is no such live buffer, return nil."
-  (let ((buf (get-file-buffer filename))
-	(truename (abbreviate-file-name (file-truename filename))))
-    (or buf
-	(let ((list (buffer-list)) found)
-	  (while (and (not found) list)
-	    (save-excursion
-	      (set-buffer (car list))
-	      (if (and buffer-file-name
-		       (string= buffer-file-truename truename))
-		  (setq found (car list))))
-	    (setq list (cdr list)))
-	  found)
-	(let ((number (nthcdr 10 (file-attributes truename)))
-	      (list (buffer-list)) found)
-	  (and buffer-file-numbers-unique
-	       number
-	       (while (and (not found) list)
-		 (save-excursion
-		   (set-buffer (car list))
-		   (if (and buffer-file-name
-			    (equal buffer-file-number number)
-			    ;; Verify this buffer's file number
-			    ;; still belongs to its file.
-			    (file-exists-p buffer-file-name)
-			    (equal (nthcdr 10 (file-attributes buffer-file-name))
-				   number))
-		       (setq found (car list))))
-		 (setq list (cdr list))))
-	  found))))
-
-(defun insert-file-contents-literally (filename &optional visit beg end replace)
-  "Like `insert-file-contents', q.v., but only reads in the file.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
-  This function ensures that none of these modifications will take place.
-
-This function does not work for remote files, because it turns off
-file name handlers and remote file access uses a file name handler."
-  (let ((file-name-handler-alist nil)
-	(format-alist nil)
-	(after-insert-file-functions nil)
-	(find-buffer-file-type-function
-	 (if (fboundp 'find-buffer-file-type)
-	     (symbol-function 'find-buffer-file-type)
-	   nil)))
-    (unwind-protect
-	(progn
-	  (fset 'find-buffer-file-type (lambda (filename) t))
-	  (insert-file-contents filename visit beg end replace))
-      (if find-buffer-file-type-function
-	  (fset 'find-buffer-file-type find-buffer-file-type-function)
-	(fmakunbound 'find-buffer-file-type)))))
-
-(defun find-file-noselect (filename &optional nowarn rawfile)
-  "Read file FILENAME into a buffer and return the buffer.
-If a buffer exists visiting FILENAME, return that one, but
-verify that the file has not changed since visited or saved.
-The buffer is not selected, just returned to the caller."
-  (setq filename
-	(abbreviate-file-name
-	 (expand-file-name filename)))
-  (if (file-directory-p filename)
-      (if find-file-run-dired
-	  (dired-noselect (if find-file-visit-truename
-			      (abbreviate-file-name (file-truename filename))
-			    filename))
-	(error "%s is a directory" filename))
-    (let* ((buf (get-file-buffer filename))
-	   (truename (abbreviate-file-name (file-truename filename)))
-	   (number (nthcdr 10 (file-attributes truename)))
-	   ;; Find any buffer for a file which has same truename.
-	   (other (and (not buf) (find-buffer-visiting filename)))
-	   error)
-      ;; Let user know if there is a buffer with the same truename.
-      (if other
-	  (progn
-	    (or nowarn
-		(string-equal filename (buffer-file-name other))
-		(message "%s and %s are the same file"
-			 filename (buffer-file-name other)))
-	    ;; Optionally also find that buffer.
-	    (if (or find-file-existing-other-name find-file-visit-truename)
-		(setq buf other))))
-      (if buf
-	  (or nowarn
-	      (verify-visited-file-modtime buf)
-	      (cond ((not (file-exists-p filename))
-		     (error "File %s no longer exists!" filename))
-		    ;; Certain files should be reverted automatically
-		    ;; if they have changed on disk and not in the buffer.
-		    ((and (not (buffer-modified-p buf))
-			  (let ((tail find-file-revert-without-query)
-				(found nil))
-			    (while tail
-			      (if (string-match (car tail) filename)
-				  (setq found t))
-			      (setq tail (cdr tail)))
-			    found))
-		     (with-current-buffer buf
-		      (message "Reverting file %s..." filename)
-		      (revert-buffer t t)
-		      (message "Reverting file %s...done" filename)))
-		    ((yes-or-no-p
-		      (if (string= (file-name-nondirectory filename)
-				   (buffer-name buf))
-			  (format
-			   (if (buffer-modified-p buf)
-	"File %s changed on disk.  Discard your edits? "
-	"File %s changed on disk.  Reread from disk? ")
-			   (file-name-nondirectory filename))
-			(format
-			 (if (buffer-modified-p buf)
-      "File %s changed on disk.  Discard your edits in %s? "
-      "File %s changed on disk.  Reread from disk into %s? ")
-			 (file-name-nondirectory filename)
-			 (buffer-name buf))))
-		     (with-current-buffer buf
-		       (revert-buffer t t)))))
-	(save-excursion
-;;; The truename stuff makes this obsolete.
-;;;	  (let* ((link-name (car (file-attributes filename)))
-;;;		 (linked-buf (and (stringp link-name)
-;;;				  (get-file-buffer link-name))))
-;;;	    (if (bufferp linked-buf)
-;;;		(message "Symbolic link to file in buffer %s"
-;;;			 (buffer-name linked-buf))))
-	  (setq buf (create-file-buffer filename))
-	  (set-buffer-major-mode buf)
-	  (set-buffer buf)
-	  (erase-buffer)
-	  (if rawfile
-	      (condition-case ()
-		  (insert-file-contents-literally filename t)
-		(file-error
-		 ;; Unconditionally set error
-		 (setq error t)))
-	    (condition-case ()
-		(insert-file-contents filename t)
-	      (file-error
-	       ;; Run find-file-not-found-hooks until one returns non-nil.
-	       (or (run-hook-with-args-until-success 'find-file-not-found-hooks)
-		   ;; If they fail too, set error.
-		   (setq error t)))))
-	  ;; Find the file's truename, and maybe use that as visited name.
-	  (setq buffer-file-truename truename)
-	  (setq buffer-file-number number)
-	  ;; On VMS, we may want to remember which directory in a search list
-	  ;; the file was found in.
-	  (and (eq system-type 'vax-vms)
-	       (let (logical)
-		 (if (string-match ":" (file-name-directory filename))
-		     (setq logical (substring (file-name-directory filename)
-					      0 (match-beginning 0))))
-		 (not (member logical find-file-not-true-dirname-list)))
-	       (setq buffer-file-name buffer-file-truename))
-	  (if find-file-visit-truename
-	      (setq buffer-file-name
-		    (setq filename
-			  (expand-file-name buffer-file-truename))))
-	  ;; Set buffer's default directory to that of the file.
-	  (setq default-directory (file-name-directory filename))
-	  ;; Turn off backup files for certain file names.  Since
-	  ;; this is a permanent local, the major mode won't eliminate it.
-	  (and (not (funcall backup-enable-predicate buffer-file-name))
-	       (progn
-		 (make-local-variable 'backup-inhibited)
-		 (setq backup-inhibited t)))
-	  (if rawfile
-	      nil
-	    (after-find-file error (not nowarn))
-	    (setq buf (current-buffer)))))
-      buf)))
-
-(defvar after-find-file-from-revert-buffer nil)
-
-(defun after-find-file (&optional error warn noauto
-				  after-find-file-from-revert-buffer
-				  nomodes)
-  "Called after finding a file and by the default revert function.
-Sets buffer mode, parses local variables.
-Optional args ERROR, WARN, and NOAUTO: ERROR non-nil means there was an
-error in reading the file.  WARN non-nil means warn if there
-exists an auto-save file more recent than the visited file.
-NOAUTO means don't mess with auto-save mode.
-Fourth arg AFTER-FIND-FILE-FROM-REVERT-BUFFER non-nil
- means this call was from `revert-buffer'.
-Fifth arg NOMODES non-nil means don't alter the file's modes.
-Finishes by calling the functions in `find-file-hooks'
-unless NOMODES is non-nil."
-  (setq buffer-read-only (not (file-writable-p buffer-file-name)))
-  (if noninteractive
-      nil
-    (let* (not-serious
-	   (msg
-	    (cond ((and error (file-attributes buffer-file-name))
-		   (setq buffer-read-only t)
-		   "File exists, but cannot be read.")
-		  ((not buffer-read-only)
-		   (if (and warn
-			    (file-newer-than-file-p (make-auto-save-file-name)
-						    buffer-file-name))
-		       (format "%s has auto save data; consider M-x recover-file"
-			       (file-name-nondirectory buffer-file-name))
-		     (setq not-serious t)
-		     (if error "(New file)" nil)))
-		  ((not error)
-		   (setq not-serious t)
-		   "Note: file is write protected")
-		  ((file-attributes (directory-file-name default-directory))
-		   "File not found and directory write-protected")
-		  ((file-exists-p (file-name-directory buffer-file-name))
-		   (setq buffer-read-only nil))
-		  (t
-		   (setq buffer-read-only nil)
-		   (if (file-exists-p (file-name-directory (directory-file-name (file-name-directory buffer-file-name))))
-		       "Use M-x make-dir RET RET to create the directory"
-		     "Use C-u M-x make-dir RET RET to create directory and its parents")))))
-      (if msg
-	  (progn
-	    (message msg)
-	    (or not-serious (sit-for 1 nil t)))))
-    (if (and auto-save-default (not noauto))
-	(auto-save-mode t)))
-  (if nomodes
-      nil
-    (normal-mode t)
-    (run-hooks 'find-file-hooks)))
-
-(defun normal-mode (&optional find-file)
-  "Choose the major mode for this buffer automatically.
-Also sets up any specified local variables of the file.
-Uses the visited file name, the -*- line, and the local variables spec.
-
-This function is called automatically from `find-file'.  In that case,
-we may set up specified local variables depending on the value of
-`enable-local-variables': if it is t, we do; if it is nil, we don't;
-otherwise, we query.  `enable-local-variables' is ignored if you
-run `normal-mode' explicitly."
-  (interactive)
-  (or find-file (funcall (or default-major-mode 'fundamental-mode)))
-  (condition-case err
-      (set-auto-mode)
-    (error (message "File mode specification error: %s"
-		    (prin1-to-string err))))
-  (condition-case err
-      (let ((enable-local-variables (or (not find-file)
-					enable-local-variables)))
-	(hack-local-variables))
-    (error (message "File local-variables error: %s"
-		    (prin1-to-string err)))))
-
-(defvar auto-mode-alist
-  '(("\\.te?xt\\'" . text-mode)
-    ("\\.c\\'" . c-mode)
-    ("\\.h\\'" . c-mode)
-    ("\\.tex\\'" . tex-mode)
-    ("\\.ltx\\'" . latex-mode)
-    ("\\.el\\'" . emacs-lisp-mode)
-    ("\\.mm\\'" . nroff-mode)
-    ("\\.me\\'" . nroff-mode)
-    ("\\.ms\\'" . nroff-mode)
-    ("\\.man\\'" . nroff-mode)
-    ("\\.scm\\'" . scheme-mode)
-    ("\\.l\\'" . lisp-mode)
-    ("\\.lisp\\'" . lisp-mode)
-    ("\\.f\\'" . fortran-mode)
-    ("\\.F\\'" . fortran-mode)
-    ("\\.for\\'" . fortran-mode)
-    ("\\.p\\'" . pascal-mode)
-    ("\\.pas\\'" . pascal-mode)
-    ("\\.mss\\'" . scribe-mode)
-    ("\\.ad[abs]\\'" . ada-mode)
-    ("\\.icn\\'" . icon-mode)
-    ("\\.pl\\'" . perl-mode)
-    ("\\.pm\\'" . perl-mode)
-    ("\\.cc\\'" . c++-mode)
-    ("\\.hh\\'" . c++-mode)
-    ("\\.hpp\\'" . c++-mode)
-    ("\\.C\\'" . c++-mode)
-    ("\\.H\\'" . c++-mode)
-    ("\\.cpp\\'" . c++-mode)
-    ("\\.cxx\\'" . c++-mode)
-    ("\\.hxx\\'" . c++-mode)
-    ("\\.c\\+\\+\\'" . c++-mode)
-    ("\\.h\\+\\+\\'" . c++-mode)
-    ("\\.m\\'" . objc-mode)
-    ("\\.java\\'" . java-mode)
-    ("\\.sim\\'" . simula-mode)
-    ("\\.mk\\'" . makefile-mode)
-    ("\\(M\\|m\\|GNUm\\)akefile\\(.in\\)?\\'" . makefile-mode)
-;;; Less common extensions come here
-;;; so more common ones above are found faster.
-    ("\\.texinfo\\'" . texinfo-mode)
-    ("\\.te?xi\\'" . texinfo-mode)
-    ("\\.s\\'" . asm-mode)
-    ("\\.S\\'" . asm-mode)
-    ("\\.asm\\'" . asm-mode)
-    ("ChangeLog\\'" . change-log-mode)
-    ("change.log\\'" . change-log-mode)
-    ("changelo\\'" . change-log-mode)
-    ("ChangeLog.[0-9]+\\'" . change-log-mode)
-    ;; for MSDOS and MS-Windows (which are case-insensitive)
-    ("changelog\\'" . change-log-mode)
-    ("changelog.[0-9]+\\'" . change-log-mode)
-    ("\\$CHANGE_LOG\\$\\.TXT" . change-log-mode)
-    ("\\.scm\\.[0-9]*\\'" . scheme-mode)
-    ("\\.[ck]?sh\\'\\|\\.shar\\'\\|/\\.z?profile\\'" . sh-mode)
-    ("/\\.\\(bash_profile\\|z?login\\|bash_login\\|z?logout\\)\\'" . sh-mode)
-    ("/\\.\\(bash_logout\\|[kz]shrc\\|bashrc\\|t?cshrc\\|esrc\\)\\'" . sh-mode)
-    ("/\\.\\([kz]shenv\\|xinitrc\\|startxrc\\|xsession\\)\\'" . sh-mode)
-;;; The following should come after the ChangeLog pattern
-;;; for the sake of ChangeLog.1, etc.
-;;; and after the .scm.[0-9] pattern too.
-    ("\\.[12345678]\\'" . nroff-mode)
-    ("\\.TeX\\'" . tex-mode)
-    ("\\.sty\\'" . latex-mode)
-    ("\\.cls\\'" . latex-mode)		;LaTeX 2e class
-    ("\\.bbl\\'" . latex-mode)
-    ("\\.bib\\'" . bibtex-mode)
-    ("\\.article\\'" . text-mode)
-    ("\\.letter\\'" . text-mode)
-    ("\\.tcl\\'" . tcl-mode)
-    ("\\.exp\\'" . tcl-mode)
-    ("\\.itcl\\'" . tcl-mode)
-    ("\\.itk\\'" . tcl-mode)
-    ("\\.f90\\'" . f90-mode)
-    ("\\.lsp\\'" . lisp-mode)
-    ("\\.awk\\'" . awk-mode)
-    ("\\.prolog\\'" . prolog-mode)
-    ("\\.tar\\'" . tar-mode)
-    ("\\.\\(arc\\|zip\\|lzh\\|zoo\\)\\'" . archive-mode)
-    ("\\.\\(ARC\\|ZIP\\|LZH\\|ZOO\\)\\'" . archive-mode)
-    ;; Mailer puts message to be edited in
-    ;; /tmp/Re.... or Message
-    ("\\`/tmp/Re" . text-mode)
-    ("/Message[0-9]*\\'" . text-mode)
-    ("/drafts/[0-9]+\\'" . mh-letter-mode)
-    ;; some news reader is reported to use this
-    ("\\`/tmp/fol/" . text-mode)
-    ("\\.y\\'" . c-mode)
-    ("\\.lex\\'" . c-mode)
-    ("\\.oak\\'" . scheme-mode)
-    ("\\.sgml?\\'" . sgml-mode)
-    ("\\.dtd\\'" . sgml-mode)
-    ("\\.s?html?\\'" . html-mode)
-    ;; .emacs following a directory delimiter
-    ;; in either Unix or VMS syntax.
-    ("[]>:/]\\..*emacs\\'" . emacs-lisp-mode)
-    ;; _emacs following a directory delimiter
-    ;; in MsDos syntax
-    ("[:/]_emacs\\'" . emacs-lisp-mode)
-    ("\\.ml\\'" . lisp-mode))
-  "\
-Alist of filename patterns vs corresponding major mode functions.
-Each element looks like (REGEXP . FUNCTION) or (REGEXP FUNCTION NON-NIL).
-\(NON-NIL stands for anything that is not nil; the value does not matter.)
-Visiting a file whose name matches REGEXP specifies FUNCTION as the
-mode function to use.  FUNCTION will be called, unless it is nil.
-
-If the element has the form (REGEXP FUNCTION NON-NIL), then after
-calling FUNCTION (if it's not nil), we delete the suffix that matched
-REGEXP and search the list again for another match.")
-
-(defvar interpreter-mode-alist
-  '(("perl" . perl-mode)
-    ("perl5" . perl-mode)
-    ("wish" . tcl-mode)
-    ("wishx" . tcl-mode)
-    ("tcl" . tcl-mode)
-    ("tclsh" . tcl-mode)
-    ("awk" . awk-mode)
-    ("mawk" . awk-mode)
-    ("nawk" . awk-mode)
-    ("gawk" . awk-mode)
-    ("scm" . scheme-mode)
-    ("ash" . sh-mode)
-    ("bash" . sh-mode)
-    ("csh" . sh-mode)
-    ("dtksh" . sh-mode)
-    ("es" . sh-mode)
-    ("itcsh" . sh-mode)
-    ("jsh" . sh-mode)
-    ("ksh" . sh-mode)
-    ("oash" . sh-mode)
-    ("pdksh" . sh-mode)
-    ("rc" . sh-mode)
-    ("sh" . sh-mode)
-    ("sh5" . sh-mode)
-    ("tcsh" . sh-mode)
-    ("wksh" . sh-mode)
-    ("wsh" . sh-mode)
-    ("zsh" . sh-mode)
-    ("tail" . text-mode)
-    ("more" . text-mode)
-    ("less" . text-mode)
-    ("pg" . text-mode))
-  "Alist mapping interpreter names to major modes.
-This alist applies to files whose first line starts with `#!'.
-Each element looks like (INTERPRETER . MODE).
-The car of each element is compared with
-the name of the interpreter specified in the first line.
-If it matches, mode MODE is selected.")
-
-(defvar inhibit-first-line-modes-regexps '("\\.tar\\'" "\\.tgz\\'")
-  "List of regexps; if one matches a file name, don't look for `-*-'.")
-
-(defvar inhibit-first-line-modes-suffixes nil
-  "List of regexps for what to ignore, for `inhibit-first-line-modes-regexps'.
-When checking `inhibit-first-line-modes-regexps', we first discard
-from the end of the file name anything that matches one of these regexps.")
-
-(defvar user-init-file
-  "" ; set by command-line
-  "File name including directory of user's initialization file.")
-
-(defun set-auto-mode ()
-  "Select major mode appropriate for current buffer.
-This checks for a -*- mode tag in the buffer's text,
-compares the filename against the entries in `auto-mode-alist',
-or checks the interpreter that runs this file against
-`interpreter-mode-alist'.
-
-It does not check for the `mode:' local variable in the
-Local Variables section of the file; for that, use `hack-local-variables'.
-
-If `enable-local-variables' is nil, this function does not check for a
--*- mode tag."
-  ;; Look for -*-MODENAME-*- or -*- ... mode: MODENAME; ... -*-
-  (let (beg end done modes)
-    (save-excursion
-      (goto-char (point-min))
-      (skip-chars-forward " \t\n")
-      (and enable-local-variables
-	   ;; Don't look for -*- if this file name matches any
-	   ;; of the regexps in inhibit-first-line-modes-regexps.
-	   (let ((temp inhibit-first-line-modes-regexps)
-		 (name (if buffer-file-name
-			   (file-name-sans-versions buffer-file-name)
-			 (buffer-name))))
-	     (while (let ((sufs inhibit-first-line-modes-suffixes))
-		      (while (and sufs (not (string-match (car sufs) name)))
-			(setq sufs (cdr sufs)))
-		      sufs)
-	       (setq name (substring name 0 (match-beginning 0))))
-	     (while (and temp
-			 (not (string-match (car temp) name)))
-	       (setq temp (cdr temp)))
-	     (not temp))
-	   (search-forward "-*-" (save-excursion
-				   ;; If the file begins with "#!"
-				   ;; (exec interpreter magic), look
-				   ;; for mode frobs in the first two
-				   ;; lines.  You cannot necessarily
-				   ;; put them in the first line of
-				   ;; such a file without screwing up
-				   ;; the interpreter invocation.
-				   (end-of-line (and (looking-at "^#!") 2))
-				   (point)) t)
-	   (progn
-	     (skip-chars-forward " \t")
-	     (setq beg (point))
-	     (search-forward "-*-"
-			     (save-excursion (end-of-line) (point))
-			     t))
-	   (progn
-	     (forward-char -3)
-	     (skip-chars-backward " \t")
-	     (setq end (point))
-	     (goto-char beg)
-	     (if (save-excursion (search-forward ":" end t))
-		 ;; Find all specifications for the `mode:' variable
-		 ;; and execute them left to right.
-		 (while (let ((case-fold-search t))
-			  (or (and (looking-at "mode:")
-				   (goto-char (match-end 0)))
-			      (re-search-forward "[ \t;]mode:" end t)))
-		   (skip-chars-forward " \t")
-		   (setq beg (point))
-		   (if (search-forward ";" end t)
-		       (forward-char -1)
-		     (goto-char end))
-		   (skip-chars-backward " \t")
-		   (setq modes (cons (intern (concat (downcase (buffer-substring beg (point))) "-mode"))
-				     modes)))
-	       ;; Simple -*-MODE-*- case.
-	       (setq modes (cons (intern (concat (downcase (buffer-substring beg end))
-						 "-mode"))
-				 modes))))))
-    ;; If we found modes to use, invoke them now,
-    ;; outside the save-excursion.
-    (if modes
-	(progn (mapcar 'funcall (nreverse modes))
-	       (setq done t)))
-    ;; If we didn't find a mode from a -*- line, try using the file name.
-    (if (and (not done) buffer-file-name)
-	(let ((name buffer-file-name)
-	      (keep-going t))
-	  ;; Remove backup-suffixes from file name.
-	  (setq name (file-name-sans-versions name))
-	  (while keep-going
-	    (setq keep-going nil)
-	    (let ((alist auto-mode-alist)
-		  (mode nil))
-	      ;; Find first matching alist entry.
-	      (let ((case-fold-search
-		     (memq system-type '(vax-vms windows-nt))))
-		(while (and (not mode) alist)
-		  (if (string-match (car (car alist)) name)
-		      (if (and (consp (cdr (car alist)))
-			       (nth 2 (car alist)))
-			  (progn
-			    (setq mode (car (cdr (car alist)))
-				  name (substring name 0 (match-beginning 0))
-				  keep-going t))
-			(setq mode (cdr (car alist))
-			      keep-going nil)))
-		  (setq alist (cdr alist))))
-	      (if mode
-		  (funcall mode)
-		;; If we can't deduce a mode from the file name,
-		;; look for an interpreter specified in the first line.
-		;; As a special case, allow for things like "#!/bin/env perl",
-		;; which finds the interpreter anywhere in $PATH.
-		(let ((interpreter
-		       (save-excursion
-			 (goto-char (point-min))
-			 (if (looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
-			     (buffer-substring (match-beginning 2)
-					       (match-end 2))
-			   "")))
-		      elt)
-		  ;; Map interpreter name to a mode.
-		  (setq elt (assoc (file-name-nondirectory interpreter)
-				   interpreter-mode-alist))
-		  (if elt
-		      (funcall (cdr elt)))))))))))
-
-(defun hack-local-variables-prop-line ()
-  ;; Set local variables specified in the -*- line.
-  ;; Ignore any specification for `mode:';
-  ;; set-auto-mode should already have handled that.
-  (save-excursion
-    (goto-char (point-min))
-    (let ((result nil)
-	  (end (save-excursion (end-of-line (and (looking-at "^#!") 2)) (point))))
-      ;; Parse the -*- line into the `result' alist.
-      (cond ((not (search-forward "-*-" end t))
-	     ;; doesn't have one.
-	     nil)
-	    ((looking-at "[ \t]*\\([^ \t\n\r:;]+\\)\\([ \t]*-\\*-\\)")
-	     ;; Simple form: "-*- MODENAME -*-".  Already handled.
-	     nil)
-	    (t
-	     ;; Hairy form: '-*-' [ <variable> ':' <value> ';' ]* '-*-'
-	     ;; (last ";" is optional).
-	     (save-excursion
-	       (if (search-forward "-*-" end t)
-		   (setq end (- (point) 3))
-		 (error "-*- not terminated before end of line")))
-	     (while (< (point) end)
-	       (or (looking-at "[ \t]*\\([^ \t\n:]+\\)[ \t]*:[ \t]*")
-		   (error "malformed -*- line"))
-	       (goto-char (match-end 0))
-	       ;; There used to be a downcase here,
-	       ;; but the manual didn't say so,
-	       ;; and people want to set var names that aren't all lc.
-	       (let ((key (intern (buffer-substring
-				   (match-beginning 1)
-				   (match-end 1))))
-		     (val (save-restriction
-			    (narrow-to-region (point) end)
-			    (read (current-buffer)))))
-		 ;; It is traditional to ignore
-		 ;; case when checking for `mode' in set-auto-mode,
-		 ;; so we must do that here as well.
-		 ;; That is inconsistent, but we're stuck with it.
-		 (or (equal (downcase (symbol-name key)) "mode")
-		     (setq result (cons (cons key val) result)))
-		 (skip-chars-forward " \t;")))
-	     (setq result (nreverse result))))
-
-      (if (and result
-	       (or (eq enable-local-variables t)
-		   (and enable-local-variables
-			(save-window-excursion
-			  (condition-case nil
-			      (switch-to-buffer (current-buffer))
-			    (error
-			     ;; If we fail to switch in the selected window,
-			     ;; it is probably a minibuffer.
-			     ;; So try another window.
-			     (condition-case nil
-				 (switch-to-buffer-other-window (current-buffer))
-			       (error
-				(switch-to-buffer-other-frame (current-buffer))))))
-			  (y-or-n-p (format "Set local variables as specified in -*- line of %s? "
-					    (file-name-nondirectory buffer-file-name)))))))
-	  (let ((enable-local-eval enable-local-eval))
-	    (while result
-	      (hack-one-local-variable (car (car result)) (cdr (car result)))
-	      (setq result (cdr result))))))))
-
-(defvar hack-local-variables-hook nil
-  "Normal hook run after processing a file's local variables specs.
-Major modes can use this to examine user-specified local variables
-in order to initialize other data structure based on them.")
-
-(defun hack-local-variables ()
-  "Parse and put into effect this buffer's local variables spec."
-  (hack-local-variables-prop-line)
-  ;; Look for "Local variables:" line in last page.
-  (save-excursion
-    (goto-char (point-max))
-    (search-backward "\n\^L" (max (- (point-max) 3000) (point-min)) 'move)
-    (if (let ((case-fold-search t))
-	  (and (search-forward "Local Variables:" nil t)
-	       (or (eq enable-local-variables t)
-		   (and enable-local-variables
-			(save-window-excursion
-			  (switch-to-buffer (current-buffer))
-			  (save-excursion
-			    (beginning-of-line)
-			    (set-window-start (selected-window) (point)))
-			  (y-or-n-p (format "Set local variables as specified at end of %s? "
- 					    (if buffer-file-name
- 						(file-name-nondirectory
- 						 buffer-file-name)
- 					      (concat "buffer "
- 						      (buffer-name))))))))))
-	(let ((continue t)
-	      prefix prefixlen suffix beg
-	      (enable-local-eval enable-local-eval))
-	  ;; The prefix is what comes before "local variables:" in its line.
-	  ;; The suffix is what comes after "local variables:" in its line.
-	  (skip-chars-forward " \t")
-	  (or (eolp)
-	      (setq suffix (buffer-substring (point)
-					     (progn (end-of-line) (point)))))
-	  (goto-char (match-beginning 0))
-	  (or (bolp)
-	      (setq prefix
-		    (buffer-substring (point)
-				      (progn (beginning-of-line) (point)))))
-
-	  (if prefix (setq prefixlen (length prefix)
-			   prefix (regexp-quote prefix)))
-	  (if suffix (setq suffix (concat (regexp-quote suffix) "$")))
-	  (while continue
-	    ;; Look at next local variable spec.
-	    (if selective-display (re-search-forward "[\n\C-m]")
-	      (forward-line 1))
-	    ;; Skip the prefix, if any.
-	    (if prefix
-		(if (looking-at prefix)
-		    (forward-char prefixlen)
-		  (error "Local variables entry is missing the prefix")))
-	    ;; Find the variable name; strip whitespace.
-	    (skip-chars-forward " \t")
-	    (setq beg (point))
-	    (skip-chars-forward "^:\n")
-	    (if (eolp) (error "Missing colon in local variables entry"))
-	    (skip-chars-backward " \t")
-	    (let* ((str (buffer-substring beg (point)))
-		   (var (read str))
-		  val)
-	      ;; Setting variable named "end" means end of list.
-	      (if (string-equal (downcase str) "end")
-		  (setq continue nil)
-		;; Otherwise read the variable value.
-		(skip-chars-forward "^:")
-		(forward-char 1)
-		(setq val (read (current-buffer)))
-		(skip-chars-backward "\n")
-		(skip-chars-forward " \t")
-		(or (if suffix (looking-at suffix) (eolp))
-		    (error "Local variables entry is terminated incorrectly"))
-		;; Set the variable.  "Variables" mode and eval are funny.
-		(hack-one-local-variable var val)))))))
-  (run-hooks 'hack-local-variables-hook))
-
-(defvar ignored-local-variables
-  '(enable-local-eval)
-  "Variables to be ignored in a file's local variable spec.")
-
-;; Get confirmation before setting these variables as locals in a file.
-(put 'debugger 'risky-local-variable t)
-(put 'enable-local-eval 'risky-local-variable t)
-(put 'ignored-local-variables 'risky-local-variable t)
-(put 'eval 'risky-local-variable t)
-(put 'file-name-handler-alist 'risky-local-variable t)
-(put 'minor-mode-map-alist 'risky-local-variable t)
-(put 'after-load-alist 'risky-local-variable t)
-(put 'buffer-file-name 'risky-local-variable t)
-(put 'buffer-auto-save-file-name 'risky-local-variable t)
-(put 'buffer-file-truename 'risky-local-variable t)
-(put 'exec-path 'risky-local-variable t)
-(put 'load-path 'risky-local-variable t)
-(put 'exec-directory 'risky-local-variable t)
-(put 'process-environment 'risky-local-variable t)
-(put 'dabbrev-case-fold-search 'risky-local-variable t)
-(put 'dabbrev-case-replace 'risky-local-variable t)
-;; Don't wait for outline.el to be loaded, for the sake of outline-minor-mode.
-(put 'outline-level 'risky-local-variable t)
-(put 'rmail-output-file-alist 'risky-local-variable t)
-
-;; This one is safe because the user gets to check it before it is used.
-(put 'compile-command 'safe-local-variable t)
-
-(defun hack-one-local-variable-quotep (exp)
-  (and (consp exp) (eq (car exp) 'quote) (consp (cdr exp))))
-
-;; "Set" one variable in a local variables spec.
-;; A few variable names are treated specially.
-(defun hack-one-local-variable (var val)
-  (cond ((eq var 'mode)
-	 (funcall (intern (concat (downcase (symbol-name val))
-				  "-mode"))))
-	((memq var ignored-local-variables)
-	 nil)
-	;; "Setting" eval means either eval it or do nothing.
-	;; Likewise for setting hook variables.
-	((or (get var 'risky-local-variable)
-	     (and
-	      (string-match "-hooks?$\\|-functions?$\\|-forms?$\\|-program$\\|-command$"
-			    (symbol-name var))
-	      (not (get var 'safe-local-variable))))
-	 ;; Permit evalling a put of a harmless property.
-	 ;; if the args do nothing tricky.
-	 (if (or (and (eq var 'eval)
-		      (consp val)
-		      (eq (car val) 'put)
-		      (hack-one-local-variable-quotep (nth 1 val))
-		      (hack-one-local-variable-quotep (nth 2 val))
-		      ;; Only allow safe values of lisp-indent-hook;
-		      ;; not functions.
-		      (or (numberp (nth 3 val))
-			  (equal (nth 3 val) ''defun))
-		      (memq (nth 1 (nth 2 val))
-			    '(lisp-indent-hook)))
-		 ;; Permit eval if not root and user says ok.
-		 (and (not (zerop (user-uid)))
-		      (or (eq enable-local-eval t)
-			  (and enable-local-eval
-			       (save-window-excursion
-				 (switch-to-buffer (current-buffer))
-				 (save-excursion
-				   (beginning-of-line)
-				   (set-window-start (selected-window) (point)))
-				 (setq enable-local-eval
-				       (y-or-n-p (format "Process `eval' or hook local variables in file %s? "
-							 (file-name-nondirectory buffer-file-name)))))))))
-	     (if (eq var 'eval)
-		 (save-excursion (eval val))
-	       (make-local-variable var)
-	       (set var val))
-	   (message "Ignoring `eval:' in file's local variables")))
-	;; Ordinary variable, really set it.
-	(t (make-local-variable var)
-	   (set var val))))
-
-
-(defun set-visited-file-name (filename &optional no-query)
-  "Change name of file visited in current buffer to FILENAME.
-The next time the buffer is saved it will go in the newly specified file.
-nil or empty string as argument means make buffer not be visiting any file.
-Remember to delete the initial contents of the minibuffer
-if you wish to pass an empty string as the argument.
-
-The optional second argument NO-QUERY, if non-nil, inhibits asking for
-confirmation in the case where another buffer is already visiting FILENAME."
-  (interactive "FSet visited file name: ")
-  (if (buffer-base-buffer)
-      (error "An indirect buffer cannot visit a file"))
-  (let (truename)
-    (if filename
-	(setq filename
-	      (if (string-equal filename "")
-		  nil
-		(expand-file-name filename))))
-    (if filename
-	(progn
-	  (setq truename (file-truename filename))
-	  (if find-file-visit-truename
-	      (setq filename truename))))
-    (let ((buffer (and filename (find-buffer-visiting filename))))
-      (and buffer (not (eq buffer (current-buffer)))
-	   (not no-query)
-	   (not (y-or-n-p (message "A buffer is visiting %s; proceed? "
-				   filename)))
-	   (error "Aborted")))
-    (or (equal filename buffer-file-name)
-	(progn
-	  (and filename (lock-buffer filename))
-	  (unlock-buffer)))
-    (setq buffer-file-name filename)
-    (if filename			; make buffer name reflect filename.
-	(let ((new-name (file-name-nondirectory buffer-file-name)))
-	  (if (string= new-name "")
-	      (error "Empty file name"))
-	  (if (eq system-type 'vax-vms)
-	      (setq new-name (downcase new-name)))
-	  (setq default-directory (file-name-directory buffer-file-name))
-	  (or (string= new-name (buffer-name))
-	      (rename-buffer new-name t))))
-    (setq buffer-backed-up nil)
-    (clear-visited-file-modtime)
-    ;; Abbreviate the file names of the buffer.
-    (if truename
-	(progn
-	  (setq buffer-file-truename (abbreviate-file-name truename))
-	  (if find-file-visit-truename
-	      (setq buffer-file-name buffer-file-truename))))
-    (setq buffer-file-number
-	  (if filename
-	      (nthcdr 10 (file-attributes buffer-file-name))
-	      nil)))
-  ;; write-file-hooks is normally used for things like ftp-find-file
-  ;; that visit things that are not local files as if they were files.
-  ;; Changing to visit an ordinary local file instead should flush the hook.
-  (kill-local-variable 'write-file-hooks)
-  (kill-local-variable 'local-write-file-hooks)
-  (kill-local-variable 'revert-buffer-function)
-  (kill-local-variable 'backup-inhibited)
-  ;; If buffer was read-only because of version control,
-  ;; that reason is gone now, so make it writable.
-  (if vc-mode
-      (setq buffer-read-only nil))
-  (kill-local-variable 'vc-mode)
-  ;; Turn off backup files for certain file names.
-  ;; Since this is a permanent local, the major mode won't eliminate it.
-  (and (not (funcall backup-enable-predicate buffer-file-name))
-       (progn
-	 (make-local-variable 'backup-inhibited)
-	 (setq backup-inhibited t)))
-  (let ((oauto buffer-auto-save-file-name))
-    ;; If auto-save was not already on, turn it on if appropriate.
-    (if (not buffer-auto-save-file-name)
-	(and buffer-file-name auto-save-default
-	     (auto-save-mode t))
-      ;; If auto save is on, start using a new name.
-      ;; We deliberately don't rename or delete the old auto save
-      ;; for the old visited file name.  This is because perhaps
-      ;; the user wants to save the new state and then compare with the
-      ;; previous state from the auto save file.
-      (setq buffer-auto-save-file-name
-	    (make-auto-save-file-name)))
-    ;; Rename the old auto save file if any.
-    (and oauto buffer-auto-save-file-name
-	 (file-exists-p oauto)
-	 (rename-file oauto buffer-auto-save-file-name t)))
-  (if buffer-file-name
-      (set-buffer-modified-p t)))
-
-(defun write-file (filename &optional confirm)
-  "Write current buffer into file FILENAME.
-Makes buffer visit that file, and marks it not modified.
-If the buffer is already visiting a file, you can specify
-a directory name as FILENAME, to write a file of the same
-old name in that directory.
-
-If optional second arg CONFIRM is non-nil,
-ask for confirmation for overwriting an existing file.
-Interactively, confirmation is required unless you supply a prefix argument."
-;;  (interactive "FWrite file: ")
-  (interactive
-   (list (if buffer-file-name
-	     (read-file-name "Write file: "
-				 nil nil nil nil)
-	   (read-file-name "Write file: "
-			       (cdr (assq 'default-directory
-					  (buffer-local-variables)))
-			       nil nil (buffer-name)))
-	 (not current-prefix-arg)))
-  (or (null filename) (string-equal filename "")
-      (progn
-	;; If arg is just a directory,
-	;; use same file name, but in that directory.
-	(if (and (file-directory-p filename) buffer-file-name)
-	    (setq filename (concat (file-name-as-directory filename)
-				   (file-name-nondirectory buffer-file-name))))
-	(and confirm
-	     (file-exists-p filename)
-	     (or (y-or-n-p (format "File `%s' exists; overwrite? " filename))
-		 (error "Canceled")))
-	(set-visited-file-name filename (not confirm))))
-  (set-buffer-modified-p t)
-  (save-buffer))
-
-(defun backup-buffer ()
-  "Make a backup of the disk file visited by the current buffer, if appropriate.
-This is normally done before saving the buffer the first time.
-If the value is non-nil, it is the result of `file-modes' on the original
-file; this means that the caller, after saving the buffer, should change
-the modes of the new file to agree with the old modes.
-
-A backup may be done by renaming or by copying; see documentation of
-variable `make-backup-files'.  If it's done by renaming, then the file is
-no longer accessible under its old name."
-  (if (and make-backup-files (not backup-inhibited)
-	   (not buffer-backed-up)
-	   (file-exists-p buffer-file-name)
-	   (memq (aref (elt (file-attributes buffer-file-name) 8) 0)
-		 '(?- ?l)))
-      (let ((real-file-name buffer-file-name)
-	    backup-info backupname targets setmodes)
-	;; If specified name is a symbolic link, chase it to the target.
-	;; Thus we make the backups in the directory where the real file is.
-	(setq real-file-name (file-chase-links real-file-name))
-	(setq backup-info (find-backup-file-name real-file-name)
-	      backupname (car backup-info)
-	      targets (cdr backup-info))
-;;;     (if (file-directory-p buffer-file-name)
-;;;         (error "Cannot save buffer in directory %s" buffer-file-name))
-	(if backup-info
-	    (condition-case ()
-		(let ((delete-old-versions
-		       ;; If have old versions to maybe delete,
-		       ;; ask the user to confirm now, before doing anything.
-		       ;; But don't actually delete til later.
-		       (and targets
-			    (or (eq delete-old-versions t) (eq delete-old-versions nil))
-			    (or delete-old-versions
-				(y-or-n-p (format "Delete excess backup versions of %s? "
-						  real-file-name))))))
-		  ;; Actually write the back up file.
-		  (condition-case ()
-		      (if (or file-precious-flag
-    ;			  (file-symlink-p buffer-file-name)
-			      backup-by-copying
-			      (and backup-by-copying-when-linked
-				   (> (file-nlinks real-file-name) 1))
-			      (and backup-by-copying-when-mismatch
-				   (let ((attr (file-attributes real-file-name)))
-				     (or (nth 9 attr)
-					 (not (file-ownership-preserved-p real-file-name))))))
-			  (condition-case ()
-			      (copy-file real-file-name backupname t t)
-			    (file-error
-			     ;; If copying fails because file BACKUPNAME
-			     ;; is not writable, delete that file and try again.
-			     (if (and (file-exists-p backupname)
-				      (not (file-writable-p backupname)))
-				 (delete-file backupname))
-			     (copy-file real-file-name backupname t t)))
-			;; rename-file should delete old backup.
-			(rename-file real-file-name backupname t)
-			(setq setmodes (file-modes backupname)))
-		    (file-error
-		     ;; If trouble writing the backup, write it in ~.
-		     (setq backupname (expand-file-name
-				       (convert-standard-filename
-					"~/%backup%~")))
-		     (message "Cannot write backup file; backing up in %s"
-			      (file-name-nondirectory backupname))
-		     (sleep-for 1)
-		     (condition-case ()
-			 (copy-file real-file-name backupname t t)
-		       (file-error
-			;; If copying fails because file BACKUPNAME
-			;; is not writable, delete that file and try again.
-			(if (and (file-exists-p backupname)
-				 (not (file-writable-p backupname)))
-			    (delete-file backupname))
-			(copy-file real-file-name backupname t t)))))
-		  (setq buffer-backed-up t)
-		  ;; Now delete the old versions, if desired.
-		  (if delete-old-versions
-		      (while targets
-			(condition-case ()
-			    (delete-file (car targets))
-			  (file-error nil))
-			(setq targets (cdr targets))))
-		  setmodes)
-	    (file-error nil))))))
-
-(defun file-name-sans-versions (name &optional keep-backup-version)
-  "Return FILENAME sans backup versions or strings.
-This is a separate procedure so your site-init or startup file can
-redefine it.
-If the optional argument KEEP-BACKUP-VERSION is non-nil,
-we do not remove backup version numbers, only true file version numbers."
-  (let ((handler (find-file-name-handler name 'file-name-sans-versions)))
-    (if handler
-	(funcall handler 'file-name-sans-versions name keep-backup-version)
-      (substring name 0
-		 (if (eq system-type 'vax-vms)
-		     ;; VMS version number is (a) semicolon, optional
-		     ;; sign, zero or more digits or (b) period, option
-		     ;; sign, zero or more digits, provided this is the
-		     ;; second period encountered outside of the
-		     ;; device/directory part of the file name.
-		     (or (string-match ";[-+]?[0-9]*\\'" name)
-			 (if (string-match "\\.[^]>:]*\\(\\.[-+]?[0-9]*\\)\\'"
-					   name)
-			     (match-beginning 1))
-			 (length name))
-		   (if keep-backup-version
-		       (length name)
-		     (or (string-match "\\.~[0-9.]+~\\'" name)
-			 (string-match "~\\'" name)
-			 (length name))))))))
-
-(defun file-ownership-preserved-p (file)
-  "Returns t if deleting FILE and rewriting it would preserve the owner."
-  (let ((handler (find-file-name-handler file 'file-ownership-preserved-p)))
-    (if handler
-	(funcall handler 'file-ownership-preserved-p file)
-      (let ((attributes (file-attributes file)))
-	;; Return t if the file doesn't exist, since it's true that no
-	;; information would be lost by an (attempted) delete and create.
-	(or (null attributes)
-	    (= (nth 2 attributes) (user-uid)))))))
-
-(defun file-name-sans-extension (filename)
-  "Return FILENAME sans final \"extension\".
-The extension, in a file name, is the part that follows the last `.'."
-  (save-match-data
-    (let ((file (file-name-sans-versions (file-name-nondirectory filename)))
-	  directory)
-      (if (string-match "\\.[^.]*\\'" file)
-	  (if (setq directory (file-name-directory filename))
-	      (expand-file-name (substring file 0 (match-beginning 0))
-				directory)
-	    (substring file 0 (match-beginning 0)))
-	filename))))
-
-(defun file-name-extension (filename &optional period)
-  "Return FILENAME's final \"extension\".
-The extension, in a file name, is the part that follows the last `.'.
-Return nil for extensionless file names such as `foo'.
-Return the empty string for file names such as `foo.'.
-
-If PERIOD is non-nil, then the returned value includes the period
-that delimits the extension, and if FILENAME has no extension,
-the value is \"\"."
-  (save-match-data
-    (let ((file (file-name-sans-versions (file-name-nondirectory filename))))
-      (if (string-match "\\.[^.]*\\'" file)
-          (substring file (+ (match-beginning 0) (if period 0 1)))
-        (if period
-            "")))))
-
-(defun make-backup-file-name (file)
-  "Create the non-numeric backup file name for FILE.
-This is a separate function so you can redefine it for customization."
-  (if (and (eq system-type 'ms-dos)
-	   (not (msdos-long-file-names)))
-      (let ((fn (file-name-nondirectory file)))
-	(concat (file-name-directory file)
-		(or
-		 (and (string-match "\\`[^.]+\\'" fn)
-		      (concat (match-string 0 fn) ".~"))
-		 (and (string-match "\\`[^.]+\\.\\(..?\\)?" fn)
-		      (concat (match-string 0 fn) "~")))))
-    (concat file "~")))
-
-(defun backup-file-name-p (file)
-  "Return non-nil if FILE is a backup file name (numeric or not).
-This is a separate function so you can redefine it for customization.
-You may need to redefine `file-name-sans-versions' as well."
-    (string-match "~\\'" file))
-
-;; This is used in various files.
-;; The usage of bv-length is not very clean,
-;; but I can't see a good alternative,
-;; so as of now I am leaving it alone.
-(defun backup-extract-version (fn)
-  "Given the name of a numeric backup file, return the backup number.
-Uses the free variable `bv-length', whose value should be
-the index in the name where the version number begins."
-  (if (and (string-match "[0-9]+~$" fn bv-length)
-	   (= (match-beginning 0) bv-length))
-      (string-to-int (substring fn bv-length -1))
-      0))
-
-;; I believe there is no need to alter this behavior for VMS;
-;; since backup files are not made on VMS, it should not get called.
-(defun find-backup-file-name (fn)
-  "Find a file name for a backup file, and suggestions for deletions.
-Value is a list whose car is the name for the backup file
- and whose cdr is a list of old versions to consider deleting now.
-If the value is nil, don't make a backup."
-  (let ((handler (find-file-name-handler fn 'find-backup-file-name)))
-    ;; Run a handler for this function so that ange-ftp can refuse to do it.
-    (if handler
-	(funcall handler 'find-backup-file-name fn)
-      (if (eq version-control 'never)
-	  (list (make-backup-file-name fn))
-	(let* ((base-versions (concat (file-name-nondirectory fn) ".~"))
-	       (bv-length (length base-versions))
-	       possibilities
-	       (versions nil)
-	       (high-water-mark 0)
-	       (deserve-versions-p nil)
-	       (number-to-delete 0))
-	  (condition-case ()
-	      (setq possibilities (file-name-all-completions
-				   base-versions
-				   (file-name-directory fn))
-		    versions (sort (mapcar
-				    (function backup-extract-version)
-				    possibilities)
-				   '<)
-		    high-water-mark (apply 'max 0 versions)
-		    deserve-versions-p (or version-control
-					   (> high-water-mark 0))
-		    number-to-delete (- (length versions)
-					kept-old-versions kept-new-versions -1))
-	    (file-error
-	     (setq possibilities nil)))
-	  (if (not deserve-versions-p)
-	      (list (make-backup-file-name fn))
-	    (cons (concat fn ".~" (int-to-string (1+ high-water-mark)) "~")
-		  (if (and (> number-to-delete 0)
-			   ;; Delete nothing if there is overflow
-			   ;; in the number of versions to keep.
-			   (>= (+ kept-new-versions kept-old-versions -1) 0))
-		      (mapcar (function (lambda (n)
-					  (concat fn ".~" (int-to-string n) "~")))
-			      (let ((v (nthcdr kept-old-versions versions)))
-				(rplacd (nthcdr (1- number-to-delete) v) ())
-				v))))))))))
-
-(defun file-nlinks (filename)
-  "Return number of names file FILENAME has."
-  (car (cdr (file-attributes filename))))
-
-(defun file-relative-name (filename &optional directory)
-  "Convert FILENAME to be relative to DIRECTORY (default: default-directory)."
-  (setq filename (expand-file-name filename)
-	directory (file-name-as-directory (expand-file-name
-					   (or directory default-directory))))
-  (let ((ancestor ""))
-    (while (not (string-match (concat "^" (regexp-quote directory)) filename))
-      (setq directory (file-name-directory (substring directory 0 -1))
-	    ancestor (concat "../" ancestor)))
-    (concat ancestor (substring filename (match-end 0)))))
-
-(defun save-buffer (&optional args)
-  "Save current buffer in visited file if modified.  Versions described below.
-By default, makes the previous version into a backup file
- if previously requested or if this is the first save.
-With 1 \\[universal-argument], marks this version
- to become a backup when the next save is done.
-With 2 \\[universal-argument]'s,
- unconditionally makes the previous version into a backup file.
-With 3 \\[universal-argument]'s, marks this version
- to become a backup when the next save is done,
- and unconditionally makes the previous version into a backup file.
-
-With argument of 0, never makes the previous version into a backup file.
-
-If a file's name is FOO, the names of its numbered backup versions are
- FOO.~i~ for various integers i.  A non-numbered backup file is called FOO~.
-Numeric backups (rather than FOO~) will be made if value of
- `version-control' is not the atom `never' and either there are already
- numeric versions of the file being backed up, or `version-control' is
- non-nil.
-We don't want excessive versions piling up, so there are variables
- `kept-old-versions', which tells Emacs how many oldest versions to keep,
- and `kept-new-versions', which tells how many newest versions to keep.
- Defaults are 2 old versions and 2 new.
-`dired-kept-versions' controls dired's clean-directory (.) command.
-If `delete-old-versions' is nil, system will query user
- before trimming versions.  Otherwise it does it silently."
-  (interactive "p")
-  (let ((modp (buffer-modified-p))
-	(large (> (buffer-size) 50000))
-	(make-backup-files (or (and make-backup-files (not (eq args 0)))
-			       (memq args '(16 64)))))
-    (and modp (memq args '(16 64)) (setq buffer-backed-up nil))
-    (if (and modp large) (message "Saving file %s..." (buffer-file-name)))
-    (basic-save-buffer)
-    (and modp (memq args '(4 64)) (setq buffer-backed-up nil))))
-
-(defun delete-auto-save-file-if-necessary (&optional force)
-  "Delete auto-save file for current buffer if `delete-auto-save-files' is t.
-Normally delete only if the file was written by this Emacs since
-the last real save, but optional arg FORCE non-nil means delete anyway."
-  (and buffer-auto-save-file-name delete-auto-save-files
-       (not (string= buffer-file-name buffer-auto-save-file-name))
-       (or force (recent-auto-save-p))
-       (progn
-	 (condition-case ()
-	     (delete-file buffer-auto-save-file-name)
-	   (file-error nil))
-	 (set-buffer-auto-saved))))
-
-(defvar after-save-hook nil
-  "Normal hook that is run after a buffer is saved to its file.")
-
-(defun basic-save-buffer ()
-  "Save the current buffer in its visited file, if it has been modified.
-After saving the buffer, run `after-save-hook'."
-  (interactive)
-  (save-excursion
-    ;; In an indirect buffer, save its base buffer instead.
-    (if (buffer-base-buffer)
-	(set-buffer (buffer-base-buffer)))
-    (if (buffer-modified-p)
-	(let ((recent-save (recent-auto-save-p))
-	      setmodes tempsetmodes)
-	  ;; On VMS, rename file and buffer to get rid of version number.
-	  (if (and (eq system-type 'vax-vms)
-		   (not (string= buffer-file-name
-				 (file-name-sans-versions buffer-file-name))))
-	      (let (buffer-new-name)
-		;; Strip VMS version number before save.
-		(setq buffer-file-name
-		      (file-name-sans-versions buffer-file-name))
-		;; Construct a (unique) buffer name to correspond.
-		(let ((buf (create-file-buffer (downcase buffer-file-name))))
-		  (setq buffer-new-name (buffer-name buf))
-		  (kill-buffer buf))
-		(rename-buffer buffer-new-name)))
-	  ;; If buffer has no file name, ask user for one.
-	  (or buffer-file-name
-	      (let ((filename
-		     (expand-file-name
-		      (read-file-name "File to save in: ") nil)))
-		(and (file-exists-p filename)
-		     (or (y-or-n-p (format "File `%s' exists; overwrite? "
-					   filename))
-			 (error "Canceled")))
-		(set-visited-file-name filename)))
-	  (or (verify-visited-file-modtime (current-buffer))
-	      (not (file-exists-p buffer-file-name))
-	      (yes-or-no-p
-	       (format "%s has changed since visited or saved.  Save anyway? "
-		       (file-name-nondirectory buffer-file-name)))
-	      (error "Save not confirmed"))
-	  (save-restriction
-	    (widen)
-	    (and (> (point-max) 1)
-		 (/= (char-after (1- (point-max))) ?\n)
-		 (not (and (eq selective-display t)
-			   (= (char-after (1- (point-max))) ?\r)))
-		 (or (eq require-final-newline t)
-		     (and require-final-newline
-			  (y-or-n-p
-			   (format "Buffer %s does not end in newline.  Add one? "
-				   (buffer-name)))))
-		 (save-excursion
-		   (goto-char (point-max))
-		   (insert ?\n)))
-	    (or (run-hook-with-args-until-success 'write-contents-hooks)
-		(run-hook-with-args-until-success 'local-write-file-hooks)
-		(run-hook-with-args-until-success 'write-file-hooks)
-		;; If a hook returned t, file is already "written".
-		;; Otherwise, write it the usual way now.
-		(setq setmodes (basic-save-buffer-1)))
-	    (setq buffer-file-number
-		  (nthcdr 10 (file-attributes buffer-file-name)))
-	    (if setmodes
-		(condition-case ()
-		    (set-file-modes buffer-file-name setmodes)
-		  (error nil))))
-	  ;; If the auto-save file was recent before this command,
-	  ;; delete it now.
-	  (delete-auto-save-file-if-necessary recent-save)
-	  ;; Support VC `implicit' locking.
-	  (vc-after-save)
-	  (run-hooks 'after-save-hook))
-      (message "(No changes need to be saved)"))))
-
-;; This does the "real job" of writing a buffer into its visited file
-;; and making a backup file.  This is what is normally done
-;; but inhibited if one of write-file-hooks returns non-nil.
-;; It returns a value to store in setmodes.
-(defun basic-save-buffer-1 ()
-  (let (tempsetmodes setmodes)
-    (if (not (file-writable-p buffer-file-name))
-	(let ((dir (file-name-directory buffer-file-name)))
-	  (if (not (file-directory-p dir))
-	      (error "%s is not a directory" dir)
-	    (if (not (file-exists-p buffer-file-name))
-		(error "Directory %s write-protected" dir)
-	      (if (yes-or-no-p
-		   (format "File %s is write-protected; try to save anyway? "
-			   (file-name-nondirectory
-			    buffer-file-name)))
-		  (setq tempsetmodes t)
-		(error "Attempt to save to a file which you aren't allowed to write"))))))
-    (or buffer-backed-up
-	(setq setmodes (backup-buffer)))
-    (let ((dir (file-name-directory buffer-file-name)))
-      (if (and file-precious-flag
-	       (file-writable-p dir))
-	  ;; If file is precious, write temp name, then rename it.
-	  ;; This requires write access to the containing dir,
-	  ;; which is why we don't try it if we don't have that access.
-	  (let ((realname buffer-file-name)
-		tempname temp nogood i succeed
-		(old-modtime (visited-file-modtime)))
-	    (setq i 0)
-	    (setq nogood t)
-	    ;; Find the temporary name to write under.
-	    (while nogood
-	      (setq tempname (format
-			      (if (and (eq system-type 'ms-dos)
-				       (not (msdos-long-file-names)))
-				  "%s#%d.tm#" ; MSDOS limits files to 8+3
-				"%s#tmp#%d")
-			      dir i))
-	      (setq nogood (file-exists-p tempname))
-	      (setq i (1+ i)))
-	    (unwind-protect
-		(progn (clear-visited-file-modtime)
-		       (write-region (point-min) (point-max)
-				     tempname nil realname
-				     buffer-file-truename)
-		       (setq succeed t))
-	      ;; If writing the temp file fails,
-	      ;; delete the temp file.
-	      (or succeed
-		  (progn
-		    (delete-file tempname)
-		    (set-visited-file-modtime old-modtime))))
-	    ;; Since we have created an entirely new file
-	    ;; and renamed it, make sure it gets the
-	    ;; right permission bits set.
-	    (setq setmodes (file-modes buffer-file-name))
-	    ;; We succeeded in writing the temp file,
-	    ;; so rename it.
-	    (rename-file tempname buffer-file-name t))
-	;; If file not writable, see if we can make it writable
-	;; temporarily while we write it.
-	;; But no need to do so if we have just backed it up
-	;; (setmodes is set) because that says we're superseding.
-	(cond ((and tempsetmodes (not setmodes))
-	       ;; Change the mode back, after writing.
-	       (setq setmodes (file-modes buffer-file-name))
-	       (set-file-modes buffer-file-name 511)))
-	(write-region (point-min) (point-max)
-		      buffer-file-name nil t buffer-file-truename)))
-    setmodes))
-
-(defun save-some-buffers (&optional arg exiting)
-  "Save some modified file-visiting buffers.  Asks user about each one.
-Optional argument (the prefix) non-nil means save all with no questions.
-Optional second argument EXITING means ask about certain non-file buffers
- as well as about file buffers."
-  (interactive "P")
-  (save-window-excursion
-    (let* ((queried nil)
-	   (files-done
-	    (map-y-or-n-p
-	     (function
-	      (lambda (buffer)
-		(and (buffer-modified-p buffer)
-		     (not (buffer-base-buffer buffer))
-		     (or
-		      (buffer-file-name buffer)
-		      (and exiting
-			   (progn
-			     (set-buffer buffer)
-			     (and buffer-offer-save (> (buffer-size) 0)))))
-		     (if arg
-			 t
-		       (setq queried t)
-		       (if (buffer-file-name buffer)
-			   (format "Save file %s? "
-				   (buffer-file-name buffer))
-			 (format "Save buffer %s? "
-				 (buffer-name buffer)))))))
-	     (function
-	      (lambda (buffer)
-		(set-buffer buffer)
-		(save-buffer)))
-	     (buffer-list)
-	     '("buffer" "buffers" "save")
-	     (list (list ?\C-r (lambda (buf)
-				 (view-buffer buf)
-				 (setq view-exit-action
-				       '(lambda (ignore)
-					  (exit-recursive-edit)))
-				 (recursive-edit)
-				 ;; Return nil to ask about BUF again.
-				 nil)
-			 "display the current buffer"))))
-	   (abbrevs-done
-	    (and save-abbrevs abbrevs-changed
-		 (progn
-		   (if (or arg
-			   (y-or-n-p (format "Save abbrevs in %s? "
-					     abbrev-file-name)))
-		       (write-abbrev-file nil))
-		   ;; Don't keep bothering user if he says no.
-		   (setq abbrevs-changed nil)
-		   t))))
-      (or queried (> files-done 0) abbrevs-done
-	  (message "(No files need saving)")))))
-
-(defun not-modified (&optional arg)
-  "Mark current buffer as unmodified, not needing to be saved.
-With prefix arg, mark buffer as modified, so \\[save-buffer] will save.
-
-It is not a good idea to use this function in Lisp programs, because it
-prints a message in the minibuffer.  Instead, use `set-buffer-modified-p'."
-  (interactive "P")
-  (message (if arg "Modification-flag set"
-	       "Modification-flag cleared"))
-  (set-buffer-modified-p arg))
-
-(defun toggle-read-only (&optional arg)
-  "Change whether this buffer is visiting its file read-only.
-With arg, set read-only iff arg is positive."
-  (interactive "P")
-  (setq buffer-read-only
-	(if (null arg)
-            (not buffer-read-only)
-            (> (prefix-numeric-value arg) 0)))
-  (force-mode-line-update))
-
-(defun insert-file (filename)
-  "Insert contents of file FILENAME into buffer after point.
-Set mark after the inserted text.
-
-This function is meant for the user to run interactively.
-Don't call it from programs!  Use `insert-file-contents' instead.
-\(Its calling sequence is different; see its documentation)."
-  (interactive "*fInsert file: ")
-  (if (file-directory-p filename)
-      (signal 'file-error (list "Opening input file" "file is a directory"
-				filename)))
-  (let ((tem (insert-file-contents filename)))
-    (push-mark (+ (point) (car (cdr tem))))))
-
-(defun append-to-file (start end filename)
-  "Append the contents of the region to the end of file FILENAME.
-When called from a function, expects three arguments,
-START, END and FILENAME.  START and END are buffer positions
-saying what text to write."
-  (interactive "r\nFAppend to file: ")
-  (write-region start end filename t))
-
-(defun file-newest-backup (filename)
-  "Return most recent backup file for FILENAME or nil if no backups exist."
-  (let* ((filename (expand-file-name filename))
-	 (file (file-name-nondirectory filename))
-	 (dir  (file-name-directory    filename))
-	 (comp (file-name-all-completions file dir))
-         (newest nil)
-         tem)
-    (while comp
-      (setq tem (car comp)
-	    comp (cdr comp))
-      (cond ((and (backup-file-name-p tem)
-                  (string= (file-name-sans-versions tem) file))
-             (setq tem (concat dir tem))
-             (if (or (null newest)
-                     (file-newer-than-file-p tem newest))
-                 (setq newest tem)))))
-    newest))
-
-(defun rename-uniquely ()
-  "Rename current buffer to a similar name not already taken.
-This function is useful for creating multiple shell process buffers
-or multiple mail buffers, etc."
-  (interactive)
-  (save-match-data
-    (let* ((base-name (if (and (string-match "<[0-9]+>\\'" (buffer-name))
-			       (not (and buffer-file-name
-					 (string= (buffer-name)
-						  (file-name-nondirectory
-						   buffer-file-name)))))
-			  ;; If the existing buffer name has a <NNN>,
-			  ;; which isn't part of the file name (if any),
-			  ;; then get rid of that.
-			  (substring (buffer-name) 0 (match-beginning 0))
-			(buffer-name)))
-	   (new-buf (generate-new-buffer base-name))
-	   (name (buffer-name new-buf)))
-      (kill-buffer new-buf)
-      (rename-buffer name)
-      (force-mode-line-update))))
-
-(defun make-directory (dir &optional parents)
-  "Create the directory DIR and any nonexistent parent dirs.
-Interactively, the default choice of directory to create
-is the current default directory for file names.
-That is useful when you have visited a file in a nonexistent directory.
-
-Noninteractively, the second (optional) argument PARENTS says whether
-to create parent directories if they don't exist."
-  (interactive
-   (list (read-file-name "Make directory: " default-directory default-directory
-			 nil nil)
-	 t))
-  (let ((handler (find-file-name-handler dir 'make-directory)))
-    (if handler
-	(funcall handler 'make-directory dir parents)
-      (if (not parents)
-	  (make-directory-internal dir)
-	(let ((dir (directory-file-name (expand-file-name dir)))
-	      create-list)
-	  (while (not (file-exists-p dir))
-	    (setq create-list (cons dir create-list)
-		  dir (directory-file-name (file-name-directory dir))))
-	  (while create-list
-	    (make-directory-internal (car create-list))
-	    (setq create-list (cdr create-list))))))))
-
-(put 'revert-buffer-function 'permanent-local t)
-(defvar revert-buffer-function nil
-  "Function to use to revert this buffer, or nil to do the default.
-The function receives two arguments IGNORE-AUTO and NOCONFIRM,
-which are the arguments that `revert-buffer' received.")
-
-(put 'revert-buffer-insert-file-contents-function 'permanent-local t)
-(defvar revert-buffer-insert-file-contents-function nil
-  "Function to use to insert contents when reverting this buffer.
-Gets two args, first the nominal file name to use,
-and second, t if reading the auto-save file.")
-
-(defvar before-revert-hook nil
-  "Normal hook for `revert-buffer' to run before reverting.
-If `revert-buffer-function' is used to override the normal revert
-mechanism, this hook is not used.")
-
-(defvar after-revert-hook nil
-  "Normal hook for `revert-buffer' to run after reverting.
-Note that the hook value that it runs is the value that was in effect
-before reverting; that makes a difference if you have buffer-local
-hook functions.
-
-If `revert-buffer-function' is used to override the normal revert
-mechanism, this hook is not used.")
-
-(defun revert-buffer (&optional ignore-auto noconfirm preserve-modes)
-  "Replace current buffer text with the text of the visited file on disk.
-This undoes all changes since the file was visited or saved.
-With a prefix argument, offer to revert from latest auto-save file, if
-that is more recent than the visited file.
-
-This command also works for special buffers that contain text which
-doesn't come from a file, but reflects some other data base instead:
-for example, Dired buffers and buffer-list buffers.  In these cases,
-it reconstructs the buffer contents from the appropriate data base.
-
-When called from Lisp, the first argument is IGNORE-AUTO; only offer
-to revert from the auto-save file when this is nil.  Note that the
-sense of this argument is the reverse of the prefix argument, for the
-sake of backward compatibility.  IGNORE-AUTO is optional, defaulting
-to nil.
-
-Optional second argument NOCONFIRM means don't ask for confirmation at
-all.
-
-Optional third argument PRESERVE-MODES non-nil means don't alter
-the files modes.  Normally we reinitialize them using `normal-mode'.
-
-If the value of `revert-buffer-function' is non-nil, it is called to
-do all the work for this command.  Otherwise, the hooks
-`before-revert-hook' and `after-revert-hook' are run at the beginning
-and the end, and if `revert-buffer-insert-file-contents-function' is
-non-nil, it is called instead of rereading visited file contents."
-
-  ;; I admit it's odd to reverse the sense of the prefix argument, but
-  ;; there is a lot of code out there which assumes that the first
-  ;; argument should be t to avoid consulting the auto-save file, and
-  ;; there's no straightforward way to encourage authors to notice a
-  ;; reversal of the argument sense.  So I'm just changing the user
-  ;; interface, but leaving the programmatic interface the same.
-  (interactive (list (not current-prefix-arg)))
-  (if revert-buffer-function
-      (funcall revert-buffer-function ignore-auto noconfirm)
-    (let* ((opoint (point))
-	   (auto-save-p (and (not ignore-auto)
-			     (recent-auto-save-p)
-			     buffer-auto-save-file-name
-			     (file-readable-p buffer-auto-save-file-name)
-			     (y-or-n-p
-   "Buffer has been auto-saved recently.  Revert from auto-save file? ")))
-	   (file-name (if auto-save-p
-			  buffer-auto-save-file-name
-			buffer-file-name)))
-      (cond ((null file-name)
-	     (error "Buffer does not seem to be associated with any file"))
-	    ((or noconfirm
-		 (yes-or-no-p (format "Revert buffer from file %s? "
-				      file-name)))
-	     (run-hooks 'before-revert-hook)
-	     ;; If file was backed up but has changed since,
-	     ;; we shd make another backup.
-	     (and (not auto-save-p)
-		  (not (verify-visited-file-modtime (current-buffer)))
-		  (setq buffer-backed-up nil))
-	     ;; Get rid of all undo records for this buffer.
-	     (or (eq buffer-undo-list t)
-		 (setq buffer-undo-list nil))
-	     ;; Effectively copy the after-revert-hook status,
-	     ;; since after-find-file will clobber it.
-	     (let ((global-hook (default-value 'after-revert-hook))
-		   (local-hook-p (local-variable-p 'after-revert-hook))
-		   (local-hook (and (local-variable-p 'after-revert-hook)
-				    after-revert-hook)))
-	       (let (buffer-read-only
-		     ;; Don't make undo records for the reversion.
-		     (buffer-undo-list t))
-		 (if revert-buffer-insert-file-contents-function
-		     (funcall revert-buffer-insert-file-contents-function
-			      file-name auto-save-p)
-		   (if (not (file-exists-p file-name))
-		       (error "File %s no longer exists!" file-name))
-		   ;; Bind buffer-file-name to nil
-		   ;; so that we don't try to lock the file.
-		   (let ((buffer-file-name nil))
-		     (or auto-save-p
-			 (unlock-buffer)))
-		   (widen)
-		   (insert-file-contents file-name (not auto-save-p)
-					 nil nil t)))
-	       (goto-char (min opoint (point-max)))
-	       ;; Recompute the truename in case changes in symlinks
-	       ;; have changed the truename.
-	       (setq buffer-file-truename
-		     (abbreviate-file-name (file-truename buffer-file-name)))
-	       (after-find-file nil nil t t preserve-modes)
-	       ;; Run after-revert-hook as it was before we reverted.
-	       (setq-default revert-buffer-internal-hook global-hook)
-	       (if local-hook-p
-		   (progn
-		     (make-local-variable 'revert-buffer-internal-hook)
-		     (setq revert-buffer-internal-hook local-hook))
-		 (kill-local-variable 'revert-buffer-internal-hook))
-	       (run-hooks 'revert-buffer-internal-hook))
-	     t)))))
-
-(defun recover-file (file)
-  "Visit file FILE, but get contents from its last auto-save file."
-  ;; Actually putting the file name in the minibuffer should be used
-  ;; only rarely.
-  ;; Not just because users often use the default.
-  (interactive "FRecover file: ")
-  (setq file (expand-file-name file))
-  (if (auto-save-file-name-p (file-name-nondirectory file))
-      (error "%s is an auto-save file" file))
-  (let ((file-name (let ((buffer-file-name file))
-		     (make-auto-save-file-name))))
-    (cond ((if (file-exists-p file)
-	       (not (file-newer-than-file-p file-name file))
-	     (not (file-exists-p file-name)))
-	   (error "Auto-save file %s not current" file-name))
-	  ((save-window-excursion
-	     (if (not (eq system-type 'vax-vms))
-		 (with-output-to-temp-buffer "*Directory*"
-		   (buffer-disable-undo standard-output)
-		   (call-process "ls" nil standard-output nil
-				 (if (file-symlink-p file) "-lL" "-l")
-				 file file-name)))
-	     (yes-or-no-p (format "Recover auto save file %s? " file-name)))
-	   (switch-to-buffer (find-file-noselect file t))
-	   (let ((buffer-read-only nil))
-	     (erase-buffer)
-	     (insert-file-contents file-name nil))
-	   (after-find-file nil nil t))
-	  (t (error "Recover-file cancelled.")))))
-
-(defun recover-session ()
-  "Recover auto save files from a previous Emacs session.
-This command first displays a Dired buffer showing you the
-previous sessions that you could recover from.
-To choose one, move point to the proper line and then type C-c C-c.
-Then you'll be asked about a number of files to recover."
-  (interactive)
-  (if (null auto-save-list-file-prefix)
-      (error "You set `auto-save-list-file-prefix' to disable making session files"))
-  (let ((ls-lisp-support-shell-wildcards t))
-    (dired (concat auto-save-list-file-prefix "*")))
-  (goto-char (point-min))
-  (or (looking-at "Move to the session you want to recover,")
-      (let ((inhibit-read-only t))
-	(insert "Move to the session you want to recover,\n"
-		"then type C-c C-c to select it.\n\n"
-		"You can also delete some of these files;\n"
-		"type d on a line to mark that file for deletion.\n\n")))
-  (use-local-map (nconc (make-sparse-keymap) (current-local-map)))
-  (define-key (current-local-map) "\C-c\C-c" 'recover-session-finish))
-
-(defun recover-session-finish ()
-  "Choose one saved session to recover auto-save files from.
-This command is used in the special Dired buffer created by
-\\[recover-session]."
-  (interactive)
-  ;; Get the name of the session file to recover from.
-  (let ((file (dired-get-filename))
-	files
-	(buffer (get-buffer-create " *recover*")))
-    (dired-do-flagged-delete t)
-    (unwind-protect
-	(save-excursion
-	  ;; Read in the auto-save-list file.
-	  (set-buffer buffer)
-	  (erase-buffer)
-	  (insert-file-contents file)
-	  ;; Loop thru the text of that file
-	  ;; and get out the names of the files to recover.
-	  (while (not (eobp))
-	    (let (thisfile autofile)
-	      (if (eolp)
-		  ;; This is a pair of lines for a non-file-visiting buffer.
-		  ;; Get the auto-save file name and manufacture
-		  ;; a "visited file name" from that.
-		  (progn
-		    (forward-line 1)
-		    (setq autofile
-			  (buffer-substring-no-properties
-			   (point)
-			   (save-excursion
-			     (end-of-line)
-			     (point))))
-		    (setq thisfile
-			  (expand-file-name
-			   (substring
-			    (file-name-nondirectory autofile)
-			    1 -1)
-			   (file-name-directory autofile)))
-		    (forward-line 1))
-		;; This pair of lines is a file-visiting
-		;; buffer.  Use the visited file name.
-		(progn
-		  (setq thisfile
-			(buffer-substring-no-properties
-			 (point) (progn (end-of-line) (point))))
-		  (forward-line 1)
-		  (setq autofile
-			(buffer-substring-no-properties
-			 (point) (progn (end-of-line) (point))))
-		  (forward-line 1)))
-	      ;; Ignore a file if its auto-save file does not exist now.
-	      (if (file-exists-p autofile)
-		  (setq files (cons thisfile files)))))
-	  (setq files (nreverse files))
-	  ;; The file contains a pair of line for each auto-saved buffer.
-	  ;; The first line of the pair contains the visited file name
-	  ;; or is empty if the buffer was not visiting a file.
-	  ;; The second line is the auto-save file name.
-	  (if files
-	      (map-y-or-n-p  "Recover %s? "
-			     (lambda (file)
-			       (condition-case nil
-				   (save-excursion (recover-file file))
-				 (error
-				  "Failed to recover `%s'" file)))
-			     files
-			     '("file" "files" "recover"))
-	    (message "No files can be recovered from this session now")))
-      (kill-buffer buffer))))
-
-(defun kill-some-buffers (&optional list)
-  "For each buffer in LIST, ask whether to kill it.
-LIST defaults to all existing live buffers."
-  (interactive)
-  (if (null list)
-      (setq list (buffer-list)))
-  (while list
-    (let* ((buffer (car list))
-	   (name (buffer-name buffer)))
-      (and (not (string-equal name ""))
-	   (/= (aref name 0) ? )
-	   (yes-or-no-p
-	    (format "Buffer %s %s.  Kill? "
-		    name
-		    (if (buffer-modified-p buffer)
-			"HAS BEEN EDITED" "is unmodified")))
-	   (kill-buffer buffer)))
-    (setq list (cdr list))))
-
-(defun auto-save-mode (arg)
-  "Toggle auto-saving of contents of current buffer.
-With prefix argument ARG, turn auto-saving on if positive, else off."
-  (interactive "P")
-  (setq buffer-auto-save-file-name
-        (and (if (null arg)
-		 (or (not buffer-auto-save-file-name)
-		     ;; If autosave is off because buffer has shrunk,
-		     ;; then toggling should turn it on.
-		     (< buffer-saved-size 0))
-	       (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))
-	     (if (and buffer-file-name auto-save-visited-file-name
-		      (not buffer-read-only))
-		 buffer-file-name
-	       (make-auto-save-file-name))))
-  ;; If -1 was stored here, to temporarily turn off saving,
-  ;; turn it back on.
-  (and (< buffer-saved-size 0)
-       (setq buffer-saved-size 0))
-  (if (interactive-p)
-      (message "Auto-save %s (in this buffer)"
-	       (if buffer-auto-save-file-name "on" "off")))
-  buffer-auto-save-file-name)
-
-(defun rename-auto-save-file ()
-  "Adjust current buffer's auto save file name for current conditions.
-Also rename any existing auto save file, if it was made in this session."
-  (let ((osave buffer-auto-save-file-name))
-    (setq buffer-auto-save-file-name
-	  (make-auto-save-file-name))
-    (if (and osave buffer-auto-save-file-name
-	     (not (string= buffer-auto-save-file-name buffer-file-name))
-	     (not (string= buffer-auto-save-file-name osave))
-	     (file-exists-p osave)
-	     (recent-auto-save-p))
-	(rename-file osave buffer-auto-save-file-name t))))
-
-(defun make-auto-save-file-name ()
-  "Return file name to use for auto-saves of current buffer.
-Does not consider `auto-save-visited-file-name' as that variable is checked
-before calling this function.  You can redefine this for customization.
-See also `auto-save-file-name-p'."
-  (if buffer-file-name
-      (if (and (eq system-type 'ms-dos)
-	       (not (msdos-long-file-names)))
-	  (let ((fn (file-name-nondirectory buffer-file-name)))
-		(string-match "\\`\\([^.]+\\)\\(\\.\\(..?\\)?.?\\|\\)\\'" fn)
-	    (concat (file-name-directory buffer-file-name)
-		    "#" (match-string 1 fn) 
-		    "." (match-string 3 fn) "#"))
-	(concat (file-name-directory buffer-file-name)
-		"#"
-		(file-name-nondirectory buffer-file-name)
-		"#"))
-
-    ;; Deal with buffers that don't have any associated files.  (Mail
-    ;; mode tends to create a good number of these.)
-
-    (let ((buffer-name (buffer-name))
-	  (limit 0))
-      ;; Use technique from Sebastian Kremer's auto-save
-      ;; package to turn slashes into \\!.  This ensures that
-      ;; the auto-save buffer name is unique.
-
-      (while (string-match "[/\\]" buffer-name limit)
-	(setq buffer-name (concat (substring buffer-name 0 (match-beginning 0))
-			(if (string= (substring buffer-name
-						(match-beginning 0)
-						(match-end 0))
-				     "/")
-			    "\\!"
-			  "\\\\")
-			(substring buffer-name (match-end 0))))
-	(setq limit (1+ (match-end 0))))
-      ;; Generate the file name.
-      (expand-file-name
-       (format "#%s#%s#" buffer-name (make-temp-name ""))
-       ;; Try a few alternative directories, to get one we can write it.
-       (cond
-	((file-writable-p default-directory) default-directory)
-	((file-writable-p "/var/tmp/") "/var/tmp/")
-	("~/"))))))
-
-(defun auto-save-file-name-p (filename)
-  "Return non-nil if FILENAME can be yielded by `make-auto-save-file-name'.
-FILENAME should lack slashes.  You can redefine this for customization."
-  (string-match "^#.*#$" filename))
-
-(defun wildcard-to-regexp (wildcard)
-  "Given a shell file name pattern WILDCARD, return an equivalent regexp.
-The generated regexp will match a filename iff the filename
-matches that wildcard according to shell rules.  Only wildcards known
-by `sh' are supported."
-  (let* ((i (string-match "[[.*+\\^$?]" wildcard))
-	 ;; Copy the initial run of non-special characters.
-	 (result (substring wildcard 0 i))
-	 (len (length wildcard)))
-    ;; If no special characters, we're almost done.
-    (if i
-	(while (< i len)
-	  (let ((ch (aref wildcard i))
-		j)
-	    (setq
-	     result
-	     (concat result
-		     (cond
-		      ((and (eq ch ?\[)
-			    (< (1+ i) len)
-			    (eq (aref wildcard (1+ i)) ?\]))
-		       "\\[")
-		      ((eq ch ?\[)	; [...] maps to regexp char class
-		       (progn
-			 (setq i (1+ i))
-			 (concat
-			  (cond
-			   ((eq (aref wildcard i) ?!) ; [!...] -> [^...]
-			    (progn
-			      (setq i (1+ i))
-			      (if (eq (aref wildcard i) ?\])
-				  (progn
-				    (setq i (1+ i))
-				    "[^]")
-				"[^")))
-			   ((eq (aref wildcard i) ?^)
-			    ;; Found "[^".  Insert a `\0' character
-			    ;; (which cannot happen in a filename)
-			    ;; into the character class, so that `^'
-			    ;; is not the first character after `[',
-			    ;; and thus non-special in a regexp.
-			    (progn
-			      (setq i (1+ i))
-			      "[\000^"))
-			   ((eq (aref wildcard i) ?\])
-			    ;; I don't think `]' can appear in a
-			    ;; character class in a wildcard, but
-			    ;; let's be general here.
-			    (progn
-			      (setq i (1+ i))
-			      "[]"))
-			   (t "["))
-			  (prog1	; copy everything upto next `]'.
-			      (substring wildcard
-					 i
-					 (setq j (string-match
-						  "]" wildcard i)))
-			    (setq i (if j (1- j) (1- len)))))))
-		      ((eq ch ?.)  "\\.")
-		      ((eq ch ?*)  "[^\000]*")
-		      ((eq ch ?+)  "\\+")
-		      ((eq ch ?^)  "\\^")
-		      ((eq ch ?$)  "\\$")
-		      ((eq ch ?\\) "\\\\") ; probably cannot happen...
-		      ((eq ch ??)  "[^\000]")
-		      (t (char-to-string ch)))))
-	    (setq i (1+ i)))))
-    ;; Shell wildcards should match the entire filename,
-    ;; not its part.  Make the regexp say so.
-    (concat "\\`" result "\\'")))
-
-(defvar list-directory-brief-switches
-  (if (eq system-type 'vax-vms) "" "-CF")
-  "*Switches for list-directory to pass to `ls' for brief listing,")
-
-(defvar list-directory-verbose-switches
-  (if (eq system-type 'vax-vms)
-      "/PROTECTION/SIZE/DATE/OWNER/WIDTH=(OWNER:10)"
-    "-l")
-  "*Switches for list-directory to pass to `ls' for verbose listing,")
-
-(defun list-directory (dirname &optional verbose)
-  "Display a list of files in or matching DIRNAME, a la `ls'.
-DIRNAME is globbed by the shell if necessary.
-Prefix arg (second arg if noninteractive) means supply -l switch to `ls'.
-Actions controlled by variables `list-directory-brief-switches'
-and `list-directory-verbose-switches'."
-  (interactive (let ((pfx current-prefix-arg))
-		 (list (read-file-name (if pfx "List directory (verbose): "
-					 "List directory (brief): ")
-				       nil default-directory nil)
-		       pfx)))
-  (let ((switches (if verbose list-directory-verbose-switches
-		    list-directory-brief-switches)))
-    (or dirname (setq dirname default-directory))
-    (setq dirname (expand-file-name dirname))
-    (with-output-to-temp-buffer "*Directory*"
-      (buffer-disable-undo standard-output)
-      (princ "Directory ")
-      (princ dirname)
-      (terpri)
-      (save-excursion
-	(set-buffer "*Directory*")
-	(setq default-directory
-	      (if (file-directory-p dirname)
-		  (file-name-as-directory dirname)
-		(file-name-directory dirname)))
-	(let ((wildcard (not (file-directory-p dirname))))
-	  (insert-directory dirname switches wildcard (not wildcard)))))))
-
-(defvar insert-directory-program "ls"
-  "Absolute or relative name of the `ls' program used by `insert-directory'.")
-
-;; insert-directory
-;; - must insert _exactly_one_line_ describing FILE if WILDCARD and
-;;   FULL-DIRECTORY-P is nil.
-;;   The single line of output must display FILE's name as it was
-;;   given, namely, an absolute path name.
-;; - must insert exactly one line for each file if WILDCARD or
-;;   FULL-DIRECTORY-P is t, plus one optional "total" line
-;;   before the file lines, plus optional text after the file lines.
-;;   Lines are delimited by "\n", so filenames containing "\n" are not
-;;   allowed.
-;;   File lines should display the basename.
-;; - must be consistent with
-;;   - functions dired-move-to-filename, (these two define what a file line is)
-;;   		 dired-move-to-end-of-filename,
-;;		 dired-between-files, (shortcut for (not (dired-move-to-filename)))
-;;   		 dired-insert-headerline
-;;   		 dired-after-subdir-garbage (defines what a "total" line is)
-;;   - variable dired-subdir-regexp
-(defun insert-directory (file switches &optional wildcard full-directory-p)
-  "Insert directory listing for FILE, formatted according to SWITCHES.
-Leaves point after the inserted text.
-SWITCHES may be a string of options, or a list of strings.
-Optional third arg WILDCARD means treat FILE as shell wildcard.
-Optional fourth arg FULL-DIRECTORY-P means file is a directory and
-switches do not contain `d', so that a full listing is expected.
-
-This works by running a directory listing program
-whose name is in the variable `insert-directory-program'.
-If WILDCARD, it also runs the shell specified by `shell-file-name'."
-  ;; We need the directory in order to find the right handler.
-  (let ((handler (find-file-name-handler (expand-file-name file)
-					 'insert-directory)))
-    (if handler
-	(funcall handler 'insert-directory file switches
-		 wildcard full-directory-p)
-      (if (eq system-type 'vax-vms)
-	  (vms-read-directory file switches (current-buffer))
-	(or (= 0
-	       (if wildcard
-		   ;; Run ls in the directory of the file pattern we asked for.
-		   (let ((default-directory
-			   (if (file-name-absolute-p file)
-			       (file-name-directory file)
-			     (file-name-directory (expand-file-name file))))
-			 (pattern (file-name-nondirectory file))
-			 (beg 0))
-		     ;; Quote some characters that have special meanings in shells;
-		     ;; but don't quote the wildcards--we want them to be special.
-		     ;; We also currently don't quote the quoting characters
-		     ;; in case people want to use them explicitly to quote
-		     ;; wildcard characters.
-		     (while (string-match "[ \t\n;<>&|()#$]" pattern beg)
-		       (setq pattern
-			     (concat (substring pattern 0 (match-beginning 0))
-				     "\\"
-				     (substring pattern (match-beginning 0)))
-			     beg (1+ (match-end 0))))
-		     (call-process shell-file-name nil t nil
-				   "-c" (concat "\\"  ;; Disregard shell aliases!
-						insert-directory-program
-						" -d "
-						(if (stringp switches)
-						    switches
-						  (mapconcat 'identity switches " "))
-						" -- "
-						pattern)))
-		 ;; SunOS 4.1.3, SVr4 and others need the "." to list the
-		 ;; directory if FILE is a symbolic link.
-		 (apply 'call-process
-			insert-directory-program nil t nil
-			(let (list)
-			  (if (listp switches)
-			      (setq list switches)
-			    (if (not (equal switches ""))
-				(progn
-				  ;; Split the switches at any spaces
-				  ;; so we can pass separate options as separate args.
-				  (while (string-match " " switches)
-				    (setq list (cons (substring switches 0 (match-beginning 0))
-						     list)
-					  switches (substring switches (match-end 0))))
-				  (setq list (nreverse (cons switches list))))))
-			  (append list
-				  ;; Avoid lossage if FILE starts with `-'.
-				  '("--")
-				  (list
-				   (if full-directory-p
-				       (concat (file-name-as-directory file) ".")
-				     file)))))))
-	    ;; We get here if ls failed.
-	    ;; Access the file to get a suitable error.
-	    (access-file file "Reading directory"))))))
-
-(defvar kill-emacs-query-functions nil
-  "Functions to call with no arguments to query about killing Emacs.
-If any of these functions returns nil, killing Emacs is cancelled.
-`save-buffers-kill-emacs' (\\[save-buffers-kill-emacs]) calls these functions,
-but `kill-emacs', the low level primitive, does not.
-See also `kill-emacs-hook'.")
-
-(defun save-buffers-kill-emacs (&optional arg)
-  "Offer to save each buffer, then kill this Emacs process.
-With prefix arg, silently save all file-visiting buffers, then kill."
-  (interactive "P")
-  (save-some-buffers arg t)
-  (and (or (not (memq t (mapcar (function
-				  (lambda (buf) (and (buffer-file-name buf)
-						     (buffer-modified-p buf))))
-				(buffer-list))))
-	   (yes-or-no-p "Modified buffers exist; exit anyway? "))
-       (or (not (fboundp 'process-list))
-	   ;; process-list is not defined on VMS.
-	   (let ((processes (process-list))
-		 active)
-	     (while processes
-	       (and (memq (process-status (car processes)) '(run stop open))
-		    (let ((val (process-kill-without-query (car processes))))
-		      (process-kill-without-query (car processes) val)
-		      val)
-		    (setq active t))
-	       (setq processes (cdr processes)))
-	     (or (not active)
-		 (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
-       ;; Query the user for other things, perhaps.
-       (run-hook-with-args-until-failure 'kill-emacs-query-functions)
-       (kill-emacs)))
-
-;; We use /: as a prefix to "quote" a file name 
-;; so that magic file name handlers will not apply to it.
-
-(setq file-name-handler-alist
-      (cons '("\\`/:" . file-name-non-special)
-	    file-name-handler-alist))
-
-;; We depend on being the last handler on the list,
-;; so that anything else which does need handling
-;; has been handled already.
-;; So it is safe for us to inhibit *all* magic file name handlers.
-
-(defun file-name-non-special (operation &rest arguments)
-  (let ((file-name-handler-alist nil)
-	;; Get a list of the indices of the args which are file names.
-	(file-arg-indices
-	 (cdr (or (assq operation
-			;; The first four are special because they
-			;; return a file name.  We want to include the /:
-			;; in the return value.
-			;; So just avoid stripping it in the first place.
-			'((expand-file-name . nil)
-			  (file-name-directory . nil)
-			  (file-name-as-directory . nil)
-			  (directory-file-name . nil)
-			  (rename-file 0 1)
-			  (copy-file 0 1)
-			  (make-symbolic-link 0 1)
-			  (add-name-to-file 0 1)))
-		  ;; For all other operations, treat the first argument only
-		  ;; as the file name.
-		  '(nil 0))))
-	;; Copy ARGUMENTS so we can replace elements in it.
-	(arguments (copy-sequence arguments)))
-    ;; Strip off the /: from the file names that have this handler.
-    (save-match-data
-      (while file-arg-indices
-	(and (nth (car file-arg-indices) arguments)
-	     (string-match "\\`/:" (nth (car file-arg-indices) arguments))
-	     (setcar (nthcdr (car file-arg-indices) arguments)
-		     (substring (nth (car file-arg-indices) arguments) 2)))
-	(setq file-arg-indices (cdr file-arg-indices))))
-    (apply operation arguments)))
-
-(define-key ctl-x-map "\C-f" 'find-file)
-(define-key ctl-x-map "\C-q" 'toggle-read-only)
-(define-key ctl-x-map "\C-r" 'find-file-read-only)
-(define-key ctl-x-map "\C-v" 'find-alternate-file)
-(define-key ctl-x-map "\C-s" 'save-buffer)
-(define-key ctl-x-map "s" 'save-some-buffers)
-(define-key ctl-x-map "\C-w" 'write-file)
-(define-key ctl-x-map "i" 'insert-file)
-(define-key esc-map "~" 'not-modified)
-(define-key ctl-x-map "\C-d" 'list-directory)
-(define-key ctl-x-map "\C-c" 'save-buffers-kill-emacs)
-
-(define-key ctl-x-4-map "f" 'find-file-other-window)
-(define-key ctl-x-4-map "r" 'find-file-read-only-other-window)
-(define-key ctl-x-4-map "\C-f" 'find-file-other-window)
-(define-key ctl-x-4-map "b" 'switch-to-buffer-other-window)
-(define-key ctl-x-4-map "\C-o" 'display-buffer)
-
-(define-key ctl-x-5-map "b" 'switch-to-buffer-other-frame)
-(define-key ctl-x-5-map "f" 'find-file-other-frame)
-(define-key ctl-x-5-map "\C-f" 'find-file-other-frame)
-(define-key ctl-x-5-map "r" 'find-file-read-only-other-frame)
-
-;;; files.el ends here
diff --git a/lisp/find-dired.el b/lisp/find-dired.el
deleted file mode 100644
index a46c6c65150..00000000000
--- a/lisp/find-dired.el
+++ /dev/null
@@ -1,212 +0,0 @@
-;;; find-dired.el --- run a `find' command and dired the output
-
-;; Copyright (C) 1992, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Roland McGrath <roland@gnu.ai.mit.edu>,
-;;	   Sebastian Kremer <sk@thp.uni-koeln.de>
-;; Keywords: unix
-
-;; 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.
-
-;;; Code:
-
-(require 'dired)
-
-;; find's -ls corresponds to these switches.
-;; Note -b, at least GNU find quotes spaces etc. in filenames
-;;;###autoload
-(defvar find-ls-option (if (eq system-type 'berkeley-unix) '("-ls" . "-gilsb")
-			 '("-exec ls -ld {} \\;" . "-ld"))
-  "*Description of the option to `find' to produce an `ls -l'-type listing.
-This is a cons of two strings (FIND-OPTION . LS-SWITCHES).  FIND-OPTION
-gives the option (or options) to `find' that produce the desired output.
-LS-SWITCHES is a list of `ls' switches to tell dired how to parse the output.")
-
-;;;###autoload
-(defvar find-grep-options
-  (if (or (eq system-type 'berkeley-unix)
-	  (string-match "solaris2" system-configuration)
-	  (string-match "irix" system-configuration))
-      "-s" "-q")
-  "*Option to grep to be as silent as possible.
-On Berkeley systems, this is `-s'; on Posix, and with GNU grep, `-q' does it.
-On other systems, the closest you can come is to use `-l'.")
-
-(defvar find-args nil
-  "Last arguments given to `find' by \\[find-dired].")
-
-;; History of find-args values entered in the minibuffer.
-(defvar find-args-history nil)
-
-;;;###autoload
-(defun find-dired (dir args)
-  "Run `find' and go into dired-mode on a buffer of the output.
-The command run (after changing into DIR) is
-
-    find . \\( ARGS \\) -ls
-
-except that the variable `find-ls-option' specifies what to use
-as the final argument."
-  (interactive (list (read-file-name "Run find in directory: " nil "" t)
-		     (read-string "Run find (with args): " find-args
-				  '(find-args-history . 1))))
-  ;; Expand DIR ("" means default-directory), and make sure it has a
-  ;; trailing slash.
-  (setq dir (file-name-as-directory (expand-file-name dir)))
-  ;; Check that it's really a directory.
-  (or (file-directory-p dir)
-      (error "find-dired needs a directory: %s" dir))
-  (switch-to-buffer (get-buffer-create "*Find*"))
-  (widen)
-  (kill-all-local-variables)
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  (setq default-directory dir
-	find-args args			; save for next interactive call
-	args (concat "find . "
-		     (if (string= args "")
-			 ""
-		       (concat "\\( " args " \\) "))
-		     (car find-ls-option)))
-  ;; The next statement will bomb in classic dired (no optional arg allowed)
-  (dired-mode dir (cdr find-ls-option))
-  ;; This really should rerun the find command, but I don't
-  ;; have time for that.
-  (use-local-map (append (make-sparse-keymap) (current-local-map)))
-  (define-key (current-local-map) "g" 'undefined)
-  ;; Set subdir-alist so that Tree Dired will work:
-  (if (fboundp 'dired-simple-subdir-alist)
-      ;; will work even with nested dired format (dired-nstd.el,v 1.15
-      ;; and later)
-      (dired-simple-subdir-alist)
-    ;; else we have an ancient tree dired (or classic dired, where
-    ;; this does no harm) 
-    (set (make-local-variable 'dired-subdir-alist)
-	 (list (cons default-directory (point-min-marker)))))
-  (setq buffer-read-only nil)
-  ;; Subdir headlerline must come first because the first marker in
-  ;; subdir-alist points there.
-  (insert "  " dir ":\n")
-  ;; Make second line a ``find'' line in analogy to the ``total'' or
-  ;; ``wildcard'' line. 
-  (insert "  " args "\n")
-  ;; Start the find process.
-  (let ((proc (start-process-shell-command "find" (current-buffer) args)))
-    (set-process-filter proc (function find-dired-filter))
-    (set-process-sentinel proc (function find-dired-sentinel))
-    ;; Initialize the process marker; it is used by the filter.
-    (move-marker (process-mark proc) 1 (current-buffer)))
-  (setq mode-line-process '(":%s")))
-
-;;;###autoload
-(defun find-name-dired (dir pattern)
-  "Search DIR recursively for files matching the globbing pattern PATTERN,
-and run dired on those files.
-PATTERN is a shell wildcard (not an Emacs regexp) and need not be quoted.
-The command run (after changing into DIR) is
-
-    find . -name 'PATTERN' -ls"
-  (interactive
-   "DFind-name (directory): \nsFind-name (filename wildcard): ")
-  (find-dired dir (concat "-name '" pattern "'")))
-
-;; This functionality suggested by
-;; From: oblanc@watcgl.waterloo.edu (Olivier Blanc)
-;; Subject: find-dired, lookfor-dired
-;; Date: 10 May 91 17:50:00 GMT
-;; Organization: University of Waterloo
-
-(defalias 'lookfor-dired 'find-grep-dired)
-;;;###autoload
-(defun find-grep-dired (dir args)
-  "Find files in DIR containing a regexp ARG and start Dired on output.
-The command run (after changing into DIR) is
-
-    find . -exec grep -s ARG {} \\\; -ls
-
-Thus ARG can also contain additional grep options."
-  (interactive "DFind-grep (directory): \nsFind-grep (grep regexp): ")
-  ;; find -exec doesn't allow shell i/o redirections in the command,
-  ;; or we could use `grep -l >/dev/null'
-  (find-dired dir
-	      (concat "! -type d -exec grep " find-grep-options " "
-		      args " {} \\\; ")))
-
-(defun find-dired-filter (proc string)
-  ;; Filter for \\[find-dired] processes.
-  (let ((buf (process-buffer proc)))
-    (if (buffer-name buf)		; not killed?
-	(save-excursion
-	  (set-buffer buf)
-	  (save-restriction
-	    (widen)
-	    (save-excursion
-	      (let ((buffer-read-only nil)
-		    (end (point-max)))
-		(goto-char end)
-		(insert string)
-		(goto-char end)
-		(or (looking-at "^")
-		    (forward-line 1))
-		(while (looking-at "^")
-		  (insert "  ")
-		  (forward-line 1))
-		;; Convert ` ./FILE' to ` FILE'
-		;; This would lose if the current chunk of output
-		;; starts or ends within the ` ./', so back up a bit:
-		(goto-char (- end 3))	; no error if < 0
-		(while (search-forward " ./" nil t)
-		  (delete-region (point) (- (point) 2)))
-		;; Find all the complete lines in the unprocessed
-		;; output and process it to add text properties.
-		(goto-char end)
-		(if (search-backward "\n" (process-mark proc) t)
-		    (progn
-		      (dired-insert-set-properties (process-mark proc)
-						   (1+ (point)))
-		      (move-marker (process-mark proc) (1+ (point)))))
-		))))
-      ;; The buffer has been killed.
-      (delete-process proc))))
-
-(defun find-dired-sentinel (proc state)
-  ;; Sentinel for \\[find-dired] processes.
-  (let ((buf (process-buffer proc)))
-    (if (buffer-name buf)
-	(save-excursion
-	  (set-buffer buf)
-	  (let ((buffer-read-only nil))
-	    (save-excursion
-	      (goto-char (point-max))
-	      (insert "\nfind " state)
-	      (forward-char -1)		;Back up before \n at end of STATE.
-	      (insert " at " (substring (current-time-string) 0 19))
-	      (forward-char 1)
-	      (setq mode-line-process
-		    (concat ":"
-			    (symbol-name (process-status proc))))
-	      ;; Since the buffer and mode line will show that the
-	      ;; process is dead, we can delete it now.  Otherwise it
-	      ;; will stay around until M-x list-processes.
-	      (delete-process proc)
-	      (force-mode-line-update)))
-	  (message "find-dired %s finished." (current-buffer))))))
-
-(provide 'find-dired)
-
-;;; find-dired.el ends here
diff --git a/lisp/find-file.el b/lisp/find-file.el
deleted file mode 100644
index b8aee680516..00000000000
--- a/lisp/find-file.el
+++ /dev/null
@@ -1,913 +0,0 @@
-;;; find-file.el --- find a file corresponding to this one given a pattern
-
-;; Author:         Henry Guillaume <henry@qbd.com.au>
-;; Keywords: c, matching, tools
-
-;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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:
-
-;; PURPOSE:
-;; This package features a function called ff-find-other-file, which performs 
-;; the following function: 
-;;
-;;     When in a .c file, find the first corresponding .h file in a set
-;;     of directories and display it, and vice-versa from the .h file.
-;;
-;; Many people maintain their include file in a directory separate to their
-;; src directory, and very often you may be editing a file and have a need to
-;; visit the "other file". This package searches through a set of directories
-;; to find that file.
-;;
-;; THE "OTHER FILE", or "corresponding file", generally has the same basename,
-;; and just has a different extension as described by the ff-other-file-alist 
-;; variable:
-;;
-;;   '(("\\.cc$"  (".hh" ".h"))
-;;     ("\\.hh$"  (".cc" ".C" ".CC" ".cxx" ".cpp")))
-;;
-;; If the current file has a .cc extension, ff-find-other-file will attempt
-;; to look for a .hh file, and then a .h file in some directory as described
-;; below. The mechanism here is to replace the matched part of the original
-;; filename with each of the corresponding extensions in turn.
-;;
-;; Alternatively, there are situations where the filename of the other file
-;; cannot be determined easily with regexps. For example, a .c file may
-;; have two corresponding .h files, for its public and private parts, or
-;; the filename for the .c file contains part of the pathname of the .h
-;; file, as between src/fooZap.cc and include/FOO/zap.hh. In that case, the
-;; format above can be changed to include a function to be called when the
-;; current file matches the regexp:
-;;
-;;   '(("\\.cc$"  cc-function)
-;;     ("\\.hh$"  hh-function))
-;;
-;; These functions must return a list consisting of the possible names of the 
-;; corresponding file, with or without path. There is no real need for more 
-;; than one function, and one could imagine the following value for cc-other-
-;; file-alist:
-;;
-;;    (setq cc-other-file-alist
-;;        '(("\\.cc$"  ff-cc-hh-converter)
-;;          ("\\.hh$"  ff-cc-hh-converter)
-;;          ("\\.c$"   (".h"))
-;;          ("\\.h$"   (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))))
-;; 
-;; ff-cc-hh-converter is included at the end of this file as a reference.
-;; 
-;; SEARCHING is carried out in a set of directories specified by the
-;; ff-search-directories variable:
-;;
-;;     ("." "../../src" "../include/*" "/usr/local/*/src/*" "$PROJECT/src")
-;;
-;; This means that the corresponding file will be searched for first in
-;; the current directory, then in ../../src, then in one of the directories
-;; under ../include, and so on. The star is _not_ a general wildcard
-;; character: it just indicates that the subdirectories of this directory
-;; must each be searched in turn. Environment variables will be expanded in
-;; the ff-search-directories variable.
-;;
-;; If the point is on a #include line, the file to be #included is searched
-;; for in the same manner. This can be disabled with the ff-ignore-include
-;; variable, or by calling ff-get-other-file instead of ff-find-other-file.
-;;
-;; If the file was not found, ff-find-other-file will prompt you for where
-;; to create the new "corresponding file" (defaults to the current directory),
-;; unless the variable ff-always-try-to-create is set to nil. 
-;;
-;; GIVEN AN ARGUMENT (with the ^U prefix), ff-find-other-file will get the 
-;; other file in another (the other?) window (see find-file-other-window and 
-;; switch-to-buffer-other-window). This can be set on a more permanent basis 
-;; by setting ff-always-in-other-window to t in which case the ^U prefix will 
-;; do the opposite of what was described above.
-;;
-;; THERE ARE FIVE AVAILABLE HOOKS, called in this order if non-nil:
-;;
-;; - ff-pre-find-hooks     - called before the search for the other file starts
-;; - ff-not-found-hooks    - called when the other file could not be found
-;; - ff-pre-load-hooks     - called just before the other file is 'loaded'
-;; - ff-file-created-hooks - called when the other file is created
-;; - ff-post-load-hooks    - called just after the other file is 'loaded'
-;;
-;; The *load-hooks allow you to place point where you want it in the other
-;; file. 
-
-;;; Change Log:
-;;
-;; FEEDBACK:
-;; Please send me bug reports, bug fixes, and extensions, so that I can
-;; merge them into the master source.
-
-;; CREDITS:
-;; Many thanks go to TUSC Computer Systems Pty Ltd for providing an environ-
-;; ment that made the development of this package possible.
-;;
-;; Many thanks also go to all those who provided valuable feedback throughout
-;; the development of this package:
-;;     Rolf Ebert in particular, Fritz Knabe, Heddy Boubaker, Sebastian Kremer,
-;;     Vasco Lopes Paulo, Mark A. Plaksin, Robert Lang, Trevor West, Kevin 
-;;     Pereira, Benedict Lofstedt & Justin Vallon.
-
-;;; Code:
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User definable variables:
-
-(defvar ff-pre-find-hooks nil
-  "*List of functions to be called before the search for the file starts.")
-
-(defvar ff-pre-load-hooks nil
-  "*List of functions to be called before the other file is loaded.")
-
-(defvar ff-post-load-hooks nil
-  "*List of functions to be called after the other file is loaded.")
-
-(defvar ff-not-found-hooks nil
-  "*List of functions to be called if the other file could not be found.")
-
-(defvar ff-file-created-hooks nil
-  "*List of functions to be called if the other file needs to be created.")
-
-(defvar ff-case-fold-search nil
-  "*Non-nil means ignore cases in matches (see `case-fold-search').
-If you have extensions in different cases, you will want this to be nil.")
-
-(defvar ff-always-in-other-window nil
-  "*If non-nil, find the corresponding file in another window by default.
-To override this, give an argument to `ff-find-other-file'.")
-
-(defvar ff-ignore-include nil
-  "*If non-nil, ignore `#include' lines.")
-
-(defvar ff-always-try-to-create t
-  "*If non-nil, always attempt to create the other file if it was not found.")
-
-(defvar ff-quiet-mode nil
-  "*If non-nil, trace which directories are being searched.")
-
-(defvar ff-special-constructs 
-  '(
-    ;; C/C++ include, for NeXTSTEP too
-    ("^\#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]" .
-     (lambda ()
-       (setq fname (buffer-substring (match-beginning 2) (match-end 2)))))
-
-    ;; Ada import
-    ("^with[ \t]+\\([a-zA-Z0-9_\\.]+\\)" .
-     (lambda ()
-       (setq fname (buffer-substring (match-beginning 1) (match-end 1)))
-       (require 'ada-mode)
-       (setq fname (concat (ada-make-filename-from-adaname fname)
-			   ada-spec-suffix))))
-    )
-  "*A list of regular expressions specifying how to recognise special 
-constructs such as include files etc, and an associated method for 
-extracting the filename from that construct.")
-
-(defvar ff-other-file-alist 'cc-other-file-alist
-  "*Alist of extensions to find given the current file's extension.
-
-This list should contain the most used extensions before the others,
-since the search algorithm searches sequentially through each
-directory specified in `ff-search-directories'.  If a file is not found,
-a new one is created with the first matching extension (`.cc' yields `.hh').
-This alist should be set by the major mode.")
-
-(defvar ff-search-directories 'cc-search-directories
-  "*List of directories to search for a specific file.
-
-Set by default to `cc-search-directories', expanded at run-time.
-
-This list is searched through with each extension specified in
-`ff-other-file-alist' that matches this file's extension.  So the
-longer the list, the longer it'll take to realise that a file
-may not exist.
-
-A typical format is 
-
-    '(\".\" \"/usr/include\" \"$PROJECT/*/include\")
-
-Environment variables can be inserted between slashes (`/').
-They will be replaced by their definition. If a variable does
-not exist, it is replaced (silently) with an empty string.
-
-The stars are *not* wildcards: they are searched for together with
-the preceding slash.  The star represents all the subdirectories except
-`..', and each of these subdirectories will be searched in turn.")
-
-(defvar cc-search-directories
-  '("." "/usr/include" "/usr/local/include/*")
-  "*See the description of the `ff-search-directories' variable.")
-
-(defvar cc-other-file-alist
-  '(
-    ("\\.cc$"  (".hh" ".h"))
-    ("\\.hh$"  (".cc" ".C"))
-
-    ("\\.c$"   (".h"))
-    ("\\.h$"   (".c" ".cc" ".C" ".CC" ".cxx" ".cpp"))
-
-    ("\\.C$"   (".H"  ".hh" ".h"))
-    ("\\.H$"   (".C"  ".CC"))
-
-    ("\\.CC$"  (".HH" ".H"  ".hh" ".h"))
-    ("\\.HH$"  (".CC"))
-
-    ("\\.cxx$" (".hh" ".h"))
-    ("\\.cpp$" (".hh" ".h"))
-    )
-  "*Alist of extensions to find given the current file's extension.
-
-This list should contain the most used extensions before the others,
-since the search algorithm searches sequentially through each directory
-specified in `ff-search-directories'.  If a file is not found, a new one
-is created with the first matching extension (`.cc' yields `.hh').")
-
-(defvar ada-search-directories
-  '("." "/usr/adainclude" "/usr/local/adainclude")
-  "*See the description for the `ff-search-directories' variable.")
-
-(defvar ada-other-file-alist
-  '(
-    ("\\.ads$" (".adb")) ;; Ada specs and bodies
-    ("\\.adb$" (".ads")) ;; GNAT filename conventions
-    )
-  "*Alist of extensions to find given the current file's extension.
-
-This list should contain the most used extensions before the others,
-since the search algorithm searches sequentially through each directory
-specified in `ada-search-directories'.  If a file is not found, a new one
-is created with the first matching extension (`.adb' yields `.ads').
-")
-
-(defvar modula2-other-file-alist
-  '(
-    ("\\.mi$" (".md")) ;; Modula-2 module definition
-    ("\\.md$" (".mi")) ;; and implementation.
-    )
-  "*See the description for the `ff-search-directories' variable.")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; No user definable variables beyond this point!
-;; ==============================================
-
-(make-variable-buffer-local 'ff-pre-find-hooks)
-(make-variable-buffer-local 'ff-pre-load-hooks)
-(make-variable-buffer-local 'ff-post-load-hooks)
-(make-variable-buffer-local 'ff-not-found-hooks)
-(make-variable-buffer-local 'ff-file-created-hooks)
-(make-variable-buffer-local 'ff-case-fold-search)
-(make-variable-buffer-local 'ff-always-in-other-window)
-(make-variable-buffer-local 'ff-ignore-include)
-(make-variable-buffer-local 'ff-quiet-mode)
-(make-variable-buffer-local 'ff-other-file-alist)
-(make-variable-buffer-local 'ff-search-directories)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User entry points
-
-;;;###autoload
-(defun ff-get-other-file (&optional in-other-window)
-  "Find the header or source file corresponding to this file.
-See also the documentation for `ff-find-other-file;.
-
-If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
-  (interactive "P")
-  (let ((ignore ff-ignore-include))
-    (setq ff-ignore-include t)
-    (ff-find-the-other-file in-other-window)
-    (setq ff-ignore-include ignore)))
-
-;;;###autoload
-(defun ff-find-other-file (&optional in-other-window ignore-include)
-  "Find the header or source file corresponding to this file.
-Being on a `#include' line pulls in that file.
-
-If optional IN-OTHER-WINDOW is non-nil, find the file in the other window.
-If optional IGNORE-INCLUDE is non-nil, ignore being on `#include' lines.
-
-Variables of interest include:
-
- - ff-case-fold-search
-   Non-nil means ignore cases in matches (see case-fold-search).
-   If you have extensions in different cases, you will want this to be nil.
-
- - ff-always-in-other-window 
-   If non-nil, always open the other file in another window, unless an
-   argument is given to ff-find-other-file.
-
- - ff-ignore-include 
-   If non-nil, ignores #include lines.
-
- - ff-always-try-to-create 
-   If non-nil, always attempt to create the other file if it was not found.
-
- - ff-quiet-mode 
-   If non-nil, traces which directories are being searched.
-
- - ff-special-constructs 
-   A list of regular expressions specifying how to recognise special 
-   constructs such as include files etc, and an associated method for 
-   extracting the filename from that construct.
-
- - ff-other-file-alist
-   Alist of extensions to find given the current file's extension.
-
- - ff-search-directories 
-   List of directories searched through with each extension specified in
-   ff-other-file-alist that matches this file's extension.
-
- - ff-pre-find-hooks 
-   List of functions to be called before the search for the file starts.
-
- - ff-pre-load-hooks 
-   List of functions to be called before the other file is loaded.
-
- - ff-post-load-hooks
-   List of functions to be called after the other file is loaded.
-
- - ff-not-found-hooks
-   List of functions to be called if the other file could not be found.
-
- - ff-file-created-hooks
-   List of functions to be called if the other file has been created."
-  (interactive "P")
-  (let ((ignore ff-ignore-include))
-    (setq ff-ignore-include ignore-include)
-    (ff-find-the-other-file in-other-window)
-    (setq ff-ignore-include ignore)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Support functions
-
-(defun ff-emacs-19 ()
-  (string-match "^19\\.[0-9]+\\.[0-9]+$" emacs-version))
-
-(defun ff-xemacs ()
-  (or (string-match "Lucid"  emacs-version)
-      (string-match "XEmacs" emacs-version)))
-
-(defun ff-find-the-other-file (&optional in-other-window)
-  "Find the header or source file corresponding to the current file.
-Being on a `#include' line pulls in that file, but see the help on
-the `ff-ignore-include' variable.
-
-If optional IN-OTHER-WINDOW is non-nil, find the file in another window."
-
-  (let (match           ;; matching regexp for this file
-        suffixes        ;; set of replacing regexps for the matching regexp
-        action          ;; function to generate the names of the other files
-        fname           ;; basename of this file
-        pos             ;; where we start matching filenames
-        stub            ;; name of the file without extension
-        alist           ;; working copy of the list of file extensions
-        pathname        ;; the pathname of the file or the #include line
-        default-name    ;; file we should create if none found
-        format          ;; what we have to match    
-        found           ;; name of the file or buffer found - nil if none 
-        dirs            ;; local value of ff-search-directories
-        no-match)       ;; whether we know about this kind of file
-
-    (if ff-pre-find-hooks
-        (run-hooks 'ff-pre-find-hooks))
-
-    (message "Working...")
-
-    (setq dirs
-          (if (symbolp ff-search-directories)
-              (ff-list-replace-env-vars (symbol-value ff-search-directories))
-            (ff-list-replace-env-vars ff-search-directories)))
-
-    (save-excursion
-      (beginning-of-line 1)
-      (setq fname (ff-treat-as-special)))
-
-    (cond
-     ((and (not ff-ignore-include) fname)
-      (setq default-name fname)
-      (setq found (ff-get-file dirs fname nil in-other-window)))
-
-     ;; let's just get the corresponding file
-     (t
-      (setq alist (if (symbolp ff-other-file-alist)
-                      (symbol-value ff-other-file-alist)
-                    ff-other-file-alist)
-            pathname (if (buffer-file-name)
-                         (buffer-file-name)
-                       "/none.none"))
-
-      (string-match ".*/\\(.+\\)$" pathname)
-      (setq fname (substring pathname (match-beginning 1) (match-end 1))
-            no-match nil
-            match (car alist))
-
-      ;; find the table entry corresponding to this file
-      (setq pos (ff-string-match (car match) fname))
-      (while (and match (if (and pos (>= pos 0)) nil (not pos)))
-        (setq alist (cdr alist))
-        (setq match (car alist))
-        (setq pos (ff-string-match (car match) fname)))
-
-      ;; no point going on if we haven't found anything
-      (if (not match)
-          (setq no-match t)
-
-        ;; otherwise, suffixes contains what we need
-        (setq suffixes (car (cdr match))
-              action (car (cdr match))
-              found nil)
-
-        ;; if we have a function to generate new names, 
-        ;; invoke it with the name of the current file
-        (if (and (atom action) (fboundp action))
-            (progn
-              (setq suffixes (funcall action (buffer-file-name))
-                    match (cons (car match) (list suffixes))
-                    stub nil
-                    default-name (car suffixes)))
-
-          ;; otherwise build our filename stub
-          (cond 
-
-           ;; get around the problem that 0 and nil both mean false!
-           ((= pos 0)
-            (setq format "")
-            (setq stub "")
-            )
-
-           (t
-            (setq format (concat "\\(.+\\)" (car match)))
-            (string-match format fname)
-            (setq stub (substring fname (match-beginning 1) (match-end 1)))
-            ))
-
-          ;; if we find nothing, we should try to get a file like this one
-          (setq default-name
-                (concat stub (car (car (cdr match))))))
-
-        ;; do the real work - find the file
-        (setq found 
-              (ff-get-file dirs
-                           stub
-                           suffixes 
-                           in-other-window)))))
-
-    (cond
-     (no-match                     ;; could not even determine the other file
-      (message ""))
-
-     (t 
-      (cond
-
-       ((not found)                ;; could not find the other file
-
-        (if ff-not-found-hooks     ;; run the hooks
-            (run-hooks 'ff-not-found-hooks))
-
-        (cond 
-         (ff-always-try-to-create  ;; try to create the file
-          (let (name pathname)
-
-            (setq name
-                  (expand-file-name
-                   (read-file-name
-                    (format "Find or create %s in: " default-name)
-                    default-directory default-name nil)))
-            
-            (setq pathname
-                  (if (file-directory-p name)
-                      (concat (file-name-as-directory name) default-name)
-                    (setq found name)))
-            
-            (ff-find-file pathname in-other-window t)))
-
-         (t                        ;; don't create the file, just whinge
-          (message "no file found for %s" fname))))
-
-       (t                          ;; matching file found
-        nil))))
-
-    found))                        ;; return buffer-name or filename
-
-(defun ff-get-file (search-dirs fname-stub &optional suffix-list other-window)
-  "Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub). 
-If (optional) SUFFIXES is nil, search for fname, otherwise search for fname 
-with each of the given suffixes. Gets the file or the buffer corresponding 
-to the name of the first file found, or nil.
-
-Arguments: (search-dirs fname-stub &optional suffix-list in-other-window)
-"
-  (let ((filename (ff-get-file-name search-dirs fname-stub suffix-list)))
-            
-    (cond 
-     ((not filename)
-      nil)
-
-     ((bufferp (get-file-buffer filename))
-      (ff-switch-to-buffer (get-file-buffer filename) other-window)
-      filename)
-               
-     ((file-exists-p filename)
-      (ff-find-file filename other-window nil)
-      filename)
-
-     (t
-      nil))))
-
-(defun ff-get-file-name (search-dirs fname-stub &optional suffix-list)
-  "Find a file in the SEARCH-DIRS with the given FILENAME (or filename stub). 
-If (optional) SUFFIXES is nil, search for fname, otherwise search for fname 
-with each of the given suffixes. Returns the name of the first file found.
-
-Arguments: (search-dirs fname-stub &optional suffix-list)
-"
-  (let* (dirs         ;; working copy of dirs to search
-         dir          ;; the current dir considered
-         file         ;; filename being looked for
-         rest         ;; pathname after first /*
-         this-suffix  ;; the suffix we are currently considering
-         suffixes     ;; working copy of suffix-list
-         filename     ;; built filename
-         blist        ;; list of live buffers
-         buf          ;; current buffer in blist
-         found)       ;; whether we have found anything
-
-    (setq suffixes suffix-list)
-
-    ;; suffixes is nil => fname-stub is the file we are looking for
-    ;; otherwise fname-stub is a stub, and we append a suffix
-    (if suffixes
-        (setq this-suffix (car suffixes))
-      (setq this-suffix "")
-      (setq suffixes (list "")))
-            
-    ;; find whether the file is in a buffer first
-    (while (and suffixes (not found))
-      (setq filename (concat fname-stub this-suffix))
-
-      (if (not ff-quiet-mode)
-          (message "finding buffer %s..." filename))
-
-      (if (bufferp (get-buffer filename))
-          (setq found (buffer-file-name (get-buffer filename))))
-
-      (setq blist (buffer-list))
-      (setq buf (buffer-name (car blist)))
-      (while (and blist (not found))
-
-        (if (string-match (concat filename "<[0-9]+>") buf)
-            (setq found (buffer-file-name (car blist))))
-
-        (setq blist (cdr blist))
-        (setq buf (buffer-name (car blist))))
-
-      (setq suffixes (cdr suffixes))
-      (setq this-suffix (car suffixes)))
-
-    ;; now look for the real file
-    (setq dirs search-dirs)
-    (setq dir  (car dirs))
-    (while (and (not found) dirs)
-
-      (setq suffixes suffix-list)
-
-      ;; if dir does not contain '/*', look for the file
-      (if (and dir (not (string-match "\\([^*]*\\)/\\\*\\(/.*\\)*" dir)))
-          (progn 
-            
-            ;; suffixes is nil => fname-stub is the file we are looking for
-            ;; otherwise fname-stub is a stub, and we append a suffix
-            (if suffixes
-                (setq this-suffix (car suffixes))
-              (setq this-suffix "")
-              (setq suffixes (list "")))
-            
-            (while (and suffixes (not found))
-
-              (setq filename (concat fname-stub this-suffix))
-              (setq file (concat dir "/" filename))
-              
-              (if (not ff-quiet-mode)
-                  (message "finding %s..." file))
-
-              (if (file-exists-p file)
-                  (setq found file))
-              
-              (setq suffixes (cdr suffixes))
-              (setq this-suffix (car suffixes))))
-
-        ;; otherwise dir matches the '/*', so search each dir separately
-        (progn
-          (if (match-beginning 2)
-              (setq rest (substring dir (match-beginning 2) (match-end 2)))
-            (setq rest "")
-            )
-          (setq dir  (substring dir (match-beginning 1) (match-end 1)))
-
-          (let ((dirlist (ff-all-dirs-under dir '("..")))
-                this-dir compl-dirs)
-
-            (setq this-dir (car dirlist))
-            (while dirlist
-              (setq compl-dirs
-                    (append
-                     compl-dirs
-                     (list (concat this-dir rest))
-                     ))
-              (setq dirlist  (cdr dirlist))
-              (setq this-dir (car dirlist)))
-
-            (if compl-dirs
-                (setq found (ff-get-file-name compl-dirs
-                                              fname-stub
-                                              suffix-list))))))
-      (setq dirs (cdr dirs))
-      (setq dir (car dirs)))
-
-    (if found
-        (message "%s found" found))
-
-    found))
-
-(defun ff-string-match (regexp string &optional start)
-  "Like `string-match', but set `case-fold-search' temporarily.
-The value used comes from `ff-case-fold-search'."
-  (let ((case-fold-search ff-case-fold-search))
-    (if regexp
-	(string-match regexp string start))))
-
-(defun ff-list-replace-env-vars (search-list)
-  "Replace environment variables (of the form $VARIABLE) in SEARCH-LIST."
-  (let (list
-        (var (car search-list)))
-    (while search-list
-      (if (string-match "\\(.*\\)\\$[({]*\\([a-zA-Z0-9_]+\\)[)}]*\\(.*\\)" var)
-          (setq var
-                (concat
-                 (substring var (match-beginning 1) (match-end 1))
-                 (getenv (substring var (match-beginning 2) (match-end 2)))
-                 (substring var (match-beginning 3) (match-end 3)))))
-      (setq search-list (cdr search-list))
-      (setq list (cons var list))
-      (setq var (car search-list)))
-    (setq search-list (reverse list))))
-
-(defun ff-treat-as-special ()
-  "Returns the file to look for if the construct was special, else nil.
-The construct is defined in the variable `ff-special-constructs'."
-  (let* (fname
-         (list ff-special-constructs)
-         (elem (car list))
-         (regexp (car elem))
-         (match (cdr elem)))
-    (while (and list (not fname))
-      (if (and (looking-at regexp) match)
-          (setq fname (funcall match)))
-      (setq list (cdr list))
-      (setq elem (car list))
-      (setq regexp (car elem))
-      (setq match (cdr elem)))
-    fname))
-
-(defun ff-basename (string)
-  "Return the basename of PATHNAME."
-  (setq string (concat "/" string))
-  (string-match ".*/\\([^/]+\\)$" string)
-  (setq string (substring string (match-beginning 1) (match-end 1))))
-
-(defun ff-all-dirs-under (here &optional exclude)
-  "Get all the directory files under directory HERE.
-Exclude all files in the optional EXCLUDE list."
-  (if (file-directory-p here)
-      (condition-case nil
-          (progn
-            (let ((files (directory-files here t))
-                  (dirlist (list))
-                  file)
-              (while files
-                (setq file (car files))
-                (if (and
-                     (file-directory-p file)
-                     (not (member (ff-basename file) exclude)))
-                    (setq dirlist (cons file dirlist)))
-                (setq files (cdr files)))
-              (setq dirlist (reverse dirlist))))
-        (error nil))
-    nil))
-
-(defun ff-switch-file (f1 f2 file &optional in-other-window new-file)
-  "Call F1 or F2 on FILE, according to IN-OTHER-WINDOW.
-In addition, this runs various hooks.
-
-Either F1 or F2 receives FILE as the sole argument.
-The decision of which one to call is based on IN-OTHER-WINDOW
-and on the global variable `ff-always-in-other-window'.
-
-F1 and F2 are typically `find-file' / `find-file-other-window'
-or `switch-to-buffer' / `switch-to-buffer-other-window' function pairs.
-
-If optional NEW-FILE is t, then a special hook (`ff-file-created-hooks') is 
-called before `ff-post-load-hooks'."
-  (if ff-pre-load-hooks
-      (run-hooks 'ff-pre-load-hooks))
-  (if (or
-       (and in-other-window (not ff-always-in-other-window))
-       (and (not in-other-window) ff-always-in-other-window))
-      (funcall f2 file)
-    (funcall f1 file))
-  (if new-file
-      (if ff-file-created-hooks
-          (run-hooks 'ff-file-created-hooks)))
-  (if ff-post-load-hooks
-      (run-hooks 'ff-post-load-hooks)))
-
-(defun ff-find-file (file &optional in-other-window new-file)
-  "Like `find-file', but may show the file in another window."
-  (ff-switch-file 'find-file 
-                  'find-file-other-window 
-                  file in-other-window new-file))
-
-(defun ff-switch-to-buffer (buffer-or-name &optional in-other-window)
-  "Like `switch-to-buffer', but may show the buffer in another window."
-
-  (ff-switch-file 'switch-to-buffer 
-                  'switch-to-buffer-other-window 
-                  buffer-or-name in-other-window nil))
-
-(cond 
- ((ff-emacs-19)
-  (defun ff-goto-click (event)
-    (set-buffer (window-buffer (posn-window (event-end event))))
-    (goto-char (posn-point (event-end event))))
-
-  ;;;###autoload
-  (defun ff-mouse-find-other-file (event)
-    "Visit the file you click on."
-    (interactive "e")
-    (save-excursion
-      (ff-goto-click event)
-      (ff-find-other-file nil)))
-
-  ;;;###autoload
-  (defun ff-mouse-find-other-file-other-window (event)
-    "Visit the file you click on."
-    (interactive "e")
-    (save-excursion
-      (ff-goto-click event)
-      (ff-find-other-file t)))
-
-  ;;;###autoload
-  (defun locate-file (fname dirs &optional suffix-list ignore-perms)
-    "Defines XEmacs look-alike locate-file for GNU Emacs-19."
-    (interactive)
-    (ff-get-file dirs fname suffix-list)) 
-  )
-
- ((ff-xemacs)
-
-  ;;;###autoload
-  (defun ff-mouse-find-other-file (event)
-    "Visit the file you click on."
-    (interactive "@e")
-    (save-excursion
-      (mouse-set-point event)
-      (ff-find-other-file nil)))
-
-  ;;;###autoload
-  (defun ff-mouse-find-other-file-other-window (event)
-    "Visit the file you click on."
-    (interactive "@e")
-    (save-excursion
-      (mouse-set-point event)
-      (ff-find-other-file t))) 
-  ))
-
-(provide 'find-file)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; This section offers an example of user defined function to select files
-
-(defun ff-upcase-p (string &optional start end)
-  "Return t if this string is all uppercase.
-Given START and/or END, checks between these characters."
-  (let (match str)
-    (if (not start)
-        (setq start 0))
-    (if (not end)
-        (setq end (length string)))
-    (if (= start end)
-        (setq end (1+ end)))
-    (setq str (substring string start end))
-    (if (and 
-         (ff-string-match "[A-Z]+" str)
-         (setq match (match-data))
-         (= (car match) 0)
-         (= (car (cdr match)) (length str)))
-        t
-      nil)))
-
-(defun ff-cc-hh-converter (arg)
-  "Discriminate file extensions.
-Build up a new file list based possibly on part of the directory name
-and the name of the file passed in."
-  (ff-string-match "\\(.*\\)/\\([^/]+\\)/\\([^.]+\\).\\([^/]+\\)$" arg)
-  (let ((path (if (match-beginning 1) 
-                  (substring arg (match-beginning 1) (match-end 1)) nil))
-        (dire (if (match-beginning 2) 
-                  (substring arg (match-beginning 2) (match-end 2)) nil))
-        (file (if (match-beginning 3) 
-                  (substring arg (match-beginning 3) (match-end 3)) nil))
-        (extn (if (match-beginning 4) 
-                  (substring arg (match-beginning 4) (match-end 4)) nil))
-        return-list)
-    (cond
-     ;; fooZapJunk.cc => ZapJunk.{hh,h} or fooZapJunk.{hh,h}
-     ((and (string= extn "cc") 
-           (ff-string-match "^\\([a-z]+\\)\\([A-Z].+\\)$" file))
-      (let ((stub  (substring file (match-beginning 2) (match-end 2))))
-        (setq dire (upcase (substring file (match-beginning 1) (match-end 1))))
-        (setq return-list (list (concat stub ".hh")
-                                (concat stub ".h")
-                                (concat file ".hh")
-                                (concat file ".h")))
-        ))
-     ;; FOO/ZapJunk.hh => fooZapJunk.{cc,C} or ZapJunk.{cc,C}
-     ((and (string= extn "hh") (ff-upcase-p dire) file)
-      (let ((stub (concat (downcase dire) file)))
-        (setq return-list (list (concat stub ".cc")           
-                                (concat stub ".C")
-                                (concat file ".cc")
-                                (concat file ".C")))
-        ))
-     ;; zap.cc => zap.hh or zap.h
-     ((string= extn "cc")
-      (let ((stub file))
-        (setq return-list (list (concat stub ".hh")
-                                (concat stub ".h")))
-        ))
-     ;; zap.hh => zap.cc or zap.C
-     ((string= extn "hh")
-      (let ((stub file))
-        (setq return-list (list (concat stub ".cc")
-                                (concat stub ".C")))
-        ))
-     (t 
-      nil))
-    
-    return-list))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; This section offers an example of user defined function to place point.
-;; The regexps are Ada specific.
-
-(defvar ff-function-name nil "Name of the function we are in.")
-
-(defvar ada-procedure-start-regexp)
-(defvar ada-package-start-regexp)
-
-;; bind with (setq ff-pre-load-hooks 'ff-which-function-are-we-in)
-;;
-(defun ff-which-function-are-we-in ()
-  "Return the name of the function whose definition/declaration point is in.
-Also remember that name in `ff-function-name'."
-
-  (setq ff-function-name nil)
-
-  (save-excursion
-    (if (re-search-backward ada-procedure-start-regexp nil t)
-        (setq ff-function-name (buffer-substring (match-beginning 0)
-                                                 (match-end 0)))
-      ; we didn't find a procedure start, perhaps there is a package
-      (if (re-search-backward ada-package-start-regexp nil t)
-          (setq ff-function-name (buffer-substring (match-beginning 0)
-                                                   (match-end 0)))
-        ))))
-
-;; bind with (setq ff-post-load-hooks 'ff-set-point-accordingly)
-;;
-(defun ff-set-point-accordingly ()
-  "Find the function specified in `ff-function-name'.
-That name was previously determined by `ff-which-function-are-we-in'."
-  (if ff-function-name
-      (progn
-        (goto-char (point-min))
-        (search-forward ff-function-name nil t))))
-
-;; find-file.el ends here
-
diff --git a/lisp/find-gc.el b/lisp/find-gc.el
deleted file mode 100644
index 4bce53c9184..00000000000
--- a/lisp/find-gc.el
+++ /dev/null
@@ -1,152 +0,0 @@
-;;; find-gc.el --- detect functions that call the garbage collector
-
-;; Copyright (C) 1992 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:
-
-;; Produce in unsafe-list the set of all functions that may invoke GC.
-;; This expects the Emacs sources to live in emacs-source-directory.
-;; It creates a temporary working directory /tmp/esrc.
-
-;;; Code:
-
-(defun find-gc-unsafe ()
-  (trace-call-tree nil)
-  (trace-use-tree)
-  (find-unsafe-funcs 'Fgarbage_collect)
-  (setq unsafe-list (sort unsafe-list
-			  (function (lambda (x y)
-				      (string-lessp (car x) (car y))))))
-)
-
-(setq emacs-source-directory "/usr/gnu/src/dist/src")
-
-
-;;; This does a depth-first search to find all functions that can
-;;; ultimately call the function "target".  The result is an a-list
-;;; in unsafe-list; the cars are the unsafe functions, and the cdrs
-;;; are (one of) the unsafe functions that these functions directly
-;;; call.
-
-(defun find-unsafe-funcs (target)
-  (setq unsafe-list (list (list target)))
-  (trace-unsafe target)
-)
-
-(defun trace-unsafe (func)
-  (let ((used (assq func subrs-used)))
-    (or used
-	(error "No subrs-used for %s" (car unsafe-list)))
-    (while (setq used (cdr used))
-      (or (assq (car used) unsafe-list)
-	  (memq (car used) noreturn-list)
-	  (progn
-	    (setq unsafe-list (cons (cons (car used) func) unsafe-list))
-	    (trace-unsafe (car used))))))
-)
-
-
-;;; Functions on this list are safe, even if they appear to be able
-;;; to call the target.
-
-(setq noreturn-list '( Fsignal Fthrow wrong_type_argument ))
-
-
-;;; This produces an a-list of functions in subrs-called.  The cdr of
-;;; each entry is a list of functions which the function in car calls.
-
-(defun trace-call-tree (&optional already-setup)
-  (message "Setting up directories...")
-  (or already-setup
-      (progn
-	;; Gee, wouldn't a built-in "system" function be handy here.
-	(call-process "csh" nil nil nil "-c" "rm -rf /tmp/esrc")
-	(call-process "csh" nil nil nil "-c" "mkdir /tmp/esrc")
-	(call-process "csh" nil nil nil "-c"
-		      (format "ln -s %s/*.[ch] /tmp/esrc"
-			      emacs-source-directory))))
-  (save-excursion
-    (set-buffer (get-buffer-create "*Trace Call Tree*"))
-    (setq subrs-called nil)
-    (let ((case-fold-search nil)
-	  (files source-files)
-	  name entry)
-      (while files
-	(message "Compiling %s..." (car files))
-	(call-process "csh" nil nil nil "-c"
-		      (format "gcc -dr -c /tmp/esrc/%s -o /dev/null"
-			      (car files)))
-	(erase-buffer)
-	(insert-file-contents (concat "/tmp/esrc/" (car files) ".rtl"))
-	(while (re-search-forward ";; Function \\|(call_insn " nil t)
-	  (if (= (char-after (- (point) 3)) ?o)
-	      (progn
-		(looking-at "[a-zA-Z0-9_]+")
-		(setq name (intern (buffer-substring (match-beginning 0)
-						     (match-end 0))))
-		(message "%s : %s" (car files) name)
-		(setq entry (list name)
-		      subrs-called (cons entry subrs-called)))
-	    (if (looking-at ".*\n?.*\"\\([A-Za-z0-9_]+\\)\"")
-		(progn
-		  (setq name (intern (buffer-substring (match-beginning 1)
-						       (match-end 1))))
-		  (or (memq name (cdr entry))
-		      (setcdr entry (cons name (cdr entry))))))))
-	(delete-file (concat "/tmp/esrc/" (car files) ".rtl"))
-	(setq files (cdr files)))))
-)
-
-
-;;; This was originally generated directory-files, but there were
-;;; too many files there that were not actually compiled.  The
-;;; list below was created for a HP-UX 7.0 system.
-
-(setq source-files '("dispnew.c" "scroll.c" "xdisp.c" "window.c"
-		     "term.c" "cm.c" "emacs.c" "keyboard.c" "macros.c"
-		     "keymap.c" "sysdep.c" "buffer.c" "filelock.c"
-		     "insdel.c" "marker.c" "minibuf.c" "fileio.c"
-		     "dired.c" "filemode.c" "cmds.c" "casefiddle.c"
-		     "indent.c" "search.c" "regex.c" "undo.c"
-		     "alloc.c" "data.c" "doc.c" "editfns.c"
-		     "callint.c" "eval.c" "fns.c" "print.c" "lread.c"
-		     "abbrev.c" "syntax.c" "unexec.c" "mocklisp.c"
-		     "bytecode.c" "process.c" "callproc.c" "doprnt.c"
-		     "x11term.c" "x11fns.c"))
-
-
-;;; This produces an inverted a-list in subrs-used.  The cdr of each
-;;; entry is a list of functions that call the function in car.
-
-(defun trace-use-tree ()
-  (setq subrs-used (mapcar 'list (mapcar 'car subrs-called)))
-  (let ((ptr subrs-called)
-	p2 found)
-    (while ptr
-      (setq p2 (car ptr))
-      (while (setq p2 (cdr p2))
-	(if (setq found (assq (car p2) subrs-used))
-	    (setcdr found (cons (car (car ptr)) (cdr found)))))
-      (setq ptr (cdr ptr))))
-)
-
-;;; find-gc.el ends here
diff --git a/lisp/finder.el b/lisp/finder.el
deleted file mode 100644
index 3d93cba79d5..00000000000
--- a/lisp/finder.el
+++ /dev/null
@@ -1,299 +0,0 @@
-;;; finder.el --- topic & keyword-based code finder
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Created: 16 Jun 1992
-;; Version: 1.0
-;; Keywords: help
-
-;; 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 mode uses the Keywords library header to provide code-finding
-;; services by keyword.
-;;
-;; Things to do:
-;;    1. Support multiple keywords per search.  This could be extremely hairy;
-;; there doesn't seem to be any way to get completing-read to exit on
-;; an EOL with no substring pending, which is what we'd want to end the loop.
-;;    2. Search by string in synopsis line?
-;;    3. Function to check finder-package-info for unknown keywords.
-
-;;; Code:
-
-(require 'lisp-mnt)
-(require 'finder-inf)
-
-;; Local variable in finder buffer.
-(defvar finder-headmark)
-
-(defvar finder-known-keywords
-  '(
-    (abbrev	. "abbreviation handling, typing shortcuts, macros")
-    (bib	. "code related to the `bib' bibliography processor")
-    (c		. "support for the C language and related languages")
-    (calendar	. "calendar and time management support")
-    (comm	. "communications, networking, remote access to files")
-    (data	. "support editing files of data")
-    (docs	. "support for Emacs documentation")
-    (emulations	. "emulations of other editors")
-    (extensions	. "Emacs Lisp language extensions")
-    (faces	. "support for multiple fonts")
-    (frames     . "support for Emacs frames and window systems")
-    (games	. "games, jokes and amusements")
-    (hardware	. "support for interfacing with exotic hardware")
-    (help	. "support for on-line help systems")
-    (hypermedia . "support for links between text or other media types")
-    (i18n	. "internationalization and alternate character-set support")
-    (internal	. "code for Emacs internals, build process, defaults")
-    (languages	. "specialized modes for editing programming languages")
-    (lisp	. "Lisp support, including Emacs Lisp")
-    (local	. "code local to your site")
-    (maint	. "maintenance aids for the Emacs development group")
-    (mail	. "modes for electronic-mail handling")
-    (matching	. "various sorts of searching and matching")
-    (mouse	. "mouse support")
-    (news	. "support for netnews reading and posting")
-    (oop        . "support for object-oriented programming")
-    (outlines   . "support for hierarchical outlining")
-    (processes	. "process, subshell, compilation, and job control support")
-    (terminals	. "support for terminal types")
-    (tex	. "code related to the TeX formatter")
-    (tools	. "programming tools")
-    (unix	. "front-ends/assistants for, or emulators of, UNIX features")
-    (vms	. "support code for vms")
-    (wp		. "word processing")
-    ))
-
-(defvar finder-mode-map nil)
-(or finder-mode-map
-    (let ((map (make-sparse-keymap)))
-      (define-key map " "	'finder-select)
-      (define-key map "f"	'finder-select)
-      (define-key map "\C-m"	'finder-select)
-      (define-key map "?"	'finder-summary)
-      (define-key map "q"	'finder-exit)
-      (define-key map "d"	'finder-list-keywords)
-      (setq finder-mode-map map)))
-
-
-;;; Code for regenerating the keyword list.
-
-(defvar finder-package-info nil
-  "Assoc list mapping file names to description & keyword lists.")
-
-(defun finder-compile-keywords (&rest dirs)
-  "Regenerate the keywords association list into the file `finder-inf.el'.
-Optional arguments are a list of Emacs Lisp directories to compile from; no
-arguments compiles from `load-path'."
-  (save-excursion
-    (let ((processed nil))
-      (find-file "finder-inf.el")
-      (erase-buffer)
-      (insert ";;; finder-inf.el --- keyword-to-package mapping\n")
-      (insert ";; Keywords: help\n")
-      (insert ";;; Commentary:\n")
-      (insert ";; Don't edit this file.  It's generated by finder.el\n\n")
-      (insert ";;; Code:\n")
-      (insert "\n(setq finder-package-info '(\n")
-      (mapcar
-       (lambda (d)
-	 (mapcar
-	  (lambda (f) 
-	    (if (and (string-match "^[^=].*\\.el$" f)
-		     (not (member f processed)))
-		(let (summary keystart keywords)
-		  (setq processed (cons f processed))
-		  (save-excursion
-		    (set-buffer (get-buffer-create "*finder-scratch*"))
-		    (buffer-disable-undo (current-buffer))
-		    (erase-buffer)
-		    (insert-file-contents
-		     (concat (file-name-as-directory (or d ".")) f))
-		    (setq summary (lm-synopsis))
-		    (setq keywords (lm-keywords)))
-		  (insert
-		   (format "    (\"%s\"\n        " f))
-		  (prin1 summary (current-buffer))
-		  (insert
-		   "\n        ")
-		  (setq keystart (point))
-		  (insert
-		   (if keywords (format "(%s)" keywords) "nil")
-		   ")\n")
-		  (subst-char-in-region keystart (point) ?, ? )
-		  )))
-	  (directory-files (or d "."))))
-       (or dirs load-path))
-      (insert "))\n\n(provide 'finder-inf)\n\n;;; finder-inf.el ends here\n")
-      (kill-buffer "*finder-scratch*")
-      (eval-current-buffer) ;; So we get the new keyword list immediately
-      (basic-save-buffer))))
-
-(defun finder-compile-keywords-make-dist ()
-  "Regenerate `finder-inf.el' for the Emacs distribution."
-  (finder-compile-keywords default-directory))
-
-;;; Now the retrieval code
-
-(defun finder-insert-at-column (column &rest strings)
-  "Insert list of STRINGS, at column COLUMN."
-  (if (> (current-column) column) (insert "\n"))
-  (move-to-column column)
-  (let ((col (current-column)))
-    (if (< col column)
-	(indent-to column)
-      (if (and (/= col column)
-	       (= (preceding-char) ?\t))
-	  (let (indent-tabs-mode)
-	    (delete-char -1)
-            (indent-to col)
-            (move-to-column column)))))
-  (apply 'insert strings))
-
-(defun finder-list-keywords ()
-  "Display descriptions of the keywords in the Finder buffer."
-  (interactive)
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  (mapcar
-   (lambda (assoc)
-     (let ((keyword (car assoc)))
-       (insert (symbol-name keyword))
-       (finder-insert-at-column 14 (concat (cdr assoc) "\n"))
-       (cons (symbol-name keyword) keyword)))
-   finder-known-keywords)
-  (goto-char (point-min))
-  (setq finder-headmark (point))
-  (setq buffer-read-only t)
-  (set-buffer-modified-p nil)
-  (balance-windows)
-  (finder-summary))
-
-(defun finder-list-matches (key)
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  (let ((id (intern key)))
-    (insert
-     "The following packages match the keyword `" key "':\n\n")
-    (setq finder-headmark (point))
-    (mapcar
-     (lambda (x)
-       (if (memq id (car (cdr (cdr x))))
-	   (progn
-	     (insert (car x))
-	     (finder-insert-at-column 16 (concat (car (cdr x)) "\n")))))
-     finder-package-info)
-    (goto-char (point-min))
-    (forward-line)
-    (setq buffer-read-only t)
-    (set-buffer-modified-p nil)
-    (shrink-window-if-larger-than-buffer)
-    (finder-summary)))
-
-;; Search for a file named FILE the same way `load' would search.
-(defun finder-find-library (file)
-  (if (file-name-absolute-p file)
-      file
-    (let ((dirs load-path)
-	  found)
-      (while (and dirs (not found))
-	(if (file-exists-p (expand-file-name (concat file ".el") (car dirs)))
-	    (setq found (expand-file-name file (car dirs)))
-	  (if (file-exists-p (expand-file-name file (car dirs)))
-	      (setq found (expand-file-name file (car dirs)))))
-	(setq dirs (cdr dirs)))
-      found)))
-
-(defun finder-commentary (file)
-  (interactive)
-  (let* ((str (lm-commentary (finder-find-library file))))
-    (if (null str)
-	(error "Can't find any Commentary section"))
-    (pop-to-buffer "*Finder*")
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (insert str)
-    (goto-char (point-min))
-    (delete-blank-lines)
-    (goto-char (point-max))
-    (delete-blank-lines)
-    (goto-char (point-min))
-    (while (re-search-forward "^;+ ?" nil t)
-      (replace-match "" nil nil))
-    (goto-char (point-min))
-    (setq buffer-read-only t)
-    (set-buffer-modified-p nil)
-    (shrink-window-if-larger-than-buffer)
-    (finder-summary)))
-
-(defun finder-current-item ()
-  (if (and finder-headmark (< (point) finder-headmark))
-      (error "No keyword or filename on this line")
-    (save-excursion
-      (beginning-of-line)
-      (current-word))))
-
-(defun finder-select ()
-  (interactive)
-  (let ((key (finder-current-item)))
-    (if (string-match "\\.el$" key)
-	(finder-commentary key)
-      (finder-list-matches key))))
-
-(defun finder-by-keyword ()
-  "Find packages matching a given keyword."
-  (interactive)
-  (finder-mode)
-  (finder-list-keywords))
-
-(defun finder-mode ()
-  "Major mode for browsing package documentation.
-\\<finder-mode-map>
-\\[finder-select]	more help for the item on the current line
-\\[finder-exit]	exit Finder mode and kill the Finder buffer.
-"
-  (interactive)
-  (pop-to-buffer "*Finder*")
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  (use-local-map finder-mode-map)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (setq mode-name "Finder")
-  (setq major-mode 'finder-mode)
-  (make-local-variable 'finder-headmark)
-  (setq finder-headmark nil))
-
-(defun finder-summary ()
-  "Summarize basic Finder commands."
-  (interactive)
-  (message "%s"
-   (substitute-command-keys
-    "\\<finder-mode-map>\\[finder-select] = select, \\[finder-list-keywords] = to finder directory, \\[finder-exit] = quit, \\[finder-summary] = help")))
-
-(defun finder-exit ()
-  "Exit Finder mode and kill the buffer"
-  (interactive)
-  (delete-window)
-  (kill-buffer "*Finder*"))
-
-(provide 'finder)
-
-;;; finder.el ends here
diff --git a/lisp/float-sup.el b/lisp/float-sup.el
deleted file mode 100644
index 5a93f5fec05..00000000000
--- a/lisp/float-sup.el
+++ /dev/null
@@ -1,60 +0,0 @@
-;;; float-sup.el --- detect absence of floating-point support in Emacs runtime
-
-;; Copyright (C) 1985, 1986, 1987 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.
-
-;;; Code:
-
-;; Provide a meaningful error message if we are running on
-;; bare (non-float) emacs.
-;; Can't test for 'floatp since that may be defined by float-imitation
-;; packages like float.el in this very directory.
-
-(if (fboundp 'atan)
-    nil
-  (error "Floating point was disabled at compile time"))
-
-;; provide an easy hook to tell if we are running with floats or not.
-;; define pi and e via math-lib calls. (much less prone to killer typos.)
-(defconst pi (* 4 (atan 1)) "The value of Pi (3.1415926...)")
-(defconst e (exp 1) "The value of e (2.7182818...)")
-
-;; Careful when editing this file ... typos here will be hard to spot.
-;; (defconst pi       3.14159265358979323846264338327
-;;  "The value of Pi (3.14159265358979323846264338327...)")
-
-(defconst degrees-to-radians (/ pi 180.0)
-  "Degrees to radian conversion constant")
-(defconst radians-to-degrees (/ 180.0 pi)
-  "Radian to degree conversion constant")
-
-;; these expand to a single multiply by a float when byte compiled
-
-(defmacro degrees-to-radians (x)
-  "Convert ARG from degrees to radians."
-  (list '* (/ pi 180.0) x))
-(defmacro radians-to-degrees (x)
-  "Convert ARG from radians to degrees."
-  (list '* (/ 180.0 pi) x))
-
-(provide 'lisp-float-type)
-
-;;; float-sup.el ends here
diff --git a/lisp/flow-ctrl.el b/lisp/flow-ctrl.el
deleted file mode 100644
index f98ecaa0fb9..00000000000
--- a/lisp/flow-ctrl.el
+++ /dev/null
@@ -1,126 +0,0 @@
-;;; flow-ctrl.el --- help for lusers on cu(1) or ttys with wired-in ^S/^Q flow control
-
-;; Copyright (C) 1990, 1991, 1994 Free Software Foundation, Inc.
-
-;; Author Kevin Gallagher
-;; Maintainer: FSF
-;; Adapted-By: ESR
-;; Keywords: hardware
-
-;; 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:
-
-;; Terminals that use XON/XOFF flow control can cause problems with
-;; GNU Emacs users.  This file contains Emacs Lisp code that makes it
-;; easy for a user to deal with this problem, when using such a
-;; terminal. 
-;;      
-;; To invoke these adjustments, a user need only invoke the function
-;; enable-flow-control-on with a list of terminal types in his/her own
-;; .emacs file.  As arguments, give it the names of one or more terminal
-;; types in use by that user which require flow control adjustments.
-;; Here's an example: 
-;; 
-;;	(enable-flow-control-on "vt200" "vt300" "vt101" "vt131")
-
-;; Portability note: This uses (getenv "TERM"), and therefore probably
-;; won't work outside of UNIX-like environments.
-
-;;; Code:
-
-(defvar flow-control-c-s-replacement ?\034
-  "Character that replaces C-s, when flow control handling is enabled.")
-(defvar flow-control-c-q-replacement ?\036
-  "Character that replaces C-q, when flow control handling is enabled.")
-
-(put 'keyboard-translate-table 'char-table-extra-slots 0)
-
-;;;###autoload
-(defun enable-flow-control (&optional argument)
-  "Toggle flow control handling.
-When handling is enabled, user can type C-s as C-\\, and C-q as C-^.
-With arg, enable flow control mode if arg is positive, otherwise disable."
-  (interactive "P")
-  (if (if argument
-	  ;; Argument means enable if arg is positive.
-	  (<= (prefix-numeric-value argument) 0)
-	;; No arg means toggle.
-	(nth 1 (current-input-mode)))
-      (progn
-	;; Turn flow control off, and stop exchanging chars.
-	(set-input-mode t nil (nth 2 (current-input-mode)))
-	(if keyboard-translate-table
-	    (progn
-	      (aset keyboard-translate-table flow-control-c-s-replacement nil)
-	      (aset keyboard-translate-table ?\^s nil)
-	      (aset keyboard-translate-table flow-control-c-q-replacement nil)
-	      (aset keyboard-translate-table ?\^q nil))))
-    ;; Turn flow control on.
-    ;; Tell emacs to pass C-s and C-q to OS.
-    (set-input-mode nil t (nth 2 (current-input-mode)))
-    ;; Initialize translate table, saving previous mappings, if any.
-    (cond ((null keyboard-translate-table)
-	   (setq keyboard-translate-table
-		 (make-char-table 'keyboard-translate-table nil)))
-	  ((char-table-p keyboard-translate-table)
-	   (setq keyboard-translate-table
-		 (copy-sequence keyboard-translate-table)))
-	  (t
-	   (let ((the-table (make-char-table 'keyboard-translate-table nil)))
-	     (let ((i 0)
-		   (j (length keyboard-translate-table)))
-	       (while (< i j)
-		 (aset the-table i (elt keyboard-translate-table i))
-		 (setq i (1+ i))))
-	     (setq keyboard-translate-table the-table))))
-    ;; Swap C-s and C-\
-    (aset keyboard-translate-table flow-control-c-s-replacement ?\^s)
-    (aset keyboard-translate-table ?\^s flow-control-c-s-replacement)
-    ;; Swap C-q and C-^
-    (aset keyboard-translate-table flow-control-c-q-replacement ?\^q)
-    (aset keyboard-translate-table ?\^q flow-control-c-q-replacement)
-    (message "XON/XOFF adjustment for %s: use %s for C-s, and use %s for C-q"
-	     (getenv "TERM") 
-	     (single-key-description flow-control-c-s-replacement)
-	     (single-key-description flow-control-c-q-replacement))
-    (sleep-for 2)))			; Give user a chance to see message.
-
-;;;###autoload
-(defun enable-flow-control-on (&rest losing-terminal-types)
-  "Enable flow control if using one of a specified set of terminal types.
-Use `(enable-flow-control-on \"vt100\" \"h19\")' to enable flow control
-on VT-100 and H19 terminals.  When flow control is enabled,
-you must type C-\\ to get the effect of a C-s, and type C-^
-to get the effect of a C-q."
-  (let ((term (getenv "TERM"))
-	hyphend)
-    ;; Look for TERM in LOSING-TERMINAL-TYPES.
-    ;; If we don't find it literally, try stripping off words
-    ;; from the end, one by one.
-    (while (and term (not (member term losing-terminal-types)))
-      ;; Strip off last hyphen and what follows, then try again.
-      (if (setq hyphend (string-match "[-_][^-_]+$" term))
-	  (setq term (substring term 0 hyphend))
-	(setq term nil)))
-    (if term
-	(enable-flow-control))))
-
-(provide 'flow-ctrl)
-
-;;; flow-ctrl.el ends here
diff --git a/lisp/foldout.el b/lisp/foldout.el
deleted file mode 100644
index ad9bfe2c2ec..00000000000
--- a/lisp/foldout.el
+++ /dev/null
@@ -1,570 +0,0 @@
-;;; foldout.el --- Folding extensions for outline-mode and outline-minor-mode.
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: Kevin Broadey <KevinB@bartley.demon.co.uk>
-;; Created: 27 Jan 1994
-;; Version: foldout.el 1.10 dated 94/05/19 at 17:09:12
-;; Keywords: folding, outline
-
-;; 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 provides folding editor extensions for outline-mode and
-;; outline-minor-mode buffers.  What's a "folding editor"?  Read on...
-;;
-;; Imagine you're in an outline-mode buffer and you've hidden all the text and
-;; subheadings under your level-1 headings.  You now want to look at the stuff
-;; hidden under one of these headings.  Normally you'd do C-c C-e (show-entry)
-;; to expose the body or C-c C-i to expose the child (level-2) headings.
-;;
-;; With foldout, you do C-c C-z (foldout-zoom-subtree).  This exposes the body
-;; and child subheadings and narrows the buffer so that only the level-1
-;; heading, the body and the level-2 headings are visible.  If you now want to
-;; look under one of the level-2 headings, position the cursor on it and do C-c
-;; C-z again.  This exposes the level-2 body and its level-3 child subheadings
-;; and narrows the buffer again.  You can keep on zooming in on successive
-;; subheadings as much as you like.  A string in the modeline tells you how
-;; deep you've gone.
-;;
-;; When zooming in on a heading you might only want to see the child
-;; subheadings.  You do this by specifying a numeric argument: C-u C-c C-z.
-;; You can specify the number of levels of children too (c.f. show-children):
-;; e.g. M-2 C-c C-z exposes two levels of child subheadings.  Alternatively,
-;; you might only be interested in the body.  You do this by specifying a
-;; negative argument: M-- C-c C-z.  You can also cause the whole subtree to be
-;; expanded, similar to C-c C-s (show-subtree), by specifying a zero argument:
-;; M-0 C-c C-z.
-;;
-;; While you're zoomed in you can still use outline-mode's exposure and hiding
-;; functions.  It won't upset foldout at all.  Also, since the buffer is
-;; narrowed, "global" editing actions will only affect the stuff under the
-;; zoomed-in heading.  This is useful for restricting changes to a particular
-;; chapter or section of your document.
-;;
-;; You unzoom (exit) a fold by doing C-c C-x (foldout-exit-fold).  This hides
-;; all the text and subheadings under the top-level heading and returns you to
-;; the previous view of the buffer.  Specifying a numeric argument exits that
-;; many folds.  Specifying a zero argument exits *all* folds.
-;;
-;; You might want to exit a fold *without* hiding the text and subheadings.
-;; You do this by specifying a negative argument.  For example, M--2 C-c C-x
-;; exits two folds and leaves the text and subheadings exposed.
-;;
-;; Foldout also provides mouse bindings for entering and exiting folds and for
-;; showing and hiding text.  Hold down Meta and Control, then click a mouse
-;; button as follows:-
-;;
-;;   mouse-1 (foldout-mouse-zoom) zooms in on the heading clicked on:-
-;;
-;;     single click	expose body
-;;     double click	expose subheadings
-;;     triple click	expose body and subheadings
-;;     quad click	expose entire subtree
-;;
-;;   mouse-2 (foldout-mouse-show) exposes text under the heading clicked on:-
-;;
-;;     single click	expose body
-;;     double click	expose subheadings
-;;     triple click	expose body and subheadings
-;;     quad click	expose entire subtree
-;;
-;;   mouse-3 (foldout-mouse-hide-or-exit) hides text under the heading clicked
-;;   on or exits the fold:-
-;;
-;;     single click	hide subtree
-;;     double click	exit fold and hide text
-;;     triple click	exit fold without hiding text
-;;     quad click	exit all folds and hide text
-;;
-;; You can change the modifier keys used by setting `foldout-mouse-modifiers'.
-
-;;; Installation:
-
-;; To use foldout, put this in your .emacs:-
-;;
-;;    (require 'foldout)
-;;
-;; If you don't want it loaded until you need it, try this instead:-
-;;
-;;    (eval-after-load "outline" '(require 'foldout))
-
-;;; Advertisements:
-
-;; Get out-xtra.el by Per Abrahamsen <abraham@iesd.auc.dk> for more
-;; outline-mode goodies.  In particular, `outline-hide-sublevels' makes
-;; setup a lot easier.
-;;
-;; folding.el by Jamie Lokier <u90jl@ecs.ox.ac.uk> supports folding by
-;; recognising special marker text in you file.
-;;
-;; c-outline.el (by me) provides outline-mode support to recognise `C'
-;; statements as outline headings, so with foldout you can have a folding `C'
-;; code editor without having to put in start- and end-of-fold markers.  This
-;; is a real winner!
-
-;;; ChangeLog:
-
-;; 1.10   21-Mar-94
-;; foldout.el is now part of the GNU Emacs distribution!!
-;; Put in changes made by RMS to version 1.8 to keep the diffs to a minimum.
-;; bugfix: numeric arg to foldout-exit-fold wasn't working - looks like I don't
-;; know how to use the Common LISP `loop' macro after all, so use `while'
-;; instead.
-
-;; 1.9    15-Mar-94
-;; Didn't test that very well, did I?  The change to foldout-zoom-subtree
-;; affected foldout-mouse-zoom: if the heading under the `level n' one clicked
-;; on was at `level n+2' then it didn't get exposed.  Sorry about that!
-
-;; 1.8	  15-Mar-94
-;; Changed meaning of prefix arg to foldout-zoom-subtree.  arg > 0 now means
-;; "expose that many children" instead of just "expose children" so it is more
-;; like `show-children' (C-c C-i).  Arg of C-u on its own only shows one level
-;; of children, though, so you can still zoom by doing C-u C-c C-z.
-;;
-;; I can't think of a good meaning for the value of a negative prefix.  Any
-;; suggestions?
-;;
-;; Added advertisement for my c-outline.el package.  Now you can have a folding
-;; editor for c-mode without any effort!
-
-;; 1.7	  7-Mar-94
-;; I got fed up trying to work out how many blank lines there were outside the
-;; narrowed region when inside a fold.  Now *all* newlines before the following
-;; heading are *in* the narrowed region.  Thus, if the cursor is at point-max,
-;; the number of blank lines above it is the number you'll get above the next
-;; heading.
-;;
-;; Since all newlines are now inside the narrowed region, when exiting a fold
-;; add a newline at the end of the region if there isn't one so that the
-;; following heading doesn't accidentally get joined to the body text.
-;;
-;; Bugfix: `foldout-mouse-modifiers' should be `defvar', not `defconst'.
-;;
-;; Use "cond" instead of "case" so that lemacs-19.9 users can use the mouse.
-;;
-;; Improve "Commentary" entry on using the mouse.
-;;
-;; Add "Installation" keyword.
-
-;; 1.6	  3-Mar-94
-;; Add mouse support functions foldout-mouse-zoom, foldout-mouse-show,
-;; foldout-mouse-hide-or-exit.
-
-;; 1.5	  11-Feb-94
-;; Rename `foldout-enter-subtree' to `foldout-zoom-subtree' and change
-;; keystroke from C-g to C-z.  This is more mnemonic and leaves C-g alone, as
-;; users expect this to cancel the current key sequence.
-;;
-;; Added better commentary at the request of RMS.  Added stuff to comply with
-;; the lisp-mnt.el conventions.  Added instructions on how best to load the
-;; package.
-
-;; 1.4	  2-Feb-94
-;; Bugfix: end-of-fold marking was wrong:-
-;;
-;;   End of narrowed region should be one character on from
-;;   (outline-end-of-subtree) so it includes the end-of-line at the end of the
-;;   last line of the subtree.
-;;
-;;   End-of-fold marker should be outside the narrowed region so text inserted
-;;   at the end of the region goes before the marker.  Need to make a special
-;;   case for end-of-buffer because it is impossible to set a marker that will
-;;   follow eob.  Bummer.
-
-;; 1.3	  28-Jan-94
-;; Changed `foldout-zoom-subtree'.  A zero arg now makes it expose the entire
-;; subtree on entering the fold.  As before, < 0 shows only the body and > 0
-;; shows only the subheadings.
-
-;; 1.2	  28-Jan-94
-;; Fixed a dumb bug - didn't make `foldout-modeline-string' buffer-local :-(
-;;
-;; Changed `foldout-exit-fold' to use prefix arg to say how many folds to exit.
-;; Negative arg means exit but don't hide text.  Zero arg means exit all folds.
-;;
-;; Added `foldout-inhibit-key-bindings' to inhibit key bindings.
-
-;; 1.1	  27-Jan-94
-;; Released to the net.  Inspired by a question in gnu.emacs.help from
-;; Jason D Lohn <jlohn@eng.umd.edu>.
-
-;;; Code:
-
-(require 'outline)
-
-;; something has gone very wrong if outline-minor-mode isn't bound now.
-(if (not (boundp 'outline-minor-mode))
-    (error "Can't find outline-minor-mode"))
-
-(defconst foldout-fold-list nil
-  "List of start and end markers for the folds currently entered.
-An end marker of NIL means the fold ends after (point-max).")
-(make-variable-buffer-local 'foldout-fold-list)
-
-(defconst foldout-modeline-string nil
-  "Modeline string announcing that we are in an outline fold.")
-(make-variable-buffer-local 'foldout-modeline-string)
-
-;; put our minor mode string immediately following outline-minor-mode's
-(or (assq 'foldout-modeline-string minor-mode-alist)
-    (let ((outl-entry (memq (assq 'outline-minor-mode minor-mode-alist)
-			    minor-mode-alist))
-	  (foldout-entry '((foldout-modeline-string foldout-modeline-string))))
-
-      ;; something's wrong with outline if we can't find it
-      (if (null outl-entry)
-	  (error "Can't find outline-minor-mode in minor-mode-alist"))
-
-      ;; slip our fold announcement into the list
-      (setcdr outl-entry (nconc foldout-entry (cdr outl-entry)))
-      ))
-
-;; outline-flag-region has different `flag' values in outline.el and
-;; noutline.el for hiding and showing text.
-
-(defconst foldout-hide-flag
-  (if (featurep 'noutline) t ?\^M))
-
-(defconst foldout-show-flag
-  (if (featurep 'noutline) nil ?\n))
-
-
-(defun foldout-zoom-subtree (&optional exposure)
-  "Open the subtree under the current heading and narrow to it.
-
-Normally the body and the immediate subheadings are exposed, but
-optional arg EXPOSURE \(interactively with prefix arg\) changes this:-
-
-	EXPOSURE > 0	exposes n levels of subheadings (c.f. show-children)
-	EXPOSURE < 0	exposes only the body
-	EXPOSURE = 0	exposes the entire subtree"
-  (interactive "P")
-  (save-excursion
-    (widen)
-    (outline-back-to-heading)
-    (let* ((exposure-value (prefix-numeric-value exposure))
-	   (start (point))
-	   (start-marker (point-marker))
-	   (end (progn (outline-end-of-subtree)
-		       (skip-chars-forward "\n\^M")
-		       (point)))
-	   ;; I need a marker that will follow the end of the region even when
-	   ;; text is inserted right at the end.  Text gets inserted *after*
-	   ;; markers, so I need it at end+1.  Unfortunately I can't set a
-	   ;; marker at (point-max)+1, so I use NIL to mean the region ends at
-	   ;; (point-max).
-	   (end-marker (if (eobp) nil (set-marker (make-marker) (1+ end))))
-	   )
-
-      ;; narrow to this subtree
-      (narrow-to-region start end)
-
-      ;; show the body and/or subheadings for this heading
-      (goto-char start)
-      (cond
-       ((null exposure)
-	(show-entry)
-	(show-children))
-       ((< exposure-value 0)
-	(show-entry))
-       ((consp exposure)
-	(show-children))
-       ((> exposure-value 0)
-	(show-children exposure-value))
-       (t
-	(show-subtree))
-       )
-
-      ;; save the location of the fold we are entering
-      (setq foldout-fold-list (cons (cons start-marker end-marker)
-				    foldout-fold-list))
-
-      ;; update the modeline
-      (foldout-update-modeline)
-      )))
-
-
-(defun foldout-exit-fold (&optional num-folds)
-  "Return to the ARG'th enclosing fold view.  With ARG = 0 exit all folds.
-
-Normally causes exited folds to be hidden, but with ARG < 0, -ARG folds are
-exited and text is left visible."
-  (interactive "p")
-  (let (start-marker end-marker (hide-fold t))
-
-    ;; check there are some folds to leave
-    (if (null foldout-fold-list)
-	(error "Not in a fold!"))
-
-    (cond
-     ;; catch a request to leave all folds
-     ((zerop num-folds)
-      (setq num-folds (length foldout-fold-list)))
- 
-     ;; have we been told not to hide the fold?
-     ((< num-folds 0)
-      (setq hide-fold nil
-	    num-folds (- num-folds)))
-     )
-
-    ;; limit the number of folds if we've been told to exit too many
-    (setq num-folds (min num-folds (length foldout-fold-list)))
-
-    ;; exit the folds
-    (widen)
-    (while (not (zerop num-folds))
-      ;; get the fold at the top of the stack
-      (setq start-marker (car (car foldout-fold-list))
-	    end-marker (cdr (car foldout-fold-list))
-	    foldout-fold-list (cdr foldout-fold-list)
-	    num-folds (1- num-folds))
-
-      ;; Make sure there is a newline at the end of this fold,
-      ;; otherwise the following heading will get joined to the body
-      ;; text.
-      (if end-marker
-	  (progn
-	    (goto-char end-marker)
-	    (forward-char -1)
-	    (or (memq (preceding-char) '(?\n ?\^M))
-		(insert ?\n))))
-
-      ;; If this is the last fold to exit, hide the text unless we've
-      ;; been told not to.  Note that at the moment point is at the
-      ;; beginning of the following heading if there is one.
-
-      ;; Also, make sure that the newline before the following heading
-      ;; is \n otherwise it will be hidden.  If there is a newline
-      ;; before this one, make it visible too so we do the same as
-      ;; outline.el and leave a blank line before the heading.
-      (if (zerop num-folds)
-	  (let ((beginning-of-heading (point))
-		(end-of-subtree (if end-marker
-				    (progn
-				      (forward-char -1)
-				      (if (memq (preceding-char)
-						'(?\n ?\^M))
-					  (forward-char -1))
-				      (point))
-				  (point-max))))
-	    ;; hide the subtree
-	    (if hide-fold
-		(outline-flag-region start-marker end-of-subtree
-				     foldout-hide-flag))
-
-	    ;; make sure the next heading is exposed
-	    (if end-marker
-		(outline-flag-region end-of-subtree beginning-of-heading
-				     foldout-show-flag))
-	    ))
-
-      ;; zap the markers so they don't slow down editing
-      (set-marker start-marker nil)
-      (if end-marker (set-marker end-marker nil))
-      )
-
-    ;; narrow to the enclosing fold if there is one
-    (if foldout-fold-list
-	(progn
-	  (setq start-marker (car (car foldout-fold-list))
-		end-marker (cdr (car foldout-fold-list)))
-	  (narrow-to-region start-marker
-			    (if end-marker
-				(1- (marker-position end-marker))
-			      (point-max)))
-	  ))
-    (recenter)
-
-    ;; update the modeline
-    (foldout-update-modeline)
-    ))
-
-
-(defun foldout-update-modeline ()
-  "Set the modeline string to indicate our fold depth."
-  (let ((depth (length foldout-fold-list)))
-    (setq foldout-modeline-string
-	  (cond
-	   ;; if we're not in a fold, keep quiet
-	   ((zerop depth)
-	    nil)
-	   ;; in outline-minor-mode we're after "Outl:xx" in the modeline
-	   (outline-minor-mode
-	    (format ":%d" depth))
-	   ;; otherwise just announce the depth (I guess we're in outline-mode)
-	   ((= depth 1)
-	    " Inside 1 fold")
-	   (t
-	    (format " Inside %d folds" depth))
-	   ))))
-
-
-(defun foldout-mouse-zoom (event)
-  "Zoom in on the heading clicked on.
-
-How much is exposed by the zoom depends on the number of mouse clicks:-
-
-	1	expose body
-	2	expose subheadings
-	3	expose body and subheadings
-	4	expose entire subtree"
-  (interactive "@e")
-
-  ;; swallow intervening mouse events so we only get the final click-count.
-  (setq event (foldout-mouse-swallow-events event))
-
-  ;; go to the heading clicked on
-  (foldout-mouse-goto-heading event)
-
-  ;; zoom away
-  (foldout-zoom-subtree
-   (let ((nclicks (event-click-count event)))
-     (cond
-      ((= nclicks 1) -1)		; body only
-      ((= nclicks 2) '(1))		; subheadings only
-      ((= nclicks 3) nil)		; body and subheadings
-      (t 0)))))				; entire subtree
-
-(defun foldout-mouse-show (event)
-  "Show what is hidden under the heading clicked on.
-
-What gets exposed depends on the number of mouse clicks:-
-
-	1	expose body
-	2	expose subheadings
-	3	expose body and subheadings
-	4	expose entire subtree"
-  (interactive "@e")
-
-  ;; swallow intervening mouse events so we only get the final click-count.
-  (setq event (foldout-mouse-swallow-events event))
-
-  ;; expose the text
-  (foldout-mouse-goto-heading event)
-  (let ((nclicks (event-click-count event)))
-    (cond
-     ((= nclicks 1) (show-entry))
-     ((= nclicks 2) (show-children))
-     ((= nclicks 3) (show-entry) (show-children))
-     (t (show-subtree)))))
-
-(defun foldout-mouse-hide-or-exit (event)
-  "Hide the subtree under the heading clicked on, or exit a fold.
-
-What happens depends on the number of mouse clicks:-
-
-	1	hide subtree
-	2	exit fold and hide text
-	3	exit fold without hiding text
-	4	exit all folds and hide text"
-  (interactive "@e")
-
-  ;; swallow intervening mouse events so we only get the final click-count.
-  (setq event (foldout-mouse-swallow-events event))
-
-  ;; hide or exit
-  (let ((nclicks (event-click-count event)))
-    (if (= nclicks 1)
-	(progn
-	  (foldout-mouse-goto-heading event)
-	  (hide-subtree))
-      (foldout-exit-fold
-       (cond
-	((= nclicks 2) 1)		; exit and hide
-	((= nclicks 3) -1)		; exit don't hide
-	(t 0))))))			; exit all
-
-
-(defun foldout-mouse-swallow-events (event)
-  "Swallow intervening mouse events so we only get the final click-count.
-Signal an error if the final event isn't the same type as the first one."
-  (let ((initial-event-type (event-basic-type event)))
-    (while (null (sit-for 0 double-click-time 'nodisplay))
-      (setq event (read-event)))
-    (or (eq initial-event-type (event-basic-type event))
-	(error "")))
-  event)
-
-(defun foldout-mouse-goto-heading (event)
-  "Go to the heading where the mouse event started.  Signal an error
-if the event didn't occur on a heading."
-  (goto-char (posn-point (event-start event)))
-  (or (outline-on-heading-p)
-      ;; outline.el sometimes treats beginning-of-buffer as a heading
-      ;; even though outline-on-heading returns nil.
-      (save-excursion (beginning-of-line) (bobp))
-      (error "Not a heading line")))
-
-
-;;; Keymaps:
-
-(defvar foldout-inhibit-key-bindings nil
-  "Set non-NIL before loading foldout to inhibit key bindings.")
-
-(defvar foldout-mouse-modifiers '(meta control)
-  "List of modifier keys to apply to foldout's mouse events.
-
-The default (meta control) makes foldout bind its functions to
-M-C-down-mouse-{1,2,3}.
-
-Valid modifiers are shift, control, meta, alt, hyper and super.")
-
-(if foldout-inhibit-key-bindings
-    ()
-  (define-key outline-mode-map "\C-c\C-z" 'foldout-zoom-subtree)
-  (define-key outline-mode-map "\C-c\C-x" 'foldout-exit-fold)
-  (define-key outline-minor-mode-map
-    (concat outline-minor-mode-prefix "\C-z") 'foldout-zoom-subtree)
-  (define-key outline-minor-mode-map
-    (concat outline-minor-mode-prefix "\C-x") 'foldout-exit-fold)
-
-  (let* ((modifiers (apply 'concat
-			   (mapcar (function
-				    (lambda (modifier)
-				      (vector
-				       (cond
-					 ((eq modifier 'shift) ?S)
-					 ((eq modifier 'control) ?C)
-					 ((eq modifier 'meta) ?M)
-					 ((eq modifier 'alt) ?A)
-					 ((eq modifier 'hyper) ?H)
-					 ((eq modifier 'super) ?s)
-					 (t (error "invalid mouse modifier %s"
-						   modifier)))
-				       ?-)))
-				   foldout-mouse-modifiers)))
-	 (mouse-1 (vector (intern (concat modifiers "down-mouse-1"))))
-	 (mouse-2 (vector (intern (concat modifiers "down-mouse-2"))))
-	 (mouse-3 (vector (intern (concat modifiers "down-mouse-3")))))
-
-    (define-key outline-mode-map mouse-1 'foldout-mouse-zoom)
-    (define-key outline-mode-map mouse-2 'foldout-mouse-show)
-    (define-key outline-mode-map mouse-3 'foldout-mouse-hide-or-exit)
-
-    (define-key outline-minor-mode-map mouse-1 'foldout-mouse-zoom)
-    (define-key outline-minor-mode-map mouse-2 'foldout-mouse-show)
-    (define-key outline-minor-mode-map mouse-3 'foldout-mouse-hide-or-exit)
-    ))
-
-(provide 'foldout)
-
-;;; foldout.el ends here
-
diff --git a/lisp/follow.el b/lisp/follow.el
deleted file mode 100644
index 80f143fba72..00000000000
--- a/lisp/follow.el
+++ /dev/null
@@ -1,2430 +0,0 @@
-;;; follow.el --- Minor mode, Synchronize windows showing the same buffer.
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Anders Lindgren <andersl@csd.uu.se>
-;; Maintainer: Anders Lindgren <andersl@csd.uu.se>
-;; Created: 25 May 1995
-;; Version: 1.6
-;; Keywords: display, window, minor-mode
-;; Date: 20 Feb 1996
-
-;; 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:
-
-;;{{{ Documentation
-
-;; `Follow mode' is a minor mode for Emacs 19 and XEmacs which
-;; combines windows into one tall virtual window.
-;;
-;; The feeling of a "virtual window" has been accomplished by the use
-;; of two major techniques:
-;;
-;; * The windows always displays adjacent sections of the buffer. 
-;;   This means that whenever one window is moved, all the
-;;   others will follow.  (Hence the name Follow Mode.)
-;;
-;; * Should the point (cursor) end up outside a window, another 
-;;   window displaying that point is selected, if possible.  This 
-;;   makes it possible to walk between windows using normal cursor 
-;;   movement commands.
-;;
-;; Follow mode comes to its prime when used on a large screen and two
-;; side-by-side window are used. The user can, with the help of Follow
-;; mode, use two full-height windows as though they would have been
-;; one. Imagine yourself editing a large function, or section of text,
-;; and beeing able to use 144 lines instead of the normal 72... (your
-;; mileage may vary).
-
-;; The latest version, and a demonstration, are avaiable at:
-;;
-;;	ftp://ftp.csd.uu.se/pub/users/andersl/emacs/follow.el
-;;	http://www.csd.uu.se/~andersl/follow.shtml
-
-;; `Follow mode' can be used together with Emacs 19 and XEmacs.
-;; It has been tested together with Emacs 19.27, 19.28, 19.29,
-;; 19.30, XEmacs 19.12, and 19.13.
-
-
-;; To test this package, make sure `follow' is loaded, or will be
-;; autoloaded when activated (see below). Then do the following:
-;;
-;; * Find your favorite file (preferably a long one.)
-;;
-;; * Resize Emacs so that it will be wide enough for two full sized
-;;   columns.  Delete the other windows and split with the commands
-;;   `C-x 1 C-x 3'.
-;;
-;; * Give the command:
-;;	M-x follow-mode <RETURN>
-;;
-;; * Now the display should look something like (assuming the text "71"
-;;   is on line 71):
-;;
-;;		    +----------+----------+
-;;		    |1         |73        |
-;;		    |2         |74        |
-;;		    |3         |75        |
-;;		         ...        ...   
-;;		    |71        |143       |
-;;		    |72        |144       |
-;;		    +----------+----------+
-;;
-;;   As you can see, the right-hand window starts at line 73, the line
-;;   immediately below the end of the left-hand window. As long as
-;;   `follow-mode' is active, the two windows will follow eachother!
-;;
-;; * Play around and enjoy! Scroll one window and watch the other.
-;;   Jump to the beginning or end. Press `Cursor down' at the last
-;;   line of the left-hand window. Enter new lines into the
-;;   text. Enter long lines spanning several lines, or several
-;;   windows.
-;;
-;; * Should you find `Follow' mode annoying, just type
-;;	M-x follow-mode <RETURN> 
-;;   to turn it off.
-
-
-;; Installation:
-;;
-;; To fully install this, add this file to your Emacs Lisp directory and
-;; compile it with M-x byte-compile-file.  Then add the following to the
-;; appropriate init file (normally your `~/.emacs' file):
-;;
-;; (autoload 'follow-mode "follow"
-;;   "Synchronize windows showing the same buffer, minor mode." t)
-
-
-;; The command `follow-delete-other-windows-and-split' maximises the
-;; visible area of the current buffer.
-;;
-;; I recommend adding it, and `follow-mode', to hotkeys in the global
-;; key map.  To do so, add the following lines (replacing `[f7]' and
-;; `[f8]' with your favorite keys) to the init file:
-;;
-;; (autoload 'follow-mode "follow"
-;;   "Synchronize windows showing the same buffer, minor mode." t)
-;; (global-set-key [f8] 'follow-mode)
-;;
-;; (autoload 'follow-delete-other-windows-and-split "follow"
-;;   "Delete other windows, split the frame in two, and enter Follow Mode." t)
-;; (global-set-key [f7] 'follow-delete-other-windows-and-split)
-
-
-;; There exists two system variables which controls the appearence of
-;; lines which are wider than the window containing them.  The default
-;; is to truncate long lines whenever a window isn't as wide as the
-;; frame.
-;;
-;; To make sure lines are never truncated, please place the following
-;; lines in your init file:
-;;
-;; (setq truncate-lines nil)
-;; (setq truncate-partial-width-windows nil)
-
-
-;; Since the display of XEmacs is pixel-oriented, a line could be
-;; clipped in half at the bottom of the window.
-;;
-;; To make XEmacs avoid clipping (normal) lines, please place the
-;; following line in your init-file:
-;;
-;; (setq pixel-vertical-clip-threshold 30)
-
-
-;; The correct way to cofigurate Follow mode, or any other mode for
-;; that matter, is to create one (or more) function which does
-;; whatever you would like to do.  The function is then added to
-;; a hook.
-;;
-;; When `Follow' mode is activated, functions stored in the hook
-;; `follow-mode-hook' are called.  When it is deactivated
-;; `follow-mode-off-hook' is runed.
-;;
-;; The keymap `follow-key-map' contains key bindings activated by
-;; `follow-mode'.
-;;
-;; Example:
-;; (add-hook 'follow-mode-hook 'my-follow-mode-hook)
-;;
-;; (defun my-follow-mode-hook ()
-;;    (define-key follow-mode-map "\C-ca" 'your-favorite-function)
-;;    (define-key follow-mode-map "\C-cb" 'another-function))
-
-
-;; Usage:
-;;
-;; To activate give the command:  M-x follow-mode
-;; and press return. To deactivate, do it again.
-;;
-;; Some special commands have been developed to make life even easier:
-;;	follow-scroll-up			 C-c . C-v
-;;		Scroll text in a Follow Mode window chain up.
-;;
-;;	follow-scroll-down			 C-c . v
-;;		Like `follow-scroll-up', but in the other direction.
-;;
-;;	follow-delete-other-windows-and-split	 C-c . 1
-;;		Maximise the visible area of the current buffer,
-;;		and enter Follow Mode. 	This is a very convenient
-;;		way to start Follow Mode, hence it is recomended
-;;		that this command is added to the global keymap.
-;;
-;;	follow-recenter				 C-c . C-l
-;;		Place the point in the center of the middle window,
-;;		or a specified number of lines from either top or bottom.
-;;
-;;	follow-switch-to-buffer			 C-c . b
-;;		Switch buffer in all windows displaying the current buffer
-;;		in this frame.
-;;
-;;	follow-switch-to-buffer-all		 C-c . C-b
-;;		Switch buffer in all windows in the active frame.
-;;
-;;	follow-switch-to-current-buffer-all
-;;		Show the current buffer in all windows on the current
-;;		frame and turn on `follow-mode'.
-;;
-;;	follow-first-window			 C-c . <
-;;		Select the first window in the frame showing the same buffer.
-;;
-;;	follow-last-window			 C-c . >
-;;		Select the last window in the frame showing the same buffer.
-;;
-;;	follow-next-window			 C-c . n
-;;		Select the next window in the frame showing the same buffer.
-;;
-;;	follow-previous-window			 C-c . p
-;;		Select the previous window showing the same buffer.
-
-
-;; Well, it seems ok, but what if I really want to look at two different
-;; positions in the text? Here are two simple methods to use:
-;;
-;; 1) Use multiple frames; `follow' mode only affects windows displayed
-;;    in the same frame. (My apoligies to you who can't use frames.)
-;;
-;; 2) Bind `follow-mode' to key so you can turn it off whenever
-;;    you want to view two locations. Of course, `follow' mode can
-;;    be reactivated by hitting the same key again.
-;;
-;;    Example from my ~/.emacs:
-;;	(global-set-key [f8] 'follow-mode)
-
-
-;; Implementation: 
-;;
-;; In an ideal world, follow mode would have been implemented in the
-;; kernal of the display routines, making sure that the windows (in
-;; follow mode) ALWAYS are aligned. On planet earth, however, we must
-;; accept a solution where we ALMOST ALWAYS can make sure that the
-;; windows are aligned.
-;;
-;; Follow mode does this in three places:
-;; 1) After each user command.
-;; 2) After a process output has been perfomed.
-;; 3) When a scrollbar has been moved.
-;;
-;; This will cover most situations. (Let me know if there are other
-;; situations which should be covered.)
-;;
-;; However, only the selected window is checked, for the reason of
-;; efficiency and code complexity. (i.e. it is possible to make a
-;; non-selected windows unaligned. It will, however, pop right back
-;; when it is selected.)
-
-;;}}}
-;;{{{ Change Log
-
-;;; Change log:
-;;	25-May-95 andersl  * File created.
-;;	26-May-95 andersl  * It works!
-;;	27-May-95 andersl  * Avoids hitting the head in the roof.
-;;		           * follow-scroll-up, -scroll-down, and -recenter.
-;;		           * V0.1 Sent to Ohio.
-;;	28-May-95 andersl  * Scroll-bar support added.
-;;	30-May-95 andersl  * Code adopted to standard style.
-;;			   * Minor mode keymap.
-;;	 2-Jun-95 andersl  * Processor output.
-;;	 3-Jun-95 andersl  * V0.4
-;;	 5-Jun-95 andersl  * V0.5. Copyright notice corrected.
-;;			     (The old one stated that I had copyright, but
-;;			     that Emacs could be freely distributed ;-)  )
-;;	 6-Jun-95 andersl  * Lucid support added. (no longer valid.)
-;;	 7-Jun-95 andersl  * Menu bar added.
-;;			   * Bug fix, (at-window 0 0) => (frame-first-window)
-;;	15-Jun-95 andersl  * 0.8 Major rework. looong lines and outline mode.
-;;	18-Jun-95 andersl  * 0.9 Allow a tail window to be selected, but pick
-;;			     a better one when edited.
-;;	26-Jun-95 andersl  * Inlineing.
-;;      02-Jul-95 andersl  * compute-motion imitated with a ugly workaround,
-;;			     Works with XEmacs again!
-;;	15-Jul-95 andersl  * find-file hook.
-;;                         * submit-feedback.
-;;                         * Survives major mode changes.
-;;                         * Region spanning multiple windows looks 
-;;			       resonabely good.
-;;	19-Jul-95 andersl  * New process-filter handling.
-;;	 1-Aug-95 andersl  * XEmacs scrollbar support.
-;;			   * Emacs 19 `window-size-change' support.
-;;			   * `save-window-excursion' removed, it triggered
-;;			     a redraw!
-;;	 5-Aug-95 andersl  * `follow-switch-to-current-buffer-all' added.
-;;	16-Nov-95 andersl  * V1.0 released!
-;;	17-Nov-95 andersl  * Byte compiler silencer for XEmacs broken.
-;;			   * fkey-end-of-buffer treated the same way 
-;;			     end-of-buffer is.
-;;			   * follow-mode-off-hook added. 
-;;			     (Suggested by David Hughes, thanks!)
-;;	20-Nov-95 andersl  * Bug in menu code corrected.
-;;			     (Reported by Robert E. Brown, thanks!)
-;;	 5-Dec-95 andersl  * `follow-avoid-tail-recenter' added to the
-;;			     post-command-idle-hook to avoid recentering
-;;			     caused by `paren' et. al.
-;;	 7-Dec-95 andersl  * `follow-avoid-tail-recenter' called by
-;;			     `window-scroll-functions'.
-;;	18-Dec-95 andersl  * All processes intercepted.
-;;	20-Dec-95 andersl  * `follow-recenter' accepts arguments.
-;;                         * `move-overlay' advices, drag-region works.
-;;	 2-Jan-96 andersl  * XEmacs: isearch fixed.
-;;                         * `follow-calc-win-end' created.
-;;       8-Jan-96 andersl  * XEmacs: `window-end' with `guarantee'
-;;                           argument used in `follow-calc-win-end'.
-;;       9-Jan-96 andersl  * `follow-end-of-buffer' added. 
-;;                           Code in post hook removed.
-;;                         * XEmacs: Post hook is always executed
-;;			     after a mouse button event.
-;;      22-Jan-96 andersl  * 1.5 released.
-;;
-
-;;}}}
-;;{{{ LCD Entry
-
-;;; LCD Archive Entry:
-;; follow|Anders Lindgren|andersl@csd.uu.se|
-;; Combines windows into tall virtual window, minor mode.
-;; 20-Feb-1996|1.6|~/modes/follow.el.Z|
-
-;;}}}
-
-;;; Code:
-
-;;{{{ Preliminaries
-
-;; Make the compiler shut up!
-;; There are two strategies:
-;; 1) Shut warnings off completely.
-;; 2) Handle each warning separately.
-;;
-;; Since I would like to see real errors, I've selected the latter
-;; method.
-;;
-;; The problem with undefined variables and functions has been solved
-;; by using `set', `symbol-value' and `symbol-function' rather than
-;; `setq' and direct references to variables and functions.
-;;
-;; For example:
-;;	(if (boundp 'foo)   ... (symbol-value 'foo) )
-;;	(set 'foo ...)   <-- XEmacs doesn't fall for this one.
-;;	(funcall (symbol-function 'set) 'bar ...)
-;;
-;; Note: When this file is interpreted, `eval-when-compile' is
-;; evaluted (really smart...)  Since it doesn't hurt to evaluate it,
-;; but it is a bit annoying, we test if the byte-compiler has been
-;; loaded.  This can, of course, lead to some occasional unintended
-;; evaluation...
-;;
-;; Should someone come up with a better solution, please let me
-;; know.
-
-(eval-when-compile
-  (if (or (featurep 'bytecomp)
-	  (featurep 'byte-compile))
-      (cond ((string-match "XEmacs" emacs-version)
-	     ;; Make XEmacs shut up!  I'm using standard Emacs
-	     ;; functions, they are NOT obsolete!
-	     (if (eq (get 'force-mode-line-update 'byte-compile)
-		     'byte-compile-obsolete)
-		 (put 'force-mode-line-update 'byte-compile 'nil))
-	     (if (eq (get 'frame-first-window 'byte-compile)
-		     'byte-compile-obsolete)
-		 (put 'frame-first-window 'byte-compile 'nil))))))
-
-;;}}}
-;;{{{ Variables
-
-(defvar follow-mode nil
-  "Variable indicating if Follow mode is active.")
-
-(defvar follow-mode-hook nil
-  "*Hooks to run when follow-mode is turned on.")
-
-(defvar follow-mode-off-hook nil
-  "*Hooks to run when follow-mode is turned off.")
-
-(defvar follow-mode-version "follow.el (Release 1.6)"
-  "The current version of Follow mode.")
-
-(defvar follow-mode-map nil
-  "*Minor mode keymap for Follow mode.")
-
-(defvar follow-mode-line-text " Follow"
-  "*Text shown in the mode line when Follow mode is active.  
-Defaults to \" Follow\".  Examples of other values
-are \" Fw\", or simply \"\".")
-
-(defvar follow-auto nil
-  "*Non-nil activates Follow mode whenever a file is loaded.")
-
-(defvar follow-mode-prefix "\C-c."
-  "*Prefix key to use for follow commands in Follow mode.
-The value of this variable is checked as part of loading Follow mode.
-After that, changing the prefix key requires manipulating keymaps.")
-
-(defvar follow-intercept-processes t
-  "*When non-nil, Follow Mode will monitor process output.")
-
-(defvar follow-emacs-version-xemacs-p 
-  (string-match "XEmacs" emacs-version)
-  "Non-nil when running under XEmacs.")
-
-(defvar follow-avoid-tail-recenter-p 
-  (not follow-emacs-version-xemacs-p)
-  "*When non-nil, patch emacs so that tail windows won't be recentered.
-
-A \"tail window\" is a window which displays only the end of 
-the buffer.  Normally it is practical for the user that empty
-windows are recentered automatically.  However, when using 
-Follow Mode it breaks the display when the end is displayed 
-in a window \"above\" the last window.  This is for 
-example the case when displaying a short page in info.
-
-Must be set before Follow Mode is loaded.
-
-Please note that it is not possible to fully prevent Emacs from
-recentering empty windows.  Please report if you find a repeatable
-situation in which Emacs recenters empty windows.
-
-XEmacs, as of 19.12, does not recenter windows, good!")
-
-(defvar follow-cache-command-list
-  '(next-line previous-line forward-char backward-char)
-  "List of commands which don't require recalculation.
-
-In order to be able to use the cache, a command should not change the
-contents of the buffer, nor should it change selected window or current
-buffer.
-
-The commands in this list are checked at load time.
-
-To mark other commands as suitable for caching, set the symbol
-property `follow-mode-use-cache' to non-nil.")
-
-(defvar follow-debug nil
-  "*Non-nil when debugging Follow mode.")
-
-
-;; Internal variables:
-
-(defvar follow-internal-force-redisplay nil
-  "True when Follow mode should redisplay the windows.")
-
-(defvar follow-process-filter-alist '()
-  "The original filters for processes intercepted by Follow mode.")
-
-(defvar follow-active-menu nil
-  "The menu visible when Follow mode is active.")
-
-(defvar follow-deactive-menu nil
-  "The menu visible when Follow mode is deactivated.")
-
-(defvar follow-inside-post-command-hook nil
-  "Non-nil when inside Follow modes `post-command-hook'. 
-Used by `follow-window-size-change'.")
-
-(defvar follow-windows-start-end-cache nil
-  "Cache used by `follow-window-start-end'.")
-
-;;}}}
-;;{{{ Bug report
-
-(eval-when-compile (require 'reporter))
-
-(defun follow-submit-feedback ()
-  "Sumbit feedback on Follow mode to the author: andersl@csd.uu.se"
-  (interactive)
-  (require 'reporter)
-  (and (y-or-n-p "Do you really want to submit a report on Follow mode? ")
-       (reporter-submit-bug-report
-	"Anders Lindgren <andersl@csd.uu.se>"
-	follow-mode-version
-	'(post-command-hook 
-	  post-command-idle-hook
-	  pre-command-hook
-	  window-size-change-functions
-	  window-scroll-functions
-	  follow-mode-hook
-	  follow-mode-off-hook
-	  follow-auto 
-	  follow-intercept-processes
-	  follow-avoid-tail-recenter-p
-	  follow-process-filter-alist)
-	nil
-	nil
-	(concat 
-	 "Hi Anders!\n\n"
-	 "(I have read the section on how to report bugs in the "
-	 "Emacs manual.)\n\n"
-	 "Even though I know you are busy, I thought you might "
-	 "want to know...\n\n"))))
-
-;;}}}
-;;{{{ Debug messages
-
-;; This inline function must be as small as possible!
-;; Maybe we should define a macro which expands to nil if
-;; the varible is not set.
-
-(defsubst follow-debug-message (&rest args)
-  "Like message, but only active when `follow-debug' is non-nil."
-  (if (and (boundp 'follow-debug) follow-debug)
-      (apply 'message args)))
-
-;;}}}
-
-;;{{{ Keymap/Menu
-
-;;; Define keys for the follow-mode minor mode map and replace some
-;;; functions in the global map.  All `follow' mode special functions
-;;; can be found on (the somewhat cumbersome) "C-c . <key>"
-;;; (Control-C dot <key>). (As of Emacs 19.29 the keys
-;;; C-c <punctuation character> are reserved for minor modes.)
-;;;
-;;; To change the prefix, redefine `follow-mode-prefix' before
-;;; `follow' is loaded, or see the section on `follow-mode-hook'
-;;; above for an example of how to bind the keys the way you like.
-;;;
-;;; Please note that the keymap is defined the first time this file is
-;;; loaded.  Also note that the only legal way to manipulate the
-;;; keymap is to use `define-key'.  Don't change it using `setq' or
-;;; similar!
-
-
-(if follow-mode-map
-    nil
-  (setq follow-mode-map (make-sparse-keymap))
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-v"	'follow-scroll-up)
-    (define-key map "\M-v"	'follow-scroll-down)
-    (define-key map "v"		'follow-scroll-down)
-    (define-key map "1"		'follow-delete-other-windows-and-split)
-    (define-key map "b"		'follow-switch-to-buffer)
-    (define-key map "\C-b"	'follow-switch-to-buffer-all)
-    (define-key map "\C-l"	'follow-recenter)
-    (define-key map "<"		'follow-first-window)
-    (define-key map ">"		'follow-last-window)
-    (define-key map "n"		'follow-next-window)
-    (define-key map "p"		'follow-previous-window)
-
-    (define-key follow-mode-map follow-mode-prefix map)
-
-    ;; Replace the standard `end-of-buffer', when in Follow Mode.  (I
-    ;; don't see the point in trying to replace every function which
-    ;; could be enhanced in Follow mode.  End-of-buffer is a special
-    ;; case since it is very simple to define and it greatly enhances
-    ;; the look and feel of Follow mode.)
-    ;;
-    ;; (The function `substitute-key-definition' does not work
-    ;; in all versions of Emacs.)
-    (mapcar
-     (function 
-      (lambda (pair)
-	(let ((old (car pair))
-	      (new (cdr pair)))
-	  (mapcar (function (lambda (key) 
-			      (define-key follow-mode-map key new)))
-		  (where-is-internal old global-map)))))
-     '((end-of-buffer      . follow-end-of-buffer)
-       (fkey-end-of-buffer . follow-end-of-buffer)))
-
-    ;;;
-    ;;; The menu.
-    ;;;
-
-    (if (not follow-emacs-version-xemacs-p)
-
-	;;
-	;; Emacs 19
-	;;
-	(let ((menumap (funcall (symbol-function 'make-sparse-keymap)	
-			"Follow"))
-	      (count 0)
-	      id)
-	  (mapcar 
-	   (function 
-	    (lambda (item)
-	      (setq id 
-		    (or (cdr item)
-			(progn
-			  (setq count (+ count 1))
-			  (intern (format "separator-%d" count)))))
-	      (define-key menumap (vector id) item)
-	      (or (eq id 'follow-mode)
-		  (put id 'menu-enable 'follow-mode))))
-	   ;; In reverse order:
-	   '(("Toggle Follow mode" . follow-mode)
-	     ("--")
-	     ("Recenter"           . follow-recenter)
-	     ("--")
-	     ("Previous Window"    . follow-previous-window)
-	     ("Next Windows"       . follow-next-window)
-	     ("Last Window"        . follow-last-window)
-	     ("First Window"       . follow-first-window)
-	     ("--")
-	     ("Switch To Buffer (all windows)"
-	                           . follow-switch-to-buffer-all)
-	     ("Switch To Buffer"   . follow-switch-to-buffer)
-	     ("--")
-	     ("Delete Other Windows and Split"
-	                           . follow-delete-other-windows-and-split)
-	     ("--")
-	     ("Scroll Down"        . follow-scroll-down)
-	     ("Scroll Up"          . follow-scroll-up)))
-	  
-	  ;; If there is a `tools' meny, we use it. However, we can't add a
-	  ;; minor-mode specific item to it (it's broken), so we make the
-	  ;; contents ghosted when not in use, and add ourselves to the
-	  ;; global map.  If no `tools' menu is present, just make a
-	  ;; top-level menu visible when the mode is activated.
-	  
-	  (let ((tools-map (lookup-key (current-global-map) [menu-bar tools]))
-		(last nil))
-	    (if (sequencep tools-map)
-		(progn
-		  ;; Find the last entry in the menu and store it in `last'.
-		  (mapcar (function
-			   (lambda (x) 
-			     (setq last (or (cdr-safe 
-					     (cdr-safe 
-					      (cdr-safe x))) 
-					    last))))
-			  tools-map)
-		  (if last
-		      (progn
-			(funcall (symbol-function 'define-key-after)
-				  tools-map [separator-follow] '("--") last)
-			(funcall (symbol-function 'define-key-after)
-				 tools-map [follow] (cons "Follow" menumap)
-				 'separator-follow))
-		    ;; Didn't find the last item, Adding to the top of
-		    ;; tools.  (This will probably never happend...)
-		    (define-key (current-global-map) [menu-bar tools follow]
-		      (cons "Follow" menumap))))
-	      ;; No tools menu, add "Follow" to the menubar.
-	      (define-key follow-mode-map [menu-bar follow]
-		(cons "Follow" menumap)))))
-
-      ;;
-      ;; XEmacs.
-      ;;
-
-      ;; place the menu in the `Tools' menu.
-      (let ((menu '("Follow"
-		    :filter follow-menu-filter
-		    ["Scroll Up" follow-scroll-up t]
-		    ["Scroll Down" follow-scroll-down t]
-		    ["Delete Other Windows and Split"
-		     follow-delete-other-windows-and-split t]
-		    ["Switch To Buffer" follow-switch-to-buffer t]
-		    ["Switch To Buffer (all windows)" 
-		     follow-switch-to-buffer-all t]
-		    ["First Window" follow-first-window t]
-		    ["Last Window" follow-last-window t]
-		    ["Next Windows" follow-next-window t]
-		    ["Previous Window" follow-previous-window t]
-		    ["Recenter" follow-recenter t]
-		    ["Deactivate" follow-mode t])))
-
-	;; Why not just `(set-buffer-menubar current-menubar)'?  The
-	;; question is a very good question.  The reason is that under
-	;; Emacs 19, neither `set-buffer-menubar' nor
-	;; `current-menubar' is defined, hence the byte-compiler will
-	;; warn.
-	(funcall (symbol-function 'set-buffer-menubar)
-		 (symbol-value 'current-menubar))
-	(funcall (symbol-function 'add-submenu) '("Tools") menu))
-
-      ;; When the mode is not activated, only one item is visible:
-      ;; "Activate".
-      (defun follow-menu-filter (menu)
-	(if follow-mode
-	    menu
-	  '(["Activate          " follow-mode t]))))))
-
-
-;;; Register the follow mode keymap.
-(or (assq 'follow-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-	  (cons (cons 'follow-mode follow-mode-map) minor-mode-map-alist)))
-
-;;}}}
-;;{{{ Cache
-
-(let ((cmds follow-cache-command-list))
-  (while cmds
-    (put (car cmds) 'follow-mode-use-cache t)
-    (setq cmds (cdr cmds))))
-
-;;}}}
-
-;;{{{ The mode
-
-;;;###autoload
-(defun turn-on-follow-mode ()
-  "Turn on Follow mode. Please see the function `follow-mode'."
-  (interactive)
-  (follow-mode 1))
-
-
-;;;###autoload
-(defun turn-off-follow-mode ()
-  "Turn off Follow mode. Please see the function `follow-mode'."
-  (interactive)
-  (follow-mode -1))
-
-
-;;;###autoload
-(defun follow-mode (arg) 
-  "Minor mode which combines windows into one tall virtual window.
-
-The feeling of a \"virtual window\" has been accomplished by the use
-of two major techniques:
-
-* The windows always displays adjacent sections of the buffer. 
-  This means that whenever one window is moved, all the
-  others will follow.  (Hence the name Follow Mode.)
-
-* Should the point (cursor) end up outside a window, another 
-  window displaying that point is selected, if possible.  This 
-  makes it possible to walk between windows using normal cursor 
-  movement commands.
-
-Follow mode comes to its prime when used on a large screen and two
-side-by-side window are used. The user can, with the help of Follow
-mode, use two full-height windows as though they would have been
-one. Imagine yourself editing a large function, or section of text,
-and beeing able to use 144 lines instead of the normal 72... (your
-mileage may vary).
-
-To split one large window into two side-by-side windows, the commands
-`\\[split-window-horizontally]' or \
-`M-x follow-delete-other-windows-and-split' can be used.
-
-Only windows displayed in the same frame follow each-other.
-
-If the variable `follow-intercept-processes' is non-nil, Follow mode
-will listen to the output of processes and redisplay accordingly.
-\(This is the default.)
-
-When Follow mode is switched on, the hook `follow-mode-hook'
-is called.  When turned off, `follow-mode-off-hook' is called.
-
-Keys specific to Follow mode:
-\\{follow-mode-map}"
-  (interactive "P")
-  (make-local-variable 'follow-mode)
-  (put 'follow-mode 'permanent-local t)
-  (let ((follow-mode-orig follow-mode))
-    (setq follow-mode
-	  (if (null arg)
-	      (not follow-mode)
-	    (> (prefix-numeric-value arg) 0)))
-    (if (and follow-mode follow-intercept-processes)
-	(follow-intercept-process-output))
-    (cond ((and follow-mode (not follow-mode-orig)) ; On
-	   ;; XEmacs: If this is non-nil, the window will scroll before
-	   ;; the point will have a chance to get into the next window.
-	   (if (boundp 'scroll-on-clipped-lines)
-	       (set 'scroll-on-clipped-lines nil))
-	   (force-mode-line-update)
-	   (add-hook 'post-command-hook 'follow-post-command-hook t)
-	   (if (boundp 'post-command-idle-hook)
-	       (add-hook 'post-command-idle-hook 
-			 'follow-avoid-tail-recenter t))
-	   (run-hooks 'follow-mode-hook))
-
-	  ((and (not follow-mode) follow-mode-orig) ; Off
-	   (force-mode-line-update)
-	   (run-hooks 'follow-mode-off-hook)))))
-
-
-;; Register follow-mode as a minor mode.
-
-(if (fboundp 'add-minor-mode)
-    ;; XEmacs
-    (funcall (symbol-function 'add-minor-mode)
-	     'follow-mode 'follow-mode-line-text)
-  (or (assq 'follow-mode minor-mode-alist)
-      (setq minor-mode-alist
-	    (cons '(follow-mode follow-mode-line-text) minor-mode-alist))))
-
-;;}}}
-;;{{{ Find file hook
-
-;; This will start follow-mode whenever a new file is loaded, if
-;; the variable `follow-auto' is non-nil.
-
-(add-hook 'find-file-hooks 'follow-find-file-hook t)
-
-(defun follow-find-file-hook ()
-  "Find-file hook for Follow Mode.  See the variable `follow-auto'."
-  (if follow-auto (follow-mode t)))
-
-;;}}}
-
-;;{{{ User functions
-
-;;;
-;;; User functions usable when in Follow mode.
-;;;
-
-;;{{{ Scroll
-
-;; `scroll-up' and `-down', but for windows in Follow Mode.
-;;
-;; Almost like the real thing, excpet when the cursor ends up outside
-;; the top or bottom...  In our case however, we end up outside the
-;; window and hence we are recenterd.  Should we let `recenter' handle
-;; the point position we would never leave the selected window.  To do
-;; it ourselves we would need to do our own redisplay, which is easier
-;; said than done.  (Why didn't I do a real display abstraction from
-;; the beginning?)
-;;
-;; We must sometimes set `follow-internal-force-redisplay', otherwise
-;; our post-command-hook will move our windows back into the old
-;; position...  (This would also be corrected if we would have had a
-;; good redisplay abstraction.)
-
-(defun follow-scroll-up (&optional arg)
-  "Scroll text in a Follow Mode window chain up.
-
-If called with no ARG, the `next-screen-context-lines' last lines of
-the bottom window in the chain will be visible in the top window.
-
-If called with an argument, scroll ARG lines up.
-Negative ARG means scroll downward.
-
-Works like `scroll-up' when not in Follow Mode."
-  (interactive "P")
-  (cond ((not (and (boundp 'follow-mode) follow-mode))
-	 (scroll-up arg))
-	(arg
-	 (save-excursion (scroll-up arg))
-	 (setq follow-internal-force-redisplay t))
-	(t
-	 (let* ((windows (follow-all-followers))
-		(end (window-end (car (reverse windows)))))
-	   (if (eq end (point-max))
-	       (signal 'end-of-buffer nil)
-	     (select-window (car windows))
-	     (goto-char end)
-	     (vertical-motion (- next-screen-context-lines))
-	     (set-window-start (car windows) (point)))))))
-
-
-(defun follow-scroll-down (&optional arg)
-  "Scroll text in a Follow Mode window chain down.
-
-If called with no ARG, the `next-screen-context-lines' top lines of
-the top window in the chain will be visible in the bottom window.
-
-If called with an argument, scroll ARG lines down.
-Negative ARG means scroll upward.
-
-Works like `scroll-up' when not in Follow Mode."
-  (interactive "P")
-  (cond ((not (and (boundp 'follow-mode) follow-mode))
-	 (scroll-up arg))
-	(arg
-	 (save-excursion (scroll-down arg)))
-	(t
-	 (let* ((windows (follow-all-followers))
-		(win (car (reverse windows)))
-		(start (window-start (car windows))))
-	   (if (eq start (point-min))
-	       (signal 'beginning-of-buffer nil)
-	     (select-window win)
-	     (goto-char start)
-	     (vertical-motion (- (- (window-height win) 
-				    1 
-				    next-screen-context-lines)))
-	     (set-window-start win (point))
-	     (goto-char start)
-	     (vertical-motion (- next-screen-context-lines 1))
-	     (setq follow-internal-force-redisplay t))))))
-
-;;}}}
-;;{{{ Buffer
-
-;;;###autoload
-(defun follow-delete-other-windows-and-split (&optional arg)
-  "Create two side by side windows and enter Follow Mode.
-
-Execute this command to display as much as possible of the text
-in the selected window.  All other windows, in the current 
-frame, are deleted and the selected window is split in two
-side-by-side windows. Follow Mode is activated, hence the 
-two windows always will display two successive pages.
-\(If one window is moved, the other one will follow.)
-
-If ARG is positive, the leftmost window is selected.  If it negative,
-the rightmost is selected.  If ARG is nil, the leftmost window is
-selected if the original window is the first one in the frame.
-
-To bind this command to a hotkey, place the following line
-in your `~/.emacs' file, replacing [f7] by your favourite key:
-    (global-set-key [f7] 'follow-delete-other-windows-and-split)"
-  (interactive "P")
-  (let ((other (or (and (null arg) 
-			(not (eq (selected-window)
-				 (frame-first-window (selected-frame)))))
-		   (and arg
-			(< (prefix-numeric-value arg) 0))))
-	(start (window-start)))
-    (delete-other-windows)
-    (split-window-horizontally)
-    (if other 
-	(progn
-	  (other-window 1)
-	  (set-window-start (selected-window) start)
-	  (setq follow-internal-force-redisplay t)))
-    (follow-mode 1)))
-
-(defun follow-switch-to-buffer (buffer)
-  "Show BUFFER in all windows in the current Follow Mode window chain."
-  (interactive "BSwitch to Buffer: ")
-  (let ((orig-window (selected-window))
-	(windows (follow-all-followers)))
-    (while windows
-      (select-window (car windows))
-      (switch-to-buffer buffer)
-      (setq windows (cdr windows)))
-    (select-window orig-window)))
-
-
-(defun follow-switch-to-buffer-all (&optional buffer)
-  "Show BUFFER in all windows on this frame.
-Defaults to current buffer."
-  (interactive (list (read-buffer "Switch to Buffer: " 
-				  (current-buffer))))
-  (or buffer (setq buffer (current-buffer)))
-  (let ((orig-window (selected-window)))
-    (walk-windows 
-     (function 
-      (lambda (win)
-	(select-window win)
-	(switch-to-buffer buffer))))
-    (select-window orig-window)
-    (follow-redisplay)))
-
-
-(defun follow-switch-to-current-buffer-all ()
-  "Show current buffer in all windows on this frame, and enter Follow Mode.
-
-To bind this command to a hotkey place the following line 
-in your `~/.emacs' file:
-	(global-set-key [f7] 'follow-switch-to-current-buffer-all)"
-  (interactive)
-  (or (and (boundp 'follow-mode) follow-mode)
-      (follow-mode 1))
-  (follow-switch-to-buffer-all))
-
-;;}}}
-;;{{{ Movement
-
-;; Note, these functions are not very useful, atleast not unless you
-;; rebind the rather cumbersome key sequence `C-c . p'.
-
-(defun follow-next-window ()
-  "Select the next window showing the same buffer."
-  (interactive)
-  (let ((succ (cdr (follow-split-followers (follow-all-followers)))))
-    (if succ
-	(select-window (car succ))
-      (error "%s" "No more windows"))))
-
-
-(defun follow-previous-window ()
-  "Select the previous window showing the same buffer."
-  (interactive)
-  (let ((pred (car (follow-split-followers (follow-all-followers)))))
-    (if pred
-	(select-window (car pred))
-      (error "%s" "No more windows"))))
-
-
-(defun follow-first-window ()
-  "Select the first window in the frame showing the same buffer."
-  (interactive)
-  (select-window (car (follow-all-followers))))
-
-
-(defun follow-last-window ()
-  "Select the last window in the frame showing the same buffer."
-  (interactive)
-  (select-window (car (reverse (follow-all-followers)))))
-
-;;}}}
-;;{{{ Redraw
-
-(defun follow-recenter (&optional arg)
-  "Recenter the middle window around the point,
-and rearrange all other windows around the middle window.
-
-With a positive argument, place the current line ARG lines
-from the top.  With a negative, place it -ARG lines from the
-bottom."
-  (interactive "P")
-  (if arg
-      (let ((p (point))
-	    (arg (prefix-numeric-value arg)))
-	(if (>= arg 0)
-	    ;; Recenter relative to the top.
-	    (progn
-	      (follow-first-window)
-	      (goto-char p)
-	      (recenter arg))
-	  ;; Recenter relative to the bottom.
-	  (follow-last-window)
-	  (goto-char p)
-	  (recenter arg)
-	  ;; Otherwise, our post-command-hook will move the window
-	  ;; right back.
-	  (setq follow-internal-force-redisplay t)))
-    ;; Recenter in the middle.
-    (let* ((dest (point))
-	   (windows (follow-all-followers))
-	   (win (nth (/ (- (length windows) 1) 2) windows)))
-      (select-window win)
-      (goto-char dest)
-      (recenter)
-      ;;(setq follow-internal-force-redisplay t)
-      )))
-
-
-(defun follow-redraw ()
-  "Arrange windows displaying the same buffer in successor order.
-This function can be called even if the buffer is not in Follow mode.
-
-Hopefully, there should be no reason to call this function when in
-Follow mode since the windows should always be aligned."
-  (interactive)
-  (sit-for 0)
-  (follow-redisplay))
-
-;;}}}
-;;{{{ End of buffer
-
-(defun follow-end-of-buffer (&optional arg)
-  "Move point to the end of the buffer. Follow Mode style.
-
-If the end is not visible, it will be displayed in the last possible
-window in the Follow Mode window chain.
-
-The mark is left at the previous position. With arg N, put point N/10
-of the way from the true end."
-  (interactive "P")
-  (let ((followers (follow-all-followers))
-	(pos (point)))
-    (cond (arg
-	   (select-window (car (reverse followers))))
-	  ((follow-select-if-end-visible 
-	    (follow-windows-start-end followers)))
-	  (t
-	   (select-window (car (reverse followers)))))
-    (goto-char pos)
-    (end-of-buffer arg)))
-
-;;}}}
-
-;;}}}
-
-;;{{{ Display
-
-;;;; The display routines
-
-;;{{{ Information gathering functions
-
-(defun follow-all-followers (&optional testwin)
-  "Return all windows displaying the same buffer as the TESTWIN.
-The list contains only windows displayed in the same frame as TESTWIN.
-If TESTWIN is nil the selected window is used."
-  (or (and testwin (window-live-p testwin))
-      (setq testwin (selected-window)))
-  (let* ((top (frame-first-window (window-frame testwin)))
-	 (win top)
-	 (done nil)
-	 (windows '())
-	 (buffer (window-buffer testwin)))
-    (while (and (not done) win)
-      (if (eq (window-buffer win) buffer)
-	  (setq windows (cons win windows)))
-      (setq win (next-window win 'not))
-      (if (eq win top)
-	  (setq done t)))
-    (nreverse windows)))
-
-
-(defun follow-split-followers (windows &optional win)
-  "Split the WINDOWS into the sets: predecessors and successors.
-Return `(PRED . SUCC)' where `PRED' and `SUCC' are ordered starting 
-from the selected window."
-  (or win 
-      (setq win (selected-window)))
-  (let ((pred '()))
-    (while (not (eq (car windows) win))
-      (setq pred (cons (car windows) pred))
-      (setq windows (cdr windows)))
-    (cons pred (cdr windows))))
-
-
-;; Try to optimize this function for speed!
-
-(defun follow-calc-win-end (&optional win)
-  "Calculate the presumed window end for WIN.
-
-Actually, the position returned is the start of the next
-window, normally is the end plus one.
-
-If WIN is nil, the selected window is used.
-
-Returns (end-pos end-of-buffer-p)"
-  (if follow-emacs-version-xemacs-p
-      ;; XEmacs can calculate the end of the window by using
-      ;; the 'guarantee options. GOOD!
-      (let ((end (window-end win t)))
-	(if (= end (funcall (symbol-function 'point-max)
-			    (window-buffer win)))
-	    (list end t)
-	  (list (+ end 1) nil))) 
-    ;; Emacs 19: We have to calculate the end by ourselves.
-    ;; This code works on both XEmacs and Emacs 19, but now
-    ;; that XEmacs has got custom-written code, this could
-    ;; be optimized for Emacs 19.
-    (let ((orig-win (and win (selected-window)))
-	  height
-	  buffer-end-p)
-      (if win (select-window win))
-      (prog1
-	  (save-excursion
-	    (goto-char (window-start))
-	    (setq height (- (window-height) 1))
-	    (setq buffer-end-p
-		  (if (bolp)
-		      (not (= height (vertical-motion height)))
-		    (save-restriction
-		      ;; Fix a mis-feature in `vertical-motion':
-		      ;; The start of the window is assumed to
-		      ;; coinside with the start of a line.
-		      (narrow-to-region (point) (point-max))
-		      (not (= height (vertical-motion height))))))
-	    (list (point) buffer-end-p))
-	(if orig-win
-	    (select-window orig-win))))))
-
-
-;; Can't use `save-window-excursion' since it triggers a redraw.
-(defun follow-calc-win-start (windows pos win)
-  "Calculate where WIN will start if the first in WINDOWS start at POS.
-
-If WIN is nil the point below all windows is returned."
-  (let (start)
-    (while (and windows (not (eq (car windows) win)))
-      (setq start (window-start (car windows)))
-      (set-window-start (car windows) pos 'noforce)
-      (setq pos (car (inline (follow-calc-win-end (car windows)))))
-      (set-window-start (car windows) start 'noforce)
-      (setq windows (cdr windows)))
-    pos))
-
-
-;; The result from `follow-windows-start-end' is cached when using
-;; a handful simple commands, like cursor movement commands.
-
-(defsubst follow-cache-valid-p (windows)
-  "Test if the cached value of `follow-windows-start-end' can be used.
-Note that this handles the case when the cache has been set to nil."
-  (let ((res t)
-	(cache follow-windows-start-end-cache))
-    (while (and res windows cache)
-      (setq res (and (eq (car windows)
-			 (car (car cache)))
-		     (eq (window-start (car windows))
-			 (car (cdr (car cache))))))
-      (setq windows (cdr windows))
-      (setq cache (cdr cache)))
-    (and res (null windows) (null cache))))
-
-
-(defsubst follow-invalidate-cache ()
-  "Force `follow-windows-start-end' to recalculate the end of the window."
-  (setq follow-windows-start-end-cache nil))
-
-
-;; Build a list of windows and their start and end positions.
-;; Useful to avoid calculating start/end position whenever they are needed.
-;; The list has the format:
-;; ((Win Start End End-of-buffer-visible-p) ...)
-
-;; Used to have a `save-window-excursion', but it obviously triggered
-;; redraws of the display. Check if I used it for anything.
-
-
-(defun follow-windows-start-end (windows)
-  "Builds a list of (WIN START END BUFFER-END-P) for every window in WINDOWS."
-  (if (follow-cache-valid-p windows)
-      follow-windows-start-end-cache
-    (let ((win-start-end '())
-	  (orig-win (selected-window)))
-      (while windows
-	(select-window (car windows))
-	(setq win-start-end 
-	      (cons (cons (car windows) 
-			  (cons (window-start)
-				(follow-calc-win-end)))
-		    win-start-end))
-	(setq windows (cdr windows)))
-      (select-window orig-win)
-      (setq follow-windows-start-end-cache (nreverse win-start-end))
-      follow-windows-start-end-cache)))
-
-
-(defsubst follow-pos-visible (pos win win-start-end)
-  "Non-nil when POS is visible in WIN."
-  (let ((wstart-wend-bend (cdr (assq win win-start-end))))
-    (and (>= pos (car wstart-wend-bend))
-	 (or (< pos (car (cdr wstart-wend-bend)))
-	     (nth 2 wstart-wend-bend)))))
-
-
-;; By `aligned' we mean that for all adjecent windows, the end of the
-;; first is equal with the start of the successor.  The first window
-;; should start at a full screen line.
-
-(defsubst follow-windows-aligned-p (win-start-end)
-  "Non-nil if the follower WINDOWS are alinged."
-  (let ((res t)) 
-    (save-excursion
-       (goto-char (window-start (car (car win-start-end))))
-       (if (bolp)
-	   nil
-	 (vertical-motion 0 (car (car win-start-end)))
-	 (setq res (eq (point) (window-start (car (car win-start-end)))))))
-    (while (and res (cdr win-start-end))
-      ;; At least two followers left
-      (setq res (eq (car (cdr (cdr (car win-start-end))))
-		    (car (cdr (car (cdr win-start-end))))))
-      (setq win-start-end (cdr win-start-end)))
-    res))
-
-
-;; Check if the point is visible in all windows. (So that
-;; no one will be recentered.)
-
-(defun follow-point-visible-all-windows-p (win-start-end)
-  "Non-nil when the window-point is visible in all windows."
-  (let ((res t))
-    (while (and res win-start-end)
-      (setq res (follow-pos-visible (window-point (car (car win-start-end)))
-				    (car (car win-start-end))
-				    win-start-end))
-      (setq win-start-end (cdr win-start-end)))
-    res))
-
-
-;; Make sure WIN always starts at the beginning of an whole screen
-;; line. If WIN is not aligned the start is updated which probably
-;; will lead to a redisplay of the screen later on.
-;;
-;; This is used with the first window in a follow chain.  The reason
-;; is that we want to detect that the point is outside the window.
-;; (Without the update, the start of the window will move as the
-;; user presses BackSpace, and the other window redisplay routines
-;; will move the start of the window in the wrong direction.)
-
-(defun follow-update-window-start (win)
-  "Make sure that the start of WIN starts at a full screen line."
-  (save-excursion
-    (goto-char (window-start win))
-    (if (bolp)
-	nil
-      (vertical-motion 0 win)
-      (if (eq (point) (window-start win))
-	  nil
-	(vertical-motion 1 win)
-	(set-window-start win (point) 'noforce)))))
-
-;;}}}
-;;{{{ Selection functions
-
-;; Make a window in WINDOWS selected if it currently
-;; is displaying the position DEST.
-;;
-;; We don't select a window if it just has been moved.
-
-(defun follow-select-if-visible (dest win-start-end)
-  "Select and return a window, if DEST is visible in it.
-Return the selected window."
-  (let ((win nil))
-    (while (and (not win) win-start-end)
-      ;; Don't select a window which was just moved. This makes it
-      ;; possible to later select the last window after a `end-of-buffer'
-      ;; command.
-      (if (follow-pos-visible dest (car (car win-start-end)) win-start-end)
-	  (progn
-	    (setq win (car (car win-start-end)))
-	    (select-window win)))
-      (setq win-start-end (cdr win-start-end)))
-    win))
-
-
-;; Lets select a window showing the end. Make sure we only select it if it
-;; it wasn't just moved here. (i.e. M-> shall not unconditionally place
-;; the point in the selected window.)
-;;
-;; (Compability cludge: in Emacs 19 `window-end' is equal to `point-max';
-;; in XEmacs, it is equal to `point-max + 1'. Should I really bother
-;; checking `window-end' now when I check `end-of-buffer' explicitylt?)
-
-(defun follow-select-if-end-visible (win-start-end)
-  "Select and return a window, if end is visible in it."
-  (let ((win nil))
-    (while (and (not win) win-start-end)
-      ;; Don't select a window which was just moved. This makes it
-      ;; possible to later select the last window after a `end-of-buffer'
-      ;; command.
-      (if (and (eq (point-max) (nth 2 (car win-start-end)))
-	       (nth 3 (car win-start-end))
-	       (eq (point-max) (min (point-max)
-				    (window-end (car (car win-start-end))))))
-	  (progn
-	    (setq win (car (car win-start-end)))
-	    (select-window win)))
-      (setq win-start-end (cdr win-start-end)))
-    win))
-
-
-;; Select a window which will display the point if the windows would
-;; be redisplayed with the first window fixed. This is useful for
-;; example when the user has pressed return at the bottom of a window
-;; as the point is not visible in any window.
-
-(defun follow-select-if-visible-from-first (dest windows)
-  "Select and return a window with DEST, if WINDOWS are redrawn from top."
-  (let ((win nil)
-	end-pos-end-p)
-    (save-excursion
-      (goto-char (window-start (car windows)))
-      ;; Make sure the line start in the beginning of a real screen
-      ;; line.
-      (vertical-motion 0 (car windows))    
-      (if (< dest (point))
-	  ;; Above the start, not visible.
-	  nil
-	;; At or below the start. Check the windows.
-	(save-window-excursion
-	  (while (and (not win) windows)
-	    (set-window-start (car windows) (point) 'noforce)
-	    (setq end-pos-end-p (follow-calc-win-end (car windows)))
-	    (goto-char (car end-pos-end-p))
-	    ;; Visible, if dest above end, or if eob is visible inside
-	    ;; the window.
-	    (if (or (car (cdr end-pos-end-p))
-		    (< dest (point)))
-		  (setq win (car windows))
-		(setq windows (cdr windows)))))))
-    (if win 
-	(select-window win))
-    win))
-
-
-;;}}}
-;;{{{ Redisplay 
-
-;; Redraw all the windows on the screen, starting with the top window.
-;; The window used as as marker is WIN, or the selcted window if WIN
-;; is nil.
-
-(defun follow-redisplay (&optional windows win)
-  "Reposition the WINDOWS around WIN.
-Should the point be too close to the roof we redisplay everything
-from the top. WINDOWS should contain a list of windows to
-redisplay, it is assumed that WIN is a member of the list. 
-Should WINDOWS be nil, the windows displaying the
-same buffer as WIN, in the current frame, are used.
-Should WIN be nil, the selected window is used." 
-  (or win
-      (setq win (selected-window)))
-  (or windows 
-      (setq windows (follow-all-followers win)))
-  (follow-downward windows (follow-calculate-first-window-start windows win)))
-
-
-;; Redisplay a chain of windows. Start every window directly after the
-;; end of the previous window, to make sure long lines are displayed
-;; correctly.
-
-(defun follow-downward (windows pos)
-  "Redisplay all WINDOWS starting at POS."
-  (while windows
-    (set-window-start (car windows) pos)
-    (setq pos (car (follow-calc-win-end (car windows))))
-    (setq windows (cdr windows))))
-
-
-;;(defun follow-downward (windows pos)
-;;  "Redisplay all WINDOWS starting at POS."
-;;  (let (p)
-;;    (while windows
-;;      (setq p (window-point (car windows)))
-;;      (set-window-start (car windows) pos)
-;;      (set-window-point (car windows) (max p pos))
-;;      (setq pos (car (follow-calc-win-end (car windows))))
-;;      (setq windows (cdr windows)))))
-
-
-;; Return the start of the first window.
-;;
-;; First, estimate the position. It the value is not perfect (i.e. we
-;; have somewhere splited a line between windows) we try to enhance
-;; the value.
-;;
-;; The guess is always perfect if no long lines is split between
-;; windows.
-;;
-;; The worst case peformace of probably very bad, but it is very
-;; unlikely that we ever will miss the correct start by more than one
-;; or two lines.
-
-(defun follow-calculate-first-window-start (windows &optional win start)
-  "Calculate the start of the first window.
-
-WINDOWS is a chain of windows to work with.  WIN is the window
-to recenter around.  It is assumed that WIN starts at position 
-START."
-  (or win 
-      (setq win (selected-window)))
-  (or start 
-      (setq start (window-start win)))
-  (let ((guess (follow-estimate-first-window-start windows win start)))
-    (if (car guess)
-	(cdr guess)
-      ;; The guess wasn't exact, try to enhance it.
-      (let ((win-start (follow-calc-win-start windows (cdr guess) win)))
-	(cond ((= win-start start) 
-	       (follow-debug-message "exact")
-	       (cdr guess))
-	      ((< win-start start)
-	       (follow-debug-message "above")
-	       (follow-calculate-first-window-start-from-above 
-		windows (cdr guess) win start))
-	      (t
-	       (follow-debug-message "below")
-	       (follow-calculate-first-window-start-from-below 
-		windows (cdr guess) win start)))))))
-
-
-;; `exact' is disabled due to XEmacs and fonts of variable
-;; height.
-(defun follow-estimate-first-window-start (windows win start)
-  "Estimate the position of the first window.
-
-Returns (EXACT . POS). If EXACT is non-nil, POS is the starting
-position of the first window. Otherwise it is a good guess."
-  (let ((pred (car (follow-split-followers windows win)))
-	(exact nil))
-    (save-excursion
-      (goto-char start)
-      ;(setq exact (bolp))
-      (vertical-motion 0 win)
-      (while pred
-	(vertical-motion (- 1 (window-height (car pred))) (car pred))
-	(if (not (bolp))
-	  (setq exact nil))
-	(setq pred (cdr pred)))
-      (cons exact (point)))))
-
-
-;; Find the starting point, start at GUESS and search downward.
-;; The returned point is always a point below GUESS.
-
-(defun follow-calculate-first-window-start-from-above 
-       (windows guess win start)
-  (save-excursion
-    (let ((done nil)
-	  win-start
-	  res)
-      (goto-char guess)
-      (while (not done)
-	(if (not (= (vertical-motion 1 (car windows)) 1))
-	    ;; Hit bottom! (Can we really do this?)
-	    ;; We'll keep it, since it ensures termination.
-	    (progn
-	      (setq done t)
-	      (setq res (point-max)))
-	  (setq win-start (follow-calc-win-start windows (point) win))
-	  (if (>= win-start start)
-	      (progn 
-		(setq done t)
-		(setq res (point))))))
-      res)))
-
-
-;; Find the starting point, start at GUESS and search upward.  Return
-;; a point on the same line as GUESS, or above.
-;;
-;; (Is this ever used? I must make sure it works just in case it is
-;; ever called.)
-
-(defun follow-calculate-first-window-start-from-below
-       (windows guess &optional win start)
-  (setq win (or win (selected-window)))
-  (setq start (or start (window-start win)))
-  (save-excursion
-    (let ((done nil)
-	  win-start
-	  res)
-      ;; Always calculate what happend when no line is displayed in the first
-      ;; window. (The `previous' res is needed below!)
-      (goto-char guess)
-      (vertical-motion 0 (car windows))
-      (setq res (point))
-      (while (not done)
-	(if (not (= (vertical-motion -1 (car windows)) -1))
-	    ;; Hit roof!
-	    (progn
-	      (setq done t)
-	      (setq res (point-min)))
-	  (setq win-start (follow-calc-win-start windows (point) win))
-	  (cond ((= win-start start)	; Perfect match, use this value
-		 (setq done t)
-		 (setq res (point)))
-		((< win-start start)	; Walked to far, use preious result
-		 (setq done t))
-		(t			; Store result for next iteration
-		 (setq res (point))))))
-      res)))
-
-;;}}}
-;;{{{ Avoid tail recenter
-
-;; This sets the window internal flag `force_start'. The effect is that
-;; windows only displaying the tail isn't recentered.
-;; Has to be called before every redisplay... (Great isn't it?)
-;;
-;; XEmacs doesn't recenter the tail, GOOD!
-;;
-;; A window displaying only the tail, is a windows whose
-;; window-start position is equal to (point-max) of the buffer it
-;; displays.
-;;
-;; This function is also added to `post-command-idle-hook', introduced
-;; in Emacs 19.30.  This is needed since the vaccine injected by the
-;; call from `post-command-hook' only works until the next redisplay.
-;; It is possible that the functions in the `post-command-idle-hook'
-;; can cause a redisplay, and hence a new vaccine is needed.
-;;
-;; Sometimes, calling this function could actually cause a redisplay,
-;; especially if it is placed in the debug filter section.  I must
-;; investigate this further...
-
-(defun follow-avoid-tail-recenter (&rest rest)
-  "Make sure windows displaying the end of a buffer aren't recentered.
-
-This is done by reading and rewriting the start positon of 
-non-first windows in Follow Mode."
-  (if follow-avoid-tail-recenter-p
-      (let* ((orig-buffer (current-buffer))
-	    (top (frame-first-window (selected-frame)))
-	    (win top)
-	    (who '())			; list of (buffer . frame)
-	    start
-	    pair)			; (buffer . frame)
-	;; If the only window in the frame is a minibuffer
-	;; window, `next-window' will never find it again...
-	(if (window-minibuffer-p top)
-	    nil
-	  (while  ;; look, no body!
-	      (progn
-		(setq start (window-start win))
-		(set-buffer (window-buffer win))
-		(setq pair (cons (window-buffer win) (window-frame win)))
-		(if (member pair who)
-		    (if (and (boundp 'follow-mode) follow-mode 
-			     (eq (point-max) start))
-			;; Write the same window start back, but don't
-			;; set the NOFORCE flag.
-			(set-window-start win start))
-		  (setq who (cons pair who)))
-		(setq win (next-window win 'not t))
-		(not (eq win top))))  ;; Loop while this is true.
-	  (set-buffer orig-buffer)))))
-
-;;}}}
-
-;;}}}
-;;{{{ Post Command Hook
-
-;;; The magic little box. This function is called after every command.
-
-;; This is not as complicated as it seems. It is simply a list of common
-;; display situations and the actions to take, plus commands for redrawing
-;; the screen if it should be unaligned.
-;;
-;; We divide the check into two parts; whether we are at the end or not.
-;; This is due to the fact that the end can actaually be visible
-;; in several window even though they are aligned.
-
-(defun follow-post-command-hook ()
-  "Ensure that the windows in Follow mode are adjecent after each command."
-  (setq follow-inside-post-command-hook t)
-  (if (or (not (input-pending-p))
-	  ;; Sometimes, in XEmacs, mouse events are not handled
-	  ;; properly by `input-pending-p'.  A typical example is
-	  ;; when clicking on a node in `info'.
-	  (and (boundp 'current-mouse-event)
-	       (symbol-value 'current-mouse-event)
-	       (fboundp 'button-event-p)
-	       (funcall (symbol-function 'button-event-p)
-			(symbol-value 'current-mouse-event))))
-      ;; Work in the selected window, not in the current buffer.
-      (let ((orig-buffer (current-buffer))
-	    (win (selected-window)))
-	(set-buffer (window-buffer win))
-	(or (and (symbolp this-command) 
-		 (get this-command 'follow-mode-use-cache))
-	    (follow-invalidate-cache))
-	(if (and (boundp 'follow-mode) follow-mode
-		 (not (window-minibuffer-p win)))
-	    ;; The buffer shown in the selected window is in follow
-	    ;; mode, lets find the current state of the display and
-	    ;; cache the result for speed (i.e. `aligned' and `visible'.)
-	    (let* ((windows (inline (follow-all-followers win)))
-		   (dest (point))
-		   (win-start-end (inline
-				    (follow-update-window-start (car windows))
-				    (follow-windows-start-end windows)))
-		   (aligned (follow-windows-aligned-p win-start-end))
-		   (visible (follow-pos-visible dest win win-start-end)))
-	      (if (not (and aligned visible))
-		  (follow-invalidate-cache))
-	      (inline (follow-avoid-tail-recenter))
-	      ;; Select a window to display the point.
-	      (or follow-internal-force-redisplay
-		  (progn
-		    (if (eq dest (point-max))
-			;; We're at the end, we have be be careful since
-			;; the display can be aligned while `dest' can
-			;; be visible in several windows.
-			(cond
-			 ;; Select the current window, but only when
-			 ;; the display is correct. (When inserting
-			 ;; character in a tail window, the display is
-			 ;; not correct, as they are shown twice.)
-			 ;;
-			 ;; Never stick to the current window after a
-			 ;; deletion.  The reason is cosmetic, when
-			 ;; typing `DEL' in a window showing only the
-			 ;; end of the file, character are removed
-			 ;; from the window above, which is very
-			 ;; unintuitive.
-			 ((and visible
-			       aligned
-			       (not (memq this-command 
-					  '(backward-delete-char
-					    delete-backward-char
-					    backward-delete-char-untabify
-					    kill-region))))
-			  (follow-debug-message "Max: same"))
-			 ;; If the end is visible, and the window
-			 ;; doesn't seems like it just has been moved,
-			 ;; select it.
-			 ((follow-select-if-end-visible win-start-end)
-			  (follow-debug-message "Max: end visible")
-			  (setq visible t)
-			  (setq aligned nil)
-			  (goto-char dest))
-			 ;; Just show the end...
-			 (t
-			  (follow-debug-message "Max: default")
-			  (select-window (car (reverse windows)))
-			  (goto-char dest)
-			  (setq visible nil)
-			  (setq aligned nil)))
-		      
-		      ;; We're not at the end, here life is much simpler.
-		      (cond
-		       ;; This is the normal case! 
-		       ;; It should be optimized for speed.
-		       ((and visible aligned)
-			(follow-debug-message "same"))
-		       ;; Pick a position in any window.  If the
-		       ;; display is ok, this will pick the `correct'
-		       ;; window.  If the display is wierd do this
-		       ;; anyway, this will be the case after a delete
-		       ;; at the beginning of the window.
-		       ((follow-select-if-visible dest win-start-end)
-			(follow-debug-message "visible")
-			(setq visible t)
-			(goto-char dest))
-		       ;; Not visible anywhere else, lets pick this one.
-		       ;; (Is this case used?)
-		       (visible
-			(follow-debug-message "visible in selected."))
-		       ;; Far out!
-		       ((eq dest (point-min))
-			(follow-debug-message "min")
-			(select-window (car windows))
-			(goto-char dest)
-			(set-window-start (selected-window) (point-min))
-			(setq win-start-end (follow-windows-start-end windows))
-			(follow-invalidate-cache)
-			(setq visible t)
-			(setq aligned nil))
-		       ;; If we can position the cursor without moving the first
-		       ;; window, do it. This is the case which catches `RET'
-		       ;; at the bottom of a window.
-		       ((follow-select-if-visible-from-first dest windows)
-			(follow-debug-message "Below first")
-			(setq visible t)		  
-			(setq aligned t)
-			(follow-redisplay windows (car windows))
-			(goto-char dest))
-		       ;; None of the above. For simplicity, we stick to the
-		       ;; selected window.
-		       (t
-			(follow-debug-message "None")
-			(setq visible nil)
-			(setq aligned nil))))
-		    ;; If a new window has been selected, make sure that the
-		    ;; old is not scrolled when the point is outside the
-		    ;; window.
-		    (or (eq win (selected-window))
-			(let ((p (window-point win)))
-			  (set-window-start win (window-start win) nil)
-			  (set-window-point win p)))))
-	      ;; Make sure the point is visible in the selected window.
-	      ;; (This could lead to a scroll.)
-	      (if (or visible
-		      (follow-pos-visible dest win win-start-end))
-		  nil
-		(sit-for 0)
-		(follow-avoid-tail-recenter)
-		(setq win-start-end (follow-windows-start-end windows))
-		(follow-invalidate-cache)
-		(setq aligned nil))
-	      ;; Redraw the windows whenever needed.
-	      (if (or follow-internal-force-redisplay
-		      (not (or aligned
-			       (follow-windows-aligned-p win-start-end)))
-		      (not (inline (follow-point-visible-all-windows-p 
-				    win-start-end))))
-		  (progn
-		    (setq follow-internal-force-redisplay nil)
-		    (follow-redisplay windows (selected-window))
-		    (setq win-start-end (follow-windows-start-end windows))
-		    (follow-invalidate-cache)
-		    ;; When the point ends up in another window. This
-		    ;; happends when dest is in the beginning of the
-		    ;; file and the selected window is not the first.
-		    ;; It can also, in rare situations happend when
-		    ;; long lines are used and there is a big
-		    ;; difference between the width of the windows.
-		    ;; (When scrolling one line in a wide window which
-		    ;; will cause a move larger that an entire small
-		    ;; window.)
-		    (if (follow-pos-visible dest win win-start-end)
-			nil
-		      (follow-select-if-visible dest win-start-end)
-		      (goto-char dest))))
-	      
-	      ;; If the region is visible, make it look good when spanning
-	      ;; multiple windows.
-	      (if (or (and (boundp 'mark-active) (symbol-value 'mark-active))
-		      (and (fboundp 'region-active-p) 
-			   (funcall (symbol-function 'region-active-p))))
-		  (follow-maximize-region 
-		   (selected-window) windows win-start-end))
-
-	      (inline (follow-avoid-tail-recenter))
-	      ;; DEBUG
-	      ;;(if (not (follow-windows-aligned-p 
-	      ;;           (follow-windows-start-end windows)))
-	      ;;    (message "follow-mode: windows still unaligend!"))
-	      ;; END OF DEBUG
-	      )				; Matches (let*
-	  ;; Buffer not in follow mode:
-	  ;; We still must update the windows displaying the tail so that
-	  ;; Emacs won't recenter them.
-	  (follow-avoid-tail-recenter))
-	(set-buffer orig-buffer)))
-  (setq follow-inside-post-command-hook nil))
-
-;;}}}
-;;{{{ The region
-
-;; Tries to make the highlighted area representing the region look
-;; good when spanning several windows. 
-;;
-;; Not perfect, as the point can't be placed at window end, only at
-;; end-1. Whis will highlight a little bit in windows above
-;; the current.
-
-(defun follow-maximize-region (win windows win-start-end)
-  "Make a highlighted region stretching multiple windows look good
-when in Follow mode."
-  (let* ((all (follow-split-followers windows win))
-	 (pred (car all))
-	 (succ (cdr all))
-	 data)
-    (while pred
-      (setq data (assq (car pred) win-start-end))
-      (set-window-point (car pred) (max (nth 1 data) (- (nth 2 data) 1)))
-      (setq pred (cdr pred)))
-    (while succ
-      (set-window-point (car succ) (nth 1 (assq (car succ) win-start-end)))
-      (setq succ (cdr succ)))))
-
-;;}}}
-;;{{{ Scroll bar
-
-;;;; Scroll-bar support code.
-
-;;; Why is it needed? Well, if the selected window is in follow mode,
-;;; all its follower stick to it blindly. If one of them is scrolled,
-;;; it immediately returns to the original position when the mouse is
-;;; released. If the selected window is not a follower of the dragged
-;;; window the windows will be unaligned.
-
-;;; The advices doesn't get compiled. Aestetically, this might be a
-;;; problem but in practical life it isn't.
-
-;;; Discussion: Now when the other windows in the chain follow the
-;;; dragged, should we really select it?
-
-(cond ((fboundp 'scroll-bar-drag)
-       ;;;
-       ;;; Emacs 19 style scrollbars.
-       ;;;
-
-       ;; Select the dragged window if it is a follower of the
-       ;; selected window.
-       ;;
-       ;; Generate advices of the form:
-       ;; (defadvice scroll-bar-drag (after follow-scroll-bar-drag activate)
-       ;;   "Adviced by `follow-mode'."
-       ;;   (follow-redraw-after-event (ad-get-arg 0)))
-       (let ((cmds '(scroll-bar-drag
-		     scroll-bar-drag-1	; Executed at every move.
-		     scroll-bar-scroll-down
-		     scroll-bar-scroll-up
-		     scroll-bar-set-window-start)))
-	 (while cmds
-	   (eval
-	    (` (defadvice (, (intern (symbol-name (car cmds))))
-		 (after 
-		  (, (intern (concat "follow-" (symbol-name (car cmds))))) 
-		  activate)
-		 "Adviced by Follow Mode."
-		 (follow-redraw-after-event (ad-get-arg 0)))))
-	   (setq cmds (cdr cmds))))
-    
-    
-       (defun follow-redraw-after-event (event)
-	 "Adviced by Follow mode."
-	 (condition-case nil
-	     (let* ((orig-win (selected-window))
-		    (win (nth 0 (funcall 
-				 (symbol-function 'event-start) event)))
-		    (fmode (assq 'follow-mode 
-				 (buffer-local-variables 
-				  (window-buffer win)))))
-	       (if (and fmode (cdr fmode))
-		   ;; The selected window is in follow-mode
-		   (progn
-		     ;; Recenter around the dragged window.
-		     (select-window win)
-		     (follow-redisplay)
-		     (select-window orig-win))))
-	   (error nil))))
-
-
-      ((fboundp 'scrollbar-vertical-drag)
-       ;;;
-       ;;; XEmacs style scrollbars.
-       ;;;
-
-       ;; Advice all scrollbar functions on the form:
-       ;;
-       ;; (defadvice scrollbar-line-down 
-       ;;	(after follow-scrollbar-line-down activate)
-       ;;   (follow-xemacs-scrollbar-support (ad-get-arg 0)))
-
-      (let ((cmds '(scrollbar-line-down	; Window
-		    scrollbar-line-up
-		    scrollbar-page-down	; Object
-		    scrollbar-page-up
-		    scrollbar-to-bottom	; Window
-		    scrollbar-to-top
-		    scrollbar-vertical-drag ; Object
-		    )))
-	
-	(while cmds
-	  (eval
-	   (` (defadvice (, (intern (symbol-name (car cmds))))
-		(after 
-		 (, (intern (concat "follow-" (symbol-name (car cmds))))) 
-		 activate)
-		"Adviced by `follow-mode'."
-		(follow-xemacs-scrollbar-support (ad-get-arg 0)))))
-	  (setq cmds (cdr cmds))))
-
-
-      (defun follow-xemacs-scrollbar-support (window)
-	"Redraw windows showing the same buffer as shown in WINDOW.
-WINDOW is either the dragged window, or a cons containing the
-window as its first element. This is called while the user drags
-the scrollbar.
-
-WINDOW can be an object or a window."
-	(condition-case nil
-	    (progn
-	      (if (consp window)
-		  (setq window (car window)))
-	      (let ((fmode (assq 'follow-mode 
-				 (buffer-local-variables 
-				  (window-buffer window))))
-		    (orig-win (selected-window)))
-		(if (and fmode (cdr fmode))
-		    (progn
-		      ;; Recenter around the dragged window.
-		      (select-window window)
-		      (follow-redisplay)
-		      (select-window orig-win)))))
-	  (error nil)))))
-
-;;}}}
-;;{{{ Process output
-
-;;; The following sections installs a spy which listens to process
-;;; output and tries to reposition the windows whose buffers are in
-;;; Follow mode.  We play safe as much as possible...
-;;;
-;;; When follow-mode is activated all active processes are
-;;; intercepted.  All new processes which change their filter function
-;;; using `set-process-filter' are also intercepted.  The reason is
-;;; that a process can cause a redisplay recentering "tail" windows.
-;;; Note that it doesn't hurt to spy on more processes than needed.
-;;;
-;;; Technically, we set the process filter to `follow-generic-filter'.
-;;; The original filter is stored in `follow-process-filter-alist'.
-;;; Our generic filter calls the original filter, or inserts the
-;;; output into the buffer, if the buffer originally didn't have an
-;;; output filter.  It also makes sure that the windows connected to
-;;; the buffer are aligned.
-;;;
-;;; Discussion: How to we find processes which doesn't call
-;;; `set-process-filter'?  (How often are processes created in a
-;;; buffer after Follow mode are activated?)
-;;;
-;;; Discussion: Should we also advice `process-filter' to make our
-;;; filter invisible to others?
-
-;;{{{ Advice for `set-process-filter'
-
-;; Do not call this with 'follow-generic-filter as the name of the
-;; filter...
-
-(defadvice set-process-filter (before follow-set-process-filter activate)
-  "Follow Mode listens to calls to this function to make 
-sure process output will be displayed correctly in buffers
-in which the mode is activated.
-
-Follow Mode inserts its own process filter to do its 
-magic stuff before the real process filter is called."
-  (if follow-intercept-processes
-      (progn
-	(setq follow-process-filter-alist
-	      (delq (assq (ad-get-arg 0) follow-process-filter-alist)
-		    follow-process-filter-alist))
-	(follow-tidy-process-filter-alist)
-	(cond ((eq (ad-get-arg 1) t))
-	      ((eq (ad-get-arg 1) nil)
-	       (ad-set-arg 1 'follow-generic-filter))
-	      (t
-	       (setq follow-process-filter-alist 
-		     (cons (cons (ad-get-arg 0) (ad-get-arg 1)) 
-			   follow-process-filter-alist))
-	       (ad-set-arg 1 'follow-generic-filter))))))
-
-
-(defun follow-call-set-process-filter (proc filter)
-  "Call original `set-process-filter' without the Follow mode advice."
-  (ad-disable-advice 'set-process-filter 'before
-		     'follow-set-process-filter)
-  (ad-activate 'set-process-filter)
-  (prog1 
-      (set-process-filter proc filter)
-    (ad-enable-advice 'set-process-filter 'before
-		      'follow-set-process-filter)
-    (ad-activate 'set-process-filter)))
-
-
-(defadvice process-filter (after follow-process-filter activate)
-  "Normally when Follow mode is activated all processes has the
-process filter set to `follow-generic-filter'.  With this advice,
-the original process filter is returned."
-  (cond ((eq ad-return-value 'follow-generic-filter)
-	 (setq ad-return-value
-	       (cdr-safe (assq (ad-get-arg 0) 
-			       follow-process-filter-alist))))))
-
-
-(defun follow-call-process-filter (proc)
-  "Call original `process-filter' without the Follow mode advice."
-  (ad-disable-advice 'process-filter 'after
-		     'follow-process-filter)
-  (ad-activate 'process-filter)
-  (prog1 
-      (process-filter proc)
-    (ad-enable-advice 'process-filter 'after 
-		      'follow-process-filter)
-    (ad-activate 'process-filter)))
-  
-
-(defun follow-tidy-process-filter-alist ()
-  "Remove old processes from `follow-process-filter-alist'."
-  (let ((alist follow-process-filter-alist)
-	(ps (process-list))
-	(new ()))
-    (while alist
-      (if (and (not (memq (process-status (car (car alist))) 
-			  '(exit signal closed nil)))
-	       (memq (car (car alist)) ps))
-	  (setq new (cons (car alist) new)))
-      (setq alist (cdr alist)))
-    (setq follow-process-filter-alist new)))
-
-;;}}}
-;;{{{ Start/stop interception of processes.
-
-;; Normally, all new processed are intercepted by our `set-process-filter'.
-;; This is needed to intercept old processed which were started before we were
-;; loaded, and processes we have forgotten by calling
-;; `follow-stop-intercept-process-output'.
-
-(defun follow-intercept-process-output ()
-  "Intercept all active processes.
-
-This is needed so that Follow Mode can track all display events in the
-system.  (See `follow-mode')"
-  (interactive)
-  (let ((list (process-list)))
-    (while list
-      (if (eq (process-filter (car list)) 'follow-generic-filter)
-	  nil
-	;; The custom `set-process-filter' defined above.
-	(set-process-filter (car list) (process-filter (car list))))
-      (setq list (cdr list))))
-  (setq follow-intercept-processes t))
-
-
-(defun follow-stop-intercept-process-output ()
-  "Stop Follow Mode from spying on processes.
-
-All current spypoints are removed and no new will be added.
-
-The effect is that Follow mode won't be able to handle buffers 
-connected to processes.  
-
-The only reason to call this function is if the Follow mode spy filter
-would interfere with some other package.  If this happens, please
-report this using the `follow-submit-feedback' function."
-  (interactive)
-  (follow-tidy-process-filter-alist)
-  (let ((list (process-list)))
-    (while list
-      (if (eq (process-filter (car list)) 'follow-generic-filter)
-	  (progn
-	    (follow-call-set-process-filter 
-	     (car list) 
-	     (cdr-safe (assq (car list) follow-process-filter-alist)))
-	    (setq follow-process-filter-alist 
-		  (delq (assq (car list) follow-process-filter-alist)
-			follow-process-filter-alist))))
-      (setq list (cdr list))))
-  (setq follow-intercept-processes nil))
-
-;;}}}
-;;{{{ The filter
-
-;;; The following section is a naive method to make buffers with
-;;; process output to work with Follow mode. Whenever the start of the
-;;; window displaying the buffer is moved, we moves it back to its
-;;; original position and try to select a new window.  (If we fail,
-;;; the normal redisplay functions of Emacs will scroll it right
-;;; back!)
-
-(defun follow-generic-filter (proc output)
-  "Process output filter for process connected to buffers in Follow mode."
-  (let* ((old-buffer (current-buffer))
-	 (orig-win (selected-window))
-	 (buf (process-buffer proc))
-	 (win (and buf (if (eq buf (window-buffer orig-win))
-			   orig-win
-			 (get-buffer-window buf t))))
-	 (return-to-orig-win (and win (not (eq win orig-win))))
-	 (orig-window-start (and win (window-start win))))
-
-    ;; If input is pending, the `sit-for' below won't redraw the
-    ;; display. In that case, calling `follow-avoid-tail-recenter' may
-    ;; provoke the process hadnling code to sceduling a redisplay.
-    ;(or (input-pending-p)
-    ; (follow-avoid-tail-recenter))
-
-    ;; Output the `output'.
-    (let ((filter (cdr-safe (assq proc follow-process-filter-alist))))
-      (cond 
-       ;; Call the original filter function
-       (filter
-	(funcall filter proc output))
-
-       ;; No filter, but we've got a buffer. Just output into it.
-       (buf
-	(set-buffer buf)
-	(if (not (marker-buffer (process-mark proc)))
-	    (set-marker (process-mark proc) (point-max)))
-	(let ((moving (= (point) (process-mark proc)))
-	      (odeactivate (and (boundp 'deactivate-mark)
-				(symbol-value 'deactivate-mark)))
-	      (old-buffer-read-only buffer-read-only))
-	  (setq buffer-read-only nil)
-	  (save-excursion
-	    (goto-char (process-mark proc))
-	    ;; `insert-before-markers' just in case the users next
-	    ;; command is M-y.
-	    (insert-before-markers output)
-	    (set-marker (process-mark proc) (point)))
-	  (if moving (goto-char (process-mark proc)))
-	  (if (boundp 'deactivate-mark)
-	      ;; This could really be
-	      ;;    (setq deactivate-mark odeactivate)
-	      ;; but this raises an error when compiling on XEmacs.
-	      (funcall (symbol-function 'set)
-		       'deactivate-mark odeactivate))
-	  (setq buffer-read-only old-buffer-read-only)))))
-
-    ;; If we're in follow mode, do our stuff.  Select a new window and
-    ;; redisplay.  (Actually, it is redundant to check `buf', but I
-    ;; feel it's more correct.)
-    (if (and buf win (window-live-p win))
-	(progn
-	  (set-buffer buf)
-	  (if (and (boundp 'follow-mode) follow-mode)
-	      (progn 
-		(select-window win)
-		(let* ((windows (follow-all-followers win))
-		       (win-start-end (follow-windows-start-end windows))
-		       (new-window-start (window-start win))
-		       (new-window-point (window-point win)))
-		  (cond
-		   ;; The window was moved. Move it back and
-		   ;; select a new.  If no better could be found,
-		   ;; we stick the the new start position.  This
-		   ;; is used when the original process filter
-		   ;; tries to position the cursor at the bottom
-		   ;; of the window.  Example: `lyskom'.
-		   ((not (eq orig-window-start new-window-start))
-		    (follow-debug-message "filter: Moved")
-		    (set-window-start win orig-window-start)
-		    (follow-redisplay windows win)
-		    (setq win-start-end (follow-windows-start-end windows))
-		    (follow-select-if-visible new-window-point 
-					      win-start-end)
-		    (goto-char new-window-point)
-		    (if (eq win (selected-window))
-			(set-window-start win new-window-start))
-		    (setq win-start-end (follow-windows-start-end windows)))
-		   ;; Stick to this window, if point is visible in it.
-		   ((pos-visible-in-window-p new-window-point)
-		    (follow-debug-message "filter: Visible in window"))
-		   ;; Avoid redisplaying the first window. If the
-		   ;; point is visible at a window below,
-		   ;; redisplay and select it.
-		   ((follow-select-if-visible-from-first 
-		     new-window-point windows)
-		    (follow-debug-message "filter: Seen from first")
-		    (follow-redisplay windows (car windows))
-		    (goto-char new-window-point)
-		    (setq win-start-end
-			  (follow-windows-start-end windows)))
-		   ;; None of the above. We stick to the current window.
-		   (t 
-		    (follow-debug-message "filter: nothing")))
-
-		  ;; Here we have slected a window. Make sure the
-		  ;; windows are aligned and the point is visible
-		  ;; in the selected window.
-		  (if (and (not (follow-pos-visible 
-				 (point) (selected-window) win-start-end))
-			   (not return-to-orig-win))
-		      (progn
-			(sit-for 0)
-			(setq win-start-end 
-			      (follow-windows-start-end windows))))
-
-		  (if (or follow-internal-force-redisplay
-			  (not (follow-windows-aligned-p win-start-end)))
-		      (follow-redisplay windows)))))))
-
-    ;; return to the original window.
-    (if return-to-orig-win
-	(select-window orig-win))
-    (set-buffer old-buffer))
-  
-  (follow-invalidate-cache)
-
-  ;; Normally, if the display has been changed, it is redrawn.  All
-  ;; windows showing only the end of a buffer is unconditionally
-  ;; recentered, we can't prevent it by calling
-  ;; `follow-avoid-tail-recenter'.
-  ;;
-  ;; By performing a redisplay on our own, Emacs need not perform
-  ;; the above described redisplay.  (However, bu performing it when
-  ;; there are input available just seems to make things worse.)
-  (if (and follow-avoid-tail-recenter-p
-	   (not (input-pending-p)))
-      (sit-for 0)))
-
-;;}}}
-
-;;}}}
-;;{{{ Window size change
-
-;; In Emacs 19.29, the functions in `window-size-change-functions' are
-;; called every time a window in a frame changes size. Most notably, it
-;; is called after the frame has been resized.
-;;
-;; We basically call our post-command-hook for every buffer which is
-;; visible in any window in the resized frame, which is in follow-mode.
-;;
-;; Since this function can be called indirectly from
-;; `follow-post-command-hook' we have a potential infinite loop.  We
-;; handle this problem by simply not doing anything at all in this
-;; situation.  The variable `follow-inside-post-command-hook' contains
-;; information about whether the execution actually is inside the
-;; post-command-hook or not.
-
-(if (boundp 'window-size-change-functions)
-    (add-hook 'window-size-change-functions 'follow-window-size-change))
-
-
-(defun follow-window-size-change (frame)
-  "Redraw all windows in FRAME, when in Follow mode."
-  ;; Below, we call `post-command-hook'. This makes sure that we
-  ;; doesn't start a mutally recursive endless loop.
-  (if follow-inside-post-command-hook
-      nil
-    (let ((buffers '())
-	  (orig-window (selected-window))
-	  (orig-buffer (current-buffer))
-	  (orig-frame (selected-frame))
-	  windows
-	  buf)
-      (select-frame frame)
-      (unwind-protect
-	  (walk-windows 
-	   (function 
-	    (lambda (win)
-	      (setq buf (window-buffer win))
-	      (if (memq buf buffers)
-		  nil
-		(set-buffer buf)
-		(if (and (boundp 'follow-mode)
-			 follow-mode)
-		    (progn
-		      (setq windows (follow-all-followers win))
-		      (if (memq orig-window windows)
-			  (progn
-			    ;; Make sure we're redrawing around the
-			    ;; selected window.
-			    ;;
-			    ;; We must be really careful not to do this
-			    ;; when we are (indirectly) called by
-			    ;; `post-command-hook'.
-			    (select-window orig-window)
-			    (follow-post-command-hook)
-			    (setq orig-window (selected-window)))
-			(follow-redisplay windows win))
-		      (setq buffers (cons buf buffers))))))))
-	(select-frame orig-frame)
-	(set-buffer orig-buffer)
-	(select-window orig-window)))))
-
-;;}}}
-
-;;{{{ XEmacs isearch
-
-;; In XEmacs, isearch often finds matches in other windows than the
-;; currently selected.  However, when exiting the old window
-;; configuration is restored, with the exception of the beginning of
-;; the start of the window for the selected window.  This is not much
-;; help for us.
-;;
-;; We overwrite the stored window configuration with the current,
-;; unless we are in `slow-search-mode', i.e. only a few lines
-;; of text is visible.
-
-(if follow-emacs-version-xemacs-p
-    (defadvice isearch-done (before follow-isearch-done activate)
-      (if (and (boundp 'follow-mode)
-	       follow-mode
-	       (boundp 'isearch-window-configuration)
-	       isearch-window-configuration
-	       (boundp 'isearch-slow-terminal-mode)
-	       (not isearch-slow-terminal-mode))
-	  (let ((buf (current-buffer)))
-	    (setq isearch-window-configuration 
-		  (current-window-configuration))
-	    (set-buffer buf)))))
-
-;;}}}
-;;{{{ Tail window handling
-
-;;; In Emacs (not XEmacs) windows showing nothing are sometimes 
-;;; recentered.  When in Follow Mode, this is not desireable for
-;;; non-first windows in the window chain.  This section tries to
-;;; make the windows stay where they should be.
-;;;
-;;; If the display is updated, all windows starting at (point-max) are
-;;; going to be recentered at the next redisplay, unless we do a
-;;; read-and-write cycle to update the `force' flag inside the windows.
-;;;
-;;; In 19.30, a new varible `window-scroll-functions' is called every
-;;; time a window is recentered.  It is not perfect for our situation,
-;;; since when it is called for a tail window, it is to late.  However,
-;;; if it is called for another window, we can try to update our
-;;; windows.
-;;;
-;;; By patching `sit-for' we can make sure that to catch all explicit
-;;; updates initiated by lisp programs.  Internal calls, on the other
-;;; hand, are not handled.
-;;;
-;;; Please note that the function `follow-avoid-tail-recenter' is also
-;;; called from other places, e.g. `post-command-hook' and
-;;; `post-command-idle-hook'.
-
-;; If this function is called it is to late for this window, but
-;; we might save other windows from beeing recentered.
-
-(if (and follow-avoid-tail-recenter-p (boundp 'window-scroll-functions))
-    (add-hook 'window-scroll-functions 'follow-avoid-tail-recenter t))
-
-
-;;  This prevents all packages which calls `sit-for' directly
-;;  to recenter tail windows.
-
-(if follow-avoid-tail-recenter-p
-    (defadvice sit-for (before follow-sit-for activate)
-      "Adviced by Follow Mode.
-
-Avoid to recenter windows displaying only the end of a file as when
-displaying a short file in two windows, using Follow Mode."
-      (follow-avoid-tail-recenter)))
-
-
-;;  Without this advice, `mouse-drag-region' would start to recenter
-;;  tail windows.
-
-(if (and follow-avoid-tail-recenter-p
-	 (fboundp 'move-overlay))
-    (defadvice move-overlay (before follow-move-overlay activate)
-      "Adviced by Follow Mode.  Don't recenter windows showing only 
-the end of a buffer.  This prevents `mouse-drag-region' from
-messing things up."
-      (follow-avoid-tail-recenter)))
-
-;;}}}
-;;{{{ profile support
-
-;; The following (non-evaluated) section can be used to
-;; profile this package using `elp'.
-;;
-;; Invalid indentation on purpose!
-
-(cond (nil
-(setq elp-function-list
-      '(window-end 
-	vertical-motion 
-	; sit-for  ;; elp can't handle advices...
-	follow-mode
-	follow-all-followers
-	follow-split-followers 
-	follow-redisplay
-	follow-downward
-	follow-calculate-first-window-start
-	follow-estimate-first-window-start
-	follow-calculate-first-window-start-from-above
-	follow-calculate-first-window-start-from-below
-	follow-calc-win-end
-	follow-calc-win-start
-	follow-pos-visible
-	follow-windows-start-end
-	follow-cache-valid-p
-	follow-select-if-visible
-	follow-select-if-visible-from-first
-	follow-windows-aligned-p
-	follow-point-visible-all-windows-p
-	follow-avoid-tail-recenter
-	follow-update-window-start
-	follow-post-command-hook
-	))))
-
-;;}}}
-
-;;{{{ The end
-
-;;;
-;;; We're done!
-;;;
-
-(provide 'follow)
-
-;;}}}
-
-;; /------------------------------------------------------------------------\
-;; | "I [..] am rarely happier then when spending an entire day programming |
-;; | my computer to perform automatically a task that it would otherwise    |
-;; | take me a good ten seconds to do by hand. Ten seconds, I tell myself,  |
-;; | is ten seconds. Time is valuable and ten seconds' worth of it is well  |
-;; | worth the investment of a day's happy activity working out a way to    |
-;; | save it".             -- Douglas Adams, "Last Chance to See"           |
-;; \------------------------------------------------------------------------/
-
-;;; follow.el ends here
diff --git a/lisp/font-lock.el b/lisp/font-lock.el
deleted file mode 100644
index 0117d5f5c94..00000000000
--- a/lisp/font-lock.el
+++ /dev/null
@@ -1,2409 +0,0 @@
-;;; font-lock.el --- Electric font lock mode
-
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: jwz, then rms, then sm <simon@gnu.ai.mit.edu>
-;; Maintainer: FSF
-;; Keywords: languages, 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:
-
-;; Font Lock mode is a minor mode that causes your comments to be displayed in
-;; one face, strings in another, reserved words in another, and so on.
-;;
-;; Comments will be displayed in `font-lock-comment-face'.
-;; Strings will be displayed in `font-lock-string-face'.
-;; Regexps are used to display selected patterns in other faces.
-;;
-;; To make the text you type be fontified, use M-x font-lock-mode RET.
-;; When this minor mode is on, the faces of the current line are updated with
-;; every insertion or deletion.
-;;
-;; To turn Font Lock mode on automatically, add this to your ~/.emacs file:
-;;
-;;  (add-hook 'emacs-lisp-mode-hook 'turn-on-font-lock)
-;;
-;; Or if you want to turn Font Lock mode on in many modes:
-;;
-;;  (global-font-lock-mode t)
-;;
-;; Fontification for a particular mode may be available in a number of levels
-;; of decoration.  The higher the level, the more decoration, but the more time
-;; it takes to fontify.  See the variable `font-lock-maximum-decoration', and
-;; also the variable `font-lock-maximum-size'.  Support modes for Font Lock
-;; mode can be used to speed up Font Lock mode.  See `font-lock-support-mode'.
-
-;;; How Font Lock mode supports modes or is supported by modes:
-
-;; Modes that support Font Lock mode do so by defining one or more variables
-;; whose values specify the fontification.  Font Lock mode knows of these
-;; variable names from (a) the buffer local variable `font-lock-defaults', if
-;; non-nil, or (b) the global variable `font-lock-defaults-alist', if the major
-;; mode has an entry.  (Font Lock mode is set up via (a) where a mode's
-;; patterns are distributed with the mode's package library, and (b) where a
-;; mode's patterns are distributed with font-lock.el itself.  An example of (a)
-;; is Pascal mode, an example of (b) is Lisp mode.  Normally, the mechanism is
-;; (a); (b) is used where it is not clear which package library should contain
-;; the pattern definitions.)  Font Lock mode chooses which variable to use for
-;; fontification based on `font-lock-maximum-decoration'.
-
-;;; Constructing patterns:
-
-;; See the documentation for the variable `font-lock-keywords'.
-;;
-;; Nasty regexps of the form "bar\\(\\|lo\\)\\|f\\(oo\\|u\\(\\|bar\\)\\)\\|lo"
-;; are made thusly: (make-regexp '("foo" "fu" "fubar" "bar" "barlo" "lo")) for
-;; efficiency.  See /pub/gnu/emacs/elisp-archive/functions/make-regexp.el.Z on
-;; archive.cis.ohio-state.edu for this and other functions not just by simon.
-
-;;; Adding patterns for modes that already support Font Lock:
-
-;; Though Font Lock highlighting patterns already exist for many modes, it's
-;; likely there's something that you want fontified that currently isn't, even
-;; at the maximum fontification level.  You can add highlighting patterns via
-;; `font-lock-add-keywords'.  For example, say in some C
-;; header file you #define the token `and' to expand to `&&', etc., to make
-;; your C code almost readable.  In your ~/.emacs there could be:
-;;
-;;  (font-lock-add-keywords 'c-mode '("\\<\\(and\\|or\\|not\\)\\>"))
-;;
-;; Some modes provide specific ways to modify patterns based on the values of
-;; other variables.  For example, additional C types can be specified via the
-;; variable `c-font-lock-extra-types'.
-
-;;; Adding patterns for modes that do not support Font Lock:
-
-;; Not all modes support Font Lock mode.  If you (as a user of the mode) add
-;; patterns for a new mode, you must define in your ~/.emacs a variable or
-;; variables that specify regexp fontification.  Then, you should indicate to
-;; Font Lock mode, via the mode hook setting `font-lock-defaults', exactly what
-;; support is required.  For example, say Foo mode should have the following
-;; regexps fontified case-sensitively, and comments and strings should not be
-;; fontified automagically.  In your ~/.emacs there could be:
-;;
-;;  (defvar foo-font-lock-keywords
-;;    '(("\\<\\(one\\|two\\|three\\)\\>" . font-lock-keyword-face)
-;;      ("\\<\\(four\\|five\\|six\\)\\>" . font-lock-type-face))
-;;    "Default expressions to highlight in Foo mode.")
-;;
-;;  (add-hook 'foo-mode-hook
-;;   (function (lambda ()
-;;               (make-local-variable 'font-lock-defaults)
-;;               (setq font-lock-defaults '(foo-font-lock-keywords t)))))
-
-;;; Adding Font Lock support for modes:
-
-;; Of course, it would be better that the mode already supports Font Lock mode.
-;; The package author would do something similar to above.  The mode must
-;; define at the top-level a variable or variables that specify regexp
-;; fontification.  Then, the mode command should indicate to Font Lock mode,
-;; via `font-lock-defaults', exactly what support is required.  For example,
-;; say Bar mode should have the following regexps fontified case-insensitively,
-;; and comments and strings should be fontified automagically.  In bar.el there
-;; could be:
-;;
-;;  (defvar bar-font-lock-keywords
-;;    '(("\\<\\(uno\\|due\\|tre\\)\\>" . font-lock-keyword-face)
-;;      ("\\<\\(quattro\\|cinque\\|sei\\)\\>" . font-lock-type-face))
-;;    "Default expressions to highlight in Bar mode.")
-;;
-;; and within `bar-mode' there could be:
-;;
-;;  (make-local-variable 'font-lock-defaults)
-;;  (setq font-lock-defaults '(bar-font-lock-keywords nil t))
-
-;; What is fontification for?  You might say, "It's to make my code look nice."
-;; I think it should be for adding information in the form of cues.  These cues
-;; should provide you with enough information to both (a) distinguish between
-;; different items, and (b) identify the item meanings, without having to read
-;; the items and think about it.  Therefore, fontification allows you to think
-;; less about, say, the structure of code, and more about, say, why the code
-;; doesn't work.  Or maybe it allows you to think less and drift off to sleep.
-;;
-;; So, here are my opinions/advice/guidelines:
-;; 
-;; - Highlight conceptual objects, such as function and variable names, and
-;;   different objects types differently, i.e., (a) and (b) above, highlight
-;;   function names differently to variable names.
-;; - Keep the faces distinct from each other as far as possible.
-;;   i.e., (a) above.
-;; - Use the same face for the same conceptual object, across all modes.
-;;   i.e., (b) above, all modes that have items that can be thought of as, say,
-;;   keywords, should be highlighted with the same face, etc.
-;; - Make the face attributes fit the concept as far as possible.
-;;   i.e., function names might be a bold colour such as blue, comments might
-;;   be a bright colour such as red, character strings might be brown, because,
-;;   err, strings are brown (that was not the reason, please believe me).
-;; - Don't use a non-nil OVERRIDE unless you have a good reason.
-;;   Only use OVERRIDE for special things that are easy to define, such as the
-;;   way `...' quotes are treated in strings and comments in Emacs Lisp mode.
-;;   Don't use it to, say, highlight keywords in commented out code or strings.
-;; - Err, that's it.
-
-;;; Code:
-
-;; User variables.
-
-(defvar font-lock-verbose (* 0 1024)
-  "*If non-nil, means show status messages for buffer fontification.
-If a number, only buffers greater than this size have fontification messages.")
-
-;;;###autoload
-(defvar font-lock-maximum-decoration nil
-  "*Maximum decoration level for fontification.
-If nil, use the default decoration (typically the minimum available).
-If t, use the maximum decoration available.
-If a number, use that level of decoration (or if not available the maximum).
-If a list, each element should be a cons pair of the form (MAJOR-MODE . LEVEL),
-where MAJOR-MODE is a symbol or t (meaning the default).  For example:
- ((c-mode . t) (c++-mode . 2) (t . 1))
-means use the maximum decoration available for buffers in C mode, level 2
-decoration for buffers in C++ mode, and level 1 decoration otherwise.")
-
-;;;###autoload
-(defvar font-lock-maximum-size (* 250 1024)
-  "*Maximum size of a buffer for buffer fontification.
-Only buffers less than this can be fontified when Font Lock mode is turned on.
-If nil, means size is irrelevant.
-If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
-where MAJOR-MODE is a symbol or t (meaning the default).  For example:
- ((c-mode . 256000) (c++-mode . 256000) (rmail-mode . 1048576))
-means that the maximum size is 250K for buffers in C or C++ modes, one megabyte
-for buffers in Rmail mode, and size is irrelevant otherwise.")
-
-;; Fontification variables:
-
-;; Originally these variable values were face names such as `bold' etc.
-;; Now we create our own faces, but we keep these variables for compatibility
-;; and they give users another mechanism for changing face appearance.
-;; We now allow a FACENAME in `font-lock-keywords' to be any expression that
-;; returns a face.  So the easiest thing is to continue using these variables,
-;; rather than sometimes evaling FACENAME and sometimes not.
-(defvar font-lock-comment-face		'font-lock-comment-face
-  "Face to use for comments.")
-
-(defvar font-lock-string-face		'font-lock-string-face
-  "Face to use for strings.")
-
-(defvar font-lock-keyword-face		'font-lock-keyword-face
-  "Face to use for keywords.")
-
-(defvar font-lock-builtin-face		'font-lock-builtin-face
-  "Face to use for builtins.")
-
-(defvar font-lock-function-name-face	'font-lock-function-name-face
-  "Face to use for function names.")
-
-(defvar font-lock-variable-name-face	'font-lock-variable-name-face
-  "Face to use for variable names.")
-
-(defvar font-lock-type-face		'font-lock-type-face
-  "Face to use for type names.")
-
-(defvar font-lock-reference-face	'font-lock-reference-face
-  "Face to use for reference names.")
-
-(defvar font-lock-warning-face		'font-lock-warning-face
-  "Face to use for things that should stand out.")
-
-(defvar font-lock-keywords nil
-  "*A list of the keywords to highlight.
-Each element should be of the form:
-
- MATCHER
- (MATCHER . MATCH)
- (MATCHER . FACENAME)
- (MATCHER . HIGHLIGHT)
- (MATCHER HIGHLIGHT ...)
- (eval . FORM)
-
-where HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED.
-
-FORM is an expression, whose value should be a keyword element, evaluated when
-the keyword is (first) used in a buffer.  This feature can be used to provide a
-keyword that can only be generated when Font Lock mode is actually turned on.
-
-For highlighting single items, typically only MATCH-HIGHLIGHT is required.
-However, if an item or (typically) items are to be highlighted following the
-instance of another item (the anchor) then MATCH-ANCHORED may be required.
-
-MATCH-HIGHLIGHT should be of the form:
-
- (MATCH FACENAME OVERRIDE LAXMATCH)
-
-Where MATCHER can be either the regexp to search for, or the function name to
-call to make the search (called with one argument, the limit of the search).
-MATCH is the subexpression of MATCHER to be highlighted.  FACENAME is an
-expression whose value is the face name to use.  FACENAME's default attributes
-may be defined in `font-lock-face-attributes'.
-
-OVERRIDE and LAXMATCH are flags.  If OVERRIDE is t, existing fontification may
-be overwritten.  If `keep', only parts not already fontified are highlighted.
-If `prepend' or `append', existing fontification is merged with the new, in
-which the new or existing fontification, respectively, takes precedence.
-If LAXMATCH is non-nil, no error is signaled if there is no MATCH in MATCHER.
-
-For example, an element of the form highlights (if not already highlighted):
-
- \"\\\\\\=<foo\\\\\\=>\"		Discrete occurrences of \"foo\" in the value of the
-			variable `font-lock-keyword-face'.
- (\"fu\\\\(bar\\\\)\" . 1)	Substring \"bar\" within all occurrences of \"fubar\" in
-			the value of `font-lock-keyword-face'.
- (\"fubar\" . fubar-face)	Occurrences of \"fubar\" in the value of `fubar-face'.
- (\"foo\\\\|bar\" 0 foo-bar-face t)
-			Occurrences of either \"foo\" or \"bar\" in the value
-			of `foo-bar-face', even if already highlighted.
-
-MATCH-ANCHORED should be of the form:
-
- (MATCHER PRE-MATCH-FORM POST-MATCH-FORM MATCH-HIGHLIGHT ...)
-
-Where MATCHER is as for MATCH-HIGHLIGHT with one exception.  The limit of the
-search is currently guaranteed to be (no greater than) the end of the line.
-PRE-MATCH-FORM and POST-MATCH-FORM are evaluated before the first, and after
-the last, instance MATCH-ANCHORED's MATCHER is used.  Therefore they can be
-used to initialise before, and cleanup after, MATCHER is used.  Typically,
-PRE-MATCH-FORM is used to move to some position relative to the original
-MATCHER, before starting with MATCH-ANCHORED's MATCHER.  POST-MATCH-FORM might
-be used to move, before resuming with MATCH-ANCHORED's parent's MATCHER.
-
-For example, an element of the form highlights (if not already highlighted):
-
- (\"\\\\\\=<anchor\\\\\\=>\" (0 anchor-face) (\"\\\\\\=<item\\\\\\=>\" nil nil (0 item-face)))
-
- Discrete occurrences of \"anchor\" in the value of `anchor-face', and subsequent
- discrete occurrences of \"item\" (on the same line) in the value of `item-face'.
- (Here PRE-MATCH-FORM and POST-MATCH-FORM are nil.  Therefore \"item\" is
- initially searched for starting from the end of the match of \"anchor\", and
- searching for subsequent instance of \"anchor\" resumes from where searching
- for \"item\" concluded.)
-
-Note that the MATCH-ANCHORED feature is experimental; in the future, we may
-replace it with other ways of providing this functionality.
-
-These regular expressions should not match text which spans lines.  While
-\\[font-lock-fontify-buffer] handles multi-line patterns correctly, updating
-when you edit the buffer does not, since it considers text one line at a time.
-
-Be very careful composing regexps for this list;
-the wrong pattern can dramatically slow things down!")
-(make-variable-buffer-local 'font-lock-keywords)
-
-;; This variable is used by mode packages that support Font Lock mode by
-;; defining their own keywords to use for `font-lock-keywords'.  (The mode
-;; command should make it buffer-local and set it to provide the set up.)
-(defvar font-lock-defaults nil
-  "If set by a major mode, should be the defaults for Font Lock mode.
-The value should be like the `cdr' of an item in `font-lock-defaults-alist'.")
-
-;; This variable is used where font-lock.el itself supplies the keywords.
-(defvar font-lock-defaults-alist
-  (let (;; We use `beginning-of-defun', rather than nil, for SYNTAX-BEGIN.
-	;; Thus the calculation of the cache is usually faster but not
-	;; infallible, so we risk mis-fontification.  sm.
-	(c-mode-defaults
-	 '((c-font-lock-keywords c-font-lock-keywords-1
-	    c-font-lock-keywords-2 c-font-lock-keywords-3)
-	   nil nil ((?_ . "w")) beginning-of-defun
-	   (font-lock-comment-start-regexp . "/[*/]")
-	   (font-lock-mark-block-function . mark-defun)))
-	(c++-mode-defaults
-	 '((c++-font-lock-keywords c++-font-lock-keywords-1 
-	    c++-font-lock-keywords-2 c++-font-lock-keywords-3)
-	   nil nil ((?_ . "w") (?~ . "w")) beginning-of-defun
-	   (font-lock-comment-start-regexp . "/[*/]")
-	   (font-lock-mark-block-function . mark-defun)))
-	(objc-mode-defaults
-	 '((objc-font-lock-keywords objc-font-lock-keywords-1
-	    objc-font-lock-keywords-2 objc-font-lock-keywords-3)
-	   nil nil ((?_ . "w") (?$ . "w")) nil
-	   (font-lock-comment-start-regexp . "/[*/]")
-	   (font-lock-mark-block-function . mark-defun)))
-	(java-mode-defaults
-	 '((java-font-lock-keywords java-font-lock-keywords-1
-	    java-font-lock-keywords-2 java-font-lock-keywords-3)
-	   nil nil ((?_ . "w") (?$ . "w") (?. . "w")) nil
-	   (font-lock-comment-start-regexp . "/[*/]")
-	   (font-lock-mark-block-function . mark-defun)))
-	(lisp-mode-defaults
-	 '((lisp-font-lock-keywords
-	    lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
-	   nil nil (("+-*/.<>=!?$%_&~^:" . "w")) beginning-of-defun
-	   (font-lock-comment-start-regexp . ";")
-	   (font-lock-mark-block-function . mark-defun)))
-	(scheme-mode-defaults
-	 '(scheme-font-lock-keywords
-	   nil t (("+-*/.<>=!?$%_&~^:" . "w")) beginning-of-defun
-	   (font-lock-comment-start-regexp . ";")
-	   (font-lock-mark-block-function . mark-defun)))
-	;; For TeX modes we could use `backward-paragraph' for the same reason.
-	;; But we don't, because paragraph breaks are arguably likely enough to
-	;; occur within a genuine syntactic block to make it too risky.
-	;; However, we do specify a MARK-BLOCK function as that cannot result
-	;; in a mis-fontification even if it might not fontify enough.  --sm.
-	(tex-mode-defaults
-	 '(tex-font-lock-keywords nil nil ((?$ . "\"")) nil
-	   (font-lock-comment-start-regexp . "%")
-	   (font-lock-mark-block-function . mark-paragraph)))
-	)
-    (list
-     (cons 'c-mode			c-mode-defaults)
-     (cons 'c++-mode			c++-mode-defaults)
-     (cons 'objc-mode			objc-mode-defaults)
-     (cons 'java-mode			java-mode-defaults)
-     (cons 'emacs-lisp-mode		lisp-mode-defaults)
-     (cons 'inferior-scheme-mode	scheme-mode-defaults)
-     (cons 'latex-mode			tex-mode-defaults)
-     (cons 'lisp-mode			lisp-mode-defaults)
-     (cons 'lisp-interaction-mode	lisp-mode-defaults)
-     (cons 'plain-tex-mode		tex-mode-defaults)
-     (cons 'scheme-mode			scheme-mode-defaults)
-     (cons 'scheme-interaction-mode	scheme-mode-defaults)
-     (cons 'slitex-mode			tex-mode-defaults)
-     (cons 'tex-mode			tex-mode-defaults)))
-  "Alist of default major mode and Font Lock defaults.
-Each item should be a list of the form:
-
- (MAJOR-MODE . (KEYWORDS KEYWORDS-ONLY CASE-FOLD SYNTAX-ALIST SYNTAX-BEGIN
-                ...))
-
-where MAJOR-MODE is a symbol.  KEYWORDS may be a symbol (a variable or function
-whose value is the keywords to use for fontification) or a list of symbols.
-If KEYWORDS-ONLY is non-nil, syntactic fontification (strings and comments) is
-not performed.  If CASE-FOLD is non-nil, the case of the keywords is ignored
-when fontifying.  If SYNTAX-ALIST is non-nil, it should be a list of cons pairs
-of the form (CHAR-OR-STRING . STRING) used to set the local Font Lock syntax
-table, for keyword and syntactic fontification (see `modify-syntax-entry').
-
-If SYNTAX-BEGIN is non-nil, it should be a function with no args used to move
-backwards outside any enclosing syntactic block, for syntactic fontification.
-Typical values are `beginning-of-line' (i.e., the start of the line is known to
-be outside a syntactic block), or `beginning-of-defun' for programming modes or
-`backward-paragraph' for textual modes (i.e., the mode-dependent function is
-known to move outside a syntactic block).  If nil, the beginning of the buffer
-is used as a position outside of a syntactic block, in the worst case.
-
-These item elements are used by Font Lock mode to set the variables
-`font-lock-keywords', `font-lock-keywords-only',
-`font-lock-keywords-case-fold-search', `font-lock-syntax-table' and
-`font-lock-beginning-of-syntax-function', respectively.
-
-Further item elements are alists of the form (VARIABLE . VALUE) and are in no
-particular order.  Each VARIABLE is made buffer-local before set to VALUE.
-
-Currently, appropriate variables include `font-lock-mark-block-function'.
-If this is non-nil, it should be a function with no args used to mark any
-enclosing block of text, for fontification via \\[font-lock-fontify-block].
-Typical values are `mark-defun' for programming modes or `mark-paragraph' for
-textual modes (i.e., the mode-dependent function is known to put point and mark
-around a text block relevant to that mode).
-
-Other variables include those for buffer-specialised fontification functions,
-`font-lock-fontify-buffer-function', `font-lock-unfontify-buffer-function',
-`font-lock-fontify-region-function', `font-lock-unfontify-region-function',
-`font-lock-comment-start-regexp', `font-lock-inhibit-thing-lock' and
-`font-lock-maximum-size'.")
-
-(defvar font-lock-keywords-alist nil
-  "*Alist of `font-lock-keywords' local to a `major-mode'.
-This is normally set via `font-lock-add-keywords'.")
-
-(defvar font-lock-keywords-only nil
-  "*Non-nil means Font Lock should not fontify comments or strings.
-This is normally set via `font-lock-defaults'.")
-
-(defvar font-lock-keywords-case-fold-search nil
-  "*Non-nil means the patterns in `font-lock-keywords' are case-insensitive.
-This is normally set via `font-lock-defaults'.")
-
-(defvar font-lock-syntax-table nil
-  "Non-nil means use this syntax table for fontifying.
-If this is nil, the major mode's syntax table is used.
-This is normally set via `font-lock-defaults'.")
-
-;; If this is nil, we only use the beginning of the buffer if we can't use
-;; `font-lock-cache-position' and `font-lock-cache-state'.
-(defvar font-lock-beginning-of-syntax-function nil
-  "*Non-nil means use this function to move back outside of a syntactic block.
-When called with no args it should leave point at the beginning of any
-enclosing syntactic block.
-If this is nil, the beginning of the buffer is used (in the worst case).
-This is normally set via `font-lock-defaults'.")
-
-(defvar font-lock-mark-block-function nil
-  "*Non-nil means use this function to mark a block of text.
-When called with no args it should leave point at the beginning of any
-enclosing textual block and mark at the end.
-This is normally set via `font-lock-defaults'.")
-
-(defvar font-lock-comment-start-regexp nil
-  "*Regexp to match the start of a comment.
-This need not discriminate between genuine comments and quoted comment
-characters or comment characters within strings.
-If nil, `comment-start-skip' is used instead; see that variable for more info.
-This is normally set via `font-lock-defaults'.")
-
-(defvar font-lock-fontify-buffer-function 'font-lock-default-fontify-buffer
-  "Function to use for fontifying the buffer.
-This is normally set via `font-lock-defaults'.")
-
-(defvar font-lock-unfontify-buffer-function 'font-lock-default-unfontify-buffer
-  "Function to use for unfontifying the buffer.
-This is used when turning off Font Lock mode.
-This is normally set via `font-lock-defaults'.")
-
-(defvar font-lock-fontify-region-function 'font-lock-default-fontify-region
-  "Function to use for fontifying a region.
-It should take two args, the beginning and end of the region, and an optional
-third arg VERBOSE.  If non-nil, the function should print status messages.
-This is normally set via `font-lock-defaults'.")
-
-(defvar font-lock-unfontify-region-function 'font-lock-default-unfontify-region
-  "Function to use for unfontifying a region.
-It should take two args, the beginning and end of the region.
-This is normally set via `font-lock-defaults'.")
-
-(defvar font-lock-inhibit-thing-lock nil
-  "List of Font Lock mode related modes that should not be turned on.
-Currently, valid mode names as `fast-lock-mode' and `lazy-lock-mode'.
-This is normally set via `font-lock-defaults'.")
-
-(defvar font-lock-mode nil)		; For the modeline.
-(defvar font-lock-fontified nil)	; Whether we have fontified the buffer.
-
-;;;###autoload
-(defvar font-lock-mode-hook nil
-  "Function or functions to run on entry to Font Lock mode.")
-
-;; Font Lock mode.
-
-(eval-when-compile
-  ;;
-  ;; We don't do this at the top-level as we only use non-autoloaded macros.
-  (require 'cl)
-  ;;
-  ;; Borrowed from lazy-lock.el.
-  ;; We use this to preserve or protect things when modifying text properties.
-  (defmacro save-buffer-state (varlist &rest body)
-    "Bind variables according to VARLIST and eval BODY restoring buffer state."
-    (` (let* ((,@ (append varlist
-		   '((modified (buffer-modified-p))
-		     (inhibit-read-only t) (buffer-undo-list t)
-		     before-change-functions after-change-functions
-		     deactivate-mark buffer-file-name buffer-file-truename))))
-	 (,@ body)
-	 (when (and (not modified) (buffer-modified-p))
-	   (set-buffer-modified-p nil)))))
-  (put 'save-buffer-state 'lisp-indent-function 1))
-
-;;;###autoload
-(defun font-lock-mode (&optional arg)
-  "Toggle Font Lock mode.
-With arg, turn Font Lock mode on if and only if arg is positive.
-
-When Font Lock mode is enabled, text is fontified as you type it:
-
- - Comments are displayed in `font-lock-comment-face';
- - Strings are displayed in `font-lock-string-face';
- - Certain other expressions are displayed in other faces according to the
-   value of the variable `font-lock-keywords'.
-
-You can enable Font Lock mode in any major mode automatically by turning on in
-the major mode's hook.  For example, put in your ~/.emacs:
-
- (add-hook 'c-mode-hook 'turn-on-font-lock)
-
-Alternatively, you can use Global Font Lock mode to automagically turn on Font
-Lock mode in buffers whose major mode supports it and whose major mode is one
-of `font-lock-global-modes'.  For example, put in your ~/.emacs:
-
- (global-font-lock-mode t)
-
-There are a number of support modes that may be used to speed up Font Lock mode
-in various ways, specified via the variable `font-lock-support-mode'.  Where
-major modes support different levels of fontification, you can use the variable
-`font-lock-maximum-decoration' to specify which level you generally prefer.
-When you turn Font Lock mode on/off the buffer is fontified/defontified, though
-fontification occurs only if the buffer is less than `font-lock-maximum-size'.
-
-For example, to specify that Font Lock mode use use Lazy Lock mode as a support
-mode and use maximum levels of fontification, put in your ~/.emacs:
-
- (setq font-lock-support-mode 'lazy-lock-mode)
- (setq font-lock-maximum-decoration t)
-
-To fontify a buffer, without turning on Font Lock mode and regardless of buffer
-size, you can use \\[font-lock-fontify-buffer].
-
-To fontify a block (the function or paragraph containing point, or a number of
-lines around point), perhaps because modification on the current line caused
-syntactic change on other lines, you can use \\[font-lock-fontify-block].
-
-The default Font Lock mode highlighting are normally selected via the variable
-`font-lock-maximum-decoration'.  You can add your own highlighting for some
-mode, by calling `font-lock-add-keywords'.
-
-The default Font Lock mode faces and their attributes are defined in the
-variable `font-lock-face-attributes', and Font Lock mode default settings in
-the variable `font-lock-defaults-alist'.  You can set your own default settings
-for some mode, by setting a buffer local value for `font-lock-defaults', via
-its mode hook."
-  (interactive "P")
-  ;; Don't turn on Font Lock mode if we don't have a display (we're running a
-  ;; batch job) or if the buffer is invisible (the name starts with a space).
-  (let ((on-p (and (not noninteractive)
-		   (not (eq (aref (buffer-name) 0) ?\ ))
-		   (if arg
-		       (> (prefix-numeric-value arg) 0)
-		     (not font-lock-mode)))))
-    (set (make-local-variable 'font-lock-mode) on-p)
-    ;; Turn on Font Lock mode.
-    (when on-p
-      (make-local-hook 'after-change-functions)
-      (add-hook 'after-change-functions 'font-lock-after-change-function nil t)
-      (font-lock-set-defaults)
-      (font-lock-turn-on-thing-lock)
-      (run-hooks 'font-lock-mode-hook)
-      ;; Fontify the buffer if we have to.
-      (let ((max-size (font-lock-value-in-major-mode font-lock-maximum-size)))
-	(cond (font-lock-fontified
-	       nil)
-	      ((or (null max-size) (> max-size (buffer-size)))
-	       (font-lock-fontify-buffer))
-	      (font-lock-verbose
-	       (message "Fontifying %s...buffer too big" (buffer-name))))))
-    ;; Turn off Font Lock mode.
-    (unless on-p
-      (remove-hook 'after-change-functions 'font-lock-after-change-function t)
-      (font-lock-unfontify-buffer)
-      (font-lock-turn-off-thing-lock)
-      (font-lock-unset-defaults))
-    (force-mode-line-update)))
-
-;;;###autoload
-(defun turn-on-font-lock ()
-  "Turn on Font Lock mode conditionally.
-Turn on only if the terminal can display it."
-  (when window-system
-    (font-lock-mode t)))
-
-;;;###autoload
-(defun font-lock-add-keywords (major-mode keywords &optional append)
-  "Add highlighting KEYWORDS for MAJOR-MODE.
-MODE should be a symbol, the major mode command name, such as `c-mode' or nil.
-If nil, highlighting keywords are added for the current buffer.
-KEYWORDS should be a list; see the variable `font-lock-keywords'.
-By default they are added at the beginning of the current highlighting list.
-If optional argument APPEND is `set', they are used to replace the current
-highlighting list.  If APPEND has any other value, e.g., t, they are added at
-the end of the current highlighting list.
-
-For example:
-
- (font-lock-add-keywords 'c-mode
-  '((\"\\\\\\=<\\\\(FIXME\\\\):\" 1 font-lock-warning-face prepend)
-    (\"\\\\\\=<\\\\(and\\\\|or\\\\|not\\\\)\\\\\\=>\" . font-lock-keyword-face)))
-
-adds two fontification patterns for C mode, to fontify `FIXME:' words, even in
-comments, and to fontify `and', `or' and `not' words as keywords."
-  (cond (major-mode
-	 ;; If MAJOR-MODE is non-nil, add the KEYWORDS and APPEND spec to
-	 ;; `font-lock-keywords-alist' so `font-lock-set-defaults' uses them.
-	 (let ((spec (cons keywords append)) cell)
-	   (if (setq cell (assq major-mode font-lock-keywords-alist))
-	       (setcdr cell (append (cdr cell) (list spec)))
-	     (push (list major-mode spec) font-lock-keywords-alist))))
-	(font-lock-mode
-	 ;; Otherwise if Font Lock mode is on, set or add the keywords now.
-	 (if (eq append 'set)
-	     (setq font-lock-keywords keywords)
-	   (let ((old (if (eq (car-safe font-lock-keywords) t)
-			  (cdr font-lock-keywords)
-			font-lock-keywords)))
-	     (setq font-lock-keywords (if append
-					  (append old keywords)
-					(append keywords old))))))))
-
-;; Global Font Lock mode.
-;;
-;; A few people have hassled in the past for a way to make it easier to turn on
-;; Font Lock mode, without the user needing to know for which modes s/he has to
-;; turn it on, perhaps the same way hilit19.el/hl319.el does.  I've always
-;; balked at that way, as I see it as just re-moulding the same problem in
-;; another form.  That is; some person would still have to keep track of which
-;; modes (which may not even be distributed with Emacs) support Font Lock mode.
-;; The list would always be out of date.  And that person might have to be me.
-
-;; Implementation.
-;;
-;; In a previous discussion the following hack came to mind.  It is a gross
-;; hack, but it generally works.  We use the convention that major modes start
-;; by calling the function `kill-all-local-variables', which in turn runs
-;; functions on the hook variable `change-major-mode-hook'.  We attach our
-;; function `font-lock-change-major-mode' to that hook.  Of course, when this
-;; hook is run, the major mode is in the process of being changed and we do not
-;; know what the final major mode will be.  So, `font-lock-change-major-mode'
-;; only (a) notes the name of the current buffer, and (b) adds our function
-;; `turn-on-font-lock-if-enabled' to the hook variables `find-file-hooks' and
-;; `post-command-hook' (for buffers that are not visiting files).  By the time
-;; the functions on the first of these hooks to be run are run, the new major
-;; mode is assumed to be in place.  This way we get a Font Lock function run
-;; when a major mode is turned on, without knowing major modes or their hooks.
-;;
-;; Naturally this requires that (a) major modes run `kill-all-local-variables',
-;; as they are supposed to do, and (b) the major mode is in place after the
-;; file is visited or the command that ran `kill-all-local-variables' has
-;; finished, whichever the sooner.  Arguably, any major mode that does not
-;; follow the convension (a) is broken, and I can't think of any reason why (b)
-;; would not be met (except `gnudoit' on non-files).  However, it is not clean.
-;;
-;; Probably the cleanest solution is to have each major mode function run some
-;; hook, e.g., `major-mode-hook', but maybe implementing that change is
-;; impractical.  I am personally against making `setq' a macro or be advised,
-;; or have a special function such as `set-major-mode', but maybe someone can
-;; come up with another solution?
-
-;; User interface.
-;;
-;; Although Global Font Lock mode is a pseudo-mode, I think that the user
-;; interface should conform to the usual Emacs convention for modes, i.e., a
-;; command to toggle the feature (`global-font-lock-mode') with a variable for
-;; finer control of the mode's behaviour (`font-lock-global-modes').
-;;
-;; The feature should not be enabled by loading font-lock.el, since other
-;; mechanisms for turning on Font Lock mode, such as M-x font-lock-mode RET or
-;; (add-hook 'c-mode-hook 'turn-on-font-lock), would cause Font Lock mode to be
-;; turned on everywhere.  That would not be intuitive or informative because
-;; loading a file tells you nothing about the feature or how to control it.  It
-;; would also be contrary to the Principle of Least Surprise.
-
-(defvar font-lock-buffers nil)		; For remembering buffers.
-(defvar global-font-lock-mode nil)
-
-;;;###autoload
-(defvar font-lock-global-modes t
-  "*Modes for which Font Lock mode is automagically turned on.
-Global Font Lock mode is controlled by the `global-font-lock-mode' command.
-If nil, means no modes have Font Lock mode automatically turned on.
-If t, all modes that support Font Lock mode have it automatically turned on.
-If a list, it should be a list of `major-mode' symbol names for which Font Lock
-mode should be automatically turned on.  The sense of the list is negated if it
-begins with `not'.  For example:
- (c-mode c++-mode)
-means that Font Lock mode is turned on for buffers in C and C++ modes only.")
-
-;;;###autoload
-(defun global-font-lock-mode (&optional arg message)
-  "Toggle Global Font Lock mode.
-With prefix ARG, turn Global Font Lock mode on if and only if ARG is positive.
-Displays a message saying whether the mode is on or off if MESSAGE is non-nil.
-Returns the new status of Global Font Lock mode (non-nil means on).
-
-When Global Font Lock mode is enabled, Font Lock mode is automagically
-turned on in a buffer if its major mode is one of `font-lock-global-modes'."
-  (interactive "P\np")
-  (let ((off-p (if arg
-		   (<= (prefix-numeric-value arg) 0)
-		 global-font-lock-mode)))
-    (if off-p
-	(remove-hook 'find-file-hooks 'turn-on-font-lock-if-enabled)
-      (add-hook 'find-file-hooks 'turn-on-font-lock-if-enabled)
-      (add-hook 'post-command-hook 'turn-on-font-lock-if-enabled)
-      (setq font-lock-buffers (buffer-list)))
-    (when message
-      (message "Global Font Lock mode is now %s." (if off-p "OFF" "ON")))
-    (setq global-font-lock-mode (not off-p))))
-
-(defun font-lock-change-major-mode ()
-  ;; Turn off Font Lock mode if it's on.
-  (when font-lock-mode
-    (font-lock-mode nil))
-  ;; Gross hack warning: Delicate readers should avert eyes now.
-  ;; Something is running `kill-all-local-variables', which generally means the
-  ;; major mode is being changed.  Run `turn-on-font-lock-if-enabled' after the
-  ;; file is visited or the current command has finished.
-  (when global-font-lock-mode
-    (add-hook 'post-command-hook 'turn-on-font-lock-if-enabled)
-    (add-to-list 'font-lock-buffers (current-buffer))))
-
-(defun turn-on-font-lock-if-enabled ()
-  ;; Gross hack warning: Delicate readers should avert eyes now.
-  ;; Turn on Font Lock mode if it's supported by the major mode and enabled by
-  ;; the user.
-  (remove-hook 'post-command-hook 'turn-on-font-lock-if-enabled)
-  (while font-lock-buffers
-    (if (buffer-live-p (car font-lock-buffers))
-	(save-excursion
-	  (set-buffer (car font-lock-buffers))
-	  (if (and (or font-lock-defaults
-		       (assq major-mode font-lock-defaults-alist))
-		   (or (eq font-lock-global-modes t)
-		       (if (eq (car-safe font-lock-global-modes) 'not)
-			   (not (memq major-mode (cdr font-lock-global-modes)))
-			 (memq major-mode font-lock-global-modes))))
-	      (let (inhibit-quit)
-		(turn-on-font-lock)))))
-    (setq font-lock-buffers (cdr font-lock-buffers))))
-
-(add-hook 'change-major-mode-hook 'font-lock-change-major-mode)
-
-;; End of Global Font Lock mode.
-
-;; Font Lock Support mode.
-;;
-;; This is the code used to interface font-lock.el with any of its add-on
-;; packages, and provide the user interface.  Packages that have their own
-;; local buffer fontification functions (see below) may have to call
-;; `font-lock-after-fontify-buffer' and/or `font-lock-after-unfontify-buffer'
-;; themselves.
-
-;;;###autoload
-(defvar font-lock-support-mode nil
-  "*Support mode for Font Lock mode.
-Support modes speed up Font Lock mode by being choosy about when fontification
-occurs.  Known support modes are Fast Lock mode (symbol `fast-lock-mode') and
-Lazy Lock mode (symbol `lazy-lock-mode').  See those modes for more info.
-If nil, means support for Font Lock mode is never performed.
-If a symbol, use that support mode.
-If a list, each element should be of the form (MAJOR-MODE . SUPPORT-MODE),
-where MAJOR-MODE is a symbol or t (meaning the default).  For example:
- ((c-mode . fast-lock-mode) (c++-mode . fast-lock-mode) (t . lazy-lock-mode))
-means that Fast Lock mode is used to support Font Lock mode for buffers in C or
-C++ modes, and Lazy Lock mode is used to support Font Lock mode otherwise.
-
-The value of this variable is used when Font Lock mode is turned on.")
-
-(defvar fast-lock-mode nil)
-(defvar lazy-lock-mode nil)
-
-(defun font-lock-turn-on-thing-lock ()
-  (let ((thing-mode (font-lock-value-in-major-mode font-lock-support-mode)))
-    (cond ((eq thing-mode 'fast-lock-mode)
-	   (fast-lock-mode t))
-	  ((eq thing-mode 'lazy-lock-mode)
-	   (lazy-lock-mode t)))))
-
-(defun font-lock-turn-off-thing-lock ()
-  (cond (fast-lock-mode
-	 (fast-lock-mode nil))
-	(lazy-lock-mode
-	 (lazy-lock-mode nil))))
-
-(defun font-lock-after-fontify-buffer ()
-  (cond (fast-lock-mode
-	 (fast-lock-after-fontify-buffer))
-	(lazy-lock-mode
-	 (lazy-lock-after-fontify-buffer))))
-
-(defun font-lock-after-unfontify-buffer ()
-  (cond (fast-lock-mode
-	 (fast-lock-after-unfontify-buffer))
-	(lazy-lock-mode
-	 (lazy-lock-after-unfontify-buffer))))
-
-;; End of Font Lock Support mode.
-
-;; Fontification functions.
-
-;;;###autoload
-(defun font-lock-fontify-buffer ()
-  "Fontify the current buffer the way `font-lock-mode' would."
-  (interactive)
-  (let ((font-lock-verbose (or font-lock-verbose (interactive-p))))
-    (funcall font-lock-fontify-buffer-function)))
-
-(defun font-lock-unfontify-buffer ()
-  (funcall font-lock-unfontify-buffer-function))
-
-(defun font-lock-fontify-region (beg end &optional loudly)
-  (funcall font-lock-fontify-region-function beg end loudly))
-
-(defun font-lock-unfontify-region (beg end)
-  (funcall font-lock-unfontify-region-function beg end))
-
-(defun font-lock-default-fontify-buffer ()
-  (let ((verbose (if (numberp font-lock-verbose)
-		     (> (buffer-size) font-lock-verbose)
-		   font-lock-verbose)))
-    (if verbose (message "Fontifying %s..." (buffer-name)))
-    ;; Make sure we have the right `font-lock-keywords' etc.
-    (if (not font-lock-mode) (font-lock-set-defaults))
-    ;; Make sure we fontify etc. in the whole buffer.
-    (save-restriction
-      (widen)
-      (condition-case nil
-	  (save-excursion
-	    (save-match-data
-	      (font-lock-fontify-region (point-min) (point-max) verbose)
-	      (font-lock-after-fontify-buffer)
-	      (setq font-lock-fontified t)))
-	;; We don't restore the old fontification, so it's best to unfontify.
-	(quit (font-lock-unfontify-buffer))))
-    (if verbose (message "Fontifying %s...%s" (buffer-name)
-			 (if font-lock-fontified "done" "quit")))))
-
-(defun font-lock-default-unfontify-buffer ()
-  (save-restriction
-    (widen)
-    (font-lock-unfontify-region (point-min) (point-max))
-    (font-lock-after-unfontify-buffer)
-    (setq font-lock-fontified nil)))
-
-(defun font-lock-default-fontify-region (beg end loudly)
-  (save-buffer-state ((old-syntax-table (syntax-table)))
-    (unwind-protect
-	(save-restriction
-	  (widen)
-	  ;; Use the fontification syntax table, if any.
-	  (when font-lock-syntax-table
-	    (set-syntax-table font-lock-syntax-table))
-	  ;; Now do the fontification.
-	  (font-lock-unfontify-region beg end)
-	  (unless font-lock-keywords-only
-	    (font-lock-fontify-syntactically-region beg end loudly))
-	  (font-lock-fontify-keywords-region beg end loudly))
-      ;; Clean up.
-      (set-syntax-table old-syntax-table))))
-
-;; The following must be rethought, since keywords can override fontification.
-;      ;; Now scan for keywords, but not if we are inside a comment now.
-;      (or (and (not font-lock-keywords-only)
-;	       (let ((state (parse-partial-sexp beg end nil nil 
-;						font-lock-cache-state)))
-;		 (or (nth 4 state) (nth 7 state))))
-;	  (font-lock-fontify-keywords-region beg end))
-
-(defun font-lock-default-unfontify-region (beg end)
-  (save-buffer-state nil
-    (remove-text-properties beg end '(face nil))))
-
-;; Called when any modification is made to buffer text.
-(defun font-lock-after-change-function (beg end old-len)
-  (save-excursion
-    (save-match-data
-      ;; Rescan between start of lines enclosing the region.
-      (font-lock-fontify-region
-       (progn (goto-char beg) (beginning-of-line) (point))
-       (progn (goto-char (+ end old-len)) (forward-line 1) (point))))))
-
-(defun font-lock-fontify-block (&optional arg)
-  "Fontify some lines the way `font-lock-fontify-buffer' would.
-The lines could be a function or paragraph, or a specified number of lines.
-If ARG is given, fontify that many lines before and after point, or 16 lines if
-no ARG is given and `font-lock-mark-block-function' is nil.
-If `font-lock-mark-block-function' non-nil and no ARG is given, it is used to
-delimit the region to fontify."
-  (interactive "P")
-  (let (font-lock-beginning-of-syntax-function deactivate-mark)
-    ;; Make sure we have the right `font-lock-keywords' etc.
-    (if (not font-lock-mode) (font-lock-set-defaults))
-    (save-excursion
-      (save-match-data
-	(condition-case error-data
-	    (if (or arg (not font-lock-mark-block-function))
-		(let ((lines (if arg (prefix-numeric-value arg) 16)))
-		  (font-lock-fontify-region
-		   (save-excursion (forward-line (- lines)) (point))
-		   (save-excursion (forward-line lines) (point))))
-	      (funcall font-lock-mark-block-function)
-	      (font-lock-fontify-region (point) (mark)))
-	  ((error quit) (message "Fontifying block...%s" error-data)))))))
-
-(define-key facemenu-keymap "\M-g" 'font-lock-fontify-block)
-
-;; Syntactic fontification functions.
-
-;; These record the parse state at a particular position, always the start of a
-;; line.  Used to make `font-lock-fontify-syntactically-region' faster.
-;; Previously, `font-lock-cache-position' was just a buffer position.  However,
-;; under certain situations, this occasionally resulted in mis-fontification.
-;; I think those "situations" were deletion with Lazy Lock mode's deferral.
-(defvar font-lock-cache-state nil)
-(defvar font-lock-cache-position nil)
-
-(defun font-lock-fontify-syntactically-region (start end &optional loudly)
-  "Put proper face on each string and comment between START and END.
-START should be at the beginning of a line."
-  (let ((synstart (cond (font-lock-comment-start-regexp
-			 (concat "\\s\"\\|" font-lock-comment-start-regexp))
-			(comment-start-skip
-			 (concat "\\s\"\\|" comment-start-skip))
-			(t
-			 "\\s\"")))
-	(cache (marker-position font-lock-cache-position))
-	state prev here beg)
-    (if loudly (message "Fontifying %s... (syntactically...)" (buffer-name)))
-    (goto-char start)
-    ;;
-    ;; Find the state at the `beginning-of-line' before `start'.
-    (if (eq start cache)
-	;; Use the cache for the state of `start'.
-	(setq state font-lock-cache-state)
-      ;; Find the state of `start'.
-      (if (null font-lock-beginning-of-syntax-function)
-	  ;; Use the state at the previous cache position, if any, or
-	  ;; otherwise calculate from `point-min'.
-	  (if (or (null cache) (< start cache))
-	      (setq state (parse-partial-sexp (point-min) start))
-	    (setq state (parse-partial-sexp cache start nil nil
-					    font-lock-cache-state)))
-	;; Call the function to move outside any syntactic block.
-	(funcall font-lock-beginning-of-syntax-function)
-	(setq state (parse-partial-sexp (point) start)))
-      ;; Cache the state and position of `start'.
-      (setq font-lock-cache-state state)
-      (set-marker font-lock-cache-position start))
-    ;;
-    ;; If the region starts inside a string, show the extent of it.
-    (when (nth 3 state)
-      (setq here (point))
-      (while (and (re-search-forward "\\s\"" end 'move)
-		  ;; Verify the state so we don't get fooled by quoting.
-		  (nth 3 (parse-partial-sexp here (point) nil nil state))))
-      (put-text-property here (point) 'face font-lock-string-face)
-      (setq state (parse-partial-sexp here (point) nil nil state)))
-    ;;
-    ;; Likewise for a comment.
-    (when (or (nth 4 state) (nth 7 state))
-      (let ((comstart (cond (font-lock-comment-start-regexp
-			     font-lock-comment-start-regexp)
-			    (comment-start-skip
-			     (concat "\\s<\\|" comment-start-skip))
-			    (t
-			     "\\s<")))
-	    (count 1))
-	(setq here (point))
-	(condition-case nil
-	    (save-restriction
-	      (narrow-to-region (point-min) end)
-	      ;; Go back to the real start of the comment.
-	      (re-search-backward comstart)
-	      (forward-comment 1)
-	      ;; If there is more than one comment type, then the previous
-	      ;; comment start might not be the real comment start.
-	      ;; For example, in C++ code, `here' might be on a line following
-	      ;; a // comment that is actually within a /* */ comment.
-	      (while (<= (point) here)
-		(goto-char here)
-		(re-search-backward comstart nil nil (incf count))
-		(forward-comment 1))
-	      ;; Go back to the real end of the comment.
-	      (skip-chars-backward " \t"))
-	  (error (goto-char end)))
-	(put-text-property here (point) 'face font-lock-comment-face)
-	(setq state (parse-partial-sexp here (point) nil nil state))))
-    ;;
-    ;; Find each interesting place between here and `end'.
-    (while (and (< (point) end)
-		(setq prev (point))
-		(re-search-forward synstart end t)
-		(setq state (parse-partial-sexp prev (point) nil nil state)))
-      (cond ((nth 3 state)
-	     ;;
-	     ;; Found a real string start.
-	     (setq here (point) beg (match-beginning 0))
-	     (condition-case nil
-		 (save-restriction
-		   (narrow-to-region (point-min) end)
-		   (goto-char (scan-sexps beg 1)))
-	       (error (goto-char end)))
-	     (put-text-property beg (point) 'face font-lock-string-face)
-	     (setq state (parse-partial-sexp here (point) nil nil state)))
-	    ((or (nth 4 state) (nth 7 state))
-	     ;;
-	     ;; Found a real comment start.
-	     (setq here (point) beg (or (match-end 1) (match-beginning 0)))
-	     (goto-char beg)
-	     (condition-case nil
-		 (save-restriction
-		   (narrow-to-region (point-min) end)
-		   (forward-comment 1)
-		   (skip-chars-backward " \t"))
-	       (error (goto-char end)))
-	     (put-text-property beg (point) 'face font-lock-comment-face)
-	     (setq state (parse-partial-sexp here (point) nil nil state)))))))
-
-;;; Additional text property functions.
-
-;; The following three text property functions are not generally available (and
-;; it's not certain that they should be) so they are inlined for speed.
-;; The case for `fillin-text-property' is simple; it may or not be generally
-;; useful.  (Since it is used here, it is useful in at least one place.;-)
-;; However, the case for `append-text-property' and `prepend-text-property' is
-;; more complicated.  Should they remove duplicate property values or not?  If
-;; so, should the first or last duplicate item remain?  Or the one that was
-;; added?  In our implementation, the first duplicate remains.
-
-(defsubst font-lock-fillin-text-property (start end prop value &optional object)
-  "Fill in one property of the text from START to END.
-Arguments PROP and VALUE specify the property and value to put where none are
-already in place.  Therefore existing property values are not overwritten.
-Optional argument OBJECT is the string or buffer containing the text."
-  (let ((start (text-property-any start end prop nil object)) next)
-    (while start
-      (setq next (next-single-property-change start prop object end))
-      (put-text-property start next prop value object)
-      (setq start (text-property-any next end prop nil object)))))
-
-;; This function (from simon's unique.el) is rewritten and inlined for speed.
-;(defun unique (list function)
-;  "Uniquify LIST, deleting elements using FUNCTION.
-;Return the list with subsequent duplicate items removed by side effects.
-;FUNCTION is called with an element of LIST and a list of elements from LIST,
-;and should return the list of elements with occurrences of the element removed,
-;i.e., a function such as `delete' or `delq'.
-;This function will work even if LIST is unsorted.  See also `uniq'."
-;  (let ((list list))
-;    (while list
-;      (setq list (setcdr list (funcall function (car list) (cdr list))))))
-;  list)
-
-(defsubst font-lock-unique (list)
-  "Uniquify LIST, deleting elements using `delq'.
-Return the list with subsequent duplicate items removed by side effects."
-  (let ((list list))
-    (while list
-      (setq list (setcdr list (delq (car list) (cdr list))))))
-  list)
-
-;; A generalisation of `facemenu-add-face' for any property, but without the
-;; removal of inactive faces via `facemenu-discard-redundant-faces' and special
-;; treatment of `default'.  Uses `unique' to remove duplicate property values.
-(defsubst font-lock-prepend-text-property (start end prop value &optional object)
-  "Prepend to one property of the text from START to END.
-Arguments PROP and VALUE specify the property and value to prepend to the value
-already in place.  The resulting property values are always lists, and unique.
-Optional argument OBJECT is the string or buffer containing the text."
-  (let ((val (if (listp value) value (list value))) next prev)
-    (while (/= start end)
-      (setq next (next-single-property-change start prop object end)
-	    prev (get-text-property start prop object))
-      (put-text-property
-       start next prop
-       (font-lock-unique (append val (if (listp prev) prev (list prev))))
-       object)
-      (setq start next))))
-
-(defsubst font-lock-append-text-property (start end prop value &optional object)
-  "Append to one property of the text from START to END.
-Arguments PROP and VALUE specify the property and value to append to the value
-already in place.  The resulting property values are always lists, and unique.
-Optional argument OBJECT is the string or buffer containing the text."
-  (let ((val (if (listp value) value (list value))) next prev)
-    (while (/= start end)
-      (setq next (next-single-property-change start prop object end)
-	    prev (get-text-property start prop object))
-      (put-text-property
-       start next prop
-       (font-lock-unique (append (if (listp prev) prev (list prev)) val))
-       object)
-      (setq start next))))
-
-;;; Regexp fontification functions.
-
-(defsubst font-lock-apply-highlight (highlight)
-  "Apply HIGHLIGHT following a match.
-HIGHLIGHT should be of the form MATCH-HIGHLIGHT, see `font-lock-keywords'."
-  (let* ((match (nth 0 highlight))
-	 (start (match-beginning match)) (end (match-end match))
-	 (override (nth 2 highlight)))
-    (cond ((not start)
-	   ;; No match but we might not signal an error.
-	   (or (nth 3 highlight)
-	       (error "No match %d in highlight %S" match highlight)))
-	  ((not override)
-	   ;; Cannot override existing fontification.
-	   (or (text-property-not-all start end 'face nil)
-	       (put-text-property start end 'face (eval (nth 1 highlight)))))
-	  ((eq override t)
-	   ;; Override existing fontification.
-	   (put-text-property start end 'face (eval (nth 1 highlight))))
-	  ((eq override 'prepend)
-	   ;; Prepend to existing fontification.
-	   (font-lock-prepend-text-property start end 'face
-					    (eval (nth 1 highlight))))
-	  ((eq override 'append)
-	   ;; Append to existing fontification.
-	   (font-lock-append-text-property start end 'face
-					   (eval (nth 1 highlight))))
-	  ((eq override 'keep)
-	   ;; Keep existing fontification.
-	   (font-lock-fillin-text-property start end 'face
-					   (eval (nth 1 highlight)))))))
-
-(defsubst font-lock-fontify-anchored-keywords (keywords limit)
-  "Fontify according to KEYWORDS until LIMIT.
-KEYWORDS should be of the form MATCH-ANCHORED, see `font-lock-keywords'."
-  (let ((matcher (nth 0 keywords)) (lowdarks (nthcdr 3 keywords)) highlights)
-    ;; Until we come up with a cleaner solution, we make LIMIT the end of line.
-    (save-excursion (end-of-line) (setq limit (min limit (point))))
-    ;; Evaluate PRE-MATCH-FORM.
-    (eval (nth 1 keywords))
-    (save-match-data
-      ;; Find an occurrence of `matcher' before `limit'.
-      (while (if (stringp matcher)
-		 (re-search-forward matcher limit t)
-	       (funcall matcher limit))
-	;; Apply each highlight to this instance of `matcher'.
-	(setq highlights lowdarks)
-	(while highlights
-	  (font-lock-apply-highlight (car highlights))
-	  (setq highlights (cdr highlights)))))
-    ;; Evaluate POST-MATCH-FORM.
-    (eval (nth 2 keywords))))
-
-(defun font-lock-fontify-keywords-region (start end &optional loudly)
-  "Fontify according to `font-lock-keywords' between START and END.
-START should be at the beginning of a line."
-  (let ((case-fold-search font-lock-keywords-case-fold-search)
-	(keywords (cdr (if (eq (car-safe font-lock-keywords) t)
-			   font-lock-keywords
-			 (font-lock-compile-keywords))))
-	(bufname (buffer-name)) (count 0)
-	keyword matcher highlights)
-    ;;
-    ;; Fontify each item in `font-lock-keywords' from `start' to `end'.
-    (while keywords
-      (if loudly (message "Fontifying %s... (regexps..%s)" bufname
-			  (make-string (incf count) ?.)))
-      ;;
-      ;; Find an occurrence of `matcher' from `start' to `end'.
-      (setq keyword (car keywords) matcher (car keyword))
-      (goto-char start)
-      (while (if (stringp matcher)
-		 (re-search-forward matcher end t)
-	       (funcall matcher end))
-	;; Apply each highlight to this instance of `matcher', which may be
-	;; specific highlights or more keywords anchored to `matcher'.
-	(setq highlights (cdr keyword))
-	(while highlights
-	  (if (numberp (car (car highlights)))
-	      (font-lock-apply-highlight (car highlights))
-	    (font-lock-fontify-anchored-keywords (car highlights) end))
-	  (setq highlights (cdr highlights))))
-      (setq keywords (cdr keywords)))))
-
-;; Various functions.
-
-(defun font-lock-compile-keywords (&optional keywords)
-  ;; Compile `font-lock-keywords' into the form (t KEYWORD ...) where KEYWORD
-  ;; is the (MATCHER HIGHLIGHT ...) shown in the variable's doc string.
-  (let ((keywords (or keywords font-lock-keywords)))
-    (setq font-lock-keywords 
-	  (if (eq (car-safe keywords) t)
-	      keywords
-	    (cons t (mapcar 'font-lock-compile-keyword keywords))))))
-
-(defun font-lock-compile-keyword (keyword)
-  (cond ((nlistp keyword)			; MATCHER
-	 (list keyword '(0 font-lock-keyword-face)))
-	((eq (car keyword) 'eval)		; (eval . FORM)
-	 (font-lock-compile-keyword (eval (cdr keyword))))
-	((eq (car-safe (cdr keyword)) 'quote)	; (MATCHER . 'FORM)
-	 ;; If FORM is a FACENAME then quote it.  Otherwise ignore the quote.
-	 (if (symbolp (nth 2 keyword))
-	     (list (car keyword) (list 0 (cdr keyword)))
-	   (font-lock-compile-keyword (cons (car keyword) (nth 2 keyword)))))
-	((numberp (cdr keyword))		; (MATCHER . MATCH)
-	 (list (car keyword) (list (cdr keyword) 'font-lock-keyword-face)))
-	((symbolp (cdr keyword))		; (MATCHER . FACENAME)
-	 (list (car keyword) (list 0 (cdr keyword))))
-	((nlistp (nth 1 keyword))		; (MATCHER . HIGHLIGHT)
-	 (list (car keyword) (cdr keyword)))
-	(t					; (MATCHER HIGHLIGHT ...)
-	 keyword)))
-
-(defun font-lock-value-in-major-mode (alist)
-  ;; Return value in ALIST for `major-mode', or ALIST if it is not an alist.
-  ;; Structure is ((MAJOR-MODE . VALUE) ...) where MAJOR-MODE may be t.
-  (if (consp alist)
-      (cdr (or (assq major-mode alist) (assq t alist)))
-    alist))
-
-(defun font-lock-choose-keywords (keywords level)
-  ;; Return LEVELth element of KEYWORDS.  A LEVEL of nil is equal to a
-  ;; LEVEL of 0, a LEVEL of t is equal to (1- (length KEYWORDS)).
-  (cond ((symbolp keywords)
-	 keywords)
-	((numberp level)
-	 (or (nth level keywords) (car (reverse keywords))))
-	((eq level t)
-	 (car (reverse keywords)))
-	(t
-	 (car keywords))))
-
-(defvar font-lock-set-defaults nil)	; Whether we have set up defaults.
-
-(defun font-lock-set-defaults ()
-  "Set fontification defaults appropriately for this mode.
-Sets various variables using `font-lock-defaults' (or, if nil, using
-`font-lock-defaults-alist') and `font-lock-maximum-decoration'."
-  ;; Set face defaults.
-  (font-lock-make-faces)
-  ;; Set fontification defaults.
-  (make-local-variable 'font-lock-fontified)
-  ;; Set iff not previously set.
-  (unless font-lock-set-defaults
-    (set (make-local-variable 'font-lock-set-defaults)		t)
-    (set (make-local-variable 'font-lock-cache-state)		nil)
-    (set (make-local-variable 'font-lock-cache-position)	(make-marker))
-    (let* ((defaults (or font-lock-defaults
-			 (cdr (assq major-mode font-lock-defaults-alist))))
-	   (keywords
-	    (font-lock-choose-keywords (nth 0 defaults)
-	     (font-lock-value-in-major-mode font-lock-maximum-decoration)))
-	   (local (cdr (assq major-mode font-lock-keywords-alist))))
-      ;; Regexp fontification?
-      (setq font-lock-keywords (if (fboundp keywords)
-				   (funcall keywords)
-				 (eval keywords)))
-      ;; Local fontification?
-      (while local
-	(font-lock-add-keywords nil (car (car local)) (cdr (car local)))
-	(setq local (cdr local)))
-      ;; Syntactic fontification?
-      (when (nth 1 defaults)
-	(set (make-local-variable 'font-lock-keywords-only) t))
-      ;; Case fold during regexp fontification?
-      (when (nth 2 defaults)
-	(set (make-local-variable 'font-lock-keywords-case-fold-search) t))
-      ;; Syntax table for regexp and syntactic fontification?
-      (when (nth 3 defaults)
-	(let ((slist (nth 3 defaults)))
-	  (set (make-local-variable 'font-lock-syntax-table)
-	       (copy-syntax-table (syntax-table)))
-	  (while slist
-	    ;; The character to modify may be a single CHAR or a STRING.
-	    (let ((chars (if (numberp (car (car slist)))
-			     (list (car (car slist)))
-			   (mapcar 'identity (car (car slist)))))
-		  (syntax (cdr (car slist))))
-	      (while chars
-		(modify-syntax-entry (car chars) syntax
-				     font-lock-syntax-table)
-		(setq chars (cdr chars)))
-	      (setq slist (cdr slist))))))
-      ;; Syntax function for syntactic fontification?
-      (when (nth 4 defaults)
-	(set (make-local-variable 'font-lock-beginning-of-syntax-function)
-	     (nth 4 defaults)))
-      ;; Variable alist?
-      (let ((alist (nthcdr 5 defaults)))
-	(while alist
-	  (set (make-local-variable (car (car alist))) (cdr (car alist)))
-	  (setq alist (cdr alist)))))))
-
-(defun font-lock-unset-defaults ()
-  "Unset fontification defaults.  See `font-lock-set-defaults'."
-  (setq font-lock-set-defaults			nil
-	font-lock-keywords			nil
-	font-lock-keywords-only			nil
-	font-lock-keywords-case-fold-search	nil
-	font-lock-syntax-table			nil
-	font-lock-beginning-of-syntax-function	nil)
-  (let* ((defaults (or font-lock-defaults
-		       (cdr (assq major-mode font-lock-defaults-alist))))
-	 (alist (nthcdr 5 defaults)))
-    (while alist
-      (set (car (car alist)) (default-value (car (car alist))))
-      (setq alist (cdr alist)))))
-
-;; Colour etc. support.
-
-;; This section of code is crying out for revision.
-
-;; To begin with, `display-type' and `background-mode' are `frame-parameters'
-;; so we don't have to calculate them here anymore.  But all the face stuff
-;; should be frame-local (and thus display-local) anyway.  Because we're not
-;; sure what support Emacs is going to have for general frame-local face
-;; attributes, we leave this section of code as it is.  For now.  --sm.
-
-(defvar font-lock-display-type nil
-  "A symbol indicating the display Emacs is running under.
-The symbol should be one of `color', `grayscale' or `mono'.
-If Emacs guesses this display attribute wrongly, either set this variable in
-your `~/.emacs' or set the resource `Emacs.displayType' in your `~/.Xdefaults'.
-See also `font-lock-background-mode' and `font-lock-face-attributes'.")
-
-(defvar font-lock-background-mode nil
-  "A symbol indicating the Emacs background brightness.
-The symbol should be one of `light' or `dark'.
-If Emacs guesses this frame attribute wrongly, either set this variable in
-your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
-`~/.Xdefaults'.
-See also `font-lock-display-type' and `font-lock-face-attributes'.")
-
-(defvar font-lock-face-attributes nil
-  "A list of default attributes to use for face attributes.
-Each element of the list should be of the form
-
- (FACE FOREGROUND BACKGROUND BOLD-P ITALIC-P UNDERLINE-P)
-
-where FACE could be one of the face symbols `font-lock-comment-face',
-`font-lock-string-face', `font-lock-keyword-face', `font-lock-builtin-face',
-`font-lock-type-face', `font-lock-function-name-face',
-`font-lock-variable-name-face', `font-lock-reference-face' and
-`font-lock-warning-face', or any other face symbols and attributes may be
-specified here and used in `font-lock-keywords'.
-
-Subsequent element items should be the attributes for the corresponding
-Font Lock mode faces.  Attributes FOREGROUND and BACKGROUND should be strings
-\(default if nil), while BOLD-P, ITALIC-P, and UNDERLINE-P should specify the
-corresponding face attributes (yes if non-nil).
-
-Emacs uses default attributes based on display type and background brightness.
-See variables `font-lock-display-type' and `font-lock-background-mode'.
-
-Resources can be used to over-ride these face attributes.  For example, the
-resource `Emacs.font-lock-comment-face.attributeUnderline' can be used to
-specify the UNDERLINE-P attribute for face `font-lock-comment-face'.")
-
-(defun font-lock-make-faces (&optional override)
-  "Make faces from `font-lock-face-attributes'.
-A default list is used if this is nil.
-If optional OVERRIDE is non-nil, faces that already exist are reset.
-See `font-lock-make-face' and `list-faces-display'."
-  ;; We don't need to `setq' any of these variables, but the user can see what
-  ;; is being used if we do.
-  (unless font-lock-display-type
-    (setq font-lock-display-type
-     (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
-       (cond (display-resource (intern (downcase display-resource)))
-	     ((x-display-color-p) 'color)
-	     ((x-display-grayscale-p) 'grayscale)
-	     (t 'mono)))))
-  (unless font-lock-background-mode
-    (setq font-lock-background-mode
-     (let ((bg-resource (x-get-resource ".backgroundMode" "BackgroundMode"))
-	   (params (frame-parameters)))
-       (cond (bg-resource (intern (downcase bg-resource)))
-	     ((eq system-type 'ms-dos)
-	      (if (string-match "light" (cdr (assq 'background-color params)))
-		  'light
-		'dark))
-	     ((< (apply '+ (x-color-values
-			    (cdr (assq 'background-color params))))
-		 (* (apply '+ (x-color-values "white")) .6))
-	      'dark)
-	     (t 'light)))))
-  (let ((face-attributes
-	 (let ((light-bg (eq font-lock-background-mode 'light)))
-	   (cond ((memq font-lock-display-type '(mono monochrome))
-		  ;; Emacs 19.25's font-lock defaults:
-		  ;;'((font-lock-comment-face nil nil nil t nil)
-		  ;;  (font-lock-string-face nil nil nil nil t)
-		  ;;  (font-lock-keyword-face nil nil t nil nil)
-		  ;;  (font-lock-function-name-face nil nil t t nil)
-		  ;;  (font-lock-type-face nil nil nil t nil))
-		  (list '(font-lock-comment-face nil nil t t nil)
-			'(font-lock-string-face nil nil nil t nil)
-			'(font-lock-keyword-face nil nil t nil nil)
-			'(font-lock-builtin-face nil nil t nil nil)
-			(list
-			 'font-lock-function-name-face
-			 (cdr (assq 'background-color (frame-parameters)))
-			 (cdr (assq 'foreground-color (frame-parameters)))
-			 t nil nil)
-			'(font-lock-variable-name-face nil nil t t nil)
-			'(font-lock-type-face nil nil t nil t)
-			'(font-lock-reference-face nil nil t nil t)
-			(list
-			 'font-lock-warning-face
-			 (cdr (assq 'background-color (frame-parameters)))
-			 (cdr (assq 'foreground-color (frame-parameters)))
-			 t nil nil)))
-		 ((memq font-lock-display-type '(grayscale greyscale
-						 grayshade greyshade))
-		  (list
-		   (list 'font-lock-comment-face
-			 (if light-bg "DimGray" "LightGray") nil t t nil)
-		   (list 'font-lock-string-face
-			 (if light-bg "DimGray" "LightGray") nil nil t nil)
-		   (list 'font-lock-keyword-face
-			 nil (if light-bg "LightGray" "DimGray") t nil nil)
-		   (list 'font-lock-builtin-face
-			 nil (if light-bg "LightGray" "DimGray") t nil nil)
-		   (list 'font-lock-function-name-face
-			 (cdr (assq 'background-color (frame-parameters)))
-			 (cdr (assq 'foreground-color (frame-parameters)))
-			 t nil nil)
-		   (list 'font-lock-variable-name-face
-			 nil (if light-bg "Gray90" "DimGray") t t nil)
-		   (list 'font-lock-type-face
-			 nil (if light-bg "Gray80" "DimGray") t nil nil)
-		   (list 'font-lock-reference-face
-			 nil (if light-bg "LightGray" "Gray50") t nil t)
-		   (list 'font-lock-warning-face
-			 (cdr (assq 'background-color (frame-parameters)))
-			 (cdr (assq 'foreground-color (frame-parameters)))
-			 t nil nil)))
-		 (light-bg		; light colour background
-		  '((font-lock-comment-face "Firebrick")
-		    (font-lock-string-face "RosyBrown")
-		    (font-lock-keyword-face "Purple")
-		    (font-lock-builtin-face "Orchid")
-		    (font-lock-function-name-face "Blue")
-		    (font-lock-variable-name-face "DarkGoldenrod")
-		    (font-lock-type-face "DarkOliveGreen")
-		    (font-lock-reference-face "CadetBlue")
-		    (font-lock-warning-face "Red" nil t nil nil)))
-		 (t			; dark colour background
-		  '((font-lock-comment-face "OrangeRed")
-		    (font-lock-string-face "LightSalmon")
-		    (font-lock-keyword-face "Cyan")
-		    (font-lock-builtin-face "LightSteelBlue")
-		    (font-lock-function-name-face "LightSkyBlue")
-		    (font-lock-variable-name-face "LightGoldenrod")
-		    (font-lock-type-face "PaleGreen")
-		    (font-lock-reference-face "Aquamarine")
-		    (font-lock-warning-face "Pink" nil t nil nil)))))))
-    (while face-attributes
-      (unless (assq (car (car face-attributes)) font-lock-face-attributes)
-	(push (car face-attributes) font-lock-face-attributes))
-      (setq face-attributes (cdr face-attributes))))
-  ;; Now make the faces if we have to.
-  (mapcar (function
-	   (lambda (face-attributes)
-	     (let ((face (nth 0 face-attributes)))
-	       (cond (override
-		      ;; We can stomp all over it anyway.  Get outta my face!
-		      (font-lock-make-face face-attributes))
-		     ((and (boundp face) (facep (symbol-value face)))
-		      ;; The variable exists and is already bound to a face.
-		      nil)
-		     ((facep face)
-		      ;; We already have a face so we bind the variable to it.
-		      (set face face))
-		     (t
-		      ;; No variable or no face.
-		      (font-lock-make-face face-attributes))))))
-	  font-lock-face-attributes))
-
-(defun font-lock-make-face (face-attributes)
-  "Make a face from FACE-ATTRIBUTES.
-FACE-ATTRIBUTES should be like an element `font-lock-face-attributes', so that
-the face name is the first item in the list.  A variable with the same name as
-the face is also set; its value is the face name."
-  (let* ((face (nth 0 face-attributes))
-	 (face-name (symbol-name face))
-	 (set-p (function (lambda (face-name resource)
-		 (x-get-resource (concat face-name ".attribute" resource)
-				 (concat "Face.Attribute" resource)))))
-	 (on-p (function (lambda (face-name resource)
-		(let ((set (funcall set-p face-name resource)))
-		  (and set (member (downcase set) '("on" "true"))))))))
-    (make-face face)
-    (add-to-list 'facemenu-unlisted-faces face)
-    ;; Set attributes not set from X resources (and therefore `make-face').
-    (or (funcall set-p face-name "Foreground")
-	(condition-case nil
-	    (set-face-foreground face (nth 1 face-attributes))
-	  (error nil)))
-    (or (funcall set-p face-name "Background")
-	(condition-case nil
-	    (set-face-background face (nth 2 face-attributes))
-	  (error nil)))
-    (if (funcall set-p face-name "Bold")
-	(and (funcall on-p face-name "Bold") (make-face-bold face nil t))
-      (and (nth 3 face-attributes) (make-face-bold face nil t)))
-    (if (funcall set-p face-name "Italic")
-	(and (funcall on-p face-name "Italic") (make-face-italic face nil t))
-      (and (nth 4 face-attributes) (make-face-italic face nil t)))
-    (or (funcall set-p face-name "Underline")
-	(set-face-underline-p face (nth 5 face-attributes)))
-    (set face face)))
-
-;;; Various regexp information shared by several modes.
-;;; Information specific to a single mode should go in its load library.
-
-;; The C/C++/Objective-C/Java support is in cc-font.el loaded by cc-mode.el.
-;; The below function should stay in font-lock.el, since it is used by many
-;; other libraries.
-
-(defun font-lock-match-c-style-declaration-item-and-skip-to-next (limit)
-  "Match, and move over, any declaration/definition item after point.
-Matches after point, but ignores leading whitespace and `*' characters.
-Does not move further than LIMIT.
-
-The expected syntax of a declaration/definition item is `word', possibly ending
-with optional whitespace and a `('.  Everything following the item (but
-belonging to it) is expected to by skip-able by `scan-sexps', and items are
-expected to be separated with a `,' and to be terminated with a `;'.
-
-Thus the regexp matches after point:	word (
-					^^^^ ^
-Where the match subexpressions are:	  1  2
-
-The item is delimited by (match-beginning 1) and (match-end 1).
-If (match-beginning 2) is non-nil, the item is followed by a `('.
-
-This function could be MATCHER in a MATCH-ANCHORED `font-lock-keywords' item."
-  (when (looking-at "[ \t*]*\\(\\sw+\\)[ \t]*\\((\\)?")
-    (save-match-data
-      (condition-case nil
-	  (save-restriction
-	    ;; Restrict to the end of line, currently guaranteed to be LIMIT.
-	    (narrow-to-region (point-min) limit)
-	    (goto-char (match-end 1))
-	    ;; Move over any item value, etc., to the next item.
-	    (while (not (looking-at "[ \t]*\\(\\(,\\)\\|;\\|$\\)"))
-	      (goto-char (or (scan-sexps (point) 1) (point-max))))
-	    (goto-char (match-end 2)))
-	(error t)))))
-
-
-(defconst lisp-font-lock-keywords-1
-  (eval-when-compile
-    (list
-     ;; Anything not a variable or type declaration is fontified as a function.
-     ;; It would be cleaner to allow preceding whitespace, but it would also be
-     ;; about five times slower.
-     (list (concat "^(\\(def\\("
-		   ;; Variable declarations.
-		   "\\(const\\|custom\\|var\\)\\|"
-		   ;; Structure declarations.
-		   "\\(class\\|struct\\|type\\)\\|"
-		   ;; Everything else is a function declaration.
-		   "\\sw+"
-		   "\\)\\)\\>"
-		   ;; Any whitespace and declared object.
-		   "[ \t'\(]*"
-		   "\\(\\sw+\\)?")
-	   '(1 font-lock-keyword-face)
-	   '(5 (cond ((match-beginning 3) font-lock-variable-name-face)
-		     ((match-beginning 4) font-lock-type-face)
-		     (t font-lock-function-name-face))
-	       nil t))
-     ))
- "Subdued level highlighting for Lisp modes.")
-
-(defconst lisp-font-lock-keywords-2
-  (append lisp-font-lock-keywords-1
-   (eval-when-compile
-     (list
-      ;;
-      ;; Control structures.  Common ELisp and CLisp forms combined.
-;      (make-regexp
-;       '("cond" "if" "while" "let\\*?" "prog[nv12*]?" "inline" "catch" "throw"
-;	 "save-restriction" "save-excursion" "save-window-excursion"
-;	 "save-selected-window" "save-match-data" "save-current-buffer"
-;	 "unwind-protect" "condition-case" "track-mouse" "dont-compile"
-;	 "eval-after-load" "eval-and-compile" "eval-when-compile"
-;	 "when" "unless" "do" "flet" "labels" "return" "return-from"
-;	 "with-output-to-temp-buffer" "with-timeout" "with-current-buffer"
-;	 "with-temp-buffer" "with-temp-file"))
-      (cons (concat "(\\("
-		    "c\\(atch\\|ond\\(\\|ition-case\\)\\)\\|"
-		    "do\\(\\|nt-compile\\)\\|"
-		    "eval-\\(a\\(fter-load\\|nd-compile\\)\\|"
-		    "when-compile\\)\\|flet\\|i\\(f\\|nline\\)\\|"
-		    "l\\(abels\\|et\\*?\\)\\|prog[nv12*]?\\|"
-		    "return\\(\\|-from\\)\\|"
-		    "save-\\(current-buffer\\|excursion\\|match-data\\|"
-		    "restriction\\|selected-window\\|window-excursion\\)\\|"
-		    "t\\(hrow\\|rack-mouse\\)\\|un\\(less\\|wind-protect\\)\\|"
-		    "w\\(h\\(en\\|ile\\)\\|ith-\\(current-buffer\\|"
-		    "output-to-temp-buffer\\|"
-		    "t\\(emp-\\(buffer\\|file\\)\\|imeout\\)\\)\\)"
-		    "\\)\\>")
-	    1)
-      ;;
-      ;; Feature symbols as references.
-      '("(\\(featurep\\|provide\\|require\\)\\>[ \t']*\\(\\sw+\\)?"
-	(1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
-      ;;
-      ;; Words inside \\[] tend to be for `substitute-command-keys'.
-      '("\\\\\\\\\\[\\(\\sw+\\)]" 1 font-lock-reference-face prepend)
-      ;;
-      ;; Words inside `' tend to be symbol names.
-      '("`\\(\\sw\\sw+\\)'" 1 font-lock-reference-face prepend)
-      ;;
-      ;; CLisp `:' keywords as builtins.
-      '("\\<:\\sw\\sw+\\>" 0 font-lock-builtin-face)
-      ;;
-      ;; ELisp and CLisp `&' keywords as types.
-      '("\\<\\&\\sw+\\>" . font-lock-type-face)
-      )))
-  "Gaudy level highlighting for Lisp modes.")
-
-
-(defvar lisp-font-lock-keywords lisp-font-lock-keywords-1
-  "Default expressions to highlight in Lisp modes.")
-
-
-(defvar scheme-font-lock-keywords
-  (eval-when-compile
-    (list
-     ;;
-     ;; Declarations.  Hannes Haug <hannes.haug@student.uni-tuebingen.de> says
-     ;; this works for SOS, STklos, SCOOPS, Meroon and Tiny CLOS.
-     (list (concat "(\\(define\\("
-		   ;; Function names.
-		   "\\(\\|-\\(generic\\(\\|-procedure\\)\\|method\\)\\)\\|"
-		   ;; Macro names, as variable names.  A bit dubious, this.
-		   "\\(-syntax\\)\\|"
-		   ;; Class names.
-		   "-class"
-		   "\\)\\)\\>"
-		   ;; Any whitespace and declared object.
-		   "[ \t]*(?"
-		   "\\(\\sw+\\)?")
-	   '(1 font-lock-keyword-face)
-	   '(7 (cond ((match-beginning 3) font-lock-function-name-face)
-		     ((match-beginning 6) font-lock-variable-name-face)
-		     (t font-lock-type-face))
-	       nil t))
-     ;;
-     ;; Control structures.
-;(make-regexp '("begin" "call-with-current-continuation" "call/cc"
-;	       "call-with-input-file" "call-with-output-file" "case" "cond"
-;	       "do" "else" "for-each" "if" "lambda"
-;	       "let\\*?" "let-syntax" "letrec" "letrec-syntax"
-;	       ;; Hannes Haug <hannes.haug@student.uni-tuebingen.de> wants:
-;	       "and" "or" "delay"
-;	       ;; Stefan Monnier <stefan.monnier@epfl.ch> says don't bother:
-;	       ;;"quasiquote" "quote" "unquote" "unquote-splicing"
-;	       "map" "syntax" "syntax-rules"))
-     (cons
-      (concat "(\\("
-	      "and\\|begin\\|c\\(a\\(ll\\(-with-\\(current-continuation\\|"
-	      "input-file\\|output-file\\)\\|/cc\\)\\|se\\)\\|ond\\)\\|"
-	      "d\\(elay\\|o\\)\\|else\\|for-each\\|if\\|"
-	      "l\\(ambda\\|et\\(-syntax\\|\\*?\\|rec\\(\\|-syntax\\)\\)\\)\\|"
-	      "map\\|or\\|syntax\\(\\|-rules\\)"
-	      "\\)\\>") 1)
-     ;;
-     ;; David Fox <fox@graphics.cs.nyu.edu> for SOS/STklos class specifiers.
-     '("\\<<\\sw+>\\>" . font-lock-type-face)
-     ;;
-     ;; Scheme `:' keywords as references.
-     '("\\<:\\sw+\\>" . font-lock-reference-face)
-     ))
-  "Default expressions to highlight in Scheme modes.")
-
-
-(defvar tex-font-lock-keywords
-;  ;; Regexps updated with help from Ulrik Dickow <dickow@nbi.dk>.
-;  '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}"
-;     2 font-lock-function-name-face)
-;    ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \t\n]+\\)}"
-;     2 font-lock-reference-face)
-;    ;; It seems a bit dubious to use `bold' and `italic' faces since we might
-;    ;; not be able to display those fonts.
-;    ("{\\\\bf\\([^}]+\\)}" 1 'bold keep)
-;    ("{\\\\\\(em\\|it\\|sl\\)\\([^}]+\\)}" 2 'italic keep)
-;    ("\\\\\\([a-zA-Z@]+\\|.\\)" . font-lock-keyword-face)
-;    ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" 1 font-lock-function-name-face keep))
-  ;; Rewritten and extended for LaTeX2e by Ulrik Dickow <dickow@nbi.dk>.
-  '(("\\\\\\(begin\\|end\\|newcommand\\){\\([a-zA-Z0-9\\*]+\\)}"
-     2 font-lock-function-name-face)
-    ("\\\\\\(cite\\|label\\|pageref\\|ref\\){\\([^} \t\n]+\\)}"
-     2 font-lock-reference-face)
-    ("^[ \t]*\\\\def\\\\\\(\\(\\w\\|@\\)+\\)" 1 font-lock-function-name-face)
-    "\\\\\\([a-zA-Z@]+\\|.\\)"
-    ;; It seems a bit dubious to use `bold' and `italic' faces since we might
-    ;; not be able to display those fonts.
-    ;; LaTeX2e: \emph{This is emphasized}.
-    ("\\\\emph{\\([^}]+\\)}" 1 'italic keep)
-    ;; LaTeX2e: \textbf{This is bold}, \textit{...}, \textsl{...}
-    ("\\\\text\\(\\(bf\\)\\|it\\|sl\\){\\([^}]+\\)}"
-     3 (if (match-beginning 2) 'bold 'italic) keep)
-    ;; Old-style bf/em/it/sl. Stop at `\\' and un-escaped `&', for good tables.
-    ("\\\\\\(\\(bf\\)\\|em\\|it\\|sl\\)\\>\\(\\([^}&\\]\\|\\\\[^\\]\\)+\\)"
-     3 (if (match-beginning 2) 'bold 'italic) keep))
-  "Default expressions to highlight in TeX modes.")
-
-;;; User choices.
-
-;; These provide a means to fontify types not defined by the language.  Those
-;; types might be the user's own or they might be generally accepted and used.
-;; Generally excepted types are used to provide default variable values.
-
-(defvar c-font-lock-extra-types '("FILE" "\\sw+_t")
-  "*List of extra types to fontify in C mode.
-Each list item should be a regexp without word-delimiters or parentheses.
-For example, a value of (\"FILE\" \"\\\\sw+_t\") means the word FILE and words
-ending in _t are treated as type names.")
-
-(defvar c++-font-lock-extra-types nil
-  "*List of extra types to fontify in C++ mode.
-Each list item should be a regexp without word-delimiters or parentheses.
-For example, a value of (\"String\") means the word String is treated as a type
-name.")
-
-(defvar objc-font-lock-extra-types '("Class" "BOOL" "IMP" "SEL")
-  "*List of extra types to fontify in Objective-C mode.
-Each list item should be a regexp without word-delimiters or parentheses.
-For example, a value of (\"Class\" \"BOOL\" \"IMP\" \"SEL\") means the words
-Class, BOOL, IMP and SEL are treated as type names.")
-
-(defvar java-font-lock-extra-types '("[A-Z\300-\326\330-\337]\\sw+")
-  "*List of extra types to fontify in Java mode.
-Each list item should be a regexp without word-delimiters or parentheses.
-For example, a value of (\"[A-Z\300-\326\330-\337]\\\\sw+\") means capitalised
-words (and words conforming to the Java id spec) are treated as type names.")
-
-;;; C.
-
-;; [Murmur murmur murmur] Maestro, drum-roll please...  [Murmur murmur murmur.]
-;; Ahem.  [Murmur murmur murmur] Lay-dees an Gennel-men.  [Murmur murmur shhh!]
-;; I am most proud and humbly honoured today [murmur murmur cough] to present
-;; to you good people, the winner of the Second Millennium Award for The Most
-;; Hairy Language Syntax.  [Ahhh!]  All rise please.  [Shuffle shuffle
-;; shuffle.]  And a round of applause please.  For...  The C Language!  [Roar.]
-;;
-;; Thank you...  You are too kind...  It is with a feeling of great privilege
-;; and indeed emotion [sob] that I accept this award.  It has been a long hard
-;; road.  But we know our destiny.  And our future.  For we must not rest.
-;; There are more tokens to overload, more shoehorn, more methodologies.  But
-;; more is a plus!  [Ha ha ha.]  And more means plus!  [Ho ho ho.]  The future
-;; is C++!  [Ohhh!]  The Third Millennium Award will be ours!  [Roar.]
-
-(defconst c-font-lock-keywords-1 nil
-  "Subdued level highlighting for C mode.")
-
-(defconst c-font-lock-keywords-2 nil
-  "Medium level highlighting for C mode.
-See also `c-font-lock-extra-types'.")
-
-(defconst c-font-lock-keywords-3 nil
-  "Gaudy level highlighting for C mode.
-See also `c-font-lock-extra-types'.")
-
-(let ((c-keywords
-;      ("break" "continue" "do" "else" "for" "if" "return" "switch" "while")
-       "break\\|continue\\|do\\|else\\|for\\|if\\|return\\|switch\\|while")
-      (c-type-types
-;      ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum"
-;	"signed" "unsigned" "short" "long" "int" "char" "float" "double"
-;	"void" "volatile" "const")
-       `(mapconcat 'identity
-	 (cons 
-	  (,@ (concat "auto\\|c\\(har\\|onst\\)\\|double\\|"	; 6 ()s deep.
-		      "e\\(num\\|xtern\\)\\|float\\|int\\|long\\|register\\|"
-		      "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|typedef\\|"
-		      "un\\(ion\\|signed\\)\\|vo\\(id\\|latile\\)"))
-	  c-font-lock-extra-types)
-	 "\\|"))
-      )
- (setq c-font-lock-keywords-1
-  (list
-   ;;
-   ;; These are all anchored at the beginning of line for speed.
-   ;; Note that `c++-font-lock-keywords-1' depends on `c-font-lock-keywords-1'.
-   ;;
-   ;; Fontify function name definitions (GNU style; without type on line).
-   '("^\\(\\sw+\\)[ \t]*(" 1 font-lock-function-name-face)
-   ;;
-   ;; Fontify error directives.
-   '("^#[ \t]*error[ \t]+\\(.+\\)" 1 font-lock-warning-face prepend)
-   ;;
-   ;; Fontify filenames in #include <...> preprocessor directives as strings.
-   '("^#[ \t]*\\(import\\|include\\)[ \t]+\\(<[^>\"\n]*>?\\)"
-     2 font-lock-string-face)
-   ;;
-   ;; Fontify function macro names.
-   '("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face)
-   ;;
-   ;; Fontify symbol names in #elif or #if ... defined preprocessor directives.
-   '("^#[ \t]*\\(elif\\|if\\)\\>"
-     ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil
-      (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t)))
-   ;;
-   ;; Fontify otherwise as symbol names, and the preprocessor directive names.
-   '("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t))
-   ))
-
- (setq c-font-lock-keywords-2
-  (append c-font-lock-keywords-1
-   (list
-    ;;
-    ;; Simple regexps for speed.
-    ;;
-    ;; Fontify all type specifiers.
-    `(eval .
-      (cons (concat "\\<\\(" (,@ c-type-types) "\\)\\>") 'font-lock-type-face))
-    ;;
-    ;; Fontify all builtin keywords (except case, default and goto; see below).
-    (concat "\\<\\(" c-keywords "\\)\\>")
-    ;;
-    ;; Fontify case/goto keywords and targets, and case default/goto tags.
-    '("\\<\\(case\\|goto\\)\\>[ \t]*\\(\\sw+\\)?"
-      (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
-    ;; Anders Lindgren <andersl@csd.uu.se> points out that it is quicker to use
-    ;; MATCH-ANCHORED to effectively anchor the regexp on the left.
-    '(":" ("^[ \t]*\\(\\sw+\\)[ \t]*:"
-	   (beginning-of-line) (end-of-line)
-	   (1 font-lock-reference-face)))
-    )))
-
- (setq c-font-lock-keywords-3
-  (append c-font-lock-keywords-2
-   ;;
-   ;; More complicated regexps for more complete highlighting for types.
-   ;; We still have to fontify type specifiers individually, as C is so hairy.
-   (list
-    ;;
-    ;; Fontify all storage classes and type specifiers, plus their items.
-    `(eval .
-      (list (concat "\\<\\(" (,@ c-type-types) "\\)\\>"
-		    "\\([ \t*&]+\\sw+\\>\\)*")
-	    ;; Fontify each declaration item.
-	    '(font-lock-match-c-style-declaration-item-and-skip-to-next
-	      ;; Start with point after all type specifiers.
-	      (goto-char (or (match-beginning 8) (match-end 1)))
-	      ;; Finish with point after first type specifier.
-	      (goto-char (match-end 1))
-	      ;; Fontify as a variable or function name.
-	      (1 (if (match-beginning 2)
-		     font-lock-function-name-face
-		   font-lock-variable-name-face)))))
-    ;;
-    ;; Fontify structures, or typedef names, plus their items.
-    '("\\(}\\)[ \t*]*\\sw"
-      (font-lock-match-c-style-declaration-item-and-skip-to-next
-       (goto-char (match-end 1)) nil
-       (1 (if (match-beginning 2)
-	      font-lock-function-name-face
-	    font-lock-variable-name-face))))
-    ;;
-    ;; Fontify anything at beginning of line as a declaration or definition.
-    '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*"
-      (1 font-lock-type-face)
-      (font-lock-match-c-style-declaration-item-and-skip-to-next
-       (goto-char (or (match-beginning 2) (match-end 1))) nil
-       (1 (if (match-beginning 2)
-	      font-lock-function-name-face
-	    font-lock-variable-name-face))))
-    )))
- )
-
-(defvar c-font-lock-keywords c-font-lock-keywords-1
-  "Default expressions to highlight in C mode.
-See also `c-font-lock-extra-types'.")
-
-;;; C++.
-
-(defconst c++-font-lock-keywords-1 nil
-  "Subdued level highlighting for C++ mode.")
-
-(defconst c++-font-lock-keywords-2 nil
-  "Medium level highlighting for C++ mode.
-See also `c++-font-lock-extra-types'.")
-
-(defconst c++-font-lock-keywords-3 nil
-  "Gaudy level highlighting for C++ mode.
-See also `c++-font-lock-extra-types'.")
-
-(defun font-lock-match-c++-style-declaration-item-and-skip-to-next (limit)
-  ;; Regexp matches after point:		word<word>::word (
-  ;;						^^^^ ^^^^   ^^^^ ^
-  ;; Where the match subexpressions are:	  1    3      5  6
-  ;;
-  ;; Item is delimited by (match-beginning 1) and (match-end 1).
-  ;; If (match-beginning 3) is non-nil, that part of the item incloses a `<>'.
-  ;; If (match-beginning 5) is non-nil, that part of the item follows a `::'.
-  ;; If (match-beginning 6) is non-nil, the item is followed by a `('.
-  (when (looking-at (eval-when-compile
-		      (concat "[ \t*&]*\\(\\sw+\\)"
-			      "\\(<\\(\\sw+\\)[ \t*&]*>\\)?"
-			      "\\(::\\**\\(\\sw+\\)\\)?"
-			      "[ \t]*\\((\\)?")))
-    (save-match-data
-      (condition-case nil
-	  (save-restriction
-	    ;; Restrict to the end of line, currently guaranteed to be LIMIT.
-	    (narrow-to-region (point-min) limit)
-	    (goto-char (match-end 1))
-	    ;; Move over any item value, etc., to the next item.
-	    (while (not (looking-at "[ \t]*\\(\\(,\\)\\|;\\|$\\)"))
-	      (goto-char (or (scan-sexps (point) 1) (point-max))))
-	    (goto-char (match-end 2)))
-	(error t)))))
-
-(let* ((c++-keywords
-;      ("break" "continue" "do" "else" "for" "if" "return" "switch" "while"
-;       "asm" "catch" "delete" "new" "operator" "sizeof" "this" "throw" "try"
-;       ;; Eric Hopper <hopper@omnifarious.mn.org> says these are new.
-;       "static_cast" "dynamic_cast" "const_cast" "reinterpret_cast")
-	(concat "asm\\|break\\|c\\(atch\\|on\\(st_cast\\|tinue\\)\\)\\|"
-		"d\\(elete\\|o\\|ynamic_cast\\)\\|else\\|for\\|if\\|new\\|"
-		"operator\\|re\\(interpret_cast\\|turn\\)\\|"
-		"s\\(izeof\\|tatic_cast\\|"
-		"witch\\)\\|t\\(h\\(is\\|row\\)\\|ry\\)\\|while"))
-       (c++-operators
-	(mapconcat 'identity
-	 (mapcar 'regexp-quote
-		 ;; Taken from Stroustrup, minus keywords otherwise fontified.
-		 (sort '("+" "-" "*" "/" "%" "^" "&" "|" "~" "!" "=" "<" ">"
-			 "+=" "-=" "*=" "/=" "%=" "^=" "&=" "|=" "<<" ">>"
-			 ">>=" "<<=" "==" "!=" "<=" ">=" "&&" "||" "++" "--"
-			 "->*" "," "->" "[]" "()")
-		       (function (lambda (a b) (> (length a) (length b))))))
-	 "\\|"))
-       (c++-type-types
-;      ("auto" "extern" "register" "static" "typedef" "struct" "union" "enum"
-;       "signed" "unsigned" "short" "long" "int" "char" "float" "double"
-;       "void" "volatile" "const" "inline" "friend" "bool"
-;       "virtual" "complex" "template"
-;       ;; Eric Hopper <hopper@omnifarious.mn.org> says these are new.
-;       "namespace" "using")
-	`(mapconcat 'identity
-	  (cons 
-	   (,@ (concat "auto\\|bool\\|c\\(har\\|o\\(mplex\\|nst\\)\\)\\|"
-		       "double\\|e\\(num\\|xtern\\)\\|f\\(loat\\|riend\\)\\|"
-		       "in\\(line\\|t\\)\\|long\\|namespace\\|register\\|"
-		       "s\\(hort\\|igned\\|t\\(atic\\|ruct\\)\\)\\|"
-		       "t\\(emplate\\|ypedef\\)\\|"
-		       "u\\(n\\(ion\\|signed\\)\\|sing\\)\\|"
-		       "v\\(irtual\\|o\\(id\\|latile\\)\\)"))	; 12 ()s deep.
-	   c++-font-lock-extra-types)
-	  "\\|"))
-       (c++-type-suffix "\\(<\\(\\sw+\\)[ \t*&]*>\\)?\\(::\\**\\(\\sw+\\)\\)?")
-       (c++-type-spec (concat "\\(\\sw+\\)\\>" c++-type-suffix))
-      )
- (setq c++-font-lock-keywords-1
-  (append
-   ;;
-   ;; The list `c-font-lock-keywords-1' less that for function names.
-   (cdr c-font-lock-keywords-1)
-   (list
-    ;;
-    ;; Class names etc.
-    (list (concat "\\<\\(class\\|public\\|private\\|protected\\)\\>[ \t]*"
-		  "\\(" c++-type-spec "\\)?")
-	  '(1 font-lock-type-face)
-	  '(3 (if (match-beginning 6)
-		  font-lock-type-face
-		font-lock-function-name-face) nil t)
-	  '(5 font-lock-function-name-face nil t)
-	  '(7 font-lock-function-name-face nil t))
-    ;;
-    ;; Fontify function name definitions, possibly incorporating class names.
-    (list (concat "^" c++-type-spec "[ \t]*(")
-	  '(1 (if (or (match-beginning 2) (match-beginning 4))
-		  font-lock-type-face
-		font-lock-function-name-face))
-	  '(3 font-lock-function-name-face nil t)
-	  '(5 font-lock-function-name-face nil t))
-    )))
-
- (setq c++-font-lock-keywords-2
-  (append c++-font-lock-keywords-1
-   (list
-    ;;
-    ;; The list `c-font-lock-keywords-2' for C++ plus operator overloading.
-    `(eval .
-      (cons (concat "\\<\\(" (,@ c++-type-types) "\\)\\>")
-	    'font-lock-type-face))
-    ;;
-    ;; Fontify operator overloading.
-    (list (concat "\\<\\(operator\\)\\>[ \t]*\\(" c++-operators "\\)?")
-	  '(1 font-lock-keyword-face)
-	  '(2 font-lock-builtin-face nil t))
-    ;;
-    ;; Fontify case/goto keywords and targets, and case default/goto tags.
-    '("\\<\\(case\\|goto\\)\\>[ \t]*\\(\\sw+\\)?"
-      (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
-    '(":" ("^[ \t]*\\(\\sw+\\)[ \t]*:\\($\\|[^:]\\)"
-	   (beginning-of-line) (end-of-line)
-	   (1 font-lock-reference-face)))
-    ;;
-    ;; Fontify other builtin keywords.
-    (cons (concat "\\<\\(" c++-keywords "\\)\\>") 'font-lock-keyword-face)
-    ;;
-    ;; Eric Hopper <hopper@omnifarious.mn.org> says `true' and `false' are new.
-    '("\\<\\(false\\|true\\)\\>" . font-lock-reference-face)
-    )))
-
- (setq c++-font-lock-keywords-3
-  (append c++-font-lock-keywords-2
-   ;;
-   ;; More complicated regexps for more complete highlighting for types.
-   (list
-    ;;
-    ;; Fontify all storage classes and type specifiers, plus their items.
-    `(eval .
-      (list (concat "\\<\\(" (,@ c++-type-types) "\\)\\>" (,@ c++-type-suffix)
-		    "\\([ \t*&]+" (,@ c++-type-spec) "\\)*")
-	    ;; Fontify each declaration item.
-	    '(font-lock-match-c++-style-declaration-item-and-skip-to-next
-	      ;; Start with point after all type specifiers.
-	      (goto-char (or (match-beginning 18) (match-end 1)))
-	      ;; Finish with point after first type specifier.
-	      (goto-char (match-end 1))
-	      ;; Fontify as a variable or function name.
-	      (1 (cond ((or (match-beginning 2) (match-beginning 4))
-			font-lock-type-face)
-		       ((match-beginning 6) font-lock-function-name-face)
-		       (t font-lock-variable-name-face)))
-	      (3 font-lock-function-name-face nil t)
-	      (5 (if (match-beginning 6)
-		     font-lock-function-name-face
-		   font-lock-variable-name-face) nil t))))
-    ;;
-    ;; Fontify structures, or typedef names, plus their items.
-    '("\\(}\\)[ \t*]*\\sw"
-      (font-lock-match-c++-style-declaration-item-and-skip-to-next
-       (goto-char (match-end 1)) nil
-       (1 (if (match-beginning 6)
-	      font-lock-function-name-face
-	    font-lock-variable-name-face))))
-    ;;
-    ;; Fontify anything at beginning of line as a declaration or definition.
-    (list (concat "^\\(" c++-type-spec "[ \t*&]*\\)+")
-	  '(font-lock-match-c++-style-declaration-item-and-skip-to-next
-	    (goto-char (match-beginning 1))
-	    (goto-char (match-end 1))
-	    (1 (cond ((or (match-beginning 2) (match-beginning 4))
-		      font-lock-type-face)
-		     ((match-beginning 6) font-lock-function-name-face)
-		     (t font-lock-variable-name-face)))
-	    (3 font-lock-function-name-face nil t)
-	    (5 (if (match-beginning 6)
-		   font-lock-function-name-face
-		 font-lock-variable-name-face) nil t)))
-    )))
- )
-
-(defvar c++-font-lock-keywords c++-font-lock-keywords-1
-  "Default expressions to highlight in C++ mode.
-See also `c++-font-lock-extra-types'.")
-
-;;; Objective-C.
-
-(defconst objc-font-lock-keywords-1 nil
-  "Subdued level highlighting for Objective-C mode.")
-
-(defconst objc-font-lock-keywords-2 nil
-  "Medium level highlighting for Objective-C mode.
-See also `objc-font-lock-extra-types'.")
-
-(defconst objc-font-lock-keywords-3 nil
-  "Gaudy level highlighting for Objective-C mode.
-See also `objc-font-lock-extra-types'.")
-
-;; Regexps written with help from Stephen Peters <speters@us.oracle.com> and
-;; Jacques Duthen Prestataire <duthen@cegelec-red.fr>.
-(let ((objc-keywords
-;       (make-regexp
-;	'("break" "continue" "do" "else" "for" "if" "return" "switch" "while"
-;	  "sizeof" "self" "super"))
-       (concat "break\\|continue\\|do\\|else\\|for\\|if\\|return\\|"
-	       "s\\(elf\\|izeof\\|uper\\|witch\\)\\|while"))
-      (objc-type-types
-       `(mapconcat 'identity
-	 (cons
-;	 '("auto" "extern" "register" "static" "typedef" "struct" "union"
-;	   "enum" "signed" "unsigned" "short" "long" "int" "char"
-;	   "float" "double" "void" "volatile" "const"
-;	   "id" "oneway" "in" "out" "inout" "bycopy" "byref")
-	  (,@ (concat "auto\\|by\\(copy\\|ref\\)\\|c\\(har\\|onst\\)\\|"
-		      "double\\|e\\(num\\|xtern\\)\\|float\\|"
-		      "i\\([dn]\\|n\\(out\\|t\\)\\)\\|long\\|"
-		      "o\\(neway\\|ut\\)\\|register\\|s\\(hort\\|igned\\|"
-		      "t\\(atic\\|ruct\\)\\)\\|typedef\\|"
-		      "un\\(ion\\|signed\\)\\|vo\\(id\\|latile\\)"))
-	  objc-font-lock-extra-types)
-	 "\\|"))
-      )
- (setq objc-font-lock-keywords-1
-  (append
-   ;;
-   ;; The list `c-font-lock-keywords-1' less that for function names.
-   (cdr c-font-lock-keywords-1)
-   (list
-    ;;
-    ;; Fontify compiler directives.
-    '("@\\(\\sw+\\)\\>"
-      (1 font-lock-keyword-face)
-      ("\\=[ \t:<(,]*\\(\\sw+\\)" nil nil
-       (1 font-lock-function-name-face)))
-    ;;
-    ;; Fontify method names and arguments.  Oh Lordy!
-    ;; First, on the same line as the function declaration.
-    '("^[+-][ \t]*\\(PRIVATE\\)?[ \t]*\\((\\([^)\n]+\\))\\)?[ \t]*\\(\\sw+\\)"
-      (1 font-lock-type-face nil t)
-      (3 font-lock-type-face nil t)
-      (4 font-lock-function-name-face)
-      ("\\=[ \t]*\\(\\sw+\\)?:[ \t]*\\((\\([^)\n]+\\))\\)?[ \t]*\\(\\sw+\\)"
-       nil nil
-       (1 font-lock-function-name-face nil t)
-       (3 font-lock-type-face nil t)
-       (4 font-lock-variable-name-face)))
-    ;; Second, on lines following the function declaration.
-    '(":" ("^[ \t]*\\(\\sw+\\)?:[ \t]*\\((\\([^)\n]+\\))\\)?[ \t]*\\(\\sw+\\)"
-	   (beginning-of-line) (end-of-line)
-	   (1 font-lock-function-name-face nil t)
-	   (3 font-lock-type-face nil t)
-	   (4 font-lock-variable-name-face)))
-    )))
-
- (setq objc-font-lock-keywords-2
-  (append objc-font-lock-keywords-1
-   (list
-    ;;
-    ;; Simple regexps for speed.
-    ;;
-    ;; Fontify all type specifiers.
-    `(eval .
-      (cons (concat "\\<\\(" (,@ objc-type-types) "\\)\\>")
-	    'font-lock-type-face))
-    ;;
-    ;; Fontify all builtin keywords (except case, default and goto; see below).
-    (concat "\\<\\(" objc-keywords "\\)\\>")
-    ;;
-    ;; Fontify case/goto keywords and targets, and case default/goto tags.
-    '("\\<\\(case\\|goto\\)\\>[ \t]*\\(\\sw+\\)?"
-      (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
-    ;; Fontify tags iff sole statement on line, otherwise we detect selectors.
-    '(":" ("^[ \t]*\\(\\sw+\\)[ \t]*:[ \t]*$"
-	   (beginning-of-line) (end-of-line)
-	   (1 font-lock-reference-face)))
-    ;;
-    ;; Fontify null object pointers.
-    '("\\<\\(Nil\\|nil\\)\\>" 1 font-lock-reference-face)
-    )))
-
- (setq objc-font-lock-keywords-3
-  (append objc-font-lock-keywords-2
-   ;;
-   ;; More complicated regexps for more complete highlighting for types.
-   ;; We still have to fontify type specifiers individually, as C is so hairy.
-   (list
-    ;;
-    ;; Fontify all storage classes and type specifiers, plus their items.
-    `(eval .
-      (list (concat "\\<\\(" (,@ objc-type-types) "\\)\\>"
-		    "\\([ \t*&]+\\sw+\\>\\)*")
-	    ;; Fontify each declaration item.
-	    '(font-lock-match-c-style-declaration-item-and-skip-to-next
-	      ;; Start with point after all type specifiers.
-	      (goto-char (or (match-beginning 2) (match-end 1)))
-	      ;; Finish with point after first type specifier.
-	      (goto-char (match-end 1))
-	      ;; Fontify as a variable or function name.
-	      (1 (if (match-beginning 2)
-		     font-lock-function-name-face
-		   font-lock-variable-name-face)))))
-    ;;
-    ;; Fontify structures, or typedef names, plus their items.
-    '("\\(}\\)[ \t*]*\\sw"
-      (font-lock-match-c-style-declaration-item-and-skip-to-next
-       (goto-char (match-end 1)) nil
-       (1 (if (match-beginning 2)
-	      font-lock-function-name-face
-	    font-lock-variable-name-face))))
-    ;;
-    ;; Fontify anything at beginning of line as a declaration or definition.
-    '("^\\(\\sw+\\)\\>\\([ \t*]+\\sw+\\>\\)*"
-      (1 font-lock-type-face)
-      (font-lock-match-c-style-declaration-item-and-skip-to-next
-       (goto-char (or (match-beginning 2) (match-end 1))) nil
-       (1 (if (match-beginning 2)
-	      font-lock-function-name-face
-	    font-lock-variable-name-face))))
-    )))
- )
-
-(defvar objc-font-lock-keywords objc-font-lock-keywords-1
-  "Default expressions to highlight in Objective-C mode.
-See also `objc-font-lock-extra-types'.")
-
-;;; Java.
-
-(defconst java-font-lock-keywords-1 nil
-  "Subdued level highlighting for Java mode.")
-
-(defconst java-font-lock-keywords-2 nil
-  "Medium level highlighting for Java mode.
-See also `java-font-lock-extra-types'.")
-
-(defconst java-font-lock-keywords-3 nil
-  "Gaudy level highlighting for Java mode.
-See also `java-font-lock-extra-types'.")
-
-;; Regexps written with help from Fred White <fwhite@bbn.com> and
-;; Anders Lindgren <andersl@csd.uu.se>.
-(let ((java-keywords
-       (concat "\\<\\("
-;	       (make-regexp
-;		'("catch" "do" "else" "super" "this" "finally" "for" "if"
-;;		  ;; Anders Lindgren <andersl@csd.uu.se> says these have gone.
-;;		  "cast" "byvalue" "future" "generic" "operator" "var"
-;;		  "inner" "outer" "rest"
-;		  "interface" "return" "switch" "throw" "try" "while")
-	       "catch\\|do\\|else\\|f\\(inally\\|or\\)\\|"
-	       "i\\(f\\|nterface\\)\\|return\\|s\\(uper\\|witch\\)\\|"
-	       "t\\(h\\(is\\|row\\)\\|ry\\)\\|while"
-	       "\\)\\>"))
-      ;;
-      ;; These are immediately followed by an object name.
-      (java-minor-types
-       (mapconcat 'identity
-	'("boolean" "char" "byte" "short" "int" "long" "float" "double" "void")
-	"\\|"))
-      ;;
-      ;; These are eventually followed by an object name.
-      (java-major-types
-;       (make-regexp
-;	'("abstract" "const" "final" "synchronized" "transient" "static"
-;;	  ;; Anders Lindgren <andersl@csd.uu.se> says this has gone.
-;;	  "threadsafe"
-;	  "volatile" "public" "private" "protected" "native")
-       (concat "abstract\\|const\\|final\\|native\\|"
-	       "p\\(r\\(ivate\\|otected\\)\\|ublic\\)\\|"
-	       "s\\(tatic\\|ynchronized\\)\\|transient\\|volatile"))
-      ;;
-      ;; Random types immediately followed by an object name.
-      (java-other-types
-       '(mapconcat 'identity (cons "\\sw+\\.\\sw+" java-font-lock-extra-types)
-		   "\\|"))
-      )
- (setq java-font-lock-keywords-1
-  (list
-   ;;
-   ;; Fontify class names.
-   '("\\<\\(class\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-type-face) (2 font-lock-function-name-face nil t))
-   ;;
-   ;; Fontify package names in import directives.
-   '("\\<\\(import\\|package\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
-   ))
-
- (setq java-font-lock-keywords-2
-  (append java-font-lock-keywords-1
-   (list
-    ;;
-    ;; Fontify all builtin type specifiers.
-    (cons (concat "\\<\\(" java-minor-types "\\|" java-major-types "\\)\\>")
-	  'font-lock-type-face)
-    ;;
-    ;; Fontify all builtin keywords (except below).
-    (concat "\\<\\(" java-keywords "\\)\\>")
-    ;;
-    ;; Fontify keywords and targets, and case default/goto tags.
-    (list "\\<\\(break\\|case\\|continue\\|goto\\)\\>[ \t]*\\(\\sw+\\)?"
-	  '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
-    '(":" ("^[ \t]*\\(\\sw+\\)[ \t]*:"
-	   (beginning-of-line) (end-of-line)
-	   (1 font-lock-reference-face)))
-    ;;
-    ;; Fontify keywords and types; the first can be followed by a type list.
-    (list (concat "\\<\\("
-		  "implements\\|throws\\|"
-		  "\\(extends\\|instanceof\\|new\\)"
-		  "\\)\\>[ \t]*\\(\\sw+\\)?")
-	  '(1 font-lock-keyword-face) '(3 font-lock-type-face nil t)
-	  '("\\=[ \t]*,[ \t]*\\(\\sw+\\)"
-	    (if (match-beginning 2) (goto-char (match-end 2))) nil
-	    (1 font-lock-type-face)))
-    ;;
-    ;; Fontify all constants.
-    '("\\<\\(false\\|null\\|true\\)\\>" . font-lock-reference-face)
-    ;;
-    ;; Javadoc tags within comments.
-    '("@\\(author\\|exception\\|return\\|see\\|version\\)\\>"
-      (1 font-lock-reference-face prepend))
-    '("@\\(param\\)\\>[ \t]*\\(\\sw+\\)?"
-      (1 font-lock-reference-face prepend)
-      (2 font-lock-variable-name-face prepend t))
-    )))
-
- (setq java-font-lock-keywords-3
-  (append java-font-lock-keywords-2
-   ;;
-   ;; More complicated regexps for more complete highlighting for types.
-   ;; We still have to fontify type specifiers individually, as Java is hairy.
-   (list
-    ;;
-    ;; Fontify random types in casts.
-    `(eval .
-      (list (concat "(\\(" (,@ java-other-types) "\\))"
-		    "[ \t]*\\(\\sw\\|[\"\(]\\)")
-	    ;; Fontify the type name.
-	    '(1 font-lock-type-face)))
-    ;;
-    ;; Fontify random types immediately followed by an item or items.
-    `(eval .
-      (list (concat "\\<\\(" (,@ java-other-types) "\\)\\>"
-		    "\\([ \t]*\\[[ \t]*\\]\\)*"
-		    "[ \t]*\\sw")
-	    ;; Fontify the type name.
-	    '(1 font-lock-type-face)))
-    `(eval .
-      (list (concat "\\<\\(" (,@ java-other-types) "\\)\\>"
-		    "\\([ \t]*\\[[ \t]*\\]\\)*"
-		    "\\([ \t]*\\sw\\)")
-	    ;; Fontify each declaration item.
-	    '(font-lock-match-c-style-declaration-item-and-skip-to-next
-	      ;; Start and finish with point after the type specifier.
-	      (goto-char (match-beginning 3)) (goto-char (match-beginning 3))
-	      ;; Fontify as a variable or function name.
-	      (1 (if (match-beginning 2)
-		     font-lock-function-name-face
-		   font-lock-variable-name-face)))))
-    ;;
-    ;; Fontify those that are immediately followed by an item or items.
-    (list (concat "\\<\\(" java-minor-types "\\)\\>"
-		  "\\([ \t]*\\[[ \t]*\\]\\)*")
-	  ;; Fontify each declaration item.
-	  '(font-lock-match-c-style-declaration-item-and-skip-to-next
-	    ;; Start and finish with point after the type specifier.
-	    nil (goto-char (match-end 0))
-	    ;; Fontify as a variable or function name.
-	    (1 (if (match-beginning 2)
-		   font-lock-function-name-face
-		 font-lock-variable-name-face))))
-    ;;
-    ;; Fontify those that are eventually followed by an item or items.
-    (list (concat "\\<\\(" java-major-types "\\)\\>"
-		  "\\([ \t]+\\sw+\\>"
-		  "\\([ \t]*\\[[ \t]*\\]\\)*"
-		  "\\)*")
-	  ;; Fontify each declaration item.
-	  '(font-lock-match-c-style-declaration-item-and-skip-to-next
-	    ;; Start with point after all type specifiers.
-	    (goto-char (or (match-beginning 2) (match-end 1)))
-	    ;; Finish with point after first type specifier.
-	    (goto-char (match-end 1))
-	    ;; Fontify as a variable or function name.
-	    (1 (if (match-beginning 2)
-		   font-lock-function-name-face
-		 font-lock-variable-name-face))))
-    )))
- )
-
-(defvar java-font-lock-keywords java-font-lock-keywords-1
-  "Default expressions to highlight in Java mode.
-See also `java-font-lock-extra-types'.")
-
-;; Install ourselves:
-
-(unless (assq 'font-lock-mode minor-mode-alist)
-  (push '(font-lock-mode " Font") minor-mode-alist))
-
-;; Provide ourselves:
-
-(provide 'font-lock)
-
-;;; font-lock.el ends here
diff --git a/lisp/format.el b/lisp/format.el
deleted file mode 100644
index 0b0910cef66..00000000000
--- a/lisp/format.el
+++ /dev/null
@@ -1,813 +0,0 @@
-;;; format.el --- read and save files in multiple formats
-
-;; Copyright (c) 1994, 1995 Free Software Foundation
-
-;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
-
-;; 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 defines a unified mechanism for saving & loading files stored
-;; in different formats.  `format-alist' contains information that directs
-;; Emacs to call an encoding or decoding function when reading or writing
-;; files that match certain conditions.  
-;;
-;; When a file is visited, its format is determined by matching the
-;; beginning of the file against regular expressions stored in
-;; `format-alist'.  If this fails, you can manually translate the buffer
-;; using `format-decode-buffer'.  In either case, the formats used are
-;; listed in the variable `buffer-file-format', and become the default
-;; format for saving the buffer.  To save a buffer in a different format,
-;; change this variable, or use `format-write-file'.
-;;
-;; Auto-save files are normally created in the same format as the visited
-;; file, but the variable `auto-save-file-format' can be set to a
-;; particularly fast or otherwise preferred format to be used for
-;; auto-saving (or nil to do no encoding on auto-save files, but then you
-;; risk losing any text-properties in the buffer).
-;;
-;; You can manually translate a buffer into or out of a particular format
-;; with the functions `format-encode-buffer' and `format-decode-buffer'.
-;; To translate just the region use the functions `format-encode-region'
-;; and `format-decode-region'.  
-;;
-;; You can define a new format by writing the encoding and decoding
-;; functions, and adding an entry to `format-alist'.  See enriched.el for
-;; an example of how to implement a file format.  There are various
-;; functions defined in this file that may be useful for writing the
-;; encoding and decoding functions:
-;;  * `format-annotate-region' and `format-deannotate-region' allow a
-;;     single alist of information to be used for encoding and decoding.
-;;     The alist defines a correspondence between strings in the file
-;;     ("annotations") and text-properties in the buffer.
-;;  * `format-replace-strings' is similarly useful for doing simple
-;;     string->string translations in a reversible manner.
-
-;;; Code:
-
-(put 'buffer-file-format 'permanent-local t)
-
-(defvar format-alist 
-  '((text/enriched "Extended MIME text/enriched format."
-		   "Content-[Tt]ype:[ \t]*text/enriched"
-		   enriched-decode enriched-encode t enriched-mode)
-    (plain "Standard ASCII format, no text properties."
-	   ;; Plain only exists so that there is an obvious neutral choice in
-	   ;; the completion list.
-	   nil nil nil nil nil))
-  "List of information about understood file formats.
-Elements are of the form \(NAME DOC-STR REGEXP FROM-FN TO-FN MODIFY MODE-FN).
-NAME    is a symbol, which is stored in `buffer-file-format'.
-DOC-STR should be a single line providing more information about the
-        format.  It is currently unused, but in the future will be shown to
-        the user if they ask for more information.
-REGEXP  is a regular expression to match against the beginning of the file;
-        it should match only files in that format.
-FROM-FN is called to decode files in that format; it gets two args, BEGIN 
-        and END, and can make any modifications it likes, returning the new
-        end.  It must make sure that the beginning of the file no longer
-        matches REGEXP, or else it will get called again.
-TO-FN   is called to encode a region into that format; it is passed three
-        arguments: BEGIN, END, and BUFFER.  BUFFER is the original buffer that
-        the data being written came from, which the function could use, for
-        example, to find the values of local variables.  TO-FN should either
-        return a list of annotations like `write-region-annotate-functions',
-        or modify the region and return the new end.
-MODIFY, if non-nil, means the TO-FN wants to modify the region.  If nil,
-        TO-FN will not make any changes but will instead return a list of
-        annotations. 
-MODE-FN, if specified, is called when visiting a file with that format.")
-
-;;; Basic Functions (called from Lisp)
-
-(defun format-annotate-function (format from to orig-buf)
-  "Returns annotations for writing region as FORMAT.
-FORMAT is a symbol naming one of the formats defined in `format-alist',
-it must be a single symbol, not a list like `buffer-file-format'.
-FROM and TO delimit the region to be operated on in the current buffer.
-ORIG-BUF is the original buffer that the data came from.
-This function works like a function on `write-region-annotate-functions':
-it either returns a list of annotations, or returns with a different buffer
-current, which contains the modified text to write.
-
-For most purposes, consider using `format-encode-region' instead."
-  ;; This function is called by write-region (actually build-annotations) 
-  ;; for each element of buffer-file-format.
-  (let* ((info (assq format format-alist))
-	 (to-fn  (nth 4 info))
-	 (modify (nth 5 info)))
-    (if to-fn
-	(if modify
-	    ;; To-function wants to modify region.  Copy to safe place.
-	    (let ((copy-buf (get-buffer-create " *Format Temp*")))
-	      (copy-to-buffer copy-buf from to)
-	      (set-buffer copy-buf)
-	      (format-insert-annotations write-region-annotations-so-far from)
-	      (funcall to-fn (point-min) (point-max) orig-buf)
-	      nil)
-	  ;; Otherwise just call function, it will return annotations.
-	  (funcall to-fn from to orig-buf)))))
-
-(defun format-decode (format length &optional visit-flag)
-  ;; This function is called by insert-file-contents whenever a file is read.
-  "Decode text from any known FORMAT.
-FORMAT is a symbol appearing in `format-alist' or a list of such symbols, 
-or nil, in which case this function tries to guess the format of the data by
-matching against the regular expressions in `format-alist'.  After a match is
-found and the region decoded, the alist is searched again from the beginning
-for another match.
-
-Second arg LENGTH is the number of characters following point to operate on.
-If optional third arg VISIT-FLAG is true, set `buffer-file-format'
-to the list of formats used, and call any mode functions defined for those
-formats.
-
-Returns the new length of the decoded region.
-
-For most purposes, consider using `format-decode-region' instead."
-  (let ((mod (buffer-modified-p))
-	(begin (point))
-	(end (+ (point) length)))
-    (if (null format)
-	;; Figure out which format it is in, remember list in `format'.
-	(let ((try format-alist))
-	  (while try
-	    (let* ((f (car try))
-		   (regexp (nth 2 f))
-		   (p (point)))
-	      (if (and regexp (looking-at regexp)
-		       (< (match-end 0) (+ begin length)))
-		  (progn
-		    (setq format (cons (car f) format))
-		    ;; Decode it
-		    (if (nth 3 f) (setq end (funcall (nth 3 f) begin end)))
-		    ;; Call visit function if required
-		    (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1))
-		    ;; Safeguard against either of the functions changing pt.
-		    (goto-char p)
-		    ;; Rewind list to look for another format
-		    (setq try format-alist))
-		(setq try (cdr try))))))
-      ;; Deal with given format(s)
-      (or (listp format) (setq format (list format)))
-      (let ((do format) f)
-	(while do
-	  (or (setq f (assq (car do) format-alist))
-	      (error "Unknown format" (car do)))
-	  ;; Decode:
-	  (if (nth 3 f) (setq end (funcall (nth 3 f) begin end)))
-	  ;; Call visit function if required
-	  (if (and visit-flag (nth 6 f)) (funcall (nth 6 f) 1))
-	  (setq do (cdr do)))))
-    (if visit-flag
-	(setq buffer-file-format format))
-    (set-buffer-modified-p mod)
-    ;; Return new length of region
-    (- end begin)))
-
-;;;
-;;; Interactive functions & entry points
-;;;
-
-(defun format-decode-buffer (&optional format)
-  "Translate the buffer from some FORMAT.
-If the format is not specified, this function attempts to guess.
-`buffer-file-format' is set to the format used, and any mode-functions 
-for the format are called."
-  (interactive
-   (list (format-read "Translate buffer from format (default: guess): ")))
-  (save-excursion
-    (goto-char (point-min))
-    (format-decode format (buffer-size) t)))
-
-(defun format-decode-region (from to &optional format)
-  "Decode the region from some format.
-Arg FORMAT is optional; if omitted the format will be determined by looking
-for identifying regular expressions at the beginning of the region."
-  (interactive
-   (list (region-beginning) (region-end) 
-	 (format-read "Translate region from format (default: guess): ")))
-  (save-excursion
-    (goto-char from)
-    (format-decode format (- to from) nil)))
-
-(defun format-encode-buffer (&optional format)
-  "Translate the buffer into FORMAT.
-FORMAT defaults to `buffer-file-format'.  It is a symbol naming one of the
-formats defined in `format-alist', or a list of such symbols."
-  (interactive
-   (list (format-read (format "Translate buffer to format (default %s): "
-			      buffer-file-format))))
-  (format-encode-region (point-min) (point-max) format))
-
-(defun format-encode-region (beg end &optional format)
- "Translate the region into some FORMAT.
-FORMAT defaults to `buffer-file-format', it is a symbol naming
-one of the formats defined in `format-alist', or a list of such symbols."
- (interactive
-  (list (region-beginning) (region-end)
-	(format-read (format "Translate region to format (default %s): "
-			     buffer-file-format))))
- (if (null format)    (setq format buffer-file-format))
- (if (symbolp format) (setq format (list format)))
- (save-excursion
-   (goto-char end)
-   (let ((cur-buf (current-buffer))
-	 (end (point-marker)))
-     (while format 
-       (let* ((info (assq (car format) format-alist))
-	      (to-fn  (nth 4 info))
-	      (modify (nth 5 info))
-	      result)
-	 (if to-fn
-	     (if modify
-		 (setq end (funcall to-fn beg end (current-buffer)))
-	       (format-insert-annotations 
-		(funcall to-fn beg end (current-buffer)))))
-	 (setq format (cdr format)))))))
-
-(defun format-write-file (filename format)
-  "Write current buffer into a FILE using some FORMAT.
-Makes buffer visit that file and sets the format as the default for future
-saves.  If the buffer is already visiting a file, you can specify a directory
-name as FILE, to write a file of the same old name in that directory."
-  (interactive
-   ;; Same interactive spec as write-file, plus format question.
-   (let* ((file (if buffer-file-name
-		    (read-file-name "Write file: "
-				    nil nil nil nil)
-		  (read-file-name "Write file: "
-				  (cdr (assq 'default-directory
-					     (buffer-local-variables)))
-				  nil nil (buffer-name))))
-	  (fmt (format-read (format "Write file `%s' in format: " 
-				    (file-name-nondirectory file)))))
-     (list file fmt)))
-  (setq buffer-file-format format)
-  (write-file filename))
-
-(defun format-find-file (filename format)
-  "Find the file FILE using data format FORMAT.
-If FORMAT is nil then do not do any format conversion."
-  (interactive
-   ;; Same interactive spec as write-file, plus format question.
-   (let* ((file (read-file-name "Find file: "))
-	  (fmt (format-read (format "Read file `%s' in format: " 
-				    (file-name-nondirectory file)))))
-     (list file fmt)))
-  (let ((format-alist nil))
-     (find-file filename))
-  (if format
-      (format-decode-buffer format)))
-
-(defun format-insert-file (filename format &optional beg end)
-  "Insert the contents of file FILE using data format FORMAT.
-If FORMAT is nil then do not do any format conversion.
-The optional third and fourth arguments BEG and END specify
-the part of the file to read.
-
-The return value is like the value of `insert-file-contents':
-a list (ABSOLUTE-FILE-NAME . SIZE)."
-  (interactive
-   ;; Same interactive spec as write-file, plus format question.
-   (let* ((file (read-file-name "Find file: "))
-	  (fmt (format-read (format "Read file `%s' in format: " 
-				    (file-name-nondirectory file)))))
-     (list file fmt)))
-  (let (value size)
-    (let ((format-alist nil))
-      (setq value (insert-file-contents filename nil beg end))
-      (setq size (nth 1 value)))
-    (if format
-	(setq size (format-decode size format)
-	      value (cons (car value) size)))
-    value))
-
-(defun format-read (&optional prompt)
-  "Read and return the name of a format.
-Return value is a list, like `buffer-file-format'; it may be nil.
-Formats are defined in `format-alist'.  Optional arg is the PROMPT to use."
-  (let* ((table (mapcar (lambda (x) (list (symbol-name (car x))))
-			format-alist))
-	 (ans (completing-read (or prompt "Format: ") table nil t)))
-    (if (not (equal "" ans)) (list (intern ans)))))
-
-
-;;;
-;;; Below are some functions that may be useful in writing encoding and
-;;; decoding functions for use in format-alist.
-;;;
-
-(defun format-replace-strings (alist &optional reverse beg end)
-  "Do multiple replacements on the buffer.
-ALIST is a list of (from . to) pairs, which should be proper arguments to
-`search-forward' and `replace-match' respectively.
-Optional 2nd arg REVERSE, if non-nil, means the pairs are (to . from), so that
-you can use the same list in both directions if it contains only literal
-strings. 
-Optional args BEGIN and END specify a region of the buffer to operate on."
-  (save-excursion
-    (save-restriction
-      (or beg (setq beg (point-min)))
-      (if end (narrow-to-region (point-min) end))
-      (while alist
-	(let ((from (if reverse (cdr (car alist)) (car (car alist))))
-	      (to   (if reverse (car (cdr alist)) (cdr (car alist)))))
-	  (goto-char beg)
-	  (while (search-forward from nil t)
-	    (goto-char (match-beginning 0))
-	    (insert to)
-	    (set-text-properties (- (point) (length to)) (point)
-				 (text-properties-at (point)))
-	    (delete-region (point) (+ (point) (- (match-end 0)
-						 (match-beginning 0)))))
-	  (setq alist (cdr alist)))))))
-
-;;; Some list-manipulation functions that we need.
-
-(defun format-delq-cons (cons list)
-  "Remove the given CONS from LIST by side effect,
-and return the new LIST.  Since CONS could be the first element 
-of LIST, write `\(setq foo \(format-delq-cons element foo))' to be sure of 
-changing the value of `foo'."
-  (if (eq cons list)
-      (cdr list)
-    (let ((p list))
-      (while (not (eq (cdr p) cons))
-	(if (null p) (error "format-delq-cons: not an element."))
-	(setq p (cdr p)))
-      ;; Now (cdr p) is the cons to delete
-      (setcdr p (cdr cons))
-      list)))
-    
-(defun format-make-relatively-unique (a b)
-  "Delete common elements of lists A and B, return as pair.
-Compares using `equal'."
-  (let* ((acopy (copy-sequence a))
-	 (bcopy (copy-sequence b))
-	 (tail acopy))
-    (while tail
-      (let ((dup (member (car tail) bcopy))
-	    (next (cdr tail)))
-	(if dup (setq acopy (format-delq-cons tail acopy)
-		      bcopy (format-delq-cons dup  bcopy)))
-	(setq tail next)))
-    (cons acopy bcopy)))
-
-(defun format-common-tail (a b)
-  "Given two lists that have a common tail, return it.
-Compares with `equal', and returns the part of A that is equal to the
-equivalent part of B.  If even the last items of the two are not equal,
-returns nil."
-  (let ((la (length a))
-	(lb (length b)))
-    ;; Make sure they are the same length
-    (if (> la lb) 
-	(setq a (nthcdr (- la lb) a))
-      (setq b (nthcdr (- lb la) b))))
-  (while (not (equal a b))
-    (setq a (cdr a)
-	  b (cdr b)))
-  a)
-
-(defun format-reorder (items order)
-  "Arrange ITEMS to following partial ORDER.
-Elements of ITEMS equal to elements of ORDER will be rearranged to follow the
-ORDER.  Unmatched items will go last."
-  (if order
-      (let ((item (member (car order) items)))
-	(if item
-	    (cons (car item) 
-		  (format-reorder (format-delq-cons item items)
-			   (cdr order)))
-	  (format-reorder items (cdr order))))
-    items))
-
-(put 'face 'format-list-valued t)	; These text-properties take values
-(put 'unknown 'format-list-valued t)	; that are lists, the elements of which
-					; should be considered separately.
-					; See format-deannotate-region and
-					; format-annotate-region.
-
-;;;
-;;; Decoding
-;;;
-
-(defun format-deannotate-region (from to translations next-fn)
-  "Translate annotations in the region into text properties.
-This sets text properties between FROM to TO as directed by the 
-TRANSLATIONS and NEXT-FN arguments.
-
-NEXT-FN is a function that searches forward from point for an annotation.
-It should return a list of 4 elements: \(BEGIN END NAME POSITIVE).  BEGIN and
-END are buffer positions bounding the annotation, NAME is the name searched
-for in TRANSLATIONS, and POSITIVE should be non-nil if this annotation marks
-the beginning of a region with some property, or nil if it ends the region.
-NEXT-FN should return nil if there are no annotations after point.
-
-The basic format of the TRANSLATIONS argument is described in the
-documentation for the `format-annotate-region' function.  There are some
-additional things to keep in mind for decoding, though:
-
-When an annotation is found, the TRANSLATIONS list is searched for a
-text-property name and value that corresponds to that annotation.  If the
-text-property has several annotations associated with it, it will be used only
-if the other annotations are also in effect at that point.  The first match
-found whose annotations are all present is used.
-
-The text property thus determined is set to the value over the region between
-the opening and closing annotations.  However, if the text-property name has a
-non-nil `format-list-valued' property, then the value will be consed onto the
-surrounding value of the property, rather than replacing that value.
-
-There are some special symbols that can be used in the \"property\" slot of
-the TRANSLATIONS list: PARAMETER and FUNCTION \(spelled in uppercase).
-Annotations listed under the pseudo-property PARAMETER are considered to be
-arguments of the immediately surrounding annotation; the text between the
-opening and closing parameter annotations is deleted from the buffer but saved
-as a string.  The surrounding annotation should be listed under the
-pseudo-property FUNCTION.  Instead of inserting a text-property for this
-annotation, the function listed in the VALUE slot is called to make whatever
-changes are appropriate.  The function's first two arguments are the START and
-END locations, and the rest of the arguments are any PARAMETERs found in that
-region.
-
-Any annotations that are found by NEXT-FN but not defined by TRANSLATIONS
-are saved as values of the `unknown' text-property \(which is list-valued).
-The TRANSLATIONS list should usually contain an entry of the form
-    \(unknown \(nil format-annotate-value))
-to write these unknown annotations back into the file."
-  (save-excursion
-    (save-restriction
-      (narrow-to-region (point-min) to)
-      (goto-char from)
-      (let (next open-ans todo loc unknown-ans)
-	(while (setq next (funcall next-fn))
-	  (let* ((loc      (nth 0 next))
-		 (end      (nth 1 next))
-		 (name     (nth 2 next))
-		 (positive (nth 3 next))
-		 (found    nil))
-
-	    ;; Delete the annotation
-	    (delete-region loc end)
-	    (if positive
-		;; Positive annotations are stacked, remembering location
-		(setq open-ans (cons (list name loc) open-ans))
-	      ;; It is a negative annotation:
-	      ;; Close the top annotation & add its text property.
-	      ;; If the file's nesting is messed up, the close might not match
-	      ;; the top thing on the open-annotations stack.
-	      ;; If no matching annotation is open, just ignore the close.
-	      (if (not (assoc name open-ans))
-		  (message "Extra closing annotation (%s) in file" name)
-	      ;; If one is open, but not on the top of the stack, close
-	      ;; the things in between as well.  Set `found' when the real
-	      ;; one is closed.
-		(while (not found)
-		  (let* ((top (car open-ans)) ; first on stack: should match.
-			 (top-name (car top))
-			 (start (car (cdr top))) ; location of start
-			 (params (cdr (cdr top))) ; parameters
-			 (aalist translations)
-			 (matched nil))
-		    (if (equal name top-name)
-			(setq found t)
-		      (message "Improper nesting in file."))
-		    ;; Look through property names in TRANSLATIONS
-		    (while aalist
-		      (let ((prop (car (car aalist)))
-			    (alist (cdr (car aalist))))
-			;; And look through values for each property
-			(while alist
-			  (let ((value (car (car alist)))
-				(ans (cdr (car alist))))
-			    (if (member top-name ans)
-				;; This annotation is listed, but still have to
-				;; check if multiple annotations are satisfied
-				(if (member 'nil (mapcar 
-						  (lambda (r)
-						    (assoc r open-ans))
-						  ans))
-				    nil	; multiple ans not satisfied
-				  ;; Yes, all set.
-				  ;; If there are multiple annotations going
-				  ;; into one text property, adjust the 
-				  ;; begin points of the other annotations
-				  ;; so that we don't get double marking.
-				  (let ((to-reset ans)
-					this-one)
-				    (while to-reset
-				      (setq this-one
-					    (assoc (car to-reset) 
-						   (cdr open-ans)))
-				      (if this-one
-					  (setcdr this-one (list loc)))
-				      (setq to-reset (cdr to-reset))))
-				  ;; Set loop variables to nil so loop
-				  ;; will exit.
-				  (setq alist nil aalist nil matched t
-					;; pop annotation off stack.
-					open-ans (cdr open-ans))
-				  (cond 
-				   ;; Check for pseudo-properties
-				   ((eq prop 'PARAMETER)
-				    ;; This is a parameter of the top open ann:
-				    ;; delete text and use as arg.
-				    (if open-ans
-					;; (If nothing open, discard).
-					(setq open-ans
-					      (cons (append (car open-ans)
-							    (list
-							     (buffer-substring
-							      start loc)))
-						    (cdr open-ans))))
-				    (delete-region start loc))
-				   ((eq prop 'FUNCTION)
-				    ;; Not a property, but a function to call.
-				    (let ((rtn (apply value start loc params)))
-				      (if rtn (setq todo (cons rtn todo)))))
-				   (t 
-				    ;; Normal property/value pair
-				    (setq todo 
-					  (cons (list start loc prop value)
-						todo)))))))
-			  (setq alist (cdr alist))))
-		      (setq aalist (cdr aalist)))
-		    (if matched
-			nil
-		      ;; Didn't find any match for the annotation:
-		      ;; Store as value of text-property `unknown'.
-		      (setq open-ans (cdr open-ans))
-		      (setq todo (cons (list start loc 'unknown top-name)
-				       todo))
-		      (setq unknown-ans (cons name unknown-ans)))))))))
-
-	;; Once entire file has been scanned, add the properties.
-	(while todo
-	  (let* ((item (car todo))
-		 (from (nth 0 item))
-		 (to   (nth 1 item))
-		 (prop (nth 2 item))
-		 (val  (nth 3 item)))
-	
-	    (put-text-property 
-	       from to prop
-	       (cond ((numberp val) ; add to ambient value if numeric
-		      (+ val (or (get-text-property from prop) 0)))
-		     ((get prop 'format-list-valued) ; value gets consed onto
-						     ; list-valued properties
-		      (let ((prev (get-text-property from prop)))
-			(cons val (if (listp prev) prev (list prev)))))
-		     (t val)))) ; normally, just set to val.
-	  (setq todo (cdr todo)))
-    
-	(if unknown-ans
-	    (message "Unknown annotations: %s" unknown-ans))))))
-
-;;;
-;;; Encoding
-;;;
-
-(defun format-insert-annotations (list &optional offset)
-  "Apply list of annotations to buffer as `write-region' would.
-Inserts each element of the given LIST of buffer annotations at its
-appropriate place.  Use second arg OFFSET if the annotations' locations are
-not relative to the beginning of the buffer: annotations will be inserted
-at their location-OFFSET+1 \(ie, the offset is treated as the character number
-of the first character in the buffer)."
-  (if (not offset) 
-      (setq offset 0)
-    (setq offset (1- offset)))
-  (let ((l (reverse list)))
-    (while l
-      (goto-char (- (car (car l)) offset))
-      (insert (cdr (car l)))
-      (setq l (cdr l)))))
-
-(defun format-annotate-value (old new)
-  "Return OLD and NEW as a \(close . open) annotation pair.
-Useful as a default function for TRANSLATIONS alist when the value of the text
-property is the name of the annotation that you want to use, as it is for the
-`unknown' text property."
-  (cons (if old (list old))
-	(if new (list new))))
-
-(defun format-annotate-region (from to trans format-fn ignore)
-  "Generate annotations for text properties in the region.
-Searches for changes between FROM and TO, and describes them with a list of
-annotations as defined by alist TRANSLATIONS and FORMAT-FN.  IGNORE lists text
-properties not to consider; any text properties that are neither ignored nor
-listed in TRANSLATIONS are warned about.
-If you actually want to modify the region, give the return value of this
-function to `format-insert-annotations'.
-
-Format of the TRANSLATIONS argument:
-
-Each element is a list whose car is a PROPERTY, and the following
-elements are VALUES of that property followed by the names of zero or more
-ANNOTATIONS.  Whenever the property takes on that value, the annotations
-\(as formatted by FORMAT-FN) are inserted into the file.
-When the property stops having that value, the matching negated annotation
-will be inserted \(it may actually be closed earlier and reopened, if
-necessary, to keep proper nesting). 
-
-If the property's value is a list, then each element of the list is dealt with
-separately.
-
-If a VALUE is numeric, then it is assumed that there is a single annotation
-and each occurrence of it increments the value of the property by that number.
-Thus, given the entry \(left-margin \(4 \"indent\")), if the left margin
-changes from 4 to 12, two <indent> annotations will be generated.
-
-If the VALUE is nil, then instead of annotations, a function should be
-specified.  This function is used as a default: it is called for all
-transitions not explicitly listed in the table.  The function is called with
-two arguments, the OLD and NEW values of the property.  It should return
-lists of annotations like `format-annotate-location' does.
-
-    The same structure can be used in reverse for reading files."
-  (let ((all-ans nil)    ; All annotations - becomes return value
-	(open-ans nil)   ; Annotations not yet closed
-	(loc nil)	 ; Current location
-	(not-found nil)) ; Properties that couldn't be saved
-    (while (or (null loc)
-	       (and (setq loc (next-property-change loc nil to))
-		    (< loc to)))
-      (or loc (setq loc from))
-      (let* ((ans (format-annotate-location loc (= loc from) ignore trans))
-	     (neg-ans (format-reorder (aref ans 0) open-ans))
-	     (pos-ans (aref ans 1))
-	     (ignored (aref ans 2)))
-	(setq not-found (append ignored not-found)
-	      ignore    (append ignored ignore))
-	;; First do the negative (closing) annotations
-	(while neg-ans
-	  ;; Check if it's missing.  This can happen (eg, a numeric property
-	  ;; going negative can generate closing annotations before there are
-	  ;; any open).  Warn user & ignore.
-	  (if (not (member (car neg-ans) open-ans))
-	      (message "Can't close %s: not open." (car neg-ans))
-	    (while (not (equal (car neg-ans) (car open-ans)))
-	      ;; To close anno. N, need to first close ans 1 to N-1,
-	      ;; remembering to re-open them later.
-	      (setq pos-ans (cons (car open-ans) pos-ans))
-	      (setq all-ans 
-		    (cons (cons loc (funcall format-fn (car open-ans) nil))
-			  all-ans))
-	      (setq open-ans (cdr open-ans)))
-	    ;; Now remove the one we're really interested in from open list.
-	    (setq open-ans (cdr open-ans))
-	    ;; And put the closing annotation here.
-	    (setq all-ans 
-		  (cons (cons loc (funcall format-fn (car neg-ans) nil))
-			all-ans)))
-	  (setq neg-ans (cdr neg-ans)))
-	;; Now deal with positive (opening) annotations
-	(let ((p pos-ans))
-	  (while pos-ans
-	    (setq open-ans (cons (car pos-ans) open-ans))
-	    (setq all-ans 
-		  (cons (cons loc (funcall format-fn (car pos-ans) t))
-			all-ans))
-	    (setq pos-ans (cdr pos-ans))))))
-
-    ;; Close any annotations still open
-    (while open-ans
-      (setq all-ans 
-	    (cons (cons to (funcall format-fn (car open-ans) nil))
-		  all-ans))
-      (setq open-ans (cdr open-ans)))
-    (if not-found
-	(message "These text properties could not be saved:\n    %s"
-		 not-found))
-    (nreverse all-ans)))
-
-;;; Internal functions for format-annotate-region.
-
-(defun format-annotate-location (loc all ignore trans)
-  "Return annotation(s) needed at LOCATION.
-This includes any properties that change between LOC-1 and LOC.
-If ALL is true, don't look at previous location, but generate annotations for
-all non-nil properties.
-Third argument IGNORE is a list of text-properties not to consider.
-
-Return value is a vector of 3 elements:
-1. List of names of the annotations to close
-2. List of the names of annotations to open.
-3. List of properties that were ignored or couldn't be annotated."
-  (let* ((prev-loc (1- loc))
-	 (before-plist (if all nil (text-properties-at prev-loc)))
-	 (after-plist (text-properties-at loc))
-	 p negatives positives prop props not-found)
-    ;; make list of all property names involved
-    (setq p before-plist)
-    (while p
-      (if (not (memq (car p) props))
-	  (setq props (cons (car p) props)))
-      (setq p (cdr (cdr p))))
-    (setq p after-plist)
-    (while p
-      (if (not (memq (car p) props))
-	  (setq props (cons (car p) props)))
-      (setq p (cdr (cdr p))))
-
-    (while props
-      (setq prop (car props)
-	    props (cdr props))
-      (if (memq prop ignore)
-	  nil  ; If it's been ignored before, ignore it now.
-	(let ((before (if all nil (car (cdr (memq prop before-plist)))))
-	      (after (car (cdr (memq prop after-plist)))))
-	  (if (equal before after)
-	      nil ; no change; ignore
-	    (let ((result (format-annotate-single-property-change
-			   prop before after trans)))
-	      (if (not result)
-		  (setq not-found (cons prop not-found))
-		(setq negatives (nconc negatives (car result))
-		      positives (nconc positives (cdr result)))))))))
-    (vector negatives positives not-found)))
-
-(defun format-annotate-single-property-change (prop old new trans)
-  "Return annotations for PROPERTY changing from OLD to NEW.
-These are searched for in the TRANSLATIONS alist.
-If NEW does not appear in the list, but there is a default function, then that
-function is called.
-Annotations to open and to close are returned as a dotted pair."
-  (let ((prop-alist (cdr (assoc prop trans)))
-	default)
-    (if (not prop-alist)
-	nil
-      ;; If property is numeric, nil means 0
-      (cond ((and (numberp old) (null new))
-	     (setq new 0))
-	    ((and (numberp new) (null old))
-	     (setq old 0)))
-      ;; If either old or new is a list, have to treat both that way.
-      (if (or (consp old) (consp new))
-	  (let* ((old (if (listp old) old (list old)))
-		 (new (if (listp new) new (list new)))
-		 (tail (format-common-tail old new))
-		 close open)
-	    (while old
-	      (setq close 
-		    (append (car (format-annotate-atomic-property-change
-				  prop-alist (car old) nil))
-			    close)
-		    old (cdr old)))
-	    (while new
-	      (setq open 
-		    (append (cdr (format-annotate-atomic-property-change
-				  prop-alist nil (car new)))
-			    open)
-		    new (cdr new)))
-	    (format-make-relatively-unique close open))
-	(format-annotate-atomic-property-change prop-alist old new)))))
-
-(defun format-annotate-atomic-property-change (prop-alist old new)
-  "Internal function annotate a single property change.
-PROP-ALIST is the relevant segment of a TRANSLATIONS list.
-OLD and NEW are the values."
-  (cond
-   ;; Numerical annotation - use difference
-   ((and (numberp old) (numberp new))
-    (let* ((entry (progn
-		    (while (and (car (car prop-alist))
-				(not (numberp (car (car prop-alist)))))
-		      (setq prop-alist (cdr prop-alist)))
-		    (car prop-alist)))
-	   (increment (car (car prop-alist)))
-	   (n (ceiling (/ (float (- new old)) (float increment))))
-	   (anno (car (cdr (car prop-alist)))))
-      (if (> n 0)
-	  (cons nil (make-list n anno))
-	(cons (make-list (- n) anno) nil))))
-
-   ;; Standard annotation
-   (t (let ((close (and old (cdr (assoc old prop-alist))))
-	    (open  (and new (cdr (assoc new prop-alist)))))
-	(if (or close open)
-	    (format-make-relatively-unique close open)
-	  ;; Call "Default" function, if any
-	  (let ((default (assq nil prop-alist)))
-	    (if default
-		(funcall (car (cdr default)) old new))))))))
-
-;; format.el ends here
diff --git a/lisp/forms-pass.el b/lisp/forms-pass.el
deleted file mode 100644
index 1a7db41e20a..00000000000
--- a/lisp/forms-pass.el
+++ /dev/null
@@ -1,25 +0,0 @@
-;;; forms-pass.el --- passwd file demo for forms-mode
-
-;; This demo visits your passwd file.
-
-;; use yp if present
-(or (file-exists-p (setq forms-file "/var/yp/src/passwd"))
-    (setq forms-file "/etc/passwd"))
-
-(setq forms-read-only t)		; to make sure
-(setq forms-field-sep ":")
-(setq forms-number-of-fields 7)
-
-(setq forms-format-list
-      (list
-       "====== Visiting " forms-file " ======\n\n"
-       "User : "	1
-       "   Uid: "	3
-       "   Gid: "	4
-       "\n\n"
-       "Name : "	5
-       "\n\n"
-       "Home : "	6
-       "\n\n"
-       "Shell: "	7
-       "\n"))
diff --git a/lisp/forms.el b/lisp/forms.el
deleted file mode 100644
index 0aa5f0f7130..00000000000
--- a/lisp/forms.el
+++ /dev/null
@@ -1,2049 +0,0 @@
-;;; forms.el --- Forms mode: edit a file as a form to fill in
-
-;; Copyright (C) 1991, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Johan Vromans <jvromans@squirrel.nl>
-
-;; 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:
-
-;; Visit a file using a form.
-;;
-;; === Naming conventions
-;;
-;; The names of all variables and functions start with 'forms-'.
-;; Names which start with 'forms--' are intended for internal use, and
-;; should *NOT* be used from the outside.
-;;
-;; All variables are buffer-local, to enable multiple forms visits 
-;; simultaneously.
-;; Variable `forms--mode-setup' is local to *ALL* buffers, for it 
-;; controls if forms-mode has been enabled in a buffer.
-;;
-;; === How it works ===
-;;
-;; Forms mode means visiting a data file which is supposed to consist
-;; of records each containing a number of fields.  The records are
-;; separated by a newline, the fields are separated by a user-defined
-;; field separator (default: TAB).
-;; When shown, a record is transferred to an Emacs buffer and
-;; presented using a user-defined form.  One record is shown at a
-;; time.
-;;
-;; Forms mode is a composite mode.  It involves two files, and two
-;; buffers.
-;; The first file, called the control file, defines the name of the
-;; data file and the forms format.  This file buffer will be used to
-;; present the forms.
-;; The second file holds the actual data.  The buffer of this file
-;; will be buried, for it is never accessed directly.
-;;
-;; Forms mode is invoked using M-x forms-find-file control-file .
-;; Alternatively `forms-find-file-other-window' can be used.
-;;
-;; You may also visit the control file, and switch to forms mode by hand
-;; with M-x forms-mode .
-;;
-;; Automatic mode switching is supported if you specify 
-;; "-*- forms -*-" in the first line of the control file.
-;; 
-;; The control file is visited, evaluated using `eval-current-buffer',
-;; and should set at least the following variables:
-;;
-;;	forms-file				[string]
-;;			The name of the data file.
-;;
-;;	forms-number-of-fields			[integer]
-;;			The number of fields in each record.
-;;
-;;	forms-format-list			[list]
-;;			Formatting instructions.
-;;
-;; `forms-format-list' should be a list, each element containing
-;;
-;;   - a string, e.g. "hello".  The string is inserted in the forms
-;;	"as is".
-;;   
-;;   - an integer, denoting a field number.
-;;	The contents of this field are inserted at this point.
-;;     Fields are numbered starting with number one.
-;;   
-;;   - a function call, e.g. (insert "text").
-;;	This function call is dynamically evaluated and should return a
-;;     string.  It should *NOT* have side-effects on the forms being
-;;     constructed.  The current fields are available to the function
-;;     in the variable `forms-fields', they should *NOT* be modified.
-;;   
-;;   - a lisp symbol, that must evaluate to one of the above.
-;;
-;; Optional variables which may be set in the control file:
-;;
-;;	forms-field-sep				[string, default TAB]
-;;			The field separator used to separate the
-;;			fields in the data file.  It may be a string.
-;;
-;;	forms-read-only				[bool, default nil]
-;;			Non-nil means that the data file is visited
-;;			read-only (view mode) as opposed to edit mode.
-;;			If no write access to the data file is
-;;			possible, view mode is enforced. 
-;;
-;;	forms-check-number-of-fields            [bool, default t]
-;;			If non-nil, a warning will be issued whenever
-;;			a record is found that does not have the number
-;;			of fields specified by `forms-number-of-fields'.
-;;
-;;	forms-multi-line			[string, default "^K"]
-;;			If non-null the records of the data file may
-;;			contain fields that can span multiple lines in
-;;			the form.
-;;			This variable denotes the separator character
-;;			to be used for this purpose.  Upon display, all
-;;			occurrences of this character are translated
-;;			to newlines.  Upon storage they are translated
-;;			back to the separator character.
-;;
-;;	forms-forms-scroll			[bool, default nil]
-;;			Non-nil means: rebind locally the commands that
-;;			perform `scroll-up' or `scroll-down' to use
-;;			`forms-next-field' resp. `forms-prev-field'.
-;;
-;;	forms-forms-jump			[bool, default nil]
-;;			Non-nil means: rebind locally the commands that
-;;
-;;	forms-insert-after			[bool, default nil]
-;;			Non-nil means: inserts of new records go after
-;;			current record, also initial position is at last
-;;			record.
-;;
-;;	forms-read-file-filter			[symbol, default nil]
-;;			If not nil: this should be the name of a 
-;;			function that is called after the forms data file
-;;			has been read.  It can be used to transform
-;;			the contents of the file into a format more suitable
-;;			for forms-mode processing.
-;;
-;;	forms-write-file-filter			[symbol, default nil]
-;;			If not nil: this should be the name of a 
-;;			function that is called before the forms data file
-;;			is written (saved) to disk.  It can be used to undo
-;;			the effects of `forms-read-file-filter', if any.
-;;
-;;	forms-new-record-filter			[symbol, default nil]
-;;			If not nil: this should be the name of a 
-;;			function that is called when a new
-;;			record is created.  It can be used to fill in
-;;			the new record with default fields, for example.
-;;
-;;	forms-modified-record-filter		[symbol, default nil]
-;;			If not nil: this should be the name of a 
-;;			function that is called when a record has
-;;			been modified.  It is called after the fields
-;;			are parsed.  It can be used to register
-;;			modification dates, for example.
-;;
-;;	forms-use-text-properties		[bool, see text for default]
-;;			This variable controls if forms mode should use
-;;			text properties to protect the form text from being
-;;			modified (using text-property `read-only').
-;;			Also, the read-write fields are shown using a
-;;			distinct face, if possible.
-;;			As of emacs 19.29, the `intangible' text property
-;;			is used to prevent moving into read-only fields.
-;;			This variable defaults to t if running Emacs 19
-;;			with text properties.
-;;			The default face to show read-write fields is
-;;			copied from face `region'.
-;;
-;;	forms-ro-face 				[symbol, default 'default]
-;;			This is the face that is used to show
-;;			read-only text on the screen.If used, this
-;;			variable should be set to a symbol that is a
-;;			valid face.
-;;			E.g.
-;;			  (make-face 'my-face)
-;;			  (setq forms-ro-face 'my-face)
-;;
-;;	forms-rw-face				[symbol, default 'region]
-;;			This is the face that is used to show
-;;			read-write text on the screen.
-;;
-;; After evaluating the control file, its buffer is cleared and used
-;; for further processing.
-;; The data file (as designated by `forms-file') is visited in a buffer
-;; `forms--file-buffer' which will not normally be shown.
-;; Great malfunctioning may be expected if this file/buffer is modified
-;; outside of this package while it is being visited!
-;;
-;; Normal operation is to transfer one line (record) from the data file,
-;; split it into fields (into `forms--the-record-list'), and display it
-;; using the specs in `forms-format-list'.
-;; A format routine `forms--format' is built upon startup to format 
-;; the records according to `forms-format-list'.
-;;
-;; When a form is changed the record is updated as soon as this form
-;; is left.  The contents of the form are parsed using information
-;; obtained from `forms-format-list', and the fields which are
-;; deduced from the form are modified.  Fields not shown on the forms
-;; retain their original values.  The newly formed record then
-;; replaces the contents of the old record in `forms--file-buffer'.
-;; A parse routine `forms--parser' is built upon startup to parse
-;; the records.
-;;
-;; Two exit functions exist: `forms-exit' and `forms-exit-no-save'.
-;; `forms-exit' saves the data to the file, if modified.
-;; `forms-exit-no-save` does not.  However, if `forms-exit-no-save'
-;; is executed and the file buffer has been modified, Emacs will ask
-;; questions anyway.
-;;
-;; Other functions provided by forms mode are:
-;;
-;;	paging (forward, backward) by record
-;;	jumping (first, last, random number)
-;;	searching
-;;	creating and deleting records
-;;	reverting the form (NOT the file buffer)
-;;	switching edit <-> view mode v.v.
-;;	jumping from field to field
-;;
-;; As an documented side-effect: jumping to the last record in the
-;; file (using forms-last-record) will adjust forms--total-records if
-;; needed.
-;;
-;; The forms buffer can be in on eof two modes: edit mode or view
-;; mode.  View mode is a read-only mode, you cannot modify the
-;; contents of the buffer.
-;;
-;; Edit mode commands:
-;; 
-;; TAB		 forms-next-field
-;; \C-c TAB	 forms-next-field
-;; \C-c <	 forms-first-record
-;; \C-c >	 forms-last-record
-;; \C-c ?	 describe-mode
-;; \C-c \C-k	 forms-delete-record
-;; \C-c \C-q	 forms-toggle-read-only
-;; \C-c \C-o	 forms-insert-record
-;; \C-c \C-l	 forms-jump-record
-;; \C-c \C-n	 forms-next-record
-;; \C-c \C-p	 forms-prev-record
-;; \C-c \C-r	 forms-search-backward
-;; \C-c \C-s	 forms-search-forward
-;; \C-c \C-x	 forms-exit
-;; 
-;; Read-only mode commands:
-;; 
-;; SPC 	 forms-next-record
-;; DEL	 forms-prev-record
-;; ?	 describe-mode
-;; \C-q forms-toggle-read-only
-;; l	 forms-jump-record
-;; n	 forms-next-record
-;; p	 forms-prev-record
-;; r	 forms-search-backward
-;; s	 forms-search-forward
-;; x	 forms-exit
-;; 
-;; Of course, it is also possible to use the \C-c prefix to obtain the
-;; same command keys as in edit mode.
-;; 
-;; The following bindings are available, independent of the mode: 
-;; 
-;; [next]	  forms-next-record
-;; [prior]	  forms-prev-record
-;; [begin]	  forms-first-record
-;; [end]	  forms-last-record
-;; [S-TAB]	  forms-prev-field
-;; [backtab] forms-prev-field
-;;
-;; For convenience, TAB is always bound to `forms-next-field', so you
-;; don't need the C-c prefix for this command.
-;;
-;; As mentioned above (see `forms-forms-scroll' and `forms-forms-jump')
-;; the bindings of standard functions `scroll-up', `scroll-down',
-;; `beginning-of-buffer' and `end-of-buffer' can be locally replaced with
-;; forms mode functions next/prev record and first/last
-;; record.
-;;
-;; `local-write-file hook' is defined to save the actual data file
-;; instead of the buffer data, `revert-file-hook' is defined to
-;; revert a forms to original.
-
-;;; Code:
-
-;;; Global variables and constants:
-
-(provide 'forms)			;;; official
-(provide 'forms-mode)			;;; for compatibility
-
-(defconst forms-version (substring "$Revision: 2.20 $" 11 -2)
-  "The version number of forms-mode (as string).  The complete RCS id is:
-
-  $Id: forms.el,v 2.20 1996/03/01 20:31:29 jv Exp $")
-
-(defvar forms-mode-hooks nil
-  "Hook functions to be run upon entering Forms mode.")
-
-;;; Mandatory variables - must be set by evaluating the control file.
-
-(defvar forms-file nil
-  "Name of the file holding the data.")
-
-(defvar forms-format-list nil
-  "List of formatting specifications.")
-
-(defvar forms-number-of-fields nil
-  "Number of fields per record.")
-
-;;; Optional variables with default values.
-
-(defvar forms-check-number-of-fields t
-  "*If non-nil, warn about records with wrong number of fields.")
-
-(defvar forms-field-sep "\t"
-  "Field separator character (default TAB).")
-
-(defvar forms-read-only nil
-  "Non-nil means: visit the file in view (read-only) mode.
-\(Defaults to the write access on the data file).")
-
-(defvar forms-multi-line "\C-k"
-  "If not nil: use this character to separate multi-line fields (default C-k).")
-
-(defvar forms-forms-scroll nil
-  "*Non-nil means replace scroll-up/down commands in Forms mode.
-The replacement commands performs forms-next/prev-record.")
-
-(defvar forms-forms-jump nil
-  "*Non-nil means redefine beginning/end-of-buffer in Forms mode.
-The replacement commands performs forms-first/last-record.")
-
-(defvar forms-read-file-filter nil
-  "The name of a function that is called after reading the data file.
-This can be used to change the contents of the file to something more
-suitable for forms processing.")
-
-(defvar forms-write-file-filter nil
-  "The name of a function that is called before writing the data file.
-This can be used to undo the effects of form-read-file-hook.")
-
-(defvar forms-new-record-filter nil
-  "The name of a function that is called when a new record is created.")
-
-(defvar forms-modified-record-filter nil
-  "The name of a function that is called when a record has been modified.")
-
-(defvar forms-fields nil
-  "List with fields of the current forms.  First field has number 1.
-This variable is for use by the filter routines only. 
-The contents may NOT be modified.")
-
-(defvar forms-use-text-properties (fboundp 'set-text-properties)
-  "*Non-nil means: use emacs-19 text properties.
-Defaults to t if this emacs is capable of handling text properties.")
-
-(defvar forms-insert-after nil
-  "*Non-nil means: inserts of new records go after current record.
-Also, initial position is at last record.")
-
-(defvar forms-ro-face 'default
-  "The face (a symbol) that is used to display read-only text on the screen.")
-
-(defvar forms-rw-face 'region
-  "The face (a symbol) that is used to display read-write text on the screen.")
-
-;;; Internal variables.
-
-(defvar forms--file-buffer nil
-  "Buffer which holds the file data")
-
-(defvar forms--total-records 0
-  "Total number of records in the data file.")
-
-(defvar forms--current-record 0
-  "Number of the record currently on the screen.")
-
-(defvar forms-mode-map nil
-   "Keymap for form buffer.")
-(defvar forms-mode-ro-map nil
-   "Keymap for form buffer in view mode.")
-(defvar forms-mode-edit-map nil
-   "Keymap for form buffer in edit mode.")
-
-(defvar forms--markers nil
-  "Field markers in the screen.")
-
-(defvar forms--dyntexts nil
-  "Dynamic texts (resulting from function calls) on the screen.")
-
-(defvar forms--the-record-list nil 
-   "List of strings of the current record, as parsed from the file.")
-
-(defvar forms--search-regexp nil
-  "Last regexp used by forms-search functions.")
-
-(defvar forms--format nil
-  "Formatting routine.")
-
-(defvar forms--parser nil
-  "Forms parser routine.")
-
-(defvar forms--mode-setup nil
-  "To keep track of forms-mode being set-up.")
-(make-variable-buffer-local 'forms--mode-setup)
-
-(defvar forms--dynamic-text nil
-  "Array that holds dynamic texts to insert between fields.")
-
-(defvar forms--elements nil
-  "Array with the order in which the fields are displayed.")
-
-(defvar forms--ro-face nil
-  "Face used to represent read-only data on the screen.")
-
-(defvar forms--rw-face nil
-  "Face used to represent read-write data on the screen.")
-
-;;;###autoload 
-(defun forms-mode (&optional primary)
-  "Major mode to visit files in a field-structured manner using a form.
-
-Commands:                        Equivalent keys in read-only mode:
- TAB            forms-next-field          TAB
- \\C-c TAB       forms-next-field          
- \\C-c <         forms-first-record         <
- \\C-c >         forms-last-record          >
- \\C-c ?         describe-mode              ?
- \\C-c \\C-k      forms-delete-record
- \\C-c \\C-q      forms-toggle-read-only     q
- \\C-c \\C-o      forms-insert-record
- \\C-c \\C-l      forms-jump-record          l
- \\C-c \\C-n      forms-next-record          n
- \\C-c \\C-p      forms-prev-record          p
- \\C-c \\C-r      forms-search-reverse       r
- \\C-c \\C-s      forms-search-forward       s
- \\C-c \\C-x      forms-exit                 x
-"
-  (interactive)
-
-  ;; This is not a simple major mode, as usual.  Therefore, forms-mode
-  ;; takes an optional argument `primary' which is used for the
-  ;; initial set-up.  Normal use would leave `primary' to nil.
-  ;; A global buffer-local variable `forms--mode-setup' has the same
-  ;; effect but makes it possible to auto-invoke forms-mode using
-  ;; `find-file'.
-  ;; Note: although it seems logical to have `make-local-variable'
-  ;; executed where the variable is first needed, I have deliberately
-  ;; placed all calls in this function.
-
-  ;; Primary set-up: evaluate buffer and check if the mandatory
-  ;; variables have been set.
-  (if (or primary (not forms--mode-setup))
-      (progn
-	;;(message "forms: setting up...")
-	(kill-all-local-variables)
-
-	;; Make mandatory variables.
-	(make-local-variable 'forms-file)
-	(make-local-variable 'forms-number-of-fields)
-	(make-local-variable 'forms-format-list)
-
-	;; Make optional variables.
-	(make-local-variable 'forms-field-sep)
-        (make-local-variable 'forms-read-only)
-        (make-local-variable 'forms-multi-line)
-	(make-local-variable 'forms-forms-scroll)
-	(make-local-variable 'forms-forms-jump)
-	(make-local-variable 'forms-insert-after)
-	(make-local-variable 'forms-use-text-properties)
-
-	;; Filter functions.
-	(make-local-variable 'forms-read-file-filter)
-	(make-local-variable 'forms-write-file-filter)
-	(make-local-variable 'forms-new-record-filter)
-	(make-local-variable 'forms-modified-record-filter)
-
-	;; Make sure no filters exist.
-	(setq forms-read-file-filter nil)
-	(setq forms-write-file-filter nil)
-	(setq forms-new-record-filter nil)
-	(setq forms-modified-record-filter nil)
-
-	;; If running Emacs 19 under X, setup faces to show read-only and 
-	;; read-write fields.
-	(if (fboundp 'make-face)
-	    (progn
-	      (make-local-variable 'forms-ro-face)
-	      (make-local-variable 'forms-rw-face)))
-
-	;; eval the buffer, should set variables
-	;;(message "forms: processing control file...")
-	;; If enable-local-eval is not set to t the user is asked first.
-	(if (or (eq enable-local-eval t)
-		(yes-or-no-p 
-		 (concat "Evaluate lisp code in buffer "
-			 (buffer-name) " to display forms ")))
-	    (eval-current-buffer)
-	  (error "`enable-local-eval' inhibits buffer evaluation"))
-
-	;; Check if the mandatory variables make sense.
-	(or forms-file
-	    (error (concat "Forms control file error: " 
-			   "'forms-file' has not been set")))
-
-	;; Check forms-field-sep first, since it can be needed to
-	;; construct a default format list.
-	(or (stringp forms-field-sep)
-	    (error (concat "Forms control file error: "
-			   "'forms-field-sep' is not a string")))
-
-	(if forms-number-of-fields
-	    (or (and (numberp forms-number-of-fields)
-		     (> forms-number-of-fields 0))
-		(error (concat "Forms control file error: "
-			       "'forms-number-of-fields' must be a number > 0")))
-	  (or (null forms-format-list)
-	      (error (concat "Forms control file error: "
-			     "'forms-number-of-fields' has not been set"))))
-
-	(or forms-format-list
-	    (forms--intuit-from-file))
-
-	(if forms-multi-line
-	    (if (and (stringp forms-multi-line)
-		     (eq (length forms-multi-line) 1))
-		(if (string= forms-multi-line forms-field-sep)
-		    (error (concat "Forms control file error: " 
-				   "'forms-multi-line' is equal to 'forms-field-sep'")))
-	      (error (concat "Forms control file error: "
-			     "'forms-multi-line' must be nil or a one-character string"))))
-	(or (fboundp 'set-text-properties)
-	    (setq forms-use-text-properties nil))
-	    
-	;; Validate and process forms-format-list.
-	;;(message "forms: pre-processing format list...")
-	(forms--process-format-list)
-
-	;; Build the formatter and parser.
-	;;(message "forms: building formatter...")
-	(make-local-variable 'forms--format)
-	(make-local-variable 'forms--markers)
-	(make-local-variable 'forms--dyntexts)
-	(make-local-variable 'forms--elements)
-	;;(message "forms: building parser...")
-	(forms--make-format)
-	(make-local-variable 'forms--parser)
-	(forms--make-parser)
-	;;(message "forms: building parser... done.")
-
-	;; Check if record filters are defined.
-	(if (and forms-new-record-filter
-		 (not (fboundp forms-new-record-filter)))
-	    (error (concat "Forms control file error: "
-			   "'forms-new-record-filter' is not a function")))
-
-	(if (and forms-modified-record-filter
-		 (not (fboundp forms-modified-record-filter)))
-	    (error (concat "Forms control file error: "
-			   "'forms-modified-record-filter' is not a function")))
-
-	;; The filters acces the contents of the forms using `forms-fields'.
-	(make-local-variable 'forms-fields)
-
-	;; Dynamic text support.
-	(make-local-variable 'forms--dynamic-text)
-
-	;; Prevent accidental overwrite of the control file and autosave.
-	(set-visited-file-name nil)
-
-	;; Prepare this buffer for further processing.
-	(setq buffer-read-only nil)
-	(erase-buffer)
-
-	;;(message "forms: setting up... done.")
-	))
-
-  ;; initialization done
-  (setq forms--mode-setup t)
-
-  ;; Copy desired faces to the actual variables used by the forms formatter.
-  (if (fboundp 'make-face)
-      (progn
-	(make-local-variable 'forms--ro-face)
-	(make-local-variable 'forms--rw-face)
-	(if forms-read-only
-	    (progn
-	      (setq forms--ro-face forms-ro-face)
-	      (setq forms--rw-face forms-ro-face))
-	  (setq forms--ro-face forms-ro-face)
-	  (setq forms--rw-face forms-rw-face))))
-
-  ;; Make more local variables.
-  (make-local-variable 'forms--file-buffer)
-  (make-local-variable 'forms--total-records)
-  (make-local-variable 'forms--current-record)
-  (make-local-variable 'forms--the-record-list)
-  (make-local-variable 'forms--search-regexp)
-
-  ; The keymaps are global, so multiple forms mode buffers can share them.
-  ;(make-local-variable 'forms-mode-map)
-  ;(make-local-variable 'forms-mode-ro-map)
-  ;(make-local-variable 'forms-mode-edit-map)
-  (if forms-mode-map			; already defined
-      nil
-    ;;(message "forms: building keymap...")
-    (forms--mode-commands)
-    ;;(message "forms: building keymap... done.")
-    )
-
-  ;; set the major mode indicator
-  (setq major-mode 'forms-mode)
-  (setq mode-name "Forms")
-
-  ;; find the data file
-  (setq forms--file-buffer (find-file-noselect forms-file))
-
-  ;; Pre-transform.
-  (let ((read-file-filter forms-read-file-filter)
-	(write-file-filter forms-write-file-filter))
-    (if read-file-filter
-	(save-excursion
-	  (set-buffer forms--file-buffer)
-	  (let ((inhibit-read-only t)
-		(file-modified (buffer-modified-p)))
-	    (run-hooks 'read-file-filter)
-	    (if (not file-modified) (set-buffer-modified-p nil)))
-	  (if write-file-filter
-	      (progn
-		(make-variable-buffer-local 'local-write-file-hooks)
-		(setq local-write-file-hooks (list write-file-filter)))))
-      (if write-file-filter
-	  (save-excursion
-	    (set-buffer forms--file-buffer)
-	    (make-variable-buffer-local 'local-write-file-hooks)
-	    (setq local-write-file-hooks (list write-file-filter))))))
-
-  ;; count the number of records, and set see if it may be modified
-  (let (ro)
-    (setq forms--total-records
-	  (save-excursion
-	    (prog1
-		(progn
-		  ;;(message "forms: counting records...")
-		  (set-buffer forms--file-buffer)
-		  (bury-buffer (current-buffer))
-		  (setq ro buffer-read-only)
-		  (count-lines (point-min) (point-max)))
-	      ;;(message "forms: counting records... done.")
-	      )))
-    (if ro
-	(setq forms-read-only t)))
-
-  ;;(message "forms: proceeding setup...")
-
-  ;; Since we aren't really implementing a minor mode, we hack the modeline
-  ;; directly to get the text " View " into forms-read-only form buffers.  For
-  ;; that reason, this variable must be buffer only.
-  (make-local-variable 'minor-mode-alist)
-  (setq minor-mode-alist (list (list 'forms-read-only " View")))
-
-  ;;(message "forms: proceeding setup (keymaps)...")
-  (forms--set-keymaps)
-  ;;(message "forms: proceeding setup (commands)...")
-  (forms--change-commands)
-
-  ;;(message "forms: proceeding setup (buffer)...")
-  (set-buffer-modified-p nil)
-
-  (if (= forms--total-records 0)
-      ;;(message "forms: proceeding setup (new file)...")
-      (progn
-	(insert 
-	 "GNU Emacs Forms Mode version " forms-version "\n\n"
-	 (if (file-exists-p forms-file)
-	     (concat "No records available in file `" forms-file "'\n\n")
-	   (format "Creating new file `%s'\nwith %d field%s per record\n\n"
-		   forms-file forms-number-of-fields
-		   (if (= 1 forms-number-of-fields) "" "s")))
-	 "Use " (substitute-command-keys "\\[forms-insert-record]")
-	 " to create new records.\n")
-	(setq forms--current-record 1)
-	(setq buffer-read-only t)
-	(set-buffer-modified-p nil))
-
-    ;; setup the first (or current) record to show
-    (if (< forms--current-record 1)
-	(setq forms--current-record 1))
-    (forms-jump-record forms--current-record)
-    )
-
-  (if forms-insert-after
-      (forms-last-record)
-    (forms-first-record))
-
-  ;; user customising
-  ;;(message "forms: proceeding setup (user hooks)...")
-  (run-hooks 'forms-mode-hooks)
-  ;;(message "forms: setting up... done.")
-
-  ;; be helpful
-  (forms--help)
-)
-
-(defun forms--process-format-list ()
-  ;; Validate `forms-format-list' and set some global variables.
-  ;; Symbols in the list are evaluated, and consecutive strings are
-  ;; concatenated.
-  ;; Array `forms--elements' is constructed that contains the order
-  ;; of the fields on the display. This array is used by 
-  ;; `forms--parser-using-text-properties' to extract the fields data
-  ;; from the form on the screen.
-  ;; Upon completion, `forms-format-list' is guaranteed correct, so
-  ;; `forms--make-format' and `forms--make-parser' do not need to perform
-  ;; any checks.
-
-  ;; Verify that `forms-format-list' is not nil.
-  (or forms-format-list
-      (error (concat "Forms control file error: "
-		     "'forms-format-list' has not been set")))
-  ;; It must be a list.
-  (or (listp forms-format-list)
-      (error (concat "Forms control file error: "
-		     "'forms-format-list' is not a list")))
-
-  ;; Assume every field is painted once.
-  ;; `forms--elements' will grow if needed.
-  (setq forms--elements (make-vector forms-number-of-fields nil))
-
-  (let ((the-list forms-format-list)	; the list of format elements
-	(this-item 0)			; element in list
-	(prev-item nil)
-	(field-num 0))			; highest field number 
-
-    (setq forms-format-list nil)	; gonna rebuild
-
-    (while the-list
-
-      (let ((el (car-safe the-list))
-	    (rem (cdr-safe the-list)))
-
-	;; If it is a symbol, eval it first.
-	(if (and (symbolp el)
-		 (boundp el))
-	    (setq el (eval el)))
-
-	(cond
-
-	 ;; Try string ...
-	 ((stringp el)
-	  (if (stringp prev-item)	; try to concatenate strings
-	      (setq prev-item (concat prev-item el))
-	    (if prev-item
-		(setq forms-format-list
-		      (append forms-format-list (list prev-item) nil)))
-	    (setq prev-item el)))
-
-	 ;; Try numeric ...
-	 ((numberp el) 
-
-	  ;; Validate range.
-	  (if (or (<= el 0)
-		  (> el forms-number-of-fields))
-	      (error (concat "Forms format error: "
-			     "field number %d out of range 1..%d")
-		     el forms-number-of-fields))
-
-	  ;; Store forms order.
-	  (if (> field-num (length forms--elements))
-	      (setq forms--elements (vconcat forms--elements (1- el)))
-	    (aset forms--elements field-num (1- el)))
-	  (setq field-num (1+ field-num))
-
-	  (if prev-item
-	      (setq forms-format-list
-		    (append forms-format-list (list prev-item) nil)))
-	  (setq prev-item el))
-
-	 ;; Try function ...
-	 ((listp el)
-
-	  ;; Validate.
-	  (or (fboundp (car-safe el))
-	      (error (concat "Forms format error: "
-			     "not a function %S")
-		     (car-safe el)))
-
-	  ;; Shift.
-	  (if prev-item
-	      (setq forms-format-list
-		    (append forms-format-list (list prev-item) nil)))
-	  (setq prev-item el))
-
-	 ;; else
-	 (t
-	  (error (concat "Forms format error: "
-			 "invalid element %S")
-		 el)))
-
-	;; Advance to next element of the list.
-	(setq the-list rem)))
-
-    ;; Append last item.
-    (if prev-item
-	(progn
-	  (setq forms-format-list
-		(append forms-format-list (list prev-item) nil))
-	  ;; Append a newline if the last item is a field.
-	  ;; This prevents parsing problems.
-	  ;; Also it makes it possible to insert an empty last field.
-	  (if (numberp prev-item)
-	      (setq forms-format-list
-		    (append forms-format-list (list "\n") nil))))))
-
-  (forms--debug 'forms-format-list
-		'forms--elements))
-
-;; Special treatment for read-only segments.
-;;
-;; If text is inserted between two read-only segments, it inherits the
-;; read-only properties.  This is not what we want.
-;; To solve this, read-only segments get the `insert-in-front-hooks'
-;; property set with a function that temporarily switches the properties
-;; of the first character of the segment to read-write, so the new
-;; text gets the right properties.
-;; The `post-command-hook' is used to restore the original properties.
-
-(defvar forms--iif-start nil
-  "Record start of modification command.")
-(defvar forms--iif-properties nil
-  "Original properties of the character being overridden.")
-
-(defun forms--iif-hook (begin end)
-  "`insert-in-front-hooks' function for read-only segments."
-
-  ;; Note start location.  By making it a marker that points one 
-  ;; character beyond the actual location, it is guaranteed to move 
-  ;; correctly if text is inserted.
-  (or forms--iif-start
-      (setq forms--iif-start (copy-marker (1+ (point)))))
-
-  ;; Check if there is special treatment required.
-  (if (or (<= forms--iif-start 2)
-	  (get-text-property (- forms--iif-start 2)
-			     'read-only))
-      (progn
-	;; Fetch current properties.
-	(setq forms--iif-properties 
-	      (text-properties-at (1- forms--iif-start)))
-
-	;; Replace them.
-	(let ((inhibit-read-only t))
-	  (set-text-properties 
-	   (1- forms--iif-start) forms--iif-start
-	   (list 'face forms--rw-face 'front-sticky '(face))))
-
-	;; Enable `post-command-hook' to restore the properties.
-	(setq post-command-hook
-	      (append (list 'forms--iif-post-command-hook) post-command-hook)))
-
-    ;; No action needed.  Clear marker.
-    (setq forms--iif-start nil)))
-
-(defun forms--iif-post-command-hook ()
-  "`post-command-hook' function for read-only segments."
-
-  ;; Disable `post-command-hook'.
-  (setq post-command-hook
-	(delq 'forms--iif-hook-post-command-hook post-command-hook))
-
-  ;; Restore properties.
-  (if forms--iif-start
-      (let ((inhibit-read-only t))
-	(set-text-properties 
-	 (1- forms--iif-start) forms--iif-start
-	 forms--iif-properties)))
-
-  ;; Cleanup.
-  (setq forms--iif-start nil))
-
-(defvar forms--marker)
-(defvar forms--dyntext)
-
-(defun forms--make-format ()
-  "Generate `forms--format' using the information in `forms-format-list'."
-
-  ;; The real work is done using a mapcar of `forms--make-format-elt' on
-  ;; `forms-format-list'.
-  ;; This function sets up the necessary environment, and decides
-  ;; which function to mapcar.
-
-  (let ((forms--marker 0)
-	(forms--dyntext 0))
-    (setq 
-     forms--format
-     (if forms-use-text-properties 
-	 (` (lambda (arg)
-	      (let ((inhibit-read-only t))
-		(,@ (apply 'append
-			   (mapcar 'forms--make-format-elt-using-text-properties
-				   forms-format-list)))
-		;; Prevent insertion before the first text.
-		(,@ (if (numberp (car forms-format-list))
-			nil
-		      '((add-text-properties (point-min) (1+ (point-min))
-					     '(front-sticky (read-only intangible))))))
-		;; Prevent insertion after the last text.
-		(remove-text-properties (1- (point)) (point)
-					'(rear-nonsticky)))
-	      (setq forms--iif-start nil)))
-       (` (lambda (arg)
-	    (,@ (apply 'append
-		       (mapcar 'forms--make-format-elt forms-format-list)))))))
-
-    ;; We have tallied the number of markers and dynamic texts,
-    ;; so we can allocate the arrays now.
-    (setq forms--markers (make-vector forms--marker nil))
-    (setq forms--dyntexts (make-vector forms--dyntext nil)))
-  (forms--debug 'forms--format))
-
-(defun forms--make-format-elt-using-text-properties (el)
-  "Helper routine to generate format function."
-
-  ;; The format routine `forms--format' will look like
-  ;;
-  ;; ;; preamble
-  ;; (lambda (arg)
-  ;;   (let ((inhibit-read-only t))
-  ;;
-  ;;     ;; A string, e.g. "text: ".
-  ;;     (set-text-properties 
-  ;;      (point)
-  ;;      (progn (insert "text: ") (point)) 
-  ;;      (list 'face forms--ro-face
-  ;;		'read-only 1
-  ;;		'insert-in-front-hooks 'forms--iif-hook
-  ;;		'rear-nonsticky '(read-only face insert-in-front-hooks)))
-  ;;
-  ;;     ;; A field, e.g. 6.
-  ;;     (let ((here (point)))
-  ;;       (aset forms--markers 0 (point-marker))
-  ;;       (insert (elt arg 5))
-  ;;       (or (= (point) here)
-  ;; 	  (set-text-properties 
-  ;; 	   here (point)
-  ;; 	   (list 'face forms--rw-face
-  ;;		 'front-sticky '(face))))
-  ;;
-  ;;     ;; Another string, e.g. "\nmore text: ".
-  ;;     (set-text-properties
-  ;;      (point)
-  ;;      (progn (insert "\nmore text: ") (point))
-  ;;      (list 'face forms--ro-face
-  ;;		'read-only 2
-  ;;		'insert-in-front-hooks 'forms--iif-hook
-  ;;		'rear-nonsticky '(read-only face insert-in-front-hooks)))
-  ;;
-  ;;     ;; A function, e.g. (tocol 40).
-  ;;     (set-text-properties
-  ;;      (point)
-  ;;      (progn
-  ;;        (insert (aset forms--dyntexts 0 (tocol 40)))
-  ;;        (point))
-  ;;      (list 'face forms--ro-face
-  ;;		'read-only 2
-  ;;		'insert-in-front-hooks 'forms--iif-hook
-  ;;		'rear-nonsticky '(read-only face insert-in-front-hooks)))
-  ;;
-  ;;	 ;; Prevent insertion before the first text.
-  ;;	 (add-text-properties (point-min) (1+ (point-min))
-  ;;			      '(front-sticky (read-only))))))
-  ;;	 ;; Prevent insertion after the last text.
-  ;;	 (remove-text-properties (1- (point)) (point)
-  ;;	 			 '(rear-nonsticky)))
-  ;;
-  ;;     ;; wrap up
-  ;;     (setq forms--iif-start nil)
-  ;;     ))
-
-  (cond
-   ((stringp el)
-    
-    (` ((set-text-properties 
-	 (point)			; start at point
-	 (progn				; until after insertion
-	   (insert (, el))
-	   (point))
-	 (list 'face forms--ro-face	; read-only appearance
-	       'read-only (,@ (list (1+ forms--marker)))
-	       'intangible t
-	       'insert-in-front-hooks '(forms--iif-hook)
-	       'rear-nonsticky '(face read-only insert-in-front-hooks
-				 intangible))))))
-    
-   ((numberp el)
-    (` ((let ((here (point)))
-	  (aset forms--markers 
-		(, (prog1 forms--marker
-		     (setq forms--marker (1+ forms--marker))))
-		(point-marker))
-	  (insert (elt arg (, (1- el))))
-	  (or (= (point) here)
-	      (set-text-properties 
-	       here (point)
-	       (list 'face forms--rw-face
-		     'front-sticky '(face))))))))
-
-   ((listp el)
-    (` ((set-text-properties
-	 (point)
-	 (progn
-	   (insert (aset forms--dyntexts 
-			 (, (prog1 forms--dyntext
-			      (setq forms--dyntext (1+ forms--dyntext))))
-			 (, el)))
-	   (point))
-	 (list 'face forms--ro-face
-	       'read-only (,@ (list (1+ forms--marker)))
-	       'intangible t
-	       'insert-in-front-hooks '(forms--iif-hook)
-	       'rear-nonsticky '(read-only face insert-in-front-hooks
-				 intangible))))))
-
-   ;; end of cond
-   ))
-
-(defun forms--make-format-elt (el)
-  "Helper routine to generate format function."
-
-  ;; If we're not using text properties, the format routine
-  ;; `forms--format' will look like
-  ;;
-  ;; (lambda (arg)
-  ;;   ;; a string, e.g. "text: "
-  ;;   (insert "text: ")
-  ;;   ;; a field, e.g. 6
-  ;;   (aset forms--markers 0 (point-marker))
-  ;;   (insert (elt arg 5))
-  ;;   ;; another string, e.g. "\nmore text: "
-  ;;   (insert "\nmore text: ")
-  ;;   ;; a function, e.g. (tocol 40)
-  ;;   (insert (aset forms--dyntexts 0 (tocol 40)))
-  ;;   ... )
-
-  (cond 
-   ((stringp el)
-    (` ((insert (, el)))))
-   ((numberp el)
-    (prog1
-	(` ((aset forms--markers (, forms--marker) (point-marker))
-	    (insert (elt arg (, (1- el))))))
-      (setq forms--marker (1+ forms--marker))))
-   ((listp el)
-    (prog1
-	(` ((insert (aset forms--dyntexts (, forms--dyntext) (, el)))))
-      (setq forms--dyntext (1+ forms--dyntext))))))
-
-(defvar forms--field)
-(defvar forms--recordv)
-(defvar forms--seen-text)
-
-(defun forms--make-parser ()
-  "Generate `forms--parser' from the information in `forms-format-list'."
-
-  ;; If we can use text properties, we simply set it to
-  ;; `forms--parser-using-text-properties'.
-  ;; Otherwise, the function is constructed using a mapcar of
-  ;; `forms--make-parser-elt on `forms-format-list'.
-
-  (setq
-   forms--parser
-   (if forms-use-text-properties
-       (function forms--parser-using-text-properties)
-     (let ((forms--field nil)
-	   (forms--seen-text nil)
-	   (forms--dyntext 0))
-
-       ;; Note: we add a nil element to the list passed to `mapcar',
-       ;; see `forms--make-parser-elt' for details.
-       (` (lambda nil
-	    (let (here)
-	      (goto-char (point-min))
-	      (,@ (apply 'append
-			 (mapcar 
-			  'forms--make-parser-elt 
-			  (append forms-format-list (list nil)))))))))))
-
-  (forms--debug 'forms--parser))
-
-(defun forms--parser-using-text-properties ()
-  "Extract field info from forms when using text properties."
-
-  ;; Using text properties, we can simply jump to the markers, and
-  ;; extract the information up to the following read-only segment.
-
-  (let ((i 0)
-	here there)
-    (while (< i (length forms--markers))
-      (goto-char (setq here (aref forms--markers i)))
-      (if (get-text-property here 'read-only)
-	  (aset forms--recordv (aref forms--elements i) nil)
-	(if (setq there 
-		  (next-single-property-change here 'read-only))
-	    (aset forms--recordv (aref forms--elements i)
-		  (buffer-substring-no-properties here there))
-	  (aset forms--recordv (aref forms--elements i)
-		(buffer-substring-no-properties here (point-max)))))
-      (setq i (1+ i)))))
-
-(defun forms--make-parser-elt (el)
-  "Helper routine to generate forms parser function."
-
-  ;; The parse routine will look like:
-  ;;
-  ;; (lambda nil
-  ;;   (let (here)
-  ;;     (goto-char (point-min))
-  ;; 
-  ;;	 ;;  "text: "
-  ;;     (if (not (looking-at "text: "))
-  ;; 	    (error "Parse error: cannot find \"text: \""))
-  ;;     (forward-char 6)	; past "text: "
-  ;; 
-  ;;     ;;  6
-  ;;	 ;;  "\nmore text: "
-  ;;     (setq here (point))
-  ;;     (if (not (search-forward "\nmore text: " nil t nil))
-  ;; 	    (error "Parse error: cannot find \"\\nmore text: \""))
-  ;;     (aset forms--recordv 5 (buffer-substring-no-properties here (- (point) 12)))
-  ;;
-  ;;	 ;;  (tocol 40)
-  ;;	(let ((forms--dyntext (car-safe forms--dynamic-text)))
-  ;;	  (if (not (looking-at (regexp-quote forms--dyntext)))
-  ;;	      (error "Parse error: not looking at \"%s\"" forms--dyntext))
-  ;;	  (forward-char (length forms--dyntext))
-  ;;	  (setq forms--dynamic-text (cdr-safe forms--dynamic-text)))
-  ;;     ... 
-  ;;     ;; final flush (due to terminator sentinel, see below)
-  ;;	(aset forms--recordv 7 (buffer-substring-no-properties (point) (point-max)))
-
-  (cond
-   ((stringp el)
-    (prog1
-	(if forms--field
-	    (` ((setq here (point))
-		(if (not (search-forward (, el) nil t nil))
-		    (error "Parse error: cannot find \"%s\"" (, el)))
-		(aset forms--recordv (, (1- forms--field))
-		      (buffer-substring-no-properties here
-					(- (point) (, (length el)))))))
-	  (` ((if (not (looking-at (, (regexp-quote el))))
-		  (error "Parse error: not looking at \"%s\"" (, el)))
-	      (forward-char (, (length el))))))
-      (setq forms--seen-text t)
-      (setq forms--field nil)))
-   ((numberp el)
-    (if forms--field
-	(error "Cannot parse adjacent fields %d and %d"
-	       forms--field el)
-      (setq forms--field el)
-      nil))
-   ((null el)
-    (if forms--field
-	(` ((aset forms--recordv (, (1- forms--field))
-		  (buffer-substring-no-properties (point) (point-max)))))))
-   ((listp el)
-    (prog1
-	(if forms--field
-	    (` ((let ((here (point))
-		      (forms--dyntext (aref forms--dyntexts (, forms--dyntext))))
-		  (if (not (search-forward forms--dyntext nil t nil))
-		      (error "Parse error: cannot find \"%s\"" forms--dyntext))
-		  (aset forms--recordv (, (1- forms--field))
-			(buffer-substring-no-properties here
-					  (- (point) (length forms--dyntext)))))))
-	  (` ((let ((forms--dyntext (aref forms--dyntexts (, forms--dyntext))))
-		(if (not (looking-at (regexp-quote forms--dyntext)))
-		    (error "Parse error: not looking at \"%s\"" forms--dyntext))
-		(forward-char (length forms--dyntext))))))
-      (setq forms--dyntext (1+ forms--dyntext))
-      (setq forms--seen-text t)
-      (setq forms--field nil)))
-   ))
-
-(defun forms--intuit-from-file ()
-  "Get number of fields and a default form using the data file."
-
-  ;; If `forms-number-of-fields' is not set, get it from the data file.
-  (if (null forms-number-of-fields)
-
-      ;; Need a file to do this.
-      (if (not (file-exists-p forms-file))
-	  (error "Need existing file or explicit 'forms-number-of-records'.")
-
-	;; Visit the file and extract the first record.
-	(setq forms--file-buffer (find-file-noselect forms-file))
-	(let ((read-file-filter forms-read-file-filter)
-	      (the-record))
-	  (setq the-record
-		(save-excursion
-		  (set-buffer forms--file-buffer)
-		  (let ((inhibit-read-only t))
-		    (run-hooks 'read-file-filter))
-		  (goto-char (point-min))
-		  (forms--get-record)))
-
-	  ;; This may be overkill, but try to avoid interference with 
-	  ;; the normal processing.
-	  (kill-buffer forms--file-buffer)
-
-	  ;; Count the number of fields in `the-record'.
-	  (let (the-result
-		(start-pos 0)
-		found-pos
-		(field-sep-length (length forms-field-sep)))
-	    (setq forms-number-of-fields 1)
-	    (while (setq found-pos
-			 (string-match forms-field-sep the-record start-pos))
-	      (progn
-		(setq forms-number-of-fields (1+ forms-number-of-fields))
-		(setq start-pos (+ field-sep-length found-pos))))))))
-
-  ;; Construct default format list.
-  (setq forms-format-list (list "Forms file \"" forms-file "\".\n\n"))
-  (let ((i 0))
-    (while (<= (setq i (1+ i)) forms-number-of-fields)
-      (setq forms-format-list
-	    (append forms-format-list
-		    (list (format "%4d: " i) i "\n"))))))
-
-(defun forms--set-keymaps ()
-  "Set the keymaps used in this mode."
-
-  (use-local-map (if forms-read-only 
-		     forms-mode-ro-map 
-		   forms-mode-edit-map)))
-
-(defun forms--mode-commands ()
-  "Fill the Forms mode keymaps."
-
-  ;; `forms-mode-map' is always accessible via \C-c prefix.
-  (setq forms-mode-map (make-keymap))
-  (define-key forms-mode-map "\t" 'forms-next-field)
-  (define-key forms-mode-map "\C-k" 'forms-delete-record)
-  (define-key forms-mode-map "\C-q" 'forms-toggle-read-only)
-  (define-key forms-mode-map "\C-o" 'forms-insert-record)
-  (define-key forms-mode-map "\C-l" 'forms-jump-record)
-  (define-key forms-mode-map "\C-n" 'forms-next-record)
-  (define-key forms-mode-map "\C-p" 'forms-prev-record)
-  (define-key forms-mode-map "\C-r" 'forms-search-backward)
-  (define-key forms-mode-map "\C-s" 'forms-search-forward)
-  (define-key forms-mode-map "\C-x" 'forms-exit)
-  (define-key forms-mode-map "<" 'forms-first-record)
-  (define-key forms-mode-map ">" 'forms-last-record)
-  (define-key forms-mode-map "\C-?" 'forms-prev-record)
-
-  ;; `forms-mode-ro-map' replaces the local map when in read-only mode.
-  (setq forms-mode-ro-map (make-keymap))
-  (suppress-keymap forms-mode-ro-map)
-  (define-key forms-mode-ro-map "\C-c" forms-mode-map)
-  (define-key forms-mode-ro-map "\t" 'forms-next-field)
-  (define-key forms-mode-ro-map "q" 'forms-toggle-read-only)
-  (define-key forms-mode-ro-map "l" 'forms-jump-record)
-  (define-key forms-mode-ro-map "n" 'forms-next-record)
-  (define-key forms-mode-ro-map "p" 'forms-prev-record)
-  (define-key forms-mode-ro-map "r" 'forms-search-backward)
-  (define-key forms-mode-ro-map "s" 'forms-search-forward)
-  (define-key forms-mode-ro-map "x" 'forms-exit)
-  (define-key forms-mode-ro-map "<" 'forms-first-record)
-  (define-key forms-mode-ro-map ">" 'forms-last-record)
-  (define-key forms-mode-ro-map "?" 'describe-mode)
-  (define-key forms-mode-ro-map " " 'forms-next-record)
-  (forms--mode-commands1 forms-mode-ro-map)
-  (forms--mode-menu-ro forms-mode-ro-map)
-
-  ;; This is the normal, local map.
-  (setq forms-mode-edit-map (make-keymap))
-  (define-key forms-mode-edit-map "\t"   'forms-next-field)
-  (define-key forms-mode-edit-map "\C-c" forms-mode-map)
-  (forms--mode-commands1 forms-mode-edit-map)
-  (forms--mode-menu-edit forms-mode-edit-map)
-  )
-
-(defun forms--mode-menu-ro (map)
-;;; Menu initialisation
-;  (define-key map [menu-bar] (make-sparse-keymap))
-  (define-key map [menu-bar forms]
-    (cons "Forms" (make-sparse-keymap "Forms")))
-  (define-key map [menu-bar forms menu-forms-exit]
-    '("Exit Forms Mode" . forms-exit))
-  (define-key map [menu-bar forms menu-forms-sep1]
-    '("----"))
-  (define-key map [menu-bar forms menu-forms-save]
-    '("Save Data" . forms-save-buffer))
-  (define-key map [menu-bar forms menu-forms-print]
-    '("Print Data" . forms-print))
-  (define-key map [menu-bar forms menu-forms-describe]
-    '("Describe Mode" . describe-mode))
-  (define-key map [menu-bar forms menu-forms-toggle-ro]
-    '("Toggle View/Edit" . forms-toggle-read-only))
-  (define-key map [menu-bar forms menu-forms-jump-record]
-    '("Jump" . forms-jump-record))
-  (define-key map [menu-bar forms menu-forms-search-backward]
-    '("Search Backward" . forms-search-backward))
-  (define-key map [menu-bar forms menu-forms-search-forward]
-    '("Search Forward" . forms-search-forward))
-  (define-key map [menu-bar forms menu-forms-delete-record]
-    '("Delete" . forms-delete-record))
-  (define-key map [menu-bar forms menu-forms-insert-record]
-    '("Insert" . forms-insert-record))
-  (define-key map [menu-bar forms menu-forms-sep2]
-    '("----"))
-  (define-key map [menu-bar forms menu-forms-last-record]
-    '("Last Record" . forms-last-record))
-  (define-key map [menu-bar forms menu-forms-first-record]
-    '("First Record" . forms-first-record))
-  (define-key map [menu-bar forms menu-forms-prev-record]
-    '("Previous Record" . forms-prev-record))
-  (define-key map [menu-bar forms menu-forms-next-record]
-    '("Next Record" . forms-next-record))
-  (define-key map [menu-bar forms menu-forms-sep3]
-    '("----"))
-  (define-key map [menu-bar forms menu-forms-prev-field]
-    '("Previous Field" . forms-prev-field))
-  (define-key map [menu-bar forms menu-forms-next-field]
-    '("Next Field" . forms-next-field))
-  (put 'forms-insert-record 'menu-enable '(not forms-read-only))
-  (put 'forms-delete-record 'menu-enable '(not forms-read-only))
-)
-(defun forms--mode-menu-edit (map)
-;;; Menu initialisation
-;  (define-key map [menu-bar] (make-sparse-keymap))
-  (define-key map [menu-bar forms]
-    (cons "Forms" (make-sparse-keymap "Forms")))
-  (define-key map [menu-bar forms menu-forms-edit--exit]
-    '("Exit" . forms-exit))
-  (define-key map [menu-bar forms menu-forms-edit-sep1]
-    '("----"))
-  (define-key map [menu-bar forms menu-forms-edit-save]
-    '("Save Data" . forms-save-buffer))
-  (define-key map [menu-bar forms menu-forms-edit-print]
-    '("Print Data" . forms-print))
-  (define-key map [menu-bar forms menu-forms-edit-describe]
-    '("Describe Mode" . describe-mode))
-  (define-key map [menu-bar forms menu-forms-edit-toggle-ro]
-    '("Toggle View/Edit" . forms-toggle-read-only))
-  (define-key map [menu-bar forms menu-forms-edit-jump-record]
-    '("Jump" . forms-jump-record))
-  (define-key map [menu-bar forms menu-forms-edit-search-backward]
-    '("Search Backward" . forms-search-backward))
-  (define-key map [menu-bar forms menu-forms-edit-search-forward]
-    '("Search Forward" . forms-search-forward))
-  (define-key map [menu-bar forms menu-forms-edit-delete-record]
-    '("Delete" . forms-delete-record))
-  (define-key map [menu-bar forms menu-forms-edit-insert-record]
-    '("Insert" . forms-insert-record))
-  (define-key map [menu-bar forms menu-forms-edit-sep2]
-    '("----"))
-  (define-key map [menu-bar forms menu-forms-edit-last-record]
-    '("Last Record" . forms-last-record))
-  (define-key map [menu-bar forms menu-forms-edit-first-record]
-    '("First Record" . forms-first-record))
-  (define-key map [menu-bar forms menu-forms-edit-prev-record]
-    '("Previous Record" . forms-prev-record))
-  (define-key map [menu-bar forms menu-forms-edit-next-record]
-    '("Next Record" . forms-next-record))
-  (define-key map [menu-bar forms menu-forms-edit-sep3]
-    '("----"))
-  (define-key map [menu-bar forms menu-forms-edit-prev-field]
-    '("Previous Field" . forms-prev-field))
-  (define-key map [menu-bar forms menu-forms-edit-next-field]
-    '("Next Field" . forms-next-field))
-  (put 'forms-insert-record 'menu-enable '(not forms-read-only))
-  (put 'forms-delete-record 'menu-enable '(not forms-read-only))
-)
-
-(defun forms--mode-commands1 (map) 
-  "Helper routine to define keys."
-  (define-key map [TAB] 'forms-next-field)
-  (define-key map [S-tab] 'forms-prev-field)
-  (define-key map [next] 'forms-next-record)
-  (define-key map [prior] 'forms-prev-record)
-  (define-key map [begin] 'forms-first-record)
-  (define-key map [last] 'forms-last-record)
-  (define-key map [backtab] 'forms-prev-field)
-  )
-
-;;; Changed functions
-
-(defun forms--change-commands ()
-  "Localize some commands for Forms mode."
-
-  ;; scroll-down -> forms-prev-record
-  ;; scroll-up -> forms-next-record
-  (if forms-forms-scroll
-      (progn
-	(substitute-key-definition 'scroll-up 'forms-next-record
-				   (current-local-map)
-				   (current-global-map))
-	(substitute-key-definition 'scroll-down 'forms-prev-record
-				   (current-local-map)
-				   (current-global-map))))
-  ;;
-  ;; beginning-of-buffer -> forms-first-record
-  ;; end-of-buffer -> forms-end-record
-  (if forms-forms-jump
-      (progn
-	(substitute-key-definition 'beginning-of-buffer 'forms-first-record
-				   (current-local-map)
-				   (current-global-map))
-	(substitute-key-definition 'end-of-buffer 'forms-last-record
-				   (current-local-map)
-				   (current-global-map))))
-  ;;
-  ;; Save buffer
-  (local-set-key "\C-x\C-s" 'forms-save-buffer)
-  ;;
-  ;; We have our own revert function - use it.
-  (make-local-variable 'revert-buffer-function)
-  (setq revert-buffer-function 'forms--revert-buffer)
-
-  t)
-
-(defun forms--help ()
-  "Initial help for Forms mode."
-  (message "%s" (substitute-command-keys (concat
-  "\\[forms-next-record]:next"
-  "   \\[forms-prev-record]:prev"
-  "   \\[forms-first-record]:first"
-  "   \\[forms-last-record]:last"
-  "   \\[describe-mode]:help"))))
-
-(defun forms--trans (subj arg rep)
-  "Translate in SUBJ all chars ARG into char REP.  ARG and REP should
- be single-char strings."
-  (let ((i 0)
-	(x (length subj))
-	(re (regexp-quote arg))
-	(k (string-to-char rep)))
-    (while (setq i (string-match re subj i))
-      (aset subj i k)
-      (setq i (1+ i)))))
-
-(defun forms--exit (query &optional save)
-  "Internal exit from forms mode function."
-
-  (let ((buf (buffer-name forms--file-buffer)))
-    (forms--checkmod)
-    (if (and save
-	     (buffer-modified-p forms--file-buffer))
-	(forms-save-buffer))
-    (save-excursion
-      (set-buffer forms--file-buffer)
-      (delete-auto-save-file-if-necessary)
-      (kill-buffer (current-buffer)))
-    (if (get-buffer buf)	; not killed???
-      (if save
-	  (progn
-	    (beep)
-	    (message "Problem saving buffers?")))
-      (delete-auto-save-file-if-necessary)
-      (kill-buffer (current-buffer)))))
-
-(defun forms--get-record ()
-  "Fetch the current record from the file buffer."
-
-  ;; This function is executed in the context of the `forms--file-buffer'.
-
-  (or (bolp)
-      (beginning-of-line nil))
-  (let ((here (point)))
-    (prog2
-     (end-of-line)
-     (buffer-substring-no-properties here (point))
-     (goto-char here))))
-
-(defun forms--show-record (the-record)
-  "Format THE-RECORD and display it in the current buffer."
-
-  ;; Split the-record.
-  (let (the-result
-	(start-pos 0)
-	found-pos
-	(field-sep-length (length forms-field-sep)))
-    (if forms-multi-line
-	(forms--trans the-record forms-multi-line "\n"))
-    ;; Add an extra separator (makes splitting easy).
-    (setq the-record (concat the-record forms-field-sep))
-    (while (setq found-pos (string-match forms-field-sep the-record start-pos))
-      (let ((ent (substring the-record start-pos found-pos)))
-	(setq the-result
-	      (append the-result (list ent)))
-	(setq start-pos (+ field-sep-length found-pos))))
-    (setq forms--the-record-list the-result))
-
-  (setq buffer-read-only nil)
-  (if forms-use-text-properties
-      (let ((inhibit-read-only t))
-	(set-text-properties (point-min) (point-max) nil)))
-  (erase-buffer)
-
-  ;; Verify the number of fields, extend forms--the-record-list if needed.
-  (if (= (length forms--the-record-list) forms-number-of-fields)
-      nil
-    (if (null forms-check-number-of-fields)
-	nil
-      (beep)
-      (message "Warning: this record has %d fields instead of %d"
-	       (length forms--the-record-list) forms-number-of-fields))
-    (if (< (length forms--the-record-list) forms-number-of-fields)
-	(setq forms--the-record-list 
-	      (append forms--the-record-list
-		      (make-list 
-		       (- forms-number-of-fields 
-			  (length forms--the-record-list))
-		       "")))))
-
-  ;; Call the formatter function.
-  (setq forms-fields (append (list nil) forms--the-record-list nil))
-  (funcall forms--format forms--the-record-list)
-
-  ;; Prepare.
-  (goto-char (point-min))
-  (set-buffer-modified-p nil)
-  (setq buffer-read-only forms-read-only)
-  (setq mode-line-process
-	(concat " " forms--current-record "/" forms--total-records)))
-
-(defun forms--parse-form ()
-  "Parse contents of form into list of strings."
-  ;; The contents of the form are parsed, and a new list of strings
-  ;; is constructed.
-  ;; A vector with the strings from the original record is 
-  ;; constructed, which is updated with the new contents.  Therefore
-  ;; fields which were not in the form are not modified.
-  ;; Finally, the vector is transformed into a list for further processing.
-
-  (let (forms--recordv)
-
-    ;; Build the vector.
-    (setq forms--recordv (vconcat forms--the-record-list))
-
-    ;; Parse the form and update the vector.
-    (let ((forms--dynamic-text forms--dynamic-text))
-      (funcall forms--parser))
-
-    (if forms-modified-record-filter
-	;; As a service to the user, we add a zeroth element so she
-	;; can use the same indices as in the forms definition.
-	(let ((the-fields (vconcat [nil] forms--recordv)))
-	  (setq the-fields (funcall forms-modified-record-filter the-fields))
-	  (cdr (append the-fields nil)))
-
-      ;; Transform to a list and return.
-      (append forms--recordv nil))))
-
-(defun forms--update ()
-  "Update current record with contents of form.
-As a side effect: sets `forms--the-record-list'."
-
-  (if forms-read-only
-      (progn
-	(message "Read-only buffer!")
-	(beep))
-
-    (let (the-record)
-      ;; Build new record.
-      (setq forms--the-record-list (forms--parse-form))
-      (setq the-record
-	    (mapconcat 'identity forms--the-record-list forms-field-sep))
-
-      (if (string-match (regexp-quote forms-field-sep)
-			(mapconcat 'identity forms--the-record-list ""))
-	  (error "Field separator occurs in record - update refused!"))
-
-      ;; Handle multi-line fields, if allowed.
-      (if forms-multi-line
-	  (forms--trans the-record "\n" forms-multi-line))
-
-      ;; A final sanity check before updating.
-      (if (string-match "\n" the-record)
-	  (progn
-	    (message "Multi-line fields in this record - update refused!")
-	    (beep))
-
-	(save-excursion
-	  (set-buffer forms--file-buffer)
-	  ;; Use delete-region instead of kill-region, to avoid
-	  ;; adding junk to the kill-ring.
-	  (delete-region (save-excursion (beginning-of-line) (point))
-			 (save-excursion (end-of-line) (point)))
-	  (insert the-record)
-	  (beginning-of-line))))))
-
-(defun forms--checkmod ()
-  "Check if this form has been modified, and call forms--update if so."
-  (if (buffer-modified-p nil)
-      (let ((here (point)))
-	(forms--update)
-	(set-buffer-modified-p nil)
-	(goto-char here))))
-
-;;; Start and exit
-
-;;;###autoload
-(defun forms-find-file (fn)
-  "Visit a file in Forms mode."
-  (interactive "fForms file: ")
-  (let ((enable-local-eval t)
-	(enable-local-variables t))
-    (find-file-read-only fn)
-    (or forms--mode-setup (forms-mode t))))
-
-;;;###autoload
-(defun forms-find-file-other-window (fn)
-  "Visit a file in Forms mode in other window."
-  (interactive "fFbrowse file in other window: ")
-  (let ((enable-local-eval t)
-	(enable-local-variables t))
-    (find-file-other-window fn)
-    (or forms--mode-setup (forms-mode t))))
-
-(defun forms-exit (query)
-  "Normal exit from Forms mode.  Modified buffers are saved."
-  (interactive "P")
-  (forms--exit query t))
-
-(defun forms-exit-no-save (query)
-  "Exit from Forms mode without saving buffers."
-  (interactive "P")
-  (forms--exit query nil))
-
-;;; Navigating commands
-
-(defun forms-next-record (arg)
-  "Advance to the ARGth following record."
-  (interactive "P")
-  (forms-jump-record (+ forms--current-record (prefix-numeric-value arg)) t))
-
-(defun forms-prev-record (arg)
-  "Advance to the ARGth previous record."
-  (interactive "P")
-  (forms-jump-record (- forms--current-record (prefix-numeric-value arg)) t))
-
-(defun forms-jump-record (arg &optional relative)
-  "Jump to a random record."
-  (interactive "NRecord number: ")
-
-  ;; Verify that the record number is within range.
-  (if (or (> arg forms--total-records)
-	  (<= arg 0))
-    (progn
-      (beep)
-      ;; Don't give the message if just paging.
-      (if (not relative)
-	  (message "Record number %d out of range 1..%d"
-		   arg forms--total-records))
-      )
-
-    ;; Flush.
-    (forms--checkmod)
-
-    ;; Calculate displacement.
-    (let ((disp (- arg forms--current-record))
-	  (cur forms--current-record))
-
-      ;; `forms--show-record' needs it now.
-      (setq forms--current-record arg)
-
-      ;; Get the record and show it.
-      (forms--show-record
-       (save-excursion
-	 (set-buffer forms--file-buffer)
-	 (beginning-of-line)
-
-	 ;; Move, and adjust the amount if needed (shouldn't happen).
-	 (if relative
-	     (if (zerop disp)
-		 nil
-	       (setq cur (+ cur disp (- (forward-line disp)))))
-	   (setq cur (+ cur disp (- (goto-line arg)))))
-
-	 (forms--get-record)))
-
-      ;; This shouldn't happen.
-      (if (/= forms--current-record cur)
-	  (progn
-	    (setq forms--current-record cur)
-	    (beep)
-	    (message "Stuck at record %d" cur))))))
-
-(defun forms-first-record ()
-  "Jump to first record."
-  (interactive)
-  (forms-jump-record 1))
-
-(defun forms-last-record ()
-  "Jump to last record.
-As a side effect: re-calculates the number of records in the data file."
-  (interactive)
-  (let
-      ((numrec 
-	(save-excursion
-	  (set-buffer forms--file-buffer)
-	  (count-lines (point-min) (point-max)))))
-    (if (= numrec forms--total-records)
-	nil
-      (beep)
-      (setq forms--total-records numrec)
-      (message "Warning: number of records changed to %d" forms--total-records)))
-  (forms-jump-record forms--total-records))
-
-;;; Other commands
-
-(defun forms-toggle-read-only (arg)
-  "Toggles read-only mode of a forms mode buffer.
-With an argument, enables read-only mode if the argument is positive.
-Otherwise enables edit mode if the visited file is writable."
-
-  (interactive "P")
-
-  (if (if arg
-	  ;; Negative arg means switch it off.
-	  (<= (prefix-numeric-value arg) 0)
-	;; No arg means toggle.
-	forms-read-only)
-
-      ;; Enable edit mode, if possible.
-      (let ((ro forms-read-only))
-	(if (save-excursion
-	      (set-buffer forms--file-buffer)
-	      buffer-read-only)
-	    (progn
-	      (setq forms-read-only t)
-	      (message "No write access to `%s'" forms-file)
-	      (beep))
-	  (setq forms-read-only nil))
-	(if (equal ro forms-read-only)
-	    nil
-	  (forms-mode)))
-
-    ;; Enable view mode.
-    (if forms-read-only
-	nil
-      (forms--checkmod)			; sync
-      (setq forms-read-only t)
-      (forms-mode))))
-
-;; Sample:
-;; (defun my-new-record-filter (the-fields)
-;;   ;; numbers are relative to 1
-;;   (aset the-fields 4 (current-time-string))
-;;   (aset the-fields 6 (user-login-name))
-;;   the-list)
-;; (setq forms-new-record-filter 'my-new-record-filter)
-
-(defun forms-insert-record (arg)
-  "Create a new record before the current one.
-With ARG: store the record after the current one.
-If `forms-new-record-filter' contains the name of a function, 
-it is called to fill (some of) the fields with default values.
-If `forms-insert-after is non-nil, the default behavior is to insert
-after the current record."
-
-  (interactive "P")
-
-  (if forms-read-only
-      (error ""))
-
-  (let (ln the-list the-record)
-
-    (if (or (and arg forms-insert-after)
-	    (and (not arg) (not forms-insert-after)))
-	(setq ln forms--current-record)
-      (setq ln (1+ forms--current-record)))
-
-    (forms--checkmod)
-    (if forms-new-record-filter
-	;; As a service to the user, we add a zeroth element so she
-	;; can use the same indices as in the forms definition.
-	(let ((the-fields (make-vector (1+ forms-number-of-fields) "")))
-	  (setq the-fields (funcall forms-new-record-filter the-fields))
-	  (setq the-list (cdr (append the-fields nil))))
-      (setq the-list (make-list forms-number-of-fields "")))
-
-    (setq the-record
-	  (mapconcat
-	  'identity
-	  the-list
-	  forms-field-sep))
-
-    (save-excursion
-      (set-buffer forms--file-buffer)
-      (goto-line ln)
-      (open-line 1)
-      (insert the-record)
-      (beginning-of-line))
-    
-    (setq forms--current-record ln))
-
-  (setq forms--total-records (1+ forms--total-records))
-  (forms-jump-record forms--current-record))
-
-(defun forms-delete-record (arg)
-  "Deletes a record.  With a prefix argument: don't ask."
-  (interactive "P")
-
-  (if forms-read-only
-      (error ""))
-
-  (forms--checkmod)
-  (if (or arg
-	  (y-or-n-p "Really delete this record? "))
-      (let ((ln forms--current-record))
-	(save-excursion
-	  (set-buffer forms--file-buffer)
-	  (goto-line ln)
-	  ;; Use delete-region instead of kill-region, to avoid
-	  ;; adding junk to the kill-ring.
-	  (delete-region (progn (beginning-of-line) (point))
-			 (progn (beginning-of-line 2) (point))))
-	(setq forms--total-records (1- forms--total-records))
-	(if (> forms--current-record forms--total-records)
-	    (setq forms--current-record forms--total-records))
-	(forms-jump-record forms--current-record)))
-  (message ""))
-
-(defun forms-search-forward (regexp)
-  "Search forward for record containing REGEXP."
-  (interactive 
-   (list (read-string (concat "Search forward for" 
-				  (if forms--search-regexp
-				   (concat " ("
-					   forms--search-regexp
-					   ")"))
-				  ": "))))
-  (if (equal "" regexp)
-      (setq regexp forms--search-regexp))
-  (forms--checkmod)
-
-  (let (the-line the-record here
-		 (fld-sep forms-field-sep))
-    (if (save-excursion
-	  (set-buffer forms--file-buffer)
-	  (setq here (point))
-	  (end-of-line)
-	  (if (null (re-search-forward regexp nil t))
-	      (progn
-		(goto-char here)
-		(message "\"%s\" not found" regexp)
-		nil)
-	    (setq the-record (forms--get-record))
-	    (setq the-line (1+ (count-lines (point-min) (point))))))
-	(progn
-	  (setq forms--current-record the-line)
-	  (forms--show-record the-record)
-	  (re-search-forward regexp nil t))))
-  (setq forms--search-regexp regexp))
-
-(defun forms-search-backward (regexp)
-  "Search backward for record containing REGEXP."
-  (interactive 
-   (list (read-string (concat "Search backward for" 
-				  (if forms--search-regexp
-				   (concat " ("
-					   forms--search-regexp
-					   ")"))
-				  ": "))))
-  (if (equal "" regexp)
-      (setq regexp forms--search-regexp))
-  (forms--checkmod)
-
-  (let (the-line the-record here
-		 (fld-sep forms-field-sep))
-    (if (save-excursion
-	  (set-buffer forms--file-buffer)
-	  (setq here (point))
-	  (beginning-of-line)
-	  (if (null (re-search-backward regexp nil t))
-	      (progn
-		(goto-char here)
-		(message "\"%s\" not found" regexp)
-		nil)
-	    (setq the-record (forms--get-record))
-	    (setq the-line (1+ (count-lines (point-min) (point))))))
-	(progn
-	  (setq forms--current-record the-line)
-	  (forms--show-record the-record)
-	  (re-search-forward regexp nil t))))
-  (setq forms--search-regexp regexp))
-
-(defun forms-save-buffer (&optional args)
-  "Forms mode replacement for save-buffer.
-It saves the data buffer instead of the forms buffer.
-Calls `forms-write-file-filter' before writing out the data."
-  (interactive "p")
-  (forms--checkmod)
-  (let ((read-file-filter forms-read-file-filter))
-    (save-excursion
-      (set-buffer forms--file-buffer)
-      (let ((inhibit-read-only t))
-	(save-buffer args)
-	(if read-file-filter
-	    (run-hooks 'read-file-filter))
-	(set-buffer-modified-p nil))))
-  t)
-
-(defun forms--revert-buffer (&optional arg noconfirm)
-  "Reverts current form to un-modified."
-  (interactive "P")
-  (if (or noconfirm
-	  (yes-or-no-p "Revert form to unmodified? "))
-      (progn
-	(set-buffer-modified-p nil)
-	(forms-jump-record forms--current-record))))
-
-(defun forms-next-field (arg)
-  "Jump to ARG-th next field."
-  (interactive "p")
-
-  (let ((i 0)
-	(here (point))
-	there
-	(cnt 0)
-	(inhibit-point-motion-hooks t))
-
-    (if (zerop arg)
-	(setq cnt 1)
-      (setq cnt (+ cnt arg)))
-
-    (if (catch 'done
-	  (while (< i (length forms--markers))
-	    (if (or (null (setq there (aref forms--markers i)))
-		    (<= there here))
-		nil
-	      (if (<= (setq cnt (1- cnt)) 0)
-		  (progn
-		    (goto-char there)
-		    (throw 'done t))))
-	    (setq i (1+ i))))
-	nil
-      (goto-char (aref forms--markers 0)))))
-
-(defun forms-prev-field (arg)
-  "Jump to ARG-th previous field."
-  (interactive "p")
-
-  (let ((i (length forms--markers))
-	(here (point))
-	there
-	(cnt 0)
-	(inhibit-point-motion-hooks t))
-
-    (if (zerop arg)
-	(setq cnt 1)
-      (setq cnt (+ cnt arg)))
-
-    (if (catch 'done
-	  (while (> i 0)
-	    (setq i ( 1- i))
-	    (if (or (null (setq there (aref forms--markers i)))
-		    (>= there here))
-		nil
-	      (if (<= (setq cnt (1- cnt)) 0)
-		  (progn
-		    (goto-char there)
-		    (throw 'done t))))))
-	nil
-      (goto-char (aref forms--markers (1- (length forms--markers)))))))
-
-(defun forms-print ()
-  "Send the records to the printer with 'print-buffer', one record per page."
-  (interactive)
-  (let ((inhibit-read-only t)
-	(save-record forms--current-record)
-	(nb-record 1)
-	(record nil))
-    (while (<= nb-record forms--total-records)
-      (forms-jump-record nb-record)
-      (setq record (buffer-string))
-      (save-excursion
-	(set-buffer (get-buffer-create "*forms-print*"))
-	(goto-char (buffer-end 1))
-	(insert record)
-	(setq buffer-read-only nil)
-	(if (< nb-record forms--total-records)
-	    (insert "\n\n")))
-      (setq nb-record (1+ nb-record)))
-    (save-excursion
-      (set-buffer "*forms-print*")
-      (print-buffer)
-      (set-buffer-modified-p nil)
-      (kill-buffer (current-buffer)))
-    (forms-jump-record save-record)))
-
-;;;
-;;; Special service
-;;;
-(defun forms-enumerate (the-fields)
-  "Take a quoted list of symbols, and set their values to sequential numbers.
-The first symbol gets number 1, the second 2 and so on.
-It returns the highest number.
-
-Usage: (setq forms-number-of-fields
-             (forms-enumerate
-              '(field1 field2 field2 ...)))"
-
-  (let ((the-index 0))
-    (while the-fields
-      (setq the-index (1+ the-index))
-      (let ((el (car-safe the-fields)))
-	(setq the-fields (cdr-safe the-fields))
-	(set el the-index)))
-    the-index))
-
-;;; Debugging
-
-(defvar forms--debug nil
-  "*Enables forms-mode debugging if not nil.")
-
-(defun forms--debug (&rest args)
-  "Internal debugging routine."
-  (if forms--debug
-      (let ((ret nil))
-	(while args
-	  (let ((el (car-safe args)))
-	    (setq args (cdr-safe args))
-	    (if (stringp el)
-		(setq ret (concat ret el))
-	      (setq ret (concat ret (prin1-to-string el) " = "))
-	      (if (boundp el)
-		  (let ((vel (eval el)))
-		    (setq ret (concat ret (prin1-to-string vel) "\n")))
-		(setq ret (concat ret "<unbound>" "\n")))
-	      (if (fboundp el)
-		  (setq ret (concat ret (prin1-to-string (symbol-function el)) 
-				    "\n"))))))
-	(save-excursion
-	  (set-buffer (get-buffer-create "*forms-mode debug*"))
-	  (if (zerop (buffer-size))
-	      (emacs-lisp-mode))
-	  (goto-char (point-max))
-	  (insert ret)))))
-
-;;; forms.el ends here.
diff --git a/lisp/frame.el b/lisp/frame.el
deleted file mode 100644
index c97a6d3ab7f..00000000000
--- a/lisp/frame.el
+++ /dev/null
@@ -1,727 +0,0 @@
-;;; frame.el --- multi-frame management independent of window systems.
-
-;; Copyright (C) 1993, 1994 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.
-
-;;; Code:
-
-(defvar frame-creation-function nil
-  "Window-system dependent function to call to create a new frame.
-The window system startup file should set this to its frame creation
-function, which should take an alist of parameters as its argument.")
-
-;;; The initial value given here for used to ask for a minibuffer.
-;;; But that's not necessary, because the default is to have one.
-;;; By not specifying it here, we let an X resource specify it.
-(defvar initial-frame-alist nil
-  "Alist of frame parameters for creating the initial X window frame.
-You can set this in your `.emacs' file; for example,
- (setq initial-frame-alist '((top . 1) (left . 1) (width . 80) (height . 55)))
-Parameters specified here supersede the values given in `default-frame-alist'.
-
-If the value calls for a frame without a minibuffer, and you have not created
-a minibuffer frame on your own, one is created according to
-`minibuffer-frame-alist'.
-
-You can specify geometry-related options for just the initial frame
-by setting this variable in your `.emacs' file; however, they won't
-take effect until Emacs reads `.emacs', which happens after first creating
-the frame.  If you want the frame to have the proper geometry as soon
-as it appears, you need to use this three-step process:
-* Specify X resources to give the geometry you want.
-* Set `default-frame-alist' to override these options so that they
-  don't affect subsequent frames.
-* Set `initial-frame-alist' in a way that matches the X resources,
-  to override what you put in `default-frame-alist'.")
-
-(defvar minibuffer-frame-alist '((width . 80) (height . 2))
-  "Alist of frame parameters for initially creating a minibuffer frame.
-You can set this in your `.emacs' file; for example,
- (setq minibuffer-frame-alist
-   '((top . 1) (left . 1) (width . 80) (height . 2)))
-Parameters specified here supersede the values given in
-`default-frame-alist'.")
-
-(defvar pop-up-frame-alist nil
-  "Alist of frame parameters used when creating pop-up frames.
-Pop-up frames are used for completions, help, and the like.
-This variable can be set in your init file, like this:
-  (setq pop-up-frame-alist '((width . 80) (height . 20)))
-These supersede the values given in `default-frame-alist'.")
-
-(setq pop-up-frame-function
-      (function (lambda ()
-		  (make-frame pop-up-frame-alist))))
-
-(defvar special-display-frame-alist
-  '((height . 14) (width . 80) (unsplittable . t))
-  "*Alist of frame parameters used when creating special frames.
-Special frames are used for buffers whose names are in
-`special-display-buffer-names' and for buffers whose names match
-one of the regular expressions in `special-display-regexps'.
-This variable can be set in your init file, like this:
-  (setq special-display-frame-alist '((width . 80) (height . 20)))
-These supersede the values given in `default-frame-alist'.")
-
-;; Display BUFFER in its own frame, reusing an existing window if any.
-;; Return the window chosen.
-;; Currently we do not insist on selecting the window within its frame.
-;; If ARGS is an alist, use it as a list of frame parameter specs.
-;; If ARGS is a list whose car is a symbol,
-;; use (car ARGS) as a function to do the work.
-;; Pass it BUFFER as first arg, and (cdr ARGS) gives the rest of the args.
-(defun special-display-popup-frame (buffer &optional args)
-  (if (and args (symbolp (car args)))
-      (apply (car args) buffer (cdr args))
-    (let ((window (get-buffer-window buffer t)))
-      (if window
-	  ;; If we have a window already, make it visible.
-	  (let ((frame (window-frame window)))
-	    (make-frame-visible frame)
-	    (raise-frame frame)
-	    window)
-	;; If no window yet, make one in a new frame.
-	(let ((frame (make-frame (append args special-display-frame-alist))))
-	  (set-window-buffer (frame-selected-window frame) buffer)
-	  (set-window-dedicated-p (frame-selected-window frame) t)
-	  (frame-selected-window frame))))))
-
-;; Handle delete-frame events from the X server.
-(defun handle-delete-frame (event)
-  (interactive "e")
-  (let ((frame (posn-window (event-start event)))
-	(i 0)
-	(tail (frame-list)))
-    (while tail
-      (and (frame-visible-p (car tail))
-	   (not (eq (car tail) frame))
-	  (setq i (1+ i)))
-      (setq tail (cdr tail)))
-    (if (> i 0)
-	(delete-frame frame t)
-      ;; Gildea@x.org says it is ok to ask questions before terminating.
-      (save-buffers-kill-emacs))))
-
-;;;; Arrangement of frames at startup
-
-;;; 1) Load the window system startup file from the lisp library and read the
-;;; high-priority arguments (-q and the like).  The window system startup
-;;; file should create any frames specified in the window system defaults.
-;;;
-;;; 2) If no frames have been opened, we open an initial text frame.
-;;;
-;;; 3) Once the init file is done, we apply any newly set parameters
-;;; in initial-frame-alist to the frame.
-
-;; These are now called explicitly at the proper times,
-;; since that is easier to understand.
-;; Actually using hooks within Emacs is bad for future maintenance. --rms.
-;; (add-hook 'before-init-hook 'frame-initialize)
-;; (add-hook 'window-setup-hook 'frame-notice-user-settings)
-
-;;; If we create the initial frame, this is it.
-(defvar frame-initial-frame nil)
-
-;; Record the parameters used in frame-initialize to make the initial frame.
-(defvar frame-initial-frame-alist)
-
-(defvar frame-initial-geometry-arguments nil)
-
-;;; startup.el calls this function before loading the user's init
-;;; file - if there is no frame with a minibuffer open now, create
-;;; one to display messages while loading the init file.
-(defun frame-initialize ()
-
-  ;; Are we actually running under a window system at all?
-  (if (and window-system (not noninteractive) (not (eq window-system 'pc)))
-      (progn
-	;; Turn on special-display processing only if there's a window system.
-	(setq special-display-function 'special-display-popup-frame)
-
-	;; If there is no frame with a minibuffer besides the terminal
-	;; frame, then we need to create the opening frame.  Make sure
-	;; it has a minibuffer, but let initial-frame-alist omit the
-	;; minibuffer spec.
-	(or (delq terminal-frame (minibuffer-frame-list))
-	    (progn
-	      (setq frame-initial-frame-alist
-		    (append initial-frame-alist default-frame-alist))
-	      ;; Record these with their default values
-	      ;; if they don't have any values explicitly.
-	      (or (assq 'vertical-scroll-bars frame-initial-frame-alist)
-		  (setq frame-initial-frame-alist
-			(cons '(vertical-scroll-bars . t)
-			      frame-initial-frame-alist)))
-	      (or (assq 'horizontal-scroll-bars frame-initial-frame-alist)
-		  (setq frame-initial-frame-alist
-			(cons '(horizontal-scroll-bars . t)
-			      frame-initial-frame-alist)))
-	      (setq default-minibuffer-frame
-		    (setq frame-initial-frame
-			  (make-frame initial-frame-alist)))
-	      ;; Delete any specifications for window geometry parameters
-	      ;; so that we won't reapply them in frame-notice-user-settings.
-	      ;; It would be wrong to reapply them then,
-	      ;; because that would override explicit user resizing.
-	      (setq initial-frame-alist
-		    (frame-remove-geometry-params initial-frame-alist))))
-	;; At this point, we know that we have a frame open, so we
-	;; can delete the terminal frame.
-	(delete-frame terminal-frame)
-	(setq terminal-frame nil))
-
-    ;; No, we're not running a window system.  Use make-terminal-frame if
-    ;; we support that feature, otherwise arrange to cause errors.
-    (or (eq window-system 'pc)
-	(setq frame-creation-function
-	      (if (fboundp 'make-terminal-frame)
-		  'make-terminal-frame
-		(function
-		 (lambda (parameters)
-		   (error
-		    "Can't create multiple frames without a window system"))))))))
-
-;;; startup.el calls this function after loading the user's init
-;;; file.  Now default-frame-alist and initial-frame-alist contain
-;;; information to which we must react; do what needs to be done.
-(defun frame-notice-user-settings ()
-
-  ;; Make menu-bar-mode and default-frame-alist consistent.
-  (if (boundp 'menu-bar-mode)
-      (let ((default (assq 'menu-bar-lines default-frame-alist)))
-	(if default
-	    (setq menu-bar-mode (not (eq (cdr default) 0)))
-	  (setq default-frame-alist
-		(cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
-		      default-frame-alist)))))
-
-  ;; Creating and deleting frames may shift the selected frame around,
-  ;; and thus the current buffer.  Protect against that.  We don't
-  ;; want to use save-excursion here, because that may also try to set
-  ;; the buffer of the selected window, which fails when the selected
-  ;; window is the minibuffer.
-  (let ((old-buffer (current-buffer)))
-
-    ;; If the initial frame is still around, apply initial-frame-alist
-    ;; and default-frame-alist to it.
-    (if (frame-live-p frame-initial-frame)
-
-	;; The initial frame we create above always has a minibuffer.
-	;; If the user wants to remove it, or make it a minibuffer-only
-	;; frame, then we'll have to delete the current frame and make a
-	;; new one; you can't remove or add a root window to/from an
-	;; existing frame.
-	;;
-	;; NOTE: default-frame-alist was nil when we created the
-	;; existing frame.  We need to explicitly include
-	;; default-frame-alist in the parameters of the screen we
-	;; create here, so that its new value, gleaned from the user's
-	;; .emacs file, will be applied to the existing screen.
-	(if (not (eq (cdr (or (assq 'minibuffer initial-frame-alist)
-			      (assq 'minibuffer default-frame-alist)
-			      '(minibuffer . t)))
-		     t))
-	    ;; Create the new frame.
-	    (let (parms new)
-	      ;; If the frame isn't visible yet, wait till it is.
-	      ;; If the user has to position the window,
-	      ;; Emacs doesn't know its real position until
-	      ;; the frame is seen to be visible.
-	      (while (not (cdr (assq 'visibility
-				     (frame-parameters frame-initial-frame))))
-		(sleep-for 1))
-	      (setq parms (frame-parameters frame-initial-frame))
-	      ;; Get rid of `name' unless it was specified explicitly before.
-	      (or (assq 'name frame-initial-frame-alist)
-		  (setq parms (delq (assq 'name parms) parms)))
-	      (setq parms (append initial-frame-alist
-				  default-frame-alist
-				  parms
-				  nil))
-	      ;; Get rid of `reverse', because that was handled
-	      ;; when we first made the frame.
-	      (setq parms (cons '(reverse) (delq (assq 'reverse parms) parms)))
-	      (if (assq 'height frame-initial-geometry-arguments)
-		  (setq parms (frame-delete-all 'height parms)))
-	      (if (assq 'width frame-initial-geometry-arguments)
-		  (setq parms (frame-delete-all 'width parms)))
-	      (if (assq 'left frame-initial-geometry-arguments)
-		  (setq parms (frame-delete-all 'left parms)))
-	      (if (assq 'top frame-initial-geometry-arguments)
-		  (setq parms (frame-delete-all 'top parms)))
-	      (setq new
-		    (make-frame
-		     ;; Use the geometry args that created the existing
-		     ;; frame, rather than the parms we get for it.
-		     (append frame-initial-geometry-arguments
-			     '((user-size . t) (user-position . t))
-			     parms)))
-	      ;; The initial frame, which we are about to delete, may be
-	      ;; the only frame with a minibuffer.  If it is, create a
-	      ;; new one.
-	      (or (delq frame-initial-frame (minibuffer-frame-list))
-		  (make-initial-minibuffer-frame nil))
-
-	      ;; If the initial frame is serving as a surrogate
-	      ;; minibuffer frame for any frames, we need to wean them
-	      ;; onto a new frame.  The default-minibuffer-frame
-	      ;; variable must be handled similarly.
-	      (let ((users-of-initial
-		     (filtered-frame-list
-		      (function (lambda (frame)
-				  (and (not (eq frame frame-initial-frame))
-				       (eq (window-frame
-					    (minibuffer-window frame))
-					   frame-initial-frame)))))))
-		(if (or users-of-initial
-			(eq default-minibuffer-frame frame-initial-frame))
-
-		    ;; Choose an appropriate frame.  Prefer frames which
-		    ;; are only minibuffers.
-		    (let* ((new-surrogate
-			    (car
-			     (or (filtered-frame-list
-				  (function
-				   (lambda (frame)
-				     (eq (cdr (assq 'minibuffer
-						    (frame-parameters frame)))
-					 'only))))
-				 (minibuffer-frame-list))))
-			   (new-minibuffer (minibuffer-window new-surrogate)))
-
-		      (if (eq default-minibuffer-frame frame-initial-frame)
-			  (setq default-minibuffer-frame new-surrogate))
-
-		      ;; Wean the frames using frame-initial-frame as
-		      ;; their minibuffer frame.
-		      (mapcar
-		       (function
-			(lambda (frame)
-			  (modify-frame-parameters
-			   frame (list (cons 'minibuffer new-minibuffer)))))
-		       users-of-initial))))
-
-	      ;; Redirect events enqueued at this frame to the new frame.
-	      ;; Is this a good idea?
-	      (redirect-frame-focus frame-initial-frame new)
-
-	      ;; Finally, get rid of the old frame.
-	      (delete-frame frame-initial-frame t))
-
-	  ;; Otherwise, we don't need all that rigamarole; just apply
-	  ;; the new parameters.
-	  (let (newparms allparms tail)
-	    (setq allparms (append initial-frame-alist
-				   default-frame-alist))
-	    (if (assq 'height frame-initial-geometry-arguments)
-		(setq allparms (frame-delete-all 'height allparms)))
-	    (if (assq 'width frame-initial-geometry-arguments)
-		(setq allparms (frame-delete-all 'width allparms)))
-	    (if (assq 'left frame-initial-geometry-arguments)
-		(setq allparms (frame-delete-all 'left allparms)))
-	    (if (assq 'top frame-initial-geometry-arguments)
-		(setq allparms (frame-delete-all 'top allparms)))
-	    (setq tail allparms)
-	    ;; Find just the parms that have changed since we first
-	    ;; made this frame.  Those are the ones actually set by
-	    ;; the init file.  For those parms whose values we already knew
-	    ;; (such as those spec'd by command line options)
-	    ;; it is undesirable to specify the parm again
-	    ;; once the user has seen the frame and been able to alter it
-	    ;; manually.
-	    (while tail
-	      (let (newval oldval)
-		(setq oldval (assq (car (car tail))
-				   frame-initial-frame-alist))
-		(setq newval (cdr (assq (car (car tail)) allparms)))
-		(or (and oldval (eq (cdr oldval) newval))
-		    (setq newparms
-			  (cons (cons (car (car tail)) newval) newparms))))
-	      (setq tail (cdr tail)))
-	    (setq newparms (nreverse newparms))
-	    (modify-frame-parameters frame-initial-frame
-				     newparms)
-	    (if (assq 'font newparms)
-		(frame-update-faces frame-initial-frame)))))
-
-    ;; Restore the original buffer.
-    (set-buffer old-buffer)
-
-    ;; Make sure the initial frame can be GC'd if it is ever deleted.
-    ;; Make sure frame-notice-user-settings does nothing if called twice.
-    (setq frame-initial-frame nil)))
-
-(defun make-initial-minibuffer-frame (display)
-  (let ((parms (append minibuffer-frame-alist '((minibuffer . only)))))
-    (if display
-	(make-frame-on-display display parms)
-      (make-frame parms))))
-
-;; Delete from ALIST all elements whose car is KEY.
-;; Return the modified alist.
-(defun frame-delete-all (key alist)
-  (setq alist (copy-sequence alist))
-  (let ((tail alist))
-    (while tail
-      (if (eq (car (car tail)) key)
-	  (setq alist (delq (car tail) alist)))
-      (setq tail (cdr tail)))
-    alist))
-
-;;;; Creation of additional frames, and other frame miscellanea
-
-;;; Return some frame other than the current frame, creating one if
-;;; necessary.  Note that the minibuffer frame, if separate, is not
-;;; considered (see next-frame).
-(defun get-other-frame ()
-  (let ((s (if (equal (next-frame (selected-frame)) (selected-frame))
-	       (make-frame)
-	     (next-frame (selected-frame)))))
-    s))
-
-(defun next-multiframe-window ()
-  "Select the next window, regardless of which frame it is on."
-  (interactive)
-  (select-window (next-window (selected-window)
-			      (> (minibuffer-depth) 0)
-			      t)))
-
-(defun previous-multiframe-window ()
-  "Select the previous window, regardless of which frame it is on."
-  (interactive)
-  (select-window (previous-window (selected-window)
-				  (> (minibuffer-depth) 0)
-				  t)))
-
-(defun make-frame-on-display (display &optional parameters)
-  "Make a frame on display DISPLAY.
-The optional second argument PARAMETERS specifies additional frame parameters."
-  (interactive "sMake frame on display: ")
-  (make-frame (cons (cons 'display display) parameters)))
-
-(defun make-frame-command ()
-  "Make a new frame, and select it if the terminal displays only one frame."
-  (interactive)
-  (if (and window-system (not (eq window-system 'pc)))
-      (make-frame)
-    (select-frame (make-frame))))
-
-;; Alias, kept temporarily.
-(defalias 'new-frame 'make-frame)
-(defun make-frame (&optional parameters)
-  "Create a new frame, displaying the current buffer.
-
-Optional argument PARAMETERS is an alist of parameters for the new
-frame.  Specifically, PARAMETERS is a list of pairs, each having
-the form (NAME . VALUE).
-
-Here are some of the parameters allowed (not a complete list):
-
-\(name . STRING)	- The frame should be named STRING.
-
-\(height . NUMBER) - The frame should be NUMBER text lines high.  If
-	this parameter is present, the width parameter must also be
-	given.
-
-\(width . NUMBER) - The frame should be NUMBER characters in width.
-	If this parameter is present, the height parameter must also
-	be given.
-
-\(minibuffer . t) - the frame should have a minibuffer
-\(minibuffer . nil) - the frame should have no minibuffer
-\(minibuffer . only) - the frame should contain only a minibuffer
-\(minibuffer . WINDOW) - the frame should use WINDOW as its minibuffer window."
-  (interactive)
-  (let ((nframe))
-    (run-hooks 'before-make-frame-hook)
-    (setq nframe (funcall frame-creation-function parameters))
-    (run-hooks 'after-make-frame-hook)
-    nframe))
-
-(defun filtered-frame-list (predicate)
-  "Return a list of all live frames which satisfy PREDICATE."
-  (let ((frames (frame-list))
-	good-frames)
-    (while (consp frames)
-      (if (funcall predicate (car frames))
-	  (setq good-frames (cons (car frames) good-frames)))
-      (setq frames (cdr frames)))
-    good-frames))
-
-(defun minibuffer-frame-list ()
-  "Return a list of all frames with their own minibuffers."
-  (filtered-frame-list
-   (function (lambda (frame)
-	       (eq frame (window-frame (minibuffer-window frame)))))))
-
-(defun frame-remove-geometry-params (param-list)
-  "Return the parameter list PARAM-LIST, but with geometry specs removed.
-This deletes all bindings in PARAM-LIST for `top', `left', `width',
-`height', `user-size' and `user-position' parameters.
-Emacs uses this to avoid overriding explicit moves and resizings from
-the user during startup."
-  (setq param-list (cons nil param-list))
-  (let ((tail param-list))
-    (while (consp (cdr tail))
-      (if (and (consp (car (cdr tail)))
-	       (memq (car (car (cdr tail)))
-		     '(height width top left user-position user-size)))
-	  (progn
-	    (setq frame-initial-geometry-arguments
-		  (cons (car (cdr tail)) frame-initial-geometry-arguments))
-	    (setcdr tail (cdr (cdr tail))))
-	(setq tail (cdr tail)))))
-  (setq frame-initial-geometry-arguments
-	(nreverse frame-initial-geometry-arguments))
-  (cdr param-list))
-
-
-(defun other-frame (arg)
-  "Select the ARG'th different visible frame, and raise it.
-All frames are arranged in a cyclic order.
-This command selects the frame ARG steps away in that order.
-A negative ARG moves in the opposite order."
-  (interactive "p")
-  (let ((frame (selected-frame)))
-    (while (> arg 0)
-      (setq frame (next-frame frame))
-      (while (not (eq (frame-visible-p frame) t))
-	(setq frame (next-frame frame)))
-      (setq arg (1- arg)))
-    (while (< arg 0)
-      (setq frame (previous-frame frame))
-      (while (not (eq (frame-visible-p frame) t))
-	(setq frame (previous-frame frame)))
-      (setq arg (1+ arg)))
-    (raise-frame frame)
-    (select-frame frame)
-    (set-mouse-position (selected-frame) (1- (frame-width)) 0)))
-
-;;;; Frame configurations
-
-(defun current-frame-configuration ()
-  "Return a list describing the positions and states of all frames.
-Its car is `frame-configuration'.
-Each element of the cdr is a list of the form (FRAME ALIST WINDOW-CONFIG),
-where
-  FRAME is a frame object,
-  ALIST is an association list specifying some of FRAME's parameters, and
-  WINDOW-CONFIG is a window configuration object for FRAME."
-  (cons 'frame-configuration
-	(mapcar (function
-		 (lambda (frame)
-		   (list frame
-			 (frame-parameters frame)
-			 (current-window-configuration frame))))
-		(frame-list))))
-
-(defun set-frame-configuration (configuration &optional nodelete)
-  "Restore the frames to the state described by CONFIGURATION.
-Each frame listed in CONFIGURATION has its position, size, window
-configuration, and other parameters set as specified in CONFIGURATION.
-Ordinarily, this function deletes all existing frames not
-listed in CONFIGURATION.  But if optional second argument NODELETE
-is given and non-nil, the unwanted frames are iconified instead."
-  (or (frame-configuration-p configuration)
-      (signal 'wrong-type-argument
-	      (list 'frame-configuration-p configuration)))
-  (let ((config-alist (cdr configuration))
-	frames-to-delete)
-    (mapcar (function
-	     (lambda (frame)
-	       (let ((parameters (assq frame config-alist)))
-		 (if parameters
-		     (progn
-		       (modify-frame-parameters
-			frame
-			;; Since we can't set a frame's minibuffer status,
-			;; we might as well omit the parameter altogether.
-			(let* ((parms (nth 1 parameters))
-			       (mini (assq 'minibuffer parms)))
-			  (if mini (setq parms (delq mini parms)))
-			  parms))
-		       (set-window-configuration (nth 2 parameters)))
-		   (setq frames-to-delete (cons frame frames-to-delete))))))
-	    (frame-list))
-    (if nodelete
-	;; Note: making frames invisible here was tried
-	;; but led to some strange behavior--each time the frame
-	;; was made visible again, the window manager asked afresh
-	;; for where to put it.
-	(mapcar 'iconify-frame frames-to-delete)
-      (mapcar 'delete-frame frames-to-delete))))
-
-;;;; Convenience functions for accessing and interactively changing
-;;;; frame parameters.
-
-(defun frame-height (&optional frame)
-  "Return number of lines available for display on FRAME.
-If FRAME is omitted, describe the currently selected frame."
-  (cdr (assq 'height (frame-parameters frame))))
-
-(defun frame-width (&optional frame)
-  "Return number of columns available for display on FRAME.
-If FRAME is omitted, describe the currently selected frame."
-  (cdr (assq 'width (frame-parameters frame))))
-
-(defun set-default-font (font-name)
-  "Set the font of the selected frame to FONT.
-When called interactively, prompt for the name of the font to use.
-To get the frame's current default font, use `frame-parameters'."
-  (interactive "sFont name: ")
-  (modify-frame-parameters (selected-frame)
-			   (list (cons 'font font-name)))
-  ;; Update faces that want a bold or italic version of the default font.
-  (frame-update-faces (selected-frame)))
-
-(defun set-background-color (color-name)
-  "Set the background color of the selected frame to COLOR.
-When called interactively, prompt for the name of the color to use.
-To get the frame's current background color, use `frame-parameters'."
-  (interactive "sColor: ")
-  (modify-frame-parameters (selected-frame)
-			   (list (cons 'background-color color-name)))
-  (frame-update-face-colors (selected-frame)))
-
-(defun set-foreground-color (color-name)
-  "Set the foreground color of the selected frame to COLOR.
-When called interactively, prompt for the name of the color to use.
-To get the frame's current foreground color, use `frame-parameters'."
-  (interactive "sColor: ")
-  (modify-frame-parameters (selected-frame)
-			   (list (cons 'foreground-color color-name)))
-  (frame-update-face-colors (selected-frame)))
-
-(defun set-cursor-color (color-name)
-  "Set the text cursor color of the selected frame to COLOR.
-When called interactively, prompt for the name of the color to use.
-To get the frame's current cursor color, use `frame-parameters'."
-  (interactive "sColor: ")
-  (modify-frame-parameters (selected-frame)
-			   (list (cons 'cursor-color color-name))))
-
-(defun set-mouse-color (color-name)
-  "Set the color of the mouse pointer of the selected frame to COLOR.
-When called interactively, prompt for the name of the color to use.
-To get the frame's current mouse color, use `frame-parameters'."
-  (interactive "sColor: ")
-  (modify-frame-parameters (selected-frame)
-			   (list (cons 'mouse-color color-name))))
-
-(defun set-border-color (color-name)
-  "Set the color of the border of the selected frame to COLOR.
-When called interactively, prompt for the name of the color to use.
-To get the frame's current border color, use `frame-parameters'."
-  (interactive "sColor: ")
-  (modify-frame-parameters (selected-frame)
-			   (list (cons 'border-color color-name))))
-
-(defun auto-raise-mode (arg)
-  "Toggle whether or not the selected frame should auto-raise.
-With arg, turn auto-raise mode on if and only if arg is positive.
-Note that this controls Emacs's own auto-raise feature.
-Some window managers allow you to enable auto-raise for certain windows.
-You can use that for Emacs windows if you wish, but if you do,
-that is beyond the control of Emacs and this command has no effect on it."
-  (interactive "P")
-  (if (null arg)
-      (setq arg
-	    (if (cdr (assq 'auto-raise (frame-parameters (selected-frame))))
-		-1 1)))
-  (modify-frame-parameters (selected-frame)
-			   (list (cons 'auto-raise (> arg 0)))))
-
-(defun auto-lower-mode (arg)
-  "Toggle whether or not the selected frame should auto-lower.
-With arg, turn auto-lower mode on if and only if arg is positive.
-Note that this controls Emacs's own auto-lower feature.
-Some window managers allow you to enable auto-lower for certain windows.
-You can use that for Emacs windows if you wish, but if you do,
-that is beyond the control of Emacs and this command has no effect on it."
-  (interactive "P")
-  (if (null arg)
-      (setq arg
-	    (if (cdr (assq 'auto-lower (frame-parameters (selected-frame))))
-		-1 1)))
-  (modify-frame-parameters (selected-frame)
-			   (list (cons 'auto-lower (> arg 0)))))
-
-(defvar scroll-bar-side 'left
-  "*Specify which side scroll bars should be on.  Value is `left' or `right'.")
-
-(defun toggle-scroll-bar (arg)
-  "Toggle whether or not the selected frame has vertical scroll bars.
-With arg, turn vertical scroll bars on if and only if arg is positive."
-  (interactive "P")
-  (if (null arg)
-      (setq arg
-	    (if (cdr (assq 'vertical-scroll-bars
-			   (frame-parameters (selected-frame))))
-		-1 1)))
-  (modify-frame-parameters (selected-frame)
-			   (list (cons 'vertical-scroll-bars
-				       (if (> arg 0)
-					   scroll-bar-side)))))
-
-(defun toggle-horizontal-scroll-bar (arg)
-  "Toggle whether or not the selected frame has horizontal scroll bars.
-With arg, turn horizontal scroll bars on if and only if arg is positive.
-Horizontal scroll bars aren't implemented yet."
-  (interactive "P")
-  (error "Horizontal scroll bars aren't implemented yet"))
-
-
-;;;; Aliases for backward compatibility with Emacs 18.
-(defalias 'screen-height 'frame-height)
-(defalias 'screen-width 'frame-width)
-
-(defun set-screen-width (cols &optional pretend)
-  "Obsolete function to change the size of the screen to COLS columns.\n\
-Optional second arg non-nil means that redisplay should use COLS columns\n\
-but that the idea of the actual width of the frame should not be changed.\n\
-This function is provided only for compatibility with Emacs 18; new code\n\
-should use `set-frame-width instead'."
-  (set-frame-width (selected-frame) cols pretend))
-
-(defun set-screen-height (lines &optional pretend)
-  "Obsolete function to change the height of the screen to LINES lines.\n\
-Optional second arg non-nil means that redisplay should use LINES lines\n\
-but that the idea of the actual height of the screen should not be changed.\n\
-This function is provided only for compatibility with Emacs 18; new code\n\
-should use `set-frame-width' instead."
-  (set-frame-height (selected-frame) lines pretend))
-
-(make-obsolete 'screen-height 'frame-height)
-(make-obsolete 'screen-width  'frame-width)
-(make-obsolete 'set-screen-width 'set-frame-width)
-(make-obsolete 'set-screen-height 'set-frame-height)
-
-
-;;;; Key bindings
-
-(define-key ctl-x-5-map "2" 'make-frame-command)
-(define-key ctl-x-5-map "0" 'delete-frame)
-(define-key ctl-x-5-map "o" 'other-frame)
-
-(provide 'frame)
-
-;;; frame.el ends here
diff --git a/lisp/gnus-cache.el b/lisp/gnus-cache.el
deleted file mode 100644
index cb770a8c619..00000000000
--- a/lisp/gnus-cache.el
+++ /dev/null
@@ -1,623 +0,0 @@
-;;; gnus-cache.el --- cache interface for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'gnus)
-(eval-when-compile (require 'cl))
-
-(defvar gnus-cache-directory
-  (nnheader-concat gnus-directory "cache/")
-  "*The directory where cached articles will be stored.")
-
-(defvar gnus-cache-active-file 
-  (concat (file-name-as-directory gnus-cache-directory) "active")
-  "*The cache active file.")
-
-(defvar gnus-cache-enter-articles '(ticked dormant)
-  "*Classes of articles to enter into the cache.")
-
-(defvar gnus-cache-remove-articles '(read)
-  "*Classes of articles to remove from the cache.")
-
-(defvar gnus-uncacheable-groups nil
-  "*Groups that match this regexp will not be cached.
-
-If you want to avoid caching your nnml groups, you could set this
-variable to \"^nnml\".")
-
-
-
-;;; Internal variables.
-
-(defvar gnus-cache-buffer nil)
-(defvar gnus-cache-active-hashtb nil)
-(defvar gnus-cache-active-altered nil)
-
-(eval-and-compile
-  (autoload 'nnml-generate-nov-databases-1 "nnml")
-  (autoload 'nnvirtual-find-group-art "nnvirtual"))
-
-
-
-;;; Functions called from Gnus.
-
-(defun gnus-cache-open ()
-  "Initialize the cache."
-  (when (or (file-exists-p gnus-cache-directory)
-	    (and gnus-use-cache
-		 (not (eq gnus-use-cache 'passive))))
-    (gnus-cache-read-active)))
-
-(condition-case ()
-    (gnus-add-shutdown 'gnus-cache-close 'gnus)
-  ;; Complexities of byte-compiling makes this kludge necessary.  Eeek.
-  (error nil))
-
-(defun gnus-cache-close ()
-  "Shut down the cache."
-  (gnus-cache-write-active)
-  (gnus-cache-save-buffers)
-  (setq gnus-cache-active-hashtb nil))
-
-(defun gnus-cache-save-buffers ()
-  ;; save the overview buffer if it exists and has been modified
-  ;; delete empty cache subdirectories
-  (if (null gnus-cache-buffer)
-      ()
-    (let ((buffer (cdr gnus-cache-buffer))
-	  (overview-file (gnus-cache-file-name
-			  (car gnus-cache-buffer) ".overview")))
-      ;; write the overview only if it was modified
-      (if (buffer-modified-p buffer)
-	  (save-excursion
-	    (set-buffer buffer)
-	    (if (> (buffer-size) 0)
-		;; non-empty overview, write it out
-		(progn
-		  (gnus-make-directory (file-name-directory overview-file))
-		  (write-region (point-min) (point-max)
-				overview-file nil 'quietly))
-	      ;; empty overview file, remove it
-	      (and (file-exists-p overview-file)
-		   (delete-file overview-file))
-	      ;; if possible, remove group's cache subdirectory
-	      (condition-case nil
-		  ;; FIXME: we can detect the error type and warn the user
-		  ;; of any inconsistencies (articles w/o nov entries?).
-		  ;; for now, just be conservative...delete only if safe -- sj
-		  (delete-directory (file-name-directory overview-file))
-		(error nil)))))
-      ;; kill the buffer, it's either unmodified or saved
-      (gnus-kill-buffer buffer)
-      (setq gnus-cache-buffer nil))))
-
-(defun gnus-cache-possibly-enter-article 
-  (group article headers ticked dormant unread &optional force)
-  (when (and (or force (not (eq gnus-use-cache 'passive)))
-	     (numberp article)
-	     (> article 0)
-	     (vectorp headers))	; This might be a dummy article.
-    ;; If this is a virtual group, we find the real group.
-    (when (gnus-virtual-group-p group)
-      (let ((result (nnvirtual-find-group-art 
-		     (gnus-group-real-name group) article)))
-	(setq group (car result)
-	      headers (copy-sequence headers))
-	(mail-header-set-number headers (cdr result))))
-    (let ((number (mail-header-number headers))
-	  file dir)
-      (when (and (> number 0)		; Reffed article.
-		 (or (not gnus-uncacheable-groups)
-		     (not (string-match gnus-uncacheable-groups group)))
-		 (or force
-		     (gnus-cache-member-of-class
-		      gnus-cache-enter-articles ticked dormant unread))
-		 (not (file-exists-p (setq file (gnus-cache-file-name
-						 group number)))))
-	;; Possibly create the cache directory.
-	(or (file-exists-p (setq dir (file-name-directory file)))
-	    (gnus-make-directory dir))
-	;; Save the article in the cache.
-	(if (file-exists-p file)
-	    t				; The article already is saved.
-	  (save-excursion
-	    (set-buffer nntp-server-buffer)
-	    (let ((gnus-use-cache nil))
-	      (gnus-request-article-this-buffer number group))
-	    (when (> (buffer-size) 0)
-	      (write-region (point-min) (point-max) file nil 'quiet)
-	      (gnus-cache-change-buffer group)
-	      (set-buffer (cdr gnus-cache-buffer))
-	      (goto-char (point-max))
-	      (forward-line -1)
-	      (while (condition-case ()
-			 (and (not (bobp))
-			      (> (read (current-buffer)) number))
-		       (error
-			;; The line was malformed, so we just remove it!!
-			(gnus-delete-line)
-			t))
-		(forward-line -1))
-	      (if (bobp) 
-		  (if (not (eobp))
-		      (progn
-			(beginning-of-line)
-			(if (< (read (current-buffer)) number)
-			    (forward-line 1)))
-		    (beginning-of-line))
-		(forward-line 1))
-	      (beginning-of-line)
-	      ;; [number subject from date id references chars lines xref]
-	      (insert (format "%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t%s\t\n"
-			      (mail-header-number headers)
-			      (mail-header-subject headers)
-			      (mail-header-from headers)
-			      (mail-header-date headers)
-			      (mail-header-id headers)
-			      (or (mail-header-references headers) "")
-			      (or (mail-header-chars headers) "")
-			      (or (mail-header-lines headers) "")
-			      (or (mail-header-xref headers) "")))
-	      ;; Update the active info.
-	      (set-buffer gnus-summary-buffer)
-	      (gnus-cache-update-active group number)
-	      (push article gnus-newsgroup-cached)
-	      (gnus-summary-update-secondary-mark article))
-	    t))))))
-
-(defun gnus-cache-enter-remove-article (article)
-  "Mark ARTICLE for later possible removal."
-  (when article
-    (push article gnus-cache-removable-articles)))
-
-(defun gnus-cache-possibly-remove-articles ()
-  "Possibly remove some of the removable articles."
-  (if (not (gnus-virtual-group-p gnus-newsgroup-name))
-      (gnus-cache-possibly-remove-articles-1)
-    (let ((arts gnus-cache-removable-articles)
-	  ga)
-      (while arts
-	(when (setq ga (nnvirtual-find-group-art
-			(gnus-group-real-name gnus-newsgroup-name) (pop arts)))
-	  (let ((gnus-cache-removable-articles (list (cdr ga)))
-		(gnus-newsgroup-name (car ga)))
-	    (gnus-cache-possibly-remove-articles-1)))))
-    (setq gnus-cache-removable-articles nil)))
-
-(defun gnus-cache-possibly-remove-articles-1 ()
-  "Possibly remove some of the removable articles."
-  (unless (eq gnus-use-cache 'passive)
-    (let ((articles gnus-cache-removable-articles)
-	  (cache-articles gnus-newsgroup-cached)
-	  article)
-      (gnus-cache-change-buffer gnus-newsgroup-name)
-      (while articles
-	(if (memq (setq article (pop articles)) cache-articles)
-	    ;; The article was in the cache, so we see whether we are
-	    ;; supposed to remove it from the cache.
-	    (gnus-cache-possibly-remove-article
-	     article (memq article gnus-newsgroup-marked)
-	     (memq article gnus-newsgroup-dormant)
-	     (or (memq article gnus-newsgroup-unreads)
-		 (memq article gnus-newsgroup-unselected))))))
-    ;; The overview file might have been modified, save it
-    ;; safe because we're only called at group exit anyway.
-    (gnus-cache-save-buffers)))
-
-(defun gnus-cache-request-article (article group)
-  "Retrieve ARTICLE in GROUP from the cache."
-  (let ((file (gnus-cache-file-name group article))
-	(buffer-read-only nil))
-    (when (file-exists-p file)
-      (erase-buffer)
-      (gnus-kill-all-overlays)
-      (insert-file-contents file)
-      t)))
-
-(defun gnus-cache-possibly-alter-active (group active)
-  "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
-  (when gnus-cache-active-hashtb
-    (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
-      (and cache-active 
-	   (< (car cache-active) (car active))
-	   (setcar active (car cache-active)))
-      (and cache-active
-	   (> (cdr cache-active) (cdr active))
-	   (setcdr active (cdr cache-active))))))
-
-(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
-  "Retrieve the headers for ARTICLES in GROUP."
-  (let ((cached 
-	 (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
-    (if (not cached)
-	;; No cached articles here, so we just retrieve them
-	;; the normal way.
-	(let ((gnus-use-cache nil))
-	  (gnus-retrieve-headers articles group fetch-old))
-      (let ((uncached-articles (gnus-sorted-intersection
-				(gnus-sorted-complement articles cached)
-				articles))
-	    (cache-file (gnus-cache-file-name group ".overview"))
-	    type)
-	;; We first retrieve all the headers that we don't have in 
-	;; the cache.
-	(let ((gnus-use-cache nil))
-	  (when uncached-articles
-	    (setq type (and articles 
-			    (gnus-retrieve-headers 
-			     uncached-articles group fetch-old)))))
-	(gnus-cache-save-buffers)
-	;; Then we insert the cached headers.
-	(save-excursion
-	  (cond
-	   ((not (file-exists-p cache-file))
-	    ;; There are no cached headers.
-	    type)
-	   ((null type)
-	    ;; There were no uncached headers (or retrieval was 
-	    ;; unsuccessful), so we use the cached headers exclusively.
-	    (set-buffer nntp-server-buffer)
-	    (erase-buffer)
-	    (insert-file-contents cache-file)
-	    'nov)
-	   ((eq type 'nov)
-	    ;; We have both cached and uncached NOV headers, so we
-	    ;; braid them.
-	    (gnus-cache-braid-nov group cached)
-	    type)
-	   (t
-	    ;; We braid HEADs.
-	    (gnus-cache-braid-heads group (gnus-sorted-intersection
-					   cached articles))
-	    type)))))))
-
-(defun gnus-cache-enter-article (&optional n)
-  "Enter the next N articles into the cache.
-If not given a prefix, use the process marked articles instead.
-Returns the list of articles entered."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((articles (gnus-summary-work-articles n))
-	article out)
-    (while articles
-      (setq article (pop articles))
-      (when (gnus-cache-possibly-enter-article 
-	     gnus-newsgroup-name article (gnus-summary-article-header article)
-	     nil nil nil t)
-	(push article out))
-      (gnus-summary-remove-process-mark article)
-      (gnus-summary-update-secondary-mark article))
-    (gnus-summary-next-subject 1)
-    (gnus-summary-position-point)
-    (nreverse out)))
-
-(defun gnus-cache-remove-article (n)
-  "Remove the next N articles from the cache.
-If not given a prefix, use the process marked articles instead.
-Returns the list of articles removed."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-cache-change-buffer gnus-newsgroup-name)
-  (let ((articles (gnus-summary-work-articles n))
-	article out)
-    (while articles
-      (setq article (pop articles))
-      (when (gnus-cache-possibly-remove-article article nil nil nil t)
-	(push article out))
-      (gnus-summary-remove-process-mark article)
-      (gnus-summary-update-secondary-mark article))
-    (gnus-summary-next-subject 1)
-    (gnus-summary-position-point)
-    (nreverse out)))
-
-(defun gnus-cached-article-p (article)
-  "Say whether ARTICLE is cached in the current group."
-  (memq article gnus-newsgroup-cached))
-
-;;; Internal functions.
-
-(defun gnus-cache-change-buffer (group)
-  (and gnus-cache-buffer
-       ;; See if the current group's overview cache has been loaded.
-       (or (string= group (car gnus-cache-buffer))
-	   ;; Another overview cache is current, save it.
-	   (gnus-cache-save-buffers)))
-  ;; if gnus-cache buffer is nil, create it
-  (or gnus-cache-buffer
-      ;; Create cache buffer
-      (save-excursion
-	(setq gnus-cache-buffer
-	      (cons group
-		    (set-buffer (get-buffer-create " *gnus-cache-overview*"))))
-	(buffer-disable-undo (current-buffer))
-	;; Insert the contents of this group's cache overview.
-	(erase-buffer)
-	(let ((file (gnus-cache-file-name group ".overview")))
-	  (and (file-exists-p file)
-	       (insert-file-contents file)))
-	;; We have a fresh (empty/just loaded) buffer, 
-	;; mark it as unmodified to save a redundant write later.
-	(set-buffer-modified-p nil))))
-
-;; Return whether an article is a member of a class.
-(defun gnus-cache-member-of-class (class ticked dormant unread)
-  (or (and ticked (memq 'ticked class))
-      (and dormant (memq 'dormant class))
-      (and unread (memq 'unread class))
-      (and (not unread) (not ticked) (not dormant) (memq 'read class))))
-
-(defun gnus-cache-file-name (group article)
-  (concat (file-name-as-directory gnus-cache-directory)
-	  (file-name-as-directory
-	   (if (gnus-use-long-file-name 'not-cache)
-	       group 
-	     (let ((group (concat group "")))
-	       (if (string-match ":" group)
-		   (aset group (match-beginning 0) ?/))
-	       (nnheader-replace-chars-in-string group ?. ?/))))
-	  (if (stringp article) article (int-to-string article))))
-
-(defun gnus-cache-update-article (group article)
-  "If ARTICLE is in the cache, remove it and re-enter it."
-  (when (gnus-cache-possibly-remove-article article nil nil nil t)
-    (let ((gnus-use-cache nil))
-      (gnus-cache-possibly-enter-article 
-       gnus-newsgroup-name article (gnus-summary-article-header article)
-       nil nil nil t))))
-
-(defun gnus-cache-possibly-remove-article (article ticked dormant unread 
-						   &optional force)
-  "Possibly remove ARTICLE from the cache."
-  (let ((group gnus-newsgroup-name)
-	(number article)
-	file)
-    ;; If this is a virtual group, we find the real group.
-    (when (gnus-virtual-group-p group)
-      (let ((result (nnvirtual-find-group-art 
-		     (gnus-group-real-name group) article)))
-	(setq group (car result)
-	      number (cdr result))))
-    (setq file (gnus-cache-file-name group number))
-    (when (and (file-exists-p file)
-	       (or force
-		   (gnus-cache-member-of-class
-		    gnus-cache-remove-articles ticked dormant unread)))
-      (save-excursion
-	(delete-file file)
-	(set-buffer (cdr gnus-cache-buffer))
-	(goto-char (point-min))
-	(if (or (looking-at (concat (int-to-string number) "\t"))
-		(search-forward (concat "\n" (int-to-string number) "\t")
-				(point-max) t))
-	    (delete-region (progn (beginning-of-line) (point))
-			   (progn (forward-line 1) (point)))))
-      (setq gnus-newsgroup-cached
-	    (delq article gnus-newsgroup-cached))
-      (gnus-summary-update-secondary-mark article)
-      t)))
-
-(defun gnus-cache-articles-in-group (group)
-  "Return a sorted list of cached articles in GROUP."
-  (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
-	articles)
-    (when (file-exists-p dir)
-      (sort (mapcar (lambda (name) (string-to-int name)) 
-		    (directory-files dir nil "^[0-9]+$" t))
-	    '<))))
-
-(defun gnus-cache-braid-nov (group cached)
-  (let ((cache-buf (get-buffer-create " *gnus-cache*"))
-	beg end)
-    (gnus-cache-save-buffers)
-    (save-excursion
-      (set-buffer cache-buf)
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (insert-file-contents (gnus-cache-file-name group ".overview"))
-      (goto-char (point-min))
-      (insert "\n")
-      (goto-char (point-min)))
-    (set-buffer nntp-server-buffer)
-    (goto-char (point-min))
-    (while cached
-      (while (and (not (eobp))
-		  (< (read (current-buffer)) (car cached)))
-	(forward-line 1))
-      (beginning-of-line)
-      (save-excursion
-	(set-buffer cache-buf)
-	(if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
-			    nil t)
-	    (setq beg (progn (beginning-of-line) (point))
-		  end (progn (end-of-line) (point)))
-	  (setq beg nil)))
-      (if beg (progn (insert-buffer-substring cache-buf beg end)
-		     (insert "\n")))
-      (setq cached (cdr cached)))
-    (kill-buffer cache-buf)))
-
-(defun gnus-cache-braid-heads (group cached)
-  (let ((cache-buf (get-buffer-create " *gnus-cache*")))
-    (save-excursion
-      (set-buffer cache-buf)
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer))
-    (set-buffer nntp-server-buffer)
-    (goto-char (point-min))
-    (while cached
-      (while (and (not (eobp))
-		  (looking-at "2.. +\\([0-9]+\\) ")
-		  (< (progn (goto-char (match-beginning 1))
-			    (read (current-buffer)))
-		     (car cached)))
-	(search-forward "\n.\n" nil 'move))
-      (beginning-of-line)
-      (save-excursion
-	(set-buffer cache-buf)
-	(erase-buffer)
-	(insert-file-contents (gnus-cache-file-name group (car cached)))
-	(goto-char (point-min))
-	(insert "220 ")
-	(princ (car cached) (current-buffer))
-	(insert " Article retrieved.\n")
-	(search-forward "\n\n" nil 'move)
-	(delete-region (point) (point-max))
-	(forward-char -1)
-	(insert "."))
-      (insert-buffer-substring cache-buf)
-      (setq cached (cdr cached)))
-    (kill-buffer cache-buf)))
-
-;;;###autoload
-(defun gnus-jog-cache ()
-  "Go through all groups and put the articles into the cache."
-  (interactive)
-  (let ((gnus-mark-article-hook nil)
-	(gnus-expert-user t)
-	(nnmail-spool-file nil)
-	(gnus-use-dribble-file nil)
-	(gnus-novice-user nil)
-	(gnus-large-newsgroup nil))
-    ;; Start Gnus.
-    (gnus)
-    ;; Go through all groups...
-    (gnus-group-mark-buffer)
-    (gnus-group-universal-argument 
-     nil nil 
-     (lambda ()
-       (gnus-summary-read-group nil nil t)
-       ;; ... and enter the articles into the cache.
-       (when (eq major-mode 'gnus-summary-mode)
-	 (gnus-uu-mark-buffer)
-	 (gnus-cache-enter-article)
-	 (kill-buffer (current-buffer)))))))
-
-(defun gnus-cache-read-active (&optional force)
-  "Read the cache active file."
-  (unless (file-exists-p gnus-cache-directory)
-    (make-directory gnus-cache-directory t))
-  (if (not (and (file-exists-p gnus-cache-active-file)
-		(or force (not gnus-cache-active-hashtb))))
-      ;; There is no active file, so we generate one.
-      (gnus-cache-generate-active)
-    ;; We simply read the active file.
-    (save-excursion
-      (gnus-set-work-buffer)
-      (insert-file-contents gnus-cache-active-file)
-      (gnus-active-to-gnus-format
-       nil (setq gnus-cache-active-hashtb 
-		 (gnus-make-hashtable 
-		  (count-lines (point-min) (point-max)))))
-      (setq gnus-cache-active-altered nil))))
-       
-(defun gnus-cache-write-active (&optional force)
-  "Write the active hashtb to the active file."
-  (when (or force
-	    (and gnus-cache-active-hashtb
-		 gnus-cache-active-altered))
-    (save-excursion
-      (gnus-set-work-buffer)
-      (mapatoms
-       (lambda (sym)
-	 (when (and sym (boundp sym))
-	   (insert (format "%s %d %d y\n"
-			   (symbol-name sym) (cdr (symbol-value sym))
-			   (car (symbol-value sym))))))
-       gnus-cache-active-hashtb)
-      (gnus-make-directory (file-name-directory gnus-cache-active-file))
-      (write-region 
-       (point-min) (point-max) gnus-cache-active-file nil 'silent))
-    ;; Mark the active hashtb as unaltered.
-    (setq gnus-cache-active-altered nil)))
-
-(defun gnus-cache-update-active (group number &optional low)
-  "Update the upper bound of the active info of GROUP to NUMBER.
-If LOW, update the lower bound instead."
-  (let ((active (gnus-gethash group gnus-cache-active-hashtb)))
-    (if (null active)
-	;; We just create a new active entry for this group.
-	(gnus-sethash group (cons number number) gnus-cache-active-hashtb)
-      ;; Update the lower or upper bound.
-      (if low
-	  (setcar active number)
-	(setcdr active number))
-      ;; Mark the active hashtb as altered.
-      (setq gnus-cache-active-altered t))))
-
-;;;###autoload
-(defun gnus-cache-generate-active (&optional directory)
-  "Generate the cache active file."
-  (interactive)
-  (let* ((top (null directory))
-	 (directory (expand-file-name (or directory gnus-cache-directory)))
-	 (files (directory-files directory 'full))
-	 (group 
-	  (if top
-	      ""
-	    (string-match 
-	     (concat "^" (file-name-as-directory
-			  (expand-file-name gnus-cache-directory)))
-	     (directory-file-name directory))
-	    (nnheader-replace-chars-in-string 
-	     (substring (directory-file-name directory) (match-end 0))
-	     ?/ ?.)))
-	 nums alphs)
-    (when top
-      (gnus-message 5 "Generating the cache active file...")
-      (setq gnus-cache-active-hashtb (gnus-make-hashtable 123)))
-    ;; Separate articles from all other files and directories.
-    (while files
-      (if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))
-	  (push (string-to-int (file-name-nondirectory (pop files))) nums)
-	(push (pop files) alphs)))
-    ;; If we have nums, then this is probably a valid group.
-    (when (setq nums (sort nums '<))
-      (gnus-sethash group (cons (car nums) (gnus-last-element nums))
-		    gnus-cache-active-hashtb))
-    ;; Go through all the other files.
-    (while alphs
-      (when (and (file-directory-p (car alphs))
-		 (not (string-match "^\\.\\.?$"
-				    (file-name-nondirectory (car alphs)))))
-	;; We descend directories.
-	(gnus-cache-generate-active (car alphs)))
-      (setq alphs (cdr alphs)))
-    ;; Write the new active file.
-    (when top
-      (gnus-cache-write-active t)
-      (gnus-message 5 "Generating the cache active file...done"))))
-
-;;;###autoload
-(defun gnus-cache-generate-nov-databases (dir)
-  "Generate NOV files recursively starting in DIR."
-  (interactive (list gnus-cache-directory))
-  (gnus-cache-close)
-  (let ((nnml-generate-active-function 'identity))
-    (nnml-generate-nov-databases-1 dir)))
-
-(provide 'gnus-cache)
-	      
-;;; gnus-cache.el ends here
diff --git a/lisp/gnus-cite.el b/lisp/gnus-cite.el
deleted file mode 100644
index bc85ea42be0..00000000000
--- a/lisp/gnus-cite.el
+++ /dev/null
@@ -1,732 +0,0 @@
-;;; gnus-cite.el --- parse citations in articles for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Keywords: news, mail
-
-;; 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:
-
-(require 'gnus)
-(require 'gnus-msg)
-(require 'gnus-ems)
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
-  (autoload 'gnus-article-add-button "gnus-vis"))
-
-;;; Customization:
-
-(defvar gnus-cited-text-button-line-format "%(%{[...]%}%)\n"
-  "Format of cited text buttons.")
-
-(defvar gnus-cited-lines-visible nil
-  "The number of lines of hidden cited text to remain visible.")
-
-(defvar gnus-cite-parse-max-size 25000
-  "Maximum article size (in bytes) where parsing citations is allowed.
-Set it to nil to parse all articles.")
-
-(defvar gnus-cite-prefix-regexp 
-    "^[]>|:}+ ]*[]>|:}+]\\(.*>\\)?\\|^.*>"
-  "Regexp matching the longest possible citation prefix on a line.")
-
-(defvar gnus-cite-max-prefix 20
-  "Maximum possible length for a citation prefix.")
-
-(defvar gnus-supercite-regexp 
-  (concat "^\\(" gnus-cite-prefix-regexp "\\)? *"
-	  ">>>>> +\"\\([^\"\n]+\\)\" +==")
-  "Regexp matching normal Supercite attribution lines.
-The first grouping must match prefixes added by other packages.")
-
-(defvar gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
-  "Regexp matching mangled Supercite attribution lines.
-The first regexp group should match the Supercite attribution.")
-
-(defvar gnus-cite-minimum-match-count 2
-  "Minimum number of identical prefixes before we believe it's a citation.")
-
-;see gnus-cus.el
-;(defvar gnus-cite-face-list 
-;  (if (eq gnus-display-type 'color)
-;      (if (eq gnus-background-mode 'dark) 'light 'dark)
-;    '(italic))
-;  "Faces used for displaying different citations.
-;It is either a list of face names, or one of the following special
-;values:
-
-;dark: Create faces from `gnus-face-dark-name-list'.
-;light: Create faces from `gnus-face-light-name-list'.
-
-;The variable `gnus-make-foreground' determines whether the created
-;faces change the foreground or the background colors.")
-
-(defvar gnus-cite-attribution-prefix "in article\\|in <"
-  "Regexp matching the beginning of an attribution line.")
-
-(defvar gnus-cite-attribution-suffix
-  "\\(wrote\\|writes\\|said\\|says\\):[ \t]*$"
-  "Regexp matching the end of an attribution line.
-The text matching the first grouping will be used as a button.")
-
-;see gnus-cus.el
-;(defvar gnus-cite-attribution-face 'underline
-;  "Face used for attribution lines.
-;It is merged with the face for the cited text belonging to the attribution.")
-
-;see gnus-cus.el
-;(defvar gnus-cite-hide-percentage 50
-;  "Only hide cited text if it is larger than this percent of the body.")
-
-;see gnus-cus.el
-;(defvar gnus-cite-hide-absolute 10
-;  "Only hide cited text if there is at least this number of cited lines.")
-
-;see gnus-cus.el
-;(defvar gnus-face-light-name-list
-;  '("light blue" "light cyan" "light yellow" "light pink"
-;    "pale green" "beige" "orange" "magenta" "violet" "medium purple"
-;    "turquoise")
-;  "Names of light colors.")
-
-;see gnus-cus.el
-;(defvar gnus-face-dark-name-list
-;  '("dark salmon" "firebrick"
-;    "dark green" "dark orange" "dark khaki" "dark violet"
-;    "dark turquoise")
-;  "Names of dark colors.")
-
-;;; Internal Variables:
-
-(defvar gnus-cite-article nil)
-
-(defvar gnus-cite-prefix-alist nil)
-;; Alist of citation prefixes.  
-;; The cdr is a list of lines with that prefix.
-
-(defvar gnus-cite-attribution-alist nil)
-;; Alist of attribution lines.
-;; The car is a line number.
-;; The cdr is the prefix for the citation started by that line.
-
-(defvar gnus-cite-loose-prefix-alist nil)
-;; Alist of citation prefixes that have no matching attribution.
-;; The cdr is a list of lines with that prefix.
-
-(defvar gnus-cite-loose-attribution-alist nil)
-;; Alist of attribution lines that have no matching citation.
-;; Each member has the form (WROTE IN PREFIX TAG), where
-;; WROTE: is the attribution line number
-;; IN: is the line number of the previous line if part of the same attribution,
-;; PREFIX: Is the citation prefix of the attribution line(s), and
-;; TAG: Is a Supercite tag, if any.
-
-(defvar gnus-cited-text-button-line-format-alist 
-  `((?b beg ?d)
-    (?e end ?d)
-    (?l (- end beg) ?d)))
-(defvar gnus-cited-text-button-line-format-spec nil)
-
-;;; Commands:
-
-(defun gnus-article-highlight-citation (&optional force)
-  "Highlight cited text.
-Each citation in the article will be highlighted with a different face.
-The faces are taken from `gnus-cite-face-list'.
-Attribution lines are highlighted with the same face as the
-corresponding citation merged with `gnus-cite-attribution-face'.
-
-Text is considered cited if at least `gnus-cite-minimum-match-count'
-lines matches `gnus-cite-prefix-regexp' with the same prefix.  
-
-Lines matching `gnus-cite-attribution-suffix' and perhaps
-`gnus-cite-attribution-prefix' are considered attribution lines."
-  (interactive (list 'force))
-  ;; Create dark or light faces if necessary.
-  (cond ((eq gnus-cite-face-list 'light)
-	 (setq gnus-cite-face-list
-	       (mapcar 'gnus-make-face gnus-face-light-name-list)))
-	((eq gnus-cite-face-list 'dark)
-	 (setq gnus-cite-face-list
-	       (mapcar 'gnus-make-face gnus-face-dark-name-list))))
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (gnus-cite-parse-maybe force)
-    (let ((buffer-read-only nil)
-	  (alist gnus-cite-prefix-alist)
-	  (faces gnus-cite-face-list)
-	  (inhibit-point-motion-hooks t)
-	  face entry prefix skip numbers number face-alist)
-      ;; Loop through citation prefixes.
-      (while alist
-	(setq entry (car alist)
-	      alist (cdr alist)
-	      prefix (car entry)
-	      numbers (cdr entry)
-	      face (car faces)
-	      faces (or (cdr faces) gnus-cite-face-list)
-	      face-alist (cons (cons prefix face) face-alist))
-	(while numbers
-	  (setq number (car numbers)
-		numbers (cdr numbers))
-	  (and (not (assq number gnus-cite-attribution-alist))
-	       (not (assq number gnus-cite-loose-attribution-alist))
-	       (gnus-cite-add-face number prefix face))))
-      ;; Loop through attribution lines.
-      (setq alist gnus-cite-attribution-alist)
-      (while alist
-	(setq entry (car alist)
-	      alist (cdr alist)
-	      number (car entry)
-	      prefix (cdr entry)
-	      skip (gnus-cite-find-prefix number)
-	      face (cdr (assoc prefix face-alist)))
-	;; Add attribution button.
-	(goto-line number)
-	(if (re-search-forward gnus-cite-attribution-suffix 
-			       (save-excursion (end-of-line 1) (point))
-			       t)
-	    (gnus-article-add-button (match-beginning 1) (match-end 1)
-				     'gnus-cite-toggle prefix))
-	;; Highlight attribution line.
-	(gnus-cite-add-face number skip face)
-	(gnus-cite-add-face number skip gnus-cite-attribution-face))
-      ;; Loop through attribution lines.
-      (setq alist gnus-cite-loose-attribution-alist)
-      (while alist
-	(setq entry (car alist)
-	      alist (cdr alist)
-	      number (car entry)
-	      skip (gnus-cite-find-prefix number))
-	(gnus-cite-add-face number skip gnus-cite-attribution-face)))))
-
-(defun gnus-dissect-cited-text ()
-  "Dissect the article buffer looking for cited text."
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (gnus-cite-parse-maybe)
-    (let ((alist gnus-cite-prefix-alist)
-	  prefix numbers number marks m)
-      ;; Loop through citation prefixes.
-      (while alist
-	(setq numbers (pop alist)
-	      prefix (pop numbers))
-	(while numbers
-	  (setq number (pop numbers))
-	  (goto-char (point-min))
-	  (forward-line number)
-	  (push (cons (point-marker) "") marks)
-	  (while (and numbers
-		      (= (1- number) (car numbers)))
-	    (setq number (pop numbers)))
-	  (goto-char (point-min))
-	  (forward-line (1- number))
-	  (push (cons (point-marker) prefix) marks)))
-      (goto-char (point-min))
-      (search-forward "\n\n" nil t)
-      (push (cons (point-marker) "") marks)
-      (goto-char (point-max))
-      (re-search-backward gnus-signature-separator nil t)
-      (push (cons (point-marker) "") marks)
-      (setq marks (sort marks (lambda (m1 m2) (< (car m1) (car m2)))))
-      (let* ((omarks marks))
-	(setq marks nil)
-	(while (cdr omarks)
-	  (if (= (caar omarks) (caadr omarks))
-	      (progn
-		(unless (equal (cdar omarks) "")
-		  (push (car omarks) marks))
-		(unless (equal (cdadr omarks) "")
-		  (push (cadr omarks) marks))
-		(setq omarks (cdr omarks)))
-	    (push (car omarks) marks))
-	  (setq omarks (cdr omarks)))
-	(when (car omarks)
-	  (push (car omarks) marks))
-	(setq marks (setq m (nreverse marks)))
-	(while (cddr m)
-	  (if (and (equal (cdadr m) "")
-		   (equal (cdar m) (cdaddr m))
-		   (goto-char (caadr m))
-		   (forward-line 1)
-		   (= (point) (caaddr m)))
-	      (setcdr m (cdddr m))
-	    (setq m (cdr m))))
-	marks))))
-	    
-
-(defun gnus-article-fill-cited-article (&optional force)
-  "Do word wrapping in the current article."
-  (interactive (list t))
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-	  (inhibit-point-motion-hooks t)
-	  (marks (gnus-dissect-cited-text))
-	  (adaptive-fill-mode nil))
-      (save-restriction
-	(while (cdr marks)
-	  (widen)
-	  (narrow-to-region (caar marks) (caadr marks))
-	  (let ((adaptive-fill-regexp
-		 (concat "^" (regexp-quote (cdar marks)) " *"))
-		(fill-prefix (cdar marks)))
-	    (fill-region (point-min) (point-max)))
-	  (set-marker (caar marks) nil)
-	  (setq marks (cdr marks)))
-	(when marks
-	  (set-marker (caar marks) nil))))))
-
-(defun gnus-article-hide-citation (&optional arg force)
-  "Toggle hiding of all cited text except attribution lines.
-See the documentation for `gnus-article-highlight-citation'.
-If given a negative prefix, always show; if given a positive prefix,
-always hide."
-  (interactive (append (gnus-hidden-arg) (list 'force)))
-  (setq gnus-cited-text-button-line-format-spec 
-	(gnus-parse-format gnus-cited-text-button-line-format 
-			   gnus-cited-text-button-line-format-alist t))
-  (unless (gnus-article-check-hidden-text 'cite arg)
-    (save-excursion
-      (set-buffer gnus-article-buffer)
-      (let ((buffer-read-only nil)
-	    (marks (gnus-dissect-cited-text))
-	    (inhibit-point-motion-hooks t)
-	    (props (nconc (list 'gnus-type 'cite)
-			  gnus-hidden-properties))
-	    beg end)
-	(while marks
-	  (setq beg nil
-		end nil)
-	  (while (and marks (string= (cdar marks) ""))
-	    (setq marks (cdr marks)))
-	  (when marks 
-	    (setq beg (caar marks)))
-	  (while (and marks (not (string= (cdar marks) "")))
-	    (setq marks (cdr marks)))
-	  (when marks
-	    (setq end (caar marks)))
-	  ;; Skip past lines we want to leave visible.
-	  (when (and beg end gnus-cited-lines-visible)
-	    (goto-char beg)
-	    (forward-line gnus-cited-lines-visible)
-	    (if (>= (point) end)
-		(setq beg nil)
-	      (setq beg (point-marker))))
-	  (when (and beg end)
-	    (gnus-add-text-properties beg end props)
-	    (goto-char beg)
-	    (unless (save-excursion (search-backward "\n\n" nil t))
-	      (insert "\n"))
-	    (gnus-article-add-button
-	     (point)
-	     (progn (eval gnus-cited-text-button-line-format-spec) (point))
-	     `gnus-article-toggle-cited-text (cons beg end))
-	    (set-marker beg (point))))))))
-
-(defun gnus-article-toggle-cited-text (region)
-  "Toggle hiding the text in REGION."
-  (let (buffer-read-only)
-    (funcall
-     (if (text-property-any
-	  (car region) (1- (cdr region))
-	  (car gnus-hidden-properties) (cadr gnus-hidden-properties))
-	 'remove-text-properties 'gnus-add-text-properties)
-     (car region) (cdr region) gnus-hidden-properties)))
-
-(defun gnus-article-hide-citation-maybe (&optional arg force)
-  "Toggle hiding of cited text that has an attribution line.
-If given a negative prefix, always show; if given a positive prefix,
-always hide.
-This will do nothing unless at least `gnus-cite-hide-percentage'
-percent and at least `gnus-cite-hide-absolute' lines of the body is
-cited text with attributions.  When called interactively, these two
-variables are ignored.
-See also the documentation for `gnus-article-highlight-citation'."
-  (interactive (append (gnus-hidden-arg) (list 'force)))
-  (unless (gnus-article-check-hidden-text 'cite arg)
-    (save-excursion
-      (set-buffer gnus-article-buffer)
-      (gnus-cite-parse-maybe force)
-      (goto-char (point-min))
-      (search-forward "\n\n" nil t)
-      (let ((start (point))
-	    (atts gnus-cite-attribution-alist)
-	    (buffer-read-only nil)
-	    (inhibit-point-motion-hooks t)
-	    (hiden 0)
-	    total)
-	(goto-char (point-max))
-	(re-search-backward gnus-signature-separator nil t)
-	(setq total (count-lines start (point)))
-	(while atts
-	  (setq hiden (+ hiden (length (cdr (assoc (cdar atts)
-						   gnus-cite-prefix-alist))))
-		atts (cdr atts)))
-	(if (or force
-		(and (> (* 100 hiden) (* gnus-cite-hide-percentage total))
-		     (> hiden gnus-cite-hide-absolute)))
-	    (progn
-	      (setq atts gnus-cite-attribution-alist)
-	      (while atts
-		(setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
-		      atts (cdr atts))
-		(while total
-		  (setq hiden (car total)
-			total (cdr total))
-		  (goto-line hiden)
-		  (or (assq hiden gnus-cite-attribution-alist)
-		      (gnus-add-text-properties 
-		       (point) (progn (forward-line 1) (point))
-		       (nconc (list 'gnus-type 'cite)
-			      gnus-hidden-properties)))))))))))
-
-(defun gnus-article-hide-citation-in-followups ()
-  "Hide cited text in non-root articles."
-  (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((article (cdr gnus-article-current)))
-      (unless (save-excursion
-		(set-buffer gnus-summary-buffer)
-		(gnus-article-displayed-root-p article))
-	(gnus-article-hide-citation)))))
-
-;;; Internal functions:
-
-(defun gnus-cite-parse-maybe (&optional force)
-  ;; Parse if the buffer has changes since last time.
-  (if (equal gnus-cite-article gnus-article-current)
-      ()
-    ;;Reset parser information.
-    (setq gnus-cite-prefix-alist nil
-	  gnus-cite-attribution-alist nil
-	  gnus-cite-loose-prefix-alist nil
-	  gnus-cite-loose-attribution-alist nil)
-    ;; Parse if not too large.
-    (if (and (not force) 
-	     gnus-cite-parse-max-size
-	     (> (buffer-size) gnus-cite-parse-max-size))
-	()
-      (setq gnus-cite-article (cons (car gnus-article-current)
-				    (cdr gnus-article-current)))
-      (gnus-cite-parse))))
-
-(defun gnus-cite-parse ()
-  ;; Parse and connect citation prefixes and attribution lines.
-  
-  ;; Parse current buffer searching for citation prefixes.
-  (goto-char (point-min))
-  (or (search-forward "\n\n" nil t)
-      (goto-char (point-max)))
-  (let ((line (1+ (count-lines (point-min) (point))))
-	(case-fold-search t)
-	(max (save-excursion
-	       (goto-char (point-max))
-	       (re-search-backward gnus-signature-separator nil t)
-	       (point)))
-	alist entry start begin end numbers prefix)
-    ;; Get all potential prefixes in `alist'.
-    (while (< (point) max)
-      ;; Each line.
-      (setq begin (point)
-	    end (progn (beginning-of-line 2) (point))
-	    start end)
-      (goto-char begin)
-      ;; Ignore standard Supercite attribution prefix.
-      (if (looking-at gnus-supercite-regexp)
-	  (if (match-end 1)
-	      (setq end (1+ (match-end 1)))
-	    (setq end (1+ begin))))
-      ;; Ignore very long prefixes.
-      (if (> end (+ (point) gnus-cite-max-prefix))
-	  (setq end (+ (point) gnus-cite-max-prefix)))
-      (while (re-search-forward gnus-cite-prefix-regexp (1- end) t)
-	;; Each prefix.
-	(setq end (match-end 0)
-	      prefix (buffer-substring begin end))
-	(gnus-set-text-properties 0 (length prefix) nil prefix)
-	(setq entry (assoc prefix alist))
-	(if entry 
-	    (setcdr entry (cons line (cdr entry)))
-	  (setq alist (cons (list prefix line) alist)))
-	(goto-char begin))
-      (goto-char start)
-      (setq line (1+ line)))
-    ;; We got all the potential prefixes.  Now create
-    ;; `gnus-cite-prefix-alist' containing the oldest prefix for each
-    ;; line that appears at least gnus-cite-minimum-match-count
-    ;; times. First sort them by length.  Longer is older.
-    (setq alist (sort alist (lambda (a b)
-			      (> (length (car a)) (length (car b))))))
-    (while alist
-      (setq entry (car alist)
-	    prefix (car entry)
-	    numbers (cdr entry)
-	    alist (cdr alist))
-      (cond ((null numbers)
-	     ;; No lines with this prefix that wasn't also part of
-	     ;; a longer prefix.
-	     )
-	    ((< (length numbers) gnus-cite-minimum-match-count)
-	     ;; Too few lines with this prefix.  We keep it a bit
-	     ;; longer in case it is an exact match for an attribution
-	     ;; line, but we don't remove the line from other
-	     ;; prefixes. 
-	     (setq gnus-cite-prefix-alist
-		   (cons entry gnus-cite-prefix-alist)))
-	    (t
-	     (setq gnus-cite-prefix-alist (cons entry
-						gnus-cite-prefix-alist))
-	     ;; Remove articles from other prefixes.
-	     (let ((loop alist)
-		   current)
-	       (while loop
-		 (setq current (car loop)
-		       loop (cdr loop))
-		 (setcdr current 
-			 (gnus-set-difference (cdr current) numbers))))))))
-  ;; No citations have been connected to attribution lines yet.
-  (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil))
-
-  ;; Parse current buffer searching for attribution lines.
-  (goto-char (point-min))
-  (search-forward "\n\n" nil t)
-  (while (re-search-forward gnus-cite-attribution-suffix (point-max) t)
-    (let* ((start (match-beginning 0))
-	   (end (match-end 0))
-	   (wrote (count-lines (point-min) end))
-	   (prefix (gnus-cite-find-prefix wrote))
-	   ;; Check previous line for an attribution leader.
-	   (tag (progn
-		  (beginning-of-line 1)
-		  (and (looking-at gnus-supercite-secondary-regexp)
-		       (buffer-substring (match-beginning 1)
-					 (match-end 1)))))
-	   (in (progn
-		 (goto-char start)
-		 (and (re-search-backward gnus-cite-attribution-prefix
-					  (save-excursion
-					    (beginning-of-line 0)
-					    (point))
-					  t)
-		      (not (re-search-forward gnus-cite-attribution-suffix
-					      start t))
-		      (count-lines (point-min) (1+ (point)))))))
-      (if (eq wrote in)
-	  (setq in nil))
-      (goto-char end)
-      (setq gnus-cite-loose-attribution-alist
-	    (cons (list wrote in prefix tag)
-		  gnus-cite-loose-attribution-alist))))
-  ;; Find exact supercite citations.
-  (gnus-cite-match-attributions 'small nil
-				(lambda (prefix tag)
-				  (if tag
-				      (concat "\\`" 
-					      (regexp-quote prefix) "[ \t]*" 
-					      (regexp-quote tag) ">"))))
-  ;; Find loose supercite citations after attributions.
-  (gnus-cite-match-attributions 'small t
-				(lambda (prefix tag)
-				  (if tag (concat "\\<"
-						  (regexp-quote tag)
-						  "\\>"))))
-  ;; Find loose supercite citations anywhere.
-  (gnus-cite-match-attributions 'small nil
-				(lambda (prefix tag)
-				  (if tag (concat "\\<"
-						  (regexp-quote tag)
-						  "\\>"))))
-  ;; Find nested citations after attributions.
-  (gnus-cite-match-attributions 'small-if-unique t
-				(lambda (prefix tag)
-				  (concat "\\`" (regexp-quote prefix) ".+")))
-  ;; Find nested citations anywhere.
-  (gnus-cite-match-attributions 'small nil
-				(lambda (prefix tag)
-				  (concat "\\`" (regexp-quote prefix) ".+")))
-  ;; Remove loose prefixes with too few lines.
-  (let ((alist gnus-cite-loose-prefix-alist)
-	entry)
-    (while alist
-      (setq entry (car alist)
-	    alist (cdr alist))
-      (if (< (length (cdr entry)) gnus-cite-minimum-match-count)
-	  (setq gnus-cite-prefix-alist
-		(delq entry gnus-cite-prefix-alist)
-		gnus-cite-loose-prefix-alist
-		(delq entry gnus-cite-loose-prefix-alist)))))
-  ;; Find flat attributions.
-  (gnus-cite-match-attributions 'first t nil)
-  ;; Find any attributions (are we getting desperate yet?).
-  (gnus-cite-match-attributions 'first nil nil))
-
-(defun gnus-cite-match-attributions (sort after fun)
-  ;; Match all loose attributions and citations (SORT AFTER FUN) .
-  ;;
-  ;; If SORT is `small', the citation with the shortest prefix will be
-  ;; used, if it is `first' the first prefix will be used, if it is
-  ;; `small-if-unique' the shortest prefix will be used if the
-  ;; attribution line does not share its own prefix with other
-  ;; loose attribution lines, otherwise the first prefix will be used.
-  ;;
-  ;; If AFTER is non-nil, only citations after the attribution line
-  ;; will be considered.
-  ;;
-  ;; If FUN is non-nil, it will be called with the arguments (WROTE
-  ;; PREFIX TAG) and expected to return a regular expression.  Only
-  ;; citations whose prefix matches the regular expression will be
-  ;; considered. 
-  ;; 
-  ;; WROTE is the attribution line number.
-  ;; PREFIX is the attribution line prefix.
-  ;; TAG is the Supercite tag on the attribution line.
-  (let ((atts gnus-cite-loose-attribution-alist)
-	(case-fold-search t)
-	att wrote in prefix tag regexp limit smallest best size)
-    (while atts
-      (setq att (car atts)
-	    atts (cdr atts)
-	    wrote (nth 0 att)
-	    in (nth 1 att)
-	    prefix (nth 2 att)
-	    tag (nth 3 att)
-	    regexp (if fun (funcall fun prefix tag) "")
-	    size (cond ((eq sort 'small) t)
-		       ((eq sort 'first) nil)
-		       (t (< (length (gnus-cite-find-loose prefix)) 2)))
-	    limit (if after wrote -1)
-	    smallest 1000000		       
-	    best nil)
-      (let ((cites gnus-cite-loose-prefix-alist)
-	    cite candidate numbers first compare)
-	(while cites
-	  (setq cite (car cites)
-		cites (cdr cites)
-		candidate (car cite)
-		numbers (cdr cite)
-		first (apply 'min numbers)
-		compare (if size (length candidate) first))
-	  (and (> first limit)
-	       regexp
-	       (string-match regexp candidate)
-	       (< compare smallest)
-	       (setq best cite
-		     smallest compare))))
-      (if (null best)
-	  ()
-	(setq gnus-cite-loose-attribution-alist
-	      (delq att gnus-cite-loose-attribution-alist))
-	(setq gnus-cite-attribution-alist 
-	      (cons (cons wrote (car best)) gnus-cite-attribution-alist))
-	(if in
-	    (setq gnus-cite-attribution-alist 
-		  (cons (cons in (car best)) gnus-cite-attribution-alist)))
-	(if (memq best gnus-cite-loose-prefix-alist)
-	    (let ((loop gnus-cite-prefix-alist)
-		  (numbers (cdr best))
-		  current)
-	      (setq gnus-cite-loose-prefix-alist
-		    (delq best gnus-cite-loose-prefix-alist))
-	      (while loop
-		(setq current (car loop)
-		      loop (cdr loop))
-		(if (eq current best)
-		    ()
-		  (setcdr current (gnus-set-difference (cdr current) numbers))
-		  (if (null (cdr current))
-		      (setq gnus-cite-loose-prefix-alist
-			    (delq current gnus-cite-loose-prefix-alist)
-			    atts (delq current atts)))))))))))
-
-(defun gnus-cite-find-loose (prefix)
-  ;; Return a list of loose attribution lines prefixed by PREFIX.
-  (let* ((atts gnus-cite-loose-attribution-alist)
-	 att line lines)
-    (while atts
-      (setq att (car atts)
-	    line (car att)
-	    atts (cdr atts))
-      (if (string-equal (gnus-cite-find-prefix line) prefix)
-	  (setq lines (cons line lines))))
-    lines))
-
-(defun gnus-cite-add-face (number prefix face)
-  ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
-  (when face
-    (let ((inhibit-point-motion-hooks t)
-	  from to)
-      (goto-line number)
-      (unless (eobp) ;; Sometimes things become confused.
-	(forward-char (length prefix))
-	(skip-chars-forward " \t")
-	(setq from (point))
-	(end-of-line 1)
-	(skip-chars-backward " \t")
-	(setq to (point))
-	(when (< from to)
-	  (gnus-overlay-put (gnus-make-overlay from to) 'face face))))))
-
-(defun gnus-cite-toggle (prefix)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-	  (numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
-	  (inhibit-point-motion-hooks t)
-	  number)
-      (while numbers
-	(setq number (car numbers)
-	      numbers (cdr numbers))
-	(goto-line number)
-	(cond ((get-text-property (point) 'invisible)
-	       (remove-text-properties (point) (progn (forward-line 1) (point))
-				       gnus-hidden-properties))
-	      ((assq number gnus-cite-attribution-alist))
-	      (t
-	       (gnus-add-text-properties 
-		(point) (progn (forward-line 1) (point))
-		 (nconc (list 'gnus-type 'cite)
-			gnus-hidden-properties))))))))
-
-(defun gnus-cite-find-prefix (line)
-  ;; Return citation prefix for LINE.
-  (let ((alist gnus-cite-prefix-alist)
-	(prefix "")
-	entry)
-    (while alist
-      (setq entry (car alist)
-	    alist (cdr alist))
-      (if (memq line (cdr entry))
-	  (setq prefix (car entry))))
-    prefix))
-
-(gnus-add-shutdown 'gnus-cache-close 'gnus)
-
-(defun gnus-cache-close ()
-  (setq gnus-cite-prefix-alist nil))
-
-(gnus-ems-redefine)
-
-(provide 'gnus-cite)
-
-;;; gnus-cite.el ends here
diff --git a/lisp/gnus-cus.el b/lisp/gnus-cus.el
deleted file mode 100644
index a83d578bec1..00000000000
--- a/lisp/gnus-cus.el
+++ /dev/null
@@ -1,683 +0,0 @@
-;;; gnus-cus.el --- User friendly customization of Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-;;
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Keywords: help, news
-;; Version: 0.1
-
-;; 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:
-
-(require 'custom)
-(require 'gnus-ems)
-(require 'browse-url)
-(eval-when-compile (require 'cl))
-
-;; The following is just helper functions and data, not meant to be set
-;; by the user.
-(defun gnus-make-face (color)
-  ;; Create entry for face with COLOR.
-  (custom-face-lookup color nil nil nil nil nil))
-
-(defvar gnus-face-light-name-list
-  '("light blue" "light cyan" "light yellow" "light pink"
-    "pale green" "beige" "orange" "magenta" "violet" "medium purple"
-    "turquoise"))
-
-(defvar gnus-face-dark-name-list
-  (list
-   ;; Not all servers have dark blue in rgb.txt.
-   (if (and (eq window-system 'x) (x-color-defined-p "dark blue"))
-       "dark blue"
-     "royal blue")
-   "firebrick" "dark green" "OrangeRed" 
-   "dark khaki" "dark violet" "SteelBlue4"))
-; CornflowerBlue SeaGreen OrangeRed SteelBlue4 DeepPink3
-; DarkOlviveGreen4 
-
-(custom-declare '()
-  '((tag . "Gnus")
-    (doc . "\
-The coffee-brewing, all singing, all dancing, kitchen sink newsreader.")
-    (type . group)
-    (data
-     ((tag . "Visual")
-      (doc . "\
-Gnus can be made colorful and fun or grey and dull as you wish.")
-      (type . group)
-      (data
-       ((tag . "Visual")
-	(doc . "Enable visual features.
-If `visual' is disabled, there will be no menus and few faces.  Most of
-the visual customization options below will be ignored.  Gnus will use
-less space and be faster as a result.")
-	(default . 
-	  (summary-highlight group-highlight
-			     article-highlight 
-			     mouse-face
-			     summary-menu group-menu article-menu
-			     tree-highlight menu highlight
-			     browse-menu server-menu
-			     page-marker tree-menu binary-menu pick-menu
-			     grouplens-menu))
-	(name . gnus-visual)
-	(type . sexp))
-       ((tag . "WWW Browser")
-	(doc . "\
-WWW Browser to call when clicking on an URL button in the article buffer.
-
-You can choose between one of the predefined browsers, or `Other'.")
-	(name . browse-url-browser-function)
-	(calculate . (cond ((boundp 'browse-url-browser-function)
-			    browse-url-browser-function)
-			   ((fboundp 'w3-fetch) 
-			    'w3-fetch)
-			   ((eq window-system 'x) 
-			    'gnus-netscape-open-url)))
-	(type . choice)
-	(data
-	 ((tag . "W3")
-	  (type . const)
-	  (default . w3-fetch))
-	 ((tag . "Netscape")
-	  (type . const)
-	  (default . browse-url-netscape))
-	 ((prompt . "Other")
-	  (doc . "\
-You must specify the name of a Lisp function here.  The lisp function
-should open a WWW browser when called with an URL (a string).
-")
-	  (default . __uninitialized__)
-	  (type . symbol))))
-       ((tag . "Mouse Face")
-	(doc . "\
-Face used for group or summary buffer mouse highlighting.
-The line beneath the mouse pointer will be highlighted with this
-face.")
-	(name . gnus-mouse-face)
-	(calculate . (condition-case ()
-			 (if (gnus-visual-p 'mouse-face 'highlight)
-			     (if (boundp 'gnus-mouse-face)
-				 gnus-mouse-face
-			       'highlight)
-			   'default)
-		       (error 'default)))
-	(type . face))
-       ((tag . "Article Display")
-	(doc . "Controls how the article buffer will look.
-
-If you leave the list empty, the article will appear exactly as it is
-stored on the disk.  The list entries will hide or highlight various
-parts of the article, making it easier to find the information you
-want.")
-	(name . gnus-article-display-hook)
-	(type . list)
-	(calculate 
-	 . (if (and (string-match "xemacs" emacs-version)
-		    (featurep 'xface))
-	       '(gnus-article-hide-headers-if-wanted
-		gnus-article-hide-boring-headers
-		gnus-article-treat-overstrike
-		gnus-article-maybe-highlight
-		gnus-article-display-x-face)
-	     '(gnus-article-hide-headers-if-wanted
-	      gnus-article-hide-boring-headers
-	      gnus-article-treat-overstrike
-	      gnus-article-maybe-highlight)))
-	(data 
-	 ((type . repeat)
-	  (header . nil)
-	  (data
-	   (tag . "Filter")
-	   (type . choice)
-	   (data
-	    ((tag . "Treat Overstrike")
-	     (doc . "\
-Convert use of overstrike into bold and underline.
-
-Two identical letters separated by a backspace are displayed as a
-single bold letter, while a letter followed by a backspace and an
-underscore will be displayed as a single underlined letter.  This
-technique was developed for old line printers (think about it), and is
-still in use on some newsgroups, in particular the ClariNet
-hierarchy.
-")
-	     (type . const)
-	     (default . 
-	       gnus-article-treat-overstrike))
-	    ((tag . "Word Wrap")
-	     (doc . "\
-Format too long lines.
-")
-	     (type . const)
-	     (default . gnus-article-word-wrap))
-	    ((tag . "Remove CR")
-	     (doc . "\
-Remove carriage returns from an article.
-")
-	     (type . const)
-	     (default . gnus-article-remove-cr))
-	    ((tag . "Display X-Face")
-	     (doc . "\
-Look for an X-Face header and display it if present.
-
-See also `X Face Command' for a definition of the external command
-used for decoding and displaying the face.
-")
-	     (type . const)
-	     (default . gnus-article-display-x-face))
-	    ((tag . "Unquote Printable")
-	     (doc . "\
-Transform MIME quoted printable into 8-bit characters.
-
-Quoted printable is often seen by strings like `=EF' where you would
-expect a non-English letter.
-")
-	     (type . const)
-	     (default .
-	       gnus-article-de-quoted-unreadable))
-	    ((tag . "Universal Time")
-	     (doc . "\
-Convert date header to universal time.
-")
-	     (type . const)
-	     (default . gnus-article-date-ut))
-	    ((tag . "Local Time")
-	     (doc . "\
-Convert date header to local timezone.
-")
-	     (type . const)
-	     (default . gnus-article-date-local))
-	    ((tag . "Lapsed Time")
-	     (doc . "\
-Replace date header with a header showing the articles age.
-")
-	     (type . const)
-	     (default . gnus-article-date-lapsed))
-	    ((tag . "Highlight")
-	     (doc . "\
-Highlight headers, citations, signature, and buttons.
-")
-	     (type . const)
-	     (default . gnus-article-highlight))
-	    ((tag . "Maybe Highlight")
-	     (doc . "\
-Highlight headers, signature, and buttons if `Visual' is turned on.
-")
-	     (type . const)
-	     (default . 
-	       gnus-article-maybe-highlight))
-	    ((tag . "Highlight Some")
-	     (doc . "\
-Highlight headers, signature, and buttons.
-")
-	     (type . const)
-	     (default . gnus-article-highlight-some))
-	    ((tag . "Highlight Headers")
-	     (doc . "\
-Highlight headers as specified by `Article Header Highlighting'.
-")
-	     (type . const)
-	     (default .
-	       gnus-article-highlight-headers))
-	    ((tag . "Highlight Signature")
-	     (doc . "\
-Highlight the signature as specified by `Article Signature Face'.
-")
-	     (type . const)
-	     (default .
-	       gnus-article-highlight-signature))
-	    ((tag . "Citation")
-	     (doc . "\
-Highlight the citations as specified by `Citation Faces'.
-")
-	     (type . const)
-	     (default . 
-	       gnus-article-highlight-citation))
-	    ((tag . "Hide")
-	     (doc . "\
-Hide unwanted headers, excess citation, and the signature.
-")
-	     (type . const)
-	     (default . gnus-article-hide))
-	    ((tag . "Hide Headers If Wanted")
-	     (doc . "\
-Hide headers, but allow user to display them with `t' or `v'.
-")
-	     (type . const)
-	     (default . 
-	       gnus-article-hide-headers-if-wanted))
-	    ((tag . "Hide Headers")
-	     (doc . "\
-Hide unwanted headers and possibly sort them as well.
-Most likely you want to use `Hide Headers If Wanted' instead.
-")
-	     (type . const)
-	     (default . gnus-article-hide-headers))
-	    ((tag . "Hide Signature")
-	     (doc . "\
-Hide the signature.
-")
-	     (type . const)
-	     (default . gnus-article-hide-signature))
-	    ((tag . "Hide Excess Citations")
-	     (doc . "\
-Hide excess citation.
-
-Excess is defined by `Citation Hide Percentage' and `Citation Hide Absolute'.
-")
-	     (type . const)
-	     (default . 
-	       gnus-article-hide-citation-maybe))
-	    ((tag . "Hide Citations")
-	     (doc . "\
-Hide all cited text.
-")
-	     (type . const)
-	     (default . gnus-article-hide-citation))
-	    ((tag . "Add Buttons")
-	     (doc . "\
-Make URL's into clickable buttons.
-")
-	     (type . const)
-	     (default . gnus-article-add-buttons))
-	    ((prompt . "Other")
-	     (doc . "\
-Name of Lisp function to call.
-
-Push the `Filter' button to select one of the predefined filters.
-")
-	     (type . symbol)))))))
-       ((tag . "Article Button Face")
-	(doc . "\
-Face used for highlighting buttons in the article buffer.
-
-An article button is a piece of text that you can activate by pressing
-`RET' or `mouse-2' above it.")
-	(name . gnus-article-button-face)
-	(default . bold)
-	(type . face))
-       ((tag . "Article Mouse Face")
-	(doc . "\
-Face used for mouse highlighting in the article buffer.
-
-Article buttons will be displayed in this face when the cursor is
-above them.")
-	(name . gnus-article-mouse-face)
-	(default . highlight)
-	(type . face))
-       ((tag . "Article Signature Face")
-	(doc . "\
-Face used for highlighting a signature in the article buffer.")
-	(name . gnus-signature-face)
-	(default . italic)
-	(type . face))
-       ((tag . "Article Header Highlighting")
-	(doc . "\
-Controls highlighting of article header.
-
-Below is a list of article header names, and the faces used for
-displaying the name and content of the header.  The `Header' field
-should contain the name of the header.  The field actually contains a
-regular expression that should match the beginning of the header line,
-but if you don't know what a regular expression is, just write the
-name of the header.  The second field is the `Name' field, which
-determines how the the header name (i.e. the part of the header left
-of the `:') is displayed.  The third field is the `Content' field,
-which determines how the content (i.e. the part of the header right of
-the `:') is displayed.  
-
-If you leave the last `Header' field in the list empty, the `Name' and
-`Content' fields will determine how headers not listed above are
-displayed.  
-
-If you only want to change the display of the name part for a specific
-header, specify `None' in the `Content' field.  Similarly, specify
-`None' in the `Name' field if you only want to leave the name part
-alone.")
-	(name . gnus-header-face-alist)
-	(type . list)
-	(calculate
-	 . (cond 
-	    ((not (eq gnus-display-type 'color))
-	     '(("" bold italic)))
-	    ((eq gnus-background-mode 'dark)
-	     (list 
-	      (list "From" nil 
-		    (custom-face-lookup "light blue" nil nil t t nil))
-	      (list "Subject" nil 
-		    (custom-face-lookup "pink" nil nil t t nil))
-	      (list "Newsgroups:.*," nil
-		    (custom-face-lookup "yellow" nil nil t t nil))
-	      (list 
-	       "" 
-	       (custom-face-lookup "cyan" nil nil t nil nil)
-	       (custom-face-lookup "forestgreen" nil nil nil t 
-				   nil))))
-	    (t
-	     (list
-	      (list "From" nil
-		    (custom-face-lookup "MidnightBlue" nil nil t t nil))
-	      (list "Subject" nil 
-		    (custom-face-lookup "firebrick" nil nil t t nil))
-	      (list "Newsgroups:.*," nil
-		    (custom-face-lookup "indianred" nil nil t t nil))
-	      (list ""
-		    (custom-face-lookup 
-		     "DarkGreen" nil nil t nil nil)
-		    (custom-face-lookup "DarkGreen" nil nil
-					nil t nil))))))
-	(data
-	 ((type . repeat)
-	  (header . nil)
-	  (data 
-	   (type . list)
-	   (compact . t)
-	   (data
-	    ((type . string)
-	     (prompt . "Header")
-	     (tag . "Header "))
-	    "\n            "
-	    ((type . face)
-	     (prompt . "Name")
-	     (tag . "Name   "))
-	    "\n            "
-	    ((type . face)
-	     (tag . "Content"))
-	    "\n")))))
-       ((tag . "Attribution Face")
-	(doc . "\
-Face used for attribution lines.
-It is merged with the face for the cited text belonging to the attribution.")
-	(name . gnus-cite-attribution-face)
-	(default . underline)
-	(type . face))
-       ((tag . "Citation Faces")
-	(doc . "\
-List of faces used for highlighting citations. 
-
-When there are citations from multiple articles in the same message,
-Gnus will try to give each citation from each article its own face.
-This should make it easier to see who wrote what.")
-	(name . gnus-cite-face-list)
-	(import . gnus-custom-import-cite-face-list)
-	(type . list)
-	(calculate . (cond ((not (eq gnus-display-type 'color))
-			    '(italic))
-			   ((eq gnus-background-mode 'dark)
-			    (mapcar 'gnus-make-face 
-				    gnus-face-light-name-list))
-			   (t 
-			    (mapcar 'gnus-make-face 
-				    gnus-face-dark-name-list))))
-	(data
-	 ((type . repeat)
-	  (header . nil)
-	  (data (type . face)
-		(tag . "Face")))))
-       ((tag . "Citation Hide Percentage")
-	(doc . "\
-Only hide excess citation if above this percentage of the body.")
-	(name . gnus-cite-hide-percentage)
-	(default . 50)
-	(type . integer))
-       ((tag . "Citation Hide Absolute")
-	(doc . "\
-Only hide excess citation if above this number of lines in the body.")
-	(name . gnus-cite-hide-absolute)
-	(default . 10)
-	(type . integer))
-       ((tag . "Summary Selected Face")
-	(doc . "\
-Face used for highlighting the current article in the summary buffer.")
-	(name . gnus-summary-selected-face)
-	(default . underline)
-	(type . face))
-       ((tag . "Summary Line Highlighting")
-	(doc . "\
-Controls the highlighting of summary buffer lines. 
-
-Below is a list of `Form'/`Face' pairs.  When deciding how a a
-particular summary line should be displayed, each form is
-evaluated. The content of the face field after the first true form is
-used.  You can change how those summary lines are displayed, by
-editing the face field.  
-
-It is also possible to change and add form fields, but currently that
-requires an understanding of Lisp expressions.  Hopefully this will
-change in a future release.  For now, you can use the following
-variables in the Lisp expression:
-
-score:   The article's score
-default: The default article score.
-below:   The score below which articles are automatically marked as read. 
-mark:    The article's mark.")
-	(name . gnus-summary-highlight)
-	(type . list)
-	(calculate 
-	 . (cond
-	    ((not (eq gnus-display-type 'color))
-	     '(((> score default) . bold)
-	       ((< score default) . italic)))
-	    ((eq gnus-background-mode 'dark)
-	     (list
-	      (cons 
-	       '(= mark gnus-canceled-mark)
-	       (custom-face-lookup "yellow" "black" nil
-				   nil nil nil))
-	      (cons '(and (> score default) 
-			  (or (= mark gnus-dormant-mark)
-			      (= mark gnus-ticked-mark)))
-		    (custom-face-lookup 
-		     "pink" nil nil t nil nil))
-	      (cons '(and (< score default) 
-			  (or (= mark gnus-dormant-mark)
-			      (= mark gnus-ticked-mark)))
-		    (custom-face-lookup "pink" nil nil 
-					nil t nil))
-	      (cons '(or (= mark gnus-dormant-mark)
-			 (= mark gnus-ticked-mark))
-		    (custom-face-lookup 
-		     "pink" nil nil nil nil nil))
-
-	      (cons
-	       '(and (> score default) (= mark gnus-ancient-mark))
-	       (custom-face-lookup "medium blue" nil nil t
-				   nil nil))
-	      (cons 
-	       '(and (< score default) (= mark gnus-ancient-mark))
-	       (custom-face-lookup "SkyBlue" nil nil
-				   nil t nil))
-	      (cons 
-	       '(= mark gnus-ancient-mark)
-	       (custom-face-lookup "SkyBlue" nil nil
-				   nil nil nil))
-	      (cons '(and (> score default) (= mark gnus-unread-mark))
-		    (custom-face-lookup "white" nil nil t
-					nil nil))
-	      (cons '(and (< score default) (= mark gnus-unread-mark))
-		    (custom-face-lookup "white" nil nil
-					nil t nil))
-	      (cons '(= mark gnus-unread-mark)
-		    (custom-face-lookup
-		     "white" nil nil nil nil nil))
-
-	      (cons '(> score default) 'bold)
-	      (cons '(< score default) 'italic)))
-	    (t
-	     (list
-	      (cons
-	       '(= mark gnus-canceled-mark)
-	       (custom-face-lookup
-		"yellow" "black" nil nil nil nil))
-	      (cons '(and (> score default) 
-			  (or (= mark gnus-dormant-mark)
-			      (= mark gnus-ticked-mark)))
-		    (custom-face-lookup "firebrick" nil nil
-					t nil nil))
-	      (cons '(and (< score default) 
-			  (or (= mark gnus-dormant-mark)
-			      (= mark gnus-ticked-mark)))
-		    (custom-face-lookup "firebrick" nil nil
-					nil t nil))
-	      (cons 
-	       '(or (= mark gnus-dormant-mark)
-		    (= mark gnus-ticked-mark))
-	       (custom-face-lookup 
-		"firebrick" nil nil nil nil nil))
-
-	      (cons '(and (> score default) (= mark gnus-ancient-mark))
-		    (custom-face-lookup "RoyalBlue" nil nil
-					t nil nil))
-	      (cons '(and (< score default) (= mark gnus-ancient-mark))
-		    (custom-face-lookup "RoyalBlue" nil nil
-					nil t nil))
-	      (cons 
-	       '(= mark gnus-ancient-mark)
-	       (custom-face-lookup
-		"RoyalBlue" nil nil nil nil nil))
-
-	      (cons '(and (> score default) (/= mark gnus-unread-mark))
-		    (custom-face-lookup "DarkGreen" nil nil
-					t nil nil))
-	      (cons '(and (< score default) (/= mark gnus-unread-mark))
-		    (custom-face-lookup "DarkGreen" nil nil
-					nil t nil))
-	      (cons
-	       '(/= mark gnus-unread-mark)
-	       (custom-face-lookup "DarkGreen" nil nil 
-				   nil nil nil))
-
-	      (cons '(> score default) 'bold)
-	      (cons '(< score default) 'italic)))))
-	(data
-	 ((type . repeat)
-	  (header . nil)
-	  (data (type . pair)
-		(compact . t)
-		(data ((type . sexp)
-		       (width . 60)
-		       (tag . "Form"))
-		      "\n            "
-		      ((type . face)
-		       (tag . "Face"))
-		      "\n")))))
-
-       ((tag . "Group Line Highlighting")
-	(doc . "\
-Controls the highlighting of group buffer lines. 
-
-Below is a list of `Form'/`Face' pairs.  When deciding how a a
-particular group line should be displayed, each form is
-evaluated. The content of the face field after the first true form is
-used.  You can change how those group lines are displayed by
-editing the face field.  
-
-It is also possible to change and add form fields, but currently that
-requires an understanding of Lisp expressions.  Hopefully this will
-change in a future release.  For now, you can use the following
-variables in the Lisp expression:
-
-group: The name of the group.
-unread: The number of unread articles in the group.
-method: The select method used.
-mailp: Whether it's a mail group or not.
-level: The level of the group.
-score: The score of the group.
-ticked: The number of ticked articles.")
-	(name . gnus-group-highlight)
-	(type . list)
-	(calculate 
-	 . (cond 
-	    ((not (eq gnus-display-type 'color))
-	     '((mailp . bold)
-	       ((= unread 0) . italic)))
-	    ((eq gnus-background-mode 'dark)
-	     `(((and (not mailp) (eq level 1)) .
-		,(custom-face-lookup "PaleTurquoise" nil nil t))
-	       ((and (not mailp) (eq level 2)) .
-		,(custom-face-lookup "turquoise" nil nil t))
-	       ((and (not mailp) (eq level 3)) .
-		,(custom-face-lookup "MediumTurquoise" nil nil t))
-	       ((and (not mailp) (>= level 4)) .
-		,(custom-face-lookup "DarkTurquoise" nil nil t))
-	       ((and mailp (eq level 1)) .
-		,(custom-face-lookup "aquamarine1" nil nil t))
-	       ((and mailp (eq level 2)) .
-		,(custom-face-lookup "aquamarine2" nil nil t))
-	       ((and mailp (eq level 3)) .
-		,(custom-face-lookup "aquamarine3" nil nil t))
-	       ((and mailp (>= level 4)) .
-		,(custom-face-lookup "aquamarine4" nil nil t))
-	       ))
-	    (t
-	     `(((and (not mailp) (<= level 3)) .
-		,(custom-face-lookup "ForestGreen" nil nil t))
-	       ((and (not mailp) (eq level 4)) .
-		,(custom-face-lookup "DarkGreen" nil nil t))
-	       ((and (not mailp) (eq level 5)) .
-		,(custom-face-lookup "CadetBlue4" nil nil t))
-	       ((and mailp (eq level 1)) .
-		,(custom-face-lookup "DeepPink3" nil nil t))
-	       ((and mailp (eq level 2)) .
-		,(custom-face-lookup "HotPink3" nil nil t))
-	       ((and mailp (eq level 3)) .
-		,(custom-face-lookup
-		  ;; Not all servers have dark magenta in rgb.txt.
-		  (if (and (eq window-system 'x)
-			   (x-color-defined-p "dark magenta"))
-		      "dark magenta"
-		    "maroon")
-		  nil nil t))
-	       ((and mailp (eq level 4)) .
-		,(custom-face-lookup "DeepPink4" nil nil t))
-	       ((and mailp (> level 4)) .
-		,(custom-face-lookup "DarkOrchid4" nil nil t))
-	       ))))
-	(data
-	 ((type . repeat)
-	  (header . nil)
-	  (data (type . pair)
-		(compact . t)
-		(data ((type . sexp)
-		       (width . 60)
-		       (tag . "Form"))
-		      "\n            "
-		      ((type . face)
-		       (tag . "Face"))
-		      "\n")))))
-
-       ;; Do not define `gnus-button-alist' before we have
-       ;; some `complexity' attribute so we can hide it from
-       ;; beginners. 
-       )))))
-
-(defun gnus-custom-import-cite-face-list (custom alist)
-  ;; Backward compatible grokking of light and dark.
-  (cond ((eq alist 'light)
-	 (setq alist (mapcar 'gnus-make-face gnus-face-light-name-list)))
-	((eq alist 'dark)
-	 (setq alist (mapcar 'gnus-make-face gnus-face-dark-name-list))))
-  (funcall (custom-super custom 'import) custom alist))
-
-(provide 'gnus-cus)
-
-;;; gnus-cus.el ends here
diff --git a/lisp/gnus-demon.el b/lisp/gnus-demon.el
deleted file mode 100644
index 431eb3220ca..00000000000
--- a/lisp/gnus-demon.el
+++ /dev/null
@@ -1,222 +0,0 @@
-;;; gnus-demon.el --- daemonic Gnus behaviour
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'gnus)
-
-(eval-when-compile (require 'cl))
-
-(defvar gnus-demon-handlers nil
-  "Alist of daemonic handlers to be run at intervals.
-Each handler is a list on the form
-
-\(FUNCTION TIME IDLE)
-
-FUNCTION is the function to be called. 
-TIME is the number of `gnus-demon-timestep's between each call.  
-If nil, never call.  If t, call each `gnus-demon-timestep'.
-If IDLE is t, only call if Emacs has been idle for a while.  If IDLE
-is a number, only call when Emacs has been idle more than this number
-of `gnus-demon-timestep's.  If IDLE is nil, don't care about
-idleness.  If IDLE is a number and TIME is nil, then call once each
-time Emacs has been idle for IDLE `gnus-demon-timestep's.")
-
-(defvar gnus-demon-timestep 60
-  "*Number of seconds in each demon timestep.")
-
-;;; Internal variables.
-
-(defvar gnus-demon-timer nil)
-(defvar gnus-demon-idle-has-been-called nil)
-(defvar gnus-demon-idle-time 0)
-(defvar gnus-demon-handler-state nil)
-(defvar gnus-demon-is-idle nil)
-(defvar gnus-demon-last-keys nil) 
-
-(eval-and-compile
-  (autoload 'timezone-parse-date "timezone")
-  (autoload 'timezone-make-arpa-date "timezone"))
-
-;;; Functions.
-
-(defun gnus-demon-add-handler (function time idle)
-  "Add the handler FUNCTION to be run at TIME and IDLE."
-  ;; First remove any old handlers that use this function.
-  (gnus-demon-remove-handler function)
-  ;; Then add the new one.
-  (push (list function time idle) gnus-demon-handlers)
-  (gnus-demon-init))
-
-(defun gnus-demon-remove-handler (function &optional no-init)
-  "Remove the handler FUNCTION from the list of handlers."
-  (setq gnus-demon-handlers 
-	(delq (assq function gnus-demon-handlers)
-	      gnus-demon-handlers))
-  (or no-init (gnus-demon-init)))
-
-(defun gnus-demon-init ()
-  "Initialize the Gnus daemon."
-  (interactive)
-  (gnus-demon-cancel)
-  (if (null gnus-demon-handlers)
-      () ; Nothing to do.
-    ;; Set up timer.
-    (setq gnus-demon-timer 
-	  (nnheader-run-at-time 
-	   gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
-    ;; Reset control variables.
-    (setq gnus-demon-handler-state
-	  (mapcar 
-	   (lambda (handler)
-	     (list (car handler) (gnus-demon-time-to-step (nth 1 handler))
-		   (nth 2 handler)))
-	   gnus-demon-handlers))
-    (setq gnus-demon-idle-time 0)
-    (setq gnus-demon-idle-has-been-called nil)
-    (setq gnus-use-demon t)))
-
-(gnus-add-shutdown 'gnus-demon-cancel 'gnus)
-
-(defun gnus-demon-cancel ()
-  "Cancel any Gnus daemons."
-  (interactive)
-  (and gnus-demon-timer
-       (nnheader-cancel-timer gnus-demon-timer))
-  (setq gnus-demon-timer nil
-	gnus-use-demon nil))
-
-(defun gnus-demon-is-idle-p ()
-  "Whether Emacs is idle or not."
-  ;; We do this simply by comparing the 100 most recent keystrokes
-  ;; with the ones we had last time.  If they are the same, one might
-  ;; guess that Emacs is indeed idle.  This only makes sense if one
-  ;; calls this function seldom -- like once a minute, which is what
-  ;; we do here.
-  (let ((keys (recent-keys)))
-    (or (equal keys gnus-demon-last-keys)
-	(progn
-	  (setq gnus-demon-last-keys keys)
-	  nil))))
-
-(defun gnus-demon-time-to-step (time)
-  "Find out how many seconds to TIME, which is on the form \"17:43\"."
-  (if (not (stringp time))
-      time
-    (let* ((date (current-time-string))
-	   (dv (timezone-parse-date date))
-	   (tdate (timezone-make-arpa-date 
-		   (string-to-number (aref dv 0))
-		   (string-to-number (aref dv 1))
-		   (string-to-number (aref dv 2)) time
-		   (or (aref dv 4) "UT")))
-	   (nseconds (gnus-time-minus
-		      (gnus-encode-date tdate) (gnus-encode-date date))))
-      (round
-       (/ (if (< nseconds 0)
-	      (+ nseconds (* 60 60 24))
-	    nseconds) gnus-demon-timestep)))))
-
-(defun gnus-demon ()
-  "The Gnus daemon that takes care of running all Gnus handlers."
-  ;; Increase or reset the time Emacs has been idle.
-  (if (gnus-demon-is-idle-p)
-      (incf gnus-demon-idle-time)
-    (setq gnus-demon-idle-time 0)
-    (setq gnus-demon-idle-has-been-called nil))
-  ;; Then we go through all the handler and call those that are
-  ;; sufficiently ripe.
-  (let ((handlers gnus-demon-handler-state)
-	handler time idle)
-    (while handlers
-      (setq handler (pop handlers))
-      (cond 
-       ((numberp (setq time (nth 1 handler)))
-	;; These handlers use a regular timeout mechanism.  We decrease
-	;; the timer if it hasn't reached zero yet.
-	(or (zerop time)
-	    (setcar (nthcdr 1 handler) (decf time)))
-	(and (zerop time)		; If the timer now is zero...
-	     (or (not (setq idle (nth 2 handler))) ; Don't care about idle.
-		 (and (numberp idle)	; Numerical idle...
-		      (< idle gnus-demon-idle-time)) ; Idle timed out.
-		 gnus-demon-is-idle)	; Or just need to be idle.
-	     ;; So we call the handler.
-	     (progn
-	       (funcall (car handler))
-	       ;; And reset the timer.
-	       (setcar (nthcdr 1 handler)
-		       (gnus-demon-time-to-step
-			(nth 1 (assq (car handler) gnus-demon-handlers)))))))
-       ;; These are only supposed to be called when Emacs is idle. 
-       ((null (setq idle (nth 2 handler)))
-	;; We do nothing.
-	)
-       ((not (numberp idle))
-	;; We want to call this handler each and every time that
-	;; Emacs is idle. 
-	(funcall (car handler)))
-       (t
-	;; We want to call this handler only if Emacs has been idle
-	;; for a specified number of timesteps.
-	(and (not (memq (car handler) gnus-demon-idle-has-been-called))
-	     (< idle gnus-demon-idle-time)
-	     (progn
-	       (funcall (car handler))
-	       ;; Make sure the handler won't be called once more in
-	       ;; this idle-cycle.
-	       (push (car handler) gnus-demon-idle-has-been-called))))))))
-
-(defun gnus-demon-add-nocem ()
-  "Add daemonic NoCeM handling to Gnus."
-  (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 t))
-
-(defun gnus-demon-scan-nocem ()
-  "Scan NoCeM groups for NoCeM messages."
-  (gnus-nocem-scan-groups))
-
-(defun gnus-demon-add-disconnection ()
-  "Add daemonic server disconnection to Gnus."
-  (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
-
-(defun gnus-demon-close-connections ()
-  (gnus-close-backends))
-
-(defun gnus-demon-add-scanmail ()
-  "Add daemonic scanning of mail from the mail backends."
-  (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
-
-(defun gnus-demon-scan-mail ()
-  (let ((servers gnus-opened-servers)
-	server)
-    (while (setq server (car (pop servers)))
-      (and (gnus-check-backend-function 'request-scan (car server))
-	   (or (gnus-server-opened server)
-	       (gnus-open-server server))
-	   (gnus-request-scan nil server)))))
-
-(provide 'gnus-demon)
-
-;;; gnus-demon.el ends here
diff --git a/lisp/gnus-edit.el b/lisp/gnus-edit.el
deleted file mode 100644
index 4ac5e6777a1..00000000000
--- a/lisp/gnus-edit.el
+++ /dev/null
@@ -1,630 +0,0 @@
-;;; gnus-edit.el --- Gnus SCORE file editing
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-;;
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Keywords: news, help
-;; Version: 0.2
-
-;;; Commentary:
-;;
-;; Type `M-x gnus-score-customize RET' to invoke.
-
-;;; Code:
-
-(require 'custom)
-(require 'gnus-score)
-(eval-when-compile (require 'cl))
-
-(defconst gnus-score-custom-data
-  '((tag . "Score")
-    (doc . "Customization of Gnus SCORE files.
-
-SCORE files allow you to assign a score to each article when you enter
-a group, and automatically mark the articles as read or delete them
-based on the score.  In the summary buffer you can use the score to
-sort the articles by score (`C-c C-s C-s') or to jump to the unread
-article with the highest score (`,').")
-    (type . group)
-    (data "\n"
-	  ((header . nil)
-	   (doc . "Name of SCORE file to customize.
-
-Enter the name in the `File' field, then push the [Load] button to
-load it.  When done editing, push the [Save] button to save the file.
-
-Several score files may apply to each group, and several groups may
-use the same score file.  This is controlled implicitly by the name of
-the score file and the value of the global variable
-`gnus-score-find-score-files-function', and explicitly by the the
-`Files' and `Exclude Files' entries.") 
-	   (compact . t)
-	   (type . group)
-	   (data ((tag . "Load")
-		  (type . button)
-		  (query . gnus-score-custom-load))
-		 ((tag . "Save")
-		  (type . button)
-		  (query . gnus-score-custom-save))
-		 ((name . file)
-		  (tag . "File")
-		  (directory . gnus-kill-files-directory)
-		  (default-file . "SCORE")
-		  (type . file))))
-	  ((name . files)
-	   (tag . "Files")
-	   (doc . "\
-List of score files to load when the the current score file is loaded.
-You can use this to share score entries between multiple score files.
-
-Push the `[INS]' button add a score file to the list, or `[DEL]' to
-delete a score file from the list.")
-	   (type . list)
-	   (data ((type . repeat)
-		  (header . nil)
-		  (data (type . file)
-			(directory . gnus-kill-files-directory)))))
-	  ((name . exclude-files)
-	   (tag . "Exclude Files")
-	   (doc . "\
-List of score files to exclude when the the current score file is loaded.
-You can use this if you have a score file you want to share between a
-number of newsgroups, except for the newsgroup this score file
-matches.  [ Did anyone get that? ]
-
-Push the `[INS]' button add a score file to the list, or `[DEL]' to
-delete a score file from the list.")
-	   (type . list)
-	   (data ((type . repeat)
-		  (header . nil)
-		  (data (type . file)
-			(directory . gnus-kill-files-directory)))))
-	  ((name . mark)
-	   (tag . "Mark")
-	   (doc . "\
-Articles below this score will be automatically marked as read.
-
-This means that when you enter the summary buffer, the articles will
-be shown but will already be marked as read.  You can then press `x'
-to get rid of them entirely.
-
-By default articles with a negative score will be marked as read.  To
-change this, push the `Mark' button, and choose `Integer'.  You can
-then enter a value in the `Mark' field.")
-	   (type . gnus-score-custom-maybe-type))
-	  ((name . expunge)
-	   (tag . "Expunge")
-	   (doc . "\
-Articles below this score will not be shown in the summary buffer.")
-	   (type . gnus-score-custom-maybe-type))
-	  ((name . mark-and-expunge)
-	   (tag . "Mark and Expunge")
-	   (doc . "\
-Articles below this score will be marked as read, but not shown.
-
-Someone should explain me the difference between this and `expunge'
-alone or combined with `mark'.")
-	   (type . gnus-score-custom-maybe-type))
-	  ((name . eval)
-	   (tag . "Eval")
-	   (doc . "\
-Evaluate this lisp expression when the entering summary buffer.")
-	   (type . sexp))
-	  ((name . read-only)
-	   (tag . "Read Only")
-	   (doc . "Read-only score files will not be updated or saved.
-Except from this buffer, of course!")
-	   (type . toggle))
-	  ((type . doc)
-	   (doc . "\
-Each news header has an associated list of score entries.  
-You can use the [INS] buttons to add new score entries anywhere in the
-list, or the [DEL] buttons to delete specific score entries.
-
-Each score entry should specify a string that should be matched with
-the content actual header in order to determine whether the entry
-applies to that header.  Enter that string in the `Match' field.
-
-If the score entry matches, the articles score will be adjusted with
-some amount.  Enter that amount in the in the `Score' field.  You
-should specify a positive amount for score entries that matches
-articles you find interesting, and a negative amount for score entries
-matching articles you would rather avoid.  The final score for the
-article will be the sum of the score of all score entries that match
-the article. 
-
-The score entry can be either permanent or expirable.  To make the
-entry permanent, push the `Date' button and choose the `Permanent'
-entry.  To make the entry expirable, choose instead the `Integer'
-entry.  After choosing the you can enter the date the score entry was
-last matched in the `Date' field.  The date will be automatically
-updated each time the score entry matches an article.  When the date
-become too old, the the score entry will be removed.
-
-For your convenience, the date is specified as the number of days
-elapsed since the (imaginary) Gregorian date Sunday, December 31, 1
-BC.
-
-Finally, you can choose what kind of match you want to perform by
-pushing the `Type' button.  For most entries you can choose between
-`Exact' which mean the header content must be exactly identical to the
-match string, or `Substring' meaning the match string should be
-somewhere in the header content, or even `Regexp' to use Emacs regular
-expression matching.  The last choice is `Fuzzy' which is like `Exact'
-except that whitespace derivations, a beginning `Re:' or a terminating
-parenthetical remark are all ignored.  Each of the four types have a
-variant which will ignore case in the comparison.  That variant is
-indicated with a `(fold)' after its name."))
-	  ((name . from)
-	   (tag . "From")
-	   (doc . "Scoring based on the authors email address.")
-	   (type . gnus-score-custom-string-type))
-	  ((name . subject)
-	   (tag . "Subject")
-	   (doc . "Scoring based on the articles subject.")
-	   (type . gnus-score-custom-string-type))
-	  ((name . followup)
-	   (tag . "Followup")
-	   (doc . "Scoring based on who the article is a followup to.
-
-If you want to see all followups to your own articles, add an entry
-with a positive score matching your email address here.  You can also
-put an entry with a negative score matching someone who is so annoying
-that you don't even want to see him quoted in followups.")
-	   (type . gnus-score-custom-string-type))
-	  ((name . xref)
-	   (tag . "Xref")
-	   (doc . "Scoring based on article crossposting.
-
-If you want to score based on which newsgroups an article is posted
-to, this is the header to use.  The syntax is a little different from
-the `Newsgroups' header, but scoring in `Xref' is much faster.  As an
-example, to match all crossposted articles match on `:.*:' using the
-`Regexp' type.")
-	   (type . gnus-score-custom-string-type))
-	  ((name . references)
-	   (tag . "References")
-	   (doc . "Scoring based on article references.
-
-The `References' header gives you an alternative way to score on
-followups.  If you for example want to see follow all discussions
-where people from `iesd.auc.dk' school participate, you can add a
-substring match on `iesd.auc.dk>' on this header.")
-	   (type . gnus-score-custom-string-type))
-	  ((name . message-id)
-	   (tag . "Message-ID")
-	   (doc . "Scoring based on the articles message-id.
-
-This isn't very useful, but Lars like completeness.  You can use it to
-match all messaged generated by recent Gnus version with a `Substring'
-match on `.fsf@'.")
-	   (type . gnus-score-custom-string-type))
-	  ((type . doc)
-	   (doc . "\
-WARNING:  Scoring on the following three pseudo headers is very slow!
-Scoring on any of the real headers use a technique that avoids
-scanning the entire article, only the actual headers you score on are
-scanned, and this scanning has been heavily optimized.  Using just a
-single entry for one the three pseudo-headers `Head', `Body', and
-`All' will require GNUS to retrieve and scan the entire article, which
-can be very slow on large groups.  However, if you add one entry for
-any of these headers, you can just as well add several.  Each
-subsequent entry cost relatively little extra time."))
-	  ((name . head)
-	   (tag . "Head")
-	   (doc . "Scoring based on the article header.
-
-Instead of matching the content of a single header, the entire header
-section of the article is matched.  You can use this to match on
-arbitrary headers, foe example to single out TIN lusers, use a substring
-match on `Newsreader: TIN'.  That should get 'em!")
-	   (type . gnus-score-custom-string-type))
-	  ((name . body)
-	   (tag . "Body")
-	   (doc . "Scoring based on the article body.
-
-If you think any article that mentions `Kibo' is inherently
-interesting, do a substring match on His name.  You Are Allowed.")
-	   (type . gnus-score-custom-string-type))
-	  ((name . all)
-	   (tag . "All")
-	   (doc . "Scoring based on the whole article.")
-	   (type . gnus-score-custom-string-type))
-	  ((name . date)
-	   (tag . "Date")
-	   (doc . "Scoring based on article date.
-
-You can change the score of articles that have been posted before,
-after, or at a specific date.  You should add the date in the `Match'
-field, and then select `before', `after', or `at' by pushing the
-`Type' button.  Imagine you want to lower the score of very old
-articles, or want to raise the score of articles from the future (such
-things happen!).  Then you can't use date scoring for that.  In fact,
-I can't imagine anything you would want to use this for.   
-
-For your convenience, the date is specified in Usenet date format.")
-	   (type . gnus-score-custom-date-type))
-	  ((type . doc)
-	   (doc . "\
-The Lines and Chars headers use integer based scoring.  
-
-This means that you should write an integer in the `Match' field, and
-the push the `Type' field to if the `Chars' or `Lines' header should
-be larger, equal, or smaller than the number you wrote in the match
-field."))
-	  ((name . chars)
-	   (tag . "Characters")
-	   (doc . "Scoring based on the number of characters in the article.")
-	   (type . gnus-score-custom-integer-type))
-	  ((name . lines)
-	   (tag . "Lines")
-	   (doc . "Scoring based on the number of lines in the article.")
-	   (type . gnus-score-custom-integer-type))
-	  ((name . orphan)
-	   (tag . "Orphan")
-	   (doc . "Score to add to articles with no parents.")
-	   (type . gnus-score-custom-maybe-type))
-	  ((name . adapt)
-	   (tag . "Adapt")
-	   (doc . "Adapting the score files to your newsreading habits.
-
-When you have finished reading a group GNUS can automatically create
-new score entries based on which articles you read and which you
-skipped.  This is normally controlled by the two global variables
-`gnus-use-adaptive-scoring' and `gnus-default-adaptive-score-alist',
-The first determines whether adaptive scoring should be enabled or
-not, while the second determines what score entries should be created.
-
-You can overwrite the setting of `gnus-use-adaptive-scoring' by
-selecting `Enable' or `Disable' by pressing the `Adapt' button.
-Selecting `Custom' will allow you to specify the exact adaptation
-rules (overwriting `gnus-default-adaptive-score-alist').")
-	   (type . choice)
-	   (data ((tag . "Default")
-		  (default . nil)
-		  (type . const))
-		 ((tag . "Enable")
-		  (default . t)
-		  (type . const))
-		 ((tag . "Disable")
-		  (default . ignore)
-		  (type . const))
-		 ((tag . "Custom")
-		  (doc . "Customization of adaptive scoring.
-
-Each time you read an article it will be marked as read.  Likewise, if
-you delete it it will be marked as deleted, and if you tick it it will
-be marked as ticked.  When you leave a group, GNUS can automatically
-create score file entries based on these marks, so next time you enter
-the group articles with subjects that you read last time have higher
-score and articles with subjects that deleted will have lower score.  
-
-Below is a list of such marks.  You can insert new marks to the list
-by pushing on one of the `[INS]' buttons in the left margin to create
-a new entry and then pushing the `Mark' button to select the mark.
-For each mark there is another list, this time of article headers,
-which determine how the mark should affect that header.  The `[INS]'
-buttons of this list are indented to indicate that the belong to the
-mark above.  Push the `Header' button to choose a header, and then
-enter a score value in the `Score' field.   
-
-For each article that are marked with `Mark' when you leave the
-group, a temporary score entry for the articles `Header' with the
-value of `Score' will be added the adapt file.  If the score entry
-already exists, `Score' will be added to its value.  If you understood
-that, you are smart.
-
-You can select the special value `Other' when pressing the `Mark' or
-`Header' buttons.  This is because Lars might add more useful values
-there.  If he does, it is up to you to figure out what they are named.")
-		  (type . list)
-		  (default . ((__uninitialized__)))
-		  (data ((type . repeat)
-			 (header . nil)
-			 (data . ((type . list)
-				  (header . nil)
-				  (compact . t)
-				  (data ((type . choice)
-					 (tag . "Mark")
-					 (data ((tag . "Unread")
-						(default . gnus-unread-mark)
-						(type . const))
-					       ((tag . "Ticked")
-						(default . gnus-ticked-mark)
-						(type . const))
-					       ((tag . "Dormant")
-						(default . gnus-dormant-mark)
-						(type . const))
-					       ((tag . "Deleted")
-						(default . gnus-del-mark)
-						(type . const))
-					       ((tag . "Read")
-						(default . gnus-read-mark)
-						(type . const))
-					       ((tag . "Expirable")
-						(default . gnus-expirable-mark)
-						(type . const))
-					       ((tag . "Killed")
-						(default . gnus-killed-mark)
-						(type . const))
-					       ((tag . "Kill-file")
-						(default . gnus-kill-file-mark)
-						(type . const))
-					       ((tag . "Low-score")
-						(default . gnus-low-score-mark)
-						(type . const))
-					       ((tag . "Catchup")
-						(default . gnus-catchup-mark)
-						(type . const))
-					       ((tag . "Ancient")
-						(default . gnus-ancient-mark)
-						(type . const))
-					       ((tag . "Canceled")
-						(default . gnus-canceled-mark)
-						(type . const))
-					       ((prompt . "Other")
-						(default . ??)
-						(type . sexp))))
-					((type . repeat)
-					 (prefix . "            ")
-					 (data . ((type . list)
-						  (compact . t)
-						  (data ((tag . "Header")
-							 (type . choice)
-							 (data ((tag . "Subject")
-								(default . subject)
-								(type . const))
-							       ((prompt . "From")
-								(tag . "From   ")
-								(default . from)
-								(type . const))
-							       ((prompt . "Other")
-								(width . 7)
-								(default . nil)
-								(type . symbol))))
-							((tag . "Score")
-							 (type . integer))))))))))))))
-	  ((name . local)
-	   (tag . "Local")
-	   (doc . "\
-List of local variables to set when this score file is loaded.
-
-Using this entry can provide a convenient way to set variables that
-will affect the summary mode for only some specific groups, i.e. those
-groups matched by the current score file.")
-	   (type . list)
-	   (data ((type . repeat)
-		  (header . nil)
-		  (data . ((type . list)
-			   (compact . t)
-			   (data ((tag . "Name")
-				  (width . 26)
-				  (type . symbol))
-				 ((tag . "Value")
-				  (width . 26)
-				  (type . sexp)))))))))))
-
-(defconst gnus-score-custom-type-properties
-  '((gnus-score-custom-maybe-type
-     (type . choice)
-     (data ((type . integer)
-	    (default . 0))
-	   ((tag . "Default")
-	    (type . const)
-	    (default . nil))))
-    (gnus-score-custom-string-type
-     (type . list)
-     (data ((type . repeat)
-	    (header . nil)
-	    (data . ((type . list)
-		     (compact . t)
-		     (data ((tag . "Match")
-			    (width . 59)
-			    (type . string))
-			   "\n            "
-			   ((tag . "Score")
-			    (type . integer))
-			   ((tag . "Date")
-			    (type . choice)
-			    (data ((type . integer)
-				   (default . 0)
-				   (width . 9))
-				  ((tag . "Permanent")
-				   (type . const)
-				   (default . nil))))
-			   ((tag . "Type")
-			    (type . choice)
-			    (data ((tag . "Exact")
-				   (default . E)
-				   (type . const))
-				  ((tag . "Substring")
-				   (default . S) 
-				   (type . const))
-				  ((tag . "Regexp")
-				   (default . R)
-				   (type . const))
-				  ((tag . "Fuzzy")
-				   (default . F)
-				   (type . const))
-				  ((tag . "Exact (fold)")
-				   (default . e)
-				   (type . const))
-				  ((tag . "Substring (fold)")
-				   (default . s) 
-				   (type . const))
-				  ((tag . "Regexp (fold)")
-				   (default . r)
-				   (type . const))
-				  ((tag . "Fuzzy  (fold)")
-				   (default . f)
-				   (type . const))))))))))
-    (gnus-score-custom-integer-type
-     (type . list)
-     (data ((type . repeat)
-	    (header . nil)
-	    (data . ((type . list)
-		     (compact . t)
-		     (data ((tag . "Match")
-			    (type . integer))
-			   ((tag . "Score")
-			    (type . integer))
-			   ((tag . "Date")
-			    (type . choice)
-			    (data ((type . integer)
-				   (default . 0)
-				   (width . 9))
-				  ((tag . "Permanent")
-				   (type . const)
-				   (default . nil))))
-			   ((tag . "Type")
-			    (type . choice)
-			    (data ((tag . "<")
-				   (default . <)
-				   (type . const))
-				  ((tag . ">")
-				   (default . >) 
-				   (type . const))
-				  ((tag . "=")
-				   (default . =)
-				   (type . const))
-				  ((tag . ">=")
-				   (default . >=)
-				   (type . const))
-				  ((tag . "<=")
-				   (default . <=)
-				   (type . const))))))))))
-    (gnus-score-custom-date-type
-     (type . list)
-     (data ((type . repeat)
-	    (header . nil)
-	    (data . ((type . list)
-		     (compact . t)
-		     (data ((tag . "Match")
-			    (width . 59)
-			    (type . string))
-			   "\n           "
-			   ((tag . "Score")
-			    (type . integer))
-			   ((tag . "Date")
-			    (type . choice)
-			    (data ((type . integer)
-				   (default . 0)
-				   (width . 9))
-				  ((tag . "Permanent")
-				   (type . const)
-				   (default . nil))))
-			   ((tag . "Type")
-			    (type . choice)
-			    (data ((tag . "Before")
-				   (default . before)
-				   (type . const))
-				  ((tag . "After")
-				   (default . after) 
-				   (type . const))
-				  ((tag . "At")
-				   (default . at)
-				   (type . const))))))))))))
-
-(defvar gnus-score-custom-file nil
-  "Name of SCORE file being customized.")
-
-(defun gnus-score-customize ()
-  "Create a buffer for editing gnus SCORE files."
-  (interactive)
-  (let (gnus-score-alist)
-    (custom-buffer-create "*Score Edit*" gnus-score-custom-data
-			  gnus-score-custom-type-properties
-			  'gnus-score-custom-set
-			  'gnus-score-custom-get
-			  'gnus-score-custom-save))
-  (make-local-variable 'gnus-score-custom-file)
-  (setq gnus-score-custom-file
-	(expand-file-name "SCORE" gnus-kill-files-directory))
-  (make-local-variable 'gnus-score-alist)
-  (setq gnus-score-alist nil)
-  (custom-reset-all))
-
-(defun gnus-score-custom-get (name)
-  (if (eq name 'file)
-      gnus-score-custom-file
-    (let ((entry (assoc (symbol-name name) gnus-score-alist)))
-      (if entry 
-	  (mapcar 'gnus-score-custom-sanify (cdr entry))
-	(setq entry (assoc name gnus-score-alist))
-	(if  (or (memq name '(files exclude-files local))
-		 (and (eq name 'adapt)
-		      (not (symbolp (car (cdr entry))))))
-	    (cdr entry)
-	  (car (cdr entry)))))))
-
-(defun gnus-score-custom-set (name value)
-  (cond ((eq name 'file)
-	 (setq gnus-score-custom-file value))
-	((assoc (symbol-name name) gnus-score-alist)
-	 (if value
-	     (setcdr (assoc (symbol-name name) gnus-score-alist) value)
-	   (setq gnus-score-alist (delq (assoc (symbol-name name) 
-					       gnus-score-alist) 
-					gnus-score-alist))))
-	((assoc (symbol-name name) gnus-header-index)
-	 (if value
-	     (setq gnus-score-alist 
-		   (cons (cons (symbol-name name) value) gnus-score-alist))))
-	((assoc name gnus-score-alist)
-	 (cond ((null value)
-		(setq gnus-score-alist (delq (assoc name gnus-score-alist)
-					     gnus-score-alist)))
-	       ((and (listp value) (not (eq name 'eval)))
-		(setcdr (assoc name gnus-score-alist) value))
-	       (t
-		(setcdr (assoc name gnus-score-alist) (list value)))))
-	((null value))
-	((and (listp value) (not (eq name 'eval)))
-	 (setq gnus-score-alist (cons (cons name value) gnus-score-alist)))
-	(t
-	 (setq gnus-score-alist 
-	       (cons (cons name (list value)) gnus-score-alist)))))
-
-(defun gnus-score-custom-sanify (entry)
-  (list (nth 0 entry)
-	(or (nth 1 entry) gnus-score-interactive-default-score)
-	(nth 2 entry)
-	(cond ((null (nth 3 entry))
-	       's)
-	      ((memq (nth 3 entry) '(before after at >= <=))
-	       (nth 3 entry))
-	      (t
-	       (intern (substring (symbol-name (nth 3 entry)) 0 1))))))
-
-(defvar gnus-score-cache nil)
-
-(defun gnus-score-custom-load ()
-  (interactive)
-  (let ((file (custom-name-value 'file)))
-    (if (eq file custom-nil)
-	(error "You must specify a file name"))
-    (setq file (expand-file-name file gnus-kill-files-directory))
-    (gnus-score-load file)
-    (setq gnus-score-custom-file file)
-    (custom-reset-all)
-    (gnus-message 4 "Loaded")))
-
-(defun gnus-score-custom-save ()
-  (interactive)
-  (custom-apply-all)
-  (gnus-score-remove-from-cache gnus-score-custom-file)
-  (let ((file gnus-score-custom-file)
-	(score gnus-score-alist)
-	emacs-lisp-mode-hook)
-    (save-excursion
-      (set-buffer (get-buffer-create "*Score*"))
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (pp score (current-buffer))
-      (gnus-make-directory (file-name-directory file))
-      (write-region (point-min) (point-max) file nil 'silent)
-      (kill-buffer (current-buffer))))
-  (gnus-message 4 "Saved"))
-
-(provide 'gnus-edit)
-
-;;; gnus-edit.el end here
diff --git a/lisp/gnus-ems.el b/lisp/gnus-ems.el
deleted file mode 100644
index fb19e6cf711..00000000000
--- a/lisp/gnus-ems.el
+++ /dev/null
@@ -1,242 +0,0 @@
-;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(eval-when-compile (require 'cl))
-
-(defvar gnus-mouse-2 [mouse-2])
-
-(defalias 'gnus-make-overlay 'make-overlay)
-(defalias 'gnus-overlay-put 'overlay-put)
-(defalias 'gnus-move-overlay 'move-overlay)
-(defalias 'gnus-overlay-end 'overlay-end)
-(defalias 'gnus-extent-detached-p 'ignore)
-(defalias 'gnus-extent-start-open 'ignore)
-(defalias 'gnus-set-text-properties 'set-text-properties)
-(defalias 'gnus-group-remove-excess-properties 'ignore)
-(defalias 'gnus-topic-remove-excess-properties 'ignore)
-(defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
-(defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
-(defalias 'gnus-make-local-hook 'make-local-hook)
-(defalias 'gnus-add-hook 'add-hook)
-(defalias 'gnus-character-to-event 'identity)
-(defalias 'gnus-add-text-properties 'add-text-properties)
-(defalias 'gnus-put-text-property 'put-text-property)
-(defalias 'gnus-mode-line-buffer-identification 'identity)
-
-
-(eval-and-compile 
-  (autoload 'gnus-xmas-define "gnus-xmas")
-  (autoload 'gnus-xmas-redefine "gnus-xmas")
-  (autoload 'appt-select-lowest-window "appt.el"))
-
-(or (fboundp 'mail-file-babyl-p)
-    (fset 'mail-file-babyl-p 'rmail-file-p))
-
-;;; Mule functions.
-
-(defun gnus-mule-cite-add-face (number prefix face)
-  ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
-  (if face
-      (let ((inhibit-point-motion-hooks t)
-	    from to)
-	(goto-line number)
-	(if (boundp 'MULE)
-	    (forward-char (chars-in-string prefix))
-	  (forward-char (length prefix)))
-	(skip-chars-forward " \t")
-	(setq from (point))
-	(end-of-line 1)
-	(skip-chars-backward " \t")
-	(setq to (point))
-	(if (< from to)
-	    (gnus-overlay-put (gnus-make-overlay from to) 'face face)))))
-
-(defun gnus-mule-max-width-function (el max-width)
-  (` (let* ((val (eval (, el)))
-	    (valstr (if (numberp val)
-			(int-to-string val) val)))
-       (if (> (length valstr) (, max-width))
-	   (truncate-string valstr (, max-width))
-	 valstr))))
-
-(eval-and-compile
-  (if (string-match "XEmacs\\|Lucid" emacs-version)
-      ()
-
-    (defvar gnus-mouse-face-prop 'mouse-face
-      "Property used for highlighting mouse regions.")
-
-    (defvar gnus-article-x-face-command
-      "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | xv -quit -"
-      "String or function to be executed to display an X-Face header.
-If it is a string, the command will be executed in a sub-shell
-asynchronously.	 The compressed face will be piped to this command.")
-
-    ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-    (defvar gnus-display-type 
-      (condition-case nil
-	  (let ((display-resource (x-get-resource ".displayType" "DisplayType")))
-	    (cond (display-resource (intern (downcase display-resource)))
-		  ((x-display-color-p) 'color)
-		  ((x-display-grayscale-p) 'grayscale)
-		  (t 'mono)))
-	(error 'mono))
-      "A symbol indicating the display Emacs is running under.
-The symbol should be one of `color', `grayscale' or `mono'. If Emacs
-guesses this display attribute wrongly, either set this variable in
-your `~/.emacs' or set the resource `Emacs.displayType' in your
-`~/.Xdefaults'. See also `gnus-background-mode'.
-
-This is a meta-variable that will affect what default values other
-variables get.  You would normally not change this variable, but
-pounce directly on the real variables themselves.")
-
-    (defvar gnus-background-mode 
-      (condition-case nil
-	  (let ((bg-resource (x-get-resource ".backgroundMode"
-					     "BackgroundMode"))
-		(params (frame-parameters)))
-	    (cond (bg-resource (intern (downcase bg-resource)))
-		  ((and (cdr (assq 'background-color params))
-			(< (apply '+ (x-color-values
-				      (cdr (assq 'background-color params))))
-			   (* (apply '+ (x-color-values "white")) .6)))
-		   'dark)
-		  (t 'light)))
-	(error 'light))
-      "A symbol indicating the Emacs background brightness.
-The symbol should be one of `light' or `dark'.
-If Emacs guesses this frame attribute wrongly, either set this variable in
-your `~/.emacs' or set the resource `Emacs.backgroundMode' in your
-`~/.Xdefaults'.
-See also `gnus-display-type'.
-
-This is a meta-variable that will affect what default values other
-variables get.  You would normally not change this variable, but
-pounce directly on the real variables themselves."))
-
-  (cond 
-   ((string-match "XEmacs\\|Lucid" emacs-version)
-    (gnus-xmas-define))
-
-   ((or (not (boundp 'emacs-minor-version))
-	(< emacs-minor-version 30))
-    ;; Remove the `intangible' prop.
-    (let ((props (and (boundp 'gnus-hidden-properties) 
-		      gnus-hidden-properties)))
-      (while (and props (not (eq (car (cdr props)) 'intangible)))
-	(setq props (cdr props)))
-      (and props (setcdr props (cdr (cdr (cdr props))))))
-    (or (fboundp 'buffer-substring-no-properties)
-	(defun buffer-substring-no-properties (beg end)
-	  (format "%s" (buffer-substring beg end)))))
-   
-   ((boundp 'MULE)
-    (provide 'gnusutil))))
-
-(eval-and-compile
-  (cond
-   ((not window-system)
-    (defun gnus-dummy-func (&rest args))
-    (let ((funcs '(mouse-set-point set-face-foreground
-				   set-face-background x-popup-menu)))
-      (while funcs
-	(or (fboundp (car funcs))
-	    (fset (car funcs) 'gnus-dummy-func))
-	(setq funcs (cdr funcs))))))
-  (or (fboundp 'file-regular-p)
-      (defun file-regular-p (file)
-	(and (not (file-directory-p file))
-	     (not (file-symlink-p file))
-	     (file-exists-p file))))
-  (or (fboundp 'face-list)
-      (defun face-list (&rest args))))
-
-(eval-and-compile
-  (let ((case-fold-search t))
-    (cond
-     ((string-match "windows-nt\\|os/2\\|emx" (format "%s" system-type))
-      (setq nnheader-file-name-translation-alist
-	    (append nnheader-file-name-translation-alist
-		    '((?: . ?_)
-		      (?+ . ?-))))))))
-
-(defvar gnus-tmp-unread)
-(defvar gnus-tmp-replied)
-(defvar gnus-tmp-score-char)
-(defvar gnus-tmp-indentation)
-(defvar gnus-tmp-opening-bracket)
-(defvar gnus-tmp-lines)
-(defvar gnus-tmp-name)
-(defvar gnus-tmp-closing-bracket)
-(defvar gnus-tmp-subject-or-nil)
-
-(defun gnus-ems-redefine ()
-  (cond 
-   ((string-match "XEmacs\\|Lucid" emacs-version)
-    (gnus-xmas-redefine))
-
-   ((boundp 'MULE)
-    ;; Mule definitions
-    (defalias 'gnus-truncate-string 'truncate-string)
-
-    (fset 'gnus-summary-make-display-table (lambda () nil))
-    (fset 'gnus-cite-add-face 'gnus-mule-cite-add-face)
-    (fset 'gnus-max-width-function 'gnus-mule-max-width-function)
-    
-    (if (boundp 'gnus-check-before-posting)
-	(setq gnus-check-before-posting
-	      (delq 'long-lines
-		    (delq 'control-chars gnus-check-before-posting))))
-
-    (defun gnus-summary-line-format-spec ()
-      (insert gnus-tmp-unread gnus-tmp-replied 
-	      gnus-tmp-score-char gnus-tmp-indentation)
-      (put-text-property
-       (point)
-       (progn
-	 (insert 
-	  gnus-tmp-opening-bracket 
-	  (format "%4d: %-20s" 
-		  gnus-tmp-lines 
-		  (if (> (length gnus-tmp-name) 20) 
-		      (truncate-string gnus-tmp-name 20) 
-		    gnus-tmp-name))
-	  gnus-tmp-closing-bracket)
-	 (point))
-       gnus-mouse-face-prop gnus-mouse-face)
-      (insert " " gnus-tmp-subject-or-nil "\n"))
-    )))
-
-
-(provide 'gnus-ems)
-
-;; Local Variables:
-;; byte-compile-warnings: '(redefine callargs)
-;; End:
-
-;;; gnus-ems.el ends here
diff --git a/lisp/gnus-gl.el b/lisp/gnus-gl.el
deleted file mode 100644
index 54997d2c9a9..00000000000
--- a/lisp/gnus-gl.el
+++ /dev/null
@@ -1,872 +0,0 @@
-;;; gnus-gl.el --- an interface to GroupLens for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Brad Miller <bmiller@cs.umn.edu>
-;; Keywords: news, score
-
-;; 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:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; GroupLens software and documentation is copyright (c) 1995 by Paul
-;; Resnick (Massachusetts Institute of Technology); Brad Miller, John
-;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota),
-;; and David Maltz (Carnegie-Mellon University).
-;;
-;; Permission to use, copy, modify, and distribute this documentation
-;; for non-commercial and commercial purposes without fee is hereby
-;; granted provided that this copyright notice and permission notice
-;; appears in all copies and that the names of the individuals and
-;; institutions holding this copyright are not used in advertising or
-;; publicity pertaining to this software without specific, written
-;; prior permission.  The copyright holders make no representations
-;; about the suitability of this software and documentation for any
-;; purpose.  It is provided ``as is'' without express or implied
-;; warranty.
-;;
-;; The copyright holders request that they be notified of
-;; modifications of this code.  Please send electronic mail to
-;; grouplens@cs.umn.edu for more information or to announce derived
-;; works.  
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Author: Brad Miller
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; User Documentation:
-;; To use GroupLens you must load this file.
-;; You must also register a pseudonym with the Better Bit Bureau.
-;; http://www.cs.umn.edu/Research/GroupLens
-;;
-;;    ---------------- For your .emacs or .gnus file ----------------
-;;
-;; As of version 2.5, grouplens now works as a minor mode of 
-;; gnus-summary-mode.  To get make that work you just need a couple of
-;; hooks.
-;; (setq gnus-use-grouplens t)
-;; (setq grouplens-pseudonym "")
-;; (setq grouplens-bbb-host "grouplens.cs.umn.edu")
-;;
-;; (setq gnus-summary-default-score 0)
-;;
-;;                              USING GROUPLENS
-;; How do I Rate an article??
-;;   Before you type n to go to the next article, hit a number from 1-5
-;;   Type r in the summary buffer and you will be prompted.
-;;   Note that when you're in grouplens-minor-mode 'r' maskes the
-;;   usual reply binding for 'r'
-;;
-;; What if, Gasp, I find a bug???
-;; Please type M-x gnus-gl-submit-bug-report.  This will set up a
-;; mail buffer with the  state of variables and buffers that will help
-;; me debug the problem.  A short description up front would help too!
-;; 
-;; How do I display the prediction for an aritcle:
-;;  If you set the gnus-summary-line-format as shown above, the score
-;;  (prediction) will be shown automatically.
-;;
-;; 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Programmer  Notes 
-;; 10/9/95
-;; gnus-scores-articles contains the articles
-;; When scoring is done, the call tree looks something like:
-;; gnus-possibly-score-headers
-;;  ==> gnus-score-headers
-;;      ==> gnus-score-load-file
-;;          ==> get-all-mids  (from the eval form)
-;;
-;; it would be nice to have one that gets called after all the other
-;; headers have been scored.
-;; we may want a variable gnus-grouplens-scale-factor
-;; and gnus-grouplens-offset  this would probably be either -3 or 0
-;; to make the scores centered around zero or not.
-;; Notes 10/12/95
-;; According to Lars, Norse god of gnus, the simple way to insert a
-;; call to an external function is to have a function added to the
-;; variable gnus-score-find-files-function  This new function
-;; gnus-grouplens-score-alist will return a core alist that
-;; has (("message-id" ("<message-id-xxxx>" score) ("<message-id-xxxy>" score))
-;; This seems like it would be pretty inefficient, though workable.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;  TODO
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; 3. Add some more ways to rate messages
-;; 4. Better error handling for token timeouts.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; bugs
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 
-
-;;; Code:
-
-(require 'gnus-score)
-(require 'cl)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; User variables
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar gnus-summary-grouplens-line-format
-  "%U%R%z%l%I%(%[%4L: %-20,20n%]%) %s\n"
-  "*The line format spec in summary GroupLens mode buffers.")
-
-(defvar grouplens-pseudonym ""
-  "User's pseudonym.  This pseudonym is obtained during the registration process")
-
-(defvar grouplens-bbb-host "grouplens.cs.umn.edu"
-  "Host where the bbbd is running" )
-
-(defvar grouplens-bbb-port 9000 
-  "Port where the bbbd is listening" )
-
-(defvar grouplens-newsgroups 
-  '("comp.lang.c++" "rec.humor" "rec.food.recipes" "comp.groupware"
-    "mn.general" "rec.arts.movies" "rec.arts.movies.current-films"
-    "comp.lang.java" "comp.os.linux.announce" "comp.os.linux.misc"
-    "comp.os.linux.development.apps" "comp.os.linux.development.system")
-  "*Groups that are part of the GroupLens experiment.")
-
-(defvar grouplens-prediction-display 'prediction-spot
-  "valid values are: 
-      prediction-spot -- an * corresponding to the prediction between 1 and 5, 
-      confidence-interval -- a numeric confidence interval
-      prediction-bar --  |#####     | the longer the bar, the better the article,
-      confidence-bar --  |  -----   } the prediction is in the middle of the bar,
-      confidence-spot -- )  *       | the spot gets bigger with more confidence,
-      prediction-num  --   plain-old numeric value,
-      confidence-plus-minus  -- prediction +/i confidence")
-
-(defvar grouplens-score-offset 0
-  "Offset the prediction by this value.  
-Setting this variable to -2 would have the following effect on
-GroupLens scores:
-
-   1   -->   -2
-   2   -->   -1
-   3   -->    0
-   4   -->    1
-   5   -->    2
-   
-The reason is that a user might want to do this is to combine
-GroupLens predictions with scores calculated by other score methods.")
-
-(defvar grouplens-score-scale-factor 1
-  "This variable allows the user to magnify the effect of GroupLens scores. 
-The scale factor is applied after the offset.")
-
-(defvar gnus-grouplens-override-scoring 'override
-  "Tell Grouplens to override the normal Gnus scoring mechanism.  
-GroupLens scores can be combined with gnus scores in one of three ways.
-'override -- just use grouplens predictions for grouplens groups
-'combine  -- combine grouplens scores with gnus scores
-'separate -- treat grouplens scores completely separate from gnus")
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; Program global variables
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar grouplens-bbb-token "0"
-  "Current session token number")
-
-(defvar grouplens-bbb-process nil
-  "Process Id of current bbbd network stream process")
-
-(defvar grouplens-bbb-buffer nil
-  "Buffer associated with the BBBD process")
-
-(defvar grouplens-rating-alist nil
-  "Current set of  message-id rating pairs")
-
-(defvar grouplens-current-hashtable (make-hash-table :test 'equal :size 100))
-;; this seems like a pretty ugly way to get around the problem, but If 
-;; I don't do this, then the compiler complains when I call gethash
-;;
-(eval-when-compile (setq grouplens-current-hashtable 
-			 (make-hash-table :test 'equal :size 100)))
-
-(defvar grouplens-current-group nil)
-
-(defvar bbb-mid-list nil)
-
-(defvar bbb-alist nil)
-
-(defvar bbb-timeout-secs 10
-  "Number of seconds to wait for some response from the BBB.
-If this times out we give up and assume that something has died..." )
-
-(defvar grouplens-previous-article nil
-  "Message-ID of the last article read.")
-
-(defvar bbb-read-point)
-(defvar bbb-response-point)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;  Utility Functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun bbb-connect-to-bbbd (host port)
-  (unless grouplens-bbb-buffer 
-    (setq grouplens-bbb-buffer 
-	  (get-buffer-create (format " *BBBD trace: %s*" host)))
-    (save-excursion
-      (set-buffer grouplens-bbb-buffer)
-      (make-local-variable 'bbb-read-point)
-      (setq bbb-read-point (point-min))))
-  ;; clear the trace buffer of old output
-  (save-excursion
-    (set-buffer grouplens-bbb-buffer)
-    (erase-buffer))
-  ;; open the connection to the server
-  (setq grouplens-bbb-process nil)
-  (catch 'done
-    (condition-case error
-	(setq grouplens-bbb-process 
-	      (open-network-stream "BBBD" grouplens-bbb-buffer host port))
-      (error (gnus-message 3 "Error: Failed to connect to BBB")
-	     nil))
-    (and (null grouplens-bbb-process) 
-	 (throw 'done nil))
-    ;; (set-process-filter grouplens-bbb-process 'bbb-process-filter)
-    (save-excursion
-      (set-buffer grouplens-bbb-buffer)
-      (setq bbb-read-point (point-min))
-      (or (bbb-read-response grouplens-bbb-process)
-	  (throw 'done nil))))
-  grouplens-bbb-process)
-
-;; (defun bbb-process-filter (process output)
-;;   (save-excursion
-;;     (set-buffer (bbb-process-buffer process))
-;;     (goto-char (point-max))
-;;     (insert output)))
-
-(defun bbb-send-command (process command)
-  (goto-char (point-max))
-  (insert command) 
-  (insert "\r\n")
-  (setq bbb-read-point (point))
-  (setq bbb-response-point (point))
-  (set-marker (process-mark process) (point)) ; process output also comes here
-  (process-send-string process command)
-  (process-send-string process "\r\n"))
-
-(defun bbb-read-response (process) ; &optional return-response-string)
-  "This function eats the initial response of OK or ERROR from the BBB."
-  (let ((case-fold-search nil)
-	 match-end)
-    (goto-char bbb-read-point)
-    (while (and (not (search-forward "\r\n" nil t))
-		(accept-process-output process bbb-timeout-secs))
-      (goto-char bbb-read-point))
-    (setq match-end (point))
-    (goto-char bbb-read-point)
-    (setq bbb-read-point match-end)
-    (looking-at "OK")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;       Login Functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun bbb-login ()
-  "return the token number if login is successful, otherwise return nil"
-  (interactive)
-  (setq grouplens-bbb-token nil)
-  (if (not (equal grouplens-pseudonym ""))
-      (let ((bbb-process 
-	     (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
-	(if bbb-process
-	    (save-excursion 
-	      (set-buffer (process-buffer bbb-process))
-	      (bbb-send-command bbb-process 
-				(concat "login " grouplens-pseudonym))
-	      (if (bbb-read-response bbb-process)
-		  (setq grouplens-bbb-token (bbb-extract-token-number))
-		(gnus-message 3 "Error: Grouplens login failed")))))
-    (gnus-message 3 "Error: you must set a pseudonym"))
-  grouplens-bbb-token)
-
-(defun bbb-extract-token-number ()
-  (let ((token-pos (search-forward "token=" nil t) ))
-    (if (looking-at "[0-9]+")
-	(buffer-substring token-pos (match-end 0)))))
-
-(gnus-add-shutdown 'bbb-logout 'gnus)
-
-(defun bbb-logout ()
-  "logout of bbb session"
-  (let ((bbb-process 
-	 (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
-    (if bbb-process
-	(save-excursion 
-	  (set-buffer (process-buffer bbb-process))
-	  (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token))
-	  (bbb-read-response bbb-process))
-      nil)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;       Get Predictions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun bbb-build-mid-scores-alist (groupname)
-  "this function can be called as part of the function to return the 
-list of score files to use. See the gnus variable 
-gnus-score-find-score-files-function.  
-
-*Note:*  If you want to use grouplens scores along with calculated scores, 
-you should see the offset and scale variables.  At this point, I don't 
-recommend using both scores and grouplens predictions together."
-  (setq grouplens-current-group groupname)
-  (if (member groupname grouplens-newsgroups)
-      (let* ((mid-list (bbb-get-all-mids))
-	     (predict-list (bbb-get-predictions mid-list groupname)))
-	(setq grouplens-previous-article nil)
-	;; scores-alist should be a list of lists:
-	;;  ((("message-id" ("<mid1>" score1 nil s) ("<mid2> score2 nil s))))
-	;;`((("message-id" . ,predict-list))) ; Yes, this is the return value
-	(list (list (list (append (list "message-id") predict-list)))))
-    nil))
-
-(defun bbb-get-predictions (midlist groupname)
-  "Ask the bbb for predictions, and build up the score alist."
-  (if (or (null grouplens-bbb-token)
-	  (equal grouplens-bbb-token "0"))
-      (progn 
-	(gnus-message 3 "Error: You are not logged in to a BBB")
-	nil)
-    (gnus-message 5 "Fetching Predictions...")
-    (let (predict-list
-	  (predict-command (bbb-build-predict-command midlist groupname 
-						      grouplens-bbb-token))
-	  (bbb-process (bbb-connect-to-bbbd grouplens-bbb-host 
-					    grouplens-bbb-port)))
-      (if bbb-process
-	  (save-excursion 
-	    (set-buffer (process-buffer bbb-process))
-	    (bbb-send-command bbb-process predict-command)
-	    (if (bbb-read-response bbb-process)
-		(setq predict-list (bbb-get-prediction-response bbb-process))
-	      (gnus-message 1 "Invalid Token, login and try again")
-	      (ding))))
-      (setq bbb-alist predict-list))))
-
-(defun bbb-get-all-mids ()
-  (let ((index (nth 1 (assoc "message-id" gnus-header-index)))
-	(articles gnus-newsgroup-headers)
-	art this)
-    (setq bbb-mid-list nil)
-    (while articles
-      (progn (setq art (car articles)
-		   this (aref art index)
-		   articles (cdr articles))
-	     (setq bbb-mid-list (cons this bbb-mid-list))))
-    bbb-mid-list))
-
-(defun bbb-build-predict-command (mlist grpname token)
-  (let ((cmd (concat "getpredictions " token " " grpname "\r\n"))
-	art)
-    (while mlist
-      (setq art (car mlist)
-	    cmd (concat cmd art "\r\n")
-	    mlist (cdr mlist)))
-    (setq cmd (concat cmd ".\r\n"))
-  cmd))
-
-(defun bbb-get-prediction-response (process)
-  (let ((case-fold-search nil)
-	match-end)
-    (goto-char bbb-read-point)
-    (while (and (not (search-forward ".\r\n" nil t))
-		(accept-process-output process bbb-timeout-secs))
-      (goto-char bbb-read-point))
-    (setq match-end (point))
-    (goto-char (+ bbb-response-point 4))  ;; we ought to be right before OK
-    (bbb-build-response-alist)))
-
-;; build-response-alist assumes that the cursor has been positioned at
-;; the first line of the list of mid/rating pairs.  For now we will
-;; use a prediction of 99 to signify no prediction.  Ultimately, we
-;; should just ignore messages with no predictions.
-(defun bbb-build-response-alist ()
-  (let ((resp nil)
-	(match-end (point)))
-    (setq grouplens-current-hashtable (make-hash-table :test 'equal :size 100))
-    (while
-	(cond ((looking-at "\\(<.*>\\) :nopred=")
-	       (push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp)
-	       (forward-line 1)
-	       t)
-	      ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)")
-	       (push `(,(bbb-get-mid) ,(bbb-get-pred) nil s) resp)
-	       (cl-puthash (bbb-get-mid)
-			   (list (bbb-get-pred) (bbb-get-confl) (bbb-get-confh))
-			   grouplens-current-hashtable)
-	       (forward-line 1)
-	       t)
-	      ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)")
-	       (push `(,(bbb-get-mid) ,(bbb-get-pred) nil s) resp)
-	       (cl-puthash (bbb-get-mid)
-			   (list (bbb-get-pred) 0 0)
-			   grouplens-current-hashtable)
-	       (forward-line 1)
-	       t)
-	      (t nil)))
-    resp))
-
-;; these two functions assume that there is an active match lying
-;; around.  Where the first parenthesized expression is the
-;; message-id, and the second is the prediction.  Since gnus assumes
-;; that scores are integer values?? we round the prediction.
-(defun bbb-get-mid ()
-  (buffer-substring (match-beginning 1) (match-end 1)))
-
-(defun bbb-get-pred ()
-  (let ((tpred (string-to-number (buffer-substring  
-				      (match-beginning 2) 
-				      (match-end 2)))))
-    (if (> tpred 0)
-	(round (* grouplens-score-scale-factor (+ grouplens-score-offset  tpred)))
-      1)))
-
-(defun bbb-get-confl ()
-  (string-to-number (buffer-substring (match-beginning 3) (match-end 3))))
-
-(defun bbb-get-confh ()
-  (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;      Prediction Display
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defconst grplens-rating-range 4.0)
-(defconst grplens-maxrating 5)
-(defconst grplens-minrating 1)
-(defconst grplens-predstringsize 12)
-
-(defvar gnus-tmp-score)
-(defun bbb-grouplens-score (header)
-  (if (eq gnus-grouplens-override-scoring 'separate)
-      (bbb-grouplens-other-score header)
-    (let* ((rate-string (make-string 12 ? ))
-	   (mid (aref header (nth 1 (assoc "message-id" gnus-header-index))))
-	   (hashent (gethash mid grouplens-current-hashtable))
-	   (iscore gnus-tmp-score)
-	   (low (car (cdr hashent)))
-	   (high (car (cdr (cdr hashent)))))
-      (aset rate-string 0 ?|) 
-      (aset rate-string 11 ?|)
-      (unless (member grouplens-current-group grouplens-newsgroups)
-	(unless (equal grouplens-prediction-display 'prediction-num)
-	  (cond ((< iscore 0)
-		 (setq iscore 1))
-		((> iscore 5)
-		 (setq iscore 5))))
-	(setq low 0) 
-	(setq high 0))
-      (if (and (bbb-valid-score iscore) 
-	       (not (null mid)))
-	  (cond 
-	   ;; prediction-spot
-	   ((equal grouplens-prediction-display 'prediction-spot)
-	    (setq rate-string (bbb-fmt-prediction-spot rate-string iscore)))
-	   ;; confidence-interval
-	   ((equal grouplens-prediction-display 'confidence-interval)
-	    (setq rate-string (bbb-fmt-confidence-interval iscore low high)))
-	   ;; prediction-bar
-	   ((equal grouplens-prediction-display 'prediction-bar)
-	    (setq rate-string (bbb-fmt-prediction-bar rate-string iscore)))
-	   ;; confidence-bar
-	   ((equal grouplens-prediction-display 'confidence-bar)
-	    (setq rate-string (format "|   %4.2f   |" iscore)))
-	   ;; confidence-spot
-	   ((equal grouplens-prediction-display 'confidence-spot)
-	    (setq rate-string (format "|   %4.2f   |" iscore)))
-	   ;; prediction-num
-	   ((equal grouplens-prediction-display 'prediction-num)
-	    (setq rate-string (bbb-fmt-prediction-num iscore)))
-	   ;; confidence-plus-minus
-	   ((equal grouplens-prediction-display 'confidence-plus-minus)
-	    (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high))
-	    )
-	   (t (gnus-message 3 "Invalid prediction display type")))
-	(aset rate-string 5 ?N) (aset rate-string 6 ?A))
-      rate-string)))
-
-;;
-;; Gnus user format function that doesn't depend on
-;; bbb-build-mid-scores-alist being used as the score function, but is
-;; instead called from gnus-select-group-hook. -- LAB
-(defun bbb-grouplens-other-score (header)
-  (if (not (member grouplens-current-group grouplens-newsgroups))
-      ;; Return an empty string
-      ""
-    (let* ((rate-string (make-string 12 ? ))
-           (mid (aref header (nth 1 (assoc "message-id" gnus-header-index))))
-           (hashent (gethash mid grouplens-current-hashtable))
-           (pred (or (nth 0 hashent) 0))
-           (low (nth 1 hashent))
-           (high (nth 2 hashent)))
-      ;; Init rate-string
-      (aset rate-string 0 ?|) 
-      (aset rate-string 11 ?|)
-      (unless (equal grouplens-prediction-display 'prediction-num)
-	(cond ((< pred 0)
-	       (setq pred 1))
-	      ((> pred 5)
-	       (setq pred 5))))
-      ;; If no entry in BBB hash mark rate string as NA and return
-      (cond 
-       ((null hashent) 
-	(aset rate-string 5 ?N) 
-	(aset rate-string 6 ?A)
-	rate-string)
-
-       ((equal grouplens-prediction-display 'prediction-spot)
-	(bbb-fmt-prediction-spot rate-string pred))
-       
-       ((equal grouplens-prediction-display 'confidence-interval)
-	(bbb-fmt-confidence-interval pred low high))
-       
-       ((equal grouplens-prediction-display 'prediction-bar)
-	(bbb-fmt-prediction-bar rate-string pred))
-
-       ((equal grouplens-prediction-display 'confidence-bar)
-	(format "|   %4.2f   |" pred))
-
-       ((equal grouplens-prediction-display 'confidence-spot)
-	(format "|   %4.2f   |" pred))
-       
-       ((equal grouplens-prediction-display 'prediction-num)
-	(bbb-fmt-prediction-num pred))
-       
-       ((equal grouplens-prediction-display 'confidence-plus-minus)
-	(bbb-fmt-confidence-plus-minus pred low high))
-       
-       (t 
-	(gnus-message 3 "Invalid prediction display type")
-	(aset rate-string 0 ?|) 
-	(aset rate-string 11 ?|)
-	rate-string)))))
-
-(defun bbb-valid-score (score)
-  (or (equal grouplens-prediction-display 'prediction-num)
-      (and (>= score grplens-minrating)
-	   (<= score grplens-maxrating))))
-
-(defun bbb-requires-confidence (format-type)
-  (or (equal format-type 'confidence-plus-minus)
-      (equal format-type 'confidence-spot)
-      (equal format-type 'confidence-interval)))
-
-(defun bbb-have-confidence (clow chigh)
-  (not (or (null clow)
-	   (null chigh))))
-
-(defun bbb-fmt-prediction-spot (rate-string score)
-  (aset rate-string
-	(round (* (/ (- score grplens-minrating) grplens-rating-range)
-		  (+ (- grplens-predstringsize 4) 1.49)))
-	?*)
-  rate-string)
-
-(defun bbb-fmt-confidence-interval (score low high)
-  (if (bbb-have-confidence low high)
-      (format "|%4.2f-%4.2f |" low high)
-    (bbb-fmt-prediction-num score)))
-
-(defun bbb-fmt-confidence-plus-minus (score low high)
-  (if (bbb-have-confidence low high)
-      (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0))
-    (bbb-fmt-prediction-num score)))
-
-(defun bbb-fmt-prediction-bar (rate-string score)
-  (let* ((i 1) 
-	 (step (/ grplens-rating-range (- grplens-predstringsize 4)))
-	 (half-step (/ step 2))
-	 (loc (- grplens-minrating half-step)))
-    (while (< i (- grplens-predstringsize 2))
-      (if (> score loc)
-	  (aset rate-string i ?#)
-	(aset rate-string i ? ))
-      (setq i (+ i 1))
-      (setq loc (+ loc step)))
-    )
-  rate-string)
-
-(defun bbb-fmt-prediction-num (score)
-  (format "|   %4.2f   |" score))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;       Put Ratings
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; The message-id for the current article can be found in
-;; (aref gnus-current-headers (nth 1 (assoc "message-id" gnus-header-index)))
-
-(defun bbb-put-ratings ()
-  (if (and grouplens-rating-alist 
-	   (member gnus-newsgroup-name grouplens-newsgroups))
-      (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host 
-					  grouplens-bbb-port))
-	    (rate-command (bbb-build-rate-command grouplens-rating-alist)))
-	(if bbb-process
-	    (save-excursion 
-	      (set-buffer (process-buffer bbb-process))
-	      (gnus-message 5 "Sending Ratings...")
-	      (bbb-send-command bbb-process rate-command)
-	      (if (bbb-read-response bbb-process)
-		  (setq grouplens-rating-alist nil)
-		(gnus-message 1 
-			      "Token timed out: call bbb-login and quit again")
-		(ding))
-	      (gnus-message 5 "Sending Ratings...Done"))
-	  (gnus-message 3 "No BBB connection")))
-    (setq grouplens-rating-alist nil)))
-
-(defun bbb-build-rate-command (rate-alist)
-  (let (this
-	(cmd (concat "putratings " grouplens-bbb-token 
-		     " " grouplens-current-group " \r\n")))
-    (while rate-alist
-      (setq this (car rate-alist)
-	    cmd (concat cmd (car this) " :rating=" (cadr this) ".00"
-			" :time=" (cddr this) "\r\n")
-	    rate-alist (cdr rate-alist)))
-    (concat cmd ".\r\n")))
-
-;; Interactive rating functions.
-(defun bbb-summary-rate-article (rating &optional midin)
-  (interactive "nRating: ")
-  (when (member gnus-newsgroup-name grouplens-newsgroups)
-    (let ((mid (or midin (bbb-get-current-id))))
-      (if (and rating 
-	       (>= rating grplens-minrating) 
-	       (<= rating grplens-maxrating)
-	       mid)
-	  (let ((oldrating (assoc mid grouplens-rating-alist)))
-	    (if oldrating
-		(setcdr oldrating (cons rating 0))
-	      (push `(,mid . (,rating . 0)) grouplens-rating-alist))
-	    (gnus-summary-mark-article nil (int-to-string rating)))	
-	(gnus-message 3 "Invalid rating")))))
-
-(defun grouplens-next-unread-article (rating)
-  "Select unread article after current one."
-  (interactive "P")
-  (if rating (bbb-summary-rate-article rating))
-  (gnus-summary-next-unread-article))
-
-(defun grouplens-best-unread-article (rating)
-  "Select unread article after current one."
-  (interactive "P")
-  (if rating (bbb-summary-rate-article rating))
-  (gnus-summary-best-unread-article))
-
-(defun grouplens-summary-catchup-and-exit (rating)
-   "Mark all articles not marked as unread in this newsgroup as read, 
-    then exit.   If prefix argument ALL is non-nil, all articles are 
-    marked as read."
-   (interactive "P")
-   (if rating
-       (bbb-summary-rate-article rating))
-   (if (numberp rating)
-       (gnus-summary-catchup-and-exit)
-     (gnus-summary-catchup-and-exit rating)))
-
-(defun grouplens-score-thread (score)
-  "Raise the score of the articles in the current thread with SCORE."
-  (interactive "nRating: ")
-  (let (e)
-    (save-excursion
-      (let ((articles (gnus-summary-articles-in-thread)))
-	(while articles
-	  (gnus-summary-goto-subject (car articles))
-	  (gnus-set-global-variables)
-	  (bbb-summary-rate-article score
-				    (mail-header-id 
-				     (gnus-summary-article-header 
-				      (car articles))))
-	  (setq articles (cdr articles))))
-      (setq e (point)))
-    (let ((gnus-summary-check-current t))
-      (or (zerop (gnus-summary-next-subject 1 t))
-	  (goto-char e))))
-  (gnus-summary-recenter)
-  (gnus-summary-position-point)
-  (gnus-set-mode-line 'summary))
-
-
-(defun bbb-get-current-id ()
-  (if gnus-current-headers
-      (aref gnus-current-headers 
-	    (nth 1 (assoc "message-id" gnus-header-index)))
-    (gnus-message 3 "You must select an article before you rate it")))
-
-(defun bbb-grouplens-group-p (group)
-  "Say whether GROUP is a GroupLens group."
-  (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" ""))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;          TIME SPENT READING
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar grouplens-current-starting-time nil)
-
-(defun grouplens-start-timer ()
-  (setq grouplens-current-starting-time (current-time)))
-
-(defun grouplens-elapsed-time ()
-  (let ((et (bbb-time-float (current-time))))
-    (- et (bbb-time-float grouplens-current-starting-time))))
-
-(defun bbb-time-float (timeval)
-  (+ (* (car timeval) 65536) 
-	(cadr timeval)))
-
-(defun grouplens-do-time ()
-  (when (member gnus-newsgroup-name grouplens-newsgroups)
-    (when grouplens-previous-article
-      (let ((elapsed-time (grouplens-elapsed-time))
-	    (oldrating (assoc grouplens-previous-article 
-			      grouplens-rating-alist)))
-	(if (not oldrating)
-	    (push `(,grouplens-previous-article . (0 . ,elapsed-time))
-		  grouplens-rating-alist)
-	  (setcdr oldrating (cons (cadr oldrating) elapsed-time)))))
-    (grouplens-start-timer)
-    (setq grouplens-previous-article (bbb-get-current-id))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;          BUG REPORTING
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defconst gnus-gl-version "gnus-gl.el 2.12")
-(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu")
-(defun gnus-gl-submit-bug-report ()
-  "Submit via mail a bug report on gnus-gl"
-  (interactive)
-  (require 'reporter)
-  (reporter-submit-bug-report gnus-gl-maintainer-address
-			      (concat "gnus-gl.el " gnus-gl-version)
-			      (list 'grouplens-pseudonym
-				    'grouplens-bbb-host
-				    'grouplens-bbb-port
-				    'grouplens-newsgroups
-				    'grouplens-bbb-token
-				    'grouplens-bbb-process
-				    'grouplens-current-group
-				    'grouplens-previous-article
-				    'grouplens-mid-list
-				    'bbb-alist)
-			      nil
-			      'gnus-gl-get-trace))
-
-(defun gnus-gl-get-trace ()
-  "Insert the contents of the BBBD trace buffer"
-  (if grouplens-bbb-buffer (insert-buffer grouplens-bbb-buffer)))
-
-;;;
-;;; Additions to make gnus-grouplens-mode  Warning Warning!!
-;;;      This version of the gnus-grouplens-mode does
-;;;      not work with gnus-5.x.  The "old" way of
-;;;      setting up GroupLens still works however.
-;;;
-(defvar gnus-grouplens-mode nil
-  "Minor mode for providing a GroupLens interface in Gnus summary buffers.")
-
-(defvar gnus-grouplens-mode-map nil)
-
-(unless gnus-grouplens-mode-map
-  (setq gnus-grouplens-mode-map (make-keymap))
-  (gnus-define-keys
-   gnus-grouplens-mode-map
-   "n" grouplens-next-unread-article
-   "r" bbb-summary-rate-article
-   "k" grouplens-score-thread
-   "c" grouplens-summary-catchup-and-exit
-   "," grouplens-best-unread-article))
-
-(defun gnus-grouplens-make-menu-bar ()
-  (unless (boundp 'gnus-grouplens-menu)
-    (easy-menu-define
-     gnus-grouplens-menu gnus-grouplens-mode-map ""
-     '("GroupLens"
-       ["Login" bbb-login t]
-       ["Rate" bbb-summary-rate-article t]
-       ["Next article" grouplens-next-unread-article t]
-       ["Best article" grouplens-best-unread-article t]
-       ["Raise thread" grouplens-score-thread t]
-       ["Report bugs" gnus-gl-submit-bug-report t]))))
-
-(defun gnus-grouplens-mode (&optional arg)
-  "Minor mode for providing a GroupLens interface in Gnus summary buffers."
-  (interactive "P")
-  (when (and (eq major-mode 'gnus-summary-mode)
-	     (member gnus-newsgroup-name grouplens-newsgroups))
-    (make-local-variable 'gnus-grouplens-mode)
-    (setq gnus-grouplens-mode 
-	  (if (null arg) (not gnus-grouplens-mode)
-	    (> (prefix-numeric-value arg) 0)))
-    (when gnus-grouplens-mode
-      (if (not (fboundp 'make-local-hook))
-	  (add-hook 'gnus-select-article-hook 'grouplens-do-time)
-	(make-local-hook 'gnus-select-article-hook)
-	(add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local))
-      (if (not (fboundp 'make-local-hook))
-	  (add-hook 'gnus-exit-group-hook 'bbb-put-ratings)
-	(make-local-hook 'gnus-exit-group-hook)
-	(add-hook 'gnus-exit-group-hook 'bbb-put-ratings nil 'local))
-      (make-local-variable 'gnus-score-find-score-files-function)
-      (cond ((eq gnus-grouplens-override-scoring 'combine)
-	     ;; either add bbb-buld-mid-scores-alist to a list
-             ;; or make a list
-	     (if (listp gnus-score-find-score-files-function)
-		 (setq gnus-score-find-score-files-function 
-		   (append 'bbb-build-mid-scores-alist      
-			   gnus-score-find-score-files-function ))
-	       (setq gnus-score-find-score-files-function 
-		     (list gnus-score-find-score-files-function 
-			   'bbb-build-mid-scores-alist))))
-	     ;; leave the gnus-score-find-score-files variable alone
-	    ((eq gnus-grouplens-override-scoring 'separate)
-	     (add-hook 'gnus-select-group-hook 
-		       '(lambda() 
-			  (bbb-build-mid-scores-alist gnus-newsgroup-name))))
-	    ;; default is to override
-	    (t (setq gnus-score-find-score-files-function 
-		     'bbb-build-mid-scores-alist)))
-      (make-local-variable 'gnus-summary-line-format)
-      (setq gnus-summary-line-format 
-	    gnus-summary-grouplens-line-format)
-      (make-local-variable 'gnus-summary-line-format-spec)
-      (setq gnus-summary-line-format-spec nil)
-
-      ;; Set up the menu.
-      (when (and menu-bar-mode
-		 (gnus-visual-p 'grouplens-menu 'menu))
-	(gnus-grouplens-make-menu-bar))
-      (unless (assq 'gnus-grouplens-mode minor-mode-alist)
-	(push '(gnus-grouplens-mode " GroupLens") minor-mode-alist))
-      (unless (assq 'gnus-grouplens-mode minor-mode-map-alist)
-	(push (cons 'gnus-grouplens-mode gnus-grouplens-mode-map)
-	      minor-mode-map-alist))
-      (run-hooks 'gnus-grouplens-mode-hook))))
-
-(provide 'gnus-gl)
-
-;;; gnus-gl.el ends here
diff --git a/lisp/gnus-kill.el b/lisp/gnus-kill.el
deleted file mode 100644
index 8c88c2347b8..00000000000
--- a/lisp/gnus-kill.el
+++ /dev/null
@@ -1,655 +0,0 @@
-;;; gnus-kill.el --- kill commands for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'gnus)
-(eval-when-compile (require 'cl))
-
-(defvar gnus-kill-file-mode-hook nil
-  "*A hook for Gnus kill file mode.")
-
-(defvar gnus-kill-expiry-days 7
-  "*Number of days before expiring unused kill file entries.")
-
-(defvar gnus-kill-save-kill-file nil
-  "*If non-nil, will save kill files after processing them.")
-
-(defvar gnus-winconf-kill-file nil)
-
-
-
-(defmacro gnus-raise (field expression level)
-  `(gnus-kill ,field ,expression
-	      (function (gnus-summary-raise-score ,level)) t))
-
-(defmacro gnus-lower (field expression level)
-  `(gnus-kill ,field ,expression
-	      (function (gnus-summary-raise-score (- ,level))) t))
-
-;;;
-;;; Gnus Kill File Mode
-;;;
-
-(defvar gnus-kill-file-mode-map nil)
-
-(unless gnus-kill-file-mode-map
-  (gnus-define-keymap
-   (setq gnus-kill-file-mode-map (copy-keymap emacs-lisp-mode-map))
-   "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
-   "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
-   "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
-   "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
-   "\C-c\C-a" gnus-kill-file-apply-buffer
-   "\C-c\C-e" gnus-kill-file-apply-last-sexp
-   "\C-c\C-c" gnus-kill-file-exit))
-
-(defun gnus-kill-file-mode ()
-  "Major mode for editing kill files.
-
-If you are using this mode - you probably shouldn't.  Kill files
-perform badly and paint with a pretty broad brush.  Score files, on
-the other hand, are vastly faster (40x speedup) and give you more
-control over what to do.
-
-In addition to Emacs-Lisp Mode, the following commands are available:
-
-\\{gnus-kill-file-mode-map}
-
-  A kill file contains Lisp expressions to be applied to a selected
-newsgroup.  The purpose is to mark articles as read on the basis of
-some set of regexps.  A global kill file is applied to every newsgroup,
-and a local kill file is applied to a specified newsgroup.  Since a
-global kill file is applied to every newsgroup, for better performance
-use a local one.
-
-  A kill file can contain any kind of Emacs Lisp expressions expected
-to be evaluated in the Summary buffer.  Writing Lisp programs for this
-purpose is not so easy because the internal working of Gnus must be
-well-known.  For this reason, Gnus provides a general function which
-does this easily for non-Lisp programmers.
-
-  The `gnus-kill' function executes commands available in Summary Mode
-by their key sequences. `gnus-kill' should be called with FIELD,
-REGEXP and optional COMMAND and ALL.  FIELD is a string representing
-the header field or an empty string.  If FIELD is an empty string, the
-entire article body is searched for.  REGEXP is a string which is
-compared with FIELD value. COMMAND is a string representing a valid
-key sequence in Summary mode or Lisp expression. COMMAND defaults to
-'(gnus-summary-mark-as-read nil \"X\").  Make sure that COMMAND is
-executed in the Summary buffer.  If the second optional argument ALL
-is non-nil, the COMMAND is applied to articles which are already
-marked as read or unread.  Articles which are marked are skipped over
-by default.
-
-  For example, if you want to mark articles of which subjects contain
-the string `AI' as read, a possible kill file may look like:
-
-	(gnus-kill \"Subject\" \"AI\")
-
-  If you want to mark articles with `D' instead of `X', you can use
-the following expression:
-
-	(gnus-kill \"Subject\" \"AI\" \"d\")
-
-In this example it is assumed that the command
-`gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode.
-
-  It is possible to delete unnecessary headers which are marked with
-`X' in a kill file as follows:
-
-	(gnus-expunge \"X\")
-
-  If the Summary buffer is empty after applying kill files, Gnus will
-exit the selected newsgroup normally.  If headers which are marked
-with `D' are deleted in a kill file, it is impossible to read articles
-which are marked as read in the previous Gnus sessions.  Marks other
-than `D' should be used for articles which should really be deleted.
-
-Entry to this mode calls emacs-lisp-mode-hook and
-gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map gnus-kill-file-mode-map)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (setq major-mode 'gnus-kill-file-mode)
-  (setq mode-name "Kill")
-  (lisp-mode-variables nil)
-  (run-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
-
-(defun gnus-kill-file-edit-file (newsgroup)
-  "Begin editing a kill file for NEWSGROUP.
-If NEWSGROUP is nil, the global kill file is selected."
-  (interactive "sNewsgroup: ")
-  (let ((file (gnus-newsgroup-kill-file newsgroup)))
-    (gnus-make-directory (file-name-directory file))
-    ;; Save current window configuration if this is first invocation.
-    (or (and (get-file-buffer file)
-	     (get-buffer-window (get-file-buffer file)))
-	(setq gnus-winconf-kill-file (current-window-configuration)))
-    ;; Hack windows.
-    (let ((buffer (find-file-noselect file)))
-      (cond ((get-buffer-window buffer)
-	     (pop-to-buffer buffer))
-	    ((eq major-mode 'gnus-group-mode)
-	     (gnus-configure-windows 'group) ;Take all windows.
-	     (pop-to-buffer buffer))
-	    ((eq major-mode 'gnus-summary-mode)
-	     (gnus-configure-windows 'article)
-	     (pop-to-buffer gnus-article-buffer)
-	     (bury-buffer gnus-article-buffer)
-	     (switch-to-buffer buffer))
-	    (t				;No good rules.
-	     (find-file-other-window file))))
-    (gnus-kill-file-mode)))
-
-;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
-(defun gnus-kill-set-kill-buffer ()
-  (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))
-	 (buffer (find-file-noselect file)))
-    (set-buffer buffer)
-    (gnus-kill-file-mode)
-    (bury-buffer buffer)))
-
-(defun gnus-kill-file-enter-kill (field regexp &optional dont-move)
-  ;; Enter kill file entry.
-  ;; FIELD: String containing the name of the header field to kill.
-  ;; REGEXP: The string to kill.
-  (save-excursion
-    (let (string)
-      (or (eq major-mode 'gnus-kill-file-mode)
-	  (gnus-kill-set-kill-buffer))
-      (unless dont-move
-	(goto-char (point-max)))
-      (insert (setq string (format "(gnus-kill %S %S)\n" field regexp)))
-      (gnus-kill-file-apply-string string))))
-    
-(defun gnus-kill-file-kill-by-subject ()
-  "Kill by subject."
-  (interactive)
-  (gnus-kill-file-enter-kill
-   "Subject" 
-   (if (vectorp gnus-current-headers)
-       (regexp-quote 
-	(gnus-simplify-subject (mail-header-subject gnus-current-headers)))
-     "") t))
-  
-(defun gnus-kill-file-kill-by-author ()
-  "Kill by author."
-  (interactive)
-  (gnus-kill-file-enter-kill
-   "From" 
-   (if (vectorp gnus-current-headers)
-       (regexp-quote (mail-header-from gnus-current-headers))
-     "") t))
- 
-(defun gnus-kill-file-kill-by-thread ()
-  "Kill by author."
-  (interactive)
-  (gnus-kill-file-enter-kill
-   "References" 
-   (if (vectorp gnus-current-headers)
-       (regexp-quote (mail-header-id gnus-current-headers))
-     "")))
- 
-(defun gnus-kill-file-kill-by-xref ()
-  "Kill by Xref."
-  (interactive)
-  (let ((xref (and (vectorp gnus-current-headers) 
-		   (mail-header-xref gnus-current-headers)))
-	(start 0)
-	group)
-    (if xref
-	(while (string-match " \\([^ \t]+\\):" xref start)
-	  (setq start (match-end 0))
-	  (if (not (string= 
-		    (setq group 
-			  (substring xref (match-beginning 1) (match-end 1)))
-		    gnus-newsgroup-name))
-	      (gnus-kill-file-enter-kill 
-	       "Xref" (concat " " (regexp-quote group) ":") t)))
-      (gnus-kill-file-enter-kill "Xref" "" t))))
-
-(defun gnus-kill-file-raise-followups-to-author (level)
-  "Raise score for all followups to the current author."
-  (interactive "p")
-  (let ((name (mail-header-from gnus-current-headers))
-	string)
-    (save-excursion
-      (gnus-kill-set-kill-buffer)
-      (goto-char (point-min))
-      (setq name (read-string (concat "Add " level
-				      " to followup articles to: ")
-			      (regexp-quote name)))
-      (setq 
-       string
-       (format
-	"(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
-	"From" name level))
-      (insert string)
-      (gnus-kill-file-apply-string string))
-    (gnus-message 
-     6 "Added temporary score file entry for followups to %s." name)))
-
-(defun gnus-kill-file-apply-buffer ()
-  "Apply current buffer to current newsgroup."
-  (interactive)
-  (if (and gnus-current-kill-article
-	   (get-buffer gnus-summary-buffer))
-      ;; Assume newsgroup is selected.
-      (gnus-kill-file-apply-string (buffer-string))
-    (ding) (gnus-message 2 "No newsgroup is selected.")))
-
-(defun gnus-kill-file-apply-string (string)
-  "Apply STRING to current newsgroup."
-  (interactive)
-  (let ((string (concat "(progn \n" string "\n)")))
-    (save-excursion
-      (save-window-excursion
-	(pop-to-buffer gnus-summary-buffer)
-	(eval (car (read-from-string string)))))))
-
-(defun gnus-kill-file-apply-last-sexp ()
-  "Apply sexp before point in current buffer to current newsgroup."
-  (interactive)
-  (if (and gnus-current-kill-article
-	   (get-buffer gnus-summary-buffer))
-      ;; Assume newsgroup is selected.
-      (let ((string
-	     (buffer-substring
-	      (save-excursion (forward-sexp -1) (point)) (point))))
-	(save-excursion
-	  (save-window-excursion
-	    (pop-to-buffer gnus-summary-buffer)
-	    (eval (car (read-from-string string))))))
-    (ding) (gnus-message 2 "No newsgroup is selected.")))
-
-(defun gnus-kill-file-exit ()
-  "Save a kill file, then return to the previous buffer."
-  (interactive)
-  (save-buffer)
-  (let ((killbuf (current-buffer)))
-    ;; We don't want to return to article buffer.
-    (and (get-buffer gnus-article-buffer)
-	 (bury-buffer gnus-article-buffer))
-    ;; Delete the KILL file windows.
-    (delete-windows-on killbuf)
-    ;; Restore last window configuration if available.
-    (and gnus-winconf-kill-file
-	 (set-window-configuration gnus-winconf-kill-file))
-    (setq gnus-winconf-kill-file nil)
-    ;; Kill the KILL file buffer.  Suggested by tale@pawl.rpi.edu.
-    (kill-buffer killbuf)))
-
-;; For kill files
-
-(defun gnus-Newsgroup-kill-file (newsgroup)
-  "Return the name of a kill file for NEWSGROUP.
-If NEWSGROUP is nil, return the global kill file instead."
-  (cond ((or (null newsgroup)
-	     (string-equal newsgroup ""))
-	 ;; The global kill file is placed at top of the directory.
-	 (expand-file-name gnus-kill-file-name gnus-kill-files-directory))
-	(gnus-use-long-file-name
-	 ;; Append ".KILL" to capitalized newsgroup name.
-	 (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
-				   "." gnus-kill-file-name)
-			   gnus-kill-files-directory))
-	(t
-	 ;; Place "KILL" under the hierarchical directory.
-	 (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
-				   "/" gnus-kill-file-name)
-			   gnus-kill-files-directory))))
-
-(defun gnus-expunge (marks)
-  "Remove lines marked with MARKS."
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
-    (gnus-summary-limit-to-marks marks 'reverse)))
-
-(defun gnus-apply-kill-file-unless-scored ()
-  "Apply .KILL file, unless a .SCORE file for the same newsgroup exists."
-  (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name))
-         ;; Ignores global KILL.
-         (if (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
-             (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE"
-			     gnus-newsgroup-name))
-         0)
-        ((or (file-exists-p (gnus-newsgroup-kill-file nil))
-             (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
-         (gnus-apply-kill-file-internal))
-        (t
-         0)))
-
-(defun gnus-apply-kill-file-internal ()
-  "Apply a kill file to the current newsgroup.
-Returns the number of articles marked as read."
-  (let* ((kill-files (list (gnus-newsgroup-kill-file nil)
-			   (gnus-newsgroup-kill-file gnus-newsgroup-name)))
-	 (unreads (length gnus-newsgroup-unreads))
-	 (gnus-summary-inhibit-highlight t)
-	 beg)
-    (setq gnus-newsgroup-kill-headers nil)
-    ;; If there are any previously scored articles, we remove these
-    ;; from the `gnus-newsgroup-headers' list that the score functions
-    ;; will see. This is probably pretty wasteful when it comes to
-    ;; conses, but is, I think, faster than having to assq in every
-    ;; single score function.
-    (let ((files kill-files))
-      (while files
-	(if (file-exists-p (car files))
-	    (let ((headers gnus-newsgroup-headers))
-	      (if gnus-kill-killed
-		  (setq gnus-newsgroup-kill-headers
-			(mapcar (lambda (header) (mail-header-number header))
-				headers))
-		(while headers
-		  (or (gnus-member-of-range 
-		       (mail-header-number (car headers)) 
-		       gnus-newsgroup-killed)
-		      (setq gnus-newsgroup-kill-headers 
-			    (cons (mail-header-number (car headers))
-				  gnus-newsgroup-kill-headers)))
-		  (setq headers (cdr headers))))
-	      (setq files nil))
- 	  (setq files (cdr files)))))
-    (if (not gnus-newsgroup-kill-headers)
-	()
-      (save-window-excursion
-	(save-excursion
-	  (while kill-files
-	    (if (not (file-exists-p (car kill-files)))
-		()
-	      (gnus-message 6 "Processing kill file %s..." (car kill-files))
-	      (find-file (car kill-files))
-	      (gnus-add-current-to-buffer-list)
-	      (goto-char (point-min))
-
-	      (if (consp (condition-case nil (read (current-buffer)) 
-			   (error nil)))
-		  (gnus-kill-parse-gnus-kill-file)
-		(gnus-kill-parse-rn-kill-file))
-	    
-	      (gnus-message 
-	       6 "Processing kill file %s...done" (car kill-files)))
-	    (setq kill-files (cdr kill-files)))))
-
-      (gnus-set-mode-line 'summary)
-
-      (if beg
-	  (let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
-	    (or (eq nunreads 0)
-		(gnus-message 6 "Marked %d articles as read" nunreads))
-	    nunreads)
-	0))))
-
-;; Parse a Gnus killfile.
-(defun gnus-score-insert-help (string alist idx)
-  (save-excursion
-    (pop-to-buffer "*Score Help*")
-    (buffer-disable-undo (current-buffer))
-    (erase-buffer)
-    (insert string ":\n\n")
-    (while alist
-      (insert (format " %c: %s\n" (caar alist) (nth idx (car alist))))
-      (setq alist (cdr alist)))))
-
-(defun gnus-kill-parse-gnus-kill-file ()
-  (goto-char (point-min))
-  (gnus-kill-file-mode)
-  (let (beg form)
-    (while (progn 
-	     (setq beg (point))
-	     (setq form (condition-case () (read (current-buffer))
-			  (error nil))))
-      (or (listp form)
-	  (error "Illegal kill entry (possibly rn kill file?): %s" form))
-      (if (or (eq (car form) 'gnus-kill)
-	      (eq (car form) 'gnus-raise)
-	      (eq (car form) 'gnus-lower))
-	  (progn
-	    (delete-region beg (point))
-	    (insert (or (eval form) "")))
-	(save-excursion
-	  (set-buffer gnus-summary-buffer)
-	  (condition-case () (eval form) (error nil)))))
-    (and (buffer-modified-p) 
-	 gnus-kill-save-kill-file
-	 (save-buffer))
-    (set-buffer-modified-p nil)))
-
-;; Parse an rn killfile.
-(defun gnus-kill-parse-rn-kill-file ()
-  (goto-char (point-min))
-  (gnus-kill-file-mode)
-  (let ((mod-to-header
-	 '((?a . "")
-	   (?h . "")
-	   (?f . "from")
-	   (?: . "subject")))
-	(com-to-com
-	 '((?m . " ")
-	   (?j . "X")))
-	pattern modifier commands)
-    (while (not (eobp))
-      (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)"))
-	  ()
-	(setq pattern (buffer-substring (match-beginning 1) (match-end 1)))
-	(setq modifier (if (match-beginning 2) (char-after (match-beginning 2))
-			 ?s))
-	(setq commands (buffer-substring (match-beginning 3) (match-end 3)))
-
-	;; The "f:+" command marks everything *but* the matches as read,
-	;; so we simply first match everything as read, and then unmark
-	;; PATTERN later. 
-	(and (string-match "\\+" commands)
-	     (progn
-	       (gnus-kill "from" ".")
-	       (setq commands "m")))
-
-	(gnus-kill 
-	 (or (cdr (assq modifier mod-to-header)) "subject")
-	 pattern 
-	 (if (string-match "m" commands) 
-	     '(gnus-summary-mark-as-unread nil " ")
-	   '(gnus-summary-mark-as-read nil "X")) 
-	 nil t))
-      (forward-line 1))))
-
-;; Kill changes and new format by suggested by JWZ and Sudish Joseph
-;; <joseph@cis.ohio-state.edu>.  
-(defun gnus-kill (field regexp &optional exe-command all silent)
-  "If FIELD of an article matches REGEXP, execute COMMAND.
-Optional 1st argument COMMAND is default to
-	(gnus-summary-mark-as-read nil \"X\").
-If optional 2nd argument ALL is non-nil, articles marked are also applied to.
-If FIELD is an empty string (or nil), entire article body is searched for.
-COMMAND must be a lisp expression or a string representing a key sequence."
-  ;; We don't want to change current point nor window configuration.
-  (let ((old-buffer (current-buffer)))
-    (save-excursion
-      (save-window-excursion
-	;; Selected window must be summary buffer to execute keyboard
-	;; macros correctly. See command_loop_1.
-	(switch-to-buffer gnus-summary-buffer 'norecord)
-	(goto-char (point-min))		;From the beginning.
-	(let ((kill-list regexp)
-	      (date (current-time-string))
-	      (command (or exe-command '(gnus-summary-mark-as-read 
-					 nil gnus-kill-file-mark)))
-	      kill kdate prev)
-	  (if (listp kill-list)
-	      ;; It is a list.
-	      (if (not (consp (cdr kill-list)))
-		  ;; It's of the form (regexp . date).
-		  (if (zerop (gnus-execute field (car kill-list) 
-					   command nil (not all)))
-		      (if (> (gnus-days-between date (cdr kill-list))
-			     gnus-kill-expiry-days)
-			  (setq regexp nil))
-		    (setcdr kill-list date))
-		(while (setq kill (car kill-list))
-		  (if (consp kill)
-		      ;; It's a temporary kill.
-		      (progn
-			(setq kdate (cdr kill))
-			(if (zerop (gnus-execute 
-				    field (car kill) command nil (not all)))
-			    (if (> (gnus-days-between date kdate)
-				   gnus-kill-expiry-days)
-				;; Time limit has been exceeded, so we
-				;; remove the match.
-				(if prev
-				    (setcdr prev (cdr kill-list))
-				  (setq regexp (cdr regexp))))
-			  ;; Successful kill. Set the date to today.
-			  (setcdr kill date)))
-		    ;; It's a permanent kill.
-		    (gnus-execute field kill command nil (not all)))
-		  (setq prev kill-list)
-		  (setq kill-list (cdr kill-list))))
-	    (gnus-execute field kill-list command nil (not all))))))
-    (switch-to-buffer old-buffer)
-    (if (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
-	(gnus-pp-gnus-kill
-	 (nconc (list 'gnus-kill field 
-		      (if (consp regexp) (list 'quote regexp) regexp))
-		(if (or exe-command all) (list (list 'quote exe-command)))
-		(if all (list t) nil))))))
-
-(defun gnus-pp-gnus-kill (object)
-  (if (or (not (consp (nth 2 object)))
-	  (not (consp (cdr (nth 2 object))))
-	  (and (eq 'quote (car (nth 2 object)))
-	       (not (consp (cdadr (nth 2 object))))))
-      (concat "\n" (prin1-to-string object))
-    (save-excursion
-      (set-buffer (get-buffer-create "*Gnus PP*"))
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (insert (format "\n(%S %S\n  '(" (nth 0 object) (nth 1 object)))
-      (let ((klist (cadr (nth 2 object)))
-	    (first t))
-	(while klist
-	  (insert (if first (progn (setq first nil) "")  "\n    ")
-		  (prin1-to-string (car klist)))
-	  (setq klist (cdr klist))))
-      (insert ")")
-      (and (nth 3 object)
-	   (insert "\n  " 
-		   (if (and (consp (nth 3 object))
-			    (not (eq 'quote (car (nth 3 object))))) 
-		       "'" "")
-		   (prin1-to-string (nth 3 object))))
-      (and (nth 4 object)
-	   (insert "\n  t"))
-      (insert ")")
-      (prog1
-	  (buffer-substring (point-min) (point-max))
-	(kill-buffer (current-buffer))))))
-
-(defun gnus-execute-1 (function regexp form header)
-  (save-excursion
-    (let (did-kill)
-      (if (null header)
-	  nil				;Nothing to do.
-	(if function
-	    ;; Compare with header field.
-	    (let (value)
-	      (and header
-		   (progn
-		     (setq value (funcall function header))
-		     ;; Number (Lines:) or symbol must be converted to string.
-		     (or (stringp value)
-			 (setq value (prin1-to-string value)))
-		     (setq did-kill (string-match regexp value)))
-		   (cond ((stringp form)	;Keyboard macro.
-			  (execute-kbd-macro form))
-			 ((gnus-functionp form)
-			  (funcall form))
-			 (t
-			  (eval form)))))
-	  ;; Search article body.
-	  (let ((gnus-current-article nil) ;Save article pointer.
-		(gnus-last-article nil)
-		(gnus-break-pages nil)	;No need to break pages.
-		(gnus-mark-article-hook nil)) ;Inhibit marking as read.
-	    (gnus-message 
-	     6 "Searching for article: %d..." (mail-header-number header))
-	    (gnus-article-setup-buffer)
-	    (gnus-article-prepare (mail-header-number header) t)
-	    (if (save-excursion
-		  (set-buffer gnus-article-buffer)
-		  (goto-char (point-min))
-		  (setq did-kill (re-search-forward regexp nil t)))
-		(if (stringp form)	;Keyboard macro.
-		    (execute-kbd-macro form)
-		  (eval form))))))
-      did-kill)))
-
-(defun gnus-execute (field regexp form &optional backward ignore-marked)
-  "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
-If FIELD is an empty string (or nil), entire article body is searched for.
-If optional 1st argument BACKWARD is non-nil, do backward instead.
-If optional 2nd argument IGNORE-MARKED is non-nil, articles which are
-marked as read or ticked are ignored."
-  (save-excursion
-    (let ((killed-no 0)
-	  function article header)
-      (cond 
-       ;; Search body.
-       ((or (null field) 
-	    (string-equal field ""))
-	(setq function nil))
-       ;; Get access function of header field.
-       ((fboundp
-	 (setq function 
-	       (intern-soft 
-		(concat "mail-header-" (downcase field)))))
-	(setq function `(lambda (h) (,function h))))
-       ;; Signal error.
-       (t
-	(error "Unknown header field: \"%s\"" field)))
-      ;; Starting from the current article.
-      (while (or
-	      ;; First article.
-	      (and (not article)
-		   (setq article (gnus-summary-article-number)))
-	      ;; Find later articles.
-	      (setq article 
-		    (gnus-summary-search-forward 
-		     (not ignore-marked) nil backward)))
-	(and (or (null gnus-newsgroup-kill-headers)
-		 (memq article gnus-newsgroup-kill-headers))
-	     (vectorp (setq header (gnus-summary-article-header article)))
-	     (gnus-execute-1 function regexp form header)
-	     (setq killed-no (1+ killed-no))))
-      ;; Return the number of killed articles.
-      killed-no)))
-
-(provide 'gnus-kill)
-
-;;; gnus-kill.el ends here
diff --git a/lisp/gnus-mh.el b/lisp/gnus-mh.el
deleted file mode 100644
index 02317a22eeb..00000000000
--- a/lisp/gnus-mh.el
+++ /dev/null
@@ -1,105 +0,0 @@
-;;; gnus-mh.el --- mh-e interface for Gnus
-;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-;;; Send mail using mh-e.
-
-;; The following mh-e interface is all cooperative works of
-;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP
-;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki
-;; SHINGU).
-
-;;; Code:
-
-(require 'mh-e)
-(require 'mh-comp)
-(require 'gnus)
-(require 'gnus-msg)
-(eval-when-compile (require 'cl))
-
-(defun gnus-summary-save-article-folder (&optional arg)
-  "Append the current article to an mh folder.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
-  (interactive "P")
-  (let ((gnus-default-article-saver 'gnus-summary-save-in-folder))
-    (gnus-summary-save-article arg)))
-
-(defun gnus-summary-save-in-folder (&optional folder)
-  "Save this article to MH folder (using `rcvstore' in MH library).
-Optional argument FOLDER specifies folder name."
-  ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
-  (mh-find-path)
-  (let ((folder
-	 (cond ((and (eq folder 'default)
-		     gnus-newsgroup-last-folder)
-		gnus-newsgroup-last-folder)
-	       (folder folder)
-	       (t (mh-prompt-for-folder 
-		   "Save article in"
-		   (funcall gnus-folder-save-name gnus-newsgroup-name
-			    gnus-current-headers gnus-newsgroup-last-folder)
-		   t))))
-	(errbuf (get-buffer-create " *Gnus rcvstore*"))
-	;; Find the rcvstore program.
-	(exec-path (if mh-lib (cons mh-lib exec-path) exec-path)))
-    (gnus-eval-in-buffer-window gnus-original-article-buffer
-      (save-restriction
-	(widen)
-	(unwind-protect
-	    (call-process-region 
-	     (point-min) (point-max) "rcvstore" nil errbuf nil folder)
-	  (set-buffer errbuf)
-	  (if (zerop (buffer-size))
-	      (message "Article saved in folder: %s" folder)
-	    (message "%s" (buffer-string)))
-	  (kill-buffer errbuf))))
-    (setq gnus-newsgroup-last-folder folder)))
-
-(defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
-  "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
-If variable `gnus-use-long-file-name' is nil, it is +News.group.
-Otherwise, it is like +news/group."
-  (or last-folder
-      (concat "+"
-	      (if gnus-use-long-file-name
-		  (gnus-capitalize-newsgroup newsgroup)
-		(gnus-newsgroup-directory-form newsgroup)))))
-
-(defun gnus-folder-save-name (newsgroup headers &optional last-folder)
-  "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
-If variable `gnus-use-long-file-name' is nil, it is +news.group.
-Otherwise, it is like +news/group."
-  (or last-folder
-      (concat "+"
-	      (if gnus-use-long-file-name
-		  newsgroup
-		(gnus-newsgroup-directory-form newsgroup)))))
-
-(provide 'gnus-mh)
-
-;;; gnus-mh.el ends here
diff --git a/lisp/gnus-msg.el b/lisp/gnus-msg.el
deleted file mode 100644
index 53e915af4c2..00000000000
--- a/lisp/gnus-msg.el
+++ /dev/null
@@ -1,929 +0,0 @@
-;;; gnus-msg.el --- mail and post interface for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'gnus)
-(require 'gnus-ems)
-(require 'message)
-(eval-when-compile (require 'cl))
-
-;; Added by Sudish Joseph <joseph@cis.ohio-state.edu>.
-(defvar gnus-post-method nil
-  "*Preferred method for posting USENET news.
-If this variable is nil, Gnus will use the current method to decide
-which method to use when posting.  If it is non-nil, it will override
-the current method.  This method will not be used in mail groups and
-the like, only in \"real\" newsgroups.
-
-The value must be a valid method as discussed in the documentation of
-`gnus-select-method'.  It can also be a list of methods.  If that is
-the case, the user will be queried for what select method to use when
-posting.")
-
-(defvar gnus-outgoing-message-group nil
-  "*All outgoing messages will be put in this group.
-If you want to store all your outgoing mail and articles in the group
-\"nnml:archive\", you set this variable to that value. This variable
-can also be a list of group names. 
-
-If you want to have greater control over what group to put each
-message in, you can set this variable to a function that checks the
-current newsgroup name and then returns a suitable group name (or list
-of names).")
-
-(defvar gnus-mailing-list-groups nil
-  "*Regexp matching groups that are really mailing lists.
-This is useful when you're reading a mailing list that has been
-gatewayed to a newsgroup, and you want to followup to an article in
-the group.")
-
-(defvar gnus-sent-message-ids-file 
-  (nnheader-concat gnus-directory "Sent-Message-IDs")
-  "File where Gnus saves a cache of sent message ids.")
-
-(defvar gnus-sent-message-ids-length 1000
-  "The number of sent Message-IDs to save.")
-
-;;; Internal variables.
-
-(defvar gnus-message-buffer "*Mail Gnus*")
-(defvar gnus-article-copy nil)
-(defvar gnus-last-posting-server nil)
-
-(eval-and-compile
-  (autoload 'gnus-uu-post-news "gnus-uu" nil t)
-  (autoload 'news-setup "rnewspost")
-  (autoload 'news-reply-mode "rnewspost")
-  (autoload 'rmail-dont-reply-to "mail-utils")
-  (autoload 'rmail-output "rmailout"))
-
-
-;;;
-;;; Gnus Posting Functions
-;;;
-
-(gnus-define-keys 
- (gnus-summary-send-map "S" gnus-summary-mode-map)
- "p" gnus-summary-post-news
- "f" gnus-summary-followup
- "F" gnus-summary-followup-with-original
- "c" gnus-summary-cancel-article
- "s" gnus-summary-supersede-article
- "r" gnus-summary-reply
- "R" gnus-summary-reply-with-original
- "m" gnus-summary-mail-other-window
- "u" gnus-uu-post-news
- "om" gnus-summary-mail-forward
- "op" gnus-summary-post-forward
- "Om" gnus-uu-digest-mail-forward
- "Op" gnus-uu-digest-post-forward)
-
-(gnus-define-keys
- (gnus-send-bounce-map "D" gnus-summary-send-map)
- "b" gnus-summary-resend-bounced-mail
-; "c" gnus-summary-send-draft
- "r" gnus-summary-resend-message)
-
-;;; Internal functions.
-
-(defvar gnus-article-reply nil)
-(defmacro gnus-setup-message (config &rest forms)
-  (let ((winconf (make-symbol "winconf"))
-	(buffer (make-symbol "buffer"))
-	(article (make-symbol "article")))
-    `(let ((,winconf (current-window-configuration))
-	   (,buffer (current-buffer))
-	   (,article (and gnus-article-reply (gnus-summary-article-number)))
-	   (message-header-setup-hook
-	    (copy-sequence message-header-setup-hook)))
-       (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
-       (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
-       ,@forms
-       (gnus-inews-add-send-actions ,winconf ,buffer ,article)
-       (setq gnus-message-buffer (current-buffer))
-       (gnus-configure-windows ,config t))))
-    
-(defun gnus-inews-add-send-actions (winconf buffer article)
-  (gnus-make-local-hook 'message-sent-hook)
-  (gnus-add-hook 'message-sent-hook 'gnus-inews-do-gcc nil t)
-  (setq message-post-method
-	`(lambda (arg)
-	   (gnus-post-method arg ,gnus-newsgroup-name)))
-  (setq message-newsreader (setq message-mailer (gnus-extended-version)))
-  (message-add-action
-   `(set-window-configuration ,winconf) 'exit 'postpone 'kill)
-  (message-add-action
-   `(when (buffer-name ,buffer)
-      (save-excursion
-	(set-buffer ,buffer)
-	,(when article
-	   `(gnus-summary-mark-article-as-replied ,article))))
-   'send))
-
-(put 'gnus-setup-message 'lisp-indent-function 1)
-(put 'gnus-setup-message 'lisp-indent-hook 1)
-(put 'gnus-setup-message 'edebug-form-spec '(form body))
-
-;;; Post news commands of Gnus group mode and summary mode
-
-(defun gnus-group-mail ()
-  "Start composing a mail."
-  (interactive)
-  (gnus-setup-message 'message
-    (message-mail)))
-
-(defun gnus-group-post-news (&optional arg)
-  "Start composing a news message.
-If ARG, post to the group under point.
-If ARG is 1, prompt for a group name."
-  (interactive "P")
-  ;; Bind this variable here to make message mode hooks
-  ;; work ok.
-  (let ((gnus-newsgroup-name
-	 (if arg
-	     (if (= 1 (prefix-numeric-value arg))
-		 (completing-read "Newsgroup: " gnus-active-hashtb nil
-				  (gnus-read-active-file-p))
-	       (gnus-group-group-name))
-	   "")))
-    (gnus-post-news 'post gnus-newsgroup-name)))
-
-(defun gnus-summary-post-news ()
-  "Start composing a news message."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-post-news 'post gnus-newsgroup-name))
-
-(defun gnus-summary-followup (yank &optional force-news)
-  "Compose a followup to an article.
-If prefix argument YANK is non-nil, original article is yanked automatically."
-  (interactive 
-   (list (and current-prefix-arg 
-	      (gnus-summary-work-articles 1))))
-  (gnus-set-global-variables)
-  (when yank
-    (gnus-summary-goto-subject (car yank)))
-  (save-window-excursion
-    (gnus-summary-select-article))
-  (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
-	(gnus-newsgroup-name gnus-newsgroup-name))
-    ;; Send a followup.
-    (gnus-post-news nil gnus-newsgroup-name
-		    headers gnus-article-buffer 
-		    yank nil force-news)))
-
-(defun gnus-summary-followup-with-original (n &optional force-news)
-  "Compose a followup to an article and include the original article."
-  (interactive "P")
-  (gnus-summary-followup (gnus-summary-work-articles n) force-news))
-
-(defun gnus-inews-yank-articles (articles)
-  (let (beg article)
-    (while (setq article (pop articles))
-      (save-window-excursion
-	(set-buffer gnus-summary-buffer)
-	(gnus-summary-select-article nil nil nil article)
-	(gnus-summary-remove-process-mark article))
-      (gnus-copy-article-buffer)
-      (let ((message-reply-buffer gnus-article-copy)
-	    (message-reply-headers gnus-current-headers))
-	(message-yank-original)
-	(setq beg (or beg (mark t))))
-      (when articles (insert "\n")))
-    
-    (push-mark)
-    (goto-char beg)))
-
-(defun gnus-summary-cancel-article (n)
-  "Cancel an article you posted."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((articles (gnus-summary-work-articles n))
-	(message-post-method
-	 `(lambda (arg)
-	    (gnus-post-method nil ,gnus-newsgroup-name)))
-	article)
-    (while (setq article (pop articles))
-      (when (gnus-summary-select-article t nil nil article)
-	(when (gnus-eval-in-buffer-window 
-	       gnus-original-article-buffer (message-cancel-news))
-	  (gnus-summary-mark-as-read article gnus-canceled-mark)
-	  (gnus-cache-remove-article 1))
-	(gnus-article-hide-headers-if-wanted))
-      (gnus-summary-remove-process-mark article))))
-
-(defun gnus-summary-supersede-article ()
-  "Compose an article that will supersede a previous article.
-This is done simply by taking the old article and adding a Supersedes
-header line with the old Message-ID."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((article (gnus-summary-article-number)))
-    (gnus-setup-message 'reply-yank
-      (gnus-summary-select-article t)
-      (set-buffer gnus-original-article-buffer)
-      (message-supersede)
-      (push
-       `((lambda ()
-	   (gnus-cache-possibly-remove-article ,article nil nil nil t)))
-       message-send-actions))))
-
-
-
-(defun gnus-copy-article-buffer (&optional article-buffer)
-  ;; make a copy of the article buffer with all text properties removed
-  ;; this copy is in the buffer gnus-article-copy.
-  ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
-  ;; this buffer should be passed to all mail/news reply/post routines.
-  (setq gnus-article-copy (get-buffer-create " *gnus article copy*"))
-  (buffer-disable-undo gnus-article-copy)
-  (or (memq gnus-article-copy gnus-buffer-list)
-      (setq gnus-buffer-list (cons gnus-article-copy gnus-buffer-list)))
-  (let ((article-buffer (or article-buffer gnus-article-buffer))
-	end beg contents)
-    (when (and (get-buffer article-buffer)
-	       (buffer-name (get-buffer article-buffer)))
-      (save-excursion
-	(set-buffer article-buffer)
-	(save-restriction
-	  (widen)
-	  (setq contents (format "%s" (buffer-string)))
-	  (set-buffer gnus-original-article-buffer)
-	  (goto-char (point-min))
-	  (while (looking-at message-unix-mail-delimiter)
-	    (forward-line 1))
-	  (setq beg (point))
-	  (setq end (or (search-forward "\n\n" nil t) (point)))
-	  (set-buffer gnus-article-copy)
-	  (erase-buffer)
-	  (insert contents)
-	  (delete-region (goto-char (point-min))
-			 (or (search-forward "\n\n" nil t) (point)))
-	  (insert-buffer-substring gnus-original-article-buffer beg end)))
-      gnus-article-copy)))
-
-(defun gnus-post-news (post &optional group header article-buffer yank subject
-			    force-news)
-  (when article-buffer
-    (gnus-copy-article-buffer))
-  (let ((gnus-article-reply article-buffer))
-    (gnus-setup-message (cond (yank 'reply-yank)
-			      (article-buffer 'reply)
-			      (t 'message))
-      (let* ((group (or group gnus-newsgroup-name))
-	     (pgroup group)
-	     to-address to-group mailing-list to-list)
-	(when group
-	  (setq to-address (gnus-group-get-parameter group 'to-address)
-		to-group (gnus-group-get-parameter group 'to-group)
-		to-list (gnus-group-get-parameter group 'to-list)
-		mailing-list (when gnus-mailing-list-groups
-			       (string-match gnus-mailing-list-groups group))
-		group (gnus-group-real-name group)))
-	(if (or (and to-group
-		     (gnus-news-group-p to-group))
-		force-news
-		(and (gnus-news-group-p 
-		      (or pgroup gnus-newsgroup-name)
-		      (if header (mail-header-number header)
-			gnus-current-article))
-		     (not mailing-list)
-		     (not to-list)
-		     (not to-address)))
-	    ;; This is news.
-	    (if post
-		(message-news (or to-group group))
-	      (set-buffer gnus-article-copy)
-	      (message-followup))
-	  ;; The is mail.
-	  (if post
-	      (progn
-		(message-mail (or to-address to-list))
-		;; Arrange for mail groups that have no `to-address' to
-		;; get that when the user sends off the mail.
-		(push (list 'gnus-inews-add-to-address group)
-		      message-send-actions))
-	    (set-buffer gnus-article-copy)
-	    (message-wide-reply to-address)))
-	(when yank
-	  (gnus-inews-yank-articles yank))))))
-
-(defun gnus-post-method (arg group &optional silent)
-  "Return the posting method based on GROUP and ARG.
-If SILENT, don't prompt the user."
-  (let ((group-method (gnus-find-method-for-group group)))
-    (cond 
-     ;; If the group-method is nil (which shouldn't happen) we use 
-     ;; the default method.
-     ((null arg)
-      (or gnus-post-method gnus-select-method message-post-method))
-     ;; We want this group's method.
-     ((and arg (not (eq arg 0)))
-      group-method)
-     ;; We query the user for a post method.
-     ((or arg
-	  (and gnus-post-method
-	       (listp (car gnus-post-method))))
-      (let* ((methods
-	      ;; Collect all methods we know about.
-	      (append
-	       (when gnus-post-method
-		 (if (listp (car gnus-post-method))
-		     gnus-post-method
-		   (list gnus-post-method)))
-	       gnus-secondary-select-methods
-	       (list gnus-select-method)
-	       (list group-method)))
-	     method-alist post-methods method)
-	;; Weed out all mail methods.
-	(while methods
-	  (setq method (gnus-server-get-method "" (pop methods)))
-	  (when (or (gnus-method-option-p method 'post)
-		    (gnus-method-option-p method 'post-mail))
-	    (push method post-methods)))
-	;; Create a name-method alist.
-	(setq method-alist
-	      (mapcar 
-	       (lambda (m)
-		 (list (concat (cadr m) " (" (symbol-name (car m)) ")") m))
-	       post-methods))
-	;; Query the user.
-	(cadr
-	 (assoc
-	  (setq gnus-last-posting-server
-		(if (and silent
-			 gnus-last-posting-server)
-		    ;; Just use the last value.
-		    gnus-last-posting-server
-		  (completing-read
-		   "Posting method: " method-alist nil t
-		   (cons (or gnus-last-posting-server "") 0))))
-	  method-alist))))
-     ;; Override normal method.
-     ((and gnus-post-method
-	   (or (gnus-method-option-p group-method 'post)
-	       (gnus-method-option-p group-method 'post-mail)))
-      gnus-post-method)
-     ;; Perhaps this is a mail group?
-     ((and (not (gnus-member-of-valid 'post group))
-	   (not (gnus-method-option-p group-method 'post-mail)))
-      group-method)
-     ;; Use the normal select method.
-     (t gnus-select-method))))
-
-(defun gnus-inews-narrow-to-headers ()
-  (widen)
-  (narrow-to-region
-   (goto-char (point-min))
-   (or (and (re-search-forward 
-	     (concat "^" (regexp-quote mail-header-separator) "$") nil t)
-	    (match-beginning 0))
-       (point-max)))
-  (goto-char (point-min)))
-
-;;;
-;;; Check whether the message has been sent already.
-;;;
-
-(defvar gnus-inews-sent-ids nil)
-
-(defun gnus-inews-reject-message ()
-  "Check whether this message has already been sent."
-  (when gnus-sent-message-ids-file
-    (let ((message-id (save-restriction (gnus-inews-narrow-to-headers)
-					(mail-fetch-field "message-id")))
-	  end)
-      (when message-id
-	(unless gnus-inews-sent-ids
-	  (condition-case ()
-	      (load  t t t)
-	    (error nil)))
-	(if (member message-id gnus-inews-sent-ids)
-	    ;; Reject this message.
-	    (not (gnus-yes-or-no-p 
-		  (format "Message %s already sent.  Send anyway? "
-			  message-id)))
-	  (push message-id gnus-inews-sent-ids)
-	  ;; Chop off the last Message-IDs.
-	  (when (setq end (nthcdr gnus-sent-message-ids-length 
-				  gnus-inews-sent-ids))
-	    (setcdr end nil))
-	  (nnheader-temp-write gnus-sent-message-ids-file
-	    (prin1 `(setq gnus-inews-sent-ids ',gnus-inews-sent-ids)
-		   (current-buffer)))
-	  nil)))))
-
-
-
-;; Dummy to avoid byte-compile warning.
-(defvar nnspool-rejected-article-hook)
-
-;;; Since the X-Newsreader/X-Mailer are ``vanity'' headers, they might
-;;; as well include the Emacs version as well.
-;;; The following function works with later GNU Emacs, and XEmacs.
-(defun gnus-extended-version ()
-  "Stringified Gnus version and Emacs version"
-  (interactive)
-  (concat
-   gnus-version
-   "/"
-   (cond
-    ((string-match "^\\([0-9]+\\.[0-9]+\\)\\.[.0-9]+$" emacs-version)
-     (concat "Emacs " (substring emacs-version
-				 (match-beginning 1)
-				 (match-end 1))))
-    ((string-match "\\([A-Z]*[Mm][Aa][Cc][Ss]\\)" emacs-version)
-     (concat (substring emacs-version
-			(match-beginning 1)
-			(match-end 1))
-	     (format " %d.%d" emacs-major-version emacs-minor-version)))
-    (t emacs-version))))
-
-;; Written by "Mr. Per Persson" <pp@solace.mh.se>.
-(defun gnus-inews-insert-mime-headers ()
-  (goto-char (point-min))
-  (let ((mail-header-separator 
-	 (progn 
-	   (goto-char (point-min))
-	   (if (and (search-forward (concat "\n" mail-header-separator "\n")
-				    nil t)
-		    (not (search-backward "\n\n" nil t)))
-	       mail-header-separator
-	     ""))))
-    (or (mail-position-on-field "Mime-Version")
-	(insert "1.0")
-	(cond ((save-restriction
-		 (widen)
-		 (goto-char (point-min))
-		 (re-search-forward "[\200-\377]" nil t))
-	       (or (mail-position-on-field "Content-Type")
-		   (insert "text/plain; charset=ISO-8859-1"))
-	       (or (mail-position-on-field "Content-Transfer-Encoding")
-		   (insert "8bit")))
-	      (t (or (mail-position-on-field "Content-Type")
-		     (insert "text/plain; charset=US-ASCII"))
-		 (or (mail-position-on-field "Content-Transfer-Encoding")
-		     (insert "7bit")))))))
-
-
-;;;
-;;; Gnus Mail Functions 
-;;;
-
-;;; Mail reply commands of Gnus summary mode
-
-(defun gnus-summary-reply (&optional yank)
-  "Reply mail to news author.
-If prefix argument YANK is non-nil, original article is yanked automatically."
-  (interactive 
-   (list (and current-prefix-arg 
-	      (gnus-summary-work-articles 1))))
-  ;; Bug fix by jbw@bigbird.bu.edu (Joe Wells)
-  ;; Stripping headers should be specified with mail-yank-ignored-headers.
-  (gnus-set-global-variables)
-  (when yank 
-    (gnus-summary-goto-subject (car yank)))
-  (let ((gnus-article-reply t))
-    (gnus-setup-message (if yank 'reply-yank 'reply)
-      (gnus-summary-select-article)
-      (set-buffer (gnus-copy-article-buffer))
-      (message-reply nil nil (gnus-group-get-parameter
-			      gnus-newsgroup-name 'broken-reply-to))
-      (when yank
-	(gnus-inews-yank-articles yank)))))
-
-(defun gnus-summary-reply-with-original (n)
-  "Reply mail to news author with original article."
-  (interactive "P")
-  (gnus-summary-reply (gnus-summary-work-articles n)))
-
-(defun gnus-summary-mail-forward (&optional post)
-  "Forward the current message to another user."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-setup-message 'forward
-    (gnus-summary-select-article)
-    (set-buffer gnus-original-article-buffer)
-    (message-forward post)))
-
-(defun gnus-summary-resend-message (address)
-  "Resend the current article to ADDRESS."
-  (interactive "sResend message to: ")
-  (gnus-summary-select-article)
-  (save-excursion
-    (set-buffer gnus-original-article-buffer)
-    (message-resend address)))
-
-(defun gnus-summary-post-forward ()
-  "Forward the current article to a newsgroup."
-  (interactive)
-  (gnus-summary-mail-forward t))
-
-(defvar gnus-nastygram-message 
-  "The following article was inappropriately posted to %s.\n"
-  "Format string to insert in nastygrams.
-The current group name will be inserted at \"%s\".")
-
-(defun gnus-summary-mail-nastygram (n)
-  "Send a nastygram to the author of the current article."
-  (interactive "P")
-  (if (or gnus-expert-user
-	  (gnus-y-or-n-p 
-	   "Really send a nastygram to the author of the current article? "))
-      (let ((group gnus-newsgroup-name))
-	(gnus-summary-reply-with-original n)
-	(set-buffer gnus-message-buffer)
-	(insert (format gnus-nastygram-message group))
-	(message-send-and-exit))))
-
-(defun gnus-summary-mail-other-window ()
-  "Compose mail in other window."
-  (interactive)
-  (gnus-setup-message 'message
-    (message-mail)))
-
-(defun gnus-mail-parse-comma-list ()
-  (let (accumulated
-	beg)
-    (skip-chars-forward " ")
-    (while (not (eobp))
-      (setq beg (point))
-      (skip-chars-forward "^,")
-      (while (zerop
-	      (save-excursion 
-		(save-restriction
-		  (let ((i 0))
-		    (narrow-to-region beg (point))
-		    (goto-char beg)
-		    (logand (progn
-			      (while (search-forward "\"" nil t)
-				(incf i))
-			      (if (zerop i) 2 i)) 2)))))
-	(skip-chars-forward ",")
-	(skip-chars-forward "^,"))
-      (skip-chars-backward " ")
-      (setq accumulated
-	    (cons (buffer-substring beg (point))
-		  accumulated))
-      (skip-chars-forward "^,")
-      (skip-chars-forward ", "))
-    accumulated))
-
-(defun gnus-mail-yank-original ()
-  (interactive)
-  (save-excursion
-    (mail-yank-original nil))
-  (or mail-yank-hooks mail-citation-hook
-      (run-hooks 'news-reply-header-hook)))
-
-(defun gnus-inews-add-to-address (group)
-  (let ((to-address (mail-fetch-field "to")))
-    (when (and to-address
-	       (gnus-alive-p))
-      ;; This mail group doesn't have a `to-list', so we add one
-      ;; here.  Magic!  
-      (gnus-group-add-parameter group (cons 'to-list to-address)))))
-
-(defun gnus-put-message ()
-  "Put the current message in some group and return to Gnus."
-  (interactive)
-  (let ((reply gnus-article-reply)
-	(winconf gnus-prev-winconf)
-	(group gnus-newsgroup-name))
-    
-    (or (and group (not (gnus-group-read-only-p group)))
-	(setq group (read-string "Put in group: " nil
-				 (gnus-writable-groups))))
-    (and (gnus-gethash group gnus-newsrc-hashtb)
-	 (error "No such group: %s" group))
-
-    (save-excursion
-      (save-restriction
-	(widen)
-	(gnus-inews-narrow-to-headers)
-	(let (gnus-deletable-headers)
-	  (if (message-news-p)
-	      (message-generate-headers message-required-news-headers)
-	    (message-generate-headers message-required-mail-headers)))
-	(goto-char (point-max))
-	(insert "Gcc: " group "\n")
-	(widen)))
-
-    (gnus-inews-do-gcc)
-
-    (if (get-buffer gnus-group-buffer)
-	(progn
-	  (if (gnus-buffer-exists-p (car-safe reply))
-	      (progn
-		(set-buffer (car reply))
-		(and (cdr reply)
-		     (gnus-summary-mark-article-as-replied 
-		      (cdr reply)))))
-	  (and winconf (set-window-configuration winconf))))))
-
-(defun gnus-article-mail (yank)
-  "Send a reply to the address near point.
-If YANK is non-nil, include the original article."
-  (interactive "P")
-  (let ((address 
-	 (buffer-substring
-	  (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
-	  (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
-    (when address
-      (message-reply address)
-      (when yank
-	(gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
-
-(defun gnus-bug ()
-  "Send a bug report to the Gnus maintainers."
-  (interactive)
-  (gnus-setup-message 'bug
-    (delete-other-windows)
-    (switch-to-buffer "*Gnus Help Bug*")
-    (erase-buffer)
-    (insert gnus-bug-message)
-    (goto-char (point-min))
-    (message-pop-to-buffer "*Gnus Bug*")
-    (message-setup `((To . ,gnus-maintainer) (Subject . "")))
-    (push `(gnus-bug-kill-buffer) message-send-actions)
-    (goto-char (point-min))
-    (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
-    (forward-line 1)
-    (insert (gnus-version) "\n")
-    (insert (emacs-version))
-    (insert "\n\n\n\n\n")
-    (gnus-debug)
-    (goto-char (point-min))
-    (search-forward "Subject: " nil t)
-    (message "")))
-
-(defun gnus-bug-kill-buffer ()
-  (and (get-buffer "*Gnus Help Bug*")
-       (kill-buffer "*Gnus Help Bug*")))
-
-(defun gnus-debug ()
-  "Attemps to go through the Gnus source file and report what variables have been changed.
-The source file has to be in the Emacs load path."
-  (interactive)
-  (let ((files '("gnus.el" "gnus-msg.el" "gnus-score.el" "nnmail.el"
-		 "message.el"))
-	file dirs expr olist sym)
-    (gnus-message 4 "Please wait while we snoop your variables...")
-    (sit-for 0)
-    (save-excursion
-      (set-buffer (get-buffer-create " *gnus bug info*"))
-      (buffer-disable-undo (current-buffer))
-      (while files
-	(erase-buffer)
-	(setq dirs load-path)
-	(while dirs
-	  (if (or (not (car dirs))
-		  (not (stringp (car dirs)))
-		  (not (file-exists-p 
-			(setq file (concat (file-name-as-directory 
-					    (car dirs)) (car files))))))
-	      (setq dirs (cdr dirs))
-	    (setq dirs nil)
-	    (insert-file-contents file)
-	    (goto-char (point-min))
-	    (if (not (re-search-forward "^;;* *Internal variables" nil t))
-		(gnus-message 4 "Malformed sources in file %s" file)
-	      (narrow-to-region (point-min) (point))
-	      (goto-char (point-min))
-	      (while (setq expr (condition-case () 
-				    (read (current-buffer)) (error nil)))
-		(condition-case ()
-		    (and (eq (car expr) 'defvar)
-			 (stringp (nth 3 expr))
-			 (or (not (boundp (nth 1 expr)))
-			     (not (equal (eval (nth 2 expr))
-					 (symbol-value (nth 1 expr)))))
-			 (setq olist (cons (nth 1 expr) olist)))
-		  (error nil))))))
-	(setq files (cdr files)))
-      (kill-buffer (current-buffer)))
-    (when (setq olist (nreverse olist))
-      (insert "------------------ Environment follows ------------------\n\n"))
-    (while olist
-      (if (boundp (car olist))
-	  (condition-case ()
-	      (pp `(setq ,(car olist)
-			 ,(if (or (consp (setq sym (symbol-value (car olist))))
-				  (and (symbolp sym)
-				       (not (or (eq sym nil)
-						(eq sym t)))))
-			      (list 'quote (symbol-value (car olist)))
-			    (symbol-value (car olist))))
-		  (current-buffer))
-	    (error
-	     (format "(setq %s 'whatever)\n" (car olist))))
-	(insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
-      (setq olist (cdr olist)))
-    (insert "\n\n")
-    ;; Remove any null chars - they seem to cause trouble for some
-    ;; mailers. (Byte-compiled output from the stuff above.) 
-    (goto-char (point-min))
-    (while (re-search-forward "[\000\200]" nil t)
-      (replace-match "" t t))))
-
-;;; Treatment of rejected articles.
-;;; Bounced mail.
-
-(defun gnus-summary-resend-bounced-mail (&optional fetch)
-  "Re-mail the current message.
-This only makes sense if the current message is a bounce message than
-contains some mail you have written which has been bounced back to
-you.
-If FETCH, try to fetch the article that this is a reply to, if indeed
-this is a reply."
-  (interactive "P")
-  (gnus-summary-select-article t)
-  (set-buffer gnus-original-article-buffer)
-  (gnus-setup-message 'compose-bounce
-    (let* ((references (mail-fetch-field "references"))
-	   (parent (and references (gnus-parent-id references))))
-      (message-bounce)
-      ;; If there are references, we fetch the article we answered to.  
-      (and fetch parent
-	   (gnus-summary-refer-article parent)
-	   (gnus-summary-show-all-headers)))))
-
-;;; Gcc handling.
-
-;; Do Gcc handling, which copied the message over to some group. 
-(defun gnus-inews-do-gcc (&optional gcc)
-  (when (gnus-alive-p)
-    (save-excursion
-      (save-restriction
-	(message-narrow-to-headers)
-	(let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
-	      (cur (current-buffer))
-	      groups group method)
-	  (when gcc
-	    (message-remove-header "gcc")
-	    (widen)
-	    (setq groups (message-tokenize-header gcc " ,"))
-	    ;; Copy the article over to some group(s).
-	    (while (setq group (pop groups))
-	      (gnus-check-server 
-	       (setq method
-		     (cond ((and (null (gnus-get-info group))
-				 (eq (car gnus-message-archive-method)
-				     (car 
-				      (gnus-server-to-method
-				       (gnus-group-method group)))))
-			    ;; If the group doesn't exist, we assume
-			    ;; it's an archive group...
-			    gnus-message-archive-method)
-			   ;; Use the method.
-			   ((gnus-info-method (gnus-get-info group))
-			    (gnus-info-method (gnus-get-info group)))
-			   ;; Find the method.
-			   (t (gnus-group-method group)))))
-	      (gnus-check-server method)
-	      (unless (gnus-request-group group t method)
-		(gnus-request-create-group group method))
-	      (save-excursion
-		(nnheader-set-temp-buffer " *acc*")
-		(insert-buffer-substring cur)
-		(goto-char (point-min))
-		(when (re-search-forward 
-		       (concat "^" (regexp-quote mail-header-separator) "$")
-		       nil t)
-		  (replace-match "" t t ))
-		(unless (gnus-request-accept-article group method t)
-		  (gnus-message 1 "Couldn't store article in group %s: %s" 
-				group (gnus-status-message method))
-		  (sit-for 2))
-		(kill-buffer (current-buffer))))))))))
-
-(defun gnus-inews-insert-gcc ()
-  "Insert Gcc headers based on `gnus-outgoing-message-group'."
-  (save-excursion
-    (save-restriction
-      (gnus-inews-narrow-to-headers)
-      (let* ((group gnus-outgoing-message-group)
-	     (gcc (cond 
-		   ((gnus-functionp group)
-		    (funcall group))
-		   ((or (stringp group) (list group))
-		    group))))
-	(when gcc
-	  (insert "Gcc: "
-		  (if (stringp gcc) gcc
-		    (mapconcat 'identity gcc " "))
-		  "\n"))))))
-
-(defun gnus-inews-insert-archive-gcc (&optional group)
-  "Insert the Gcc to say where the article is to be archived."
-  (let* ((var gnus-message-archive-group)
-	 (group (or group gnus-newsgroup-name ""))
-	 result
-	 (groups
-	  (cond 
-	   ((null gnus-message-archive-method)
-	    ;; Ignore.
-	    nil)
-	   ((stringp var)
-	    ;; Just a single group.
-	    (list var))
-	   ((null var)
-	    ;; We don't want this.
-	    nil)
-	   ((and (listp var) (stringp (car var)))
-	    ;; A list of groups.
-	    var)
-	   ((gnus-functionp var)
-	    ;; A function.
-	    (funcall var group))
-	   (t
-	    ;; An alist of regexps/functions/forms.
-	    (while (and var
-			(not
-			 (setq result
-			       (cond 
-				((stringp (caar var))
-				 ;; Regexp.
-				 (when (string-match (caar var) group)
-				   (cdar var)))
-				((gnus-functionp (car var))
-				 ;; Function.
-				 (funcall (car var) group))
-				(t
-				 (eval (car var)))))))
-	      (setq var (cdr var)))
-	    result)))
-	 name)
-    (when groups
-      (when (stringp groups)
-	(setq groups (list groups)))
-      (save-excursion
-	(save-restriction
-	  (gnus-inews-narrow-to-headers)
-	  (goto-char (point-max))
-	  (insert "Gcc: ")
-	  (while (setq name (pop groups))
-	    (insert (if (string-match ":" name)
-			name
-		      (gnus-group-prefixed-name 
-		       name gnus-message-archive-method)))
-	    (if groups (insert " ")))
-	  (insert "\n"))))))
-
-(defun gnus-summary-send-draft ()
-  "Enter a mail/post buffer to edit and send the draft."
-  (interactive)
-  (gnus-set-global-variables)
-  (let (buf)
-    (if (not (setq buf (gnus-request-restore-buffer 
-			(gnus-summary-article-number) gnus-newsgroup-name)))
-	(error "Couldn't restore the article")
-      (switch-to-buffer buf)
-      (when (eq major-mode 'news-reply-mode)
-	(local-set-key "\C-c\C-c" 'gnus-inews-news))
-      ;; Insert the separator.
-      (goto-char (point-min))
-      (search-forward "\n\n")
-      (forward-char -1)
-      (insert mail-header-separator)
-      ;; Configure windows.
-      (let ((gnus-draft-buffer (current-buffer)))
-	(gnus-configure-windows 'draft t)
-	(goto-char (point))))))
-  
-(gnus-add-shutdown 'gnus-inews-close 'gnus)
-
-(defun gnus-inews-close ()
-  (setq gnus-inews-sent-ids nil))
-  
-;;; Allow redefinition of functions.
-
-(gnus-ems-redefine)
-
-(provide 'gnus-msg)
-
-;;; gnus-msg.el ends here
diff --git a/lisp/gnus-nocem.el b/lisp/gnus-nocem.el
deleted file mode 100644
index 89f27773b8c..00000000000
--- a/lisp/gnus-nocem.el
+++ /dev/null
@@ -1,247 +0,0 @@
-;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'gnus)
-(require 'nnmail)
-(eval-when-compile (require 'cl))
-
-(defvar gnus-nocem-groups 
-  '("alt.nocem.misc" "news.admin.net-abuse.announce")
-  "*List of groups that will be searched for NoCeM messages.")
-
-(defvar gnus-nocem-issuers 
-  '("Automoose-1" ; The CancelMoose[tm] on autopilot.
-    "clewis@ferret.ocunix.on.ca;" ; Chris Lewis -- Canadian angel & despammer.
-    "jem@xpat.com;"  ; John Milburn -- despammer in Korea.
-    "red@redpoll.mrfs.oh.us (Richard E. Depew)" ; Spew/bincancel guy.
-    )
-  "*List of NoCeM issuers to pay attention to.")
-
-(defvar gnus-nocem-directory 
-  (concat (file-name-as-directory gnus-article-save-directory) "NoCeM/")
-  "*Directory where NoCeM files will be stored.")
-
-(defvar gnus-nocem-expiry-wait 15
-  "*Number of days to keep NoCeM headers in the cache.")
-
-(defvar gnus-nocem-verifyer nil
-  "*Function called to verify that the NoCeM message is valid.
-One likely value is `mc-verify'.  If the function in this variable
-isn't bound, the message will be used unconditionally.")
-
-;;; Internal variables
-
-(defvar gnus-nocem-active nil)
-(defvar gnus-nocem-alist nil)
-(defvar gnus-nocem-touched-alist nil)
-(defvar gnus-nocem-hashtb nil)
-
-;;; Functions
-
-(defun gnus-nocem-active-file ()
-  (concat (file-name-as-directory gnus-nocem-directory) "active"))
-
-(defun gnus-nocem-cache-file ()
-  (concat (file-name-as-directory gnus-nocem-directory) "cache"))
-
-(defun gnus-nocem-scan-groups ()
-  "Scan all NoCeM groups for new NoCeM messages."
-  (interactive)
-  (let ((groups gnus-nocem-groups)
-	group active gactive articles)
-    (or (file-exists-p gnus-nocem-directory)
-	(make-directory gnus-nocem-directory t))
-    ;; Load any previous NoCeM headers.
-    (gnus-nocem-load-cache)
-    ;; Read the active file if it hasn't been read yet.
-    (and (file-exists-p (gnus-nocem-active-file))
-	 (not gnus-nocem-active)
-	 (condition-case ()
-	     (load (gnus-nocem-active-file) t t t)
-	   (error nil)))
-    ;; Go through all groups and see whether new articles have
-    ;; arrived.  
-    (while (setq group (pop groups))
-      (if (not (setq gactive (gnus-activate-group group)))
-	  () ; This group doesn't exist.
-	(setq active (nth 1 (assoc group gnus-nocem-active)))
-	(when (and (not (< (cdr gactive) (car gactive))) ; Empty group.
-		   (or (not active)
-		       (< (cdr active) (cdr gactive))))
-	  ;; Ok, there are new articles in this group, se we fetch the
-	  ;; headers.
-	  (save-excursion
-	    (let ((dependencies (make-vector 10 nil))
-		  (buffer (nnheader-set-temp-buffer " *Gnus NoCeM*"))
-		  headers)
-	      (setq headers
-		    (if (eq 'nov
-			    (gnus-retrieve-headers 
-			     (setq articles
-				   (gnus-uncompress-range
-				    (cons 
-				     (if active (1+ (cdr active)) 
-				       (car gactive))
-				     (cdr gactive))))
-			     group))
-			(gnus-get-newsgroup-headers-xover 
-			 articles nil dependencies)
-		      (gnus-get-newsgroup-headers dependencies)))
-	      (while headers
-		;; We take a closer look on all articles that have
-		;; "@@NCM" in the subject.  
-		(when (string-match "@@NCM"
-				    (mail-header-subject (car headers)))
-		  (gnus-nocem-check-article group (car headers)))
-		(setq headers (cdr headers)))
-	      (kill-buffer (current-buffer)))))
-	(setq gnus-nocem-active
-	      (cons (list group gactive) 
-		    (delq (assoc group gnus-nocem-active)
-			  gnus-nocem-active)))))
-    ;; Save the results, if any.
-    (gnus-nocem-save-cache)
-    (gnus-nocem-save-active)))
-
-(defun gnus-nocem-check-article (group header)
-  "Check whether the current article is an NCM article and that we want it."
-  ;; Get the article.
-  (gnus-message 7 "Checking article %d in %s for NoCeM..."
-		(mail-header-number header) group)
-  (let ((date (mail-header-date header))
-	issuer b e)
-    (when (or (not date)
-	      (nnmail-time-less 
-	       (nnmail-time-since (nnmail-date-to-time date))
-	       (nnmail-days-to-time gnus-nocem-expiry-wait)))
-      (gnus-request-article-this-buffer (mail-header-number header) group)
-      (goto-char (point-min))
-      ;; The article has to have proper NoCeM headers.
-      (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t))
-		 (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t)))
-	;; We get the name of the issuer.
-	(narrow-to-region b e)
-	(setq issuer (mail-fetch-field "issuer"))
-	(and (member issuer gnus-nocem-issuers) ; We like her...
-	     (gnus-nocem-verify-issuer issuer) ; She is who she says she is..
-	     (gnus-nocem-enter-article)))))) ; We gobble the message.
-  
-(defun gnus-nocem-verify-issuer (person)
-  "Verify using PGP that the canceler is who she says she is."
-  (widen)
-  (if (fboundp gnus-nocem-verifyer)
-      (funcall gnus-nocem-verifyer)
-    ;; If we don't have MailCrypt, then we use the message anyway.
-    t))
-
-(defun gnus-nocem-enter-article ()
-  "Enter the current article into the NoCeM cache."
-  (goto-char (point-min))
-  (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t))
-	(e (search-forward "\n@@END NCM BODY\n" nil t))
-	(buf (current-buffer))
-	ncm id)
-    (when (and b e)
-      (narrow-to-region b (1+ (match-beginning 0)))
-      (goto-char (point-min))
-      (while (search-forward "\t" nil t)
-	(when (condition-case nil
-		  (boundp (let ((obarray gnus-active-hashtb)) (read buf)))
-		(error nil))
-	  (beginning-of-line)
-	  (while (= (following-char) ?\t)
-	    (forward-line -1))
-	  (setq id (buffer-substring (point) (1- (search-forward "\t"))))
-	  (push id ncm)
-	  (gnus-sethash id t gnus-nocem-hashtb)
-	  (forward-line 1)
-	  (while (= (following-char) ?\t)
-	    (forward-line 1))))
-      (when ncm
-	(setq gnus-nocem-touched-alist t)
-	(push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time)
-		    ncm) 
-	      gnus-nocem-alist)))))
-
-(defun gnus-nocem-load-cache ()
-  "Load the NoCeM cache."
-  (unless gnus-nocem-alist
-    ;; The buffer doesn't exist, so we create it and load the NoCeM
-    ;; cache.  
-    (when (file-exists-p (gnus-nocem-cache-file))
-      (load (gnus-nocem-cache-file) t t t)
-      (gnus-nocem-alist-to-hashtb))))
-      
-(defun gnus-nocem-save-cache ()
-  "Save the NoCeM cache."
-  (when (and gnus-nocem-alist
-	     gnus-nocem-touched-alist)
-    (nnheader-temp-write (gnus-nocem-cache-file)
-      (prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist) (current-buffer)))
-    (setq gnus-nocem-touched-alist nil)))
-
-(defun gnus-nocem-save-active ()
-  "Save the NoCeM active file."
-  (nnheader-temp-write (gnus-nocem-active-file)
-    (prin1 `(setq gnus-nocem-active ',gnus-nocem-active) (current-buffer))))
-
-(defun gnus-nocem-alist-to-hashtb ()
-  "Create a hashtable from the Message-IDs we have."
-  (let* ((alist gnus-nocem-alist)
-	 (pprev (cons nil alist))
-	 (prev pprev)
-	 (expiry (nnmail-days-to-time gnus-nocem-expiry-wait))
-	 entry)
-    (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51)))
-    (while (setq entry (car alist))
-      (if (not (nnmail-time-less (nnmail-time-since (car entry)) expiry))
-	  ;; This entry has expired, so we remove it.
-	  (setcdr prev (cdr alist))
-	(setq prev alist)
-	;; This is ok, so we enter it into the hashtable.
-	(setq entry (cdr entry))
-	(while entry
-	  (gnus-sethash (car entry) t gnus-nocem-hashtb)
-	  (setq entry (cdr entry))))
-      (setq alist (cdr alist)))))
-
-(gnus-add-shutdown 'gnus-nocem-close 'gnus)
-
-(defun gnus-nocem-close ()
-  "Clear internal NoCeM variables."
-  (setq gnus-nocem-alist nil
-	gnus-nocem-hashtb nil
-	gnus-nocem-active nil
-	gnus-nocem-touched-alist nil))
-
-(defun gnus-nocem-unwanted-article-p (id)
-  "Say whether article ID in the current group is wanted."
-  (gnus-gethash id gnus-nocem-hashtb))
-
-(provide 'gnus-nocem)
-
-;;; gnus-nocem.el ends here
diff --git a/lisp/gnus-salt.el b/lisp/gnus-salt.el
deleted file mode 100644
index b5e38677212..00000000000
--- a/lisp/gnus-salt.el
+++ /dev/null
@@ -1,654 +0,0 @@
-;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-
-;; 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:
-
-(require 'gnus)
-(eval-when-compile (require 'cl))
-
-;;;
-;;; gnus-pick-mode
-;;;
-
-(defvar gnus-pick-mode nil
-  "Minor mode for providing a pick-and-read interface in Gnus summary buffers.")
-
-(defvar gnus-pick-display-summary nil
-  "*Display summary while reading.")
-
-(defvar gnus-pick-mode-hook nil
-  "Hook run in summary pick mode buffers.")
-
-;;; Internal variables.
-
-(defvar gnus-pick-mode-map nil)
-
-(unless gnus-pick-mode-map
-  (setq gnus-pick-mode-map (make-sparse-keymap))
-
-  (gnus-define-keys
-   gnus-pick-mode-map
-   "t" gnus-uu-mark-thread
-   "T" gnus-uu-unmark-thread
-   " " gnus-summary-mark-as-processable
-   "u" gnus-summary-unmark-as-processable
-   "U" gnus-summary-unmark-all-processable
-   "v" gnus-uu-mark-over
-   "r" gnus-uu-mark-region
-   "R" gnus-uu-unmark-region
-   "e" gnus-uu-mark-by-regexp
-   "E" gnus-uu-mark-by-regexp
-   "b" gnus-uu-mark-buffer
-   "B" gnus-uu-unmark-buffer
-   "\r" gnus-pick-start-reading))
-
-(defun gnus-pick-make-menu-bar ()
-  (unless (boundp 'gnus-pick-menu)
-    (easy-menu-define
-     gnus-pick-menu gnus-pick-mode-map ""
-     '("Pick"
-       ("Pick"
-	["Article" gnus-summary-mark-as-processable t]
-	["Thread" gnus-uu-mark-thread t]
-	["Region" gnus-uu-mark-region t]
-	["Regexp" gnus-uu-mark-regexp t]
-	["Buffer" gnus-uu-mark-buffer t])
-       ("Unpick"
-	["Article" gnus-summary-unmark-as-processable t]
-	["Thread" gnus-uu-unmark-thread t]
-	["Region" gnus-uu-unmark-region t]
-	["Regexp" gnus-uu-unmark-regexp t]
-	["Buffer" gnus-uu-unmark-buffer t])
-       ["Start reading" gnus-pick-start-reading t]
-       ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
-
-(defun gnus-pick-mode (&optional arg)
-  "Minor mode for providing a pick-and-read interface in Gnus summary buffers.
-
-\\{gnus-pick-mode-map}"
-  (interactive "P")
-  (when (eq major-mode 'gnus-summary-mode)
-    (make-local-variable 'gnus-pick-mode)
-    (setq gnus-pick-mode 
-	  (if (null arg) (not gnus-pick-mode)
-	    (> (prefix-numeric-value arg) 0)))
-    (when gnus-pick-mode
-      ;; Make sure that we don't select any articles upon group entry.
-      (make-local-variable 'gnus-auto-select-first)
-      (setq gnus-auto-select-first nil)
-      ;; Set up the menu.
-      (when (and menu-bar-mode
-		 (gnus-visual-p 'pick-menu 'menu))
-	(gnus-pick-make-menu-bar))
-      (unless (assq 'gnus-pick-mode minor-mode-alist)
-	(push '(gnus-pick-mode " Pick") minor-mode-alist))
-      (unless (assq 'gnus-pick-mode minor-mode-map-alist)
-	(push (cons 'gnus-pick-mode gnus-pick-mode-map)
-	      minor-mode-map-alist))
-      (run-hooks 'gnus-pick-mode-hook))))
-
-(defun gnus-pick-start-reading (&optional catch-up)
-  "Start reading the picked articles.
-If given a prefix, mark all unpicked articles as read."
-  (interactive "P")
-  (unless gnus-newsgroup-processable
-    (error "No articles have been picked"))
-  (gnus-summary-limit-to-articles nil)
-  (when catch-up
-    (gnus-summary-limit-mark-excluded-as-read))
-  (gnus-summary-first-unread-article)
-  (gnus-configure-windows (if gnus-pick-display-summary 'article 'pick) t))
-
-
-;;;
-;;; gnus-binary-mode
-;;;
-
-(defvar gnus-binary-mode nil
-  "Minor mode for provind a binary group interface in Gnus summary buffers.")
-
-(defvar gnus-binary-mode-hook nil
-  "Hook run in summary binary mode buffers.")
-
-(defvar gnus-binary-mode-map nil)
-
-(unless gnus-binary-mode-map
-  (setq gnus-binary-mode-map (make-sparse-keymap))
-
-  (gnus-define-keys
-   gnus-binary-mode-map
-   "g" gnus-binary-show-article))
-
-(defun gnus-binary-make-menu-bar ()
-  (unless (boundp 'gnus-binary-menu)
-    (easy-menu-define
-     gnus-binary-menu gnus-binary-mode-map ""
-     '("Pick"
-       ["Switch binary mode off" gnus-binary-mode t]))))
-
-(defun gnus-binary-mode (&optional arg)
-  "Minor mode for providing a binary group interface in Gnus summary buffers."
-  (interactive "P")
-  (when (eq major-mode 'gnus-summary-mode)
-    (make-local-variable 'gnus-binary-mode)
-    (setq gnus-binary-mode 
-	  (if (null arg) (not gnus-binary-mode)
-	    (> (prefix-numeric-value arg) 0)))
-    (when gnus-binary-mode
-      ;; Make sure that we don't select any articles upon group entry.
-      (make-local-variable 'gnus-auto-select-first)
-      (setq gnus-auto-select-first nil)
-      (make-local-variable 'gnus-summary-display-article-function)
-      (setq gnus-summary-display-article-function 'gnus-binary-display-article)
-      ;; Set up the menu.
-      (when (and menu-bar-mode
-		 (gnus-visual-p 'binary-menu 'menu))
-	(gnus-binary-make-menu-bar))
-      (unless (assq 'gnus-binary-mode minor-mode-alist)
-	(push '(gnus-binary-mode " Binary") minor-mode-alist))
-      (unless (assq 'gnus-binary-mode minor-mode-map-alist)
-	(push (cons 'gnus-binary-mode gnus-binary-mode-map)
-	      minor-mode-map-alist))
-      (run-hooks 'gnus-binary-mode-hook))))
-
-(defun gnus-binary-display-article (article &optional all-header)
-  "Run ARTICLE through the binary decode functions."
-  (when (gnus-summary-goto-subject article)
-    (let ((gnus-view-pseudos 'automatic))
-      (gnus-uu-decode-uu))))
-
-(defun gnus-binary-show-article (&optional arg)
-  "Bypass the binary functions and show the article."
-  (interactive "P")
-  (let (gnus-summary-display-article-function)
-    (gnus-summary-show-article arg)))
-
-;;;
-;;; gnus-tree-mode
-;;;
-
-(defvar gnus-tree-line-format "%(%[%3,3n%]%)"
-  "Format of tree elements.")
-
-(defvar gnus-tree-minimize-window t
-  "If non-nil, minimize the tree buffer window.
-If a number, never let the tree buffer grow taller than that number of
-lines.")
-
-(defvar gnus-selected-tree-face 'modeline
-  "*Face used for highlighting selected articles in the thread tree.")
-
-(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\))
-			     (?\{ . ?\}) (?< . ?>))
-  "Brackets used in tree nodes.")
-
-(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
-  "Charaters used to connect parents with children.")
-
-(defvar gnus-tree-mode-line-format "Gnus: %%b %S %Z"
-  "*The format specification for the tree mode line.")
-
-(defvar gnus-generate-tree-function 'gnus-generate-vertical-tree
-  "*Function for generating a thread tree.
-Two predefined functions are available:
-`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'.")
-
-(defvar gnus-tree-mode-hook nil
-  "*Hook run in tree mode buffers.")
-
-;;; Internal variables.
-
-(defvar gnus-tree-line-format-alist 
-  `((?n gnus-tmp-name ?s)
-    (?f gnus-tmp-from ?s)
-    (?N gnus-tmp-number ?d)
-    (?\[ gnus-tmp-open-bracket ?c)
-    (?\] gnus-tmp-close-bracket ?c)
-    (?s gnus-tmp-subject ?s)))
-
-(defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist)
-
-(defvar gnus-tree-mode-line-format-spec nil)
-(defvar gnus-tree-line-format-spec nil)
-
-(defvar gnus-tree-node-length nil)
-(defvar gnus-selected-tree-overlay nil)
-
-(defvar gnus-tree-displayed-thread nil)
-
-(defvar gnus-tree-mode-map nil)
-(put 'gnus-tree-mode 'mode-class 'special)
-
-(unless gnus-tree-mode-map
-  (setq gnus-tree-mode-map (make-keymap))
-  (suppress-keymap gnus-tree-mode-map)
-  (gnus-define-keys
-   gnus-tree-mode-map
-   "\r" gnus-tree-select-article
-   gnus-mouse-2 gnus-tree-pick-article
-   "\C-?" gnus-tree-read-summary-keys
-
-   "\C-c\C-i" gnus-info-find-node)
-
-  (substitute-key-definition
-   'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
-
-(defun gnus-tree-make-menu-bar ()
-  (unless (boundp 'gnus-tree-menu)
-    (easy-menu-define
-     gnus-tree-menu gnus-tree-mode-map ""
-     '("Tree"
-       ["Select article" gnus-tree-select-article t]))))
-
-(defun gnus-tree-mode ()
-  "Major mode for displaying thread trees."
-  (interactive)
-  (setq gnus-tree-mode-line-format-spec 
-	(gnus-parse-format gnus-tree-mode-line-format 
-			   gnus-summary-mode-line-format-alist))
-  (setq gnus-tree-line-format-spec 
-	(gnus-parse-format gnus-tree-line-format 
-			   gnus-tree-line-format-alist t))
-  (when (and menu-bar-mode
-	     (gnus-visual-p 'tree-menu 'menu))
-    (gnus-tree-make-menu-bar))
-  (kill-all-local-variables)
-  (gnus-simplify-mode-line)
-  (setq mode-name "Tree")
-  (setq major-mode 'gnus-tree-mode)
-  (use-local-map gnus-tree-mode-map)
-  (buffer-disable-undo (current-buffer))
-  (setq buffer-read-only t)
-  (setq truncate-lines t)
-  (save-excursion
-    (gnus-set-work-buffer)
-    (gnus-tree-node-insert (make-mail-header "") nil)
-    (setq gnus-tree-node-length (1- (point))))
-  (run-hooks 'gnus-tree-mode-hook))
-
-(defun gnus-tree-read-summary-keys (&optional arg)
-  "Read a summary buffer key sequence and execute it."
-  (interactive "P")
-  (let ((buf (current-buffer))
-	win)
-    (gnus-article-read-summary-keys arg nil t)
-    (when (setq win (get-buffer-window buf))
-      (select-window win)
-      (when gnus-selected-tree-overlay
-	(goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
-      (gnus-tree-minimize))))
-
-(defun gnus-tree-select-article (article)
-  "Select the article under point, if any."
-  (interactive (list (gnus-tree-article-number)))
-  (let ((buf (current-buffer)))
-    (when article
-      (save-excursion
-	(set-buffer gnus-summary-buffer)
-	(gnus-summary-goto-article article))
-      (select-window (get-buffer-window buf)))))
-
-(defun gnus-tree-pick-article (e)
-  "Select the article under the mouse pointer."
-  (interactive "e")
-  (mouse-set-point e)
-  (gnus-tree-select-article (gnus-tree-article-number)))
-
-(defun gnus-tree-article-number ()
-  (get-text-property (point) 'gnus-number))
-
-(defun gnus-tree-article-region (article)
-  "Return a cons with BEG and END of the article region."
-  (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article)))
-    (when pos
-      (cons pos (next-single-property-change pos 'gnus-number)))))
-
-(defun gnus-tree-goto-article (article)
-  (let ((pos (text-property-any (point-min) (point-max) 'gnus-number article)))
-    (when pos
-      (goto-char pos))))
-
-(defun gnus-tree-recenter ()
-  "Center point in the tree window."
-  (let ((selected (selected-window))
-	(tree-window (get-buffer-window gnus-tree-buffer t)))
-    (when tree-window
-      (select-window tree-window)
-      (when gnus-selected-tree-overlay
-	(goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
-      (let* ((top (cond ((< (window-height) 4) 0)
-			((< (window-height) 7) 1)
-			(t 2))) 
-	     (height (1- (window-height)))
-	     (bottom (save-excursion (goto-char (point-max))
-				     (forward-line (- height))
-				     (point))))
-	;; Set the window start to either `bottom', which is the biggest
-	;; possible valid number, or the second line from the top,
-	;; whichever is the least.
-	(set-window-start
-	 tree-window (min bottom (save-excursion 
-				   (forward-line (- top)) (point)))))
-      (select-window selected))))
-
-(defun gnus-get-tree-buffer ()
-  "Return the tree buffer properly initialized."
-  (save-excursion
-    (set-buffer (get-buffer-create gnus-tree-buffer))
-    (unless (eq major-mode 'gnus-tree-mode)
-      (gnus-add-current-to-buffer-list)
-      (gnus-tree-mode))
-    (current-buffer)))
-
-(defun gnus-tree-minimize ()
-  (when (and gnus-tree-minimize-window
-	     (not (one-window-p)))
-    (let ((windows 0)
-	  tot-win-height)
-      (walk-windows (lambda (window) (incf windows)))
-      (setq tot-win-height 
-	    (- (frame-height) 
-	       (* window-min-height (1- windows))
-	       2))
-      (let* ((window-min-height 2)
-	     (height (count-lines (point-min) (point-max)))
-	     (min (max (1- window-min-height) height))
-	     (tot (if (numberp gnus-tree-minimize-window)
-		      (min gnus-tree-minimize-window min)
-		    min))
-	     (win (get-buffer-window (current-buffer)))
-	     (wh (and win (1- (window-height win)))))
-	(setq tot (min tot tot-win-height))
-	(when (and win
-		   (not (eq tot wh)))
-	  (let ((selected (selected-window)))
-	    (select-window win)
-	    (enlarge-window (- tot wh))
-	    (select-window selected)))))))
-
-;;; Generating the tree.
-
-(defun gnus-tree-node-insert (header sparse &optional adopted)
-  (let* ((dummy (stringp header))
-	 (header (if (vectorp header) header
-		   (progn
-		     (setq header (make-mail-header "*****"))
-		     (mail-header-set-number header 0)
-		     (mail-header-set-lines header 0)
-		     (mail-header-set-chars header 0)
-		     header)))
-	 (gnus-tmp-from (mail-header-from header))
-	 (gnus-tmp-subject (mail-header-subject header))
-	 (gnus-tmp-number (mail-header-number header))
-	 (gnus-tmp-name
-	  (cond
-	   ((string-match "(.+)" gnus-tmp-from)
-	    (substring gnus-tmp-from
-		       (1+ (match-beginning 0)) (1- (match-end 0))))
-	   ((string-match "<[^>]+> *$" gnus-tmp-from)
-	    (let ((beg (match-beginning 0)))
-	      (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
-		       (substring gnus-tmp-from (1+ (match-beginning 0))
-				  (1- (match-end 0))))
-		  (substring gnus-tmp-from 0 beg))))
-	   ((memq gnus-tmp-number sparse)
-	    "***")
-	   (t gnus-tmp-from)))
-	 (gnus-tmp-open-bracket
-	  (cond ((memq gnus-tmp-number sparse) 
-		 (caadr gnus-tree-brackets))
-		(dummy (caaddr gnus-tree-brackets))
-		(adopted (car (nth 3 gnus-tree-brackets)))
-		(t (caar gnus-tree-brackets))))
-	 (gnus-tmp-close-bracket
-	  (cond ((memq gnus-tmp-number sparse)
-		 (cdadr gnus-tree-brackets))
-		(adopted (cdr (nth 3 gnus-tree-brackets)))
-		(dummy
-		 (cdaddr gnus-tree-brackets))
-		(t (cdar gnus-tree-brackets))))
-	 (buffer-read-only nil)
-	 beg end)
-    (gnus-add-text-properties
-     (setq beg (point))
-     (setq end (progn (eval gnus-tree-line-format-spec) (point)))
-     (list 'gnus-number gnus-tmp-number))
-    (when (or t (gnus-visual-p 'tree-highlight 'highlight))
-      (gnus-tree-highlight-node gnus-tmp-number beg end))))
-
-(defun gnus-tree-highlight-node (article beg end)
-  "Highlight current line according to `gnus-summary-highlight'."
-  (let ((list gnus-summary-highlight)
-	face)
-    (save-excursion
-      (set-buffer gnus-summary-buffer)
-      (let* ((score (or (cdr (assq article gnus-newsgroup-scored))
-			gnus-summary-default-score 0))
-	     (default gnus-summary-default-score)
-	     (mark (or (gnus-summary-article-mark article) gnus-unread-mark)))
-	;; Eval the cars of the lists until we find a match.
-	(while (and list
-		    (not (eval (caar list))))
-	  (setq list (cdr list)))))
-    (unless (eq (setq face (cdar list)) (get-text-property beg 'face))
-      (gnus-put-text-property 
-       beg end 'face 
-       (if (boundp face) (symbol-value face) face)))))
-
-(defun gnus-tree-indent (level)
-  (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? )))
-
-(defvar gnus-tmp-limit)
-(defvar gnus-tmp-sparse)
-(defvar gnus-tmp-indent)
-
-(defun gnus-generate-tree (thread)
-  "Generate a thread tree for THREAD."
-  (save-excursion
-    (set-buffer (gnus-get-tree-buffer))
-    (let ((buffer-read-only nil)
-	  (gnus-tmp-indent 0))
-      (erase-buffer)
-      (funcall gnus-generate-tree-function thread 0)
-      (gnus-set-mode-line 'tree)
-      (goto-char (point-min))
-      (gnus-tree-minimize)
-      (gnus-tree-recenter)
-      (let ((selected (selected-window)))
-	(when (get-buffer-window (set-buffer gnus-tree-buffer) t)
-	  (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
-	  (gnus-horizontal-recenter)
-	  (select-window selected))))))
-
-(defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted)
-  "Generate a horizontal tree."
-  (let* ((dummy (stringp (car thread)))
-	 (do (or dummy
-		 (memq (mail-header-number (car thread)) gnus-tmp-limit)))
-	 col beg)
-    (if (not do)
-	;; We don't want this article.
-	(setq thread (cdr thread))
-      (if (not (bolp))
-	  ;; Not the first article on the line, so we insert a "-".
-	  (insert (car gnus-tree-parent-child-edges))
-	;; If the level isn't zero, then we insert some indentation.
-	(unless (zerop level)
-	  (gnus-tree-indent level)
-	  (insert (cadr gnus-tree-parent-child-edges))
-	  (setq col (- (setq beg (point)) (gnus-point-at-bol) 1))
-	  ;; Draw "|" lines upwards.
-	  (while (progn
-		   (forward-line -1)
-		   (forward-char col)
-		   (= (following-char) ? ))
-	    (delete-char 1)
-	    (insert (caddr gnus-tree-parent-child-edges)))
-	  (goto-char beg)))
-      (setq dummyp nil)
-      ;; Insert the article node.
-      (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted))
-    (if (null thread)
-	;; End of the thread, so we go to the next line.
-	(unless (bolp)
-	  (insert "\n"))
-      ;; Recurse downwards in all children of this article.
-      (while thread
-	(gnus-generate-horizontal-tree
-	 (pop thread) (if do (1+ level) level) 
-	 (or dummyp dummy) dummy)))))
-
-(defsubst gnus-tree-indent-vertical ()
-  (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent) 
-		(- (point) (gnus-point-at-bol)))))
-    (when (> len 0)
-      (insert (make-string len ? )))))
-
-(defsubst gnus-tree-forward-line (n)
-  (while (>= (decf n) 0)
-    (unless (zerop (forward-line 1))
-      (end-of-line)
-      (insert "\n")))
-  (end-of-line))
-
-(defun gnus-generate-vertical-tree (thread level &optional dummyp adopted)
-  "Generate a vertical tree."
-  (let* ((dummy (stringp (car thread)))
-	 (do (or dummy
-		 (memq (mail-header-number (car thread)) gnus-tmp-limit)))
-	 beg)
-    (if (not do)
-	;; We don't want this article.
-	(setq thread (cdr thread))
-      (if (not (save-excursion (beginning-of-line) (bobp)))
-	  ;; Not the first article on the line, so we insert a "-".
-	  (progn
-	    (gnus-tree-indent-vertical)
-	    (insert (make-string (/ gnus-tree-node-length 2) ? ))
-	    (insert (caddr gnus-tree-parent-child-edges))
-	    (gnus-tree-forward-line 1))
-	;; If the level isn't zero, then we insert some indentation.
-	(unless (zerop gnus-tmp-indent)
-	  (gnus-tree-forward-line (1- (* 2 level)))
-	  (gnus-tree-indent-vertical)
-	  (delete-char -1)
-	  (insert (cadr gnus-tree-parent-child-edges))
-	  (setq beg (point))
-	  ;; Draw "-" lines leftwards.
-	  (while (progn
-		   (forward-char -2)
-		   (= (following-char) ? ))
-	    (delete-char 1)
-	    (insert (car gnus-tree-parent-child-edges)))
-	  (goto-char beg)
-	  (gnus-tree-forward-line 1)))
-      (setq dummyp nil)
-      ;; Insert the article node.
-      (gnus-tree-indent-vertical)
-      (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)
-      (gnus-tree-forward-line 1))
-    (if (null thread)
-	;; End of the thread, so we go to the next line.
-	(progn
-	  (goto-char (point-min))
-	  (end-of-line)
-	  (incf gnus-tmp-indent))
-      ;; Recurse downwards in all children of this article.
-      (while thread
-	(gnus-generate-vertical-tree
-	 (pop thread) (if do (1+ level) level) 
-	 (or dummyp dummy) dummy)))))
-
-;;; Interface functions.
-
-(defun gnus-possibly-generate-tree (article &optional force)
-  "Generate the thread tree for ARTICLE if it isn't displayed already."
-  (when (save-excursion
-	  (set-buffer gnus-summary-buffer)
-	  (and gnus-use-trees
-	       (vectorp (gnus-summary-article-header article))))
-    (save-excursion
-      (let ((top (save-excursion
-		   (set-buffer gnus-summary-buffer)
-		   (gnus-cut-thread
-		    (gnus-remove-thread 
-		     (mail-header-id 
-		      (gnus-summary-article-header article)) t))))
-	    (gnus-tmp-limit gnus-newsgroup-limit)
-	    (gnus-tmp-sparse gnus-newsgroup-sparse))
-	(when (or force
-		  (not (eq top gnus-tree-displayed-thread)))
-	  (gnus-generate-tree top)
-	  (setq gnus-tree-displayed-thread top))))))
-
-(defun gnus-tree-open (group)
-  (gnus-get-tree-buffer))
-
-(defun gnus-tree-close (group)
-  ;(gnus-kill-buffer gnus-tree-buffer)
-  )
-
-(defun gnus-highlight-selected-tree (article)
-  "Highlight the selected article in the tree."
-  (let ((buf (current-buffer))
-	region)
-    (set-buffer gnus-tree-buffer)
-    (when (setq region (gnus-tree-article-region article))
-      (when (or (not gnus-selected-tree-overlay)
-		(gnus-extent-detached-p gnus-selected-tree-overlay))
-	;; Create a new overlay.
-	(gnus-overlay-put
-	 (setq gnus-selected-tree-overlay (gnus-make-overlay 1 2))
-	 'face gnus-selected-tree-face))
-      ;; Move the overlay to the article.
-      (gnus-move-overlay 
-       gnus-selected-tree-overlay (goto-char (car region)) (cdr region))
-      (gnus-tree-minimize)
-      (gnus-tree-recenter)
-      (let ((selected (selected-window)))
-	(when (get-buffer-window (set-buffer gnus-tree-buffer) t)
-	  (select-window (get-buffer-window (set-buffer gnus-tree-buffer) t))
-	  (gnus-horizontal-recenter)
-	  (select-window selected))))
-    ;; If we remove this save-excursion, it updates the wrong mode lines?!?
-    (save-excursion
-      (set-buffer gnus-tree-buffer)
-      (gnus-set-mode-line 'tree))
-    (set-buffer buf)))
-
-(defun gnus-tree-highlight-article (article face)
-  (save-excursion
-    (set-buffer (gnus-get-tree-buffer))
-    (let (region)
-      (when (setq region (gnus-tree-article-region article))
-	(gnus-put-text-property (car region) (cdr region) 'face face)
-	(set-window-point 
-	 (get-buffer-window (current-buffer) t) (cdr region))))))
-
-;;; Allow redefinition of functions.
-(gnus-ems-redefine)
-
-(provide 'gnus-salt)
-
-;;; gnus-salt.el ends here
diff --git a/lisp/gnus-scomo.el b/lisp/gnus-scomo.el
deleted file mode 100644
index 668941c05e2..00000000000
--- a/lisp/gnus-scomo.el
+++ /dev/null
@@ -1,110 +0,0 @@
-;;; gnus-scomo.el --- mode for editing Gnus score files
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news, mail
-
-;; 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:
-
-(require 'easymenu)
-(require 'timezone)
-(eval-when-compile (require 'cl))
-
-(defvar gnus-score-mode-hook nil
-  "*Hook run in score mode buffers.")
-
-(defvar gnus-score-menu-hook nil
-  "*Hook run after creating the score mode menu.")
-
-(defvar gnus-score-edit-exit-function nil
-  "Function run on exit from the score buffer.")
-
-(defvar gnus-score-mode-map nil)
-(unless gnus-score-mode-map
-  (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map))
-  (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit)
-  (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date)
-  (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print))
-
-;;;###autoload
-(defun gnus-score-mode ()
-  "Mode for editing Gnus score files.
-This mode is an extended emacs-lisp mode.
-
-\\{gnus-score-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map gnus-score-mode-map)
-  (when menu-bar-mode
-    (gnus-score-make-menu-bar))
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (setq major-mode 'gnus-score-mode)
-  (setq mode-name "Score")
-  (lisp-mode-variables nil)
-  (make-local-variable 'gnus-score-edit-exit-function)
-  (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook))
-
-(defun gnus-score-make-menu-bar ()
-  (unless (boundp 'gnus-score-menu)
-    (easy-menu-define
-     gnus-score-menu gnus-score-mode-map ""
-     '("Score"
-       ["Exit" gnus-score-edit-exit t]
-       ["Insert date" gnus-score-edit-insert-date t]
-       ["Format" gnus-score-pretty-print t]))
-    (run-hooks 'gnus-score-menu-hook)))
-
-(defun gnus-score-edit-insert-date ()
-  "Insert date in numerical format."
-  (interactive)
-  (princ (gnus-score-day-number (current-time)) (current-buffer)))
-
-(defun gnus-score-pretty-print ()
-  "Format the current score file."
-  (interactive)
-  (goto-char (point-min))
-  (let ((form (read (current-buffer))))
-    (erase-buffer)
-    (pp form (current-buffer)))
-  (goto-char (point-min)))
-
-(defun gnus-score-edit-exit ()
-  "Stop editing the score file."
-  (interactive)
-  (unless (file-exists-p (file-name-directory (buffer-file-name)))
-    (make-directory (file-name-directory (buffer-file-name)) t))
-  (save-buffer)
-  (bury-buffer (current-buffer))
-  (let ((buf (current-buffer)))
-    (when gnus-score-edit-exit-function
-      (funcall gnus-score-edit-exit-function))
-    (when (eq buf (current-buffer))
-      (switch-to-buffer (other-buffer (current-buffer))))))
-
-(defun gnus-score-day-number (time)
-  (let ((dat (decode-time time)))
-    (timezone-absolute-from-gregorian
-     (nth 4 dat) (nth 3 dat) (nth 5 dat))))
-
-(provide 'gnus-scomo)
-
-;;; gnus-scomo.el ends here
diff --git a/lisp/gnus-score.el b/lisp/gnus-score.el
deleted file mode 100644
index 523fa13587f..00000000000
--- a/lisp/gnus-score.el
+++ /dev/null
@@ -1,2258 +0,0 @@
-;;; gnus-score.el --- scoring code for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
-;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'gnus)
-(eval-when-compile (require 'cl))
-
-(defvar gnus-global-score-files nil
-  "*List of global score files and directories.
-Set this variable if you want to use people's score files.  One entry
-for each score file or each score file directory.  Gnus will decide
-by itself what score files are applicable to which group.
-
-Say you want to use the single score file
-\"/ftp.ifi.uio.no@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
-score files in the \"/ftp.some-where:/pub/score\" directory.
-
- (setq gnus-global-score-files
-       '(\"/ftp.ifi.uio.no:/pub/larsi/ding/score/soc.motss.SCORE\"
-         \"/ftp.some-where:/pub/score\"))")
-
-(defvar gnus-score-file-single-match-alist nil
-  "*Alist mapping regexps to lists of score files.
-Each element of this alist should be of the form
-	(\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
-
-If the name of a group is matched by REGEXP, the corresponding scorefiles
-will be used for that group.
-The first match found is used, subsequent matching entries are ignored (to
-use multiple matches, see gnus-score-file-multiple-match-alist).
-
-These score files are loaded in addition to any files returned by
-gnus-score-find-score-files-function (which see).")
-
-(defvar gnus-score-file-multiple-match-alist nil
-  "*Alist mapping regexps to lists of score files.
-Each element of this alist should be of the form
-	(\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
-
-If the name of a group is matched by REGEXP, the corresponding scorefiles
-will be used for that group.
-If multiple REGEXPs match a group, the score files corresponding to each
-match will be used (for only one match to be used, see
-gnus-score-file-single-match-alist).
-
-These score files are loaded in addition to any files returned by
-gnus-score-find-score-files-function (which see).")
-
-(defvar gnus-score-file-suffix "SCORE"
-  "*Suffix of the score files.")
-
-(defvar gnus-adaptive-file-suffix "ADAPT"
-  "*Suffix of the adaptive score files.")
-
-(defvar gnus-score-find-score-files-function 'gnus-score-find-bnews
-  "*Function used to find score files.
-The function will be called with the group name as the argument, and
-should return a list of score files to apply to that group.  The score
-files do not actually have to exist.
-
-Predefined values are:
-
-gnus-score-find-single: Only apply the group's own score file.
-gnus-score-find-hierarchical: Also apply score files from parent groups.
-gnus-score-find-bnews: Apply score files whose names matches.
-
-See the documentation to these functions for more information.
-
-This variable can also be a list of functions to be called.  Each
-function should either return a list of score files, or a list of
-score alists.")
-
-(defvar gnus-score-interactive-default-score 1000
-  "*Scoring commands will raise/lower the score with this number as the default.")
-
-(defvar gnus-score-expiry-days 7
-  "*Number of days before unused score file entries are expired.
-If this variable is nil, no score file entries will be expired.")
-
-(defvar gnus-update-score-entry-dates t
-  "*In non-nil, update matching score entry dates.
-If this variable is nil, then score entries that provide matches
-will be expired along with non-matching score entries.")
-
-(defvar gnus-orphan-score nil
-  "*All orphans get this score added. Set in the score file.")
-
-(defvar gnus-default-adaptive-score-alist  
-  '((gnus-kill-file-mark)
-    (gnus-unread-mark)
-    (gnus-read-mark (from  3) (subject  30))
-    (gnus-catchup-mark (subject -10))
-    (gnus-killed-mark (from -1) (subject -20))
-    (gnus-del-mark (from -2) (subject -15)))
-"*Alist of marks and scores.")
-
-(defvar gnus-score-mimic-keymap nil
-  "*Have the score entry functions pretend that they are a keymap.")
-
-(defvar gnus-score-exact-adapt-limit 10
-  "*Number that says how long a match has to be before using substring matching.
-When doing adaptive scoring, one normally uses fuzzy or substring
-matching.  However, if the header one matches is short, the possibility
-for false positives is great, so if the length of the match is less
-than this variable, exact matching will be used.
-
-If this variable is nil, exact matching will always be used.")
-
-(defvar gnus-score-uncacheable-files "ADAPT$"
-  "*All score files that match this regexp will not be cached.")
-
-(defvar gnus-score-default-header nil
-  "Default header when entering new scores.
-
-Should be one of the following symbols.
-
- a: from
- s: subject
- b: body
- h: head
- i: message-id
- t: references
- x: xref
- l: lines
- d: date
- f: followup
-
-If nil, the user will be asked for a header.")
-
-(defvar gnus-score-default-type nil
-  "Default match type when entering new scores.
-
-Should be one of the following symbols.
-
- s: substring
- e: exact string
- f: fuzzy string
- r: regexp string
- b: before date
- a: at date
- n: this date
- <: less than number
- >: greater than number
- =: equal to number
-
-If nil, the user will be asked for a match type.")
-
-(defvar gnus-score-default-fold nil
-  "Use case folding for new score file entries iff not nil.")
-
-(defvar gnus-score-default-duration nil
-  "Default duration of effect when entering new scores.
-
-Should be one of the following symbols.
-
- t: temporary
- p: permanent
- i: immediate
-
-If nil, the user will be asked for a duration.")
-
-(defvar gnus-score-after-write-file-function nil
-  "*Function called with the name of the score file just written to disk.")
-
-
-
-;; Internal variables.
-
-(defvar gnus-internal-global-score-files nil)
-(defvar gnus-score-file-list nil)
-
-(defvar gnus-short-name-score-file-cache nil)
-
-(defvar gnus-score-help-winconf nil)
-(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
-(defvar gnus-score-trace nil)
-(defvar gnus-score-edit-buffer nil)
-
-(defvar gnus-score-alist nil
-  "Alist containing score information.
-The keys can be symbols or strings.  The following symbols are defined. 
-
-touched: If this alist has been modified.
-mark:    Automatically mark articles below this.
-expunge: Automatically expunge articles below this.
-files:   List of other score files to load when loading this one.
-eval:    Sexp to be evaluated when the score file is loaded.
-
-String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...) 
-where HEADER is the header being scored, MATCH is the string we are
-looking for, TYPE is a flag indicating whether it should use regexp or
-substring matching, SCORE is the score to add and DATE is the date
-of the last successful match.")
-
-(defvar gnus-score-cache nil)
-(defvar gnus-scores-articles nil)
-(defvar gnus-score-index nil)
-
-
-(defconst gnus-header-index
-  ;; Name to index alist.
-  '(("number" 0 gnus-score-integer)
-    ("subject" 1 gnus-score-string)
-    ("from" 2 gnus-score-string)
-    ("date" 3 gnus-score-date)
-    ("message-id" 4 gnus-score-string) 
-    ("references" 5 gnus-score-string) 
-    ("chars" 6 gnus-score-integer) 
-    ("lines" 7 gnus-score-integer) 
-    ("xref" 8 gnus-score-string)
-    ("head" -1 gnus-score-body)
-    ("body" -1 gnus-score-body)
-    ("all" -1 gnus-score-body)
-    ("followup" 2 gnus-score-followup)
-    ("thread" 5 gnus-score-thread)))
-
-(eval-and-compile
-  (autoload 'gnus-uu-ctl-map "gnus-uu" nil nil 'keymap))
-
-;;; Summary mode score maps.
-
-(gnus-define-keys
- (gnus-summary-score-map "V" gnus-summary-mode-map)
- "s" gnus-summary-set-score
- "a" gnus-summary-score-entry
- "S" gnus-summary-current-score
- "c" gnus-score-change-score-file
- "m" gnus-score-set-mark-below
- "x" gnus-score-set-expunge-below
- "R" gnus-summary-rescore
- "e" gnus-score-edit-current-scores
- "f" gnus-score-edit-file
- "F" gnus-score-flush-cache
- "t" gnus-score-find-trace
- "C" gnus-score-customize)
-
-;; Summary score file commands
-
-;; Much modification of the kill (ahem, score) code and lots of the
-;; functions are written by Per Abrahamsen <amanda@iesd.auc.dk>.
-
-(defun gnus-summary-lower-score (&optional score)
-  "Make a score entry based on the current article.
-The user will be prompted for header to score on, match type,
-permanence, and the string to be used.  The numerical prefix will be
-used as score."
-  (interactive "P")
-  (gnus-summary-increase-score (- (gnus-score-default score))))
-
-(defvar gnus-score-default-header nil
-  "*The default header to score on when entering a score rule interactively.")
-
-(defvar gnus-score-default-type nil
-  "*The default score type to use when entering a score rule interactively.")
-
-(defvar gnus-score-default-duration nil
-  "*The default score duration to use on when entering a score rule interactively.")
-
-(defun gnus-score-kill-help-buffer ()
-  (when (get-buffer "*Score Help*")
-    (kill-buffer "*Score Help*")
-    (and gnus-score-help-winconf
-	 (set-window-configuration gnus-score-help-winconf))))
-
-(defun gnus-summary-increase-score (&optional score)
-  "Make a score entry based on the current article.
-The user will be prompted for header to score on, match type,
-permanence, and the string to be used.  The numerical prefix will be
-used as score."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let* ((nscore (gnus-score-default score))
-	 (prefix (if (< nscore 0) ?L ?I))
-	 (increase (> nscore 0))
-	 (char-to-header 
-	  '((?a "from" nil nil string)
-	    (?s "subject" nil nil string)
-	    (?b "body" "" nil body-string)
-	    (?h "head" "" nil body-string)
-	    (?i "message-id" nil t string)
-	    (?t "references" "message-id" nil string)
-	    (?x "xref" nil nil string)
-	    (?l "lines" nil nil number)
-	    (?d "date" nil nil date)
-	    (?f "followup" nil nil string)
-	    (?T "thread" nil nil string)))
-	 (char-to-type
-	  '((?s s "substring" string)
-	    (?e e "exact string" string)
-	    (?f f "fuzzy string" string)
-	    (?r r "regexp string" string)
-	    (?z s "substring" body-string)
-	    (?p s "regexp string" body-string)
-	    (?b before "before date" date)
-	    (?a at "at date" date) 
-	    (?n now "this date" date)
-	    (?< < "less than number" number)
-	    (?> > "greater than number" number) 
-	    (?= = "equal to number" number)))
-	 (char-to-perm
-	  (list (list ?t (current-time-string) "temporary") 
-		'(?p perm "permanent") '(?i now "immediate")))
-	 (mimic gnus-score-mimic-keymap)
-	 (hchar (and gnus-score-default-header 
-		     (aref (symbol-name gnus-score-default-header) 0)))
-	 (tchar (and gnus-score-default-type
-		     (aref (symbol-name gnus-score-default-type) 0)))
-	 (pchar (and gnus-score-default-duration
-		     (aref (symbol-name gnus-score-default-duration) 0)))
-	 entry temporary type match)
-    
-    (unwind-protect
-	(progn
-
-	  ;; First we read the header to score.
-	  (while (not hchar)
-	    (if mimic
-		(progn 
-		  (sit-for 1)
-		  (message "%c-" prefix))
-	      (message "%s header (%s?): " (if increase "Increase" "Lower")
-		       (mapconcat (lambda (s) (char-to-string (car s)))
-				  char-to-header "")))
-	    (setq hchar (read-char))
-	    (when (or (= hchar ??) (= hchar ?\C-h))
-	      (setq hchar nil)
-	      (gnus-score-insert-help "Match on header" char-to-header 1)))
-
-	  (gnus-score-kill-help-buffer)
-	  (unless (setq entry (assq (downcase hchar) char-to-header))
-	    (if mimic (error "%c %c" prefix hchar) (error "")))
-
-	  (when (/= (downcase hchar) hchar)
-	    ;; This was a majuscle, so we end reading and set the defaults.
-	    (if mimic (message "%c %c" prefix hchar) (message ""))
-	    (setq tchar (or tchar ?s)
-		  pchar (or pchar ?t)))
-    
-	  ;; We continue reading - the type.
-	  (while (not tchar)
-	    (if mimic
-		(progn
-		  (sit-for 1) (message "%c %c-" prefix hchar))
-	      (message "%s header '%s' with match type (%s?): "
-		       (if increase "Increase" "Lower")
-		       (nth 1 entry)
-		       (mapconcat (lambda (s) 
-				    (if (eq (nth 4 entry) 
-					    (nth 3 s))
-					(char-to-string (car s))
-				      ""))
-				  char-to-type "")))
-	    (setq tchar (read-char))
-	    (when (or (= tchar ??) (= tchar ?\C-h))
-	      (setq tchar nil)
-	      (gnus-score-insert-help
-	       "Match type"
-	       (delq nil
-		     (mapcar (lambda (s) 
-			       (if (eq (nth 4 entry) 
-				       (nth 3 s))
-				   s nil))
-			     char-to-type ))
-	       2)))
-
-	  (gnus-score-kill-help-buffer)
-	  (unless (setq type (nth 1 (assq (downcase tchar) char-to-type)))
-	    (if mimic (error "%c %c" prefix hchar) (error "")))
-
-	  (when (/= (downcase tchar) tchar)
-	    ;; It was a majuscle, so we end reading and the the default.
-	    (if mimic (message "%c %c %c" prefix hchar tchar)
-	      (message ""))
-	    (setq pchar (or pchar ?p)))
-
-	  ;; We continue reading.
-	  (while (not pchar)
-	    (if mimic
-		(progn
-		  (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
-	      (message "%s permanence (%s?): " (if increase "Increase" "Lower")
-		       (mapconcat (lambda (s) (char-to-string (car s)))
-				  char-to-perm "")))
-	    (setq pchar (read-char))
-	    (when (or (= pchar ??) (= pchar ?\C-h))
-	      (setq pchar nil)
-	      (gnus-score-insert-help "Match permanence" char-to-perm 2)))
-
-	  (gnus-score-kill-help-buffer)
-	  (if mimic (message "%c %c %c" prefix hchar tchar pchar)
-	    (message ""))
-	  (unless (setq temporary (cadr (assq pchar char-to-perm)))
-	    (if mimic 
-		(error "%c %c %c %c" prefix hchar tchar pchar)
-	      (error ""))))
-      ;; Always kill the score help buffer.
-      (gnus-score-kill-help-buffer))
-
-    ;; We have all the data, so we enter this score.
-    (setq match (if (string= (nth 2 entry) "") ""
-		  (gnus-summary-header (or (nth 2 entry) (nth 1 entry)))))
-      
-    ;; Modify the match, perhaps.
-    (cond 
-     ((equal (nth 1 entry) "xref")
-      (when (string-match "^Xref: *" match)
-	(setq match (substring match (match-end 0))))
-      (when (string-match "^[^:]* +" match)
-	(setq match (substring match (match-end 0))))))
-    
-    (when (memq type '(r R regexp Regexp))
-      (setq match (regexp-quote match)))
-
-    (gnus-summary-score-entry
-     (nth 1 entry)			; Header
-     match				; Match
-     type				; Type
-     (if (eq 's score) nil score)	; Score
-     (if (eq 'perm temporary)		; Temp
-	 nil
-        temporary)
-     (not (nth 3 entry)))		; Prompt
-    ))
-  
-(defun gnus-score-insert-help (string alist idx)
-  (setq gnus-score-help-winconf (current-window-configuration))
-  (save-excursion
-    (set-buffer (get-buffer-create "*Score Help*"))
-    (buffer-disable-undo (current-buffer))
-    (delete-windows-on (current-buffer))
-    (erase-buffer)
-    (insert string ":\n\n")
-    (let ((max -1)
-	  (list alist)
-	  (i 0)
-	  n width pad format)
-      ;; find the longest string to display
-      (while list
-	(setq n (length (nth idx (car list))))
-	(or (> max n)
-	    (setq max n))
-	(setq list (cdr list)))
-      (setq max (+ max 4))		; %c, `:', SPACE, a SPACE at end
-      (setq n (/ (1- (window-width)) max))	; items per line
-      (setq width (/ (1- (window-width)) n)) ; width of each item
-      ;; insert `n' items, each in a field of width `width' 
-      (while alist
-	(if (< i n)
-	    ()
-	  (setq i 0)
-	  (delete-char -1)		; the `\n' takes a char
-	  (insert "\n"))
-	(setq pad (- width 3))
-	(setq format (concat "%c: %-" (int-to-string pad) "s"))
-	(insert (format format (caar alist) (nth idx (car alist))))
-	(setq alist (cdr alist))
-	(setq i (1+ i))))
-    ;; display ourselves in a small window at the bottom
-    (gnus-appt-select-lowest-window)
-    (split-window)
-    (pop-to-buffer "*Score Help*")
-    (let ((window-min-height 1))
-      (shrink-window-if-larger-than-buffer))
-    (select-window (get-buffer-window gnus-summary-buffer))))
-  
-(defun gnus-summary-header (header &optional no-err)
-  ;; Return HEADER for current articles, or error.
-  (let ((article (gnus-summary-article-number))
-	headers)
-    (if article
-	(if (and (setq headers (gnus-summary-article-header article))
-		 (vectorp headers))
-	    (aref headers (nth 1 (assoc header gnus-header-index)))
-	  (if no-err
-	      nil
-	    (error "Pseudo-articles can't be scored")))
-      (if no-err
-	  (error "No article on current line")
-	nil))))
-
-(defun gnus-newsgroup-score-alist ()
-  (or
-   (let ((param-file (gnus-group-get-parameter 
-		      gnus-newsgroup-name 'score-file)))
-     (when param-file
-       (gnus-score-load param-file)))
-   (gnus-score-load
-    (gnus-score-file-name gnus-newsgroup-name)))
-  gnus-score-alist)
-
-(defsubst gnus-score-get (symbol &optional alist)
-  ;; Get SYMBOL's definition in ALIST.
-  (cdr (assoc symbol 
-	      (or alist 
-		  gnus-score-alist
-		  (gnus-newsgroup-score-alist)))))
-
-(defun gnus-summary-score-entry 
-  (header match type score date &optional prompt silent)
-  "Enter score file entry.
-HEADER is the header being scored.
-MATCH is the string we are looking for.
-TYPE is the match type: substring, regexp, exact, fuzzy.
-SCORE is the score to add.
-DATE is the expire date, or nil for no expire, or 'now for immediate expire.
-If optional argument `PROMPT' is non-nil, allow user to edit match.
-If optional argument `SILENT' is nil, show effect of score entry."
-  (interactive
-   (list (completing-read "Header: "
-			  gnus-header-index
-			  (lambda (x) (fboundp (nth 2 x)))
-			  t)
-	 (read-string "Match: ")
-	 (if (y-or-n-p "Use regexp match? ") 'r 's)
-	 (and current-prefix-arg
-	      (prefix-numeric-value current-prefix-arg))
-	 (cond ((not (y-or-n-p "Add to score file? "))
-		'now)
-	       ((y-or-n-p "Expire kill? ")
-		(current-time-string))
-	       (t nil))))
-  ;; Regexp is the default type.
-  (if (eq type t) (setq type 'r))
-  ;; Simplify matches...
-  (cond ((or (eq type 'r) (eq type 's) (eq type nil))
-	 (setq match (if match (gnus-simplify-subject-re match) "")))
-	((eq type 'f)
-	 (setq match (gnus-simplify-subject-fuzzy match))))
-  (let ((score (gnus-score-default score))
-	(header (format "%s" (downcase header)))
-	new)
-    (and prompt (setq match (read-string 
-			     (format "Match %s on %s, %s: " 
-				     (cond ((eq date 'now)
-					    "now")
-					   ((stringp date)
-					    "temp")
-					   (t "permanent"))
-				     header
-				     (if (< score 0) "lower" "raise"))
-			     (if (numberp match)
-				 (int-to-string match)
-			       match))))
-
-    ;; Get rid of string props.
-    (setq match (format "%s" match))
-
-    ;; If this is an integer comparison, we transform from string to int. 
-    (and (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
-	 (setq match (string-to-int match)))
-
-    (unless (eq date 'now)
-      ;; Add the score entry to the score file.
-      (when (= score gnus-score-interactive-default-score)
-	   (setq score nil))
-      (let ((old (gnus-score-get header))
-	    elem)
-	(setq new
-	      (cond 
-	       (type (list match score (and date (gnus-day-number date)) type))
-	       (date (list match score (gnus-day-number date)))
-	       (score (list match score))
-	       (t (list match))))
-	;; We see whether we can collapse some score entries.
-	;; This isn't quite correct, because there may be more elements
-	;; later on with the same key that have matching elems... Hm.
-	(if (and old
-		 (setq elem (assoc match old))
-		 (eq (nth 3 elem) (nth 3 new))
-		 (or (and (numberp (nth 2 elem)) (numberp (nth 2 new)))
-		     (and (not (nth 2 elem)) (not (nth 2 new)))))
-	    ;; Yup, we just add this new score to the old elem.
-	    (setcar (cdr elem) (+ (or (nth 1 elem) 
-				      gnus-score-interactive-default-score)
-				  (or (nth 1 new)
-				      gnus-score-interactive-default-score)))
-	  ;; Nope, we have to add a new elem.
-	  (gnus-score-set header (if old (cons new old) (list new))))
-	(gnus-score-set 'touched '(t))))
-
-    ;; Score the current buffer.
-    (unless silent
-      (if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
-	       (eq (nth 2 (assoc header gnus-header-index))
-		   'gnus-score-string))
-	  (gnus-summary-score-effect header match type score)
-	(gnus-summary-rescore)))
-
-    ;; Return the new scoring rule.
-    new))
-
-(defun gnus-summary-score-effect (header match type score)
-  "Simulate the effect of a score file entry.
-HEADER is the header being scored.
-MATCH is the string we are looking for.
-TYPE is a flag indicating if it is a regexp or substring.
-SCORE is the score to add."
-  (interactive (list (completing-read "Header: "
-				      gnus-header-index
-				      (lambda (x) (fboundp (nth 2 x)))
-				      t)
-		     (read-string "Match: ")
-		     (y-or-n-p "Use regexp match? ")
-		     (prefix-numeric-value current-prefix-arg)))
-  (save-excursion
-    (or (and (stringp match) (> (length match) 0))
-	(error "No match"))
-    (goto-char (point-min))
-    (let ((regexp (cond ((eq type 'f)
-			 (gnus-simplify-subject-fuzzy match))
-			((eq type 'r) 
-			 match)
-			((eq type 'e)
-			 (concat "\\`" (regexp-quote match) "\\'"))
-			(t 
-			 (regexp-quote match)))))
-      (while (not (eobp))
-	(let ((content (gnus-summary-header header 'noerr))
-	      (case-fold-search t))
-	  (and content
-	       (if (if (eq type 'f)
-		       (string-equal (gnus-simplify-subject-fuzzy content)
-				     regexp)
-		     (string-match regexp content))
-		   (gnus-summary-raise-score score))))
-	(beginning-of-line 2)))))
-
-(defun gnus-summary-score-crossposting (score date)
-  ;; Enter score file entry for current crossposting.
-  ;; SCORE is the score to add.
-  ;; DATE is the expire date.
-  (let ((xref (gnus-summary-header "xref"))
-	(start 0)
-	group)
-    (or xref (error "This article is not crossposted"))
-    (while (string-match " \\([^ \t]+\\):" xref start)
-      (setq start (match-end 0))
-      (if (not (string= 
-		(setq group 
-		      (substring xref (match-beginning 1) (match-end 1)))
-		gnus-newsgroup-name))
-	  (gnus-summary-score-entry
-	   "xref" (concat " " group ":") nil score date t)))))
-
-
-;;;
-;;; Gnus Score Files
-;;;
-
-;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
-
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-score-set-mark-below (score)
-  "Automatically mark articles with score below SCORE as read."
-  (interactive 
-   (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
-	     (string-to-int (read-string "Mark below: ")))))
-  (setq score (or score gnus-summary-default-score 0))
-  (gnus-score-set 'mark (list score))
-  (gnus-score-set 'touched '(t))
-  (setq gnus-summary-mark-below score)
-  (gnus-score-update-lines))
-
-(defun gnus-score-update-lines ()
-  "Update all lines in the summary buffer."
-  (save-excursion
-    (goto-char (point-min))
-    (while (not (eobp))
-      (gnus-summary-update-line)
-      (forward-line 1))))
-
-(defun gnus-score-update-all-lines ()
-  "Update all lines in the summary buffer, even the hidden ones."
-  (save-excursion
-    (goto-char (point-min))
-    (let (hidden)
-      (while (not (eobp))
-	(when (gnus-summary-show-thread)
-	  (push (point) hidden))
-	(gnus-summary-update-line)
-	(forward-line 1))
-      ;; Re-hide the hidden threads.
-      (while hidden
-	(goto-char (pop hidden))
-	(gnus-summary-hide-thread)))))
-
-(defun gnus-score-set-expunge-below (score)
-  "Automatically expunge articles with score below SCORE."
-  (interactive 
-   (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
-	     (string-to-int (read-string "Expunge below: ")))))
-  (setq score (or score gnus-summary-default-score 0))
-  (gnus-score-set 'expunge (list score))
-  (gnus-score-set 'touched '(t)))
-
-(defun gnus-score-followup-article (&optional score)
-  "Add SCORE to all followups to the article in the current buffer."
-  (interactive "P")
-  (setq score (gnus-score-default score))
-  (when (gnus-buffer-live-p gnus-summary-buffer)
-    (save-excursion
-      (save-restriction
-	(goto-char (point-min))
-	(let ((id (mail-fetch-field "message-id")))
-	  (when id
-	    (set-buffer gnus-summary-buffer)
-	    (gnus-summary-score-entry
-	     "references" (concat id "[ \t]*$") 'r
-	     score (current-time-string) nil t)))))))
-
-(defun gnus-score-followup-thread (&optional score)
-  "Add SCORE to all later articles in the thread the current buffer is part of."
-  (interactive "P")
-  (setq score (gnus-score-default score))
-  (when (gnus-buffer-live-p gnus-summary-buffer)
-    (save-excursion
-      (save-restriction
-	(goto-char (point-min))
-	(let ((id (mail-fetch-field "message-id")))
-	  (when id
-	    (set-buffer gnus-summary-buffer)
-	    (gnus-summary-score-entry
-	     "references" id 's
-	     score (current-time-string))))))))
-
-(defun gnus-score-set (symbol value &optional alist)
-  ;; Set SYMBOL to VALUE in ALIST.
-  (let* ((alist 
-	  (or alist 
-	      gnus-score-alist
-	      (gnus-newsgroup-score-alist)))
-	 (entry (assoc symbol alist)))
-    (cond ((gnus-score-get 'read-only alist)
-	   ;; This is a read-only score file, so we do nothing.
-	   )
-	  (entry
-	   (setcdr entry value))
-	  ((null alist)
-	   (error "Empty alist"))
-	  (t
-	   (setcdr alist
-		   (cons (cons symbol value) (cdr alist)))))))
-
-(defun gnus-summary-raise-score (n)
-  "Raise the score of the current article by N."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (gnus-summary-set-score (+ (gnus-summary-article-score) 
-			     (or n gnus-score-interactive-default-score ))))
-
-(defun gnus-summary-set-score (n)
-  "Set the score of the current article to N."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (save-excursion
-    (gnus-summary-show-thread)
-    (let ((buffer-read-only nil))
-      ;; Set score.
-      (gnus-summary-update-mark
-       (if (= n (or gnus-summary-default-score 0)) ? 
-	 (if (< n (or gnus-summary-default-score 0))
-	     gnus-score-below-mark gnus-score-over-mark)) 'score))
-    (let* ((article (gnus-summary-article-number))
-	   (score (assq article gnus-newsgroup-scored)))
-      (if score (setcdr score n)
-	(setq gnus-newsgroup-scored
-	      (cons (cons article n) gnus-newsgroup-scored))))
-    (gnus-summary-update-line)))
-
-(defun gnus-summary-current-score ()
-  "Return the score of the current article."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-message 1 "%s" (gnus-summary-article-score)))
-
-(defun gnus-score-change-score-file (file)
-  "Change current score alist."
-  (interactive 
-   (list (read-file-name "Change to score file: " gnus-kill-files-directory)))
-  (gnus-score-load-file file)
-  (gnus-set-mode-line 'summary))
-
-(defvar gnus-score-edit-exit-function)
-(defun gnus-score-edit-current-scores (file)
-  "Edit the current score alist."
-  (interactive (list gnus-current-score-file))
-  (let ((winconf (current-window-configuration)))
-    (and (buffer-name gnus-summary-buffer) (gnus-score-save))
-    (gnus-make-directory (file-name-directory file))
-    (setq gnus-score-edit-buffer (find-file-noselect file))
-    (gnus-configure-windows 'edit-score)
-    (gnus-score-mode)
-    (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
-    (make-local-variable 'gnus-prev-winconf)
-    (setq gnus-prev-winconf winconf))
-  (gnus-message 
-   4 (substitute-command-keys 
-      "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
-  
-(defun gnus-score-edit-file (file)
-  "Edit a score file."
-  (interactive 
-   (list (read-file-name "Edit score file: " gnus-kill-files-directory)))
-  (gnus-make-directory (file-name-directory file))
-  (and (buffer-name gnus-summary-buffer) (gnus-score-save))
-  (let ((winconf (current-window-configuration)))
-    (setq gnus-score-edit-buffer (find-file-noselect file))
-    (gnus-configure-windows 'edit-score)
-    (gnus-score-mode)
-    (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
-    (make-local-variable 'gnus-prev-winconf)
-    (setq gnus-prev-winconf winconf))
-  (gnus-message 
-   4 (substitute-command-keys 
-      "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
-  
-(defun gnus-score-load-file (file)
-  ;; Load score file FILE.  Returns a list a retrieved score-alists.
-  (let* ((file (expand-file-name 
-		(or (and (string-match
-			  (concat "^" (expand-file-name
-				       gnus-kill-files-directory)) 
-			  (expand-file-name file))
-			 file)
-		    (concat (file-name-as-directory gnus-kill-files-directory)
-			    file))))
-	 (cached (assoc file gnus-score-cache))
-	 (global (member file gnus-internal-global-score-files))
-	 lists alist)
-    (if cached
-	;; The score file was already loaded.
-	(setq alist (cdr cached))
-      ;; We load the score file.
-      (setq gnus-score-alist nil)
-      (setq alist (gnus-score-load-score-alist file))
-      ;; We add '(touched) to the alist to signify that it hasn't been
-      ;; touched (yet). 
-      (or (assq 'touched alist) (setq alist (cons (list 'touched nil) alist)))
-      ;; If it is a global score file, we make it read-only.
-      (and global
-	   (not (assq 'read-only alist))
-	   (setq alist (cons (list 'read-only t) alist)))
-      (setq gnus-score-cache
-	    (cons (cons file alist) gnus-score-cache)))
-    (let ((a alist)
-	  found)
-      (while a
-	;; Downcase all header names.
-	(when (stringp (caar a))
-	  (setcar (car a) (downcase (caar a)))
-	  (setq found t))
-	(pop a))
-      ;; If there are actual scores in the alist, we add it to the
-      ;; return value of this function.
-      (when found
-	(setq lists (list alist))))
-    ;; Treat the other possible atoms in the score alist.
-    (let ((mark (car (gnus-score-get 'mark alist)))
-	  (expunge (car (gnus-score-get 'expunge alist)))
-	  (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
-	  (files (gnus-score-get 'files alist))
-	  (exclude-files (gnus-score-get 'exclude-files alist))
-          (orphan (car (gnus-score-get 'orphan alist)))
-	  (adapt (gnus-score-get 'adapt alist))
-	  (thread-mark-and-expunge
-	   (car (gnus-score-get 'thread-mark-and-expunge alist)))
-	  (adapt-file (car (gnus-score-get 'adapt-file alist)))
-	  (local (gnus-score-get 'local alist))
-	  (eval (car (gnus-score-get 'eval alist))))
-      ;; We do not respect eval and files atoms from global score
-      ;; files. 
-      (and files (not global)
-	   (setq lists (apply 'append lists
-			      (mapcar (lambda (file)
-					(gnus-score-load-file file)) 
-				      (if adapt-file (cons adapt-file files)
-					files)))))
-      (and eval (not global) (eval eval))
-      ;; We then expand any exclude-file directives.
-      (setq gnus-scores-exclude-files 
-	    (nconc 
-	     (mapcar 
-	      (lambda (sfile) 
-		(expand-file-name sfile (file-name-directory file)))
-	      exclude-files) gnus-scores-exclude-files))
-      (if (not local)
-	  ()
-	(save-excursion
-	  (set-buffer gnus-summary-buffer)
-	  (while local
-	    (and (consp (car local))
-		 (symbolp (caar local))
-		 (progn
-		   (make-local-variable (caar local))
-		   (set (caar local) (nth 1 (car local)))))
-	    (setq local (cdr local)))))
-      (if orphan (setq gnus-orphan-score orphan))
-      (setq gnus-adaptive-score-alist
-	    (cond ((equal adapt '(t))
-		   (setq gnus-newsgroup-adaptive t)
-		   gnus-default-adaptive-score-alist)
-		  ((equal adapt '(ignore))
-		   (setq gnus-newsgroup-adaptive nil))
-		  ((consp adapt)
-		   (setq gnus-newsgroup-adaptive t)
-		   adapt)
-		  (t
-		   ;;(setq gnus-newsgroup-adaptive gnus-use-adaptive-scoring)
-		   gnus-default-adaptive-score-alist)))
-      (setq gnus-thread-expunge-below 
-	    (or thread-mark-and-expunge gnus-thread-expunge-below))
-      (setq gnus-summary-mark-below 
-	    (or mark mark-and-expunge gnus-summary-mark-below))
-      (setq gnus-summary-expunge-below 
-	    (or expunge mark-and-expunge gnus-summary-expunge-below))
-      (setq gnus-newsgroup-adaptive-score-file 
-	    (or adapt-file gnus-newsgroup-adaptive-score-file)))
-    (setq gnus-current-score-file file)
-    (setq gnus-score-alist alist)
-    lists))
-
-(defun gnus-score-load (file)
-  ;; Load score FILE.
-  (let ((cache (assoc file gnus-score-cache)))
-    (if cache
-	(setq gnus-score-alist (cdr cache))
-      (setq gnus-score-alist nil)
-      (gnus-score-load-score-alist file)
-      (or gnus-score-alist
-	  (setq gnus-score-alist (copy-alist '((touched nil)))))
-      (setq gnus-score-cache
-	    (cons (cons file gnus-score-alist) gnus-score-cache)))))
-
-(defun gnus-score-remove-from-cache (file)
-  (setq gnus-score-cache 
-	(delq (assoc file gnus-score-cache) gnus-score-cache)))
-
-(defun gnus-score-load-score-alist (file)
-  (let (alist)
-    (if (not (file-readable-p file))
-	(setq gnus-score-alist nil)
-      (save-excursion
-	(gnus-set-work-buffer)
-	(insert-file-contents file)
-	(goto-char (point-min))
-	;; Only do the loading if the score file isn't empty.
-	(when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t))
-	  (setq alist
-		(condition-case ()
-		    (read (current-buffer))
-		  (error 
-		   (progn
-		     (gnus-message 3 "Problem with score file %s" file)
-		     (ding) 
-		     (sit-for 2)
-		     nil))))))
-      (if (eq (car alist) 'setq)
-	  ;; This is an old-style score file.
-	  (setq gnus-score-alist (gnus-score-transform-old-to-new alist))
-	(setq gnus-score-alist alist))
-      ;; Check the syntax of the score file.
-      (setq gnus-score-alist
-	    (gnus-score-check-syntax gnus-score-alist file)))))
-
-(defun gnus-score-check-syntax (alist file)
-  "Check the syntax of the score ALIST."
-  (cond 
-   ((null alist)
-    nil)
-   ((not (consp alist))
-    (gnus-message 1 "Score file is not a list: %s" file)
-    (ding)
-    nil)
-   (t
-    (let ((a alist)
-	  sr err s type)
-      (while (and a (not err))
-	(setq
-	 err
-	 (cond
-	  ((not (listp (car a)))
-	   (format "Illegal score element %s in %s" (car a) file))
-	  ((stringp (caar a))
-	   (cond 
-	    ((not (listp (setq sr (cdar a))))
-	     (format "Illegal header match %s in %s" (nth 1 (car a)) file))
-	    (t
-	     (setq type (caar a))
-	     (while (and sr (not err))
-	       (setq s (pop sr))
-	       (setq 
-		err
-		(cond
-		 ((if (member (downcase type) '("lines" "chars"))
-		      (not (numberp (car s)))
-		    (not (stringp (car s))))
-		  (format "Illegal match %s in %s" (car s) file))
-		 ((and (cadr s) (not (integerp (cadr s))))
-		  (format "Non-integer score %s in %s" (cadr s) file))
-		 ((and (caddr s) (not (integerp (caddr s))))
-		  (format "Non-integer date %s in %s" (caddr s) file))
-		 ((and (cadddr s) (not (symbolp (cadddr s))))
-		  (format "Non-symbol match type %s in %s" (cadddr s) file)))))
-	     err)))))
-	(setq a (cdr a)))
-      (if err
-	  (progn
-	    (ding)
-	    (gnus-message 3 err)
-	    (sit-for 2)
-	    nil)
-	alist)))))    
-
-(defun gnus-score-transform-old-to-new (alist)
-  (let* ((alist (nth 2 alist))
-	 out entry)
-    (if (eq (car alist) 'quote)
-	(setq alist (nth 1 alist)))
-    (while alist
-      (setq entry (car alist))
-      (if (stringp (car entry))
-	  (let ((scor (cdr entry)))
-	    (setq out (cons entry out))
-	    (while scor
-	      (setcar scor
-		      (list (caar scor) (nth 2 (car scor))
-			    (and (nth 3 (car scor))
-				 (gnus-day-number (nth 3 (car scor))))
-			    (if (nth 1 (car scor)) 'r 's)))
-	      (setq scor (cdr scor))))
-	(setq out (cons (if (not (listp (cdr entry))) 
-			    (list (car entry) (cdr entry))
-			  entry)
-			out)))
-      (setq alist (cdr alist)))
-    (cons (list 'touched t) (nreverse out))))
-  
-(defun gnus-score-save ()
-  ;; Save all score information.
-  (let ((cache gnus-score-cache))
-    (save-excursion
-      (setq gnus-score-alist nil)
-      (set-buffer (get-buffer-create "*Score*"))
-      (buffer-disable-undo (current-buffer))
-      (let (entry score file)
-	(while cache
-	  (setq entry (car cache)
-		cache (cdr cache)
-		file (car entry)
-		score (cdr entry))
-	  (if (or (not (equal (gnus-score-get 'touched score) '(t)))
-		  (gnus-score-get 'read-only score)
-		  (and (file-exists-p file)
-		       (not (file-writable-p file))))
-	      ()
-	    (setq score (setcdr entry (delq (assq 'touched score) score)))
-	    (erase-buffer)
-	    (let (emacs-lisp-mode-hook)
-	      (if (string-match 
-		   (concat (regexp-quote gnus-adaptive-file-suffix)
-			   "$") file)
-		  ;; This is an adaptive score file, so we do not run
-		  ;; it through `pp'.  These files can get huge, and
-		  ;; are not meant to be edited by human hands.
-		  (prin1 score (current-buffer))
-		;; This is a normal score file, so we print it very
-		;; prettily. 
-		(pp score (current-buffer))))
-	    (if (not (gnus-make-directory (file-name-directory file)))
-		()
-	      ;; If the score file is empty, we delete it.
-	      (if (zerop (buffer-size))
-		  (delete-file file)
-		;; There are scores, so we write the file. 
- 		(when (file-writable-p file)
-		  (write-region (point-min) (point-max) file nil 'silent)
-		  (and gnus-score-after-write-file-function
-		       (funcall gnus-score-after-write-file-function file)))))
-	    (and gnus-score-uncacheable-files
-		 (string-match gnus-score-uncacheable-files file)
-		 (gnus-score-remove-from-cache file)))))
-      (kill-buffer (current-buffer)))))
-  
-(defun gnus-score-headers (score-files &optional trace)
-  ;; Score `gnus-newsgroup-headers'.
-  (let (scores news)
-    ;; PLM: probably this is not the best place to clear orphan-score
-    (setq gnus-orphan-score nil)
-    (setq gnus-scores-articles nil)
-    (setq gnus-scores-exclude-files nil)
-    ;; Load the score files.
-    (while score-files
-      (if (stringp (car score-files))
-	  ;; It is a string, which means that it's a score file name,
-	  ;; so we load the score file and add the score alist to
-	  ;; the list of alists.
-	  (setq scores (nconc (gnus-score-load-file (car score-files)) scores))
-	;; It is an alist, so we just add it to the list directly.
-	(setq scores (nconc (car score-files) scores)))
-      (setq score-files (cdr score-files)))
-    ;; Prune the score files that are to be excluded, if any.
-    (when gnus-scores-exclude-files
-      (let ((s scores)
-	    c)
-	(while s
-	  (and (setq c (rassq (car s) gnus-score-cache))
-	       (member (car c) gnus-scores-exclude-files)
-	       (setq scores (delq (car s) scores)))
-	  (setq s (cdr s)))))
-    (setq news scores)
-    ;; Do the scoring.
-    (while news
-      (setq scores news
-	    news nil)
-      (when (and gnus-summary-default-score
-		 scores)
-	(let* ((entries gnus-header-index)
-	       (now (gnus-day-number (current-time-string)))
-	       (expire (and gnus-score-expiry-days
-			    (- now gnus-score-expiry-days)))
-	       (headers gnus-newsgroup-headers)
-	       (current-score-file gnus-current-score-file)
-	       entry header new)
-	  (gnus-message 5 "Scoring...")
-	  ;; Create articles, an alist of the form `(HEADER . SCORE)'.
-	  (while (setq header (pop headers))
-	    ;; WARNING: The assq makes the function O(N*S) while it could
-	    ;; be written as O(N+S), where N is (length gnus-newsgroup-headers)
-	    ;; and S is (length gnus-newsgroup-scored).
-	    (or (assq (mail-header-number header) gnus-newsgroup-scored)
-		(setq gnus-scores-articles ;Total of 2 * N cons-cells used.
-		      (cons (cons header (or gnus-summary-default-score 0))
-			    gnus-scores-articles))))
-
-	  (save-excursion
-	    (set-buffer (get-buffer-create "*Headers*"))
-	    (buffer-disable-undo (current-buffer))
-
-	    ;; Set the global variant of this variable.
-	    (setq gnus-current-score-file current-score-file)
-	    ;; score orphans
-	    (when gnus-orphan-score 
-	      (setq gnus-score-index 
-		    (nth 1 (assoc "references" gnus-header-index)))
-	      (gnus-score-orphans gnus-orphan-score))
-	    ;; Run each header through the score process.
-	    (while entries
-	      (setq entry (pop entries)
-		    header (nth 0 entry)
-		    gnus-score-index (nth 1 (assoc header gnus-header-index)))
-	      (when (< 0 (apply 'max (mapcar
-				      (lambda (score)
-					(length (gnus-score-get header score)))
-				      scores)))
-		;; Call the scoring function for this type of "header".
-		(when (setq new (funcall (nth 2 entry) scores header
-					 now expire trace))
-		  (push new news))))
-	    ;; Remove the buffer.
-	    (kill-buffer (current-buffer)))
-
-	  ;; Add articles to `gnus-newsgroup-scored'.
-	  (while gnus-scores-articles
-	    (or (= gnus-summary-default-score (cdar gnus-scores-articles))
-		(setq gnus-newsgroup-scored
-		      (cons (cons (mail-header-number 
-				   (caar gnus-scores-articles))
-				  (cdar gnus-scores-articles))
-			    gnus-newsgroup-scored)))
-	    (setq gnus-scores-articles (cdr gnus-scores-articles)))
-
-	  (gnus-message 5 "Scoring...done"))))))
-
-
-(defun gnus-get-new-thread-ids (articles)
-  (let ((index (nth 1 (assoc "message-id" gnus-header-index)))
-        (refind gnus-score-index)
-        id-list art this tref)
-    (while articles
-      (setq art (car articles)
-            this (aref (car art) index)
-            tref (aref (car art) refind)
-            articles (cdr articles))
-      (if (string-equal tref "")        ;no references line
-          (setq id-list (cons this id-list))))
-    id-list))
-
-;; Orphan functions written by plm@atcmp.nl (Peter Mutsaers).
-(defun gnus-score-orphans (score)
-  (let ((new-thread-ids (gnus-get-new-thread-ids gnus-scores-articles))
-        alike articles art arts this last this-id)
-    
-    (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
-	  articles gnus-scores-articles)
-
-    ;;more or less the same as in gnus-score-string
-    (erase-buffer)
-    (while articles
-      (setq art (car articles)
-            this (aref (car art) gnus-score-index)
-            articles (cdr articles))
-      ;;completely skip if this is empty (not a child, so not an orphan)
-      (if (not (string= this ""))
-          (if (equal last this)
-              ;; O(N*H) cons-cells used here, where H is the number of
-              ;; headers.
-              (setq alike (cons art alike))
-            (if last
-                (progn
-                  ;; Insert the line, with a text property on the
-                  ;; terminating newline referring to the articles with
-                  ;; this line.
-                  (insert last ?\n)
-                  (put-text-property (1- (point)) (point) 'articles alike)))
-            (setq alike (list art)
-                  last this))))
-    (and last                           ; Bwadr, duplicate code.
-         (progn
-           (insert last ?\n)                    
-           (put-text-property (1- (point)) (point) 'articles alike)))
-
-    ;; PLM: now delete those lines that contain an entry from new-thread-ids
-    (while new-thread-ids
-      (setq this-id (car new-thread-ids)
-            new-thread-ids (cdr new-thread-ids))
-      (goto-char (point-min))
-      (while (search-forward this-id nil t)
-        ;; found a match. remove this line
-	(beginning-of-line)
-	(kill-line 1)))
-
-    ;; now for each line: update its articles with score by moving to
-    ;; every end-of-line in the buffer and read the articles property
-    (goto-char (point-min))
-    (while (eq 0 (progn
-                   (end-of-line)
-                   (setq arts (get-text-property (point) 'articles))
-                   (while arts
-                     (setq art (car arts)
-                           arts (cdr arts))
-                     (setcdr art (+ score (cdr art))))
-                   (forward-line))))))
-             
-
-(defun gnus-score-integer (scores header now expire &optional trace)
-  (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
-	entries alist)
-
-    ;; Find matches.
-    (while scores
-      (setq alist (car scores)
-	    scores (cdr scores)
-	    entries (assoc header alist))
-      (while (cdr entries)		;First entry is the header index.
-	(let* ((rest (cdr entries))		
-	       (kill (car rest))
-	       (match (nth 0 kill))
-	       (type (or (nth 3 kill) '>))
-	       (score (or (nth 1 kill) gnus-score-interactive-default-score))
-	       (date (nth 2 kill))
-	       (found nil)
-	       (match-func (if (or (eq type '>) (eq type '<) (eq type '<=)
-				   (eq type '>=) (eq type '=))
-			       type
-			     (error "Illegal match type: %s" type)))
-	       (articles gnus-scores-articles))
-	  ;; Instead of doing all the clever stuff that
-	  ;; `gnus-score-string' does to minimize searches and stuff,
-	  ;; I will assume that people generally will put so few
-	  ;; matches on numbers that any cleverness will take more
-	  ;; time than one would gain.
-	  (while articles
-	    (and (funcall match-func 
-			  (or (aref (caar articles) gnus-score-index) 0)
-			  match)
-		 (progn
-		   (and trace (setq gnus-score-trace 
-				    (cons
-				     (cons
-				      (car-safe (rassq alist gnus-score-cache))
-				      kill)
-				     gnus-score-trace)))
-		   (setq found t)
-		   (setcdr (car articles) (+ score (cdar articles)))))
-	    (setq articles (cdr articles)))
-	  ;; Update expire date
-	  (cond ((null date))		;Permanent entry.
-		((and found gnus-update-score-entry-dates) ;Match, update date.
-		 (gnus-score-set 'touched '(t) alist)
-		 (setcar (nthcdr 2 kill) now))
-		((and expire (< date expire)) ;Old entry, remove.
-		 (gnus-score-set 'touched '(t) alist)
-		 (setcdr entries (cdr rest))
-		 (setq rest entries)))
-	  (setq entries rest)))))
-  nil)
-
-(defun gnus-score-date (scores header now expire &optional trace)
-  (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
-	entries alist)
-
-    ;; Find matches.
-    (while scores
-      (setq alist (car scores)
-	    scores (cdr scores)
-	    entries (assoc header alist))
-      (while (cdr entries)		;First entry is the header index.
-	(let* ((rest (cdr entries))		
-	       (kill (car rest))
-	       (match (timezone-make-date-sortable (nth 0 kill)))
-	       (type (or (nth 3 kill) 'before))
-	       (score (or (nth 1 kill) gnus-score-interactive-default-score))
-	       (date (nth 2 kill))
-	       (found nil)
-	       (match-func 
-		(cond ((eq type 'after) 'string<)
-		      ((eq type 'before) 'gnus-string>)
-		      ((eq type 'at) 'string=)
-		      (t (error "Illegal match type: %s" type))))
-	       (articles gnus-scores-articles)
-	       l)
-	  ;; Instead of doing all the clever stuff that
-	  ;; `gnus-score-string' does to minimize searches and stuff,
-	  ;; I will assume that people generally will put so few
-	  ;; matches on numbers that any cleverness will take more
-	  ;; time than one would gain.
-	  (while articles
-	    (and
-	     (setq l (aref (caar articles) gnus-score-index))
-	     (funcall match-func match (timezone-make-date-sortable l))
-	     (progn
-	       (and trace (setq gnus-score-trace 
-				(cons
-				 (cons
-				  (car-safe (rassq alist gnus-score-cache))
-				  kill)
-				 gnus-score-trace)))
-	       (setq found t)
-	       (setcdr (car articles) (+ score (cdar articles)))))
-	    (setq articles (cdr articles)))
-	  ;; Update expire date
-	  (cond ((null date))		;Permanent entry.
-		((and found gnus-update-score-entry-dates) ;Match, update date.
-		 (gnus-score-set 'touched '(t) alist)
-		 (setcar (nthcdr 2 kill) now))
-		((and expire (< date expire))	;Old entry, remove.
-		 (gnus-score-set 'touched '(t) alist)
-		 (setcdr entries (cdr rest))
-		 (setq rest entries)))
-	  (setq entries rest)))))
-  nil)
-
-(defun gnus-score-body (scores header now expire &optional trace)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (setq gnus-scores-articles
-	  (sort gnus-scores-articles
-		(lambda (a1 a2)
-		  (< (mail-header-number (car a1))
-		     (mail-header-number (car a2))))))
-    (save-restriction
-      (let* ((buffer-read-only nil)
-	     (articles gnus-scores-articles)
-	     (all-scores scores)
-	     (request-func (cond ((string= "head" header)
-				  'gnus-request-head)
-				 ((string= "body" header)
-				  'gnus-request-body)
-				 (t 'gnus-request-article)))
-	     entries alist ofunc article last)
-	(when articles
-	  (while (cdr articles)
-	    (setq articles (cdr articles)))
-	  (setq last (mail-header-number (caar articles)))
-	  (setq articles gnus-scores-articles)
-	  ;; Not all backends support partial fetching.  In that case,
-	  ;; we just fetch the entire article.
-	  (or (gnus-check-backend-function 
-	       (and (string-match "^gnus-" (symbol-name request-func))
-		    (intern (substring (symbol-name request-func)
-				       (match-end 0))))
-	       gnus-newsgroup-name)
-	      (progn
-		(setq ofunc request-func)
-		(setq request-func 'gnus-request-article)))
-	  (while articles
-	    (setq article (mail-header-number (caar articles)))
-	    (gnus-message 7 "Scoring on article %s of %s..." article last)
-	    (when (funcall request-func article gnus-newsgroup-name)
-	      (widen)
-	      (goto-char (point-min))
-	      ;; If just parts of the article is to be searched, but the
-	      ;; backend didn't support partial fetching, we just narrow
-	      ;; to the relevant parts.
-	      (if ofunc
-		  (if (eq ofunc 'gnus-request-head)
-		      (narrow-to-region
-		       (point)
-		       (or (search-forward "\n\n" nil t) (point-max)))
-		    (narrow-to-region
-		     (or (search-forward "\n\n" nil t) (point))
-		     (point-max))))
-	      (setq scores all-scores)
-	      ;; Find matches.
-	      (while scores
-		(setq alist (car scores)
-		      scores (cdr scores)
-		      entries (assoc header alist))
-		(while (cdr entries)	;First entry is the header index.
-		  (let* ((rest (cdr entries))		
-			 (kill (car rest))
-			 (match (nth 0 kill))
-			 (type (or (nth 3 kill) 's))
-			 (score (or (nth 1 kill) 
-				    gnus-score-interactive-default-score))
-			 (date (nth 2 kill))
-			 (found nil)
-			 (case-fold-search 
-			  (not (or (eq type 'R) (eq type 'S)
-				   (eq type 'Regexp) (eq type 'String))))
-			 (search-func 
-			  (cond ((or (eq type 'r) (eq type 'R)
-				     (eq type 'regexp) (eq type 'Regexp))
-				 're-search-forward)
-				((or (eq type 's) (eq type 'S)
-				     (eq type 'string) (eq type 'String))
-				 'search-forward)
-				(t
-				 (error "Illegal match type: %s" type)))))
-		    (goto-char (point-min))
-		    (if (funcall search-func match nil t)
-			;; Found a match, update scores.
-			(progn
-			  (setcdr (car articles) (+ score (cdar articles)))
-			  (setq found t)
-			  (and trace (setq gnus-score-trace 
-					   (cons
-					    (cons
-					     (car-safe
-					      (rassq alist gnus-score-cache))
-					     kill)
-					    gnus-score-trace)))))
-		    ;; Update expire date
-		    (cond
-		     ((null date))	;Permanent entry.
-		     ((and found gnus-update-score-entry-dates) ;Match, update date.
-		      (gnus-score-set 'touched '(t) alist)
-		      (setcar (nthcdr 2 kill) now))
-		     ((and expire (< date expire)) ;Old entry, remove.
-		      (gnus-score-set 'touched '(t) alist)
-		      (setcdr entries (cdr rest))
-		      (setq rest entries)))
-		    (setq entries rest)))))
-	    (setq articles (cdr articles)))))))
-  nil)
-
-(defun gnus-score-followup (scores header now expire &optional trace thread)
-  ;; Insert the unique article headers in the buffer.
-  (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
-	(current-score-file gnus-current-score-file)
-	(all-scores scores)
-	;; gnus-score-index is used as a free variable.
-	alike last this art entries alist articles
-	new news)
-
-    ;; Change score file to the adaptive score file.  All entries that
-    ;; this function makes will be put into this file.
-    (save-excursion
-      (set-buffer gnus-summary-buffer)
-      (gnus-score-load-file
-       (or gnus-newsgroup-adaptive-score-file
-	   (gnus-score-file-name 
-	    gnus-newsgroup-name gnus-adaptive-file-suffix))))
-
-    (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
-	  articles gnus-scores-articles)
-
-    (erase-buffer)
-    (while articles
-      (setq art (car articles)
-	    this (aref (car art) gnus-score-index)
-	    articles (cdr articles))
-      (if (equal last this)
-	  (setq alike (cons art alike))
-	(if last
-	    (progn
-	      (insert last ?\n)
-	      (put-text-property (1- (point)) (point) 'articles alike)))
-	(setq alike (list art)
-	      last this)))
-    (and last				; Bwadr, duplicate code.
-	 (progn
-	   (insert last ?\n)			
-	   (put-text-property (1- (point)) (point) 'articles alike)))
-  
-    ;; Find matches.
-    (while scores
-      (setq alist (car scores)
-	    scores (cdr scores)
-	    entries (assoc header alist))
-      (while (cdr entries)		;First entry is the header index.
-	(let* ((rest (cdr entries))		
-	       (kill (car rest))
-	       (match (nth 0 kill))
-	       (type (or (nth 3 kill) 's))
-	       (score (or (nth 1 kill) gnus-score-interactive-default-score))
-	       (date (nth 2 kill))
-	       (found nil)
-	       (mt (aref (symbol-name type) 0))
-	       (case-fold-search 
-		(not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F))))
-	       (dmt (downcase mt))
-	       (search-func 
-		(cond ((= dmt ?r) 're-search-forward)
-		      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
-		      (t (error "Illegal match type: %s" type))))
-	       arts art)
-	  (goto-char (point-min))
-	  (if (= dmt ?e)
-	      (while (funcall search-func match nil t)
-		(and (= (progn (beginning-of-line) (point))
-			(match-beginning 0))
-		     (= (progn (end-of-line) (point))
-			(match-end 0))
-		     (progn
-		       (setq found (setq arts (get-text-property 
-					       (point) 'articles)))
-		       ;; Found a match, update scores.
-		       (while arts
-			 (setq art (car arts)
-			       arts (cdr arts))
-			 (gnus-score-add-followups 
-			  (car art) score all-scores thread))))
-		(end-of-line))
-	    (while (funcall search-func match nil t)
-	      (end-of-line)
-	      (setq found (setq arts (get-text-property (point) 'articles)))
-	      ;; Found a match, update scores.
-	      (while (setq art (pop arts))
-		(when (setq new (gnus-score-add-followups
-				 (car art) score all-scores thread))
-		  (push new news)))))
-	  ;; Update expire date
-	  (cond ((null date))		;Permanent entry.
-		((and found gnus-update-score-entry-dates) ;Match, update date.
-		 (gnus-score-set 'touched '(t) alist)
-		 (setcar (nthcdr 2 kill) now))
-		((and expire (< date expire))	;Old entry, remove.
-		 (gnus-score-set 'touched '(t) alist)
-		 (setcdr entries (cdr rest))
-		 (setq rest entries)))
-	  (setq entries rest))))
-    ;; We change the score file back to the previous one.
-    (save-excursion
-      (set-buffer gnus-summary-buffer)
-      (gnus-score-load-file current-score-file))
-    (list (cons "references" news))))
-
-(defun gnus-score-add-followups (header score scores &optional thread)
-  "Add a score entry to the adapt file."
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
-    (let* ((id (mail-header-id header))
-	   (scores (car scores))
-	   entry dont)
-      ;; Don't enter a score if there already is one.
-      (while (setq entry (pop scores))
-	(and (equal "references" (car entry))
-	     (or (null (nth 3 (cadr entry)))
-		 (eq 's (nth 3 (cadr entry))))
-	     (assoc id entry)
-	     (setq dont t)))
-      (unless dont
-	(gnus-summary-score-entry 
-	 (if thread "thread" "references")
-	 id 's score (current-time-string) nil t)))))
-
-(defun gnus-score-string (score-list header now expire &optional trace)
-  ;; Score ARTICLES according to HEADER in SCORE-LIST.
-  ;; Update matching entries to NOW and remove unmatched entries older
-  ;; than EXPIRE.
-  
-  ;; Insert the unique article headers in the buffer.
-  (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
-	;; gnus-score-index is used as a free variable.
-	alike last this art entries alist articles scores fuzzy)
-
-    ;; Sorting the articles costs os O(N*log N) but will allow us to
-    ;; only match with each unique header.  Thus the actual matching
-    ;; will be O(M*U) where M is the number of strings to match with,
-    ;; and U is the number of unique headers.  It is assumed (but
-    ;; untested) this will be a net win because of the large constant
-    ;; factor involved with string matching.
-    (setq gnus-scores-articles (sort gnus-scores-articles 'gnus-score-string<)
-	  articles gnus-scores-articles)
-
-    (erase-buffer)
-    (while articles
-      (setq art (car articles)
-	    this (aref (car art) gnus-score-index)
-	    articles (cdr articles))
-      (if (equal last this)
-	  ;; O(N*H) cons-cells used here, where H is the number of
-	  ;; headers.
-	  (setq alike (cons art alike))
-	(if last
-	    (progn
-	      ;; Insert the line, with a text property on the
-	      ;; terminating newline referring to the articles with
-	      ;; this line.
-	      (insert last ?\n)
-	      (put-text-property (1- (point)) (point) 'articles alike)))
-	(setq alike (list art)
-	      last this)))
-    (and last				; Bwadr, duplicate code.
-	 (progn
-	   (insert last ?\n)			
-	   (put-text-property (1- (point)) (point) 'articles alike)))
-
-    ;; Find ordinary matches.
-    (setq scores score-list) 
-    (while scores
-      (setq alist (car scores)
-	    scores (cdr scores)
-	    entries (assoc header alist))
-      (while (cdr entries)		;First entry is the header index.
-	(let* ((rest (cdr entries))		
-	       (kill (car rest))
-	       (match (nth 0 kill))
-	       (type (or (nth 3 kill) 's))
-	       (score (or (nth 1 kill) gnus-score-interactive-default-score))
-	       (date (nth 2 kill))
-	       (found nil)
-	       (mt (aref (symbol-name type) 0))
-	       (case-fold-search 
-		(not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F))))
-	       (dmt (downcase mt))
-	       (search-func 
-		(cond ((= dmt ?r) 're-search-forward)
-		      ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
-		      (t (error "Illegal match type: %s" type))))
-	       arts art)
-	  (if (= dmt ?f)
-	      (setq fuzzy t)
-	    ;; Do non-fuzzy matching.
-	    (goto-char (point-min))
-	    (if (= dmt ?e)
-		;; Do exact matching.
-		(while (and (not (eobp)) 
-			    (funcall search-func match nil t))
-		  (and (= (progn (beginning-of-line) (point))
-			  (match-beginning 0))
-		       (= (progn (end-of-line) (point))
-			  (match-end 0))
-		       (progn
-			 (setq found (setq arts (get-text-property 
-						 (point) 'articles)))
-			 ;; Found a match, update scores.
-			 (if trace
-			     (while arts
-			       (setq art (car arts)
-				     arts (cdr arts))
-			       (setcdr art (+ score (cdr art)))
-			       (setq gnus-score-trace
-				     (cons
-				      (cons
-				       (car-safe
-					(rassq alist gnus-score-cache))
-				       kill)
-				      gnus-score-trace)))
-			   (while arts
-			     (setq art (car arts)
-				   arts (cdr arts))
-			     (setcdr art (+ score (cdr art)))))))
-		  (forward-line 1))
-	      ;; Do regexp and substring matching.
-	      (and (string= match "") (setq match "\n"))
-	      (while (and (not (eobp))
-			  (funcall search-func match nil t))
-		(goto-char (match-beginning 0))
-		(end-of-line)
-		(setq found (setq arts (get-text-property (point) 'articles)))
-		;; Found a match, update scores.
-		(if trace
-		    (while arts
-		      (setq art (pop arts))
-		      (setcdr art (+ score (cdr art)))
-		      (push (cons
-			      (car-safe (rassq alist gnus-score-cache))
-			      kill)
-			    gnus-score-trace))
-		  (while arts
-		    (setq art (pop arts))
-		    (setcdr art (+ score (cdr art)))))
-		(forward-line 1)))
-	    ;; Update expire date
-	    (cond 
-	     ((null date))		;Permanent entry.
-	     ((and found gnus-update-score-entry-dates) ;Match, update date.
-	      (gnus-score-set 'touched '(t) alist)
-	      (setcar (nthcdr 2 kill) now))
-	     ((and expire (< date expire)) ;Old entry, remove.
-	      (gnus-score-set 'touched '(t) alist)
-	      (setcdr entries (cdr rest))
-	      (setq rest entries))))
-	  (setq entries rest))))
-
-    ;; Find fuzzy matches.
-    (when fuzzy
-      (setq scores score-list)
-      (gnus-simplify-buffer-fuzzy)
-      (while scores
-	(setq alist (car scores)
-	      scores (cdr scores)
-	      entries (assoc header alist))
-	(while (cdr entries)		;First entry is the header index.
-	  (let* ((rest (cdr entries))		
-		 (kill (car rest))
-		 (match (nth 0 kill))
-		 (type (or (nth 3 kill) 's))
-		 (score (or (nth 1 kill) gnus-score-interactive-default-score))
-		 (date (nth 2 kill))
-		 (found nil)
-		 (mt (aref (symbol-name type) 0))
-		 (case-fold-search (not (= mt ?F)))
-		 (dmt (downcase mt))
-		 arts art)
-	    (when (= dmt ?f)
-	      (goto-char (point-min))
-	      (while (and (not (eobp)) 
-			  (search-forward match nil t))
-		(when (and (= (progn (beginning-of-line) (point))
-			      (match-beginning 0))
-			   (= (progn (end-of-line) (point))
-			      (match-end 0)))
-		  (setq found (setq arts (get-text-property 
-					  (point) 'articles)))
-		  ;; Found a match, update scores.
-		  (if trace
-		      (while arts
-			(setq art (pop arts))
-			(setcdr art (+ score (cdr art)))
-			(push (cons
-			       (car-safe (rassq alist gnus-score-cache))
-			       kill)
-			      gnus-score-trace))
-		    (while arts
-		      (setq art (pop arts))
-		      (setcdr art (+ score (cdr art))))))
-		(forward-line 1))
-	      ;; Update expire date
-	      (unless trace
-		(cond 
-		 ((null date))		;Permanent entry.
-		 ((and found gnus-update-score-entry-dates) ;Match, update date.
-		  (gnus-score-set 'touched '(t) alist)
-		  (setcar (nthcdr 2 kill) now))
-		 ((and expire (< date expire)) ;Old entry, remove.
-		  (gnus-score-set 'touched '(t) alist)
-		  (setcdr entries (cdr rest))
-		  (setq rest entries)))))
-	    (setq entries rest))))))
-  nil)
-
-(defun gnus-score-string< (a1 a2)
-  ;; Compare headers in articles A2 and A2.
-  ;; The header index used is the free variable `gnus-score-index'.
-  (string-lessp (aref (car a1) gnus-score-index)
-		(aref (car a2) gnus-score-index)))
-
-(defun gnus-score-build-cons (article)
-  ;; Build a `gnus-newsgroup-scored' type cons from ARTICLE.
-  (cons (mail-header-number (car article)) (cdr article)))
-
-(defun gnus-current-score-file-nondirectory (&optional score-file)
-  (let ((score-file (or score-file gnus-current-score-file)))
-    (if score-file 
-	(gnus-short-group-name (file-name-nondirectory score-file))
-      "none")))
-
-(defun gnus-score-adaptive ()
-  (save-excursion
-    (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
-	   (alist malist)
-	   (date (current-time-string)) 
-	   (data gnus-newsgroup-data)
-	   elem headers match)
-      ;; First we transform the adaptive rule alist into something
-      ;; that's faster to process.
-      (while malist
-	(setq elem (car malist))
-	(if (symbolp (car elem))
-	    (setcar elem (symbol-value (car elem))))
-	(setq elem (cdr elem))
-	(while elem
-	  (setcdr (car elem) 
-		  (cons (if (eq (caar elem) 'followup)
-			    "references"
-			  (symbol-name (caar elem)))
-			(cdar elem)))
-	  (setcar (car elem) 
-		  `(lambda (h)
-		     (,(intern 
-			(concat "mail-header-" 
-				(if (eq (caar elem) 'followup)
-				    "message-id"
-				  (downcase (symbol-name (caar elem))))))
-		      h)))
-	  (setq elem (cdr elem)))
-	(setq malist (cdr malist)))
-      ;; We change the score file to the adaptive score file.
-      (save-excursion
-	(set-buffer gnus-summary-buffer)
-	(gnus-score-load-file 
-	 (or gnus-newsgroup-adaptive-score-file
-	     (gnus-score-file-name 
-	      gnus-newsgroup-name gnus-adaptive-file-suffix))))
-      ;; The we score away.
-      (while data
-	(setq elem (cdr (assq (gnus-data-mark (car data)) alist)))
-	(if (or (not elem)
-		(gnus-data-pseudo-p (car data)))
-	    ()
-	  (when (setq headers (gnus-data-header (car data)))
-	    (while elem 
-	      (setq match (funcall (caar elem) headers))
-	      (gnus-summary-score-entry 
-	       (nth 1 (car elem)) match
-	       (cond
-		((numberp match)
-		 '=)
-		((equal (nth 1 (car elem)) "date")
-		 'a)
-		(t
-		 ;; Whether we use substring or exact matches are controlled
-		 ;; here.  
-		 (if (or (not gnus-score-exact-adapt-limit)
-			 (< (length match) gnus-score-exact-adapt-limit))
-		     'e 
-		   (if (equal (nth 1 (car elem)) "subject")
-		       'f 's))))
-	       (nth 2 (car elem)) date nil t)
-	      (setq elem (cdr elem)))))
-	(setq data (cdr data))))))
-
-(defun gnus-score-edit-done ()
-  (let ((bufnam (buffer-file-name (current-buffer)))
-	(winconf gnus-prev-winconf))
-    (and winconf (set-window-configuration winconf))
-    (gnus-score-remove-from-cache bufnam)
-    (gnus-score-load-file bufnam)))
-
-(defun gnus-score-find-trace ()
-  "Find all score rules that applies to the current article."
-  (interactive)
-  (let ((gnus-newsgroup-headers
-	 (list (gnus-summary-article-header)))
-	(gnus-newsgroup-scored nil)
-	(buf (current-buffer))
-	trace)
-    (when (get-buffer "*Gnus Scores*")
-      (save-excursion
-	(set-buffer "*Gnus Scores*")
-	(erase-buffer)))
-    (setq gnus-score-trace nil)
-    (gnus-possibly-score-headers 'trace)
-    (if (not (setq trace gnus-score-trace))
-	(gnus-error 1 "No score rules apply to the current article.")
-      (pop-to-buffer "*Gnus Scores*")
-      (gnus-add-current-to-buffer-list)
-      (erase-buffer)
-      (while trace
-	(insert (format "%S  ->  %s\n" (cdar trace)
-			(file-name-nondirectory (caar trace))))
-	(setq trace (cdr trace)))
-      (goto-char (point-min))
-      (pop-to-buffer buf))))
-
-(defun gnus-summary-rescore ()
-  "Redo the entire scoring process in the current summary."
-  (interactive)
-  (gnus-score-save)
-  (setq gnus-score-cache nil)
-  (setq gnus-newsgroup-scored nil)
-  (gnus-possibly-score-headers)
-  (gnus-score-update-all-lines))
-  
-(defun gnus-score-flush-cache ()
-  "Flush the cache of score files."
-  (interactive)
-  (gnus-score-save)
-  (setq gnus-score-cache nil
-	gnus-score-alist nil
-	gnus-short-name-score-file-cache nil)
-  (gnus-message 6 "The score cache is now flushed"))
-
-(gnus-add-shutdown 'gnus-score-close 'gnus)
-
-(defvar gnus-score-file-alist-cache nil)
-
-(defun gnus-score-close ()
-  "Clear all internal score variables."
-  (setq gnus-score-cache nil
-	gnus-internal-global-score-files nil
-	gnus-score-file-list nil
-	gnus-score-file-alist-cache nil))
-
-;; Summary score marking commands.
-
-(defun gnus-summary-raise-same-subject-and-select (score)
-  "Raise articles which has the same subject with SCORE and select the next."
-  (interactive "p")
-  (let ((subject (gnus-summary-article-subject)))
-    (gnus-summary-raise-score score)
-    (while (gnus-summary-find-subject subject)
-      (gnus-summary-raise-score score))
-    (gnus-summary-next-article t)))
-
-(defun gnus-summary-raise-same-subject (score)
-  "Raise articles which has the same subject with SCORE."
-  (interactive "p")
-  (let ((subject (gnus-summary-article-subject)))
-    (gnus-summary-raise-score score)
-    (while (gnus-summary-find-subject subject)
-      (gnus-summary-raise-score score))
-    (gnus-summary-next-subject 1 t)))
-
-(defun gnus-score-default (level)
-  (if level (prefix-numeric-value level) 
-    gnus-score-interactive-default-score))
-
-(defun gnus-summary-raise-thread (&optional score)
-  "Raise the score of the articles in the current thread with SCORE."
-  (interactive "P")
-  (setq score (gnus-score-default score))
-  (let (e)
-    (save-excursion
-      (let ((articles (gnus-summary-articles-in-thread)))
-	(while articles
-	  (gnus-summary-goto-subject (car articles))
-	  (gnus-summary-raise-score score)
-	  (setq articles (cdr articles))))
-      (setq e (point)))
-    (let ((gnus-summary-check-current t))
-      (or (zerop (gnus-summary-next-subject 1 t))
-	  (goto-char e))))
-  (gnus-summary-recenter)
-  (gnus-summary-position-point)
-  (gnus-set-mode-line 'summary))
-
-(defun gnus-summary-lower-same-subject-and-select (score)
-  "Raise articles which has the same subject with SCORE and select the next."
-  (interactive "p")
-  (gnus-summary-raise-same-subject-and-select (- score)))
-
-(defun gnus-summary-lower-same-subject (score)
-  "Raise articles which has the same subject with SCORE."
-  (interactive "p")
-  (gnus-summary-raise-same-subject (- score)))
-
-(defun gnus-summary-lower-thread (&optional score)
-  "Lower score of articles in the current thread with SCORE."
-  (interactive "P")
-  (gnus-summary-raise-thread (- (1- (gnus-score-default score)))))
-
-;;; Finding score files. 
-
-(defun gnus-score-score-files (group)
-  "Return a list of all possible score files."
-  ;; Search and set any global score files.
-  (and gnus-global-score-files 
-       (or gnus-internal-global-score-files
-	   (gnus-score-search-global-directories gnus-global-score-files)))
-  ;; Fix the kill-file dir variable.
-  (setq gnus-kill-files-directory 
-	(file-name-as-directory gnus-kill-files-directory))
-  ;; If we can't read it, there are no score files.
-  (if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
-      (setq gnus-score-file-list nil)
-    (if (not (gnus-use-long-file-name 'not-score))
-	;; We do not use long file names, so we have to do some
-	;; directory traversing.  
-	(setq gnus-score-file-list 
-	      (cons nil 
-		    (or gnus-short-name-score-file-cache
-			(prog2
-			    (gnus-message 6 "Finding all score files...")
-			    (setq gnus-short-name-score-file-cache
-				  (gnus-score-score-files-1
-				   gnus-kill-files-directory))
-			  (gnus-message 6 "Finding all score files...done")))))
-      ;; We want long file names.
-      (when (or (not gnus-score-file-list)
-		(not (car gnus-score-file-list))
-		(gnus-file-newer-than gnus-kill-files-directory
-				      (car gnus-score-file-list)))
-	(setq gnus-score-file-list 
-	      (cons (nth 5 (file-attributes gnus-kill-files-directory))
-		    (nreverse 
-		     (directory-files 
-		      gnus-kill-files-directory t 
-		      (gnus-score-file-regexp)))))))
-    (cdr gnus-score-file-list)))
-
-(defun gnus-score-score-files-1 (dir)
-  "Return all possible score files under DIR."
-  (let ((files (directory-files (expand-file-name dir) t nil t))
-	(regexp (gnus-score-file-regexp))
-	out file)
-    (while (setq file (pop files))
-      (cond 
-       ;; Ignore "." and "..".
-       ((member (file-name-nondirectory file) '("." ".."))
-	nil)
-       ;; Recurse down directories.
-       ((file-directory-p file)
-	(setq out (nconc (gnus-score-score-files-1 file) out)))
-       ;; Add files to the list of score files.
-       ((string-match regexp file)
-	(push file out))))
-    (or out
-	;; Return a dummy value.
-	(list "~/News/this.file.does.not.exist.SCORE"))))
-       
-(defun gnus-score-file-regexp ()
-  "Return a regexp that match all score files."
-  (concat "\\(" (regexp-quote gnus-score-file-suffix )
-	  "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'"))
-	
-(defun gnus-score-find-bnews (group)
-  "Return a list of score files for GROUP.
-The score files are those files in the ~/News/ directory which matches
-GROUP using BNews sys file syntax."
-  (let* ((sfiles (append (gnus-score-score-files group)
-			 gnus-internal-global-score-files))
-	 (kill-dir (file-name-as-directory 
-		    (expand-file-name gnus-kill-files-directory)))
-	 (klen (length kill-dir))
-	 (score-regexp (gnus-score-file-regexp))
-	 (trans (cdr (assq ?: nnheader-file-name-translation-alist)))
-	 ofiles not-match regexp)
-    (save-excursion
-      (set-buffer (get-buffer-create "*gnus score files*"))
-      (buffer-disable-undo (current-buffer))
-      ;; Go through all score file names and create regexp with them
-      ;; as the source.  
-      (while sfiles
-	(erase-buffer)
-	(insert (car sfiles))
-	(goto-char (point-min))
-	;; First remove the suffix itself.
-	(when (re-search-forward (concat "." score-regexp) nil t)
-	  (replace-match "" t t) 
-	  (goto-char (point-min))
-	  (if (looking-at (regexp-quote kill-dir))
-	      ;; If the file name was just "SCORE", `klen' is one character
-	      ;; too much.
-	      (delete-char (min (1- (point-max)) klen))
-	    (goto-char (point-max))
-	    (search-backward "/")
-	    (delete-region (1+ (point)) (point-min)))
-	  ;; If short file names were used, we have to translate slashes.
-	  (goto-char (point-min))
-	  (let ((regexp (concat
-			 "[/:" (if trans (char-to-string trans) "") "]")))
-	    (while (re-search-forward regexp nil t)
-	      (replace-match "." t t)))
-	  ;; Cludge to get rid of "nntp+" problems.
-	  (goto-char (point-min))
-	  (and (looking-at "nn[a-z]+\\+")
-	       (progn
-		 (search-forward "+")
-		 (forward-char -1)
-		 (insert "\\")))
-	  ;; Kludge to deal with "++".
-	  (goto-char (point-min))
-	  (while (search-forward "++" nil t)
-	    (replace-match "\\+\\+" t t))
-	  ;; Translate "all" to ".*".
-	  (goto-char (point-min))
-	  (while (search-forward "all" nil t)
-	    (replace-match ".*" t t))
-	  (goto-char (point-min))
-	  ;; Deal with "not."s.
-	  (if (looking-at "not.")
-	      (progn
-		(setq not-match t)
-		(setq regexp (buffer-substring 5 (point-max))))
-	    (setq regexp (buffer-substring 1 (point-max)))
-	    (setq not-match nil))
-	  ;; Finally - if this resulting regexp matches the group name,
-	  ;; we add this score file to the list of score files
-	  ;; applicable to this group.
-	  (if (or (and not-match
-		       (not (string-match regexp group)))
-		  (and (not not-match)
-		       (string-match regexp group)))
-	      (setq ofiles (cons (car sfiles) ofiles))))
-	(setq sfiles (cdr sfiles)))
-      (kill-buffer (current-buffer))
-      ;; Slight kludge here - the last score file returned should be
-      ;; the local score file, whether it exists or not. This is so
-      ;; that any score commands the user enters will go to the right
-      ;; file, and not end up in some global score file.
-      (let ((localscore (gnus-score-file-name group)))
-	(setq ofiles (cons localscore (delete localscore ofiles))))
-      (nreverse ofiles))))
-
-(defun gnus-score-find-single (group)
-  "Return list containing the score file for GROUP."
-  (list (or gnus-newsgroup-adaptive-score-file
-	    (gnus-score-file-name group gnus-adaptive-file-suffix))
-	(gnus-score-file-name group)))
-
-(defun gnus-score-find-hierarchical (group)
-  "Return list of score files for GROUP.
-This includes the score file for the group and all its parents."
-  (let ((all (copy-sequence '(nil)))
-	(start 0))
-    (while (string-match "\\." group (1+ start))
-      (setq start (match-beginning 0))
-      (setq all (cons (substring group 0 start) all)))
-    (setq all (cons group all))
-    (nconc
-     (mapcar (lambda (newsgroup)
-	       (gnus-score-file-name newsgroup gnus-adaptive-file-suffix))
-	     (setq all (nreverse all)))
-     (mapcar 'gnus-score-file-name all))))
-
-(defun gnus-score-find-alist (group)
-  "Return list of score files for GROUP.
-The list is determined from the variable gnus-score-file-alist."
-  (let ((alist gnus-score-file-multiple-match-alist)
-	score-files)
-    ;; if this group has been seen before, return the cached entry
-    (if (setq score-files (assoc group gnus-score-file-alist-cache))
-	(cdr score-files)		;ensures caching groups with no matches
-      ;; handle the multiple match alist
-      (while alist
-	(and (string-match (caar alist) group)
-	     (setq score-files
-		   (nconc score-files (copy-sequence (cdar alist)))))
-	(setq alist (cdr alist)))
-      (setq alist gnus-score-file-single-match-alist)
-      ;; handle the single match alist
-      (while alist
-	(and (string-match (caar alist) group)
-	     ;; progn used just in case ("regexp") has no files
-	     ;; and score-files is still nil. -sj
-	     ;; this can be construed as a "stop searching here" feature :>
-	     ;; and used to simplify regexps in the single-alist 
-	     (progn
-	       (setq score-files
-		     (nconc score-files (copy-sequence (cdar alist))))
-	       (setq alist nil)))
-	(setq alist (cdr alist)))
-      ;; cache the score files
-      (setq gnus-score-file-alist-cache
-	    (cons (cons group score-files) gnus-score-file-alist-cache))
-      score-files)))
-
-(defun gnus-possibly-score-headers (&optional trace)
-  (let ((funcs gnus-score-find-score-files-function)
-	score-files)
-    ;; Make sure funcs is a list.
-    (and funcs
-	 (not (listp funcs))
-	 (setq funcs (list funcs)))
-    ;; Get the initial score files for this group.
-    (when funcs 
-      (setq score-files (gnus-score-find-alist gnus-newsgroup-name)))
-    ;; Go through all the functions for finding score files (or actual
-    ;; scores) and add them to a list.
-    (while funcs
-      (when (gnus-functionp (car funcs))
-	(setq score-files 
-	      (nconc score-files (funcall (car funcs) gnus-newsgroup-name))))
-      (setq funcs (cdr funcs)))
-    ;; Check whether there is a `score-file' group parameter.
-    (let ((param-file (gnus-group-get-parameter 
-		       gnus-newsgroup-name 'score-file)))
-      (when param-file
-	(push param-file score-files)))
-    ;; Do the scoring if there are any score files for this group.
-    (when score-files
-      (gnus-score-headers score-files trace))))
-
-(defun gnus-score-file-name (newsgroup &optional suffix)
-  "Return the name of a score file for NEWSGROUP."
-  (let ((suffix (or suffix gnus-score-file-suffix)))
-    (nnheader-translate-file-chars
-     (cond
-      ((or (null newsgroup)
-	   (string-equal newsgroup ""))
-       ;; The global score file is placed at top of the directory.
-       (expand-file-name 
-	suffix gnus-kill-files-directory))
-      ((gnus-use-long-file-name 'not-score)
-       ;; Append ".SCORE" to newsgroup name.
-       (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
-				 "." suffix)
-			 gnus-kill-files-directory))
-      (t
-       ;; Place "SCORE" under the hierarchical directory.
-       (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
-				 "/" suffix)
-			 gnus-kill-files-directory))))))
-
-(defun gnus-score-search-global-directories (files)
-  "Scan all global score directories for score files."
-  ;; Set the variable `gnus-internal-global-score-files' to all
-  ;; available global score files.
-  (interactive (list gnus-global-score-files))
-  (let (out)
-    (while files
-      (if (string-match "/$" (car files))
-	  (setq out (nconc (directory-files 
-			    (car files) t
-			    (concat (gnus-score-file-regexp) "$"))))
-	(setq out (cons (car files) out)))
-      (setq files (cdr files)))
-    (setq gnus-internal-global-score-files out)))
-
-(defun gnus-score-default-fold-toggle ()
-  "Toggle folding for new score file entries."
-  (interactive)
-  (setq gnus-score-default-fold (not gnus-score-default-fold))
-  (if gnus-score-default-fold
-      (gnus-message 1 "New score file entries will be case insensitive.")
-    (gnus-message 1 "New score file entries will be case sensitive.")))
-
-(provide 'gnus-score)
-
-;;; gnus-score.el ends here
diff --git a/lisp/gnus-setup.el b/lisp/gnus-setup.el
deleted file mode 100644
index 20613d8bebd..00000000000
--- a/lisp/gnus-setup.el
+++ /dev/null
@@ -1,210 +0,0 @@
-;;; gnus-setup.el --- Initialization & Setup for Gnus 5
-;; Copyright (C) 1995, 96 Free Software Foundation, Inc.
-
-;; Author: Steven L. Baur <steve@miranova.com>
-;; Keywords: news
-
-;; 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:
-;; My head is starting to spin with all the different mail/news packages.
-;; Stop The Madness!
-
-;; Given that Emacs Lisp byte codes may be diverging, it is probably best
-;; not to byte compile this, and just arrange to have the .el loaded out
-;; of .emacs.
-
-;;; Code:
-
-(defvar running-xemacs (string-match "XEmacs\\|Lucid" emacs-version))
-
-(defvar gnus-emacs-lisp-directory (if running-xemacs
-				      "/usr/local/lib/xemacs/"
-				    "/usr/local/share/emacs/")
-  "Directory where Emacs site lisp is located.")
-
-(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory
-					 "gnus-5.0.15/lisp/")
-  "Directory where Gnus Emacs lisp is found.")
-
-(defvar gnus-sgnus-lisp-directory (concat gnus-emacs-lisp-directory
-					  "sgnus/lisp/")
-  "Directory where September Gnus Emacs lisp is found.")
-
-(defvar gnus-tm-lisp-directory (concat gnus-emacs-lisp-directory
-				       "site-lisp/")
-  "Directory where TM Emacs lisp is found.")
-
-(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory
-					      "site-lisp/mailcrypt-3.4/")
-  "Directory where Mailcrypt Emacs Lisp is found.")
-
-(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory
-					 "site-lisp/bbdb-1.50/")
-  "Directory where Big Brother Database is found.")
-
-(defvar gnus-use-tm t
-  "Set this if you want MIME support for Gnus")
-(defvar gnus-use-mhe nil
-  "Set this if you want to use MH-E for mail reading")
-(defvar gnus-use-rmail nil
-  "Set this if you want to use RMAIL for mail reading")
-(defvar gnus-use-sendmail t
-  "Set this if you want to use SENDMAIL for mail reading")
-(defvar gnus-use-vm nil
-  "Set this if you want to use the VM package for mail reading")
-(defvar gnus-use-sc t
-  "Set this if you want to use Supercite")
-(defvar gnus-use-mailcrypt t
-  "Set this if you want to use Mailcrypt for dealing with PGP messages")
-(defvar gnus-use-bbdb nil
-  "Set this if you want to use the Big Brother DataBase")
-(defvar gnus-use-september nil
-  "Set this if you are using the experimental September Gnus")
-
-(let ((gnus-directory (if gnus-use-september
-			  gnus-sgnus-lisp-directory
-			gnus-gnus-lisp-directory)))
-  (if (null (member gnus-directory load-path))
-      (setq load-path (cons gnus-directory load-path))))
-
-;;; Tools for MIME by
-;;; UMEDA Masanobu <umerin@mse.kyutech.ac.jp>
-;;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-
-(if gnus-use-tm
-    (progn
-      (if (null (member gnus-tm-lisp-directory load-path))
- 	  (setq load-path (cons gnus-tm-lisp-directory load-path)))
-       (load "mime-setup")))
-
-;;; Mailcrypt by
-;;; Jin Choi <jin@atype.com>
-;;; Patrick LoPresti <patl@lcs.mit.edu>
-
-(if gnus-use-mailcrypt
-    (progn
-      (if (null (member gnus-mailcrypt-lisp-directory load-path))
- 	  (setq load-path (cons gnus-mailcrypt-lisp-directory load-path)))
-      (autoload 'mc-install-write-mode "mailcrypt" nil t)
-      (autoload 'mc-install-read-mode "mailcrypt" nil t)
-      (add-hook 'message-mode-hook 'mc-install-write-mode)
-      (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode)
-      (if gnus-use-mhe
-	  (progn
-	    (add-hook 'mh-folder-mode-hook 'mc-install-read-mode)
- 	    (add-hook 'mh-letter-mode-hook 'mc-install-write-mode)))))
-
-;;; BBDB by
-;;; Jamie Zawinski <jwz@lucid.com>
-
-(if gnus-use-bbdb
-    (progn
-      (if (null (member gnus-bbdb-lisp-directory load-path))
- 	  (setq load-path (cons gnus-bbdb-lisp-directory load-path)))
-      (autoload 'bbdb "bbdb-com"
-	"Insidious Big Brother Database" t)
-      (autoload 'bbdb-name "bbdb-com"
-	"Insidious Big Brother Database" t)
-      (autoload 'bbdb-company "bbdb-com"
-	"Insidious Big Brother Database" t)
-      (autoload 'bbdb-net "bbdb-com"
-	"Insidious Big Brother Database" t)
-      (autoload 'bbdb-notes "bbdb-com"
-	"Insidious Big Brother Database" t)
-
-      (if gnus-use-vm
-	  (progn
-	    (autoload 'bbdb-insinuate-vm "bbdb-vm"
-	      "Hook BBDB into VM" t)))
-
-      (if gnus-use-rmail
-	  (progn
-	    (autoload 'bbdb-insinuate-rmail "bbdb-rmail"
-	      "Hook BBDB into RMAIL" t)
-	    (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail)))
-
-      (if gnus-use-mhe
-	  (progn
-	    (autoload 'bbdb-insinuate-mh "bbdb-mh"
-	      "Hook BBDB into MH-E" t)
-	    (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh)))
-
-      (autoload 'bbdb-insinuate-gnus "bbdb-gnus"
-	"Hook BBDB into Gnus" t)
-      (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
-
-      (if gnus-use-sendmail
-	  (progn
-	    (autoload 'bbdb-insinuate-sendmail "bbdb"
-	      "Insidious Big Brother Database" t)
-	    (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)
-	    (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail)))))
-
-(if gnus-use-sc
-    (progn
-      (add-hook 'mail-citation-hook 'sc-cite-original)
-      (setq message-cite-function 'sc-cite-original)
-      (autoload 'sc-cite-original "supercite")))
-
-;;;### (autoloads (gnus-batch-score gnus-fetch-group gnus gnus-slave gnus-no-server gnus-update-format) "gnus" "lisp/gnus.el" (12473 2137))
-;;; Generated autoloads from lisp/gnus.el
-
-(autoload 'gnus-update-format "gnus" "\
-Update the format specification near point." t nil)
-
-(autoload 'gnus-slave-no-server "gnus" "\
-Read network news as a slave without connecting to local server." t nil)
-
-(autoload 'gnus-no-server "gnus" "\
-Read network news.
-If ARG is a positive number, Gnus will use that as the
-startup level.  If ARG is nil, Gnus will be started at level 2. 
-If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use.
-As opposed to `gnus', this command will not connect to the local server." t nil)
-
-(autoload 'gnus-slave "gnus" "\
-Read news as a slave." t nil)
-
-(autoload 'gnus "gnus" "\
-Read network news.
-If ARG is non-nil and a positive number, Gnus will use that as the
-startup level.  If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use." t nil)
-
-(autoload 'gnus-fetch-group "gnus" "\
-Start Gnus if necessary and enter GROUP.
-Returns whether the fetching was successful or not." t nil)
-
-(defalias 'gnus-batch-kill 'gnus-batch-score)
-
-(autoload 'gnus-batch-score "gnus" "\
-Run batched scoring.
-Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
-Newsgroups is a list of strings in Bnews format.  If you want to score
-the comp hierarchy, you'd say \"comp.all\".  If you would not like to
-score the alt hierarchy, you'd say \"!alt.all\"." t nil)
-
-;;;***
-
-(provide 'gnus-setup)
-
-(run-hooks 'gnus-setup-load-hook)
-
-;;; gnus-setup.el ends here
diff --git a/lisp/gnus-soup.el b/lisp/gnus-soup.el
deleted file mode 100644
index c4a8fd798b9..00000000000
--- a/lisp/gnus-soup.el
+++ /dev/null
@@ -1,563 +0,0 @@
-;;; gnus-soup.el --- SOUP packet writing support for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news, mail
-
-;; 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:
-
-(require 'gnus-msg)
-(require 'gnus)
-(eval-when-compile (require 'cl))
-
-;;; User Variables:
-
-(defvar gnus-soup-directory "~/SoupBrew/"
-  "*Directory containing an unpacked SOUP packet.")
-
-(defvar gnus-soup-replies-directory (concat gnus-soup-directory "SoupReplies/")
-  "*Directory where Gnus will do processing of replies.")
-
-(defvar gnus-soup-prefix-file "gnus-prefix"
-  "*Name of the file where Gnus stores the last used prefix.")
-
-(defvar gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz"
-  "Format string command for packing a SOUP packet.
-The SOUP files will be inserted where the %s is in the string.
-This string MUST contain both %s and %d. The file number will be
-inserted where %d appears.")
-
-(defvar gnus-soup-unpacker "gunzip -c %s | tar xvf -"
-  "*Format string command for unpacking a SOUP packet.
-The SOUP packet file name will be inserted at the %s.")
-
-(defvar gnus-soup-packet-directory "~/"
-  "*Where gnus-soup will look for REPLIES packets.")
-
-(defvar gnus-soup-packet-regexp "Soupin"
-  "*Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'.")
-
-(defvar gnus-soup-ignored-headers "^Xref:"
-  "*Regexp to match headers to be removed when brewing SOUP packets.")
-
-;;; Internal Variables:
-
-(defvar gnus-soup-encoding-type ?n
-  "*Soup encoding type.
-`n' is news format, `m' is Unix mbox format, and `M' is MMDF mailbox
-format.")
-
-(defvar gnus-soup-index-type ?c
-  "*Soup index type.
-`n' means no index file and `c' means standard Cnews overview
-format.") 
-
-(defvar gnus-soup-areas nil)
-(defvar gnus-soup-last-prefix nil)
-(defvar gnus-soup-prev-prefix nil)
-(defvar gnus-soup-buffers nil)
-
-;;; Access macros:
-
-(defmacro gnus-soup-area-prefix (area)
-  `(aref ,area 0))
-(defmacro gnus-soup-set-area-prefix (area prefix)
-  `(aset ,area 0 ,prefix))
-(defmacro gnus-soup-area-name (area)
-  `(aref ,area 1))
-(defmacro gnus-soup-area-encoding (area)
-  `(aref ,area 2))
-(defmacro gnus-soup-area-description (area)
-  `(aref ,area 3))
-(defmacro gnus-soup-area-number (area)
-  `(aref ,area 4))
-(defmacro gnus-soup-area-set-number (area value)
-  `(aset ,area 4 ,value))
-
-(defmacro gnus-soup-encoding-format (encoding)
-  `(aref ,encoding 0))
-(defmacro gnus-soup-encoding-index (encoding)
-  `(aref ,encoding 1))
-(defmacro gnus-soup-encoding-kind (encoding)
-  `(aref ,encoding 2))
-
-(defmacro gnus-soup-reply-prefix (reply)
-  `(aref ,reply 0))
-(defmacro gnus-soup-reply-kind (reply)
-  `(aref ,reply 1))
-(defmacro gnus-soup-reply-encoding (reply)
-  `(aref ,reply 2))
-
-;;; Commands:
-
-(defun gnus-soup-send-replies ()
-  "Unpack and send all replies in the reply packet."
-  (interactive)
-  (let ((packets (directory-files
-		  gnus-soup-packet-directory t gnus-soup-packet-regexp)))
-    (while packets
-      (and (gnus-soup-send-packet (car packets))
-	   (delete-file (car packets)))
-      (setq packets (cdr packets)))))
-
-(defun gnus-soup-add-article (n)
-  "Add the current article to SOUP packet.
-If N is a positive number, add the N next articles.
-If N is a negative number, add the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-move those articles instead."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let* ((articles (gnus-summary-work-articles n))
-	 (tmp-buf (get-buffer-create "*soup work*"))
-	 (area (gnus-soup-area gnus-newsgroup-name))
-	 (prefix (gnus-soup-area-prefix area))
-	 headers)
-    (buffer-disable-undo tmp-buf)
-    (save-excursion
-      (while articles
-	;; Find the header of the article.
-	(set-buffer gnus-summary-buffer)
-	(when (setq headers (gnus-summary-article-header (car articles)))
-	  ;; Put the article in a buffer.
-	  (set-buffer tmp-buf)
-	  (when (gnus-request-article-this-buffer 
-		 (car articles) gnus-newsgroup-name)
-	    (save-restriction
-	      (message-narrow-to-head)
-	      (message-remove-header gnus-soup-ignored-headers t))
-	    (gnus-soup-store gnus-soup-directory prefix headers
-			     gnus-soup-encoding-type 
-			     gnus-soup-index-type)
-	    (gnus-soup-area-set-number 
-	     area (1+ (or (gnus-soup-area-number area) 0)))))
-	;; Mark article as read. 
-	(set-buffer gnus-summary-buffer)
-	(gnus-summary-remove-process-mark (car articles))
-	(gnus-summary-mark-as-read (car articles) gnus-souped-mark)
-	(setq articles (cdr articles)))
-      (kill-buffer tmp-buf))
-    (gnus-soup-save-areas)))
-
-(defun gnus-soup-pack-packet ()
-  "Make a SOUP packet from the SOUP areas."
-  (interactive)
-  (gnus-soup-read-areas)
-  (gnus-soup-pack gnus-soup-directory gnus-soup-packer))
-
-(defun gnus-group-brew-soup (n)
-  "Make a soup packet from the current group.
-Uses the process/prefix convention."
-  (interactive "P")
-  (let ((groups (gnus-group-process-prefix n)))
-    (while groups
-      (gnus-group-remove-mark (car groups))
-      (gnus-soup-group-brew (car groups) t)
-      (setq groups (cdr groups)))
-    (gnus-soup-save-areas)))
-
-(defun gnus-brew-soup (&optional level)
-  "Go through all groups on LEVEL or less and make a soup packet."
-  (interactive "P")
-  (let ((level (or level gnus-level-subscribed))
-	(newsrc (cdr gnus-newsrc-alist)))
-    (while newsrc
-      (and (<= (nth 1 (car newsrc)) level)
-	   (gnus-soup-group-brew (caar newsrc) t))
-      (setq newsrc (cdr newsrc)))
-    (gnus-soup-save-areas)))
-
-;;;###autoload
-(defun gnus-batch-brew-soup ()
-  "Brew a SOUP packet from groups mention on the command line.
-Will use the remaining command line arguments as regular expressions
-for matching on group names.
-
-For instance, if you want to brew on all the nnml groups, as well as
-groups with \"emacs\" in the name, you could say something like:
-
-$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\""
-  (interactive)
-  )
-  
-;;; Internal Functions:
-
-;; Store the current buffer. 
-(defun gnus-soup-store (directory prefix headers format index)
-  ;; Create the directory, if needed. 
-  (or (file-directory-p directory)
-      (gnus-make-directory directory))
-  (let* ((msg-buf (find-file-noselect
-		   (concat directory prefix ".MSG")))
-	 (idx-buf (if (= index ?n)
-		      nil
-		    (find-file-noselect
-		     (concat directory prefix ".IDX"))))
-	 (article-buf (current-buffer))
-	 from head-line beg type)
-    (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
-    (buffer-disable-undo msg-buf)
-    (and idx-buf 
-	 (progn
-	   (setq gnus-soup-buffers (cons idx-buf gnus-soup-buffers))
-	   (buffer-disable-undo idx-buf)))
-    (save-excursion
-      ;; Make sure the last char in the buffer is a newline.
-      (goto-char (point-max))
-      (or (= (current-column) 0)
-	  (insert "\n"))
-      ;; Find the "from".
-      (goto-char (point-min))
-      (setq from
-	    (gnus-mail-strip-quoted-names
-	     (or (mail-fetch-field "from")
-		 (mail-fetch-field "really-from")
-		 (mail-fetch-field "sender"))))
-      (goto-char (point-min))
-      ;; Depending on what encoding is supposed to be used, we make
-      ;; a soup header. 
-      (setq head-line
-	    (cond 
-	     ((= gnus-soup-encoding-type ?n)
-	      (format "#! rnews %d\n" (buffer-size)))
-	     ((= gnus-soup-encoding-type ?m)
-	      (while (search-forward "\nFrom " nil t)
-		(replace-match "\n>From " t t))
-	      (concat "From " (or from "unknown")
-		      " " (current-time-string) "\n"))
-	     ((= gnus-soup-encoding-type ?M)
-	      "\^a\^a\^a\^a\n")
-	     (t (error "Unsupported type: %c" gnus-soup-encoding-type))))
-      ;; Insert the soup header and the article in the MSG buf.
-      (set-buffer msg-buf)
-      (goto-char (point-max))
-      (insert head-line)
-      (setq beg (point))
-      (insert-buffer-substring article-buf)
-      ;; Insert the index in the IDX buf.
-      (cond ((= index ?c)
-	     (set-buffer idx-buf)
-	     (gnus-soup-insert-idx beg headers))
-	    ((/= index ?n)
-	     (error "Unknown index type: %c" type)))
-      ;; Return the MSG buf.
-      msg-buf)))
-
-(defun gnus-soup-group-brew (group &optional not-all)
-  "Enter GROUP and add all articles to a SOUP package.
-If NOT-ALL, don't pack ticked articles."
-  (let ((gnus-expert-user t)
-	(gnus-large-newsgroup nil)
-	(entry (gnus-gethash group gnus-newsrc-hashtb)))
-    (when (or (null entry)
-	      (eq (car entry) t)
-	      (and (car entry)
-		   (> (car entry) 0))
-	      (and (not not-all)
-		   (gnus-range-length (cdr (assq 'tick (gnus-info-marks 
-							(nth 2 entry)))))))
-      (when (gnus-summary-read-group group nil t)
-	(setq gnus-newsgroup-processable
-	      (reverse
-	       (if (not not-all)
-		   (append gnus-newsgroup-marked gnus-newsgroup-unreads)
-		 gnus-newsgroup-unreads)))
-	(gnus-soup-add-article nil)
-	(gnus-summary-exit)))))
-
-(defun gnus-soup-insert-idx (offset header)
-  ;; [number subject from date id references chars lines xref]
-  (goto-char (point-max))
-  (insert
-   (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n"
-	   offset
-	   (or (mail-header-subject header) "(none)")
-	   (or (mail-header-from header) "(nobody)")
-	   (or (mail-header-date header) "")
-	   (or (mail-header-id header)
-	       (concat "soup-dummy-id-" 
-		       (mapconcat 
-			(lambda (time) (int-to-string time))
-			(current-time) "-")))
-	   (or (mail-header-references header) "")
-	   (or (mail-header-chars header) 0) 
-	   (or (mail-header-lines header) "0"))))
-
-(defun gnus-soup-save-areas ()
-  (gnus-soup-write-areas)
-  (save-excursion
-    (let (buf)
-      (while gnus-soup-buffers
-	(setq buf (car gnus-soup-buffers)
-	      gnus-soup-buffers (cdr gnus-soup-buffers))
-	(if (not (buffer-name buf))
-	    ()
-	  (set-buffer buf)
-	  (and (buffer-modified-p) (save-buffer))
-	  (kill-buffer (current-buffer)))))
-    (gnus-soup-write-prefixes)))
-
-(defun gnus-soup-write-prefixes ()
-  (let ((prefix gnus-soup-last-prefix))
-    (save-excursion
-      (while prefix
-	(gnus-set-work-buffer)
-	(insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdar prefix)))
-	(gnus-make-directory (caar prefix))
-	(write-region (point-min) (point-max)
-		      (concat (caar prefix) gnus-soup-prefix-file) 
-		      nil 'nomesg)
-	(setq prefix (cdr prefix))))))
-
-(defun gnus-soup-pack (dir packer)
-  (let* ((files (mapconcat 'identity
-			   '("AREAS" "*.MSG" "*.IDX" "INFO"
-			     "LIST" "REPLIES" "COMMANDS" "ERRORS")
-			   " "))
-	 (packer (if (< (string-match "%s" packer)
-			(string-match "%d" packer))
-		     (format packer files
-			     (string-to-int (gnus-soup-unique-prefix dir)))
-		   (format packer 
-			   (string-to-int (gnus-soup-unique-prefix dir))
-			   files)))
-	 (dir (expand-file-name dir)))
-    (or (file-directory-p dir)
-	(gnus-make-directory dir))
-    (setq gnus-soup-areas nil)
-    (gnus-message 4 "Packing %s..." packer)
-    (if (zerop (call-process shell-file-name
-			     nil nil nil shell-command-switch 
-			     (concat "cd " dir " ; " packer)))
-	(progn
-	  (call-process shell-file-name nil nil nil shell-command-switch 
-			(concat "cd " dir " ; rm " files))
-	  (gnus-message 4 "Packing...done" packer))
-      (error "Couldn't pack packet."))))
-
-(defun gnus-soup-parse-areas (file)
-  "Parse soup area file FILE.
-The result is a of vectors, each containing one entry from the AREA file.
-The vector contain five strings, 
-  [prefix name encoding description number]
-though the two last may be nil if they are missing."
-  (let (areas)
-    (save-excursion
-      (set-buffer (find-file-noselect file 'force))
-      (buffer-disable-undo (current-buffer))
-      (goto-char (point-min))
-      (while (not (eobp))
-	(setq areas
-	      (cons (vector (gnus-soup-field) 
-			    (gnus-soup-field)
-			    (gnus-soup-field)
-			    (and (eq (preceding-char) ?\t)
-				 (gnus-soup-field))
-			    (and (eq (preceding-char) ?\t)
-				 (string-to-int (gnus-soup-field))))
-		    areas))
-	(if (eq (preceding-char) ?\t)
-	    (beginning-of-line 2)))
-      (kill-buffer (current-buffer)))
-    areas))
-
-(defun gnus-soup-parse-replies (file)
-  "Parse soup REPLIES file FILE.
-The result is a of vectors, each containing one entry from the REPLIES
-file. The vector contain three strings, [prefix name encoding]."
-  (let (replies)
-    (save-excursion
-      (set-buffer (find-file-noselect file))
-      (buffer-disable-undo (current-buffer))
-      (goto-char (point-min))
-      (while (not (eobp))
-	(setq replies
-	      (cons (vector (gnus-soup-field) (gnus-soup-field)
-			    (gnus-soup-field))
-		    replies))
-	(if (eq (preceding-char) ?\t)
-	    (beginning-of-line 2)))
-      (kill-buffer (current-buffer)))
-    replies))
-
-(defun gnus-soup-field ()
-  (prog1
-      (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point)))
-    (forward-char 1)))
-
-(defun gnus-soup-read-areas ()
-  (or gnus-soup-areas
-      (setq gnus-soup-areas
-	    (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS")))))
-
-(defun gnus-soup-write-areas ()
-  "Write the AREAS file."
-  (interactive)
-  (when gnus-soup-areas
-    (nnheader-temp-write (concat gnus-soup-directory "AREAS")
-      (let ((areas gnus-soup-areas)
-	    area)
-	(while (setq area (pop areas))
-	  (insert
-	   (format 
-	    "%s\t%s\t%s%s\n"
-	    (gnus-soup-area-prefix area)
-	    (gnus-soup-area-name area) 
-	    (gnus-soup-area-encoding area)
-	    (if (or (gnus-soup-area-description area) 
-		    (gnus-soup-area-number area))
-		(concat "\t" (or (gnus-soup-area-description
-				  area) "")
-			(if (gnus-soup-area-number area)
-			    (concat "\t" (int-to-string 
-					  (gnus-soup-area-number area)))
-			  "")) ""))))))))
-
-(defun gnus-soup-write-replies (dir areas)
-  "Write a REPLIES file in DIR containing AREAS."
-  (nnheader-temp-write (concat dir "REPLIES")
-    (let (area)
-      (while (setq area (pop areas))
-	(insert (format "%s\t%s\t%s\n"
-			(gnus-soup-reply-prefix area)
-			(gnus-soup-reply-kind area) 
-			(gnus-soup-reply-encoding area)))))))
-
-(defun gnus-soup-area (group)
-  (gnus-soup-read-areas)
-  (let ((areas gnus-soup-areas)
-	(real-group (gnus-group-real-name group))
-	area result)
-    (while areas
-      (setq area (car areas)
-	    areas (cdr areas))
-      (if (equal (gnus-soup-area-name area) real-group)
-	  (setq result area)))
-    (or result
-	(setq result
-	      (vector (gnus-soup-unique-prefix)
-		      real-group 
-		      (format "%c%c%c"
-			      gnus-soup-encoding-type
-			      gnus-soup-index-type
-			      (if (gnus-member-of-valid 'mail group) ?m ?n))
-		      nil nil)
-	      gnus-soup-areas (cons result gnus-soup-areas)))
-    result))
-
-(defun gnus-soup-unique-prefix (&optional dir)
-  (let* ((dir (file-name-as-directory (or dir gnus-soup-directory)))
-	 (entry (assoc dir gnus-soup-last-prefix))
-	 gnus-soup-prev-prefix)
-    (if entry
-	()
-      (and (file-exists-p (concat dir gnus-soup-prefix-file))
-	   (condition-case nil
-	       (load (concat dir gnus-soup-prefix-file) nil t t)
-	     (error nil)))
-      (setq gnus-soup-last-prefix 
-	    (cons (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
-		  gnus-soup-last-prefix)))
-    (setcdr entry (1+ (cdr entry)))
-    (gnus-soup-write-prefixes)
-    (int-to-string (cdr entry))))
-
-(defun gnus-soup-unpack-packet (dir unpacker packet)
-  "Unpack PACKET into DIR using UNPACKER.
-Return whether the unpacking was successful."
-  (gnus-make-directory dir)
-  (gnus-message 4 "Unpacking: %s" (format unpacker packet))
-  (prog1
-      (zerop (call-process
-	      shell-file-name nil nil nil shell-command-switch
-	      (format "cd %s ; %s" (expand-file-name dir) 
-		      (format unpacker packet))))
-    (gnus-message 4 "Unpacking...done")))
-
-(defun gnus-soup-send-packet (packet)
-  (gnus-soup-unpack-packet 
-   gnus-soup-replies-directory gnus-soup-unpacker packet)
-  (let ((replies (gnus-soup-parse-replies 
-		  (concat gnus-soup-replies-directory "REPLIES"))))
-    (save-excursion
-      (while replies
-	(let* ((msg-file (concat gnus-soup-replies-directory
-				 (gnus-soup-reply-prefix (car replies))
-				 ".MSG"))
-	       (msg-buf (and (file-exists-p msg-file)
-			     (find-file-noselect msg-file)))
-	       (tmp-buf (get-buffer-create " *soup send*"))
-	       beg end)
-	  (cond 
-	   ((/= (gnus-soup-encoding-format 
-		 (gnus-soup-reply-encoding (car replies))) ?n)
-	    (error "Unsupported encoding"))
-	   ((null msg-buf)
-	    t)
-	   (t
-	    (buffer-disable-undo msg-buf)
-	    (buffer-disable-undo tmp-buf)
-	    (set-buffer msg-buf)
-	    (goto-char (point-min))
-	    (while (not (eobp))
-	      (or (looking-at "#! *rnews +\\([0-9]+\\)")
-		  (error "Bad header."))
-	      (forward-line 1)
-	      (setq beg (point)
-		    end (+ (point) (string-to-int 
-				    (buffer-substring 
-				     (match-beginning 1) (match-end 1)))))
-	      (switch-to-buffer tmp-buf)
-	      (erase-buffer)
-	      (insert-buffer-substring msg-buf beg end)
-	      (goto-char (point-min))
-	      (search-forward "\n\n")
-	      (forward-char -1)
-	      (insert mail-header-separator)
-	      (setq message-newsreader (setq message-mailer
-					     (gnus-extended-version)))
-	      (cond 
-	       ((string= (gnus-soup-reply-kind (car replies)) "news")
-		(gnus-message 5 "Sending news message to %s..."
-			      (mail-fetch-field "newsgroups"))
-		(sit-for 1)
-		(funcall message-send-news-function))
-	       ((string= (gnus-soup-reply-kind (car replies)) "mail")
-		(gnus-message 5 "Sending mail to %s..."
-			 (mail-fetch-field "to"))
-		(sit-for 1)
-		(message-send-mail))
-	       (t
-		(error "Unknown reply kind")))
-	      (set-buffer msg-buf)
-	      (goto-char end))
-	    (delete-file (buffer-file-name))
-	    (kill-buffer msg-buf)
-	    (kill-buffer tmp-buf)
-	    (gnus-message 4 "Sent packet"))))
-	(setq replies (cdr replies)))
-      t)))
-		   
-(provide 'gnus-soup)
-
-;;; gnus-soup.el ends here
diff --git a/lisp/gnus-srvr.el b/lisp/gnus-srvr.el
deleted file mode 100644
index 7a29e0f7532..00000000000
--- a/lisp/gnus-srvr.el
+++ /dev/null
@@ -1,708 +0,0 @@
-;;; gnus-srvr.el --- virtual server support for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'gnus)
-(eval-when-compile (require 'cl))
-
-(defvar gnus-server-mode-hook nil
-  "Hook run in `gnus-server-mode' buffers.")
-
-(defconst gnus-server-line-format "     {%(%h:%w%)} %s\n"
-  "Format of server lines.
-It works along the same lines as a normal formatting string,
-with some simple extensions.")
-
-(defvar gnus-server-mode-line-format "Gnus  List of servers"
-  "The format specification for the server mode line.")
-
-(defvar gnus-server-exit-hook nil
-  "*Hook run when exiting the server buffer.")
-
-;;; Internal variables.
-
-(defvar gnus-inserted-opened-servers nil)
-
-(defvar gnus-server-line-format-alist
-  `((?h how ?s)
-    (?n name ?s)
-    (?w where ?s)
-    (?s status ?s)))
-
-(defvar gnus-server-mode-line-format-alist 
-  `((?S news-server ?s)
-    (?M news-method ?s)
-    (?u user-defined ?s)))
-
-(defvar gnus-server-line-format-spec nil)
-(defvar gnus-server-mode-line-format-spec nil)
-(defvar gnus-server-killed-servers nil)
-
-(defvar gnus-server-mode-map)
-
-(defvar gnus-server-menu-hook nil
-  "*Hook run after the creation of the server mode menu.")
-
-(defun gnus-server-make-menu-bar ()
-  (gnus-visual-turn-off-edit-menu 'server)
-  (unless (boundp 'gnus-server-server-menu)
-    (easy-menu-define
-     gnus-server-server-menu gnus-server-mode-map ""
-     '("Server"
-       ["Add" gnus-server-add-server t]
-       ["Browse" gnus-server-read-server t]
-       ["List" gnus-server-list-servers t]
-       ["Kill" gnus-server-kill-server t]
-       ["Yank" gnus-server-yank-server t]
-       ["Copy" gnus-server-copy-server t]
-       ["Edit" gnus-server-edit-server t]
-       ["Exit" gnus-server-exit t]
-       ))
-
-    (easy-menu-define
-     gnus-server-connections-menu gnus-server-mode-map ""
-     '("Connections"
-       ["Open" gnus-server-open-server t]
-       ["Close" gnus-server-close-server t]
-       ["Deny" gnus-server-deny-server t]
-       ["Reset" gnus-server-remove-denials t]
-       ))
-
-    (run-hooks 'gnus-server-menu-hook)))
-
-(defvar gnus-server-mode-map nil)
-(put 'gnus-server-mode 'mode-class 'special)
-
-(unless gnus-server-mode-map
-  (setq gnus-server-mode-map (make-sparse-keymap))
-  (suppress-keymap gnus-server-mode-map)
-
-  (gnus-define-keys
-   gnus-server-mode-map
-   " " gnus-server-read-server
-   "\r" gnus-server-read-server
-   gnus-mouse-2 gnus-server-pick-server
-   "q" gnus-server-exit
-   "l" gnus-server-list-servers
-   "k" gnus-server-kill-server
-   "y" gnus-server-yank-server
-   "c" gnus-server-copy-server
-   "a" gnus-server-add-server
-   "e" gnus-server-edit-server
-
-   "O" gnus-server-open-server
-   "C" gnus-server-close-server
-   "D" gnus-server-deny-server
-   "R" gnus-server-remove-denials
-
-    "\C-c\C-i" gnus-info-find-node))
-
-(defun gnus-server-mode ()
-  "Major mode for listing and editing servers.
-
-All normal editing commands are switched off.
-\\<gnus-server-mode-map>
-For more in-depth information on this mode, read the manual 
-(`\\[gnus-info-find-node]'). 
-
-The following commands are available:
-
-\\{gnus-server-mode-map}"
-  (interactive)
-  (when (and menu-bar-mode
-	     (gnus-visual-p 'server-menu 'menu))
-    (gnus-server-make-menu-bar))
-  (kill-all-local-variables)
-  (gnus-simplify-mode-line)
-  (setq major-mode 'gnus-server-mode)
-  (setq mode-name "Server")
-					;  (gnus-group-set-mode-line)
-  (setq mode-line-process nil)
-  (use-local-map gnus-server-mode-map)
-  (buffer-disable-undo (current-buffer))
-  (setq truncate-lines t)
-  (setq buffer-read-only t)
-  (run-hooks 'gnus-server-mode-hook))
-
-(defun gnus-server-insert-server-line (name method)
-  (let* ((how (car method))
-	 (where (nth 1 method))
-	 (elem (assoc method gnus-opened-servers))
-	 (status (cond ((eq (nth 1 elem) 'denied)
-			"(denied)")
-		       ((or (gnus-server-opened method)
-			    (eq (nth 1 elem) 'ok))
-			"(opened)")
-		       (t
-			"(closed)"))))
-    (beginning-of-line)
-    (gnus-add-text-properties
-     (point)
-     (prog1 (1+ (point))
-       ;; Insert the text.
-       (eval gnus-server-line-format-spec))
-     (list 'gnus-server (intern name)))))
-
-(defun gnus-enter-server-buffer ()
-  "Set up the server buffer."
-  (gnus-server-setup-buffer)
-  (gnus-configure-windows 'server)
-  (gnus-server-prepare))
-
-(defun gnus-server-setup-buffer ()
-  "Initialize the server buffer."
-  (unless (get-buffer gnus-server-buffer)
-    (save-excursion
-      (set-buffer (get-buffer-create gnus-server-buffer))
-      (gnus-server-mode)
-      (when gnus-carpal 
-	(gnus-carpal-setup-buffer 'server)))))
-
-(defun gnus-server-prepare ()
-  (setq gnus-server-mode-line-format-spec 
-	(gnus-parse-format gnus-server-mode-line-format 
-			   gnus-server-mode-line-format-alist))
-  (setq gnus-server-line-format-spec 
-	(gnus-parse-format gnus-server-line-format 
-			   gnus-server-line-format-alist t))
-  (let ((alist gnus-server-alist)
-	(buffer-read-only nil)
-	(opened gnus-opened-servers)
-	done server op-ser)
-    (erase-buffer)
-    (setq gnus-inserted-opened-servers nil)
-    ;; First we do the real list of servers.
-    (while alist
-      (push (cdr (setq server (pop alist))) done)
-      (when (and server (car server) (cdr server))
-	(gnus-server-insert-server-line (car server) (cdr server))))
-    ;; Then we insert the list of servers that have been opened in
-    ;; this session.
-    (while opened 
-      (unless (member (caar opened) done)
-	(gnus-server-insert-server-line 
-	 (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
-	 (caar opened))
-	(push (list op-ser (caar opened)) gnus-inserted-opened-servers))
-      (setq opened (cdr opened))))
-  (goto-char (point-min))
-  (gnus-server-position-point))
-
-(defun gnus-server-server-name ()
-  (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server)))
-    (and server (symbol-name server))))
-
-(defalias 'gnus-server-position-point 'gnus-goto-colon)
-
-(defconst gnus-server-edit-buffer "*Gnus edit server*")
-
-(defun gnus-server-update-server (server)
-  (save-excursion
-    (set-buffer gnus-server-buffer)
-    (let* ((buffer-read-only nil)
-	   (entry (assoc server gnus-server-alist))
-	   (oentry (assoc (gnus-server-to-method server)
-			  gnus-opened-servers)))
-      (when entry
-	(gnus-dribble-enter 
-	 (concat "(gnus-server-set-info \"" server "\" '"
-		 (prin1-to-string (cdr entry)) ")")))
-      (when (or entry oentry)
-	;; Buffer may be narrowed.
-	(save-restriction
-	  (widen)
-	  (when (gnus-server-goto-server server)
-	    (gnus-delete-line))
-	  (if entry
-	      (gnus-server-insert-server-line (car entry) (cdr entry))
-	    (gnus-server-insert-server-line 
-	     (format "%s:%s" (caar oentry) (nth 1 (car oentry)))
-	     (car oentry)))
-	  (gnus-server-position-point))))))
-
-(defun gnus-server-set-info (server info)
-  ;; Enter a select method into the virtual server alist.
-  (when (and server info)
-    (gnus-dribble-enter 
-     (concat "(gnus-server-set-info \"" server "\" '"
-	     (prin1-to-string info) ")"))
-    (let* ((server (nth 1 info))
-	   (entry (assoc server gnus-server-alist)))
-      (if entry (setcdr entry info)
-	(setq gnus-server-alist
-	      (nconc gnus-server-alist (list (cons server info))))))))
-
-;;; Interactive server functions.
-
-(defun gnus-server-kill-server (server)
-  "Kill the server on the current line."
-  (interactive (list (gnus-server-server-name)))
-  (unless (gnus-server-goto-server server)
-    (if server (error "No such server: %s" server)
-      (error "No server on the current line")))
-  (unless (assoc server gnus-server-alist)
-    (error "Read-only server %s" server))
-  (gnus-dribble-enter "")
-  (let ((buffer-read-only nil))
-    (gnus-delete-line))
-  (setq gnus-server-killed-servers 
-	(cons (assoc server gnus-server-alist) gnus-server-killed-servers))
-  (setq gnus-server-alist (delq (car gnus-server-killed-servers)
-				gnus-server-alist))
-  (gnus-server-position-point))
-
-(defun gnus-server-yank-server ()
-  "Yank the previously killed server."
-  (interactive)
-  (or gnus-server-killed-servers
-      (error "No killed servers to be yanked"))
-  (let ((alist gnus-server-alist)
-	(server (gnus-server-server-name))
-	(killed (car gnus-server-killed-servers)))
-    (if (not server) 
-	(setq gnus-server-alist (nconc gnus-server-alist (list killed)))
-      (if (string= server (caar gnus-server-alist))
-	  (setq gnus-server-alist (cons killed gnus-server-alist))
-	(while (and (cdr alist)
-		    (not (string= server (caadr alist))))
-	  (setq alist (cdr alist)))
-	(if alist
-	    (setcdr alist (cons killed (cdr alist)))
- 	  (setq gnus-server-alist (list killed)))))
-    (gnus-server-update-server (car killed))
-    (setq gnus-server-killed-servers (cdr gnus-server-killed-servers))
-    (gnus-server-position-point)))
-
-(defun gnus-server-exit ()
-  "Return to the group buffer."
-  (interactive)
-  (kill-buffer (current-buffer))
-  (switch-to-buffer gnus-group-buffer)
-  (run-hooks 'gnus-server-exit-hook))
-
-(defun gnus-server-list-servers ()
-  "List all available servers."
-  (interactive)
-  (let ((cur (gnus-server-server-name)))
-    (gnus-server-prepare)
-    (if cur (gnus-server-goto-server cur)
-      (goto-char (point-max))
-      (forward-line -1))
-    (gnus-server-position-point)))
-
-(defun gnus-server-set-status (method status)
-  "Make METHOD have STATUS."
-  (let ((entry (assoc method gnus-opened-servers)))
-    (if entry
-	(setcar (cdr entry) status)
-      (push (list method status) gnus-opened-servers))))
-
-(defun gnus-opened-servers-remove (method)
-  "Remove METHOD from the list of opened servers."
-  (setq gnus-opened-servers (delq (assoc method gnus-opened-servers)
-				  gnus-opened-servers)))
-
-(defun gnus-server-open-server (server)
-  "Force an open of SERVER."
-  (interactive (list (gnus-server-server-name)))
-  (let ((method (gnus-server-to-method server)))
-    (or method (error "No such server: %s" server))
-    (gnus-server-set-status method 'ok)
-    (prog1
-	(or (gnus-open-server method)
-	    (progn (message "Couldn't open %s" server) nil))
-      (gnus-server-update-server server)
-      (gnus-server-position-point))))
-
-(defun gnus-server-close-server (server)
-  "Close SERVER."
-  (interactive (list (gnus-server-server-name)))
-  (let ((method (gnus-server-to-method server)))
-    (or method (error "No such server: %s" server))
-    (gnus-server-set-status method 'closed)
-    (prog1
-	(gnus-close-server method)
-      (gnus-server-update-server server)
-      (gnus-server-position-point))))
-
-(defun gnus-server-deny-server (server)
-  "Make sure SERVER will never be attempted opened."
-  (interactive (list (gnus-server-server-name)))
-  (let ((method (gnus-server-to-method server)))
-    (or method (error "No such server: %s" server))
-    (gnus-server-set-status method 'denied))
-  (gnus-server-update-server server)
-  (gnus-server-position-point)
-  t)
-
-(defun gnus-server-remove-denials ()
-  "Make all denied servers into closed servers."
-  (interactive)
-  (let ((servers gnus-opened-servers))
-    (while servers
-      (when (eq (nth 1 (car servers)) 'denied)
-	(setcar (nthcdr 1 (car servers)) 'closed))
-      (setq servers (cdr servers))))
-  (gnus-server-list-servers))
-
-(defun gnus-server-copy-server (from to)
-  (interactive
-   (list
-    (or (gnus-server-server-name)
-	(error "No server on the current line"))
-    (read-string "Copy to: ")))
-  (or from (error "No server on current line"))
-  (or (and to (not (string= to ""))) (error "No name to copy to"))
-  (and (assoc to gnus-server-alist) (error "%s already exists" to))
-  (or (assoc from gnus-server-alist) 
-      (error "%s: no such server" from))
-  (let ((to-entry (gnus-copy-sequence (assoc from gnus-server-alist))))
-    (setcar to-entry to)
-    (setcar (nthcdr 2 to-entry) to)
-    (setq gnus-server-killed-servers 
-	  (cons to-entry gnus-server-killed-servers))
-    (gnus-server-yank-server)))
-
-(defun gnus-server-add-server (how where)
-  (interactive 
-   (list (intern (completing-read "Server method: "
-				  gnus-valid-select-methods nil t))
-	 (read-string "Server name: ")))
-  (setq gnus-server-killed-servers 
-	(cons (list where how where) gnus-server-killed-servers))
-  (gnus-server-yank-server))
-
-(defun gnus-server-goto-server (server)
-  "Jump to a server line."
-  (interactive
-   (list (completing-read "Goto server: " gnus-server-alist nil t)))
-  (let ((to (text-property-any (point-min) (point-max) 
-			       'gnus-server (intern server))))
-    (and to
-	 (progn
-	   (goto-char to) 
-	   (gnus-server-position-point)))))
-
-(defun gnus-server-edit-server (server)
-  "Edit the server on the current line."
-  (interactive (list (gnus-server-server-name)))
-  (unless server
-    (error "No server on current line"))
-  (unless (assoc server gnus-server-alist)
-    (error "This server can't be edited"))
-  (let ((winconf (current-window-configuration))
-	(info (cdr (assoc server gnus-server-alist))))
-    (gnus-close-server info)
-    (get-buffer-create gnus-server-edit-buffer)
-    (gnus-configure-windows 'edit-server)
-    (gnus-add-current-to-buffer-list)
-    (emacs-lisp-mode)
-    (make-local-variable 'gnus-prev-winconf)
-    (setq gnus-prev-winconf winconf)
-    (use-local-map (copy-keymap (current-local-map)))
-    (let ((done-func '(lambda () 
-			"Exit editing mode and update the information."
-			(interactive)
-			(gnus-server-edit-server-done 'group))))
-      (setcar (cdr (nth 4 done-func)) server)
-      (local-set-key "\C-c\C-c" done-func))
-    (erase-buffer)
-    (insert ";; Type `C-c C-c' after you have edited the server.\n\n")
-    (insert (pp-to-string info))))
-
-(defun gnus-server-edit-server-done (server)
-  (interactive)
-  (set-buffer (get-buffer-create gnus-server-edit-buffer))
-  (goto-char (point-min))
-  (let ((form (read (current-buffer)))
-	(winconf gnus-prev-winconf))
-    (gnus-server-set-info server form)
-    (kill-buffer (current-buffer))
-    (and winconf (set-window-configuration winconf))
-    (set-buffer gnus-server-buffer)
-    (gnus-server-update-server server)
-    (gnus-server-list-servers)
-    (gnus-server-position-point)))
-
-(defun gnus-server-read-server (server)
-  "Browse a server."
-  (interactive (list (gnus-server-server-name)))
-  (let ((buf (current-buffer)))
-    (prog1
-	(gnus-browse-foreign-server (gnus-server-to-method server) buf)
-      (save-excursion
-	(set-buffer buf)
-	(gnus-server-update-server (gnus-server-server-name))
-	(gnus-server-position-point)))))
-    
-(defun gnus-server-pick-server (e)
-  (interactive "e")
-  (mouse-set-point e)
-  (gnus-server-read-server (gnus-server-server-name)))
-
-
-;;;
-;;; Browse Server Mode
-;;;
-
-(defvar gnus-browse-menu-hook nil
-  "*Hook run after the creation of the browse mode menu.")
-
-(defvar gnus-browse-mode-hook nil)
-(defvar gnus-browse-mode-map nil)
-(put 'gnus-browse-mode 'mode-class 'special)
-
-(unless gnus-browse-mode-map
-  (setq gnus-browse-mode-map (make-keymap))
-  (suppress-keymap gnus-browse-mode-map)
-
-  (gnus-define-keys
-   gnus-browse-mode-map
-   " " gnus-browse-read-group
-   "=" gnus-browse-select-group
-   "n" gnus-browse-next-group
-   "p" gnus-browse-prev-group
-   "\177" gnus-browse-prev-group
-   "N" gnus-browse-next-group
-   "P" gnus-browse-prev-group
-   "\M-n" gnus-browse-next-group
-   "\M-p" gnus-browse-prev-group
-   "\r" gnus-browse-select-group
-   "u" gnus-browse-unsubscribe-current-group
-   "l" gnus-browse-exit
-   "L" gnus-browse-exit
-   "q" gnus-browse-exit
-   "Q" gnus-browse-exit
-   "\C-c\C-c" gnus-browse-exit
-   "?" gnus-browse-describe-briefly
-
-   "\C-c\C-i" gnus-info-find-node))
-
-(defun gnus-browse-make-menu-bar ()
-  (gnus-visual-turn-off-edit-menu 'browse)
-  (or
-   (boundp 'gnus-browse-menu)
-   (progn
-     (easy-menu-define
-      gnus-browse-menu gnus-browse-mode-map ""
-      '("Browse"
-	["Subscribe" gnus-browse-unsubscribe-current-group t]
-	["Read" gnus-browse-read-group t]
-	["Select" gnus-browse-read-group t]
-	["Next" gnus-browse-next-group t]
-	["Prev" gnus-browse-next-group t]
-	["Exit" gnus-browse-exit t]
-	))
-      (run-hooks 'gnus-browse-menu-hook))))
-
-(defvar gnus-browse-current-method nil)
-(defvar gnus-browse-return-buffer nil)
-
-(defvar gnus-browse-buffer "*Gnus Browse Server*")
-
-(defun gnus-browse-foreign-server (method &optional return-buffer)
-  "Browse the server METHOD."
-  (setq gnus-browse-current-method method)
-  (setq gnus-browse-return-buffer return-buffer)
-  (let ((gnus-select-method method)
-	groups group)
-    (gnus-message 5 "Connecting to %s..." (nth 1 method))
-    (cond
-     ((not (gnus-check-server method))
-      (gnus-message
-       1 "Unable to contact server: %s" (gnus-status-message method))
-      nil)
-     ((not (gnus-request-list method))
-      (gnus-message
-       1 "Couldn't request list: %s" (gnus-status-message method))
-      nil)
-     (t
-      (get-buffer-create gnus-browse-buffer)
-      (gnus-add-current-to-buffer-list)
-      (and gnus-carpal (gnus-carpal-setup-buffer 'browse))
-      (gnus-configure-windows 'browse)
-      (buffer-disable-undo (current-buffer))
-      (let ((buffer-read-only nil))
-	(erase-buffer))
-      (gnus-browse-mode)
-      (setq mode-line-buffer-identification
-	    (list
-	     (format
-	      "Gnus: %%b {%s:%s}" (car method) (cadr method))))
-      (save-excursion
-	(set-buffer nntp-server-buffer)
-	(let ((cur (current-buffer)))
-	  (goto-char (point-min))
-	  (or (string= gnus-ignored-newsgroups "")
-	      (delete-matching-lines gnus-ignored-newsgroups))
-	  (while (re-search-forward
-		  "\\(^[^ \t]+\\)[ \t]+[0-9]+[ \t]+[0-9]+" nil t)
-	    (goto-char (match-end 1))
-	    (setq groups (cons (cons (match-string 1)
-				     (max 0 (- (1+ (read cur)) (read cur))))
-			       groups)))))
-      (setq groups (sort groups
-			 (lambda (l1 l2)
-			   (string< (car l1) (car l2)))))
-      (let ((buffer-read-only nil))
-	(while groups
-	  (setq group (car groups))
-	  (insert
-	   (format "K%7d: %s\n" (cdr group) (car group)))
-	  (setq groups (cdr groups))))
-      (switch-to-buffer (current-buffer))
-      (goto-char (point-min))
-      (gnus-group-position-point)
-      (gnus-message 5 "Connecting to %s...done" (nth 1 method))
-      t))))
-
-(defun gnus-browse-mode ()
-  "Major mode for browsing a foreign server.
-
-All normal editing commands are switched off.
-
-\\<gnus-browse-mode-map>
-The only things you can do in this buffer is
-
-1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
-The group will be inserted into the group buffer upon exit from this
-buffer.
-
-2) `\\[gnus-browse-read-group]' to read a group ephemerally.
-
-3) `\\[gnus-browse-exit]' to return to the group buffer."
-  (interactive)
-  (kill-all-local-variables)
-  (when (and menu-bar-mode
-	     (gnus-visual-p 'browse-menu 'menu))
-    (gnus-browse-make-menu-bar))
-  (gnus-simplify-mode-line)
-  (setq major-mode 'gnus-browse-mode)
-  (setq mode-name "Browse Server")
-  (setq mode-line-process nil)
-  (use-local-map gnus-browse-mode-map)
-  (buffer-disable-undo (current-buffer))
-  (setq truncate-lines t)
-  (setq buffer-read-only t)
-  (run-hooks 'gnus-browse-mode-hook))
-
-(defun gnus-browse-read-group (&optional no-article)
-  "Enter the group at the current line."
-  (interactive)
-  (let ((group (gnus-browse-group-name)))
-    (or (gnus-group-read-ephemeral-group
-	 group gnus-browse-current-method nil
-	 (cons (current-buffer) 'browse))
-	(error "Couldn't enter %s" group))))
-
-(defun gnus-browse-select-group ()
-  "Select the current group."
-  (interactive)
-  (gnus-browse-read-group 'no))
-
-(defun gnus-browse-next-group (n)
-  "Go to the next group."
-  (interactive "p")
-  (prog1
-      (forward-line n)
-    (gnus-group-position-point)))
-
-(defun gnus-browse-prev-group (n)
-  "Go to the next group."
-  (interactive "p")
-  (gnus-browse-next-group (- n)))
-
-(defun gnus-browse-unsubscribe-current-group (arg)
-  "(Un)subscribe to the next ARG groups."
-  (interactive "p")
-  (when (eobp)
-    (error "No group at current line."))
-  (let ((ward (if (< arg 0) -1 1))
-	(arg (abs arg)))
-    (while (and (> arg 0)
-		(not (eobp))
-		(gnus-browse-unsubscribe-group)
-		(zerop (gnus-browse-next-group ward)))
-      (decf arg))
-    (gnus-group-position-point)
-    (if (/= 0 arg) (gnus-message 7 "No more newsgroups"))
-    arg))
-
-(defun gnus-browse-group-name ()
-  (save-excursion
-    (beginning-of-line)
-    (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
-      (gnus-group-prefixed-name (match-string 1) gnus-browse-current-method))))
-
-(defun gnus-browse-unsubscribe-group ()
-  "Toggle subscription of the current group in the browse buffer."
-  (let ((sub nil)
-	(buffer-read-only nil)
-	group)
-    (save-excursion
-      (beginning-of-line)
-      ;; If this group it killed, then we want to subscribe it.
-      (if (= (following-char) ?K) (setq sub t))
-      (setq group (gnus-browse-group-name))
-      (delete-char 1)
-      (if sub
-	  (progn
-	    (gnus-group-change-level
-	     (list t group gnus-level-default-subscribed
-		   nil nil gnus-browse-current-method)
-	     gnus-level-default-subscribed gnus-level-killed
-	     (and (car (nth 1 gnus-newsrc-alist))
-		  (gnus-gethash (car (nth 1 gnus-newsrc-alist))
-				gnus-newsrc-hashtb))
-	     t)
-	    (insert ? ))
-	(gnus-group-change-level
-	 group gnus-level-killed gnus-level-default-subscribed)
-	(insert ?K)))
-    t))
-
-(defun gnus-browse-exit ()
-  "Quit browsing and return to the group buffer."
-  (interactive)
-  (when (eq major-mode 'gnus-browse-mode)
-    (kill-buffer (current-buffer)))
-  ;; Insert the newly subscribed groups in the group buffer.
-  (save-excursion
-    (set-buffer gnus-group-buffer)
-    (gnus-group-list-groups nil))
-  (if gnus-browse-return-buffer
-      (gnus-configure-windows 'server 'force)
-    (gnus-configure-windows 'group 'force)))
-
-(defun gnus-browse-describe-briefly ()
-  "Give a one line description of the group mode commands."
-  (interactive)
-  (gnus-message 6
-		(substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward  \\[gnus-group-prev-group]:Backward  \\[gnus-browse-exit]:Exit  \\[gnus-info-find-node]:Run Info  \\[gnus-browse-describe-briefly]:This help")))
-
-(provide 'gnus-srvr)
-
-;;; gnus-srvr.el ends here.
diff --git a/lisp/gnus-topic.el b/lisp/gnus-topic.el
deleted file mode 100644
index 774b149a5a4..00000000000
--- a/lisp/gnus-topic.el
+++ /dev/null
@@ -1,1057 +0,0 @@
-;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Ilja Weis <kult@uni-paderborn.de>
-;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'gnus)
-(eval-when-compile (require 'cl))
-
-(defvar gnus-topic-mode nil
-  "Minor mode for Gnus group buffers.")
-
-(defvar gnus-topic-mode-hook nil
-  "Hook run in topic mode buffers.")
-
-(defvar gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
-  "Format of topic lines.
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%i  Indentation based on topic level.
-%n  Topic name.
-%v  Nothing if the topic is visible, \"...\" otherwise.
-%g  Number of groups in the topic.
-%a  Number of unread articles in the groups in the topic.
-%A  Number of unread articles in the groups in the topic and its subtopics.
-")
-
-(defvar gnus-topic-indent-level 2
-  "*How much each subtopic should be indented.")
-
-;; Internal variables.
-
-(defvar gnus-topic-active-topology nil)
-(defvar gnus-topic-active-alist nil)
-
-(defvar gnus-topology-checked-p nil
-  "Whether the topology has been checked in this session.")
-
-(defvar gnus-topic-killed-topics nil)
-(defvar gnus-topic-inhibit-change-level nil)
-(defvar gnus-topic-tallied-groups nil)
-
-(defconst gnus-topic-line-format-alist
-  `((?n name ?s)
-    (?v visible ?s)
-    (?i indentation ?s)
-    (?g number-of-groups ?d)
-    (?a (gnus-topic-articles-in-topic entries) ?d)
-    (?A total-number-of-articles ?d)
-    (?l level ?d)))
-
-(defvar gnus-topic-line-format-spec nil)
-
-;; Functions.
-
-(defun gnus-group-topic-name ()
-  "The name of the topic on the current line."
-  (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic)))
-    (and topic (symbol-name topic))))
-
-(defun gnus-group-topic-level ()
-  "The level of the topic on the current line."
-  (get-text-property (gnus-point-at-bol) 'gnus-topic-level))
-
-(defun gnus-group-topic-unread ()
-  "The number of unread articles in topic on the current line."
-  (get-text-property (gnus-point-at-bol) 'gnus-topic-unread))
-
-(defun gnus-topic-unread (topic)
-  "Return the number of unread articles in TOPIC."
-  (or (save-excursion
-	(and (gnus-topic-goto-topic topic)
-	     (gnus-group-topic-unread)))
-      0))
-
-(defun gnus-topic-init-alist ()
-  "Initialize the topic structures."
-  (setq gnus-topic-topology
-	(cons (list "Gnus" 'visible)
-	      (mapcar (lambda (topic)
-			(list (list (car topic) 'visible)))
-		      '(("misc")))))
-  (setq gnus-topic-alist
-	(list (cons "misc"
-		    (mapcar (lambda (info) (gnus-info-group info))
-			    (cdr gnus-newsrc-alist)))
-	      (list "Gnus")))
-  (gnus-topic-enter-dribble))
-
-(defun gnus-group-prepare-topics (level &optional all lowest regexp list-topic topic-level)
-  "List all newsgroups with unread articles of level LEVEL or lower, and
-use the `gnus-group-topics' to sort the groups.
-If ALL is non-nil, list groups that have no unread articles.
-If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
-  (set-buffer gnus-group-buffer)
-  (let ((buffer-read-only nil)
-        (lowest (or lowest 1)))
-
-    (setq gnus-topic-tallied-groups nil)
-
-    (when (or (not gnus-topic-alist)
-	      (not gnus-topology-checked-p))
-      (gnus-topic-check-topology))
-
-    (unless list-topic 
-      (erase-buffer))
-    
-    ;; List dead groups?
-    (when (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie))
-      (gnus-group-prepare-flat-list-dead 
-       (setq gnus-zombie-list (sort gnus-zombie-list 'string<)) 
-       gnus-level-zombie ?Z
-       regexp))
-    
-    (when (and (>= level gnus-level-killed) (<= lowest gnus-level-killed))
-      (gnus-group-prepare-flat-list-dead 
-       (setq gnus-killed-list (sort gnus-killed-list 'string<))
-       gnus-level-killed ?K
-       regexp))
-
-    ;; Use topics.
-    (when (< lowest gnus-level-zombie)
-      (if list-topic
-	  (let ((top (gnus-topic-find-topology list-topic)))
-	    (gnus-topic-prepare-topic (cdr top) (car top)
-				      (or topic-level level) all))
-	(gnus-topic-prepare-topic gnus-topic-topology 0
-				  (or topic-level level) all))))
-
-  (gnus-group-set-mode-line)
-  (setq gnus-group-list-mode (cons level all))
-  (run-hooks 'gnus-group-prepare-hook))
-
-(defun gnus-topic-prepare-topic (topicl level &optional list-level all silent)
-  "Insert TOPIC into the group buffer.
-If SILENT, don't insert anything.  Return the number of unread
-articles in the topic and its subtopics."
-  (let* ((type (pop topicl))
-	 (entries (gnus-topic-find-groups (car type) list-level all))
-	 (visiblep (and (eq (nth 1 type) 'visible) (not silent)))
-	 (gnus-group-indentation 
-	  (make-string (* gnus-topic-indent-level level) ? ))
-	 (beg (progn (beginning-of-line) (point)))
-	 (topicl (reverse topicl))
-	 (all-entries entries)
-	 (unread 0)
-	 (topic (car type))
-	 info entry end active)
-    ;; Insert any sub-topics.
-    (while topicl
-      (incf unread
-	    (gnus-topic-prepare-topic 
-	     (pop topicl) (1+ level) list-level all
-	     (not visiblep))))
-    (setq end (point))
-    (goto-char beg)
-    ;; Insert all the groups that belong in this topic.
-    (while (setq entry (pop entries))
-      (when visiblep 
-	(if (stringp entry)
-	    ;; Dead groups.
-	    (gnus-group-insert-group-line
-	     entry (if (member entry gnus-zombie-list) 8 9)
-	     nil (- (1+ (cdr (setq active (gnus-active entry))))
-		    (car active)) nil)
-	  ;; Living groups.
-	  (when (setq info (nth 2 entry))
-	    (gnus-group-insert-group-line 
-	     (gnus-info-group info)
-	     (gnus-info-level info) (gnus-info-marks info) 
-	     (car entry) (gnus-info-method info)))))
-      (when (and (listp entry)
-		 (numberp (car entry))
-		 (not (member (gnus-info-group (setq info (nth 2 entry)))
-			      gnus-topic-tallied-groups)))
-	(push (gnus-info-group info) gnus-topic-tallied-groups)
-	(incf unread (car entry))))
-    (goto-char beg)
-    ;; Insert the topic line.
-    (unless silent
-      (gnus-extent-start-open (point))
-      (gnus-topic-insert-topic-line 
-       (car type) visiblep
-       (not (eq (nth 2 type) 'hidden))
-       level all-entries unread))
-    (goto-char end)
-    unread))
-
-(defun gnus-topic-find-groups (topic &optional level all)
-  "Return entries for all visible groups in TOPIC."
-  (let ((groups (cdr (assoc topic gnus-topic-alist)))
-        info clevel unread group lowest params visible-groups entry active)
-    (setq lowest (or lowest 1))
-    (setq level (or level 7))
-    ;; We go through the newsrc to look for matches.
-    (while groups
-      (setq entry (gnus-gethash (setq group (pop groups)) gnus-newsrc-hashtb)
-	    info (nth 2 entry)
-	    params (gnus-info-params info)
-	    active (gnus-active group)
-            unread (or (car entry)
-		       (and (not (equal group "dummy.group"))
-			    active
-			    (- (1+ (cdr active)) (car active))))
-	    clevel (or (gnus-info-level info)
-		       (if (member group gnus-zombie-list) 8 9)))
-      (and 
-       unread				; nil means that the group is dead.
-       (<= clevel level) 
-       (>= clevel lowest)		; Is inside the level we want.
-       (or all
-	   (if (eq unread t)
-	       gnus-group-list-inactive-groups
-	     (> unread 0))
-	   (and gnus-list-groups-with-ticked-articles
-		(cdr (assq 'tick (gnus-info-marks info))))
-					; Has right readedness.
-	   ;; Check for permanent visibility.
-	   (and gnus-permanently-visible-groups
-		(string-match gnus-permanently-visible-groups group))
-	   (memq 'visible params)
-	   (cdr (assq 'visible params)))
-       ;; Add this group to the list of visible groups.
-       (push (or entry group) visible-groups)))
-    (nreverse visible-groups)))
-
-(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level)
-  "Remove the current topic."
-  (let ((topic (gnus-group-topic-name))
-	(level (gnus-group-topic-level))
-	(beg (progn (beginning-of-line) (point)))
-	buffer-read-only)
-    (when topic
-      (while (and (zerop (forward-line 1))
-		  (> (or (gnus-group-topic-level) (1+ level)) level)))
-      (delete-region beg (point))
-      (setcar (cdadr (gnus-topic-find-topology topic))
-	      (if insert 'visible 'invisible))
-      (when hide
-	(setcdr (cdadr (gnus-topic-find-topology topic))
-		(list hide)))
-      (unless total-remove
-	(gnus-topic-insert-topic topic in-level)))))
-
-(defun gnus-topic-insert-topic (topic &optional level)
-  "Insert TOPIC."
-  (gnus-group-prepare-topics 
-   (car gnus-group-list-mode) (cdr gnus-group-list-mode)
-   nil nil topic level))
-  
-(defun gnus-topic-fold (&optional insert)
-  "Remove/insert the current topic."
-  (let ((topic (gnus-group-topic-name))) 
-    (when topic
-      (save-excursion
-	(if (not (gnus-group-active-topic-p))
-	    (gnus-topic-remove-topic
-	     (or insert (not (gnus-topic-visible-p))))
-	  (let ((gnus-topic-topology gnus-topic-active-topology)
-		(gnus-topic-alist gnus-topic-active-alist)
-		(gnus-group-list-mode (cons 5 t)))
-	    (gnus-topic-remove-topic
-	     (or insert (not (gnus-topic-visible-p))) nil nil 9)))))))
-
-(defun gnus-group-topic-p ()
-  "Return non-nil if the current line is a topic."
-  (gnus-group-topic-name))
-
-(defun gnus-topic-visible-p ()
-  "Return non-nil if the current topic is visible."
-  (get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
-
-(defun gnus-topic-insert-topic-line (name visiblep shownp level entries 
-					  &optional unread)
-  (let* ((visible (if visiblep "" "..."))
-	 (indentation (make-string (* gnus-topic-indent-level level) ? ))
-	 (total-number-of-articles unread)
-	 (number-of-groups (length entries))
-	 (active-topic (eq gnus-topic-alist gnus-topic-active-alist)))
-    (beginning-of-line)
-    ;; Insert the text.
-    (gnus-add-text-properties 
-     (point)
-     (prog1 (1+ (point)) 
-       (eval gnus-topic-line-format-spec)
-       (gnus-topic-remove-excess-properties)1)
-     (list 'gnus-topic (intern name)
-	   'gnus-topic-level level
-	   'gnus-topic-unread unread
-	   'gnus-active active-topic
-	   'gnus-topic-visible visiblep))))
-
-(defun gnus-topic-previous-topic (topic)
-  "Return the previous topic on the same level as TOPIC."
-  (let ((top (cddr (gnus-topic-find-topology
-		    (gnus-topic-parent-topic topic)))))
-    (unless (equal topic (caaar top))
-      (while (and top (not (equal (caaadr top) topic)))
-	(setq top (cdr top)))
-      (caaar top))))
-
-(defun gnus-topic-parent-topic (topic &optional topology)
-  "Return the parent of TOPIC."
-  (unless topology
-    (setq topology gnus-topic-topology))
-  (let ((parent (car (pop topology)))
-	result found)
-    (while (and topology
-		(not (setq found (equal (caaar topology) topic)))
-		(not (setq result (gnus-topic-parent-topic topic 
-							   (car topology)))))
-      (setq topology (cdr topology)))
-    (or result (and found parent))))
-
-(defun gnus-topic-next-topic (topic &optional previous)
-  "Return the next sibling of TOPIC."
-  (let ((topology gnus-topic-topology)
-	(parentt (cddr (gnus-topic-find-topology 
-			(gnus-topic-parent-topic topic))))
-	prev)
-    (while (and parentt
-		(not (equal (caaar parentt) topic)))
-      (setq prev (caaar parentt)
-	    parentt (cdr parentt)))
-    (if previous
-	prev
-      (caaadr parentt))))
-
-(defun gnus-topic-find-topology (topic &optional topology level remove)
-  "Return the topology of TOPIC."
-  (unless topology
-    (setq topology gnus-topic-topology)
-    (setq level 0))
-  (let ((top topology)
-	result)
-    (if (equal (caar topology) topic)
-	(progn
-	  (when remove
-	    (delq topology remove))
-	  (cons level topology))
-      (setq topology (cdr topology))
-      (while (and topology
-		  (not (setq result (gnus-topic-find-topology
-				     topic (car topology) (1+ level)
-				     (and remove top)))))
-	(setq topology (cdr topology)))
-      result)))
-
-(gnus-add-shutdown 'gnus-topic-close 'gnus)
-
-(defun gnus-topic-close ()
-  (setq gnus-topic-active-topology nil
-	gnus-topic-active-alist nil
-	gnus-topic-killed-topics nil
-	gnus-topic-tallied-groups nil
-	gnus-topology-checked-p nil))
-
-(defun gnus-topic-check-topology ()  
-  ;; The first time we set the topology to whatever we have
-  ;; gotten here, which can be rather random.
-  (unless gnus-topic-alist
-    (gnus-topic-init-alist))
-
-  (setq gnus-topology-checked-p t)
-  (let ((topics (gnus-topic-list))
-	(alist gnus-topic-alist)
-	changed)
-    (while alist
-      (unless (member (caar alist) topics)
-	(nconc gnus-topic-topology
-	       (list (list (list (caar alist) 'visible))))
-	(setq changed t))
-      (setq alist (cdr alist)))
-    (when changed
-      (gnus-topic-enter-dribble)))
-  (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
-					 gnus-topic-alist)))
-	 (entry (assoc (caar gnus-topic-topology) gnus-topic-alist))
-	 (newsrc gnus-newsrc-alist)
-	 group)
-    (while newsrc
-      (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
-	(setcdr entry (cons group (cdr entry)))))))
-
-(defvar gnus-tmp-topics nil)
-(defun gnus-topic-list (&optional topology)
-  (unless topology
-    (setq topology gnus-topic-topology 
-	  gnus-tmp-topics nil))
-  (push (caar topology) gnus-tmp-topics)
-  (mapcar 'gnus-topic-list (cdr topology))
-  gnus-tmp-topics)
-
-(defun gnus-topic-enter-dribble ()
-  (gnus-dribble-enter
-   (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
-
-(defun gnus-topic-articles-in-topic (entries)
-  (let ((total 0)
-	number)
-    (while entries
-      (when (numberp (setq number (car (pop entries))))
-	(incf total number)))
-    total))
-
-(defun gnus-group-topic (group)
-  "Return the topic GROUP is a member of."
-  (let ((alist gnus-topic-alist)
-	out)
-    (while alist
-      (when (member group (cdar alist))
-	(setq out (caar alist)
-	      alist nil))
-      (setq alist (cdr alist)))
-    out))
-
-(defun gnus-topic-goto-topic (topic)
-  "Go to TOPIC."
-  (when topic
-    (gnus-goto-char (text-property-any (point-min) (point-max)
-				       'gnus-topic (intern topic)))))
-
-(defun gnus-group-parent-topic ()
-  "Return the name of the current topic."
-  (let ((result
-	 (or (get-text-property (point) 'gnus-topic)
-	     (save-excursion
-	       (and (gnus-goto-char (previous-single-property-change
-				     (point) 'gnus-topic))
-		    (get-text-property (max (1- (point)) (point-min))
-				       'gnus-topic))))))
-    (when result
-      (symbol-name result))))
-  
-(defun gnus-topic-update-topic ()
-  "Update all parent topics to the current group."
-  (when (and (eq major-mode 'gnus-group-mode)
-	     gnus-topic-mode)
-    (let ((group (gnus-group-group-name))
-	  (buffer-read-only nil))
-      (when (and group (gnus-get-info group)
-		 (gnus-topic-goto-topic (gnus-group-parent-topic)))
-	(gnus-topic-update-topic-line (gnus-group-topic-name))
-	(gnus-group-goto-group group)
-	(gnus-group-position-point)))))
-
-(defun gnus-topic-goto-missing-group (group) 
-  "Place point where GROUP is supposed to be inserted."
-  (let* ((topic (gnus-group-topic group))
-	 (groups (cdr (assoc topic gnus-topic-alist)))
-	 (g (cdr (member group groups)))
-	 (unfound t))
-    (while (and g unfound)
-      (when (gnus-group-goto-group (pop g))
-	(beginning-of-line)
-	(setq unfound nil)))
-    (when unfound
-      (setq g (cdr (member group (reverse groups))))
-      (while (and g unfound)
-	(when (gnus-group-goto-group (pop g))
-	  (forward-line 1)
-	  (setq unfound nil)))
-      (when unfound
-	(gnus-topic-goto-topic topic)
-	(forward-line 1)))))
-
-(defun gnus-topic-update-topic-line (topic-name &optional reads)
-  (let* ((top (gnus-topic-find-topology topic-name))
-	 (type (cadr top))
-	 (children (cddr top))
-	 (entries (gnus-topic-find-groups 
-		   (car type) (car gnus-group-list-mode)
-		   (cdr gnus-group-list-mode)))
-	 (parent (gnus-topic-parent-topic topic-name))
-	 (all-entries entries)
-	 (unread 0)
-	 old-unread entry)
-    (when (gnus-topic-goto-topic (car type))
-      ;; Tally all the groups that belong in this topic.
-      (if reads
-	  (setq unread (- (gnus-group-topic-unread) reads))
-	(while children
-	  (incf unread (gnus-topic-unread (caar (pop children)))))
-	(while (setq entry (pop entries))
-	  (when (numberp (car entry))
-	    (incf unread (car entry)))))
-      (setq old-unread (gnus-group-topic-unread))
-      ;; Insert the topic line.
-      (gnus-topic-insert-topic-line 
-       (car type) (gnus-topic-visible-p)
-       (not (eq (nth 2 type) 'hidden))
-       (gnus-group-topic-level) all-entries unread)
-      (gnus-delete-line))
-    (when parent
-      (forward-line -1)
-      (gnus-topic-update-topic-line
-       parent (- old-unread (gnus-group-topic-unread))))
-    unread))
-
-(defun gnus-topic-grok-active (&optional force)
-  "Parse all active groups and create topic structures for them."
-  ;; First we make sure that we have really read the active file. 
-  (when (or force
-	    (not gnus-topic-active-alist))
-    (let (groups)
-      ;; Get a list of all groups available.
-      (mapatoms (lambda (g) (when (symbol-value g)
-			      (push (symbol-name g) groups)))
-		gnus-active-hashtb)
-      (setq groups (sort groups 'string<))
-      ;; Init the variables.
-      (setq gnus-topic-active-topology (list (list "" 'visible)))
-      (setq gnus-topic-active-alist nil)
-      ;; Descend the top-level hierarchy.
-      (gnus-topic-grok-active-1 gnus-topic-active-topology groups)
-      ;; Set the top-level topic names to something nice.
-      (setcar (car gnus-topic-active-topology) "Gnus active")
-      (setcar (car gnus-topic-active-alist) "Gnus active"))))
-
-(defun gnus-topic-grok-active-1 (topology groups)
-  (let* ((name (caar topology))
-	 (prefix (concat "^" (regexp-quote name)))
-	 tgroups ntopology group)
-    (while (and groups
-		(string-match prefix (setq group (car groups))))
-      (if (not (string-match "\\." group (match-end 0)))
-	  ;; There are no further hierarchies here, so we just
-	  ;; enter this group into the list belonging to this
-	  ;; topic.
-	  (push (pop groups) tgroups)
-	;; New sub-hierarchy, so we add it to the topology.
-	(nconc topology (list (setq ntopology 
-				    (list (list (substring 
-						 group 0 (match-end 0))
-						'invisible)))))
-	;; Descend the hierarchy.
-	(setq groups (gnus-topic-grok-active-1 ntopology groups))))
-    ;; We remove the trailing "." from the topic name.
-    (setq name
-	  (if (string-match "\\.$" name)
-	      (substring name 0 (match-beginning 0))
-	    name))
-    ;; Add this topic and its groups to the topic alist.
-    (push (cons name (nreverse tgroups)) gnus-topic-active-alist)
-    (setcar (car topology) name)
-    ;; We return the rest of the groups that didn't belong
-    ;; to this topic.
-    groups))
-
-(defun gnus-group-active-topic-p ()
-  "Return whether the current active comes from the active topics."
-  (save-excursion
-    (beginning-of-line)
-    (get-text-property (point) 'gnus-active)))
-
-;;; Topic mode, commands and keymap.
-
-(defvar gnus-topic-mode-map nil)
-(defvar gnus-group-topic-map nil)
-
-(unless gnus-topic-mode-map
-  (setq gnus-topic-mode-map (make-sparse-keymap))
-
-  ;; Override certain group mode keys.
-  (gnus-define-keys
-   gnus-topic-mode-map
-   "=" gnus-topic-select-group
-   "\r" gnus-topic-select-group
-   " " gnus-topic-read-group
-   "\C-k" gnus-topic-kill-group
-   "\C-y" gnus-topic-yank-group
-   "\M-g" gnus-topic-get-new-news-this-topic
-   "AT" gnus-topic-list-active
-   gnus-mouse-2 gnus-mouse-pick-topic)
-
-  ;; Define a new submap.
-  (gnus-define-keys
-   (gnus-group-topic-map "T" gnus-group-mode-map)
-   "#" gnus-topic-mark-topic
-   "\M-#" gnus-topic-unmark-topic
-   "n" gnus-topic-create-topic
-   "m" gnus-topic-move-group
-   "D" gnus-topic-remove-group
-   "c" gnus-topic-copy-group
-   "h" gnus-topic-hide-topic
-   "s" gnus-topic-show-topic
-   "M" gnus-topic-move-matching
-   "C" gnus-topic-copy-matching
-   "\C-i" gnus-topic-indent
-   [tab] gnus-topic-indent
-   "r" gnus-topic-rename
-   "\177" gnus-topic-delete))
-
-(defun gnus-topic-make-menu-bar ()
-  (unless (boundp 'gnus-topic-menu)
-    (easy-menu-define
-     gnus-topic-menu gnus-topic-mode-map ""
-     '("Topics"
-       ["Toggle topics" gnus-topic-mode t]
-       ("Groups"
-	["Copy" gnus-topic-copy-group t]
-	["Move" gnus-topic-move-group t]
-	["Remove" gnus-topic-remove-group t]
-	["Copy matching" gnus-topic-copy-matching t]
-	["Move matching" gnus-topic-move-matching t])
-       ("Topics"
-	["Show" gnus-topic-show-topic t]
-	["Hide" gnus-topic-hide-topic t]
-	["Delete" gnus-topic-delete t]
-	["Rename" gnus-topic-rename t]
-	["Create" gnus-topic-create-topic t]
-	["Mark" gnus-topic-mark-topic t]
-	["Indent" gnus-topic-indent t])
-       ["List active" gnus-topic-list-active t]))))
-
-(defun gnus-topic-mode (&optional arg redisplay)
-  "Minor mode for topicsifying Gnus group buffers."
-  (interactive (list current-prefix-arg t))
-  (when (eq major-mode 'gnus-group-mode)
-    (make-local-variable 'gnus-topic-mode)
-    (setq gnus-topic-mode 
-	  (if (null arg) (not gnus-topic-mode)
-	    (> (prefix-numeric-value arg) 0)))
-    ;; Infest Gnus with topics.
-    (when gnus-topic-mode
-      (when (and menu-bar-mode
-		 (gnus-visual-p 'topic-menu 'menu))
-	(gnus-topic-make-menu-bar))
-      (setq gnus-topic-line-format-spec 
-	    (gnus-parse-format gnus-topic-line-format 
-			       gnus-topic-line-format-alist t))
-      (unless (assq 'gnus-topic-mode minor-mode-alist)
-	(push '(gnus-topic-mode " Topic") minor-mode-alist))
-      (unless (assq 'gnus-topic-mode minor-mode-map-alist)
-	(push (cons 'gnus-topic-mode gnus-topic-mode-map)
-	      minor-mode-map-alist))
-      (add-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
-      (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
-      (add-hook 'gnus-group-update-group-hook 'gnus-topic-update-topic)
-      (make-local-variable 'gnus-group-prepare-function)
-      (setq gnus-group-prepare-function 'gnus-group-prepare-topics)
-      (make-local-variable 'gnus-group-goto-next-group-function)
-      (setq gnus-group-goto-next-group-function 
-	    'gnus-topic-goto-next-group)
-      (setq gnus-group-change-level-function 'gnus-topic-change-level)
-      (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
-      (make-local-variable 'gnus-group-indentation-function)
-      (setq gnus-group-indentation-function
-	    'gnus-topic-group-indentation)
-      (setq gnus-topology-checked-p nil)
-      ;; We check the topology.
-      (when gnus-newsrc-alist
-	(gnus-topic-check-topology))
-      (run-hooks 'gnus-topic-mode-hook))
-    ;; Remove topic infestation.
-    (unless gnus-topic-mode
-      (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
-      (remove-hook 'gnus-group-change-level-function 
-		   'gnus-topic-change-level)
-      (setq gnus-group-prepare-function 'gnus-group-prepare-flat))
-    (when redisplay
-      (gnus-group-list-groups))))
-    
-(defun gnus-topic-select-group (&optional all)
-  "Select this newsgroup.
-No article is selected automatically.
-If ALL is non-nil, already read articles become readable.
-If ALL is a number, fetch this number of articles."
-  (interactive "P")
-  (if (gnus-group-topic-p)
-      (let ((gnus-group-list-mode 
-	     (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
-	(gnus-topic-fold all))
-    (gnus-group-select-group all)))
-
-(defun gnus-mouse-pick-topic (e)
-  "Select the group or topic under the mouse pointer."
-  (interactive "e")
-  (mouse-set-point e)
-  (gnus-topic-read-group nil))
-
-(defun gnus-topic-read-group (&optional all no-article group)
-  "Read news in this newsgroup.
-If the prefix argument ALL is non-nil, already read articles become
-readable.  IF ALL is a number, fetch this number of articles.  If the
-optional argument NO-ARTICLE is non-nil, no article will be
-auto-selected upon group entry.  If GROUP is non-nil, fetch that
-group."
-  (interactive "P")
-  (if (gnus-group-topic-p)
-      (let ((gnus-group-list-mode 
-	     (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
-	(gnus-topic-fold all))
-    (gnus-group-read-group all no-article group)))
-
-(defun gnus-topic-create-topic (topic parent &optional previous full-topic)
-  (interactive 
-   (list
-    (read-string "New topic: ")
-    (gnus-group-parent-topic)))
-  ;; Check whether this topic already exists.
-  (when (gnus-topic-find-topology topic)
-    (error "Topic aleady exists"))
-  (unless parent
-    (setq parent (caar gnus-topic-topology)))
-  (let ((top (cdr (gnus-topic-find-topology parent)))
-	(full-topic (or full-topic `((,topic visible)))))
-    (unless top
-      (error "No such parent topic: %s" parent))
-    (if previous
-	(progn
-	  (while (and (cdr top)
-		      (not (equal (caaadr top) previous)))
-	    (setq top (cdr top)))
-	  (setcdr top (cons full-topic (cdr top))))
-      (nconc top (list full-topic)))
-    (unless (assoc topic gnus-topic-alist)
-      (push (list topic) gnus-topic-alist)))
-  (gnus-topic-enter-dribble)
-  (gnus-group-list-groups)
-  (gnus-topic-goto-topic topic))
-
-(defun gnus-topic-move-group (n topic &optional copyp)
-  "Move the next N groups to TOPIC.
-If COPYP, copy the groups instead."
-  (interactive
-   (list current-prefix-arg
-	 (completing-read "Move to topic: " gnus-topic-alist nil t)))
-  (let ((groups (gnus-group-process-prefix n))
-	(topicl (assoc topic gnus-topic-alist))
-	entry)
-    (mapcar (lambda (g) 
-	      (gnus-group-remove-mark g)
-	      (when (and
-		     (setq entry (assoc (gnus-group-parent-topic)
-					gnus-topic-alist))
-		     (not copyp))
-		(setcdr entry (gnus-delete-first g (cdr entry))))
-	      (nconc topicl (list g)))
-	    groups)
-    (gnus-group-position-point))
-  (gnus-topic-enter-dribble)
-  (gnus-group-list-groups))
-
-(defun gnus-topic-remove-group ()
-  "Remove the current group from the topic."
-  (interactive)
-  (let ((topicl (assoc (gnus-group-parent-topic) gnus-topic-alist))
-	(group (gnus-group-group-name))
-	(buffer-read-only nil))
-    (when (and topicl group)
-      (gnus-delete-line)
-      (gnus-delete-first group topicl))
-    (gnus-group-position-point)))
-
-(defun gnus-topic-copy-group (n topic)
-  "Copy the current group to a topic."
-  (interactive
-   (list current-prefix-arg
-	 (completing-read "Copy to topic: " gnus-topic-alist nil t)))
-  (gnus-topic-move-group n topic t))
-
-(defun gnus-topic-group-indentation ()
-  (make-string 
-   (* gnus-topic-indent-level
-      (or (save-excursion
-	    (gnus-topic-goto-topic (gnus-group-parent-topic))
-	    (gnus-group-topic-level)) 0)) ? ))
-
-(defun gnus-topic-change-level (group level oldlevel)
-  "Run when changing levels to enter/remove groups from topics."
-  (save-excursion
-    (set-buffer gnus-group-buffer)
-    (when (and gnus-topic-mode 
-	       gnus-topic-alist
-	       (not gnus-topic-inhibit-change-level))
-      ;; Remove the group from the topics.
-      (when (and (< oldlevel gnus-level-zombie)
-		 (>= level gnus-level-zombie))
-	(let (alist)
-	  (forward-line -1)
-	  (when (setq alist (assoc (gnus-group-parent-topic) gnus-topic-alist))
-	    (setcdr alist (gnus-delete-first group (cdr alist))))))
-      ;; If the group is subscribed. then we enter it into the topics.
-      (when (and (< level gnus-level-zombie)
-		 (>= oldlevel gnus-level-zombie))
-	(let* ((prev (gnus-group-group-name))
-	       (gnus-topic-inhibit-change-level t)
-	       (gnus-group-indentation
-		(make-string 
-		 (* gnus-topic-indent-level
-		    (or (save-excursion
-			  (gnus-topic-goto-topic (gnus-group-parent-topic))
-			  (gnus-group-topic-level)) 0)) ? ))
-	       (yanked (list group))
-	       alist talist end)
-	  ;; Then we enter the yanked groups into the topics they belong
-	  ;; to. 
-	  (when (setq alist (assoc (save-excursion
-				     (forward-line -1)
-				     (or
-				      (gnus-group-parent-topic)
-				      (caar gnus-topic-topology)))
-				   gnus-topic-alist))
-	    (setq talist alist)
-	    (when (stringp yanked)
-	      (setq yanked (list yanked)))
-	    (if (not prev)
-		(nconc alist yanked)
-	      (if (not (cdr alist))
-		  (setcdr alist (nconc yanked (cdr alist)))
-		(while (and (not end) (cdr alist))
-		  (when (equal (cadr alist) prev)
-		    (setcdr alist (nconc yanked (cdr alist)))
-		    (setq end t))
-		  (setq alist (cdr alist)))
-		(unless end
-		  (nconc talist yanked))))))
-	(gnus-topic-update-topic)))))
-
-(defun gnus-topic-goto-next-group (group props)
-  "Go to group or the next group after group."
-  (if (null group)
-      (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props))))
-    (if (gnus-group-goto-group group)
-	t
-      ;; The group is no longer visible.
-      (let* ((list (assoc (gnus-group-parent-topic) gnus-topic-alist))
-	     (after (cdr (member group (cdr list)))))
-	;; First try to put point on a group after the current one.
-	(while (and after
-		    (not (gnus-group-goto-group (car after))))
-	  (setq after (cdr after)))
-	;; Then try to put point on a group before point.
-	(unless after
-	  (setq after (cdr (member group (reverse (cdr list)))))
-	  (while (and after 
-		      (not (gnus-group-goto-group (car after))))
-	    (setq after (cdr after))))
-	;; Finally, just put point on the topic.
-	(unless after
-	  (gnus-topic-goto-topic (car list))
-	  (setq after nil))
-	t))))
-
-(defun gnus-topic-kill-group (&optional n discard)
-  "Kill the next N groups."
-  (interactive "P")
-  (if (gnus-group-topic-p)
-      (let ((topic (gnus-group-topic-name)))
-	(gnus-topic-remove-topic nil t)
-	(push (gnus-topic-find-topology topic nil nil gnus-topic-topology)
-	      gnus-topic-killed-topics))
-    (gnus-group-kill-group n discard)
-    (gnus-topic-update-topic)))
-  
-(defun gnus-topic-yank-group (&optional arg)
-  "Yank the last topic."
-  (interactive "p")
-  (if gnus-topic-killed-topics
-      (let ((previous 
-	     (or (gnus-group-topic-name)
-		 (gnus-topic-next-topic (gnus-group-parent-topic))))
-	    (item (cdr (pop gnus-topic-killed-topics))))
-	(gnus-topic-create-topic
-	 (caar item) (gnus-topic-parent-topic previous) previous
-	 item)
-	(gnus-topic-goto-topic (caar item)))
-    (let* ((prev (gnus-group-group-name))
-	   (gnus-topic-inhibit-change-level t)
-	   (gnus-group-indentation
-	    (make-string 
-	     (* gnus-topic-indent-level
-		(or (save-excursion
-		      (gnus-topic-goto-topic (gnus-group-parent-topic))
-		      (gnus-group-topic-level)) 0)) ? ))
-	   yanked alist)
-      ;; We first yank the groups the normal way...
-      (setq yanked (gnus-group-yank-group arg))
-      ;; Then we enter the yanked groups into the topics they belong
-      ;; to. 
-      (setq alist (assoc (save-excursion
-			   (forward-line -1)
-			   (gnus-group-parent-topic))
-			 gnus-topic-alist))
-      (when (stringp yanked)
-	(setq yanked (list yanked)))
-      (if (not prev)
-	  (nconc alist yanked)
-	(if (not (cdr alist))
-	    (setcdr alist (nconc yanked (cdr alist)))
-	  (while (cdr alist)
-	    (when (equal (cadr alist) prev)
-	      (setcdr alist (nconc yanked (cdr alist)))
-	      (setq alist nil))
-	    (setq alist (cdr alist))))))
-    (gnus-topic-update-topic)))
-
-(defun gnus-topic-hide-topic ()
-  "Hide all subtopics under the current topic."
-  (interactive)
-  (when (gnus-group-parent-topic)
-    (gnus-topic-goto-topic (gnus-group-parent-topic))
-    (gnus-topic-remove-topic nil nil 'hidden)))
-
-(defun gnus-topic-show-topic ()
-  "Show the hidden topic."
-  (interactive)
-  (when (gnus-group-topic-p)
-    (gnus-topic-remove-topic t nil 'shown)))
-
-(defun gnus-topic-mark-topic (topic &optional unmark)
-  "Mark all groups in the topic with the process mark."
-  (interactive (list (gnus-group-parent-topic)))
-  (save-excursion
-    (let ((groups (gnus-topic-find-groups topic 9 t)))
-      (while groups
-	(funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
-		 (gnus-info-group (nth 2 (pop groups))))))))
-
-(defun gnus-topic-unmark-topic (topic &optional unmark)
-  "Remove the process mark from all groups in the topic."
-  (interactive (list (gnus-group-parent-topic)))
-  (gnus-topic-mark-topic topic t))
-
-(defun gnus-topic-get-new-news-this-topic (&optional n)
-  "Check for new news in the current topic."
-  (interactive "P")
-  (if (not (gnus-group-topic-p))
-      (gnus-group-get-new-news-this-group n)
-    (gnus-topic-mark-topic (gnus-group-topic-name))
-    (gnus-group-get-new-news-this-group)))
-
-(defun gnus-topic-move-matching (regexp topic &optional copyp)
-  "Move all groups that match REGEXP to some topic."
-  (interactive
-   (let (topic)
-     (nreverse
-      (list
-       (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t))
-       (read-string (format "Move to %s (regexp): " topic))))))
-  (gnus-group-mark-regexp regexp)
-  (gnus-topic-move-group nil topic copyp))
-
-(defun gnus-topic-copy-matching (regexp topic &optional copyp)
-  "Copy all groups that match REGEXP to some topic."
-  (interactive
-   (let (topic)
-     (nreverse
-      (list
-       (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t))
-       (read-string (format "Copy to %s (regexp): " topic))))))
-  (gnus-topic-move-matching regexp topic t))
-
-(defun gnus-topic-delete (topic)
-  "Delete a topic."
-  (interactive (list (gnus-group-topic-name)))
-  (unless topic
-    (error "No topic to be deleted"))
-  (let ((entry (assoc topic gnus-topic-alist))
-	(buffer-read-only nil))
-    (when (cdr entry)
-      (error "Topic not empty"))
-    ;; Delete if visible.
-    (when (gnus-topic-goto-topic topic)
-      (gnus-delete-line))
-    ;; Remove from alist.
-    (setq gnus-topic-alist (delq entry gnus-topic-alist))
-    ;; Remove from topology.
-    (gnus-topic-find-topology topic nil nil 'delete)))
-
-(defun gnus-topic-rename (old-name new-name)
-  "Rename a topic."
-  (interactive
-   (let ((topic (gnus-group-parent-topic)))
-     (list topic
-	   (read-string (format "Rename %s to: " topic)))))
-  (let ((top (gnus-topic-find-topology old-name))
-	(entry (assoc old-name gnus-topic-alist)))
-    (when top
-      (setcar (cadr top) new-name))
-    (when entry 
-      (setcar entry new-name))
-    (gnus-group-list-groups)))
-
-(defun gnus-topic-indent (&optional unindent)
-  "Indent a topic -- make it a sub-topic of the previous topic.
-If UNINDENT, remove an indentation."
-  (interactive "P")
-  (if unindent
-      (gnus-topic-unindent)
-    (let* ((topic (gnus-group-parent-topic))
-	   (parent (gnus-topic-previous-topic topic)))
-      (unless parent
-	(error "Nothing to indent %s into" topic))
-      (when topic
-	(gnus-topic-goto-topic topic)
-	(gnus-topic-kill-group)
-	(gnus-topic-create-topic
-	 topic parent nil (cdr (pop gnus-topic-killed-topics)))
-	(or (gnus-topic-goto-topic topic)
-	    (gnus-topic-goto-topic parent))))))
-
-(defun gnus-topic-unindent ()
-  "Unindent a topic."
-  (interactive)
-  (let* ((topic (gnus-group-parent-topic))
-	 (parent (gnus-topic-parent-topic topic))
-	 (grandparent (gnus-topic-parent-topic parent)))
-    (unless grandparent
-      (error "Nothing to indent %s into" topic))
-    (when topic
-      (gnus-topic-goto-topic topic)
-      (gnus-topic-kill-group)
-      (gnus-topic-create-topic
-       topic grandparent (gnus-topic-next-topic parent)
-       (cdr (pop gnus-topic-killed-topics)))
-      (gnus-topic-goto-topic topic))))
-
-(defun gnus-topic-list-active (&optional force)
-  "List all groups that Gnus knows about in a topicsified fashion.
-If FORCE, always re-read the active file."
-  (interactive "P")
-  (when force
-    (gnus-get-killed-groups))
-  (gnus-topic-grok-active force)
-  (let ((gnus-topic-topology gnus-topic-active-topology)
-	(gnus-topic-alist gnus-topic-active-alist)
-	gnus-killed-list gnus-zombie-list)
-    (gnus-group-list-groups 9 nil 1)))
-
-(provide 'gnus-topic)
-
-;;; gnus-topic.el ends here
diff --git a/lisp/gnus-uu.el b/lisp/gnus-uu.el
deleted file mode 100644
index bd23e9edeba..00000000000
--- a/lisp/gnus-uu.el
+++ /dev/null
@@ -1,1951 +0,0 @@
-;;; gnus-uu.el --- extract (uu)encoded files in Gnus
-;; Copyright (C) 1985,86,87,93,94,95,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Created: 2 Oct 1993
-;; Keyword: news
-
-;; 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: 
-
-(require 'gnus)
-(require 'gnus-msg)
-(eval-when-compile (require 'cl))
-
-;; Default viewing action rules
-
-(defvar gnus-uu-default-view-rules 
-  '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed s/\r//g")
-    ("\\.pas$" "cat %s | sed s/\r//g")
-    ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
-    ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "xv")
-    ("\\.tga$" "tgatoppm %s | xv -")
-    ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$" 
-     "sox -v .5 %s -t .au -u - > /dev/audio")
-    ("\\.au$" "cat %s > /dev/audio")
-    ("\\.midi?$" "playmidi -f")
-    ("\\.mod$" "str32")
-    ("\\.ps$" "ghostview")
-    ("\\.dvi$" "xdvi")
-    ("\\.html$" "xmosaic")
-    ("\\.mpe?g$" "mpeg_play")
-    ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim")
-    ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$" 
-     "gnus-uu-archive"))
-  "*Default actions to be taken when the user asks to view a file.  
-To change the behaviour, you can either edit this variable or set
-`gnus-uu-user-view-rules' to something useful.
-
-For example:
-
-To make gnus-uu use 'xli' to display JPEG and GIF files, put the
-following in your .emacs file:
-
-  (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\")))
-
-Both these variables are lists of lists with two string elements. The
-first string is a regular expression. If the file name matches this
-regular expression, the command in the second string is executed with
-the file as an argument.
-
-If the command string contains \"%s\", the file name will be inserted
-at that point in the command string. If there's no \"%s\" in the
-command string, the file name will be appended to the command string
-before executing.
-
-There are several user variables to tailor the behaviour of gnus-uu to
-your needs. First we have `gnus-uu-user-view-rules', which is the
-variable gnus-uu first consults when trying to decide how to view a
-file. If this variable contains no matches, gnus-uu examines the
-default rule variable provided in this package. If gnus-uu finds no
-match here, it uses `gnus-uu-user-view-rules-end' to try to make a
-match.")
-
-(defvar gnus-uu-user-view-rules nil 
-  "*Variable detailing what actions are to be taken to view a file.
-See the documentation on the `gnus-uu-default-view-rules' variable for 
-details.")
-
-(defvar gnus-uu-user-view-rules-end 
-  '(("" "file"))
-  "*Variable saying what actions are to be taken if no rule matched the file name.
-See the documentation on the `gnus-uu-default-view-rules' variable for 
-details.")
-
-;; Default unpacking commands
-
-(defvar gnus-uu-default-archive-rules 
-  '(("\\.tar$" "tar xf")
-    ("\\.zip$" "unzip -o")
-    ("\\.ar$" "ar x")
-    ("\\.arj$" "unarj x")
-    ("\\.zoo$" "zoo -e")
-    ("\\.\\(lzh\\|lha\\)$" "lha x")
-    ("\\.Z$" "uncompress")
-    ("\\.gz$" "gunzip")
-    ("\\.arc$" "arc -x")))
-
-(defvar gnus-uu-destructive-archivers 
-  (list "uncompress" "gunzip"))
-
-(defvar gnus-uu-user-archive-rules nil
-  "*A list that can be set to override the default archive unpacking commands.
-To use, for instance, 'untar' to unpack tar files and 'zip -x' to
-unpack zip files, say the following:
-  (setq gnus-uu-user-archive-rules 
-    '((\"\\\\.tar$\" \"untar\")
-      (\"\\\\.zip$\" \"zip -x\")))")
-
-(defvar gnus-uu-ignore-files-by-name nil
-  "*A regular expression saying what files should not be viewed based on name.
-If, for instance, you want gnus-uu to ignore all .au and .wav files, 
-you could say something like
-
-  (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
-
-Note that this variable can be used in conjunction with the
-`gnus-uu-ignore-files-by-type' variable.")
-
-(defvar gnus-uu-ignore-files-by-type nil
-  "*A regular expression saying what files that shouldn't be viewed, based on MIME file type.
-If, for instance, you want gnus-uu to ignore all audio files and all mpegs, 
-you could say something like
-
-  (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
-
-Note that this variable can be used in conjunction with the
-`gnus-uu-ignore-files-by-name' variable.")
-
-;; Pseudo-MIME support
-
-(defconst gnus-uu-ext-to-mime-list
-  '(("\\.gif$" "image/gif")
-    ("\\.jpe?g$" "image/jpeg")
-    ("\\.tiff?$" "image/tiff")
-    ("\\.xwd$" "image/xwd")
-    ("\\.pbm$" "image/pbm")
-    ("\\.pgm$" "image/pgm")
-    ("\\.ppm$" "image/ppm")
-    ("\\.xbm$" "image/xbm")
-    ("\\.pcx$" "image/pcx")
-    ("\\.tga$" "image/tga")
-    ("\\.ps$" "image/postscript")
-    ("\\.fli$" "video/fli")
-    ("\\.wav$" "audio/wav")
-    ("\\.aiff$" "audio/aiff")
-    ("\\.hcom$" "audio/hcom")
-    ("\\.voc$" "audio/voc")
-    ("\\.smp$" "audio/smp")
-    ("\\.mod$" "audio/mod")
-    ("\\.dvi$" "image/dvi")
-    ("\\.mpe?g$" "video/mpeg")
-    ("\\.au$" "audio/basic")
-    ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain")
-    ("\\.\\(c\\|h\\)$" "text/source")
-    ("read.*me" "text/plain")
-    ("\\.html$" "text/html")
-    ("\\.bat$" "text/bat")
-    ("\\.[1-6]$" "text/man")
-    ("\\.flc$" "video/flc")
-    ("\\.rle$" "video/rle")
-    ("\\.pfx$" "video/pfx")
-    ("\\.avi$" "video/avi")
-    ("\\.sme$" "video/sme")
-    ("\\.rpza$" "video/prza")
-    ("\\.dl$" "video/dl")
-    ("\\.qt$" "video/qt")
-    ("\\.rsrc$" "video/rsrc")
-    ("\\..*$" "unknown/unknown")))
-
-;; Various variables users may set 
-
-(defvar gnus-uu-tmp-dir "/tmp/" 
-  "*Variable saying where gnus-uu is to do its work.
-Default is \"/tmp/\".")
-
-(defvar gnus-uu-do-not-unpack-archives nil 
-  "*Non-nil means that gnus-uu won't peek inside archives looking for files to display. 
-Default is nil.")
-
-(defvar gnus-uu-ignore-default-view-rules nil
-  "*Non-nil means that gnus-uu will ignore the default viewing rules.
-Only the user viewing rules will be consulted. Default is nil.")
-
-(defvar gnus-uu-grabbed-file-functions nil
-  "*Functions run on each file after successful decoding.
-They will be called with the name of the file as the argument.
-Likely functions you can use in this list are `gnus-uu-grab-view' 
-and `gnus-uu-grab-move'.")
-
-(defvar gnus-uu-ignore-default-archive-rules nil 
-  "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.  
-Only the user unpacking commands will be consulted. Default is nil.")
-
-(defvar gnus-uu-kill-carriage-return t
-  "*Non-nil means that gnus-uu will strip all carriage returns from articles.
-Default is t.")
-
-(defvar gnus-uu-view-with-metamail nil
-  "*Non-nil means that files will be viewed with metamail.
-The gnus-uu viewing functions will be ignored and gnus-uu will try
-to guess at a content-type based on file name suffixes. Default
-it nil.")
-
-(defvar gnus-uu-unmark-articles-not-decoded nil
-  "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread. 
-Default is nil.")
-
-(defvar gnus-uu-correct-stripped-uucode nil
-  "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted. 
-Default is nil.")
-
-(defvar gnus-uu-save-in-digest nil
-  "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
-If this variable is nil, gnus-uu will just save everything in a 
-file without any embellishments. The digesting almost conforms to RFC1153 -
-no easy way to specify any meaningful volume and issue numbers were found, 
-so I simply dropped them.")
-
-(defvar gnus-uu-digest-headers 
-  '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
-    "^Summary:" "^References:")
-  "*List of regexps to match headers included in digested messages.
-The headers will be included in the sequence they are matched.")
-
-(defvar gnus-uu-save-separate-articles nil
-  "*Non-nil means that gnus-uu will save articles in separate files.")
-
-;; Internal variables
-
-(defvar gnus-uu-saved-article-name nil)
-
-(defconst gnus-uu-begin-string "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
-(defconst gnus-uu-end-string "^end[ \t]*$")
-
-(defconst gnus-uu-body-line "^M")
-(let ((i 61))
-  (while (> (setq i (1- i)) 0)
-    (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
-  (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$")))
-
-;"^M.............................................................?$"
-
-(defconst gnus-uu-shar-begin-string "^#! */bin/sh")
-
-(defvar gnus-uu-shar-file-name nil)
-(defconst gnus-uu-shar-name-marker "begin [0-7][0-7][0-7][ \t]+\\(\\(\\w\\|\\.\\)*\\b\\)")
-
-(defconst gnus-uu-postscript-begin-string "^%!PS-")
-(defconst gnus-uu-postscript-end-string "^%%EOF$")
-
-(defvar gnus-uu-file-name nil)
-(defconst gnus-uu-uudecode-process nil)
-(defvar gnus-uu-binhex-article-name nil)
-
-(defvar gnus-uu-work-dir nil)
-
-(defconst gnus-uu-output-buffer-name " *Gnus UU Output*")
-
-(defvar gnus-uu-default-dir gnus-article-save-directory)
-(defvar gnus-uu-digest-from-subject nil)
-
-;; Keymaps
-
-(gnus-define-keys 
- (gnus-uu-mark-map "P" gnus-summary-mark-map)
- "p" gnus-summary-mark-as-processable
- "u" gnus-summary-unmark-as-processable
- "U" gnus-summary-unmark-all-processable
- "v" gnus-uu-mark-over
- "s" gnus-uu-mark-series
- "r" gnus-uu-mark-region
- "R" gnus-uu-mark-by-regexp
- "t" gnus-uu-mark-thread
- "T" gnus-uu-unmark-thread
- "a" gnus-uu-mark-all
- "b" gnus-uu-mark-buffer
- "S" gnus-uu-mark-sparse)
-
-(gnus-define-keys 
- (gnus-uu-extract-map "X" gnus-summary-mode-map)
- ;;"x" gnus-uu-extract-any
- ;;"m" gnus-uu-extract-mime
- "u" gnus-uu-decode-uu
- "U" gnus-uu-decode-uu-and-save
- "s" gnus-uu-decode-unshar
- "S" gnus-uu-decode-unshar-and-save
- "o" gnus-uu-decode-save
- "O" gnus-uu-decode-save
- "b" gnus-uu-decode-binhex
- "B" gnus-uu-decode-binhex
- "p" gnus-uu-decode-postscript
- "P" gnus-uu-decode-postscript-and-save)
-
-(gnus-define-keys 
- (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
- "u" gnus-uu-decode-uu-view
- "U" gnus-uu-decode-uu-and-save-view
- "s" gnus-uu-decode-unshar-view
- "S" gnus-uu-decode-unshar-and-save-view
- "o" gnus-uu-decode-save-view
- "O" gnus-uu-decode-save-view
- "b" gnus-uu-decode-binhex-view
- "B" gnus-uu-decode-binhex-view
- "p" gnus-uu-decode-postscript-view
- "P" gnus-uu-decode-postscript-and-save-view)
-
-
-;; Commands.
-
-(defun gnus-uu-decode-uu (&optional n)
-  "Uudecodes the current article."
-  (interactive "P") 
-  (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n))
-
-(defun gnus-uu-decode-uu-and-save (n dir)
-  "Decodes and saves the resulting file."
-  (interactive
-   (list current-prefix-arg
-	 (file-name-as-directory
-	  (read-file-name "Uudecode and save in dir: "
-			  gnus-uu-default-dir
-			  gnus-uu-default-dir t))))
-  (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t))
-
-(defun gnus-uu-decode-unshar (&optional n)
-  "Unshars the current article."
-  (interactive "P")
-  (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t))
-
-(defun gnus-uu-decode-unshar-and-save (n dir)
-  "Unshars and saves the current article."
-  (interactive
-   (list current-prefix-arg
-	 (file-name-as-directory
-	  (read-file-name "Unshar and save in dir: "
-			  gnus-uu-default-dir
-			  gnus-uu-default-dir t))))
-  (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t))
-
-(defun gnus-uu-decode-save (n file)
-  "Saves the current article."
-  (interactive
-   (list current-prefix-arg
-	 (read-file-name 
-	  (if gnus-uu-save-separate-articles
-	      "Save articles is dir: "
-	    "Save articles in file: ")
-	  gnus-uu-default-dir
-	  gnus-uu-default-dir)))
-  (setq gnus-uu-saved-article-name file)
-  (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t))
-
-(defun gnus-uu-decode-binhex (n dir)
-  "Unbinhexes the current article."
-  (interactive
-   (list current-prefix-arg
-	 (file-name-as-directory
-	  (read-file-name "Unbinhex and save in dir: "
-			  gnus-uu-default-dir
-			  gnus-uu-default-dir))))
-  (setq gnus-uu-binhex-article-name 
-	(make-temp-name (concat gnus-uu-work-dir "binhex")))
-  (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
-
-(defun gnus-uu-decode-uu-view (&optional n)
-  "Uudecodes and views the current article."    
-  (interactive "P")
-  (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
-    (gnus-uu-decode-uu n)))
-
-(defun gnus-uu-decode-uu-and-save-view (n dir)
-  "Decodes, views and saves the resulting file."
-  (interactive
-   (list current-prefix-arg
-	 (read-file-name "Uudecode, view and save in dir: "
-			 gnus-uu-default-dir
-			 gnus-uu-default-dir t)))
-  (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
-    (gnus-uu-decode-uu-and-save n dir)))
-
-(defun gnus-uu-decode-unshar-view (&optional n)
-  "Unshars and views the current article."
-  (interactive "P")
-  (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
-    (gnus-uu-decode-unshar n)))
-
-(defun gnus-uu-decode-unshar-and-save-view (n dir)
-  "Unshars and saves the current article."
-  (interactive
-   (list current-prefix-arg
-	 (read-file-name "Unshar, view and save in dir: "
-			 gnus-uu-default-dir
-			 gnus-uu-default-dir t)))
-  (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
-    (gnus-uu-decode-unshar-and-save n dir)))
-
-(defun gnus-uu-decode-save-view (n file)
-  "Saves and views the current article."
-  (interactive
-   (list current-prefix-arg
-	 (read-file-name  (if gnus-uu-save-separate-articles
-			      "Save articles is dir: "
-			    "Save articles in file: ")
-			  gnus-uu-default-dir gnus-uu-default-dir)))
-  (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
-    (gnus-uu-decode-save n file)))
-
-(defun gnus-uu-decode-binhex-view (n file)
-  "Unbinhexes and views the current article."
-  (interactive
-   (list current-prefix-arg
-	 (read-file-name "Unbinhex, view and save in dir: "
-			 gnus-uu-default-dir gnus-uu-default-dir)))
-  (setq gnus-uu-binhex-article-name 
-	(make-temp-name (concat gnus-uu-work-dir "binhex")))
-  (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
-    (gnus-uu-decode-binhex n file)))
-
-
-;; Digest and forward articles
-
-(defun gnus-uu-digest-mail-forward (&optional n post)
-  "Digests and forwards all articles in this series."
-  (interactive "P")
-  (let ((gnus-uu-save-in-digest t)
-	(file (make-temp-name (concat gnus-uu-tmp-dir "forward")))
-	buf subject from)
-    (setq gnus-uu-digest-from-subject nil)
-    (gnus-uu-decode-save n file)
-    (setq buf (switch-to-buffer (get-buffer-create " *gnus-uu-forward*")))
-    (gnus-add-current-to-buffer-list)
-    (erase-buffer)
-    (delete-other-windows)
-    (insert-file file)
-    (let ((fs gnus-uu-digest-from-subject))
-      (if (not fs)
-	  ()
-	(setq from (caar fs)
-	      subject (gnus-simplify-subject-fuzzy (cdar fs))
-	      fs (cdr fs))
-	(while (and fs (or from subject))
-	  (and from
-	       (or (string= from (caar fs))
-		   (setq from nil)))
-	  (and subject
-	       (or (string= (gnus-simplify-subject-fuzzy (cdar fs))
-			    subject)
-		   (setq subject nil)))
-	  (setq fs (cdr fs))))
-      (or subject (setq subject "Digested Articles"))
-      (or from (setq from "Various")))
-    (goto-char (point-min))
-    (and (re-search-forward "^Subject: ")
-	 (progn
-	   (delete-region (point) (gnus-point-at-eol))
-	   (insert subject)))
-    (goto-char (point-min))
-    (and (re-search-forward "^From: ")
-	 (progn
-	   (delete-region (point) (gnus-point-at-eol))
-	   (insert from)))
-    (message-forward post)
-    (delete-file file)
-    (kill-buffer buf)
-    (setq gnus-uu-digest-from-subject nil)))
-
-(defun gnus-uu-digest-post-forward (&optional n)
-  "Digest and forward to a newsgroup."
-  (interactive "P")
-  (gnus-uu-digest-mail-forward n t))
-
-;; Process marking.
-
-(defun gnus-uu-mark-by-regexp (regexp &optional unmark)
-  "Ask for a regular expression and set the process mark on all articles that match."
-  (interactive (list (read-from-minibuffer "Mark (regexp): ")))
-  (gnus-set-global-variables)
-  (let ((articles (gnus-uu-find-articles-matching regexp)))
-    (while articles
-      (if unmark
-	  (gnus-summary-remove-process-mark (pop articles))
-	(gnus-summary-set-process-mark (pop articles))))
-    (message ""))
-  (gnus-summary-position-point))
-
-(defun gnus-uu-unmark-by-regexp (regexp &optional unmark)
-  "Ask for a regular expression and remove the process mark on all articles that match."
-  (interactive (list (read-from-minibuffer "Mark (regexp): ")))
-  (gnus-uu-mark-by-regexp regexp t))
-
-(defun gnus-uu-mark-series ()
-  "Mark the current series with the process mark."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((articles (gnus-uu-find-articles-matching)))
-    (while articles
-      (gnus-summary-set-process-mark (car articles))
-      (setq articles (cdr articles)))
-    (message ""))
-  (gnus-summary-position-point))
-
-(defun gnus-uu-mark-region (beg end &optional unmark)
-  "Set the process mark on all articles between point and mark."
-  (interactive "r")
-  (gnus-set-global-variables)
-  (save-excursion
-    (goto-char beg)
-    (while (< (point) end)
-      (if unmark
-	  (gnus-summary-remove-process-mark (gnus-summary-article-number))
-	(gnus-summary-set-process-mark (gnus-summary-article-number)))
-      (forward-line 1)))
-  (gnus-summary-position-point))
-
-(defun gnus-uu-unmark-region (beg end)
-  "Remove the process mark from all articles between point and mark."
-  (interactive "r")
-  (gnus-uu-mark-region beg end t))
-
-(defun gnus-uu-mark-buffer ()
-  "Set the process mark on all articles in the buffer."
-  (interactive)
-  (gnus-uu-mark-region (point-min) (point-max)))
-      
-(defun gnus-uu-unmark-buffer ()
-  "Remove the process mark on all articles in the buffer."
-  (interactive)
-  (gnus-uu-mark-region (point-min) (point-max) t))
-      
-(defun gnus-uu-mark-thread ()
-  "Marks all articles downwards in this thread."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((level (gnus-summary-thread-level)))
-    (while (and (gnus-summary-set-process-mark (gnus-summary-article-number))
-		(zerop (gnus-summary-next-subject 1))
-		(> (gnus-summary-thread-level) level))))
-  (gnus-summary-position-point))
-
-(defun gnus-uu-unmark-thread ()
-  "Unmarks all articles downwards in this thread."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((level (gnus-summary-thread-level)))
-    (while (and (gnus-summary-remove-process-mark
-		 (gnus-summary-article-number))
-		(zerop (gnus-summary-next-subject 1))
-		(> (gnus-summary-thread-level) level))))
-  (gnus-summary-position-point))
-
-(defun gnus-uu-mark-over (&optional score)
-  "Mark all articles with a score over SCORE (the prefix.)"
-  (interactive "P")
-  (let ((score (gnus-score-default score))
-	(data gnus-newsgroup-data))
-    (save-excursion
-      (while data
-	(when (> (or (cdr (assq (gnus-data-number (caar data))
-				gnus-newsgroup-scored))
-		     gnus-summary-default-score 0)
-		 score)
-	  (gnus-summary-set-process-mark (caar data)))
-	(setq data (cdr data))))
-    (gnus-summary-position-point)))
-
-(defun gnus-uu-mark-sparse ()
-  "Mark all series that have some articles marked."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((marked (nreverse gnus-newsgroup-processable))
-	subject articles total headers)
-    (or marked (error "No articles marked with the process mark"))
-    (setq gnus-newsgroup-processable nil)
-    (save-excursion
-      (while marked
-	(and (vectorp (setq headers 
-			    (gnus-summary-article-header (car marked))))
-	     (setq subject (mail-header-subject headers)
-		   articles (gnus-uu-find-articles-matching 
-			     (gnus-uu-reginize-string subject))
-		   total (nconc total articles)))
-	(while articles
-	  (gnus-summary-set-process-mark (car articles))
-	  (setcdr marked (delq (car articles) (cdr marked)))
-	  (setq articles (cdr articles)))
-	(setq marked (cdr marked)))
-      (setq gnus-newsgroup-processable (nreverse total)))
-    (gnus-summary-position-point)))
-
-(defun gnus-uu-mark-all ()
-  "Mark all articles in \"series\" order."
-  (interactive)
-  (gnus-set-global-variables)
-  (setq gnus-newsgroup-processable nil)
-  (save-excursion
-    (let ((data gnus-newsgroup-data)
-	  number)
-      (while data
-	(when (and (not (memq (setq number (gnus-data-number (car data)))
-			      gnus-newsgroup-processable))
-		   (vectorp (gnus-data-header (car data))))
-	  (gnus-summary-goto-subject number)
-	  (gnus-uu-mark-series))
-	(setq data (cdr data)))))
-  (gnus-summary-position-point))
-
-;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>. 
-
-(defun gnus-uu-decode-postscript (&optional n)
-  "Gets postscript of the current article."
-  (interactive "P")
-  (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n))
-
-(defun gnus-uu-decode-postscript-view (&optional n)
-  "Gets and views the current article."
-  (interactive "P")
-  (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
-    (gnus-uu-decode-postscript n)))
-
-(defun gnus-uu-decode-postscript-and-save (n dir)
-  "Extracts postscript and saves the current article."
-  (interactive
-   (list current-prefix-arg
-	 (file-name-as-directory
-	  (read-file-name "Save in dir: "
-			  gnus-uu-default-dir
-			  gnus-uu-default-dir t))))
-  (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article 
-			      n dir nil nil t))
-
-(defun gnus-uu-decode-postscript-and-save-view (n dir)
-  "Decodes, views and saves the resulting file."
-  (interactive
-   (list current-prefix-arg
-	 (read-file-name "Where do you want to save the file(s)? "
-			 gnus-uu-default-dir
-			 gnus-uu-default-dir t)))
-  (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
-    (gnus-uu-decode-postscript-and-save n dir)))
-
-
-;; Internal functions.
-
-(defun gnus-uu-decode-with-method (method n &optional save not-insert 
-					  scan cdir)
-  (gnus-uu-initialize scan)
-  (if save (setq gnus-uu-default-dir save))
-  ;; Create the directory we save to.
-  (when (and scan cdir save
-	     (not (file-exists-p save)))
-    (make-directory save t))
-  (let ((articles (gnus-uu-get-list-of-articles n))
-	files)
-    (setq files (gnus-uu-grab-articles articles method t))
-    (let ((gnus-current-article (car articles)))
-      (and scan (setq files (gnus-uu-scan-directory gnus-uu-work-dir))))
-    (and save (gnus-uu-save-files files save))
-    (if (eq gnus-uu-do-not-unpack-archives nil)
-      (setq files (gnus-uu-unpack-files files)))
-    (setq files (nreverse (gnus-uu-get-actions files)))
-    (or not-insert (not gnus-insert-pseudo-articles)
-	(gnus-summary-insert-pseudos files save))))
-
-(defun gnus-uu-scan-directory (dir &optional rec)
-  "Return a list of all files under DIR."
-  (let ((files (directory-files dir t))
-	out file)
-    (while (setq file (pop files))
-      (unless (member (file-name-nondirectory file) '("." ".."))
-	(push (list (cons 'name file)
-		    (cons 'article gnus-current-article))
-	      out)
-	(when (file-directory-p file)
-	  (setq out (nconc (gnus-uu-scan-directory file t) out)))))
-    (if rec 
-	out
-      (nreverse out))))
-
-(defun gnus-uu-save-files (files dir)
-  "Save FILES in DIR."
-  (let ((len (length files))
-	(reg (concat "^" (regexp-quote gnus-uu-work-dir)))
-	to-file file fromdir)
-    (while (setq file (cdr (assq 'name (pop files))))
-      (when (file-exists-p file)
-	(string-match reg file)
-	(setq fromdir (substring file (match-end 0)))
-	(if (file-directory-p file)
-	    (unless (file-exists-p (concat dir fromdir))
-	      (make-directory (concat dir fromdir) t))
-	  (setq to-file (concat dir fromdir))
-	  (when (or (not (file-exists-p to-file))
-		    (gnus-y-or-n-p (format "%s exists; overwrite? " to-file)))
-	    (copy-file file to-file t t)))))
-    (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s"))))
-
-;; Functions for saving and possibly digesting articles without
-;; any decoding.
-
-;; Function called by gnus-uu-grab-articles to treat each article.
-(defun gnus-uu-save-article (buffer in-state)
-  (cond 
-   (gnus-uu-save-separate-articles
-    (save-excursion
-      (set-buffer buffer)
-      (write-region 1 (point-max) (concat gnus-uu-saved-article-name 
-					  gnus-current-article))
-      (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
-	    ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 
-						 'begin 'end))
-	    ((eq in-state 'last) (list 'end))
-	    (t (list 'middle)))))
-   ((not gnus-uu-save-in-digest)
-    (save-excursion
-      (set-buffer buffer)
-      (write-region 1 (point-max) gnus-uu-saved-article-name t)
-      (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
-	    ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name 
-						 'begin 'end))
-	    ((eq in-state 'last) (list 'end))
-	    (t (list 'middle)))))
-   (t
-    (let ((header (gnus-summary-article-header)))
-      (setq gnus-uu-digest-from-subject
-	    (cons (cons (mail-header-from header)
-			(mail-header-subject header))
-		  gnus-uu-digest-from-subject)))
-    (let ((name (file-name-nondirectory gnus-uu-saved-article-name))
-	  (delim (concat "^" (make-string 30 ?-) "$"))
-	  beg subj headers headline sorthead body end-string state)
-      (if (or (eq in-state 'first) 
-	      (eq in-state 'first-and-last))
-	  (progn 
-	    (setq state (list 'begin))
-	    (save-excursion (set-buffer (get-buffer-create "*gnus-uu-body*"))
-			    (erase-buffer))
-	    (save-excursion 
-	      (set-buffer (get-buffer-create "*gnus-uu-pre*"))
-	      (erase-buffer)
-	      (insert (format 
-		       "Date: %s\nFrom: %s\nSubject: %s Digest\n\nTopics:\n"
-		       (current-time-string) name name))))
-	(if (not (eq in-state 'end))
-	    (setq state (list 'middle))))
-      (save-excursion
-	(set-buffer (get-buffer "*gnus-uu-body*"))
-	(goto-char (setq beg (point-max)))
-	(save-excursion
-	  (save-restriction
-	    (set-buffer buffer)
-	    (let (buffer-read-only)
-	      (gnus-set-text-properties (point-min) (point-max) nil)
-	      ;; These two are necessary for XEmacs 19.12 fascism.
-	      (put-text-property (point-min) (point-max) 'invisible nil)
-	      (put-text-property (point-min) (point-max) 'intangible nil))
-	    (goto-char (point-min))
-	    (re-search-forward "\n\n")
-	    ;; Quote all 30-dash lines.
-	    (save-excursion
-	      (while (re-search-forward delim nil t)
-		(beginning-of-line)
-		(delete-char 1)
-		(insert " ")))
-	    (setq body (buffer-substring (1- (point)) (point-max)))
-	    (narrow-to-region (point-min) (point))
-	    (if (not (setq headers gnus-uu-digest-headers))
-		(setq sorthead (buffer-substring (point-min) (point-max)))
-	      (while headers
-		(setq headline (car headers))
-		(setq headers (cdr headers))
-		(goto-char (point-min))
-		(while (re-search-forward headline nil t)
-		  (setq sorthead 
-			(concat sorthead
-				(buffer-substring 
-				 (match-beginning 0)
-				 (or (and (re-search-forward "^[^ \t]" nil t)
-					  (1- (point)))
-				     (progn (forward-line 1) (point)))))))))
-	    (widen)))
-	(insert sorthead) (goto-char (point-max))
-	(insert body) (goto-char (point-max))
-	(insert (concat "\n" (make-string 30 ?-) "\n\n"))
-	(goto-char beg)
-	(if (re-search-forward "^Subject: \\(.*\\)$" nil t)
-	    (progn
-	      (setq subj (buffer-substring (match-beginning 1) (match-end 1)))
-	      (save-excursion 
-		(set-buffer (get-buffer "*gnus-uu-pre*"))
-		(insert (format "   %s\n" subj))))))
-      (if (or (eq in-state 'last)
-	      (eq in-state 'first-and-last))
-	  (progn
-	    (save-excursion
-	      (set-buffer (get-buffer "*gnus-uu-pre*"))
-	      (insert (format "\n\n%s\n\n" (make-string 70 ?-)))
-	      (write-region 1 (point-max) gnus-uu-saved-article-name))
-	    (save-excursion
-	      (set-buffer (get-buffer "*gnus-uu-body*"))
-	      (goto-char (point-max))
-	      (insert 
-	       (concat (setq end-string (format "End of %s Digest" name)) 
-		       "\n"))
-	      (insert (concat (make-string (length end-string) ?*) "\n"))
-	      (write-region 1 (point-max) gnus-uu-saved-article-name t))
-	    (kill-buffer (get-buffer "*gnus-uu-pre*"))
-	    (kill-buffer (get-buffer "*gnus-uu-body*"))
-	    (setq state (cons 'end state))))
-      (if (memq 'begin state)
-	  (cons gnus-uu-saved-article-name state)
-	state)))))
-
-;; Binhex treatment - not very advanced. 
-
-(defconst gnus-uu-binhex-body-line 
-  "^[^:]...............................................................$")
-(defconst gnus-uu-binhex-begin-line 
-  "^:...............................................................$")
-(defconst gnus-uu-binhex-end-line
-  ":$")
-
-(defun gnus-uu-binhex-article (buffer in-state)
-  (let (state start-char)
-    (save-excursion
-      (set-buffer buffer)
-      (widen)
-      (goto-char (point-min))
-      (if (not (re-search-forward gnus-uu-binhex-begin-line nil t))
-	  (if (not (re-search-forward gnus-uu-binhex-body-line nil t))
-	      (setq state (list 'wrong-type))))
-
-      (if (memq 'wrong-type state)
-	  ()
-	(beginning-of-line)
-	(setq start-char (point))
-	(if (looking-at gnus-uu-binhex-begin-line)
-	    (progn
-	      (setq state (list 'begin))
-	      (write-region 1 1 gnus-uu-binhex-article-name))
-	  (setq state (list 'middle)))
-	(goto-char (point-max))
-	(re-search-backward (concat gnus-uu-binhex-body-line "\\|" 
-				    gnus-uu-binhex-end-line) nil t)
-	(if (looking-at gnus-uu-binhex-end-line)
-	    (setq state (if (memq 'begin state)
-			    (cons 'end state)
-			  (list 'end))))
-	(beginning-of-line)
-	(forward-line 1)
-	(if (file-exists-p gnus-uu-binhex-article-name)
-	    (append-to-file start-char (point) gnus-uu-binhex-article-name))))
-    (if (memq 'begin state)
-	(cons gnus-uu-binhex-article-name state)
-      state)))
-
-;; PostScript
-
-(defun gnus-uu-decode-postscript-article (process-buffer in-state)
-  (let ((state (list 'ok))
-	start-char end-char file-name)
-    (save-excursion
-      (set-buffer process-buffer)
-      (goto-char (point-min))
-      (if (not (re-search-forward gnus-uu-postscript-begin-string nil t))
-	  (setq state (list 'wrong-type))
-	(beginning-of-line)
-	(setq start-char (point))
-	(if (not (re-search-forward gnus-uu-postscript-end-string nil t))
-	    (setq state (list 'wrong-type))
-	  (setq end-char (point))
-	  (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
-	  (insert-buffer-substring process-buffer start-char end-char)
-	  (setq file-name (concat gnus-uu-work-dir
-				  (cdr gnus-article-current) ".ps"))
-	  (write-region (point-min) (point-max) file-name)
-	  (setq state (list file-name 'begin 'end)))))
-    state))
-      
-
-;; Find actions.
-
-(defun gnus-uu-get-actions (files)
-  (let ((ofiles files)
-	action name)
-    (while files
-      (setq name (cdr (assq 'name (car files))))
-      (and 
-       (setq action (gnus-uu-get-action name))
-       (setcar files (nconc (list (if (string= action "gnus-uu-archive")
-				      (cons 'action "file")
-				    (cons 'action action))
-				  (cons 'execute (gnus-uu-command
-						  action name)))
-			    (car files))))
-      (setq files (cdr files)))
-    ofiles))
-
-(defun gnus-uu-get-action (file-name)
-  (let (action)
-    (setq action 
-	  (gnus-uu-choose-action 
-	   file-name
-	   (append 
-	    gnus-uu-user-view-rules
-	    (if gnus-uu-ignore-default-view-rules 
-		nil 
-	      gnus-uu-default-view-rules)
-	    gnus-uu-user-view-rules-end)))
-    (if (and (not (string= (or action "") "gnus-uu-archive")) 
-	     gnus-uu-view-with-metamail)
-	(if (setq action 
-		  (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list))
-	    (setq action (format "metamail -d -b -c \"%s\"" action))))
-    action))
-
-
-;; Functions for treating subjects and collecting series.
-
-(defun gnus-uu-reginize-string (string)
-  ;; Takes a string and puts a \ in front of every special character;
-  ;; ignores any leading "version numbers" thingies that they use in
-  ;; the comp.binaries groups, and either replaces anything that looks
-  ;; like "2/3" with "[0-9]+/[0-9]+" or, if it can't find something
-  ;; like that, replaces the last two numbers with "[0-9]+". This, in
-  ;; my experience, should get most postings of a series.
-  (let ((count 2)
-	(vernum "v[0-9]+[a-z][0-9]+:")
-	beg)
-    (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (insert (regexp-quote string))
-      (setq beg 1)
-
-      (setq case-fold-search nil)
-      (goto-char (point-min))
-      (if (looking-at vernum)
-	  (progn
-	    (replace-match vernum t t)
-	    (setq beg (length vernum))))
-
-      (goto-char beg)
-      (if (re-search-forward "[ \t]*[0-9]+/[0-9]+" nil t)
-	  (replace-match " [0-9]+/[0-9]+")
-
-	(goto-char beg)
-	(if (re-search-forward "[0-9]+[ \t]*of[ \t]*[0-9]+" nil t)
-	    (replace-match "[0-9]+ of [0-9]+")
-
-	  (end-of-line)
-	  (while (and (re-search-backward "[0-9]" nil t) (> count 0))
-            (while (and 
-		    (looking-at "[0-9]") 
-		    (< 1 (goto-char (1- (point))))))
-            (re-search-forward "[0-9]+" nil t)
-	    (replace-match "[0-9]+")
-	    (backward-char 5)
-	    (setq count (1- count)))))
-
-      (goto-char beg)
-      (while (re-search-forward "[ \t]+" nil t)
-	(replace-match "[ \t]*" t t))
-
-      (buffer-substring 1 (point-max)))))
-
-(defun gnus-uu-get-list-of-articles (n)
-  ;; If N is non-nil, the article numbers of the N next articles
-  ;; will be returned.
-  ;; If any articles have been marked as processable, they will be
-  ;; returned. 
-  ;; Failing that, articles that have subjects that are part of the
-  ;; same "series" as the current will be returned.
-  (let (articles)
-    (cond 
-     (n
-      (let ((backward (< n 0))
-	    (n (abs n)))
-	(save-excursion
-	  (while (and (> n 0)
-		      (setq articles (cons (gnus-summary-article-number) 
-					   articles))
-		      (gnus-summary-search-forward nil nil backward))
-	    (setq n (1- n))))
-	(nreverse articles)))
-     (gnus-newsgroup-processable
-      (reverse gnus-newsgroup-processable))
-     (t
-      (gnus-uu-find-articles-matching)))))
-
-(defun gnus-uu-string< (l1 l2)
-  (string< (car l1) (car l2)))
-
-(defun gnus-uu-find-articles-matching 
-  (&optional subject only-unread do-not-translate)
-  ;; Finds all articles that matches the regexp SUBJECT.  If it is
-  ;; nil, the current article name will be used. If ONLY-UNREAD is
-  ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is
-  ;; non-nil, article names are not equalized before sorting.
-  (let ((subject (or subject 
-		     (gnus-uu-reginize-string (gnus-summary-article-subject))))
-	list-of-subjects)
-    (save-excursion
-      (if (not subject)
-	  ()
-	;; Collect all subjects matching subject.
-	(let ((case-fold-search t)
-	      (data gnus-newsgroup-data)
-	      subj mark d)
-	  (while data
-	    (setq d (pop data))
-	    (and (not (gnus-data-pseudo-p d))
-		 (or (not only-unread)
-		     (= (setq mark (gnus-data-mark d))
-			gnus-unread-mark)
-		     (= mark gnus-ticked-mark)
-		     (= mark gnus-dormant-mark))
-		 (setq subj (mail-header-subject (gnus-data-header d)))
-		 (string-match subject subj)
-		 (setq list-of-subjects 
-		       (cons (cons subj (gnus-data-number d))
-			     list-of-subjects)))))
-
-	;; Expand numbers, sort, and return the list of article
-	;; numbers.
-	(mapcar (lambda (sub) (cdr sub)) 
-		(sort (gnus-uu-expand-numbers 
-		       list-of-subjects
-		       (not do-not-translate)) 
-		      'gnus-uu-string<))))))
-
-(defun gnus-uu-expand-numbers (string-list &optional translate)
-  ;; Takes a list of strings and "expands" all numbers in all the
-  ;; strings.  That is, this function makes all numbers equal length by
-  ;; prepending lots of zeroes before each number. This is to ease later
-  ;; sorting to find out what sequence the articles are supposed to be
-  ;; decoded in. Returns the list of expanded strings.
-  (let ((out-list string-list)
-	string)
-    (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
-      (buffer-disable-undo (current-buffer))
-      (while string-list
-	(erase-buffer)
-	(insert (caar string-list))
-	;; Translate multiple spaces to one space.
-	(goto-char (point-min))
-	(while (re-search-forward "[ \t]+" nil t)
-	  (replace-match " "))
-	;; Translate all characters to "a".
-	(goto-char (point-min))
-	(if translate 
-	    (while (re-search-forward "[A-Za-z]" nil t)
-	      (replace-match "a" t t)))
-	;; Expand numbers.
-	(goto-char (point-min))
-	(while (re-search-forward "[0-9]+" nil t)
-	  (replace-match  
-	   (format "%06d" 
-		   (string-to-int (buffer-substring 
-				   (match-beginning 0) (match-end 0))))))
-	(setq string (buffer-substring 1 (point-max)))
-	(setcar (car string-list) string)
-	(setq string-list (cdr string-list))))
-    out-list))
-
-
-;; `gnus-uu-grab-articles' is the general multi-article treatment
-;; function.  It takes a list of articles to be grabbed and a function
-;; to apply to each article.
-;;
-;; The function to be called should take two parameters.  The first
-;; parameter is the article buffer. The function should leave the
-;; result, if any, in this buffer. Most treatment functions will just
-;; generate files...
-;;
-;; The second parameter is the state of the list of articles, and can
-;; have four values: `first', `middle', `last' and `first-and-last'.
-;;
-;; The function should return a list. The list may contain the
-;; following symbols:
-;; `error' if an error occurred
-;; `begin' if the beginning of an encoded file has been received
-;;   If the list returned contains a `begin', the first element of
-;;   the list *must* be a string with the file name of the decoded
-;;   file.
-;; `end' if the the end of an encoded file has been received
-;; `middle' if the article was a body part of an encoded file
-;; `wrong-type' if the article was not a part of an encoded file
-;; `ok', which can be used everything is ok
-
-(defvar gnus-uu-has-been-grabbed nil)
-
-(defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article)
-  (let (art)
-    (if (not (and gnus-uu-has-been-grabbed
-		  gnus-uu-unmark-articles-not-decoded))
-	()
-      (if dont-unmark-last-article
-	  (progn
-	    (setq art (car gnus-uu-has-been-grabbed))
-	    (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed))))
-      (while gnus-uu-has-been-grabbed
-	(gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t)
-	(setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
-      (if dont-unmark-last-article
-	  (setq gnus-uu-has-been-grabbed (list art))))))
-
-;; This function takes a list of articles and a function to apply to
-;; each article grabbed. 
-;; 
-;; This function returns a list of files decoded if the grabbing and
-;; the process-function has been successful and nil otherwise.
-(defun gnus-uu-grab-articles (articles process-function 
-				       &optional sloppy limit no-errors)
-  (let ((state 'first) 
-	has-been-begin article result-file result-files process-state
-	gnus-summary-display-article-function
-	gnus-article-display-hook gnus-article-prepare-hook
-	article-series files)
- 
-    (while (and articles 
-		(not (memq 'error process-state))
-		(or sloppy
-		    (not (memq 'end process-state))))
-
-      (setq article (pop articles))
-      (push article article-series)
-
-      (unless articles 
-	(if (eq state 'first)
-	    (setq state 'first-and-last)
-	  (setq state 'last)))
-
-      (let ((part (gnus-uu-part-number article)))
-	(gnus-message 6 "Getting article %d%s..." 
-		      article (if (string= part "") "" (concat ", " part))))
-      (gnus-summary-display-article article)
-      
-      ;; Push the article to the processing function.
-      (save-excursion
-	(set-buffer gnus-original-article-buffer)
-	(let ((buffer-read-only nil))
-	  (save-excursion
-	    (set-buffer gnus-summary-buffer)
-	    (setq process-state 
-		  (funcall process-function
-			   gnus-original-article-buffer state)))))
-
-      (gnus-summary-remove-process-mark article)
-
-      ;; If this is the beginning of a decoded file, we push it 
-      ;; on to a list.
-      (when (or (memq 'begin process-state)
-		(and (or (eq state 'first) 
-			 (eq state 'first-and-last))
-		     (memq 'ok process-state)))
-	(if has-been-begin
-	    ;; If there is a `result-file' here, that means that the
-	    ;; file was unsuccessfully decoded, so we delete it.
-	    (when (and result-file 
-		       (file-exists-p result-file)) 
-	      (delete-file result-file)))
-	(when (memq 'begin process-state)
-	  (setq result-file (car process-state)))
-	(setq has-been-begin t))
-
-      ;; Check whether we have decoded one complete file.
-      (when (memq 'end process-state)
-	(setq article-series nil)
-	(setq has-been-begin nil)
-	(if (stringp result-file)
-	    (setq files (list result-file))
-	  (setq files result-file))
-	(setq result-file (car files))
-	(while files
-	  (push (list (cons 'name (pop files))
-		      (cons 'article article))
-		result-files))
-	;; Allow user-defined functions to be run on this file.
-	(when gnus-uu-grabbed-file-functions
-	  (let ((funcs gnus-uu-grabbed-file-functions))
-	    (unless (listp funcs)
-	      (setq funcs (list funcs)))
-	    (while funcs
-	      (funcall (pop funcs) result-file))))
-	;; Check whether we have decoded enough articles.
-	(and limit (= (length result-files) limit)
-	     (setq articles nil)))
-
-      ;; If this is the last article to be decoded, and
-      ;; we still haven't reached the end, then we delete
-      ;; the partially decoded file.
-      (and (or (eq state 'last) (eq state 'first-and-last))
-	   (not (memq 'end process-state))
-	   result-file 
-	   (file-exists-p result-file)
-	   (delete-file result-file))
-
-      ;; If this was a file of the wrong sort, then 
-      (when (and (or (memq 'wrong-type process-state)
-		     (memq 'error process-state))
-		 gnus-uu-unmark-articles-not-decoded)
-	(gnus-summary-tick-article article t))
-
-      ;; Set the new series state.
-      (if (and (not has-been-begin)
-	       (not sloppy)
-	       (or (memq 'end process-state)
-		   (memq 'middle process-state)))
-	  (progn
-	    (setq process-state (list 'error))
-	    (gnus-message 2 "No begin part at the beginning")
-	    (sleep-for 2))
-	(setq state 'middle)))
-
-    ;; When there are no result-files, then something must be wrong.
-    (if result-files
-	(message "")
-      (cond
-       ((not has-been-begin)
-	(gnus-message 2 "Wrong type file"))
-       ((memq 'error process-state)
-	(gnus-message 2 "An error occurred during decoding"))
-       ((not (or (memq 'ok process-state) 
-		 (memq 'end process-state)))
-	(gnus-message 2 "End of articles reached before end of file")))
-      ;; Make unsuccessfully decoded articles unread.
-      (when gnus-uu-unmark-articles-not-decoded
-	(while article-series
-	  (gnus-summary-tick-article (pop article-series) t))))
-
-    result-files))
-
-(defun gnus-uu-grab-view (file)
-  "View FILE using the gnus-uu methods."
-  (let ((action (gnus-uu-get-action file)))
-    (gnus-execute-command
-     (if (string-match "%" action)
-	 (format action file)
-       (concat action " " file))
-     (eq gnus-view-pseudos 'not-confirm))))
-
-(defun gnus-uu-grab-move (file)
-  "Move FILE to somewhere."
-  (when gnus-uu-default-dir
-    (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir)
-			   (file-name-nondirectory file))))
-      (rename-file file to-file)
-      (unless (file-exists-p file)
-	(make-symbolic-link to-file file)))))
-
-(defun gnus-uu-part-number (article)
-  (let* ((header (gnus-summary-article-header article))
-	 (subject (and header (mail-header-subject header))))
-    (if (and subject 
-	     (string-match "[0-9]+ */[0-9]+\\|[0-9]+ * of *[0-9]+" subject))
-	(match-string 0 subject)
-      "")))
-
-(defun gnus-uu-uudecode-sentinel (process event)
-  (delete-process (get-process process)))
-
-(defun gnus-uu-uustrip-article (process-buffer in-state)
-  ;; Uudecodes a file asynchronously.
-  (save-excursion
-    (set-buffer process-buffer)
-    (let ((state (list 'wrong-type))
-	  process-connection-type case-fold-search buffer-read-only 
-	  files start-char)
-      (goto-char (point-min))
-
-      ;; Deal with ^M at the end of the lines.
-      (when gnus-uu-kill-carriage-return
-	(save-excursion
-	  (while (search-forward "\r" nil t)
-	    (delete-backward-char 1))))
-
-      (while (or (re-search-forward gnus-uu-begin-string nil t)
-		 (re-search-forward gnus-uu-body-line nil t))
-	(setq state (list 'ok))
-	;; Ok, we are at the first uucoded line.
-	(beginning-of-line)
-	(setq start-char (point))
-
-	(if (not (looking-at gnus-uu-begin-string))
-	    (setq state (list 'middle))
-	  ;; This is the beginning of an uuencoded article.
-	  ;; We replace certain characters that could make things messy.
-	  (setq gnus-uu-file-name 
-		(let ((nnheader-file-name-translation-alist
-		       '((?/ . ?,) (? . ?_) (?* . ?_) (?$ . ?_))))
-		  (nnheader-translate-file-chars (match-string 1))))
-
-	  ;; Remove any non gnus-uu-body-line right after start.
-	  (forward-line 1)
-	  (while (and (not (eobp))
-		      (not (looking-at gnus-uu-body-line)))
-	    (gnus-delete-line))
-
-	  ;; If a process is running, we kill it.
-	  (when (and gnus-uu-uudecode-process
-		     (memq (process-status gnus-uu-uudecode-process) 
-			   '(run stop)))
-	    (delete-process gnus-uu-uudecode-process)
-	    (gnus-uu-unmark-list-of-grabbed t))
-
-	  ;; Start a new uudecoding process.
-	  (setq gnus-uu-uudecode-process
-		(start-process 
-		 "*uudecode*" 
-		 (get-buffer-create gnus-uu-output-buffer-name)
-		 shell-file-name shell-command-switch
-		 (format "cd %s ; uudecode" gnus-uu-work-dir)))
-	  (set-process-sentinel 
-	   gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
-	  (setq state (list 'begin))
-	  (push (concat gnus-uu-work-dir gnus-uu-file-name) files))
-	
-	;; We look for the end of the thing to be decoded.
-	(if (re-search-forward gnus-uu-end-string nil t)
-	    (setq state (cons 'end state))
-	  (goto-char (point-max))
-	  (re-search-backward gnus-uu-body-line nil t))
-	 
-	(forward-line 1)
-
-	(when gnus-uu-uudecode-process
-	  (when (memq (process-status gnus-uu-uudecode-process) '(run stop))
-	    ;; Try to correct mishandled uucode.
-	    (when gnus-uu-correct-stripped-uucode
-	      (gnus-uu-check-correct-stripped-uucode start-char (point)))
-
-	    ;; Send the text to the process.
-	    (condition-case nil
-		(process-send-region
-		 gnus-uu-uudecode-process start-char (point))
-	      (error 
-	       (progn 
-		 (delete-process gnus-uu-uudecode-process)
-		 (gnus-message 2 "gnus-uu: Couldn't uudecode")
-		 (setq state (list 'wrong-type)))))
-
-	    (if (memq 'end state)
-		(progn
-		  ;; Send an EOF, just in case.
-		  (condition-case ()
-		      (process-send-eof gnus-uu-uudecode-process)
-		    (error nil))
-		  (while (memq (process-status gnus-uu-uudecode-process)
-			       '(open run))
-		    (accept-process-output gnus-uu-uudecode-process 1)))
-	      (when (or (not gnus-uu-uudecode-process)
-			(not (memq (process-status gnus-uu-uudecode-process)
-				   '(run stop))))
-		(setq state (list 'wrong-type)))))))
-
-      (if (memq 'begin state)
-	  (cons (if (= (length files) 1) (car files) files) state)
-	state))))
-
-;; This function is used by `gnus-uu-grab-articles' to treat
-;; a shared article.
-(defun gnus-uu-unshar-article (process-buffer in-state)
-  (let ((state (list 'ok))
-	start-char)
-    (save-excursion
-      (set-buffer process-buffer)
-      (goto-char (point-min))
-      (if (not (re-search-forward gnus-uu-shar-begin-string nil t))
-	  (setq state (list 'wrong-type))
-	(beginning-of-line)
-	(setq start-char (point))
-	(call-process-region 
-	 start-char (point-max) shell-file-name nil 
-	 (get-buffer-create gnus-uu-output-buffer-name) nil 
-	 shell-command-switch (concat "cd " gnus-uu-work-dir " ; sh"))))
-    state))
-
-;; Returns the name of what the shar file is going to unpack.
-(defun gnus-uu-find-name-in-shar ()
-  (let ((oldpoint (point))
-	res)
-    (goto-char (point-min))
-    (if (re-search-forward gnus-uu-shar-name-marker nil t)
-	(setq res (buffer-substring (match-beginning 1) (match-end 1))))
-    (goto-char oldpoint)
-    res))
-
-;; `gnus-uu-choose-action' chooses what action to perform given the name
-;; and `gnus-uu-file-action-list'.  Returns either nil if no action is
-;; found, or the name of the command to run if such a rule is found.
-(defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore)
-  (let ((action-list (copy-sequence file-action-list))
-	(case-fold-search t)
-	rule action)
-    (and 
-     (or no-ignore 
-	 (and (not 
-	       (and gnus-uu-ignore-files-by-name
-		    (string-match gnus-uu-ignore-files-by-name file-name)))
-	      (not 
-	       (and gnus-uu-ignore-files-by-type
-		    (string-match gnus-uu-ignore-files-by-type 
-				  (or (gnus-uu-choose-action 
-				       file-name gnus-uu-ext-to-mime-list t) 
-				      ""))))))
-     (while (not (or (eq action-list ()) action))
-       (setq rule (car action-list))
-       (setq action-list (cdr action-list))
-       (if (string-match (car rule) file-name)
-	   (setq action (cadr rule)))))
-    action))
-
-(defun gnus-uu-treat-archive (file-path)
-  ;; Unpacks an archive. Returns t if unpacking is successful.
-  (let ((did-unpack t)
-	action command dir)
-    (setq action (gnus-uu-choose-action 
-		  file-path (append gnus-uu-user-archive-rules
-				    (if gnus-uu-ignore-default-archive-rules
-					nil
-				      gnus-uu-default-archive-rules))))
-
-    (if (not action) (error "No unpackers for the file %s" file-path))
-
-    (string-match "/[^/]*$" file-path)
-    (setq dir (substring file-path 0 (match-beginning 0)))
-
-    (if (member action gnus-uu-destructive-archivers)
-	(copy-file file-path (concat file-path "~") t))
-
-    (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path)))
-
-    (save-excursion
-      (set-buffer (get-buffer-create gnus-uu-output-buffer-name))
-      (erase-buffer))
-
-    (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
-
-    (if (= 0 (call-process shell-file-name nil 
-			   (get-buffer-create gnus-uu-output-buffer-name)
-			   nil shell-command-switch command))
-	(message "")
-      (gnus-message 2 "Error during unpacking of archive")
-      (setq did-unpack nil))
-
-    (if (member action gnus-uu-destructive-archivers)
-	(rename-file (concat file-path "~") file-path t))
-
-    did-unpack))
-
-(defun gnus-uu-dir-files (dir)
-  (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$"))
-	files file)
-    (while dirs
-      (if (file-directory-p (setq file (car dirs)))
-	  (setq files (append files (gnus-uu-dir-files file)))
-	(setq files (cons file files)))
-      (setq dirs (cdr dirs)))
-    files))
-
-(defun gnus-uu-unpack-files (files &optional ignore)
-  ;; Go through FILES and look for files to unpack. 
-  (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir))
-	 (ofiles files)
-	 file did-unpack)
-    (while files
-      (setq file (cdr (assq 'name (car files))))
-      (if (and (not (member file ignore))
-	       (equal (gnus-uu-get-action (file-name-nondirectory file))
-		      "gnus-uu-archive"))
-	  (progn
-	    (setq did-unpack (cons file did-unpack))
-	    (or (gnus-uu-treat-archive file)
-		(gnus-message 2 "Error during unpacking of %s" file))
-	    (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir))
-		   (nfiles newfiles))
-	      (while nfiles
-		(or (member (car nfiles) totfiles)
-		    (setq ofiles (cons (list (cons 'name (car nfiles))
-					     (cons 'original file))
-				       ofiles)))
-		(setq nfiles (cdr nfiles)))
-	      (setq totfiles newfiles))))
-      (setq files (cdr files)))
-    (if did-unpack 
-	(gnus-uu-unpack-files ofiles (append did-unpack ignore))
-      ofiles)))
-
-(defun gnus-uu-ls-r (dir)
-  (let* ((files (gnus-uu-directory-files dir t))
-	 (ofiles files))
-    (while files
-      (if (file-directory-p (car files))
-	  (progn
-	    (setq ofiles (delete (car files) ofiles))
-	    (setq ofiles (append ofiles (gnus-uu-ls-r (car files))))))
-      (setq files (cdr files)))
-    ofiles))
-
-;; Various stuff
-
-(defun gnus-uu-directory-files (dir &optional full)
-  (let (files out file)
-    (setq files (directory-files dir full))
-    (while files
-      (setq file (car files))
-      (setq files (cdr files))
-      (or (member (file-name-nondirectory file) '("." ".."))
-	  (setq out (cons file out))))
-    (setq out (nreverse out))
-    out))
-
-(defun gnus-uu-check-correct-stripped-uucode (start end)
-  (save-excursion
-    (let (found beg length)
-      (if (not gnus-uu-correct-stripped-uucode)
-	  ()
-	(goto-char start)
-
-	(if (re-search-forward " \\|`" end t)
-	    (progn
-	      (goto-char start)
-	      (while (not (eobp))
-		(progn
-		  (if (looking-at "\n") (replace-match ""))
-		  (forward-line 1))))
-	    
-	  (while (not (eobp))
-	    (if (looking-at (concat gnus-uu-begin-string "\\|" 
-				    gnus-uu-end-string))
-		()
-	      (if (not found)
-		  (progn
-		    (beginning-of-line)
-		    (setq beg (point))
-		    (end-of-line)
-		    (setq length (- (point) beg))))
-	      (setq found t)
-	      (beginning-of-line)
-	      (setq beg (point))
-	      (end-of-line)
-	      (if (not (= length (- (point) beg)))
-		  (insert (make-string (- length (- (point) beg)) ? ))))
-	    (forward-line 1)))))))
-
-(defvar gnus-uu-tmp-alist nil)
-
-(defun gnus-uu-initialize (&optional scan)
-  (let (entry)
-    (if (and (not scan)
-	     (if (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist))
-		 (if (file-exists-p (cdr entry))
-		     (setq gnus-uu-work-dir (cdr entry))
-		   (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist))
-		   nil)))
-	t
-      (setq gnus-uu-tmp-dir (file-name-as-directory 
-			     (expand-file-name gnus-uu-tmp-dir)))
-      (if (not (file-directory-p gnus-uu-tmp-dir))
-	  (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir)
-	(if (not (file-writable-p gnus-uu-tmp-dir))
-	    (error "Temp directory %s can't be written to" 
-		   gnus-uu-tmp-dir)))
-
-      (setq gnus-uu-work-dir 
-	    (make-temp-name (concat gnus-uu-tmp-dir "gnus")))
-      (if (not (file-directory-p gnus-uu-work-dir)) 
-	  (gnus-make-directory gnus-uu-work-dir))
-      (set-file-modes gnus-uu-work-dir 448)
-      (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
-      (setq gnus-uu-tmp-alist (cons (cons gnus-newsgroup-name gnus-uu-work-dir)
-				    gnus-uu-tmp-alist)))))
-
-
-;; Kills the temporary uu buffers, kills any processes, etc.
-(defun gnus-uu-clean-up ()
-  (let (buf pst)
-    (and gnus-uu-uudecode-process
-	 (memq (process-status (or gnus-uu-uudecode-process "nevair"))
-	       '(stop run))
-	 (delete-process gnus-uu-uudecode-process))
-    (and (setq buf (get-buffer gnus-uu-output-buffer-name))
-	 (kill-buffer buf))))
-
-;; Inputs an action and a file and returns a full command, putting
-;; quotes round the file name and escaping any quotes in the file name.
-(defun gnus-uu-command (action file)
-  (let ((ofile ""))
-    (while (string-match "!\\|`\\|\"\\|\\$\\|\\\\\\|&" file)
-      (progn
-	(setq ofile
-	      (concat ofile (substring file 0 (match-beginning 0)) "\\"
-		      (substring file (match-beginning 0) (match-end 0))))
-	(setq file (substring file (1+ (match-beginning 0))))))
-    (setq ofile (concat "\"" ofile file "\""))
-    (if (string-match "%s" action)
-	(format action ofile)
-      (concat action " " ofile))))
-
-(defun gnus-uu-delete-work-dir (&optional dir)
-  "Delete recursively all files and directories under `gnus-uu-work-dir'."
-  (if dir
-      (gnus-message 7 "Deleting directory %s..." dir)
-    (setq dir gnus-uu-work-dir))
-  (when (and dir
-	     (file-exists-p dir))
-    (let ((files (directory-files dir t nil t))
-	  file)
-      (while (setq file (pop files))
-	(unless (member (file-name-nondirectory file) '("." ".."))
-	  (if (file-directory-p file)
-	      (gnus-uu-delete-work-dir file)
-	    (gnus-message 9 "Deleting file %s..." file)
-	    (delete-file file))))
-      (delete-directory dir)))
-  (gnus-message 7 ""))
-
-;; Initializing
-
-(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up)
-(add-hook 'gnus-exit-group-hook	'gnus-uu-delete-work-dir)
-
-
-
-;;;
-;;; uuencoded posting
-;;;
-
-;; Any function that is to be used as and encoding method will take two
-;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg"
-;; and "spiral.jpg", respectively.) The function should return nil if
-;; the encoding wasn't successful.
-(defvar gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode
-  "Function used for encoding binary files.
-There are three functions supplied with gnus-uu for encoding files:
-`gnus-uu-post-encode-uuencode', which does straight uuencoding;
-`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME 
-headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with 
-uuencode and adds MIME headers.")
-
-(defvar gnus-uu-post-include-before-composing nil
-  "Non-nil means that gnus-uu will ask for a file to encode before you compose the article.
-If this variable is t, you can either include an encoded file with
-\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article.")
-
-(defvar gnus-uu-post-length 990
-  "Maximum length of an article.
-The encoded file will be split into how many articles it takes to
-post the entire file.")
-
-(defvar gnus-uu-post-threaded nil
-  "Non-nil means that gnus-uu will post the encoded file in a thread.
-This may not be smart, as no other decoder I have seen are able to
-follow threads when collecting uuencoded articles. (Well, I have seen
-one package that does that - gnus-uu, but somehow, I don't think that 
-counts...) Default is nil.")
-
-(defvar gnus-uu-post-separate-description t
-  "Non-nil means that the description will be posted in a separate article.
-The first article will typically be numbered (0/x). If this variable
-is nil, the description the user enters will be included at the 
-beginning of the first article, which will be numbered (1/x). Default 
-is t.")
-
-(defvar gnus-uu-post-binary-separator "--binary follows this line--")
-(defvar gnus-uu-post-message-id nil)
-(defvar gnus-uu-post-inserted-file-name nil)
-(defvar gnus-uu-winconf-post-news nil)
-
-(defun gnus-uu-post-news ()
-  "Compose an article and post an encoded file."
-  (interactive)
-  (setq gnus-uu-post-inserted-file-name nil)
-  (setq gnus-uu-winconf-post-news (current-window-configuration))
-
-  (gnus-summary-post-news)
-
-  (use-local-map (copy-keymap (current-local-map)))
-  (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
-  (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
-  (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
-  (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article)
-      
-  (if gnus-uu-post-include-before-composing
-      (save-excursion (setq gnus-uu-post-inserted-file-name 
-			    (gnus-uu-post-insert-binary)))))
-
-(defun gnus-uu-post-insert-binary-in-article ()
-  "Inserts an encoded file in the buffer.
-The user will be asked for a file name."
-  (interactive)
-  (save-excursion 
-    (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))
-
-;; Encodes with uuencode and substitutes all spaces with backticks.
-(defun gnus-uu-post-encode-uuencode (path file-name)
-  (if (gnus-uu-post-encode-file "uuencode" path file-name)
-      (progn
-	(goto-char (point-min))
-	(forward-line 1)
-	(while (re-search-forward " " nil t)
-	  (replace-match "`"))
-	t)))
-
-;; Encodes with uuencode and adds MIME headers.
-(defun gnus-uu-post-encode-mime-uuencode (path file-name)
-  (if (gnus-uu-post-encode-uuencode path file-name)
-      (progn
-	(gnus-uu-post-make-mime file-name "x-uue")
-	t)))
-
-;; Encodes with base64 and adds MIME headers
-(defun gnus-uu-post-encode-mime (path file-name)
-  (if (gnus-uu-post-encode-file "mmencode" path file-name)
-      (progn
-	(gnus-uu-post-make-mime file-name "base64")
-	t)))
-
-;; Adds MIME headers.
-(defun gnus-uu-post-make-mime (file-name encoding)
-  (goto-char (point-min))
-  (insert (format "Content-Type: %s; name=\"%s\"\n" 
-		  (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list) 
-		  file-name))
-  (insert (format "Content-Transfer-Encoding: %s\n\n" encoding))
-  (save-restriction
-    (set-buffer gnus-message-buffer)
-    (goto-char (point-min))
-    (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
-    (forward-line -1)
-    (narrow-to-region 1 (point))
-    (or (mail-fetch-field "mime-version")
-	(progn
-	  (widen)
-	  (insert "MIME-Version: 1.0\n")))
-    (widen)))
-
-;; Encodes a file PATH with COMMAND, leaving the result in the
-;; current buffer.
-(defun gnus-uu-post-encode-file (command path file-name)
-  (= 0 (call-process shell-file-name nil t nil shell-command-switch 
-		     (format "%s %s %s" command path file-name))))
-
-(defun gnus-uu-post-news-inews ()
-  "Posts the composed news article and encoded file.
-If no file has been included, the user will be asked for a file."
-  (interactive)
-
-  (let (file-name)
-
-    (if gnus-uu-post-inserted-file-name
-	(setq file-name gnus-uu-post-inserted-file-name)
-      (setq file-name (gnus-uu-post-insert-binary)))
-  
-    (if gnus-uu-post-threaded
-	(let ((message-required-news-headers 
-	       (if (memq 'Message-ID message-required-news-headers)
-		   message-required-news-headers
-		 (cons 'Message-ID message-required-news-headers)))
-	      gnus-inews-article-hook)
-
-	  (setq gnus-inews-article-hook (if (listp gnus-inews-article-hook)
-					    gnus-inews-article-hook
-					  (list gnus-inews-article-hook)))
-	  (setq gnus-inews-article-hook 
-		(cons
-		 '(lambda ()
-		    (save-excursion
-		      (goto-char (point-min))
-		      (if (re-search-forward "^Message-ID: \\(.*\\)$" nil t)
-			  (setq gnus-uu-post-message-id 
-				(buffer-substring 
-				 (match-beginning 1) (match-end 1)))
-			(setq gnus-uu-post-message-id nil))))
-		 gnus-inews-article-hook))
-	  (gnus-uu-post-encoded file-name t))
-      (gnus-uu-post-encoded file-name nil)))
-  (setq gnus-uu-post-inserted-file-name nil)
-  (and gnus-uu-winconf-post-news
-       (set-window-configuration gnus-uu-winconf-post-news)))
-      
-;; Asks for a file to encode, encodes it and inserts the result in
-;; the current buffer. Returns the file name the user gave.
-(defun gnus-uu-post-insert-binary ()
-  (let ((uuencode-buffer-name "*uuencode buffer*")
-	file-path uubuf file-name)
-
-    (setq file-path (read-file-name 
-		     "What file do you want to encode? "))
-    (if (not (file-exists-p file-path))
-	(error "%s: No such file" file-path))
-
-    (goto-char (point-max))
-    (insert (format "\n%s\n" gnus-uu-post-binary-separator))
-    
-    (if (string-match "^~/" file-path)
-	(setq file-path (concat "$HOME" (substring file-path 1))))
-    (if (string-match "/[^/]*$" file-path)
-	(setq file-name (substring file-path (1+ (match-beginning 0))))
-      (setq file-name file-path))
-
-    (unwind-protect
-	(if (save-excursion
-	      (set-buffer (setq uubuf 
-				(get-buffer-create uuencode-buffer-name)))
-	      (erase-buffer)
-	      (funcall gnus-uu-post-encode-method file-path file-name))
-	    (insert-buffer-substring uubuf)
-	  (error "Encoding unsuccessful"))
-      (kill-buffer uubuf))
-    file-name))
-
-;; Posts the article and all of the encoded file.
-(defun gnus-uu-post-encoded (file-name &optional threaded)
-  (let ((send-buffer-name "*uuencode send buffer*")
-	(encoded-buffer-name "*encoded buffer*")
-	(top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]")
-	(separator (concat mail-header-separator "\n\n"))
-	uubuf length parts header i end beg
-	beg-line minlen buf post-buf whole-len beg-binary end-binary)
-
-    (setq post-buf (current-buffer))
-
-    (goto-char (point-min))
-    (if (not (re-search-forward 
-	      (if gnus-uu-post-separate-description 
-		  (concat "^" (regexp-quote gnus-uu-post-binary-separator)
-			  "$")
-		(concat "^" (regexp-quote mail-header-separator) "$")) nil t))
-	(error "Internal error: No binary/header separator"))
-    (beginning-of-line)
-    (forward-line 1)
-    (setq beg-binary (point))
-    (setq end-binary (point-max))
-
-    (save-excursion 
-      (set-buffer (setq uubuf (get-buffer-create encoded-buffer-name)))
-      (erase-buffer)
-      (insert-buffer-substring post-buf beg-binary end-binary)
-      (goto-char (point-min))
-      (setq length (count-lines 1 (point-max)))
-      (setq parts (/ length gnus-uu-post-length))
-      (if (not (< (% length gnus-uu-post-length) 4))
-	  (setq parts (1+ parts))))
-
-    (if gnus-uu-post-separate-description
-	(forward-line -1))
-    (kill-region (point) (point-max))
-
-    (goto-char (point-min))
-    (re-search-forward 
-     (concat "^" (regexp-quote mail-header-separator) "$") nil t)
-    (beginning-of-line)
-    (setq header (buffer-substring 1 (point)))
-
-    (goto-char (point-min))
-    (if (not gnus-uu-post-separate-description)
-	()
-      (if (and (not threaded) (re-search-forward "^Subject: " nil t))
-	  (progn
-	    (end-of-line)
-	    (insert (format " (0/%d)" parts))))
-      (message-send))
-
-    (save-excursion
-      (setq i 1)
-      (setq beg 1)
-      (while (not (> i parts))
-	(set-buffer (get-buffer-create send-buffer-name))
-	(erase-buffer)
-	(insert header)
-	(if (and threaded gnus-uu-post-message-id)
-	    (insert (format "References: %s\n" gnus-uu-post-message-id)))
-	(insert separator)
-	(setq whole-len
-	      (- 62 (length (format top-string "" file-name i parts ""))))
-	(if (> 1 (setq minlen (/ whole-len 2)))
-	    (setq minlen 1))
-	(setq 
-	 beg-line 
-	 (format top-string
-		 (make-string minlen ?-) 
-		 file-name i parts
-		 (make-string 
-		  (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
-
-	(goto-char (point-min))
-	(if (not (re-search-forward "^Subject: " nil t))
-	    ()
-	  (if (not threaded)
-	      (progn
-		(end-of-line)
-		(insert (format " (%d/%d)" i parts)))
-	    (if (or (and (= i 2) gnus-uu-post-separate-description)
-		    (and (= i 1) (not gnus-uu-post-separate-description)))
-		(replace-match "Subject: Re: "))))
-		  
-	(goto-char (point-max))
-	(save-excursion
-	  (set-buffer uubuf)
-	  (goto-char beg)
-	  (if (= i parts)
-	      (goto-char (point-max))
-	    (forward-line gnus-uu-post-length))
-	  (if (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4))
-	      (forward-line -4))
-	  (setq end (point)))
-	(insert-buffer-substring uubuf beg end)
-	(insert beg-line)
-	(insert "\n")
-	(setq beg end)
-	(setq i (1+ i))
-	(goto-char (point-min))
-	(re-search-forward
-	 (concat "^" (regexp-quote mail-header-separator) "$") nil t)
-	(beginning-of-line)
-	(forward-line 2)
-	(if (re-search-forward 
-	     (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$")
-	     nil t)
-	    (progn 
-	      (replace-match "")
-	      (forward-line 1)))
-	(insert beg-line)
-	(insert "\n")
-	(let (message-sent-message-via)
-	  (message-send))))
-
-    (and (setq buf (get-buffer send-buffer-name))
-	 (kill-buffer buf))
-    (and (setq buf (get-buffer encoded-buffer-name))
-	 (kill-buffer buf))
-
-    (if (not gnus-uu-post-separate-description)
-	(progn
-	  (set-buffer-modified-p nil)
-	  (and (fboundp 'bury-buffer) (bury-buffer))))))
-
-(provide 'gnus-uu)
-
-;; gnus-uu.el ends here
diff --git a/lisp/gnus-vis.el b/lisp/gnus-vis.el
deleted file mode 100644
index 0258368cce8..00000000000
--- a/lisp/gnus-vis.el
+++ /dev/null
@@ -1,1615 +0,0 @@
-;;; gnus-vis.el --- display-oriented parts of Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Per Abrahamsen <abraham@iesd.auc.dk>
-;; Keywords: news
-
-;; 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:
-
-(require 'gnus)
-(require 'gnus-ems)
-(require 'easymenu)
-(require 'custom)
-(require 'browse-url)
-(require 'gnus-score)
-(eval-when-compile (require 'cl))
-
-(defvar gnus-group-menu-hook nil
-  "*Hook run after the creation of the group mode menu.")
-
-(defvar gnus-summary-menu-hook nil
-  "*Hook run after the creation of the summary mode menu.")
-
-(defvar gnus-article-menu-hook nil
-  "*Hook run after the creation of the article mode menu.")
-
-;;; Summary highlights.
-
-;(defvar gnus-summary-highlight-properties
-;  '((unread "ForestGreen" "green")
-;    (ticked "Firebrick" "pink")
-;    (read "black" "white")
-;    (low italic italic)
-;    (high bold bold)
-;    (canceled "yellow/black" "black/yellow")))
-
-;(defvar gnus-summary-highlight-translation
-;  '(((unread (= mark gnus-unread-mark))
-;     (ticked (or (= mark gnus-ticked-mark) (= mark gnus-dormant-mark)))
-;     (read (not (or (= mark gnus-unread-mark) (= mark gnus-dormant-mark)
-;		    (= mark gnus-ticked-mark) (= mark gnus-canceled-mark))))
-;     (canceled (= mark gnus-canceled-mark)))
-;    ((low (< score gnus-summary-default-score))
-;     (high (> score gnus-summary-default-score)))))
-
-;(defun gnus-visual-map-face-translation ()
-;  (let ((props gnus-summary-highlight-properties)
-;	(trans gnus-summary-highlight-translation)
-;	map)
-;    (while props)))
-      
-;see gnus-cus.el
-;(defvar gnus-summary-selected-face 'underline
-;  "*Face used for highlighting the current article in the summary buffer.")
- 
-;see gnus-cus.el
-;(defvar gnus-summary-highlight
-;  (cond ((not (eq gnus-display-type 'color))
-;	 '(((> score default) . bold)
-;	   ((< score default) . italic)))
-;	((eq gnus-background-mode 'dark)
-;	 (list (cons '(= mark gnus-canceled-mark)
-;		     (custom-face-lookup "yellow" "black" nil nil nil nil))
-;	       (cons '(and (> score default) 
-;			   (or (= mark gnus-dormant-mark)
-;			       (= mark gnus-ticked-mark)))
-;		     (custom-face-lookup "pink" nil nil t nil nil))
-;	       (cons '(and (< score default) 
-;			   (or (= mark gnus-dormant-mark)
-;			       (= mark gnus-ticked-mark)))
-;		     (custom-face-lookup "pink" nil nil nil t nil))
-;	       (cons '(or (= mark gnus-dormant-mark)
-;			  (= mark gnus-ticked-mark))
-;		     (custom-face-lookup "pink" nil nil nil nil nil))
-
-;	       (cons '(and (> score default) (= mark gnus-ancient-mark))
-;		     (custom-face-lookup "SkyBlue" nil nil t nil nil))
-;	       (cons '(and (< score default) (= mark gnus-ancient-mark))
-;		     (custom-face-lookup "SkyBlue" nil nil nil t nil))
-;	       (cons '(= mark gnus-ancient-mark)
-;		     (custom-face-lookup "SkyBlue" nil nil nil nil nil))
-
-;	       (cons '(and (> score default) (= mark gnus-unread-mark))
-;		     (custom-face-lookup "white" nil nil t nil nil))
-;	       (cons '(and (< score default) (= mark gnus-unread-mark))
-;		     (custom-face-lookup "white" nil nil nil t nil))
-;	       (cons '(= mark gnus-unread-mark)
-;		     (custom-face-lookup "white" nil nil nil nil nil))
-
-;	       (cons '(> score default) 'bold)
-;	       (cons '(< score default) 'italic)))
-;	(t
-;	 (list (cons '(= mark gnus-canceled-mark)
-;		     (custom-face-lookup "yellow" "black" nil nil nil nil))
-;	       (cons '(and (> score default) 
-;			   (or (= mark gnus-dormant-mark)
-;			       (= mark gnus-ticked-mark)))
-;		     (custom-face-lookup "firebrick" nil nil t nil nil))
-;	       (cons '(and (< score default) 
-;			   (or (= mark gnus-dormant-mark)
-;			       (= mark gnus-ticked-mark)))
-;		     (custom-face-lookup "firebrick" nil nil nil t nil))
-;	       (cons '(or (= mark gnus-dormant-mark)
-;			  (= mark gnus-ticked-mark))
-;		     (custom-face-lookup "firebrick" nil nil nil nil nil))
-
-;	       (cons '(and (> score default) (= mark gnus-ancient-mark))
-;		     (custom-face-lookup "RoyalBlue" nil nil t nil nil))
-;	       (cons '(and (< score default) (= mark gnus-ancient-mark))
-;		     (custom-face-lookup "RoyalBlue" nil nil nil t nil))
-;	       (cons '(= mark gnus-ancient-mark)
-;		     (custom-face-lookup "RoyalBlue" nil nil nil nil nil))
-
-;	       (cons '(and (> score default) (/= mark gnus-unread-mark))
-;		     (custom-face-lookup "DarkGreen" nil nil t nil nil))
-;	       (cons '(and (< score default) (/= mark gnus-unread-mark))
-;		     (custom-face-lookup "DarkGreen" nil nil nil t nil))
-;	       (cons '(/= mark gnus-unread-mark)
-;		     (custom-face-lookup "DarkGreen" nil nil nil nil nil))
-
-;	       (cons '(> score default) 'bold)
-;	       (cons '(< score default) 'italic))))
-;  "*Alist of `(FORM . FACE)'.
-;Summary lines are highlighted with the FACE for the first FORM which
-;evaluate to a non-nil value.  
-
-;Point will be at the beginning of the line when FORM is evaluated.
-;The following can be used for convenience:
-
-;score:   (gnus-summary-article-score)
-;default: gnus-summary-default-score
-;below:   gnus-summary-mark-below
-;mark:    (gnus-summary-article-mark)
-
-;The latter can be used like this:
-;   ((= mark gnus-replied-mark) . underline)")
-
-;;; article highlights
-
-;see gnus-cus.el
-;(defvar gnus-header-face-alist 
-;  (cond ((not (eq gnus-display-type 'color))
-;	 '(("" bold italic)))
-;	((eq gnus-background-mode 'dark)
-;	 (list (list "From" nil 
-;		     (custom-face-lookup "SkyBlue" nil nil t t nil))
-;	       (list "Subject" nil 
-;		     (custom-face-lookup "pink" nil nil t t nil))
-;	       (list "Newsgroups:.*," nil
-;		     (custom-face-lookup "yellow" nil nil t t nil))
-;	       (list "" 
-;		     (custom-face-lookup "cyan" nil nil t nil nil)
-;		     (custom-face-lookup "green" nil nil nil t nil))))
-;	(t
-;	 (list (list "From" nil 
-;		     (custom-face-lookup "RoyalBlue" nil nil t t nil))
-;	       (list "Subject" nil 
-;		     (custom-face-lookup "firebrick" nil nil t t nil))
-;	       (list "Newsgroups:.*," nil
-;		     (custom-face-lookup "red" nil nil t t nil))
-;	       (list ""
-;		     (custom-face-lookup "DarkGreen" nil nil t nil nil)
-;		     (custom-face-lookup "DarkGreen" nil nil nil t nil)))))
-;  "Alist of headers and faces used for highlighting them.
-;The entries in the list has the form `(REGEXP NAME CONTENT)', where
-;REGEXP is a regular expression matching the beginning of the header,
-;NAME is the face used for highlighting the header name and CONTENT is
-;the face used for highlighting the header content. 
-
-;The first non-nil NAME or CONTENT with a matching REGEXP in the list
-;will be used.")
-
-
-;see gnus-cus.el
-;(defvar gnus-make-foreground t
-;  "Non nil means foreground color to highlight citations.")
-
-;see gnus-cus.el
-;(defvar gnus-article-button-face 'bold
-;  "Face used for text buttons.")
-
-;see gnus-cus.el
-;(defvar gnus-article-mouse-face (if (boundp 'gnus-mouse-face)
-;				    gnus-mouse-face
-;				  'highlight)
-;  "Face used when the mouse is over the button.")
-
-;see gnus-cus.el
-;(defvar gnus-signature-face 'italic
-;  "Face used for signature.")
-
-(defvar gnus-button-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-\\wa-zA-Z0-9_=!?#$@~`%&*+|\\/.,]*[-\\wa-zA-Z0-9_=#$@~`%&*+|\\/]"
-  "*Regular expression that matches URLs.")
-
-(defvar gnus-button-alist 
-  `(("\\bin\\( +article\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)" 2 
-     t gnus-button-message-id 3)
-    ("\\(<?\\(url: ?\\)?news:\\([^>\n\t ]*\\)>?\\)" 1 t
-     gnus-button-message-id 3)
-    ("\\(<URL: *\\)?mailto: *\\([^> \n\t]+\\)>?" 0 t gnus-button-reply 2)
-    ;; Next regexp stolen from highlight-headers.el.
-    ;; Modified by Vladimir Alexiev.
-    (,gnus-button-url-regexp 0 t gnus-button-url 0)
-    ;; This is how URLs _should_ be embedded in text...  It should go
-    ;; last to avoid matching only a subset of the URL, depending on
-    ;; how it was broken across lines.
-    ("<URL:\\([^>]+\\)>" 0 t gnus-button-url 1))
-  "Alist of regexps matching buttons in article bodies.
-
-Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
-REGEXP: is the string matching text around the button,
-BUTTON: is the number of the regexp grouping actually matching the button,
-FORM: is a lisp expression which must eval to true for the button to
-be added, 
-CALLBACK: is the function to call when the user push this button, and each
-PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
-
-CALLBACK can also be a variable, in that case the value of that
-variable it the real callback function.")
-
-(defvar gnus-header-button-alist 
-  `(("^\\(References\\|Message-I[Dd]\\):" "<[^>]+>"
-     0 t gnus-button-message-id 0)
-    ("^\\(From\\|Reply-To\\): " ": *\\(.+\\)$" 1 t gnus-button-reply 0)
-    ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+" 
-     0 t gnus-button-mailto 0)
-    ("^X-[Uu][Rr][Ll]:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
-    ("^[^:]+:" ,gnus-button-url-regexp 0 t gnus-button-url 0)
-    ("^[^:]+:" "\\(<\\(url: \\)?news:\\([^>\n ]*\\)>\\)" 1 t
-     gnus-button-message-id 3))
-  "Alist of headers and regexps to match buttons in article heads.
-
-This alist is very similar to `gnus-button-alist', except that each
-alist has an additional HEADER element first in each entry:
-
-\(HEADER REGEXP BUTTON FORM CALLBACK PAR)
-
-HEADER is a regexp to match a header.  For a fuller explanation, see
-`gnus-button-alist'.")
-
-;see gnus-cus.el
-;(eval-when-compile
-;  (defvar browse-url-browser-function))
-
-;;; Group mode highlighting.
-
-;see gnus-cus.el
-;(defvar gnus-group-highlight nil
-;  "Group lines are highlighted with the FACE for the first FORM which
-;evaluate to a non-nil value.  
-;
-;Point will be at the beginning of the line when FORM is evaluated.
-;Variables bound when these forms are evaluated include:
-;
-;group: The group name.
-;unread: The number of unread articles.
-;method: The select method.
-;mailp: Whether the select method is a mail method.
-;level: The level of the group.
-;score: The score of the group.
-;ticked: The number of ticked articles in the group.
-;")
-
-
-;;; Internal variables.
-
-(defvar gnus-button-marker-list nil)
-
-
-
-(eval-and-compile
-  (autoload 'nnkiboze-generate-groups "nnkiboze")
-  (autoload 'gnus-cite-parse-maybe "gnus-cite" nil t))
-
-;;;
-;;; gnus-menu
-;;;
-
-(defun gnus-visual-turn-off-edit-menu (type)
-  (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
-    [menu-bar edit] 'undefined))
-
-;; Newsgroup buffer
-
-(defun gnus-group-make-menu-bar ()
-  (gnus-visual-turn-off-edit-menu 'group)
-  (or 
-   (boundp 'gnus-group-reading-menu)
-   (progn
-     (easy-menu-define
-      gnus-group-reading-menu gnus-group-mode-map ""
-      '("Group"
-	["Read" gnus-group-read-group (gnus-group-group-name)]
-	["Select" gnus-group-select-group (gnus-group-group-name)]
-	["See old articles" (gnus-group-select-group 'all)
-	 :keys "C-u SPC" :active (gnus-group-group-name)]
-	["Catch up" gnus-group-catchup-current (gnus-group-group-name)]
-	["Catch up all articles" gnus-group-catchup-current-all
-	 (gnus-group-group-name)]
-	["Check for new articles" gnus-group-get-new-news-this-group
-	 (gnus-group-group-name)]
-	["Toggle subscription" gnus-group-unsubscribe-current-group
-	 (gnus-group-group-name)]
-	["Kill" gnus-group-kill-group (gnus-group-group-name)]
-	["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
-	["Describe" gnus-group-describe-group (gnus-group-group-name)]
-	["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
-	["Edit kill file" gnus-group-edit-local-kill
-	 (gnus-group-group-name)]
-	;; Actually one should check, if any of the marked groups gives t for
-	;; (gnus-check-backend-function 'request-expire-articles ...)
-	["Expire articles" gnus-group-expire-articles
-	 (or (and (gnus-group-group-name)
-		  (gnus-check-backend-function
-		   'request-expire-articles
-		   (gnus-group-group-name))) gnus-group-marked)]
-	["Set group level" gnus-group-set-current-level
-	 (gnus-group-group-name)]
-	["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
-	))
-  
-     (easy-menu-define
-      gnus-group-group-menu gnus-group-mode-map ""
-      '("Groups"
-	("Listing"
-	 ["List unread subscribed groups" gnus-group-list-groups t]
-	 ["List (un)subscribed groups" gnus-group-list-all-groups t]
-	 ["List killed groups" gnus-group-list-killed gnus-killed-list]
-	 ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
-	 ["List level..." gnus-group-list-level t]
-	 ["Describe all groups" gnus-group-describe-all-groups t]
-	 ["Group apropos..." gnus-group-apropos t]
-	 ["Group and description apropos..." gnus-group-description-apropos t]
-	 ["List groups matching..." gnus-group-list-matching t]
-	 ["List all groups matching..." gnus-group-list-all-matching t]
-	 ["List active file" gnus-group-list-active t])
-	("Sort"
-	 ["Default sort" gnus-group-sort-groups
-	  (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-	 ["Sort by method" gnus-group-sort-groups-by-method
-	  (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-	 ["Sort by rank" gnus-group-sort-groups-by-rank
-	  (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-	 ["Sort by score" gnus-group-sort-groups-by-score
-	  (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-	 ["Sort by level" gnus-group-sort-groups-by-level
-	  (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-	 ["Sort by unread" gnus-group-sort-groups-by-unread
-	  (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))]
-	 ["Sort by name" gnus-group-sort-groups-by-alphabet
-	  (or (not (boundp 'gnus-topic-mode)) (not gnus-topic-mode))])
-	("Mark"
-	 ["Mark group" gnus-group-mark-group
-	  (and (gnus-group-group-name)
-	       (not (memq (gnus-group-group-name) gnus-group-marked)))]
-	 ["Unmark group" gnus-group-unmark-group
-	  (and (gnus-group-group-name)
-	       (memq (gnus-group-group-name) gnus-group-marked))]
-	 ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
-	 ["Mark regexp..." gnus-group-mark-regexp t]
-	 ["Mark region" gnus-group-mark-region t]
-	 ["Mark buffer" gnus-group-mark-buffer t]
-	 ["Execute command" gnus-group-universal-argument
-	  (or gnus-group-marked (gnus-group-group-name))])
-	("Subscribe"
-	 ["Subscribe to random group" gnus-group-unsubscribe-group t]
-	 ["Kill all newsgroups in region" gnus-group-kill-region t]
-	 ["Kill all zombie groups" gnus-group-kill-all-zombies
-	  gnus-zombie-list]
-	 ["Kill all groups on level..." gnus-group-kill-level t])
-	("Foreign groups"
-	 ["Make a foreign group" gnus-group-make-group t]
-	 ["Add a directory group" gnus-group-make-directory-group t]
-	 ["Add the help group" gnus-group-make-help-group t]
-	 ["Add the archive group" gnus-group-make-archive-group t]
-	 ["Make a doc group" gnus-group-make-doc-group t]
-	 ["Make a kiboze group" gnus-group-make-kiboze-group t]
-	 ["Make a virtual group" gnus-group-make-empty-virtual t]
-	 ["Add a group to a virtual" gnus-group-add-to-virtual t]
-	 ["Rename group" gnus-group-rename-group
-	  (gnus-check-backend-function
-	   'request-rename-group (gnus-group-group-name))]
-	 ["Delete group" gnus-group-delete-group
-	  (gnus-check-backend-function
-	   'request-delete-group (gnus-group-group-name))])
-	("Editing groups"
-	 ["Parameters" gnus-group-edit-group-parameters
-	  (gnus-group-group-name)]
-	 ["Select method" gnus-group-edit-group-method
-	  (gnus-group-group-name)]
-	 ["Info" gnus-group-edit-group (gnus-group-group-name)])
-	("Score file"
-	 ["Flush cache" gnus-score-flush-cache
-	  (or gnus-score-cache gnus-short-name-score-file-cache)])
-	("Move"
-	 ["Next" gnus-group-next-group t]
-	 ["Previous" gnus-group-prev-group t]
-	 ["Next unread" gnus-group-next-unread-group t]
-	 ["Previous unread" gnus-group-prev-unread-group t]
-	 ["Next unread same level" gnus-group-next-unread-group-same-level t]
-	 ["Previous unread same level"
-	  gnus-group-previous-unread-group-same-level t]
-	 ["Jump to group" gnus-group-jump-to-group t]
-	 ["First unread group" gnus-group-first-unread-group t]
-	 ["Best unread group" gnus-group-best-unread-group t])
-	["Transpose" gnus-group-transpose-groups
-	 (gnus-group-group-name)]
-	["Read a directory as a group..." gnus-group-enter-directory t]
-	))
-
-     (easy-menu-define
-      gnus-group-misc-menu gnus-group-mode-map ""
-      '("Misc"
-	["Send a bug report" gnus-bug t]
-	["Send a mail" gnus-group-mail t]
-	["Post an article..." gnus-group-post-news t]
-	["Customize score file" gnus-score-customize t]
-	["Check for new news" gnus-group-get-new-news t]     
-	["Activate all groups" gnus-activate-all-groups t]
-	["Delete bogus groups" gnus-group-check-bogus-groups t]
-	["Find new newsgroups" gnus-find-new-newsgroups t]
-	["Restart Gnus" gnus-group-restart t]
-	["Read init file" gnus-group-read-init-file t]
-	["Browse foreign server" gnus-group-browse-foreign-server t]
-	["Enter server buffer" gnus-group-enter-server-mode t]
-	["Expire all expirable articles" gnus-group-expire-all-groups t]
-	["Generate any kiboze groups" nnkiboze-generate-groups t]
-	["Gnus version" gnus-version t]
-	["Save .newsrc files" gnus-group-save-newsrc t]
-	["Suspend Gnus" gnus-group-suspend t]
-	["Clear dribble buffer" gnus-group-clear-dribble t]
-	["Exit from Gnus" gnus-group-exit t]
-	["Exit without saving" gnus-group-quit t]
-	["Edit global kill file" gnus-group-edit-global-kill t]
-	["Read manual" gnus-info-find-node t]
-	["Toggle topics" gnus-topic-mode t]
-	("SOUP"
-	 ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
-	 ["Send replies" gnus-soup-send-replies
-	  (fboundp 'gnus-soup-pack-packet)]
-	 ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
-	 ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
-	 ["Brew SOUP" gnus-soup-brew-soup (fboundp 'gnus-soup-pack-packet)])
-	))
-     (run-hooks 'gnus-group-menu-hook)
-     )))
-
-;; Summary buffer
-(defun gnus-summary-make-menu-bar ()
-  (gnus-visual-turn-off-edit-menu 'summary)
-
-  (unless (boundp 'gnus-summary-misc-menu)
-
-    (easy-menu-define
-     gnus-summary-misc-menu gnus-summary-mode-map ""
-     '("Misc"
-       ("Mark"
-	("Read"
-	 ["Mark as read" gnus-summary-mark-as-read-forward t]
-	 ["Mark same subject and select"
-	  gnus-summary-kill-same-subject-and-select t]
-	 ["Mark same subject" gnus-summary-kill-same-subject t]
-	 ["Catchup" gnus-summary-catchup t]
-	 ["Catchup all" gnus-summary-catchup-all t]
-	 ["Catchup to here" gnus-summary-catchup-to-here t]
-	 ["Catchup region" gnus-summary-mark-region-as-read t]
-	 ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
-	("Various"
-	 ["Tick" gnus-summary-tick-article-forward t]
-	 ["Mark as dormant" gnus-summary-mark-as-dormant t]
-	 ["Remove marks" gnus-summary-clear-mark-forward t]
-	 ["Set expirable mark" gnus-summary-mark-as-expirable t]
-	 ["Set bookmark" gnus-summary-set-bookmark t]
-	 ["Remove bookmark" gnus-summary-remove-bookmark t])
-	("Limit"
-	 ["Marks..." gnus-summary-limit-to-marks t]
-	 ["Subject..." gnus-summary-limit-to-subject t]
-	 ["Author..." gnus-summary-limit-to-author t]
-	 ["Score" gnus-summary-limit-to-score t]
-	 ["Unread" gnus-summary-limit-to-unread t]
-	 ["Non-dormant" gnus-summary-limit-exclude-dormant t]
-	 ["Articles" gnus-summary-limit-to-articles t]
-	 ["Pop limit" gnus-summary-pop-limit t]
-	 ["Show dormant" gnus-summary-limit-include-dormant t]
-	 ["Hide childless dormant" 
-	  gnus-summary-limit-exclude-childless-dormant t]
-	 ;;["Hide thread" gnus-summary-limit-exclude-thread t]
-	 ["Show expunged" gnus-summary-show-all-expunged t])
-	("Process mark"
-	 ["Set mark" gnus-summary-mark-as-processable t]
-	 ["Remove mark" gnus-summary-unmark-as-processable t]
-	 ["Remove all marks" gnus-summary-unmark-all-processable t]
-	 ["Mark above" gnus-uu-mark-over t]
-	 ["Mark series" gnus-uu-mark-series t]
-	 ["Mark region" gnus-uu-mark-region t]
-	 ["Mark by regexp..." gnus-uu-mark-by-regexp t]
-	 ["Mark all" gnus-uu-mark-all t]
-	 ["Mark buffer" gnus-uu-mark-buffer t]
-	 ["Mark sparse" gnus-uu-mark-sparse t]
-	 ["Mark thread" gnus-uu-mark-thread t]
-	 ["Unmark thread" gnus-uu-unmark-thread t]))
-       ("Scroll article"
-	["Page forward" gnus-summary-next-page t]
-	["Page backward" gnus-summary-prev-page t]
-	["Line forward" gnus-summary-scroll-up t])
-       ("Move"
-	["Next unread article" gnus-summary-next-unread-article t]
-	["Previous unread article" gnus-summary-prev-unread-article t]
-	["Next article" gnus-summary-next-article t]
-	["Previous article" gnus-summary-prev-article t]
-	["Next unread subject" gnus-summary-next-unread-subject t]
-	["Previous unread subject" gnus-summary-prev-unread-subject t]
-	["Next article same subject" gnus-summary-next-same-subject t]
-	["Previous article same subject" gnus-summary-prev-same-subject t]
-	["First unread article" gnus-summary-first-unread-article t]
-	["Best unread article" gnus-summary-best-unread-article t]
-	["Go to subject number..." gnus-summary-goto-subject t]
-	["Go to article number..." gnus-summary-goto-article t]
-	["Go to the last article" gnus-summary-goto-last-article t]
-	["Pop article off history" gnus-summary-pop-article t])	
-       ("Sort"
-	["Sort by number" gnus-summary-sort-by-number t]
-	["Sort by author" gnus-summary-sort-by-author t]
-	["Sort by subject" gnus-summary-sort-by-subject t]
-	["Sort by date" gnus-summary-sort-by-date t]
-	["Sort by score" gnus-summary-sort-by-score t])
-       ("Exit"
-	["Catchup and exit" gnus-summary-catchup-and-exit t]
-	["Catchup all and exit" gnus-summary-catchup-and-exit t]
-	["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
-	["Exit group" gnus-summary-exit t]
-	["Exit group without updating" gnus-summary-exit-no-update t]
-	["Exit and goto next group" gnus-summary-next-group t]
-	["Exit and goto prev group" gnus-summary-prev-group t]
-	["Reselect group" gnus-summary-reselect-current-group t]
-	["Rescan group" gnus-summary-rescan-group t])
-       ("Help"
-	["Fetch group FAQ" gnus-summary-fetch-faq t]
-	["Describe group" gnus-summary-describe-group t]
-	["Read manual" gnus-info-find-node t])
-       ("Cache"
-	["Enter article" gnus-cache-enter-article t]
-	["Remove article" gnus-cache-remove-article t])
-       ("Modes"
-	["Pick and read" gnus-pick-mode t]
-	["Binary" gnus-binary-mode t])
-       ["Filter articles..." gnus-summary-execute-command t]
-       ["Run command on subjects..." gnus-summary-universal-argument t]
-       ["Toggle line truncation" gnus-summary-toggle-truncation t]
-       ["Expand window" gnus-summary-expand-window t]
-       ["Expire expirable articles" gnus-summary-expire-articles
-	(gnus-check-backend-function
-	 'request-expire-articles gnus-newsgroup-name)]
-       ["Edit local kill file" gnus-summary-edit-local-kill t]
-       ["Edit main kill file" gnus-summary-edit-global-kill t]
-       ))
-
-    (easy-menu-define
-     gnus-summary-kill-menu gnus-summary-mode-map ""
-     (cons
-      "Score"
-      (nconc
-       (list
-	["Enter score..." gnus-summary-score-entry t])
-       (gnus-visual-score-map 'increase)
-       (gnus-visual-score-map 'lower)
-       '(("Mark"
-	  ["Kill below" gnus-summary-kill-below t]
-	  ["Mark above" gnus-summary-mark-above t]
-	  ["Tick above" gnus-summary-tick-above t]
-	  ["Clear above" gnus-summary-clear-above t])
-	 ["Current score" gnus-summary-current-score t]
-	 ["Set score" gnus-summary-set-score t]
-	 ["Customize score file" gnus-score-customize t]
-	 ["Switch current score file..." gnus-score-change-score-file t]
-	 ["Set mark below..." gnus-score-set-mark-below t]
-	 ["Set expunge below..." gnus-score-set-expunge-below t]
-	 ["Edit current score file" gnus-score-edit-current-scores t]
-	 ["Edit score file" gnus-score-edit-file t]
-	 ["Trace score" gnus-score-find-trace t]
-	 ["Rescore buffer" gnus-summary-rescore t]
-	 ["Increase score..." gnus-summary-increase-score t]
-	 ["Lower score..." gnus-summary-lower-score t]))))
-
-    '(("Default header"
-       ["Ask" (gnus-score-set-default 'gnus-score-default-header nil)
-	:style radio 
-	:selected (null gnus-score-default-header)]
-       ["From" (gnus-score-set-default 'gnus-score-default-header 'a)
-	:style radio 
-	:selected (eq gnus-score-default-header 'a)]
-       ["Subject" (gnus-score-set-default 'gnus-score-default-header 's)
-	:style radio 
-	:selected (eq gnus-score-default-header 's)]
-       ["Article body"
-	(gnus-score-set-default 'gnus-score-default-header 'b)
-	:style radio 
-	:selected (eq gnus-score-default-header 'b )]
-       ["All headers"
-	(gnus-score-set-default 'gnus-score-default-header 'h)
-	:style radio 
-	:selected (eq gnus-score-default-header 'h )]
-       ["Message-Id" (gnus-score-set-default 'gnus-score-default-header 'i)
-	:style radio 
-	:selected (eq gnus-score-default-header 'i )]
-       ["Thread" (gnus-score-set-default 'gnus-score-default-header 't)
-	:style radio 
-	:selected (eq gnus-score-default-header 't )]
-       ["Crossposting"
-	(gnus-score-set-default 'gnus-score-default-header 'x)
-	:style radio 
-	:selected (eq gnus-score-default-header 'x )]
-       ["Lines" (gnus-score-set-default 'gnus-score-default-header 'l)
-	:style radio 
-	:selected (eq gnus-score-default-header 'l )]
-       ["Date" (gnus-score-set-default 'gnus-score-default-header 'd)
-	:style radio 
-	:selected (eq gnus-score-default-header 'd )]
-       ["Followups to author"
-	(gnus-score-set-default 'gnus-score-default-header 'f)
-	:style radio 
-	:selected (eq gnus-score-default-header 'f )])
-      ("Default type"
-       ["Ask" (gnus-score-set-default 'gnus-score-default-type nil)
-	:style radio 
-	:selected (null gnus-score-default-type)]
-       ;; The `:active' key is commented out in the following,
-       ;; because the GNU Emacs hack to support radio buttons use
-       ;; active to indicate which button is selected.  
-       ["Substring" (gnus-score-set-default 'gnus-score-default-type 's)
-	:style radio 
-	;; :active (not (memq gnus-score-default-header '(l d)))
-	:selected (eq gnus-score-default-type 's)]
-       ["Regexp" (gnus-score-set-default 'gnus-score-default-type 'r)
-	:style radio
-	;; :active (not (memq gnus-score-default-header '(l d)))
-	:selected (eq gnus-score-default-type 'r)]
-       ["Exact" (gnus-score-set-default 'gnus-score-default-type 'e)
-	:style radio
-	;; :active (not (memq gnus-score-default-header '(l d)))
-	:selected (eq gnus-score-default-type 'e)]
-       ["Fuzzy" (gnus-score-set-default 'gnus-score-default-type 'f)
-	:style radio 
-	;; :active (not (memq gnus-score-default-header '(l d)))
-	:selected (eq gnus-score-default-type 'f)]
-       ["Before date" (gnus-score-set-default 'gnus-score-default-type 'b)
-	:style radio 
-	;; :active (eq (gnus-score-default-header 'd))
-	:selected (eq gnus-score-default-type 'b)]
-       ["At date" (gnus-score-set-default 'gnus-score-default-type 'n)
-	:style radio 
-	;; :active (eq (gnus-score-default-header 'd))
-	:selected (eq gnus-score-default-type 'n)]
-       ["After date" (gnus-score-set-default 'gnus-score-default-type 'a)
-	:style radio 
-	;; :active (eq (gnus-score-default-header 'd))
-	:selected (eq gnus-score-default-type 'a)]
-       ["Less than number"
-	(gnus-score-set-default 'gnus-score-default-type '<)
-	:style radio 
-	;; :active (eq (gnus-score-default-header 'l))
-	:selected (eq gnus-score-default-type '<)]
-       ["Equal to number"
-	(gnus-score-set-default 'gnus-score-default-type '=)
-	:style radio 
-	;; :active (eq (gnus-score-default-header 'l))
-	:selected (eq gnus-score-default-type '=)]
-       ["Greater than number" 
-	(gnus-score-set-default 'gnus-score-default-type '>)
-	:style radio 
-	;; :active (eq (gnus-score-default-header 'l))
-	:selected (eq gnus-score-default-type '>)])
-      ["Default fold" gnus-score-default-fold-toggle
-       :style toggle
-       :selected gnus-score-default-fold]
-      ("Default duration"
-       ["Ask" (gnus-score-set-default 'gnus-score-default-duration nil)
-	:style radio
-	:selected (null gnus-score-default-duration)]
-       ["Permanent"
-	(gnus-score-set-default 'gnus-score-default-duration 'p)
-	:style radio
-	:selected (eq gnus-score-default-duration 'p)]
-       ["Temporary"
-	(gnus-score-set-default 'gnus-score-default-duration 't)
-	:style radio
-	:selected (eq gnus-score-default-duration 't)]
-       ["Immediate" 
-	(gnus-score-set-default 'gnus-score-default-duration 'i)
-	:style radio
-	:selected (eq gnus-score-default-duration 'i)]))
-
-    (easy-menu-define
-     gnus-summary-article-menu gnus-summary-mode-map ""
-     '("Article"
-       ("Hide"
-	["All" gnus-article-hide t]
-	["Headers" gnus-article-hide-headers t]
-	["Signature" gnus-article-hide-signature t]
-	["Citation" gnus-article-hide-citation t]
-	["PGP" gnus-article-hide-pgp t]
-	["Boring headers" gnus-article-hide-boring-headers t])
-       ("Highlight"
-	["All" gnus-article-highlight t]
-	["Headers" gnus-article-highlight-headers t]
-	["Signature" gnus-article-highlight-signature t]
-	["Citation" gnus-article-highlight-citation t])
-       ("Date"
-	["Local" gnus-article-date-local t]
-	["UT" gnus-article-date-ut t]
-	["Original" gnus-article-date-original t]
-	["Lapsed" gnus-article-date-lapsed t])
-       ("Filter"
-	["Overstrike" gnus-article-treat-overstrike t]
-	["Word wrap" gnus-article-fill-cited-article t]
-	["CR" gnus-article-remove-cr t]
-	["Trailing blank lines" gnus-article-remove-trailing-blank-lines t]
-	["Show X-Face" gnus-article-display-x-face t]
-	["Quoted-Printable" gnus-article-de-quoted-unreadable t]
-	["Rot 13" gnus-summary-caesar-message t]
-	["Add buttons" gnus-article-add-buttons t]
-	["Add buttons to head" gnus-article-add-buttons-to-head t]
-	["Stop page breaking" gnus-summary-stop-page-breaking t]
-	["Toggle MIME" gnus-summary-toggle-mime t]
-	["Verbose header" gnus-summary-verbose-headers t]
-	["Toggle header" gnus-summary-toggle-header t])
-       ("Output"
-	["Save in default format" gnus-summary-save-article t]
-	["Save in file" gnus-summary-save-article-file t]
-	["Save in Unix mail format" gnus-summary-save-article-mail t]
-	["Save in MH folder" gnus-summary-save-article-folder t]
-	["Save in VM folder" gnus-summary-save-article-vm t]
-	["Save in RMAIL mbox" gnus-summary-save-article-rmail t]
-	["Save body in file" gnus-summary-save-article-body-file t]
-	["Pipe through a filter" gnus-summary-pipe-output t]
-	["Add to SOUP packet" gnus-soup-add-article t])
-       ("Backend"
-	["Respool article..." gnus-summary-respool-article t]
-	["Move article..." gnus-summary-move-article
-	 (gnus-check-backend-function
-	  'request-move-article gnus-newsgroup-name)]
-	["Copy article..." gnus-summary-copy-article t]
-	["Crosspost article..." gnus-summary-crosspost-article
-	 (gnus-check-backend-function
-	  'request-replace-article gnus-newsgroup-name)]
-	["Import file..." gnus-summary-import-article t]
-	["Edit article" gnus-summary-edit-article
-	 (not (gnus-group-read-only-p))]
-	["Delete article" gnus-summary-delete-article
-	 (gnus-check-backend-function
-	  'request-expire-articles gnus-newsgroup-name)]
-	["Query respool" gnus-summary-respool-query t]
-	["Delete expirable articles" gnus-summary-expire-articles-now
-	 (gnus-check-backend-function
-	  'request-expire-articles gnus-newsgroup-name)])
-       ("Extract"
-	["Uudecode" gnus-uu-decode-uu t]
-	["Uudecode and save" gnus-uu-decode-uu-and-save t]
-	["Unshar" gnus-uu-decode-unshar t]
-	["Unshar and save" gnus-uu-decode-unshar-and-save t]
-	["Save" gnus-uu-decode-save t]
-	["Binhex" gnus-uu-decode-binhex t]
-	["Postscript" gnus-uu-decode-postscript t])
-       ["Enter digest buffer" gnus-summary-enter-digest-group t]
-       ["Isearch article..." gnus-summary-isearch-article t]
-       ["Search articles forward..." gnus-summary-search-article-forward t]
-       ["Search articles backward..." gnus-summary-search-article-backward t]
-       ["Beginning of the article" gnus-summary-beginning-of-article t]
-       ["End of the article" gnus-summary-end-of-article t]
-       ["Fetch parent of article" gnus-summary-refer-parent-article t]
-       ["Fetch referenced articles" gnus-summary-refer-references t]
-       ["Fetch article with id..." gnus-summary-refer-article t]
-       ["Redisplay" gnus-summary-show-article t]))
-
-    (easy-menu-define
-     gnus-summary-thread-menu gnus-summary-mode-map ""
-     '("Threads"
-       ["Toggle threading" gnus-summary-toggle-threads t]
-       ["Hide threads" gnus-summary-hide-all-threads t]
-       ["Show threads" gnus-summary-show-all-threads t]
-       ["Hide thread" gnus-summary-hide-thread t]
-       ["Show thread" gnus-summary-show-thread t]
-       ["Go to next thread" gnus-summary-next-thread t]
-       ["Go to previous thread" gnus-summary-prev-thread t]
-       ["Go down thread" gnus-summary-down-thread t]
-       ["Go up thread" gnus-summary-up-thread t]
-       ["Top of thread" gnus-summary-top-thread t]
-       ["Mark thread as read" gnus-summary-kill-thread t]
-       ["Lower thread score" gnus-summary-lower-thread t]
-       ["Raise thread score" gnus-summary-raise-thread t]
-       ["Rethread current" gnus-summary-rethread-current t]
-       ))
-
-    (easy-menu-define
-     gnus-summary-post-menu gnus-summary-mode-map ""
-     '("Post"
-       ["Post an article" gnus-summary-post-news t]
-       ["Followup" gnus-summary-followup t]
-       ["Followup and yank" gnus-summary-followup-with-original t]
-       ["Supersede article" gnus-summary-supersede-article t]
-       ["Cancel article" gnus-summary-cancel-article t]
-       ["Reply" gnus-summary-reply t]
-       ["Reply and yank" gnus-summary-reply-with-original t]
-       ["Mail forward" gnus-summary-mail-forward t]
-       ["Post forward" gnus-summary-post-forward t]
-       ["Digest and mail" gnus-uu-digest-mail-forward t]
-       ["Digest and post" gnus-uu-digest-post-forward t]
-       ["Resend message" gnus-summary-resend-message t]
-       ["Send bounced mail" gnus-summary-resend-bounced-mail t]
-       ["Send a mail" gnus-summary-mail-other-window t]
-       ["Uuencode and post" gnus-uu-post-news t]
-       ;;("Draft"
-       ;;["Send" gnus-summary-send-draft t]
-       ;;["Send bounced" gnus-resend-bounced-mail t])
-       ))
-    (run-hooks 'gnus-summary-menu-hook)
-    ))
-
-(defun gnus-score-set-default (var value)
-  "A version of set that updates the GNU Emacs menu-bar."
-  (set var value)
-  ;; It is the message that forces the active status to be updated.
-  (message ""))
-
-(defun gnus-visual-score-map (type)
-  (if t
-      nil
-    (let ((headers '(("author" "from" string)
-		     ("subject" "subject" string)
-		     ("article body" "body" string)
-		     ("article head" "head" string)
-		     ("xref" "xref" string)
-		     ("lines" "lines" number)
-		     ("followups to author" "followup" string)))
-	  (types '((number ("less than" <)
-			   ("greater than" >)
-			   ("equal" =))
-		   (string ("substring" s)
-			   ("exact string" e)
-			   ("fuzzy string" f)
-			   ("regexp" r))))
-	  (perms '(("temporary" (current-time-string))
-		   ("permanent" nil)
-		   ("immediate" now)))
-	  header)
-      (list 
-       (apply 
-	'nconc
-	(list
-	 (if (eq type 'lower)
-	     "Lower score"
-	   "Increase score"))
-	(let (outh)
-	  (while headers
-	    (setq header (car headers))
-	    (setq outh 
-		  (cons 
-		   (apply 
-		    'nconc
-		    (list (car header))
-		    (let ((ts (cdr (assoc (nth 2 header) types)))
-			  outt)
-		      (while ts
-			(setq outt
-			      (cons 
-			       (apply 
-				'nconc
-				(list (caar ts))
-				(let ((ps perms)
-				      outp)
-				  (while ps
-				    (setq outp
-					  (cons
-					   (vector
-					    (caar ps) 
-					    (list
-					     'gnus-summary-score-entry
-					     (nth 1 header)
-					     (if (or (string= (nth 1 header) 
-							      "head")
-						     (string= (nth 1 header)
-							      "body"))
-						 ""
-					       (list 'gnus-summary-header 
-						     (nth 1 header)))
-					     (list 'quote (nth 1 (car ts)))
-					     (list 'gnus-score-default nil)
-					     (nth 1 (car ps))
-					     t)
-					    t)
-					   outp))
-				    (setq ps (cdr ps)))
-				  (list (nreverse outp))))
-			       outt))
-			(setq ts (cdr ts)))
-		      (list (nreverse outt))))
-		   outh))
-	    (setq headers (cdr headers)))
-	  (list (nreverse outh))))))))
- 
-;; Article buffer
-(defun gnus-article-make-menu-bar ()
-  (gnus-visual-turn-off-edit-menu 'summary)
-  (or
-   (boundp 'gnus-article-article-menu)
-   (progn
-     (easy-menu-define
-      gnus-article-article-menu gnus-article-mode-map ""
-      '("Article"
-	["Scroll forwards" gnus-article-goto-next-page t]
-	["Scroll backwards" gnus-article-goto-prev-page t]
-	["Show summary" gnus-article-show-summary t]
-	["Fetch Message-ID at point" gnus-article-refer-article t]
-	["Mail to address at point" gnus-article-mail t]
-	))
-
-     (easy-menu-define
-      gnus-article-treatment-menu gnus-article-mode-map ""
-      '("Treatment"
-	["Hide headers" gnus-article-hide-headers t]
-	["Hide signature" gnus-article-hide-signature t]
-	["Hide citation" gnus-article-hide-citation t]
-	["Treat overstrike" gnus-article-treat-overstrike t]
-	["Remove carriage return" gnus-article-remove-cr t]
-	["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
-	))
-     (run-hooks 'gnus-article-menu-hook))))
-
-;;;
-;;; summary highlights
-;;;
-
-(defun gnus-highlight-selected-summary ()
-  ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-  ;; Highlight selected article in summary buffer
-  (if gnus-summary-selected-face
-      (save-excursion
-	(let* ((beg (progn (beginning-of-line) (point)))
-	       (end (progn (end-of-line) (point)))
-	       ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
-	       (from (if (get-text-property beg gnus-mouse-face-prop) 
-			 beg
-		       (1+ (or (next-single-property-change 
-				beg gnus-mouse-face-prop nil end) 
-			       beg))))
-	       (to (1- (or (next-single-property-change
-			    from gnus-mouse-face-prop nil end)
-			   end))))
-	  ;; If no mouse-face prop on line (e.g. xemacs) we 
-	  ;; will have to = from = end, so we highlight the
-	  ;; entire line instead.
-	  (if (= (+ to 2) from)
-	      (progn
-		(setq from beg)
-		(setq to end)))
-	  (if gnus-newsgroup-selected-overlay
-	      (gnus-move-overlay gnus-newsgroup-selected-overlay 
-				 from to (current-buffer))
-	    (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
-	    (gnus-overlay-put gnus-newsgroup-selected-overlay 'face 
-			      gnus-summary-selected-face))))))
-
-;; New implementation by Christian Limpach <Christian.Limpach@nice.ch>.
-(defun gnus-summary-highlight-line ()
-  "Highlight current line according to `gnus-summary-highlight'."
-  (let* ((list gnus-summary-highlight)
-	 (p (point))
-	 (end (progn (end-of-line) (point)))
-	 ;; now find out where the line starts and leave point there.
-	 (beg (progn (beginning-of-line) (point)))
-	 (article (gnus-summary-article-number))
-	 (score (or (cdr (assq (or article gnus-current-article)
-			       gnus-newsgroup-scored))
-		    gnus-summary-default-score 0))
-	 (mark (or (gnus-summary-article-mark) gnus-unread-mark))
-	 (inhibit-read-only t))
-    ;; Eval the cars of the lists until we find a match.
-    (let ((default gnus-summary-default-score))
-      (while (and list
-		  (not (eval (caar list))))
-	(setq list (cdr list))))
-    (let ((face (cdar list)))
-      (unless (eq face (get-text-property beg 'face))
-	(gnus-put-text-property 
-	 beg end 'face 
-	 (setq face (if (boundp face) (symbol-value face) face)))
-	(when gnus-summary-highlight-line-function
-	  (funcall gnus-summary-highlight-line-function article face))))
-    (goto-char p)))
-
-(defun gnus-group-highlight-line ()
-  "Highlight the current line according to `gnus-group-highlight'."
-  (let* ((list gnus-group-highlight)
-	 (p (point))
-	 (end (progn (end-of-line) (point)))
-	 ;; now find out where the line starts and leave point there.
-	 (beg (progn (beginning-of-line) (point)))
-	 (group (gnus-group-group-name))
-	 (entry (gnus-group-entry group))
-	 (unread (if (numberp (car entry)) (car entry) 0))
-	 (info (nth 2 entry))
-	 (method (gnus-server-get-method group (gnus-info-method info)))
-	 (marked (gnus-info-marks info))
-	 (mailp (memq 'mail (assoc (symbol-name
-				    (car (or method gnus-select-method)))
-				   gnus-valid-select-methods)))
-	 (level (or (gnus-info-level info) 9))
-	 (score (or (gnus-info-score info) 0))
-	 (ticked (gnus-range-length (cdr (assq 'tick marked))))
-	 (inhibit-read-only t))
-    ;; Eval the cars of the lists until we find a match.
-    (while (and list
-		(not (eval (caar list))))
-      (setq list (cdr list)))
-    (let ((face (cdar list)))
-      (unless (eq face (get-text-property beg 'face))
-	(gnus-put-text-property 
-	 beg end 'face 
-	 (setq face (if (boundp face) (symbol-value face) face)))
-	(gnus-extent-start-open beg)))
-    (goto-char p)))
-
-;;;
-;;; gnus-carpal
-;;;
-
-(defvar gnus-carpal-group-buffer-buttons
-  '(("next" . gnus-group-next-unread-group)
-    ("prev" . gnus-group-prev-unread-group)
-    ("read" . gnus-group-read-group)
-    ("select" . gnus-group-select-group)
-    ("catch-up" . gnus-group-catchup-current)
-    ("new-news" . gnus-group-get-new-news-this-group)
-    ("toggle-sub" . gnus-group-unsubscribe-current-group)
-    ("subscribe" . gnus-group-unsubscribe-group)
-    ("kill" . gnus-group-kill-group)
-    ("yank" . gnus-group-yank-group)
-    ("describe" . gnus-group-describe-group)
-    "list"
-    ("subscribed" . gnus-group-list-groups)
-    ("all" . gnus-group-list-all-groups)
-    ("killed" . gnus-group-list-killed)
-    ("zombies" . gnus-group-list-zombies)
-    ("matching" . gnus-group-list-matching)
-    ("post" . gnus-group-post-news)
-    ("mail" . gnus-group-mail)
-    ("rescan" . gnus-group-get-new-news)
-    ("browse-foreign" . gnus-group-browse-foreign)
-    ("exit" . gnus-group-exit)))
-
-(defvar gnus-carpal-summary-buffer-buttons
-  '("mark" 
-    ("read" . gnus-summary-mark-as-read-forward)
-    ("tick" . gnus-summary-tick-article-forward)
-    ("clear" . gnus-summary-clear-mark-forward)
-    ("expirable" . gnus-summary-mark-as-expirable)
-    "move"
-    ("scroll" . gnus-summary-next-page)
-    ("next-unread" . gnus-summary-next-unread-article)
-    ("prev-unread" . gnus-summary-prev-unread-article)
-    ("first" . gnus-summary-first-unread-article)
-    ("best" . gnus-summary-best-unread-article)
-    "article"
-    ("headers" . gnus-summary-toggle-header)
-    ("uudecode" . gnus-uu-decode-uu)
-    ("enter-digest" . gnus-summary-enter-digest-group)
-    ("fetch-parent" . gnus-summary-refer-parent-article)
-    "mail"
-    ("move" . gnus-summary-move-article)
-    ("copy" . gnus-summary-copy-article)
-    ("respool" . gnus-summary-respool-article)
-    "threads"
-    ("lower" . gnus-summary-lower-thread)
-    ("kill" . gnus-summary-kill-thread)
-    "post"
-    ("post" . gnus-summary-post-news)
-    ("mail" . gnus-summary-mail)
-    ("followup" . gnus-summary-followup-with-original)
-    ("reply" . gnus-summary-reply-with-original)
-    ("cancel" . gnus-summary-cancel-article)
-    "misc"
-    ("exit" . gnus-summary-exit)
-    ("fed-up" . gnus-summary-catchup-and-goto-next-group)))
-
-(defvar gnus-carpal-server-buffer-buttons 
-  '(("add" . gnus-server-add-server)
-    ("browse" . gnus-server-browse-server)
-    ("list" . gnus-server-list-servers)
-    ("kill" . gnus-server-kill-server)
-    ("yank" . gnus-server-yank-server)
-    ("copy" . gnus-server-copy-server)
-    ("exit" . gnus-server-exit)))
-
-(defvar gnus-carpal-browse-buffer-buttons
-  '(("subscribe" . gnus-browse-unsubscribe-current-group)
-    ("exit" . gnus-browse-exit)))
-
-(defvar gnus-carpal-group-buffer "*Carpal Group*")
-(defvar gnus-carpal-summary-buffer "*Carpal Summary*")
-(defvar gnus-carpal-server-buffer "*Carpal Server*")
-(defvar gnus-carpal-browse-buffer "*Carpal Browse*")
-
-(defvar gnus-carpal-attached-buffer nil)
-
-(defvar gnus-carpal-mode-hook nil
-  "*Hook run in carpal mode buffers.")
-
-(defvar gnus-carpal-button-face 'bold
-  "*Face used on carpal buttons.")
-
-(defvar gnus-carpal-header-face 'bold-italic
-  "*Face used on carpal buffer headers.")
-
-(defvar gnus-carpal-mode-map nil)
-(put 'gnus-carpal-mode 'mode-class 'special)
-
-(if gnus-carpal-mode-map
-    nil
-  (setq gnus-carpal-mode-map (make-keymap))
-  (suppress-keymap gnus-carpal-mode-map)
-  (define-key gnus-carpal-mode-map " " 'gnus-carpal-select)
-  (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select)
-  (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select))
-
-(defun gnus-carpal-mode ()
-  "Major mode for clicking buttons.
-
-All normal editing commands are switched off.
-\\<gnus-carpal-mode-map>
-The following commands are available:
-
-\\{gnus-carpal-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (setq mode-line-modified "-- ")
-  (setq major-mode 'gnus-carpal-mode)
-  (setq mode-name "Gnus Carpal")
-  (setq mode-line-process nil)
-  (use-local-map gnus-carpal-mode-map)
-  (buffer-disable-undo (current-buffer))
-  (setq buffer-read-only t)
-  (make-local-variable 'gnus-carpal-attached-buffer)
-  (run-hooks 'gnus-carpal-mode-hook))
-
-(defun gnus-carpal-setup-buffer (type)
-  (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type)))))
-    (if (get-buffer buffer)
-	()
-      (save-excursion
-	(set-buffer (get-buffer-create buffer))
-	(gnus-carpal-mode)
-	(setq gnus-carpal-attached-buffer 
-	      (intern (format "gnus-%s-buffer" type)))
-	(gnus-add-current-to-buffer-list)
-	(let ((buttons (symbol-value 
-			(intern (format "gnus-carpal-%s-buffer-buttons"
-					type))))
-	      (buffer-read-only nil)
-	      button)
-	  (while buttons
-	    (setq button (car buttons)
-		  buttons (cdr buttons))
-	    (if (stringp button)
-		(gnus-set-text-properties
-		 (point)
-		 (prog2 (insert button) (point) (insert " "))
-		 (list 'face gnus-carpal-header-face))
-	      (gnus-set-text-properties
-	       (point)
-	       (prog2 (insert (car button)) (point) (insert " "))
-	       (list 'gnus-callback (cdr button)
-		     'face gnus-carpal-button-face
-		     gnus-mouse-face-prop 'highlight))))
-	  (let ((fill-column (- (window-width) 2)))
-	    (fill-region (point-min) (point-max)))
-	  (set-window-point (get-buffer-window (current-buffer)) 
-			    (point-min)))))))
-
-(defun gnus-carpal-select ()
-  "Select the button under point."
-  (interactive)
-  (let ((func (get-text-property (point) 'gnus-callback)))
-    (if (null func)
-	()
-      (pop-to-buffer (symbol-value gnus-carpal-attached-buffer))
-      (call-interactively func))))
-
-(defun gnus-carpal-mouse-select (event)
-  "Select the button under the mouse pointer."
-  (interactive "e")
-  (mouse-set-point event)
-  (gnus-carpal-select))
-
-;;; 
-;;; article highlights
-;;;
-
-;; Written by Per Abrahamsen <abraham@iesd.auc.dk>.
-
-;;; Internal Variables:
-
-(defvar gnus-button-regexp nil)
-;; Regexp matching any of the regexps from `gnus-button-alist'.
-
-(defvar gnus-button-last nil)
-;; The value of `gnus-button-alist' when `gnus-button-regexp' was build.
-
-;;; Commands:
-
-(defun gnus-article-push-button (event)
-  "Check text under the mouse pointer for a callback function.
-If the text under the mouse pointer has a `gnus-callback' property,
-call it with the value of the `gnus-data' text property."
-  (interactive "e")
-  (set-buffer (window-buffer (posn-window (event-start event))))
-  (let* ((pos (posn-point (event-start event)))
-         (data (get-text-property pos 'gnus-data))
-	 (fun (get-text-property pos 'gnus-callback)))
-    (if fun (funcall fun data))))
-
-(defun gnus-article-press-button ()
-  "Check text at point for a callback function.
-If the text at point has a `gnus-callback' property,
-call it with the value of the `gnus-data' text property."
-  (interactive)
-  (let* ((data (get-text-property (point) 'gnus-data))
-	 (fun (get-text-property (point) 'gnus-callback)))
-    (if fun (funcall fun data))))
-
-(defun gnus-article-prev-button (n)
-  "Move point to N buttons backward.
-If N is negative, move forward instead."
-  (interactive "p")
-  (gnus-article-next-button (- n)))
-
-(defun gnus-article-next-button (n)
-  "Move point to N buttons forward.
-If N is negative, move backward instead."
-  (interactive "p")
-  (let ((function (if (< n 0) 'previous-single-property-change
-		    'next-single-property-change))
-	(inhibit-point-motion-hooks t)
-	(backward (< n 0))
-	(limit (if (< n 0) (point-min) (point-max))))
-    (setq n (abs n))
-    (while (and (not (= limit (point)))
-		(> n 0))
-      ;; Skip past the current button.
-      (when (get-text-property (point) 'gnus-callback)
-	(goto-char (funcall function (point) 'gnus-callback nil limit)))
-      ;; Go to the next (or previous) button.
-      (gnus-goto-char (funcall function (point) 'gnus-callback nil limit))
-      ;; Put point at the start of the button.
-      (when (and backward (not (get-text-property (point) 'gnus-callback)))
-	(goto-char (funcall function (point) 'gnus-callback nil limit)))
-      ;; Skip past intangible buttons.
-      (when (get-text-property (point) 'intangible)
-	(incf n))
-      (decf n))
-    (unless (zerop n)
-      (gnus-message 5 "No more buttons"))
-    n))
-
-(defun gnus-article-highlight (&optional force)
-  "Highlight current article.
-This function calls `gnus-article-highlight-headers',
-`gnus-article-highlight-citation', 
-`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
-do the highlighting.  See the documentation for those functions."
-  (interactive (list 'force))
-  (gnus-article-highlight-headers)
-  (gnus-article-highlight-citation force)
-  (gnus-article-highlight-signature)
-  (gnus-article-add-buttons force)
-  (gnus-article-add-buttons-to-head))
-
-(defun gnus-article-highlight-some (&optional force)
-  "Highlight current article.
-This function calls `gnus-article-highlight-headers',
-`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
-do the highlighting.  See the documentation for those functions."
-  (interactive (list 'force))
-  (gnus-article-highlight-headers)
-  (gnus-article-highlight-signature)
-  (gnus-article-add-buttons))
-
-(defun gnus-article-highlight-headers ()
-  "Highlight article headers as specified by `gnus-header-face-alist'."
-  (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (save-restriction
-      (let ((alist gnus-header-face-alist)
-	    (buffer-read-only nil)
-	    (case-fold-search t)
-	    (inhibit-point-motion-hooks t)
-	    entry regexp header-face field-face from hpoints fpoints)
-	(goto-char (point-min))
-	(when (search-forward "\n\n" nil t)
-	  (narrow-to-region (1- (point)) (point-min))
-	  (while (setq entry (pop alist))
-	    (goto-char (point-min))
-	    (setq regexp (concat "^\\("
-				 (if (string-equal "" (nth 0 entry))
-				     "[^\t ]"
-				   (nth 0 entry))
-				 "\\)")
-		  header-face (nth 1 entry)
-		  field-face (nth 2 entry))
-	    (while (and (re-search-forward regexp nil t)
-			(not (eobp)))
-	      (beginning-of-line)
-	      (setq from (point))
-	      (or (search-forward ":" nil t)
-		  (forward-char 1))
-	      (when (and header-face
-			 (not (memq (point) hpoints)))
-		(push (point) hpoints)
-		(gnus-put-text-property from (point) 'face header-face))
-	      (when (and field-face
-			 (not (memq (setq from (point)) fpoints)))
-		(push from fpoints)
-		(if (re-search-forward "^[^ \t]" nil t)
-		    (forward-char -2)
-		  (goto-char (point-max)))
-		(gnus-put-text-property from (point) 'face field-face)))))))))
-
-(defun gnus-article-highlight-signature ()
-  "Highlight the signature in an article.
-It does this by highlighting everything after
-`gnus-signature-separator' using `gnus-signature-face'." 
-  (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-	  (inhibit-point-motion-hooks t))
-      (save-restriction
-	(when (and gnus-signature-face
-		   (gnus-narrow-to-signature))
-	  (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
-			    'face gnus-signature-face)
-	  (widen)
-	  (re-search-backward gnus-signature-separator nil t)
-	  (let ((start (match-beginning 0))
-		(end (set-marker (make-marker) (1+ (match-end 0)))))
-	    (gnus-article-add-button start (1- end) 'gnus-signature-toggle
-				     end)))))))
-
-(defun gnus-article-add-buttons (&optional force)
-  "Find external references in the article and make buttons of them.
-\"External references\" are things like Message-IDs and URLs, as
-specified by `gnus-button-alist'."
-  (interactive (list 'force))
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    ;; Remove all old markers.
-    (while gnus-button-marker-list
-      (set-marker (pop gnus-button-marker-list) nil))
-    (let ((buffer-read-only nil)
-	  (inhibit-point-motion-hooks t)
-	  (case-fold-search t)
-	  (alist gnus-button-alist)
-	  beg entry regexp)
-      (goto-char (point-min))
-      ;; We skip the headers.
-      (unless (search-forward "\n\n" nil t)
-	(goto-char (point-max)))
-      (setq beg (point))
-      (while (setq entry (pop alist))
-	(setq regexp (car entry))
-	(goto-char beg)
-	(while (re-search-forward regexp nil t)
-	  (let* ((start (and entry (match-beginning (nth 1 entry))))
-		 (end (and entry (match-end (nth 1 entry))))
-		 (from (match-beginning 0)))
-	    (when (or (eq t (nth 1 entry))
-		      (eval (nth 1 entry)))
-	      ;; That optional form returned non-nil, so we add the
-	      ;; button. 
-	      (gnus-article-add-button 
-	       start end 'gnus-button-push 
-	       (car (push (set-marker (make-marker) from)
-			  gnus-button-marker-list))))))))))
-
-;; Add buttons to the head of an article.
-(defun gnus-article-add-buttons-to-head ()
-  "Add buttons to the head of the article."
-  (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-	  (inhibit-point-motion-hooks t)
-	  (case-fold-search t)
-	  (alist gnus-header-button-alist)
-	  entry beg end)
-      (nnheader-narrow-to-headers)
-      (while alist
-	;; Each alist entry.
-	(setq entry (car alist)
-	      alist (cdr alist))
-	(goto-char (point-min))
-	(while (re-search-forward (car entry) nil t)
-	  ;; Each header matching the entry.
-	  (setq beg (match-beginning 0))
-	  (setq end (or (and (re-search-forward "^[^ \t]" nil t)
-			     (match-beginning 0))
-			(point-max)))
-	  (goto-char beg)
-	  (while (re-search-forward (nth 1 entry) end t)
-	    ;; Each match within a header.
-	    (let* ((from (match-beginning 0))
-		   (entry (cdr entry))
-		   (start (match-beginning (nth 1 entry)))
-		   (end (match-end (nth 1 entry)))
-		   (form (nth 2 entry)))
-	      (goto-char (match-end 0))
-	      (and (eval form)
-		   (gnus-article-add-button 
-		    start end (nth 3 entry)
-		    (buffer-substring (match-beginning (nth 4 entry))
-				      (match-end (nth 4 entry)))))))
-	  (goto-char end))))
-    (widen)))
-
-;;; External functions:
-
-(defun gnus-article-add-button (from to fun &optional data)
-  "Create a button between FROM and TO with callback FUN and data DATA."
-  (and gnus-article-button-face
-       (gnus-overlay-put (gnus-make-overlay from to)
-			 'face gnus-article-button-face))
-  (gnus-add-text-properties 
-   from to
-   (nconc (and gnus-article-mouse-face
-	       (list gnus-mouse-face-prop gnus-article-mouse-face))
-	  (list 'gnus-callback fun)
-	  (and data (list 'gnus-data data)))))
-
-;;; Internal functions:
-
-(defun gnus-signature-toggle (end)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-	  (inhibit-point-motion-hooks t))
-      (if (get-text-property end 'invisible)
-	  (gnus-unhide-text end (point-max))
-	(gnus-hide-text end (point-max) gnus-hidden-properties)))))
-
-(defun gnus-button-entry ()
-  ;; Return the first entry in `gnus-button-alist' matching this place.
-  (let ((alist gnus-button-alist)
-	(entry nil))
-    (while alist
-      (setq entry (pop alist))
-      (if (looking-at (car entry))
-	  (setq alist nil)
-	(setq entry nil)))
-    entry))
-
-(defun gnus-button-push (marker)
-  ;; Push button starting at MARKER.
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (goto-char marker)
-    (let* ((entry (gnus-button-entry))
-	   (inhibit-point-motion-hooks t)
-	   (fun (nth 3 entry))
-	   (args (mapcar (lambda (group) 
-			   (let ((string (buffer-substring
-					  (match-beginning group)
-					  (match-end group))))
-			     (gnus-set-text-properties
-			      0 (length string) nil string)
-			     string))
-			 (nthcdr 4 entry))))
-      (cond
-       ((fboundp fun)
-	(apply fun args))
-       ((and (boundp fun)
-	     (fboundp (symbol-value fun)))
-	(apply (symbol-value fun) args))
-       (t
-	(gnus-message 1 "You must define `%S' to use this button"
-		      (cons fun args)))))))
-
-(defun gnus-button-message-id (message-id)
-  "Fetch MESSAGE-ID."
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
-    (gnus-summary-refer-article message-id)))
-
-(defun gnus-button-mailto (address)
-  ;; Mail to ADDRESS.
-  (set-buffer (gnus-copy-article-buffer))
-  (message-reply address))
-
-(defun gnus-button-reply (address)
-  ;; Reply to ADDRESS.
-  (message-reply address))
-
-(defun gnus-button-url (address)
-  "Browse ADDRESS."
-  (funcall browse-url-browser-function
-	   ;; Zap whitespace in case <URL:...> contained it.
-	   ;; (Whitespace illegal in raw URL.)
-	   (let ((stripped-address address))
-	     (while (string-match "\\s +\\|\n+" stripped-address)
-	       (setq stripped-address (replace-match "" t t stripped-address)))
-	     stripped-address)))
-
-;;; Next/prev buttons in the article buffer.
-
-(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
-(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
-
-(defvar gnus-prev-page-map nil)
-(unless gnus-prev-page-map
-  (setq gnus-prev-page-map (make-sparse-keymap))
-  (define-key gnus-prev-page-map gnus-mouse-2 'gnus-button-prev-page)
-  (define-key gnus-prev-page-map "\r" 'gnus-button-prev-page))
-
-(defun gnus-insert-prev-page-button ()
-  (let ((buffer-read-only nil))
-    (gnus-eval-format 
-     gnus-prev-page-line-format nil
-     `(gnus-prev t local-map ,gnus-prev-page-map
-		 gnus-callback gnus-article-button-prev-page))))
-
-(defvar gnus-next-page-map nil)
-(unless gnus-next-page-map
-  (setq gnus-next-page-map (make-keymap))
-  (suppress-keymap gnus-prev-page-map)
-  (define-key gnus-next-page-map gnus-mouse-2 'gnus-button-next-page)
-  (define-key gnus-next-page-map "\r" 'gnus-button-next-page))
-
-(defun gnus-button-next-page ()
-  "Go to the next page."
-  (interactive)
-  (let ((win (selected-window)))
-    (select-window (get-buffer-window gnus-article-buffer t))
-    (gnus-article-next-page)
-    (select-window win)))
-
-(defun gnus-button-prev-page ()
-  "Go to the prev page."
-  (interactive)
-  (let ((win (selected-window)))
-    (select-window (get-buffer-window gnus-article-buffer t))
-    (gnus-article-prev-page)
-    (select-window win)))
-
-(defun gnus-insert-next-page-button ()
-  (let ((buffer-read-only nil))
-    (gnus-eval-format gnus-next-page-line-format nil
-		      `(gnus-next t local-map ,gnus-next-page-map
-				  gnus-callback 
-				  gnus-article-button-next-page))))
-
-(defun gnus-article-button-next-page (arg)
-  "Go to the next page."
-  (interactive "P")
-  (let ((win (selected-window)))
-    (select-window (get-buffer-window gnus-article-buffer t))
-    (gnus-article-next-page)
-    (select-window win)))
-
-(defun gnus-article-button-prev-page (arg)
-  "Go to the prev page."
-  (interactive "P")
-  (let ((win (selected-window)))
-    (select-window (get-buffer-window gnus-article-buffer t))
-    (gnus-article-prev-page)
-    (select-window win)))
-
-;;; Compatibility Functions:
-
-(or (fboundp 'rassoc)
-    ;; Introduced in Emacs 19.29.
-    (defun rassoc (elt list)
-      "Return non-nil if ELT is `equal' to the cdr of an element of LIST.
-The value is actually the element of LIST whose cdr is ELT."
-      (let (result)
-	(while list
-	  (setq result (car list))
-	  (if (equal (cdr result) elt)
-	      (setq list nil)
-	    (setq result nil
-		  list (cdr list))))
-	result)))
-
-; (require 'gnus-cus)
-(gnus-ems-redefine)
-(provide 'gnus-vis)
-
-;;; gnus-vis.el ends here
diff --git a/lisp/gnus-vm.el b/lisp/gnus-vm.el
deleted file mode 100644
index ecfc0e93880..00000000000
--- a/lisp/gnus-vm.el
+++ /dev/null
@@ -1,111 +0,0 @@
-;;; gnus-vm.el --- vm interface for Gnus
-;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.
-
-;; Author: Per Persson <pp@solace.mh.se>
-;; Keywords: news, mail
-
-;; 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:
-
-;; Major contributors: 
-;;	Christian Limpach <Christian.Limpach@nice.ch>
-;; Some code stolen from: 
-;;	Rick Sladkey <jrs@world.std.com>
-
-;;; Code:
-
-(require 'sendmail)
-(require 'message)
-(require 'gnus)
-(require 'gnus-msg)
-
-(eval-when-compile
-  (autoload 'vm-mode "vm")
-  (autoload 'vm-save-message "vm")
-  (autoload 'vm-forward-message "vm")
-  (autoload 'vm-reply "vm")
-  (autoload 'vm-mail "vm"))
-
-(defvar gnus-vm-inhibit-window-system nil
-  "Inhibit loading `win-vm' if using a window-system.
-Has to be set before gnus-vm is loaded.")
-
-(or gnus-vm-inhibit-window-system
-    (condition-case nil
-	(if window-system
-	    (require 'win-vm))
-      (error nil)))
-
-(if (not (featurep 'vm))
-    (load "vm"))
-
-(defun gnus-vm-make-folder (&optional buffer)
-  (let ((article (or buffer (current-buffer)))
-	(tmp-folder (generate-new-buffer " *tmp-folder*"))
-	(start (point-min))
-	(end (point-max)))
-    (set-buffer tmp-folder)
-    (insert-buffer-substring article start end)
-    (goto-char (point-min))
-    (if (looking-at "^\\(From [^ ]+ \\).*$")
-	(replace-match (concat "\\1" (current-time-string)))
-      (insert "From " gnus-newsgroup-name " "
-	      (current-time-string) "\n"))
-    (while (re-search-forward "\n\nFrom " nil t)
-      (replace-match "\n\n>From "))
-    ;; insert a newline, otherwise the last line gets lost
-    (goto-char (point-max))
-    (insert "\n")
-    (vm-mode)
-    tmp-folder))
-  
-(defun gnus-summary-save-article-vm (&optional arg)
-  "Append the current article to a vm folder.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
-  (interactive "P")
-  (let ((gnus-default-article-saver 'gnus-summary-save-in-vm))
-    (gnus-summary-save-article arg)))
-
-(defun gnus-summary-save-in-vm (&optional folder)
-  (interactive)
-  (let ((default-name
-	  (funcall gnus-mail-save-name gnus-newsgroup-name
-		   gnus-current-headers gnus-newsgroup-last-mail)))
-    (setq folder
-	  (cond ((eq folder 'default) default-name)
-		(folder folder)
-		(t (gnus-read-save-file-name 
-		    "Save article in VM folder:" default-name))))
-    (gnus-make-directory (file-name-directory folder))
-    (set-buffer gnus-original-article-buffer)
-    (save-excursion
-      (save-restriction
-	(widen)
-	(let ((vm-folder (gnus-vm-make-folder)))
-	  (vm-save-message folder)
-	  (kill-buffer vm-folder))))
-    ;; Remember the directory name to save articles.
-    (setq gnus-newsgroup-last-mail folder)))
-
-(provide 'gnus-vm)
-
-;;; gnus-vm.el ends here.
diff --git a/lisp/gnus.el b/lisp/gnus.el
deleted file mode 100644
index f50ca034de1..00000000000
--- a/lisp/gnus.el
+++ /dev/null
@@ -1,17270 +0,0 @@
-;;; gnus.el --- a newsreader for GNU Emacs
-;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(eval '(run-hooks 'gnus-load-hook))
-
-(require 'mail-utils)
-(require 'timezone)
-(require 'nnheader)
-(require 'nnmail)
-(require 'backquote)
-(require 'nnoo)
-
-(eval-when-compile (require 'cl))
-
-(defvar gnus-directory (or (getenv "SAVEDIR") "~/News/")
-  "*Directory variable from which all other Gnus file variables are derived.")
-
-;; Site dependent variables.  These variables should be defined in
-;; paths.el.
-
-(defvar gnus-default-nntp-server nil
-  "Specify a default NNTP server.
-This variable should be defined in paths.el, and should never be set
-by the user.
-If you want to change servers, you should use `gnus-select-method'.
-See the documentation to that variable.")
-
-(defvar gnus-backup-default-subscribed-newsgroups
-  '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
-  "Default default new newsgroups the first time Gnus is run.
-Should be set in paths.el, and shouldn't be touched by the user.")
-
-(defvar gnus-local-organization nil
-  "String with a description of what organization (if any) the user belongs to.
-The ORGANIZATION environment variable is used instead if it is defined.
-If this variable contains a function, this function will be called
-with the current newsgroup name as the argument.  The function should
-return a string.
-
-In any case, if the string (either in the variable, in the environment
-variable, or returned by the function) is a file name, the contents of
-this file will be used as the organization.")
-
-;; Customization variables
-
-;; Don't touch this variable.
-(defvar gnus-nntp-service "nntp"
-  "*NNTP service name (\"nntp\" or 119).
-This is an obsolete variable, which is scarcely used.  If you use an
-nntp server for your newsgroup and want to change the port number
-used to 899, you would say something along these lines:
-
- (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
-
-(defvar gnus-nntpserver-file "/etc/nntpserver"
-  "*A file with only the name of the nntp server in it.")
-
-;; This function is used to check both the environment variable
-;; NNTPSERVER and the /etc/nntpserver file to see whether one can find
-;; an nntp server name default.
-(defun gnus-getenv-nntpserver ()
-  (or (getenv "NNTPSERVER")
-      (and (file-readable-p gnus-nntpserver-file)
-	   (save-excursion
-	     (set-buffer (get-buffer-create " *gnus nntp*"))
-	     (buffer-disable-undo (current-buffer))
-	     (insert-file-contents gnus-nntpserver-file)
-	     (let ((name (buffer-string)))
-	       (prog1
-		   (if (string-match "^[ \t\n]*$" name)
-		       nil
-		     name)
-		 (kill-buffer (current-buffer))))))))
-
-(defvar gnus-select-method
-  (nconc
-   (list 'nntp (or (condition-case ()
-		       (gnus-getenv-nntpserver)
-		     (error nil))
-		   (if (and gnus-default-nntp-server
-			    (not (string= gnus-default-nntp-server "")))
-		       gnus-default-nntp-server)
-		   (system-name)))
-   (if (or (null gnus-nntp-service)
-	   (equal gnus-nntp-service "nntp"))
-       nil
-     (list gnus-nntp-service)))
-  "*Default method for selecting a newsgroup.
-This variable should be a list, where the first element is how the
-news is to be fetched, the second is the address.
-
-For instance, if you want to get your news via NNTP from
-\"flab.flab.edu\", you could say:
-
-(setq gnus-select-method '(nntp \"flab.flab.edu\"))
-
-If you want to use your local spool, say:
-
-(setq gnus-select-method (list 'nnspool (system-name)))
-
-If you use this variable, you must set `gnus-nntp-server' to nil.
-
-There is a lot more to know about select methods and virtual servers -
-see the manual for details.")
-
-(defvar gnus-message-archive-method 
-  `(nnfolder
-    "archive"
-    (nnfolder-directory ,(nnheader-concat message-directory "archive"))
-    (nnfolder-active-file 
-     ,(nnheader-concat message-directory "archive/active"))
-    (nnfolder-get-new-mail nil)
-    (nnfolder-inhibit-expiry t))
-  "*Method used for archiving messages you've sent.
-This should be a mail method.
-
-It's probably not a very effective to change this variable once you've
-run Gnus once.  After doing that, you must edit this server from the
-server buffer.")
-
-(defvar gnus-message-archive-group nil
-  "*Name of the group in which to save the messages you've written.
-This can either be a string, a list of strings; or an alist
-of regexps/functions/forms to be evaluated to return a string (or a list
-of strings).  The functions are called with the name of the current
-group (or nil) as a parameter.
-
-Normally the group names returned by this variable should be
-unprefixed -- which implictly means \"store on the archive server\".
-However, you may wish to store the message on some other server.  In
-that case, just return a fully prefixed name of the group --
-\"nnml+private:mail.misc\", for instance.")
-
-(defvar gnus-refer-article-method nil
-  "*Preferred method for fetching an article by Message-ID.
-If you are reading news from the local spool (with nnspool), fetching
-articles by Message-ID is painfully slow.  By setting this method to an
-nntp method, you might get acceptable results.
-
-The value of this variable must be a valid select method as discussed
-in the documentation of `gnus-select-method'.")
-
-(defvar gnus-secondary-select-methods nil
-  "*A list of secondary methods that will be used for reading news.
-This is a list where each element is a complete select method (see
-`gnus-select-method').
-
-If, for instance, you want to read your mail with the nnml backend,
-you could set this variable:
-
-(setq gnus-secondary-select-methods '((nnml \"\")))")
-
-(defvar gnus-secondary-servers nil
-  "*List of NNTP servers that the user can choose between interactively.
-To make Gnus query you for a server, you have to give `gnus' a
-non-numeric prefix - `C-u M-x gnus', in short.")
-
-(defvar gnus-nntp-server nil
-  "*The name of the host running the NNTP server.
-This variable is semi-obsolete.	 Use the `gnus-select-method'
-variable instead.")
-
-(defvar gnus-startup-file "~/.newsrc"
-  "*Your `.newsrc' file.
-`.newsrc-SERVER' will be used instead if that exists.")
-
-(defvar gnus-init-file "~/.gnus"
-  "*Your Gnus elisp startup file.
-If a file with the .el or .elc suffixes exist, it will be read
-instead.")
-
-(defvar gnus-group-faq-directory
-  '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
-    "/ftp@sunsite.auc.dk:/pub/usenet/"
-    "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
-    "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
-    "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
-    "/ftp@rtfm.mit.edu:/pub/usenet/"
-    "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
-    "/ftp@ftp.sunet.se:/pub/usenet/"
-    "/ftp@nctuccca.edu.tw:/USENET/FAQ/"
-    "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
-    "/ftp@ftp.hk.super.net:/mirror/faqs/")
-  "*Directory where the group FAQs are stored.
-This will most commonly be on a remote machine, and the file will be
-fetched by ange-ftp.
-
-This variable can also be a list of directories.  In that case, the
-first element in the list will be used by default.  The others can
-be used when being prompted for a site.
-
-Note that Gnus uses an aol machine as the default directory.  If this
-feels fundamentally unclean, just think of it as a way to finally get
-something of value back from them.
-
-If the default site is too slow, try one of these:
-
-   North America: mirrors.aol.com		 /pub/rtfm/usenet
-		  ftp.seas.gwu.edu		 /pub/rtfm
-		  rtfm.mit.edu			 /pub/usenet
-   Europe:	  ftp.uni-paderborn.de		 /pub/FAQ
-                  src.doc.ic.ac.uk               /usenet/news-FAQS
-		  ftp.sunet.se			 /pub/usenet
-	          sunsite.auc.dk                 /pub/usenet
-   Asia:	  nctuccca.edu.tw		 /USENET/FAQ
-		  hwarang.postech.ac.kr		 /pub/usenet
-		  ftp.hk.super.net		 /mirror/faqs")
-
-(defvar gnus-group-archive-directory
-  "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
-  "*The address of the (ding) archives.")
-
-(defvar gnus-group-recent-archive-directory
-  "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
-  "*The address of the most recent (ding) articles.")
-
-(defvar gnus-default-subscribed-newsgroups nil
-  "*This variable lists what newsgroups should be subscribed the first time Gnus is used.
-It should be a list of strings.
-If it is `t', Gnus will not do anything special the first time it is
-started; it'll just use the normal newsgroups subscription methods.")
-
-(defvar gnus-use-cross-reference t
-  "*Non-nil means that cross referenced articles will be marked as read.
-If nil, ignore cross references.  If t, mark articles as read in
-subscribed newsgroups.	If neither t nor nil, mark as read in all
-newsgroups.")
-
-(defvar gnus-single-article-buffer t
-  "*If non-nil, display all articles in the same buffer.
-If nil, each group will get its own article buffer.")
-
-(defvar gnus-use-dribble-file t
-  "*Non-nil means that Gnus will use a dribble file to store user updates.
-If Emacs should crash without saving the .newsrc files, complete
-information can be restored from the dribble file.")
-
-(defvar gnus-dribble-directory nil
-  "*The directory where dribble files will be saved.
-If this variable is nil, the directory where the .newsrc files are
-saved will be used.")
-
-(defvar gnus-asynchronous nil
-  "*If non-nil, Gnus will supply backends with data needed for async article fetching.")
-
-(defvar gnus-kill-summary-on-exit t
-  "*If non-nil, kill the summary buffer when you exit from it.
-If nil, the summary will become a \"*Dead Summary*\" buffer, and
-it will be killed sometime later.")
-
-(defvar gnus-large-newsgroup 200
-  "*The number of articles which indicates a large newsgroup.
-If the number of articles in a newsgroup is greater than this value,
-confirmation is required for selecting the newsgroup.")
-
-;; Suggested by Andrew Eskilsson <pi92ae@lelle.pt.hk-r.se>.
-(defvar gnus-no-groups-message "No news is horrible news"
-  "*Message displayed by Gnus when no groups are available.")
-
-(defvar gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
-  "*Non-nil means that the default name of a file to save articles in is the group name.
-If it's nil, the directory form of the group name is used instead.
-
-If this variable is a list, and the list contains the element
-`not-score', long file names will not be used for score files; if it
-contains the element `not-save', long file names will not be used for
-saving; and if it contains the element `not-kill', long file names
-will not be used for kill files.
-
-Note that the default for this variable varies according to what system
-type you're using.  On `usg-unix-v' and `xenix' this variable defaults
-to nil while on all other systems it defaults to t.")
-
-(defvar gnus-article-save-directory gnus-directory
-  "*Name of the directory articles will be saved in (default \"~/News\").")
-
-(defvar gnus-kill-files-directory gnus-directory
-  "*Name of the directory where kill files will be stored (default \"~/News\").")
-
-(defvar gnus-default-article-saver 'gnus-summary-save-in-rmail
-  "*A function to save articles in your favorite format.
-The function must be interactively callable (in other words, it must
-be an Emacs command).
-
-Gnus provides the following functions:
-
-* gnus-summary-save-in-rmail (Rmail format)
-* gnus-summary-save-in-mail (Unix mail format)
-* gnus-summary-save-in-folder (MH folder)
-* gnus-summary-save-in-file (article format).
-* gnus-summary-save-in-vm (use VM's folder format).")
-
-(defvar gnus-prompt-before-saving 'always
-  "*This variable says how much prompting is to be done when saving articles.
-If it is nil, no prompting will be done, and the articles will be
-saved to the default files.  If this variable is `always', each and
-every article that is saved will be preceded by a prompt, even when
-saving large batches of articles.  If this variable is neither nil not
-`always', there the user will be prompted once for a file name for
-each invocation of the saving commands.")
-
-(defvar gnus-rmail-save-name (function gnus-plain-save-name)
-  "*A function generating a file name to save articles in Rmail format.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
-
-(defvar gnus-mail-save-name (function gnus-plain-save-name)
-  "*A function generating a file name to save articles in Unix mail format.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE.")
-
-(defvar gnus-folder-save-name (function gnus-folder-save-name)
-  "*A function generating a file name to save articles in MH folder.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER.")
-
-(defvar gnus-file-save-name (function gnus-numeric-save-name)
-  "*A function generating a file name to save articles in article format.
-The function is called with NEWSGROUP, HEADERS, and optional
-LAST-FILE.")
-
-(defvar gnus-split-methods
-  '((gnus-article-archive-name))
-  "*Variable used to suggest where articles are to be saved.
-For instance, if you would like to save articles related to Gnus in
-the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
-you could set this variable to something like:
-
- '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
-   (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
-
-This variable is an alist where the where the key is the match and the
-value is a list of possible files to save in if the match is non-nil.
-
-If the match is a string, it is used as a regexp match on the
-article.  If the match is a symbol, that symbol will be funcalled
-from the buffer of the article to be saved with the newsgroup as the
-parameter.  If it is a list, it will be evaled in the same buffer.
-
-If this form or function returns a string, this string will be used as
-a possible file name; and if it returns a non-nil list, that list will
-be used as possible file names.")
-
-(defvar gnus-move-split-methods nil
-  "*Variable used to suggest where articles are to be moved to.
-It uses the same syntax as the `gnus-split-methods' variable.")
-
-(defvar gnus-save-score nil
-  "*If non-nil, save group scoring info.")
-
-(defvar gnus-use-adaptive-scoring nil
-  "*If non-nil, use some adaptive scoring scheme.")
-
-(defvar gnus-use-cache 'passive
-  "*If nil, Gnus will ignore the article cache.
-If `passive', it will allow entering (and reading) articles
-explicitly entered into the cache.  If anything else, use the
-cache to the full extent of the law.")
-
-(defvar gnus-use-trees nil
-  "*If non-nil, display a thread tree buffer.")
-
-(defvar gnus-use-grouplens nil
-  "*If non-nil, use GroupLens ratings.")
-
-(defvar gnus-keep-backlog nil
-  "*If non-nil, Gnus will keep read articles for later re-retrieval.
-If it is a number N, then Gnus will only keep the last N articles
-read.  If it is neither nil nor a number, Gnus will keep all read
-articles.  This is not a good idea.")
-
-(defvar gnus-use-nocem nil
-  "*If non-nil, Gnus will read NoCeM cancel messages.")
-
-(defvar gnus-use-demon nil
-  "If non-nil, Gnus might use some demons.")
-
-(defvar gnus-use-scoring t
-  "*If non-nil, enable scoring.")
-
-(defvar gnus-use-picons nil
-  "*If non-nil, display picons.")
-
-(defvar gnus-fetch-old-headers nil
-  "*Non-nil means that Gnus will try to build threads by grabbing old headers.
-If an unread article in the group refers to an older, already read (or
-just marked as read) article, the old article will not normally be
-displayed in the Summary buffer.  If this variable is non-nil, Gnus
-will attempt to grab the headers to the old articles, and thereby
-build complete threads.	 If it has the value `some', only enough
-headers to connect otherwise loose threads will be displayed.
-This variable can also be a number.  In that case, no more than that
-number of old headers will be fetched.
-
-The server has to support NOV for any of this to work.")
-
-;see gnus-cus.el
-;(defvar gnus-visual t
-;  "*If non-nil, will do various highlighting.
-;If nil, no mouse highlights (or any other highlights) will be
-;performed.  This might speed up Gnus some when generating large group
-;and summary buffers.")
-
-(defvar gnus-novice-user t
-  "*Non-nil means that you are a usenet novice.
-If non-nil, verbose messages may be displayed and confirmations may be
-required.")
-
-(defvar gnus-expert-user nil
-  "*Non-nil means that you will never be asked for confirmation about anything.
-And that means *anything*.")
-
-(defvar gnus-verbose 7
-  "*Integer that says how verbose Gnus should be.
-The higher the number, the more messages Gnus will flash to say what
-it's doing.  At zero, Gnus will be totally mute; at five, Gnus will
-display most important messages; and at ten, Gnus will keep on
-jabbering all the time.")
-
-(defvar gnus-keep-same-level nil
-  "*Non-nil means that the next newsgroup after the current will be on the same level.
-When you type, for instance, `n' after reading the last article in the
-current newsgroup, you will go to the next newsgroup.  If this variable
-is nil, the next newsgroup will be the next from the group
-buffer.
-If this variable is non-nil, Gnus will either put you in the
-next newsgroup with the same level, or, if no such newsgroup is
-available, the next newsgroup with the lowest possible level higher
-than the current level.
-If this variable is `best', Gnus will make the next newsgroup the one
-with the best level.")
-
-(defvar gnus-summary-make-false-root 'adopt
-  "*nil means that Gnus won't gather loose threads.
-If the root of a thread has expired or been read in a previous
-session, the information necessary to build a complete thread has been
-lost.  Instead of having many small sub-threads from this original thread
-scattered all over the summary buffer, Gnus can gather them.
-
-If non-nil, Gnus will try to gather all loose sub-threads from an
-original thread into one large thread.
-
-If this variable is non-nil, it should be one of `none', `adopt',
-`dummy' or `empty'.
-
-If this variable is `none', Gnus will not make a false root, but just
-present the sub-threads after another.
-If this variable is `dummy', Gnus will create a dummy root that will
-have all the sub-threads as children.
-If this variable is `adopt', Gnus will make one of the \"children\"
-the parent and mark all the step-children as such.
-If this variable is `empty', the \"children\" are printed with empty
-subject fields.	 (Or rather, they will be printed with a string
-given by the `gnus-summary-same-subject' variable.)")
-
-(defvar gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
-  "*A regexp to match subjects to be excluded from loose thread gathering.
-As loose thread gathering is done on subjects only, that means that
-there can be many false gatherings performed.  By rooting out certain
-common subjects, gathering might become saner.")
-
-(defvar gnus-summary-gather-subject-limit nil
-  "*Maximum length of subject comparisons when gathering loose threads.
-Use nil to compare full subjects.  Setting this variable to a low
-number will help gather threads that have been corrupted by
-newsreaders chopping off subject lines, but it might also mean that
-unrelated articles that have subject that happen to begin with the
-same few characters will be incorrectly gathered.
-
-If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
-comparing subjects.")
-
-(defvar gnus-simplify-ignored-prefixes nil
-  "*Regexp, matches for which are removed from subject lines when simplifying.")
-
-(defvar gnus-build-sparse-threads nil
-  "*If non-nil, fill in the gaps in threads.
-If `some', only fill in the gaps that are needed to tie loose threads
-together.  If `more', fill in all leaf nodes that Gnus can find.  If
-non-nil and non-`some', fill in all gaps that Gnus manages to guess.")
-
-(defvar gnus-summary-thread-gathering-function 'gnus-gather-threads-by-subject
-  "Function used for gathering loose threads.
-There are two pre-defined functions: `gnus-gather-threads-by-subject',
-which only takes Subjects into consideration; and
-`gnus-gather-threads-by-references', which compared the References
-headers of the articles to find matches.")
-
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defvar gnus-summary-same-subject ""
-  "*String indicating that the current article has the same subject as the previous.
-This variable will only be used if the value of
-`gnus-summary-make-false-root' is `empty'.")
-
-(defvar gnus-summary-goto-unread t
-  "*If non-nil, marking commands will go to the next unread article.
-If `never', \\<gnus-summary-mode-map>\\[gnus-summary-next-page] will go to the next article,
-whether it is read or not.")
-
-(defvar gnus-group-goto-unread t
-  "*If non-nil, movement commands will go to the next unread and subscribed group.")
-
-(defvar gnus-goto-next-group-when-activating t
-  "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group.")
-
-(defvar gnus-check-new-newsgroups t
-  "*Non-nil means that Gnus will add new newsgroups at startup.
-If this variable is `ask-server', Gnus will ask the server for new
-groups since the last time it checked.	This means that the killed list
-is no longer necessary, so you could set `gnus-save-killed-list' to
-nil.
-
-A variant is to have this variable be a list of select methods.	 Gnus
-will then use the `ask-server' method on all these select methods to
-query for new groups from all those servers.
-
-Eg.
-  (setq gnus-check-new-newsgroups
-	'((nntp \"some.server\") (nntp \"other.server\")))
-
-If this variable is nil, then you have to tell Gnus explicitly to
-check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups].")
-
-(defvar gnus-check-bogus-newsgroups nil
-  "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
-If this variable is nil, then you have to tell Gnus explicitly to
-check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups].")
-
-(defvar gnus-read-active-file t
-  "*Non-nil means that Gnus will read the entire active file at startup.
-If this variable is nil, Gnus will only know about the groups in your
-`.newsrc' file.
-
-If this variable is `some', Gnus will try to only read the relevant
-parts of the active file from the server.  Not all servers support
-this, and it might be quite slow with other servers, but this should
-generally be faster than both the t and nil value.
-
-If you set this variable to nil or `some', you probably still want to
-be told about new newsgroups that arrive.  To do that, set
-`gnus-check-new-newsgroups' to `ask-server'.  This may not work
-properly with all servers.")
-
-(defvar gnus-level-subscribed 5
-  "*Groups with levels less than or equal to this variable are subscribed.")
-
-(defvar gnus-level-unsubscribed 7
-  "*Groups with levels less than or equal to this variable are unsubscribed.
-Groups with levels less than `gnus-level-subscribed', which should be
-less than this variable, are subscribed.")
-
-(defvar gnus-level-zombie 8
-  "*Groups with this level are zombie groups.")
-
-(defvar gnus-level-killed 9
-  "*Groups with this level are killed.")
-
-(defvar gnus-level-default-subscribed 3
-  "*New subscribed groups will be subscribed at this level.")
-
-(defvar gnus-level-default-unsubscribed 6
-  "*New unsubscribed groups will be unsubscribed at this level.")
-
-(defvar gnus-activate-level (1+ gnus-level-subscribed)
-  "*Groups higher than this level won't be activated on startup.
-Setting this variable to something log might save lots of time when
-you have many groups that you aren't interested in.")
-
-(defvar gnus-activate-foreign-newsgroups 4
-  "*If nil, Gnus will not check foreign newsgroups at startup.
-If it is non-nil, it should be a number between one and nine.  Foreign
-newsgroups that have a level lower or equal to this number will be
-activated on startup.  For instance, if you want to active all
-subscribed newsgroups, but not the rest, you'd set this variable to
-`gnus-level-subscribed'.
-
-If you subscribe to lots of newsgroups from different servers, startup
-might take a while.  By setting this variable to nil, you'll save time,
-but you won't be told how many unread articles there are in the
-groups.")
-
-(defvar gnus-save-newsrc-file t
-  "*Non-nil means that Gnus will save the `.newsrc' file.
-Gnus always saves its own startup file, which is called
-\".newsrc.eld\".  The file called \".newsrc\" is in a format that can
-be readily understood by other newsreaders.  If you don't plan on
-using other newsreaders, set this variable to nil to save some time on
-exit.")
-
-(defvar gnus-save-killed-list t
-  "*If non-nil, save the list of killed groups to the startup file.
-If you set this variable to nil, you'll save both time (when starting
-and quitting) and space (both memory and disk), but it will also mean
-that Gnus has no record of which groups are new and which are old, so
-the automatic new newsgroups subscription methods become meaningless.
-
-You should always set `gnus-check-new-newsgroups' to `ask-server' or
-nil if you set this variable to nil.")
-
-(defvar gnus-interactive-catchup t
-  "*If non-nil, require your confirmation when catching up a group.")
-
-(defvar gnus-interactive-exit t
-  "*If non-nil, require your confirmation when exiting Gnus.")
-
-(defvar gnus-kill-killed t
-  "*If non-nil, Gnus will apply kill files to already killed articles.
-If it is nil, Gnus will never apply kill files to articles that have
-already been through the scoring process, which might very well save lots
-of time.")
-
-(defvar gnus-extract-address-components 'gnus-extract-address-components
-  "*Function for extracting address components from a From header.
-Two pre-defined function exist: `gnus-extract-address-components',
-which is the default, quite fast, and too simplistic solution, and
-`mail-extract-address-components', which works much better, but is
-slower.")
-
-(defvar gnus-summary-default-score 0
-  "*Default article score level.
-If this variable is nil, scoring will be disabled.")
-
-(defvar gnus-summary-zcore-fuzz 0
-  "*Fuzziness factor for the zcore in the summary buffer.
-Articles with scores closer than this to `gnus-summary-default-score'
-will not be marked.")
-
-(defvar gnus-simplify-subject-fuzzy-regexp nil
-  "*Strings to be removed when doing fuzzy matches.
-This can either be a regular expression or list of regular expressions
-that will be removed from subject strings if fuzzy subject
-simplification is selected.")
-
-(defvar gnus-permanently-visible-groups nil
-  "*Regexp to match groups that should always be listed in the group buffer.
-This means that they will still be listed when there are no unread
-articles in the groups.")
-
-(defvar gnus-list-groups-with-ticked-articles t
-  "*If non-nil, list groups that have only ticked articles.
-If nil, only list groups that have unread articles.")
-
-(defvar gnus-group-default-list-level gnus-level-subscribed
-  "*Default listing level.
-Ignored if `gnus-group-use-permanent-levels' is non-nil.")
-
-(defvar gnus-group-use-permanent-levels nil
-  "*If non-nil, once you set a level, Gnus will use this level.")
-
-(defvar gnus-group-list-inactive-groups t
-  "*If non-nil, inactive groups will be listed.")
-
-(defvar gnus-show-mime nil
-  "*If non-nil, do mime processing of articles.
-The articles will simply be fed to the function given by
-`gnus-show-mime-method'.")
-
-(defvar gnus-strict-mime t
-  "*If nil, MIME-decode even if there is no Mime-Version header in the article.")
-
-(defvar gnus-show-mime-method 'metamail-buffer
-  "*Function to process a MIME message.
-The function is called from the article buffer.")
-
-(defvar gnus-decode-encoded-word-method (lambda ())
-  "*Function to decode a MIME encoded-words.
-The function is called from the article buffer.")
-
-(defvar gnus-show-threads t
-  "*If non-nil, display threads in summary mode.")
-
-(defvar gnus-thread-hide-subtree nil
-  "*If non-nil, hide all threads initially.
-If threads are hidden, you have to run the command
-`gnus-summary-show-thread' by hand or use `gnus-select-article-hook'
-to expose hidden threads.")
-
-(defvar gnus-thread-hide-killed t
-  "*If non-nil, hide killed threads automatically.")
-
-(defvar gnus-thread-ignore-subject nil
-  "*If non-nil, ignore subjects and do all threading based on the Reference header.
-If nil, which is the default, articles that have different subjects
-from their parents will start separate threads.")
-
-(defvar gnus-thread-operation-ignore-subject t
-  "*If non-nil, subjects will be ignored when doing thread commands.
-This affects commands like `gnus-summary-kill-thread' and
-`gnus-summary-lower-thread'.
-
-If this variable is nil, articles in the same thread with different
-subjects will not be included in the operation in question.  If this
-variable is `fuzzy', only articles that have subjects that are fuzzily
-equal will be included.")
-
-(defvar gnus-thread-indent-level 4
-  "*Number that says how much each sub-thread should be indented.")
-
-(defvar gnus-ignored-newsgroups
-  (purecopy (mapconcat 'identity
-		       '("^to\\."	; not "real" groups
-			 "^[0-9. \t]+ " ; all digits in name
-			 "[][\"#'()]"	; bogus characters
-			 )
-		       "\\|"))
-  "*A regexp to match uninteresting newsgroups in the active file.
-Any lines in the active file matching this regular expression are
-removed from the newsgroup list before anything else is done to it,
-thus making them effectively non-existent.")
-
-(defvar gnus-ignored-headers
-  "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:\\|^Received:\\|^Mail-from:"
-  "*All headers that match this regexp will be hidden.
-This variable can also be a list of regexps of headers to be ignored.
-If `gnus-visible-headers' is non-nil, this variable will be ignored.")
-
-(defvar gnus-visible-headers "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-"
-  "*All headers that do not match this regexp will be hidden.
-This variable can also be a list of regexp of headers to remain visible.
-If this variable is non-nil, `gnus-ignored-headers' will be ignored.")
-
-(defvar gnus-sorted-header-list
-  '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:" "^To:"
-    "^Cc:" "^Date:" "^Organization:")
-  "*This variable is a list of regular expressions.
-If it is non-nil, headers that match the regular expressions will
-be placed first in the article buffer in the sequence specified by
-this list.")
-
-(defvar gnus-boring-article-headers
-  '(empty followup-to reply-to)
-  "*Headers that are only to be displayed if they have interesting data.
-Possible values in this list are `empty', `newsgroups', `followup-to',
-`reply-to', and `date'.")
-
-(defvar gnus-show-all-headers nil
-  "*If non-nil, don't hide any headers.")
-
-(defvar gnus-save-all-headers t
-  "*If non-nil, don't remove any headers before saving.")
-
-(defvar gnus-saved-headers gnus-visible-headers
-  "*Headers to keep if `gnus-save-all-headers' is nil.
-If `gnus-save-all-headers' is non-nil, this variable will be ignored.
-If that variable is nil, however, all headers that match this regexp
-will be kept while the rest will be deleted before saving.")
-
-(defvar gnus-inhibit-startup-message nil
-  "*If non-nil, the startup message will not be displayed.")
-
-(defvar gnus-signature-separator "^-- *$"
-  "Regexp matching signature separator.")
-
-(defvar gnus-signature-limit nil
-  "Provide a limit to what is considered a signature.
-If it is a number, no signature may not be longer (in characters) than
-that number.  If it is a function, the function will be called without
-any parameters, and if it returns nil, there is no signature in the
-buffer.  If it is a string, it will be used as a regexp.  If it
-matches, the text in question is not a signature.")
-
-(defvar gnus-auto-extend-newsgroup t
-  "*If non-nil, extend newsgroup forward and backward when requested.")
-
-(defvar gnus-auto-select-first t
-  "*If nil, don't select the first unread article when entering a group.
-If this variable is `best', select the highest-scored unread article
-in the group.  If neither nil nor `best', select the first unread
-article.
-
-If you want to prevent automatic selection of the first unread article
-in some newsgroups, set the variable to nil in
-`gnus-select-group-hook'.")
-
-(defvar gnus-auto-select-next t
-  "*If non-nil, offer to go to the next group from the end of the previous.
-If the value is t and the next newsgroup is empty, Gnus will exit
-summary mode and go back to group mode.	 If the value is neither nil
-nor t, Gnus will select the following unread newsgroup.	 In
-particular, if the value is the symbol `quietly', the next unread
-newsgroup will be selected without any confirmation, and if it is
-`almost-quietly', the next group will be selected without any
-confirmation if you are located on the last article in the group.
-Finally, if this variable is `slightly-quietly', the `Z n' command
-will go to the next group without confirmation.")
-
-(defvar gnus-auto-select-same nil
-  "*If non-nil, select the next article with the same subject.")
-
-(defvar gnus-summary-check-current nil
-  "*If non-nil, consider the current article when moving.
-The \"unread\" movement commands will stay on the same line if the
-current article is unread.")
-
-(defvar gnus-auto-center-summary t
-  "*If non-nil, always center the current summary buffer.
-In particular, if `vertical' do only vertical recentering.  If non-nil
-and non-`vertical', do both horizontal and vertical recentering.")
-
-(defvar gnus-break-pages t
-  "*If non-nil, do page breaking on articles.
-The page delimiter is specified by the `gnus-page-delimiter'
-variable.")
-
-(defvar gnus-page-delimiter "^\^L"
-  "*Regexp describing what to use as article page delimiters.
-The default value is \"^\^L\", which is a form linefeed at the
-beginning of a line.")
-
-(defvar gnus-use-full-window t
-  "*If non-nil, use the entire Emacs screen.")
-
-(defvar gnus-window-configuration nil
-  "Obsolete variable.  See `gnus-buffer-configuration'.")
-
-(defvar gnus-window-min-width 2
-  "*Minimum width of Gnus buffers.")
-
-(defvar gnus-window-min-height 1
-  "*Minimum height of Gnus buffers.")
-
-(defvar gnus-buffer-configuration
-  '((group
-     (vertical 1.0
-	       (group 1.0 point)
-	       (if gnus-carpal '(group-carpal 4))))
-    (summary
-     (vertical 1.0
-	       (summary 1.0 point)
-	       (if gnus-carpal '(summary-carpal 4))))
-    (article
-     (cond 
-      (gnus-use-picons
-       '(frame 1.0
-	       (vertical 1.0
-			 (summary 0.25 point)
-			 (if gnus-carpal '(summary-carpal 4))
-			 (article 1.0))
-	       (vertical ((height . 5) (width . 15)
-			  (user-position . t)
-			  (left . -1) (top . 1))
-			 (picons 1.0))))
-      (gnus-use-trees
-       '(vertical 1.0
-		  (summary 0.25 point)
-		  (tree 0.25)
-		  (article 1.0)))
-      (t
-       '(vertical 1.0
-		 (summary 0.25 point)
-		 (if gnus-carpal '(summary-carpal 4))
-		 (article 1.0)))))
-    (server
-     (vertical 1.0
-	       (server 1.0 point)
-	       (if gnus-carpal '(server-carpal 2))))
-    (browse
-     (vertical 1.0
-	       (browse 1.0 point)
-	       (if gnus-carpal '(browse-carpal 2))))
-    (message
-     (vertical 1.0
-	       (message 1.0 point)))
-    (pick
-     (vertical 1.0
-	       (article 1.0 point)))
-    (info
-     (vertical 1.0
-	       (info 1.0 point)))
-    (summary-faq
-     (vertical 1.0
-	       (summary 0.25)
-	       (faq 1.0 point)))
-    (edit-group
-     (vertical 1.0
-	       (group 0.5)
-	       (edit-group 1.0 point)))
-    (edit-server
-     (vertical 1.0
-	       (server 0.5)
-	       (edit-server 1.0 point)))
-    (edit-score
-     (vertical 1.0
-	       (summary 0.25)
-	       (edit-score 1.0 point)))
-    (post
-     (vertical 1.0
-	       (post 1.0 point)))
-    (reply
-     (vertical 1.0
-	       (article-copy 0.5)
-	       (message 1.0 point)))
-    (forward
-     (vertical 1.0
-	       (message 1.0 point)))
-    (reply-yank
-     (vertical 1.0
-	       (message 1.0 point)))
-    (mail-bounce
-     (vertical 1.0
-	       (article 0.5)
-	       (message 1.0 point)))
-    (draft
-     (vertical 1.0
-	       (draft 1.0 point)))
-    (pipe
-     (vertical 1.0
-	       (summary 0.25 point)
-	       (if gnus-carpal '(summary-carpal 4))
-	       ("*Shell Command Output*" 1.0)))
-    (bug
-     (vertical 1.0
-	       ("*Gnus Help Bug*" 0.5)
-	       ("*Gnus Bug*" 1.0 point)))
-    (compose-bounce
-     (vertical 1.0
-	       (article 0.5)
-	       (message 1.0 point))))
-  "Window configuration for all possible Gnus buffers.
-This variable is a list of lists.  Each of these lists has a NAME and
-a RULE.	 The NAMEs are commonsense names like `group', which names a
-rule used when displaying the group buffer; `summary', which names a
-rule for what happens when you enter a group and do not display an
-article buffer; and so on.  See the value of this variable for a
-complete list of NAMEs.
-
-Each RULE is a list of vectors.	 The first element in this vector is
-the name of the buffer to be displayed; the second element is the
-percentage of the screen this buffer is to occupy (a number in the
-0.0-0.99 range); the optional third element is `point', which should
-be present to denote which buffer point is to go to after making this
-buffer configuration.")
-
-(defvar gnus-window-to-buffer
-  '((group . gnus-group-buffer)
-    (summary . gnus-summary-buffer)
-    (article . gnus-article-buffer)
-    (server . gnus-server-buffer)
-    (browse . "*Gnus Browse Server*")
-    (edit-group . gnus-group-edit-buffer)
-    (edit-server . gnus-server-edit-buffer)
-    (group-carpal . gnus-carpal-group-buffer)
-    (summary-carpal . gnus-carpal-summary-buffer)
-    (server-carpal . gnus-carpal-server-buffer)
-    (browse-carpal . gnus-carpal-browse-buffer)
-    (edit-score . gnus-score-edit-buffer)
-    (message . gnus-message-buffer)
-    (mail . gnus-message-buffer)
-    (post-news . gnus-message-buffer)
-    (faq . gnus-faq-buffer)
-    (picons . "*Picons*")
-    (tree . gnus-tree-buffer)
-    (info . gnus-info-buffer)
-    (article-copy . gnus-article-copy)
-    (draft . gnus-draft-buffer))
-  "Mapping from short symbols to buffer names or buffer variables.")
-
-(defvar gnus-carpal nil
-  "*If non-nil, display clickable icons.")
-
-(defvar gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
-  "*Function called with a group name when new group is detected.
-A few pre-made functions are supplied: `gnus-subscribe-randomly'
-inserts new groups at the beginning of the list of groups;
-`gnus-subscribe-alphabetically' inserts new groups in strict
-alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
-in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
-for your decision; `gnus-subscribe-killed' kills all new groups;
-`gnus-subscribe-zombies' will make all new groups into zombies.")
-
-;; Suggested by a bug report by Hallvard B Furuseth.
-;; <h.b.furuseth@usit.uio.no>.
-(defvar gnus-subscribe-options-newsgroup-method
-  (function gnus-subscribe-alphabetically)
-  "*This function is called to subscribe newsgroups mentioned on \"options -n\" lines.
-If, for instance, you want to subscribe to all newsgroups in the
-\"no\" and \"alt\" hierarchies, you'd put the following in your
-.newsrc file:
-
-options -n no.all alt.all
-
-Gnus will the subscribe all new newsgroups in these hierarchies with
-the subscription method in this variable.")
-
-(defvar gnus-subscribe-hierarchical-interactive nil
-  "*If non-nil, Gnus will offer to subscribe hierarchically.
-When a new hierarchy appears, Gnus will ask the user:
-
-'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
-
-If the user pressed `d', Gnus will descend the hierarchy, `y' will
-subscribe to all newsgroups in the hierarchy and `s' will skip this
-hierarchy in its entirety.")
-
-(defvar gnus-group-sort-function 'gnus-group-sort-by-alphabet
-  "*Function used for sorting the group buffer.
-This function will be called with group info entries as the arguments
-for the groups to be sorted.  Pre-made functions include
-`gnus-group-sort-by-alphabet', `gnus-group-sort-by-unread',
-`gnus-group-sort-by-level', `gnus-group-sort-by-score', and
-`gnus-group-sort-by-rank'.
-
-This variable can also be a list of sorting functions.	In that case,
-the most significant sort function should be the last function in the
-list.")
-
-;; Mark variables suggested by Thomas Michanek
-;; <Thomas.Michanek@telelogic.se>.
-(defvar gnus-unread-mark ? 
-  "*Mark used for unread articles.")
-(defvar gnus-ticked-mark ?!
-  "*Mark used for ticked articles.")
-(defvar gnus-dormant-mark ??
-  "*Mark used for dormant articles.")
-(defvar gnus-del-mark ?r
-  "*Mark used for del'd articles.")
-(defvar gnus-read-mark ?R
-  "*Mark used for read articles.")
-(defvar gnus-expirable-mark ?E
-  "*Mark used for expirable articles.")
-(defvar gnus-killed-mark ?K
-  "*Mark used for killed articles.")
-(defvar gnus-souped-mark ?F
-  "*Mark used for killed articles.")
-(defvar gnus-kill-file-mark ?X
-  "*Mark used for articles killed by kill files.")
-(defvar gnus-low-score-mark ?Y
-  "*Mark used for articles with a low score.")
-(defvar gnus-catchup-mark ?C
-  "*Mark used for articles that are caught up.")
-(defvar gnus-replied-mark ?A
-  "*Mark used for articles that have been replied to.")
-(defvar gnus-cached-mark ?*
-  "*Mark used for articles that are in the cache.")
-(defvar gnus-saved-mark ?S
-  "*Mark used for articles that have been saved to.")
-(defvar gnus-process-mark ?#
-  "*Process mark.")
-(defvar gnus-ancient-mark ?O
-  "*Mark used for ancient articles.")
-(defvar gnus-sparse-mark ?Q
-  "*Mark used for sparsely reffed articles.")
-(defvar gnus-canceled-mark ?G
-  "*Mark used for canceled articles.")
-(defvar gnus-score-over-mark ?+
-  "*Score mark used for articles with high scores.")
-(defvar gnus-score-below-mark ?-
-  "*Score mark used for articles with low scores.")
-(defvar gnus-empty-thread-mark ? 
-  "*There is no thread under the article.")
-(defvar gnus-not-empty-thread-mark ?=
-  "*There is a thread under the article.")
-
-(defvar gnus-view-pseudo-asynchronously nil
-  "*If non-nil, Gnus will view pseudo-articles asynchronously.")
-
-(defvar gnus-view-pseudos nil
-  "*If `automatic', pseudo-articles will be viewed automatically.
-If `not-confirm', pseudos will be viewed automatically, and the user
-will not be asked to confirm the command.")
-
-(defvar gnus-view-pseudos-separately t
-  "*If non-nil, one pseudo-article will be created for each file to be viewed.
-If nil, all files that use the same viewing command will be given as a
-list of parameters to that command.")
-
-(defvar gnus-insert-pseudo-articles t
-  "*If non-nil, insert pseudo-articles when decoding articles.")
-
-(defvar gnus-group-line-format "%M%S%p%P%5y: %(%g%)%l\n"
-  "*Format of group lines.
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%M    Only marked articles (character, \"*\" or \" \")
-%S    Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
-%L    Level of subscribedness (integer)
-%N    Number of unread articles (integer)
-%I    Number of dormant articles (integer)
-%i    Number of ticked and dormant (integer)
-%T    Number of ticked articles (integer)
-%R    Number of read articles (integer)
-%t    Total number of articles (integer)
-%y    Number of unread, unticked articles (integer)
-%G    Group name (string)
-%g    Qualified group name (string)
-%D    Group description (string)
-%s    Select method (string)
-%o    Moderated group (char, \"m\")
-%p    Process mark (char)
-%O    Moderated group (string, \"(m)\" or \"\")
-%P    Topic indentation (string)
-%l    Whether there are GroupLens predictions for this group (string)
-%n    Select from where (string)
-%z    A string that look like `<%s:%n>' if a foreign select method is used
-%u    User defined specifier.  The next character in the format string should
-      be a letter.  Gnus will call the function gnus-user-format-function-X,
-      where X is the letter following %u.  The function will be passed the
-      current header as argument.  The function should return a string, which
-      will be inserted into the buffer just like information from any other
-      group specifier.
-
-Text between %( and %) will be highlighted with `gnus-mouse-face' when
-the mouse point move inside the area.  There can only be one such area.
-
-Note that this format specification is not always respected.  For
-reasons of efficiency, when listing killed groups, this specification
-is ignored altogether.	If the spec is changed considerably, your
-output may end up looking strange when listing both alive and killed
-groups.
-
-If you use %o or %O, reading the active file will be slower and quite
-a bit of extra memory will be used. %D will also worsen performance.
-Also note that if you change the format specification to include any
-of these specs, you must probably re-start Gnus to see them go into
-effect.")
-
-(defvar gnus-summary-line-format "%U%R%z%I%(%[%4L: %-20,20n%]%) %s\n"
-  "*The format specification of the lines in the summary buffer.
-
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%N   Article number, left padded with spaces (string)
-%S   Subject (string)
-%s   Subject if it is at the root of a thread, and \"\" otherwise (string)
-%n   Name of the poster (string)
-%a   Extracted name of the poster (string)
-%A   Extracted address of the poster (string)
-%F   Contents of the From: header (string)
-%x   Contents of the Xref: header (string)
-%D   Date of the article (string)
-%d   Date of the article (string) in DD-MMM format
-%M   Message-id of the article (string)
-%r   References of the article (string)
-%c   Number of characters in the article (integer)
-%L   Number of lines in the article (integer)
-%I   Indentation based on thread level (a string of spaces)
-%T   A string with two possible values: 80 spaces if the article
-     is on thread level two or larger and 0 spaces on level one
-%R   \"A\" if this article has been replied to, \" \" otherwise (character)
-%U   Status of this article (character, \"R\", \"K\", \"-\" or \" \")
-%[   Opening bracket (character, \"[\" or \"<\")
-%]   Closing bracket (character, \"]\" or \">\")
-%>   Spaces of length thread-level (string)
-%<   Spaces of length (- 20 thread-level) (string)
-%i   Article score (number)
-%z   Article zcore (character)
-%t   Number of articles under the current thread (number).
-%e   Whether the thread is empty or not (character).
-%l   GroupLens score (string).
-%u   User defined specifier.  The next character in the format string should
-     be a letter.  Gnus will call the function gnus-user-format-function-X,
-     where X is the letter following %u.  The function will be passed the
-     current header as argument.  The function should return a string, which
-     will be inserted into the summary just like information from any other
-     summary specifier.
-
-Text between %( and %) will be highlighted with `gnus-mouse-face'
-when the mouse point is placed inside the area.	 There can only be one
-such area.
-
-The %U (status), %R (replied) and %z (zcore) specs have to be handled
-with care.  For reasons of efficiency, Gnus will compute what column
-these characters will end up in, and \"hard-code\" that.  This means that
-it is illegal to have these specs after a variable-length spec.	 Well,
-you might not be arrested, but your summary buffer will look strange,
-which is bad enough.
-
-The smart choice is to have these specs as for to the left as
-possible.
-
-This restriction may disappear in later versions of Gnus.")
-
-(defvar gnus-summary-dummy-line-format
-  "*  %(:                          :%) %S\n"
-  "*The format specification for the dummy roots in the summary buffer.
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%S  The subject")
-
-(defvar gnus-summary-mode-line-format "Gnus: %%b [%A] %Z"
-  "*The format specification for the summary mode line.
-It works along the same lines as a normal formatting string,
-with some simple extensions:
-
-%G  Group name
-%p  Unprefixed group name
-%A  Current article number
-%V  Gnus version
-%U  Number of unread articles in the group
-%e  Number of unselected articles in the group
-%Z  A string with unread/unselected article counts
-%g  Shortish group name
-%S  Subject of the current article
-%u  User-defined spec
-%s  Current score file name
-%d  Number of dormant articles
-%r  Number of articles that have been marked as read in this session
-%E  Number of articles expunged by the score files")
-
-(defvar gnus-article-mode-line-format "Gnus: %%b %S"
-  "*The format specification for the article mode line.
-See `gnus-summary-mode-line-format' for a closer description.")
-
-(defvar gnus-group-mode-line-format "Gnus: %%b {%M%:%S}"
-  "*The format specification for the group mode line.
-It works along the same lines as a normal formatting string,
-with some simple extensions:
-
-%S   The native news server.
-%M   The native select method.
-%:   \":\" if %S isn't \"\".")
-
-(defvar gnus-valid-select-methods
-  '(("nntp" post address prompt-address)
-    ("nnspool" post address)
-    ("nnvirtual" post-mail virtual prompt-address)
-    ("nnmbox" mail respool address)
-    ("nnml" mail respool address)
-    ("nnmh" mail respool address)
-    ("nndir" post-mail prompt-address address)
-    ("nneething" none address prompt-address)
-    ("nndoc" none address prompt-address)
-    ("nnbabyl" mail address respool)
-    ("nnkiboze" post virtual)
-    ("nnsoup" post-mail address)
-    ("nndraft" post-mail)
-    ("nnfolder" mail respool address))
-  "An alist of valid select methods.
-The first element of each list lists should be a string with the name
-of the select method.  The other elements may be be the category of
-this method (ie. `post', `mail', `none' or whatever) or other
-properties that this method has (like being respoolable).
-If you implement a new select method, all you should have to change is
-this variable.	I think.")
-
-(defvar gnus-updated-mode-lines '(group article summary tree)
-  "*List of buffers that should update their mode lines.
-The list may contain the symbols `group', `article' and `summary'.  If
-the corresponding symbol is present, Gnus will keep that mode line
-updated with information that may be pertinent.
-If this variable is nil, screen refresh may be quicker.")
-
-;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
-(defvar gnus-mode-non-string-length nil
-  "*Max length of mode-line non-string contents.
-If this is nil, Gnus will take space as is needed, leaving the rest
-of the modeline intact.")
-
-;see gnus-cus.el
-;(defvar gnus-mouse-face 'highlight
-;  "*Face used for mouse highlighting in Gnus.
-;No mouse highlights will be done if `gnus-visual' is nil.")
-
-(defvar gnus-summary-mark-below 0
-  "*Mark all articles with a score below this variable as read.
-This variable is local to each summary buffer and usually set by the
-score file.")
-
-(defvar gnus-article-sort-functions '(gnus-article-sort-by-number)
-  "*List of functions used for sorting articles in the summary buffer.
-This variable is only used when not using a threaded display.")
-
-(defvar gnus-thread-sort-functions '(gnus-thread-sort-by-number)
-  "*List of functions used for sorting threads in the summary buffer.
-By default, threads are sorted by article number.
-
-Each function takes two threads and return non-nil if the first thread
-should be sorted before the other.  If you use more than one function,
-the primary sort function should be the last.  You should probably
-always include `gnus-thread-sort-by-number' in the list of sorting
-functions -- preferably first.
-
-Ready-mady functions include `gnus-thread-sort-by-number',
-`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
-`gnus-thread-sort-by-date', `gnus-thread-sort-by-score' and
-`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').")
-
-(defvar gnus-thread-score-function '+
-  "*Function used for calculating the total score of a thread.
-
-The function is called with the scores of the article and each
-subthread and should then return the score of the thread.
-
-Some functions you can use are `+', `max', or `min'.")
-
-(defvar gnus-summary-expunge-below nil
-  "All articles that have a score less than this variable will be expunged.")
-
-(defvar gnus-thread-expunge-below nil
-  "All threads that have a total score less than this variable will be expunged.
-See `gnus-thread-score-function' for en explanation of what a
-\"thread score\" is.")
-
-(defvar gnus-auto-subscribed-groups
-  "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl"
-  "*All new groups that match this regexp will be subscribed automatically.
-Note that this variable only deals with new groups.  It has no effect
-whatsoever on old groups.
-
-New groups that match this regexp will not be handled by
-`gnus-subscribe-newsgroup-method'.  Instead, they will
-be subscribed using `gnus-subscribe-options-newsgroup-method'.")
-
-(defvar gnus-options-subscribe nil
-  "*All new groups matching this regexp will be subscribed unconditionally.
-Note that this variable deals only with new newsgroups.	 This variable
-does not affect old newsgroups.
-
-New groups that match this regexp will not be handled by
-`gnus-subscribe-newsgroup-method'.  Instead, they will
-be subscribed using `gnus-subscribe-options-newsgroup-method'.")
-
-(defvar gnus-options-not-subscribe nil
-  "*All new groups matching this regexp will be ignored.
-Note that this variable deals only with new newsgroups.	 This variable
-does not affect old (already subscribed) newsgroups.")
-
-(defvar gnus-auto-expirable-newsgroups nil
-  "*Groups in which to automatically mark read articles as expirable.
-If non-nil, this should be a regexp that should match all groups in
-which to perform auto-expiry.  This only makes sense for mail groups.")
-
-(defvar gnus-total-expirable-newsgroups nil
-  "*Groups in which to perform expiry of all read articles.
-Use with extreme caution.  All groups that match this regexp will be
-expiring - which means that all read articles will be deleted after
-(say) one week.	 (This only goes for mail groups and the like, of
-course.)")
-
-(defvar gnus-group-uncollapsed-levels 1
-  "Number of group name elements to leave alone when making a short group name.")
-
-(defvar gnus-hidden-properties '(invisible t intangible t)
-  "Property list to use for hiding text.")
-
-(defvar gnus-modtime-botch nil
-  "*Non-nil means .newsrc should be deleted prior to save.  
-Its use is due to the bogus appearance that .newsrc was modified on
-disc.")
-
-;; Hooks.
-
-(defvar gnus-group-mode-hook nil
-  "*A hook for Gnus group mode.")
-
-(defvar gnus-summary-mode-hook nil
-  "*A hook for Gnus summary mode.
-This hook is run before any variables are set in the summary buffer.")
-
-(defvar gnus-article-mode-hook nil
-  "*A hook for Gnus article mode.")
-
-(defvar gnus-summary-prepare-exit-hook nil
-  "*A hook called when preparing to exit from the summary buffer.
-It calls `gnus-summary-expire-articles' by default.")
-(add-hook 'gnus-summary-prepare-exit-hook 'gnus-summary-expire-articles)
-
-(defvar gnus-summary-exit-hook nil
-  "*A hook called on exit from the summary buffer.")
-
-(defvar gnus-group-catchup-group-hook nil
-  "*A hook run when catching up a group from the group buffer.")
-
-(defvar gnus-group-update-group-hook nil
-  "*A hook called when updating group lines.")
-
-(defvar gnus-open-server-hook nil
-  "*A hook called just before opening connection to the news server.")
-
-(defvar gnus-load-hook nil
-  "*A hook run while Gnus is loaded.")
-
-(defvar gnus-startup-hook nil
-  "*A hook called at startup.
-This hook is called after Gnus is connected to the NNTP server.")
-
-(defvar gnus-get-new-news-hook nil
-  "*A hook run just before Gnus checks for new news.")
-
-(defvar gnus-after-getting-new-news-hook nil
-  "*A hook run after Gnus checks for new news.")
-
-(defvar gnus-group-prepare-function 'gnus-group-prepare-flat
-  "*A function that is called to generate the group buffer.
-The function is called with three arguments: The first is a number;
-all group with a level less or equal to that number should be listed,
-if the second is non-nil, empty groups should also be displayed.  If
-the third is non-nil, it is a number.  No groups with a level lower
-than this number should be displayed.
-
-The only current function implemented is `gnus-group-prepare-flat'.")
-
-(defvar gnus-group-prepare-hook nil
-  "*A hook called after the group buffer has been generated.
-If you want to modify the group buffer, you can use this hook.")
-
-(defvar gnus-summary-prepare-hook nil
-  "*A hook called after the summary buffer has been generated.
-If you want to modify the summary buffer, you can use this hook.")
-
-(defvar gnus-summary-generate-hook nil
-  "*A hook run just before generating the summary buffer.
-This hook is commonly used to customize threading variables and the
-like.")
-
-(defvar gnus-article-prepare-hook nil
-  "*A hook called after an article has been prepared in the article buffer.
-If you want to run a special decoding program like nkf, use this hook.")
-
-;(defvar gnus-article-display-hook nil
-;  "*A hook called after the article is displayed in the article buffer.
-;The hook is designed to change the contents of the article
-;buffer.  Typical functions that this hook may contain are
-;`gnus-article-hide-headers' (hide selected headers),
-;`gnus-article-maybe-highlight' (perform fancy article highlighting),
-;`gnus-article-hide-signature' (hide signature) and
-;`gnus-article-treat-overstrike' (turn \"^H_\" into bold characters).")
-;(add-hook 'gnus-article-display-hook 'gnus-article-hide-headers-if-wanted)
-;(add-hook 'gnus-article-display-hook 'gnus-article-treat-overstrike)
-;(add-hook 'gnus-article-display-hook 'gnus-article-maybe-highlight)
-
-(defvar gnus-article-x-face-too-ugly nil
-  "Regexp matching posters whose face shouldn't be shown automatically.")
-
-(defvar gnus-select-group-hook nil
-  "*A hook called when a newsgroup is selected.
-
-If you'd like to simplify subjects like the
-`gnus-summary-next-same-subject' command does, you can use the
-following hook:
-
- (setq gnus-select-group-hook
-      (list
-	(lambda ()
-	  (mapcar (lambda (header)
-		     (mail-header-set-subject
-		      header
-		      (gnus-simplify-subject
-		       (mail-header-subject header) 're-only)))
-		  gnus-newsgroup-headers))))")
-
-(defvar gnus-select-article-hook nil
-  "*A hook called when an article is selected.")
-
-(defvar gnus-apply-kill-hook '(gnus-apply-kill-file)
-  "*A hook called to apply kill files to a group.
-This hook is intended to apply a kill file to the selected newsgroup.
-The function `gnus-apply-kill-file' is called by default.
-
-Since a general kill file is too heavy to use only for a few
-newsgroups, I recommend you to use a lighter hook function.  For
-example, if you'd like to apply a kill file to articles which contains
-a string `rmgroup' in subject in newsgroup `control', you can use the
-following hook:
-
- (setq gnus-apply-kill-hook
-      (list
-	(lambda ()
-	  (cond ((string-match \"control\" gnus-newsgroup-name)
-		 (gnus-kill \"Subject\" \"rmgroup\")
-		 (gnus-expunge \"X\"))))))")
-
-(defvar gnus-visual-mark-article-hook
-  (list 'gnus-highlight-selected-summary)
-  "*Hook run after selecting an article in the summary buffer.
-It is meant to be used for highlighting the article in some way.  It
-is not run if `gnus-visual' is nil.")
-
-(defvar gnus-parse-headers-hook nil
-  "*A hook called before parsing the headers.")
-(add-hook 'gnus-parse-headers-hook 'gnus-decode-rfc1522)
-
-(defvar gnus-exit-group-hook nil
-  "*A hook called when exiting (not quitting) summary mode.")
-
-(defvar gnus-suspend-gnus-hook nil
-  "*A hook called when suspending (not exiting) Gnus.")
-
-(defvar gnus-exit-gnus-hook nil
-  "*A hook called when exiting Gnus.")
-
-(defvar gnus-after-exiting-gnus-hook nil
-  "*A hook called after exiting Gnus.")
-
-(defvar gnus-save-newsrc-hook nil
-  "*A hook called before saving any of the newsrc files.")
-
-(defvar gnus-save-quick-newsrc-hook nil
-  "*A hook called just before saving the quick newsrc file.
-Can be used to turn version control on or off.")
-
-(defvar gnus-save-standard-newsrc-hook nil
-  "*A hook called just before saving the standard newsrc file.
-Can be used to turn version control on or off.")
-
-(defvar gnus-summary-update-hook
-  (list 'gnus-summary-highlight-line)
-  "*A hook called when a summary line is changed.
-The hook will not be called if `gnus-visual' is nil.
-
-The default function `gnus-summary-highlight-line' will
-highlight the line according to the `gnus-summary-highlight'
-variable.")
-
-(defvar gnus-group-update-hook '(gnus-group-highlight-line)
-  "*A hook called when a group line is changed.
-The hook will not be called if `gnus-visual' is nil.
-
-The default function `gnus-group-highlight-line' will
-highlight the line according to the `gnus-group-highlight'
-variable.")
-
-(defvar gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
-  "*A hook called when an article is selected for the first time.
-The hook is intended to mark an article as read (or unread)
-automatically when it is selected.")
-
-(defvar gnus-group-change-level-function nil
-  "Function run when a group level is changed.
-It is called with three parameters -- GROUP, LEVEL and OLDLEVEL.")
-
-;; Remove any hilit infestation.
-(add-hook 'gnus-startup-hook
-	  (lambda ()
-	    (remove-hook 'gnus-summary-prepare-hook
-			 'hilit-rehighlight-buffer-quietly)
-	    (remove-hook 'gnus-summary-prepare-hook 'hilit-install-line-hooks)
-	    (setq gnus-mark-article-hook
-		  '(gnus-summary-mark-read-and-unread-as-read))
-	    (remove-hook 'gnus-article-prepare-hook
-			 'hilit-rehighlight-buffer-quietly)))
-
-
-;; Internal variables
-
-(defvar gnus-tree-buffer "*Tree*"
-  "Buffer where Gnus thread trees are displayed.")
-
-;; Dummy variable.
-(defvar gnus-use-generic-from nil)
-
-(defvar gnus-thread-indent-array nil)
-(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
-
-(defvar gnus-newsrc-file-version nil)
-
-(defvar gnus-method-history nil)
-;; Variable holding the user answers to all method prompts.
-
-(defvar gnus-group-history nil)
-;; Variable holding the user answers to all group prompts.
-
-(defvar gnus-server-alist nil
-  "List of available servers.")
-
-(defvar gnus-group-indentation-function nil)
-
-(defvar gnus-topic-indentation "") ;; Obsolete variable.
-
-(defvar gnus-goto-missing-group-function nil)
-
-(defvar gnus-override-subscribe-method nil)
-
-(defvar gnus-group-goto-next-group-function nil
-  "Function to override finding the next group after listing groups.")
-
-(defconst gnus-article-mark-lists
-  '((marked . tick) (replied . reply)
-    (expirable . expire) (killed . killed)
-    (bookmarks . bookmark) (dormant . dormant)
-    (scored . score) (saved . save)
-    (cached . cache)
-    ))
-
-;; Avoid highlighting in kill files.
-(defvar gnus-summary-inhibit-highlight nil)
-(defvar gnus-newsgroup-selected-overlay nil)
-
-(defvar gnus-inhibit-hiding nil)
-(defvar gnus-group-indentation "")
-(defvar gnus-inhibit-limiting nil)
-(defvar gnus-created-frames nil)
-
-(defvar gnus-article-mode-map nil)
-(defvar gnus-dribble-buffer nil)
-(defvar gnus-headers-retrieved-by nil)
-(defvar gnus-article-reply nil)
-(defvar gnus-override-method nil)
-(defvar gnus-article-check-size nil)
-
-(defvar gnus-current-score-file nil)
-(defvar gnus-newsgroup-adaptive-score-file nil)
-(defvar gnus-scores-exclude-files nil)
-
-(defvar gnus-opened-servers nil)
-
-(defvar gnus-current-move-group nil)
-(defvar gnus-current-copy-group nil)
-(defvar gnus-current-crosspost-group nil)
-
-(defvar gnus-newsgroup-dependencies nil)
-(defvar gnus-newsgroup-async nil)
-(defconst gnus-group-edit-buffer "*Gnus edit newsgroup*")
-
-(defvar gnus-newsgroup-adaptive nil)
-
-(defvar gnus-summary-display-table nil)
-(defvar gnus-summary-display-article-function nil)
-
-(defvar gnus-summary-highlight-line-function nil
-  "Function called after highlighting a summary line.")
-
-(defvar gnus-group-line-format-alist
-  `((?M gnus-tmp-marked-mark ?c)
-    (?S gnus-tmp-subscribed ?c)
-    (?L gnus-tmp-level ?d)
-    (?N (cond ((eq number t) "*" )
-	      ((numberp number) 
-	       (int-to-string
-		(+ number
-		   (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
-		   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
-	      (t number)) ?s)
-    (?R gnus-tmp-number-of-read ?s)
-    (?t gnus-tmp-number-total ?d)
-    (?y gnus-tmp-number-of-unread ?s)
-    (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
-    (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
-    (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
-	   (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
-    (?g gnus-tmp-group ?s)
-    (?G gnus-tmp-qualified-group ?s)
-    (?c (gnus-short-group-name gnus-tmp-group) ?s)
-    (?D gnus-tmp-newsgroup-description ?s)
-    (?o gnus-tmp-moderated ?c)
-    (?O gnus-tmp-moderated-string ?s)
-    (?p gnus-tmp-process-marked ?c)
-    (?s gnus-tmp-news-server ?s)
-    (?n gnus-tmp-news-method ?s)
-    (?P gnus-group-indentation ?s)
-    (?l gnus-tmp-grouplens ?s)
-    (?z gnus-tmp-news-method-string ?s)
-    (?u gnus-tmp-user-defined ?s)))
-
-(defvar gnus-summary-line-format-alist
-  `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
-    (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
-    (?s gnus-tmp-subject-or-nil ?s)
-    (?n gnus-tmp-name ?s)
-    (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
-	?s)
-    (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
-	    gnus-tmp-from) ?s)
-    (?F gnus-tmp-from ?s)
-    (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
-    (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
-    (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
-    (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
-    (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
-    (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
-    (?L gnus-tmp-lines ?d)
-    (?I gnus-tmp-indentation ?s)
-    (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
-    (?R gnus-tmp-replied ?c)
-    (?\[ gnus-tmp-opening-bracket ?c)
-    (?\] gnus-tmp-closing-bracket ?c)
-    (?\> (make-string gnus-tmp-level ? ) ?s)
-    (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
-    (?i gnus-tmp-score ?d)
-    (?z gnus-tmp-score-char ?c)
-    (?l (bbb-grouplens-score gnus-tmp-header) ?s)
-    (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
-    (?U gnus-tmp-unread ?c)
-    (?t (gnus-summary-number-of-articles-in-thread
-	 (and (boundp 'thread) (car thread)) gnus-tmp-level)
-	?d)
-    (?e (gnus-summary-number-of-articles-in-thread
-	 (and (boundp 'thread) (car thread)) gnus-tmp-level t)
-	?c)
-    (?u gnus-tmp-user-defined ?s))
-  "An alist of format specifications that can appear in summary lines,
-and what variables they correspond with, along with the type of the
-variable (string, integer, character, etc).")
-
-(defvar gnus-summary-dummy-line-format-alist
-  `((?S gnus-tmp-subject ?s)
-    (?N gnus-tmp-number ?d)
-    (?u gnus-tmp-user-defined ?s)))
-
-(defvar gnus-summary-mode-line-format-alist
-  `((?G gnus-tmp-group-name ?s)
-    (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
-    (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
-    (?A gnus-tmp-article-number ?d)
-    (?Z gnus-tmp-unread-and-unselected ?s)
-    (?V gnus-version ?s)
-    (?U gnus-tmp-unread-and-unticked ?d)
-    (?S gnus-tmp-subject ?s)
-    (?e gnus-tmp-unselected ?d)
-    (?u gnus-tmp-user-defined ?s)
-    (?d (length gnus-newsgroup-dormant) ?d)
-    (?t (length gnus-newsgroup-marked) ?d)
-    (?r (length gnus-newsgroup-reads) ?d)
-    (?E gnus-newsgroup-expunged-tally ?d)
-    (?s (gnus-current-score-file-nondirectory) ?s)))
-
-(defvar gnus-article-mode-line-format-alist
-  gnus-summary-mode-line-format-alist)
-
-(defvar gnus-group-mode-line-format-alist
-  `((?S gnus-tmp-news-server ?s)
-    (?M gnus-tmp-news-method ?s)
-    (?u gnus-tmp-user-defined ?s)
-    (?: gnus-tmp-colon ?s)))
-
-(defvar gnus-have-read-active-file nil)
-
-(defconst gnus-maintainer
-  "gnus-bug@ifi.uio.no (The Gnus Bugfixing Girls + Boys)"
-  "The mail address of the Gnus maintainers.")
-
-(defconst gnus-version-number "5.3"
-  "Version number for this version of Gnus.")
-
-(defconst gnus-version (format "Gnus v%s" gnus-version-number)
-  "Version string for this version of Gnus.")
-
-(defvar gnus-info-nodes
-  '((gnus-group-mode "(gnus)The Group Buffer")
-    (gnus-summary-mode "(gnus)The Summary Buffer")
-    (gnus-article-mode "(gnus)The Article Buffer")
-    (gnus-server-mode "(gnus)The Server Buffer")
-    (gnus-browse-mode "(gnus)Browse Foreign Server")
-    (gnus-tree-mode "(gnus)Tree Display")
-    )
-  "Alist of major modes and related Info nodes.")
-
-(defvar gnus-group-buffer "*Group*")
-(defvar gnus-summary-buffer "*Summary*")
-(defvar gnus-article-buffer "*Article*")
-(defvar gnus-server-buffer "*Server*")
-
-(defvar gnus-work-buffer " *gnus work*")
-
-(defvar gnus-original-article-buffer " *Original Article*")
-(defvar gnus-original-article nil)
-
-(defvar gnus-buffer-list nil
-  "Gnus buffers that should be killed on exit.")
-
-(defvar gnus-slave nil
-  "Whether this Gnus is a slave or not.")
-
-(defvar gnus-variable-list
-  '(gnus-newsrc-options gnus-newsrc-options-n
-    gnus-newsrc-last-checked-date
-    gnus-newsrc-alist gnus-server-alist
-    gnus-killed-list gnus-zombie-list
-    gnus-topic-topology gnus-topic-alist
-    gnus-format-specs)
-  "Gnus variables saved in the quick startup file.")
-
-(defvar gnus-newsrc-options nil
-  "Options line in the .newsrc file.")
-
-(defvar gnus-newsrc-options-n nil
-  "List of regexps representing groups to be subscribed/ignored unconditionally.")
-
-(defvar gnus-newsrc-last-checked-date nil
-  "Date Gnus last asked server for new newsgroups.")
-
-(defvar gnus-topic-topology nil
-  "The complete topic hierarchy.")
-
-(defvar gnus-topic-alist nil
-  "The complete topic-group alist.")
-
-(defvar gnus-newsrc-alist nil
-  "Assoc list of read articles.
-gnus-newsrc-hashtb should be kept so that both hold the same information.")
-
-(defvar gnus-newsrc-hashtb nil
-  "Hashtable of gnus-newsrc-alist.")
-
-(defvar gnus-killed-list nil
-  "List of killed newsgroups.")
-
-(defvar gnus-killed-hashtb nil
-  "Hash table equivalent of gnus-killed-list.")
-
-(defvar gnus-zombie-list nil
-  "List of almost dead newsgroups.")
-
-(defvar gnus-description-hashtb nil
-  "Descriptions of newsgroups.")
-
-(defvar gnus-list-of-killed-groups nil
-  "List of newsgroups that have recently been killed by the user.")
-
-(defvar gnus-active-hashtb nil
-  "Hashtable of active articles.")
-
-(defvar gnus-moderated-list nil
-  "List of moderated newsgroups.")
-
-(defvar gnus-group-marked nil)
-
-(defvar gnus-current-startup-file nil
-  "Startup file for the current host.")
-
-(defvar gnus-last-search-regexp nil
-  "Default regexp for article search command.")
-
-(defvar gnus-last-shell-command nil
-  "Default shell command on article.")
-
-(defvar gnus-current-select-method nil
-  "The current method for selecting a newsgroup.")
-
-(defvar gnus-group-list-mode nil)
-
-(defvar gnus-article-internal-prepare-hook nil)
-
-(defvar gnus-newsgroup-name nil)
-(defvar gnus-newsgroup-begin nil)
-(defvar gnus-newsgroup-end nil)
-(defvar gnus-newsgroup-last-rmail nil)
-(defvar gnus-newsgroup-last-mail nil)
-(defvar gnus-newsgroup-last-folder nil)
-(defvar gnus-newsgroup-last-file nil)
-(defvar gnus-newsgroup-auto-expire nil)
-(defvar gnus-newsgroup-active nil)
-
-(defvar gnus-newsgroup-data nil)
-(defvar gnus-newsgroup-data-reverse nil)
-(defvar gnus-newsgroup-limit nil)
-(defvar gnus-newsgroup-limits nil)
-
-(defvar gnus-newsgroup-unreads nil
-  "List of unread articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-unselected nil
-  "List of unselected unread articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-reads nil
-  "Alist of read articles and article marks in the current newsgroup.")
-
-(defvar gnus-newsgroup-expunged-tally nil)
-
-(defvar gnus-newsgroup-marked nil
-  "List of ticked articles in the current newsgroup (a subset of unread art).")
-
-(defvar gnus-newsgroup-killed nil
-  "List of ranges of articles that have been through the scoring process.")
-
-(defvar gnus-newsgroup-cached nil
-  "List of articles that come from the article cache.")
-
-(defvar gnus-newsgroup-saved nil
-  "List of articles that have been saved.")
-
-(defvar gnus-newsgroup-kill-headers nil)
-
-(defvar gnus-newsgroup-replied nil
-  "List of articles that have been replied to in the current newsgroup.")
-
-(defvar gnus-newsgroup-expirable nil
-  "List of articles in the current newsgroup that can be expired.")
-
-(defvar gnus-newsgroup-processable nil
-  "List of articles in the current newsgroup that can be processed.")
-
-(defvar gnus-newsgroup-bookmarks nil
-  "List of articles in the current newsgroup that have bookmarks.")
-
-(defvar gnus-newsgroup-dormant nil
-  "List of dormant articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-scored nil
-  "List of scored articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-headers nil
-  "List of article headers in the current newsgroup.")
-
-(defvar gnus-newsgroup-threads nil)
-
-(defvar gnus-newsgroup-prepared nil
-  "Whether the current group has been prepared properly.")
-
-(defvar gnus-newsgroup-ancient nil
-  "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-sparse nil)
-
-(defvar gnus-current-article nil)
-(defvar gnus-article-current nil)
-(defvar gnus-current-headers nil)
-(defvar gnus-have-all-headers nil)
-(defvar gnus-last-article nil)
-(defvar gnus-newsgroup-history nil)
-(defvar gnus-current-kill-article nil)
-
-;; Save window configuration.
-(defvar gnus-prev-winconf nil)
-
-(defvar gnus-summary-mark-positions nil)
-(defvar gnus-group-mark-positions nil)
-
-(defvar gnus-reffed-article-number nil)
-
-;;; Let the byte-compiler know that we know about this variable.
-(defvar rmail-default-rmail-file)
-
-(defvar gnus-cache-removable-articles nil)
-
-(defvar gnus-dead-summary nil)
-
-(defconst gnus-summary-local-variables
-  '(gnus-newsgroup-name
-    gnus-newsgroup-begin gnus-newsgroup-end
-    gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
-    gnus-newsgroup-last-folder gnus-newsgroup-last-file
-    gnus-newsgroup-auto-expire gnus-newsgroup-unreads
-    gnus-newsgroup-unselected gnus-newsgroup-marked
-    gnus-newsgroup-reads gnus-newsgroup-saved
-    gnus-newsgroup-replied gnus-newsgroup-expirable
-    gnus-newsgroup-processable gnus-newsgroup-killed
-    gnus-newsgroup-bookmarks gnus-newsgroup-dormant
-    gnus-newsgroup-headers gnus-newsgroup-threads
-    gnus-newsgroup-prepared gnus-summary-highlight-line-function
-    gnus-current-article gnus-current-headers gnus-have-all-headers
-    gnus-last-article gnus-article-internal-prepare-hook
-    gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
-    gnus-newsgroup-scored gnus-newsgroup-kill-headers
-    gnus-newsgroup-async gnus-thread-expunge-below
-    gnus-score-alist gnus-current-score-file gnus-summary-expunge-below
-    (gnus-summary-mark-below . global)
-    gnus-newsgroup-active gnus-scores-exclude-files
-    gnus-newsgroup-history gnus-newsgroup-ancient
-    gnus-newsgroup-sparse
-    (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
-    gnus-newsgroup-adaptive-score-file
-    (gnus-newsgroup-expunged-tally . 0)
-    gnus-cache-removable-articles gnus-newsgroup-cached
-    gnus-newsgroup-data gnus-newsgroup-data-reverse
-    gnus-newsgroup-limit gnus-newsgroup-limits)
-  "Variables that are buffer-local to the summary buffers.")
-
-(defconst gnus-bug-message
-  "Sending a bug report to the Gnus Towers.
-========================================
-
-The buffer below is a mail buffer.  When you press `C-c C-c', it will
-be sent to the Gnus Bug Exterminators.
-
-At the bottom of the buffer you'll see lots of variable settings.
-Please do not delete those.  They will tell the Bug People what your
-environment is, so that it will be easier to locate the bugs.
-
-If you have found a bug that makes Emacs go \"beep\", set
-debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
-and include the backtrace in your bug report.
-
-Please describe the bug in annoying, painstaking detail.
-
-Thank you for your help in stamping out bugs.
-")
-
-;;; End of variables.
-
-;; Define some autoload functions Gnus might use.
-(eval-and-compile
-
-  ;; This little mapcar goes through the list below and marks the
-  ;; symbols in question as autoloaded functions.
-  (mapcar
-   (lambda (package)
-     (let ((interactive (nth 1 (memq ':interactive package))))
-       (mapcar
-	(lambda (function)
-	  (let (keymap)
-	    (when (consp function)
-	      (setq keymap (car (memq 'keymap function)))
-	      (setq function (car function)))
-	    (autoload function (car package) nil interactive keymap)))
-	(if (eq (nth 1 package) ':interactive)
-	    (cdddr package)
-	  (cdr package)))))
-   '(("metamail" metamail-buffer)
-     ("info" Info-goto-node)
-     ("hexl" hexl-hex-string-to-integer)
-     ("pp" pp pp-to-string pp-eval-expression)
-     ("mail-extr" mail-extract-address-components)
-     ("nnmail" nnmail-split-fancy nnmail-article-group)
-     ("nnvirtual" nnvirtual-catchup-group)
-     ("timezone" timezone-make-date-arpa-standard timezone-fix-time
-      timezone-make-sortable-date timezone-make-time-string)
-     ("rmailout" rmail-output)
-     ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
-      rmail-show-message)
-     ("gnus-soup" :interactive t
-      gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
-      gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
-     ("nnsoup" nnsoup-pack-replies)
-     ("score-mode" :interactive t gnus-score-mode)
-     ("gnus-mh" gnus-mh-mail-setup gnus-summary-save-article-folder
-      gnus-Folder-save-name gnus-folder-save-name)
-     ("gnus-mh" :interactive t gnus-summary-save-in-folder)
-     ("gnus-vis" gnus-group-make-menu-bar gnus-summary-make-menu-bar
-      gnus-server-make-menu-bar gnus-article-make-menu-bar
-      gnus-browse-make-menu-bar gnus-highlight-selected-summary
-      gnus-summary-highlight-line gnus-carpal-setup-buffer
-      gnus-group-highlight-line
-      gnus-article-add-button gnus-insert-next-page-button
-      gnus-insert-prev-page-button gnus-visual-turn-off-edit-menu)
-     ("gnus-vis" :interactive t
-      gnus-article-push-button gnus-article-press-button
-      gnus-article-highlight gnus-article-highlight-some
-      gnus-article-highlight-headers gnus-article-highlight-signature
-      gnus-article-add-buttons gnus-article-add-buttons-to-head
-      gnus-article-next-button gnus-article-prev-button)
-     ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
-      gnus-demon-add-disconnection gnus-demon-add-handler
-      gnus-demon-remove-handler)
-     ("gnus-demon" :interactive t
-      gnus-demon-init gnus-demon-cancel)
-     ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
-      gnus-tree-open gnus-tree-close)
-     ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
-      gnus-nocem-unwanted-article-p)
-     ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info)
-     ("gnus-srvr" gnus-browse-foreign-server)
-     ("gnus-cite" :interactive t
-      gnus-article-highlight-citation gnus-article-hide-citation-maybe
-      gnus-article-hide-citation gnus-article-fill-cited-article
-      gnus-article-hide-citation-in-followups)
-     ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
-      gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
-      gnus-execute gnus-expunge)
-     ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
-      gnus-cache-possibly-remove-articles gnus-cache-request-article
-      gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
-      gnus-cache-enter-remove-article gnus-cached-article-p
-      gnus-cache-open gnus-cache-close gnus-cache-update-article)
-     ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
-      gnus-cache-remove-article)
-     ("gnus-score" :interactive t
-      gnus-summary-increase-score gnus-summary-lower-score
-      gnus-score-flush-cache gnus-score-close
-      gnus-score-raise-same-subject-and-select
-      gnus-score-raise-same-subject gnus-score-default
-      gnus-score-raise-thread gnus-score-lower-same-subject-and-select
-      gnus-score-lower-same-subject gnus-score-lower-thread
-      gnus-possibly-score-headers gnus-summary-raise-score 
-      gnus-summary-set-score gnus-summary-current-score)
-     ("gnus-score"
-      (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
-      gnus-current-score-file-nondirectory gnus-score-adaptive
-      gnus-score-find-trace gnus-score-file-name)
-     ("gnus-edit" :interactive t gnus-score-customize)
-     ("gnus-topic" :interactive t gnus-topic-mode)
-     ("gnus-topic" gnus-topic-remove-group)
-     ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
-     ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
-     ("gnus-uu" :interactive t
-      gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
-      gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
-      gnus-uu-mark-by-regexp gnus-uu-mark-all
-      gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
-      gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
-      gnus-uu-decode-unshar-and-save gnus-uu-decode-save
-      gnus-uu-decode-binhex gnus-uu-decode-uu-view
-      gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
-      gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
-      gnus-uu-decode-binhex-view)
-     ("gnus-msg" (gnus-summary-send-map keymap)
-      gnus-mail-yank-original gnus-mail-send-and-exit
-      gnus-article-mail gnus-new-mail gnus-mail-reply)
-     ("gnus-msg" :interactive t
-      gnus-group-post-news gnus-group-mail gnus-summary-post-news
-      gnus-summary-followup gnus-summary-followup-with-original
-      gnus-summary-cancel-article gnus-summary-supersede-article
-      gnus-post-news gnus-inews-news 
-      gnus-summary-reply gnus-summary-reply-with-original
-      gnus-summary-mail-forward gnus-summary-mail-other-window
-      gnus-bug)
-     ("gnus-picon" :interactive t gnus-article-display-picons
-      gnus-group-display-picons gnus-picons-article-display-x-face
-      gnus-picons-display-x-face)
-     ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p 
-      gnus-grouplens-mode)
-     ("smiley" :interactive t gnus-smiley-display)
-     ("gnus-vm" gnus-vm-mail-setup)
-     ("gnus-vm" :interactive t gnus-summary-save-in-vm
-      gnus-summary-save-article-vm))))
-
-
-
-;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-;; If you want the cursor to go somewhere else, set these two
-;; functions in some startup hook to whatever you want.
-(defalias 'gnus-summary-position-point 'gnus-goto-colon)
-(defalias 'gnus-group-position-point 'gnus-goto-colon)
-
-;;; Various macros and substs.
-
-(defun gnus-header-from (header)
-  (mail-header-from header))
-
-(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
-  "Pop to BUFFER, evaluate FORMS, and then return to the original window."
-  (let ((tempvar (make-symbol "GnusStartBufferWindow"))
-	(w (make-symbol "w"))
-	(buf (make-symbol "buf")))
-    `(let* ((,tempvar (selected-window))
-	    (,buf ,buffer)
-	    (,w (get-buffer-window ,buf 'visible)))
-       (unwind-protect
-	   (progn
-	     (if ,w
-		 (select-window ,w)
-	       (pop-to-buffer ,buf))
-	     ,@forms)
-	 (select-window ,tempvar)))))
-
-(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
-(put 'gnus-eval-in-buffer-window 'lisp-indent-hook 1)
-(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
-
-(defmacro gnus-gethash (string hashtable)
-  "Get hash value of STRING in HASHTABLE."
-  `(symbol-value (intern-soft ,string ,hashtable)))
-
-(defmacro gnus-sethash (string value hashtable)
-  "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
-  `(set (intern ,string ,hashtable) ,value))
-
-(defmacro gnus-intern-safe (string hashtable)
-  "Set hash value.  Arguments are STRING, VALUE, and HASHTABLE."
-  `(let ((symbol (intern ,string ,hashtable)))
-     (or (boundp symbol)
-	 (set symbol nil))
-     symbol))
-
-(defmacro gnus-group-unread (group)
-  "Get the currently computed number of unread articles in GROUP."
-  `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
-
-(defmacro gnus-group-entry (group)
-  "Get the newsrc entry for GROUP."
-  `(gnus-gethash ,group gnus-newsrc-hashtb))
-
-(defmacro gnus-active (group)
-  "Get active info on GROUP."
-  `(gnus-gethash ,group gnus-active-hashtb))
-
-(defmacro gnus-set-active (group active)
-  "Set GROUP's active info."
-  `(gnus-sethash ,group ,active gnus-active-hashtb))
-
-;; modified by MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;;   function `substring' might cut on a middle of multi-octet
-;;   character.
-(defun gnus-truncate-string (str width)
-  (substring str 0 width))
-
-;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>.  A safe way
-;; to limit the length of a string.  This function is necessary since
-;; `(substr "abc" 0 30)' pukes with "Args out of range".
-(defsubst gnus-limit-string (str width)
-  (if (> (length str) width)
-      (substring str 0 width)
-    str))
-
-(defsubst gnus-simplify-subject-re (subject)
-  "Remove \"Re:\" from subject lines."
-  (if (string-match "^[Rr][Ee]: *" subject)
-      (substring subject (match-end 0))
-    subject))
-
-(defsubst gnus-functionp (form)
-  "Return non-nil if FORM is funcallable."
-  (or (and (symbolp form) (fboundp form))
-      (and (listp form) (eq (car form) 'lambda))))
-
-(defsubst gnus-goto-char (point)
-  (and point (goto-char point)))
-
-(defmacro gnus-buffer-exists-p (buffer)
-  `(let ((buffer ,buffer))
-     (and buffer
-	  (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
-		   buffer))))
-
-(defmacro gnus-kill-buffer (buffer)
-  `(let ((buf ,buffer))
-     (if (gnus-buffer-exists-p buf)
-	 (kill-buffer buf))))
-
-(defsubst gnus-point-at-bol ()
-  "Return point at the beginning of the line."
-  (let ((p (point)))
-    (beginning-of-line)
-    (prog1
-	(point)
-      (goto-char p))))
-
-(defsubst gnus-point-at-eol ()
-  "Return point at the end of the line."
-  (let ((p (point)))
-    (end-of-line)
-    (prog1
-	(point)
-      (goto-char p))))
-
-(defun gnus-alive-p ()
-  "Say whether Gnus is running or not."
-  (and gnus-group-buffer
-       (get-buffer gnus-group-buffer)))
-
-(defun gnus-delete-first (elt list)
-  "Delete by side effect the first occurrence of ELT as a member of LIST."
-  (if (equal (car list) elt)
-      (cdr list)
-    (let ((total list))
-      (while (and (cdr list)
-		  (not (equal (cadr list) elt)))
-	(setq list (cdr list)))
-      (when (cdr list)
-	(setcdr list (cddr list)))
-      total)))
-
-;; Delete the current line (and the next N lines.);
-(defmacro gnus-delete-line (&optional n)
-  `(delete-region (progn (beginning-of-line) (point))
-		  (progn (forward-line ,(or n 1)) (point))))
-
-;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
-(defvar gnus-init-inhibit nil)
-(defun gnus-read-init-file (&optional inhibit-next)
-  (if gnus-init-inhibit
-      (setq gnus-init-inhibit nil)
-    (setq gnus-init-inhibit inhibit-next)
-    (and gnus-init-file
-	 ;; Don't load .gnus if -q option was used.
-	 init-file-user
-	 (or (and (file-exists-p gnus-init-file)
-		  ;; Don't try to load a directory.
-		  (not (file-directory-p gnus-init-file)))
-	     (file-exists-p (concat gnus-init-file ".el"))
-	     (file-exists-p (concat gnus-init-file ".elc")))
-	 (condition-case var
-	     (load gnus-init-file nil t)
-	   (error
-	    (error "Error in %s: %s" gnus-init-file var))))))
-
-;; Info access macros.
-
-(defmacro gnus-info-group (info)
-  `(nth 0 ,info))
-(defmacro gnus-info-rank (info)
-  `(nth 1 ,info))
-(defmacro gnus-info-read (info)
-  `(nth 2 ,info))
-(defmacro gnus-info-marks (info)
-  `(nth 3 ,info))
-(defmacro gnus-info-method (info)
-  `(nth 4 ,info))
-(defmacro gnus-info-params (info)
-  `(nth 5 ,info))
-
-(defmacro gnus-info-level (info)
-  `(let ((rank (gnus-info-rank ,info)))
-     (if (consp rank)
-	 (car rank)
-       rank)))
-(defmacro gnus-info-score (info)
-  `(let ((rank (gnus-info-rank ,info)))
-     (or (and (consp rank) (cdr rank)) 0)))
-
-(defmacro gnus-info-set-group (info group)
-  `(setcar ,info ,group))
-(defmacro gnus-info-set-rank (info rank)
-  `(setcar (nthcdr 1 ,info) ,rank))
-(defmacro gnus-info-set-read (info read)
-  `(setcar (nthcdr 2 ,info) ,read))
-(defmacro gnus-info-set-marks (info marks)
-  `(setcar (nthcdr 3 ,info) ,marks))
-(defmacro gnus-info-set-method (info method)
-  `(setcar (nthcdr 4 ,info) ,method))
-(defmacro gnus-info-set-params (info params)
-  `(setcar (nthcdr 5 ,info) ,params))
-
-(defmacro gnus-info-set-level (info level)
-  `(let ((rank (cdr ,info)))
-     (if (consp (car rank))
-	 (setcar (car rank) ,level)
-       (setcar rank ,level))))
-(defmacro gnus-info-set-score (info score)
-  `(let ((rank (cdr ,info)))
-     (if (consp (car rank))
-	 (setcdr (car rank) ,score)
-       (setcar rank (cons (car rank) ,score)))))
-
-(defmacro gnus-get-info (group)
-  `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
-
-(defun gnus-byte-code (func)
-  "Return a form that can be `eval'ed based on FUNC."
-  (let ((fval (symbol-function func)))
-    (if (byte-code-function-p fval)
-	(let ((flist (append fval nil)))
-	  (setcar flist 'byte-code)
-	  flist)
-      (cons 'progn (cddr fval)))))
-
-;; Find out whether the gnus-visual TYPE is wanted.
-(defun gnus-visual-p (&optional type class)
-  (and gnus-visual			; Has to be non-nil, at least.
-       (if (not type)			; We don't care about type.
-	   gnus-visual
-	 (if (listp gnus-visual)	; It's a list, so we check it.
-	     (or (memq type gnus-visual)
-		 (memq class gnus-visual))
-	   t))))
-
-;;; Load the compatability functions.
-
-(require 'gnus-cus)
-(require 'gnus-ems)
-
-
-;;;
-;;; Shutdown
-;;;
-
-(defvar gnus-shutdown-alist nil)
-
-(defun gnus-add-shutdown (function &rest symbols)
-  "Run FUNCTION whenever one of SYMBOLS is shut down."
-  (push (cons function symbols) gnus-shutdown-alist))
-
-(defun gnus-shutdown (symbol)
-  "Shut down everything that waits for SYMBOL."
-  (let ((alist gnus-shutdown-alist)
-	entry)
-    (while (setq entry (pop alist))
-      (when (memq symbol (cdr entry))
-	(funcall (car entry))))))
-
-
-
-;; Format specs.  The chunks below are the machine-generated forms
-;; that are to be evaled as the result of the default format strings.
-;; We write them in here to get them byte-compiled.  That way the
-;; default actions will be quite fast, while still retaining the full
-;; flexibility of the user-defined format specs.
-
-;; First we have lots of dummy defvars to let the compiler know these
-;; are really dynamic variables.
-
-(defvar gnus-tmp-unread)
-(defvar gnus-tmp-replied)
-(defvar gnus-tmp-score-char)
-(defvar gnus-tmp-indentation)
-(defvar gnus-tmp-opening-bracket)
-(defvar gnus-tmp-lines)
-(defvar gnus-tmp-name)
-(defvar gnus-tmp-closing-bracket)
-(defvar gnus-tmp-subject-or-nil)
-(defvar gnus-tmp-subject)
-(defvar gnus-tmp-marked)
-(defvar gnus-tmp-marked-mark)
-(defvar gnus-tmp-subscribed)
-(defvar gnus-tmp-process-marked)
-(defvar gnus-tmp-number-of-unread)
-(defvar gnus-tmp-group-name)
-(defvar gnus-tmp-group)
-(defvar gnus-tmp-article-number)
-(defvar gnus-tmp-unread-and-unselected)
-(defvar gnus-tmp-news-method)
-(defvar gnus-tmp-news-server)
-(defvar gnus-tmp-article-number)
-(defvar gnus-mouse-face)
-(defvar gnus-mouse-face-prop)
-
-(defun gnus-summary-line-format-spec ()
-  (insert gnus-tmp-unread gnus-tmp-replied
-	  gnus-tmp-score-char gnus-tmp-indentation)
-  (gnus-put-text-property
-   (point)
-   (progn
-     (insert
-      gnus-tmp-opening-bracket
-      (format "%4d: %-20s"
-	      gnus-tmp-lines
-	      (if (> (length gnus-tmp-name) 20)
-		  (substring gnus-tmp-name 0 20)
-		gnus-tmp-name))
-      gnus-tmp-closing-bracket)
-     (point))
-   gnus-mouse-face-prop gnus-mouse-face)
-  (insert " " gnus-tmp-subject-or-nil "\n"))
-
-(defvar gnus-summary-line-format-spec
-  (gnus-byte-code 'gnus-summary-line-format-spec))
-
-(defun gnus-summary-dummy-line-format-spec ()
-  (insert "*  ")
-  (gnus-put-text-property
-   (point)
-   (progn
-     (insert ":				 :")
-     (point))
-   gnus-mouse-face-prop gnus-mouse-face)
-  (insert " " gnus-tmp-subject "\n"))
-
-(defvar gnus-summary-dummy-line-format-spec
-  (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
-
-(defun gnus-group-line-format-spec ()
-  (insert gnus-tmp-marked-mark gnus-tmp-subscribed
-	  gnus-tmp-process-marked
-	  gnus-group-indentation
-	  (format "%5s: " gnus-tmp-number-of-unread))
-  (gnus-put-text-property
-   (point)
-   (progn
-     (insert gnus-tmp-group "\n")
-     (1- (point)))
-   gnus-mouse-face-prop gnus-mouse-face))
-(defvar gnus-group-line-format-spec
-  (gnus-byte-code 'gnus-group-line-format-spec))
-
-(defvar gnus-format-specs
-  `((version . ,emacs-version)
-    (group ,gnus-group-line-format ,gnus-group-line-format-spec)
-    (summary-dummy ,gnus-summary-dummy-line-format
-		   ,gnus-summary-dummy-line-format-spec)
-    (summary ,gnus-summary-line-format ,gnus-summary-line-format-spec)))
-
-(defvar gnus-article-mode-line-format-spec nil)
-(defvar gnus-summary-mode-line-format-spec nil)
-(defvar gnus-group-mode-line-format-spec nil)
-
-;;; Phew.  All that gruft is over, fortunately.
-
-
-;;;
-;;; Gnus Utility Functions
-;;;
-
-(defun gnus-extract-address-components (from)
-  (let (name address)
-    ;; First find the address - the thing with the @ in it.  This may
-    ;; not be accurate in mail addresses, but does the trick most of
-    ;; the time in news messages.
-    (if (string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
-	(setq address (substring from (match-beginning 0) (match-end 0))))
-    ;; Then we check whether the "name <address>" format is used.
-    (and address
-	 ;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>
-	 ;; Linear white space is not required.
-	 (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
-	 (and (setq name (substring from 0 (match-beginning 0)))
-	      ;; Strip any quotes from the name.
-	      (string-match "\".*\"" name)
-	      (setq name (substring name 1 (1- (match-end 0))))))
-    ;; If not, then "address (name)" is used.
-    (or name
-	(and (string-match "(.+)" from)
-	     (setq name (substring from (1+ (match-beginning 0))
-				   (1- (match-end 0)))))
-	(and (string-match "()" from)
-	     (setq name address))
-	;; Fix by MORIOKA Tomohiko <morioka@jaist.ac.jp>.
-	;; XOVER might not support folded From headers.
-	(and (string-match "(.*" from)
-	     (setq name (substring from (1+ (match-beginning 0))
-				   (match-end 0)))))
-    ;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-    (list (or name from) (or address from))))
-
-(defun gnus-fetch-field (field)
-  "Return the value of the header FIELD of current article."
-  (save-excursion
-    (save-restriction
-      (let ((case-fold-search t)
-	    (inhibit-point-motion-hooks t))
-	(nnheader-narrow-to-headers)
-	(message-fetch-field field)))))
-
-(defun gnus-goto-colon ()
-  (beginning-of-line)
-  (search-forward ":" (gnus-point-at-eol) t))
-
-;;;###autoload
-(defun gnus-update-format (var)
-  "Update the format specification near point."
-  (interactive
-   (list
-    (save-excursion
-      (eval-defun nil)
-      ;; Find the end of the current word.
-      (re-search-forward "[ \t\n]" nil t)
-      ;; Search backward.
-      (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
-	(match-string 1)))))
-  (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
-			      (match-string 1 var))))
-	 (entry (assq type gnus-format-specs))
-	 value spec)
-    (when entry
-      (setq gnus-format-specs (delq entry gnus-format-specs)))
-    (set
-     (intern (format "%s-spec" var))
-     (gnus-parse-format (setq value (symbol-value (intern var)))
-			(symbol-value (intern (format "%s-alist" var)))
-			(not (string-match "mode" var))))
-    (setq spec (symbol-value (intern (format "%s-spec" var))))
-    (push (list type value spec) gnus-format-specs)
-
-    (pop-to-buffer "*Gnus Format*")
-    (erase-buffer)
-    (lisp-interaction-mode)
-    (insert (pp-to-string spec))))
-
-(defun gnus-update-format-specifications (&optional force)
-  "Update all (necessary) format specifications."
-  ;; Make the indentation array.
-  (gnus-make-thread-indent-array)
-
-  ;; See whether all the stored info needs to be flushed.
-  (when (or force
-	    (not (equal emacs-version
-			(cdr (assq 'version gnus-format-specs)))))
-    (setq gnus-format-specs nil))
-
-  ;; Go through all the formats and see whether they need updating.
-  (let ((types '(summary summary-dummy group
-			 summary-mode group-mode article-mode))
-	new-format entry type val)
-    (while (setq type (pop types))
-      ;; Jump to the proper buffer to find out the value of
-      ;; the variable, if possible.  (It may be buffer-local.)
-      (save-excursion
-	(let ((buffer (intern (format "gnus-%s-buffer" type)))
-	      val)
-	  (when (and (boundp buffer)
-		     (setq val (symbol-value buffer))
-		     (get-buffer val)
-		     (buffer-name (get-buffer val)))
-	    (set-buffer (get-buffer val)))
-	  (setq new-format (symbol-value
-			    (intern (format "gnus-%s-line-format" type))))))
-      (setq entry (cdr (assq type gnus-format-specs)))
-      (if (and entry
-	       (equal (car entry) new-format))
-	  ;; Use the old format.
-	  (set (intern (format "gnus-%s-line-format-spec" type))
-	       (cadr entry))
-	;; This is a new format.
-	(setq val
-	      (if (not (stringp new-format))
-		  ;; This is a function call or something.
-		  new-format
-		;; This is a "real" format.
-		(gnus-parse-format
-		 new-format
-		 (symbol-value
-		  (intern (format "gnus-%s-line-format-alist"
-				  (if (eq type 'article-mode)
-				      'summary-mode type))))
-		 (not (string-match "mode$" (symbol-name type))))))
-	;; Enter the new format spec into the list.
-	(if entry
-	    (progn
-	      (setcar (cdr entry) val)
-	      (setcar entry new-format))
-	  (push (list type new-format val) gnus-format-specs))
-	(set (intern (format "gnus-%s-line-format-spec" type)) val))))
-
-  (unless (assq 'version gnus-format-specs)
-    (push (cons 'version emacs-version) gnus-format-specs))
-
-  (gnus-update-group-mark-positions)
-  (gnus-update-summary-mark-positions))
-
-(defun gnus-update-summary-mark-positions ()
-  "Compute where the summary marks are to go."
-  (save-excursion
-    (when (and gnus-summary-buffer
-	       (get-buffer gnus-summary-buffer)
-	       (buffer-name (get-buffer gnus-summary-buffer)))
-      (set-buffer gnus-summary-buffer))
-    (let ((gnus-replied-mark 129)
-	  (gnus-score-below-mark 130)
-	  (gnus-score-over-mark 130)
-	  (thread nil)
-	  (gnus-visual nil)
-	  (spec gnus-summary-line-format-spec)
-	  pos)
-      (save-excursion
-	(gnus-set-work-buffer)
-	(let ((gnus-summary-line-format-spec spec))
-	  (gnus-summary-insert-line
-	   [0 "" "" "" "" "" 0 0 ""]  0 nil 128 t nil "" nil 1)
-	  (goto-char (point-min))
-	  (setq pos (list (cons 'unread (and (search-forward "\200" nil t)
-					     (- (point) 2)))))
-	  (goto-char (point-min))
-	  (push (cons 'replied (and (search-forward "\201" nil t) 
-				    (- (point) 2)))
-		pos)
-	  (goto-char (point-min))
-	  (push (cons 'score (and (search-forward "\202" nil t) (- (point) 2)))
-		pos)))
-      (setq gnus-summary-mark-positions pos))))
-
-(defun gnus-update-group-mark-positions ()
-  (save-excursion
-    (let ((gnus-process-mark 128)
-	  (gnus-group-marked '("dummy.group"))
-	  (gnus-active-hashtb (make-vector 10 0)))
-      (gnus-set-active "dummy.group" '(0 . 0))
-      (gnus-set-work-buffer)
-      (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
-      (goto-char (point-min))
-      (setq gnus-group-mark-positions
-	    (list (cons 'process (and (search-forward "\200" nil t)
-				      (- (point) 2))))))))
-
-(defvar gnus-mouse-face-0 'highlight)
-(defvar gnus-mouse-face-1 'highlight)
-(defvar gnus-mouse-face-2 'highlight)
-(defvar gnus-mouse-face-3 'highlight)
-(defvar gnus-mouse-face-4 'highlight)
-
-(defun gnus-mouse-face-function (form type)
-  `(gnus-put-text-property
-    (point) (progn ,@form (point))
-    gnus-mouse-face-prop
-    ,(if (equal type 0)
-	 'gnus-mouse-face
-       `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
-
-(defvar gnus-face-0 'bold)
-(defvar gnus-face-1 'italic)
-(defvar gnus-face-2 'bold-italic)
-(defvar gnus-face-3 'bold)
-(defvar gnus-face-4 'bold)
-
-(defun gnus-face-face-function (form type)
-  `(gnus-put-text-property
-    (point) (progn ,@form (point))
-    'face ',(symbol-value (intern (format "gnus-face-%d" type)))))
-
-(defun gnus-max-width-function (el max-width)
-  (or (numberp max-width) (signal 'wrong-type-argument '(numberp max-width)))
-  (if (symbolp el)
-      `(if (> (length ,el) ,max-width)
-	   (substring ,el 0 ,max-width)
-	 ,el)
-    `(let ((val (eval ,el)))
-       (if (numberp val)
-	   (setq val (int-to-string val)))
-       (if (> (length val) ,max-width)
-	   (substring val 0 ,max-width)
-	 val))))
-
-(defun gnus-parse-format (format spec-alist &optional insert)
-  ;; This function parses the FORMAT string with the help of the
-  ;; SPEC-ALIST and returns a list that can be eval'ed to return the
-  ;; string.  If the FORMAT string contains the specifiers %( and %)
-  ;; the text between them will have the mouse-face text property.
-  (if (string-match
-       "\\`\\(.*\\)%[0-9]?[{(]\\(.*\\)%[0-9]?[})]\\(.*\n?\\)\\'"
-       format)
-      (gnus-parse-complex-format format spec-alist)
-    ;; This is a simple format.
-    (gnus-parse-simple-format format spec-alist insert)))
-
-(defun gnus-parse-complex-format (format spec-alist)
-  (save-excursion
-    (gnus-set-work-buffer)
-    (insert format)
-    (goto-char (point-min))
-    (while (re-search-forward "\"" nil t)
-      (replace-match "\\\"" nil t))
-    (goto-char (point-min))
-    (insert "(\"")
-    (while (re-search-forward "%\\([0-9]+\\)?\\([{}()]\\)" nil t)
-      (let ((number (if (match-beginning 1)
-			(match-string 1) "0"))
-	    (delim (aref (match-string 2) 0)))
-	(if (or (= delim ?\() (= delim ?\{))
-	    (replace-match (concat "\"(" (if (= delim ?\() "mouse" "face")
-				   " " number " \""))
-	  (replace-match "\")\""))))
-    (goto-char (point-max))
-    (insert "\")")
-    (goto-char (point-min))
-    (let ((form (read (current-buffer))))
-      (cons 'progn (gnus-complex-form-to-spec form spec-alist)))))
-
-(defun gnus-complex-form-to-spec (form spec-alist)
-  (delq nil
-	(mapcar
-	 (lambda (sform)
-	   (if (stringp sform)
-	       (gnus-parse-simple-format sform spec-alist t)
-	     (funcall (intern (format "gnus-%s-face-function" (car sform)))
-		      (gnus-complex-form-to-spec (cddr sform) spec-alist)
-		      (nth 1 sform))))
-	 form)))
-
-(defun gnus-parse-simple-format (format spec-alist &optional insert)
-  ;; This function parses the FORMAT string with the help of the
-  ;; SPEC-ALIST and returns a list that can be eval'ed to return a
-  ;; string.
-  (let ((max-width 0)
-	spec flist fstring newspec elem beg result dontinsert)
-    (save-excursion
-      (gnus-set-work-buffer)
-      (insert format)
-      (goto-char (point-min))
-      (while (re-search-forward "%[-0-9]*\\(,[0-9]+\\)?\\([^0-9]\\)\\(.\\)?"
-				nil t)
-	(if (= (setq spec (string-to-char (match-string 2))) ?%)
-	      (setq newspec "%"
-		    beg (1+ (match-beginning 0)))
-	  ;; First check if there are any specs that look anything like
-	  ;; "%12,12A", ie. with a "max width specification".  These have
-	  ;; to be treated specially.
-	  (if (setq beg (match-beginning 1))
-	      (setq max-width
-		    (string-to-int
-		     (buffer-substring
-		      (1+ (match-beginning 1)) (match-end 1))))
-	    (setq max-width 0)
-	    (setq beg (match-beginning 2)))
-	  ;; Find the specification from `spec-alist'.
-	  (unless (setq elem (cdr (assq spec spec-alist)))
-	    (setq elem '("*" ?s)))
-	  ;; Treat user defined format specifiers specially.
-	  (when (eq (car elem) 'gnus-tmp-user-defined)
-	    (setq elem
-		  (list
-		   (list (intern (concat "gnus-user-format-function-"
-					 (match-string 3)))
-			 'gnus-tmp-header) ?s))
-	    (delete-region (match-beginning 3) (match-end 3)))
-	  (if (not (zerop max-width))
-	      (let ((el (car elem)))
-		(cond ((= (cadr elem) ?c)
-		       (setq el (list 'char-to-string el)))
-		      ((= (cadr elem) ?d)
-		       (setq el (list 'int-to-string el))))
-		(setq flist (cons (gnus-max-width-function el max-width)
-				  flist))
-		(setq newspec ?s))
-	    (progn
-	      (setq flist (cons (car elem) flist))
-	      (setq newspec (cadr elem)))))
-	;; Remove the old specification (and possibly a ",12" string).
-	(delete-region beg (match-end 2))
-	;; Insert the new specification.
-	(goto-char beg)
-	(insert newspec))
-      (setq fstring (buffer-substring 1 (point-max))))
-    ;; Do some postprocessing to increase efficiency.
-    (setq
-     result
-     (cond
-      ;; Emptyness.
-      ((string= fstring "")
-       nil)
-      ;; Not a format string.
-      ((not (string-match "%" fstring))
-       (list fstring))
-      ;; A format string with just a single string spec.
-      ((string= fstring "%s")
-       (list (car flist)))
-      ;; A single character.
-      ((string= fstring "%c")
-       (list (car flist)))
-      ;; A single number.
-      ((string= fstring "%d")
-       (setq dontinsert)
-       (if insert
-	   (list `(princ ,(car flist)))
-	 (list `(int-to-string ,(car flist)))))
-      ;; Just lots of chars and strings.
-      ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
-       (nreverse flist))
-      ;; A single string spec at the beginning of the spec.
-      ((string-match "\\`%[sc][^%]+\\'" fstring)
-       (list (car flist) (substring fstring 2)))
-      ;; A single string spec in the middle of the spec.
-      ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
-       (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
-      ;; A single string spec in the end of the spec.
-      ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
-       (list (match-string 1 fstring) (car flist)))
-      ;; A more complex spec.
-      (t
-       (list (cons 'format (cons fstring (nreverse flist)))))))
-
-    (if insert
-	(when result
-	  (if dontinsert
-	      result
-	    (cons 'insert result)))
-      (cond ((stringp result)
-	     result)
-	    ((consp result)
-	     (cons 'concat result))
-	    (t "")))))
-
-(defun gnus-eval-format (format &optional alist props)
-  "Eval the format variable FORMAT, using ALIST.
-If PROPS, insert the result."
-  (let ((form (gnus-parse-format format alist props)))
-    (if props
-	(gnus-add-text-properties (point) (progn (eval form) (point)) props)
-      (eval form))))
-
-(defun gnus-remove-text-with-property (prop)
-  "Delete all text in the current buffer with text property PROP."
-  (save-excursion
-    (goto-char (point-min))
-    (while (not (eobp))
-      (while (get-text-property (point) prop)
-	(delete-char 1))
-      (goto-char (next-single-property-change (point) prop nil (point-max))))))
-
-(defun gnus-set-work-buffer ()
-  (if (get-buffer gnus-work-buffer)
-      (progn
-	(set-buffer gnus-work-buffer)
-	(erase-buffer))
-    (set-buffer (get-buffer-create gnus-work-buffer))
-    (kill-all-local-variables)
-    (buffer-disable-undo (current-buffer))
-    (gnus-add-current-to-buffer-list)))
-
-;; Article file names when saving.
-
-(defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
-  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is nil, it is ~/News/News.group/num.
-Otherwise, it is like ~/News/news/group/num."
-  (let ((default
-	  (expand-file-name
-	   (concat (if (gnus-use-long-file-name 'not-save)
-		       (gnus-capitalize-newsgroup newsgroup)
-		     (gnus-newsgroup-directory-form newsgroup))
-		   "/" (int-to-string (mail-header-number headers)))
-	   gnus-article-save-directory)))
-    (if (and last-file
-	     (string-equal (file-name-directory default)
-			   (file-name-directory last-file))
-	     (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
-	default
-      (or last-file default))))
-
-(defun gnus-numeric-save-name (newsgroup headers &optional last-file)
-  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is non-nil, it is
-~/News/news.group/num.	Otherwise, it is like ~/News/news/group/num."
-  (let ((default
-	  (expand-file-name
-	   (concat (if (gnus-use-long-file-name 'not-save)
-		       newsgroup
-		     (gnus-newsgroup-directory-form newsgroup))
-		   "/" (int-to-string (mail-header-number headers)))
-	   gnus-article-save-directory)))
-    (if (and last-file
-	     (string-equal (file-name-directory default)
-			   (file-name-directory last-file))
-	     (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
-	default
-      (or last-file default))))
-
-(defun gnus-Plain-save-name (newsgroup headers &optional last-file)
-  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is non-nil, it is
-~/News/News.group.  Otherwise, it is like ~/News/news/group/news."
-  (or last-file
-      (expand-file-name
-       (if (gnus-use-long-file-name 'not-save)
-	   (gnus-capitalize-newsgroup newsgroup)
-	 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
-       gnus-article-save-directory)))
-
-(defun gnus-plain-save-name (newsgroup headers &optional last-file)
-  "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is non-nil, it is
-~/News/news.group.  Otherwise, it is like ~/News/news/group/news."
-  (or last-file
-      (expand-file-name
-       (if (gnus-use-long-file-name 'not-save)
-	   newsgroup
-	 (concat (gnus-newsgroup-directory-form newsgroup) "/news"))
-       gnus-article-save-directory)))
-
-;; For subscribing new newsgroup
-
-(defun gnus-subscribe-hierarchical-interactive (groups)
-  (let ((groups (sort groups 'string<))
-	prefixes prefix start ans group starts)
-    (while groups
-      (setq prefixes (list "^"))
-      (while (and groups prefixes)
-	(while (not (string-match (car prefixes) (car groups)))
-	  (setq prefixes (cdr prefixes)))
-	(setq prefix (car prefixes))
-	(setq start (1- (length prefix)))
-	(if (and (string-match "[^\\.]\\." (car groups) start)
-		 (cdr groups)
-		 (setq prefix
-		       (concat "^" (substring (car groups) 0 (match-end 0))))
-		 (string-match prefix (cadr groups)))
-	    (progn
-	      (setq prefixes (cons prefix prefixes))
-	      (message "Descend hierarchy %s? ([y]nsq): "
-		       (substring prefix 1 (1- (length prefix))))
-	      (while (not (memq (setq ans (read-char)) '(?y ?\n ?n ?s ?q)))
-		(ding)
-		(message "Descend hierarchy %s? ([y]nsq): "
-			 (substring prefix 1 (1- (length prefix)))))
-	      (cond ((= ans ?n)
-		     (while (and groups
-				 (string-match prefix
-					       (setq group (car groups))))
-		       (setq gnus-killed-list
-			     (cons group gnus-killed-list))
-		       (gnus-sethash group group gnus-killed-hashtb)
-		       (setq groups (cdr groups)))
-		     (setq starts (cdr starts)))
-		    ((= ans ?s)
-		     (while (and groups
-				 (string-match prefix
-					       (setq group (car groups))))
-		       (gnus-sethash group group gnus-killed-hashtb)
-		       (gnus-subscribe-alphabetically (car groups))
-		       (setq groups (cdr groups)))
-		     (setq starts (cdr starts)))
-		    ((= ans ?q)
-		     (while groups
-		       (setq group (car groups))
-		       (setq gnus-killed-list (cons group gnus-killed-list))
-		       (gnus-sethash group group gnus-killed-hashtb)
-		       (setq groups (cdr groups))))
-		    (t nil)))
-	  (message "Subscribe %s? ([n]yq)" (car groups))
-	  (while (not (memq (setq ans (read-char)) '(?y ?\n ?q ?n)))
-	    (ding)
-	    (message "Subscribe %s? ([n]yq)" (car groups)))
-	  (setq group (car groups))
-	  (cond ((= ans ?y)
-		 (gnus-subscribe-alphabetically (car groups))
-		 (gnus-sethash group group gnus-killed-hashtb))
-		((= ans ?q)
-		 (while groups
-		   (setq group (car groups))
-		   (setq gnus-killed-list (cons group gnus-killed-list))
-		   (gnus-sethash group group gnus-killed-hashtb)
-		   (setq groups (cdr groups))))
-		(t
-		 (setq gnus-killed-list (cons group gnus-killed-list))
-		 (gnus-sethash group group gnus-killed-hashtb)))
-	  (setq groups (cdr groups)))))))
-
-(defun gnus-subscribe-randomly (newsgroup)
-  "Subscribe new NEWSGROUP by making it the first newsgroup."
-  (gnus-subscribe-newsgroup newsgroup))
-
-(defun gnus-subscribe-alphabetically (newgroup)
-  "Subscribe new NEWSGROUP and insert it in alphabetical order."
-  (let ((groups (cdr gnus-newsrc-alist))
-	before)
-    (while (and (not before) groups)
-      (if (string< newgroup (caar groups))
-	  (setq before (caar groups))
-	(setq groups (cdr groups))))
-    (gnus-subscribe-newsgroup newgroup before)))
-
-(defun gnus-subscribe-hierarchically (newgroup)
-  "Subscribe new NEWSGROUP and insert it in hierarchical newsgroup order."
-  ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
-  (save-excursion
-    (set-buffer (find-file-noselect gnus-current-startup-file))
-    (let ((groupkey newgroup)
-	  before)
-      (while (and (not before) groupkey)
-	(goto-char (point-min))
-	(let ((groupkey-re
-	       (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
-	  (while (and (re-search-forward groupkey-re nil t)
-		      (progn
-			(setq before (match-string 1))
-			(string< before newgroup)))))
-	;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
-	(setq groupkey
-	      (if (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
-		  (substring groupkey (match-beginning 1) (match-end 1)))))
-      (gnus-subscribe-newsgroup newgroup before))
-    (kill-buffer (current-buffer))))
-
-(defun gnus-subscribe-interactively (group)
-  "Subscribe the new GROUP interactively.
-It is inserted in hierarchical newsgroup order if subscribed.  If not,
-it is killed."
-  (if (gnus-y-or-n-p (format "Subscribe new newsgroup: %s " group))
-      (gnus-subscribe-hierarchically group)
-    (push group gnus-killed-list)))
-
-(defun gnus-subscribe-zombies (group)
-  "Make the new GROUP into a zombie group."
-  (push group gnus-zombie-list))
-
-(defun gnus-subscribe-killed (group)
-  "Make the new GROUP a killed group."
-  (push group gnus-killed-list))
-
-(defun gnus-subscribe-newsgroup (newsgroup &optional next)
-  "Subscribe new NEWSGROUP.
-If NEXT is non-nil, it is inserted before NEXT.	 Otherwise it is made
-the first newsgroup."
-  ;; We subscribe the group by changing its level to `subscribed'.
-  (gnus-group-change-level
-   newsgroup gnus-level-default-subscribed
-   gnus-level-killed (gnus-gethash (or next "dummy.group") gnus-newsrc-hashtb))
-  (gnus-message 5 "Subscribe newsgroup: %s" newsgroup))
-
-;; For directories
-
-(defun gnus-newsgroup-directory-form (newsgroup)
-  "Make hierarchical directory name from NEWSGROUP name."
-  (let ((newsgroup (gnus-newsgroup-savable-name newsgroup))
-	(len (length newsgroup))
-	idx)
-    ;; If this is a foreign group, we don't want to translate the
-    ;; entire name.
-    (if (setq idx (string-match ":" newsgroup))
-	(aset newsgroup idx ?/)
-      (setq idx 0))
-    ;; Replace all occurrences of `.' with `/'.
-    (while (< idx len)
-      (if (= (aref newsgroup idx) ?.)
-	  (aset newsgroup idx ?/))
-      (setq idx (1+ idx)))
-    newsgroup))
-
-(defun gnus-newsgroup-savable-name (group)
-  ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
-  ;; with dots.
-  (nnheader-replace-chars-in-string group ?/ ?.))
-
-(defun gnus-make-directory (dir)
-  "Make DIRECTORY recursively."
-  ;; Why don't we use `(make-directory dir 'parents)'?  That's just one
-  ;; of the many mysteries of the universe.
-  (let* ((dir (expand-file-name dir default-directory))
-	 dirs err)
-    (if (string-match "/$" dir)
-	(setq dir (substring dir 0 (match-beginning 0))))
-    ;; First go down the path until we find a directory that exists.
-    (while (not (file-exists-p dir))
-      (setq dirs (cons dir dirs))
-      (string-match "/[^/]+$" dir)
-      (setq dir (substring dir 0 (match-beginning 0))))
-    ;; Then create all the subdirs.
-    (while (and dirs (not err))
-      (condition-case ()
-	  (make-directory (car dirs))
-	(error (setq err t)))
-      (setq dirs (cdr dirs)))
-    ;; We return whether we were successful or not.
-    (not dirs)))
-
-(defun gnus-capitalize-newsgroup (newsgroup)
-  "Capitalize NEWSGROUP name."
-  (and (not (zerop (length newsgroup)))
-       (concat (char-to-string (upcase (aref newsgroup 0)))
-	       (substring newsgroup 1))))
-
-;; Various... things.
-
-(defun gnus-simplify-subject (subject &optional re-only)
-  "Remove `Re:' and words in parentheses.
-If RE-ONLY is non-nil, strip leading `Re:'s only."
-  (let ((case-fold-search t))		;Ignore case.
-    ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
-    (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
-      (setq subject (substring subject (match-end 0))))
-    ;; Remove uninteresting prefixes.
-    (if (and (not re-only)
-	     gnus-simplify-ignored-prefixes
-	     (string-match gnus-simplify-ignored-prefixes subject))
-	(setq subject (substring subject (match-end 0))))
-    ;; Remove words in parentheses from end.
-    (unless re-only
-      (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
-	(setq subject (substring subject 0 (match-beginning 0)))))
-    ;; Return subject string.
-    subject))
-
-;; Remove any leading "re:"s, any trailing paren phrases, and simplify
-;; all whitespace.
-;; Written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
-(defun gnus-simplify-buffer-fuzzy ()
-  (let ((case-fold-search t))
-    (goto-char (point-min))
-    (while (search-forward "\t" nil t)
-      (replace-match " " t t))
-    (goto-char (point-min))
-    (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *" nil t)
-    (goto-char (match-beginning 0))
-    (while (or
-	    (looking-at "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
-	    (looking-at "^[[].*: .*[]]$"))
-      (goto-char (point-min))
-      (while (re-search-forward "^ *\\(re\\|fwd\\)[[{(^0-9]*[])}]?[:;] *"
-				nil t)
-	(replace-match "" t t))
-      (goto-char (point-min))
-      (while (re-search-forward "^[[].*: .*[]]$" nil t)
-	(goto-char (match-end 0))
-	(delete-char -1)
-	(delete-region
-	 (progn (goto-char (match-beginning 0)))
-	 (re-search-forward ":"))))
-    (goto-char (point-min))
-    (while (re-search-forward " *[[{(][^()\n]*[]})] *$" nil t)
-      (replace-match "" t t))
-    (goto-char (point-min))
-    (while (re-search-forward "  +" nil t)
-      (replace-match " " t t))
-    (goto-char (point-min))
-    (while (re-search-forward " $" nil t)
-      (replace-match "" t t))
-    (goto-char (point-min))
-    (while (re-search-forward "^ +" nil t)
-      (replace-match "" t t))
-    (goto-char (point-min))
-    (when gnus-simplify-subject-fuzzy-regexp
-      (if (listp gnus-simplify-subject-fuzzy-regexp)
-	  (let ((list gnus-simplify-subject-fuzzy-regexp))
-	    (while list
-	      (goto-char (point-min))
-	      (while (re-search-forward (car list) nil t)
-		(replace-match "" t t))
-	      (setq list (cdr list))))
-	(while (re-search-forward gnus-simplify-subject-fuzzy-regexp nil t)
-	  (replace-match "" t t))))))
-
-(defun gnus-simplify-subject-fuzzy (subject)
-  "Siplify a subject string fuzzily."
-  (save-excursion
-    (gnus-set-work-buffer)
-    (let ((case-fold-search t))
-      (insert subject)
-      (inline (gnus-simplify-buffer-fuzzy))
-      (buffer-string))))
-
-;; Add the current buffer to the list of buffers to be killed on exit.
-(defun gnus-add-current-to-buffer-list ()
-  (or (memq (current-buffer) gnus-buffer-list)
-      (setq gnus-buffer-list (cons (current-buffer) gnus-buffer-list))))
-
-(defun gnus-string> (s1 s2)
-  (not (or (string< s1 s2)
-	   (string= s1 s2))))
-
-(defun gnus-read-active-file-p ()
-  "Say whether the active file has been read from `gnus-select-method'."
-  (memq gnus-select-method gnus-have-read-active-file))
-
-;;; General various misc type functions.
-
-(defun gnus-clear-system ()
-  "Clear all variables and buffers."
-  ;; Clear Gnus variables.
-  (let ((variables gnus-variable-list))
-    (while variables
-      (set (car variables) nil)
-      (setq variables (cdr variables))))
-  ;; Clear other internal variables.
-  (setq gnus-list-of-killed-groups nil
-	gnus-have-read-active-file nil
-	gnus-newsrc-alist nil
-	gnus-newsrc-hashtb nil
-	gnus-killed-list nil
-	gnus-zombie-list nil
-	gnus-killed-hashtb nil
-	gnus-active-hashtb nil
-	gnus-moderated-list nil
-	gnus-description-hashtb nil
-	gnus-current-headers nil
-	gnus-thread-indent-array nil
-	gnus-newsgroup-headers nil
-	gnus-newsgroup-name nil
-	gnus-server-alist nil
-	gnus-group-list-mode nil
-	gnus-opened-servers nil
-	gnus-group-mark-positions nil
-	gnus-newsgroup-data nil
-	gnus-newsgroup-unreads nil
-	nnoo-state-alist nil
-	gnus-current-select-method nil)
-  (gnus-shutdown 'gnus)
-  ;; Kill the startup file.
-  (and gnus-current-startup-file
-       (get-file-buffer gnus-current-startup-file)
-       (kill-buffer (get-file-buffer gnus-current-startup-file)))
-  ;; Clear the dribble buffer.
-  (gnus-dribble-clear)
-  ;; Kill global KILL file buffer.
-  (when (get-file-buffer (gnus-newsgroup-kill-file nil))
-    (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
-  (gnus-kill-buffer nntp-server-buffer)
-  ;; Kill Gnus buffers.
-  (while gnus-buffer-list
-    (gnus-kill-buffer (pop gnus-buffer-list)))
-  ;; Remove Gnus frames.
-  (gnus-kill-gnus-frames))
-
-(defun gnus-kill-gnus-frames ()
-  "Kill all frames Gnus has created."
-  (while gnus-created-frames
-    (when (frame-live-p (car gnus-created-frames))
-      ;; We slap a condition-case around this `delete-frame' to ensure 
-      ;; against errors if we try do delete the single frame that's left.
-      (condition-case ()
-	  (delete-frame (car gnus-created-frames))
-	(error nil)))
-    (pop gnus-created-frames)))
-
-(defun gnus-windows-old-to-new (setting)
-  ;; First we take care of the really, really old Gnus 3 actions.
-  (when (symbolp setting)
-    (setq setting
-	  ;; Take care of ooold GNUS 3.x values.
-	  (cond ((eq setting 'SelectArticle) 'article)
-		((memq setting '(SelectSubject ExpandSubject)) 'summary)
-		((memq setting '(SelectNewsgroup ExitNewsgroup)) 'group)
-		(t setting))))
-  (if (or (listp setting)
-	  (not (and gnus-window-configuration
-		    (memq setting '(group summary article)))))
-      setting
-    (let* ((setting (if (eq setting 'group)
-			(if (assq 'newsgroup gnus-window-configuration)
-			    'newsgroup
-			  'newsgroups) setting))
-	   (elem (cadr (assq setting gnus-window-configuration)))
-	   (total (apply '+ elem))
-	   (types '(group summary article))
-	   (pbuf (if (eq setting 'newsgroups) 'group 'summary))
-	   (i 0)
-	   perc
-	   out)
-      (while (< i 3)
-	(or (not (numberp (nth i elem)))
-	    (zerop (nth i elem))
-	    (progn
-	      (setq perc (if (= i 2)
-			     1.0
-			   (/ (float (nth 0 elem)) total)))
-	      (setq out (cons (if (eq pbuf (nth i types))
-				  (list (nth i types) perc 'point)
-				(list (nth i types) perc))
-			      out))))
-	(setq i (1+ i)))
-      `(vertical 1.0 ,@(nreverse out)))))
-
-;;;###autoload
-(defun gnus-add-configuration (conf)
-  "Add the window configuration CONF to `gnus-buffer-configuration'."
-  (setq gnus-buffer-configuration
-	(cons conf (delq (assq (car conf) gnus-buffer-configuration)
-			 gnus-buffer-configuration))))
-
-(defvar gnus-frame-list nil)
-
-(defun gnus-configure-frame (split &optional window)
-  "Split WINDOW according to SPLIT."
-  (unless window
-    (setq window (get-buffer-window (current-buffer))))
-  (select-window window)
-  ;; This might be an old-stylee buffer config.
-  (when (vectorp split)
-    (setq split (append split nil)))
-  (when (or (consp (car split))
-	    (vectorp (car split)))
-    (push 1.0 split)
-    (push 'vertical split))
-  ;; The SPLIT might be something that is to be evaled to
-  ;; return a new SPLIT.
-  (while (and (not (assq (car split) gnus-window-to-buffer))
-	      (gnus-functionp (car split)))
-    (setq split (eval split)))
-  (let* ((type (car split))
-	 (subs (cddr split))
-	 (len (if (eq type 'horizontal) (window-width) (window-height)))
-	 (total 0)
-	 (window-min-width (or gnus-window-min-width window-min-width))
-	 (window-min-height (or gnus-window-min-height window-min-height))
-	 s result new-win rest comp-subs size sub)
-    (cond
-     ;; Nothing to do here.
-     ((null split))
-     ;; Don't switch buffers.
-     ((null type)
-      (and (memq 'point split) window))
-     ;; This is a buffer to be selected.
-     ((not (memq type '(frame horizontal vertical)))
-      (let ((buffer (cond ((stringp type) type)
-			  (t (cdr (assq type gnus-window-to-buffer)))))
-	    buf)
-	(unless buffer
-	  (error "Illegal buffer type: %s" type))
-	(unless (setq buf (get-buffer (if (symbolp buffer)
-					  (symbol-value buffer) buffer)))
-	  (setq buf (get-buffer-create (if (symbolp buffer)
-					   (symbol-value buffer) buffer))))
-	(switch-to-buffer buf)
-	;; We return the window if it has the `point' spec.
-	(and (memq 'point split) window)))
-     ;; This is a frame split.
-     ((eq type 'frame)
-      (unless gnus-frame-list
-	(setq gnus-frame-list (list (window-frame
-				     (get-buffer-window (current-buffer))))))
-      (let ((i 0)
-	    params frame fresult)
-	(while (< i (length subs))
-	  ;; Frame parameter is gotten from the sub-split.
-	  (setq params (cadr (elt subs i)))
-	  ;; It should be a list.
-	  (unless (listp params)
-	    (setq params nil))
-	  ;; Create a new frame?
-	  (unless (setq frame (elt gnus-frame-list i))
-	    (nconc gnus-frame-list (list (setq frame (make-frame params))))
-	    (push frame gnus-created-frames))
-	  ;; Is the old frame still alive?
-	  (unless (frame-live-p frame)
-	    (setcar (nthcdr i gnus-frame-list)
-		    (setq frame (make-frame params))))
-	  ;; Select the frame in question and do more splits there.
-	  (select-frame frame)
-	  (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
-	  (incf i))
-	;; Select the frame that has the selected buffer.
-	(when fresult
-	  (select-frame (window-frame fresult)))))
-     ;; This is a normal split.
-     (t
-      (when (> (length subs) 0)
-	;; First we have to compute the sizes of all new windows.
-	(while subs
-	  (setq sub (append (pop subs) nil))
-	  (while (and (not (assq (car sub) gnus-window-to-buffer))
-		      (gnus-functionp (car sub)))
-	    (setq sub (eval sub)))
-	  (when sub
-	    (push sub comp-subs)
-	    (setq size (cadar comp-subs))
-	    (cond ((equal size 1.0)
-		   (setq rest (car comp-subs))
-		   (setq s 0))
-		  ((floatp size)
-		   (setq s (floor (* size len))))
-		  ((integerp size)
-		   (setq s size))
-		  (t
-		   (error "Illegal size: %s" size)))
-	    ;; Try to make sure that we are inside the safe limits.
-	    (cond ((zerop s))
-		  ((eq type 'horizontal)
-		   (setq s (max s window-min-width)))
-		  ((eq type 'vertical)
-		   (setq s (max s window-min-height))))
-	    (setcar (cdar comp-subs) s)
-	    (incf total s)))
-	;; Take care of the "1.0" spec.
-	(if rest
-	    (setcar (cdr rest) (- len total))
-	  (error "No 1.0 specs in %s" split))
-	;; The we do the actual splitting in a nice recursive
-	;; fashion.
-	(setq comp-subs (nreverse comp-subs))
-	(while comp-subs
-	  (if (null (cdr comp-subs))
-	      (setq new-win window)
-	    (setq new-win
-		  (split-window window (cadar comp-subs)
-				(eq type 'horizontal))))
-	  (setq result (or (gnus-configure-frame
-			    (car comp-subs) window) result))
-	  (select-window new-win)
-	  (setq window new-win)
-	  (setq comp-subs (cdr comp-subs))))
-      ;; Return the proper window, if any.
-      (when result
-	(select-window result))))))
-
-(defvar gnus-frame-split-p nil)
-
-(defun gnus-configure-windows (setting &optional force)
-  (setq setting (gnus-windows-old-to-new setting))
-  (let ((split (if (symbolp setting)
-		   (cadr (assq setting gnus-buffer-configuration))
-		 setting))
-	all-visible)
-
-    (setq gnus-frame-split-p nil)
-
-    (unless split
-      (error "No such setting: %s" setting))
-
-    (if (and (setq all-visible (gnus-all-windows-visible-p split))
-	     (not force))
-	;; All the windows mentioned are already visible, so we just
-	;; put point in the assigned buffer, and do not touch the
-	;; winconf.
-	(select-window all-visible)
-
-      ;; Either remove all windows or just remove all Gnus windows.
-      (let ((frame (selected-frame)))
-	(unwind-protect
-	    (if gnus-use-full-window
-		;; We want to remove all other windows.
-		(if (not gnus-frame-split-p)
-		    ;; This is not a `frame' split, so we ignore the
-		    ;; other frames.  
-		    (delete-other-windows)
-		  ;; This is a `frame' split, so we delete all windows
-		  ;; on all frames.
-		  (mapcar 
-		   (lambda (frame)
-		     (unless (eq (cdr (assq 'minibuffer
-					    (frame-parameters frame)))
-				 'only)
-		       (select-frame frame)
-		       (delete-other-windows)))
-		   (frame-list)))
-	      ;; Just remove some windows.
-	      (gnus-remove-some-windows)
-	      (switch-to-buffer nntp-server-buffer))
-	  (select-frame frame)))
-
-      (switch-to-buffer nntp-server-buffer)
-      (gnus-configure-frame split (get-buffer-window (current-buffer))))))
-
-(defun gnus-all-windows-visible-p (split)
-  "Say whether all buffers in SPLIT are currently visible.
-In particular, the value returned will be the window that
-should have point."
-  (let ((stack (list split))
-	(all-visible t)
-	type buffer win buf)
-    (while (and (setq split (pop stack))
-		all-visible)
-      ;; Be backwards compatible.
-      (when (vectorp split)
-	(setq split (append split nil)))
-      (when (or (consp (car split))
-		(vectorp (car split)))
-	(push 1.0 split)
-	(push 'vertical split))
-      ;; The SPLIT might be something that is to be evaled to
-      ;; return a new SPLIT.
-      (while (and (not (assq (car split) gnus-window-to-buffer))
-		  (gnus-functionp (car split)))
-	(setq split (eval split)))
-
-      (setq type (elt split 0))
-      (cond
-       ;; Nothing here.
-       ((null split) t)
-       ;; A buffer.
-       ((not (memq type '(horizontal vertical frame)))
-	(setq buffer (cond ((stringp type) type)
-			   (t (cdr (assq type gnus-window-to-buffer)))))
-	(unless buffer
-	  (error "Illegal buffer type: %s" type))
-	(when (setq buf (get-buffer (if (symbolp buffer)
-					(symbol-value buffer)
-				      buffer)))
-	  (setq win (get-buffer-window buf t)))
-	(if win
-	    (when (memq 'point split)
-		(setq all-visible win))
-	  (setq all-visible nil)))
-       (t
-	(when (eq type 'frame)
-	  (setq gnus-frame-split-p t))
-	(setq stack (append (cddr split) stack)))))
-    (unless (eq all-visible t)
-      all-visible)))
-
-(defun gnus-window-top-edge (&optional window)
-  (nth 1 (window-edges window)))
-
-(defun gnus-remove-some-windows ()
-  (let ((buffers gnus-window-to-buffer)
-	buf bufs lowest-buf lowest)
-    (save-excursion
-      ;; Remove windows on all known Gnus buffers.
-      (while buffers
-	(setq buf (cdar buffers))
-	(if (symbolp buf)
-	    (setq buf (and (boundp buf) (symbol-value buf))))
-	(and buf
-	     (get-buffer-window buf)
-	     (progn
-	       (setq bufs (cons buf bufs))
-	       (pop-to-buffer buf)
-	       (if (or (not lowest)
-		       (< (gnus-window-top-edge) lowest))
-		   (progn
-		     (setq lowest (gnus-window-top-edge))
-		     (setq lowest-buf buf)))))
-	(setq buffers (cdr buffers)))
-      ;; Remove windows on *all* summary buffers.
-      (walk-windows
-       (lambda (win)
-	 (let ((buf (window-buffer win)))
-	   (if (string-match	"^\\*Summary" (buffer-name buf))
-	       (progn
-		 (setq bufs (cons buf bufs))
-		 (pop-to-buffer buf)
-		 (if (or (not lowest)
-			 (< (gnus-window-top-edge) lowest))
-		     (progn
-		       (setq lowest-buf buf)
-		       (setq lowest (gnus-window-top-edge)))))))))
-      (and lowest-buf
-	   (progn
-	     (pop-to-buffer lowest-buf)
-	     (switch-to-buffer nntp-server-buffer)))
-      (while bufs
-	(and (not (eq (car bufs) lowest-buf))
-	     (delete-windows-on (car bufs)))
-	(setq bufs (cdr bufs))))))
-
-(defun gnus-version (&optional arg)
-  "Version number of this version of Gnus.
-If ARG, insert string at point."
-  (interactive "P")
-  (let ((methods gnus-valid-select-methods)
-	(mess gnus-version)
-	meth)
-    ;; Go through all the legal select methods and add their version
-    ;; numbers to the total version string.  Only the backends that are
-    ;; currently in use will have their message numbers taken into
-    ;; consideration.
-    (while methods
-      (setq meth (intern (concat (caar methods) "-version")))
-      (and (boundp meth)
-	   (stringp (symbol-value meth))
-	   (setq mess (concat mess "; " (symbol-value meth))))
-      (setq methods (cdr methods)))
-    (if arg
-	(insert (message mess))
-      (message mess))))
-
-(defun gnus-info-find-node ()
-  "Find Info documentation of Gnus."
-  (interactive)
-  ;; Enlarge info window if needed.
-  (let ((mode major-mode)
-	gnus-info-buffer)
-    (Info-goto-node (cadr (assq mode gnus-info-nodes)))
-    (setq gnus-info-buffer (current-buffer))
-    (gnus-configure-windows 'info)))
-
-(defun gnus-days-between (date1 date2)
-  ;; Return the number of days between date1 and date2.
-  (- (gnus-day-number date1) (gnus-day-number date2)))
-
-(defun gnus-day-number (date)
-  (let ((dat (mapcar (lambda (s) (and s (string-to-int s)) )
-		     (timezone-parse-date date))))
-    (timezone-absolute-from-gregorian
-     (nth 1 dat) (nth 2 dat) (car dat))))
-
-(defun gnus-encode-date (date)
-  "Convert DATE to internal time."
-  (let* ((parse (timezone-parse-date date))
-	 (date (mapcar (lambda (d) (and d (string-to-int d))) parse))
-	 (time (mapcar 'string-to-int (timezone-parse-time (aref parse 3)))))
-    (encode-time (caddr time) (cadr time) (car time)
-		 (caddr date) (cadr date) (car date) (nth 4 date))))
-
-(defun gnus-time-minus (t1 t2)
-  "Subtract two internal times."
-  (let ((borrow (< (cadr t1) (cadr t2))))
-    (list (- (car t1) (car t2) (if borrow 1 0))
-	  (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
-(defun gnus-file-newer-than (file date)
-  (let ((fdate (nth 5 (file-attributes file))))
-    (or (> (car fdate) (car date))
-	(and (= (car fdate) (car date))
-	     (> (nth 1 fdate) (nth 1 date))))))
-
-(defmacro gnus-local-set-keys (&rest plist)
-  "Set the keys in PLIST in the current keymap."
-  `(gnus-define-keys-1 (current-local-map) ',plist))
-
-(defmacro gnus-define-keys (keymap &rest plist)
-  "Define all keys in PLIST in KEYMAP."
-  `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
-
-(put 'gnus-define-keys 'lisp-indent-function 1)
-(put 'gnus-define-keys 'lisp-indent-hook 1)
-(put 'gnus-define-keymap 'lisp-indent-function 1)
-(put 'gnus-define-keymap 'lisp-indent-hook 1)
-
-(defmacro gnus-define-keymap (keymap &rest plist)
-  "Define all keys in PLIST in KEYMAP."
-  `(gnus-define-keys-1 ,keymap (quote ,plist)))
-
-(defun gnus-define-keys-1 (keymap plist)
-  (when (null keymap)
-    (error "Can't set keys in a null keymap"))
-  (cond ((symbolp keymap)
-	 (setq keymap (symbol-value keymap)))
-	((keymapp keymap))
-	((listp keymap)
-	 (set (car keymap) nil)
-	 (define-prefix-command (car keymap))
-	 (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
-	 (setq keymap (symbol-value (car keymap)))))
-  (let (key)
-    (while plist
-      (when (symbolp (setq key (pop plist)))
-	(setq key (symbol-value key)))
-      (define-key keymap key (pop plist)))))
-
-(defun gnus-group-read-only-p (&optional group)
-  "Check whether GROUP supports editing or not.
-If GROUP is nil, `gnus-newsgroup-name' will be checked instead.	 Note
-that that variable is buffer-local to the summary buffers."
-  (let ((group (or group gnus-newsgroup-name)))
-    (not (gnus-check-backend-function 'request-replace-article group))))
-
-(defun gnus-group-total-expirable-p (group)
-  "Check whether GROUP is total-expirable or not."
-  (let ((params (gnus-info-params (gnus-get-info group))))
-    (or (memq 'total-expire params)
-	(cdr (assq 'total-expire params)) ; (total-expire . t)
-	(and gnus-total-expirable-newsgroups ; Check var.
-	     (string-match gnus-total-expirable-newsgroups group)))))
-
-(defun gnus-group-auto-expirable-p (group)
-  "Check whether GROUP is total-expirable or not."
-  (let ((params (gnus-info-params (gnus-get-info group))))
-    (or (memq 'auto-expire params)
-	(cdr (assq 'auto-expire params)) ; (auto-expire . t)
-	(and gnus-auto-expirable-newsgroups ; Check var.
-	     (string-match gnus-auto-expirable-newsgroups group)))))
-
-(defun gnus-virtual-group-p (group)
-  "Say whether GROUP is virtual or not."
-  (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
-			gnus-valid-select-methods)))
-
-(defun gnus-news-group-p (group &optional article)
-  "Return non-nil if GROUP (and ARTICLE) come from a news server."
-  (or (gnus-member-of-valid 'post group) ; Ordinary news group.
-      (and (gnus-member-of-valid 'post-mail group) ; Combined group.
-	   (eq (gnus-request-type group article) 'news))))
-
-(defsubst gnus-simplify-subject-fully (subject)
-  "Simplify a subject string according to the user's wishes."
-  (cond
-   ((null gnus-summary-gather-subject-limit)
-    (gnus-simplify-subject-re subject))
-   ((eq gnus-summary-gather-subject-limit 'fuzzy)
-    (gnus-simplify-subject-fuzzy subject))
-   ((numberp gnus-summary-gather-subject-limit)
-    (gnus-limit-string (gnus-simplify-subject-re subject)
-		       gnus-summary-gather-subject-limit))
-   (t
-    subject)))
-
-(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
-  "Check whether two subjects are equal.  If optional argument
-simple-first is t, first argument is already simplified."
-  (cond
-   ((null simple-first)
-    (equal (gnus-simplify-subject-fully s1)
-	   (gnus-simplify-subject-fully s2)))
-   (t
-    (equal s1
-	   (gnus-simplify-subject-fully s2)))))
-
-;; Returns a list of writable groups.
-(defun gnus-writable-groups ()
-  (let ((alist gnus-newsrc-alist)
-	groups group)
-    (while (setq group (car (pop alist)))
-      (unless (gnus-group-read-only-p group)
-	(push group groups)))
-    (nreverse groups)))
-
-(defun gnus-completing-read (default prompt &rest args)
-  ;; Like `completing-read', except that DEFAULT is the default argument.
-  (let* ((prompt (if default 
-		     (concat prompt " (default " default ") ")
-		   (concat prompt " ")))
-	 (answer (apply 'completing-read prompt args)))
-    (if (or (null answer) (zerop (length answer)))
-	default
-      answer)))
-
-;; Two silly functions to ensure that all `y-or-n-p' questions clear
-;; the echo area.
-(defun gnus-y-or-n-p (prompt)
-  (prog1
-      (y-or-n-p prompt)
-    (message "")))
-
-(defun gnus-yes-or-no-p (prompt)
-  (prog1
-      (yes-or-no-p prompt)
-    (message "")))
-
-;; Check whether to use long file names.
-(defun gnus-use-long-file-name (symbol)
-  ;; The variable has to be set...
-  (and gnus-use-long-file-name
-       ;; If it isn't a list, then we return t.
-       (or (not (listp gnus-use-long-file-name))
-	   ;; If it is a list, and the list contains `symbol', we
-	   ;; return nil.
-	   (not (memq symbol gnus-use-long-file-name)))))
-
-;; I suspect there's a better way, but I haven't taken the time to do
-;; it yet. -erik selberg@cs.washington.edu
-(defun gnus-dd-mmm (messy-date)
-  "Return a string like DD-MMM from a big messy string"
-  (let ((datevec (condition-case () (timezone-parse-date messy-date) 
-		   (error nil))))
-    (if (not datevec)
-	"??-???"
-      (format "%2s-%s"
-	      (condition-case ()
-		  ;; Make sure leading zeroes are stripped.
-		  (number-to-string (string-to-number (aref datevec 2)))
-		(error "??"))
-	      (capitalize
-	       (or (car
-		    (nth (1- (string-to-number (aref datevec 1)))
-			 timezone-months-assoc))
-		   "???"))))))
-
-(defun gnus-mode-string-quote (string)
-  "Quote all \"%\" in STRING."
-  (save-excursion
-    (gnus-set-work-buffer)
-    (insert string)
-    (goto-char (point-min))
-    (while (search-forward "%" nil t)
-      (insert "%"))
-    (buffer-string)))
-
-;; Make a hash table (default and minimum size is 255).
-;; Optional argument HASHSIZE specifies the table size.
-(defun gnus-make-hashtable (&optional hashsize)
-  (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 255) 255) 0))
-
-;; Make a number that is suitable for hashing; bigger than MIN and one
-;; less than 2^x.
-(defun gnus-create-hash-size (min)
-  (let ((i 1))
-    (while (< i min)
-      (setq i (* 2 i)))
-    (1- i)))
-
-;; Show message if message has a lower level than `gnus-verbose'.
-;; Guideline for numbers:
-;; 1 - error messages, 3 - non-serious error messages, 5 - messages
-;; for things that take a long time, 7 - not very important messages
-;; on stuff, 9 - messages inside loops.
-(defun gnus-message (level &rest args)
-  (if (<= level gnus-verbose)
-      (apply 'message args)
-    ;; We have to do this format thingy here even if the result isn't
-    ;; shown - the return value has to be the same as the return value
-    ;; from `message'.
-    (apply 'format args)))
-
-(defun gnus-error (level &rest args)
-  "Beep an error if LEVEL is equal to or less than `gnus-verbose'."
-  (when (<= (floor level) gnus-verbose)
-    (apply 'message args)
-    (ding)
-    (let (duration)
-      (when (and (floatp level)
-		 (not (zerop (setq duration (* 10 (- level (floor level)))))))
-	(sit-for duration))))
-  nil)
-
-;; Generate a unique new group name.
-(defun gnus-generate-new-group-name (leaf)
-  (let ((name leaf)
-	(num 0))
-    (while (gnus-gethash name gnus-newsrc-hashtb)
-      (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
-    name))
-
-(defsubst gnus-hide-text (b e props)
-  "Set text PROPS on the B to E region, extending `intangible' 1 past B."
-  (gnus-add-text-properties b e props)
-  (when (memq 'intangible props)
-    (gnus-put-text-property (max (1- b) (point-min))
-		       b 'intangible (cddr (memq 'intangible props)))))
-
-(defsubst gnus-unhide-text (b e)
-  "Remove hidden text properties from region between B and E."
-  (remove-text-properties b e gnus-hidden-properties)
-  (when (memq 'intangible gnus-hidden-properties)
-    (gnus-put-text-property (max (1- b) (point-min))
-			    b 'intangible nil)))
-
-(defun gnus-hide-text-type (b e type)
-  "Hide text of TYPE between B and E."
-  (gnus-hide-text b e (cons 'gnus-type (cons type gnus-hidden-properties))))
-
-(defun gnus-parent-headers (headers &optional generation)
-  "Return the headers of the GENERATIONeth parent of HEADERS."
-  (unless generation 
-    (setq generation 1))
-  (let (references parent)
-    (while (and headers (not (zerop generation)))
-      (setq references (mail-header-references headers))
-      (when (and references
-		 (setq parent (gnus-parent-id references))
-		 (setq headers (car (gnus-id-to-thread parent))))
-	(decf generation)))
-    headers))
-
-(defun gnus-parent-id (references)
-  "Return the last Message-ID in REFERENCES."
-  (when (and references
-	     (string-match "\\(<[^\n<>]+>\\)[ \t\n]*\\'" references))
-    (substring references (match-beginning 1) (match-end 1))))
-
-(defun gnus-split-references (references)
-  "Return a list of Message-IDs in REFERENCES."
-  (let ((beg 0)
-	ids)
-    (while (string-match "<[^>]+>" references beg)
-      (push (substring references (match-beginning 0) (setq beg (match-end 0)))
-	    ids))
-    (nreverse ids)))
-
-(defun gnus-buffer-live-p (buffer)
-  "Say whether BUFFER is alive or not."
-  (and buffer
-       (get-buffer buffer)
-       (buffer-name (get-buffer buffer))))
-
-(defun gnus-ephemeral-group-p (group)
-  "Say whether GROUP is ephemeral or not."
-  (gnus-group-get-parameter group 'quit-config))
-
-(defun gnus-group-quit-config (group)
-  "Return the quit-config of GROUP."
-  (gnus-group-get-parameter group 'quit-config))
-
-(defun gnus-simplify-mode-line ()
-  "Make mode lines a bit simpler."
-  (setq mode-line-modified "-- ")
-  (when (listp mode-line-format)
-    (make-local-variable 'mode-line-format)
-    (setq mode-line-format (copy-sequence mode-line-format))
-    (when (equal (nth 3 mode-line-format) "   ")
-      (setcar (nthcdr 3 mode-line-format) " "))))
-
-;;; List and range functions
-
-(defun gnus-last-element (list)
-  "Return last element of LIST."
-  (while (cdr list)
-    (setq list (cdr list)))
-  (car list))
-
-(defun gnus-copy-sequence (list)
-  "Do a complete, total copy of a list."
-  (if (and (consp list) (not (consp (cdr list))))
-      (cons (car list) (cdr list))
-    (mapcar (lambda (elem) (if (consp elem)
-			       (if (consp (cdr elem))
-				   (gnus-copy-sequence elem)
-				 (cons (car elem) (cdr elem)))
-			     elem))
-	    list)))
-
-(defun gnus-set-difference (list1 list2)
-  "Return a list of elements of LIST1 that do not appear in LIST2."
-  (let ((list1 (copy-sequence list1)))
-    (while list2
-      (setq list1 (delq (car list2) list1))
-      (setq list2 (cdr list2)))
-    list1))
-
-(defun gnus-sorted-complement (list1 list2)
-  "Return a list of elements of LIST1 that do not appear in LIST2.
-Both lists have to be sorted over <."
-  (let (out)
-    (if (or (null list1) (null list2))
-	(or list1 list2)
-      (while (and list1 list2)
-	(cond ((= (car list1) (car list2))
-	       (setq list1 (cdr list1)
-		     list2 (cdr list2)))
-	      ((< (car list1) (car list2))
-	       (setq out (cons (car list1) out))
-	       (setq list1 (cdr list1)))
-	      (t
-	       (setq out (cons (car list2) out))
-	       (setq list2 (cdr list2)))))
-      (nconc (nreverse out) (or list1 list2)))))
-
-(defun gnus-intersection (list1 list2)
-  (let ((result nil))
-    (while list2
-      (if (memq (car list2) list1)
-	  (setq result (cons (car list2) result)))
-      (setq list2 (cdr list2)))
-    result))
-
-(defun gnus-sorted-intersection (list1 list2)
-  ;; LIST1 and LIST2 have to be sorted over <.
-  (let (out)
-    (while (and list1 list2)
-      (cond ((= (car list1) (car list2))
-	     (setq out (cons (car list1) out)
-		   list1 (cdr list1)
-		   list2 (cdr list2)))
-	    ((< (car list1) (car list2))
-	     (setq list1 (cdr list1)))
-	    (t
-	     (setq list2 (cdr list2)))))
-    (nreverse out)))
-
-(defun gnus-set-sorted-intersection (list1 list2)
-  ;; LIST1 and LIST2 have to be sorted over <.
-  ;; This function modifies LIST1.
-  (let* ((top (cons nil list1))
-	 (prev top))
-    (while (and list1 list2)
-      (cond ((= (car list1) (car list2))
-	     (setq prev list1
-		   list1 (cdr list1)
-		   list2 (cdr list2)))
-	    ((< (car list1) (car list2))
-	     (setcdr prev (cdr list1))
-	     (setq list1 (cdr list1)))
-	    (t
-	     (setq list2 (cdr list2)))))
-    (setcdr prev nil)
-    (cdr top)))
-
-(defun gnus-compress-sequence (numbers &optional always-list)
-  "Convert list of numbers to a list of ranges or a single range.
-If ALWAYS-LIST is non-nil, this function will always release a list of
-ranges."
-  (let* ((first (car numbers))
-	 (last (car numbers))
-	 result)
-    (if (null numbers)
-	nil
-      (if (not (listp (cdr numbers)))
-	  numbers
-	(while numbers
-	  (cond ((= last (car numbers)) nil) ;Omit duplicated number
-		((= (1+ last) (car numbers)) ;Still in sequence
-		 (setq last (car numbers)))
-		(t			;End of one sequence
-		 (setq result
-		       (cons (if (= first last) first
-			       (cons first last)) result))
-		 (setq first (car numbers))
-		 (setq last  (car numbers))))
-	  (setq numbers (cdr numbers)))
-	(if (and (not always-list) (null result))
-	    (if (= first last) (list first) (cons first last))
-	  (nreverse (cons (if (= first last) first (cons first last))
-			  result)))))))
-
-(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
-(defun gnus-uncompress-range (ranges)
-  "Expand a list of ranges into a list of numbers.
-RANGES is either a single range on the form `(num . num)' or a list of
-these ranges."
-  (let (first last result)
-    (cond
-     ((null ranges)
-      nil)
-     ((not (listp (cdr ranges)))
-      (setq first (car ranges))
-      (setq last (cdr ranges))
-      (while (<= first last)
-	(setq result (cons first result))
-	(setq first (1+ first)))
-      (nreverse result))
-     (t
-      (while ranges
-	(if (atom (car ranges))
-	    (if (numberp (car ranges))
-		(setq result (cons (car ranges) result)))
-	  (setq first (caar ranges))
-	  (setq last  (cdar ranges))
-	  (while (<= first last)
-	    (setq result (cons first result))
-	    (setq first (1+ first))))
-	(setq ranges (cdr ranges)))
-      (nreverse result)))))
-
-(defun gnus-add-to-range (ranges list)
-  "Return a list of ranges that has all articles from both RANGES and LIST.
-Note: LIST has to be sorted over `<'."
-  (if (not ranges)
-      (gnus-compress-sequence list t)
-    (setq list (copy-sequence list))
-    (or (listp (cdr ranges))
-	(setq ranges (list ranges)))
-    (let ((out ranges)
-	  ilist lowest highest temp)
-      (while (and ranges list)
-	(setq ilist list)
-	(setq lowest (or (and (atom (car ranges)) (car ranges))
-			 (caar ranges)))
-	(while (and list (cdr list) (< (cadr list) lowest))
-	  (setq list (cdr list)))
-	(if (< (car ilist) lowest)
-	    (progn
-	      (setq temp list)
-	      (setq list (cdr list))
-	      (setcdr temp nil)
-	      (setq out (nconc (gnus-compress-sequence ilist t) out))))
-	(setq highest (or (and (atom (car ranges)) (car ranges))
-			  (cdar ranges)))
-	(while (and list (<= (car list) highest))
-	  (setq list (cdr list)))
-	(setq ranges (cdr ranges)))
-      (if list
-	  (setq out (nconc (gnus-compress-sequence list t) out)))
-      (setq out (sort out (lambda (r1 r2)
-			    (< (or (and (atom r1) r1) (car r1))
-			       (or (and (atom r2) r2) (car r2))))))
-      (setq ranges out)
-      (while ranges
-	(if (atom (car ranges))
-	    (if (cdr ranges)
-		(if (atom (cadr ranges))
-		    (if (= (1+ (car ranges)) (cadr ranges))
-			(progn
-			  (setcar ranges (cons (car ranges)
-					       (cadr ranges)))
-			  (setcdr ranges (cddr ranges))))
-		  (if (= (1+ (car ranges)) (caadr ranges))
-		      (progn
-			(setcar (cadr ranges) (car ranges))
-			(setcar ranges (cadr ranges))
-			(setcdr ranges (cddr ranges))))))
-	  (if (cdr ranges)
-	      (if (atom (cadr ranges))
-		  (if (= (1+ (cdar ranges)) (cadr ranges))
-		      (progn
-			(setcdr (car ranges) (cadr ranges))
-			(setcdr ranges (cddr ranges))))
-		(if (= (1+ (cdar ranges)) (caadr ranges))
-		    (progn
-		      (setcdr (car ranges) (cdadr ranges))
-		      (setcdr ranges (cddr ranges)))))))
-	(setq ranges (cdr ranges)))
-      out)))
-
-(defun gnus-remove-from-range (ranges list)
-  "Return a list of ranges that has all articles from LIST removed from RANGES.
-Note: LIST has to be sorted over `<'."
-  ;; !!! This function shouldn't look like this, but I've got a headache.
-  (gnus-compress-sequence
-   (gnus-sorted-complement
-    (gnus-uncompress-range ranges) list)))
-
-(defun gnus-member-of-range (number ranges)
-  (if (not (listp (cdr ranges)))
-      (and (>= number (car ranges))
-	   (<= number (cdr ranges)))
-    (let ((not-stop t))
-      (while (and ranges
-		  (if (numberp (car ranges))
-		      (>= number (car ranges))
-		    (>= number (caar ranges)))
-		  not-stop)
-	(if (if (numberp (car ranges))
-		(= number (car ranges))
-	      (and (>= number (caar ranges))
-		   (<= number (cdar ranges))))
-	    (setq not-stop nil))
-	(setq ranges (cdr ranges)))
-      (not not-stop))))
-
-(defun gnus-range-length (range)
-  "Return the length RANGE would have if uncompressed."
-  (length (gnus-uncompress-range range)))
-
-(defun gnus-sublist-p (list sublist)
-  "Test whether all elements in SUBLIST are members of LIST."
-  (let ((sublistp t))
-    (while sublist
-      (unless (memq (pop sublist) list)
-	(setq sublistp nil
-	      sublist nil)))
-    sublistp))
-
-
-;;;
-;;; Gnus group mode
-;;;
-
-(defvar gnus-group-mode-map nil)
-(put 'gnus-group-mode 'mode-class 'special)
-
-(unless gnus-group-mode-map
-  (setq gnus-group-mode-map (make-keymap))
-  (suppress-keymap gnus-group-mode-map)
-
-  (gnus-define-keys gnus-group-mode-map
-    " " gnus-group-read-group
-    "=" gnus-group-select-group
-    "\r" gnus-group-select-group
-    "\M-\r" gnus-group-quick-select-group
-    "j" gnus-group-jump-to-group
-    "n" gnus-group-next-unread-group
-    "p" gnus-group-prev-unread-group
-    "\177" gnus-group-prev-unread-group
-    [delete] gnus-group-prev-unread-group
-    "N" gnus-group-next-group
-    "P" gnus-group-prev-group
-    "\M-n" gnus-group-next-unread-group-same-level
-    "\M-p" gnus-group-prev-unread-group-same-level
-    "," gnus-group-best-unread-group
-    "." gnus-group-first-unread-group
-    "u" gnus-group-unsubscribe-current-group
-    "U" gnus-group-unsubscribe-group
-    "c" gnus-group-catchup-current
-    "C" gnus-group-catchup-current-all
-    "l" gnus-group-list-groups
-    "L" gnus-group-list-all-groups
-    "m" gnus-group-mail
-    "g" gnus-group-get-new-news
-    "\M-g" gnus-group-get-new-news-this-group
-    "R" gnus-group-restart
-    "r" gnus-group-read-init-file
-    "B" gnus-group-browse-foreign-server
-    "b" gnus-group-check-bogus-groups
-    "F" gnus-find-new-newsgroups
-    "\C-c\C-d" gnus-group-describe-group
-    "\M-d" gnus-group-describe-all-groups
-    "\C-c\C-a" gnus-group-apropos
-    "\C-c\M-\C-a" gnus-group-description-apropos
-    "a" gnus-group-post-news
-    "\ek" gnus-group-edit-local-kill
-    "\eK" gnus-group-edit-global-kill
-    "\C-k" gnus-group-kill-group
-    "\C-y" gnus-group-yank-group
-    "\C-w" gnus-group-kill-region
-    "\C-x\C-t" gnus-group-transpose-groups
-    "\C-c\C-l" gnus-group-list-killed
-    "\C-c\C-x" gnus-group-expire-articles
-    "\C-c\M-\C-x" gnus-group-expire-all-groups
-    "V" gnus-version
-    "s" gnus-group-save-newsrc
-    "z" gnus-group-suspend
-;    "Z" gnus-group-clear-dribble
-    "q" gnus-group-exit
-    "Q" gnus-group-quit
-    "?" gnus-group-describe-briefly
-    "\C-c\C-i" gnus-info-find-node
-    "\M-e" gnus-group-edit-group-method
-    "^" gnus-group-enter-server-mode
-    gnus-mouse-2 gnus-mouse-pick-group
-    "<" beginning-of-buffer
-    ">" end-of-buffer
-    "\C-c\C-b" gnus-bug
-    "\C-c\C-s" gnus-group-sort-groups
-    "t" gnus-topic-mode
-    "\C-c\M-g" gnus-activate-all-groups
-    "\M-&" gnus-group-universal-argument
-    "#" gnus-group-mark-group
-    "\M-#" gnus-group-unmark-group)
-
-  (gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
-    "m" gnus-group-mark-group
-    "u" gnus-group-unmark-group
-    "w" gnus-group-mark-region
-    "m" gnus-group-mark-buffer
-    "r" gnus-group-mark-regexp
-    "U" gnus-group-unmark-all-groups)
-
-  (gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
-    "d" gnus-group-make-directory-group
-    "h" gnus-group-make-help-group
-    "a" gnus-group-make-archive-group
-    "k" gnus-group-make-kiboze-group
-    "m" gnus-group-make-group
-    "E" gnus-group-edit-group
-    "e" gnus-group-edit-group-method
-    "p" gnus-group-edit-group-parameters
-    "v" gnus-group-add-to-virtual
-    "V" gnus-group-make-empty-virtual
-    "D" gnus-group-enter-directory
-    "f" gnus-group-make-doc-group
-    "r" gnus-group-rename-group
-    "\177" gnus-group-delete-group
-    [delete] gnus-group-delete-group)
-
-   (gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
-     "b" gnus-group-brew-soup
-     "w" gnus-soup-save-areas
-     "s" gnus-soup-send-replies
-     "p" gnus-soup-pack-packet
-     "r" nnsoup-pack-replies)
-
-   (gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
-     "s" gnus-group-sort-groups
-     "a" gnus-group-sort-groups-by-alphabet
-     "u" gnus-group-sort-groups-by-unread
-     "l" gnus-group-sort-groups-by-level
-     "v" gnus-group-sort-groups-by-score
-     "r" gnus-group-sort-groups-by-rank
-     "m" gnus-group-sort-groups-by-method)
-
-   (gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
-     "k" gnus-group-list-killed
-     "z" gnus-group-list-zombies
-     "s" gnus-group-list-groups
-     "u" gnus-group-list-all-groups
-     "A" gnus-group-list-active
-     "a" gnus-group-apropos
-     "d" gnus-group-description-apropos
-     "m" gnus-group-list-matching
-     "M" gnus-group-list-all-matching
-     "l" gnus-group-list-level)
-
-   (gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
-     "f" gnus-score-flush-cache)
-
-   (gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
-     "f" gnus-group-fetch-faq)
-
-   (gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
-     "l" gnus-group-set-current-level
-     "t" gnus-group-unsubscribe-current-group
-     "s" gnus-group-unsubscribe-group
-     "k" gnus-group-kill-group
-     "y" gnus-group-yank-group
-     "w" gnus-group-kill-region
-     "\C-k" gnus-group-kill-level
-     "z" gnus-group-kill-all-zombies))
-
-(defun gnus-group-mode ()
-  "Major mode for reading news.
-
-All normal editing commands are switched off.
-\\<gnus-group-mode-map>
-The group buffer lists (some of) the groups available.	For instance,
-`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
-lists all zombie groups.
-
-Groups that are displayed can be entered with `\\[gnus-group-read-group]'.  To subscribe
-to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
-
-For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
-
-The following commands are available:
-
-\\{gnus-group-mode-map}"
-  (interactive)
-  (when (and menu-bar-mode
-	     (gnus-visual-p 'group-menu 'menu))
-    (gnus-group-make-menu-bar))
-  (kill-all-local-variables)
-  (gnus-simplify-mode-line)
-  (setq major-mode 'gnus-group-mode)
-  (setq mode-name "Group")
-  (gnus-group-set-mode-line)
-  (setq mode-line-process nil)
-  (use-local-map gnus-group-mode-map)
-  (buffer-disable-undo (current-buffer))
-  (setq truncate-lines t)
-  (setq buffer-read-only t)
-  (gnus-make-local-hook 'post-command-hook)
-  (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
-  (run-hooks 'gnus-group-mode-hook))
-
-(defun gnus-clear-inboxes-moved ()
-  (setq nnmail-moved-inboxes nil))
-
-(defun gnus-mouse-pick-group (e)
-  "Enter the group under the mouse pointer."
-  (interactive "e")
-  (mouse-set-point e)
-  (gnus-group-read-group nil))
-
-;; Look at LEVEL and find out what the level is really supposed to be.
-;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
-;; will depend on whether `gnus-group-use-permanent-levels' is used.
-(defun gnus-group-default-level (&optional level number-or-nil)
-  (cond
-   (gnus-group-use-permanent-levels
-    (or (setq gnus-group-use-permanent-levels
-	      (or level (if (numberp gnus-group-use-permanent-levels)
-			    gnus-group-use-permanent-levels
-			  (or gnus-group-default-list-level
-			      gnus-level-subscribed))))
-	gnus-group-default-list-level gnus-level-subscribed))
-   (number-or-nil
-    level)
-   (t
-    (or level gnus-group-default-list-level gnus-level-subscribed))))
-
-;;;###autoload
-(defun gnus-slave-no-server (&optional arg)
-  "Read network news as a slave, without connecting to local server"
-  (interactive "P")
-  (gnus-no-server arg t))
-
-;;;###autoload
-(defun gnus-no-server (&optional arg slave)
-  "Read network news.
-If ARG is a positive number, Gnus will use that as the
-startup level.	If ARG is nil, Gnus will be started at level 2.
-If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use.
-As opposed to `gnus', this command will not connect to the local server."
-  (interactive "P")
-  (let ((val (or arg (1- gnus-level-default-subscribed))))
-    (gnus val t slave)
-    (make-local-variable 'gnus-group-use-permanent-levels)
-    (setq gnus-group-use-permanent-levels val)))
-
-;;;###autoload
-(defun gnus-slave (&optional arg)
-  "Read news as a slave."
-  (interactive "P")
-  (gnus arg nil 'slave))
-
-;;;###autoload
-(defun gnus-other-frame (&optional arg)
-  "Pop up a frame to read news."
-  (interactive "P")
-  (if (get-buffer gnus-group-buffer)
-      (let ((pop-up-frames t))
-	(gnus arg))
-    (select-frame (make-frame))
-    (gnus arg)))
-
-;;;###autoload
-(defun gnus (&optional arg dont-connect slave)
-  "Read network news.
-If ARG is non-nil and a positive number, Gnus will use that as the
-startup level.	If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use."
-  (interactive "P")
-
-  (if (get-buffer gnus-group-buffer)
-      (progn
-	(switch-to-buffer gnus-group-buffer)
-	(gnus-group-get-new-news))
-
-    (gnus-clear-system)
-    (nnheader-init-server-buffer)
-    (gnus-read-init-file)
-    (setq gnus-slave slave)
-
-    (gnus-group-setup-buffer)
-    (let ((buffer-read-only nil))
-      (erase-buffer)
-      (if (not gnus-inhibit-startup-message)
-	  (progn
-	    (gnus-group-startup-message)
-	    (sit-for 0))))
-
-    (let ((level (and (numberp arg) (> arg 0) arg))
-	  did-connect)
-      (unwind-protect
-	  (progn
-	    (or dont-connect
-		(setq did-connect
-		      (gnus-start-news-server (and arg (not level))))))
-	(if (and (not dont-connect)
-		 (not did-connect))
-	    (gnus-group-quit)
-	  (run-hooks 'gnus-startup-hook)
-	  ;; NNTP server is successfully open.
-
-	  ;; Find the current startup file name.
-	  (setq gnus-current-startup-file
-		(gnus-make-newsrc-file gnus-startup-file))
-
-	  ;; Read the dribble file.
-	  (when (or gnus-slave gnus-use-dribble-file)
-	    (gnus-dribble-read-file))
-
-	  ;; Allow using GroupLens predictions.
-	  (when gnus-use-grouplens
-	    (bbb-login)
-	    (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
-
-	  (gnus-summary-make-display-table)
-	  ;; Do the actual startup.
-	  (gnus-setup-news nil level dont-connect)
-	  ;; Generate the group buffer.
-	  (gnus-group-list-groups level)
-	  (gnus-group-first-unread-group)
-	  (gnus-configure-windows 'group)
-	  (gnus-group-set-mode-line))))))
-
-(defun gnus-unload ()
-  "Unload all Gnus features."
-  (interactive)
-  (or (boundp 'load-history)
-      (error "Sorry, `gnus-unload' is not implemented in this Emacs version."))
-  (let ((history load-history)
-	feature)
-    (while history
-      (and (string-match "^\\(gnus\\|nn\\)" (caar history))
-	   (setq feature (cdr (assq 'provide (car history))))
-	   (unload-feature feature 'force))
-      (setq history (cdr history)))))
-
-(defun gnus-compile ()
-  "Byte-compile the user-defined format specs."
-  (interactive)
-  (let ((entries gnus-format-specs)
-	entry gnus-tmp-func)
-    (save-excursion
-      (gnus-message 7 "Compiling format specs...")
-
-      (while entries
-	(setq entry (pop entries))
-	(if (eq (car entry) 'version)
-	    (setq gnus-format-specs (delq entry gnus-format-specs))
-	  (when (and (listp (caddr entry))
-		     (not (eq 'byte-code (caaddr entry))))
-	    (fset 'gnus-tmp-func
-		  `(lambda () ,(caddr entry)))
-	    (byte-compile 'gnus-tmp-func)
-	    (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func)))))
-
-      (push (cons 'version emacs-version) gnus-format-specs)
-
-      (gnus-message 7 "Compiling user specs...done"))))
-
-(defun gnus-indent-rigidly (start end arg)
-  "Indent rigidly using only spaces and no tabs."
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (indent-rigidly start end arg)
-      (goto-char (point-min))
-      (while (search-forward "\t" nil t)
-	(replace-match "	" t t)))))
-
-(defun gnus-group-startup-message (&optional x y)
-  "Insert startup message in current buffer."
-  ;; Insert the message.
-  (erase-buffer)
-  (insert
-   (format "              %s
-          _    ___ _             _
-          _ ___ __ ___  __    _ ___
-          __   _     ___    __  ___
-              _           ___     _
-             _  _ __             _
-             ___   __            _
-                   __           _
-                    _      _   _
-                   _      _    _
-                      _  _    _
-                  __  ___
-                 _   _ _     _
-                _   _
-              _    _
-             _    _
-            _
-          __
-
-"
-           ""))
-  ;; And then hack it.
-  (gnus-indent-rigidly (point-min) (point-max)
-		       (/ (max (- (window-width) (or x 46)) 0) 2))
-  (goto-char (point-min))
-  (forward-line 1)
-  (let* ((pheight (count-lines (point-min) (point-max)))
-	 (wheight (window-height))
-	 (rest (- wheight pheight)))
-    (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
-  ;; Fontify some.
-  (goto-char (point-min))
-  (and (search-forward "Praxis" nil t)
-       (gnus-put-text-property (match-beginning 0) (match-end 0) 'face 'bold))
-  (goto-char (point-min))
-  (let* ((mode-string (gnus-group-set-mode-line)))
-    (setq mode-line-buffer-identification
-	  (list (concat gnus-version (substring (car mode-string) 4))))
-    (set-buffer-modified-p t)))
-
-(defun gnus-group-setup-buffer ()
-  (or (get-buffer gnus-group-buffer)
-      (progn
-	(switch-to-buffer gnus-group-buffer)
-	(gnus-add-current-to-buffer-list)
-	(gnus-group-mode)
-	(and gnus-carpal (gnus-carpal-setup-buffer 'group)))))
-
-(defun gnus-group-list-groups (&optional level unread lowest)
-  "List newsgroups with level LEVEL or lower that have unread articles.
-Default is all subscribed groups.
-If argument UNREAD is non-nil, groups with no unread articles are also
-listed."
-  (interactive (list (if current-prefix-arg
-			 (prefix-numeric-value current-prefix-arg)
-		       (or
-			(gnus-group-default-level nil t)
-			gnus-group-default-list-level
-			gnus-level-subscribed))))
-  (or level
-      (setq level (car gnus-group-list-mode)
-	    unread (cdr gnus-group-list-mode)))
-  (setq level (gnus-group-default-level level))
-  (gnus-group-setup-buffer)		;May call from out of group buffer
-  (gnus-update-format-specifications)
-  (let ((case-fold-search nil)
-	(props (text-properties-at (gnus-point-at-bol)))
-	(group (gnus-group-group-name)))
-    (set-buffer gnus-group-buffer)
-    (funcall gnus-group-prepare-function level unread lowest)
-    (if (zerop (buffer-size))
-	(gnus-message 5 gnus-no-groups-message)
-      (goto-char (point-max))
-      (when (or (not gnus-group-goto-next-group-function)
-		(not (funcall gnus-group-goto-next-group-function 
-			      group props)))
-	(if (not group)
-	    ;; Go to the first group with unread articles.
-	    (gnus-group-search-forward t)
-	  ;; Find the right group to put point on.  If the current group
-	  ;; has disappeared in the new listing, try to find the next
-	  ;; one.	 If no next one can be found, just leave point at the
-	  ;; first newsgroup in the buffer.
-	  (if (not (gnus-goto-char
-		    (text-property-any
-		     (point-min) (point-max)
-		     'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
-	      (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
-		(while (and newsrc
-			    (not (gnus-goto-char
-				  (text-property-any
-				   (point-min) (point-max) 'gnus-group
-				   (gnus-intern-safe
-				    (caar newsrc) gnus-active-hashtb)))))
-		  (setq newsrc (cdr newsrc)))
-		(or newsrc (progn (goto-char (point-max))
-				  (forward-line -1)))))))
-      ;; Adjust cursor point.
-      (gnus-group-position-point))))
-
-(defun gnus-group-list-level (level &optional all)
-  "List groups on LEVEL.
-If ALL (the prefix), also list groups that have no unread articles."
-  (interactive "nList groups on level: \nP")
-  (gnus-group-list-groups level all level))
-
-(defun gnus-group-prepare-flat (level &optional all lowest regexp)
-  "List all newsgroups with unread articles of level LEVEL or lower.
-If ALL is non-nil, list groups that have no unread articles.
-If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
-If REGEXP, only list groups matching REGEXP."
-  (set-buffer gnus-group-buffer)
-  (let ((buffer-read-only nil)
-	(newsrc (cdr gnus-newsrc-alist))
-	(lowest (or lowest 1))
-	info clevel unread group params)
-    (erase-buffer)
-    (if (< lowest gnus-level-zombie)
-	;; List living groups.
-	(while newsrc
-	  (setq info (car newsrc)
-		group (gnus-info-group info)
-		params (gnus-info-params info)
-		newsrc (cdr newsrc)
-		unread (car (gnus-gethash group gnus-newsrc-hashtb)))
-	  (and unread			; This group might be bogus
-	       (or (not regexp)
-		   (string-match regexp group))
-	       (<= (setq clevel (gnus-info-level info)) level)
-	       (>= clevel lowest)
-	       (or all			; We list all groups?
-		   (if (eq unread t)	; Unactivated?
-		       gnus-group-list-inactive-groups ; We list unactivated 
-		     (> unread 0))	; We list groups with unread articles
-		   (and gnus-list-groups-with-ticked-articles
-			(cdr (assq 'tick (gnus-info-marks info))))
-					; And groups with tickeds
-		   ;; Check for permanent visibility.
-		   (and gnus-permanently-visible-groups
-			(string-match gnus-permanently-visible-groups
-				      group))
-		   (memq 'visible params)
-		   (cdr (assq 'visible params)))
-	       (gnus-group-insert-group-line
-		group (gnus-info-level info)
-		(gnus-info-marks info) unread (gnus-info-method info)))))
-
-    ;; List dead groups.
-    (and (>= level gnus-level-zombie) (<= lowest gnus-level-zombie)
-	 (gnus-group-prepare-flat-list-dead
-	  (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
-	  gnus-level-zombie ?Z
-	  regexp))
-    (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)
-	 (gnus-group-prepare-flat-list-dead
-	  (setq gnus-killed-list (sort gnus-killed-list 'string<))
-	  gnus-level-killed ?K regexp))
-
-    (gnus-group-set-mode-line)
-    (setq gnus-group-list-mode (cons level all))
-    (run-hooks 'gnus-group-prepare-hook)))
-
-(defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
-  ;; List zombies and killed lists somewhat faster, which was
-  ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.  It does
-  ;; this by ignoring the group format specification altogether.
-  (let (group)
-    (if regexp
-	;; This loop is used when listing groups that match some
-	;; regexp.
-	(while groups
-	  (setq group (pop groups))
-	  (when (string-match regexp group)
-	    (gnus-add-text-properties
-	     (point) (prog1 (1+ (point))
-		       (insert " " mark "     *: " group "\n"))
-	     (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
-		   'gnus-unread t
-		   'gnus-level level))))
-      ;; This loop is used when listing all groups.
-      (while groups
-	(gnus-add-text-properties
-	 (point) (prog1 (1+ (point))
-		   (insert " " mark "     *: "
-			   (setq group (pop groups)) "\n"))
-	 (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
-	       'gnus-unread t
-	       'gnus-level level))))))
-
-(defmacro gnus-group-real-name (group)
-  "Find the real name of a foreign newsgroup."
-  `(let ((gname ,group))
-     (if (string-match ":[^:]+$" gname)
-	 (substring gname (1+ (match-beginning 0)))
-       gname)))
-
-(defsubst gnus-server-add-address (method)
-  (let ((method-name (symbol-name (car method))))
-    (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
-	     (not (assq (intern (concat method-name "-address")) method)))
-	(append method (list (list (intern (concat method-name "-address"))
-				   (nth 1 method))))
-      method)))
-
-(defsubst gnus-server-get-method (group method)
-  ;; Input either a server name, and extended server name, or a
-  ;; select method, and return a select method.
-  (cond ((stringp method)
-	 (gnus-server-to-method method))
-	((equal method gnus-select-method)
-	 gnus-select-method)
-	((and (stringp (car method)) group)
-	 (gnus-server-extend-method group method))
-	((and method (not group)
-	      (equal (cadr method) ""))
-	 method)
-	(t
-	 (gnus-server-add-address method))))
-
-(defun gnus-server-to-method (server)
-  "Map virtual server names to select methods."
-  (or 
-   ;; Is this a method, perhaps?
-   (and server (listp server) server)
-   ;; Perhaps this is the native server?
-   (and (equal server "native") gnus-select-method)
-   ;; It should be in the server alist.
-   (cdr (assoc server gnus-server-alist))
-   ;; If not, we look through all the opened server
-   ;; to see whether we can find it there.
-   (let ((opened gnus-opened-servers))
-     (while (and opened
-		 (not (equal server (format "%s:%s" (caaar opened)
-					    (cadaar opened)))))
-       (pop opened))
-     (caar opened))))
-
-(defmacro gnus-method-equal (ss1 ss2)
-  "Say whether two servers are equal."
-  `(let ((s1 ,ss1)
-	 (s2 ,ss2))
-     (or (equal s1 s2)
-	 (and (= (length s1) (length s2))
-	      (progn
-		(while (and s1 (member (car s1) s2))
-		  (setq s1 (cdr s1)))
-		(null s1))))))
-
-(defun gnus-server-equal (m1 m2)
-  "Say whether two methods are equal."
-  (let ((m1 (cond ((null m1) gnus-select-method)
-		  ((stringp m1) (gnus-server-to-method m1))
-		  (t m1)))
-	(m2 (cond ((null m2) gnus-select-method)
-		  ((stringp m2) (gnus-server-to-method m2))
-		  (t m2))))
-    (gnus-method-equal m1 m2)))
-
-(defun gnus-servers-using-backend (backend)
-  "Return a list of known servers using BACKEND."
-  (let ((opened gnus-opened-servers)
-	out)
-    (while opened
-      (when (eq backend (caaar opened))
-	(push (caar opened) out))
-      (pop opened))
-    out))
-
-(defun gnus-archive-server-wanted-p ()
-  "Say whether the user wants to use the archive server."
-  (cond 
-   ((or (not gnus-message-archive-method)
-	(not gnus-message-archive-group))
-    nil)
-   ((and gnus-message-archive-method gnus-message-archive-group)
-    t)
-   (t
-    (let ((active (cadr (assq 'nnfolder-active-file
-			      gnus-message-archive-method))))
-      (and active
-	   (file-exists-p active))))))
-
-(defun gnus-group-prefixed-name (group method)
-  "Return the whole name from GROUP and METHOD."
-  (and (stringp method) (setq method (gnus-server-to-method method)))
-  (concat (format "%s" (car method))
-	  (if (and
-	       (or (assoc (format "%s" (car method)) 
-			  (gnus-methods-using 'address))
-		   (gnus-server-equal method gnus-message-archive-method))
-	       (nth 1 method)
-	       (not (string= (nth 1 method) "")))
-	      (concat "+" (nth 1 method)))
-	  ":" group))
-
-(defun gnus-group-real-prefix (group)
-  "Return the prefix of the current group name."
-  (if (string-match "^[^:]+:" group)
-      (substring group 0 (match-end 0))
-    ""))
-
-(defun gnus-group-method (group)
-  "Return the server or method used for selecting GROUP."
-  (let ((prefix (gnus-group-real-prefix group)))
-    (if (equal prefix "")
-	gnus-select-method
-      (let ((servers gnus-opened-servers)
-	    (server "")
-	    backend possible found)
-	(if (string-match "^[^\\+]+\\+" prefix)
-	    (setq backend (intern (substring prefix 0 (1- (match-end 0))))
-		  server (substring prefix (match-end 0) (1- (length prefix))))
-	  (setq backend (intern (substring prefix 0 (1- (length prefix))))))
-	(while servers
-	  (when (eq (caaar servers) backend)
-	    (setq possible (caar servers))
-	    (when (equal (cadaar servers) server)
-	      (setq found (caar servers))))
-	  (pop servers))
-	(or (car (rassoc found gnus-server-alist))
-	    found
-	    (car (rassoc possible gnus-server-alist))
-	    possible
-	    (list backend server))))))
-
-(defsubst gnus-secondary-method-p (method)
-  "Return whether METHOD is a secondary select method."
-  (let ((methods gnus-secondary-select-methods)
-	(gmethod (gnus-server-get-method nil method)))
-    (while (and methods
-		(not (equal (gnus-server-get-method nil (car methods))
-			    gmethod)))
-      (setq methods (cdr methods)))
-    methods))
-
-(defun gnus-group-foreign-p (group)
-  "Say whether a group is foreign or not."
-  (and (not (gnus-group-native-p group))
-       (not (gnus-group-secondary-p group))))
-
-(defun gnus-group-native-p (group)
-  "Say whether the group is native or not."
-  (not (string-match ":" group)))
-
-(defun gnus-group-secondary-p (group)
-  "Say whether the group is secondary or not."
-  (gnus-secondary-method-p (gnus-find-method-for-group group)))
-
-(defun gnus-group-get-parameter (group &optional symbol)
-  "Returns the group parameters for GROUP.
-If SYMBOL, return the value of that symbol in the group parameters."
-  (let ((params (gnus-info-params (gnus-get-info group))))
-    (if symbol
-	(gnus-group-parameter-value params symbol)
-      params)))
-
-(defun gnus-group-parameter-value (params symbol)
-  "Return the value of SYMBOL in group PARAMS."
-  (or (car (memq symbol params))	; It's either a simple symbol
-      (cdr (assq symbol params))))	; or a cons.
-
-(defun gnus-group-add-parameter (group param)
-  "Add parameter PARAM to GROUP."
-  (let ((info (gnus-get-info group)))
-    (if (not info)
-	() ; This is a dead group.  We just ignore it.
-      ;; Cons the new param to the old one and update.
-      (gnus-group-set-info (cons param (gnus-info-params info))
-			   group 'params))))
-
-(defun gnus-group-set-parameter (group name value)
-  "Set parameter NAME to VALUE in GROUP."
-  (let ((info (gnus-get-info group)))
-    (if (not info)
-	() ; This is a dead group.  We just ignore it.
-      (let ((old-params (gnus-info-params info))
-	    (new-params (list (cons name value))))
-	(while old-params
-	  (if (or (not (listp (car old-params)))
-		  (not (eq (caar old-params) name)))
-	      (setq new-params (append new-params (list (car old-params)))))
-	  (setq old-params (cdr old-params)))
-	(gnus-group-set-info new-params group 'params)))))
-
-(defun gnus-group-add-score (group &optional score)
-  "Add SCORE to the GROUP score.
-If SCORE is nil, add 1 to the score of GROUP."
-  (let ((info (gnus-get-info group)))
-    (when info
-      (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
-
-(defun gnus-summary-bubble-group ()
-  "Increase the score of the current group.
-This is a handy function to add to `gnus-summary-exit-hook' to
-increase the score of each group you read."
-  (gnus-group-add-score gnus-newsgroup-name))
-
-(defun gnus-group-set-info (info &optional method-only-group part)
-  (let* ((entry (gnus-gethash
-		 (or method-only-group (gnus-info-group info))
-		 gnus-newsrc-hashtb))
-	 (part-info info)
-	 (info (if method-only-group (nth 2 entry) info))
-	 method)
-    (when method-only-group
-      (unless entry
-	(error "Trying to change non-existent group %s" method-only-group))
-      ;; We have received parts of the actual group info - either the
-      ;; select method or the group parameters.	 We first check
-      ;; whether we have to extend the info, and if so, do that.
-      (let ((len (length info))
-	    (total (if (eq part 'method) 5 6)))
-	(when (< len total)
-	  (setcdr (nthcdr (1- len) info)
-		  (make-list (- total len) nil)))
-	;; Then we enter the new info.
-	(setcar (nthcdr (1- total) info) part-info)))
-    (unless entry
-      ;; This is a new group, so we just create it.
-      (save-excursion
-	(set-buffer gnus-group-buffer)
-	(setq method (gnus-info-method info))
-	(when (gnus-server-equal method "native")
-	  (setq method nil))
-	(save-excursion
-	  (set-buffer gnus-group-buffer)
-	  (if method
-	      ;; It's a foreign group...
-	      (gnus-group-make-group
-	       (gnus-group-real-name (gnus-info-group info))
-	       (if (stringp method) method
-		 (prin1-to-string (car method)))
-	       (and (consp method)
-		    (nth 1 (gnus-info-method info))))
-	    ;; It's a native group.
-	    (gnus-group-make-group (gnus-info-group info))))
-	(gnus-message 6 "Note: New group created")
-	(setq entry
-	      (gnus-gethash (gnus-group-prefixed-name
-			     (gnus-group-real-name (gnus-info-group info))
-			     (or (gnus-info-method info) gnus-select-method))
-			    gnus-newsrc-hashtb))))
-    ;; Whether it was a new group or not, we now have the entry, so we
-    ;; can do the update.
-    (if entry
-	(progn
-	  (setcar (nthcdr 2 entry) info)
-	  (when (and (not (eq (car entry) t))
-		     (gnus-active (gnus-info-group info)))
-	    (setcar entry (length (gnus-list-of-unread-articles (car info))))))
-      (error "No such group: %s" (gnus-info-group info)))))
-
-(defun gnus-group-set-method-info (group select-method)
-  (gnus-group-set-info select-method group 'method))
-
-(defun gnus-group-set-params-info (group params)
-  (gnus-group-set-info params group 'params))
-
-(defun gnus-group-update-group-line ()
-  "Update the current line in the group buffer."
-  (let* ((buffer-read-only nil)
-	 (group (gnus-group-group-name))
-	 (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
-	 gnus-group-indentation)
-    (when group
-      (and entry
-	   (not (gnus-ephemeral-group-p group))
-	   (gnus-dribble-enter
-	    (concat "(gnus-group-set-info '"
-		    (prin1-to-string (nth 2 entry)) ")")))
-      (setq gnus-group-indentation (gnus-group-group-indentation))
-      (gnus-delete-line)
-      (gnus-group-insert-group-line-info group)
-      (forward-line -1)
-      (gnus-group-position-point))))
-
-(defun gnus-group-insert-group-line-info (group)
-  "Insert GROUP on the current line."
-  (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
-	active info)
-    (if entry
-	(progn
-	  ;; (Un)subscribed group.
-	  (setq info (nth 2 entry))
-	  (gnus-group-insert-group-line
-	   group (gnus-info-level info) (gnus-info-marks info)
-	   (or (car entry) t) (gnus-info-method info)))
-      ;; This group is dead.
-      (gnus-group-insert-group-line
-       group
-       (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
-       nil
-       (if (setq active (gnus-active group))
-	   (- (1+ (cdr active)) (car active)) 0)
-       nil))))
-
-(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level 
-						    gnus-tmp-marked number
-						    gnus-tmp-method)
-  "Insert a group line in the group buffer."
-  (let* ((gnus-tmp-active (gnus-active gnus-tmp-group))
-	 (gnus-tmp-number-total
-	  (if gnus-tmp-active
-	      (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
-	    0))
-	 (gnus-tmp-number-of-unread
-	  (if (numberp number) (int-to-string (max 0 number))
-	    "*"))
-	 (gnus-tmp-number-of-read
-	  (if (numberp number)
-	      (int-to-string (max 0 (- gnus-tmp-number-total number)))
-	    "*"))
-	 (gnus-tmp-subscribed
-	  (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
-		((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
-		((= gnus-tmp-level gnus-level-zombie) ?Z)
-		(t ?K)))
-	 (gnus-tmp-qualified-group (gnus-group-real-name gnus-tmp-group))
-	 (gnus-tmp-newsgroup-description
-	  (if gnus-description-hashtb
-	      (or (gnus-gethash gnus-tmp-group gnus-description-hashtb) "")
-	    ""))
-	 (gnus-tmp-moderated
-	  (if (member gnus-tmp-group gnus-moderated-list) ?m ? ))
-	 (gnus-tmp-moderated-string
-	  (if (eq gnus-tmp-moderated ?m) "(m)" ""))
-	 (gnus-tmp-method
-	  (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
-	 (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
-	 (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
-	 (gnus-tmp-news-method-string
-	  (if gnus-tmp-method
-	      (format "(%s:%s)" (car gnus-tmp-method)
-		      (cadr gnus-tmp-method)) ""))
-	 (gnus-tmp-marked-mark
-	  (if (and (numberp number)
-		   (zerop number)
-		   (cdr (assq 'tick gnus-tmp-marked)))
-	      ?* ? ))
-	 (gnus-tmp-process-marked
-	  (if (member gnus-tmp-group gnus-group-marked)
-	      gnus-process-mark ? ))
-	 (gnus-tmp-grouplens
-	  (or (and gnus-use-grouplens
-		   (bbb-grouplens-group-p gnus-tmp-group))
-	      ""))
-	 (buffer-read-only nil)
-	 header gnus-tmp-header)	; passed as parameter to user-funcs.
-    (beginning-of-line)
-    (gnus-add-text-properties
-     (point)
-     (prog1 (1+ (point))
-       ;; Insert the text.
-       (eval gnus-group-line-format-spec))
-     `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
-       gnus-unread ,(if (numberp number)
-			(string-to-int gnus-tmp-number-of-unread)
-		      t)
-       gnus-marked ,gnus-tmp-marked-mark
-       gnus-indentation ,gnus-group-indentation
-       gnus-level ,gnus-tmp-level))
-    (when (inline (gnus-visual-p 'group-highlight 'highlight))
-      (forward-line -1)
-      (run-hooks 'gnus-group-update-hook)
-      (forward-line))
-    ;; Allow XEmacs to remove front-sticky text properties.
-    (gnus-group-remove-excess-properties)))
-
-(defun gnus-group-update-group (group &optional visible-only)
-  "Update all lines where GROUP appear.
-If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
-already."
-  (save-excursion
-    (set-buffer gnus-group-buffer)
-    ;; The buffer may be narrowed.
-    (save-restriction
-      (widen)
-      (let ((ident (gnus-intern-safe group gnus-active-hashtb))
-	    (loc (point-min))
-	    found buffer-read-only)
-	;; Enter the current status into the dribble buffer.
-	(let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
-	  (if (and entry (not (gnus-ephemeral-group-p group)))
-	      (gnus-dribble-enter
-	       (concat "(gnus-group-set-info '" (prin1-to-string (nth 2 entry))
-		       ")"))))
-	;; Find all group instances.  If topics are in use, each group
-	;; may be listed in more than once.
-	(while (setq loc (text-property-any
-			  loc (point-max) 'gnus-group ident))
-	  (setq found t)
-	  (goto-char loc)
-	  (let ((gnus-group-indentation (gnus-group-group-indentation)))
-	    (gnus-delete-line)
-	    (gnus-group-insert-group-line-info group)
-	    (save-excursion
-	      (forward-line -1)
-	      (run-hooks 'gnus-group-update-group-hook)))
-	  (setq loc (1+ loc)))
-	(unless (or found visible-only)
-	  ;; No such line in the buffer, find out where it's supposed to
-	  ;; go, and insert it there (or at the end of the buffer).
-	  (if gnus-goto-missing-group-function
-	      (funcall gnus-goto-missing-group-function group)
-	    (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
-	      (while (and entry (car entry)
-			  (not
-			   (gnus-goto-char
-			    (text-property-any
-			     (point-min) (point-max)
-			     'gnus-group (gnus-intern-safe
-					  (caar entry) gnus-active-hashtb)))))
-		(setq entry (cdr entry)))
-	      (or entry (goto-char (point-max)))))
-	  ;; Finally insert the line.
-	  (let ((gnus-group-indentation (gnus-group-group-indentation)))
-	    (gnus-group-insert-group-line-info group)
-	    (save-excursion
-	      (forward-line -1)
-	      (run-hooks 'gnus-group-update-group-hook))))
-	(gnus-group-set-mode-line)))))
-
-(defun gnus-group-set-mode-line ()
-  "Update the mode line in the group buffer."
-  (when (memq 'group gnus-updated-mode-lines)
-    ;; Yes, we want to keep this mode line updated.
-    (save-excursion
-      (set-buffer gnus-group-buffer)
-      (let* ((gformat (or gnus-group-mode-line-format-spec
-			  (setq gnus-group-mode-line-format-spec
-				(gnus-parse-format
-				 gnus-group-mode-line-format
-				 gnus-group-mode-line-format-alist))))
-	     (gnus-tmp-news-server (cadr gnus-select-method))
-	     (gnus-tmp-news-method (car gnus-select-method))
-	     (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
-	     (max-len 60)
-	     gnus-tmp-header		;Dummy binding for user-defined formats
-	     ;; Get the resulting string.
-	     (modified 
-	      (and gnus-dribble-buffer
-		   (buffer-name gnus-dribble-buffer)
-		   (buffer-modified-p gnus-dribble-buffer)
-		   (save-excursion
-		     (set-buffer gnus-dribble-buffer)
-		     (not (zerop (buffer-size))))))
-	     (mode-string (eval gformat)))
-	;; Say whether the dribble buffer has been modified.
-	(setq mode-line-modified
-	      (if modified "---*- " "----- "))
-	;; If the line is too long, we chop it off.
-	(when (> (length mode-string) max-len)
-	  (setq mode-string (substring mode-string 0 (- max-len 4))))
-	(prog1
-	    (setq mode-line-buffer-identification 
-		  (gnus-mode-line-buffer-identification
-		   (list mode-string)))
-	  (set-buffer-modified-p modified))))))
-
-(defun gnus-group-group-name ()
-  "Get the name of the newsgroup on the current line."
-  (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
-    (and group (symbol-name group))))
-
-(defun gnus-group-group-level ()
-  "Get the level of the newsgroup on the current line."
-  (get-text-property (gnus-point-at-bol) 'gnus-level))
-
-(defun gnus-group-group-indentation ()
-  "Get the indentation of the newsgroup on the current line."
-  (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
-      (and gnus-group-indentation-function
-	   (funcall gnus-group-indentation-function))
-      ""))
-
-(defun gnus-group-group-unread ()
-  "Get the number of unread articles of the newsgroup on the current line."
-  (get-text-property (gnus-point-at-bol) 'gnus-unread))
-
-(defun gnus-group-search-forward (&optional backward all level first-too)
-  "Find the next newsgroup with unread articles.
-If BACKWARD is non-nil, find the previous newsgroup instead.
-If ALL is non-nil, just find any newsgroup.
-If LEVEL is non-nil, find group with level LEVEL, or higher if no such
-group exists.
-If FIRST-TOO, the current line is also eligible as a target."
-  (let ((way (if backward -1 1))
-	(low gnus-level-killed)
-	(beg (point))
-	pos found lev)
-    (if (and backward (progn (beginning-of-line)) (bobp))
-	nil
-      (or first-too (forward-line way))
-      (while (and
-	      (not (eobp))
-	      (not (setq
-		    found
-		    (and (or all
-			     (and
-			      (let ((unread
-				     (get-text-property (point) 'gnus-unread)))
-				(and (numberp unread) (> unread 0)))
-			      (setq lev (get-text-property (point)
-							   'gnus-level))
-			      (<= lev gnus-level-subscribed)))
-			 (or (not level)
-			     (and (setq lev (get-text-property (point)
-							       'gnus-level))
-				  (or (= lev level)
-				      (and (< lev low)
-					   (< level lev)
-					   (progn
-					     (setq low lev)
-					     (setq pos (point))
-					     nil))))))))
-	      (zerop (forward-line way)))))
-    (if found
-	(progn (gnus-group-position-point) t)
-      (goto-char (or pos beg))
-      (and pos t))))
-
-;;; Gnus group mode commands
-
-;; Group marking.
-
-(defun gnus-group-mark-group (n &optional unmark no-advance)
-  "Mark the current group."
-  (interactive "p")
-  (let ((buffer-read-only nil)
-	group)
-    (while (and (> n 0)
-		(not (eobp)))
-      (when (setq group (gnus-group-group-name))
-	;; Update the mark.
-	(beginning-of-line)
-	(forward-char
-	 (or (cdr (assq 'process gnus-group-mark-positions)) 2))
-	(delete-char 1)
-	(if unmark
-	    (progn
-	      (insert " ")
-	      (setq gnus-group-marked (delete group gnus-group-marked)))
-	  (insert "#")
-	  (setq gnus-group-marked
-		(cons group (delete group gnus-group-marked)))))
-      (or no-advance (gnus-group-next-group 1))
-      (decf n))
-    (gnus-summary-position-point)
-    n))
-
-(defun gnus-group-unmark-group (n)
-  "Remove the mark from the current group."
-  (interactive "p")
-  (gnus-group-mark-group n 'unmark)
-  (gnus-group-position-point))
-
-(defun gnus-group-unmark-all-groups ()
-  "Unmark all groups."
-  (interactive)
-  (let ((groups gnus-group-marked))
-    (save-excursion
-      (while groups
-	(gnus-group-remove-mark (pop groups)))))
-  (gnus-group-position-point))
-
-(defun gnus-group-mark-region (unmark beg end)
-  "Mark all groups between point and mark.
-If UNMARK, remove the mark instead."
-  (interactive "P\nr")
-  (let ((num (count-lines beg end)))
-    (save-excursion
-      (goto-char beg)
-      (- num (gnus-group-mark-group num unmark)))))
-
-(defun gnus-group-mark-buffer (&optional unmark)
-  "Mark all groups in the buffer.
-If UNMARK, remove the mark instead."
-  (interactive "P")
-  (gnus-group-mark-region unmark (point-min) (point-max)))
-
-(defun gnus-group-mark-regexp (regexp)
-  "Mark all groups that match some regexp."
-  (interactive "sMark (regexp): ")
-  (let ((alist (cdr gnus-newsrc-alist))
-	group)
-    (while alist
-      (when (string-match regexp (setq group (gnus-info-group (pop alist))))
-	(gnus-group-set-mark group))))
-  (gnus-group-position-point))
-
-(defun gnus-group-remove-mark (group)
-  "Remove the process mark from GROUP and move point there.
-Return nil if the group isn't displayed."
-  (if (gnus-group-goto-group group)
-      (save-excursion
-	(gnus-group-mark-group 1 'unmark t)
-	t)
-    (setq gnus-group-marked
-	  (delete group gnus-group-marked))
-    nil))
-
-(defun gnus-group-set-mark (group)
-  "Set the process mark on GROUP."
-  (if (gnus-group-goto-group group) 
-      (save-excursion
-	(gnus-group-mark-group 1 nil t))
-    (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
-
-(defun gnus-group-universal-argument (arg &optional groups func)
-  "Perform any command on all groups accoring to the process/prefix convention."
-  (interactive "P")
-  (let ((groups (or groups (gnus-group-process-prefix arg)))
-	group func)
-    (if (eq (setq func (or func
-			   (key-binding
-			    (read-key-sequence
-			     (substitute-command-keys
-			      "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
-	    'undefined)
-	(gnus-error 1 "Undefined key")
-      (while groups
-	(gnus-group-remove-mark (setq group (pop groups)))
-	(command-execute func))))
-  (gnus-group-position-point))
-
-(defun gnus-group-process-prefix (n)
-  "Return a list of groups to work on.
-Take into consideration N (the prefix) and the list of marked groups."
-  (cond
-   (n
-    (setq n (prefix-numeric-value n))
-    ;; There is a prefix, so we return a list of the N next
-    ;; groups.
-    (let ((way (if (< n 0) -1 1))
-	  (n (abs n))
-	  group groups)
-      (save-excursion
-	(while (and (> n 0)
-		    (setq group (gnus-group-group-name)))
-	  (setq groups (cons group groups))
-	  (setq n (1- n))
-	  (gnus-group-next-group way)))
-      (nreverse groups)))
-   ((and (boundp 'transient-mark-mode)
-	 transient-mark-mode
-	 (boundp 'mark-active)
-	 mark-active)
-    ;; Work on the region between point and mark.
-    (let ((max (max (point) (mark)))
-	  groups)
-      (save-excursion
-	(goto-char (min (point) (mark)))
-	(while
-	    (and
-	     (push (gnus-group-group-name) groups)
-	     (zerop (gnus-group-next-group 1))
-	     (< (point) max)))
-	(nreverse groups))))
-   (gnus-group-marked
-    ;; No prefix, but a list of marked articles.
-    (reverse gnus-group-marked))
-   (t
-    ;; Neither marked articles or a prefix, so we return the
-    ;; current group.
-    (let ((group (gnus-group-group-name)))
-      (and group (list group))))))
-
-;; Selecting groups.
-
-(defun gnus-group-read-group (&optional all no-article group)
-  "Read news in this newsgroup.
-If the prefix argument ALL is non-nil, already read articles become
-readable.  IF ALL is a number, fetch this number of articles.  If the
-optional argument NO-ARTICLE is non-nil, no article will be
-auto-selected upon group entry.	 If GROUP is non-nil, fetch that
-group."
-  (interactive "P")
-  (let ((group (or group (gnus-group-group-name)))
-	number active marked entry)
-    (or group (error "No group on current line"))
-    (setq marked (nth 3 (nth 2 (setq entry (gnus-gethash
-					    group gnus-newsrc-hashtb)))))
-    ;; This group might be a dead group.  In that case we have to get
-    ;; the number of unread articles from `gnus-active-hashtb'.
-    (setq number
-	  (cond ((numberp all) all)
-		(entry (car entry))
-		((setq active (gnus-active group))
-		 (- (1+ (cdr active)) (car active)))))
-    (gnus-summary-read-group
-     group (or all (and (numberp number)
-			(zerop (+ number (gnus-range-length 
-					  (cdr (assq 'tick marked)))
-				  (gnus-range-length
-				   (cdr (assq 'dormant marked)))))))
-     no-article)))
-
-(defun gnus-group-select-group (&optional all)
-  "Select this newsgroup.
-No article is selected automatically.
-If ALL is non-nil, already read articles become readable.
-If ALL is a number, fetch this number of articles."
-  (interactive "P")
-  (gnus-group-read-group all t))
-
-(defun gnus-group-quick-select-group (&optional all)
-  "Select the current group \"quickly\".
-This means that no highlighting or scoring will be performed."
-  (interactive "P")
-  (let (gnus-visual
-	gnus-score-find-score-files-function
-	gnus-apply-kill-hook
-	gnus-summary-expunge-below)
-    (gnus-group-read-group all t)))
-
-(defun gnus-group-visible-select-group (&optional all)
-  "Select the current group without hiding any articles."
-  (interactive "P")
-  (let ((gnus-inhibit-limiting t))
-    (gnus-group-read-group all t)))
-
-;;;###autoload
-(defun gnus-fetch-group (group)
-  "Start Gnus if necessary and enter GROUP.
-Returns whether the fetching was successful or not."
-  (interactive "sGroup name: ")
-  (or (get-buffer gnus-group-buffer)
-      (gnus))
-  (gnus-group-read-group nil nil group))
-
-;; Enter a group that is not in the group buffer.  Non-nil is returned
-;; if selection was successful.
-(defun gnus-group-read-ephemeral-group
-  (group method &optional activate quit-config)
-  (let ((group (if (gnus-group-foreign-p group) group
-		 (gnus-group-prefixed-name group method))))
-    (gnus-sethash
-     group
-     `(t nil (,group ,gnus-level-default-subscribed nil nil ,method
-		     ((quit-config . ,(if quit-config quit-config
-					(cons (current-buffer) 'summary))))))
-     gnus-newsrc-hashtb)
-    (set-buffer gnus-group-buffer)
-    (or (gnus-check-server method)
-	(error "Unable to contact server: %s" (gnus-status-message method)))
-    (if activate (or (gnus-request-group group)
-		     (error "Couldn't request group")))
-    (condition-case ()
-	(gnus-group-read-group t t group)
-      (error nil)
-      (quit nil))))
-
-(defun gnus-group-jump-to-group (group)
-  "Jump to newsgroup GROUP."
-  (interactive
-   (list (completing-read
-	  "Group: " gnus-active-hashtb nil
-	  (gnus-read-active-file-p)
-	  nil
-	  'gnus-group-history)))
-
-  (when (equal group "")
-    (error "Empty group name"))
-
-  (when (string-match "[\000-\032]" group)
-    (error "Control characters in group: %s" group))
-
-  (let ((b (text-property-any
-	    (point-min) (point-max)
-	    'gnus-group (gnus-intern-safe group gnus-active-hashtb))))
-    (unless (gnus-ephemeral-group-p group)
-      (if b
-	  ;; Either go to the line in the group buffer...
-	  (goto-char b)
-	;; ... or insert the line.
-	(or
-	 (gnus-active group)
-	 (gnus-activate-group group)
-	 (error "%s error: %s" group (gnus-status-message group)))
-
-	(gnus-group-update-group group)
-	(goto-char (text-property-any
-		    (point-min) (point-max)
-		    'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))
-    ;; Adjust cursor point.
-    (gnus-group-position-point)))
-
-(defun gnus-group-goto-group (group)
-  "Goto to newsgroup GROUP."
-  (when group
-    (let ((b (text-property-any (point-min) (point-max)
-				'gnus-group (gnus-intern-safe
-					     group gnus-active-hashtb))))
-      (and b (goto-char b)))))
-
-(defun gnus-group-next-group (n)
-  "Go to next N'th newsgroup.
-If N is negative, search backward instead.
-Returns the difference between N and the number of skips actually
-done."
-  (interactive "p")
-  (gnus-group-next-unread-group n t))
-
-(defun gnus-group-next-unread-group (n &optional all level)
-  "Go to next N'th unread newsgroup.
-If N is negative, search backward instead.
-If ALL is non-nil, choose any newsgroup, unread or not.
-If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
-such group can be found, the next group with a level higher than
-LEVEL.
-Returns the difference between N and the number of skips actually
-made."
-  (interactive "p")
-  (let ((backward (< n 0))
-	(n (abs n)))
-    (while (and (> n 0)
-		(gnus-group-search-forward
-		 backward (or (not gnus-group-goto-unread) all) level))
-      (setq n (1- n)))
-    (if (/= 0 n) (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
-			       (if level " on this level or higher" "")))
-    n))
-
-(defun gnus-group-prev-group (n)
-  "Go to previous N'th newsgroup.
-Returns the difference between N and the number of skips actually
-done."
-  (interactive "p")
-  (gnus-group-next-unread-group (- n) t))
-
-(defun gnus-group-prev-unread-group (n)
-  "Go to previous N'th unread newsgroup.
-Returns the difference between N and the number of skips actually
-done."
-  (interactive "p")
-  (gnus-group-next-unread-group (- n)))
-
-(defun gnus-group-next-unread-group-same-level (n)
-  "Go to next N'th unread newsgroup on the same level.
-If N is negative, search backward instead.
-Returns the difference between N and the number of skips actually
-done."
-  (interactive "p")
-  (gnus-group-next-unread-group n t (gnus-group-group-level))
-  (gnus-group-position-point))
-
-(defun gnus-group-prev-unread-group-same-level (n)
-  "Go to next N'th unread newsgroup on the same level.
-Returns the difference between N and the number of skips actually
-done."
-  (interactive "p")
-  (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
-  (gnus-group-position-point))
-
-(defun gnus-group-best-unread-group (&optional exclude-group)
-  "Go to the group with the highest level.
-If EXCLUDE-GROUP, do not go to that group."
-  (interactive)
-  (goto-char (point-min))
-  (let ((best 100000)
-	unread best-point)
-    (while (not (eobp))
-      (setq unread (get-text-property (point) 'gnus-unread))
-      (if (and (numberp unread) (> unread 0))
-	  (progn
-	    (if (and (get-text-property (point) 'gnus-level)
-		     (< (get-text-property (point) 'gnus-level) best)
-		     (or (not exclude-group)
-			 (not (equal exclude-group (gnus-group-group-name)))))
-		(progn
-		  (setq best (get-text-property (point) 'gnus-level))
-		  (setq best-point (point))))))
-      (forward-line 1))
-    (if best-point (goto-char best-point))
-    (gnus-summary-position-point)
-    (and best-point (gnus-group-group-name))))
-
-(defun gnus-group-first-unread-group ()
-  "Go to the first group with unread articles."
-  (interactive)
-  (prog1
-      (let ((opoint (point))
-	    unread)
-	(goto-char (point-min))
-	(if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
-		(and (numberp unread)	; Not a topic.
-		     (not (zerop unread))) ; Has unread articles.
-		(zerop (gnus-group-next-unread-group 1))) ; Next unread group.
-	    (point)			; Success.
-	  (goto-char opoint)
-	  nil))				; Not success.
-    (gnus-group-position-point)))
-
-(defun gnus-group-enter-server-mode ()
-  "Jump to the server buffer."
-  (interactive)
-  (gnus-enter-server-buffer))
-
-(defun gnus-group-make-group (name &optional method address)
-  "Add a new newsgroup.
-The user will be prompted for a NAME, for a select METHOD, and an
-ADDRESS."
-  (interactive
-   (cons
-    (read-string "Group name: ")
-    (let ((method
-	   (completing-read
-	    "Method: " (append gnus-valid-select-methods gnus-server-alist)
-	    nil t nil 'gnus-method-history)))
-      (cond ((assoc method gnus-valid-select-methods)
-	     (list method
-		   (if (memq 'prompt-address
-			     (assoc method gnus-valid-select-methods))
-		       (read-string "Address: ")
-		     "")))
-	    ((assoc method gnus-server-alist)
-	     (list method))
-	    (t
-	     (list method ""))))))
-
-  (let* ((meth (and method (if address (list (intern method) address)
-			     method)))
-	 (nname (if method (gnus-group-prefixed-name name meth) name))
-	 backend info)
-    (when (gnus-gethash nname gnus-newsrc-hashtb)
-      (error "Group %s already exists" nname))
-    ;; Subscribe to the new group.
-    (gnus-group-change-level
-     (setq info (list t nname gnus-level-default-subscribed nil nil meth))
-     gnus-level-default-subscribed gnus-level-killed
-     (and (gnus-group-group-name)
-	  (gnus-gethash (gnus-group-group-name)
-			gnus-newsrc-hashtb))
-     t)
-    ;; Make it active.
-    (gnus-set-active nname (cons 1 0))
-    (or (gnus-ephemeral-group-p name)
-	(gnus-dribble-enter
-	 (concat "(gnus-group-set-info '" (prin1-to-string (cdr info)) ")")))
-    ;; Insert the line.
-    (gnus-group-insert-group-line-info nname)
-    (forward-line -1)
-    (gnus-group-position-point)
-
-    ;; Load the backend and try to make the backend create
-    ;; the group as well.
-    (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
-						  nil meth))))
-		 gnus-valid-select-methods)
-      (require backend))
-    (gnus-check-server meth)
-    (and (gnus-check-backend-function 'request-create-group nname)
-	 (gnus-request-create-group nname))
-    t))
-
-(defun gnus-group-delete-group (group &optional force)
-  "Delete the current group.  Only meaningful with mail groups.
-If FORCE (the prefix) is non-nil, all the articles in the group will
-be deleted.  This is \"deleted\" as in \"removed forever from the face
-of the Earth\".	 There is no undo.  The user will be prompted before
-doing the deletion."
-  (interactive
-   (list (gnus-group-group-name)
-	 current-prefix-arg))
-  (or group (error "No group to rename"))
-  (or (gnus-check-backend-function 'request-delete-group group)
-      (error "This backend does not support group deletion"))
-  (prog1
-      (if (not (gnus-yes-or-no-p
-		(format
-		 "Do you really want to delete %s%s? "
-		 group (if force " and all its contents" ""))))
-	  () ; Whew!
-	(gnus-message 6 "Deleting group %s..." group)
-	(if (not (gnus-request-delete-group group force))
-	    (gnus-error 3 "Couldn't delete group %s" group)
-	  (gnus-message 6 "Deleting group %s...done" group)
-	  (gnus-group-goto-group group)
-	  (gnus-group-kill-group 1 t)
-	  (gnus-sethash group nil gnus-active-hashtb)
-	  t))
-    (gnus-group-position-point)))
-
-(defun gnus-group-rename-group (group new-name)
-  (interactive
-   (list
-    (gnus-group-group-name)
-    (progn
-      (or (gnus-check-backend-function
-	   'request-rename-group (gnus-group-group-name))
-	  (error "This backend does not support renaming groups"))
-      (read-string "New group name: "))))
-
-  (or (gnus-check-backend-function 'request-rename-group group)
-      (error "This backend does not support renaming groups"))
-
-  (or group (error "No group to rename"))
-  (and (string-match "^[ \t]*$" new-name)
-       (error "Not a valid group name"))
-
-  ;; We find the proper prefixed name.
-  (setq new-name
-	(gnus-group-prefixed-name
-	 (gnus-group-real-name new-name)
-	 (gnus-info-method (gnus-get-info group))))
-
-  (gnus-message 6 "Renaming group %s to %s..." group new-name)
-  (prog1
-      (if (not (gnus-request-rename-group group new-name))
-	  (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
-	;; We rename the group internally by killing it...
-	(gnus-group-goto-group group)
-	(gnus-group-kill-group)
-	;; ... changing its name ...
-	(setcar (cdar gnus-list-of-killed-groups) new-name)
-	;; ... and then yanking it.  Magic!
-	(gnus-group-yank-group)
-	(gnus-set-active new-name (gnus-active group))
-	(gnus-message 6 "Renaming group %s to %s...done" group new-name)
-	new-name)
-    (gnus-group-position-point)))
-
-(defun gnus-group-edit-group (group &optional part)
-  "Edit the group on the current line."
-  (interactive (list (gnus-group-group-name)))
-  (let* ((part (or part 'info))
-	 (done-func `(lambda ()
-		       "Exit editing mode and update the information."
-		       (interactive)
-		       (gnus-group-edit-group-done ',part ,group)))
-	 (winconf (current-window-configuration))
-	 info)
-    (or group (error "No group on current line"))
-    (or (setq info (gnus-get-info group))
-	(error "Killed group; can't be edited"))
-    (set-buffer (get-buffer-create gnus-group-edit-buffer))
-    (gnus-configure-windows 'edit-group)
-    (gnus-add-current-to-buffer-list)
-    (emacs-lisp-mode)
-    ;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-    (use-local-map (copy-keymap emacs-lisp-mode-map))
-    (local-set-key "\C-c\C-c" done-func)
-    (make-local-variable 'gnus-prev-winconf)
-    (setq gnus-prev-winconf winconf)
-    (erase-buffer)
-    (insert
-     (cond
-      ((eq part 'method)
-       ";; Type `C-c C-c' after editing the select method.\n\n")
-      ((eq part 'params)
-       ";; Type `C-c C-c' after editing the group parameters.\n\n")
-      ((eq part 'info)
-       ";; Type `C-c C-c' after editing the group info.\n\n")))
-    (insert
-     (pp-to-string
-      (cond ((eq part 'method)
-	     (or (gnus-info-method info) "native"))
-	    ((eq part 'params)
-	     (gnus-info-params info))
-	    (t info)))
-     "\n")))
-
-(defun gnus-group-edit-group-method (group)
-  "Edit the select method of GROUP."
-  (interactive (list (gnus-group-group-name)))
-  (gnus-group-edit-group group 'method))
-
-(defun gnus-group-edit-group-parameters (group)
-  "Edit the group parameters of GROUP."
-  (interactive (list (gnus-group-group-name)))
-  (gnus-group-edit-group group 'params))
-
-(defun gnus-group-edit-group-done (part group)
-  "Get info from buffer, update variables and jump to the group buffer."
-  (set-buffer (get-buffer-create gnus-group-edit-buffer))
-  (goto-char (point-min))
-  (let* ((form (read (current-buffer)))
-	 (winconf gnus-prev-winconf)
-	 (method (cond ((eq part 'info) (nth 4 form))
-		       ((eq part 'method) form)
-		       (t nil)))
-	 (info (cond ((eq part 'info) form)
-		     ((eq part 'method) (gnus-get-info group))
-		     (t nil)))
-	 (new-group (if info
-		      (if (or (not method)
-			      (gnus-server-equal
-			       gnus-select-method method))
-			  (gnus-group-real-name (car info))
-			(gnus-group-prefixed-name
-			 (gnus-group-real-name (car info)) method))
-		      nil)))
-    (when (and new-group
-	       (not (equal new-group group)))
-      (when (gnus-group-goto-group group)
-	(gnus-group-kill-group 1))
-      (gnus-activate-group new-group))
-    ;; Set the info.
-    (if (and info new-group)
-	(progn
-	  (setq info (gnus-copy-sequence info))
-	  (setcar info new-group)
-	  (unless (gnus-server-equal method "native")
-	    (unless (nthcdr 3 info)
-	      (nconc info (list nil nil)))
-	    (unless (nthcdr 4 info)
-	      (nconc info (list nil)))
-	    (gnus-info-set-method info method))
-	  (gnus-group-set-info info))
-      (gnus-group-set-info form (or new-group group) part))
-    (kill-buffer (current-buffer))
-    (and winconf (set-window-configuration winconf))
-    (set-buffer gnus-group-buffer)
-    (gnus-group-update-group (or new-group group))
-    (gnus-group-position-point)))
-
-(defun gnus-group-make-help-group ()
-  "Create the Gnus documentation group."
-  (interactive)
-  (let ((path load-path)
-	(name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
-	file dir)
-    (and (gnus-gethash name gnus-newsrc-hashtb)
-	 (error "Documentation group already exists"))
-    (while path
-      (setq dir (file-name-as-directory (expand-file-name (pop path)))
-	    file nil)
-      (when (or (file-exists-p (setq file (concat dir "gnus-tut.txt")))
-		(file-exists-p
-		 (setq file (concat (file-name-directory
-				     (directory-file-name dir))
-				    "etc/gnus-tut.txt"))))
-	(setq path nil)))
-    (if (not file)
-	(gnus-message 1 "Couldn't find doc group")
-      (gnus-group-make-group
-       (gnus-group-real-name name)
-       (list 'nndoc "gnus-help"
-	     (list 'nndoc-address file)
-	     (list 'nndoc-article-type 'mbox)))))
-  (gnus-group-position-point))
-
-(defun gnus-group-make-doc-group (file type)
-  "Create a group that uses a single file as the source."
-  (interactive
-   (list (read-file-name "File name: ")
-	 (and current-prefix-arg 'ask)))
-  (when (eq type 'ask)
-    (let ((err "")
-	  char found)
-      (while (not found)
-	(message
-	 "%sFile type (mbox, babyl, digest, forward, mmfd, guess) [mbdfag]: "
-	 err)
-	(setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
-			  ((= char ?b) 'babyl)
-			  ((= char ?d) 'digest)
-			  ((= char ?f) 'forward)
-			  ((= char ?a) 'mmfd)
-			  (t (setq err (format "%c unknown. " char))
-			     nil))))
-      (setq type found)))
-  (let* ((file (expand-file-name file))
-	 (name (gnus-generate-new-group-name
-		(gnus-group-prefixed-name
-		 (file-name-nondirectory file) '(nndoc "")))))
-    (gnus-group-make-group
-     (gnus-group-real-name name)
-     (list 'nndoc (file-name-nondirectory file)
-	   (list 'nndoc-address file)
-	   (list 'nndoc-article-type (or type 'guess))))))
-
-(defun gnus-group-make-archive-group (&optional all)
-  "Create the (ding) Gnus archive group of the most recent articles.
-Given a prefix, create a full group."
-  (interactive "P")
-  (let ((group (gnus-group-prefixed-name
-		(if all "ding.archives" "ding.recent") '(nndir ""))))
-    (and (gnus-gethash group gnus-newsrc-hashtb)
-	 (error "Archive group already exists"))
-    (gnus-group-make-group
-     (gnus-group-real-name group)
-     (list 'nndir (if all "hpc" "edu")
-	   (list 'nndir-directory
-		 (if all gnus-group-archive-directory
-		   gnus-group-recent-archive-directory))))))
-
-(defun gnus-group-make-directory-group (dir)
-  "Create an nndir group.
-The user will be prompted for a directory.  The contents of this
-directory will be used as a newsgroup.	The directory should contain
-mail messages or news articles in files that have numeric names."
-  (interactive
-   (list (read-file-name "Create group from directory: ")))
-  (or (file-exists-p dir) (error "No such directory"))
-  (or (file-directory-p dir) (error "Not a directory"))
-  (let ((ext "")
-	(i 0)
-	group)
-    (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
-      (setq group
-	    (gnus-group-prefixed-name
-	     (concat (file-name-as-directory (directory-file-name dir))
-		     ext)
-	     '(nndir "")))
-      (setq ext (format "<%d>" (setq i (1+ i)))))
-    (gnus-group-make-group
-     (gnus-group-real-name group)
-     (list 'nndir group (list 'nndir-directory dir)))))
-
-(defun gnus-group-make-kiboze-group (group address scores)
-  "Create an nnkiboze group.
-The user will be prompted for a name, a regexp to match groups, and
-score file entries for articles to include in the group."
-  (interactive
-   (list
-    (read-string "nnkiboze group name: ")
-    (read-string "Source groups (regexp): ")
-    (let ((headers (mapcar (lambda (group) (list group))
-			   '("subject" "from" "number" "date" "message-id"
-			     "references" "chars" "lines" "xref"
-			     "followup" "all" "body" "head")))
-	  scores header regexp regexps)
-      (while (not (equal "" (setq header (completing-read
-					  "Match on header: " headers nil t))))
-	(setq regexps nil)
-	(while (not (equal "" (setq regexp (read-string
-					    (format "Match on %s (string): "
-						    header)))))
-	  (setq regexps (cons (list regexp nil nil 'r) regexps)))
-	(setq scores (cons (cons header regexps) scores)))
-      scores)))
-  (gnus-group-make-group group "nnkiboze" address)
-  (nnheader-temp-write (gnus-score-file-name (concat "nnkiboze:" group))
-    (let (emacs-lisp-mode-hook)
-      (pp scores (current-buffer)))))
-
-(defun gnus-group-add-to-virtual (n vgroup)
-  "Add the current group to a virtual group."
-  (interactive
-   (list current-prefix-arg
-	 (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
-			  "nnvirtual:")))
-  (or (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
-      (error "%s is not an nnvirtual group" vgroup))
-  (let* ((groups (gnus-group-process-prefix n))
-	 (method (gnus-info-method (gnus-get-info vgroup))))
-    (setcar (cdr method)
-	    (concat
-	     (nth 1 method) "\\|"
-	     (mapconcat
-	      (lambda (s)
-		(gnus-group-remove-mark s)
-		(concat "\\(^" (regexp-quote s) "$\\)"))
-	      groups "\\|"))))
-  (gnus-group-position-point))
-
-(defun gnus-group-make-empty-virtual (group)
-  "Create a new, fresh, empty virtual group."
-  (interactive "sCreate new, empty virtual group: ")
-  (let* ((method (list 'nnvirtual "^$"))
-	 (pgroup (gnus-group-prefixed-name group method)))
-    ;; Check whether it exists already.
-    (and (gnus-gethash pgroup gnus-newsrc-hashtb)
-	 (error "Group %s already exists." pgroup))
-    ;; Subscribe the new group after the group on the current line.
-    (gnus-subscribe-group pgroup (gnus-group-group-name) method)
-    (gnus-group-update-group pgroup)
-    (forward-line -1)
-    (gnus-group-position-point)))
-
-(defun gnus-group-enter-directory (dir)
-  "Enter an ephemeral nneething group."
-  (interactive "DDirectory to read: ")
-  (let* ((method (list 'nneething dir '(nneething-read-only t)))
-	 (leaf (gnus-group-prefixed-name
-		(file-name-nondirectory (directory-file-name dir))
-		method))
-	 (name (gnus-generate-new-group-name leaf)))
-    (unless (gnus-group-read-ephemeral-group
-	     name method t
-	     (cons (current-buffer)
-		   (if (eq major-mode 'gnus-summary-mode)
-		       'summary 'group)))
-      (error "Couldn't enter %s" dir))))
-
-;; Group sorting commands
-;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
-
-(defun gnus-group-sort-groups (func &optional reverse)
-  "Sort the group buffer according to FUNC.
-If REVERSE, reverse the sorting order."
-  (interactive (list gnus-group-sort-function
-		     current-prefix-arg))
-  (let ((func (cond 
-	       ((not (listp func)) func)
-	       ((null func) func)
-	       ((= 1 (length func)) (car func))
-	       (t `(lambda (t1 t2)
-		     ,(gnus-make-sort-function 
-		       (reverse func)))))))
-    ;; We peel off the dummy group from the alist.
-    (when func
-      (when (equal (car (gnus-info-group gnus-newsrc-alist)) "dummy.group")
-	(pop gnus-newsrc-alist))
-      ;; Do the sorting.
-      (setq gnus-newsrc-alist
-	    (sort gnus-newsrc-alist func))
-      (when reverse
-	(setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
-      ;; Regenerate the hash table.
-      (gnus-make-hashtable-from-newsrc-alist)
-      (gnus-group-list-groups))))
-
-(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
-  "Sort the group buffer alphabetically by group name.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
-
-(defun gnus-group-sort-groups-by-unread (&optional reverse)
-  "Sort the group buffer by number of unread articles.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
-
-(defun gnus-group-sort-groups-by-level (&optional reverse)
-  "Sort the group buffer by group level.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
-
-(defun gnus-group-sort-groups-by-score (&optional reverse)
-  "Sort the group buffer by group score.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
-
-(defun gnus-group-sort-groups-by-rank (&optional reverse)
-  "Sort the group buffer by group rank.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
-
-(defun gnus-group-sort-groups-by-method (&optional reverse)
-  "Sort the group buffer alphabetically by backend name.
-If REVERSE, sort in reverse order."
-  (interactive "P")
-  (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
-
-(defun gnus-group-sort-by-alphabet (info1 info2)
-  "Sort alphabetically."
-  (string< (gnus-info-group info1) (gnus-info-group info2)))
-
-(defun gnus-group-sort-by-unread (info1 info2)
-  "Sort by number of unread articles."
-  (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
-	(n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
-    (< (or (and (numberp n1) n1) 0)
-       (or (and (numberp n2) n2) 0))))
-
-(defun gnus-group-sort-by-level (info1 info2)
-  "Sort by level."
-  (< (gnus-info-level info1) (gnus-info-level info2)))
-
-(defun gnus-group-sort-by-method (info1 info2)
-  "Sort alphabetically by backend name."
-  (string< (symbol-name (car (gnus-find-method-for-group
-			      (gnus-info-group info1) info1)))
-	   (symbol-name (car (gnus-find-method-for-group
-			      (gnus-info-group info2) info2)))))
-
-(defun gnus-group-sort-by-score (info1 info2)
-  "Sort by group score."
-  (< (gnus-info-score info1) (gnus-info-score info2)))
-
-(defun gnus-group-sort-by-rank (info1 info2)
-  "Sort by level and score."
-  (let ((level1 (gnus-info-level info1))
-	(level2 (gnus-info-level info2)))
-    (or (< level1 level2)
-	(and (= level1 level2)
-	     (> (gnus-info-score info1) (gnus-info-score info2))))))
-
-;; Group catching up.
-
-(defun gnus-group-clear-data (n)
-  "Clear all marks and read ranges from the current group."
-  (interactive "P")
-  (let ((groups (gnus-group-process-prefix n))
-	group info)
-    (while (setq group (pop groups))
-      (setq info (gnus-get-info group))
-      (gnus-info-set-read info nil)
-      (when (gnus-info-marks info)
-	(gnus-info-set-marks info nil))
-      (gnus-get-unread-articles-in-group info (gnus-active group) t)
-      (when (gnus-group-goto-group group)
-	(gnus-group-remove-mark group)
-	(gnus-group-update-group-line)))))
-
-(defun gnus-group-catchup-current (&optional n all)
-  "Mark all articles not marked as unread in current newsgroup as read.
-If prefix argument N is numeric, the ARG next newsgroups will be
-caught up.  If ALL is non-nil, marked articles will also be marked as
-read.  Cross references (Xref: header) of articles are ignored.
-The difference between N and actual number of newsgroups that were
-caught up is returned."
-  (interactive "P")
-  (unless (gnus-group-group-name)
-    (error "No group on the current line"))
-  (if (not (or (not gnus-interactive-catchup) ;Without confirmation?
-	       gnus-expert-user
-	       (gnus-y-or-n-p
-		(if all
-		    "Do you really want to mark all articles as read? "
-		  "Mark all unread articles as read? "))))
-      n
-    (let ((groups (gnus-group-process-prefix n))
-	  (ret 0))
-      (while groups
-	;; Virtual groups have to be given special treatment.
-	(let ((method (gnus-find-method-for-group (car groups))))
-	  (if (eq 'nnvirtual (car method))
-	      (nnvirtual-catchup-group
-	       (gnus-group-real-name (car groups)) (nth 1 method) all)))
-	(gnus-group-remove-mark (car groups))
-	(if (>= (gnus-group-group-level) gnus-level-zombie)
-	    (gnus-message 2 "Dead groups can't be caught up")
-	  (if (prog1
-		  (gnus-group-goto-group (car groups))
-		(gnus-group-catchup (car groups) all))
-	      (gnus-group-update-group-line)
-	    (setq ret (1+ ret))))
-	(setq groups (cdr groups)))
-      (gnus-group-next-unread-group 1)
-      ret)))
-
-(defun gnus-group-catchup-current-all (&optional n)
-  "Mark all articles in current newsgroup as read.
-Cross references (Xref: header) of articles are ignored."
-  (interactive "P")
-  (gnus-group-catchup-current n 'all))
-
-(defun gnus-group-catchup (group &optional all)
-  "Mark all articles in GROUP as read.
-If ALL is non-nil, all articles are marked as read.
-The return value is the number of articles that were marked as read,
-or nil if no action could be taken."
-  (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
-	 (num (car entry)))
-    ;; Do the updating only if the newsgroup isn't killed.
-    (if (not (numberp (car entry)))
-	(gnus-message 1 "Can't catch up; non-active group")
-      ;; Do auto-expirable marks if that's required.
-      (when (gnus-group-auto-expirable-p group)
-	(gnus-add-marked-articles
-	 group 'expire (gnus-list-of-unread-articles group))
-	(when all
-	  (let ((marks (nth 3 (nth 2 entry))))
-	    (gnus-add-marked-articles
-	     group 'expire (gnus-uncompress-range (cdr (assq 'tick marks))))
-	    (gnus-add-marked-articles
-	     group 'expire (gnus-uncompress-range (cdr (assq 'tick marks)))))))
-      (when entry
-	(gnus-update-read-articles group nil)
-	;; Also nix out the lists of marks and dormants.
-	(when all
-	  (gnus-add-marked-articles group 'tick nil nil 'force)
-	  (gnus-add-marked-articles group 'dormant nil nil 'force))
-	(run-hooks 'gnus-group-catchup-group-hook)
-	num))))
-
-(defun gnus-group-expire-articles (&optional n)
-  "Expire all expirable articles in the current newsgroup."
-  (interactive "P")
-  (let ((groups (gnus-group-process-prefix n))
-	group)
-    (unless groups
-      (error "No groups to expire"))
-    (while (setq group (pop groups))
-      (gnus-group-remove-mark group)
-      (when (gnus-check-backend-function 'request-expire-articles group)
-	(gnus-message 6 "Expiring articles in %s..." group)
-	(let* ((info (gnus-get-info group))
-	       (expirable (if (gnus-group-total-expirable-p group)
-			      (cons nil (gnus-list-of-read-articles group))
-			    (assq 'expire (gnus-info-marks info))))
-	       (expiry-wait (gnus-group-get-parameter group 'expiry-wait)))
-	  (when expirable
-	    (setcdr
-	     expirable
-	     (gnus-compress-sequence
-	      (if expiry-wait
-		  ;; We set the expiry variables to the groupp
-		  ;; parameter. 
-		  (let ((nnmail-expiry-wait-function nil)
-			(nnmail-expiry-wait expiry-wait))
-		    (gnus-request-expire-articles
-		     (gnus-uncompress-sequence (cdr expirable)) group))
-		;; Just expire using the normal expiry values.
-		(gnus-request-expire-articles
-		 (gnus-uncompress-sequence (cdr expirable)) group))))
-	    (gnus-close-group group))
-	  (gnus-message 6 "Expiring articles in %s...done" group)))
-      (gnus-group-position-point))))
-
-(defun gnus-group-expire-all-groups ()
-  "Expire all expirable articles in all newsgroups."
-  (interactive)
-  (save-excursion
-    (gnus-message 5 "Expiring...")
-    (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
-				     (cdr gnus-newsrc-alist))))
-      (gnus-group-expire-articles nil)))
-  (gnus-group-position-point)
-  (gnus-message 5 "Expiring...done"))
-
-(defun gnus-group-set-current-level (n level)
-  "Set the level of the next N groups to LEVEL."
-  (interactive
-   (list
-    current-prefix-arg
-    (string-to-int
-     (let ((s (read-string
-	       (format "Level (default %s): "
-		       (or (gnus-group-group-level) 
-			   gnus-level-default-subscribed)))))
-       (if (string-match "^\\s-*$" s)
-	   (int-to-string (or (gnus-group-group-level) 
-			      gnus-level-default-subscribed))
-	 s)))))
-  (or (and (>= level 1) (<= level gnus-level-killed))
-      (error "Illegal level: %d" level))
-  (let ((groups (gnus-group-process-prefix n))
-	group)
-    (while (setq group (pop groups))
-      (gnus-group-remove-mark group)
-      (gnus-message 6 "Changed level of %s from %d to %d"
-		    group (or (gnus-group-group-level) gnus-level-killed)
-		    level)
-      (gnus-group-change-level
-       group level (or (gnus-group-group-level) gnus-level-killed))
-      (gnus-group-update-group-line)))
-  (gnus-group-position-point))
-
-(defun gnus-group-unsubscribe-current-group (&optional n)
-  "Toggle subscription of the current group.
-If given numerical prefix, toggle the N next groups."
-  (interactive "P")
-  (let ((groups (gnus-group-process-prefix n))
-	group)
-    (while groups
-      (setq group (car groups)
-	    groups (cdr groups))
-      (gnus-group-remove-mark group)
-      (gnus-group-unsubscribe-group
-       group (if (<= (gnus-group-group-level) gnus-level-subscribed)
-		 gnus-level-default-unsubscribed
-	       gnus-level-default-subscribed) t)
-      (gnus-group-update-group-line))
-    (gnus-group-next-group 1)))
-
-(defun gnus-group-unsubscribe-group (group &optional level silent)
-  "Toggle subscription to GROUP.
-Killed newsgroups are subscribed.  If SILENT, don't try to update the
-group line."
-  (interactive
-   (list (completing-read
-	  "Group: " gnus-active-hashtb nil
-	  (gnus-read-active-file-p)
-	  nil 
-	  'gnus-group-history)))
-  (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
-    (cond
-     ((string-match "^[ \t]$" group)
-      (error "Empty group name"))
-     (newsrc
-      ;; Toggle subscription flag.
-      (gnus-group-change-level
-       newsrc (if level level (if (<= (nth 1 (nth 2 newsrc))
-				      gnus-level-subscribed)
-				  (1+ gnus-level-subscribed)
-				gnus-level-default-subscribed)))
-      (unless silent
-	(gnus-group-update-group group)))
-     ((and (stringp group)
-	   (or (not (gnus-read-active-file-p))
-	       (gnus-active group)))
-      ;; Add new newsgroup.
-      (gnus-group-change-level
-       group
-       (if level level gnus-level-default-subscribed)
-       (or (and (member group gnus-zombie-list)
-		gnus-level-zombie)
-	   gnus-level-killed)
-       (and (gnus-group-group-name)
-	    (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
-      (unless silent
-	(gnus-group-update-group group)))
-     (t (error "No such newsgroup: %s" group)))
-    (gnus-group-position-point)))
-
-(defun gnus-group-transpose-groups (n)
-  "Move the current newsgroup up N places.
-If given a negative prefix, move down instead.	The difference between
-N and the number of steps taken is returned."
-  (interactive "p")
-  (or (gnus-group-group-name)
-      (error "No group on current line"))
-  (gnus-group-kill-group 1)
-  (prog1
-      (forward-line (- n))
-    (gnus-group-yank-group)
-    (gnus-group-position-point)))
-
-(defun gnus-group-kill-all-zombies ()
-  "Kill all zombie newsgroups."
-  (interactive)
-  (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
-  (setq gnus-zombie-list nil)
-  (gnus-group-list-groups))
-
-(defun gnus-group-kill-region (begin end)
-  "Kill newsgroups in current region (excluding current point).
-The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
-  (interactive "r")
-  (let ((lines
-	 ;; Count lines.
-	 (save-excursion
-	   (count-lines
-	    (progn
-	      (goto-char begin)
-	      (beginning-of-line)
-	      (point))
-	    (progn
-	      (goto-char end)
-	      (beginning-of-line)
-	      (point))))))
-    (goto-char begin)
-    (beginning-of-line)			;Important when LINES < 1
-    (gnus-group-kill-group lines)))
-
-(defun gnus-group-kill-group (&optional n discard)
-  "Kill the next N groups.
-The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
-However, only groups that were alive can be yanked; already killed
-groups or zombie groups can't be yanked.
-The return value is the name of the group that was killed, or a list
-of groups killed."
-  (interactive "P")
-  (let ((buffer-read-only nil)
-	(groups (gnus-group-process-prefix n))
-	group entry level out)
-    (if (< (length groups) 10)
-	;; This is faster when there are few groups.
-	(while groups
-	  (push (setq group (pop groups)) out)
-	  (gnus-group-remove-mark group)
-	  (setq level (gnus-group-group-level))
-	  (gnus-delete-line)
-	  (when (and (not discard)
-		     (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
-	    (push (cons (car entry) (nth 2 entry))
-		  gnus-list-of-killed-groups))
-	  (gnus-group-change-level
-	   (if entry entry group) gnus-level-killed (if entry nil level)))
-      ;; If there are lots and lots of groups to be killed, we use
-      ;; this thing instead.
-      (let (entry)
-	(setq groups (nreverse groups))
-	(while groups
-	  (gnus-group-remove-mark (setq group (pop groups)))
-	  (gnus-delete-line)
-	  (push group gnus-killed-list)
-	  (setq gnus-newsrc-alist
-		(delq (assoc group gnus-newsrc-alist)
-		      gnus-newsrc-alist))
-	  (when gnus-group-change-level-function
-	    (funcall gnus-group-change-level-function group 9 3))
-	  (cond
-	   ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
-	    (push (cons (car entry) (nth 2 entry))
-		  gnus-list-of-killed-groups)
-	    (setcdr (cdr entry) (cdddr entry)))
-	   ((member group gnus-zombie-list)
-	    (setq gnus-zombie-list (delete group gnus-zombie-list)))))
-	(gnus-make-hashtable-from-newsrc-alist)))
-
-    (gnus-group-position-point)
-    (if (< (length out) 2) (car out) (nreverse out))))
-
-(defun gnus-group-yank-group (&optional arg)
-  "Yank the last newsgroups killed with \\[gnus-group-kill-group],
-inserting it before the current newsgroup.  The numeric ARG specifies
-how many newsgroups are to be yanked.  The name of the newsgroup yanked
-is returned, or (if several groups are yanked) a list of yanked groups
-is returned."
-  (interactive "p")
-  (setq arg (or arg 1))
-  (let (info group prev out)
-    (while (>= (decf arg) 0)
-      (if (not (setq info (pop gnus-list-of-killed-groups)))
-	  (error "No more newsgroups to yank"))
-      (push (setq group (nth 1 info)) out)
-      ;; Find which newsgroup to insert this one before - search
-      ;; backward until something suitable is found.  If there are no
-      ;; other newsgroups in this buffer, just make this newsgroup the
-      ;; first newsgroup.
-      (setq prev (gnus-group-group-name))
-      (gnus-group-change-level
-       info (gnus-info-level (cdr info)) gnus-level-killed
-       (and prev (gnus-gethash prev gnus-newsrc-hashtb))
-       t)
-      (gnus-group-insert-group-line-info group))
-    (forward-line -1)
-    (gnus-group-position-point)
-    (if (< (length out) 2) (car out) (nreverse out))))
-
-(defun gnus-group-kill-level (level)
-  "Kill all groups that is on a certain LEVEL."
-  (interactive "nKill all groups on level: ")
-  (cond
-   ((= level gnus-level-zombie)
-    (setq gnus-killed-list
-	  (nconc gnus-zombie-list gnus-killed-list))
-    (setq gnus-zombie-list nil))
-   ((and (< level gnus-level-zombie)
-	 (> level 0)
-	 (or gnus-expert-user
-	     (gnus-yes-or-no-p
-	      (format
-	       "Do you really want to kill all groups on level %d? "
-	       level))))
-    (let* ((prev gnus-newsrc-alist)
-	   (alist (cdr prev)))
-      (while alist
-	(if (= (gnus-info-level (car alist)) level)
-	    (progn
-	      (push (gnus-info-group (car alist)) gnus-killed-list)
-	      (setcdr prev (cdr alist)))
-	  (setq prev alist))
-	(setq alist (cdr alist)))
-      (gnus-make-hashtable-from-newsrc-alist)
-      (gnus-group-list-groups)))
-   (t
-    (error "Can't kill; illegal level: %d" level))))
-
-(defun gnus-group-list-all-groups (&optional arg)
-  "List all newsgroups with level ARG or lower.
-Default is gnus-level-unsubscribed, which lists all subscribed and most
-unsubscribed groups."
-  (interactive "P")
-  (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
-
-;; Redefine this to list ALL killed groups if prefix arg used.
-;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
-(defun gnus-group-list-killed (&optional arg)
-  "List all killed newsgroups in the group buffer.
-If ARG is non-nil, list ALL killed groups known to Gnus.  This may
-entail asking the server for the groups."
-  (interactive "P")
-  ;; Find all possible killed newsgroups if arg.
-  (when arg
-    (gnus-get-killed-groups))
-  (if (not gnus-killed-list)
-      (gnus-message 6 "No killed groups")
-    (let (gnus-group-list-mode)
-      (funcall gnus-group-prepare-function
-	       gnus-level-killed t gnus-level-killed))
-    (goto-char (point-min)))
-  (gnus-group-position-point))
-
-(defun gnus-group-list-zombies ()
-  "List all zombie newsgroups in the group buffer."
-  (interactive)
-  (if (not gnus-zombie-list)
-      (gnus-message 6 "No zombie groups")
-    (let (gnus-group-list-mode)
-      (funcall gnus-group-prepare-function
-	       gnus-level-zombie t gnus-level-zombie))
-    (goto-char (point-min)))
-  (gnus-group-position-point))
-
-(defun gnus-group-list-active ()
-  "List all groups that are available from the server(s)."
-  (interactive)
-  ;; First we make sure that we have really read the active file.
-  (unless (gnus-read-active-file-p)
-    (let ((gnus-read-active-file t))
-      (gnus-read-active-file)))
-  ;; Find all groups and sort them.
-  (let ((groups
-	 (sort
-	  (let (list)
-	    (mapatoms
-	     (lambda (sym)
-	       (and (boundp sym)
-		    (symbol-value sym)
-		    (setq list (cons (symbol-name sym) list))))
-	     gnus-active-hashtb)
-	    list)
-	  'string<))
-	(buffer-read-only nil))
-    (erase-buffer)
-    (while groups
-      (gnus-group-insert-group-line-info (pop groups)))
-    (goto-char (point-min))))
-
-(defun gnus-activate-all-groups (level)
-  "Activate absolutely all groups."
-  (interactive (list 7))
-  (let ((gnus-activate-level level)
-	(gnus-activate-foreign-newsgroups level))
-    (gnus-group-get-new-news)))
-
-(defun gnus-group-get-new-news (&optional arg)
-  "Get newly arrived articles.
-If ARG is a number, it specifies which levels you are interested in
-re-scanning.  If ARG is non-nil and not a number, this will force
-\"hard\" re-reading of the active files from all servers."
-  (interactive "P")
-  (run-hooks 'gnus-get-new-news-hook)
-  ;; We might read in new NoCeM messages here.
-  (when (and gnus-use-nocem 
-	     (null arg))
-    (gnus-nocem-scan-groups))
-  ;; If ARG is not a number, then we read the active file.
-  (when (and arg (not (numberp arg)))
-    (let ((gnus-read-active-file t))
-      (gnus-read-active-file))
-    (setq arg nil))
-
-  (setq arg (gnus-group-default-level arg t))
-  (if (and gnus-read-active-file (not arg))
-      (progn
-	(gnus-read-active-file)
-	(gnus-get-unread-articles arg))
-    (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
-      (gnus-get-unread-articles arg)))
-  (run-hooks 'gnus-after-getting-new-news-hook)
-  (gnus-group-list-groups))
-
-(defun gnus-group-get-new-news-this-group (&optional n)
-  "Check for newly arrived news in the current group (and the N-1 next groups).
-The difference between N and the number of newsgroup checked is returned.
-If N is negative, this group and the N-1 previous groups will be checked."
-  (interactive "P")
-  (let* ((groups (gnus-group-process-prefix n))
-	 (ret (if (numberp n) (- n (length groups)) 0))
-	 (beg (unless n (point)))
-	 group)
-    (while (setq group (pop groups))
-      (gnus-group-remove-mark group)
-      (if (gnus-activate-group group 'scan)
-	  (progn
-	    (gnus-get-unread-articles-in-group
-	     (gnus-get-info group) (gnus-active group) t)
-	    (unless (gnus-virtual-group-p group)
-	      (gnus-close-group group))
-	    (gnus-group-update-group group))
-	(if (eq (gnus-server-status (gnus-find-method-for-group group))
-		'denied)
-	    (gnus-error "Server denied access")
-	  (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
-    (when beg (goto-char beg))
-    (when gnus-goto-next-group-when-activating
-      (gnus-group-next-unread-group 1 t))
-    (gnus-summary-position-point)
-    ret))
-
-(defun gnus-group-fetch-faq (group &optional faq-dir)
-  "Fetch the FAQ for the current group."
-  (interactive
-   (list
-    (and (gnus-group-group-name)
-	 (gnus-group-real-name (gnus-group-group-name)))
-    (cond (current-prefix-arg
-	   (completing-read
-	    "Faq dir: " (and (listp gnus-group-faq-directory)
-			     (mapcar (lambda (file) (list file))
-				     gnus-group-faq-directory)))))))
-  (or faq-dir
-      (setq faq-dir (if (listp gnus-group-faq-directory)
-			(car gnus-group-faq-directory)
-		      gnus-group-faq-directory)))
-  (or group (error "No group name given"))
-  (let ((file (concat (file-name-as-directory faq-dir)
-		      (gnus-group-real-name group))))
-    (if (not (file-exists-p file))
-	(error "No such file: %s" file)
-      (find-file file))))
-
-(defun gnus-group-describe-group (force &optional group)
-  "Display a description of the current newsgroup."
-  (interactive (list current-prefix-arg (gnus-group-group-name)))
-  (let* ((method (gnus-find-method-for-group group))
-	 (mname (gnus-group-prefixed-name "" method))
-	 desc)
-    (when (and force
-	       gnus-description-hashtb)
-      (gnus-sethash mname nil gnus-description-hashtb))
-    (or group (error "No group name given"))
-    (and (or (and gnus-description-hashtb
-		  ;; We check whether this group's method has been
-		  ;; queried for a description file.
-		  (gnus-gethash mname gnus-description-hashtb))
-	     (setq desc (gnus-group-get-description group))
-	     (gnus-read-descriptions-file method))
-	 (gnus-message 1
-	  (or desc (gnus-gethash group gnus-description-hashtb)
-	      "No description available")))))
-
-;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-group-describe-all-groups (&optional force)
-  "Pop up a buffer with descriptions of all newsgroups."
-  (interactive "P")
-  (and force (setq gnus-description-hashtb nil))
-  (if (not (or gnus-description-hashtb
-	       (gnus-read-all-descriptions-files)))
-      (error "Couldn't request descriptions file"))
-  (let ((buffer-read-only nil)
-	b)
-    (erase-buffer)
-    (mapatoms
-     (lambda (group)
-       (setq b (point))
-       (insert (format "      *: %-20s %s\n" (symbol-name group)
-		       (symbol-value group)))
-       (gnus-add-text-properties
-	b (1+ b) (list 'gnus-group group
-		       'gnus-unread t 'gnus-marked nil
-		       'gnus-level (1+ gnus-level-subscribed))))
-     gnus-description-hashtb)
-    (goto-char (point-min))
-    (gnus-group-position-point)))
-
-;; Suggested by by Daniel Quinlan <quinlan@best.com>.
-(defun gnus-group-apropos (regexp &optional search-description)
-  "List all newsgroups that have names that match a regexp."
-  (interactive "sGnus apropos (regexp): ")
-  (let ((prev "")
-	(obuf (current-buffer))
-	groups des)
-    ;; Go through all newsgroups that are known to Gnus.
-    (mapatoms
-     (lambda (group)
-       (and (symbol-name group)
-	    (string-match regexp (symbol-name group))
-	    (setq groups (cons (symbol-name group) groups))))
-     gnus-active-hashtb)
-    ;; Also go through all descriptions that are known to Gnus.
-    (when search-description
-      (mapatoms
-       (lambda (group)
-	 (and (string-match regexp (symbol-value group))
-	      (gnus-active (symbol-name group))
-	      (setq groups (cons (symbol-name group) groups))))
-       gnus-description-hashtb))
-    (if (not groups)
-	(gnus-message 3 "No groups matched \"%s\"." regexp)
-      ;; Print out all the groups.
-      (save-excursion
-	(pop-to-buffer "*Gnus Help*")
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)
-	(setq groups (sort groups 'string<))
-	(while groups
-	  ;; Groups may be entered twice into the list of groups.
-	  (if (not (string= (car groups) prev))
-	      (progn
-		(insert (setq prev (car groups)) "\n")
-		(if (and gnus-description-hashtb
-			 (setq des (gnus-gethash (car groups)
-						 gnus-description-hashtb)))
-		    (insert "  " des "\n"))))
-	  (setq groups (cdr groups)))
-	(goto-char (point-min))))
-    (pop-to-buffer obuf)))
-
-(defun gnus-group-description-apropos (regexp)
-  "List all newsgroups that have names or descriptions that match a regexp."
-  (interactive "sGnus description apropos (regexp): ")
-  (if (not (or gnus-description-hashtb
-	       (gnus-read-all-descriptions-files)))
-      (error "Couldn't request descriptions file"))
-  (gnus-group-apropos regexp t))
-
-;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-group-list-matching (level regexp &optional all lowest)
-  "List all groups with unread articles that match REGEXP.
-If the prefix LEVEL is non-nil, it should be a number that says which
-level to cut off listing groups.
-If ALL, also list groups with no unread articles.
-If LOWEST, don't list groups with level lower than LOWEST.
-
-This command may read the active file."
-  (interactive "P\nsList newsgroups matching: ")
-  ;; First make sure active file has been read.
-  (when (and level
-	     (> (prefix-numeric-value level) gnus-level-killed))
-    (gnus-get-killed-groups))
-  (gnus-group-prepare-flat (or level gnus-level-subscribed)
-			   all (or lowest 1) regexp)
-  (goto-char (point-min))
-  (gnus-group-position-point))
-
-(defun gnus-group-list-all-matching (level regexp &optional lowest)
-  "List all groups that match REGEXP.
-If the prefix LEVEL is non-nil, it should be a number that says which
-level to cut off listing groups.
-If LOWEST, don't list groups with level lower than LOWEST."
-  (interactive "P\nsList newsgroups matching: ")
-  (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
-
-;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
-(defun gnus-group-save-newsrc (&optional force)
-  "Save the Gnus startup files.
-If FORCE, force saving whether it is necessary or not."
-  (interactive "P")
-  (gnus-save-newsrc-file force))
-
-(defun gnus-group-restart (&optional arg)
-  "Force Gnus to read the .newsrc file."
-  (interactive "P")
-  (when (gnus-yes-or-no-p
-	 (format "Are you sure you want to read %s? "
-		 gnus-current-startup-file))
-    (gnus-save-newsrc-file)
-    (gnus-setup-news 'force)
-    (gnus-group-list-groups arg)))
-
-(defun gnus-group-read-init-file ()
-  "Read the Gnus elisp init file."
-  (interactive)
-  (gnus-read-init-file))
-
-(defun gnus-group-check-bogus-groups (&optional silent)
-  "Check bogus newsgroups.
-If given a prefix, don't ask for confirmation before removing a bogus
-group."
-  (interactive "P")
-  (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
-  (gnus-group-list-groups))
-
-(defun gnus-group-edit-global-kill (&optional article group)
-  "Edit the global kill file.
-If GROUP, edit that local kill file instead."
-  (interactive "P")
-  (setq gnus-current-kill-article article)
-  (gnus-kill-file-edit-file group)
-  (gnus-message
-   6
-   (substitute-command-keys
-    (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
-	    (if group "local" "global")))))
-
-(defun gnus-group-edit-local-kill (article group)
-  "Edit a local kill file."
-  (interactive (list nil (gnus-group-group-name)))
-  (gnus-group-edit-global-kill article group))
-
-(defun gnus-group-force-update ()
-  "Update `.newsrc' file."
-  (interactive)
-  (gnus-save-newsrc-file))
-
-(defun gnus-group-suspend ()
-  "Suspend the current Gnus session.
-In fact, cleanup buffers except for group mode buffer.
-The hook gnus-suspend-gnus-hook is called before actually suspending."
-  (interactive)
-  (run-hooks 'gnus-suspend-gnus-hook)
-  ;; Kill Gnus buffers except for group mode buffer.
-  (let* ((group-buf (get-buffer gnus-group-buffer))
-	 ;; Do this on a separate list in case the user does a ^G before we finish
-	 (gnus-buffer-list
-	  (delete group-buf (delete gnus-dribble-buffer
-				    (append gnus-buffer-list nil)))))
-    (while gnus-buffer-list
-      (gnus-kill-buffer (pop gnus-buffer-list)))
-    (gnus-kill-gnus-frames)
-    (when group-buf
-      (setq gnus-buffer-list (list group-buf))
-      (bury-buffer group-buf)
-      (delete-windows-on group-buf t))))
-
-(defun gnus-group-clear-dribble ()
-  "Clear all information from the dribble buffer."
-  (interactive)
-  (gnus-dribble-clear)
-  (gnus-message 7 "Cleared dribble buffer"))
-
-(defun gnus-group-exit ()
-  "Quit reading news after updating .newsrc.eld and .newsrc.
-The hook `gnus-exit-gnus-hook' is called before actually exiting."
-  (interactive)
-  (when 
-      (or noninteractive		;For gnus-batch-kill
-	  (not gnus-interactive-exit)	;Without confirmation
-	  gnus-expert-user
-	  (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
-    (run-hooks 'gnus-exit-gnus-hook)
-    ;; Offer to save data from non-quitted summary buffers.
-    (gnus-offer-save-summaries)
-    ;; Save the newsrc file(s).
-    (gnus-save-newsrc-file)
-    ;; Kill-em-all.
-    (gnus-close-backends)
-    ;; Reset everything.
-    (gnus-clear-system)
-    ;; Allow the user to do things after cleaning up.
-    (run-hooks 'gnus-after-exiting-gnus-hook)))
-
-(defun gnus-close-backends ()
-  ;; Send a close request to all backends that support such a request.
-  (let ((methods gnus-valid-select-methods)
-	func)
-    (while methods
-      (if (fboundp (setq func (intern (concat (caar methods)
-					      "-request-close"))))
-	  (funcall func))
-      (setq methods (cdr methods)))))
-
-(defun gnus-group-quit ()
-  "Quit reading news without updating .newsrc.eld or .newsrc.
-The hook `gnus-exit-gnus-hook' is called before actually exiting."
-  (interactive)
-  (when (or noninteractive		;For gnus-batch-kill
-	    (zerop (buffer-size))
-	    (not (gnus-server-opened gnus-select-method))
-	    gnus-expert-user
-	    (not gnus-current-startup-file)
-	    (gnus-yes-or-no-p
-	     (format "Quit reading news without saving %s? "
-		     (file-name-nondirectory gnus-current-startup-file))))
-    (run-hooks 'gnus-exit-gnus-hook)
-    (if gnus-use-full-window
-	(delete-other-windows)
-      (gnus-remove-some-windows))
-    (gnus-dribble-save)
-    (gnus-close-backends)
-    (gnus-clear-system)
-    ;; Allow the user to do things after cleaning up.
-    (run-hooks 'gnus-after-exiting-gnus-hook)))
-
-(defun gnus-offer-save-summaries ()
-  "Offer to save all active summary buffers."
-  (save-excursion
-    (let ((buflist (buffer-list))
-	  buffers bufname)
-      ;; Go through all buffers and find all summaries.
-      (while buflist
-	(and (setq bufname (buffer-name (car buflist)))
-	     (string-match "Summary" bufname)
-	     (save-excursion
-	       (set-buffer bufname)
-	       ;; We check that this is, indeed, a summary buffer.
-	       (and (eq major-mode 'gnus-summary-mode)
-		    ;; Also make sure this isn't bogus.
-		    gnus-newsgroup-prepared))
-	     (push bufname buffers))
-	(setq buflist (cdr buflist)))
-      ;; Go through all these summary buffers and offer to save them.
-      (when buffers
-	(map-y-or-n-p
-	 "Update summary buffer %s? "
-	 (lambda (buf) (set-buffer buf) (gnus-summary-exit))
-	 buffers)))))
-
-(defun gnus-group-describe-briefly ()
-  "Give a one line description of the group mode commands."
-  (interactive)
-  (gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select  \\[gnus-group-next-unread-group]:Forward  \\[gnus-group-prev-unread-group]:Backward  \\[gnus-group-exit]:Exit  \\[gnus-info-find-node]:Run Info  \\[gnus-group-describe-briefly]:This help")))
-
-(defun gnus-group-browse-foreign-server (method)
-  "Browse a foreign news server.
-If called interactively, this function will ask for a select method
- (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
-If not, METHOD should be a list where the first element is the method
-and the second element is the address."
-  (interactive
-   (list (let ((how (completing-read
-		     "Which backend: "
-		     (append gnus-valid-select-methods gnus-server-alist)
-		     nil t (cons "nntp" 0) 'gnus-method-history)))
-	   ;; We either got a backend name or a virtual server name.
-	   ;; If the first, we also need an address.
-	   (if (assoc how gnus-valid-select-methods)
-	       (list (intern how)
-		     ;; Suggested by mapjph@bath.ac.uk.
-		     (completing-read
-		      "Address: "
-		      (mapcar (lambda (server) (list server))
-			      gnus-secondary-servers)))
-	     ;; We got a server name, so we find the method.
-	     (gnus-server-to-method how)))))
-  (gnus-browse-foreign-server method))
-
-
-;;;
-;;; Gnus summary mode
-;;;
-
-(defvar gnus-summary-mode-map nil)
-
-(put 'gnus-summary-mode 'mode-class 'special)
-
-(unless gnus-summary-mode-map
-  (setq gnus-summary-mode-map (make-keymap))
-  (suppress-keymap gnus-summary-mode-map)
-
-  ;; Non-orthogonal keys
-
-  (gnus-define-keys gnus-summary-mode-map
-    " " gnus-summary-next-page
-    "\177" gnus-summary-prev-page
-    [delete] gnus-summary-prev-page
-    "\r" gnus-summary-scroll-up
-    "n" gnus-summary-next-unread-article
-    "p" gnus-summary-prev-unread-article
-    "N" gnus-summary-next-article
-    "P" gnus-summary-prev-article
-    "\M-\C-n" gnus-summary-next-same-subject
-    "\M-\C-p" gnus-summary-prev-same-subject
-    "\M-n" gnus-summary-next-unread-subject
-    "\M-p" gnus-summary-prev-unread-subject
-    "." gnus-summary-first-unread-article
-    "," gnus-summary-best-unread-article
-    "\M-s" gnus-summary-search-article-forward
-    "\M-r" gnus-summary-search-article-backward
-    "<" gnus-summary-beginning-of-article
-    ">" gnus-summary-end-of-article
-    "j" gnus-summary-goto-article
-    "^" gnus-summary-refer-parent-article
-    "\M-^" gnus-summary-refer-article
-    "u" gnus-summary-tick-article-forward
-    "!" gnus-summary-tick-article-forward
-    "U" gnus-summary-tick-article-backward
-    "d" gnus-summary-mark-as-read-forward
-    "D" gnus-summary-mark-as-read-backward
-    "E" gnus-summary-mark-as-expirable
-    "\M-u" gnus-summary-clear-mark-forward
-    "\M-U" gnus-summary-clear-mark-backward
-    "k" gnus-summary-kill-same-subject-and-select
-    "\C-k" gnus-summary-kill-same-subject
-    "\M-\C-k" gnus-summary-kill-thread
-    "\M-\C-l" gnus-summary-lower-thread
-    "e" gnus-summary-edit-article
-    "#" gnus-summary-mark-as-processable
-    "\M-#" gnus-summary-unmark-as-processable
-    "\M-\C-t" gnus-summary-toggle-threads
-    "\M-\C-s" gnus-summary-show-thread
-    "\M-\C-h" gnus-summary-hide-thread
-    "\M-\C-f" gnus-summary-next-thread
-    "\M-\C-b" gnus-summary-prev-thread
-    "\M-\C-u" gnus-summary-up-thread
-    "\M-\C-d" gnus-summary-down-thread
-    "&" gnus-summary-execute-command
-    "c" gnus-summary-catchup-and-exit
-    "\C-w" gnus-summary-mark-region-as-read
-    "\C-t" gnus-summary-toggle-truncation
-    "?" gnus-summary-mark-as-dormant
-    "\C-c\M-\C-s" gnus-summary-limit-include-expunged
-    "\C-c\C-s\C-n" gnus-summary-sort-by-number
-    "\C-c\C-s\C-a" gnus-summary-sort-by-author
-    "\C-c\C-s\C-s" gnus-summary-sort-by-subject
-    "\C-c\C-s\C-d" gnus-summary-sort-by-date
-    "\C-c\C-s\C-i" gnus-summary-sort-by-score
-    "=" gnus-summary-expand-window
-    "\C-x\C-s" gnus-summary-reselect-current-group
-    "\M-g" gnus-summary-rescan-group
-    "w" gnus-summary-stop-page-breaking
-    "\C-c\C-r" gnus-summary-caesar-message
-    "\M-t" gnus-summary-toggle-mime
-    "f" gnus-summary-followup
-    "F" gnus-summary-followup-with-original
-    "C" gnus-summary-cancel-article
-    "r" gnus-summary-reply
-    "R" gnus-summary-reply-with-original
-    "\C-c\C-f" gnus-summary-mail-forward
-    "o" gnus-summary-save-article
-    "\C-o" gnus-summary-save-article-mail
-    "|" gnus-summary-pipe-output
-    "\M-k" gnus-summary-edit-local-kill
-    "\M-K" gnus-summary-edit-global-kill
-    "V" gnus-version
-    "\C-c\C-d" gnus-summary-describe-group
-    "q" gnus-summary-exit
-    "Q" gnus-summary-exit-no-update
-    "\C-c\C-i" gnus-info-find-node
-    gnus-mouse-2 gnus-mouse-pick-article
-    "m" gnus-summary-mail-other-window
-    "a" gnus-summary-post-news
-    "x" gnus-summary-limit-to-unread
-    "s" gnus-summary-isearch-article
-    "t" gnus-article-hide-headers
-    "g" gnus-summary-show-article
-    "l" gnus-summary-goto-last-article
-    "\C-c\C-v\C-v" gnus-uu-decode-uu-view
-    "\C-d" gnus-summary-enter-digest-group
-    "\C-c\C-b" gnus-bug
-    "*" gnus-cache-enter-article
-    "\M-*" gnus-cache-remove-article
-    "\M-&" gnus-summary-universal-argument
-    "\C-l" gnus-recenter
-    "I" gnus-summary-increase-score
-    "L" gnus-summary-lower-score
-
-    "V" gnus-summary-score-map
-    "X" gnus-uu-extract-map
-    "S" gnus-summary-send-map)
-
-  ;; Sort of orthogonal keymap
-  (gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
-    "t" gnus-summary-tick-article-forward
-    "!" gnus-summary-tick-article-forward
-    "d" gnus-summary-mark-as-read-forward
-    "r" gnus-summary-mark-as-read-forward
-    "c" gnus-summary-clear-mark-forward
-    " " gnus-summary-clear-mark-forward
-    "e" gnus-summary-mark-as-expirable
-    "x" gnus-summary-mark-as-expirable
-    "?" gnus-summary-mark-as-dormant
-    "b" gnus-summary-set-bookmark
-    "B" gnus-summary-remove-bookmark
-    "#" gnus-summary-mark-as-processable
-    "\M-#" gnus-summary-unmark-as-processable
-    "S" gnus-summary-limit-include-expunged
-    "C" gnus-summary-catchup
-    "H" gnus-summary-catchup-to-here
-    "\C-c" gnus-summary-catchup-all
-    "k" gnus-summary-kill-same-subject-and-select
-    "K" gnus-summary-kill-same-subject
-    "P" gnus-uu-mark-map)
-
-  (gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mode-map)
-    "c" gnus-summary-clear-above
-    "u" gnus-summary-tick-above
-    "m" gnus-summary-mark-above
-    "k" gnus-summary-kill-below)
-
-  (gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
-    "/" gnus-summary-limit-to-subject
-    "n" gnus-summary-limit-to-articles
-    "w" gnus-summary-pop-limit
-    "s" gnus-summary-limit-to-subject
-    "a" gnus-summary-limit-to-author
-    "u" gnus-summary-limit-to-unread
-    "m" gnus-summary-limit-to-marks
-    "v" gnus-summary-limit-to-score
-    "D" gnus-summary-limit-include-dormant
-    "d" gnus-summary-limit-exclude-dormant
-    ;;  "t" gnus-summary-limit-exclude-thread
-    "E" gnus-summary-limit-include-expunged
-    "c" gnus-summary-limit-exclude-childless-dormant
-    "C" gnus-summary-limit-mark-excluded-as-read)
-
-  (gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
-    "n" gnus-summary-next-unread-article
-    "p" gnus-summary-prev-unread-article
-    "N" gnus-summary-next-article
-    "P" gnus-summary-prev-article
-    "\C-n" gnus-summary-next-same-subject
-    "\C-p" gnus-summary-prev-same-subject
-    "\M-n" gnus-summary-next-unread-subject
-    "\M-p" gnus-summary-prev-unread-subject
-    "f" gnus-summary-first-unread-article
-    "b" gnus-summary-best-unread-article
-    "j" gnus-summary-goto-article
-    "g" gnus-summary-goto-subject
-    "l" gnus-summary-goto-last-article
-    "p" gnus-summary-pop-article)
-
-  (gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
-    "k" gnus-summary-kill-thread
-    "l" gnus-summary-lower-thread
-    "i" gnus-summary-raise-thread
-    "T" gnus-summary-toggle-threads
-    "t" gnus-summary-rethread-current
-    "^" gnus-summary-reparent-thread
-    "s" gnus-summary-show-thread
-    "S" gnus-summary-show-all-threads
-    "h" gnus-summary-hide-thread
-    "H" gnus-summary-hide-all-threads
-    "n" gnus-summary-next-thread
-    "p" gnus-summary-prev-thread
-    "u" gnus-summary-up-thread
-    "o" gnus-summary-top-thread
-    "d" gnus-summary-down-thread
-    "#" gnus-uu-mark-thread
-    "\M-#" gnus-uu-unmark-thread)
-
-  (gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
-    "c" gnus-summary-catchup-and-exit
-    "C" gnus-summary-catchup-all-and-exit
-    "E" gnus-summary-exit-no-update
-    "Q" gnus-summary-exit
-    "Z" gnus-summary-exit
-    "n" gnus-summary-catchup-and-goto-next-group
-    "R" gnus-summary-reselect-current-group
-    "G" gnus-summary-rescan-group
-    "N" gnus-summary-next-group
-    "P" gnus-summary-prev-group)
-
-  (gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
-    " " gnus-summary-next-page
-    "n" gnus-summary-next-page
-    "\177" gnus-summary-prev-page
-    [delete] gnus-summary-prev-page
-    "p" gnus-summary-prev-page
-    "\r" gnus-summary-scroll-up
-    "<" gnus-summary-beginning-of-article
-    ">" gnus-summary-end-of-article
-    "b" gnus-summary-beginning-of-article
-    "e" gnus-summary-end-of-article
-    "^" gnus-summary-refer-parent-article
-    "r" gnus-summary-refer-parent-article
-    "R" gnus-summary-refer-references
-    "g" gnus-summary-show-article
-    "s" gnus-summary-isearch-article)
-
-  (gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
-    "b" gnus-article-add-buttons
-    "B" gnus-article-add-buttons-to-head
-    "o" gnus-article-treat-overstrike
-    ;;  "w" gnus-article-word-wrap
-    "w" gnus-article-fill-cited-article
-    "c" gnus-article-remove-cr
-    "L" gnus-article-remove-trailing-blank-lines
-    "q" gnus-article-de-quoted-unreadable
-    "f" gnus-article-display-x-face
-    "l" gnus-summary-stop-page-breaking
-    "r" gnus-summary-caesar-message
-    "t" gnus-article-hide-headers
-    "v" gnus-summary-verbose-headers
-    "m" gnus-summary-toggle-mime)
-
-  (gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
-    "a" gnus-article-hide
-    "h" gnus-article-hide-headers
-    "b" gnus-article-hide-boring-headers
-    "s" gnus-article-hide-signature
-    "c" gnus-article-hide-citation
-    "p" gnus-article-hide-pgp
-    "\C-c" gnus-article-hide-citation-maybe)
-
-  (gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
-    "a" gnus-article-highlight
-    "h" gnus-article-highlight-headers
-    "c" gnus-article-highlight-citation
-    "s" gnus-article-highlight-signature)
-
-  (gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
-    "z" gnus-article-date-ut
-    "u" gnus-article-date-ut
-    "l" gnus-article-date-local
-    "e" gnus-article-date-lapsed
-    "o" gnus-article-date-original)
-
-  (gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
-    "v" gnus-version
-    "f" gnus-summary-fetch-faq
-    "d" gnus-summary-describe-group
-    "h" gnus-summary-describe-briefly
-    "i" gnus-info-find-node)
-
-  (gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
-    "e" gnus-summary-expire-articles
-    "\M-\C-e" gnus-summary-expire-articles-now
-    "\177" gnus-summary-delete-article
-    [delete] gnus-summary-delete-article
-    "m" gnus-summary-move-article
-    "r" gnus-summary-respool-article
-    "w" gnus-summary-edit-article
-    "c" gnus-summary-copy-article
-    "B" gnus-summary-crosspost-article
-    "q" gnus-summary-respool-query
-    "i" gnus-summary-import-article)
-
-  (gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
-    "o" gnus-summary-save-article
-    "m" gnus-summary-save-article-mail
-    "r" gnus-summary-save-article-rmail
-    "f" gnus-summary-save-article-file
-    "b" gnus-summary-save-article-body-file
-    "h" gnus-summary-save-article-folder
-    "v" gnus-summary-save-article-vm
-    "p" gnus-summary-pipe-output
-    "s" gnus-soup-add-article)
-  )
-
-
-
-(defun gnus-summary-mode (&optional group)
-  "Major mode for reading articles.
-
-All normal editing commands are switched off.
-\\<gnus-summary-mode-map>
-Each line in this buffer represents one article.  To read an
-article, you can, for instance, type `\\[gnus-summary-next-page]'.  To move forwards
-and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
-respectively.
-
-You can also post articles and send mail from this buffer.  To
-follow up an article, type `\\[gnus-summary-followup]'.	 To mail a reply to the author
-of an article, type `\\[gnus-summary-reply]'.
-
-There are approx. one gazillion commands you can execute in this
-buffer; read the info pages for more information (`\\[gnus-info-find-node]').
-
-The following commands are available:
-
-\\{gnus-summary-mode-map}"
-  (interactive)
-  (when (and menu-bar-mode
-	     (gnus-visual-p 'summary-menu 'menu))
-    (gnus-summary-make-menu-bar))
-  (kill-all-local-variables)
-  (gnus-summary-make-local-variables)
-  (gnus-make-thread-indent-array)
-  (gnus-simplify-mode-line)
-  (setq major-mode 'gnus-summary-mode)
-  (setq mode-name "Summary")
-  (make-local-variable 'minor-mode-alist)
-  (use-local-map gnus-summary-mode-map)
-  (buffer-disable-undo (current-buffer))
-  (setq buffer-read-only t)		;Disable modification
-  (setq truncate-lines t)
-  (setq selective-display t)
-  (setq selective-display-ellipses t)	;Display `...'
-  (setq buffer-display-table gnus-summary-display-table)
-  (setq gnus-newsgroup-name group)
-  (make-local-variable 'gnus-summary-line-format)
-  (make-local-variable 'gnus-summary-line-format-spec)
-  (make-local-variable 'gnus-summary-mark-positions)
-  (gnus-make-local-hook 'post-command-hook)
-  (gnus-add-hook 'post-command-hook 'gnus-clear-inboxes-moved nil t)
-  (run-hooks 'gnus-summary-mode-hook))
-
-(defun gnus-summary-make-local-variables ()
-  "Make all the local summary buffer variables."
-  (let ((locals gnus-summary-local-variables)
-	global local)
-    (while (setq local (pop locals))
-      (if (consp local)
-	  (progn
-	    (if (eq (cdr local) 'global)
-		;; Copy the global value of the variable.
-		(setq global (symbol-value (car local)))
-	      ;; Use the value from the list.
-	      (setq global (eval (cdr local))))
-	    (make-local-variable (car local))
-	    (set (car local) global))
-	;; Simple nil-valued local variable.
-	(make-local-variable local)
-	(set local nil)))))
-
-(defun gnus-summary-make-display-table ()
-  ;; Change the display table.	Odd characters have a tendency to mess
-  ;; up nicely formatted displays - we make all possible glyphs
-  ;; display only a single character.
-
-  ;; We start from the standard display table, if any.
-  (setq gnus-summary-display-table
-	(or (copy-sequence standard-display-table)
-	    (make-display-table)))
-  ;; Nix out all the control chars...
-  (let ((i 32))
-    (while (>= (setq i (1- i)) 0)
-      (aset gnus-summary-display-table i [??])))
-  ;; ... but not newline and cr, of course. (cr is necessary for the
-  ;; selective display).
-  (aset gnus-summary-display-table ?\n nil)
-  (aset gnus-summary-display-table ?\r nil)
-  ;; We nix out any glyphs over 126 that are not set already.
-  (let ((i 256))
-    (while (>= (setq i (1- i)) 127)
-      ;; Only modify if the entry is nil.
-      (or (aref gnus-summary-display-table i)
-	  (aset gnus-summary-display-table i [??])))))
-
-(defun gnus-summary-clear-local-variables ()
-  (let ((locals gnus-summary-local-variables))
-    (while locals
-      (if (consp (car locals))
-	  (and (vectorp (caar locals))
-	       (set (caar locals) nil))
-	(and (vectorp (car locals))
-	     (set (car locals) nil)))
-      (setq locals (cdr locals)))))
-
-;; Summary data functions.
-
-(defmacro gnus-data-number (data)
-  `(car ,data))
-
-(defmacro gnus-data-set-number (data number)
-  `(setcar ,data ,number))
-
-(defmacro gnus-data-mark (data)
-  `(nth 1 ,data))
-
-(defmacro gnus-data-set-mark (data mark)
-  `(setcar (nthcdr 1 ,data) ,mark))
-
-(defmacro gnus-data-pos (data)
-  `(nth 2 ,data))
-
-(defmacro gnus-data-set-pos (data pos)
-  `(setcar (nthcdr 2 ,data) ,pos))
-
-(defmacro gnus-data-header (data)
-  `(nth 3 ,data))
-
-(defmacro gnus-data-level (data)
-  `(nth 4 ,data))
-
-(defmacro gnus-data-unread-p (data)
-  `(= (nth 1 ,data) gnus-unread-mark))
-
-(defmacro gnus-data-pseudo-p (data)
-  `(consp (nth 3 ,data)))
-
-(defmacro gnus-data-find (number)
-  `(assq ,number gnus-newsgroup-data))
-
-(defmacro gnus-data-find-list (number &optional data)
-  `(let ((bdata ,(or data 'gnus-newsgroup-data)))
-     (memq (assq ,number bdata)
-	   bdata)))
-
-(defmacro gnus-data-make (number mark pos header level)
-  `(list ,number ,mark ,pos ,header ,level))
-
-(defun gnus-data-enter (after-article number mark pos header level offset)
-  (let ((data (gnus-data-find-list after-article)))
-    (or data (error "No such article: %d" after-article))
-    (setcdr data (cons (gnus-data-make number mark pos header level)
-		       (cdr data)))
-    (setq gnus-newsgroup-data-reverse nil)
-    (gnus-data-update-list (cddr data) offset)))
-
-(defun gnus-data-enter-list (after-article list &optional offset)
-  (when list
-    (let ((data (and after-article (gnus-data-find-list after-article)))
-	  (ilist list))
-      (or data (not after-article) (error "No such article: %d" after-article))
-      ;; Find the last element in the list to be spliced into the main
-      ;; list.
-      (while (cdr list)
-	(setq list (cdr list)))
-      (if (not data)
-	  (progn
-	    (setcdr list gnus-newsgroup-data)
-	    (setq gnus-newsgroup-data ilist)
-	    (and offset (gnus-data-update-list (cdr list) offset)))
-	(setcdr list (cdr data))
-	(setcdr data ilist)
-	(and offset (gnus-data-update-list (cdr data) offset)))
-      (setq gnus-newsgroup-data-reverse nil))))
-
-(defun gnus-data-remove (article &optional offset)
-  (let ((data gnus-newsgroup-data))
-    (if (= (gnus-data-number (car data)) article)
-	(setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
-	      gnus-newsgroup-data-reverse nil)
-      (while (cdr data)
-	(and (= (gnus-data-number (cadr data)) article)
-	     (progn
-	       (setcdr data (cddr data))
-	       (and offset (gnus-data-update-list (cdr data) offset))
-	       (setq data nil
-		     gnus-newsgroup-data-reverse nil)))
-	(setq data (cdr data))))))
-
-(defmacro gnus-data-list (backward)
-  `(if ,backward
-       (or gnus-newsgroup-data-reverse
-	   (setq gnus-newsgroup-data-reverse
-		 (reverse gnus-newsgroup-data)))
-     gnus-newsgroup-data))
-
-(defun gnus-data-update-list (data offset)
-  "Add OFFSET to the POS of all data entries in DATA."
-  (while data
-    (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
-    (setq data (cdr data))))
-
-(defun gnus-data-compute-positions ()
-  "Compute the positions of all articles."
-  (let ((data gnus-newsgroup-data)
-	pos)
-    (while data
-      (when (setq pos (text-property-any
-		       (point-min) (point-max)
-		       'gnus-number (gnus-data-number (car data))))
-	(gnus-data-set-pos (car data) (+ pos 3)))
-      (setq data (cdr data)))))
-
-(defun gnus-summary-article-pseudo-p (article)
-  "Say whether this article is a pseudo article or not."
-  (not (vectorp (gnus-data-header (gnus-data-find article)))))
-
-(defun gnus-article-parent-p (number)
-  "Say whether this article is a parent or not."
-  (let ((data (gnus-data-find-list number)))
-    (and (cdr data)			; There has to be an article after...
-	 (< (gnus-data-level (car data)) ; And it has to have a higher level.
-	    (gnus-data-level (nth 1 data))))))
-
-(defun gnus-article-children (number)
-  "Return a list of all children to NUMBER."
-  (let* ((data (gnus-data-find-list number))
-	 (level (gnus-data-level (car data)))
-	 children)
-    (setq data (cdr data))
-    (while (and data		
-		(= (gnus-data-level (car data)) (1+ level)))
-      (push (gnus-data-number (car data)) children)
-      (setq data (cdr data)))
-    children))
-
-(defmacro gnus-summary-skip-intangible ()
-  "If the current article is intangible, then jump to a different article."
-  '(let ((to (get-text-property (point) 'gnus-intangible)))
-    (and to (gnus-summary-goto-subject to))))
-
-(defmacro gnus-summary-article-intangible-p ()
-  "Say whether this article is intangible or not."
-  '(get-text-property (point) 'gnus-intangible))
-
-;; Some summary mode macros.
-
-(defmacro gnus-summary-article-number ()
-  "The article number of the article on the current line.
-If there isn's an article number here, then we return the current
-article number."
-  '(progn
-     (gnus-summary-skip-intangible)
-     (or (get-text-property (point) 'gnus-number)
-	 (gnus-summary-last-subject))))
-
-(defmacro gnus-summary-article-header (&optional number)
-  `(gnus-data-header (gnus-data-find
-		      ,(or number '(gnus-summary-article-number)))))
-
-(defmacro gnus-summary-thread-level (&optional number)
-  `(if (and (eq gnus-summary-make-false-root 'dummy)
-	    (get-text-property (point) 'gnus-intangible))
-       0
-     (gnus-data-level (gnus-data-find
-		       ,(or number '(gnus-summary-article-number))))))
-
-(defmacro gnus-summary-article-mark (&optional number)
-  `(gnus-data-mark (gnus-data-find
-		    ,(or number '(gnus-summary-article-number)))))
-
-(defmacro gnus-summary-article-pos (&optional number)
-  `(gnus-data-pos (gnus-data-find
-		   ,(or number '(gnus-summary-article-number)))))
-
-(defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
-(defmacro gnus-summary-article-subject (&optional number)
-  "Return current subject string or nil if nothing."
-  `(let ((headers
-	  ,(if number
-	       `(gnus-data-header (assq ,number gnus-newsgroup-data))
-	     '(gnus-data-header (assq (gnus-summary-article-number)
-				      gnus-newsgroup-data)))))
-     (and headers
-	  (vectorp headers)
-	  (mail-header-subject headers))))
-
-(defmacro gnus-summary-article-score (&optional number)
-  "Return current article score."
-  `(or (cdr (assq ,(or number '(gnus-summary-article-number))
-		  gnus-newsgroup-scored))
-       gnus-summary-default-score 0))
-
-(defun gnus-summary-article-children (&optional number)
-  (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
-	 (level (gnus-data-level (car data)))
-	 l children)
-    (while (and (setq data (cdr data))
-		(> (setq l (gnus-data-level (car data))) level))
-      (and (= (1+ level) l)
-	   (setq children (cons (gnus-data-number (car data))
-				children))))
-    (nreverse children)))
-
-(defun gnus-summary-article-parent (&optional number)
-  (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
-				    (gnus-data-list t)))
-	 (level (gnus-data-level (car data))))
-    (if (zerop level)
-	() ; This is a root.
-      ;; We search until we find an article with a level less than
-      ;; this one.  That function has to be the parent.
-      (while (and (setq data (cdr data))
-		  (not (< (gnus-data-level (car data)) level))))
-      (and data (gnus-data-number (car data))))))
-
-(defun gnus-unread-mark-p (mark)
-  "Say whether MARK is the unread mark."
-  (= mark gnus-unread-mark))
-
-(defun gnus-read-mark-p (mark)
-  "Say whether MARK is one of the marks that mark as read.
-This is all marks except unread, ticked, dormant, and expirable."
-  (not (or (= mark gnus-unread-mark)
-	   (= mark gnus-ticked-mark)
-	   (= mark gnus-dormant-mark)
-	   (= mark gnus-expirable-mark))))
-
-;; Saving hidden threads.
-
-(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
-(put 'gnus-save-hidden-threads 'lisp-indent-hook 0)
-(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
-
-(defmacro gnus-save-hidden-threads (&rest forms)
-  "Save hidden threads, eval FORMS, and restore the hidden threads."
-  (let ((config (make-symbol "config")))
-    `(let ((,config (gnus-hidden-threads-configuration)))
-       (unwind-protect
-	   (progn
-	     ,@forms)
-	 (gnus-restore-hidden-threads-configuration ,config)))))
-
-(defun gnus-hidden-threads-configuration ()
-  "Return the current hidden threads configuration."
-  (save-excursion
-    (let (config)
-      (goto-char (point-min))
-      (while (search-forward "\r" nil t)
-	(push (1- (point)) config))
-      config)))
-
-(defun gnus-restore-hidden-threads-configuration (config)
-  "Restore hidden threads configuration from CONFIG."
-  (let (point buffer-read-only)
-    (while (setq point (pop config))
-      (when (and (< point (point-max))
-		 (goto-char point)
-		 (= (following-char) ?\n))
-	(subst-char-in-region point (1+ point) ?\n ?\r)))))
-
-;; Various summary mode internalish functions.
-
-(defun gnus-mouse-pick-article (e)
-  (interactive "e")
-  (mouse-set-point e)
-  (gnus-summary-next-page nil t))
-
-(defun gnus-summary-setup-buffer (group)
-  "Initialize summary buffer."
-  (let ((buffer (concat "*Summary " group "*")))
-    (if (get-buffer buffer)
-	(progn
-	  (set-buffer buffer)
-	  (setq gnus-summary-buffer (current-buffer))
-	  (not gnus-newsgroup-prepared))
-      ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
-      (setq gnus-summary-buffer (set-buffer (get-buffer-create buffer)))
-      (gnus-add-current-to-buffer-list)
-      (gnus-summary-mode group)
-      (when gnus-carpal
-	(gnus-carpal-setup-buffer 'summary))
-      (unless gnus-single-article-buffer
-	(make-local-variable 'gnus-article-buffer)
-	(make-local-variable 'gnus-article-current)
-	(make-local-variable 'gnus-original-article-buffer))
-      (setq gnus-newsgroup-name group)
-      t)))
-
-(defun gnus-set-global-variables ()
-  ;; Set the global equivalents of the summary buffer-local variables
-  ;; to the latest values they had.  These reflect the summary buffer
-  ;; that was in action when the last article was fetched.
-  (when (eq major-mode 'gnus-summary-mode)
-    (setq gnus-summary-buffer (current-buffer))
-    (let ((name gnus-newsgroup-name)
-	  (marked gnus-newsgroup-marked)
-	  (unread gnus-newsgroup-unreads)
-	  (headers gnus-current-headers)
-	  (data gnus-newsgroup-data)
-	  (summary gnus-summary-buffer)
-	  (article-buffer gnus-article-buffer)
-	  (original gnus-original-article-buffer)
-	  (gac gnus-article-current)
-	  (score-file gnus-current-score-file))
-      (save-excursion
-	(set-buffer gnus-group-buffer)
-	(setq gnus-newsgroup-name name)
-	(setq gnus-newsgroup-marked marked)
-	(setq gnus-newsgroup-unreads unread)
-	(setq gnus-current-headers headers)
-	(setq gnus-newsgroup-data data)
-	(setq gnus-article-current gac)
-	(setq gnus-summary-buffer summary)
-	(setq gnus-article-buffer article-buffer)
-	(setq gnus-original-article-buffer original)
-	(setq gnus-current-score-file score-file)))))
-
-(defun gnus-summary-last-article-p (&optional article)
-  "Return whether ARTICLE is the last article in the buffer."
-  (if (not (setq article (or article (gnus-summary-article-number))))
-      t ; All non-existant numbers are the last article. :-)
-    (not (cdr (gnus-data-find-list article)))))
-
-(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
-  "Insert a dummy root in the summary buffer."
-  (beginning-of-line)
-  (gnus-add-text-properties
-   (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
-   (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
-
-(defun gnus-make-thread-indent-array ()
-  (let ((n 200))
-    (unless (and gnus-thread-indent-array
-		 (= gnus-thread-indent-level gnus-thread-indent-array-level))
-      (setq gnus-thread-indent-array (make-vector 201 "")
-	    gnus-thread-indent-array-level gnus-thread-indent-level)
-      (while (>= n 0)
-	(aset gnus-thread-indent-array n
-	      (make-string (* n gnus-thread-indent-level) ? ))
-	(setq n (1- n))))))
-
-(defun gnus-summary-insert-line
-  (gnus-tmp-header gnus-tmp-level gnus-tmp-current gnus-tmp-unread
-		   gnus-tmp-replied gnus-tmp-expirable gnus-tmp-subject-or-nil
-		   &optional gnus-tmp-dummy gnus-tmp-score gnus-tmp-process)
-  (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
-	 (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
-	 (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
-	 (gnus-tmp-score-char
-	  (if (or (null gnus-summary-default-score)
-		  (<= (abs (- gnus-tmp-score gnus-summary-default-score))
-		      gnus-summary-zcore-fuzz)) ? 
-	    (if (< gnus-tmp-score gnus-summary-default-score)
-		gnus-score-below-mark gnus-score-over-mark)))
-	 (gnus-tmp-replied (cond (gnus-tmp-process gnus-process-mark)
-				 ((memq gnus-tmp-current gnus-newsgroup-cached)
-				  gnus-cached-mark)
-				 (gnus-tmp-replied gnus-replied-mark)
-				 ((memq gnus-tmp-current gnus-newsgroup-saved)
-				  gnus-saved-mark)
-				 (t gnus-unread-mark)))
-	 (gnus-tmp-from (mail-header-from gnus-tmp-header))
-	 (gnus-tmp-name
-	  (cond
-	   ((string-match "(.+)" gnus-tmp-from)
-	    (substring gnus-tmp-from
-		       (1+ (match-beginning 0)) (1- (match-end 0))))
-	   ((string-match "<[^>]+> *$" gnus-tmp-from)
-	    (let ((beg (match-beginning 0)))
-	      (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
-		       (substring gnus-tmp-from (1+ (match-beginning 0))
-				  (1- (match-end 0))))
-		  (substring gnus-tmp-from 0 beg))))
-	   (t gnus-tmp-from)))
-	 (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
-	 (gnus-tmp-number (mail-header-number gnus-tmp-header))
-	 (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
-	 (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
-	 (buffer-read-only nil))
-    (when (string= gnus-tmp-name "")
-      (setq gnus-tmp-name gnus-tmp-from))
-    (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
-    (gnus-put-text-property
-     (point)
-     (progn (eval gnus-summary-line-format-spec) (point))
-     'gnus-number gnus-tmp-number)
-    (when (gnus-visual-p 'summary-highlight 'highlight)
-      (forward-line -1)
-      (run-hooks 'gnus-summary-update-hook)
-      (forward-line 1))))
-
-(defun gnus-summary-update-line (&optional dont-update)
-  ;; Update summary line after change.
-  (when (and gnus-summary-default-score
-	     (not gnus-summary-inhibit-highlight))
-    (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
-	   (article (gnus-summary-article-number))
-	   (score (gnus-summary-article-score article)))
-      (unless dont-update
-	(if (and gnus-summary-mark-below
-		 (< (gnus-summary-article-score)
-		    gnus-summary-mark-below))
-	    ;; This article has a low score, so we mark it as read.
-	    (when (memq article gnus-newsgroup-unreads)
-	      (gnus-summary-mark-article-as-read gnus-low-score-mark))
-	  (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
-	    ;; This article was previously marked as read on account
-	    ;; of a low score, but now it has risen, so we mark it as
-	    ;; unread.
-	    (gnus-summary-mark-article-as-unread gnus-unread-mark)))
-	(gnus-summary-update-mark
-	 (if (or (null gnus-summary-default-score)
-		 (<= (abs (- score gnus-summary-default-score))
-		     gnus-summary-zcore-fuzz)) ? 
-	   (if (< score gnus-summary-default-score)
-	       gnus-score-below-mark gnus-score-over-mark)) 'score))
-      ;; Do visual highlighting.
-      (when (gnus-visual-p 'summary-highlight 'highlight)
-	(run-hooks 'gnus-summary-update-hook)))))
-
-(defvar gnus-tmp-new-adopts nil)
-
-(defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
-  ;; Sum up all elements (and sub-elements) in a list.
-  (let* ((number
-	  ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
-	  (cond
-	   ((and (consp thread) (cdr thread))
-	    (apply
-	     '+ 1 (mapcar
-		   'gnus-summary-number-of-articles-in-thread (cdr thread))))
-	   ((null thread)
-	    1)
-	   ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
-	    1)
-	   (t 0))))
-    (when (and level (zerop level) gnus-tmp-new-adopts)
-      (incf number
-	    (apply '+ (mapcar
-		       'gnus-summary-number-of-articles-in-thread
-		       gnus-tmp-new-adopts))))
-    (if char
-	(if (> number 1) gnus-not-empty-thread-mark
-	  gnus-empty-thread-mark)
-      number)))
-
-(defun gnus-summary-set-local-parameters (group)
- "Go through the local params of GROUP and set all variable specs in that list."
-  (let ((params (gnus-info-params (gnus-get-info group)))
-	elem)
-    (while params
-      (setq elem (car params)
-	    params (cdr params))
-      (and (consp elem)			; Has to be a cons.
-	   (consp (cdr elem))		; The cdr has to be a list.
-	   (symbolp (car elem))		; Has to be a symbol in there.
-	   (not (memq (car elem) 
-		      '(quit-config to-address to-list to-group)))
-	   (progn			; So we set it.
-	     (make-local-variable (car elem))
-	     (set (car elem) (eval (nth 1 elem))))))))
-
-(defun gnus-summary-read-group (group &optional show-all no-article
-				      kill-buffer no-display)
-  "Start reading news in newsgroup GROUP.
-If SHOW-ALL is non-nil, already read articles are also listed.
-If NO-ARTICLE is non-nil, no article is selected initially.
-If NO-DISPLAY, don't generate a summary buffer."
-  (gnus-message 5 "Retrieving newsgroup: %s..." group)
-  (let* ((new-group (gnus-summary-setup-buffer group))
-	 (quit-config (gnus-group-quit-config group))
-	 (did-select (and new-group (gnus-select-newsgroup group show-all))))
-    (cond
-     ;; This summary buffer exists already, so we just select it.
-     ((not new-group)
-      (gnus-set-global-variables)
-      (when kill-buffer
-	(gnus-kill-or-deaden-summary kill-buffer))
-      (gnus-configure-windows 'summary 'force)
-      (gnus-set-mode-line 'summary)
-      (gnus-summary-position-point)
-      (message "")
-      t)
-     ;; We couldn't select this group.
-     ((null did-select)
-      (when (and (eq major-mode 'gnus-summary-mode)
-		 (not (equal (current-buffer) kill-buffer)))
-	(kill-buffer (current-buffer))
-	(if (not quit-config)
-	    (progn
-	      (set-buffer gnus-group-buffer)
-	      (gnus-group-jump-to-group group)
-	      (gnus-group-next-unread-group 1))
-	  (if (not (buffer-name (car quit-config)))
-	      (gnus-configure-windows 'group 'force)
-	    (set-buffer (car quit-config))
-	    (and (eq major-mode 'gnus-summary-mode)
-		 (gnus-set-global-variables))
-	    (gnus-configure-windows (cdr quit-config)))))
-      (gnus-message 3 "Can't select group")
-      nil)
-     ;; The user did a `C-g' while prompting for number of articles,
-     ;; so we exit this group.
-     ((eq did-select 'quit)
-      (and (eq major-mode 'gnus-summary-mode)
-	   (not (equal (current-buffer) kill-buffer))
-	   (kill-buffer (current-buffer)))
-      (when kill-buffer
-	(gnus-kill-or-deaden-summary kill-buffer))
-      (if (not quit-config)
-	  (progn
-	    (set-buffer gnus-group-buffer)
-	    (gnus-group-jump-to-group group)
-	    (gnus-group-next-unread-group 1)
-	    (gnus-configure-windows 'group 'force))
-	(if (not (buffer-name (car quit-config)))
-	    (gnus-configure-windows 'group 'force)
-	  (set-buffer (car quit-config))
-	  (and (eq major-mode 'gnus-summary-mode)
-	       (gnus-set-global-variables))
-	  (gnus-configure-windows (cdr quit-config))))
-      ;; Finally signal the quit.
-      (signal 'quit nil))
-     ;; The group was successfully selected.
-     (t
-      (gnus-set-global-variables)
-      ;; Save the active value in effect when the group was entered.
-      (setq gnus-newsgroup-active
-	    (gnus-copy-sequence
-	     (gnus-active gnus-newsgroup-name)))
-      ;; You can change the summary buffer in some way with this hook.
-      (run-hooks 'gnus-select-group-hook)
-      ;; Set any local variables in the group parameters.
-      (gnus-summary-set-local-parameters gnus-newsgroup-name)
-      (gnus-update-format-specifications)
-      ;; Do score processing.
-      (when gnus-use-scoring
-	(gnus-possibly-score-headers))
-      ;; Check whether to fill in the gaps in the threads.
-      (when gnus-build-sparse-threads
-	(gnus-build-sparse-threads))
-      ;; Find the initial limit.
-      (if gnus-show-threads
-	  (if show-all
-	      (let ((gnus-newsgroup-dormant nil))
-		(gnus-summary-initial-limit show-all))
-	    (gnus-summary-initial-limit show-all))
-	(setq gnus-newsgroup-limit 
-	      (mapcar 
-	       (lambda (header) (mail-header-number header))
-	       gnus-newsgroup-headers)))
-      ;; Generate the summary buffer.
-      (unless no-display
-	(gnus-summary-prepare))
-      (when gnus-use-trees
-	(gnus-tree-open group)
-	(setq gnus-summary-highlight-line-function
-	      'gnus-tree-highlight-article))
-      ;; If the summary buffer is empty, but there are some low-scored
-      ;; articles or some excluded dormants, we include these in the
-      ;; buffer.
-      (when (and (zerop (buffer-size))
-		 (not no-display))
-	(cond (gnus-newsgroup-dormant
-	       (gnus-summary-limit-include-dormant))
-	      ((and gnus-newsgroup-scored show-all)
-	       (gnus-summary-limit-include-expunged))))
-      ;; Function `gnus-apply-kill-file' must be called in this hook.
-      (run-hooks 'gnus-apply-kill-hook)
-      (if (and (zerop (buffer-size))
-	       (not no-display))
-	  (progn
-	    ;; This newsgroup is empty.
-	    (gnus-summary-catchup-and-exit nil t) ;Without confirmations.
-	    (gnus-message 6 "No unread news")
-	    (when kill-buffer
-	      (gnus-kill-or-deaden-summary kill-buffer))
-	    ;; Return nil from this function.
-	    nil)
-	;; Hide conversation thread subtrees.  We cannot do this in
-	;; gnus-summary-prepare-hook since kill processing may not
-	;; work with hidden articles.
-	(and gnus-show-threads
-	     gnus-thread-hide-subtree
-	     (gnus-summary-hide-all-threads))
-	;; Show first unread article if requested.
-	(if (and (not no-article)
-		 (not no-display)
-		 gnus-newsgroup-unreads
-		 gnus-auto-select-first)
-	    (unless (if (eq gnus-auto-select-first 'best)
-			(gnus-summary-best-unread-article)
-		      (gnus-summary-first-unread-article))
-	      (gnus-configure-windows 'summary))
-	  ;; Don't select any articles, just move point to the first
-	  ;; article in the group.
-	  (goto-char (point-min))
-	  (gnus-summary-position-point)
-	  (gnus-set-mode-line 'summary)
-	  (gnus-configure-windows 'summary 'force))
-	;; If we are in async mode, we send some info to the backend.
-	(when gnus-newsgroup-async
-	  (gnus-request-asynchronous gnus-newsgroup-name gnus-newsgroup-data))
-	(when kill-buffer
-	  (gnus-kill-or-deaden-summary kill-buffer))
-	(when (get-buffer-window gnus-group-buffer t)
-	  ;; Gotta use windows, because recenter does wierd stuff if
-	  ;; the current buffer ain't the displayed window.
-	  (let ((owin (selected-window)))
-	    (select-window (get-buffer-window gnus-group-buffer t))
-	    (when (gnus-group-goto-group group)
-	      (recenter))
-	    (select-window owin))))
-      ;; Mark this buffer as "prepared".
-      (setq gnus-newsgroup-prepared t)
-      t))))
-
-(defun gnus-summary-prepare ()
-  "Generate the summary buffer."
-  (let ((buffer-read-only nil))
-    (erase-buffer)
-    (setq gnus-newsgroup-data nil
-	  gnus-newsgroup-data-reverse nil)
-    (run-hooks 'gnus-summary-generate-hook)
-    ;; Generate the buffer, either with threads or without.
-    (when gnus-newsgroup-headers
-      (gnus-summary-prepare-threads
-       (if gnus-show-threads
-	   (gnus-sort-gathered-threads
-	    (funcall gnus-summary-thread-gathering-function
-		     (gnus-sort-threads
-		      (gnus-cut-threads (gnus-make-threads)))))
-	 ;; Unthreaded display.
-	 (gnus-sort-articles gnus-newsgroup-headers))))
-    (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
-    ;; Call hooks for modifying summary buffer.
-    (goto-char (point-min))
-    (run-hooks 'gnus-summary-prepare-hook)))
-
-(defun gnus-gather-threads-by-subject (threads)
-  "Gather threads by looking at Subject headers."
-  (if (not gnus-summary-make-false-root)
-      threads
-    (let ((hashtb (gnus-make-hashtable 1023))
-	  (prev threads)
-	  (result threads)
-	  subject hthread whole-subject)
-      (while threads
-	(setq whole-subject (mail-header-subject (caar threads)))
-	(setq subject
-	      (cond
-	       ;; Truncate the subject.
-	       ((numberp gnus-summary-gather-subject-limit)
-		(setq subject (gnus-simplify-subject-re whole-subject))
-		(if (> (length subject) gnus-summary-gather-subject-limit)
-		    (substring subject 0 gnus-summary-gather-subject-limit)
-		  subject))
-	       ;; Fuzzily simplify it.
-	       ((eq 'fuzzy gnus-summary-gather-subject-limit)
-		(gnus-simplify-subject-fuzzy whole-subject))
-	       ;; Just remove the leading "Re:".
-	       (t
-		(gnus-simplify-subject-re whole-subject))))
-
-	(if (and gnus-summary-gather-exclude-subject
-		 (string-match gnus-summary-gather-exclude-subject
-			       subject))
-	    ()	       	; We don't want to do anything with this article.
-	  ;; We simplify the subject before looking it up in the
-	  ;; hash table.
-
-	  (if (setq hthread (gnus-gethash subject hashtb))
-	      (progn
-		;; We enter a dummy root into the thread, if we
-		;; haven't done that already.
-		(unless (stringp (caar hthread))
-		  (setcar hthread (list whole-subject (car hthread))))
-		;; We add this new gathered thread to this gathered
-		;; thread.
-		(setcdr (car hthread)
-			(nconc (cdar hthread) (list (car threads))))
-		;; Remove it from the list of threads.
-		(setcdr prev (cdr threads))
-		(setq threads prev))
-	    ;; Enter this thread into the hash table.
-	    (gnus-sethash subject threads hashtb)))
-	(setq prev threads)
-	(setq threads (cdr threads)))
-      result)))
-
-(defun gnus-gather-threads-by-references (threads)
-  "Gather threads by looking at References headers."
-  (let ((idhashtb (gnus-make-hashtable 1023))
-	(thhashtb (gnus-make-hashtable 1023))
-	(prev threads)
-	(result threads)
-	ids references id gthread gid entered)
-    (while threads
-      (when (setq references (mail-header-references (caar threads)))
-	(setq id (mail-header-id (caar threads)))
-	(setq ids (gnus-split-references references))
-	(setq entered nil)
-	(while ids
-	  (if (not (setq gid (gnus-gethash (car ids) idhashtb)))
-	      (progn
-		(gnus-sethash (car ids) id idhashtb)
-		(gnus-sethash id threads thhashtb))
-	    (setq gthread (gnus-gethash gid thhashtb))
-	    (unless entered
-	      ;; We enter a dummy root into the thread, if we
-	      ;; haven't done that already.
-	      (unless (stringp (caar gthread))
-		(setcar gthread (list (mail-header-subject (caar gthread))
-				      (car gthread))))
-	      ;; We add this new gathered thread to this gathered
-	      ;; thread.
-	      (setcdr (car gthread)
-		      (nconc (cdar gthread) (list (car threads)))))
-	    ;; Add it into the thread hash table.
-	    (gnus-sethash id gthread thhashtb)
-	    (setq entered t)
-	    ;; Remove it from the list of threads.
-	    (setcdr prev (cdr threads))
-	    (setq threads prev))
-	  (setq ids (cdr ids))))
-      (setq prev threads)
-      (setq threads (cdr threads)))
-    result))
-
-(defun gnus-sort-gathered-threads (threads)
-  "Sort subtreads inside each gathered thread by article number."
-  (let ((result threads))
-    (while threads
-      (when (stringp (caar threads))
-	(setcdr (car threads)
-		(sort (cdar threads) 'gnus-thread-sort-by-number)))
-      (setq threads (cdr threads)))
-    result))
-
-(defun gnus-make-threads ()
-  "Go through the dependency hashtb and find the roots.	 Return all threads."
-  (let (threads)
-    (mapatoms
-     (lambda (refs)
-       (unless (car (symbol-value refs))
-	 ;; These threads do not refer back to any other articles,
-	 ;; so they're roots.
-	 (setq threads (append (cdr (symbol-value refs)) threads))))
-     gnus-newsgroup-dependencies)
-    threads))
-
-(defun gnus-build-sparse-threads ()
-  (let ((headers gnus-newsgroup-headers)
-	(deps gnus-newsgroup-dependencies)
-	header references generation relations 
-	cthread subject child end pthread relation)
-    ;; First we create an alist of generations/relations, where 
-    ;; generations is how much we trust the ralation, and the relation
-    ;; is parent/child.
-    (gnus-message 7 "Making sparse threads...")
-    (save-excursion
-      (nnheader-set-temp-buffer " *gnus sparse threads*")
-      (while (setq header (pop headers))
-	(when (and (setq references (mail-header-references header))
-		   (not (string= references "")))
-	  (insert references)
-	  (setq child (mail-header-id header)
-		subject (mail-header-subject header))
-	  (setq generation 0)
-	  (while (search-backward ">" nil t)
-	    (setq end (1+ (point)))
-	    (when (search-backward "<" nil t)
-	      (push (list (incf generation) 
-			  child (setq child (buffer-substring (point) end))
-			  subject)
-		    relations)))
-	  (push (list (1+ generation) child nil subject) relations)
-	  (erase-buffer)))
-      (kill-buffer (current-buffer)))
-    ;; Sort over trustworthiness.
-    (setq relations (sort relations (lambda (r1 r2) (< (car r1) (car r2)))))
-    (while (setq relation (pop relations))
-      (when (if (boundp (setq cthread (intern (cadr relation) deps)))
-		(unless (car (symbol-value cthread))
-		  ;; Make this article the parent of these threads.
-		  (setcar (symbol-value cthread)
-			  (vector gnus-reffed-article-number 
-				  (cadddr relation) 
-				  "" ""
-				  (cadr relation) 
-				  (or (caddr relation) "") 0 0 "")))
-	      (set cthread (list (vector gnus-reffed-article-number
-					 (cadddr relation) 
-					 "" "" (cadr relation) 
-					 (or (caddr relation) "") 0 0 ""))))
-	(push gnus-reffed-article-number gnus-newsgroup-limit)
-	(push gnus-reffed-article-number gnus-newsgroup-sparse)
-	(push (cons gnus-reffed-article-number gnus-sparse-mark)
-	      gnus-newsgroup-reads)
-	(decf gnus-reffed-article-number)
-	;; Make this new thread the child of its parent.
-	(if (boundp (setq pthread (intern (or (caddr relation) "none") deps)))
-	    (setcdr (symbol-value pthread)
-		    (nconc (cdr (symbol-value pthread))
-			   (list (symbol-value cthread))))
-	  (set pthread (list nil (symbol-value cthread))))))
-    (gnus-message 7 "Making sparse threads...done")))
-
-(defun gnus-build-old-threads ()
-  ;; Look at all the articles that refer back to old articles, and
-  ;; fetch the headers for the articles that aren't there.  This will
-  ;; build complete threads - if the roots haven't been expired by the
-  ;; server, that is.
-  (let (id heads)
-    (mapatoms
-     (lambda (refs)
-       (when (not (car (symbol-value refs)))
-	 (setq heads (cdr (symbol-value refs)))
-	 (while heads
-	   (if (memq (mail-header-number (caar heads))
-		     gnus-newsgroup-dormant)
-	       (setq heads (cdr heads))
-	     (setq id (symbol-name refs))
-	     (while (and (setq id (gnus-build-get-header id))
-			 (not (car (gnus-gethash
-				    id gnus-newsgroup-dependencies)))))
-	     (setq heads nil)))))
-     gnus-newsgroup-dependencies)))
-
-(defun gnus-build-get-header (id)
-  ;; Look through the buffer of NOV lines and find the header to
-  ;; ID.  Enter this line into the dependencies hash table, and return
-  ;; the id of the parent article (if any).
-  (let ((deps gnus-newsgroup-dependencies)
-	found header)
-    (prog1
-	(save-excursion
-	  (set-buffer nntp-server-buffer)
-	  (goto-char (point-min))
-	  (while (and (not found) (search-forward id nil t))
-	    (beginning-of-line)
-	    (setq found (looking-at
-			 (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
-				 (regexp-quote id))))
-	    (or found (beginning-of-line 2)))
-	  (when found
-	    (beginning-of-line)
-	    (and
-	     (setq header (gnus-nov-parse-line
-			   (read (current-buffer)) deps))
-	     (gnus-parent-id (mail-header-references header)))))
-      (when header
-	(let ((number (mail-header-number header)))
-	  (push number gnus-newsgroup-limit)
-	  (push header gnus-newsgroup-headers)
-	  (if (memq number gnus-newsgroup-unselected)
-	      (progn
-		(push number gnus-newsgroup-unreads)
-		(setq gnus-newsgroup-unselected
-		      (delq number gnus-newsgroup-unselected)))
-	    (push number gnus-newsgroup-ancient)))))))
-
-(defun gnus-summary-update-article (article &optional iheader)
-  "Update ARTICLE in the summary buffer."
-  (set-buffer gnus-summary-buffer)
-  (let* ((header (or iheader (gnus-summary-article-header article)))
-	 (id (mail-header-id header))
-	 (data (gnus-data-find article))
-	 (thread (gnus-id-to-thread id))
-	 (references (mail-header-references header))
-	 (parent
-	  (gnus-id-to-thread
-	   (or (gnus-parent-id 
-		(if (and references
-			 (not (equal "" references)))
-		    references))
-	       "none")))
-	 (buffer-read-only nil)
-	 (old (car thread))
-	 (number (mail-header-number header))
-	 pos)
-    (when thread
-      ;; !!! Should this be in or not?
-      (unless iheader
-	(setcar thread nil))
-      (when parent
-	(delq thread parent))
-      (if (gnus-summary-insert-subject id header iheader)
-	  ;; Set the (possibly) new article number in the data structure.
-	  (gnus-data-set-number data (gnus-id-to-article id))
-	(setcar thread old)
-	nil))))
-
-(defun gnus-rebuild-thread (id)
-  "Rebuild the thread containing ID."
-  (let ((buffer-read-only nil)
-	current thread data)
-    (if (not gnus-show-threads)
-	(setq thread (list (car (gnus-id-to-thread id))))
-      ;; Get the thread this article is part of.
-      (setq thread (gnus-remove-thread id)))
-    (setq current (save-excursion
-		    (and (zerop (forward-line -1))
-			 (gnus-summary-article-number))))
-    ;; If this is a gathered thread, we have to go some re-gathering.
-    (when (stringp (car thread))
-      (let ((subject (car thread))
-	    roots thr)
-	(setq thread (cdr thread))
-	(while thread
-	  (unless (memq (setq thr (gnus-id-to-thread
-				      (gnus-root-id
-				       (mail-header-id (caar thread)))))
-			roots)
-	    (push thr roots))
-	  (setq thread (cdr thread)))
-	;; We now have all (unique) roots.
-	(if (= (length roots) 1)
-	    ;; All the loose roots are now one solid root.
-	    (setq thread (car roots))
-	  (setq thread (cons subject (gnus-sort-threads roots))))))
-    (let (threads)
-      ;; We then insert this thread into the summary buffer.
-      (let (gnus-newsgroup-data gnus-newsgroup-threads)
-	(gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
-	(setq data (nreverse gnus-newsgroup-data))
-	(setq threads gnus-newsgroup-threads))
-      ;; We splice the new data into the data structure.
-      (gnus-data-enter-list current data)
-      (gnus-data-compute-positions)
-      (setq gnus-newsgroup-threads (nconc threads gnus-newsgroup-threads)))))
-
-(defun gnus-number-to-header (number)
-  "Return the header for article NUMBER."
-  (let ((headers gnus-newsgroup-headers))
-    (while (and headers
-		(not (= number (mail-header-number (car headers)))))
-      (pop headers))
-    (when headers
-      (car headers))))
-
-(defun gnus-id-to-thread (id)
-  "Return the (sub-)thread where ID appears."
-  (gnus-gethash id gnus-newsgroup-dependencies))
-
-(defun gnus-id-to-article (id)
-  "Return the article number of ID."
-  (let ((thread (gnus-id-to-thread id)))
-    (when (and thread
-	       (car thread))
-      (mail-header-number (car thread)))))
-
-(defun gnus-id-to-header (id)
-  "Return the article headers of ID."
-  (car (gnus-id-to-thread id)))
-
-(defun gnus-article-displayed-root-p (article)
-  "Say whether ARTICLE is a root(ish) article."
-  (let ((level (gnus-summary-thread-level article))
-	(refs (mail-header-references  (gnus-summary-article-header article)))
-	particle)
-    (cond 
-     ((null level) nil)
-     ((zerop level) t)
-     ((null refs) t)
-     ((null (gnus-parent-id refs)) t)
-     ((and (= 1 level)
-	   (null (setq particle (gnus-id-to-article
-				 (gnus-parent-id refs))))
-	   (null (gnus-summary-thread-level particle)))))))
-
-(defun gnus-root-id (id)
-  "Return the id of the root of the thread where ID appears."
-  (let (last-id prev)
-    (while (and id (setq prev (car (gnus-gethash 
-				    id gnus-newsgroup-dependencies))))
-      (setq last-id id
-	    id (gnus-parent-id (mail-header-references prev))))
-    last-id))
-
-(defun gnus-remove-thread (id &optional dont-remove)
-  "Remove the thread that has ID in it."
-  (let ((dep gnus-newsgroup-dependencies)
-	headers thread last-id)
-    ;; First go up in this thread until we find the root.
-    (setq last-id (gnus-root-id id))
-    (setq headers (list (car (gnus-id-to-thread last-id))
-			(caadr (gnus-id-to-thread last-id))))
-    ;; We have now found the real root of this thread.	It might have
-    ;; been gathered into some loose thread, so we have to search
-    ;; through the threads to find the thread we wanted.
-    (let ((threads gnus-newsgroup-threads)
-	  sub)
-      (while threads
-	(setq sub (car threads))
-	(if (stringp (car sub))
-	    ;; This is a gathered threads, so we look at the roots
-	    ;; below it to find whether this article in in this
-	    ;; gathered root.
-	    (progn
-	      (setq sub (cdr sub))
-	      (while sub
-		(when (member (caar sub) headers)
-		  (setq thread (car threads)
-			threads nil
-			sub nil))
-		(setq sub (cdr sub))))
-	  ;; It's an ordinary thread, so we check it.
-	  (when (eq (car sub) (car headers))
-	    (setq thread sub
-		  threads nil)))
-	(setq threads (cdr threads)))
-      ;; If this article is in no thread, then it's a root.
-      (if thread
-	  (unless dont-remove
-	    (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
-	(setq thread (gnus-gethash last-id dep)))
-      (when thread
-	(prog1
-	    thread ; We return this thread.
-	  (unless dont-remove
-	    (if (stringp (car thread))
-		(progn
-		  ;; If we use dummy roots, then we have to remove the
-		  ;; dummy root as well.
-		  (when (eq gnus-summary-make-false-root 'dummy)
-		    ;; Uhm.
-		    )
-		  (setq thread (cdr thread))
-		  (while thread
-		    (gnus-remove-thread-1 (car thread))
-		    (setq thread (cdr thread))))
-	      (gnus-remove-thread-1 thread))))))))
-
-(defun gnus-remove-thread-1 (thread)
-  "Remove the thread THREAD recursively."
-  (let ((number (mail-header-number (car thread)))
-	pos)
-    (when (setq pos (text-property-any
-		     (point-min) (point-max) 'gnus-number number))
-      (goto-char pos)
-      (gnus-delete-line)
-      (gnus-data-remove number))
-    (setq thread (cdr thread))
-    (while thread
-      (gnus-remove-thread-1 (pop thread)))))
-
-(defun gnus-sort-threads (threads)
-  "Sort THREADS."
-  (if (not gnus-thread-sort-functions)
-      threads
-    (let ((func (if (= 1 (length gnus-thread-sort-functions))
-		    (car gnus-thread-sort-functions)
-		  `(lambda (t1 t2)
-		     ,(gnus-make-sort-function 
-		       (reverse gnus-thread-sort-functions))))))
-      (gnus-message 7 "Sorting threads...")
-      (prog1
-	  (sort threads func)
-	(gnus-message 7 "Sorting threads...done")))))
-
-(defun gnus-sort-articles (articles)
-  "Sort ARTICLES."
-  (when gnus-article-sort-functions
-    (let ((func (if (= 1 (length gnus-article-sort-functions))
-		    (car gnus-article-sort-functions)
-		  `(lambda (t1 t2)
-		     ,(gnus-make-sort-function 
-		       (reverse gnus-article-sort-functions))))))
-      (gnus-message 7 "Sorting articles...")
-      (prog1
-	  (setq gnus-newsgroup-headers (sort articles func))
-	(gnus-message 7 "Sorting articles...done")))))
-
-(defun gnus-make-sort-function (funs)
-  "Return a composite sort condition based on the functions in FUNC."
-  (if (cdr funs)
-      `(or (,(car funs) t1 t2)
-	   (and (not (,(car funs) t2 t1))
-		,(gnus-make-sort-function (cdr funs))))
-    `(,(car funs) t1 t2)))
-		 
-;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-(defmacro gnus-thread-header (thread)
-  ;; Return header of first article in THREAD.
-  ;; Note that THREAD must never, ever be anything else than a variable -
-  ;; using some other form will lead to serious barfage.
-  (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
-  ;; (8% speedup to gnus-summary-prepare, just for fun :-)
-  (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207" ;
-	(vector thread) 2))
-
-(defsubst gnus-article-sort-by-number (h1 h2)
-  "Sort articles by article number."
-  (< (mail-header-number h1)
-     (mail-header-number h2)))
-
-(defun gnus-thread-sort-by-number (h1 h2)
-  "Sort threads by root article number."
-  (gnus-article-sort-by-number
-   (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-author (h1 h2)
-  "Sort articles by root author."
-  (string-lessp
-   (let ((extract (funcall
-		   gnus-extract-address-components
-		   (mail-header-from h1))))
-     (or (car extract) (cdr extract)))
-   (let ((extract (funcall
-		   gnus-extract-address-components
-		   (mail-header-from h2))))
-     (or (car extract) (cdr extract)))))
-
-(defun gnus-thread-sort-by-author (h1 h2)
-  "Sort threads by root author."
-  (gnus-article-sort-by-author
-   (gnus-thread-header h1)  (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-subject (h1 h2)
-  "Sort articles by root subject."
-  (string-lessp
-   (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
-   (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
-
-(defun gnus-thread-sort-by-subject (h1 h2)
-  "Sort threads by root subject."
-  (gnus-article-sort-by-subject
-   (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-date (h1 h2)
-  "Sort articles by root article date."
-  (string-lessp
-   (inline (gnus-sortable-date (mail-header-date h1)))
-   (inline (gnus-sortable-date (mail-header-date h2)))))
-
-(defun gnus-thread-sort-by-date (h1 h2)
-  "Sort threads by root article date."
-  (gnus-article-sort-by-date
-   (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-score (h1 h2)
-  "Sort articles by root article score.
-Unscored articles will be counted as having a score of zero."
-  (> (or (cdr (assq (mail-header-number h1)
-		    gnus-newsgroup-scored))
-	 gnus-summary-default-score 0)
-     (or (cdr (assq (mail-header-number h2)
-		    gnus-newsgroup-scored))
-	 gnus-summary-default-score 0)))
-
-(defun gnus-thread-sort-by-score (h1 h2)
-  "Sort threads by root article score."
-  (gnus-article-sort-by-score
-   (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defun gnus-thread-sort-by-total-score (h1 h2)
-  "Sort threads by the sum of all scores in the thread.
-Unscored articles will be counted as having a score of zero."
-  (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
-
-(defun gnus-thread-total-score (thread)
-  ;;  This function find the total score of THREAD.
-  (cond ((null thread)
-	 0)
-	((consp thread)
-	 (if (stringp (car thread))
-	     (apply gnus-thread-score-function 0
-		    (mapcar 'gnus-thread-total-score-1 (cdr thread)))
-	   (gnus-thread-total-score-1 thread)))
-	(t
-	 (gnus-thread-total-score-1 (list thread)))))
-
-(defun gnus-thread-total-score-1 (root)
-  ;; This function find the total score of the thread below ROOT.
-  (setq root (car root))
-  (apply gnus-thread-score-function
-	 (or (append
-	      (mapcar 'gnus-thread-total-score
-		      (cdr (gnus-gethash (mail-header-id root)
-					 gnus-newsgroup-dependencies)))
-		 (if (> (mail-header-number root) 0)
-		     (list (or (cdr (assq (mail-header-number root) 
-					  gnus-newsgroup-scored))
-			       gnus-summary-default-score 0))))
-	     (list gnus-summary-default-score)
-	     '(0))))
-
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defvar gnus-tmp-prev-subject nil)
-(defvar gnus-tmp-false-parent nil)
-(defvar gnus-tmp-root-expunged nil)
-(defvar gnus-tmp-dummy-line nil)
-
-(defun gnus-summary-prepare-threads (threads)
-  "Prepare summary buffer from THREADS and indentation LEVEL.
-THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
-or a straight list of headers."
-  (gnus-message 7 "Generating summary...")
-
-  (setq gnus-newsgroup-threads threads)
-  (beginning-of-line)
-
-  (let ((gnus-tmp-level 0)
-	(default-score (or gnus-summary-default-score 0))
-	(gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
-	thread number subject stack state gnus-tmp-gathered beg-match
-	new-roots gnus-tmp-new-adopts thread-end
-	gnus-tmp-header gnus-tmp-unread
-	gnus-tmp-replied gnus-tmp-subject-or-nil
-	gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
-	gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
-	gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket)
-
-    (setq gnus-tmp-prev-subject nil)
-
-    (if (vectorp (car threads))
-	;; If this is a straight (sic) list of headers, then a
-	;; threaded summary display isn't required, so we just create
-	;; an unthreaded one.
-	(gnus-summary-prepare-unthreaded threads)
-
-      ;; Do the threaded display.
-
-      (while (or threads stack gnus-tmp-new-adopts new-roots)
-
-	(if (and (= gnus-tmp-level 0)
-		 (not (setq gnus-tmp-dummy-line nil))
-		 (or (not stack)
-		     (= (caar stack) 0))
-		 (not gnus-tmp-false-parent)
-		 (or gnus-tmp-new-adopts new-roots))
-	    (if gnus-tmp-new-adopts
-		(setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
-		      thread (list (car gnus-tmp-new-adopts))
-		      gnus-tmp-header (caar thread)
-		      gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
-	      (if new-roots
-		  (setq thread (list (car new-roots))
-			gnus-tmp-header (caar thread)
-			new-roots (cdr new-roots))))
-
-	  (if threads
-	      ;; If there are some threads, we do them before the
-	      ;; threads on the stack.
-	      (setq thread threads
-		    gnus-tmp-header (caar thread))
-	    ;; There were no current threads, so we pop something off
-	    ;; the stack.
-	    (setq state (car stack)
-		  gnus-tmp-level (car state)
-		  thread (cdr state)
-		  stack (cdr stack)
-		  gnus-tmp-header (caar thread))))
-
-	(setq gnus-tmp-false-parent nil)
-	(setq gnus-tmp-root-expunged nil)
-	(setq thread-end nil)
-
-	(if (stringp gnus-tmp-header)
-	    ;; The header is a dummy root.
-	    (cond
-	     ((eq gnus-summary-make-false-root 'adopt)
-	      ;; We let the first article adopt the rest.
-	      (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
-					       (cddar thread)))
-	      (setq gnus-tmp-gathered
-		    (nconc (mapcar
-			    (lambda (h) (mail-header-number (car h)))
-			    (cddar thread))
-			   gnus-tmp-gathered))
-	      (setq thread (cons (list (caar thread)
-				       (cadar thread))
-				 (cdr thread)))
-	      (setq gnus-tmp-level -1
-		    gnus-tmp-false-parent t))
-	     ((eq gnus-summary-make-false-root 'empty)
-	      ;; We print adopted articles with empty subject fields.
-	      (setq gnus-tmp-gathered
-		    (nconc (mapcar
-			    (lambda (h) (mail-header-number (car h)))
-			    (cddar thread))
-			   gnus-tmp-gathered))
-	      (setq gnus-tmp-level -1))
-	     ((eq gnus-summary-make-false-root 'dummy)
-	      ;; We remember that we probably want to output a dummy
-	      ;; root.
-	      (setq gnus-tmp-dummy-line gnus-tmp-header)
-	      (setq gnus-tmp-prev-subject gnus-tmp-header))
-	     (t
-	      ;; We do not make a root for the gathered
-	      ;; sub-threads at all.
-	      (setq gnus-tmp-level -1)))
-
-	  (setq number (mail-header-number gnus-tmp-header)
-		subject (mail-header-subject gnus-tmp-header))
-
-	  (cond
-	   ;; If the thread has changed subject, we might want to make
-	   ;; this subthread into a root.
-	   ((and (null gnus-thread-ignore-subject)
-		 (not (zerop gnus-tmp-level))
-		 gnus-tmp-prev-subject
-		 (not (inline
-			(gnus-subject-equal gnus-tmp-prev-subject subject))))
-	    (setq new-roots (nconc new-roots (list (car thread)))
-		  thread-end t
-		  gnus-tmp-header nil))
-	   ;; If the article lies outside the current limit,
-	   ;; then we do not display it.
-	   ((and (not (memq number gnus-newsgroup-limit))
-		 (not gnus-tmp-dummy-line))
-	    (setq gnus-tmp-gathered
-		  (nconc (mapcar
-			  (lambda (h) (mail-header-number (car h)))
-			  (cdar thread))
-			 gnus-tmp-gathered))
-	    (setq gnus-tmp-new-adopts (if (cdar thread)
-					  (append gnus-tmp-new-adopts
-						  (cdar thread))
-					gnus-tmp-new-adopts)
-		  thread-end t
-		  gnus-tmp-header nil)
-	    (when (zerop gnus-tmp-level)
-	      (setq gnus-tmp-root-expunged t)))
-	   ;; Perhaps this article is to be marked as read?
-	   ((and gnus-summary-mark-below
-		 (< (or (cdr (assq number gnus-newsgroup-scored))
-			default-score)
-		    gnus-summary-mark-below)
-		 ;; Don't touch sparse articles.
-		 (not (memq number gnus-newsgroup-sparse))
-		 (not (memq number gnus-newsgroup-ancient)))
-	    (setq gnus-newsgroup-unreads
-		  (delq number gnus-newsgroup-unreads))
-	    (if gnus-newsgroup-auto-expire
-		(push number gnus-newsgroup-expirable)
-	      (push (cons number gnus-low-score-mark)
-		    gnus-newsgroup-reads))))
-
-	  (when gnus-tmp-header
-	    ;; We may have an old dummy line to output before this
-	    ;; article.
-	    (when gnus-tmp-dummy-line
-	      (gnus-summary-insert-dummy-line
-	       gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
-	      (setq gnus-tmp-dummy-line nil))
-
-	    ;; Compute the mark.
-	    (setq
-	     gnus-tmp-unread
-	     (cond
-	      ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
-	      ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
-	      ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
-	      ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
-	      (t (or (cdr (assq number gnus-newsgroup-reads))
-		     gnus-ancient-mark))))
-
-	    (push (gnus-data-make number gnus-tmp-unread (1+ (point))
-				  gnus-tmp-header gnus-tmp-level)
-		  gnus-newsgroup-data)
-
-	    ;; Actually insert the line.
-	    (setq
-	     gnus-tmp-subject-or-nil
-	     (cond
-	      ((and gnus-thread-ignore-subject
-		    gnus-tmp-prev-subject
-		    (not (inline (gnus-subject-equal
-				  gnus-tmp-prev-subject subject))))
-	       subject)
-	      ((zerop gnus-tmp-level)
-	       (if (and (eq gnus-summary-make-false-root 'empty)
-			(memq number gnus-tmp-gathered)
-			gnus-tmp-prev-subject
-			(inline (gnus-subject-equal
-				 gnus-tmp-prev-subject subject)))
-		   gnus-summary-same-subject
-		 subject))
-	      (t gnus-summary-same-subject)))
-	    (if (and (eq gnus-summary-make-false-root 'adopt)
-		     (= gnus-tmp-level 1)
-		     (memq number gnus-tmp-gathered))
-		(setq gnus-tmp-opening-bracket ?\<
-		      gnus-tmp-closing-bracket ?\>)
-	      (setq gnus-tmp-opening-bracket ?\[
-		    gnus-tmp-closing-bracket ?\]))
-	    (setq
-	     gnus-tmp-indentation
-	     (aref gnus-thread-indent-array gnus-tmp-level)
-	     gnus-tmp-lines (mail-header-lines gnus-tmp-header)
-	     gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
-				gnus-summary-default-score 0)
-	     gnus-tmp-score-char
-	     (if (or (null gnus-summary-default-score)
-		     (<= (abs (- gnus-tmp-score gnus-summary-default-score))
-			 gnus-summary-zcore-fuzz)) ? 
-	       (if (< gnus-tmp-score gnus-summary-default-score)
-		   gnus-score-below-mark gnus-score-over-mark))
-	     gnus-tmp-replied
-	     (cond ((memq number gnus-newsgroup-processable)
-		    gnus-process-mark)
-		   ((memq number gnus-newsgroup-cached)
-		    gnus-cached-mark)
-		   ((memq number gnus-newsgroup-replied)
-		    gnus-replied-mark)
-		   ((memq number gnus-newsgroup-saved)
-		    gnus-saved-mark)
-		   (t gnus-unread-mark))
-	     gnus-tmp-from (mail-header-from gnus-tmp-header)
-	     gnus-tmp-name
-	     (cond
-	      ((string-match "(.+)" gnus-tmp-from)
-	       (substring gnus-tmp-from
-			  (1+ (match-beginning 0)) (1- (match-end 0))))
-	      ((string-match "<[^>]+> *$" gnus-tmp-from)
-	       (setq beg-match (match-beginning 0))
-	       (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
-			(substring gnus-tmp-from (1+ (match-beginning 0))
-				   (1- (match-end 0))))
-		   (substring gnus-tmp-from 0 beg-match)))
-	      (t gnus-tmp-from)))
-	    (when (string= gnus-tmp-name "")
-	      (setq gnus-tmp-name gnus-tmp-from))
-	    (or (numberp gnus-tmp-lines) (setq gnus-tmp-lines 0))
-	    (gnus-put-text-property
-	     (point)
-	     (progn (eval gnus-summary-line-format-spec) (point))
-	     'gnus-number number)
-	    (when gnus-visual-p
-	      (forward-line -1)
-	      (run-hooks 'gnus-summary-update-hook)
-	      (forward-line 1))
-
-	    (setq gnus-tmp-prev-subject subject)))
-
-	(when (nth 1 thread)
-	  (push (cons (max 0 gnus-tmp-level) (nthcdr 1 thread)) stack))
-	(incf gnus-tmp-level)
-	(setq threads (if thread-end nil (cdar thread)))
-	(unless threads
-	  (setq gnus-tmp-level 0)))))
-  (gnus-message 7 "Generating summary...done"))
-
-(defun gnus-summary-prepare-unthreaded (headers)
-  "Generate an unthreaded summary buffer based on HEADERS."
-  (let (header number mark)
-
-    (while headers
-      ;; We may have to root out some bad articles...
-      (when (memq (setq number (mail-header-number
-				(setq header (pop headers))))
-		  gnus-newsgroup-limit)
-	;; Mark article as read when it has a low score.
-	(when (and gnus-summary-mark-below
-		   (< (or (cdr (assq number gnus-newsgroup-scored))
-			  gnus-summary-default-score 0)
-		      gnus-summary-mark-below)
-		   (not (memq number gnus-newsgroup-ancient)))
-	  (setq gnus-newsgroup-unreads
-		(delq number gnus-newsgroup-unreads))
-	  (if gnus-newsgroup-auto-expire
-	      (push number gnus-newsgroup-expirable)
-	    (push (cons number gnus-low-score-mark)
-		  gnus-newsgroup-reads)))
-
-	(setq mark
-	      (cond
-	       ((memq number gnus-newsgroup-marked) gnus-ticked-mark)
-	       ((memq number gnus-newsgroup-dormant) gnus-dormant-mark)
-	       ((memq number gnus-newsgroup-unreads) gnus-unread-mark)
-	       ((memq number gnus-newsgroup-expirable) gnus-expirable-mark)
-	       (t (or (cdr (assq number gnus-newsgroup-reads))
-		      gnus-ancient-mark))))
-	(setq gnus-newsgroup-data
-	      (cons (gnus-data-make number mark (1+ (point)) header 0)
-		    gnus-newsgroup-data))
-	(gnus-summary-insert-line
-	 header 0 nil mark (memq number gnus-newsgroup-replied)
-	 (memq number gnus-newsgroup-expirable)
-	 (mail-header-subject header) nil
-	 (cdr (assq number gnus-newsgroup-scored))
-	 (memq number gnus-newsgroup-processable))))))
-
-(defun gnus-select-newsgroup (group &optional read-all)
-  "Select newsgroup GROUP.
-If READ-ALL is non-nil, all articles in the group are selected."
-  (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
-	 (info (nth 2 entry))
-	 articles fetched-articles cached)
-
-    (or (gnus-check-server
-	 (setq gnus-current-select-method (gnus-find-method-for-group group)))
-	(error "Couldn't open server"))
-
-    (or (and entry (not (eq (car entry) t))) ; Either it's active...
-	(gnus-activate-group group)	; Or we can activate it...
-	(progn				; Or we bug out.
-	  (when (equal major-mode 'gnus-summary-mode)
-	    (kill-buffer (current-buffer)))
-	  (error "Couldn't request group %s: %s"
-		 group (gnus-status-message group))))
-
-    (unless (gnus-request-group group t)
-      (when (equal major-mode 'gnus-summary-mode)
-	(kill-buffer (current-buffer)))
-      (error "Couldn't request group %s: %s"
-	     group (gnus-status-message group)))      
-
-    (setq gnus-newsgroup-name group)
-    (setq gnus-newsgroup-unselected nil)
-    (setq gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
-
-    (and gnus-asynchronous
-	 (gnus-check-backend-function
-	  'request-asynchronous gnus-newsgroup-name)
-	 (setq gnus-newsgroup-async
-	       (gnus-request-asynchronous gnus-newsgroup-name)))
-
-    ;; Adjust and set lists of article marks.
-    (when info
-      (gnus-adjust-marked-articles info))
-
-    ;; Kludge to avoid having cached articles nixed out in virtual groups.
-    (when (gnus-virtual-group-p group)
-      (setq cached gnus-newsgroup-cached))
-
-    (setq gnus-newsgroup-unreads
-	  (gnus-set-difference
-	   (gnus-set-difference gnus-newsgroup-unreads gnus-newsgroup-marked)
-	   gnus-newsgroup-dormant))
-
-    (setq gnus-newsgroup-processable nil)
-
-    (setq articles (gnus-articles-to-read group read-all))
-
-    (cond
-     ((null articles)
-      ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
-      'quit)
-     ((eq articles 0) nil)
-     (t
-      ;; Init the dependencies hash table.
-      (setq gnus-newsgroup-dependencies
-	    (gnus-make-hashtable (length articles)))
-      ;; Retrieve the headers and read them in.
-      (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
-      (setq gnus-newsgroup-headers
-	    (if (eq 'nov
-		    (setq gnus-headers-retrieved-by
-			  (gnus-retrieve-headers
-			   articles gnus-newsgroup-name
-			   ;; We might want to fetch old headers, but
-			   ;; not if there is only 1 article.
-			   (and gnus-fetch-old-headers
-				(or (and
-				     (not (eq gnus-fetch-old-headers 'some))
-				     (not (numberp gnus-fetch-old-headers)))
-				    (> (length articles) 1))))))
-		(gnus-get-newsgroup-headers-xover articles)
-	      (gnus-get-newsgroup-headers)))
-      (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name)
-
-      ;; Kludge to avoid having cached articles nixed out in virtual groups.
-      (when cached
-	(setq gnus-newsgroup-cached cached))
-
-      ;; Set the initial limit.
-      (setq gnus-newsgroup-limit (copy-sequence articles))
-      ;; Remove canceled articles from the list of unread articles.
-      (setq gnus-newsgroup-unreads
-	    (gnus-set-sorted-intersection
-	     gnus-newsgroup-unreads
-	     (setq fetched-articles
-		   (mapcar (lambda (headers) (mail-header-number headers))
-			   gnus-newsgroup-headers))))
-      ;; Removed marked articles that do not exist.
-      (gnus-update-missing-marks
-       (gnus-sorted-complement fetched-articles articles))
-      ;; We might want to build some more threads first.
-      (and gnus-fetch-old-headers
-	   (eq gnus-headers-retrieved-by 'nov)
-	   (gnus-build-old-threads))
-      ;; Check whether auto-expire is to be done in this group.
-      (setq gnus-newsgroup-auto-expire
-	    (gnus-group-auto-expirable-p group))
-      ;; Set up the article buffer now, if necessary.
-      (unless gnus-single-article-buffer
-	(gnus-article-setup-buffer))
-      ;; First and last article in this newsgroup.
-      (when gnus-newsgroup-headers
-	(setq gnus-newsgroup-begin
-	      (mail-header-number (car gnus-newsgroup-headers))
-	      gnus-newsgroup-end
-	      (mail-header-number
-	       (gnus-last-element gnus-newsgroup-headers))))
-      (setq gnus-reffed-article-number -1)
-      ;; GROUP is successfully selected.
-      (or gnus-newsgroup-headers t)))))
-
-(defun gnus-articles-to-read (group read-all)
-  ;; Find out what articles the user wants to read.
-  (let* ((articles
-	  ;; Select all articles if `read-all' is non-nil, or if there
-	  ;; are no unread articles.
-	  (if (or read-all
-		  (and (zerop (length gnus-newsgroup-marked))
-		       (zerop (length gnus-newsgroup-unreads))))
-	      (gnus-uncompress-range (gnus-active group))
-	    (sort (append gnus-newsgroup-dormant gnus-newsgroup-marked
-			  (copy-sequence gnus-newsgroup-unreads))
-		  '<)))
-	 (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
-	 (scored (length scored-list))
-	 (number (length articles))
-	 (marked (+ (length gnus-newsgroup-marked)
-		    (length gnus-newsgroup-dormant)))
-	 (select
-	  (cond
-	   ((numberp read-all)
-	    read-all)
-	   (t
-	    (condition-case ()
-		(cond
-		 ((and (or (<= scored marked) (= scored number))
-		       (numberp gnus-large-newsgroup)
-		       (> number gnus-large-newsgroup))
-		  (let ((input
-			 (read-string
-			  (format
-			   "How many articles from %s (default %d): "
-			   gnus-newsgroup-name number))))
-		    (if (string-match "^[ \t]*$" input) number input)))
-		 ((and (> scored marked) (< scored number)
-		       (> (- scored number) 20))
-		  (let ((input
-			 (read-string
-			  (format "%s %s (%d scored, %d total): "
-				  "How many articles from"
-				  group scored number))))
-		    (if (string-match "^[ \t]*$" input)
-			number input)))
-		 (t number))
-	      (quit nil))))))
-    (setq select (if (stringp select) (string-to-number select) select))
-    (if (or (null select) (zerop select))
-	select
-      (if (and (not (zerop scored)) (<= (abs select) scored))
-	  (progn
-	    (setq articles (sort scored-list '<))
-	    (setq number (length articles)))
-	(setq articles (copy-sequence articles)))
-
-      (if (< (abs select) number)
-	  (if (< select 0)
-	      ;; Select the N oldest articles.
-	      (setcdr (nthcdr (1- (abs select)) articles) nil)
-	    ;; Select the N most recent articles.
-	    (setq articles (nthcdr (- number select) articles))))
-      (setq gnus-newsgroup-unselected
-	    (gnus-sorted-intersection
-	     gnus-newsgroup-unreads
-	     (gnus-sorted-complement gnus-newsgroup-unreads articles)))
-      articles)))
-
-(defun gnus-killed-articles (killed articles)
-  (let (out)
-    (while articles
-      (if (inline (gnus-member-of-range (car articles) killed))
-	  (setq out (cons (car articles) out)))
-      (setq articles (cdr articles)))
-    out))
-
-(defun gnus-uncompress-marks (marks)
-  "Uncompress the mark ranges in MARKS."
-  (let ((uncompressed '(score bookmark))
-	out)
-    (while marks
-      (if (memq (caar marks) uncompressed)
-	  (push (car marks) out)
-	(push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
-      (setq marks (cdr marks)))
-    out))
-
-(defun gnus-adjust-marked-articles (info)
-  "Set all article lists and remove all marks that are no longer legal."
-  (let* ((marked-lists (gnus-info-marks info))
-	 (active (gnus-active (gnus-info-group info)))
-	 (min (car active))
-	 (max (cdr active))
-	 (types gnus-article-mark-lists)
-	 (uncompressed '(score bookmark killed))
-	 marks var articles article mark)
-
-    (while marked-lists
-      (setq marks (pop marked-lists))
-      (set (setq var (intern (format "gnus-newsgroup-%s"
-				     (car (rassq (setq mark (car marks))
-						 types)))))
-	   (if (memq (car marks) uncompressed) (cdr marks)
-	     (gnus-uncompress-range (cdr marks))))
-
-      (setq articles (symbol-value var))
-
-      ;; All articles have to be subsets of the active articles.
-      (cond
-       ;; Adjust "simple" lists.
-       ((memq mark '(tick dormant expirable reply save))
-	(while articles
-	  (when (or (< (setq article (pop articles)) min) (> article max))
-	    (set var (delq article (symbol-value var))))))
-       ;; Adjust assocs.
-       ((memq mark uncompressed)
-	(while articles
-	  (when (or (not (consp (setq article (pop articles))))
-		    (< (car article) min)
-		    (> (car article) max))
-	    (set var (delq article (symbol-value var))))))))))
-
-(defun gnus-update-missing-marks (missing)
-  "Go through the list of MISSING articles and remove them mark lists."
-  (when missing
-    (let ((types gnus-article-mark-lists)
-	  var m)
-      ;; Go through all types.
-      (while types
-	(setq var (intern (format "gnus-newsgroup-%s" (car (pop types)))))
-	(when (symbol-value var)
-	  ;; This list has articles.  So we delete all missing articles
-	  ;; from it.
-	  (setq m missing)
-	  (while m
-	    (set var (delq (pop m) (symbol-value var)))))))))
-
-(defun gnus-update-marks ()
-  "Enter the various lists of marked articles into the newsgroup info list."
-  (let ((types gnus-article-mark-lists)
-	(info (gnus-get-info gnus-newsgroup-name))
-	(uncompressed '(score bookmark killed))
-	type list newmarked symbol)
-    (when info
-      ;; Add all marks lists that are non-nil to the list of marks lists.
-      (while types
-	(setq type (pop types))
-	(when (setq list (symbol-value
-			  (setq symbol
-				(intern (format "gnus-newsgroup-%s"
-						(car type))))))
-	  (push (cons (cdr type)
-		      (if (memq (cdr type) uncompressed) list
-			(gnus-compress-sequence 
-			 (set symbol (sort list '<)) t)))
-		newmarked)))
-
-      ;; Enter these new marks into the info of the group.
-      (if (nthcdr 3 info)
-	  (setcar (nthcdr 3 info) newmarked)
-	;; Add the marks lists to the end of the info.
-	(when newmarked
-	  (setcdr (nthcdr 2 info) (list newmarked))))
-
-      ;; Cut off the end of the info if there's nothing else there.
-      (let ((i 5))
-	(while (and (> i 2)
-		    (not (nth i info)))
-	  (when (nthcdr (decf i) info)
-	    (setcdr (nthcdr i info) nil)))))))
-
-(defun gnus-add-marked-articles (group type articles &optional info force)
-  ;; Add ARTICLES of TYPE to the info of GROUP.
-  ;; If INFO is non-nil, use that info.	 If FORCE is non-nil, don't
-  ;; add, but replace marked articles of TYPE with ARTICLES.
-  (let ((info (or info (gnus-get-info group)))
-	(uncompressed '(score bookmark killed))
-	marked m)
-    (or (not info)
-	(and (not (setq marked (nthcdr 3 info)))
-	     (or (null articles)
-		 (setcdr (nthcdr 2 info)
-			 (list (list (cons type (gnus-compress-sequence
-						 articles t)))))))
-	(and (not (setq m (assq type (car marked))))
-	     (or (null articles)
-		 (setcar marked
-			 (cons (cons type (gnus-compress-sequence articles t) )
-			       (car marked)))))
-	(if force
-	    (if (null articles)
-		(setcar (nthcdr 3 info)
-			(delq (assq type (car marked)) (car marked)))
-	      (setcdr m (gnus-compress-sequence articles t)))
-	  (setcdr m (gnus-compress-sequence
-		     (sort (nconc (gnus-uncompress-range (cdr m))
-				  (copy-sequence articles)) '<) t))))))
-
-(defun gnus-set-mode-line (where)
-  "This function sets the mode line of the article or summary buffers.
-If WHERE is `summary', the summary mode line format will be used."
-  ;; Is this mode line one we keep updated?
-  (when (memq where gnus-updated-mode-lines)
-    (let (mode-string)
-      (save-excursion
-	;; We evaluate this in the summary buffer since these
-	;; variables are buffer-local to that buffer.
-	(set-buffer gnus-summary-buffer)
-	;; We bind all these variables that are used in the `eval' form
-	;; below.
-	(let* ((mformat (symbol-value
-			 (intern
-			  (format "gnus-%s-mode-line-format-spec" where))))
-	       (gnus-tmp-group-name gnus-newsgroup-name)
-	       (gnus-tmp-article-number (or gnus-current-article 0))
-	       (gnus-tmp-unread gnus-newsgroup-unreads)
-	       (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
-	       (gnus-tmp-unselected (length gnus-newsgroup-unselected))
-	       (gnus-tmp-unread-and-unselected
-		(cond ((and (zerop gnus-tmp-unread-and-unticked)
-			    (zerop gnus-tmp-unselected)) "")
-		      ((zerop gnus-tmp-unselected)
-		       (format "{%d more}" gnus-tmp-unread-and-unticked))
-		      (t (format "{%d(+%d) more}"
-				 gnus-tmp-unread-and-unticked
-				 gnus-tmp-unselected))))
-	       (gnus-tmp-subject
-		(if (and gnus-current-headers
-			 (vectorp gnus-current-headers))
-		    (gnus-mode-string-quote
-		     (mail-header-subject gnus-current-headers)) ""))
-	       max-len
-	       gnus-tmp-header);; passed as argument to any user-format-funcs
-	  (setq mode-string (eval mformat))
-	  (setq max-len (max 4 (if gnus-mode-non-string-length
-				   (- (window-width)
-				      gnus-mode-non-string-length)
-				 (length mode-string))))
-	  ;; We might have to chop a bit of the string off...
-	  (when (> (length mode-string) max-len)
-	    (setq mode-string
-		  (concat (gnus-truncate-string mode-string (- max-len 3))
-			  "...")))
-	  ;; Pad the mode string a bit.
-	  (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
-      ;; Update the mode line.
-      (setq mode-line-buffer-identification 
-	    (gnus-mode-line-buffer-identification
-	     (list mode-string)))
-      (set-buffer-modified-p t))))
-
-(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
-  "Go through the HEADERS list and add all Xrefs to a hash table.
-The resulting hash table is returned, or nil if no Xrefs were found."
-  (let* ((virtual (gnus-virtual-group-p from-newsgroup))
-	 (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
-	 (xref-hashtb (make-vector 63 0))
-	 start group entry number xrefs header)
-    (while headers
-      (setq header (pop headers))
-      (when (and (setq xrefs (mail-header-xref header))
-		 (not (memq (setq number (mail-header-number header))
-			    unreads)))
-	(setq start 0)
-	(while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
-	  (setq start (match-end 0))
-	  (setq group (if prefix
-			  (concat prefix (substring xrefs (match-beginning 1)
-						    (match-end 1)))
-			(substring xrefs (match-beginning 1) (match-end 1))))
-	  (setq number
-		(string-to-int (substring xrefs (match-beginning 2)
-					  (match-end 2))))
-	  (if (setq entry (gnus-gethash group xref-hashtb))
-	      (setcdr entry (cons number (cdr entry)))
-	    (gnus-sethash group (cons number nil) xref-hashtb)))))
-    (and start xref-hashtb)))
-
-(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
-  "Look through all the headers and mark the Xrefs as read."
-  (let ((virtual (gnus-virtual-group-p from-newsgroup))
-	name entry info xref-hashtb idlist method nth4)
-    (save-excursion
-      (set-buffer gnus-group-buffer)
-      (when (setq xref-hashtb
-		  (gnus-create-xref-hashtb from-newsgroup headers unreads))
-	(mapatoms
-	 (lambda (group)
-	   (unless (string= from-newsgroup (setq name (symbol-name group)))
-	     (setq idlist (symbol-value group))
-	     ;; Dead groups are not updated.
-	     (and (prog1
-		      (setq entry (gnus-gethash name gnus-newsrc-hashtb)
-			    info (nth 2 entry))
-		    (if (stringp (setq nth4 (gnus-info-method info)))
-			(setq nth4 (gnus-server-to-method nth4))))
-		  ;; Only do the xrefs if the group has the same
-		  ;; select method as the group we have just read.
-		  (or (gnus-methods-equal-p
-		       nth4 (gnus-find-method-for-group from-newsgroup))
-		      virtual
-		      (equal nth4 (setq method (gnus-find-method-for-group
-						from-newsgroup)))
-		      (and (equal (car nth4) (car method))
-			   (equal (nth 1 nth4) (nth 1 method))))
-		  gnus-use-cross-reference
-		  (or (not (eq gnus-use-cross-reference t))
-		      virtual
-		      ;; Only do cross-references on subscribed
-		      ;; groups, if that is what is wanted.
-		      (<= (gnus-info-level info) gnus-level-subscribed))
-		  (gnus-group-make-articles-read name idlist))))
-	 xref-hashtb)))))
-
-(defun gnus-group-make-articles-read (group articles)
-  (let* ((num 0)
-	 (entry (gnus-gethash group gnus-newsrc-hashtb))
-	 (info (nth 2 entry))
-	 (active (gnus-active group))
-	 range)
-    ;; First peel off all illegal article numbers.
-    (if active
-	(let ((ids articles)
-	      id first)
-	  (while ids
-	    (setq id (car ids))
-	    (if (and first (> id (cdr active)))
-		(progn
-		  ;; We'll end up in this situation in one particular
-		  ;; obscure situation.	 If you re-scan a group and get
-		  ;; a new article that is cross-posted to a different
-		  ;; group that has not been re-scanned, you might get
-		  ;; crossposted article that has a higher number than
-		  ;; Gnus believes possible.  So we re-activate this
-		  ;; group as well.  This might mean doing the
-		  ;; crossposting thingy will *increase* the number
-		  ;; of articles in some groups.  Tsk, tsk.
-		  (setq active (or (gnus-activate-group group) active))))
-	    (if (or (> id (cdr active))
-		    (< id (car active)))
-		(setq articles (delq id articles)))
-	    (setq ids (cdr ids)))))
-    ;; If the read list is nil, we init it.
-    (and active
-	 (null (gnus-info-read info))
-	 (> (car active) 1)
-	 (gnus-info-set-read info (cons 1 (1- (car active)))))
-    ;; Then we add the read articles to the range.
-    (gnus-info-set-read
-     info
-     (setq range
-	   (gnus-add-to-range
-	    (gnus-info-read info) (setq articles (sort articles '<)))))
-    ;; Then we have to re-compute how many unread
-    ;; articles there are in this group.
-    (if active
-	(progn
-	  (cond
-	   ((not range)
-	    (setq num (- (1+ (cdr active)) (car active))))
-	   ((not (listp (cdr range)))
-	    (setq num (- (cdr active) (- (1+ (cdr range))
-					 (car range)))))
-	   (t
-	    (while range
-	      (if (numberp (car range))
-		  (setq num (1+ num))
-		(setq num (+ num (- (1+ (cdar range)) (caar range)))))
-	      (setq range (cdr range)))
-	    (setq num (- (cdr active) num))))
-	  ;; Update the number of unread articles.
-	  (setcar entry num)
-	  ;; Update the group buffer.
-	  (gnus-group-update-group group t)))))
-
-(defun gnus-methods-equal-p (m1 m2)
-  (let ((m1 (or m1 gnus-select-method))
-	(m2 (or m2 gnus-select-method)))
-    (or (equal m1 m2)
-	(and (eq (car m1) (car m2))
-	     (or (not (memq 'address (assoc (symbol-name (car m1))
-					    gnus-valid-select-methods)))
-		 (equal (nth 1 m1) (nth 1 m2)))))))
-
-(defsubst gnus-header-value ()
-  (buffer-substring (match-end 0) (gnus-point-at-eol)))
-
-(defvar gnus-newsgroup-none-id 0)
-
-(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
-  (let ((cur nntp-server-buffer)
-	(dependencies
-	 (or dependencies
-	     (save-excursion (set-buffer gnus-summary-buffer)
-			     gnus-newsgroup-dependencies)))
-	headers id id-dep ref-dep end ref)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (run-hooks 'gnus-parse-headers-hook)
-      (let ((case-fold-search t)
-	    in-reply-to header p lines)
-	(goto-char (point-min))
-	;; Search to the beginning of the next header.	Error messages
-	;; do not begin with 2 or 3.
-	(while (re-search-forward "^[23][0-9]+ " nil t)
-	  (setq id nil
-		ref nil)
-	  ;; This implementation of this function, with nine
-	  ;; search-forwards instead of the one re-search-forward and
-	  ;; a case (which basically was the old function) is actually
-	  ;; about twice as fast, even though it looks messier.	 You
-	  ;; can't have everything, I guess.  Speed and elegance
-	  ;; doesn't always go hand in hand.
-	  (setq
-	   header
-	   (vector
-	    ;; Number.
-	    (prog1
-		(read cur)
-	      (end-of-line)
-	      (setq p (point))
-	      (narrow-to-region (point)
-				(or (and (search-forward "\n.\n" nil t)
-					 (- (point) 2))
-				    (point))))
-	    ;; Subject.
-	    (progn
-	      (goto-char p)
-	      (if (search-forward "\nsubject: " nil t)
-		  (gnus-header-value) "(none)"))
-	    ;; From.
-	    (progn
-	      (goto-char p)
-	      (if (search-forward "\nfrom: " nil t)
-		  (gnus-header-value) "(nobody)"))
-	    ;; Date.
-	    (progn
-	      (goto-char p)
-	      (if (search-forward "\ndate: " nil t)
-		  (gnus-header-value) ""))
-	    ;; Message-ID.
-	    (progn
-	      (goto-char p)
-	      (if (search-forward "\nmessage-id: " nil t)
-		  (setq id (gnus-header-value))
-		;; If there was no message-id, we just fake one to make
-		;; subsequent routines simpler.
-		(setq id (concat "none+"
-				 (int-to-string
-				  (setq gnus-newsgroup-none-id
-					(1+ gnus-newsgroup-none-id)))))))
-	    ;; References.
-	    (progn
-	      (goto-char p)
-	      (if (search-forward "\nreferences: " nil t)
-		  (progn
-		    (setq end (point))
-		    (prog1
-			(gnus-header-value)
-		      (setq ref
-			    (buffer-substring
-			     (progn
-			       (end-of-line)
-			       (search-backward ">" end t)
-			       (1+ (point)))
-			     (progn
-			       (search-backward "<" end t)
-			       (point))))))
-		;; Get the references from the in-reply-to header if there
-		;; were no references and the in-reply-to header looks
-		;; promising.
-		(if (and (search-forward "\nin-reply-to: " nil t)
-			 (setq in-reply-to (gnus-header-value))
-			 (string-match "<[^>]+>" in-reply-to))
-		    (setq ref (substring in-reply-to (match-beginning 0)
-					 (match-end 0)))
-		  (setq ref ""))))
-	    ;; Chars.
-	    0
-	    ;; Lines.
-	    (progn
-	      (goto-char p)
-	      (if (search-forward "\nlines: " nil t)
-		  (if (numberp (setq lines (read cur)))
-		      lines 0)
-		0))
-	    ;; Xref.
-	    (progn
-	      (goto-char p)
-	      (and (search-forward "\nxref: " nil t)
-		   (gnus-header-value)))))
-	  ;; We do the threading while we read the headers.  The
-	  ;; message-id and the last reference are both entered into
-	  ;; the same hash table.  Some tippy-toeing around has to be
-	  ;; done in case an article has arrived before the article
-	  ;; which it refers to.
-	  (if (boundp (setq id-dep (intern id dependencies)))
-	      (if (and (car (symbol-value id-dep))
-		       (not force-new))
-		  ;; An article with this Message-ID has already
-		  ;; been seen, so we ignore this one, except we add
-		  ;; any additional Xrefs (in case the two articles
-		  ;; came from different servers).
-		  (progn
-		    (mail-header-set-xref
-		     (car (symbol-value id-dep))
-		     (concat (or (mail-header-xref
-				  (car (symbol-value id-dep))) "")
-			     (or (mail-header-xref header) "")))
-		    (setq header nil))
-		(setcar (symbol-value id-dep) header))
-	    (set id-dep (list header)))
-	  (when header
-	    (if (boundp (setq ref-dep (intern ref dependencies)))
-		(setcdr (symbol-value ref-dep)
-			(nconc (cdr (symbol-value ref-dep))
-			       (list (symbol-value id-dep))))
-	      (set ref-dep (list nil (symbol-value id-dep))))
-	    (setq headers (cons header headers)))
-	  (goto-char (point-max))
-	  (widen))
-	(nreverse headers)))))
-
-;; The following macros and functions were written by Felix Lee
-;; <flee@cse.psu.edu>.
-
-(defmacro gnus-nov-read-integer ()
-  '(prog1
-       (if (= (following-char) ?\t)
-	   0
-	 (let ((num (condition-case nil (read buffer) (error nil))))
-	   (if (numberp num) num 0)))
-     (or (eobp) (forward-char 1))))
-
-(defmacro gnus-nov-skip-field ()
-  '(search-forward "\t" eol 'move))
-
-(defmacro gnus-nov-field ()
-  '(buffer-substring (point) (if (gnus-nov-skip-field) (1- (point)) eol)))
-
-;; Goes through the xover lines and returns a list of vectors
-(defun gnus-get-newsgroup-headers-xover (sequence &optional 
-						  force-new dependencies)
-  "Parse the news overview data in the server buffer, and return a
-list of headers that match SEQUENCE (see `nntp-retrieve-headers')."
-  ;; Get the Xref when the users reads the articles since most/some
-  ;; NNTP servers do not include Xrefs when using XOVER.
-  (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
-  (let ((cur nntp-server-buffer)
-	(dependencies (or dependencies gnus-newsgroup-dependencies))
-	number headers header)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      ;; Allow the user to mangle the headers before parsing them.
-      (run-hooks 'gnus-parse-headers-hook)
-      (goto-char (point-min))
-      (while (and sequence (not (eobp)))
-	(setq number (read cur))
-	(while (and sequence (< (car sequence) number))
-	  (setq sequence (cdr sequence)))
-	(and sequence
-	     (eq number (car sequence))
-	     (progn
-	       (setq sequence (cdr sequence))
-	       (if (setq header
-			 (inline (gnus-nov-parse-line
-				  number dependencies force-new)))
-		   (setq headers (cons header headers)))))
-	(forward-line 1))
-      (setq headers (nreverse headers)))
-    headers))
-
-;; This function has to be called with point after the article number
-;; on the beginning of the line.
-(defun gnus-nov-parse-line (number dependencies &optional force-new)
-  (let ((none 0)
-	(eol (gnus-point-at-eol))
-	(buffer (current-buffer))
-	header ref id id-dep ref-dep)
-
-    ;; overview: [num subject from date id refs chars lines misc]
-    (narrow-to-region (point) eol)
-    (or (eobp) (forward-char))
-
-    (condition-case nil
-	(setq header
-	      (vector
-	       number			; number
-	       (gnus-nov-field)		; subject
-	       (gnus-nov-field)		; from
-	       (gnus-nov-field)		; date
-	       (setq id (or (gnus-nov-field)
-			    (concat "none+"
-				    (int-to-string
-				     (setq none (1+ none)))))) ; id
-	       (progn
-		 (save-excursion
-		   (let ((beg (point)))
-		     (search-forward "\t" eol)
-		     (if (search-backward ">" beg t)
-			 (setq ref
-			       (buffer-substring
-				(1+ (point))
-				(search-backward "<" beg t)))
-		       (setq ref nil))))
-		 (gnus-nov-field))	; refs
-	       (gnus-nov-read-integer)	; chars
-	       (gnus-nov-read-integer)	; lines
-	       (if (= (following-char) ?\n)
-		   nil
-		 (gnus-nov-field))	; misc
-	       ))
-      (error (progn
-	       (gnus-error 4 "Strange nov line")
-	       (setq header nil)
-	       (goto-char eol))))
-
-    (widen)
-
-    ;; We build the thread tree.
-    (when header
-      (if (boundp (setq id-dep (intern id dependencies)))
-	  (if (and (car (symbol-value id-dep))
-		   (not force-new))
-	      ;; An article with this Message-ID has already been seen,
-	      ;; so we ignore this one, except we add any additional
-	      ;; Xrefs (in case the two articles came from different
-	      ;; servers.
-	      (progn
-		(mail-header-set-xref
-		 (car (symbol-value id-dep))
-		 (concat (or (mail-header-xref
-			      (car (symbol-value id-dep))) "")
-			 (or (mail-header-xref header) "")))
-		(setq header nil))
-	    (setcar (symbol-value id-dep) header))
-	(set id-dep (list header))))
-    (when header
-      (if (boundp (setq ref-dep (intern (or ref "none") dependencies)))
-	  (setcdr (symbol-value ref-dep)
-		  (nconc (cdr (symbol-value ref-dep))
-			 (list (symbol-value id-dep))))
-	(set ref-dep (list nil (symbol-value id-dep)))))
-    header))
-
-(defun gnus-article-get-xrefs ()
-  "Fill in the Xref value in `gnus-current-headers', if necessary.
-This is meant to be called in `gnus-article-internal-prepare-hook'."
-  (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
-				 gnus-current-headers)))
-    (or (not gnus-use-cross-reference)
-	(not headers)
-	(and (mail-header-xref headers)
-	     (not (string= (mail-header-xref headers) "")))
-	(let ((case-fold-search t)
-	      xref)
-	  (save-restriction
-	    (nnheader-narrow-to-headers)
-	    (goto-char (point-min))
-	    (if (or (and (eq (downcase (following-char)) ?x)
-			 (looking-at "Xref:"))
-		    (search-forward "\nXref:" nil t))
-		(progn
-		  (goto-char (1+ (match-end 0)))
-		  (setq xref (buffer-substring (point)
-					       (progn (end-of-line) (point))))
-		  (mail-header-set-xref headers xref))))))))
-
-(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
-  "Find article ID and insert the summary line for that article."
-  (let ((header (if (and old-header use-old-header)
-		    old-header (gnus-read-header id)))
-	(number (and (numberp id) id))
-	pos)
-    (when header
-      ;; Rebuild the thread that this article is part of and go to the
-      ;; article we have fetched.
-      (when (and (not gnus-show-threads)
-		 old-header)
-	(when (setq pos (text-property-any
-			 (point-min) (point-max) 'gnus-number 
-			 (mail-header-number old-header)))
-	  (goto-char pos)
-	  (gnus-delete-line)
-	  (gnus-data-remove (mail-header-number old-header))))
-      (when old-header
-	(mail-header-set-number header (mail-header-number old-header)))
-      (setq gnus-newsgroup-sparse
-	    (delq (setq number (mail-header-number header)) 
-		  gnus-newsgroup-sparse))
-      (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
-      (gnus-rebuild-thread (mail-header-id header))
-      (gnus-summary-goto-subject number nil t))
-    (when (and (numberp number)
-	       (> number 0))
-      ;; We have to update the boundaries even if we can't fetch the
-      ;; article if ID is a number -- so that the next `P' or `N'
-      ;; command will fetch the previous (or next) article even
-      ;; if the one we tried to fetch this time has been canceled.
-      (and (> number gnus-newsgroup-end)
-	   (setq gnus-newsgroup-end number))
-      (and (< number gnus-newsgroup-begin)
-	   (setq gnus-newsgroup-begin number))
-      (setq gnus-newsgroup-unselected
-	    (delq number gnus-newsgroup-unselected)))
-    ;; Report back a success?
-    (and header (mail-header-number header))))
-
-(defun gnus-summary-work-articles (n)
-  "Return a list of articles to be worked upon.	 The prefix argument,
-the list of process marked articles, and the current article will be
-taken into consideration."
-  (cond
-   (n
-    ;; A numerical prefix has been given.
-    (let ((backward (< n 0))
-	  (n (abs (prefix-numeric-value n)))
-	  articles article)
-      (save-excursion
-	(while
-	    (and (> n 0)
-		 (push (setq article (gnus-summary-article-number))
-		       articles)
-		 (if backward
-		     (gnus-summary-find-prev nil article)
-		   (gnus-summary-find-next nil article)))
-	  (decf n)))
-      (nreverse articles)))
-   ((and (boundp 'transient-mark-mode)
-	 transient-mark-mode
-	 mark-active)
-    ;; Work on the region between point and mark.
-    (let ((max (max (point) (mark)))
-	  articles article)
-      (save-excursion
-	(goto-char (min (point) (mark)))
-	(while
-	    (and
-	     (push (setq article (gnus-summary-article-number)) articles)
-	     (gnus-summary-find-next nil article)
-	     (< (point) max)))
-	(nreverse articles))))
-   (gnus-newsgroup-processable
-    ;; There are process-marked articles present.
-    (reverse gnus-newsgroup-processable))
-   (t
-    ;; Just return the current article.
-    (list (gnus-summary-article-number)))))
-
-(defun gnus-summary-search-group (&optional backward use-level)
-  "Search for next unread newsgroup.
-If optional argument BACKWARD is non-nil, search backward instead."
-  (save-excursion
-    (set-buffer gnus-group-buffer)
-    (if (gnus-group-search-forward
-	 backward nil (if use-level (gnus-group-group-level) nil))
-	(gnus-group-group-name))))
-
-(defun gnus-summary-best-group (&optional exclude-group)
-  "Find the name of the best unread group.
-If EXCLUDE-GROUP, do not go to this group."
-  (save-excursion
-    (set-buffer gnus-group-buffer)
-    (save-excursion
-      (gnus-group-best-unread-group exclude-group))))
-
-(defun gnus-summary-find-next (&optional unread article backward)
-  (if backward (gnus-summary-find-prev)
-    (let* ((dummy (gnus-summary-article-intangible-p))
-	   (article (or article (gnus-summary-article-number)))
-	   (arts (gnus-data-find-list article))
-	   result)
-      (when (and (not dummy)
-		 (or (not gnus-summary-check-current)
-		     (not unread)
-		     (not (gnus-data-unread-p (car arts)))))
-	(setq arts (cdr arts)))
-      (when (setq result
-		  (if unread
-		      (progn
-			(while arts
-			  (when (gnus-data-unread-p (car arts))
-			    (setq result (car arts)
-				  arts nil))
-			  (setq arts (cdr arts)))
-			result)
-		    (car arts)))
-	(goto-char (gnus-data-pos result))
-	(gnus-data-number result)))))
-
-(defun gnus-summary-find-prev (&optional unread article)
-  (let* ((eobp (eobp))
-	 (article (or article (gnus-summary-article-number)))
-	 (arts (gnus-data-find-list article (gnus-data-list 'rev)))
-	 result)
-    (when (and (not eobp)
-	       (or (not gnus-summary-check-current)
-		   (not unread)
-		   (not (gnus-data-unread-p (car arts)))))
-      (setq arts (cdr arts)))
-    (if (setq result
-	      (if unread
-		  (progn
-		    (while arts
-		      (and (gnus-data-unread-p (car arts))
-			   (setq result (car arts)
-				 arts nil))
-		      (setq arts (cdr arts)))
-		    result)
-		(car arts)))
-	(progn
-	  (goto-char (gnus-data-pos result))
-	  (gnus-data-number result)))))
-
-(defun gnus-summary-find-subject (subject &optional unread backward article)
-  (let* ((simp-subject (gnus-simplify-subject-fully subject))
-	 (article (or article (gnus-summary-article-number)))
-	 (articles (gnus-data-list backward))
-	 (arts (gnus-data-find-list article articles))
-	 result)
-    (when (or (not gnus-summary-check-current)
-	      (not unread)
-	      (not (gnus-data-unread-p (car arts))))
-      (setq arts (cdr arts)))
-    (while arts
-      (and (or (not unread)
-	       (gnus-data-unread-p (car arts)))
-	   (vectorp (gnus-data-header (car arts)))
-	   (gnus-subject-equal
-	    simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
-	   (setq result (car arts)
-		 arts nil))
-      (setq arts (cdr arts)))
-    (and result
-	 (goto-char (gnus-data-pos result))
-	 (gnus-data-number result))))
-
-(defun gnus-summary-search-forward (&optional unread subject backward)
-  "Search forward for an article.
-If UNREAD, look for unread articles.  If SUBJECT, look for
-articles with that subject.  If BACKWARD, search backward instead."
-  (cond (subject (gnus-summary-find-subject subject unread backward))
-	(backward (gnus-summary-find-prev unread))
-	(t (gnus-summary-find-next unread))))
-
-(defun gnus-recenter (&optional n)
-  "Center point in window and redisplay frame.
-Also do horizontal recentering."
-  (interactive "P")
-  (when (and gnus-auto-center-summary
-	     (not (eq gnus-auto-center-summary 'vertical)))
-    (gnus-horizontal-recenter))
-  (recenter n))
-
-(defun gnus-summary-recenter ()
-  "Center point in the summary window.
-If `gnus-auto-center-summary' is nil, or the article buffer isn't
-displayed, no centering will be performed."
-  ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
-  ;; Recenter only when requested.  Suggested by popovich@park.cs.columbia.edu.
-  (let* ((top (cond ((< (window-height) 4) 0)
-		    ((< (window-height) 7) 1)
-		    (t 2)))
-	 (height (1- (window-height)))
-	 (bottom (save-excursion (goto-char (point-max))
-				 (forward-line (- height))
-				 (point)))
-	 (window (get-buffer-window (current-buffer))))
-    ;; The user has to want it.
-    (when gnus-auto-center-summary
-      (when (get-buffer-window gnus-article-buffer)
-       ;; Only do recentering when the article buffer is displayed,
-       ;; Set the window start to either `bottom', which is the biggest
-       ;; possible valid number, or the second line from the top,
-       ;; whichever is the least.
-       (set-window-start
-	window (min bottom (save-excursion 
-			     (forward-line (- top)) (point)))))
-      ;; Do horizontal recentering while we're at it.
-      (when (and (get-buffer-window (current-buffer) t)
-		 (not (eq gnus-auto-center-summary 'vertical)))
-	(let ((selected (selected-window)))
-	  (select-window (get-buffer-window (current-buffer) t))
-	  (gnus-summary-position-point)
-	  (gnus-horizontal-recenter)
-	  (select-window selected))))))
-
-(defun gnus-horizontal-recenter ()
-  "Recenter the current buffer horizontally."
-  (if (< (current-column) (/ (window-width) 2))
-      (set-window-hscroll (get-buffer-window (current-buffer) t) 0)
-    (let* ((orig (point))
-	   (end (window-end (get-buffer-window (current-buffer) t)))
-	   (max 0))
-      ;; Find the longest line currently displayed in the window.
-      (goto-char (window-start))
-      (while (and (not (eobp)) 
-		  (< (point) end))
-	(end-of-line)
-	(setq max (max max (current-column)))
-	(forward-line 1))
-      (goto-char orig)
-      ;; Scroll horizontally to center (sort of) the point.
-      (if (> max (window-width))
-	  (set-window-hscroll 
-	   (get-buffer-window (current-buffer) t)
-	   (min (- (current-column) (/ (window-width) 3))
-		(+ 2 (- max (window-width)))))
-	(set-window-hscroll (get-buffer-window (current-buffer) t) 0))
-      max)))
-
-;; Function written by Stainless Steel Rat <ratinox@ccs.neu.edu>.
-(defun gnus-short-group-name (group &optional levels)
-  "Collapse GROUP name LEVELS."
-  (let* ((name "") 
-	 (foreign "")
-	 (depth 0) 
-	 (skip 1)
-	 (levels (or levels
-		     (progn
-		       (while (string-match "\\." group skip)
-			 (setq skip (match-end 0)
-			       depth (+ depth 1)))
-		       depth))))
-    (if (string-match ":" group)
-	(setq foreign (substring group 0 (match-end 0))
-	      group (substring group (match-end 0))))
-    (while group
-      (if (and (string-match "\\." group)
-	       (> levels (- gnus-group-uncollapsed-levels 1)))
-	  (setq name (concat name (substring group 0 1))
-		group (substring group (match-end 0))
-		levels (- levels 1)
-		name (concat name "."))
-	(setq name (concat foreign name group)
-	      group nil)))
-    name))
-
-(defun gnus-summary-jump-to-group (newsgroup)
-  "Move point to NEWSGROUP in group mode buffer."
-  ;; Keep update point of group mode buffer if visible.
-  (if (eq (current-buffer) (get-buffer gnus-group-buffer))
-      (save-window-excursion
-	;; Take care of tree window mode.
-	(if (get-buffer-window gnus-group-buffer)
-	    (pop-to-buffer gnus-group-buffer))
-	(gnus-group-jump-to-group newsgroup))
-    (save-excursion
-      ;; Take care of tree window mode.
-      (if (get-buffer-window gnus-group-buffer)
-	  (pop-to-buffer gnus-group-buffer)
-	(set-buffer gnus-group-buffer))
-      (gnus-group-jump-to-group newsgroup))))
-
-;; This function returns a list of article numbers based on the
-;; difference between the ranges of read articles in this group and
-;; the range of active articles.
-(defun gnus-list-of-unread-articles (group)
-  (let* ((read (gnus-info-read (gnus-get-info group)))
-	 (active (gnus-active group))
-	 (last (cdr active))
-	 first nlast unread)
-    ;; If none are read, then all are unread.
-    (if (not read)
-	(setq first (car active))
-      ;; If the range of read articles is a single range, then the
-      ;; first unread article is the article after the last read
-      ;; article.  Sounds logical, doesn't it?
-      (if (not (listp (cdr read)))
-	  (setq first (1+ (cdr read)))
-	;; `read' is a list of ranges.
-	(if (/= (setq nlast (or (and (numberp (car read)) (car read))
-				(caar read))) 1)
-	    (setq first 1))
-	(while read
-	  (if first
-	      (while (< first nlast)
-		(setq unread (cons first unread))
-		(setq first (1+ first))))
-	  (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
-	  (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
-	  (setq read (cdr read)))))
-    ;; And add the last unread articles.
-    (while (<= first last)
-      (setq unread (cons first unread))
-      (setq first (1+ first)))
-    ;; Return the list of unread articles.
-    (nreverse unread)))
-
-(defun gnus-list-of-read-articles (group)
-  "Return a list of unread, unticked and non-dormant articles."
-  (let* ((info (gnus-get-info group))
-	 (marked (gnus-info-marks info))
-	 (active (gnus-active group)))
-    (and info active
-	 (gnus-set-difference
-	  (gnus-sorted-complement
-	   (gnus-uncompress-range active)
-	   (gnus-list-of-unread-articles group))
-	  (append
-	   (gnus-uncompress-range (cdr (assq 'dormant marked)))
-	   (gnus-uncompress-range (cdr (assq 'tick marked))))))))
-
-;; Various summary commands
-
-(defun gnus-summary-universal-argument (arg)
-  "Perform any operation on all articles that are process/prefixed."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((articles (gnus-summary-work-articles arg))
-	func article)
-    (if (eq
-	 (setq
-	  func
-	  (key-binding
-	   (read-key-sequence
-	    (substitute-command-keys
-	     "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"
-	     ))))
-	 'undefined)
-	(gnus-error 1 "Undefined key")
-      (save-excursion
-	(while articles
-	  (gnus-summary-goto-subject (setq article (pop articles)))
-	  (command-execute func)
-	  (gnus-summary-remove-process-mark article)))))
-  (gnus-summary-position-point))
-
-(defun gnus-summary-toggle-truncation (&optional arg)
-  "Toggle truncation of summary lines.
-With arg, turn line truncation on iff arg is positive."
-  (interactive "P")
-  (setq truncate-lines
-	(if (null arg) (not truncate-lines)
-	  (> (prefix-numeric-value arg) 0)))
-  (redraw-display))
-
-(defun gnus-summary-reselect-current-group (&optional all rescan)
-  "Exit and then reselect the current newsgroup.
-The prefix argument ALL means to select all articles."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (when (gnus-ephemeral-group-p gnus-newsgroup-name)
-    (error "Ephemeral groups can't be reselected"))
-  (let ((current-subject (gnus-summary-article-number))
-	(group gnus-newsgroup-name))
-    (setq gnus-newsgroup-begin nil)
-    (gnus-summary-exit)
-    ;; We have to adjust the point of group mode buffer because the
-    ;; current point was moved to the next unread newsgroup by
-    ;; exiting.
-    (gnus-summary-jump-to-group group)
-    (when rescan
-      (save-excursion
-	(gnus-group-get-new-news-this-group 1)))
-    (gnus-group-read-group all t)
-    (gnus-summary-goto-subject current-subject nil t)))
-
-(defun gnus-summary-rescan-group (&optional all)
-  "Exit the newsgroup, ask for new articles, and select the newsgroup."
-  (interactive "P")
-  (gnus-summary-reselect-current-group all t))
-
-(defun gnus-summary-update-info ()
-  (let* ((group gnus-newsgroup-name))
-    (when gnus-newsgroup-kill-headers
-      (setq gnus-newsgroup-killed
-	    (gnus-compress-sequence
-	     (nconc
-	      (gnus-set-sorted-intersection
-	       (gnus-uncompress-range gnus-newsgroup-killed)
-	       (setq gnus-newsgroup-unselected
-		     (sort gnus-newsgroup-unselected '<)))
-	      (setq gnus-newsgroup-unreads
-		    (sort gnus-newsgroup-unreads '<))) t)))
-    (unless (listp (cdr gnus-newsgroup-killed))
-      (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
-    (let ((headers gnus-newsgroup-headers))
-      (run-hooks 'gnus-exit-group-hook)
-      (unless gnus-save-score
-	(setq gnus-newsgroup-scored nil))
-      ;; Set the new ranges of read articles.
-      (gnus-update-read-articles
-       group (append gnus-newsgroup-unreads gnus-newsgroup-unselected))
-      ;; Set the current article marks.
-      (gnus-update-marks)
-      ;; Do the cross-ref thing.
-      (when gnus-use-cross-reference
-	(gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
-      ;; Do adaptive scoring, and possibly save score files.
-      (when gnus-newsgroup-adaptive
-	(gnus-score-adaptive))
-      (when gnus-use-scoring
-	(gnus-score-save))
-      ;; Do not switch windows but change the buffer to work.
-      (set-buffer gnus-group-buffer)
-      (or (gnus-ephemeral-group-p gnus-newsgroup-name)
-	  (gnus-group-update-group group)))))
-
-(defun gnus-summary-exit (&optional temporary)
-  "Exit reading current newsgroup, and then return to group selection mode.
-gnus-exit-group-hook is called with no arguments if that value is non-nil."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-kill-save-kill-buffer)
-  (let* ((group gnus-newsgroup-name)
-	 (quit-config (gnus-group-quit-config gnus-newsgroup-name))
-	 (mode major-mode)
-	 (buf (current-buffer)))
-    (run-hooks 'gnus-summary-prepare-exit-hook)
-    ;; If we have several article buffers, we kill them at exit.
-    (unless gnus-single-article-buffer
-      (gnus-kill-buffer gnus-original-article-buffer)
-      (setq gnus-article-current nil))
-    (when gnus-use-cache
-      (gnus-cache-possibly-remove-articles)
-      (gnus-cache-save-buffers))
-    (when gnus-use-trees
-      (gnus-tree-close group))
-    ;; Make all changes in this group permanent.
-    (unless quit-config
-      (gnus-summary-update-info))
-    (gnus-close-group group)
-    ;; Make sure where I was, and go to next newsgroup.
-    (set-buffer gnus-group-buffer)
-    (unless quit-config
-      (gnus-group-jump-to-group group))
-    (run-hooks 'gnus-summary-exit-hook)
-    (unless quit-config
-      (gnus-group-next-unread-group 1))
-    (if temporary
-	nil				;Nothing to do.
-      ;; If we have several article buffers, we kill them at exit.
-      (unless gnus-single-article-buffer
-	(gnus-kill-buffer gnus-article-buffer)
-	(gnus-kill-buffer gnus-original-article-buffer)
-	(setq gnus-article-current nil))
-      (set-buffer buf)
-      (if (not gnus-kill-summary-on-exit)
-	  (gnus-deaden-summary)
-	;; We set all buffer-local variables to nil.  It is unclear why
-	;; this is needed, but if we don't, buffer-local variables are
-	;; not garbage-collected, it seems.  This would the lead to en
-	;; ever-growing Emacs.
-	(gnus-summary-clear-local-variables)
-	(when (get-buffer gnus-article-buffer)
-	  (bury-buffer gnus-article-buffer))
-	;; We clear the global counterparts of the buffer-local
-	;; variables as well, just to be on the safe side.
-	(gnus-configure-windows 'group 'force)
-	(gnus-summary-clear-local-variables)
-	;; Return to group mode buffer.
-	(if (eq mode 'gnus-summary-mode)
-	    (gnus-kill-buffer buf)))
-      (setq gnus-current-select-method gnus-select-method)
-      (pop-to-buffer gnus-group-buffer)
-      ;; Clear the current group name.
-      (if (not quit-config)
-	  (progn
-	    (gnus-group-jump-to-group group)
-	    (gnus-group-next-unread-group 1)
-	    (gnus-configure-windows 'group 'force))
-	(if (not (buffer-name (car quit-config)))
-	    (gnus-configure-windows 'group 'force)
-	  (set-buffer (car quit-config))
-	  (and (eq major-mode 'gnus-summary-mode)
-	       (gnus-set-global-variables))
-	  (gnus-configure-windows (cdr quit-config))))
-      (unless quit-config
-	(setq gnus-newsgroup-name nil)))))
-
-(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
-(defun gnus-summary-exit-no-update (&optional no-questions)
-  "Quit reading current newsgroup without updating read article info."
-  (interactive)
-  (gnus-set-global-variables)
-  (let* ((group gnus-newsgroup-name)
-	 (quit-config (gnus-group-quit-config group)))
-    (when (or no-questions
-	      gnus-expert-user
-	      (gnus-y-or-n-p "Do you really wanna quit reading this group? "))
-      ;; If we have several article buffers, we kill them at exit.
-      (unless gnus-single-article-buffer
-	(gnus-kill-buffer gnus-article-buffer)
-	(gnus-kill-buffer gnus-original-article-buffer)
-	(setq gnus-article-current nil))
-      (if (not gnus-kill-summary-on-exit)
-	  (gnus-deaden-summary)
-	(gnus-close-group group)
-	(gnus-summary-clear-local-variables)
-	(set-buffer gnus-group-buffer)
-	(gnus-summary-clear-local-variables)
-	(when (get-buffer gnus-summary-buffer)
-	  (kill-buffer gnus-summary-buffer)))
-      (unless gnus-single-article-buffer
-	(setq gnus-article-current nil))
-      (when gnus-use-trees
-	(gnus-tree-close group))
-      (when (get-buffer gnus-article-buffer)
-	(bury-buffer gnus-article-buffer))
-      ;; Return to the group buffer.
-      (gnus-configure-windows 'group 'force)
-      ;; Clear the current group name.
-      (setq gnus-newsgroup-name nil)
-      (when (equal (gnus-group-group-name) group)
-	(gnus-group-next-unread-group 1))
-      (when quit-config
-	(if (not (buffer-name (car quit-config)))
-	    (gnus-configure-windows 'group 'force)
-	  (set-buffer (car quit-config))
-	  (when (eq major-mode 'gnus-summary-mode)
-	    (gnus-set-global-variables))
-	  (gnus-configure-windows (cdr quit-config)))))))
-
-;;; Dead summaries.
-
-(defvar gnus-dead-summary-mode-map nil)
-
-(if gnus-dead-summary-mode-map
-    nil
-  (setq gnus-dead-summary-mode-map (make-keymap))
-  (suppress-keymap gnus-dead-summary-mode-map)
-  (substitute-key-definition
-   'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
-  (let ((keys '("\C-d" "\r" "\177")))
-    (while keys
-      (define-key gnus-dead-summary-mode-map
-	(pop keys) 'gnus-summary-wake-up-the-dead))))
-
-(defvar gnus-dead-summary-mode nil
-  "Minor mode for Gnus summary buffers.")
-
-(defun gnus-dead-summary-mode (&optional arg)
-  "Minor mode for Gnus summary buffers."
-  (interactive "P")
-  (when (eq major-mode 'gnus-summary-mode)
-    (make-local-variable 'gnus-dead-summary-mode)
-    (setq gnus-dead-summary-mode
-	  (if (null arg) (not gnus-dead-summary-mode)
-	    (> (prefix-numeric-value arg) 0)))
-    (when gnus-dead-summary-mode
-      (unless (assq 'gnus-dead-summary-mode minor-mode-alist)
-	(push '(gnus-dead-summary-mode " Dead") minor-mode-alist))
-      (unless (assq 'gnus-dead-summary-mode minor-mode-map-alist)
-	(push (cons 'gnus-dead-summary-mode gnus-dead-summary-mode-map)
-	      minor-mode-map-alist)))))
-
-(defun gnus-deaden-summary ()
-  "Make the current summary buffer into a dead summary buffer."
-  ;; Kill any previous dead summary buffer.
-  (when (and gnus-dead-summary
-	     (buffer-name gnus-dead-summary))
-    (save-excursion
-      (set-buffer gnus-dead-summary)
-      (when gnus-dead-summary-mode
-	(kill-buffer (current-buffer)))))
-  ;; Make this the current dead summary.
-  (setq gnus-dead-summary (current-buffer))
-  (gnus-dead-summary-mode 1)
-  (let ((name (buffer-name)))
-    (when (string-match "Summary" name)
-      (rename-buffer
-       (concat (substring name 0 (match-beginning 0)) "Dead "
-	       (substring name (match-beginning 0))) t))))
-
-(defun gnus-kill-or-deaden-summary (buffer)
-  "Kill or deaden the summary BUFFER."
-  (when (and (buffer-name buffer)
-	     (not gnus-single-article-buffer))
-    (save-excursion
-      (set-buffer buffer)
-      (gnus-kill-buffer gnus-article-buffer)
-      (gnus-kill-buffer gnus-original-article-buffer)))
-  (cond (gnus-kill-summary-on-exit
-	 (when (and gnus-use-trees
-		    (and (get-buffer buffer)
-			 (buffer-name (get-buffer buffer))))
-	   (save-excursion
-	     (set-buffer (get-buffer buffer))
-	     (gnus-tree-close gnus-newsgroup-name)))
-	 (gnus-kill-buffer buffer))
-	((and (get-buffer buffer)
-	      (buffer-name (get-buffer buffer)))
-	 (save-excursion
-	   (set-buffer buffer)
-	   (gnus-deaden-summary)))))
-
-(defun gnus-summary-wake-up-the-dead (&rest args)
-  "Wake up the dead summary buffer."
-  (interactive)
-  (gnus-dead-summary-mode -1)
-  (let ((name (buffer-name)))
-    (when (string-match "Dead " name)
-      (rename-buffer
-       (concat (substring name 0 (match-beginning 0))
-	       (substring name (match-end 0))) t)))
-  (gnus-message 3 "This dead summary is now alive again"))
-
-;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
-(defun gnus-summary-fetch-faq (&optional faq-dir)
-  "Fetch the FAQ for the current group.
-If FAQ-DIR (the prefix), prompt for a directory to search for the faq
-in."
-  (interactive
-   (list
-    (if current-prefix-arg
-	(completing-read
-	 "Faq dir: " (and (listp gnus-group-faq-directory)
-			  gnus-group-faq-directory)))))
-  (let (gnus-faq-buffer)
-    (and (setq gnus-faq-buffer
-	       (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
-	 (gnus-configure-windows 'summary-faq))))
-
-;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-summary-describe-group (&optional force)
-  "Describe the current newsgroup."
-  (interactive "P")
-  (gnus-group-describe-group force gnus-newsgroup-name))
-
-(defun gnus-summary-describe-briefly ()
-  "Describe summary mode commands briefly."
-  (interactive)
-  (gnus-message 6
-		(substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select  \\[gnus-summary-next-unread-article]:Forward  \\[gnus-summary-prev-unread-article]:Backward  \\[gnus-summary-exit]:Exit  \\[gnus-info-find-node]:Run Info	 \\[gnus-summary-describe-briefly]:This help")))
-
-;; Walking around group mode buffer from summary mode.
-
-(defun gnus-summary-next-group (&optional no-article target-group backward)
-  "Exit current newsgroup and then select next unread newsgroup.
-If prefix argument NO-ARTICLE is non-nil, no article is selected
-initially.  If NEXT-GROUP, go to this group.  If BACKWARD, go to
-previous group instead."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((current-group gnus-newsgroup-name)
-	(current-buffer (current-buffer))
-	entered)
-    ;; First we semi-exit this group to update Xrefs and all variables.
-    ;; We can't do a real exit, because the window conf must remain
-    ;; the same in case the user is prompted for info, and we don't
-    ;; want the window conf to change before that...
-    (gnus-summary-exit t)
-    (while (not entered)
-      ;; Then we find what group we are supposed to enter.
-      (set-buffer gnus-group-buffer)
-      (gnus-group-jump-to-group current-group)
-      (setq target-group
-	    (or target-group
-		(if (eq gnus-keep-same-level 'best)
-		    (gnus-summary-best-group gnus-newsgroup-name)
-		  (gnus-summary-search-group backward gnus-keep-same-level))))
-      (if (not target-group)
-	  ;; There are no further groups, so we return to the group
-	  ;; buffer.
-	  (progn
-	    (gnus-message 5 "Returning to the group buffer")
-	    (setq entered t)
-	    (set-buffer current-buffer)
-	    (gnus-summary-exit))
-	;; We try to enter the target group.
-	(gnus-group-jump-to-group target-group)
-	(let ((unreads (gnus-group-group-unread)))
-	  (if (and (or (eq t unreads)
-		       (and unreads (not (zerop unreads))))
-		   (gnus-summary-read-group
-		    target-group nil no-article current-buffer))
-	      (setq entered t)
-	    (setq current-group target-group
-		  target-group nil)))))))
-
-(defun gnus-summary-prev-group (&optional no-article)
-  "Exit current newsgroup and then select previous unread newsgroup.
-If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
-  (interactive "P")
-  (gnus-summary-next-group no-article nil t))
-
-;; Walking around summary lines.
-
-(defun gnus-summary-first-subject (&optional unread)
-  "Go to the first unread subject.
-If UNREAD is non-nil, go to the first unread article.
-Returns the article selected or nil if there are no unread articles."
-  (interactive "P")
-  (prog1
-      (cond
-       ;; Empty summary.
-       ((null gnus-newsgroup-data)
-	(gnus-message 3 "No articles in the group")
-	nil)
-       ;; Pick the first article.
-       ((not unread)
-	(goto-char (gnus-data-pos (car gnus-newsgroup-data)))
-	(gnus-data-number (car gnus-newsgroup-data)))
-       ;; No unread articles.
-       ((null gnus-newsgroup-unreads)
-	(gnus-message 3 "No more unread articles")
-	nil)
-       ;; Find the first unread article.
-       (t
-	(let ((data gnus-newsgroup-data))
-	  (while (and data
-		      (not (gnus-data-unread-p (car data))))
-	    (setq data (cdr data)))
-	  (if data
-	      (progn
-		(goto-char (gnus-data-pos (car data)))
-		(gnus-data-number (car data)))))))
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-next-subject (n &optional unread dont-display)
-  "Go to next N'th summary line.
-If N is negative, go to the previous N'th subject line.
-If UNREAD is non-nil, only unread articles are selected.
-The difference between N and the actual number of steps taken is
-returned."
-  (interactive "p")
-  (let ((backward (< n 0))
-	(n (abs n)))
-    (while (and (> n 0)
-		(if backward
-		    (gnus-summary-find-prev unread)
-		  (gnus-summary-find-next unread)))
-      (setq n (1- n)))
-    (if (/= 0 n) (gnus-message 7 "No more%s articles"
-			       (if unread " unread" "")))
-    (unless dont-display
-      (gnus-summary-recenter)
-      (gnus-summary-position-point))
-    n))
-
-(defun gnus-summary-next-unread-subject (n)
-  "Go to next N'th unread summary line."
-  (interactive "p")
-  (gnus-summary-next-subject n t))
-
-(defun gnus-summary-prev-subject (n &optional unread)
-  "Go to previous N'th summary line.
-If optional argument UNREAD is non-nil, only unread article is selected."
-  (interactive "p")
-  (gnus-summary-next-subject (- n) unread))
-
-(defun gnus-summary-prev-unread-subject (n)
-  "Go to previous N'th unread summary line."
-  (interactive "p")
-  (gnus-summary-next-subject (- n) t))
-
-(defun gnus-summary-goto-subject (article &optional force silent)
-  "Go the subject line of ARTICLE.
-If FORCE, also allow jumping to articles not currently shown."
-  (let ((b (point))
-	(data (gnus-data-find article)))
-    ;; We read in the article if we have to.
-    (and (not data)
-	 force
-	 (gnus-summary-insert-subject article (and (vectorp force) force) t)
-	 (setq data (gnus-data-find article)))
-    (goto-char b)
-    (if (not data)
-	(progn
-	  (unless silent
-	    (gnus-message 3 "Can't find article %d" article))
-	  nil)
-      (goto-char (gnus-data-pos data))
-      article)))
-
-;; Walking around summary lines with displaying articles.
-
-(defun gnus-summary-expand-window (&optional arg)
-  "Make the summary buffer take up the entire Emacs frame.
-Given a prefix, will force an `article' buffer configuration."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (if arg
-      (gnus-configure-windows 'article 'force)
-    (gnus-configure-windows 'summary 'force)))
-
-(defun gnus-summary-display-article (article &optional all-header)
-  "Display ARTICLE in article buffer."
-  (gnus-set-global-variables)
-  (if (null article)
-      nil
-    (prog1
-	(if gnus-summary-display-article-function
-	    (funcall gnus-summary-display-article-function article all-header)
-	  (gnus-article-prepare article all-header))
-      (run-hooks 'gnus-select-article-hook)
-      (unless (zerop gnus-current-article)
-	(gnus-summary-goto-subject gnus-current-article))
-      (gnus-summary-recenter)
-      (when gnus-use-trees
-	(gnus-possibly-generate-tree article)
-	(gnus-highlight-selected-tree article))
-      ;; Successfully display article.
-      (gnus-article-set-window-start
-       (cdr (assq article gnus-newsgroup-bookmarks))))))
-
-(defun gnus-summary-select-article (&optional all-headers force pseudo article)
-  "Select the current article.
-If ALL-HEADERS is non-nil, show all header fields.  If FORCE is
-non-nil, the article will be re-fetched even if it already present in
-the article buffer.  If PSEUDO is non-nil, pseudo-articles will also
-be displayed."
-  ;; Make sure we are in the summary buffer to work around bbdb bug.
-  (unless (eq major-mode 'gnus-summary-mode)
-    (set-buffer gnus-summary-buffer))
-  (let ((article (or article (gnus-summary-article-number)))
-	(all-headers (not (not all-headers))) ;Must be T or NIL.
-	gnus-summary-display-article-function
-	did)
-    (and (not pseudo)
-	 (gnus-summary-article-pseudo-p article)
-	 (error "This is a pseudo-article."))
-    (prog1
-	(save-excursion
-	  (set-buffer gnus-summary-buffer)
-	  (if (or (and gnus-single-article-buffer
-		       (or (null gnus-current-article)
-			   (null gnus-article-current)
-			   (null (get-buffer gnus-article-buffer))
-			   (not (eq article (cdr gnus-article-current)))
-			   (not (equal (car gnus-article-current)
-				       gnus-newsgroup-name))))
-		  (and (not gnus-single-article-buffer)
-		       (or (null gnus-current-article)
-			   (not (eq gnus-current-article article))))
-		  force)
-	      ;; The requested article is different from the current article.
-	      (prog1
-		  (gnus-summary-display-article article all-headers)
-		(setq did article))
-	    (if (or all-headers gnus-show-all-headers)
-		(gnus-article-show-all-headers))
-	    'old))
-      (if did
-	  (gnus-article-set-window-start
-	   (cdr (assq article gnus-newsgroup-bookmarks)))))))
-
-(defun gnus-summary-set-current-mark (&optional current-mark)
-  "Obsolete function."
-  nil)
-
-(defun gnus-summary-next-article (&optional unread subject backward push)
-  "Select the next article.
-If UNREAD, only unread articles are selected.
-If SUBJECT, only articles with SUBJECT are selected.
-If BACKWARD, the previous article is selected instead of the next."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (cond
-   ;; Is there such an article?
-   ((and (gnus-summary-search-forward unread subject backward)
-	 (or (gnus-summary-display-article (gnus-summary-article-number))
-	     (eq (gnus-summary-article-mark) gnus-canceled-mark)))
-    (gnus-summary-position-point))
-   ;; If not, we try the first unread, if that is wanted.
-   ((and subject
-	 gnus-auto-select-same
-	 (gnus-summary-first-unread-article))
-    (gnus-summary-position-point)
-    (gnus-message 6 "Wrapped"))
-   ;; Try to get next/previous article not displayed in this group.
-   ((and gnus-auto-extend-newsgroup
-	 (not unread) (not subject))
-    (gnus-summary-goto-article
-     (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
-     nil t))
-   ;; Go to next/previous group.
-   (t
-    (or (gnus-ephemeral-group-p gnus-newsgroup-name)
-	(gnus-summary-jump-to-group gnus-newsgroup-name))
-    (let ((cmd last-command-char)
-	  (group
-	   (if (eq gnus-keep-same-level 'best)
-	       (gnus-summary-best-group gnus-newsgroup-name)
-	     (gnus-summary-search-group backward gnus-keep-same-level))))
-      ;; For some reason, the group window gets selected.  We change
-      ;; it back.
-      (select-window (get-buffer-window (current-buffer)))
-      ;; Select next unread newsgroup automagically.
-      (cond
-       ((or (not gnus-auto-select-next)
-	    (not cmd))
-	(gnus-message 7 "No more%s articles" (if unread " unread" "")))
-       ((or (eq gnus-auto-select-next 'quietly)
-	    (and (eq gnus-auto-select-next 'slightly-quietly)
-		 push)
-	    (and (eq gnus-auto-select-next 'almost-quietly)
-		 (gnus-summary-last-article-p)))
-	;; Select quietly.
-	(if (gnus-ephemeral-group-p gnus-newsgroup-name)
-	    (gnus-summary-exit)
-	  (gnus-message 7 "No more%s articles (%s)..."
-			(if unread " unread" "")
-			(if group (concat "selecting " group)
-			  "exiting"))
-	  (gnus-summary-next-group nil group backward)))
-       (t
-	(gnus-summary-walk-group-buffer
-	 gnus-newsgroup-name cmd unread backward)))))))
-
-(defun gnus-summary-walk-group-buffer (from-group cmd unread backward)
-  (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
-		      (?\C-p (gnus-group-prev-unread-group 1))))
-	keve key group ended)
-    (save-excursion
-      (set-buffer gnus-group-buffer)
-      (gnus-summary-jump-to-group from-group)
-      (setq group
-	    (if (eq gnus-keep-same-level 'best)
-		(gnus-summary-best-group gnus-newsgroup-name)
-	      (gnus-summary-search-group backward gnus-keep-same-level))))
-    (while (not ended)
-      (gnus-message
-       5 "No more%s articles%s" (if unread " unread" "")
-       (if (and group
-		(not (gnus-ephemeral-group-p gnus-newsgroup-name)))
-	   (format " (Type %s for %s [%s])"
-		   (single-key-description cmd) group
-		   (car (gnus-gethash group gnus-newsrc-hashtb)))
-	 (format " (Type %s to exit %s)"
-		 (single-key-description cmd)
-		 gnus-newsgroup-name)))
-      ;; Confirm auto selection.
-      (setq key (car (setq keve (gnus-read-event-char))))
-      (setq ended t)
-      (cond
-       ((assq key keystrokes)
-	(let ((obuf (current-buffer)))
-	  (switch-to-buffer gnus-group-buffer)
-	  (and group
-	       (gnus-group-jump-to-group group))
-	  (eval (cadr (assq key keystrokes)))
-	  (setq group (gnus-group-group-name))
-	  (switch-to-buffer obuf))
-	(setq ended nil))
-       ((equal key cmd)
-	(if (or (not group)
-		(gnus-ephemeral-group-p gnus-newsgroup-name))
-	    (gnus-summary-exit)
-	  (gnus-summary-next-group nil group backward)))
-       (t
-	(push (cdr keve) unread-command-events))))))
-
-(defun gnus-read-event-char ()
-  "Get the next event."
-  (let ((event (read-event)))
-    (cons (and (numberp event) event) event)))
-
-(defun gnus-summary-next-unread-article ()
-  "Select unread article after current one."
-  (interactive)
-  (gnus-summary-next-article t (and gnus-auto-select-same
-				    (gnus-summary-article-subject))))
-
-(defun gnus-summary-prev-article (&optional unread subject)
-  "Select the article after the current one.
-If UNREAD is non-nil, only unread articles are selected."
-  (interactive "P")
-  (gnus-summary-next-article unread subject t))
-
-(defun gnus-summary-prev-unread-article ()
-  "Select unred article before current one."
-  (interactive)
-  (gnus-summary-prev-article t (and gnus-auto-select-same
-				    (gnus-summary-article-subject))))
-
-(defun gnus-summary-next-page (&optional lines circular)
-  "Show next page of the selected article.
-If at the end of the current article, select the next article.
-LINES says how many lines should be scrolled up.
-
-If CIRCULAR is non-nil, go to the start of the article instead of
-selecting the next article when reaching the end of the current
-article."
-  (interactive "P")
-  (setq gnus-summary-buffer (current-buffer))
-  (gnus-set-global-variables)
-  (let ((article (gnus-summary-article-number))
-	(endp nil))
-    (gnus-configure-windows 'article)
-    (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
-	(if (and (eq gnus-summary-goto-unread 'never)
-		 (not (gnus-summary-last-article-p article)))
-	    (gnus-summary-next-article)
-	  (gnus-summary-next-unread-article))
-      (if (or (null gnus-current-article)
-	      (null gnus-article-current)
-	      (/= article (cdr gnus-article-current))
-	      (not (equal (car gnus-article-current) gnus-newsgroup-name)))
-	  ;; Selected subject is different from current article's.
-	  (gnus-summary-display-article article)
-	(gnus-eval-in-buffer-window gnus-article-buffer
-	  (setq endp (gnus-article-next-page lines)))
-	(if endp
-	    (cond (circular
-		   (gnus-summary-beginning-of-article))
-		  (lines
-		   (gnus-message 3 "End of message"))
-		  ((null lines)
-		   (if (and (eq gnus-summary-goto-unread 'never)
-			    (not (gnus-summary-last-article-p article)))
-		       (gnus-summary-next-article)
-		     (gnus-summary-next-unread-article)))))))
-    (gnus-summary-recenter)
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-prev-page (&optional lines)
-  "Show previous page of selected article.
-Argument LINES specifies lines to be scrolled down."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((article (gnus-summary-article-number)))
-    (gnus-configure-windows 'article)
-    (if (or (null gnus-current-article)
-	    (null gnus-article-current)
-	    (/= article (cdr gnus-article-current))
-	    (not (equal (car gnus-article-current) gnus-newsgroup-name)))
-	;; Selected subject is different from current article's.
-	(gnus-summary-display-article article)
-      (gnus-summary-recenter)
-      (gnus-eval-in-buffer-window gnus-article-buffer
-	(gnus-article-prev-page lines))))
-  (gnus-summary-position-point))
-
-(defun gnus-summary-scroll-up (lines)
-  "Scroll up (or down) one line current article.
-Argument LINES specifies lines to be scrolled up (or down if negative)."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (gnus-configure-windows 'article)
-  (gnus-summary-show-thread)
-  (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
-    (gnus-eval-in-buffer-window gnus-article-buffer
-      (cond ((> lines 0)
-	     (if (gnus-article-next-page lines)
-		 (gnus-message 3 "End of message")))
-	    ((< lines 0)
-	     (gnus-article-prev-page (- lines))))))
-  (gnus-summary-recenter)
-  (gnus-summary-position-point))
-
-(defun gnus-summary-next-same-subject ()
-  "Select next article which has the same subject as current one."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-summary-next-article nil (gnus-summary-article-subject)))
-
-(defun gnus-summary-prev-same-subject ()
-  "Select previous article which has the same subject as current one."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-summary-prev-article nil (gnus-summary-article-subject)))
-
-(defun gnus-summary-next-unread-same-subject ()
-  "Select next unread article which has the same subject as current one."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-summary-next-article t (gnus-summary-article-subject)))
-
-(defun gnus-summary-prev-unread-same-subject ()
-  "Select previous unread article which has the same subject as current one."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-summary-prev-article t (gnus-summary-article-subject)))
-
-(defun gnus-summary-first-unread-article ()
-  "Select the first unread article.
-Return nil if there are no unread articles."
-  (interactive)
-  (gnus-set-global-variables)
-  (prog1
-      (if (gnus-summary-first-subject t)
-	  (progn
-	    (gnus-summary-show-thread)
-	    (gnus-summary-first-subject t)
-	    (gnus-summary-display-article (gnus-summary-article-number))))
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-best-unread-article ()
-  "Select the unread article with the highest score."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((best -1000000)
-	(data gnus-newsgroup-data)
-	article score)
-    (while data
-      (and (gnus-data-unread-p (car data))
-	   (> (setq score
-		    (gnus-summary-article-score (gnus-data-number (car data))))
-	      best)
-	   (setq best score
-		 article (gnus-data-number (car data))))
-      (setq data (cdr data)))
-    (prog1
-	(if article
-	    (gnus-summary-goto-article article)
-	  (error "No unread articles"))
-      (gnus-summary-position-point))))
-
-(defun gnus-summary-last-subject ()
-  "Go to the last displayed subject line in the group."
-  (let ((article (gnus-data-number (car (gnus-data-list t)))))
-    (when article
-      (gnus-summary-goto-subject article))))
-
-(defun gnus-summary-goto-article (article &optional all-headers force)
-  "Fetch ARTICLE and display it if it exists.
-If ALL-HEADERS is non-nil, no header lines are hidden."
-  (interactive
-   (list
-    (string-to-int
-     (completing-read
-      "Article number: "
-      (mapcar (lambda (number) (list (int-to-string number)))
-	      gnus-newsgroup-limit)))
-    current-prefix-arg
-    t))
-  (prog1
-      (if (gnus-summary-goto-subject article force)
-	  (gnus-summary-display-article article all-headers)
-	(gnus-message 4 "Couldn't go to article %s" article) nil)
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-goto-last-article ()
-  "Go to the previously read article."
-  (interactive)
-  (prog1
-      (and gnus-last-article
-	   (gnus-summary-goto-article gnus-last-article))
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-pop-article (number)
-  "Pop one article off the history and go to the previous.
-NUMBER articles will be popped off."
-  (interactive "p")
-  (let (to)
-    (setq gnus-newsgroup-history
-	  (cdr (setq to (nthcdr number gnus-newsgroup-history))))
-    (if to
-	(gnus-summary-goto-article (car to))
-      (error "Article history empty")))
-  (gnus-summary-position-point))
-
-;; Summary commands and functions for limiting the summary buffer.
-
-(defun gnus-summary-limit-to-articles (n)
-  "Limit the summary buffer to the next N articles.
-If not given a prefix, use the process marked articles instead."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (prog1
-      (let ((articles (gnus-summary-work-articles n)))
-	(setq gnus-newsgroup-processable nil)
-	(gnus-summary-limit articles))
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-pop-limit (&optional total)
-  "Restore the previous limit.
-If given a prefix, remove all limits."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (when total 
-    (setq gnus-newsgroup-limits
-	  (list (mapcar (lambda (h) (mail-header-number h))
-			gnus-newsgroup-headers))))
-  (unless gnus-newsgroup-limits
-    (error "No limit to pop"))
-  (prog1
-      (gnus-summary-limit nil 'pop)
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-limit-to-subject (subject &optional header)
-  "Limit the summary buffer to articles that have subjects that match a regexp."
-  (interactive "sRegexp: ")
-  (unless header
-    (setq header "subject"))
-  (when (not (equal "" subject))
-    (prog1
-	(let ((articles (gnus-summary-find-matching
-			 (or header "subject") subject 'all)))
-	  (or articles (error "Found no matches for \"%s\"" subject))
-	  (gnus-summary-limit articles))
-      (gnus-summary-position-point))))
-
-(defun gnus-summary-limit-to-author (from)
-  "Limit the summary buffer to articles that have authors that match a regexp."
-  (interactive "sRegexp: ")
-  (gnus-summary-limit-to-subject from "from"))
-
-(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
-(make-obsolete
- 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
-
-(defun gnus-summary-limit-to-unread (&optional all)
-  "Limit the summary buffer to articles that are not marked as read.
-If ALL is non-nil, limit strictly to unread articles."
-  (interactive "P")
-  (if all
-      (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
-    (gnus-summary-limit-to-marks
-     ;; Concat all the marks that say that an article is read and have
-     ;; those removed.
-     (list gnus-del-mark gnus-read-mark gnus-ancient-mark
-	   gnus-killed-mark gnus-kill-file-mark
-	   gnus-low-score-mark gnus-expirable-mark
-	   gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark)
-     'reverse)))
-
-(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
-(make-obsolete 'gnus-summary-delete-marked-with 'gnus-summary-limit-to-marks)
-
-(defun gnus-summary-limit-to-marks (marks &optional reverse)
-  "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
-If REVERSE, limit the summary buffer to articles that are not marked
-with MARKS.  MARKS can either be a string of marks or a list of marks.
-Returns how many articles were removed."
-  (interactive "sMarks: ")
-  (gnus-set-global-variables)
-  (prog1
-      (let ((data gnus-newsgroup-data)
-	    (marks (if (listp marks) marks
-		     (append marks nil))) ; Transform to list.
-	    articles)
-	(while data
-	  (and (if reverse (not (memq (gnus-data-mark (car data)) marks))
-		 (memq (gnus-data-mark (car data)) marks))
-	       (setq articles (cons (gnus-data-number (car data)) articles)))
-	  (setq data (cdr data)))
-	(gnus-summary-limit articles))
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-limit-to-score (&optional score)
-  "Limit to articles with score at or above SCORE."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (setq score (if score
-		  (prefix-numeric-value score)
-		(or gnus-summary-default-score 0)))
-  (let ((data gnus-newsgroup-data)
-	articles)
-    (while data
-      (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
-		score)
-	(push (gnus-data-number (car data)) articles))
-      (setq data (cdr data)))
-    (prog1
-	(gnus-summary-limit articles)
-      (gnus-summary-position-point))))
-
-(defun gnus-summary-limit-include-dormant ()
-  "Display all the hidden articles that are marked as dormant."
-  (interactive)
-  (gnus-set-global-variables)
-  (or gnus-newsgroup-dormant
-      (error "There are no dormant articles in this group"))
-  (prog1
-      (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-limit-exclude-dormant ()
-  "Hide all dormant articles."
-  (interactive)
-  (gnus-set-global-variables)
-  (prog1
-      (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-limit-exclude-childless-dormant ()
-  "Hide all dormant articles that have no children."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((data (gnus-data-list t))
-	articles d children)
-    ;; Find all articles that are either not dormant or have
-    ;; children.
-    (while (setq d (pop data))
-      (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
-		(and (setq children 
-			   (gnus-article-children (gnus-data-number d)))
-		     (let (found)
-		       (while children
-			 (when (memq (car children) articles)
-			   (setq children nil
-				 found t))
-			 (pop children))
-		       found)))
-	(push (gnus-data-number d) articles)))
-    ;; Do the limiting.
-    (prog1
-	(gnus-summary-limit articles)
-      (gnus-summary-position-point))))
-
-(defun gnus-summary-limit-mark-excluded-as-read (&optional all)
-  "Mark all unread excluded articles as read.
-If ALL, mark even excluded ticked and dormants as read."
-  (interactive "P")
-  (let ((articles (gnus-sorted-complement
-		   (sort
-		    (mapcar (lambda (h) (mail-header-number h))
-			    gnus-newsgroup-headers)
-		    '<)
-		   (sort gnus-newsgroup-limit '<)))
-	article)
-    (setq gnus-newsgroup-unreads nil)
-    (if all
-	(setq gnus-newsgroup-dormant nil
-	      gnus-newsgroup-marked nil
-	      gnus-newsgroup-reads
-	      (nconc
-	       (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
-	       gnus-newsgroup-reads))
-      (while (setq article (pop articles))
-	(unless (or (memq article gnus-newsgroup-dormant)
-		    (memq article gnus-newsgroup-marked))
-	  (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
-
-(defun gnus-summary-limit (articles &optional pop)
-  (if pop
-      ;; We pop the previous limit off the stack and use that.
-      (setq articles (car gnus-newsgroup-limits)
-	    gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
-    ;; We use the new limit, so we push the old limit on the stack.
-    (setq gnus-newsgroup-limits
-	  (cons gnus-newsgroup-limit gnus-newsgroup-limits)))
-  ;; Set the limit.
-  (setq gnus-newsgroup-limit articles)
-  (let ((total (length gnus-newsgroup-data))
-	(data (gnus-data-find-list (gnus-summary-article-number)))
-	(gnus-summary-mark-below nil)	; Inhibit this.
-	found)
-    ;; This will do all the work of generating the new summary buffer
-    ;; according to the new limit.
-    (gnus-summary-prepare)
-    ;; Hide any threads, possibly.
-    (and gnus-show-threads
-	 gnus-thread-hide-subtree
-	 (gnus-summary-hide-all-threads))
-    ;; Try to return to the article you were at, or one in the
-    ;; neighborhood.
-    (if data
-	;; We try to find some article after the current one.
-	(while data
-	  (and (gnus-summary-goto-subject
-		(gnus-data-number (car data)) nil t)
-	       (setq data nil
-		     found t))
-	  (setq data (cdr data))))
-    (or found
-	;; If there is no data, that means that we were after the last
-	;; article.  The same goes when we can't find any articles
-	;; after the current one.
-	(progn
-	  (goto-char (point-max))
-	  (gnus-summary-find-prev)))
-    ;; We return how many articles were removed from the summary
-    ;; buffer as a result of the new limit.
-    (- total (length gnus-newsgroup-data))))
-
-(defsubst gnus-invisible-cut-children (threads)
-  (let ((num 0))
-    (while threads
-      (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
-	(incf num))
-      (pop threads))
-    (< num 2)))
-
-(defsubst gnus-cut-thread (thread)
-  "Go forwards in the thread until we find an article that we want to display."
-  (when (or (eq gnus-fetch-old-headers 'some)
-	    (eq gnus-build-sparse-threads 'some)
-	    (eq gnus-build-sparse-threads 'more))
-    ;; Deal with old-fetched headers and sparse threads.
-    (while (and
-	    thread
-	    (or
-	     (memq (mail-header-number (car thread)) gnus-newsgroup-sparse)
-	     (memq (mail-header-number (car thread)) gnus-newsgroup-ancient))
-	    (or (<= (length (cdr thread)) 1)
-		(gnus-invisible-cut-children (cdr thread))))
-      (setq thread (cadr thread))))
-  thread)
-
-(defun gnus-cut-threads (threads)
-  "Cut off all uninteresting articles from the beginning of threads."
-  (when (or (eq gnus-fetch-old-headers 'some)
-	    (eq gnus-build-sparse-threads 'some)
-	    (eq gnus-build-sparse-threads 'more))
-    (let ((th threads))
-      (while th
-	(setcar th (gnus-cut-thread (car th)))
-	(setq th (cdr th)))))
-  ;; Remove nixed out threads.
-  (delq nil threads))
-
-(defun gnus-summary-initial-limit (&optional show-if-empty)
-  "Figure out what the initial limit is supposed to be on group entry.
-This entails weeding out unwanted dormants, low-scored articles,
-fetch-old-headers verbiage, and so on."
-  ;; Most groups have nothing to remove.
-  (if (or gnus-inhibit-limiting
-	  (and (null gnus-newsgroup-dormant)
-	       (not (eq gnus-fetch-old-headers 'some))
-	       (null gnus-summary-expunge-below)
-	       (not (eq gnus-build-sparse-threads 'some))
-	       (not (eq gnus-build-sparse-threads 'more))
-	       (null gnus-thread-expunge-below)
-	       (not gnus-use-nocem)))
-      () ; Do nothing.
-    (push gnus-newsgroup-limit gnus-newsgroup-limits)
-    (setq gnus-newsgroup-limit nil)
-    (mapatoms
-     (lambda (node)
-       (unless (car (symbol-value node))
-	 ;; These threads have no parents -- they are roots.
-	 (let ((nodes (cdr (symbol-value node)))
-	       thread)
-	   (while nodes
-	     (if (and gnus-thread-expunge-below
-		      (< (gnus-thread-total-score (car nodes))
-			 gnus-thread-expunge-below))
-		 (gnus-expunge-thread (pop nodes))
-	       (setq thread (pop nodes))
-	       (gnus-summary-limit-children thread))))))
-     gnus-newsgroup-dependencies)
-    ;; If this limitation resulted in an empty group, we might
-    ;; pop the previous limit and use it instead.
-    (when (and (not gnus-newsgroup-limit)
-	       show-if-empty)
-      (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
-    gnus-newsgroup-limit))
-
-(defun gnus-summary-limit-children (thread)
-  "Return 1 if this subthread is visible and 0 if it is not."
-  ;; First we get the number of visible children to this thread.  This
-  ;; is done by recursing down the thread using this function, so this
-  ;; will really go down to a leaf article first, before slowly
-  ;; working its way up towards the root.
-  (when thread
-    (let ((children
-	   (if (cdr thread)
-	       (apply '+ (mapcar 'gnus-summary-limit-children
-				 (cdr thread)))
-	     0))
-	  (number (mail-header-number (car thread)))
-	  score)
-      (if (or
-	   ;; If this article is dormant and has absolutely no visible
-	   ;; children, then this article isn't visible.
-	   (and (memq number gnus-newsgroup-dormant)
-		(= children 0))
-	   ;; If this is "fetch-old-headered" and there is only one
-	   ;; visible child (or less), then we don't want this article.
-	   (and (eq gnus-fetch-old-headers 'some)
-		(memq number gnus-newsgroup-ancient)
-		(zerop children))
-	   ;; If this is a sparsely inserted article with no children,
-	   ;; we don't want it.
-	   (and (eq gnus-build-sparse-threads 'some)
-		(memq number gnus-newsgroup-sparse)
-		(zerop children))
-	   ;; If we use expunging, and this article is really
-	   ;; low-scored, then we don't want this article.
-	   (when (and gnus-summary-expunge-below
-		      (< (setq score
-			       (or (cdr (assq number gnus-newsgroup-scored))
-				   gnus-summary-default-score))
-			 gnus-summary-expunge-below))
-	     ;; We increase the expunge-tally here, but that has
-	     ;; nothing to do with the limits, really.
-	     (incf gnus-newsgroup-expunged-tally)
-	     ;; We also mark as read here, if that's wanted.
-	     (when (and gnus-summary-mark-below
-			(< score gnus-summary-mark-below))
-	       (setq gnus-newsgroup-unreads
-		     (delq number gnus-newsgroup-unreads))
-	       (if gnus-newsgroup-auto-expire
-		   (push number gnus-newsgroup-expirable)
-		 (push (cons number gnus-low-score-mark)
-		       gnus-newsgroup-reads)))
-	     t)
-	   (and gnus-use-nocem
-		(gnus-nocem-unwanted-article-p (mail-header-id (car thread)))))
-	  ;; Nope, invisible article.
-	  0
-	;; Ok, this article is to be visible, so we add it to the limit
-	;; and return 1.
-	(setq gnus-newsgroup-limit (cons number gnus-newsgroup-limit))
-	1))))
-
-(defun gnus-expunge-thread (thread)
-  "Mark all articles in THREAD as read."
-  (let* ((number (mail-header-number (car thread))))
-    (incf gnus-newsgroup-expunged-tally)
-    ;; We also mark as read here, if that's wanted.
-    (setq gnus-newsgroup-unreads
-	  (delq number gnus-newsgroup-unreads))
-    (if gnus-newsgroup-auto-expire
-	(push number gnus-newsgroup-expirable)
-      (push (cons number gnus-low-score-mark)
-	    gnus-newsgroup-reads)))
-  ;; Go recursively through all subthreads.
-  (mapcar 'gnus-expunge-thread (cdr thread)))
-
-;; Summary article oriented commands
-
-(defun gnus-summary-refer-parent-article (n)
-  "Refer parent article N times.
-The difference between N and the number of articles fetched is returned."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (while
-      (and
-       (> n 0)
-       (let* ((header (gnus-summary-article-header))
-	      (ref
-	       ;; If we try to find the parent of the currently
-	       ;; displayed article, then we take a look at the actual
-	       ;; References header, since this is slightly more
-	       ;; reliable than the References field we got from the
-	       ;; server.
-	       (if (and (eq (mail-header-number header)
-			    (cdr gnus-article-current))
-			(equal gnus-newsgroup-name
-			       (car gnus-article-current)))
-		   (save-excursion
-		     (set-buffer gnus-original-article-buffer)
-		     (nnheader-narrow-to-headers)
-		     (prog1
-			 (message-fetch-field "references")
-		       (widen)))
-		 ;; It's not the current article, so we take a bet on
-		 ;; the value we got from the server.
-		 (mail-header-references header))))
-	 (if (setq ref (or ref (mail-header-references header)))
-	     (or (gnus-summary-refer-article (gnus-parent-id ref))
-		 (gnus-message 1 "Couldn't find parent"))
-	   (gnus-message 1 "No references in article %d"
-			 (gnus-summary-article-number))
-	   nil)))
-    (setq n (1- n)))
-  (gnus-summary-position-point)
-  n)
-
-(defun gnus-summary-refer-references ()
-  "Fetch all articles mentioned in the References header.
-Return how many articles were fetched."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((ref (mail-header-references (gnus-summary-article-header)))
-	(current (gnus-summary-article-number))
-	(n 0))
-    ;; For each Message-ID in the References header...
-    (while (string-match "<[^>]*>" ref)
-      (incf n)
-      ;; ... fetch that article.
-      (gnus-summary-refer-article
-       (prog1 (match-string 0 ref)
-	 (setq ref (substring ref (match-end 0))))))
-    (gnus-summary-goto-subject current)
-    (gnus-summary-position-point)
-    n))
-
-(defun gnus-summary-refer-article (message-id)
-  "Fetch an article specified by MESSAGE-ID."
-  (interactive "sMessage-ID: ")
-  (when (and (stringp message-id)
-	     (not (zerop (length message-id))))
-    ;; Construct the correct Message-ID if necessary.
-    ;; Suggested by tale@pawl.rpi.edu.
-    (unless (string-match "^<" message-id)
-      (setq message-id (concat "<" message-id)))
-    (unless (string-match ">$" message-id)
-      (setq message-id (concat message-id ">")))
-    (let* ((header (gnus-id-to-header message-id))
-	   (sparse (and header
-			(memq (mail-header-number header)
-			      gnus-newsgroup-sparse))))
-      (if header
-	  (prog1
-	      ;; The article is present in the buffer, to we just go to it.
-	      (gnus-summary-goto-article 
-	       (mail-header-number header) nil header)
-	    (when sparse
-	      (gnus-summary-update-article (mail-header-number header))))
-	;; We fetch the article
-	(let ((gnus-override-method 
-	       (and (gnus-news-group-p gnus-newsgroup-name)
-		    gnus-refer-article-method))
-	      number)
-	  ;; Start the special refer-article method, if necessary.
-	  (when (and gnus-refer-article-method
-		     (gnus-news-group-p gnus-newsgroup-name))
-	    (gnus-check-server gnus-refer-article-method))
-	  ;; Fetch the header, and display the article.
-	  (if (setq number (gnus-summary-insert-subject message-id))
-	      (gnus-summary-select-article nil nil nil number)
-	    (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
-
-(defun gnus-summary-enter-digest-group (&optional force)
-  "Enter a digest group based on the current article."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-summary-select-article)
-  (let ((name (format "%s-%d"
-		      (gnus-group-prefixed-name
-		       gnus-newsgroup-name (list 'nndoc ""))
-		      gnus-current-article))
-	(ogroup gnus-newsgroup-name)
-	(case-fold-search t)
-	(buf (current-buffer))
-	dig)
-    (save-excursion
-      (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
-      (insert-buffer-substring gnus-original-article-buffer)
-      (narrow-to-region
-       (goto-char (point-min))
-       (or (search-forward "\n\n" nil t) (point)))
-      (goto-char (point-min))
-      (delete-matching-lines "^\\(Path\\):\\|^From ")
-      (widen))
-    (unwind-protect
-	(if (gnus-group-read-ephemeral-group
-	     name `(nndoc ,name (nndoc-address
-				 ,(get-buffer dig))
-			  (nndoc-article-type ,(if force 'digest 'guess))) t)
-	    ;; Make all postings to this group go to the parent group.
-	    (nconc (gnus-info-params (gnus-get-info name))
-		   (list (cons 'to-group ogroup)))
-	  ;; Couldn't select this doc group.
-	  (switch-to-buffer buf)
-	  (gnus-set-global-variables)
-	  (gnus-configure-windows 'summary)
-	  (gnus-message 3 "Article couldn't be entered?"))
-      (kill-buffer dig))))
-
-(defun gnus-summary-isearch-article (&optional regexp-p)
-  "Do incremental search forward on the current article.
-If REGEXP-P (the prefix) is non-nil, do regexp isearch."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-summary-select-article)
-  (gnus-configure-windows 'article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (goto-char (point-min))
-    (isearch-forward regexp-p)))
-
-(defun gnus-summary-search-article-forward (regexp &optional backward)
-  "Search for an article containing REGEXP forward.
-If BACKWARD, search backward instead."
-  (interactive
-   (list (read-string
-	  (format "Search article %s (regexp%s): "
-		  (if current-prefix-arg "backward" "forward")
-		  (if gnus-last-search-regexp
-		      (concat ", default " gnus-last-search-regexp)
-		    "")))
-	 current-prefix-arg))
-  (gnus-set-global-variables)
-  (if (string-equal regexp "")
-      (setq regexp (or gnus-last-search-regexp ""))
-    (setq gnus-last-search-regexp regexp))
-  (unless (gnus-summary-search-article regexp backward)
-    (error "Search failed: \"%s\"" regexp)))
-
-(defun gnus-summary-search-article-backward (regexp)
-  "Search for an article containing REGEXP backward."
-  (interactive
-   (list (read-string
-	  (format "Search article backward (regexp%s): "
-		  (if gnus-last-search-regexp
-		      (concat ", default " gnus-last-search-regexp)
-		    "")))))
-  (gnus-summary-search-article-forward regexp 'backward))
-
-(defun gnus-summary-search-article (regexp &optional backward)
-  "Search for an article containing REGEXP.
-Optional argument BACKWARD means do search for backward.
-`gnus-select-article-hook' is not called during the search."
-  (let ((gnus-select-article-hook nil)	;Disable hook.
-	(gnus-article-display-hook nil)
-	(gnus-mark-article-hook nil)	;Inhibit marking as read.
-	(re-search
-	 (if backward
-	     're-search-backward 're-search-forward))
-	(sum (current-buffer))
-	(found nil))
-    (gnus-save-hidden-threads
-      (gnus-summary-select-article)
-      (set-buffer gnus-article-buffer)
-      (when backward
-	(forward-line -1))
-      (while (not found)
-	(gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
-	(if (if backward
-		(re-search-backward regexp nil t)
-	      (re-search-forward regexp nil t))
-	    ;; We found the regexp.
-	    (progn
-	      (setq found 'found)
-	      (beginning-of-line)
-	      (set-window-start
-	       (get-buffer-window (current-buffer))
-	       (point))
-	      (forward-line 1)
-	      (set-buffer sum))
-	  ;; We didn't find it, so we go to the next article.
-	  (set-buffer sum)
-	  (if (not (if backward (gnus-summary-find-prev)
-		     (gnus-summary-find-next)))
-	      ;; No more articles.
-	      (setq found t)
-	    ;; Select the next article and adjust point.
-	    (gnus-summary-select-article)
-	    (set-buffer gnus-article-buffer)
-	    (widen)
-	    (goto-char (if backward (point-max) (point-min))))))
-      (gnus-message 7 ""))
-    ;; Return whether we found the regexp.
-    (when (eq found 'found)
-      (gnus-summary-show-thread)
-      (gnus-summary-goto-subject gnus-current-article)
-      (gnus-summary-position-point)
-      t)))
-
-(defun gnus-summary-find-matching (header regexp &optional backward unread
-					  not-case-fold)
-  "Return a list of all articles that match REGEXP on HEADER.
-The search stars on the current article and goes forwards unless
-BACKWARD is non-nil.  If BACKWARD is `all', do all articles.
-If UNREAD is non-nil, only unread articles will
-be taken into consideration.  If NOT-CASE-FOLD, case won't be folded
-in the comparisons."
-  (let ((data (if (eq backward 'all) gnus-newsgroup-data
-		(gnus-data-find-list
-		 (gnus-summary-article-number) (gnus-data-list backward))))
-	(func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
-	(case-fold-search (not not-case-fold))
-	articles d)
-    (or (fboundp (intern (concat "mail-header-" header)))
-	(error "%s is not a valid header" header))
-    (while data
-      (setq d (car data))
-      (and (or (not unread)		; We want all articles...
-	       (gnus-data-unread-p d))	; Or just unreads.
-	   (vectorp (gnus-data-header d)) ; It's not a pseudo.
-	   (string-match regexp (funcall func (gnus-data-header d))) ; Match.
-	   (setq articles (cons (gnus-data-number d) articles))) ; Success!
-      (setq data (cdr data)))
-    (nreverse articles)))
-
-(defun gnus-summary-execute-command (header regexp command &optional backward)
-  "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
-If HEADER is an empty string (or nil), the match is done on the entire
-article.  If BACKWARD (the prefix) is non-nil, search backward instead."
-  (interactive
-   (list (let ((completion-ignore-case t))
-	   (completing-read
-	    "Header name: "
-	    (mapcar (lambda (string) (list string))
-		    '("Number" "Subject" "From" "Lines" "Date"
-		      "Message-ID" "Xref" "References" "Body"))
-	    nil 'require-match))
-	 (read-string "Regexp: ")
-	 (read-key-sequence "Command: ")
-	 current-prefix-arg))
-  (when (equal header "Body")
-    (setq header ""))
-  (gnus-set-global-variables)
-  ;; Hidden thread subtrees must be searched as well.
-  (gnus-summary-show-all-threads)
-  ;; We don't want to change current point nor window configuration.
-  (save-excursion
-    (save-window-excursion
-      (gnus-message 6 "Executing %s..." (key-description command))
-      ;; We'd like to execute COMMAND interactively so as to give arguments.
-      (gnus-execute header regexp
-		    `(lambda () (call-interactively ',(key-binding command)))
-		    backward)
-      (gnus-message 6 "Executing %s...done" (key-description command)))))
-
-(defun gnus-summary-beginning-of-article ()
-  "Scroll the article back to the beginning."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-summary-select-article)
-  (gnus-configure-windows 'article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (widen)
-    (goto-char (point-min))
-    (and gnus-break-pages (gnus-narrow-to-page))))
-
-(defun gnus-summary-end-of-article ()
-  "Scroll to the end of the article."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-summary-select-article)
-  (gnus-configure-windows 'article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (widen)
-    (goto-char (point-max))
-    (recenter -3)
-    (and gnus-break-pages (gnus-narrow-to-page))))
-
-(defun gnus-summary-show-article (&optional arg)
-  "Force re-fetching of the current article.
-If ARG (the prefix) is non-nil, show the raw article without any
-article massaging functions being run."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (if (not arg)
-      ;; Select the article the normal way.
-      (gnus-summary-select-article nil 'force)
-    ;; Bind the article treatment functions to nil.
-    (let ((gnus-have-all-headers t)
-	  gnus-article-display-hook
-	  gnus-article-prepare-hook
-	  gnus-break-pages
-	  gnus-visual)
-      (gnus-summary-select-article nil 'force)))
-  (gnus-summary-goto-subject gnus-current-article)
-;  (gnus-configure-windows 'article)
-  (gnus-summary-position-point))
-
-(defun gnus-summary-verbose-headers (&optional arg)
-  "Toggle permanent full header display.
-If ARG is a positive number, turn header display on.
-If ARG is a negative number, turn header display off."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-summary-toggle-header arg)
-  (setq gnus-show-all-headers
-	(cond ((or (not (numberp arg))
-		   (zerop arg))
-	       (not gnus-show-all-headers))
-	      ((natnump arg)
-	       t))))
-
-(defun gnus-summary-toggle-header (&optional arg)
-  "Show the headers if they are hidden, or hide them if they are shown.
-If ARG is a positive number, show the entire header.
-If ARG is a negative number, hide the unwanted header lines."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let* ((buffer-read-only nil)
-	   (inhibit-point-motion-hooks t)
-	   (hidden (text-property-any
-		    (goto-char (point-min)) (search-forward "\n\n")
-		    'invisible t))
-	   e)
-      (goto-char (point-min))
-      (when (search-forward "\n\n" nil t)
-	(delete-region (point-min) (1- (point))))
-      (goto-char (point-min))
-      (save-excursion
-	(set-buffer gnus-original-article-buffer)
-	(goto-char (point-min))
-	(setq e (1- (or (search-forward "\n\n" nil t) (point-max)))))
-      (insert-buffer-substring gnus-original-article-buffer 1 e)
-      (let ((gnus-inhibit-hiding t))
-	(run-hooks 'gnus-article-display-hook))
-      (if (or (not hidden) (and (numberp arg) (< arg 0)))
-	  (gnus-article-hide-headers)))))
-
-(defun gnus-summary-show-all-headers ()
-  "Make all header lines visible."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-article-show-all-headers))
-
-(defun gnus-summary-toggle-mime (&optional arg)
-  "Toggle MIME processing.
-If ARG is a positive number, turn MIME processing on."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (setq gnus-show-mime
-	(if (null arg) (not gnus-show-mime)
-	  (> (prefix-numeric-value arg) 0)))
-  (gnus-summary-select-article t 'force))
-
-(defun gnus-summary-caesar-message (&optional arg)
-  "Caesar rotate the current article by 13.
-The numerical prefix specifies how manu places to rotate each letter
-forward."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-summary-select-article)
-  (let ((mail-header-separator ""))
-    (gnus-eval-in-buffer-window gnus-article-buffer
-      (save-restriction
-	(widen)
-	(let ((start (window-start))
-	      buffer-read-only)
-	  (message-caesar-buffer-body arg)
-	  (set-window-start (get-buffer-window (current-buffer)) start))))))
-
-(defun gnus-summary-stop-page-breaking ()
-  "Stop page breaking in the current article."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-summary-select-article)
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (widen)))
-
-(defun gnus-summary-move-article (&optional n to-newsgroup select-method action)
-  "Move the current article to a different newsgroup.
-If N is a positive number, move the N next articles.
-If N is a negative number, move the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-move those articles instead.
-If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
-If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
-re-spool using this method.
-
-For this function to work, both the current newsgroup and the
-newsgroup that you want to move to have to support the `request-move'
-and `request-accept' functions."
-  (interactive "P")
-  (unless action (setq action 'move))
-  (gnus-set-global-variables)
-  ;; Check whether the source group supports the required functions.
-  (cond ((and (eq action 'move)
-	      (not (gnus-check-backend-function
-		    'request-move-article gnus-newsgroup-name)))
-	 (error "The current group does not support article moving"))
-	((and (eq action 'crosspost)
-	      (not (gnus-check-backend-function
-		    'request-replace-article gnus-newsgroup-name)))
-	 (error "The current group does not support article editing")))
-  (let ((articles (gnus-summary-work-articles n))
-	(prefix (gnus-group-real-prefix gnus-newsgroup-name))
-	(names '((move "Move" "Moving")
-		 (copy "Copy" "Copying")
-		 (crosspost "Crosspost" "Crossposting")))
-	(copy-buf (save-excursion
-		    (nnheader-set-temp-buffer " *copy article*")))
-	art-group to-method new-xref article to-groups)
-    (unless (assq action names)
-      (error "Unknown action %s" action))
-    ;; Read the newsgroup name.
-    (when (and (not to-newsgroup)
-	       (not select-method))
-      (setq to-newsgroup
-	    (gnus-read-move-group-name
-	     (cadr (assq action names))
-	     (symbol-value (intern (format "gnus-current-%s-group" action)))
-	     articles prefix))
-      (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
-    (setq to-method (or select-method 
-			(gnus-group-name-to-method to-newsgroup)))
-    ;; Check the method we are to move this article to...
-    (or (gnus-check-backend-function 'request-accept-article (car to-method))
-	(error "%s does not support article copying" (car to-method)))
-    (or (gnus-check-server to-method)
-	(error "Can't open server %s" (car to-method)))
-    (gnus-message 6 "%s to %s: %s..."
-		  (caddr (assq action names))
-		  (or (car select-method) to-newsgroup) articles)
-    (while articles
-      (setq article (pop articles))
-      (setq
-       art-group
-       (cond
-	;; Move the article.
-	((eq action 'move)
-	 (gnus-request-move-article
-	  article			; Article to move
-	  gnus-newsgroup-name		; From newsgrouo
-	  (nth 1 (gnus-find-method-for-group
-		  gnus-newsgroup-name)) ; Server
-	  (list 'gnus-request-accept-article
-		to-newsgroup (list 'quote select-method)
-		(not articles))		; Accept form
-	  (not articles)))		; Only save nov last time
-	;; Copy the article.
-	((eq action 'copy)
-	 (save-excursion
-	   (set-buffer copy-buf)
-	   (gnus-request-article-this-buffer article gnus-newsgroup-name)
-	   (gnus-request-accept-article
-	    to-newsgroup select-method (not articles))))
-	;; Crosspost the article.
-	((eq action 'crosspost)
-	 (let ((xref (mail-header-xref (gnus-summary-article-header article))))
-	   (setq new-xref (concat gnus-newsgroup-name ":" article))
-	   (if (and xref (not (string= xref "")))
-	       (progn
-		 (when (string-match "^Xref: " xref)
-		   (setq xref (substring xref (match-end 0))))
-		 (setq new-xref (concat xref " " new-xref)))
-	     (setq new-xref (concat (system-name) " " new-xref)))
-	   (save-excursion
-	     (set-buffer copy-buf)
-	     (gnus-request-article-this-buffer article gnus-newsgroup-name)
-	     (nnheader-replace-header "xref" new-xref)
-	     (gnus-request-accept-article
-	      to-newsgroup select-method (not articles)))))))
-      (if (not art-group)
-	  (gnus-message 1 "Couldn't %s article %s"
-			(cadr (assq action names)) article)
-	(let* ((entry
-		(or
-		 (gnus-gethash (car art-group) gnus-newsrc-hashtb)
-		 (gnus-gethash
-		  (gnus-group-prefixed-name
-		   (car art-group)
-		   (or select-method 
-		       (gnus-find-method-for-group to-newsgroup)))
-		  gnus-newsrc-hashtb)))
-	       (info (nth 2 entry))
-	       (to-group (gnus-info-group info)))
-	  ;; Update the group that has been moved to.
-	  (when (and info
-		     (memq action '(move copy)))
-	    (unless (member to-group to-groups)
-	      (push to-group to-groups))
-
-	    (unless (memq article gnus-newsgroup-unreads)
-	      (gnus-info-set-read
-	       info (gnus-add-to-range (gnus-info-read info)
-				       (list (cdr art-group)))))
-
-	    ;; Copy any marks over to the new group.
-	    (let ((marks gnus-article-mark-lists)
-		  (to-article (cdr art-group)))
-
-	      ;; See whether the article is to be put in the cache.
-	      (when gnus-use-cache
-		(gnus-cache-possibly-enter-article
-		 to-group to-article
-		 (let ((header (copy-sequence
-				(gnus-summary-article-header article))))
-		   (mail-header-set-number header to-article)
-		   header)
-		 (memq article gnus-newsgroup-marked)
-		 (memq article gnus-newsgroup-dormant)
-		 (memq article gnus-newsgroup-unreads)))
-
-	      (while marks
-		(when (memq article (symbol-value
-				     (intern (format "gnus-newsgroup-%s"
-						     (caar marks)))))
-		  ;; If the other group is the same as this group,
-		  ;; then we have to add the mark to the list.
-		  (when (equal to-group gnus-newsgroup-name)
-		    (set (intern (format "gnus-newsgroup-%s" (caar marks)))
-			 (cons to-article
-			       (symbol-value
-				(intern (format "gnus-newsgroup-%s"
-						(caar marks)))))))
-		  ;; Copy mark to other group.
-		  (gnus-add-marked-articles
-		   to-group (cdar marks) (list to-article) info))
-		(setq marks (cdr marks)))))
-
-	  ;; Update the Xref header in this article to point to
-	  ;; the new crossposted article we have just created.
-	  (when (eq action 'crosspost)
-	    (save-excursion
-	      (set-buffer copy-buf)
-	      (gnus-request-article-this-buffer article gnus-newsgroup-name)
-	      (nnheader-replace-header
-	       "xref" (concat new-xref " " (gnus-group-prefixed-name
-					    (car art-group) to-method)
-			      ":" (cdr art-group)))
-	      (gnus-request-replace-article
-	       article gnus-newsgroup-name (current-buffer)))))
-
-	(gnus-summary-goto-subject article)
-	(when (eq action 'move)
-	  (gnus-summary-mark-article article gnus-canceled-mark)))
-      (gnus-summary-remove-process-mark article))
-    ;; Re-activate all groups that have been moved to.
-    (while to-groups
-      (gnus-activate-group (pop to-groups)))
-    
-    (gnus-kill-buffer copy-buf)
-    (gnus-summary-position-point)
-    (gnus-set-mode-line 'summary)))
-
-(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
-  "Move the current article to a different newsgroup.
-If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
-If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
-re-spool using this method."
-  (interactive "P")
-  (gnus-summary-move-article n nil select-method 'copy))
-
-(defun gnus-summary-crosspost-article (&optional n)
-  "Crosspost the current article to some other group."
-  (interactive "P")
-  (gnus-summary-move-article n nil nil 'crosspost))
-
-(defvar gnus-summary-respool-default-method nil
-  "Default method for respooling an article.  
-If nil, use to the current newsgroup method.")
-
-(defun gnus-summary-respool-article (&optional n method)
-  "Respool the current article.
-The article will be squeezed through the mail spooling process again,
-which means that it will be put in some mail newsgroup or other
-depending on `nnmail-split-methods'.
-If N is a positive number, respool the N next articles.
-If N is a negative number, respool the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-respool those articles instead.
-
-Respooling can be done both from mail groups and \"real\" newsgroups.
-In the former case, the articles in question will be moved from the
-current group into whatever groups they are destined to.  In the
-latter case, they will be copied into the relevant groups."
-  (interactive 
-   (list current-prefix-arg
-	 (let* ((methods (gnus-methods-using 'respool))
-		(methname
-		 (symbol-name (or gnus-summary-respool-default-method
-				  (car (gnus-find-method-for-group
-					gnus-newsgroup-name)))))
-		(method
-		 (gnus-completing-read 
-		  methname "What backend do you want to use when respooling?"
-		  methods nil t nil 'gnus-method-history))
-		ms)
-	   (cond
-	    ((zerop (length (setq ms (gnus-servers-using-backend method))))
-	     (list (intern method) ""))
-	    ((= 1 (length ms))
-	     (car ms))
-	    (t
-	     (cdr (completing-read 
-		   "Server name: "
-		   (mapcar (lambda (m) (cons (cadr m) m)) ms) nil t)))))))
-  (gnus-set-global-variables)
-  (unless method
-    (error "No method given for respooling"))
-  (if (assoc (symbol-name
-	      (car (gnus-find-method-for-group gnus-newsgroup-name)))
-	     (gnus-methods-using 'respool))
-      (gnus-summary-move-article n nil method)
-    (gnus-summary-copy-article n nil method)))
-
-(defun gnus-summary-import-article (file)
-  "Import a random file into a mail newsgroup."
-  (interactive "fImport file: ")
-  (gnus-set-global-variables)
-  (let ((group gnus-newsgroup-name)
-	(now (current-time))
-	atts lines)
-    (or (gnus-check-backend-function 'request-accept-article group)
-	(error "%s does not support article importing" group))
-    (or (file-readable-p file)
-	(not (file-regular-p file))
-	(error "Can't read %s" file))
-    (save-excursion
-      (set-buffer (get-buffer-create " *import file*"))
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (insert-file-contents file)
-      (goto-char (point-min))
-      (unless (nnheader-article-p)
-	;; This doesn't look like an article, so we fudge some headers.
-	(setq atts (file-attributes file)
-	      lines (count-lines (point-min) (point-max)))
-	(insert "From: " (read-string "From: ") "\n"
-		"Subject: " (read-string "Subject: ") "\n"
-		"Date: " (timezone-make-date-arpa-standard
-			  (current-time-string (nth 5 atts))
-			  (current-time-zone now)
-			  (current-time-zone now)) "\n"
-		"Message-ID: " (message-make-message-id) "\n"
-		"Lines: " (int-to-string lines) "\n"
-		"Chars: " (int-to-string (nth 7 atts)) "\n\n"))
-      (gnus-request-accept-article group nil t)
-      (kill-buffer (current-buffer)))))
-
-(defun gnus-summary-expire-articles (&optional now)
-  "Expire all articles that are marked as expirable in the current group."
-  (interactive)
-  (gnus-set-global-variables)
-  (when (gnus-check-backend-function
-	 'request-expire-articles gnus-newsgroup-name)
-    ;; This backend supports expiry.
-    (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
-	   (expirable (if total
-			  (gnus-list-of-read-articles gnus-newsgroup-name)
-			(setq gnus-newsgroup-expirable
-			      (sort gnus-newsgroup-expirable '<))))
-	   (expiry-wait (if now 'immediate
-			  (gnus-group-get-parameter
-			   gnus-newsgroup-name 'expiry-wait)))
-	   es)
-      (when expirable
-	;; There are expirable articles in this group, so we run them
-	;; through the expiry process.
-	(gnus-message 6 "Expiring articles...")
-	;; The list of articles that weren't expired is returned.
-	(if expiry-wait
-	    (let ((nnmail-expiry-wait-function nil)
-		  (nnmail-expiry-wait expiry-wait))
-	      (setq es (gnus-request-expire-articles
-			expirable gnus-newsgroup-name)))
-	  (setq es (gnus-request-expire-articles
-		    expirable gnus-newsgroup-name)))
-	(or total (setq gnus-newsgroup-expirable es))
-	;; We go through the old list of expirable, and mark all
-	;; really expired articles as nonexistent.
-	(unless (eq es expirable)	;If nothing was expired, we don't mark.
-	  (let ((gnus-use-cache nil))
-	    (while expirable
-	      (unless (memq (car expirable) es)
-		(when (gnus-data-find (car expirable))
-		  (gnus-summary-mark-article
-		   (car expirable) gnus-canceled-mark)))
-	      (setq expirable (cdr expirable)))))
-	(gnus-message 6 "Expiring articles...done")))))
-
-(defun gnus-summary-expire-articles-now ()
-  "Expunge all expirable articles in the current group.
-This means that *all* articles that are marked as expirable will be
-deleted forever, right now."
-  (interactive)
-  (gnus-set-global-variables)
-  (or gnus-expert-user
-      (gnus-y-or-n-p
-       "Are you really, really, really sure you want to delete all these messages? ")
-      (error "Phew!"))
-  (gnus-summary-expire-articles t))
-
-;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
-(defun gnus-summary-delete-article (&optional n)
-  "Delete the N next (mail) articles.
-This command actually deletes articles.	 This is not a marking
-command.  The article will disappear forever from your life, never to
-return.
-If N is negative, delete backwards.
-If N is nil and articles have been marked with the process mark,
-delete these instead."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (or (gnus-check-backend-function 'request-expire-articles
-				   gnus-newsgroup-name)
-      (error "The current newsgroup does not support article deletion."))
-  ;; Compute the list of articles to delete.
-  (let ((articles (gnus-summary-work-articles n))
-	not-deleted)
-    (if (and gnus-novice-user
-	     (not (gnus-y-or-n-p
-		   (format "Do you really want to delete %s forever? "
-			   (if (> (length articles) 1) 
-			       (format "these %s articles" (length articles))
-			     "this article")))))
-	()
-      ;; Delete the articles.
-      (setq not-deleted (gnus-request-expire-articles
-			 articles gnus-newsgroup-name 'force))
-      (while articles
-	(gnus-summary-remove-process-mark (car articles))
-	;; The backend might not have been able to delete the article
-	;; after all.
-	(or (memq (car articles) not-deleted)
-	    (gnus-summary-mark-article (car articles) gnus-canceled-mark))
-	(setq articles (cdr articles))))
-    (gnus-summary-position-point)
-    (gnus-set-mode-line 'summary)
-    not-deleted))
-
-(defun gnus-summary-edit-article (&optional force)
-  "Enter into a buffer and edit the current article.
-This will have permanent effect only in mail groups.
-If FORCE is non-nil, allow editing of articles even in read-only
-groups."
-  (interactive "P")
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
-    (gnus-set-global-variables)
-    (when (and (not force)
-	       (gnus-group-read-only-p))
-      (error "The current newsgroup does not support article editing."))
-    (gnus-summary-select-article t nil t)
-    (gnus-configure-windows 'article)
-    (select-window (get-buffer-window gnus-article-buffer))
-    (gnus-message 6 "C-c C-c to end edits")
-    (setq buffer-read-only nil)
-    (text-mode)
-    (use-local-map (copy-keymap (current-local-map)))
-    (local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
-    (buffer-enable-undo)
-    (widen)
-    (goto-char (point-min))
-    (search-forward "\n\n" nil t)))
-
-(defun gnus-summary-edit-article-done ()
-  "Make edits to the current article permanent."
-  (interactive)
-  (if (gnus-group-read-only-p)
-      (progn
-	(let ((beep (not (eq major-mode 'text-mode))))
-	  (gnus-summary-edit-article-postpone)
-	  (when beep
-	    (gnus-error
-	     3 "The current newsgroup does not support article editing."))))
-    (let ((buf (format "%s" (buffer-string))))
-      (erase-buffer)
-      (insert buf)
-      (if (not (gnus-request-replace-article
-		(cdr gnus-article-current) (car gnus-article-current)
-		(current-buffer)))
-	  (error "Couldn't replace article.")
-	(gnus-article-mode)
-	(use-local-map gnus-article-mode-map)
-	(setq buffer-read-only t)
-	(buffer-disable-undo (current-buffer))
-	(gnus-configure-windows 'summary)
-	(gnus-summary-update-article (cdr gnus-article-current))
-	(when gnus-use-cache
-	  (gnus-cache-update-article 	
-	   (car gnus-article-current) (cdr gnus-article-current)))
-	(when gnus-keep-backlog
-	  (gnus-backlog-remove-article 
-	   (car gnus-article-current) (cdr gnus-article-current))))
-      (save-excursion
-	(when (get-buffer gnus-original-article-buffer)
-	  (set-buffer gnus-original-article-buffer)
-	  (setq gnus-original-article nil)))
-      (setq gnus-article-current nil
-	    gnus-current-article nil)
-      (run-hooks 'gnus-article-display-hook)
-      (and (gnus-visual-p 'summary-highlight 'highlight)
-	   (run-hooks 'gnus-visual-mark-article-hook)))))
-
-(defun gnus-summary-edit-article-postpone ()
-  "Postpone changes to the current article."
-  (interactive)
-  (gnus-article-mode)
-  (use-local-map gnus-article-mode-map)
-  (setq buffer-read-only t)
-  (buffer-disable-undo (current-buffer))
-  (gnus-configure-windows 'summary)
-  (and (gnus-visual-p 'summary-highlight 'highlight)
-       (run-hooks 'gnus-visual-mark-article-hook)))
-
-(defun gnus-summary-respool-query ()
-  "Query where the respool algorithm would put this article."
-  (interactive)
-  (gnus-set-global-variables)
-  (gnus-summary-select-article)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (save-restriction
-      (goto-char (point-min))
-      (search-forward "\n\n")
-      (narrow-to-region (point-min) (point))
-      (pp-eval-expression
-       (list 'quote (mapcar 'car (nnmail-article-group 'identity)))))))
-
-;; Summary marking commands.
-
-(defun gnus-summary-kill-same-subject-and-select (&optional unmark)
-  "Mark articles which has the same subject as read, and then select the next.
-If UNMARK is positive, remove any kind of mark.
-If UNMARK is negative, tick articles."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (if unmark
-      (setq unmark (prefix-numeric-value unmark)))
-  (let ((count
-	 (gnus-summary-mark-same-subject
-	  (gnus-summary-article-subject) unmark)))
-    ;; Select next unread article.  If auto-select-same mode, should
-    ;; select the first unread article.
-    (gnus-summary-next-article t (and gnus-auto-select-same
-				      (gnus-summary-article-subject)))
-    (gnus-message 7 "%d article%s marked as %s"
-		  count (if (= count 1) " is" "s are")
-		  (if unmark "unread" "read"))))
-
-(defun gnus-summary-kill-same-subject (&optional unmark)
-  "Mark articles which has the same subject as read.
-If UNMARK is positive, remove any kind of mark.
-If UNMARK is negative, tick articles."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (if unmark
-      (setq unmark (prefix-numeric-value unmark)))
-  (let ((count
-	 (gnus-summary-mark-same-subject
-	  (gnus-summary-article-subject) unmark)))
-    ;; If marked as read, go to next unread subject.
-    (if (null unmark)
-	;; Go to next unread subject.
-	(gnus-summary-next-subject 1 t))
-    (gnus-message 7 "%d articles are marked as %s"
-		  count (if unmark "unread" "read"))))
-
-(defun gnus-summary-mark-same-subject (subject &optional unmark)
-  "Mark articles with same SUBJECT as read, and return marked number.
-If optional argument UNMARK is positive, remove any kinds of marks.
-If optional argument UNMARK is negative, mark articles as unread instead."
-  (let ((count 1))
-    (save-excursion
-      (cond
-       ((null unmark)			; Mark as read.
-	(while (and
-		(progn
-		  (gnus-summary-mark-article-as-read gnus-killed-mark)
-		  (gnus-summary-show-thread) t)
-		(gnus-summary-find-subject subject))
-	  (setq count (1+ count))))
-       ((> unmark 0)			; Tick.
-	(while (and
-		(progn
-		  (gnus-summary-mark-article-as-unread gnus-ticked-mark)
-		  (gnus-summary-show-thread) t)
-		(gnus-summary-find-subject subject))
-	  (setq count (1+ count))))
-       (t				; Mark as unread.
-	(while (and
-		(progn
-		  (gnus-summary-mark-article-as-unread gnus-unread-mark)
-		  (gnus-summary-show-thread) t)
-		(gnus-summary-find-subject subject))
-	  (setq count (1+ count)))))
-      (gnus-set-mode-line 'summary)
-      ;; Return the number of marked articles.
-      count)))
-
-(defun gnus-summary-mark-as-processable (n &optional unmark)
-  "Set the process mark on the next N articles.
-If N is negative, mark backward instead.  If UNMARK is non-nil, remove
-the process mark instead.  The difference between N and the actual
-number of articles marked is returned."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (let ((backward (< n 0))
-	(n (abs n)))
-    (while (and
-	    (> n 0)
-	    (if unmark
-		(gnus-summary-remove-process-mark
-		 (gnus-summary-article-number))
-	      (gnus-summary-set-process-mark (gnus-summary-article-number)))
-	    (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
-      (setq n (1- n)))
-    (if (/= 0 n) (gnus-message 7 "No more articles"))
-    (gnus-summary-recenter)
-    (gnus-summary-position-point)
-    n))
-
-(defun gnus-summary-unmark-as-processable (n)
-  "Remove the process mark from the next N articles.
-If N is negative, mark backward instead.  The difference between N and
-the actual number of articles marked is returned."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (gnus-summary-mark-as-processable n t))
-
-(defun gnus-summary-unmark-all-processable ()
-  "Remove the process mark from all articles."
-  (interactive)
-  (gnus-set-global-variables)
-  (save-excursion
-    (while gnus-newsgroup-processable
-      (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
-  (gnus-summary-position-point))
-
-(defun gnus-summary-mark-as-expirable (n)
-  "Mark N articles forward as expirable.
-If N is negative, mark backward instead.  The difference between N and
-the actual number of articles marked is returned."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (gnus-summary-mark-forward n gnus-expirable-mark))
-
-(defun gnus-summary-mark-article-as-replied (article)
-  "Mark ARTICLE replied and update the summary line."
-  (setq gnus-newsgroup-replied (cons article gnus-newsgroup-replied))
-  (let ((buffer-read-only nil))
-    (when (gnus-summary-goto-subject article)
-      (gnus-summary-update-secondary-mark article))))
-
-(defun gnus-summary-set-bookmark (article)
-  "Set a bookmark in current article."
-  (interactive (list (gnus-summary-article-number)))
-  (gnus-set-global-variables)
-  (if (or (not (get-buffer gnus-article-buffer))
-	  (not gnus-current-article)
-	  (not gnus-article-current)
-	  (not (equal gnus-newsgroup-name (car gnus-article-current))))
-      (error "No current article selected"))
-  ;; Remove old bookmark, if one exists.
-  (let ((old (assq article gnus-newsgroup-bookmarks)))
-    (if old (setq gnus-newsgroup-bookmarks
-		  (delq old gnus-newsgroup-bookmarks))))
-  ;; Set the new bookmark, which is on the form
-  ;; (article-number . line-number-in-body).
-  (setq gnus-newsgroup-bookmarks
-	(cons
-	 (cons article
-	       (save-excursion
-		 (set-buffer gnus-article-buffer)
-		 (count-lines
-		  (min (point)
-		       (save-excursion
-			 (goto-char (point-min))
-			 (search-forward "\n\n" nil t)
-			 (point)))
-		  (point))))
-	 gnus-newsgroup-bookmarks))
-  (gnus-message 6 "A bookmark has been added to the current article."))
-
-(defun gnus-summary-remove-bookmark (article)
-  "Remove the bookmark from the current article."
-  (interactive (list (gnus-summary-article-number)))
-  (gnus-set-global-variables)
-  ;; Remove old bookmark, if one exists.
-  (let ((old (assq article gnus-newsgroup-bookmarks)))
-    (if old
-	(progn
-	  (setq gnus-newsgroup-bookmarks
-		(delq old gnus-newsgroup-bookmarks))
-	  (gnus-message 6 "Removed bookmark."))
-      (gnus-message 6 "No bookmark in current article."))))
-
-;; Suggested by Daniel Quinlan <quinlan@best.com>.
-(defun gnus-summary-mark-as-dormant (n)
-  "Mark N articles forward as dormant.
-If N is negative, mark backward instead.  The difference between N and
-the actual number of articles marked is returned."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (gnus-summary-mark-forward n gnus-dormant-mark))
-
-(defun gnus-summary-set-process-mark (article)
-  "Set the process mark on ARTICLE and update the summary line."
-  (setq gnus-newsgroup-processable
-	(cons article
-	      (delq article gnus-newsgroup-processable)))
-  (when (gnus-summary-goto-subject article)
-    (gnus-summary-show-thread)
-    (gnus-summary-update-secondary-mark article)))
-
-(defun gnus-summary-remove-process-mark (article)
-  "Remove the process mark from ARTICLE and update the summary line."
-  (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
-  (when (gnus-summary-goto-subject article)
-    (gnus-summary-show-thread)
-    (gnus-summary-update-secondary-mark article)))
-
-(defun gnus-summary-set-saved-mark (article)
-  "Set the process mark on ARTICLE and update the summary line."
-  (push article gnus-newsgroup-saved)
-  (when (gnus-summary-goto-subject article)
-    (gnus-summary-update-secondary-mark article)))
-
-(defun gnus-summary-mark-forward (n &optional mark no-expire)
-  "Mark N articles as read forwards.
-If N is negative, mark backwards instead.  Mark with MARK, ?r by default.
-The difference between N and the actual number of articles marked is
-returned."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (let ((backward (< n 0))
-	(gnus-summary-goto-unread
-	 (and gnus-summary-goto-unread
-	      (not (eq gnus-summary-goto-unread 'never))
-	      (not (memq mark (list gnus-unread-mark
-				    gnus-ticked-mark gnus-dormant-mark)))))
-	(n (abs n))
-	(mark (or mark gnus-del-mark)))
-    (while (and (> n 0)
-		(gnus-summary-mark-article nil mark no-expire)
-		(zerop (gnus-summary-next-subject
-			(if backward -1 1)
-			(and gnus-summary-goto-unread
-			     (not (eq gnus-summary-goto-unread 'never)))
-			t)))
-      (setq n (1- n)))
-    (if (/= 0 n) (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
-    (gnus-summary-recenter)
-    (gnus-summary-position-point)
-    (gnus-set-mode-line 'summary)
-    n))
-
-(defun gnus-summary-mark-article-as-read (mark)
-  "Mark the current article quickly as read with MARK."
-  (let ((article (gnus-summary-article-number)))
-    (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
-    (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
-    (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
-    (setq gnus-newsgroup-reads
-	  (cons (cons article mark) gnus-newsgroup-reads))
-    ;; Possibly remove from cache, if that is used.
-    (and gnus-use-cache (gnus-cache-enter-remove-article article))
-    ;; Allow the backend to change the mark.
-    (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
-    ;; Check for auto-expiry.
-    (when (and gnus-newsgroup-auto-expire
-	       (or (= mark gnus-killed-mark) (= mark gnus-del-mark)
-		   (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
-		   (= mark gnus-ancient-mark)
-		   (= mark gnus-read-mark) (= mark gnus-souped-mark)))
-      (setq mark gnus-expirable-mark)
-      (push article gnus-newsgroup-expirable))
-    ;; Set the mark in the buffer.
-    (gnus-summary-update-mark mark 'unread)
-    t))
-
-(defun gnus-summary-mark-article-as-unread (mark)
-  "Mark the current article quickly as unread with MARK."
-  (let ((article (gnus-summary-article-number)))
-    (if (< article 0)
-	(gnus-error 1 "Unmarkable article")
-      (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
-      (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
-      (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
-      (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
-      (cond ((= mark gnus-ticked-mark)
-	     (push article gnus-newsgroup-marked))
-	    ((= mark gnus-dormant-mark)
-	     (push article gnus-newsgroup-dormant))
-	    (t
-	     (push article gnus-newsgroup-unreads)))
-      (setq gnus-newsgroup-reads
-	    (delq (assq article gnus-newsgroup-reads)
-		  gnus-newsgroup-reads))
-
-      ;; See whether the article is to be put in the cache.
-      (and gnus-use-cache
-	   (vectorp (gnus-summary-article-header article))
-	   (save-excursion
-	     (gnus-cache-possibly-enter-article
-	      gnus-newsgroup-name article
-	      (gnus-summary-article-header article)
-	      (= mark gnus-ticked-mark)
-	      (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
-      ;; Fix the mark.
-      (gnus-summary-update-mark mark 'unread))
-    t))
-
-(defun gnus-summary-mark-article (&optional article mark no-expire)
-  "Mark ARTICLE with MARK.  MARK can be any character.
-Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
-`??' (dormant) and `?E' (expirable).
-If MARK is nil, then the default character `?D' is used.
-If ARTICLE is nil, then the article on the current line will be
-marked."
-  ;; The mark might be a string.
-  (and (stringp mark)
-       (setq mark (aref mark 0)))
-  ;; If no mark is given, then we check auto-expiring.
-  (and (not no-expire)
-       gnus-newsgroup-auto-expire
-       (or (not mark)
-	   (and (numberp mark)
-		(or (= mark gnus-killed-mark) (= mark gnus-del-mark)
-		    (= mark gnus-catchup-mark) (= mark gnus-low-score-mark)
-		    (= mark gnus-read-mark) (= mark gnus-souped-mark))))
-       (setq mark gnus-expirable-mark))
-  (let* ((mark (or mark gnus-del-mark))
-	 (article (or article (gnus-summary-article-number))))
-    (or article (error "No article on current line"))
-    (if (or (= mark gnus-unread-mark)
-	    (= mark gnus-ticked-mark)
-	    (= mark gnus-dormant-mark))
-	(gnus-mark-article-as-unread article mark)
-      (gnus-mark-article-as-read article mark))
-
-    ;; See whether the article is to be put in the cache.
-    (and gnus-use-cache
-	 (not (= mark gnus-canceled-mark))
-	 (vectorp (gnus-summary-article-header article))
-	 (save-excursion
-	   (gnus-cache-possibly-enter-article
-	    gnus-newsgroup-name article
-	    (gnus-summary-article-header article)
-	    (= mark gnus-ticked-mark)
-	    (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
-    (if (gnus-summary-goto-subject article nil t)
-	(let ((buffer-read-only nil))
-	  (gnus-summary-show-thread)
-	  ;; Fix the mark.
-	  (gnus-summary-update-mark mark 'unread)
-	  t))))
-
-(defun gnus-summary-update-secondary-mark (article)
-  "Update the secondary (read, process, cache) mark."
-  (gnus-summary-update-mark
-   (cond ((memq article gnus-newsgroup-processable)
-	  gnus-process-mark)
-	 ((memq article gnus-newsgroup-cached)
-	  gnus-cached-mark)
-	 ((memq article gnus-newsgroup-replied)
-	  gnus-replied-mark)
-	 ((memq article gnus-newsgroup-saved)
-	  gnus-saved-mark)
-	 (t gnus-unread-mark))
-   'replied)
-  (when (gnus-visual-p 'summary-highlight 'highlight)
-    (run-hooks 'gnus-summary-update-hook))
-  t)
-
-(defun gnus-summary-update-mark (mark type)
-  (beginning-of-line)
-  (let ((forward (cdr (assq type gnus-summary-mark-positions)))
-	(buffer-read-only nil))
-    (when (and forward
-	       (<= (+ forward (point)) (point-max)))
-      ;; Go to the right position on the line.
-      (goto-char (+ forward (point)))
-      ;; Replace the old mark with the new mark.
-      (subst-char-in-region (point) (1+ (point)) (following-char) mark)
-      ;; Optionally update the marks by some user rule.
-      (when (eq type 'unread)
-	(gnus-data-set-mark
-	 (gnus-data-find (gnus-summary-article-number)) mark)
-	(gnus-summary-update-line (eq mark gnus-unread-mark))))))
-
-(defun gnus-mark-article-as-read (article &optional mark)
-  "Enter ARTICLE in the pertinent lists and remove it from others."
-  ;; Make the article expirable.
-  (let ((mark (or mark gnus-del-mark)))
-    (if (= mark gnus-expirable-mark)
-	(setq gnus-newsgroup-expirable (cons article gnus-newsgroup-expirable))
-      (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)))
-    ;; Remove from unread and marked lists.
-    (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
-    (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
-    (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
-    (push (cons article mark) gnus-newsgroup-reads)
-    ;; Possibly remove from cache, if that is used.
-    (when gnus-use-cache
-      (gnus-cache-enter-remove-article article))))
-
-(defun gnus-mark-article-as-unread (article &optional mark)
-  "Enter ARTICLE in the pertinent lists and remove it from others."
-  (let ((mark (or mark gnus-ticked-mark)))
-    (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
-    (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
-    (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
-    (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
-    (cond ((= mark gnus-ticked-mark)
-	   (push article gnus-newsgroup-marked))
-	  ((= mark gnus-dormant-mark)
-	   (push article gnus-newsgroup-dormant))
-	  (t
-	   (push article gnus-newsgroup-unreads)))
-    (setq gnus-newsgroup-reads
-	  (delq (assq article gnus-newsgroup-reads)
-		gnus-newsgroup-reads))))
-
-(defalias 'gnus-summary-mark-as-unread-forward
-  'gnus-summary-tick-article-forward)
-(make-obsolete 'gnus-summary-mark-as-unread-forward
-	       'gnus-summary-tick-article-forward)
-(defun gnus-summary-tick-article-forward (n)
-  "Tick N articles forwards.
-If N is negative, tick backwards instead.
-The difference between N and the number of articles ticked is returned."
-  (interactive "p")
-  (gnus-summary-mark-forward n gnus-ticked-mark))
-
-(defalias 'gnus-summary-mark-as-unread-backward
-  'gnus-summary-tick-article-backward)
-(make-obsolete 'gnus-summary-mark-as-unread-backward
-	       'gnus-summary-tick-article-backward)
-(defun gnus-summary-tick-article-backward (n)
-  "Tick N articles backwards.
-The difference between N and the number of articles ticked is returned."
-  (interactive "p")
-  (gnus-summary-mark-forward (- n) gnus-ticked-mark))
-
-(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
-(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
-(defun gnus-summary-tick-article (&optional article clear-mark)
-  "Mark current article as unread.
-Optional 1st argument ARTICLE specifies article number to be marked as unread.
-Optional 2nd argument CLEAR-MARK remove any kinds of mark."
-  (interactive)
-  (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
-				       gnus-ticked-mark)))
-
-(defun gnus-summary-mark-as-read-forward (n)
-  "Mark N articles as read forwards.
-If N is negative, mark backwards instead.
-The difference between N and the actual number of articles marked is
-returned."
-  (interactive "p")
-  (gnus-summary-mark-forward n gnus-del-mark t))
-
-(defun gnus-summary-mark-as-read-backward (n)
-  "Mark the N articles as read backwards.
-The difference between N and the actual number of articles marked is
-returned."
-  (interactive "p")
-  (gnus-summary-mark-forward (- n) gnus-del-mark t))
-
-(defun gnus-summary-mark-as-read (&optional article mark)
-  "Mark current article as read.
-ARTICLE specifies the article to be marked as read.
-MARK specifies a string to be inserted at the beginning of the line."
-  (gnus-summary-mark-article article mark))
-
-(defun gnus-summary-clear-mark-forward (n)
-  "Clear marks from N articles forward.
-If N is negative, clear backward instead.
-The difference between N and the number of marks cleared is returned."
-  (interactive "p")
-  (gnus-summary-mark-forward n gnus-unread-mark))
-
-(defun gnus-summary-clear-mark-backward (n)
-  "Clear marks from N articles backward.
-The difference between N and the number of marks cleared is returned."
-  (interactive "p")
-  (gnus-summary-mark-forward (- n) gnus-unread-mark))
-
-(defun gnus-summary-mark-unread-as-read ()
-  "Intended to be used by `gnus-summary-mark-article-hook'."
-  (when (memq gnus-current-article gnus-newsgroup-unreads)
-    (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
-
-(defun gnus-summary-mark-read-and-unread-as-read ()
-  "Intended to be used by `gnus-summary-mark-article-hook'."
-  (let ((mark (gnus-summary-article-mark)))
-    (when (or (gnus-unread-mark-p mark)
-	      (gnus-read-mark-p mark))
-      (gnus-summary-mark-article gnus-current-article gnus-read-mark))))
-
-(defun gnus-summary-mark-region-as-read (point mark all)
-  "Mark all unread articles between point and mark as read.
-If given a prefix, mark all articles between point and mark as read,
-even ticked and dormant ones."
-  (interactive "r\nP")
-  (save-excursion
-    (let (article)
-      (goto-char point)
-      (beginning-of-line)
-      (while (and
-	      (< (point) mark)
-	      (progn
-		(when (or all
-			  (memq (setq article (gnus-summary-article-number))
-				gnus-newsgroup-unreads))
-		  (gnus-summary-mark-article article gnus-del-mark))
-		t)
-	      (gnus-summary-find-next))))))
-
-(defun gnus-summary-mark-below (score mark)
-  "Mark articles with score less than SCORE with MARK."
-  (interactive "P\ncMark: ")
-  (gnus-set-global-variables)
-  (setq score (if score
-		  (prefix-numeric-value score)
-		(or gnus-summary-default-score 0)))
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
-    (goto-char (point-min))
-    (while 
-	(progn
-	  (and (< (gnus-summary-article-score) score)
-	       (gnus-summary-mark-article nil mark))
-	  (gnus-summary-find-next)))))
-
-(defun gnus-summary-kill-below (&optional score)
-  "Mark articles with score below SCORE as read."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-summary-mark-below score gnus-killed-mark))
-
-(defun gnus-summary-clear-above (&optional score)
-  "Clear all marks from articles with score above SCORE."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-summary-mark-above score gnus-unread-mark))
-
-(defun gnus-summary-tick-above (&optional score)
-  "Tick all articles with score above SCORE."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-summary-mark-above score gnus-ticked-mark))
-
-(defun gnus-summary-mark-above (score mark)
-  "Mark articles with score over SCORE with MARK."
-  (interactive "P\ncMark: ")
-  (gnus-set-global-variables)
-  (setq score (if score
-		  (prefix-numeric-value score)
-		(or gnus-summary-default-score 0)))
-  (save-excursion
-    (set-buffer gnus-summary-buffer)
-    (goto-char (point-min))
-    (while (and (progn
-		  (if (> (gnus-summary-article-score) score)
-		      (gnus-summary-mark-article nil mark))
-		  t)
-		(gnus-summary-find-next)))))
-
-;; Suggested by Daniel Quinlan <quinlan@best.com>.
-(defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
-(defun gnus-summary-limit-include-expunged ()
-  "Display all the hidden articles that were expunged for low scores."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((buffer-read-only nil))
-    (let ((scored gnus-newsgroup-scored)
-	  headers h)
-      (while scored
-	(or (gnus-summary-goto-subject (caar scored))
-	    (and (setq h (gnus-summary-article-header (caar scored)))
-		 (< (cdar scored) gnus-summary-expunge-below)
-		 (setq headers (cons h headers))))
-	(setq scored (cdr scored)))
-      (or headers (error "No expunged articles hidden."))
-      (goto-char (point-min))
-      (gnus-summary-prepare-unthreaded (nreverse headers)))
-    (goto-char (point-min))
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-catchup (&optional all quietly to-here not-mark)
-  "Mark all articles not marked as unread in this newsgroup as read.
-If prefix argument ALL is non-nil, all articles are marked as read.
-If QUIETLY is non-nil, no questions will be asked.
-If TO-HERE is non-nil, it should be a point in the buffer.  All
-articles before this point will be marked as read.
-The number of articles marked as read is returned."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (prog1
-      (if (or quietly
-	      (not gnus-interactive-catchup) ;Without confirmation?
-	      gnus-expert-user
-	      (gnus-y-or-n-p
-	       (if all
-		   "Mark absolutely all articles as read? "
-		 "Mark all unread articles as read? ")))
-	  (if (and not-mark
-		   (not gnus-newsgroup-adaptive)
-		   (not gnus-newsgroup-auto-expire))
-	      (progn
-		(when all
-		  (setq gnus-newsgroup-marked nil
-			gnus-newsgroup-dormant nil))
-		(setq gnus-newsgroup-unreads nil))
-	    ;; We actually mark all articles as canceled, which we
-	    ;; have to do when using auto-expiry or adaptive scoring.
-	    (gnus-summary-show-all-threads)
-	    (if (gnus-summary-first-subject (not all))
-		(while (and
-			(if to-here (< (point) to-here) t)
-			(gnus-summary-mark-article-as-read gnus-catchup-mark)
-			(gnus-summary-find-next (not all)))))
-	    (unless to-here
-	      (setq gnus-newsgroup-unreads nil))
-	    (gnus-set-mode-line 'summary)))
-    (let ((method (gnus-find-method-for-group gnus-newsgroup-name)))
-      (if (and (not to-here) (eq 'nnvirtual (car method)))
-	  (nnvirtual-catchup-group
-	   (gnus-group-real-name gnus-newsgroup-name) (nth 1 method) all)))
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-catchup-to-here (&optional all)
-  "Mark all unticked articles before the current one as read.
-If ALL is non-nil, also mark ticked and dormant articles as read."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (save-excursion
-    (gnus-save-hidden-threads
-      (let ((beg (point)))
-	;; We check that there are unread articles.
-	(when (or all (gnus-summary-find-prev))
-	  (gnus-summary-catchup all t beg)))))
-  (gnus-summary-position-point))
-
-(defun gnus-summary-catchup-all (&optional quietly)
-  "Mark all articles in this newsgroup as read."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-summary-catchup t quietly))
-
-(defun gnus-summary-catchup-and-exit (&optional all quietly)
-  "Mark all articles not marked as unread in this newsgroup as read, then exit.
-If prefix argument ALL is non-nil, all articles are marked as read."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-summary-catchup all quietly nil 'fast)
-  ;; Select next newsgroup or exit.
-  (if (eq gnus-auto-select-next 'quietly)
-      (gnus-summary-next-group nil)
-    (gnus-summary-exit)))
-
-(defun gnus-summary-catchup-all-and-exit (&optional quietly)
-  "Mark all articles in this newsgroup as read, and then exit."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (gnus-summary-catchup-and-exit t quietly))
-
-;; Suggested by "Arne Eofsson" <arne@hodgkin.mbi.ucla.edu>.
-(defun gnus-summary-catchup-and-goto-next-group (&optional all)
-  "Mark all articles in this group as read and select the next group.
-If given a prefix, mark all articles, unread as well as ticked, as
-read."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (save-excursion
-    (gnus-summary-catchup all))
-  (gnus-summary-next-article t nil nil t))
-
-;; Thread-based commands.
-
-(defun gnus-summary-articles-in-thread (&optional article)
-  "Return a list of all articles in the current thread.
-If ARTICLE is non-nil, return all articles in the thread that starts
-with that article."
-  (let* ((article (or article (gnus-summary-article-number)))
-	 (data (gnus-data-find-list article))
-	 (top-level (gnus-data-level (car data)))
-	 (top-subject
-	  (cond ((null gnus-thread-operation-ignore-subject)
-		 (gnus-simplify-subject-re
-		  (mail-header-subject (gnus-data-header (car data)))))
-		((eq gnus-thread-operation-ignore-subject 'fuzzy)
-		 (gnus-simplify-subject-fuzzy
-		  (mail-header-subject (gnus-data-header (car data)))))
-		(t nil)))
-	 (end-point (save-excursion
-		      (if (gnus-summary-go-to-next-thread) 
-			  (point) (point-max))))
-	 articles)
-    (while (and data
-		(< (gnus-data-pos (car data)) end-point))
-      (when (or (not top-subject)
-		(string= top-subject
-			 (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
-			     (gnus-simplify-subject-fuzzy
-			      (mail-header-subject
-			       (gnus-data-header (car data))))
-			   (gnus-simplify-subject-re
-			    (mail-header-subject
-			     (gnus-data-header (car data)))))))
-	(push (gnus-data-number (car data)) articles))
-      (unless (and (setq data (cdr data))
-		   (> (gnus-data-level (car data)) top-level))
-	(setq data nil)))
-    ;; Return the list of articles.
-    (nreverse articles)))
-
-(defun gnus-summary-rethread-current ()
-  "Rethread the thread the current article is part of."
-  (interactive)
-  (gnus-set-global-variables)
-  (let* ((gnus-show-threads t)
-	 (article (gnus-summary-article-number))
-	 (id (mail-header-id (gnus-summary-article-header)))
-	 (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
-    (unless id
-      (error "No article on the current line"))
-    (gnus-rebuild-thread id)
-    (gnus-summary-goto-subject article)))
-
-(defun gnus-summary-reparent-thread ()
-  "Make current article child of the marked (or previous) article.
-
-Note that the re-threading will only work if `gnus-thread-ignore-subject'
-is non-nil or the Subject: of both articles are the same."
-  (interactive)
-  (or (not (gnus-group-read-only-p))
-      (error "The current newsgroup does not support article editing."))
-  (or (<= (length gnus-newsgroup-processable) 1)
-      (error "No more than one article may be marked."))
-  (save-window-excursion
-    (let ((gnus-article-buffer " *reparent*")
-	  (current-article (gnus-summary-article-number))
-	  ; first grab the marked article, otherwise one line up.
-	  (parent-article (if (not (null gnus-newsgroup-processable))
-			      (car gnus-newsgroup-processable)
-			    (save-excursion
-			      (if (eq (forward-line -1) 0)
-				  (gnus-summary-article-number)
-				(error "Beginning of summary buffer."))))))
-      (or (not (eq current-article parent-article))
-	  (error "An article may not be self-referential."))
-      (let ((message-id (mail-header-id 
-			 (gnus-summary-article-header parent-article))))
-	(or (and message-id (not (equal message-id "")))
-	    (error "No message-id in desired parent."))
-	(gnus-summary-select-article t t nil current-article)
-	(set-buffer gnus-article-buffer)
-	(setq buffer-read-only nil)
-	(let ((buf (format "%s" (buffer-string))))
-	  (erase-buffer)
-	  (insert buf))
-	(goto-char (point-min))
-	(if (search-forward-regexp "^References: " nil t)
-	    (insert message-id " " )
-	  (insert "References: " message-id "\n"))
-	(or (gnus-request-replace-article current-article
-					  (car gnus-article-current)
-					  gnus-article-buffer)
-	    (error "Couldn't replace article."))
-	(set-buffer gnus-summary-buffer)
-	(gnus-summary-unmark-all-processable)
-	(gnus-summary-rethread-current)
-	(gnus-message 3 "Article %d is now the child of article %d."
-		      current-article parent-article)))))
-
-(defun gnus-summary-toggle-threads (&optional arg)
-  "Toggle showing conversation threads.
-If ARG is positive number, turn showing conversation threads on."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
-    (setq gnus-show-threads
-	  (if (null arg) (not gnus-show-threads)
-	    (> (prefix-numeric-value arg) 0)))
-    (gnus-summary-prepare)
-    (gnus-summary-goto-subject current)
-    (gnus-summary-position-point)))
-
-(defun gnus-summary-show-all-threads ()
-  "Show all threads."
-  (interactive)
-  (gnus-set-global-variables)
-  (save-excursion
-    (let ((buffer-read-only nil))
-      (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
-  (gnus-summary-position-point))
-
-(defun gnus-summary-show-thread ()
-  "Show thread subtrees.
-Returns nil if no thread was there to be shown."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((buffer-read-only nil)
-	(orig (point))
-	;; first goto end then to beg, to have point at beg after let
-	(end (progn (end-of-line) (point)))
-	(beg (progn (beginning-of-line) (point))))
-    (prog1
-	;; Any hidden lines here?
-	(search-forward "\r" end t)
-      (subst-char-in-region beg end ?\^M ?\n t)
-      (goto-char orig)
-      (gnus-summary-position-point))))
-
-(defun gnus-summary-hide-all-threads ()
-  "Hide all thread subtrees."
-  (interactive)
-  (gnus-set-global-variables)
-  (save-excursion
-    (goto-char (point-min))
-    (gnus-summary-hide-thread)
-    (while (zerop (gnus-summary-next-thread 1 t))
-      (gnus-summary-hide-thread)))
-  (gnus-summary-position-point))
-
-(defun gnus-summary-hide-thread ()
-  "Hide thread subtrees.
-Returns nil if no threads were there to be hidden."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((buffer-read-only nil)
-	(start (point))
-	(article (gnus-summary-article-number)))
-    (goto-char start)
-    ;; Go forward until either the buffer ends or the subthread
-    ;; ends.
-    (when (and (not (eobp))
-	       (or (zerop (gnus-summary-next-thread 1 t))
-		   (goto-char (point-max))))
-      (prog1
-	  (if (and (> (point) start)
-		   (search-backward "\n" start t))
-	      (progn
-		(subst-char-in-region start (point) ?\n ?\^M)
-		(gnus-summary-goto-subject article))
-	    (goto-char start)
-	    nil)
-	;;(gnus-summary-position-point)
-	))))
-
-(defun gnus-summary-go-to-next-thread (&optional previous)
-  "Go to the same level (or less) next thread.
-If PREVIOUS is non-nil, go to previous thread instead.
-Return the article number moved to, or nil if moving was impossible."
-  (let ((level (gnus-summary-thread-level))
-	(way (if previous -1 1))
-	(beg (point)))
-    (forward-line way)
-    (while (and (not (eobp))
-		(< level (gnus-summary-thread-level)))
-      (forward-line way))
-    (if (eobp)
-	(progn
-	  (goto-char beg)
-	  nil)
-      (setq beg (point))
-      (prog1
-	  (gnus-summary-article-number)
-	(goto-char beg)))))
-
-(defun gnus-summary-go-to-next-thread-old (&optional previous)
-  "Go to the same level (or less) next thread.
-If PREVIOUS is non-nil, go to previous thread instead.
-Return the article number moved to, or nil if moving was impossible."
-  (if (and (eq gnus-summary-make-false-root 'dummy)
-	   (gnus-summary-article-intangible-p))
-      (let ((beg (point)))
-	(while (and (zerop (forward-line 1))
-		    (not (gnus-summary-article-intangible-p))
-		    (not (zerop (save-excursion 
-				  (gnus-summary-thread-level))))))
-	(if (eobp)
-	    (progn
-	      (goto-char beg)
-	      nil)
-	  (point)))
-    (let* ((level (gnus-summary-thread-level))
-	   (article (gnus-summary-article-number))
-	   (data (cdr (gnus-data-find-list article (gnus-data-list previous))))
-	   oart)
-      (while data
-	(if (<= (gnus-data-level (car data)) level)
-	    (setq oart (gnus-data-number (car data))
-		  data nil)
-	  (setq data (cdr data))))
-      (and oart
-	   (gnus-summary-goto-subject oart)))))
-
-(defun gnus-summary-next-thread (n &optional silent)
-  "Go to the same level next N'th thread.
-If N is negative, search backward instead.
-Returns the difference between N and the number of skips actually
-done.
-
-If SILENT, don't output messages."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (let ((backward (< n 0))
-	(n (abs n))
-	old dum int)
-    (while (and (> n 0)
-		(gnus-summary-go-to-next-thread backward))
-      (decf n))
-    (unless silent 
-      (gnus-summary-position-point))
-    (when (and (not silent) (/= 0 n))
-      (gnus-message 7 "No more threads"))
-    n))
-
-(defun gnus-summary-prev-thread (n)
-  "Go to the same level previous N'th thread.
-Returns the difference between N and the number of skips actually
-done."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (gnus-summary-next-thread (- n)))
-
-(defun gnus-summary-go-down-thread ()
-  "Go down one level in the current thread."
-  (let ((children (gnus-summary-article-children)))
-    (and children
-	 (gnus-summary-goto-subject (car children)))))
-
-(defun gnus-summary-go-up-thread ()
-  "Go up one level in the current thread."
-  (let ((parent (gnus-summary-article-parent)))
-    (and parent
-	 (gnus-summary-goto-subject parent))))
-
-(defun gnus-summary-down-thread (n)
-  "Go down thread N steps.
-If N is negative, go up instead.
-Returns the difference between N and how many steps down that were
-taken."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (let ((up (< n 0))
-	(n (abs n)))
-    (while (and (> n 0)
-		(if up (gnus-summary-go-up-thread)
-		  (gnus-summary-go-down-thread)))
-      (setq n (1- n)))
-    (gnus-summary-position-point)
-    (if (/= 0 n) (gnus-message 7 "Can't go further"))
-    n))
-
-(defun gnus-summary-up-thread (n)
-  "Go up thread N steps.
-If N is negative, go up instead.
-Returns the difference between N and how many steps down that were
-taken."
-  (interactive "p")
-  (gnus-set-global-variables)
-  (gnus-summary-down-thread (- n)))
-
-(defun gnus-summary-top-thread ()
-  "Go to the top of the thread."
-  (interactive)
-  (gnus-set-global-variables)
-  (while (gnus-summary-go-up-thread))
-  (gnus-summary-article-number))
-
-(defun gnus-summary-kill-thread (&optional unmark)
-  "Mark articles under current thread as read.
-If the prefix argument is positive, remove any kinds of marks.
-If the prefix argument is negative, tick articles instead."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (when unmark
-    (setq unmark (prefix-numeric-value unmark)))
-  (let ((articles (gnus-summary-articles-in-thread)))
-    (save-excursion
-      ;; Expand the thread.
-      (gnus-summary-show-thread)
-      ;; Mark all the articles.
-      (while articles
-	(gnus-summary-goto-subject (car articles))
-	(cond ((null unmark)
-	       (gnus-summary-mark-article-as-read gnus-killed-mark))
-	      ((> unmark 0)
-	       (gnus-summary-mark-article-as-unread gnus-unread-mark))
-	      (t
-	       (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
-	(setq articles (cdr articles))))
-    ;; Hide killed subtrees.
-    (and (null unmark)
-	 gnus-thread-hide-killed
-	 (gnus-summary-hide-thread))
-    ;; If marked as read, go to next unread subject.
-    (if (null unmark)
-	;; Go to next unread subject.
-	(gnus-summary-next-subject 1 t)))
-  (gnus-set-mode-line 'summary))
-
-;; Summary sorting commands
-
-(defun gnus-summary-sort-by-number (&optional reverse)
-  "Sort summary buffer by article number.
-Argument REVERSE means reverse order."
-  (interactive "P")
-  (gnus-summary-sort 'number reverse))
-
-(defun gnus-summary-sort-by-author (&optional reverse)
-  "Sort summary buffer by author name alphabetically.
-If case-fold-search is non-nil, case of letters is ignored.
-Argument REVERSE means reverse order."
-  (interactive "P")
-  (gnus-summary-sort 'author reverse))
-
-(defun gnus-summary-sort-by-subject (&optional reverse)
-  "Sort summary buffer by subject alphabetically. `Re:'s are ignored.
-If case-fold-search is non-nil, case of letters is ignored.
-Argument REVERSE means reverse order."
-  (interactive "P")
-  (gnus-summary-sort 'subject reverse))
-
-(defun gnus-summary-sort-by-date (&optional reverse)
-  "Sort summary buffer by date.
-Argument REVERSE means reverse order."
-  (interactive "P")
-  (gnus-summary-sort 'date reverse))
-
-(defun gnus-summary-sort-by-score (&optional reverse)
-  "Sort summary buffer by score.
-Argument REVERSE means reverse order."
-  (interactive "P")
-  (gnus-summary-sort 'score reverse))
-
-(defun gnus-summary-sort (predicate reverse)
-  "Sort summary buffer by PREDICATE.  REVERSE means reverse order."
-  (gnus-set-global-variables)
-  (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
-	 (article (intern (format "gnus-article-sort-by-%s" predicate)))
-	 (gnus-thread-sort-functions
-	  (list
-	   (if (not reverse)
-	       thread
-	     `(lambda (t1 t2)
-		(,thread t2 t1)))))
-	 (gnus-article-sort-functions
-	  (list
-	   (if (not reverse)
-	       article
-	     `(lambda (t1 t2)
-		(,article t2 t1)))))
-	 (buffer-read-only)
-	 (gnus-summary-prepare-hook nil))
-    ;; We do the sorting by regenerating the threads.
-    (gnus-summary-prepare)
-    ;; Hide subthreads if needed.
-    (when (and gnus-show-threads gnus-thread-hide-subtree)
-      (gnus-summary-hide-all-threads)))
-  ;; If in async mode, we send some info to the backend.
-  (when gnus-newsgroup-async
-    (gnus-request-asynchronous
-     gnus-newsgroup-name gnus-newsgroup-data)))
-
-(defun gnus-sortable-date (date)
-  "Make sortable string by string-lessp from DATE.
-Timezone package is used."
-  (condition-case ()
-      (progn
-	(setq date (inline (timezone-fix-time 
-			    date nil 
-			    (aref (inline (timezone-parse-date date)) 4))))
-	(inline
-	  (timezone-make-sortable-date
-	   (aref date 0) (aref date 1) (aref date 2)
-	   (inline
-	     (timezone-make-time-string
-	      (aref date 3) (aref date 4) (aref date 5))))))
-    (error "")))
-  
-;; Summary saving commands.
-
-(defun gnus-summary-save-article (&optional n not-saved)
-  "Save the current article using the default saver function.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead.
-The variable `gnus-default-article-saver' specifies the saver function."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((articles (gnus-summary-work-articles n))
-	(save-buffer (save-excursion 
-		       (nnheader-set-temp-buffer " *Gnus Save*")))
-	file header article)
-    (while articles
-      (setq header (gnus-summary-article-header
-		    (setq article (pop articles))))
-      (if (not (vectorp header))
-	  ;; This is a pseudo-article.
-	  (if (assq 'name header)
-	      (gnus-copy-file (cdr (assq 'name header)))
-	    (gnus-message 1 "Article %d is unsaveable" article))
-	;; This is a real article.
-	(save-window-excursion
-	  (gnus-summary-select-article t nil nil article))
-	(save-excursion
-	  (set-buffer save-buffer)
-	  (erase-buffer)
-	  (insert-buffer-substring gnus-original-article-buffer))
-	(unless gnus-save-all-headers
-	  ;; Remove headers accoring to `gnus-saved-headers'.
-	  (let ((gnus-visible-headers
-		 (or gnus-saved-headers gnus-visible-headers))
-		(gnus-article-buffer save-buffer))
-	    (gnus-article-hide-headers 1 t)))
-	(save-window-excursion
-	  (if (not gnus-default-article-saver)
-	      (error "No default saver is defined.")
-	    ;; !!! Magic!  The saving functions all save
-	    ;; `gnus-original-article-buffer' (or so they think),
-	    ;; but we bind that variable to our save-buffer.
-	    (set-buffer gnus-article-buffer)
-	    (let ((gnus-original-article-buffer save-buffer))
-	      (set-buffer gnus-summary-buffer)
-	      (setq file (funcall
-			  gnus-default-article-saver
-			  (cond
-			   ((not gnus-prompt-before-saving)
-			    'default)
-			   ((eq gnus-prompt-before-saving 'always)
-			    nil)
-			   (t file)))))))
-	(gnus-summary-remove-process-mark article)
-	(unless not-saved
-	  (gnus-summary-set-saved-mark article))))
-    (gnus-kill-buffer save-buffer)
-    (gnus-summary-position-point)
-    n))
-
-(defun gnus-summary-pipe-output (&optional arg)
-  "Pipe the current article to a subprocess.
-If N is a positive number, pipe the N next articles.
-If N is a negative number, pipe the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-pipe those articles instead."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe))
-    (gnus-summary-save-article arg t))
-  (gnus-configure-windows 'pipe))
-
-(defun gnus-summary-save-article-mail (&optional arg)
-  "Append the current article to an mail file.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
-    (gnus-summary-save-article arg)))
-
-(defun gnus-summary-save-article-rmail (&optional arg)
-  "Append the current article to an rmail file.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
-    (gnus-summary-save-article arg)))
-
-(defun gnus-summary-save-article-file (&optional arg)
-  "Append the current article to a file.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
-    (gnus-summary-save-article arg)))
-
-(defun gnus-summary-save-article-body-file (&optional arg)
-  "Append the current article body to a file.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
-  (interactive "P")
-  (gnus-set-global-variables)
-  (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
-    (gnus-summary-save-article arg)))
-
-(defun gnus-get-split-value (methods)
-  "Return a value based on the split METHODS."
-  (let (split-name method result match)
-    (when methods
-      (save-excursion
-	(set-buffer gnus-original-article-buffer)
-	(save-restriction
-	  (nnheader-narrow-to-headers)
-	  (while methods
-	    (goto-char (point-min))
-	    (setq method (pop methods))
-	    (setq match (car method))
-	    (when (cond
-		   ((stringp match)
-		    ;; Regular expression.
-		    (condition-case ()
-			(re-search-forward match nil t)
-		      (error nil)))
-		   ((gnus-functionp match)
-		    ;; Function.
-		    (save-restriction
-		      (widen)
-		      (setq result (funcall match gnus-newsgroup-name))))
-		   ((consp match)
-		    ;; Form.
-		    (save-restriction
-		      (widen)
-		      (setq result (eval match)))))
-	      (setq split-name (append (cdr method) split-name))
-	      (cond ((stringp result)
-		     (push result split-name))
-		    ((consp result)
-		     (setq split-name (append result split-name)))))))))
-    split-name))
-
-(defun gnus-read-move-group-name (prompt default articles prefix)
-  "Read a group name."
-  (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
-	 (minibuffer-confirm-incomplete nil) ; XEmacs
-	 group-map
-	 (dum (mapatoms
-	       (lambda (g) 
-		 (and (boundp g)
-		      (symbol-name g)
-		      (memq 'respool
-			    (assoc (symbol-name
-				    (car (gnus-find-method-for-group
-					  (symbol-name g))))
-				   gnus-valid-select-methods))
-		      (push (list (symbol-name g)) group-map)))
-	       gnus-active-hashtb))
-	 (prom
-	  (format "%s %s to:"
-		  prompt
-		  (if (> (length articles) 1)
-		      (format "these %d articles" (length articles))
-		    "this article")))
-	 (to-newsgroup
-	  (cond
-	   ((null split-name)
-	    (gnus-completing-read default prom
-				  group-map nil nil prefix
-				  'gnus-group-history))
-	   ((= 1 (length split-name))
-	    (gnus-completing-read (car split-name) prom group-map
-				  nil nil nil
-				  'gnus-group-history))
-	   (t
-	    (gnus-completing-read nil prom 
-				  (mapcar (lambda (el) (list el))
-					  (nreverse split-name))
-				  nil nil nil
-				  'gnus-group-history)))))
-    (when to-newsgroup
-      (if (or (string= to-newsgroup "")
-	      (string= to-newsgroup prefix))
-	  (setq to-newsgroup (or default "")))
-      (or (gnus-active to-newsgroup)
-	  (gnus-activate-group to-newsgroup)
-	  (if (gnus-y-or-n-p (format "No such group: %s.  Create it? "
-				     to-newsgroup))
-	      (or (and (gnus-request-create-group 
-			to-newsgroup (gnus-group-name-to-method to-newsgroup))
-		       (gnus-activate-group to-newsgroup nil nil
-					    (gnus-group-name-to-method
-					     to-newsgroup)))
-		  (error "Couldn't create group %s" to-newsgroup)))
-	  (error "No such group: %s" to-newsgroup)))
-    to-newsgroup))
-
-(defun gnus-read-save-file-name (prompt default-name)
-  (let* ((split-name (gnus-get-split-value gnus-split-methods))
-	 (file
-	  ;; Let the split methods have their say.
-	  (cond
-	   ;; No split name was found.
-	   ((null split-name)
-	    (read-file-name
-	     (concat prompt " (default "
-		     (file-name-nondirectory default-name) ") ")
-	     (file-name-directory default-name)
-	     default-name))
-	   ;; A single split name was found
-	   ((= 1 (length split-name))
- 	    (let* ((name (car split-name))
- 		   (dir (cond ((file-directory-p name)
- 			       (file-name-as-directory name))
- 			      ((file-exists-p name) name)
- 			      (t gnus-article-save-directory))))
- 	      (read-file-name
- 	       (concat prompt " (default " name ") ")
- 	       dir name)))
-	   ;; A list of splits was found.
-	   (t
-	    (setq split-name (nreverse split-name))
-	    (let (result)
-	      (let ((file-name-history (nconc split-name file-name-history)))
-		(setq result
-		      (read-file-name
-		       (concat prompt " (`M-p' for defaults) ")
-		       gnus-article-save-directory
-		       (car split-name))))
-	      (car (push result file-name-history)))))))
-    ;; If we have read a directory, we append the default file name.
-    (when (file-directory-p file)
-      (setq file (concat (file-name-as-directory file)
-			 (file-name-nondirectory default-name))))
-    ;; Possibly translate some charaters.
-    (nnheader-translate-file-chars file)))
-
-(defun gnus-article-archive-name (group)
-  "Return the first instance of an \"Archive-name\" in the current buffer."
-  (let ((case-fold-search t))
-    (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
-      (match-string 1))))
-
-(defun gnus-summary-save-in-rmail (&optional filename)
-  "Append this article to Rmail file.
-Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory'."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((default-name
-	  (funcall gnus-rmail-save-name gnus-newsgroup-name
-		   gnus-current-headers gnus-newsgroup-last-rmail)))
-    (setq filename
-	  (cond ((eq filename 'default)
-		 default-name)
-		(filename filename)
-		(t (gnus-read-save-file-name
-		    "Save in rmail file:" default-name))))
-    (gnus-make-directory (file-name-directory filename))
-    (gnus-eval-in-buffer-window gnus-original-article-buffer
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (gnus-output-to-rmail filename))))
-    ;; Remember the directory name to save articles
-    (setq gnus-newsgroup-last-rmail filename)))
-
-(defun gnus-summary-save-in-mail (&optional filename)
-  "Append this article to Unix mail file.
-Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory'."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((default-name
-	  (funcall gnus-mail-save-name gnus-newsgroup-name
-		   gnus-current-headers gnus-newsgroup-last-mail)))
-    (setq filename
-	  (cond ((eq filename 'default)
-		 default-name)
-		(filename filename)
-		(t (gnus-read-save-file-name
-		    "Save in Unix mail file:" default-name))))
-    (setq filename
-	  (expand-file-name filename
-			    (and default-name
-				 (file-name-directory default-name))))
-    (gnus-make-directory (file-name-directory filename))
-    (gnus-eval-in-buffer-window gnus-original-article-buffer
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (if (and (file-readable-p filename) (mail-file-babyl-p filename))
-	      (gnus-output-to-rmail filename)
-	    (let ((mail-use-rfc822 t))
-	      (rmail-output filename 1 t t))))))
-    ;; Remember the directory name to save articles.
-    (setq gnus-newsgroup-last-mail filename)))
-
-(defun gnus-summary-save-in-file (&optional filename)
-  "Append this article to file.
-Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory'."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((default-name
-	  (funcall gnus-file-save-name gnus-newsgroup-name
-		   gnus-current-headers gnus-newsgroup-last-file)))
-    (setq filename
-	  (cond ((eq filename 'default)
-		 default-name)
-		(filename filename)
-		(t (gnus-read-save-file-name
-		    "Save in file:" default-name))))
-    (gnus-make-directory (file-name-directory filename))
-    (gnus-eval-in-buffer-window gnus-original-article-buffer
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (gnus-output-to-file filename))))
-    ;; Remember the directory name to save articles.
-    (setq gnus-newsgroup-last-file filename)))
-
-(defun gnus-summary-save-body-in-file (&optional filename)
-  "Append this article body to a file.
-Optional argument FILENAME specifies file name.
-The directory to save in defaults to `gnus-article-save-directory'."
-  (interactive)
-  (gnus-set-global-variables)
-  (let ((default-name
-	  (funcall gnus-file-save-name gnus-newsgroup-name
-		   gnus-current-headers gnus-newsgroup-last-file)))
-    (setq filename
-	  (cond ((eq filename 'default)
-		 default-name)
-		(filename filename)
-		(t (gnus-read-save-file-name
-		    "Save body in file:" default-name))))
-    (gnus-make-directory (file-name-directory filename))
-    (gnus-eval-in-buffer-window gnus-original-article-buffer
-      (save-excursion
-	(save-restriction
-	  (widen)
-	  (goto-char (point-min))
-	  (and (search-forward "\n\n" nil t)
-	       (narrow-to-region (point) (point-max)))
-	  (gnus-output-to-file filename))))
-    ;; Remember the directory name to save articles.
-    (setq gnus-newsgroup-last-file filename)))
-
-(defun gnus-summary-save-in-pipe (&optional command)
-  "Pipe this article to subprocess."
-  (interactive)
-  (gnus-set-global-variables)
-  (setq command
-	(cond ((eq command 'default)
-	       gnus-last-shell-command)
-	      (command command)
-	      (t (read-string "Shell command on article: "
-			      gnus-last-shell-command))))
-  (if (string-equal command "")
-      (setq command gnus-last-shell-command))
-  (gnus-eval-in-buffer-window gnus-article-buffer
-    (save-restriction
-      (widen)
-      (shell-command-on-region (point-min) (point-max) command nil)))
-  (setq gnus-last-shell-command command))
-
-;; Summary extract commands
-
-(defun gnus-summary-insert-pseudos (pslist &optional not-view)
-  (let ((buffer-read-only nil)
-	(article (gnus-summary-article-number))
-	after-article b e)
-    (or (gnus-summary-goto-subject article)
-	(error (format "No such article: %d" article)))
-    (gnus-summary-position-point)
-    ;; If all commands are to be bunched up on one line, we collect
-    ;; them here.
-    (if gnus-view-pseudos-separately
-	()
-      (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
-	    files action)
-	(while ps
-	  (setq action (cdr (assq 'action (car ps))))
-	  (setq files (list (cdr (assq 'name (car ps)))))
-	  (while (and ps (cdr ps)
-		      (string= (or action "1")
-			       (or (cdr (assq 'action (cadr ps))) "2")))
-	    (setq files (cons (cdr (assq 'name (cadr ps))) files))
-	    (setcdr ps (cddr ps)))
-	  (if (not files)
-	      ()
-	    (if (not (string-match "%s" action))
-		(setq files (cons " " files)))
-	    (setq files (cons " " files))
-	    (and (assq 'execute (car ps))
-		 (setcdr (assq 'execute (car ps))
-			 (funcall (if (string-match "%s" action)
-				      'format 'concat)
-				  action
-				  (mapconcat (lambda (f) f) files " ")))))
-	  (setq ps (cdr ps)))))
-    (if (and gnus-view-pseudos (not not-view))
-	(while pslist
-	  (and (assq 'execute (car pslist))
-	       (gnus-execute-command (cdr (assq 'execute (car pslist)))
-				     (eq gnus-view-pseudos 'not-confirm)))
-	  (setq pslist (cdr pslist)))
-      (save-excursion
-	(while pslist
-	  (setq after-article (or (cdr (assq 'article (car pslist)))
-				  (gnus-summary-article-number)))
-	  (gnus-summary-goto-subject after-article)
-	  (forward-line 1)
-	  (setq b (point))
-	  (insert "    " (file-name-nondirectory
-				(cdr (assq 'name (car pslist))))
-		  ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
-	  (setq e (point))
-	  (forward-line -1)		; back to `b'
-	  (gnus-add-text-properties
-	   b (1- e) (list 'gnus-number gnus-reffed-article-number
-			  gnus-mouse-face-prop gnus-mouse-face))
-	  (gnus-data-enter
-	   after-article gnus-reffed-article-number
-	   gnus-unread-mark b (car pslist) 0 (- e b))
-	  (push gnus-reffed-article-number gnus-newsgroup-unreads)
-	  (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
-	  (setq pslist (cdr pslist)))))))
-
-(defun gnus-pseudos< (p1 p2)
-  (let ((c1 (cdr (assq 'action p1)))
-	(c2 (cdr (assq 'action p2))))
-    (and c1 c2 (string< c1 c2))))
-
-(defun gnus-request-pseudo-article (props)
-  (cond ((assq 'execute props)
-	 (gnus-execute-command (cdr (assq 'execute props)))))
-  (let ((gnus-current-article (gnus-summary-article-number)))
-    (run-hooks 'gnus-mark-article-hook)))
-
-(defun gnus-execute-command (command &optional automatic)
-  (save-excursion
-    (gnus-article-setup-buffer)
-    (set-buffer gnus-article-buffer)
-    (setq buffer-read-only nil)
-    (let ((command (if automatic command (read-string "Command: " command)))
-	  ;; Just binding this here doesn't help, because there might
-	  ;; be output from the process after exiting the scope of 
-	  ;; this `let'.
-	  ;; (buffer-read-only nil)
-	  )
-      (erase-buffer)
-      (insert "$ " command "\n\n")
-      (if gnus-view-pseudo-asynchronously
-	  (start-process "gnus-execute" nil shell-file-name
-			 shell-command-switch command)
-	(call-process shell-file-name nil t nil
-		      shell-command-switch command)))))
-
-(defun gnus-copy-file (file &optional to)
-  "Copy FILE to TO."
-  (interactive
-   (list (read-file-name "Copy file: " default-directory)
-	 (read-file-name "Copy file to: " default-directory)))
-  (gnus-set-global-variables)
-  (or to (setq to (read-file-name "Copy file to: " default-directory)))
-  (and (file-directory-p to)
-       (setq to (concat (file-name-as-directory to)
-			(file-name-nondirectory file))))
-  (copy-file file to))
-
-;; Summary kill commands.
-
-(defun gnus-summary-edit-global-kill (article)
-  "Edit the \"global\" kill file."
-  (interactive (list (gnus-summary-article-number)))
-  (gnus-set-global-variables)
-  (gnus-group-edit-global-kill article))
-
-(defun gnus-summary-edit-local-kill ()
-  "Edit a local kill file applied to the current newsgroup."
-  (interactive)
-  (gnus-set-global-variables)
-  (setq gnus-current-headers (gnus-summary-article-header))
-  (gnus-set-global-variables)
-  (gnus-group-edit-local-kill
-   (gnus-summary-article-number) gnus-newsgroup-name))
-
-
-;;;
-;;; Gnus article mode
-;;;
-
-(put 'gnus-article-mode 'mode-class 'special)
-
-(if gnus-article-mode-map
-    nil
-  (setq gnus-article-mode-map (make-keymap))
-  (suppress-keymap gnus-article-mode-map)
-
-  (gnus-define-keys gnus-article-mode-map
-    " " gnus-article-goto-next-page
-    "\177" gnus-article-goto-prev-page
-    [delete] gnus-article-goto-prev-page
-    "\C-c^" gnus-article-refer-article
-    "h" gnus-article-show-summary
-    "s" gnus-article-show-summary
-    "\C-c\C-m" gnus-article-mail
-    "?" gnus-article-describe-briefly
-    gnus-mouse-2 gnus-article-push-button
-    "\r" gnus-article-press-button
-    "\t" gnus-article-next-button
-    "\M-\t" gnus-article-prev-button
-    "<" beginning-of-buffer
-    ">" end-of-buffer
-    "\C-c\C-i" gnus-info-find-node
-    "\C-c\C-b" gnus-bug)
-
-  (substitute-key-definition
-   'undefined 'gnus-article-read-summary-keys gnus-article-mode-map))
-
-(defun gnus-article-mode ()
-  "Major mode for displaying an article.
-
-All normal editing commands are switched off.
-
-The following commands are available:
-
-\\<gnus-article-mode-map>
-\\[gnus-article-next-page]\t Scroll the article one page forwards
-\\[gnus-article-prev-page]\t Scroll the article one page backwards
-\\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
-\\[gnus-article-show-summary]\t Display the summary buffer
-\\[gnus-article-mail]\t Send a reply to the address near point
-\\[gnus-article-describe-briefly]\t Describe the current mode briefly
-\\[gnus-info-find-node]\t Go to the Gnus info node"
-  (interactive)
-  (when (and menu-bar-mode
-	     (gnus-visual-p 'article-menu 'menu))
-    (gnus-article-make-menu-bar))
-  (kill-all-local-variables)
-  (gnus-simplify-mode-line)
-  (setq mode-name "Article")
-  (setq major-mode 'gnus-article-mode)
-  (make-local-variable 'minor-mode-alist)
-  (or (assq 'gnus-show-mime minor-mode-alist)
-      (setq minor-mode-alist
-	    (cons (list 'gnus-show-mime " MIME") minor-mode-alist)))
-  (use-local-map gnus-article-mode-map)
-  (make-local-variable 'page-delimiter)
-  (setq page-delimiter gnus-page-delimiter)
-  (buffer-disable-undo (current-buffer))
-  (setq buffer-read-only t)		;Disable modification
-  (run-hooks 'gnus-article-mode-hook))
-
-(defun gnus-article-setup-buffer ()
-  "Initialize the article buffer."
-  (let* ((name (if gnus-single-article-buffer "*Article*"
-		 (concat "*Article " gnus-newsgroup-name "*")))
-	 (original
-	  (progn (string-match "\\*Article" name)
-		 (concat " *Original Article"
-			 (substring name (match-end 0))))))
-    (setq gnus-article-buffer name)
-    (setq gnus-original-article-buffer original)
-    ;; This might be a variable local to the summary buffer.
-    (unless gnus-single-article-buffer
-      (save-excursion
-	(set-buffer gnus-summary-buffer)
-	(setq gnus-article-buffer name)
-	(setq gnus-original-article-buffer original)
-	(gnus-set-global-variables))
-      (make-local-variable 'gnus-summary-buffer))
-    ;; Init original article buffer.
-    (save-excursion
-      (set-buffer (get-buffer-create gnus-original-article-buffer))
-      (buffer-disable-undo (current-buffer))
-      (setq major-mode 'gnus-original-article-mode)
-      (make-local-variable 'gnus-original-article))
-    (if (get-buffer name)
-	(save-excursion
-	  (set-buffer name)
-	  (buffer-disable-undo (current-buffer))
-	  (setq buffer-read-only t)
-	  (gnus-add-current-to-buffer-list)
-	  (or (eq major-mode 'gnus-article-mode)
-	      (gnus-article-mode))
-	  (current-buffer))
-      (save-excursion
-	(set-buffer (get-buffer-create name))
-	(gnus-add-current-to-buffer-list)
-	(gnus-article-mode)
-	(current-buffer)))))
-
-;; Set article window start at LINE, where LINE is the number of lines
-;; from the head of the article.
-(defun gnus-article-set-window-start (&optional line)
-  (set-window-start
-   (get-buffer-window gnus-article-buffer t)
-   (save-excursion
-     (set-buffer gnus-article-buffer)
-     (goto-char (point-min))
-     (if (not line)
-	 (point-min)
-       (gnus-message 6 "Moved to bookmark")
-       (search-forward "\n\n" nil t)
-       (forward-line line)
-       (point)))))
-
-(defun gnus-kill-all-overlays ()
-  "Delete all overlays in the current buffer."
-  (when (fboundp 'overlay-lists)
-    (let* ((overlayss (overlay-lists))
-	   (buffer-read-only nil)
-	   (overlays (nconc (car overlayss) (cdr overlayss))))
-      (while overlays
-	(delete-overlay (pop overlays))))))
-
-(defun gnus-request-article-this-buffer (article group)
-  "Get an article and insert it into this buffer."
-  (let (do-update-line)
-    (prog1
-	(save-excursion
-	  (erase-buffer)
-	  (gnus-kill-all-overlays)
-	  (setq group (or group gnus-newsgroup-name))
-
-	  ;; Open server if it has closed.
-	  (gnus-check-server (gnus-find-method-for-group group))
-
-	  ;; Using `gnus-request-article' directly will insert the article into
-	  ;; `nntp-server-buffer' - so we'll save some time by not having to
-	  ;; copy it from the server buffer into the article buffer.
-
-	  ;; We only request an article by message-id when we do not have the
-	  ;; headers for it, so we'll have to get those.
-	  (when (stringp article)
-	    (let ((gnus-override-method gnus-refer-article-method))
-	      (gnus-read-header article)))
-
-	  ;; If the article number is negative, that means that this article
-	  ;; doesn't belong in this newsgroup (possibly), so we find its
-	  ;; message-id and request it by id instead of number.
-	  (when (and (numberp article)
-		     gnus-summary-buffer
-		     (get-buffer gnus-summary-buffer)
-		     (buffer-name (get-buffer gnus-summary-buffer)))
-	    (save-excursion
-	      (set-buffer gnus-summary-buffer)
-	      (let ((header (gnus-summary-article-header article)))
-		(if (< article 0)
-		    (cond 
-		     ((memq article gnus-newsgroup-sparse)
-		      ;; This is a sparse gap article.
-		      (setq do-update-line article)
-		      (setq article (mail-header-id header))
-		      (let ((gnus-override-method gnus-refer-article-method))
-			(gnus-read-header article))
-		      (setq gnus-newsgroup-sparse
-			    (delq article gnus-newsgroup-sparse)))
-		     ((vectorp header)
-		      ;; It's a real article.
-		      (setq article (mail-header-id header)))
-		     (t
-		      ;; It is an extracted pseudo-article.
-		      (setq article 'pseudo)
-		      (gnus-request-pseudo-article header))))
-		
-		(let ((method (gnus-find-method-for-group 
-			       gnus-newsgroup-name)))
-		  (if (not (eq (car method) 'nneething))
-		      ()
-		    (let ((dir (concat (file-name-as-directory (nth 1 method))
-				       (mail-header-subject header))))
-		      (if (file-directory-p dir)
-			  (progn
-			    (setq article 'nneething)
-			    (gnus-group-enter-directory dir)))))))))
-
-	  (cond
-	   ;; Refuse to select canceled articles.
-	   ((and (numberp article)
-		 gnus-summary-buffer
-		 (get-buffer gnus-summary-buffer)
-		 (buffer-name (get-buffer gnus-summary-buffer))
-		 (eq (cdr (save-excursion
-			    (set-buffer gnus-summary-buffer)
-			    (assq article gnus-newsgroup-reads)))
-		     gnus-canceled-mark))
-	    nil)
-	   ;; We first check `gnus-original-article-buffer'.
-	   ((and (get-buffer gnus-original-article-buffer)
-		 (numberp article)
-		 (save-excursion
-		   (set-buffer gnus-original-article-buffer)
-		   (and (equal (car gnus-original-article) group)
-			(eq (cdr gnus-original-article) article))))
-	    (insert-buffer-substring gnus-original-article-buffer)
-	    'article)
-	   ;; Check the backlog.
-	   ((and gnus-keep-backlog
-		 (gnus-backlog-request-article group article (current-buffer)))
-	    'article)
-	   ;; Check the cache.
-	   ((and gnus-use-cache
-		 (numberp article)
-		 (gnus-cache-request-article article group))
-	    'article)
-	   ;; Get the article and put into the article buffer.
-	   ((or (stringp article) (numberp article))
-	    (let ((gnus-override-method
-		   (and (stringp article) gnus-refer-article-method))
-		  (buffer-read-only nil))
-	      (erase-buffer)
-	      (gnus-kill-all-overlays)
-	      (if (gnus-request-article article group (current-buffer))
-		  (progn
-		    (and gnus-keep-backlog
-			 (numberp article)
-			 (gnus-backlog-enter-article
-			  group article (current-buffer)))
-		    'article))))
-	   ;; It was a pseudo.
-	   (t article)))
-
-      ;; Take the article from the original article buffer
-      ;; and place it in the buffer it's supposed to be in.
-      (when (and (get-buffer gnus-article-buffer)
-		 ;;(numberp article)
-		 (equal (buffer-name (current-buffer))
-			(buffer-name (get-buffer gnus-article-buffer))))
-	(save-excursion
-	  (if (get-buffer gnus-original-article-buffer)
-	      (set-buffer (get-buffer gnus-original-article-buffer))
-	    (set-buffer (get-buffer-create gnus-original-article-buffer))
-	    (buffer-disable-undo (current-buffer))
-	    (setq major-mode 'gnus-original-article-mode)
-	    (setq buffer-read-only t)
-	    (gnus-add-current-to-buffer-list))
-	  (let (buffer-read-only)
-	    (erase-buffer)
-	    (insert-buffer-substring gnus-article-buffer))
-	  (setq gnus-original-article (cons group article))))
-    
-      ;; Update sparse articles.
-      (when (and do-update-line
-		 (or (numberp article)
-		     (stringp article)))
-	(let ((buf (current-buffer)))
-	  (set-buffer gnus-summary-buffer)
-	  (gnus-summary-update-article do-update-line)
-	  (gnus-summary-goto-subject do-update-line nil t)
-	  (set-window-point (get-buffer-window (current-buffer) t)
-			    (point))
-	  (set-buffer buf))))))
-
-(defun gnus-read-header (id &optional header)
-  "Read the headers of article ID and enter them into the Gnus system."
-  (let ((group gnus-newsgroup-name)
-	(gnus-override-method 
-	 (and (gnus-news-group-p gnus-newsgroup-name)
-	      gnus-refer-article-method))	
-	where)
-    ;; First we check to see whether the header in question is already
-    ;; fetched.
-    (if (stringp id)
-	;; This is a Message-ID.
-	(setq header (or header (gnus-id-to-header id)))
-      ;; This is an article number.
-      (setq header (or header (gnus-summary-article-header id))))
-    (if (and header
-	     (not (memq (mail-header-number header) gnus-newsgroup-sparse)))
-	;; We have found the header.
-	header
-      ;; We have to really fetch the header to this article.
-      (when (setq where (gnus-request-head id group))
-	(save-excursion
-	  (set-buffer nntp-server-buffer)
-	  (goto-char (point-max))
-	  (insert ".\n")
-	  (goto-char (point-min))
-	  (insert "211 ")
-	  (princ (cond
-		  ((numberp id) id)
-		  ((cdr where) (cdr where))
-		  (header (mail-header-number header))
-		  (t gnus-reffed-article-number))
-		 (current-buffer))
-	  (insert " Article retrieved.\n"))
-	;(when (and header
-	;	   (memq (mail-header-number header) gnus-newsgroup-sparse))
-	;  (setcar (gnus-id-to-thread id) nil))
-	(if (not (setq header (car (gnus-get-newsgroup-headers))))
-	    ()				; Malformed head.
-	  (unless (memq (mail-header-number header) gnus-newsgroup-sparse)
-	    (if (and (stringp id)
-		     (not (string= (gnus-group-real-name group)
-				   (car where))))
-		;; If we fetched by Message-ID and the article came
-		;; from a different group, we fudge some bogus article
-		;; numbers for this article.
-		(mail-header-set-number header gnus-reffed-article-number))
-	    (decf gnus-reffed-article-number)
-	    (gnus-remove-header (mail-header-number header))
-	    (push header gnus-newsgroup-headers)
-	    (setq gnus-current-headers header)
-	    (push (mail-header-number header) gnus-newsgroup-limit))
-	  header)))))
-
-(defun gnus-remove-header (number)
-  "Remove header NUMBER from `gnus-newsgroup-headers'."
-  (if (and gnus-newsgroup-headers
-	   (= number (mail-header-number (car gnus-newsgroup-headers))))
-      (pop gnus-newsgroup-headers)
-    (let ((headers gnus-newsgroup-headers))
-      (while (and (cdr headers)
-		  (not (= number (mail-header-number (cadr headers)))))
-	(pop headers))
-      (when (cdr headers)
-	(setcdr headers (cddr headers))))))
-
-(defun gnus-article-prepare (article &optional all-headers header)
-  "Prepare ARTICLE in article mode buffer.
-ARTICLE should either be an article number or a Message-ID.
-If ARTICLE is an id, HEADER should be the article headers.
-If ALL-HEADERS is non-nil, no headers are hidden."
-  (save-excursion
-    ;; Make sure we start in a summary buffer.
-    (unless (eq major-mode 'gnus-summary-mode)
-      (set-buffer gnus-summary-buffer))
-    (setq gnus-summary-buffer (current-buffer))
-    ;; Make sure the connection to the server is alive.
-    (unless (gnus-server-opened
-	     (gnus-find-method-for-group gnus-newsgroup-name))
-      (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
-      (gnus-request-group gnus-newsgroup-name t))
-    (let* ((article (if header (mail-header-number header) article))
-	   (summary-buffer (current-buffer))
-	   (internal-hook gnus-article-internal-prepare-hook)
-	   (group gnus-newsgroup-name)
-	   result)
-      (save-excursion
-	(gnus-article-setup-buffer)
-	(set-buffer gnus-article-buffer)
-	;; Deactivate active regions.
-	(when (and (boundp 'transient-mark-mode)
-		   transient-mark-mode)
-	  (setq mark-active nil))
-	(if (not (setq result (let ((buffer-read-only nil))
-				(gnus-request-article-this-buffer
-				 article group))))
-	    ;; There is no such article.
-	    (save-excursion
-	      (when (and (numberp article)
-			 (not (memq article gnus-newsgroup-sparse)))
-		(setq gnus-article-current
-		      (cons gnus-newsgroup-name article))
-		(set-buffer gnus-summary-buffer)
-		(setq gnus-current-article article)
-		(gnus-summary-mark-article article gnus-canceled-mark))
-	      (unless (memq article gnus-newsgroup-sparse)
-		(gnus-error
-		 1 "No such article (may have expired or been canceled)")))
-	  (if (or (eq result 'pseudo) (eq result 'nneething))
-	      (progn
-		(save-excursion
-		  (set-buffer summary-buffer)
-		  (setq gnus-last-article gnus-current-article
-			gnus-newsgroup-history (cons gnus-current-article
-						     gnus-newsgroup-history)
-			gnus-current-article 0
-			gnus-current-headers nil
-			gnus-article-current nil)
-		  (if (eq result 'nneething)
-		      (gnus-configure-windows 'summary)
-		    (gnus-configure-windows 'article))
-		  (gnus-set-global-variables))
-		(gnus-set-mode-line 'article))
-	    ;; The result from the `request' was an actual article -
-	    ;; or at least some text that is now displayed in the
-	    ;; article buffer.
-	    (if (and (numberp article)
-		     (not (eq article gnus-current-article)))
-		;; Seems like a new article has been selected.
-		;; `gnus-current-article' must be an article number.
-		(save-excursion
-		  (set-buffer summary-buffer)
-		  (setq gnus-last-article gnus-current-article
-			gnus-newsgroup-history (cons gnus-current-article
-						     gnus-newsgroup-history)
-			gnus-current-article article
-			gnus-current-headers
-			(gnus-summary-article-header gnus-current-article)
-			gnus-article-current
-			(cons gnus-newsgroup-name gnus-current-article))
-		  (unless (vectorp gnus-current-headers)
-		    (setq gnus-current-headers nil))
-		  (gnus-summary-show-thread)
-		  (run-hooks 'gnus-mark-article-hook)
-		  (gnus-set-mode-line 'summary)
-		  (and (gnus-visual-p 'article-highlight 'highlight)
-		       (run-hooks 'gnus-visual-mark-article-hook))
-		  ;; Set the global newsgroup variables here.
-		  ;; Suggested by Jim Sisolak
-		  ;; <sisolak@trans4.neep.wisc.edu>.
-		  (gnus-set-global-variables)
-		  (setq gnus-have-all-headers
-			(or all-headers gnus-show-all-headers))
-		  (and gnus-use-cache
-		       (vectorp (gnus-summary-article-header article))
-		       (gnus-cache-possibly-enter-article
-			group article
-			(gnus-summary-article-header article)
-			(memq article gnus-newsgroup-marked)
-			(memq article gnus-newsgroup-dormant)
-			(memq article gnus-newsgroup-unreads)))))
-	    (when (or (numberp article)
-		      (stringp article))
-	      ;; Hooks for getting information from the article.
-	      ;; This hook must be called before being narrowed.
-	      (let (buffer-read-only)
-		(run-hooks 'internal-hook)
-		(run-hooks 'gnus-article-prepare-hook)
-		;; Decode MIME message.
-		(if gnus-show-mime
-		    (if (or (not gnus-strict-mime)
-			    (gnus-fetch-field "Mime-Version"))
-			(funcall gnus-show-mime-method)
-		      (funcall gnus-decode-encoded-word-method)))
-		;; Perform the article display hooks.
-		(run-hooks 'gnus-article-display-hook))
-	      ;; Do page break.
-	      (goto-char (point-min))
-	      (and gnus-break-pages (gnus-narrow-to-page)))
-	    (gnus-set-mode-line 'article)
-	    (gnus-configure-windows 'article)
-	    (goto-char (point-min))
-	    t))))))
-
-(defun gnus-article-show-all-headers ()
-  "Show all article headers in article mode buffer."
-  (save-excursion
-    (gnus-article-setup-buffer)
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil))
-      (gnus-unhide-text (point-min) (point-max)))))
-
-(defun gnus-article-hide-headers-if-wanted ()
-  "Hide unwanted headers if `gnus-have-all-headers' is nil.
-Provided for backwards compatibility."
-  (or (save-excursion (set-buffer gnus-summary-buffer) gnus-have-all-headers)
-      gnus-inhibit-hiding
-      (gnus-article-hide-headers)))
-
-(defsubst gnus-article-header-rank ()
-  "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
-  (let ((list gnus-sorted-header-list)
-	(i 0))
-    (while list
-      (when (looking-at (car list))
-	(setq list nil))
-      (setq list (cdr list))
-      (incf i))
-    i))
-
-(defun gnus-article-hide-headers (&optional arg delete)
-  "Toggle whether to hide unwanted headers and possibly sort them as well.
-If given a negative prefix, always show; if given a positive prefix,
-always hide."
-  (interactive (gnus-hidden-arg))
-  (if (gnus-article-check-hidden-text 'headers arg)
-      ;; Show boring headers as well.
-      (gnus-article-show-hidden-text 'boring-headers)
-    ;; This function might be inhibited.
-    (unless gnus-inhibit-hiding
-      (save-excursion
-	(set-buffer gnus-article-buffer)
-	(save-restriction
-	  (let ((buffer-read-only nil)
-		(props (nconc (list 'gnus-type 'headers)
-			      gnus-hidden-properties))
-		(max (1+ (length gnus-sorted-header-list)))
-		(ignored (when (not (stringp gnus-visible-headers))
-			   (cond ((stringp gnus-ignored-headers)
-				  gnus-ignored-headers)
-				 ((listp gnus-ignored-headers)
-				  (mapconcat 'identity gnus-ignored-headers
-					     "\\|")))))
-		(visible
-		 (cond ((stringp gnus-visible-headers)
-			gnus-visible-headers)
-		       ((and gnus-visible-headers
-			     (listp gnus-visible-headers))
-			(mapconcat 'identity gnus-visible-headers "\\|"))))
-		(inhibit-point-motion-hooks t)
-		want-list beg)
-	    ;; First we narrow to just the headers.
-	    (widen)
-	    (goto-char (point-min))
-	    ;; Hide any "From " lines at the beginning of (mail) articles.
-	    (while (looking-at "From ")
-	      (forward-line 1))
-	    (unless (bobp)
-	      (if delete
-		  (delete-region (point-min) (point))
-		(gnus-hide-text (point-min) (point) props)))
-	    ;; Then treat the rest of the header lines.
-	    (narrow-to-region
-	     (point)
-	     (progn (search-forward "\n\n" nil t) (forward-line -1) (point)))
-	    ;; Then we use the two regular expressions
-	    ;; `gnus-ignored-headers' and `gnus-visible-headers' to
-	    ;; select which header lines is to remain visible in the
-	    ;; article buffer.
-	    (goto-char (point-min))
-	    (while (re-search-forward "^[^ \t]*:" nil t)
-	      (beginning-of-line)
-	      ;; We add the headers we want to keep to a list and delete
-	      ;; them from the buffer.
-	      (gnus-put-text-property 
-	       (point) (1+ (point)) 'message-rank
-	       (if (or (and visible (looking-at visible))
-		       (and ignored
-			    (not (looking-at ignored))))
-		   (gnus-article-header-rank) 
-		 (+ 2 max)))
-	      (forward-line 1))
-	    (message-sort-headers-1)
-	    (when (setq beg (text-property-any 
-			     (point-min) (point-max) 'message-rank (+ 2 max)))
-	      ;; We make the unwanted headers invisible.
-	      (if delete
-		  (delete-region beg (point-max))
-		;; Suggested by Sudish Joseph <joseph@cis.ohio-state.edu>.
-		(gnus-hide-text-type beg (point-max) 'headers))
-	      ;; Work around XEmacs lossage.
-	      (gnus-put-text-property (point-min) beg 'invisible nil))))))))
-
-(defun gnus-article-hide-boring-headers (&optional arg)
-  "Toggle hiding of headers that aren't very interesting.
-If given a negative prefix, always show; if given a positive prefix,
-always hide."
-  (interactive (gnus-hidden-arg))
-  (unless (gnus-article-check-hidden-text 'boring-headers arg)
-    (save-excursion
-      (set-buffer gnus-article-buffer)
-      (save-restriction
-	(let ((buffer-read-only nil)
-	      (list gnus-boring-article-headers)
-	      (inhibit-point-motion-hooks t)
-	      elem)
-	  (nnheader-narrow-to-headers)
-	  (while list
-	    (setq elem (pop list))
-	    (goto-char (point-min))
-	    (cond
-	     ;; Hide empty headers.
-	     ((eq elem 'empty)
-	      (while (re-search-forward "^[^:]+:[ \t]\n[^ \t]" nil t)
-		(forward-line -1)
-		(gnus-hide-text-type
-		 (progn (beginning-of-line) (point))
-		 (progn 
-		   (end-of-line)
-		   (if (re-search-forward "^[^ \t]" nil t)
-		       (match-beginning 0)
-		     (point-max)))
-		 'boring-headers)))
-	     ;; Hide boring Newsgroups header.
-	     ((eq elem 'newsgroups)
-	      (when (equal (message-fetch-field "newsgroups")
-			   (gnus-group-real-name gnus-newsgroup-name))
-		(gnus-article-hide-header "newsgroups")))
-	     ((eq elem 'followup-to)
-	      (when (equal (message-fetch-field "followup-to")
-			   (message-fetch-field "newsgroups"))
-		(gnus-article-hide-header "followup-to")))
-	     ((eq elem 'reply-to)
-	      (let ((from (message-fetch-field "from"))
-		    (reply-to (message-fetch-field "reply-to")))
-		(when (and
-		       from reply-to
-		       (equal 
-			(nth 1 (funcall gnus-extract-address-components from))
-			(nth 1 (funcall gnus-extract-address-components
-					reply-to))))
-		  (gnus-article-hide-header "reply-to"))))
-	     ((eq elem 'date)
-	      (let ((date (message-fetch-field "date")))
-		(when (and date
-			   (< (gnus-days-between date (current-time-string))
-			      4))
-		  (gnus-article-hide-header "date")))))))))))
-
-(defun gnus-article-hide-header (header)
-  (save-excursion
-    (goto-char (point-min))
-    (when (re-search-forward (concat "^" header ":") nil t)
-      (gnus-hide-text-type
-       (progn (beginning-of-line) (point))
-       (progn 
-	 (end-of-line)
-	 (if (re-search-forward "^[^ \t]" nil t)
-	     (match-beginning 0)
-	   (point-max)))
-       'boring-headers))))
-
-;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-article-treat-overstrike ()
-  "Translate overstrikes into bold text."
-  (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil))
-      (while (search-forward "\b" nil t)
-	(let ((next (following-char))
-	      (previous (char-after (- (point) 2))))
-	  (cond 
-	   ((eq next previous)
-	    (gnus-put-text-property (- (point) 2) (point) 'invisible t)
-	    (gnus-put-text-property (point) (1+ (point)) 'face 'bold))
-	   ((eq next ?_)
-	    (gnus-put-text-property (1- (point)) (1+ (point)) 'invisible t)
-	    (gnus-put-text-property
-	     (- (point) 2) (1- (point)) 'face 'underline))
-	   ((eq previous ?_)
-	    (gnus-put-text-property (- (point) 2) (point) 'invisible t)
-	    (gnus-put-text-property
-	     (point) (1+ (point))	'face 'underline))))))))
-
-(defun gnus-article-word-wrap ()
-  "Format too long lines."
-  (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil))
-      (widen)
-      (goto-char (point-min))
-      (search-forward "\n\n" nil t)
-      (end-of-line 1)
-      (let ((paragraph-start "^[>|#:<;* ]*[ \t]*$")
-	    (adaptive-fill-regexp "[ \t]*\\([|#:<;>*]+ *\\)?")
-	    (adaptive-fill-mode t))
-	(while (not (eobp))
-	  (and (>= (current-column) (min fill-column (window-width)))
-	       (/= (preceding-char) ?:)
-	       (fill-paragraph nil))
-	  (end-of-line 2))))))
-
-(defun gnus-article-remove-cr ()
-  "Remove carriage returns from an article."
-  (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil))
-      (goto-char (point-min))
-      (while (search-forward "\r" nil t)
-	(replace-match "" t t)))))
-
-(defun gnus-article-remove-trailing-blank-lines ()
-  "Remove all trailing blank lines from the article."
-  (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil))
-      (goto-char (point-max))
-      (delete-region
-       (point)
-       (progn
-	 (while (looking-at "^[ \t]*$")
-	   (forward-line -1))
-	 (forward-line 1)
-	 (point))))))
-
-(defun gnus-article-display-x-face (&optional force)
-  "Look for an X-Face header and display it if present."
-  (interactive (list 'force))
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    ;; Delete the old process, if any.
-    (when (process-status "gnus-x-face")
-      (delete-process "gnus-x-face"))
-    (let ((inhibit-point-motion-hooks t)
-	  (case-fold-search nil)
-	  from)
-      (save-restriction
-	(nnheader-narrow-to-headers)
-	(setq from (message-fetch-field "from"))
-	(goto-char (point-min))
-	(when (and gnus-article-x-face-command
-		   (or force
-		       ;; Check whether this face is censored.
-		       (not gnus-article-x-face-too-ugly)
-		       (and gnus-article-x-face-too-ugly from
-			    (not (string-match gnus-article-x-face-too-ugly
-					       from))))
-		   ;; Has to be present.
-		   (re-search-forward "^X-Face: " nil t))
-	  ;; We now have the area of the buffer where the X-Face is stored.
-	  (let ((beg (point))
-		(end (1- (re-search-forward "^\\($\\|[^ \t]\\)" nil t))))
-	    ;; We display the face.
-	    (if (symbolp gnus-article-x-face-command)
-		;; The command is a lisp function, so we call it.
-		(if (gnus-functionp gnus-article-x-face-command)
-		    (funcall gnus-article-x-face-command beg end)
-		  (error "%s is not a function" gnus-article-x-face-command))
-	      ;; The command is a string, so we interpret the command
-	      ;; as a, well, command, and fork it off.
-	      (let ((process-connection-type nil))
-		(process-kill-without-query
-		 (start-process
-		  "gnus-x-face" nil shell-file-name shell-command-switch
-		  gnus-article-x-face-command))
-		(process-send-region "gnus-x-face" beg end)
-		(process-send-eof "gnus-x-face")))))))))
-
-(defalias 'gnus-headers-decode-quoted-printable 'gnus-decode-rfc1522)
-(defun gnus-decode-rfc1522 ()
-  "Hack to remove QP encoding from headers."
-  (let ((case-fold-search t)
-	(inhibit-point-motion-hooks t)
-	(buffer-read-only nil)
-	string)
-    (save-restriction
-      (narrow-to-region
-       (goto-char (point-min))
-       (or (search-forward "\n\n" nil t) (point-max)))
-
-      (goto-char (point-min))
-      (while (re-search-forward 
-	      "=\\?iso-8859-1\\?q\\?\\([^?\t\n]*\\)\\?=" nil t)
-	(setq string (match-string 1))
-	(narrow-to-region (match-beginning 0) (match-end 0))
-	(delete-region (point-min) (point-max))
-	(insert string)
-	(gnus-mime-decode-quoted-printable (goto-char (point-min)) (point-max))
-	(subst-char-in-region (point-min) (point-max) ?_ ? )
-	(widen)
-	(goto-char (point-min))))))
-
-(defun gnus-article-de-quoted-unreadable (&optional force)
-  "Do a naive translation of a quoted-printable-encoded article.
-This is in no way, shape or form meant as a replacement for real MIME
-processing, but is simply a stop-gap measure until MIME support is
-written.
-If FORCE, decode the article whether it is marked as quoted-printable
-or not."
-  (interactive (list 'force))
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((case-fold-search t)
-	  (buffer-read-only nil)
-	  (type (gnus-fetch-field "content-transfer-encoding")))
-      (gnus-decode-rfc1522)
-      (when (or force
-		(and type (string-match "quoted-printable" (downcase type))))
-	(goto-char (point-min))
-	(search-forward "\n\n" nil 'move)
-	(gnus-mime-decode-quoted-printable (point) (point-max))))))
-
-(defun gnus-mime-decode-quoted-printable (from to)
-  "Decode Quoted-Printable in the region between FROM and TO."
-  (interactive "r")
-  (goto-char from)
-  (while (search-forward "=" to t)
-    (cond ((eq (following-char) ?\n)
-	   (delete-char -1)
-	   (delete-char 1))
-	  ((looking-at "[0-9A-F][0-9A-F]")
-	   (subst-char-in-region
-	    (1- (point)) (point) ?=
-	    (hexl-hex-string-to-integer
-	     (buffer-substring (point) (+ 2 (point)))))
-	   (delete-char 2))
-	  ((looking-at "=")
-	   (delete-char 1))
-	  ((gnus-message 3 "Malformed MIME quoted-printable message")))))
-
-(defun gnus-article-hide-pgp (&optional arg)
-  "Toggle hiding of any PGP headers and signatures in the current article.
-If given a negative prefix, always show; if given a positive prefix,
-always hide."
-  (interactive (gnus-hidden-arg))
-  (unless (gnus-article-check-hidden-text 'pgp arg)
-    (save-excursion
-      (set-buffer gnus-article-buffer)
-      (let ((props (nconc (list 'gnus-type 'pgp) gnus-hidden-properties))
-	    buffer-read-only beg end)
-	(widen)
-	(goto-char (point-min))
-	;; Hide the "header".
-	(and (search-forward "\n-----BEGIN PGP SIGNED MESSAGE-----\n" nil t)
-	     (gnus-hide-text (match-beginning 0) (match-end 0) props))
-	(setq beg (point))
-	;; Hide the actual signature.
-	(and (search-forward "\n-----BEGIN PGP SIGNATURE-----\n" nil t)
-	     (setq end (1+ (match-beginning 0)))
-	     (gnus-hide-text
-	      end
-	      (if (search-forward "\n-----END PGP SIGNATURE-----\n" nil t)
-		  (match-end 0)
-		;; Perhaps we shouldn't hide to the end of the buffer
-		;; if there is no end to the signature?
-		(point-max))
-	      props))
-	;; Hide "- " PGP quotation markers.
-	(when (and beg end)
-	  (narrow-to-region beg end)
-	  (goto-char (point-min))
-	  (while (re-search-forward "^- " nil t)
-	    (gnus-hide-text (match-beginning 0) (match-end 0) props))
-	  (widen))))))
-
-(defun gnus-article-hide-signature (&optional arg)
-  "Hide the signature in the current article.
-If given a negative prefix, always show; if given a positive prefix,
-always hide."
-  (interactive (gnus-hidden-arg))
-  (unless (gnus-article-check-hidden-text 'signature arg)
-    (save-excursion
-      (set-buffer gnus-article-buffer)
-      (save-restriction
-	(let ((buffer-read-only nil))
-	  (when (gnus-narrow-to-signature)
-	    (gnus-hide-text-type (point-min) (point-max) 'signature)))))))
-
-(defun gnus-article-strip-leading-blank-lines ()
-  "Remove all blank lines from the beginning of the article."
-  (interactive)
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let (buffer-read-only)
-      (goto-char (point-min))
-      (when (search-forward "\n\n" nil t)
-	(while (looking-at "[ \t]$")
-	  (gnus-delete-line))))))
-
-(defvar mime::preview/content-list)
-(defvar mime::preview-content-info/point-min)
-(defun gnus-narrow-to-signature ()
-  "Narrow to the signature."
-  (widen)
-  (if (and (boundp 'mime::preview/content-list)
-	   mime::preview/content-list)
-      (let ((pcinfo (car (last mime::preview/content-list))))
-	(condition-case ()
-	    (narrow-to-region
-	     (funcall (intern "mime::preview-content-info/point-min") pcinfo)
-	     (point-max))
-	  (error nil))))
-  (goto-char (point-max))
-  (when (re-search-backward gnus-signature-separator nil t)
-    (forward-line 1)
-    (when (or (null gnus-signature-limit)
-	      (and (numberp gnus-signature-limit)
-		   (< (- (point-max) (point)) gnus-signature-limit))
-	      (and (gnus-functionp gnus-signature-limit)
-		   (funcall gnus-signature-limit))
-	      (and (stringp gnus-signature-limit)
-		   (not (re-search-forward gnus-signature-limit nil t))))
-      (narrow-to-region (point) (point-max))
-      t)))
-
-(defun gnus-hidden-arg ()
-  "Return the current prefix arg as a number, or 0 if no prefix."
-  (list (if current-prefix-arg
-	    (prefix-numeric-value current-prefix-arg)
-	  0)))
-
-(defun gnus-article-check-hidden-text (type arg)
-  "Return nil if hiding is necessary.
-Arg can be nil or a number.  Nil and positive means hide, negative
-means show, 0 means toggle."
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((hide (gnus-article-hidden-text-p type)))
-      (cond
-       ((or (null arg)
-	    (> arg 0))
-	nil)
-       ((< arg 0)
-	(gnus-article-show-hidden-text type))
-       (t
-	(if (eq hide 'hidden)
-	    (gnus-article-show-hidden-text type)
-	  nil))))))
-
-(defun gnus-article-hidden-text-p (type)
-  "Say whether the current buffer contains hidden text of type TYPE."
-  (let ((pos (text-property-any (point-min) (point-max) 'gnus-type type)))
-    (when pos
-      (if (get-text-property pos 'invisible)
-	  'hidden
-	'shown))))
-
-(defun gnus-article-hide (&optional arg force)
-  "Hide all the gruft in the current article.
-This means that PGP stuff, signatures, cited text and (some)
-headers will be hidden.
-If given a prefix, show the hidden text instead."
-  (interactive (list current-prefix-arg 'force))
-  (gnus-article-hide-headers arg)
-  (gnus-article-hide-pgp arg)
-  (gnus-article-hide-citation-maybe arg force)
-  (gnus-article-hide-signature arg))
-
-(defun gnus-article-show-hidden-text (type &optional hide)
-  "Show all hidden text of type TYPE.
-If HIDE, hide the text instead."
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (let ((buffer-read-only nil)
-	  (inhibit-point-motion-hooks t)
-	  (beg (point-min)))
-      (while (gnus-goto-char (text-property-any
-			      beg (point-max) 'gnus-type type))
-	(setq beg (point))
-	(forward-char)
-	(if hide
-	    (gnus-hide-text beg (point) gnus-hidden-properties)
-	  (gnus-unhide-text beg (point)))
-	(setq beg (point)))
-      t)))
-
-(defvar gnus-article-time-units
-  `((year . ,(* 365.25 24 60 60))
-    (week . ,(* 7 24 60 60))
-    (day . ,(* 24 60 60))
-    (hour . ,(* 60 60))
-    (minute . 60)
-    (second . 1))
-  "Mapping from time units to seconds.")
-
-(defun gnus-article-date-ut (&optional type highlight)
-  "Convert DATE date to universal time in the current article.
-If TYPE is `local', convert to local time; if it is `lapsed', output
-how much time has lapsed since DATE."
-  (interactive (list 'ut t))
-  (let* ((header (or gnus-current-headers
-		     (gnus-summary-article-header) ""))
-	 (date (and (vectorp header) (mail-header-date header)))
-	 (date-regexp "^Date: \\|^X-Sent: ")
-	 (now (current-time))
-	 (inhibit-point-motion-hooks t)
-	 bface eface)
-    (when (and date (not (string= date "")))
-      (save-excursion
-	(set-buffer gnus-article-buffer)
-	(save-restriction
-	  (nnheader-narrow-to-headers)
-	  (let ((buffer-read-only nil))
-	    ;; Delete any old Date headers.
-	    (if (re-search-forward date-regexp nil t)
-		(progn
-		  (setq bface (get-text-property (gnus-point-at-bol) 'face)
-			eface (get-text-property (1- (gnus-point-at-eol))
-						 'face))
-		  (message-remove-header date-regexp t)
-		  (beginning-of-line))
-	      (goto-char (point-max)))
-	    (insert (gnus-make-date-line date type))
-	    ;; Do highlighting.
-	    (forward-line -1)
-	    (when (and (gnus-visual-p 'article-highlight 'highlight)
-		       (looking-at "\\([^:]+\\): *\\(.*\\)$"))
-	      (gnus-put-text-property (match-beginning 1) (match-end 1)
-				 'face bface)
-	      (gnus-put-text-property (match-beginning 2) (match-end 2)
-				 'face eface))))))))
-
-(defun gnus-make-date-line (date type)
-  "Return a DATE line of TYPE."
-  (cond
-   ;; Convert to the local timezone.  We have to slap a
-   ;; `condition-case' round the calls to the timezone
-   ;; functions since they aren't particularly resistant to
-   ;; buggy dates.
-   ((eq type 'local)
-    (concat "Date: " (condition-case ()
-			 (timezone-make-date-arpa-standard date)
-		       (error date))
-	    "\n"))
-   ;; Convert to Universal Time.
-   ((eq type 'ut)
-    (concat "Date: "
-	    (condition-case ()
-		(timezone-make-date-arpa-standard date nil "UT")
-	      (error date))
-	    "\n"))
-   ;; Get the original date from the article.
-   ((eq type 'original)
-    (concat "Date: " date "\n"))
-   ;; Do an X-Sent lapsed format.
-   ((eq type 'lapsed)
-    ;; If the date is seriously mangled, the timezone
-    ;; functions are liable to bug out, so we condition-case
-    ;; the entire thing.
-    (let* ((now (current-time))
-	   (real-time
-	    (condition-case ()
-		(gnus-time-minus
-		 (gnus-encode-date
-		  (timezone-make-date-arpa-standard
-		   (current-time-string now)
-		   (current-time-zone now) "UT"))
-		 (gnus-encode-date
-		  (timezone-make-date-arpa-standard
-		   date nil "UT")))
-	      (error '(0 0))))
-	   (real-sec (+ (* (float (car real-time)) 65536)
-			(cadr real-time)))
-	   (sec (abs real-sec))
-	   num prev)
-      (cond
-       ((equal real-time '(0 0))
-	"X-Sent: Unknown\n")
-       ((zerop sec)
-	"X-Sent: Now\n")
-       (t
-	(concat
-	 "X-Sent: "
-	 ;; This is a bit convoluted, but basically we go
-	 ;; through the time units for years, weeks, etc,
-	 ;; and divide things to see whether that results
-	 ;; in positive answers.
-	 (mapconcat
-	  (lambda (unit)
-	    (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
-		;; The (remaining) seconds are too few to
-		;; be divided into this time unit.
-		""
-	      ;; It's big enough, so we output it.
-	      (setq sec (- sec (* num (cdr unit))))
-	      (prog1
-		  (concat (if prev ", " "") (int-to-string
-					     (floor num))
-			  " " (symbol-name (car unit)) 
-			  (if (> num 1) "s" ""))
-		(setq prev t))))
-	  gnus-article-time-units "")
-	 ;; If dates are odd, then it might appear like the
-	 ;; article was sent in the future.
-	 (if (> real-sec 0)
-	     " ago\n"
-	   " in the future\n"))))))
-   (t
-    (error "Unknown conversion type: %s" type))))
-
-(defun gnus-article-date-local (&optional highlight)
-  "Convert the current article date to the local timezone."
-  (interactive (list t))
-  (gnus-article-date-ut 'local highlight))
-
-(defun gnus-article-date-original (&optional highlight)
-  "Convert the current article date to what it was originally.
-This is only useful if you have used some other date conversion
-function and want to see what the date was before converting."
-  (interactive (list t))
-  (gnus-article-date-ut 'original highlight))
-
-(defun gnus-article-date-lapsed (&optional highlight)
-  "Convert the current article date to time lapsed since it was sent."
-  (interactive (list t))
-  (gnus-article-date-ut 'lapsed highlight))
-
-(defun gnus-article-maybe-highlight ()
-  "Do some article highlighting if `gnus-visual' is non-nil."
-  (if (gnus-visual-p 'article-highlight 'highlight)
-      (gnus-article-highlight-some)))
-
-;;; Article savers.
-
-(defun gnus-output-to-rmail (file-name)
-  "Append the current article to an Rmail file named FILE-NAME."
-  (require 'rmail)
-  ;; Most of these codes are borrowed from rmailout.el.
-  (setq file-name (expand-file-name file-name))
-  (setq rmail-default-rmail-file file-name)
-  (let ((artbuf (current-buffer))
-	(tmpbuf (get-buffer-create " *Gnus-output*")))
-    (save-excursion
-      (or (get-file-buffer file-name)
-	  (file-exists-p file-name)
-	  (if (gnus-yes-or-no-p
-	       (concat "\"" file-name "\" does not exist, create it? "))
-	      (let ((file-buffer (create-file-buffer file-name)))
-		(save-excursion
-		  (set-buffer file-buffer)
-		  (rmail-insert-rmail-file-header)
-		  (let ((require-final-newline nil))
-		    (write-region (point-min) (point-max) file-name t 1)))
-		(kill-buffer file-buffer))
-	    (error "Output file does not exist")))
-      (set-buffer tmpbuf)
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (insert-buffer-substring artbuf)
-      (gnus-convert-article-to-rmail)
-      ;; Decide whether to append to a file or to an Emacs buffer.
-      (let ((outbuf (get-file-buffer file-name)))
-	(if (not outbuf)
-	    (append-to-file (point-min) (point-max) file-name)
-	  ;; File has been visited, in buffer OUTBUF.
-	  (set-buffer outbuf)
-	  (let ((buffer-read-only nil)
-		(msg (and (boundp 'rmail-current-message)
-			  (symbol-value 'rmail-current-message))))
-	    ;; If MSG is non-nil, buffer is in RMAIL mode.
-	    (if msg
-		(progn (widen)
-		       (narrow-to-region (point-max) (point-max))))
-	    (insert-buffer-substring tmpbuf)
-	    (if msg
-		(progn
-		  (goto-char (point-min))
-		  (widen)
-		  (search-backward "\^_")
-		  (narrow-to-region (point) (point-max))
-		  (goto-char (1+ (point-min)))
-		  (rmail-count-new-messages t)
-		  (rmail-show-message msg)))))))
-    (kill-buffer tmpbuf)))
-
-(defun gnus-output-to-file (file-name)
-  "Append the current article to a file named FILE-NAME."
-  (let ((artbuf (current-buffer)))
-    (nnheader-temp-write nil
-      (insert-buffer-substring artbuf)
-      ;; Append newline at end of the buffer as separator, and then
-      ;; save it to file.
-      (goto-char (point-max))
-      (insert "\n")
-      (append-to-file (point-min) (point-max) file-name))))
-
-(defun gnus-convert-article-to-rmail ()
-  "Convert article in current buffer to Rmail message format."
-  (let ((buffer-read-only nil))
-    ;; Convert article directly into Babyl format.
-    ;; Suggested by Rob Austein <sra@lcs.mit.edu>
-    (goto-char (point-min))
-    (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
-    (while (search-forward "\n\^_" nil t) ;single char
-      (replace-match "\n^_" t t))	;2 chars: "^" and "_"
-    (goto-char (point-max))
-    (insert "\^_")))
-
-(defun gnus-narrow-to-page (&optional arg)
-  "Narrow the article buffer to a page.
-If given a numerical ARG, move forward ARG pages."
-  (interactive "P")
-  (setq arg (if arg (prefix-numeric-value arg) 0))
-  (save-excursion
-    (set-buffer gnus-article-buffer)
-    (goto-char (point-min))
-    (widen)
-    (when (gnus-visual-p 'page-marker)
-      (let ((buffer-read-only nil))
-	(gnus-remove-text-with-property 'gnus-prev)
-	(gnus-remove-text-with-property 'gnus-next)))
-    (when
-	(cond ((< arg 0)
-	       (re-search-backward page-delimiter nil 'move (1+ (abs arg))))
-	      ((> arg 0)
-	       (re-search-forward page-delimiter nil 'move arg)))
-      (goto-char (match-end 0)))
-    (narrow-to-region
-     (point)
-     (if (re-search-forward page-delimiter nil 'move)
-	 (match-beginning 0)
-       (point)))
-    (when (and (gnus-visual-p 'page-marker)
-	       (not (= (point-min) 1)))
-      (save-excursion
-	(goto-char (point-min))
-	(gnus-insert-prev-page-button)))
-    (when (and (gnus-visual-p 'page-marker)
-	       (not (= (1- (point-max)) (buffer-size))))
-      (save-excursion
-	(goto-char (point-max))
-	(gnus-insert-next-page-button)))))
-
-;; Article mode commands
-
-(defun gnus-article-goto-next-page ()
-  "Show the next page of the article."
-  (interactive)
-  (when (gnus-article-next-page)
-    (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
-
-(defun gnus-article-goto-prev-page ()
-  "Show the next page of the article."
-  (interactive)
-  (if (bobp) (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))
-    (gnus-article-prev-page nil)))
-
-(defun gnus-article-next-page (&optional lines)
-  "Show the next page of the current article.
-If end of article, return non-nil.  Otherwise return nil.
-Argument LINES specifies lines to be scrolled up."
-  (interactive "p")
-  (move-to-window-line -1)
-  ;; Fixed by enami@ptgd.sony.co.jp (enami tsugutomo)
-  (if (save-excursion
-	(end-of-line)
-	(and (pos-visible-in-window-p)	;Not continuation line.
-	     (eobp)))
-      ;; Nothing in this page.
-      (if (or (not gnus-break-pages)
-	      (save-excursion
-		(save-restriction
-		  (widen) (forward-line 1) (eobp)))) ;Real end-of-buffer?
-	  t				;Nothing more.
-	(gnus-narrow-to-page 1)		;Go to next page.
-	nil)
-    ;; More in this page.
-    (condition-case ()
-	(scroll-up lines)
-      (end-of-buffer
-       ;; Long lines may cause an end-of-buffer error.
-       (goto-char (point-max))))
-    (move-to-window-line 0)
-    nil))
-
-(defun gnus-article-prev-page (&optional lines)
-  "Show previous page of current article.
-Argument LINES specifies lines to be scrolled down."
-  (interactive "p")
-  (move-to-window-line 0)
-  (if (and gnus-break-pages
-	   (bobp)
-	   (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
-      (progn
-	(gnus-narrow-to-page -1)	;Go to previous page.
-	(goto-char (point-max))
-	(recenter -1))
-    (prog1
-	(condition-case ()
-	    (scroll-down lines)
-	  (error nil))
-      (move-to-window-line 0))))
-
-(defun gnus-article-refer-article ()
-  "Read article specified by message-id around point."
-  (interactive)
-  (let ((point (point)))
-    (search-forward ">" nil t)		;Move point to end of "<....>".
-    (if (re-search-backward "\\(<[^<> \t\n]+>\\)" nil t)
-	(let ((message-id (match-string 1)))
-	  (goto-char point)
-	  (set-buffer gnus-summary-buffer)
-	  (gnus-summary-refer-article message-id))
-      (goto-char (point))
-      (error "No references around point"))))
-
-(defun gnus-article-show-summary ()
-  "Reconfigure windows to show summary buffer."
-  (interactive)
-  (gnus-configure-windows 'article)
-  (gnus-summary-goto-subject gnus-current-article))
-
-(defun gnus-article-describe-briefly ()
-  "Describe article mode commands briefly."
-  (interactive)
-  (gnus-message 6
-		(substitute-command-keys "\\<gnus-article-mode-map>\\[gnus-article-goto-next-page]:Next page	 \\[gnus-article-goto-prev-page]:Prev page  \\[gnus-article-show-summary]:Show summary  \\[gnus-info-find-node]:Run Info  \\[gnus-article-describe-briefly]:This help")))
-
-(defun gnus-article-summary-command ()
-  "Execute the last keystroke in the summary buffer."
-  (interactive)
-  (let ((obuf (current-buffer))
-	(owin (current-window-configuration))
-	func)
-    (switch-to-buffer gnus-summary-buffer 'norecord)
-    (setq func (lookup-key (current-local-map) (this-command-keys)))
-    (call-interactively func)
-    (set-buffer obuf)
-    (set-window-configuration owin)
-    (set-window-point (get-buffer-window (current-buffer)) (point))))
-
-(defun gnus-article-summary-command-nosave ()
-  "Execute the last keystroke in the summary buffer."
-  (interactive)
-  (let (func)
-    (pop-to-buffer gnus-summary-buffer 'norecord)
-    (setq func (lookup-key (current-local-map) (this-command-keys)))
-    (call-interactively func)))
-
-(defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
-  "Read a summary buffer key sequence and execute it from the article buffer."
-  (interactive "P")
-  (let ((nosaves
-	 '("q" "Q"  "c" "r" "R" "\C-c\C-f" "m"	"a" "f" "F"
-	   "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
-	   "=" "^" "\M-^" "|"))
-	(nosave-but-article
-	 '("A\r"))
-	keys)
-    (save-excursion
-      (set-buffer gnus-summary-buffer)
-      (push (or key last-command-event) unread-command-events)
-      (setq keys (read-key-sequence nil)))
-    (message "")
-
-    (if (or (member keys nosaves)
-	    (member keys nosave-but-article))
-	(let (func)
-	  (save-window-excursion
-	    (pop-to-buffer gnus-summary-buffer 'norecord)
-	    (setq func (lookup-key (current-local-map) keys)))
-	  (if (not func)
-	      (ding)
-	    (set-buffer gnus-summary-buffer)
-	    (call-interactively func))
-	  (when (member keys nosave-but-article)
-	    (pop-to-buffer gnus-article-buffer 'norecord)))
-      (let ((obuf (current-buffer))
-	    (owin (current-window-configuration))
-	    (opoint (point))
-	    func in-buffer)
-	(if not-restore-window
-	    (pop-to-buffer gnus-summary-buffer 'norecord)
-	  (switch-to-buffer gnus-summary-buffer 'norecord))
-	(setq in-buffer (current-buffer))
-	(if (setq func (lookup-key (current-local-map) keys))
-	    (call-interactively func)
-	  (ding))
-	(when (eq in-buffer (current-buffer))
-	  (set-buffer obuf)
-	  (unless not-restore-window
-	    (set-window-configuration owin))
-	  (set-window-point (get-buffer-window (current-buffer)) opoint))))))
-
-
-;;;
-;;; Kill file handling.
-;;;
-
-;;;###autoload
-(defalias 'gnus-batch-kill 'gnus-batch-score)
-;;;###autoload
-(defun gnus-batch-score ()
-  "Run batched scoring.
-Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
-Newsgroups is a list of strings in Bnews format.  If you want to score
-the comp hierarchy, you'd say \"comp.all\".  If you would not like to
-score the alt hierarchy, you'd say \"!alt.all\"."
-  (interactive)
-  (let* ((yes-and-no
-	  (gnus-newsrc-parse-options
-	   (apply (function concat)
-		  (mapcar (lambda (g) (concat g " "))
-			  command-line-args-left))))
-	 (gnus-expert-user t)
-	 (nnmail-spool-file nil)
-	 (gnus-use-dribble-file nil)
-	 (yes (car yes-and-no))
-	 (no (cdr yes-and-no))
-	 group newsrc entry
-	 ;; Disable verbose message.
-	 gnus-novice-user gnus-large-newsgroup)
-    ;; Eat all arguments.
-    (setq command-line-args-left nil)
-    ;; Start Gnus.
-    (gnus)
-    ;; Apply kills to specified newsgroups in command line arguments.
-    (setq newsrc (cdr gnus-newsrc-alist))
-    (while newsrc
-      (setq group (caar newsrc))
-      (setq entry (gnus-gethash group gnus-newsrc-hashtb))
-      (if (and (<= (nth 1 (car newsrc)) gnus-level-subscribed)
-	       (and (car entry)
-		    (or (eq (car entry) t)
-			(not (zerop (car entry)))))
-	       (if yes (string-match yes group) t)
-	       (or (null no) (not (string-match no group))))
-	  (progn
-	    (gnus-summary-read-group group nil t nil t)
-	    (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
-		 (gnus-summary-exit))))
-      (setq newsrc (cdr newsrc)))
-    ;; Exit Emacs.
-    (switch-to-buffer gnus-group-buffer)
-    (gnus-group-save-newsrc)))
-
-(defun gnus-apply-kill-file ()
-  "Apply a kill file to the current newsgroup.
-Returns the number of articles marked as read."
-  (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
-	  (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
-      (gnus-apply-kill-file-internal)
-    0))
-
-(defun gnus-kill-save-kill-buffer ()
-  (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
-    (when (get-file-buffer file)
-      (save-excursion
-	(set-buffer (get-file-buffer file))
-	(and (buffer-modified-p) (save-buffer))
-	(kill-buffer (current-buffer))))))
-
-(defvar gnus-kill-file-name "KILL"
-  "Suffix of the kill files.")
-
-(defun gnus-newsgroup-kill-file (newsgroup)
-  "Return the name of a kill file name for NEWSGROUP.
-If NEWSGROUP is nil, return the global kill file name instead."
-  (cond 
-   ;; The global KILL file is placed at top of the directory.
-   ((or (null newsgroup)
-	(string-equal newsgroup ""))
-    (expand-file-name gnus-kill-file-name
-		      gnus-kill-files-directory))
-   ;; Append ".KILL" to newsgroup name.
-   ((gnus-use-long-file-name 'not-kill)
-    (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
-			      "." gnus-kill-file-name)
-		      gnus-kill-files-directory))
-   ;; Place "KILL" under the hierarchical directory.
-   (t
-    (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
-			      "/" gnus-kill-file-name)
-		      gnus-kill-files-directory))))
-
-
-;;;
-;;; Dribble file
-;;;
-
-(defvar gnus-dribble-ignore nil)
-(defvar gnus-dribble-eval-file nil)
-
-(defun gnus-dribble-file-name ()
-  "Return the dribble file for the current .newsrc."
-  (concat
-   (if gnus-dribble-directory
-       (concat (file-name-as-directory gnus-dribble-directory)
-	       (file-name-nondirectory gnus-current-startup-file))
-     gnus-current-startup-file)
-   "-dribble"))
-
-(defun gnus-dribble-enter (string)
-  "Enter STRING into the dribble buffer."
-  (if (and (not gnus-dribble-ignore)
-	   gnus-dribble-buffer
-	   (buffer-name gnus-dribble-buffer))
-      (let ((obuf (current-buffer)))
-	(set-buffer gnus-dribble-buffer)
-	(insert string "\n")
-	(set-window-point (get-buffer-window (current-buffer)) (point-max))
-	(bury-buffer gnus-dribble-buffer)
-	(set-buffer obuf))))
-
-(defun gnus-dribble-read-file ()
-  "Read the dribble file from disk."
-  (let ((dribble-file (gnus-dribble-file-name)))
-    (save-excursion
-      (set-buffer (setq gnus-dribble-buffer
-			(get-buffer-create
-			 (file-name-nondirectory dribble-file))))
-      (gnus-add-current-to-buffer-list)
-      (erase-buffer)
-      (setq buffer-file-name dribble-file)
-      (auto-save-mode t)
-      (buffer-disable-undo (current-buffer))
-      (bury-buffer (current-buffer))
-      (set-buffer-modified-p nil)
-      (let ((auto (make-auto-save-file-name))
-	    (gnus-dribble-ignore t)
-	    modes)
-	(when (or (file-exists-p auto) (file-exists-p dribble-file))
-	  ;; Load whichever file is newest -- the auto save file
-	  ;; or the "real" file.
-	  (if (file-newer-than-file-p auto dribble-file)
-	      (insert-file-contents auto)
-	    (insert-file-contents dribble-file))
-	  (unless (zerop (buffer-size))
-	    (set-buffer-modified-p t))
-	  ;; Set the file modes to reflect the .newsrc file modes.
-	  (save-buffer)
-	  (when (and (file-exists-p gnus-current-startup-file)
-		     (setq modes (file-modes gnus-current-startup-file)))
-	    (set-file-modes dribble-file modes))
-	  ;; Possibly eval the file later.
-	  (when (gnus-y-or-n-p
-		 "Auto-save file exists.  Do you want to read it? ")
-	    (setq gnus-dribble-eval-file t)))))))
-
-(defun gnus-dribble-eval-file ()
-  (when gnus-dribble-eval-file
-    (setq gnus-dribble-eval-file nil)
-    (save-excursion
-      (let ((gnus-dribble-ignore t))
-	(set-buffer gnus-dribble-buffer)
-	(eval-buffer (current-buffer))))))
-
-(defun gnus-dribble-delete-file ()
-  (when (file-exists-p (gnus-dribble-file-name))
-    (delete-file (gnus-dribble-file-name)))
-  (when gnus-dribble-buffer
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
-      (let ((auto (make-auto-save-file-name)))
-	(if (file-exists-p auto)
-	    (delete-file auto))
-	(erase-buffer)
-	(set-buffer-modified-p nil)))))
-
-(defun gnus-dribble-save ()
-  (when (and gnus-dribble-buffer
-	     (buffer-name gnus-dribble-buffer))
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
-      (save-buffer))))
-
-(defun gnus-dribble-clear ()
-  (when (gnus-buffer-exists-p gnus-dribble-buffer)
-    (save-excursion
-      (set-buffer gnus-dribble-buffer)
-      (erase-buffer)
-      (set-buffer-modified-p nil)
-      (setq buffer-saved-size (buffer-size)))))
-
-
-;;;
-;;; Server Communication
-;;;
-
-(defun gnus-start-news-server (&optional confirm)
-  "Open a method for getting news.
-If CONFIRM is non-nil, the user will be asked for an NNTP server."
-  (let (how)
-    (if gnus-current-select-method
-	;; Stream is already opened.
-	nil
-      ;; Open NNTP server.
-      (if (null gnus-nntp-service) (setq gnus-nntp-server nil))
-      (if confirm
-	  (progn
-	    ;; Read server name with completion.
-	    (setq gnus-nntp-server
-		  (completing-read "NNTP server: "
-				   (mapcar (lambda (server) (list server))
-					   (cons (list gnus-nntp-server)
-						 gnus-secondary-servers))
-				   nil nil gnus-nntp-server))))
-
-      (if (and gnus-nntp-server
-	       (stringp gnus-nntp-server)
-	       (not (string= gnus-nntp-server "")))
-	  (setq gnus-select-method
-		(cond ((or (string= gnus-nntp-server "")
-			   (string= gnus-nntp-server "::"))
-		       (list 'nnspool (system-name)))
-		      ((string-match "^:" gnus-nntp-server)
-		       (list 'nnmh gnus-nntp-server
-			     (list 'nnmh-directory
-				   (file-name-as-directory
-				    (expand-file-name
-				     (concat "~/" (substring
-						   gnus-nntp-server 1)))))
-			     (list 'nnmh-get-new-mail nil)))
-		      (t
-		       (list 'nntp gnus-nntp-server)))))
-
-      (setq how (car gnus-select-method))
-      (cond ((eq how 'nnspool)
-	     (require 'nnspool)
-	     (gnus-message 5 "Looking up local news spool..."))
-	    ((eq how 'nnmh)
-	     (require 'nnmh)
-	     (gnus-message 5 "Looking up mh spool..."))
-	    (t
-	     (require 'nntp)))
-      (setq gnus-current-select-method gnus-select-method)
-      (run-hooks 'gnus-open-server-hook)
-      (or
-       ;; gnus-open-server-hook might have opened it
-       (gnus-server-opened gnus-select-method)
-       (gnus-open-server gnus-select-method)
-       (gnus-y-or-n-p
-	(format
-	 "%s (%s) open error: '%s'.	Continue? "
-	 (car gnus-select-method) (cadr gnus-select-method)
-	 (gnus-status-message gnus-select-method)))
-       (gnus-error 1 "Couldn't open server on %s"
-		   (nth 1 gnus-select-method))))))
-
-(defun gnus-check-group (group)
-  "Try to make sure that the server where GROUP exists is alive."
-  (let ((method (gnus-find-method-for-group group)))
-    (or (gnus-server-opened method)
-	(gnus-open-server method))))
-
-(defun gnus-check-server (&optional method silent)
-  "Check whether the connection to METHOD is down.
-If METHOD is nil, use `gnus-select-method'.
-If it is down, start it up (again)."
-  (let ((method (or method gnus-select-method)))
-    ;; Transform virtual server names into select methods.
-    (when (stringp method)
-      (setq method (gnus-server-to-method method)))
-    (if (gnus-server-opened method)
-	;; The stream is already opened.
-	t
-      ;; Open the server.
-      (unless silent
-	(gnus-message 5 "Opening %s server%s..." (car method)
-		      (if (equal (nth 1 method) "") ""
-			(format " on %s" (nth 1 method)))))
-      (run-hooks 'gnus-open-server-hook)
-      (prog1
-	  (gnus-open-server method)
-	(unless silent
-	  (message ""))))))
-
-(defun gnus-get-function (method function &optional noerror)
-  "Return a function symbol based on METHOD and FUNCTION."
-  ;; Translate server names into methods.
-  (unless method
-    (error "Attempted use of a nil select method"))
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (let ((func (intern (format "%s-%s" (car method) function))))
-    ;; If the functions isn't bound, we require the backend in
-    ;; question.
-    (unless (fboundp func)
-      (require (car method))
-      (when (and (not (fboundp func))
-		 (not noerror))
-	;; This backend doesn't implement this function.
-	(error "No such function: %s" func)))
-    func))
-
-
-;;;
-;;; Interface functions to the backends.
-;;;
-
-(defun gnus-open-server (method)
-  "Open a connection to METHOD."
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (let ((elem (assoc method gnus-opened-servers)))
-    ;; If this method was previously denied, we just return nil.
-    (if (eq (nth 1 elem) 'denied)
-	(progn
-	  (gnus-message 1 "Denied server")
-	  nil)
-      ;; Open the server.
-      (let ((result
-	     (funcall (gnus-get-function method 'open-server)
-		      (nth 1 method) (nthcdr 2 method))))
-	;; If this hasn't been opened before, we add it to the list.
-	(unless elem
-	  (setq elem (list method nil)
-		gnus-opened-servers (cons elem gnus-opened-servers)))
-	;; Set the status of this server.
-	(setcar (cdr elem) (if result 'ok 'denied))
-	;; Return the result from the "open" call.
-	result))))
-
-(defun gnus-close-server (method)
-  "Close the connection to METHOD."
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (funcall (gnus-get-function method 'close-server) (nth 1 method)))
-
-(defun gnus-request-list (method)
-  "Request the active file from METHOD."
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (funcall (gnus-get-function method 'request-list) (nth 1 method)))
-
-(defun gnus-request-list-newsgroups (method)
-  "Request the newsgroups file from METHOD."
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (funcall (gnus-get-function method 'request-list-newsgroups) (nth 1 method)))
-
-(defun gnus-request-newgroups (date method)
-  "Request all new groups since DATE from METHOD."
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (funcall (gnus-get-function method 'request-newgroups)
-	   date (nth 1 method)))
-
-(defun gnus-server-opened (method)
-  "Check whether a connection to METHOD has been opened."
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (funcall (gnus-get-function method 'server-opened) (nth 1 method)))
-
-(defun gnus-status-message (method)
-  "Return the status message from METHOD.
-If METHOD is a string, it is interpreted as a group name.   The method
-this group uses will be queried."
-  (let ((method (if (stringp method) (gnus-find-method-for-group method)
-		  method)))
-    (funcall (gnus-get-function method 'status-message) (nth 1 method))))
-
-(defun gnus-request-group (group &optional dont-check method)
-  "Request GROUP.  If DONT-CHECK, no information is required."
-  (let ((method (or method (gnus-find-method-for-group group))))
-    (when (stringp method)
-      (setq method (gnus-server-to-method method)))
-    (funcall (gnus-get-function method 'request-group)
-	     (gnus-group-real-name group) (nth 1 method) dont-check)))
-
-(defun gnus-request-asynchronous (group &optional articles)
-  "Request that GROUP behave asynchronously.
-ARTICLES is the `data' of the group."
-  (let ((method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function method 'request-asynchronous)
-	     (gnus-group-real-name group) (nth 1 method) articles)))
-
-(defun gnus-list-active-group (group)
-  "Request active information on GROUP."
-  (let ((method (gnus-find-method-for-group group))
-	(func 'list-active-group))
-    (when (gnus-check-backend-function func group)
-      (funcall (gnus-get-function method func)
-	       (gnus-group-real-name group) (nth 1 method)))))
-
-(defun gnus-request-group-description (group)
-  "Request a description of GROUP."
-  (let ((method (gnus-find-method-for-group group))
-	(func 'request-group-description))
-    (when (gnus-check-backend-function func group)
-      (funcall (gnus-get-function method func)
-	       (gnus-group-real-name group) (nth 1 method)))))
-
-(defun gnus-close-group (group)
-  "Request the GROUP be closed."
-  (let ((method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function method 'close-group)
-	     (gnus-group-real-name group) (nth 1 method))))
-
-(defun gnus-retrieve-headers (articles group &optional fetch-old)
-  "Request headers for ARTICLES in GROUP.
-If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
-  (let ((method (gnus-find-method-for-group group)))
-    (if (and gnus-use-cache (numberp (car articles)))
-	(gnus-cache-retrieve-headers articles group fetch-old)
-      (funcall (gnus-get-function method 'retrieve-headers)
-	       articles (gnus-group-real-name group) (nth 1 method)
-	       fetch-old))))
-
-(defun gnus-retrieve-groups (groups method)
-  "Request active information on GROUPS from METHOD."
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (funcall (gnus-get-function method 'retrieve-groups) groups (nth 1 method)))
-
-(defun gnus-request-type (group &optional article)
-  "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
-  (let ((method (gnus-find-method-for-group group)))
-    (if (not (gnus-check-backend-function 'request-type (car method)))
-	'unknown
-      (funcall (gnus-get-function method 'request-type)
-	       (gnus-group-real-name group) article))))
-
-(defun gnus-request-update-mark (group article mark)
-  "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
-  (let ((method (gnus-find-method-for-group group)))
-    (if (not (gnus-check-backend-function 'request-update-mark (car method)))
-	mark
-      (funcall (gnus-get-function method 'request-update-mark)
-	       (gnus-group-real-name group) article mark))))
-
-(defun gnus-request-article (article group &optional buffer)
-  "Request the ARTICLE in GROUP.
-ARTICLE can either be an article number or an article Message-ID.
-If BUFFER, insert the article in that group."
-  (let ((method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function method 'request-article)
-	     article (gnus-group-real-name group) (nth 1 method) buffer)))
-
-(defun gnus-request-head (article group)
-  "Request the head of ARTICLE in GROUP."
-  (let* ((method (gnus-find-method-for-group group))
-	 (head (gnus-get-function method 'request-head t)))
-    (if (fboundp head)
-	(funcall head article (gnus-group-real-name group) (nth 1 method))
-      (let ((res (gnus-request-article article group)))
-	(when res
-	  (save-excursion
-	    (set-buffer nntp-server-buffer)
-	    (goto-char (point-min))
-	    (when (search-forward "\n\n" nil t)
-	      (delete-region (1- (point)) (point-max)))
-	    (nnheader-fold-continuation-lines)))
-	res))))
-
-(defun gnus-request-body (article group)
-  "Request the body of ARTICLE in GROUP."
-  (let ((method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function method 'request-body)
-	     article (gnus-group-real-name group) (nth 1 method))))
-
-(defun gnus-request-post (method)
-  "Post the current buffer using METHOD."
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (funcall (gnus-get-function method 'request-post) (nth 1 method)))
-
-(defun gnus-request-scan (group method)
-  "Request a SCAN being performed in GROUP from METHOD.
-If GROUP is nil, all groups on METHOD are scanned."
-  (let ((method (if group (gnus-find-method-for-group group) method)))
-    (funcall (gnus-get-function method 'request-scan)
-	     (and group (gnus-group-real-name group)) (nth 1 method))))
-
-(defsubst gnus-request-update-info (info method)
-  "Request that METHOD update INFO."
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (when (gnus-check-backend-function 'request-update-info (car method))
-    (funcall (gnus-get-function method 'request-update-info)
-	     (gnus-group-real-name (gnus-info-group info))
-	     info (nth 1 method))))
-
-(defun gnus-request-expire-articles (articles group &optional force)
-  (let ((method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function method 'request-expire-articles)
-	     articles (gnus-group-real-name group) (nth 1 method)
-	     force)))
-
-(defun gnus-request-move-article
-  (article group server accept-function &optional last)
-  (let ((method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function method 'request-move-article)
-	     article (gnus-group-real-name group)
-	     (nth 1 method) accept-function last)))
-
-(defun gnus-request-accept-article (group method &optional last)
-  ;; Make sure there's a newline at the end of the article.
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (when (and (not method)
-	     (stringp group))
-    (setq method (gnus-group-name-to-method group)))
-  (goto-char (point-max))
-  (unless (bolp)
-    (insert "\n"))
-  (let ((func (car (or method (gnus-find-method-for-group group)))))
-    (funcall (intern (format "%s-request-accept-article" func))
-	     (if (stringp group) (gnus-group-real-name group) group)
-	     (cadr method)
-	     last)))
-
-(defun gnus-request-replace-article (article group buffer)
-  (let ((func (car (gnus-find-method-for-group group))))
-    (funcall (intern (format "%s-request-replace-article" func))
-	     article (gnus-group-real-name group) buffer)))
-
-(defun gnus-request-associate-buffer (group)
-  (let ((method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function method 'request-associate-buffer)
-	     (gnus-group-real-name group))))
-
-(defun gnus-request-restore-buffer (article group)
-  "Request a new buffer restored to the state of ARTICLE."
-  (let ((method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function method 'request-restore-buffer)
-	     article (gnus-group-real-name group) (nth 1 method))))
-
-(defun gnus-request-create-group (group &optional method)
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (let ((method (or method (gnus-find-method-for-group group))))
-    (funcall (gnus-get-function method 'request-create-group)
-	     (gnus-group-real-name group) (nth 1 method))))
-
-(defun gnus-request-delete-group (group &optional force)
-  (let ((method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function method 'request-delete-group)
-	     (gnus-group-real-name group) force (nth 1 method))))
-
-(defun gnus-request-rename-group (group new-name)
-  (let ((method (gnus-find-method-for-group group)))
-    (funcall (gnus-get-function method 'request-rename-group)
-	     (gnus-group-real-name group)
-	     (gnus-group-real-name new-name) (nth 1 method))))
-
-(defun gnus-member-of-valid (symbol group)
-  "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
-  (memq symbol (assoc
-		(symbol-name (car (gnus-find-method-for-group group)))
-		gnus-valid-select-methods)))
-
-(defun gnus-method-option-p (method option)
-  "Return non-nil if select METHOD has OPTION as a parameter."
-  (when (stringp method)
-    (setq method (gnus-server-to-method method)))
-  (memq option (assoc (format "%s" (car method))
-		      gnus-valid-select-methods)))
-
-(defun gnus-server-extend-method (group method)
-  ;; This function "extends" a virtual server.	If the server is
-  ;; "hello", and the select method is ("hello" (my-var "something"))
-  ;; in the group "alt.alt", this will result in a new virtual server
-  ;; called "hello+alt.alt".
-  (let ((entry
-	 (gnus-copy-sequence
-	  (if (equal (car method) "native") gnus-select-method
-	    (cdr (assoc (car method) gnus-server-alist))))))
-    (setcar (cdr entry) (concat (nth 1 entry) "+" group))
-    (nconc entry (cdr method))))
-
-(defun gnus-server-status (method)
-  "Return the status of METHOD."
-  (nth 1 (assoc method gnus-opened-servers)))
-
-(defun gnus-group-name-to-method (group)
-  "Return a select method suitable for GROUP."
-  (if (string-match ":" group)
-      (let ((server (substring group 0 (match-beginning 0))))
-	(if (string-match "\\+" server)
-	    (list (intern (substring server 0 (match-beginning 0)))
-		  (substring server (match-end 0)))
-	  (list (intern server) "")))
-    gnus-select-method))
-
-(defun gnus-find-method-for-group (group &optional info)
-  "Find the select method that GROUP uses."
-  (or gnus-override-method
-      (and (not group)
-	   gnus-select-method)
-      (let ((info (or info (gnus-get-info group)))
-	    method)
-	(if (or (not info)
-		(not (setq method (gnus-info-method info)))
-		(equal method "native"))
-	    gnus-select-method
-	  (setq method
-		(cond ((stringp method)
-		       (gnus-server-to-method method))
-		      ((stringp (car method))
-		       (gnus-server-extend-method group method))
-		      (t
-		       method)))
-	  (cond ((equal (cadr method) "")
-		 method)
-		((null (cadr method))
-		 (list (car method) ""))
-		(t
-		 (gnus-server-add-address method)))))))
-
-(defun gnus-check-backend-function (func group)
-  "Check whether GROUP supports function FUNC."
-  (let ((method (if (stringp group) (car (gnus-find-method-for-group group))
-		  group)))
-    (fboundp (intern (format "%s-%s" method func)))))
-
-(defun gnus-methods-using (feature)
-  "Find all methods that have FEATURE."
-  (let ((valids gnus-valid-select-methods)
-	outs)
-    (while valids
-      (if (memq feature (car valids))
-	  (setq outs (cons (car valids) outs)))
-      (setq valids (cdr valids)))
-    outs))
-
-
-;;;
-;;; Active & Newsrc File Handling
-;;;
-
-(defun gnus-setup-news (&optional rawfile level dont-connect)
-  "Setup news information.
-If RAWFILE is non-nil, the .newsrc file will also be read.
-If LEVEL is non-nil, the news will be set up at level LEVEL."
-  (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile)))))
-
-    (when init 
-      ;; Clear some variables to re-initialize news information.
-      (setq gnus-newsrc-alist nil
-	    gnus-active-hashtb nil)
-      ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
-      (gnus-read-newsrc-file rawfile))
-
-    (when (and (not (assoc "archive" gnus-server-alist))
-	       (gnus-archive-server-wanted-p))
-      (push (cons "archive" gnus-message-archive-method)
-	    gnus-server-alist))
-
-    ;; If we don't read the complete active file, we fill in the
-    ;; hashtb here.
-    (if (or (null gnus-read-active-file)
-	    (eq gnus-read-active-file 'some))
-	(gnus-update-active-hashtb-from-killed))
-
-    ;; Read the active file and create `gnus-active-hashtb'.
-    ;; If `gnus-read-active-file' is nil, then we just create an empty
-    ;; hash table.  The partial filling out of the hash table will be
-    ;; done in `gnus-get-unread-articles'.
-    (and gnus-read-active-file
-	 (not level)
-	 (gnus-read-active-file))
-
-    (or gnus-active-hashtb
-	(setq gnus-active-hashtb (make-vector 4095 0)))
-
-    ;; Initialize the cache.
-    (when gnus-use-cache
-      (gnus-cache-open))
-
-    ;; Possibly eval the dribble file.
-    (and init (or gnus-use-dribble-file gnus-slave) (gnus-dribble-eval-file))
-
-    ;; Slave Gnusii should then clear the dribble buffer.
-    (when (and init gnus-slave)
-      (gnus-dribble-clear))
-
-    (gnus-update-format-specifications)
-
-    ;; See whether we need to read the description file.
-    (if (and (string-match "%[-,0-9]*D" gnus-group-line-format)
-	     (not gnus-description-hashtb)
-	     (not dont-connect)
-	     gnus-read-active-file)
-	(gnus-read-all-descriptions-files))
-
-    ;; Find new newsgroups and treat them.
-    (if (and init gnus-check-new-newsgroups (not level)
-	     (gnus-check-server gnus-select-method))
-	(gnus-find-new-newsgroups))
-
-    ;; We might read in new NoCeM messages here.
-    (when (and gnus-use-nocem 
-	       (not level)
-	       (not dont-connect))
-      (gnus-nocem-scan-groups))
-
-    ;; Find the number of unread articles in each non-dead group.
-    (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
-      (gnus-get-unread-articles level))
-
-    (if (and init gnus-check-bogus-newsgroups
-	     gnus-read-active-file (not level)
-	     (gnus-server-opened gnus-select-method))
-	(gnus-check-bogus-newsgroups))))
-
-(defun gnus-find-new-newsgroups (&optional arg)
-  "Search for new newsgroups and add them.
-Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method.'
-The `-n' option line from .newsrc is respected.
-If ARG (the prefix), use the `ask-server' method to query
-the server for new groups."
-  (interactive "P")
-  (let ((check (if (or (and arg (not (listp gnus-check-new-newsgroups)))
-		       (null gnus-read-active-file)
-		       (eq gnus-read-active-file 'some))
-		   'ask-server gnus-check-new-newsgroups)))
-    (unless (gnus-check-first-time-used)
-      (if (or (consp check)
-	      (eq check 'ask-server))
-	  ;; Ask the server for new groups.
-	  (gnus-ask-server-for-new-groups)
-	;; Go through the active hashtb and look for new groups.
-	(let ((groups 0)
-	      group new-newsgroups)
-	  (gnus-message 5 "Looking for new newsgroups...")
-	  (unless gnus-have-read-active-file
-	    (gnus-read-active-file))
-	  (setq gnus-newsrc-last-checked-date (current-time-string))
-	  (unless gnus-killed-hashtb
-	    (gnus-make-hashtable-from-killed))
-	  ;; Go though every newsgroup in `gnus-active-hashtb' and compare
-	  ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
-	  (mapatoms
-	   (lambda (sym)
-	     (if (or (null (setq group (symbol-name sym)))
-		     (not (boundp sym))
-		     (null (symbol-value sym))
-		     (gnus-gethash group gnus-killed-hashtb)
-		     (gnus-gethash group gnus-newsrc-hashtb))
-		 ()
-	       (let ((do-sub (gnus-matches-options-n group)))
-		 (cond
-		  ((eq do-sub 'subscribe)
-		   (setq groups (1+ groups))
-		   (gnus-sethash group group gnus-killed-hashtb)
-		   (funcall gnus-subscribe-options-newsgroup-method group))
-		  ((eq do-sub 'ignore)
-		   nil)
-		  (t
-		   (setq groups (1+ groups))
-		   (gnus-sethash group group gnus-killed-hashtb)
-		   (if gnus-subscribe-hierarchical-interactive
-		       (setq new-newsgroups (cons group new-newsgroups))
-		     (funcall gnus-subscribe-newsgroup-method group)))))))
-	   gnus-active-hashtb)
-	  (when new-newsgroups
-	    (gnus-subscribe-hierarchical-interactive new-newsgroups))
-	  ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
-	  (if (> groups 0)
-	      (gnus-message 6 "%d new newsgroup%s arrived."
-			    groups (if (> groups 1) "s have" " has"))
-	    (gnus-message 6 "No new newsgroups.")))))))
-
-(defun gnus-matches-options-n (group)
-  ;; Returns `subscribe' if the group is to be unconditionally
-  ;; subscribed, `ignore' if it is to be ignored, and nil if there is
-  ;; no match for the group.
-
-  ;; First we check the two user variables.
-  (cond
-   ((and gnus-options-subscribe
-	 (string-match gnus-options-subscribe group))
-    'subscribe)
-   ((and gnus-auto-subscribed-groups
-	 (string-match gnus-auto-subscribed-groups group))
-    'subscribe)
-   ((and gnus-options-not-subscribe
-	 (string-match gnus-options-not-subscribe group))
-    'ignore)
-   ;; Then we go through the list that was retrieved from the .newsrc
-   ;; file.  This list has elements on the form
-   ;; `(REGEXP . {ignore,subscribe})'.  The first match found (the list
-   ;; is in the reverse order of the options line) is returned.
-   (t
-    (let ((regs gnus-newsrc-options-n))
-      (while (and regs
-		  (not (string-match (caar regs) group)))
-	(setq regs (cdr regs)))
-      (and regs (cdar regs))))))
-
-(defun gnus-ask-server-for-new-groups ()
-  (let* ((date (or gnus-newsrc-last-checked-date (current-time-string)))
-	 (methods (cons gnus-select-method
-			(nconc
-			 (when (gnus-archive-server-wanted-p)
-			   (list "archive"))
-			 (append
-			  (and (consp gnus-check-new-newsgroups)
-			       gnus-check-new-newsgroups)
-			  gnus-secondary-select-methods))))
-	 (groups 0)
-	 (new-date (current-time-string))
-	 group new-newsgroups got-new method hashtb
-	 gnus-override-subscribe-method)
-    ;; Go through both primary and secondary select methods and
-    ;; request new newsgroups.
-    (while (setq method (gnus-server-get-method nil (pop methods)))
-      (setq new-newsgroups nil)
-      (setq gnus-override-subscribe-method method)
-      (when (and (gnus-check-server method)
-		 (gnus-request-newgroups date method))
-	(save-excursion
-	  (setq got-new t)
-	  (setq hashtb (gnus-make-hashtable 100))
-	  (set-buffer nntp-server-buffer)
-	  ;; Enter all the new groups into a hashtable.
-	  (gnus-active-to-gnus-format method hashtb 'ignore))
-	;; Now all new groups from `method' are in `hashtb'.
-	(mapatoms
-	 (lambda (group-sym)
-	   (if (or (null (setq group (symbol-name group-sym)))
-		   (not (boundp group-sym))
-		   (null (symbol-value group-sym))
-		   (gnus-gethash group gnus-newsrc-hashtb)
-		   (member group gnus-zombie-list)
-		   (member group gnus-killed-list))
-	       ;; The group is already known.
-	       ()
-	     ;; Make this group active.
-	     (when (symbol-value group-sym)
-	       (gnus-set-active group (symbol-value group-sym)))
-	     ;; Check whether we want it or not.
-	     (let ((do-sub (gnus-matches-options-n group)))
-	       (cond
-		((eq do-sub 'subscribe)
-		 (incf groups)
-		 (gnus-sethash group group gnus-killed-hashtb)
-		 (funcall gnus-subscribe-options-newsgroup-method group))
-		((eq do-sub 'ignore)
-		 nil)
-		(t
-		 (incf groups)
-		 (gnus-sethash group group gnus-killed-hashtb)
-		 (if gnus-subscribe-hierarchical-interactive
-		     (push group new-newsgroups)
-		   (funcall gnus-subscribe-newsgroup-method group)))))))
-	 hashtb))
-      (when new-newsgroups
-	(gnus-subscribe-hierarchical-interactive new-newsgroups)))
-    ;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
-    (when (> groups 0)
-      (gnus-message 6 "%d new newsgroup%s arrived."
-		    groups (if (> groups 1) "s have" " has")))
-    (and got-new (setq gnus-newsrc-last-checked-date new-date))
-    got-new))
-
-(defun gnus-check-first-time-used ()
-  (if (or (> (length gnus-newsrc-alist) 1)
-	  (file-exists-p gnus-startup-file)
-	  (file-exists-p (concat gnus-startup-file ".el"))
-	  (file-exists-p (concat gnus-startup-file ".eld")))
-      nil
-    (gnus-message 6 "First time user; subscribing you to default groups")
-    (unless (gnus-read-active-file-p)
-      (gnus-read-active-file))
-    (setq gnus-newsrc-last-checked-date (current-time-string))
-    (let ((groups gnus-default-subscribed-newsgroups)
-	  group)
-      (if (eq groups t)
-	  nil
-	(setq groups (or groups gnus-backup-default-subscribed-newsgroups))
-	(mapatoms
-	 (lambda (sym)
-	   (if (null (setq group (symbol-name sym)))
-	       ()
-	     (let ((do-sub (gnus-matches-options-n group)))
-	       (cond
-		((eq do-sub 'subscribe)
-		 (gnus-sethash group group gnus-killed-hashtb)
-		 (funcall gnus-subscribe-options-newsgroup-method group))
-		((eq do-sub 'ignore)
-		 nil)
-		(t
-		 (setq gnus-killed-list (cons group gnus-killed-list)))))))
-	 gnus-active-hashtb)
-	(while groups
-	  (if (gnus-active (car groups))
-	      (gnus-group-change-level
-	       (car groups) gnus-level-default-subscribed gnus-level-killed))
-	  (setq groups (cdr groups)))
-	(gnus-group-make-help-group)
-	(and gnus-novice-user
-	     (gnus-message 7 "`A k' to list killed groups"))))))
-
-(defun gnus-subscribe-group (group previous &optional method)
-  (gnus-group-change-level
-   (if method
-       (list t group gnus-level-default-subscribed nil nil method)
-     group)
-   gnus-level-default-subscribed gnus-level-killed previous t))
-
-;; `gnus-group-change-level' is the fundamental function for changing
-;; subscription levels of newsgroups.  This might mean just changing
-;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
-;; again, which subscribes/unsubscribes a group, which is equally
-;; trivial.  Changing from 1-7 to 8-9 means that you kill a group, and
-;; from 8-9 to 1-7 means that you remove the group from the list of
-;; killed (or zombie) groups and add them to the (kinda) subscribed
-;; groups.  And last but not least, moving from 8 to 9 and 9 to 8,
-;; which is trivial.
-;; ENTRY can either be a string (newsgroup name) or a list (if
-;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
-;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
-;; entries.
-;; LEVEL is the new level of the group, OLDLEVEL is the old level and
-;; PREVIOUS is the group (in hashtb entry format) to insert this group
-;; after.
-(defun gnus-group-change-level (entry level &optional oldlevel
-				      previous fromkilled)
-  (let (group info active num)
-    ;; Glean what info we can from the arguments
-    (if (consp entry)
-	(if fromkilled (setq group (nth 1 entry))
-	  (setq group (car (nth 2 entry))))
-      (setq group entry))
-    (if (and (stringp entry)
-	     oldlevel
-	     (< oldlevel gnus-level-zombie))
-	(setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
-    (if (and (not oldlevel)
-	     (consp entry))
-	(setq oldlevel (gnus-info-level (nth 2 entry)))
-      (setq oldlevel (or oldlevel 9)))
-    (if (stringp previous)
-	(setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
-
-    (if (and (>= oldlevel gnus-level-zombie)
-	     (gnus-gethash group gnus-newsrc-hashtb))
-	;; We are trying to subscribe a group that is already
-	;; subscribed.
-	()				; Do nothing.
-
-      (or (gnus-ephemeral-group-p group)
-	  (gnus-dribble-enter
-	   (format "(gnus-group-change-level %S %S %S %S %S)"
-		   group level oldlevel (car (nth 2 previous)) fromkilled)))
-
-      ;; Then we remove the newgroup from any old structures, if needed.
-      ;; If the group was killed, we remove it from the killed or zombie
-      ;; list.  If not, and it is in fact going to be killed, we remove
-      ;; it from the newsrc hash table and assoc.
-      (cond
-       ((>= oldlevel gnus-level-zombie)
-	(if (= oldlevel gnus-level-zombie)
-	    (setq gnus-zombie-list (delete group gnus-zombie-list))
-	  (setq gnus-killed-list (delete group gnus-killed-list))))
-       (t
-	(if (and (>= level gnus-level-zombie)
-		 entry)
-	    (progn
-	      (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
-	      (if (nth 3 entry)
-		  (setcdr (gnus-gethash (car (nth 3 entry))
-					gnus-newsrc-hashtb)
-			  (cdr entry)))
-	      (setcdr (cdr entry) (cdddr entry))))))
-
-      ;; Finally we enter (if needed) the list where it is supposed to
-      ;; go, and change the subscription level.  If it is to be killed,
-      ;; we enter it into the killed or zombie list.
-      (cond 
-       ((>= level gnus-level-zombie)
-	;; Remove from the hash table.
-	(gnus-sethash group nil gnus-newsrc-hashtb)
-	;; We do not enter foreign groups into the list of dead
-	;; groups.
-	(unless (gnus-group-foreign-p group)
-	  (if (= level gnus-level-zombie)
-	      (setq gnus-zombie-list (cons group gnus-zombie-list))
-	    (setq gnus-killed-list (cons group gnus-killed-list)))))
-       (t
-	;; If the list is to be entered into the newsrc assoc, and
-	;; it was killed, we have to create an entry in the newsrc
-	;; hashtb format and fix the pointers in the newsrc assoc.
-	(if (< oldlevel gnus-level-zombie)
-	    ;; It was alive, and it is going to stay alive, so we
-	    ;; just change the level and don't change any pointers or
-	    ;; hash table entries.
-	    (setcar (cdaddr entry) level)
-	  (if (listp entry)
-	      (setq info (cdr entry)
-		    num (car entry))
-	    (setq active (gnus-active group))
-	    (setq num
-		  (if active (- (1+ (cdr active)) (car active)) t))
-	    ;; Check whether the group is foreign.  If so, the
-	    ;; foreign select method has to be entered into the
-	    ;; info.
-	    (let ((method (or gnus-override-subscribe-method
-			      (gnus-group-method group))))
-	      (if (eq method gnus-select-method)
-		  (setq info (list group level nil))
-		(setq info (list group level nil nil method)))))
-	  (unless previous
-	    (setq previous
-		  (let ((p gnus-newsrc-alist))
-		    (while (cddr p)
-		      (setq p (cdr p)))
-		    p)))
-	  (setq entry (cons info (cddr previous)))
-	  (if (cdr previous)
-	      (progn
-		(setcdr (cdr previous) entry)
-		(gnus-sethash group (cons num (cdr previous))
-			      gnus-newsrc-hashtb))
-	    (setcdr previous entry)
-	    (gnus-sethash group (cons num previous)
-			  gnus-newsrc-hashtb))
-	  (when (cdr entry)
-	    (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry)))))
-      (when gnus-group-change-level-function
-	(funcall gnus-group-change-level-function group level oldlevel)))))
-
-(defun gnus-kill-newsgroup (newsgroup)
-  "Obsolete function.  Kills a newsgroup."
-  (gnus-group-change-level
-   (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
-
-(defun gnus-check-bogus-newsgroups (&optional confirm)
-  "Remove bogus newsgroups.
-If CONFIRM is non-nil, the user has to confirm the deletion of every
-newsgroup."
-  (let ((newsrc (cdr gnus-newsrc-alist))
-	bogus group entry info)
-    (gnus-message 5 "Checking bogus newsgroups...")
-    (unless (gnus-read-active-file-p)
-      (gnus-read-active-file))
-    (when (gnus-read-active-file-p)
-      ;; Find all bogus newsgroup that are subscribed.
-      (while newsrc
-	(setq info (pop newsrc)
-	      group (gnus-info-group info))
-	(unless (or (gnus-active group)	; Active
-		    (gnus-info-method info) ; Foreign
-		    (and confirm
-			 (not (gnus-y-or-n-p
-			       (format "Remove bogus newsgroup: %s " group)))))
-	  ;; Found a bogus newsgroup.
-	  (push group bogus)))
-      ;; Remove all bogus subscribed groups by first killing them, and
-      ;; then removing them from the list of killed groups.
-      (while bogus
-	(when (setq entry (gnus-gethash (setq group (pop bogus))
-					gnus-newsrc-hashtb))
-	  (gnus-group-change-level entry gnus-level-killed)
-	  (setq gnus-killed-list (delete group gnus-killed-list))))
-      ;; Then we remove all bogus groups from the list of killed and
-      ;; zombie groups.  They are are removed without confirmation.
-      (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
-	    killed)
-	(while dead-lists
-	  (setq killed (symbol-value (car dead-lists)))
-	  (while killed
-	    (unless (gnus-active (setq group (pop killed)))
-	      ;; The group is bogus.
-	      ;; !!!Slow as hell.
-	      (set (car dead-lists)
-		   (delete group (symbol-value (car dead-lists))))))
-	  (setq dead-lists (cdr dead-lists))))
-      (gnus-message 5 "Checking bogus newsgroups...done"))))
-
-(defun gnus-check-duplicate-killed-groups ()
-  "Remove duplicates from the list of killed groups."
-  (interactive)
-  (let ((killed gnus-killed-list))
-    (while killed
-      (gnus-message 9 "%d" (length killed))
-      (setcdr killed (delete (car killed) (cdr killed)))
-      (setq killed (cdr killed)))))
-
-;; We want to inline a function from gnus-cache, so we cheat here:
-(eval-when-compile
-  (provide 'gnus)
-  (setq gnus-directory (or (getenv "SAVEDIR") "~/News/"))
-  (require 'gnus-cache))
-
-(defun gnus-get-unread-articles-in-group (info active &optional update)
-  (when active
-    ;; Allow the backend to update the info in the group.
-    (when (and update 
-	       (gnus-request-update-info
-		info (gnus-find-method-for-group (gnus-info-group info))))
-      (gnus-activate-group (gnus-info-group info) nil t))
-    (let* ((range (gnus-info-read info))
-	   (num 0))
-      ;; If a cache is present, we may have to alter the active info.
-      (when (and gnus-use-cache info)
-	(inline (gnus-cache-possibly-alter-active 
-		 (gnus-info-group info) active)))
-      ;; Modify the list of read articles according to what articles
-      ;; are available; then tally the unread articles and add the
-      ;; number to the group hash table entry.
-      (cond
-       ((zerop (cdr active))
-	(setq num 0))
-       ((not range)
-	(setq num (- (1+ (cdr active)) (car active))))
-       ((not (listp (cdr range)))
-	;; Fix a single (num . num) range according to the
-	;; active hash table.
-	;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
-	(and (< (cdr range) (car active)) (setcdr range (1- (car active))))
-	(and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
-	;; Compute number of unread articles.
-	(setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
-       (t
-	;; The read list is a list of ranges.  Fix them according to
-	;; the active hash table.
-	;; First peel off any elements that are below the lower
-	;; active limit.
-	(while (and (cdr range)
-		    (>= (car active)
-			(or (and (atom (cadr range)) (cadr range))
-			    (caadr range))))
-	  (if (numberp (car range))
-	      (setcar range
-		      (cons (car range)
-			    (or (and (numberp (cadr range))
-				     (cadr range))
-				(cdadr range))))
-	    (setcdr (car range)
-		    (or (and (numberp (nth 1 range)) (nth 1 range))
-			(cdadr range))))
-	  (setcdr range (cddr range)))
-	;; Adjust the first element to be the same as the lower limit.
-	(if (and (not (atom (car range)))
-		 (< (cdar range) (car active)))
-	    (setcdr (car range) (1- (car active))))
-	;; Then we want to peel off any elements that are higher
-	;; than the upper active limit.
-	(let ((srange range))
-	  ;; Go past all legal elements.
-	  (while (and (cdr srange)
-		      (<= (or (and (atom (cadr srange))
-				   (cadr srange))
-			      (caadr srange)) (cdr active)))
-	    (setq srange (cdr srange)))
-	  (if (cdr srange)
-	      ;; Nuke all remaining illegal elements.
-	      (setcdr srange nil))
-
-	  ;; Adjust the final element.
-	  (if (and (not (atom (car srange)))
-		   (> (cdar srange) (cdr active)))
-	      (setcdr (car srange) (cdr active))))
-	;; Compute the number of unread articles.
-	(while range
-	  (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
-				      (cdar range)))
-			      (or (and (atom (car range)) (car range))
-				  (caar range)))))
-	  (setq range (cdr range)))
-	(setq num (max 0 (- (cdr active) num)))))
-      ;; Set the number of unread articles.
-      (when info
-	(setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
-      num)))
-
-;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
-;; and compute how many unread articles there are in each group.
-(defun gnus-get-unread-articles (&optional level)
-  (let* ((newsrc (cdr gnus-newsrc-alist))
-	 (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
-	 (foreign-level
-	  (min
-	   (cond ((and gnus-activate-foreign-newsgroups
-		       (not (numberp gnus-activate-foreign-newsgroups)))
-		  (1+ gnus-level-subscribed))
-		 ((numberp gnus-activate-foreign-newsgroups)
-		  gnus-activate-foreign-newsgroups)
-		 (t 0))
-	   level))
-	 info group active method)
-    (gnus-message 5 "Checking new news...")
-
-    (while newsrc
-      (setq active (gnus-active (setq group (gnus-info-group
-					     (setq info (pop newsrc))))))
-
-      ;; Check newsgroups.  If the user doesn't want to check them, or
-      ;; they can't be checked (for instance, if the news server can't
-      ;; be reached) we just set the number of unread articles in this
-      ;; newsgroup to t.  This means that Gnus thinks that there are
-      ;; unread articles, but it has no idea how many.
-      (if (and (setq method (gnus-info-method info))
-	       (not (gnus-server-equal
-		     gnus-select-method
-		     (setq method (gnus-server-get-method nil method))))
-	       (not (gnus-secondary-method-p method)))
-	  ;; These groups are foreign.  Check the level.
-	  (when (<= (gnus-info-level info) foreign-level)
-	    (setq active (gnus-activate-group group 'scan))
-	    (unless (inline (gnus-virtual-group-p group))
-	      (inline (gnus-close-group group)))
-	    (when (fboundp (intern (concat (symbol-name (car method))
-					   "-request-update-info")))
-	      (inline (gnus-request-update-info info method))))
-	;; These groups are native or secondary.
-	(when (and (<= (gnus-info-level info) level)
-		   (not gnus-read-active-file))
-	  (setq active (gnus-activate-group group 'scan))
-	  (inline (gnus-close-group group))))
-
-      ;; Get the number of unread articles in the group.
-      (if active
-	  (inline (gnus-get-unread-articles-in-group info active))
-	;; The group couldn't be reached, so we nix out the number of
-	;; unread articles and stuff.
-	(gnus-set-active group nil)
-	(setcar (gnus-gethash group gnus-newsrc-hashtb) t)))
-
-    (gnus-message 5 "Checking new news...done")))
-
-;; Create a hash table out of the newsrc alist.  The `car's of the
-;; alist elements are used as keys.
-(defun gnus-make-hashtable-from-newsrc-alist ()
-  (let ((alist gnus-newsrc-alist)
-	(ohashtb gnus-newsrc-hashtb)
-	prev)
-    (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
-    (setq alist
-	  (setq prev (setq gnus-newsrc-alist
-			   (if (equal (caar gnus-newsrc-alist)
-				      "dummy.group")
-			       gnus-newsrc-alist
-			     (cons (list "dummy.group" 0 nil) alist)))))
-    (while alist
-      (gnus-sethash
-       (caar alist)
-       (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
-	     prev)
-       gnus-newsrc-hashtb)
-      (setq prev alist
-	    alist (cdr alist)))))
-
-(defun gnus-make-hashtable-from-killed ()
-  "Create a hash table from the killed and zombie lists."
-  (let ((lists '(gnus-killed-list gnus-zombie-list))
-	list)
-    (setq gnus-killed-hashtb
-	  (gnus-make-hashtable
-	   (+ (length gnus-killed-list) (length gnus-zombie-list))))
-    (while (setq list (pop lists))
-      (setq list (symbol-value list))
-      (while list
-	(gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
-
-(defun gnus-activate-group (group &optional scan dont-check method)
-  ;; Check whether a group has been activated or not.
-  ;; If SCAN, request a scan of that group as well.
-  (let ((method (or method (gnus-find-method-for-group group)))
-	active)
-    (and (gnus-check-server method)
-	 ;; We escape all bugs and quit here to make it possible to
-	 ;; continue if a group is so out-there that it reports bugs
-	 ;; and stuff.
-	 (progn
-	   (and scan
-		(gnus-check-backend-function 'request-scan (car method))
-		(gnus-request-scan group method))
-	   t)
-	 (condition-case ()
-	     (gnus-request-group group dont-check method)
-	;   (error nil)
-	   (quit nil))
-	 (save-excursion
-	   (set-buffer nntp-server-buffer)
-	   (goto-char (point-min))
-	   ;; Parse the result we got from `gnus-request-group'.
-	   (and (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
-		(progn
-		  (goto-char (match-beginning 1))
-		  (gnus-set-active
-		   group (setq active (cons (read (current-buffer))
-					    (read (current-buffer)))))
-		  ;; Return the new active info.
-		  active))))))
-
-(defun gnus-update-read-articles (group unread)
-  "Update the list of read and ticked articles in GROUP using the
-UNREAD and TICKED lists.
-Note: UNSELECTED has to be sorted over `<'.
-Returns whether the updating was successful."
-  (let* ((active (or gnus-newsgroup-active (gnus-active group)))
-	 (entry (gnus-gethash group gnus-newsrc-hashtb))
-	 (info (nth 2 entry))
-	 (prev 1)
-	 (unread (sort (copy-sequence unread) '<))
-	 read)
-    (if (or (not info) (not active))
-	;; There is no info on this group if it was, in fact,
-	;; killed.  Gnus stores no information on killed groups, so
-	;; there's nothing to be done.
-	;; One could store the information somewhere temporarily,
-	;; perhaps...  Hmmm...
-	()
-      ;; Remove any negative articles numbers.
-      (while (and unread (< (car unread) 0))
-	(setq unread (cdr unread)))
-      ;; Remove any expired article numbers
-      (while (and unread (< (car unread) (car active)))
-	(setq unread (cdr unread)))
-      ;; Compute the ranges of read articles by looking at the list of
-      ;; unread articles.
-      (while unread
-	(if (/= (car unread) prev)
-	    (setq read (cons (if (= prev (1- (car unread))) prev
-			       (cons prev (1- (car unread)))) read)))
-	(setq prev (1+ (car unread)))
-	(setq unread (cdr unread)))
-      (when (<= prev (cdr active))
-	(setq read (cons (cons prev (cdr active)) read)))
-      ;; Enter this list into the group info.
-      (gnus-info-set-read
-       info (if (> (length read) 1) (nreverse read) read))
-      ;; Set the number of unread articles in gnus-newsrc-hashtb.
-      (gnus-get-unread-articles-in-group info (gnus-active group))
-      t)))
-
-(defun gnus-make-articles-unread (group articles)
-  "Mark ARTICLES in GROUP as unread."
-  (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
-			  (gnus-gethash (gnus-group-real-name group)
-					gnus-newsrc-hashtb))))
-	 (ranges (gnus-info-read info))
-	 news article)
-    (while articles
-      (when (gnus-member-of-range
-	     (setq article (pop articles)) ranges)
-	(setq news (cons article news))))
-    (when news
-      (gnus-info-set-read
-       info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
-      (gnus-group-update-group group t))))
-
-;; Enter all dead groups into the hashtb.
-(defun gnus-update-active-hashtb-from-killed ()
-  (let ((hashtb (setq gnus-active-hashtb (make-vector 4095 0)))
-	(lists (list gnus-killed-list gnus-zombie-list))
-	killed)
-    (while lists
-      (setq killed (car lists))
-      (while killed
-	(gnus-sethash (car killed) nil hashtb)
-	(setq killed (cdr killed)))
-      (setq lists (cdr lists)))))
-
-(defun gnus-get-killed-groups ()
-  "Go through the active hashtb and all all unknown groups as killed."
-  ;; First make sure active file has been read.
-  (unless (gnus-read-active-file-p)
-    (let ((gnus-read-active-file t))
-      (gnus-read-active-file)))
-  (or gnus-killed-hashtb (gnus-make-hashtable-from-killed))
-  ;; Go through all newsgroups that are known to Gnus - enlarge kill list.
-  (mapatoms
-   (lambda (sym)
-     (let ((groups 0)
-	   (group (symbol-name sym)))
-       (if (or (null group)
-	       (gnus-gethash group gnus-killed-hashtb)
-	       (gnus-gethash group gnus-newsrc-hashtb))
-	   ()
-	 (let ((do-sub (gnus-matches-options-n group)))
-	   (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
-	       ()
-	     (setq groups (1+ groups))
-	     (setq gnus-killed-list
-		   (cons group gnus-killed-list))
-	     (gnus-sethash group group gnus-killed-hashtb))))))
-   gnus-active-hashtb))
-
-;; Get the active file(s) from the backend(s).
-(defun gnus-read-active-file ()
-  (gnus-group-set-mode-line)
-  (let ((methods 
-	 (append
-	  (if (gnus-check-server gnus-select-method)
-	      ;; The native server is available.
-	      (cons gnus-select-method gnus-secondary-select-methods)
-	    ;; The native server is down, so we just do the
-	    ;; secondary ones.
-	    gnus-secondary-select-methods)
-	  ;; Also read from the archive server.
-	  (when (gnus-archive-server-wanted-p)
-	    (list "archive"))))
-	list-type)
-    (setq gnus-have-read-active-file nil)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (while methods
-	(let* ((method (if (stringp (car methods))
-			   (gnus-server-get-method nil (car methods))
-			 (car methods)))
-	       (where (nth 1 method))
-	       (mesg (format "Reading active file%s via %s..."
-			     (if (and where (not (zerop (length where))))
-				 (concat " from " where) "")
-			     (car method))))
-	  (gnus-message 5 mesg)
-	  (when (gnus-check-server method)
-	    ;; Request that the backend scan its incoming messages.
-	    (and (gnus-check-backend-function 'request-scan (car method))
-		 (gnus-request-scan nil method))
-	    (cond
-	     ((and (eq gnus-read-active-file 'some)
-		   (gnus-check-backend-function 'retrieve-groups (car method)))
-	      (let ((newsrc (cdr gnus-newsrc-alist))
-		    (gmethod (gnus-server-get-method nil method))
-		    groups info)
-		(while (setq info (pop newsrc))
-		  (when (gnus-server-equal
-			 (gnus-find-method-for-group 
-			  (gnus-info-group info) info)
-			 gmethod)
-		    (push (gnus-group-real-name (gnus-info-group info)) 
-			  groups)))
-		(when groups
-		  (gnus-check-server method)
-		  (setq list-type (gnus-retrieve-groups groups method))
-		  (cond
-		   ((not list-type)
-		    (gnus-error
-		     1.2 "Cannot read partial active file from %s server."
-		     (car method)))
-		   ((eq list-type 'active)
-		    (gnus-active-to-gnus-format method gnus-active-hashtb))
-		   (t
-		    (gnus-groups-to-gnus-format method gnus-active-hashtb))))))
-	     (t
-	      (if (not (gnus-request-list method))
-		  (unless (equal method gnus-message-archive-method)
-		    (gnus-error 1 "Cannot read active file from %s server."
-				(car method)))
-		(gnus-message 5 mesg)
-		(gnus-active-to-gnus-format method gnus-active-hashtb)
-		;; We mark this active file as read.
-		(push method gnus-have-read-active-file)
-		(gnus-message 5 "%sdone" mesg))))))
-	(setq methods (cdr methods))))))
-
-;; Read an active file and place the results in `gnus-active-hashtb'.
-(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors)
-  (unless method
-    (setq method gnus-select-method))
-  (let ((cur (current-buffer))
-	(hashtb (or hashtb
-		    (if (and gnus-active-hashtb
-			     (not (equal method gnus-select-method)))
-			gnus-active-hashtb
-		      (setq gnus-active-hashtb
-			    (if (equal method gnus-select-method)
-				(gnus-make-hashtable
-				 (count-lines (point-min) (point-max)))
-			      (gnus-make-hashtable 4096)))))))
-    ;; Delete unnecessary lines.
-    (goto-char (point-min))
-    (while (search-forward "\nto." nil t)
-      (delete-region (1+ (match-beginning 0))
-		     (progn (forward-line 1) (point))))
-    (or (string= gnus-ignored-newsgroups "")
-	(progn
-	  (goto-char (point-min))
-	  (delete-matching-lines gnus-ignored-newsgroups)))
-    ;; Make the group names readable as a lisp expression even if they
-    ;; contain special characters.
-    ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
-    (goto-char (point-max))
-    (while (re-search-backward "[][';?()#]" nil t)
-      (insert ?\\))
-    ;; If these are groups from a foreign select method, we insert the
-    ;; group prefix in front of the group names.
-    (and method (not (gnus-server-equal
-		      (gnus-server-get-method nil method)
-		      (gnus-server-get-method nil gnus-select-method)))
-	 (let ((prefix (gnus-group-prefixed-name "" method)))
-	   (goto-char (point-min))
-	   (while (and (not (eobp))
-		       (progn (insert prefix)
-			      (zerop (forward-line 1)))))))
-    ;; Store the active file in a hash table.
-    (goto-char (point-min))
-    (if (string-match "%[oO]" gnus-group-line-format)
-	;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
-	;; If we want information on moderated groups, we use this
-	;; loop...
-	(let* ((mod-hashtb (make-vector 7 0))
-	       (m (intern "m" mod-hashtb))
-	       group max min)
-	  (while (not (eobp))
-	    (condition-case nil
-		(progn
-		  (narrow-to-region (point) (gnus-point-at-eol))
-		  (setq group (let ((obarray hashtb)) (read cur)))
-		  (if (and (numberp (setq max (read cur)))
-			   (numberp (setq min (read cur)))
-			   (progn
-			     (skip-chars-forward " \t")
-			     (not
-			      (or (= (following-char) ?=)
-				  (= (following-char) ?x)
-				  (= (following-char) ?j)))))
-		      (set group (cons min max))
-		    (set group nil))
-		  ;; Enter moderated groups into a list.
-		  (if (eq (let ((obarray mod-hashtb)) (read cur)) m)
-		      (setq gnus-moderated-list
-			    (cons (symbol-name group) gnus-moderated-list))))
-	      (error
-	       (and group
-		    (symbolp group)
-		    (set group nil))))
-	    (widen)
-	    (forward-line 1)))
-      ;; And if we do not care about moderation, we use this loop,
-      ;; which is faster.
-      (let (group max min)
-	(while (not (eobp))
-	  (condition-case ()
-	      (progn
-		(narrow-to-region (point) (gnus-point-at-eol))
-		;; group gets set to a symbol interned in the hash table
-		;; (what a hack!!) - jwz
-		(setq group (let ((obarray hashtb)) (read cur)))
-		(if (and (numberp (setq max (read cur)))
-			 (numberp (setq min (read cur)))
-			 (progn
-			   (skip-chars-forward " \t")
-			   (not
-			    (or (= (following-char) ?=)
-				(= (following-char) ?x)
-				(= (following-char) ?j)))))
-		    (set group (cons min max))
-		  (set group nil)))
-	    (error
-	     (progn
-	       (and group
-		    (symbolp group)
-		    (set group nil))
-	       (or ignore-errors
-		   (gnus-message 3 "Warning - illegal active: %s"
-				 (buffer-substring
-				  (gnus-point-at-bol) (gnus-point-at-eol)))))))
-	  (widen)
-	  (forward-line 1))))))
-
-(defun gnus-groups-to-gnus-format (method &optional hashtb)
-  ;; Parse a "groups" active file.
-  (let ((cur (current-buffer))
-	(hashtb (or hashtb
-		    (if (and method gnus-active-hashtb)
-			gnus-active-hashtb
-		      (setq gnus-active-hashtb
-			    (gnus-make-hashtable
-			     (count-lines (point-min) (point-max)))))))
-	(prefix (and method
-		     (not (gnus-server-equal
-			   (gnus-server-get-method nil method)
-			   (gnus-server-get-method nil gnus-select-method)))
-		     (gnus-group-prefixed-name "" method))))
-
-    (goto-char (point-min))
-    ;; We split this into to separate loops, one with the prefix
-    ;; and one without to speed the reading up somewhat.
-    (if prefix
-	(let (min max opoint group)
-	  (while (not (eobp))
-	    (condition-case ()
-		(progn
-		  (read cur) (read cur)
-		  (setq min (read cur)
-			max (read cur)
-			opoint (point))
-		  (skip-chars-forward " \t")
-		  (insert prefix)
-		  (goto-char opoint)
-		  (set (let ((obarray hashtb)) (read cur))
-		       (cons min max)))
-	      (error (and group (symbolp group) (set group nil))))
-	    (forward-line 1)))
-      (let (min max group)
-	(while (not (eobp))
-	  (condition-case ()
-	      (if (= (following-char) ?2)
-		  (progn
-		    (read cur) (read cur)
-		    (setq min (read cur)
-			  max (read cur))
-		    (set (setq group (let ((obarray hashtb)) (read cur)))
-			 (cons min max))))
-	    (error (and group (symbolp group) (set group nil))))
-	  (forward-line 1))))))
-
-(defun gnus-read-newsrc-file (&optional force)
-  "Read startup file.
-If FORCE is non-nil, the .newsrc file is read."
-  ;; Reset variables that might be defined in the .newsrc.eld file.
-  (let ((variables gnus-variable-list))
-    (while variables
-      (set (car variables) nil)
-      (setq variables (cdr variables))))
-  (let* ((newsrc-file gnus-current-startup-file)
-	 (quick-file (concat newsrc-file ".el")))
-    (save-excursion
-      ;; We always load the .newsrc.eld file.  If always contains
-      ;; much information that can not be gotten from the .newsrc
-      ;; file (ticked articles, killed groups, foreign methods, etc.)
-      (gnus-read-newsrc-el-file quick-file)
-
-      (if (and (file-exists-p gnus-current-startup-file)
-	       (or force
-		   (and (file-newer-than-file-p newsrc-file quick-file)
-			(file-newer-than-file-p newsrc-file
-						(concat quick-file "d")))
-		   (not gnus-newsrc-alist)))
-	  ;; We read the .newsrc file.  Note that if there if a
-	  ;; .newsrc.eld file exists, it has already been read, and
-	  ;; the `gnus-newsrc-hashtb' has been created.  While reading
-	  ;; the .newsrc file, Gnus will only use the information it
-	  ;; can find there for changing the data already read -
-	  ;; ie. reading the .newsrc file will not trash the data
-	  ;; already read (except for read articles).
-	  (save-excursion
-	    (gnus-message 5 "Reading %s..." newsrc-file)
-	    (set-buffer (find-file-noselect newsrc-file))
-	    (buffer-disable-undo (current-buffer))
-	    (gnus-newsrc-to-gnus-format)
-	    (kill-buffer (current-buffer))
-	    (gnus-message 5 "Reading %s...done" newsrc-file)))
-
-      ;; Read any slave files.
-      (unless gnus-slave
-	(gnus-master-read-slave-newsrc))
-      
-      ;; Convert old to new.
-      (gnus-convert-old-newsrc))))
-
-(defun gnus-continuum-version (version)
-  "Return VERSION as a floating point number."
-  (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
-	    (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
-    (let* ((alpha (and (match-beginning 1) (match-string 1 version)))
-	   (number (match-string 2 version))
-	   major minor least)
-      (string-match "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
-      (setq major (string-to-number (match-string 1 number)))
-      (setq minor (string-to-number (match-string 2 number)))
-      (setq least (if (match-beginning 3)
-		      (string-to-number (match-string 3 number))
-		    0))
-      (string-to-number
-       (if (zerop major)
-	   (format "%s00%02d%02d"
-		   (cond 
-		    ((member alpha '("(ding)" "d")) "4.99")
-		    ((member alpha '("September" "s")) "5.01")
-		    ((member alpha '("Red" "r")) "5.03"))
-		   minor least)
-	 (format "%d.%02d%02d" major minor least))))))
-
-(defun gnus-convert-old-newsrc ()
-  "Convert old newsrc into the new format, if needed."
-  (let ((fcv (and gnus-newsrc-file-version
-		  (gnus-continuum-version gnus-newsrc-file-version))))
-    (cond
-     ;; No .newsrc.eld file was loaded.
-     ((null fcv) nil)
-     ;; Gnus 5 .newsrc.eld was loaded.
-     ((< fcv (gnus-continuum-version "September Gnus v0.1"))
-      (gnus-convert-old-ticks)))))
-
-(defun gnus-convert-old-ticks ()
-  (let ((newsrc (cdr gnus-newsrc-alist))
-	marks info dormant ticked)
-    (while (setq info (pop newsrc))
-      (when (setq marks (gnus-info-marks info))
-	(setq dormant (cdr (assq 'dormant marks))
-	      ticked (cdr (assq 'tick marks)))
-	(when (or dormant ticked)
-	  (gnus-info-set-read
-	   info
-	   (gnus-add-to-range
-	    (gnus-info-read info)
-	    (nconc (gnus-uncompress-range dormant)
-		   (gnus-uncompress-range ticked)))))))))
-
-(defun gnus-read-newsrc-el-file (file)
-  (let ((ding-file (concat file "d")))
-    ;; We always, always read the .eld file.
-    (gnus-message 5 "Reading %s..." ding-file)
-    (let (gnus-newsrc-assoc)
-      (condition-case nil
-	  (load ding-file t t t)
-	(error
-	 (gnus-error 1 "Error in %s" ding-file)))
-      (when gnus-newsrc-assoc
-	(setq gnus-newsrc-alist gnus-newsrc-assoc)))
-    (gnus-make-hashtable-from-newsrc-alist)
-    (when (file-newer-than-file-p file ding-file)
-      ;; Old format quick file
-      (gnus-message 5 "Reading %s..." file)
-      ;; The .el file is newer than the .eld file, so we read that one
-      ;; as well.
-      (gnus-read-old-newsrc-el-file file))))
-
-;; Parse the old-style quick startup file
-(defun gnus-read-old-newsrc-el-file (file)
-  (let (newsrc killed marked group m info)
-    (prog1
-	(let ((gnus-killed-assoc nil)
-	      gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
-	  (prog1
-	      (condition-case nil
-		  (load file t t t)
-		(error nil))
-	    (setq newsrc gnus-newsrc-assoc
-		  killed gnus-killed-assoc
-		  marked gnus-marked-assoc)))
-      (setq gnus-newsrc-alist nil)
-      (while (setq group (pop newsrc))
-	(if (setq info (gnus-get-info (car group)))
-	    (progn
-	      (gnus-info-set-read info (cddr group))
-	      (gnus-info-set-level
-	       info (if (nth 1 group) gnus-level-default-subscribed
-		      gnus-level-default-unsubscribed))
-	      (setq gnus-newsrc-alist (cons info gnus-newsrc-alist)))
-	  (push (setq info
-		      (list (car group)
-			    (if (nth 1 group) gnus-level-default-subscribed
-			      gnus-level-default-unsubscribed)
-			    (cddr group)))
-		gnus-newsrc-alist))
-	;; Copy marks into info.
-	(when (setq m (assoc (car group) marked))
-	  (unless (nthcdr 3 info)
-	    (nconc info (list nil)))
-	  (gnus-info-set-marks
-	   info (list (cons 'tick (gnus-compress-sequence 
-				   (sort (cdr m) '<) t))))))
-      (setq newsrc killed)
-      (while newsrc
-	(setcar newsrc (caar newsrc))
-	(setq newsrc (cdr newsrc)))
-      (setq gnus-killed-list killed))
-    ;; The .el file version of this variable does not begin with
-    ;; "options", while the .eld version does, so we just add it if it
-    ;; isn't there.
-    (and
-     gnus-newsrc-options
-     (progn
-       (and (not (string-match "^ *options" gnus-newsrc-options))
-	    (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
-       (and (not (string-match "\n$" gnus-newsrc-options))
-	    (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
-       ;; Finally, if we read some options lines, we parse them.
-       (or (string= gnus-newsrc-options "")
-	   (gnus-newsrc-parse-options gnus-newsrc-options))))
-
-    (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
-    (gnus-make-hashtable-from-newsrc-alist)))
-
-(defun gnus-make-newsrc-file (file)
-  "Make server dependent file name by catenating FILE and server host name."
-  (let* ((file (expand-file-name file nil))
-	 (real-file (concat file "-" (nth 1 gnus-select-method))))
-    (if (or (file-exists-p real-file)
-	    (file-exists-p (concat real-file ".el"))
-	    (file-exists-p (concat real-file ".eld")))
-	real-file file)))
-
-(defun gnus-newsrc-to-gnus-format ()
-  (setq gnus-newsrc-options "")
-  (setq gnus-newsrc-options-n nil)
-
-  (or gnus-active-hashtb
-      (setq gnus-active-hashtb (make-vector 4095 0)))
-  (let ((buf (current-buffer))
-	(already-read (> (length gnus-newsrc-alist) 1))
-	group subscribed options-symbol newsrc Options-symbol
-	symbol reads num1)
-    (goto-char (point-min))
-    ;; We intern the symbol `options' in the active hashtb so that we
-    ;; can `eq' against it later.
-    (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
-    (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
-
-    (while (not (eobp))
-      ;; We first read the first word on the line by narrowing and
-      ;; then reading into `gnus-active-hashtb'.  Most groups will
-      ;; already exist in that hashtb, so this will save some string
-      ;; space.
-      (narrow-to-region
-       (point)
-       (progn (skip-chars-forward "^ \t!:\n") (point)))
-      (goto-char (point-min))
-      (setq symbol
-	    (and (/= (point-min) (point-max))
-		 (let ((obarray gnus-active-hashtb)) (read buf))))
-      (widen)
-      ;; Now, the symbol we have read is either `options' or a group
-      ;; name.  If it is an options line, we just add it to a string.
-      (cond
-       ((or (eq symbol options-symbol)
-	    (eq symbol Options-symbol))
-	(setq gnus-newsrc-options
-	      ;; This concating is quite inefficient, but since our
-	      ;; thorough studies show that approx 99.37% of all
-	      ;; .newsrc files only contain a single options line, we
-	      ;; don't give a damn, frankly, my dear.
-	      (concat gnus-newsrc-options
-		      (buffer-substring
-		       (gnus-point-at-bol)
-		       ;; Options may continue on the next line.
-		       (or (and (re-search-forward "^[^ \t]" nil 'move)
-				(progn (beginning-of-line) (point)))
-			   (point)))))
-	(forward-line -1))
-       (symbol
-	;; Group names can be just numbers.  
-	(when (numberp symbol) 
-	  (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
-	(or (boundp symbol) (set symbol nil))
-	;; It was a group name.
-	(setq subscribed (= (following-char) ?:)
-	      group (symbol-name symbol)
-	      reads nil)
-	(if (eolp)
-	    ;; If the line ends here, this is clearly a buggy line, so
-	    ;; we put point a the beginning of line and let the cond
-	    ;; below do the error handling.
-	    (beginning-of-line)
-	  ;; We skip to the beginning of the ranges.
-	  (skip-chars-forward "!: \t"))
-	;; We are now at the beginning of the list of read articles.
-	;; We read them range by range.
-	(while
-	    (cond
-	     ((looking-at "[0-9]+")
-	      ;; We narrow and read a number instead of buffer-substring/
-	      ;; string-to-int because it's faster.  narrow/widen is
-	      ;; faster than save-restriction/narrow, and save-restriction
-	      ;; produces a garbage object.
-	      (setq num1 (progn
-			   (narrow-to-region (match-beginning 0) (match-end 0))
-			   (read buf)))
-	      (widen)
-	      ;; If the next character is a dash, then this is a range.
-	      (if (= (following-char) ?-)
-		  (progn
-		    ;; We read the upper bound of the range.
-		    (forward-char 1)
-		    (if (not (looking-at "[0-9]+"))
-			;; This is a buggy line, by we pretend that
-			;; it's kinda OK.  Perhaps the user should be
-			;; dinged?
-			(setq reads (cons num1 reads))
-		      (setq reads
-			    (cons
-			     (cons num1
-				   (progn
-				     (narrow-to-region (match-beginning 0)
-						       (match-end 0))
-				     (read buf)))
-			     reads))
-		      (widen)))
-		;; It was just a simple number, so we add it to the
-		;; list of ranges.
-		(setq reads (cons num1 reads)))
-	      ;; If the next char in ?\n, then we have reached the end
-	      ;; of the line and return nil.
-	      (/= (following-char) ?\n))
-	     ((= (following-char) ?\n)
-	      ;; End of line, so we end.
-	      nil)
-	     (t
-	      ;; Not numbers and not eol, so this might be a buggy
-	      ;; line...
-	      (or (eobp)
-		  ;; If it was eob instead of ?\n, we allow it.
-		  (progn
-		    ;; The line was buggy.
-		    (setq group nil)
-		    (gnus-error 3.1 "Mangled line: %s"
-				(buffer-substring (gnus-point-at-bol)
-						  (gnus-point-at-eol)))))
-	      nil))
-	  ;; Skip past ", ".  Spaces are illegal in these ranges, but
-	  ;; we allow them, because it's a common mistake to put a
-	  ;; space after the comma.
-	  (skip-chars-forward ", "))
-
-	;; We have already read .newsrc.eld, so we gently update the
-	;; data in the hash table with the information we have just
-	;; read.
-	(when group
-	  (let ((info (gnus-get-info group))
-		level)
-	    (if info
-		;; There is an entry for this file in the alist.
-		(progn
-		  (gnus-info-set-read info (nreverse reads))
-		  ;; We update the level very gently.  In fact, we
-		  ;; only change it if there's been a status change
-		  ;; from subscribed to unsubscribed, or vice versa.
-		  (setq level (gnus-info-level info))
-		  (cond ((and (<= level gnus-level-subscribed)
-			      (not subscribed))
-			 (setq level (if reads
-					 gnus-level-default-unsubscribed
-				       (1+ gnus-level-default-unsubscribed))))
-			((and (> level gnus-level-subscribed) subscribed)
-			 (setq level gnus-level-default-subscribed)))
-		  (gnus-info-set-level info level))
-	      ;; This is a new group.
-	      (setq info (list group
-			       (if subscribed
-				   gnus-level-default-subscribed
-				 (if reads
-				     (1+ gnus-level-subscribed)
-				   gnus-level-default-unsubscribed))
-			       (nreverse reads))))
-	    (setq newsrc (cons info newsrc))))))
-      (forward-line 1))
-
-    (setq newsrc (nreverse newsrc))
-
-    (if (not already-read)
-	()
-      ;; We now have two newsrc lists - `newsrc', which is what we
-      ;; have read from .newsrc, and `gnus-newsrc-alist', which is
-      ;; what we've read from .newsrc.eld.  We have to merge these
-      ;; lists.  We do this by "attaching" any (foreign) groups in the
-      ;; gnus-newsrc-alist to the (native) group that precedes them.
-      (let ((rc (cdr gnus-newsrc-alist))
-	    (prev gnus-newsrc-alist)
-	    entry mentry)
-	(while rc
-	  (or (null (nth 4 (car rc)))	; It's a native group.
-	      (assoc (caar rc) newsrc) ; It's already in the alist.
-	      (if (setq entry (assoc (caar prev) newsrc))
-		  (setcdr (setq mentry (memq entry newsrc))
-			  (cons (car rc) (cdr mentry)))
-		(setq newsrc (cons (car rc) newsrc))))
-	  (setq prev rc
-		rc (cdr rc)))))
-
-    (setq gnus-newsrc-alist newsrc)
-    ;; We make the newsrc hashtb.
-    (gnus-make-hashtable-from-newsrc-alist)
-
-    ;; Finally, if we read some options lines, we parse them.
-    (or (string= gnus-newsrc-options "")
-	(gnus-newsrc-parse-options gnus-newsrc-options))))
-
-;; Parse options lines to find "options -n !all rec.all" and stuff.
-;; The return value will be a list on the form
-;; ((regexp1 . ignore)
-;;  (regexp2 . subscribe)...)
-;; When handling new newsgroups, groups that match a `ignore' regexp
-;; will be ignored, and groups that match a `subscribe' regexp will be
-;; subscribed.  A line like
-;; options -n !all rec.all
-;; will lead to a list that looks like
-;; (("^rec\\..+" . subscribe)
-;;  ("^.+" . ignore))
-;; So all "rec.*" groups will be subscribed, while all the other
-;; groups will be ignored.  Note that "options -n !all rec.all" is very
-;; different from "options -n rec.all !all".
-(defun gnus-newsrc-parse-options (options)
-  (let (out eol)
-    (save-excursion
-      (gnus-set-work-buffer)
-      (insert (regexp-quote options))
-      ;; First we treat all continuation lines.
-      (goto-char (point-min))
-      (while (re-search-forward "\n[ \t]+" nil t)
-	(replace-match " " t t))
-      ;; Then we transform all "all"s into ".+"s.
-      (goto-char (point-min))
-      (while (re-search-forward "\\ball\\b" nil t)
-	(replace-match ".+" t t))
-      (goto-char (point-min))
-      ;; We remove all other options than the "-n" ones.
-      (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
-	(replace-match " ")
-	(forward-char -1))
-      (goto-char (point-min))
-
-      ;; We are only interested in "options -n" lines - we
-      ;; ignore the other option lines.
-      (while (re-search-forward "[ \t]-n" nil t)
-	(setq eol
-	      (or (save-excursion
-		    (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
-			 (- (point) 2)))
-		  (gnus-point-at-eol)))
-	;; Search for all "words"...
-	(while (re-search-forward "[^ \t,\n]+" eol t)
-	  (if (= (char-after (match-beginning 0)) ?!)
-	      ;; If the word begins with a bang (!), this is a "not"
-	      ;; spec.  We put this spec (minus the bang) and the
-	      ;; symbol `ignore' into the list.
-	      (setq out (cons (cons (concat
-				     "^" (buffer-substring
-					  (1+ (match-beginning 0))
-					  (match-end 0)))
-				    'ignore) out))
-	    ;; There was no bang, so this is a "yes" spec.
-	    (setq out (cons (cons (concat "^" (match-string 0))
-				  'subscribe) out)))))
-
-      (setq gnus-newsrc-options-n out))))
-
-(defun gnus-save-newsrc-file (&optional force)
-  "Save .newsrc file."
-  ;; Note: We cannot save .newsrc file if all newsgroups are removed
-  ;; from the variable gnus-newsrc-alist.
-  (when (and (or gnus-newsrc-alist gnus-killed-list)
-	     gnus-current-startup-file)
-    (save-excursion
-      (if (and (or gnus-use-dribble-file gnus-slave)
-	       (not force)
-	       (or (not gnus-dribble-buffer)
-		   (not (buffer-name gnus-dribble-buffer))
-		   (zerop (save-excursion
-			    (set-buffer gnus-dribble-buffer)
-			    (buffer-size)))))
-	  (gnus-message 4 "(No changes need to be saved)")
-	(run-hooks 'gnus-save-newsrc-hook)
-	(if gnus-slave
-	    (gnus-slave-save-newsrc)
-	  ;; Save .newsrc.
-	  (when gnus-save-newsrc-file
-	    (gnus-message 5 "Saving %s..." gnus-current-startup-file)
-	    (gnus-gnus-to-newsrc-format)
-	    (gnus-message 5 "Saving %s...done" gnus-current-startup-file))
-	  ;; Save .newsrc.eld.
-	  (set-buffer (get-buffer-create " *Gnus-newsrc*"))
-	  (make-local-variable 'version-control)
-	  (setq version-control 'never)
-	  (setq buffer-file-name
-		(concat gnus-current-startup-file ".eld"))
-	  (setq default-directory (file-name-directory buffer-file-name))
-	  (gnus-add-current-to-buffer-list)
-	  (buffer-disable-undo (current-buffer))
-	  (erase-buffer)
-	  (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
-	  (gnus-gnus-to-quick-newsrc-format)
-	  (run-hooks 'gnus-save-quick-newsrc-hook)
-	  (save-buffer)
-	  (kill-buffer (current-buffer))
-	  (gnus-message
-	   5 "Saving %s.eld...done" gnus-current-startup-file))
-	(gnus-dribble-delete-file)
-	(gnus-group-set-mode-line)))))
-
-(defun gnus-gnus-to-quick-newsrc-format ()
-  "Insert Gnus variables such as gnus-newsrc-alist in lisp format."
-  (insert ";; Gnus startup file.\n")
-  (insert ";; Never delete this file - touch .newsrc instead to force Gnus\n")
-  (insert ";; to read .newsrc.\n")
-  (insert "(setq gnus-newsrc-file-version "
-	  (prin1-to-string gnus-version) ")\n")
-  (let ((variables
-	 (if gnus-save-killed-list gnus-variable-list
-	   ;; Remove the `gnus-killed-list' from the list of variables
-	   ;; to be saved, if required.
-	   (delq 'gnus-killed-list (copy-sequence gnus-variable-list))))
-	;; Peel off the "dummy" group.
-	(gnus-newsrc-alist (cdr gnus-newsrc-alist))
-	variable)
-    ;; Insert the variables into the file.
-    (while variables
-      (when (and (boundp (setq variable (pop variables)))
-		 (symbol-value variable))
-	(insert "(setq " (symbol-name variable) " '")
-	(prin1 (symbol-value variable) (current-buffer))
-	(insert ")\n")))))
-
-(defun gnus-gnus-to-newsrc-format ()
-  ;; Generate and save the .newsrc file.
-  (save-excursion
-    (set-buffer (create-file-buffer gnus-current-startup-file))
-    (let ((newsrc (cdr gnus-newsrc-alist))
-	  (standard-output (current-buffer))
-	  info ranges range method)
-      (setq buffer-file-name gnus-current-startup-file)
-      (setq default-directory (file-name-directory buffer-file-name))
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      ;; Write options.
-      (if gnus-newsrc-options (insert gnus-newsrc-options))
-      ;; Write subscribed and unsubscribed.
-      (while (setq info (pop newsrc))
-	;; Don't write foreign groups to .newsrc.
-	(when (or (null (setq method (gnus-info-method info)))
-		  (equal method "native")
-		  (gnus-server-equal method gnus-select-method))
-	  (insert (gnus-info-group info)
-		  (if (> (gnus-info-level info) gnus-level-subscribed)
-		      "!" ":"))
-	  (when (setq ranges (gnus-info-read info))
-	    (insert " ")
-	    (if (not (listp (cdr ranges)))
-		(if (= (car ranges) (cdr ranges))
-		    (princ (car ranges))
-		  (princ (car ranges))
-		  (insert "-")
-		  (princ (cdr ranges)))
-	      (while (setq range (pop ranges))
-		(if (or (atom range) (= (car range) (cdr range)))
-		    (princ (or (and (atom range) range) (car range)))
-		  (princ (car range))
-		  (insert "-")
-		  (princ (cdr range)))
-		(if ranges (insert ",")))))
-	  (insert "\n")))
-      (make-local-variable 'version-control)
-      (setq version-control 'never)
-      ;; It has been reported that sometime the modtime on the .newsrc
-      ;; file seems to be off.  We really do want to overwrite it, so
-      ;; we clear the modtime here before saving.  It's a bit odd,
-      ;; though...
-      ;; sometimes the modtime clear isn't sufficient.  most brute force:
-      ;; delete the silly thing entirely first.  but this fails to provide
-      ;; such niceties as .newsrc~ creation.
-      (if gnus-modtime-botch
-	  (delete-file gnus-startup-file)
-	(clear-visited-file-modtime))
-      (run-hooks 'gnus-save-standard-newsrc-hook)
-      (save-buffer)
-      (kill-buffer (current-buffer)))))
-
-
-;;;
-;;; Slave functions.
-;;;
-
-(defun gnus-slave-save-newsrc ()
-  (save-excursion
-    (set-buffer gnus-dribble-buffer)
-    (let ((slave-name
-	   (make-temp-name (concat gnus-current-startup-file "-slave-"))))
-      (write-region (point-min) (point-max) slave-name nil 'nomesg))))
-
-(defun gnus-master-read-slave-newsrc ()
-  (let ((slave-files
-	 (directory-files
-	  (file-name-directory gnus-current-startup-file)
-	  t (concat
-	     "^" (regexp-quote
-		  (concat
-		   (file-name-nondirectory gnus-current-startup-file)
-		   "-slave-")))
-	  t))
-	file)
-    (if (not slave-files)
-	()				; There are no slave files to read.
-      (gnus-message 7 "Reading slave newsrcs...")
-      (save-excursion
-	(set-buffer (get-buffer-create " *gnus slave*"))
-	(buffer-disable-undo (current-buffer))
-	(setq slave-files
-	      (sort (mapcar (lambda (file)
-			      (list (nth 5 (file-attributes file)) file))
-			    slave-files)
-		    (lambda (f1 f2)
-		      (or (< (caar f1) (caar f2))
-			  (< (nth 1 (car f1)) (nth 1 (car f2)))))))
-	(while slave-files
-	  (erase-buffer)
-	  (setq file (nth 1 (car slave-files)))
-	  (insert-file-contents file)
-	  (if (condition-case ()
-		  (progn
-		    (eval-buffer (current-buffer))
-		    t)
-		(error
-		 (gnus-error 3.2 "Possible error in %s" file)
-		 nil))
-	      (or gnus-slave ; Slaves shouldn't delete these files.
-		  (condition-case ()
-		      (delete-file file)
-		    (error nil))))
-	  (setq slave-files (cdr slave-files))))
-      (gnus-message 7 "Reading slave newsrcs...done"))))
-
-
-;;;
-;;; Group description.
-;;;
-
-(defun gnus-read-all-descriptions-files ()
-  (let ((methods (cons gnus-select-method 
-		       (nconc
-			(when (gnus-archive-server-wanted-p)
-			  (list "archive"))
-			gnus-secondary-select-methods))))
-    (while methods
-      (gnus-read-descriptions-file (car methods))
-      (setq methods (cdr methods)))
-    t))
-
-(defun gnus-read-descriptions-file (&optional method)
-  (let ((method (or method gnus-select-method))
-	group)
-    (when (stringp method)
-      (setq method (gnus-server-to-method method)))
-    ;; We create the hashtable whether we manage to read the desc file
-    ;; to avoid trying to re-read after a failed read.
-    (or gnus-description-hashtb
-	(setq gnus-description-hashtb
-	      (gnus-make-hashtable (length gnus-active-hashtb))))
-    ;; Mark this method's desc file as read.
-    (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
-		  gnus-description-hashtb)
-
-    (gnus-message 5 "Reading descriptions file via %s..." (car method))
-    (cond
-     ((not (gnus-check-server method))
-      (gnus-message 1 "Couldn't open server")
-      nil)
-     ((not (gnus-request-list-newsgroups method))
-      (gnus-message 1 "Couldn't read newsgroups descriptions")
-      nil)
-     (t
-      (save-excursion
-	(save-restriction
-	  (set-buffer nntp-server-buffer)
-	  (goto-char (point-min))
-	  (when (or (search-forward "\n.\n" nil t)
-		    (goto-char (point-max)))
-	    (beginning-of-line)
-	    (narrow-to-region (point-min) (point)))
-	  ;; If these are groups from a foreign select method, we insert the
-	  ;; group prefix in front of the group names.
-	  (and method (not (gnus-server-equal
-			    (gnus-server-get-method nil method)
-			    (gnus-server-get-method nil gnus-select-method)))
-	       (let ((prefix (gnus-group-prefixed-name "" method)))
-		 (goto-char (point-min))
-		 (while (and (not (eobp))
-			     (progn (insert prefix)
-				    (zerop (forward-line 1)))))))
-	  (goto-char (point-min))
-	  (while (not (eobp))
-	    ;; If we get an error, we set group to 0, which is not a
-	    ;; symbol...
-	    (setq group
-		  (condition-case ()
-		      (let ((obarray gnus-description-hashtb))
-			;; Group is set to a symbol interned in this
-			;; hash table.
-			(read nntp-server-buffer))
-		    (error 0)))
-	    (skip-chars-forward " \t")
-	    ;; ...  which leads to this line being effectively ignored.
-	    (and (symbolp group)
-		 (set group (buffer-substring
-			     (point) (progn (end-of-line) (point)))))
-	    (forward-line 1))))
-      (gnus-message 5 "Reading descriptions file...done")
-      t))))
-
-(defun gnus-group-get-description (group)
-  "Get the description of a group by sending XGTITLE to the server."
-  (when (gnus-request-group-description group)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (goto-char (point-min))
-      (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
-	(match-string 1)))))
-
-
-;;;
-;;; Buffering of read articles.
-;;;
-
-(defvar gnus-backlog-buffer " *Gnus Backlog*")
-(defvar gnus-backlog-articles nil)
-(defvar gnus-backlog-hashtb nil)
-
-(defun gnus-backlog-buffer ()
-  "Return the backlog buffer."
-  (or (get-buffer gnus-backlog-buffer)
-      (save-excursion
-	(set-buffer (get-buffer-create gnus-backlog-buffer))
-	(buffer-disable-undo (current-buffer))
-	(setq buffer-read-only t)
-	(gnus-add-current-to-buffer-list)
-	(get-buffer gnus-backlog-buffer))))
-
-(defun gnus-backlog-setup ()
-  "Initialize backlog variables."
-  (unless gnus-backlog-hashtb
-    (setq gnus-backlog-hashtb (make-vector 1023 0))))
-
-(gnus-add-shutdown 'gnus-backlog-shutdown 'gnus)
-
-(defun gnus-backlog-shutdown ()
-  "Clear all backlog variables and buffers."
-  (when (get-buffer gnus-backlog-buffer)
-    (kill-buffer gnus-backlog-buffer))
-  (setq gnus-backlog-hashtb nil
-	gnus-backlog-articles nil))
-
-(defun gnus-backlog-enter-article (group number buffer)
-  (gnus-backlog-setup)
-  (let ((ident (intern (concat group ":" (int-to-string number))
-		       gnus-backlog-hashtb))
-	b)
-    (if (memq ident gnus-backlog-articles)
-	() ; It's already kept.
-      ;; Remove the oldest article, if necessary.
-      (and (numberp gnus-keep-backlog)
-	   (>= (length gnus-backlog-articles) gnus-keep-backlog)
-	   (gnus-backlog-remove-oldest-article))
-      (setq gnus-backlog-articles (cons ident gnus-backlog-articles))
-      ;; Insert the new article.
-      (save-excursion
-	(set-buffer (gnus-backlog-buffer))
-	(let (buffer-read-only)
-	  (goto-char (point-max))
-	  (or (bolp) (insert "\n"))
-	  (setq b (point))
-	  (insert-buffer-substring buffer)
-	  ;; Tag the beginning of the article with the ident.
-	  (gnus-put-text-property b (1+ b) 'gnus-backlog ident))))))
-
-(defun gnus-backlog-remove-oldest-article ()
-  (save-excursion
-    (set-buffer (gnus-backlog-buffer))
-    (goto-char (point-min))
-    (if (zerop (buffer-size))
-	() ; The buffer is empty.
-      (let ((ident (get-text-property (point) 'gnus-backlog))
-	    buffer-read-only)
-	;; Remove the ident from the list of articles.
-	(when ident
-	  (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
-	;; Delete the article itself.
-	(delete-region
-	 (point) (next-single-property-change
-		  (1+ (point)) 'gnus-backlog nil (point-max)))))))
-
-(defun gnus-backlog-remove-article (group number)
-  "Remove article NUMBER in GROUP from the backlog."
-  (when (numberp number)
-    (gnus-backlog-setup)
-    (let ((ident (intern (concat group ":" (int-to-string number))
-			 gnus-backlog-hashtb))
-	  beg end)
-      (when (memq ident gnus-backlog-articles)
-	;; It was in the backlog.
-	(save-excursion
-	  (set-buffer (gnus-backlog-buffer))
-	  (let (buffer-read-only)
-	    (when (setq beg (text-property-any
-			     (point-min) (point-max) 'gnus-backlog
-			     ident))
-	      ;; Find the end (i. e., the beginning of the next article).
-	      (setq end
-		    (next-single-property-change
-		     (1+ beg) 'gnus-backlog (current-buffer) (point-max)))
-	      (delete-region beg end)
-	      ;; Return success.
-	      t)))))))
-
-(defun gnus-backlog-request-article (group number buffer)
-  (when (numberp number)
-    (gnus-backlog-setup)
-    (let ((ident (intern (concat group ":" (int-to-string number))
-			 gnus-backlog-hashtb))
-	  beg end)
-      (when (memq ident gnus-backlog-articles)
-	;; It was in the backlog.
-	(save-excursion
-	  (set-buffer (gnus-backlog-buffer))
-	  (if (not (setq beg (text-property-any
-			      (point-min) (point-max) 'gnus-backlog
-			      ident)))
-	      ;; It wasn't in the backlog after all.
-	      (ignore
-	       (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
-	    ;; Find the end (i. e., the beginning of the next article).
-	    (setq end
-		  (next-single-property-change
-		   (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
-	(let ((buffer-read-only nil))
-	  (erase-buffer)
-	  (insert-buffer-substring gnus-backlog-buffer beg end)
-	  t)))))
-
-;; Allow redefinition of Gnus functions.
-
-(gnus-ems-redefine)
-
-(provide 'gnus)
-
-;;; gnus.el ends here
diff --git a/lisp/goto-addr.el b/lisp/goto-addr.el
deleted file mode 100644
index ecf64b3dcfb..00000000000
--- a/lisp/goto-addr.el
+++ /dev/null
@@ -1,241 +0,0 @@
-;;; goto-addr.el --- click to browse URL or to send to e-mail address
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Eric Ding <ericding@mit.edu>
-;; Maintainer: Eric Ding <ericding@mit.edu>
-;; Created: 15 Aug 1995
-;; Keywords: mh-e, www, mouse, mail
-
-;; 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 allows you to click or hit a key sequence while on a
-;; URL or e-mail address, and either load the URL into a browser of
-;; your choice using the browse-url package, or if it's an e-mail
-;; address, to send an e-mail to that address.  By default, we bind to
-;; the [mouse-2] and the [C-c return] key sequences.
-
-;; INSTALLATION
-;;
-;; To use goto-address in a particular mode (for example, while
-;; reading mail in mh-e), add something like this in your .emacs file:
-;; 
-;; (add-hook 'mh-show-mode-hook 'goto-address)
-;;
-;; By default, goto-address now sends using `mail' instead of `mh-send'.
-;; To use mh-e to send mail, add the following to your .emacs file:
-;;
-;; (setq goto-address-mail-method 'goto-address-send-using-mh-e)
-;;
-;; The mouse click method is bound to [mouse-2] on highlighted URL's or
-;; e-mail addresses only; it functions normally everywhere else.  To bind
-;; another mouse click to the function, add the following to your .emacs
-;; (for example):
-;;
-;; (setq goto-address-highlight-keymap
-;;   (let ((m (make-sparse-keymap)))
-;;     (define-key m [S-mouse-2] 'goto-address-at-mouse)
-;;     m))
-;;
-
-;; BUG REPORTS
-;;
-;; Please send bug reports to me at ericding@mit.edu.
-
-;; Known bugs/features:
-;; * goto-address-mail-regexp only catches foo@bar.org style addressing,
-;;   not stuff like X.400 addresses, etc.
-;; * regexp also catches Message-Id line, since it is in the format of
-;;   an Internet e-mail address (like Compuserve addresses)
-;; * If show buffer is fontified after goto-address-fontify is run
-;;   (say, using font-lock-fontify-buffer), then font-lock face will
-;;   override goto-address faces.
-
-;;; Code:
-
-(require 'browse-url)
-
-;;; I don't expect users to want fontify'ing without highlighting.
-(defvar goto-address-fontify-p t
-  "*If t, URL's and e-mail addresses in buffer are fontified.
-But only if `goto-address-highlight-p' is also non-nil.")
-
-(defvar goto-address-highlight-p t
-  "*If t, URL's and e-mail addresses in buffer are highlighted.")
-
-(defvar goto-address-fontify-maximum-size 30000
-  "*Maximum size of file in which to fontify and/or highlight URL's.")
-
-(defvar goto-address-mail-regexp
-  "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
-  "A regular expression probably matching an e-mail address.")
-
-(defvar goto-address-url-regexp
-  (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|"
-	  "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:"
-	  "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*"
-	  "[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
-  "A regular expression probably matching a URL.")
-
-(defvar goto-address-mail-method
-  'goto-address-send-using-mail
-  "*Function to compose mail.
-Two pre-made functions are `goto-address-send-using-mail' (sendmail);
-and `goto-address-send-using-mh-e' (MH-E).")
-
-(defvar goto-address-highlight-keymap
-  (let ((m (make-sparse-keymap)))
-    (define-key m [mouse-2] 'goto-address-at-mouse)
-    m)
-  "keymap to hold goto-addr's mouse key defs under highlighted URLs.")
-
-(defvar goto-address-url-face 'bold
-  "*Face to use for URLs.")
-
-(defvar goto-address-url-mouse-face 'highlight
-  "*Face to use for URLs when the mouse is on them.")
-
-(defvar goto-address-mail-face 'italic
-  "*Face to use for e-mail addresses.")
-
-(defvar goto-address-mail-mouse-face 'secondary-selection
-  "*Face to use for e-mail addresses when the mouse is on them.")
-
-(defun goto-address-fontify ()
-  "Fontify the URL's and e-mail addresses in the current buffer.
-This function implements `goto-address-highlight-p'
-and `goto-address-fontify-p'."
-  (save-excursion
-    (let ((inhibit-read-only t)
-	  (inhibit-point-motion-hooks t)
-	  (modified (buffer-modified-p)))
-      (goto-char (point-min))
-      (if (< (- (point-max) (point)) goto-address-fontify-maximum-size)
-	  (progn
-	    (while (re-search-forward goto-address-url-regexp nil t)
-              (let* ((s (match-beginning 0))
-                     (e (match-end 0))
-                     (this-overlay (make-overlay s e)))
-		(and goto-address-fontify-p
-                     (overlay-put this-overlay 'face goto-address-url-face))
-		(overlay-put this-overlay
-                             'mouse-face goto-address-url-mouse-face)
-		(overlay-put this-overlay
-                             'local-map goto-address-highlight-keymap)))
-	    (goto-char (point-min))
-	    (while (re-search-forward goto-address-mail-regexp nil t)
-              (let* ((s (match-beginning 0))
-                     (e (match-end 0))
-                     (this-overlay (make-overlay s e)))
-		(and goto-address-fontify-p
-                     (overlay-put this-overlay 'face goto-address-mail-face))
-                (overlay-put this-overlay 'mouse-face
-                             goto-address-mail-mouse-face)
-                (overlay-put this-overlay
-                             'local-map goto-address-highlight-keymap)))))
-      (and (buffer-modified-p)
-	   (not modified)
-	   (set-buffer-modified-p nil)))))
-
-;;; code to find and goto addresses; much of this has been blatantly
-;;; snarfed from browse-url.el
-
-;;;###autoload
-(defun goto-address-at-mouse (event)
-  "Send to the e-mail address or load the URL clicked with the mouse.
-Send mail to address at position of mouse click.  See documentation for
-`goto-address-find-address-at-point'.  If no address is found
-there, then load the URL at or before the position of the mouse click."
-  (interactive "e")
-  (save-excursion
-    (let ((posn (event-start event)))
-      (set-buffer (window-buffer (posn-window posn)))
-      (goto-char (posn-point posn))
-      (let ((address
-	     (save-excursion (goto-address-find-address-at-point))))
-	(if (string-equal address "")
-	    (let ((url (browse-url-url-at-point)))
-	      (if (string-equal url "")
-		  (error "No e-mail address or URL found")
-		(funcall browse-url-browser-function url)))
-	  (funcall goto-address-mail-method address))))))
-
-;;;###autoload
-(defun goto-address-at-point ()
-  "Send to the e-mail address or load the URL at point.
-Send mail to address at point.  See documentation for
-`goto-address-find-address-at-point'.  If no address is found
-there, then load the URL at or before point."
-  (interactive)
-  (save-excursion
-    (let ((address (save-excursion (goto-address-find-address-at-point))))
-      (if (string-equal address "")
-	  (let ((url (browse-url-url-at-point)))
-	    (if (string-equal url "")
-		(error "No e-mail address or URL found")
-	      (funcall browse-url-browser-function url)))
-	(funcall goto-address-mail-method address)))))
-
-(defun goto-address-find-address-at-point ()
-  "Find e-mail address around or before point.
-Then search backwards to beginning of line for the start of an e-mail
-address.  If no e-mail address found, return the empty string."
-  (let ((bol (save-excursion (beginning-of-line) (point))))
-    (re-search-backward "[^-_A-z0-9.@]" bol 'lim)
-    (if (or (looking-at goto-address-mail-regexp)  ; already at start
-	    (let ((eol (save-excursion (end-of-line) (point))))
-	      (and (re-search-forward goto-address-mail-regexp eol 'lim)
-		   (goto-char (match-beginning 0)))))
-	(buffer-substring (match-beginning 0) (match-end 0))
-      "")))
-
-(defun goto-address-send-using-mh-e (to)
-  (require 'mh-comp)
-  (mh-find-path)
-  (let ((cc (mh-read-address "Cc: "))
-	(subject (read-string "Subject: "))
-	(config (current-window-configuration)))
-    (delete-other-windows)
-    (mh-send-sub to cc subject config)))
-
-(fset 'goto-address-send-using-mhe 'goto-address-send-using-mh-e)
-
-(defun goto-address-send-using-mail (to)
-  (mail-other-window nil to)
-  (and (goto-char (point-min))
-       (end-of-line 2)))
-
-;;;###autoload
-(defun goto-address ()
-  "Sets up goto-address functionality in the current buffer.
-Allows user to use mouse/keyboard command to click to go to a URL
-or to send e-mail.
-By default, goto-address binds to mouse-2 and C-c RET.
-
-Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
-`goto-address-highlight-p' for more information)."
-  (interactive)
-  (local-set-key "\C-c\r" 'goto-address-at-point)
-  (if goto-address-highlight-p
-      (goto-address-fontify)))
-
-(provide 'goto-addr)
-
-;;; goto-addr.el ends here.
diff --git a/lisp/gud.el b/lisp/gud.el
deleted file mode 100644
index ad279c082d7..00000000000
--- a/lisp/gud.el
+++ /dev/null
@@ -1,1628 +0,0 @@
-;;; gud.el --- Grand Unified Debugger mode for gdb, dbx, etc. under Emacs
-
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: FSF
-;; Keywords: unix, tools
-
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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:
-
-;; The ancestral gdb.el was by W. Schelter <wfs@rascal.ics.utexas.edu>
-;; It was later rewritten by rms.  Some ideas were due to Masanobu. 
-;; Grand Unification (sdb/dbx support) by Eric S. Raymond <esr@thyrsus.com>
-;; The overloading code was then rewritten by Barry Warsaw <bwarsaw@cen.com>,
-;; who also hacked the mode to use comint.el.  Shane Hartman <shane@spr.com>
-;; added support for xdb (HPUX debugger).  Rick Sladkey <jrs@world.std.com>
-;; wrote the GDB command completion code.  Dave Love <d.love@dl.ac.uk>
-;; added the IRIX kluge, re-implemented the Mips-ish variant and added
-;; a menu. Brian D. Carlstrom <bdc@ai.mit.edu> combined the IRIX kluge with 
-;; the gud-xdb-directories hack producing gud-dbx-directories.
-
-;;; Code:
-
-(require 'comint)
-(require 'etags)
-
-;; ======================================================================
-;; GUD commands must be visible in C buffers visited by GUD
-
-(defvar gud-key-prefix "\C-x\C-a"
-  "Prefix of all GUD commands valid in C buffers.")
-
-(global-set-key (concat gud-key-prefix "\C-l") 'gud-refresh)
-(define-key ctl-x-map " " 'gud-break)	;; backward compatibility hack
-
-(defvar gud-marker-filter nil)
-(put 'gud-marker-filter 'permanent-local t)
-(defvar gud-find-file nil)
-(put 'gud-find-file 'permanent-local t)
-
-(defun gud-marker-filter (&rest args)
-  (apply gud-marker-filter args))
-
-(defun gud-find-file (file)
-  ;; Don't get confused by double slashes in the name that comes from GDB.
-  (while (string-match "//+" file)
-    (setq file (replace-match "/" t t file)))
-  (funcall gud-find-file file))
-
-;; Keymap definitions for menu bar entries common to all debuggers and
-;; slots for debugger-dependent ones in sensible places.  (Defined here
-;; before use.)
-(defvar gud-menu-map (make-sparse-keymap "Gud") nil)
-(define-key gud-menu-map [refresh] '("Refresh" . gud-refresh))
-(define-key gud-menu-map [remove] '("Remove Breakpoint" . gud-remove))
-(define-key gud-menu-map [tbreak] nil)	; gdb, sdb and xdb
-(define-key gud-menu-map [break] '("Set Breakpoint" . gud-break))
-(define-key gud-menu-map [up] nil)	; gdb, dbx, and xdb
-(define-key gud-menu-map [down] nil)	; gdb, dbx, and xdb
-(define-key gud-menu-map [print] '("Print Expression" . gud-print))
-(define-key gud-menu-map [finish] nil)	; gdb or xdb
-(define-key gud-menu-map [stepi] '("Step Instruction" . gud-stepi))
-(define-key gud-menu-map [step] '("Step Line" . gud-step))
-(define-key gud-menu-map [next] '("Next Line" . gud-next))
-(define-key gud-menu-map [cont] '("Continue" . gud-cont))
-
-;; ======================================================================
-;; command definition
-
-;; This macro is used below to define some basic debugger interface commands.
-;; Of course you may use `gud-def' with any other debugger command, including
-;; user defined ones.
-
-;; A macro call like (gud-def FUNC NAME KEY DOC) expands to a form
-;; which defines FUNC to send the command NAME to the debugger, gives
-;; it the docstring DOC, and binds that function to KEY in the GUD
-;; major mode.  The function is also bound in the global keymap with the
-;; GUD prefix.
-
-(defmacro gud-def (func cmd key &optional doc)
-  "Define FUNC to be a command sending STR and bound to KEY, with
-optional doc string DOC.  Certain %-escapes in the string arguments
-are interpreted specially if present.  These are:
-
-  %f	name (without directory) of current source file. 
-  %d	directory of current source file. 
-  %l	number of current source line
-  %e	text of the C lvalue or function-call expression surrounding point.
-  %a	text of the hexadecimal address surrounding point
-  %p	prefix argument to the command (if any) as a number
-
-  The `current' source file is the file of the current buffer (if
-we're in a C file) or the source file current at the last break or
-step (if we're in the GUD buffer).
-  The `current' line is that of the current buffer (if we're in a
-source file) or the source line number at the last break or step (if
-we're in the GUD buffer)."
-  (list 'progn
-	(list 'defun func '(arg)
-	      (or doc "")
-	      '(interactive "p")
-	      (list 'gud-call cmd 'arg))
-	(if key
-	    (list 'define-key
-		  '(current-local-map)
-		  (concat "\C-c" key)
-		  (list 'quote func)))
-	(if key
-	    (list 'global-set-key
-		  (list 'concat 'gud-key-prefix key)
-		  (list 'quote func)))))
-
-;; Where gud-display-frame should put the debugging arrow.  This is
-;; set by the marker-filter, which scans the debugger's output for
-;; indications of the current program counter.
-(defvar gud-last-frame nil)
-
-;; Used by gud-refresh, which should cause gud-display-frame to redisplay
-;; the last frame, even if it's been called before and gud-last-frame has
-;; been set to nil.
-(defvar gud-last-last-frame nil)
-
-;; All debugger-specific information is collected here.
-;; Here's how it works, in case you ever need to add a debugger to the mode.
-;;
-;; Each entry must define the following at startup:
-;;
-;;<name>
-;; comint-prompt-regexp
-;; gud-<name>-massage-args
-;; gud-<name>-marker-filter
-;; gud-<name>-find-file
-;;
-;; The job of the massage-args method is to modify the given list of
-;; debugger arguments before running the debugger.
-;;
-;; The job of the marker-filter method is to detect file/line markers in
-;; strings and set the global gud-last-frame to indicate what display
-;; action (if any) should be triggered by the marker.  Note that only
-;; whatever the method *returns* is displayed in the buffer; thus, you
-;; can filter the debugger's output, interpreting some and passing on
-;; the rest.
-;;
-;; The job of the find-file method is to visit and return the buffer indicated
-;; by the car of gud-tag-frame.  This may be a file name, a tag name, or
-;; something else.  It would be good if it also copied the Gud menubar entry.
-
-;; ======================================================================
-;; gdb functions
-
-;;; History of argument lists passed to gdb.
-(defvar gud-gdb-history nil)
-
-(defun gud-gdb-massage-args (file args)
-  (cons "-fullname" args))
-
-(defvar gud-gdb-marker-regexp
-  (concat "\032\032\\([^" path-separator "\n]*\\)" path-separator
-	  "\\([0-9]*\\)" path-separator ".*\n"))
-
-;; There's no guarantee that Emacs will hand the filter the entire
-;; marker at once; it could be broken up across several strings.  We
-;; might even receive a big chunk with several markers in it.  If we
-;; receive a chunk of text which looks like it might contain the
-;; beginning of a marker, we save it here between calls to the
-;; filter.
-(defvar gud-marker-acc "")
-(make-variable-buffer-local 'gud-marker-acc)
-
-(defun gud-gdb-marker-filter (string)
-  (setq gud-marker-acc (concat gud-marker-acc string))
-  (let ((output ""))
-
-    ;; Process all the complete markers in this chunk.
-    (while (string-match gud-gdb-marker-regexp gud-marker-acc)
-      (setq
-
-       ;; Extract the frame position from the marker.
-       gud-last-frame
-       (cons (substring gud-marker-acc (match-beginning 1) (match-end 1))
-	     (string-to-int (substring gud-marker-acc
-				       (match-beginning 2)
-				       (match-end 2))))
-
-       ;; Append any text before the marker to the output we're going
-       ;; to return - we don't include the marker in this text.
-       output (concat output
-		      (substring gud-marker-acc 0 (match-beginning 0)))
-
-       ;; Set the accumulator to the remaining text.
-       gud-marker-acc (substring gud-marker-acc (match-end 0))))
-
-    ;; Does the remaining text look like it might end with the
-    ;; beginning of another marker?  If it does, then keep it in
-    ;; gud-marker-acc until we receive the rest of it.  Since we
-    ;; know the full marker regexp above failed, it's pretty simple to
-    ;; test for marker starts.
-    (if (string-match "\032.*\\'" gud-marker-acc)
-	(progn
-	  ;; Everything before the potential marker start can be output.
-	  (setq output (concat output (substring gud-marker-acc
-						 0 (match-beginning 0))))
-
-	  ;; Everything after, we save, to combine with later input.
-	  (setq gud-marker-acc
-		(substring gud-marker-acc (match-beginning 0))))
-
-      (setq output (concat output gud-marker-acc)
-	    gud-marker-acc ""))
-
-    output))
-
-(defun gud-gdb-find-file (f)
-  (save-excursion
-    (let ((buf (find-file-noselect f)))
-      (set-buffer buf)
-      (gud-make-debug-menu)
-      (local-set-key [menu-bar debug tbreak]
-		     '("Temporary Breakpoint" . gud-tbreak))
-      (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
-      (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
-      (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
-      buf)))
-
-(defvar gdb-minibuffer-local-map nil
-  "Keymap for minibuffer prompting of gdb startup command.")
-(if gdb-minibuffer-local-map
-    ()
-  (setq gdb-minibuffer-local-map (copy-keymap minibuffer-local-map))
-  (define-key
-    gdb-minibuffer-local-map "\C-i" 'comint-dynamic-complete-filename))
-
-;;;###autoload
-(defun gdb (command-line)
-  "Run gdb on program FILE in buffer *gud-FILE*.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger."
-  (interactive
-   (list (read-from-minibuffer "Run gdb (like this): "
-			       (if (consp gud-gdb-history)
-				   (car gud-gdb-history)
-				 "gdb ")
-			       gdb-minibuffer-local-map nil
-			       '(gud-gdb-history . 1))))
-
-  (gud-common-init command-line 'gud-gdb-massage-args
-		   'gud-gdb-marker-filter 'gud-gdb-find-file)
-
-  (gud-def gud-break  "break %f:%l"  "\C-b" "Set breakpoint at current line.")
-  (gud-def gud-tbreak "tbreak %f:%l" "\C-t" "Set temporary breakpoint at current line.")
-  (gud-def gud-remove "clear %f:%l"  "\C-d" "Remove breakpoint at current line")
-  (gud-def gud-step   "step %p"      "\C-s" "Step one source line with display.")
-  (gud-def gud-stepi  "stepi %p"     "\C-i" "Step one instruction with display.")
-  (gud-def gud-next   "next %p"      "\C-n" "Step one line (skip functions).")
-  (gud-def gud-cont   "cont"         "\C-r" "Continue with display.")
-  (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")
-  (gud-def gud-up     "up %p"        "<" "Up N stack frames (numeric arg).")
-  (gud-def gud-down   "down %p"      ">" "Down N stack frames (numeric arg).")
-  (gud-def gud-print  "print %e"     "\C-p" "Evaluate C expression at point.")
-
-  (local-set-key "\C-i" 'gud-gdb-complete-command)
-  (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak))
-  (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
-  (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
-  (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
-  (setq comint-prompt-regexp "^(.*gdb[+]?) *")
-  (setq paragraph-start comint-prompt-regexp)
-  (run-hooks 'gdb-mode-hook)
-  )
-
-;; One of the nice features of GDB is its impressive support for
-;; context-sensitive command completion.  We preserve that feature
-;; in the GUD buffer by using a GDB command designed just for Emacs.
-
-;; The completion process filter indicates when it is finished.
-(defvar gud-gdb-complete-in-progress)
-
-;; Since output may arrive in fragments we accumulate partials strings here.
-(defvar gud-gdb-complete-string)
-
-;; We need to know how much of the completion to chop off.
-(defvar gud-gdb-complete-break)
-
-;; The completion list is constructed by the process filter.
-(defvar gud-gdb-complete-list)
-
-(defvar gud-comint-buffer nil)
-
-(defun gud-gdb-complete-command ()
-  "Perform completion on the GDB command preceding point.
-This is implemented using the GDB `complete' command which isn't
-available with older versions of GDB."
-  (interactive)
-  (let* ((end (point))
-	 (command (save-excursion
-		    (beginning-of-line)
-		    (and (looking-at comint-prompt-regexp)
-			 (goto-char (match-end 0)))
-		    (buffer-substring (point) end)))
-	 command-word)
-    ;; Find the word break.  This match will always succeed.
-    (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
-    (setq gud-gdb-complete-break (match-beginning 2)
-	  command-word (substring command gud-gdb-complete-break))
-    ;; Temporarily install our filter function.
-    (let ((gud-marker-filter 'gud-gdb-complete-filter))
-      ;; Issue the command to GDB.
-      (gud-basic-call (concat "complete " command))
-      (setq gud-gdb-complete-in-progress t
-	    gud-gdb-complete-string nil
-	    gud-gdb-complete-list nil)
-      ;; Slurp the output.
-      (while gud-gdb-complete-in-progress
-	(accept-process-output (get-buffer-process gud-comint-buffer))))
-    ;; Protect against old versions of GDB.
-    (and gud-gdb-complete-list
-	 (string-match "^Undefined command: \"complete\""
-		       (car gud-gdb-complete-list))
-	 (error "This version of GDB doesn't support the `complete' command."))
-    ;; Sort the list like readline.
-    (setq gud-gdb-complete-list
-	  (sort gud-gdb-complete-list (function string-lessp)))
-    ;; Remove duplicates.
-    (let ((first gud-gdb-complete-list)
-	  (second (cdr gud-gdb-complete-list)))
-      (while second
-	(if (string-equal (car first) (car second))
-	    (setcdr first (setq second (cdr second)))
-	  (setq first second
-		second (cdr second)))))
-    ;; Add a trailing single quote if there is a unique completion
-    ;; and it contains an odd number of unquoted single quotes.
-    (and (= (length gud-gdb-complete-list) 1)
-	 (let ((str (car gud-gdb-complete-list))
-	       (pos 0)
-	       (count 0))
-	   (while (string-match "\\([^'\\]\\|\\\\'\\)*'" str pos)
-	     (setq count (1+ count)
-		   pos (match-end 0)))
-	   (and (= (mod count 2) 1)
-		(setq gud-gdb-complete-list (list (concat str "'"))))))
-    ;; Let comint handle the rest.
-    (comint-dynamic-simple-complete command-word gud-gdb-complete-list)))
-    
-;; The completion process filter is installed temporarily to slurp the
-;; output of GDB up to the next prompt and build the completion list.
-(defun gud-gdb-complete-filter (string)
-  (setq string (concat gud-gdb-complete-string string))
-  (while (string-match "\n" string)
-    (setq gud-gdb-complete-list
-	  (cons (substring string gud-gdb-complete-break (match-beginning 0))
-		gud-gdb-complete-list))
-    (setq string (substring string (match-end 0))))
-  (if (string-match comint-prompt-regexp string)
-      (progn
-	(setq gud-gdb-complete-in-progress nil)
-	string)
-    (progn
-      (setq gud-gdb-complete-string string)
-      "")))
-
-
-;; ======================================================================
-;; sdb functions
-
-;;; History of argument lists passed to sdb.
-(defvar gud-sdb-history nil)
-
-(defvar gud-sdb-needs-tags (not (file-exists-p "/var"))
-  "If nil, we're on a System V Release 4 and don't need the tags hack.")
-
-(defvar gud-sdb-lastfile nil)
-
-(defun gud-sdb-massage-args (file args) args)
-
-(defun gud-sdb-marker-filter (string)
-  (setq gud-marker-acc
-	(if gud-marker-acc (concat gud-marker-acc string) string))
-  (let (start)
-    ;; Process all complete markers in this chunk
-    (while 
-	(cond 
-	 ;; System V Release 3.2 uses this format
-	 ((string-match "\\(^\\|\n\\)\\*?\\(0x\\w* in \\)?\\([^:\n]*\\):\\([0-9]*\\):.*\n"
-			gud-marker-acc start)
-	  (setq gud-last-frame
-		(cons
-		 (substring gud-marker-acc (match-beginning 3) (match-end 3))
-		 (string-to-int 
-		  (substring gud-marker-acc (match-beginning 4) (match-end 4))))))
-	 ;; System V Release 4.0 quite often clumps two lines together
-	 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n\\([0-9]+\\):" 
-			gud-marker-acc start)
-	  (setq gud-sdb-lastfile
-		(substring gud-marker-acc (match-beginning 2) (match-end 2)))
-	  (setq gud-last-frame
-		(cons
-		 gud-sdb-lastfile
-		 (string-to-int 
-		  (substring gud-marker-acc (match-beginning 3) (match-end 3))))))
-	 ;; System V Release 4.0 
-	 ((string-match "^\\(BREAKPOINT\\|STEPPED\\) process [0-9]+ function [^ ]+ in \\(.+\\)\n"
-			gud-marker-acc start)
-	  (setq gud-sdb-lastfile
-		(substring gud-marker-acc (match-beginning 2) (match-end 2))))
-	 ((and gud-sdb-lastfile (string-match "^\\([0-9]+\\):"
-					      gud-marker-acc start))
-	       (setq gud-last-frame
-		     (cons
-		      gud-sdb-lastfile
-		      (string-to-int 
-		       (substring gud-marker-acc (match-beginning 1) (match-end 1))))))
-	 (t 
-	  (setq gud-sdb-lastfile nil)))
-      (setq start (match-end 0)))
-
-    ;; Search for the last incomplete line in this chunk
-    (while (string-match "\n" gud-marker-acc start)
-      (setq start (match-end 0)))
-
-    ;; If we have an incomplete line, store it in gud-marker-acc.
-    (setq gud-marker-acc (substring gud-marker-acc (or start 0))))
-  string)
-
-(defun gud-sdb-find-file (f)
-  (save-excursion
-    (let ((buf (if gud-sdb-needs-tags
-		   (find-tag-noselect f)
-		 (find-file-noselect f))))
-      (set-buffer buf)
-      (gud-make-debug-menu)
-      (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak))
-      buf)))
-
-;;;###autoload
-(defun sdb (command-line)
-  "Run sdb on program FILE in buffer *gud-FILE*.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger."
-  (interactive
-   (list (read-from-minibuffer "Run sdb (like this): "
-			       (if (consp gud-sdb-history)
-				   (car gud-sdb-history)
-				 "sdb ")
-			       nil nil
-			       '(gud-sdb-history . 1))))
-  (if (and gud-sdb-needs-tags
-	   (not (and (boundp 'tags-file-name)
-		     (stringp tags-file-name)
-		     (file-exists-p tags-file-name))))
-      (error "The sdb support requires a valid tags table to work."))
-
-  (gud-common-init command-line 'gud-sdb-massage-args
-		   'gud-sdb-marker-filter 'gud-sdb-find-file)
-
-  (gud-def gud-break  "%l b" "\C-b"   "Set breakpoint at current line.")
-  (gud-def gud-tbreak "%l c" "\C-t"   "Set temporary breakpoint at current line.")
-  (gud-def gud-remove "%l d" "\C-d"   "Remove breakpoint at current line")
-  (gud-def gud-step   "s %p" "\C-s"   "Step one source line with display.")
-  (gud-def gud-stepi  "i %p" "\C-i"   "Step one instruction with display.")
-  (gud-def gud-next   "S %p" "\C-n"   "Step one line (skip functions).")
-  (gud-def gud-cont   "c"    "\C-r"   "Continue with display.")
-  (gud-def gud-print  "%e/"  "\C-p"   "Evaluate C expression at point.")
-
-  (setq comint-prompt-regexp  "\\(^\\|\n\\)\\*")
-  (setq paragraph-start comint-prompt-regexp)
-  (local-set-key [menu-bar debug tbreak]
-    '("Temporary Breakpoint" . gud-tbreak))
-  (run-hooks 'sdb-mode-hook)
-  )
-
-;; ======================================================================
-;; dbx functions
-
-;;; History of argument lists passed to dbx.
-(defvar gud-dbx-history nil)
-
-(defvar gud-dbx-directories nil
-  "*A list of directories that dbx should search for source code.
-If nil, only source files in the program directory
-will be known to dbx.
-
-The file names should be absolute, or relative to the directory
-containing the executable being debugged.")
-
-(defun gud-dbx-massage-args (file args)
-  (nconc (let ((directories gud-dbx-directories)
-	       (result nil))
-	   (while directories
-	     (setq result (cons (car directories) (cons "-I" result)))
-	     (setq directories (cdr directories)))
-	   (nreverse result))
-	 args))
-
-(defun gud-dbx-file-name (f)
-  "Transform a relative file name to an absolute file name, for dbx."
-  (let ((result nil))
-    (if (file-exists-p f)
-        (setq result (expand-file-name f))
-      (let ((directories gud-dbx-directories))
-        (while directories
-          (let ((path (concat (car directories) "/" f)))
-            (if (file-exists-p path)
-                (setq result (expand-file-name path)
-                      directories nil)))
-          (setq directories (cdr directories)))))
-    result))
-
-(defun gud-dbx-marker-filter (string)
-  (setq gud-marker-acc (if gud-marker-acc (concat gud-marker-acc string) string))
-
-  (let (start)
-    ;; Process all complete markers in this chunk.
-    (while (or (string-match
-		"stopped in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
-		gud-marker-acc start)
-	       (string-match
-		"signal .* in .* at line \\([0-9]*\\) in file \"\\([^\"]*\\)\""
-		gud-marker-acc start))
-      (setq gud-last-frame
-	    (cons
-	     (substring gud-marker-acc (match-beginning 2) (match-end 2))
-	     (string-to-int 
-	      (substring gud-marker-acc (match-beginning 1) (match-end 1))))
-	    start (match-end 0)))
-
-    ;; Search for the last incomplete line in this chunk
-    (while (string-match "\n" gud-marker-acc start)
-      (setq start (match-end 0)))
-
-    ;; If the incomplete line APPEARS to begin with another marker, keep it
-    ;; in the accumulator.  Otherwise, clear the accumulator to avoid an
-    ;; unnecessary concat during the next call.
-    (setq gud-marker-acc 
-	  (if (string-match "\\(stopped\\|signal\\)" gud-marker-acc start)
-	      (substring gud-marker-acc (match-beginning 0))
-	    nil)))
-  string)
-
-;; Functions for Mips-style dbx.  Given the option `-emacs', documented in
-;; OSF1, not necessarily elsewhere, it produces markers similar to gdb's.
-(defvar gud-mips-p
-  (or (string-match "^mips-[^-]*-ultrix" system-configuration)
-      ;; We haven't tested gud on this system:
-      (string-match "^mips-[^-]*-riscos" system-configuration)
-      ;; It's documented on OSF/1.3
-      (string-match "^mips-[^-]*-osf1" system-configuration)
-      (string-match "^alpha-[^-]*-osf" system-configuration))
-  "Non-nil to assume the MIPS/OSF dbx conventions (argument `-emacs').")
-
-(defun gud-mipsdbx-massage-args (file args)
-  (cons "-emacs" args))
-
-;; This is just like the gdb one except for the regexps since we need to cope
-;; with an optional breakpoint number in [] before the ^Z^Z
-(defun gud-mipsdbx-marker-filter (string)
-  (setq gud-marker-acc (concat gud-marker-acc string))
-  (let ((output ""))
-
-    ;; Process all the complete markers in this chunk.
-    (while (string-match
-	    ;; This is like th gdb marker but with an optional
-	    ;; leading break point number like `[1] '
-	    "[][ 0-9]*\032\032\\([^:\n]*\\):\\([0-9]*\\):.*\n"
-	    gud-marker-acc)
-      (setq
-
-       ;; Extract the frame position from the marker.
-       gud-last-frame
-       (cons (substring gud-marker-acc (match-beginning 1) (match-end 1))
-	     (string-to-int (substring gud-marker-acc
-				       (match-beginning 2)
-				       (match-end 2))))
-
-       ;; Append any text before the marker to the output we're going
-       ;; to return - we don't include the marker in this text.
-       output (concat output
-		      (substring gud-marker-acc 0 (match-beginning 0)))
-
-       ;; Set the accumulator to the remaining text.
-       gud-marker-acc (substring gud-marker-acc (match-end 0))))
-
-    ;; Does the remaining text look like it might end with the
-    ;; beginning of another marker?  If it does, then keep it in
-    ;; gud-marker-acc until we receive the rest of it.  Since we
-    ;; know the full marker regexp above failed, it's pretty simple to
-    ;; test for marker starts.
-    (if (string-match "[][ 0-9]*\032.*\\'" gud-marker-acc)
-	(progn
-	  ;; Everything before the potential marker start can be output.
-	  (setq output (concat output (substring gud-marker-acc
-						 0 (match-beginning 0))))
-
-	  ;; Everything after, we save, to combine with later input.
-	  (setq gud-marker-acc
-		(substring gud-marker-acc (match-beginning 0))))
-
-      (setq output (concat output gud-marker-acc)
-	    gud-marker-acc ""))
-
-    output))
-
-;; The dbx in IRIX is a pain.  It doesn't print the file name when
-;; stopping at a breakpoint (but you do get it from the `up' and
-;; `down' commands...).  The only way to extract the information seems
-;; to be with a `file' command, although the current line number is
-;; available in $curline.  Thus we have to look for output which
-;; appears to indicate a breakpoint.  Then we prod the dbx sub-process
-;; to output the information we want with a combination of the
-;; `printf' and `file' commands as a pseudo marker which we can
-;; recognise next time through the marker-filter.  This would be like
-;; the gdb marker but you can't get the file name without a newline...
-;; Note that gud-remove won't work since Irix dbx expects a breakpoint
-;; number rather than a line number etc.  Maybe this could be made to
-;; work by listing all the breakpoints and picking the one(s) with the
-;; correct line number, but life's too short.
-;;   d.love@dl.ac.uk (Dave Love) can be blamed for this
-
-(defvar gud-irix-p
-  (and (string-match "^mips-[^-]*-irix" system-configuration)
-       (not (string-match "irix[6-9]\\.[1-9]" system-configuration)))
-  "Non-nil to assume the interface appropriate for IRIX dbx.
-This works in IRIX 4, 5 and 6, but `gud-dbx-use-stopformat-p' provides
-a better solution in 6.1 upwards.")
-(defvar gud-dbx-use-stopformat-p
-  (string-match "irix[6-9]\\.[1-9]" system-configuration)
-  "Non-nil to use the dbx feature present at least from Irix 6.1
-  whereby $stopformat=1 produces an output format compatiable with
-  `gud-dbx-marker-filter'.")
-;; [Irix dbx seems to be a moving target.  The dbx output changed
-;; subtly sometime between OS v4.0.5 and v5.2 so that, for instance,
-;; the output from `up' is no longer spotted by gud (and it's probably
-;; not distinctive enough to try to match it -- use C-<, C->
-;; exclusively) .  For 5.3 and 6.0, the $curline variable changed to
-;; `long long'(why?!), so the printf stuff needed changing.  The line
-;; number was cast to `long' as a compromise between the new `long
-;; long' and the original `int'.  This is reported not to work in 6.2,
-;; so it's changed back to int -- don't make your sources too long.
-;; From Irix6.1 (but not 6.0?) dbx supports an undocumented feature
-;; whereby `set $stopformat=1' reportedly produces output compatible
-;; with `gud-dbx-marker-filter', which we prefer.
-
-;; The process filter is also somewhat
-;; unreliable, sometimes not spotting the markers; I don't know
-;; whether there's anything that can be done about that.  It would be
-;; much better if SGI could be persuaded to (re?)instate the MIPS
-;; -emacs flag for gdb-like output (which ought to be possible as most
-;; of the communication I've had over it has been from sgi.com).]
-
-;; this filter is influenced by the xdb one rather than the gdb one
-(defun gud-irixdbx-marker-filter (string)
-  (let (result (case-fold-search nil))
-    (if (or (string-match comint-prompt-regexp string)
-	    (string-match ".*\012" string))
-	(setq result (concat gud-marker-acc string)
-	      gud-marker-acc "")
-      (setq gud-marker-acc (concat gud-marker-acc string)))
-    (if result
-	(cond
-	 ;; look for breakpoint or signal indication e.g.:
-	 ;; [2] Process  1267 (pplot) stopped at [params:338 ,0x400ec0]
-	 ;; Process  1281 (pplot) stopped at [params:339 ,0x400ec8]
-	 ;; Process  1270 (pplot) Floating point exception [._read._read:16 ,0x452188]
-	 ((string-match
-	   "^\\(\\[[0-9]+] \\)?Process +[0-9]+ ([^)]*) [^[]+\\[[^]\n]*]\n" 
-	   result)
-	  ;; prod dbx into printing out the line number and file
-	  ;; name in a form we can grok as below
-	  (process-send-string (get-buffer-process gud-comint-buffer)
-			       "printf \"\032\032%1d:\",(int)$curline;file\n"))
-	 ;; look for result of, say, "up" e.g.:
-	 ;; .pplot.pplot(0x800) ["src/pplot.f":261, 0x400c7c]
-	 ;; (this will also catch one of the lines printed by "where")
-	 ((string-match
-	   "^[^ ][^[]*\\[\"\\([^\"]+\\)\":\\([0-9]+\\), [^]]+]\n"
-	   result)
-	  (let ((file (substring result (match-beginning 1)
-				 (match-end 1))))
-	    (if (file-exists-p file)
-		(setq gud-last-frame
-		      (cons
-		       (substring
-			result (match-beginning 1) (match-end 1))
-		       (string-to-int 
-			(substring
-			 result (match-beginning 2) (match-end 2)))))))
-	  result)
-	 ((string-match			; kluged-up marker as above
-	   "\032\032\\([0-9]*\\):\\(.*\\)\n" result)
-	  (let ((file (gud-dbx-file-name
-		       (substring result (match-beginning 2) (match-end 2)))))
-	    (if (and file (file-exists-p file))
-		(setq gud-last-frame
-		      (cons
-		       file
-		       (string-to-int 
-			(substring
-			 result (match-beginning 1) (match-end 1)))))))
-	  (setq result (substring result 0 (match-beginning 0))))))
-    (or result "")))
-
-(defun gud-dbx-find-file (f)
-  (save-excursion
-    (let ((realf (gud-dbx-file-name f)))
-      (if realf
-	  (let ((buf (find-file-noselect realf)))
-	    (set-buffer buf)
-	    (gud-make-debug-menu)
-	    (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
-	    (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
-	    buf)
-	nil))))
-
-;;;###autoload
-(defun dbx (command-line)
-  "Run dbx on program FILE in buffer *gud-FILE*.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger."
-  (interactive
-   (list (read-from-minibuffer "Run dbx (like this): "
-			       (if (consp gud-dbx-history)
-				   (car gud-dbx-history)
-				 "dbx ")
-			       nil nil
-			       '(gud-dbx-history . 1))))
-
-  (cond
-   (gud-mips-p
-    (gud-common-init command-line 'gud-mipsdbx-massage-args
-		     'gud-mipsdbx-marker-filter 'gud-dbx-find-file))
-   (gud-irix-p
-    (gud-common-init command-line 'gud-dbx-massage-args
-		     'gud-irixdbx-marker-filter 'gud-dbx-find-file))
-   (t
-    (gud-common-init command-line 'gud-dbx-massage-args
-		     'gud-dbx-marker-filter 'gud-dbx-find-file)))
-
-  (cond
-   (gud-mips-p
-    (gud-def gud-up     "up %p"         "<" "Up (numeric arg) stack frames.")
-    (gud-def gud-down   "down %p" ">" "Down (numeric arg) stack frames.")
-    (gud-def gud-break "stop at \"%f\":%l"
-				  "\C-b" "Set breakpoint at current line.")
-    (gud-def gud-finish "return"  "\C-f" "Finish executing current function."))
-   (gud-irix-p
-    (gud-def gud-break "stop at \"%d%f\":%l"
-				  "\C-b" "Set breakpoint at current line.")
-    (gud-def gud-finish "return"  "\C-f" "Finish executing current function.")
-    (gud-def gud-up     "up %p; printf \"\032\032%1d:\",(int)$curline;file\n"
-	     "<" "Up (numeric arg) stack frames.")
-    (gud-def gud-down "down %p; printf \"\032\032%1d:\",(int)$curline;file\n"
-	     ">" "Down (numeric arg) stack frames.")
-    ;; Make dbx give out the source location info that we need.
-    (process-send-string (get-buffer-process gud-comint-buffer)
-			 "printf \"\032\032%1d:\",(int)$curline;file\n"))
-   (gud-dbx-use-stopformat-p
-    (process-send-string (get-buffer-process gud-comint-buffer) 
-			 "set $stopformat=1\n"))
-   (t
-    (gud-def gud-up     "up %p"         "<" "Up (numeric arg) stack frames.")
-    (gud-def gud-down   "down %p" ">" "Down (numeric arg) stack frames.")
-    (gud-def gud-break "file \"%d%f\"\nstop at %l"
-				  "\C-b" "Set breakpoint at current line.")))
-
-  (gud-def gud-remove "clear %l"  "\C-d" "Remove breakpoint at current line")
-  (gud-def gud-step   "step %p"	  "\C-s" "Step one line with display.")
-  (gud-def gud-stepi  "stepi %p"  "\C-i" "Step one instruction with display.")
-  (gud-def gud-next   "next %p"	  "\C-n" "Step one line (skip functions).")
-  (gud-def gud-cont   "cont"	  "\C-r" "Continue with display.")
-  (gud-def gud-print  "print %e"  "\C-p" "Evaluate C expression at point.")
-
-  (setq comint-prompt-regexp  "^[^)\n]*dbx) *")
-  (setq paragraph-start comint-prompt-regexp)
-  (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
-  (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
-  (run-hooks 'dbx-mode-hook)
-  )
-
-;; ======================================================================
-;; xdb (HP PARISC debugger) functions
-
-;;; History of argument lists passed to xdb.
-(defvar gud-xdb-history nil)
-
-(defvar gud-xdb-directories nil
-  "*A list of directories that xdb should search for source code.
-If nil, only source files in the program directory
-will be known to xdb.
-
-The file names should be absolute, or relative to the directory
-containing the executable being debugged.")
-
-(defun gud-xdb-massage-args (file args)
-  (nconc (let ((directories gud-xdb-directories)
-	       (result nil))
-	   (while directories
-	     (setq result (cons (car directories) (cons "-d" result)))
-	     (setq directories (cdr directories)))
-	   (nreverse result))
-	 args))
-
-(defun gud-xdb-file-name (f)
-  "Transform a relative pathname to a full pathname in xdb mode"
-  (let ((result nil))
-    (if (file-exists-p f)
-        (setq result (expand-file-name f))
-      (let ((directories gud-xdb-directories))
-        (while directories
-          (let ((path (concat (car directories) "/" f)))
-            (if (file-exists-p path)
-                (setq result (expand-file-name path)
-                      directories nil)))
-          (setq directories (cdr directories)))))
-    result))
-
-;; xdb does not print the lines all at once, so we have to accumulate them
-(defun gud-xdb-marker-filter (string)
-  (let (result)
-    (if (or (string-match comint-prompt-regexp string)
-            (string-match ".*\012" string))
-        (setq result (concat gud-marker-acc string)
-              gud-marker-acc "")
-      (setq gud-marker-acc (concat gud-marker-acc string)))
-    (if result
-        (if (or (string-match "\\([^\n \t:]+\\): [^:]+: \\([0-9]+\\)[: ]"
-			      result)
-                (string-match "[^: \t]+:[ \t]+\\([^:]+\\): [^:]+: \\([0-9]+\\):"
-                              result))
-            (let ((line (string-to-int
-                         (substring result (match-beginning 2) (match-end 2))))
-                  (file (gud-xdb-file-name
-                         (substring result (match-beginning 1) (match-end 1)))))
-              (if file
-                  (setq gud-last-frame (cons file line))))))
-    (or result "")))    
-               
-(defun gud-xdb-find-file (f)
-  (save-excursion
-    (let ((realf (gud-xdb-file-name f)))
-      (if realf
-	  (let ((buf (find-file-noselect realf)))
-	    (set-buffer buf)
-	    (gud-make-debug-menu)
-	    (local-set-key [menu-bar debug tbreak]
-			   '("Temporary Breakpoint" . gud-tbreak))
-	    (local-set-key [menu-bar debug finish]
-			   '("Finish Function" . gud-finish))
-	    (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
-	    (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
-	    buf)
-	nil))))
-
-;;;###autoload
-(defun xdb (command-line)
-  "Run xdb on program FILE in buffer *gud-FILE*.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger.
-
-You can set the variable 'gud-xdb-directories' to a list of program source
-directories if your program contains sources from more than one directory."
-  (interactive
-   (list (read-from-minibuffer "Run xdb (like this): "
-			       (if (consp gud-xdb-history)
-				   (car gud-xdb-history)
-				 "xdb ")
-			       nil nil
-			       '(gud-xdb-history . 1))))
-
-  (gud-common-init command-line 'gud-xdb-massage-args
-		   'gud-xdb-marker-filter 'gud-xdb-find-file)
-
-  (gud-def gud-break  "b %f:%l"    "\C-b" "Set breakpoint at current line.")
-  (gud-def gud-tbreak "b %f:%l\\t" "\C-t"
-           "Set temporary breakpoint at current line.")
-  (gud-def gud-remove "db"         "\C-d" "Remove breakpoint at current line")
-  (gud-def gud-step   "s %p"	   "\C-s" "Step one line with display.")
-  (gud-def gud-next   "S %p"	   "\C-n" "Step one line (skip functions).")
-  (gud-def gud-cont   "c"	   "\C-r" "Continue with display.")
-  (gud-def gud-up     "up %p"	   "<"    "Up (numeric arg) stack frames.")
-  (gud-def gud-down   "down %p"	   ">"    "Down (numeric arg) stack frames.")
-  (gud-def gud-finish "bu\\t"      "\C-f" "Finish executing current function.")
-  (gud-def gud-print  "p %e"       "\C-p" "Evaluate C expression at point.")
-
-  (setq comint-prompt-regexp  "^>")
-  (setq paragraph-start comint-prompt-regexp)
-  (local-set-key [menu-bar debug tbreak] '("Temporary Breakpoint" . gud-tbreak))
-  (local-set-key [menu-bar debug finish] '("Finish Function" . gud-finish))
-  (local-set-key [menu-bar debug up] '("Up Stack" . gud-up))
-  (local-set-key [menu-bar debug down] '("Down Stack" . gud-down))
-  (run-hooks 'xdb-mode-hook))
-
-;; ======================================================================
-;; perldb functions
-
-;;; History of argument lists passed to perldb.
-(defvar gud-perldb-history nil)
-
-(defun gud-perldb-massage-args (file args)
-  (cond ((equal (car args) "-e") 
-	 (cons "-d" 
-	       (cons (car args) 
-		     (cons (nth 1 args) 
-			   (cons "--" (cons "-emacs" (cdr (cdr args))))))))
-	(t
-	 (cons "-d" (cons (car args) (cons "-emacs" (cdr args)))))))
-
-;; There's no guarantee that Emacs will hand the filter the entire
-;; marker at once; it could be broken up across several strings.  We
-;; might even receive a big chunk with several markers in it.  If we
-;; receive a chunk of text which looks like it might contain the
-;; beginning of a marker, we save it here between calls to the
-;; filter.
-(defvar gud-perldb-marker-acc "")
-
-(defun gud-perldb-marker-filter (string)
-  (setq gud-marker-acc (concat gud-marker-acc string))
-  (let ((output ""))
-
-    ;; Process all the complete markers in this chunk.
-    (while (string-match "\032\032\\(\\([a-zA-Z]:\\)?[^:\n]*\\):\\([0-9]*\\):.*\n"
-			 gud-marker-acc)
-      (setq
-
-       ;; Extract the frame position from the marker.
-       gud-last-frame
-       (cons (substring gud-marker-acc (match-beginning 1) (match-end 1))
-	     (string-to-int (substring gud-marker-acc
-				       (match-beginning 3)
-				       (match-end 3))))
-
-       ;; Append any text before the marker to the output we're going
-       ;; to return - we don't include the marker in this text.
-       output (concat output
-		      (substring gud-marker-acc 0 (match-beginning 0)))
-
-       ;; Set the accumulator to the remaining text.
-       gud-marker-acc (substring gud-marker-acc (match-end 0))))
-
-    ;; Does the remaining text look like it might end with the
-    ;; beginning of another marker?  If it does, then keep it in
-    ;; gud-marker-acc until we receive the rest of it.  Since we
-    ;; know the full marker regexp above failed, it's pretty simple to
-    ;; test for marker starts.
-    (if (string-match "\032.*\\'" gud-marker-acc)
-	(progn
-	  ;; Everything before the potential marker start can be output.
-	  (setq output (concat output (substring gud-marker-acc
-						 0 (match-beginning 0))))
-
-	  ;; Everything after, we save, to combine with later input.
-	  (setq gud-marker-acc
-		(substring gud-marker-acc (match-beginning 0))))
-
-      (setq output (concat output gud-marker-acc)
-	    gud-marker-acc ""))
-
-    output))
-
-(defun gud-perldb-find-file (f)
-  (save-excursion
-    (let ((buf (find-file-noselect f)))
-      (set-buffer buf)
-      (gud-make-debug-menu)
-      buf)))
-
-(defvar perldb-command-name "perl"
-  "File name for executing Perl.")
-
-;;;###autoload
-(defun perldb (command-line)
-  "Run perldb on program FILE in buffer *gud-FILE*.
-The directory containing FILE becomes the initial working directory
-and source-file directory for your debugger."
-  (interactive
-   (list (read-from-minibuffer "Run perldb (like this): "
-			       (if (consp gud-perldb-history)
-				   (car gud-perldb-history)
-				 (concat perldb-command-name
-					 " "
-					 (or (buffer-file-name)
-					     "-e 0"))
-					 " ")
-			       nil nil
-			       '(gud-perldb-history . 1))))
-
-  (gud-common-init command-line 'gud-perldb-massage-args
-		   'gud-perldb-marker-filter 'gud-perldb-find-file)
-
-  (gud-def gud-break  "b %l"         "\C-b" "Set breakpoint at current line.")
-  (gud-def gud-remove "d %l"         "\C-d" "Remove breakpoint at current line")
-  (gud-def gud-step   "s"            "\C-s" "Step one source line with display.")
-  (gud-def gud-next   "n"            "\C-n" "Step one line (skip functions).")
-  (gud-def gud-cont   "c"            "\C-r" "Continue with display.")
-;  (gud-def gud-finish "finish"       "\C-f" "Finish executing current function.")
-;  (gud-def gud-up     "up %p"        "<" "Up N stack frames (numeric arg).")
-;  (gud-def gud-down   "down %p"      ">" "Down N stack frames (numeric arg).")
-  (gud-def gud-print  "%e"           "\C-p" "Evaluate perl expression at point.")
-
-  (setq comint-prompt-regexp "^  DB<+[0-9]+>+ ")
-  (setq paragraph-start comint-prompt-regexp)
-  (run-hooks 'perldb-mode-hook)
-  )
-
-;;
-;; End of debugger-specific information
-;;
-
-
-;;; When we send a command to the debugger via gud-call, it's annoying
-;;; to see the command and the new prompt inserted into the debugger's
-;;; buffer; we have other ways of knowing the command has completed.
-;;;
-;;; If the buffer looks like this:
-;;; --------------------
-;;; (gdb) set args foo bar
-;;; (gdb) -!-
-;;; --------------------
-;;; (the -!- marks the location of point), and we type `C-x SPC' in a
-;;; source file to set a breakpoint, we want the buffer to end up like
-;;; this:
-;;; --------------------
-;;; (gdb) set args foo bar
-;;; Breakpoint 1 at 0x92: file make-docfile.c, line 49.
-;;; (gdb) -!-
-;;; --------------------
-;;; Essentially, the old prompt is deleted, and the command's output
-;;; and the new prompt take its place.
-;;;
-;;; Not echoing the command is easy enough; you send it directly using
-;;; process-send-string, and it never enters the buffer.  However,
-;;; getting rid of the old prompt is trickier; you don't want to do it
-;;; when you send the command, since that will result in an annoying
-;;; flicker as the prompt is deleted, redisplay occurs while Emacs
-;;; waits for a response from the debugger, and the new prompt is
-;;; inserted.  Instead, we'll wait until we actually get some output
-;;; from the subprocess before we delete the prompt.  If the command
-;;; produced no output other than a new prompt, that prompt will most
-;;; likely be in the first chunk of output received, so we will delete
-;;; the prompt and then replace it with an identical one.  If the
-;;; command produces output, the prompt is moving anyway, so the
-;;; flicker won't be annoying.
-;;;
-;;; So - when we want to delete the prompt upon receipt of the next
-;;; chunk of debugger output, we position gud-delete-prompt-marker at
-;;; the start of the prompt; the process filter will notice this, and
-;;; delete all text between it and the process output marker.  If
-;;; gud-delete-prompt-marker points nowhere, we leave the current
-;;; prompt alone.
-(defvar gud-delete-prompt-marker nil)
-
-
-(defun gud-mode ()
-  "Major mode for interacting with an inferior debugger process.
-
-   You start it up with one of the commands M-x gdb, M-x sdb, M-x dbx,
-M-x perldb, or M-x xdb.  Each entry point finishes by executing a
-hook; `gdb-mode-hook', `sdb-mode-hook', `dbx-mode-hook',
-`perldb-mode-hook', or `xdb-mode-hook' respectively.
-
-After startup, the following commands are available in both the GUD
-interaction buffer and any source buffer GUD visits due to a breakpoint stop
-or step operation:
-
-\\[gud-break] sets a breakpoint at the current file and line.  In the
-GUD buffer, the current file and line are those of the last breakpoint or
-step.  In a source buffer, they are the buffer's file and current line.
-
-\\[gud-remove] removes breakpoints on the current file and line.
-
-\\[gud-refresh] displays in the source window the last line referred to
-in the gud buffer.
-
-\\[gud-step], \\[gud-next], and \\[gud-stepi] do a step-one-line,
-step-one-line (not entering function calls), and step-one-instruction
-and then update the source window with the current file and position.
-\\[gud-cont] continues execution.
-
-\\[gud-print] tries to find the largest C lvalue or function-call expression
-around point, and sends it to the debugger for value display.
-
-The above commands are common to all supported debuggers except xdb which
-does not support stepping instructions.
-
-Under gdb, sdb and xdb, \\[gud-tbreak] behaves exactly like \\[gud-break],
-except that the breakpoint is temporary; that is, it is removed when
-execution stops on it.
-
-Under gdb, dbx, and xdb, \\[gud-up] pops up through an enclosing stack
-frame.  \\[gud-down] drops back down through one.
-
-If you are using gdb or xdb, \\[gud-finish] runs execution to the return from
-the current function and stops.
-
-All the keystrokes above are accessible in the GUD buffer
-with the prefix C-c, and in all buffers through the prefix C-x C-a.
-
-All pre-defined functions for which the concept make sense repeat
-themselves the appropriate number of times if you give a prefix
-argument.
-
-You may use the `gud-def' macro in the initialization hook to define other
-commands.
-
-Other commands for interacting with the debugger process are inherited from
-comint mode, which see."
-  (interactive)
-  (comint-mode)
-  (setq major-mode 'gud-mode)
-  (setq mode-name "Debugger")
-  (setq mode-line-process '(":%s"))
-  (use-local-map comint-mode-map)
-  (gud-make-debug-menu)
-  (define-key (current-local-map) "\C-c\C-l" 'gud-refresh)
-  (make-local-variable 'gud-last-frame)
-  (setq gud-last-frame nil)
-  (make-local-variable 'comint-prompt-regexp)
-  ;; Don't put repeated commands in command history many times.
-  (make-local-variable 'comint-input-ignoredups)
-  (setq comint-input-ignoredups t)
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'gud-delete-prompt-marker)
-  (setq gud-delete-prompt-marker (make-marker))
-  (run-hooks 'gud-mode-hook))
-
-;; Chop STRING into words separated by SPC or TAB and return a list of them.
-(defun gud-chop-words (string)
-  (let ((i 0) (beg 0)
-	(len (length string))
-	(words nil))
-    (while (< i len)
-      (if (memq (aref string i) '(?\t ? ))
-	  (progn
-	    (setq words (cons (substring string beg i) words)
-		  beg (1+ i))
-	    (while (and (< beg len) (memq (aref string beg) '(?\t ? )))
-	      (setq beg (1+ beg)))
-	    (setq i (1+ beg)))
-	(setq i (1+ i))))
-    (if (< beg len)
-	(setq words (cons (substring string beg) words)))
-    (nreverse words)))
-
-;; Perform initializations common to all debuggers.
-;; The first arg is the specified command line,
-;; which starts with the program to debug.
-;; The other three args specify the values to use
-;; for local variables in the debugger buffer.
-(defun gud-common-init (command-line massage-args marker-filter find-file)
-  (let* ((words (gud-chop-words command-line))
-	 (program (car words))
-	 ;; Extract the file name from WORDS
-	 ;; and put t in its place.
-	 ;; Later on we will put the modified file name arg back there.
-	 (file-word (let ((w (cdr words)))
-		      (while (and w (= ?- (aref (car w) 0)))
-			(setq w (cdr w)))
-		      (and w
-			   (prog1 (car w)
-			     (setcar w t)))))
-	 (file-subst
-	  (and file-word (substitute-in-file-name file-word)))
-	 (args (cdr words))
-	 ;; If a directory was specified, expand the file name.
-	 ;; Otherwise, don't expand it, so GDB can use the PATH.
-	 ;; A file name without directory is literally valid
-	 ;; only if the file exists in ., and in that case,
-	 ;; omitting the expansion here has no visible effect.
-	 (file (and file-word
-		    (if (file-name-directory file-subst)
-			(expand-file-name file-subst)
-		      file-subst)))
-	 (filepart (and file-word (concat "-" (file-name-nondirectory file)))))
-    (switch-to-buffer (concat "*gud" filepart "*"))
-    ;; Set default-directory to the file's directory.
-    (and file-word
-	 ;; Don't set default-directory if no directory was specified.
-	 ;; In that case, either the file is found in the current directory,
-	 ;; in which case this setq is a no-op,
-	 ;; or it is found by searching PATH,
-	 ;; in which case we don't know what directory it was found in.
-	 (file-name-directory file)
-	 (setq default-directory (file-name-directory file)))
-    (or (bolp) (newline))
-    (insert "Current directory is " default-directory "\n")
-    ;; Put the substituted and expanded file name back in its place.
-    (let ((w args))
-      (while (and w (not (eq (car w) t)))
-	(setq w (cdr w)))
-      (if w
-	  (setcar w file)))
-    (apply 'make-comint (concat "gud" filepart) program nil
-	   (funcall massage-args file args)))
-  ;; Since comint clobbered the mode, we don't set it until now.
-  (gud-mode)
-  (make-local-variable 'gud-marker-filter)
-  (setq gud-marker-filter marker-filter)
-  (make-local-variable 'gud-find-file)
-  (setq gud-find-file find-file)
-
-  (set-process-filter (get-buffer-process (current-buffer)) 'gud-filter)
-  (set-process-sentinel (get-buffer-process (current-buffer)) 'gud-sentinel)
-  (gud-set-buffer)
-  )
-
-(defun gud-set-buffer ()
-  (cond ((eq major-mode 'gud-mode)
-	(setq gud-comint-buffer (current-buffer)))))
-
-(defvar gud-filter-defer-flag nil
-  "Non-nil means don't process anything from the debugger right now.
-It is saved for when this flag is not set.")
-
-(defvar gud-filter-pending-text nil
-  "Non-nil means this is text that has been saved for later in `gud-filter'.")
-
-;; These functions are responsible for inserting output from your debugger
-;; into the buffer.  The hard work is done by the method that is
-;; the value of gud-marker-filter.
-
-(defun gud-filter (proc string)
-  ;; Here's where the actual buffer insertion is done
-  (let (output process-window)
-    (if (buffer-name (process-buffer proc))
-	(if gud-filter-defer-flag
-	    ;; If we can't process any text now,
-	    ;; save it for later.
-	    (setq gud-filter-pending-text
-		  (concat (or gud-filter-pending-text "") string))
-
-	  ;; If we have to ask a question during the processing,
-	  ;; defer any additional text that comes from the debugger
-	  ;; during that time.
-	  (let ((gud-filter-defer-flag t))
-	    ;; Process now any text we previously saved up.
-	    (if gud-filter-pending-text
-		(setq string (concat gud-filter-pending-text string)
-		      gud-filter-pending-text nil))
-	    (save-excursion
-	      (set-buffer (process-buffer proc))
-	      ;; If we have been so requested, delete the debugger prompt.
-	      (if (marker-buffer gud-delete-prompt-marker)
-		  (progn
-		    (delete-region (process-mark proc) gud-delete-prompt-marker)
-		    (set-marker gud-delete-prompt-marker nil)))
-	      ;; Save the process output, checking for source file markers.
-	      (setq output (gud-marker-filter string))
-	      ;; Check for a filename-and-line number.
-	      ;; Don't display the specified file
-	      ;; unless (1) point is at or after the position where output appears
-	      ;; and (2) this buffer is on the screen.
-	      (setq process-window
-		    (and gud-last-frame
-			 (>= (point) (process-mark proc))
-			 (get-buffer-window (current-buffer))))
-
-	      ;; Let the comint filter do the actual insertion.
-	      ;; That lets us inherit various comint features.
-	      (comint-output-filter proc output)))
-
-	  ;; Put the arrow on the source line.
-	  ;; This must be outside of the save-excursion
-	  ;; in case the source file is our current buffer.
-	  (if process-window
-	      (save-selected-window
-		(select-window process-window)
-		(gud-display-frame))
-	    ;; We have to be in the proper buffer, (process-buffer proc),
-	    ;; but not in a save-excursion, because that would restore point.
-	    (let ((old-buf (current-buffer)))
-	      (set-buffer (process-buffer proc))
-	      (unwind-protect
-		  (gud-display-frame)
-		(set-buffer old-buf))))
-
-	  ;; If we deferred text that arrived during this processing,
-	  ;; handle it now.
-	  (if gud-filter-pending-text
-	      (gud-filter proc ""))))))
-
-(defun gud-sentinel (proc msg)
-  (cond ((null (buffer-name (process-buffer proc)))
-	 ;; buffer killed
-	 ;; Stop displaying an arrow in a source file.
-	 (setq overlay-arrow-position nil)
-	 (set-process-buffer proc nil))
-	((memq (process-status proc) '(signal exit))
-	 ;; Stop displaying an arrow in a source file.
-	 (setq overlay-arrow-position nil)
-	 ;; Fix the mode line.
-	 (setq mode-line-process
-	       (concat ":"
-		       (symbol-name (process-status proc))))
-	 (let* ((obuf (current-buffer)))
-	   ;; save-excursion isn't the right thing if
-	   ;;  process-buffer is current-buffer
-	   (unwind-protect
-	       (progn
-		 ;; Write something in *compilation* and hack its mode line,
-		 (set-buffer (process-buffer proc))
-		 (force-mode-line-update)
-		 (if (eobp)
-		     (insert ?\n mode-name " " msg)
-		   (save-excursion
-		     (goto-char (point-max))
-		     (insert ?\n mode-name " " msg)))
-		 ;; If buffer and mode line will show that the process
-		 ;; is dead, we can delete it now.  Otherwise it
-		 ;; will stay around until M-x list-processes.
-		 (delete-process proc))
-	     ;; Restore old buffer, but don't restore old point
-	     ;; if obuf is the gud buffer.
-	     (set-buffer obuf))))))
-
-(defun gud-display-frame ()
-  "Find and obey the last filename-and-line marker from the debugger.
-Obeying it means displaying in another window the specified file and line."
-  (interactive)
-  (if gud-last-frame
-   (progn
-     (gud-set-buffer)
-     (gud-display-line (car gud-last-frame) (cdr gud-last-frame))
-     (setq gud-last-last-frame gud-last-frame
-	   gud-last-frame nil))))
-
-;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
-;; and that its line LINE is visible.
-;; Put the overlay-arrow on the line LINE in that buffer.
-;; Most of the trickiness in here comes from wanting to preserve the current
-;; region-restriction if that's possible.  We use an explicit display-buffer
-;; to get around the fact that this is called inside a save-excursion.
-
-(defun gud-display-line (true-file line)
-  (let* ((last-nonmenu-event t)	 ; Prevent use of dialog box for questions.
-	 (buffer
-	  (save-excursion
-	    (or (eq (current-buffer) gud-comint-buffer)
-		(set-buffer gud-comint-buffer))
-	    (gud-find-file true-file)))
-	 (window (and buffer (or (get-buffer-window buffer)
-				 (display-buffer buffer))))
-	 (pos))
-    (if buffer
-	(progn
-	  (save-excursion
-	    (set-buffer buffer)
-	    (save-restriction
-	      (widen)
-	      (goto-line line)
-	      (setq pos (point))
-	      (setq overlay-arrow-string "=>")
-	      (or overlay-arrow-position
-		  (setq overlay-arrow-position (make-marker)))
-	      (set-marker overlay-arrow-position (point) (current-buffer)))
-	    (cond ((or (< pos (point-min)) (> pos (point-max)))
-		   (widen)
-		   (goto-char pos))))
-	  (set-window-point window overlay-arrow-position)))))
-
-;;; The gud-call function must do the right thing whether its invoking
-;;; keystroke is from the GUD buffer itself (via major-mode binding)
-;;; or a C buffer.  In the former case, we want to supply data from
-;;; gud-last-frame.  Here's how we do it:
-
-(defun gud-format-command (str arg)
-  (let ((insource (not (eq (current-buffer) gud-comint-buffer)))
-	(frame (or gud-last-frame gud-last-last-frame))
-	result)
-    (while (and str (string-match "\\([^%]*\\)%\\([adeflp]\\)" str))
-      (let ((key (string-to-char (substring str (match-beginning 2))))
-	    subst)
-	(cond
-	 ((eq key ?f)
-	  (setq subst (file-name-nondirectory (if insource
-						  (buffer-file-name)
-						(car frame)))))
-	 ((eq key ?d)
-	  (setq subst (file-name-directory (if insource
-					       (buffer-file-name)
-					     (car frame)))))
-	 ((eq key ?l)
-	  (setq subst (if insource
-			  (save-excursion
-			    (beginning-of-line)
-			    (save-restriction (widen) 
-					      (1+ (count-lines 1 (point)))))
-			(cdr frame))))
-	 ((eq key ?e)
-	  (setq subst (gud-find-c-expr)))
-	 ((eq key ?a)
-	  (setq subst (gud-read-address)))
-	 ((eq key ?p)
-	  (setq subst (if arg (int-to-string arg) ""))))
-	(setq result (concat result
-			     (substring str (match-beginning 1) (match-end 1))
-			     subst)))
-      (setq str (substring str (match-end 2))))
-    ;; There might be text left in STR when the loop ends.
-    (concat result str)))
-
-(defun gud-read-address ()
-  "Return a string containing the core-address found in the buffer at point."
-  (save-excursion
-    (let ((pt (point)) found begin)
-      (setq found (if (search-backward "0x" (- pt 7) t) (point)))
-      (cond
-       (found (forward-char 2)
-	      (buffer-substring found
-				(progn (re-search-forward "[^0-9a-f]")
-				       (forward-char -1)
-				       (point))))
-       (t (setq begin (progn (re-search-backward "[^0-9]") 
-			     (forward-char 1)
-			     (point)))
-	  (forward-char 1)
-	  (re-search-forward "[^0-9]")
-	  (forward-char -1)
-	  (buffer-substring begin (point)))))))
-
-(defun gud-call (fmt &optional arg)
-  (let ((msg (gud-format-command fmt arg)))
-    (message "Command: %s" msg)
-    (sit-for 0)
-    (gud-basic-call msg)))
-
-(defun gud-basic-call (command)
-  "Invoke the debugger COMMAND displaying source in other window."
-  (interactive)
-  (gud-set-buffer)
-  (let ((command (concat command "\n"))
-	(proc (get-buffer-process gud-comint-buffer)))
-    (or proc (error "Current buffer has no process"))
-    ;; Arrange for the current prompt to get deleted.
-    (save-excursion
-      (set-buffer gud-comint-buffer)
-      (goto-char (process-mark proc))
-      (beginning-of-line)
-      (if (looking-at comint-prompt-regexp)
-	  (set-marker gud-delete-prompt-marker (point))))
-    (process-send-string proc command)))
-
-(defun gud-refresh (&optional arg)
-  "Fix up a possibly garbled display, and redraw the arrow."
-  (interactive "P")
-  (recenter arg)
-  (or gud-last-frame (setq gud-last-frame gud-last-last-frame))
-  (gud-display-frame))
-
-
-(defun gud-new-keymap (map)
-  "Return a new keymap which inherits from MAP and has name `Gud'."
-  (nconc (make-sparse-keymap "Gud") map))
-
-(defun gud-make-debug-menu ()
-  "Make sure the current local map has a [menu-bar debug] submap.
-If it doesn't, replace it with a new map that inherits it,
-and create such a submap in that new map."
-  (if (and (current-local-map)
-	   (lookup-key (current-local-map) [menu-bar debug]))
-      nil
-    (use-local-map (gud-new-keymap (current-local-map)))
-    (define-key (current-local-map) [menu-bar debug]
-      (cons "Gud" (gud-new-keymap gud-menu-map)))))
-
-;;; Code for parsing expressions out of C code.  The single entry point is
-;;; find-c-expr, which tries to return an lvalue expression from around point.
-;;;
-;;; The rest of this file is a hacked version of gdbsrc.el by
-;;; Debby Ayers <ayers@asc.slb.com>,
-;;; Rich Schaefer <schaefer@asc.slb.com> Schlumberger, Austin, Tx.
-
-(defun gud-find-c-expr ()
-  "Returns the C expr that surrounds point."
-  (interactive)
-  (save-excursion
-    (let (p expr test-expr)
-      (setq p (point))
-      (setq expr (gud-innermost-expr))
-      (setq test-expr (gud-prev-expr))
-      (while (and test-expr (gud-expr-compound test-expr expr))
-	(let ((prev-expr expr))
-	  (setq expr (cons (car test-expr) (cdr expr)))
-	  (goto-char (car expr))
-	  (setq test-expr (gud-prev-expr))
-	  ;; If we just pasted on the condition of an if or while,
-	  ;; throw it away again.
-	  (if (member (buffer-substring (car test-expr) (cdr test-expr))
-		      '("if" "while" "for"))
-	      (setq test-expr nil
-		    expr prev-expr))))
-      (goto-char p)
-      (setq test-expr (gud-next-expr))
-      (while (gud-expr-compound expr test-expr)
-	(setq expr (cons (car expr) (cdr test-expr)))
-	(setq test-expr (gud-next-expr))
-	)
-      (buffer-substring (car expr) (cdr expr)))))
-
-(defun gud-innermost-expr ()
-  "Returns the smallest expr that point is in; move point to beginning of it.
-The expr is represented as a cons cell, where the car specifies the point in
-the current buffer that marks the beginning of the expr and the cdr specifies 
-the character after the end of the expr."
-  (let ((p (point)) begin end)
-    (gud-backward-sexp)
-    (setq begin (point))
-    (gud-forward-sexp)
-    (setq end (point))
-    (if (>= p end) 
-	(progn
-	 (setq begin p)
-	 (goto-char p)
-	 (gud-forward-sexp)
-	 (setq end (point)))
-      )
-    (goto-char begin)
-    (cons begin end)))
-
-(defun gud-backward-sexp ()
-  "Version of `backward-sexp' that catches errors."
-  (condition-case nil
-      (backward-sexp)
-    (error t)))
-
-(defun gud-forward-sexp ()
-  "Version of `forward-sexp' that catches errors."
-  (condition-case nil
-     (forward-sexp)
-    (error t)))
-
-(defun gud-prev-expr ()
-  "Returns the previous expr, point is set to beginning of that expr.
-The expr is represented as a cons cell, where the car specifies the point in
-the current buffer that marks the beginning of the expr and the cdr specifies 
-the character after the end of the expr"
-  (let ((begin) (end))
-    (gud-backward-sexp)
-    (setq begin (point))
-    (gud-forward-sexp)
-    (setq end (point))
-    (goto-char begin)
-    (cons begin end)))
-
-(defun gud-next-expr ()
-  "Returns the following expr, point is set to beginning of that expr.
-The expr is represented as a cons cell, where the car specifies the point in
-the current buffer that marks the beginning of the expr and the cdr specifies 
-the character after the end of the expr."
-  (let ((begin) (end))
-    (gud-forward-sexp)
-    (gud-forward-sexp)
-    (setq end (point))
-    (gud-backward-sexp)
-    (setq begin (point))
-    (cons begin end)))
-
-(defun gud-expr-compound-sep (span-start span-end)
-  "Scan from SPAN-START to SPAN-END for punctuation characters.
-If `->' is found, return `?.'.  If `.' is found, return `?.'.
-If any other punctuation is found, return `??'.
-If no punctuation is found, return `? '."
-  (let ((result ?\ )
-	(syntax))
-    (while (< span-start span-end)
-      (setq syntax (char-syntax (char-after span-start)))
-      (cond
-       ((= syntax ?\ ) t)
-       ((= syntax ?.) (setq syntax (char-after span-start))
-	(cond 
-	 ((= syntax ?.) (setq result ?.))
-	 ((and (= syntax ?-) (= (char-after (+ span-start 1)) ?>))
-	  (setq result ?.)
-	  (setq span-start (+ span-start 1)))
-	 (t (setq span-start span-end)
-	    (setq result ??)))))
-      (setq span-start (+ span-start 1)))
-    result))
-
-(defun gud-expr-compound (first second)
-  "Non-nil if concatenating FIRST and SECOND makes a single C expression.
-The two exprs are represented as a cons cells, where the car 
-specifies the point in the current buffer that marks the beginning of the 
-expr and the cdr specifies the character after the end of the expr.
-Link exprs of the form:
-      Expr -> Expr
-      Expr . Expr
-      Expr (Expr)
-      Expr [Expr]
-      (Expr) Expr
-      [Expr] Expr"
-  (let ((span-start (cdr first))
-	(span-end (car second))
-	(syntax))
-    (setq syntax (gud-expr-compound-sep span-start span-end))
-    (cond
-     ((= (car first) (car second)) nil)
-     ((= (cdr first) (cdr second)) nil)
-     ((= syntax ?.) t)
-     ((= syntax ?\ )
-	 (setq span-start (char-after (- span-start 1)))
-	 (setq span-end (char-after span-end))
-	 (cond
-	  ((= span-start ?)) t)
-	  ((= span-start ?]) t)
-          ((= span-end ?() t)
-	  ((= span-end ?[) t)
-	  (t nil)))
-     (t nil))))
-
-(provide 'gud)
-
-;;; gud.el ends here
diff --git a/lisp/help-macro.el b/lisp/help-macro.el
deleted file mode 100644
index ff9c71b3ee0..00000000000
--- a/lisp/help-macro.el
+++ /dev/null
@@ -1,177 +0,0 @@
-;;; help-macro.el --- Makes command line help such as help-for-help
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Lynn Slater <lrs@indetech.com>
-;; Created: : Mon Oct  1 11:42:39 1990
-;; Adapted-By: ESR
-
-;; 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 supplies the macro make-help-screen which constructs
-;; single character dispatching with browsable help such as that provided
-;; by help-for-help. This can be used to make many modes easier to use; for
-;; example, the Gnu Emacs Empire Tool uses this for every "nested" mode map
-;; called from the main mode map.
-
-;;       The name of this package was changed from help-screen.el to
-;; help-macro.el in order to fit in a 14-character limit.
-
-;;-> ***********************  Example of use *********************************
-
-;;->(make-help-screen help-for-empire-redistribute-map
-;;->		  "c:civ m:mil p:population f:food ?"
-;;->		  "You have discovered the GEET redistribution commands
-;;->   From here, you can use the following options:
-;;->
-;;->c	Redistribute civs from overfull sectors into connected underfull ones
-;;->	  The functions typically named by empire-ideal-civ-fcn control
-;;->          based in part on empire-sector-civ-threshold  
-;;->m	Redistribute military using levels given by empire-ideal-mil-fcn
-;;->p	Redistribute excess population to highways for max pop growth
-;;->	  Excess is any sector so full babies will not be born.
-;;->f	Even out food on highways to highway min and leave levels
-;;->	  This is good to pump max food to all warehouses/dist pts
-;;->
-;;->
-;;->Use \\[help-for-empire-redistribute-map] for help on redistribution.
-;;->Use \\[help-for-empire-extract-map] for help on data extraction.
-;;->Please use \\[describe-key] to find out more about any of the other keys."
-;;->		  empire-shell-redistribute-map)
-
-;;->  (define-key c-mp "\C-h" 'help-for-empire-redistribute-map)
-;;->  (define-key c-mp help-character 'help-for-empire-redistribute-map)
-
-;;; Change Log:
-;;
-;; 22-Jan-1991		Lynn Slater x2048	
-;;    Last Modified: Mon Oct  1 11:43:52 1990 #3 (Lynn Slater)
-;;    documented better
-
-;;; Code:
-
-(provide 'help-macro)
-(require 'backquote)
-
-;;;###autoload
-(defvar three-step-help nil
-  "*Non-nil means give more info about Help command in three steps.
-The three steps are simple prompt, prompt with all options,
-and window listing and describing the options.
-A value of nil means skip the middle step, so that
-\\[help-command] \\[help-command] gives the window that lists the options.")
-
-(defmacro make-help-screen (fname help-line help-text helped-map)
-  "Construct help-menu function name FNAME.
-When invoked, FNAME shows HELP-LINE and reads a command using HELPED-MAP.
-If the command is the help character, FNAME displays HELP-TEXT
-and continues trying to read a command using HELPED-MAP.
-When FNAME finally does get a command, it executes that command
-and then returns."
-  (` (defun (, fname) ()
-	   (, help-text)
-	   (interactive)
-	   (let ((line-prompt
-		  (substitute-command-keys (, help-line))))
-	     (if three-step-help
-		 (message "%s" line-prompt))
-	     (let* ((help-screen (documentation (quote (, fname))))
-		    ;; We bind overriding-local-map for very small
-		    ;; sections, *excluding* where we switch buffers
-		    ;; and where we execute the chosen help command.
-		    (local-map (make-sparse-keymap))
-		    (minor-mode-map-alist nil)
-		    (prev-frame (selected-frame))
-		    config new-frame key char)
-	       (unwind-protect
-		   (progn
-		     (setcdr local-map (, helped-map))
-		     (define-key local-map [t] 'undefined)
-		     (if three-step-help
-			 (progn
-			   (setq key (let ((overriding-local-map local-map))
-				     (read-key-sequence nil)))
-			   ;; Make the HELP key translate to C-h.
-			   (if (lookup-key function-key-map key)
-			       (setq key (lookup-key function-key-map key)))
-			   (setq char (aref key 0)))
-		       (setq char ??))
-		     (if (or (eq char ??) (eq char help-char)
-			     (memq char help-event-list))
-			 (progn
-			   (setq config (current-window-configuration))
-			   (switch-to-buffer-other-window "*Help*")
-			   (and (fboundp 'make-frame)
-				(not (eq (window-frame (selected-window))
-					 prev-frame))
-				(setq new-frame (window-frame (selected-window))
-				      config nil))
-			   (erase-buffer)
-			   (insert help-screen)
-			   (help-mode)
-			   (goto-char (point-min))
-			   (while (or (memq char (append help-event-list
-							 (cons help-char '(?? ?\C-v ?\ ?\177 delete backspace ?\M-v))))
-				      (eq (car-safe char) 'switch-frame)
-				      (equal key "\M-v"))
-			     (condition-case nil
-				 (progn
-				   (if (eq (car-safe char) 'switch-frame)
-				       (handle-switch-frame char))
-				   (if (memq char '(?\C-v ?\ ))
-				       (scroll-up))
-				   (if (or (memq char '(?\177 ?\M-v
-							delete backspace))
-					   (equal key "\M-v"))
-				       (scroll-down)))
-			       (error nil))
-			     (let ((cursor-in-echo-area t)
-				   (overriding-local-map local-map))
-			       (setq key (read-key-sequence
-					  (format "Type one of the options listed%s: "
-						  (if (pos-visible-in-window-p
-						       (point-max))
-						      "" " or Space to scroll")))
-				     char (aref key 0))))))
-		     ;; Mouse clicks are not part of the help feature,
-		     ;; so reexecute them in the standard environment.
-		     (if (listp char)
-			 (setq unread-command-events
-			       (cons char unread-command-events)
-			       config nil)
-		       (let ((defn (lookup-key local-map key)))
-			 (if defn
-			     (progn
-			       (if config
-				   (progn
-				     (set-window-configuration config)
-				     (setq config nil)))
-			       (if new-frame
-				   (progn (iconify-frame new-frame)
-					  (setq new-frame nil)))
-			       (call-interactively defn))
-			   (ding)))))
-		 (if new-frame (iconify-frame new-frame))
-		 (if config
-		     (set-window-configuration config))))))
-     ))
-
-;;; help-macro.el
-
diff --git a/lisp/help.el b/lisp/help.el
deleted file mode 100644
index 9f4c2cf352b..00000000000
--- a/lisp/help.el
+++ /dev/null
@@ -1,705 +0,0 @@
-;;; help.el --- help commands for Emacs
-
-;; Copyright (C) 1985, 1986, 1993, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: help, 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 code implements GNU Emacs' on-line help system, the one invoked by
-;;`M-x help-for-help'.
-
-;;; Code:
-
-;; Get the macro make-help-screen when this is compiled,
-;; or run interpreted, but not when the compiled code is loaded.
-(eval-when-compile (require 'help-macro))
-
-(defvar help-map (make-sparse-keymap)
-  "Keymap for characters following the Help key.")
-
-(defvar help-mode-map (make-sparse-keymap)
-  "Keymap for help mode.")
-
-(define-key global-map (char-to-string help-char) 'help-command)
-(define-key global-map [help] 'help-command)
-(define-key global-map [f1] 'help-command)
-(fset 'help-command help-map)
-
-(define-key help-map (char-to-string help-char) 'help-for-help)
-(define-key help-map [help] 'help-for-help)
-(define-key help-map [f1] 'help-for-help)
-(define-key help-map "?" 'help-for-help)
-
-(define-key help-map "\C-c" 'describe-copying)
-(define-key help-map "\C-d" 'describe-distribution)
-(define-key help-map "\C-w" 'describe-no-warranty)
-(define-key help-map "\C-p" 'describe-project)
-(define-key help-map "a" 'command-apropos)
-
-(define-key help-map "b" 'describe-bindings)
-
-(define-key help-map "c" 'describe-key-briefly)
-(define-key help-map "k" 'describe-key)
-
-(define-key help-map "d" 'describe-function)
-(define-key help-map "f" 'describe-function)
-
-(define-key help-map "F" 'view-emacs-FAQ)
-
-(define-key help-map "i" 'info)
-(define-key help-map "\C-f" 'Info-goto-emacs-command-node)
-(define-key help-map "\C-k" 'Info-goto-emacs-key-command-node)
-(define-key help-map "\C-i" 'word-help)
-
-(define-key help-map "l" 'view-lossage)
-
-(define-key help-map "m" 'describe-mode)
-
-(define-key help-map "\C-n" 'view-emacs-news)
-(define-key help-map "n" 'view-emacs-news)
-
-(define-key help-map "p" 'finder-by-keyword)
-(autoload 'finder-by-keyword "finder"
-  "Find packages matching a given keyword." t)
-
-(define-key help-map "s" 'describe-syntax)
-
-(define-key help-map "t" 'help-with-tutorial)
-
-(define-key help-map "w" 'where-is)
-
-(define-key help-map "v" 'describe-variable)
-
-(define-key help-map "q" 'help-quit)
-
-(defvar help-font-lock-keywords
-  (eval-when-compile
-    (let ((name-char "[-+a-zA-Z0-9_*]") (sym-char "[-+a-zA-Z0-9_:*]"))
-      (list
-       ;;
-       ;; The symbol itself.
-       (list (concat "\\`\\(" name-char "+\\)\\(\\(:\\)\\|\\('\\)\\)")
-	     '(1 (if (match-beginning 3)
-		     font-lock-function-name-face
-		   font-lock-variable-name-face)))
-       ;;
-       ;; Words inside `' which tend to be symbol names.
-       (list (concat "`\\(" sym-char sym-char "+\\)'")
-	     1 'font-lock-reference-face t)
-       ;;
-       ;; CLisp `:' keywords as references.
-       (list (concat "\\<:" sym-char "+\\>") 0 'font-lock-reference-face t))))
-  "Default expressions to highlight in Help mode.")
-
-(defun help-mode ()
-  "Major mode for viewing help text.
-Entry to this mode runs the normal hook `help-mode-hook'.
-Commands:
-\\{help-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map help-mode-map)
-  (setq mode-name "Help")
-  (setq major-mode 'help-mode)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(help-font-lock-keywords))
-  (view-mode)
-  (run-hooks 'help-mode-hook))
-
-(defun help-quit ()
-  (interactive)
-  nil)
-
-(defun help-with-tutorial ()
-  "Select the Emacs learn-by-doing tutorial."
-  (interactive)
-  (let ((file (expand-file-name "~/TUTORIAL")))
-    (delete-other-windows)
-    (if (get-file-buffer file)
-	(switch-to-buffer (get-file-buffer file))
-      (switch-to-buffer (create-file-buffer file))
-      (setq buffer-file-name file)
-      (setq default-directory (expand-file-name "~/"))
-      (setq buffer-auto-save-file-name nil)
-      (insert-file-contents (expand-file-name "TUTORIAL" data-directory))
-      (goto-char (point-min))
-      (search-forward "\n<<")
-      (beginning-of-line)
-      (delete-region (point) (progn (end-of-line) (point)))
-      (let ((n (- (window-height (selected-window))
-		  (count-lines (point-min) (point))
-		  6)))
-	(if (< n 12)
-	    (newline n)
-	  ;; Some people get confused by the large gap.
-	  (newline (/ n 2))
-	  (insert "[Middle of page left blank for didactic purposes.  "
-		  "Text continues below]")
-	  (newline (- n (/ n 2)))))
-      (goto-char (point-min))
-      (set-buffer-modified-p nil))))
-
-(defun describe-key-briefly (key)
-  "Print the name of the function KEY invokes.  KEY is a string."
-  (interactive "kDescribe key briefly: ")
-  ;; If this key seq ends with a down event, discard the
-  ;; following click or drag event.  Otherwise that would
-  ;; erase the message.
-  (let ((type (aref key (1- (length key)))))
-    (if (listp type) (setq type (car type)))
-    (and (symbolp type)
-	 (memq 'down (event-modifiers type))
-	 (read-event)))
-  (save-excursion
-    (let ((modifiers (event-modifiers (aref key 0)))
-	  window position)
-      ;; For a mouse button event, go to the button it applies to
-      ;; to get the right key bindings.  And go to the right place
-      ;; in case the keymap depends on where you clicked.
-      (if (or (memq 'click modifiers) (memq 'down modifiers)
-	      (memq 'drag modifiers))
-	  (setq window (posn-window (event-start (aref key 0)))
-		position (posn-point (event-start (aref key 0)))))
-      (if (windowp window)
-	  (progn
-	    (set-buffer (window-buffer window))
-	    (goto-char position)))
-      ;; Ok, now look up the key and name the command.
-      (let ((defn (key-binding key)))
-	(if (or (null defn) (integerp defn))
-	    (message "%s is undefined" (key-description key))
-	  (message (if (windowp window)
-		       "%s at that spot runs the command %s"
-		     "%s runs the command %s")
-		   (key-description key)
-		   (if (symbolp defn) defn (prin1-to-string defn))))))))
-
-(defun print-help-return-message (&optional function)
-  "Display or return message saying how to restore windows after help command.
-Computes a message and applies the optional argument FUNCTION to it.
-If FUNCTION is nil, applies `message' to it, thus printing it."
-  (and (not (get-buffer-window standard-output))
-       (let ((first-message
-	      (cond ((special-display-p (buffer-name standard-output))
-		     ;; If the help output buffer is a special display buffer,
-		     ;; don't say anything about how to get rid of it.
-		     ;; First of all, the user will do that with the window
-		     ;; manager, not with Emacs.
-		     ;; Secondly, the buffer has not been displayed yet,
-		     ;; so we don't know whether its frame will be selected.
-		     nil)
-		    ((not (one-window-p t))
-		     "Type \\[switch-to-buffer-other-window] RET to restore the other window.")
-		    (pop-up-windows
-		     "Type \\[delete-other-windows] to remove help window.")
-		    (t
-		     "Type \\[switch-to-buffer] RET to remove help window."))))
-	 (funcall (or function 'message)
-		  (concat
-		   (if first-message
-		       (substitute-command-keys first-message)
-		     "")
-		   (if first-message "  " "")
-		   ;; If the help buffer will go in a separate frame,
-		   ;; it's no use mentioning a command to scroll, so don't.
-		   (if (special-display-p (buffer-name standard-output))
-		       nil
-		     (if (same-window-p (buffer-name standard-output))
-			 ;; Say how to scroll this window.
-			 (substitute-command-keys
-			  "\\[scroll-up] to scroll the help.")
-		       ;; Say how to scroll some other window.
-		       (substitute-command-keys
-			"\\[scroll-other-window] to scroll the help."))))))))
-
-(defun describe-key (key)
-  "Display documentation of the function invoked by KEY.  KEY is a string."
-  (interactive "kDescribe key: ")
-  ;; If this key seq ends with a down event, discard the
-  ;; following click or drag event.  Otherwise that would
-  ;; erase the message.
-  (let ((type (aref key (1- (length key)))))
-    (if (listp type) (setq type (car type)))
-    (and (symbolp type)
-	 (memq 'down (event-modifiers type))
-	 (read-event)))
-  (save-excursion
-    (let ((modifiers (event-modifiers (aref key 0)))
-	  window position)
-      ;; For a mouse button event, go to the button it applies to
-      ;; to get the right key bindings.  And go to the right place
-      ;; in case the keymap depends on where you clicked.
-      (if (or (memq 'click modifiers) (memq 'down modifiers)
-	      (memq 'drag modifiers))
-	  (setq window (posn-window (event-start (aref key 0)))
-		position (posn-point (event-start (aref key 0)))))
-      (if (windowp window)
-	  (progn
-	    (set-buffer (window-buffer window))
-	    (goto-char position)))
-      (let ((defn (key-binding key)))
-	(if (or (null defn) (integerp defn))
-	    (message "%s is undefined" (key-description key))
-	  (with-output-to-temp-buffer "*Help*"
-	    (princ (key-description key))
-	    (if (windowp window)
-		(princ " at that spot"))
-	    (princ " runs the command ")
-	    (prin1 defn)
-	    (princ ":\n")
-	    (let ((doc (documentation defn)))
-	      (if doc
-		  (progn (terpri)
-			 (princ doc))
-		(princ "not documented")))
-	    (save-excursion
-	      (set-buffer standard-output)
-	      (help-mode))
-	    (print-help-return-message)))))))
-
-(defun describe-mode ()
-  "Display documentation of current major mode and minor modes.
-For this to work correctly for a minor mode, the mode's indicator variable
-\(listed in `minor-mode-alist') must also be a function whose documentation
-describes the minor mode."
-  (interactive)
-  (with-output-to-temp-buffer "*Help*"
-    (let ((minor-modes minor-mode-alist)
-	  (first t))
-      (while minor-modes
-	(let* ((minor-mode (car (car minor-modes)))
-	       (indicator (car (cdr (car minor-modes)))))
-	  ;; Document a minor mode if it is listed in minor-mode-alist,
-	  ;; bound locally in this buffer, non-nil, and has a function
-	  ;; definition.
-	  (if (and (symbol-value minor-mode)
-		   (fboundp minor-mode))
-	      (let ((pretty-minor-mode minor-mode))
-		(if (string-match "-mode$" (symbol-name minor-mode))
-		    (setq pretty-minor-mode
-			  (capitalize
-			   (substring (symbol-name minor-mode)
-				      0 (match-beginning 0)))))
-		(while (and indicator (symbolp indicator))
-		  (setq indicator (symbol-value indicator)))
-		(if first
-		    (princ "The minor modes are described first,
-followed by the major mode, which is described on the last page.\n\f\n"))
-		(setq first nil)
-		(princ (format "%s minor mode (%s):\n"
-			       pretty-minor-mode
-			       (if indicator
-				   (format "indicator%s" indicator)
-				 "no indicator")))
-		(princ (documentation minor-mode))
-		(princ "\n\f\n"))))
-	(setq minor-modes (cdr minor-modes))))
-    (princ mode-name)
-    (princ " mode:\n")
-    (princ (documentation major-mode))
-    (save-excursion
-      (set-buffer standard-output)
-      (help-mode))
-    (print-help-return-message)))
-
-;; So keyboard macro definitions are documented correctly
-(fset 'defining-kbd-macro (symbol-function 'start-kbd-macro))
-
-(defun describe-distribution ()
-  "Display info on how to obtain the latest version of GNU Emacs."
-  (interactive)
-  (find-file-read-only
-   (expand-file-name "DISTRIB" data-directory)))
-
-(defun describe-copying ()
-  "Display info on how you may redistribute copies of GNU Emacs."
-  (interactive)
-  (find-file-read-only
-   (expand-file-name "COPYING" data-directory))
-  (goto-char (point-min)))
-
-(defun describe-project ()
-  "Display info on the GNU project."
-  (interactive)
-  (find-file-read-only
-   (expand-file-name "GNU" data-directory))
-  (goto-char (point-min)))
-
-(defun describe-no-warranty ()
-  "Display info on all the kinds of warranty Emacs does NOT have."
-  (interactive)
-  (describe-copying)
-  (let (case-fold-search)
-    (search-forward "NO WARRANTY")
-    (recenter 0)))
-
-(defun describe-prefix-bindings ()
-  "Describe the bindings of the prefix used to reach this command.
-The prefix described consists of all but the last event
-of the key sequence that ran this command."
-  (interactive)
-  (let* ((key (this-command-keys)))
-    (describe-bindings
-     (if (stringp key)
-	 (substring key 0 (1- (length key)))
-       (let ((prefix (make-vector (1- (length key)) nil))
-	     (i 0))
-	 (while (< i (length prefix))
-	   (aset prefix i (aref key i))
-	   (setq i (1+ i)))
-	 prefix)))))
-;; Make C-h after a prefix, when not specifically bound, 
-;; run describe-prefix-bindings.
-(setq prefix-help-command 'describe-prefix-bindings)
-
-(defun view-emacs-news ()
-  "Display info on recent changes to Emacs."
-  (interactive)
-  (find-file-read-only (expand-file-name "NEWS" data-directory)))
-
-(defun view-emacs-FAQ ()
-  "Display the Emacs Frequently Asked Questions (FAQ) file."
-  (interactive)
-  (find-file-read-only (expand-file-name "FAQ" data-directory)))
-
-(defun view-lossage ()
-  "Display last 100 input keystrokes."
-  (interactive)
-  (with-output-to-temp-buffer "*Help*"
-    (princ (mapconcat (function (lambda (key)
-				  (if (or (integerp key)
-					  (symbolp key)
-					  (listp key))
-				      (single-key-description key)
-				    (prin1-to-string key nil))))
-		      (recent-keys)
-		      " "))
-    (save-excursion
-      (set-buffer standard-output)
-      (goto-char (point-min))
-      (while (progn (move-to-column 50) (not (eobp)))
-	(search-forward " " nil t)
-	(insert "\n"))
-      (help-mode))
-    (print-help-return-message)))
-
-(defalias 'help 'help-for-help)
-(make-help-screen help-for-help
-  "a b c f C-f i k C-k l m n p s t v w C-c C-d C-n C-w, or ? for more help:"
-  "You have typed \\[help-command], the help character.  Type a Help option:
-\(Use SPC or DEL to scroll through this text.  Type \\<help-map>\\[help-quit] to exit the Help command.)
-
-a  command-apropos.  Give a substring, and see a list of commands
-	(functions interactively callable) that contain
-	that substring.  See also the  apropos  command.
-b  describe-bindings.  Display table of all key bindings.
-c  describe-key-briefly.  Type a command key sequence;
-	it prints the function name that sequence runs.
-f  describe-function.  Type a function name and get documentation of it.
-C-f Info-goto-emacs-command-node.  Type a function name;
-	it takes you to the Info node for that command.
-F  view-emacs-FAQ.  Shows emacs frequently asked questions file.
-i  info. The  info  documentation reader.
-k  describe-key.  Type a command key sequence;
-	it displays the full documentation.
-C-k Info-goto-emacs-key-command-node.  Type a command key sequence;
-	it takes you to the Info node for the command bound to that key.
-l  view-lossage.  Shows last 100 characters you typed.
-m  describe-mode.  Print documentation of current major mode,
-	which describes the commands peculiar to it.
-n  view-emacs-news.  Shows emacs news file.
-p  finder-by-keyword. Find packages matching a given topic keyword.
-s  describe-syntax.  Display contents of syntax table, plus explanations
-t  help-with-tutorial.  Select the Emacs learn-by-doing tutorial.
-v  describe-variable.  Type name of a variable;
-	it displays the variable's documentation and value.
-w  where-is.  Type command name; it prints which keystrokes
-	invoke that command.
-C-c print Emacs copying permission (General Public License).
-C-d print Emacs ordering information.
-C-n print news of recent Emacs changes.
-C-p print information about the GNU project.
-C-w print information on absence of warranty for GNU Emacs."
-  help-map)
-
-;; Return a function which is called by the list containing point.
-;; If that gives no function, return a function whose name is around point.
-;; If that doesn't give a function, return nil.
-(defun function-called-at-point ()
-  (or (condition-case ()
-	  (save-excursion
-	    (save-restriction
-	      (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
-	      (backward-up-list 1)
-	      (forward-char 1)
-	      (let (obj)
-		(setq obj (read (current-buffer)))
-		(and (symbolp obj) (fboundp obj) obj))))
-	(error nil))
-      (condition-case ()
-	  (let ((stab (syntax-table)))
-	    (unwind-protect
-		(save-excursion
-		  (set-syntax-table emacs-lisp-mode-syntax-table)
-		  (or (not (zerop (skip-syntax-backward "_w")))
-		      (eq (char-syntax (following-char)) ?w)
-		      (eq (char-syntax (following-char)) ?_)
-		      (forward-sexp -1))
-		  (skip-chars-forward "'")
-		  (let ((obj (read (current-buffer))))
-		    (and (symbolp obj) (fboundp obj) obj)))
-	      (set-syntax-table stab)))
-	(error nil))))
-
-(defun describe-function-find-file (function)
-  (let ((files load-history)
-	file functions)
-    (while files
-      (if (memq function (cdr (car files)))
-	  (setq file (car (car files)) files nil))
-      (setq files (cdr files)))
-    file))
-
-(defun describe-function (function)
-  "Display the full documentation of FUNCTION (a symbol)."
-  (interactive
-   (let ((fn (function-called-at-point))
-	 (enable-recursive-minibuffers t)	     
-	 val)
-     (setq val (completing-read (if fn
-				    (format "Describe function (default %s): " fn)
-				  "Describe function: ")
-				obarray 'fboundp t))
-     (list (if (equal val "")
-	       fn (intern val)))))
-  (if function
-      (with-output-to-temp-buffer "*Help*"
-	(prin1 function)
-	(princ ": ")
-	(let* ((def (symbol-function function))
-	       file-name
-	       (beg (if (commandp def) "an interactive " "a ")))
-	  (princ (cond ((or (stringp def)
-			    (vectorp def))
-			"a keyboard macro")
-		       ((subrp def)
-			(concat beg "built-in function"))
-		       ((byte-code-function-p def)
-			(concat beg "compiled Lisp function"))
-		       ((symbolp def)
-			(format "alias for `%s'" def))
-		       ((eq (car-safe def) 'lambda)
-			(concat beg "Lisp function"))
-		       ((eq (car-safe def) 'macro)
-			"a Lisp macro")
-		       ((eq (car-safe def) 'mocklisp)
-			"a mocklisp function")
-		       ((eq (car-safe def) 'autoload)
-			(setq file-name (nth 1 def))
-			(format "%s autoloaded Lisp %s"
-				(if (commandp def) "an interactive" "an")
-				(if (nth 4 def) "macro" "function")
-				))
-		       (t "")))
-	  (or file-name
-	      (setq file-name (describe-function-find-file function)))
-	  (if file-name
-	      (progn
-		(princ " in `")
-		;; We used to add .el to the file name,
-		;; but that's completely wrong when the user used load-file.
-		(princ file-name)
-		(princ "'")))
-	  (princ ".")
-	  (terpri)
-	  (let ((arglist (cond ((byte-code-function-p def)
-				(car (append def nil)))
-			       ((eq (car-safe def) 'lambda)
-				(nth 1 def))
-			       (t t))))
-	    (if (listp arglist)
-		(progn
-		  (princ (cons function
-			       (mapcar (lambda (arg)
-					 (if (memq arg '(&optional &rest))
-					     arg
-					   (intern (upcase (symbol-name arg)))))
-				       arglist)))
-		  (terpri))))
-	  (let ((doc (documentation function)))
-	    (if doc
-		(progn (terpri)
-		       (princ doc))
-	      (princ "not documented"))))
-	(print-help-return-message)
-	(save-excursion
-	  (set-buffer standard-output)
-	  (help-mode)
-	  ;; Return the text we displayed.
-	  (buffer-string)))
-    (message "You didn't specify a function")))
-
-;; We return 0 if we can't find a variable to return.
-(defun variable-at-point ()
-  (condition-case ()
-      (let ((stab (syntax-table)))
-	(unwind-protect
-	    (save-excursion
-	      (set-syntax-table emacs-lisp-mode-syntax-table)
-	      (or (not (zerop (skip-syntax-backward "_w")))
-		  (eq (char-syntax (following-char)) ?w)
-		  (eq (char-syntax (following-char)) ?_)
-		  (forward-sexp -1))
-	      (skip-chars-forward "'")
-	      (let ((obj (read (current-buffer))))
-		(or (and (symbolp obj) (boundp obj) obj)
-		    0)))
-	  (set-syntax-table stab)))
-    (error 0)))
-
-(defun describe-variable (variable)
-  "Display the full documentation of VARIABLE (a symbol).
-Returns the documentation as a string, also."
-  (interactive 
-   (let ((v (variable-at-point))
-	 (enable-recursive-minibuffers t)
-	 val)
-     (setq val (completing-read (if (symbolp v)
-				    (format "Describe variable (default %s): " v)
-				  "Describe variable: ")
-				obarray 'boundp t))
-     (list (if (equal val "")
-	       v (intern val)))))
-  (if (symbolp variable)
-      (let (valvoid)
-	(with-output-to-temp-buffer "*Help*"
-	  (prin1 variable)
-	  (if (not (boundp variable))
-	      (progn
-		(princ " is void")
-		(terpri)
-		(setq valvoid t))
-	    (princ "'s value is ")
-	    (terpri)
-	    (pp (symbol-value variable))
-	    (terpri))
-	  (if (local-variable-p variable)
-	      (progn
-		(princ (format "Local in buffer %s; " (buffer-name)))
-		(if (not (default-boundp variable))
-		    (princ "globally void")
-		  (princ "global value is ")
-		  (terpri)
-		  (pp (default-value variable)))
-		(terpri)))
-	  (terpri)
-	  (save-current-buffer
-	    (set-buffer standard-output)
-	    (if (> (count-lines (point-min) (point-max)) 10)
-		(progn
-		  (goto-char (point-min))
-		  (if valvoid
-		      (forward-line 1)
-		    (forward-sexp 1)
-		    (delete-region (point) (progn (end-of-line) (point)))
-		    (insert "'s value is shown below.\n\n")
-		    (save-excursion
-		      (insert "\n\nValue:"))))))
-	  (princ "Documentation:")
-	  (terpri)
-	  (let ((doc (documentation-property variable 'variable-documentation)))
-	    (princ (or doc "not documented as a variable.")))
-	  (print-help-return-message)
-	  (save-excursion
-	    (set-buffer standard-output)
-	    (help-mode)
-	    ;; Return the text we displayed.
-	    (buffer-string))))
-    (message "You did not specify a variable")))
-
-(defun where-is (definition)
-  "Print message listing key sequences that invoke specified command.
-Argument is a command definition, usually a symbol with a function definition."
-  (interactive
-   (let ((fn (function-called-at-point))
-	 (enable-recursive-minibuffers t)	     
-	 val)
-     (setq val (completing-read (if fn
-				    (format "Where is command (default %s): " fn)
-				  "Where is command: ")
-				obarray 'fboundp t))
-     (list (if (equal val "")
-	       fn (intern val)))))
-  (let* ((keys (where-is-internal definition overriding-local-map nil nil))
-	 (keys1 (mapconcat 'key-description keys ", ")))
-    (if (> (length keys1) 0)
-	(message "%s is on %s" definition keys1)
-      (message "%s is not on any key" definition)))
-  nil)
-
-(defun locate-library (library &optional nosuffix path interactive-call)
-  "Show the precise file name of Emacs library LIBRARY.
-This command searches the directories in `load-path' like `M-x load-library'
-to find the file that `M-x load-library RET LIBRARY RET' would load.
-Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el'
-to the specified name LIBRARY.
-
-If the optional third arg PATH is specified, that list of directories
-is used instead of `load-path'."
-  (interactive (list (read-string "Locate library: ")
-		     nil nil
-		     t))
-  (let (result)
-    (catch 'answer
-      (mapcar
-       (lambda (dir)
-	 (mapcar
-	  (lambda (suf)
-	    (let ((try (expand-file-name (concat library suf) dir)))
-	      (and (file-readable-p try)
-		   (null (file-directory-p try))
-		   (progn
-		     (setq result try)
-		     (throw 'answer try)))))
-	  (if nosuffix
-	      '("")
-	    (let ((basic '(".elc" ".el" ""))
-		  (compressed '(".Z" ".gz" "")))
-	      ;; If autocompression mode is on,
-	      ;; consider all combinations of library suffixes
-	      ;; and compression suffixes.
-	      (if (rassq 'jka-compr-handler file-name-handler-alist)
-		  (apply 'nconc
-			 (mapcar (lambda (compelt)
-				   (mapcar (lambda (baselt)
-					     (concat baselt compelt))
-					   basic))
-				 compressed))
-		basic)))))
-       (or path load-path)))
-    (and interactive-call
-	 (if result
-	     (message "Library is file %s" result)
-	   (message "No library %s in search path" library)))
-    result))
-
-;;; help.el ends here
diff --git a/lisp/hexl.el b/lisp/hexl.el
deleted file mode 100644
index 56f05de37cd..00000000000
--- a/lisp/hexl.el
+++ /dev/null
@@ -1,789 +0,0 @@
-;;; hexl.el --- edit a file in a hex dump format using the hexl filter.
-
-;; Copyright (C) 1989, 1994 Free Software Foundation, Inc.
-
-;; Author: Keith Gabryelski <ag@wheaties.ai.mit.edu>
-;; Maintainer: FSF
-;; Keywords: data
-
-;; 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 implements a major mode for editing binary files.  It uses
-;; a program called hexl, supplied with the GNU Emacs distribution, that
-;; can filter a binary into an editable format or from the format back into
-;; binary.  For full instructions, invoke `hexl-mode' on an empty buffer and
-;; do `M-x describe-mode'.
-;;
-;; This may be useful in your .emacs:
-;;
-;;	(autoload 'hexl-find-file "hexl"
-;;	  "Edit file FILENAME in hexl-mode." t)
-;;	
-;;	(define-key global-map "\C-c\C-h" 'hexl-find-file)
-;;
-;; NOTE: Remember to change HEXL-PROGRAM or HEXL-OPTIONS if needed.
-;;
-;; Currently hexl only supports big endian hex output with 16 bit
-;; grouping.
-;;
-;; -iso in `hexl-options' will allow iso characters to display in the
-;; ASCII region of the screen (if your emacs supports this) instead of
-;; changing them to dots.
-
-;;; Code:
-
-;;
-;; vars here
-;;
-
-(defvar hexl-program "hexl"
-  "The program that will hexlify and dehexlify its stdin.
-`hexl-program' will always be concatenated with `hexl-options'
-and \"-de\" when dehexlifying a buffer.")
-
-(defvar hexl-iso ""
-  "If your emacs can handle ISO characters, this should be set to
-\"-iso\" otherwise it should be \"\".")
-
-(defvar hexl-options (format "-hex %s" hexl-iso)
-  "Options to hexl-program that suit your needs.")
-
-(defvar hexlify-command
-  (format "%s%s %s" exec-directory hexl-program hexl-options)
-  "The command to use to hexlify a buffer.")
-
-(defvar dehexlify-command
-  (format "%s%s -de %s" exec-directory hexl-program hexl-options)
-  "The command to use to unhexlify a buffer.")
-
-(defvar hexl-max-address 0
-  "Maximum offset into hexl buffer.")
-
-(defvar hexl-mode-map nil)
-
-(defvar hexl-mode-old-local-map)
-(defvar hexl-mode-old-mode-name)
-(defvar hexl-mode-old-major-mode)
-(defvar hexl-mode-old-write-contents-hooks)
-(defvar hexl-mode-old-require-final-newline)
-(defvar hexl-mode-old-syntax-table)
-
-;; routines
-
-;;;###autoload
-(defun hexl-mode (&optional arg)
-  "\\<hexl-mode-map>
-A major mode for editing binary files in hex dump format.
-
-This function automatically converts a buffer into the hexl format
-using the function `hexlify-buffer'.
-
-Each line in the buffer has an \"address\" (displayed in hexadecimal)
-representing the offset into the file that the characters on this line
-are at and 16 characters from the file (displayed as hexadecimal
-values grouped every 16 bits) and as their ASCII values.
-
-If any of the characters (displayed as ASCII characters) are
-unprintable (control or meta characters) they will be replaced as
-periods.
-
-If `hexl-mode' is invoked with an argument the buffer is assumed to be
-in hexl format.
-
-A sample format:
-
-  HEX ADDR: 0001 0203 0405 0607 0809 0a0b 0c0d 0e0f     ASCII-TEXT
-  --------  ---- ---- ---- ---- ---- ---- ---- ----  ----------------
-  00000000: 5468 6973 2069 7320 6865 786c 2d6d 6f64  This is hexl-mod
-  00000010: 652e 2020 4561 6368 206c 696e 6520 7265  e.  Each line re
-  00000020: 7072 6573 656e 7473 2031 3620 6279 7465  presents 16 byte
-  00000030: 7320 6173 2068 6578 6164 6563 696d 616c  s as hexadecimal
-  00000040: 2041 5343 4949 0a61 6e64 2070 7269 6e74   ASCII.and print
-  00000050: 6162 6c65 2041 5343 4949 2063 6861 7261  able ASCII chara
-  00000060: 6374 6572 732e 2020 416e 7920 636f 6e74  cters.  Any cont
-  00000070: 726f 6c20 6f72 206e 6f6e 2d41 5343 4949  rol or non-ASCII
-  00000080: 2063 6861 7261 6374 6572 730a 6172 6520   characters.are 
-  00000090: 6469 7370 6c61 7965 6420 6173 2070 6572  displayed as per
-  000000a0: 696f 6473 2069 6e20 7468 6520 7072 696e  iods in the prin
-  000000b0: 7461 626c 6520 6368 6172 6163 7465 7220  table character 
-  000000c0: 7265 6769 6f6e 2e0a                      region..
-
-Movement is as simple as movement in a normal emacs text buffer.  Most
-cursor movement bindings are the same (ie. Use \\[hexl-backward-char], \\[hexl-forward-char], \\[hexl-next-line], and \\[hexl-previous-line]
-to move the cursor left, right, down, and up).
-
-Advanced cursor movement commands (ala \\[hexl-beginning-of-line], \\[hexl-end-of-line], \\[hexl-beginning-of-buffer], and \\[hexl-end-of-buffer]) are
-also supported.
-
-There are several ways to change text in hexl mode:
-
-ASCII characters (character between space (0x20) and tilde (0x7E)) are
-bound to self-insert so you can simply type the character and it will
-insert itself (actually overstrike) into the buffer.
-
-\\[hexl-quoted-insert] followed by another keystroke allows you to insert the key even if
-it isn't bound to self-insert.  An octal number can be supplied in place
-of another key to insert the octal number's ASCII representation.
-
-\\[hexl-insert-hex-char] will insert a given hexadecimal value (if it is between 0 and 0xFF)
-into the buffer at the current point.
-
-\\[hexl-insert-octal-char] will insert a given octal value (if it is between 0 and 0377)
-into the buffer at the current point.
-
-\\[hexl-insert-decimal-char] will insert a given decimal value (if it is between 0 and 255)
-into the buffer at the current point.
-
-\\[hexl-mode-exit] will exit hexl-mode.
-
-Note: saving the file with any of the usual Emacs commands
-will actually convert it back to binary format while saving.
-
-You can use \\[hexl-find-file] to visit a file in hexl-mode.
-
-\\[describe-bindings] for advanced commands."
-  (interactive "p")
-  (if (eq major-mode 'hexl-mode)
-      (error "You are already in hexl mode")
-
-    (let ((modified (buffer-modified-p))
-	  (inhibit-read-only t)
-	  (original-point (1- (point)))
-	  max-address)
-      (and (eobp) (not (bobp))
-	   (setq original-point (1- original-point)))
-      (if (not (or (eq arg 1) (not arg)))
-	  ;; if no argument then we guess at hexl-max-address
-          (setq max-address (+ (* (/ (1- (buffer-size)) 68) 16) 15))
-        (setq max-address (1- (buffer-size)))
-        (hexlify-buffer)
-        (set-buffer-modified-p modified))
-      (make-local-variable 'hexl-max-address)
-      (setq hexl-max-address max-address)
-      (hexl-goto-address original-point))
-
-    ;; We do not turn off the old major mode; instead we just
-    ;; override most of it.  That way, we can restore it perfectly.
-    (make-local-variable 'hexl-mode-old-local-map)
-    (setq hexl-mode-old-local-map (current-local-map))
-    (use-local-map hexl-mode-map)
-
-    (make-local-variable 'hexl-mode-old-mode-name)
-    (setq hexl-mode-old-mode-name mode-name)
-    (setq mode-name "Hexl")
-
-    (make-local-variable 'hexl-mode-old-major-mode)
-    (setq hexl-mode-old-major-mode major-mode)
-    (setq major-mode 'hexl-mode)
-
-    (make-local-variable 'hexl-mode-old-syntax-table)
-    (setq hexl-mode-old-syntax-table (syntax-table))
-    (set-syntax-table (standard-syntax-table))
-
-    (make-local-variable 'hexl-mode-old-write-contents-hooks)
-    (setq hexl-mode-old-write-contents-hooks write-contents-hooks)
-    (make-local-variable 'write-contents-hooks)
-    (add-hook 'write-contents-hooks 'hexl-save-buffer)
-
-    (make-local-variable 'hexl-mode-old-require-final-newline)
-    (setq hexl-mode-old-require-final-newline require-final-newline)
-    (make-local-variable 'require-final-newline)
-    (setq require-final-newline nil)
-
-    ;; Add hooks to rehexlify or dehexlify on various events.
-    (make-local-hook 'after-revert-hook)
-    (add-hook 'after-revert-hook 'hexl-after-revert-hook nil t)
-
-    (make-local-hook 'change-major-mode-hook)
-    (add-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer nil t))
-  (run-hooks 'hexl-mode-hook))
-
-(defun hexl-after-revert-hook ()
-  (hexlify-buffer)
-  (set-buffer-modified-p nil))
-
-(defvar hexl-in-save-buffer nil)
-
-(defun hexl-save-buffer ()
-  "Save a hexl format buffer as binary in visited file if modified."
-  (interactive)
-  (if hexl-in-save-buffer nil
-    (set-buffer-modified-p (if (buffer-modified-p)
-			       (save-excursion
-				 (let ((buf (generate-new-buffer " hexl"))
-				       (name (buffer-name))
-				       (file-name (buffer-file-name))
-				       (start (point-min))
-				       (end (point-max))
-				       modified)
-				   (set-buffer buf)
-				   (insert-buffer-substring name start end)
-				   (set-buffer name)
-				   (dehexlify-buffer)
-				   ;; Prevent infinite recursion.
-				   (let ((hexl-in-save-buffer t)
-					 (buffer-file-type t)) ; for ms-dos
-				     (save-buffer))
-				   (setq modified (buffer-modified-p))
-				   (delete-region (point-min) (point-max))
-				   (insert-buffer-substring buf start end)
-				   (kill-buffer buf)
-				   modified))
-			     (message "(No changes need to be saved)")
-			     nil))
-    ;; Return t to indicate we have saved t
-    t))
-
-;;;###autoload
-(defun hexl-find-file (filename)
-  "Edit file FILENAME in hexl-mode.
-Switch to a buffer visiting file FILENAME, creating one in none exists."
-  (interactive "fFilename: ")
-  (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
-      (find-file-binary filename)
-    (find-file filename))
-  (if (not (eq major-mode 'hexl-mode))
-      (hexl-mode)))
-
-(defun hexl-mode-exit (&optional arg)
-  "Exit Hexl mode, returning to previous mode.
-With arg, don't unhexlify buffer."
-  (interactive "p")
-  (if (or (eq arg 1) (not arg))
-      (let ((modified (buffer-modified-p))
-	    (inhibit-read-only t)
-	    (original-point (1+ (hexl-current-address))))
-	(dehexlify-buffer)
-	(remove-hook 'write-contents-hooks 'hexl-save-buffer)
-	(set-buffer-modified-p modified)
-	(goto-char original-point)))
-
-  (remove-hook 'after-revert-hook 'hexl-after-revert-hook t)
-  (remove-hook 'change-major-mode-hook 'hexl-maybe-dehexlify-buffer t)
-
-  (setq write-contents-hooks hexl-mode-old-write-contents-hooks)
-  (setq require-final-newline hexl-mode-old-require-final-newline)
-  (setq mode-name hexl-mode-old-mode-name)
-  (use-local-map hexl-mode-old-local-map)
-  (set-syntax-table hexl-mode-old-syntax-table)
-  (setq major-mode hexl-mode-old-major-mode)
-  (force-mode-line-update))
-
-(defun hexl-maybe-dehexlify-buffer ()
-  "Convert a hexl format buffer to binary.
-Ask the user for confirmation."
-  (if (y-or-n-p "Convert contents back to binary format? ")
-      (let ((modified (buffer-modified-p))
-	    (inhibit-read-only t)
-	    (original-point (1+ (hexl-current-address))))
-	(dehexlify-buffer)
-	(remove-hook 'write-contents-hooks 'hexl-save-buffer)
-	(set-buffer-modified-p modified)
-	(goto-char original-point))))
-
-(defun hexl-current-address (&optional validate)
-  "Return current hexl-address."
-  (interactive)
-  (let ((current-column (- (% (point) 68) 11)) 
-	(hexl-address 0))
-    (if (< current-column 0)
-	(if validate
-	    (error "Point is not on a character in the file")
-	  (setq current-column 0)))
-    (setq hexl-address
-	  (+ (* (/ (point) 68) 16)
-	     (if (>= current-column 41)
-		 (- current-column 41)
-	       (/ (- current-column  (/ current-column 5)) 2))))
-    hexl-address))
-
-(defun hexl-address-to-marker (address)
-  "Return marker for ADDRESS."
-  (interactive "nAddress: ")
-  (+ (* (/ address 16) 68) 11 (/ (* (% address 16) 5) 2)))
-
-(defun hexl-goto-address (address)
-  "Goto hexl-mode (decimal) address ADDRESS.
-Signal error if ADDRESS out of range."
-  (interactive "nAddress: ")
-  (if (or (< address 0) (> address hexl-max-address))
-	  (error "Out of hexl region."))
-  (goto-char (hexl-address-to-marker address)))
-
-(defun hexl-goto-hex-address (hex-address)
-  "Go to hexl-mode address (hex string) HEX-ADDRESS.
-Signal error if HEX-ADDRESS is out of range."
-  (interactive "sHex Address: ")
-  (hexl-goto-address (hexl-hex-string-to-integer hex-address)))
-
-(defun hexl-hex-string-to-integer (hex-string)
-  "Return decimal integer for HEX-STRING."
-  (interactive "sHex number: ")
-  (let ((hex-num 0))
-    (while (not (equal hex-string ""))
-      (setq hex-num (+ (* hex-num 16)
-		       (hexl-hex-char-to-integer (string-to-char hex-string))))
-      (setq hex-string (substring hex-string 1)))
-    hex-num))
-
-(defun hexl-octal-string-to-integer (octal-string)
-  "Return decimal integer for OCTAL-STRING."
-  (interactive "sOctal number: ")
-  (let ((oct-num 0))
-    (while (not (equal octal-string ""))
-      (setq oct-num (+ (* oct-num 8)
-		       (hexl-oct-char-to-integer
-			(string-to-char octal-string))))
-      (setq octal-string (substring octal-string 1)))
-    oct-num))
-
-;; move point functions
-
-(defun hexl-backward-char (arg)
-  "Move to left ARG bytes (right if ARG negative) in hexl-mode."
-  (interactive "p")
-  (hexl-goto-address (- (hexl-current-address) arg)))
-
-(defun hexl-forward-char (arg)
-  "Move right ARG bytes (left if ARG negative) in hexl-mode."
-  (interactive "p")
-  (hexl-goto-address (+ (hexl-current-address) arg)))
-
-(defun hexl-backward-short (arg)
-  "Move to left ARG shorts (right if ARG negative) in hexl-mode."
-  (interactive "p")
-  (hexl-goto-address (let ((address (hexl-current-address)))
-		       (if (< arg 0)
-			   (progn
-			     (setq arg (- arg))
-			     (while (> arg 0)
-			       (if (not (equal address (logior address 3)))
-				   (if (> address hexl-max-address)
-				       (progn
-					 (message "End of buffer.")
-					 (setq address hexl-max-address))
-				     (setq address (logior address 3)))
-				 (if (> address hexl-max-address)
-				     (progn
-				       (message "End of buffer.")
-				       (setq address hexl-max-address))
-				   (setq address (+ address 4))))
-			       (setq arg (1- arg)))
-			     (if (> address hexl-max-address)
-				 (progn
-				   (message "End of buffer.")
-				   (setq address hexl-max-address))
-			       (setq address (logior address 3))))
-			 (while (> arg 0)
-			   (if (not (equal address (logand address -4)))
-			       (setq address (logand address -4))
-			     (if (not (equal address 0))
-				 (setq address (- address 4))
-			       (message "Beginning of buffer.")))
-			   (setq arg (1- arg))))
-		       address)))
-
-(defun hexl-forward-short (arg)
-  "Move right ARG shorts (left if ARG negative) in hexl-mode."
-  (interactive "p")
-  (hexl-backward-short (- arg)))
-
-(defun hexl-backward-word (arg)
-  "Move to left ARG words (right if ARG negative) in hexl-mode."
-  (interactive "p")
-  (hexl-goto-address (let ((address (hexl-current-address)))
-		       (if (< arg 0)
-			   (progn
-			     (setq arg (- arg))
-			     (while (> arg 0)
-			       (if (not (equal address (logior address 7)))
-				   (if (> address hexl-max-address)
-				       (progn
-					 (message "End of buffer.")
-					 (setq address hexl-max-address))
-				     (setq address (logior address 7)))
-				 (if (> address hexl-max-address)
-				     (progn
-				       (message "End of buffer.")
-				       (setq address hexl-max-address))
-				   (setq address (+ address 8))))
-			       (setq arg (1- arg)))
-			     (if (> address hexl-max-address)
-				 (progn
-				   (message "End of buffer.")
-				   (setq address hexl-max-address))
-			       (setq address (logior address 7))))
-			 (while (> arg 0)
-			   (if (not (equal address (logand address -8)))
-			       (setq address (logand address -8))
-			     (if (not (equal address 0))
-				 (setq address (- address 8))
-			       (message "Beginning of buffer.")))
-			   (setq arg (1- arg))))
-		       address)))
-
-(defun hexl-forward-word (arg)
-  "Move right ARG words (left if ARG negative) in hexl-mode."
-  (interactive "p")
-  (hexl-backward-word (- arg)))
-
-(defun hexl-previous-line (arg)
-  "Move vertically up ARG lines [16 bytes] (down if ARG negative) in hexl-mode.
-If there is byte at the target address move to the last byte in that line."
-  (interactive "p")
-  (hexl-next-line (- arg)))
-
-(defun hexl-next-line (arg)
-  "Move vertically down ARG lines [16 bytes] (up if ARG negative) in hexl-mode.
-If there is no byte at the target address move to the last byte in that line."
-  (interactive "p")
-  (hexl-goto-address (let ((address (+ (hexl-current-address) (* arg 16))))
-		       (if (and (< arg 0) (< address 0))
-				(progn (message "Out of hexl region.")
-				       (setq address
-					     (% (hexl-current-address) 16)))
-			 (if (and (> address hexl-max-address)
-				  (< (% hexl-max-address 16) (% address 16)))
-			     (setq address hexl-max-address)
-			   (if (> address hexl-max-address)
-			       (progn (message "Out of hexl region.")
-				      (setq
-				       address
-				       (+ (logand hexl-max-address -16)
-					  (% (hexl-current-address) 16)))))))
-		       address)))
-
-(defun hexl-beginning-of-buffer (arg)
-  "Move to the beginning of the hexl buffer.
-Leaves `hexl-mark' at previous position.
-With prefix arg N, puts point N bytes of the way from the true beginning."
-  (interactive "p")
-  (push-mark (point))
-  (hexl-goto-address (+ 0 (1- arg))))
-
-(defun hexl-end-of-buffer (arg)
-  "Go to `hexl-max-address' minus ARG."
-  (interactive "p")
-  (push-mark (point))
-  (hexl-goto-address (- hexl-max-address (1- arg))))
-
-(defun hexl-beginning-of-line ()
-  "Goto beginning of line in hexl mode."
-  (interactive)
-  (goto-char (+ (* (/ (point) 68) 68) 11)))
-
-(defun hexl-end-of-line ()
-  "Goto end of line in hexl mode."
-  (interactive)
-  (hexl-goto-address (let ((address (logior (hexl-current-address) 15)))
-		       (if (> address hexl-max-address)
-			   (setq address hexl-max-address))
-		       address)))
-
-(defun hexl-scroll-down (arg)
-  "Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
-  (interactive "P")
-  (if (null arg)
-      (setq arg (1- (window-height)))
-    (setq arg (prefix-numeric-value arg)))
-  (hexl-scroll-up (- arg)))
-
-(defun hexl-scroll-up (arg)
-  "Scroll hexl buffer window upward ARG lines; or near full window if no ARG."
-  (interactive "P")
-  (if (null arg)
-      (setq arg (1- (window-height)))
-    (setq arg (prefix-numeric-value arg)))
-  (let ((movement (* arg 16))
-	(address (hexl-current-address)))
-    (if (or (> (+ address movement) hexl-max-address)
-	    (< (+ address movement) 0))
-	(message "Out of hexl region.")
-      (hexl-goto-address (+ address movement))
-      (recenter 0))))
-
-(defun hexl-beginning-of-1k-page ()
-  "Go to beginning of 1k boundary."
-  (interactive)
-  (hexl-goto-address (logand (hexl-current-address) -1024)))
-
-(defun hexl-end-of-1k-page ()
-  "Go to end of 1k boundary."
-  (interactive)
-  (hexl-goto-address (let ((address (logior (hexl-current-address) 1023)))
-		       (if (> address hexl-max-address)
-			   (setq address hexl-max-address))
-		       address)))
-
-(defun hexl-beginning-of-512b-page ()
-  "Go to beginning of 512 byte boundary."
-  (interactive)
-  (hexl-goto-address (logand (hexl-current-address) -512)))
-
-(defun hexl-end-of-512b-page ()
-  "Go to end of 512 byte boundary."
-  (interactive)
-  (hexl-goto-address (let ((address (logior (hexl-current-address) 511)))
-		       (if (> address hexl-max-address)
-			   (setq address hexl-max-address))
-		       address)))
-
-(defun hexl-quoted-insert (arg)
-  "Read next input character and insert it.
-Useful for inserting control characters.
-You may also type up to 3 octal digits, to insert a character with that code"
-  (interactive "p")
-  (hexl-insert-char (read-quoted-char) arg))
-
-;00000000: 0011 2233 4455 6677 8899 aabb ccdd eeff  0123456789ABCDEF
-
-;;;###autoload
-(defun hexlify-buffer ()
-  "Convert a binary buffer to hexl format.
-This discards the buffer's undo information."
-  (interactive)
-  (and buffer-undo-list
-       (or (y-or-n-p "Converting to hexl format discards undo info; ok? ")
-	   (error "Aborted")))
-  (setq buffer-undo-list nil)
-  (let ((binary-process-output nil) ; for Ms-Dos
-	(binary-process-input t)
-	(buffer-undo-list t))
-    (shell-command-on-region (point-min) (point-max) hexlify-command t)))
-
-(defun dehexlify-buffer ()
-  "Convert a hexl format buffer to binary.
-This discards the buffer's undo information."
-  (interactive)
-  (and buffer-undo-list
-       (or (y-or-n-p "Converting from hexl format discards undo info; ok? ")
-	   (error "Aborted")))
-  (setq buffer-undo-list nil)
-  (let ((binary-process-output t) ; for Ms-Dos
-	(binary-process-input nil)
-	(buffer-undo-list t))
-    (shell-command-on-region (point-min) (point-max) dehexlify-command t)))
-
-(defun hexl-char-after-point ()
-  "Return char for ASCII hex digits at point."
-  (hexl-htoi (char-after (point))
-	     (char-after (1+ (point)))))
-
-(defun hexl-htoi (lh rh)
-  "Hex (char) LH (char) RH to integer."
-    (+ (* (hexl-hex-char-to-integer lh) 16)
-       (hexl-hex-char-to-integer rh)))
-
-(defun hexl-hex-char-to-integer (character)
-  "Take a char and return its value as if it was a hex digit."
-  (if (and (>= character ?0) (<= character ?9))
-      (- character ?0)
-    (let ((ch (logior character 32)))
-      (if (and (>= ch ?a) (<= ch ?f))
-	  (- ch (- ?a 10))
-	(error "Invalid hex digit `%c'." ch)))))
-
-(defun hexl-oct-char-to-integer (character)
-  "Take a char and return its value as if it was a octal digit."
-  (if (and (>= character ?0) (<= character ?7))
-      (- character ?0)
-    (error "Invalid octal digit `%c'." character)))
-
-(defun hexl-printable-character (ch)
-  "Return a displayable string for character CH."
-  (format "%c" (if hexl-iso
-		   (if (or (< ch 32) (and (>= ch 127) (< ch 160)))
-		       46
-		     ch)
-		 (if (or (< ch 32) (>= ch 127))
-		     46
-		   ch))))
-
-(defun hexl-self-insert-command (arg)
-  "Insert this character."
-  (interactive "p")
-  (hexl-insert-char last-command-char arg))
-
-(defun hexl-insert-char (ch num)
-  "Insert a character in a hexl buffer."
-  (let ((address (hexl-current-address t)))
-    (while (> num 0)
-      (let ((hex-position
-	     (+ (* (/ address 16) 68)
-		11
-		(* 2 (% address 16))
-		(/ (% address 16) 2)))
-	    (ascii-position
-	     (+ (* (/ address 16) 68) 52 (% address 16)))
-	    at-ascii-position)
-	(if (= (point) ascii-position)
-	    (setq at-ascii-position t))
-	(goto-char hex-position)
-	(delete-char 2)
-	(insert (format "%02x" ch))
-	(goto-char ascii-position)
-	(delete-char 1)
-	(insert (hexl-printable-character ch))
-	(or (eq address hexl-max-address)
-	    (setq address (1+ address)))
-	(hexl-goto-address address)
-	(if at-ascii-position
-	    (progn
-	      (beginning-of-line)
-	      (forward-char 51)
-	      (forward-char (% address 16)))))
-      (setq num (1- num)))))
-
-;; hex conversion
-
-(defun hexl-insert-hex-char (arg)
-  "Insert a ASCII char ARG times at point for a given hexadecimal number."
-  (interactive "p")
-  (let ((num (hexl-hex-string-to-integer (read-string "Hex number: "))))
-    (if (or (> num 255) (< num 0))
-	(error "Hex number out of range.")
-      (hexl-insert-char num arg))))
-
-(defun hexl-insert-decimal-char (arg)
-  "Insert a ASCII char ARG times at point for a given decimal number."
-  (interactive "p")
-  (let ((num (string-to-int (read-string "Decimal Number: "))))
-    (if (or (> num 255) (< num 0))
-	(error "Decimal number out of range.")
-      (hexl-insert-char num arg))))
-
-(defun hexl-insert-octal-char (arg)
-  "Insert a ASCII char ARG times at point for a given octal number."
-  (interactive "p")
-  (let ((num (hexl-octal-string-to-integer (read-string "Octal Number: "))))
-    (if (or (> num 255) (< num 0))
-	(error "Decimal number out of range.")
-      (hexl-insert-char num arg))))
-
-;; startup stuff.
-
-(if hexl-mode-map
-    nil
-  (setq hexl-mode-map (make-sparse-keymap))
-
-  (define-key hexl-mode-map [left] 'hexl-backward-char)
-  (define-key hexl-mode-map [right] 'hexl-forward-char)
-  (define-key hexl-mode-map [up] 'hexl-previous-line)
-  (define-key hexl-mode-map [down] 'hexl-next-line)
-  (define-key hexl-mode-map [M-left] 'hexl-backward-short)
-  (define-key hexl-mode-map [M-right] 'hexl-forward-short)
-  (define-key hexl-mode-map [next] 'hexl-scroll-up)
-  (define-key hexl-mode-map [prior] 'hexl-scroll-down)
-  (define-key hexl-mode-map [home] 'hexl-beginning-of-buffer)
-  (define-key hexl-mode-map [deletechar] 'undefined)
-  (define-key hexl-mode-map [deleteline] 'undefined)
-  (define-key hexl-mode-map [insertline] 'undefined)
-  (define-key hexl-mode-map [S-delete] 'undefined)
-  (define-key hexl-mode-map "\177" 'undefined)
-
-  (define-key hexl-mode-map "\C-a" 'hexl-beginning-of-line)
-  (define-key hexl-mode-map "\C-b" 'hexl-backward-char)
-  (define-key hexl-mode-map "\C-d" 'undefined)
-  (define-key hexl-mode-map "\C-e" 'hexl-end-of-line)
-  (define-key hexl-mode-map "\C-f" 'hexl-forward-char)
-
-  (if (not (eq (key-binding (char-to-string help-char)) 'help-command))
-      (define-key hexl-mode-map (char-to-string help-char) 'undefined))
-
-  (define-key hexl-mode-map "\C-i" 'hexl-self-insert-command)
-  (define-key hexl-mode-map "\C-j" 'hexl-self-insert-command)
-  (define-key hexl-mode-map "\C-k" 'undefined)
-  (define-key hexl-mode-map "\C-m" 'hexl-self-insert-command)
-  (define-key hexl-mode-map "\C-n" 'hexl-next-line)
-  (define-key hexl-mode-map "\C-o" 'undefined)
-  (define-key hexl-mode-map "\C-p" 'hexl-previous-line)
-  (define-key hexl-mode-map "\C-q" 'hexl-quoted-insert)
-  (define-key hexl-mode-map "\C-t" 'undefined)
-  (define-key hexl-mode-map "\C-v" 'hexl-scroll-up)
-  (define-key hexl-mode-map "\C-w" 'undefined)
-  (define-key hexl-mode-map "\C-y" 'undefined)
-
-  (let ((ch 32))
-    (while (< ch 127)
-      (define-key hexl-mode-map (format "%c" ch) 'hexl-self-insert-command)
-      (setq ch (1+ ch))))
-
-  (define-key hexl-mode-map "\e\C-a" 'hexl-beginning-of-512b-page)
-  (define-key hexl-mode-map "\e\C-b" 'hexl-backward-short)
-  (define-key hexl-mode-map "\e\C-c" 'undefined)
-  (define-key hexl-mode-map "\e\C-d" 'hexl-insert-decimal-char)
-  (define-key hexl-mode-map "\e\C-e" 'hexl-end-of-512b-page)
-  (define-key hexl-mode-map "\e\C-f" 'hexl-forward-short)
-  (define-key hexl-mode-map "\e\C-g" 'undefined)
-  (define-key hexl-mode-map "\e\C-h" 'undefined)
-  (define-key hexl-mode-map "\e\C-i" 'undefined)
-  (define-key hexl-mode-map "\e\C-j" 'undefined)
-  (define-key hexl-mode-map "\e\C-k" 'undefined)
-  (define-key hexl-mode-map "\e\C-l" 'undefined)
-  (define-key hexl-mode-map "\e\C-m" 'undefined)
-  (define-key hexl-mode-map "\e\C-n" 'undefined)
-  (define-key hexl-mode-map "\e\C-o" 'hexl-insert-octal-char)
-  (define-key hexl-mode-map "\e\C-p" 'undefined)
-  (define-key hexl-mode-map "\e\C-q" 'undefined)
-  (define-key hexl-mode-map "\e\C-r" 'undefined)
-  (define-key hexl-mode-map "\e\C-s" 'undefined)
-  (define-key hexl-mode-map "\e\C-t" 'undefined)
-  (define-key hexl-mode-map "\e\C-u" 'undefined)
-
-  (define-key hexl-mode-map "\e\C-w" 'undefined)
-  (define-key hexl-mode-map "\e\C-x" 'hexl-insert-hex-char)
-  (define-key hexl-mode-map "\e\C-y" 'undefined)
-
-  (define-key hexl-mode-map "\ea" 'undefined)
-  (define-key hexl-mode-map "\eb" 'hexl-backward-word)
-  (define-key hexl-mode-map "\ec" 'undefined)
-  (define-key hexl-mode-map "\ed" 'undefined)
-  (define-key hexl-mode-map "\ee" 'undefined)
-  (define-key hexl-mode-map "\ef" 'hexl-forward-word)
-  (define-key hexl-mode-map "\eg" 'hexl-goto-hex-address)
-  (define-key hexl-mode-map "\eh" 'undefined)
-  (define-key hexl-mode-map "\ei" 'undefined)
-  (define-key hexl-mode-map "\ej" 'hexl-goto-address)
-  (define-key hexl-mode-map "\ek" 'undefined)
-  (define-key hexl-mode-map "\el" 'undefined)
-  (define-key hexl-mode-map "\em" 'undefined)
-  (define-key hexl-mode-map "\en" 'undefined)
-  (define-key hexl-mode-map "\eo" 'undefined)
-  (define-key hexl-mode-map "\ep" 'undefined)
-  (define-key hexl-mode-map "\eq" 'undefined)
-  (define-key hexl-mode-map "\er" 'undefined)
-  (define-key hexl-mode-map "\es" 'undefined)
-  (define-key hexl-mode-map "\et" 'undefined)
-  (define-key hexl-mode-map "\eu" 'undefined)
-  (define-key hexl-mode-map "\ev" 'hexl-scroll-down)
-  (define-key hexl-mode-map "\ey" 'undefined)
-  (define-key hexl-mode-map "\ez" 'undefined)
-  (define-key hexl-mode-map "\e<" 'hexl-beginning-of-buffer)
-  (define-key hexl-mode-map "\e>" 'hexl-end-of-buffer)
-
-  (define-key hexl-mode-map "\C-c\C-c" 'hexl-mode-exit)
-
-  (define-key hexl-mode-map "\C-x[" 'hexl-beginning-of-1k-page)
-  (define-key hexl-mode-map "\C-x]" 'hexl-end-of-1k-page)
-  (define-key hexl-mode-map "\C-x\C-p" 'undefined)
-  (define-key hexl-mode-map "\C-x\C-s" 'hexl-save-buffer)
-  (define-key hexl-mode-map "\C-x\C-t" 'undefined))
-
-;;; hexl.el ends here
diff --git a/lisp/hilit19.el b/lisp/hilit19.el
deleted file mode 100644
index 9694d7dd0c3..00000000000
--- a/lisp/hilit19.el
+++ /dev/null
@@ -1,1512 +0,0 @@
-;;; hilit19.el --- customizable highlighting for Emacs19
-
-;; Copyright (c) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author:   Jonathan Stigelman <stig@hackvan.com>
-;; Keywords: 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:
-
-;; Hilit19.el is a customizable highlighting package for Emacs19.  It supports
-;; not only source code highlighting, but also Info, RMAIL, VM, gnus...
-;; Hilit19 knows (or thinks it knows) how to highlight emacs buffers in
-;; about 25 different modes.
-;; 
-;; WHERE TO GET THE LATEST VERSIONS OF HILIT19.EL (beta and release), 
-;; PLUS LOTS OF OTHER *WAY COOL* STUFF VIA ANONYMOUS FTP:
-;;
-;;      ftp.hackvan.com:/pub/stig/src/elisp/hilit19.el.gz
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; TO SUBMIT BUG REPORTS (or feedback of any sort)...
-;;
-;;    M-x hilit-submit-feedback RET
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; hilit19.el,v 2.19 1993/09/08 18:44:10 stig Release
-;;
-;; LCD Archive Entry:
-;; hilit19|Jonathan Stigelman|stig@hackvan.com|
-;; Comprehensive (and comparatively fast) regex-based highlighting for Emacs 19|
-;; 1993/09/08 18:44:10|Release 2.19|~/packages/hilit19.el.Z|
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; GENERAL OVERVIEW
-;;
-;;      This package installs numerous hooks to colorfully highlight your
-;;      source code buffers as well as mail and news buffers.  Most 
-;;      programming languages have predefined highlighting patterns.
-;;	Just load hilit19 and files will be automatically highlighted as
-;;      they're loaded.
-;;
-;;      Rehighlight a buffer by typing C-S-l (control-shift-lowercase-L).
-;;
-;;      If, when you edit the buffer, the coloring gets messed up, just
-;;      redraw and the coloring will be adjusted.  If automatic highlighting
-;;      in the current buffer has been turned off, then typing C-u C-S-l will
-;;	force a rehighlight of the entire buffer.
-;;
-;;      Hilit19 can build faces by examining the names that you give to them
-;;	For example, green/black-bold-italic-underline would be created as
-;;	a face with a green foreground, and a black background, using a 
-;;	bold-italic font...with underlining for good measure.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; SETUP -- In your .emacs:
-;;
-;; 
-;; (cond (window-system
-;;        (setq hilit-mode-enable-list  '(not text-mode)
-;;              hilit-background-mode   'light
-;;              hilit-inhibit-hooks     nil
-;;              hilit-inhibit-rebinding nil)
-;; 
-;;        (require 'hilit19)
-;;        ))
-;; 
-;; If you like font-lock-mode and want to use both packages, then you can
-;; disable hilit for the modes in which you want to use font-lock by listing
-;; said modes in hilit-mode-enable-list.
-;; 
-;;      (hilit-translate type     'RoyalBlue   ; enable highlighting in C/C++
-;;			 string	  nil)         ; disable string highlighting
-;;
-;; To get 100% of the utility of hilit19, you may also have to apply the
-;; patches below for info.el and vm5.33L_19/vm-summary.el
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; SETUP -- Are you using the right font for Emacs?
-;;
-;; Emacs cannot properly find bold and italic fonts unless you specify a
-;; verbose X11 font name.  If you specify a font for emacs in your
-;; .Xdefaults, it *MUST* be specified using the long form of the font name.
-;; Here's a good font menu:
-;;
-;; (setq
-;;  x-fixed-font-alist
-;;  '("Font Menu"
-;;    ("Misc"
-;;     ("6x12" "-misc-fixed-medium-r-semicondensed--12-110-75-75-c-60-*-1")
-;;     ("6x13" "-misc-fixed-medium-r-semicondensed--13-120-75-75-c-60-*-1")
-;;     ("lucida 13"
-;;      "-b&h-lucidatypewriter-medium-r-normal-sans-0-0-0-0-m-0-*-1")
-;;     ("7x13" "-misc-fixed-medium-r-normal--13-120-75-75-c-70-*-1")
-;;     ("7x14" "-misc-fixed-medium-r-normal--14-130-75-75-c-70-*-1")
-;;     ("9x15" "-misc-fixed-medium-r-normal--15-140-*-*-c-*-*-1")
-;;     ("")
-;;     ("clean 8x8" "-schumacher-clean-medium-r-normal--*-80-*-*-c-*-*-1")
-;;     ("clean 8x14" "-schumacher-clean-medium-r-normal--*-140-*-*-c-*-*-1")
-;;     ("clean 8x10" "-schumacher-clean-medium-r-normal--*-100-*-*-c-*-*-1")
-;;     ("clean 8x16" "-schumacher-clean-medium-r-normal--*-160-*-*-c-*-*-1")
-;;     ("")
-;;     ("sony 8x16" "-sony-fixed-medium-r-normal--16-120-100-100-c-80-*-1")
-;;     ("")
-;;     ("-- Courier --")
-;;     ("Courier 10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-*-1")
-;;     ("Courier 12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-*-1")
-;;     ("Courier 14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-*-1")
-;;     ("Courier 18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-*-1")
-;;     ("Courier 18-b" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-*-1")
-;;     )))
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; KNOWN BUGS/TO DO LIST/HELP WANTED/APPLY WITHIN
-;;
-;; * unbalanced, unescaped double quote characters can confuse hilit19.
-;;   This will be fixed someday, so don't bug me about it.
-;;
-;; * ALTHOUGH HILIT19 IS FASTER THAN FONT-LOCK-MODE...
-;;   For various reasons, the speed of the package could still stand to be
-;;   improved.  If you care to do a little profiling and make things tighter...
-;;
-;; * hilit-toggle-highlight is flaky when auto-rehighlight is neither t nor nil.
-;;   Does anyone actually USE this?  I think I might just remove it.
-;;
-;; PROJECTS THAT YOU CAN TAKE OVER BECAUSE I DON'T MUCH CARE ABOUT THEM...
-;;
-;; * Moved hilit-wysiwyg-replace here from my version of man.el, this is not
-;;   a bug.  The bug is that I don't have a reverse operation yet...just a
-;;   stub Wysiwyg-anything really belongs in a package of its own.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Thanks to the following people for their input:
-;;    ebert@enpc.enpc.fr (Rolf EBERT), ada, LaTeX & bibtex highlights
-;;    Vivek Khera <khera@cs.duke.edu>, gnus hooks + random advice & patches
-;;    brian@athe.WUstl.EDU (Brian Dunford-Shore), prolog highlights
-;;    John Ladwig <jladwig@soils.umn.edu>, 1st pass nroff highlights
-;;    campo@sunthpi3.difi.unipi.it (Massimo Campostrini), fortran highlights
-;;    jayb@laplace.MATH.ColoState.EDU (Jay Bourland), 1st pass dired
-;;    Yoshio Turner <yoshio@CS.UCLA.EDU>, modula 2 highlights
-;;    Fritz Knabe <knabe@ecrc.de>, advice & patches
-;;    Alon Albert <alon@milcse.rtsg.mot.com>, advice & patches
-;;    dana@thumper.bellcore.com (Dana A. Chee), working on the multi-frame bug
-;;    derway@ndc.com (Don Erway), for breaking it...
-;;    moss_r@summer.chem.su.oz.au (Richard Moss), first pass at add-pattern
-;;    Olivier Lecarme <ol@aiguemarine.unice.fr>, Pascal & Icon patterns
-;;
-;; With suggestions and minor regex patches from numerous others...
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; hilit19.el,v
-;; Revision 2.19  1993/09/08  18:44:10  stig
-;; installed patch for elusive bug in hilit-rehighlight-region that caused
-;; hilit-unhighlight-region to hang in an infinite loop.
-;;
-;; Revision 2.18  1993/08/27  03:51:00  stig
-;; minor mods to lisp-mode and c/c++ mode patterns
-;;
-;; Revision 2.17  1993/08/25  02:19:17  stig
-;; work-around for bug in next-overlay-change that caused dired and jargon-mode
-;; to hang in an endless loop.  Perhaps other modes were doing this too.
-;;
-;; Revision 2.16  1993/08/22  19:46:00  stig
-;; bug fix for next-overlay-change and accompanying change to
-;; hilit-unhighlight-region
-;;
-;; Revision 2.15  1993/08/20  12:16:22  stig
-;; minor change to fortran patterns
-;;
-;; Revision 2.14  1993/08/17  14:12:10  stig
-;; added default face mapping for 'formula' which is needed for new latex
-;; patterns.
-;;
-;; twiddled the calendar-mode patterns a bit.
-;;
-;; Revision 2.13  1993/08/16  04:33:54  stig
-;; hilit-set-mode-patterns was screwing up two part patterns.  it doesn't now.
-;;
-;; Revision 2.12  1993/08/16  00:16:41  stig
-;; changed references to default-bold-italic to just bold-italic because the
-;;   font for that face is maintained by emacs.
-;;
-;; the pattern matcher now starts its searches from the end of the most
-;;   recently highlighted region (which is not necessarily the end of the most
-;;   recently matched regex).
-;;
-;; multiple errors in pattern matcher now just give an error instead of lots of
-;;   annoying messages and dings.
-;;
-;; no longer use vm-summary-mode-hooks.
-;;
-;; some code moved from hilit-highlight-region to hilit-set-mode-patterns.
-;;   This will affect you if you pass your patterns directly to
-;;   hilit-highlight-region....use a pseudo-mode instead.
-;;
-;; pattern changes to C/C++, latex, texinfo, fortran, nroff, etc.
-;;
-;; Revision 2.11  1993/08/13  12:12:37  stig
-;; removed some crufty commented-out code
-;;
-;; diverged lisp-mode and emacs-lisp-mode...also added lisp keywords.
-;;
-;; Revision 2.10  1993/08/13  09:47:06  stig
-;; added calendar-mode, icon-mode and pascal-mode patterns
-;;
-;; commented out hilit-toggle-highlight because I want to phase it out entirely
-;;
-;; Revision 2.9  1993/08/13  08:44:22  stig
-;; added optional case-fold argument to hilit-set-mode-patterns, this case-fold
-;; parameter is now stored in hilit-patterns-alist.
-;;
-;; Revision 2.8  1993/08/12  22:05:03  stig
-;; fixed some typos in documentation
-;;
-;; twiddled some of the color defaults for dark backgrounds
-;;
-;; always get 'mono color defaults if (not (x-display-color-p))
-;;
-;; added hilit-rehighlight-buffer-quietly to dired-after-readin-hook
-;;
-;; fixed bug in hilit-string-find that mishandled strings of the form: "\\"
-;;
-;; NEW FUNCTION: hilit-add-mode-pattern...  kinda like add-hook for patterns
-;;
-;; fixed minor pattern bugs for latex-mode and emacs-lisp-mode
-;;
-;; Revision 2.7  1993/07/30  02:43:01  stig
-;; added const to the list of modifiers for C/C++ types
-;;
-;; Revision 2.6  1993/07/30  00:30:54  stig
-;; now permit selection of arbitrary subexpressions for highlighting...
-;; fixed keyword patterns for C/C++ using this technique.
-;;
-;; Revision 2.5  1993/07/28  05:02:56  stig
-;; improvements to makefile regular expressions
-;; removed about 130 lines just by compacting the big defconst for
-;;   hilit-face-translation-table into a mapcar and defining a separate table
-;;   of default faces.
-;;
-;; Revision 2.4  1993/07/27  14:09:05  stig
-;; documented another "known problem" to "head off gripe mail at the pass."
-;;
-;; Revision 2.3  1993/07/27  02:15:49  stig
-;; (hilit-lookup-face-create) incorporated patch which improves its behavior
-;; with more than one frame...  Still can't have bold on the same face in two
-;; different fonts sizes at the same time...
-;;
-;; Revision 2.2  1993/07/27  02:02:59  stig
-;; vastly improved the makefile patterns
-;; added hook for mh-show-mode
-;;
-;; Revision 2.1  1993/07/24  17:46:21  stig
-;; Phasing out Info-select-hook...  Version 19.18 will use Info-selection-hook.
-;;
-;; Revision 2.0  1993/07/24  13:50:10  stig
-;; better documentation and added the function hilit-submit-feedback.
-;; C-S-l (control shift l) repaints the buffer.  Other bindings are optional.
-;; multi-line highlights no longer cause problems when
-;;   hilit-auto-rehighlight is 'visible
-;; added hilit-predefined-face-list...
-;; changed name of hilit-mode-alist to hilit-patterns-alist
-;; added hilit-message-quietly to mail-setup-hook
-;; added hilit-parser-alist which can be used to apply different patterns to
-;;   different parts of a buffer.  This could be integrated in a far more
-;;   elegant manner, but it presently serves the purpose of not applying
-;;   message header patterns to message bodies in mail-mode and its kin.
-;; hilit-set-mode-patterns now takes a list of modes and an optional parse-fn
-;;
-
-;;;;;; AND THIS CAN BE APPLIED TO VM 5.33L_19
-;; 
-;; *** ../site/vm5.33L_19/vm-summary.el    Fri Jun  4 22:17:11 1993
-;; --- ./vm-summary.el     Tue Jun 22 16:39:30 1993
-;; ***************
-;; *** 152,158 ****
-;;                   (insert "->")
-;;                   (delete-char 2)
-;;                   (forward-char -2)
-;; !                 (and w vm-auto-center-summary (vm-auto-center-summary))))
-;;             (and old-window (select-window old-window)))))))
-;;   
-;;   (defun vm-mark-for-display-update (message)
-;; --- 152,159 ----
-;;                   (insert "->")
-;;                   (delete-char 2)
-;;                   (forward-char -2)
-;; !                 (and w vm-auto-center-summary (vm-auto-center-summary))
-;; !                 (run-hooks 'vm-summary-pointer-hook)))
-;;             (and old-window (select-window old-window)))))))
-;;   
-;;   (defun vm-mark-for-display-update (message)
-;; 
-;;;;;;
-
-;;; Code:
-
-;; User Options:
-
-(defvar hilit-quietly nil
-  "* If non-nil, this inhibits progress indicators during highlighting")
-
-(defvar hilit-auto-highlight t
-  "* T if we should highlight all buffers as we find 'em, nil to disable
-  automatic highlighting by the find-file hook.")
-
-(defvar hilit-auto-highlight-maxout 60000 ; hilit19 keeps getting bigger...
-  "* auto-highlight is disabled in buffers larger than this")
-
-(defvar hilit-auto-rehighlight t
-  "* If this is non-nil, then hilit-redraw and hilit-recenter will also
-  rehighlight part or all of the current buffer.  T will rehighlight the
-  whole buffer, a NUMBER will rehighlight that many lines before and after
-  the cursor, and the symbol 'visible' will rehighlight only the visible
-  portion of the current buffer.  This variable is buffer-local.")
-
-(make-variable-buffer-local 'hilit-auto-rehighlight)
-
-(defvar hilit-auto-rehighlight-fallback '(20000 . 100)
-  "* Cons of the form (THRESHOLD . FALLBACK), where FALLBACK is assigned to
-  hilit-auto-rehighlight if the size of a newly opened buffer is larger than
-  THRESHOLD.")
-
-(defvar hilit-face-check t
-  "* T slows down highlighting but permits the user to change fonts without
-  losing bold and italic faces...  T causes hilit-lookup-face-create to dig
-  through the frame parameters for the current window every time it's called.
-  If you never change fonts in emacs, set this to NIL.")
-
-;; Variables which must be set before loading hilit19.
-
-(defvar hilit-inhibit-rebinding nil
-  "If non-nil, this inhibits replacement of recenter, yank, and yank-pop.")
-
-(defvar hilit-inhibit-hooks nil
-  "If non-nil, this inhibits installation of hooks for Info, gnus, & vm.")
-
-(defvar hilit-background-mode 'light
-  "'mono inhibits color, 'dark or 'light indicate the background brightness.")
-
-(defvar hilit-mode-enable-list nil
-  "If a list of modes to exclusively enable or specifically disable.
-The sense of the list is negated if it begins with the symbol 'not'.
-Set this variable before you load hilit19.
-
-Ex:  (perl-mode jargon-mode c-mode)	; just perl, C, and jargon modes
-     (not text-mode)			; all modes except text mode")
-
-;; Variables that are not generally modified directly
-
-(defvar hilit-parser-alist nil
-  "alist of major-mode values and parsers called by hilit-rehighlight-buffer.
-
-Parsers for a given mode are IGNORED for partial rehighlights...maybe you'd
-like to make this more universal?")
-
-(defvar hilit-patterns-alist nil
-  "alist of major-mode values and default highlighting patterns
-
-A highlighting pattern is a list of the form (start end face), where
-start is a regex, end is either a regex or a match number for start, and face
-is the name of an entry in hilit-face-translation-table, the name of a face,
-or nil (which disables the pattern).
-
-Each entry in the alist is of the form:
-	(mode . (case-fold pattern [pattern ...]))
-
-See the hilit-lookup-face-create documentation for valid face names.")
-
-(defvar hilit-predefined-face-list (face-list)
-  "List of faces with which hilit-lookup-face-create will NOT tamper.
-
-If hilit19 is dumped into emacs at your site, you may have to set this in
-your init file.")
-
-(eval-when-compile (setq byte-optimize t))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Use this to report bugs:
-
-(eval-when-compile (require 'reporter))	; no compilation gripes
-
-(defun hilit-submit-feedback ()
-  "Submit feedback on hilit19 to the author: stig@hackvan.com"
-  (interactive)
-  (require 'reporter)
-  (and (y-or-n-p "Do you really want to submit a report on hilit19? ")
-       (reporter-submit-bug-report
-	"Jonathan Stigelman <stig@hackvan.com>"
-	"hilit19.el (Release 2.19)"
-	(and (y-or-n-p "Do you need to include a dump hilit variables? ")
-	     (append
-	      '(
-		hilit-quietly    		hilit-inhibit-hooks
-		hilit-background-mode		hilit-mode-enable-list
-		hilit-auto-highlight		hilit-auto-highlight-maxout
-		hilit-auto-rehighlight		hilit-auto-rehighlight-fallback
-		hilit-face-check
-		)
-	      (and (y-or-n-p "Have you modified the standard patterns? ")
-		   (yes-or-no-p "Are your patterns *REALLY* relevant? ")
-		   '(hilit-parser-alist
-		     hilit-patterns-alist
-		     hilit-predefined-face-list
-		     ))))
-	 (function
-	  (lambda ()
-	    (and (y-or-n-p "Is this a problem with font display? ")
-		 (insert "\nFrame Configuration:\n====================\n"
-			 (prin1-to-string (frame-configuration-to-register ?F))
-			 "\n"
-			 ))))
-	 nil
-	 (concat
-	  "This is (check all that apply, and delete what's irrelevant):\n"
-	  "  [ ] a _MASSIVE_THANK_YOU_ for writing hilit19.el\n"
-	  "  [ ] An invitation to attend the next Hackers Conference\n"
-	  "  [ ] You're a RIGHTEOUS HACKER, what are your rates?\n"
-	  "  [ ] I've used the force and read the source, but I'M CONFUSED\n"
-	  "  [ ] a PATCH. (output of 'diff -uw old.el new.el' or 'diff -cw')\n"
-	  "  [ ] a SERIOUS AND REPRODUCIBLE BUG that is not an EMACS bug\n"
-	  "     - I *swear* that it's not already mentioned in the KNOWN BUGS\n"
-	  "     - I HAVE CHECKED ftp.hackvan.com:/pub/stig/src/elisp/hilit19.el.gz\n"
-	  "       for a newer release that fixes the problem.\n"
-	  "    >> I HAVE ALSO CHECKED ftp.hackvan.com:/pub/stig/src/elisp/hl319.el.gz\n"
-	  "       This is the alpha version...what will become hilit19 (Beta 3.0).\n"
-	  "\n"
-	  "Hey Stig, I *know* you're busy but...\n"))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; These faces are either a valid face name, or nil
-;; if you want to change them, you must do so AFTER hilit19 is loaded
-
-(defconst hilit-default-face-table
-  '(
-    ;; used for C/C++ and Emacs Lisp and perl
-    (comment	firebrick-italic    moccasin           italic)
-    (include	purple		    Plum1	       bold-italic)
-    (define	ForestGreen-bold    green	       bold)
-    (defun	blue-bold	    cyan-bold	       bold-italic)
-    (decl	RoyalBlue	    cyan	       bold)
-    (type	nil		    yellow	       nil)
-    (keyword	RoyalBlue	    cyan	       bold-italic)
-    (label	red-underline	    orange-underlined  underline)
-    (string	grey40		    orange	       underline)
-    
-    ;; some further faces for Ada
-    (struct	  black-bold        white-bold	       bold)
-    (glob-struct  magenta	    Plum1	       default-bold-underline)
-    (named-param  DarkGoldenrod	    Goldenrod	       underline)
-	
-    ;; and another one for LaTeX
-    (crossref	  DarkGoldenrod	    Goldenrod	       underline)
-    (formula	  Goldenrod	    DarkGoldenrod      underline)
- 
-    ;; compilation buffers
-    (active-error default/pink-bold  default/DeepPink-bold  default-underline)
-    (error	  red-bold           yellow	       bold)
-    (warning	  blue-italic	     green	       italic)
-
-    ;; Makefiles (some faces borrowed from C/C++ too)
-    (rule	  blue-bold-underline cyan-underline   default-bold-underline)
-    
-    ;; VM, GNUS and Text mode
-    (msg-subject    blue-bold       yellow             bold)
-    (msg-from	    purple-bold	    green	       bold)
-    (msg-header	    firebrick-bold  cyan	       italic)
-    (msg-separator  black/tan-bold  black/lightblue    nil)
-    (msg-quote	    ForestGreen	    pink	       italic)
-
-    (summary-seen     grey40	    white	       nil)
-    (summary-killed   grey50	    white	       nil)
-    (summary-Xed      OliveDrab2    green	       nil)
-    (summary-deleted  firebrick	    white	       italic)
-    (summary-unread   RoyalBlue	    yellow	       bold)
-    (summary-new      blue-bold	    yellow-bold	       bold-italic)
-    (summary-current  default/skyblue-bold green/dimgrey-bold reverse-default)
-
-    (gnus-group-unsubscribed grey50		white	    nil)
-    (gnus-group-empty	     nil		nil	    nil)
-    (gnus-group-full	     ForestGreen	green	    italic)
-    (gnus-group-overflowing  firebrick		red	    bold-italic)
-
-    ;; dired mode
-    (dired-directory blue-bold         cyan            bold)
-    (dired-link	     firebrick-italic  green	       italic)
-    (dired-ignored   ForestGreen       moccasin	       nil)
-    (dired-deleted   red-bold-italic   orange	       bold-italic)
-    (dired-marked    purple	       Plum1	       nil)
-	
-    ;; Info-mode, and jargon-mode.el and prep.ai.mit.edu:/pub/gnu/jargon*
-    (jargon-entry    blue-bold	       cyan            bold)
-    (jargon-xref     purple-bold       Plum1	       italic)
-    (jargon-keyword  firebrick-underline yellow	       underline)
-    )
-  "alist of default faces (face . (light-default dark-default mono-default))
-
-There is no way for the user to modify this table such that it will have any
-effect upon the translations used by hilit19.  Instead, use the function
-hilit-translate AFTER hilit19 has been loaded.
-
-See also the documentation for hilit-lookup-face-create.")
-
-(defconst hilit-face-translation-table
-  (let ((index (or (and (x-display-color-p)
-			(cdr (assq hilit-background-mode
-				   '((light . 1) (dark . 2)))))
-		   3)))
-    (mapcar (function (lambda (x) (cons (car x) (nth index x))))
-	    hilit-default-face-table))
-  "alist that maps symbolic face-names to real face names")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; To translate one face to another...
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro hilit-translate (&rest args)
-  "(hilit-translate FROM TO FROM TO ...): translate each face FROM to the
-value of its TO face.  This is like setq for faces.
-
-The function hilit-lookup-face-create will repeatedly translate until no more
-translations for the face exist in the translation table.
-
-See the documentation for hilit-lookup-face-create for names of valid faces."
-  (or (zerop (% (length args) 2))
-      (error "wrong number of args"))
-  (let (cmdl from to)
-    (while args
-      (setq from (car args) to (nth 1 args) args (nthcdr 2 args)
-	    cmdl (cons (list 'hilit-associate ''hilit-face-translation-table
-			     (list 'quote from) to)
-		       cmdl)))
-    (cons 'progn cmdl)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
-;; This function actually translates and then creates the faces...
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
-
-(defun hilit-lookup-face-create (face &optional force)
-  "Get a FACE, or create it if it doesn't exist.  In order for it to
-properly create the face, the following naming convention must be used:
-    [reverse-](fgcolor[/bgcolor])[-bold][-italic][-underline]
-Example: (hilit-lookup-face-create 'comment-face) might create and return 'red
-
-Each color is either the name of an X color (see .../X11/lib/X11/rgb.txt),
-a hexadecimal specification of the form \"hex-[0-9A-Fa-f]+\", or \"default\".
-
-An optional argument, FORCE, will cause the face to be recopied from the
-default...which is probably of use only if you've changed fonts.
-
-See the documentation for hilit-translate and hilit-face-translation-table."
-
-;; translate the face ...
-  (let ((trec t) visited)
-    (while trec
-      (cond ((memq face visited) (error "face translation loop: %S" visited))
-	    (t (setq visited (cons face visited)
-		     trec (assq face hilit-face-translation-table))
-	       (and trec (setq face (cdr trec)))))))
-
-  ;; make the face if we need to...
-  (let* ((fn (symbol-name face))
-	 (frame (selected-frame))
-	 (basefont (cdr (assq 'font (frame-parameters frame))))
-	 error fgcolor bgcolor)
-    (cond
-     ((or (null face)			
-	  (memq face hilit-predefined-face-list))
-      ;; do nothing if the face is nil or if it's predefined.
-      )
-     ((or force
-	  (not (memq face (face-list)))
-	  (and hilit-face-check
-	       (not (string= (get face 'basefont) basefont))))
-      (copy-face 'default 'scratch-face)
-      (if (string-match "^reverse-?" fn)
-	  (progn (invert-face 'scratch-face)
-		 (setq fn (substring fn (match-end 0)))))
-
-      ;; parse foreground color
-      (if (string-match "^\\(hex-\\)?\\([A-Za-z0-9]+\\)" fn)
-	  (setq fgcolor (concat
-			 (if (match-beginning 1) "#")
-			 (substring fn (match-beginning 2) (match-end 2)))
-		fn (substring fn (match-end 0)))
-	(error "bad face name %S" face))
-
-      ;; parse background color
-      (if (string-match "^/\\(hex-\\)?\\([A-Za-z0-9]+\\)" fn)
-	  (setq bgcolor (concat
-			 (and (match-beginning 1) "#")
-			 (substring fn (match-beginning 2) (match-end 2)))
-		fn (substring fn (match-end 0))))
-      
-      (and (string= "default" fgcolor) (setq fgcolor nil))
-      (and (string= "default" bgcolor) (setq bgcolor nil))
-      
-      ;; catch errors if we can't allocate the color(s)
-      (condition-case nil
-	  (progn (set-face-foreground 'scratch-face fgcolor)
-		 (set-face-background 'scratch-face bgcolor)
-		 (copy-face 'scratch-face face)
-		 (put face 'basefont basefont))
-	(error (message "couldn't allocate color for '%s'"
-			(symbol-name face))
-	       (setq face 'default)
-	       (setq error t)))
-      (or error
-	  ;; don't bother w/ bold or italic if we didn't get the color
-	  ;; we wanted, but ignore errors making the face bold or italic
-	  ;; if the font isn't available, there's nothing to do about it...
-	  (progn
-	    (set-face-font face nil frame)
-	    (set-face-underline-p face (string-match "underline" fn))
-	    (if (string-match ".*bold" fn)
-		;; make face bold in all frames
-		(make-face-bold face nil 'noerr))
-	    (if (string-match ".*italic" fn)
-		;; make face italic in all frames
-		(make-face-italic face nil 'noerr))
-	    ))
-      )))
-  face)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Region Highlight/Unhighlight code (Both overlay and text-property versions)
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defsubst hilit-region-set-face (start end face-name &optional prio prop)
-  "Highlight region from START to END using FACE and, optionally, PRIO.
-The optional 5th arg, PROP is a property to set instead of 'hilit."
-  (let ((overlay (make-overlay start end)))
-    (overlay-put overlay 'face face-name)
-    (overlay-put overlay (or prop 'hilit) t)
-    (and prio (overlay-put overlay 'priority prio))))
-
-(defun hilit-unhighlight-region (start end &optional quietly)
-  "Unhighlights the region from START to END, optionally in a QUIET way"
-  (interactive "r")
-  (or quietly hilit-quietly (message "Unhighlighting"))
-  (let ((lstart 0))
-    (while (and start (> start lstart) (< start end))
-      (mapcar (function (lambda (ovr)
-			  (and (overlay-get ovr 'hilit) (delete-overlay ovr))))
-	      (overlays-at start))
-      (setq lstart start start (next-overlay-change start))))
-  (or quietly hilit-quietly (message "Done unhighlighting")))
-
-;;;; These functions use text properties instead of overlays.  Text properties
-;;;; are copied through kill and yank...which might be convenient, but is not
-;;;; terribly efficient as of 19.12, ERGO it's been disabled
-;;
-;;(defsubst hilit-region-set-face (start end face-name &optional prio prop)
-;;  "Highlight region from START to END using FACE and, optionally, PRIO.
-;;The optional 5th arg, PROP is a property to set instead of 'hilit."
-;;    (put-text-property start end 'face face-name)
-;;    )
-;;
-;;(defun hilit-unhighlight-region (start end &optional quietly)
-;;  "Unhighlights the region from START to END, optionally in a QUIET way"
-;;  (interactive "r")
-;;  (let ((buffer-read-only nil)
-;;	(bm (buffer-modified-p)))
-;;    (remove-text-properties start end '(face))
-;;    (set-buffer-modified-p bm)))
-;;;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Pattern Application code and user functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun hilit-highlight-region (start end &optional patterns quietly)
-  "Highlights the area of the buffer between START and END (the region when
-interactive).  Without the optional PATTERNS argument, the pattern for
-major-mode is used.  If PATTERNS is a symbol, then the patterns associated
-with that symbol are used.  QUIETLY suppresses progress messages if
-non-nil."
-  (interactive "r")
-  (cond ((null patterns)
-	 (setq patterns (cdr (assq major-mode hilit-patterns-alist))))
-	((symbolp patterns)
-	 (setq patterns (cdr (assq patterns hilit-patterns-alist)))))  
-  ;; txt prop: (setq patterns (reverse patterns))
-  (let ((case-fold-search (car patterns))
-	(prio (1- (length patterns)))
-	;; txt prop: (buffer-read-only nil)
-	;; txt prop: (bm (buffer-modified-p))
-	p pstart pend face mstart (puke-count 0))
-    ;; txt prop: (unwind-protect
-    (setq patterns (cdr patterns))	; remove case-fold from head of pattern
-    (save-excursion
-      (save-restriction
-	(narrow-to-region start end)
-	(while patterns
-	  (setq p (car patterns))
-	  (setq pstart (car p)
-		pend (nth 1 p)
-		face (hilit-lookup-face-create (nth 2 p)))
-	  (if (not face)		; skipped if nil
-	      nil
-	    (or quietly hilit-quietly
-		(message "highlighting %d: %s%s" prio pstart 
-			 (if (stringp pend) (concat " ... " pend) "")))
-	    (goto-char (point-min))
-	    (condition-case msg
-		(cond 
-		      ((symbolp pstart)
-		       ;; inner loop -- special function to find pattern
-		       (let (region)
-			 (while (setq region (funcall pstart pend))
-			   (hilit-region-set-face (car region) (cdr region)
-						  face prio))))
-		      ((stringp pend)
-		       ;; inner loop -- regex-start ... regex-end
-		       (while (re-search-forward pstart nil t nil)
-			 (goto-char (setq mstart (match-beginning 0)))
-			 (if (re-search-forward pend nil t nil)
-			     (hilit-region-set-face mstart (match-end 0)
-						    face prio)
-			   (forward-char 1))))
-		      ((numberp pend)
-		       ;; inner loop -- just one regex to match whole pattern
-		       (while (re-search-forward pstart nil t nil)
-			 (goto-char (match-end pend))
-			 (hilit-region-set-face  (match-beginning pend)
-						 (match-end pend) face prio)))
-		      (t (error "malformed pattern")))
-	      (error (if (> (setq puke-count (1+ puke-count)) 1)
-			 (error msg)
-		       (message "Error: '%s'" msg)
-		       (ding) (sit-for 4)))))
-	  (setq prio (1- prio)
-		patterns (cdr patterns)))
-	))
-    (or quietly hilit-quietly (message "")) ; "Done highlighting"
-    ;; txt prop: (set-buffer-modified-p bm)) ; unwind protection
-    ))
-
-(defun hilit-rehighlight-region (start end &optional quietly)
-  "Re-highlights the region, optionally in a QUIET way"
-  (interactive "r")
-  (save-restriction
-    (widen)
-    (setq start (apply 'min start (mapcar 'overlay-start (overlays-at start)))
-	  end (apply 'max end (mapcar 'overlay-end (overlays-at end))))
-    (hilit-unhighlight-region start end quietly)
-    (hilit-highlight-region   start end nil quietly)))
-
-(defun hilit-rehighlight-buffer (&optional quietly)
-  "Re-highlights the buffer, optionally in a QUIET way"
-  (interactive "")
-  (let ((parse-fn (cdr (assq major-mode hilit-parser-alist))))
-    (if parse-fn
-	(funcall parse-fn quietly)
-      (hilit-rehighlight-region (point-min) (point-max) quietly)))
-  nil)
-
-(defun hilit-rehighlight-buffer-quietly ()
-  (hilit-rehighlight-buffer t))
-
-(defun hilit-rehighlight-message (quietly)
-  "Highlight a buffer containing a news article or mail message."
-  (save-excursion
-    (goto-char (point-min))
-    (re-search-forward "^$" nil 'noerr)
-    (hilit-unhighlight-region (point-min) (point-max) quietly)
-    (hilit-highlight-region (point-min) (point) 'msg-header quietly)
-    (hilit-highlight-region (point) (point-max) 'msg-body quietly)))
-
-(defalias 'hilit-highlight-buffer 'hilit-rehighlight-buffer)
-
-;; Well, I want to remove this function...there's one sure way to find out if
-;; anyone uses it or not...and that's to comment it out.
-;; 
-;; (defun hilit-toggle-highlight (arg)
-;;   "Locally toggle highlighting.  With arg, forces highlighting off."
-;;   (interactive "P")
-;;   ;; FIXME -- this loses numeric information in hilit-auto-rehighlight
-;;   (setq hilit-auto-rehighlight
-;;         (and (not arg) (not hilit-auto-rehighlight)))
-;;   (if hilit-auto-rehighlight
-;;       (hilit-rehighlight-buffer)
-;;     (hilit-unhighlight-region (point-min) (point-max)))
-;;   (message "Rehighlighting is set to %s" hilit-auto-rehighlight))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; HOOKS
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun hilit-find-file-hook ()
-  "Find-file hook for hilit package.  See the variable hilit-auto-highlight."
-  (cond ((and hilit-auto-highlight
-	      (assq major-mode hilit-patterns-alist))
-	 (if (> buffer-saved-size (car hilit-auto-rehighlight-fallback))
-	     (setq hilit-auto-rehighlight
-		   (cdr hilit-auto-rehighlight-fallback)))
-	 (if (> buffer-saved-size hilit-auto-highlight-maxout)
-	     nil
-	   (let ((bm (buffer-modified-p)))
-	     (hilit-rehighlight-buffer)
-	     (set-buffer-modified-p bm))))))
-
-(defun hilit-repaint-command (arg)
-  "Rehighlights according to the value of hilit-auto-rehighlight, or the
-prefix argument if that is specified.
-\t\\[hilit-repaint-command]\t\trepaint according to hilit-auto-rehighlight
-\t^U \\[hilit-repaint-command]\trepaint entire buffer
-\t^U - \\[hilit-repaint-command]\trepaint visible portion of buffer
-\t^U n \\[hilit-repaint-command]\trepaint n lines to either side of point"
-  (interactive "P") 
-  (let (st en quietly)
-    (or arg (setq arg hilit-auto-rehighlight))
-    (cond ((or (eq  arg 'visible) (eq arg '-))
-	   (setq st (window-start) en (window-end) quietly t))
-	  ((numberp arg)
-	   (setq st (save-excursion (forward-line (- arg)) (point))
-		 en (save-excursion (forward-line arg) (point))))
-	  (arg
-	   (hilit-rehighlight-buffer)))
-    (if st
-	  (hilit-rehighlight-region st en quietly))))
-
-(defun hilit-recenter (arg)
-  "Recenter, then rehighlight according to hilit-auto-rehighlight.  If called
-with an unspecified prefix argument (^U but no number), then a rehighlight of
-the entire buffer is forced."
-  (interactive "P")
-  (recenter arg)
-  ;; force display update
-  (sit-for 0)
-  (hilit-repaint-command (consp arg)))
-
-(defun hilit-yank (arg)
-  "Yank with rehighlighting"
-  (interactive "*P")
-  (let ((transient-mark-mode nil))
-    (yank arg)
-    (and hilit-auto-rehighlight
-	 (hilit-rehighlight-region (region-beginning) (region-end) t))
-    (setq this-command 'yank)))
-
-(defun hilit-yank-pop (arg)
-  "Yank-pop with rehighlighting"
-  (interactive "*p")
-  (let ((transient-mark-mode nil))
-    (yank-pop arg)
-    (and hilit-auto-rehighlight
-	 (hilit-rehighlight-region (region-beginning) (region-end) t))
-    (setq this-command 'yank)))
-
-;;; this line highlighting stuff is untested.  play with it only if you feel
-;;; adventurous...don't ask me to fix it...though you're welcome to.  -- Stig
-;; 
-;; (defun hilit-rehighlight-line-quietly (&rest args)
-;;   "Quietly rehighlight just this line.
-;; Useful as an after change hook in VM/gnus summary buffers and dired buffers.
-;; If only there were an after-change-function, that is..."
-;;   (save-excursion
-;;     (push-mark nil t)
-;;     (hilit-rehighlight-yank-region)
-;;     (and orig-achange-function (apply orig-achange-function args))))
-;; 
-;; (defun hilit-install-line-hooks ()
-;;   (make-variable-buffer-local 'after-change-function)
-;;   (make-local-variable 'orig-achange-function)
-;;   (setq orig-achange-function after-change-function)
-;;   (setq after-change-function 'hilit-rehighlight-line-quietly))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Wysiwyg Stuff...  take it away and build a whole package around it!
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; 
-;; ; For the Jargon-impaired, WYSIWYG === What You See Is What You Get
-;; ; Sure, it sucks to type.  Oh, well.
-;; (defun hilit-wysiwyg-replace ()
-;;   "Replace overstruck text with normal text that's been overlaid with the 
-;; appropriate text attribute.  Suitable for a find-file hook."
-;;   (save-excursion
-;;     (goto-char (point-min))
-;;     (let ((wysb (hilit-lookup-face-create 'wysiwyg-bold))
-;; 	  (wysu (hilit-lookup-face-create 'wysiwyg-underline))
-;; 	  (bmod (buffer-modified-p)))
-;;       (while (re-search-forward "\\(.\b.\\)+" nil t)
-;; 	(let ((st (match-beginning 0)) (en (match-end 0)))
-;; 	  (goto-char st)
-;; 	  (if (looking-at "_")
-;; 	      (hilit-region-set-face st en wysu 100 'wysiwyg)
-;; 	    (hilit-region-set-face st en wysb 100 'wysiwyg))
-;; 	  (while (and (< (point) en) (looking-at ".\b"))
-;; 	    (replace-match "") (forward-char))
-;; 	  ))
-;;       (set-buffer-modified-p bmod))))
-;; 
-;; ; is this more appropriate as a write-file-hook or a write-contents-hook?
-;; (defun hilit-wysiwyg-write-repair ()
-;;   "Replace wysiwyg overlays with overstrike text."
-;;   (message "*sigh* hilit-wysiwyg-write-repair not implemented yet")
-;;
-;; For efficiency, this hook should copy the current buffer to a scratch
-;; buffer and do its overstriking there.  Overlays are not copied, so it'll
-;; be necessary to hop back and forth.  This is OK since you're not fiddling
-;; with--making or deleting--any overlays.  THEN write the new buffer,
-;; delete it, and RETURN T. << important
-;;
-;; Just so you know...there is already an emacs function called
-;; underline-region that does underlining.  I think that the thing to do is
-;; extend that to do overstriking as well.
-;;
-;;  (while (< start end)
-;;    (mapcar (function (lambda (ovr)
-;;			  (and (overlay-get ovr 'hilit) (delete-overlay ovr))))
-;;	    (overlays-at start))
-;;    (setq start (next-overlay-change start)))
-;;  nil)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Initialization.  
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(and (not hilit-inhibit-rebinding)
-     window-system
-     (progn 
-       (substitute-key-definition 'yank     'hilit-yank
-				  (current-global-map))
-       (substitute-key-definition 'yank-pop 'hilit-yank-pop
-				  (current-global-map))
-       (substitute-key-definition 'recenter 'hilit-recenter
-				  (current-global-map))))
-
-(global-set-key [?\C-\S-l] 'hilit-repaint-command)
-
-(and window-system
-     (add-hook 'find-file-hooks 'hilit-find-file-hook t))
-
-(eval-when-compile (require 'gnus))	; no compilation gripes
-
-(and (not hilit-inhibit-hooks)
-     window-system
-     (condition-case c
-	 (progn
-
-	   ;; BUFFER highlights...
-	   (mapcar (function
-		    (lambda (hook)
-		      (add-hook hook 'hilit-rehighlight-buffer-quietly)))
-		   '(
-		     Info-selection-hook
-
-;; runs too early		     vm-summary-mode-hooks
-		     vm-summary-pointer-hook
-		     vm-preview-message-hook
-		     vm-show-message-hook
-
-		     rmail-show-message-hook
-		     mail-setup-hook 
-		     mh-show-mode-hook
-
-		     dired-after-readin-hook
-		     ))
-	   )
-       (error (message "Error loading highlight hooks: %s" c)
-	      (ding) (sit-for 1))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Default patterns for various modes.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; do I need this?  I changed the defconst to a defvar because defconst is
-;;; inappropriate, but I don't know why I wanted hilit-patterns-alist to be
-;;; reset on every reload...
-
-(setq hilit-patterns-alist nil) 
-
-(defun hilit-associate (alist key val)
-  "creates, or destructively replaces, the pair (key . val) in alist"
-  (let ((oldentry (assq key (eval alist))))
-    (if oldentry
-	(setcdr oldentry val)
-      (set alist (cons (cons key val) (eval alist))))))
-  
-(defun hilit-set-mode-patterns (modelist patterns
-					 &optional parse-fn case-fold)
-  "Sets the default highlighting patterns for MODE to PATTERNS.
-See the variable hilit-mode-enable-list.
-
-Takes optional arguments PARSE-FN and CASE-FOLD."
-  ;; change pattern
-  (mapcar (function (lambda (p)
-		      (and (stringp (car p))
-			   (null (nth 1 p))
-			   (setcar (cdr p) 0))))
-	  patterns)
-  (setq patterns (cons case-fold patterns))
-  
-  (or (consp modelist) (setq modelist (list modelist)))
-  (let (ok (flip (eq (car hilit-mode-enable-list) 'not)))
-    (mapcar (function
-	     (lambda (m)
-	       (setq ok (or (null hilit-mode-enable-list)
-			    (memq m hilit-mode-enable-list)))
-	       (and flip (setq ok (not ok)))
-	       (and ok
-		    (progn
-		      (and parse-fn
-			   (hilit-associate 'hilit-parser-alist m parse-fn))
-		      (hilit-associate 'hilit-patterns-alist m patterns)))))
-	    modelist)))
-
-(defun hilit-add-pattern (pstart pend face &optional mode first)
-  "Highlight pstart with face for the current major-mode.
-Optionally, place the new pattern first in the pattern list"
-  (interactive "sPattern start regex: \nsPattern end regex (default none): \nxFace: ")
-
-  (and (equal pstart "") (error "Must specify starting regex"))
-  (cond ((equal pend "") (setq pend 0))
-	((string-match "^[0-9]+$" pend) (setq pend (string-to-int pend))))
-  (or mode (setq mode major-mode))
-  (let ((old-patterns (cdr (assq mode hilit-patterns-alist)))
-	(new-pat (list pstart pend face)))
-    (cond ((not old-patterns)
-	   (hilit-set-mode-patterns mode (list new-pat)))
-	  (first
-	   (setcdr old-patterns (cons new-pat (cdr old-patterns))))
-	  (t 
-	   (nconc old-patterns (list new-pat)))))
-  (and (interactive-p) (hilit-rehighlight-buffer)))
-
-(defun hilit-string-find (qchar)
-  "looks for a string and returns (start . end) or NIL.  The argument QCHAR
-is the character that would precede a character constant double quote.
-Finds strings delimited by double quotes.  The first double quote may not be
-preceded by QCHAR and the closing double quote may not be preceded by an odd
-number of backslashes."
-  (let (st en)
-    (while (and (search-forward "\"" nil t)
-		(eq qchar (char-after (1- (setq st (match-beginning 0)))))))
-    (while (and (search-forward "\"" nil t)
-		(save-excursion
-		  (setq en (point))
-		  (forward-char -1)
-		  (skip-chars-backward "\\\\")
-		  (forward-char 1)
-		  (not (zerop (% (- en (point)) 2))))))
-    (and en (cons st en))))    
-
-;; return types on same line...
-;; ("^[a-zA-z].*\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
-
-;; On another note, a working pattern for grabbing function definitions for C is
-;; 
-;; ("^[a-zA-Z_]+.*[;{]$" nil ForestGreen)  ; global defns ( start at col 1 )
-;; ("^[a-zA-Z_]+.*(" ")" defun)
-;; ; defuns assumed to start at col 1, not with # or {
-;; 
-;; this will make external declarations/definitions green, and function
-;; definitions the defun face.  Hmmm - seems to work for me anyway.
-
-(let ((comments     '(("/\\*" "\\*/" comment)))
-      (c++-comments '(("//.*$" nil comment)
-		      ("^/.*$" nil comment)))
-      (strings      '((hilit-string-find ?' string)))
-      (preprocessor '(("^#[ \t]*\\(undef\\|define\\).*$" "[^\\]$" define)
-		      ("^#.*$" nil include))))
-
-  (hilit-set-mode-patterns
-   '(c-mode c++-c-mode elec-c-mode)
-   (append
-    comments strings preprocessor
-    '(
-      ;; function decls are expected to have types on the previous line
-      ("^\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
-      ("^\\(typedef\\|struct\\|union\\|enum\\).*$" nil decl)
-      ;; datatype -- black magic regular expression
-      ("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type)
-      ;; key words
-      ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\)\\>[^_]" 1 keyword)
-      )))
-
-  (hilit-set-mode-patterns
-   'c++-mode
-   (append
-    comments c++-comments strings preprocessor
-    '(
-      ;; function decls are expected to have types on the previous line
-      ("^\\(\\(\\w\\|[$_]\\)+::\\)?\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
-      ("^\\(\\(\\w\\|[$_]\\)+[ \t]*::[ \t]*\\)?\\(\\(\\w\\|[$_]\\)+\\|operator.*\\)\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
-      ("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*$" nil decl)
-      ;; datatype -- black magic regular expression
-      ("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\|class\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type)
-      ;; key words
-      ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|delete\\|new\\)\\>[^_]"
-       1 keyword))))
-
-  (hilit-set-mode-patterns
-   '(objc-mode objective-C-mode)
-   (append
-    comments c++-comments strings preprocessor
-    '(
-      ;; function decls are expected to have types on the previous line
-      ("^\\(\\(\\w\\|[$_]\\)+::\\)?\\(\\w\\|[$_]\\)+\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
-      ("^\\(\\(\\w\\|[$_]\\)+[ \t]*::[ \t]*\\)?\\(\\(\\w\\|[$_]\\)+\\|operator.*\\)\\s *\\(\\(\\w\\|[$_]\\)+\\s *((\\|(\\)[^)]*)+" nil defun)
-
-      ("^\\(template\\|typedef\\|struct\\|union\\|class\\|enum\\|public\\|private\\|protected\\).*$" nil decl)
-      ;; datatype -- black magic regular expression
-      ("[ \n\t({]\\(\\(const\\|register\\|volatile\\|unsigned\\|extern\\|static\\)\\s +\\)*\\(\\(\\w\\|[$_]\\)+_t\\|float\\|double\\|void\\|char\\|short\\|int\\|long\\|FILE\\|\\(\\(struct\\|union\\|enum\\|class\\)\\([ \t]+\\(\\w\\|[$_]\\)*\\)\\)\\)\\(\\s +\\*+)?\\|[ \n\t;()]\\)" nil type)
-      ;; key words
-      ("[^_]\\<\\(return\\|goto\\|if\\|else\\|case\\|default\\|switch\\|break\\|continue\\|while\\|do\\|for\\|public\\|protected\\|private\\|interface\\|implementation\\|end\\|super\\|self\\)\\>[^_]"
-       1 keyword))))
-  )
-
-(hilit-set-mode-patterns
- 'perl-mode
- '(("\\s #.*$" nil comment)
-   ("^#.*$" nil comment)
-   ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string)
-   ("^\\(__....?__\\|\\s *\\sw+:\\)" nil label)
-   ("^require.*$" nil include)
-   ("^package.*$" nil decl)
-   ("^\\s *sub\\s +\\(\\w\\|[_']\\)+" nil defun)
-   ("\\b\\(do\\|if\\|unless\\|while\\|until\\|else\\|elsif\\|for\\|foreach\\|continue\\|next\\|redo\\|last\\|goto\\|return\\|die\\|exit\\)\\b" nil keyword)))
-
-(hilit-set-mode-patterns
- 'ada-mode
- '(;; comments
-   ("--.*$" nil comment)
-   ;; main structure
-   ("[ \t\n]procedure[ \t]" "\\([ \t]\\(is\\|renames\\)\\|);\\)" glob-struct)
-   ("[ \t\n]task[ \t]" "[ \t]is" glob-struct)
-   ("[ \t\n]function[ \t]" "return[ \t]+[A-Za-z_0-9]+[ \t]*\\(is\\|;\\|renames\\)" glob-struct)
-   ("[ \t\n]package[ \t]" "[ \t]\\(is\\|renames\\)" glob-struct)
-   ;; if there is nothing before "private", it is part of the structure
-   ("^[ \t]*private[ \t\n]" nil glob-struct)
-   ;; if there is no indentation before the "end", then it is most
-   ;; probably the end of the package
-   ("^end.*$" ";" glob-struct)
-   ;; program structure -- "null", "delay" and "terminate" omitted
-   ("[ \n\t]\\(in\\|out\\|select\\|if\\|else\\|case\\|when\\|and\\|or\\|not\\|accept\\|loop\\|do\\|then\\|elsif\\|else\\|for\\|while\\|exit\\)[ \n\t;]" nil struct)
-   ;; block structure
-   ("[ \n\t]\\(begin\\|end\\|declare\\|exception\\|generic\\|raise\\|return\\|package\\|body\\)[ \n\t;]" nil struct)
-   ;; type declaration
-   ("^[ \t]*\\(type\\|subtype\\).*$" ";" decl)
-   ("[ \t]+is record.*$" "end record;" decl)
-   ;; "pragma", "with", and "use" are close to C cpp directives
-   ("^[ \t]*\\(with\\|pragma\\|use\\)" ";" include)
-   ;; nice for named parameters, but not so beautiful in case statements
-   ("[A-Za-z_0-9.]+[ \t]*=>"   nil named-param)
-   ;; string constants probably not everybody likes this one
-   ("\"" ".*\"" string)))
-
-(hilit-set-mode-patterns
- 'fortran-mode
- '(("^[*Cc].*$" nil comment)
-   ("'[^'\n]*'" nil string)
-   ("\\(^[ \t]*[0-9]+\\|[ \t]continue[ \t\n]\\|format\\)" nil define)
-   ("[ \t]\\(do\\|do[ \t]*[0-9]+\\|go[ \t]*to[ \t]*[0-9]+\\|end[ \t]*do\\|if\\|else[ \t]*if\\|then\\|else\\|end[ \t]*if\\)[ \t\n(]" nil define)
-   ("[ \t]\\(call\\|program\\|subroutine\\|function\\|stop\\|return\\|end\\|include\\)[ \t\n]" nil include)
-   ("[ \t]\\(parameter[\t\n ]*([^)]*)\\|data\\|save\\|common[ \t\n]*/[^/]*/\\)" 
-    nil decl)
-   ("^     ." nil type)
-   ("implicit[ \t]*none" nil decl)
-   ("\\([ \t]\\|implicit[ \t]*\\)\\(dimension\\|integer\\|real\\|double[ \t]*precision\\|character\\|logical\\|complex\\|double[ \t]*complex\\)\\([*][0-9]*\\|[ \t\n]\\)" nil keyword)
-   )
- nil 'case-insensitive)
-
-(hilit-set-mode-patterns
- '(m2-mode modula-2-mode)
- '(("(\\*" "\\*)" comment)
-   (hilit-string-find ?\\ string)
-   ("^[ \t]*PROCEDURE[ \t]+\\w+[^ \t(;]*" nil defun)
-   ("\\<\\(RECORD\\|ARRAY\\|OF\\|POINTER\\|TO\\|BEGIN\\|END\\|FOR\\|IF\\|THEN\\|ELSE\\|ELSIF\\|CASE\\|WHILE\\|DO\\|MODULE\\|FROM\\|RETURN\\|IMPORT\\|EXPORT\\|VAR\\|LOOP\\|UNTIL\\|\\DEFINITION\\|IMPLEMENTATION\\|AND\\|OR\\|NOT\\|CONST\\|TYPE\\|QUALIFIED\\)\\>" nil keyword)
-   )
- nil 'case-insensitive)
-
-(hilit-set-mode-patterns 'prolog-mode
- '(("/\\*" "\\*/" comment)
-   ("%.*$" nil comment)
-   (":-" nil defun)
-   ("!" nil label)
-   ("\"[^\\\"]*\\(\\\\\\(.\\|\n\\)[^\\\"]*\\)*\"" nil string)
-   ("\\b\\(is\\|mod\\)\\b" nil keyword)
-   ("\\(->\\|-->\\|;\\|==\\|\\\\==\\|=<\\|>=\\|<\\|>\\|=\\|\\\\=\\|=:=\\|=\\\.\\\.\\|\\\\\\\+\\)" nil decl)
-   ("\\(\\\[\\||\\|\\\]\\)" nil include)))
-
-(hilit-set-mode-patterns
- '(
-   LaTeX-mode japanese-LaTeX-mode SliTeX-mode
-   japanese-SliTeX-mode FoilTeX-mode latex-mode
-   )
- '(
-   ;; comments
-   ("[^\\]%.*$" nil comment)
-
-   ;; the following two match \foo[xx]{xx} or \foo*{xx} or \foo{xx}
-   ("\\\\\\(sub\\)*\\(paragraph\\|section\\)\\(\*\\|\\[.*\\]\\)?{" "}"
-    keyword)
-   ("\\\\\\(chapter\\|part\\)\\(\*\\|\\[.*\\]\\)?{" "}" keyword)
-   ("\\\\footnote\\(mark\\|text\\)?{" "}" keyword)
-   ("\\\\[a-z]+box" nil keyword)
-   ("\\\\\\(v\\|h\\)space\\(\*\\)?{" "}" keyword)
-
-   ;; (re-)define new commands/environments/counters
-   ("\\\\\\(re\\)?new\\(environment\\|command\\){" "}" defun)
-   ("\\\\new\\(length\\|theorem\\|counter\\){" "}" defun)
-
-   ;; various declarations/definitions
-   ("\\\\\\(setlength\\|settowidth\\|addtolength\\|setcounter\\|addtocounter\\)" nil define)
-   ("\\\\\\(title\\|author\\|date\\|thanks\\){" "}" define)
-
-   ("\\\\documentstyle\\(\\[.*\\]\\)?{" "}" decl)
-   ("\\\\\\(begin\\|end\\|nofiles\\|includeonly\\){" "}" decl)
-   ("\\\\\\(raggedright\\|makeindex\\|makeglossary\\|maketitle\\)\\b" nil
-    decl)
-   ("\\\\\\(pagestyle\\|thispagestyle\\|pagenumbering\\){" "}" decl)
-   ("\\\\\\(normalsize\\|small\\|footnotesize\\|scriptsize\\|tiny\\|large\\|Large\\|LARGE\\|huge\\|Huge\\)\\b" nil decl)
-   ("\\\\\\(appendix\\|tableofcontents\\|listoffigures\\|listoftables\\)\\b"
-    nil decl)
-   ("\\\\\\(bf\\|em\\|it\\|rm\\|sf\\|sl\\|ss\\|tt\\)\\b" nil decl)
-
-   ;; label-like things
-   ("\\\\item\\(\\[[^]]*\\]\\)?" nil label)
-   ("\\\\caption\\(\\[[^]]*\\]\\)?{" "}" label)
-
-   ;; formulas
-   ("[^\\]\\\\("  "\\\\)" formula)                   ; \( \)
-   ("[^\\]\\\\\\[" "\\\\\\]" formula)                ; \[ \]
-   ("[^\\$]\\(\\$\\(\\$[^$]*\\$\\|[^$]*\\)\\$\\)" 1 formula) ; '$...$' or '$$...$$'
-   
-   ;; things that bring in external files
-   ("\\\\\\(include\\|input\\|bibliography\\){" "}" include)
-
-   ;; "wysiwyg" emphasis -- these don't work with nested expressions
-   ;; ("{\\\\\\(em\\|it\\|sl\\)" "}" italic)
-   ;; ("{\\\\bf" "}" bold)
-
-   ("``" "''" string)
-
-   ;; things that do some sort of cross-reference
-   ("\\\\\\(\\(no\\)?cite\\|\\(page\\)?ref\\|label\\|index\\|glossary\\){" "}" crossref)
-   ))
-
-(hilit-set-mode-patterns
- 'bibtex-mode
- '(;;(";.*$"			nil	comment)
-   ("%.*$"			nil	comment)
-   ("@[a-zA-Z]+"		nil	keyword)
-   ("{[ \t]*[-a-z:_A-Z0-9]+,"	nil	label) ; is wrong sometimes
-   ("^[ \t]*[a-zA-Z]+[ \t]*="	nil	define)))
-
-(hilit-set-mode-patterns
- 'compilation-mode
- '(
-   ("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+: warning:.*$" nil warning)
-   ("^[-_.\"A-Za-z0-9]+\\(:\\|, line \\)[0-9]+:.*$" nil error)
-   ))
-
-(hilit-set-mode-patterns
- 'makefile-mode
- '(("^#.*$" nil comment)
-   ("[^$]#.*$" nil comment)
-   ;; rules
-   ("^[^ \t\n]*%[^ \t\n]*[ \t]*::?[ \t]*[^ \t\n]*[ \t]*\\(#.*\\)?$" nil rule)
-   ("^[.][A-Za-z][A-Za-z]?\..*$" nil rule)
-   ;; variable definition
-   ("^[_A-Za-z0-9]+[ \t]*\+?=" nil define)
-   ("\\( \\|:=\\)[_A-Za-z0-9]+[ \t]*\\+=" nil define)
-   ;; variable references
-   ("\\$\\([^ \t\n{(]\\|[{(]@?[_A-Za-z0-9:.,%/=]+[)}]\\)" nil keyword)
-   ("^[A-Za-z0-9.,/_-]+[ \t]*:.*$" nil defun)
-   ("^include " nil include)))
-
-(let* ((header-patterns '(("^Subject:.*$" nil msg-subject)
-			  ("^From:.*$" nil msg-from)
-			  ("^--text follows this line--$" nil msg-separator)
-			  ("^[A-Za-z][A-Za-z0-9-]+:" nil msg-header)))
-       (body-patterns '(("^\\(In article\\|[ \t]*\\w*[]<>}|]\\).*$"
-			 nil msg-quote)))
-       (message-patterns (append header-patterns body-patterns)))
-  (hilit-set-mode-patterns 'msg-header header-patterns)
-  (hilit-set-mode-patterns 'msg-body body-patterns)
-  (hilit-set-mode-patterns '(vm-mode text-mode mail-mode rmail-mode
-			     gnus-article-mode news-reply-mode mh-show-mode)
-			   message-patterns
-			   'hilit-rehighlight-message))
-
-(hilit-set-mode-patterns
- 'gnus-group-mode
- '(("^ U.*$" nil gnus-group-unsubscribed)
-   ("^\\*? +[01]?[0-9]:.*$" nil gnus-group-empty)
-   ("^ +[2-9][0-9]:.*$" nil gnus-group-full)
-   ("^ +[0-9][0-9][0-9]+:.*$" nil gnus-group-overflowing)))
-
-(hilit-set-mode-patterns
- 'vm-summary-mode
- '(("^   .*$" nil summary-seen)
-   ("^->.*$" nil  summary-current)
-   ("^  D.*$" nil summary-deleted)
-   ("^  U.*$" nil summary-unread)
-   ("^  N.*$" nil summary-new)))
-
-
-;;; this will match only comments w/ an even (zero is even) number of quotes...
-;;; which is still inadequate because it matches comments in multi-line strings
-;;; how anal do you want to get about never highlighting comments in strings?
-;;; I could twiddle with this forever and still it wouldn't be perfect.
-;;;   (";\\([^\"\n]*\"[^\"\n]*\"\\)*[^\"\n]*$" nil comment)
-
-(hilit-set-mode-patterns
- '(emacs-lisp-mode lisp-interaction-mode)
- '(
-   (";.*" nil comment)
-
-;;; This almost works...but I think I'll stick with the parser function 
-;;;("[^?]\\(\"\\(\"\\||\\([^\"]+\\|[\\]\\([\\][\\]\\)*\"\\)*\"\\)\\)" 1 string)
-   (hilit-string-find ?\\ string)
-
-   ("^\\s *(def\\(un\\|macro\\|advice\\|alias\\|subst\\)[ \t\n]"
-    "\\()\\|nil\\)" defun)
-   ("^\\s *(defvar\\s +\\S +" nil decl)
-   ("^\\s *(defconst\\s +\\S +" nil define)
-   ("^\\s *(\\(provide\\|require\\|\\(auto\\)?load\\).*$" nil include)
-   ("\\s *\\&\\(rest\\|optional\\)\\s *" nil keyword)
-   ("(\\(let\\*?\\|cond\\|if\\|or\\|and\\|map\\(car\\|concat\\)\\|prog[n1*]?\\|while\\|lambda\\|function\\|set\\([qf]\\|car\\|cdr\\)?\\|nconc\\|eval-when-compile\\|condition-case\\|unwind-protect\\|catch\\|throw\\|error\\)[ \t\n]" 1 keyword)
-   ))
-
-(hilit-set-mode-patterns
- '(lisp-mode ilisp-mode)
- '(
-   (";.*" nil comment)
-   ("#|" "|#" comment)
-;;; This almost works...but I think I'll stick with the parser function 
-;;;("[^?]\\(\"\\(\"\\||\\([^\"]+\\|[\\]\\([\\][\\]\\)*\"\\)*\"\\)\\)" 1 string)
-   (hilit-string-find ?\\ string)
-
-   ;; this is waaaaaaaay too slow
-   ;;   ("^\\s *(def\\(un\\|macro\\|advice\\|alias\\|method\\|subst\\)\\s \\S +[ \t\n]+\\(nil\\|(\\(([^()]*)\\|[^()]+\\)*)\\)" nil defun)
-   ("^\\s *(def\\(un\\|macro\\|advice\\|subst\\|method\\)\\s " "\\()\\|nil\\)" defun)
-
-   ("^\\s *(\\(def\\(var\\|type\\|parameter\\)\\|declare\\)\\s +\\S +" nil decl)
-   ("^\\s *(def\\(const\\(ant\\)?\\|class\\|struct\\)\\s \\S +[ \t\n]+" nil define)
-   ("^\\s *(\\(provide\\|require\\|\\(auto\\)?load\\).*$" nil include)
-   ("[ \t]\\&\\(key\\|rest\\|optional\\|aux\\)\\s *" nil keyword)
-   ("(\\(let\\*?\\|locally\\|cond\\|if\\*?\\|or\\|and\\|map\\(car\\|c[ao]n\\)?\\|prog[nv1*]?\\|while\\|when\\|unless\\|do\\(\\*\\|list\\|times\\)\\|list\\|lambda\\|function\\|values\\|set\\([qf]\\|car\\|cdr\\)?\\|rplac[ad]\\|nconc\\|block\\|go\\|return\\(-from\\)?\\|[ec]?\\(type\\)?case\\|multiple-value-\\(bind\\|setq\\|list\\|call\\|prog1\\)\\|unwind-protect\\|handler-case\\|catch\\|throw\\|eval-when\\(-compile\\)?\\)[ \t\n]" 1 keyword)
-   ))
-
-
-(hilit-set-mode-patterns
- 'plain-tex-mode
- '(("^%%.*$" nil comment)
-   ("{\\\\em\\([^}]+\\)}" nil comment)
-   ("\\(\\\\\\w+\\)" nil keyword)
-   ("{\\\\bf\\([^}]+\\)}" nil keyword)
-   ("^[ \t\n]*\\\\def[\\\\@]\\(\\w+\\)" nil defun)
-   ("\\\\\\(begin\\|end\\){\\([A-Za-z0-9\\*]+\\)}" nil defun)
-   ;; ("[^\\\\]\\$\\([^$]*\\)\\$" nil string)
-   ("\\$\\([^$]*\\)\\$" nil string)
-   ))
-
-;; Reasonable extensions would include smarter parameter handling for such
-;; things as the .IX and .I macros, which alternate the handling of following
-;; arguments.
-
-(hilit-set-mode-patterns
- 'nroff-mode
- '(("^\\.[\\\][\\\"].*$" nil comment)
-   ("^\\.so .*$" nil include)
-   ("^\\.[ST]H.*$" nil defun)
-;;   ("^[^\\.].*\"[^\\\"]*\\(\\\\\\(.\\)[^\\\"]*\\)*\"" nil string)
-   ("\"" "[^\\]\"" string)
-   ("^\\.[A-Z12\\\\].*$" nil define)
-   ("\\([\\\][^ ]*\\)" nil keyword)
-   ("^\\.[A-Z].*$" nil keyword))
- nil 'case-insensitive)
-
-(hilit-set-mode-patterns
- 'texinfo-mode
- '(("^\\(@c\\|@comment\\)\\>.*$" nil comment)
-   ("@\\(emph\\|strong\\|b\\|i\\){[^}]+}" nil comment)
-;; seems broken
-;; ("\\$[^$]*\\$" nil string)
-   ("@\\(file\\|kbd\\|key\\){[^}]+}" nil string)
-   ("^\\*.*$" nil defun)
-   ("@\\(if\\w+\\|format\\|item\\)\\b.*$" nil defun)
-   ("@end +[A-Za-z0-9]+[ \t]*$" nil defun)
-   ("@\\(samp\\|code\\|var\\){[^}]+}" nil defun)
-   ("@\\w+\\({[^}]+}\\)?" nil keyword)
-   ))
-
-(hilit-set-mode-patterns
- 'dired-mode
- (append
-  '(("^D.*$"  nil dired-deleted)
-   ("^\\*.*$" nil dired-marked)
-   ("^  d.*$" nil dired-directory)
-   ("^  l.*$" nil dired-link)
-   ("^  -.*#.*#$" nil dired-ignored))
-  (list (cons
-	 (concat "^  .*\\("
-		 (mapconcat 'regexp-quote completion-ignored-extensions "\\|")
-		 "\\)$")
-	 '(nil dired-ignored)))))
-
-(hilit-set-mode-patterns
- 'jargon-mode
- '(("^:[^:]*:" nil jargon-entry)
-   ("{[^}]*}+" nil jargon-xref)))
-
-(hilit-set-mode-patterns
- 'Info-mode
- '(("^\\* [^:]+:+" nil jargon-entry)
-   ("\\*[Nn]ote\\b[^:]+:+" nil jargon-xref)
-   ("  \\(Next\\|Prev\\|Up\\):" nil jargon-xref)
-   ("- \\(Variable\\|Function\\|Macro\\|Command\\|Special Form\\|User Option\\):.*$"
-    nil jargon-keyword)))	; lisp manual
-
-(hilit-set-mode-patterns
- 'calendar-mode
- '(("[A-Z][a-z]+ [0-9]+" nil define)	; month and year
-   ("S  M Tu  W Th  F  S" nil label)))	; week days
-
-(hilit-set-mode-patterns
- 'asm-mode
- '(("/\\*" "\\*/" comment)
-   ("^#[ \t]*\\(undef\\|define\\).*$" "[^\\]$" define)
-   ("^#.*$" nil include)
-   ;; labels
-   ("^.+:" nil defun)
-   ;; assembler directives
-   ("^[ \t]*\\..*$" nil decl)
-   ;; register names
-   ("\\$[a-z0-9]+" nil string)
-   ;; mnemonics
-   ("^[ \t]*[a-z]+" nil struct)))
-
-(hilit-set-mode-patterns
- 'pascal-mode
- '(("(\\*" "\\*)" comment)
-   ("{" "}" comment)
-   ;; Doesn't work when there are strings in comments....
-   ;; ("'[^']*'" nil string)
-   ("^#.*$" nil include)
-   ("^[ \t]*\\(procedure\\|function\\)[ \t]+\\w+[^ \t(;]*" nil defun)
-   ("\\<\\(program\\|begin\\|end\\)\\>" nil defun)
-   ("\\<\\(external\\|forward\\)\\>" nil include)
-   ("\\<\\(label\\|const\\|type\\|var\\)\\>" nil define)
-   ("\\<\\(record\\|array\\|file\\)\\>" nil type)
-   ("\\<\\(of\\|to\\|for\\|if\\|then\\|else\\|case\\|while\\|do\\|until\\|and\\|or\\|not\\|with\\|repeat\\)\\>" nil keyword)
-   )
- nil 'case-insensitive)
-
-(hilit-set-mode-patterns
- 'icon-mode
- '(("#.*$" nil comment)
-   ("\"[^\\\"]*\\(\\\\.[^\\\"]*\\)*\"" nil string)
-   ;; charsets: these do not work because of a conflict with strings
-   ;; ("'[^\\']*\\(\\\\.[^\\']*\\)*'" nil string)
-   ("^[ \t]*procedure[ \t]+\\w+[ \t]*(" ")" defun)
-   ("^[ \t]*record.*(" ")" include)
-   ("^[ \t]*\\(global\\|link\\)[ \t\n]+[A-Za-z_0-9]+\\([ \t\n]*,[ \t\n]*[A-Za-z_0-9]+\\)*" nil include)
-   ("^[ \t]*\\(local\\|static\\)[ \t\n]+[A-Za-z_0-9]+\\([ \t\n]*,[ \t\n]*[A-Za-z_0-9]+\\)*" nil decl)
-   ("\\<\\(initial\\|end\\)\\>" nil glob-struct)
-   ("\\<\\(while\\|until\\|return\\|every\\|if\\|then\\|else\\|to\\|case\\|of\\|suspend\\|create\\|do\\|repeat\\|break\\)\\>" nil keyword)
-   ))
-
-;; as you can see, I had two similar problems for Pascal and Icon. In
-;; Pascal, strings are delimited with ' and an embedded quote is doubled,
-;; thus string syntax would be extremely simple. However, if a string
-;; occurs within a comment, the following text is considered a string.
-;; 
-;; In Icon, strings are similar to C ones, but there are also charsets,
-;; delimited with simple quotes. I could not manage to use both regexps at
-;; the same time.
-
-;; The problem I have with my patterns for Icon is that this language has a
-;; string similar constant to the C one (but a string can be cut on several
-;; lines, if terminated by a dash and continued with initial blanks, like
-;; this:
-;;         "This is a somewhat long -
-;;          string, written on three -
-;;          successive lines"
-;; in order to insert a double quote in a string, you have to escape it
-;; with a \), bu also a character set constant (named a charset), which
-;; uses single quotes instead of double ones. It would seem intuitive to
-;; highlight both constants in the same way.
-
-
-(provide 'hilit19)
-
-;;; hilit19 ends here.
diff --git a/lisp/hippie-exp.el b/lisp/hippie-exp.el
deleted file mode 100644
index caa479d9ec8..00000000000
--- a/lisp/hippie-exp.el
+++ /dev/null
@@ -1,1127 +0,0 @@
-;;; hippie-exp.el --- expand text trying various ways to find its expansion.
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Anders Holst <aho@sans.kth.se>
-;; Last change: 6 August 1995
-;; Version: 1.4
-;; Keywords: abbrev
-
-;; 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:
-
-;;  `hippie-expand' is a single function for a lot of different kinds
-;;  of completions and expansions.  Called repeatedly it tries all
-;;  possible completions in succession. 
-;;  Which kinds of completions to try, and in which order, is
-;;  determined by the contents of `hippie-expand-try-functions-list'.
-;;  Much customization of `hippie-expand' can be made by changing the
-;;  order of, removing, or inserting new functions in this list.
-;;  Given a positive numeric argument, `hippie-expand' jumps directly
-;;  ARG functions forward in this list.  Given some other argument
-;;  (a negative argument or just Ctrl-U) it undoes the tried
-;;  completion.
-;;
-;;  If the variable `hippie-expand-verbose' is non-nil, `hippie-expand'
-;;  outputs in a message which try-function in the list that is used
-;;  currently (ie. was used currently and will be tried first the next
-;;  time).
-;;  The variable `hippie-expand-max-buffers' determines in how many
-;;  buffers, apart from the current, to search for expansions in.  It
-;;  is used by the try-functions named "-all-buffers".
-;;  The variable `hippie-expand-ignore-buffers' is a list of regexps
-;;  matching buffer names (as strings) or major modes (as atoms) of
-;;  buffers that should not be searched by the try-functions named
-;;  "-all-buffers".
-;;  See also the macro `make-hippie-expand-function' below.
-;;  
-;;  A short description of the current try-functions in this file:
-;;    `try-complete-file-name' : very convenient to have in any buffer,
-;;      and not just in the minibuffer or (some) shell-mode.  It goes
-;;      through all possible completions instead of just completing as
-;;      much as is unique.
-;;    `try-complete-file-name-partially' : To insert in the list just
-;;      before `try-complete-file-name' for those who want first to get
-;;      a file name completed only as many characters as is unique.
-;;    `try-expand-all-abbrevs' : can be removed if you don't use abbrevs.
-;;      Otherwise it looks through all abbrev-tables, starting with
-;;      the local followed by the global. 
-;;    `try-expand-line' : Searches the buffer for an entire line that 
-;;      begins exactly as the current line.  Convenient sometimes, for 
-;;      example as a substitute for (or complement to) the history
-;;      list in shell-like buffers.  At other times, only confusing.
-;;    `try-expand-line-all-buffers' : Like `try-expand-line' but searches
-;;      in all buffers (except the current).  (This may be a little
-;;      slow, don't use it unless you are really fond of `hippie-expand'.)
-;;    `try-expand-list' : Tries to expand the text back to the nearest
-;;      open delimiter, to a whole list from the buffer. Convenient for
-;;      example when writing lisp or TeX.
-;;    `try-expand-list-all-buffers' : Like `try-expand-list' but searches 
-;;      in all buffers (except the current).  
-;;    `try-expand-dabbrev' : works exactly as dabbrev-expand (but of
-;;      course in a way compatible with the other try-functions).
-;;    `try-expand-dabbrev-all-buffers' : perhaps the most useful of them,
-;;      like `dabbrev-expand' but searches all Emacs buffers (except the
-;;      current) for matching words.  (No, I don't find this one
-;;      particularly slow.) 
-;;    `try-expand-dabbrev-visible': Searches the currently visible parts of
-;;      all windows.  Can be put before `try-expand-dabbrev-all-buffers' to
-;;      first try the expansions you can see.
-;;    `try-expand-dabbrev-from-kill': Searches the kill ring for a suitable
-;;      completion of the word.  Good to have, just in case the word was not
-;;      found elsewhere.
-;;    `try-expand-whole-kill' : Tries to complete text with a whole entry
-;;      from the kill ring.  May be good if you don't know how far up in
-;;      the kill-ring the required entry is, and don't want to mess with
-;;      "Choose Next Paste".
-;;    `try-complete-lisp-symbol' : like `lisp-complete-symbol', but goes
-;;      through all possibilities instead of completing what is unique.
-;;      Might be tedious (usually a lot of possible completions) and
-;;      since its function is much like `lisp-complete-symbol', which
-;;      already has a key of its own, you might want to remove this.
-;;    `try-complete-lisp-symbol-partially' : To insert in the list just
-;;      before `try-complete-lisp-symbol' for those who first want to get
-;;      completion of what is unique in the name.  
-;;
-;;  Not all of the above functions are by default in
-;;  `hippie-expand-try-functions-list'.  This variable is better set
-;;  in ".emacs" to make `hippie-expand' behave maximally convenient
-;;  according to personal taste.  Also, instead of loading the
-;;  variable with all kinds of try-functions above, it might be an
-;;  idea to use `make-hippie-expand-function' to construct different
-;;  `hippie-expand'-like functions, with different try-lists and bound
-;;  to different keys. It is also possible to make
-;;  `hippie-expand-try-functions-list' a buffer local variable, and
-;;  let it depend on the mode (by setting it in the mode-hooks).
-;;
-;;  To write new try-functions, consider the following:
-;;  Each try-function takes one argument OLD which is nil the first
-;;  time the function is called and true in succeeding calls for the
-;;  same string to complete.  The first time the function has to
-;;  extract the string before point to complete, and substitute the
-;;  first completion alternative for it.  On following calls it has to
-;;  substitute the next possible completion for the last tried string.
-;;  The try-function is to return t as long as it finds new
-;;  possible completions.  When there are no more alternatives it has
-;;  to restore the text before point to its original contents, and
-;;  return nil (don't beep or message or anything).
-;;  The try-function can (should) use the following functions:
-;;    `he-init-string' : Initializes the text to substitute to the
-;;      contents of the region BEGIN to END.  Also sets the variable
-;;      `he-search-string' to the text to expand.
-;;    `he-substitute-string' : substitutes STR into the region
-;;      initialized with `he-init-string'.  (An optional second argument
-;;      TRANS-CASE non-nil, means transfer of case from the abbreviation
-;;      to the expansion is ok if that is enabled in the buffer.)
-;;    `he-reset-string' : Resets the initialized region to its original
-;;      contents.
-;;  There is also a variable: `he-tried-table' which is meant to contain
-;;  all tried expansions so far.  The try-function can check this 
-;;  variable to see whether an expansion has already been tried
-;;  (hint: `he-string-member').
-;;
-;;  Known bugs
-;;
-;;  It may happen that some completion suggestion occurs twice, in
-;;  spite of the use of `he-tried-table' to prevent that.  This is 
-;;  because different try-functions may try to complete different
-;;  lengths of text, and thus put different amounts of the
-;;  text in `he-tried-table'.  Anyway this seems to occur seldom enough
-;;  not to be too disturbing.  Also it should NOT be possible for the
-;;  opposite situation to occur, that `hippie-expand' misses some
-;;  suggestion because it thinks it has already tried it.
-;;
-;;  Acknowledgement
-;;
-;;  I want to thank Mikael Djurfeldt in discussions with whom the idea
-;;  of this function took form.
-;;  I am also grateful to all those who have given me suggestions on
-;;  how to improve it, and all those who helped to find and remove bugs.
-;;
-
-;;; Code:
-
-(defvar he-num -1)
-
-(defvar he-string-beg (make-marker))
-
-(defvar he-string-end (make-marker))
-
-(defvar he-search-string ())
-
-(defvar he-expand-list ())
-
-(defvar he-tried-table ())
-
-(defvar he-search-loc (make-marker))
-
-(defvar he-search-loc2 ())
-
-(defvar he-search-bw ())
-
-(defvar he-search-bufs ())
-
-(defvar he-searched-n-bufs ())
-
-(defvar he-search-window ())
-
-;;;###autoload
-(defvar hippie-expand-try-functions-list '(try-complete-file-name-partially
-					   try-complete-file-name
-					   try-expand-all-abbrevs
-					   try-expand-list
-					   try-expand-line
-					   try-expand-dabbrev
-					   try-expand-dabbrev-all-buffers
-					   try-expand-dabbrev-from-kill
-					   try-complete-lisp-symbol-partially
-					   try-complete-lisp-symbol)
-  "The list of expansion functions tried in order by `hippie-expand'.
-To change the behavior of `hippie-expand', remove, change the order of,
-or insert functions in this list.")
-
-;;;###autoload
-(defvar hippie-expand-verbose t
-  "*Non-nil makes `hippie-expand' output which function it is trying.")
-
-;;;###autoload
-(defvar hippie-expand-max-buffers ()
-  "*The maximum number of buffers (apart from the current) searched.
-If nil, all buffers are searched.")
-
-;;;###autoload
-(defvar hippie-expand-ignore-buffers '("^ \\*.*\\*$" dired-mode)
-  "*A list specifying which buffers not to search (if not current).
-Can contain both regexps matching buffer names (as strings) and major modes
-\(as atoms)")
-
-;;;###autoload
-(defun hippie-expand (arg)
-  "Try to expand text before point, using multiple methods.
-The expansion functions in `hippie-expand-try-functions-list' are
-tried in order, until a possible expansion is found.  Repeated
-application of `hippie-expand' inserts successively possible
-expansions.  
-With a positive numeric argument, jumps directly to the ARG next
-function in this list.  With a negative argument or just \\[universal-argument], 
-undoes the expansion." 
-  (interactive "P")
-  (if (or (not arg) 
-	  (and (integerp arg) (> arg 0)))
-      (let ((first (or (= he-num -1)
-		       (not (equal this-command last-command)))))
-	(if first
-	    (progn
-	      (setq he-num -1)
-	      (setq he-tried-table nil)))
-	(if arg
-	    (if (not first) (he-reset-string))
-	    (setq arg 0))
-	(let ((i (max (+ he-num arg) 0)))
-	  (while (not (or (>= i (length hippie-expand-try-functions-list))
-			  (apply (nth i hippie-expand-try-functions-list) 
-				 (list (= he-num i)))))
-	    (setq i (1+ i)))
-	  (setq he-num i))
-	(if (>= he-num (length hippie-expand-try-functions-list))
-	    (progn
-	      (setq he-num -1)
-	      (if first
-		  (message "No expansion found")
-		  (message "No further expansions found"))
-	      (ding))
-	    (if (and hippie-expand-verbose
-		     (not (window-minibuffer-p (selected-window))))
-		(message "Using %s"
-			 (prin1-to-string (nth he-num 
-				   hippie-expand-try-functions-list))))))
-      (if (and (>= he-num 0)
-	       (eq (marker-buffer he-string-beg) (current-buffer)))
-	  (progn
-	    (setq he-num -1)
-	    (he-reset-string)
-	    (if (and hippie-expand-verbose
-		     (not (window-minibuffer-p (selected-window))))
-		(message "Undoing expansions"))))))
-
-;; Initializes the region to expand (to between BEG and END).
-(defun he-init-string (beg end)
-  (set-marker he-string-beg beg)
-  (set-marker he-string-end end)
-  (setq he-search-string (buffer-substring beg end)))
-
-;; Resets the expanded region to its original contents.
-(defun he-reset-string ()
-  (let ((newpos (point-marker)))
-    (goto-char he-string-beg)
-    (insert he-search-string)
-    (delete-region (point) he-string-end)
-    (goto-char newpos)))
-
-;; Substitutes an expansion STR into the correct region (the region
-;; initialized with `he-init-string'). 
-;; An optional argument TRANS-CASE means that it is ok to transfer case
-;; from the abbreviation to the expansion if that is possible, and is
-;; enabled in the buffer.
-(defun he-substitute-string (str &optional trans-case)
-  (let ((trans-case (and trans-case
-			 case-replace
-			 case-fold-search))
-	(newpos (point-marker))
-	(subst ()))
-    (goto-char he-string-beg)
-    (setq subst (if trans-case (he-transfer-case he-search-string str) str))
-    (setq he-tried-table (cons subst he-tried-table))
-    (insert subst)
-    (delete-region (point) he-string-end)
-    (goto-char newpos)))
-
-(defun he-capitalize-first (str)
-  (save-match-data
-    (if (string-match "\\Sw*\\(\\sw\\).*" str)
-	(let ((res (downcase str))
-	      (no (match-beginning 1)))
-	  (aset res no (upcase (aref str no)))
-	  res)
-      str)))
-
-(defun he-ordinary-case-p (str)
-  (or (string= str (downcase str))
-      (string= str (upcase str))
-      (string= str (capitalize str))
-      (string= str (he-capitalize-first str))))
-
-(defun he-transfer-case (from-str to-str)
-  (cond ((string= from-str (substring to-str 0 (min (length from-str)
-						    (length to-str))))
-	 to-str)
-	((not (he-ordinary-case-p to-str))
-	 to-str)
-	((string= from-str (downcase from-str))
-	 (downcase to-str))
-	((string= from-str (upcase from-str))
-	 (upcase to-str))
-	((string= from-str (he-capitalize-first from-str))
-	 (he-capitalize-first to-str))
-	((string= from-str (capitalize from-str))
-	 (capitalize to-str))
-	(t
-	 to-str)))
-
-
-;; Check if STR is a member of LST.
-;; Transform to the final case if optional TRANS-CASE is non-NIL.
-(defun he-string-member (str lst &optional trans-case)
-  (if str
-      (member (if (and trans-case
-		       case-replace
-		       case-fold-search)
-		  (he-transfer-case he-search-string str)
-		str)
-	      lst)))
-
-;; Check if STR matches any regexp in LST.
-;; Ignore possible non-strings in LST.
-(defun he-regexp-member (str lst)
-  (while (and lst
-	      (or (not (stringp (car lst)))
-		  (not (string-match (car lst) str))))
-    (setq lst (cdr lst)))
-  lst)
-
-;;  For the real hippie-expand enthusiast: A macro that makes it
-;;  possible to use many functions like hippie-expand, but with
-;;  different try-functions-lists.
-;;  Usage is for example:
-;;    (fset 'my-complete-file (make-hippie-expand-function
-;;                             '(try-complete-file-name-partially
-;;                               try-complete-file-name)))
-;;    (fset 'my-complete-line (make-hippie-expand-function
-;;                             '(try-expand-line
-;;                               try-expand-line-all-buffers)))
-;;  
-;;;###autoload
-(defmacro make-hippie-expand-function (try-list &optional verbose)
-  "Construct a function similar to `hippie-expand'.
-Make it use the expansion functions in TRY-LIST.  An optional second
-argument VERBOSE non-nil makes the function verbose."
-  (` (function (lambda (arg)
-       (, (concat 
-	   "Try to expand text before point, using the following functions: \n"
-	   (mapconcat 'prin1-to-string (eval try-list) ", ")))
-       (interactive "P")
-       (let ((hippie-expand-try-functions-list (, try-list))
-	     (hippie-expand-verbose (, verbose)))
-	 (hippie-expand arg))))))
-
-
-;;;  Here follows the try-functions and their requisites:
-
-
-(defun try-complete-file-name (old)
-  "Try to complete text as a file name.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible completions of the same
-string).  It returns t if a new completion is found, nil otherwise."
-  (if (not old)
-      (progn 
-	(he-init-string (he-file-name-beg) (point))
-	(let ((name-part (he-file-name-nondirectory he-search-string))
-	      (dir-part (expand-file-name (or (he-file-name-directory
-					       he-search-string) ""))))
-	  (if (not (he-string-member name-part he-tried-table))
-	      (setq he-tried-table (cons name-part he-tried-table)))
-	  (if (and (not (equal he-search-string ""))
-		   (he-file-directory-p dir-part))
-	      (setq he-expand-list (sort (file-name-all-completions 
-					  name-part
-					  dir-part)
-					 'string-lessp))
-	      (setq he-expand-list ())))))
-
-  (while (and he-expand-list
-	      (he-string-member (car he-expand-list) he-tried-table))
-    (setq he-expand-list (cdr he-expand-list)))
-  (if (null he-expand-list)
-      (progn
-	(if old (he-reset-string))
-	())
-      (let ((filename (he-concat-directory-file-name
-		       (he-file-name-directory he-search-string)
-		       (car he-expand-list))))
-	(he-substitute-string filename)
-	(setq he-tried-table (cons (car he-expand-list) (cdr he-tried-table)))
-	(setq he-expand-list (cdr he-expand-list))
-	t)))
-
-(defun try-complete-file-name-partially (old)
-  "Try to complete text as a file name, as many characters as unique.
-The argument OLD has to be nil the first call of this function.  It
-returns t if a unique, possibly partial, completion is found, nil 
-otherwise."
-  (let ((expansion ()))
-    (if (not old)
-	(progn 
-	  (he-init-string (he-file-name-beg) (point))
-	  (let ((name-part (he-file-name-nondirectory he-search-string))
-		(dir-part (expand-file-name (or (he-file-name-directory
-						 he-search-string) ""))))
-	    (if (and (not (equal he-search-string ""))
-		     (he-file-directory-p dir-part))
-		(setq expansion (file-name-completion name-part
-						      dir-part)))
-	    (if (or (eq expansion t)
-		    (string= expansion name-part)
-		    (he-string-member expansion he-tried-table))
-		(setq expansion ())))))
-
-    (if (not expansion)
-	(progn
-	  (if old (he-reset-string))
-	  ())
-	(let ((filename (he-concat-directory-file-name
-			 (he-file-name-directory he-search-string)
-			 expansion)))
-	  (he-substitute-string filename)
-	  (setq he-tried-table (cons expansion (cdr he-tried-table)))
-	  t))))
-
-(defvar he-file-name-chars
-  (cond ((memq system-type '(vax-vms axp-vms))
-	 "-a-zA-Z0-9_/.,~^#$+=:\\[\\]")
-	((memq system-type '(ms-dos windows-nt))
-	 "-a-zA-Z0-9_/.,~^#$+=:\\\\")
-	(t			    ;; More strange file formats ?
-	 "-a-zA-Z0-9_/.,~^#$+="))
-  "Characters that are considered part of the file name to expand.")
-
-(defun he-file-name-beg ()
-  (save-excursion
-    (skip-chars-backward he-file-name-chars)
-    (point)))
-
-;; Thanks go to Richard Levitte <levitte@e.kth.se> who helped to make these
-;; work under VMS, and to David Hughes <ukchugd@ukpmr.cs.philips.nl> who 
-;; helped to make it work on PC.
-(defun he-file-name-nondirectory (file)
-  "Fix to make `file-name-nondirectory' work for hippie-expand under VMS."
-  (if (memq system-type '(axp-vms vax-vms))
-      (let ((n (file-name-nondirectory file)))
-	(if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n)
-	    (concat "[." (substring n (match-beginning 2) (match-end 2)))
-	  n))
-    (file-name-nondirectory file)))
-
-(defun he-file-name-directory (file)
-  "Fix to make `file-name-directory' work for hippie-expand under VMS."
-  (if (memq system-type '(axp-vms vax-vms))
-      (let ((n (file-name-nondirectory file))
-	    (d (file-name-directory file)))
-	(if (string-match "^\\(\\[.*\\)\\.\\([^\\.]*\\)$" n)
-	    (concat d (substring n (match-beginning 1) (match-end 1)) "]")
-	  d))
-    (file-name-directory file)))
-
-(defun he-file-directory-p (file)
-  "Fix to make `file-directory-p' work for hippie-expand under VMS."
-  (if (memq system-type '(vax-vms axp-vms))
-      (or (file-directory-p file)
-	  (file-directory-p (concat file "[000000]")))
-    (file-directory-p file)))
-  
-(defun he-concat-directory-file-name (dir-part name-part)
-  "Try to slam together two parts of a file specification, system dependently."
-  (cond ((null dir-part) name-part)
-	((memq system-type '(axp-vms vax-vms))
-	 (if (and (string= (substring dir-part -1) "]")
-		  (string= (substring name-part 0 2) "[."))
-	     (concat (substring dir-part 0 -1) (substring name-part 1))
-	   (concat dir-part name-part)))
-	((memq system-type '(ms-dos w32))
-	 (if (and (string-match "\\\\" dir-part)
-		  (not (string-match "/" dir-part))
-		  (= (aref name-part (1- (length name-part))) ?/))
-	     (aset name-part (1- (length name-part)) ?\\))
-	 (concat dir-part name-part))
-	(t 
-	 (concat dir-part name-part))))
-			
-(defun try-complete-lisp-symbol (old)
-  "Try to complete word as an Emacs Lisp symbol.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible completions of the same
-string).  It returns t if a new completion is found, nil otherwise."
-  (if (not old)
-      (progn 
-	(he-init-string (he-lisp-symbol-beg) (point))
-	(if (not (he-string-member he-search-string he-tried-table))
-	    (setq he-tried-table (cons he-search-string he-tried-table)))
-	(setq he-expand-list 
-	      (and (not (equal he-search-string ""))
-		   (sort (all-completions he-search-string obarray
-					  (function (lambda (sym)
-					    (or (boundp sym)
-						(fboundp sym)
-						(symbol-plist sym)))))
-			 'string-lessp)))))
-  (while (and he-expand-list
-	      (he-string-member (car he-expand-list) he-tried-table))
-    (setq he-expand-list (cdr he-expand-list)))
-  (if (null he-expand-list)
-      (progn
-	(if old (he-reset-string))
-	())
-      (progn
-	(he-substitute-string (car he-expand-list))
-	(setq he-expand-list (cdr he-expand-list))
-	t)))
-
-(defun try-complete-lisp-symbol-partially (old)
-  "Try to complete as an Emacs Lisp symbol, as many characters as unique.
-The argument OLD has to be nil the first call of this function.  It
-returns t if a unique, possibly partial, completion is found, nil 
-otherwise."
-  (let ((expansion ()))
-    (if (not old)
-	(progn 
-	  (he-init-string (he-lisp-symbol-beg) (point))
-	  (if (not (string= he-search-string ""))
-	      (setq expansion 
-		    (try-completion he-search-string obarray
-				    (function (lambda (sym)
-				      (or (boundp sym)
-					  (fboundp sym)
-					  (symbol-plist sym)))))))
-	  (if (or (eq expansion t)
-		  (string= expansion he-search-string)
-		  (he-string-member expansion he-tried-table))
-	      (setq expansion ()))))
-
-  (if (not expansion)
-      (progn
-	(if old (he-reset-string))
-	())
-      (progn
-	(he-substitute-string expansion)
-	t))))
-
-(defun he-lisp-symbol-beg ()
-  (let ((skips "-a-zA-Z0-9_."))
-    (save-excursion
-      (skip-chars-backward skips)
-      (point))))
-
-(defun try-expand-line (old)
-  "Try to complete the current line to an entire line in the buffer.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible completions of the same
-string).  It returns t if a new completion is found, nil otherwise."
-  (let ((expansion ())
-	(strip-prompt (and (get-buffer-process (current-buffer))
-			   comint-prompt-regexp)))
-    (if (not old)
-	(progn
-	  (he-init-string (he-line-beg strip-prompt) (point))
-	  (set-marker he-search-loc he-string-beg)
-	  (setq he-search-bw t)))
-
-    (if (not (equal he-search-string ""))
-	(save-excursion
-	  ;; Try looking backward unless inhibited.
-	  (if he-search-bw
-	      (progn 
-		(goto-char he-search-loc)
-		(setq expansion (he-line-search he-search-string
-						strip-prompt t))
-		(set-marker he-search-loc (point))
-		(if (not expansion)
-		    (progn
-		      (set-marker he-search-loc he-string-end)
-		      (setq he-search-bw ())))))
-	  
-	  (if (not expansion) ; Then look forward.
-	      (progn 
-		(goto-char he-search-loc)
-		(setq expansion (he-line-search he-search-string 
-						strip-prompt nil))
-		(set-marker he-search-loc (point))))))
-
-    (if (not expansion)
-	(progn
-	  (if old (he-reset-string))
-	  ())
-	(progn
-	  (he-substitute-string expansion t)
-	  t))))
-
-(defun try-expand-line-all-buffers (old)
-  "Try to complete the current line, searching all other buffers.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible completions of the same
-string).  It returns t if a new completion is found, nil otherwise."
-  (let ((expansion ())
-	(strip-prompt (and (get-buffer-process (current-buffer))
-			   comint-prompt-regexp))
-	(buf (current-buffer))
-	(orig-case-fold-search case-fold-search))
-    (if (not old)
-	(progn
-	  (he-init-string (he-line-beg strip-prompt) (point))
-	  (setq he-search-bufs (buffer-list))
-	  (setq he-searched-n-bufs 0)
-	  (set-marker he-search-loc 1 (car he-search-bufs))))
-
-    (if (not (equal he-search-string ""))
-	(while (and he-search-bufs 
-		    (not expansion)
-		    (or (not hippie-expand-max-buffers)
-			(< he-searched-n-bufs hippie-expand-max-buffers)))
-	  (set-buffer (car he-search-bufs))
-	  (if (and (not (eq (current-buffer) buf))
-		   (not (memq major-mode hippie-expand-ignore-buffers))
-		   (not (he-regexp-member (buffer-name)
-					  hippie-expand-ignore-buffers)))
-	      (save-excursion
-		(goto-char he-search-loc)
-		(setq strip-prompt (and (get-buffer-process (current-buffer))
-					comint-prompt-regexp))
-		(setq expansion (let ((case-fold-search orig-case-fold-search))
-				  (he-line-search he-search-string
-						  strip-prompt nil)))
-		(set-marker he-search-loc (point))
-		(if (not expansion)
-		    (progn
-		      (setq he-search-bufs (cdr he-search-bufs))
-		      (setq he-searched-n-bufs (1+ he-searched-n-bufs))
-		      (set-marker he-search-loc 1 (car he-search-bufs)))))
-	    (setq he-search-bufs (cdr he-search-bufs))
-	    (set-marker he-search-loc 1 (car he-search-bufs)))))
-
-    (set-buffer buf)
-    (if (not expansion)
-	(progn
-	  (if old (he-reset-string))
-	  ())
-	(progn
-	  (he-substitute-string expansion t)
-	  t))))
-
-(defun he-line-search (str strip-prompt reverse) 
-  (let ((result ()))
-    (while (and (not result)
-		(if reverse
-		    (re-search-backward 
-		     (he-line-search-regexp str strip-prompt)
-		     nil t)
-		    (re-search-forward
-		     (he-line-search-regexp str strip-prompt)
-		     nil t)))
-      (setq result (buffer-substring (match-beginning 2) (match-end 2)))
-      (if (he-string-member result he-tried-table t)
-	  (setq result nil)))		    ; if already in table, ignore
-    result))
-
-(defun he-line-beg (strip-prompt)
-  (save-excursion
-    (if (re-search-backward (he-line-search-regexp "" strip-prompt) 
-			    (save-excursion (beginning-of-line)
-					    (point)) t)
-	(match-beginning 2)
-      (point))))
-
-(defun he-line-search-regexp (pat strip-prompt)
-  (if strip-prompt
-      (concat "\\(" comint-prompt-regexp "\\|^\\s-*\\)\\("
-	      (regexp-quote pat)
-	      "[^\n]*[^ \t\n]\\)")
-      (concat "^\\(\\s-*\\)\\(" 
-	      (regexp-quote pat)
-	      "[^\n]*[^ \t\n]\\)")))
-
-(defun try-expand-list (old)
-  "Try to complete the current beginning of a list.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible completions of the same
-string).  It returns t if a new completion is found, nil otherwise."
-  (let ((expansion ()))
-    (if (not old)
-	(progn
-	  (he-init-string (he-list-beg) (point))
-	  (set-marker he-search-loc he-string-beg)
-	  (setq he-search-bw t)))
-
-    (if (not (equal he-search-string ""))
-	(save-excursion
-	  ;; Try looking backward unless inhibited.
-	  (if he-search-bw
-	      (progn 
-		(goto-char he-search-loc)
-		(setq expansion (he-list-search he-search-string t))
-		(set-marker he-search-loc (point))
-		(if (not expansion)
-		    (progn
-		      (set-marker he-search-loc he-string-end)
-		      (setq he-search-bw ())))))
-	  
-	  (if (not expansion) ; Then look forward.
-	      (progn 
-		(goto-char he-search-loc)
-		(setq expansion (he-list-search he-search-string nil))
-		(set-marker he-search-loc (point))))))
-
-    (if (not expansion)
-	(progn
-	  (if old (he-reset-string))
-	  ())
-	(progn
-	  (he-substitute-string expansion t)
-	  t))))
-
-(defun try-expand-list-all-buffers (old)
-  "Try to complete the current list, searching all other buffers.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible completions of the same
-string).  It returns t if a new completion is found, nil otherwise."
-  (let ((expansion ())
-	(buf (current-buffer))
-	(orig-case-fold-search case-fold-search))
-    (if (not old)
-	(progn
-	  (he-init-string (he-list-beg) (point))
-	  (setq he-search-bufs (buffer-list))
-	  (setq he-searched-n-bufs 0)
-	  (set-marker he-search-loc 1 (car he-search-bufs))))
-
-    (if (not (equal he-search-string ""))
-	(while (and he-search-bufs 
-		    (not expansion)
-		    (or (not hippie-expand-max-buffers)
-			(< he-searched-n-bufs hippie-expand-max-buffers)))
-	  (set-buffer (car he-search-bufs))
-	  (if (and (not (eq (current-buffer) buf))
-		   (not (memq major-mode hippie-expand-ignore-buffers))
-		   (not (he-regexp-member (buffer-name)
-					  hippie-expand-ignore-buffers)))
-	      (save-excursion
-		(goto-char he-search-loc)
-		(setq expansion (let ((case-fold-search orig-case-fold-search))
-				  (he-list-search he-search-string nil)))
-		(set-marker he-search-loc (point))
-		(if (not expansion)
-		    (progn
-		      (setq he-search-bufs (cdr he-search-bufs))
-		      (setq he-searched-n-bufs (1+ he-searched-n-bufs))
-		      (set-marker he-search-loc 1 (car he-search-bufs)))))
-	    (setq he-search-bufs (cdr he-search-bufs))
-	    (set-marker he-search-loc 1 (car he-search-bufs)))))
-
-    (set-buffer buf)
-    (if (not expansion)
-	(progn
-	  (if old (he-reset-string))
-	  ())
-	(progn
-	  (he-substitute-string expansion t)
-	  t))))
-
-(defun he-list-search (str reverse) 
-  (let ((result ())
-	beg pos err)
-    (while (and (not result)
-		(if reverse
-		    (search-backward str nil t)
-		    (search-forward str nil t)))
-      (setq pos (point))
-      (setq beg (match-beginning 0))
-      (goto-char beg)
-      (setq err ())
-      (condition-case ()
-	  (forward-list 1)
-	(error (setq err t)))
-      (if (and reverse 
-	       (> (point) he-string-beg))
-	  (setq err t))
-      (if (not err)
-	  (progn
-	    (setq result (buffer-substring beg (point)))
-	    (if (he-string-member result he-tried-table t)
-		(setq result nil))))	       ; if already in table, ignore
-      (goto-char pos))
-    result))
-
-(defun he-list-beg ()
-  (save-excursion
-    (condition-case ()
-	(backward-up-list 1)
-      (error ()))
-    (point)))
-
-(defun try-expand-all-abbrevs (old)
-  "Try to expand word before point according to all abbrev tables.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible expansions of the same
-string).  It returns t if a new expansion is found, nil otherwise."
-  (if (not old)
-      (progn
-	(he-init-string (he-dabbrev-beg) (point))
-	(setq he-expand-list 
-	      (and (not (equal he-search-string ""))
-		   (mapcar (function (lambda (sym)
-			     (if (and (boundp sym) (vectorp (eval sym)))
-				 (abbrev-expansion (downcase he-search-string)
-						   (eval sym)))))
-			   (append '(local-abbrev-table 
-				     global-abbrev-table)
-				   abbrev-table-name-list))))))
-  (while (and he-expand-list
-	      (or (not (car he-expand-list))
-		  (he-string-member (car he-expand-list) he-tried-table t)))
-    (setq he-expand-list (cdr he-expand-list)))
-  (if (null he-expand-list)
-      (progn
-	(if old (he-reset-string))
-	())
-      (progn
-	(he-substitute-string (car he-expand-list) t)
-	(setq he-expand-list (cdr he-expand-list))
-	t)))
-
-(defun try-expand-dabbrev (old)
-  "Try to expand word \"dynamically\", searching the current buffer.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible expansions of the same
-string).  It returns t if a new expansion is found, nil otherwise."
-  (let ((expansion ()))
-    (if (not old)
-	(progn
-	  (he-init-string (he-dabbrev-beg) (point))
-	  (set-marker he-search-loc he-string-beg)
-	  (setq he-search-bw t)))
-
-    (if (not (equal he-search-string ""))
-	(save-excursion
-	  ;; Try looking backward unless inhibited.
-	  (if he-search-bw
-	      (progn 
-		(goto-char he-search-loc)
-		(setq expansion (he-dabbrev-search he-search-string t))
-		(set-marker he-search-loc (point))
-		(if (not expansion)
-		    (progn
-		      (set-marker he-search-loc he-string-end)
-		      (setq he-search-bw ())))))
-	  
-	  (if (not expansion) ; Then look forward.
-	      (progn 
-		(goto-char he-search-loc)
-		(setq expansion (he-dabbrev-search he-search-string nil))
-		(set-marker he-search-loc (point))))))
-	
-    (if (not expansion)
-	(progn
-	  (if old (he-reset-string))
-	  ())
-	(progn
-	  (he-substitute-string expansion t)
-	  t))))
-
-(defun try-expand-dabbrev-all-buffers (old)
-  "Tries to expand word \"dynamically\", searching all other buffers.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible expansions of the same
-string).  It returns t if a new expansion is found, nil otherwise."
-  (let ((expansion ())
-	(buf (current-buffer))
-	(orig-case-fold-search case-fold-search))
-    (if (not old)
-	(progn
-	  (he-init-string (he-dabbrev-beg) (point))
-	  (setq he-search-bufs (buffer-list))
-	  (setq he-searched-n-bufs 0)
-	  (set-marker he-search-loc 1 (car he-search-bufs))))
-
-    (if (not (equal he-search-string ""))
-	(while (and he-search-bufs 
-		    (not expansion)
-		    (or (not hippie-expand-max-buffers)
-			(< he-searched-n-bufs hippie-expand-max-buffers)))
-	  (set-buffer (car he-search-bufs))
-	  (if (and (not (eq (current-buffer) buf))
-		   (not (memq major-mode hippie-expand-ignore-buffers))
-		   (not (he-regexp-member (buffer-name)
-					  hippie-expand-ignore-buffers)))
-	      (save-excursion
-		(goto-char he-search-loc)
-		(setq expansion (let ((case-fold-search orig-case-fold-search))
-				  (he-dabbrev-search he-search-string nil)))
-		(set-marker he-search-loc (point))
-		(if (not expansion)
-		    (progn
-		      (setq he-search-bufs (cdr he-search-bufs))
-		      (setq he-searched-n-bufs (1+ he-searched-n-bufs))
-		      (set-marker he-search-loc 1 (car he-search-bufs)))))
-	    (setq he-search-bufs (cdr he-search-bufs))
-	    (set-marker he-search-loc 1 (car he-search-bufs)))))
-
-    (set-buffer buf)
-    (if (not expansion)
-	(progn
-	  (if old (he-reset-string))
-	  ())
-	(progn
-	  (he-substitute-string expansion t)
-	  t))))
-
-;; Thanks go to Jeff Dairiki <dairiki@faraday.apl.washington.edu> who
-;; suggested this one.
-(defun try-expand-dabbrev-visible (old)
-  "Try to expand word \"dynamically\", searching visible window parts.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible expansions of the same
-string).  It returns t if a new expansion is found, nil otherwise."
-  (let ((expansion ())
-	(buf (current-buffer))
-	(flag (if (frame-visible-p (window-frame (selected-window)))
-		  'visible t)))
-    (if (not old)
-	(progn
-	   (he-init-string (he-dabbrev-beg) (point))
-	   (setq he-search-window (selected-window))
-	   (set-marker he-search-loc
-		       (window-start he-search-window)
-		       (window-buffer he-search-window))))
-
-    (while (and (not (equal he-search-string ""))
-		(marker-position he-search-loc)
-		(not expansion))
-      (save-excursion
-	(set-buffer (marker-buffer he-search-loc))
-	(goto-char he-search-loc)
-	(setq expansion (he-dabbrev-search he-search-string ()
-					   (window-end he-search-window)))
-	(if (and expansion
-		 (eq (marker-buffer he-string-beg) (current-buffer))
-		 (eq (marker-position he-string-beg) (match-beginning 0)))
-	    (setq expansion (he-dabbrev-search he-search-string ()
-					       (window-end he-search-window))))
-	(set-marker he-search-loc (point) (current-buffer)))
-      (if (not expansion)
-	  (progn 
-	    (setq he-search-window (next-window he-search-window nil flag))
-	    (if (eq he-search-window (selected-window))
-		(set-marker he-search-loc nil)
-	      (set-marker he-search-loc (window-start he-search-window)
-			  (window-buffer he-search-window))))))
-    
-    (set-buffer buf)
-    (if (not expansion)
-	(progn
-	  (if old (he-reset-string))
-	  ())
-	(progn
-	  (he-substitute-string expansion t)
-	  t))))
-
-(defun he-dabbrev-search (pattern &optional reverse limit)
-  (let ((result ())
-	(regpat (if (eq (char-syntax (aref pattern 0)) ?_)
-		    (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")
-		  (concat "\\<" (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+"))))
-    (while (and (not result) 
-		(if reverse
-		     (re-search-backward regpat limit t)
-		     (re-search-forward regpat limit t)))
-      (setq result (buffer-substring (match-beginning 0) (match-end 0)))
-      (if (or (and (> (match-beginning 0) (point-min))
-		   (memq (char-syntax (char-after (1- (match-beginning 0))))
-			 '(?_ ?w)))
-	      (he-string-member result he-tried-table t))
-	  (setq result nil)))     ; ignore if bad prefix or already in table
-    result))
-
-(defvar he-dabbrev-skip-space ()
-  "Non-NIL means tolerate trailing spaces in the abbreviation to expand.")
-
-(defun he-dabbrev-beg ()
-  (let ((op (point)))
-    (save-excursion
-      (if he-dabbrev-skip-space
-	  (skip-syntax-backward ". "))
-      (if (= (skip-syntax-backward "w_") 0)
-	  op
-	(point)))))
-
-(defun try-expand-dabbrev-from-kill (old)
-  "Try to expand word \"dynamically\", searching the kill ring.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible completions of the same
-string).  It returns t if a new completion is found, nil otherwise."
-  (let ((expansion ()))
-    (if (not old)
-	(progn 
-	  (he-init-string (he-dabbrev-beg) (point))
-	  (setq he-expand-list
-		(if (not (equal he-search-string ""))
-		    kill-ring))
-	  (setq he-search-loc2 0)))
-    (if (not (equal he-search-string ""))
-	(setq expansion (he-dabbrev-kill-search he-search-string)))
-    (if (not expansion)
-	(progn
-	  (if old (he-reset-string))
-	  ())
-	(progn
-	  (he-substitute-string expansion t)
-	  t))))
-
-(defun he-dabbrev-kill-search (pattern)
-  (let ((result ())
-	(regpat (if (eq (char-syntax (aref pattern 0)) ?_)
-		    (concat (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")
-		  (concat "\\<" (regexp-quote pattern) "\\(\\sw\\|\\s_\\)+")))
-	(killstr (car he-expand-list)))
-    (while (and (not result) 
-		he-expand-list)
-      (while (and (not result)
-		  (string-match regpat killstr he-search-loc2))
-	(setq result (substring killstr (match-beginning 0) (match-end 0)))
-	(setq he-search-loc2 (1+ (match-beginning 0)))
-	(if (or (and (> (match-beginning 0) 0)
-		     (memq (char-syntax (aref killstr (1- (match-beginning 0))))
-			   '(?_ ?w)))
-		(he-string-member result he-tried-table t))
-	    (setq result nil)))     ; ignore if bad prefix or already in table
-      (if (and (not result) 
-		he-expand-list)
-	  (progn
-	    (setq he-expand-list (cdr he-expand-list)) 
-	    (setq killstr (car he-expand-list))
-	    (setq he-search-loc2 0))))
-    result))
-
-(defun try-expand-whole-kill (old)
-  "Try to complete text with something from the kill ring.
-The argument OLD has to be nil the first call of this function, and t
-for subsequent calls (for further possible completions of the same
-string).  It returns t if a new completion is found, nil otherwise."
-  (let ((expansion ()))
-    (if (not old)
-	(progn 
-	  (he-init-string (he-kill-beg) (point))
-	  (if (not (he-string-member he-search-string he-tried-table))
-	      (setq he-tried-table (cons he-search-string he-tried-table)))
-	  (setq he-expand-list 
-		(if (not (equal he-search-string ""))
-		    kill-ring))
-	  (setq he-search-loc2 ())))
-    (if (not (equal he-search-string ""))
-	(setq expansion (he-whole-kill-search he-search-string)))
-    (if (not expansion)
-	(progn
-	  (if old (he-reset-string))
-	  ())
-	(progn
-	  (he-substitute-string expansion)
-	  t))))
-
-(defun he-whole-kill-search (str)
-  (let ((case-fold-search ())
-	(result ())
-	(str (regexp-quote str))
-	(killstr (car he-expand-list))
-	(pos -1))
-    (while (and (not result)
-		he-expand-list)
-      (if (not he-search-loc2)
-	  (while (setq pos (string-match str killstr (1+ pos)))
-	    (setq he-search-loc2 (cons pos he-search-loc2))))
-      (while (and (not result)
-		  he-search-loc2)
-	(setq pos (car he-search-loc2))
-	(setq he-search-loc2 (cdr he-search-loc2))
-	(save-excursion
-	  (goto-char he-string-beg)
-	  (if (and (>= (- (point) pos) (point-min))   ; avoid some string GC
-		   (eq (char-after (- (point) pos)) (aref killstr 0))
-		   (search-backward (substring killstr 0 pos)
-				    (- (point) pos) t))
-	      (setq result (substring killstr pos))))
-	(if (and result
-		 (he-string-member result he-tried-table))
-	    (setq result nil)))     ; ignore if already in table
-      (if (and (not result)
-		he-expand-list)
-	  (progn
-	    (setq he-expand-list (cdr he-expand-list)) 
-	    (setq killstr (car he-expand-list))
-	    (setq pos -1))))
-    result))
-
-(defun he-kill-beg ()
-  (let ((op (point)))
-    (save-excursion
-      (skip-syntax-backward "^w_")
-      (if (= (skip-syntax-backward "w_") 0)
-	  op
-	(point)))))
-
-
-(provide 'hippie-exp)
-
-;;; hippie-exp.el ends here
diff --git a/lisp/hscroll.el b/lisp/hscroll.el
deleted file mode 100644
index 7dd3674527d..00000000000
--- a/lisp/hscroll.el
+++ /dev/null
@@ -1,233 +0,0 @@
-;;; hscroll.el: Minor mode to automatically scroll truncated lines horizontally
-;;; Copyright (C) 1992, 1993, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Wayne Mesard <wmesard@esd.sgi.com>
-;; Keywords: display
-
-;; 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:a
-;;
-;;    Automatically scroll horizontally when the point moves off the
-;;    left or right edge of the window.  
-;;
-;;    - Type "M-x hscroll-mode" to enable it in the current buffer.
-;;    - Type "M-x hscroll-global-mode" to enable it in every buffer.
-;;    - "turn-on-hscroll" is useful in mode hooks as in:
-;;          (add-hook 'text-mode-hook 'turn-on-hscroll)
-;;
-;;    - hscroll-margin controls how close the cursor can get to the edge 
-;;      of the window.
-;;    - hscroll-step-percent controls how far to jump once we decide to do so.
-;;
-;;    Most users won't want to mess with the other variables defined
-;;    here.  But they're all documented, and they all start with
-;;    "hscroll-" if you're curious.
-;;
-;;    Oh, you should also know that if you set the hscroll-margin and
-;;    hscroll-step-percent large enough, you can get an interesting, but
-;;    undesired ping-pong effect as the point bounces from one edge to
-;;    the other.
-;;
-;;    wmesard@sgi.com
-
-;;; Code:
-
-;;; 
-;;; PUBLIC VARIABLES
-;;; 
-
-(defvar hscroll-version "2.2")
-
-(defvar hscroll-margin 5 
-  "*How many columns away from the edge of the window point is allowed to get
-before HScroll will horizontally scroll the window.")
-
-(defvar hscroll-snap-threshold 30
-  "*When point is this many columns (or less) from the left edge of the document, 
-don't do any horizontal scrolling.  In other words, be biased towards the left
-edge of the document.
-  Set this variable to zero to disable this bias.")
-
-(defvar hscroll-step-percent 25
-  "*How far away to place the point from the window's edge when scrolling.
-Expressed as a percentage of the window's width.")
-
-(defvar hscroll-mode-name " Hscr"
-  "*Horizontal scrolling mode line indicator.
-Set this to nil to conserve valuable mode line space.")
-
-(or (assq 'hscroll-mode minor-mode-alist)
-    (setq minor-mode-alist
-	  (cons '(hscroll-mode hscroll-mode-name) minor-mode-alist)))
-
-
-;;; 
-;;; PRIVATE VARIABLES
-;;; 
-
-(defvar hscroll-mode nil 
-  "Non-nil if HScroll mode is enabled.")
-(make-variable-buffer-local 'hscroll-mode)
-
-
-(defvar hscroll-old-truncate-local nil)
-(defvar hscroll-old-truncate-was-global nil)
-(make-variable-buffer-local 'hscroll-old-truncate)
-(make-variable-buffer-local 'hscroll-old-truncate-was-global)
-
-(defvar hscroll-old-truncate-default nil)
-
-;;; 
-;;; PUBLIC COMMANDS
-;;; 
-
-;;;###autoload
-(defun turn-on-hscroll ()
-  "Unconditionally turn on Hscroll mode in the current buffer."
-  (hscroll-mode 1))
-
-;;;###autoload
-(defun hscroll-mode (&optional arg)
-  "Toggle HScroll mode in the current buffer.
-With ARG, turn HScroll mode on if ARG is positive, off otherwise.
-In HScroll mode, truncated lines will automatically scroll left or
-right when point gets near either edge of the window.
-  See also \\[hscroll-global-mode]."
-  (interactive "P")
-  (make-local-hook 'post-command-hook)
-  (let ((newmode (if (null arg)
-		      (not hscroll-mode)
-		    (> (prefix-numeric-value arg) 0))))
-
-    (if newmode
-	;; turn it on
-	(if (not hscroll-mode)
-	    ;; it was off
-	    (let ((localp (local-variable-p 'truncate-lines)))
-	      (if localp
-		  (setq hscroll-old-truncate-local truncate-lines))
-	      (setq hscroll-old-truncate-was-global (not localp))
-	      (setq truncate-lines t)
-	      (add-hook 'post-command-hook 
-			(function hscroll-window-maybe) nil t)
-	      ))
-      ;; turn it off
-      (if hscroll-mode
-	  ;; it was on
-	  (progn
-	    (if hscroll-old-truncate-was-global
-		(kill-local-variable 'truncate-lines)
-	      (setq truncate-lines hscroll-old-truncate-local))
-	    (if (not truncate-lines)
-		(set-window-hscroll (selected-window) 0))
-	    (remove-hook 'post-command-hook
-			 (function hscroll-window-maybe) t)
-	    ))
-      )
-
-    (setq hscroll-mode newmode)
-    (force-mode-line-update nil)
-    ))
-
-
-;;;###autoload
-(defun hscroll-global-mode  (&optional arg)
-  "Toggle HScroll mode in all buffers.
-With ARG, turn HScroll mode on if ARG is positive, off otherwise.
-If a buffer ever has HScroll mode set locally (via \\[hscroll-mode]), 
-it will forever use the local value (i.e., \\[hscroll-global-mode] 
-will have no effect on it).
-  See also \\[hscroll-mode]."
-  (interactive "P")
-  (let* ((oldmode (default-value 'hscroll-mode))
-	 (newmode (if (null arg)
-		      (not oldmode)
-		    (> (prefix-numeric-value arg) 0))))
-
-    (if newmode
-	;; turn it on
-	(if (not hscroll-mode)
-	    ;; it was off
-	    (progn
-	      (setq hscroll-old-truncate-default (default-value truncate-lines))
-	      (setq hscroll-old-truncate-was-global t)
-	      (setq-default truncate-lines t)
-	      (add-hook 'post-command-hook (function hscroll-window-maybe))
-	      ))
-      ;; turn it off
-      (if hscroll-mode
-	  ;; it was on
-	  (progn
-	    (setq-default truncate-lines hscroll-old-truncate-default)
-	    (remove-hook 'post-command-hook (function hscroll-window-maybe))
-	    ))
-      )
-
-    (setq-default hscroll-mode newmode)
-    (force-mode-line-update t)
-    ))
-
-(defun hscroll-window-maybe ()
-  "Scroll horizontally if point is off or nearly off the edge of the window.
-This is called automatically when in HScroll mode, but it can be explicitly
-invoked as well (i.e., it can be bound to a key)."
-  (interactive)
-  ;; Only consider scrolling if truncate-lines is true, 
-  ;; the window is already scrolled or partial-widths is true and this is
-  ;; a partial width window.  See display_text_line() in xdisp.c.
-  (if (and hscroll-mode
-	   (or truncate-lines
-	       (not (zerop (window-hscroll)))
-	       (and truncate-partial-width-windows
-		    (< (window-width) (frame-width)))))
-      (let ((linelen (save-excursion (end-of-line) (current-column)))
-	    (rightmost-char (+ (window-width) (window-hscroll)))
-	    )
- 	(if (< (current-column) hscroll-snap-threshold)
- 	    (set-window-hscroll 
- 	     (selected-window) 
- 	     (- (window-hscroll)))
- 	  (if (>= (current-column)
-		(- rightmost-char hscroll-margin
-		   ;; Off-by-one if the left edge is scrolled
-		   (if (not (zerop (window-hscroll))) 1 0)
-		   ;; Off by one if the right edge is scrolled
-		   (if (> linelen rightmost-char) 1 0)
-		   ))
-	    ;; Scroll to the left a proportion of the window's width.
-	    (set-window-hscroll 
-	     (selected-window) 
-	     (- (+ (current-column) 
-		   (/ (* (window-width) hscroll-step-percent) 100))
-		(window-width)))
-	  (if (< (current-column) (+ (window-hscroll) hscroll-margin))
-	      ;; Scroll to the right a proportion of the window's width.
-	      (set-window-hscroll
-	       (selected-window)
-	       (- (current-column) (/ (* (window-width) hscroll-step-percent) 100)))
-	    )))
-	)))
-
-;;; 
-;;; It's not a bug, it's a *feature*
-;;; 
-
-(provide 'hscroll)
-
-;;; hscroll.el ends here
diff --git a/lisp/icomplete.el b/lisp/icomplete.el
deleted file mode 100644
index 025af152a9d..00000000000
--- a/lisp/icomplete.el
+++ /dev/null
@@ -1,287 +0,0 @@
-;;; icomplete.el --- minibuffer completion incremental feedback
-
-;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Ken Manheimer <klm@nist.gov>
-;; Maintainer: Ken Manheimer <klm@nist.gov>
-;; Created: Mar 1993 klm@nist.gov - first release to usenet
-;; Keywords: help, abbrev
-
-;; 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:
-
-;; Loading this package implements a more fine-grained minibuffer
-;; completion feedback scheme.  Prospective completions are concisely
-;; indicated within the minibuffer itself, with each successive
-;; keystroke.
-
-;; See 'icomplete-completions' docstring for a description of the
-;; icomplete display format.
-
-;; See the `icomplete-minibuffer-setup-hook' docstring for a means to
-;; customize icomplete setup for interoperation with other
-;; minibuffer-oriented packages.
-
-;; To activate icomplete mode, simply load the package.  You can
-;; subsequently deactivate it by invoking the function icomplete-mode
-;; with a negative prefix-arg (C-U -1 ESC-x icomplete-mode).  Also,
-;; you can prevent activation of the mode during package load by
-;; first setting the variable `icomplete-mode' to nil.  Icompletion
-;; can be enabled any time after the package is loaded by invoking
-;; icomplete-mode without a prefix arg.
-
-;; Thanks to everyone for their suggestions for refinements of this
-;; package.  I particularly have to credit Michael Cook, who
-;; implemented an incremental completion style in his 'iswitch'
-;; functions that served as a model for icomplete.  Some other
-;; contributors: Noah Freidman (restructuring as minor mode), Colin
-;; Rafferty (lemacs reconciliation), Lars Lindberg, RMS, and
-;; others.
-
-;; klm.
-
-;;; Code:
-
-;;;_* Provide
-(provide 'icomplete)
-
-;;;_* User Customization variables
-
-;;;_* Initialization
-;;;_  = icomplete-minibuffer-setup-hook
-(defvar icomplete-minibuffer-setup-hook nil
-  "*Icomplete-specific customization of minibuffer setup.
-
-This hook is run during minibuffer setup iff icomplete will be active.
-It is intended for use in customizing icomplete for interoperation
-with other packages.  For instance:
-
-  \(add-hook 'icomplete-minibuffer-setup-hook 
-	    \(function
-	     \(lambda ()
-	       \(make-local-variable 'resize-minibuffer-window-max-height)
-	       \(setq resize-minibuffer-window-max-height 3))))
-
-will constrain rsz-mini to a maximum minibuffer height of 3 lines when
-icompletion is occurring.")
-
-;;;_ + Internal Variables
-;;;_  = icomplete-mode
-(defvar icomplete-mode t
-  "Non-nil enables incremental minibuffer completion, once
-`\\[icomplete-mode]' function has set things up.")
-;;;_  = icomplete-eoinput 1
-(defvar icomplete-eoinput 1
-  "Point where minibuffer input ends and completion info begins.")
-(make-variable-buffer-local 'icomplete-eoinput)
-;;;_  = icomplete-pre-command-hook
-(defvar icomplete-pre-command-hook nil
-  "Incremental-minibuffer-completion pre-command-hook.
-
-Is run in minibuffer before user input when `icomplete-mode' is non-nil.
-Use `icomplete-mode' function to set it up properly for incremental
-minibuffer completion.")
-(add-hook 'icomplete-pre-command-hook 'icomplete-tidy)
-;;;_  = icomplete-post-command-hook
-(defvar icomplete-post-command-hook nil
-  "Incremental-minibuffer-completion post-command-hook.
-
-Is run in minibuffer after user input when `icomplete-mode' is non-nil.
-Use `icomplete-mode' function to set it up properly for incremental
-minibuffer completion.")
-(add-hook 'icomplete-post-command-hook 'icomplete-exhibit)
-
-;;;_ > icomplete-mode (&optional prefix)
-;;;###autoload
-(defun icomplete-mode (&optional prefix)
-  "Activate incremental minibuffer completion for this emacs session,
-or deactivate with negative prefix arg."
-  (interactive "p")
-  (or prefix (setq prefix 0))
-  (cond ((>= prefix 0)
-	 (setq icomplete-mode t)
-	 ;; The following is not really necessary after first time -
-	 ;; no great loss.
-	 (add-hook 'minibuffer-setup-hook 'icomplete-minibuffer-setup))
-	(t (setq icomplete-mode nil))))
-
-;;;_ > icomplete-simple-completing-p ()
-(defun icomplete-simple-completing-p ()
-
-  "Non-nil if current window is minibuffer that's doing simple completion.
-
-Conditions are:
-   the selected window is a minibuffer,
-   and not in the middle of macro execution,
-   and minibuffer-completion-table is not a symbol (which would
-       indicate some non-standard, non-simple completion mechanism,
-       like file-name and other custom-func completions)."
-
-  (and (window-minibuffer-p (selected-window))
-       (not executing-kbd-macro)
-       (not (symbolp minibuffer-completion-table))))
-
-;;;_ > icomplete-minibuffer-setup ()
-;;;###autoload
-(defun icomplete-minibuffer-setup ()
-  "Run in minibuffer on activation to establish incremental completion.
-Usually run by inclusion in `minibuffer-setup-hook'."
-  (cond ((and icomplete-mode (icomplete-simple-completing-p))
-	 (make-local-hook 'pre-command-hook)
-	 (add-hook 'pre-command-hook
-		   (function (lambda ()
-			       (run-hooks 'icomplete-pre-command-hook)))
-		   nil t)
-	 (make-local-hook 'post-command-hook)
-	 (add-hook 'post-command-hook
-		   (function (lambda ()
-			       (run-hooks 'icomplete-post-command-hook)))
-		   nil t)
-	 (run-hooks 'icomplete-minibuffer-setup-hook))))
-
-;;;_* Completion
-
-;;;_ > icomplete-tidy ()
-(defun icomplete-tidy ()
-  "Remove completions display \(if any) prior to new user input.
-Should be run in on the minibuffer `pre-command-hook'.  See `icomplete-mode'
-and `minibuffer-setup-hook'."
-  (if (icomplete-simple-completing-p)
-      (if (and (boundp 'icomplete-eoinput)
-	       icomplete-eoinput)
-
-	  (if (> icomplete-eoinput (point-max))
-	      ;; Oops, got rug pulled out from under us - reinit:
-	      (setq icomplete-eoinput (point-max))
-	    (let ((buffer-undo-list buffer-undo-list )) ; prevent entry
-	      (delete-region icomplete-eoinput (point-max))))
-
-	;; Reestablish the local variable 'cause minibuffer-setup is weird:
-	(make-local-variable 'icomplete-eoinput)
-	(setq icomplete-eoinput 1))))
-
-;;;_ > icomplete-exhibit ()
-(defun icomplete-exhibit ()
-  "Insert icomplete completions display.
-Should be run via minibuffer `post-command-hook'.  See `icomplete-mode'
-and `minibuffer-setup-hook'."
-  (if (icomplete-simple-completing-p)
-      (let ((contents (buffer-substring (point-min)(point-max)))
-	    (buffer-undo-list t))
-	(save-excursion
-	  (goto-char (point-max))
-                                        ; Register the end of input, so we
-                                        ; know where the extra stuff
-                                        ; (match-status info) begins:
-	  (if (not (boundp 'icomplete-eoinput))
-	      ;; In case it got wiped out by major mode business:
-	      (make-local-variable 'icomplete-eoinput))
-	  (setq icomplete-eoinput (point))
-                                        ; Insert the match-status information:
-	  (if (> (point-max) 1)
-	      (insert-string
-	       (icomplete-completions contents
-				      minibuffer-completion-table
-				      minibuffer-completion-predicate
-				      (not
-				       minibuffer-completion-confirm))))))))
-
-;;;_ > icomplete-completions (name candidates predicate require-match)
-(defun icomplete-completions (name candidates predicate require-match)
-  "Identify prospective candidates for minibuffer completion.
-
-The display is updated with each minibuffer keystroke during
-minibuffer completion.
-
-Prospective completion suffixes (if any) are displayed, bracketed by
-one of \(), \[], or \{} pairs.  The choice of brackets is as follows:
-
-  \(...) - a single prospect is identified and matching is enforced,
-  \[...] - a single prospect is identified but matching is optional, or
-  \{...} - multiple prospects, separated by commas, are indicated, and
-          further input is required to distinguish a single one.
-
-The displays for unambiguous matches have ` [Matched]' appended
-\(whether complete or not), or ` \[No matches]', if no eligible
-matches exist."
-
-  (let ((comps (all-completions name candidates predicate))
-                                        ; "-determined" - only one candidate
-        (open-bracket-determined (if require-match "(" "["))
-        (close-bracket-determined (if require-match ")" "]"))
-                                        ;"-prospects" - more than one candidate
-        (open-bracket-prospects "{")
-        (close-bracket-prospects "}")
-        )
-    (cond ((null comps) (format " %sNo matches%s"
-                                open-bracket-determined
-                                close-bracket-determined))
-          ((null (cdr comps))           ;one match
-           (concat (if (and (> (length (car comps))
-                               (length name)))
-                       (concat open-bracket-determined
-                               (substring (car comps) (length name))
-                               close-bracket-determined)
-                     "")
-                   " [Matched]"))
-          (t                            ;multiple matches
-           (let* ((most (try-completion name candidates predicate))
-                  (most-len (length most))
-                  most-is-exact
-                  (alternatives
-                   (apply
-                    (function concat)
-                    (cdr (apply
-			  (function nconc)
-			  (mapcar '(lambda (com)
-				     (if (= (length com) most-len)
-					 ;; Most is one exact match,
-					 ;; note that and leave out
-					 ;; for later indication:
-					 (progn
-					   (setq most-is-exact t)
-					   ())
-				       (list ","
-					     (substring com
-							most-len))))
-				  comps))))))
-             (concat (and (> most-len (length name))
-                          (concat open-bracket-determined
-                                  (substring most (length name))
-                                  close-bracket-determined))
-                     open-bracket-prospects
-                     (if most-is-exact
-                         (concat "," alternatives)
-                       alternatives)
-                     close-bracket-prospects))))))
-
-;;;_ + Initialization
-;;; If user hasn't setq-default icomplete-mode to nil, then setup for
-;;; activation:
-(if icomplete-mode
-    (icomplete-mode))
-
-
-;;;_* Local emacs vars.
-;;;Local variables:
-;;;outline-layout: (-2 :)
-;;;End:
-
-;;; icomplete.el ends here
-
diff --git a/lisp/ielm.el b/lisp/ielm.el
deleted file mode 100644
index afc2fa3a858..00000000000
--- a/lisp/ielm.el
+++ /dev/null
@@ -1,472 +0,0 @@
-;;; ielm.el --- interaction mode for Emacs Lisp
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: David Smith <maa036@lancaster.ac.uk>
-;; Created: 25 Feb 1994
-;; Keywords: lisp
-
-;; 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:
-
-;; Provides a nice interface to evaluating Emacs Lisp expressions.
-;; Input is handled by the comint package, and output is passed
-;; through the pretty-printer.
-
-;; To install: copy this file to a directory in your load-path, and
-;; add the following line to your .emacs file:
-;;
-;;   (autoload 'ielm "ielm" "Start an inferior Emacs Lisp session" t)
-;;
-;; For completion to work, the comint.el from FSF Emacs 19.23 is
-;; required.  If you do not have it, or if you are running Lemacs,
-;; also add the following code to your .emacs:
-;;
-;;    (setq ielm-mode-hook
-;; 	    '(lambda nil
-;; 		 (define-key ielm-map "\t"
-;; 		    '(lambda nil (interactive) (or (ielm-tab) 
-;;                                                 (lisp-complete-symbol))))))
-
-;; To start: M-x ielm.  Type C-h m in the *ielm* buffer for more info.
-
-;; The latest version is available by WWW from 
-;;      http://mathssun5.lancs.ac.uk:2080/~maa036/elisp/dir.html
-;; or by anonymous FTP from
-;;      /anonymous@wingra.stat.wisc.edu:pub/src/emacs-lisp/ielm.el.gz
-;; or from the author: David M. Smith <maa036@lancaster.ac.uk>
-
-;;; Code:
-
-(require 'comint)
-(require 'pp)
-
-;;; User variables
-
-(defvar ielm-noisy t
-  "*If non-nil, IELM will beep on error.")
-
-(defvar ielm-prompt "ELISP> "
-  "Prompt used in IELM.")
-
-(defvar ielm-dynamic-return t
-  "*Controls whether \\<ielm-map>\\[ielm-return] has intelligent behaviour in IELM.
-If non-nil, \\[ielm-return] evaluates input for complete sexps, or inserts a newline
-and indents for incomplete sexps.  If nil, always inserts newlines.")
-
-(defvar ielm-dynamic-multiline-inputs t
-  "*Force multiline inputs to start from column zero?
-If non-nil, after entering the first line of an incomplete sexp, a newline
-will be inserted after the prompt, moving the input to the next line.
-This gives more frame width for large indented sexps, and allows functions
-such as `edebug-defun' to work with such inputs.")
-
-(defvar ielm-mode-hook nil
-  "*Hooks to be run when IELM (`inferior-emacs-lisp-mode') is started.")
-
-;;; System variables
-
-(defvar ielm-working-buffer nil
-  "Buffer in which IELM sexps will be evaluated.
-This variable is buffer-local.")
-
-(defvar ielm-header 
-  (concat
-   "*** Welcome to IELM version "
-   (substring "$Revision: 1.7 $" 11 -2)
-   " ***  Type (describe-mode) for help.\n"
-   "IELM has ABSOLUTELY NO WARRANTY; type (describe-no-warranty) for details.\n")
-  "Message to display when IELM is started.")
-
-(defvar ielm-map nil)
-(if ielm-map nil
-  (if (string-match "Lucid" emacs-version)
-      ;; Lemacs
-      (progn
-	(setq ielm-map (make-sparse-keymap))
-	(set-keymap-parent ielm-map comint-mode-map))
-    ;; FSF
-    (setq ielm-map (cons 'keymap comint-mode-map)))
-  (define-key ielm-map "\t" 'comint-dynamic-complete)
-  (define-key ielm-map "\C-m" 'ielm-return)
-  (define-key ielm-map "\C-j" 'ielm-send-input)
-  (define-key ielm-map "\e\C-x" 'eval-defun)         ; for consistency with
-  (define-key ielm-map "\e\t" 'lisp-complete-symbol) ; lisp-interaction-mode
-  ;; These bindings are from shared-lisp-mode-map -- can you inherit
-  ;; from more than one keymap??
-  (define-key ielm-map "\e\C-q" 'indent-sexp)      
-  (define-key ielm-map "\177" 'backward-delete-char-untabify)
-  ;; Some convenience bindings for setting the working buffer
-  (define-key ielm-map "\C-c\C-b" 'ielm-change-working-buffer)
-  (define-key ielm-map "\C-c\C-f" 'ielm-display-working-buffer)
-  (define-key ielm-map "\C-c\C-v" 'ielm-print-working-buffer))
-
-(defvar ielm-font-lock-keywords
-  (list 
-   (cons (concat "^" (regexp-quote ielm-prompt)) 'font-lock-keyword-face)
-   '("\\(^\\*\\*\\*[^*]+\\*\\*\\*\\)\\(.*$\\)" (1 font-lock-comment-face) (2 font-lock-reference-face)))
-  "Additional expressions to highlight in ielm buffers.")
-	
-;;; Completion stuff
-
-(defun ielm-tab nil
-  "Possibly indent the current line as lisp code."
-  (interactive)
-  (if (or (eq (preceding-char) ?\n)
-	  (eq (char-syntax (preceding-char)) ? ))
-      (progn
-	(ielm-indent-line)
-	t)))
-  
-(defun ielm-complete-symbol nil
-  "Complete the lisp symbol before point."
-  ;; A wrapper for lisp-complete symbol that returns non-nil if
-  ;; completion has occurred
-  (let* ((btick (buffer-modified-tick))
-	 (cbuffer (get-buffer "*Completions*"))
-	 (ctick (and cbuffer (buffer-modified-tick cbuffer))))
-    (lisp-complete-symbol)
-     ;; completion has occurred if:
-    (or 
-     ;; the buffer has been modified
-     (not (= btick (buffer-modified-tick))) 
-     ;; a completions buffer has been modified or created
-     (if cbuffer
-	 (not (= ctick (buffer-modified-tick cbuffer)))
-       (get-buffer "*Completions*")))))
-
-(defun ielm-complete-filename nil
-  "Dynamically complete filename before point, if in a string."
-  (if (nth 3 (parse-partial-sexp comint-last-input-start (point)))
-      (comint-dynamic-complete-filename)))
-     
-(defun ielm-indent-line nil
-  "Indent the current line as Lisp code if it is not a prompt line."
-  (if (save-excursion
-	(beginning-of-line)
-	(looking-at comint-prompt-regexp)) nil
-    (lisp-indent-line)))
-
-;;; Working buffer manipulation
-
-(defun ielm-print-working-buffer nil
-  "Print the current IELM working buffer's name in the echo area."
-  (interactive)
-  (message "The current working buffer is: %s" (buffer-name ielm-working-buffer)))
-
-(defun ielm-display-working-buffer nil
-  "Display the current IELM working buffer.
-Don't forget that selecting that buffer will change its value of `point'
-to its value of `window-point'!"
-  (interactive)
-  (display-buffer ielm-working-buffer)
-  (ielm-print-working-buffer))
-
-(defun ielm-change-working-buffer (buf)
-  "Change the current IELM working buffer to BUF.
-This is the buffer in which all sexps entered at the IELM prompt are
-evaluated.  You can achieve the same effect with a call to
-`set-buffer' at the IELM prompt."
-  (interactive "bSet working buffer to: ")
-  (setq ielm-working-buffer (or (get-buffer buf) (error "No such buffer")))
-  (ielm-print-working-buffer))
-
-;;; Other bindings
-
-(defun ielm-return nil
-  "Newline and indent, or evaluate the sexp before the prompt.
-Complete sexps are evaluated; for incomplete sexps inserts a newline
-and indents.  If however `ielm-dynamic-return' is nil, this always
-simply inserts a newline."
-  (interactive)
-  (if ielm-dynamic-return 
-      (let ((state       
-	     (save-excursion
-	       (end-of-line)
-	       (parse-partial-sexp (ielm-pm)
-				   (point)))))
-	(if (and (< (car state) 1) (not (nth 3 state)))
-	    (ielm-send-input)
-	  (if (and ielm-dynamic-multiline-inputs
-		   (save-excursion
-		     (beginning-of-line)
-		     (looking-at comint-prompt-regexp)))
-	      (save-excursion
-		(goto-char (ielm-pm))
-		(newline 1)))
-	  (newline-and-indent)))
-    (newline)))
-
-(defun ielm-input-sender (proc input)
-  ;; Just sets the variable ielm-input, which is in the scope of 
-  ;; `ielm-send-input's call.
-  (setq ielm-input input))
-
-(defun ielm-send-input nil
-  "Evaluate the Emacs Lisp expression after the prompt."
-  (interactive)
-  (let ((buf (current-buffer))
-	ielm-input)			; set by ielm-input-sender
-    (comint-send-input)			; update history, markers etc.
-    (ielm-eval-input ielm-input)))
-
-;;; Utility functions
-
-(defun ielm-is-whitespace (string)
-  "Return non-nil if STRING is all whitespace."
-  (or (string= string "") (string-match "\\`[ \t\n]+\\'" string)))
-
-(defun ielm-format-errors (errlist)
-  (let ((result ""))
-    (while errlist
-      (setq result (concat result (prin1-to-string (car errlist)) ", "))
-      (setq errlist (cdr errlist)))
-    (substring result 0 -2)))
-
-
-(defun ielm-format-error (err)
-  ;; Return a string form of the error ERR.
-  (format "%s%s"
-	  (or (get (car err) 'error-message) "Peculiar error")
-	  (if (cdr err)
-	      (format ": %s" (ielm-format-errors (cdr err)))
-	    "")))
-
-;;; Evaluation
-
-(defun ielm-eval-input (ielm-string)
-  "Evaluate the Lisp expression IELM-STRING, and pretty-print the result."
-  ;; This is the function that actually `sends' the input to the
-  ;; `inferior Lisp process'. All comint-send-input does is works out
-  ;; what that input is.  What this function does is evaluates that
-  ;; input and produces `output' which gets inserted into the buffer,
-  ;; along with a new prompt.  A better way of doing this might have
-  ;; been to actually send the output to the `cat' process, and write
-  ;; this as in output filter that converted sexps in the output
-  ;; stream to their evaluated value.  But that would have involved
-  ;; more process coordination than I was happy to deal with.
-  ;;
-  ;; NOTE: all temporary variables in this function will be in scope
-  ;; during the eval, and so need to have non-clashing names.
-  (let (ielm-form			; form to evaluate
-	ielm-pos			; End posn of parse in string
-	ielm-result			; Result, or error message
-	ielm-error-type			; string, nil if no error
-	(ielm-output	"")		; result to display
-	(ielm-wbuf ielm-working-buffer)	; current buffer after evaluation
-	(ielm-pmark (ielm-pm)))
-    (if (not (ielm-is-whitespace ielm-string))
-	(progn
-	  (condition-case err
-	      (let (rout)
-		(setq rout (read-from-string ielm-string))
-		(setq ielm-form (car rout))
-		(setq ielm-pos (cdr rout)))
-	    (error (setq ielm-result (ielm-format-error err))
-		   (setq ielm-error-type "Read error")))
-	  (if ielm-error-type nil
-	    ;; Make sure working buffer has not been killed
-	    (if (not (buffer-name ielm-working-buffer))
-		(setq ielm-result "Working buffer has been killed"
-		      ielm-error-type "IELM Error"
-		      ielm-wbuf (current-buffer))
-	      (if (ielm-is-whitespace (substring ielm-string ielm-pos))
-		  ;; need this awful let convolution to work around
-		  ;; an Emacs bug involving local vbls and let binding
-		  (let ((:save :)
-			(::save ::)
-			(:::save :::))
-		    (save-excursion
-		      (set-buffer ielm-working-buffer)
-		      (condition-case err
-			  (let ((: :save)
-				(:: ::save)
-				(::: :::save)
-				(ielm-obuf (current-buffer)))
-			    (setq ielm-result (eval ielm-form))
-			    (setq ielm-wbuf (current-buffer))
-			    ;; The eval may have changed current-buffer;
-			    ;; need to set it back here to avoid a bug
-			    ;; in let.  Don't want to use save-excursion
-			    ;; because we want to allow changes in point.
-			    (set-buffer ielm-obuf))
-			(error (setq ielm-result (ielm-format-error err))
-			       (setq ielm-error-type "Eval error"))
-			(quit (setq ielm-result "Quit during evaluation")
-			      (setq ielm-error-type "Eval error")))))
-		(setq ielm-error-type "IELM error")
-		(setq ielm-result "More than one sexp in input"))))
-
-	  ;; If the eval changed the current buffer, mention it here
-	  (if (eq ielm-wbuf ielm-working-buffer) nil
-	    (message "current buffer is now: %s" ielm-wbuf)
-	    (setq ielm-working-buffer ielm-wbuf))
-
-	  (goto-char ielm-pmark)
-	  (if (not ielm-error-type)
-	      (condition-case err
-		  ;; Self-referential objects cause loops in the printer, so
-		  ;; trap quits here. May as well do errors, too
-		  (setq ielm-output (concat ielm-output (pp-to-string ielm-result)))
-		(error (setq ielm-error-type "IELM Error")
-		       (setq ielm-result  "Error during pretty-printing (bug in pp)"))
-		(quit  (setq ielm-error-type "IELM Error")
-		       (setq ielm-result "Quit during pretty-printing"))))
-	  (if ielm-error-type
-	      (progn
-		(if ielm-noisy (ding))
-		(setq ielm-output (concat ielm-output "*** " ielm-error-type " ***  "))
-		(setq ielm-output (concat ielm-output ielm-result)))
-	    ;; There was no error, so shift the ::: values
-	    (setq ::: ::)
-	    (setq :: :)
-	    (setq : ielm-result))
-	  (setq ielm-output (concat ielm-output "\n"))))
-    (setq ielm-output (concat ielm-output ielm-prompt))
-    (comint-output-filter (ielm-process) ielm-output)))
-
-;;; Process and marker utilities
-
-(defun ielm-process nil
-  ;; Return the current buffer's process.
-  (get-buffer-process (current-buffer)))
-
-(defun ielm-pm nil
-  ;; Return the process mark of the current buffer.
-  (process-mark (get-buffer-process (current-buffer))))
-
-(defun ielm-set-pm (pos)
-  ;; Set the process mark in the current buffer to POS.
-  (set-marker (process-mark (get-buffer-process (current-buffer))) pos))
-
-;;; Major mode
-
-(defun inferior-emacs-lisp-mode nil
-  "Major mode for interactively evaluating Emacs Lisp expressions.
-Uses the interface provided by `comint-mode' (which see).
-
-* \\<ielm-map>\\[ielm-send-input] evaluates the sexp following the prompt. There must be at most
-  one top-level sexp per prompt.
-
-* \\[ielm-return] inserts a newline and indents, or evaluates a
-  complete expression (but see variable `ielm-dynamic-return').
-  Inputs longer than one line are moved to the line following the
-  prompt (but see variable `ielm-dynamic-multiline-inputs').
-
-* \\[comint-dynamic-complete] completes Lisp symbols (or filenames, within strings), 
-  or indents the line if there is nothing to complete.
-
-During evaluations, the values of the variables `:', `::', and `:::'
-are the results of the previous, second previous and third previous
-evaluations respectively.
-
-The current working buffer may be changed (with a call to
-`set-buffer', or with \\[ielm-change-working-buffer]), and its value
-is preserved between successive evaluations.  In this way, expressions
-may be evaluated in a different buffer than the *ielm* buffer.
-Display the name of the working buffer with \\[ielm-print-working-buffer],
-or the buffer itself with \\[ielm-display-working-buffer].
-
-Expressions evaluated by IELM are not subject to `debug-on-quit' or
-`debug-on-error'.
-
-The behaviour of IELM may be customised with the following variables:
-* To stop beeping on error, set `ielm-noisy' to nil
-* If you don't like the prompt, you can change it by setting `ielm-prompt'.
-* Set `ielm-dynamic-return' to nil for bindings like `lisp-interaction-mode'
-* Entry to this mode runs `comint-mode-hook' and `ielm-mode-hook'
- (in that order).
-
-Customised bindings may be defined in `ielm-map', which currently contains:
-\\{ielm-map}"
-  (interactive)
-  (comint-mode)
-  (setq comint-prompt-regexp (concat "^" (regexp-quote ielm-prompt)))
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start comint-prompt-regexp)
-  (setq comint-input-sender 'ielm-input-sender)
-  (setq comint-process-echoes nil)
-  (setq comint-dynamic-complete-functions 
-	'(ielm-tab comint-replace-by-expanded-history ielm-complete-filename ielm-complete-symbol))
-  (setq comint-get-old-input 'ielm-get-old-input)
-
-  (setq major-mode 'inferior-emacs-lisp-mode)
-  (setq mode-name "IELM")
-  (use-local-map ielm-map)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-
-  (make-local-variable 'indent-line-function)
-  (make-local-variable 'ielm-working-buffer)
-  (setq ielm-working-buffer (current-buffer))
-  (setq indent-line-function 'ielm-indent-line)
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'lisp-fill-paragraph)
-
-  ;; Value holders
-  (setq : nil)
-  (make-local-variable ':)
-  (setq :: nil)
-  (make-local-variable '::)
-  (setq ::: nil)
-  (make-local-variable ':::)
-
-  ;; font-lock support
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults 
-	'(ielm-font-lock-keywords nil nil ((?: . "w") (?- . "w") (?* . "w"))))
-  
-  ;; A dummy process to keep comint happy. It will never get any input
-  (if (comint-check-proc (current-buffer)) nil
-    (start-process "ielm" (current-buffer) "cat")
-    (process-kill-without-query (ielm-process))
-    (goto-char (point-max))
-    ;; Add a silly header
-    (insert ielm-header)
-    (ielm-set-pm (point-max))
-    (comint-output-filter (ielm-process) ielm-prompt)
-    (set-marker comint-last-input-start (ielm-pm))
-    (set-process-filter (get-buffer-process (current-buffer)) 'comint-output-filter))
-  (run-hooks 'ielm-mode-hook))
-
-(defun ielm-get-old-input nil
-  ;; Return the previous input surrounding point
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at comint-prompt-regexp) nil
-      (re-search-backward comint-prompt-regexp))
-    (comint-skip-prompt)
-    (buffer-substring (point) (progn (forward-sexp 1) (point)))))
-
-;;; User command
-
-;;;###autoload (add-hook 'same-window-buffer-names "*ielm*")
-
-;;;###autoload
-(defun ielm nil
-  "Interactively evaluate Emacs Lisp expressions.
-Switches to the buffer `*ielm*', or creates it if it does not exist."
-  (interactive)
-  (if (comint-check-proc "*ielm*")
-      nil
-    (save-excursion
-      (set-buffer (get-buffer-create "*ielm*"))
-      (inferior-emacs-lisp-mode)))
-  (pop-to-buffer "*ielm*"))
-
-;;; ielm.el ends here
diff --git a/lisp/imenu.el b/lisp/imenu.el
deleted file mode 100644
index 1ddd70dcfd2..00000000000
--- a/lisp/imenu.el
+++ /dev/null
@@ -1,920 +0,0 @@
-;;; imenu.el --- Framework for mode-specific buffer indexes.
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Ake Stenhoff <etxaksf@aom.ericsson.se>
-;;         Lars Lindberg <lli@sypro.cap.se>
-;; Created: 8 Feb 1994
-;; Keywords: 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:
-
-;; Purpose of this package:
-;;   To present a framework for mode-specific buffer indexes.
-;;   A buffer index is an alist of names and buffer positions.
-;;   For instance all functions in a C-file and their positions.
-;;
-;; How it works:
-
-;;   A mode-specific function is called to generate the index.  It is
-;;   then presented to the user, who can choose from this index.
-;;
-;;   The package comes with a set of example functions for how to
-;;   utilize this package.
-
-;;   There are *examples* for index gathering functions/regular
-;;   expressions for C/C++ and Lisp/Emacs Lisp but it is easy to
-;;   customize for other modes.  A function for jumping to the chosen
-;;   index position is also supplied.
-
-;;; Thanks goes to
-;;  [simon] - Simon Leinen simon@lia.di.epfl.ch
-;;  [dean] - Dean Andrews ada@unison.com
-;;  [alon] - Alon Albert al@mercury.co.il 
-;;  [greg] - Greg Thompson gregt@porsche.visix.COM
-;;  [wolfgang] - Wolfgang Bangerth zcg51122@rpool1.rus.uni-stuttgart.de
-;;  [kai] - Kai Grossjohann grossjoh@linus.informatik.uni-dortmund.de
-;;  [david] - David M. Smith dsmith@stats.adelaide.edu.au
-;;  [christian] - Christian Egli Christian.Egli@hcsd.hac.com
-;;  [karl] - Karl Fogel kfogel@floss.life.uiuc.edu
-
-;;; Code
-
-(eval-when-compile (require 'cl))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Customizable variables
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar imenu-auto-rescan nil
-  "*Non-nil means Imenu should always rescan the buffers.")
-
-(defvar imenu-auto-rescan-maxout 60000 
-  "* auto-rescan is disabled in buffers larger than this.
-This variable is buffer-local.")
-
-(defvar imenu-always-use-completion-buffer-p nil
-  "*Set this to non-nil for displaying the index in a completion buffer.
-
-Non-nil means always display the index in a completion buffer.
-Nil means display the index as a mouse menu when the mouse was
-used to invoke `imenu'.
-`never' means never automatically display a listing of any kind.")
-
-(defvar imenu-sort-function nil
-  "*The function to use for sorting the index mouse-menu.
-
-Affects only the mouse index menu.
-
-Set this to nil if you don't want any sorting (faster).
-The items in the menu are then presented in the order they were found
-in the buffer.
-
-Set it to `imenu--sort-by-name' if you want alphabetic sorting.
-
-The function should take two arguments and return T if the first
-element should come before the second.  The arguments are cons cells;
-\(NAME . POSITION).  Look at `imenu--sort-by-name' for an example.")
-
-(defvar imenu-max-items 25
-  "*Maximum number of elements in an mouse menu for Imenu.")
-
-(defvar imenu-scanning-message "Scanning buffer for index...%2d%%"
-  "*Progress message during the index scanning of the buffer.
-If non-nil, user gets a message during the scanning of the buffer.
-
-Relevant only if the mode-specific function that creates the buffer
-index use `imenu-progress-message'.")
-
-(defvar imenu-space-replacement "^"
-  "*The replacement string for spaces in index names.
-Used when presenting the index in a completion-buffer to make the
-names work as tokens.")
-
-(defvar imenu-level-separator ":"
-  "*The separator between index names of different levels.
-Used for making mouse-menu titles and for flattening nested indexes
-with name concatenation.")
-
-;;;###autoload
-(defvar imenu-generic-expression nil
-  "The regex pattern to use for creating a buffer index.
-
-If non-nil this pattern is passed to `imenu--generic-function'
-to create a buffer index.
-
-The value should be an alist with elements that look like this:
- (MENU-TITLE REGEXP INDEX)
-or like this:
- (MENU-TITLE REGEXP INDEX FUNCTION ARGUMENTS...)
-with zero or more ARGUMENTS.  The former format creates a simple element in
-the index alist when it matches; the latter creates a special element
-of the form  (NAME FUNCTION NAME POSITION-MARKER ARGUMENTS...)
-with FUNCTION and ARGUMENTS beiong copied from `imenu-generic-expression'.
-
-MENU-TITLE is a string used as the title for the submenu or nil if the
-entries are not nested.
-
-REGEXP is a regexp that should match a construct in the buffer that is
-to be displayed in the menu; i.e., function or variable definitions,
-etc.  It contains a substring which is the name to appear in the
-menu.  See the info section on Regexps for more information.
-
-INDEX points to the substring in REGEXP that contains the name (of the
-function, variable or type) that is to appear in the menu.
-
-For emacs-lisp-mode for example PATTERN would look like:
-
-'((nil \"^\\\\s-*(def\\\\(un\\\\|subst\\\\|macro\\\\|advice\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2)
-  (\"*Vars*\" \"^\\\\s-*(def\\\\(var\\\\|const\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2)
-  (\"*Types*\" \"^\\\\s-*(def\\\\(type\\\\|struct\\\\|class\\\\|ine-condition\\\\)\\\\s-+\\\\([-A-Za-z0-9+]+\\\\)\" 2))
-
-The variable is buffer-local.")
-
-;;;###autoload
-(make-variable-buffer-local 'imenu-generic-expression)
-
-;;;; Hooks
-
-(defvar imenu-create-index-function 'imenu-default-create-index-function
-  "The function to use for creating a buffer index.
-
-It should be a function that takes no arguments and returns an index
-of the current buffer as an alist.
-
-Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION).
-Special elements look like (INDEX-NAME FUNCTION ARGUMENTS...).
-A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
-The function `imenu--subalist-p' tests an element and returns t
- if it is a sub-alist.
-
-This function is called within a `save-excursion'.
-
-The variable is buffer-local.")
-(make-variable-buffer-local 'imenu-create-index-function)
-
-(defvar imenu-prev-index-position-function 'beginning-of-defun
-  "Function for finding the next index position.
-
-If `imenu-create-index-function' is set to
-`imenu-default-create-index-function', then you must set this variable
-to a function that will find the next index, looking backwards in the
-file.
-
-The function should leave point at the place to be connected to the
-index and it should return nil when it doesn't find another index.")
-(make-variable-buffer-local 'imenu-prev-index-position-function)
-
-(defvar imenu-extract-index-name-function nil
-  "Function for extracting the index name.
-
-This function is called after the function pointed out by
-`imenu-prev-index-position-function'.")
-(make-variable-buffer-local 'imenu-extract-index-name-function)
-
-(defun imenu--subalist-p (item)
-  (and (consp (cdr item)) (listp (cadr item))
-       (not (eq (caadr item) 'lambda))))
-
-;;;
-;;; Macro to display a progress message.
-;;; RELPOS is the relative position to display.
-;;; If RELPOS is nil, then the relative position in the buffer
-;;; is calculated.
-;;; PREVPOS is the variable in which we store the last position displayed.
-(defmacro imenu-progress-message (prevpos &optional relpos reverse)
-  (` (and
-      imenu-scanning-message
-      (let ((pos (, (if relpos
-			relpos
-		      (` (imenu--relative-position (, reverse)))))))
-	(if (, (if relpos t
-		 (` (> pos (+ 5 (, prevpos))))))
-	    (progn
-	      (message imenu-scanning-message pos)
-	      (setq (, prevpos) pos)))))))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;
-;;;; Some examples of functions utilizing the framework of this
-;;;; package.
-;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Return the current/previous sexp and the location of the sexp (its
-;; beginning) without moving the point.
-(defun imenu-example--name-and-position ()
-  (save-excursion
-    (forward-sexp -1)
-    (let ((beg (point))
-	  (end (progn (forward-sexp) (point)))
-	  (marker (make-marker)))
-      (set-marker marker beg)
-      (cons (buffer-substring beg end)
-	    marker))))
-
-;;;
-;;; Lisp
-;;; 
-
-(defun imenu-example--lisp-extract-index-name ()
-  ;; Example of a candidate for `imenu-extract-index-name-function'.
-  ;; This will generate a flat index of definitions in a lisp file.
-  (save-match-data
-    (and (looking-at "(def")
-	 (condition-case nil
-	     (progn
-	       (down-list 1)
-	       (forward-sexp 2)
-	       (let ((beg (point))
-		     (end (progn (forward-sexp -1) (point))))
-		 (buffer-substring beg end)))
-	   (error nil)))))
-
-(defun imenu-example--create-lisp-index ()
-  ;; Example of a candidate for `imenu-create-index-function'.
-  ;; It will generate a nested index of definitions.
-  (let ((index-alist '())
-	(index-var-alist '())
-	(index-type-alist '())
-	(index-unknown-alist '())
-	prev-pos)
-    (goto-char (point-max))
-    (imenu-progress-message prev-pos 0)
-    ;; Search for the function
-    (while (beginning-of-defun)
-      (imenu-progress-message prev-pos nil t)
-      (save-match-data
-	(and (looking-at "(def")
-	     (save-excursion
-	       (down-list 1)
-	       (cond
-		((looking-at "def\\(var\\|const\\)")
-		 (forward-sexp 2)
-		 (push (imenu-example--name-and-position)
-		       index-var-alist))
-		((looking-at "def\\(un\\|subst\\|macro\\|advice\\)")
-		 (forward-sexp 2)
-		 (push (imenu-example--name-and-position)
-		       index-alist))
-		((looking-at "def\\(type\\|struct\\|class\\|ine-condition\\)")
- 		 (forward-sexp 2)
- 		 (if (= (char-after (1- (point))) ?\))
- 		     (progn
- 		       (forward-sexp -1)
- 		       (down-list 1)
- 		       (forward-sexp 1)))
- 		 (push (imenu-example--name-and-position)
- 		       index-type-alist))
-		(t
-		 (forward-sexp 2)
-		 (push (imenu-example--name-and-position)
-		       index-unknown-alist)))))))
-    (imenu-progress-message prev-pos 100)
-    (and index-var-alist
-	 (push (cons "Variables" index-var-alist)
-	       index-alist))
-    (and index-type-alist
- 	 (push (cons "Types" index-type-alist)
-  	       index-alist))
-    (and index-unknown-alist
-	 (push (cons "Syntax-unknown" index-unknown-alist)
-	       index-alist))
-    index-alist))
-
-;; Regular expression to find C functions
-(defvar imenu-example--function-name-regexp-c
-  (concat 
-   "^[a-zA-Z0-9]+[ \t]?"		; type specs; there can be no
-   "\\([a-zA-Z0-9_*]+[ \t]+\\)?"	; more than 3 tokens, right?
-   "\\([a-zA-Z0-9_*]+[ \t]+\\)?"
-   "\\([*&]+[ \t]*\\)?"			; pointer
-   "\\([a-zA-Z0-9_*]+\\)[ \t]*("	; name
-   ))
-
-(defun imenu-example--create-c-index (&optional regexp)
-  (let ((index-alist '())
-	prev-pos char)
-    (goto-char (point-min))
-    (imenu-progress-message prev-pos 0)
-    ;; Search for the function
-    (save-match-data
-      (while (re-search-forward
-	      (or regexp imenu-example--function-name-regexp-c)
-	      nil t)
-	(imenu-progress-message prev-pos)
-	(backward-up-list 1)
-	(save-excursion
-	  (goto-char (scan-sexps (point) 1))
-	  (setq char (following-char)))
-	;; Skip this function name if it is a prototype declaration.
-	(if (not (eq char ?\;))
-	    (push (imenu-example--name-and-position) index-alist))))
-    (imenu-progress-message prev-pos 100)
-    (nreverse index-alist)))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Internal variables
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; The item to use in the index for rescanning the buffer.
-(defconst imenu--rescan-item '("*Rescan*" . -99))
-
-;; The latest buffer index.
-;; Buffer local.
-(defvar imenu--index-alist nil)
-(make-variable-buffer-local 'imenu--index-alist)
-
-;; The latest buffer index used to update the menu bar menu.
-(defvar imenu--last-menubar-index-alist nil)
-(make-variable-buffer-local 'imenu--last-menubar-index-alist)
-
-;; History list for 'jump-to-function-in-buffer'.
-;; Making this buffer local caused it not to work!
-(defvar imenu--history-list nil)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; Internal support functions
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;
-;;; Sort function
-;;; Sorts the items depending on their index name.
-;;; An item look like (NAME . POSITION).
-;;;
-(defun imenu--sort-by-name (item1 item2)
-  (string-lessp (car item1) (car item2)))
-
-(defun imenu--relative-position (&optional reverse)
-  ;; Support function to calculate relative position in buffer
-  ;; Beginning of buffer is 0 and end of buffer is 100
-  ;; If REVERSE is non-nil then the beginning is 100 and the end is 0.
-  (let ((pos (point))
-	(total (buffer-size)))
-    (and reverse (setq pos (- total pos)))
-    (if (> total 50000)
-	;; Avoid overflow from multiplying by 100!
-	(/ (1- pos) (max (/ total 100) 1))
-      (/ (* 100 (1- pos)) (max total 1)))))
-
-;; Split LIST into sublists of max length N.
-;; Example (imenu--split '(1 2 3 4 5 6 7 8) 3)-> '((1 2 3) (4 5 6) (7 8))
-(defun imenu--split (list n)
-  (let ((remain list)
-	(result '())
-	(sublist '())
-	(i 0))
-    (while remain
-      (push (pop remain) sublist)
-      (incf i)
-      (and (= i n)
-	   ;; We have finished a sublist
-	   (progn (push (nreverse sublist) result)
-		  (setq i 0)
-		  (setq sublist '()))))
-    ;; There might be a sublist (if the length of LIST mod n is != 0)
-    ;; that has to be added to the result list.
-    (and sublist
-	 (push (nreverse sublist) result))
-    (nreverse result)))
-
-;;; Split the alist MENULIST into a nested alist, if it is long enough.
-;;; In any case, add TITLE to the front of the alist.
-(defun imenu--split-menu (menulist title)
-  (let (keep-at-top tail)
-    (if (memq imenu--rescan-item menulist)
-	(setq keep-at-top (cons imenu--rescan-item nil)
-	      menulist (delq imenu--rescan-item menulist)))
-    (setq tail menulist)
-    (while tail
-      (if (imenu--subalist-p (car tail))
-	  (setq keep-at-top (cons (car tail) keep-at-top)
-		menulist (delq (car tail) menulist)))
-      (setq tail (cdr tail)))
-    (if imenu-sort-function
-	(setq menulist
-	      (sort
-	       (let ((res nil)
-		     (oldlist menulist))
-		 ;; Copy list method from the cl package `copy-list'
-		 (while (consp oldlist) (push (pop oldlist) res))
-		 (prog1 (nreverse res) (setcdr res oldlist)))
-	       imenu-sort-function)))
-    (if (> (length menulist) imenu-max-items)
-	(let ((count 0))
-	  (setq menulist
-		(mapcar
-		 (function
-		  (lambda (menu)
-		    (cons (format "From: %s" (caar menu)) menu)))
-		 (imenu--split menulist imenu-max-items)))))
-    (cons title
-	  (nconc (nreverse keep-at-top) menulist))))
-
-;;; Split up each long alist that are nested within ALIST
-;;; into nested alists.
-(defun imenu--split-submenus (alist)
-  (mapcar (function (lambda (elt)
-		      (if (and (consp elt)
-			       (stringp (car elt))
-			       (listp (cdr elt)))
-			  (imenu--split-menu (cdr elt) (car elt))
-			elt)))
-	  alist))
-
-(defun imenu--make-index-alist (&optional noerror)
-  "Create an index-alist for the definitions in the current buffer.
-
-Simple elements in the alist look like (INDEX-NAME . INDEX-POSITION).
-Special elements look like (INDEX-NAME FUNCTION ARGUMENTS...).
-A nested sub-alist element looks like (INDEX-NAME SUB-ALIST).
-The function `imenu--subalist-p' tests an element and returns t
- if it is a sub-alist.
-
-There is one simple element with negative POSITION; that's intended
-as a way for the user to ask to recalculate the buffer's index alist."
-  (or (and imenu--index-alist
-	   (or (not imenu-auto-rescan)
-	       (and imenu-auto-rescan
-		    (> (buffer-size)  imenu-auto-rescan-maxout))))
-      ;; Get the index
-      (setq imenu--index-alist
-	    (save-excursion
-	      (save-restriction
-		(widen)
-		(funcall imenu-create-index-function)))))
-  (or imenu--index-alist noerror
-      (error "No items suitable for an index found in this buffer"))
-  (or imenu--index-alist
-      (setq imenu--index-alist (list nil)))
-  ;; Add a rescan option to the index.
-  (cons imenu--rescan-item imenu--index-alist))
-
-;;; Find all markers in alist and makes
-;;; them point nowhere.
-;;; The top-level call uses nil as the argument;
-;;; non-nil arguments are in recursivecalls.
-(defvar imenu--cleanup-seen)
-
-(defun imenu--cleanup (&optional alist)
-  ;; If alist is provided use that list. 
-  ;; If not, empty the table of lists already seen
-  ;; and use imenu--index-alist.
-  (if alist
-      (setq imenu--cleanup-seen (cons alist imenu--cleanup-seen))
-    (setq alist imenu--index-alist imenu--cleanup-seen (list alist)))
-
-  (and alist
-       (mapcar
-	(function
-	 (lambda (item)
-	   (cond
-	    ((markerp (cdr item))
-	     (set-marker (cdr item) nil))
-	    ;; Don't process one alist twice.
-	    ((memq (cdr item) imenu--cleanup-seen))
-	    ((imenu--subalist-p item)
-	     (imenu--cleanup (cdr item))))))
-	alist)
-       t))
-
-(defun imenu--create-keymap-2 (alist counter &optional commands)
-  (let ((map nil))
-    (mapcar
-     (function
-      (lambda (item)
-	(cond
-	 ((imenu--subalist-p item)
-	  (append (list (setq counter (1+ counter))
-			(car item) 'keymap (car item))
-		  (imenu--create-keymap-2 (cdr item) (+ counter 10) commands)))
-	 (t
-	  (let ((end (if commands `(lambda () (interactive)
-				     (imenu--menubar-select ',item))
-		       (cons '(nil) item))))
-	    (cons (car item)
-		  (cons (car item) end))))
-	 )))
-     alist)))
-
-;; If COMMANDS is non-nil, make a real keymap
-;; with a real command used as the definition.
-;; If it is nil, make something suitable for x-popup-menu.
-(defun imenu--create-keymap-1 (title alist &optional commands)
-  (append (list 'keymap title) (imenu--create-keymap-2 alist 0 commands)))
-
-
-(defun imenu--in-alist (str alist)
-  "Check whether the string STR is contained in multi-level ALIST."
-  (let (elt head tail res)
-    (setq res nil)
-    (while alist
-      (setq elt (car alist) 
-	    tail (cdr elt)
-	    alist (cdr alist) 
-	    head (car elt)) 
-      ;; A nested ALIST element looks like
-      ;;   (INDEX-NAME (INDEX-NAME . INDEX-POSITION) ...)
-      ;; while a bottom-level element looks like
-      ;;   (INDEX-NAME . INDEX-POSITION)
-      ;; We are only interested in the bottom-level elements, so we need to
-      ;; recurse if TAIL is a list.
-      (cond ((listp tail)
-	     (if (setq res (imenu--in-alist str tail))
-		 (setq alist nil)))
-	    ((string= str head)
-	     (setq alist nil res elt))))
-    res))
-
-(defun imenu-default-create-index-function ()
-  "*Wrapper for index searching functions.
-
-Moves point to end of buffer and then repeatedly calls
-`imenu-prev-index-position-function' and `imenu-extract-index-name-function'.
-Their results are gathered into an index alist."
-  ;; These should really be done by setting imenu-create-index-function
-  ;; in these major modes.  But save that change for later.
-  (cond ((and (fboundp imenu-prev-index-position-function)
-	      (fboundp imenu-extract-index-name-function))
-	 (let ((index-alist '())
-	       prev-pos name)
-	   (goto-char (point-max))
-	   (imenu-progress-message prev-pos 0 t)
-	   ;; Search for the function
-	   (while (funcall imenu-prev-index-position-function) 
-	     (imenu-progress-message prev-pos nil t)
-	     (save-excursion
-	       (setq name (funcall imenu-extract-index-name-function)))
-	     (and (stringp name)
-		  (push (cons name (point)) index-alist)))
-	   (imenu-progress-message prev-pos 100 t)
-	   index-alist))
-	;; Use generic expression if possible.
-	((and imenu-generic-expression)
-	 (imenu--generic-function imenu-generic-expression)) 
-	(t
-	 (error "The mode `%s' does not support Imenu" mode-name))))
-
-(defun imenu--replace-spaces (name replacement)
-  ;; Replace all spaces in NAME with REPLACEMENT.
-  ;; That second argument should be a string.
-  (mapconcat
-   (function
-    (lambda (ch)
-      (if (char-equal ch ?\ )
-	  replacement
-	(char-to-string ch))))
-   name
-   ""))
-
-(defun imenu--flatten-index-alist (index-alist &optional concat-names prefix)
-  ;; Takes a nested INDEX-ALIST and returns a flat index alist.
-  ;; If optional CONCAT-NAMES is non-nil, then a nested index has its
-  ;; name and a space concatenated to the names of the children.
-  ;; Third argument PREFIX is for internal use only.
-  (mapcan
-   (function
-    (lambda (item)
-      (let* ((name (car item))
-	     (pos (cdr item))
-	     (new-prefix (and concat-names
-			      (if prefix
-				  (concat prefix imenu-level-separator name)
-				name))))
-	(cond
-	 ((or (markerp pos) (numberp pos))
-	  (list (cons new-prefix pos)))
-	 (t
-	  (imenu--flatten-index-alist pos new-prefix))))))
-   index-alist))
-
-;;;
-;;; Generic index gathering function.
-;;;
-
-(defun imenu--generic-function (patterns)
-;; Built on some ideas that Erik Naggum <erik@naggum.no> once posted
-;; to comp.emacs
-  "Return an index of the current buffer as an alist.
-
-PATTERN is an alist with elements that look like this: (MENU-TITLE
-REGEXP INDEX).
-
-MENU-TITLE is a string used as the title for the submenu or nil if the
-entries are not nested.
-
-REGEXP is a regexp that should match a construct in the buffer that is
-to be displayed in the menu; i.e., function or variable definitions,
-etc.  It contains a substring which is the name to appear in the
-menu.  See the info section on Regexps for more information.
-
-INDEX points to the substring in REGEXP that contains the name (of the
-function, variable or type) that is to appear in the menu.
-
-For emacs-lisp-mode for example PATTERN would look like:
-
-'((nil \"^\\\\s-*(def\\\\(un\\\\|subst\\\\|macro\\\\|advice\\\\)\\\\s-+\\\\([-A-Za-z0-9]+\\\\)\" 2)
-  (\"*Vars*\" \"^\\\\s-*(def\\\\(var\\\\|const\\\\)\\\\s-+\\\\([-A-Za-z0-9]+\\\\)\" 2)
-  (\"*Types*\" \"^\\\\s-*(def\\\\(type\\\\|struct\\\\|class\\\\|ine-condition\\\\)\\\\s-+\\\\([-A-Za-z0-9]+\\\\)\" 2))'
-
-Returns an index of the current buffer as an alist.  The elements in
-the alist look like: (INDEX-NAME . INDEX-POSITION).  They may also be
-nested index lists like (INDEX-NAME . INDEX-ALIST) depending on
-pattern.
-
-\(imenu--generic-function PATTERN\)."
-
-  (let ((index-alist (list 'dummy))
-        (found nil)
-	(global-regexp 
-	 (concat "\\(" 
-		 (mapconcat
-		  (function (lambda (pattern) (identity (cadr pattern)))) 
-		  patterns "\\)\\|\\(") 
-		 "\\)"))
-	prev-pos)
-
-    (goto-char (point-max))
-    (imenu-progress-message prev-pos 0 t)
-    (save-match-data
-      (while (re-search-backward global-regexp nil t)
-	(imenu-progress-message prev-pos nil t)
-        (setq found nil)
-	(save-excursion
-	  (goto-char (match-beginning 0))
-	  (mapcar 
-	   (function 
-	    (lambda (pat) 
-	      (let ((menu-title (car pat))
-		    (regexp (cadr pat))
-		    (index (caddr pat))
-		    (function (cadddr pat))
-		    (rest (cddddr pat)))
-		(if (and (not found) ; Only allow one entry;
-			 (looking-at regexp))
-		    (let ((beg (make-marker))
-			  (end (match-end index)))
-		      (set-marker beg (match-beginning index))
-		      (setq found t)
-		      (push 
-		       (let ((name
-			      (buffer-substring-no-properties beg end)))
-			 (if function
-			     (nconc (list name function name beg)
-				    rest)
-			   (cons name beg)))
-		       (cdr 
-			(or (assoc menu-title index-alist)
-			    (car (push 
-				  (cons menu-title '()) 
-				  index-alist))))))))))
-	   patterns))))
-    (imenu-progress-message prev-pos 100 t)
-    (let ((main-element (assq nil index-alist)))
-      (nconc (delq main-element (delq 'dummy index-alist))
-	     (cdr main-element)))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; The main functions for this package!
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun imenu--completion-buffer (index-alist &optional prompt)
-  "Let the user select from INDEX-ALIST in a completion buffer with PROMPT.
-
-Returns t for rescan and otherwise a position number."
-  ;; Create a list for this buffer only when needed.
-  (let (name choice
-	     (prepared-index-alist
-	      (mapcar
-	       (function
-		(lambda (item)
-		  (cons (imenu--replace-spaces (car item) imenu-space-replacement)
-			(cdr item))))
-	       index-alist)))
-    (if (eq imenu-always-use-completion-buffer-p 'never)
-  	(setq name (completing-read (or prompt "Index item: ")
-  				    prepared-index-alist
- 				    nil t nil 'imenu--history-list))
-      (save-window-excursion
-	;; Display the completion buffer
-	(with-output-to-temp-buffer "*Completions*"
-	  (display-completion-list
-	   (all-completions "" prepared-index-alist )))
-	(let ((minibuffer-setup-hook
-	       (function (lambda ()
-			   (let ((buffer (current-buffer)))
-			     (save-excursion
-			       (set-buffer "*Completions*")
-			       (setq completion-reference-buffer buffer)))))))
-	  ;; Make a completion question
-	  (setq name (completing-read (or prompt "Index item: ")
-				      prepared-index-alist
-				      nil t nil 'imenu--history-list)))))
-    (cond ((not (stringp name))
-	   nil)
-	  ((string= name (car imenu--rescan-item))
-	   t)
-	  (t
-	   (setq choice (assoc name prepared-index-alist))
-	   (if (imenu--subalist-p choice)
-	       (imenu--completion-buffer (cdr choice) prompt)
-	     choice)))))
-
-(defun imenu--mouse-menu (index-alist event &optional title)
-  "Let the user select from a buffer index from a mouse menu.
-
-INDEX-ALIST is the buffer index and EVENT is a mouse event.
-
-Returns t for rescan and otherwise an element or subelement of INDEX-ALIST."
-  (setq index-alist (imenu--split-submenus index-alist))
-  (let* ((menu 	(imenu--split-menu index-alist
-		 (or title (buffer-name))))
-	 position)
-    (setq menu (imenu--create-keymap-1 (car menu) 
-				       (if (< 1 (length (cdr menu)))
-					   (cdr menu)
-					 (cdr (car (cdr menu))))))
-    (setq position (x-popup-menu event menu))
-    (cond ((eq position nil)
-	   position)
-	  ;; If one call to x-popup-menu handled the nested menus,
-	  ;; find the result by looking down the menus here.
-	  ((and (listp position)
-		(numberp (car position))
-		(stringp (nth (1- (length position)) position)))
-	   (let ((final menu))
-	     (while position
-	       (setq final (assoc (car position) final))
-	       (setq position (cdr position)))
-             (or (string= (car final) (car imenu--rescan-item))
-                 (cdr (cdr (cdr final))))))
-	  ;; If x-popup-menu went just one level and found a leaf item,
-	  ;; return the INDEX-ALIST element for that.
-	  ((and (consp position)
-		(stringp (car position))
-		(null (cdr position)))
-	   (or (string= (car position) (car imenu--rescan-item))
-	       (assq (car position) index-alist)))
-	  ;; If x-popup-menu went just one level
-	  ;; and found a non-leaf item (a submenu),
-	  ;; recurse to handle the rest.
-	  ((listp position)
-	   (imenu--mouse-menu position event
-			      (if title
-				  (concat title imenu-level-separator
-					  (car (rassq position index-alist)))
-				(car (rassq position index-alist))))))))
-
-(defun imenu-choose-buffer-index (&optional prompt alist)
-  "Let the user select from a buffer index and return the chosen index.
-
-If the user originally activated this function with the mouse, a mouse
-menu is used.  Otherwise a completion buffer is used and the user is
-prompted with PROMPT.
-
-If you call this function with index alist ALIST, then it lets the user
-select from ALIST.
-
-With no index alist ALIST, it calls `imenu--make-index-alist' to
-create the index alist.
-
-If `imenu-always-use-completion-buffer-p' is non-nil, then the
-completion buffer is always used, no matter if the mouse was used or
-not.
-
-The returned value is of the form (INDEX-NAME . INDEX-POSITION)."
-  (let (index-alist
-	(mouse-triggered (listp last-nonmenu-event))
-	(result t) )
-    ;; If selected by mouse, see to that the window where the mouse is
-    ;; really is selected.
-    (and mouse-triggered
-	 (not (equal last-nonmenu-event '(menu-bar)))
-	 (let ((window (posn-window (event-start last-nonmenu-event))))
-	   (or (framep window) (null window) (select-window window))))
-    ;; Create a list for this buffer only when needed.
-    (while (eq result t)
-      (setq index-alist (if alist alist (imenu--make-index-alist)))
-      (setq result
-	    (if (and mouse-triggered
-		     (not imenu-always-use-completion-buffer-p))
-		(imenu--mouse-menu index-alist last-nonmenu-event)
-	      (imenu--completion-buffer index-alist prompt)))
-      (and (eq result t)
-	   (imenu--cleanup)
-	   (setq imenu--index-alist nil)))
-    result))
-
-;;;###autoload
-(defun imenu-add-to-menubar (name)
-  "Adds an `imenu' entry to the menu bar for the current buffer.
-NAME is a string used to name the menu bar item.
-See the command `imenu' for more information."
-  (interactive "sImenu menu item name: ")
-  (let ((newmap (make-sparse-keymap))
-	(menu-bar (lookup-key (current-local-map) [menu-bar])))
-    (define-key newmap [menu-bar]
-      (append (make-sparse-keymap) menu-bar))
-    (define-key newmap [menu-bar index]
-      (cons name (nconc (make-sparse-keymap "Imenu")
-			(make-sparse-keymap))))
-    (use-local-map (append newmap (current-local-map))))
-  (add-hook 'menu-bar-update-hook 'imenu-update-menubar))
-
-(defvar imenu-buffer-menubar nil)
-
-(defun imenu-update-menubar ()
-  (and (current-local-map)
-       (keymapp (lookup-key (current-local-map) [menu-bar index]))
-       (let ((index-alist (imenu--make-index-alist t)))
-	 ;; Don't bother updating if the index-alist has not changed
-	 ;; since the last time we did it.
-	 (or (equal index-alist imenu--last-menubar-index-alist)
-	     (let (menu menu1 old)
-	       (setq imenu--last-menubar-index-alist index-alist)
-	       (setq index-alist (imenu--split-submenus index-alist))
-	       (setq menu (imenu--split-menu index-alist
-			   (buffer-name)))
-	       (setq menu1 (imenu--create-keymap-1 (car menu) 
-						   (if (< 1 (length (cdr menu)))
-						       (cdr menu)
-						     (cdr (car (cdr menu))))
-						   t))
-	       (setq old (lookup-key (current-local-map) [menu-bar index]))
-	       (setcdr old (cdr menu1)))))))
-
-(defun imenu--menubar-select (item)
-  "Use Imenu to select the function or variable named in this menu item."
-  (if (equal item '("*Rescan*" . -99))
-      (progn
-	(imenu--cleanup)
-	(setq imenu--index-alist nil)
-	(imenu-update-menubar))
-    (imenu item)))
-
-;;;###autoload
-(defun imenu (index-item)
-  "Jump to a place in the buffer chosen using a buffer menu or mouse menu.
-See `imenu-choose-buffer-index' for more information."
-  (interactive (list (imenu-choose-buffer-index)))
-  ;; Convert a string to an alist element.
-  (if (stringp index-item)
-      (setq index-item (assoc index-item (imenu--make-index-alist))))
-  (and index-item
-       (progn
-	 (push-mark)
-	 (cond
-	  ((markerp (cdr index-item))
-	   (if (or (< (marker-position (cdr index-item)) (point-min))
-		   (> (marker-position (cdr index-item)) (point-max)))
-	       ;; widen if outside narrowing
-	       (widen))
-	   (goto-char (marker-position (cdr index-item))))
-	  ((imenu--subalist-p index-item)
-	   (if (or (< (cdr index-item) (point-min))
-		   (> (cdr index-item) (point-max)))
-	       ;; widen if outside narrowing
-	       (widen))
-	   (goto-char (cdr index-item)))
-	  ((integerp (cdr index-item))
-	   (if (or (< (cdr index-item) (point-min))
-		   (> (cdr index-item) (point-max)))
-	       ;; widen if outside narrowing
-	       (widen))
-	   (goto-char (cdr index-item)))
-	  (t
-	   ;; A special item with a function.
-	   (let ((function (cadr index-item))
-		 (rest (cddr index-item)))
-	     (apply function (car index-item) rest)))))))
-
-(provide 'imenu)
-
-;;; imenu.el ends here
diff --git a/lisp/indent.el b/lisp/indent.el
deleted file mode 100644
index c1e2fc2e132..00000000000
--- a/lisp/indent.el
+++ /dev/null
@@ -1,467 +0,0 @@
-;;; indent.el --- indentation commands for Emacs
-
-;; Copyright (C) 1985, 1995 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:
-
-;; Commands for making and changing indentation in text.  These are
-;; described in the Emacs manual.
-
-;;; Code:
-
-(defvar standard-indent 4 "\
-Default number of columns for margin-changing functions to indent.")
-
-(defvar indent-line-function 'indent-to-left-margin "\
-Function to indent current line.")
-
-(defun indent-according-to-mode ()
-  "Indent line in proper way for current major mode."
-  (interactive)
-  (funcall indent-line-function))
-
-(defun indent-for-tab-command (&optional prefix-arg)
-  "Indent line in proper way for current major mode."
-  (interactive "P")
-  (if (eq indent-line-function 'indent-to-left-margin)
-      (insert-tab prefix-arg)
-    (if prefix-arg
-	(funcall indent-line-function prefix-arg)
-      (funcall indent-line-function))))
-
-(defun insert-tab (&optional prefix-arg)
-  (let ((count (prefix-numeric-value prefix-arg)))
-    (if abbrev-mode
-	(expand-abbrev))
-    (if indent-tabs-mode
-	(insert-char ?\t count)
-      (indent-to (* tab-width (+ count (/ (current-column) tab-width)))))))
-
-(defun indent-rigidly (start end arg)
-  "Indent all lines starting in the region sideways by ARG columns.
-Called from a program, takes three arguments, START, END and ARG."
-  (interactive "r\np")
-  (save-excursion
-    (goto-char end)
-    (setq end (point-marker))
-    (goto-char start)
-    (or (bolp) (forward-line 1))
-    (while (< (point) end)
-      (let ((indent (current-indentation))
-	    eol-flag)
-	(save-excursion
-	  (skip-chars-forward " \t")
-	  (setq eol-flag (eolp)))
-	(or eol-flag
-	    (indent-to (max 0 (+ indent arg)) 0))
-	(delete-region (point) (progn (skip-chars-forward " \t") (point))))
-      (forward-line 1))
-    (move-marker end nil)))
-
-(defun indent-line-to (column)
-  "Indent current line to COLUMN.
-This function removes or adds spaces and tabs at beginning of line
-only if necessary.  It leaves point at end of indentation."
-  (back-to-indentation)
-  (let ((cur-col (current-column)))
-    (cond ((< cur-col column)
-	   (if (> (- column (* (/ cur-col tab-width) tab-width)) tab-width)
-	       (delete-region (point)
-			      (progn (skip-chars-backward " ") (point))))
-	   (indent-to column))
-	  ((> cur-col column) ; too far right (after tab?)
-	   (delete-region (progn (move-to-column column t) (point))
-			  (progn (back-to-indentation) (point)))))))
-
-(defun current-left-margin ()
-  "Return the left margin to use for this line.
-This is the value of the buffer-local variable `left-margin' plus the value
-of the `left-margin' text-property at the start of the line."
-  (save-excursion
-    (back-to-indentation)
-    (max 0
-	 (+ left-margin (or (get-text-property
-			     (if (and (eobp) (not (bobp)))
-				 (1- (point)) (point))
-			     'left-margin) 0)))))
-
-(defun move-to-left-margin (&optional n force)
-  "Move to the left margin of the current line.
-With optional argument, move forward N-1 lines first.
-The column moved to is the one given by the `current-left-margin' function.
-If the line's indentation appears to be wrong, and this command is called
-interactively or with optional argument FORCE, it will be fixed."
-  (interactive (list (prefix-numeric-value current-prefix-arg) t))
-  (beginning-of-line n)
-  (skip-chars-forward " \t")
-  (let ((lm (current-left-margin))
-	(cc (current-column)))
-    (cond ((> cc lm)
-	   (if (> (move-to-column lm force) lm)
-	       ;; If lm is in a tab and we are not forcing, move before tab
-	       (backward-char 1)))
-	  ((and force (< cc lm))
-	   (indent-to-left-margin)))))
-
-;; This is the default indent-line-function,
-;; used in Fundamental Mode, Text Mode, etc.
-(defun indent-to-left-margin ()
-  "Indent current line to the column given by `current-left-margin'."
-  (indent-line-to (current-left-margin)))
-
-(defun delete-to-left-margin (&optional from to)
-  "Remove left margin indentation from a region.
-This deletes to the column given by `current-left-margin'.
-In no case will it delete non-whitespace.
-Args FROM and TO are optional; default is the whole buffer."
-  (save-excursion
-    (goto-char (or to (point-max)))
-    (setq to (point-marker))
-    (goto-char (or from (point-min)))
-    (or (bolp) (forward-line 1))
-    (while (< (point) to)
-      (delete-region (point) (progn (move-to-left-margin nil t) (point)))
-      (forward-line 1))
-    (move-marker to nil)))
-
-(defun set-left-margin (from to lm)
-  "Set the left margin of the region to WIDTH.
-If `auto-fill-mode' is active, re-fill the region to fit the new margin."
-  (interactive "r\nNSet left margin to column: ")
-  (if (interactive-p) (setq lm (prefix-numeric-value lm)))
-  (save-excursion
-    ;; If inside indentation, start from BOL.
-    (goto-char from)
-    (skip-chars-backward " \t")
-    (if (bolp) (setq from (point)))
-    ;; Place end after whitespace
-    (goto-char to)
-    (skip-chars-forward " \t")
-    (setq to (point-marker)))
-  ;; Delete margin indentation first, but keep paragraph indentation.
-  (delete-to-left-margin from to)
-  (put-text-property from to 'left-margin lm)
-  (indent-rigidly from to lm)
-  (if auto-fill-function (save-excursion (fill-region from to nil t t)))
-  (move-marker to nil))
-
-(defun set-right-margin (from to lm)
-  "Set the right margin of the region to WIDTH.
-If `auto-fill-mode' is active, re-fill the region to fit the new margin."
-  (interactive "r\nNSet right margin to width: ")
-  (if (interactive-p) (setq lm (prefix-numeric-value lm)))
-  (save-excursion
-    (goto-char from)
-    (skip-chars-backward " \t")
-    (if (bolp) (setq from (point))))
-  (put-text-property from to 'right-margin lm)
-  (if auto-fill-function (save-excursion (fill-region from to nil t t))))
-
-(defun alter-text-property (from to prop func &optional object)
-  "Programmatically change value of a text-property.
-For each region between FROM and TO that has a single value for PROPERTY,
-apply FUNCTION to that value and sets the property to the function's result.
-Optional fifth argument OBJECT specifies the string or buffer to operate on."
-  (let ((begin from)
-	end val)
-    (while (setq val (get-text-property begin prop object)
-		 end (text-property-not-all begin to prop val object))
-      (put-text-property begin end prop (funcall func val) object)
-      (setq begin end))
-    (if (< begin to)
-	(put-text-property begin to prop (funcall func val) object))))
-
-(defun increase-left-margin (from to inc)
-  "Increase or decrease the left-margin of the region.
-With no prefix argument, this adds `standard-indent' of indentation.
-A prefix arg (optional third arg INC noninteractively) specifies the amount
-to change the margin by, in characters.
-If `auto-fill-mode' is active, re-fill the region to fit the new margin."
-  (interactive "*r\nP")
-  (setq inc (if inc (prefix-numeric-value inc) standard-indent))
-  (save-excursion
-    (goto-char from)
-    (skip-chars-backward " \t")
-    (if (bolp) (setq from (point)))
-    (goto-char to)
-    (setq to (point-marker)))
-  (alter-text-property from to 'left-margin
-		       (lambda (v) (max (- left-margin) (+ inc (or v 0)))))
-  (indent-rigidly from to inc)
-  (if auto-fill-function (save-excursion (fill-region from to nil t t)))
-  (move-marker to nil))
-
-(defun decrease-left-margin (from to inc)
-  "Make the left margin of the region smaller.
-With no prefix argument, decrease the indentation by `standard-indent'.
-A prefix arg (optional third arg INC noninteractively) specifies the amount
-to change the margin by, in characters.
-If `auto-fill-mode' is active, re-fill the region to fit the new margin."
-  (interactive "*r\nP")
-  (setq inc (if inc (prefix-numeric-value inc) standard-indent))
-  (increase-left-margin from to (- inc)))
-
-(defun increase-right-margin (from to inc)
-  "Increase the right-margin of the region.
-With no prefix argument, increase the right margin by `standard-indent'.
-A prefix arg (optional third arg INC noninteractively) specifies the amount
-to change the margin by, in characters.  A negative argument decreases
-the right margin width.
-If `auto-fill-mode' is active, re-fill the region to fit the new margin."
-  (interactive "r\nP")
-  (if (interactive-p)
-      (setq inc (if inc (prefix-numeric-value current-prefix-arg)
-		  standard-indent)))
-  (save-excursion
-    (alter-text-property from to 'right-margin
-       (lambda (v) (+ inc (or v 0))))
-    (if auto-fill-function
-	(fill-region from to nil t t))))
-
-(defun decrease-right-margin (from to inc)
-  "Make the right margin of the region smaller.
-With no prefix argument, decrease the right margin by `standard-indent'.
-A prefix arg (optional third arg INC noninteractively) specifies the amount
-of width to remove, in characters.  A negative argument increases
-the right margin width.
-If `auto-fill-mode' is active, re-fills region to fit in new margin."
-  (interactive "*r\nP")
-  (setq inc (if inc (prefix-numeric-value inc) standard-indent))
-  (increase-right-margin from to (- inc)))
-
-(defun beginning-of-line-text (&optional n)
-  "Move to the beginning of the text on this line.
-With optional argument, move forward N-1 lines first.
-From the beginning of the line, moves past the left-margin indentation, the
-fill-prefix, and any indentation used for centering or right-justifying the
-line, but does not move past any whitespace that was explicitly inserted 
-\(such as a tab used to indent the first line of a paragraph)."
-  (interactive "p")
-  (beginning-of-line n)
-  (skip-chars-forward " \t")
-  ;; Skip over fill-prefix.
-  (if (and fill-prefix 
-	   (not (string-equal fill-prefix "")))
-      (if (equal fill-prefix
-		 (buffer-substring 
-		  (point) (min (point-max) (+ (length fill-prefix) (point)))))
-	  (forward-char (length fill-prefix)))
-    (if (and adaptive-fill-mode adaptive-fill-regexp
-	     (looking-at adaptive-fill-regexp))
-	(goto-char (match-end 0))))
-  ;; Skip centering or flushright indentation
-  (if (memq (current-justification) '(center right))
-      (skip-chars-forward " \t")))
-
-(defvar indent-region-function nil
-  "Short cut function to indent region using `indent-according-to-mode'.
-A value of nil means really run `indent-according-to-mode' on each line.")
-
-(defun indent-region (start end column)
-  "Indent each nonblank line in the region.
-With no argument, indent each line using `indent-according-to-mode',
-or use `indent-region-function' to do the whole region if that's non-nil.
-If there is a fill prefix, make each line start with the fill prefix.
-With argument COLUMN, indent each line to that column.
-Called from a program, takes three args: START, END and COLUMN."
-  (interactive "r\nP")
-  (if (null column)
-      (if fill-prefix
-	  (save-excursion
-	    (goto-char end)
-	    (setq end (point-marker))
-	    (goto-char start)
-	    (let ((regexp (regexp-quote fill-prefix)))
-	      (while (< (point) end)
-		(or (looking-at regexp)
-		    (and (bolp) (eolp))
-		    (insert fill-prefix))
-		(forward-line 1))))
-	(if indent-region-function
-	    (funcall indent-region-function start end)
-	  (save-excursion
-	    (goto-char end)
-	    (setq end (point-marker))
-	    (goto-char start)
-	    (or (bolp) (forward-line 1))
-	    (while (< (point) end)
-	      (or (and (bolp) (eolp))
-		  (funcall indent-line-function))
-	      (forward-line 1))
-	    (move-marker end nil))))
-    (setq column (prefix-numeric-value column))
-    (save-excursion
-      (goto-char end)
-      (setq end (point-marker))
-      (goto-char start)
-      (or (bolp) (forward-line 1))
-      (while (< (point) end)
-	(delete-region (point) (progn (skip-chars-forward " \t") (point)))
-	(or (eolp)
-	    (indent-to column 0))
-	(forward-line 1))
-      (move-marker end nil))))
-
-(defun indent-relative-maybe ()
-  "Indent a new line like previous nonblank line."
-  (interactive)
-  (indent-relative t))
-
-(defun indent-relative (&optional unindented-ok)
-  "Space out to under next indent point in previous nonblank line.
-An indent point is a non-whitespace character following whitespace.
-If the previous nonblank line has no indent points beyond the
-column point starts at, `tab-to-tab-stop' is done instead."
-  (interactive "P")
-  (if abbrev-mode (expand-abbrev))
-  (let ((start-column (current-column))
-	indent)
-    (save-excursion
-      (beginning-of-line)
-      (if (re-search-backward "^[^\n]" nil t)
-	  (let ((end (save-excursion (forward-line 1) (point))))
-	    (move-to-column start-column)
-	    ;; Is start-column inside a tab on this line?
-	    (if (> (current-column) start-column)
-		(backward-char 1))
-	    (or (looking-at "[ \t]")
-		unindented-ok
-		(skip-chars-forward "^ \t" end))
-	    (skip-chars-forward " \t" end)
-	    (or (= (point) end) (setq indent (current-column))))))
-    (if indent
-	(let ((opoint (point-marker)))
-	  (delete-region (point) (progn (skip-chars-backward " \t") (point)))
-	  (indent-to indent 0)
-	  (if (> opoint (point))
-	      (goto-char opoint))
-	  (move-marker opoint nil))
-      (tab-to-tab-stop))))
-
-(defvar tab-stop-list
-  '(8 16 24 32 40 48 56 64 72 80 88 96 104 112 120)
-  "*List of tab stop positions used by `tab-to-tab-stops'.
-This should be a list of integers, ordered from smallest to largest.")
-
-(defvar edit-tab-stops-map nil "Keymap used in `edit-tab-stops'.")
-(if edit-tab-stops-map
-    nil
-  (setq edit-tab-stops-map (make-sparse-keymap))
-  (define-key edit-tab-stops-map "\C-x\C-s" 'edit-tab-stops-note-changes)
-  (define-key edit-tab-stops-map "\C-c\C-c" 'edit-tab-stops-note-changes))
-
-(defvar edit-tab-stops-buffer nil
-  "Buffer whose tab stops are being edited--in case
-the variable `tab-stop-list' is local in that buffer.")
-
-(defun edit-tab-stops ()
-  "Edit the tab stops used by `tab-to-tab-stop'.
-Creates a buffer *Tab Stops* containing text describing the tab stops.
-A colon indicates a column where there is a tab stop.
-You can add or remove colons and then do \\<edit-tab-stops-map>\\[edit-tab-stops-note-changes] to make changes take effect."
-  (interactive)
-  (setq edit-tab-stops-buffer (current-buffer))
-  (switch-to-buffer (get-buffer-create "*Tab Stops*"))
-  (use-local-map edit-tab-stops-map)
-  (make-local-variable 'indent-tabs-mode)
-  (setq indent-tabs-mode nil)
-  (overwrite-mode 1)
-  (setq truncate-lines t)
-  (erase-buffer)
-  (let ((tabs tab-stop-list))
-    (while tabs
-      (indent-to (car tabs) 0)
-      (insert ?:)
-      (setq tabs (cdr tabs))))
-  (let ((count 0))
-    (insert ?\n)
-    (while (< count 8)
-      (insert (+ count ?0))
-    (insert "         ")
-      (setq count (1+ count)))
-    (insert ?\n)
-    (while (> count 0)
-      (insert "0123456789")
-      (setq count (1- count))))
-  (insert "\nTo install changes, type C-c C-c")
-  (goto-char (point-min)))
-
-(defun edit-tab-stops-note-changes ()
-  "Put edited tab stops into effect."
-  (interactive)
-    (let (tabs)
-      (save-excursion
-	(goto-char 1)
-	(end-of-line)
-	(while (search-backward ":" nil t)
-	  (setq tabs (cons (current-column) tabs))))
-      (bury-buffer (prog1 (current-buffer)
-			  (switch-to-buffer edit-tab-stops-buffer)))
-      (setq tab-stop-list tabs))
-  (message "Tab stops installed"))
-
-(defun tab-to-tab-stop ()
-  "Insert spaces or tabs to next defined tab-stop column.
-The variable `tab-stop-list' is a list of columns at which there are tab stops.
-Use \\[edit-tab-stops] to edit them interactively."
-  (interactive)
-  (and abbrev-mode (= (char-syntax (preceding-char)) ?w)
-       (expand-abbrev))
-  (let ((tabs tab-stop-list))
-    (while (and tabs (>= (current-column) (car tabs)))
-      (setq tabs (cdr tabs)))
-    (if tabs
-	(let ((opoint (point)))
-	  (skip-chars-backward " \t")
-	  (delete-region (point) opoint)
-	  (indent-to (car tabs)))
-      (insert ?\ ))))
-
-(defun move-to-tab-stop ()
-  "Move point to next defined tab-stop column.
-The variable `tab-stop-list' is a list of columns at which there are tab stops.
-Use \\[edit-tab-stops] to edit them interactively."
-  (interactive)
-  (let ((tabs tab-stop-list))
-    (while (and tabs (>= (current-column) (car tabs)))
-      (setq tabs (cdr tabs)))
-    (if tabs
-	(let ((before (point)))
-	  (move-to-column (car tabs) t)
-	  (save-excursion
-	    (goto-char before)
-	    ;; If we just added a tab, or moved over one,
-	    ;; delete any superfluous spaces before the old point.
-	    (if (and (eq (preceding-char) ?\ )
-		     (eq (following-char) ?\t))
-		(let ((tabend (* (/ (current-column) tab-width) tab-width)))
-		  (while (and (> (current-column) tabend)
-			      (eq (preceding-char) ?\ ))
-		    (forward-char -1))
-		  (delete-region (point) before))))))))
-
-(define-key global-map "\t" 'indent-for-tab-command)
-(define-key esc-map "\034" 'indent-region)
-(define-key ctl-x-map "\t" 'indent-rigidly)
-(define-key esc-map "i" 'tab-to-tab-stop)
-
-;;; indent.el ends here
diff --git a/lisp/info.el b/lisp/info.el
deleted file mode 100644
index 63076dfa93b..00000000000
--- a/lisp/info.el
+++ /dev/null
@@ -1,1968 +0,0 @@
-;;; info.el --- info package for Emacs.
-
-;; Copyright (C) 1985, 1986, 1992, 1993, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: help
-
-;; 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:
-
-;; Note that nowadays we expect info files to be made using makeinfo.
-
-;;; Code:
-
-(defvar Info-history nil
-  "List of info nodes user has visited.
-Each element of list is a list (FILENAME NODENAME BUFFERPOS).")
-
-(defvar Info-enable-edit nil
-  "*Non-nil means the \\<Info-mode-map>\\[Info-edit] command in Info can edit the current node.
-This is convenient if you want to write info files by hand.
-However, we recommend that you not do this.
-It is better to write a Texinfo file and generate the Info file from that,
-because that gives you a printed manual as well.")
-
-(defvar Info-enable-active-nodes nil
-  "Non-nil allows Info to execute Lisp code associated with nodes.
-The Lisp code is executed when the node is selected.")
-(put 'Info-enable-active-nodes 'risky-local-variable t)
-
-(defvar Info-fontify t
-  "*Non-nil enables highlighting and fonts in Info nodes.")
-
-(defvar Info-fontify-maximum-menu-size 30000
-  "*Maximum size of menu to fontify if `Info-fontify' is non-nil.")
-
-(defvar Info-directory-list
-  (let ((path (getenv "INFOPATH"))
-	;; This is for older Emacs versions
-	;; which might get this info.el from the Texinfo distribution.
-	(path-separator (if (boundp 'path-separator) path-separator
-			  (if (eq system-type 'ms-dos) ";" ":")))
-	(source (expand-file-name "info/" source-directory))
-	(sibling (if installation-directory
-		     (expand-file-name "info/" installation-directory)))
-	alternative)
-    (if path
-	(let ((list nil)
-	      idx)
-	  (while (> (length path) 0)
-	    (setq idx (or (string-match path-separator path) (length path))
-		  list (cons (substring path 0 idx) list)
-		  path (substring path (min (1+ idx)
-					    (length path)))))
-	  (nreverse list))
-      (if (and sibling (file-exists-p sibling))
-	  (setq alternative sibling)
-	(setq alternative source))
-      (if (or (member alternative Info-default-directory-list)
-	      (not (file-exists-p alternative))
-	      ;; On DOS/NT, we use movable executables always,
-	      ;; and we must always find the Info dir at run time.
-	      (if (or (eq system-type 'ms-dos) (eq system-type 'windows-nt))
-		  nil
-		;; Use invocation-directory for Info only if we used it for
-		;; exec-directory also.
-		(not (string= exec-directory
-			      (expand-file-name "lib-src/"
-						installation-directory)))))
-	  Info-default-directory-list
-	(reverse (cons alternative
-		       (cdr (reverse Info-default-directory-list)))))))
-  "List of directories to search for Info documentation files.
-nil means not yet initialized.  In this case, Info uses the environment
-variable INFOPATH to initialize it, or `Info-default-directory-list'
-if there is no INFOPATH variable in the environment.
-The last element of `Info-default-directory-list' is the directory
-where Emacs installs the Info files that come with it.
-
-If you run the Emacs executable from the `src' directory in the Emacs
-source tree, the `info' directory in the source tree is used as the last
-element, in place of the installation Info directory.  This is useful
-when you run a version of Emacs without installing it.")
-
-(defvar Info-additional-directory-list nil
-  "List of additional directories to search for Info documentation files.
-These directories are not searched for merging the `dir' file.")
-
-(defvar Info-current-file nil
-  "Info file that Info is now looking at, or nil.
-This is the name that was specified in Info, not the actual file name.
-It doesn't contain directory names or file name extensions added by Info.")
-
-(defvar Info-current-subfile nil
-  "Info subfile that is actually in the *info* buffer now,
-or nil if current info file is not split into subfiles.")
-
-(defvar Info-current-node nil
-  "Name of node that Info is now looking at, or nil.")
-
-(defvar Info-tag-table-marker (make-marker)
-  "Marker pointing at beginning of current Info file's tag table.
-Marker points nowhere if file has no tag table.")
-
-(defvar Info-current-file-completions nil
-  "Cached completion list for current Info file.")
-
-(defvar Info-index-alternatives nil
-  "List of possible matches for last Info-index command.")
-
-(defvar Info-standalone nil
-  "Non-nil if Emacs was started solely as an Info browser.")
-
-(defvar Info-suffix-list
-  (if (eq system-type 'ms-dos)
-      '( (".gz"      . "gunzip")
-	 (".z"       . "gunzip")
-	 (".inf"     . nil)
-	 (""         . nil))
-    '( (".info.Z"  . "uncompress")
-       (".info.Y"  . "unyabba")
-       (".info.gz" . "gunzip")
-       (".info.z"  . "gunzip")
-       (".info"    . nil)
-       (".Z"       . "uncompress")
-       (".Y"       . "unyabba")
-       (".gz"      . "gunzip")
-       (".z"       . "gunzip")
-       (""         . nil)))
-  "List of file name suffixes and associated decoding commands.
-Each entry should be (SUFFIX . STRING); the file is given to
-the command as standard input.  If STRING is nil, no decoding is done.
-Because the SUFFIXes are tried in order, the empty string should
-be last in the list.")
-
-;; Concatenate SUFFIX onto FILENAME.  SUFFIX should start with a dot.
-;; First, on ms-dos, delete some of the extension in FILENAME
-;; to make room.
-(defun info-insert-file-contents-1 (filename suffix)
-  (if (not (eq system-type 'ms-dos))
-      (concat filename suffix)
-    (let* ((sans-exts (file-name-sans-extension filename))
-	   ;; How long is the extension in FILENAME (not counting the dot).
-	   (ext-len (max 0 (- (length filename) (length sans-exts) 1)))
-	   ext-left)
-      ;; SUFFIX starts with a dot.  If FILENAME already has one,
-      ;; get rid of the one in SUFFIX (unless suffix is empty).
-      (or (and (<= ext-len 0)
-	       (not (eq (aref filename (1- (length filename))) ?.)))
-	  (= (length suffix) 0)
-	  (setq suffix (substring suffix 1)))
-      ;; How many chars of that extension should we keep?
-      (setq ext-left (min ext-len (max 0 (- 3 (length suffix)))))
-      ;; Get rid of the rest of the extension, and add SUFFIX.
-      (concat (substring filename 0 (- (length filename)
-				       (- ext-len ext-left)))
-	      suffix))))
-
-(defun info-insert-file-contents (filename &optional visit)
-  "Insert the contents of an info file in the current buffer.
-Do the right thing if the file has been compressed or zipped."
-  (let ((tail Info-suffix-list)
-	fullname decoder)
-    (if (file-exists-p filename)
-	;; FILENAME exists--see if that name contains a suffix.
-	;; If so, set DECODE accordingly.
-	(progn
-	  (while (and tail
-		      (not (string-match
-			    (concat (regexp-quote (car (car tail))) "$")
-			    filename)))
-	    (setq tail (cdr tail)))
-	  (setq fullname filename
-		decoder (cdr (car tail))))
-      ;; Try adding suffixes to FILENAME and see if we can find something.
-      (while (and tail
-		  (not (file-exists-p (info-insert-file-contents-1
-				       filename (car (car tail))))))
-	(setq tail (cdr tail)))
-      ;; If we found a file with a suffix, set DECODER according to the suffix
-      ;; and set FULLNAME to the file's actual name.
-      (setq fullname (info-insert-file-contents-1 filename (car (car tail)))
-	    decoder (cdr (car tail)))
-      (or tail
-	  (error "Can't find %s or any compressed version of it" filename)))
-    ;; check for conflict with jka-compr
-    (if (and (featurep 'jka-compr)
-	     (jka-compr-installed-p)
-	     (jka-compr-get-compression-info fullname))
-	(setq decoder nil))
-    (insert-file-contents fullname visit)
-    (if decoder
-	(let ((buffer-read-only nil)
-	      (default-directory (or (file-name-directory fullname)
-				     default-directory)))
-	  (call-process-region (point-min) (point-max) decoder t t)))))
-
-;;;###autoload (add-hook 'same-window-buffer-names "*info*")
-
-;;;###autoload
-(defun info (&optional file)
-  "Enter Info, the documentation browser.
-Optional argument FILE specifies the file to examine;
-the default is the top-level directory of Info.
-
-In interactive use, a prefix argument directs this command
-to read a file name from the minibuffer.
-
-The search path for Info files is in the variable `Info-directory-list'.
-The top-level Info directory is made by combining all the files named `dir' 
-in all the directories in that path."
-  (interactive (if current-prefix-arg
-		   (list (read-file-name "Info file name: " nil nil t))))
-  (if file
-      (Info-goto-node (concat "(" file ")"))
-    (if (get-buffer "*info*")
-	(pop-to-buffer "*info*")
-      (Info-directory))))
-
-;;;###autoload
-(defun info-standalone ()
-  "Run Emacs as a standalone Info reader.
-Usage:  emacs -f info-standalone [filename]
-In standalone mode, \\<Info-mode-map>\\[Info-exit] exits Emacs itself."
-  (setq Info-standalone t)
-  (if (and command-line-args-left
-	   (not (string-match "^-" (car command-line-args-left))))
-      (condition-case err
-	  (progn
-	    (info (car command-line-args-left))
-	    (setq command-line-args-left (cdr command-line-args-left)))
-	(error (send-string-to-terminal
-		(format "%s\n" (if (eq (car-safe err) 'error)
-				   (nth 1 err) err)))
-	       (save-buffers-kill-emacs)))
-    (info)))
-
-;; Go to an info node specified as separate filename and nodename.
-;; no-going-back is non-nil if recovering from an error in this function;
-;; it says do not attempt further (recursive) error recovery.
-(defun Info-find-node (filename nodename &optional no-going-back)
-  ;; Convert filename to lower case if not found as specified.
-  ;; Expand it.
-  (if filename
-      (let (temp temp-downcase found)
-	(setq filename (substitute-in-file-name filename))
-	(if (string= (downcase filename) "dir")
-	    (setq found t)
-	  (let ((dirs (if (string-match "^\\./" filename)
-			  ;; If specified name starts with `./'
-			  ;; then just try current directory.
-			  '("./")
-			(if (file-name-absolute-p filename)
-			    ;; No point in searching for an
-			    ;; absolute file name
-			    '(nil)
-			  (if Info-additional-directory-list
-			      (append Info-directory-list
-				      Info-additional-directory-list)
-			    Info-directory-list)))))
-	    ;; Search the directory list for file FILENAME.
-	    (while (and dirs (not found))
-	      (setq temp (expand-file-name filename (car dirs)))
-	      (setq temp-downcase
-		    (expand-file-name (downcase filename) (car dirs)))
-	      ;; Try several variants of specified name.
-	      (let ((suffix-list Info-suffix-list))
-		(while (and suffix-list (not found))
-		  (cond ((file-exists-p
-			  (info-insert-file-contents-1
-			   temp (car (car suffix-list))))
-			 (setq found temp))
-			((file-exists-p
-			  (info-insert-file-contents-1
-			   temp-downcase (car (car suffix-list))))
-			 (setq found temp-downcase)))
-		  (setq suffix-list (cdr suffix-list))))
-	      (setq dirs (cdr dirs)))))
-	(if found
-	    (setq filename found)
-	  (error "Info file %s does not exist" filename))))
-  ;; Record the node we are leaving.
-  (if (and Info-current-file (not no-going-back))
-      (setq Info-history
-	    (cons (list Info-current-file Info-current-node (point))
-		  Info-history)))
-  ;; Go into info buffer.
-  (pop-to-buffer "*info*")
-  (buffer-disable-undo (current-buffer))
-  (or (eq major-mode 'Info-mode)
-      (Info-mode))
-  (widen)
-  (setq Info-current-node nil)
-  (unwind-protect
-      (progn
-	;; Switch files if necessary
-	(or (null filename)
-	    (equal Info-current-file filename)
-	    (let ((buffer-read-only nil))
-	      (setq Info-current-file nil
-		    Info-current-subfile nil
-		    Info-current-file-completions nil
-		    buffer-file-name nil)
-	      (erase-buffer)
-	      (if (eq filename t)
-		  (Info-insert-dir)
-		(info-insert-file-contents filename t)
-		(setq default-directory (file-name-directory filename)))
-	      (set-buffer-modified-p nil)
-	      ;; See whether file has a tag table.  Record the location if yes.
-	      (set-marker Info-tag-table-marker nil)
-	      (goto-char (point-max))
-	      (forward-line -8)
-	      ;; Use string-equal, not equal, to ignore text props.
-	      (or (string-equal nodename "*")
-		  (not (search-forward "\^_\nEnd tag table\n" nil t))
-		  (let (pos)
-		    ;; We have a tag table.  Find its beginning.
-		    ;; Is this an indirect file?
-		    (search-backward "\nTag table:\n")
-		    (setq pos (point))
-		    (if (save-excursion
-			  (forward-line 2)
-			  (looking-at "(Indirect)\n"))
-			;; It is indirect.  Copy it to another buffer
-			;; and record that the tag table is in that buffer.
-			(save-excursion
-			  (let ((buf (current-buffer)))
-			    (set-buffer (get-buffer-create " *info tag table*"))
-                            (buffer-disable-undo (current-buffer))
-			    (setq case-fold-search t)
-			    (erase-buffer)
-			    (insert-buffer-substring buf)
-			    (set-marker Info-tag-table-marker
-					(match-end 0))))
-		      (set-marker Info-tag-table-marker pos))))
-	      (setq Info-current-file
-		    (if (eq filename t) "dir" filename))))
-	;; Use string-equal, not equal, to ignore text props.
-	(if (string-equal nodename "*")
-	    (progn (setq Info-current-node nodename)
-		   (Info-set-mode-line))
-	  ;; Search file for a suitable node.
-	  (let ((guesspos (point-min))
-		(regexp (concat "Node: *" (regexp-quote nodename) " *[,\t\n\177]")))
-	    ;; First get advice from tag table if file has one.
-	    ;; Also, if this is an indirect info file,
-	    ;; read the proper subfile into this buffer.
-	    (if (marker-position Info-tag-table-marker)
-		(save-excursion
-		  (set-buffer (marker-buffer Info-tag-table-marker))
-		  (goto-char Info-tag-table-marker)
-		  (if (re-search-forward regexp nil t)
-		      (progn
-			(setq guesspos (read (current-buffer)))
-			;; If this is an indirect file,
-			;; determine which file really holds this node
-			;; and read it in.
-			(if (not (eq (current-buffer) (get-buffer "*info*")))
-			    (setq guesspos
-				  (Info-read-subfile guesspos))))
-		    (error "No such node: %s" nodename))))
-	    (goto-char (max (point-min) (- guesspos 1000)))
-	    ;; Now search from our advised position (or from beg of buffer)
-	    ;; to find the actual node.
-	    (catch 'foo
-	      (while (search-forward "\n\^_" nil t)
-		(forward-line 1)
-		(let ((beg (point)))
-		  (forward-line 1)
-		  (if (re-search-backward regexp beg t)
-		      (throw 'foo t))))
-	      (error "No such node: %s" nodename)))
-	  (Info-select-node)))
-    ;; If we did not finish finding the specified node,
-    ;; go back to the previous one.
-    (or Info-current-node no-going-back (null Info-history)
-	(let ((hist (car Info-history)))
-	  (setq Info-history (cdr Info-history))
-	  (Info-find-node (nth 0 hist) (nth 1 hist) t)
-	  (goto-char (nth 2 hist)))))
-  (goto-char (point-min)))
-
-;; Cache the contents of the (virtual) dir file, once we have merged
-;; it for the first time, so we can save time subsequently.
-(defvar Info-dir-contents nil)
-
-;; Cache for the directory we decided to use for the default-directory
-;; of the merged dir text.
-(defvar Info-dir-contents-directory nil)
-
-;; Record the file attributes of all the files from which we
-;; constructed Info-dir-contents.
-(defvar Info-dir-file-attributes nil)
-
-;; Construct the Info directory node by merging the files named `dir'
-;; from various directories.  Set the *info* buffer's
-;; default-directory to the first directory we actually get any text
-;; from.
-(defun Info-insert-dir ()
-  (if (and Info-dir-contents Info-dir-file-attributes
-	   ;; Verify that none of the files we used has changed
-	   ;; since we used it.
-	   (eval (cons 'and
-		       (mapcar '(lambda (elt)
-				  (let ((curr (file-attributes (car elt))))
-				    ;; Don't compare the access time.
-				    (if curr (setcar (nthcdr 4 curr) 0))
-				    (setcar (nthcdr 4 (cdr elt)) 0)
-				    (equal (cdr elt) curr)))
-			       Info-dir-file-attributes))))
-      (insert Info-dir-contents)
-    (let ((dirs Info-directory-list)
-	  buffers buffer others nodes dirs-done)
-
-      (setq Info-dir-file-attributes nil)
-
-      ;; Search the directory list for the directory file.
-      (while dirs
-	(let ((truename (file-truename (expand-file-name (car dirs)))))
-	  (or (member truename dirs-done)
-	      (member (directory-file-name truename) dirs-done)
-	      ;; Try several variants of specified name.
-	      ;; Try upcasing, appending `.info', or both.
-	      (let* (file
-		     (attrs
-		      (or
-		       (progn (setq file (expand-file-name "dir" truename))
-			      (file-attributes file))
-		       (progn (setq file (expand-file-name "DIR" truename))
-			      (file-attributes file))
-		       (progn (setq file (expand-file-name "dir.info" truename))
-			      (file-attributes file))
-		       (progn (setq file (expand-file-name "DIR.INFO" truename))
-			      (file-attributes file)))))
-		(setq dirs-done
-		      (cons truename
-			    (cons (directory-file-name truename)
-				  dirs-done)))
-		(if attrs
-		    (save-excursion
-		      (or buffers
-			  (message "Composing main Info directory..."))
-		      (set-buffer (generate-new-buffer "info dir"))
-		      (insert-file-contents file)
-		      (setq buffers (cons (current-buffer) buffers)
-			    Info-dir-file-attributes
-			    (cons (cons file attrs)
-				  Info-dir-file-attributes))))))
-	  (or (cdr dirs) (setq Info-dir-contents-directory
-			       (file-name-as-directory (car dirs))))
-	  (setq dirs (cdr dirs))))
-      
-      (or buffers
-	  (error "Can't find the Info directory node"))
-      ;; Distinguish the dir file that comes with Emacs from all the
-      ;; others.  Yes, that is really what this is supposed to do.
-      ;; If it doesn't work, fix it.
-      (setq buffer (car buffers)
-	    others (cdr buffers))
-
-      ;; Insert the entire original dir file as a start; note that we've
-      ;; already saved its default directory to use as the default
-      ;; directory for the whole concatenation.
-      (insert-buffer buffer)
-
-      ;; Look at each of the other buffers one by one.
-      (while others
-	(let ((other (car others)))
-	  ;; In each, find all the menus.
-	  (save-excursion
-	    (set-buffer other)
-	    (goto-char (point-min))
-	    ;; Find each menu, and add an elt to NODES for it.
-	    (while (re-search-forward "^\\* Menu:" nil t)
-	      (let (beg nodename end)
-		(forward-line 1)
-		(setq beg (point))
-		(search-backward "\n\^_")
-		(search-forward "Node: ")
-		(setq nodename (Info-following-node-name))
-		(search-forward "\n\^_" nil 'move)
-		(beginning-of-line)
-		(setq end (point))
-		(setq nodes (cons (list nodename other beg end) nodes))))))
-	(setq others (cdr others)))
-      ;; Add to the main menu a menu item for each other node.
-      (re-search-forward "^\\* Menu:")
-      (forward-line 1)
-      (let ((menu-items '("top"))
-	    (nodes nodes)
-	    (case-fold-search t)
-	    (end (save-excursion (search-forward "\^_" nil t) (point))))
-	(while nodes
-	  (let ((nodename (car (car nodes))))
-	    (save-excursion
-	      (or (member (downcase nodename) menu-items)
-		  (re-search-forward (concat "^\\* "
-					     (regexp-quote nodename)
-					     "::")
-				     end t)
-		  (progn
-		    (insert "* " nodename "::" "\n")
-		    (setq menu-items (cons nodename menu-items))))))
-	  (setq nodes (cdr nodes))))
-      ;; Now take each node of each of the other buffers
-      ;; and merge it into the main buffer.
-      (while nodes
-	(let ((nodename (car (car nodes))))
-	  (goto-char (point-min))
-	  ;; Find the like-named node in the main buffer.
-	  (if (re-search-forward (concat "\n\^_.*\n.*Node: "
-					 (regexp-quote nodename)
-					 "[,\n\t]")
-				 nil t)
-	      (progn
-		(search-forward "\n\^_" nil 'move)
-		(beginning-of-line)
-		(insert "\n"))
-	    ;; If none exists, add one.
-	    (goto-char (point-max))
-	    (insert "\^_\nFile: dir\tNode: " nodename "\n\n* Menu:\n\n"))
-	  ;; Merge the text from the other buffer's menu
-	  ;; into the menu in the like-named node in the main buffer.
-	  (apply 'insert-buffer-substring (cdr (car nodes))))
-	(setq nodes (cdr nodes)))
-      ;; Kill all the buffers we just made.
-      (while buffers
-	(kill-buffer (car buffers))
-	(setq buffers (cdr buffers)))
-      (message "Composing main Info directory...done"))
-    (setq Info-dir-contents (buffer-string)))
-  (setq default-directory Info-dir-contents-directory))
-
-(defun Info-read-subfile (nodepos)
-  ;; NODEPOS is either a position (in the Info file as a whole,
-  ;; not relative to a subfile) or the name of a subfile.
-  (let (lastfilepos
-	lastfilename)
-    (if (numberp nodepos)
-	(save-excursion
-	  (set-buffer (marker-buffer Info-tag-table-marker))
-	  (goto-char (point-min))
-	  (search-forward "\n\^_")
-	  (forward-line 2)
-	  (catch 'foo
-	    (while (not (looking-at "\^_"))
-	      (if (not (eolp))
-		  (let ((beg (point))
-			thisfilepos thisfilename)
-		    (search-forward ": ")
-		    (setq thisfilename  (buffer-substring beg (- (point) 2)))
-		    (setq thisfilepos (read (current-buffer)))
-		    ;; read in version 19 stops at the end of number.
-		    ;; Advance to the next line.
-		    (forward-line 1)
-		    (if (> thisfilepos nodepos)
-			(throw 'foo t))
-		    (setq lastfilename thisfilename)
-		    (setq lastfilepos thisfilepos))
-		(forward-line 1)))))
-      (setq lastfilename nodepos)
-      (setq lastfilepos 0))
-    (set-buffer (get-buffer "*info*"))
-    (or (equal Info-current-subfile lastfilename)
-	(let ((buffer-read-only nil))
-	  (setq buffer-file-name nil)
-	  (widen)
-	  (erase-buffer)
-	  (info-insert-file-contents lastfilename)
-	  (set-buffer-modified-p nil)
-	  (setq Info-current-subfile lastfilename)))
-    (goto-char (point-min))
-    (search-forward "\n\^_")
-    (if (numberp nodepos)
-	(+ (- nodepos lastfilepos) (point)))))
-
-;; Select the info node that point is in.
-(defun Info-select-node ()
-  (save-excursion
-   ;; Find beginning of node.
-   (search-backward "\n\^_")
-   (forward-line 2)
-   ;; Get nodename spelled as it is in the node.
-   (re-search-forward "Node:[ \t]*")
-   (setq Info-current-node
-	 (buffer-substring-no-properties (point)
-					 (progn
-					  (skip-chars-forward "^,\t\n")
-					  (point))))
-   (Info-set-mode-line)
-   ;; Find the end of it, and narrow.
-   (beginning-of-line)
-   (let (active-expression)
-     (narrow-to-region (point)
-		       (if (re-search-forward "\n[\^_\f]" nil t)
-			   (prog1
-			    (1- (point))
-			    (if (looking-at "[\n\^_\f]*execute: ")
-				(progn
-				  (goto-char (match-end 0))
-				  (setq active-expression
-					(read (current-buffer))))))
-			 (point-max)))
-     (if Info-enable-active-nodes (eval active-expression))
-     (if Info-fontify (Info-fontify-node))
-     (run-hooks 'Info-selection-hook))))
-
-(defun Info-set-mode-line ()
-  (setq mode-line-buffer-identification
-	(concat
-	 "Info:  ("
-	 (if Info-current-file
-	     (file-name-nondirectory Info-current-file)
-	   "")
-	 ")"
-	 (or Info-current-node ""))))
-
-;; Go to an info node specified with a filename-and-nodename string
-;; of the sort that is found in pointers in nodes.
-
-(defun Info-goto-node (nodename)
-  "Go to info node named NAME.  Give just NODENAME or (FILENAME)NODENAME."
-  (interactive (list (Info-read-node-name "Goto node: ")))
-  (let (filename)
-    (string-match "\\s *\\((\\s *\\([^\t)]*\\)\\s *)\\s *\\|\\)\\(.*\\)"
-		  nodename)
-    (setq filename (if (= (match-beginning 1) (match-end 1))
-		       ""
-		     (substring nodename (match-beginning 2) (match-end 2)))
-	  nodename (substring nodename (match-beginning 3) (match-end 3)))
-    (let ((trim (string-match "\\s *\\'" filename)))
-      (if trim (setq filename (substring filename 0 trim))))
-    (let ((trim (string-match "\\s *\\'" nodename)))
-      (if trim (setq nodename (substring nodename 0 trim))))
-    (if transient-mark-mode (deactivate-mark))
-    (Info-find-node (if (equal filename "") nil filename)
-		    (if (equal nodename "") "Top" nodename))))
-
-;; This function is used as the "completion table" while reading a node name.
-;; It does completion using the alist in completion-table
-;; unless STRING starts with an open-paren.
-(defun Info-read-node-name-1 (string predicate code)
-  (let ((no-completion (and (> (length string) 0) (eq (aref string 0) ?\())))
-    (cond ((eq code nil)
-	   (if no-completion
-	       string
-	     (try-completion string completion-table predicate)))
-	  ((eq code t)
-	   (if no-completion
-	       nil
-	     (all-completions string completion-table predicate)))
-	  ((eq code 'lambda)
-	   (if no-completion
-	       t
-	     (assoc string completion-table))))))
-
-(defun Info-read-node-name (prompt &optional default)
-  (let* ((completion-ignore-case t)
-	 (completion-table (Info-build-node-completions))
-	 (nodename (completing-read prompt 'Info-read-node-name-1)))
-    (if (equal nodename "")
-	(or default
-	    (Info-read-node-name prompt))
-      nodename)))
-
-(defun Info-build-node-completions ()
-  (or Info-current-file-completions
-      (let ((compl nil))
-	(save-excursion
-	  (save-restriction
-	    (if (marker-buffer Info-tag-table-marker)
-		(progn
-		  (set-buffer (marker-buffer Info-tag-table-marker))
-		  (widen)
-		  (goto-char Info-tag-table-marker)
-		  (while (re-search-forward "\nNode: \\(.*\\)\177" nil t)
-		    (setq compl
-			  (cons (list (buffer-substring (match-beginning 1)
-							(match-end 1)))
-				compl))))
-	      (widen)
-	      (goto-char (point-min))
-	      (while (search-forward "\n\^_" nil t)
-		(forward-line 1)
-		(let ((beg (point)))
-		  (forward-line 1)
-		  (if (re-search-backward "Node: *\\([^,\n]*\\) *[,\n\t]"
-					  beg t)
-		      (setq compl 
-			    (cons (list (buffer-substring (match-beginning 1)
-							  (match-end 1)))
-				  compl))))))))
-	(setq Info-current-file-completions compl))))
-
-(defun Info-restore-point (hl)
-  "If this node has been visited, restore the point value when we left."
-  (while hl
-    (if (and (equal (nth 0 (car hl)) Info-current-file)
-	     ;; Use string-equal, not equal, to ignore text props.
-	     (string-equal (nth 1 (car hl)) Info-current-node))
-	(progn
-	  (goto-char (nth 2 (car hl)))
-	  (setq hl nil))		;terminate the while at next iter
-      (setq hl (cdr hl)))))
-
-(defvar Info-last-search nil
-  "Default regexp for \\<Info-mode-map>\\[Info-search] command to search for.")
-
-(defun Info-search (regexp)
-  "Search for REGEXP, starting from point, and select node it's found in."
-  (interactive "sSearch (regexp): ")
-  (if transient-mark-mode (deactivate-mark))
-  (if (equal regexp "")
-      (setq regexp Info-last-search)
-    (setq Info-last-search regexp))
-  (let ((found ()) current
-	(onode Info-current-node)
-	(ofile Info-current-file)
-	(opoint (point))
-	(ostart (window-start))
-	(osubfile Info-current-subfile))
-    (save-excursion
-      (save-restriction
-	(widen)
-	(if (null Info-current-subfile)
-	    (progn (re-search-forward regexp) (setq found (point)))
-	  (condition-case err
-	      (progn (re-search-forward regexp) (setq found (point)))
-	    (search-failed nil)))))
-    (if (not found) ;can only happen in subfile case -- else would have erred
-	(unwind-protect
-	    (let ((list ()))
-	      (set-buffer (marker-buffer Info-tag-table-marker))
-	      (goto-char (point-min))
-	      (search-forward "\n\^_\nIndirect:")
-	      (save-restriction
-		(narrow-to-region (point)
-				  (progn (search-forward "\n\^_")
-					 (1- (point))))
-		(goto-char (point-min))
-		(search-forward (concat "\n" osubfile ": "))
-		(beginning-of-line)
-		(while (not (eobp))
-		  (re-search-forward "\\(^.*\\): [0-9]+$")
-		  (goto-char (+ (match-end 1) 2))
-		  (setq list (cons (cons (read (current-buffer))
-					 (buffer-substring (match-beginning 1)
-							   (match-end 1)))
-				   list))
-		  (goto-char (1+ (match-end 0))))
-		(setq list (nreverse list)
-		      current (car (car list))
-		      list (cdr list)))
-	      (while list
-		(message "Searching subfile %s..." (cdr (car list)))
-		(Info-read-subfile (car (car list)))
-		(setq list (cdr list))
-;;		(goto-char (point-min))
-		(if (re-search-forward regexp nil t)
-		    (setq found (point) list ())))
-	      (if found
-		  (message "")
-		(signal 'search-failed (list regexp))))
-	  (if (not found)
-	      (progn (Info-read-subfile osubfile)
-		     (goto-char opoint)
-		     (Info-select-node)
-		     (set-window-start (selected-window) ostart)))))
-    (widen)
-    (goto-char found)
-    (Info-select-node)
-    ;; Use string-equal, not equal, to ignore text props.
-    (or (and (string-equal onode Info-current-node)
-	     (equal ofile Info-current-file))
-	(setq Info-history (cons (list ofile onode opoint)
-				 Info-history)))))
-
-;; Extract the value of the node-pointer named NAME.
-;; If there is none, use ERRORNAME in the error message; 
-;; if ERRORNAME is nil, just return nil.
-(defun Info-extract-pointer (name &optional errorname)
-  (save-excursion
-   (goto-char (point-min))
-   (forward-line 1)
-   (if (re-search-backward (concat name ":") nil t)
-       (progn
-	 (goto-char (match-end 0))
-	 (Info-following-node-name))
-     (if (eq errorname t)
-	 nil
-       (error "Node has no %s" (capitalize (or errorname name)))))))
-
-;; Return the node name in the buffer following point.
-;; ALLOWEDCHARS, if non-nil, goes within [...] to make a regexp
-;; saying which chas may appear in the node name.
-(defun Info-following-node-name (&optional allowedchars)
-  (skip-chars-forward " \t")
-  (buffer-substring-no-properties
-   (point)
-   (progn
-     (while (looking-at (concat "[" (or allowedchars "^,\t\n") "]"))
-       (skip-chars-forward (concat (or allowedchars "^,\t\n") "("))
-       (if (looking-at "(")
-	   (skip-chars-forward "^)")))
-     (skip-chars-backward " ")
-     (point))))
-
-(defun Info-next ()
-  "Go to the next node of this node."
-  (interactive)
-  (Info-goto-node (Info-extract-pointer "next")))
-
-(defun Info-prev ()
-  "Go to the previous node of this node."
-  (interactive)
-  (Info-goto-node (Info-extract-pointer "prev[ious]*" "previous")))
-
-(defun Info-up ()
-  "Go to the superior node of this node."
-  (interactive)
-  (Info-goto-node (Info-extract-pointer "up"))
-  (Info-restore-point Info-history))
-
-(defun Info-last ()
-  "Go back to the last node visited."
-  (interactive)
-  (or Info-history
-      (error "This is the first Info node you looked at"))
-  (let (filename nodename opoint)
-    (setq filename (car (car Info-history)))
-    (setq nodename (car (cdr (car Info-history))))
-    (setq opoint (car (cdr (cdr (car Info-history)))))
-    (setq Info-history (cdr Info-history))
-    (Info-find-node filename nodename)
-    (setq Info-history (cdr Info-history))
-    (goto-char opoint)))
-
-(defun Info-directory ()
-  "Go to the Info directory node."
-  (interactive)
-  (Info-find-node "dir" "top"))
-
-(defun Info-follow-reference (footnotename)
-  "Follow cross reference named NAME to the node it refers to.
-NAME may be an abbreviation of the reference name."
-  (interactive
-   (let ((completion-ignore-case t)
-	 completions default alt-default (start-point (point)) str i bol eol)
-     (save-excursion
-       ;; Store end and beginning of line.
-       (end-of-line)
-       (setq eol (point))
-       (beginning-of-line)
-       (setq bol (point))
-
-       (goto-char (point-min))
-       (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
-	 (setq str (buffer-substring
-		    (match-beginning 1)
-		    (1- (point))))
-	 ;; See if this one should be the default.
-	 (and (null default)
-	      (<= (match-beginning 0) start-point)
-	      (<= start-point (point))
-	      (setq default t))
-	 ;; See if this one should be the alternate default.
-	 (and (null alt-default)
-	      (and (<= bol (match-beginning 0))
-		   (<= (point) eol))
-	      (setq alt-default t))
-	 (setq i 0)
-	 (while (setq i (string-match "[ \n\t]+" str i))
-	   (setq str (concat (substring str 0 i) " "
-			     (substring str (match-end 0))))
-	   (setq i (1+ i)))
-	 ;; Record as a completion and perhaps as default.
-	 (if (eq default t) (setq default str))
-	 (if (eq alt-default t) (setq alt-default str))
-	 ;; Don't add this string if it's a duplicate.
-	 ;; We use a loop instead of "(assoc str completions)" because
-	 ;; we want to do a case-insensitive compare.
-	 (let ((tail completions)
-	       (tem (downcase str)))
-	   (while (and tail
-		       (not (string-equal tem (downcase (car (car tail))))))
-	     (setq tail (cdr tail)))
-	   (or tail
-	       (setq completions
-		     (cons (cons str nil)
-			   completions))))))
-     ;; If no good default was found, try an alternate.
-     (or default
-	 (setq default alt-default))
-     ;; If only one cross-reference found, then make it default.
-     (if (eq (length completions) 1)
-         (setq default (car (car completions))))
-     (if completions
-	 (let ((input (completing-read (if default
-					   (concat "Follow reference named: ("
-						   default ") ")
-					 "Follow reference named: ")
-				       completions nil t)))
-	   (list (if (equal input "")
-		     default input)))
-       (error "No cross-references in this node"))))
-  (let (target beg i (str (concat "\\*note " (regexp-quote footnotename))))
-    (while (setq i (string-match " " str i))
-      (setq str (concat (substring str 0 i) "[ \t\n]+" (substring str (1+ i))))
-      (setq i (+ i 6)))
-    (save-excursion
-      (goto-char (point-min))
-      (or (re-search-forward str nil t)
-	  (error "No cross-reference named %s" footnotename))
-      (goto-char (+ (match-beginning 0) 5))
-      (setq target
-	    (Info-extract-menu-node-name "Bad format cross reference" t)))
-    (while (setq i (string-match "[ \t\n]+" target i))
-      (setq target (concat (substring target 0 i) " "
-			   (substring target (match-end 0))))
-      (setq i (+ i 1)))
-    (Info-goto-node target)))
-
-(defun Info-extract-menu-node-name (&optional errmessage multi-line)
-  (skip-chars-forward " \t\n")
-  (let ((beg (point))
-	str i)
-    (skip-chars-forward "^:")
-    (forward-char 1)
-    (setq str
-	  (if (looking-at ":")
-	      (buffer-substring-no-properties beg (1- (point)))
-	    (skip-chars-forward " \t\n")
-	    (Info-following-node-name (if multi-line "^.,\t" "^.,\t\n"))))
-    (while (setq i (string-match "\n" str i))
-      (aset str i ?\ ))
-    ;; Collapse multiple spaces.
-    (while (string-match "  +" str)
-      (setq str (replace-match " " t t str)))
-    str))
-
-;; No one calls this.
-;;(defun Info-menu-item-sequence (list)
-;;  (while list
-;;    (Info-menu (car list))
-;;    (setq list (cdr list))))
-
-(defun Info-complete-menu-item (string predicate action)
-  (let ((case-fold-search t))
-    (cond ((eq action nil)
-	   (let (completions
-		 (pattern (concat "\n\\* \\("
-				  (regexp-quote string)
-				  "[^:\t\n]*\\):")))
-	     (save-excursion
-	       (set-buffer Info-complete-menu-buffer)
-	       (goto-char (point-min))
-	       (search-forward "\n* Menu:")
-	       (while (re-search-forward pattern nil t)
-		 (setq completions (cons (cons (format "%s"
-						       (buffer-substring
-							(match-beginning 1)
-							(match-end 1)))
-					       (match-beginning 1))
-					 completions))))
-	     (try-completion string completions predicate)))
-	  ((eq action t)
-	   (let (completions
-		 (pattern (concat "\n\\* \\("
-				  (regexp-quote string)
-				  "[^:\t\n]*\\):")))
-	     (save-excursion
-	       (set-buffer Info-complete-menu-buffer)
-	       (goto-char (point-min))
-	       (search-forward "\n* Menu:")
-	       (while (re-search-forward pattern nil t)
-		 (setq completions (cons (cons (format "%s"
-						       (buffer-substring
-							(match-beginning 1)
-							(match-end 1)))
-					       (match-beginning 1))
-					 completions))))
-	     (all-completions string completions predicate)))
-	  (t
-	   (save-excursion
-	     (set-buffer Info-complete-menu-buffer)
-	     (goto-char (point-min))
-	     (search-forward "\n* Menu:")
-	     (re-search-forward (concat "\n\\* "
-					(regexp-quote string)
-					":")
-				nil t))))))
-
-
-(defun Info-menu (menu-item)
-  "Go to node for menu item named (or abbreviated) NAME.
-Completion is allowed, and the menu item point is on is the default."
-  (interactive
-   (let ((completions '())
-	 ;; If point is within a menu item, use that item as the default
-	 (default nil)
-	 (p (point))
-	 beg
-	 (last nil))
-     (save-excursion
-       (goto-char (point-min))
-       (if (not (search-forward "\n* menu:" nil t))
-	   (error "No menu in this node"))
-       (setq beg (point))
-       (and (< (point) p)
-	    (save-excursion
-	      (goto-char p)
-	      (end-of-line)
-	      (re-search-backward "\n\\* \\([^:\t\n]*\\):" beg t)
-	      (setq default (format "%s" (buffer-substring
-					  (match-beginning 1)
-					  (match-end 1)))))))
-     (let ((item nil))
-       (while (null item)
-	 (setq item (let ((completion-ignore-case t)
-			  (Info-complete-menu-buffer (current-buffer)))
-		      (completing-read (if default
-					   (format "Menu item (default %s): "
-						   default)
-					   "Menu item: ")
-				       'Info-complete-menu-item nil t)))
-	 ;; we rely on the fact that completing-read accepts an input
-	 ;; of "" even when the require-match argument is true and ""
-	 ;; is not a valid possibility
-	 (if (string= item "")
-	     (if default
-		 (setq item default)
-	         ;; ask again
-	         (setq item nil))))
-       (list item))))
-  ;; there is a problem here in that if several menu items have the same
-  ;; name you can only go to the node of the first with this command.
-  (Info-goto-node (Info-extract-menu-item menu-item)))
-  
-(defun Info-extract-menu-item (menu-item)
-  (setq menu-item (regexp-quote menu-item))
-  (save-excursion
-    (goto-char (point-min))
-    (or (search-forward "\n* menu:" nil t)
-	(error "No menu in this node"))
-    (or (re-search-forward (concat "\n\\* " menu-item ":") nil t)
-	(re-search-forward (concat "\n\\* " menu-item) nil t)
-	(error "No such item in menu"))
-    (beginning-of-line)
-    (forward-char 2)
-    (Info-extract-menu-node-name)))
-
-;; If COUNT is nil, use the last item in the menu.
-(defun Info-extract-menu-counting (count)
-  (save-excursion
-    (goto-char (point-min))
-    (or (search-forward "\n* menu:" nil t)
-	(error "No menu in this node"))
-    (if count
-	(or (search-forward "\n* " nil t count)
-	    (error "Too few items in menu"))
-      (while (search-forward "\n* " nil t)
-	nil))
-    (Info-extract-menu-node-name)))
-
-(defun Info-nth-menu-item ()
-  "Go to the node of the Nth menu item.
-N is the digit argument used to invoke this command."
-  (interactive)
-  (Info-goto-node
-   (Info-extract-menu-counting
-    (- (aref (this-command-keys) (1- (length (this-command-keys)))) ?0))))
-
-(defun Info-top-node ()
-  "Go to the Top node of this file."
-  (interactive)
-  (Info-goto-node "Top"))
-
-(defun Info-final-node ()
-  "Go to the final node in this file."
-  (interactive)
-  (Info-goto-node "Top")
-  (let (Info-history)
-    ;; Go to the last node in the menu of Top.
-    (Info-goto-node (Info-extract-menu-counting nil))
-    ;; If the last node in the menu is not last in pointer structure,
-    ;; move forward until we can't go any farther. 
-    (while (Info-forward-node t t) nil)
-    ;; Then keep moving down to last subnode, unless we reach an index.
-    (while (and (not (string-match "\\<index\\>" Info-current-node))
-		(save-excursion (search-forward "\n* Menu:" nil t)))
-      (Info-goto-node (Info-extract-menu-counting nil)))))
-
-(defun Info-forward-node (&optional not-down no-error)
-  "Go forward one node, considering all nodes as forming one sequence."
-  (interactive)
-  (goto-char (point-min))
-  (forward-line 1)
-  ;; three possibilities, in order of priority:
-  ;;     1. next node is in a menu in this node (but not in an index)
-  ;;     2. next node is next at same level
-  ;;     3. next node is up and next
-  (cond ((and (not not-down)
-              (save-excursion (search-forward "\n* menu:" nil t))
-	      (not (string-match "\\<index\\>" Info-current-node)))
-	 (Info-goto-node (Info-extract-menu-counting 1))
-         t)
-        ((save-excursion (search-backward "next:" nil t))
-         (Info-next)
-         t)
-        ((and (save-excursion (search-backward "up:" nil t))
-	      ;; Use string-equal, not equal, to ignore text props.
-	      (not (string-equal (downcase (Info-extract-pointer "up"))
-				 "top")))
-         (let ((old-node Info-current-node))
-           (Info-up)
-           (let (Info-history success)
-             (unwind-protect
-                 (setq success (Info-forward-node t no-error))
-               (or success (Info-goto-node old-node))))))
-        (no-error nil)
-        (t (error "No pointer forward from this node"))))
-
-(defun Info-backward-node ()
-  "Go backward one node, considering all nodes as forming one sequence."
-  (interactive)
-  (let ((prevnode (Info-extract-pointer "prev[ious]*" t))
-	(upnode (Info-extract-pointer "up" t)))
-    (cond ((and upnode (string-match "(" upnode))
-	   (error "First node in file"))
-	  ((and upnode (or (null prevnode)
-			   ;; Use string-equal, not equal,
-			   ;; to ignore text properties.
-			   (string-equal (downcase prevnode)
-					 (downcase upnode))))
-	   (Info-up))
-	  (prevnode
-	   ;; If we move back at the same level,
-	   ;; go down to find the last subnode*.
-	   (Info-prev)
-	   (let (Info-history)
-	     (while (and (not (string-match "\\<index\\>" Info-current-node))
-			 (save-excursion (search-forward "\n* Menu:" nil t)))
-	       (Info-goto-node (Info-extract-menu-counting nil)))))
-	  (t
-	   (error "No pointer backward from this node")))))
-
-(defun Info-exit ()
-  "Exit Info by selecting some other buffer."
-  (interactive)
-  (if Info-standalone
-      (save-buffers-kill-emacs)
-    (switch-to-buffer (prog1 (other-buffer (current-buffer))
-			(bury-buffer (current-buffer))))))
-
-(defun Info-next-menu-item ()
-  (interactive)
-  (save-excursion
-    (forward-line -1)
-    (search-forward "\n* menu:" nil t)
-    (or (search-forward "\n* " nil t)
-	(error "No more items in menu"))
-    (Info-goto-node (Info-extract-menu-node-name))))
-
-(defun Info-last-menu-item ()
-  (interactive)
-  (save-excursion
-    (forward-line 1)
-    (let ((beg (save-excursion
-		 (and (search-backward "\n* menu:" nil t)
-		      (point)))))
-      (or (and beg (search-backward "\n* " beg t))
-	  (error "No previous items in menu")))
-    (Info-goto-node (save-excursion
-		      (goto-char (match-end 0))
-		      (Info-extract-menu-node-name)))))
-
-(defmacro Info-no-error (&rest body)
-  (list 'condition-case nil (cons 'progn (append body '(t))) '(error nil)))
-
-(defun Info-next-preorder ()
-  "Go to the next subnode or the next node, or go up a level."
-  (interactive)
-  (cond ((Info-no-error (Info-next-menu-item)))
-	((Info-no-error (Info-next)))
-	((Info-no-error (Info-up))
-	 ;; Since we have already gone thru all the items in this menu,
-	 ;; go up to the end of this node.
-	 (goto-char (point-max))
-	 ;; Since logically we are done with the node with that menu,
-	 ;; move on from it.
-	 (Info-next-preorder))
-	(t
-	 (error "No more nodes"))))
-
-(defun Info-last-preorder ()
-  "Go to the last node, popping up a level if there is none."
-  (interactive)
-  (cond ((Info-no-error
-	  (Info-last-menu-item)
-	  ;; If we go down a menu item, go to the end of the node
-	  ;; so we can scroll back through it.
-	  (goto-char (point-max)))
-	 ;; Keep going down, as long as there are nested menu nodes.
-	 (while (Info-no-error
-		 (Info-last-menu-item)
-		 ;; If we go down a menu item, go to the end of the node
-		 ;; so we can scroll back through it.
-		 (goto-char (point-max))))
-	 (recenter -1))
-	((Info-no-error (Info-prev))
-	 (goto-char (point-max))
-	 (while (Info-no-error
-		 (Info-last-menu-item)
-		 ;; If we go down a menu item, go to the end of the node
-		 ;; so we can scroll back through it.
-		 (goto-char (point-max))))
-	 (recenter -1))
-	((Info-no-error (Info-up))
-	 (goto-char (point-min))
-	 (or (search-forward "\n* Menu:" nil t)
-	     (goto-char (point-max))))
-	(t (error "No previous nodes"))))
-
-(defun Info-scroll-up ()
-  "Scroll one screenful forward in Info, considering all nodes as one sequence.
-Once you scroll far enough in a node that its menu appears on the screen
-but after point, the next scroll moves into its first subnode.
-
-When you scroll past the end of a node, that goes to the next node; if
-this node has no successor, it moves to the parent node's successor,
-and so on.  If point is inside the menu of a node, it moves to
-subnode indicated by the following menu item.  (That case won't
-normally result from this command, but can happen in other ways.)"
-
-  (interactive)
-  (if (or (< (window-start) (point-min))
-	  (> (window-start) (point-max)))
-      (set-window-start (selected-window) (point)))
-  (let ((virtual-end (save-excursion
-		       (goto-char (point-min))
-		       (if (search-forward "\n* Menu:" nil t)
-			   (point)
-			 (point-max)))))
-    (if (or (< virtual-end (window-start))
-	    (pos-visible-in-window-p virtual-end))
-	(Info-next-preorder)
-      (scroll-up))))
-
-(defun Info-scroll-down ()
-  "Scroll one screenful back in Info, considering all nodes as one sequence.
-Within the menu of a node, this goes to its last subnode.
-When you scroll past the beginning of a node, that goes to the
-previous node or back up to the parent node."
-  (interactive)
-  (if (or (< (window-start) (point-min))
-	  (> (window-start) (point-max)))
-      (set-window-start (selected-window) (point)))
-  (let* ((current-point (point))
-	 (virtual-end (save-excursion
-			(beginning-of-line)
-			(setq current-point (point))
-			(goto-char (point-min))
-			(search-forward "\n* Menu:"
-					current-point
-					t))))
-    (if (or virtual-end (pos-visible-in-window-p (point-min)))
-	(Info-last-preorder)
-      (scroll-down))))
-
-(defun Info-next-reference (&optional recur)
-  "Move cursor to the next cross-reference or menu item in the node."
-  (interactive)
-  (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:")
-	(old-pt (point)))
-    (or (eobp) (forward-char 1))
-    (or (re-search-forward pat nil t)
-	(progn
-	  (goto-char (point-min))
-	  (or (re-search-forward pat nil t)
-	      (progn
-		(goto-char old-pt)
-		(error "No cross references in this node")))))
-    (goto-char (match-beginning 0))
-    (if (looking-at "\\* Menu:")
-	(if recur
-	    (error "No cross references in this node")
-	  (Info-next-reference t)))))
-
-(defun Info-prev-reference (&optional recur)
-  "Move cursor to the previous cross-reference or menu item in the node."
-  (interactive)
-  (let ((pat "\\*note[ \n\t]*\\([^:]*\\):\\|^\\* .*:")
-	(old-pt (point)))
-    (or (re-search-backward pat nil t)
-	(progn
-	  (goto-char (point-max))
-	  (or (re-search-backward pat nil t)
-	      (progn
-		(goto-char old-pt)
-		(error "No cross references in this node")))))
-    (goto-char (match-beginning 0))
-    (if (looking-at "\\* Menu:")
-	(if recur
-	    (error "No cross references in this node")
-	  (Info-prev-reference t)))))
-
-(defun Info-index (topic)
-  "Look up a string in the index for this file.
-The index is defined as the first node in the top-level menu whose
-name contains the word \"Index\", plus any immediately following
-nodes whose names also contain the word \"Index\".
-If there are no exact matches to the specified topic, this chooses
-the first match which is a case-insensitive substring of a topic.
-Use the `,' command to see the other matches.
-Give a blank topic name to go to the Index node itself."
-  (interactive "sIndex topic: ")
-  (let ((orignode Info-current-node)
-	(rnode nil)
-	(pattern (format "\n\\* \\([^\n:]*%s[^\n:]*\\):[ \t]*\\([^.\n]*\\)\\.[ \t]*\\([0-9]*\\)"
-			 (regexp-quote topic)))
-	node)
-    (Info-goto-node "Top")
-    (or (search-forward "\n* menu:" nil t)
-	(error "No index"))
-    (or (re-search-forward "\n\\* \\(.*\\<Index\\>\\)" nil t)
-	(error "No index"))
-    (goto-char (match-beginning 1))
-    ;; Here, and subsequently in this function,
-    ;; we bind Info-history to nil for internal node-switches
-    ;; so that we don't put junk in the history.
-    ;; In the first Info-goto-node call, above, we do update the history
-    ;; because that is what the user's previous node choice into it.
-    (let ((Info-history nil))
-      (Info-goto-node (Info-extract-menu-node-name)))
-    (or (equal topic "")
-	(let ((matches nil)
-	      (exact nil)
-	      (Info-history nil)
-	      found)
-	  (while
-	      (progn
-		(goto-char (point-min))
-		(while (re-search-forward pattern nil t)
-		  (setq matches
-			(cons (list (buffer-substring (match-beginning 1)
-						      (match-end 1))
-				    (buffer-substring (match-beginning 2)
-						      (match-end 2))
-				    Info-current-node
-				    (string-to-int (concat "0"
-							   (buffer-substring
-							    (match-beginning 3)
-							    (match-end 3)))))
-			      matches)))
-		(and (setq node (Info-extract-pointer "next" t))
-		     (string-match "\\<Index\\>" node)))
-	    (Info-goto-node node))
-	  (or matches
-	      (progn
-		(Info-goto-node orignode)
-		(error "No `%s' in index" topic)))
-	  ;; Here it is a feature that assoc is case-sensitive.
-	  (while (setq found (assoc topic matches))
-	    (setq exact (cons found exact)
-		  matches (delq found matches)))
-	  (setq Info-index-alternatives (nconc exact (nreverse matches)))
-	  (Info-index-next 0)))))
-
-(defun Info-index-next (num)
-  "Go to the next matching index item from the last `i' command."
-  (interactive "p")
-  (or Info-index-alternatives
-      (error "No previous `i' command"))
-  (while (< num 0)
-    (setq num (+ num (length Info-index-alternatives))))
-  (while (> num 0)
-    (setq Info-index-alternatives
-	  (nconc (cdr Info-index-alternatives)
-		 (list (car Info-index-alternatives)))
-	  num (1- num)))
-  (Info-goto-node (nth 1 (car Info-index-alternatives)))
-  (if (> (nth 3 (car Info-index-alternatives)) 0)
-      (forward-line (nth 3 (car Info-index-alternatives)))
-    (forward-line 3)  ; don't search in headers
-    (let ((name (car (car Info-index-alternatives))))
-      (Info-find-index-name name)))
-  (message "Found `%s' in %s.  %s"
-	   (car (car Info-index-alternatives))
-	   (nth 2 (car Info-index-alternatives))
-	   (if (cdr Info-index-alternatives)
-	       "(Press `,' for more)"
-	     "(Only match)")))
-
-(defun Info-find-index-name (name)
-  "Move point to the place within the current node where NAME is defined."
-  (if (or (re-search-forward (format
-			      "[a-zA-Z]+: %s\\( \\|$\\)"
-			      (regexp-quote name)) nil t)
-	  (search-forward (format "`%s'" name) nil t)
-	  (and (string-match "\\`.*\\( (.*)\\)\\'" name)
-	       (search-forward
-		(format "`%s'" (substring name 0 (match-beginning 1)))
-		nil t))
-	  (search-forward name nil t))
-      (beginning-of-line)
-    (goto-char (point-min))))
-
-(defun Info-undefined ()
-  "Make command be undefined in Info."
-  (interactive)
-  (ding))
-
-(defun Info-help ()
-  "Enter the Info tutorial."
-  (interactive)
-  (delete-other-windows)
-  (Info-find-node "info"
-		  (if (< (window-height) 23)
-		      "Help-Small-Screen"
-		    "Help")))
-
-(defun Info-summary ()
-  "Display a brief summary of all Info commands."
-  (interactive)
-  (save-window-excursion
-    (switch-to-buffer "*Help*")
-    (erase-buffer)
-    (insert (documentation 'Info-mode))
-    (help-mode)
-    (goto-char (point-min))
-    (let (ch flag)
-      (while (progn (setq flag (not (pos-visible-in-window-p (point-max))))
-		    (message (if flag "Type Space to see more"
-			       "Type Space to return to Info"))
-		    (if (not (eq ?\  (setq ch (read-event))))
-			(progn (setq unread-command-events (list ch)) nil)
-		      flag))
-	(scroll-up)))
-    (bury-buffer "*Help*")))
-
-(defun Info-get-token (pos start all &optional errorstring)
-  "Return the token around POS,
-POS must be somewhere inside the token
-START is a regular expression which will match the
-    beginning of the tokens delimited string
-ALL is a regular expression with a single
-    parenthesized subpattern which is the token to be
-    returned. E.g. '{\(.*\)}' would return any string
-    enclosed in braces around POS.
-SIG optional fourth argument, controls action on no match
-    nil: return nil
-    t: beep
-    a string: signal an error, using that string."
-  (save-excursion
-    (goto-char pos)
-    ;; First look for a match for START that goes across POS.
-    (while (and (not (bobp)) (> (point) (- pos (length start)))
-		(not (looking-at start)))
-      (forward-char -1))
-    ;; If we did not find one, search back for START
-    ;; (this finds only matches that end at or before POS).
-    (or (looking-at start)
-	(progn
-	  (goto-char pos)
-	  (re-search-backward start (max (point-min) (- pos 200)) 'yes)))
-    (let (found)
-      (while (and (re-search-forward all (min (point-max) (+ pos 200)) 'yes)
-		  (not (setq found (and (<= (match-beginning 0) pos)
-					(> (match-end 0) pos))))))
-      (if (and found (<= (match-beginning 0) pos)
-	       (> (match-end 0) pos))
-	  (buffer-substring (match-beginning 1) (match-end 1))
-	(cond ((null errorstring)
-	       nil)
-	      ((eq errorstring t)
-	       (beep)
-	       nil)
-	      (t
-	       (error "No %s around position %d" errorstring pos)))))))
-
-(defun Info-mouse-follow-nearest-node (click)
-  "\\<Info-mode-map>Follow a node reference near point.
-Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where you click.
-At end of the node's text, moves to the next node, or up if none."
-  (interactive "e")
-  (let* ((start (event-start click))
-	 (window (car start))
-	 (pos (car (cdr start))))
-    (select-window window)
-    (goto-char pos))
-  (and (not (Info-try-follow-nearest-node))
-       (save-excursion (forward-line 1) (eobp))
-       (Info-next-preorder)))
-
-(defun Info-follow-nearest-node ()
-  "\\<Info-mode-map>Follow a node reference near point.
-Like \\[Info-menu], \\[Info-follow-reference], \\[Info-next], \\[Info-prev] or \\[Info-up] command, depending on where point is.
-If no reference to follow, moves to the next node, or up if none."
-  (interactive)
-  (or (Info-try-follow-nearest-node)
-      (Info-next-preorder)))
-
-;; Common subroutine.
-(defun Info-try-follow-nearest-node ()
-  "Follow a node reference near point.  Return non-nil if successful."
-  (let (node)
-    (cond
-     ((setq node (Info-get-token (point) "\\*note[ \n]"
-				 "\\*note[ \n]\\([^:]*\\):"))
-      (Info-follow-reference node))
-     ((setq node (Info-get-token (point) "\\* " "\\* \\([^:]*\\)::"))
-      (Info-goto-node node))
-     ((setq node (Info-get-token (point) "\\* " "\\* \\([^:]*\\):"))
-      (Info-menu node))
-     ((setq node (Info-get-token (point) "Up: " "Up: \\([^,\n\t]*\\)"))
-      (Info-goto-node node))
-     ((setq node (Info-get-token (point) "Next: " "Next: \\([^,\n\t]*\\)"))
-      (Info-goto-node node))
-     ((setq node (Info-get-token (point) "File: " "File: \\([^,\n\t]*\\)"))
-      (Info-goto-node "Top"))
-     ((setq node (Info-get-token (point) "Prev: " "Prev: \\([^,\n\t]*\\)"))
-      (Info-goto-node node)))
-    node))
-
-(defvar Info-mode-map nil
-  "Keymap containing Info commands.")
-(if Info-mode-map
-    nil
-  (setq Info-mode-map (make-keymap))
-  (suppress-keymap Info-mode-map)
-  (define-key Info-mode-map "." 'beginning-of-buffer)
-  (define-key Info-mode-map " " 'Info-scroll-up)
-  (define-key Info-mode-map "\C-m" 'Info-follow-nearest-node)
-  (define-key Info-mode-map "\t" 'Info-next-reference)
-  (define-key Info-mode-map "\e\t" 'Info-prev-reference)
-  (define-key Info-mode-map "1" 'Info-nth-menu-item)
-  (define-key Info-mode-map "2" 'Info-nth-menu-item)
-  (define-key Info-mode-map "3" 'Info-nth-menu-item)
-  (define-key Info-mode-map "4" 'Info-nth-menu-item)
-  (define-key Info-mode-map "5" 'Info-nth-menu-item)
-  (define-key Info-mode-map "6" 'Info-nth-menu-item)
-  (define-key Info-mode-map "7" 'Info-nth-menu-item)
-  (define-key Info-mode-map "8" 'Info-nth-menu-item)
-  (define-key Info-mode-map "9" 'Info-nth-menu-item)
-  (define-key Info-mode-map "0" 'undefined)
-  (define-key Info-mode-map "?" 'Info-summary)
-  (define-key Info-mode-map "]" 'Info-forward-node)
-  (define-key Info-mode-map "[" 'Info-backward-node)
-  (define-key Info-mode-map "<" 'Info-top-node)
-  (define-key Info-mode-map ">" 'Info-final-node)
-  (define-key Info-mode-map "b" 'beginning-of-buffer)
-  (define-key Info-mode-map "d" 'Info-directory)
-  (define-key Info-mode-map "e" 'Info-edit)
-  (define-key Info-mode-map "f" 'Info-follow-reference)
-  (define-key Info-mode-map "g" 'Info-goto-node)
-  (define-key Info-mode-map "h" 'Info-help)
-  (define-key Info-mode-map "i" 'Info-index)
-  (define-key Info-mode-map "l" 'Info-last)
-  (define-key Info-mode-map "m" 'Info-menu)
-  (define-key Info-mode-map "n" 'Info-next)
-  (define-key Info-mode-map "p" 'Info-prev)
-  (define-key Info-mode-map "q" 'Info-exit)
-  (define-key Info-mode-map "s" 'Info-search)
-  ;; For consistency with Rmail.
-  (define-key Info-mode-map "\M-s" 'Info-search)
-  (define-key Info-mode-map "t" 'Info-top-node)
-  (define-key Info-mode-map "u" 'Info-up)
-  (define-key Info-mode-map "," 'Info-index-next)
-  (define-key Info-mode-map "\177" 'Info-scroll-down)
-  (define-key Info-mode-map [mouse-2] 'Info-mouse-follow-nearest-node)
-  )
-
-(defun Info-check-pointer (item)
-  ;; Non-nil if ITEM is present in this node.
-  (condition-case nil
-      (Info-extract-pointer item)
-    (error nil)))
-
-(easy-menu-define Info-mode-menu Info-mode-map
-  "Menu for info files."
-  '("Info"
-    ["Up" Info-up (Info-check-pointer "up")]
-    ["Next" Info-next (Info-check-pointer "next")]
-    ["Previous" Info-prev (Info-check-pointer "prev[ious]*")]
-    ("Menu item" ["You should never see this" report-emacs-bug t])
-    ("Reference" ["You should never see this" report-emacs-bug t])
-    ["Search..." Info-search t]
-    ["Goto node..." Info-goto-node t]
-    ["Last" Info-last Info-history]
-    ["Exit" Info-exit t]))
-
-(defvar Info-menu-last-node nil)
-;; Last node the menu was created for.
-
-(defun Info-menu-update ()
-  ;; Update the Info menu for the current node.
-  (condition-case nil
-      (if (or (not (eq major-mode 'Info-mode))
-	      (eq Info-current-node Info-menu-last-node))
-	  ()
-	;; Update menu menu.
-	(let* ((Info-complete-menu-buffer (current-buffer))
-	       (items (nreverse (condition-case nil
-				    (Info-complete-menu-item
-				     "" (lambda (e) t) t)
-				  (error nil))))
-	       entries current 
-	       (number 0))
-	  (while (and items (< number 9))
-	    (setq current (car items)
-		  items (cdr items)
-		  number (1+ number))
-	    (setq entries (cons `[,current 
-				  (Info-menu ,current)
-				  :keys ,(format "%d" number)]
-				entries)))
-	  (if items
-	      (setq entries (cons ["Other..." Info-menu t] entries)))
-	  (or entries
-	      (setq entries (list ["No menu" nil nil])))
-	  (easy-menu-change '("Info") "Menu item" (nreverse entries)))
-	;; Update reference menu.  Code stolen from `Info-follow-reference'.
-	(let ((items nil)
-	      str i entries current 
-	      (number 0))
-	  (save-excursion
-	    (goto-char (point-min))
-	    (while (re-search-forward "\\*note[ \n\t]*\\([^:]*\\):" nil t)
-	      (setq str (buffer-substring
-			 (match-beginning 1)
-			 (1- (point))))
-	      (setq i 0)
-	      (while (setq i (string-match "[ \n\t]+" str i))
-		(setq str (concat (substring str 0 i) " "
-				  (substring str (match-end 0))))
-		(setq i (1+ i)))
-	      (setq items
-		    (cons str items))))
-	  (while (and items (< number 9))
-	    (setq current (car items)
-		  items (cdr items)
-		  number (1+ number))
-	    (setq entries (cons `[,current 
-				  (Info-follow-reference ,current)
-				  t]
-				entries)))
-	  (if items
-	      (setq entries (cons ["Other..." Info-follow-reference t]
-				  entries)))
-	  (or entries
-	      (setq entries (list ["No references" nil nil])))
-	  (easy-menu-change '("Info") "Reference" (nreverse entries)))
-	;; Update last seen node.
-	(setq Info-menu-last-node (current-buffer)))
-    ;; Try to avoid entering infinite beep mode in case of errors.
-    (error (ding))))
-
-
-;; Info mode is suitable only for specially formatted data.
-(put 'info-mode 'mode-class 'special)
-
-(defun Info-mode ()
-  "\\<Info-mode-map>
-Info mode provides commands for browsing through the Info documentation tree.
-Documentation in Info is divided into \"nodes\", each of which discusses
-one topic and contains references to other nodes which discuss related
-topics.  Info has commands to follow the references and show you other nodes.
-
-\\[Info-help]	Invoke the Info tutorial.
-
-Selecting other nodes:
-\\[Info-mouse-follow-nearest-node]
-	Follow a node reference you click on.
-	  This works with menu items, cross references, and
-	  the \"next\", \"previous\" and \"up\", depending on where you click.
-\\[Info-next]	Move to the \"next\" node of this node.
-\\[Info-prev]	Move to the \"previous\" node of this node.
-\\[Info-up]	Move \"up\" from this node.
-\\[Info-menu]	Pick menu item specified by name (or abbreviation).
-	Picking a menu item causes another node to be selected.
-\\[Info-directory]	Go to the Info directory node.
-\\[Info-follow-reference]	Follow a cross reference.  Reads name of reference.
-\\[Info-last]	Move to the last node you were at.
-\\[Info-index]	Look up a topic in this file's Index and move to that node.
-\\[Info-index-next]	(comma) Move to the next match from a previous `i' command.
-
-Moving within a node:
-\\[Info-scroll-up]	Normally, scroll forward a full screen.  If the end of the buffer is
-already visible, try to go to the next menu entry, or up if there is none.
-\\[Info-scroll-down]  Normally, scroll backward.  If the beginning of the buffer is
-already visible, try to go to the previous menu entry, or up if there is none.
-\\[beginning-of-buffer]	Go to beginning of node.  
-
-Advanced commands:
-\\[Info-exit]	Quit Info: reselect previously selected buffer.
-\\[Info-edit]	Edit contents of selected node.
-1	Pick first item in node's menu.
-2, 3, 4, 5   Pick second ... fifth item in node's menu.
-\\[Info-goto-node]	Move to node specified by name.
-	You may include a filename as well, as (FILENAME)NODENAME.
-\\[universal-argument] \\[info]	Move to new Info file with completion.
-\\[Info-search]	Search through this Info file for specified regexp,
-	and select the node in which the next occurrence is found.
-\\[Info-next-reference]	Move cursor to next cross-reference or menu item.
-\\[Info-prev-reference]	Move cursor to previous cross-reference or menu item."
-  (kill-all-local-variables)
-  (setq major-mode 'Info-mode)
-  (setq mode-name "Info")
-  (setq tab-width 8)
-  (use-local-map Info-mode-map)
-  (make-local-hook 'activate-menubar-hook)
-  (add-hook 'activate-menubar-hook 'Info-menu-update nil t)
-  (set-syntax-table text-mode-syntax-table)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (setq case-fold-search t)
-  (setq buffer-read-only t)
-  (make-local-variable 'Info-current-file)
-  (make-local-variable 'Info-current-subfile)
-  (make-local-variable 'Info-current-node)
-  (make-local-variable 'Info-tag-table-marker)
-  (make-local-variable 'Info-history)
-  (make-local-variable 'Info-index-alternatives)
-  (if (memq (framep (selected-frame)) '(x pc w32))
-      (progn
-	(make-face 'info-node)
-	(make-face 'info-menu-5)
-	(make-face 'info-xref)
-	(or (face-differs-from-default-p 'info-node)
-	    (if (face-differs-from-default-p 'bold-italic)
-		(copy-face 'bold-italic 'info-node)
-	      (copy-face 'bold 'info-node)))
-	(or (face-differs-from-default-p 'info-menu-5)
-	    (set-face-underline-p 'info-menu-5 t))
-	(or (face-differs-from-default-p 'info-xref)
-	    (copy-face 'bold 'info-xref)))
-    (setq Info-fontify nil))
-  (Info-set-mode-line)
-  (run-hooks 'Info-mode-hook))
-
-(defvar Info-edit-map nil
-  "Local keymap used within `e' command of Info.")
-(if Info-edit-map
-    nil
-  (setq Info-edit-map (nconc (make-sparse-keymap) text-mode-map))
-  (define-key Info-edit-map "\C-c\C-c" 'Info-cease-edit))
-
-;; Info-edit mode is suitable only for specially formatted data.
-(put 'info-edit-mode 'mode-class 'special)
-
-(defun Info-edit-mode ()
-  "Major mode for editing the contents of an Info node.
-Like text mode with the addition of `Info-cease-edit'
-which returns to Info mode for browsing.
-\\{Info-edit-map}"
-  (use-local-map Info-edit-map)
-  (setq major-mode 'Info-edit-mode)
-  (setq mode-name "Info Edit")
-  (kill-local-variable 'mode-line-buffer-identification)
-  (setq buffer-read-only nil)
-  (force-mode-line-update)
-  (buffer-enable-undo (current-buffer))
-  (run-hooks 'Info-edit-mode-hook))
-
-(defun Info-edit ()
-  "Edit the contents of this Info node.
-Allowed only if variable `Info-enable-edit' is non-nil."
-  (interactive)
-  (or Info-enable-edit
-      (error "Editing info nodes is not enabled"))
-  (Info-edit-mode)
-  (message "%s" (substitute-command-keys
-	    "Editing: Type \\<Info-edit-map>\\[Info-cease-edit] to return to info")))
-
-(defun Info-cease-edit ()
-  "Finish editing Info node; switch back to Info proper."
-  (interactive)
-  ;; Do this first, so nothing has changed if user C-g's at query.
-  (and (buffer-modified-p)
-       (y-or-n-p "Save the file? ")
-       (save-buffer))
-  (use-local-map Info-mode-map)
-  (setq major-mode 'Info-mode)
-  (setq mode-name "Info")
-  (Info-set-mode-line)
-  (setq buffer-read-only t)
-  (force-mode-line-update)
-  (and (marker-position Info-tag-table-marker)
-       (buffer-modified-p)
-       (message "Tags may have changed.  Use Info-tagify if necessary")))
-
-(defvar Info-file-list-for-emacs
-  '("ediff" "forms" "gnus" "info" ("mh" . "mh-e") "sc")
-  "List of Info files that describe Emacs commands.
-An element can be a file name, or a list of the form (PREFIX . FILE)
-where PREFIX is a name prefix and FILE is the file to look in.
-If the element is just a file name, the file name also serves as the prefix.")
-
-(defun Info-find-emacs-command-nodes (command)
-  "Return a list of locations documenting COMMAND.
-The `info-file' property of COMMAND says which Info manual to search.
-If COMMAND has no property, the variable `Info-file-list-for-emacs'
-defines heuristics for which Info manual to try.
-The locations are of the format used in Info-history, i.e.
-\(FILENAME NODENAME BUFFERPOS\)."
-  (let ((where '())
-	(cmd-desc (concat "^\\* " (regexp-quote (symbol-name command))
-			  ":\\s *\\(.*\\)\\.$"))
-	(info-file "emacs"))		;default
-    ;; Determine which info file this command is documented in.
-    (if (get command 'info-file)
-	(setq info-file (get command 'info-file))
-      ;; If it doesn't say explicitly, test its name against
-      ;; various prefixes that we know.
-      (let ((file-list Info-file-list-for-emacs))
-	(while file-list
-	  (let* ((elt (car file-list))
-		 (name (if (consp elt)
-			   (car elt)
-			 elt))
-		 (file (if (consp elt) (cdr elt) elt))
-		 (regexp (concat "\\`" (regexp-quote name)
-				 "\\(\\'\\|-\\)")))
-	    (if (string-match regexp (symbol-name command))
-		(setq info-file file file-list nil))
-	    (setq file-list (cdr file-list))))))
-    (save-excursion
-      (condition-case nil
-	  (Info-find-node info-file "Command Index")
-	;; Some manuals may not have a separate Command Index node,
-	;; so try just Index instead.
-	(error
-	 (Info-find-node info-file "Index")))
-      ;; Take the index node off the Info history.
-      (setq Info-history (cdr Info-history))
-      (goto-char (point-max))
-      (while (re-search-backward cmd-desc nil t)
-	  (setq where (cons (list Info-current-file
-				  (buffer-substring
-				   (match-beginning 1)
-				   (match-end 1))
-				  0)
-			    where)))
-      where)))
-
-;;;###autoload
-(defun Info-goto-emacs-command-node (command)
-  "Go to the Info node in the Emacs manual for command COMMAND.
-The command is found by looking up in Emacs manual's Command Index
-or in another manual found via COMMAND's `info-file' property or
-the variable `Info-file-list-for-emacs'."
-  (interactive "CFind documentation for command: ")
-  (or (commandp command)
-      (signal 'wrong-type-argument (list 'commandp command)))
-  (let ((where (Info-find-emacs-command-nodes command)))
-    (if where
-	(let ((num-matches (length where)))
-	  ;; Get Info running, and pop to it in another window.
-	  (save-window-excursion
-	    (info))
-	  (pop-to-buffer "*info*")
-	  (Info-find-node (car (car where))
-			  (car (cdr (car where))))
-	  (if (> num-matches 1)
-	      (progn
-		;; Info-find-node already pushed (car where) onto
-		;; Info-history.  Put the other nodes that were found on
-		;; the history.
-		(setq Info-history (nconc (cdr where) Info-history))
-		(message "Found %d other entr%s.  Use %s to see %s."
-			 (1- num-matches)
-			 (if (> num-matches 2) "ies" "y")
-			 (substitute-command-keys "\\[Info-last]")
-			 (if (> num-matches 2) "them" "it")))))
-      (error "Couldn't find documentation for %s" command))))
-
-;;;###autoload
-(defun Info-goto-emacs-key-command-node (key)
-  "Go to the Info node in the Emacs manual the command bound to KEY, a string.
-Interactively, if the binding is execute-extended-command, a command is read.
-The command is found by looking up in Emacs manual's Command Index
-or in another manual found via COMMAND's `info-file' property or
-the variable `Info-file-list-for-emacs'."
-  (interactive "kFind documentation for key:")
-  (let ((command (key-binding key)))
-    (cond ((null command)
-	   (message "%s is undefined" (key-description key)))
-	  ((and (interactive-p)
-		(eq command 'execute-extended-command))
-	   (Info-goto-emacs-command-node
-	    (read-command "Find documentation for command: ")))
-	  (t
-	   (Info-goto-emacs-command-node command)))))
-
-(defvar Info-title-face-alist
-  '((?* bold underline)
-    (?= bold-italic underline)
-    (?- italic underline))
-  "*Alist of face or list of faces to use for pseudo-underlined titles.
-The alist key is the character the title is underlined with (?*, ?= or ?-).")
-
-(defun Info-fontify-node ()
-  (save-excursion
-    (let ((buffer-read-only nil))
-      (goto-char (point-min))
-      (if (looking-at "^File: [^,: \t]+,?[ \t]+")
-	  (progn
-	    (goto-char (match-end 0))
-	    (while
-		(looking-at "[ \t]*[^:, \t\n]+:[ \t]+\\([^:,\t\n]+\\),?")
-	      (goto-char (match-end 0))
-	      (put-text-property (match-beginning 1) (match-end 1)
-				 'face 'info-xref)
-	      (put-text-property (match-beginning 1) (match-end 1)
-				 'mouse-face 'highlight))))
-      (goto-char (point-min))
-      (while (re-search-forward "\n\\([^ \t\n].+\\)\n\\(\\*+\\|=+\\|-+\\)$"
-				 nil t)
-	(put-text-property (match-beginning 1) (match-end 1)
-			   'face
-			   (cdr (assq (preceding-char) Info-title-face-alist)))
-	(put-text-property (match-end 1) (match-end 2)
-			   'invisible t))
-      (goto-char (point-min))
-      (while (re-search-forward "\\*Note[ \n\t]+\\([^:]*\\):" nil t)
-	(if (= (char-after (1- (match-beginning 0))) ?\") ; hack
-	    nil
-	  (put-text-property (match-beginning 1) (match-end 1)
-			     'face 'info-xref)
-	  (put-text-property (match-beginning 1) (match-end 1)
-			     'mouse-face 'highlight)))
-      (goto-char (point-min))
-      (if (and (search-forward "\n* Menu:" nil t)
-	       (not (string-match "\\<Index\\>" Info-current-node))
-	       ;; Don't take time to annotate huge menus
-	       (< (- (point-max) (point)) Info-fontify-maximum-menu-size))
-	  (let ((n 0))
-	    (while (re-search-forward "^\\* \\([^:\t\n]*\\):" nil t)
-	      (setq n (1+ n))
-	      (if (memq n '(5 9))   ; visual aids to help with 1-9 keys
-		  (put-text-property (match-beginning 0)
-				     (1+ (match-beginning 0))
-				     'face 'info-menu-5))
-	      (put-text-property (match-beginning 1) (match-end 1)
-				 'face 'info-node)
-	      (put-text-property (match-beginning 1) (match-end 1)
-				 'mouse-face 'highlight))))
-      (set-buffer-modified-p nil))))
-
-(provide 'info)
-
-;;; info.el ends here
diff --git a/lisp/informat.el b/lisp/informat.el
deleted file mode 100644
index 0b195b9e620..00000000000
--- a/lisp/informat.el
+++ /dev/null
@@ -1,429 +0,0 @@
-;;; informat.el --- info support functions package for Emacs
-
-;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: help
-
-;; 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.
-
-;;; Code:
-
-(require 'info)
-
-;;;###autoload
-(defun Info-tagify ()
-  "Create or update Info-file tag table in current buffer."
-  (interactive)
-  ;; Save and restore point and restrictions.
-  ;; save-restrictions would not work
-  ;; because it records the old max relative to the end.
-  ;; We record it relative to the beginning.
-  (message "Tagifying %s ..." (file-name-nondirectory (buffer-file-name)))
-  (let ((omin (point-min))
-	(omax (point-max))
-	(nomax (= (point-max) (1+ (buffer-size))))
-	(opoint (point)))
-    (unwind-protect
-	(progn
-	  (widen)
-	  (goto-char (point-min))
-	  (if (search-forward "\^_\nIndirect:\n" nil t)
-	      (message "Cannot tagify split info file")
-	    (let ((regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]")
-		  (case-fold-search t)
-		  list)
-	      (while (search-forward "\n\^_" nil t)
-		;; We want the 0-origin character position of the ^_.
-		;; That is the same as the Emacs (1-origin) position
-		;; of the newline before it.
-		(let ((beg (match-beginning 0)))
-		  (forward-line 2)
-		  (if (re-search-backward regexp beg t)
-		      (setq list
-			    (cons (list (buffer-substring-no-properties
-					  (match-beginning 1)
-					  (match-end 1))
-					beg)
-				  list)))))
-	      (goto-char (point-max))
-	      (forward-line -8)
-	      (let ((buffer-read-only nil))
-		(if (search-forward "\^_\nEnd tag table\n" nil t)
-		    (let ((end (point)))
-		      (search-backward "\nTag table:\n")
-		      (beginning-of-line)
-		      (delete-region (point) end)))
-		(goto-char (point-max))
-		(insert "\^_\f\nTag table:\n")
-		(move-marker Info-tag-table-marker (point))
-		(setq list (nreverse list))
-		(while list
-		  (insert "Node: " (car (car list)) ?\177)
-		  (princ (car (cdr (car list))) (current-buffer))
-		  (insert ?\n)
-		  (setq list (cdr list)))
-		(insert "\^_\nEnd tag table\n")))))
-      (goto-char opoint)
-      (narrow-to-region omin (if nomax (1+ (buffer-size))
-			       (min omax (point-max))))))
-  (message "Tagifying %s ... done" (file-name-nondirectory (buffer-file-name))))
-
-;;;###autoload
-(defun Info-split ()
-  "Split an info file into an indirect file plus bounded-size subfiles.
-Each subfile will be up to 50,000 characters plus one node.
-
-To use this command, first visit a large Info file that has a tag
-table.  The buffer is modified into a (small) indirect info file which
-should be saved in place of the original visited file.
-
-The subfiles are written in the same directory the original file is
-in, with names generated by appending `-' and a number to the original
-file name.  The indirect file still functions as an Info file, but it
-contains just the tag table and a directory of subfiles."
-
-  (interactive)
-  (if (< (buffer-size) 70000)
-      (error "This is too small to be worth splitting"))
-  (goto-char (point-min))
-  (search-forward "\^_")
-  (forward-char -1)
-  (let ((start (point))
-	(chars-deleted 0)
-	subfiles
-	(subfile-number 1)
-	(case-fold-search t)
-	(filename (file-name-sans-versions buffer-file-name)))
-    (goto-char (point-max))
-    (forward-line -8)
-    (setq buffer-read-only nil)
-    (or (search-forward "\^_\nEnd tag table\n" nil t)
-	(error "Tag table required; use M-x Info-tagify"))
-    (search-backward "\nTag table:\n")
-    (if (looking-at "\nTag table:\n\^_")
-	(error "Tag table is just a skeleton; use M-x Info-tagify"))
-    (beginning-of-line)
-    (forward-char 1)
-    (save-restriction
-      (narrow-to-region (point-min) (point))
-      (goto-char (point-min))
-      (while (< (1+ (point)) (point-max))
-	(goto-char (min (+ (point) 50000) (point-max)))
-	(search-forward "\^_" nil 'move)
-	(setq subfiles
-	      (cons (list (+ start chars-deleted)
-			  (concat (file-name-nondirectory filename)
-				  (format "-%d" subfile-number)))
-		    subfiles))
-	;; Put a newline at end of split file, to make Unix happier.
-	(insert "\n")
-	(write-region (point-min) (point)
-		      (concat filename (format "-%d" subfile-number)))
-	(delete-region (1- (point)) (point))
-	;; Back up over the final ^_.
-	(forward-char -1)
-	(setq chars-deleted (+ chars-deleted (- (point) start)))
-	(delete-region start (point))
-	(setq subfile-number (1+ subfile-number))))
-    (while subfiles
-      (goto-char start)
-      (insert (nth 1 (car subfiles))
-	      (format ": %d" (1- (car (car subfiles))))
-	      "\n")
-      (setq subfiles (cdr subfiles)))
-    (goto-char start)
-    (insert "\^_\nIndirect:\n")
-    (search-forward "\nTag Table:\n")
-    (insert "(Indirect)\n")))
-
-;;;###autoload
-(defun Info-validate ()
-  "Check current buffer for validity as an Info file.
-Check that every node pointer points to an existing node."
-  (interactive)
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      (if (search-forward "\nTag table:\n(Indirect)\n" nil t)
-	  (error "Don't yet know how to validate indirect info files: \"%s\""
-		 (buffer-name (current-buffer))))
-      (goto-char (point-min))
-      (let ((allnodes '(("*")))
-	    (regexp "Node:[ \t]*\\([^,\n\t]*\\)[,\t\n]")
-	    (case-fold-search t)
-	    (tags-losing nil)
-	    (lossages ()))
-	(while (search-forward "\n\^_" nil t)
-	  (forward-line 1)
-	  (let ((beg (point)))
-	    (forward-line 1)
-	    (if (re-search-backward regexp beg t)
-		(let ((name (downcase
-			      (buffer-substring-no-properties
-			        (match-beginning 1)
-				(progn
-				  (goto-char (match-end 1))
-				  (skip-chars-backward " \t")
-				  (point))))))
-		  (if (assoc name allnodes)
-		      (setq lossages
-			    (cons (list name "Duplicate node-name" nil)
-				  lossages))
-		      (setq allnodes
-			    (cons (list name
-					(progn
-					  (end-of-line)
-					  (and (re-search-backward
-						"prev[ious]*:" beg t)
-					       (progn
-						 (goto-char (match-end 0))
-						 (downcase
-						   (Info-following-node-name)))))
-					beg)
-				  allnodes)))))))
-	(goto-char (point-min))
-	(while (search-forward "\n\^_" nil t)
-	  (forward-line 1)
-	  (let ((beg (point))
-		thisnode next)
-	    (forward-line 1)
-	    (if (re-search-backward regexp beg t)
-		(save-restriction
-		  (search-forward "\n\^_" nil 'move)
-		  (narrow-to-region beg (point))
-		  (setq thisnode (downcase
-				   (buffer-substring-no-properties
-				     (match-beginning 1)
-				     (progn
-				       (goto-char (match-end 1))
-				       (skip-chars-backward " \t")
-				       (point)))))
-		  (end-of-line)
-		  (and (search-backward "next:" nil t)
-		       (setq next (Info-validate-node-name "invalid Next"))
-		       (assoc next allnodes)
-		       (if (equal (car (cdr (assoc next allnodes)))
-				  thisnode)
-			   ;; allow multiple `next' pointers to one node
-			   (let ((tem lossages))
-			     (while tem
-			       (if (and (equal (car (cdr (car tem)))
-					       "should have Previous")
-					(equal (car (car tem))
-					       next))
-				   (setq lossages (delq (car tem) lossages)))
-			       (setq tem (cdr tem))))
-			 (setq lossages
-			       (cons (list next
-					   "should have Previous"
-					   thisnode)
-				     lossages))))
-		  (end-of-line)
-		  (if (re-search-backward "prev[ious]*:" nil t)
-		      (Info-validate-node-name "invalid Previous"))
-		  (end-of-line)
-		  (if (search-backward "up:" nil t)
-		      (Info-validate-node-name "invalid Up"))
-		  (if (re-search-forward "\n* Menu:" nil t)
-		      (while (re-search-forward "\n\\* " nil t)
-			(Info-validate-node-name
-			  (concat "invalid menu item "
-				  (buffer-substring (point)
-						    (save-excursion
-						      (skip-chars-forward "^:")
-						      (point))))
-			  (Info-extract-menu-node-name))))
-		  (goto-char (point-min))
-		  (while (re-search-forward "\\*note[ \n]*[^:\t]*:" nil t)
-		    (goto-char (+ (match-beginning 0) 5))
-		    (skip-chars-forward " \n")
-		    (Info-validate-node-name
-		     (concat "invalid reference "
-			     (buffer-substring (point)
-					       (save-excursion
-						 (skip-chars-forward "^:")
-						 (point))))
-		     (Info-extract-menu-node-name "Bad format cross-reference")))))))
-	(setq tags-losing (not (Info-validate-tags-table)))
-	(if (or lossages tags-losing)
-	    (with-output-to-temp-buffer " *problems in info file*"
-	      (while lossages
-		(princ "In node \"")
-		(princ (car (car lossages)))
-		(princ "\", ")
-		(let ((tem (nth 1 (car lossages))))
-		  (cond ((string-match "\n" tem)
-			 (princ (substring tem 0 (match-beginning 0)))
-			 (princ "..."))
-			(t
-			 (princ tem))))
-		(if (nth 2 (car lossages))
-		    (progn
-		      (princ ": ")
-		      (let ((tem (nth 2 (car lossages))))
-			(cond ((string-match "\n" tem)
-			       (princ (substring tem 0 (match-beginning 0)))
-			       (princ "..."))
-			      (t
-			       (princ tem))))))
-		(terpri)
-		(setq lossages (cdr lossages)))
-	      (if tags-losing (princ "\nTags table must be recomputed\n")))
-	  ;; Here if info file is valid.
-	  ;; If we already made a list of problems, clear it out.
-	  (save-excursion
-	    (if (get-buffer " *problems in info file*")
-		(progn
-		  (set-buffer " *problems in info file*")
-		  (kill-buffer (current-buffer)))))
-	  (message "File appears valid"))))))
-
-(defun Info-validate-node-name (kind &optional name)
-  (if name
-      nil
-    (goto-char (match-end 0))
-    (skip-chars-forward " \t")
-    (if (= (following-char) ?\()
-	nil
-      (setq name
-	    (buffer-substring-no-properties
-	     (point)
-	     (progn
-	      (skip-chars-forward "^,\t\n")
-	      (skip-chars-backward " ")
-	      (point))))))
-  (if (null name)
-      nil
-    (setq name (downcase name))
-    (or (and (> (length name) 0) (= (aref name 0) ?\())
-	(assoc name allnodes)
-	(setq lossages
-	      (cons (list thisnode kind name) lossages))))
-  name)
-
-(defun Info-validate-tags-table ()
-  (goto-char (point-min))
-  (if (not (search-forward "\^_\nEnd tag table\n" nil t))
-      t
-    (not (catch 'losing
-	   (let* ((end (match-beginning 0))
-		  (start (progn (search-backward "\nTag table:\n")
-				(1- (match-end 0))))
-		  tem)
-	     (setq tem allnodes)
-	     (while tem
-	       (goto-char start)
-	       (or (equal (car (car tem)) "*")
-		   (search-forward (concat "Node: "
-					   (car (car tem))
-					   "\177")
-				   end t)
-		   (throw 'losing 'x))
-	       (setq tem (cdr tem)))
-	     (goto-char (1+ start))
-	     (while (looking-at ".*Node: \\(.*\\)\177\\([0-9]+\\)$")
-	       (setq tem (downcase (buffer-substring-no-properties
-				     (match-beginning 1)
-				     (match-end 1))))
-	       (setq tem (assoc tem allnodes))
-	       (if (or (not tem)
-		       (< 1000 (progn
-				 (goto-char (match-beginning 2))
-				 (setq tem (- (car (cdr (cdr tem)))
-					      (read (current-buffer))))
-				 (if (> tem 0) tem (- tem)))))
-		   (throw 'losing 'y))
-	       (forward-line 1)))
-	   (if (looking-at "\^_\n")
-	       (forward-line 1))
-	   (or (looking-at "End tag table\n")
-	       (throw 'losing 'z))
-	   nil))))
-
-;;;###autoload
-(defun batch-info-validate ()
-  "Runs `Info-validate' on the files remaining on the command line.
-Must be used only with -batch, and kills Emacs on completion.
-Each file will be processed even if an error occurred previously.
-For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\""
-  (if (not noninteractive)
-      (error "batch-info-validate may only be used -batch."))
-  (let ((version-control t)
-	(auto-save-default nil)
-	(find-file-run-dired nil)
-	(kept-old-versions 259259)
-	(kept-new-versions 259259))
-    (let ((error 0)
-	  file
-	  (files ()))
-      (while command-line-args-left
-	(setq file (expand-file-name (car command-line-args-left)))
-	(cond ((not (file-exists-p file))
-	       (message ">> %s does not exist!" file)
-	       (setq error 1
-		     command-line-args-left (cdr command-line-args-left))) 
-	      ((file-directory-p file)
-	       (setq command-line-args-left (nconc (directory-files file)
-					      (cdr command-line-args-left))))
-	      (t
-	       (setq files (cons file files)
-		     command-line-args-left (cdr command-line-args-left)))))
-      (while files
-	(setq file (car files)
-	      files (cdr files))
-	(let ((lose nil))
-	  (condition-case err
-	      (progn
-		(if buffer-file-name (kill-buffer (current-buffer)))
-		(find-file file)
-		(buffer-disable-undo (current-buffer))
-		(set-buffer-modified-p nil)
-		(fundamental-mode)
-		(let ((case-fold-search nil))
-		  (goto-char (point-max))
-		  (cond ((search-backward "\n\^_\^L\nTag table:\n" nil t)
-			 (message "%s already tagified" file))
-			((< (point-max) 30000)
-			 (message "%s too small to bother tagifying" file))
-			(t
-			 (Info-tagify))))
-		(let ((loss-name " *problems in info file*"))
-		  (message "Checking validity of info file %s..." file)
-		  (if (get-buffer loss-name)
-		      (kill-buffer loss-name))
-		  (Info-validate)
-		  (if (not (get-buffer loss-name))
-		      nil ;(message "Checking validity of info file %s... OK" file)
-		    (message "----------------------------------------------------------------------")
-		    (message ">> PROBLEMS IN INFO FILE %s" file)
-		    (save-excursion
-		      (set-buffer loss-name)
-		      (princ (buffer-substring-no-properties
-			      (point-min) (point-max))))
-		    (message "----------------------------------------------------------------------")
-		    (setq error 1 lose t)))
-		(if (and (buffer-modified-p)
-			 (not lose))
-		    (progn (message "Saving modified %s" file)
-			   (save-buffer))))
-	    (error (message ">> Error: %s" (prin1-to-string err))))))
-      (kill-emacs error))))
-
-;;; informat.el ends here
diff --git a/lisp/international/iso-acc.el b/lisp/international/iso-acc.el
deleted file mode 100644
index 9f3fa7a53e6..00000000000
--- a/lisp/international/iso-acc.el
+++ /dev/null
@@ -1,419 +0,0 @@
-;;; iso-acc.el --- minor mode providing electric accent keys
-
-;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
-
-;; Author: Johan Vromans
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; 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:
-
-;; Function `iso-accents-mode' activates a minor mode in which
-;; typewriter "dead keys" are emulated.  The purpose of this emulation
-;; is to provide a simple means for inserting accented characters
-;; according to the ISO-8859-1 character set.
-;;
-;; In `iso-accents-mode', pseudo accent characters are used to
-;; introduce accented keys.  The pseudo-accent characters are:
-;;
-;;   '  (minute)    -> grave accent
-;;   `  (backtick)  -> acute accent
-;;   "  (second)    -> diaeresis
-;;   ^  (caret)     -> circumflex
-;;   ~  (tilde)     -> tilde over the character
-;;   /  (slash)     -> slash through the character.
-;;                  Also:  /A is A-with-ring and /E is AE ligature.
-;;
-;; The action taken depends on the key that follows the pseudo accent.
-;; In general: 
-;;
-;;   pseudo-accent + appropriate letter -> accented letter
-;;   pseudo-accent + space -> pseudo-accent
-;;   pseudo-accent + pseudo-accent -> accent (if available)
-;;   pseudo-accent + other -> pseudo-accent + other
-;;
-;; If the pseudo-accent is followed by anything else than a 
-;; self-insert-command, the dead-key code is terminated, the
-;; pseudo-accent inserted 'as is' and the bell is rung to signal this.
-;;
-;; Function `iso-accents-mode' can be used to enable the iso accents
-;; minor mode, or disable it.
-
-;; If you want only some of these characters to serve as accents,
-;; add a language to `iso-languages' which specifies the accent characters
-;; that you want, then select the language with `iso-accents-customize'.
-
-;;; Code:
-
-(provide 'iso-acc)
-
-(defvar iso-languages
-  '(("catalan"
-     ;; Note this includes some extra characters used in Spanish,
-     ;; on the idea that someone who uses Catalan is likely to use Spanish
-     ;; as well.
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
-	 (?\  . ?'))
-     (?` (?A . ?\300) (?E . ?\310) (?O . ?\322)
-	 (?a . ?\340) (?e . ?\350) (?o . ?\362) (?\  . ?`))
-     (?\" (?I . ?\317) (?U . ?\334) (?i . ?\357) (?u . ?\374) (?\  . ?\"))
-     (?\~ (?C . ?\307) (?N . ?\321) (?c . ?\347) (?n . ?\361)
-	  (?> . ?\273) (?< . ?\253) (?! . ?\241) (?? . ?\277)
-	  (?\  . ?\~)))
-
-    ("esperanto"
-     (?^ (?H . ?\246) (?J . ?\254) (?h . ?\266) (?j . ?\274) (?C . ?\306)
-	 (?G . ?\330) (?S . ?\336) (?c . ?\346) (?g . ?\370) (?s . ?\376)
-	 (?^ . ?^) (?\  . ?^))
-     (?~ (?U . ?\335) (?u . ?\375) (?\  . ?~)))
-
-    ("french"
-     (?' (?E . ?\311) (?C . ?\307) (?e . ?\351) (?c . ?\347) (?\  . ?'))
-     (?` (?A . ?\300) (?E . ?\310) (?U . ?\331)
-         (?a . ?\340) (?e . ?\350) (?u . ?\371) (?\  . ?`))
-     (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
-	 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
-	 (?\  . ?^))
-     (?\" (?E . ?\313) (?I . ?\317)  
-          (?e . ?\353) (?i . ?\357) (?\  . ?\"))
-     (?\~ (?< . ?\253) (?> . ?\273) (?C . ?\307) (?c . ?\347) (?\  . ?\~)))
-
-    ("german"
-     (?\" (?A . ?\304) (?O . ?\326) (?U . ?\334)
-	  (?a . ?\344) (?o . ?\366) (?u . ?\374) (?s . ?\337) (?\  . ?\")))
-
-    ("irish"
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
-	 (?\  . ?')))
-
-    ("latin-1"
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?Y . ?\335) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
-	 (?u . ?\372) (?y . ?\375) (?' . ?\264) (?\  . ?'))      
-     (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
-	 (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
-	 (?` . ?`) (?\  . ?`))
-     (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
-	 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
-	 (?^ . ?^) (?\  . ?^))
-     (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
-	  (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?s . ?\337)
-	  (?u . ?\374) (?y . ?\377) (?\" . ?\250) (?\  . ?\"))
-     (?\~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325)
-	  (?T . ?\336) (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361)
-	  (?o . ?\365) (?t . ?\376) (?> . ?\273) (?< . ?\253) (?\~ . ?\270)
-	  (?! . ?\241) (?? . ?\277)
-	  (?\  . ?\~))
-     (?\/ (?A . ?\305) (?E . ?\306) (?O . ?\330) (?a . ?\345) (?e . ?\346)
-	  (?o . ?\370) (?\/ . ?\260) (?\  . ?\/)))
-
-    ("latin-2"
-     (?' (?A . ?\301) (?C . ?\306) (?D . ?\320) (?E . ?\311) (?I . ?\315)
-	 (?L . ?\305) (?N . ?\321) (?O . ?\323) (?R . ?\300) (?S . ?\246)
-	 (?U . ?\332) (?Y . ?\335) (?Z . ?\254) (?a . ?\341) (?c . ?\346)
-	 (?d . ?\360) (?e . ?\351) (?i . ?\355) (?l . ?\345) (?n . ?\361)
-	 (?o . ?\363) (?r . ?\340) (?s . ?\266) (?u . ?\372) (?y . ?\375)
-	 (?z . ?\274) (?' . ?\264) (?\  . ?')) 
-     (?` (?A . ?\241) (?C . ?\307) (?E . ?\312) (?L . ?\243) (?S . ?\252)
-	 (?T . ?\336) (?Z . ?\257) (?a . ?\261) (?l . ?\263) (?c . ?\347)
-	 (?e . ?\352) (?s . ?\272) (?t . ?\376) (?z . ?\277) (?` . ?\252)
-	 (?. . ?\377) (?\  . ?`))
-     (?^ (?A . ?\302) (?O . ?\324) (?a . ?\342) (?o . ?\364)
-	 (?^ . ?^)			; no special code?
-	 (?\  . ?^))
-     (?\" (?A . ?\304) (?E . ?\313) (?O . ?\326) (?U . ?\334) (?a . ?\344)
-	  (?e . ?\353) (?o . ?\366) (?s . ?\337) (?u . ?\374) (?\" . ?\250)
-	  (?\  . ?\"))
-     (?\~ (?A . ?\303) (?C . ?\310) (?D . ?\317) (?L . ?\245) (?N . ?\322)
-	  (?O . ?\325) (?R . ?\330) (?S . ?\251) (?T . ?\253) (?U . ?\333)
-	  (?Z . ?\256) (?a . ?\323) (?c . ?\350) (?d . ?\357) (?l . ?\265)
-	  (?n . ?\362) (?o . ?\365) (?r . ?\370) (?s . ?\271) (?t . ?\273)
-	  (?u . ?\373) (?z . ?\276)
-	  (?v . ?\242)			; v accent
-	  (?\~ . ?\242)			; v accent
-	  (?\. . ?\270)			; cedilla accent
-	  (?\  . ?\~)))
-
-    ("latin-3"
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
-	 (?' . ?\264) (?\  . ?'))      
-     (?` (?A . ?\300) (?E . ?\310) (?I . ?\314) (?O . ?\322) (?U . ?\331)
-	 (?a . ?\340) (?e . ?\350) (?i . ?\354) (?o . ?\362) (?u . ?\371)
-	 (?` . ?`) (?\  . ?`))
-     (?^ (?A . ?\302) (?E . ?\312) (?I . ?\316) (?O . ?\324) (?U . ?\333)
-	 (?a . ?\342) (?e . ?\352) (?i . ?\356) (?o . ?\364) (?u . ?\373)
-	 (?H . ?\246) (?J . ?\254) (?h . ?\266) (?j . ?\274) (?C . ?\306)
-	 (?G . ?\330) (?S . ?\336) (?c . ?\346) (?g . ?\370) (?s . ?\376)
-	 (?^ . ?^) (?\  . ?^))
-     (?\" (?A . ?\304) (?E . ?\313) (?I . ?\317) (?O . ?\326) (?U . ?\334)
-	  (?a . ?\344) (?e . ?\353) (?i . ?\357) (?o . ?\366) (?s . ?\337)
-	  (?u . ?\374) (?\" . ?\250) (?\  . ?\"))
-     (?~ (?A . ?\303) (?C . ?\307) (?D . ?\320) (?N . ?\321) (?O . ?\325)
-	 (?a . ?\343) (?c . ?\347) (?d . ?\360) (?n . ?\361) (?o . ?\365)
-	 (?$ . ?\245) (?S . ?\252) (?s . ?\272) (?G . ?\253) (?g . ?\273)
-	 (?U . ?\335) (?u . ?\375) (?` . ?\242) (?~ . ?\270) (?\  . ?~))
-     (?/ (?H . ?\241) (?# . ?\243) (?$ . ?\244) (?r . ?\256) (?h . ?\261)
-	 (?I . ?\251) (?Z . ?\257) (?i . ?\271) (?z . ?\277) (?C . ?\305)
-	 (?G . ?\325) (?c . ?\345) (?g . ?\365) (?. . ?\377) (?/ . ?\260)
-	 (?\  . ?/)))
-
-    ("portuguese"
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?C . ?\307) (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363)
-	 (?u . ?\372) (?c . ?\347) (?\  . ?'))
-     (?` (?A . ?\300) (?a . ?\340) (?\  . ?`))
-     (?^ (?A . ?\302) (?E . ?\312) (?O . ?\324) (?a . ?\342) (?e . ?\352)
-	 (?o . ?\364) (?\  . ?^))
-     (?\" (?U . ?\334) (?u . ?\374) (?\  . ?\"))
-     (?\~ (?A . ?\303) (?O . ?\325) (?a . ?\343) (?o . ?\365) (?\  . ?\~)))
-
-    ("spanish"
-     (?' (?A . ?\301) (?E . ?\311) (?I . ?\315) (?O . ?\323) (?U . ?\332)
-	 (?a . ?\341) (?e . ?\351) (?i . ?\355) (?o . ?\363) (?u . ?\372)
-	 (?\  . ?'))
-     (?\" (?U . ?\334) (?u . ?\374) (?\  . ?\"))
-     (?\~ (?N . ?\321) (?n . ?\361) (?> . ?\273) (?< . ?\253) (?! . ?\241)
-          (?? . ?\277) (?\  . ?\~))))
-  "List of language-specific customizations for the ISO Accents mode.
-
-Each element of the list is of the form
-
-    (LANGUAGE
-     (PSEUDO-ACCENT MAPPINGS)
-     (PSEUDO-ACCENT MAPPINGS)
-     ...)
-
-LANGUAGE is a string naming the language.
-PSEUDO-ACCENT is a char specifying an accent key.
-MAPPINGS are cons cells of the form (CHAR . ISO-CHAR).
-
-The net effect is that the key sequence PSEUDO-ACCENT CHAR is mapped
-to ISO-CHAR on input.")
-
-(defvar iso-language nil
-  "Language for which ISO Accents mode is currently customized.
-Change it with the `iso-accents-customize' function.")
-
-(defvar iso-accents-list nil
-  "Association list for ISO accent combinations, for the chosen language.")
-
-(defvar iso-accents-mode nil
-  "*Non-nil enables ISO Accents mode.
-Setting this variable makes it local to the current buffer.
-See the function `iso-accents-mode'.")
-(make-variable-buffer-local 'iso-accents-mode)
-
-(defvar iso-accents-enable '(?' ?` ?^ ?\" ?~ ?/)
-  "*List of accent keys that become prefixes in ISO Accents mode.
-The default is (?' ?` ?^ ?\" ?~ ?/), which contains all the supported
-accent keys.  If you set this variable to a list in which some of those
-characters are missing, the missing ones do not act as accents.
-
-Note that if you specify a language with `iso-accents-customize',
-that can also turn off certain prefixes (whichever ones are not needed in
-the language you choose).")
-
-(defun iso-accents-accent-key (prompt)
-  "Modify the following character by adding an accent to it."
-  ;; Pick up the accent character.
-  (if (and iso-accents-mode
-	   (memq last-input-char iso-accents-enable))
-      (iso-accents-compose prompt)
-    (char-to-string last-input-char)))
-
-(defun iso-accents-compose (prompt)
-  (let* ((first-char last-input-char)
-	 (list (assq first-char iso-accents-list))
-	 ;; Wait for the second key and look up the combination.
-	 (second-char (if (or prompt
-			      (not (eq (key-binding "a")
-				       'self-insert-command))
-			      ;; Not at start of a key sequence.
-			      (> (length (this-single-command-keys)) 1)
-			      ;; Called from anything but the command loop.
-			      this-command)
-			  (progn
-			    (message "%s%c"
-				     (or prompt "Compose with ")
-				     first-char)
-			    (read-event))
-			(insert first-char)
-			(prog1 (read-event)
-			  (delete-region (1- (point)) (point)))))
-	 (entry (cdr (assq second-char list))))
-    (if entry
-	;; Found it: return the mapped char
-	(vector entry)
-      ;; Otherwise, advance and schedule the second key for execution.
-      (setq unread-command-events (list second-char))
-      (vector first-char))))
-
-;; It is a matter of taste if you want the minor mode indicated
-;; in the mode line...
-;; If so, uncomment the next four lines.
-;; (or (assq 'iso-accents-mode minor-mode-map-alist)
-;;     (setq minor-mode-alist
-;; 	  (append minor-mode-alist
-;; 		  '((iso-accents-mode " ISO-Acc")))))
-
-;;;###autoload
-(defun iso-accents-mode (&optional arg)
-  "Toggle ISO Accents mode, in which accents modify the following letter.
-This permits easy insertion of accented characters according to ISO-8859-1.
-When Iso-accents mode is enabled, accent character keys
-\(`, ', \", ^, / and ~) do not self-insert; instead, they modify the following
-letter key so that it inserts an ISO accented letter.
-
-You can customize ISO Accents mode to a particular language
-with the command `iso-accents-customize'.
-
-Special combinations: ~c gives a c with cedilla,
-~d gives an Icelandic eth (d with dash).
-~t gives an Icelandic thorn.
-\"s gives German sharp s.
-/a gives a with ring.
-/e gives an a-e ligature.
-~< and ~> give guillemots.
-~! gives an inverted exclamation mark.
-~? gives an inverted question mark.
-
-With an argument, a positive argument enables ISO Accents mode, 
-and a negative argument disables it."
-
-  (interactive "P")
-
-  (if (if arg
-	  ;; Negative arg means switch it off.
-	  (<= (prefix-numeric-value arg) 0)
-	;; No arg means toggle.
-	iso-accents-mode)
-      (setq iso-accents-mode nil)
-
-    ;; Enable electric accents.
-    (setq iso-accents-mode t)))
-
-(defun iso-accents-customize (language)
-  "Customize the ISO accents machinery for a particular language.
-It selects the customization based on the specifications in the
-`iso-languages' variable."
-  (interactive (list (completing-read "Language: " iso-languages nil t)))
-  (let ((table (assoc language iso-languages))
-	all-accents tail)
-    (if (not table)
-	(error "Unknown language '%s'" language)
-      (setq iso-language language
-	    iso-accents-list (cdr table))
-      (if key-translation-map
-	  (substitute-key-definition
-	   'iso-accents-accent-key nil key-translation-map)
-	(setq key-translation-map (make-sparse-keymap)))
-      ;; Set up translations for all the characters that are used as
-      ;; accent prefixes in this language.
-      (setq tail iso-accents-list)
-      (while tail
-	(define-key key-translation-map (vector (car (car tail)))
-	  'iso-accents-accent-key)
-	(setq tail (cdr tail))))))
-
-(defun iso-accentuate (start end)
-  "Convert two-character sequences in region into accented characters.
-Noninteractively, this operates on text from START to END.
-This uses the same conversion that ISO Accents mode uses for type-in."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char start)
-      (forward-char 1)
-      (let (entry)
-	(while (< (point) end)
-	  (if (and (memq (preceding-char) iso-accents-enable)
-		   (setq entry (cdr (assq (following-char) (assq (preceding-char) iso-accents-list)))))
-	      (progn
-		(forward-char -1)
-		(delete-char 2)
-		(insert entry)
-		(setq end (1- end)))
-	    (forward-char 1)))))))
-
-(defun iso-accent-rassoc-unit (value alist)
-  (let (elt acc)
-    (while (and alist (not elt))
-      (setq acc (car (car alist))
-	    elt (car (rassq value (cdr (car alist))))
-	    alist (cdr alist)))
-    (if elt
-	(cons acc elt))))
-
-(defun iso-unaccentuate (start end)
-  "Convert accented characters in the region into two-character sequences.
-Noninteractively, this operates on text from START to END.
-This uses the opposite of the conversion done by ISO Accents mode for type-in."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char start)
-      (let (entry)
-	(while (< (point) end)
-	  (if (and (> (following-char) 127)
-		   (setq entry (iso-accent-rassoc-unit (following-char)
-						       iso-accents-list)))
-	      (progn
-		(delete-char 1)
-		(insert (car entry) (cdr entry))
-		(setq end (1+ end)))
-	    (forward-char 1)))))))
-
-(defun iso-deaccentuate (start end)
-  "Convert accented characters in the region into unaccented characters.
-Noninteractively, this operates on text from START to END."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char start)
-      (let (entry)
-	(while (< (point) end)
-	  (if (and (> (following-char) 127)
-		   (setq entry (iso-accent-rassoc-unit (following-char)
-						       iso-accents-list)))
-	      (progn
-		(delete-char 1)
-		(insert (cdr entry)))
-	    (forward-char 1)))))))
-
-;; Set up the default settings.
-(iso-accents-customize "latin-1")
-
-;; Use Iso-Accents mode in the minibuffer
-;; if it was in use in the previous buffer.
-(defun iso-acc-minibuf-setup ()
-  (setq iso-accents-mode
-	(save-excursion
-	  (set-buffer (window-buffer minibuffer-scroll-window))
-	  iso-accents-mode)))
-
-(add-hook 'minibuffer-setup-hook 'iso-acc-minibuf-setup)
-
-;;; iso-acc.el ends here
diff --git a/lisp/international/iso-ascii.el b/lisp/international/iso-ascii.el
deleted file mode 100644
index abed6a37df5..00000000000
--- a/lisp/international/iso-ascii.el
+++ /dev/null
@@ -1,146 +0,0 @@
-;;; iso-ascii.el --- set up char tables for ISO 8859/1 on ASCII terminals.
-
-;; Copyright (C) 1987, 1995 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; 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:
-
-;; Written by Howard Gayle.  See display-table.el for details.
-
-;; This code sets up to display ISO 8859/1 characters on plain
-;; ASCII terminals.  The display strings for the characters are
-;; more-or-less based on TeX.
-
-;;; Code:
-
-(require 'disp-table)
-
-(defvar iso-ascii-convenient nil
-  "*Non-nil means `iso-ascii' should aim for convenience, not precision.")
-
-(defun iso-ascii-display (code string &optional convenient-string)
-  (if iso-ascii-convenient
-      (setq string (or convenient-string string))
-    (setq string (concat "{" string "}")))
-  (standard-display-ascii code string))
-
-(iso-ascii-display 160 "_" " ")   ; NBSP (no-break space)
-(iso-ascii-display 161 "!")   ; inverted exclamation mark
-(iso-ascii-display 162 "c")   ; cent sign
-(iso-ascii-display 163 "GBP") ; pound sign
-(iso-ascii-display 164 "$")   ; general currency sign
-(iso-ascii-display 165 "JPY") ; yen sign
-(iso-ascii-display 166 "|")   ; broken vertical line
-(iso-ascii-display 167 "S" "(S)")   ; section sign
-(iso-ascii-display 168 "\"")  ; diaeresis
-(iso-ascii-display 169 "C" "(C)")   ; copyright sign
-(iso-ascii-display 170 "_a")  ; ordinal indicator, feminine
-(iso-ascii-display 171 "<<")  ; left angle quotation mark
-(iso-ascii-display 172 "~")   ; not sign
-(iso-ascii-display 173 "-")   ; soft hyphen
-(iso-ascii-display 174 "R" "(R)")   ; registered sign
-(iso-ascii-display 175 "=")   ; macron
-(iso-ascii-display 176 "o")   ; degree sign
-(iso-ascii-display 177 "+-")  ; plus or minus sign
-(iso-ascii-display 178 "2")   ; superscript two
-(iso-ascii-display 179 "3")   ; superscript three
-(iso-ascii-display 180 "'")   ; acute accent
-(iso-ascii-display 181 "u")   ; micro sign
-(iso-ascii-display 182 "P" "{P}")   ; pilcrow
-(iso-ascii-display 183 ".")   ; middle dot
-(iso-ascii-display 184 ",")   ; cedilla
-(iso-ascii-display 185 "1")   ; superscript one
-(iso-ascii-display 186 "_o")  ; ordinal indicator, masculine
-(iso-ascii-display 187 ">>")  ; right angle quotation mark
-(iso-ascii-display 188 "1/4") ; fraction one-quarter
-(iso-ascii-display 189 "1/2") ; fraction one-half
-(iso-ascii-display 190 "3/4") ; fraction three-quarters
-(iso-ascii-display 191 "?")   ; inverted question mark
-(iso-ascii-display 192 "`A")  ; A with grave accent
-(iso-ascii-display 193 "'A")  ; A with acute accent
-(iso-ascii-display 194 "^A")  ; A with circumflex accent
-(iso-ascii-display 195 "~A")  ; A with tilde
-(iso-ascii-display 196 "\"A") ; A with diaeresis or umlaut mark
-(iso-ascii-display 197 "AA")  ; A with ring
-(iso-ascii-display 198 "AE")  ; AE diphthong
-(iso-ascii-display 199 ",C")  ; C with cedilla
-(iso-ascii-display 200 "`E")  ; E with grave accent
-(iso-ascii-display 201 "'E")  ; E with acute accent
-(iso-ascii-display 202 "^E")  ; E with circumflex accent
-(iso-ascii-display 203 "\"E") ; E with diaeresis or umlaut mark
-(iso-ascii-display 204 "`I")  ; I with grave accent
-(iso-ascii-display 205 "'I")  ; I with acute accent
-(iso-ascii-display 206 "^I")  ; I with circumflex accent
-(iso-ascii-display 207 "\"I") ; I with diaeresis or umlaut mark
-(iso-ascii-display 208 "-D")  ; D with stroke, Icelandic eth
-(iso-ascii-display 209 "~N")  ; N with tilde
-(iso-ascii-display 210 "`O")  ; O with grave accent
-(iso-ascii-display 211 "'O")  ; O with acute accent
-(iso-ascii-display 212 "^O")  ; O with circumflex accent
-(iso-ascii-display 213 "~O")  ; O with tilde
-(iso-ascii-display 214 "\"O") ; O with diaeresis or umlaut mark
-(iso-ascii-display 215 "x")   ; multiplication sign
-(iso-ascii-display 216 "/O")  ; O with slash
-(iso-ascii-display 217 "`U")  ; U with grave accent
-(iso-ascii-display 218 "'U")  ; U with acute accent
-(iso-ascii-display 219 "^U")  ; U with circumflex accent
-(iso-ascii-display 220 "\"U") ; U with diaeresis or umlaut mark
-(iso-ascii-display 221 "'Y")  ; Y with acute accent
-(iso-ascii-display 222 "TH")  ; capital thorn, Icelandic
-(iso-ascii-display 223 "ss")  ; small sharp s, German
-(iso-ascii-display 224 "`a")  ; a with grave accent
-(iso-ascii-display 225 "'a")  ; a with acute accent
-(iso-ascii-display 226 "^a")  ; a with circumflex accent
-(iso-ascii-display 227 "~a")  ; a with tilde
-(iso-ascii-display 228 "\"a") ; a with diaeresis or umlaut mark
-(iso-ascii-display 229 "aa")  ; a with ring
-(iso-ascii-display 230 "ae")  ; ae diphthong
-(iso-ascii-display 231 ",c")  ; c with cedilla
-(iso-ascii-display 232 "`e")  ; e with grave accent
-(iso-ascii-display 233 "'e")  ; e with acute accent
-(iso-ascii-display 234 "^e")  ; e with circumflex accent
-(iso-ascii-display 235 "\"e") ; e with diaeresis or umlaut mark
-(iso-ascii-display 236 "`i")  ; i with grave accent
-(iso-ascii-display 237 "'i")  ; i with acute accent
-(iso-ascii-display 238 "^i")  ; i with circumflex accent
-(iso-ascii-display 239 "\"i") ; i with diaeresis or umlaut mark
-(iso-ascii-display 240 "-d")  ; d with stroke, Icelandic eth
-(iso-ascii-display 241 "~n")  ; n with tilde
-(iso-ascii-display 242 "`o")  ; o with grave accent
-(iso-ascii-display 243 "'o")  ; o with acute accent
-(iso-ascii-display 244 "^o")  ; o with circumflex accent
-(iso-ascii-display 245 "~o")  ; o with tilde
-(iso-ascii-display 246 "\"o") ; o with diaeresis or umlaut mark
-(iso-ascii-display 247 "/")   ; division sign
-(iso-ascii-display 248 "/o")  ; o with slash
-(iso-ascii-display 249 "`u")  ; u with grave accent
-(iso-ascii-display 250 "'u")  ; u with acute accent
-(iso-ascii-display 251 "^u")  ; u with circumflex accent
-(iso-ascii-display 252 "\"u") ; u with diaeresis or umlaut mark
-(iso-ascii-display 253 "'y")  ; y with acute accent
-(iso-ascii-display 254 "th")  ; small thorn, Icelandic
-(iso-ascii-display 255 "\"y") ; small y with diaeresis or umlaut mark
-
-(provide 'iso-ascii)
-
-;;; iso-ascii.el ends here
diff --git a/lisp/international/iso-cvt.el b/lisp/international/iso-cvt.el
deleted file mode 100644
index 150eed2a9f6..00000000000
--- a/lisp/international/iso-cvt.el
+++ /dev/null
@@ -1,717 +0,0 @@
-;;; iso-cvt.el --- translate to ISO 8859-1 from/to net/TeX conventions
-;; This file was formerly called gm-lingo.el.
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Michael Gschwind <mike@vlsivie.tuwien.ac.at>
-;; Keywords: tex, iso, latin, i18n
-
-;; 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 lisp code serves two purposes, both of which involve 
-;; the translation of various conventions for representing European 
-;; character sets to ISO 8859-1.
-
-;; Net support: 
-;; Various conventions exist in Newsgroups on how to represent national 
-;; characters. The functions provided here translate these net conventions 
-;; to ISO.
-;;
-;; Calling `iso-german' will turn the net convention for umlauts ("a etc.) 
-;; into ISO latin1 umlauts for easy reading.
-;; 'iso-spanish' will turn net conventions for representing spanish 
-;; to ISO latin1. (Note that accents are omitted in news posts most 
-;; of the time, only enye is escaped.)
-
-;; TeX support
-;; This mode installs hooks which change TeX files to ISO Latin-1 for 
-;; simplified editing. When the TeX file is saved, ISO latin1 characters are
-;; translated back to escape sequences.
-;;
-;; An alternative is a TeX style that handles 8 bit ISO files 
-;; (available on ftp.vlsivie.tuwien.ac.at in /pub/8bit)  
-;; - but these files are difficult to transmit ... so while the net is  
-;; still @ 7 bit this may be useful
-
-;;; TO DO:
-;; The net support should install hooks (like TeX support does) 
-;; which recognizes certain news groups and translates all articles from 
-;; those groups. 
-;;
-;; Cover more cases for translation (There is an infinite number of ways to 
-;; represent accented characters in TeX)
-
-;;; SEE ALSO:
-;; If you are interested in questions related to using the ISO 8859-1 
-;; characters set (configuring emacs, Unix, etc. to use ISO), then you
-;; can get the ISO 8859-1 FAQ via anonymous ftp from 
-;; ftp.vlsivie.tuwien.ac.at in /pub/bit/FAQ-ISO-8859-1
-
-;;; Code:
-
-(provide 'iso-cvt)
-
-(defvar iso-spanish-trans-tab
-  '(
-    ("~n" "ñ")
-    ("\([a-zA-Z]\)#" "\\1ñ")
-    ("~N" "Ñ")
-    ("\\([-a-zA-Z\"`]\\)\"u" "\\1ü")
-    ("\\([-a-zA-Z\"`]\\)\"U" "\\1Ü")
-    ("\\([-a-zA-Z]\\)'o" "\\1ó")
-    ("\\([-a-zA-Z]\\)'O" "\\Ó")
-    ("\\([-a-zA-Z]\\)'e" "\\1é")
-    ("\\([-a-zA-Z]\\)'E" "\\1É")
-    ("\\([-a-zA-Z]\\)'a" "\\1á")
-    ("\\([-a-zA-Z]\\)'A" "\\1A")
-    ("\\([-a-zA-Z]\\)'i" "\\1í")
-    ("\\([-a-zA-Z]\\)'I" "\\1Í")
-    )
-  "Spanish translation table.")
-
-(defun iso-translate-conventions (trans-tab)
-  "Use the translation table TRANS-TAB to translate the current buffer."
-  (save-excursion
-    (goto-char (point-min))
-    (let ((work-tab trans-tab)
-	  (buffer-read-only nil)
-	  (case-fold-search nil))
-      (while work-tab
-	(save-excursion
-	  (let ((trans-this (car work-tab)))
-	    (while (re-search-forward (car trans-this) nil t)
-	      (replace-match (car (cdr trans-this)) t nil)))
-	  (setq work-tab (cdr work-tab)))))))
-
-(defun iso-spanish ()
-  "Translate net conventions for Spanish to ISO 8859-1."
-  (interactive)
-  (iso-translate-conventions iso-spanish-trans-tab))
-
-(defvar iso-aggressive-german-trans-tab
-  '(
-    ("\"a" "ä")
-    ("\"A" "Ä")
-    ("\"o" "ö")
-    ("\"O" "Ö")
-    ("\"u" "ü")
-    ("\"U" "Ü")
-    ("\"s" "ß")
-    ("\\\\3" "ß")
-    )
-  "German translation table. 
-This table uses an aggressive translation approach and may erroneously
-translate too much.")
-
-(defvar iso-conservative-german-trans-tab
-  '(
-    ("\\([-a-zA-Z\"`]\\)\"a" "\\1ä")
-    ("\\([-a-zA-Z\"`]\\)\"A" "\\1Ä")
-    ("\\([-a-zA-Z\"`]\\)\"o" "\\1ö")
-    ("\\([-a-zA-Z\"`]\\)\"O" "\\1Ö")
-    ("\\([-a-zA-Z\"`]\\)\"u" "\\1ü")
-    ("\\([-a-zA-Z\"`]\\)\"U" "\\1Ü")
-    ("\\([-a-zA-Z\"`]\\)\"s" "\\1ß")
-    ("\\([-a-zA-Z\"`]\\)\\\\3" "\\1ß")
-    )
-  "German translation table.
-This table uses a conservative translation approach and may translate too 
-little.")
-
-
-(defvar iso-german-trans-tab iso-aggressive-german-trans-tab 
-  "Currently active translation table for German.")
-
-(defun iso-german ()
- "Translate net conventions for German to ISO 8859-1."
- (interactive)
- (iso-translate-conventions iso-german-trans-tab))
- 
-(defvar iso-iso2tex-trans-tab
-  '(
-    ("ä" "{\\\\\"a}")
-    ("à" "{\\\\`a}")
-    ("á" "{\\\\'a}")
-    ("ã" "{\\\\~a}")
-    ("â" "{\\\\^a}")
-    ("ë" "{\\\\\"e}")
-    ("è" "{\\\\`e}")
-    ("é" "{\\\\'e}")
-    ("ê" "{\\\\^e}")
-    ("ï" "{\\\\\"\\\\i}")
-    ("ì" "{\\\\`\\\\i}")
-    ("í" "{\\\\'\\\\i}")
-    ("î" "{\\\\^\\\\i}")
-    ("ö" "{\\\\\"o}")
-    ("ò" "{\\\\`o}")
-    ("ó" "{\\\\'o}")
-    ("õ" "{\\\\~o}")
-    ("ô" "{\\\\^o}")
-    ("ü" "{\\\\\"u}")
-    ("ù" "{\\\\`u}")
-    ("ú" "{\\\\'u}")
-    ("û" "{\\\\^u}")
-    ("Ä" "{\\\\\"A}")
-    ("À" "{\\\\`A}")
-    ("Á" "{\\\\'A}")
-    ("Ã" "{\\\\~A}")
-    ("Â" "{\\\\^A}")
-    ("Ë" "{\\\\\"E}")
-    ("È" "{\\\\`E}")
-    ("É" "{\\\\'E}")
-    ("Ê" "{\\\\^E}")
-    ("Ï" "{\\\\\"I}")
-    ("Ì" "{\\\\`I}")
-    ("Í" "{\\\\'I}")
-    ("Î" "{\\\\^I}")
-    ("Ö" "{\\\\\"O}")
-    ("Ò" "{\\\\`O}")
-    ("Ó" "{\\\\'O}")
-    ("Õ" "{\\\\~O}")
-    ("Ô" "{\\\\^O}")
-    ("Ü" "{\\\\\"U}")
-    ("Ù" "{\\\\`U}")
-    ("Ú" "{\\\\'U}")
-    ("Û" "{\\\\^U}")
-    ("ñ" "{\\\\~n}")
-    ("Ñ" "{\\\\~N}")
-    ("ç" "{\\\\c c}")
-    ("Ç" "{\\\\c C}")
-    ("ß" "{\\\\ss}")
-    ("\306" "{\\\\AE}")
-    ("\346" "{\\\\ae}")
-    ("\305" "{\\\\AA}")
-    ("\345" "{\\\\aa}")
-    ("\251" "{\\\\copyright}")
-    ("£" "{\\\\pounds}")
-    ("¶" "{\\\\P}")
-    ("§" "{\\\\S}")
-    ("¿" "{?`}")
-    ("¡" "{!`}")
-    )
-  "Translation table for translating ISO 8859-1 characters to TeX sequences.")
-
-
-
-
-(defun iso-iso2tex ()
- "Translate ISO 8859-1 characters to TeX sequences."
- (interactive)
- (iso-translate-conventions iso-iso2tex-trans-tab))
-
-
-(defvar iso-tex2iso-trans-tab
-  '(
-    ("{\\\\\"a}" "ä")
-    ("{\\\\`a}" "à")
-    ("{\\\\'a}" "á")
-    ("{\\\\~a}" "ã")
-    ("{\\\\^a}" "â")
-    ("{\\\\\"e}" "ë")
-    ("{\\\\`e}" "è")
-    ("{\\\\'e}" "é")
-    ("{\\\\^e}" "ê")
-    ("{\\\\\"\\\\i}" "ï")
-    ("{\\\\`\\\\i}" "ì")
-    ("{\\\\'\\\\i}" "í")
-    ("{\\\\^\\\\i}" "î")
-    ("{\\\\\"i}" "ï")
-    ("{\\\\`i}" "ì")
-    ("{\\\\'i}" "í")
-    ("{\\\\^i}" "î")
-    ("{\\\\\"o}" "ö")
-    ("{\\\\`o}" "ò")
-    ("{\\\\'o}" "ó")
-    ("{\\\\~o}" "õ")
-    ("{\\\\^o}" "ô")
-    ("{\\\\\"u}" "ü")
-    ("{\\\\`u}" "ù")
-    ("{\\\\'u}" "ú")
-    ("{\\\\^u}" "û")
-    ("{\\\\\"A}" "Ä")
-    ("{\\\\`A}" "À")
-    ("{\\\\'A}" "Á")
-    ("{\\\\~A}" "Ã")
-    ("{\\\\^A}" "Â")
-    ("{\\\\\"E}" "Ë")
-    ("{\\\\`E}" "È")
-    ("{\\\\'E}" "É")
-    ("{\\\\^E}" "Ê")
-    ("{\\\\\"I}" "Ï")
-    ("{\\\\`I}" "Ì")
-    ("{\\\\'I}" "Í")
-    ("{\\\\^I}" "Î")
-    ("{\\\\\"O}" "Ö")
-    ("{\\\\`O}" "Ò")
-    ("{\\\\'O}" "Ó")
-    ("{\\\\~O}" "Õ")
-    ("{\\\\^O}" "Ô")
-    ("{\\\\\"U}" "Ü")
-    ("{\\\\`U}" "Ù")
-    ("{\\\\'U}" "Ú")
-    ("{\\\\^U}" "Û")
-    ("{\\\\~n}" "ñ")
-    ("{\\\\~N}" "Ñ")
-    ("{\\\\c c}" "ç")
-    ("{\\\\c C}" "Ç")
-    ("\\\\\"a" "ä")
-    ("\\\\`a" "à")
-    ("\\\\'a" "á")
-    ("\\\\~a" "ã")
-    ("\\\\^a" "â")
-    ("\\\\\"e" "ë")
-    ("\\\\`e" "è")
-    ("\\\\'e" "é")
-    ("\\\\^e" "ê")
-    ("\\\\\"\\\\i" "ï")
-    ("\\\\`\\\\i" "ì")
-    ("\\\\'\\\\i" "í")
-    ("\\\\^\\\\i" "î")
-    ("\\\\\"i" "ï")
-    ("\\\\`i" "ì")
-    ("\\\\'i" "í")
-    ("\\\\^i" "î")
-    ("\\\\\"o" "ö")
-    ("\\\\`o" "ò")
-    ("\\\\'o" "ó")
-    ("\\\\~o" "õ")
-    ("\\\\^o" "ô")
-    ("\\\\\"u" "ü")
-    ("\\\\`u" "ù")
-    ("\\\\'u" "ú")
-    ("\\\\^u" "û")
-    ("\\\\\"A" "Ä")
-    ("\\\\`A" "À")
-    ("\\\\'A" "Á")
-    ("\\\\~A" "Ã")
-    ("\\\\^A" "Â")
-    ("\\\\\"E" "Ë")
-    ("\\\\`E" "È")
-    ("\\\\'E" "É")
-    ("\\\\^E" "Ê")
-    ("\\\\\"I" "Ï")
-    ("\\\\`I" "Ì")
-    ("\\\\'I" "Í")
-    ("\\\\^I" "Î")
-    ("\\\\\"O" "Ö")
-    ("\\\\`O" "Ò")
-    ("\\\\'O" "Ó")
-    ("\\\\~O" "Õ")
-    ("\\\\^O" "Ô")
-    ("\\\\\"U" "Ü")
-    ("\\\\`U" "Ù")
-    ("\\\\'U" "Ú")
-    ("\\\\^U" "Û")
-    ("\\\\~n" "ñ")
-    ("\\\\~N" "Ñ")
-    ("\\\\\"{a}" "ä")
-    ("\\\\`{a}" "à")
-    ("\\\\'{a}" "á")
-    ("\\\\~{a}" "ã")
-    ("\\\\^{a}" "â")
-    ("\\\\\"{e}" "ë")
-    ("\\\\`{e}" "è")
-    ("\\\\'{e}" "é")
-    ("\\\\^{e}" "ê")
-    ("\\\\\"{\\\\i}" "ï")
-    ("\\\\`{\\\\i}" "ì")
-    ("\\\\'{\\\\i}" "í")
-    ("\\\\^{\\\\i}" "î")
-    ("\\\\\"{i}" "ï")
-    ("\\\\`{i}" "ì")
-    ("\\\\'{i}" "í")
-    ("\\\\^{i}" "î")
-    ("\\\\\"{o}" "ö")
-    ("\\\\`{o}" "ò")
-    ("\\\\'{o}" "ó")
-    ("\\\\~{o}" "õ")
-    ("\\\\^{o}" "ô")
-    ("\\\\\"{u}" "ü")
-    ("\\\\`{u}" "ù")
-    ("\\\\'{u}" "ú")
-    ("\\\\^{u}" "û")
-    ("\\\\\"{A}" "Ä")
-    ("\\\\`{A}" "À")
-    ("\\\\'{A}" "Á")
-    ("\\\\~{A}" "Ã")
-    ("\\\\^{A}" "Â")
-    ("\\\\\"{E}" "Ë")
-    ("\\\\`{E}" "È")
-    ("\\\\'{E}" "É")
-    ("\\\\^{E}" "Ê")
-    ("\\\\\"{I}" "Ï")
-    ("\\\\`{I}" "Ì")
-    ("\\\\'{I}" "Í")
-    ("\\\\^{I}" "Î")
-    ("\\\\\"{O}" "Ö")
-    ("\\\\`{O}" "Ò")
-    ("\\\\'{O}" "Ó")
-    ("\\\\~{O}" "Õ")
-    ("\\\\^{O}" "Ô")
-    ("\\\\\"{U}" "Ü")
-    ("\\\\`{U}" "Ù")
-    ("\\\\'{U}" "Ú")
-    ("\\\\^{U}" "Û")
-    ("\\\\~{n}" "ñ")
-    ("\\\\~{N}" "Ñ")
-    ("\\\\c{c}" "ç")
-    ("\\\\c{C}" "Ç")
-    ("{\\\\ss}" "ß")
-    ("{\\\\AE}" "\306")
-    ("{\\\\ae}" "\346")
-    ("{\\\\AA}" "\305")
-    ("{\\\\aa}" "\345")
-    ("{\\\\copyright}" "\251")
-    ("\\\\copyright{}" "\251")
-    ("{\\\\pounds}" "£" )
-    ("{\\\\P}" "¶" )
-    ("{\\\\S}" "§" )
-    ("\\\\pounds{}" "£" )
-    ("\\\\P{}" "¶" )
-    ("\\\\S{}" "§" )
-    ("{\\?`}" "¿")
-    ("{!`}" "¡")
-    ("\\?`" "¿")
-    ("!`" "¡")
-    )
-  "Translation table for translating TeX sequences to ISO 8859-1 characters. 
-This table is not exhaustive (and due to TeX's power can never be). It only
-contains commonly used sequences.")
-
-(defun iso-tex2iso ()
- "Translate TeX sequences to ISO 8859-1 characters."
- (interactive)
- (iso-translate-conventions iso-tex2iso-trans-tab))
-
-(defvar iso-gtex2iso-trans-tab
-  '(
-    ("{\\\\\"a}" "ä")
-    ("{\\\\`a}" "à")
-    ("{\\\\'a}" "á")
-    ("{\\\\~a}" "ã")
-    ("{\\\\^a}" "â")
-    ("{\\\\\"e}" "ë")
-    ("{\\\\`e}" "è")
-    ("{\\\\'e}" "é")
-    ("{\\\\^e}" "ê")
-    ("{\\\\\"\\\\i}" "ï")
-    ("{\\\\`\\\\i}" "ì")
-    ("{\\\\'\\\\i}" "í")
-    ("{\\\\^\\\\i}" "î")
-    ("{\\\\\"i}" "ï")
-    ("{\\\\`i}" "ì")
-    ("{\\\\'i}" "í")
-    ("{\\\\^i}" "î")
-    ("{\\\\\"o}" "ö")
-    ("{\\\\`o}" "ò")
-    ("{\\\\'o}" "ó")
-    ("{\\\\~o}" "õ")
-    ("{\\\\^o}" "ô")
-    ("{\\\\\"u}" "ü")
-    ("{\\\\`u}" "ù")
-    ("{\\\\'u}" "ú")
-    ("{\\\\^u}" "û")
-    ("{\\\\\"A}" "Ä")
-    ("{\\\\`A}" "À")
-    ("{\\\\'A}" "Á")
-    ("{\\\\~A}" "Ã")
-    ("{\\\\^A}" "Â")
-    ("{\\\\\"E}" "Ë")
-    ("{\\\\`E}" "È")
-    ("{\\\\'E}" "É")
-    ("{\\\\^E}" "Ê")
-    ("{\\\\\"I}" "Ï")
-    ("{\\\\`I}" "Ì")
-    ("{\\\\'I}" "Í")
-    ("{\\\\^I}" "Î")
-    ("{\\\\\"O}" "Ö")
-    ("{\\\\`O}" "Ò")
-    ("{\\\\'O}" "Ó")
-    ("{\\\\~O}" "Õ")
-    ("{\\\\^O}" "Ô")
-    ("{\\\\\"U}" "Ü")
-    ("{\\\\`U}" "Ù")
-    ("{\\\\'U}" "Ú")
-    ("{\\\\^U}" "Û")
-    ("{\\\\~n}" "ñ")
-    ("{\\\\~N}" "Ñ")
-    ("{\\\\c c}" "ç")
-    ("{\\\\c C}" "Ç")
-    ("\\\\\"a" "ä")
-    ("\\\\`a" "à")
-    ("\\\\'a" "á")
-    ("\\\\~a" "ã")
-    ("\\\\^a" "â")
-    ("\\\\\"e" "ë")
-    ("\\\\`e" "è")
-    ("\\\\'e" "é")
-    ("\\\\^e" "ê")
-    ("\\\\\"\\\\i" "ï")
-    ("\\\\`\\\\i" "ì")
-    ("\\\\'\\\\i" "í")
-    ("\\\\^\\\\i" "î")
-    ("\\\\\"i" "ï")
-    ("\\\\`i" "ì")
-    ("\\\\'i" "í")
-    ("\\\\^i" "î")
-    ("\\\\\"o" "ö")
-    ("\\\\`o" "ò")
-    ("\\\\'o" "ó")
-    ("\\\\~o" "õ")
-    ("\\\\^o" "ô")
-    ("\\\\\"u" "ü")
-    ("\\\\`u" "ù")
-    ("\\\\'u" "ú")
-    ("\\\\^u" "û")
-    ("\\\\\"A" "Ä")
-    ("\\\\`A" "À")
-    ("\\\\'A" "Á")
-    ("\\\\~A" "Ã")
-    ("\\\\^A" "Â")
-    ("\\\\\"E" "Ë")
-    ("\\\\`E" "È")
-    ("\\\\'E" "É")
-    ("\\\\^E" "Ê")
-    ("\\\\\"I" "Ï")
-    ("\\\\`I" "Ì")
-    ("\\\\'I" "Í")
-    ("\\\\^I" "Î")
-    ("\\\\\"O" "Ö")
-    ("\\\\`O" "Ò")
-    ("\\\\'O" "Ó")
-    ("\\\\~O" "Õ")
-    ("\\\\^O" "Ô")
-    ("\\\\\"U" "Ü")
-    ("\\\\`U" "Ù")
-    ("\\\\'U" "Ú")
-    ("\\\\^U" "Û")
-    ("\\\\~n" "ñ")
-    ("\\\\~N" "Ñ")
-    ("\\\\\"{a}" "ä")
-    ("\\\\`{a}" "à")
-    ("\\\\'{a}" "á")
-    ("\\\\~{a}" "ã")
-    ("\\\\^{a}" "â")
-    ("\\\\\"{e}" "ë")
-    ("\\\\`{e}" "è")
-    ("\\\\'{e}" "é")
-    ("\\\\^{e}" "ê")
-    ("\\\\\"{\\\\i}" "ï")
-    ("\\\\`{\\\\i}" "ì")
-    ("\\\\'{\\\\i}" "í")
-    ("\\\\^{\\\\i}" "î")
-    ("\\\\\"{i}" "ï")
-    ("\\\\`{i}" "ì")
-    ("\\\\'{i}" "í")
-    ("\\\\^{i}" "î")
-    ("\\\\\"{o}" "ö")
-    ("\\\\`{o}" "ò")
-    ("\\\\'{o}" "ó")
-    ("\\\\~{o}" "õ")
-    ("\\\\^{o}" "ô")
-    ("\\\\\"{u}" "ü")
-    ("\\\\`{u}" "ù")
-    ("\\\\'{u}" "ú")
-    ("\\\\^{u}" "û")
-    ("\\\\\"{A}" "Ä")
-    ("\\\\`{A}" "À")
-    ("\\\\'{A}" "Á")
-    ("\\\\~{A}" "Ã")
-    ("\\\\^{A}" "Â")
-    ("\\\\\"{E}" "Ë")
-    ("\\\\`{E}" "È")
-    ("\\\\'{E}" "É")
-    ("\\\\^{E}" "Ê")
-    ("\\\\\"{I}" "Ï")
-    ("\\\\`{I}" "Ì")
-    ("\\\\'{I}" "Í")
-    ("\\\\^{I}" "Î")
-    ("\\\\\"{O}" "Ö")
-    ("\\\\`{O}" "Ò")
-    ("\\\\'{O}" "Ó")
-    ("\\\\~{O}" "Õ")
-    ("\\\\^{O}" "Ô")
-    ("\\\\\"{U}" "Ü")
-    ("\\\\`{U}" "Ù")
-    ("\\\\'{U}" "Ú")
-    ("\\\\^{U}" "Û")
-    ("\\\\~{n}" "ñ")
-    ("\\\\~{N}" "Ñ")
-    ("\\\\c{c}" "ç")
-    ("\\\\c{C}" "Ç")
-    ("{\\\\ss}" "ß")
-    ("{\\\\AE}" "\306")
-    ("{\\\\ae}" "\346")
-    ("{\\\\AA}" "\305")
-    ("{\\\\aa}" "\345")
-    ("{\\\\copyright}" "\251")
-    ("\\\\copyright{}" "\251")
-    ("{\\\\pounds}" "£" )
-    ("{\\\\P}" "¶" )
-    ("{\\\\S}" "§" )
-    ("\\\\pounds{}" "£" )
-    ("\\\\P{}" "¶" )
-    ("\\\\S{}" "§" )
-    ("?`" "¿")
-    ("!`" "¡")
-    ("{?`}" "¿")
-    ("{!`}" "¡")
-    ("\"a" "ä")
-    ("\"A" "Ä")
-    ("\"o" "ö")
-    ("\"O" "Ö")
-    ("\"u" "ü")
-    ("\"U" "Ü")
-    ("\"s" "ß")
-    ("\\\\3" "ß")
-    )
-  "Translation table for translating German TeX sequences to ISO 8859-1.
-This table is not exhaustive (and due to TeX's power can never be).  It only
-contains commonly used sequences.")
-
-(defvar iso-iso2gtex-trans-tab
-  '(
-    ("ä" "\"a")
-    ("à" "{\\\\`a}")
-    ("á" "{\\\\'a}")
-    ("ã" "{\\\\~a}")
-    ("â" "{\\\\^a}")
-    ("ë" "{\\\\\"e}")
-    ("è" "{\\\\`e}")
-    ("é" "{\\\\'e}")
-    ("ê" "{\\\\^e}")
-    ("ï" "{\\\\\"\\\\i}")
-    ("ì" "{\\\\`\\\\i}")
-    ("í" "{\\\\'\\\\i}")
-    ("î" "{\\\\^\\\\i}")
-    ("ö" "\"o")
-    ("ò" "{\\\\`o}")
-    ("ó" "{\\\\'o}")
-    ("õ" "{\\\\~o}")
-    ("ô" "{\\\\^o}")
-    ("ü" "\"u")
-    ("ù" "{\\\\`u}")
-    ("ú" "{\\\\'u}")
-    ("û" "{\\\\^u}")
-    ("Ä" "\"A")
-    ("À" "{\\\\`A}")
-    ("Á" "{\\\\'A}")
-    ("Ã" "{\\\\~A}")
-    ("Â" "{\\\\^A}")
-    ("Ë" "{\\\\\"E}")
-    ("È" "{\\\\`E}")
-    ("É" "{\\\\'E}")
-    ("Ê" "{\\\\^E}")
-    ("Ï" "{\\\\\"I}")
-    ("Ì" "{\\\\`I}")
-    ("Í" "{\\\\'I}")
-    ("Î" "{\\\\^I}")
-    ("Ö" "\"O")
-    ("Ò" "{\\\\`O}")
-    ("Ó" "{\\\\'O}")
-    ("Õ" "{\\\\~O}")
-    ("Ô" "{\\\\^O}")
-    ("Ü" "\"U")
-    ("Ù" "{\\\\`U}")
-    ("Ú" "{\\\\'U}")
-    ("Û" "{\\\\^U}")
-    ("ñ" "{\\\\~n}")
-    ("Ñ" "{\\\\~N}")
-    ("ç" "{\\\\c c}")
-    ("Ç" "{\\\\c C}")
-    ("ß" "\"s")
-    ("\306" "{\\\\AE}")
-    ("\346" "{\\\\ae}")
-    ("\305" "{\\\\AA}")
-    ("\345" "{\\\\aa}")
-    ("\251" "{\\\\copyright}")
-    ("£" "{\\\\pounds}")
-    ("¶" "{\\\\P}")
-    ("§" "{\\\\S}")
-    ("¿" "{?`}")
-    ("¡" "{!`}")
-    )
-  "Translation table for translating ISO 8859-1 characters to German TeX.")
-
-(defun iso-gtex2iso ()
- "Translate German TeX sequences to ISO 8859-1 characters."
- (interactive)
- (iso-translate-conventions iso-gtex2iso-trans-tab))
-
-
-(defun iso-iso2gtex ()
- "Translate ISO 8859-1 characters to German TeX sequences."
- (interactive)
- (iso-translate-conventions iso-iso2gtex-trans-tab))
-
-
-(defun iso-german-tex-p ()
- "Check if tex buffer is German LaTeX."
- (save-excursion
-   (save-restriction
-     (widen)
-     (goto-char (point-min))
-     (re-search-forward "\\\\documentstyle\\[.*german.*\\]" nil t))))
-
-(defun iso-fix-iso2tex ()
-  "Turn ISO 8859-1 (aka. ISO Latin-1) buffer into TeX sequences.
-If German TeX is used, German TeX sequences are generated."
-  (if (or (equal major-mode 'latex-mode)
-	  (equal major-mode 'LaTeX-mode)) ; AucTeX wants this
-      (if (iso-german-tex-p)
-	  (iso-iso2gtex)
-	(iso-iso2tex)))
-  (if (or (equal major-mode 'tex-mode)
-	  (equal major-mode 'TeX-mode) ; AucTeX wants this
-	  (equal major-mode 'plain-tex-mode))
-      (iso-iso2tex)))
-
-(defun iso-fix-tex2iso ()
-  "Turn TeX sequences into ISO 8859-1 (aka. ISO Latin-1) characters.
-This function recognizes German TeX buffers."
-  (if (or (equal major-mode 'latex-mode)
-	  (equal major-mode 'Latex-mode)) ; AucTeX wants this
-      (if (iso-german-tex-p)
-	  (iso-gtex2iso)
-	(iso-tex2iso)))
-  (if (or (equal major-mode 'tex-mode)
-	  (equal major-mode 'TeX-mode)  ; AucTeX wants this
-	  (equal major-mode 'plain-tex-mode))
-      (iso-tex2iso)))
-
-(defun iso-cvt-ffh ()
-  "find-file-hook for iso-cvt.el."
-  (iso-fix-tex2iso)
-  (set-buffer-modified-p nil))
-
-(defun iso-cvt-wfh ()
-  "write file hook for iso-cvt.el."
-  (iso-fix-iso2tex))
-
-(defun iso-cvt-ash ()
-  "after save hook for iso-cvt.el."
-  (iso-fix-tex2iso)
-  (set-buffer-modified-p nil))
-
-(add-hook 'find-file-hooks 'iso-cvt-ffh)
-(add-hook 'write-file-hooks 'iso-cvt-wfh)
-(add-hook 'after-save-hook 'iso-cvt-ash)
-
-;;; iso-cvt.el ends here
diff --git a/lisp/international/iso-insert.el b/lisp/international/iso-insert.el
deleted file mode 100644
index 870fc1afeea..00000000000
--- a/lisp/international/iso-insert.el
+++ /dev/null
@@ -1,629 +0,0 @@
-;;; iso-insert.el --- insert functions for ISO 8859/1.
-
-;; Copyright (C) 1987, 1994 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; 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:
-
-;; Written by Howard Gayle.  See case-table.el for details.
-
-;;; Code:
-
-(defun insert-no-break-space ()
-   (interactive "*")
-   (insert 160)
-)
-
-(defun insert-inverted-exclamation-mark ()
-   (interactive "*")
-   (insert 161)
-)
-
-(defun insert-cent-sign ()
-   (interactive "*")
-   (insert 162)
-)
-
-(defun insert-pound-sign ()
-   (interactive "*")
-   (insert 163)
-)
-
-(defun insert-general-currency-sign ()
-   (interactive "*")
-   (insert 164)
-)
-
-(defun insert-yen-sign ()
-   (interactive "*")
-   (insert 165)
-)
-
-(defun insert-broken-vertical-line ()
-   (interactive "*")
-   (insert 166)
-)
-
-(defun insert-section-sign ()
-   (interactive "*")
-   (insert 167)
-)
-
-(defun insert-diaeresis ()
-   (interactive "*")
-   (insert 168)
-)
-
-(defun insert-copyright-sign ()
-   (interactive "*")
-   (insert 169)
-)
-
-(defun insert-ordinal-indicator-feminine ()
-   (interactive "*")
-   (insert 170)
-)
-
-(defun insert-angle-quotation-mark-left ()
-   (interactive "*")
-   (insert 171)
-)
-
-(defun insert-not-sign ()
-   (interactive "*")
-   (insert 172)
-)
-
-(defun insert-soft-hyphen ()
-   (interactive "*")
-   (insert 173)
-)
-
-(defun insert-registered-sign ()
-   (interactive "*")
-   (insert 174)
-)
-
-(defun insert-macron ()
-   (interactive "*")
-   (insert 175)
-)
-
-(defun insert-degree-sign ()
-   (interactive "*")
-   (insert 176)
-)
-
-(defun insert-plus-or-minus-sign ()
-   (interactive "*")
-   (insert 177)
-)
-
-(defun insert-superscript-two ()
-   (interactive "*")
-   (insert 178)
-)
-
-(defun insert-superscript-three ()
-   (interactive "*")
-   (insert 179)
-)
-
-(defun insert-acute-accent ()
-   (interactive "*")
-   (insert 180)
-)
-
-(defun insert-micro-sign ()
-   (interactive "*")
-   (insert 181)
-)
-
-(defun insert-pilcrow ()
-   (interactive "*")
-   (insert 182)
-)
-
-(defun insert-middle-dot ()
-   (interactive "*")
-   (insert 183)
-)
-
-(defun insert-cedilla ()
-   (interactive "*")
-   (insert 184)
-)
-
-(defun insert-superscript-one ()
-   (interactive "*")
-   (insert 185)
-)
-
-(defun insert-ordinal-indicator-masculine ()
-   (interactive "*")
-   (insert 186)
-)
-
-(defun insert-angle-quotation-mark-right ()
-   (interactive "*")
-   (insert 187)
-)
-
-(defun insert-fraction-one-quarter ()
-   (interactive "*")
-   (insert 188)
-)
-
-(defun insert-fraction-one-half ()
-   (interactive "*")
-   (insert 189)
-)
-
-(defun insert-fraction-three-quarters ()
-   (interactive "*")
-   (insert 190)
-)
-
-(defun insert-inverted-question-mark ()
-   (interactive "*")
-   (insert 191)
-)
-
-(defun insert-A-grave ()
-   (interactive "*")
-   (insert 192)
-)
-
-(defun insert-A-acute ()
-   (interactive "*")
-   (insert 193)
-)
-
-(defun insert-A-circumflex ()
-   (interactive "*")
-   (insert 194)
-)
-
-(defun insert-A-tilde ()
-   (interactive "*")
-   (insert 195)
-)
-
-(defun insert-A-umlaut ()
-   (interactive "*")
-   (insert 196)
-)
-
-(defun insert-A-ring ()
-   (interactive "*")
-   (insert 197)
-)
-
-(defun insert-AE ()
-   (interactive "*")
-   (insert 198)
-)
-
-(defun insert-C-cedilla ()
-   (interactive "*")
-   (insert 199)
-)
-
-(defun insert-E-grave ()
-   (interactive "*")
-   (insert 200)
-)
-
-(defun insert-E-acute ()
-   (interactive "*")
-   (insert 201)
-)
-
-(defun insert-E-circumflex ()
-   (interactive "*")
-   (insert 202)
-)
-
-(defun insert-E-umlaut ()
-   (interactive "*")
-   (insert 203)
-)
-
-(defun insert-I-grave ()
-   (interactive "*")
-   (insert 204)
-)
-
-(defun insert-I-acute ()
-   (interactive "*")
-   (insert 205)
-)
-
-(defun insert-I-circumflex ()
-   (interactive "*")
-   (insert 206)
-)
-
-(defun insert-I-umlaut ()
-   (interactive "*")
-   (insert 207)
-)
-
-(defun insert-D-stroke ()
-   (interactive "*")
-   (insert 208)
-)
-
-(defun insert-N-tilde ()
-   (interactive "*")
-   (insert 209)
-)
-
-(defun insert-O-grave ()
-   (interactive "*")
-   (insert 210)
-)
-
-(defun insert-O-acute ()
-   (interactive "*")
-   (insert 211)
-)
-
-(defun insert-O-circumflex ()
-   (interactive "*")
-   (insert 212)
-)
-
-(defun insert-O-tilde ()
-   (interactive "*")
-   (insert 213)
-)
-
-(defun insert-O-umlaut ()
-   (interactive "*")
-   (insert 214)
-)
-
-(defun insert-multiplication-sign ()
-   (interactive "*")
-   (insert 215)
-)
-
-(defun insert-O-slash ()
-   (interactive "*")
-   (insert 216)
-)
-
-(defun insert-U-grave ()
-   (interactive "*")
-   (insert 217)
-)
-
-(defun insert-U-acute ()
-   (interactive "*")
-   (insert 218)
-)
-
-(defun insert-U-circumflex ()
-   (interactive "*")
-   (insert 219)
-)
-
-(defun insert-U-umlaut ()
-   (interactive "*")
-   (insert 220)
-)
-
-(defun insert-Y-acute ()
-   (interactive "*")
-   (insert 221)
-)
-
-(defun insert-THORN ()
-   (interactive "*")
-   (insert 222)
-)
-
-(defun insert-ss ()
-   (interactive "*")
-   (insert 223)
-)
-
-(defun insert-a-grave ()
-   (interactive "*")
-   (insert 224)
-)
-
-(defun insert-a-acute ()
-   (interactive "*")
-   (insert 225)
-)
-
-(defun insert-a-circumflex ()
-   (interactive "*")
-   (insert 226)
-)
-
-(defun insert-a-tilde ()
-   (interactive "*")
-   (insert 227)
-)
-
-(defun insert-a-umlaut ()
-   (interactive "*")
-   (insert 228)
-)
-
-(defun insert-a-ring ()
-   (interactive "*")
-   (insert 229)
-)
-
-(defun insert-ae ()
-   (interactive "*")
-   (insert 230)
-)
-
-(defun insert-c-cedilla ()
-   (interactive "*")
-   (insert 231)
-)
-
-(defun insert-e-grave ()
-   (interactive "*")
-   (insert 232)
-)
-
-(defun insert-e-acute ()
-   (interactive "*")
-   (insert 233)
-)
-
-(defun insert-e-circumflex ()
-   (interactive "*")
-   (insert 234)
-)
-
-(defun insert-e-umlaut ()
-   (interactive "*")
-   (insert 235)
-)
-
-(defun insert-i-grave ()
-   (interactive "*")
-   (insert 236)
-)
-
-(defun insert-i-acute ()
-   (interactive "*")
-   (insert 237)
-)
-
-(defun insert-i-circumflex ()
-   (interactive "*")
-   (insert 238)
-)
-
-(defun insert-i-umlaut ()
-   (interactive "*")
-   (insert 239)
-)
-
-(defun insert-d-stroke ()
-   (interactive "*")
-   (insert 240)
-)
-
-(defun insert-n-tilde ()
-   (interactive "*")
-   (insert 241)
-)
-
-(defun insert-o-grave ()
-   (interactive "*")
-   (insert 242)
-)
-
-(defun insert-o-acute ()
-   (interactive "*")
-   (insert 243)
-)
-
-(defun insert-o-circumflex ()
-   (interactive "*")
-   (insert 244)
-)
-
-(defun insert-o-tilde ()
-   (interactive "*")
-   (insert 245)
-)
-
-(defun insert-o-umlaut ()
-   (interactive "*")
-   (insert 246)
-)
-
-(defun insert-division-sign ()
-   (interactive "*")
-   (insert 247)
-)
-
-(defun insert-o-slash ()
-   (interactive "*")
-   (insert 248)
-)
-
-(defun insert-u-grave ()
-   (interactive "*")
-   (insert 249)
-)
-
-(defun insert-u-acute ()
-   (interactive "*")
-   (insert 250)
-)
-
-(defun insert-u-circumflex ()
-   (interactive "*")
-   (insert 251)
-)
-
-(defun insert-u-umlaut ()
-   (interactive "*")
-   (insert 252)
-)
-
-(defun insert-y-acute ()
-   (interactive "*")
-   (insert 253)
-)
-
-(defun insert-thorn ()
-   (interactive "*")
-   (insert 254)
-)
-
-(defun insert-y-umlaut ()
-   (interactive "*")
-   (insert 255)
-)
-
-(defvar 8859-1-map nil "Keymap for ISO 8859/1 character insertion.")
-(if 8859-1-map nil
-   (setq 8859-1-map (make-keymap))
-   (define-key 8859-1-map " "    'insert-no-break-space)
-   (define-key 8859-1-map "!"    'insert-inverted-exclamation-mark)
-   (define-key 8859-1-map "\""   (make-sparse-keymap))
-   (define-key 8859-1-map "\"\"" 'insert-diaeresis)
-   (define-key 8859-1-map "\"A"  'insert-A-umlaut)
-   (define-key 8859-1-map "\"E"  'insert-E-umlaut)
-   (define-key 8859-1-map "\"I"  'insert-I-umlaut)
-   (define-key 8859-1-map "\"O"  'insert-O-umlaut)
-   (define-key 8859-1-map "\"U"  'insert-U-umlaut)
-   (define-key 8859-1-map "\"a"  'insert-a-umlaut)
-   (define-key 8859-1-map "\"e"  'insert-e-umlaut)
-   (define-key 8859-1-map "\"i"  'insert-i-umlaut)
-   (define-key 8859-1-map "\"o"  'insert-o-umlaut)
-   (define-key 8859-1-map "\"u"  'insert-u-umlaut)
-   (define-key 8859-1-map "\"y"  'insert-y-umlaut)
-   (define-key 8859-1-map "'"    (make-sparse-keymap))
-   (define-key 8859-1-map "''"   'insert-acute-accent)
-   (define-key 8859-1-map "'A"   'insert-A-acute)
-   (define-key 8859-1-map "'E"   'insert-E-acute)
-   (define-key 8859-1-map "'I"   'insert-I-acute)
-   (define-key 8859-1-map "'O"   'insert-O-acute)
-   (define-key 8859-1-map "'U"   'insert-U-acute)
-   (define-key 8859-1-map "'Y"   'insert-Y-acute)
-   (define-key 8859-1-map "'a"   'insert-a-acute)
-   (define-key 8859-1-map "'e"   'insert-e-acute)
-   (define-key 8859-1-map "'i"   'insert-i-acute)
-   (define-key 8859-1-map "'o"   'insert-o-acute)
-   (define-key 8859-1-map "'u"   'insert-u-acute)
-   (define-key 8859-1-map "'y"   'insert-y-acute)
-   (define-key 8859-1-map "$"    'insert-general-currency-sign)
-   (define-key 8859-1-map "+"    'insert-plus-or-minus-sign)
-   (define-key 8859-1-map ","    (make-sparse-keymap))
-   (define-key 8859-1-map ",,"   'insert-cedilla)
-   (define-key 8859-1-map ",C"   'insert-C-cedilla)
-   (define-key 8859-1-map ",c"   'insert-c-cedilla)
-   (define-key 8859-1-map "-"    'insert-soft-hyphen)
-   (define-key 8859-1-map "."    'insert-middle-dot)
-   (define-key 8859-1-map "/"    (make-sparse-keymap))
-   (define-key 8859-1-map "//"   'insert-division-sign)
-   (define-key 8859-1-map "/O"   'insert-O-slash)
-   (define-key 8859-1-map "/o"   'insert-o-slash)
-   (define-key 8859-1-map "1"    (make-sparse-keymap))
-   (define-key 8859-1-map "1/"   (make-sparse-keymap))
-   (define-key 8859-1-map "1/2"  'insert-fraction-one-half)
-   (define-key 8859-1-map "1/4"  'insert-fraction-one-quarter)
-   (define-key 8859-1-map "3"    (make-sparse-keymap))
-   (define-key 8859-1-map "3/"   (make-sparse-keymap))
-   (define-key 8859-1-map "3/4"  'insert-fraction-three-quarters)
-   (define-key 8859-1-map "<"    'insert-angle-quotation-mark-left)
-   (define-key 8859-1-map "="    'insert-macron)
-   (define-key 8859-1-map ">"    'insert-angle-quotation-mark-right)
-   (define-key 8859-1-map "?"    'insert-inverted-question-mark)
-   (define-key 8859-1-map "A"    'insert-A-ring)
-   (define-key 8859-1-map "E"    'insert-AE)
-   (define-key 8859-1-map "C"    'insert-copyright-sign)
-   (define-key 8859-1-map "D"    'insert-D-stroke)
-   (define-key 8859-1-map "L"    'insert-pound-sign)
-   (define-key 8859-1-map "P"    'insert-pilcrow)
-   (define-key 8859-1-map "R"    'insert-registered-sign)
-   (define-key 8859-1-map "S"    'insert-section-sign)
-   (define-key 8859-1-map "T"    'insert-THORN)
-   (define-key 8859-1-map "Y"    'insert-yen-sign)
-   (define-key 8859-1-map "^"    (make-sparse-keymap))
-   (define-key 8859-1-map "^1"   'insert-superscript-one)
-   (define-key 8859-1-map "^2"   'insert-superscript-two)
-   (define-key 8859-1-map "^3"   'insert-superscript-three)
-   (define-key 8859-1-map "^A"   'insert-A-circumflex)
-   (define-key 8859-1-map "^E"   'insert-E-circumflex)
-   (define-key 8859-1-map "^I"   'insert-I-circumflex)
-   (define-key 8859-1-map "^O"   'insert-O-circumflex)
-   (define-key 8859-1-map "^U"   'insert-U-circumflex)
-   (define-key 8859-1-map "^a"   'insert-a-circumflex)
-   (define-key 8859-1-map "^e"   'insert-e-circumflex)
-   (define-key 8859-1-map "^i"   'insert-i-circumflex)
-   (define-key 8859-1-map "^o"   'insert-o-circumflex)
-   (define-key 8859-1-map "^u"   'insert-u-circumflex)
-   (define-key 8859-1-map "_"    (make-sparse-keymap))
-   (define-key 8859-1-map "_a"   'insert-ordinal-indicator-feminine)
-   (define-key 8859-1-map "_o"   'insert-ordinal-indicator-masculine)
-   (define-key 8859-1-map "`"    (make-sparse-keymap))
-   (define-key 8859-1-map "`A"   'insert-A-grave)
-   (define-key 8859-1-map "`E"   'insert-E-grave)
-   (define-key 8859-1-map "`I"   'insert-I-grave)
-   (define-key 8859-1-map "`O"   'insert-O-grave)
-   (define-key 8859-1-map "`U"   'insert-U-grave)
-   (define-key 8859-1-map "`a"   'insert-a-grave)
-   (define-key 8859-1-map "`e"   'insert-e-grave)
-   (define-key 8859-1-map "`i"   'insert-i-grave)
-   (define-key 8859-1-map "`o"   'insert-o-grave)
-   (define-key 8859-1-map "`u"   'insert-u-grave)
-   (define-key 8859-1-map "a"    'insert-a-ring)
-   (define-key 8859-1-map "e"    'insert-ae)
-   (define-key 8859-1-map "c"    'insert-cent-sign)
-   (define-key 8859-1-map "d"    'insert-d-stroke)
-   (define-key 8859-1-map "o"    'insert-degree-sign)
-   (define-key 8859-1-map "s"    'insert-ss)
-   (define-key 8859-1-map "t"    'insert-thorn)
-   (define-key 8859-1-map "u"    'insert-micro-sign)
-   (define-key 8859-1-map "x"    'insert-multiplication-sign)
-   (define-key 8859-1-map "|"    'insert-broken-vertical-line)
-   (define-key 8859-1-map "~"    (make-sparse-keymap))
-   (define-key 8859-1-map "~A"   'insert-A-tilde)
-   (define-key 8859-1-map "~N"   'insert-N-tilde)
-   (define-key 8859-1-map "~O"   'insert-O-tilde)
-   (define-key 8859-1-map "~a"   'insert-a-tilde)
-   (define-key 8859-1-map "~n"   'insert-n-tilde)
-   (define-key 8859-1-map "~o"   'insert-o-tilde)
-   (define-key 8859-1-map "~~"   'insert-not-sign)
-   (if (not (lookup-key global-map "\C-x8"))
-      (define-key global-map "\C-x8" 8859-1-map))
-)
-
-(provide 'iso-insert)
-
-;;; iso-insert.el ends here
diff --git a/lisp/international/iso-swed.el b/lisp/international/iso-swed.el
deleted file mode 100644
index 30ede7c30de..00000000000
--- a/lisp/international/iso-swed.el
+++ /dev/null
@@ -1,151 +0,0 @@
-;;; iso-swed.el --- set up char tables for ISO 8859/1 for Swedish/Finnish ttys
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; 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:
-
-;; Written by Howard Gayle.  See case-table.el for details.
-
-;;; Code:
-
-;; This code sets up to display ISO 8859/1 characters on
-;; terminals that have ASCII in the G0 set and a Swedish/Finnish
-;; version of ISO 646 in the G1 set.  The G1 set differs from
-;; ASCII as follows:
-;; 
-;; ASCII G1
-;;     $ general currency sign
-;;     @ capital E with acute accent
-;;     [ capital A with diaeresis or umlaut mark
-;;     \ capital O with diaeresis or umlaut mark
-;;     ] capital A with ring
-;;     ^ capital U with diaeresis or umlaut mark
-;;     ` small e with acute accent
-;;     { small a with diaeresis or umlaut mark
-;;     | small o with diaeresis or umlaut mark
-;;     } small a with ring
-;;     ~ small u with diaeresis or umlaut mark
-
-(require 'disp-table)
-
-(standard-display-ascii 160 "{_}")   ; NBSP (no-break space)
-(standard-display-ascii 161 "{!}")   ; inverted exclamation mark
-(standard-display-ascii 162 "{c}")   ; cent sign
-(standard-display-ascii 163 "{GBP}") ; pound sign
-(standard-display-g1    164 ?$)      ; general currency sign
-(standard-display-ascii 165 "{JPY}") ; yen sign
-(standard-display-ascii 166 "{|}")   ; broken vertical line
-(standard-display-ascii 167 "{S}")   ; section sign
-(standard-display-ascii 168 "{\"}")  ; diaeresis
-(standard-display-ascii 169 "{C}")   ; copyright sign
-(standard-display-ascii 170 "{_a}")  ; ordinal indicator, feminine
-(standard-display-ascii 171 "{<<}")  ; left angle quotation mark
-(standard-display-ascii 172 "{~}")   ; not sign
-(standard-display-ascii 173 "{-}")   ; soft hyphen
-(standard-display-ascii 174 "{R}")   ; registered sign
-(standard-display-ascii 175 "{=}")   ; macron
-(standard-display-ascii 176 "{o}")   ; degree sign
-(standard-display-ascii 177 "{+-}")  ; plus or minus sign
-(standard-display-ascii 178 "{2}")   ; superscript two
-(standard-display-ascii 179 "{3}")   ; superscript three
-(standard-display-ascii 180 "{'}")   ; acute accent
-(standard-display-ascii 181 "{u}")   ; micro sign
-(standard-display-ascii 182 "{P}")   ; pilcrow
-(standard-display-ascii 183 "{.}")   ; middle dot
-(standard-display-ascii 184 "{,}")   ; cedilla
-(standard-display-ascii 185 "{1}")   ; superscript one
-(standard-display-ascii 186 "{_o}")  ; ordinal indicator, masculine
-(standard-display-ascii 187 "{>>}")  ; right angle quotation mark
-(standard-display-ascii 188 "{1/4}") ; fraction one-quarter
-(standard-display-ascii 189 "{1/2}") ; fraction one-half
-(standard-display-ascii 190 "{3/4}") ; fraction three-quarters
-(standard-display-ascii 191 "{?}")   ; inverted question mark
-(standard-display-ascii 192 "{`A}")  ; A with grave accent
-(standard-display-ascii 193 "{'A}")  ; A with acute accent
-(standard-display-ascii 194 "{^A}")  ; A with circumflex accent
-(standard-display-ascii 195 "{~A}")  ; A with tilde
-(standard-display-g1    196 ?[)      ; A with diaeresis or umlaut mark
-(standard-display-g1    197 ?])      ; A with ring
-(standard-display-ascii 198 "{AE}")  ; AE diphthong
-(standard-display-ascii 199 "{,C}")  ; C with cedilla
-(standard-display-ascii 200 "{`E}")  ; E with grave accent
-(standard-display-g1    201 ?@)      ; E with acute accent
-(standard-display-ascii 202 "{^E}")  ; E with circumflex accent
-(standard-display-ascii 203 "{\"E}") ; E with diaeresis or umlaut mark
-(standard-display-ascii 204 "{`I}")  ; I with grave accent
-(standard-display-ascii 205 "{'I}")  ; I with acute accent
-(standard-display-ascii 206 "{^I}")  ; I with circumflex accent
-(standard-display-ascii 207 "{\"I}") ; I with diaeresis or umlaut mark
-(standard-display-ascii 208 "{-D}")  ; D with stroke, Icelandic eth
-(standard-display-ascii 209 "{~N}")  ; N with tilde
-(standard-display-ascii 210 "{`O}")  ; O with grave accent
-(standard-display-ascii 211 "{'O}")  ; O with acute accent
-(standard-display-ascii 212 "{^O}")  ; O with circumflex accent
-(standard-display-ascii 213 "{~O}")  ; O with tilde
-(standard-display-g1    214 ?\\)     ; O with diaeresis or umlaut mark
-(standard-display-ascii 215 "{x}")   ; multiplication sign
-(standard-display-ascii 216 "{/O}")  ; O with slash
-(standard-display-ascii 217 "{`U}")  ; U with grave accent
-(standard-display-ascii 218 "{'U}")  ; U with acute accent
-(standard-display-ascii 219 "{^U}")  ; U with circumflex accent
-(standard-display-g1    220 ?^)      ; U with diaeresis or umlaut mark
-(standard-display-ascii 221 "{'Y}")  ; Y with acute accent
-(standard-display-ascii 222 "{TH}")  ; capital thorn, Icelandic
-(standard-display-ascii 223 "{ss}")  ; small sharp s, German
-(standard-display-ascii 224 "{`a}")  ; a with grave accent
-(standard-display-ascii 225 "{'a}")  ; a with acute accent
-(standard-display-ascii 226 "{^a}")  ; a with circumflex accent
-(standard-display-ascii 227 "{~a}")  ; a with tilde
-(standard-display-g1    228 ?{)      ; a with diaeresis or umlaut mark
-(standard-display-g1    229 ?})      ; a with ring
-(standard-display-ascii 230 "{ae}")  ; ae diphthong
-(standard-display-ascii 231 "{,c}")  ; c with cedilla
-(standard-display-ascii 232 "{`e}")  ; e with grave accent
-(standard-display-g1    233 ?`)      ; e with acute accent
-(standard-display-ascii 234 "{^e}")  ; e with circumflex accent
-(standard-display-ascii 235 "{\"e}") ; e with diaeresis or umlaut mark
-(standard-display-ascii 236 "{`i}")  ; i with grave accent
-(standard-display-ascii 237 "{'i}")  ; i with acute accent
-(standard-display-ascii 238 "{^i}")  ; i with circumflex accent
-(standard-display-ascii 239 "{\"i}") ; i with diaeresis or umlaut mark
-(standard-display-ascii 240 "{-d}")  ; d with stroke, Icelandic eth
-(standard-display-ascii 241 "{~n}")  ; n with tilde
-(standard-display-ascii 242 "{`o}")  ; o with grave accent
-(standard-display-ascii 243 "{'o}")  ; o with acute accent
-(standard-display-ascii 244 "{^o}")  ; o with circumflex accent
-(standard-display-ascii 245 "{~o}")  ; o with tilde
-(standard-display-g1    246 ?|)      ; o with diaeresis or umlaut mark
-(standard-display-ascii 247 "{/}")   ; division sign
-(standard-display-ascii 248 "{/o}")  ; o with slash
-(standard-display-ascii 249 "{`u}")  ; u with grave accent
-(standard-display-ascii 250 "{'u}")  ; u with acute accent
-(standard-display-ascii 251 "{^u}")  ; u with circumflex accent
-(standard-display-g1    252 ?~)      ; u with diaeresis or umlaut mark
-(standard-display-ascii 253 "{'y}")  ; y with acute accent
-(standard-display-ascii 254 "{th}")  ; small thorn, Icelandic
-(standard-display-ascii 255 "{\"y}") ; small y with diaeresis or umlaut mark
-
-(provide 'iso-swed)
-
-;;; iso-swed.el ends here
diff --git a/lisp/international/iso-transl.el b/lisp/international/iso-transl.el
deleted file mode 100644
index 4b39ccea632..00000000000
--- a/lisp/international/iso-transl.el
+++ /dev/null
@@ -1,259 +0,0 @@
-;;; iso-transl.el --- keyboard input definitions for ISO 8859/1.
-
-;; Copyright (C) 1987, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; 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:
-
-;; Loading this package defines three ways of entering the non-ASCII
-;; printable characters with codes above 127: the prefix C-x 8, or the
-;; Alt key, or a dead accent key.  For example, you can enter uppercase
-;; A-umlaut as `C-x 8 " A' or `Alt-" A' (if you have an Alt key) or
-;; `umlaut A' (if you have an umlaut/diaeresis key).
-
-;;; Code:
-
-(defvar iso-transl-dead-key-alist
-  '((?\' . mute-acute)
-    (?\` . mute-grave)
-    (?\" . mute-diaeresis)
-    (?^ . mute-asciicircum)
-    (?\~ . mute-asciitilde)
-    (?\' . dead-acute)
-    (?\` . dead-grave)
-    (?\" . dead-diaeresis)
-    (?^ . dead-asciicircum)
-    (?\~ . dead-asciitilde)
-    (?^ . dead-circum)
-    (?^ . dead-circumflex)
-    (?\~ . dead-tilde)
-    ;; Someone reports that these keys don't work if shifted.
-    ;; This might fix it--no word yet.
-    (?\' . S-dead-acute)
-    (?\` . S-dead-grave)
-    (?\" . S-dead-diaeresis)
-    (?^ . S-dead-asciicircum)
-    (?\~ . S-dead-asciitilde)
-    (?^ . S-dead-circum)
-    (?^ . S-dead-circumflex)
-    (?\~ . S-dead-tilde))
-  "Mapping of ASCII characters to their corresponding dead-key symbols.")
-
-;; The two-character mnemonics are intended to be available in all languages.
-;; The ones beginning with `*' have one-character synonyms, but a
-;; language-specific table might override the short form for its own use.
-(defvar iso-transl-char-map
-  '(("* "   . [160])(" "   . [160])
-    ("*!"   . [161])("!"   . [161])
-    ("\"\"" . [168])
-    ("\"A"  . [196])
-    ("\"E"  . [203])
-    ("\"I"  . [207])
-    ("\"O"  . [214])
-    ("\"U"  . [220])
-    ("\"a"  . [228])
-    ("\"e"  . [235])
-    ("\"i"  . [239])
-    ("\"o"  . [246])
-    ("\"s"  . [223])
-    ("\"u"  . [252])
-    ("\"y"  . [255])
-    ("''"   . [180])
-    ("'A"   . [193])
-    ("'E"   . [201])
-    ("'I"   . [205])
-    ("'O"   . [211])
-    ("'U"   . [218])
-    ("'Y"   . [221])
-    ("'a"   . [225])
-    ("'e"   . [233])
-    ("'i"   . [237])
-    ("'o"   . [243])
-    ("'u"   . [250])
-    ("'y"   . [253])
-    ("*$"   . [164])("$"   . [164])
-    ("*+"   . [177])("+"   . [177])
-    (",,"   . [184])
-    (",C"   . [199])
-    (",c"   . [231])
-    ("*-"   . [173])("-"   . [173])
-    ("*."   . [183])("."   . [183])
-    ("//"   . [247])
-    ("/A"   . [197])
-    ("/E"   . [198])
-    ("/O"   . [216])
-    ("/a"   . [229])
-    ("/e"   . [230])
-    ("/o"   . [248])
-    ("1/2"  . [189])
-    ("1/4"  . [188])
-    ("3/4"  . [190])
-    ("*<"   . [171])("<"   . [171])
-    ("*="   . [175])("="   . [175])
-    ("*>"   . [187])(">"   . [187])
-    ("*?"   . [191])("?"   . [191])
-    ("*C"   . [169])("C"   . [169])
-    ("*L"   . [163])("L"   . [163])
-    ("*P"   . [182])("P"   . [182])
-    ("*R"   . [174])("R"   . [174])
-    ("*S"   . [167])("S"   . [167])
-    ("*Y"   . [165])("Y"   . [165])
-    ("^1"   . [185])
-    ("^2"   . [178])
-    ("^3"   . [179])
-    ("^A"   . [194])
-    ("^E"   . [202])
-    ("^I"   . [206])
-    ("^O"   . [212])
-    ("^U"   . [219])
-    ("^a"   . [226])
-    ("^e"   . [234])
-    ("^i"   . [238])
-    ("^o"   . [244])
-    ("^u"   . [251])
-    ("_a"   . [170])
-    ("_o"   . [186])
-    ("`A"   . [192])
-    ("`E"   . [200])
-    ("`I"   . [204])
-    ("`O"   . [210])
-    ("`U"   . [217])
-    ("`a"   . [224])
-    ("`e"   . [232])
-    ("`i"   . [236])
-    ("`o"   . [242])
-    ("`u"   . [249])
-    ("*c"   . [162])("c"   . [162])
-    ("*o"   . [176])("o"   . [176])
-    ("*u"   . [181])("u"   . [181])
-    ("*m"   . [181])("m"   . [181])
-    ("*x"   . [215])("x"   . [215])
-    ("*|"   . [166])("|"   . [166])
-    ("~A"   . [195])
-    ("~D"   . [208])
-    ("~N"   . [209])
-    ("~O"   . [213])
-    ("~T"   . [222])
-    ("~a"   . [227])
-    ("~d"   . [240])
-    ("~n"   . [241])
-    ("~o"   . [245])
-    ("~t"   . [254])
-    ("~~"   . [172])
-    ("' "   . "'")
-    ("` "   . "`")
-    ("\" "  . "\"")
-    ("^ "   . "^")
-    ("~ "   . "~"))
-  "Alist of character translations for entering ISO characters.
-Each element has the form (STRING . VECTOR).
-The sequence STRING of ASCII chars translates into the
-sequence VECTOR.  (VECTOR is normally one character long.)")
-
-;; Language-specific translation lists.
-(defvar iso-transl-language-alist
-  '(("Esperanto"
-     ("C"  . [198])
-     ("G"  . [216])
-     ("H"  . [166])
-     ("J"  . [172])
-     ("S"  . [222])
-     ("U"  . [221])
-     ("c"  . [230])
-     ("g"  . [248])
-     ("h"  . [182])
-     ("j"  . [188])
-     ("s"  . [254])
-     ("u"  . [253]))
-    ("French"
-     ("C"  . [199])
-     ("c"  . [231]))
-    ("German"
-     ("A"  . [196])
-     ("O"  . [214]) 
-     ("U"  . [220])
-     ("a"  . [228])
-     ("o"  . [246])
-     ("s"  . [223])
-     ("u"  . [252]))
-    ("Portuguese"
-     ("C"  . [199])
-     ("c"  . [231]))
-    ("Spanish"
-     ("!"  . [161])
-     ("?"  . [191])
-     ("N"  . [241])
-     ("n"  . [209]))))
-
-(defvar iso-transl-ctl-x-8-map nil
-  "Keymap for C-x 8 prefix.")
-(or iso-transl-ctl-x-8-map
-    (setq iso-transl-ctl-x-8-map (make-sparse-keymap)))
-(or key-translation-map
-    (setq key-translation-map (make-sparse-keymap)))
-(define-key key-translation-map "\C-x8" iso-transl-ctl-x-8-map)
-
-;; For each entry in the alist, we'll make up to three ways to generate
-;; the character in question: the prefix `C-x 8'; the ALT modifier on
-;; the first key of the sequence; and (if applicable) replacing the first
-;; key of the sequence with the corresponding dead key.  For example, a
-;; character associated with the string "~n" can be input with `C-x 8 ~ n'
-;; or `Alt-~ n' or `mute-asciitilde n'.
-(defun iso-transl-define-keys (alist)
-  (while alist
-    (define-key iso-transl-ctl-x-8-map (car (car alist)) (cdr (car alist)))
-    (let ((inchar (aref (car (car alist)) 0))
-	  (vec (vconcat (car (car alist))))
-	  (tail iso-transl-dead-key-alist))
-      (aset vec 0 (logior (aref vec 0) ?\A-\^@))
-      (define-key key-translation-map vec (cdr (car alist)))
-      (define-key isearch-mode-map (vector (aref vec 0)) nil)
-      (while tail
-	(if (eq (car (car tail)) inchar)
-	    (let ((deadvec (copy-sequence vec))
-		  (deadkey (cdr (car tail))))
-	      (aset deadvec 0 deadkey)
-	      (define-key isearch-mode-map (vector deadkey) nil)
-	      (define-key key-translation-map deadvec (cdr (car alist)))))
-	(setq tail (cdr tail))))
-    (setq alist (cdr alist))))
-
-(defun iso-transl-set-language (lang)
-  (interactive (list (let ((completion-ignore-case t))
-		       (completing-read "Set which language? "
-					iso-transl-language-alist nil t))))
-  (iso-transl-define-keys (cdr (assoc lang iso-transl-language-alist))))
-
-
-;; The standard mapping comes automatically.  You can partially overlay it
-;; with a language-specific mapping by using `M-x iso-transl-set-language'.
-(iso-transl-define-keys iso-transl-char-map)
-
-(define-key isearch-mode-map "\C-x" nil)
-(define-key isearch-mode-map [?\C-x t] 'isearch-other-control-char)
-(define-key isearch-mode-map "\C-x8" nil)
-
-
-(provide 'iso-transl)
-
-;;; iso-transl.el ends here
diff --git a/lisp/international/latin-2.el b/lisp/international/latin-2.el
deleted file mode 100644
index 62029cdb9b2..00000000000
--- a/lisp/international/latin-2.el
+++ /dev/null
@@ -1,94 +0,0 @@
-;;; iso02-syn.el --- set up case-conversion and syntax tables for ISO 8859-2
-;;;                   (ISO latin2, i.e. East Block character set)
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Michael Gschwind (mike@vlsivie.tuwien.ac.at)
-;; Keywords: i18n
-
-;; 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:
-
-;; Written by Michael Gschwind.  See case-table.el for details.
-
-;;; Code:
-
-(require 'case-table)
-
-(let ((downcase (standard-case-table)))
-  (set-case-syntax 160 " " downcase)	  ; NBSP (no-break space)
-  (set-case-syntax-pair 161 177 downcase) ; A with hook
-  (set-case-syntax 162 "w" downcase)	  ; u accent
-  (set-case-syntax-pair 163 179 downcase) ; L with slash
-  (set-case-syntax 164 "w" downcase)	  ; general currency sign
-  (set-case-syntax-pair 165 181 downcase) ; L with v
-  (set-case-syntax-pair 166 182 downcase) ; S with acute accent
-  (set-case-syntax 167 "w" downcase)	  ; section sign
-  (set-case-syntax 168 "w" downcase)	  ; diaeresis
-  (set-case-syntax-pair 169 185 downcase) ; S with v
-  (set-case-syntax-pair 170 186 downcase) ; S with cedilla
-  (set-case-syntax-pair 171 187 downcase) ; T with v
-  (set-case-syntax-pair 172 188 downcase) ; Z with acute accent
-  (set-case-syntax 173 "_" downcase)	  ; soft hyphen
-  (set-case-syntax-pair 174 190 downcase) ; Z with v
-  (set-case-syntax-pair 175 191 downcase) ; Z with dot
-  (set-case-syntax 176 "_" downcase)	; degree sign
-  (set-case-syntax 178 "w" downcase)	; hook accent
-  (set-case-syntax 180 "w" downcase)	; acute accent
-  (set-case-syntax 183 "_" downcase)	; v accent
-  (set-case-syntax 184 "w" downcase)	; cedilla
-  (set-case-syntax 189 "w" downcase)	; Hungarian '' accent
-  (set-case-syntax-pair 192 224 downcase) ; R with acute accent
-  (set-case-syntax-pair 193 225 downcase) ; A with acute accent
-  (set-case-syntax-pair 194 226 downcase) ; A with circumflex accent
-  (set-case-syntax-pair 195 227 downcase) ; A with u accent
-  (set-case-syntax-pair 196 228 downcase) ; A with diaeresis or umlaut mark
-  (set-case-syntax-pair 197 229 downcase) ; L with acute accent
-  (set-case-syntax-pair 198 230 downcase) ; C with acute accent
-  (set-case-syntax-pair 199 231 downcase) ; C with cedilla
-  (set-case-syntax-pair 200 232 downcase) ; C with v accent
-  (set-case-syntax-pair 201 233 downcase) ; E with acute accent
-  (set-case-syntax-pair 202 234 downcase) ; E with hook
-  (set-case-syntax-pair 203 235 downcase) ; E with diaeresis 
-  (set-case-syntax-pair 204 236 downcase) ; E with v accent
-  (set-case-syntax-pair 205 237 downcase) ; I with acute accent
-  (set-case-syntax-pair 206 238 downcase) ; I with circumflex accent
-  (set-case-syntax-pair 207 239 downcase) ; D with v accent
-  (set-case-syntax-pair 208 240 downcase) ; D with stroke
-  (set-case-syntax-pair 209 241 downcase) ; N with acute accent
-  (set-case-syntax-pair 210 242 downcase) ; N with v accent
-  (set-case-syntax-pair 211 243 downcase) ; O with acute accent
-  (set-case-syntax-pair 212 244 downcase) ; O with circumflex accent
-  (set-case-syntax-pair 213 245 downcase) ; O with Hungarian accent
-  (set-case-syntax-pair 214 246 downcase) ; O with diaeresis or umlaut mark
-  (set-case-syntax 215 "_" downcase)	; multiplication sign
-  (set-case-syntax-pair 216 248 downcase) ; R with v accent
-  (set-case-syntax-pair 217 249 downcase) ; U with ring
-  (set-case-syntax-pair 218 250 downcase) ; U with acute accent
-  (set-case-syntax-pair 219 251 downcase) ; U with Hungaraian accent
-  (set-case-syntax-pair 220 252 downcase) ; U with diaeresis or umlaut mark
-  (set-case-syntax-pair 221 253 downcase) ; Y with acute accent
-  (set-case-syntax-pair 222 254 downcase) ; T with hook
-  (set-case-syntax 223 "w" downcase)	; small sharp s, German
-  (set-case-syntax 247 "_" downcase)	; division sign
-  (set-case-syntax 255 "w" downcase)	; dot accent
-)
-
-(provide 'iso02-syn)
-
-;;; iso-syntax.el ends here
diff --git a/lisp/international/swedish.el b/lisp/international/swedish.el
deleted file mode 100644
index b3b73a41f48..00000000000
--- a/lisp/international/swedish.el
+++ /dev/null
@@ -1,154 +0,0 @@
-;;; swedish.el --- miscellaneous functions for dealing with Swedish.
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: i18n
-
-;; 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.
-
-;;; Code:
-
-;; Written by Howard Gayle.  See case-table.el for details.
-
-;; See iso-swed.el for a description of the character set.
-
-(require 'iso-syntax)
-
-(defvar swedish-re
-  "[ \t\n]\\(och\\|att\\|en\\|{r\\|\\[R\\|p}\\|P\\]\\|som\\|det\\|av\\|den\\|f|r\\|F\\\\R\\)[ \t\n.,?!:;'\")}]"
-  "Regular expression for common Swedish words.")
-
-(defvar swascii-to-8859-trans
-  (let ((string (make-string 256 ? ))
-	(i 0))
-    (while (< i 256)
-      (aset string i i)
-      (setq i (1+ i)))
-    (aset string ?\[ 196)
-    (aset string ?\] 197)
-    (aset string ?\\ 214)
-    (aset string ?^ 220)
-    (aset string ?\{ 228)
-    (aset string ?\} 229)
-    (aset string ?\` 233)
-    (aset string ?\| 246)
-    (aset string ?~ 252)
-    string)
-  "Trans table from SWASCII to 8859.")
-
-; $ is not converted because it almost always means US
-; dollars, not general currency sign.  @ is not converted
-; because it is more likely to be an at sign in a mail address
-; than an E with acute accent.
-
-(defun swascii-to-8859-buffer ()
-  "Convert characters in buffer from Swedish/Finnish-ascii to ISO 8859/1.
-Works even on read-only buffers.  `$' and `@' are not converted."
-  (interactive)
-  (let  ((buffer-read-only nil))
-    (translate-region (point-min) (point-max) swascii-to-8859-trans)))
-
-(defun swascii-to-8859-buffer-maybe ()
-  "Call swascii-to-8859-buffer if the buffer looks like Swedish-ascii.
-Leaves point just after the word that looks Swedish."
-  (interactive)
-  (let ((case-fold-search t))
-    (if (re-search-forward swedish-re nil t)
-	(swascii-to-8859-buffer))))
-
-(setq rmail-show-message-hook 'swascii-to-8859-buffer-maybe)
-
-(or (boundp 'news-group-hook-alist) (setq news-group-hook-alist nil))
-(setq news-group-hook-alist
-      (append '(("^swnet." . swascii-to-8859-buffer-maybe))
-	      news-group-hook-alist))
-
-(defvar 8859-to-swascii-trans
-  (let ((string (make-string 256 ? ))
-	(i 0))
-    (while (< i 256)
-      (aset string i i)
-      (setq i (1+ i)))
-    (aset string 164 ?$)
-    (aset string 196 ?\[)
-    (aset string 197 ?\])
-    (aset string 201 ?@)
-    (aset string 214 ?\\)
-    (aset string 220 ?^)
-    (aset string 228 ?\{)
-    (aset string 229 ?\})
-    (aset string 233 ?\`)
-    (aset string 246 ?\|)
-    (aset string 252 ?~)
-    string)
-  "8859 to SWASCII trans table.")
-
-(defun 8859-to-swascii-buffer ()
-   "Convert characters in buffer from ISO 8859/1 to Swedish/Finnish-ascii."
-   (interactive "*")
-   (translate-region (point-min) (point-max) 8859-to-swascii-trans))
-
-(setq mail-send-hook  '8859-to-swascii-buffer)
-(setq news-inews-hook '8859-to-swascii-buffer)
-
-;; It's not clear what purpose is served by a separate
-;; Swedish mode that differs from Text mode only in having
-;; a separate abbrev table.  Nothing says that the abbrevs you
-;; define in Text mode have to be English!
-
-;(defvar swedish-mode-abbrev-table nil
-;   "Abbrev table used while in swedish mode.")
-;(define-abbrev-table 'swedish-mode-abbrev-table ())
-
-;(defun swedish-mode ()
-;   "Major mode for editing Swedish text intended for humans to
-;read.  Special commands:\\{text-mode-map}
-;Turning on swedish-mode calls the value of the variable
-;text-mode-hook, if that value is non-nil."
-;   (interactive)
-;   (kill-all-local-variables)
-;   (use-local-map text-mode-map)
-;   (setq mode-name "Swedish")
-;   (setq major-mode 'swedish-mode)
-;   (setq local-abbrev-table swedish-mode-abbrev-table)
-;   (set-syntax-table text-mode-syntax-table)
-;   (run-hooks 'text-mode-hook))
-
-;(defun indented-swedish-mode ()
-;   "Major mode for editing indented Swedish text intended for
-;humans to read.\\{indented-text-mode-map}
-;Turning on indented-swedish-mode calls the value of the
-;variable text-mode-hook, if that value is non-nil."
-;   (interactive)
-;   (kill-all-local-variables)
-;   (use-local-map text-mode-map)
-;   (define-abbrev-table 'swedish-mode-abbrev-table ())
-;   (setq local-abbrev-table swedish-mode-abbrev-table)
-;   (set-syntax-table text-mode-syntax-table)
-;   (make-local-variable 'indent-line-function)
-;   (setq indent-line-function 'indent-relative-maybe)
-;   (use-local-map indented-text-mode-map)
-;   (setq mode-name "Indented Swedish")
-;   (setq major-mode 'indented-swedish-mode)
-;   (run-hooks 'text-mode-hook))
-
-(provide 'swedish)
-
-;;; swedish.el ends here
diff --git a/lisp/isearch.el b/lisp/isearch.el
deleted file mode 100644
index 28fe63335d0..00000000000
--- a/lisp/isearch.el
+++ /dev/null
@@ -1,1451 +0,0 @@
-;;; isearch.el --- incremental search minor mode.
-
-;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
-;; 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:
-
-;; Instructions
-
-;; For programmed use of isearch-mode, e.g. calling (isearch-forward),
-;; isearch-mode behaves modally and does not return until the search
-;; is completed.  It uses a recursive-edit to behave this way.  Note:
-;; gnus does it wrong: (call-interactively 'isearch-forward).
-
-;; The key bindings active within isearch-mode are defined below in
-;; `isearch-mode-map' which is given bindings close to the default
-;; characters of the original isearch.el.  With `isearch-mode',
-;; however, you can bind multi-character keys and it should be easier
-;; to add new commands.  One bug though: keys with meta-prefix cannot
-;; be longer than two chars.  Also see minibuffer-local-isearch-map
-;; for bindings active during `isearch-edit-string'.
-
-;; Note to emacs version 19 users: isearch-mode should work even if
-;; you switch windows with the mouse, in which case isearch-mode is
-;; terminated automatically before the switch.  This is true of lemacs
-;; too, with a few more cleanups I've neglected in this release. 
-;; No one has supplied patches for epoch yet.
-
-;; The search ring and completion commands automatically put you in
-;; the minibuffer to edit the string.  This gives you a chance to
-;; modify the search string before executing the search.  There are
-;; three commands to terminate the editing: C-s and C-r exit the
-;; minibuffer and search forward and reverse respectively, while C-m
-;; exits and does a nonincremental search.
-
-;; Exiting immediately from isearch uses isearch-edit-string instead
-;; of nonincremental-search, if search-nonincremental-instead is non-nil.
-;; The name of this option should probably be changed if we decide to
-;; keep the behavior.  No point in forcing nonincremental search until
-;; the last possible moment.
-
-;; TODO
-;; - Integrate the emacs 19 generalized command history.
-;; - Think about incorporating query-replace.
-;; - Hooks and options for failed search.
-
-;;; Change Log:
-
-;; Changes before those recorded in ChangeLog:
-
-;; Revision 1.4  92/09/14  16:26:02  liberte
-;; Added prefix args to isearch-forward, etc. to switch between
-;;    string and regular expression searching.
-;; Added some support for lemacs.
-;; Added general isearch-highlight option - but only for lemacs so far.
-;; Added support for frame switching in emacs 19.
-;; Added word search option to isearch-edit-string.
-;; Renamed isearch-quit to isearch-abort.
-;; Numerous changes to comments and doc strings.
-;; 
-;; Revision 1.3  92/06/29  13:10:08  liberte
-;; Moved modal isearch-mode handling into isearch-mode.
-;; Got rid of buffer-local isearch variables.
-;; isearch-edit-string used by ring adjustments, completion, and
-;; nonincremental searching.  C-s and C-r are additional exit commands.
-;; Renamed all regex to regexp.
-;; Got rid of found-start and found-point globals.
-;; Generalized handling of upper-case chars.
-
-;; Revision 1.2  92/05/27  11:33:57  liberte
-;; Emacs version 19 has a search ring, which is supported here.
-;; Other fixes found in the version 19 isearch are included here.
-;;
-;; Also see variables search-caps-disable-folding,
-;; search-nonincremental-instead, search-whitespace-regexp, and
-;; commands isearch-toggle-regexp, isearch-edit-string.
-;;
-;; semi-modal isearching is supported.
-
-;; Changes for 1.1
-;; 3/18/92 Fixed invalid-regexp.
-;; 3/18/92 Fixed yanking in regexps.
-
-;;; Code:
-
-
-;;; Some additional options and constants.
-
-(defvar search-exit-option t
-  "*Non-nil means random control characters terminate incremental search.")
-
-(defvar search-slow-window-lines 1
-  "*Number of lines in slow search display windows.
-These are the short windows used during incremental search on slow terminals.
-Negative means put the slow search window at the top (normally it's at bottom)
-and the value is minus the number of lines.")
-
-(defvar search-slow-speed 1200
-  "*Highest terminal speed at which to use \"slow\" style incremental search.
-This is the style where a one-line window is created to show the line
-that the search has reached.")
-
-(defvar search-upper-case 'not-yanks
-  "*If non-nil, upper case chars disable case fold searching.
-That is, upper and lower case chars must match exactly.
-This applies no matter where the chars come from, but does not
-apply to chars in regexps that are prefixed with `\\'.
-If this value is `not-yanks', yanked text is always downcased.")
-
-(defvar search-nonincremental-instead t
-  "*If non-nil, do a nonincremental search instead if exiting immediately.
-Actually, `isearch-edit-string' is called to let you enter the search
-string, and RET terminates editing and does a nonincremental search.")
-
-(defvar search-whitespace-regexp "\\s-+"
-  "*If non-nil, regular expression to match a sequence of whitespace chars.
-You might want to use something like \"[ \\t\\r\\n]+\" instead.")
-
-(defvar search-highlight nil
-  "*Non-nil means incremental search highlights the current match.")
-
-(defvar isearch-mode-hook nil
-  "Function(s) to call after starting up an incremental search.")
-
-(defvar isearch-mode-end-hook nil
-  "Function(s) to call after terminating an incremental search.")
-
-;;; Search ring.
-
-(defvar search-ring nil
-  "List of search string sequences.")
-(defvar regexp-search-ring nil
-  "List of regular expression search string sequences.")
-
-(defvar search-ring-max 16
-  "*Maximum length of search ring before oldest elements are thrown away.")
-(defvar regexp-search-ring-max 16
-  "*Maximum length of regexp search ring before oldest elements are thrown away.")
-
-(defvar search-ring-yank-pointer nil
-  "Index in `search-ring' of last string reused.
-nil if none yet.")
-(defvar regexp-search-ring-yank-pointer nil
-  "Index in `regexp-search-ring' of last string reused.
-nil if none yet.")
-
-(defvar search-ring-update nil
-  "*Non-nil if advancing or retreating in the search ring should cause search.
-Default value, nil, means edit the string instead.")
-
-;;; Define isearch-mode keymap.
-
-(defvar isearch-mode-map nil
-  "Keymap for isearch-mode.")
-
-(or isearch-mode-map
-    (let* ((i 0)
-	   (map (make-keymap)))
-      (or (vectorp (nth 1 map))
-	  (error "The initialization of isearch-mode-map must be updated"))
-      ;; Give this map a vector 256 long, for dense binding
-      ;; of a larger range of ordinary characters.
-      (setcar (cdr map) (make-vector 256 nil))
-
-      ;; Make function keys, etc, exit the search.
-      (define-key map [t] 'isearch-other-control-char)
-      ;; Control chars, by default, end isearch mode transparently.
-      ;; We need these explicit definitions because, in a dense keymap, 
-      ;; the binding for t does not affect characters.
-      ;; We use a dense keymap to save space.
-      (while (< i ?\ )
-	(define-key map (make-string 1 i) 'isearch-other-control-char)
-	(setq i (1+ i)))
-
-      ;; Printing chars extend the search string by default.
-      (setq i ?\ )
-      (while (< i (length (nth 1 map)))
-	(define-key map (vector i) 'isearch-printing-char)
-	(setq i (1+ i)))
-
-      ;; To handle local bindings with meta char prefix keys, define
-      ;; another full keymap.  This must be done for any other prefix
-      ;; keys as well, one full keymap per char of the prefix key.  It
-      ;; would be simpler to disable the global keymap, and/or have a
-      ;; default local key binding for any key not otherwise bound.
-      (let ((meta-map (make-sparse-keymap)))
-	(define-key map (char-to-string meta-prefix-char) meta-map)
-	(define-key map [escape] meta-map))
-      (define-key map (vector meta-prefix-char t) 'isearch-other-meta-char)
-
-      ;; Several non-printing chars change the searching behavior.
-      (define-key map "\C-s" 'isearch-repeat-forward)
-      (define-key map "\C-r" 'isearch-repeat-backward)
-      (define-key map "\177" 'isearch-delete-char)
-      (define-key map "\C-g" 'isearch-abort)
-      ;; This assumes \e is the meta-prefix-char.
-      (or (= ?\e meta-prefix-char)
-	  (error "Inconsistency in isearch.el"))
-      (define-key map "\e\e\e" 'isearch-cancel)
-      (define-key map  [escape escape escape] 'isearch-cancel)
-    
-      (define-key map "\C-q" 'isearch-quote-char)
-
-      (define-key map "\r" 'isearch-exit)
-      (define-key map "\C-j" 'isearch-printing-char)
-      (define-key map "\t" 'isearch-printing-char)
-      (define-key map " " 'isearch-whitespace-chars)
-    
-      (define-key map "\C-w" 'isearch-yank-word)
-      (define-key map "\C-y" 'isearch-yank-line)
-
-      ;; Define keys for regexp chars * ? |.
-      ;; Nothing special for + because it matches at least once.
-      (define-key map "*" 'isearch-*-char)
-      (define-key map "?" 'isearch-*-char)
-      (define-key map "|" 'isearch-|-char)
-
-;;; Turned off because I find I expect to get the global definition--rms.
-;;;      ;; Instead bind C-h to special help command for isearch-mode.
-;;;      (define-key map "\C-h" 'isearch-mode-help)
-
-      (define-key map "\M-n" 'isearch-ring-advance)
-      (define-key map "\M-p" 'isearch-ring-retreat)
-      (define-key map "\M-y" 'isearch-yank-kill)
-
-      (define-key map "\M-\t" 'isearch-complete)
-
-      ;; Pass frame events transparently so they won't exit the search.
-      ;; In particular, if we have more than one display open, then a
-      ;; switch-frame might be generated by someone typing at another keyboard.
-      (define-key map [switch-frame] nil)
-      (define-key map [delete-frame] nil)
-      (define-key map [iconify-frame] nil)
-      (define-key map [make-frame-visible] nil)
-
-      (setq isearch-mode-map map)
-      ))
-
-;; Some bindings you may want to put in your isearch-mode-hook.
-;; Suggest some alternates...
-;; (define-key isearch-mode-map "\C-t" 'isearch-toggle-case-fold)
-;; (define-key isearch-mode-map "\C-t" 'isearch-toggle-regexp)
-;; (define-key isearch-mode-map "\C-^" 'isearch-edit-string)
-
-
-(defvar minibuffer-local-isearch-map nil
-  "Keymap for editing isearch strings in the minibuffer.")
-
-(or minibuffer-local-isearch-map
-    (let ((map (copy-keymap minibuffer-local-map)))
-      (define-key map "\r" 'isearch-nonincremental-exit-minibuffer)
-      (define-key map "\M-n" 'isearch-ring-advance-edit)
-      (define-key map "\M-p" 'isearch-ring-retreat-edit)
-      (define-key map "\M-\t" 'isearch-complete-edit)
-      (define-key map "\C-s" 'isearch-forward-exit-minibuffer)
-      (define-key map "\C-r" 'isearch-reverse-exit-minibuffer)
-      (setq minibuffer-local-isearch-map map)
-      ))
-
-;; Internal variables declared globally for byte-compiler.
-;; These are all set with setq while isearching
-;; and bound locally while editing the search string.
-
-(defvar isearch-forward nil)	; Searching in the forward direction.
-(defvar isearch-regexp nil)	; Searching for a regexp.
-(defvar isearch-word nil)	; Searching for words.
-
-(defvar isearch-cmds nil)   ; Stack of search status sets.
-(defvar isearch-string "")  ; The current search string.
-(defvar isearch-message "") ; text-char-description version of isearch-string
-
-(defvar isearch-success t)		; Searching is currently successful.
-(defvar isearch-invalid-regexp nil)	; Regexp not well formed.
-(defvar isearch-within-brackets nil)	; Regexp has unclosed [.
-(defvar isearch-other-end nil)	; Start (end) of match if forward (backward).
-(defvar isearch-wrapped nil)	; Searching restarted from the top (bottom).
-(defvar isearch-barrier 0)
-(defvar isearch-just-started nil)
-
-; case-fold-search while searching.
-;   either nil, t, or 'yes.  'yes means the same as t except that mixed
-;   case in the search string is ignored.
-(defvar isearch-case-fold-search nil)
-
-(defvar isearch-adjusted nil)
-(defvar isearch-slow-terminal-mode nil)
-;;; If t, using a small window.
-(defvar isearch-small-window nil)
-(defvar isearch-opoint 0)
-;;; The window configuration active at the beginning of the search.
-(defvar isearch-window-configuration nil)
-
-;; Flag to indicate a yank occurred, so don't move the cursor.
-(defvar isearch-yank-flag nil)
-
-;;; A function to be called after each input character is processed.
-;;; (It is not called after characters that exit the search.)
-;;; It is only set from an optional argument to `isearch-mode'.
-(defvar isearch-op-fun nil)
-
-;;;  Is isearch-mode in a recursive edit for modal searching.
-(defvar isearch-recursive-edit nil)
-
-;;; Should isearch be terminated after doing one search?
-(defvar isearch-nonincremental nil)
-
-;; New value of isearch-forward after isearch-edit-string.
-(defvar isearch-new-forward nil)
-
-
-;; Minor-mode-alist changes - kind of redundant with the
-;; echo area, but if isearching in multiple windows, it can be useful.
-
-(or (assq 'isearch-mode minor-mode-alist)
-    (nconc minor-mode-alist
-	   (list '(isearch-mode isearch-mode))))
-
-(defvar isearch-mode nil) ;; Name of the minor mode, if non-nil.
-(make-variable-buffer-local 'isearch-mode)
-
-(define-key global-map "\C-s" 'isearch-forward)
-(define-key esc-map "\C-s" 'isearch-forward-regexp)
-(define-key global-map "\C-r" 'isearch-backward)
-(define-key esc-map "\C-r" 'isearch-backward-regexp)
-
-;;; Entry points to isearch-mode.
-;;; These four functions should replace those in loaddefs.el
-;;; An alternative is to defalias isearch-forward etc to isearch-mode,
-;;; and look at this-command to set the options accordingly.
-
-(defun isearch-forward (&optional regexp-p no-recursive-edit)
-  "\
-Do incremental search forward.
-With a prefix argument, do an incremental regular expression search instead.
-\\<isearch-mode-map>
-As you type characters, they add to the search string and are found.
-The following non-printing keys are bound in `isearch-mode-map'.  
-
-Type \\[isearch-delete-char] to cancel characters from end of search string.
-Type \\[isearch-exit] to exit, leaving point at location found.
-Type LFD (C-j) to match end of line.
-Type \\[isearch-repeat-forward] to search again forward,\
- \\[isearch-repeat-backward] to search again backward.
-Type \\[isearch-yank-word] to yank word from buffer onto end of search\
- string and search for it.
-Type \\[isearch-yank-line] to yank rest of line onto end of search string\
- and search for it.
-Type \\[isearch-yank-kill] to yank the last string of killed text.
-Type \\[isearch-quote-char] to quote control character to search for it.
-\\[isearch-abort] while searching or when search has failed cancels input\
- back to what has
- been found successfully.
-\\[isearch-abort] when search is successful aborts and moves point to\
- starting point.
-
-Also supported is a search ring of the previous 16 search strings.
-Type \\[isearch-ring-advance] to search for the next item in the search ring.
-Type \\[isearch-ring-retreat] to search for the previous item in the search\
- ring.
-Type \\[isearch-complete] to complete the search string using the search ring.
-
-The above keys, bound in `isearch-mode-map', are often controlled by 
- options; do M-x apropos on search-.* to find them.
-Other control and meta characters terminate the search
- and are then executed normally (depending on `search-exit-option').
-Likewise for function keys and mouse button events.
-
-If this function is called non-interactively, it does not return to
-the calling function until the search is done."
-
-  (interactive "P\np")
-  (isearch-mode t (not (null regexp-p)) nil (not no-recursive-edit)))
-
-(defun isearch-forward-regexp (&optional not-regexp no-recursive-edit)
-  "\
-Do incremental search forward for regular expression.
-With a prefix argument, do a regular string search instead.
-Like ordinary incremental search except that your input
-is treated as a regexp.  See \\[isearch-forward] for more info."
-  (interactive "P\np")
-  (isearch-mode t (null not-regexp) nil (not no-recursive-edit)))
-
-(defun isearch-backward (&optional regexp-p no-recursive-edit)
-  "\
-Do incremental search backward.
-With a prefix argument, do a regular expression search instead.
-See \\[isearch-forward] for more information."
-  (interactive "P\np")
-  (isearch-mode nil (not (null regexp-p)) nil (not no-recursive-edit)))
-
-(defun isearch-backward-regexp (&optional not-regexp no-recursive-edit)
-  "\
-Do incremental search backward for regular expression.
-With a prefix argument, do a regular string search instead.
-Like ordinary incremental search except that your input
-is treated as a regexp.  See \\[isearch-forward] for more info."
-  (interactive "P\np")
-  (isearch-mode nil (null not-regexp) nil (not no-recursive-edit)))
-
-
-(defun isearch-mode-help ()
-  (interactive)
-  (describe-function 'isearch-forward)
-  (isearch-update))
-
-
-;; isearch-mode only sets up incremental search for the minor mode.
-;; All the work is done by the isearch-mode commands.
-
-;; Not used yet:
-;;(defvar isearch-commands '(isearch-forward isearch-backward
-;;			     isearch-forward-regexp isearch-backward-regexp)
-;;  "List of commands for which isearch-mode does not recursive-edit.")
-			     
-
-(defun isearch-mode (forward &optional regexp op-fun recursive-edit word-p)
-  "Start isearch minor mode.  Called by `isearch-forward', etc.
-
-\\{isearch-mode-map}"
-
-  ;; Initialize global vars.
-  (setq isearch-forward forward
-	isearch-regexp regexp
-	isearch-word word-p
-	isearch-op-fun op-fun
-	isearch-case-fold-search case-fold-search
-	isearch-string ""
-	isearch-message ""
-	isearch-cmds nil
-	isearch-success t
-	isearch-wrapped nil
-	isearch-barrier (point)
-	isearch-adjusted nil
-	isearch-yank-flag nil
-	isearch-invalid-regexp nil
-	isearch-within-brackets nil
-	isearch-slow-terminal-mode (and (<= baud-rate search-slow-speed)
-					(> (window-height)
-					   (* 4 search-slow-window-lines)))
-	isearch-other-end nil
-	isearch-small-window nil
-	isearch-just-started t
-
-	isearch-opoint (point)
-	search-ring-yank-pointer nil
-	regexp-search-ring-yank-pointer nil)
-  (looking-at "")
-  (setq isearch-window-configuration
-	(if isearch-slow-terminal-mode (current-window-configuration) nil))
-
-  ;; Maybe make minibuffer frame visible and/or raise it.
-  (let ((frame (window-frame (minibuffer-window))))
-    (if (not (memq (frame-live-p frame) '(nil t)))
-	(progn
-	  (make-frame-visible frame)
-	  (if minibuffer-auto-raise
-	      (raise-frame frame)))))
-
-  (setq	isearch-mode " Isearch")  ;; forward? regexp?
-  (force-mode-line-update)
-
-  (isearch-push-state)
-
-  (setq overriding-terminal-local-map isearch-mode-map)
-  (isearch-update)
-  (run-hooks 'isearch-mode-hook)
-
-  (add-hook 'mouse-leave-buffer-hook 'isearch-done)
-
-  ;; isearch-mode can be made modal (in the sense of not returning to 
-  ;; the calling function until searching is completed) by entering 
-  ;; a recursive-edit and exiting it when done isearching.
-  (if recursive-edit
-      (let ((isearch-recursive-edit t))
-	(recursive-edit)))
-  isearch-success)
-
-
-;; Some high level utilities.  Others below.
-
-(defun isearch-update ()
-  ;; Called after each command to update the display.  
-  (if (null unread-command-events)
-      (progn
-	(if (not (input-pending-p))
-	    (isearch-message))
-	(if (and isearch-slow-terminal-mode
-		 (not (or isearch-small-window 
-			  (pos-visible-in-window-p))))
-	    (let ((found-point (point)))
-	      (setq isearch-small-window t)
-	      (move-to-window-line 0)
-	      (let ((window-min-height 1))
-		(split-window nil (if (< search-slow-window-lines 0)
-				      (1+ (- search-slow-window-lines))
-				    (- (window-height)
-				       (1+ search-slow-window-lines)))))
-	      (if (< search-slow-window-lines 0)
-		  (progn (vertical-motion (- 1 search-slow-window-lines))
-			 (set-window-start (next-window) (point))
-			 (set-window-hscroll (next-window)
-					     (window-hscroll))
-			 (set-window-hscroll (selected-window) 0))
-		(other-window 1))
-	      (goto-char found-point)))
-	(if isearch-other-end
-	    (if (< isearch-other-end (point)) ; isearch-forward?
-		(isearch-highlight isearch-other-end (point))
-	      (isearch-highlight (point) isearch-other-end))
-	  (isearch-dehighlight nil))
-	))
-  (setq ;; quit-flag nil  not for isearch-mode
-   isearch-adjusted nil
-   isearch-yank-flag nil)
-  )
-
-(defun isearch-done (&optional nopush edit)
-  (remove-hook 'mouse-leave-buffer-hook 'isearch-done)
-  ;; Called by all commands that terminate isearch-mode.
-  ;; If NOPUSH is non-nil, we don't push the string on the search ring.
-  (setq overriding-terminal-local-map nil)
-  ;; (setq pre-command-hook isearch-old-pre-command-hook) ; for lemacs
-  (isearch-dehighlight t)
-  (let ((found-start (window-start (selected-window)))
-	(found-point (point)))
-    (if isearch-window-configuration
-	(set-window-configuration isearch-window-configuration))
-
-    (if isearch-small-window
-	(goto-char found-point)
-      ;; Exiting the save-window-excursion clobbers window-start; restore it.
-      (set-window-start (selected-window) found-start t))
-
-    ;; If there was movement, mark the starting position.
-    ;; Maybe should test difference between and set mark iff > threshold.
-    (if (/= (point) isearch-opoint)
-	(or (and transient-mark-mode mark-active)
-	    (progn
-	      (push-mark isearch-opoint t)
-	      (or executing-kbd-macro (> (minibuffer-depth) 0)
-		  (message "Mark saved where search started"))))))
-
-  (setq isearch-mode nil)
-  (force-mode-line-update)
-
-  (if (and (> (length isearch-string) 0) (not nopush))
-      ;; Update the ring data.
-      (isearch-update-ring isearch-string isearch-regexp))
-
-  (run-hooks 'isearch-mode-end-hook)
-  (and (not edit) isearch-recursive-edit (exit-recursive-edit)))
-
-(defun isearch-update-ring (string &optional regexp)
-  "Add STRING to the beginning of the search ring.
-REGEXP says which ring to use."
-  (if regexp 
-      (if (or (null regexp-search-ring)
-	      (not (string= string (car regexp-search-ring))))
-	  (progn
-	    (setq regexp-search-ring
-		  (cons string regexp-search-ring))
-	    (if (> (length regexp-search-ring) regexp-search-ring-max)
-		(setcdr (nthcdr (1- search-ring-max) regexp-search-ring)
-			nil))))
-    (if (or (null search-ring)
-	    (not (string= string (car search-ring))))
-	(progn
-	  (setq search-ring (cons string search-ring))
-	  (if (> (length search-ring) search-ring-max)
-	      (setcdr (nthcdr (1- search-ring-max) search-ring) nil))))))
-
-;;; Switching buffers should first terminate isearch-mode.
-;;; This is done quite differently for each variant of emacs.
-;;; For lemacs, see Exiting in lemacs below
-
-;; For Emacs 19, the frame switch event is handled.
-(defun isearch-switch-frame-handler ()
-  (interactive) ;; Is this necessary?
-  ;; First terminate isearch-mode.
-  (isearch-done)
-  (handle-switch-frame (car (cdr (isearch-last-command-char)))))
-
-
-;; Commands active while inside of the isearch minor mode.
-
-(defun isearch-exit ()
-  "Exit search normally.
-However, if this is the first command after starting incremental
-search and `search-nonincremental-instead' is non-nil, do a
-nonincremental search instead via `isearch-edit-string'."
-  (interactive)
-  (if (and search-nonincremental-instead 
-	   (= 0 (length isearch-string)))
-      (let ((isearch-nonincremental t))
-	(isearch-edit-string)))
-  (isearch-done))
-
-
-(defun isearch-edit-string ()
-  "Edit the search string in the minibuffer.
-The following additional command keys are active while editing.
-\\<minibuffer-local-isearch-map>
-\\[exit-minibuffer] to resume incremental searching with the edited string.
-\\[isearch-nonincremental-exit-minibuffer] to do one nonincremental search.
-\\[isearch-forward-exit-minibuffer] to resume isearching forward.
-\\[isearch-reverse-exit-minibuffer] to resume isearching backward.
-\\[isearch-ring-advance-edit] to replace the search string with the next item in the search ring.
-\\[isearch-ring-retreat-edit] to replace the search string with the previous item in the search ring.
-\\[isearch-complete-edit] to complete the search string using the search ring.
-\\<isearch-mode-map>
-If first char entered is \\[isearch-yank-word], then do word search instead."
-
-  ;; This code is very hairy for several reasons, explained in the code.
-  ;; Mainly, isearch-mode must be terminated while editing and then restarted.
-  ;; If there were a way to catch any change of buffer from the minibuffer,
-  ;; this could be simplified greatly.
-  ;; Editing doesn't back up the search point.  Should it?
-  (interactive)
-  (condition-case err
-      (progn
-	(let ((isearch-nonincremental isearch-nonincremental)
-
-	      ;; Locally bind all isearch global variables to protect them
-	      ;; from recursive isearching.
-	      ;; isearch-string -message and -forward are not bound
-	      ;; so they may be changed.  Instead, save the values.
-	      (isearch-new-string isearch-string)
-	      (isearch-new-message isearch-message)
-	      (isearch-new-forward isearch-forward)
-	      (isearch-new-word isearch-word)
-
-	      (isearch-regexp isearch-regexp)
-	      (isearch-op-fun isearch-op-fun)
-	      (isearch-cmds isearch-cmds)
-	      (isearch-success isearch-success)
-	      (isearch-wrapped isearch-wrapped)
-	      (isearch-barrier isearch-barrier)
-	      (isearch-adjusted isearch-adjusted)
-	      (isearch-yank-flag isearch-yank-flag)
-	      (isearch-invalid-regexp isearch-invalid-regexp)
-	      (isearch-within-brackets isearch-within-brackets)
-  ;;; Don't bind this.  We want isearch-search, below, to set it.
-  ;;; And the old value won't matter after that.
-  ;;;	    (isearch-other-end isearch-other-end)
-  ;;; Perhaps some of these other variables should be bound for a
-  ;;; shorter period, ending before the next isearch-search.
-  ;;; But there doesn't seem to be a real bug, so let's not risk it now.
-	      (isearch-opoint isearch-opoint)
-	      (isearch-slow-terminal-mode isearch-slow-terminal-mode)
-	      (isearch-small-window isearch-small-window)
-	      (isearch-recursive-edit isearch-recursive-edit)
-	      ;; Save current configuration so we can restore it here.
-	      (isearch-window-configuration (current-window-configuration))
-	      )
-
-	  ;; Actually terminate isearching until editing is done.
-	  ;; This is so that the user can do anything without failure, 
-	  ;; like switch buffers and start another isearch, and return.
-	  (condition-case err
-	      (isearch-done t t)
-	    (exit nil))			; was recursive editing
-
-	  (isearch-message) ;; for read-char
-	  (unwind-protect
-	      (let* (;; Why does following read-char echo?  
-		     ;;(echo-keystrokes 0) ;; not needed with above message
-		     (e (let ((cursor-in-echo-area t))
-			  (read-event)))
-		     ;; Binding minibuffer-history-symbol to nil is a work-around
-		     ;; for some incompatibility with gmhist.
-		     (minibuffer-history-symbol)
-		     (message-log-max nil))
-		;; If the first character the user types when we prompt them
-		;; for a string is the yank-word character, then go into
-		;; word-search mode.  Otherwise unread that character and
-		;; read a key the normal way.
-		;; Word search does not apply (yet) to regexp searches,
-		;; no check is made here.
-		(message (isearch-message-prefix nil nil t))
-		(if (eq 'isearch-yank-word
-			(lookup-key isearch-mode-map (vector e)))
-		    (setq isearch-word t;; so message-prefix is right
-			  isearch-new-word t)
-		  (cancel-kbd-macro-events)
-		  (isearch-unread e))
-		(setq cursor-in-echo-area nil)
-		(setq isearch-new-string
-		      (let (junk-ring)
-			(read-from-minibuffer
-			 (isearch-message-prefix nil nil isearch-nonincremental)
-			 isearch-string
-			 minibuffer-local-isearch-map nil
-			 'junk-ring))
-		      isearch-new-message
-		      (mapconcat 'isearch-text-char-description
-				 isearch-new-string "")))
-	    ;; Always resume isearching by restarting it.
-	    (isearch-mode isearch-forward 
-			  isearch-regexp 
-			  isearch-op-fun 
-			  nil
-			  isearch-word)
-
-	    ;; Copy new local values to isearch globals
-	    (setq isearch-string isearch-new-string
-		  isearch-message isearch-new-message
-		  isearch-forward isearch-new-forward
-		  isearch-word isearch-new-word))
-
-	  ;; Empty isearch-string means use default.
-	  (if (= 0 (length isearch-string))
-	      (setq isearch-string (or (car (if isearch-regexp
-						regexp-search-ring
-					      search-ring))
-				       ""))
-	    ;; This used to set the last search string,
-	    ;; but I think it is not right to do that here.
-	    ;; Only the string actually used should be saved.
-	    ))
-
-	;; Push the state as of before this C-s.
-	(isearch-push-state)
-
-	;; Reinvoke the pending search.
-	(isearch-search)
-	(isearch-update)
-	(if isearch-nonincremental 
-	    (progn
-	      ;; (sit-for 1) ;; needed if isearch-done does: (message "")
-	      (isearch-done))))
-
-    (quit  ; handle abort-recursive-edit
-     (isearch-abort)  ;; outside of let to restore outside global values
-     )))
-
-(defun isearch-nonincremental-exit-minibuffer ()
-  (interactive)
-  (setq isearch-nonincremental t)
-  (exit-minibuffer))
-
-(defun isearch-forward-exit-minibuffer ()
-  (interactive)
-  (setq isearch-new-forward t)
-  (exit-minibuffer))
-
-(defun isearch-reverse-exit-minibuffer ()
-  (interactive)
-  (setq isearch-new-forward nil)
-  (exit-minibuffer))
-
-(defun isearch-cancel ()
-  "Terminate the search and go back to the starting point."
-  (interactive)
-  (goto-char isearch-opoint)
-  (isearch-done t)
-  (signal 'quit nil))  ; and pass on quit signal
-
-(defun isearch-abort ()
-  "Abort incremental search mode if searching is successful, signaling quit.
-Otherwise, revert to previous successful search and continue searching.
-Use `isearch-exit' to quit without signaling."
-  (interactive)
-;;  (ding)  signal instead below, if quitting
-  (discard-input)
-  (if isearch-success
-      ;; If search is successful, move back to starting point
-      ;; and really do quit.
-      (progn (goto-char isearch-opoint)
-	     (setq isearch-success nil)
-	     (isearch-done t)   ; exit isearch
-	     (signal 'quit nil))  ; and pass on quit signal
-    ;; If search is failing, or has an incomplete regexp,
-    ;; rub out until it is once more successful.
-    (while (or (not isearch-success) isearch-invalid-regexp)
-      (isearch-pop-state))
-    (isearch-update)))
-
-(defun isearch-repeat (direction)
-  ;; Utility for isearch-repeat-forward and -backward.
-  (if (eq isearch-forward (eq direction 'forward))
-      ;; C-s in forward or C-r in reverse.
-      (if (equal isearch-string "")
-	  ;; If search string is empty, use last one.
-	  (setq isearch-string
-		(or (if isearch-regexp
-			(car regexp-search-ring)
-		      (car search-ring))
-		    "")
-		isearch-message
-		(mapconcat 'isearch-text-char-description
-			   isearch-string ""))
-	;; If already have what to search for, repeat it.
-	(or isearch-success
-	    (progn 
-	      (goto-char (if isearch-forward (point-min) (point-max)))
-	      (setq isearch-wrapped t))))
-    ;; C-s in reverse or C-r in forward, change direction.
-    (setq isearch-forward (not isearch-forward)))
-
-  (setq isearch-barrier (point)) ; For subsequent \| if regexp.
-
-  (if (equal isearch-string "")
-      (setq isearch-success t)
-    (if (and isearch-success (equal (match-end 0) (match-beginning 0))
-	     (not isearch-just-started))
-	;; If repeating a search that found
-	;; an empty string, ensure we advance.
-	(if (if isearch-forward (eobp) (bobp))
-	    ;; If there's nowhere to advance to, fail (and wrap next time).
-	    (progn
-	      (setq isearch-success nil)
-	      (ding))
-	  (forward-char (if isearch-forward 1 -1))
-	  (isearch-search))
-      (isearch-search)))
-
-  (isearch-push-state)
-  (isearch-update))
-
-(defun isearch-repeat-forward ()
-  "Repeat incremental search forwards."
-  (interactive)
-  (isearch-repeat 'forward))
-
-(defun isearch-repeat-backward ()
-  "Repeat incremental search backwards."
-  (interactive)
-  (isearch-repeat 'backward))
-
-(defun isearch-toggle-regexp ()
-  "Toggle regexp searching on or off."
-  ;; The status stack is left unchanged.
-  (interactive)
-  (setq isearch-regexp (not isearch-regexp))
-  (if isearch-regexp (setq isearch-word nil))
-  (isearch-update))
-
-(defun isearch-toggle-case-fold ()
-  "Toggle case folding in searching on or off."
-  (interactive)
-  (setq isearch-case-fold-search
-	(if isearch-case-fold-search nil 'yes))
-  (let ((message-log-max nil))
-    (message "%s%s [case %ssensitive]"
-	     (isearch-message-prefix nil nil isearch-nonincremental)
-	     isearch-message
-	     (if isearch-case-fold-search "in" "")))
-  (setq isearch-adjusted t)
-  (sit-for 1)
-  (isearch-update))
-
-(defun isearch-delete-char ()
-  "Discard last input item and move point back.  
-If no previous match was done, just beep."
-  (interactive)
-  (if (null (cdr isearch-cmds))
-      (ding)
-    (isearch-pop-state))
-  (isearch-update))
-
-
-(defun isearch-yank (chunk)
-  ;; Helper for isearch-yank-word and isearch-yank-line
-  ;; CHUNK should be word, line or kill.
-  (let ((string (cond
-                 ((eq chunk 'kill)
-                  (current-kill 0))
-                 (t
-		  (save-excursion
-		    (and (not isearch-forward) isearch-other-end
-			 (goto-char isearch-other-end))
-		    (buffer-substring
-		     (point)
-		     (save-excursion
-		       (cond
-			((eq chunk 'word)
-			 (forward-word 1))
-			((eq chunk 'line)
-			 (end-of-line)))
-		       (point))))))))
-    ;; Downcase the string if not supposed to case-fold yanked strings.
-    (if (and isearch-case-fold-search
-	     (eq 'not-yanks search-upper-case))
-	(setq string (downcase string)))
-    (if isearch-regexp (setq string (regexp-quote string)))
-    (setq isearch-string (concat isearch-string string)
-	  isearch-message
-	  (concat isearch-message
-		  (mapconcat 'isearch-text-char-description
-			     string ""))
-	  ;; Don't move cursor in reverse search.
-	  isearch-yank-flag t))
-  (isearch-search-and-update))
-
-(defun isearch-yank-kill ()
-  "Pull string from kill ring into search string."
-  (interactive)
-  (isearch-yank 'kill))
-
-(defun isearch-yank-word ()
-  "Pull next word from buffer into search string."
-  (interactive)
-  (isearch-yank 'word))
-
-(defun isearch-yank-line ()
-  "Pull rest of line from buffer into search string."
-  (interactive)
-  (isearch-yank 'line))
-
-
-(defun isearch-search-and-update ()
-  ;; Do the search and update the display.
-  (if (and (not isearch-success)
-	   ;; unsuccessful regexp search may become
-	   ;;  successful by addition of characters which
-	   ;;  make isearch-string valid
-	   (not isearch-regexp))
-      nil
-    ;; In reverse search, adding stuff at
-    ;; the end may cause zero or many more chars to be
-    ;; matched, in the string following point.
-    ;; Allow all those possibilities without moving point as
-    ;; long as the match does not extend past search origin.
-    (if (and (not isearch-forward) (not isearch-adjusted)
-	     (condition-case ()
-		 (let ((case-fold-search isearch-case-fold-search))
-		   (looking-at (if isearch-regexp isearch-string
-				 (regexp-quote isearch-string))))
-	       (error nil))
-	       (or isearch-yank-flag
-		   (<= (match-end 0) 
-		       (min isearch-opoint isearch-barrier))))
-	(setq isearch-success t 
-	      isearch-invalid-regexp nil
-	      isearch-within-brackets nil
-	      isearch-other-end (match-end 0))
-      ;; Not regexp, not reverse, or no match at point.
-      (if (and isearch-other-end (not isearch-adjusted))
-	  (goto-char (if isearch-forward isearch-other-end
-		       (min isearch-opoint 
-			    isearch-barrier 
-			    (1+ isearch-other-end)))))
-      (isearch-search)
-      ))
-  (isearch-push-state)
-  (if isearch-op-fun (funcall isearch-op-fun))
-  (isearch-update))
-
-
-;; *, ?, and | chars can make a regexp more liberal.
-;; They can make a regexp match sooner or make it succeed instead of failing.
-;; So go back to place last successful search started
-;; or to the last ^S/^R (barrier), whichever is nearer.
-;; + needs no special handling because the string must match at least once.
-
-(defun isearch-*-char ()
-  "Handle * and ? specially in regexps."
-  (interactive)
-  (if isearch-regexp 
-
-      (progn
-	(setq isearch-adjusted t)
-	;; Get the isearch-other-end from before the last search.
-	;; We want to start from there,
-	;; so that we don't retreat farther than that.
-	;; (car isearch-cmds) is after last search;
-	;; (car (cdr isearch-cmds)) is from before it.
-	(let ((cs (nth 5 (car (cdr isearch-cmds)))))
-	  (setq cs (or cs isearch-barrier))
-	  (goto-char
-	   (if isearch-forward
-	       (max cs isearch-barrier)
-	     (min cs isearch-barrier))))))
-  (isearch-process-search-char (isearch-last-command-char)))
-  
-
-(defun isearch-|-char ()
-  "If in regexp search, jump to the barrier."
-  (interactive)
-  (if isearch-regexp
-      (progn
-	(setq isearch-adjusted t)
-	(goto-char isearch-barrier)))
-  (isearch-process-search-char (isearch-last-command-char)))
-
-
-(defalias 'isearch-other-control-char 'isearch-other-meta-char)
-
-(defun isearch-other-meta-char ()
-  "Exit the search normally and reread this key sequence.
-But only if `search-exit-option' is non-nil, the default.
-If it is the symbol `edit', the search string is edited in the minibuffer
-and the meta character is unread so that it applies to editing the string."
-  (interactive)
-  (let* ((key (this-command-keys))
-	 (main-event (aref key 0))
-	 (keylist (listify-key-sequence key)))
-    (cond ((and (= (length key) 1)
-		(let ((lookup (lookup-key function-key-map key)))
-		  (not (or (null lookup) (integerp lookup)
-			   (keymapp lookup)))))
-	   ;; Handle a function key that translates into something else.
-	   ;; If the key has a global definition too,
-	   ;; exit and unread the key itself, so its global definition runs.
-	   ;; Otherwise, unread the translation,
-	   ;; so that the translated key takes effect within isearch.
-	   (cancel-kbd-macro-events)
-	   (if (lookup-key global-map key)
-	       (progn 
-		 (isearch-done)
-		 (apply 'isearch-unread keylist))
-	     (apply 'isearch-unread
-		    (listify-key-sequence (lookup-key function-key-map key)))))
-	  (
-	   ;; Handle an undefined shifted control character
-	   ;; by downshifting it if that makes it defined.
-	   ;; (As read-key-sequence would normally do,
-	   ;; if we didn't have a default definition.)
-	   (let ((mods (event-modifiers main-event)))
-	     (and (integerp main-event)
-		  (memq 'shift mods)
-		  (memq 'control mods)
-		  (lookup-key isearch-mode-map
-			      (let ((copy (copy-sequence key)))
-				(aset copy 0
-				      (- main-event (- ?\C-\S-a ?\C-a)))
-				copy)
-			      nil)))
-	   (setcar keylist (- main-event (- ?\C-\S-a ?\C-a)))
-	   (cancel-kbd-macro-events)
-	   (apply 'isearch-unread keylist))
-	  ((eq search-exit-option 'edit)
-	   (apply 'isearch-unread keylist)
-	   (isearch-edit-string))
-	  (search-exit-option
-	   (let (window)
-	     (cancel-kbd-macro-events)
-	     (apply 'isearch-unread keylist)
-	     ;; Properly handle scroll-bar and mode-line clicks
-	     ;; for which a dummy prefix event was generated as (aref key 0).
-	     (and (> (length key) 1)
-		  (symbolp (aref key 0))
-		  (listp (aref key 1))
-		  (not (numberp (posn-point (event-start (aref key 1)))))
-		  ;; Convert the event back into its raw form,
-		  ;; with the dummy prefix implicit in the mouse event,
-		  ;; so it will get split up once again.
-		  (progn (setq unread-command-events
-			       (cdr unread-command-events))
-			 (setq main-event (car unread-command-events))
-			 (setcar (cdr (event-start main-event))
-				 (car (nth 1 (event-start main-event))))))
-	     ;; If we got a mouse click, maybe it was read with the buffer
-	     ;; it was clicked on.  If so, that buffer, not the current one,
-	     ;; is in isearch mode.  So end the search in that buffer.
-	     (if (and (listp main-event)
-		      (setq window (posn-window (event-start main-event)))
-		      (windowp window))
-		 (save-excursion
-		   (set-buffer (window-buffer window))
-		   (isearch-done))
-	       (isearch-done))))
-	  (t;; otherwise nil
-	   (isearch-process-search-string key key)))))
-
-(defun isearch-quote-char ()
-  "Quote special characters for incremental search."
-  (interactive)
-  (isearch-process-search-char (read-quoted-char (isearch-message t))))
-
-(defun isearch-return-char ()
-  "Convert return into newline for incremental search.
-Obsolete."
-  (interactive)
-  (isearch-process-search-char ?\n))
-
-(defun isearch-printing-char ()
-  "Add this ordinary printing character to the search string and search."
-  (interactive)
-  (isearch-process-search-char (isearch-last-command-char)))
-
-(defun isearch-whitespace-chars ()
-  "Match all whitespace chars, if in regexp mode.
-If you want to search for just a space, type C-q SPC."
-  (interactive)
-  (if isearch-regexp 
-      (if (and search-whitespace-regexp (not isearch-within-brackets)
-	       (not isearch-invalid-regexp))
-	  (isearch-process-search-string search-whitespace-regexp " ")
-	(isearch-printing-char))
-    (progn
-      ;; This way of doing word search doesn't correctly extend current search.
-      ;;      (setq isearch-word t)
-      ;;      (setq isearch-adjusted t)
-      ;;      (goto-char isearch-barrier)
-      (isearch-printing-char))))
-
-(defun isearch-process-search-char (char)
-  ;; Append the char to the search string, update the message and re-search.
-  (isearch-process-search-string 
-   (isearch-char-to-string char) 
-   (isearch-text-char-description char)))
-
-(defun isearch-process-search-string (string message)
-  (setq isearch-string (concat isearch-string string)
-	isearch-message (concat isearch-message message))
-  (isearch-search-and-update))
-
-
-;; Search Ring
-
-(defun isearch-ring-adjust1 (advance)
-  ;; Helper for isearch-ring-adjust
-  (let* ((ring (if isearch-regexp regexp-search-ring search-ring))
-	 (length (length ring))
-	 (yank-pointer-name (if isearch-regexp
-				'regexp-search-ring-yank-pointer
-			      'search-ring-yank-pointer))
-	 (yank-pointer (eval yank-pointer-name)))
-    (if (zerop length)
-	()
-      (set yank-pointer-name
-	   (setq yank-pointer
-		 (mod (+ (or yank-pointer 0)
-			 (if advance -1 1))
-		      length)))
-      (setq isearch-string (nth yank-pointer ring)
-	    isearch-message (mapconcat 'isearch-text-char-description
-				       isearch-string "")))))
-
-(defun isearch-ring-adjust (advance)
-  ;; Helper for isearch-ring-advance and isearch-ring-retreat
-  (isearch-ring-adjust1 advance)
-  (if search-ring-update
-      (progn
-	(isearch-search)
-	(isearch-update))
-    (isearch-edit-string)
-    )
-  (isearch-push-state))
-
-(defun isearch-ring-advance ()
-  "Advance to the next search string in the ring."
-  ;; This could be more general to handle a prefix arg, but who would use it.
-  (interactive)
-  (isearch-ring-adjust 'advance))
-
-(defun isearch-ring-retreat ()
-  "Retreat to the previous search string in the ring."
-  (interactive)
-  (isearch-ring-adjust nil))
-
-(defun isearch-ring-advance-edit (n)
-  "Insert the next element of the search history into the minibuffer."
-  (interactive "p")
-  (let* ((yank-pointer-name (if isearch-regexp
-				'regexp-search-ring-yank-pointer
-			      'search-ring-yank-pointer))
-	 (yank-pointer (eval yank-pointer-name))
-	 (ring (if isearch-regexp regexp-search-ring search-ring))
-	 (length (length ring)))
-    (if (zerop length)
-	()
-      (set yank-pointer-name
-	   (setq yank-pointer
-		 (mod (- (or yank-pointer 0) n)
-		      length)))
-
-      (erase-buffer)
-      (insert (nth yank-pointer ring))
-      (goto-char (point-max)))))
-
-(defun isearch-ring-retreat-edit (n)
-  "Inserts the previous element of the search history into the minibuffer."
-  (interactive "p")
-  (isearch-ring-advance-edit (- n)))
-
-;;(defun isearch-ring-adjust-edit (advance)
-;;  "Use the next or previous search string in the ring while in minibuffer."
-;;  (isearch-ring-adjust1 advance)
-;;  (erase-buffer)
-;;  (insert isearch-string))
-
-;;(defun isearch-ring-advance-edit ()
-;;  (interactive)
-;;  (isearch-ring-adjust-edit 'advance))
-
-;;(defun isearch-ring-retreat-edit ()
-;;  "Retreat to the previous search string in the ring while in the minibuffer."
-;;  (interactive)
-;;  (isearch-ring-adjust-edit nil))
-
-
-(defun isearch-complete1 ()
-  ;; Helper for isearch-complete and isearch-complete-edit
-  ;; Return t if completion OK, nil if no completion exists.
-  (let* ((ring (if isearch-regexp regexp-search-ring search-ring))
-         (alist (mapcar (function (lambda (string) (list string))) ring))
-         (completion-ignore-case case-fold-search)
-         (completion (try-completion isearch-string alist)))
-    (cond
-     ((eq completion t)
-      ;; isearch-string stays the same
-      t)
-     ((or completion ; not nil, must be a string
-	  (= 0 (length isearch-string))) ; shouldn't have to say this
-      (if (equal completion isearch-string)  ;; no extension?
-	  (progn
-	    (if completion-auto-help
-		(with-output-to-temp-buffer "*Isearch completions*"
-		  (display-completion-list 
-		   (all-completions isearch-string alist))))
-	    t)
-	(and completion
-	     (setq isearch-string completion))))
-     (t
-      (message "No completion") ; waits a second if in minibuffer
-      nil))))
-
-(defun isearch-complete ()
-  "Complete the search string from the strings on the search ring.
-The completed string is then editable in the minibuffer.
-If there is no completion possible, say so and continue searching."
-  (interactive)
-  (if (isearch-complete1)
-      (isearch-edit-string)
-    ;; else
-    (sit-for 1)
-    (isearch-update)))
-
-(defun isearch-complete-edit ()
-  "Same as `isearch-complete' except in the minibuffer."
-  (interactive)
-  (setq isearch-string (buffer-string))
-  (if (isearch-complete1)
-      (progn
-	(erase-buffer)
-	(insert isearch-string))))
-
-
-;; The search status stack (and isearch window-local variables, not used).
-;; Need a structure for this.
-
-(defun isearch-top-state ()
-  (let ((cmd (car isearch-cmds)))
-    (setq isearch-string (car cmd)
-	  isearch-message (car (cdr cmd))
-	  isearch-success (nth 3 cmd)
-	  isearch-forward (nth 4 cmd)
-	  isearch-other-end (nth 5 cmd)
-	  isearch-word (nth 6 cmd)
-	  isearch-invalid-regexp (nth 7 cmd)
-	  isearch-wrapped (nth 8 cmd)
-	  isearch-barrier (nth 9 cmd)
-	  isearch-within-brackets (nth 10 cmd)
-	  isearch-case-fold-search (nth 11 cmd))
-    (goto-char (car (cdr (cdr cmd))))))
-
-(defun isearch-pop-state ()
-  (setq isearch-cmds (cdr isearch-cmds))
-  (isearch-top-state)
-  )
-
-(defun isearch-push-state ()
-  (setq isearch-cmds 
-	(cons (list isearch-string isearch-message (point)
-		    isearch-success isearch-forward isearch-other-end 
-		    isearch-word
-		    isearch-invalid-regexp isearch-wrapped isearch-barrier
-		    isearch-within-brackets isearch-case-fold-search)
-	      isearch-cmds)))
-
-
-;; Message string
-
-(defun isearch-message (&optional c-q-hack ellipsis)
-  ;; Generate and print the message string.
-  (let ((cursor-in-echo-area ellipsis)
-	(m (concat
-	    (isearch-message-prefix c-q-hack ellipsis isearch-nonincremental)
-	    isearch-message
-	    (isearch-message-suffix c-q-hack ellipsis)
-	    )))
-    (if c-q-hack
-	m
-      (let ((message-log-max nil))
-	(message "%s" m)))))
-
-(defun isearch-message-prefix (&optional c-q-hack ellipsis nonincremental)
-  ;; If about to search, and previous search regexp was invalid,
-  ;; check that it still is.  If it is valid now,
-  ;; let the message we display while searching say that it is valid.
-  (and isearch-invalid-regexp ellipsis
-       (condition-case ()
-	   (progn (re-search-forward isearch-string (point) t)
-		  (setq isearch-invalid-regexp nil
-			isearch-within-brackets nil))
-	 (error nil)))
-  ;; If currently failing, display no ellipsis.
-  (or isearch-success (setq ellipsis nil))
-  (let ((m (concat (if isearch-success "" "failing ")
-		   (if (and isearch-wrapped
-			    (if isearch-forward
-				(> (point) isearch-opoint)
-			      (< (point) isearch-opoint)))
-		       "over")
-		   (if isearch-wrapped "wrapped ")
-		   (if isearch-word "word " "")
-		   (if isearch-regexp "regexp " "")
-		   (if nonincremental "search" "I-search")
-		   (if isearch-forward ": " " backward: ")
-		   )))
-    (aset m 0 (upcase (aref m 0)))
-    m))
-
-
-(defun isearch-message-suffix (&optional c-q-hack ellipsis)
-  (concat (if c-q-hack "^Q" "")
-	  (if isearch-invalid-regexp
-	      (concat " [" isearch-invalid-regexp "]")
-	    "")))
-
-
-;;; Searching
-
-(defun isearch-search ()
-  ;; Do the search with the current search string.
-  (isearch-message nil t)
-  (if (and (eq isearch-case-fold-search t) search-upper-case)
-      (setq isearch-case-fold-search
-	    (isearch-no-upper-case-p isearch-string isearch-regexp)))
-  (condition-case lossage
-      (let ((inhibit-quit nil)
-	    (case-fold-search isearch-case-fold-search))
-	(if isearch-regexp (setq isearch-invalid-regexp nil))
-	(setq isearch-within-brackets nil)
-	(setq isearch-success
-	      (funcall
-	       (cond (isearch-word
-		      (if isearch-forward
-			  'word-search-forward 'word-search-backward))
-		     (isearch-regexp
-		      (if isearch-forward
-			  're-search-forward 're-search-backward))
-		     (t
-		      (if isearch-forward 'search-forward 'search-backward)))
-	       isearch-string nil t))
-	(setq isearch-just-started nil)
-	(if isearch-success
-	    (setq isearch-other-end
-		  (if isearch-forward (match-beginning 0) (match-end 0)))))
-
-    (quit (isearch-unread ?\C-g)
-	  (setq isearch-success nil))
-
-    (invalid-regexp 
-     (setq isearch-invalid-regexp (car (cdr lossage)))
-     (setq isearch-within-brackets (string-match "\\`Unmatched \\["
-						 isearch-invalid-regexp))
-     (if (string-match
-	  "\\`Premature \\|\\`Unmatched \\|\\`Invalid "
-	  isearch-invalid-regexp)
-	 (setq isearch-invalid-regexp "incomplete input")))
-    (error
-     ;; stack overflow in regexp search.
-     (setq isearch-invalid-regexp (car (cdr lossage)))))
-
-  (if isearch-success
-      nil
-    ;; Ding if failed this time after succeeding last time.
-    (and (nth 3 (car isearch-cmds))
-	 (ding))
-    (goto-char (nth 2 (car isearch-cmds)))))
-
-
-
-;;; Highlighting
-
-(defvar isearch-overlay nil)
-
-(defun isearch-highlight (beg end)
-  (if (or (null search-highlight) (null window-system))
-      nil
-    (or isearch-overlay (setq isearch-overlay (make-overlay beg end)))
-    (move-overlay isearch-overlay beg end (current-buffer))
-    (overlay-put isearch-overlay 'face
-		 (if (internal-find-face 'isearch nil)
-		     'isearch 'region))))
-
-(defun isearch-dehighlight (totally)
-  (if isearch-overlay
-      (delete-overlay isearch-overlay)))
-
-;;; General utilities
-
-
-(defun isearch-no-upper-case-p (string regexp-flag)
-  "Return t if there are no upper case chars in STRING.
-If REGEXP-FLAG is non-nil, disregard letters preceded by `\\' (but not `\\\\')
-since they have special meaning in a regexp."
-  (let (quote-flag (i 0) (len (length string)) found) 
-    (while (and (not found) (< i len))
-      (let ((char (aref string i)))
-	(if (and regexp-flag (eq char ?\\))
-	    (setq quote-flag (not quote-flag))
-	  (if (and (not quote-flag) (not (eq char (downcase char))))
-	      (setq found t))))
-      (setq i (1+ i)))
-    (not found)))
-
-;; Portability functions to support various Emacs versions.
-
-(defun isearch-char-to-string (c)
-  (make-string 1 c))
-
-(defun isearch-text-char-description (c)
-  (if (and (integerp c) (or (< c ?\ ) (= c ?\^?)))
-      (text-char-description c)
-    (isearch-char-to-string c)))
-
-;; General function to unread characters or events.
-;; Also insert them in a keyboard macro being defined.
-(defun isearch-unread (&rest char-or-events)
-  (mapcar 'store-kbd-macro-event char-or-events)
-  (setq unread-command-events
-	(append char-or-events unread-command-events)))
-
-(defun isearch-last-command-char ()
-  ;; General function to return the last command character.
-  last-command-char)
-
-;;; isearch.el ends here
diff --git a/lisp/iso02-acc.el b/lisp/iso02-acc.el
deleted file mode 100644
index 585670ad802..00000000000
--- a/lisp/iso02-acc.el
+++ /dev/null
@@ -1,124 +0,0 @@
-;;; iso02-acc.el --- electric accent keys for Eastern Europe (ISO latin2)
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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.
-
-;;; Code:
-
-(defvar iso-accents-list
-  '(((?' ?A) ?\301)
-    ((?' ?C) ?\306) 
-    ((?' ?D) ?\320)
-    ((?' ?E) ?\311)
-    ((?' ?I) ?\315)
-    ((?' ?L) ?\305)
-    ((?' ?N) ?\321)
-    ((?' ?O) ?\323)
-    ((?' ?R) ?\300)
-    ((?' ?S) ?\246)
-    ((?' ?U) ?\332)
-    ((?' ?Y) ?\335)
-    ((?' ?Z) ?\254)
-    ((?' ?a) ?\341)
-    ((?' ?c) ?\346)
-    ((?' ?d) ?\360)  
-    ((?' ?e) ?\351)
-    ((?' ?i) ?\355)
-    ((?' ?l) ?\345)
-    ((?' ?n) ?\361)
-    ((?' ?o) ?\363)
-    ((?' ?r) ?\340)
-    ((?' ?s) ?\266)
-    ((?' ?u) ?\372)
-    ((?' ?y) ?\375)
-    ((?' ?z) ?\274)
-    ((?' ?') ?\264)
-    ((?' ? ) ?')
-    ((?` ?A) ?\241)
-    ((?` ?C) ?\307)
-    ((?` ?E) ?\312)
-    ((?` ?L) ?\243)
-    ((?` ?S) ?\252)
-    ((?` ?T) ?\336)
-    ((?` ?Z) ?\257)
-    ((?` ?a) ?\261)
-    ((?` ?l) ?\263)
-    ((?` ?c) ?\347)
-    ((?` ?e) ?\352)
-    ((?` ?s) ?\272)
-    ((?` ?t) ?\376)
-    ((?` ?z) ?\277)
-    ((?` ? ) ?`)
-    ((?` ?`) ?\252)
-    ((?` ?.) ?\377)
-    ((?^ ?A) ?\302)
-    ((?^ ?O) ?\324)
-    ((?^ ?a) ?\342)
-    ((?^ ?o) ?\364)
-    ((?^ ? ) ?^)
-    ((?^ ?^) ?^)		; no special code?
-    ((?\" ?A) ?\304)
-    ((?\" ?E) ?\313)
-    ((?\" ?O) ?\326)
-    ((?\" ?U) ?\334)
-    ((?\" ?a) ?\344)
-    ((?\" ?e) ?\353)
-    ((?\" ?o) ?\366)
-    ((?\" ?s) ?\337)
-    ((?\" ?u) ?\374)
-    ((?\" ? ) ?\")
-    ((?\" ?\") ?\250)
-    ((?\~ ?A) ?\303)
-    ((?\~ ?C) ?\310)
-    ((?\~ ?D) ?\317)
-    ((?\~ ?L) ?\245)
-    ((?\~ ?N) ?\322)
-    ((?\~ ?O) ?\325)
-    ((?\~ ?R) ?\330)
-    ((?\~ ?S) ?\251)
-    ((?\~ ?T) ?\253)
-    ((?\~ ?U) ?\333)
-    ((?\~ ?Z) ?\256)
-    ((?\~ ?a) ?\323)
-    ((?\~ ?c) ?\350)
-    ((?\~ ?d) ?\357)
-    ((?\~ ?l) ?\265)
-    ((?\~ ?n) ?\362)
-    ((?\~ ?o) ?\365)
-    ((?\~ ?r) ?\370)
-    ((?\~ ?s) ?\271)
-    ((?\~ ?t) ?\273)
-    ((?\~ ?u) ?\373)
-    ((?\~ ?z) ?\276)
-    ((?\~ ?\ ) ?\~)
-    ((?\~ ?v) ?\242) ;; v accent
-    ((?\~ ?\~) ?\242) ;; v accent
-    ((?\~ ?\.) ?\270) ;; cedilla accent
-    )
-  "Association list for ISO latin-2 accent combinations.")
-
-(defvar iso-accents-enable '(?' ?` ?^ ?\" ?~)
-  "*List of accent keys that become prefixes in ISO Accents mode.
-The default is (?' ?` ?^ ?\" ?~), which contains all the supported
-accent keys.  For certain languages, you might want to remove some of
-those characters that are not actually used.")
-
-(require 'iso-acc)
-
-;;; iso02-acc.el ends here
diff --git a/lisp/jka-compr.el b/lisp/jka-compr.el
deleted file mode 100644
index ef1a25f591a..00000000000
--- a/lisp/jka-compr.el
+++ /dev/null
@@ -1,842 +0,0 @@
-;;; jka-compr.el --- reading/writing/loading compressed files
-
-;; Copyright (C) 1993, 1994  Free Software Foundation, Inc.
-
-;; Author: jka@ece.cmu.edu (Jay K. Adams)
-;; Keywords: data
-
-;; 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 implements low-level support for reading, writing,
-;; and loading compressed files.  It hooks into the low-level file
-;; I/O functions (including write-region and insert-file-contents) so
-;; that they automatically compress or uncompress a file if the file
-;; appears to need it (based on the extension of the file name).
-;; Packages like Rmail, VM, GNUS, and Info should be able to work
-;; with compressed files without modification.
-
-
-;; INSTRUCTIONS:
-;;
-;; To use jka-compr, simply load this package, and edit as usual.
-;; Its operation should be transparent to the user (except for
-;; messages appearing when a file is being compressed or
-;; uncompressed).
-;;
-;; The variable, jka-compr-compression-info-list can be used to
-;; customize jka-compr to work with other compression programs.
-;; The default value of this variable allows jka-compr to work with
-;; Unix compress and gzip.
-;;
-;; If you are concerned about the stderr output of gzip and other
-;; compression/decompression programs showing up in your buffers, you
-;; should set the discard-error flag in the compression-info-list.
-;; This will cause the stderr of all programs to be discarded.
-;; However, it also causes emacs to call compression/uncompression
-;; programs through a shell (which is specified by jka-compr-shell).
-;; This may be a drag if, on your system, starting up a shell is
-;; slow.
-;;
-;; If you don't want messages about compressing and decompressing
-;; to show up in the echo area, you can set the compress-name and
-;; decompress-name fields of the jka-compr-compression-info-list to
-;; nil.
-
-
-;; APPLICATION NOTES:
-;;
-;; crypt++
-;;   jka-compr can coexist with crpyt++ if you take all the decompression
-;;   entries out of the crypt-encoding-list.  Clearly problems will arise if
-;;   you have two programs trying to compress/decompress files.  jka-compr
-;;   will not "work with" crypt++ in the following sense: you won't be able to
-;;   decode encrypted compressed files--that is, files that have been
-;;   compressed then encrypted (in that order).  Theoretically, crypt++ and
-;;   jka-compr could properly handle a file that has been encrypted then
-;;   compressed, but there is little point in trying to compress an encrypted
-;;   file.
-;;
-
-
-;; ACKNOWLEDGMENTS
-;; 
-;; jka-compr is a V19 adaptation of jka-compr for V18 of Emacs.  Many people
-;; have made helpful suggestions, reported bugs, and even fixed bugs in 
-;; jka-compr.  I recall the following people as being particularly helpful.
-;;
-;;   Jean-loup Gailly
-;;   David Hughes
-;;   Richard Pieri
-;;   Daniel Quinlan
-;;   Chris P. Ross
-;;   Rick Sladkey
-;;
-;; Andy Norman's ange-ftp was the inspiration for the original jka-compr for
-;; Version 18 of Emacs.
-;;
-;; After I had made progress on the original jka-compr for V18, I learned of a
-;; package written by Kazushi Jam Marukawa, called jam-zcat, that did exactly
-;; what I was trying to do.  I looked over the jam-zcat source code and
-;; probably got some ideas from it.
-;;
-
-;;; Code:
-
-(defvar jka-compr-shell "sh"
-  "*Shell to be used for calling compression programs.
-The value of this variable only matters if you want to discard the
-stderr of a compression/decompression program (see the documentation
-for `jka-compr-compression-info-list').")
-
-
-(defvar jka-compr-use-shell t)
-
-
-;;; I have this defined so that .Z files are assumed to be in unix
-;;; compress format; and .gz files, in gzip format.
-(defvar jka-compr-compression-info-list
-  ;;[regexp
-  ;; compr-message  compr-prog  compr-args
-  ;; uncomp-message uncomp-prog uncomp-args
-  ;; can-append auto-mode-flag]
-  '(["\\.Z\\(~\\|\\.~[0-9]+~\\)?\\'"
-     "compressing"    "compress"     ("-c")
-     "uncompressing"  "uncompress"   ("-c")
-     nil t]
-    ["\\.tgz\\'"
-     "zipping"        "gzip"         ("-c" "-q")
-     "unzipping"      "gzip"         ("-c" "-q" "-d")
-     t nil]
-    ["\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'"
-     "zipping"        "gzip"         ("-c" "-q")
-     "unzipping"      "gzip"         ("-c" "-q" "-d")
-     t t])
-
-  "List of vectors that describe available compression techniques.
-Each element, which describes a compression technique, is a vector of
-the form [REGEXP COMPRESS-MSG COMPRESS-PROGRAM COMPRESS-ARGS
-UNCOMPRESS-MSG UNCOMPRESS-PROGRAM UNCOMPRESS-ARGS
-APPEND-FLAG EXTENSION], where:
-
-   regexp                is a regexp that matches filenames that are
-                         compressed with this format
-
-   compress-msg          is the message to issue to the user when doing this
-                         type of compression (nil means no message)
-
-   compress-program      is a program that performs this compression
-
-   compress-args         is a list of args to pass to the compress program
-
-   uncompress-msg        is the message to issue to the user when doing this
-                         type of uncompression (nil means no message)
-
-   uncompress-program    is a program that performs this compression
-
-   uncompress-args       is a list of args to pass to the uncompress program
-
-   append-flag           is non-nil if this compression technique can be
-                         appended
-
-   auto-mode flag        non-nil means strip the regexp from file names
-                         before attempting to set the mode.
-
-Because of the way `call-process' is defined, discarding the stderr output of
-a program adds the overhead of starting a shell each time the program is
-invoked.")
-
-(defvar jka-compr-mode-alist-additions
-  (list (cons "\\.tgz\\'" 'tar-mode))
-  "A list of pairs to add to auto-mode-alist when jka-compr is installed.")
-
-(defvar jka-compr-file-name-handler-entry
-  nil
-  "The entry in `file-name-handler-alist' used by the jka-compr I/O functions.")
-
-;;; Functions for accessing the return value of jka-compr-get-compression-info
-(defun jka-compr-info-regexp               (info)  (aref info 0))
-(defun jka-compr-info-compress-message     (info)  (aref info 1))
-(defun jka-compr-info-compress-program     (info)  (aref info 2))
-(defun jka-compr-info-compress-args        (info)  (aref info 3))
-(defun jka-compr-info-uncompress-message   (info)  (aref info 4))
-(defun jka-compr-info-uncompress-program   (info)  (aref info 5))
-(defun jka-compr-info-uncompress-args      (info)  (aref info 6))
-(defun jka-compr-info-can-append           (info)  (aref info 7))
-(defun jka-compr-info-strip-extension      (info)  (aref info 8))
-
-
-(defun jka-compr-get-compression-info (filename)
-  "Return information about the compression scheme of FILENAME.
-The determination as to which compression scheme, if any, to use is
-based on the filename itself and `jka-compr-compression-info-list'."
-  (catch 'compression-info
-    (let ((case-fold-search nil))
-      (mapcar
-       (function (lambda (x)
-		   (and (string-match (jka-compr-info-regexp x) filename)
-			(throw 'compression-info x))))
-       jka-compr-compression-info-list)
-      nil)))
-
-
-(put 'compression-error 'error-conditions '(compression-error file-error error))
-
-
-(defvar jka-compr-acceptable-retval-list '(0 2 141))
-
-
-(defun jka-compr-error (prog args infile message &optional errfile)
-
-  (let ((errbuf (get-buffer-create " *jka-compr-error*"))
-	(curbuf (current-buffer)))
-    (set-buffer errbuf)
-    (widen) (erase-buffer)
-    (insert (format "Error while executing \"%s %s < %s\"\n\n"
-		     prog
-		     (mapconcat 'identity args " ")
-		     infile))
-
-     (and errfile
-	  (insert-file-contents errfile))
-
-     (set-buffer curbuf)
-     (display-buffer errbuf))
-
-  (signal 'compression-error (list "Opening input file" (format "error %s" message) infile)))
-			
-   
-(defvar jka-compr-dd-program
-  "/bin/dd")
-
-
-(defvar jka-compr-dd-blocksize 256)
-
-
-(defun jka-compr-partial-uncompress (prog message args infile beg len)
-  "Call program PROG with ARGS args taking input from INFILE.
-Fourth and fifth args, BEG and LEN, specify which part of the output
-to keep: LEN chars starting BEG chars from the beginning."
-  (let* ((skip (/ beg jka-compr-dd-blocksize))
-	 (prefix (- beg (* skip jka-compr-dd-blocksize)))
-	 (count (and len (1+ (/ (+ len prefix) jka-compr-dd-blocksize))))
-	 (start (point))
-	 (err-file (jka-compr-make-temp-name))
-	 (run-string (format "%s %s 2> %s | %s bs=%d skip=%d %s 2> /dev/null"
-			     prog
-			     (mapconcat 'identity args " ")
-			     err-file
-			     jka-compr-dd-program
-			     jka-compr-dd-blocksize
-			     skip
-			     ;; dd seems to be unreliable about
-			     ;; providing the last block.  So, always
-			     ;; read one more than you think you need.
-			     (if count (concat "count=" (1+ count)) ""))))
-
-    (unwind-protect
-	(or (memq (call-process jka-compr-shell
-				infile t nil "-c"
-				run-string)
-		  jka-compr-acceptable-retval-list)
-	    
-	    (jka-compr-error prog args infile message err-file))
-
-      (jka-compr-delete-temp-file err-file))
-
-    ;; Delete the stuff after what we want, if there is any.
-    (and
-     len
-     (< (+ start prefix len) (point))
-     (delete-region (+ start prefix len) (point)))
-
-    ;; Delete the stuff before what we want.
-    (delete-region start (+ start prefix))))
-
-
-(defun jka-compr-call-process (prog message infile output temp args)
-  (if jka-compr-use-shell
-
-      (let ((err-file (jka-compr-make-temp-name)))
-	    
-	(unwind-protect
-
-	    (or (memq
-		 (call-process jka-compr-shell infile
-			       (if (stringp output) nil output)
-			       nil
-			       "-c"
-			       (format "%s %s 2> %s %s"
-				       prog
-				       (mapconcat 'identity args " ")
-				       err-file
-				       (if (stringp output)
-					   (concat "> " output)
-					 "")))
-		 jka-compr-acceptable-retval-list)
-
-		(jka-compr-error prog args infile message err-file))
-
-	  (jka-compr-delete-temp-file err-file)))
-
-    (or (zerop
-	 (apply 'call-process
-		prog
-		infile
-		(if (stringp output) temp output)
-		nil
-		args))
-	(jka-compr-error prog args infile message))
-
-    (and (stringp output)
-	 (let ((cbuf (current-buffer)))
-	   (set-buffer temp)
-	   (write-region (point-min) (point-max) output)
-	   (erase-buffer)
-	   (set-buffer cbuf)))))
-
-
-;;; Support for temp files.  Much of this was inspired if not lifted
-;;; from ange-ftp.
-
-(defvar jka-compr-temp-name-template
-  (expand-file-name "jka-com"
-		    (or (getenv "TMPDIR") "/tmp/"))
-  "Prefix added to all temp files created by jka-compr.
-There should be no more than seven characters after the final `/'")
-
-(defvar jka-compr-temp-name-table (make-vector 31 nil))
-
-(defun jka-compr-make-temp-name (&optional local-copy)
-  "This routine will return the name of a new file."
-  (let* ((lastchar ?a)
-	 (prevchar ?a)
-	 (template (concat jka-compr-temp-name-template "aa"))
-	 (lastpos (1- (length template)))
-	 (not-done t)
-	 file
-	 entry)
-
-    (while not-done
-      (aset template lastpos lastchar)
-      (setq file (concat (make-temp-name template) "#"))
-      (setq entry (intern file jka-compr-temp-name-table))
-      (if (or (get entry 'active)
-	      (file-exists-p file))
-
-	  (progn
-	    (setq lastchar (1+ lastchar))
-	    (if (> lastchar ?z)
-		(progn
-		  (setq prevchar (1+ prevchar))
-		  (setq lastchar ?a)
-		  (if (> prevchar ?z)
-		      (error "Can't allocate temp file.")
-		    (aset template (1- lastpos) prevchar)))))
-
-	(put entry 'active (not local-copy))
-	(setq not-done nil)))
-
-    file))
-
-
-(defun jka-compr-delete-temp-file (temp)
-
-  (put (intern temp jka-compr-temp-name-table)
-       'active nil)
-
-  (condition-case ()
-      (delete-file temp)
-    (error nil)))
-
-
-(defun jka-compr-write-region (start end file &optional append visit)
-  (let* ((filename (expand-file-name file))
-	 (visit-file (if (stringp visit) (expand-file-name visit) filename))
-	 (info (jka-compr-get-compression-info visit-file)))
-      
-      (if info
-
-	  (let ((can-append (jka-compr-info-can-append info))
-		(compress-program (jka-compr-info-compress-program info))
-		(compress-message (jka-compr-info-compress-message info))
-		(uncompress-program (jka-compr-info-uncompress-program info))
-		(uncompress-message (jka-compr-info-uncompress-message info))
-		(compress-args (jka-compr-info-compress-args info))
-		(uncompress-args (jka-compr-info-uncompress-args info))
-		(base-name (file-name-nondirectory visit-file))
-		temp-file cbuf temp-buffer)
-
-	    (setq cbuf (current-buffer)
-		  temp-buffer (get-buffer-create " *jka-compr-wr-temp*"))
-	    (set-buffer temp-buffer)
-	    (widen) (erase-buffer)
-	    (set-buffer cbuf)
-
-	    (if (and append
-		     (not can-append)
-		     (file-exists-p filename))
-		
-		(let* ((local-copy (file-local-copy filename))
-		       (local-file (or local-copy filename)))
-		  
-		  (setq temp-file local-file))
-
-	      (setq temp-file (jka-compr-make-temp-name)))
-
-	    (and 
-	     compress-message
-	     (message "%s %s..." compress-message base-name))
-	    
-	    (jka-compr-run-real-handler 'write-region
-					(list start end temp-file t 'dont))
-
-	    (jka-compr-call-process compress-program
-				    (concat compress-message
-					    " " base-name)
-				    temp-file
-				    temp-buffer
-				    nil
-				    compress-args)
-
-	    (set-buffer temp-buffer)
-	    (jka-compr-run-real-handler 'write-region
-					(list (point-min) (point-max)
-					      filename
-					      (and append can-append) 'dont))
-	    (erase-buffer)
-	    (set-buffer cbuf)
-
-	    (jka-compr-delete-temp-file temp-file)
-
-	    (and
-	     compress-message
-	     (message "%s %s...done" compress-message base-name))
-
-	    (cond
-	     ((eq visit t)
-	      (setq buffer-file-name filename)
-	      (set-visited-file-modtime))
-	     ((stringp visit)
-	      (setq buffer-file-name visit)
-	      (let ((buffer-file-name filename))
-		(set-visited-file-modtime))))
-
-	    (and (or (eq visit t)
-		     (eq visit nil)
-		     (stringp visit))
-		 (message "Wrote %s" visit-file))
-
-	    nil)
-	      
-	(jka-compr-run-real-handler 'write-region
-				    (list start end filename append visit)))))
-
-
-(defun jka-compr-insert-file-contents (file &optional visit beg end replace)
-  (barf-if-buffer-read-only)
-
-  (and (or beg end)
-       visit
-       (error "Attempt to visit less than an entire file"))
-
-  (let* ((filename (expand-file-name file))
-	 (info (jka-compr-get-compression-info filename)))
-
-    (if info
-
-	(let ((uncompress-message (jka-compr-info-uncompress-message info))
-	      (uncompress-program (jka-compr-info-uncompress-program info))
-	      (uncompress-args (jka-compr-info-uncompress-args info))
-	      (base-name (file-name-nondirectory filename))
-	      (notfound nil)
-	      (local-copy
-	       (jka-compr-run-real-handler 'file-local-copy (list filename)))
-	      local-file
-	      size start)
-
-	  (setq local-file (or local-copy filename))
-
-	  (and
-	   visit
-	   (setq buffer-file-name filename))
-
-	  (unwind-protect		; to make sure local-copy gets deleted
-
-	      (progn
-		  
-		(and
-		 uncompress-message
-		 (message "%s %s..." uncompress-message base-name))
-
-		(condition-case error-code
-
-		    (progn
-		      (if replace
-			  (goto-char (point-min)))
-		      (setq start (point))
-		      (if (or beg end)
-			  (jka-compr-partial-uncompress uncompress-program
-							(concat uncompress-message
-								" " base-name)
-							uncompress-args
-							local-file
-							(or beg 0)
-							(if (and beg end)
-							    (- end beg)
-							  end))
-			;; If visiting, bind off buffer-file-name so that
-			;; file-locking will not ask whether we should
-			;; really edit the buffer.
-			(let ((buffer-file-name
-			       (if visit nil buffer-file-name)))
-			  (jka-compr-call-process uncompress-program
-						  (concat uncompress-message
-							  " " base-name)
-						  local-file
-						  t
-						  nil
-						  uncompress-args)))
-		      (setq size (- (point) start))
-		      (if replace
-			  (let* ((del-beg (point))
-				 (del-end (+ del-beg size)))
-			    (delete-region del-beg
-					   (min del-end (point-max)))))
-		      (goto-char start))
-		  (error
-		   (if (and (eq (car error-code) 'file-error)
-			    (eq (nth 3 error-code) local-file))
-		       (if visit
-			   (setq notfound error-code)
-			 (signal 'file-error 
-				 (cons "Opening input file"
-				       (nthcdr 2 error-code))))
-		     (signal (car error-code) (cdr error-code))))))
-
-	    (and
-	     local-copy
-	     (file-exists-p local-copy)
-	     (delete-file local-copy)))
-
-	  (and
-	   visit
-	   (progn
-	     (unlock-buffer)
-	     (setq buffer-file-name filename)
-	     (set-visited-file-modtime)))
-	    
-	  (and
-	   uncompress-message
-	   (message "%s %s...done" uncompress-message base-name))
-
-	  (and
-	   visit
-	   notfound
-	   (signal 'file-error
-		   (cons "Opening input file" (nth 2 notfound))))
-
-	  ;; Run the functions that insert-file-contents would.
-	  (let ((p after-insert-file-functions)
-		(insval size))
-	    (while p
-	      (setq insval (funcall (car p) size))
-	      (if insval
-		  (progn
-		    (or (integerp insval)
-			(signal 'wrong-type-argument
-				(list 'integerp insval)))
-		    (setq size insval)))
-	      (setq p (cdr p))))
-
-	  (list filename size))
-
-      (jka-compr-run-real-handler 'insert-file-contents
-				  (list file visit beg end replace)))))
-
-
-(defun jka-compr-file-local-copy (file)
-  (let* ((filename (expand-file-name file))
-	 (info (jka-compr-get-compression-info filename)))
-
-    (if info
-
-	(let ((uncompress-message (jka-compr-info-uncompress-message info))
-	      (uncompress-program (jka-compr-info-uncompress-program info))
-	      (uncompress-args (jka-compr-info-uncompress-args info))
-	      (base-name (file-name-nondirectory filename))
-	      (local-copy
-	       (jka-compr-run-real-handler 'file-local-copy (list filename)))
-	      (temp-file (jka-compr-make-temp-name t))
-	      (temp-buffer (get-buffer-create " *jka-compr-flc-temp*"))
-	      (notfound nil)
-	      (cbuf (current-buffer))
-	      local-file)
-
-	  (setq local-file (or local-copy filename))
-
-	  (unwind-protect
-
-	      (progn
-		  
-		(and
-		 uncompress-message
-		 (message "%s %s..." uncompress-message base-name))
-
-		(set-buffer temp-buffer)
-		  
-		(jka-compr-call-process uncompress-program
-					(concat uncompress-message
-						" " base-name)
-					local-file
-					t
-					nil
-					uncompress-args)
-
-		(and
-		 uncompress-message
-		 (message "%s %s...done" uncompress-message base-name))
-
-		(write-region
-		 (point-min) (point-max) temp-file nil 'dont))
-
-	    (and
-	     local-copy
-	     (file-exists-p local-copy)
-	     (delete-file local-copy))
-
-	    (set-buffer cbuf)
-	    (kill-buffer temp-buffer))
-
-	  temp-file)
-	    
-      (jka-compr-run-real-handler 'file-local-copy (list filename)))))
-
-
-;;; Support for loading compressed files.
-(defun jka-compr-load (file &optional noerror nomessage nosuffix)
-  "Documented as original."
-
-  (let* ((local-copy (jka-compr-file-local-copy file))
-	 (load-file (or local-copy file)))
-
-    (unwind-protect
-
-	(let (inhibit-file-name-operation
-	      inhibit-file-name-handlers)
-	  (or nomessage
-	      (message "Loading %s..." file))
-
-	  (let ((load-force-doc-strings t))
-	    (load load-file noerror t t))
-
-	  (or nomessage
-	      (message "Loading %s...done." file)))
-
-      (jka-compr-delete-temp-file local-copy))
-
-    t))
-
-(defun jka-compr-byte-compiler-base-file-name (file)
-  (let ((info (jka-compr-get-compression-info file)))
-    (if (and info (jka-compr-info-strip-extension info))
-	(save-match-data
-	  (substring file 0 (string-match (jka-compr-info-regexp info) file)))
-      file)))
-
-(put 'write-region 'jka-compr 'jka-compr-write-region)
-(put 'insert-file-contents 'jka-compr 'jka-compr-insert-file-contents)
-(put 'file-local-copy 'jka-compr 'jka-compr-file-local-copy)
-(put 'load 'jka-compr 'jka-compr-load)
-(put 'byte-compiler-base-file-name 'jka-compr
-     'jka-compr-byte-compiler-base-file-name)
-
-(defun jka-compr-handler (operation &rest args)
-  (save-match-data
-    (let ((jka-op (get operation 'jka-compr)))
-      (if jka-op
-	  (apply jka-op args)
-	(jka-compr-run-real-handler operation args)))))
-
-;; If we are given an operation that we don't handle,
-;; call the Emacs primitive for that operation,
-;; and manipulate the inhibit variables
-;; to prevent the primitive from calling our handler again.
-(defun jka-compr-run-real-handler (operation args)
-  (let ((inhibit-file-name-handlers
-	 (cons 'jka-compr-handler
-	       (and (eq inhibit-file-name-operation operation)
-		    inhibit-file-name-handlers)))
-	(inhibit-file-name-operation operation))
-    (apply operation args)))
-
-;;;###autoload(defun auto-compression-mode (&optional arg)
-;;;###autoload  "\
-;;;###autoloadToggle automatic file compression and uncompression.
-;;;###autoloadWith prefix argument ARG, turn auto compression on if positive, else off.
-;;;###autoloadReturns the new status of auto compression (non-nil means on)."
-;;;###autoload  (interactive "P")
-;;;###autoload  (if (not (fboundp 'jka-compr-installed-p))
-;;;###autoload      (progn
-;;;###autoload        (require 'jka-compr)
-;;;###autoload        ;; That turned the mode on, so make it initially off.
-;;;###autoload        (toggle-auto-compression)))
-;;;###autoload  (toggle-auto-compression arg t))
-
-(defun toggle-auto-compression (&optional arg message)
-  "Toggle automatic file compression and uncompression.
-With prefix argument ARG, turn auto compression on if positive, else off.
-Returns the new status of auto compression (non-nil means on).
-If the argument MESSAGE is non-nil, it means to print a message
-saying whether the mode is now on or off."
-  (interactive "P\np")
-  (let* ((installed (jka-compr-installed-p))
-	 (flag (if (null arg)
-		   (not installed)
-		 (or (eq arg t) (listp arg) (and (integerp arg) (> arg 0))))))
-
-    (cond
-     ((and flag installed) t)		; already installed
-
-     ((and (not flag) (not installed)) nil) ; already not installed
-
-     (flag
-      (jka-compr-install))
-
-     (t
-      (jka-compr-uninstall)))
-
-
-    (and message
-	 (if flag
-	     (message "Automatic file (de)compression is now ON.")
-	   (message "Automatic file (de)compression is now OFF.")))
-
-    flag))
-
-(defun jka-compr-build-file-regexp ()
-  (concat
-   "\\("
-   (mapconcat
-    'jka-compr-info-regexp
-    jka-compr-compression-info-list
-    "\\)\\|\\(")
-   "\\)"))
-
-
-(defun jka-compr-install ()
-  "Install jka-compr.
-This adds entries to `file-name-handler-alist' and `auto-mode-alist'
-and `inhibit-first-line-modes-suffixes'."
-
-  (setq jka-compr-file-name-handler-entry
-	(cons (jka-compr-build-file-regexp) 'jka-compr-handler))
-
-  (setq file-name-handler-alist (cons jka-compr-file-name-handler-entry
-				      file-name-handler-alist))
-
-  (mapcar
-   (function (lambda (x)
-	       (and (jka-compr-info-strip-extension x)
-		    ;; Make entries in auto-mode-alist so that modes
-		    ;; are chosen right according to the file names
-		    ;; sans `.gz'.
-		    (setq auto-mode-alist
-			  (cons (list (jka-compr-info-regexp x)
-				      nil 'jka-compr)
-				auto-mode-alist))
-		    ;; Also add these regexps to
-		    ;; inhibit-first-line-modes-suffixes, so that a
-		    ;; -*- line in the first file of a compressed tar
-		    ;; file doesn't override tar-mode.
-		    (setq inhibit-first-line-modes-suffixes
-			  (cons (jka-compr-info-regexp x)
-				inhibit-first-line-modes-suffixes)))))
-   jka-compr-compression-info-list)
-  (setq auto-mode-alist
-	(append auto-mode-alist jka-compr-mode-alist-additions)))
-
-
-(defun jka-compr-uninstall ()
-  "Uninstall jka-compr.
-This removes the entries in `file-name-handler-alist' and `auto-mode-alist'
-and `inhibit-first-line-modes-suffixes' that were added
-by `jka-compr-installed'."
-  ;; Delete from inhibit-first-line-modes-suffixes
-  ;; what jka-compr-install added.
-  (mapcar
-     (function (lambda (x)
-		 (and (jka-compr-info-strip-extension x)
-		      (setq inhibit-first-line-modes-suffixes
-			    (delete (jka-compr-info-regexp x)
-				    inhibit-first-line-modes-suffixes)))))
-     jka-compr-compression-info-list)
-
-  (let* ((fnha (cons nil file-name-handler-alist))
-	 (last fnha))
-
-    (while (cdr last)
-      (if (eq (cdr (car (cdr last))) 'jka-compr-handler)
-	  (setcdr last (cdr (cdr last)))
-	(setq last (cdr last))))
-
-    (setq file-name-handler-alist (cdr fnha)))
-
-  (let* ((ama (cons nil auto-mode-alist))
-	 (last ama)
-	 entry)
-
-    (while (cdr last)
-      (setq entry (car (cdr last)))
-      (if (or (member entry jka-compr-mode-alist-additions)
-	      (and (consp (cdr entry))
-		   (eq (nth 2 entry) 'jka-compr)))
-	  (setcdr last (cdr (cdr last)))
-	(setq last (cdr last))))
-    
-    (setq auto-mode-alist (cdr ama))))
-
-      
-(defun jka-compr-installed-p ()
-  "Return non-nil if jka-compr is installed.
-The return value is the entry in `file-name-handler-alist' for jka-compr."
-
-  (let ((fnha file-name-handler-alist)
-	(installed nil))
-
-    (while (and fnha (not installed))
-     (and (eq (cdr (car fnha)) 'jka-compr-handler)
-	   (setq installed (car fnha)))
-      (setq fnha (cdr fnha)))
-
-    installed))
-
-
-;;; Add the file I/O hook if it does not already exist.
-;;; Make sure that jka-compr-file-name-handler-entry is eq to the
-;;; entry for jka-compr in file-name-handler-alist.
-(and (jka-compr-installed-p)
-     (jka-compr-uninstall))
-
-(jka-compr-install)
-
-
-(provide 'jka-compr)
-
-;; jka-compr.el ends here.
diff --git a/lisp/kermit.el b/lisp/kermit.el
deleted file mode 100644
index 0eebc7aa082..00000000000
--- a/lisp/kermit.el
+++ /dev/null
@@ -1,149 +0,0 @@
-;;; kermit.el --- additions to shell mode for use with kermit, etc.
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Jeff Norden <jeff@colgate.csnet>
-;; Created: 15 Feb 1988
-;; Keywords: comm
-
-;; 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:
-
-;; I'm not sure, but I think somebody asked about running kermit under shell
-;; mode a while ago.  Anyway, here is some code that I find useful.  The result
-;; is that I can log onto machines with primitive operating systems (VMS and
-;; ATT system V :-), and still have the features of shell-mode available for
-;; command history, etc.  It's also handy to be able to run a file transfer in
-;; an emacs window.  The transfer is in the "background", but you can also
-;; monitor or stop it easily.
-
-;; The ^\ key is bound to a function for sending escape sequences to kermit,
-;; and ^C^Q can be used to send any control characters needed thru to the
-;; system you connect to.  A more serious problem is that some brain-dead
-;; systems will not recognize a ^J as an end-of-line character.  So LFD is
-;; bound to a new function which acts just like CR usually does in shell-mode,
-;; but a ^M is sent as an end-of-line.  Functions are also provided to swap the
-;; bindings of CR and LFD.  I've also included a filter which will clean out
-;; any ^M's or ^@'s that get typed at you, but I don't really recommend it.
-;; There doesn't seem to be an acceptably fast way to do this via emacs-lisp.
-;; Invoking kermit by the command " kermit | tr -d '\015' " seems to work
-;; better (on my system anyway).
-
-;; Here's how I've been using this setup.  We have several machines connected
-;; thru a fairly stupid terminal switch.  If I want to connect to unix system,
-;; then I use the LFD key to talk to the switch, and ignore any ^M's in the
-;; buffer, and do a " stty -echo nl " after I log in.  Then the only real
-;; difference from being in local shell-mode is that you need to type
-;; ^C^Q^C to send an interrupt, and ^C^Q^Z for a stop signal, etc.  (since ^C^C
-;; just generates a local stop signal, which kermit ignores).
-;; To connect to a VMS system, I use a shell script to invoke kermit thru the
-;; tr filter, do "M-X kermit-send-cr", and then tell VMS that I'm on a 
-;; half-duplex terminal.
-
-;; Some caveats:
-;; 1) Kermit under shell mode is a real pain if you don't have pty's.  I
-;; recently discovered this on our 3b2/400.  When kermit can't find a tty, it
-;; assumes it is supposed to be in remote mode.  So the simple command "kermit"
-;; won't work in shell mode on such a system.  You can get around this by using
-;; the -c (connect) command line option, which means you also have to specify a
-;; line and baud on the command line, as in "kermit -l /dev/tty53 -b 9600 -c".
-;; However, this will cause kermit to exit when the connection is closed.  So
-;; in order to do a file transfer, you have to think ahead and and add -r
-;; (receive) to the command line.  This means that you can't use the server
-;; feature.  The only fix I can see is to muck around with the source code for
-;; kermit, although this probably wouldn't be too hard.  What is needed is an
-;; option to force kermit to be local, to use stdin and stdout for interactive
-;; speech, and to forget about cbreak mode.
-
-;; Please let me know if any bugs turn up.
-;; Feb 1988, Jeff Norden - jeff@colgate.csnet
-
-;;; Code:
-
-(require 'shell)
-
-(defvar kermit-esc-char "\C-\\" "*Kermit's escape char")
-
-(defun kermit-esc ()
-  "For sending escape sequences to a kermit running in shell mode."
-  (interactive)
-  (process-send-string 
-   (get-buffer-process (current-buffer))
-   (concat kermit-esc-char (char-to-string (read-char)))))
-
-(defun kermit-send-char ()
-  "Send an arbitrary character to a program in shell mode."
-  (interactive)
-  (process-send-string 
-   (get-buffer-process (current-buffer))
-   (char-to-string (read-char))))
-
-(define-key shell-mode-map "\C-\\" 'kermit-esc)
-(define-key shell-mode-map "\C-c\C-q" 'kermit-send-char)
-;; extra bindings for folks suffering form ^S/^Q braindamage:
-(define-key shell-mode-map "\C-c\\" 'kermit-esc)
-
-(defun kermit-send-input-cr ()
-  "Like \\[comint-send-input] but end the line with carriage-return."
-  (interactive)
-  (comint-send-input)
-  (comint-send-string (get-buffer-process (current-buffer)) "\r"))
-
-;; This is backwards of what makes sense, but ...
-(define-key shell-mode-map "\n" 'kermit-send-input-cr)
-
-(defun kermit-default-cr ()
-  "Make RETURN end the line with carriage-return and LFD end it with a newline.
-This is useful for talking to other systems on which carriage-return
-is the normal way to end a line."
-  (interactive)
-  (define-key shell-mode-map "\r" 'kermit-send-input-cr)
-  (define-key shell-mode-map "\n" 'comint-send-input))
-
-(defun kermit-default-nl ()
-  "Make RETURN end the line with a newline char.  This is the default state.
-In this state, use LFD to send a line and end it with a carriage-return."
-  (interactive)
-  (define-key shell-mode-map "\n" 'kermit-send-input-cr)
-  (define-key shell-mode-map "\r" 'comint-send-input))
-
-(defun kermit-clean-filter (proc str)
-  "Strip ^M and ^@ characters from process output."
-  (save-excursion
-    (let ((beg (process-mark proc)))
-      (set-buffer (process-buffer proc))
-      (goto-char beg)
-      (insert-before-markers str)
-      (while (re-search-backward "[\r\C-a]+" beg t)
-	(replace-match "")))))
-
-(defun kermit-clean-on ()
-  "Delete all null characters and ^M's from the kermit output.
-Note that another (perhaps better) way to do this is to use the
-command `kermit | tr -d '\\015''."
-  (interactive)
-  (set-process-filter (get-buffer-process (current-buffer))
-		      'kermit-clean-filter))
-
-(defun kermit-clean-off ()
-  "Cancel a previous kermit-clean-shell-on command."
-  (interactive)
-  (set-process-filter (get-buffer-process (current-buffer)) nil))
-
-;;; kermit.el ends here
diff --git a/lisp/lazy-lock.el b/lisp/lazy-lock.el
deleted file mode 100644
index fffb0204c77..00000000000
--- a/lisp/lazy-lock.el
+++ /dev/null
@@ -1,1047 +0,0 @@
-;;; lazy-lock.el --- Lazy demand-driven fontification for fast Font Lock mode.
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Simon Marshall <simon@gnu.ai.mit.edu>
-;; Keywords: faces files
-;; Version: 2.07
-
-;;; 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:
-
-;; Lazy Lock mode is a Font Lock support mode.
-;; It makes visiting buffers in Font Lock mode faster by making fontification
-;; be demand-driven, deferred and stealthy, so that fontification only occurs
-;; when, and where, necessary.
-;;
-;; See caveats and feedback below.
-;; See also the fast-lock package.  (But don't use them at the same time!)
-
-;; Installation:
-;; 
-;; Put in your ~/.emacs:
-;;
-;; (setq font-lock-support-mode 'lazy-lock-mode)
-;;
-;; Start up a new Emacs and use font-lock as usual (except that you can use the
-;; so-called "gaudier" fontification regexps on big files without frustration).
-;;
-;; In a buffer (which has `font-lock-mode' enabled) which is at least
-;; `lazy-lock-minimum-size' characters long, buffer fontification will not
-;; occur and only the visible portion of the buffer will be fontified.  Motion
-;; around the buffer will fontify those visible portions not previously
-;; fontified.  If stealth fontification is enabled, buffer fontification will
-;; occur in invisible parts of the buffer after `lazy-lock-stealth-time'
-;; seconds of idle time.  If on-the-fly fontification is deferred, on-the-fly
-;; fontification will occur after `lazy-lock-defer-time' seconds of idle time.
-
-;; User-visible differences with version 1:
-;;
-;; - Version 2 can defer on-the-fly fontification.  Therefore you need not, and
-;; should not, use defer-lock.el with this version of lazy-lock.el.
-;;
-;; A number of variables have changed meaning:
-;;
-;; - A value of nil for the variable `lazy-lock-minimum-size' means never turn
-;; on demand-driven fontification.  In version 1 this meant always turn on
-;; demand-driven fontification.  If you really want demand-driven fontification
-;; regardless of buffer size, set this variable to 0.
-;;
-;; - The variable `lazy-lock-stealth-lines' cannot have a nil value.  In
-;; version 1 this meant use `window-height' as the maximum number of lines to
-;; fontify as a stealth chunk.  This makes no sense; stealth fontification is
-;; of a buffer, not a window.
-
-;; Implementation differences with version 1:
-;;
-;; - Version 1 of lazy-lock.el is a bit of a hack.  Version 1 demand-driven
-;; fontification, the core feature of lazy-lock.el, is implemented by placing a
-;; function on `post-command-hook'.  This function fontifies where necessary,
-;; i.e., where a window scroll has occurred.  However, there are a number of
-;; problems with using `post-command-hook':
-;;
-;; (a) As the name suggests, `post-command-hook' is run after every command,
-;;     i.e., frequently and regardless of whether scrolling has occurred.
-;; (b) Scrolling can occur during a command, when `post-command-hook' is not
-;;     run, i.e., it is not necessarily run after scrolling has occurred.
-;; (c) When `post-command-hook' is run, there is nothing to suggest where
-;;     scrolling might have occurred, i.e., which windows have scrolled.
-;;
-;; Thus lazy-lock.el's function is called almost as often as possible, usually
-;; when it need not be called, yet it is not always called when it is needed.
-;; Also, lazy-lock.el's function must check each window to see if a scroll has
-;; occurred there.  Worse still, lazy-lock.el's function must fontify a region
-;; twice as large as necessary to make sure the window is completely fontified.
-;; Basically, `post-command-hook' is completely inappropriate for lazy-lock.el.
-;;
-;; Ideally, we want to attach lazy-lock.el's function to a hook that is run
-;; only when scrolling occurs, e.g., `window-start' has changed, and tells us
-;; as much information as we need, i.e., the window and its new buffer region.
-;; Richard Stallman implemented a `window-scroll-functions' for Emacs 19.30.
-;; Functions on it are run when `window-start' has changed, and are supplied
-;; with the window and the window's new `window-start' position.  (It would be
-;; better if it also supplied the window's new `window-end' position, but that
-;; is calculated as part of the redisplay process, and the functions on
-;; `window-scroll-functions' are run before redisplay has finished.)  Thus, the
-;; hook deals with the above problems (a), (b) and (c).
-;;
-;; If only life was that easy.  Version 2 demand-driven fontification is mostly
-;; implemented by placing a function on `window-scroll-functions'.  However,
-;; not all scrolling occurs when `window-start' has changed.  A change in
-;; window size, e.g., via C-x 1, or a significant deletion, e.g., of a number
-;; of lines, causes text previously invisible (i.e., after `window-end') to
-;; become visible without changing `window-start'.  Arguably, these events are
-;; not scrolling events, but fontification must occur for lazy-lock.el to work.
-;; Hooks `window-size-change-functions' and `redisplay-end-trigger-functions'
-;; were added for these circumstances.
-;;
-;; Ben Wing thinks these hooks are "horribly horribly kludgy", and implemented
-;; a `pre-idle-hook', a `mother-of-all-post-command-hooks', for XEmacs 19.14.
-;; He then hacked up a version 1 lazy-lock.el to use `pre-idle-hook' rather
-;; than `post-command-hook'.  Whereas functions on `post-command-hook' are
-;; called almost as often as possible, functions on `pre-idle-hook' really are
-;; called as often as possible, even when the mouse moves and, on some systems,
-;; while XEmacs is idle.  Thus, the hook deals with the above problem (b), but
-;; unfortunately it makes (a) worse and does not address (c) at all.
-;;
-;; I freely admit that `redisplay-end-trigger-functions' and, to a much lesser
-;; extent, `window-size-change-functions' are not pretty.  However, I feel that
-;; a `window-scroll-functions' feature is cleaner than a `pre-idle-hook', and
-;; the result is faster and smaller, less intrusive and more targeted, code.
-;; Since `pre-idle-hook' is pretty much like `post-command-hook', there is no
-;; point in making this version of lazy-lock.el work with it.  Anyway, that's
-;; Lit 30 of my humble opinion.
-;;
-;; - Version 1 stealth fontification is also implemented by placing a function
-;; on `post-command-hook'.  This function waits for a given amount of time,
-;; and, if Emacs remains idle, fontifies where necessary.  Again, there are a
-;; number of problems with using `post-command-hook':
-;;
-;; (a) Functions on `post-command-hook' are run sequentially, so this function
-;;     can interfere with other functions on the hook, and vice versa.
-;; (b) This function waits for a given amount of time, so it can interfere with
-;;     various features that are dealt with by Emacs after a command, e.g.,
-;;     region highlighting, asynchronous updating and keystroke echoing.
-;; (c) Fontification may be required during a command, when `post-command-hook'
-;;     is not run.  (Version 2 deferred fontification only.)
-;;
-;; Again, `post-command-hook' is completely inappropriate for lazy-lock.el.
-;; Richard Stallman and Morten Welinder implemented internal Timers and Idle
-;; Timers for Emacs 19.31.  Functions can be run independently at given times
-;; or after given amounts of idle time.  Thus, the feature deals with the above
-;; problems (a), (b) and (c).  Version 2 deferral and stealth are implemented
-;; by functions on Idle Timers.  (A function on XEmacs' `pre-idle-hook' is
-;; similar to an Emacs Idle Timer function with a fixed zero second timeout.)
-
-;; Caveats:
-;;
-;; Lazy Lock mode does not work efficiently with Outline mode.
-;; This is because when in Outline mode, although text may be not visible to
-;; you in the window, the text is visible to Emacs Lisp code (not surprisingly)
-;; and Lazy Lock fontifies it mercilessly.  Maybe it will be fixed one day.
-;;
-;; Because buffer text is not necessarily fontified, other packages that expect
-;; buffer text to be fontified in Font Lock mode either might not work as
-;; expected, or might not display buffer text as expected.  An example of the
-;; latter is `occur', which copies lines of buffer text into another buffer.
-;;
-;; In Emacs 19.30, Lazy Lock mode does not ensure that an existing buffer is
-;; fontified if it is made visible via a minibuffer-less command that replaces
-;; an existing window's buffer (e.g., via the Buffers menu).  Upgrade!
-;;
-;; In Emacs 19.30, Lazy Lock mode does not work well with Transient Mark mode
-;; or modes based on Comint mode (e.g., Shell mode), and also interferes with
-;; the echoing of keystrokes in the minibuffer.  This is because of the way
-;; deferral and stealth have to be implemented for Emacs 19.30.  Upgrade!
-;;
-;; Currently XEmacs does not have the features to support this version of
-;; lazy-lock.el.  Maybe it will one day.
-
-;; History:
-;;
-;; 1.15--2.00:
-;; - Rewrite for Emacs 19.30 and the features rms added to support lazy-lock.el
-;;   so that it could work correctly and efficiently.
-;; - Many thanks to those who reported bugs, fixed bugs, made suggestions or
-;;   otherwise contributed in the version 1 cycle; Jari Aalto, Kevin Broadey,
-;;   Ulrik Dickow, Bill Dubuque, Bob Glickstein, Boris Goldowsky,
-;;   Jonas Jarnestrom, David Karr, Michael Kifer, Erik Naggum, Rick Sladkey,
-;;   Jim Thompson, Ben Wing, Ilya Zakharevich, and Richard Stallman.
-;; 2.00--2.01:
-;; - Made `lazy-lock-fontify-after-command' always `sit-for' and so redisplay
-;; - Use `buffer-name' not `buffer-live-p' (Bill Dubuque hint)
-;; - Made `lazy-lock-install' do `add-to-list' not `setq' of `current-buffer'
-;; - Made `lazy-lock-fontify-after-install' loop over buffer list
-;; - Made `lazy-lock-arrange-before-change' to arrange `window-end' triggering
-;; - Made `lazy-lock-let-buffer-state' wrap both `befter-change-functions'
-;; - Made `lazy-lock-fontify-region' do `condition-case' (Hyman Rosen report)
-;; 2.01--2.02:
-;; - Use `buffer-live-p' as `buffer-name' can barf (Richard Stanton report)
-;; - Made `lazy-lock-install' set `font-lock-fontified' (Kevin Davidson report)
-;; - Made `lazy-lock-install' add hooks only if needed
-;; - Made `lazy-lock-unstall' add `font-lock-after-change-function' if needed
-;; 2.02--2.03:
-;; - Made `lazy-lock-fontify-region' do `condition-case' for `quit' too
-;; - Made `lazy-lock-mode' respect the value of `font-lock-inhibit-thing-lock'
-;; - Added `lazy-lock-after-unfontify-buffer'
-;; - Removed `lazy-lock-fontify-after-install' hack
-;; - Made `lazy-lock-fontify-after-scroll' not `set-buffer' to `window-buffer'
-;; - Made `lazy-lock-fontify-after-trigger' not `set-buffer' to `window-buffer'
-;; - Made `lazy-lock-fontify-after-idle' be interruptible (Scott Burson hint)
-;; 2.03--2.04:
-;; - Rewrite for Emacs 19.31 idle timers
-;; - Renamed `buffer-windows' to `get-buffer-window-list'
-;; - Removed `buffer-live-p'
-;; - Made `lazy-lock-defer-after-change' always save `current-buffer'
-;; - Made `lazy-lock-fontify-after-defer' just process buffers
-;; - Made `lazy-lock-install-hooks' add hooks correctly (Kevin Broadey report)
-;; - Made `lazy-lock-install' cope if `lazy-lock-defer-time' is a list
-;; 2.04--2.05:
-;; - Rewrite for Common Lisp macros
-;; - Added `do-while' macro
-;; - Renamed `lazy-lock-let-buffer-state' macro to `save-buffer-state'
-;; - Returned `lazy-lock-fontify-after-install' hack (Darren Hall hint)
-;; - Added `lazy-lock-defer-on-scrolling' functionality (Scott Byer hint)
-;; - Made `lazy-lock-mode' wrap `font-lock-support-mode'
-;; 2.05--2.06:
-;; - Made `lazy-lock-fontify-after-defer' swap correctly (Scott Byer report)
-;; 2.06--2.07:
-;; - Added `lazy-lock-stealth-load' functionality (Rob Hooft hint)
-;; - Made `lazy-lock-unstall' call `lazy-lock-fontify-region' if needed
-;; - Made `lazy-lock-mode' call `lazy-lock-unstall' only if needed
-;; - Made `lazy-lock-defer-after-scroll' do `set-window-redisplay-end-trigger'
-;; - Added `lazy-lock-defer-contextually' functionality
-;; - Added `lazy-lock-defer-on-the-fly' from `lazy-lock-defer-time'
-;; - Renamed `lazy-lock-defer-driven' to `lazy-lock-defer-on-scrolling'
-;; - Removed `lazy-lock-submit-bug-report' and bade farewell
-
-;;; Code:
-
-(require 'font-lock)
-
-;; Make sure lazy-lock.el is supported.
-(if (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version)))
-	t
-      (and (= emacs-major-version 19) (< emacs-minor-version 30)))
-    (error "`lazy-lock' was written for Emacs 19.30 or later"))
-
-;; Flush out those lusers who didn't read all of the Commentary.
-(if (or (memq 'turn-on-defer-lock font-lock-mode-hook)
-	(memq 'defer-lock-mode font-lock-mode-hook))
-    (error "`lazy-lock' was written for use without `defer-lock'"))
-  
-(eval-when-compile
-  ;;
-  ;; We don't do this at the top-level as idle timers are not necessarily used.
-  (require 'timer)
-  ;; We don't do this at the top-level as we only use non-autoloaded macros.
-  (require 'cl)
-  ;;
-  ;; Well, shouldn't Lazy Lock mode be as lazy as possible?
-  (setq byte-compile-dynamic t byte-compile-dynamic-docstrings t)
-  ;; But, we make sure that the code is as zippy as can be.
-  (setq byte-optimize t)
-  ;;
-  ;; We use this to preserve or protect things when modifying text properties.
-  (defmacro save-buffer-state (varlist &rest body)
-    "Bind variables according to VARLIST and eval BODY restoring buffer state."
-    (` (let* ((,@ (append varlist
-		   '((modified (buffer-modified-p))
-		     (inhibit-read-only t) (buffer-undo-list t)
-		     before-change-functions after-change-functions
-		     deactivate-mark buffer-file-name buffer-file-truename))))
-	 (,@ body)
-	 (when (and (not modified) (buffer-modified-p))
-	   (set-buffer-modified-p nil)))))
-  (put 'save-buffer-state 'lisp-indent-function 1)
-  ;;
-  ;; We use this for clarity and speed.  Naughty but nice.
-  (defmacro do-while (test &rest body)
-    "(do-while TEST BODY...): eval BODY... and repeat if TEST yields non-nil.
-The order of execution is thus BODY, TEST, BODY, TEST and so on
-until TEST returns nil."
-    (` (while (progn (,@ body) (, test)))))
-  (put 'do-while 'lisp-indent-function (get 'while 'lisp-indent-function))
-  ;;
-  ;; We use this for clarity and speed.  Borrowed from a future Emacs.
-  (or (fboundp 'with-current-buffer)
-      (defmacro with-current-buffer (buffer &rest body)
-	"Execute the forms in BODY with BUFFER as the current buffer.
-The value returned is the value of the last form in BODY."
-	(` (save-excursion (set-buffer (, buffer)) (,@ body)))))
-  (put 'with-current-buffer 'lisp-indent-function 1))
-
-;(defun lazy-lock-submit-bug-report ()
-;  "Submit via mail a bug report on lazy-lock.el."
-;  (interactive)
-;  (let ((reporter-prompt-for-summary-p t))
-;    (reporter-submit-bug-report "simon@gnu.ai.mit.edu" "lazy-lock 2.07"
-;     '(lazy-lock-minimum-size lazy-lock-defer-on-the-fly
-;       lazy-lock-defer-on-scrolling lazy-lock-defer-contextually
-;       lazy-lock-defer-time lazy-lock-stealth-time
-;       lazy-lock-stealth-load lazy-lock-stealth-nice lazy-lock-stealth-lines
-;       lazy-lock-stealth-verbose)
-;     nil nil
-;     (concat "Hi Si.,
-;
-;I want to report a bug.  I've read the `Bugs' section of `Info' on Emacs, so I
-;know how to make a clear and unambiguous report.  To reproduce the bug:
-;
-;Start a fresh editor via `" invocation-name " -no-init-file -no-site-file'.
-;In the `*scratch*' buffer, evaluate:"))))
-
-(defvar lazy-lock-mode nil)
-(defvar lazy-lock-buffers nil)			; for deferral
-(defvar lazy-lock-timers (cons nil nil))	; for deferral and stealth
-
-;; User Variables:
-
-(defvar lazy-lock-minimum-size (* 25 1024)
-  "*Minimum size of a buffer for demand-driven fontification.
-On-demand fontification occurs if the buffer size is greater than this value.
-If nil, means demand-driven fontification is never performed.
-If a list, each element should be a cons pair of the form (MAJOR-MODE . SIZE),
-where MAJOR-MODE is a symbol or t (meaning the default).  For example:
- ((c-mode . 25600) (c++-mode . 25600) (rmail-mode . 1048576))
-means that the minimum size is 25K for buffers in C or C++ modes, one megabyte
-for buffers in Rmail mode, and size is irrelevant otherwise.
-
-The value of this variable is used when Lazy Lock mode is turned on.")
-
-(defvar lazy-lock-defer-on-the-fly t
-  "*If non-nil, means fontification after a change should be deferred.
-If nil, means on-the-fly fontification is performed.  This means when changes
-occur in the buffer, those areas are immediately fontified.
-If a list, it should be a list of `major-mode' symbol names for which deferred
-fontification should occur.  The sense of the list is negated if it begins with
-`not'.  For example:
- (c-mode c++-mode)
-means that on-the-fly fontification is deferred for buffers in C and C++ modes
-only, and deferral does not occur otherwise.
-
-The value of this variable is used when Lazy Lock mode is turned on.")
-
-(defvar lazy-lock-defer-on-scrolling nil
-  "*If non-nil, means fontification after a scroll should be deferred.
-If nil, means demand-driven fontification is performed.  This means when
-scrolling into unfontified areas of the buffer, those areas are immediately
-fontified.  Thus scrolling never presents unfontified areas.  However, since
-fontification occurs during scrolling, scrolling may be slow.
-If t, means defer-driven fontification is performed.  This means fontification
-of those areas is deferred.  Thus scrolling may present momentarily unfontified
-areas.  However, since fontification does not occur during scrolling, scrolling
-will be faster than demand-driven fontification.
-If any other value, e.g., `eventually', means demand-driven fontification is
-performed until the buffer is fontified, then buffer fontification becomes
-defer-driven.  Thus scrolling never presents unfontified areas until the buffer
-is first fontified, after which subsequent scrolling may present future buffer
-insertions momentarily unfontified.  However, since fontification does not
-occur during scrolling after the buffer is first fontified, scrolling will
-become faster.  (But, since contextual changes continually occur, such a value
-makes little sense if `lazy-lock-defer-contextually' is non-nil.)
-
-The value of this variable is used when Lazy Lock mode is turned on.")
-
-(defvar lazy-lock-defer-contextually 'syntax-driven
-  "*If non-nil, means deferred fontification should be syntactically true.
-If nil, means deferred fontification occurs only on those lines modified.  This
-means where modification on a line causes syntactic change on subsequent lines,
-those subsequent lines are not refontified to reflect their new context.
-If t, means deferred fontification occurs on those lines modified and all
-subsequent lines.  This means those subsequent lines are refontified to reflect
-their new syntactic context, either immediately or when scrolling into them.
-If any other value, e.g., `syntax-driven', means deferred syntactically true
-fontification occurs only if syntactic fontification is performed using the
-buffer mode's syntax table, i.e., only if `font-lock-keywords-only' is nil.
-
-The value of this variable is used when Lazy Lock mode is turned on.")
-
-(defvar lazy-lock-defer-time
-  (if (featurep 'lisp-float-type) (/ (float 1) (float 3)) 1)
-  "*Time in seconds to delay before beginning deferred fontification.
-Deferred fontification occurs if there is no input within this time.
-If nil, means fontification is never deferred, regardless of the values of the
-variables `lazy-lock-defer-on-the-fly', `lazy-lock-defer-on-scrolling' and
-`lazy-lock-defer-contextually'.
-
-The value of this variable is used when Lazy Lock mode is turned on.")
-
-(defvar lazy-lock-stealth-time 30
-  "*Time in seconds to delay before beginning stealth fontification.
-Stealth fontification occurs if there is no input within this time.
-If nil, means stealth fontification is never performed.
-
-The value of this variable is used when Lazy Lock mode is turned on.")
-
-(defvar lazy-lock-stealth-lines (if font-lock-maximum-decoration 100 250)
-  "*Maximum size of a chunk of stealth fontification.
-Each iteration of stealth fontification can fontify this number of lines.
-To speed up input response during stealth fontification, at the cost of stealth
-taking longer to fontify, you could reduce the value of this variable.")
-
-(defvar lazy-lock-stealth-load
-  (when (condition-case nil (load-average) (error)) 200)
-  "*Load in percentage above which stealth fontification is suspended.
-Stealth fontification pauses when the system short-term load average (as
-returned by the function `load-average' if supported) goes above this level,
-thus reducing the demand that stealth fontification makes on the system.
-If nil, means stealth fontification is never suspended.
-To reduce machine load during stealth fontification, at the cost of stealth
-taking longer to fontify, you could reduce the value of this variable.
-See also `lazy-lock-stealth-nice'.")
-
-(defvar lazy-lock-stealth-nice
-  (if (featurep 'lisp-float-type) (/ (float 1) (float 8)) 1)
-  "*Time in seconds to pause between chunks of stealth fontification.
-Each iteration of stealth fontification is separated by this amount of time,
-thus reducing the demand that stealth fontification makes on the system.
-If nil, means stealth fontification is never paused.
-To reduce machine load during stealth fontification, at the cost of stealth
-taking longer to fontify, you could increase the value of this variable.
-See also `lazy-lock-stealth-load'.")
-
-(defvar lazy-lock-stealth-verbose
-  (when (featurep 'lisp-float-type)
-    (and font-lock-verbose (not lazy-lock-defer-contextually)))
-  "*If non-nil, means stealth fontification should show status messages.")
-
-;; User Functions:
-
-;;;###autoload
-(defun lazy-lock-mode (&optional arg)
-  "Toggle Lazy Lock mode.
-With arg, turn Lazy Lock mode on if and only if arg is positive.  Enable it
-automatically in your `~/.emacs' by:
-
- (setq font-lock-support-mode 'lazy-lock-mode)
-
-When Lazy Lock mode is enabled, fontification can be lazy in a number of ways:
-
-- Demand-driven buffer fontification if `lazy-lock-minimum-size' is non-nil.
-  This means initial fontification does not occur if the buffer is greater than
-  `lazy-lock-minimum-size' characters in length.  Instead, fontification occurs
-  when necessary, such as when scrolling through the buffer would otherwise
-  reveal unfontified areas.  This is useful if buffer fontification is too slow
-  for large buffers.
-
-- Deferred scroll fontification if `lazy-lock-defer-on-scrolling' is non-nil.
-  This means demand-driven fontification does not occur as you scroll.
-  Instead, fontification is deferred until after `lazy-lock-defer-time' seconds
-  of Emacs idle time, while Emacs remains idle.  This is useful if
-  fontification is too slow to keep up with scrolling.
-
-- Deferred on-the-fly fontification if `lazy-lock-defer-on-the-fly' is non-nil.
-  This means on-the-fly fontification does not occur as you type.  Instead,
-  fontification is deferred until after `lazy-lock-defer-time' seconds of Emacs
-  idle time, while Emacs remains idle.  This is useful if fontification is too
-  slow to keep up with your typing.
-
-- Deferred context fontification if `lazy-lock-defer-contextually' is non-nil.
-  This means fontification updates the buffer corresponding to true syntactic
-  context, after `lazy-lock-defer-time' seconds of Emacs idle time, while Emacs
-  remains idle.  Otherwise, fontification occurs on modified lines only, and
-  subsequent lines can remain fontified corresponding to previous syntactic
-  contexts.  This is useful where strings or comments span lines.
-
-- Stealthy buffer fontification if `lazy-lock-stealth-time' is non-nil.
-  This means remaining unfontified areas of buffers are fontified if Emacs has
-  been idle for `lazy-lock-stealth-time' seconds, while Emacs remains idle.
-  This is useful if any buffer has any deferred fontification.
-
-Basic Font Lock mode on-the-fly fontification behaviour fontifies modified
-lines only.  Thus, if `lazy-lock-defer-contextually' is non-nil, Lazy Lock mode
-on-the-fly fontification may fontify differently, albeit correctly.  In any
-event, to refontify some lines you can use \\[font-lock-fontify-block].
-
-Stealth fontification only occurs while the system remains unloaded.
-If the system load rises above `lazy-lock-stealth-load' percent, stealth
-fontification is suspended.  Stealth fontification intensity is controlled via
-the variable `lazy-lock-stealth-nice' and `lazy-lock-stealth-lines', and
-verbosity is controlled via the variable `lazy-lock-stealth-verbose'."
-  (interactive "P")
-  (let* ((was-on lazy-lock-mode)
-	 (now-on (unless (memq 'lazy-lock-mode font-lock-inhibit-thing-lock)
-		   (if arg (> (prefix-numeric-value arg) 0) (not was-on)))))
-    (cond ((and now-on (not font-lock-mode))
-	   ;; Turned on `lazy-lock-mode' rather than `font-lock-mode'.
-	   (let ((font-lock-support-mode 'lazy-lock-mode))
-	     (font-lock-mode t)))
-	  (now-on
-	   ;; Turn ourselves on.
-	   (set (make-local-variable 'lazy-lock-mode) t)
-	   (lazy-lock-install))
-	  (was-on
-	   ;; Turn ourselves off.
-	   (set (make-local-variable 'lazy-lock-mode) nil)
-	   (lazy-lock-unstall)))))
-
-;;;###autoload
-(defun turn-on-lazy-lock ()
-  "Unconditionally turn on Lazy Lock mode."
-  (lazy-lock-mode t))
-
-(defun lazy-lock-install ()
-  (let ((min-size (font-lock-value-in-major-mode lazy-lock-minimum-size))
-	(defer-change (and lazy-lock-defer-time lazy-lock-defer-on-the-fly))
-	(defer-scroll (and lazy-lock-defer-time lazy-lock-defer-on-scrolling))
-	(defer-context (and lazy-lock-defer-time lazy-lock-defer-contextually
-			    (or (eq lazy-lock-defer-contextually t)
-				(null font-lock-keywords-only)))))
-    ;;
-    ;; Tell Font Lock whether Lazy Lock will do fontification.
-    (make-local-variable 'font-lock-fontified)
-    (setq font-lock-fontified (and min-size (>= (buffer-size) min-size)))
-    ;;
-    ;; Add the text properties and fontify.
-    (if (not font-lock-fontified)
-	(lazy-lock-after-fontify-buffer)
-      ;; Make sure we fontify in any existing windows showing the buffer.
-      (let ((windows (get-buffer-window-list (current-buffer) 'nomini t)))
-	(lazy-lock-after-unfontify-buffer)
-	(while windows
-	  (lazy-lock-fontify-conservatively (car windows))
-	  (setq windows (cdr windows)))))
-    ;;
-    ;; Add the fontification hooks.
-    (lazy-lock-install-hooks
-     font-lock-fontified
-     (cond ((eq (car-safe defer-change) 'not)
-	    (not (memq major-mode (cdr defer-change))))
-	   ((listp defer-change)
-	    (memq major-mode defer-change))
-	   (t
-	    defer-change))
-     (eq defer-scroll t)
-     defer-context)
-    ;;
-    ;; Add the fontification timers.
-    (lazy-lock-install-timers
-     (if (or defer-change defer-scroll defer-context) lazy-lock-defer-time)
-     lazy-lock-stealth-time)))
-
-(defun lazy-lock-install-hooks (fontifying
-				defer-change defer-scroll defer-context)
-  ;;
-  ;; Add hook if lazy-lock.el is fontifying on scrolling or is deferring.
-  (when (or fontifying defer-change defer-scroll defer-context)
-    (make-local-hook 'window-scroll-functions)
-    (add-hook 'window-scroll-functions (if defer-scroll
-					   'lazy-lock-defer-after-scroll
-					 'lazy-lock-fontify-after-scroll)
-	      nil t))
-  ;;
-  ;; Add hook if lazy-lock.el is fontifying and is not deferring changes.
-  (when (and fontifying (not defer-change) (not defer-context))
-    (make-local-hook 'before-change-functions)
-    (add-hook 'before-change-functions 'lazy-lock-arrange-before-change nil t))
-  ;;
-  ;; Replace Font Lock mode hook.
-  (remove-hook 'after-change-functions 'font-lock-after-change-function t)
-  (add-hook 'after-change-functions
-	    (cond ((and defer-change defer-context)
-		   'lazy-lock-defer-rest-after-change)
-		  (defer-change
-		   'lazy-lock-defer-line-after-change)
-		  (defer-context
-		   'lazy-lock-fontify-rest-after-change)
-		  (t
-		   'lazy-lock-fontify-line-after-change))
-	    nil t)
-  ;;
-  ;; Add package-specific hook.
-  (make-local-hook 'outline-view-change-hook)
-  (add-hook 'outline-view-change-hook 'lazy-lock-fontify-after-outline nil t))
-
-(defun lazy-lock-install-timers (dtime stime)
-  ;; Schedule or re-schedule the deferral and stealth timers.
-  ;; The layout of `lazy-lock-timers' is:
-  ;;  ((DEFER-TIME . DEFER-TIMER) (STEALTH-TIME . STEALTH-TIMER)
-  ;; If an idle timeout has changed, cancel the existing idle timer (if there
-  ;; is one) and schedule a new one (if the new idle timeout is non-nil).
-  (unless (eq dtime (car (car lazy-lock-timers)))
-    (let ((defer (car lazy-lock-timers)))
-      (when (cdr defer)
-	(cancel-timer (cdr defer)))
-      (setcar lazy-lock-timers (cons dtime (and dtime
-	      (run-with-idle-timer dtime t 'lazy-lock-fontify-after-defer))))))
-  (unless (eq stime (car (cdr lazy-lock-timers)))
-    (let ((stealth (cdr lazy-lock-timers)))
-      (when (cdr stealth)
-	(cancel-timer (cdr stealth)))
-      (setcdr lazy-lock-timers (cons stime (and stime
-	      (run-with-idle-timer stime t 'lazy-lock-fontify-after-idle)))))))
-
-(defun lazy-lock-unstall ()
-  ;;
-  ;; If Font Lock mode is still enabled, make sure that the buffer is
-  ;; fontified, and reinstall its hook.  We must do this first.
-  (when font-lock-mode
-    (when (lazy-lock-unfontified-p)
-      (let ((verbose (if (numberp font-lock-verbose)
-			 (> (buffer-size) font-lock-verbose)
-		       font-lock-verbose)))
-	(if verbose (message "Fontifying %s..." (buffer-name)))
-	;; Make sure we fontify etc. in the whole buffer.
-	(save-restriction
-	  (widen)
-	  (lazy-lock-fontify-region (point-min) (point-max)))
-	(if verbose (message "Fontifying %s...%s" (buffer-name)
-			     (if (lazy-lock-unfontified-p) "quit" "done")))))
-    (add-hook 'after-change-functions 'font-lock-after-change-function nil t))
-  ;;
-  ;; Remove the text properties.
-  (lazy-lock-after-unfontify-buffer)
-  ;;
-  ;; Remove the fontification hooks.
-  (remove-hook 'window-scroll-functions 'lazy-lock-fontify-after-scroll t)
-  (remove-hook 'window-scroll-functions 'lazy-lock-defer-after-scroll t)
-  (remove-hook 'before-change-functions 'lazy-lock-arrange-before-change t)
-  (remove-hook 'after-change-functions 'lazy-lock-fontify-line-after-change t)
-  (remove-hook 'after-change-functions 'lazy-lock-fontify-rest-after-change t)
-  (remove-hook 'after-change-functions 'lazy-lock-defer-line-after-change t)
-  (remove-hook 'after-change-functions 'lazy-lock-defer-rest-after-change t)
-  (remove-hook 'outline-view-change-hook 'lazy-lock-fontify-after-outline t))
-
-;; Hook functions.
-
-;; Lazy Lock mode intervenes when (1) a previously invisible buffer region
-;; becomes visible, i.e., for demand- or defer-driven on-the-scroll
-;; fontification, (2) a buffer modification occurs, i.e., for defer-driven
-;; on-the-fly fontification, (3) Emacs becomes idle, i.e., for fontification of
-;; deferred fontification and stealth fontification, and (4) other special
-;; occasions.
-
-;; 1.  There are three ways whereby this can happen.
-;;
-;; (a) Scrolling the window, either explicitly (e.g., `scroll-up') or
-;;     implicitly (e.g., `search-forward').  Here, `window-start' changes.
-;;     Fontification occurs by adding `lazy-lock-fontify-after-scroll' (for
-;;     demand-driven fontification) or `lazy-lock-defer-after-scroll' (for
-;;     defer-driven fontification) to the hook `window-scroll-functions'.
-
-(defun lazy-lock-fontify-after-scroll (window window-start)
-  ;; Called from `window-scroll-functions'.
-  ;; Fontify WINDOW from WINDOW-START following the scroll.  We cannot use
-  ;; `window-end' so we work out what it would be via `vertical-motion'.
-  (save-excursion
-    (goto-char window-start)
-    (vertical-motion (window-height window) window)
-    (lazy-lock-fontify-region window-start (point)))
-  ;; A prior deletion that did not cause scrolling, followed by a scroll, would
-  ;; result in an unnecessary trigger after this if we did not cancel it now.
-  (set-window-redisplay-end-trigger window nil))
-
-(defun lazy-lock-defer-after-scroll (window window-start)
-  ;; Called from `window-scroll-functions'.
-  ;; Defer fontification following the scroll.  Save the current buffer so that
-  ;; we subsequently fontify in all windows showing the buffer.
-  (unless (memq (current-buffer) lazy-lock-buffers)
-    (push (current-buffer) lazy-lock-buffers))
-  ;; A prior deletion that did not cause scrolling, followed by a scroll, would
-  ;; result in an unnecessary trigger after this if we did not cancel it now.
-  (set-window-redisplay-end-trigger window nil))
-
-;; (b) Resizing the window, either explicitly (e.g., `enlarge-window') or
-;;     implicitly (e.g., `delete-other-windows').  Here, `window-end' changes.
-;;     Fontification occurs by adding `lazy-lock-fontify-after-resize' to the
-;;     hook `window-size-change-functions'.
-
-(defun lazy-lock-fontify-after-resize (frame)
-  ;; Called from `window-size-change-functions'.
-  ;; Fontify windows in FRAME following the resize.  We cannot use
-  ;; `window-start' or `window-end' so we fontify conservatively.
-  (save-excursion
-    (save-selected-window
-      (select-frame frame)
-      (walk-windows (function (lambda (window)
-		       (set-buffer (window-buffer window))
-		       (when lazy-lock-mode
-			 (lazy-lock-fontify-conservatively window))
-		       (set-window-redisplay-end-trigger window nil)))
-		    'nomini frame))))
-
-;; (c) Deletion in the buffer.  Here, a `window-end' marker can become visible.
-;;     Fontification occurs by adding `lazy-lock-arrange-before-change' to
-;;     `before-change-functions' and `lazy-lock-fontify-after-trigger' to the
-;;     hook `redisplay-end-trigger-functions'.  Before every deletion, the
-;;     marker `window-redisplay-end-trigger' position is set to the soon-to-be
-;;     changed `window-end' position.  If the marker becomes visible,
-;;     `lazy-lock-fontify-after-trigger' gets called.  Ouch.  Note that we only
-;;     have to deal with this eventuality if there is no on-the-fly deferral.
-
-(defun lazy-lock-arrange-before-change (beg end)
-  ;; Called from `before-change-functions'.
-  ;; Arrange that if text becomes visible it will be fontified (if a deletion
-  ;; is pending, text might become visible at the bottom).
-  (unless (eq beg end)
-    (let ((windows (get-buffer-window-list (current-buffer) 'nomini t)) window)
-      (while windows
-	(setq window (car windows))
-	(unless (markerp (window-redisplay-end-trigger window))
-	  (set-window-redisplay-end-trigger window (make-marker)))
-	(set-marker (window-redisplay-end-trigger window) (window-end window))
-	(setq windows (cdr windows))))))
-
-(defun lazy-lock-fontify-after-trigger (window trigger-point)
-  ;; Called from `redisplay-end-trigger-functions'.
-  ;; Fontify WINDOW from TRIGGER-POINT.  We cannot use `window-end' so we work
-  ;; out what it would be via `vertical-motion'.
-  ;; We could probably just use `lazy-lock-fontify-after-scroll' without loss:
-  ;;  (lazy-lock-fontify-after-scroll window (window-start window))
-  (save-excursion
-    (goto-char (window-start window))
-    (vertical-motion (window-height window) window)
-    (lazy-lock-fontify-region trigger-point (point))))
-
-;; 2.  Modified text must be marked as unfontified so it can be identified and
-;;     fontified later when Emacs is idle.  Deferral occurs by adding one of
-;;     `lazy-lock-fontify-*-after-change' (for on-the-fly fontification) or
-;;     `lazy-lock-defer-*-after-change' (for deferred fontification) to the
-;;     hook `after-change-functions'.
-
-(defalias 'lazy-lock-fontify-line-after-change
-  ;; Called from `after-change-functions'.
-  ;; Fontify the current change.
-  'font-lock-after-change-function)
-
-(defun lazy-lock-fontify-rest-after-change (beg end old-len)
-  ;; Called from `after-change-functions'.
-  ;; Fontify the current change and defer fontification of the rest of the
-  ;; buffer.  Save the current buffer so that we subsequently fontify in all
-  ;; windows showing the buffer.
-  (lazy-lock-fontify-line-after-change beg end old-len)
-  (save-buffer-state nil
-    (unless (memq (current-buffer) lazy-lock-buffers)
-      (push (current-buffer) lazy-lock-buffers))
-    (remove-text-properties end (point-max) '(lazy-lock nil))))
-
-(defun lazy-lock-defer-line-after-change (beg end old-len)
-  ;; Called from `after-change-functions'.
-  ;; Defer fontification of the current change.  Save the current buffer so
-  ;; that we subsequently fontify in all windows showing the buffer.
-  (save-buffer-state nil
-    (unless (memq (current-buffer) lazy-lock-buffers)
-      (push (current-buffer) lazy-lock-buffers))
-    (remove-text-properties (max (1- beg) (point-min))
-			    (min (1+ end) (point-max))
-			    '(lazy-lock nil))))
-
-(defun lazy-lock-defer-rest-after-change (beg end old-len)
-  ;; Called from `after-change-functions'.
-  ;; Defer fontification of the rest of the buffer.  Save the current buffer so
-  ;; that we subsequently fontify in all windows showing the buffer.
-  (save-buffer-state nil
-    (unless (memq (current-buffer) lazy-lock-buffers)
-      (push (current-buffer) lazy-lock-buffers))
-    (remove-text-properties (max (1- beg) (point-min))
-			    (point-max)
-			    '(lazy-lock nil))))
-
-;; 3.  Deferred fontification and stealth fontification are done from these two
-;;     functions.  They are set up as Idle Timers.
-
-(defun lazy-lock-fontify-after-defer ()
-  ;; Called from `timer-idle-list'.
-  ;; Fontify all windows where deferral has occurred for its buffer.
-  (while (and lazy-lock-buffers (not (input-pending-p)))
-    (let ((windows (get-buffer-window-list (car lazy-lock-buffers) 'nomini t)))
-      (while windows
-	(lazy-lock-fontify-window (car windows))
-	(setq windows (cdr windows)))
-      (setq lazy-lock-buffers (cdr lazy-lock-buffers))))
-  ;; Add hook if fontification should now be defer-driven in this buffer.
-  (when (and lazy-lock-mode lazy-lock-defer-on-scrolling
-	     (memq 'lazy-lock-fontify-after-scroll window-scroll-functions)
-	     (not (or (input-pending-p) (lazy-lock-unfontified-p))))
-    (remove-hook 'window-scroll-functions 'lazy-lock-fontify-after-scroll t)
-    (add-hook 'window-scroll-functions 'lazy-lock-defer-after-scroll nil t)))
-
-(defun lazy-lock-fontify-after-idle ()
-  ;; Called from `timer-idle-list'.
-  ;; Fontify all buffers that need it, stealthily while idle.
-  (unless (or executing-kbd-macro (window-minibuffer-p (selected-window)))
-    ;; Loop over all buffers, fontify stealthily for each if necessary.
-    (let ((buffers (buffer-list)) (continue t) message message-log-max)
-      (save-excursion
-	(do-while (and buffers continue)
-	  (set-buffer (car buffers))
-	  (if (not (and lazy-lock-mode (lazy-lock-unfontified-p)))
-	      (setq continue (not (input-pending-p)))
-	    ;; Fontify regions in this buffer while there is no input.
-	    (do-while (and (lazy-lock-unfontified-p) continue)
-	      (if (and lazy-lock-stealth-load
-		       (> (car (load-average)) lazy-lock-stealth-load))
-		  ;; Wait a while before continuing with the loop.
-		  (progn
-		    (when message
-		      (message "Fontifying stealthily...suspended")
-		      (setq message nil))
-		    (setq continue (sit-for (or lazy-lock-stealth-time 30))))
-		;; Fontify a chunk.
-		(when lazy-lock-stealth-verbose
-		  (if message
-		      (message "Fontifying stealthily... %2d%% of %s"
-			       (lazy-lock-percent-fontified) (buffer-name))
-		    (message "Fontifying stealthily...")
-		    (setq message t)))
-		(lazy-lock-fontify-chunk)
-		(setq continue (sit-for (or lazy-lock-stealth-nice 0))))))
-	  (setq buffers (cdr buffers))))
-      (when message
-	(message "Fontifying stealthily...%s" (if continue "done" "quit"))))))
-
-;; 4.  Special circumstances.
-
-(defun lazy-lock-fontify-after-outline ()
-  ;; Called from `outline-view-change-hook'.
-  ;; Fontify windows showing the current buffer, as its visibility has changed.
-  ;; This is a conspiracy hack between lazy-lock.el and noutline.el.
-  (let ((windows (get-buffer-window-list (current-buffer) 'nomini t)))
-    (while windows
-      (lazy-lock-fontify-conservatively (car windows))
-      (setq windows (cdr windows)))))
-
-(defun lazy-lock-after-fontify-buffer ()
-  ;; Called from `font-lock-after-fontify-buffer'.
-  ;; Mark the current buffer as fontified.
-  ;; This is a conspiracy hack between lazy-lock.el and font-lock.el.
-  (save-buffer-state nil
-    (add-text-properties (point-min) (point-max) '(lazy-lock t))))
-
-(defun lazy-lock-after-unfontify-buffer ()
-  ;; Called from `font-lock-after-unfontify-buffer'.
-  ;; Mark the current buffer as unfontified.
-  ;; This is a conspiracy hack between lazy-lock.el and font-lock.el.
-  (save-buffer-state nil
-    (remove-text-properties (point-min) (point-max) '(lazy-lock nil))))
-
-;; Fontification functions.
-
-;; If packages want to ensure that some region of the buffer is fontified, they
-;; should use this function.  For an example, see ps-print.el.
-(defun lazy-lock-fontify-region (beg end)
-  ;; Fontify between BEG and END, where necessary, in the current buffer.
-  (when (setq beg (text-property-any beg end 'lazy-lock nil))
-    (save-excursion
-      (save-match-data
-	(save-buffer-state
-	    ;; Ensure syntactic fontification is always correct.
-	    (font-lock-beginning-of-syntax-function next)
-	  ;; Find successive unfontified regions between BEG and END.
-	  (condition-case data
-	      (do-while beg
-		(setq next (or (text-property-any beg end 'lazy-lock t) end))
-		;; Make sure the region end points are at beginning of line.
-		(goto-char beg)
-		(unless (bolp)
-		  (beginning-of-line)
-		  (setq beg (point)))
-		(goto-char next)
-		(unless (bolp)
-		  (forward-line)
-		  (setq next (point)))
-		;; Fontify the region, then flag it as fontified.
-		(font-lock-fontify-region beg next)
-		(add-text-properties beg next '(lazy-lock t))
-		(setq beg (text-property-any next end 'lazy-lock nil)))
-	    ((error quit) (message "Fontifying region...%s" data))))))))
-
-(defun lazy-lock-fontify-chunk ()
-  ;; Fontify the nearest chunk, for stealth, in the current buffer.
-  (save-excursion
-    (save-restriction
-      (widen)
-      ;; Move to end of line in case the character at point is not fontified.
-      (end-of-line)
-      ;; Find where the previous, and next, unfontified regions end, and begin.
-      (let ((prev (previous-single-property-change (point) 'lazy-lock))
-	    (next (text-property-any (point) (point-max) 'lazy-lock nil)))
-	;; Fontify from the nearest unfontified position.
-	(if (or (null prev) (and next (< (- next (point)) (- (point) prev))))
-	    ;; The next, or neither, region is the nearest not fontified.
-	    (lazy-lock-fontify-region
-	     (progn (goto-char (or next (point-min)))
-		    (beginning-of-line)
-		    (point))
-	     (progn (goto-char (or next (point-min)))
-		    (forward-line lazy-lock-stealth-lines)
-		    (point)))
-	  ;; The previous region is the nearest not fontified.
-	  (lazy-lock-fontify-region
-	   (progn (goto-char prev)
-		  (forward-line (- lazy-lock-stealth-lines))
-		  (point))
-	   (progn (goto-char prev)
-		  (forward-line)
-		  (point))))))))
-
-(defun lazy-lock-fontify-window (window)
-  ;; Fontify in WINDOW between `window-start' and `window-end'.
-  ;; We can only do this when we can use `window-start' and `window-end'.
-  (with-current-buffer (window-buffer window)
-    (lazy-lock-fontify-region (window-start window) (window-end window))))
-
-(defun lazy-lock-fontify-conservatively (window)
-  ;; Fontify in WINDOW conservatively around point.
-  ;; Where we cannot use `window-start' and `window-end' we do `window-height'
-  ;; lines around point.  That way we guarantee to have done enough.
-  (with-current-buffer (window-buffer window)
-    (lazy-lock-fontify-region
-     (save-excursion
-       (vertical-motion (- (window-height window)) window) (point))
-     (save-excursion
-       (vertical-motion (window-height window) window) (point)))))
-
-(defun lazy-lock-unfontified-p ()
-  ;; Return non-nil if there is anywhere still to be fontified.
-  (save-restriction
-    (widen)
-    (text-property-any (point-min) (point-max) 'lazy-lock nil)))
-
-(defun lazy-lock-percent-fontified ()
-  ;; Return the percentage (of characters) of the buffer that are fontified.
-  (save-restriction
-    (widen)
-    (let ((beg (point-min)) (size 0) next)
-      ;; Find where the next fontified region begins.
-      (while (setq beg (text-property-any beg (point-max) 'lazy-lock t))
-	(setq next (or (text-property-any beg (point-max) 'lazy-lock nil)
-		       (point-max)))
-	(incf size (- next beg))
-	(setq beg next))
-      ;; Float because using integer multiplication will frequently overflow.
-      (truncate (* (/ (float size) (point-max)) 100)))))
-
-;; Version dependent workarounds and fixes.
-
-(when (if (save-match-data (string-match "Lucid\\|XEmacs" (emacs-version)))
-	  nil
-	(and (= emacs-major-version 19) (= emacs-minor-version 30)))
-  ;;
-  ;; We use `post-command-idle-hook' for deferral and stealth.  Oh Lordy.
-  (defun lazy-lock-install-timers (foo bar)
-    (add-hook 'post-command-idle-hook 'lazy-lock-fontify-post-command t)
-    (add-hook 'post-command-idle-hook 'lazy-lock-fontify-post-idle t)
-    (add-to-list 'lazy-lock-install (current-buffer))
-    (add-hook 'post-command-hook 'lazy-lock-fontify-after-install))
-  (defun lazy-lock-fontify-post-command ()
-    (and lazy-lock-buffers (not executing-kbd-macro)
-	 (progn
-	   (and deactivate-mark (deactivate-mark))
-	   (sit-for
-	    (or (cdr-safe lazy-lock-defer-time) lazy-lock-defer-time 0)))
-	 (lazy-lock-fontify-after-defer)))
-  (defun lazy-lock-fontify-post-idle ()
-    (and lazy-lock-stealth-time (not executing-kbd-macro)
-	 (not (window-minibuffer-p (selected-window)))
-	 (progn
-	   (and deactivate-mark (deactivate-mark))
-	   (sit-for lazy-lock-stealth-time))
-	 (lazy-lock-fontify-after-idle)))
-  ;;
-  ;; Simulate running of `window-scroll-functions' in `set-window-buffer'.
-  (defvar lazy-lock-install nil)
-  (defun lazy-lock-fontify-after-install ()
-    (remove-hook 'post-command-hook 'lazy-lock-fontify-after-install)
-    (while lazy-lock-install
-      (mapcar 'lazy-lock-fontify-conservatively
-	      (get-buffer-window-list (pop lazy-lock-install) 'nomini t)))))
-
-(when (consp lazy-lock-defer-time)
-  ;;
-  ;; In 2.06.04 and below, `lazy-lock-defer-time' could specify modes and time.
-  (with-output-to-temp-buffer "*Help*"
-    (princ "The value of the variable `lazy-lock-defer-time' was\n ")
-    (princ lazy-lock-defer-time)
-    (princ "\n")
-    (princ "This variable cannot now be a list of modes and time, ")
-    (princ "so instead use the forms:\n")
-    (princ " (setq lazy-lock-defer-time ")
-    (princ (cdr lazy-lock-defer-time))
-    (princ ")\n")
-    (princ " (setq lazy-lock-defer-on-the-fly '")
-    (princ (car lazy-lock-defer-time))
-    (princ ")\n")
-    (princ "in your ~/.emacs.  ")
-    (princ "The above forms have been evaluated for this editor session,\n")
-    (princ "but you should change your ~/.emacs now."))
-  (setq lazy-lock-defer-on-the-fly (car lazy-lock-defer-time)
-	lazy-lock-defer-time (cdr lazy-lock-defer-time)))
-
-(when (boundp 'lazy-lock-defer-driven)
-  ;;
-  ;; In 2.06.04 and below, `lazy-lock-defer-driven' was the variable name.
-  (with-output-to-temp-buffer "*Help*"
-    (princ "The value of the variable `lazy-lock-defer-driven' is set to ")
-    (if (memq lazy-lock-defer-driven '(nil t))
-	(princ lazy-lock-defer-driven)
-      (princ "`")
-      (princ lazy-lock-defer-driven)
-      (princ "'"))
-    (princ ".\n")
-    (princ "This variable is now called `lazy-lock-defer-on-scrolling',\n")
-    (princ "so instead use the form:\n")
-    (princ " (setq lazy-lock-defer-on-scrolling ")
-    (unless (memq lazy-lock-defer-driven '(nil t))
-      (princ "'"))
-    (princ lazy-lock-defer-driven)
-    (princ ")\n")
-    (princ "in your ~/.emacs.  ")
-    (princ "The above form has been evaluated for this editor session,\n")
-    (princ "but you should change your ~/.emacs now."))
-  (setq lazy-lock-defer-on-scrolling lazy-lock-defer-driven))
-
-;; Possibly absent.
-
-(unless (boundp 'font-lock-inhibit-thing-lock)
-  ;; Font Lock mode uses this to direct Lazy and Fast Lock modes to stay off.
-  (defvar font-lock-inhibit-thing-lock nil
-    "List of Font Lock mode related modes that should not be turned on."))
-
-(unless (fboundp 'font-lock-value-in-major-mode)
-  (defun font-lock-value-in-major-mode (alist)
-    ;; Return value in ALIST for `major-mode'.
-    (if (consp alist)
-	(cdr (or (assq major-mode alist) (assq t alist)))
-      alist)))
-
-(unless (fboundp 'get-buffer-window-list)
-  ;; We use this to get all windows showing a buffer we have to fontify.
-  (defun get-buffer-window-list (buffer &optional minibuf frame)
-    "Return windows currently displaying BUFFER, or nil if none."
-    (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
-      (walk-windows (function (lambda (window)
-				(when (eq (window-buffer window) buffer)
-				  (push window windows))))
-		    minibuf frame)
-      windows)))
-
-;; Install ourselves:
-
-(add-hook 'window-size-change-functions 'lazy-lock-fontify-after-resize)
-(add-hook 'redisplay-end-trigger-functions 'lazy-lock-fontify-after-trigger)
-
-(unless (assq 'lazy-lock-mode minor-mode-alist)
-  (setq minor-mode-alist (append minor-mode-alist '((lazy-lock-mode nil)))))
-
-;; Provide ourselves:
-
-(provide 'lazy-lock)
-
-;;; lazy-lock.el ends here
diff --git a/lisp/ledit.el b/lisp/ledit.el
deleted file mode 100644
index f106abfe08b..00000000000
--- a/lisp/ledit.el
+++ /dev/null
@@ -1,155 +0,0 @@
-;;; ledit.el --- Emacs side of ledit interface
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keyword: languages
-
-;; 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 is a major mode for editing Liszt.  See etc/LEDIT for details.
-
-;;; Code:
-
-;;; To do:
-;;; o lisp -> emacs side of things (grind-definition and find-definition)
-
-(defvar ledit-mode-map nil)
-
-(defconst ledit-zap-file (concat "/tmp/" (user-login-name) ".l1")
-  "File name for data sent to Lisp by Ledit.")
-(defconst ledit-read-file (concat "/tmp/" (user-login-name) ".l2")
-  "File name for data sent to Ledit by Lisp.")
-(defconst ledit-compile-file 
-  (concat "/tmp/" (user-login-name) ".l4")
-  "File name for data sent to Lisp compiler by Ledit.")
-(defconst ledit-buffer "*LEDIT*"
-  "Name of buffer in which Ledit accumulates data to send to Lisp.")
-
-;;;###autoload
-(defconst ledit-save-files t "\
-*Non-nil means Ledit should save files before transferring to Lisp.")
-;;;###autoload
-(defconst ledit-go-to-lisp-string "%?lisp" "\
-*Shell commands to execute to resume Lisp job.")
-;;;###autoload
-(defconst ledit-go-to-liszt-string "%?liszt" "\
-*Shell commands to execute to resume Lisp compiler job.")
-
-(defun ledit-save-defun ()
-  "Save the current defun in the ledit buffer"
-  (interactive)
-  (save-excursion
-   (end-of-defun)
-   (let ((end (point)))
-     (beginning-of-defun)
-     (append-to-buffer ledit-buffer (point) end))
-   (message "Current defun saved for Lisp")))
-
-(defun ledit-save-region (beg end)
-  "Save the current region in the ledit buffer"
-  (interactive "r")
-  (append-to-buffer ledit-buffer beg end)
-  (message "Region saved for Lisp"))
-
-(defun ledit-zap-defun-to-lisp ()
-  "Carry the current defun to Lisp."
-  (interactive)
-  (ledit-save-defun)
-  (ledit-go-to-lisp))
-
-(defun ledit-zap-defun-to-liszt ()
-  "Carry the current defun to liszt."
-  (interactive)
-  (ledit-save-defun)
-  (ledit-go-to-liszt))
-
-(defun ledit-zap-region-to-lisp (beg end)
-  "Carry the current region to Lisp."
-  (interactive "r")
-  (ledit-save-region beg end)
-  (ledit-go-to-lisp))
-
-(defun ledit-go-to-lisp ()
-  "Suspend Emacs and restart a waiting Lisp job."
-  (interactive)
-  (if ledit-save-files
-      (save-some-buffers))
-  (if (get-buffer ledit-buffer)
-      (save-excursion
-       (set-buffer ledit-buffer)
-       (goto-char (point-min))
-       (write-region (point-min) (point-max) ledit-zap-file)
-       (erase-buffer)))
-  (suspend-emacs ledit-go-to-lisp-string)
-  (load ledit-read-file t t))
-
-(defun ledit-go-to-liszt ()
-  "Suspend Emacs and restart a waiting Liszt job."
-  (interactive)
-  (if ledit-save-files
-      (save-some-buffers))
-  (if (get-buffer ledit-buffer)
-      (save-excursion
-       (set-buffer ledit-buffer)
-       (goto-char (point-min))
-       (insert "(declare (macros t))\n")
-       (write-region (point-min) (point-max) ledit-compile-file)
-       (erase-buffer)))
-  (suspend-emacs ledit-go-to-liszt-string)
-  (load ledit-read-file t t))
-
-(defun ledit-setup ()
-  "Set up key bindings for the Lisp/Emacs interface."
-  (if (not ledit-mode-map)
-      (progn (setq ledit-mode-map (nconc (make-sparse-keymap) 
-					 shared-lisp-mode-map))))
-  (define-key ledit-mode-map "\e\^d" 'ledit-save-defun)
-  (define-key ledit-mode-map "\e\^r" 'ledit-save-region)
-  (define-key ledit-mode-map "\^xz" 'ledit-go-to-lisp)
-  (define-key ledit-mode-map "\e\^c" 'ledit-go-to-liszt))
-
-(ledit-setup)
-
-;;;###autoload
-(defun ledit-mode ()
-  "\\<ledit-mode-map>Major mode for editing text and stuffing it to a Lisp job.
-Like Lisp mode, plus these special commands:
-  \\[ledit-save-defun]	-- record defun at or after point
-	   for later transmission to Lisp job.
-  \\[ledit-save-region] -- record region for later transmission to Lisp job.
-  \\[ledit-go-to-lisp] -- transfer to Lisp job and transmit saved text.
-  \\[ledit-go-to-liszt] -- transfer to Liszt (Lisp compiler) job
-	   and transmit saved text.
-\\{ledit-mode-map}
-To make Lisp mode automatically change to Ledit mode,
-do (setq lisp-mode-hook 'ledit-from-lisp-mode)"
-  (interactive)
-  (lisp-mode)
-  (ledit-from-lisp-mode))
-
-;;;###autoload
-(defun ledit-from-lisp-mode ()
-  (use-local-map ledit-mode-map)
-  (setq mode-name "Ledit")
-  (setq major-mode 'ledit-mode)
-  (run-hooks 'ledit-mode-hook))
-
-;;; ledit.el ends here
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
deleted file mode 100644
index 726ae22e8da..00000000000
--- a/lisp/loadhist.el
+++ /dev/null
@@ -1,149 +0,0 @@
-;;; loadhist.el --- lisp functions for working with feature groups
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Version: 1.0
-;; 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:
-
-;; These functions exploit the load-history system variable.
-;; Entry points include `unload-feature', `symbol-file', and `feature-file'.
-
-;;; Code:
-
-(defun symbol-file (sym)
-  "Return the input source from which SYM was loaded.
-This is a file name, or nil if the source was a buffer with no associated file."
-  (catch 'foundit
-    (mapcar
-     (function (lambda (x) (if (memq sym (cdr x)) (throw 'foundit (car x)))))
-     load-history)
-    nil))
-
-(defun feature-symbols (feature)
-  "Return the file and list of symbols associated with a given FEATURE."
-   (catch 'foundit
-     (mapcar
-      (function (lambda (x) 
-		  (if (member (cons 'provide feature) (cdr x))
-		      (throw 'foundit x))))
-      load-history)
-     nil))
-
-(defun feature-file (feature)
-  "Return the file name from which a given FEATURE was loaded.
-Actually, return the load argument, if any; this is sometimes the name of a
-Lisp file without an extension.  If the feature came from an eval-buffer on
-a buffer with no associated file, or an eval-region, return nil."
-  (if (not (featurep feature))
-      (error "%s is not a currently loaded feature" (symbol-name feature))
-    (car (feature-symbols feature))))
-
-(defun file-provides (file)
-  "Return the list of features provided by FILE."
-  (let ((symbols (cdr (assoc file load-history))) (provides nil))
-    (mapcar
-     (function (lambda (x)
-		 (if (and (consp x) (eq (car x) 'provide))
-		     (setq provides (cons (cdr x) provides)))))
-     symbols)
-    provides
-    ))
-
-(defun file-requires (file)
-  "Return the list of features required by FILE."
-  (let ((symbols (cdr (assoc file load-history))) (requires nil))
-    (mapcar
-     (function (lambda (x)
-		 (if (and (consp x) (eq (car x) 'require))
-		     (setq requires (cons (cdr x) requires)))))
-     symbols)
-    requires
-    ))
-
-(defun file-set-intersect (p q)
-  ;; Return the set intersection of two lists
-  (let ((ret nil))
-    (mapcar
-     (function (lambda (x) (if (memq x q) (setq ret (cons x ret)))))
-     p)
-    ret
-    ))
-
-(defun file-dependents (file)
-  "Return the list of loaded libraries that depend on FILE.
-This can include FILE itself."
-  (let ((provides (file-provides file)) (dependents nil))
-    (mapcar
-     (function (lambda (x) 
-		 (if (file-set-intersect provides (file-requires (car x)))
-		     (setq dependents (cons (car x) dependents)))))
-     load-history)
-    dependents
-    ))
-
-(defun read-feature (prompt)
-  "Read a feature name \(string\) from the minibuffer,
-prompting with PROMPT and completing from `features', and
-return the feature \(symbol\)."
-  (intern (completing-read prompt
-			   (mapcar (function (lambda (feature)
-					       (list (symbol-name feature))))
-				   features)
-			   nil t)))
-
-;;;###autoload
-(defun unload-feature (feature &optional force)
-  "Unload the library that provided FEATURE, restoring all its autoloads.
-If the feature is required by any other loaded code, and optional FORCE
-is nil, raise an error."
-  (interactive (list (read-feature "Feature: ")))
-  (if (not (featurep feature))
-      (error "%s is not a currently loaded feature" (symbol-name feature)))
-  (if (not force)
-      (let* ((file (feature-file feature))
-	     (dependents (delete file (copy-sequence (file-dependents file)))))
-	(if dependents
-	    (error "Loaded libraries %s depend on %s"
-		   (prin1-to-string dependents) file)
-	    )))
-  (let* ((flist (feature-symbols feature)) (file (car flist)))
-    (mapcar
-     (function (lambda (x) 
-		 (cond ((stringp x) nil)
-		       ((consp x)
-			;; Remove any feature names that this file provided.
-			(if (eq (car x) 'provide)
-			    (setq features (delq (cdr x) features))))
-		       ((boundp x) (makunbound x))
-		       ((fboundp x)
-			(fmakunbound x)
-			(let ((aload (get x 'autoload)))
-			  (if aload (fset x (cons 'autoload aload))))))))
-     (cdr flist))
-    ;; Delete the load-history element for this file.
-    (let ((elt (assoc file load-history)))
-      (setq load-history (delq elt load-history)))))
-
-(provide 'loadhist)
-
-;;; loadhist.el ends here
diff --git a/lisp/loadup.el b/lisp/loadup.el
deleted file mode 100644
index 06770a7809b..00000000000
--- a/lisp/loadup.el
+++ /dev/null
@@ -1,253 +0,0 @@
-;;; loadup.el --- load up standardly loaded Lisp files for Emacs.
-
-;; Copyright (C) 1985, 1986, 1992, 1994 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 is loaded into a bare Emacs to make a dumpable one.
-
-;;; Code:
-
-(message "Using load-path %s" load-path)
-
-;;; We don't want to have any undo records in the dumped Emacs.
-(buffer-disable-undo "*scratch*")
-
-(load "subr")
-
-;; We specify .el in case someone compiled version.el by mistake.
-(load "version.el")
-
-(garbage-collect)
-(load "byte-run")
-(garbage-collect)
-(load "map-ynp")
-(garbage-collect)
-(load "bindings.el")  ;Don't get confused if someone compiled this by mistake.
-(garbage-collect)
-(load "loaddefs.el")  ;Don't get confused if someone compiled this by mistake.
-(garbage-collect)
-(load "simple")
-(garbage-collect)
-(load "help")
-(garbage-collect)
-(load "files")
-(garbage-collect)
-(load "format")
-(garbage-collect)
-(load "indent")
-(garbage-collect)
-(load "isearch")
-(garbage-collect)
-(load "window")
-(garbage-collect)
-(load "frame")
-(if (fboundp 'frame-face-alist)
-    (progn
-      (garbage-collect)
-      (load "faces")
-      (load "facemenu")))
-(if (fboundp 'track-mouse)
-    (progn
-      (garbage-collect)
-      (load "mouse")
-      (garbage-collect)
-      (load "scroll-bar")
-      (load "select")))
-(load "menu-bar")
-(garbage-collect)
-(load "paths.el")  ;Don't get confused if someone compiled paths by mistake.
-(garbage-collect)
-(load "startup")
-(garbage-collect)
-(load "lisp")
-(garbage-collect)
-(load "page")
-(garbage-collect)
-(load "register")
-(garbage-collect)
-(load "paragraphs")
-(garbage-collect)
-(load "lisp-mode")
-(garbage-collect)
-(load "text-mode")
-(garbage-collect)
-(load "fill")
-(garbage-collect)
-(load "replace")
-(if (eq system-type 'vax-vms)
-    (progn
-      (garbage-collect)
-      (load "vmsproc")))
-(garbage-collect)
-(load "abbrev")
-(garbage-collect)
-(load "buff-menu")
-(if (eq system-type 'vax-vms)
-    (progn
-      (garbage-collect)
-      (load "vms-patch")))
-(if (eq system-type 'windows-nt)
-    (progn
-      (garbage-collect)
-      (load "ls-lisp")
-      (garbage-collect)
-      (load "disp-table") ; needed to setup ibm-pc char set, see internal.el
-      (garbage-collect)
-      (load "dos-w32")
-      (garbage-collect)
-      (load "w32-fns")
-      (garbage-collect)))
-(if (eq system-type 'ms-dos)
-    (progn
-      (load "ls-lisp")
-      (garbage-collect)
-      (load "dos-w32")
-      (garbage-collect)
-      (load "dos-fns")
-      (garbage-collect)
-      (load "disp-table") ; needed to setup ibm-pc char set, see internal.el
-      (garbage-collect)))
-(if (fboundp 'atan)	; preload some constants and 
-    (progn		; floating pt. functions if 
-      (garbage-collect)	; we have float support.
-      (load "float-sup")))
-
-(garbage-collect)
-(load "vc-hooks")
-(load "ediff-hook")
-
-;If you want additional libraries to be preloaded and their
-;doc strings kept in the DOC file rather than in core,
-;you may load them with a "site-load.el" file.
-;But you must also cause them to be scanned when the DOC file
-;is generated.  For VMS, you must edit ../vms/makedoc.com.
-;For other systems, you must edit ../src/Makefile.in.
-(if (load "site-load" t)
-    (garbage-collect))
-
-(if (fboundp 'x-popup-menu)
-    (precompute-menubar-bindings))
-;; Turn on recording of which commands get rebound,
-;; for the sake of the next call to precompute-menubar-bindings.
-(setq define-key-rebound-commands nil)
-
-;; Determine which last version number to use
-;; based on the executables that now exist.
-(if (and (or (equal (nth 3 command-line-args) "dump")
-	     (equal (nth 4 command-line-args) "dump"))
-	 (not (eq system-type 'ms-dos)))
-    (let* ((base (concat "emacs-" emacs-version "."))
-	   (files (file-name-all-completions base default-directory))
-	   (versions (mapcar (function (lambda (name)
-					 (string-to-int (substring name (length base)))))
-			     files)))
-      (setq emacs-version (format "%s.%d"
-				  emacs-version
-				  (if versions
-				      (1+ (apply 'max versions))
-				    1)))))
-
-;; Note: all compiled Lisp files loaded above this point
-;; must be among the ones parsed by make-docfile
-;; to construct DOC.  Any that are not processed
-;; for DOC will not have doc strings in the dumped Emacs.
-
-(message "Finding pointers to doc strings...")
-(if (or (equal (nth 3 command-line-args) "dump")
-	(equal (nth 4 command-line-args) "dump"))
-    (let ((name emacs-version))
-      (while (string-match "[^-+_.a-zA-Z0-9]+" name)
-	(setq name (concat (downcase (substring name 0 (match-beginning 0)))
-			   "-"
-			   (substring name (match-end 0)))))
-      (if (memq system-type '(ms-dos windows-nt))
-	  (setq name (expand-file-name
-		      (if (fboundp 'x-create-frame) "DOC-X" "DOC") "../etc"))
-	(setq name (concat (expand-file-name "../etc/DOC-") name))
-	(if (file-exists-p name)
-	    (delete-file name))
-	(copy-file (expand-file-name "../etc/DOC") name t))
-      (Snarf-documentation (file-name-nondirectory name)))
-    (Snarf-documentation "DOC"))
-(message "Finding pointers to doc strings...done")
-
-;Note: You can cause additional libraries to be preloaded
-;by writing a site-init.el that loads them.
-;See also "site-load" above.
-(load "site-init" t)
-(setq current-load-list nil)
-(garbage-collect)
-
-;;; At this point, we're ready to resume undo recording for scratch.
-(buffer-enable-undo "*scratch*")
-
-(if (or (equal (nth 3 command-line-args) "dump")
-	(equal (nth 4 command-line-args) "dump"))
-    (if (eq system-type 'vax-vms)
-	(progn 
-	  (message "Dumping data as file temacs.dump")
-	  (dump-emacs "temacs.dump" "temacs")
-	  (kill-emacs))
-      (let ((name (concat "emacs-" emacs-version)))
-	(while (string-match "[^-+_.a-zA-Z0-9]+" name)
-	  (setq name (concat (downcase (substring name 0 (match-beginning 0)))
-			     "-"
-			     (substring name (match-end 0)))))
-	(if (eq system-type 'ms-dos)
-	    (message "Dumping under the name emacs")
-	  (message "Dumping under names emacs and %s" name)))
-      (condition-case ()
-	  (delete-file "emacs")
-	(file-error nil))
-      ;; We used to dump under the name xemacs, but that occasionally
-      ;; confused people installing Emacs (they'd install the file
-      ;; under the name `xemacs'), and it's inconsistent with every
-      ;; other GNU product's build process.
-      (dump-emacs "emacs" "temacs")
-      (message "%d pure bytes used" pure-bytes-used)
-      ;; Recompute NAME now, so that it isn't set when we dump.
-      (if (not (memq system-type '(ms-dos windows-nt)))
-	  (let ((name (concat "emacs-" emacs-version)))
-	    (while (string-match "[^-+_.a-zA-Z0-9]+" name)
-	      (setq name (concat (downcase (substring name 0 (match-beginning 0)))
-				 "-"
-				 (substring name (match-end 0)))))
-	    (add-name-to-file "emacs" name t)))
-      (kill-emacs)))
-
-;; Avoid error if user loads some more libraries now.
-(setq purify-flag nil)
-
-;; For machines with CANNOT_DUMP defined in config.h,
-;; this file must be loaded each time Emacs is run.
-;; So run the startup code now.
-
-(or (equal (nth 3 command-line-args) "dump")
-    (equal (nth 4 command-line-args) "dump")
-    (progn
-      ;; Avoid loading loadup.el a second time!
-      (setq command-line-args (cdr (cdr command-line-args)))
-      (eval top-level)))
-
-;;; loadup.el ends here
diff --git a/lisp/locate.el b/lisp/locate.el
deleted file mode 100644
index 9084a1021bb..00000000000
--- a/lisp/locate.el
+++ /dev/null
@@ -1,365 +0,0 @@
-;; Locate.el: interface to the locate command
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Peter Breton <pbreton@i-kinetics.com>
-
-;; 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:
-
-;; Search a database of files and use dired commands on
-;; the result. 
-;;
-
-;;;;; Building a database of files ;;;;;;;;;
-;; 
-;; You can create a simple files database with a port of the Unix find command
-;; and one of the various Windows NT various scheduling utilities,
-;; for example the AT command from the NT Resource Kit, WinCron which is
-;; included with Microsoft FrontPage, or the shareware NTCron program.
-;;
-;; To set up a function which searches the files database, do something
-;; like this:
-;; 
-;; (defvar locate-fcodes-file       (concat my-home "/fcodes"))
-;; (defvar locate-make-command-line 'nt-locate-make-command-line)
-;; 
-;; (defun nt-locate-make-command-line (arg)
-;;  (cons "grep"
-;;        (mapconcat 'identity
-;; 		  (list "-i" arg locate-fcodes-file)
-;; 		  " ")))
-;;
-;;;;;;;; ADVICE For dired-make-relative: ;;;;;;;;;
-;; 
-;; For certain dired commands to work right, you should also include the
-;; following in your _emacs/.emacs:
-;; 
-;; (defadvice dired-make-relative (before set-no-error activate)
-;;   "For locate mode and Windows, don't return errors"
-;;   (if (and (eq   major-mode  'locate-mode)
-;; 	   (memq system-type (list 'windows-nt 'ms-dos)))
-;;       (ad-set-arg 2 t)
-;;     ))
-;;
-;; Otherwise, dired-make-relative will give error messages like
-;; "FILENAME: not in directory tree growing at /"
-
-;;; Commentary:
-;;
-;; Locate.el provides an interface to a program which searches a
-;; database of file names. By default, this program is the GNU locate
-;; command, but it could also be the BSD-style find command, or even a
-;; user specified command.
-;;
-;; To use the BSD-style "fast find", or any other shell command of the
-;; form 
-;;
-;;   SHELLPROGRAM  Name-to-find
-;;
-;; set the variable locate-command in your .emacs file.
-;;
-;;   To use a more complicated expression, create a function which 
-;; takes a string (the name to find) as input and returns a cons
-;; pair: the car should be the command to be executed, the cdr
-;; should be the arguments, concatenated into a string (including
-;; the name to find). Then do
-;;
-;; (setq locate-make-command-line 'my-locate-command-line) 
-;;
-;; in your .emacs, using the name of your function in place of
-;; my-locate-command-line
-;;
-;; You should make sure that whichever command you use works correctly
-;; from a shell prompt. GNU locate and BSD find expect the file databases
-;; to either be in standard places or located via environment variables.
-;; If the latter, make sure these environment variables are set in
-;; your emacs process
-;;
-;; Locate-mode assumes that each line output from the locate-command
-;; consists exactly of a file name, possibly preceded or trailed by
-;; whitespace. If your file database has other information on the line (for
-;; example, the file size), you will need to redefine the function 
-;; locate-get-file-positions to return a list consisting of the first
-;; character in the file name and the last character in the file name.
-;;
-;; To use locate-mode, simply type M-x locate and then the string
-;; you wish to find. You can use almost all of the dired commands in
-;; the resulting *Locate* buffer.  It is worth noting that your commands
-;; do not, of course, affect the file database. For example, if you
-;; compress a file in the locate buffer, the actual file will be
-;; compressed, but the entry in the file database will not be
-;; affected. Consequently, the database and the filesystem will be out
-;; of sync until the next time the database is updated
-;;
-;; The command locate-with-filter keeps only lines matching a
-;; regular expression; this is often useful to constrain a big search.
-;;
-
-;;; Code:
-
-(eval-when-compile
-  (require 'dired))
-
-;; Variables
-(defvar locate-command "locate"
-  "*The executable program used to search a database of files.")
-
-(defvar locate-history-list nil
-  "The history list used by the \\[locate] command.")
-
-(defvar locate-make-command-line 'locate-default-make-command-line
-  "*Function used to create the locate command line.")
-
-(defvar locate-buffer-name "*Locate*"
-  "*Name of the buffer to show results from the \\[locate] command.")
-
-(defvar locate-fcodes-file nil
-  "*Database of filenames.")
-
-(defvar locate-mouse-face 'highlight
-  "*Face used to highlight locate entries.")
-
-(defvar locate-header-face 'region
-  "*Face used to highlight the locate header.")
-
-(defvar locate-current-filter nil)
-
-;; Functions
-
-(defun locate-default-make-command-line (search-string)
-  (cons locate-command search-string))
-
-;;;### autoload
-(defun locate (search-string &optional filter)
-  "Run the \\[locate] command, putting results in `*Locate*' buffer."
-  (interactive
-      (list (read-from-minibuffer "Locate: " nil nil
-		  nil 'locate-history-list)))
-  (let* ((pop-up-windows 1)
-	 (locate-cmd-list (funcall locate-make-command-line search-string))
-	 (locate-cmd (car locate-cmd-list))
-	 (locate-cmd-args (cdr locate-cmd-list))
-	 (locate-proc)
-	)
-    
-    ;; Find the Locate buffer
-    (if (not (string-equal (buffer-name) locate-buffer-name))
-       (switch-to-buffer-other-window locate-buffer-name))
-
-    (locate-mode)
-    (erase-buffer)
-
-    (setq locate-current-filter filter)
-
-    (call-process locate-cmd nil t nil locate-cmd-args)
-    (if filter
-	(locate-filter-output filter))
-
-    (locate-do-setup)
- )
-)
-
-;;;### autoload
-(defun locate-with-filter (search-string filter)
-  "Run the locate command with a filter."
-  (interactive
-      (list (read-from-minibuffer "Locate: " nil nil
-		  nil 'locate-history-list)
-            (read-from-minibuffer "Filter: " nil nil
-		  nil 'grep-history)))
-  (locate search-string filter))
-
-(defun locate-filter-output (filter)
-  "Filter output from the locate command."
-  (goto-char (point-min))
-  (delete-non-matching-lines (regexp-quote filter)))
-
-(defvar locate-mode-map nil
-  "Local keymap for Locate mode buffers.")
-(if locate-mode-map
-    nil
-
-   (require 'dired)
-
-   (setq locate-mode-map (copy-keymap dired-mode-map))
-
-   ;; Undefine Useless Dired Menu bars
-   (define-key locate-mode-map [menu-bar Dired]   'undefined)
-   (define-key locate-mode-map [menu-bar subdir]  'undefined)
-
-   (define-key locate-mode-map [menu-bar mark executables] 'undefined)
-   (define-key locate-mode-map [menu-bar mark directory]   'undefined)
-   (define-key locate-mode-map [menu-bar mark directories] 'undefined)
-   (define-key locate-mode-map [menu-bar mark symlinks]    'undefined)
-
-   (define-key locate-mode-map [mouse-2] 'mouse-locate-view-file)
-   (define-key locate-mode-map "\C-ct"   'locate-tags)
-
-   (define-key locate-mode-map "U"       'dired-unmark-all-files-no-query)
-)
-
-;; This variable is used to indent the lines and then to search for
-;; the file name
-(defconst locate-filename-indentation 4
- "The amount of indentation for each file.")
-
-(defun locate-get-file-positions ()
-  (save-excursion
-     (end-of-line)
-     (let ((eol (point)))
-       (beginning-of-line)
-
-       ;; Assumes names end at the end of the line
-       (forward-char locate-filename-indentation)
-       (list (point) eol))))
-
-;; From SQL-mode
-(defun current-line ()
-  "Return the current line number, as an integer."
-  (interactive)
-  (+ (count-lines (point-min) (point))
-     (if (eq (current-column) 0)
-	 1
-       0)))
-
-(defun locate-get-filename ()
-  (let ((pos    (locate-get-file-positions))
-	(lineno (current-line)))
-    (and (not (eq lineno 1)) 
-	 (not (eq lineno 2)) 
-	 (buffer-substring (elt pos 0) (elt pos 1)))))
-
-(defun mouse-locate-view-file (event)
-  "In Locate mode, view a file, using the mouse."
-  (interactive "@e") 
-  (save-excursion
-    (goto-char (posn-point (event-start event)))
-      (view-file (locate-get-filename))))
-
-;; Define a mode for locate
-;; Default directory is set to "/" so that dired commands, which
-;; expect to be in a tree, will work properly
-(defun locate-mode ()
-  "Major mode for the `*Locate*' buffer made by \\[locate]."
-  (kill-all-local-variables)
-  (use-local-map             locate-mode-map)
-  (setq major-mode          'locate-mode
-        mode-name           "Locate"
-        default-directory   "/"
-	dired-subdir-alist  (list (cons "/" (point-min-marker))))
-  (make-local-variable 'dired-move-to-filename-regexp)
-  (setq dired-move-to-filename-regexp
-	(make-string locate-filename-indentation ?\ ))
-  (make-local-variable 'dired-actual-switches)
-  (setq dired-actual-switches "")
-  (make-local-variable 'dired-permission-flags-regexp)
-  (setq dired-permission-flags-regexp "^\\(    \\)")
-  (run-hooks 'locate-mode-hook))
-
-(defun locate-do-setup ()
-  (let ((search-string (car locate-history-list)))
-    (goto-char (point-min))
-    (save-excursion
-      
-      ;; Nothing returned from locate command?
-      (if (eobp)
-	  (progn
-	    (kill-buffer locate-buffer-name)
-	    (delete-window)
-	    (if locate-current-filter
-		(error "Locate: no match for %s in database using filter %s"
-		       search-string locate-current-filter)
-	    (error "Locate: no match for %s in database" search-string))))
-
-      (locate-insert-header search-string)
-      
-      (while (not (eobp))
-	(insert-char ?\  locate-filename-indentation t)
-	(locate-set-properties)
-	(forward-line 1)))))
-
-(defun locate-set-properties ()
-  (save-excursion
-    (let ((pos (locate-get-file-positions)))
-      (add-text-properties (elt pos 0) (elt pos 1)
-			   (list 'mouse-face locate-mouse-face)))))
-
-(defun locate-insert-header (search-string)
-  (let ((locate-format-string "Matches for %s")
-	(locate-regexp-match
-	 (concat " *Matches for \\(" (regexp-quote search-string) "\\)"))
-	(locate-format-args (list search-string))
-	)
-  
-    (if locate-fcodes-file
-	(setq locate-format-string
-	      (concat locate-format-string " in %s")
-	      locate-regexp-match
-	      (concat locate-regexp-match
-		      " in \\("
-		      (regexp-quote locate-fcodes-file)
-		      "\\)")
-	      locate-format-args
-	      (append (list locate-fcodes-file) locate-format-args)))
-
-    (if locate-current-filter
-	(setq locate-format-string
-	      (concat locate-format-string " using filter %s")
-	      locate-regexp-match
-	      (concat locate-regexp-match
-		      " using filter "
-		      "\\("
-		      (regexp-quote locate-current-filter)
-		      "\\)")
-	      locate-format-args
-	      (append (list locate-current-filter) locate-format-args)))
-	
-    (setq locate-format-string
-	  (concat locate-format-string ": \n\n")
-	  locate-regexp-match
-	  (concat locate-regexp-match ": \n"))
-    
-    (insert (apply 'format locate-format-string (reverse locate-format-args)))
-    
-    (save-excursion
-      (goto-char (point-min))
-      (if (not (looking-at locate-regexp-match))
-	  nil
-	(add-text-properties (match-beginning 1) (match-end 1)
-			     (list 'face locate-header-face))
-	(and (match-beginning 2)
-	     (add-text-properties (match-beginning 2) (match-end 2)
-				  (list 'face locate-header-face)))
-	(and (match-beginning 3)
-	     (add-text-properties (match-beginning 3) (match-end 3)
-				  (list 'face locate-header-face)))
-	))))
-
-(defun locate-tags ()
-  "Visit a tags table in `*Locate*' mode."
-  (interactive)
-  (let ((tags-table (locate-get-filename)))
-   (if (y-or-n-p (format "Visit tags table %s? " tags-table)) 
-     (visit-tags-table tags-table)
-    nil)))
-
-(provide 'locate)
-
-;;; locate.el ends here
diff --git a/lisp/lpr.el b/lisp/lpr.el
deleted file mode 100644
index 34956193642..00000000000
--- a/lisp/lpr.el
+++ /dev/null
@@ -1,188 +0,0 @@
-;;; lpr.el --- print Emacs buffer on line printer.
-
-;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: unix
-
-;; 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:
-
-;; Commands to send the region or a buffer your printer.  Entry points
-;; are `lpr-buffer', `print-buffer', lpr-region', or `print-region'; option
-;; variables include `lpr-switches' and `lpr-command'.
-
-;;; Code:
-
-;;;###autoload
-(defvar lpr-switches nil 
-  "*List of strings to pass as extra options for the printer program.
-See `lpr-command'.")
-
-(defvar lpr-add-switches (eq system-type 'berkeley-unix)
-  "*Non-nil means construct -T and -J options for the printer program.
-These are made assuming that the program is `lpr';
-if you are using some other incompatible printer program,
-this variable should be nil.")
-
-;;;###autoload
-(defvar lpr-command
-  (if (memq system-type '(usg-unix-v dgux hpux irix))
-      "lp" "lpr")
-  "*Name of program for printing a file.")
-
-;; Default is nil, because that enables us to use pr -f
-;; which is more reliable than pr with no args, which is what lpr -p does.
-(defvar lpr-headers-switches nil
-  "*List of strings of options to request page headings in the printer program.
-If nil, we run `lpr-page-header-program' to make page headings
-and print the result.")
-
-(defvar print-region-function nil
-  "Function to call to print the region on a printer.
-See definition of `print-region-1' for calling conventions.")
-
-(defvar lpr-page-header-program "pr"
-  "*Name of program for adding page headers to a file.")
-
-(defvar lpr-page-header-switches '("-f")
-  "*List of strings to use as options for the page-header-generating program.
-The variable `lpr-page-header-program' specifies the program to use.")
-
-;;;###autoload
-(defun lpr-buffer ()
-  "Print buffer contents as with Unix command `lpr'.
-`lpr-switches' is a list of extra switches (strings) to pass to lpr."
-  (interactive)
-  (print-region-1 (point-min) (point-max) lpr-switches nil))
-
-;;;###autoload
-(defun print-buffer ()
-  "Print buffer contents as with Unix command `lpr -p'.
-`lpr-switches' is a list of extra switches (strings) to pass to lpr."
-  (interactive)
-  (print-region-1 (point-min) (point-max) lpr-switches t))
-
-;;;###autoload
-(defun lpr-region (start end)
-  "Print region contents as with Unix command `lpr'.
-`lpr-switches' is a list of extra switches (strings) to pass to lpr."
-  (interactive "r")
-  (print-region-1 start end lpr-switches nil))
-
-;;;###autoload
-(defun print-region (start end)
-  "Print region contents as with Unix command `lpr -p'.
-`lpr-switches' is a list of extra switches (strings) to pass to lpr."
-  (interactive "r")
-  (print-region-1 start end lpr-switches t))
-
-(defun print-region-1 (start end switches page-headers)
-  ;; On some MIPS system, having a space in the job name
-  ;; crashes the printer demon.  But using dashes looks ugly
-  ;; and it seems to annoying to do for that MIPS system.
-  (let ((name (concat (buffer-name) " Emacs buffer"))
-	(title (concat (buffer-name) " Emacs buffer"))
-	;; On MS-DOS systems, make pipes use binary mode if the
-	;; original file is binary.
-	(binary-process-input buffer-file-type)
-	(binary-process-output buffer-file-type)
-	(width tab-width)
-	switch-string)
-    (save-excursion
-      (if page-headers
-	  (if lpr-headers-switches
-	      ;; It is possible to use an lpr option
-	      ;; to get page headers.
-	      (setq switches (append (if (stringp lpr-headers-switches)
-					 (list lpr-headers-switches)
-				        lpr-headers-switches)
-				     switches))))
-      (setq switch-string
-	    (if switches (concat " with options "
-				 (mapconcat 'identity switches " "))
-	      ""))
-      (message "Spooling%s..." switch-string)
-      (if (/= tab-width 8)
-	  (let ((new-coords (print-region-new-buffer start end)))
-	    (setq start (car new-coords) end (cdr new-coords))
-	    (setq tab-width width)
-	    (save-excursion
-	      (goto-char end)
-	      (setq end (point-marker)))
-	    (untabify (point-min) (point-max))))
-      (if page-headers
-	  (if lpr-headers-switches
-	      ;; We handled this above by modifying SWITCHES.
-	      nil
-	    ;; Run a separate program to get page headers.
-	    (let ((new-coords (print-region-new-buffer start end)))
-	      (setq start (car new-coords) end (cdr new-coords)))
-	    (apply 'call-process-region start end lpr-page-header-program
-				 t t nil
-				 (nconc (and lpr-add-switches
-					     (list "-h" title))
-					lpr-page-header-switches))
-	    (setq start (point-min) end (point-max))))
-      (apply (or print-region-function 'call-process-region)
-	     (nconc (list start end lpr-command
-			  nil nil nil)
-		    (nconc (and lpr-add-switches
-				(list "-J" name))
-			   ;; These belong in pr if we are using that.
-			   (and lpr-add-switches lpr-headers-switches
-				(list "-T" title))
-			   switches)))
-      (if (markerp end)
-	  (set-marker end nil))
-      (message "Spooling%s...done" switch-string))))
-
-;; This function copies the text between start and end
-;; into a new buffer, makes that buffer current.
-;; It returns the new range to print from the new current buffer
-;; as (START . END).
-
-(defun print-region-new-buffer (ostart oend)
-  (if (string= (buffer-name) " *spool temp*")
-      (cons ostart oend)
-    (let ((oldbuf (current-buffer)))
-      (set-buffer (get-buffer-create " *spool temp*"))
-      (widen) (erase-buffer)
-      (insert-buffer-substring oldbuf ostart oend)
-      (cons (point-min) (point-max)))))
-
-(defun printify-region (begin end)
-  "Turn nonprinting characters (other than TAB, LF, SPC, RET, and FF)
-in the current buffer into printable representations as control or
-hexadecimal escapes."
-  (interactive "r")
-  (save-excursion
-    (goto-char begin)
-    (let (c)
-      (while (re-search-forward "[\^@-\^h\^k\^n-\^_\177-\377]" end t)
-	(setq c (preceding-char))
-	(delete-backward-char 1)
-	(insert 
-	 (if (< c ?\ )
-	     (format "\\^%c" (+ c ?@))
-	   (format "\\%02x" c)))))))
-
-(provide 'lpr)
-
-;;; lpr.el ends here
diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el
deleted file mode 100644
index 158414664f3..00000000000
--- a/lisp/ls-lisp.el
+++ /dev/null
@@ -1,270 +0,0 @@
-;;; ls-lisp.el --- emulate insert-directory completely in Emacs Lisp
-
-;; Copyright (C) 1992, 1994 by Sebastian Kremer <sk@thp.uni-koeln.de>
-
-;; Author: Sebastian Kremer <sk@thp.uni-koeln.de>
-;; Keywords: unix
-
-;; 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:
-
-;; INSTALLATION =======================================================
-;; 
-;; Put this file into your load-path.  To use it, load it
-;; with (load "ls-lisp").
-
-;; OVERVIEW ===========================================================
-
-;; This file overloads the function insert-directory to implement it
-;; directly from Emacs lisp, without running `ls' in a subprocess.
-
-;; It is useful if you cannot afford to fork Emacs on a real memory UNIX,
-;; under VMS, or if you don't have the ls program, or if you want
-;; different format from what ls offers.
-
-;; This function uses regexps instead of shell
-;; wildcards.  If you enter regexps remember to double each $ sign.
-;; For example, to include files *.el, enter `.*\.el$$',
-;; resulting in the regexp `.*\.el$'.
-
-;;  RESTRICTIONS =====================================================
-
-;; * many ls switches are ignored, see docstring of `insert-directory'.
-
-;; * Only numeric uid/gid
-
-;; TODO ==============================================================
-
-;; Recognize some more ls switches: R F
-
-;;; Code:
-
-;;;###autoload
-(defvar ls-lisp-support-shell-wildcards t
-  "*Non-nil means file patterns are treated as shell wildcards.
-nil means they are treated as Emacs regexps (for backward compatibility).
-This variable is checked by \\[insert-directory] only when `ls-lisp.el'
-package is used.")
-
-(defun insert-directory (file &optional switches wildcard full-directory-p)
-  "Insert directory listing for FILE, formatted according to SWITCHES.
-Leaves point after the inserted text.
-Optional third arg WILDCARD means treat FILE as shell wildcard.
-Optional fourth arg FULL-DIRECTORY-P means file is a directory and
-switches do not contain `d', so that a full listing is expected.
-
-This version of the function comes from `ls-lisp.el'.  It doesn not
-run any external programs or shells.  It supports ordinary shell
-wildcards if `ls-lisp-support-shell-wildcards' variable is non-nil;
-otherwise, it interprets wildcards as regular expressions to match
-file names.
-
-Not all `ls' switches are supported.  The switches that work
-are: A a c i r S s t u"
-  (let ((handler (find-file-name-handler file 'insert-directory)))
-    (if handler
-	(funcall handler 'insert-directory file switches
-		 wildcard full-directory-p)
-      ;; Sometimes we get ".../foo*/" as FILE.  While the shell and
-      ;; `ls' don't mind, we certainly do, because it makes us think
-      ;; there is no wildcard, only a directory name.
-      (if (and ls-lisp-support-shell-wildcards
-	       (string-match "[[?*]" file))
-	  (progn
-	    (or (not (eq (aref file (1- (length file))) ?/))
-		(setq file (substring file 0 (1- (length file)))))
-	    (setq wildcard t)))
-      ;; Convert SWITCHES to a list of characters.
-      (setq switches (append switches nil))
-      (if wildcard
-	  (setq wildcard
-		(if ls-lisp-support-shell-wildcards
-		    (wildcard-to-regexp (file-name-nondirectory file))
-		  (file-name-nondirectory file))
-		file (file-name-directory file)))
-      (if (or wildcard
-	      full-directory-p)
-	  (let* ((dir (file-name-as-directory file))
-		 (default-directory dir);; so that file-attributes works
-		 (sum 0)
-		 elt
-		 short
-		 (file-list (directory-files dir nil wildcard))
-		 file-alist 
-		 (now (current-time))
-		 ;; do all bindings here for speed
-		 fil attr)
-	    (cond ((memq ?A switches)
-		   (setq file-list
-			 (ls-lisp-delete-matching "^\\.\\.?$" file-list)))
-		  ((not (memq ?a switches))
-		   ;; if neither -A  nor -a, flush . files
-		   (setq file-list
-			 (ls-lisp-delete-matching "^\\." file-list))))
-	    (setq file-alist
-		  (mapcar
-		   (function
-		    (lambda (x)
-		      ;; file-attributes("~bogus") bombs
-		      (cons x (file-attributes (expand-file-name x)))))
-		   ;; inserting the call to directory-files right here
-		   ;; seems to stimulate an Emacs bug
-		   ;; ILLEGAL DATATYPE (#o37777777727) or #o67
-		   file-list))
-	    ;; ``Total'' line (filled in afterwards).
-	    (insert (if (car-safe file-alist)
-			"total \007\n"
-		      ;; Shell says ``No match'' if no files match
-		      ;; the wildcard; let's say something similar.
-		      "(No match)\ntotal \007\n"))
-	    (setq file-alist
-		  (ls-lisp-handle-switches file-alist switches))
-	    (while file-alist
-	      (setq elt (car file-alist)
-		    file-alist (cdr file-alist)
-		    short (car elt)
-		    attr (cdr elt))
-	      (and attr
-		   (setq sum (+ sum (nth 7 attr)))
-		   (insert (ls-lisp-format short attr switches now))))
-	    ;; Fill in total size of all files:
-	    (save-excursion
-	      (search-backward "total \007")
-	      (goto-char (match-end 0))
-	      (delete-char -1)
-	      (insert (format "%d" (if (zerop sum) 0 (1+ (/ sum 1024)))))))
-	;; if not full-directory-p, FILE *must not* end in /, as
-	;; file-attributes will not recognize a symlink to a directory
-	;; must make it a relative filename as ls does:
-	(setq file (file-name-nondirectory file))
-	(insert (ls-lisp-format file (file-attributes file) switches
-				(current-time)))))))
-
-(defun ls-lisp-delete-matching (regexp list)
-  ;; Delete all elements matching REGEXP from LIST, return new list.
-  ;; Should perhaps use setcdr for efficiency.
-  (let (result)
-    (while list
-      (or (string-match regexp (car list))
-	  (setq result (cons (car list) result)))
-      (setq list (cdr list)))
-    result))
-
-(defun ls-lisp-handle-switches (file-alist switches)
-  ;; FILE-ALIST's elements are (FILE . FILE-ATTRIBUTES).
-  ;; Return new alist sorted according to SWITCHES which is a list of
-  ;; characters.  Default sorting is alphabetically.
-  (let (index)
-    (setq file-alist
-	  (sort file-alist
-		(cond ((memq ?S switches) ; sorted on size
-		       (function
-			(lambda (x y)
-			  ;; 7th file attribute is file size
-			  ;; Make largest file come first
-			  (< (nth 7 (cdr y))
-			     (nth 7 (cdr x))))))
-		      ((memq ?t switches) ; sorted on time
-		       (setq index (ls-lisp-time-index switches))
-		       (function
-			(lambda (x y)
-			  (ls-lisp-time-lessp (nth index (cdr y))
-					      (nth index (cdr x))))))
-		      (t		; sorted alphabetically
-		       (function
-			(lambda (x y)
-			  (string-lessp (car x)
-					(car y)))))))))
-  (if (memq ?r switches)		; reverse sort order
-      (setq file-alist (nreverse file-alist)))
-  file-alist)
-
-;; From Roland McGrath.  Can use this to sort on time.
-(defun ls-lisp-time-lessp (time0 time1)
-  (let ((hi0 (car time0))
-	(hi1 (car time1))
-	(lo0 (car (cdr time0)))
-	(lo1 (car (cdr time1))))
-    (or (< hi0 hi1)
-	(and (= hi0 hi1)
-	     (< lo0 lo1)))))
-
-
-(defun ls-lisp-format (file-name file-attr switches now)
-  (let ((file-type (nth 0 file-attr)))
-    (concat (if (memq ?i switches)	; inode number
-		(format "%6d " (nth 10 file-attr)))
-	    ;; nil is treated like "" in concat
-	    (if (memq ?s switches)	; size in K
-		(format "%4d " (1+ (/ (nth 7 file-attr) 1024))))
-	    (nth 8 file-attr)		; permission bits
-	    ;; numeric uid/gid are more confusing than helpful
-	    ;; Emacs should be able to make strings of them.
-	    ;; user-login-name and user-full-name could take an
-	    ;; optional arg.
-	    (format " %3d %-8s %-8s %8d "
-		    (nth 1 file-attr)	; no. of links
-		    (if (= (user-uid) (nth 2 file-attr))
-			(user-login-name)
-		      (int-to-string (nth 2 file-attr)))	; uid
-		    (if (eq system-type 'ms-dos)
-			"root"		; everything is root on MSDOS.
-		      (int-to-string (nth 3 file-attr)))	; gid
-		    (nth 7 file-attr)	; size in bytes
-		    )
-	    (ls-lisp-format-time file-attr switches now)
-	    " "
-	    file-name
-	    (if (stringp file-type)	; is a symbolic link
-		(concat " -> " file-type)
-	      "")
-	    "\n"
-	    )))
-
-(defun ls-lisp-time-index (switches)
-  ;; Return index into file-attributes according to ls SWITCHES.
-  (cond
-   ((memq ?c switches) 6)		; last mode change
-   ((memq ?u switches) 4)		; last access
-   ;; default is last modtime
-   (t 5)))
-
-(defun ls-lisp-format-time (file-attr switches now)
-  ;; Format time string for file with attributes FILE-ATTR according
-  ;; to SWITCHES (a list of ls option letters of which c and u are recognized).
-  ;; Use the same method as `ls' to decide whether to show time-of-day or year,
-  ;; depending on distance between file date and NOW.
-  (let* ((time (nth (ls-lisp-time-index switches) file-attr))
-	 (diff16 (- (car time) (car now)))
-	 (diff (+ (ash diff16 16) (- (car (cdr time)) (car (cdr now)))))
-	 (past-cutoff (- (* 6 30 24 60 60)))	; 6 30-day months
-	 (future-cutoff (* 60 60)))		; 1 hour
-    (format-time-string
-     (if (and
-	  (<= past-cutoff diff) (<= diff future-cutoff)
-	  ;; Sanity check in case `diff' computation overflowed.
-	  (<= (1- (ash past-cutoff -16)) diff16)
-	  (<= diff16 (1+ (ash future-cutoff -16))))
-	 "%b %e %H:%M"
-       "%b %e  %Y")
-     time)))
-
-(provide 'ls-lisp)
-
-;;; ls-lisp.el ends here
diff --git a/lisp/macros.el b/lisp/macros.el
deleted file mode 100644
index 6263a6957c2..00000000000
--- a/lisp/macros.el
+++ /dev/null
@@ -1,306 +0,0 @@
-;;; macros.el --- non-primitive commands for keyboard macros.
-
-;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: abbrev
-
-;; 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:
-
-;; Extension commands for keyboard macros.  These permit you to assign
-;; a name to the last-defined keyboard macro, expand and insert the
-;; lisp corresponding to a macro, query the user from within a macro,
-;; or apply a macro to each line in the reason.
-
-;;; Code:
-
-;;;###autoload
-(defun name-last-kbd-macro (symbol)
-  "Assign a name to the last keyboard macro defined.
-Argument SYMBOL is the name to define.
-The symbol's function definition becomes the keyboard macro string.
-Such a \"function\" cannot be called from Lisp, but it is a valid editor command."
-  (interactive "SName for last kbd macro: ")
-  (or last-kbd-macro
-      (error "No keyboard macro defined"))
-  (and (fboundp symbol)
-       (not (stringp (symbol-function symbol)))
-       (not (vectorp (symbol-function symbol)))
-       (error "Function %s is already defined and not a keyboard macro."
-	      symbol))
-  (if (string-equal symbol "")
-      (error "No command name given"))
-  (fset symbol last-kbd-macro))
-
-;;;###autoload
-(defun insert-kbd-macro (macroname &optional keys)
-  "Insert in buffer the definition of kbd macro NAME, as Lisp code.
-Optional second arg KEYS means also record the keys it is on
-\(this is the prefix argument, when calling interactively).
-
-This Lisp code will, when executed, define the kbd macro with the same
-definition it has now.  If you say to record the keys, the Lisp code
-will also rebind those keys to the macro.  Only global key bindings
-are recorded since executing this Lisp code always makes global
-bindings.
-
-To save a kbd macro, visit a file of Lisp code such as your `~/.emacs',
-use this command, and then save the file."
-  (interactive "CInsert kbd macro (name): \nP")
-  (let (definition)
-    (if (string= (symbol-name macroname) "")
-	(progn
-	  (setq macroname 'last-kbd-macro definition last-kbd-macro)
-	  (insert "(setq "))
-      (setq definition (symbol-function macroname))
-      (insert "(fset '"))
-    (prin1 macroname (current-buffer))
-    (insert "\n   ")
-    (if (stringp definition)
-	(let ((beg (point)) end)
-	  (prin1 definition (current-buffer))
-	  (setq end (point-marker))
-	  (goto-char beg)
-	  (while (< (point) end)
-	    (let ((char (following-char)))
-	      (cond ((= char 0)
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\C-@"))
-		    ((< char 27)
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\C-" (+ 96 char)))
-		    ((= char ?\C-\\)
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\C-\\\\"))
-		    ((< char 32)
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\C-" (+ 64 char)))
-		    ((< char 127)
-		     (forward-char 1))
-		    ((= char 127)
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\C-?"))
-		    ((= char 128)
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\M-\\C-@"))
-		    ((= char (aref "\M-\C-\\" 0))
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\M-\\C-\\\\"))
-		    ((< char 155)
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\M-\\C-" (- char 32)))
-		    ((< char 160)
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\M-\\C-" (- char 64)))
-		    ((= char (aref "\M-\\" 0))
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\M-\\\\"))
-		    ((< char 255)
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\M-" (- char 128)))
-		    ((= char 255)
-		     (delete-region (point) (1+ (point)))
-		     (insert "\\M-\\C-?"))))))
-      (if (vectorp definition)
-	  (let ((len (length definition)) (i 0) char mods)
-	    (while (< i len)
-	      (insert (if (zerop i) ?\[ ?\ ))
-	      (setq char (aref definition i)
-		    i (1+ i))
-	      (cond ((not (numberp char))
-		     (prin1 char (current-buffer)))
-		    (t
-		     (insert "?")
-		     (setq mods (event-modifiers char)
-			   char (event-basic-type char))
-		     (while mods
-		       (cond ((eq (car mods) 'control)
-			      (insert "\\C-"))
-			     ((eq (car mods) 'meta)
-			      (insert "\\M-"))
-			     ((eq (car mods) 'hyper)
-			      (insert "\\H-"))
-			     ((eq (car mods) 'super)
-			      (insert "\\s-"))
-			     ((eq (car mods) 'alt)
-			      (insert "\\A-"))
-			     ((and (eq (car mods) 'shift)
-				   (>= char ?a)
-				   (<= char ?z))
-			      (setq char (upcase char)))
-			     ((eq (car mods) 'shift)
-			      (insert "\\S-")))
-		       (setq mods (cdr mods)))
-		     (cond ((= char ?\\)
-			    (insert "\\\\"))
-			   ((= char 127)
-			    (insert "\\C-?"))
-			   ((< char 127)
-			    (insert char))
-			   (t (insert "\\" (format "%o" char)))))))
-	    (insert ?\]))
-	(prin1 definition (current-buffer))))
-    (insert ")\n")
-    (if keys
-	(let ((keys (where-is-internal macroname '(keymap))))
-	  (while keys
-	    (insert "(global-set-key ")
-	    (prin1 (car keys) (current-buffer))
-	    (insert " '")
-	    (prin1 macroname (current-buffer))
-	    (insert ")\n")
-	    (setq keys (cdr keys)))))))
-
-;;;###autoload
-(defun kbd-macro-query (flag)
-  "Query user during kbd macro execution.
-  With prefix argument, enters recursive edit, reading keyboard
-commands even within a kbd macro.  You can give different commands
-each time the macro executes.
-  Without prefix argument, asks whether to continue running the macro.
-Your options are: \\<query-replace-map>
-\\[act]	Finish this iteration normally and continue with the next.
-\\[skip]	Skip the rest of this iteration, and start the next.
-\\[exit]	Stop the macro entirely right now.
-\\[recenter]	Redisplay the screen, then ask again.
-\\[edit]	Enter recursive edit; ask again when you exit from that."
-  (interactive "P")
-  (or executing-kbd-macro
-      defining-kbd-macro
-      (error "Not defining or executing kbd macro"))
-  (if flag
-      (let (executing-kbd-macro defining-kbd-macro)
-	(recursive-edit))
-    (if (not executing-kbd-macro)
-	nil
-      (let ((loop t)
-	    (msg (substitute-command-keys
-		  "Proceed with macro?\\<query-replace-map>\
- (\\[act], \\[skip], \\[exit], \\[recenter], \\[edit]) ")))
-	(while loop
-	  (let ((key (let ((executing-kbd-macro nil)
-			   (defining-kbd-macro nil))
-		       (message "%s" msg)
-		       (read-event)))
-		def)
-	    (setq key (vector key))
-	    (setq def (lookup-key query-replace-map key))
-	    (cond ((eq def 'act)
-		   (setq loop nil))
-		  ((eq def 'skip)
-		   (setq loop nil)
-		   (setq executing-kbd-macro ""))
-		  ((eq def 'exit)
-		   (setq loop nil)
-		   (setq executing-kbd-macro t))
-		  ((eq def 'recenter)
-		   (recenter nil))
-		  ((eq def 'edit)
-		   (let (executing-kbd-macro defining-kbd-macro)
-		     (recursive-edit)))
-		  ((eq def 'quit)
-		   (setq quit-flag t))
-		  (t
-		   (or (eq def 'help)
-		       (ding))
-		   (with-output-to-temp-buffer "*Help*"
-		     (princ
-		      (substitute-command-keys
-		       "Specify how to proceed with keyboard macro execution.
-Possibilities: \\<query-replace-map>
-\\[act]	Finish this iteration normally and continue with the next.
-\\[skip]	Skip the rest of this iteration, and start the next.
-\\[exit]	Stop the macro entirely right now.
-\\[recenter]	Redisplay the screen, then ask again.
-\\[edit]	Enter recursive edit; ask again when you exit from that."))
-		     (save-excursion
-		       (set-buffer standard-output)
-		       (help-mode)))))))))))
-
-;;;###autoload
-(defun apply-macro-to-region-lines (top bottom &optional macro)
-  "For each complete line between point and mark, move to the beginning
-of the line, and run the last keyboard macro.
-
-When called from lisp, this function takes two arguments TOP and
-BOTTOM, describing the current region.  TOP must be before BOTTOM.
-The optional third argument MACRO specifies a keyboard macro to
-execute.
-
-This is useful for quoting or unquoting included text, adding and
-removing comments, or producing tables where the entries are regular.
-
-For example, in Usenet articles, sections of text quoted from another
-author are indented, or have each line start with `>'.  To quote a
-section of text, define a keyboard macro which inserts `>', put point
-and mark at opposite ends of the quoted section, and use
-`\\[apply-macro-to-region-lines]' to mark the entire section.
-
-Suppose you wanted to build a keyword table in C where each entry
-looked like this:
-
-    { \"foo\", foo_data, foo_function }, 
-    { \"bar\", bar_data, bar_function },
-    { \"baz\", baz_data, baz_function },
-
-You could enter the names in this format:
-
-    foo
-    bar
-    baz
-
-and write a macro to massage a word into a table entry:
-
-    \\C-x (
-       \\M-d { \"\\C-y\", \\C-y_data, \\C-y_function },
-    \\C-x )
-
-and then select the region of un-tablified names and use
-`\\[apply-macro-to-region-lines]' to build the table from the names.
-"
-  (interactive "r")
-  (or macro
-      (progn
-	(if (null last-kbd-macro)
-	    (error "No keyboard macro has been defined."))
-	(setq macro last-kbd-macro)))
-  (save-excursion
-    (let ((end-marker (progn
-			(goto-char bottom)
-			(beginning-of-line)
-			(point-marker)))
-	  next-line-marker)
-      (goto-char top)
-      (if (not (bolp))
-	  (forward-line 1))
-      (setq next-line-marker (point-marker))
-      (while (< next-line-marker end-marker)
-	(goto-char next-line-marker)
-	(save-excursion
-	  (forward-line 1)
-	  (set-marker next-line-marker (point)))
-	(save-excursion
-	  (execute-kbd-macro (or macro last-kbd-macro))))
-      (set-marker end-marker nil)
-      (set-marker next-line-marker nil))))
-
-;;;###autoload (define-key ctl-x-map "q" 'kbd-macro-query)
-
-;;; macros.el ends here
diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el
deleted file mode 100644
index dc4c749c31a..00000000000
--- a/lisp/mail/blessmail.el
+++ /dev/null
@@ -1,69 +0,0 @@
-;;; blessmail.el --- Decide whether movemail needs special privileges.
-
-;; Copyright (C) 1994 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 is loaded into a bare Emacs to create the blessmail script,
-;; which (on systems that need it) is used during installation
-;; to give appropriate permissions to movemail.
-;;
-;; It has to be done from lisp in order to be sure of getting the
-;; correct value of rmail-spool-directory.
-
-;;; Code:
-
-;; These are no longer needed because we run this in emacs instead of temacs.
-;; (message "Using load-path %s" load-path)
-;; (load "paths.el")
-;; It is not safe to load site-init.el here, because it might have things in it
-;; that won't load properly unless all the rest of Emacs is loaded.
-
-(let ((dirname (directory-file-name rmail-spool-directory))
-      linkname attr modes)
-  ;; Check for symbolic link
-  (while (setq linkname (file-symlink-p dirname))
-    (setq dirname (if (file-name-absolute-p linkname)
-		      linkname
-		    (concat (file-name-directory dirname) linkname))))
-  (insert "#!/bin/sh\n")
-  (setq attr (file-attributes dirname))
-  (if (not (eq t (car attr)))
-      (insert (format "echo %s is not a directory\n" rmail-spool-directory))
-    (setq modes (nth 8 attr))
-    (cond ((= ?w (aref modes 8))
-	   ;; Nothing needs to be done.
-	   )
-	  ((= ?w (aref modes 5))
-	   (insert "chgrp " (number-to-string (nth 3 attr))
-		   " $* && chmod g+s $*\n"))
-	  ((= ?w (aref modes 2))
-	   (insert "chown " (number-to-string (nth 2 attr))
-		   " $* && chmod u+s $*\n"))
-	  (t
-	   (insert "chown root $* && chmod u+s $*\n"))))
-  (insert "echo mail directory = " dirname "\n"))
-(write-region (point-min) (point-max) "blessmail")
-(kill-emacs)
-
-;;; blessmail.el ends here
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
deleted file mode 100644
index 6efd33ea05a..00000000000
--- a/lisp/mail/emacsbug.el
+++ /dev/null
@@ -1,153 +0,0 @@
-;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list.
-
-;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; Maintainer: FSF
-;; Keywords: maint
-
-;; Not fully installed because it can work only on Internet hosts.
-;; 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:
-
-;; `M-x report-emacs-bug ' starts an email note to the Emacs maintainers
-;; describing a problem.  Here's how it's done...
-
-;;; Code:
-
-;; >> This should be an address which is accessible to your machine,
-;; >> otherwise you can't use this file.  It will only work on the
-;; >> internet with this address.
-
-(require 'sendmail)
-
-(defvar bug-gnu-emacs "bug-gnu-emacs@prep.ai.mit.edu"
-  "Address of mailing list for GNU Emacs bugs.")
-
-(defvar report-emacs-bug-pretest-address "emacs-pretest-bug@gnu.ai.mit.edu"
-  "Address of mailing list for GNU Emacs pretest bugs.")
-
-(defvar report-emacs-bug-orig-text nil
-  "The automatically-created initial text of bug report.")
-
-;;;###autoload
-(defun report-emacs-bug (topic &optional recent-keys)
-  "Report a bug in GNU Emacs.
-Prompts for bug subject.  Leaves you in a mail buffer."
-  ;; This strange form ensures that (recent-keys) is the value before
-  ;; the bug subject string is read.
-  (interactive (reverse (list (recent-keys) (read-string "Bug Subject: "))))
-  (condition-case nil
-      (let (user-point)
-	(compose-mail (if (string-match "\\..*\\..*\\." emacs-version)
-			  ;; If there are four numbers in emacs-version,
-			  ;; this is a pretest version.
-			  report-emacs-bug-pretest-address
-			bug-gnu-emacs)
-		      topic)
-	;; The rest of this does not execute
-	;; if the user was asked to confirm and said no.
-	(goto-char (point-min))
-	(re-search-forward (concat "^" (regexp-quote mail-header-separator) "\n"))
-	(insert "In " (emacs-version) "\n")
-	(if (and system-configuration-options
-		 (not (equal system-configuration-options "")))
-	    (insert "configured using `configure "
-		    system-configuration-options "'\n"))
-	(insert "\n")
-	(insert "Please describe exactly what actions triggered the bug\n"
-		"and the precise symptoms of the bug:\n\n") 
-	(setq user-point (point))
-	(insert "\n\n\n"
-		"Recent input:\n")
-	(let ((before-keys (point)))
-	  (insert (mapconcat (lambda (key)
-			       (if (or (integerp key)
-				       (symbolp key)
-				       (listp key))
-				   (single-key-description key)
-				 (prin1-to-string key nil)))
-			     (or recent-keys (recent-keys))
-			     " "))
-	  (save-restriction
-	    (narrow-to-region before-keys (point))
-	    (goto-char before-keys)
-	    (while (progn (move-to-column 50) (not (eobp)))
-	      (search-forward " " nil t)
-	      (insert "\n"))))
-	(let ((message-buf (get-buffer "*Messages*")))
-	  (if message-buf
-	      (progn
-		(insert "\n\nRecent messages:\n")
-		(insert-buffer-substring message-buf
-					 (save-excursion
-					   (set-buffer message-buf)
-					   (goto-char (point-max))
-					   (forward-line -10)
-					   (point))
-					 (save-excursion
-					   (set-buffer message-buf)
-					   (point-max))))))
-	;; This is so the user has to type something
-	;; in order to send easily.
-	(use-local-map (nconc (make-sparse-keymap) (current-local-map)))
-	(define-key (current-local-map) "\C-c\C-i" 'report-emacs-bug-info)
-	(with-output-to-temp-buffer "*Bug Help*"
-	  (princ (substitute-command-keys
-		  "Type \\[mail-send-and-exit] to send the bug report.\n"))
-	  (princ (substitute-command-keys
-		  "Type \\[kill-buffer] RET to cancel (don't send it).\n"))
-	  (terpri)
-	  (princ (substitute-command-keys
-		  "Type \\[report-emacs-bug-info] to visit in Info the Emacs Manual section
-about when and how to write a bug report,
-and what information to supply so that the bug can be fixed.
-Type SPC to scroll through this section and its subsections.")))
-	;; Make it less likely people will send empty messages.
-	(make-local-variable 'mail-send-hook)
-	(add-hook 'mail-send-hook 'report-emacs-bug-hook)
-	(save-excursion
-	  (goto-char (point-max))
-	  (skip-chars-backward " \t\n")
-	  (make-local-variable 'report-emacs-bug-orig-text)
-	  (setq report-emacs-bug-orig-text (buffer-substring (point-min) (point))))
-	(goto-char user-point))
-    (error nil)))
-
-(defun report-emacs-bug-info ()
-  "Go to the Info node on reporting Emacs bugs."
-  (interactive)
-  (info)
-  (Info-directory)
-  (Info-menu "emacs")
-  (Info-goto-node "Bugs"))
-
-(defun report-emacs-bug-hook ()
-  (save-excursion
-    (goto-char (point-max))
-    (skip-chars-backward " \t\n")
-    (if (and (= (- (point) (point-min))
-		(length report-emacs-bug-orig-text))
-	     (equal (buffer-substring (point-min) (point))
-		    report-emacs-bug-orig-text))
-	(error "No text entered in bug report"))))
-
-(provide 'emacsbug)
-
-;;; emacsbug.el ends here
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
deleted file mode 100644
index 931685c4de1..00000000000
--- a/lisp/mail/mail-extr.el
+++ /dev/null
@@ -1,1987 +0,0 @@
-;;; mail-extr.el --- extract full name and address from RFC 822 mail header.
-
-;; Copyright (C) 1991, 1992, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Joe Wells <jbw@cs.bu.edu>
-;; Maintainer: Jamie Zawinski <jwz@lucid.com>
-;; Version: 1.8
-;; Keywords: mail
-
-;; 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 has been censored by the Communications Decency Act.
-;;; That law was passed under the guise of a ban on pornography, but
-;;; it bans far more than that.  This file did not contain pornography,
-;;; but it was censored nonetheless.
-
-;;; For information on US government censorship of the Internet, and
-;;; what you can do to bring back freedom of the press, see the web
-;;; site http://www.vtw.org/
-
-;; The entry point of this code is
-;;
-;;    mail-extract-address-components: (address)
-;;  
-;;    Given an RFC-822 ADDRESS, extract full name and canonical address.
-;;    Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
-;;    If no name can be extracted, FULL-NAME will be nil.
-;;    ADDRESS may be a string or a buffer.  If it is a buffer, the visible 
-;;     (narrowed) portion of the buffer will be interpreted as the address.
-;;     (This feature exists so that the clever caller might be able to avoid
-;;     consing a string.)
-;;    If ADDRESS contains more than one RFC-822 address, only the first is
-;;     returned.
-;;
-;; This code is more correct (and more heuristic) parser than the code in
-;; rfc822.el.  And despite its size, it's fairly fast.
-;;
-;; There are two main benefits:
-;;
-;; 1. Higher probability of getting the correct full name for a human than
-;;    any other package we know of.  (On the other hand, it will cheerfully
-;;    mangle non-human names/comments.)
-;; 2. Address part is put in a canonical form.
-;;
-;; The interface is not yet carved in stone; please give us suggestions.
-;;
-;; We have an extensive test-case collection of funny addresses if you want to
-;; work with the code.  Developing this code requires frequent testing to
-;; make sure you're not breaking functionality.  The test cases aren't included
-;; because they are over 100K.
-;;
-;; If you find an address that mail-extr fails on, please send it to the 
-;; maintainer along with what you think the correct results should be.  We do
-;; not consider it a bug if mail-extr mangles a comment that does not
-;; correspond to a real human full name, although we would prefer that 
-;; mail-extr would return the comment as-is.
-;;
-;; Features:
-;;
-;; * Full name handling:
-;;
-;;   * knows where full names can be found in an address.
-;;   * avoids using empty comments and quoted text.
-;;   * extracts full names from mailbox names.
-;;   * recognizes common formats for comments after a full name.
-;;   * puts a period and a space after each initial.
-;;   * understands & referring to the mailbox name, capitalized.
-;;   * strips name prefixes like "Prof.", etc.
-;;   * understands what characters can occur in names (not just letters).
-;;   * figures out middle initial from mailbox name.
-;;   * removes funny nicknames.
-;;   * keeps suffixes such as Jr., Sr., III, etc.
-;;   * reorders "Last, First" type names.
-;;
-;; * Address handling:
-;;
-;;   * parses rfc822 quoted text, comments, and domain literals.
-;;   * parses rfc822 multi-line headers.
-;;   * does something reasonable with rfc822 GROUP addresses.
-;;   * handles many rfc822 noncompliant and garbage addresses.
-;;   * canonicalizes addresses (after stripping comments/phrases outside <>).
-;;     * converts ! addresses into .UUCP and %-style addresses.
-;;     * converts rfc822 ROUTE addresses to %-style addresses.
-;;     * truncates %-style addresses at leftmost fully qualified domain name.
-;;     * handles local relative precedence of ! vs. % and @ (untested).
-;;
-;; It does almost no string creation.  It primarily uses the built-in
-;; parsing routines with the appropriate syntax tables.  This should
-;; result in greater speed.
-;;
-;; TODO:
-;;
-;; * handle all test cases.  (This will take forever.)
-;; * software to pick the correct header to use (eg., "Senders-Name:").
-;; * multiple addresses in the "From:" header (almost all of the necessary
-;;   code is there).
-;; * flag to not treat `,' as an address separator.  (This is useful when
-;;   there is a "From:" header but no "Sender:" header, because then there
-;;   is only allowed to be one address.)
-;; * mailbox name does not necessarily contain full name.
-;; * fixing capitalization when it's all upper or lowercase.  (Hard!)
-;; * some of the domain literal handling is missing.  (But I've never even
-;;   seen one of these in a mail address, so maybe no big deal.)
-;; * arrange to have syntax tables byte-compiled.
-;; * speed hacks.
-;; * delete unused variables.
-;; * arrange for testing with different relative precedences of ! vs. @
-;;   and %.
-;; * insert documentation strings!
-;; * handle X.400-gatewayed addresses according to RFC 1148.
-
-;;; Change Log: 
-;; 
-;; Thu Feb 17 17:57:33 1994  Jamie Zawinski (jwz@lucid.com)
-;;
-;;	* merged with jbw's latest version
-;;
-;; Wed Feb  9 21:56:27 1994  Jamie Zawinski (jwz@lucid.com)
-;;
-;;      * high-bit chars in comments weren't treated as word syntax
-;;
-;; Sat Feb  5 03:13:40 1994  Jamie Zawinski (jwz@lucid.com)
-;;
-;;      * call replace-match with fixed-case arg
-;;
-;; Thu Dec 16 21:56:45 1993  Jamie Zawinski (jwz@lucid.com)
-;;
-;;      * some more cleanup, doc, added provide
-;;
-;; Tue Mar 23 21:23:18 1993  Joe Wells  (jbw at csd.bu.edu)
-;; 
-;; 	* Made mail-full-name-prefixes a user-customizable variable.
-;;        Allow passing the address as a buffer as well as as a string.
-;;        Allow [ and ] as name characters (Finnish character set).
-;; 
-;; Mon Mar 22 21:20:56 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;; 
-;; 	* Handle "null" addresses.  Handle = used for spacing in mailbox
-;; 	  name.  Fix bug in handling of ROUTE-ADDR-type addresses that are
-;; 	  missing their brackets.  Handle uppercase "JR".  Extract full
-;; 	  names from X.400 addresses encoded in RFC-822.  Fix bug in
-;;        handling of multiple addresses where first has trailing comment.
-;;        Handle more kinds of telephone extension lead-ins.
-;; 
-;; Mon Mar 22 20:16:57 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;; 
-;; 	* Handle HZ encoding for embedding GB encoded chinese characters.
-;; 
-;; Mon Mar 22 00:46:12 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;; 
-;; 	* Fixed too broad matching of ham radio call signs.  Fixed bug in
-;; 	  handling an unmatched ' in a name string.  Enhanced recognition
-;; 	  of when . in the mailbox name terminates the name portion.
-;; 	  Narrowed conversion of . to space to only the necessary
-;; 	  situation.  Deal with VMS's stupid date stamps.  Handle a unique
-;; 	  way of introducing an alternate address.  Fixed spacing bug I
-;; 	  introduced in switching last name order.  Fixed bug in handling
-;; 	  address with ! and % but no @.  Narrowed the cases in which
-;; 	  certain trailing words are discarded.
-;; 
-;; Sun Mar 21 21:41:06 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;; 
-;; 	* Fixed bugs in handling GROUP addresses.  Certain words in the
-;; 	  middle of a name no longer terminate it.  Handle LISTSERV list
-;;        names.  Ignore comment field containing mailbox name.
-;; 
-;; Sun Mar 21 14:39:38 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;; 
-;; 	* Moved variant-method code back into main function.  Handle
-;; 	underscores as spaces in comments.  Handle leading nickname.  Add
-;; 	flag to ignore single-word names.  Other changes.
-;; 
-;; Mon Feb  1 22:23:31 1993  Joe Wells  (jbw at bigbird.bu.edu)
-;; 
-;; 	* Added in changes by Rod Whitby and Jamie Zawinski.  This
-;;        includes the flag mail-extr-guess-middle-initial and the fix for
-;;        handling multiple addresses correctly.  (Whitby just changed
-;;	  a > to a <.)
-;; 
-;; Mon Apr  6 23:59:09 1992  Joe Wells  (jbw at bigbird.bu.edu)
-;; 
-;; 	* Cleaned up some more.  Release version 1.0 to world.
-;; 
-;; Sun Apr  5 19:39:08 1992  Joe Wells  (jbw at bigbird.bu.edu)
-;; 
-;; 	* Cleaned up full name extraction extensively.
-;; 
-;; Sun Feb  2 14:45:24 1992  Joe Wells  (jbw at bigbird.bu.edu)
-;; 
-;; 	* Total rewrite.  Integrated mail-canonicalize-address into
-;; 	mail-extract-address-components.  Now handles GROUP addresses more
-;; 	or less correctly.  Better handling of lots of different cases.
-;; 
-;; Fri Jun 14 19:39:50 1991
-;;	* Created.
-
-;;; Code:
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; User configuration variable definitions.
-;;
-
-(defvar mail-extr-guess-middle-initial nil
-  "*Whether to try to guess middle initial from mail address.
-If true, then when we see an address like \"John Smith <jqs@host.com>\"
-we will assume that \"John Q. Smith\" is the fellow's name.")
-
-(defvar mail-extr-ignore-single-names t
-  "*Whether to ignore a name that is just a single word.
-If true, then when we see an address like \"Idiot <dumb@stupid.com>\"
-we will act as though we couldn't find a full name in the address.")
-
-;; Matches a leading title that is not part of the name (does not
-;; contribute to uniquely identifying the person).
-(defvar mail-extr-full-name-prefixes
-  (purecopy
-   "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]")
-  "*Matches prefixes to the full name that identify a person's position.
-These are stripped from the full name because they do not contribute to
-uniquely identifying the person.")
-
-(defvar mail-extr-@-binds-tighter-than-! nil
-  "*Whether the local mail transport agent looks at ! before @.")
-
-(defvar mail-extr-mangle-uucp nil
-  "*Whether to throw away information in UUCP addresses
-by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\".")
-
-;;----------------------------------------------------------------------
-;; what orderings are meaningful?????
-;;(defvar mail-operator-precedence-list '(?! ?% ?@))
-;; Right operand of a % or a @ must be a domain name, period.  No other
-;; operators allowed.  Left operand of a @ is an address relative to that
-;; site.
-
-;; Left operand of a ! must be a domain name.  Right operand is an
-;; arbitrary address.
-;;----------------------------------------------------------------------
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Constant definitions.
-;;
-
-;;           Codes in
-;; Names in  ISO 8859-1 Name
-;; ISO 10XXX ISO 8859-2 in
-;; ISO 6937  ISO 10646  RFC            Swedish
-;; etc.      Hex Oct    1345 TeX Split ASCII Description
-;; --------- ---------- ---- --- ----- ----- -------------------------------
-;; %a        E4  344    a:   \"a ae    {     latin small   a + diaeresis   d
-;; %o        F6  366    o:   \"o oe    |     latin small   o + diaeresis   v
-;; @a        E5  345    aa   \oa aa    }     latin small   a + ring above  e
-;; %u        FC  374    u:   \"u ue    ~     latin small   u + diaeresis   |
-;; /e        E9  351    e'   \'e       `     latin small   e + acute       i
-;; %A        C4  304    A:   \"A AE    [     latin capital a + diaeresis   D
-;; %O        D6  326    O:   \"O OE    \     latin capital o + diaeresis   V
-;; @A        C5  305    AA   \oA AA    ]     latin capital a + ring above  E
-;; %U        DC  334    U:   \"U UE    ^     latin capital u + diaeresis   \
-;; /E        C9  311    E'   \'E       @     latin capital e + acute       I
-
-;; NOTE: @a and @A are not in ISO 8859-2 (the codes mentioned above invoke
-;; /l and /L).  Some of this data was retrieved from
-;; listserv@jhuvm.hcf.jhu.edu.
-
-;; Any character that can occur in a name, not counting characters that
-;; separate parts of a multipart name (hyphen and period).
-;; Yes, there are weird people with digits in their names.
-;; You will also notice the consideration for the
-;; Swedish/Finnish/Norwegian character set.
-(defconst mail-extr-all-letters-but-separators
-  (purecopy "][A-Za-z{|}'~0-9`\200-\377"))
-
-;; Any character that can occur in a name in an RFC822 address including
-;; the separator (hyphen and possibly period) for multipart names.
-;; #### should . be in here?
-(defconst mail-extr-all-letters
-  (purecopy (concat mail-extr-all-letters-but-separators "---")))
-
-;; Any character that can start a name.
-;; Keep this set as minimal as possible.
-(defconst mail-extr-first-letters (purecopy "A-Za-z\200-\377"))
-
-;; Any character that can end a name.
-;; Keep this set as minimal as possible.
-(defconst mail-extr-last-letters (purecopy "A-Za-z\200-\377`'."))
-
-(defconst mail-extr-leading-garbage
-  (purecopy (format "[^%s]+" mail-extr-first-letters)))
-
-;; (defconst mail-extr-non-name-chars 
-;;   (purecopy (concat "^" mail-extr-all-letters ".")))
-;; (defconst mail-extr-non-begin-name-chars
-;;   (purecopy (concat "^" mail-extr-first-letters)))
-;; (defconst mail-extr-non-end-name-chars
-;;   (purecopy (concat "^" mail-extr-last-letters)))
-
-;; Matches an initial not followed by both a period and a space. 
-;; (defconst mail-extr-bad-initials-pattern
-;;   (purecopy 
-;;    (format "\\(\\([^%s]\\|\\`\\)[%s]\\)\\(\\.\\([^ ]\\)\\| \\|\\([^%s .]\\)\\|\\'\\)"
-;;            mail-extr-all-letters mail-extr-first-letters mail-extr-all-letters)))
-
-;; Matches periods used instead of spaces.  Must not match the period
-;; following an initial.
-(defconst mail-extr-bad-dot-pattern
-  (purecopy
-   (format "\\([%s][%s]\\)\\.+\\([%s]\\)"
-	   mail-extr-all-letters
-	   mail-extr-last-letters
-	   mail-extr-first-letters)))
-
-;; Matches an embedded or leading nickname that should be removed.
-;; (defconst mail-extr-nickname-pattern
-;;   (purecopy
-;;    (format "\\([ .]\\|\\`\\)[\"'`\[\(]\\([ .%s]+\\)[\]\"'\)] "
-;;            mail-extr-all-letters)))
-
-;; Matches the occurrence of a generational name suffix, and the last
-;; character of the preceding name.  This is important because we want to
-;; keep such suffixes: they help to uniquely identify the person.
-;; *** Perhaps this should be a user-customizable variable.  However, the
-;; *** regular expression is fairly tricky to alter, so maybe not.
-(defconst mail-extr-full-name-suffix-pattern
-  (purecopy
-   (format
-    "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)"
-    mail-extr-all-letters mail-extr-all-letters)))
-
-(defconst mail-extr-roman-numeral-pattern (purecopy "V?I+V?\\b"))
-
-;; Matches a trailing uppercase (with other characters possible) acronym.
-;; Must not match a trailing uppercase last name or trailing initial
-(defconst mail-extr-weird-acronym-pattern
-  (purecopy "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)"))
-      
-;; Matches a mixed-case or lowercase name (not an initial).
-;; #### Match Latin1 lower case letters here too?
-;; (defconst mail-extr-mixed-case-name-pattern
-;;   (purecopy
-;;    (format
-;;     "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)"
-;;     mail-extr-all-letters mail-extr-last-letters
-;;     mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters
-;;     mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters)))
-
-;; Matches a trailing alternative address.
-;; #### Match Latin1 letters here too?
-;; #### Match _ before @ here too?  
-(defconst mail-extr-alternative-address-pattern
-  (purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]"))
-
-;; Matches a variety of trailing comments not including comma-delimited
-;; comments.
-(defconst mail-extr-trailing-comment-start-pattern
-  (purecopy " [-{]\\|--\\|[+@#></\;]"))
-
-;; Matches a name (not an initial).
-;; This doesn't force a word boundary at the end because sometimes a
-;; comment is separated by a `-' with no preceding space.
-(defconst mail-extr-name-pattern
-  (purecopy (format "\\b[%s][%s]*[%s]"
-		    mail-extr-first-letters
-		    mail-extr-all-letters
-		    mail-extr-last-letters)))
-
-(defconst mail-extr-initial-pattern
-  (purecopy (format "\\b[%s]\\([. ]\\|\\b\\)" mail-extr-first-letters)))
-
-;; Matches a single name before a comma.
-;; (defconst mail-extr-last-name-first-pattern
-;;   (purecopy (concat "\\`" mail-extr-name-pattern ",")))
-
-;; Matches telephone extensions.
-(defconst mail-extr-telephone-extension-pattern
-  (purecopy
-   "\\(\\([Ee]xt\\|\\|[Tt]ph\\|[Tt]el\\|[Xx]\\).?\\)? *\\+?[0-9][- 0-9]+"))
-
-;; Matches ham radio call signs.
-;; Help from: Mat Maessen N2NJZ <maessm@rpi.edu>, Mark Feit
-;; <mark@era.com>, Michael Covington <mcovingt@ai.uga.edu>.
-;; Examples: DX504 DX515 K5MRU K8DHK KA9WGN KA9WGN KD3FU KD6EUI KD6HBW
-;; KE9TV KF0NV N1API N3FU N3GZE N3IGS N4KCC N7IKQ N9HHU W4YHF W6ANK WA2SUH
-;; WB7VZI N2NJZ NR3G KJ4KK AB4UM AL7NI KH6OH WN3KBT N4TMI W1A N0NZO
-(defconst mail-extr-ham-call-sign-pattern
-  (purecopy "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)"))
-
-;; Possible trailing suffixes: "\\(/\\(KT\\|A[AEG]\\|[R0-9]\\)\\)?"
-;; /KT == Temporary Technician (has CSC but not "real" license)
-;; /AA == Temporary Advanced
-;; /AE == Temporary Extra
-;; /AG == Temporary General
-;; /R  == repeater
-;; /#  == stations operating out of home district
-;; I don't include these in the regexp above because I can't imagine
-;; anyone putting them with their name in an e-mail address.
-
-;; Matches normal single-part name
-(defconst mail-extr-normal-name-pattern
-  (purecopy (format "\\b[%s][%s]+[%s]"
-		    mail-extr-first-letters
-		    mail-extr-all-letters-but-separators
-		    mail-extr-last-letters)))
-
-;; Matches a single word name.
-;; (defconst mail-extr-one-name-pattern
-;;   (purecopy (concat "\\`" mail-extr-normal-name-pattern "\\'")))
-  
-;; Matches normal two names with missing middle initial
-;; The first name is not allowed to have a hyphen because this can cause
-;; false matches where the "middle initial" is actually the first letter
-;; of the second part of the first name.
-(defconst mail-extr-two-name-pattern
-  (purecopy
-   (concat "\\`\\(" mail-extr-normal-name-pattern
-	   "\\|" mail-extr-initial-pattern
-	   "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)")))
-
-(defconst mail-extr-listserv-list-name-pattern
-  (purecopy "Multiple recipients of list \\([-A-Z]+\\)"))
-
-(defconst mail-extr-stupid-vms-date-stamp-pattern
-  (purecopy
-   "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *"))
-
-;;; HZ -- GB (PRC Chinese character encoding) in ASCII embedding protocol
-;;
-;; In ASCII mode, a byte is interpreted as an ASCII character, unless a '~' is
-;; encountered. The character '~' is an escape character. By convention, it
-;; must be immediately followed ONLY by '~', '{' or '\n' (<LF>), with the
-;; following special meaning.
-;; 
-;; o The escape sequence '~~' is interpreted as a '~'.
-;; o The escape-to-GB sequence '~{' switches the mode from ASCII to GB.
-;; o The escape sequence '~\n' is a line-continuation marker to be consumed
-;;   with no output produced.
-;; 
-;; In GB mode, characters are interpreted two bytes at a time as (pure) GB
-;; codes until the escape-from-GB code '~}' is read. This code switches the
-;; mode from GB back to ASCII.  (Note that the escape-from-GB code '~}'
-;; ($7E7D) is outside the defined GB range.)
-(defconst mail-extr-hz-embedded-gb-encoded-chinese-pattern
-  (purecopy "~{\\([^~].\\|~[^\}]\\)+~}"))
-
-;; The leading optional lowercase letters are for a bastardized version of
-;; the encoding, as is the optional nature of the final slash.
-(defconst mail-extr-x400-encoded-address-pattern
-  (purecopy "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'"))
-
-(defconst mail-extr-x400-encoded-address-field-pattern-format
-  (purecopy "/%s=\\([^/]+\\)\\(/\\|\\'\\)"))
-
-(defconst mail-extr-x400-encoded-address-surname-pattern
-  ;; S stands for Surname (family name).
-  (purecopy
-   (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]")))
-
-(defconst mail-extr-x400-encoded-address-given-name-pattern
-  ;; G stands for Given name.
-  (purecopy
-   (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]")))
-
-(defconst mail-extr-x400-encoded-address-full-name-pattern
-  ;; PN stands for Personal Name.  When used it represents the combination
-  ;; of the G and S fields.
-  ;; "The one system I used having this field asked it with the prompt
-  ;; `Personal Name'.  But they mapped it into G and S on outgoing real
-  ;; X.400 addresses.  As they mapped G and S into PN on incoming..."
-  (purecopy
-   (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]")))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Syntax tables used for quick parsing.
-;;
-
-(defconst mail-extr-address-syntax-table (make-syntax-table))
-(defconst mail-extr-address-comment-syntax-table (make-syntax-table))
-(defconst mail-extr-address-domain-literal-syntax-table (make-syntax-table))
-(defconst mail-extr-address-text-comment-syntax-table (make-syntax-table))
-(defconst mail-extr-address-text-syntax-table (make-syntax-table))
-(mapcar
- (function
-  (lambda (pair)
-    (let ((syntax-table (symbol-value (car pair))))
-      (mapcar
-       (function
-	(lambda (item)
-	  (if (eq 2 (length item))
-	      ;; modifying syntax of a single character
-	      (modify-syntax-entry (car item) (car (cdr item)) syntax-table)
-	    ;; modifying syntax of a range of characters
-	    (let ((char (nth 0 item))
-		  (bound (nth 1 item))
-		  (syntax (nth 2 item)))
-	      (while (<= char bound)
-		(modify-syntax-entry char syntax syntax-table)
-		(setq char (1+ char)))))))
-       (cdr pair)))))
- '((mail-extr-address-syntax-table
-    (?\000 ?\037 "w")			;control characters
-    (?\040	 " ")			;SPC
-    (?! ?~	 "w")			;printable characters
-    (?\177	 "w")			;DEL
-    (?\200 ?\377 "w")			;high-bit-on characters
-    (?\240	 " ")			;nobreakspace
-    (?\t " ")
-    (?\r " ")
-    (?\n " ")
-    (?\( ".")
-    (?\) ".")
-    (?<  ".")
-    (?>  ".")
-    (?@  ".")
-    (?,  ".")
-    (?\; ".")
-    (?:  ".")
-    (?\\ "\\")
-    (?\" "\"")
-    (?.  ".")
-    (?\[ ".")
-    (?\] ".")
-    ;; % and ! aren't RFC822 characters, but it is convenient to pretend
-    (?%  ".")
-    (?!  ".") ;; this needs to be word-constituent when not in .UUCP mode
-    )
-   (mail-extr-address-comment-syntax-table
-    (?\000 ?\377 "w")
-    (?\040 " ")
-    (?\240 " ")
-    (?\t " ")
-    (?\r " ")
-    (?\n " ")
-    (?\( "\(\)")
-    (?\) "\)\(")
-    (?\\ "\\"))
-   (mail-extr-address-domain-literal-syntax-table
-    (?\000 ?\377 "w")
-    (?\040 " ")
-    (?\240 " ")
-    (?\t " ")
-    (?\r " ")
-    (?\n " ")
-    (?\[ "\(\]")			;??????
-    (?\] "\)\[")			;??????
-    (?\\ "\\"))
-   (mail-extr-address-text-comment-syntax-table
-    (?\000 ?\377 "w")
-    (?\040 " ")
-    (?\240 " ")
-    (?\t " ")
-    (?\r " ")
-    (?\n " ")
-    (?\( "\(\)")
-    (?\) "\)\(")
-    (?\[ "\(\]")
-    (?\] "\)\[")
-    (?\{ "\(\}")
-    (?\} "\)\{")
-    (?\\ "\\")
-    (?\" "\"")
-    ;; (?\' "\)\`")
-    ;; (?\` "\(\'")
-    )
-   (mail-extr-address-text-syntax-table
-    (?\000 ?\177 ".")
-    (?\200 ?\377 "w")
-    (?\040 " ")
-    (?\t " ")
-    (?\r " ")
-    (?\n " ")
-    (?A ?Z "w")
-    (?a ?z "w")
-    (?-    "w")
-    (?\}   "w")
-    (?\{   "w")
-    (?|    "w")
-    (?\'   "w")
-    (?~    "w")
-    (?0 ?9 "w"))
-   ))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Utility functions and macros.
-;;
-
-(defmacro mail-extr-delete-char (n)
-  ;; in v19, delete-char is compiled as a function call, but delete-region
-  ;; is byte-coded, so it's much much faster.
-  (list 'delete-region '(point) (list '+ '(point) n)))
-
-(defmacro mail-extr-skip-whitespace-forward ()
-  ;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.
-  '(skip-chars-forward " \t\n\r\240"))
-
-(defmacro mail-extr-skip-whitespace-backward ()
-  ;; v19 fn skip-syntax-backward is more tasteful, but not byte-coded.
-  '(skip-chars-backward " \t\n\r\240"))
-
-
-(defmacro mail-extr-undo-backslash-quoting (beg end)
-  (`(save-excursion
-      (save-restriction
-	(narrow-to-region (, beg) (, end))
-	(goto-char (point-min))
-	;; undo \ quoting
-	(while (search-forward "\\" nil t)
-	  (mail-extr-delete-char -1)
-	  (or (eobp)
-	      (forward-char 1))
-	  )))))
-
-(defmacro mail-extr-nuke-char-at (pos)
-  (` (save-excursion
-       (goto-char (, pos))
-       (mail-extr-delete-char 1)
-       (insert ?\ ))))
-
-(put 'mail-extr-nuke-outside-range
-     'edebug-form-spec '(symbolp &optional form form atom))
-
-(defmacro mail-extr-nuke-outside-range (list-symbol
-					beg-symbol end-symbol
-					&optional no-replace)
-  ;; LIST-SYMBOL names a variable holding a list of buffer positions
-  ;; BEG-SYMBOL and END-SYMBOL name variables delimiting a range
-  ;; Each element of LIST-SYMBOL which lies outside of the range is
-  ;;  deleted from the list.
-  ;; Unless NO-REPLACE is true, at each of the positions in LIST-SYMBOL
-  ;;  which lie outside of the range, one character at that position is
-  ;;  replaced with a SPC.
-  (or (memq no-replace '(t nil))
-      (error "no-replace must be t or nil, evaluable at macroexpand-time"))
-  (` (let ((temp (, list-symbol))
-	   ch)
-       (while temp
-	 (setq ch (car temp))
-	 (cond ((or (> ch (, end-symbol))
-		    (< ch (, beg-symbol)))
-		(,@ (if no-replace
-			nil
-		      (` ((mail-extr-nuke-char-at ch)))))
-		(setcar temp nil)))
-	 (setq temp (cdr temp)))
-       (setq (, list-symbol) (delq nil (, list-symbol))))))
-
-(defun mail-extr-demarkerize (marker)
-  ;; if arg is a marker, destroys the marker, then returns the old value.
-  ;; otherwise returns the arg.
-  (if (markerp marker)
-      (let ((temp (marker-position marker)))
-	(set-marker marker nil)
-	temp)
-    marker))
-
-(defun mail-extr-markerize (pos)
-  ;; coerces pos to a marker if non-nil.
-  (if (or (markerp pos) (null pos))
-      pos
-    (copy-marker pos)))
-
-(defmacro mail-extr-last (list)
-  ;; Returns last element of LIST.
-  ;; Could be a subst.
-  (` (let ((list (, list)))
-       (while (not (null (cdr list)))
-	 (setq list (cdr list)))
-       (car list))))
-  
-(defmacro mail-extr-safe-move-sexp (arg)
-  ;; Safely skip over one balanced sexp, if there is one.  Return t if success.
-  (` (condition-case error
-	 (progn
-	   (goto-char (or (scan-sexps (point) (, arg)) (point)))
-	   t)
-       (error
-	;; #### kludge kludge kludge kludge kludge kludge kludge !!!
-	(if (string-equal (nth 1 error) "Unbalanced parentheses")
-	    nil
-	  (while t
-	    (signal (car error) (cdr error))))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; The main function to grind addresses
-;;
-
-(defvar disable-initial-guessing-flag)	; dynamic assignment
-(defvar cbeg)				; dynamic assignment
-(defvar cend)				; dynamic assignment
-
-;;;###autoload
-(defun mail-extract-address-components (address)
-  "Given an RFC-822 ADDRESS, extract full name and canonical address.
-Returns a list of the form (FULL-NAME CANONICAL-ADDRESS).
-If no name can be extracted, FULL-NAME will be nil.
-ADDRESS may be a string or a buffer.  If it is a buffer, the visible 
- (narrowed) portion of the buffer will be interpreted as the address.
- (This feature exists so that the clever caller might be able to avoid
- consing a string.)
-If ADDRESS contains more than one RFC-822 address, only the first is
- returned.  Some day this function may be extended to extract multiple
- addresses, or perhaps return the position at which parsing stopped."
-  (let ((canonicalization-buffer (get-buffer-create " *canonical address*"))
-	(extraction-buffer (get-buffer-create " *extract address components*"))
-	char
-;;	multiple-addresses
-	<-pos >-pos @-pos :-pos comma-pos !-pos %-pos \;-pos
-	group-:-pos group-\;-pos route-addr-:-pos
-	record-pos-symbol
-	first-real-pos last-real-pos
-	phrase-beg phrase-end
-	cbeg cend			; dynamically set from -voodoo
-	quote-beg quote-end
-	atom-beg atom-end
-	mbox-beg mbox-end
-	\.-ends-name
-	temp
-;;	name-suffix
-	fi mi li			; first, middle, last initial
-	saved-%-pos saved-!-pos saved-@-pos
-	domain-pos \.-pos insert-point
-;;	mailbox-name-processed-flag
-	disable-initial-guessing-flag	; dynamically set from -voodoo
-	)
-    
-    (save-excursion
-      (set-buffer extraction-buffer)
-      (fundamental-mode)
-      (kill-all-local-variables)
-      (buffer-disable-undo extraction-buffer)
-      (set-syntax-table mail-extr-address-syntax-table)
-      (widen)
-      (erase-buffer)
-      (setq case-fold-search nil)
-      
-      ;; Insert extra space at beginning to allow later replacement with <
-      ;; without having to move markers.
-      (insert ?\ )
-
-      ;; Insert the address itself.
-      (cond ((stringp address)
-	     (insert address))
-	    ((bufferp address)
-	     (insert-buffer-substring address))
-	    (t
-	     (error "Invalid address: %s" address)))
-
-      (set-text-properties (point-min) (point-max) nil)
-      
-      ;; stolen from rfc822.el
-      ;; Unfold multiple lines.
-      (goto-char (point-min))
-      (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t)
-	(replace-match "\\1 " t))
-      
-      ;; first pass grabs useful information about address
-      (goto-char (point-min))
-      (while (progn
-	       (mail-extr-skip-whitespace-forward)
-	       (not (eobp)))
-	(setq char (char-after (point)))
-	(or first-real-pos
-	    (if (not (eq char ?\())
-		(setq first-real-pos (point))))
-	(cond
-	 ;; comment
-	 ((eq char ?\()
-	  (set-syntax-table mail-extr-address-comment-syntax-table)
-	  ;; only record the first non-empty comment's position
-	  (if (and (not cbeg)
-		   (save-excursion
-		     (forward-char 1)
-		     (mail-extr-skip-whitespace-forward)
-		     (not (eq ?\) (char-after (point))))))
-	      (setq cbeg (point)))
-	  ;; TODO: don't record if unbalanced
-	  (or (mail-extr-safe-move-sexp 1)
-	      (forward-char 1))
-	  (set-syntax-table mail-extr-address-syntax-table)
-	  (if (and cbeg
-		   (not cend))
-	      (setq cend (point))))
-	 ;; quoted text
-	 ((eq char ?\")
-	  ;; only record the first non-empty quote's position
-	  (if (and (not quote-beg)
-		   (save-excursion
-		     (forward-char 1)
-		     (mail-extr-skip-whitespace-forward)
-		     (not (eq ?\" (char-after (point))))))
-	      (setq quote-beg (point)))
-	  ;; TODO: don't record if unbalanced
-	  (or (mail-extr-safe-move-sexp 1)
-	      (forward-char 1))
-	  (if (and quote-beg
-		   (not quote-end))
-	      (setq quote-end (point))))
-	 ;; domain literals
-	 ((eq char ?\[)
-	  (set-syntax-table mail-extr-address-domain-literal-syntax-table)
-	  (or (mail-extr-safe-move-sexp 1)
-	      (forward-char 1))
-	  (set-syntax-table mail-extr-address-syntax-table))
-	 ;; commas delimit addresses when outside < > pairs.
-	 ((and (eq char ?,)
-	       (or (and (null <-pos)
-			;; Handle ROUTE-ADDR address that is missing its <.
-			(not (eq ?@ (char-after (1+ (point))))))
-		   (and >-pos
-			;; handle weird munged addresses
-			;; BUG FIX: This test was reversed.  Thanks to the
-			;; brilliant Rod Whitby <rwhitby@research.canon.oz.au>
-			;; for discovering this!
-			(< (mail-extr-last <-pos) (car >-pos)))))
-;; It'd be great if some day this worked, but for now, punt.
-;;	  (setq multiple-addresses t)
-;;	  ;; *** Why do I want this:
-;;	  (mail-extr-delete-char 1)
-;;	  (narrow-to-region (point-min) (point))
-	  (delete-region (point) (point-max))
-	  (setq char ?\() ; HAVE I NO SHAME??
-	  )
-	 ;; record the position of various interesting chars, determine
-	 ;; legality later.
-	 ((setq record-pos-symbol
-		(cdr (assq char
-			   '((?< . <-pos) (?> . >-pos) (?@ . @-pos)
-			     (?: . :-pos) (?, . comma-pos) (?! . !-pos)
-			     (?% . %-pos) (?\; . \;-pos)))))
-	  (set record-pos-symbol
-	       (cons (point) (symbol-value record-pos-symbol)))
-	  (forward-char 1))
-	 ((eq char ?.)
-	  (forward-char 1))
-	 ((memq char '(
-		       ;; comment terminator illegal
-		       ?\)
-		       ;; domain literal terminator illegal
-		       ?\]
-		       ;; \ allowed only within quoted strings,
-		       ;; domain literals, and comments
-		       ?\\
-		       ))
-	  (mail-extr-nuke-char-at (point))
-	  (forward-char 1))
-	 (t
-	  (forward-word 1)))
-	(or (eq char ?\()
-	    ;; At the end of first address of a multiple address header.
-	    (and (eq char ?,)
-		 (eobp))
-	    (setq last-real-pos (point))))
-      
-      ;; Use only the leftmost <, if any.  Replace all others with spaces.
-      (while (cdr <-pos)
-	(mail-extr-nuke-char-at (car <-pos))
-	(setq <-pos (cdr <-pos)))
-      
-      ;; Use only the rightmost >, if any.  Replace all others with spaces.
-      (while (cdr >-pos)
-	(mail-extr-nuke-char-at (nth 1 >-pos))
-	(setcdr >-pos (nthcdr 2 >-pos)))
-      
-      ;; If multiple @s and a :, but no < and >, insert around buffer.
-      ;; Example: @foo.bar.dom,@xxx.yyy.zzz:mailbox@aaa.bbb.ccc
-      ;; This commonly happens on the UUCP "From " line.  Ugh.
-      (cond ((and (> (length @-pos) 1)
-		  (eq 1 (length :-pos))	;TODO: check if between last two @s
-		  (not \;-pos)
-		  (not <-pos))
-	     (goto-char (point-min))
-	     (mail-extr-delete-char 1)
-	     (setq <-pos (list (point)))
-	     (insert ?<)))
-      
-      ;; If < but no >, insert > in rightmost possible position
-      (cond ((and <-pos
-		  (null >-pos))
-	     (goto-char (point-max))
-	     (setq >-pos (list (point)))
-	     (insert ?>)))
-      
-      ;; If > but no <, replace > with space.
-      (cond ((and >-pos
-		  (null <-pos))
-	     (mail-extr-nuke-char-at (car >-pos))
-	     (setq >-pos nil)))
-
-      ;; Turn >-pos and <-pos into non-lists
-      (setq >-pos (car >-pos)
-	    <-pos (car <-pos))
-      
-      ;; Trim other punctuation lists of items outside < > pair to handle
-      ;; stupid MTAs.
-      (cond (<-pos			; don't need to check >-pos also
-	     ;; handle bozo software that violates RFC 822 by sticking
-	     ;; punctuation marks outside of a < > pair
-	     (mail-extr-nuke-outside-range @-pos <-pos >-pos t)
-	     ;; RFC 822 says nothing about these two outside < >, but
-	     ;; remove those positions from the lists to make things
-	     ;; easier.
-	     (mail-extr-nuke-outside-range !-pos <-pos >-pos t)
-	     (mail-extr-nuke-outside-range %-pos <-pos >-pos t)))
-      
-      ;; Check for : that indicates GROUP list and for : part of
-      ;; ROUTE-ADDR spec.
-      ;; Can't possibly be more than two :.  Nuke any extra.
-      (while :-pos
-	(setq temp (car :-pos)
-	      :-pos (cdr :-pos))
-	(cond ((and <-pos >-pos
-		    (> temp <-pos)
-		    (< temp >-pos))
-	       (if (or route-addr-:-pos
-		       (< (length @-pos) 2)
-		       (> temp (car @-pos))
-		       (< temp (nth 1 @-pos)))
-		   (mail-extr-nuke-char-at temp)
-		 (setq route-addr-:-pos temp)))
-	      ((or (not <-pos)
-		   (and <-pos
-			(< temp <-pos)))
-	       (setq group-:-pos temp))))
-      
-      ;; Nuke any ; that is in or to the left of a < > pair or to the left
-      ;; of a GROUP starting :.  Also, there may only be one ;.
-      (while \;-pos
-	(setq temp (car \;-pos)
-	      \;-pos (cdr \;-pos))
-	(cond ((and <-pos >-pos
-		    (> temp <-pos)
-		    (< temp >-pos))
-	       (mail-extr-nuke-char-at temp))
-	      ((and (or (not group-:-pos)
-			(> temp group-:-pos))
-		    (not group-\;-pos))
-	       (setq group-\;-pos temp))))
-      
-      ;; Nuke unmatched GROUP syntax characters.
-      (cond ((and group-:-pos (not group-\;-pos))
-	     ;; *** Do I really need to erase it?
-	     (mail-extr-nuke-char-at group-:-pos)
-	     (setq group-:-pos nil)))
-      (cond ((and group-\;-pos (not group-:-pos))
-	     ;; *** Do I really need to erase it?
-	     (mail-extr-nuke-char-at group-\;-pos)
-	     (setq group-\;-pos nil)))
-      
-      ;; Handle junk like ";@host.company.dom" that sendmail adds.
-      ;; **** should I remember comment positions?
-      (cond
-       (group-\;-pos
-	;; this is fine for now
-	(mail-extr-nuke-outside-range !-pos group-:-pos group-\;-pos t)
-	(mail-extr-nuke-outside-range @-pos group-:-pos group-\;-pos t)
-	(mail-extr-nuke-outside-range %-pos group-:-pos group-\;-pos t)
-	(mail-extr-nuke-outside-range comma-pos group-:-pos group-\;-pos t)
-	(and last-real-pos
-	     (> last-real-pos (1+ group-\;-pos))
-	     (setq last-real-pos (1+ group-\;-pos)))
-	;; *** This may be wrong:
-        (and cend
-             (> cend group-\;-pos)
-             (setq cend nil
-                   cbeg nil))
-	(and quote-end
-	     (> quote-end group-\;-pos)
-	     (setq quote-end nil
-		   quote-beg nil))
-	;; This was both wrong and unnecessary:
-	;;(narrow-to-region (point-min) group-\;-pos)
-
-	;; *** The entire handling of GROUP addresses seems rather lame.
-	;; *** It deserves a complete rethink, except that these addresses
-	;; *** are hardly ever seen.
-	))
-      
-      ;; Any commas must be between < and : of ROUTE-ADDR.  Nuke any
-      ;; others.
-      ;; Hell, go ahead an nuke all of the commas.
-      ;; **** This will cause problems when we start handling commas in
-      ;; the PHRASE part .... no it won't ... yes it will ... ?????
-      (mail-extr-nuke-outside-range comma-pos 1 1)
-      
-      ;; can only have multiple @s inside < >.  The fact that some MTAs
-      ;; put de-bracketed ROUTE-ADDRs in the UUCP-style "From " line is
-      ;; handled above.
-      
-      ;; Locate PHRASE part of ROUTE-ADDR.
-      (cond (<-pos
-	     (goto-char <-pos)
-	     (mail-extr-skip-whitespace-backward)
-	     (setq phrase-end (point))
-	     (goto-char (or ;;group-:-pos
-			    (point-min)))
-	     (mail-extr-skip-whitespace-forward)
-	     (if (< (point) phrase-end)
-		 (setq phrase-beg (point))
-	       (setq phrase-end nil))))
-      
-      ;; handle ROUTE-ADDRS with real ROUTEs.
-      ;; If there are multiple @s, then we assume ROUTE-ADDR syntax, and
-      ;; any % or ! must be semantically meaningless.
-      ;; TODO: do this processing into canonicalization buffer
-      (cond (route-addr-:-pos
-	     (setq !-pos nil
-		   %-pos nil
-		   >-pos (copy-marker >-pos)
-		   route-addr-:-pos (copy-marker route-addr-:-pos))
-	     (goto-char >-pos)
-	     (insert-before-markers ?X)
-	     (goto-char (car @-pos))
-	     (while (setq @-pos (cdr @-pos))
-	       (mail-extr-delete-char 1)
-	       (setq %-pos (cons (point-marker) %-pos))
-	       (insert "%")
-	       (goto-char (1- >-pos))
-	       (save-excursion
-		 (insert-buffer-substring extraction-buffer
-					  (car @-pos) route-addr-:-pos)
-		 (delete-region (car @-pos) route-addr-:-pos))
-	       (or (cdr @-pos)
-		   (setq saved-@-pos (list (point)))))
-	     (setq @-pos saved-@-pos)
-	     (goto-char >-pos)
-	     (mail-extr-delete-char -1)
-	     (mail-extr-nuke-char-at route-addr-:-pos)
-	     (mail-extr-demarkerize route-addr-:-pos)
-	     (setq route-addr-:-pos nil
-		   >-pos (mail-extr-demarkerize >-pos)
-		   %-pos (mapcar 'mail-extr-demarkerize %-pos))))
-      
-      ;; de-listify @-pos
-      (setq @-pos (car @-pos))
-      
-      ;; TODO: remove comments in the middle of an address
-      
-      (set-buffer canonicalization-buffer)
-      (fundamental-mode)
-      (kill-all-local-variables)
-      (buffer-disable-undo canonicalization-buffer)
-      (set-syntax-table mail-extr-address-syntax-table)
-      (setq case-fold-search nil)
-      
-      (widen)
-      (erase-buffer)
-      (insert-buffer-substring extraction-buffer)
-      
-      (if <-pos
-	  (narrow-to-region (progn
-			      (goto-char (1+ <-pos))
-			      (mail-extr-skip-whitespace-forward)
-			      (point))
-			    >-pos)
-	(if (and first-real-pos last-real-pos)
-	    (narrow-to-region first-real-pos last-real-pos)
-	  ;; ****** Oh no!  What if the address is completely empty!
-	  ;; *** Is this correct?
-	  (narrow-to-region (point-max) (point-max))
-	  ))
-      
-      (and @-pos %-pos
-	   (mail-extr-nuke-outside-range %-pos (point-min) @-pos))
-      (and %-pos !-pos
-	   (mail-extr-nuke-outside-range !-pos (point-min) (car %-pos)))
-      (and @-pos !-pos (not %-pos)
-	   (mail-extr-nuke-outside-range !-pos (point-min) @-pos))
-      
-      ;; Error condition:?? (and %-pos (not @-pos))
-      
-      ;; WARNING: THIS CODE IS DUPLICATED BELOW.
-      (cond ((and %-pos
-		  (not @-pos))
-	     (goto-char (car %-pos))
-	     (mail-extr-delete-char 1)
-	     (setq @-pos (point))
-	     (insert "@")
-	     (setq %-pos (cdr %-pos))))
-
-      (if mail-extr-mangle-uucp
-      (cond (!-pos
-	     ;; **** I don't understand this save-restriction and the
-	     ;; narrow-to-region inside it.  Why did I do that?
-	     (save-restriction
-	       (cond ((and @-pos
-			   mail-extr-@-binds-tighter-than-!)
-		      (goto-char @-pos)
-		      (setq %-pos (cons (point) %-pos)
-			    @-pos nil)
-		      (mail-extr-delete-char 1)
-		      (insert "%")
-		      (setq insert-point (point-max)))
-		     (mail-extr-@-binds-tighter-than-!
-		      (setq insert-point (point-max)))
-		     (%-pos
-		      (setq insert-point (mail-extr-last %-pos)
-			    saved-%-pos (mapcar 'mail-extr-markerize %-pos)
-			    %-pos nil
-			    @-pos (mail-extr-markerize @-pos)))
-		     (@-pos
-		      (setq insert-point @-pos)
-		      (setq @-pos (mail-extr-markerize @-pos)))
-		     (t
-		      (setq insert-point (point-max))))
-	       (narrow-to-region (point-min) insert-point)
-	       (setq saved-!-pos (car !-pos))
-	       (while !-pos
-		 (goto-char (point-max))
-		 (cond ((and (not @-pos)
-			     (not (cdr !-pos)))
-			(setq @-pos (point))
-			(insert-before-markers "@ "))
-		       (t
-			(setq %-pos (cons (point) %-pos))
-			(insert-before-markers "% ")))
-		 (backward-char 1)
-		 (insert-buffer-substring 
-		  (current-buffer)
-		  (if (nth 1 !-pos)
-		      (1+ (nth 1 !-pos))
-		    (point-min))
-		  (car !-pos))
-		 (mail-extr-delete-char 1)
-		 (or (save-excursion
-		       (mail-extr-safe-move-sexp -1)
-		       (mail-extr-skip-whitespace-backward)
-		       (eq ?. (preceding-char)))
-		     (insert-before-markers
-		      (if (save-excursion
-			    (mail-extr-skip-whitespace-backward)
-			    (eq ?. (preceding-char)))
-			  ""
-			".")
-		      "uucp"))
-		 (setq !-pos (cdr !-pos))))
-	     (and saved-%-pos
-		  (setq %-pos (append (mapcar 'mail-extr-demarkerize
-					      saved-%-pos)
-				      %-pos)))
-	     (setq @-pos (mail-extr-demarkerize @-pos))
-	     (narrow-to-region (1+ saved-!-pos) (point-max)))))
-
-      ;; WARNING: THIS CODE IS DUPLICATED ABOVE.
-      (cond ((and %-pos
-		  (not @-pos))
-	     (goto-char (car %-pos))
-	     (mail-extr-delete-char 1)
-	     (setq @-pos (point))
-	     (insert "@")
-	     (setq %-pos (cdr %-pos))))
-
-      (setq %-pos (nreverse %-pos))
-      (cond (%-pos			; implies @-pos valid
-	     (setq temp %-pos)
-	     (catch 'truncated
-	       (while temp
-		 (goto-char (or (nth 1 temp)
-				@-pos))
-		 (mail-extr-skip-whitespace-backward)
-		 (save-excursion
-		   (mail-extr-safe-move-sexp -1)
-		   (setq domain-pos (point))
-		   (mail-extr-skip-whitespace-backward)
-		   (setq \.-pos (eq ?. (preceding-char))))
-		 (cond ((and \.-pos
-			     ;; #### string consing
-			     (let ((s (intern-soft
-				       (buffer-substring domain-pos (point))
-				       mail-extr-all-top-level-domains)))
-			       (and s (get s 'domain-name))))
-			(narrow-to-region (point-min) (point))
-			(goto-char (car temp))
-			(mail-extr-delete-char 1)
-			(setq @-pos (point))
-			(setcdr temp nil)
-			(setq %-pos (delq @-pos %-pos))
-			(insert "@")
-			(throw 'truncated t)))
-		 (setq temp (cdr temp))))))
-      (setq mbox-beg (point-min)
-	    mbox-end (if %-pos (car %-pos)
-		       (or @-pos
-			   (point-max))))
-      
-      ;; Done canonicalizing address.
-      
-      (set-buffer extraction-buffer)
-      
-      ;; Decide what part of the address to search to find the full name.
-      (cond (
-	     ;; Example: "First M. Last" <fml@foo.bar.dom>
-	     (and phrase-beg
-		  (eq quote-beg phrase-beg)
-		  (<= quote-end phrase-end))
-	     (narrow-to-region (1+ quote-beg) (1- quote-end))
-	     (mail-extr-undo-backslash-quoting (point-min) (point-max)))
-
-	    ;; Example: First Last <fml@foo.bar.dom>
-	    (phrase-beg
-	     (narrow-to-region phrase-beg phrase-end))
-
-	    ;; Example: fml@foo.bar.dom (First M. Last)
-	    (cbeg
-	     (narrow-to-region (1+ cbeg) (1- cend))
-	     (mail-extr-undo-backslash-quoting (point-min) (point-max))
-	     
-	     ;; Deal with spacing problems
-	     (goto-char (point-min))
-;	     (cond ((not (search-forward " " nil t))
-;		    (goto-char (point-min))
-;		    (cond ((search-forward "_" nil t)
-;			   ;; Handle the *idiotic* use of underlines as spaces.
-;			   ;; Example: fml@foo.bar.dom (First_M._Last)
-;			   (goto-char (point-min))
-;			   (while (search-forward "_" nil t)
-;			     (replace-match " " t)))
-;			  ((search-forward "." nil t)
-;			   ;; Fix . used as space
-;			   ;; Example: danj1@cb.att.com (daniel.jacobson)
-;			   (goto-char (point-min))
-;			   (while (re-search-forward mail-extr-bad-dot-pattern nil t)
-;			     (replace-match "\\1 \\2" t))))))
-	     )
-	    
-	    ;; Otherwise we try to get the name from the mailbox portion
-	    ;; of the address.
-	    ;; Example: First_M_Last@foo.bar.dom
-	    (t
-	     ;; *** Work in canon buffer instead?  No, can't.  Hmm.
-	     (goto-char (point-max))
-	     (narrow-to-region (point) (point))
-	     (insert-buffer-substring canonicalization-buffer
-				      mbox-beg mbox-end)
-	     (goto-char (point-min))
-	     
-	     ;; Example: First_Last.XXX@foo.bar.dom
-	     (setq \.-ends-name (re-search-forward "[_0-9]" nil t))
-	     
-	     (goto-char (point-min))
-
-	     (if (not mail-extr-mangle-uucp)
-		 (modify-syntax-entry ?! "w" (syntax-table)))
-
-	     (while (progn
-		      (mail-extr-skip-whitespace-forward)
-		      (not (eobp)))
-	       (setq char (char-after (point)))
-	       (cond
-		((eq char ?\")
-		 (setq quote-beg (point))
-		 (or (mail-extr-safe-move-sexp 1)
-		     ;; TODO: handle this error condition!!!!!
-		     (forward-char 1))
-		 ;; take into account deletions
-		 (setq quote-end (- (point) 2))
-		 (save-excursion
-		   (backward-char 1)
-		   (mail-extr-delete-char 1)
-		   (goto-char quote-beg)
-		   (or (eobp)
-		       (mail-extr-delete-char 1)))
-		 (mail-extr-undo-backslash-quoting quote-beg quote-end)
-		 (or (eq ?\  (char-after (point)))
-		     (insert " "))
-;;		 (setq mailbox-name-processed-flag t)
-		 (setq \.-ends-name t))
-		((eq char ?.)
-		 (if (memq (char-after (1+ (point))) '(?_ ?=))
-		     (progn
-		       (forward-char 1)
-		       (mail-extr-delete-char 1)
-		       (insert ?\ ))
-		   (if \.-ends-name
-		       (narrow-to-region (point-min) (point))
-		     (mail-extr-delete-char 1)
-		     (insert " ")))
-;;		 (setq mailbox-name-processed-flag t)
-		 )
-		((memq (char-syntax char) '(?. ?\\))
-		 (mail-extr-delete-char 1)
-		 (insert " ")
-;;		 (setq mailbox-name-processed-flag t)
-		 )
-		(t
-		 (setq atom-beg (point))
-		 (forward-word 1)
-		 (setq atom-end (point))
-		 (goto-char atom-beg)
-		 (save-restriction
-		   (narrow-to-region atom-beg atom-end)
-		   (cond
-		    
-		    ;; Handle X.400 addresses encoded in RFC-822.
-		    ;; *** This has to handle the case where it is
-		    ;; *** embedded in a quote too!
-		    ;; *** The input is being broken up into atoms
-		    ;; *** by periods!
-		    ((looking-at mail-extr-x400-encoded-address-pattern)
-		     
-		     ;; Copy the contents of the individual fields that
-		     ;; might hold name data to the beginning.
-		     (mapcar
-		      (function
-		       (lambda (field-pattern)
-			 (cond
-			  ((save-excursion
-			     (re-search-forward field-pattern nil t))
-			   (insert-buffer-substring (current-buffer)
-						    (match-beginning 1)
-						    (match-end 1))
-			   (insert " ")))))
-		      (list mail-extr-x400-encoded-address-given-name-pattern
-			    mail-extr-x400-encoded-address-surname-pattern
-			    mail-extr-x400-encoded-address-full-name-pattern))
-		     
-		     ;; Discard the rest, since it contains stuff like
-		     ;; routing information, not part of a name.
-		     (mail-extr-skip-whitespace-backward)
-		     (delete-region (point) (point-max))
-		     
-		     ;; Handle periods used for spacing.
-		     (while (re-search-forward mail-extr-bad-dot-pattern nil t)
-		       (replace-match "\\1 \\2" t))
-		     
-;;		     (setq mailbox-name-processed-flag t)
-		     )
-		    
-		    ;; Handle normal addresses.
-		    (t
-		     (goto-char (point-min))
-		     ;; Handle _ and = used for spacing.
-		     (while (re-search-forward "\\([^_=]+\\)[_=]" nil t)
-		       (replace-match "\\1 " t)
-;;		       (setq mailbox-name-processed-flag t)
-		       )
-		     (goto-char (point-max))))))))
-
-	     ;; undo the dirty deed
-	     (if (not mail-extr-mangle-uucp)
-		 (modify-syntax-entry ?! "." (syntax-table)))
-	     ;;
-	     ;; If we derived the name from the mailbox part of the address,
-	     ;; and we only got one word out of it, don't treat that as a
-	     ;; name.  "foo@bar" --> (nil "foo@bar"), not ("foo" "foo@bar")
-             ;; (if (not mailbox-name-processed-flag)
-             ;;     (delete-region (point-min) (point-max)))
-	     ))
-      
-      (set-syntax-table mail-extr-address-text-syntax-table)
-      
-      (mail-extr-voodoo mbox-beg mbox-end canonicalization-buffer)
-      (goto-char (point-min))
-
-      ;; If name is "First Last" and userid is "F?L", then assume
-      ;; the middle initial is the second letter in the userid.
-      ;; Initial code by Jamie Zawinski <jwz@lucid.com>
-      ;; *** Make it work when there's a suffix as well.
-      (goto-char (point-min))
-      (cond ((and mail-extr-guess-middle-initial
-		  (not disable-initial-guessing-flag)
-		  (eq 3 (- mbox-end mbox-beg))
-		  (progn
-		    (goto-char (point-min))
-		    (looking-at mail-extr-two-name-pattern)))
-	     (setq fi (char-after (match-beginning 0))
-		   li (char-after (match-beginning 3)))
-	     (save-excursion
-	       (set-buffer canonicalization-buffer)
-	       ;; char-equal is ignoring case here, so no need to upcase
-	       ;; or downcase.
-	       (let ((case-fold-search t))
-		 (and (char-equal fi (char-after mbox-beg))
-		      (char-equal li (char-after (1- mbox-end)))
-		      (setq mi (char-after (1+ mbox-beg))))))
-	     (cond ((and mi
-			 ;; TODO: use better table than syntax table
-			 (eq ?w (char-syntax mi)))
-		    (goto-char (match-beginning 3))
-		    (insert (upcase mi) ". ")))))
-      
-      ;; Nuke name if it is the same as mailbox name.
-      (let ((buffer-length (- (point-max) (point-min)))
-	    (i 0)
-	    (names-match-flag t))
-	(cond ((and (> buffer-length 0)
-		    (eq buffer-length (- mbox-end mbox-beg)))
-	       (goto-char (point-max))
-	       (insert-buffer-substring canonicalization-buffer
-					mbox-beg mbox-end)
-	       (while (and names-match-flag
-			   (< i buffer-length))
-		 (or (eq (downcase (char-after (+ i (point-min))))
-			 (downcase
-			  (char-after (+ i buffer-length (point-min)))))
-		     (setq names-match-flag nil))
-		 (setq i (1+ i)))
-	       (delete-region (+ (point-min) buffer-length) (point-max))
-	       (if names-match-flag
-		   (narrow-to-region (point) (point))))))
-      
-      ;; Nuke name if it's just one word.
-      (goto-char (point-min))
-      (and mail-extr-ignore-single-names
-	   (not (re-search-forward "[- ]" nil t))
-	   (narrow-to-region (point) (point)))
-      
-      ;; Result
-      (list (if (not (= (point-min) (point-max)))
-		(buffer-string))
-	    (progn
-	      (set-buffer canonicalization-buffer)
-	      (if (not (= (point-min) (point-max)))
-		  (buffer-string))))
-      )))
-
-(defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer)
-  (let ((word-count 0)
-	(case-fold-search nil)
-	mixed-case-flag lower-case-flag ;;upper-case-flag
-	suffix-flag last-name-comma-flag
-	;;cbeg cend
-	initial
-	begin-again-flag
-	drop-this-word-if-trailing-flag
-	drop-last-word-if-trailing-flag
-	word-found-flag
-	this-word-beg last-word-beg
-	name-beg name-end
-	name-done-flag
-	)
-    (save-excursion
-      (set-syntax-table mail-extr-address-text-syntax-table)
-      
-      ;; This was moved above.
-      ;; Fix . used as space
-      ;; But it belongs here because it occurs not only as
-      ;;   rypens@reks.uia.ac.be (Piet.Rypens)
-      ;; but also as
-      ;;   "Piet.Rypens" <rypens@reks.uia.ac.be>
-      ;;(goto-char (point-min))
-      ;;(while (re-search-forward mail-extr-bad-dot-pattern nil t)
-      ;;  (replace-match "\\1 \\2" t))
-
-      (cond ((not (search-forward " " nil t))
-	     (goto-char (point-min))
-	     (cond ((search-forward "_" nil t)
-		    ;; Handle the *idiotic* use of underlines as spaces.
-		    ;; Example: fml@foo.bar.dom (First_M._Last)
-		    (goto-char (point-min))
-		    (while (search-forward "_" nil t)
-		      (replace-match " " t)))
-		   ((search-forward "." nil t)
-		    ;; Fix . used as space
-		    ;; Example: danj1@cb.att.com (daniel.jacobson)
-		    (goto-char (point-min))
-		    (while (re-search-forward mail-extr-bad-dot-pattern nil t)
-		      (replace-match "\\1 \\2" t))))))
-
-
-      ;; Loop over the words (and other junk) in the name.
-      (goto-char (point-min))
-      (while (not name-done-flag)
-	
-	(cond (word-found-flag
-	       ;; Last time through this loop we skipped over a word.
-	       (setq last-word-beg this-word-beg)
-	       (setq drop-last-word-if-trailing-flag
-		     drop-this-word-if-trailing-flag)
-	       (setq word-found-flag nil)))
-
-	(cond (begin-again-flag
-	       ;; Last time through the loop we found something that
-	       ;; indicates we should pretend we are beginning again from
-	       ;; the start.
-	       (setq word-count 0)
-	       (setq last-word-beg nil)
-	       (setq drop-last-word-if-trailing-flag nil)
-	       (setq mixed-case-flag nil)
-	       (setq lower-case-flag nil)
-;;	       (setq upper-case-flag nil)
-	       (setq begin-again-flag nil)
-	       ))
-	
-	;; Initialize for this iteration of the loop.
-	(mail-extr-skip-whitespace-forward)
-	(if (eq word-count 0) (narrow-to-region (point) (point-max)))
-	(setq this-word-beg (point))
-	(setq drop-this-word-if-trailing-flag nil)
-	
-	;; Decide what to do based on what we are looking at.
-	(cond
-	 
-	 ;; Delete title
-	 ((and (eq word-count 0)
-	       (looking-at mail-extr-full-name-prefixes))
-	  (goto-char (match-end 0))
-	  (narrow-to-region (point) (point-max)))
-	 
-	 ;; Stop after name suffix
-	 ((and (>= word-count 2)
-	       (looking-at mail-extr-full-name-suffix-pattern))
-	  (mail-extr-skip-whitespace-backward)
-	  (setq suffix-flag (point))
-	  (if (eq ?, (following-char))
-	      (forward-char 1)
-	    (insert ?,))
-	  ;; Enforce at least one space after comma
-	  (or (eq ?\  (following-char))
-	      (insert ?\ ))
-	  (mail-extr-skip-whitespace-forward)
-	  (cond ((memq (following-char) '(?j ?J ?s ?S))
-		 (capitalize-word 1)
-		 (if (eq (following-char) ?.)
-		     (forward-char 1)
-		   (insert ?.)))
-		(t
-		 (upcase-word 1)))
-	  (setq word-found-flag t)
-	  (setq name-done-flag t))
-	 
-	 ;; Handle SCA names
-	 ((looking-at "MKA \\(.+\\)")	; "Mundanely Known As"
-	  (goto-char (match-beginning 1))
-	  (narrow-to-region (point) (point-max))
-	  (setq begin-again-flag t))
-	 
-	 ;; Check for initial last name followed by comma
-	 ((and (eq ?, (following-char))
-	       (eq word-count 1))
-	  (forward-char 1)
-	  (setq last-name-comma-flag t)
-	  (or (eq ?\  (following-char))
-	      (insert ?\ )))
-	 
-	 ;; Stop before trailing comma-separated comment
-	 ;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
-	 ;; *** This case is redundant???
-	 ;;((eq ?, (following-char))
-	 ;; (setq name-done-flag t))
-	 
-	 ;; Delete parenthesized/quoted comment/nickname
-	 ((memq (following-char) '(?\( ?\{ ?\[ ?\" ?\' ?\`))
-	  (setq cbeg (point))
-	  (set-syntax-table mail-extr-address-text-comment-syntax-table)
-	  (cond ((memq (following-char) '(?\' ?\`))
-		 (or (search-forward "'" nil t
-				     (if (eq ?\' (following-char)) 2 1))
-		     (mail-extr-delete-char 1)))
-		(t
-		 (or (mail-extr-safe-move-sexp 1)
-		     (goto-char (point-max)))))
-	  (set-syntax-table mail-extr-address-text-syntax-table)
-	  (setq cend (point))
-	  (cond
-	   ;; Handle case of entire name being quoted
-	   ((and (eq word-count 0)
-		 (looking-at " *\\'")
-		 (>= (- cend cbeg) 2))
-	    (narrow-to-region (1+ cbeg) (1- cend))
-	    (goto-char (point-min)))
-	   (t
-	    ;; Handle case of quoted initial
-	    (if (and (or (= 3 (- cend cbeg))
-			 (and (= 4 (- cend cbeg))
-			      (eq ?. (char-after (+ 2 cbeg)))))
-		     (not (looking-at " *\\'")))
-		(setq initial (char-after (1+ cbeg)))
-	      (setq initial nil))
-	    (delete-region cbeg cend)
-	    (if initial
-		(insert initial ". ")))))
-	 
-	 ;; Handle & substitution
-	 ((and (or (bobp)
-		   (eq ?\  (preceding-char)))
-	       (looking-at "&\\( \\|\\'\\)"))
-	  (mail-extr-delete-char 1)
-	  (capitalize-region
-	   (point)
-	   (progn
-	     (insert-buffer-substring canonicalization-buffer
-				      mbox-beg mbox-end)
-	     (point)))
-	  (setq disable-initial-guessing-flag t)
-	  (setq word-found-flag t))
-	 
-	 ;; Handle *Stupid* VMS date stamps
-	 ((looking-at mail-extr-stupid-vms-date-stamp-pattern)
-	  (replace-match "" t))
-	 
-	 ;; Handle Chinese characters.
-	 ((looking-at mail-extr-hz-embedded-gb-encoded-chinese-pattern)
-	  (goto-char (match-end 0))
-	  (setq word-found-flag t))
-	 
-	 ;; Skip initial garbage characters.
-	 ;; THIS CASE MUST BE AFTER THE PRECEDING CASES.
-	 ((and (eq word-count 0)
-	       (looking-at mail-extr-leading-garbage))
-	  (goto-char (match-end 0))
-	  ;; *** Skip backward over these???
-	  ;; (skip-chars-backward "& \"")
-	  (narrow-to-region (point) (point-max)))
-	 
-	 ;; Various stopping points
-	 ((or
-	   
-	   ;; Stop before ALL CAPS acronyms, if preceded by mixed-case
-	   ;; words.  Example: XT-DEM.
-	   (and (>= word-count 2)
-		mixed-case-flag
-		(looking-at mail-extr-weird-acronym-pattern)
-		(not (looking-at mail-extr-roman-numeral-pattern)))
-	   
-	   ;; Stop before trailing alternative address
-	   (looking-at mail-extr-alternative-address-pattern)
-	   
-	   ;; Stop before trailing comment not introduced by comma
-	   ;; THIS CASE MUST BE AFTER AN EARLIER CASE.
-	   (looking-at mail-extr-trailing-comment-start-pattern)
-	   
-	   ;; Stop before telephone numbers
-	   (looking-at mail-extr-telephone-extension-pattern))
-	  (setq name-done-flag t))
-	 
-	 ;; Delete ham radio call signs
-	 ((looking-at mail-extr-ham-call-sign-pattern)
-	  (delete-region (match-beginning 0) (match-end 0)))
-	 
-	 ;; Fixup initials
-	 ((looking-at mail-extr-initial-pattern)
-	  (or (eq (following-char) (upcase (following-char)))
-	      (setq lower-case-flag t))
-	  (forward-char 1)
-	  (if (eq ?. (following-char))
-	      (forward-char 1)
-	    (insert ?.))
-	  (or (eq ?\  (following-char))
-	      (insert ?\ ))
-	  (setq word-found-flag t))
-	 
-	 ;; Handle BITNET LISTSERV list names.
-	 ((and (eq word-count 0)
-	       (looking-at mail-extr-listserv-list-name-pattern))
-	  (narrow-to-region (match-beginning 1) (match-end 1))
-	  (setq word-found-flag t)
-	  (setq name-done-flag t))
-	 
-	 ;; Regular name words
-	 ((looking-at mail-extr-name-pattern)
-	  (setq name-beg (point))
-	  (setq name-end (match-end 0))
-	  
-	  ;; Certain words will be dropped if they are at the end.
-	  (and (>= word-count 2)
-	       (not lower-case-flag)
-	       (or
-		;; A trailing 4-or-more letter lowercase words preceded by
-		;; mixed case or uppercase words will be dropped.
-		(looking-at "[a-z][a-z][a-z][a-z]+[ \t]*\\'")
-		;; Drop a trailing word which is terminated with a period.
-		(eq ?. (char-after (1- name-end))))
-	       (setq drop-this-word-if-trailing-flag t))
-	  
-	  ;; Set the flags that indicate whether we have seen a lowercase
-	  ;; word, a mixed case word, and an uppercase word.
-	  (if (re-search-forward "[a-z]" name-end t)
-	      (if (progn
-		    (goto-char name-beg)
-		    (re-search-forward "[A-Z]" name-end t))
-		  (setq mixed-case-flag t)
-		(setq lower-case-flag t))
-;;	    (setq upper-case-flag t)
-	    )
-	  
-	  (goto-char name-end)
-	  (setq word-found-flag t))
-
-	 (t
-	  (setq name-done-flag t)
-	  ))
-	
-	;; Count any word that we skipped over.
-	(if word-found-flag
-	    (setq word-count (1+ word-count))))
-      
-      ;; If the last thing in the name is 2 or more periods, or one or more
-      ;; other sentence terminators (but not a single period) then keep them
-      ;; and the preceding word.  This is for the benefit of whole sentences
-      ;; in the name field: it's better behavior than dropping the last word
-      ;; of the sentence...
-      (if (and (not suffix-flag)
-	       (looking-at "\\(\\.+\\|[?!;:.][?!;:.]+\\|[?!;:][?!;:.]*\\)\\'"))
-	  (goto-char (setq suffix-flag (point-max))))
-
-      ;; Drop everything after point and certain trailing words.
-      (narrow-to-region (point-min)
-			(or (and drop-last-word-if-trailing-flag
-				 last-word-beg)
-			    (point)))
-      
-      ;; Xerox's mailers SUCK!!!!!!
-      ;; We simply refuse to believe that any last name is PARC or ADOC.
-      ;; If it looks like that is the last name, that there is no meaningful
-      ;; here at all.  Actually I guess it would be best to map patterns
-      ;; like foo.hoser@xerox.com into foo@hoser.xerox.com, but I don't
-      ;; actually know that that is what's going on.
-      (cond ((not suffix-flag)
-	     (goto-char (point-min))
-	     (let ((case-fold-search t))
-	       (if (looking-at "[-A-Za-z_]+[. ]\\(PARC\\|ADOC\\)\\'")
-		   (erase-buffer)))))
-
-      ;; If last name first put it at end (but before suffix)
-      (cond (last-name-comma-flag
-	     (goto-char (point-min))
-	     (search-forward ",")
-	     (setq name-end (1- (point)))
-	     (goto-char (or suffix-flag (point-max)))
-	     (or (eq ?\  (preceding-char))
-		 (insert ?\ ))
-	     (insert-buffer-substring (current-buffer) (point-min) name-end)
-	     (goto-char name-end)
-	     (skip-chars-forward "\t ,")
-	     (narrow-to-region (point) (point-max))))
-      
-      ;; Delete leading and trailing junk characters.
-      ;; *** This is probably completely unneeded now.
-      ;;(goto-char (point-max))
-      ;;(skip-chars-backward mail-extr-non-end-name-chars)
-      ;;(if (eq ?. (following-char))
-      ;;    (forward-char 1))
-      ;;(narrow-to-region (point)
-      ;;                  (progn
-      ;;                    (goto-char (point-min))
-      ;;                    (skip-chars-forward mail-extr-non-begin-name-chars)
-      ;;                    (point)))
-      
-      ;; Compress whitespace
-      (goto-char (point-min))
-      (while (re-search-forward "[ \t\n]+" nil t)
-	(replace-match (if (eobp) "" " ") t))
-      )))
-
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Table of top-level domain names.
-;;
-;; This is used during address canonicalization; be careful of format changes.
-;; Keep in mind that the country abbreviations follow ISO-3166.  There is
-;; a U.S. FIPS that specifies a different set of two-letter country
-;; abbreviations.
-
-(defconst mail-extr-all-top-level-domains
-  (let ((ob (make-vector 509 0)))
-    (mapcar
-     (function
-      (lambda (x)
-	(put (intern (downcase (car x)) ob)
-	     'domain-name
-	     (if (nth 2 x)
-		 (format (nth 2 x) (nth 1 x))
-	       (nth 1 x)))))
-     '(
-       ;; ISO 3166 codes:
-       ("ae" "United Arab Emirates")
-       ("ag" "Antigua and Barbuda")
-       ("al" "Albania")
-       ("ao" "Angola")
-       ("aq" "Antarctica")		; continent
-       ("ar" "Argentina"	"Argentine Republic")
-       ("at" "Austria"		"The Republic of %s")
-       ("au" "Australia")
-       ("az" "Azerbaijan")
-       ("bb" "Barbados")
-       ("bd" "Bangladesh")
-       ("be" "Belgium"		"The Kingdom of %s")
-       ("bf" "Burkina Faso")
-       ("bg" "Bulgaria")
-       ("bh" "Bahrain")
-       ("bm" "Bermuda")
-       ("bo" "Bolivia"		"Republic of %s")
-       ("br" "Brazil"		"The Federative Republic of %s")
-       ("bs" "Bahamas")
-       ("bw" "Botswana")
-       ("by" "Belarus")
-       ("bz" "Belize")
-       ("ca" "Canada")
-       ("cg" "Congo")
-       ("ch" "Switzerland"	"The Swiss Confederation")
-       ("ci" "Ivory Coast")
-       ("cl" "Chile"		"The Republic of %s")
-       ("cm" "Cameroon")		; In .fr domain
-       ("cn" "China"		"The People's Republic of %s")
-       ("co" "Colombia")
-       ("cr" "Costa Rica"	"The Republic of %s")
-       ("cs" "Czechoslovakia")
-       ("cu" "Cuba")
-       ("cy" "Cyprus")
-       ("cz" "Czech Republic")
-       ("de" "Germany")
-       ("dk" "Denmark")
-       ("dm" "Dominica")
-       ("do" "Dominican Republic"	"The %s")
-       ("dz" "Algeria")
-       ("ec" "Ecuador"		"The Republic of %s")
-       ("ee" "Estonia")
-       ("eg" "Egypt"		"The Arab Republic of %s")
-       ("er" "Eritrea")
-       ("es" "Spain"		"The Kingdom of %s")
-       ("fi" "Finland"		"The Republic of %s")
-       ("fj" "Fiji")
-       ("fo" "Faroe Islands")
-       ("fr" "France")
-       ("gb" "Great Britain")
-       ("gd" "Grenada")
-       ("ge" "Georgia")
-       ("gf" "Guyana (Fr.)")
-       ("gp" "Guadeloupe (Fr.)")
-       ("gr" "Greece"		"The Hellenic Republic (%s)")
-       ("gt" "Guatemala")
-       ("gu" "Guam (U.S.)")
-       ("hk" "Hong Kong")
-       ("hn" "Honduras")
-       ("hr" "Croatia")
-       ("ht" "Haiti")
-       ("hu" "Hungary"		"The Hungarian Republic")	;???
-       ("id" "Indonesia")
-       ("ie" "Ireland")
-       ("il" "Israel"		"The State of %s")
-       ("in" "India"		"The Republic of %s")
-       ("ir" "Iran")
-       ("is" "Iceland"		"The Republic of %s")
-       ("it" "Italy"		"The Italian Republic")
-       ("jm" "Jamaica")
-       ("jp" "Japan")
-       ("ke" "Kenya")
-       ("kn" "St. Kitts, Nevis, and Anguilla")
-       ("kp" "Korea (North)")
-       ("kr" "Korea (South)")
-       ("kw" "Kuwait")
-       ("kz" "Kazakhstan")
-       ("lb" "Lebanon")
-       ("lc" "St. Lucia")
-       ("li" "Liechtenstein")
-       ("lk" "Sri Lanka"	"The Democratic Socialist Republic of %s")
-       ("ls" "Lesotho")
-       ("lt" "Lithuania")
-       ("lu" "Luxembourg")
-       ("lv" "Latvia")
-       ("ma" "Morocco")
-       ("md" "Moldova")
-       ("mg" "Madagascar")
-       ("mk" "Macedonia")
-       ("ml" "Mali")
-       ("mo" "Macau")
-       ("mt" "Malta")
-       ("mu" "Mauritius")
-       ("mw" "Malawi")
-       ("mx" "Mexico"		"The United Mexican States")
-       ("my" "Malaysia"		"%s (changed to Myanmar?)")		;???
-       ("mz" "Mozambique")
-       ("na" "Namibia")
-       ("nc" "New Caledonia (Fr.)")
-       ("ne" "Niger")			; In .fr domain
-       ("ni" "Nicaragua"	"The Republic of %s")
-       ("nl" "Netherlands"	"The Kingdom of the %s")
-       ("no" "Norway"		"The Kingdom of %s")
-       ("np" "Nepal")			; Via .in domain
-       ("nz" "New Zealand")
-       ("pa" "Panama")
-       ("pe" "Peru")
-       ("pf" "Polynesia (Fr.)")
-       ("pg" "Papua New Guinea")
-       ("ph" "Philippines"	"The Republic of the %s")
-       ("pk" "Pakistan")
-       ("pl" "Poland")
-       ("pr" "Puerto Rico (U.S.)")
-       ("pt" "Portugal"		"The Portuguese Republic")
-       ("py" "Paraguay")
-       ("re" "Reunion (Fr.)")		; In .fr domain
-       ("ro" "Romania")
-       ("ru" "Russian Federation")
-       ("sa" "Saudi Arabia")
-       ("sc" "Seychelles")
-       ("sd" "Sudan")
-       ("se" "Sweden"		"The Kingdom of %s")
-       ("sg" "Singapore"	"The Republic of %s")
-       ("si" "Slovenia")
-       ("sj" "Svalbard and Jan Mayen Is.") ; In .no domain
-       ("sk" "Slovakia"		"The Slovak Republic")
-       ("sn" "Senegal")
-       ("sr" "Suriname")
-       ("su" "Soviet Union")
-       ("sz" "Swaziland")
-       ("tg" "Togo")
-       ("th" "Thailand"		"The Kingdom of %s")
-       ("tm" "Turkmenistan")		; In .su domain
-       ("tn" "Tunisia")
-       ("tr" "Turkey"		"The Republic of %s")
-       ("tt" "Trinidad and Tobago")
-       ("tw" "Taiwan")
-       ("ua" "Ukraine")
-       ("uk" "United Kingdom"	"The %s of Great Britain and Northern Ireland")
-       ("us" "United States"	"The %s of America")
-       ("uy" "Uruguay"		"The Eastern Republic of %s")
-       ("vc" "St. Vincent and the Grenadines")
-       ("ve" "Venezuela"	"The Republic of %s")
-       ("vi" "Virgin Islands (U.S.)")
-       ("vn" "Vietnam")
-       ("vu" "Vanuatu")
-       ("yu" "Yugoslavia"	"The Socialist Federal Republic of %s")
-       ("za" "South Africa"	"The Republic of %s (or Zambia? Zaire?)")
-       ("zw" "Zimbabwe"		"Republic of %s")
-       ;; Special top-level domains:
-       ("arpa" t		"Advanced Research Projects Agency (U.S. DoD)")
-       ("bitnet" t		"Because It's Time NET")
-       ("com" t			"Commercial")
-       ("edu" t			"Educational")
-       ("gov" t			"Government (U.S.)")
-       ("int" t			"International (NATO)")
-       ("mil" t			"Military (U.S.)")
-       ("nato" t		"North Atlantic Treaty Organization")
-       ("net" t			"Network")
-       ("org" t			"Non-profit Organization")
-       ;;("unter-dom" t		"? (Ger.)")
-       ("uucp" t		"Unix to Unix CoPy")
-       ;;("fipnet" nil		"?")
-       ))
-    ob))
-
-;;;###autoload
-(defun what-domain (domain)
-  "Convert mail domain DOMAIN to the country it corresponds to."
-  (interactive
-   (let ((completion-ignore-case t))
-     (list (completing-read "Domain: "
-			    mail-extr-all-top-level-domains nil t))))
-  (or (setq domain (intern-soft (downcase domain)
-				mail-extr-all-top-level-domains))
-      (error "No such domain"))
-  (message "%s: %s" (upcase (symbol-name domain)) (get domain 'domain-name)))
-
-
-;(let ((all nil))
-;  (mapatoms #'(lambda (x)
-;		(if (and (boundp x) 
-;			 (string-match "^mail-extr-" (symbol-name x)))
-;		    (setq all (cons x all)))))
-;  (setq all (sort all #'string-lessp))
-;  (cons 'setq
-;	(apply 'nconc (mapcar #'(lambda (x)
-;				  (list x (symbol-value x)))
-;			      all))))
-
-
-(provide 'mail-extr)
-
-;;; mail-extr.el ends here
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
deleted file mode 100644
index 893ce40ddb7..00000000000
--- a/lisp/mail/mail-hist.el
+++ /dev/null
@@ -1,302 +0,0 @@
-;;; mail-hist.el --- Headers and message body history for outgoing mail.
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: Karl Fogel <kfogel@cs.oberlin.edu>
-;; Created: March, 1994
-;; Keywords: mail, history
-
-;; 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:
-
-;; Thanks to Jim Blandy for mentioning ring.el.  It saved a lot of
-;; time.
-;;
-;; To use this package, put it in a directory in your load-path, and
-;; put this in your .emacs file:
-;;
-;; (load "mail-hist" nil t)
-;;
-;; Or you could do it with autoloads and hooks in your .emacs:
-;;
-;; (add-hook 'mail-mode-hook 'mail-hist-define-keys)
-;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)
-;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc
-;; (autoload 'mail-hist-define-keys "mail-hist")
-;; (autoload 'mail-hist-put-headers-into-history "mail-hist")
-;;
-;; Once it's installed, use M-p and M-n from mail headers to recover
-;; previous/next contents in the history for that header, or, in the
-;; body of the message, to recover previous/next text of the message.
-;; This only applies to outgoing mail -- mail-hist ignores received
-;; messages.
-;;
-;; Although repeated history requests do clear out the text from the
-;; previous request, an isolated request just inserts its text at
-;; point, so that you can mix the histories of different messages
-;; easily.  This might be confusing at times, but there should be no
-;; problems that undo can't handle.
-
-;;; Code:
-(require 'ring)
-
-;;;###autoload
-(defun mail-hist-define-keys ()
-  "Define keys for accessing mail header history.  For use in hooks."
-  (local-set-key "\M-p" 'mail-hist-previous-input)
-  (local-set-key "\M-n" 'mail-hist-next-input))
-
-;;;###autoload
-(defun mail-hist-enable ()
-  (add-hook 'mail-mode-hook 'mail-hist-define-keys)
-  (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history))
-
-(defvar mail-hist-header-ring-alist nil
-  "Alist of form (header-name . history-ring).
-Used for knowing which history list to look in when the user asks for
-previous/next input.")
-
-(defvar mail-hist-history-size (or kill-ring-max 1729)
-  "*The maximum number of elements in a mail field's history.
-Oldest elements are dumped first.")
-
-;;;###autoload
-(defvar mail-hist-keep-history t
-  "*Non-nil means keep a history for headers and text of outgoing mail.")
-
-;; For handling repeated history requests
-(defvar mail-hist-access-count 0)
-
-(defvar mail-hist-last-bounds nil)
-;; (start . end) A pair indicating the buffer positions delimiting the
-;; last inserted history, so it can be replaced by a new input if the
-;; command is repeated.
-
-(defvar mail-hist-header-regexp "^[^:]*:"
-  "Regular expression for matching headers in a mail message.")
-
-(defsubst mail-hist-current-header-name ()
-  "Get name of mail header point is currently in, without the colon.
-Returns nil if not in a header, implying that point is in the body of
-the message."
-  (if (save-excursion
-        (re-search-backward (concat "^" (regexp-quote mail-header-separator)
-				    "$")
-			    nil t))
-      nil ; then we are in the body of the message
-    (save-excursion
-      (let* ((body-start ; limit possibility of false headers
-              (save-excursion
-                (re-search-forward
-		 (concat "^" (regexp-quote mail-header-separator) "$")
-		 nil t)))
-             (name-start
-              (re-search-backward mail-hist-header-regexp nil t))
-             (name-end
-              (prog2 (search-forward ":" body-start t) (1- (point)))))
-        (and
-         name-start
-         name-end
-         (downcase (buffer-substring-no-properties name-start name-end)))))))
-
-(defsubst mail-hist-forward-header (count)
-  "Move forward COUNT headers (backward if COUNT is negative).
-If last/first header is encountered first, stop there and returns
-nil.  
-
-Places point on the first non-whitespace on the line following the
-colon after the header name, or on the second space following that if
-the header is empty."
-  (let ((boundary (save-excursion
-		    (re-search-forward
-		     (concat "^" (regexp-quote mail-header-separator) "$")
-		     nil t))))
-    (and
-     boundary
-     (let ((unstopped t))
-       (setq boundary (save-excursion
-                    (goto-char boundary)
-                    (beginning-of-line)
-                    (1- (point))))
-       (if (> count 0)
-           (while (> count 0)
-             (setq
-              unstopped
-              (re-search-forward mail-hist-header-regexp boundary t))
-             (setq count (1- count)))
-         ;; because the current header will match too.
-         (setq count (1- count))
-         ;; count is negative
-         (while (< count 0)
-           (setq
-            unstopped
-            (re-search-backward mail-hist-header-regexp nil t))
-           (setq count (1+ count)))
-         ;; we end up behind the header, so must move to the front
-         (re-search-forward mail-hist-header-regexp boundary t))
-       ;; Now we are right after the colon
-       (and (looking-at "\\s-") (forward-char 1))
-       ;; return nil if didn't go as far as asked, otherwise point
-       unstopped))))
-
-(defsubst mail-hist-beginning-of-header ()
-  "Move to the start of the current header.
-The start of the current header is defined as one space after the
-colon, or just after the colon if it is not followed by whitespace."
-  ;; this is slick as all heck:
-  (if (mail-hist-forward-header -1)
-      (mail-hist-forward-header 1)
-    (mail-hist-forward-header 1)
-    (mail-hist-forward-header -1)))
-
-(defsubst mail-hist-current-header-contents ()
-  "Get the contents of the mail header in which point is located."
-  (save-excursion
-    (mail-hist-beginning-of-header)
-    (let ((start (point)))
-      (or (mail-hist-forward-header 1)
-          (re-search-forward
-	   (concat "^" (regexp-quote mail-header-separator) "$")))
-      (beginning-of-line)
-      (buffer-substring start (1- (point))))))
-
-(defsubst mail-hist-get-header-ring (header)
-  "Get HEADER's history ring, or nil if none.
-HEADER is a string without the colon."
-  (setq header (downcase header))
-  (cdr (assoc header mail-hist-header-ring-alist)))
-
-(defvar mail-hist-text-size-limit nil
-  "*Don't store any header or body with more than this many characters.
-If the value is nil, that means no limit on text size.")
-
-(defun mail-hist-text-too-long-p (text)
-  "Return t if TEXT does not exceed mail-hist's size limit.
-The variable `mail-hist-text-size-limit' defines this limit."
-  (if mail-hist-text-size-limit
-      (> (length text) mail-hist-text-size-limit)))
-
-(defsubst mail-hist-add-header-contents-to-ring (header &optional contents)
-  "Add the contents of HEADER to the header history ring.
-Optional argument CONTENTS is a string which will be the contents
-\(instead of whatever's found in the header)."
-  (setq header (downcase header))
-  (let ((ctnts (or contents (mail-hist-current-header-contents)))
-        (ring  (cdr (assoc header mail-hist-header-ring-alist))))
-    (if (mail-hist-text-too-long-p ctnts) (setq ctnts ""))
-    (or ring
-        ;; If the ring doesn't exist, we'll have to make it and add it
-        ;; to the mail-header-ring-alist:
-        (prog1
-            (setq ring (make-ring mail-hist-history-size))
-          (setq mail-hist-header-ring-alist
-                (cons (cons header ring) mail-hist-header-ring-alist))))
-    (ring-insert ring ctnts)))
-
-;;;###autoload
-(defun mail-hist-put-headers-into-history ()
-  "Put headers and contents of this message into mail header history. 
-Each header has its own independent history, as does the body of the
-message.
-
-This function normally would be called when the message is sent." 
-  (and
-   mail-hist-keep-history
-   (save-excursion
-     (goto-char (point-min))
-     (while (mail-hist-forward-header 1)
-       (mail-hist-add-header-contents-to-ring
-        (mail-hist-current-header-name)))
-     (let ((body-contents
-            (save-excursion
-	      (goto-char (point-min))
-	      (re-search-forward
-	       (concat "^" (regexp-quote mail-header-separator) "$")
-	       nil)
-	      (forward-line 1)
-	      (buffer-substring (point) (point-max)))))
-       (mail-hist-add-header-contents-to-ring "body" body-contents)))))
-
-(defun mail-hist-previous-input (header)
-  "Insert the previous contents of this mail header or message body.
-Moves back through the history of sent mail messages.  Each header has
-its own independent history, as does the body of the message.
-
-The history only contains the contents of outgoing messages, not
-received mail."
-  (interactive (list (or (mail-hist-current-header-name) "body")))
-  (setq header (downcase header))
-  (let* ((ring (cdr (assoc header mail-hist-header-ring-alist)))
-         (len (ring-length ring))
-         (repeat (eq last-command 'mail-hist-input-access)))
-    (if repeat
-        (setq mail-hist-access-count
-              (ring-plus1 mail-hist-access-count len))
-      (setq mail-hist-access-count 0))
-    (if (null ring)
-        (progn
-          (ding)
-          (message "No history for \"%s\"." header))
-      (if (ring-empty-p ring)
-          (error "\"%s\" ring is empty." header)
-        (and repeat
-             (delete-region (car mail-hist-last-bounds)
-                            (cdr mail-hist-last-bounds)))
-        (let ((start (point)))
-          (insert (ring-ref ring mail-hist-access-count))
-          (setq mail-hist-last-bounds (cons start (point)))
-          (setq this-command 'mail-hist-input-access))))))
-
-(defun mail-hist-next-input (header)
-  "Insert next contents of this mail header or message body.
-Moves back through the history of sent mail messages.  Each header has
-its own independent history, as does the body of the message.
-
-Although you can do so, it does not make much sense to call this
-without having called `mail-hist-previous-header' first
-(\\[mail-hist-previous-header]).
-
-The history only contains the contents of outgoing messages, not
-received mail."
-  (interactive (list (or (mail-hist-current-header-name) "body")))
-  (setq header (downcase header))
-  (let* ((ring (cdr (assoc header mail-hist-header-ring-alist)))
-         (len (ring-length ring))
-         (repeat (eq last-command 'mail-hist-input-access)))
-    (if repeat
-        (setq mail-hist-access-count
-              (ring-minus1 mail-hist-access-count len))
-      (setq mail-hist-access-count 0))
-    (if (null ring)
-        (progn
-          (ding)
-          (message "No history for \"%s\"." header))
-      (if (ring-empty-p ring)
-          (error "\"%s\" ring is empty." header)
-        (and repeat
-             (delete-region (car mail-hist-last-bounds)
-                            (cdr mail-hist-last-bounds)))
-        (let ((start (point)))
-          (insert (ring-ref ring mail-hist-access-count))
-          (setq mail-hist-last-bounds (cons start (point)))
-          (setq this-command 'mail-hist-input-access))))))
-
-(provide 'mail-hist)
-
-;; mail-hist.el ends here
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
deleted file mode 100644
index ebf2f617789..00000000000
--- a/lisp/mail/mail-utils.el
+++ /dev/null
@@ -1,254 +0,0 @@
-;;; mail-utils.el --- utility functions used both by rmail and rnews
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail, news
-
-;; 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:
-
-;; Utility functions for mail and netnews handling.  These handle fine
-;; points of header parsing.
-
-;;; Code:
-
-;;; We require lisp-mode to make sure that lisp-mode-syntax-table has
-;;; been initialized.
-(require 'lisp-mode)
-		     
-;;;###autoload
-(defvar mail-use-rfc822 nil "\
-*If non-nil, use a full, hairy RFC822 parser on mail addresses.
-Otherwise, (the default) use a smaller, somewhat faster, and
-often correct parser.")
-
-;; Returns t if file FILE is an Rmail file.
-;;;###autoload
-(defun mail-file-babyl-p (file)
-  (let ((buf (generate-new-buffer " *rmail-file-p*")))
-    (unwind-protect
-	(save-excursion
-	  (set-buffer buf)
-	  (insert-file-contents file nil 0 100)
-	  (looking-at "BABYL OPTIONS:"))
-      (kill-buffer buf))))
-
-(defun mail-string-delete (string start end)
-  "Returns a string containing all of STRING except the part
-from START (inclusive) to END (exclusive)."
-  (if (null end) (substring string 0 start)
-    (concat (substring string 0 start)
-	    (substring string end nil))))
-
-(defun mail-strip-quoted-names (address)
-  "Delete comments and quoted strings in an address list ADDRESS.
-Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR.
-Return a modified address list."
-  (if (null address)
-      nil
-    (if mail-use-rfc822
-	(progn (require 'rfc822)
-	       (mapconcat 'identity (rfc822-addresses address) ", "))
-      (let (pos)
-       (string-match "\\`[ \t\n]*" address)
-       ;; strip surrounding whitespace
-       (setq address (substring address
-				(match-end 0)
-				(string-match "[ \t\n]*\\'" address
-					      (match-end 0))))
-
-       ;; Detect nested comments.
-       (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address)
-	   ;; Strip nested comments.
-	   (save-excursion
-	     (set-buffer (get-buffer-create " *temp*"))
-	     (erase-buffer)
-	     (insert address)
-	     (set-syntax-table lisp-mode-syntax-table)
-	     (goto-char 1)
-	     (while (search-forward "(" nil t)
-	       (forward-char -1)
-	       (skip-chars-backward " \t")
-	       (delete-region (point)
-			      (save-excursion
-				(condition-case ()
-				    (forward-sexp 1)
-				  (error (goto-char (point-max))))
-				  (point))))
-	     (setq address (buffer-string))
-	     (erase-buffer))
-	 ;; Strip non-nested comments an easier way.
-	 (while (setq pos (string-match 
-			    ;; This doesn't hack rfc822 nested comments
-			    ;;  `(xyzzy (foo) whinge)' properly.  Big deal.
-			    "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)"
-			    address))
-	   (setq address
-		 (mail-string-delete address
-				     pos (match-end 0)))))
-
-       ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar@host>')
-       (setq pos 0)
-       (while (setq pos (string-match
-			  "[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*"
-			  address pos))
-	 ;; If the next thing is "@", we have "foo bar"@host.  Leave it.
-	 (if (and (> (length address) (match-end 0))
-		  (= (aref address (match-end 0)) ?@))
-	     (setq pos (match-end 0))
-	   (setq address
-		 (mail-string-delete address
-				     pos (match-end 0)))))
-       ;; Retain only part of address in <> delims, if there is such a thing.
-       (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,]*>\\)"
-				      address))
-	 (let ((junk-beg (match-end 1))
-	       (junk-end (match-beginning 2))
-	       (close (match-end 0)))
-	   (setq address (mail-string-delete address (1- close) close))
-	   (setq address (mail-string-delete address junk-beg junk-end))))
-       address))))
-  
-(or (and (boundp 'rmail-default-dont-reply-to-names)
-	 (not (null rmail-default-dont-reply-to-names)))
-    (setq rmail-default-dont-reply-to-names "info-"))
-
-; rmail-dont-reply-to-names is defined in loaddefs
-(defun rmail-dont-reply-to (userids)
-  "Returns string of mail addresses USERIDS sans any recipients
-that start with matches for `rmail-dont-reply-to-names'.
-Usenet paths ending in an element that matches are removed also."
-  (if (null rmail-dont-reply-to-names)
-      (setq rmail-dont-reply-to-names
-	    (concat (if rmail-default-dont-reply-to-names
-			(concat rmail-default-dont-reply-to-names "\\|")
-		        "")
-		    (concat (regexp-quote (user-login-name))
-			    "\\>"))))
-  (let ((match (concat "\\(^\\|,\\)[ \t\n]*\\([^,\n]*!\\|\\)\\("
-		       rmail-dont-reply-to-names
-		       "\\|[^\,.<]*<\\(" rmail-dont-reply-to-names "\\)"
-		       "\\)"))
-	(case-fold-search t)
-	pos epos)
-    (setq foo match)
-    (while (setq pos (string-match match userids))
-      (if (> pos 0) (setq pos (match-beginning 2)))
-      (setq epos
-	    ;; Delete thru the next comma, plus whitespace after.
-	    (if (string-match ",[ \t\n]+" userids (match-end 0))
-		(match-end 0)
-	      (length userids)))
-      (setq userids
-	    (mail-string-delete
-	      userids pos epos)))
-    ;; get rid of any trailing commas
-    (if (setq pos (string-match "[ ,\t\n]*\\'" userids))
-	(setq userids (substring userids 0 pos)))
-    ;; remove leading spaces. they bother me.
-    (if (string-match "\\s *" userids)
-	(substring userids (match-end 0))
-      userids)))
-
-;;;###autoload
-(defun mail-fetch-field (field-name &optional last all)
-  "Return the value of the header field FIELD-NAME.
-The buffer is expected to be narrowed to just the headers of the message.
-If second arg LAST is non-nil, use the last such field if there are several.
-If third arg ALL is non-nil, concatenate all such fields with commas between."
-  (save-excursion
-    (goto-char (point-min))
-    (let ((case-fold-search t)
-	  (name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*")))
-      (if all
-	  (let ((value ""))
-	    (while (re-search-forward name nil t)
-	      (let ((opoint (point)))
-		(while (progn (forward-line 1)
-			      (looking-at "[ \t]")))
-		;; Back up over newline, then trailing spaces or tabs
-		(forward-char -1)
-		(skip-chars-backward " \t" opoint)
-		(setq value (concat value
-				    (if (string= value "") "" ", ")
-				    (buffer-substring-no-properties
-				     opoint (point))))))
-	    (and (not (string= value "")) value))
-	(if (re-search-forward name nil t)
-	    (progn
-	      (if last (while (re-search-forward name nil t)))
-	      (let ((opoint (point)))
-		(while (progn (forward-line 1)
-			      (looking-at "[ \t]")))
-		;; Back up over newline, then trailing spaces or tabs
-		(forward-char -1)
-		(skip-chars-backward " \t" opoint)
-		(buffer-substring-no-properties opoint (point)))))))))
-
-;; Parse a list of tokens separated by commas.
-;; It runs from point to the end of the visible part of the buffer.
-;; Whitespace before or after tokens is ignored,
-;; but whitespace within tokens is kept.
-(defun mail-parse-comma-list ()
-  (let (accumulated
-	beg)
-    (skip-chars-forward " ")
-    (while (not (eobp))
-      (setq beg (point))
-      (skip-chars-forward "^,")
-      (skip-chars-backward " ")
-      (setq accumulated
-	    (cons (buffer-substring beg (point))
-		  accumulated))
-      (skip-chars-forward "^,")
-      (skip-chars-forward ", "))
-    accumulated))
-
-(defun mail-comma-list-regexp (labels)
-  (let (pos)
-    (setq pos (or (string-match "[^ \t]" labels) 0))
-    ;; Remove leading and trailing whitespace.
-    (setq labels (substring labels pos (string-match "[ \t]*$" labels pos)))
-    ;; Change each comma to \|, and flush surrounding whitespace.
-    (while (setq pos (string-match "[ \t]*,[ \t]*" labels))
-      (setq labels
-	    (concat (substring labels 0 pos)
-		    "\\|"
-		    (substring labels (match-end 0))))))
-  labels)
-
-(defun mail-rfc822-time-zone (time)
-  (let* ((sec (or (car (current-time-zone time)) 0))
-	 (absmin (/ (abs sec) 60)))
-    (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
-
-(defun mail-rfc822-date ()
-  (let* ((time (current-time))
-	 (s (current-time-string time)))
-    (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s)
-    (concat (substring s (match-beginning 2) (match-end 2)) " "
-	    (substring s (match-beginning 1) (match-end 1)) " "
-	    (substring s (match-beginning 4) (match-end 4)) " "
-	    (substring s (match-beginning 3) (match-end 3)) " "
-	    (mail-rfc822-time-zone time))))
-
-(provide 'mail-utils)
-
-;;; mail-utils.el ends here
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
deleted file mode 100644
index e69e10cdf5f..00000000000
--- a/lisp/mail/mailabbrev.el
+++ /dev/null
@@ -1,576 +0,0 @@
-;;; mailabbrev.el --- abbrev-expansion of mail aliases.
-
-;; Copyright (C) 1985, 1986, 87, 92, 93, 1996 Free Software Foundation, Inc.
-
-;; Author: Jamie Zawinski <jwz@lucid.com>
-;; Maintainer: Jamie Zawinski <jwz@lucid.com>
-;; Created: 19 Oct 90
-;; Keywords: mail
-
-;; 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 ensures that, when the point is in a To:, CC:, BCC:, or From:
-;; field, word-abbrevs are defined for each of your mail aliases.  These
-;; aliases will be defined from your .mailrc file (or the file specified by
-;; the MAILRC environment variable) if it exists.  Your mail aliases will
-;; expand any time you type a word-delimiter at the end of an abbreviation.
-;;
-;; What you see is what you get: if mailabbrev is in use when you type
-;; a name, and the name does not expand, you know it is not an abbreviation.
-;; However, if you yank abbreviations into the headers
-;; in a way that bypasses the check for abbreviations,
-;; they are expanded (but not visibly) when you send the message.
-;;
-;; Your mail alias abbrevs will be in effect only when the point is in an
-;; appropriate header field.  When in the body of the message, or other
-;; header fields, the mail aliases will not expand.  Rather, the normal
-;; mode-specific abbrev table (mail-mode-abbrev-table) will be used if
-;; defined.  So if you use mail-mode specific abbrevs, this code will not
-;; adversely affect you.  You can control which header fields the abbrevs
-;; are used in by changing the variable mail-abbrev-mode-regexp.
-;;
-;; If auto-fill mode is on, abbrevs will wrap at commas instead of at word
-;; boundaries; also, header continuation-lines will be properly indented.
-;;
-;; You can also insert a mail alias with mail-interactive-insert-alias
-;; (bound to C-c C-a), which prompts you for an alias (with completion)
-;; and inserts its expansion at point.
-;;
-;; This file fixes a bug in the old system which prohibited your .mailrc
-;; file from having lines like
-;;
-;;     alias someone "John Doe <doe@quux.com>"
-;;
-;; That is, if you want an address to have embedded spaces, simply surround it
-;; with double-quotes.  This is necessary because the format of the .mailrc
-;; file bogusly uses spaces as address delimiters.  The following line defines
-;; an alias which expands to three addresses:
-;;
-;;     alias foobar addr-1 addr-2 "address three <addr-3>"
-;;
-;; (This is bogus because mail-delivery programs want commas, not spaces,
-;; but that's what the file format is, so we have to live with it.)
-;;
-;; If you like, you can call the function define-mail-abbrev to define your
-;; mail aliases instead of using a .mailrc file.  When you call it in this
-;; way, addresses are separated by commas.
-;;
-;; CAVEAT: This works on most Sun systems; I have been told that some versions
-;; of /bin/mail do not understand double-quotes in the .mailrc file.  So you
-;; should make sure your version does before including verbose addresses like
-;; this.  One solution to this, if you are on a system whose /bin/mail doesn't
-;; work that way, (and you still want to be able to /bin/mail to send mail in
-;; addition to emacs) is to define minimal aliases (without full names) in
-;; your .mailrc file, and use define-mail-abbrev to redefine them when sending
-;; mail from emacs; this way, mail sent from /bin/mail will work, and mail
-;; sent from emacs will be pretty.
-;;
-;; Aliases in the mailrc file may be nested.  If you define aliases like
-;;     alias group1 fred ethel
-;;     alias group2 larry curly moe
-;;     alias everybody group1 group2
-;; Then when you type "everybody" on the To: line, it will be expanded to
-;;     fred, ethyl, larry, curly, moe
-;;
-;; Aliases may also contain forward references; the alias of "everybody" can
-;; precede the aliases of "group1" and "group2".
-;;
-;; This code also understands the "source" .mailrc command, for reading
-;; aliases from some other file as well.
-;;
-;; Aliases may contain hyphens, as in "alias foo-bar foo@bar"; word-abbrevs
-;; normally cannot contain hyphens, but this code works around that for the
-;; specific case of mail-alias word-abbrevs.
-;;
-;; To read in the contents of another .mailrc-type file from emacs, use the
-;; command Meta-X merge-mail-abbrevs.  The rebuild-mail-abbrevs command is
-;; similar, but will delete existing aliases first.
-;;
-;; If you would like your aliases to be expanded when you type M-> or ^N to
-;; move out of the mail-header into the message body (instead of having to
-;; type SPC at the end of the abbrev before moving away) then you can do
-;;
-;;  (add-hook
-;;   'mail-setup-hook
-;;   '(lambda ()
-;;      (substitute-key-definition 'next-line 'mail-abbrev-next-line
-;;				 mail-mode-map global-map)
-;;      (substitute-key-definition 'end-of-buffer 'mail-abbrev-end-of-buffer
-;;				 mail-mode-map global-map)))
-;;
-;; If you want multiple addresses separated by a string other than ", " then
-;; you can set the variable mail-alias-separator-string to it.  This has to
-;; be a comma bracketed by whitespace if you want any kind of reasonable
-;; behaviour.
-;;
-;; Thanks to Harald Hanche-Olsen, Michael Ernst, David Loeffler, and
-;; Noah Friedman for suggestions and bug reports.
-
-;; To use this package, do (add-hook 'mail-setup-hook 'mail-abbrevs-setup).
-
-;;; Code:
-
-(require 'sendmail)
-
-;; originally defined in sendmail.el - used to be an alist, now is a table.
-(defvar mail-abbrevs nil
-  "Word-abbrev table of mail address aliases.
-If this is nil, it means the aliases have not yet been initialized and
-should be read from the .mailrc file.  (This is distinct from there being
-no aliases, which is represented by this being a table with no entries.)")
-
-(defvar mail-abbrev-modtime nil
-  "The modification time of your mail alias file when it was last examined.")
-
-(defun mail-abbrevs-sync-aliases ()
-  (if (file-exists-p mail-personal-alias-file)
-      (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
-	(if (not (equal mail-abbrev-modtime modtime))
-	    (progn
-	      (setq mail-abbrev-modtime modtime)
-	      (build-mail-abbrevs))))))
-
-;;;###autoload
-(defun mail-abbrevs-setup ()
-  "Initialize use of the `mailabbrev' package."
-  (if (and (not (vectorp mail-abbrevs))
-	   (file-exists-p mail-personal-alias-file))
-      (progn
-	(setq mail-abbrev-modtime
-	      (nth 5 (file-attributes mail-personal-alias-file)))
-	(build-mail-abbrevs)))
-  (mail-abbrevs-sync-aliases)
-  (make-local-hook 'pre-abbrev-expand-hook)
-  (add-hook 'pre-abbrev-expand-hook 'sendmail-pre-abbrev-expand-hook
-	    nil t)
-  (abbrev-mode 1))
-
-;;;###autoload
-(defun build-mail-abbrevs (&optional file recursivep)
-  "Read mail aliases from personal mail alias file and set `mail-abbrevs'.
-By default this is the file specified by `mail-personal-alias-file'."
-  (setq file (expand-file-name (or file mail-personal-alias-file)))
-  (if (vectorp mail-abbrevs)
-      nil
-    (setq mail-abbrevs nil)
-    (define-abbrev-table 'mail-abbrevs '()))
-  (message "Parsing %s..." file)
-  (let ((buffer nil)
-	(obuf (current-buffer)))
-    (unwind-protect
-	(progn
-	  (setq buffer (generate-new-buffer "mailrc"))
-	  (buffer-disable-undo buffer)
-	  (set-buffer buffer)
-	  (cond ((get-file-buffer file)
-		 (insert (save-excursion
-			   (set-buffer (get-file-buffer file))
-			   (buffer-substring (point-min) (point-max)))))
-		((not (file-exists-p file)))
-		(t (insert-file-contents file)))
-	  ;; Don't lose if no final newline.
-	  (goto-char (point-max))
-	  (or (eq (preceding-char) ?\n) (newline))
-	  (goto-char (point-min))
-	  ;; Delete comments from the file
-	  (while (search-forward "# " nil t)
-	    (let ((p (- (point) 2)))
-	      (end-of-line)
-	      (delete-region p (point))))
-	  (goto-char (point-min))
-	  ;; handle "\\\n" continuation lines
-	  (while (not (eobp))
-	    (end-of-line)
-	    (if (= (preceding-char) ?\\)
-		(progn (delete-char -1) (delete-char 1) (insert ?\ ))
-	        (forward-char 1)))
-	  (goto-char (point-min))
-	  (while (re-search-forward
-		  "^\\(a\\(lias\\)?\\|g\\(roup\\)?\\|source\\)[ \t]+" nil t)
-	    (beginning-of-line)
-	    (if (looking-at "source[ \t]+\\([^ \t\n]+\\)")
-		(progn
-		  (end-of-line)
-		  (build-mail-abbrevs
-		   (substitute-in-file-name
-		    (buffer-substring (match-beginning 1) (match-end 1)))
-		   t))
-	      (re-search-forward "[ \t]+\\([^ \t\n]+\\)")
-	      (let* ((name (buffer-substring
-			    (match-beginning 1) (match-end 1)))
-		     (start (progn (skip-chars-forward " \t") (point))))
-		(end-of-line)
-;		(message "** %s \"%s\"" name (buffer-substring start (point)))(sit-for 1)
-		(define-mail-abbrev
-		    name
-		    (buffer-substring start (point))
-		    t))))
-	  ;; Resolve forward references in .mailrc file.
-	  ;; This would happen automatically before the first abbrev was
-	  ;; expanded, but why not do it now.
-	  (or recursivep (mail-resolve-all-aliases))
-	  mail-abbrevs)
-      (if buffer (kill-buffer buffer))
-      (set-buffer obuf)))
-    (message "Parsing %s... done" file))
-
-(defvar mail-alias-separator-string ", "
-  "*A string inserted between addresses in multi-address mail aliases.
-This has to contain a comma, so \", \" is a reasonable value.  You might
-also want something like \",\\n    \" to get each address on its own line.")
-
-;; define-mail-abbrev sets this flag, which causes mail-resolve-all-aliases
-;; to be called before expanding abbrevs if it's necessary.
-(defvar mail-abbrev-aliases-need-to-be-resolved t)
-
-;; originally defined in mailalias.el ; build-mail-abbrevs calls this with
-;; stuff parsed from the .mailrc file.
-;;
-;;;###autoload
-(defun define-mail-abbrev (name definition &optional from-mailrc-file)
-  "Define NAME as a mail alias abbrev that translates to DEFINITION.
-If DEFINITION contains multiple addresses, separate them with commas."
-  ;; When this is called from build-mail-abbrevs, the third argument is
-  ;; true, and we do some evil space->comma hacking like /bin/mail does.
-  (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
-  ;; Read the defaults first, if we have not done so.
-  (if (vectorp mail-abbrevs)
-      nil
-    (setq mail-abbrevs nil)
-    (define-abbrev-table 'mail-abbrevs '())
-    (if (file-exists-p mail-personal-alias-file)
-	(build-mail-abbrevs)))
-  ;; strip garbage from front and end
-  (if (string-match "\\`[ \t\n,]+" definition)
-      (setq definition (substring definition (match-end 0))))
-  (if (string-match "[ \t\n,]+\\'" definition)
-      (setq definition (substring definition 0 (match-beginning 0))))
-  (let* ((result '())
-	 (L (length definition))
-	 (start (if (> L 0) 0))
-	 end)
-    (while start
-      ;; If we're reading from the mailrc file, then addresses are delimited
-      ;; by spaces, and addresses with embedded spaces must be surrounded by
-      ;; double-quotes.  Otherwise, addresses are separated by commas.
-      (if from-mailrc-file
-	  (if (eq ?\" (aref definition start))
-	      (setq start (1+ start)
-		    end (string-match "\"[ \t,]*" definition start))
-	    (setq end (string-match "[ \t,]+" definition start)))
-	(setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start)))
-      (setq result (cons (substring definition start end) result))
-      (setq start (and end
-		       (/= (match-end 0) L)
-		       (match-end 0))))
-    (setq definition (mapconcat (function identity)
-				(nreverse result)
-				mail-alias-separator-string)))
-  (setq mail-abbrev-aliases-need-to-be-resolved t)
-  (setq name (downcase name))
-  ;; use an abbrev table instead of an alist for mail-abbrevs.
-  (let ((abbrevs-changed abbrevs-changed))  ; protect this from being changed.
-    (define-abbrev mail-abbrevs name definition 'mail-abbrev-expand-hook)))
-
-
-(defun mail-resolve-all-aliases ()
-  "Resolve all forward references in the mail aliases table."
-  (if mail-abbrev-aliases-need-to-be-resolved
-      (progn
-;;	(message "Resolving mail aliases...")
-	(if (vectorp mail-abbrevs)
-	    (mapatoms (function mail-resolve-all-aliases-1) mail-abbrevs))
-	(setq mail-abbrev-aliases-need-to-be-resolved nil)
-;;	(message "Resolving mail aliases... done.")
-	)))
-
-(defun mail-resolve-all-aliases-1 (sym &optional so-far)
-  (if (memq sym so-far)
-      (error "mail alias loop detected: %s"
-	     (mapconcat 'symbol-name (cons sym so-far) " <- ")))
-  (let ((definition (and (boundp sym) (symbol-value sym))))
-    (if definition
-	(let ((result '())
-	      (start 0))
-	  (while start
-	    (let ((end (string-match "[ \t\n]*,[, \t\n]*" definition start)))
-	      (setq result (cons (substring definition start end) result)
-		    start (and end (match-end 0)))))
-	  (setq definition
-		(mapconcat (function (lambda (x)
-			     (or (mail-resolve-all-aliases-1
-				   (intern-soft (downcase x) mail-abbrevs)
-				   (cons sym so-far))
-				 x)))
-			   (nreverse result)
-			   mail-alias-separator-string))
-	  (set sym definition))))
-  (symbol-value sym))
-
-
-(defun mail-abbrev-expand-hook ()
-  "For use as the fourth arg to `define-abbrev'.
-After expanding a mail-abbrev, if Auto Fill mode is on and we're past the
-fill-column, break the line at the previous comma, and indent the next line."
-  ;; Disable abbrev mode to avoid recursion in indent-relative expanding
-  ;; part of the abbrev expansion as an abbrev itself.
-  (let ((abbrev-mode nil))
-    (save-excursion
-      (let ((p (point))
-	    bol comma fp)
-	(beginning-of-line)
-	(setq bol (point))
-	(goto-char p)
-	(while (and auto-fill-function
-		    (>= (current-column) fill-column)
-		    (search-backward "," bol t))
-	  (setq comma (point))
-	  (forward-char 1)		; Now we are just past the comma.
-	  (insert "\n")
-	  (delete-horizontal-space)
-	  (setq p (point))
-	  (indent-relative)
-	  (setq fp (buffer-substring p (point)))
-	  ;; Go to the end of the new line.
-	  (end-of-line)
-	  (if (> (current-column) fill-column)
-	      ;; It's still too long; do normal auto-fill.
-	      (let ((fill-prefix (or fp "\t")))
-		(do-auto-fill)))
-	  ;; Resume the search.
-	  (goto-char comma)
-	  )))))
-
-;;; Syntax tables and abbrev-expansion
-
-(defvar mail-abbrev-mode-regexp
-  "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):"
-  "*Regexp to select mail-headers in which mail abbrevs should be expanded.
-This string will be handed to `looking-at' with point at the beginning
-of the current line; if it matches, abbrev mode will be turned on, otherwise
-it will be turned off.  (You don't need to worry about continuation lines.)
-This should be set to match those mail fields in which you want abbreviations
-turned on.")
-
-(defvar mail-mode-header-syntax-table
-  (let ((tab (copy-syntax-table text-mode-syntax-table)))
-    ;; This makes the characters "@%!._-" be considered symbol-constituents
-    ;; but not word-constituents, so forward-sexp will move you over an
-    ;; entire address, but forward-word will only move you over a sequence
-    ;; of alphanumerics.  (Clearly the right thing.)
-    (modify-syntax-entry ?@ "_" tab)
-    (modify-syntax-entry ?% "_" tab)
-    (modify-syntax-entry ?! "_" tab)
-    (modify-syntax-entry ?. "_" tab)
-    (modify-syntax-entry ?_ "_" tab)
-    (modify-syntax-entry ?- "_" tab)
-    (modify-syntax-entry ?< "(>" tab)
-    (modify-syntax-entry ?> ")<" tab)
-    tab)
-  "The syntax table used in send-mail mode when in a mail-address header.
-`mail-mode-syntax-table' is used when the cursor is in the message body or in
-non-address headers.")
-
-(defvar mail-abbrev-syntax-table
-  (let* ((tab (copy-syntax-table mail-mode-header-syntax-table))
-	 (_ (aref (standard-syntax-table) ?_))
-	 (w (aref (standard-syntax-table) ?w)))
-    (map-char-table
-     (function (lambda (key value)
-		 (if (equal value _)
-		     (set-char-table-range tab key w))))
-     tab)
-    tab)
-  "The syntax-table used for abbrev-expansion purposes.
-This is not actually made the current syntax table of the buffer, but
-simply controls the set of characters which may be a part of the name
-of a mail alias.")
-
-
-(defun mail-abbrev-in-expansion-header-p ()
-  "Whether point is in a mail-address header field."
-  (let ((case-fold-search t))
-    (and ;;
-         ;; we are on an appropriate header line...
-     (save-excursion
-       (beginning-of-line)
-       ;; skip backwards over continuation lines.
-       (while (and (looking-at "^[ \t]")
-		   (not (= (point) (point-min))))
-	 (forward-line -1))
-       ;; are we at the front of an appropriate header line?
-       (looking-at mail-abbrev-mode-regexp))
-     ;;
-     ;; ...and we are before the mail-header-separator
-     (< (point)
-	(save-excursion
-	  (goto-char (point-min))
-	  (search-forward (concat "\n" mail-header-separator "\n")
-			  nil 0)
-	  (point))))))
-
-(defvar mail-mode-abbrev-table) ; quiet the compiler
-
-(defun sendmail-pre-abbrev-expand-hook ()
-  (and (and mail-abbrevs (not (eq mail-abbrevs t)))
-       (if (mail-abbrev-in-expansion-header-p)
-	   (progn
-	     ;;
-	     ;; We are in a To: (or CC:, or whatever) header, and
-	     ;; should use word-abbrevs to expand mail aliases.
-
-	     ;; Before anything else, resolve aliases if they need it.
-	     (and mail-abbrev-aliases-need-to-be-resolved
-		  (mail-resolve-all-aliases))
-
-	     ;; Now proceed with the abbrev section.
-	     ;;   -  First, install the mail-abbrevs as the word-abbrev table.
-	     ;;   -  Then install the mail-abbrev-syntax-table, which
-	     ;;      temporarily marks all of the
-	     ;;      non-alphanumeric-atom-characters (the "_"
-	     ;;      syntax ones) as being normal word-syntax.  We do this
-	     ;;      because the C code for expand-abbrev only works on words,
-	     ;;      and we want these characters to be considered words for
-	     ;;      the purpose of abbrev expansion.
-	     ;;   -  Then we call expand-abbrev again, recursively, to do
-	     ;;      the abbrev expansion with the above syntax table.
-	     ;;   -  Then we do a trick which tells the expand-abbrev frame
-	     ;;      which invoked us to not continue (and thus not
-	     ;;      expand twice.) This means that any abbrev expansion
-	     ;;      will happen as a result of this function's call to
-	     ;;      expand-abbrev, and not as a result of the call to
-	     ;;      expand-abbrev which invoked *us*.
-	     ;;   -  Then we set the syntax table to
-	     ;;      mail-mode-header-syntax-table, which doesn't have
-	     ;;      anything to do with abbrev expansion, but
-	     ;;      is just for the user's convenience (see its doc string.)
-	     ;;
-
-	     (setq local-abbrev-table mail-abbrevs)
-
-	     ;; If the character just typed was non-alpha-symbol-syntax,
-	     ;; then don't expand the abbrev now (that is, don't expand
-	     ;; when the user types -.)  Check the character's syntax in
-	     ;; the mail-mode-header-syntax-table.
-
-	     (set-syntax-table mail-mode-header-syntax-table)
-	     (or (and (integerp last-command-char)
-		      (eq (char-syntax last-command-char) ?_))
-		 (let ((pre-abbrev-expand-hook nil)) ; That's us; don't loop.
-		   ;; Use this table so that abbrevs can have hyphens in them.
-		   (set-syntax-table mail-abbrev-syntax-table)
-		   (expand-abbrev)
-		   ;; Now set it back to what it was before.
-		   (set-syntax-table mail-mode-header-syntax-table)))
-	     (setq abbrev-start-location (point-max) ; This is the trick.
-		   abbrev-start-location-buffer (current-buffer)))
-
-	 ;; We're not in a mail header where mail aliases should
-	 ;; be expanded, then use the normal mail-mode abbrev table
-	 ;; (if any) and the normal mail-mode syntax table.
-
-	 (setq local-abbrev-table (and (boundp 'mail-mode-abbrev-table)
-				       mail-mode-abbrev-table))
-	 (set-syntax-table mail-mode-syntax-table))
-       ))
-
-;;; utilities
-
-(defun merge-mail-abbrevs (file)
-  "Merge mail aliases from the given file with existing ones."
-  (interactive (list
-		(let ((insert-default-directory t)
-		      (default-directory (expand-file-name "~/"))
-		      (def mail-personal-alias-file))
-		  (read-file-name
-		    (format "Read additional aliases from file: (default %s) "
-			    def)
-		    default-directory
-		    (expand-file-name def default-directory)
-		    t))))
-  (build-mail-abbrevs file))
-
-(defun rebuild-mail-abbrevs (&optional file)
-  "Rebuild all the mail aliases from the given file."
-  (interactive (list
-		(let ((insert-default-directory t)
-		      (default-directory (expand-file-name "~/"))
-		      (def mail-personal-alias-file))
-		  (read-file-name
-		   (format "Read mail aliases from file: (default %s) " def)
-		   default-directory
-		   (expand-file-name def default-directory)
-		   t))))
-  (if (null file)
-      (setq file buffer-file-name))
-  (setq mail-abbrevs nil)
-  (build-mail-abbrevs file))
-
-(defun mail-interactive-insert-alias (&optional alias)
-  "Prompt for and insert a mail alias."
-  (interactive (progn
-		(if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
-		(list (completing-read "Expand alias: " mail-abbrevs nil t))))
-  (if (not (vectorp mail-abbrevs)) (mail-abbrevs-setup))
-  (insert (or (and alias (symbol-value (intern-soft alias mail-abbrevs))) ""))
-  (mail-abbrev-expand-hook))
-
-(defun mail-abbrev-next-line (&optional arg)
-  "Expand any mail abbrev, then move cursor vertically down ARG lines.
-If there is no character in the target line exactly under the current column,
-the cursor is positioned after the character in that line which spans this
-column, or at the end of the line if it is not long enough.
-If there is no line in the buffer after this one,
-a newline character is inserted to create a line
-and the cursor moves to that line.
-
-The command \\[set-goal-column] can be used to create
-a semipermanent goal column to which this command always moves.
-Then it does not try to move vertically.  This goal column is stored
-in `goal-column', which is nil when there is none.
-
-If you are thinking of using this in a Lisp program, consider
-using `forward-line' instead.  It is usually easier to use
-and more reliable (no dependence on goal column, etc.)."
-  (interactive "p")
-  (if (looking-at "[ \t]*\n") (expand-abbrev))
-  (setq this-command 'next-line)
-  (next-line arg))
-
-(defun mail-abbrev-end-of-buffer (&optional arg)
-  "Expand any mail abbrev, then move point to end of buffer.
-Leave mark at previous position.
-With arg N, put point N/10 of the way from the true end.
-
-Don't use this command in Lisp programs!
-\(goto-char (point-max)) is faster and avoids clobbering the mark."
-  (interactive "P")
-  (if (looking-at "[ \t]*\n") (expand-abbrev))
-  (setq this-command 'end-of-buffer)
-  (end-of-buffer arg))
-
-(define-key mail-mode-map "\C-c\C-a" 'mail-interactive-insert-alias)
-
-;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line)
-;;(define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer)
-
-(provide 'mailabbrev)
-
-;;; mailabbrev.el ends here.
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
deleted file mode 100644
index 0969f50ae29..00000000000
--- a/lisp/mail/mailalias.el
+++ /dev/null
@@ -1,441 +0,0 @@
-;;; mailalias.el --- expand and complete mailing address aliases
-
-;; Copyright (C) 1985, 1987, 1995, 1996 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; 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:
-
-;; Basic functions for defining and expanding mail aliases.
-;; These seal off the interface to the alias-definition parts of a
-;; .mailrc file formatted for BSD's Mail or USL's mailx.
-
-;;; Code:
-
-(require 'sendmail)
-
-(defvar mail-names t
-  "Alist of local users, aliases and directory entries as available.
-When t this still needs to be initialized.
-This is the basis for `mail-complete'.")
-
-(defvar mail-local-names t
-  "Alist of local users.
-When t this still needs to be initialized.")
-
-(defvar mail-directory-names t
-  "Alist of mail address directory entries.
-When t this still needs to be initialized.")
-
-(defvar mail-address-field-regexp
-  "^\\(Resent-\\)?\\(To\\|From\\|CC\\|BCC\\|Reply-to\\):")
-
-(defvar mail-complete-alist
-  `((,mail-address-field-regexp mail-get-names pattern)
-    ("Newsgroups:" . (if (boundp 'gnus-active-hashtb)
-			 gnus-active-hashtb
-		       (if (boundp news-group-article-assoc)
-			   news-group-article-assoc)))
-    ("Followup-To:" . (mail-sentto-newsgroups))
-    ;;("Distribution:" ???)
-    )
-  "Alist of header field and expression to return alist for completion.
-Expression may reference variable `pattern' which is the string being completed.
-If not on matching header, `mail-complete-function' gets called instead.")
-
-(defvar mail-complete-function 'ispell-complete-word
-  "Function to call when completing outside `mail-complete-alist'-header.")
-
-
-(defvar mail-directory-function nil
-  "Function to get completions from directory service or `nil' for none.
-See `mail-directory-requery'.")
-
-
-;; This is for when the directory is huge, or changes frequently.
-(defvar mail-directory-requery nil
-  "When non-`nil' call `mail-directory-function' for each completion.
-In that case, one argument gets passed to the function, the partial string
-entered so far.")
-
-
-(defvar mail-directory-process nil
-  "Unix command when `mail-directory-function' is `mail-directory-process'.
-This is a list of the form (COMMAND ARG ...), where each of the list elements
-is evaluated.  When `mail-directory-requery' is non-`nil', during
-evaluation the variable `pattern' contains the partial input being completed.
-This might look like
-
-  '(remote-shell-program \"HOST\" \"-nl\" \"USER\" \"COMMAND\")
-
-or
-
-  '(remote-shell-program \"HOST\" \"-n\" \"COMMAND '^\" pattern \"'\")")
-
-(defvar mail-directory-stream ()
-  "List of (HOST SERVICE) for stream connection to mail directory.")
-
-(defvar mail-directory-parser nil
-  "How to interpret the output of `mail-directory-function'.
-Three types of values are possible:
-
-  - nil means to gather each line as one name
-  - regexp means first \\(grouping\\) in successive matches is name
-  - function called at beginning of buffer that returns an alist of names")
-
-
-;; Called from sendmail-send-it, or similar functions,
-;; only if some mail aliases are defined.
-(defun expand-mail-aliases (beg end &optional exclude)
-  "Expand all mail aliases in suitable header fields found between BEG and END.
-Suitable header fields are `To', `From', `CC' and `BCC', `Reply-to', and
-their `Resent-' variants.
-
-Optional second arg EXCLUDE may be a regular expression defining text to be
-removed from alias expansions."
-  (sendmail-sync-aliases)
-  (if (eq mail-aliases t)
-      (progn (setq mail-aliases nil) (build-mail-aliases)))
-  (goto-char beg)
-  (setq end (set-marker (make-marker) end))
-  (let ((case-fold-search nil))
-    (while (let ((case-fold-search t))
-	     (re-search-forward mail-address-field-regexp end t))
-      (skip-chars-forward " \t")
-      (let ((beg1 (point))
-	    end1 pos epos seplen
-	    ;; DISABLED-ALIASES records aliases temporarily disabled
-	    ;; while we scan text that resulted from expanding those aliases.
-	    ;; Each element is (ALIAS . TILL-WHEN), where TILL-WHEN
-	    ;; is where to reenable the alias (expressed as number of chars
-	    ;; counting from END1).
-	    (disabled-aliases nil))
-	(re-search-forward "^[^ \t]" end 'move)
-	(beginning-of-line)
-	(skip-chars-backward " \t\n")
-	(setq end1 (point-marker))
-	(goto-char beg1)
-	(while (< (point) end1)
-	  (setq pos (point))
-	  ;; Reenable any aliases which were disabled for ranges
-	  ;; that we have passed out of.
-	  (while (and disabled-aliases (> pos (- end1 (cdr (car disabled-aliases)))))
-	    (setq disabled-aliases (cdr disabled-aliases)))
-	  ;; EPOS gets position of end of next name;
-	  ;; SEPLEN gets length of whitespace&separator that follows it.
-	  (if (re-search-forward "[ \t]*[\n,][ \t]*" end1 t)
-	      (setq epos (match-beginning 0)
-		    seplen (- (point) epos))
-	    (setq epos (marker-position end1) seplen 0))
-	  (let (translation
-		(string (buffer-substring-no-properties pos epos)))
-	    (if (and (not (assoc string disabled-aliases))
-		     (setq translation
-			   (cdr (assoc string mail-aliases))))
-		(progn
-		  ;; This name is an alias.  Disable it.
-		  (setq disabled-aliases (cons (cons string (- end1 epos))
-					       disabled-aliases))
-		  ;; Replace the alias with its expansion
-		  ;; then rescan the expansion for more aliases.
-		  (goto-char pos)
-		  (insert translation)
-		  (if exclude
- 		      (let ((regexp
-			     (concat "\\b\\(" exclude "\\)\\b"))
-			    (end (point-marker)))
-			(goto-char pos)
-			(while (re-search-forward regexp end t)
-			  (replace-match ""))
-			(goto-char end)))
-		  (delete-region (point) (+ (point) (- epos pos)))
-		  (goto-char pos))
-	      ;; Name is not an alias.  Skip to start of next name.
-	      (goto-char epos)
-	      (forward-char seplen))))
-	(set-marker end1 nil)))
-    (set-marker end nil)))
-
-;; Called by mail-setup, or similar functions, only if the file specified
-;; by mail-personal-alias-file (usually `~/.mailrc') exists.
-(defun build-mail-aliases (&optional file)
-  "Read mail aliases from personal aliases file and set `mail-aliases'.
-By default, this is the file specified by `mail-personal-alias-file'."
-  (setq file (expand-file-name (or file mail-personal-alias-file)))
-  (let ((buffer nil)
-	(obuf (current-buffer)))
-    (unwind-protect
-	(progn
-	  (setq buffer (generate-new-buffer " mailrc"))
-	  (set-buffer buffer)
-	  (while file
-	    (cond ((get-file-buffer file)
-		   (insert (save-excursion
-			     (set-buffer (get-file-buffer file))
-			     (buffer-substring-no-properties
-			      (point-min) (point-max)))))
-		  ((file-exists-p file) (insert-file-contents file))
-		  ((file-exists-p (setq file (concat "~/" file)))
-		   (insert-file-contents file))
-		  (t (setq file nil)))
-	    ;; Don't lose if no final newline.
-	    (goto-char (point-max))
-	    (or (eq (preceding-char) ?\n) (newline))
-	    (goto-char (point-min))
-	    ;; handle "\\\n" continuation lines
-	    (while (not (eobp))
-	      (end-of-line)
-	      (if (= (preceding-char) ?\\)
-		  (progn (delete-char -1) (delete-char 1) (insert ?\ ))
-	        (forward-char 1)))
-	    (goto-char (point-min))
-	    ;; handle `source' directives -- Eddy/1994/May/25
-	    (cond ((re-search-forward "^source[ \t]+" nil t)
-		   (re-search-forward "\\S-+")
-		   (setq file (buffer-substring-no-properties
-			       (match-beginning 0) (match-end 0)))
-		   (beginning-of-line)
-		   (insert "# ") ; to ensure we don't re-process this file
-		   (beginning-of-line))
-		  (t (setq file nil))))
-	  (goto-char (point-min))
-	  (while (re-search-forward
-		  "^\\(a\\|alias\\|g\\|group\\)[ \t]+\\([^ \t]+\\)" nil t)
-	    (let* ((name (match-string 2))
-		   (start (progn (skip-chars-forward " \t") (point))))
-	      (end-of-line)
-	      (define-mail-alias
-		name
-		(buffer-substring-no-properties start (point))
-		t)))
-	  mail-aliases)
-      (if buffer (kill-buffer buffer))
-      (set-buffer obuf))))
-
-;; Always autoloadable in case the user wants to define aliases
-;; interactively or in .emacs.
-;;;###autoload
-(defun define-mail-alias (name definition &optional from-mailrc-file)
-  "Define NAME as a mail alias that translates to DEFINITION.
-This means that sending a message to NAME will actually send to DEFINITION.
-
-Normally, the addresses in DEFINITION must be separated by commas.
-If FROM-MAILRC-FILE is non-nil, then addresses in DEFINITION 
-can be separated by spaces; an address can contain spaces
-if it is quoted with double-quotes."
-
-  (interactive "sDefine mail alias: \nsDefine %s as mail alias for: ")
-  ;; Read the defaults first, if we have not done so.
-  (sendmail-sync-aliases)
-  (if (eq mail-aliases t)
-      (progn
-	(setq mail-aliases nil)
-	(if (file-exists-p mail-personal-alias-file)
-	    (build-mail-aliases))))
-  ;; strip garbage from front and end
-  (if (string-match "\\`[ \t\n,]+" definition)
-      (setq definition (substring definition (match-end 0))))
-  (if (string-match "[ \t\n,]+\\'" definition)
-      (setq definition (substring definition 0 (match-beginning 0))))
-  (let ((result '())
-	;; If DEFINITION is null string, avoid looping even once.
-	(start (and (not (equal definition "")) 0))
-	(L (length definition))
-	end tem)
-    (while start
-      ;; If we're reading from the mailrc file, then addresses are delimited
-      ;; by spaces, and addresses with embedded spaces must be surrounded by
-      ;; double-quotes.  Otherwise, addresses are separated by commas.
-      (if from-mailrc-file
-	  (if (eq ?\" (aref definition start))
-	      (setq start (1+ start)
-		    end (string-match "\"[ \t,]*" definition start))
-	    (setq end (string-match "[ \t,]+" definition start)))
-	(setq end (string-match "[ \t\n,]*,[ \t\n,]*" definition start)))
-      (setq result (cons (substring definition start end) result))
-      (setq start (and end
-		       (/= (match-end 0) L)
-		       (match-end 0))))
-    (setq definition (mapconcat (function identity)
-				(nreverse result)
-				", "))
-    (setq tem (assoc name mail-aliases))
-    (if tem
-	(rplacd tem definition)
-      (setq mail-aliases (cons (cons name definition) mail-aliases)
-	    mail-names t))))
-
-;;;###autoload
-(defun mail-complete (arg)
-  "Perform completion on header field or word preceding point.
-Completable headers are according to `mail-complete-alist'.  If none matches
-current header, calls `mail-complete-function' and passes prefix arg if any."
-  (interactive "P")
-  ;; Read the defaults first, if we have not done so.
-  (sendmail-sync-aliases)
-  (if (eq mail-aliases t)
-      (progn
-	(setq mail-aliases nil)
-	(if (file-exists-p mail-personal-alias-file)
-	    (build-mail-aliases))))
-  (let ((list mail-complete-alist))
-    (if (and (save-excursion (search-forward
-			      (concat "\n" mail-header-separator "\n")
-			      nil t))
-	     (save-excursion
-	       (if (re-search-backward "^[^\t]" nil t)
-		   (while list
-		     (if (looking-at (car (car list)))
-			 (setq arg (cdr (car list))
-			       list ())
-		       (setq list (cdr list)))))
-	       arg))
-	(let* ((end (point))
-	       (beg (save-excursion
-		      (skip-chars-backward "^ \t<,:")
-		      (point)))
-	       (pattern (buffer-substring beg end))
-	       completion)
-	  (setq list (eval arg)
-		completion (try-completion pattern list))
-	  (cond ((eq completion t))
-		((null completion)
-		 (message "Can't find completion for \"%s\"" pattern)
-		 (ding))
-		((not (string= pattern completion))
-		 (delete-region beg end)
-		 (insert completion))
-		(t
-		 (message "Making completion list...")
-		 (with-output-to-temp-buffer "*Completions*"
-		   (display-completion-list
-		    (all-completions pattern list)))
-		 (message "Making completion list...%s" "done"))))
-      (funcall mail-complete-function arg))))
-
-(defun mail-get-names (pattern)
-  "Fetch local users and global mail adresses for completion.
-Consults `/etc/passwd' and a directory service if one is set up via
-`mail-directory-function'."
-  (if (eq mail-local-names t)
-      (save-excursion
-	(set-buffer (generate-new-buffer " passwd"))
-	(insert-file-contents "/etc/passwd" nil nil nil t)
-	(setq mail-local-names)
-	(while (not (eobp))
-	  ;;Recognize lines like
-	  ;;  nobody:*:65534:65534::/:
-	  ;;  +demo::::::/bin/csh
-	  ;;  +ethanb
-	  ;;while skipping
-	  ;;  +@SOFTWARE
-	  (if (looking-at "\\+?\\([^:@\n+]+\\)")
-	      (add-to-list 'mail-local-names (list (match-string 1))))
-	  (beginning-of-line 2))
-	(kill-buffer (current-buffer))))
-  (if (or (eq mail-names t)
-		(eq mail-directory-names t))
-      (let (directory)
-	(and mail-directory-function
-	     (eq mail-directory-names t)
-	     (setq directory
-		   (mail-directory (if mail-directory-requery pattern))))
-	(if (or directory
-		(eq mail-names t))
-	    (setq mail-names
-		  (sort (append (if (consp mail-aliases) mail-aliases)
-				(if (consp mail-local-names)
-				    mail-local-names)
-				directory)
-			(lambda (a b)
-			  ;; should cache downcased strings
-			  (string< (downcase (car a))
-				   (downcase (car b)))))))
-	(or mail-directory-requery
-	    (setq mail-directory-names directory))))
-  mail-names)
-
-
-(defun mail-directory (pattern)
-  "Call directory to get names matching PATTERN or all if `nil'.
-Calls `mail-directory-function' and applies `mail-directory-parser' to output."
-  (save-excursion
-    (message "Querying directory...")
-    (set-buffer (generate-new-buffer " *mail-directory*"))
-    (funcall mail-directory-function pattern)
-    (goto-char 1)
-    (let (directory)
-      (if (stringp mail-directory-parser)
-	  (while (re-search-forward mail-directory-parser nil t)
-	    (setq directory
-		  `((,(match-string 1))
-		    ,@directory)))
-	(if mail-directory-parser
-	    (setq directory (funcall mail-directory-parser))
-	  (while (not (eobp))
-	    (setq directory
-		  `((,(buffer-substring (point)
-					(progn
-					  (forward-line)
-					  (if (bolp)
-					    (1- (point))
-					    (point)))))
-		    ,@directory)))))
-      (kill-buffer (current-buffer))
-      (message "Querying directory...done")
-      directory)))
-
-
-(defun mail-directory-process (pattern)
-  "Call a Unix process to output names in directory.
-See `mail-directory-process'."
-  (apply 'call-process (eval (car mail-directory-process)) nil t nil
-	 (mapcar 'eval (cdr mail-directory-process))))
-
-;; This should handle a dialog.  Currently expects port to spit out names.
-(defun mail-directory-stream (pattern)
-  "Open a stream to retrieve names in directory.
-See `mail-directory-stream'."
-  (let (mailalias-done)
-    (set-process-sentinel
-     (apply 'open-network-stream "mailalias" (current-buffer)
-	    mail-directory-stream)
-     (lambda (x x)
-       (setq mailalias-done t)))
-    (while (not mailalias-done)
-      (sit-for .1))))
-
-(defun mail-sentto-newsgroups ()
-  "Return all entries from Newsgroups: header as completion alist."
-  (save-excursion
-    (if (mail-position-on-field "newsgroups" t)
-	(let ((point (point))
-	      list)
-	  (while (< (skip-chars-backward "^:, \t\n") 0)
-	    (setq list `((,(buffer-substring (point) point))
-			 ,@list))
-	    (skip-chars-backward ", \t\n")
-	    (setq point (point)))
-	  list))))
-
-(provide 'mailalias)
-
-;;; mailalias.el ends here
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
deleted file mode 100644
index 142b29c4f35..00000000000
--- a/lisp/mail/mailheader.el
+++ /dev/null
@@ -1,183 +0,0 @@
-;;; mailheader.el --- Mail header parsing, merging, formatting
-
-;; Copyright (C) 1996 by Free Software Foundation, Inc.
-
-;; Author: Erik Naggum <erik@arcana.naggum.no>
-;; Keywords: tools, mail, news
-
-;; 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 provides an abstraction to RFC822-style messages, used in
-;; mail, news, and some other systems.  The simple syntactic rules for such
-;; headers, such as quoting and line folding, are routinely reimplemented
-;; in many individual packages.  This package removes the need for this
-;; redundancy by representing message headers as association lists,
-;; offering functions to extract the set of headers from a message, to
-;; parse individual headers, to merge sets of headers, and to format a set
-;; of headers.
-
-;; The car of each element in the message-header alist is a symbol whose
-;; print name is the name of the header, in all lower-case.  The cdr of an
-;; element depends on the operation.  After extracting headers from a
-;; messge, it is a string, the value of the header.  An extracted set of
-;; headers may be parsed further, which may turn it into a list, whose car
-;; is the original value and whose subsequent elements depend on the
-;; header.  For formatting, it is evaluated to obtain the strings to be
-;; inserted.  For merging, one set of headers consists of strings, while
-;; the other set will be evaluated with the symbols in the first set of
-;; headers bound to their respective values.
-
-;;; Code:
-
-(eval-when-compile
-  (require 'cl))
-
-;; Make the byte-compiler shut up.
-(defvar headers)
-
-(defun mail-header-extract ()
-  "Extract headers from current buffer after point.
-Returns a header alist, where each element is a cons cell (name . value),
-where NAME is a symbol, and VALUE is the string value of the header having
-that name."
-  (let ((message-headers ()) (top (point))
-	start end)
-    (while (and (setq start (point))
-		(> (skip-chars-forward "^\0- :") 0)
-		(= (following-char) ?:)
-		(setq end (point))
-		(progn (forward-char) 
-		       (> (skip-chars-forward " \t") 0)))
-      (let ((header (intern (downcase (buffer-substring start end))))
-	    (value (list (buffer-substring
-			  (point) (progn (end-of-line) (point))))))
-	(while (progn (forward-char) (> (skip-chars-forward " \t") 0))
-	  (push (buffer-substring (point) (progn (end-of-line) (point)))
-		value))
-	(push (if (cdr value)
-		  (cons header (mapconcat #'identity (nreverse value) " "))
-		  (cons header (car value)))
-	      message-headers)))
-    (goto-char top)
-    (nreverse message-headers)))
-
-(defun mail-header-extract-no-properties ()
-  "Extract headers from current buffer after point, without properties.
-Returns a header alist, where each element is a cons cell (name . value),
-where NAME is a symbol, and VALUE is the string value of the header having
-that name."
-  (mapcar
-   (lambda (elt)
-     (set-text-properties 0 (length (cdr elt)) nil (cdr elt))
-     elt)
-   (mail-header-extract)))
-
-(defun mail-header-parse (parsing-rules headers)
-  "Apply PARSING-RULES to HEADERS.
-PARSING-RULES is an alist whose keys are header names (symbols) and whose
-value is a parsing function.  The function takes one argument, a string,
-and return a list of values, which will destructively replace the value
-associated with the key in HEADERS, after being prepended with the original
-value."
-  (dolist (rule parsing-rules)
-    (let ((header (assq (car rule) headers)))
-      (when header
-	(if (consp (cdr header))
-	    (setf (cddr header) (funcall (cdr rule) (cadr header)))
-	  (setf (cdr header)
-		(cons (cdr header) (funcall (cdr rule) (cdr header))))))))
-  headers)
-
-(defsubst mail-header (header &optional header-alist)
-  "Return the value associated with header HEADER in HEADER-ALIST.
-If the value is a string, it is the original value of the header.  If the
-value is a list, its first element is the original value of the header,
-with any subsequent elements bing the result of parsing the value.
-If HEADER-ALIST is nil, the dynamically bound variable `headers' is used."
-  (cdr (assq header (or header-alist headers))))
-
-(defun mail-header-set (header value &optional header-alist)
-  "Set the value associated with header HEADER to VALUE in HEADER-ALIST.
-HEADER-ALIST defaults to the dynamically bound variable `headers' if nil.
-See `mail-header' for the semantics of VALUE."
-  (let* ((alist (or header-alist headers))
-	(entry (assq header alist)))
-    (if entry
-	(setf (cdr entry) value)
-	(nconc alist (list (cons header value)))))
-  value)
-
-(defsetf mail-header (header &optional header-alist) (value)
-  `(mail-header-set ,header ,value ,header-alist))
-
-(defun mail-header-merge (merge-rules headers)
-  "Return a new header alist with MERGE-RULES applied to HEADERS.
-MERGE-RULES is an alist whose keys are header names (symbols) and whose
-values are forms to evaluate, the results of which are the new headers.  It
-should be a string or a list of string.  The first element may be nil to
-denote that the formatting functions must use the remaining elements, or
-skip the header altogether if there are no other elements.
-  The macro `mail-header' can be used to access headers in HEADERS."
-  (mapcar
-   (lambda (rule)
-     (cons (car rule) (eval (cdr rule))))
-   merge-rules))
-
-(defvar mail-header-format-function
-  (lambda (header value)
-    "Function to format headers without a specified formatting function."
-    (insert (capitalize (symbol-name header))
-	    ": "
-	    (if (consp value) (car value) value)
-	    "\n")))
-
-(defun mail-header-format (format-rules headers)
-  "Use FORMAT-RULES to format HEADERS and insert into current buffer.
-FORMAT-RULES is an alist whose keys are header names (symbols), and whose
-values are functions that format the header, the results of which are
-inserted, unless it is nil.  The function takes two arguments, the header
-symbol, and the value of that header.  If the function itself is nil, the
-default action is to insert the value of the header, unless it is nil.
-The headers are inserted in the order of the FORMAT-RULES.
-A key of t represents any otherwise unmentioned headers.
-A key of nil has as its value a list of defaulted headers to ignore."
-  (let ((ignore (append (cdr (assq nil format-rules))
-			(mapcar #'car format-rules))))
-    (dolist (rule format-rules)
-      (let* ((header (car rule))
-	    (value (mail-header header)))
-	(cond ((null header) 'ignore)
-	      ((eq header t)
-	       (dolist (defaulted headers)
-		 (unless (memq (car defaulted) ignore)
-		   (let* ((header (car defaulted))
-			  (value (cdr defaulted)))
-		     (if (cdr rule)
-			 (funcall (cdr rule) header value)
-			 (funcall mail-header-format-function header value))))))
-	      (value
-	       (if (cdr rule)
-		   (funcall (cdr rule) header value)
-		   (funcall mail-header-format-function header value))))))
-    (insert "\n")))
-
-(provide 'mailheader)
-
-;;; mailheader.el ends here
diff --git a/lisp/mail/mailpost.el b/lisp/mail/mailpost.el
deleted file mode 100644
index 5ff33478698..00000000000
--- a/lisp/mail/mailpost.el
+++ /dev/null
@@ -1,103 +0,0 @@
-;;; mailpost.el --- RMAIL coupler to /usr/uci/post mailer
-
-;; This is in the public domain
-;; since Delp distributed it without a copyright notice in 1986.
-
-;; Author: Gary Delp <delp@huey.Udel.Edu>
-;; Maintainer: FSF
-;; Created: 13 Jan 1986
-;; Keywords: mail
-
-;;; Commentary:
-
-;; Yet another mail interface.  this for the rmail system to provide
-;;  the missing sendmail interface on systems without /usr/lib/sendmail,
-;;   but with /usr/uci/post.
-
-;;; Code:
-
-(require 'mailalias)
-(require 'sendmail)
-
-;; (setq send-mail-function 'post-mail-send-it)
-
-(defun post-mail-send-it ()
-  "The MH -post interface for `rmail-mail' to call.
-To use it, include \"(setq send-mail-function 'post-mail-send-it)\" in
-site-init."
-  (let ((errbuf (if mail-interactive
-		    (generate-new-buffer " post-mail errors")
-		  0))
-	(temfile "/tmp/,rpost")
-	(tembuf (generate-new-buffer " post-mail temp"))
-	(case-fold-search nil)
-	delimline
-	(mailbuf (current-buffer)))
-    (unwind-protect
-	(save-excursion
-	  (set-buffer tembuf)
-	  (erase-buffer)
-	  (insert-buffer-substring mailbuf)
-	  (goto-char (point-max))
-	  ;; require one newline at the end.
-	  (or (= (preceding-char) ?\n)
-	      (insert ?\n))
-	  ;; Change header-delimiter to be what post-mail expects.
-	  (goto-char (point-min))
-	  (search-forward (concat "\n" mail-header-separator "\n"))
-	  (replace-match "\n\n")
-	  (backward-char 1)
-	  (setq delimline (point-marker))
-	  (if mail-aliases
-	      (expand-mail-aliases (point-min) delimline))
-	  (goto-char (point-min))
-	  ;; ignore any blank lines in the header
-	  (while (and (re-search-forward "\n\n\n*" delimline t)
-		      (< (point) delimline))
-	    (replace-match "\n"))
-	  ;; Find and handle any FCC fields.
-	  (let ((case-fold-search t))
-	    (goto-char (point-min))
-	    (if (re-search-forward "^FCC:" delimline t)
-		(mail-do-fcc delimline))
-	    ;; If there is a From and no Sender, put it a Sender.
-	    (goto-char (point-min))
-	    (and (re-search-forward "^From:"  delimline t)
-		 (not (save-excursion
-			(goto-char (point-min))
-			(re-search-forward "^Sender:" delimline t)))
-		 (progn
-		   (forward-line 1)
-		   (insert "Sender: " (user-login-name) "\n")))
-	    ;; don't send out a blank subject line
-	    (goto-char (point-min))
-	    (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
-		(replace-match ""))
-	    (if mail-interactive
-		(save-excursion
-		  (set-buffer errbuf)
-		  (erase-buffer))))
-	  (write-file (setq temfile (make-temp-name temfile)))
-	  (set-file-modes temfile 384)
-	  (apply 'call-process
-		 (append (list (if (boundp 'post-mail-program)
-				   post-mail-program
-				 "/usr/uci/lib/mh/post")
-			       nil errbuf nil
-			       "-nofilter" "-msgid")
-			 (if mail-interactive '("-watch") '("-nowatch"))
-			 (list temfile)))
-	  (if mail-interactive
-	      (save-excursion
-		(set-buffer errbuf)
-		(goto-char (point-min))
-		(while (re-search-forward "\n\n* *" nil t)
-		  (replace-match "; "))
-		(if (not (zerop (buffer-size)))
-		    (error "Sending...failed to %s"
-			   (buffer-substring (point-min) (point-max)))))))
-      (kill-buffer tembuf)
-      (if (bufferp errbuf)
-	  (switch-to-buffer errbuf)))))
-
-;;; mailpost.el ends here
diff --git a/lisp/mail/metamail.el b/lisp/mail/metamail.el
deleted file mode 100644
index 98ad5fb3a86..00000000000
--- a/lisp/mail/metamail.el
+++ /dev/null
@@ -1,200 +0,0 @@
-;;; metamail.el --- Metamail interface for GNU Emacs
-
-;; Copyright (C) 1993, 1996  Masanobu UMEDA
-
-;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Version: $Header: metamail.el,v 1.10 96/04/18 11:27:08 umerin Exp $
-;; Keywords: mail, news, mime, multimedia
-
-;; 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:
-
-;; The latest version will be at:
-;;	ftp://ftp.kyutech.ac.jp/pub/MultiMedia/mime/emacs-mime-tools.shar
-
-;; Note: Metamail does not have all options which is compatible with
-;; the environment variables.  For that reason, matamail.el have to
-;; hack the environment variables.  In addition, there is no way to
-;; display all header fields without extra informative body messages
-;; which are suppressed by "-q" option.
-
-;; The following definition is what I'm using with GNUS 4:
-;;(setq gnus-show-mime-method
-;;      (function
-;;       (lambda ()
-;;	   (metamail-interpret-header)
-;;	   (let ((metamail-switches	;Suppress header fields in a body.
-;;		  (append metamail-switches '("-q"))))
-;;	     (metamail-interpret-body)))))
-
-;; The idea of using metamail to process MIME messages is from
-;; gnus-mime.el by Spike <Spike@world.std.com>.
-
-;;; Code:
-
-(defvar metamail-program-name "metamail"
-  "*Metamail program name.")
-
-(defvar metamail-mailer-name "emacs"
-  "*Mailer name set to MM_MAILER environment variable.")
-
-(defvar metamail-environment '("KEYHEADS=*" "MM_QUIET=1")
-  "*Environment variables passed to `metamail'.
-It must be a list of strings that have the format ENVVARNAME=VALUE.
-It is not expected to be altered globally by `set' or `setq'.
-Instead, change its value temporary using `let' or `let*' form.")
-
-(defvar metamail-switches '("-x" "-d" "-z")
-  "*Switches for `metamail' program.
-`-z' is required to remove zap file.
-It is not expected to be altered globally by `set' or `setq'.
-Instead, change its value temporary using `let' or `let*' form.
-`-m MAILER' argument is automatically generated from the
-`metamail-mailer-name' variable.")
-
-;;;###autoload
-(defun metamail-interpret-header ()
-  "Interpret a header part of a MIME message in current buffer.
-Its body part is not interpreted at all."
-  (interactive)
-  (save-excursion
-    (let* ((buffer-read-only nil)
-	   (metamail-switches		;Inhibit processing an empty body.
-	    (append metamail-switches '("-c" "text/plain" "-E" "7bit")))
-	   (end (progn
-		  (goto-char (point-min))
-		  (search-forward "\n\n" nil 'move)
-		  ;; An extra newline is inserted by metamail if there
-		  ;; is no body part.  So, insert a dummy body by
-		  ;; itself.
-		  (insert "\n")
-		  (point))))
-      (metamail-region (point-min) end nil nil 'nodisplay)
-      ;; Remove an extra newline inserted by myself.
-      (goto-char (point-min))
-      (if (search-forward "\n\n\n" nil t)
-	  (delete-char -1))
-      )))
-
-;;;###autoload
-(defun metamail-interpret-body (&optional viewmode nodisplay)
-  "Interpret a body part of a MIME message in current buffer.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted.
-Its header part is not interpreted at all."
-  (interactive "p")
-  (save-excursion
-    (let ((contype nil)
-	  (encoding nil)
-	  (end (progn
-		 (goto-char (point-min))
-		 (search-forward "\n\n" nil t)
-		 (point))))
-      ;; Find Content-Type and Content-Transfer-Encoding from the header.
-      (save-restriction
-	(narrow-to-region (point-min) end)
-	(setq contype 
-	      (or (mail-fetch-field "Content-Type") "text/plain"))
-	(setq encoding 
-	      (or (mail-fetch-field "Content-Transfer-Encoding") "7bit")))
-      ;; Interpret the body part only.
-      (let ((metamail-switches		;Process body part only.
-	     (append metamail-switches
-		     (list "-b" "-c" contype "-E" encoding))))
-	(metamail-region end (point-max) viewmode nil nodisplay))
-      ;; Mode specific hack.
-      (cond ((eq major-mode 'rmail-mode)
-	     ;; Adjust the marker of this message if in Rmail mode buffer.
-	     (set-marker (aref rmail-message-vector (1+ rmail-current-message))
-			 (point-max))))
-      )))
-
-;;;###autoload
-(defun metamail-buffer (&optional viewmode buffer nodisplay)
-  "Process current buffer through `metamail'.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument BUFFER specifies a buffer to be filled (nil
-means current).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted."
-  (interactive "p")
-  (metamail-region (point-min) (point-max) viewmode buffer nodisplay))
-
-;;;###autoload
-(defun metamail-region (beg end &optional viewmode buffer nodisplay)
-  "Process current region through 'metamail'.
-Optional argument VIEWMODE specifies the value of the
-EMACS_VIEW_MODE environment variable (defaulted to 1).
-Optional argument BUFFER specifies a buffer to be filled (nil
-means current).
-Optional argument NODISPLAY non-nil means buffer is not
-redisplayed as output is inserted."
-  (interactive "r\np")
-  (let ((curbuf (current-buffer))
-	(buffer-read-only nil)
-	(metafile (make-temp-name "/tmp/metamail"))
-	(option-environment
-	 (list (concat "EMACS_VIEW_MODE=" 
-		       (if (numberp viewmode) viewmode 1)))))
-    (save-excursion
-      ;; Gee!  Metamail does not ouput to stdout if input comes from
-      ;; stdin.
-      (let ((selective-display nil)	;Disable ^M to nl translation.
-	    (kanji-fileio-code 2)	;Write in JIS code when nemacs.
-	    (file-coding-system		;Write in JUNET style when mule.
-	     (if (featurep 'mule) *junet*)))
-	(write-region beg end metafile nil 'nomessage))
-      (if buffer
-	  (set-buffer buffer))
-      (setq buffer-read-only nil)
-      ;; Clear destination buffer.
-      (if (eq curbuf (current-buffer))
-	  (delete-region beg end)
-	(delete-region (point-min) (point-max)))
-      ;; We have to pass the environment variable KEYHEADS to display
-      ;; all header fields.  Metamail should have an optional argument
-      ;; to pass such information directly.
-      (let ((process-environment
-	     (append process-environment
-		     metamail-environment option-environment)))
-	;; Specify character coding system.
-	(if (boundp 'NEMACS)
-	    (define-program-kanji-code nil metamail-program-name 2)) ;JIS
-	(if (featurep 'mule)
-	    (define-program-coding-system nil metamail-program-name *junet*))
-	(apply (function call-process)
-	       metamail-program-name
-	       nil
-	       t			;Output to current buffer
-	       (not nodisplay)		;Force redisplay
-	       (append metamail-switches
-		       (list "-m" (or metamail-mailer-name "emacs"))
-		       (list metafile))))
-      ;; `metamail' may not delete the temporary file!
-      (condition-case error
-	  (delete-file metafile)
-	(error nil))
-      )))
-
-(provide 'metamail)
-
-;;; metamail.el ends here
diff --git a/lisp/mail/mh-comp.el b/lisp/mail/mh-comp.el
deleted file mode 100644
index 25117cac6c2..00000000000
--- a/lisp/mail/mh-comp.el
+++ /dev/null
@@ -1,1052 +0,0 @@
-;;; mh-comp --- mh-e functions for composing messages
-;; Time-stamp: <95/08/19 17:48:59 gildea>
-
-;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
-
-;; This file is part of mh-e, 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:
-
-;; Internal support for mh-e package.
-
-;;; Change Log:
-
-;; $Id: mh-comp.el,v 1.7 1995/11/03 02:28:52 kwzh Exp erik $
-
-;;; Code:
-
-(provide 'mh-comp)
-(require 'mh-utils)
-
-;;; Site customization (see also mh-utils.el):
-
-(defvar mh-send-prog "send"
-  "Name of the MH send program.
-Some sites need to change this because of a name conflict.")
-
-(defvar mh-redist-full-contents nil
-  "Non-nil if the `dist' command needs whole letter for redistribution.
-This is the case only when `send' is compiled with the BERK option.
-If MH will not allow you to redist a previously redist'd msg, set to nil.")
-
-
-(defvar mh-note-repl "-"
-  "String whose first character is used to notate replied to messages.")
-
-(defvar mh-note-forw "F"
-  "String whose first character is used to notate forwarded messages.")
-
-(defvar mh-note-dist "R"
-  "String whose first character is used to notate redistributed messages.")
-
-(defvar mh-yank-hooks nil
-  "Obsolete hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between point and mark.
-And each hook function should leave point and mark around the citation
-text as modified.
-
-This is a normal hook, misnamed for historical reasons.
-It is semi-obsolete and is only used if mail-citation-hook is nil.")
-
-(defvar mail-citation-hook nil
-  "*Hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between point and mark.
-And each hook function should leave point and mark around the citation
-text as modified.
-
-If this hook is entirely empty (nil), the text of the message is inserted
-with mh-ins-buf-prefix prefixed to each line.
-
-See also the variable mh-yank-from-start-of-msg, which controls how
-much of the message passed to the hook.")
-
-;;; Copied from sendmail.el for Hyperbole
-(defvar mail-header-separator "--------"
-  "*Line used by MH to separate headers from text in messages being composed.")
-
-;;; Personal preferences:
-
-(defvar mh-delete-yanked-msg-window nil
-  "*Controls window display when a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
-If non-nil, yanking the current message into a draft letter deletes any
-windows displaying the message.")
-
-(defvar mh-yank-from-start-of-msg t
-  "*Controls which part of a message is yanked by \\<mh-letter-mode-map>\\[mh-yank-cur-msg].
-If non-nil, include the entire message.  If the symbol `body', then yank the
-message minus the header.  If nil, yank only the portion of the message
-following the point.  If the show buffer has a region, this variable is
-ignored.")
-
-(defvar mh-ins-buf-prefix "> "
-  "*String to put before each non-blank line of a yanked or inserted message.
-\\<mh-letter-mode-map>Used when the message is inserted into an outgoing letter
-by \\[mh-insert-letter] or \\[mh-yank-cur-msg].")
-
-(defvar mh-reply-default-reply-to nil
-  "*Sets the person or persons to whom a reply will be sent.
-If nil, prompt for recipient.  If non-nil, then \\<mh-folder-mode-map>`\\[mh-reply]' will use this
-value and it should be one of \"from\", \"to\", \"cc\", or \"all\".
-The values \"cc\" and \"all\" do the same thing.")
-
-(defvar mh-signature-file-name "~/.signature"
-  "*Name of file containing the user's signature.
-Inserted into message by \\<mh-letter-mode-map>\\[mh-insert-signature].")
-
-(defvar mh-forward-subject-format "%s: %s"
-  "*Format to generate the Subject: line contents for a forwarded message.
-The two string arguments to the format are the sender of the original
-message and the original subject line.")
-
-(defvar mh-comp-formfile "components"
-  "Name of file to be used as a skeleton for composing messages.
-Default is \"components\".  If not a complete path name, the file
-is searched for first in the user's MH directory, then in the
-system MH lib directory.")
-
-(defvar mh-repl-formfile "replcomps"
-  "Name of file to be used as a skeleton for replying to messages.
-Default is \"replcomps\".  If not a complete path name, the file
-is searched for first in the user's MH directory, then in the
-system MH lib directory.")
-
-;;; Hooks:
-
-(defvar mh-letter-mode-hook nil
-  "Invoked in `mh-letter-mode' on a new letter.")
-
-(defvar mh-compose-letter-function nil
-  "Invoked when setting up a letter draft.
-It is passed three arguments: TO recipients, SUBJECT, and CC recipients.")
-
-(defvar mh-before-send-letter-hook nil
-  "Invoked at the beginning of the \\<mh-letter-mode-map>\\[mh-send-letter] command.")
-
-
-(defvar mh-rejected-letter-start
-  (concat "^   ----- Unsent message follows -----$"	;from sendmail V5
-	  "\\|^   ----- Original message follows -----$" ;from sendmail V8
-	  "\\|^------- Unsent Draft$"			;from MH itself
-	  "\\|^----------  Original Message  ----------$" ;from zmailer
-	  "\\|^  --- The unsent message follows ---$"	;from AIX mail system
-	  "\\|^    Your message follows:$"		;from MMDF-II
-	  "\\|^Content-Description: Returned Content$"	;1993 KJ sendmail
-	  )
-  "Regexp specifying the beginning of the wrapper around a returned letter.
-This wrapper is generated by the mail system when rejecting a letter.")
-
-(defvar mh-new-draft-cleaned-headers
-  "^Date:\\|^Received:\\|^Message-Id:\\|^From:\\|^Sender:\\|^Errors-To:\\|^Delivery-Date:\\|^Return-Path:"
-  "Regexp of header lines to remove before offering a message as a new draft.
-Used by the \\<mh-folder-mode-map>`\\[mh-edit-again]' and `\\[mh-extract-rejected-mail]' commands.")
-
-(defvar mh-to-field-choices '(("t" . "To:") ("s" . "Subject:") ("c" . "Cc:")
-			      ("b" . "Bcc:") ("f" . "Fcc:") ("r" . "From:")
-			      ("d" . "Dcc:"))
-  "Alist of (final-character . field-name) choices for mh-to-field.")
-
-(defvar mh-letter-mode-map (copy-keymap text-mode-map)
-  "Keymap for composing mail.")
-
-(defvar mh-letter-mode-syntax-table nil
-  "Syntax table used by mh-e while in MH-Letter mode.")
-
-(if mh-letter-mode-syntax-table
-    ()
-    (setq mh-letter-mode-syntax-table
-	  (make-syntax-table text-mode-syntax-table))
-    (modify-syntax-entry ?% "." mh-letter-mode-syntax-table))
-
-
-;;;###autoload
-(defun mh-smail ()
-  "Compose and send mail with the MH mail system.
-This function is an entry point to mh-e, the Emacs front end
-to the MH mail system.
-
-See documentation of `\\[mh-send]' for more details on composing mail."
-  (interactive)
-  (mh-find-path)
-  (call-interactively 'mh-send))
-
-
-(defvar mh-error-if-no-draft nil)	;raise error over using old draft
-
-
-;;;###autoload
-(defun mh-smail-batch ()
-  "Set up a mail composition draft with the MH mail system.
-This function is an entry point to mh-e, the Emacs front end
-to the MH mail system.  This function does not prompt the user
-for any header fields, and thus is suitable for use by programs
-that want to create a mail buffer.
-Users should use `\\[mh-smail]' to compose mail."
-  (mh-find-path)
-  (let ((mh-error-if-no-draft t))
-    (mh-send "" "" "")))
-
-
-(defun mh-edit-again (msg)
-  "Clean-up a draft or a message previously sent and make it resendable.
-Default is the current message.
-The variable mh-new-draft-cleaned-headers specifies the headers to remove.
-See also documentation for `\\[mh-send]' function."
-  (interactive (list (mh-get-msg-num t)))
-  (let* ((from-folder mh-current-folder)
-	 (config (current-window-configuration))
-	 (draft
-	  (cond ((and mh-draft-folder (equal from-folder mh-draft-folder))
-		 (pop-to-buffer (find-file-noselect (mh-msg-filename msg)) t)
-		 (rename-buffer (format "draft-%d" msg))
-		 (buffer-name))
-		(t
-		 (mh-read-draft "clean-up" (mh-msg-filename msg) nil)))))
-    (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil)
-    (goto-char (point-min))
-    (save-buffer)
-    (mh-compose-and-send-mail draft "" from-folder nil nil nil nil nil nil
-			      config)))
-
-
-(defun mh-extract-rejected-mail (msg)
-  "Extract a letter returned by the mail system and make it resendable.
-Default is the current message.  The variable mh-new-draft-cleaned-headers
-gives the headers to clean out of the original message.
-See also documentation for `\\[mh-send]' function."
-  (interactive (list (mh-get-msg-num t)))
-  (let ((from-folder mh-current-folder)
-	(config (current-window-configuration))
-	(draft (mh-read-draft "extraction" (mh-msg-filename msg) nil)))
-    (goto-char (point-min))
-    (cond ((re-search-forward mh-rejected-letter-start nil t)
-	   (skip-chars-forward " \t\n")
-	   (delete-region (point-min) (point))
-	   (mh-clean-msg-header (point-min) mh-new-draft-cleaned-headers nil))
-	  (t
-	   (message "Does not appear to be a rejected letter.")))
-    (goto-char (point-min))
-    (save-buffer)
-    (mh-compose-and-send-mail draft "" from-folder msg
-			      (mh-get-header-field "To:")
-			      (mh-get-header-field "From:")
-			      (mh-get-header-field "Cc:")
-			      nil nil config)))
-
-
-(defun mh-forward (to cc &optional msg-or-seq)
-  "Forward a message or message sequence.  Defaults to displayed message.
-If optional prefix argument provided, then prompt for the message sequence.
-See also documentation for `\\[mh-send]' function."
-  (interactive (list (mh-read-address "To: ")
-		     (mh-read-address "Cc: ")
-		     (if current-prefix-arg
-			 (mh-read-seq-default "Forward" t)
-		       (mh-get-msg-num t))))
-  (or msg-or-seq
-      (setq msg-or-seq (mh-get-msg-num t)))
-  (let* ((folder mh-current-folder)
-	 (config (current-window-configuration))
-	 ;; forw always leaves file in "draft" since it doesn't have -draft
-	 (draft-name (expand-file-name "draft" mh-user-path))
-	 (draft (cond ((or (not (file-exists-p draft-name))
-			   (y-or-n-p "The file 'draft' exists.  Discard it? "))
-		       (mh-exec-cmd "forw" "-build"
-				    mh-current-folder msg-or-seq)
-		       (prog1
-			   (mh-read-draft "" draft-name t)
-			 (mh-insert-fields "To:" to "Cc:" cc)
-			 (save-buffer)))
-		      (t
-		       (mh-read-draft "" draft-name nil)))))
-    (let (orig-from
-	  orig-subject)
-      (goto-char (point-min))
-      (re-search-forward "^------- Forwarded Message")
-      (forward-line 1)
-      (skip-chars-forward " \t\n")
-      (save-restriction
-	(narrow-to-region (point) (point-max))
-	(setq orig-from (mh-get-header-field "From:"))
-	(setq orig-subject (mh-get-header-field "Subject:")))
-      (let ((forw-subject
-	     (mh-forwarded-letter-subject orig-from orig-subject)))
-	(mh-insert-fields "Subject:" forw-subject)
-	(goto-char (point-min))
-	(re-search-forward "^------- Forwarded Message")
-	(forward-line -1)
-	(delete-other-windows)
-	(if (numberp msg-or-seq)
-	    (mh-add-msgs-to-seq msg-or-seq 'forwarded t)
-	  (mh-add-msgs-to-seq (mh-seq-to-msgs msg-or-seq) 'forwarded t))
-	(mh-compose-and-send-mail draft "" folder msg-or-seq
-				  to forw-subject cc
-				  mh-note-forw "Forwarded:"
-				  config)))))
-
-(defun mh-forwarded-letter-subject (from subject)
-  ;; Return a Subject suitable for a forwarded message.
-  ;; Original message has headers FROM and SUBJECT.
-  (let ((addr-start (string-match "<" from))
-	(comment (string-match "(" from)))
-    (cond ((and addr-start (> addr-start 0))
-	   ;; Full Name <luser@host>
-	   (setq from (substring from 0 (1- addr-start))))
-	  (comment
-	   ;; luser@host (Full Name)
-	   (setq from (substring from (1+ comment) (1- (length from)))))))
-  (format mh-forward-subject-format from subject))
-
-
-;;;###autoload
-(defun mh-smail-other-window ()
-  "Compose and send mail in other window with the MH mail system.
-This function is an entry point to mh-e, the Emacs front end
-to the MH mail system.
-
-See documentation of `\\[mh-send]' for more details on composing mail."
-  (interactive)
-  (mh-find-path)
-  (call-interactively 'mh-send-other-window))
-
-
-(defun mh-redistribute (to cc &optional msg)
-  "Redistribute a letter.
-Depending on how your copy of MH was compiled, you may need to change the
-setting of the variable mh-redist-full-contents.  See its documentation."
-  (interactive (list (mh-read-address "Redist-To: ")
-		     (mh-read-address "Redist-Cc: ")
-		     (mh-get-msg-num t)))
-  (or msg
-      (setq msg (mh-get-msg-num t)))
-  (save-window-excursion
-    (let ((folder mh-current-folder)
-	  (draft (mh-read-draft "redistribution"
-				(if mh-redist-full-contents
-				    (mh-msg-filename msg)
-				  nil)
-				nil)))
-      (mh-goto-header-end 0)
-      (insert "Resent-To: " to "\n")
-      (if (not (equal cc "")) (insert "Resent-cc: " cc "\n"))
-      (mh-clean-msg-header (point-min)
-			   "^Message-Id:\\|^Received:\\|^Return-Path:\\|^Sender:\\|^Date:\\|^From:"
-			   nil)
-      (save-buffer)
-      (message "Redistributing...")
-      (if mh-redist-full-contents
-	  (call-process "/bin/sh" nil 0 nil "-c"
-			(format "mhdist=1 mhaltmsg=%s %s -push %s"
-				buffer-file-name
-				(expand-file-name mh-send-prog mh-progs)
-				buffer-file-name))
-	(call-process "/bin/sh" nil 0 nil "-c"
-		      (format "mhdist=1 mhaltmsg=%s mhannotate=1 %s -push %s"
-			      (mh-msg-filename msg folder)
-			      (expand-file-name mh-send-prog mh-progs)
-			      buffer-file-name)))
-      (mh-annotate-msg msg folder mh-note-dist
-		       "-component" "Resent:"
-		       "-text" (format "\"%s %s\"" to cc))
-      (kill-buffer draft)
-      (message "Redistributing...done"))))
-
-
-(defun mh-reply (message &optional includep)
-  "Reply to MESSAGE (default: current message).
-If optional prefix argument INCLUDEP provided, then include the message
-in the reply using filter mhl.reply in your MH directory.
-Prompts for type of addresses to reply to:
-   from    sender only,
-   to      sender and primary recipients,
-   cc/all  sender and all recipients.
-If the file named by `mh-repl-formfile' exists, it is used as a skeleton
-for the reply.  See also documentation for `\\[mh-send]' function."
-  (interactive (list (mh-get-msg-num t) current-prefix-arg))
-  (let ((minibuffer-help-form
-	 "from => Sender only\nto => Sender and primary recipients\ncc or all => Sender and all recipients"))
-    (let ((reply-to (or mh-reply-default-reply-to
-			(completing-read "Reply to whom: "
-					 '(("from") ("to") ("cc") ("all"))
-					 nil
-					 t)))
-	  (folder mh-current-folder)
-	  (show-buffer mh-show-buffer)
-	  (config (current-window-configuration)))
-      (message "Composing a reply...")
-      (mh-exec-cmd "repl" "-build" "-noquery" "-nodraftfolder"
-	     (if (stringp mh-repl-formfile) ;must be string, but we're paranoid
-		 (list "-form" mh-repl-formfile))
-	     mh-current-folder message
-	     (cond ((or (equal reply-to "from") (equal reply-to ""))
-		    '("-nocc" "all"))
-		   ((equal reply-to "to")
-		    '("-cc" "to"))
-		   ((or (equal reply-to "cc") (equal reply-to "all"))
-		    '("-cc" "all" "-nocc" "me")))
-	     (if includep
-		 '("-filter" "mhl.reply")))
-      (let ((draft (mh-read-draft "reply"
-				  (expand-file-name "reply" mh-user-path)
-				  t)))
-	(delete-other-windows)
-	(save-buffer)
-	
-	(let ((to (mh-get-header-field "To:"))
-	      (subject (mh-get-header-field "Subject:"))
-	      (cc (mh-get-header-field "Cc:")))
-	  (goto-char (point-min))
-	  (mh-goto-header-end 1)
-	  (or includep
-	      (mh-in-show-buffer (show-buffer)
-		(mh-display-msg message folder)))
-	  (mh-add-msgs-to-seq message 'answered t)
-	  (message "Composing a reply...done")
-	  (mh-compose-and-send-mail draft "" folder message to subject cc
-				    mh-note-repl "Replied:" config))))))
-
-
-(defun mh-send (to cc subject)
-  "Compose and send a letter.
-The file named by `mh-comp-formfile' will be used as the form.
-Do not call this function from outside mh-e; use \\[mh-smail] instead.
-
-The letter is composed in mh-letter-mode; see its documentation for more
-details.  If `mh-compose-letter-function' is defined, it is called on the
-draft and passed three arguments: to, subject, and cc."
-  (interactive (list
-		(mh-read-address "To: ")
-		(mh-read-address "Cc: ")
-		(read-string "Subject: ")))
-  (let ((config (current-window-configuration)))
-    (delete-other-windows)
-    (mh-send-sub to cc subject config)))
-
-
-(defun mh-send-other-window (to cc subject)
-  "Compose and send a letter in another window.
-Do not call this function from outside mh-e;
-use \\[mh-smail-other-window] instead.
-See also documentation for `\\[mh-send]' function."
-  (interactive (list
-		(mh-read-address "To: ")
-		(mh-read-address "Cc: ")
-		(read-string "Subject: ")))
-  (let ((pop-up-windows t))
-    (mh-send-sub to cc subject (current-window-configuration))))
-
-
-(defun mh-send-sub (to cc subject config)
-  ;; Do the real work of composing and sending a letter.
-  ;; Expects the TO, CC, and SUBJECT fields as arguments.
-  ;; CONFIG is the window configuration before sending mail.
-  (let ((folder mh-current-folder)
-	(msg-num (mh-get-msg-num nil)))
-    (message "Composing a message...")
-    (let ((draft (mh-read-draft
-		  "message"
-		  (let (components)
-		    (cond
-		     ((file-exists-p
-		       (setq components
-			     (expand-file-name mh-comp-formfile mh-user-path)))
-		      components)
-		     ((file-exists-p
-		       (setq components
-			     (expand-file-name mh-comp-formfile mh-lib)))
-		      components)
-		     (t
-		      (error (format "Can't find components file \"%s\""
-				     components)))))
-		  nil)))
-      (mh-insert-fields "To:" to "Subject:" subject "Cc:" cc)
-      (goto-char (point-max))
-      (message "Composing a message...done")
-      (mh-compose-and-send-mail draft "" folder msg-num
-				to subject cc
-				nil nil config))))
-
-
-(defun mh-read-draft (use initial-contents delete-contents-file)
-  ;; Read draft file into a draft buffer and make that buffer the current one.
-  ;; USE is a message used for prompting about the intended use of the message.
-  ;; INITIAL-CONTENTS is filename that is read into an empty buffer, or NIL
-  ;; if buffer should not be modified.  Delete the initial-contents file if
-  ;; DELETE-CONTENTS-FILE flag is set.
-  ;; Returns the draft folder's name.
-  ;; If the draft folder facility is enabled in ~/.mh_profile, a new buffer is
-  ;; used each time and saved in the draft folder.  The draft file can then be
-  ;; reused.
-  (cond (mh-draft-folder
-	 (let ((orig-default-dir default-directory)
-	       (draft-file-name (mh-new-draft-name)))
-	   (pop-to-buffer (generate-new-buffer
-			   (format "draft-%s"
-				   (file-name-nondirectory draft-file-name))))
-	   (condition-case ()
-	       (insert-file-contents draft-file-name t)
-	     (file-error))
-	   (setq default-directory orig-default-dir)))
-	(t
-	 (let ((draft-name (expand-file-name "draft" mh-user-path)))
-	   (pop-to-buffer "draft")	; Create if necessary
-	   (if (buffer-modified-p)
-	       (if (y-or-n-p "Draft has been modified; kill anyway? ")
-		   (set-buffer-modified-p nil)
-		   (error "Draft preserved")))
-	   (setq buffer-file-name draft-name)
-	   (clear-visited-file-modtime)
-	   (unlock-buffer)
-	   (cond ((and (file-exists-p draft-name)
-		       (not (equal draft-name initial-contents)))
-		  (insert-file-contents draft-name)
-		  (delete-file draft-name))))))
-  (cond ((and initial-contents
-	      (or (zerop (buffer-size))
-		  (if (y-or-n-p
-			(format "A draft exists.  Use for %s? " use))
-		      (if mh-error-if-no-draft
-			  (error "A prior draft exists."))
-		    t)))
-	 (erase-buffer)
-	 (insert-file-contents initial-contents)
-	 (if delete-contents-file (delete-file initial-contents))))
-  (auto-save-mode 1)
-  (if mh-draft-folder
-      (save-buffer))			; Do not reuse draft name
-  (buffer-name))
-
-
-(defun mh-new-draft-name ()
-  ;; Returns the pathname of folder for draft messages.
-  (save-excursion
-    (mh-exec-cmd-quiet t "mhpath" mh-draft-folder "new")
-    (buffer-substring (point-min) (1- (point-max)))))
-
-
-(defun mh-annotate-msg (msg buffer note &rest args)
-  ;; Mark the MESSAGE in BUFFER listing with the character NOTE and annotate
-  ;; the saved message with ARGS.
-  (apply 'mh-exec-cmd "anno" buffer msg args)
-  (save-excursion
-    (cond ((get-buffer buffer)		; Buffer may be deleted
-	   (set-buffer buffer)
-	   (if (symbolp msg)
-	       (mh-notate-seq msg note (1+ mh-cmd-note))
-	       (mh-notate msg note (1+ mh-cmd-note)))))))
-
-
-(defun mh-insert-fields (&rest name-values)
-  ;; Insert the NAME-VALUE pairs in the current buffer.
-  ;; If field NAME exists, append VALUE to it.
-  ;; Do not insert any pairs whose value is the empty string.
-  (let ((case-fold-search t))
-    (while name-values
-      (let ((field-name (car name-values))
-	    (value (car (cdr name-values))))
-	(cond ((equal value "")
-	       nil)
-	      ((mh-position-on-field field-name)
-	       (insert " " value))
-	      (t
-	       (insert field-name " " value "\n")))
-	(setq name-values (cdr (cdr name-values)))))))
-
-
-(defun mh-position-on-field (field &optional ignore)
-  ;; Move to the end of the FIELD in the header.
-  ;; Move to end of entire header if FIELD not found.
-  ;; Returns non-nil iff FIELD was found.
-  ;; The optional second arg is for pre-version 4 compatibility.
-  (if (mh-goto-header-field field)
-      (progn
-	(mh-header-field-end)
-	t)))
-
-
-(defun mh-get-header-field (field)
-  ;; Find and return the body of FIELD in the mail header.
-  ;; Returns the empty string if the field is not in the header of the
-  ;; current buffer.
-  (if (mh-goto-header-field field)
-      (progn
-	(skip-chars-forward " \t")	;strip leading white space in body
-	(let ((start (point)))
-	  (mh-header-field-end)
-	  (buffer-substring start (point))))
-    ""))
-
-(fset 'mh-get-field 'mh-get-header-field) ;mh-e 4 compatibility
-
-(defun mh-goto-header-field (field)
-  ;; Move to FIELD in the message header.
-  ;; Move to the end of the FIELD name, which should end in a colon.
-  ;; Returns T if found, NIL if not.
-  (goto-char (point-min))
-  (let ((case-fold-search t)
-	(headers-end (save-excursion
-		      (mh-goto-header-end 0)
-		      (point))))
-    (re-search-forward (format "^%s" field) headers-end t)))
-
-(defun mh-header-field-end ()
-  ;; Move to the end of the current header field.
-  ;; Handles RFC 822 continuation lines.
-  (forward-line 1)
-  (while (looking-at "^[ \t]")
-    (forward-line 1))
-  (backward-char 1))		;to end of previous line
-  
-
-(defun mh-goto-header-end (arg)
-  ;; Find the end of the message header in the current buffer and position
-  ;; the cursor at the ARG'th newline after the header.
-  (if (re-search-forward "^-*$" nil nil)
-      (forward-line arg)))
-
-
-(defun mh-read-address (prompt)
-  ;; Read a To: or Cc: address, prompting in the minibuffer with PROMPT.
-  ;; May someday do completion on aliases.
-  (read-string prompt))
-
-
-
-;;; Mode for composing and sending a draft message.
-
-(defvar mh-sent-from-folder nil)	;Folder of msg assoc with this letter.
-
-(defvar mh-sent-from-msg nil)		;Number of msg assoc with this letter.
-
-(defvar mh-send-args nil)		;Extra args to pass to "send" command.
-
-(defvar mh-annotate-char nil)		;Character to use to annotate mh-sent-from-msg.
-
-(defvar mh-annotate-field nil)		;Field name for message annotation.
-
-(put 'mh-letter-mode 'mode-class 'special)
-
-;;;###autoload
-(defun mh-letter-mode ()
-  "Mode for composing letters in mh-e.\\<mh-letter-mode-map>
-When you have finished composing, type \\[mh-send-letter] to send the message
-using the MH mail handling system.
-See the documentation for \\[mh-edit-mhn] for information on composing MIME
-messages.
-
-\\{mh-letter-mode-map}
-
-Variables controlling this mode (defaults in parentheses):
-
- mh-delete-yanked-msg-window (nil)
-    If non-nil, \\[mh-yank-cur-msg] will delete any windows displaying
-    the yanked message.
-
- mh-yank-from-start-of-msg (t)
-    If non-nil, \\[mh-yank-cur-msg] will include the entire message.
-    If `body', just yank the body (no header).
-    If nil, only the portion of the message following the point will be yanked.
-    If there is a region, this variable is ignored.
-
- mh-ins-buf-prefix (\"> \")
-    String to insert before each non-blank line of a message as it is
-    inserted in a draft letter.
-
- mh-signature-file-name (\"~/.signature\")
-    File to be inserted into message by \\[mh-insert-signature].
-
-Upon invoking mh-letter-mode, text-mode-hook and mh-letter-mode-hook are
-invoked with no args, if those values are non-nil."
-
-  (interactive)
-  (or mh-user-path (mh-find-path))
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-start))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate
-	(concat "^[ \t]*[-_][-_][-_]+$\\|" paragraph-separate))
-  (make-local-variable 'mh-send-args)
-  (make-local-variable 'mh-annotate-char)
-  (make-local-variable 'mh-annotate-field)
-  (make-local-variable 'mh-previous-window-config)
-  (make-local-variable 'mh-sent-from-folder)
-  (make-local-variable 'mh-sent-from-msg)
-  (make-local-variable 'mail-header-separator)
-  (setq mail-header-separator "--------") ;for Hyperbole
-  (use-local-map mh-letter-mode-map)
-  (setq major-mode 'mh-letter-mode)
-  (mh-set-mode-name "MH-Letter")
-  (set-syntax-table mh-letter-mode-syntax-table)
-  (run-hooks 'text-mode-hook)
-  ;; if text-mode-hook turned on auto-fill, tune it for messages
-  (cond ((and (boundp 'auto-fill-hook) auto-fill-hook) ;emacs 18
-	 (make-local-variable 'auto-fill-hook)
-	 (setq auto-fill-hook 'mh-auto-fill-for-letter)))
-  (cond ((and (boundp 'auto-fill-function) auto-fill-function) ;emacs 19
-	 (make-local-variable 'auto-fill-function)
-	 (setq auto-fill-function 'mh-auto-fill-for-letter)))
-  (run-hooks 'mh-letter-mode-hook))
-
-
-(defun mh-auto-fill-for-letter ()
-  ;; Auto-fill in letters treats the header specially by inserting a tab
-  ;; before continuation line.
-  (if (mh-in-header-p)
-      (let ((fill-prefix "\t"))
-	(do-auto-fill))
-    (do-auto-fill)))
-
-
-(defun mh-in-header-p ()
-  ;; Return non-nil if the point is in the header of a draft message.
-  (save-excursion
-    (let ((cur-point (point)))
-      (goto-char (point-min))
-      (re-search-forward "^-*$" nil t)
-      (< cur-point (point)))))
-
-
-(defun mh-to-field ()
-  "Move point to the end of a specified header field.
-The field is indicated by the previous keystroke (the last keystroke
-of the command) according to the list in the variable mh-to-field-choices.
-Create the field if it does not exist.  Set the mark to point before moving."
-  (interactive)
-  (expand-abbrev)
-  (let ((target (cdr (or (assoc (char-to-string (logior last-input-char ?`))
-				mh-to-field-choices)
-			 ;; also look for a char for version 4 compat
-			 (assoc (logior last-input-char ?`) mh-to-field-choices))))
-	(case-fold-search t))
-    (push-mark)
-    (cond ((mh-position-on-field target)
-	   (let ((eol (point)))
-	     (skip-chars-backward " \t")
-	     (delete-region (point) eol))
-	   (if (and (not (eq (logior last-input-char ?`) ?s))
-		    (save-excursion
-		      (backward-char 1)
-		      (not (looking-at "[:,]"))))
-	       (insert ", ")
-	       (insert " ")))
-	  (t
-	   (if (mh-position-on-field "To:")
-	       (forward-line 1))
-	   (insert (format "%s \n" target))
-	   (backward-char 1)))))
-
-
-(defun mh-to-fcc (&optional folder)
-  "Insert an Fcc: FOLDER field in the current message.
-Prompt for the field name with a completion list of the current folders."
-  (interactive)
-  (or folder
-      (setq folder (mh-prompt-for-folder
-		    "Fcc"
-		    (or (and mh-default-folder-for-message-function
-			     (save-excursion
-			       (goto-char (point-min))
-			       (funcall mh-default-folder-for-message-function)))
-			"")
-		    t)))
-  (let ((last-input-char ?\C-f))
-    (expand-abbrev)
-    (save-excursion
-      (mh-to-field)
-      (insert (if (mh-folder-name-p folder)
-		  (substring folder 1)
-		folder)))))
-
-
-(defun mh-insert-signature ()
-  "Insert the file named by mh-signature-file-name at the current point."
-  (interactive)
-  (insert-file-contents mh-signature-file-name)
-  (force-mode-line-update))
-
-
-(defun mh-check-whom ()
-  "Verify recipients of the current letter, showing expansion of any aliases."
-  (interactive)
-  (let ((file-name buffer-file-name))
-    (save-buffer)
-    (message "Checking recipients...")
-    (mh-in-show-buffer ("*Recipients*")
-      (bury-buffer (current-buffer))
-      (erase-buffer)
-      (mh-exec-cmd-output "whom" t file-name))
-    (message "Checking recipients...done")))
-
-
-
-;;; Routines to compose and send a letter.
-
-(defun mh-compose-and-send-mail (draft send-args
-				       sent-from-folder sent-from-msg
-				       to subject cc
-				       annotate-char annotate-field
-				       config)
-  ;; Edit and compose a draft message in buffer DRAFT and send or save it.
-  ;; SENT-FROM-FOLDER is buffer containing scan listing of current folder, or
-  ;; nil if none exists.
-  ;; SENT-FROM-MSG is the message number or sequence name or nil.
-  ;; SEND-ARGS is an optional argument passed to the send command.
-  ;; The TO, SUBJECT, and CC fields are passed to the
-  ;; mh-compose-letter-function.
-  ;; If ANNOTATE-CHAR is non-null, it is used to notate the scan listing of the
-  ;; message.  In that case, the ANNOTATE-FIELD is used to build a string
-  ;; for mh-annotate-msg.
-  ;; CONFIG is the window configuration to restore after sending the letter.
-  (pop-to-buffer draft)
-  (mh-letter-mode)
-  (setq mh-sent-from-folder sent-from-folder)
-  (setq mh-sent-from-msg sent-from-msg)
-  (setq mh-send-args send-args)
-  (setq mh-annotate-char annotate-char)
-  (setq mh-annotate-field annotate-field)
-  (setq mh-previous-window-config config)
-  (setq mode-line-buffer-identification (list "{%b}"))
-  (if (and (boundp 'mh-compose-letter-function)
-	   mh-compose-letter-function)
-      ;; run-hooks will not pass arguments.
-      (let ((value mh-compose-letter-function))
-	(if (and (listp value) (not (eq (car value) 'lambda)))
-	    (while value
-	      (funcall (car value) to subject cc)
-	      (setq value (cdr value)))
-	    (funcall mh-compose-letter-function to subject cc)))))
-
-
-(defun mh-send-letter (&optional arg)
-  "Send the draft letter in the current buffer.
-If optional prefix argument is provided, monitor delivery.
-Run mh-before-send-letter-hook before doing anything."
-  (interactive "P")
-  (run-hooks 'mh-before-send-letter-hook)
-  (save-buffer)
-  (message "Sending...")
-  (let ((draft-buffer (current-buffer))
-	(file-name buffer-file-name)
-	(config mh-previous-window-config))
-    (cond (arg
-	   (pop-to-buffer "MH mail delivery")
-	   (erase-buffer)
-	   (mh-exec-cmd-output mh-send-prog t "-watch" "-nopush"
-			       "-nodraftfolder" mh-send-args file-name)
-	   (goto-char (point-max))	; show the interesting part
-	   (recenter -1)
-	   (set-buffer draft-buffer))	; for annotation below
-	  (t
-	   (mh-exec-cmd-daemon mh-send-prog "-nodraftfolder" "-noverbose"
-			       mh-send-args file-name)))
-    (if mh-annotate-char
-	(mh-annotate-msg mh-sent-from-msg
-			 mh-sent-from-folder
-			 mh-annotate-char
-			 "-component" mh-annotate-field
-			 "-text" (format "\"%s %s\""
-					 (mh-get-header-field "To:")
-					 (mh-get-header-field "Cc:"))))
-
-    (cond ((or (not arg)
-	       (y-or-n-p "Kill draft buffer? "))
-	   (kill-buffer draft-buffer)
-	   (if config
-	       (set-window-configuration config))))
-    (if arg
-	(message "Sending...done")
-      (message "Sending...backgrounded"))))
-
-
-(defun mh-insert-letter (folder message verbatim)
-  "Insert a message into the current letter.
-Removes the message's headers using mh-invisible-headers.  Prefixes
-each non-blank line with mh-ins-buf-prefix.  Prompts for FOLDER and
-MESSAGE.  If prefix argument VERBATIM provided, do not indent and do
-not delete headers.  Leaves the mark before the letter and point after it."
-  (interactive
-   (list (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
-	 (read-input (format "Message number%s: "
-			     (if mh-sent-from-msg
-				 (format " [%d]" mh-sent-from-msg)
-			       "")))
-	 current-prefix-arg))
-  (save-restriction
-    (narrow-to-region (point) (point))
-    (let ((start (point-min)))
-      (if (equal message "") (setq message (int-to-string mh-sent-from-msg)))
-      (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
-			      (expand-file-name message
-						(mh-expand-file-name folder)))
-      (cond ((not verbatim)
-	     (mh-clean-msg-header start mh-invisible-headers mh-visible-headers)
-	     (set-mark start)		; since mh-clean-msg-header moves it
-	     (mh-insert-prefix-string mh-ins-buf-prefix))))))
-
-
-(defun mh-yank-cur-msg ()
-  "Insert the current message into the draft buffer.
-Prefix each non-blank line in the message with the string in
-`mh-ins-buf-prefix'.  If a region is set in the message's buffer, then
-only the region will be inserted.  Otherwise, the entire message will
-be inserted if `mh-yank-from-start-of-msg' is non-nil.  If this variable
-is nil, the portion of the message following the point will be yanked.
-If `mh-delete-yanked-msg-window' is non-nil, any window displaying the
-yanked message will be deleted."
-  (interactive)
-  (if (and mh-sent-from-folder mh-sent-from-msg)
-      (let ((to-point (point))
-	    (to-buffer (current-buffer)))
-	(set-buffer mh-sent-from-folder)
-	(if mh-delete-yanked-msg-window
-	    (delete-windows-on mh-show-buffer))
-	(set-buffer mh-show-buffer)	; Find displayed message
-	(let ((mh-ins-str (cond ((if (boundp 'mark-active)
-				     mark-active ;Emacs 19
-				   (mark)) ;Emacs 18
-				 (buffer-substring (region-beginning)
-						   (region-end)))
-				((eq 'body mh-yank-from-start-of-msg)
-				 (buffer-substring
-				  (save-excursion
-				    (goto-char (point-min))
-				    (mh-goto-header-end 1)
-				    (point))
-				  (point-max)))
-				(mh-yank-from-start-of-msg
-				 (buffer-substring (point-min) (point-max)))
-				(t
-				 (buffer-substring (point) (point-max))))))
-	  (set-buffer to-buffer)
-	  (save-restriction
-	    (narrow-to-region to-point to-point)
-	    (push-mark)
-	    (insert mh-ins-str)
-	    (mh-insert-prefix-string mh-ins-buf-prefix)
-	    (insert "\n"))))
-    (error "There is no current message")))
-
-
-(defun mh-insert-prefix-string (mh-ins-string)
-  ;; Run mail-citation-hook to insert a prefix string before each line
-  ;; in the buffer.  Generality for supercite users.
-  (set-mark (point-max))
-  (goto-char (point-min))
-  (cond (mail-citation-hook
-	 (run-hooks 'mail-citation-hook))
-	(mh-yank-hooks			;old hook name
-	 (run-hooks 'mh-yank-hooks))
-	(t
-	 (or (bolp) (forward-line 1))
-	 (let ((zmacs-regions nil))	;so "(mark)" works in XEmacs
-	   (while (< (point) (mark))
-	     (insert mh-ins-string)
-	     (forward-line 1))))))
-
-
-(defun mh-fully-kill-draft ()
-  "Kill the draft message file and the draft message buffer.
-Use \\[kill-buffer] if you don't want to delete the draft message file."
-  (interactive)
-  (if (y-or-n-p "Kill draft message? ")
-      (let ((config mh-previous-window-config))
-	(if (file-exists-p buffer-file-name)
-	    (delete-file buffer-file-name))
-	(set-buffer-modified-p nil)
-	(kill-buffer (buffer-name))
-	(message "")
-	(if config
-	    (set-window-configuration config)))
-    (error "Message not killed")))
-
-
-;;; Build the letter-mode keymap:
-
-(define-key mh-letter-mode-map "\C-c\C-f\C-b" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-f\C-c" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-f\C-d" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-f\C-f" 'mh-to-fcc)
-(define-key mh-letter-mode-map "\C-c\C-f\C-r" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-f\C-s" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-f\C-t" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-fb" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-fc" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-fd" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-ff" 'mh-to-fcc)
-(define-key mh-letter-mode-map "\C-c\C-fr" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-fs" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-ft" 'mh-to-field)
-(define-key mh-letter-mode-map "\C-c\C-i" 'mh-insert-letter)
-(define-key mh-letter-mode-map "\C-c\C-q" 'mh-fully-kill-draft)
-(define-key mh-letter-mode-map "\C-c\C-\\" 'mh-fully-kill-draft) ;if no C-q
-(define-key mh-letter-mode-map "\C-c\C-s" 'mh-insert-signature)
-(define-key mh-letter-mode-map "\C-c\C-^" 'mh-insert-signature) ;if no C-s
-(define-key mh-letter-mode-map "\C-c\C-w" 'mh-check-whom)
-(define-key mh-letter-mode-map "\C-c\C-y" 'mh-yank-cur-msg)
-(define-key mh-letter-mode-map "\C-c\C-c" 'mh-send-letter)
-(define-key mh-letter-mode-map "\C-c\C-m\C-f" 'mh-mhn-compose-forw)
-(define-key mh-letter-mode-map "\C-c\C-m\C-e" 'mh-mhn-compose-anon-ftp)
-(define-key mh-letter-mode-map "\C-c\C-m\C-t" 'mh-mhn-compose-external-compressed-tar)
-(define-key mh-letter-mode-map "\C-c\C-m\C-i" 'mh-mhn-compose-insertion)
-(define-key mh-letter-mode-map "\C-c\C-e" 'mh-edit-mhn)
-(define-key mh-letter-mode-map "\C-c\C-m\C-u" 'mh-revert-mhn-edit)
-
-;; "C-c /" prefix is used in mh-letter-mode by pgp.el
-
-;;; autoloads from mh-mime
-
-(autoload 'mh-mhn-compose-insertion "mh-mime"
-  "Add a directive to insert a MIME message part from a file.
-This is the typical way to insert non-text parts in a message.
-See also \\[mh-edit-mhn]." t)
-
-(autoload 'mh-mhn-compose-anon-ftp "mh-mime"
-  "Add a directive for a MIME anonymous ftp external body part.
-This directive tells MH to include a reference to a
-message/external-body part retrievable by anonymous FTP.
-See also \\[mh-edit-mhn]." t)
-
-(autoload 'mh-mhn-compose-external-compressed-tar "mh-mime"
-  "Add a directive to include a MIME reference to a compressed tar file.
-The file should be available via anonymous ftp.  This directive
-tells MH to include a reference to a message/external-body part.
-See also \\[mh-edit-mhn]." t)
-
-(autoload 'mh-mhn-compose-forw "mh-mime"
-  "Add a forw directive to this message, to forward a message with MIME.
-This directive tells MH to include another message in this one.
-See also \\[mh-edit-mhn]." t)
-
-(autoload 'mh-edit-mhn "mh-mime"
-  "Format the current draft for MIME, expanding any mhn directives.
-Process the current draft with the mhn program, which,
-using directives already inserted in the draft, fills in
-all the MIME components and header fields.
-This step should be done last just before sending the message.
-The mhn program is part of MH version 6.8 or later.
-The `\\[mh-revert-mhn-edit]' command undoes this command.
-For assistance with creating mhn directives to insert
-various types of components in a message, see
-\\[mh-mhn-compose-insertion] (generic insertion from a file),
-\\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp),
-\\[mh-mhn-compose-external-compressed-tar] \
-\(reference to compressed tar file via anonymous ftp), and
-\\[mh-mhn-compose-forw] (forward message)." t)
-
-(autoload 'mh-revert-mhn-edit "mh-mime"
-  "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file.
-Optional non-nil argument means don't ask for confirmation." t)
diff --git a/lisp/mail/mh-e.el b/lisp/mail/mh-e.el
deleted file mode 100644
index 0a32ca2768d..00000000000
--- a/lisp/mail/mh-e.el
+++ /dev/null
@@ -1,1484 +0,0 @@
-;;; mh-e.el --- GNU Emacs interface to the MH mail system
-
-;; Copyright (C) 1985,86,87,88,90,92,93,94,95 Free Software Foundation, Inc.
-
-;; Maintainer: Stephen Gildea <gildea@lcs.mit.edu>
-;; Version: 5.0.2
-;; Keywords: mail
-;; Bug-reports: include `M-x mh-version' output in any correspondence
-
-;; This file is part of mh-e, 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:
-
-;; HOW TO USE:
-;; M-x mh-rmail to read mail.  Type C-h m there for a list of commands.
-;; C-u M-x mh-rmail to visit any folder.
-;; M-x mh-smail to send mail.  From within the mail reader, "m" works, too.
-
-;; MH (Message Handler) is a powerful mail reader.  The MH newsgroup
-;; is comp.mail.mh; the mailing list is mh-users@ics.uci.edu (send to
-;; mh-users-request to be added).  See the monthly Frequently Asked
-;; Questions posting there for information on getting MH and mh-e.
-
-;; mh-e is an Emacs interface to the MH mail system.
-;; The mailing list mh-e@x.org is for discussion of mh-e and
-;; announcements of new versions.  Send a "subscribe" message to
-;; mh-e-request@x.org to be added.  Do not report bugs here; mail
-;; them directly to the author (see top of mh-e.el source).
-;; Include the output of M-x mh-version in any bug report.
-
-;; mh-e works with GNU Emacs 18 or 19, and MH 6.
-
-;; NB.  MH must have been compiled with the MHE compiler flag or several
-;; features necessary for mh-e will be missing from MH commands, specifically
-;; the -build switch to repl and forw.
-
-;; Your .emacs might benefit from these bindings:
-;; (global-set-key "\C-cr" 'mh-rmail)
-;; (global-set-key "\C-xm" 'mh-smail)
-;; (global-set-key "\C-x4m" 'mh-smail-other-window)
-
-;;; Change Log:
-
-;; Original version for Gosling emacs by Brian Reid, Stanford, 1982.
-;; Modified by James Larus, BBN, July 1984 and UCB, 1984 & 1985.
-;; Rewritten for GNU Emacs, James Larus 1985.  larus@ginger.berkeley.edu
-;; Modified by Stephen Gildea 1988.  gildea@lcs.mit.edu
-(defconst mh-e-RCS-id "$Id: mh-e.el,v 1.13 1996/01/25 01:02:59 kwzh Exp kwzh $")
-
-;;; Code:
-
-(provide 'mh-e)
-(require 'mh-utils)
-
-
-;;; Hooks:
-
-(defvar mh-folder-mode-hook nil
-  "Invoked in MH-Folder mode on a new folder.")
-
-(defvar mh-inc-folder-hook nil
-  "Invoked by \\<mh-folder-mode-map>`\\[mh-inc-folder]' after incorporating mail into a folder.")
-
-(defvar mh-show-hook nil
-  "Invoked after \\<mh-folder-mode-map>`\\[mh-show]' shows a message.")
-
-(defvar mh-show-mode-hook nil
-  "Invoked in MH-Show mode on each message.")
-
-(defvar mh-delete-msg-hook nil
-  "Invoked after marking each message for deletion.")
-
-(defvar mh-refile-msg-hook nil
-  "Invoked after marking each message for refiling.")
-
-(defvar mh-before-quit-hook nil
-  "Invoked by \\<mh-folder-mode-map>`\\[mh-quit]' before quitting mh-e.  See also  mh-quit-hook.")
-
-(defvar mh-quit-hook nil
-  "Invoked after \\<mh-folder-mode-map>`\\[mh-quit]' quits mh-e.  See also  mh-before-quit-hook.")
-
-
-
-;;; Personal preferences:
-
-(defvar mh-lpr-command-format "lpr -J '%s'"
-  "*Format for Unix command that prints a message.
-The string should be a Unix command line, with the string '%s' where
-the job's name (folder and message number) should appear.  The formatted
-message text is piped to this command when you type \\<mh-folder-mode-map>`\\[mh-print-msg]'.")
-
-(defvar mh-scan-prog "scan"
-  "*Program to run to generate one-line-per-message listing of a folder.
-Normally \"scan\" or a file name linked to scan.  This file is searched
-for relative to the mh-progs directory unless it is an absolute pathname.
-Automatically becomes buffer-local when set in any fashion.")
-(make-variable-buffer-local 'mh-scan-prog)
-
-(defvar mh-inc-prog "inc"
-  "*Program to run to incorporate new mail into a folder.
-Normally \"inc\".  This file is searched for relative to
-the mh-progs directory unless it is an absolute pathname.")
-
-(defvar mh-print-background nil
-  "*Print messages in the background if non-nil.
-WARNING: do not delete the messages until printing is finished;
-otherwise, your output may be truncated.")
-
-(defvar mh-recenter-summary-p nil
-  "*Recenter summary window when the show window is toggled off if non-nil.")
-
-(defvar mh-do-not-confirm nil
-  "*Non-nil means do not prompt for confirmation before some mh-e commands.
-Affects non-recoverable commands such as mh-kill-folder and mh-undo-folder.")
-
-(defvar mh-store-default-directory nil
-  "*Last directory used by \\[mh-store-msg]; default for next store.
-A directory name string, or nil to use current directory.")
-
-;;; Parameterize mh-e to work with different scan formats.  The defaults work
-;;; with the standard MH scan listings, in which the first 4 characters on
-;;; the line are the message number, followed by two places for notations.
-
-(defvar mh-good-msg-regexp  "^....[^D^]"
-  "Regexp specifying the scan lines that are 'good' messages.")
-
-(defvar mh-deleted-msg-regexp "^....D"
-  "Regexp matching scan lines of deleted messages.")
-
-(defvar mh-refiled-msg-regexp  "^....\\^"
-  "Regexp matching scan lines of refiled messages.")
-
-(defvar mh-valid-scan-line "^ *[0-9]"
-  "Regexp matching scan lines for messages (not error messages).")
-
-(defvar mh-cur-scan-msg-regexp "^....\\+"
-  "Regexp matching scan line for the cur message.")
-
-(defvar mh-note-deleted "D"
-  "String whose first character is used to notate deleted messages.")
-
-(defvar mh-note-refiled "^"
-  "String whose first character is used to notate refiled messages.")
-
-(defvar mh-note-cur "+"
-  "String whose first character is used to notate the current message.")
-
-(defvar mh-partial-folder-mode-line-annotation "select"
-  "Annotation when displaying part of a folder.
-The string is displayed after the folder's name.  NIL for no annotation.")
-
-
-;;; Internal variables:
-
-(defvar mh-last-destination nil)	;Destination of last refile or write command.
-
-(defvar mh-folder-mode-map (make-keymap)
-  "Keymap for MH folders.")
-
-(defvar mh-delete-list nil)		;List of msg numbers to delete.
-
-(defvar mh-refile-list nil)		;List of folder names in mh-seq-list.
-
-(defvar mh-next-direction 'forward)	;Direction to move to next message.
-
-(defvar mh-narrowed-to-seq nil)		;Sequence display is narrowed to or nil if not narrowed.
-
-(defvar mh-first-msg-num nil)		;Number of first msg in buffer.
-
-(defvar mh-last-msg-num nil)		;Number of last msg in buffer.
-
-(defvar mh-mode-line-annotation nil)	;Indiction this is not the full folder.
-
-;;; Macros and generic functions:
-
-(defun mh-mapc (func list)
-  (while list
-    (funcall func (car list))
-    (setq list (cdr list))))
-
-
-
-;;; Entry points:
-
-;;;###autoload
-(defun mh-rmail (&optional arg)
-  "Inc(orporate) new mail with MH, or, with arg, scan an MH mail folder.
-This function is an entry point to mh-e, the Emacs front end
-to the MH mail system."
-  (interactive "P")
-  (mh-find-path)
-  (if arg
-      (call-interactively 'mh-visit-folder)
-      (mh-inc-folder)))
-
-
-;;; mh-smail and mh-smail-other-window have been moved to the new file
-;;; mh-comp.el, but Emacs 18 still looks for them here, so provide a
-;;; definition here, too, for a while.
-
-(defun mh-smail ()
-  "Compose and send mail with the MH mail system.
-This function is an entry point to mh-e, the Emacs front end
-to the MH mail system."
-  (interactive)
-  (mh-find-path)
-  (require 'mh-comp)
-  (call-interactively 'mh-send))
-
-
-(defun mh-smail-other-window ()
-  "Compose and send mail in other window with the MH mail system.
-This function is an entry point to mh-e, the Emacs front end
-to the MH mail system."
-  (interactive)
-  (mh-find-path)
-  (require 'mh-comp)
-  (call-interactively 'mh-send-other-window))
-
-
-
-;;; User executable mh-e commands:
-
-
-(defun mh-delete-msg (msg-or-seq)
-  "Mark the specified MESSAGE(s) for subsequent deletion and move to the next.
-Default is the displayed message.  If optional prefix argument is
-given then prompt for the message sequence."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-seq-default "Delete" t)
-			 (mh-get-msg-num t))))
-  (mh-delete-msg-no-motion msg-or-seq)
-  (mh-next-msg))
-
-
-(defun mh-delete-msg-no-motion (msg-or-seq)
-  "Mark the specified MESSAGE(s) for subsequent deletion.
-Default is the displayed message.  If optional prefix argument is
-provided, then prompt for the message sequence."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-seq-default "Delete" t)
-			 (mh-get-msg-num t))))
-  (if (numberp msg-or-seq)
-      (mh-delete-a-msg msg-or-seq)
-      (mh-map-to-seq-msgs 'mh-delete-a-msg msg-or-seq)))
-
-
-(defun mh-execute-commands ()
-  "Process outstanding delete and refile requests."
-  (interactive)
-  (if mh-narrowed-to-seq (mh-widen))
-  (mh-process-commands mh-current-folder)
-  (mh-set-scan-mode)
-  (mh-goto-cur-msg)			; after mh-set-scan-mode for efficiency
-  (mh-make-folder-mode-line)
-  t)					; return t for [local-]write-file-hooks
-
-
-(defun mh-first-msg ()
-  "Move to the first message."
-  (interactive)
-  (goto-char (point-min))
-  (while (and (not (eobp)) (not (looking-at mh-valid-scan-line)))
-    (forward-line 1)))
-
-
-(defun mh-header-display ()
-  "Show the current message with all its headers.
-Displays headers that might have been suppressed by setting the
-variables `mh-clean-message-header' or `mhl-formfile', or by the fallback
-behavior of scrolling uninteresting headers off the top of the window.
-Type \"\\[mh-show]\" to show the message normally again."
-  (interactive)
-  (and (not mh-showing-with-headers)
-       (or mhl-formfile mh-clean-message-header)
-       (mh-invalidate-show-buffer))
-  (let ((mhl-formfile nil)
-	(mh-clean-message-header nil))
-    (mh-show-msg nil)
-    (mh-in-show-buffer (mh-show-buffer)
-      (goto-char (point-min))
-      (mh-recenter 0))
-    (setq mh-showing-with-headers t)))
-
-
-(defun mh-inc-folder (&optional maildrop-name)
-  "Inc(orporate)s new mail into the Inbox folder.
-Optional prefix argument specifies an alternate maildrop from the default.
-If the prefix argument is given, incorporates mail into the current
-folder, otherwise uses the folder named by `mh-inbox'.
-Runs `mh-inc-folder-hook' after incorporating new mail.
-Do not call this function from outside mh-e; use \\[mh-rmail] instead."
-  (interactive (list (if current-prefix-arg
-			 (expand-file-name
-			  (read-file-name "inc mail from file: "
-					  mh-user-path)))))
-  (let ((config (current-window-configuration)))
-    (if (not maildrop-name)
-	(cond ((not (get-buffer mh-inbox))
-	       (mh-make-folder mh-inbox)
-	       (setq mh-previous-window-config config))
-	      ((not (eq (current-buffer) (get-buffer mh-inbox)))
-	       (switch-to-buffer mh-inbox)
-	       (setq mh-previous-window-config config)))))
-  (mh-get-new-mail maildrop-name)
-  (run-hooks 'mh-inc-folder-hook))
-
-
-(defun mh-last-msg ()
-  "Move to the last message."
-  (interactive)
-  (goto-char (point-max))
-  (while (and (not (bobp)) (looking-at "^$"))
-    (forward-line -1)))
-
-
-(defun mh-next-undeleted-msg (&optional arg)
-  "Move to the NTH next undeleted message in window."
-  (interactive "p")
-  (setq mh-next-direction 'forward)
-  (forward-line 1)
-  (cond ((re-search-forward mh-good-msg-regexp nil 0 arg)
-	 (beginning-of-line)
-	 (mh-maybe-show))
-	(t
-	 (forward-line -1)
-	 (if (get-buffer mh-show-buffer)
-	     (delete-windows-on mh-show-buffer)))))
-
-
-(defun mh-refile-msg (msg-or-seq folder)
-  "Refile MESSAGE(s) (default: displayed message) into FOLDER.
-If optional prefix argument provided, then prompt for message sequence."
-  (interactive
-   (list (if current-prefix-arg
-	     (mh-read-seq-default "Refile" t)
-	   (mh-get-msg-num t))
-	 (intern
-	  (mh-prompt-for-folder
-	   "Destination"
-	   (or (and mh-default-folder-for-message-function
-		    (let ((refile-file (mh-msg-filename (mh-get-msg-num t))))
-		      (save-excursion
-			(set-buffer (get-buffer-create mh-temp-buffer))
-			(erase-buffer)
-			(insert-file-contents refile-file)
-			(let ((buffer-file-name refile-file))
-			  (funcall mh-default-folder-for-message-function)))))
-	       (and (eq 'refile (car mh-last-destination))
-		    (symbol-name (cdr mh-last-destination)))
-	       "")
-	   t))))
-  (setq mh-last-destination (cons 'refile folder))
-  (if (numberp msg-or-seq)
-      (mh-refile-a-msg msg-or-seq folder)
-      (mh-map-to-seq-msgs 'mh-refile-a-msg msg-or-seq folder))
-  (mh-next-msg))
-
-
-(defun mh-refile-or-write-again (message)
-  "Re-execute the last refile or write command on the given MESSAGE.
-Default is the displayed message.  Use the same folder or file as the
-previous refile or write command."
-  (interactive (list (mh-get-msg-num t)))
-  (if (null mh-last-destination)
-      (error "No previous refile or write"))
-  (cond ((eq (car mh-last-destination) 'refile)
-	 (mh-refile-a-msg message (cdr mh-last-destination))
-	 (message "Destination folder: %s" (cdr mh-last-destination)))
-	(t
-	 (apply 'mh-write-msg-to-file message (cdr mh-last-destination))
-	 (message "Destination: %s" (cdr mh-last-destination))))
-  (mh-next-msg))
-
-
-(defun mh-quit ()
-  "Quit the current mh-e folder.
-Start by running mh-before-quit-hook.  Restore the previous window
-configuration, if one exists.  Finish by running mh-quit-hook."
-  (interactive)
-  (run-hooks 'mh-before-quit-hook) 
-  (mh-update-sequences)
-  (mh-invalidate-show-buffer)
-  (bury-buffer (current-buffer))
-  (if (get-buffer mh-show-buffer)
-      (bury-buffer mh-show-buffer))
-  (if mh-previous-window-config
-      (set-window-configuration mh-previous-window-config))
-  (run-hooks 'mh-quit-hook))
-
-(defun mh-page-msg (&optional arg)
-  "Page the displayed message forwards.
-Scrolls ARG lines or a full screen if no argument is supplied."
-  (interactive "P")
-  (scroll-other-window arg))
-
-
-(defun mh-previous-page (&optional arg)
-  "Page the displayed message backwards.
-Scrolls ARG lines or a full screen if no argument is supplied."
-  (interactive "P")
-  (mh-in-show-buffer (mh-show-buffer)
-    (scroll-down arg)))
-
-
-(defun mh-previous-undeleted-msg (&optional arg)
-  "Move to the NTH previous undeleted message in window."
-  (interactive "p")
-  (setq mh-next-direction 'backward)
-  (beginning-of-line)
-  (cond ((re-search-backward mh-good-msg-regexp nil 0 arg)
-	 (mh-maybe-show))
-	(t
-	 (if (get-buffer mh-show-buffer)
-	     (delete-windows-on mh-show-buffer)))))
-
-
-(defun mh-rescan-folder (&optional range)
-  "Rescan a folder after optionally processing the outstanding commands.
-If optional prefix argument is provided, prompt for the range of
-messages to display.  Otherwise show the entire folder."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-msg-range "Range to scan [all]? ")
-		       nil)))
-  (setq mh-next-direction 'forward)
-  (mh-scan-folder mh-current-folder (or range "all")))
-
-
-(defun mh-write-msg-to-file (msg file no-headers)
-  "Append MESSAGE to the end of a FILE.
-If NO-HEADERS (prefix argument) is provided, write only the message body.
-Otherwise send the entire message including the headers."
-  (interactive
-   (list (mh-get-msg-num t)
-	 (let ((default-dir (if (eq 'write (car mh-last-destination))
-				(file-name-directory (car (cdr mh-last-destination)))
-			      default-directory)))
-	   (read-file-name (format "Save message%s in file: "
-				   (if current-prefix-arg " body" ""))
-			   default-dir
-			   (if (eq 'write (car mh-last-destination))
-			       (car (cdr mh-last-destination))
-			     (expand-file-name "mail.out" default-dir))))
-	 current-prefix-arg))
-  (let ((msg-file-to-output (mh-msg-filename msg))
-	(output-file (mh-expand-file-name file)))
-    (setq mh-last-destination (list 'write file (if no-headers 'no-headers)))
-    (save-excursion
-      (set-buffer (get-buffer-create mh-temp-buffer))
-      (erase-buffer)
-      (insert-file-contents msg-file-to-output)
-      (goto-char (point-min))
-      (if no-headers (search-forward "\n\n"))
-      (append-to-file (point) (point-max) output-file))))
-
-
-(defun mh-toggle-showing ()
-  "Toggle the scanning mode/showing mode of displaying messages."
-  (interactive)
-  (if mh-showing
-      (mh-set-scan-mode)
-      (mh-show)))
-
-
-(defun mh-undo (msg-or-seq)
-  "Undo the pending deletion or refile of the specified MESSAGE(s).
-Default is the displayed message.  If optional prefix argument is
-provided, then prompt for the message sequence."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-seq-default "Undo" t)
-			 (mh-get-msg-num t))))
-  (cond ((numberp msg-or-seq)
-	 (let ((original-position (point)))
-	   (beginning-of-line)
-	   (while (not (or (looking-at mh-deleted-msg-regexp)
-			   (looking-at mh-refiled-msg-regexp)
-			   (and (eq mh-next-direction 'forward) (bobp))
-			   (and (eq mh-next-direction 'backward)
-				(save-excursion (forward-line) (eobp)))))
-	     (forward-line (if (eq mh-next-direction 'forward) -1 1)))
-	   (if (or (looking-at mh-deleted-msg-regexp)
-		   (looking-at mh-refiled-msg-regexp))
-	       (progn
-		 (mh-undo-msg (mh-get-msg-num t))
-		 (mh-maybe-show))
-	       (goto-char original-position)
-	       (error "Nothing to undo"))))
-	(t
-	 (mh-map-to-seq-msgs 'mh-undo-msg msg-or-seq)))
-  ;; update the mh-refile-list so mh-outstanding-commands-p will work
-  (mh-mapc (function
-	    (lambda (elt)
-	      (if (not (mh-seq-to-msgs elt))
-		  (setq mh-refile-list (delq elt mh-refile-list)))))
-	   mh-refile-list)
-  (if (not (mh-outstanding-commands-p))
-      (mh-set-folder-modified-p nil)))
-
-
-;;;###autoload
-(defun mh-version ()
-  "Display version information about mh-e and the MH mail handling system."
-  (interactive)
-  (mh-find-progs)
-  (set-buffer (get-buffer-create mh-temp-buffer))
-  (erase-buffer)
-  (insert "  mh-e info:\n\nversion: " mh-e-RCS-id
-	  "\nEmacs: " emacs-version " on " (symbol-name system-type) " ")
-  (condition-case ()
-      (call-process "uname" nil t nil "-a")
-    (file-error))
-  (insert "\n\n  MH info:\n\n" (expand-file-name "inc" mh-progs) ":\n")
-  (let ((help-start (point)))
-    (condition-case err-data
-	(mh-exec-cmd-output "inc" nil "-help")
-      (file-error (insert (mapconcat 'concat (cdr err-data) ": "))))
-    (goto-char help-start)
-    (search-forward "version: " nil t)
-    (beginning-of-line)
-    (delete-region help-start (point))
-    (goto-char (point-min)))
-  (display-buffer mh-temp-buffer))
-
-
-(defun mh-visit-folder (folder &optional range)
-  "Visit FOLDER and display RANGE of messages.
-Do not call this function from outside mh-e; see \\[mh-rmail] instead."
-  (interactive (list (mh-prompt-for-folder "Visit" mh-inbox t)
-		     (mh-read-msg-range "Range [all]? ")))
-  (let ((config (current-window-configuration)))
-    (mh-scan-folder folder (or range "all"))
-    (setq mh-previous-window-config config))
-  nil)
-
-
-(defun mh-compat-quit ()
-  "The \"b\" key is obsolescent; will assume you want \"\\[mh-quit]\" ..."
-  ;; Was going to make it run mh-burst-digest, but got complaint that
-  ;; 'b' should mean 'back', as it does in info, less, and rn.
-  ;; This is a temporary compatibility function.
-  (interactive)
-  (message "%s" (documentation this-command))
-  (sit-for 1)
-  (call-interactively 'mh-quit))
-
-
-(defun mh-update-sequences ()
-  "Update MH's Unseen sequence and current folder and message.
-Flush mh-e's state out to MH.  The message at the cursor becomes current."
-  (interactive)
-  ;; mh-update-sequences is the opposite of mh-read-folder-sequences,
-  ;; which updates mh-e's state from MH.
-  (let ((folder-set (mh-update-unseen))
-	(new-cur (mh-get-msg-num nil)))
-    (if new-cur
-	(let ((seq-entry (mh-find-seq 'cur)))
-	  (mh-remove-cur-notation)
-	  (setcdr seq-entry (list new-cur)) ;delete-seq-locally, add-msgs-to-seq
-	  (mh-define-sequence 'cur (list new-cur))
-	  (beginning-of-line)
-	  (if (looking-at mh-good-msg-regexp)
-	      (mh-notate nil mh-note-cur mh-cmd-note)))
-      (or folder-set
-	  (save-excursion
-	    (mh-exec-cmd-quiet t "folder" mh-current-folder "-fast"))))))
-
-
-
-
-;;; Support routines.
-
-(defun mh-delete-a-msg (msg)
-  ;; Delete the MESSAGE.
-  (save-excursion
-    (mh-goto-msg msg nil t)
-    (if (looking-at mh-refiled-msg-regexp)
-	(error "Message %d is refiled.  Undo refile before deleting." msg))
-    (if (looking-at mh-deleted-msg-regexp)
-	nil
-	(mh-set-folder-modified-p t)
-	(setq mh-delete-list (cons msg mh-delete-list))
-	(mh-add-msgs-to-seq msg 'deleted t)
-	(mh-notate msg mh-note-deleted mh-cmd-note)
-	(run-hooks 'mh-delete-msg-hook))))
-
-(defun mh-refile-a-msg (msg destination)
-  ;; Refile MESSAGE in FOLDER.  FOLDER is a symbol, not a string.
-  (save-excursion
-    (mh-goto-msg msg nil t)
-    (cond ((looking-at mh-deleted-msg-regexp)
-	   (error "Message %d is deleted.  Undo delete before moving." msg))
-	  ((looking-at mh-refiled-msg-regexp)
-	   (if (y-or-n-p
-		(format "Message %d already refiled.  Copy to %s as well? "
-			msg destination))
-	       (mh-exec-cmd "refile" (mh-get-msg-num t) "-link"
-			    "-src" mh-current-folder
-			    (symbol-name destination))
-	       (message "Message not copied.")))
-	  (t
-	   (mh-set-folder-modified-p t)
-	   (if (not (memq destination mh-refile-list))
-	       (setq mh-refile-list (cons destination mh-refile-list)))
-	   (if (not (memq msg (mh-seq-to-msgs destination)))
-	       (mh-add-msgs-to-seq msg destination t))
-	   (mh-notate msg mh-note-refiled mh-cmd-note)
-	   (run-hooks 'mh-refile-msg-hook)))))
-
-
-(defun mh-next-msg ()
-  ;; Move backward or forward to the next undeleted message in the buffer.
-  (if (eq mh-next-direction 'forward)
-      (mh-next-undeleted-msg 1)
-      (mh-previous-undeleted-msg 1)))
-
-
-(defun mh-set-scan-mode ()
-  ;; Display the scan listing buffer, but do not show a message.
-  (if (get-buffer mh-show-buffer)
-      (delete-windows-on mh-show-buffer))
-  (setq mh-showing nil)
-  (force-mode-line-update)
-  (if mh-recenter-summary-p
-      (mh-recenter nil)))
-
-
-(defun mh-undo-msg (msg)
-  ;; Undo the deletion or refile of one MESSAGE.
-  (cond ((memq msg mh-delete-list)
-	 (setq mh-delete-list (delq msg mh-delete-list))
-	 (mh-delete-msg-from-seq msg 'deleted t))
-	(t
-	 (mh-mapc (function (lambda (dest)
-			      (mh-delete-msg-from-seq msg dest t)))
-		  mh-refile-list)))
-  (mh-notate msg ?  mh-cmd-note))
-
-
-
-
-;;; The folder data abstraction.
-
-(defun mh-make-folder (name)
-  ;; Create and initialize a new mail folder called NAME and make it the
-  ;; current folder.
-  (switch-to-buffer name)
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  (setq buffer-read-only t)
-  (mh-folder-mode)
-  (mh-set-folder-modified-p nil)
-  (setq buffer-file-name mh-folder-filename)
-  (mh-make-folder-mode-line))
-
-
-;;; Ensure new buffers won't get this mode if default-major-mode is nil.
-(put 'mh-folder-mode 'mode-class 'special)
-
-(defun mh-folder-mode ()
-  "Major mh-e mode for \"editing\" an MH folder scan listing.\\<mh-folder-mode-map>
-You can show the message the cursor is pointing to, and step through the
-messages.  Messages can be marked for deletion or refiling into another
-folder; these commands are executed all at once with a separate command.
-
-A prefix argument (\\[universal-argument]) to delete, refile, list, or undo
-applies the action to a message sequence.
-
-Here is a list of the standard keys for mh-e commands, grouped by function.
-This list is purposefully not customized; mh-e has a long history, and many
-alternate key bindings as a result.  This list is to encourage users to use
-standard keys so the other keys can perhaps someday be put to new uses.
-
-t	toggle show or scan-only mode
-RET	show message, or back to top if already showing
-
-SPC	page message forward
-DEL	page message back
-
-n	next message
-p	previous message
-g	go to message by number
-
-d	mark for deletion
-o, ^	mark for output (refile) to another folder
-?	show folder of pending refile
-u	undo delete or refile marking
-
-x	execute marked deletes and refiles
-i	incorporate new mail
-
-m	mail a new message
-r	reply to a message
-f	forward a message
-
-q	quit mh-e
-
-M-f	visit new folder
-M-r	rescan this folder
-
-Here are all the commands with their current binding, listed in key order:
-\\{mh-folder-mode-map}
-
-Variables controlling mh-e operation are (defaults in parentheses):
-
- mh-recursive-folders (nil)
-    Non-nil means commands which operate on folders do so recursively.
-
- mh-bury-show-buffer (t)
-    Non-nil means that the buffer used to display message is buried.
-    It will never be offered as the default other buffer.
-
- mh-clean-message-header (nil)
-    Non-nil means remove header lines matching the regular expression
-    specified in mh-invisible-headers from messages.
-
- mh-visible-headers (nil)
-    If non-nil, it contains a regexp specifying the headers that are shown in
-    a message if mh-clean-message-header is non-nil.  Setting this variable
-    overrides mh-invisible-headers.
-
- mh-do-not-confirm (nil)
-    Non-nil means do not prompt for confirmation before executing some
-    non-recoverable commands such as mh-kill-folder and mh-undo-folder.
-
- mhl-formfile (nil)
-    Name of format file to be used by mhl to show messages.
-    A value of T means use the default format file.
-    Nil means don't use mhl to format messages.
-
- mh-lpr-command-format (\"lpr -p -J '%s'\")
-    Format for command used to print a message on a system printer.
-
- mh-scan-prog (\"scan\")
-    Program to run to generate one-line-per-message listing of a folder.
-    Normally \"scan\" or a file name linked to scan.  This file is searched
-    for relative to the mh-progs directory unless it is an absolute pathname.
-    Automatically becomes buffer-local when set in any fashion.
-
- mh-print-background (nil)
-    Print messages in the background if non-nil.
-    WARNING: do not delete the messages until printing is finished;
-    otherwise, your output may be truncated.
-
- mh-recenter-summary-p (nil)
-    If non-nil, then the scan listing is recentered when the window displaying
-    a messages is toggled off.
-
- mh-summary-height (4)
-    Number of lines in the summary window including the mode line.
-
-The value of mh-folder-mode-hook is called when a new folder is set up."
-
-  (kill-all-local-variables)
-  (use-local-map mh-folder-mode-map)
-  (setq major-mode 'mh-folder-mode)
-  (mh-set-mode-name "MH-Folder")
-  (mh-make-local-vars
-   'mh-current-folder (buffer-name)	; Name of folder, a string
-   'mh-show-buffer (format "show-%s" (buffer-name)) ; Buffer that displays msgs
-   'mh-folder-filename			; e.g. "/usr/foobar/Mail/inbox/"
-   (file-name-as-directory (mh-expand-file-name (buffer-name)))
-   'mh-showing nil			; Show message also?
-   'mh-delete-list nil			; List of msgs nums to delete
-   'mh-refile-list nil			; List of folder names in mh-seq-list
-   'mh-seq-list nil			; Alist of (seq . msgs) nums
-   'mh-seen-list nil			; List of displayed messages
-   'mh-next-direction 'forward		; Direction to move to next message
-   'mh-narrowed-to-seq nil		; Sequence display is narrowed to
-   'mh-first-msg-num nil		; Number of first msg in buffer
-   'mh-last-msg-num nil			; Number of last msg in buffer
-   'mh-msg-count nil			; Number of msgs in buffer
-   'mh-mode-line-annotation nil		; Indiction this is not the full folder
-   'mh-previous-window-config nil)	; Previous window configuration
-  (setq truncate-lines t)
-  (auto-save-mode -1)
-  (setq buffer-offer-save t)
-  (if (boundp 'local-write-file-hooks)
-      (setq local-write-file-hooks '(mh-execute-commands)) ;Emacs 19
-    (make-local-variable 'write-file-hooks)
-    (setq write-file-hooks '(mh-execute-commands))) ;Emacs 18
-  (make-local-variable 'revert-buffer-function)
-  (setq revert-buffer-function 'mh-undo-folder)
-  (or (assq 'mh-showing minor-mode-alist)
-      (setq minor-mode-alist
-	    (cons '(mh-showing " Show") minor-mode-alist)))
-  (run-hooks 'mh-folder-mode-hook))
-
-
-(defun mh-make-local-vars (&rest pairs)
-  ;; Take VARIABLE-VALUE pairs and make local variables initialized to the
-  ;; value.
-  (while pairs
-    (make-variable-buffer-local (car pairs))
-    (set (car pairs) (car (cdr pairs)))
-    (setq pairs (cdr (cdr pairs)))))
-
-
-(defun mh-scan-folder (folder range)
-  ;; Scan the FOLDER over the RANGE.  Return in the folder's buffer.
-  (cond ((null (get-buffer folder))
-	 (mh-make-folder folder))
-	(t
-	 (mh-process-or-undo-commands folder)
-	 (switch-to-buffer folder)))
-  (mh-regenerate-headers range)
-  (cond ((zerop (buffer-size))
-	 (if (equal range "all")
-	     (message "Folder %s is empty" folder)
-	   (message "No messages in %s, range %s" folder range))
-	 (sit-for 5)))
-  (mh-goto-cur-msg))
-
-
-(defun mh-regenerate-headers (range &optional update)
-  ;; scan folder over range RANGE.
-  ;; If UPDATE, append the scan lines, otherwise replace.
-  (let ((folder mh-current-folder)
-	scan-start)
-    (message "Scanning %s..." folder)
-    (with-mh-folder-updating (nil)
-      (if update
-	  (goto-char (point-max))
-	(erase-buffer))
-      (setq scan-start (point))
-      (mh-exec-cmd-output mh-scan-prog nil
-			  "-noclear" "-noheader"
-			  "-width" (window-width)
-			  folder range)
-      (goto-char scan-start)
-      (cond ((looking-at "scan: no messages in")
-	     (keep-lines mh-valid-scan-line)) ; Flush random scan lines
-	    ((looking-at "scan: "))	; Keep error messages
-	    (t
-	     (keep-lines mh-valid-scan-line))) ; Flush random scan lines
-      (setq mh-seq-list (mh-read-folder-sequences folder nil))
-      (mh-notate-user-sequences)
-      (or update
-	  (setq mh-mode-line-annotation
-		(if (equal range "all")
-		    nil
-		  mh-partial-folder-mode-line-annotation)))
-      (mh-make-folder-mode-line))
-    (message "Scanning %s...done" folder)))
-
-
-(defun mh-get-new-mail (maildrop-name)
-  ;; Read new mail from a maildrop into the current buffer.
-  ;; Return in the current buffer.
-  (let ((point-before-inc (point))
-	(folder mh-current-folder)
-	(new-mail-p nil))
-    (with-mh-folder-updating (t)
-      (if maildrop-name
-	  (message "inc %s -file %s..." folder maildrop-name)
-	(message "inc %s..." folder))
-      (setq mh-next-direction 'forward)
-      (goto-char (point-max))
-      (let ((start-of-inc (point)))
-	(if maildrop-name
-	    ;; I think MH 5 used "-ms-file" instead of "-file",
-	    ;; which would make inc'ing from maildrops fail.
-	    (mh-exec-cmd-output mh-inc-prog nil folder
-				"-file" (expand-file-name maildrop-name)
-				"-width" (window-width)
-				"-truncate")
-	    (mh-exec-cmd-output mh-inc-prog nil
-				"-width" (window-width)))
-	(if maildrop-name
-	    (message "inc %s -file %s...done" folder maildrop-name)
-	  (message "inc %s...done" folder))
-	(goto-char start-of-inc)
-	(cond ((save-excursion
-		 (re-search-forward "^inc: no mail" nil t))
-	       (message "No new mail%s%s" (if maildrop-name " in " "")
-			(if maildrop-name maildrop-name "")))
-	      ((re-search-forward "^inc:" nil t) ; Error messages
-	       (error "inc error"))
-	      (t
-	       (mh-remove-cur-notation)
-	       (setq new-mail-p t)))
-	(keep-lines mh-valid-scan-line) ; Flush random scan lines
-	(setq mh-seq-list (mh-read-folder-sequences folder t))
-	(mh-notate-user-sequences)
-	(if new-mail-p
-	    (progn
-	      (mh-make-folder-mode-line)
-	      (mh-goto-cur-msg))
-	    (goto-char point-before-inc))))))
-
-
-(defun mh-make-folder-mode-line (&optional ignored)
-  ;; Set the fields of the mode line for a folder buffer.
-  ;; The optional argument is now obsolete.  It used to be used to pass
-  ;; in what is now stored in the buffer-local variable
-  ;; mh-mode-line-annotation.
-  (save-excursion
-    (mh-first-msg)
-    (setq mh-first-msg-num (mh-get-msg-num nil))
-    (mh-last-msg)
-    (setq mh-last-msg-num (mh-get-msg-num nil))
-    (setq mh-msg-count (count-lines (point-min) (point-max)))
-    (setq mode-line-buffer-identification
-	  (list (format "{%%b%s} %d msg%s"
-			(if mh-mode-line-annotation
-			    (format "/%s" mh-mode-line-annotation)
-			  "")
-			mh-msg-count
-			(if (zerop mh-msg-count)
-			    "s"
-			  (if (> mh-msg-count 1)
-			      (format "s (%d-%d)" mh-first-msg-num
-				      mh-last-msg-num)
-			    (format " (%d)" mh-first-msg-num))))))))
-
-
-(defun mh-unmark-all-headers (remove-all-flags)
-  ;; Remove all '+' flags from the headers, and if called with a non-nil
-  ;; argument, remove all 'D', '^' and '%' flags too.
-  ;; Optimized for speed (i.e., no regular expressions).
-  (save-excursion
-    (let ((case-fold-search nil)
-	  (last-line (1- (point-max)))
-	  char)
-      (mh-first-msg)
-      (while (<= (point) last-line)
-	(forward-char mh-cmd-note)
-	(setq char (following-char))
-	(if (or (and remove-all-flags
-		     (or (eql char (aref mh-note-deleted 0))
-			 (eql char (aref mh-note-refiled 0))))
-		(eql char (aref mh-note-cur 0)))
-	    (progn
-	      (delete-char 1)
-	      (insert " ")))
-	(if remove-all-flags
-	    (progn
-	      (forward-char 1)
-	      (if (eql (following-char) (aref mh-note-seq 0))
-		  (progn
-		    (delete-char 1)
-		    (insert " ")))))
-	(forward-line)))))
-
-
-(defun mh-remove-cur-notation ()
-  ;; Remove old cur notation (cf mh-goto-cur-msg code).
-  (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
-    (save-excursion
-      (and cur-msg
-	   (mh-goto-msg cur-msg t t)
-	   (looking-at mh-cur-scan-msg-regexp)
-	   (mh-notate nil ?  mh-cmd-note)))))
-
-(defun mh-goto-cur-msg ()
-  ;; Position the cursor at the current message.
-  (let ((cur-msg (car (mh-seq-to-msgs 'cur))))
-    (cond ((and cur-msg
-		(mh-goto-msg cur-msg t t))
-	   (mh-notate nil mh-note-cur mh-cmd-note)
-	   (mh-recenter 0)
-	   (mh-maybe-show cur-msg))
-	  (t
-	   (mh-last-msg)
-	   (message "No current message")))))
-
-
-(defun mh-process-or-undo-commands (folder)
-  ;; If FOLDER has outstanding commands, then either process or discard them.
-  ;; Called by functions like mh-sort-folder, so also invalidate show buffer.
-  (set-buffer folder)
-  (if (mh-outstanding-commands-p)
-      (if (or mh-do-not-confirm
-	      (y-or-n-p
-		"Process outstanding deletes and refiles (or lose them)? "))
-	  (mh-process-commands folder)
-	  (mh-undo-folder)))
-  (mh-update-unseen)
-  (mh-invalidate-show-buffer))
-
-
-(defun mh-process-commands (folder)
-  ;; Process outstanding commands for the folder FOLDER.
-  (message "Processing deletes and refiles for %s..." folder)
-  (set-buffer folder)
-  (with-mh-folder-updating (nil)
-    ;; Update the unseen sequence if it exists
-    (mh-update-unseen)
-
-    ;; Then refile messages
-    (mh-mapc
-     (function
-      (lambda (dest)
-	(let ((msgs (mh-seq-to-msgs dest)))
-	  (cond (msgs
-		 (apply 'mh-exec-cmd "refile"
-			"-src" folder (symbol-name dest)
-			(mh-coalesce-msg-list msgs))
-		 (mh-delete-scan-msgs msgs))))))
-     mh-refile-list)
-    (setq mh-refile-list nil)
-
-    ;; Now delete messages
-    (cond (mh-delete-list
-	   (apply 'mh-exec-cmd "rmm" folder
-		  (mh-coalesce-msg-list mh-delete-list))
-	   (mh-delete-scan-msgs mh-delete-list)
-	   (setq mh-delete-list nil)))
-
-    ;; Don't need to remove sequences since delete and refile do so.
-
-    ;; Mark cur message
-    (if (> (buffer-size) 0)
-	(mh-define-sequence 'cur (list (or (mh-get-msg-num nil) "last"))))
-
-    (and (buffer-file-name (get-buffer mh-show-buffer))
-	 (not (file-exists-p (buffer-file-name (get-buffer mh-show-buffer))))
-	 ;; If "inc" were to put a new msg in this file,
-	 ;; we would not notice, so mark it invalid now.
-	 (mh-invalidate-show-buffer))
-
-    (setq mh-seq-list (mh-read-folder-sequences mh-current-folder nil))
-    (mh-unmark-all-headers t)
-    (mh-notate-user-sequences)
-    (message "Processing deletes and refiles for %s...done" folder)))
-
-
-(defun mh-update-unseen ()
-  ;; Flush updates to the Unseen sequence out to MH.
-  ;; Return non-NIL iff set the MH folder.
-  (if mh-seen-list
-      (let* ((unseen-seq (mh-find-seq mh-unseen-seq))
-	     (unseen-msgs (mh-seq-msgs unseen-seq)))
-	(if unseen-msgs
-	    (progn
-	      (mh-undefine-sequence mh-unseen-seq mh-seen-list)
-	      (while mh-seen-list
-		(setq unseen-msgs (delq (car mh-seen-list) unseen-msgs))
-		(setq mh-seen-list (cdr mh-seen-list)))
-	      (setcdr unseen-seq unseen-msgs)
-	      t)			;since we set the folder
-	  (setq mh-seen-list nil)))))
-
-
-(defun mh-delete-scan-msgs (msgs)
-  ;; Delete the scan listing lines for each of the msgs in the LIST.
-  (save-excursion
-    (while msgs
-      (if (mh-goto-msg (car msgs) t t)
-	  (mh-delete-line 1))
-      (setq msgs (cdr msgs)))))
-
-
-(defun mh-outstanding-commands-p ()
-  ;; Returns non-nil if there are outstanding deletes or refiles.
-  (or mh-delete-list mh-refile-list))
-
-
-(defun mh-coalesce-msg-list (messages)
-  ;; Give a list of MESSAGES, return a list of message number ranges.
-  ;; Sort of the opposite of mh-read-msg-list, which expands ranges.
-  ;; Message lists passed to MH programs go through this so
-  ;; command line arguments won't exceed system limits.
-  (let ((msgs (sort (copy-sequence messages) 'mh-greaterp))
-	(range-high nil)
-	(prev -1)
-	(ranges nil))
-    (while prev
-      (if range-high
-	  (if (or (not (numberp prev))
-		  (not (eql (car msgs) (1- prev))))
-	      (progn			;non-sequential, flush old range
-		(if (eql prev range-high)
-		    (setq ranges (cons range-high ranges))
-		  (setq ranges (cons (format "%s-%s" prev range-high) ranges)))
-		(setq range-high nil))))
-      (or range-high
-	  (setq range-high (car msgs))) ;start new or first range
-      (setq prev (car msgs))
-      (setq msgs (cdr msgs)))
-    ranges))
-
-(defun mh-greaterp (msg1 msg2)
-  ;; Sort two message indicators.  Strings are "smaller" than numbers.
-  ;; Legal values are things like "cur", "last", 1, and 1820.
-  (if (numberp msg1)
-	 (if (numberp msg2)
-	     (> msg1 msg2)
-	   t)
-    (if (numberp msg2)
-	nil
-      (string-lessp msg2 msg1))))
-
-
-
-;;; Basic sequence handling
-
-(defun mh-delete-seq-locally (seq)
-  ;; Remove mh-e's record of SEQUENCE.
-  (let ((entry (mh-find-seq seq)))
-    (setq mh-seq-list (delq entry mh-seq-list))))
-
-(defun mh-read-folder-sequences (folder save-refiles)
-  ;; Read and return the predefined sequences for a FOLDER.
-  ;; If SAVE-REFILES is non-nil, then keep the sequences
-  ;; that note messages to be refiled.
-  (let ((seqs ()))
-    (cond (save-refiles
-	    (mh-mapc (function (lambda (seq) ; Save the refiling sequences
-				 (if (mh-folder-name-p (mh-seq-name seq))
-				     (setq seqs (cons seq seqs)))))
-		     mh-seq-list)))
-    (save-excursion
-      (if (eq 0 (mh-exec-cmd-quiet nil "mark" folder "-list"))
-	  (progn
-	    ;; look for name in line of form "cur: 4" or "myseq (private): 23"
-	    (while (re-search-forward "^[^: ]+" nil t)
-	      (setq seqs (cons (mh-make-seq (intern (buffer-substring
-						     (match-beginning 0)
-						     (match-end 0)))
-					    (mh-read-msg-list))
-			       seqs)))
-	    (delete-region (point-min) (point))))) ; avoid race with mh-process-daemon
-    seqs))
-
-(defun mh-read-msg-list ()
-  ;; Return a list of message numbers from the current point to the end of
-  ;; the line.  Expands ranges into set of individual numbers.
-  (let ((msgs ())
-	(end-of-line (save-excursion (end-of-line) (point)))
-	num)
-    (while (re-search-forward "[0-9]+" end-of-line t)
-      (setq num (string-to-int (buffer-substring (match-beginning 0)
-						 (match-end 0))))
-      (cond ((looking-at "-")		; Message range
-	     (forward-char 1)
-	     (re-search-forward "[0-9]+" end-of-line t)
-	     (let ((num2 (string-to-int (buffer-substring (match-beginning 0)
-							  (match-end 0)))))
-	       (if (< num2 num)
-		   (error "Bad message range: %d-%d" num num2))
-	       (while (<= num num2)
-		 (setq msgs (cons num msgs))
-		 (setq num (1+ num)))))
-	    ((not (zerop num))		;"pick" outputs "0" to mean no match
-	     (setq msgs (cons num msgs)))))
-    msgs))
-
-(defun mh-notate-user-sequences ()
-  ;; Mark the scan listing of all messages in user-defined sequences.
-  (let ((seqs mh-seq-list)
-	name)
-    (while seqs
-      (setq name (mh-seq-name (car seqs)))
-      (if (not (mh-internal-seq name))
-	  (mh-notate-seq name mh-note-seq (1+ mh-cmd-note)))
-      (setq seqs (cdr seqs)))))
-
-
-(defun mh-internal-seq (name)
-  ;; Return non-NIL if NAME is the name of an internal mh-e sequence.
-  (or (memq name '(answered cur deleted forwarded printed))
-      (eq name mh-unseen-seq)
-      (eq name mh-previous-seq)
-      (mh-folder-name-p name)))
-
-
-(defun mh-delete-msg-from-seq (message sequence &optional internal-flag)
-  "Delete MESSAGE from SEQUENCE.  MESSAGE defaults to displayed message.
-From Lisp, optional third arg INTERNAL-FLAG non-nil means do not
-inform MH of the change."
-  (interactive (list (mh-get-msg-num t)
-		     (mh-read-seq-default "Delete from" t)
-		     nil))
-  (let ((entry (mh-find-seq sequence)))
-    (cond (entry
-	   (mh-notate-if-in-one-seq message ?  (1+ mh-cmd-note) sequence)
-	   (if (not internal-flag)
-	       (mh-undefine-sequence sequence (list message)))
-	   (setcdr entry (delq message (mh-seq-msgs entry)))))))
-
-
-(defun mh-undefine-sequence (seq msgs)
-  ;; Remove from the SEQUENCE the list of MSGS.
-  (mh-exec-cmd "mark" mh-current-folder "-delete"
-	       "-sequence" (symbol-name seq)
-	       (mh-coalesce-msg-list msgs)))
-
-
-(defun mh-define-sequence (seq msgs)
-  ;; Define the SEQUENCE to contain the list of MSGS.
-  ;; Do not mark pseudo-sequences or empty sequences.
-  ;; Signals an error if SEQUENCE is an illegal name.
-  (if (and msgs
-	   (not (mh-folder-name-p seq)))
-      (save-excursion
-	(mh-exec-cmd-error nil "mark" mh-current-folder "-add" "-zero"
-			   "-sequence" (symbol-name seq)
-			   (mh-coalesce-msg-list msgs)))))
-
-
-(defun mh-map-over-seqs (func seq-list)
-  ;; Apply the FUNCTION to each element in the list of SEQUENCES,
-  ;; passing the sequence name and the list of messages as arguments.
-  (while seq-list
-    (funcall func (mh-seq-name (car seq-list)) (mh-seq-msgs (car seq-list)))
-    (setq seq-list (cdr seq-list))))
-
-
-(defun mh-notate-if-in-one-seq (msg notation offset seq)
-  ;; If the MESSAGE is in only the SEQUENCE, then mark the scan listing of the
-  ;; message with the CHARACTER at the given OFFSET from the beginning of the
-  ;; listing line.
-  (let ((in-seqs (mh-seq-containing-msg msg nil)))
-    (if (and (eq seq (car in-seqs)) (null (cdr in-seqs)))
-	(mh-notate msg notation offset))))
-
-
-(defun mh-seq-containing-msg (msg &optional include-internal-p)
-  ;; Return a list of the sequences containing MESSAGE.
-  ;; If INCLUDE-INTERNAL-P non-nil, include mh-e internal sequences in list.
-  (let ((l mh-seq-list)
-	(seqs ()))
-    (while l
-      (and (memq msg (mh-seq-msgs (car l)))
-	   (or include-internal-p
-	       (not (mh-internal-seq (mh-seq-name (car l)))))
-	   (setq seqs (cons (mh-seq-name (car l)) seqs)))
-      (setq l (cdr l)))
-    seqs))
-
-
-
-
-;;; User prompting commands.
-
-
-(defun mh-read-msg-range (prompt)
-  ;; Read a list of blank-separated items.
-  (let* ((buf (read-string prompt))
-	 (buf-size (length buf))
-	 (start 0)
-	 (input ()))
-    (while (< start buf-size)
-      (let ((next (read-from-string buf start buf-size)))
-	(setq input (cons (car next) input))
-	(setq start (cdr next))))
-    (nreverse input)))
-
-
-
-;;; Build the folder-mode keymap:
-
-(suppress-keymap mh-folder-mode-map)
-(define-key mh-folder-mode-map "q" 'mh-quit)
-(define-key mh-folder-mode-map "b" 'mh-compat-quit)
-(define-key mh-folder-mode-map "?" 'mh-msg-is-in-seq)
-(define-key mh-folder-mode-map "%" 'mh-put-msg-in-seq)
-(define-key mh-folder-mode-map "|" 'mh-pipe-msg)
-(define-key mh-folder-mode-map "\ea" 'mh-edit-again)
-(define-key mh-folder-mode-map "\e%" 'mh-delete-msg-from-seq)
-(define-key mh-folder-mode-map "\e#" 'mh-delete-seq)
-(define-key mh-folder-mode-map "\C-xn" 'mh-narrow-to-seq)
-(define-key mh-folder-mode-map "\C-xw" 'mh-widen)
-(define-key mh-folder-mode-map "\eb" 'mh-burst-digest)
-(define-key mh-folder-mode-map "\eu" 'mh-undo-folder)
-(define-key mh-folder-mode-map "\e " 'mh-page-digest)
-(define-key mh-folder-mode-map "\e\177" 'mh-page-digest-backwards)
-(define-key mh-folder-mode-map "\ed" 'mh-redistribute)
-(define-key mh-folder-mode-map "\ee" 'mh-extract-rejected-mail)
-(define-key mh-folder-mode-map "\ef" 'mh-visit-folder)
-(define-key mh-folder-mode-map "\ek" 'mh-kill-folder)
-(define-key mh-folder-mode-map "\el" 'mh-list-folders)
-(define-key mh-folder-mode-map "\en" 'mh-store-msg)
-(define-key mh-folder-mode-map "\ep" 'mh-pack-folder)
-(define-key mh-folder-mode-map "\eq" 'mh-list-sequences)
-(define-key mh-folder-mode-map "\es" 'mh-search-folder)
-(define-key mh-folder-mode-map "\er" 'mh-rescan-folder)
-(define-key mh-folder-mode-map "l" 'mh-print-msg)
-(define-key mh-folder-mode-map "t" 'mh-toggle-showing)
-(define-key mh-folder-mode-map "c" 'mh-copy-msg)
-(define-key mh-folder-mode-map "i" 'mh-inc-folder)
-(define-key mh-folder-mode-map "x" 'mh-execute-commands)
-(define-key mh-folder-mode-map "e" 'mh-execute-commands)
-(define-key mh-folder-mode-map "f" 'mh-forward)
-(define-key mh-folder-mode-map "m" 'mh-send)
-(define-key mh-folder-mode-map "s" 'mh-send)
-(define-key mh-folder-mode-map "r" 'mh-reply)
-(define-key mh-folder-mode-map "a" 'mh-reply)
-(define-key mh-folder-mode-map "j" 'mh-goto-msg)
-(define-key mh-folder-mode-map "g" 'mh-goto-msg)
-(define-key mh-folder-mode-map "\e<" 'mh-first-msg)
-(define-key mh-folder-mode-map "\e>" 'mh-last-msg)
-(define-key mh-folder-mode-map "\177" 'mh-previous-page)
-(define-key mh-folder-mode-map " " 'mh-page-msg)
-(define-key mh-folder-mode-map "\r" 'mh-show)
-(define-key mh-folder-mode-map "." 'mh-show)
-(define-key mh-folder-mode-map "," 'mh-header-display)
-(define-key mh-folder-mode-map "u" 'mh-undo)
-(define-key mh-folder-mode-map "d" 'mh-delete-msg)
-(define-key mh-folder-mode-map "\C-d" 'mh-delete-msg-no-motion)
-(define-key mh-folder-mode-map "p" 'mh-previous-undeleted-msg)
-(define-key mh-folder-mode-map "n" 'mh-next-undeleted-msg)
-(define-key mh-folder-mode-map "o" 'mh-refile-msg)
-(define-key mh-folder-mode-map "^" 'mh-refile-msg)
-(define-key mh-folder-mode-map "\C-o" 'mh-write-msg-to-file)
-(define-key mh-folder-mode-map ">" 'mh-write-msg-to-file)
-(define-key mh-folder-mode-map "!" 'mh-refile-or-write-again)
-
-;; "C-c /" prefix is used in mh-folder-mode by pgp.el and mailcrypt
-
-
-
-;;;autoload the other mh-e parts
-
-;;; mh-comp
-
-(autoload 'mh-smail "mh-comp"
-  "Compose and send mail with the MH mail system.
-This function is an entry point to mh-e, the Emacs front end
-to the MH mail system.
-See documentation of `\\[mh-send]' for more details on composing mail." t)
-
-(autoload 'mh-smail-other-window "mh-comp"
-  "Compose and send mail in other window with the MH mail system.
-This function is an entry point to mh-e, the Emacs front end
-to the MH mail system.
-See documentation of `\\[mh-send]' for more details on composing mail." t)
-
-(autoload 'mh-edit-again "mh-comp"
-  "Clean-up a draft or a message previously sent and make it resendable.
-Default is the current message.
-The variable mh-new-draft-cleaned-headers specifies the headers to remove.
-See also documentation for `\\[mh-send]' function." t)
-
-(autoload 'mh-extract-rejected-mail "mh-comp"
-  "Extract a letter returned by the mail system and make it resendable.
-Default is the current message.  The variable mh-new-draft-cleaned-headers
-gives the headers to clean out of the original message.
-See also documentation for `\\[mh-send]' function." t)
-
-(autoload 'mh-forward "mh-comp"
-  "Forward a message or message sequence.  Defaults to displayed message.
-If optional prefix argument provided, then prompt for the message sequence.
-See also documentation for `\\[mh-send]' function." t)
-
-(autoload 'mh-redistribute "mh-comp"
-  "Redistribute a letter.
-Depending on how your copy of MH was compiled, you may need to change the
-setting of the variable mh-redist-full-contents.  See its documentation." t)
-
-(autoload 'mh-reply "mh-comp"
-  "Reply to a MESSAGE (default: displayed message).
-If optional prefix argument INCLUDEP provided, then include the message
-in the reply using filter mhl.reply in your MH directory.
-Prompts for type of addresses to reply to:
-   from    sender only,
-   to      sender and primary recipients,
-   cc/all  sender and all recipients.
-If the file named by `mh-repl-formfile' exists, it is used as a skeleton
-for the reply.  See also documentation for `\\[mh-send]' function." t)
-
-(autoload 'mh-send "mh-comp"
-  "Compose and send a letter.
-The file named by `mh-comp-formfile' will be used as the form.
-Do not call this function from outside mh-e; use \\[mh-smail] instead.
-The letter is composed in mh-letter-mode; see its documentation for more
-details.  If `mh-compose-letter-function' is defined, it is called on the
-draft and passed three arguments: to, subject, and cc." t)
-
-(autoload 'mh-send-other-window "mh-comp"
-  "Compose and send a letter in another window.
-Do not call this function from outside mh-e;
-use \\[mh-smail-other-window] instead.
-See also documentation for `\\[mh-send]' function." t)
-
-(autoload 'mh-letter-mode "mh-comp"
-  "Mode for composing letters in mh-e.
-For more details, type \\[describe-mode] while in MH-Letter mode." t)
-
-
-;;; mh-funcs
-
-(autoload 'mh-burst-digest "mh-funcs"
-  "Burst apart the current message, which should be a digest.
-The message is replaced by its table of contents and the messages from the
-digest are inserted into the folder after that message." t)
-
-(autoload 'mh-copy-msg "mh-funcs"
-  "Copy to another FOLDER the specified MESSAGE(s) without deleting them.
-Default is the displayed message.  If optional prefix argument is
-provided, then prompt for the message sequence." t)
-
-(autoload 'mh-kill-folder "mh-funcs"
-  "Remove the current folder." t)
-
-(autoload 'mh-list-folders "mh-funcs"
-  "List mail folders." t)
-
-(autoload 'mh-pack-folder "mh-funcs"
-  "Renumber the messages of a folder to be 1..n.
-First, offer to execute any outstanding commands for the current folder.
-If optional prefix argument provided, prompt for the range of messages
-to display after packing.  Otherwise, show the entire folder." t)
-
-(autoload 'mh-pipe-msg "mh-funcs"
-  "Pipe the current message through the given shell COMMAND.
-If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
-Otherwise just send the message's body without the headers." t)
-
-(autoload 'mh-page-digest "mh-funcs"
-  "Advance displayed message to next digested message." t)
-
-(autoload 'mh-page-digest-backwards "mh-funcs"
-  "Back up displayed message to previous digested message." t)
-
-(autoload 'mh-print-msg "mh-funcs"
-  "Print MESSAGE(s) (default: displayed message) on printer.
-If optional prefix argument provided, then prompt for the message sequence.
-The variable mh-lpr-command-format is used to generate the print command.
-The messages are formatted by mhl.  See the variable mhl-formfile." t)
-
-(autoload 'mh-sort-folder "mh-funcs"
-  "Sort the messages in the current folder by date.
-Calls the MH program sortm to do the work.
-The arguments in the list  mh-sortm-args  are passed to sortm
-if this function is passed an argument." t)
-
-(autoload 'mh-undo-folder "mh-funcs"
-  "Undo all commands in current folder." t)
-
-(autoload 'mh-store-msg "mh-funcs"
-  "Store the file(s) contained in the current message into DIRECTORY.
-The message can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
-mh-store-default-directory  or the current directory." t)
-
-(autoload 'mh-store-buffer "mh-funcs"
-  "Store the file(s) contained in the current buffer into DIRECTORY.
-The buffer can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
-`mh-store-default-directory' or the current directory." t)
-
-
-;;; mh-pick
-
-(autoload 'mh-search-folder "mh-pick"
-  "Search FOLDER for messages matching a pattern.
-Add the messages found to the sequence named `search'." t)
-
-;;; mh-seq
-
-(autoload 'mh-delete-seq "mh-seq"
-  "Delete the SEQUENCE." t)
-(autoload 'mh-list-sequences "mh-seq"
-  "List the sequences defined in FOLDER." t)
-(autoload 'mh-msg-is-in-seq "mh-seq"
-  "Display the sequences that contain MESSAGE (default: displayed message)." t)
-(autoload 'mh-narrow-to-seq "mh-seq"
-  "Restrict display of this folder to just messages in SEQUENCE
-Use \\[mh-widen] to undo this command." t)
-(autoload 'mh-put-msg-in-seq "mh-seq"
-  "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
-If optional prefix argument provided, then prompt for the message sequence." t)
-(autoload 'mh-widen "mh-seq"
-  "Remove restrictions from current folder, thereby showing all messages." t)
-(autoload 'mh-rename-seq "mh-seq"
-  "Rename SEQUENCE to have NEW-NAME." t)
-
-;;; mh-e.el ends here
diff --git a/lisp/mail/mh-funcs.el b/lisp/mail/mh-funcs.el
deleted file mode 100644
index cc1ce6aec1b..00000000000
--- a/lisp/mail/mh-funcs.el
+++ /dev/null
@@ -1,354 +0,0 @@
-;;; mh-funcs --- mh-e functions not everyone will use right away
-;; Time-stamp: <95/08/19 16:44:06 gildea>
-
-;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
-
-;; This file is part of mh-e, 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:
-
-;; Internal support for mh-e package.
-;; Putting these functions in a separate file lets mh-e start up faster,
-;; since less Lisp code needs to be loaded all at once.
-
-;;; Change Log:
-
-;; $Id: mh-funcs.el,v 1.4 1995/11/03 02:29:34 kwzh Exp erik $
-
-;;; Code:
-
-(provide 'mh-funcs)
-(require 'mh-e)
-
-;;; customization
-
-(defvar mh-sortm-args nil
-  "Extra arguments to have \\[mh-sort-folder] pass to the \"sortm\" command.
-The arguments are passed to sortm if \\[mh-sort-folder] is given a
-prefix argument.  Normally default arguments to sortm are specified in the
-MH profile.
-For example, '(\"-nolimit\" \"-textfield\" \"subject\") is a useful setting.")
-
-(defvar mh-note-copied "C"
-  "String whose first character is used to notate copied messages.")
-
-(defvar mh-note-printed "P"
-  "String whose first character is used to notate printed messages.")
-
-;;; functions
-
-(defun mh-burst-digest ()
-  "Burst apart the current message, which should be a digest.
-The message is replaced by its table of contents and the messages from the
-digest are inserted into the folder after that message."
-  (interactive)
-  (let ((digest (mh-get-msg-num t)))
-    (mh-process-or-undo-commands mh-current-folder)
-    (mh-set-folder-modified-p t)		; lock folder while bursting
-    (message "Bursting digest...")
-    (mh-exec-cmd "burst" mh-current-folder digest "-inplace")
-    (with-mh-folder-updating (t)
-      (beginning-of-line)
-      (delete-region (point) (point-max)))
-    (mh-regenerate-headers (format "%d-last" digest) t)
-    (mh-goto-cur-msg)
-    (message "Bursting digest...done")))
-
-
-(defun mh-copy-msg (msg-or-seq folder)
-  "Copy the specified MESSAGE(s) to another FOLDER without deleting them.
-Default is the displayed message.  If optional prefix argument is
-provided, then prompt for the message sequence."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-seq-default "Copy" t)
-			 (mh-get-msg-num t))
-		     (mh-prompt-for-folder "Copy to" "" t)))
-  (mh-exec-cmd "refile" msg-or-seq "-link" "-src" mh-current-folder folder)
-  (if (numberp msg-or-seq)
-      (mh-notate msg-or-seq mh-note-copied mh-cmd-note)
-      (mh-notate-seq msg-or-seq mh-note-copied mh-cmd-note)))
-
-(defun mh-kill-folder ()
-  "Remove the current folder."
-  (interactive)
-  (if (or mh-do-not-confirm
-	  (yes-or-no-p (format "Remove folder %s? " mh-current-folder)))
-      (let ((folder mh-current-folder))
-	(if (null mh-folder-list)
-	    (mh-set-folder-list))
-	(mh-set-folder-modified-p t)	; lock folder to kill it
-	(mh-exec-cmd-daemon "rmf" folder)
-	(setq mh-folder-list
-	      (delq (assoc folder mh-folder-list) mh-folder-list))
-	(run-hooks 'mh-folder-list-change-hook)
-	(message "Folder %s removed" folder)
-	(mh-set-folder-modified-p nil)	; so kill-buffer doesn't complain
-	(if (get-buffer mh-show-buffer)
-	    (kill-buffer mh-show-buffer))
-	(kill-buffer folder))
-      (message "Folder not removed")))
-
-
-(defun mh-list-folders ()
-  "List mail folders."
-  (interactive)
-  (with-output-to-temp-buffer mh-temp-buffer
-    (save-excursion
-      (switch-to-buffer mh-temp-buffer)
-      (erase-buffer)
-      (message "Listing folders...")
-      (mh-exec-cmd-output "folders" t (if mh-recursive-folders
-					  "-recurse"
-					  "-norecurse"))
-      (goto-char (point-min))
-      (message "Listing folders...done"))))
-
-
-(defun mh-pack-folder (range)
-  "Renumber the messages of a folder to be 1..n.
-First, offer to execute any outstanding commands for the current folder.
-If optional prefix argument provided, prompt for the RANGE of messages
-to display after packing.  Otherwise, show the entire folder."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-msg-range
-			  "Range to scan after packing [all]? ")
-		       "all")))
-  (mh-pack-folder-1 range)
-  (mh-goto-cur-msg)
-  (message "Packing folder...done"))
-
-
-(defun mh-pack-folder-1 (range)
-  ;; Close and pack the current folder.
-  (mh-process-or-undo-commands mh-current-folder)
-  (message "Packing folder...")
-  (mh-set-folder-modified-p t)		; lock folder while packing
-  (save-excursion
-    (mh-exec-cmd-quiet t "folder" mh-current-folder "-pack"
-		       "-norecurse" "-fast"))
-  (mh-regenerate-headers range))
-
-
-(defun mh-pipe-msg (command include-headers)
-  "Pipe the current message through the given shell COMMAND.
-If INCLUDE-HEADERS (prefix argument) is provided, send the entire message.
-Otherwise just send the message's body without the headers."
-  (interactive
-   (list (read-string "Shell command on message: ") current-prefix-arg))
-  (let ((msg-file-to-pipe (mh-msg-filename (mh-get-msg-num t)))
-	(message-directory default-directory))
-    (save-excursion
-      (set-buffer (get-buffer-create mh-temp-buffer))
-      (erase-buffer)
-      (insert-file-contents msg-file-to-pipe)
-      (goto-char (point-min))
-      (if (not include-headers) (search-forward "\n\n"))
-      (let ((default-directory message-directory))
-	(shell-command-on-region (point) (point-max) command nil)))))
-
-
-(defun mh-page-digest ()
-  "Advance displayed message to next digested message."
-  (interactive)
-  (mh-in-show-buffer (mh-show-buffer)
-    ;; Go to top of screen (in case user moved point).
-    (move-to-window-line 0)
-    (let ((case-fold-search nil))
-      ;; Search for blank line and then for From:
-      (or (and (search-forward "\n\n" nil t)
-	       (re-search-forward "^From:" nil t))
-	  (error "No more messages in digest")))
-    ;; Go back to previous blank line, then forward to the first non-blank.
-    (search-backward "\n\n" nil t)
-    (forward-line 2)
-    (mh-recenter 0)))
-
-
-(defun mh-page-digest-backwards ()
-  "Back up displayed message to previous digested message."
-  (interactive)
-  (mh-in-show-buffer (mh-show-buffer)
-    ;; Go to top of screen (in case user moved point).
-    (move-to-window-line 0)
-    (let ((case-fold-search nil))
-      (beginning-of-line)
-      (or (and (search-backward "\n\n" nil t)
-	       (re-search-backward "^From:" nil t))
-	  (error "No previous message in digest")))
-    ;; Go back to previous blank line, then forward to the first non-blank.
-    (if (search-backward "\n\n" nil t)
-	(forward-line 2))
-    (mh-recenter 0)))
-
-
-(defun mh-print-msg (msg-or-seq)
-  "Print MESSAGE(s) (default: displayed message) on printer.
-If optional prefix argument provided, then prompt for the message sequence.
-The variable mh-lpr-command-format is used to generate the print command.
-The messages are formatted by mhl.  See the variable mhl-formfile."
-  (interactive (list (if current-prefix-arg
-			 (reverse (mh-seq-to-msgs
-				   (mh-read-seq-default "Print" t)))
-		       (mh-get-msg-num t))))
-  (if (numberp msg-or-seq)
-      (message "Printing message...")
-      (message "Printing sequence..."))
-  (let ((print-command
-	 (if (numberp msg-or-seq)
-	     (format "%s -nobell -clear %s %s | %s"
-		     (expand-file-name "mhl" mh-lib)
-		     (mh-msg-filename msg-or-seq)
-		     (if (stringp mhl-formfile)
-			 (format "-form %s" mhl-formfile)
-		       "")
-		     (format mh-lpr-command-format
-			     (if (numberp msg-or-seq)
-				 (format "%s/%d" mh-current-folder
-				       msg-or-seq)
-			         (format "Sequence from %s" mh-current-folder))))
-	     (format "(scan -clear %s ; %s -nobell -clear %s %s) | %s"
-		     (mapconcat (function (lambda (msg) msg)) msg-or-seq " ")
-		     (expand-file-name "mhl" mh-lib)
-		     (if (stringp mhl-formfile)
-			 (format "-form %s" mhl-formfile)
-		       "")
-		     (mh-msg-filenames msg-or-seq)
-		     (format mh-lpr-command-format
-			     (if (numberp msg-or-seq)
-				 (format "%s/%d" mh-current-folder
-				       msg-or-seq)
-			         (format "Sequence from %s"
-					 mh-current-folder)))))))
-    (if mh-print-background
-	(mh-exec-cmd-daemon shell-file-name "-c" print-command)
-      (call-process shell-file-name nil nil nil "-c" print-command))
-    (if (numberp msg-or-seq)
-	(mh-notate msg-or-seq mh-note-printed mh-cmd-note)
-        (mh-notate-seq msg-or-seq mh-note-printed mh-cmd-note))
-    (mh-add-msgs-to-seq msg-or-seq 'printed t)
-    (if (numberp msg-or-seq)
-	(message "Printing message...done")
-        (message "Printing sequence...done"))))
-
-
-(defun mh-msg-filenames (msgs &optional folder)
-  ;; Return a list of file names for MSGS in FOLDER (default current folder).
-  (mapconcat (function (lambda (msg) (mh-msg-filename msg folder))) msgs " "))
-
-
-(defun mh-sort-folder (&optional extra-args)
-  "Sort the messages in the current folder by date.
-Calls the MH program sortm to do the work.
-The arguments in the list  mh-sortm-args  are passed to sortm
-if this function is passed an argument."
-  (interactive "P")
-  (mh-process-or-undo-commands mh-current-folder)
-  (setq mh-next-direction 'forward)
-  (mh-set-folder-modified-p t)		; lock folder while sorting
-  (message "Sorting folder...")
-  (mh-exec-cmd "sortm" mh-current-folder (if extra-args mh-sortm-args))
-  (message "Sorting folder...done")
-  (mh-scan-folder mh-current-folder "all"))
-
-
-(defun mh-undo-folder (&rest ignore)
-  "Undo all pending deletes and refiles in current folder."
-  (interactive)
-  (cond ((or mh-do-not-confirm
-	     (yes-or-no-p "Undo all commands in folder? "))
-	 (setq mh-delete-list nil
-	       mh-refile-list nil
-	       mh-seq-list nil
-	       mh-next-direction 'forward)
-	 (with-mh-folder-updating (nil)
-	   (mh-unmark-all-headers t)))
-	(t
-	 (message "Commands not undone.")
-	 (sit-for 2))))
-
-
-(defun mh-store-msg (directory)
-  "Store the file(s) contained in the current message into DIRECTORY.
-The message can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
-mh-store-default-directory  or the current directory."
-  (interactive (list (let ((udir (or mh-store-default-directory default-directory)))
-				 (read-file-name "Store message in directory: "
-						 udir udir nil))))
-  (let ((msg-file-to-store (mh-msg-filename (mh-get-msg-num t))))
-    (save-excursion
-      (set-buffer (get-buffer-create mh-temp-buffer))
-      (erase-buffer)
-      (insert-file-contents msg-file-to-store)
-      (mh-store-buffer directory))))
-
-(defun mh-store-buffer (directory)
-  "Store the file(s) contained in the current buffer into DIRECTORY.
-The buffer can contain a shar file or uuencoded file.
-Default directory is the last directory used, or initially the value of
-`mh-store-default-directory' or the current directory."
-  (interactive (list (let ((udir (or mh-store-default-directory default-directory)))
-		       (read-file-name "Store buffer in directory: "
-				       udir udir nil))))
-  (let ((store-directory (expand-file-name directory))
-	(sh-start (save-excursion
-		    (goto-char (point-min))
-		    (if (re-search-forward
-			 "^#![ \t]*/bin/sh\\|^#\\|^: " nil t)
-			(progn
-			  ;; The "cut here" pattern was removed from above
-			  ;; because it seemed to hurt more than help.
-			  ;; But keep this to make it easier to put it back.
-			  (if (looking-at "^[^a-z0-9\"]*cut here\\b")
-			      (forward-line 1))
-			  (beginning-of-line)
-			  (if (looking-at "^[#:]....+\n\\( ?\n\\)?end$")
-			      nil	;most likely end of a uuencode
-			    (point))))))
-	(log-buffer (get-buffer-create "*Store Output*"))
-	(command "sh")
-	(uudecode-filename "(unknown filename)"))
-    (if (not sh-start)
-	(save-excursion
-	  (goto-char (point-min))
-	  (if (re-search-forward "^begin [0-7]+ " nil t)
-	      (setq uudecode-filename
-		    (buffer-substring (point)
-				      (progn (end-of-line) (point)))))))
-    (save-excursion
-      (set-buffer log-buffer)
-      (erase-buffer)
-      (if (not (file-directory-p store-directory))
-	  (progn
-	    (insert "mkdir " directory "\n")
-	    (call-process "mkdir" nil log-buffer t store-directory)))
-      (insert "cd " directory "\n")
-      (setq mh-store-default-directory directory)
-      (if (not sh-start)
-	  (progn
-	    (setq command "uudecode")
-	    (insert uudecode-filename " being uudecoded...\n"))))
-    (set-window-start (display-buffer log-buffer) 0) ;watch progress
-    (let (value)
-      (let ((default-directory (file-name-as-directory store-directory)))
-	(setq value (call-process-region sh-start (point-max) command
-					 nil log-buffer t)))
-      (set-buffer log-buffer)
-      (mh-handle-process-error command value))
-    (insert "\n(mh-store finished)\n")))
-	
diff --git a/lisp/mail/mh-mime.el b/lisp/mail/mh-mime.el
deleted file mode 100644
index dcb12b5588b..00000000000
--- a/lisp/mail/mh-mime.el
+++ /dev/null
@@ -1,236 +0,0 @@
-;;; mh-mime --- mh-e support for composing MIME messages
-;; Time-stamp: <95/08/19 16:45:17 gildea>
-
-;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
-
-;; This file is part of mh-e, 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:
-
-;; Internal support for mh-e package.
-;; Support for generating an mhn composition file.
-;; MIME is supported only by MH 6.8 or later.
-
-;;; Change Log:
-
-;; $Id: mh-mime.el,v 1.5 1995/11/03 02:29:49 kwzh Exp erik $
-
-;;; Code:
-
-(provide 'mh-mime)
-(require 'mh-comp)
-
-
-;; To do:
-;; paragraph code should not fill # lines if MIME enabled.
-;; implement mh-auto-edit-mhn (if non-nil, \\[mh-send-letter]
-;;	invokes mh-edit-mhn automatically before sending.)
-;;      actually, instead of mh-auto-edit-mhn,
-;;      should read automhnproc from profile
-;; MIME option to mh-forward
-;; command to move to content-description insertion point
-
-(defvar mh-mhn-args nil
-  "Extra arguments to have \\[mh-edit-mhn] pass to the \"mhn\" command.
-The arguments are passed to mhn if \\[mh-edit-mhn] is given a
-prefix argument.  Normally default arguments to mhn are specified in the
-MH profile.")
-
-(defvar mh-edit-mhn-hook nil
-  "Invoked on the formatted letter by \\<mh-letter-mode-map>\\[mh-edit-mhn].")
-
-;;;###autoload
-(defvar mh-mime-content-types
-  '(("text/plain") ("text/richtext")
-    ("multipart/mixed") ("multipart/alternative") ("multipart/digest")
-    ("multipart/parallel")
-    ("message/rfc822") ("message/partial") ("message/external-body")
-    ("application/octet-stream") ("application/postscript")
-    ("image/jpeg") ("image/gif")
-    ("audio/basic")
-    ("video/mpeg"))
-  "Legal MIME content types.  See documentation for \\[mh-edit-mhn].")
-
-(defun mh-mhn-compose-insertion (pathname type description)
-  "Add a directive to insert a MIME message part from a file.
-This is the typical way to insert non-text parts in a message.
-Arguments are PATHNAME, which tells where to find the file, TYPE, the
-MIME content type, and DESCRIPTION, a line of text for the
-Content-description header.  See also \\[mh-edit-mhn]."
-  (interactive (list
-		(read-file-name "Insert contents of: ")
-		(completing-read "Content-type: "
-				 mh-mime-content-types nil nil nil)
-		(read-string "Content-description: ")))
-  (mh-mhn-compose-type pathname type description))
-
-(defun mh-mhn-compose-type (pathname type
-			    &optional description attributes comment)
-  (beginning-of-line)
-  (insert "#" type)
-  (and attributes
-       (insert "; " attributes))
-  (and comment
-       (insert " (" comment ")"))
-  (insert " [")
-  (and description
-       (insert description))
-  (insert "] " (expand-file-name pathname))
-  (insert "\n"))
-
-
-(defun mh-mhn-compose-anon-ftp (host pathname type description)
-  "Add a directive for a MIME anonymous ftp external body part.
-This directive tells MH to include a reference to a
-message/external-body part retrievable by anonymous FTP.  Arguments
-are HOST and PATHNAME, which tell where to find the file, TYPE, the
-MIME content type, and DESCRIPTION, a line of text for the
-Content-description header.  See also \\[mh-edit-mhn]."
-  (interactive (list
-		(read-string "Remote host: ")
-		(read-string "Remote pathname: ")
-		(completing-read "External Content-type: "
-				 mh-mime-content-types nil nil nil)
-		(read-string "External Content-description: ")))
-  (mh-mhn-compose-external-type "anon-ftp" host pathname
-				type description))
-
-(defun mh-mhn-compose-external-compressed-tar (host pathname description)
-  "Add a directive to include a MIME reference to a compressed tar file.
-The file should be available via anonymous ftp.  This directive
-tells MH to include a reference to a message/external-body part.
-Arguments are HOST and PATHNAME, which tell where to find the file, and
-DESCRIPTION, a line of text for the Content-description header.
-See also \\[mh-edit-mhn]."
-  (interactive (list
-		(read-string "Remote host: ")
-		(read-string "Remote pathname: ")
-		(read-string "Tar file Content-description: ")))
-  (mh-mhn-compose-external-type "anon-ftp" host pathname
-				"application/octet-stream"
-				description
-				"type=tar; conversions=x-compress"
-				"mode=image"))
-
-
-(defun mh-mhn-compose-external-type (access-type host pathname type
-				     &optional description
-				     attributes extra-params comment)
-  (beginning-of-line)
-  (insert "#@" type)
-  (and attributes
-       (insert "; " attributes))
-  (and comment
-       (insert " (" comment ") "))
-  (insert " [")
-  (and description
-       (insert description))
-  (insert "] ")
-  (insert "access-type=" access-type "; ")
-  (insert "site=" host)
-  (insert "; name=" (file-name-nondirectory pathname))
-  (insert "; directory=\"" (file-name-directory pathname) "\"")
-  (and extra-params
-       (insert "; " extra-params))
-  (insert "\n"))
-
-(defun mh-mhn-compose-forw (&optional description folder messages)
-  "Add a forw directive to this message, to forward a message with MIME.
-This directive tells MH to include the named messages in this one.
-Arguments are DESCRIPTION, a line of text for the Content-description header,
-and FOLDER and MESSAGES, which name the message(s) to be forwarded.
-See also \\[mh-edit-mhn]."
-  (interactive (list
-		(read-string "Forw Content-description: ")
-		(mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
-		(read-string (format "Messages%s: "
-				     (if mh-sent-from-msg
-					 (format " [%d]" mh-sent-from-msg)
-				       "")))))
-  (beginning-of-line)
-  (insert "#forw [")
-  (and description
-       (not (string= description ""))
-       (insert description))
-  (insert "]")
-  (and folder
-       (not (string= folder ""))
-       (insert " " folder))
-  (if (and messages
-	   (not (string= messages "")))
-      (let ((start (point)))
-	(insert " " messages)
-	(subst-char-in-region start (point) ?, ? ))
-    (if mh-sent-from-msg
-	(insert " " (int-to-string mh-sent-from-msg))))
-  (insert "\n"))
-
-(defun mh-edit-mhn (&optional extra-args)
-  "Format the current draft for MIME, expanding any mhn directives.
-Process the current draft with the mhn program, which,
-using directives already inserted in the draft, fills in
-all the MIME components and header fields.
-This step should be done last just before sending the message.
-The mhn program is part of MH version 6.8 or later.
-The `\\[mh-revert-mhn-edit]' command undoes this command.
-The arguments in the list `mh-mhn-args' are passed to mhn
-if this function is passed an argument.
-
-For assistance with creating mhn directives to insert
-various types of components in a message, see
-\\[mh-mhn-compose-insertion] (generic insertion from a file),
-\\[mh-mhn-compose-anon-ftp] (external reference to file via anonymous ftp),
-\\[mh-mhn-compose-external-compressed-tar] \
-\(reference to compressed tar file via anonymous ftp), and
-\\[mh-mhn-compose-forw] (forward message)."
-  (interactive "*P")
-  (save-buffer)
-  (message "mhn editing...")
-  (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
-		     "mhn" (if extra-args mh-mhn-args) buffer-file-name)
-  (revert-buffer t t)
-  (message "mhn editing...done")
-  (run-hooks 'mh-edit-mhn-hook))
-
-
-(defun mh-revert-mhn-edit (noconfirm)
-  "Undoes the effect of \\[mh-edit-mhn] by reverting to the backup file.
-Optional non-nil argument means don't ask for confirmation."
-  (interactive "*P")
-  (if (null buffer-file-name)
-      (error "Buffer does not seem to be associated with any file"))
-  (let ((backup-strings '("," "#"))
-	backup-file)
-    (while (and backup-strings
-		(not (file-exists-p
-		      (setq backup-file
-			    (concat (file-name-directory buffer-file-name)
-				    (car backup-strings)
-				    (file-name-nondirectory buffer-file-name)
-				    ".orig")))))
-      (setq backup-strings (cdr backup-strings)))
-    (or backup-strings
-	(error "mhn backup file for %s no longer exists!" buffer-file-name))
-    (or noconfirm
-	(yes-or-no-p (format "Revert buffer from file %s? "
-			     backup-file))
-	(error "mhn edit revert not confirmed."))
-    (let ((buffer-read-only nil))
-      (erase-buffer)
-      (insert-file-contents backup-file))
-    (after-find-file nil)))
diff --git a/lisp/mail/mh-pick.el b/lisp/mail/mh-pick.el
deleted file mode 100644
index a297d5e6f5c..00000000000
--- a/lisp/mail/mh-pick.el
+++ /dev/null
@@ -1,195 +0,0 @@
-;;; mh-pick --- make a search pattern and search for a message in mh-e
-;; Time-stamp: <95/08/19 16:45:16 gildea>
-
-;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
-
-;; This file is part of mh-e, 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:
-
-;; Internal support for mh-e package.
-
-;;; Change Log:
-
-;; $Id: mh-pick.el,v 1.4 1995/11/03 02:30:09 kwzh Exp erik $
-
-;;; Code:
-
-(provide 'mh-pick)
-(require 'mh-e)
-
-(defvar mh-pick-mode-hook nil
-  "Invoked in `mh-pick-mode' on a new pattern.")
-
-;;; Internal variables:
-
-(defvar mh-pick-mode-map (make-sparse-keymap)
-  "Keymap for searching folder.")
-
-(defvar mh-searching-folder nil)	;Folder this pick is searching.
-
-(defun mh-search-folder (folder)
-  "Search FOLDER for messages matching a pattern.
-Add the messages found to the sequence named `search'."
-  (interactive (list (mh-prompt-for-folder "Search"
-					   mh-current-folder
-					   t)))
-  (switch-to-buffer-other-window "pick-pattern")
-  (if (or (zerop (buffer-size))
-	  (not (y-or-n-p "Reuse pattern? ")))
-      (mh-make-pick-template)
-    (message ""))
-  (setq mh-searching-folder folder))
-
-(defun mh-make-pick-template ()
-  ;; Initialize the current buffer with a template for a pick pattern.
-  (erase-buffer)
-  (insert "From: \n"
-	  "To: \n"
-	  "Cc: \n"
-	  "Date: \n"
-	  "Subject: \n"
-	  "---------\n")
-  (mh-pick-mode)
-  (goto-char (point-min))
-  (end-of-line))
-
-(put 'mh-pick-mode 'mode-class 'special)
-
-(defun mh-pick-mode ()
-  "Mode for creating search templates in mh-e.\\<mh-pick-mode-map>
-After each field name, enter the pattern to search for.  If a field's
-value does not matter for the search, leave it empty.  To search the
-entire message, supply the pattern in the \"body\" of the template.
-Each non-empty field must be matched for a message to be selected.
-To effect a logical \"or\", use \\[mh-search-folder] multiple times.
-When you have finished, type  \\[mh-do-pick-search]  to do the search.
-\\{mh-pick-mode-map}
-Turning on mh-pick-mode calls the value of the variable mh-pick-mode-hook
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (make-local-variable 'mh-searching-folder)
-  (use-local-map mh-pick-mode-map)
-  (setq major-mode 'mh-pick-mode)
-  (mh-set-mode-name "MH-Pick")
-  (run-hooks 'mh-pick-mode-hook))
-
-
-(defun mh-do-pick-search ()
-  "Find messages that match the qualifications in the current pattern buffer.
-Messages are searched for in the folder named in mh-searching-folder.
-Add the messages found to the sequence named `search'."
-  (interactive)
-  (let ((pattern-buffer (buffer-name))
-	(searching-buffer mh-searching-folder)
-	range
-	msgs
-	(finding-messages t)
-	(pattern nil)
-	(new-buffer nil))
-    (save-excursion
-      (cond ((get-buffer searching-buffer)
-	     (set-buffer searching-buffer)
-	     (setq range (list (format "%d-%d"
-				       mh-first-msg-num mh-last-msg-num))))
-	    (t
-	     (mh-make-folder searching-buffer)
-	     (setq range '("all"))
-	     (setq new-buffer t))))
-    (message "Searching...")
-    (goto-char (point-min))
-    (while (and range
-		(setq pattern (mh-next-pick-field pattern-buffer)))
-      (setq msgs (mh-seq-from-command searching-buffer
-				      'search
-				      (mh-list-to-string
-				       (list "pick" pattern searching-buffer
-					     "-list"
-					     (mh-coalesce-msg-list range)))))
-      (setq range msgs))		;restrict the pick range for next pass
-    (message "Searching...done")
-    (if new-buffer
-	(mh-scan-folder searching-buffer msgs)
-	(switch-to-buffer searching-buffer))
-    (mh-add-msgs-to-seq msgs 'search)
-    (delete-other-windows)))
-
-
-(defun mh-seq-from-command (folder seq seq-command)
-  ;; In FOLDER, make a sequence named SEQ by executing COMMAND.
-  ;; COMMAND is a list.  The first element is a program name
-  ;; and the subsequent elements are its arguments, all strings.
-  (let ((msg)
-	(msgs ())
-	(case-fold-search t))
-    (save-excursion
-      (save-window-excursion
-	(if (eq 0 (apply 'mh-exec-cmd-quiet nil seq-command))
-	    ;; "pick" outputs one number per line
-	    (while (setq msg (car (mh-read-msg-list)))
-	      (setq msgs (cons msg msgs))
-	      (forward-line 1))))
-      (set-buffer folder)
-      (setq msgs (nreverse msgs))	;put in ascending order
-      msgs)))
-
-
-(defun mh-next-pick-field (buffer)
-  ;; Return the next piece of a pick argument that can be extracted from the
-  ;; BUFFER.
-  ;; Return a list like ("--fieldname" "pattern") or ("-search" "bodypat")
-  ;; or NIL if no pieces remain.
-  (set-buffer buffer)
-  (let ((case-fold-search t))
-    (cond ((eobp)
-	   nil)
-	  ((re-search-forward "^\\([a-z][^: \t\n]*\\):[ \t]*\\([a-z0-9].*\\)$" nil t)
-	   (let* ((component
-		   (format "--%s"
-			   (downcase (buffer-substring (match-beginning 1)
-						       (match-end 1)))))
-		  (pat (buffer-substring (match-beginning 2) (match-end 2))))
-	       (forward-line 1)
-	       (list component pat)))
-	  ((re-search-forward "^-*$" nil t)
-	   (forward-char 1)
-	   (let ((body (buffer-substring (point) (point-max))))
-	     (if (and (> (length body) 0) (not (equal body "\n")))
-		 (list "-search" body)
-		 nil)))
-	  (t
-	   nil))))
-
-;;; Build the pick-mode keymap:
-
-(define-key mh-pick-mode-map "\C-c\C-c" 'mh-do-pick-search)
-(define-key mh-pick-mode-map "\C-c\C-f\C-b" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-f\C-c" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-f\C-d" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-f\C-f" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-f\C-r" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-f\C-s" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-f\C-t" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-fb" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-fc" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-fd" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-ff" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-fr" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-fs" 'mh-to-field)
-(define-key mh-pick-mode-map "\C-c\C-ft" 'mh-to-field)
diff --git a/lisp/mail/mh-seq.el b/lisp/mail/mh-seq.el
deleted file mode 100644
index 59db6ee8f19..00000000000
--- a/lisp/mail/mh-seq.el
+++ /dev/null
@@ -1,237 +0,0 @@
-;;; mh-seq --- mh-e sequences support
-;; Time-stamp: <95/08/19 16:45:15 gildea>
-
-;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
-
-;; This file is part of mh-e, 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:
-
-;; Internal support for mh-e package.
-
-;;; Change Log:
-
-;; $Id: mh-seq.el,v 1.5 1996/01/14 07:34:30 erik Exp kwzh $
-
-;;; Code:
-
-(provide 'mh-seq)
-(require 'mh-e)
-
-;;; Internal variables:
-
-(defvar mh-last-seq-used nil)		;Name of seq to which a msg was last added.
-
-(defvar mh-non-seq-mode-line-annotation nil) ;Saved value of mh-mode-line-annotation when narrowed to a seq.
-
-
-(defun mh-delete-seq (sequence)
-  "Delete the SEQUENCE."
-  (interactive (list (mh-read-seq-default "Delete" t)))
-  (mh-map-to-seq-msgs 'mh-notate-if-in-one-seq sequence ?  (1+ mh-cmd-note)
-		      sequence)
-  (mh-undefine-sequence sequence '("all"))
-  (mh-delete-seq-locally sequence))
-
-
-(defun mh-list-sequences (folder)
-  "List the sequences defined in FOLDER."
-  (interactive (list (mh-prompt-for-folder "List sequences in"
-					   mh-current-folder t)))
-  (let ((temp-buffer mh-temp-buffer)
-	(seq-list mh-seq-list))
-    (with-output-to-temp-buffer temp-buffer
-      (save-excursion
-	(set-buffer temp-buffer)
-	(erase-buffer)
-	(message "Listing sequences ...")
-	(insert "Sequences in folder " folder ":\n")
-	(while seq-list
-	  (let ((name (mh-seq-name (car seq-list)))
-		(sorted-seq-msgs
-		 (sort (copy-sequence (mh-seq-msgs (car seq-list))) '<))
-		(last-col (- (window-width) 4))
-		name-spec)
-	    (insert (setq name-spec (format "%20s:" name)))
-	    (while sorted-seq-msgs
-	      (if (> (current-column) last-col)
-		  (progn
-		    (insert "\n")
-		    (move-to-column (length name-spec))))
-	      (insert (format " %s" (car sorted-seq-msgs)))
-	      (setq sorted-seq-msgs (cdr sorted-seq-msgs)))
-	    (insert "\n"))
-	  (setq seq-list (cdr seq-list)))
-	(goto-char (point-min))
-	(message "Listing sequences...done")))))
-
-
-(defun mh-msg-is-in-seq (message)
-  "Display the sequences that contain MESSAGE (default: current message)."
-  (interactive (list (mh-get-msg-num t)))
-  (message "Message %d is in sequences: %s"
-	   message
-	   (mapconcat 'concat
-		      (mh-list-to-string (mh-seq-containing-msg message t))
-		      " ")))
-
-
-(defun mh-narrow-to-seq (sequence)
-  "Restrict display of this folder to just messages in SEQUENCE.
-Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command."
-  (interactive (list (mh-read-seq "Narrow to" t)))
-  (with-mh-folder-updating (t)
-    (cond ((mh-seq-to-msgs sequence)
-	   (mh-widen)
-	   (let ((eob (point-max)))
-	     (mh-copy-seq-to-point sequence eob)
-	     (narrow-to-region eob (point-max))
-	     (make-variable-buffer-local 'mh-non-seq-mode-line-annotation)
-	     (setq mh-non-seq-mode-line-annotation mh-mode-line-annotation)
-	     (setq mh-mode-line-annotation (symbol-name sequence))
-	     (mh-make-folder-mode-line)
-	     (mh-recenter nil)
-	     (setq mh-narrowed-to-seq sequence)))
-	  (t
-	   (error "No messages in sequence `%s'" (symbol-name sequence))))))
-
-
-(defun mh-put-msg-in-seq (msg-or-seq sequence)
-  "Add MESSAGE(s) (default: displayed message) to SEQUENCE.
-If optional prefix argument provided, then prompt for the message sequence."
-  (interactive (list (if current-prefix-arg
-			 (mh-read-seq-default "Add messages from" t)
-		         (mh-get-msg-num t))
-		     (mh-read-seq-default "Add to" nil)))
-  (if (not (mh-internal-seq sequence))
-      (setq mh-last-seq-used sequence))
-  (mh-add-msgs-to-seq (if (numberp msg-or-seq)
-			  msg-or-seq
-			  (mh-seq-to-msgs msg-or-seq))
-		      sequence))
-
-
-(defun mh-widen ()
-  "Remove restrictions from current folder, thereby showing all messages."
-  (interactive)
-  (if mh-narrowed-to-seq
-      (with-mh-folder-updating (t)
-	(delete-region (point-min) (point-max))
-	(widen)
-	(setq mh-mode-line-annotation mh-non-seq-mode-line-annotation)
-	(mh-make-folder-mode-line)))
-  (setq mh-narrowed-to-seq nil))
-
-
-
-;;; Commands to manipulate sequences.  Sequences are stored in an alist
-;;; of the form:
-;;;	((seq-name msgs ...) (seq-name msgs ...) ...)
-
-
-(defun mh-read-seq-default (prompt not-empty)
-  ;; Read and return sequence name with default narrowed or previous sequence.
-  (mh-read-seq prompt not-empty
-	       (or mh-narrowed-to-seq
-		   mh-last-seq-used
-		   (car (mh-seq-containing-msg (mh-get-msg-num nil) nil)))))
-
-
-(defun mh-read-seq (prompt not-empty &optional default)
-  ;; Read and return a sequence name.  Prompt with PROMPT, raise an error
-  ;; if the sequence is empty and the NOT-EMPTY flag is non-nil, and supply
-  ;; an optional DEFAULT sequence.
-  ;; A reply of '%' defaults to the first sequence containing the current
-  ;; message.
-  (let* ((input (completing-read (format "%s %s %s" prompt "sequence:"
-					 (if default
-					     (format "[%s] " default)
-					     ""))
-				 (mh-seq-names mh-seq-list)))
-	 (seq (cond ((equal input "%")
-		     (car (mh-seq-containing-msg (mh-get-msg-num t) nil)))
-		    ((equal input "") default)
-		    (t (intern input))))
-	 (msgs (mh-seq-to-msgs seq)))
-    (if (and (null msgs) not-empty)
-	(error "No messages in sequence `%s'" seq))
-    seq))
-
-
-(defun mh-seq-names (seq-list)
-  ;; Return an alist containing the names of the SEQUENCES.
-  (mapcar (function (lambda (entry) (list (symbol-name (mh-seq-name entry)))))
-	  seq-list))
-
-
-(defun mh-rename-seq (sequence new-name)
-  "Rename SEQUENCE to have NEW-NAME."
-  (interactive (list (mh-read-seq "Old" t)
-		     (intern (read-string "New sequence name: "))))
-  (let ((old-seq (mh-find-seq sequence)))
-    (or old-seq
-	(error "Sequence %s does not exist" sequence))
-    ;; create new sequence first, since it might raise an error.
-    (mh-define-sequence new-name (mh-seq-msgs old-seq))
-    (mh-undefine-sequence sequence (mh-seq-msgs old-seq))
-    (rplaca old-seq new-name)))
-
-
-(defun mh-map-to-seq-msgs (func seq &rest args)
-  ;; Invoke the FUNCTION at each message in the SEQUENCE, passing the
-  ;; remaining ARGS as arguments.
-  (save-excursion
-    (let ((msgs (mh-seq-to-msgs seq)))
-      (while msgs
-	(if (mh-goto-msg (car msgs) t t)
-	    (apply func (car msgs) args))
-	(setq msgs (cdr msgs))))))
-
-
-(defun mh-notate-seq (seq notation offset)
-  ;; Mark the scan listing of all messages in the SEQUENCE with the CHARACTER
-  ;; at the given OFFSET from the beginning of the listing line.
-  (mh-map-to-seq-msgs 'mh-notate seq notation offset))
-
-
-(defun mh-add-to-sequence (seq msgs)
-  ;; Add to a SEQUENCE each message the list of MSGS.
-  (if (not (mh-folder-name-p seq))
-      (if msgs
-	  (apply 'mh-exec-cmd "mark" mh-current-folder "-add"
-		 "-sequence" (symbol-name seq)
-		 (mh-coalesce-msg-list msgs)))))
-
-
-(defun mh-copy-seq-to-point (seq location)
-  ;; Copy the scan listing of the messages in SEQUENCE to after the point
-  ;; LOCATION in the current buffer.
-  (mh-map-to-seq-msgs 'mh-copy-line-to-point seq location))
-
-
-(defun mh-copy-line-to-point (msg location)
-  ;; Copy the current line to the LOCATION in the current buffer.
-  (beginning-of-line)
-  (save-excursion
-    (let ((beginning-of-line (point))
-	  end)
-      (forward-line 1)
-      (setq end (point))
-      (goto-char location)
-      (insert-buffer-substring (current-buffer) beginning-of-line end))))
-
diff --git a/lisp/mail/mh-utils.el b/lisp/mail/mh-utils.el
deleted file mode 100644
index d2505918c86..00000000000
--- a/lisp/mail/mh-utils.el
+++ /dev/null
@@ -1,953 +0,0 @@
-;;; mh-utils.el --- mh-e code needed for both sending and reading
-;; Time-stamp: <95/10/22 17:58:16 gildea>
-
-;; Copyright (C) 1993, 1995 Free Software Foundation, Inc.
-
-;; This file is part of mh-e, 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:
-
-;; Internal support for mh-e package.
-
-;;; Change Log:
-
-;; $Id: mh-utils.el,v 1.9 1996/01/29 23:17:16 kwzh Exp rms $
-
-;;; Code:
-
-;;; Set for local environment:
-;;; mh-progs and mh-lib used to be set in paths.el, which tried to
-;;; figure out at build time which of several possible directories MH
-;;; was installed into.  But if you installed MH after building Emacs,
-;;; this would almost certainly be wrong, so now we do it at run time.
-
-(defvar mh-progs nil
-  "Directory containing MH commands, such as inc, repl, and rmm.")
-
-(defvar mh-lib nil
-  "Directory containing the MH library.
-This directory contains, among other things,
-the mhl program and the components file.")
-
-;;;###autoload
-(put 'mh-progs 'risky-local-variable t)
-;;;###autoload
-(put 'mh-lib 'risky-local-variable t)
-
-;;; User preferences:
-
-(defvar mh-auto-folder-collect t
-  "*Whether to start collecting MH folder names immediately in the background.
-Non-nil means start a background process collecting the names of all
-folders as soon as mh-e is loaded.")
-
-(defvar mh-recursive-folders nil
-  "*If non-nil, then commands which operate on folders do so recursively.")
-
-(defvar mh-clean-message-header nil
-  "*Non-nil means clean headers of messages that are displayed or inserted.
-The variables `mh-visible-headers' and `mh-invisible-headers' control what
-is removed.")
-
-(defvar mh-visible-headers nil
-  "*If non-nil, contains a regexp specifying the headers to keep when cleaning.
-Only used if `mh-clean-message-header' is non-nil.  Setting this variable
-overrides `mh-invisible-headers'.")
-
-(defvar mh-invisible-headers
-  "^Received: \\|^Message-Id: \\|^Remailed-\\|^Via: \\|^Mail-from: \\|^Return-Path: \\|^Delivery-Date: \\|^In-Reply-To: \\|^Resent-"
-  "Regexp matching lines in a message header that are not to be shown.
-If `mh-visible-headers' is non-nil, it is used instead to specify what
-to keep.")
-
-(defvar mh-bury-show-buffer t
-  "*Non-nil means that the displayed show buffer for a folder is buried.")
-
-(defvar mh-summary-height 4
-  "*Number of lines in MH-Folder window (including the mode line).")
-
-(defvar mh-msg-number-regexp "^ *\\([0-9]+\\)"
-  "Regexp to find the number of a message in a scan line.
-The message's number must be surrounded with \\( \\)")
-
-(defvar mh-msg-search-regexp "^[^0-9]*%d[^0-9]"
-  "Format string containing a regexp matching the scan listing for a message.
-The desired message's number will be an argument to format.")
-
-(defvar mhl-formfile nil
-  "*Name of format file to be used by mhl to show and print messages.
-A value of T means use the default format file.
-Nil means don't use mhl to format messages when showing; mhl is still used,
-with the default format file, to format messages when printing them.
-The format used should specify a non-zero value for overflowoffset so
-the message continues to conform to RFC 822 and mh-e can parse the headers.")
-(put 'mhl-formfile 'info-file "mh-e")
-
-(defvar mh-default-folder-for-message-function nil
-  "Function to select a default folder for refiling or Fcc.
-If set to a function, that function is called with no arguments by
-`\\[mh-refile-msg]' and `\\[mh-to-fcc]' to get a default when
-prompting the user for a folder.  The function is called from within a
-save-excursion, with point at the start of the message.  It should
-return the folder to offer as the refile or Fcc folder, as a string
-with a leading `+' sign.  It can also return an empty string to use no
-default, or NIL to calculate the default the usual way.
-NOTE: This variable is not an ordinary hook;
-It may not be a list of functions.")
-
-(defvar mh-find-path-hook nil
-  "Invoked by mh-find-path while reading the user's MH profile.")
-
-(defvar mh-folder-list-change-hook nil
-  "Invoked whenever the cached folder list `mh-folder-list' is changed.")
-
-(defvar mh-show-buffer-mode-line-buffer-id "{show-%s} %d"
-  "Format string to produce `mode-line-buffer-identification' for show buffers.
-First argument is folder name.  Second is message number.")
-
-(defvar mh-cmd-note 4
-  "Offset to insert notation.")
-
-(defvar mh-note-seq "%"
-  "String whose first character is used to notate messages in a sequence.")
-
-;;; Internal bookkeeping variables:
-
-;; The value of `mh-folder-list-change-hook' is called whenever
-;; mh-folder-list variable is set.
-(defvar mh-folder-list nil)		;List of folder names for completion.
-
-;; Cached value of the `Path:' component in the user's MH profile.
-(defvar mh-user-path nil)		;User's mail folder directory.
-
-;; An mh-draft-folder of NIL means do not use a draft folder.
-;; Cached value of the `Draft-Folder:' component in the user's MH profile.
-(defvar mh-draft-folder nil)		;Name of folder containing draft messages.
-
-;; Cached value of the `Unseen-Sequence:' component in the user's MH profile.
-(defvar mh-unseen-seq nil)		;Name of the Unseen sequence.
-
-;; Cached value of the `Previous-Sequence:' component in the user's MH profile.
-(defvar mh-previous-seq nil)		;Name of the Previous sequence.
-
-;; Cached value of the `Inbox:' component in the user's MH profile,
-;; or "+inbox" if no such component.
-(defvar mh-inbox nil)			;Name of the Inbox folder.
-
-(defconst mh-temp-buffer " *mh-temp*")	;Name of mh-e scratch buffer.
-
-(defvar mh-previous-window-config nil)	;Window configuration before mh-e command.
-
-;;; Internal variables local to a folder.
-
-(defvar mh-current-folder nil)		;Name of current folder, a string.
-
-(defvar mh-show-buffer nil)		;Buffer that displays message for this folder.
-
-(defvar mh-folder-filename nil)		;Full path of directory for this folder.
-  
-(defvar mh-msg-count nil)		;Number of msgs in buffer.
-
-(defvar mh-showing nil)			;If non-nil, show the message in a separate window.
-
-;;; This holds a documentation string used by describe-mode.
-(defun mh-showing ()
-  "When moving to a new message in the Folder window,
-also show it in a separate Show window."
-  nil)
-
-(defvar mh-seq-list nil)		;The sequences of this folder.  An alist of (seq . msgs).
-
-(defvar mh-seen-list nil)		;List of displayed messages to be removed from the Unseen sequence.
-
-;; If non-nil, show buffer contains message with all headers.
-;; If nil, show buffer contains message processed normally.
-(defvar mh-showing-with-headers nil)	;Showing message with headers or normally.
-
-
-;;; mh-e macros
-
-(defmacro with-mh-folder-updating (save-modification-flag-p &rest body)
-  ;; Format is (with-mh-folder-updating (SAVE-MODIFICATION-FLAG-P) &body BODY).
-  ;; Execute BODY, which can modify the folder buffer without having to
-  ;; worry about file locking or the read-only flag, and return its result.
-  ;; If SAVE-MODIFICATION-FLAG-P is non-nil, the buffer's modification
-  ;; flag is unchanged, otherwise it is cleared.
-  (setq save-modification-flag-p (car save-modification-flag-p)) ; CL style
-  (` (prog1
-	 (let ((mh-folder-updating-mod-flag (buffer-modified-p))
-	       (buffer-read-only nil)
-	       (buffer-file-name nil))	;don't let the buffer get locked
-	   (prog1
-	       (progn
-		 (,@ body))
-	     (mh-set-folder-modified-p mh-folder-updating-mod-flag)))
-       (,@ (if (not save-modification-flag-p)
-	       '((mh-set-folder-modified-p nil)))))))
-
-(put 'with-mh-folder-updating 'lisp-indent-hook 1)
-
-(defmacro mh-in-show-buffer (show-buffer &rest body)
-  ;; Format is (mh-in-show-buffer (SHOW-BUFFER) &body BODY).
-  ;; Display buffer SHOW-BUFFER in other window and execute BODY in it.
-  ;; Stronger than save-excursion, weaker than save-window-excursion.
-  (setq show-buffer (car show-buffer))	; CL style
-  (` (let ((mh-in-show-buffer-saved-window (selected-window)))
-       (switch-to-buffer-other-window (, show-buffer))
-       (if mh-bury-show-buffer (bury-buffer (current-buffer)))
-       (unwind-protect
-	   (progn
-	     (,@ body))
-	 (select-window mh-in-show-buffer-saved-window)))))
-
-(put 'mh-in-show-buffer 'lisp-indent-hook 1)
-
-(defmacro mh-make-seq (name msgs) (list 'cons name msgs))
-
-(defmacro mh-seq-name (pair) (list 'car pair))
-
-(defmacro mh-seq-msgs (pair) (list 'cdr pair))
-
-
-;;; Ensure new buffers won't get this mode if default-major-mode is nil.
-(put 'mh-show-mode 'mode-class 'special)
-
-(defun mh-show-mode ()
-  "Major mode for showing messages in mh-e.
-The value of mh-show-mode-hook is called when a new message is displayed."
-  (kill-all-local-variables)
-  (setq major-mode 'mh-show-mode)
-  (mh-set-mode-name "MH-Show")
-  (run-hooks 'mh-show-mode-hook))
-
-
-(defun mh-maybe-show (&optional msg)
-  ;; If in showing mode, then display the message pointed to by the cursor.
-  (if mh-showing (mh-show msg)))
-
-(defun mh-show (&optional message)
-  "Show MESSAGE (default: message at cursor).
-Force a two-window display with the folder window on top (size
-mh-summary-height) and the show buffer below it.
-If the message is already visible, display the start of the message.
-
-Display of the message is controlled by setting the variables
-`mh-clean-message-header' and `mhl-formfile'.  The default behavior is
-to scroll uninteresting headers off the top of the window.
-Type \"\\[mh-header-display]\" to see the message with all its headers."
-  (interactive)
-  (and mh-showing-with-headers
-       (or mhl-formfile mh-clean-message-header)
-       (mh-invalidate-show-buffer))
-  (mh-show-msg message))
-
-
-(defun mh-show-msg (msg)
-  (if (not msg)
-      (setq msg (mh-get-msg-num t)))
-  (setq mh-showing t)
-  (let ((folder mh-current-folder)
-	(clean-message-header mh-clean-message-header)
-	(show-window (get-buffer-window mh-show-buffer)))
-    (if (not (eql (next-window (minibuffer-window)) (selected-window)))
-	(delete-other-windows))		; force ourself to the top window
-    (mh-in-show-buffer (mh-show-buffer)
-      (if (and show-window
-	       (equal (mh-msg-filename msg folder) buffer-file-name))
-	  (progn			;just back up to start
-	    (goto-char (point-min))
-	    (if (not clean-message-header)
-		(mh-start-of-uncleaned-message)))
-	(mh-display-msg msg folder))))
-  (if (not (= (1+ (window-height)) (screen-height))) ;not horizontally split
-      (shrink-window (- (window-height) mh-summary-height)))
-  (mh-recenter nil)
-  (if (not (memq msg mh-seen-list)) (setq mh-seen-list (cons msg mh-seen-list)))
-  (run-hooks 'mh-show-hook))
-
-
-(defun mh-display-msg (msg-num folder)
-  ;; Display message NUMBER of FOLDER.
-  ;; Sets the current buffer to the show buffer.
-  (set-buffer folder)
-  ;; Bind variables in folder buffer in case they are local
-  (let ((formfile mhl-formfile)
-	(clean-message-header mh-clean-message-header)
-	(invisible-headers mh-invisible-headers)
-	(visible-headers mh-visible-headers)
-	(msg-filename (mh-msg-filename msg-num))
-	(show-buffer mh-show-buffer))
-    (if (not (file-exists-p msg-filename))
-	(error "Message %d does not exist" msg-num))
-    (set-buffer show-buffer)
-    (cond ((not (equal msg-filename buffer-file-name))
-	   (mh-unvisit-file)
-	   (erase-buffer)
-	   ;; Changing contents, so this hook needs to be reinitialized.
-	   ;; pgp.el uses this.
-	   (if (boundp 'write-contents-hooks) ;Emacs 19
-	       (kill-local-variable 'write-contents-hooks))
-	   (if formfile
-	       (mh-exec-lib-cmd-output "mhl" "-nobell" "-noclear"
-				       (if (stringp formfile)
-					   (list "-form" formfile))
-				       msg-filename)
-	     (insert-file-contents msg-filename))
-	   (goto-char (point-min))
-	   (cond (clean-message-header
-		  (mh-clean-msg-header (point-min)
-				       invisible-headers
-				       visible-headers)
-		  (goto-char (point-min)))
-		 (t
-		  (mh-start-of-uncleaned-message)))
-	   ;; the parts of visiting we want to do (no locking)
-	   (or (eq buffer-undo-list t)	;don't save undo info for prev msgs
-	       (setq buffer-undo-list nil))
-	   (set-buffer-modified-p nil)
-	   (set-buffer-auto-saved)
-	   ;; the parts of set-visited-file-name we want to do (no locking)
-	   (setq buffer-file-name msg-filename)
-	   (setq buffer-backed-up nil)
-	   (auto-save-mode 1)
-	   (set-mark nil)
-	   (mh-show-mode)
-	   (setq mode-line-buffer-identification
-		 (list (format mh-show-buffer-mode-line-buffer-id
-			       folder msg-num)))
-	   (set-buffer folder)
-	   (setq mh-showing-with-headers nil)))))
-
-(defun mh-start-of-uncleaned-message ()
-  ;; position uninteresting headers off the top of the window
-  (let ((case-fold-search t))
-    (re-search-forward
-     "^To:\\|^Cc:\\|^From:\\|^Subject:\\|^Date:" nil t)
-    (beginning-of-line)
-    (mh-recenter 0)))
-
-
-(defun mh-invalidate-show-buffer ()
-  ;; Invalidate the show buffer so we must update it to use it.
-  (if (get-buffer mh-show-buffer)
-      (save-excursion
-	(set-buffer mh-show-buffer)
-	(mh-unvisit-file))))
-
-
-(defun mh-unvisit-file ()
-  ;; Separate current buffer from the message file it was visiting.
-  (or (not (buffer-modified-p))
-      (null buffer-file-name)		;we've been here before
-      (yes-or-no-p (format "Message %s modified; flush changes? "
-			   (file-name-nondirectory buffer-file-name)))
-      (error "Flushing changes not confirmed"))
-  (clear-visited-file-modtime)
-  (unlock-buffer)
-  (setq buffer-file-name nil))
-
-  
-(defun mh-get-msg-num (error-if-no-message)
-  ;; Return the message number of the displayed message.  If the argument
-  ;; ERROR-IF-NO-MESSAGE is non-nil, then complain if the cursor is not
-  ;; pointing to a message.
-  (save-excursion
-    (beginning-of-line)
-    (cond ((looking-at mh-msg-number-regexp)
-	   (string-to-int (buffer-substring (match-beginning 1)
-					    (match-end 1))))
-	  (error-if-no-message
-	   (error "Cursor not pointing to message"))
-	  (t nil))))
-
-
-(defun mh-msg-filename (msg &optional folder)
-  ;; Return the file name of MESSAGE in FOLDER (default current folder).
-  (expand-file-name (int-to-string msg)
-		    (if folder
-			(mh-expand-file-name folder)
-			mh-folder-filename)))
-
-
-(defun mh-clean-msg-header (start invisible-headers visible-headers)
-  ;; Flush extraneous lines in a message header, from the given POINT to the
-  ;; end of the message header.  If VISIBLE-HEADERS is non-nil, it contains a
-  ;; regular expression specifying the lines to display, otherwise
-  ;; INVISIBLE-HEADERS contains a regular expression specifying lines to
-  ;; delete from the header.
-  (let ((case-fold-search t))
-    (save-restriction
-      (goto-char start)
-      (if (search-forward "\n\n" nil 'move)
-	  (backward-char 1))
-      (narrow-to-region start (point))
-      (goto-char (point-min))
-      (if visible-headers
-	  (while (< (point) (point-max))
-	    (cond ((looking-at visible-headers)
-		   (forward-line 1)
-		   (while (looking-at "[ \t]") (forward-line 1)))
-		  (t
-		    (mh-delete-line 1)
-		    (while (looking-at "[ \t]")
-		      (mh-delete-line 1)))))
-	  (while (re-search-forward invisible-headers nil t)
-	    (beginning-of-line)
-	    (mh-delete-line 1)
-	    (while (looking-at "[ \t]")
-	      (mh-delete-line 1))))
-      (unlock-buffer))))
-
-
-(defun mh-recenter (arg)
-  ;; Like recenter but with two improvements: nil arg means recenter,
-  ;; and only does anything if the current buffer is in the selected
-  ;; window.  (Commands like save-some-buffers can make this false.)
-  (if (eql (get-buffer-window (current-buffer))
-	   (selected-window))
-      (recenter (if arg arg '(t)))))
-
-
-(defun mh-delete-line (lines)
-  ;; Delete version of kill-line.
-  (delete-region (point) (progn (forward-line lines) (point))))
-
-
-(defun mh-notate (msg notation offset)
-  ;; Marks MESSAGE with the character NOTATION at position OFFSET.
-  ;; Null MESSAGE means the message that the cursor points to.
-  (save-excursion
-    (if (or (null msg)
-	    (mh-goto-msg msg t t))
-	(with-mh-folder-updating (t)
-	  (beginning-of-line)
-	  (forward-char offset)
-	  (delete-char 1)
-	  (insert notation)))))
-
-
-(defun mh-find-msg-get-num (step)
-  ;; Return the message number of the message on the current scan line
-  ;; or one nearby.  Jumps over non-message lines, such as inc errors.
-  ;; STEP tells whether to search forward or backward if we have to search.
-  (or (mh-get-msg-num nil)
-      (let ((msg-num nil)
-	    (nreverses 0))
-	(while (and (not msg-num)
-		    (< nreverses 2))
-	  (cond ((eobp)
-		 (setq step -1)
-		 (setq nreverses (1+ nreverses)))
-		((bobp)
-		 (setq step 1)
-		 (setq nreverses (1+ nreverses))))
-	  (forward-line step)
-	  (setq msg-num (mh-get-msg-num nil)))
-	msg-num)))
-
-(defun mh-goto-msg (number &optional no-error-if-no-message dont-show)
-  "Position the cursor at message NUMBER.
-Optional non-nil second argument means return nil instead of
-signaling an error if message does not exist; in this case,
-the cursor is positioned near where the message would have been.
-Non-nil third argument means not to show the message."
-  (interactive "NGo to message: ")
-  (setq number (prefix-numeric-value number)) ;Emacs 19
-  ;; This basic routine tries to be as fast as possible,
-  ;; using a binary search and minimal regexps.
-  (let ((cur-msg (mh-find-msg-get-num -1))
-	(jump-size mh-msg-count))
-    (while (and (> jump-size 1)
-		cur-msg
-		(not (eq cur-msg number)))
-      (cond ((< cur-msg number)
-	     (setq jump-size (min (- number cur-msg)
-				  (ash (1+ jump-size) -1)))
-	     (forward-line jump-size)
-	     (setq cur-msg (mh-find-msg-get-num 1)))
-	    (t
-	     (setq jump-size (min (- cur-msg number)
-				  (ash (1+ jump-size) -1)))
-	     (forward-line (- jump-size))
-	     (setq cur-msg (mh-find-msg-get-num -1)))))
-    (if (eq cur-msg number)
-	(progn
-	  (beginning-of-line)
-	  (or dont-show
-	      (mh-maybe-show number)
-	      t))
-      (if (not no-error-if-no-message)
-	  (error "No message %d" number)))))
-
-
-(defun mh-msg-search-pat (n)
-  ;; Return a search pattern for message N in the scan listing.
-  (format mh-msg-search-regexp n))
-
-
-(defun mh-get-profile-field (field)
-  ;; Find and return the value of FIELD in the current buffer.
-  ;; Returns NIL if the field is not in the buffer.
-  (let ((case-fold-search t))
-    (goto-char (point-min))
-    (cond ((not (re-search-forward (format "^%s" field) nil t)) nil)
-	  ((looking-at "[\t ]*$") nil)
-	  (t
-	   (re-search-forward "[\t ]*\\([^\t \n].*\\)$" nil t)
-	   (let ((start (match-beginning 1)))
-	     (end-of-line)
-	     (buffer-substring start (point)))))))
-
-(defvar mail-user-agent 'mh-e-user-agent) ;from reporter.el 3.2
-
-(defun mh-find-path ()
-  ;; Set mh-progs and mh-lib.
-  ;; (This step is necessary if MH was installed after this Emacs was dumped.)
-  ;; From profile file, set mh-user-path, mh-draft-folder,
-  ;; mh-unseen-seq, mh-previous-seq, mh-inbox.
-  (mh-find-progs)
-  (save-excursion
-    ;; Be sure profile is fully expanded before switching buffers
-    (let ((profile (expand-file-name (or (getenv "MH") "~/.mh_profile"))))
-      (set-buffer (get-buffer-create mh-temp-buffer))
-      (setq buffer-offer-save nil)	;for people who set default to t
-      (erase-buffer)
-      (condition-case err
-	  (insert-file-contents profile)
-	(file-error
-	 (mh-install profile err)))
-      (setq mh-user-path (mh-get-profile-field "Path:"))
-      (if (not mh-user-path)
-	  (setq mh-user-path "Mail"))
-      (setq mh-user-path
-	    (file-name-as-directory
-	     (expand-file-name mh-user-path (expand-file-name "~"))))
-      (setq mh-draft-folder (mh-get-profile-field "Draft-Folder:"))
-      (if mh-draft-folder
-	  (progn
-	    (if (not (mh-folder-name-p mh-draft-folder))
-		(setq mh-draft-folder (format "+%s" mh-draft-folder)))
-	    (if (not (file-exists-p (mh-expand-file-name mh-draft-folder)))
-		(error "Draft folder \"%s\" not found.  Create it and try again."
-		       (mh-expand-file-name mh-draft-folder)))))
-      (setq mh-inbox (mh-get-profile-field "Inbox:"))
-      (cond ((not mh-inbox)
-	     (setq mh-inbox "+inbox"))
-	    ((not (mh-folder-name-p mh-inbox))
-	     (setq mh-inbox (format "+%s" mh-inbox))))
-      (setq mh-unseen-seq (mh-get-profile-field "Unseen-Sequence:"))
-      (if mh-unseen-seq
-	  (setq mh-unseen-seq (intern mh-unseen-seq))
-	(setq mh-unseen-seq 'unseen))	;old MH default?
-      (setq mh-previous-seq (mh-get-profile-field "Previous-Sequence:"))
-      (if mh-previous-seq
-	  (setq mh-previous-seq (intern mh-previous-seq)))
-      (setq mail-user-agent 'mh-e-user-agent)
-      (run-hooks 'mh-find-path-hook))))
-
-(defun mh-find-progs ()
-  (or (file-exists-p (expand-file-name "inc" mh-progs))
-      (setq mh-progs
-	    (or (mh-path-search exec-path "inc")
-		(mh-path-search '("/usr/local/bin/mh/"
-				  "/usr/local/mh/"
-				  "/usr/bin/mh/" ;Ultrix 4.2
-				  "/usr/new/mh/" ;Ultrix <4.2
-				  "/usr/contrib/mh/bin/" ;BSDI
-				  "/usr/local/bin/"
-				  )
-				"inc")
-		mh-progs
-		"/usr/local/bin/")))
-  (or (file-exists-p (expand-file-name "mhl" mh-lib))
-      (setq mh-lib
-	    (or (mh-path-search '("/usr/local/lib/mh/"
-				  "/usr/local/mh/lib/"
-				  "/usr/local/bin/mh/"
-				  "/usr/lib/mh/" ;Ultrix 4.2
-				  "/usr/new/lib/mh/" ;Ultrix <4.2
-				  "/usr/contrib/mh/lib/" ;BSDI
-				  )
-				"mhl")
-		(mh-path-search exec-path "mhl") ;unlikely
-		mh-lib
-		"/usr/local/lib/mh/"))))
-
-(defun mh-path-search (path file)
-  ;; Search PATH, a list of directory names, for FILE.
-  ;; Returns the element of PATH that contains FILE, or nil if not found.
-  (while (and path
-	      (not (file-exists-p (expand-file-name file (car path)))))
-    (setq path (cdr path)))
-  (car path))
-
-(defvar mh-no-install nil)		;do not run install-mh
-
-(defun mh-install (profile error-val)
-  ;; Called to do error recovery if we fail to read the profile file.
-  ;; If possible, initialize the MH environment.
-  (if (or (getenv "MH")
-	  (file-exists-p profile)
-	  mh-no-install)
-      (signal (car error-val)
-	      (list (format "Cannot read MH profile \"%s\"" profile)
-		    (car (cdr (cdr error-val))))))
-  ;; The "install-mh" command will output a short note which
-  ;; mh-exec-cmd will display to the user.
-  ;; The MH 5 version of install-mh might try prompt the user
-  ;; for information, which would fail here.
-  (mh-exec-cmd (expand-file-name "install-mh" mh-lib) "-auto")
-  ;; now try again to read the profile file
-  (erase-buffer)
-  (condition-case err
-      (insert-file-contents profile)
-    (file-error
-     (signal (car err)			;re-signal with more specific msg
-	     (list (format "Cannot read MH profile \"%s\"" profile)
-		   (car (cdr (cdr err))))))))
-
-
-(defun mh-set-folder-modified-p (flag)
-  ;; Mark current folder as modified or unmodified according to FLAG.
-  (set-buffer-modified-p flag))
-
-
-(defun mh-find-seq (name) (assoc name mh-seq-list))
-
-(defun mh-seq-to-msgs (seq)
-  ;; Return a list of the messages in SEQUENCE.
-  (mh-seq-msgs (mh-find-seq seq)))
-
-
-(defun mh-add-msgs-to-seq (msgs seq &optional internal-flag)
-  ;; Add MESSAGE(s) to the SEQUENCE.  If optional FLAG is non-nil, do not mark
-  ;; the message in the scan listing or inform MH of the addition.
-  (let ((entry (mh-find-seq seq)))
-    (if (and msgs (atom msgs)) (setq msgs (list msgs)))
-    (if (null entry)
-	(setq mh-seq-list (cons (mh-make-seq seq msgs) mh-seq-list))
-	(if msgs (setcdr entry (append msgs (mh-seq-msgs entry)))))
-    (cond ((not internal-flag)
-	   (mh-add-to-sequence seq msgs)
-	   (mh-notate-seq seq mh-note-seq (1+ mh-cmd-note))))))
-
-(autoload 'mh-add-to-sequence "mh-seq")
-(autoload 'mh-notate-seq "mh-seq")
-(autoload 'mh-read-seq-default "mh-seq")
-(autoload 'mh-map-to-seq-msgs "mh-seq")
-
-
-(defun mh-set-mode-name (mode-name-string)
-  ;; Set the mode-name and ensure that the mode line is updated.
-  (setq mode-name mode-name-string)
-  (force-mode-line-update t))
-
-
-(defun mh-prompt-for-folder (prompt default can-create)
-  ;; Prompt for a folder name with PROMPT.  Returns the folder's name as a
-  ;; string.  DEFAULT is used if the folder exists and the user types return.
-  ;; If the CAN-CREATE flag is t, then a non-existent folder is made.
-  (if (null default)
-      (setq default ""))
-  (let* ((prompt (format "%s folder%s" prompt
-			 (if (equal "" default)
-			     "? "
-			     (format " [%s]? " default))))
-	 read-name folder-name)
-    (if (null mh-folder-list)
-	(mh-set-folder-list))
-    (while (and (setq read-name (completing-read prompt mh-folder-list
-					    nil nil "+"))
-		(equal read-name "")
-		(equal default "")))
-    (cond ((or (equal read-name "") (equal read-name "+"))
-	   (setq read-name default))
-	  ((not (mh-folder-name-p read-name))
-	   (setq read-name (format "+%s" read-name))))
-    (setq folder-name read-name)
-    (cond ((and (> (length folder-name) 0)
-		(eql (aref folder-name (1- (length folder-name))) ?/))
-	   (setq folder-name (substring folder-name 0 -1))))
-    (let ((new-file-p (not (file-exists-p (mh-expand-file-name folder-name)))))
-      (cond ((and new-file-p
-		  (y-or-n-p
-		   (format "Folder %s does not exist.  Create it? " folder-name)))
-	     (message "Creating %s" folder-name)
-	     (call-process "mkdir" nil nil nil (mh-expand-file-name folder-name))
-	     (message "Creating %s...done" folder-name)
-	     (setq mh-folder-list (cons (list read-name) mh-folder-list))
-	     (run-hooks 'mh-folder-list-change-hook))
-	    (new-file-p
-	     (error "Folder %s is not created" folder-name))
-	    ((not (file-directory-p (mh-expand-file-name folder-name)))
-	     (error "\"%s\" is not a directory"
-		    (mh-expand-file-name folder-name)))
-	    ((and (null (assoc read-name mh-folder-list))
-		  (null (assoc (concat read-name "/") mh-folder-list)))
-	     (setq mh-folder-list (cons (list read-name) mh-folder-list))
-	     (run-hooks 'mh-folder-list-change-hook))))
-    folder-name))
-
-
-(defvar mh-make-folder-list-process nil) ;The background process collecting the folder list.
-
-(defvar mh-folder-list-temp nil)	;mh-folder-list as it is being built.
-
-(defvar mh-folder-list-partial-line "")	;Start of last incomplete line from folder process.
-
-(defun mh-set-folder-list ()
-  ;; Sets mh-folder-list correctly.
-  ;; A useful function for the command line or for when you need to
-  ;; sync by hand.  Format is in a form suitable for completing read.
-  (message "Collecting folder names...")
-  (if (not mh-make-folder-list-process)
-      (mh-make-folder-list-background))
-  (while (eq (process-status mh-make-folder-list-process) 'run)
-    (accept-process-output mh-make-folder-list-process))
-  (setq mh-folder-list mh-folder-list-temp)
-  (run-hooks 'mh-folder-list-change-hook)
-  (setq mh-folder-list-temp nil)
-  (delete-process mh-make-folder-list-process)
-  (setq mh-make-folder-list-process nil)
-  (message "Collecting folder names...done"))
-
-(defun mh-make-folder-list-background ()
-  ;; Start a background process to compute a list of the user's folders.
-  ;; Call mh-set-folder-list to wait for the result.
-  (cond
-   ((not mh-make-folder-list-process)
-    (mh-find-path)
-    (let ((process-connection-type nil))
-      (setq mh-make-folder-list-process
-	    (start-process "folders" nil (expand-file-name "folders" mh-progs)
-			   "-fast"
-			   (if mh-recursive-folders
-			       "-recurse"
-			     "-norecurse")))
-      (set-process-filter mh-make-folder-list-process
-			  'mh-make-folder-list-filter)
-      (process-kill-without-query mh-make-folder-list-process)))))
-
-(defun mh-make-folder-list-filter (process output)
-  ;; parse output from "folders -fast"
-  (let ((position 0)
-	line-end
-	new-folder
-	(prevailing-match-data (match-data)))
-    (unwind-protect
-	;; make sure got complete line
-	(while (setq line-end (string-match "\n" output position))
-	  (setq new-folder (format "+%s%s"
-				   mh-folder-list-partial-line
-				   (substring output position line-end)))
-	  (setq mh-folder-list-partial-line "")
-	  ;; is new folder a subfolder of previous?
-	  (if (and mh-folder-list-temp
-		   (string-match
-		    (regexp-quote
-		     (concat (car (car mh-folder-list-temp)) "/"))
-		    new-folder))
-	      ;; append slash to parent folder for better completion
-	      ;; (undone by mh-prompt-for-folder)
-	      (setq mh-folder-list-temp
-		    (cons
-		     (list new-folder)
-		     (cons
-		      (list (concat (car (car mh-folder-list-temp)) "/"))
-		      (cdr mh-folder-list-temp))))
-	    (setq mh-folder-list-temp
-		  (cons (list new-folder)
-			mh-folder-list-temp)))
-	  (setq position (1+ line-end)))
-      (store-match-data prevailing-match-data))
-    (setq mh-folder-list-partial-line (substring output position))))
-
-
-(defun mh-folder-name-p (name)
-  ;; Return non-NIL if NAME is possibly the name of a folder.
-  ;; A name (a string or symbol) can be a folder name if it begins with "+".
-  (if (symbolp name)
-      (eql (aref (symbol-name name) 0) ?+)
-    (and (> (length name) 0)
-	 (eql (aref name 0) ?+))))
-
-
-;;; Issue commands to MH.
-
-
-(defun mh-exec-cmd (command &rest args)
-  ;; Execute mh-command COMMAND with ARGS.
-  ;; The side effects are what is desired.
-  ;; Any output is assumed to be an error and is shown to the user.
-  ;; The output is not read or parsed by mh-e.
-  (save-excursion
-    (set-buffer (get-buffer-create mh-temp-buffer))
-    (erase-buffer)
-    (apply 'call-process
-	   (expand-file-name command mh-progs) nil t nil
-	   (mh-list-to-string args))
-    (if (> (buffer-size) 0)
-	(save-window-excursion
-	  (switch-to-buffer-other-window mh-temp-buffer)
-	  (sit-for 5)))))
-
-
-(defun mh-exec-cmd-error (env command &rest args)
-  ;; In environment ENV, execute mh-command COMMAND with args ARGS.
-  ;; ENV is nil or a string of space-separated "var=value" elements.
-  ;; Signals an error if process does not complete successfully.
-  (save-excursion
-    (set-buffer (get-buffer-create mh-temp-buffer))
-    (erase-buffer)
-    (let ((status
-	   (if env
-	       ;; the shell hacks necessary here shows just how broken Unix is
-	       (apply 'call-process "/bin/sh" nil t nil "-c"
-		      (format "%s %s ${1+\"$@\"}"
-			      env 
-			      (expand-file-name command mh-progs))
-		      command
-		      (mh-list-to-string args))
-	       (apply 'call-process
-		      (expand-file-name command mh-progs) nil t nil
-		      (mh-list-to-string args)))))
-      (mh-handle-process-error command status))))
-
-
-(defun mh-exec-cmd-daemon (command &rest args)
-  ;; Execute MH command COMMAND with ARGS in the background.
-  ;; Any output from command is displayed in an asynchronous pop-up window.
-  (save-excursion
-    (set-buffer (get-buffer-create mh-temp-buffer))
-    (erase-buffer))
-  (let* ((process-connection-type nil)
-	 (process (apply 'start-process
-			 command nil
-			 (expand-file-name command mh-progs)
-			 (mh-list-to-string args))))
-    (set-process-filter process 'mh-process-daemon)))
-
-(defun mh-process-daemon (process output)
-  ;; Process daemon that puts output into a temporary buffer.
-  (set-buffer (get-buffer-create mh-temp-buffer))
-  (insert-before-markers output)
-  (display-buffer mh-temp-buffer))
-
-
-(defun mh-exec-cmd-quiet (raise-error command &rest args)
-  ;; Args are RAISE-ERROR, COMMANDS, ARGS....
-  ;; Execute MH command COMMAND with ARGS.  ARGS is a list of strings.
-  ;; Return at start of mh-temp buffer, where output can be parsed and used.
-  ;; Returns value of call-process, which is 0 for success,
-  ;; unless RAISE-ERROR is non-nil, in which case an error is signaled
-  ;; if call-process returns non-0.
-  (set-buffer (get-buffer-create mh-temp-buffer))
-  (erase-buffer)
-  (let ((value
-	 (apply 'call-process
-		(expand-file-name command mh-progs) nil t nil
-		args)))
-    (goto-char (point-min))
-    (if raise-error
-	(mh-handle-process-error command value)
-      value)))
-
-
-(defun mh-exec-cmd-output (command display &rest args)
-  ;; Execute MH command COMMAND with DISPLAY flag and ARGS.
-  ;; Put the output into buffer after point.  Set mark after inserted text.
-  ;; Output is expected to be shown to user, not parsed by mh-e.
-  (push-mark (point) t)
-  (apply 'call-process
-	 (expand-file-name command mh-progs) nil t display
-	 (mh-list-to-string args))
-  (exchange-point-and-mark))
-
-
-(defun mh-exec-lib-cmd-output (command &rest args)
-  ;; Execute MH library command COMMAND with ARGS.
-  ;; Put the output into buffer after point.  Set mark after inserted text.
-  (apply 'mh-exec-cmd-output (expand-file-name command mh-lib) nil args))
-
-
-(defun mh-handle-process-error (command status)
-  ;; Raise error if COMMAND returned non-0 STATUS, otherwise return STATUS.
-  ;; STATUS is return value from call-process.
-  ;; Program output is in current buffer.
-  ;; If output is too long to include in error message, display the buffer.
-  (cond ((eql status 0)			;success
-	 status)
-	((stringp status)		;kill string
-	 (error "%s: %s" command status))
-	(t				;exit code
-	 (cond
-	  ((= (buffer-size) 0)		;program produced no error message
-	   (error "%s: exit code %d" command status))
-	  (t
-	   ;; will error message fit on one line?
-	   (goto-line 2)
-	   (if (and (< (buffer-size) (screen-width))
-		    (eobp))
-	       (error "%s"
-		      (buffer-substring 1 (progn (goto-char 1)
-						 (end-of-line)
-						 (point))))
-	     (display-buffer (current-buffer))
-	     (error "%s failed with status %d.  See error message in other window."
-		    command status)))))))
-
-
-(defun mh-expand-file-name (filename &optional default)
-  ;; Just like `expand-file-name', but also handles MH folder names.
-  ;; Assumes that any filename that starts with '+' is a folder name.
-   (if (mh-folder-name-p filename)
-       (expand-file-name (substring filename 1) mh-user-path)
-     (expand-file-name filename default)))
-
-
-(defun mh-list-to-string (l)
-  ;; Flattens the list L and makes every element of the new list into a string.
-  (nreverse (mh-list-to-string-1 l)))
-
-(defun mh-list-to-string-1 (l)
-  (let ((new-list nil))
-    (while l
-      (cond ((null (car l)))
-	    ((symbolp (car l))
-	     (setq new-list (cons (symbol-name (car l)) new-list)))
-	    ((numberp (car l))
-	     (setq new-list (cons (int-to-string (car l)) new-list)))
-	    ((equal (car l) ""))
-	    ((stringp (car l)) (setq new-list (cons (car l) new-list)))
-	    ((listp (car l))
-	     (setq new-list (nconc (mh-list-to-string-1 (car l))
-				   new-list)))
-	    (t (error "Bad element in mh-list-to-string: %s" (car l))))
-      (setq l (cdr l)))
-    new-list))
-
-(provide 'mh-utils)
-
-(and (not noninteractive)
-     mh-auto-folder-collect
-     (let ((mh-no-install t))		;only get folders if MH installed
-       (condition-case err
-	   (mh-make-folder-list-background)
-	 (file-error))))		;so don't complain if not installed
-
-;;; mh-utils.el ends here
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
deleted file mode 100644
index 76d7108d1a0..00000000000
--- a/lisp/mail/reporter.el
+++ /dev/null
@@ -1,437 +0,0 @@
-;;; reporter.el --- customizable bug reporting of lisp programs
-
-;; Copyright (C) 1993 1994 1995 1996 Free Software Foundation, Inc.
-
-;; Author:          1993-1996 Barry A. Warsaw
-;; Created:         19-Apr-1993
-;; Version:         3.3
-;; Last Modified:   1996/07/02 00:39:09
-;; Keywords: maint mail 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:
-
-;; End User Interface
-;; ==================
-;; The variable `mail-user-agent' contains a symbol indicating which
-;; Emacs mail package end users would like to use to compose outgoing
-;; mail.  See that variable for details.
-
-;; Lisp Package Authors
-;; ====================
-;; Reporter was written primarily for Emacs Lisp package authors so
-;; that their users can easily report bugs.  When invoked,
-;; reporter-submit-bug-report will set up an outgoing mail buffer with
-;; the appropriate bug report address, including a lisp expression the
-;; maintainer of the package can eval to completely reproduce the
-;; environment in which the bug was observed (e.g. by using
-;; eval-last-sexp).  This package proved especially useful during my
-;; development of cc-mode, which is highly dependent on its
-;; configuration variables.
-;;
-;; Do a "C-h f reporter-submit-bug-report" for more information.
-;; Here's an example usage:
-;;
-;;(defconst mypkg-version "9.801")
-;;(defconst mypkg-maintainer-address "mypkg-help@foo.com")
-;;(defun mypkg-submit-bug-report ()
-;;  "Submit via mail a bug report on mypkg"
-;;  (interactive)
-;;  (reporter-submit-bug-report
-;;   mypkg-maintainer-address
-;;   (concat "mypkg.el " mypkg-version)
-;;   (list 'mypkg-variable-1
-;;         'mypkg-variable-2
-;;         ;; ...
-;;         'mypkg-variable-last)))
-
-;; Mailing List
-;; ============
-;; I've set up a Majordomo mailing list to report bugs or suggest
-;; enhancements, etc.  This list's intended audience is elisp package
-;; authors who are using reporter and want to stay current with
-;; releases. Here are the relevant addresses:
-;;
-;; Administrivia: reporter-request@python.org
-;; Submissions:   reporter@python.org
-
-;; Packages that currently use reporter are: cc-mode, supercite, elp,
-;; tcl, ediff, crypt++ (crypt), dired-x, rmailgen, mode-line, vm,
-;; mh-e, edebug, archie, viper, w3-mode, framepop, hl319, hilit19,
-;; pgp, eos, hm--html, efs.
-;;
-;; If you know of others, please email me!
-
-;;; Code:
-
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; Package author interface variables
-
-(defvar reporter-prompt-for-summary-p nil
-  "Interface variable controlling prompting for problem summary.
-When non-nil, `reporter-submit-bug-report' prompts the user for a
-brief summary of the problem, and puts this summary on the Subject:
-line.  If this variable is a string, that string is used as the prompt
-string.
-
-Default behavior is to not prompt (i.e. nil). If you want reporter to
-prompt, you should `let' bind this variable before calling
-`reporter-submit-bug-report'.  Note that this variable is not
-buffer-local so you should never just `setq' it.")
-
-(defvar reporter-dont-compact-list nil
-  "Interface variable controlling compacting of list values.
-When non-nil, this must be a list of variable symbols.  When a
-variable containing a list value is formatted in the bug report mail
-buffer, it normally is compacted so that its value fits one the fewest
-number of lines.  If the variable's symbol appears in this list, its
-value is printed in a more verbose style, specifically, one elemental
-sexp per line.
-
-Note that this variable is not buffer-local so you should never just
-`setq' it.  If you want to changes its default value, you should `let'
-bind it.")
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; End of editable variables
-
-
-(defvar reporter-eval-buffer nil
-  "Buffer to retrieve variable's value from.
-This is necessary to properly support the printing of buffer-local
-variables.  Current buffer will always be the mail buffer being
-composed.")
-
-(defconst reporter-version "3.2"
-  "Reporter version number.")
-
-(defvar reporter-initial-text nil
-  "The automatically created initial text of a bug report.")
-(make-variable-buffer-local 'reporter-initial-text)
-
-
-
-;; status feedback to the user
-(defvar reporter-status-message nil)
-(defvar reporter-status-count nil)
-
-(defun reporter-update-status ()
-  ;; periodically output a status message
-  (if (zerop (% reporter-status-count 10))
-      (progn
-	(message reporter-status-message)
-	(setq reporter-status-message (concat reporter-status-message "."))))
-  (setq reporter-status-count (1+ reporter-status-count)))
-
-
-;; dumping/pretty printing of values
-(defun reporter-beautify-list (maxwidth compact-p)
-  ;; pretty print a list
-  (reporter-update-status)
-  (let (linebreak indent-enclosing-p indent-p here)
-    (condition-case nil			;loop exit
-	(progn
-	  (down-list 1)
-	  (setq indent-enclosing-p t)
-	  (while t
-	    (setq here (point))
-	    (forward-sexp 1)
-	    (if (<= maxwidth (current-column))
-		(if linebreak
-		    (progn
-		      (goto-char linebreak)
-		      (newline-and-indent)
-		      (setq linebreak nil))
-		  (goto-char here)
-		  (setq indent-p (reporter-beautify-list maxwidth compact-p))
-		  (goto-char here)
-		  (forward-sexp 1)
-		  (if indent-p
-		      (newline-and-indent))
-		  t)
-	      (if compact-p
-		  (setq linebreak (point))
-		(newline-and-indent))
-	      ))
-	  t)
-      (error indent-enclosing-p))))
-
-(defun reporter-lisp-indent (indent-point state)
-  ;; a better lisp indentation style for bug reporting
-  (save-excursion
-    (goto-char (1+ (nth 1 state)))
-    (current-column)))
-
-(defun reporter-dump-variable (varsym mailbuf)
-  ;; Pretty-print the value of the variable in symbol VARSYM.  MAILBUF
-  ;; is the mail buffer being composed
-  (reporter-update-status)
-  (condition-case nil
-      (let ((val (save-excursion
-		   (set-buffer reporter-eval-buffer)
-		   (symbol-value varsym)))
-	    (sym (symbol-name varsym))
-	    (print-escape-newlines t)
-	    (maxwidth (1- (window-width)))
-	    (here (point)))
-	(insert "     " sym " "
-		(cond
-		 ((memq val '(t nil)) "")
-		 ((listp val) "'")
-		 ((symbolp val) "'")
-		 (t ""))
-		(prin1-to-string val))
-	(lisp-indent-line)
-	;; clean up lists, but only if the line as printed was long
-	;; enough to wrap
-	(if (and val			;nil is a list, but short
-		 (listp val)
-		 (<= maxwidth (current-column)))
-	    (save-excursion
-	      (let ((compact-p (not (memq varsym reporter-dont-compact-list)))
-		    (lisp-indent-function 'reporter-lisp-indent))
-		(goto-char here)
-		(reporter-beautify-list maxwidth compact-p))))
-	(insert "\n"))
-    (void-variable
-     (save-excursion
-       (set-buffer mailbuf)
-       (mail-position-on-field "X-Reporter-Void-Vars-Found")
-       (end-of-line)
-       (insert (symbol-name varsym) " ")))
-    (error
-     (error ""))))
-
-(defun reporter-dump-state (pkgname varlist pre-hooks post-hooks)
-  ;; Dump the state of the mode specific variables.
-  ;; PKGNAME contains the name of the mode as it will appear in the bug
-  ;; report (you must explicitly concat any version numbers).
-
-  ;; VARLIST is the list of variables to dump.  Each element in
-  ;; VARLIST can be a variable symbol, or a cons cell.  If a symbol,
-  ;; this will be passed to `reporter-dump-variable' for insertion
-  ;; into the mail buffer.  If a cons cell, the car must be a variable
-  ;; symbol and the cdr must be a function which will be `funcall'd
-  ;; with arguments the symbol and the mail buffer being composed. Use
-  ;; this to write your own custom variable value printers for
-  ;; specific variables.
-
-  ;; Note that the global variable `reporter-eval-buffer' will be bound to
-  ;; the buffer in which `reporter-submit-bug-report' was invoked.  If you
-  ;; want to print the value of a buffer local variable, you should wrap
-  ;; the `eval' call in your custom printer inside a `set-buffer' (and
-  ;; probably a `save-excursion'). `reporter-dump-variable' handles this
-  ;; properly.
-
-  ;; PRE-HOOKS is run after the emacs-version and PKGNAME are inserted, but
-  ;; before the VARLIST is dumped.  POST-HOOKS is run after the VARLIST is
-  ;; dumped.
-  (let ((buffer (current-buffer)))
-    (set-buffer buffer)
-    (insert "Emacs  : " (emacs-version) "\n")
-    (and pkgname
-	 (insert "Package: " pkgname "\n"))
-    (run-hooks 'pre-hooks)
-    (if (not varlist)
-	nil
-      (insert "\ncurrent state:\n==============\n")
-      ;; create an emacs-lisp-mode buffer to contain the output, which
-      ;; we'll later insert into the mail buffer
-      (condition-case fault
-	  (let ((mailbuf (current-buffer))
-		(elbuf (get-buffer-create " *tmp-reporter-buffer*")))
-	    (save-excursion
-	      (set-buffer elbuf)
-	      (emacs-lisp-mode)
-	      (erase-buffer)
-	      (insert "(setq\n")
-	      (lisp-indent-line)
-	      (mapcar
-	       (function
-		(lambda (varsym-or-cons-cell)
-		  (let ((varsym (or (car-safe varsym-or-cons-cell)
-				    varsym-or-cons-cell))
-			(printer (or (cdr-safe varsym-or-cons-cell)
-				     'reporter-dump-variable)))
-		    (funcall printer varsym mailbuf)
-		    )))
-	       varlist)
-	      (lisp-indent-line)
-	      (insert ")\n"))
-	    (insert-buffer elbuf))
-	(error
-	 (insert "State could not be dumped due to the following error:\n\n"
-		 (format "%s" fault)
-		 "\n\nYou should still send this bug report."))))
-    (run-hooks 'post-hooks)
-    ))
-
-
-(defun reporter-calculate-separator ()
-  ;; returns the string regexp matching the mail separator
-  (save-excursion
-    (re-search-forward
-     (concat
-      "^\\("				;beginning of line
-      (mapconcat
-       'identity
-       (list "[\t ]*"			;simple SMTP form
-	     "-+"			;mh-e form
-	     (regexp-quote 
-	      mail-header-separator))	;sendmail.el form
-       "\\|")				;or them together
-      "\\)$")				;end of line
-     nil
-     'move)				;search for and move
-    (buffer-substring (match-beginning 0) (match-end 0))))
-
-
-(defun reporter-compose-outgoing ()
-  ;; compose the outgoing mail buffer, and return the selected
-  ;; paradigm, with the current-buffer tacked onto the beginning of
-  ;; the list.
-  (let* ((agent mail-user-agent)
-	 (compose (get mail-user-agent 'composefunc)))
-    ;; Sanity check.  If this fails then we'll try to use the SENDMAIL
-    ;; protocol, otherwise we must signal an error.
-    (if (not (and compose (fboundp compose)))
-	(progn
-	  (setq agent 'sendmail-user-agent
-		compose (get agent 'composefunc))
-	  (if (not (and compose (fboundp compose)))
-	      (error "Could not find a valid `mail-user-agent'")
-	    (ding)
-	    (message "`%s' is an invalid `mail-user-agent'; using `sendmail-user-agent'"
-		     mail-user-agent)
-	    )))
-    (funcall compose)
-    agent))
-
-
-;;;###autoload
-(defun reporter-submit-bug-report
-  (address pkgname varlist &optional pre-hooks post-hooks salutation)
-  ;; Submit a bug report via mail.
-
-  ;; ADDRESS is the email address for the package's maintainer. PKGNAME is
-  ;; the name of the mode (you must explicitly concat any version numbers).
-  ;; VARLIST is the list of variables to dump (see `reporter-dump-state'
-  ;; for details). Optional PRE-HOOKS and POST-HOOKS are passed to
-  ;; `reporter-dump-state'. Optional SALUTATION is inserted at the top of the
-  ;; mail buffer, and point is left after the salutation.
-
-  ;; This function will prompt for a summary if
-  ;; reporter-prompt-for-summary-p is non-nil.
-
-  ;; The mailer used is described in by the variable `mail-user-agent'.
-  (let ((reporter-eval-buffer (current-buffer))
-	final-resting-place
-	after-sep-pos
-	(reporter-status-message "Formatting bug report buffer...")
-	(reporter-status-count 0)
-	(problem (and reporter-prompt-for-summary-p
-		      (read-string (if (stringp reporter-prompt-for-summary-p)
-				       reporter-prompt-for-summary-p
-				     "(Very) brief summary of problem: "))))
-	(agent (reporter-compose-outgoing))
-	(mailbuf (current-buffer))
-	hookvar)
-    ;; do the work
-    (require 'sendmail)
-    ;; If mailbuf did not get made visible before, make it visible now.
-    (let (same-window-buffer-names same-window-regexps)
-      (pop-to-buffer mailbuf)
-      ;; Just in case the original buffer is not visible now, bring it
-      ;; back somewhere
-      (display-buffer reporter-eval-buffer))
-    (goto-char (point-min))
-    ;; different mailers use different separators, some may not even
-    ;; use mail-header-separator, but sendmail.el stuff must have this
-    ;; variable bound.
-    (let ((mail-header-separator (reporter-calculate-separator)))
-      (mail-position-on-field "to")
-      (insert address)
-      ;; insert problem summary if available
-      (if (and reporter-prompt-for-summary-p problem pkgname)
-	  (progn
-	    (mail-position-on-field "subject")
-	    (insert pkgname "; " problem)))
-      ;; move point to the body of the message
-      (mail-text)
-      (forward-line 1)
-      (setq after-sep-pos (point))
-      (and salutation (insert "\n" salutation "\n\n"))
-      (unwind-protect
-	  (progn
-	    (setq final-resting-place (point-marker))
-	    (insert "\n\n")
-	    (reporter-dump-state pkgname varlist pre-hooks post-hooks)
-	    (goto-char final-resting-place))
-	(set-marker final-resting-place nil)))
-
-    ;; save initial text and set up the `no-empty-submission' hook.
-    ;; This only works for mailers that support a pre-send hook, and
-    ;; for which the paradigm has a non-nil value for the `hookvar'
-    ;; key in its agent (i.e. sendmail.el's mail-send-hook).
-    (save-excursion
-      (goto-char (point-max))
-      (skip-chars-backward " \t\n")
-      (setq reporter-initial-text (buffer-substring after-sep-pos (point))))
-    (if (setq hookvar (get agent 'hookvar))
-	(progn
-	  (make-variable-buffer-local hookvar)
-	  (add-hook hookvar 'reporter-bug-hook)))
-
-    ;; compose the minibuf message and display this.
-    (let* ((sendkey-whereis (where-is-internal
-			     (get agent 'sendfunc) nil t))
-	   (abortkey-whereis (where-is-internal
-			      (get agent 'abortfunc) nil t))
-	   (sendkey (if sendkey-whereis
-			(key-description sendkey-whereis)
-		      "C-c C-c"))   ; TBD: BOGUS hardcode
-	   (abortkey (if abortkey-whereis
-			 (key-description abortkey-whereis)
-		       "M-x kill-buffer"))  ; TBD: BOGUS hardcode
-	   )
-      (message "Please enter your report.  Type %s to send, %s to abort."
-	       sendkey abortkey))
-    ))
-
-(defun reporter-bug-hook ()
-  ;; prohibit sending mail if empty bug report
-  (let ((after-sep-pos
-	 (save-excursion
-	   (beginning-of-buffer)
-	   (re-search-forward (reporter-calculate-separator) (point-max) 'move)
-	   (forward-line 1)
-	   (point))))
-    (save-excursion
-      (goto-char (point-max))
-      (skip-chars-backward " \t\n")
-      (if (and (= (- (point) after-sep-pos)
-		  (length reporter-initial-text))
-	       (string= (buffer-substring after-sep-pos (point))
-			reporter-initial-text))
-	  (error "Bug report was empty--not sent"))
-      )))
-
-
-(provide 'reporter)
-;;; reporter.el ends here
diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el
deleted file mode 100644
index 178dd943cb6..00000000000
--- a/lisp/mail/rfc822.el
+++ /dev/null
@@ -1,319 +0,0 @@
-;;; rfc822.el --- hairy rfc822 parser for mail and news and suchlike
-
-;; Copyright (C) 1986, 87, 1990 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik <mly@eddie.mit.edu>
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; 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:
-
-;; Support functions for parsing RFC-822 headers, used by mail and news
-;; modes.  
-
-;;; Code:
-
-;; uses address-start free, throws to address
-(defun rfc822-bad-address (reason)
-  (save-restriction
-    (insert "_^_")
-    (narrow-to-region address-start
-		      (if (re-search-forward "[,;]" nil t)
-			  (max (point-min) (1- (point)))
-			(point-max)))
-    ;; make the error string be suitable for inclusion in (...)
-    (let ((losers '("\\" "(" ")" "\n")))
-      (while losers
-	(goto-char (point-min))
-	(while (search-forward (car losers) nil t)
-	  (backward-char 1)
-	  (insert ?\\)
-	  (forward-char 1))
-	(setq losers (cdr losers))))
-    (goto-char (point-min)) (insert "(Unparsable address -- "
-				    reason
-				    ": \"")
-    (goto-char (point-max)) (insert "\")"))
-  (rfc822-nuke-whitespace)
-  (throw 'address (buffer-substring address-start (point))))
-
-(defun rfc822-nuke-whitespace (&optional leave-space)
-  (let (ch)
-    (while (cond ((eobp)
-		  nil)
-		 ((= (setq ch (following-char)) ?\()
-		  (forward-char 1)
-		  (while (if (eobp)
-			     (rfc822-bad-address "Unbalanced comment (...)")
-			   (/= (setq ch (following-char)) ?\)))
-		    (cond ((looking-at "[^()\\]+")
-			   (replace-match ""))
-			  ((= ch ?\()
-			   (rfc822-nuke-whitespace))
-			  ((< (point) (1- (point-max)))
-			   (delete-char 2))
-			  (t
-			   (rfc822-bad-address "orphaned backslash"))))
-		  ;; delete remaining "()"
-		  (forward-char -1)
-		  (delete-char 2)
-		  t)
-		 ((memq ch '(?\ ?\t ?\n))
-		  (delete-region (point)
-				 (progn (skip-chars-forward " \t\n") (point)))
-		  t)
-		 (t
-		  nil)))
-    (or (not leave-space)
-	(eobp)
-	(bobp)
-	(= (preceding-char) ?\ )
-	(insert ?\ ))))
-
-(defun rfc822-looking-at (regex &optional leave-space)
-  (if (cond ((stringp regex)
-	     (if (looking-at regex)
-		 (progn (goto-char (match-end 0))
-			t)))
-	    (t
-	     (if (and (not (eobp))
-		      (= (following-char) regex))
-		 (progn (forward-char 1)
-			t))))
-      (let ((tem (match-data)))
-	(rfc822-nuke-whitespace leave-space)
-	(store-match-data tem)
-	t)))
-
-(defun rfc822-snarf-word ()
-  ;; word is atom | quoted-string
-  (cond ((= (following-char) ?\")
-	 ;; quoted-string
-	 (or (rfc822-looking-at "\"\\([^\"\\\n]\\|\\\\.\\|\\\\\n\\)*\"")
-	     (rfc822-bad-address "Unterminated quoted string")))
-	((rfc822-looking-at "[^][\000-\037\177-\377 ()<>@,;:\\\".]+")
-	 ;; atom
-	 )
-	(t
-	 (rfc822-bad-address "Rubbish in address"))))
-
-(defun rfc822-snarf-words ()
-  (rfc822-snarf-word)
-  (while (rfc822-looking-at ?.)
-    (rfc822-snarf-word)))
-
-(defun rfc822-snarf-subdomain ()
-  ;; sub-domain is domain-ref | domain-literal
-  (cond ((= (following-char) ?\[)
-	 ;; domain-ref
-	 (or (rfc822-looking-at "\\[\\([^][\\\n]\\|\\\\.\\|\\\\\n\\)*\\]")
-	     (rfc822-bad-address "Unterminated domain literal [...]")))
-	((rfc822-looking-at "[^][\000-\037\177-\377 ()<>@,;:\\\".]+")
-	 ;; domain-literal = atom
-	 )
-	(t
-	 (rfc822-bad-address "Rubbish in host/domain specification"))))
-
-(defun rfc822-snarf-domain ()
-  (rfc822-snarf-subdomain)
-  (while (rfc822-looking-at ?.)
-    (rfc822-snarf-subdomain)))
-
-(defun rfc822-snarf-frob-list (name separator terminator snarfer
-				    &optional return)
-  (let ((first t)
-	(list ())
-	tem)
-    (while (cond ((eobp)
-		  (rfc822-bad-address
-		    (format "End of addresses in middle of %s" name)))
-		 ((rfc822-looking-at terminator)
-		  nil)
-		 ((rfc822-looking-at separator)
-		  ;; multiple separators are allowed and do nothing.
-		  (while (rfc822-looking-at separator))
-		  t)
-		 (first
-		  t)
-		 (t
-		  (rfc822-bad-address
-		    (format "Gubbish in middle of %s" name))))
-      (setq tem (funcall snarfer)
-	    first nil)
-      (and return tem
-	   (setq list (if (listp tem)
-			  (nconc (reverse tem) list)
-			  (cons tem list)))))
-    (nreverse list)))
-
-;; return either an address (a string) or a list of addresses
-(defun rfc822-addresses-1 (&optional allow-groups)
-  ;; Looking for an rfc822 `address'
-  ;; Either a group (1*word ":" [#mailbox] ";")
-  ;; or a mailbox (addr-spec | 1*word route-addr)
-  ;;  addr-spec is (local-part "@" domain)
-  ;;  route-addr is ("<" [1#("@" domain) ":"] addr-spec ">")
-  ;;  local-part is (word *("." word))
-  ;;  word is (atom | quoted-string)
-  ;;  quoted-string is ("\([^\"\\n]\|\\.\|\\\n\)")
-  ;;  atom is [^\000-\037\177 ()<>@,;:\".[]]+
-  ;;  domain is sub-domain *("." sub-domain)
-  ;;  sub-domain is domain-ref | domain-literal
-  ;;  domain-literal is  "[" *(dtext | quoted-pair) "]"
-  ;;  dtext is "[^][\\n"
-  ;;  domain-ref is atom
-  (let ((address-start (point))
-	(n 0))
-    (catch 'address
-      ;; optimize common cases:
-      ;;  foo
-      ;;  foo.bar@bar.zap
-      ;; followed by "\\'\\|,\\|([^()\\]*)\\'"
-      ;; other common cases are:
-      ;;  foo bar <foo.bar@baz.zap>
-      ;;  "foo bar" <foo.bar@baz.zap>
-      ;;  those aren't hacked yet.
-      (if (and (rfc822-looking-at "[^][\000-\037\177-\377 ()<>@,;:\\\"]+\\(\\|@[^][\000-\037\177-\377 ()<>@,;:\\\"]+\\)" t)
-	       (progn (or (eobp)
-			  (rfc822-looking-at ?,))))
-	  (progn
-	    ;; rfc822-looking-at may have inserted a space
-	    (or (bobp) (/= (preceding-char) ?\ ) (delete-char -1))
-	    ;; relying on the fact that rfc822-looking-at <char>
-	    ;;  doesn't mung match-data
-	    (throw 'address (buffer-substring address-start (match-end 0)))))
-      (goto-char address-start)
-      (while t
-	(cond ((and (= n 1) (rfc822-looking-at ?@))
-	       ;; local-part@domain
-	       (rfc822-snarf-domain)
-	       (throw 'address
-		 (buffer-substring address-start (point))))
-	      ((rfc822-looking-at ?:)
-	       (cond ((not allow-groups)
-		      (rfc822-bad-address "A group name may not appear here"))
-		     ((= n 0)
-		      (rfc822-bad-address "No name for :...; group")))
-	       ;; group
-	       (throw 'address
-		 ;; return a list of addresses
-		 (rfc822-snarf-frob-list ":...; group" ?\, ?\;
-					 'rfc822-addresses-1 t)))
-	      ((rfc822-looking-at ?<)
-	       (let ((start (point))
-		     (strip t))
-		 (cond ((rfc822-looking-at ?>)
-			;; empty path
-			())
-		       ((and (not (eobp)) (= (following-char) ?\@))
-			;; <@foo.bar,@baz:quux@abcd.efg>
-			(rfc822-snarf-frob-list "<...> address" ?\, ?\:
-			  (function (lambda ()
-				      (if (rfc822-looking-at ?\@)
-					  (rfc822-snarf-domain)
-					(rfc822-bad-address
-					  "Gubbish in route-addr")))))
-			(rfc822-snarf-words)
-			(or (rfc822-looking-at ?@)
-			    (rfc822-bad-address "Malformed <..@..> address"))
-			(rfc822-snarf-domain)
-			(setq strip nil))
-		       ((progn (rfc822-snarf-words) (rfc822-looking-at ?@))
-			; allow <foo> (losing unix seems to do this)
-			(rfc822-snarf-domain)))
-		 (let ((end (point)))
-		   (if (rfc822-looking-at ?\>)
-		       (throw 'address
-			 (buffer-substring (if strip start (1- start))
-					   (if strip end (1+ end))))
-		     (rfc822-bad-address "Unterminated <...> address")))))
-	      ((looking-at "[^][\000-\037\177-\377 ()<>@,;:\\.]")
-	       ;; this allows "." to be part of the words preceding
-	       ;; an addr-spec, since many broken mailers output
-	       ;; "Hern K. Herklemeyer III
-	       ;;   <yank@megadeath.dod.gods-own-country>"
-               (let ((again t))
-                 (while again
-                   (or (= n 0) (bobp) (= (preceding-char) ?\ )
-                       (insert ?\ ))
-                   (rfc822-snarf-words)
-                   (setq n (1+ n))
-                   (setq again (or (rfc822-looking-at ?.)
-                                   (looking-at "[^][\000-\037\177-\377 ()<>@,;:\\.]"))))))
-	      ((= n 0)
-	       (throw 'address nil))
-	      ((= n 1) ; allow "foo" (losing unix seems to do this)
-	       (throw 'address
-		 (buffer-substring address-start (point))))
-              ((> n 1)
-               (rfc822-bad-address "Missing comma between addresses or badly-formatted address"))
-	      ((or (eobp) (= (following-char) ?,))
-	       (rfc822-bad-address "Missing comma or route-spec"))
-	      (t
-	       (rfc822-bad-address "Strange character or missing comma")))))))
-
-			   
-(defun rfc822-addresses (header-text)
-  (if (string-match "\\`[ \t]*\\([^][\000-\037\177-\377 ()<>@,;:\\\".]+\\)[ \t]*\\'"
-                    header-text)
-      ;; Make very simple case moderately fast.
-      (list (substring header-text (match-beginning 1) (match-end 1)))
-    (let ((buf (generate-new-buffer " rfc822")))
-      (unwind-protect
-	(save-excursion
-	  (set-buffer buf)
-	  (make-local-variable 'case-fold-search)
-	  (setq case-fold-search nil)	;For speed(?)
-	  (insert header-text)
-	  ;; unfold continuation lines
-	  (goto-char (point-min))
-
-	  (while (re-search-forward "\\([^\\]\\(\\\\\\\\\\)*\\)\n[ \t]" nil t)
-	    (replace-match "\\1 " t))
-
-	  (goto-char (point-min))
-	  (rfc822-nuke-whitespace)
-	  (let ((list ())
-		tem
-		address-start); this is for rfc822-bad-address
-	    (while (not (eobp))
-	      (setq address-start (point))
-	      (setq tem
-		    (catch 'address ; this is for rfc822-bad-address
-		      (cond ((rfc822-looking-at ?\,)
-			     nil)
-			    ((looking-at "[][\000-\037\177-\377@;:\\.>)]")
-			     (forward-char)
-			     (rfc822-bad-address
-			       (format "Strange character \\%c found"
-				       (preceding-char))))
-			    (t
-			     (rfc822-addresses-1 t)))))
-	      (cond ((null tem))
-		    ((stringp tem)
-		     (setq list (cons tem list)))
-		    (t
-		     (setq list (nconc (nreverse tem) list)))))
-	    (nreverse list)))
-      (and buf (kill-buffer buf))))))
-
-(provide 'rfc822)
-
-;;; rfc822.el ends here
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
deleted file mode 100644
index 30493fea700..00000000000
--- a/lisp/mail/rmail.el
+++ /dev/null
@@ -1,2715 +0,0 @@
-;;; rmail.el --- main code of "RMAIL" mail reader for Emacs.
-
-;; Copyright (C) 1985,86,87,88,93,94,95,96 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; 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.
-
-;;; Code:
-
-;; Souped up by shane@mit-ajax based on ideas of rlk@athena.mit.edu
-;;   New features include attribute and keyword support, message
-;;   selection by dispatch table, summary by attributes and keywords,
-;;   expunging by dispatch table, sticky options for file commands.
-
-;; Extended by Bob Weiner of Motorola
-;;   New features include: rmail and rmail-summary buffers remain
-;;   synchronized and key bindings basically operate the same way in both
-;;   buffers, summary by topic or by regular expression, rmail-reply-prefix
-;;   variable, and a bury rmail buffer (wipe) command.
-;;
-
-(require 'mail-utils)
-
-;; For Emacs V18 compatibility
-(and (not (fboundp 'buffer-disable-undo))
-     (fboundp 'buffer-flush-undo)
-     (defalias 'buffer-disable-undo 'buffer-flush-undo))
-
-; These variables now declared in paths.el.
-;(defvar rmail-spool-directory "/usr/spool/mail/"
-;  "This is the name of the directory used by the system mailer for\n\
-;delivering new mail.  Its name should end with a slash.")
-;(defvar rmail-file-name
-;  (expand-file-name "~/RMAIL")
-;  "")
-
-(defvar rmail-movemail-program nil
-  "If non-nil, name of program for fetching new mail.")
-
-(defvar rmail-pop-password nil
-  "*Password to use when reading mail from a POP server, if required.")
-
-(defvar rmail-pop-password-required nil
-  "*Non-nil if a password is required when reading mail using POP.")
-
-;;;###autoload
-(defvar rmail-dont-reply-to-names nil "\
-*A regexp specifying names to prune of reply to messages.
-A value of nil means exclude your own name only.")
-
-;;;###autoload
-(defvar rmail-default-dont-reply-to-names "info-" "\
-A regular expression specifying part of the value of the default value of
-the variable `rmail-dont-reply-to-names', for when the user does not set
-`rmail-dont-reply-to-names' explicitly.  (The other part of the default
-value is the user's name.)
-It is useful to set this variable in the site customization file.")
-
-;;;###autoload
-(defvar rmail-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:\\|^\\(resent-\\|\\)message-id:\\|^summary-line:\\|^resent-date:\\|^nntp-posting-host:\\|^path:\\|^x-char.*:\\|^x-face:\\|^x-mailer:"
-  "*Regexp to match header fields that Rmail should normally hide.")
-
-;;;###autoload
-(defvar rmail-displayed-headers nil
-  "*Regexp to match Header fields that Rmail should display.
-If nil, display all header fields except those matched by
-`rmail-ignored-headers'.")
-
-;;;###autoload
-(defvar rmail-retry-ignored-headers nil "\
-*Headers that should be stripped when retrying a failed message.")
-
-;;;###autoload
-(defvar rmail-highlighted-headers "^From:\\|^Subject:" "\
-*Regexp to match Header fields that Rmail should normally highlight.
-A value of nil means don't highlight.
-See also `rmail-highlight-face'.")
-
-;;;###autoload
-(defvar rmail-highlight-face nil "\
-*Face used by Rmail for highlighting headers.")
-
-;;;###autoload
-(defvar rmail-delete-after-output nil "\
-*Non-nil means automatically delete a message that is copied to a file.")
-
-;;;###autoload
-(defvar rmail-primary-inbox-list nil "\
-*List of files which are inboxes for user's primary mail file `~/RMAIL'.
-`nil' means the default, which is (\"/usr/spool/mail/$USER\")
-\(the name varies depending on the operating system,
-and the value of the environment variable MAIL overrides it).")
-
-;;;###autoload
-(defvar rmail-mail-new-frame nil
-  "*Non-nil means Rmail makes a new frame for composing outgoing mail.")
-
-;;;###autoload
-(defvar rmail-secondary-file-directory "~/"
-  "*Directory for additional secondary Rmail files.")
-;;;###autoload
-(defvar rmail-secondary-file-regexp "\\.xmail$"
-  "*Regexp for which files are secondary Rmail files.")
-
-;;;###autoload
-(defvar rmail-mode-hook nil
-  "List of functions to call when Rmail is invoked.")
-
-;;;###autoload
-(defvar rmail-get-new-mail-hook nil
-  "List of functions to call when Rmail has retrieved new mail.")
-
-;;;###autoload
-(defvar rmail-show-message-hook nil
-  "List of functions to call when Rmail displays a message.")
-
-;;;###autoload
-(defvar rmail-delete-message-hook nil
-  "List of functions to call when Rmail deletes a message.
-When the hooks are called, the message has been marked deleted but is
-still the current message in the Rmail buffer.")
-
-;; These may be altered by site-init.el to match the format of mmdf files
-;;  delimiting used on a given host (delim1 and delim2 from the config
-;;  files).
-
-(defvar mmdf-delim1 "^\001\001\001\001\n"
-  "Regexp marking the start of an mmdf message")
-(defvar mmdf-delim2 "^\001\001\001\001\n"
-  "Regexp marking the end of an mmdf message")
-
-(defvar rmail-message-filter nil
-  "If non-nil, a filter function for new messages in RMAIL.
-Called with region narrowed to the message, including headers,
-before obeying `rmail-ignored-headers'.")
-
-(defvar rmail-reply-prefix "Re: "
-  "String to prepend to Subject line when replying to a message.")
-
-;; Some mailers use "Re(2):" or "Re^2:" or "Re: Re:" or "Re[2]".
-;; This pattern should catch all the common variants.
-(defvar rmail-reply-regexp "\\`\\(Re\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?: *\\)*"
-  "Regexp to delete from Subject line before inserting `rmail-reply-prefix'.")
-
-(defvar rmail-display-summary nil
-  "If non-nil, Rmail always displays the summary buffer.")
-
-(defvar rmail-mode-map nil)
-
-(defvar rmail-inbox-list nil)
-(defvar rmail-keywords nil)
-
-;; Message counters and markers.  Deleted flags.
-
-(defvar rmail-current-message nil)
-(defvar rmail-total-messages nil)
-(defvar rmail-message-vector nil)
-(defvar rmail-deleted-vector nil)
-
-(defvar rmail-overlay-list nil)
-
-(defvar rmail-font-lock-keywords
-  (eval-when-compile
-    (let* ((cite-chars "[>|}]")
-	   (cite-prefix "A-Za-z")
-	   (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
-      (list '("^\\(From\\|Sender\\):" . font-lock-function-name-face)
-	    '("^Reply-To:.*$" . font-lock-function-name-face)
-	    '("^Subject:" . font-lock-comment-face)
-	    '("^\\(To\\|Apparently-To\\|Cc\\):" . font-lock-keyword-face)
-	    ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
-	    `(,cite-chars
-	      (,(concat "\\=[ \t]*"
-			"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
-			cite-chars ".*")
-	       (beginning-of-line) (end-of-line)
-	       (0 font-lock-reference-face)))       
-	    '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\|Date\\):.*$"
-	      . font-lock-string-face))))
-  "Additional expressions to highlight in Rmail mode.")
-
-;; These are used by autoloaded rmail-summary.
-
-(defvar rmail-summary-buffer nil)
-(defvar rmail-summary-vector nil)
-
-;; `Sticky' default variables.
-
-;; Last individual label specified to a or k.
-(defvar rmail-last-label nil)
-;; Last set of values specified to C-M-n, C-M-p, C-M-s or C-M-l.
-(defvar rmail-last-multi-labels nil)
-(defvar rmail-last-regexp nil)
-(defvar rmail-default-file "~/xmail"
-  "*Default file name for \\[rmail-output].")
-(defvar rmail-default-rmail-file "~/XMAIL"
-  "*Default file name for \\[rmail-output-to-rmail-file].")
-
-;;; Regexp matching the delimiter of messages in UNIX mail format
-;;; (UNIX From lines), minus the initial ^.  Note that if you change
-;;; this expression, you must change the code in rmail-nuke-pinhead-header
-;;; that knows the exact ordering of the \\( \\) subexpressions.
-(defvar rmail-unix-mail-delimiter
-  (let ((time-zone-regexp
-	 (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
-		 "\\|[-+]?[0-9][0-9][0-9][0-9]"
-		 "\\|"
-		 "\\) *")))
-    (concat
-     "From "
-
-     ;; Many things can happen to an RFC 822 mailbox before it is put into
-     ;; a `From' line.  The leading phrase can be stripped, e.g.
-     ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'.  The <> can be stripped, e.g.
-     ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'.  Everything starting with a CRLF
-     ;; can be removed, e.g.
-     ;;		From: joe@y.z (Joe	K
-     ;;			User)
-     ;; can yield `From joe@y.z (Joe 	K Fri Mar 22 08:11:15 1996', and
-     ;;		From: Joe User
-     ;;			<joe@y.z>
-     ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
-     ;; The mailbox can be removed or be replaced by white space, e.g.
-     ;;		From: "Joe User"{space}{tab}
-     ;;			<joe@y.z>
-     ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996',
-     ;; where {space} and {tab} represent the Ascii space and tab characters.
-     ;; We want to match the results of any of these manglings.
-     ;; The following regexp rejects names whose first characters are
-     ;; obviously bogus, but after that anything goes.
-     "\\([^\0-\b\n-\r\^?].*\\)? "
-
-     ;; The time the message was sent.
-     "\\([^\0-\r \^?]+\\) +"				; day of the week
-     "\\([^\0-\r \^?]+\\) +"				; month
-     "\\([0-3]?[0-9]\\) +"				; day of month
-     "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *"	; time of day
-
-     ;; Perhaps a time zone, specified by an abbreviation, or by a
-     ;; numeric offset.
-     time-zone-regexp
-
-     ;; The year.
-     " \\([0-9][0-9]+\\) *"
-
-     ;; On some systems the time zone can appear after the year, too.
-     time-zone-regexp
-
-     ;; Old uucp cruft.
-     "\\(remote from .*\\)?"
-
-     "\n"))
-  nil)
-
-;; Perform BODY in the summary buffer
-;; in such a way that its cursor is properly updated in its own window.
-(defmacro rmail-select-summary (&rest body)
-  (` (let ((total rmail-total-messages))
-       (if (rmail-summary-displayed)
-	   (let ((window (selected-window)))
-	     (save-excursion
-	       (unwind-protect
-		   (progn
-		     (pop-to-buffer rmail-summary-buffer)
-		     ;; rmail-total-messages is a buffer-local var
-		     ;; in the rmail buffer.
-		     ;; This way we make it available for the body
-		     ;; even tho the rmail buffer is not current.
-		     (let ((rmail-total-messages total))
-		       (,@ body)))
-		 (select-window window))))
-	 (save-excursion
-	   (set-buffer rmail-summary-buffer)
-	   (let ((rmail-total-messages total))
-	     (,@ body))))
-       (rmail-maybe-display-summary))))
-
-;;;; *** Rmail Mode ***
-
-;;;###autoload
-(defun rmail (&optional file-name-arg)
-  "Read and edit incoming mail.
-Moves messages into file named by `rmail-file-name' (a babyl format file)
- and edits that file in RMAIL Mode.
-Type \\[describe-mode] once editing that file, for a list of RMAIL commands.
-
-May be called with file name as argument; then performs rmail editing on
-that file, but does not copy any new mail into the file.
-Interactively, if you supply a prefix argument, then you
-have a chance to specify a file name with the minibuffer.
-
-If `rmail-display-summary' is non-nil, make a summary for this RMAIL file."
-  (interactive (if current-prefix-arg
-		   (list (read-file-name "Run rmail on RMAIL file: "))))
-  (let* ((file-name (expand-file-name (or file-name-arg rmail-file-name)))
-	 (existed (get-file-buffer file-name))
-	 run-mail-hook)
-    ;; Like find-file, but in the case where a buffer existed
-    ;; and the file was reverted, recompute the message-data.
-    (if (and existed (not (verify-visited-file-modtime existed)))
-	(progn
-	  ;; Don't be confused by apparent local-variables spec
-	  ;; in the last message in the RMAIL file.
-	  (let ((enable-local-variables nil))
-	    (find-file file-name))
-	  (if (and (verify-visited-file-modtime existed)
-		   (eq major-mode 'rmail-mode))
-	      (progn (rmail-forget-messages)
-		     (rmail-set-message-counters))))
-      (let ((enable-local-variables nil))
-	(find-file file-name)))
-    (if (eq major-mode 'rmail-edit-mode)
-	(error "Exit Rmail Edit mode before getting new mail."))
-    (if (and existed (> (buffer-size) 0))
-	;; Buffer not new and not empty; ensure in proper mode, but that's all.
-	(or (eq major-mode 'rmail-mode)
-	    (progn (rmail-mode-2)
-		   (setq run-mail-hook t)))
-      (setq run-mail-hook t)
-      (rmail-mode-2)
-      ;; Convert all or part to Babyl file if possible.
-      (rmail-convert-file)
-      (goto-char (point-max))
-      (if (null rmail-inbox-list)
-	  (progn
-	    (rmail-set-message-counters)
-	    (rmail-show-message))))
-    (or (and (null file-name-arg)
-	     (rmail-get-new-mail))
-	(rmail-show-message (rmail-first-unseen-message)))
-    (if rmail-display-summary (rmail-summary))
-    (rmail-construct-io-menu)
-    (if run-mail-hook
-	(run-hooks 'rmail-mode-hook))))
-
-;; Given the value of MAILPATH, return a list of inbox file names.
-;; This is turned off because it is not clear that the user wants
-;; all these inboxes to feed into the primary rmail file.
-; (defun rmail-convert-mailpath (string)
-;   (let (idx list)
-;     (while (setq idx (string-match "[%:]" string))
-;       (let ((this (substring string 0 idx)))
-; 	(setq string (substring string (1+ idx)))
-; 	(setq list (cons (if (string-match "%" this)
-; 			     (substring this 0 (string-match "%" this))
-; 			   this)
-; 			 list))))
-;     list))
-
-; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
-; will not cause emacs 18.55 problems.
-
-(defun rmail-convert-file ()
-  (let (convert)
-    (widen)
-    (goto-char (point-min))
-    ;; If file doesn't start like a Babyl file,
-    ;; convert it to one, by adding a header and converting each message.
-    (cond ((looking-at "BABYL OPTIONS:"))
-	  ((looking-at "Version: 5\n")
-	   ;; Losing babyl file made by old version of Rmail.
-	   ;; Just fix the babyl file header; don't make a new one,
-	   ;; so we don't lose the Labels: file attribute, etc.
-	   (let ((buffer-read-only nil))
-	     (insert "BABYL OPTIONS: -*- rmail -*-\n")))
-	  ((equal (point-min) (point-max))
-	   ;; Empty RMAIL file.  Just insert the header.
-	   (rmail-insert-rmail-file-header))
-	  (t
-	   ;; Non-empty file in non-RMAIL format.  Add header and convert.
-	   (setq convert t)
-	   (rmail-insert-rmail-file-header)))
-    ;; If file was not a Babyl file or if there are
-    ;; Unix format messages added at the end,
-    ;; convert file as necessary.
-    (if (or convert
-	    (save-excursion
-	      (goto-char (point-max))
-	      (search-backward "\n\^_")
-	      (forward-char 2)
-	      (looking-at "\n*From ")))
-	(let ((buffer-read-only nil))
-	  (message "Converting to Babyl format...")
-	  ;; If file needs conversion, convert it all,
-	  ;; except for the BABYL header.
-	  ;; (rmail-convert-to-babyl-format would delete the header.)
-	  (goto-char (point-min))
-	  (search-forward "\n\^_" nil t)
-	  (narrow-to-region (point) (point-max))
-	  (rmail-convert-to-babyl-format)
-	  (message "Converting to Babyl format...done")))))
-
-;;; I have checked that adding "-*- rmail -*-" to the BABYL OPTIONS line
-;;; will not cause emacs 18.55 problems.
-
-(defun rmail-insert-rmail-file-header ()
-  (let ((buffer-read-only nil))
-    (insert "BABYL OPTIONS: -*- rmail -*-
-Version: 5
-Labels:
-Note:   This is the header of an rmail file.
-Note:   If you are seeing it in rmail,
-Note:    it means the file has no messages in it.\n\^_")))
-
-(if rmail-mode-map
-    nil
-  (setq rmail-mode-map (make-keymap))
-  (suppress-keymap rmail-mode-map)
-  (define-key rmail-mode-map "a"      'rmail-add-label)
-  (define-key rmail-mode-map "b"      'rmail-bury)
-  (define-key rmail-mode-map "c"      'rmail-continue)
-  (define-key rmail-mode-map "d"      'rmail-delete-forward)
-  (define-key rmail-mode-map "\C-d"   'rmail-delete-backward)
-  (define-key rmail-mode-map "e"      'rmail-edit-current-message)
-  (define-key rmail-mode-map "f"      'rmail-forward)
-  (define-key rmail-mode-map "g"      'rmail-get-new-mail)
-  (define-key rmail-mode-map "h"      'rmail-summary)
-  (define-key rmail-mode-map "i"      'rmail-input)
-  (define-key rmail-mode-map "j"      'rmail-show-message)
-  (define-key rmail-mode-map "k"      'rmail-kill-label)
-  (define-key rmail-mode-map "l"      'rmail-summary-by-labels)
-  (define-key rmail-mode-map "\e\C-h" 'rmail-summary)
-  (define-key rmail-mode-map "\e\C-l" 'rmail-summary-by-labels)
-  (define-key rmail-mode-map "\e\C-r" 'rmail-summary-by-recipients)
-  (define-key rmail-mode-map "\e\C-s" 'rmail-summary-by-regexp)
-  (define-key rmail-mode-map "\e\C-t" 'rmail-summary-by-topic)
-  (define-key rmail-mode-map "m"      'rmail-mail)
-  (define-key rmail-mode-map "\em"    'rmail-retry-failure)
-  (define-key rmail-mode-map "n"      'rmail-next-undeleted-message)
-  (define-key rmail-mode-map "\en"    'rmail-next-message)
-  (define-key rmail-mode-map "\e\C-n" 'rmail-next-labeled-message)
-  (define-key rmail-mode-map "o"      'rmail-output-to-rmail-file)
-  (define-key rmail-mode-map "\C-o"   'rmail-output)
-  (define-key rmail-mode-map "p"      'rmail-previous-undeleted-message)
-  (define-key rmail-mode-map "\ep"    'rmail-previous-message)
-  (define-key rmail-mode-map "\e\C-p" 'rmail-previous-labeled-message)
-  (define-key rmail-mode-map "q"      'rmail-quit)
-  (define-key rmail-mode-map "r"      'rmail-reply)
-;; I find I can't live without the default M-r command -- rms.
-;;  (define-key rmail-mode-map "\er"  'rmail-search-backwards)
-  (define-key rmail-mode-map "s"      'rmail-expunge-and-save)
-  (define-key rmail-mode-map "\es"    'rmail-search)
-  (define-key rmail-mode-map "t"      'rmail-toggle-header)
-  (define-key rmail-mode-map "u"      'rmail-undelete-previous-message)
-  (define-key rmail-mode-map "w"      'rmail-edit-current-message)
-  (define-key rmail-mode-map "x"      'rmail-expunge)
-  (define-key rmail-mode-map "."      'rmail-beginning-of-message)
-  (define-key rmail-mode-map "<"      'rmail-first-message)
-  (define-key rmail-mode-map ">"      'rmail-last-message)
-  (define-key rmail-mode-map " "      'scroll-up)
-  (define-key rmail-mode-map "\177"   'scroll-down)
-  (define-key rmail-mode-map "?"      'describe-mode)
-  (define-key rmail-mode-map "\C-c\C-s\C-d" 'rmail-sort-by-date)
-  (define-key rmail-mode-map "\C-c\C-s\C-s" 'rmail-sort-by-subject)
-  (define-key rmail-mode-map "\C-c\C-s\C-a" 'rmail-sort-by-author)
-  (define-key rmail-mode-map "\C-c\C-s\C-r" 'rmail-sort-by-recipient)
-  (define-key rmail-mode-map "\C-c\C-s\C-c" 'rmail-sort-by-correspondent)
-  (define-key rmail-mode-map "\C-c\C-s\C-l" 'rmail-sort-by-lines)
-  (define-key rmail-mode-map "\C-c\C-s\C-k" 'rmail-sort-by-keywords)
-  (define-key rmail-mode-map "\C-c\C-n" 'rmail-next-same-subject)
-  (define-key rmail-mode-map "\C-c\C-p" 'rmail-previous-same-subject)
-  )
-
-(define-key rmail-mode-map [menu-bar] (make-sparse-keymap))
-
-(define-key rmail-mode-map [menu-bar classify]
-  (cons "Classify" (make-sparse-keymap "Classify")))
-
-(define-key rmail-mode-map [menu-bar classify input-menu]
-  nil)
-
-(define-key rmail-mode-map [menu-bar classify output-menu]
-  nil)
-
-(define-key rmail-mode-map [menu-bar classify output-inbox]
-  '("Output (inbox)..." . rmail-output))
-
-(define-key rmail-mode-map [menu-bar classify output]
-  '("Output (Rmail)..." . rmail-output-to-rmail-file))
-
-(define-key rmail-mode-map [menu-bar classify kill-label]
-  '("Kill Label..." . rmail-kill-label))
-
-(define-key rmail-mode-map [menu-bar classify add-label]
-  '("Add Label..." . rmail-add-label))
-
-(define-key rmail-mode-map [menu-bar summary]
-  (cons "Summary" (make-sparse-keymap "Summary")))
-
-(define-key rmail-mode-map [menu-bar summary senders]
-  '("By Senders..." . rmail-summary-by-senders))
-
-(define-key rmail-mode-map [menu-bar summary labels]
-  '("By Labels..." . rmail-summary-by-labels))
-
-(define-key rmail-mode-map [menu-bar summary recipients]
-  '("By Recipients..." . rmail-summary-by-recipients))
-
-(define-key rmail-mode-map [menu-bar summary topic]
-  '("By Topic..." . rmail-summary-by-topic))
-
-(define-key rmail-mode-map [menu-bar summary regexp]
-  '("By Regexp..." . rmail-summary-by-regexp))
-
-(define-key rmail-mode-map [menu-bar summary all]
-  '("All" . rmail-summary))
-
-(define-key rmail-mode-map [menu-bar mail]
-  (cons "Mail" (make-sparse-keymap "Mail")))
-
-(define-key rmail-mode-map [menu-bar mail rmail-get-new-mail]
-  '("Get New Mail" . rmail-get-new-mail))
-
-(define-key rmail-mode-map [menu-bar mail lambda]
-  '("----"))
-
-(define-key rmail-mode-map [menu-bar mail continue]
-  '("Continue" . rmail-continue))
-
-(define-key rmail-mode-map [menu-bar mail resend]
-  '("Re-send..." . rmail-resend))
-
-(define-key rmail-mode-map [menu-bar mail forward]
-  '("Forward" . rmail-forward))
-
-(define-key rmail-mode-map [menu-bar mail retry]
-  '("Retry" . rmail-retry-failure))
-
-(define-key rmail-mode-map [menu-bar mail reply]
-  '("Reply" . rmail-reply))
-
-(define-key rmail-mode-map [menu-bar mail mail]
-  '("Mail" . rmail-mail))
-
-(define-key rmail-mode-map [menu-bar delete]
-  (cons "Delete" (make-sparse-keymap "Delete")))
-
-(define-key rmail-mode-map [menu-bar delete expunge/save]
-  '("Expunge/Save" . rmail-expunge-and-save))
-
-(define-key rmail-mode-map [menu-bar delete expunge]
-  '("Expunge" . rmail-expunge))
-
-(define-key rmail-mode-map [menu-bar delete undelete]
-  '("Undelete" . rmail-undelete-previous-message))
-
-(define-key rmail-mode-map [menu-bar delete delete]
-  '("Delete" . rmail-delete-forward))
-
-(define-key rmail-mode-map [menu-bar move]
-  (cons "Move" (make-sparse-keymap "Move")))
-
-(define-key rmail-mode-map [menu-bar move search-back]
-  '("Search Back..." . rmail-search-backwards))
-
-(define-key rmail-mode-map [menu-bar move search]
-  '("Search..." . rmail-search))
-
-(define-key rmail-mode-map [menu-bar move previous]
-  '("Previous Nondeleted" . rmail-previous-undeleted-message))
-
-(define-key rmail-mode-map [menu-bar move next]
-  '("Next Nondeleted" . rmail-next-undeleted-message))
-
-(define-key rmail-mode-map [menu-bar move last]
-  '("Last" . rmail-last-message))
-
-(define-key rmail-mode-map [menu-bar move first]
-  '("First" . rmail-first-message))
-
-(define-key rmail-mode-map [menu-bar move previous]
-  '("Previous" . rmail-previous-message))
-
-(define-key rmail-mode-map [menu-bar move next]
-  '("Next" . rmail-next-message))
-
-;; Rmail mode is suitable only for specially formatted data.
-(put 'rmail-mode 'mode-class 'special)
-
-(defun rmail-mode-kill-summary ()
-  (if rmail-summary-buffer (kill-buffer rmail-summary-buffer)))
-
-;;;###autoload
-(defun rmail-mode ()
-  "Rmail Mode is used by \\<rmail-mode-map>\\[rmail] for editing Rmail files.
-All normal editing commands are turned off.
-Instead, these commands are available:
-
-\\[rmail-beginning-of-message]	Move point to front of this message (same as \\[beginning-of-buffer]).
-\\[scroll-up]	Scroll to next screen of this message.
-\\[scroll-down]	Scroll to previous screen of this message.
-\\[rmail-next-undeleted-message]	Move to Next non-deleted message.
-\\[rmail-previous-undeleted-message]	Move to Previous non-deleted message.
-\\[rmail-next-message]	Move to Next message whether deleted or not.
-\\[rmail-previous-message]	Move to Previous message whether deleted or not.
-\\[rmail-first-message]	Move to the first message in Rmail file.
-\\[rmail-last-message]	Move to the last message in Rmail file.
-\\[rmail-show-message]	Jump to message specified by numeric position in file.
-\\[rmail-search]	Search for string and show message it is found in.
-\\[rmail-delete-forward]	Delete this message, move to next nondeleted.
-\\[rmail-delete-backward]	Delete this message, move to previous nondeleted.
-\\[rmail-undelete-previous-message]	Undelete message.  Tries current message, then earlier messages
-	till a deleted message is found.
-\\[rmail-edit-current-message]	Edit the current message.  \\[rmail-cease-edit] to return to Rmail.
-\\[rmail-expunge]	Expunge deleted messages.
-\\[rmail-expunge-and-save]	Expunge and save the file.
-\\[rmail-quit]       Quit Rmail: expunge, save, then switch to another buffer.
-\\[save-buffer] Save without expunging.
-\\[rmail-get-new-mail]	Move new mail from system spool directory into this file.
-\\[rmail-mail]	Mail a message (same as \\[mail-other-window]).
-\\[rmail-continue]	Continue composing outgoing message started before.
-\\[rmail-reply]	Reply to this message.  Like \\[rmail-mail] but initializes some fields.
-\\[rmail-retry-failure]	Send this message again.  Used on a mailer failure message.
-\\[rmail-forward]	Forward this message to another user.
-\\[rmail-output-to-rmail-file]       Output this message to an Rmail file (append it).
-\\[rmail-output]	Output this message to a Unix-format mail file (append it).
-\\[rmail-input]	Input Rmail file.  Run Rmail on that file.
-\\[rmail-add-label]	Add label to message.  It will be displayed in the mode line.
-\\[rmail-kill-label]	Kill label.  Remove a label from current message.
-\\[rmail-next-labeled-message]   Move to Next message with specified label
-          (label defaults to last one specified).
-          Standard labels: filed, unseen, answered, forwarded, deleted.
-          Any other label is present only if you add it with \\[rmail-add-label].
-\\[rmail-previous-labeled-message]   Move to Previous message with specified label
-\\[rmail-summary]	Show headers buffer, with a one line summary of each message.
-\\[rmail-summary-by-labels]	Summarize only messages with particular label(s).
-\\[rmail-summary-by-recipients]   Summarize only messages with particular recipient(s).
-\\[rmail-summary-by-regexp]   Summarize only messages with particular regexp(s).
-\\[rmail-summary-by-topic]   Summarize only messages with subject line regexp(s).
-\\[rmail-toggle-header]	Toggle display of complete header."
-  (interactive)
-  (rmail-mode-2)
-  (rmail-set-message-counters)
-  (rmail-show-message rmail-total-messages)
-  (run-hooks 'rmail-mode-hook))
-
-(defun rmail-mode-2 ()
-  (kill-all-local-variables)
-  (rmail-mode-1)
-  (rmail-variables))
-
-(defun rmail-mode-1 ()
-  (setq major-mode 'rmail-mode)
-  (setq mode-name "RMAIL")
-  (setq buffer-read-only t)
-  ;; No need to auto save RMAIL files in normal circumstances
-  ;; because they contain no info except attribute changes
-  ;; and deletion of messages.
-  ;; The one exception is when messages are copied into an Rmail mode buffer.
-  ;; rmail-output-to-rmail-file enables auto save when you do that.
-  (setq buffer-auto-save-file-name nil)
-  (if (boundp 'mode-line-modified)
-      (setq mode-line-modified "--- ")
-    (setq mode-line-format
-	  (cons "--- " (cdr (default-value 'mode-line-format)))))
-  (use-local-map rmail-mode-map)
-  (set-syntax-table text-mode-syntax-table)
-  (setq local-abbrev-table text-mode-abbrev-table))
-
-(defun rmail-variables ()
-  (make-local-variable 'revert-buffer-function)
-  (setq revert-buffer-function 'rmail-revert)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults
-   '(rmail-font-lock-keywords t nil nil nil
-     (font-lock-maximum-size . nil)
-     (font-lock-fontify-buffer-function . rmail-fontify-buffer-function)
-     (font-lock-unfontify-buffer-function . rmail-unfontify-buffer-function)
-     (font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
-  (make-local-variable 'rmail-last-label)
-  (make-local-variable 'rmail-last-regexp)
-  (make-local-variable 'rmail-deleted-vector)
-  (make-local-variable 'rmail-summary-buffer)
-  (make-local-variable 'rmail-summary-vector)
-  (make-local-variable 'rmail-current-message)
-  (make-local-variable 'rmail-total-messages)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline nil)
-  (make-local-variable 'rmail-overlay-list)
-  (setq rmail-overlay-list nil)
-  (make-local-variable 'version-control)
-  (setq version-control 'never)
-  (make-local-variable 'kill-buffer-hook)
-  (add-hook 'kill-buffer-hook 'rmail-mode-kill-summary)
-  (make-local-variable 'file-precious-flag)
-  (setq file-precious-flag t)
-  (make-local-variable 'rmail-message-vector)
-  (make-local-variable 'rmail-inbox-list)
-  (setq rmail-inbox-list (rmail-parse-file-inboxes))
-  ;; Provide default set of inboxes for primary mail file ~/RMAIL.
-  (and (null rmail-inbox-list)
-       (or (equal buffer-file-name (expand-file-name rmail-file-name))
-	   (equal buffer-file-truename
-		  (abbreviate-file-name (file-truename rmail-file-name))))
-       (setq rmail-inbox-list
-	     (or rmail-primary-inbox-list
-		 (list (or (getenv "MAIL")
-			   (concat rmail-spool-directory
-				   (user-login-name)))))))
-  (make-local-variable 'rmail-keywords)
-  ;; this gets generated as needed
-  (setq rmail-keywords nil))
-
-;; Handle M-x revert-buffer done in an rmail-mode buffer.
-(defun rmail-revert (arg noconfirm)
-  (let ((revert-buffer-function (default-value 'revert-buffer-function)))
-    ;; Call our caller again, but this time it does the default thing.
-    (if (revert-buffer arg noconfirm)
-	;; If the user said "yes", and we changed something,
-	;; reparse the messages.
-	(progn
-	  (rmail-convert-file)
-	  (goto-char (point-max))
-	  (rmail-mode)))))
-
-;; Return a list of files from this buffer's Mail: option.
-;; Does not assume that messages have been parsed.
-;; Just returns nil if buffer does not look like Babyl format.
-(defun rmail-parse-file-inboxes ()
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char 1)
-      (cond ((looking-at "BABYL OPTIONS:")
-	     (search-forward "\n\^_" nil 'move)
-	     (narrow-to-region 1 (point))
-	     (goto-char 1)
-	     (if (search-forward "\nMail:" nil t)
-		 (progn
-		   (narrow-to-region (point) (progn (end-of-line) (point)))
-		   (goto-char (point-min))
-		   (mail-parse-comma-list))))))))
-
-(defun rmail-expunge-and-save ()
-  "Expunge and save RMAIL file."
-  (interactive)
-  (rmail-expunge)
-  (save-buffer)
-  (if (rmail-summary-exists)
-      (rmail-select-summary (set-buffer-modified-p nil))))
-
-(defun rmail-quit ()
-  "Quit out of RMAIL."
-  (interactive)
-  (rmail-expunge-and-save)
-  ;; Don't switch to the summary buffer even if it was recently visible.
-  (if rmail-summary-buffer
-      (progn
-	(replace-buffer-in-windows rmail-summary-buffer)
-	(bury-buffer rmail-summary-buffer)))
-  (let ((obuf (current-buffer)))
-    (replace-buffer-in-windows obuf)
-    (bury-buffer obuf)))
-
-(defun rmail-bury ()
-  "Bury current Rmail buffer and its summary buffer."
-  (interactive)
-  ;; This let var was called rmail-buffer, but that interfered
-  ;; with the buffer-local var used in summary buffers.
-  (let ((buffer-to-bury (current-buffer)))
-    (if (rmail-summary-exists)
-	(let (window)
-	  (while (setq window (get-buffer-window rmail-summary-buffer))
-	    (set-window-buffer window (other-buffer rmail-summary-buffer)))
-	  (bury-buffer rmail-summary-buffer)))
-    (switch-to-buffer (other-buffer (current-buffer)))
-    (bury-buffer buffer-to-bury)))
-
-(defun rmail-duplicate-message ()
-  "Create a duplicated copy of the current message.
-The duplicate copy goes into the Rmail file just after the
-original copy."
-  (interactive)
-  (widen)
-  (let ((buffer-read-only nil)
-	(number rmail-current-message)
-	(string (buffer-substring (rmail-msgbeg rmail-current-message)
-				  (rmail-msgend rmail-current-message))))
-    (goto-char (rmail-msgend rmail-current-message))
-    (insert string)
-    (rmail-forget-messages)
-    (rmail-show-message number)
-    (message "Message duplicated")))
-
-;;;###autoload
-(defun rmail-input (filename)
-  "Run Rmail on file FILENAME."
-  (interactive "FRun rmail on RMAIL file: ")
-  (rmail filename))
-
-
-;; This used to scan subdirectories recursively, but someone pointed out
-;; that if the user wants that, person can put all the files in one dir.
-;; And the recursive scan was slow.  So I took it out.
-;; rms, Sep 1996.
-(defun rmail-find-all-files (start)
-  "Return list of file in dir START that match `rmail-secondary-file-regexp'."
-  (if (file-accessible-directory-p start)
-      ;; Don't sort here.
-      (let* ((case-fold-search t)
-	     (files (directory-files start t rmail-secondary-file-regexp)))
-	;; Sort here instead of in directory-files
-	;; because this list is usually much shorter.
-	(sort files 'string<))))
-
-(defun rmail-list-to-menu (menu-name l action &optional full-name)
-  (let ((menu (make-sparse-keymap menu-name)))
-    (mapcar
-     (function (lambda (item)
-		 (let (command)
-		   (if (consp item)
-		       (progn
-			 (setq command
-			       (rmail-list-to-menu (car item) (cdr item) 
-						   action 
-						   (if full-name
-						       (concat full-name "/"
-							       (car item))
-						     (car item))))
-			 (setq name (car item)))
-		     (progn
-		       (setq name item)
-		       (setq command 
-			     (list 'lambda () '(interactive)
-				   (list action
-					 (expand-file-name 
-					  (if full-name
-					      (concat full-name "/" item)
-					    item)
-					  rmail-secondary-file-directory))))))
-		   (define-key menu (vector (intern name))
-		     (cons name command)))))
-     (reverse l))
-    menu))
- 
-;; This command is always "disabled" when it appears in a menu.
-(put 'rmail-disable-menu 'menu-enable ''nil)
-
-(defun rmail-construct-io-menu ()
-  (let ((files (rmail-find-all-files rmail-secondary-file-directory)))
-    (if files
-	(progn
-	  (define-key rmail-mode-map [menu-bar classify input-menu]
-	    (cons "Input Rmail File" 
-		  (rmail-list-to-menu "Input Rmail File" 
-				      files
-				      'rmail-input)))
-	  (define-key rmail-mode-map [menu-bar classify output-menu]
-	    (cons "Output Rmail File" 
-		  (rmail-list-to-menu "Output Rmail File" 
-				      files
-				      'rmail-output-to-rmail-file))))
-
-      (define-key rmail-mode-map [menu-bar classify input-menu]
-	'("Input Rmail File" . rmail-disable-menu))
-      (define-key rmail-mode-map [menu-bar classify output-menu]
-	'("Output Rmail File" . rmail-disable-menu)))))
-
-
-;;;; *** Rmail input ***
-
-;; RLK feature not added in this version:
-;; argument specifies inbox file or files in various ways.
-
-(defun rmail-get-new-mail (&optional file-name)
-  "Move any new mail from this RMAIL file's inbox files.
-The inbox files can be specified with the file's Mail: option.  The
-variable `rmail-primary-inbox-list' specifies the inboxes for your
-primary RMAIL file if it has no Mail: option.  By default, this is
-your /usr/spool/mail/$USER.
-
-You can also specify the file to get new mail from.  In this case, the
-file of new mail is not changed or deleted.  Noninteractively, you can
-pass the inbox file name as an argument.  Interactively, a prefix
-argument causes us to read a file name and use that file as the inbox.
-
-This function runs `rmail-get-new-mail-hook' before saving the updated file.
-It returns t if it got any new messages."
-  (interactive
-   (list (if current-prefix-arg
-	     (read-file-name "Get new mail from file: "))))
-  (run-hooks 'rmail-before-get-new-mail-hook)
-  ;; If the disk file has been changed from under us,
-  ;; revert to it before we get new mail.
-  (or (verify-visited-file-modtime (current-buffer))
-      (find-file (buffer-file-name)))
-  (rmail-maybe-set-message-counters)
-  (widen)
-  ;; Get rid of all undo records for this buffer.
-  (or (eq buffer-undo-list t)
-      (setq buffer-undo-list nil))
-  (let ((all-files (if file-name (list file-name)
-		     rmail-inbox-list)))
-    (unwind-protect
-	(while all-files
-	  (let ((opoint (point))
-		(new-messages 0)
-		(delete-files ())
-		;; If buffer has not changed yet, and has not been saved yet,
-		;; don't replace the old backup file now.
-		(make-backup-files (and make-backup-files (buffer-modified-p)))
-		(buffer-read-only nil)
-		;; Don't make undo records for what we do in getting mail.
-		(buffer-undo-list t)
-		success
-		;; Files to insert this time around.
-		files
-		;; Last names of those files.
-		file-last-names)
-	    ;; Pull files off all-files onto files
-	    ;; as long as there is no name conflict.
-	    ;; A conflict happens when two inbox file names
-	    ;; have the same last component.
-	    (while (and all-files
-			(not (member (file-name-nondirectory (car all-files))
-				     file-last-names)))
-	      (setq files (cons (car all-files) files)
-		    file-last-names
-		    (cons (file-name-nondirectory (car all-files)) files))
-	      (setq all-files (cdr all-files)))
-	    ;; Put them back in their original order.
-	    (setq files (nreverse files))
-
-	    (goto-char (point-max))
-	    (skip-chars-backward " \t\n")	    ; just in case of brain damage
-	    (delete-region (point) (point-max)) ; caused by require-final-newline
-	    (save-excursion
-	      (save-restriction
-		(narrow-to-region (point) (point))
-		;; Read in the contents of the inbox files,
-		;; renaming them as necessary,
-		;; and adding to the list of files to delete eventually.
-		(if file-name
-		    (rmail-insert-inbox-text files nil)
-		  (setq delete-files (rmail-insert-inbox-text files t)))
-		;; Scan the new text and convert each message to babyl format.
-		(goto-char (point-min))
-		(unwind-protect
-		    (save-excursion
-		      (setq new-messages (rmail-convert-to-babyl-format)
-			    success t))
-		  ;; If we could not convert the file's inboxes,
-		  ;; rename the files we tried to read
-		  ;; so we won't over and over again.
-		  (if (and (not file-name) (not success))
-		      (let ((delfiles delete-files)
-			    (count 0))
-			(while delfiles
-			  (while (file-exists-p (format "RMAILOSE.%d" count))
-			    (setq count (1+ count)))
-			  (rename-file (car delfiles)
-				       (format "RMAILOSE.%d" count))
-			  (setq delfiles (cdr delfiles))))))
-		(or (zerop new-messages)
-		    (let (success)
-		      (widen)
-		      (search-backward "\n\^_" nil t)
-		      (narrow-to-region (point) (point-max))
-		      (goto-char (1+ (point-min)))
-		      (rmail-count-new-messages)
-		      (run-hooks 'rmail-get-new-mail-hook)
-		      (save-buffer)))
-		;; Delete the old files, now that babyl file is saved.
-		(while delete-files
-		  (condition-case ()
-		      ;; First, try deleting.
-		      (condition-case ()
-			  (delete-file (car delete-files))
-			(file-error
-			 ;; If we can't delete it, truncate it.
-			 (write-region (point) (point) (car delete-files))))
-		    (file-error nil))
-		  (setq delete-files (cdr delete-files)))))
-	    (if (= new-messages 0)
-		(progn (goto-char opoint)
-		       (if (or file-name rmail-inbox-list)
-			   (message "(No new mail has arrived)"))
-		       nil)
-	      (if (rmail-summary-exists)
-		  (rmail-select-summary
-		    (rmail-update-summary)))
-	      (message "%d new message%s read"
-		       new-messages (if (= 1 new-messages) "" "s"))
-	      ;; Move to the first new message
-	      ;; unless we have other unseen messages before it.
-	      (rmail-show-message (rmail-first-unseen-message))
-	      (run-hooks 'rmail-after-get-new-mail-hook)
-	      t)))
-      ;; Don't leave the buffer screwed up if we get a disk-full error.
-      (rmail-show-message))))
-
-(defun rmail-insert-inbox-text (files renamep)
-  ;; Detect a locked file now, so that we avoid moving mail
-  ;; out of the real inbox file.  (That could scare people.)
-  (or (memq (file-locked-p buffer-file-name) '(nil t))
-      (error "RMAIL file %s is locked"
-	     (file-name-nondirectory buffer-file-name)))
-  (let (file tofile delete-files movemail popmail)
-    (while files
-      (setq file (file-truename
-		  (expand-file-name (substitute-in-file-name (car files))))
-	    tofile (expand-file-name
-		    ;; Generate name to move to from inbox name,
-		    ;; in case of multiple inboxes that need moving.
-		    (concat ".newmail-" (file-name-nondirectory file))
-		    ;; Use the directory of this rmail file
-		    ;; because it's a nuisance to use the homedir
-		    ;; if that is on a full disk and this rmail
-		    ;; file isn't.
-		    (file-name-directory
-		     (expand-file-name buffer-file-name))))
-      ;; Always use movemail to rename the file,
-      ;; since there can be mailboxes in various directories.
-      (setq movemail t)
-;;;      ;; If getting from mail spool directory,
-;;;      ;; use movemail to move rather than just renaming,
-;;;      ;; so as to interlock with the mailer.
-;;;      (setq movemail (string= file
-;;;			      (file-truename
-;;;			       (concat rmail-spool-directory
-;;;				       (file-name-nondirectory file)))))
-      (setq popmail (string-match "^po:" (file-name-nondirectory file)))
-      (if popmail (setq file (file-name-nondirectory file)
-			renamep t))
-      (if movemail
-	  (progn
-	    ;; On some systems, /usr/spool/mail/foo is a directory
-	    ;; and the actual inbox is /usr/spool/mail/foo/foo.
-	    (if (file-directory-p file)
-		(setq file (expand-file-name (user-login-name)
-					     file)))))
-      (cond (popmail
-	     (if (and rmail-pop-password-required (not rmail-pop-password))
-		 (setq rmail-pop-password
-		       (rmail-read-passwd
-			(format "Password for %s: "
-				(substring file (+ popmail 3))))))
-	     (if (eq system-type 'windows-nt)
-		 ;; cannot have "po:" in file name
-		 (setq tofile
-		       (expand-file-name
-			(concat ".newmail-pop-" (substring file (+ popmail 3)))
-			(file-name-directory
-			 (expand-file-name buffer-file-name)))))
-	     (message "Getting mail from post office ..."))
-	    ((and (file-exists-p tofile)
-		  (/= 0 (nth 7 (file-attributes tofile))))
-	     (message "Getting mail from %s..." tofile))
-	    ((and (file-exists-p file)
-		  (/= 0 (nth 7 (file-attributes file))))
-	     (message "Getting mail from %s..." file)))
-      ;; Set TOFILE if have not already done so, and
-      ;; rename or copy the file FILE to TOFILE if and as appropriate.
-      (cond ((not renamep)
-	     (setq tofile file))
-	    ((or (file-exists-p tofile) (and (not popmail)
-					     (not (file-exists-p file))))
-	     nil)
-	    ((and (not movemail) (not popmail))
-	     ;; Try copying.  If that fails (perhaps no space),
-	     ;; rename instead.
-	     (condition-case nil
-		 (copy-file file tofile nil)
-	       (error
-		;; Third arg is t so we can replace existing file TOFILE.
-		(rename-file file tofile t)))
-	     ;; Make the real inbox file empty.
-	     ;; Leaving it deleted could cause lossage
-	     ;; because mailers often won't create the file.
-	     (condition-case ()
-		 (write-region (point) (point) file)
-	       (file-error nil)))
-	    (t
-	     (let ((errors nil))
-	       (unwind-protect
-		   (save-excursion
-		     (setq errors (generate-new-buffer " *rmail loss*"))
-		     (buffer-disable-undo errors)
-		     (if rmail-pop-password
-			 (call-process
-			  (or rmail-movemail-program
-			      (expand-file-name "movemail" exec-directory))
-			  nil errors nil file tofile rmail-pop-password)
-		       (call-process
-			(or rmail-movemail-program
-			    (expand-file-name "movemail" exec-directory))
-			nil errors nil file tofile))
-		     (if (not (buffer-modified-p errors))
-			 ;; No output => movemail won
-			 nil
-		       (set-buffer errors)
-		       (subst-char-in-region (point-min) (point-max)
-					     ?\n ?\  )
-		       (goto-char (point-max))
-		       (skip-chars-backward " \t")
-		       (delete-region (point) (point-max))
-		       (goto-char (point-min))
-		       (if (looking-at "movemail: ")
-			   (delete-region (point-min) (match-end 0)))
-		       (beep t)
-		       (message "movemail: %s"
-				(buffer-substring (point-min)
-						  (point-max)))
-		       (sit-for 3)
-		       nil))
-		 (if errors (kill-buffer errors))))))
-      ;; At this point, TOFILE contains the name to read:
-      ;; Either the alternate name (if we renamed)
-      ;; or the actual inbox (if not renaming).
-      (if (file-exists-p tofile)
-	  (let (size)
-	    (goto-char (point-max))
-	    (setq size (nth 1 (insert-file-contents tofile)))
-	    (goto-char (point-max))
-	    (or (= (preceding-char) ?\n)
-		(zerop size)
-		(insert ?\n))
-	    (setq delete-files (cons tofile delete-files))))
-      (message "")
-      (setq files (cdr files)))
-    delete-files))
-
-(defun rmail-read-passwd (prompt &optional default)
-  "Read a password, echoing `.' for each character typed.
-End with RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.
-Optional DEFAULT is password to start with."
-  (let ((pass (if default default ""))
-	(c 0)
-	(echo-keystrokes 0)
-	(cursor-in-echo-area t))
-    (while (progn (message "%s%s"
-			   prompt
-			   (make-string (length pass) ?.))
-		  (setq c (read-char))
-		  (and (/= c ?\r) (/= c ?\n) (/= c ?\e)))
-      (if (= c ?\C-u)
-	  (setq pass "")
-	(if (and (/= c ?\b) (/= c ?\177))
-	    (setq pass (concat pass (char-to-string c)))
-	  (if (> (length pass) 0)
-	      (setq pass (substring pass 0 -1))))))
-    (message "")
-    (message nil)
-    pass))
-
-;; the  rmail-break-forwarded-messages  feature is not implemented
-(defun rmail-convert-to-babyl-format ()
-  (let ((count 0) start
-	(case-fold-search nil)
-	(invalid-input-resync
-	 (function (lambda ()
-		     (message "Invalid Babyl format in inbox!")
-		     (sit-for 3)
-		     ;; Try to get back in sync with a real message.
-		     (if (re-search-forward
-			  (concat mmdf-delim1 "\\|^From") nil t)
-			 (beginning-of-line)
-		       (goto-char (point-max)))))))
-    (goto-char (point-min))
-    (save-restriction
-      (while (not (eobp))
-	(cond ((looking-at "BABYL OPTIONS:");Babyl header
-	       (if (search-forward "\n\^_" nil t)
-		   ;; If we find the proper terminator, delete through there.
-		   (delete-region (point-min) (point))
-		 (funcall invalid-input-resync)
-		 (delete-region (point-min) (point))))
-	      ;; Babyl format message
-	      ((looking-at "\^L")
-	       (or (search-forward "\n\^_" nil t)
-		   (funcall invalid-input-resync))
-	       (setq count (1+ count))
-	       ;; Make sure there is no extra white space after the ^_
-	       ;; at the end of the message.
-	       ;; Narrowing will make sure that whatever follows the junk
-	       ;; will be treated properly.
-	       (delete-region (point)
-			      (save-excursion
-				(skip-chars-forward " \t\n")
-				(point)))
-	       (narrow-to-region (point) (point-max)))
-	      ;;*** MMDF format
-	      ((let ((case-fold-search t))
-		 (looking-at mmdf-delim1))
-	       (let ((case-fold-search t))
-		 (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n")
-		 (setq start (point))
-		 (re-search-forward mmdf-delim2 nil t)
-		 (replace-match "\^_"))
-	       (save-excursion
-		 (save-restriction
-		   (narrow-to-region start (1- (point)))
-		   (goto-char (point-min))
-		   (while (search-forward "\n\^_" nil t); single char "\^_"
-		     (replace-match "\n^_")))); 2 chars: "^" and "_"
-	       (narrow-to-region (point) (point-max))
-	       (setq count (1+ count)))
-	      ;;*** Mail format
-	      ((looking-at "^From ")
-	       (setq start (point))
-	       (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
-	       (rmail-nuke-pinhead-header)
-	       ;; If this message has a Content-Length field,
-	       ;; skip to the end of the contents.
-	       (let* ((header-end (save-excursion
-				    (and (re-search-forward "\n\n" nil t)
-					 (1- (point)))))
-		      (case-fold-search t)
-		      (size
-		       ;; Get the numeric value from the Content-Length field.
-		       (save-excursion
-			 ;; Back up to end of prev line,
-			 ;; in case the Content-Length field comes first.
-			 (forward-char -1)
-			 (and (search-forward "\ncontent-length: "
-					      header-end t)
-			      (let ((beg (point))
-				    (eol (progn (end-of-line) (point))))
-				(string-to-int (buffer-substring beg eol)))))))
-		 (and size
-		      (if (and (natnump size)
-			       (<= (+ header-end size) (point-max))
-			       ;; Make sure this would put us at a position
-			       ;; that we could continue from.
-			       (save-excursion
-				 (goto-char (+ header-end size))
-				 (skip-chars-forward "\n")
-				 (or (eobp)
-				     (and (looking-at "BABYL OPTIONS:")
-					  (search-forward "\n\^_" nil t))
-				     (and (looking-at "\^L")
-					  (search-forward "\n\^_" nil t))
-				     (let ((case-fold-search t))
-				       (looking-at mmdf-delim1))
-				     (looking-at "From "))))
-			  (goto-char (+ header-end size))
-			(message "Ignoring invalid Content-Length field")
-			(sit-for 1 0 t))))
-
-	       (if (re-search-forward
-		    (concat "^[\^_]?\\("
-			    rmail-unix-mail-delimiter
-			    "\\|"
-			    mmdf-delim1 "\\|"
-			    "^BABYL OPTIONS:\\|"
-			    "\^L\n[01],\\)") nil t)
-		   (goto-char (match-beginning 1))
-		 (goto-char (point-max)))
-	       (setq count (1+ count))
-	       (save-excursion
-		 (save-restriction
-		   (narrow-to-region start (point))
-		   (goto-char (point-min))
-		   (while (search-forward "\n\^_" nil t); single char
-		     (replace-match "\n^_")))); 2 chars: "^" and "_"
-	       (insert ?\^_)
-	       (narrow-to-region (point) (point-max)))
-	      ;;
-	      ;; This kludge is because some versions of sendmail.el
-	      ;; insert an extra newline at the beginning that shouldn't
-	      ;; be there.  sendmail.el has been fixed, but old versions
-	      ;; may still be in use.  -- rms, 7 May 1993.
-	      ((eolp) (delete-char 1))
-	      (t (error "Cannot convert to babyl format")))))
-    count))
-
-;; Delete the "From ..." line, creating various other headers with
-;; information from it if they don't already exist.  Now puts the
-;; original line into a mail-from: header line for debugging and for
-;; use by the rmail-output function.
-(defun rmail-nuke-pinhead-header ()
-  (save-excursion
-    (save-restriction
-      (let ((start (point))
-  	    (end (progn
-		   (condition-case ()
-		       (search-forward "\n\n")
-		     (error
-		      (goto-char (point-max))
-		      (insert "\n\n")))
-		   (point)))
-	    has-from has-date)
-	(narrow-to-region start end)
-	(let ((case-fold-search t))
-	  (goto-char start)
-	  (setq has-from (search-forward "\nFrom:" nil t))
-	  (goto-char start)
-	  (setq has-date (and (search-forward "\nDate:" nil t) (point)))
-	  (goto-char start))
-	(let ((case-fold-search nil))
-	  (if (re-search-forward (concat "^" rmail-unix-mail-delimiter) nil t)
-	      (replace-match
-		(concat
-		  "Mail-from: \\&"
-		  ;; Keep and reformat the date if we don't
-		  ;;  have a Date: field.
-		  (if has-date
-		      ""
-		    (concat
-		     "Date: \\2, \\4 \\3 \\9 \\5 "
-		    
-		     ;; The timezone could be matched by group 7 or group 10.
-		     ;; If neither of them matched, assume EST, since only
-		     ;; Easterners would be so sloppy.
-		     ;; It's a shame the substitution can't use "\\10".
-		     (cond
-		      ((/= (match-beginning 7) (match-end 7)) "\\7")
-		      ((/= (match-beginning 10) (match-end 10))
-		       (buffer-substring (match-beginning 10)
-					 (match-end 10)))
-		      (t "EST"))
-		     "\n"))
-		  ;; Keep and reformat the sender if we don't
-		  ;; have a From: field.
-		  (if has-from
-		      ""
-		    "From: \\1\n"))
-		t)))))))
-
-;;;; *** Rmail Message Formatting and Header Manipulation ***
-
-(defun rmail-reformat-message (beg end)
-  (goto-char beg)
-  (forward-line 1)
-  (if (/= (following-char) ?0)
-      (error "Bad format in RMAIL file."))
-  (let ((buffer-read-only nil)
-	(delta (- (buffer-size) end)))
-    (delete-char 1)
-    (insert ?1)
-    (forward-line 1)
-    (let ((case-fold-search t))
-      (while (looking-at "Summary-line:\\|Mail-From:")
- 	(forward-line 1)))
-    (if (looking-at "\\*\\*\\* EOOH \\*\\*\\*\n")
-	(delete-region (point)
-		       (progn (forward-line 1) (point))))
-    (let ((str (buffer-substring (point)
-				 (save-excursion (search-forward "\n\n" end 'move)
-						 (point)))))
-      (insert str "*** EOOH ***\n")
-      (narrow-to-region (point) (- (buffer-size) delta)))
-    (goto-char (point-min))
-    (if rmail-message-filter (funcall rmail-message-filter))
-    (if (or rmail-displayed-headers rmail-ignored-headers)
-	(rmail-clear-headers))))
-
-(defun rmail-clear-headers (&optional ignored-headers)
-  "Delete all header fields that Rmail should not show.
-If the optional argument IGNORED-HEADERS is non-nil,
-delete all header fields whose names match that regexp.
-Otherwise, if `rmail-displayed-headers' is non-nil,
-delete all header fields *except* those whose names match that regexp.
-Otherwise, delete all header fields whose names match `rmail-ignored-headers'."
-  (if (search-forward "\n\n" nil t)
-      (let ((case-fold-search t)
-	    (buffer-read-only nil))
-	(if (and rmail-displayed-headers (null ignored-headers))
-	    (save-restriction
-	      (narrow-to-region (point-min) (point))
-	      (let (lim)
-		(goto-char (point-min))
-		(while (save-excursion
-			 (re-search-forward "\n[^ \t]")
-			 (and (not (eobp))
-			      (setq lim (1- (point)))))
-		  (if (save-excursion
-			(re-search-forward rmail-displayed-headers lim t))
-		      (goto-char lim)
-		    (delete-region (point) lim))))
-	      (goto-char (point-min)))
-	  (or ignored-headers (setq ignored-headers rmail-ignored-headers))
-	  (save-restriction
-	    (narrow-to-region (point-min) (point))
-	    (while (progn
-		     (goto-char (point-min))
-		     (re-search-forward ignored-headers nil t))
-	      (beginning-of-line)
-	      (delete-region (point)
-			     (progn (re-search-forward "\n[^ \t]")
-				    (1- (point))))))))))
-
-(defun rmail-msg-is-pruned ()
-  (rmail-maybe-set-message-counters)
-  (save-restriction
-    (save-excursion
-  (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
-    (goto-char (point-min))
-    (forward-line 1)
-      (= (following-char) ?1))))
-
-(defun rmail-toggle-header (&optional arg)
-  "Show original message header if pruned header currently shown, or vice versa.
-With argument ARG, show the message header pruned if ARG is greater than zero;
-otherwise, show it in full."
-  (interactive "P")
-  (let* ((buffer-read-only nil)
-	 (pruned (rmail-msg-is-pruned))
-	 (prune (if arg
-		    (> (prefix-numeric-value arg) 0)
-		  (not pruned))))
-    (if (eq pruned prune)
-	t
-      (rmail-maybe-set-message-counters)
-      (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
-      (if pruned
-	  (progn (goto-char (point-min))
-		 (forward-line 1)
-		 (delete-char 1)
-		 (insert ?0)
-		 (forward-line 1)
-		 (let ((case-fold-search t))
-		   (while (looking-at "Summary-Line:\\|Mail-From:")
-		     (forward-line 1)))
-		 (insert "*** EOOH ***\n")
-		 (forward-char -1)
-		 (search-forward "\n*** EOOH ***\n")
-		 (forward-line -1)
-		 (let ((temp (point)))
-		   (and (search-forward "\n\n" nil t)
-			(delete-region temp (point))))
-		 (goto-char (point-min))
-		 (search-forward "\n*** EOOH ***\n")
-		 (narrow-to-region (point) (point-max)))
-	(rmail-reformat-message (point-min) (point-max)))
-      (rmail-highlight-headers))))
-
-;;;; *** Rmail Attributes and Keywords ***
-
-;; Make a string describing current message's attributes and keywords
-;; and set it up as the name of a minor mode
-;; so it will appear in the mode line.
-(defun rmail-display-labels ()
-  (let ((blurb "") (beg (point-min-marker)) (end (point-max-marker)))
-    (save-excursion
-      (unwind-protect
-	  (progn
-	    (widen)
-	    (goto-char (rmail-msgbeg rmail-current-message))
-	    (forward-line 1)
-	    (if (looking-at "[01],")
-		(progn
-		  (narrow-to-region (point) (progn (end-of-line) (point)))
-		  ;; Truly valid BABYL format requires a space before each
-		  ;; attribute or keyword name.  Put them in if missing.
-		  (let (buffer-read-only)
-		    (goto-char (point-min))
-		    (while (search-forward "," nil t)
-		      (or (looking-at "[ ,]") (eobp)
-			  (insert " "))))
-		  (goto-char (point-max))
-		  (if (search-backward ",," nil 'move)
-		      (progn
-			(if (> (point) (1+ (point-min)))
-			    (setq blurb (buffer-substring (+ 1 (point-min)) (point))))
-			(if (> (- (point-max) (point)) 2)
-			    (setq blurb
-				  (concat blurb
-					  ";"
-					  (buffer-substring (+ (point) 3)
-							    (1- (point-max)))))))))))
-	;; Note: we don't use save-restriction because that does not work right
-	;; if changes are made outside the saved restriction
-	;; before that restriction is restored.
-	(narrow-to-region beg end)
-	(set-marker beg nil)
-	(set-marker end nil)))
-    (while (string-match " +," blurb)
-      (setq blurb (concat (substring blurb 0 (match-beginning 0)) ","
-			  (substring blurb (match-end 0)))))
-    (while (string-match ", +" blurb)
-      (setq blurb (concat (substring blurb 0 (match-beginning 0)) ","
-			  (substring blurb (match-end 0)))))
-    (setq mode-line-process
-	  (format " %d/%d%s"
-		  rmail-current-message rmail-total-messages blurb))))
-
-;; Turn an attribute of a message on or off according to STATE.
-;; ATTR is the name of the attribute, as a string.
-;; MSGNUM is message number to change; nil means current message.
-(defun rmail-set-attribute (attr state &optional msgnum)
-  (let ((omax (point-max-marker))
-	(omin (point-min-marker))
-	(buffer-read-only nil))
-    (or msgnum (setq msgnum rmail-current-message))
-    (if (> msgnum 0)
-	(unwind-protect
-	    (save-excursion
-	      (widen)
-	      (goto-char (+ 3 (rmail-msgbeg msgnum)))
-	      (let ((curstate
-		     (not
-		      (null (search-backward (concat ", " attr ",")
-					     (prog1 (point) (end-of-line)) t)))))
-		(or (eq curstate (not (not state)))
-		    (if curstate
-			(delete-region (point) (1- (match-end 0)))
-		      (beginning-of-line)
-		      (forward-char 2)
-		      (insert " " attr ","))))
-	      (if (string= attr "deleted")
-		  (rmail-set-message-deleted-p msgnum state)))
-	  ;; Note: we don't use save-restriction because that does not work right
-	  ;; if changes are made outside the saved restriction
-	  ;; before that restriction is restored.
-	  (narrow-to-region omin omax)
-	  (set-marker omin nil)
-	  (set-marker omax nil)
-	  (if (= msgnum rmail-current-message)
-	      (rmail-display-labels))))))
-
-;; Return t if the attributes/keywords line of msg number MSG
-;; contains a match for the regexp LABELS.
-(defun rmail-message-labels-p (msg labels)
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (rmail-msgbeg msg))
-      (forward-char 3)
-      (re-search-backward labels (prog1 (point) (end-of-line)) t))))
-
-;;;; *** Rmail Message Selection And Support ***
-
-(defun rmail-msgend (n)
-  (marker-position (aref rmail-message-vector (1+ n))))
-
-(defun rmail-msgbeg (n)
-  (marker-position (aref rmail-message-vector n)))
-
-(defun rmail-widen-to-current-msgbeg (function)
-  "Call FUNCTION with point at start of internal data of current message.
-Assumes that bounds were previously narrowed to display the message in Rmail.
-The bounds are widened enough to move point where desired, then narrowed
-again afterward.
-
-FUNCTION may not change the visible text of the message, but it may
-change the invisible header text."
-  (save-excursion
-    (let ((obeg (- (point-max) (point-min))))
-      (unwind-protect
-	  (progn
-	    (narrow-to-region (rmail-msgbeg rmail-current-message)
-			      (point-max))
-	    (goto-char (point-min))
-	    (funcall function))
-	;; Note: we don't use save-restriction because that does not work right
-	;; if changes are made outside the saved restriction
-	;; before that restriction is restored.
-	;; Here we assume that changes made by FUNCTION
-	;; occur before the visible region of the message.
-	(narrow-to-region (- (point-max) obeg) (point-max))))))
-
-(defun rmail-forget-messages ()
-  (unwind-protect
-      (if (vectorp rmail-message-vector)
-	  (let* ((i 0)
-		 (v rmail-message-vector)
-		 (n (length v)))
-	    (while (< i n)
-	      (move-marker (aref v i)  nil)
-	      (setq i (1+ i)))))
-    (setq rmail-message-vector nil)
-    (setq rmail-deleted-vector nil)))
-
-(defun rmail-maybe-set-message-counters ()
-  (if (not (and rmail-deleted-vector
-		rmail-message-vector
-		rmail-current-message
-		rmail-total-messages))
-      (rmail-set-message-counters)))
-
-(defun rmail-count-new-messages (&optional nomsg)
-  (let* ((case-fold-search nil)
-	 (total-messages 0)
-	 (messages-head nil)
-	 (deleted-head nil))
-    (or nomsg (message "Counting new messages..."))
-    (goto-char (point-max))
-    ;; Put at the end of messages-head
-    ;; the entry for message N+1, which marks
-    ;; the end of message N.  (N = number of messages).
-    (search-backward "\n\^_")
-    (forward-char 1)
-    (setq messages-head (list (point-marker)))
-    (rmail-set-message-counters-counter (point-min))
-    (setq rmail-current-message (1+ rmail-total-messages))
-    (setq rmail-total-messages
-	  (+ rmail-total-messages total-messages))
-    (setq rmail-message-vector
-	  (vconcat rmail-message-vector (cdr messages-head)))
-    (aset rmail-message-vector
-	  rmail-current-message (car messages-head))
-    (setq rmail-deleted-vector
-	  (concat rmail-deleted-vector deleted-head))
-    (setq rmail-summary-vector
-	  (vconcat rmail-summary-vector (make-vector total-messages nil)))
-    (goto-char (point-min))
-    (or nomsg (message "Counting new messages...done (%d)" total-messages))))
-
-(defun rmail-set-message-counters ()
-  (rmail-forget-messages)
-  (save-excursion
-    (save-restriction
-      (widen)
-      (let* ((point-save (point))
-	     (total-messages 0)
-	     (messages-after-point)
-	     (case-fold-search nil)
-	     (messages-head nil)
-	     (deleted-head nil))
-	(message "Counting messages...")
-	(goto-char (point-max))
-	;; Put at the end of messages-head
-	;; the entry for message N+1, which marks
-	;; the end of message N.  (N = number of messages).
-	(search-backward "\n\^_" nil t)
-	(if (/= (point) (point-max)) (forward-char 1))
-	(setq messages-head (list (point-marker)))
-	(rmail-set-message-counters-counter (min (point) point-save))
-	(setq messages-after-point total-messages)
-	(rmail-set-message-counters-counter)
-	(setq rmail-total-messages total-messages)
-	(setq rmail-current-message
-	      (min total-messages
-		   (max 1 (- total-messages messages-after-point))))
-	(setq rmail-message-vector
-	      (apply 'vector (cons (point-min-marker) messages-head))
-	      rmail-deleted-vector (concat "D" deleted-head)
-	      rmail-summary-vector (make-vector rmail-total-messages nil))
-	(message "Counting messages...done")))))
-	
-(defun rmail-set-message-counters-counter (&optional stop)
-  (while (search-backward "\n\^_\^L\n" stop t)
-    (forward-char 1)
-    (setq messages-head (cons (point-marker) messages-head))
-    (save-excursion
-      (setq deleted-head
-	    (cons (if (search-backward ", deleted,"
-				       (prog1 (point)
-					 (forward-line 2))
-				       t)
-		      ?D ?\ )
-		  deleted-head)))
-    (if (zerop (% (setq total-messages (1+ total-messages)) 20))
-	(message "Counting messages...%d" total-messages))))
-
-(defun rmail-beginning-of-message ()
-  "Show current message starting from the beginning."
-  (interactive)
-  (rmail-show-message rmail-current-message))
-
-(defun rmail-show-message (&optional n no-summary)
-  "Show message number N (prefix argument), counting from start of file.
-If summary buffer is currently displayed, update current message there also."
-  (interactive "p")
-  (rmail-maybe-set-message-counters)
-  (widen)
-  (if (zerop rmail-total-messages)
-      (progn (narrow-to-region (point-min) (1- (point-max)))
-	     (goto-char (point-min))
-	     (setq mode-line-process nil))
-    (let (blurb)
-      (if (not n)
-	  (setq n rmail-current-message)
-	(cond ((<= n 0)
-	       (setq n 1
-		     rmail-current-message 1
-		     blurb "No previous message"))
-	      ((> n rmail-total-messages)
-	       (setq n rmail-total-messages
-		     rmail-current-message rmail-total-messages
-		     blurb "No following message"))
-	      (t
-	       (setq rmail-current-message n))))
-      (let ((beg (rmail-msgbeg n)))
-	(goto-char beg)
-	(forward-line 1)
-	;; Clear the "unseen" attribute when we show a message.
-	(rmail-set-attribute "unseen" nil)
-	;; Reformat the header, or else find the reformatted header.
-	(let ((end (rmail-msgend n)))
-	  (if (= (following-char) ?0)
-	      (rmail-reformat-message beg end)
-	    (search-forward "\n*** EOOH ***\n" end t)
-	    (narrow-to-region (point) end)))
-	(goto-char (point-min))
-	(rmail-display-labels)
-	(rmail-highlight-headers)
-	(if transient-mark-mode (deactivate-mark))
-	(run-hooks 'rmail-show-message-hook)
-	;; If there is a summary buffer, try to move to this message
-	;; in that buffer.  But don't complain if this message
-	;; is not mentioned in the summary.
-	;; Don't do this at all if we were called on behalf
-	;; of cursor motion in the summary buffer.
-	(and (rmail-summary-exists) (not no-summary)
-	     (let ((curr-msg rmail-current-message))
-	       (rmail-select-summary
-		(rmail-summary-goto-msg curr-msg t t))))
-	(if blurb
-	    (message blurb))))))
-
-;; Find all occurrences of certain fields, and highlight them.
-(defun rmail-highlight-headers ()
-  ;; Do this only if the system supports faces.
-  (if (and (fboundp 'internal-find-face)
-	   rmail-highlighted-headers)
-      (save-excursion
-	(search-forward "\n\n" nil 'move)
-	(save-restriction
-	  (narrow-to-region (point-min) (point))
-	  (let ((case-fold-search t)
-		(inhibit-read-only t)
-		;; Highlight with boldface if that is available.
-		;; Otherwise use the `highlight' face.
-		(face (or rmail-highlight-face
-			  (if (face-differs-from-default-p 'bold)
-			      'bold 'highlight)))
-		;; List of overlays to reuse.
-		(overlays rmail-overlay-list))
-	    (goto-char (point-min))
-	    (while (re-search-forward rmail-highlighted-headers nil t)
-	      (skip-chars-forward " \t")
-	      (let ((beg (point))
-		    overlay)
-		(while (progn (forward-line 1)
-			      (looking-at "[ \t]")))
-		;; Back up over newline, then trailing spaces or tabs
-		(forward-char -1)
-		(while (member (preceding-char) '(?  ?\t))
-		  (forward-char -1))
-		(if overlays
-		    ;; Reuse an overlay we already have.
-		    (progn
-		      (setq overlay (car overlays)
-			    overlays (cdr overlays))
-		      (overlay-put overlay 'face face)
-		      (move-overlay overlay beg (point)))
-		  ;; Make a new overlay and add it to
-		  ;; rmail-overlay-list.
-		  (setq overlay (make-overlay beg (point)))
-		  (overlay-put overlay 'face face)
-		  (setq rmail-overlay-list
-			(cons overlay rmail-overlay-list))))))))))
-
-(defun rmail-next-message (n)
-  "Show following message whether deleted or not.
-With prefix arg N, moves forward N messages, or backward if N is negative."
-  (interactive "p")
-  (rmail-maybe-set-message-counters)
-  (rmail-show-message (+ rmail-current-message n)))
-
-(defun rmail-previous-message (n)
-  "Show previous message whether deleted or not.
-With prefix arg N, moves backward N messages, or forward if N is negative."
-  (interactive "p")
-  (rmail-next-message (- n)))  
-
-(defun rmail-next-undeleted-message (n)
-  "Show following non-deleted message.
-With prefix arg N, moves forward N non-deleted messages,
-or backward if N is negative.
-
-Returns t if a new message is being shown, nil otherwise."
-  (interactive "p")
-  (rmail-maybe-set-message-counters)
-  (let ((lastwin rmail-current-message)
-	(current rmail-current-message))
-    (while (and (> n 0) (< current rmail-total-messages))
-      (setq current (1+ current))
-      (if (not (rmail-message-deleted-p current))
-	  (setq lastwin current n (1- n))))
-    (while (and (< n 0) (> current 1))
-      (setq current (1- current))
-      (if (not (rmail-message-deleted-p current))
-	  (setq lastwin current n (1+ n))))
-    (if (/= lastwin rmail-current-message)
- 	(progn (rmail-show-message lastwin)
- 	       t)
-      (if (< n 0)
-	  (message "No previous nondeleted message"))
-      (if (> n 0)
-	  (message "No following nondeleted message"))
-      nil)))
-
-(defun rmail-previous-undeleted-message (n)
-  "Show previous non-deleted message.
-With prefix argument N, moves backward N non-deleted messages,
-or forward if N is negative."
-  (interactive "p")
-  (rmail-next-undeleted-message (- n)))
-
-(defun rmail-first-message ()
-  "Show first message in file."
-  (interactive)
-  (rmail-maybe-set-message-counters)
-  (rmail-show-message 1))
-
-(defun rmail-last-message ()
-  "Show last message in file."
-  (interactive)
-  (rmail-maybe-set-message-counters)
-  (rmail-show-message rmail-total-messages))
-
-(defun rmail-what-message ()
-  (let ((where (point))
-	(low 1)
-	(high rmail-total-messages)
-	(mid (/ rmail-total-messages 2)))
-    (while (> (- high low) 1)
-      (if (>= where (rmail-msgbeg mid))
-	  (setq low mid)
-	(setq high mid))
-      (setq mid (+ low (/ (- high low) 2))))
-    (if (>= where (rmail-msgbeg high)) high low)))
-
-(defun rmail-message-recipients-p (msg recipients &optional primary-only)
-  (save-restriction
-    (goto-char (rmail-msgbeg msg))
-    (search-forward "\n*** EOOH ***\n")
-    (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
-    (or (string-match recipients (or (mail-fetch-field "To") ""))
-	(string-match recipients (or (mail-fetch-field "From") ""))
-	(if (not primary-only)
-	    (string-match recipients (or (mail-fetch-field "Cc") ""))))))
-
-(defun rmail-message-regexp-p (msg regexp)
-  "Return t, if for message number MSG, regexp REGEXP matches in the header."
-  (goto-char (rmail-msgbeg msg))
-  (let ((end 
-         (save-excursion 
-           (search-forward "*** EOOH ***" (point-max)) (point))))
-    (re-search-forward regexp end t)))
-
-(defvar rmail-search-last-regexp nil)
-(defun rmail-search (regexp &optional n)
-  "Show message containing next match for REGEXP (but not the current msg).
-Prefix argument gives repeat count; negative argument means search
-backwards (through earlier messages).
-Interactively, empty argument means use same regexp used last time."
-  (interactive
-    (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
-	   (prompt
-	    (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
-	   regexp)
-      (if rmail-search-last-regexp
-	  (setq prompt (concat prompt
-			       "(default "
-			       rmail-search-last-regexp
-			       ") ")))
-      (setq regexp (read-string prompt))
-      (cond ((not (equal regexp ""))
-	     (setq rmail-search-last-regexp regexp))
-	    ((not rmail-search-last-regexp)
-	     (error "No previous Rmail search string")))
-      (list rmail-search-last-regexp
-	    (prefix-numeric-value current-prefix-arg))))
-  (or n (setq n 1))
-  (message "%sRmail search for %s..."
-	   (if (< n 0) "Reverse " "")
-	   regexp)
-  (rmail-maybe-set-message-counters)
-  (let ((omin (point-min))
-	(omax (point-max))
-	(opoint (point))
-	win
-	(reversep (< n 0))
-	(msg rmail-current-message))
-    (unwind-protect
-	(progn
-	  (widen)
-	  (while (/= n 0)
-	    ;; Check messages one by one, advancing message number up or down
-	    ;; but searching forward through each message.
-	    (if reversep
-		(while (and (null win) (> msg 1))
-		  (goto-char (rmail-msgbeg (setq msg (1- msg))))
-		  (setq win (re-search-forward
-			     regexp (rmail-msgend msg) t)))
-	      (while (and (null win) (< msg rmail-total-messages))
-		(goto-char (rmail-msgbeg (setq msg (1+ msg))))
-		(setq win (re-search-forward regexp (rmail-msgend msg) t))))
-	    (setq n (+ n (if reversep 1 -1)))))
-      (if win
-	  (progn
-	    ;; If this is a reverse search and we found a message,
-	    ;; search backward thru this message to position point.
-	    (if reversep
-		(progn
-		  (goto-char (rmail-msgend msg))
-		  (re-search-backward
-		   regexp (rmail-msgbeg msg) t)))
-	    (setq win (point))
-	    (rmail-show-message msg)
-	    (message "%sRmail search for %s...done"
-		     (if reversep "Reverse " "")
-		     regexp)
-	    (goto-char win))
-	(goto-char opoint)
-	(narrow-to-region omin omax)
-	(ding)
-	(message "Search failed: %s" regexp)))))
-
-(defun rmail-search-backwards (regexp &optional n)
-  "Show message containing previous match for REGEXP.
-Prefix argument gives repeat count; negative argument means search
-forward (through later messages).
-Interactively, empty argument means use same regexp used last time."
-  (interactive
-    (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
-	   (prompt
-	    (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
-	   regexp)
-      (if rmail-search-last-regexp
-	  (setq prompt (concat prompt
-			       "(default "
-			       rmail-search-last-regexp
-			       ") ")))
-      (setq regexp (read-string prompt))
-      (cond ((not (equal regexp ""))
-	     (setq rmail-search-last-regexp regexp))
-	    ((not rmail-search-last-regexp)
-	     (error "No previous Rmail search string")))
-      (list rmail-search-last-regexp
-	    (prefix-numeric-value current-prefix-arg))))
-  (rmail-search regexp (- (or n 1))))
-
-;; Show the first message which has the `unseen' attribute.
-(defun rmail-first-unseen-message ()
-  (rmail-maybe-set-message-counters)
-  (let ((current 1)
-	found)
-    (save-restriction
-      (widen)
-      (while (and (not found) (<= current rmail-total-messages))
-	(if (rmail-message-labels-p current ", ?\\(unseen\\),")
-	    (setq found current))
-	(setq current (1+ current))))
-;; Let the caller show the message.
-;;    (if found
-;;	(rmail-show-message found))
-    found))
-
-(defun rmail-next-same-subject (n)
-  "Go to the next mail message having the same subject header.
-With prefix argument N, do this N times.
-If N is negative, go backwards instead."
-  (interactive "p")
-  (let ((subject (mail-fetch-field "Subject"))
-	(forward (> n 0))
-	(i rmail-current-message)
-	search-regexp found)
-    (if (string-match "Re:[ \t]*" subject)
-	(setq subject (substring subject (match-end 0))))
-    (setq search-regexp (concat "^Subject: *\\(Re: *\\)?"
-				(regexp-quote subject)
-				"\n"))
-    (save-excursion
-      (save-restriction
-	(widen)
-	(while (and (/= n 0)
-		    (if forward
-			(< i rmail-total-messages)
-		      (> i 1)))
-	  (let (done)
-	    (while (and (not done)
-			(if forward
-			    (< i rmail-total-messages)
-			  (> i 1)))
-	      (setq i (if forward (1+ i) (1- i)))
-	      (goto-char (rmail-msgbeg i))
-	      (search-forward "\n*** EOOH ***\n")
-	      (let ((beg (point)) end)
-		(search-forward "\n\n")
-		(setq end (point))
-		(goto-char beg)
-		(setq done (re-search-forward search-regexp end t))))
-	    (if done (setq found i)))
-	  (setq n (if forward (1- n) (1+ n))))))
-    (if found
-	(rmail-show-message found)
-      (error "No %s message with same subject"
-	     (if forward "following" "previous")))))
-
-(defun rmail-previous-same-subject (n)
-  "Go to the previous mail message having the same subject header.
-With prefix argument N, do this N times.
-If N is negative, go forwards instead."
-  (interactive "p")
-  (rmail-next-same-subject (- n)))
-
-;;;; *** Rmail Message Deletion Commands ***
-
-(defun rmail-message-deleted-p (n)
-  (= (aref rmail-deleted-vector n) ?D))
-
-(defun rmail-set-message-deleted-p (n state)
-  (aset rmail-deleted-vector n (if state ?D ?\ )))
-
-(defun rmail-delete-message ()
-  "Delete this message and stay on it."
-  (interactive)
-  (rmail-set-attribute "deleted" t)
-  (run-hooks 'rmail-delete-message-hook))
-
-(defun rmail-undelete-previous-message ()
-  "Back up to deleted message, select it, and undelete it."
-  (interactive)
-  (let ((msg rmail-current-message))
-    (while (and (> msg 0)
-		(not (rmail-message-deleted-p msg)))
-      (setq msg (1- msg)))
-    (if (= msg 0)
-	(error "No previous deleted message")
-      (if (/= msg rmail-current-message)
-	  (rmail-show-message msg))
-      (rmail-set-attribute "deleted" nil)
-      (if (rmail-summary-exists)
-	  (save-excursion
-	    (set-buffer rmail-summary-buffer)
-	    (rmail-summary-mark-undeleted msg)))
-      (rmail-maybe-display-summary))))
-
-(defun rmail-delete-forward (&optional backward)
-  "Delete this message and move to next nondeleted one.
-Deleted messages stay in the file until the \\[rmail-expunge] command is given.
-With prefix argument, delete and move backward.
-
-Returns t if a new message is displayed after the delete, or nil otherwise."
-  (interactive "P")
-  (rmail-set-attribute "deleted" t)
-  (run-hooks 'rmail-delete-message-hook)
-  (let ((del-msg rmail-current-message))
-    (if (rmail-summary-exists)
-	(rmail-select-summary
-	 (rmail-summary-mark-deleted del-msg)))
-    (prog1 (rmail-next-undeleted-message (if backward -1 1))
-      (rmail-maybe-display-summary))))
-
-(defun rmail-delete-backward ()
-  "Delete this message and move to previous nondeleted one.
-Deleted messages stay in the file until the \\[rmail-expunge] command is given."
-  (interactive)
-  (rmail-delete-forward t))
-
-;; Compute the message number a given message would have after expunging.
-;; The present number of the message is OLDNUM.
-;; DELETEDVEC should be rmail-deleted-vector.
-;; The value is nil for a message that would be deleted.
-(defun rmail-msg-number-after-expunge (deletedvec oldnum)
-  (if (or (null oldnum) (= (aref deletedvec oldnum) ?D))
-      nil
-    (let ((i 0)
-	  (newnum 0))
-      (while (< i oldnum)
-	(if (/= (aref deletedvec i) ?D)
-	    (setq newnum (1+ newnum)))
-	(setq i (1+ i)))
-      newnum)))
-
-(defun rmail-only-expunge ()
-  "Actually erase all deleted messages in the file."
-  (interactive)
-  (message "Expunging deleted messages...")
-  ;; Discard all undo records for this buffer.
-  (or (eq buffer-undo-list t)
-      (setq buffer-undo-list nil))
-  (rmail-maybe-set-message-counters)
-  (let* ((omax (- (buffer-size) (point-max)))
-	 (omin (- (buffer-size) (point-min)))
-	 (opoint (if (and (> rmail-current-message 0)
-			  (rmail-message-deleted-p rmail-current-message))
-		     0
-		   (- (point) (point-min))))
-	 (messages-head (cons (aref rmail-message-vector 0) nil))
-	 (messages-tail messages-head)
-	 ;; Don't make any undo records for the expunging.
-	 (buffer-undo-list t)
-	 (win))
-    (unwind-protect
-	(save-excursion
-	  (widen)
-	  (goto-char (point-min))
-	  (let ((counter 0)
-		(number 1)
-		(total rmail-total-messages)
-		(new-message-number rmail-current-message)
-		(new-summary nil)
-		(rmailbuf (current-buffer))
-		(buffer-read-only nil)
-		(messages rmail-message-vector)
-		(deleted rmail-deleted-vector)
-		(summary rmail-summary-vector))
-	    (setq rmail-total-messages nil
-		  rmail-current-message nil
-		  rmail-message-vector nil
-		  rmail-deleted-vector nil
-		  rmail-summary-vector nil)
-
-	    ;; Find each sendmail buffer that is set to reply
-	    ;; to a message in this buffer, and update its
-	    ;; message number.
-	    (let ((bufs (buffer-list)))
-	      (while bufs
-		(save-excursion
-		  (set-buffer (car bufs))
-		  (and (boundp 'rmail-send-actions-rmail-buffer)
-		       (eq rmail-send-actions-rmail-buffer rmailbuf)
-		       (setq rmail-send-actions-rmail-msg-number
-			     (rmail-msg-number-after-expunge
-			      deleted
-			      rmail-send-actions-rmail-msg-number))))
-		(setq bufs (cdr bufs))))
-
-	    (while (<= number total)
-	      (if (= (aref deleted number) ?D)
-		  (progn
-		    (delete-region
-		      (marker-position (aref messages number))
-		      (marker-position (aref messages (1+ number))))
-		    (move-marker (aref messages number) nil)
-		    (if (> new-message-number counter)
-			(setq new-message-number (1- new-message-number))))
-		(setq counter (1+ counter))
-		(setq messages-tail
-		      (setcdr messages-tail
-			      (cons (aref messages number) nil)))
-		(setq new-summary
-		      (cons (if (= counter number) (aref summary (1- number)))
-			    new-summary)))
-	      (if (zerop (% (setq number (1+ number)) 20))
-		  (message "Expunging deleted messages...%d" number)))
-	    (setq messages-tail
-		  (setcdr messages-tail
-			  (cons (aref messages number) nil)))
-	    (setq rmail-current-message new-message-number
-		  rmail-total-messages counter
-		  rmail-message-vector (apply 'vector messages-head)
-		  rmail-deleted-vector (make-string (1+ counter) ?\ )
-		  rmail-summary-vector (vconcat (nreverse new-summary))
-		  win t)))
-      (message "Expunging deleted messages...done")
-      (if (not win)
-	  (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))
-      (rmail-show-message
-       (if (zerop rmail-current-message) 1 nil))
-      (forward-char opoint))))
-
-(defun rmail-expunge ()
-  "Erase deleted messages from Rmail file and summary buffer."
-  (interactive)
-  (rmail-only-expunge)
-  (if (rmail-summary-exists)
-      (rmail-select-summary
-	(rmail-update-summary))))
-
-;;;; *** Rmail Mailing Commands ***
-
-(defun rmail-start-mail (&optional noerase to subject in-reply-to cc
-				   replybuffer sendactions same-window others)
-  (let (yank-action)
-    (if replybuffer
-	(setq yank-action (list 'insert-buffer replybuffer)))
-    (setq others (cons (cons "cc" cc) others))
-    (setq others (cons (cons "in-reply-to" in-reply-to) others))
-    (if same-window
-	(compose-mail to subject others
-		      noerase nil
-		      yank-action sendactions)
-      (if (and window-system rmail-mail-new-frame)
-	  (prog1
-	      (compose-mail to subject others
-			    noerase 'switch-to-buffer-other-frame
-			    yank-action sendactions)
-	    ;; This is not a standard frame parameter;
-	    ;; nothing except sendmail.el looks at it.
-	    (modify-frame-parameters (selected-frame)
-				     '((mail-dedicated-frame . t))))
-	(compose-mail to subject others
-		      noerase 'switch-to-buffer-other-window
-		      yank-action sendactions)))))
-
-(defun rmail-mail ()
-  "Send mail in another window.
-While composing the message, use \\[mail-yank-original] to yank the
-original message into it."
-  (interactive)
-  (rmail-start-mail nil nil nil nil nil (current-buffer)))
-
-(defun rmail-continue ()
-  "Continue composing outgoing message previously being composed."
-  (interactive)
-  (rmail-start-mail t))
-
-(put 'rmail-send-actions-rmail-buffer 'permanent-local t)
-(put 'rmail-send-actions-rmail-msg-number 'permanent-local t)
-
-(defun rmail-reply (just-sender)
-  "Reply to the current message.
-Normally include CC: to all other recipients of original message;
-prefix argument means ignore them.  While composing the reply,
-use \\[mail-yank-original] to yank the original message into it."
-  (interactive "P")
-  (let (from reply-to cc subject date to message-id
-	     resent-to resent-cc resent-reply-to
-	     (msgnum rmail-current-message)
-	     (rmail-buffer (current-buffer)))
-    (save-excursion
-      (save-restriction
-	(widen)
-	(goto-char (rmail-msgbeg rmail-current-message))
-	(forward-line 1)
-	(if (= (following-char) ?0)
-	    (narrow-to-region
-	     (progn (forward-line 2)
-		    (point))
-	     (progn (search-forward "\n\n" (rmail-msgend rmail-current-message)
-				    'move)
-		    (point)))
-	  (narrow-to-region (point)
-			    (progn (search-forward "\n*** EOOH ***\n")
-				   (beginning-of-line) (point))))
-	(setq from (mail-fetch-field "from")
-	      reply-to (or (mail-fetch-field "reply-to" nil t)
-			   from)
-	      cc (and (not just-sender)
-		      (mail-fetch-field "cc" nil t))
-	      subject (mail-fetch-field "subject")
-	      date (mail-fetch-field "date")
-	      to (or (mail-fetch-field "to" nil t) "")
-	      message-id (mail-fetch-field "message-id")
-	      resent-reply-to (mail-fetch-field "resent-reply-to" t)
-	      resent-cc (and (not just-sender)
-			     (mail-fetch-field "resent-cc" nil t))
-	      resent-to (or (mail-fetch-field "resent-to" nil t) "")
-;;;	      resent-subject (mail-fetch-field "resent-subject")
-;;;	      resent-date (mail-fetch-field "resent-date")
-;;;	      resent-message-id (mail-fetch-field "resent-message-id")
-	      )))
-    ;; Merge the resent-to and resent-cc into the to and cc.
-    (if (and resent-to (not (equal resent-to "")))
-	(if (not (equal to ""))
-	    (setq to (concat to ", " resent-to))
-	  (setq to resent-to)))
-    (if (and resent-cc (not (equal resent-cc "")))
-	(if (not (equal cc ""))
-	    (setq cc (concat cc ", " resent-cc))
-	  (setq cc resent-cc)))
-    ;; Add `Re: ' to subject if not there already.
-    (and (stringp subject)
-	 (setq subject
-	       (concat rmail-reply-prefix
-		       (if (string-match rmail-reply-regexp subject)
-			   (substring subject (match-end 0))
-			 subject))))
-    (rmail-start-mail nil
-      (mail-strip-quoted-names reply-to)
-      subject
-      (rmail-make-in-reply-to-field from date message-id)
-      (if just-sender
-	  nil
-	(let* ((cc-list (rmail-dont-reply-to
-			  (mail-strip-quoted-names
-			    (if (null cc) to (concat to ", " cc))))))
-	  (if (string= cc-list "") nil cc-list)))
-      (current-buffer)
-      (list (list '(lambda ()
-		     (let ((msgnum rmail-send-actions-rmail-msg-number))
-		       (save-excursion
-			 (set-buffer rmail-send-actions-rmail-buffer)
-			 (if msgnum
-			     (rmail-set-attribute "answered" t msgnum))))))))
-    ;; We keep the rmail buffer and message number in these 
-    ;; buffer-local vars in the sendmail buffer,
-    ;; so that rmail-only-expunge can relocate the message number.
-    (make-local-variable 'rmail-send-actions-rmail-buffer)
-    (make-local-variable 'rmail-send-actions-rmail-msg-number)
-    (setq rmail-send-actions-rmail-buffer rmail-buffer)
-    (setq rmail-send-actions-rmail-msg-number msgnum)))
-
-(defun rmail-make-in-reply-to-field (from date message-id)
-  (cond ((not from)
-         (if message-id
-             message-id
-             nil))
-        (mail-use-rfc822
-         (require 'rfc822)
-         (let ((tem (car (rfc822-addresses from))))
-           (if message-id
-               (if (string-match
-                    (regexp-quote (if (string-match "@[^@]*\\'" tem)
-                                      (substring tem 0 (match-beginning 0))
-                                      tem))
-                    message-id)
-                   ;; Message-ID is sufficiently informative
-                   message-id
-                   (concat message-id " (" tem ")"))
-	     ;; Copy TEM, discarding text properties.
-	     (setq tem (copy-sequence tem))
-	     (set-text-properties 0 (length tem) nil tem)
-	     (setq tem (copy-sequence tem))
-	     ;; Use prin1 to fake RFC822 quoting
-	     (let ((field (prin1-to-string tem)))
-	       (if date
-		   (concat field "'s message of " date)
-		   field)))))
-        ((let* ((foo "[^][\000-\037\177-\377()<>@,;:\\\" ]+")
-                (bar "[^][\000-\037\177-\377()<>@,;:\\\"]+"))
-           ;; Can't use format because format loses on \000 (unix *^&%*^&%$!!)
-           (or (string-match (concat "\\`[ \t]*\\(" bar
-                                     "\\)\\(<" foo "@" foo ">\\)?[ \t]*\\'")
-                             ;; "Unix Loser <Foo@bar.edu>" => "Unix Loser"
-                             from)
-               (string-match (concat "\\`[ \t]*<" foo "@" foo ">[ \t]*(\\("
-                                     bar "\\))[ \t]*\\'")
-                             ;; "<Bugs@bar.edu>" (Losing Unix) => "Losing Unix"
-                             from)))
-         (let ((start (match-beginning 1))
-               (end (match-end 1)))
-           ;; Trim whitespace which above regexp match allows
-           (while (and (< start end)
-                       (memq (aref from start) '(?\t ?\ )))
-             (setq start (1+ start)))
-           (while (and (< start end)
-                       (memq (aref from (1- end)) '(?\t ?\ )))
-             (setq end (1- end)))
-           (let ((field (substring from start end)))
-             (if date (setq field (concat "message from " field " on " date)))
-             (if message-id
-                 ;; "<AA259@bar.edu> (message from Unix Loser on 1-Apr-89)"
-                 (concat message-id " (" field ")")
-                 field))))
-        (t
-         ;; If we can't kludge it simply, do it correctly
-         (let ((mail-use-rfc822 t))
-           (rmail-make-in-reply-to-field from date message-id)))))
-
-(defun rmail-forward (resend)
-  "Forward the current message to another user.
-With prefix argument, \"resend\" the message instead of forwarding it;
-see the documentation of `rmail-resend'."
-  (interactive "P")
-  (if resend
-      (call-interactively 'rmail-resend)
-    (let ((forward-buffer (current-buffer))
-	  (msgnum rmail-current-message)
-	  (subject (concat "["
-			   (let ((from (or (mail-fetch-field "From")
-					   (mail-fetch-field ">From"))))
-			     (if from
-				 (concat (mail-strip-quoted-names from) ": ")
-			       ""))
-			   (or (mail-fetch-field "Subject") "")
-			   "]")))
-      (if (rmail-start-mail
-	   nil nil subject nil nil nil
-	   (list (list (function
-			(lambda ()
-			  (let ((msgnum
-				 rmail-send-actions-rmail-msg-number))
-			    (save-excursion
-			      (set-buffer rmail-send-actions-rmail-buffer)
-			      (if msgnum
-				  (rmail-set-attribute
-				   "forwarded" t msgnum))))))))
-	   ;; If only one window, use it for the mail buffer.
-	   ;; Otherwise, use another window for the mail buffer
-	   ;; so that the Rmail buffer remains visible
-	   ;; and sending the mail will get back to it.
-	   (and (not rmail-mail-new-frame) (one-window-p t)))
-	  ;; The mail buffer is now current.
-	  (save-excursion
-	    ;; We keep the rmail buffer and message number in these 
-	    ;; buffer-local vars in the sendmail buffer,
-	    ;; so that rmail-only-expunge can relocate the message number.
-	    (make-local-variable 'rmail-send-actions-rmail-buffer)
-	    (make-local-variable 'rmail-send-actions-rmail-msg-number)
-	    (setq rmail-send-actions-rmail-buffer forward-buffer)
-	    (setq rmail-send-actions-rmail-msg-number msgnum)
-	    ;; Insert after header separator--before signature if any.
-	    (goto-char (point-min))
-	    (search-forward-regexp
-	     (concat "^" (regexp-quote mail-header-separator) "$"))
-	    (forward-line 1)
-	    (insert "------- Start of forwarded message -------\n")
-	    ;; Quote lines with `- ' if they start with `-'.
-	    (let ((beg (point)) end)
-	      (setq end (point-marker))
-	      (set-marker-insertion-type end t)
-	      (insert-buffer-substring forward-buffer)
-	      (goto-char beg)
-	      (while (re-search-forward "^-" nil t)
-		(beginning-of-line)
-		(insert "- ")
-		(forward-line 1))
-	      (goto-char end)
-	      (skip-chars-backward "\n")
-	      (if (< (point) end)
-		  (forward-char 1))
-	      (delete-region (point) end)
-	      (set-marker end nil))
-	    (insert "------- End of forwarded message -------\n")
-	    (push-mark))))))
-
-(defun rmail-resend (address &optional from comment mail-alias-file)
-  "Resend current message to ADDRESSES.
-ADDRESSES should be a single address, a string consisting of several
-addresses separated by commas, or a list of addresses.
-
-Optional FROM is the address to resend the message from, and
-defaults to the username of the person redistributing the message.
-Optional COMMENT is a string that will be inserted as a comment in the
-resent message.
-Optional ALIAS-FILE is alternate aliases file to be used by sendmail,
-typically for purposes of moderating a list."
-  (interactive "sResend to: ")
-  (require 'sendmail)
-  (require 'mailalias)
-  (if (not from) (setq from (user-login-name)))
-  (let ((tembuf (generate-new-buffer " sendmail temp"))
-	(mail-header-separator "")
-	(case-fold-search nil)
-	(mailbuf (current-buffer)))
-    (unwind-protect
-	(save-excursion
-	  ;;>> Copy message into temp buffer
-	  (set-buffer tembuf)
-	  (insert-buffer-substring mailbuf)
-	  (goto-char (point-min))
-	  ;; Delete any Sender field, since that's not specifiable.
-	  ; Only delete Sender fields in the actual header.
-	  (re-search-forward "^$" nil 'move)
-	  ; Using "while" here rather than "if" because some buggy mail
-	  ; software may have inserted multiple Sender fields.
-	  (while (re-search-backward "^Sender:" nil t)
-	    (let (beg)
-	      (setq beg (point))
-	      (forward-line 1)
-	      (while (looking-at "[ \t]")
-		(forward-line 1))
-	      (delete-region beg (point))))
-	  ; Go back to the beginning of the buffer so the Resent- fields
-	  ; are inserted there.
-	  (goto-char (point-min))
-	  ;;>> Insert resent-from:
-	  (insert "Resent-From: " from "\n")
-	  (insert "Resent-Date: " (mail-rfc822-date) "\n")
-	  ;;>> Insert resent-to: and bcc if need be.
-	  (let ((before (point)))
-	    (if mail-self-blind
-		(insert "Resent-Bcc: " (user-login-name) "\n"))
-	    (insert "Resent-To: " (if (stringp address)
-			       address
-			     (mapconcat 'identity address ",\n\t"))
-		    "\n")
-	    ;; Expand abbrevs in the recipients.
-	    (save-excursion
-	      (if (featurep 'mailabbrev)
-		  (let ((end (point-marker))
-			(local-abbrev-table mail-abbrevs)
-			(old-syntax-table (syntax-table)))
-		    (if (and (not (vectorp mail-abbrevs))
-			     (file-exists-p mail-personal-alias-file))
-			(build-mail-abbrevs))
-		    (set-syntax-table mail-abbrev-syntax-table)
-		    (goto-char before)
-		    (while (and (< (point) end)
-				(progn (forward-word 1)
-				       (<= (point) end)))
-		      (expand-abbrev))
-		    (set-syntax-table old-syntax-table))
-		(expand-mail-aliases before (point)))))
-	  ;;>> Set up comment, if any.
-	  (if (and (sequencep comment) (not (zerop (length comment))))
-	      (let ((before (point))
-		    after)
-		(insert comment)
-		(or (eolp) (insert "\n"))
-		(setq after (point))
-		(goto-char before)
-		(while (< (point) after)
-		  (insert "Resent-Comment: ")
-		  (forward-line 1))))
-	  ;; Don't expand aliases in the destination fields
-	  ;; of the original message.
-	  (let (mail-aliases)
-	    (funcall send-mail-function)))
-      (kill-buffer tembuf))
-    (rmail-set-attribute "resent" t rmail-current-message)))
-
-(defvar mail-unsent-separator
-  (concat "^ *---+ +Unsent message follows +---+ *$\\|"
-	  "^ *---+ +Returned message +---+ *$\\|"
-	  "^Start of returned message$\\|"
-	  "^ *---+ +Original message +---+ *$\\|"
-	  "^ *--+ +begin message +--+ *$\\|"
-	  "^ *---+ +Original message follows +---+ *$\\|"
-	  "^|? *---+ +Message text follows: +---+ *|?$")
-  "A regexp that matches the separator before the text of a failed message.")
-
-(defun rmail-retry-failure ()
-  "Edit a mail message which is based on the contents of the current message.
-For a message rejected by the mail system, extract the interesting headers and
-the body of the original message.
-The variable `mail-unsent-separator' should match the string that
-delimits the returned original message.
-The variable `rmail-retry-ignored-headers' is a regular expression
-specifying headers which should not be copied into the new message."
-  (interactive)
-  (require 'mail-utils)
-  (let ((rmail-buffer (current-buffer))
-	(msgnum rmail-current-message)
-	bounce-start bounce-end bounce-indent resending)
-    (save-excursion
-      ;; Narrow down to just the quoted original message
-      (rmail-beginning-of-message)
-      (let ((case-fold-search t))
-	(if (search-forward "This is a MIME-encapsulated message\n\n--" nil t)
-	    (let ((codestring
-		   (buffer-substring (progn (beginning-of-line) (point))
-				     (progn (end-of-line) (point)))))
-	      (or (re-search-forward mail-unsent-separator nil t)
-		  (error "Cannot find beginning of header in failed message"))
-	      (or (and (search-forward codestring nil t)
-		       (search-forward "\n\n" nil t))
-		  (error "Cannot find end of Mime data in failed message"))
-	      (setq bounce-start (point))
-	      (save-excursion
-		(goto-char (point-max))
-		(search-backward codestring)
-		(setq bounce-end (point)))
-	      (or (search-forward "\n\n" nil t)
-		  (error "Cannot find end of header in failed message")))
-	  (or (re-search-forward mail-unsent-separator nil t)
-	      (error "Cannot parse this as a failure message"))
-	  (skip-chars-forward "\n")
-	  ;; Support a style of failure message in which the original
-	  ;; message is indented, and included within lines saying
-	  ;; `Start of returned message' and `End of returned message'.
-	  (if (looking-at " +Received:")
-	      (progn
-		(setq bounce-start (point))
-		(skip-chars-forward " ")
-		(setq bounce-indent (- (current-column)))
-		(goto-char (point-max))
-		(re-search-backward "^End of returned message$" nil t)
-		(setq bounce-end (point)))
-	    ;; One message contained a few random lines before the old
-	    ;; message header.  The first line of the message started with
-	    ;; two hyphens.  A blank line followed these random lines.
-	    ;; The same line beginning with two hyphens was possibly
-	    ;; marking the end of the message.
-	    (if (looking-at "^--")
-		(let ((boundary (buffer-substring-no-properties
-				 (point)
-				 (progn (end-of-line) (point)))))
-		  (search-forward "\n\n")
-		  (skip-chars-forward "\n")
-		  (setq bounce-start (point))
-		  (goto-char (point-max))
-		  (search-backward (concat "\n\n" boundary) bounce-start t)
-		  (setq bounce-end (point)))
-	      (setq bounce-start (point)
-		    bounce-end (point-max)))
-	    (or (search-forward "\n\n" nil t)
-		(error "Cannot find end of header in failed message"))
-	    ))))
-    ;; Start sending a new message; default header fields from the original.
-    ;; Turn off the usual actions for initializing the message body
-    ;; because we want to get only the text from the failure message.
-    (let ((action
-	   ;; This function will be called when the user sends the retry.
-	   ;; It will mark the bounce message as "retried".
-	   (function (lambda ()
-		       (let ((msgnum rmail-send-actions-rmail-msg-number))
-			 (save-excursion
-			   (set-buffer rmail-send-actions-rmail-buffer)
-			   (if msgnum
-			       (rmail-set-attribute "retried" t msgnum)))))))
-	  mail-signature mail-setup-hook)
-      (if (rmail-start-mail nil nil nil nil nil rmail-buffer
-			    (list (list action)))
-	  ;; Insert original text as initial text of new draft message.
-	  ;; Bind inhibit-read-only since the header delimiter
-	  ;; of the previous message was probably read-only.
-	  (let ((inhibit-read-only t))
-	    ;; We keep the rmail buffer and message number in these 
-	    ;; buffer-local vars in the sendmail buffer,
-	    ;; so that the rmail-only-expunge can relocate the message number.
-	    (make-local-variable 'rmail-send-actions-rmail-buffer)
-	    (make-local-variable 'rmail-send-actions-rmail-msg-number)
-	    (setq rmail-send-actions-rmail-buffer rmail-buffer)
-	    (setq rmail-send-actions-rmail-msg-number msgnum)
-	    (erase-buffer)
-	    (insert-buffer-substring rmail-buffer bounce-start bounce-end)
-	    (goto-char (point-min))
-	    (if bounce-indent
-		(indent-rigidly (point-min) (point-max) bounce-indent))
-	    (rmail-clear-headers rmail-retry-ignored-headers)
-	    (rmail-clear-headers "^sender:\\|^from:\\|^return-path:")
-	    (goto-char (point-min))
-	    (save-restriction
-	      (search-forward "\n\n")
-	      (forward-line -1)
-	      (narrow-to-region (point-min) (point))
-	      (setq resending (mail-fetch-field "resent-to"))
-	      (if mail-self-blind
-		  (if resending
-		      (insert "Resent-Bcc: " (user-login-name) "\n")
-		    (insert "BCC: " (user-login-name) "\n"))))
-	    (insert mail-header-separator)
-	    (mail-position-on-field (if resending "Resent-To" "To") t)
-	    (set-buffer rmail-buffer)
-	    (rmail-beginning-of-message))))))
-
-(defun rmail-summary-exists ()
-  "Non-nil iff in an RMAIL buffer and an associated summary buffer exists.
-In fact, the non-nil value returned is the summary buffer itself."
-  (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
-       rmail-summary-buffer))
-
-(defun rmail-summary-displayed ()
-  "t iff in RMAIL buffer and an associated summary buffer is displayed."
-  (and rmail-summary-buffer (get-buffer-window rmail-summary-buffer)))
-
-(defvar rmail-redisplay-summary nil
-  "*Non-nil means Rmail should show the summary when it changes.
-This has an effect only if a summary buffer exists.")
-
-(defvar rmail-summary-window-size nil
-  "*Non-nil means specify the height for an Rmail summary window.")
-
-;; Put the summary buffer back on the screen, if user wants that.
-(defun rmail-maybe-display-summary ()
-  (let ((selected (selected-window))
-	window)
-    ;; If requested, make sure the summary is displayed.
-    (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
-	 rmail-redisplay-summary
-	 (if (get-buffer-window rmail-summary-buffer 0)
-	     ;; It's already in some frame; show that one.
-	     (let ((frame (window-frame
-			   (get-buffer-window rmail-summary-buffer 0))))
-	       (make-frame-visible frame)
-	       (raise-frame frame))
-	   (display-buffer rmail-summary-buffer)))
-    ;; If requested, set the height of the summary window.
-    (and rmail-summary-buffer (buffer-name rmail-summary-buffer)
-	 rmail-summary-window-size
-	 (setq window (get-buffer-window rmail-summary-buffer))
-	 ;; Don't try to change the size if just one window in frame.
-	 (not (eq window (frame-root-window (window-frame window))))
-	 (unwind-protect 
-	     (progn
-	       (select-window window)
-	       (enlarge-window (- rmail-summary-window-size (window-height))))
-	   (select-window selected)))))
-
-;;;; *** Rmail Local Fontification ***
-
-(defun rmail-fontify-buffer-function ()
-  ;; This function's symbol is bound to font-lock-fontify-buffer-function.
-  (make-local-hook 'rmail-show-message-hook)
-  (add-hook 'rmail-show-message-hook 'rmail-fontify-message nil t)
-  ;; If we're already showing a message, fontify it now.
-  (if rmail-current-message (rmail-fontify-message))
-  ;; Prevent Font Lock mode from kicking in.
-  (setq font-lock-fontified t))
-
-(defun rmail-unfontify-buffer-function ()
-  ;; This function's symbol is bound to font-lock-fontify-unbuffer-function.
-  (let ((modified (buffer-modified-p))
-	(buffer-undo-list t) (inhibit-read-only t)
-	before-change-functions after-change-functions
-	buffer-file-name buffer-file-truename)
-    (save-restriction
-      (widen)
-      (remove-hook 'rmail-show-message-hook 'rmail-fontify-message t)
-      (remove-text-properties (point-min) (point-max) '(rmail-fontified nil))
-      (font-lock-default-unfontify-buffer)
-      (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))))
-
-(defun rmail-fontify-message ()
-  ;; Fontify the current message if it is not already fontified.
-  (if (text-property-any (point-min) (point-max) 'rmail-fontified nil)
-      (let ((modified (buffer-modified-p))
-	    (buffer-undo-list t) (inhibit-read-only t)
-	    before-change-functions after-change-functions
-	    buffer-file-name buffer-file-truename)
-	(save-excursion
-	  (save-match-data
-	    (add-text-properties (point-min) (point-max) '(rmail-fontified t))
-	    (font-lock-fontify-region (point-min) (point-max))
-	    (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil)))))))
-
-(provide 'rmail)
-
-;;; rmail.el ends here
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
deleted file mode 100644
index 2f892981d19..00000000000
--- a/lisp/mail/rmailedit.el
+++ /dev/null
@@ -1,121 +0,0 @@
-;;; rmailedit.el --- "RMAIL edit mode"  Edit the current message.
-
-;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; 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.
-
-;;; Code:
-
-(require 'rmail)
-
-(defvar rmail-edit-map nil)
-(if rmail-edit-map
-    nil
-  ;; Make a keymap that inherits text-mode-map.
-  (setq rmail-edit-map (nconc (make-sparse-keymap) text-mode-map))
-  (define-key rmail-edit-map "\C-c\C-c" 'rmail-cease-edit)
-  (define-key rmail-edit-map "\C-c\C-]" 'rmail-abort-edit))
-
-;; Rmail Edit mode is suitable only for specially formatted data.
-(put 'rmail-edit-mode 'mode-class 'special)
-
-(defun rmail-edit-mode ()
-  "Major mode for editing the contents of an RMAIL message.
-The editing commands are the same as in Text mode, together with two commands
-to return to regular RMAIL:
-  *  rmail-abort-edit cancels the changes
-     you have made and returns to RMAIL
-  *  rmail-cease-edit makes them permanent.
-\\{rmail-edit-map}"
-  (use-local-map rmail-edit-map)
-  (setq major-mode 'rmail-edit-mode)
-  (setq mode-name "RMAIL Edit")
-  (if (boundp 'mode-line-modified)
-      (setq mode-line-modified (default-value 'mode-line-modified))
-    (setq mode-line-format (default-value 'mode-line-format)))
-  (if (rmail-summary-exists)
-      (save-excursion
-	(set-buffer rmail-summary-buffer)
-	(rmail-summary-disable)))
-  (run-hooks 'text-mode-hook 'rmail-edit-mode-hook))
-
-;;;###autoload
-(defun rmail-edit-current-message ()
-  "Edit the contents of this message."
-  (interactive)
-  (rmail-edit-mode)
-  (make-local-variable 'rmail-old-text)
-  (setq rmail-old-text (buffer-substring (point-min) (point-max)))
-  (setq buffer-read-only nil)
-  (force-mode-line-update)
-  (if (and (eq (key-binding "\C-c\C-c") 'rmail-cease-edit)
-	   (eq (key-binding "\C-c\C-]") 'rmail-abort-edit))
-      (message "Editing: Type C-c C-c to return to Rmail, C-c C-] to abort")
-    (message "%s" (substitute-command-keys
-	       "Editing: Type \\[rmail-cease-edit] to return to Rmail, \\[rmail-abort-edit] to abort"))))
-
-(defun rmail-cease-edit ()
-  "Finish editing message; switch back to Rmail proper."
-  (interactive)
-  (if (rmail-summary-exists)
-      (save-excursion
-	(set-buffer rmail-summary-buffer)
-	(rmail-summary-enable)))
-  ;; Make sure buffer ends with a newline.
-  (save-excursion
-    (goto-char (point-max))
-    (if (/= (preceding-char) ?\n)
-	(insert "\n"))
-    ;; Adjust the marker that points to the end of this message.
-    (set-marker (aref rmail-message-vector (1+ rmail-current-message))
-		(point)))
-  (let ((old rmail-old-text))
-    (force-mode-line-update)
-    (rmail-mode-1)
-    (if (and (= (length old) (- (point-max) (point-min)))
-	     (string= old (buffer-substring (point-min) (point-max))))
-	()
-      (setq old nil)
-      (rmail-set-attribute "edited" t)
-      (if (boundp 'rmail-summary-vector)
-	  (progn
-	    (aset rmail-summary-vector (1- rmail-current-message) nil)
-	    (save-excursion
-	      (rmail-widen-to-current-msgbeg
-	        (function (lambda ()
-			    (forward-line 2)
-			    (if (looking-at "Summary-line: ")
-				(let ((buffer-read-only nil))
-				  (delete-region (point)
-						 (progn (forward-line 1)
-							(point))))))))
-	      (rmail-show-message))))))
-  (setq buffer-read-only t))
-
-(defun rmail-abort-edit ()
-  "Abort edit of current message; restore original contents."
-  (interactive)
-  (delete-region (point-min) (point-max))
-  (insert rmail-old-text)
-  (rmail-cease-edit)
-  (rmail-highlight-headers))
-
-;;; rmailedit.el ends here
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
deleted file mode 100644
index dfafab38e60..00000000000
--- a/lisp/mail/rmailkwd.el
+++ /dev/null
@@ -1,269 +0,0 @@
-;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs.
-
-;; Copyright (C) 1985, 1988, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; 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.
-
-;;; Code:
-
-;; Global to all RMAIL buffers.  It exists primarily for the sake of
-;; completion.  It is better to use strings with the label functions
-;; and let them worry about making the label.
-
-(defvar rmail-label-obarray (make-vector 47 0))
-
-;; Named list of symbols representing valid message attributes in RMAIL.
-
-(defconst rmail-attributes
-  (cons 'rmail-keywords
-	(mapcar (function (lambda (s) (intern s rmail-label-obarray)))
-		'("deleted" "answered" "filed" "forwarded" "unseen" "edited"
-		  "resent"))))
-
-(defconst rmail-deleted-label (intern "deleted" rmail-label-obarray))
-
-;; Named list of symbols representing valid message keywords in RMAIL.
-
-(defvar rmail-keywords)
-
-;;;###autoload
-(defun rmail-add-label (string)
-  "Add LABEL to labels associated with current RMAIL message.
-Completion is performed over known labels when reading."
-  (interactive (list (rmail-read-label "Add label")))
-  (rmail-set-label string t))
-
-;;;###autoload
-(defun rmail-kill-label (string)
-  "Remove LABEL from labels associated with current RMAIL message.
-Completion is performed over known labels when reading."
-  (interactive (list (rmail-read-label "Remove label")))
-  (rmail-set-label string nil))
-
-;;;###autoload
-(defun rmail-read-label (prompt)
-  (if (not rmail-keywords) (rmail-parse-file-keywords))
-  (let ((result
-	 (completing-read (concat prompt
-				  (if rmail-last-label
-				      (concat " (default "
-					      (symbol-name rmail-last-label)
-					      "): ")
-				    ": "))
-			  rmail-label-obarray
-			  nil
-			  nil)))
-    (if (string= result "")
-	rmail-last-label
-      (setq rmail-last-label (rmail-make-label result t)))))
-
-(defun rmail-set-label (l state &optional n)
-  (rmail-maybe-set-message-counters)
-  (if (not n) (setq n rmail-current-message))
-  (aset rmail-summary-vector (1- n) nil)
-  (let* ((attribute (rmail-attribute-p l))
-	 (keyword (and (not attribute)
-		       (or (rmail-keyword-p l)
-			   (rmail-install-keyword l))))
-	 (label (or attribute keyword)))
-    (if label
-	(let ((omax (- (buffer-size) (point-max)))
-	      (omin (- (buffer-size) (point-min)))
-	      (buffer-read-only nil)
-	      (case-fold-search t))
-	  (unwind-protect
-	      (save-excursion
-		(widen)
-		(goto-char (rmail-msgbeg n))
-		(forward-line 1)
-		(if (not (looking-at "[01],"))
-		    nil
-		  (let ((start (1+ (point)))
-			(bound))
-		    (narrow-to-region (point) (progn (end-of-line) (point)))
-		    (setq bound (point-max))
-		    (search-backward ",," nil t)
-		    (if attribute
-			(setq bound (1+ (point)))
-		      (setq start (1+ (point))))
-		    (goto-char start)
-;		    (while (re-search-forward "[ \t]*,[ \t]*" nil t)
-;		      (replace-match ","))
-;		    (goto-char start)
-		    (if (re-search-forward
-			   (concat ", " (rmail-quote-label-name label) ",")
-			   bound
-			   'move)
-			(if (not state) (replace-match ","))
-		      (if state (insert " " (symbol-name label) ",")))
-		    (if (eq label rmail-deleted-label)
-			(rmail-set-message-deleted-p n state)))))
-	    (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))
-	    (if (= n rmail-current-message) (rmail-display-labels)))))))
-
-;; Commented functions aren't used by RMAIL but might be nice for user
-;; packages that do stuff with RMAIL.  Note that rmail-message-labels-p
-;; is in rmail.el now.
-
-;(defun rmail-message-label-p (label &optional n)
-;  "Returns symbol if LABEL (attribute or keyword) on NTH or current message."
-;  (rmail-message-labels-p (or n rmail-current-message) (regexp-quote label)))
-
-;(defun rmail-parse-message-labels (&optional n)
-;  "Returns labels associated with NTH or current RMAIL message.
-;The result is a list of two lists of strings.  The first is the
-;message attributes and the second is the message keywords."
-;  (let (atts keys)
-;    (save-restriction
-;      (widen)
-;      (goto-char (rmail-msgbeg (or n rmail-current-message)))
-;      (forward-line 1)
-;      (or (looking-at "[01],") (error "Malformed label line"))
-;      (forward-char 2)
-;      (while (looking-at "[ \t]*\\([^ \t\n,]+\\),")
-;	(setq atts (cons (buffer-substring (match-beginning 1) (match-end 1))
-;			  atts))
-;	(goto-char (match-end 0)))
-;      (or (looking-at ",") (error "Malformed label line"))
-;      (forward-char 1)
-;      (while (looking-at "[ \t]*\\([^ \t\n,]+\\),")
-;	(setq keys (cons (buffer-substring (match-beginning 1) (match-end 1))
-;			 keys))
-;	(goto-char (match-end 0)))
-;      (or (looking-at "[ \t]*$") (error "Malformed label line"))
-;      (list (nreverse atts) (nreverse keys)))))
-
-(defun rmail-attribute-p (s)
-  (let ((symbol (rmail-make-label s)))
-    (if (memq symbol (cdr rmail-attributes)) symbol)))
-
-(defun rmail-keyword-p (s)
-  (let ((symbol (rmail-make-label s)))
-    (if (memq symbol (cdr (rmail-keywords))) symbol)))
-
-(defun rmail-make-label (s &optional forcep)
-  (cond ((symbolp s) s)
-	(forcep (intern (downcase s) rmail-label-obarray))
-	(t  (intern-soft (downcase s) rmail-label-obarray))))
-
-(defun rmail-force-make-label (s)
-  (intern (downcase s) rmail-label-obarray))
-
-(defun rmail-quote-label-name (label)
-  (regexp-quote (symbol-name (rmail-make-label label t))))
-
-;; Motion on messages with keywords.
-
-;;;###autoload
-(defun rmail-previous-labeled-message (n labels)
-  "Show previous message with one of the labels LABELS.
-LABELS should be a comma-separated list of label names.
-If LABELS is empty, the last set of labels specified is used.
-With prefix argument N moves backward N messages with these labels."
-  (interactive "p\nsMove to previous msg with labels: ")
-  (rmail-next-labeled-message (- n) labels))
-
-;;;###autoload
-(defun rmail-next-labeled-message (n labels)
-  "Show next message with one of the labels LABELS.
-LABELS should be a comma-separated list of label names.
-If LABELS is empty, the last set of labels specified is used.
-With prefix argument N moves forward N messages with these labels."
-  (interactive "p\nsMove to next msg with labels: ")
-  (if (string= labels "")
-      (setq labels rmail-last-multi-labels))
-  (or labels
-      (error "No labels to find have been specified previously"))
-  (setq rmail-last-multi-labels labels)
-  (rmail-maybe-set-message-counters)
-  (let ((lastwin rmail-current-message)
-	(current rmail-current-message)
-	(regexp (concat ", ?\\("
-			(mail-comma-list-regexp labels)
-			"\\),")))
-    (save-restriction
-      (widen)
-      (while (and (> n 0) (< current rmail-total-messages))
-	(setq current (1+ current))
-	(if (rmail-message-labels-p current regexp)
-	    (setq lastwin current n (1- n))))
-      (while (and (< n 0) (> current 1))
-	(setq current (1- current))
-	(if (rmail-message-labels-p current regexp)
-	    (setq lastwin current n (1+ n)))))
-    (rmail-show-message lastwin)
-    (if (< n 0)
-	(message "No previous message with labels %s" labels))
-    (if (> n 0)
-	(message "No following message with labels %s" labels))))
-
-;;; Manipulate the file's Labels option.
-
-;; Return a list of symbols for all
-;; the keywords (labels) recorded in this file's Labels option.
-(defun rmail-keywords ()
-  (or rmail-keywords (rmail-parse-file-keywords)))
-
-;; Set rmail-keywords to a list of symbols for all
-;; the keywords (labels) recorded in this file's Labels option.
-(defun rmail-parse-file-keywords ()
-  (save-restriction
-    (save-excursion
-      (widen)
-      (goto-char 1)
-      (setq rmail-keywords
-	    (if (search-forward "\nLabels:" (rmail-msgbeg 1) t)
-		(progn
-		  (narrow-to-region (point) (progn (end-of-line) (point)))
-		  (goto-char (point-min))
-		  (cons 'rmail-keywords
-			(mapcar 'rmail-force-make-label
-				(mail-parse-comma-list)))))))))
-
-;; Add WORD to the list in the file's Labels option.
-;; Any keyword used for the first time needs this done.
-(defun rmail-install-keyword (word)
-  (let ((keyword (rmail-make-label word t))
-	(keywords (rmail-keywords)))
-    (if (not (or (rmail-attribute-p keyword)
-		 (rmail-keyword-p keyword)))
-	(let ((omin (- (buffer-size) (point-min)))
-	      (omax (- (buffer-size) (point-max))))
-	  (unwind-protect
-	      (save-excursion
-		(widen)
-		(goto-char 1)
-		(let ((case-fold-search t)
-		      (buffer-read-only nil))
-		  (or (search-forward "\nLabels:" nil t)
-		      (progn
-			(end-of-line)
-			(insert "\nLabels:")))
-		  (delete-region (point) (progn (end-of-line) (point)))
-		  (setcdr keywords (cons keyword (cdr keywords)))
-		  (while (setq keywords (cdr keywords))
-		    (insert (symbol-name (car keywords)) ","))
-		  (delete-char -1)))
-	    (narrow-to-region (- (buffer-size) omin)
-			      (- (buffer-size) omax)))))
-    keyword))
-
-;;; rmailkwd.el ends here
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
deleted file mode 100644
index 98926d8117e..00000000000
--- a/lisp/mail/rmailmsc.el
+++ /dev/null
@@ -1,55 +0,0 @@
-;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; 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.
-
-;;; Code:
-
-;;;###autoload
-(defun set-rmail-inbox-list (file-name)
-  "Set the inbox list of the current RMAIL file to FILE-NAME.
-You can specify one file name, or several names separated by commas.
-If FILE-NAME is empty, remove any existing inbox list."
-  (interactive "sSet mailbox list to (comma-separated list of filenames): ")
-  (save-excursion
-    (let ((names (rmail-parse-file-inboxes))
-	  (standard-output nil))
-      (if (or (not names)
-	      (y-or-n-p (concat "Replace "
-				(mapconcat 'identity names ", ")
-				"? ")))
-	  (let ((buffer-read-only nil))
-	    (widen)
-	    (goto-char (point-min))
-	    (search-forward "\n\^_")
-	    (re-search-backward "^Mail" nil t)
-	    (forward-line 0)
-	    (if (looking-at "Mail:")
-		(delete-region (point)
-			       (progn (forward-line 1)
-				      (point))))
-	    (if (not (string= file-name ""))
-		(insert-before-markers "Mail: " file-name "\n"))))))
-  (setq rmail-inbox-list (rmail-parse-file-inboxes))
-  (rmail-show-message rmail-current-message))
-
-;;; rmailmsc.el ends here
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
deleted file mode 100644
index 29621cc955d..00000000000
--- a/lisp/mail/rmailout.el
+++ /dev/null
@@ -1,322 +0,0 @@
-;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file.
-
-;; Copyright (C) 1985, 1987, 1993, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; 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.
-
-;;; Code:
-
-(require 'rmail)
-
-;;;###autoload
-(defvar rmail-output-file-alist nil
-  "*Alist matching regexps to suggested output Rmail files.
-This is a list of elements of the form (REGEXP . NAME-EXP).
-The suggestion is taken if REGEXP matches anywhere in the message buffer.
-NAME-EXP may be a string constant giving the file name to use,
-or more generally it may be any kind of expression that returns
-a file name as a string.")
-
-;;; There are functions elsewhere in Emacs that use this function; check
-;;; them out before you change the calling method.
-;;;###autoload
-(defun rmail-output-to-rmail-file (file-name &optional count)
-  "Append the current message to an Rmail file named FILE-NAME.
-If the file does not exist, ask if it should be created.
-If file is being visited, the message is appended to the Emacs
-buffer visiting that file.
-If the file exists and is not an Rmail file, 
-the message is appended in inbox format.
-
-The default file name comes from `rmail-default-rmail-file',
-which is updated to the name you use in this command.
-
-A prefix argument N says to output N consecutive messages
-starting with the current one.  Deleted messages are skipped and don't count."
-  (interactive
-   (let ((default-file
-	   (let (answer tail)
-	     (setq tail rmail-output-file-alist)
-	     ;; Suggest a file based on a pattern match.
-	     (while (and tail (not answer))
-	       (save-excursion
-		 (goto-char (point-min))
-		 (if (re-search-forward (car (car tail)) nil t)
-		     (setq answer (eval (cdr (car tail)))))
-		 (setq tail (cdr tail))))
-	     ;; If not suggestions, use same file as last time.
-	     (or answer rmail-default-rmail-file))))
-     (list (setq rmail-default-rmail-file
-		 (let ((read-file
-			(read-file-name
-			 (concat "Output message to Rmail file: (default "
-				 (file-name-nondirectory default-file)
-				 ") ")
-			 (file-name-directory default-file)
-			 default-file)))
-		   (if (file-directory-p read-file)
-		       (expand-file-name (file-name-nondirectory default-file)
-					 read-file)
-		     (expand-file-name
-		      (or read-file default-file)
-		      (file-name-directory default-file)))))
-	   (prefix-numeric-value current-prefix-arg))))
-  (or count (setq count 1))
-  (setq file-name
-	(expand-file-name file-name
-			  (file-name-directory rmail-default-rmail-file)))
-  (if (and (file-readable-p file-name) (not (mail-file-babyl-p file-name)))
-      (rmail-output file-name count)
-    (rmail-maybe-set-message-counters)
-    (setq file-name (abbreviate-file-name file-name))
-    (or (get-file-buffer file-name)
-	(file-exists-p file-name)
-	(if (yes-or-no-p
-	     (concat "\"" file-name "\" does not exist, create it? "))
-	    (let ((file-buffer (create-file-buffer file-name)))
-	      (save-excursion
-		(set-buffer file-buffer)
-		(rmail-insert-rmail-file-header)
-		(let ((require-final-newline nil))
-		  (write-region (point-min) (point-max) file-name t 1)))
-	      (kill-buffer file-buffer))
-	  (error "Output file does not exist")))
-    (while (> count 0)
-      (let (redelete)
-	(unwind-protect
-	    (progn
-	      ;; Temporarily turn off Deleted attribute.
-	      ;; Do this outside the save-restriction, since it would
-	      ;; shift the place in the buffer where the visible text starts.
-	      (if (rmail-message-deleted-p rmail-current-message)
-		  (progn (setq redelete t)
-			 (rmail-set-attribute "deleted" nil)))
-	      (save-restriction
-		(widen)
-		;; Decide whether to append to a file or to an Emacs buffer.
-		(save-excursion
-		  (let ((buf (get-file-buffer file-name))
-			(cur (current-buffer))
-			(beg (1+ (rmail-msgbeg rmail-current-message)))
-			(end (1+ (rmail-msgend rmail-current-message))))
-		    (if (not buf)
-			;; Output to a file.
-			(if rmail-fields-not-to-output
-			    ;; Delete some fields while we output.
-			    (let ((obuf (current-buffer)))
-			      (set-buffer (get-buffer-create " rmail-out-temp"))
-			      (insert-buffer-substring obuf beg end)
-			      (rmail-delete-unwanted-fields)
-			      (append-to-file (point-min) (point-max) file-name)
-			      (set-buffer obuf)
-			      (kill-buffer (get-buffer " rmail-out-temp")))
-			  (append-to-file beg end file-name))
-		      (if (eq buf (current-buffer))
-			  (error "Can't output message to same file it's already in"))
-		      ;; File has been visited, in buffer BUF.
-		      (set-buffer buf)
-		      (let ((buffer-read-only nil)
-			    (msg (and (boundp 'rmail-current-message)
-				      rmail-current-message)))
-			;; If MSG is non-nil, buffer is in RMAIL mode.
-			(if msg
-			    (progn
-			      ;; Turn on auto save mode, if it's off in this
-			      ;; buffer but enabled by default.
-			      (and (not buffer-auto-save-file-name)
-				   auto-save-default
-				   (auto-save-mode t))
-			      (rmail-maybe-set-message-counters)
-			      (widen)
-			      (narrow-to-region (point-max) (point-max))
-			      (insert-buffer-substring cur beg end)
-			      (goto-char (point-min))
-			      (widen)
-			      (search-backward "\n\^_")
-			      (narrow-to-region (point) (point-max))
-			      (rmail-delete-unwanted-fields)
-			      (rmail-count-new-messages t)
-			      (if (rmail-summary-exists)
-				  (rmail-select-summary
-				    (rmail-update-summary)))
-			      (rmail-show-message msg))
-		;; Output file not in rmail mode => just insert at the end.
-		(narrow-to-region (point-min) (1+ (buffer-size)))
-		(goto-char (point-max))
-		(insert-buffer-substring cur beg end)
-		(rmail-delete-unwanted-fields)))))))
-	      (rmail-set-attribute "filed" t))
-	  (if redelete (rmail-set-attribute "deleted" t))))
-      (setq count (1- count))
-      (if rmail-delete-after-output
-	  (rmail-delete-forward)
-	(if (> count 0)
-	    (rmail-next-undeleted-message 1))))))
-
-;;;###autoload
-(defvar rmail-fields-not-to-output nil
-  "*Regexp describing fields to exclude when outputting a message to a file.")
-
-;; Delete from the buffer header fields we don't want output.
-;; NOT-RMAIL if t means this buffer does not have the full header
-;; and *** EOOH *** that a message in an Rmail file has.
-(defun rmail-delete-unwanted-fields (&optional not-rmail)
-  (if rmail-fields-not-to-output 
-      (save-excursion
-	(goto-char (point-min))
-	;; Find the end of the header.
-	(if (and (or not-rmail (search-forward "\n*** EOOH ***\n" nil t))
-		 (search-forward "\n\n" nil t))
-	    (let ((end (point-marker)))
-	      (goto-char (point-min))
-	      (while (re-search-forward rmail-fields-not-to-output end t)
-		(beginning-of-line)
-		(delete-region (point)
-			       (progn (forward-line 1) (point)))))))))
-
-;;; There are functions elsewhere in Emacs that use this function; check
-;;; them out before you change the calling method.
-;;;###autoload
-(defun rmail-output (file-name &optional count noattribute from-gnus)
-  "Append this message to system-inbox-format mail file named FILE-NAME.
-A prefix argument N says to output N consecutive messages
-starting with the current one.  Deleted messages are skipped and don't count.
-When called from lisp code, N may be omitted.
-
-If the pruned message header is shown on the current message, then
-messages will be appended with pruned headers; otherwise, messages
-will be appended with their original headers.
-
-The default file name comes from `rmail-default-file',
-which is updated to the name you use in this command.
-
-The optional third argument NOATTRIBUTE, if non-nil, says not
-to set the `filed' attribute, and not to display a message.
-
-The optional fourth argument FROM-GNUS is set when called from GNUS."
-  (interactive
-   (let ((default-file
-	   (let (answer tail)
-	     (setq tail rmail-output-file-alist)
-	     ;; Suggest a file based on a pattern match.
-	     (while (and tail (not answer))
-	       (save-excursion
-		 (goto-char (point-min))
-		 (if (re-search-forward (car (car tail)) nil t)
-		     (setq answer (eval (cdr (car tail)))))
-		 (setq tail (cdr tail))))
-	     ;; If not suggestions, use same file as last time.
-	     (or answer rmail-default-file))))
-     (list (setq rmail-default-file
-		 (let ((read-file
-			(read-file-name
-			 (concat "Output message to Unix mail file: (default "
-				 (file-name-nondirectory default-file)
-				 ") ")
-			 (file-name-directory default-file)
-			 default-file)))
-		   (if (file-directory-p read-file)
-		       (expand-file-name (file-name-nondirectory default-file)
-					 read-file)
-		     (expand-file-name
-		      (or read-file default-file)
-		      (file-name-directory default-file)))))
-	   (prefix-numeric-value current-prefix-arg))))
-  (or count (setq count 1))
-  (setq file-name
-	(expand-file-name file-name
-			  (and rmail-default-file
-			       (file-name-directory rmail-default-file))))
-  (if (and (file-readable-p file-name) (mail-file-babyl-p file-name))
-      (rmail-output-to-rmail-file file-name count)
-    (let ((orig-count count)
-	  (rmailbuf (current-buffer))
-	  (case-fold-search t)
-	  (tembuf (get-buffer-create " rmail-output"))
-	  (original-headers-p
-	   (and (not from-gnus)
-		(save-excursion 
-		  (save-restriction
-		    (narrow-to-region (rmail-msgbeg rmail-current-message) (point-max))
-		    (goto-char (point-min))
-		    (forward-line 1)
-		    (= (following-char) ?0)))))
-	  header-beginning
-	  mail-from)
-      (while (> count 0)
-	(or from-gnus
-	    (setq mail-from
-		  (save-excursion
-		    (save-restriction
-		      (widen)
-		      (goto-char (rmail-msgbeg rmail-current-message))
-		      (setq header-beginning (point))
-		      (search-forward "\n*** EOOH ***\n")
-		      (narrow-to-region header-beginning (point))
-		      (mail-fetch-field "Mail-From")))))
-	(save-excursion
-	  (set-buffer tembuf)
-	  (erase-buffer)
-	  (insert-buffer-substring rmailbuf)
-	  (rmail-delete-unwanted-fields t)
-	  (insert "\n")
-	  (goto-char (point-min))
-	  (if mail-from
-	      (insert mail-from "\n")
-	    (insert "From "
-		    (mail-strip-quoted-names (or (mail-fetch-field "from")
-						 (mail-fetch-field "really-from")
-						 (mail-fetch-field "sender")
-						 "unknown"))
-		    " " (current-time-string) "\n"))
-	  ;; ``Quote'' "\nFrom " as "\n>From "
-	  ;;  (note that this isn't really quoting, as there is no requirement
-	  ;;   that "\n[>]+From " be quoted in the same transparent way.)
-	  (let ((case-fold-search nil))
-	    (while (search-forward "\nFrom " nil t)
-	      (forward-char -5)
-	      (insert ?>)))
-	  (write-region (point-min) (point-max) file-name t
-			(if noattribute 'nomsg)))
-	(or noattribute
-	    (if (equal major-mode 'rmail-mode)
-		(rmail-set-attribute "filed" t)))
-	(setq count (1- count))
-	(or from-gnus
-	    (let ((next-message-p
-		   (if rmail-delete-after-output
-		       (rmail-delete-forward)
-		     (if (> count 0)
-			 (rmail-next-undeleted-message 1))))
-		  (num-appended (- orig-count count)))
-	      (if (and next-message-p original-headers-p)
-		  (rmail-toggle-header))
-	      (if (and (> count 0) (not next-message-p))
-		  (progn 
-		    (error
-		     (save-excursion
-		       (set-buffer rmailbuf)
-		       (format "Only %d message%s appended" num-appended
-			       (if (= num-appended 1) "" "s"))))
-		    (setq count 0))))))
-      (kill-buffer tembuf))))
-
-;;; rmailout.el ends here
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
deleted file mode 100644
index 4066890fea9..00000000000
--- a/lisp/mail/rmailsort.el
+++ /dev/null
@@ -1,245 +0,0 @@
-;;; rmailsort.el --- Rmail: sort messages.
-
-;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Version: $Header: /home/fsf/rms/e19/lisp/RCS/rmailsort.el,v 1.24 1996/01/20 07:41:37 kwzh Exp rms $
-;; Keywords: mail
-
-;; 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.
-
-;;; Code:
-
-(require 'sort)
-
-;; For rmail-select-summary
-(require 'rmail)
-
-(autoload 'timezone-make-date-sortable "timezone")
-
-;; Sorting messages in Rmail buffer
-
-;;;###autoload
-(defun rmail-sort-by-date (reverse)
-  "Sort messages of current Rmail file by date.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-messages reverse
-		       (function
-			(lambda (msg)
-			  (rmail-make-date-sortable
-			   (rmail-fetch-field msg "Date"))))))
-
-;;;###autoload
-(defun rmail-sort-by-subject (reverse)
-  "Sort messages of current Rmail file by subject.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-messages reverse
-		       (function
-			(lambda (msg)
-			  (let ((key (or (rmail-fetch-field msg "Subject") ""))
-				(case-fold-search t))
-			    ;; Remove `Re:'
-			    (if (string-match "^\\(re:[ \t]*\\)*" key)
-				(substring key (match-end 0))
-			      key))))))
-
-;;;###autoload
-(defun rmail-sort-by-author (reverse)
-  "Sort messages of current Rmail file by author.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-messages reverse
-		       (function
-			(lambda (msg)
-			  (downcase	;Canonical name
-			   (mail-strip-quoted-names
-			    (or (rmail-fetch-field msg "From")
-				(rmail-fetch-field msg "Sender") "")))))))
-
-;;;###autoload
-(defun rmail-sort-by-recipient (reverse)
-  "Sort messages of current Rmail file by recipient.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-messages reverse
-		       (function
-			(lambda (msg)
-			  (downcase	;Canonical name
-			   (mail-strip-quoted-names
-			    (or (rmail-fetch-field msg "To")
-				(rmail-fetch-field msg "Apparently-To") "")
-			    ))))))
-
-;;;###autoload
-(defun rmail-sort-by-correspondent (reverse)
-  "Sort messages of current Rmail file by other correspondent.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-messages reverse
-		       (function
-			(lambda (msg)
-			  (rmail-select-correspondent
-			   msg
-			   '("From" "Sender" "To" "Apparently-To"))))))
-
-(defun rmail-select-correspondent (msg fields)
-  (let ((ans ""))
-    (while (and fields (string= ans ""))
-      (setq ans
-	    (rmail-dont-reply-to
-	     (mail-strip-quoted-names
-	      (or (rmail-fetch-field msg (car fields)) ""))))
-      (setq fields (cdr fields)))
-    ans))
-
-;;;###autoload
-(defun rmail-sort-by-lines (reverse)
-  "Sort messages of current Rmail file by number of lines.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-messages reverse
-		       (function
-			(lambda (msg)
-			  (count-lines (rmail-msgbeg msg)
-				       (rmail-msgend msg))))))
-
-;;;###autoload
-(defun rmail-sort-by-keywords (reverse labels)
-  "Sort messages of current Rmail file by labels.
-If prefix argument REVERSE is non-nil, sort them in reverse order.
-KEYWORDS is a comma-separated list of labels."
-  (interactive "P\nsSort by labels: ")
-  (or (string-match "[^ \t]" labels)
-      (error "No labels specified"))
-  (setq labels (concat (substring labels (match-beginning 0)) ","))
-  (let (labelvec)
-    (while (string-match "[ \t]*,[ \t]*" labels)
-      (setq labelvec (cons 
-		      (concat ", ?\\("
-			      (substring labels 0 (match-beginning 0))
-			      "\\),")
-		      labelvec))
-      (setq labels (substring labels (match-end 0))))
-    (setq labelvec (apply 'vector (nreverse labelvec)))
-    (rmail-sort-messages reverse
-			 (function
-			  (lambda (msg)
-			    (let ((n 0))
-			      (while (and (< n (length labelvec))
-					  (not (rmail-message-labels-p
-						msg (aref labelvec n))))
-				(setq n (1+ n)))
-			      n))))))
-
-;; Basic functions
-
-(defun rmail-sort-messages (reverse keyfun)
-  "Sort messages of current Rmail file.
-If 1st argument REVERSE is non-nil, sort them in reverse order.
-2nd argument KEYFUN is called with a message number, and should return a key."
-  (save-excursion
-    ;; If we are in a summary buffer, operate on the Rmail buffer.
-    (if (eq major-mode 'rmail-summary-mode)
-	(set-buffer rmail-buffer))
-    (let ((buffer-read-only nil)
-	  (predicate nil)			;< or string-lessp
-	  (sort-lists nil))
-      (message "Finding sort keys...")
-      (widen)
-      (let ((msgnum 1))
-	(while (>= rmail-total-messages msgnum)
-	  (setq sort-lists
-		(cons (list (funcall keyfun msgnum) ;Make sorting key
-			    (eq rmail-current-message msgnum) ;True if current
-			    (aref rmail-message-vector msgnum)
-			    (aref rmail-message-vector (1+ msgnum)))
-		      sort-lists))
-	  (if (zerop (% msgnum 10))
-	      (message "Finding sort keys...%d" msgnum))
-	  (setq msgnum (1+ msgnum))))
-      (or reverse (setq sort-lists (nreverse sort-lists)))
-      ;; Decide predicate: < or string-lessp
-      (if (numberp (car (car sort-lists))) ;Is a key numeric?
-	  (setq predicate (function <))
-	(setq predicate (function string-lessp)))
-      (setq sort-lists
-	    (sort sort-lists
-		  (function
-		   (lambda (a b)
-		     (funcall predicate (car a) (car b))))))
-      (if reverse (setq sort-lists (nreverse sort-lists)))
-      ;; Now we enter critical region.  So, keyboard quit is disabled.
-      (message "Reordering messages...")
-      (let ((inhibit-quit t)		;Inhibit quit
-	    (current-message nil)
-	    (msgnum 1)
-	    (msginfo nil))
-	;; There's little hope that we can easily undo after that.
-	(buffer-disable-undo (current-buffer))
-	(goto-char (rmail-msgbeg 1))
-	;; To force update of all markers.
-	(insert-before-markers ?Z)
-	(backward-char 1)
-	;; Now reorder messages.
-	(while sort-lists
-	  (setq msginfo (car sort-lists))
-	  ;; Swap two messages.
-	  (insert-buffer-substring
-	   (current-buffer) (nth 2 msginfo) (nth 3 msginfo))
-	  (delete-region  (nth 2 msginfo) (nth 3 msginfo))
-	  ;; Is current message?
-	  (if (nth 1 msginfo)
-	      (setq current-message msgnum))
-	  (setq sort-lists (cdr sort-lists))
-	  (if (zerop (% msgnum 10))
-	      (message "Reordering messages...%d" msgnum))
-	  (setq msgnum (1+ msgnum)))
-	;; Delete the garbage inserted before.
-	(delete-char 1)
-	(setq quit-flag nil)
-	(buffer-enable-undo)
-	(rmail-set-message-counters)
-	(rmail-show-message current-message)
-	(if (rmail-summary-exists)
-	    (rmail-select-summary
-	     (rmail-update-summary)))))))
-
-(defun rmail-fetch-field (msg field)
-  "Return the value of the header FIELD of MSG.
-Arguments are MSG and FIELD."
-  (save-restriction
-    (widen)
-    (let ((next (rmail-msgend msg)))
-      (goto-char (rmail-msgbeg msg))
-      (narrow-to-region (if (search-forward "\n*** EOOH ***\n" next t)
-			    (point)
-			  (forward-line 1)
-			  (point))
-			(progn (search-forward "\n\n" nil t) (point)))
-      (mail-fetch-field field))))
-
-(defun rmail-make-date-sortable (date)
-  "Make DATE sortable using the function string-lessp."
-  ;; Assume the default time zone is GMT.
-  (timezone-make-date-sortable date "GMT" "GMT"))
-
-(provide 'rmailsort)
-
-;;; rmailsort.el ends here
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
deleted file mode 100644
index 9c04ef524cf..00000000000
--- a/lisp/mail/rmailsum.el
+++ /dev/null
@@ -1,1531 +0,0 @@
-;;; rmailsum.el --- make summary buffers for the mail reader
-
-;; Copyright (C) 1985, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; 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:
-
-;; Extended by Bob Weiner of Motorola
-;;   Provided all commands from rmail-mode in rmail-summary-mode and made key
-;;   bindings in both modes wholly compatible.
-
-;;; Code:
-
-;; For rmail-select-summary
-(require 'rmail)
-
-;;;###autoload
-(defvar rmail-summary-scroll-between-messages t
-  "*Non-nil means Rmail summary scroll commands move between messages.")
-
-;;;###autoload
-(defvar rmail-summary-line-count-flag t
-  "*Non-nil if Rmail summary should show the number of lines in each message.")
-
-(defvar rmail-summary-font-lock-keywords
-  '(("^....D.*" . font-lock-string-face)			; Deleted.
-    ("^....-.*" . font-lock-type-face)				; Unread.
-    ;; Neither of the below will be highlighted if either of the above are:
-    ("^....[^D-] \\(......\\)" 1 font-lock-keyword-face)	; Date.
-    ("{ \\([^}]+\\),}" 1 font-lock-comment-face))		; Labels.
-  "Additional expressions to highlight in Rmail Summary mode.")
-
-;; Entry points for making a summary buffer.
-
-;; Regenerate the contents of the summary
-;; using the same selection criterion as last time.
-;; M-x revert-buffer in a summary buffer calls this function.
-(defun rmail-update-summary (&rest ignore)
-  (apply (car rmail-summary-redo) (cdr rmail-summary-redo)))
-
-;;;###autoload
-(defun rmail-summary ()
-  "Display a summary of all messages, one line per message."
-  (interactive)
-  (rmail-new-summary "All" '(rmail-summary) nil))
-
-;;;###autoload
-(defun rmail-summary-by-labels (labels)
-  "Display a summary of all messages with one or more LABELS.
-LABELS should be a string containing the desired labels, separated by commas."
-  (interactive "sLabels to summarize by: ")
-  (if (string= labels "")
-      (setq labels (or rmail-last-multi-labels
-		       (error "No label specified"))))
-  (setq rmail-last-multi-labels labels)
-  (rmail-new-summary (concat "labels " labels)
-		     (list 'rmail-summary-by-labels labels)
-		     'rmail-message-labels-p
-		     (concat ", \\(" (mail-comma-list-regexp labels) "\\),")))
-
-;;;###autoload
-(defun rmail-summary-by-recipients (recipients &optional primary-only)
-  "Display a summary of all messages with the given RECIPIENTS.
-Normally checks the To, From and Cc fields of headers;
-but if PRIMARY-ONLY is non-nil (prefix arg given),
- only look in the To and From fields.
-RECIPIENTS is a string of regexps separated by commas."
-  (interactive "sRecipients to summarize by: \nP")
-  (rmail-new-summary
-   (concat "recipients " recipients)
-   (list 'rmail-summary-by-recipients recipients primary-only)
-   'rmail-message-recipients-p
-   (mail-comma-list-regexp recipients) primary-only))
-
-;;;###autoload
-(defun rmail-summary-by-regexp (regexp)
-  "Display a summary of all messages according to regexp REGEXP.
-If the regular expression is found in the header of the message
-\(including in the date and other lines, as well as the subject line),
-Emacs will list the header line in the RMAIL-summary."
-  (interactive "sRegexp to summarize by: ")
-  (if (string= regexp "")
-      (setq regexp (or rmail-last-regexp
-			 (error "No regexp specified."))))
-  (setq rmail-last-regexp regexp)
-  (rmail-new-summary (concat "regexp " regexp)
-		     (list 'rmail-summary-by-regexp regexp)
-		     'rmail-message-regexp-p
-                     regexp))
-
-;; rmail-summary-by-topic
-;; 1989 R.A. Schnitzler
-
-;;;###autoload
-(defun rmail-summary-by-topic (subject &optional whole-message)
-  "Display a summary of all messages with the given SUBJECT.
-Normally checks the Subject field of headers;
-but if WHOLE-MESSAGE is non-nil (prefix arg given), 
- look in the whole message.
-SUBJECT is a string of regexps separated by commas."
-  (interactive "sTopics to summarize by: \nP")
-  (rmail-new-summary
-   (concat "about " subject)
-   (list 'rmail-summary-by-topic subject whole-message)
-   'rmail-message-subject-p
-   (mail-comma-list-regexp subject) whole-message))
-
-(defun rmail-message-subject-p (msg subject &optional whole-message)
-  (save-restriction
-    (goto-char (rmail-msgbeg msg))
-    (search-forward "\n*** EOOH ***\n")
-    (narrow-to-region
-     (point)
-     (progn (search-forward (if whole-message "\^_" "\n\n")) (point)))
-    (goto-char (point-min))
-    (if whole-message (re-search-forward subject nil t)
-      (string-match subject (or (mail-fetch-field "Subject") "")) )))
-
-;;;###autoload
-(defun rmail-summary-by-senders (senders)
-  "Display a summary of all messages with the given SENDERS.
-SENDERS is a string of names separated by commas."
-  (interactive "sSenders to summarize by: ")
-  (rmail-new-summary
-   (concat "senders " senders)
-   (list 'rmail-summary-by-senders senders)
-   'rmail-message-senders-p
-   (mail-comma-list-regexp senders)))
-
-(defun rmail-message-senders-p (msg senders)
-  (save-restriction
-    (goto-char (rmail-msgbeg msg))
-    (search-forward "\n*** EOOH ***\n")
-    (narrow-to-region (point) (progn (search-forward "\n\n") (point)))
-    (string-match senders (or (mail-fetch-field "From") ""))))
-
-;; General making of a summary buffer.
-
-(defvar rmail-summary-symbol-number 0)
-
-(defun rmail-new-summary (description redo-form function &rest args)
-  "Create a summary of selected messages.
-DESCRIPTION makes part of the mode line of the summary buffer.
-For each message, FUNCTION is applied to the message number and ARGS...
-and if the result is non-nil, that message is included.
-nil for FUNCTION means all messages."
-  (message "Computing summary lines...")
-  (let (sumbuf mesg was-in-summary)
-    (save-excursion
-      ;; Go to the Rmail buffer.
-      (if (eq major-mode 'rmail-summary-mode)
-	  (progn
-	    (setq was-in-summary t)
-	    (set-buffer rmail-buffer)))
-      ;; Find its summary buffer, or make one.
-      (setq sumbuf
-	    (if (and rmail-summary-buffer
-		     (buffer-name rmail-summary-buffer))
-		rmail-summary-buffer
-	      (generate-new-buffer (concat (buffer-name) "-summary"))))
-      (setq mesg rmail-current-message)
-      ;; Filter the messages; make or get their summary lines.
-      (let ((summary-msgs ())
-	    (new-summary-line-count 0))
-	(let ((msgnum 1)
-	      (buffer-read-only nil)
-	      (old-min (point-min-marker))
-	      (old-max (point-max-marker)))
-	  ;; Can't use save-restriction here; that doesn't work if we
-	  ;; plan to modify text outside the original restriction.
-	  (save-excursion
-	    (widen)
-	    (goto-char (point-min))
-	    (while (>= rmail-total-messages msgnum)
-	      (if (or (null function)
-		      (apply function (cons msgnum args)))
-		  (setq summary-msgs
-			(cons (cons msgnum (rmail-make-summary-line msgnum))
-			      summary-msgs)))
-	      (setq msgnum (1+ msgnum)))
-	    (setq summary-msgs (nreverse summary-msgs)))
-	  (narrow-to-region old-min old-max))
-	;; Temporarily, while summary buffer is unfinished,
-	;; we "don't have" a summary.
-	(setq rmail-summary-buffer nil)
-	(save-excursion
-	  (let ((rbuf (current-buffer))
-		(total rmail-total-messages))
-	    (set-buffer sumbuf)
-	    ;; Set up the summary buffer's contents.
-	    (let ((buffer-read-only nil))
-	      (erase-buffer)
-	      (while summary-msgs
-		(princ (cdr (car summary-msgs)) sumbuf)
-		(setq summary-msgs (cdr summary-msgs)))
-	      (goto-char (point-min)))
-	    ;; Set up the rest of its state and local variables.
-	    (setq buffer-read-only t)
-	    (rmail-summary-mode)
-	    (make-local-variable 'minor-mode-alist)
-	    (setq minor-mode-alist (list (list t (concat ": " description))))
-	    (setq rmail-buffer rbuf
-		  rmail-summary-redo redo-form
-		  rmail-total-messages total))))
-      (setq rmail-summary-buffer sumbuf))
-    ;; Now display the summary buffer and go to the right place in it.
-    (or was-in-summary
-	(progn
-	  (if (and (one-window-p)
-		   pop-up-windows (not pop-up-frames))
-	      ;; If there is just one window, put the summary on the top.
-	      (progn
-		(split-window (selected-window) rmail-summary-window-size)
-		(select-window (next-window (frame-first-window)))
-		(pop-to-buffer sumbuf)
-		;; If pop-to-buffer did not use that window, delete that
-		;; window.  (This can happen if it uses another frame.)
-		(if (not (eq sumbuf (window-buffer (frame-first-window))))
-		    (delete-other-windows)))
-	    (pop-to-buffer sumbuf))
-	  (set-buffer rmail-buffer)
-	  ;; This is how rmail makes the summary buffer reappear.
-	  ;; We do this here to make the window the proper size.
-	  (rmail-select-summary nil)
-	  (set-buffer rmail-summary-buffer)))
-    (rmail-summary-goto-msg mesg t t)
-    (rmail-summary-construct-io-menu)
-    (message "Computing summary lines...done")))
-
-;; Low levels of generating a summary.
-
-(defun rmail-make-summary-line (msg)
-  (let ((line (or (aref rmail-summary-vector (1- msg))
-		  (progn
-		    (setq new-summary-line-count
-			  (1+ new-summary-line-count))
-		    (if (zerop (% new-summary-line-count 10))
-			(message "Computing summary lines...%d"
-				 new-summary-line-count))
-		    (rmail-make-summary-line-1 msg)))))
-    ;; Fix up the part of the summary that says "deleted" or "unseen".
-    (aset line 4
-	  (if (rmail-message-deleted-p msg) ?\D
-	    (if (= ?0 (char-after (+ 3 (rmail-msgbeg msg))))
-		?\- ?\ )))
-    line))
-
-(defun rmail-make-summary-line-1 (msg)
-  (goto-char (rmail-msgbeg msg))
-  (let* ((lim (save-excursion (forward-line 2) (point)))
-	 pos
-	 (labels
-	  (progn
-	    (forward-char 3)
-	    (concat
-;	     (if (save-excursion (re-search-forward ",answered," lim t))
-;		 "*" "")
-;	     (if (save-excursion (re-search-forward ",filed," lim t))
-;		 "!" "")
-	     (if (progn (search-forward ",,") (eolp))
-		 ""
-	       (concat "{"
-		       (buffer-substring (point)
-					 (progn (end-of-line) (point)))
-		       "} ")))))
-	 (line
-	  (progn
-	    (forward-line 1)
-	    (if (looking-at "Summary-line: ")
-		(progn
-		  (goto-char (match-end 0))
-		  (setq line
-			(buffer-substring (point)
-					  (progn (forward-line 1) (point)))))))))
-    ;; Obsolete status lines lacking a # should be flushed.
-    (and line
-	 (not (string-match "#" line))
-	 (progn
-	   (delete-region (point)
-			  (progn (forward-line -1) (point)))
-	   (setq line nil)))
-    ;; If we didn't get a valid status line from the message,
-    ;; make a new one and put it in the message.
-    (or line
-	(let* ((case-fold-search t)
-	       (next (rmail-msgend msg))
-	       (beg (if (progn (goto-char (rmail-msgbeg msg))
-			       (search-forward "\n*** EOOH ***\n" next t))
-			(point)
-		      (forward-line 1)
-		      (point)))
-	       (end (progn (search-forward "\n\n" nil t) (point))))
-	  (save-restriction
-	    (narrow-to-region beg end)
-	    (goto-char beg)
-	    (setq line (rmail-make-basic-summary-line)))
-	  (goto-char (rmail-msgbeg msg))
-	  (forward-line 2)
-	  (insert "Summary-line: " line)))
-    (setq pos (string-match "#" line))
-    (aset rmail-summary-vector (1- msg)
-	  (concat (format "%4d  " msg)
-		  (substring line 0 pos)
-		  labels
-		  (substring line (1+ pos))))))
-
-(defun rmail-make-basic-summary-line ()
-  (goto-char (point-min))
-  (concat (save-excursion
-	    (if (not (re-search-forward "^Date:" nil t))
-		"      "
-	      (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)"
-		      (save-excursion (end-of-line) (point)) t)
-		     (format "%2d-%3s"
-			     (string-to-int (buffer-substring
-					     (match-beginning 2)
-					     (match-end 2)))
-			     (buffer-substring
-			      (match-beginning 4) (match-end 4))))
-		    ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)"
-		      (save-excursion (end-of-line) (point)) t)
-		     (format "%2d-%3s"
-			     (string-to-int (buffer-substring
-					     (match-beginning 4)
-					     (match-end 4)))
-			     (buffer-substring
-			      (match-beginning 2) (match-end 2))))
-		    ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)"
-		      (save-excursion (end-of-line) (point)) t)
-		     (format "%2s%2s%2s"
-			     (buffer-substring
-			      (match-beginning 2) (match-end 2))
-			     (buffer-substring
-			      (match-beginning 3) (match-end 3))
-			     (buffer-substring
-			      (match-beginning 4) (match-end 4))))
-		    (t "??????"))))
-	  "  "
-	  (save-excursion
-	    (if (not (re-search-forward "^From:[ \t]*" nil t))
-		"                         "
-	      (let* ((from (mail-strip-quoted-names
-			    (buffer-substring
-			     (1- (point))
-			     ;; Get all the lines of the From field
-			     ;; so that we get a whole comment if there is one,
-			     ;; so that mail-strip-quoted-names can discard it.
-			     (let ((opoint (point)))
-			       (while (progn (forward-line 1)
-					     (looking-at "[ \t]")))
-			       ;; Back up over newline, then trailing spaces or tabs
-			       (forward-char -1)
-			       (skip-chars-backward " \t")
-			       (point)))))
-                     len mch lo)
-		(if (string-match (concat "^\\("
-					  (regexp-quote (user-login-name))
-					  "\\($\\|@\\)\\|"
-					  (regexp-quote
-					   ;; Don't lose if run from init file
-					   ;; where user-mail-address is not
-					   ;; set yet.
-					   (or user-mail-address
-					       (concat (user-login-name) "@"
-						       (or mail-host-address
-							   (system-name)))))
-					  "\\>\\)")
-				  from)
-		    (save-excursion
-		      (goto-char (point-min))
-		      (if (not (re-search-forward "^To:[ \t]*" nil t))
-			  nil
-			(setq from
-			      (concat "to: "
-				      (mail-strip-quoted-names
-				       (buffer-substring
-					(point)
-					(progn (end-of-line)
-					       (skip-chars-backward " \t")
-					       (point)))))))))
-		(setq len (length from))
-		(setq mch (string-match "[@%]" from))
-		(format "%25s"
-			(if (or (not mch) (<= len 25))
-			    (substring from (max 0 (- len 25)))
-			  (substring from
-				     (setq lo (cond ((< (- mch 14) 0) 0)
-						    ((< len (+ mch 11))
-						     (- len 25))
-						    (t (- mch 14))))
-				     (min len (+ lo 25))))))))
-          (if rmail-summary-line-count-flag
-	      (save-excursion
-		(save-restriction
-		  (widen)
-		  (let ((beg (rmail-msgbeg msgnum))
-			(end (rmail-msgend msgnum))
-			lines)
-		    (save-excursion
-		      (goto-char beg)
-		      ;; Count only lines in the reformatted header,
-		      ;; if we have reformatted it.
-		      (search-forward "\n*** EOOH ***\n" end t)
-		      (setq lines (count-lines (point) end)))
-		    (format (cond
-			     ((<= lines     9) "   [%d]")
-			     ((<= lines    99) "  [%d]")
-			     ((<= lines   999) " [%3d]")
-			     (t		    "[%d]"))
-			    lines))))
-            " ")
-	  " #"				;The # is part of the format.
-	  (if (re-search-forward "^Subject:" nil t)
-	      (progn (skip-chars-forward " \t")
-		     (buffer-substring (point)
-				       (progn (end-of-line)
-					      (point))))
-	    (re-search-forward "[\n][\n]+" nil t)
-	    (buffer-substring (point) (progn (end-of-line) (point))))
-	  "\n"))
-
-;; Simple motion in a summary buffer.
-
-(defun rmail-summary-next-all (&optional number)
-  (interactive "p")
-  (forward-line (if number number 1))
-  ;; It doesn't look nice to move forward past the last message line.
-  (and (eobp) (> number 0)
-       (forward-line -1))
-  (display-buffer rmail-buffer))
-
-(defun rmail-summary-previous-all (&optional number)
-  (interactive "p")
-  (forward-line (- (if number number 1)))
-  ;; It doesn't look nice to move forward past the last message line.
-  (and (eobp) (< number 0)
-       (forward-line -1))
-  (display-buffer rmail-buffer))
-
-(defun rmail-summary-next-msg (&optional number)
-  "Display next non-deleted msg from rmail file.
-With optional prefix argument NUMBER, moves forward this number of non-deleted
-messages, or backward if NUMBER is negative."
-  (interactive "p")
-  (forward-line 0)
-  (and (> number 0) (end-of-line))
-  (let ((count (if (< number 0) (- number) number))
-	(search (if (> number 0) 're-search-forward 're-search-backward))
-	(non-del-msg-found nil))
-    (while (and (> count 0) (setq non-del-msg-found
-				  (or (funcall search "^....[^D]" nil t)
-				      non-del-msg-found)))
-      (setq count (1- count))))
-  (beginning-of-line)
-  (display-buffer rmail-buffer))
-
-(defun rmail-summary-previous-msg (&optional number)
-  (interactive "p")
-  (rmail-summary-next-msg (- (if number number 1))))
-
-(defun rmail-summary-next-labeled-message (n labels)
-  "Show next message with LABEL.  Defaults to last labels used.
-With prefix argument N moves forward N messages with these labels."
-  (interactive "p\nsMove to next msg with labels: ")
-  (let (msg)
-    (save-excursion
-      (set-buffer rmail-buffer)
-      (rmail-next-labeled-message n labels)
-      (setq msg rmail-current-message))
-    (rmail-summary-goto-msg msg)))
-
-(defun rmail-summary-previous-labeled-message (n labels)
-  "Show previous message with LABEL.  Defaults to last labels used.
-With prefix argument N moves backward N messages with these labels."
-  (interactive "p\nsMove to previous msg with labels: ")
-  (let (msg)
-    (save-excursion
-      (set-buffer rmail-buffer)
-      (rmail-previous-labeled-message n labels)
-      (setq msg rmail-current-message))
-    (rmail-summary-goto-msg msg)))
-
-(defun rmail-summary-next-same-subject (n)
-  "Go to the next message in the summary having the same subject.
-With prefix argument N, do this N times.
-If N is negative, go backwards."
-  (interactive "p")
-  (let (subject search-regexp  i found
-	(forward (> n 0)))
-    (save-excursion
-      (set-buffer rmail-buffer)
-      (setq subject (mail-fetch-field "Subject"))
-      (setq i rmail-current-message))
-    (if (string-match "Re:[ \t]*" subject)
-	(setq subject (substring subject (match-end 0))))
-    (setq search-regexp (concat "^Subject: *\\(Re: *\\)?"
-				(regexp-quote subject)
-				"\n"))
-    (save-excursion
-      (while (and (/= n 0)
-		  (if forward
-		      (not (eobp))
-		    (not (bobp))))
-	(let (done)
-	  (while (and (not done)
-		      (if forward
-			  (not (eobp))
-			(not (bobp))))
-	    ;; Advance thru summary.
-	    (forward-line (if forward 1 -1))
-	    ;; Get msg number of this line.
-	    (setq i (string-to-int
-		     (buffer-substring (point)
-				       (min (point-max) (+ 5 (point))))))
-	    ;; See if that msg has desired subject.
-	    (save-excursion
-	      (set-buffer rmail-buffer)
-	      (save-restriction
-		(widen)
-		(goto-char (rmail-msgbeg i))
-		(search-forward "\n*** EOOH ***\n")
-		(let ((beg (point)) end)
-		  (search-forward "\n\n")
-		  (setq end (point))
-		  (goto-char beg)
-		  (setq done (re-search-forward search-regexp end t))))))
-	  (if done (setq found i)))
-	(setq n (if forward (1- n) (1+ n)))))
-    (if found
-	(rmail-summary-goto-msg found)
-      (error "No %s message with same subject"
-	     (if forward "following" "previous")))))
-
-(defun rmail-summary-previous-same-subject (n)
-  "Go to the previous message in the summary having the same subject.
-With prefix argument N, do this N times.
-If N is negative, go forwards instead."
-  (interactive "p")
-  (rmail-summary-next-same-subject (- n)))
-
-;; Delete and undelete summary commands.
-
-(defun rmail-summary-delete-forward (&optional backward)
-  "Delete this message and move to next nondeleted one.
-Deleted messages stay in the file until the \\[rmail-expunge] command is given.
-With prefix argument, delete and move backward."
-  (interactive "P")
-  (let (end)
-    (rmail-summary-goto-msg)
-    (pop-to-buffer rmail-buffer)
-    (rmail-delete-message)
-    (let ((del-msg rmail-current-message))
-      (pop-to-buffer rmail-summary-buffer)
-      (rmail-summary-mark-deleted del-msg)
-      (while (and (not (if backward (bobp) (eobp)))
-		  (save-excursion (beginning-of-line)
-				  (looking-at " *[0-9]+D")))
-	(forward-line (if backward -1 1)))
-      ;; It looks ugly to move to the empty line at end of buffer.
-      (and (eobp) (not backward)
-	   (forward-line -1)))))
-
-(defun rmail-summary-delete-backward ()
-  "Delete this message and move to previous nondeleted one.
-Deleted messages stay in the file until the \\[rmail-expunge] command is given."
-  (interactive)
-  (rmail-summary-delete-forward t))
-
-(defun rmail-summary-mark-deleted (&optional n undel)
-  ;; Since third arg is t, this only alters the summary, not the Rmail buf.
-  (and n (rmail-summary-goto-msg n t t))
-  (or (eobp)
-      (not (overlay-get rmail-summary-overlay 'face))
-      (let ((buffer-read-only nil))
-	(skip-chars-forward " ")
-	(skip-chars-forward "[0-9]")
-	(if undel
-	    (if (looking-at "D")
-		(progn (delete-char 1) (insert " ")))
-	  (delete-char 1)
-	  (insert "D"))))
-  (beginning-of-line))
-
-(defun rmail-summary-mark-undeleted (n)
-  (rmail-summary-mark-deleted n t))
-
-(defun rmail-summary-deleted-p (&optional n)
-  (save-excursion
-    (and n (rmail-summary-goto-msg n nil t))
-    (skip-chars-forward " ")
-    (skip-chars-forward "[0-9]")
-    (looking-at "D")))
-
-(defun rmail-summary-undelete (&optional arg)
-  "Undelete current message.
-Optional prefix ARG means undelete ARG previous messages."
-  (interactive "p")
-  (if (/= arg 1)
-      (rmail-summary-undelete-many arg)
-    (let ((buffer-read-only nil)
-	  (opoint (point)))
-      (end-of-line)
-      (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)
-	     (replace-match "\\1 ")
-	     (rmail-summary-goto-msg)
-	     (pop-to-buffer rmail-buffer)
-	     (and (rmail-message-deleted-p rmail-current-message)
-		  (rmail-undelete-previous-message))
-	     (pop-to-buffer rmail-summary-buffer))
-	    (t (goto-char opoint))))))
-
-(defun rmail-summary-undelete-many (&optional n)
-  "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs."
-  (interactive "P")
-  (save-excursion
-    (set-buffer rmail-buffer)
-    (let* ((init-msg (if n rmail-current-message rmail-total-messages))
-	   (rmail-current-message init-msg)
-	   (n (or n rmail-total-messages))
-	   (msgs-undeled 0))
-      (while (and (> rmail-current-message 0)
-		  (< msgs-undeled n))
-	(if (rmail-message-deleted-p rmail-current-message)
-	    (progn (rmail-set-attribute "deleted" nil)
-		   (setq msgs-undeled (1+ msgs-undeled))))
-	(setq rmail-current-message (1- rmail-current-message)))
-      (set-buffer rmail-summary-buffer)
-      (setq rmail-current-message init-msg msgs-undeled 0)
-      (while (and (> rmail-current-message 0)
-		  (< msgs-undeled n))
-	(if (rmail-summary-deleted-p rmail-current-message)
-	    (progn (rmail-summary-mark-undeleted rmail-current-message)
-		   (setq msgs-undeled (1+ msgs-undeled))))
-	(setq rmail-current-message (1- rmail-current-message))))
-    (rmail-summary-goto-msg)))
-
-;; Rmail Summary mode is suitable only for specially formatted data.
-(put 'rmail-summary-mode 'mode-class 'special)
-
-(defun rmail-summary-mode ()
-  "Rmail Summary Mode is invoked from Rmail Mode by using \\<rmail-mode-map>\\[rmail-summary].
-As commands are issued in the summary buffer, they are applied to the
-corresponding mail messages in the rmail buffer.
-
-All normal editing commands are turned off.
-Instead, nearly all the Rmail mode commands are available,
-though many of them move only among the messages in the summary.
-
-These additional commands exist:
-
-\\[rmail-summary-undelete-many]	Undelete all or prefix arg deleted messages.
-\\[rmail-summary-wipe] Delete the summary and go to the Rmail buffer.
-
-Commands for sorting the summary:
-
-\\[rmail-summary-sort-by-date] Sort by date.
-\\[rmail-summary-sort-by-subject] Sort by subject.
-\\[rmail-summary-sort-by-author] Sort by author.
-\\[rmail-summary-sort-by-recipient] Sort by recipient.
-\\[rmail-summary-sort-by-correspondent] Sort by correspondent.
-\\[rmail-summary-sort-by-lines] Sort by lines.
-\\[rmail-summary-sort-by-keywords] Sort by keywords."
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'rmail-summary-mode)
-  (setq mode-name "RMAIL Summary")
-  (setq truncate-lines t)
-  (setq buffer-read-only t)
-  (set-syntax-table text-mode-syntax-table)
-  (make-local-variable 'rmail-buffer)
-  (make-local-variable 'rmail-total-messages)
-  (make-local-variable 'rmail-current-message)
-  (setq rmail-current-message nil)
-  (make-local-variable 'rmail-summary-redo)
-  (setq rmail-summary-redo nil)
-  (make-local-variable 'revert-buffer-function)
-  (make-local-hook 'post-command-hook)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(rmail-summary-font-lock-keywords t))
-  (rmail-summary-enable)
-  (run-hooks 'rmail-summary-mode-hook))
-
-;; Summary features need to be disabled during edit mode.
-(defun rmail-summary-disable ()
-  (use-local-map text-mode-map)
-  (remove-hook 'post-command-hook 'rmail-summary-rmail-update t)
-  (setq revert-buffer-function nil))
-
-(defun rmail-summary-enable ()
-  (use-local-map rmail-summary-mode-map)
-  (add-hook 'post-command-hook 'rmail-summary-rmail-update nil t)
-  (setq revert-buffer-function 'rmail-update-summary))
-
-(defvar rmail-summary-put-back-unseen nil
-  "Used for communicating between calls to `rmail-summary-rmail-update'.
-If it moves to a message within an Incremental Search, and removes
-the `unseen' attribute from that message, it sets this flag
-so that if the next motion between messages is in the same Incremental
-Search, the `unseen' attribute is restored.")
-
-;; Show in Rmail the message described by the summary line that point is on,
-;; but only if the Rmail buffer is already visible.
-;; This is a post-command-hook in summary buffers.
-(defun rmail-summary-rmail-update ()
-  (let (buffer-read-only)
-    (save-excursion
-      ;; If at end of buffer, pretend we are on the last text line.
-      (if (eobp)
-	  (forward-line -1))
-      (beginning-of-line)
-      (skip-chars-forward " ")
-      (let ((msg-num (string-to-int (buffer-substring
-				     (point)
-				     (progn (skip-chars-forward "0-9")
-					    (point))))))
-	;; Always leave `unseen' removed
-	;; if we get out of isearch mode.
-	;; Don't let a subsequent isearch restore that `unseen'.
-	(if (not isearch-mode)
-	    (setq rmail-summary-put-back-unseen nil))
-
-	(or (eq rmail-current-message msg-num)
-	    (let ((window (get-buffer-window rmail-buffer))
-		  (owin (selected-window)))
-	      (if isearch-mode
-		  (save-excursion
-		    (set-buffer rmail-buffer)
-		    ;; If we first saw the previous message in this search,
-		    ;; and we have gone to a different message while searching,
-		    ;; put back `unseen' on the former one.
-		    (rmail-set-attribute "unseen" t
-					 rmail-current-message)
-		    ;; Arrange to do that later, for the new current message,
-		    ;; if it still has `unseen'.
-		    (setq rmail-summary-put-back-unseen
-			  (rmail-message-labels-p msg-num ", ?\\(unseen\\),")))
-		(setq rmail-summary-put-back-unseen nil))
-
-	      ;; Go to the desired message.
-	      (setq rmail-current-message msg-num)
-
-	      ;; Update the summary to show the message has been seen.
-	      (if (= (following-char) ?-)
-		  (progn
-		    (delete-char 1)
-		    (insert " ")))
-
-	      (if window
-		  ;; Using save-window-excursion would cause the new value
-		  ;; of point to get lost.
-		  (unwind-protect
-		      (progn
-			(select-window window)
-			(rmail-show-message msg-num t))
-		    (select-window owin))
-		(if (buffer-name rmail-buffer)
-		    (save-excursion
-		      (set-buffer rmail-buffer)
-		      (rmail-show-message msg-num t))))))
-	(rmail-summary-update-highlight nil)))))
-
-(defvar rmail-summary-mode-map nil)
-
-(if rmail-summary-mode-map
-    nil
-  (setq rmail-summary-mode-map (make-keymap))
-  (suppress-keymap rmail-summary-mode-map)
-  (define-key rmail-summary-mode-map "a"      'rmail-summary-add-label)
-  (define-key rmail-summary-mode-map "b"      'rmail-summary-bury)
-  (define-key rmail-summary-mode-map "c"      'rmail-summary-continue)
-  (define-key rmail-summary-mode-map "d"      'rmail-summary-delete-forward)
-  (define-key rmail-summary-mode-map "\C-d"   'rmail-summary-delete-backward)
-  (define-key rmail-summary-mode-map "e"      'rmail-summary-edit-current-message)
-  (define-key rmail-summary-mode-map "f"      'rmail-summary-forward)
-  (define-key rmail-summary-mode-map "g"      'rmail-summary-get-new-mail)
-  (define-key rmail-summary-mode-map "h"      'rmail-summary)
-  (define-key rmail-summary-mode-map "i"      'rmail-summary-input)
-  (define-key rmail-summary-mode-map "j"      'rmail-summary-goto-msg)
-  (define-key rmail-summary-mode-map "k"      'rmail-summary-kill-label)
-  (define-key rmail-summary-mode-map "l"      'rmail-summary-by-labels)
-  (define-key rmail-summary-mode-map "\e\C-h" 'rmail-summary)
-  (define-key rmail-summary-mode-map "\e\C-l" 'rmail-summary-by-labels)
-  (define-key rmail-summary-mode-map "\e\C-r" 'rmail-summary-by-recipients)
-  (define-key rmail-summary-mode-map "\e\C-s" 'rmail-summary-by-regexp)
-  (define-key rmail-summary-mode-map "\e\C-t" 'rmail-summary-by-topic)
-  (define-key rmail-summary-mode-map "m"      'rmail-summary-mail)
-  (define-key rmail-summary-mode-map "\M-m"   'rmail-summary-retry-failure)
-  (define-key rmail-summary-mode-map "n"      'rmail-summary-next-msg)
-  (define-key rmail-summary-mode-map "\en"    'rmail-summary-next-all)
-  (define-key rmail-summary-mode-map "\e\C-n" 'rmail-summary-next-labeled-message)
-  (define-key rmail-summary-mode-map "o"      'rmail-summary-output-to-rmail-file)
-  (define-key rmail-summary-mode-map "\C-o"   'rmail-summary-output)
-  (define-key rmail-summary-mode-map "p"      'rmail-summary-previous-msg)
-  (define-key rmail-summary-mode-map "\ep"    'rmail-summary-previous-all)
-  (define-key rmail-summary-mode-map "\e\C-p" 'rmail-summary-previous-labeled-message)
-  (define-key rmail-summary-mode-map "q"      'rmail-summary-quit)
-  (define-key rmail-summary-mode-map "r"      'rmail-summary-reply)
-  (define-key rmail-summary-mode-map "s"      'rmail-summary-expunge-and-save)
-  (define-key rmail-summary-mode-map "\es"    'rmail-summary-search)
-  (define-key rmail-summary-mode-map "t"      'rmail-summary-toggle-header)
-  (define-key rmail-summary-mode-map "u"      'rmail-summary-undelete)
-  (define-key rmail-summary-mode-map "\M-u"   'rmail-summary-undelete-many)
-  (define-key rmail-summary-mode-map "w"      'rmail-summary-wipe)
-  (define-key rmail-summary-mode-map "x"      'rmail-summary-expunge)
-  (define-key rmail-summary-mode-map "."      'rmail-summary-beginning-of-message)
-  (define-key rmail-summary-mode-map "<"      'rmail-summary-first-message)
-  (define-key rmail-summary-mode-map ">"      'rmail-summary-last-message)
-  (define-key rmail-summary-mode-map " "      'rmail-summary-scroll-msg-up)
-  (define-key rmail-summary-mode-map "\177"   'rmail-summary-scroll-msg-down)
-  (define-key rmail-summary-mode-map "?"      'describe-mode)
-  (define-key rmail-summary-mode-map "\C-c\C-n" 'rmail-summary-next-same-subject)
-  (define-key rmail-summary-mode-map "\C-c\C-p" 'rmail-summary-previous-same-subject)
-  (define-key rmail-summary-mode-map "\C-c\C-s\C-d"
-    'rmail-summary-sort-by-date)
-  (define-key rmail-summary-mode-map "\C-c\C-s\C-s"
-    'rmail-summary-sort-by-subject)
-  (define-key rmail-summary-mode-map "\C-c\C-s\C-a"
-    'rmail-summary-sort-by-author)
-  (define-key rmail-summary-mode-map "\C-c\C-s\C-r"
-    'rmail-summary-sort-by-recipient)
-  (define-key rmail-summary-mode-map "\C-c\C-s\C-c"
-    'rmail-summary-sort-by-correspondent)
-  (define-key rmail-summary-mode-map "\C-c\C-s\C-l"
-    'rmail-summary-sort-by-lines)
-  (define-key rmail-summary-mode-map "\C-c\C-s\C-k"
-    'rmail-summary-sort-by-keywords)
-  )
-
-;;; Menu bar bindings.
-
-(define-key rmail-summary-mode-map [menu-bar] (make-sparse-keymap))
-
-(define-key rmail-summary-mode-map [menu-bar classify]
-  (cons "Classify" (make-sparse-keymap "Classify")))
-
-(define-key rmail-summary-mode-map [menu-bar classify output-menu]
-  '("Output (Rmail Menu)..." . rmail-summary-output-menu))
-
-(define-key rmail-summary-mode-map [menu-bar classify input-menu]
-  '("Input Rmail File (menu)..." . rmail-input-menu))
-
-(define-key rmail-summary-mode-map [menu-bar classify input-menu]
-  '(nil))
-
-(define-key rmail-summary-mode-map [menu-bar classify output-menu]
-  '(nil))
-
-(define-key rmail-summary-mode-map [menu-bar classify output-inbox]
-  '("Output (inbox)..." . rmail-summary-output))
-
-(define-key rmail-summary-mode-map [menu-bar classify output]
-  '("Output (Rmail)..." . rmail-summary-output-to-rmail-file))
-
-(define-key rmail-summary-mode-map [menu-bar classify kill-label]
-  '("Kill Label..." . rmail-summary-kill-label))
-
-(define-key rmail-summary-mode-map [menu-bar classify add-label]
-  '("Add Label..." . rmail-summary-add-label))
-
-(define-key rmail-summary-mode-map [menu-bar summary]
-  (cons "Summary" (make-sparse-keymap "Summary")))
-
-(define-key rmail-summary-mode-map [menu-bar summary senders]
-  '("By Senders..." . rmail-summary-by-senders))
-
-(define-key rmail-summary-mode-map [menu-bar summary labels]
-  '("By Labels..." . rmail-summary-by-labels))
-
-(define-key rmail-summary-mode-map [menu-bar summary recipients]
-  '("By Recipients..." . rmail-summary-by-recipients))
-
-(define-key rmail-summary-mode-map [menu-bar summary topic]
-  '("By Topic..." . rmail-summary-by-topic))
-
-(define-key rmail-summary-mode-map [menu-bar summary regexp]
-  '("By Regexp..." . rmail-summary-by-regexp))
-
-(define-key rmail-summary-mode-map [menu-bar summary all]
-  '("All" . rmail-summary))
-
-(define-key rmail-summary-mode-map [menu-bar mail]
-  (cons "Mail" (make-sparse-keymap "Mail")))
-
-(define-key rmail-summary-mode-map [menu-bar mail rmail-summary-get-new-mail]
-  '("Get New Mail" . rmail-summary-get-new-mail))
-
-(define-key rmail-summary-mode-map [menu-bar mail lambda]
-  '("----"))
-
-(define-key rmail-summary-mode-map [menu-bar mail continue]
-  '("Continue" . rmail-summary-continue))
-
-(define-key rmail-summary-mode-map [menu-bar mail resend]
-  '("Re-send..." . rmail-summary-resend))
-
-(define-key rmail-summary-mode-map [menu-bar mail forward]
-  '("Forward" . rmail-summary-forward))
-
-(define-key rmail-summary-mode-map [menu-bar mail retry]
-  '("Retry" . rmail-summary-retry-failure))
-
-(define-key rmail-summary-mode-map [menu-bar mail reply]
-  '("Reply" . rmail-summary-reply))
-
-(define-key rmail-summary-mode-map [menu-bar mail mail]
-  '("Mail" . rmail-summary-mail))
-
-(define-key rmail-summary-mode-map [menu-bar delete]
-  (cons "Delete" (make-sparse-keymap "Delete")))
-
-(define-key rmail-summary-mode-map [menu-bar delete expunge/save]
-  '("Expunge/Save" . rmail-summary-expunge-and-save))
-
-(define-key rmail-summary-mode-map [menu-bar delete expunge]
-  '("Expunge" . rmail-summary-expunge))
-
-(define-key rmail-summary-mode-map [menu-bar delete undelete]
-  '("Undelete" . rmail-summary-undelete))
-
-(define-key rmail-summary-mode-map [menu-bar delete delete]
-  '("Delete" . rmail-summary-delete-forward))
-
-(define-key rmail-summary-mode-map [menu-bar move]
-  (cons "Move" (make-sparse-keymap "Move")))
-
-(define-key rmail-summary-mode-map [menu-bar move search-back]
-  '("Search Back..." . rmail-summary-search-backward))
-
-(define-key rmail-summary-mode-map [menu-bar move search]
-  '("Search..." . rmail-summary-search))
-
-(define-key rmail-summary-mode-map [menu-bar move previous]
-  '("Previous Nondeleted" . rmail-summary-previous-msg))
-
-(define-key rmail-summary-mode-map [menu-bar move next]
-  '("Next Nondeleted" . rmail-summary-next-msg))
-
-(define-key rmail-summary-mode-map [menu-bar move last]
-  '("Last" . rmail-summary-last-message))
-
-(define-key rmail-summary-mode-map [menu-bar move first]
-  '("First" . rmail-summary-first-message))
-
-(define-key rmail-summary-mode-map [menu-bar move previous]
-  '("Previous" . rmail-summary-previous-all))
-
-(define-key rmail-summary-mode-map [menu-bar move next]
-  '("Next" . rmail-summary-next-all))
-
-(defvar rmail-summary-overlay nil)
-(put 'rmail-summary-overlay 'permanent-local t)
-
-;; Go to message N in the summary buffer which is current,
-;; and in the corresponding Rmail buffer.
-;; If N is nil, use the message corresponding to point in the summary
-;; and move to that message in the Rmail buffer.
-
-;; If NOWARN, don't say anything if N is out of range.
-;; If SKIP-RMAIL, don't do anything to the Rmail buffer.
-
-(defun rmail-summary-goto-msg (&optional n nowarn skip-rmail)
-  (interactive "P")
-  (if (consp n) (setq n (prefix-numeric-value n)))
-  (if (eobp) (forward-line -1))
-  (beginning-of-line)
-  (let* ((obuf (current-buffer))
-	 (buf rmail-buffer)
-	 (cur (point))
-	 message-not-found
-	 (curmsg (string-to-int
-		  (buffer-substring (point)
-				    (min (point-max) (+ 5 (point))))))
-	 (total (save-excursion (set-buffer buf) rmail-total-messages)))
-    ;; If message number N was specified, find that message's line
-    ;; or set message-not-found.
-    ;; If N wasn't specified or that message can't be found.
-    ;; set N by default.
-    (if (not n)
-	(setq n curmsg)
-      (if (< n 1)
-	  (progn (message "No preceding message")
-		 (setq n 1)))
-      (if (> n total)
-	  (progn (message "No following message")
-		 (goto-char (point-max))
-		 (rmail-summary-goto-msg nil nowarn skip-rmail)))
-      (goto-char (point-min))
-      (if (not (re-search-forward (format "^%4d[^0-9]" n) nil t))
-	  (progn (or nowarn (message "Message %d not found" n))
-		 (setq n curmsg)
-		 (setq message-not-found t)
-		 (goto-char cur))))
-    (beginning-of-line)
-    (skip-chars-forward " ")
-    (skip-chars-forward "0-9")
-    (save-excursion (if (= (following-char) ?-)
-			(let ((buffer-read-only nil))
-			  (delete-char 1)
-			  (insert " "))))
-    (rmail-summary-update-highlight message-not-found)
-    (beginning-of-line)
-    (if skip-rmail
-	nil
-      (let ((selwin (selected-window)))
-	(unwind-protect
-	    (progn (pop-to-buffer buf)
-		   (rmail-show-message n))
-	  (select-window selwin)
-	  ;; The actions above can alter the current buffer.  Preserve it.
-	  (set-buffer obuf))))))
-
-;; Update the highlighted line in an rmail summary buffer.
-;; That should be current.  We highlight the line point is on.
-;; If NOT-FOUND is non-nil, we turn off highlighting.
-(defun rmail-summary-update-highlight (not-found)
-  ;; Make sure we have an overlay to use.
-  (or rmail-summary-overlay
-      (progn
-	(make-local-variable 'rmail-summary-overlay)
-	(setq rmail-summary-overlay (make-overlay (point) (point)))))
-  ;; If this message is in the summary, use the overlay to highlight it.
-  ;; Otherwise, don't highlight anything.
-  (if not-found
-      (overlay-put rmail-summary-overlay 'face nil)
-    (move-overlay rmail-summary-overlay
-		  (save-excursion (beginning-of-line)
-				  (skip-chars-forward " ")
-				  (point))
-		  (save-excursion (end-of-line) (point)))
-    (overlay-put rmail-summary-overlay 'face 'highlight)))
-
-(defun rmail-summary-scroll-msg-up (&optional dist)
-  "Scroll the Rmail window forward.
-If the Rmail window is displaying the end of a message,
-advance to the next message."
-  (interactive "P")
-  (if (eq dist '-)
-      (rmail-summary-scroll-msg-down nil)
-    (let ((rmail-buffer-window (get-buffer-window rmail-buffer)))
-      (if rmail-buffer-window
-	  (if (let ((rmail-summary-window (selected-window)))
-		(select-window rmail-buffer-window)
-		(prog1
-		    ;; Is EOB visible in the buffer?
-		    (save-excursion
-		      (let ((ht (window-height (selected-window))))
-			(move-to-window-line (- ht 2))
-			(end-of-line)
-			(eobp)))
-		  (select-window rmail-summary-window)))
-	      (if (not rmail-summary-scroll-between-messages)
-		  (error "End of buffer")
-		(rmail-summary-next-msg (or dist 1)))
-	    (let ((other-window-scroll-buffer rmail-buffer))
-	      (scroll-other-window dist)))
-	;; If it isn't visible at all, show the beginning.
-	(rmail-summary-beginning-of-message)))))
-
-(defun rmail-summary-scroll-msg-down (&optional dist)
-  "Scroll the Rmail window backward.
-If the Rmail window is now displaying the beginning of a message,
-move to the previous message."
-  (interactive "P")
-  (if (eq dist '-)
-      (rmail-summary-scroll-msg-up nil)
-    (let ((rmail-buffer-window (get-buffer-window rmail-buffer)))
-      (if rmail-buffer-window
-	  (if (let ((rmail-summary-window (selected-window)))
-		(select-window rmail-buffer-window)
-		(prog1
-		    ;; Is BOB visible in the buffer?
-		    (save-excursion
-		      (move-to-window-line 0)
-		      (beginning-of-line)
-		      (bobp))
-		  (select-window rmail-summary-window)))
-	      (if (not rmail-summary-scroll-between-messages)
-		  (error "Beginning of buffer")
-		(rmail-summary-previous-msg (or dist 1)))
-	    (let ((other-window-scroll-buffer rmail-buffer))
-	      (scroll-other-window-down dist)))
-	;; If it isn't visible at all, show the beginning.
-	(rmail-summary-beginning-of-message)))))
-
-(defun rmail-summary-beginning-of-message ()
-  "Show current message from the beginning."
-  (interactive)
-  (if (and (one-window-p) (not pop-up-frames))
-      ;; If there is just one window, put the summary on the top.
-      (let ((buffer rmail-buffer))
-	(split-window (selected-window) rmail-summary-window-size)
-	(select-window (frame-first-window))
-	(pop-to-buffer rmail-buffer)
-	;; If pop-to-buffer did not use that window, delete that
-	;; window.  (This can happen if it uses another frame.)
-	(or (eq buffer (window-buffer (next-window (frame-first-window))))
-	    (delete-other-windows)))
-    (pop-to-buffer rmail-buffer))
-  (beginning-of-buffer)
-  (pop-to-buffer rmail-summary-buffer))
-
-(defun rmail-summary-bury ()
-  "Bury the Rmail buffer and the Rmail summary buffer."
-  (interactive)
-  (let ((buffer-to-bury (current-buffer)))
-    (let (window)
-      (while (setq window (get-buffer-window rmail-buffer))
-	(set-window-buffer window (other-buffer rmail-buffer)))
-      (bury-buffer rmail-buffer))
-    (switch-to-buffer (other-buffer buffer-to-bury))
-    (bury-buffer buffer-to-bury)))
-
-(defun rmail-summary-quit ()
-  "Quit out of Rmail and Rmail summary."
-  (interactive)
-  (rmail-summary-wipe)
-  (rmail-quit))
-
-(defun rmail-summary-wipe ()
-  "Kill and wipe away Rmail summary, remaining within Rmail."
-  (interactive)
-  (save-excursion (set-buffer rmail-buffer) (setq rmail-summary-buffer nil))
-  (let ((local-rmail-buffer rmail-buffer))
-    (kill-buffer (current-buffer))
-    ;; Delete window if not only one.
-    (if (not (eq (selected-window) (next-window nil 'no-minibuf)))
-	(delete-window))
-    ;; Switch windows to the rmail buffer, or switch to it in this window.
-    (pop-to-buffer local-rmail-buffer)))
-
-(defun rmail-summary-expunge ()
-  "Actually erase all deleted messages and recompute summary headers."
-  (interactive)
-  (save-excursion
-    (set-buffer rmail-buffer)
-    (rmail-only-expunge))
-  (rmail-update-summary))
-
-(defun rmail-summary-expunge-and-save ()
-  "Expunge and save RMAIL file."
-  (interactive)
-  (save-excursion
-    (set-buffer rmail-buffer)
-    (rmail-only-expunge))
-  (rmail-update-summary)
-  (save-excursion
-    (set-buffer rmail-buffer)
-    (save-buffer))
-  (set-buffer-modified-p nil))
-
-(defun rmail-summary-get-new-mail ()
-  "Get new mail and recompute summary headers."
-  (interactive)
-  (let (msg)
-    (save-excursion
-      (set-buffer rmail-buffer)
-      (rmail-get-new-mail)
-      ;; Get the proper new message number.
-      (setq msg rmail-current-message))
-    ;; Make sure that message is displayed.
-    (or (zerop msg)
-	(rmail-summary-goto-msg msg))))
-
-(defun rmail-summary-input (filename)
-  "Run Rmail on file FILENAME."
-  (interactive "FRun rmail on RMAIL file: ")
-  ;; We switch windows here, then display the other Rmail file there.
-  (pop-to-buffer rmail-buffer)
-  (rmail filename))
-
-(defun rmail-summary-first-message ()
-  "Show first message in Rmail file from summary buffer."
-  (interactive)
-  (beginning-of-buffer))
-
-(defun rmail-summary-last-message ()
-  "Show last message in Rmail file from summary buffer."
-  (interactive)
-  (end-of-buffer)
-  (forward-line -1))
-
-(defvar rmail-summary-edit-map nil)
-(if rmail-summary-edit-map
-    nil
-  (setq rmail-summary-edit-map
-	(nconc (make-sparse-keymap) text-mode-map))
-  (define-key rmail-summary-edit-map "\C-c\C-c" 'rmail-cease-edit)
-  (define-key rmail-summary-edit-map "\C-c\C-]" 'rmail-abort-edit))
-
-(defun rmail-summary-edit-current-message ()
-  "Edit the contents of this message."
-  (interactive)
-  (pop-to-buffer rmail-buffer)
-  (rmail-edit-current-message)
-  (use-local-map rmail-summary-edit-map))
-
-(defun rmail-summary-cease-edit ()
-  "Finish editing message, then go back to Rmail summary buffer."
-  (interactive)
-  (rmail-cease-edit)
-  (pop-to-buffer rmail-summary-buffer))
-
-(defun rmail-summary-abort-edit ()
-  "Abort edit of current message; restore original contents.
-Go back to summary buffer."
-  (interactive)
-  (rmail-abort-edit)
-  (pop-to-buffer rmail-summary-buffer))
-
-(defun rmail-summary-search-backward (regexp &optional n)
-  "Show message containing next match for REGEXP.
-Prefix argument gives repeat count; negative argument means search
-backwards (through earlier messages).
-Interactively, empty argument means use same regexp used last time."
-  (interactive
-    (let* ((reversep (>= (prefix-numeric-value current-prefix-arg) 0))
-	   (prompt
-	    (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
-	   regexp)
-      (if rmail-search-last-regexp
-	  (setq prompt (concat prompt
-			       "(default "
-			       rmail-search-last-regexp
-			       ") ")))
-      (setq regexp (read-string prompt))
-      (cond ((not (equal regexp ""))
-	     (setq rmail-search-last-regexp regexp))
-	    ((not rmail-search-last-regexp)
-	     (error "No previous Rmail search string")))
-      (list rmail-search-last-regexp
-	    (prefix-numeric-value current-prefix-arg))))
-  ;; Don't use save-excursion because that prevents point from moving
-  ;; properly in the summary buffer.
-  (let ((buffer (current-buffer)))
-    (unwind-protect
-	(progn
-	  (set-buffer rmail-buffer)
-	  (rmail-search regexp (- n)))
-      (set-buffer buffer))))
-
-(defun rmail-summary-search (regexp &optional n)
-  "Show message containing next match for REGEXP.
-Prefix argument gives repeat count; negative argument means search
-backwards (through earlier messages).
-Interactively, empty argument means use same regexp used last time."
-  (interactive
-    (let* ((reversep (< (prefix-numeric-value current-prefix-arg) 0))
-	   (prompt
-	    (concat (if reversep "Reverse " "") "Rmail search (regexp): "))
-	   regexp)
-      (if rmail-search-last-regexp
-	  (setq prompt (concat prompt
-			       "(default "
-			       rmail-search-last-regexp
-			       ") ")))
-      (setq regexp (read-string prompt))
-      (cond ((not (equal regexp ""))
-	     (setq rmail-search-last-regexp regexp))
-	    ((not rmail-search-last-regexp)
-	     (error "No previous Rmail search string")))
-      (list rmail-search-last-regexp
-	    (prefix-numeric-value current-prefix-arg))))
-  ;; Don't use save-excursion because that prevents point from moving
-  ;; properly in the summary buffer.
-  (let ((buffer (current-buffer)))
-    (unwind-protect
-	(progn
-	  (set-buffer rmail-buffer)
-	  (rmail-search regexp n))
-      (set-buffer buffer))))
-
-(defun rmail-summary-toggle-header ()
-  "Show original message header if pruned header currently shown, or vice versa."
-  (interactive)
-  (save-excursion
-    (set-buffer rmail-buffer)
-    (rmail-toggle-header))
-  ;; Inside save-excursion, some changes to point in the RMAIL buffer are lost.
-  ;; Set point to point-min in the RMAIL buffer, if it is visible.
-  (let ((window (get-buffer-window rmail-buffer)))
-    (if window
-        ;; Using save-window-excursion would lose the new value of point.
-        (let ((owin (selected-window)))
-          (unwind-protect
-              (progn
-                (select-window window)
-                (goto-char (point-min)))
-            (select-window owin))))))
-
-
-(defun rmail-summary-add-label (label)
-  "Add LABEL to labels associated with current Rmail message.
-Completion is performed over known labels when reading."
-  (interactive (list (save-excursion
-		       (set-buffer rmail-buffer)
-		       (rmail-read-label "Add label"))))
-  (save-excursion
-    (set-buffer rmail-buffer)
-    (rmail-add-label label)))
-
-(defun rmail-summary-kill-label (label)
-  "Remove LABEL from labels associated with current Rmail message.
-Completion is performed over known labels when reading."
-  (interactive (list (save-excursion
-		       (set-buffer rmail-buffer)
-		       (rmail-read-label "Kill label"))))
-  (save-excursion
-    (set-buffer rmail-buffer)
-    (rmail-set-label label nil)))
-
-;;;; *** Rmail Summary Mailing Commands ***
-
-(defun rmail-summary-mail ()
-  "Send mail in another window.
-While composing the message, use \\[mail-yank-original] to yank the
-original message into it."
-  (interactive)
-  (let ((window (get-buffer-window rmail-buffer)))
-    (if window
-	(select-window window)
-      (set-buffer rmail-buffer)))
-  (rmail-start-mail nil nil nil nil nil (current-buffer))
-  (use-local-map (copy-keymap (current-local-map)))
-  (define-key (current-local-map)
-    "\C-c\C-c" 'rmail-summary-send-and-exit))
-
-(defun rmail-summary-continue ()
-  "Continue composing outgoing message previously being composed."
-  (interactive)
-  (let ((window (get-buffer-window rmail-buffer)))
-    (if window
-	(select-window window)
-      (set-buffer rmail-buffer)))
-  (rmail-start-mail t))
-
-(defun rmail-summary-reply (just-sender)
-  "Reply to the current message.
-Normally include CC: to all other recipients of original message;
-prefix argument means ignore them.  While composing the reply,
-use \\[mail-yank-original] to yank the original message into it."
-  (interactive "P")
-  (let ((window (get-buffer-window rmail-buffer)))
-    (if window
-	(select-window window)
-      (set-buffer rmail-buffer)))
-  (rmail-reply just-sender)
-  (use-local-map (copy-keymap (current-local-map)))
-  (define-key (current-local-map)
-    "\C-c\C-c" 'rmail-summary-send-and-exit))
-
-(defun rmail-summary-retry-failure ()
-  "Edit a mail message which is based on the contents of the current message.
-For a message rejected by the mail system, extract the interesting headers and
-the body of the original message; otherwise copy the current message."
-  (interactive)
-  (let ((window (get-buffer-window rmail-buffer)))
-    (if window
-	(select-window window)
-      (set-buffer rmail-buffer)))
-  (rmail-retry-failure)
-  (use-local-map (copy-keymap (current-local-map)))
-  (define-key (current-local-map)
-    "\C-c\C-c" 'rmail-summary-send-and-exit))
-
-(defun rmail-summary-send-and-exit ()
-  "Send mail reply and return to summary buffer."
-  (interactive)
-  (mail-send-and-exit t))
-
-(defun rmail-summary-forward (resend)
-  "Forward the current message to another user.
-With prefix argument, \"resend\" the message instead of forwarding it;
-see the documentation of `rmail-resend'."
-  (interactive "P")
-  (save-excursion
-    (let ((window (get-buffer-window rmail-buffer)))
-      (if window
-	  (select-window window)
-	(set-buffer rmail-buffer)))
-    (rmail-forward resend)
-    (use-local-map (copy-keymap (current-local-map)))
-    (define-key (current-local-map)
-      "\C-c\C-c" 'rmail-summary-send-and-exit)))
-
-(defun rmail-summary-resend ()
-  "Resend current message using 'rmail-resend'."
-  (interactive)
-  (save-excursion
-    (let ((window (get-buffer-window rmail-buffer)))
-      (if window
-	  (select-window window)
-	(set-buffer rmail-buffer)))
-    (call-interactively 'rmail-resend)))
-
-;; Summary output commands.
-
-(defun rmail-summary-output-to-rmail-file (&optional file-name)
-  "Append the current message to an Rmail file named FILE-NAME.
-If the file does not exist, ask if it should be created.
-If file is being visited, the message is appended to the Emacs
-buffer visiting that file."
-  (interactive)
-  (save-excursion
-    (set-buffer rmail-buffer)
-    (let ((rmail-delete-after-output nil))
-      (if file-name
-	  (rmail-output-to-rmail-file file-name)
-	(call-interactively 'rmail-output-to-rmail-file))))
-  (if rmail-delete-after-output
-      (rmail-summary-delete-forward nil)))
-
-(defun rmail-summary-output-menu ()
-  "Output current message to another Rmail file, chosen with a menu.
-Also set the default for subsequent \\[rmail-output-to-rmail-file] commands.
-The variables `rmail-secondary-file-directory' and
-`rmail-secondary-file-regexp' control which files are offered in the menu."
-  (interactive)
-  (save-excursion
-    (set-buffer rmail-buffer)
-    (let ((rmail-delete-after-output nil))
-      (call-interactively 'rmail-output-menu)))
-  (if rmail-delete-after-output
-      (rmail-summary-delete-forward nil)))
-
-(defun rmail-summary-output ()
-  "Append this message to Unix mail file named FILE-NAME."
-  (interactive)
-  (save-excursion
-    (set-buffer rmail-buffer)
-    (let ((rmail-delete-after-output nil))
-      (call-interactively 'rmail-output)))
-  (if rmail-delete-after-output
-      (rmail-summary-delete-forward nil)))
-
-(defun rmail-summary-construct-io-menu ()
-  (let ((files (rmail-find-all-files rmail-secondary-file-directory)))
-    (if files
-	(progn
-	  (define-key rmail-summary-mode-map [menu-bar classify input-menu]
-	    (cons "Input Rmail File" 
-		  (rmail-list-to-menu "Input Rmail File" 
-				      files
-				      'rmail-summary-input)))
-	  (define-key rmail-summary-mode-map [menu-bar classify output-menu]
-	    (cons "Output Rmail File" 
-		  (rmail-list-to-menu "Output Rmail File" 
-				      files
-				      'rmail-summary-output-to-rmail-file))))
-      (define-key rmail-summary-mode-map [menu-bar classify input-menu]
-	'("Input Rmail File" . rmail-disable-menu))
-      (define-key rmail-summary-mode-map [menu-bar classify output-menu]
-	'("Output Rmail File" . rmail-disable-menu)))))
-
-
-;; Sorting messages in Rmail Summary buffer.
-
-(defun rmail-summary-sort-by-date (reverse)
-  "Sort messages of current Rmail summary by date.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-from-summary (function rmail-sort-by-date) reverse))
-
-(defun rmail-summary-sort-by-subject (reverse)
-  "Sort messages of current Rmail summary by subject.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-from-summary (function rmail-sort-by-subject) reverse))
-
-(defun rmail-summary-sort-by-author (reverse)
-  "Sort messages of current Rmail summary by author.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-from-summary (function rmail-sort-by-author) reverse))
-
-(defun rmail-summary-sort-by-recipient (reverse)
-  "Sort messages of current Rmail summary by recipient.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-from-summary (function rmail-sort-by-recipient) reverse))
-
-(defun rmail-summary-sort-by-correspondent (reverse)
-  "Sort messages of current Rmail summary by other correspondent.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-from-summary (function rmail-sort-by-correspondent) reverse))
-
-(defun rmail-summary-sort-by-lines (reverse)
-  "Sort messages of current Rmail summary by lines of the message.
-If prefix argument REVERSE is non-nil, sort them in reverse order."
-  (interactive "P")
-  (rmail-sort-from-summary (function rmail-sort-by-lines) reverse))
-
-(defun rmail-summary-sort-by-keywords (reverse labels)
-  "Sort messages of current Rmail summary by keywords.
-If prefix argument REVERSE is non-nil, sort them in reverse order.
-KEYWORDS is a comma-separated list of labels."
-  (interactive "P\nsSort by labels: ")
-  (rmail-sort-from-summary
-   (function (lambda (reverse)
-	       (rmail-sort-by-keywords reverse labels)))
-   reverse))
-
-(defun rmail-sort-from-summary (sortfun reverse)
-  "Sort Rmail messages from Summary buffer and update it after sorting."
-  (require 'rmailsort)
-  (let ((selwin (selected-window)))
-    (unwind-protect
-	(progn (pop-to-buffer rmail-buffer)
-	       (funcall sortfun reverse))
-      (select-window selwin))))
-
-;;; rmailsum.el ends here
diff --git a/lisp/mail/rnews.el b/lisp/mail/rnews.el
deleted file mode 100644
index d748fe49958..00000000000
--- a/lisp/mail/rnews.el
+++ /dev/null
@@ -1,989 +0,0 @@
-;;; rnews.el --- USENET news reader for gnu emacs
-
-;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: news
-
-;; 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.
-
-;;; Change Log:
-
-;; Created Sun Mar 10,1985 at 21:35:01 ads and sundar@hernes.ai.mit.edu
-;; Should do the point pdl stuff sometime
-;; finito except pdl.... Sat Mar 16,1985 at 06:43:44
-;; lets keep the summary stuff out until we get it working ..
-;;	sundar@hermes.ai.mit.edu Wed Apr 10,1985 at 16:32:06
-;; hack slash maim. mly@prep.ai.mit.edu Thu 18 Apr, 1985 06:11:14
-;; modified to correct reentrance bug, to not bother with groups that
-;;   received no new traffic since last read completely, to find out
-;;   what traffic a group has available much more quickly when
-;;   possible, to do some completing reads for group names - should
-;;   be much faster...
-;;	KING@KESTREL.arpa, Thu Mar 13 09:03:28 1986
-;; made news-{next,previous}-group skip groups with no new messages; and
-;; added checking for unsubscribed groups to news-add-news-group
-;;	tower@prep.ai.mit.edu Jul 18 1986
-;; bound rmail-output to C-o; and changed header-field commands binding to
-;; agree with the new C-c C-f usage in sendmail
-;; 	tower@prep Sep  3 1986
-;; added news-rotate-buffer-body
-;;	tower@prep Oct 17 1986
-;; made messages more user friendly, cleaned up news-inews
-;; move posting and mail code to new file rnewpost.el
-;;	tower@prep Oct 29 1986
-;; added caesar-region, rename news-caesar-buffer-body, hacked accordingly
-;;	tower@prep Nov 21 1986
-;; added tower@prep 22 Apr 87
-
-;;; Code:
-
-(require 'mail-utils)
-
-(autoload 'rmail-output "rmailout"
-  "Append this message to Unix mail file named FILE-NAME."
-  t)
-
-(autoload 'news-reply "rnewspost"
-  "Compose and post a reply to the current article on USENET.
-While composing the reply, use \\[mail-yank-original] to yank the original
-message into it."
-  t)
-
-(autoload 'news-mail-other-window "rnewspost"
-  "Send mail in another window.
-While composing the message, use \\[mail-yank-original] to yank the
-original message into it."
-  t)
-
-(autoload 'news-post-news "rnewspost"
-  "Begin editing a new USENET news article to be posted."
-  t)
-
-(autoload 'news-mail-reply "rnewspost"
-  "Mail a reply to the author of the current article.
-While composing the reply, use \\[mail-yank-original] to yank the original
-message into it."
-  t)
-
-(defvar news-group-hook-alist nil
-  "Alist of (GROUP-REGEXP . HOOK) pairs.
-Just before displaying a message, each HOOK is called
-if its GROUP-REGEXP matches the current newsgroup name.")
-
-(defvar rmail-last-file (expand-file-name "~/mbox.news"))
-
-;Now in paths.el.
-;(defvar news-path "/usr/spool/news/"
-;  "The root directory below which all news files are stored.")
-
-(defvar news-startup-file "$HOME/.newsrc" "Contains ~/.newsrc")
-(defvar news-certification-file "$HOME/.news-dates" "Contains ~/.news-dates")
-
-;; random headers that we decide to ignore.
-(defvar news-ignored-headers
-  "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:"
-  "All random fields within the header of a message.")
-
-(defvar news-mode-map nil)
-(defvar news-read-first-time-p t)
-;; Contains the (dotified) news groups of which you are a member. 
-(defvar news-user-group-list nil)
-
-(defvar news-current-news-group nil)
-(defvar news-current-group-begin nil)
-(defvar news-current-group-end  nil)
-(defvar news-current-certifications nil
-   	"An assoc list of a group name and the time at which it is
-known that the group had no new traffic")
-(defvar news-current-certifiable nil
-	"The time when the directory we are now working on was written")
-
-(defvar news-message-filter nil
-  "User specifiable filter function that will be called during
-formatting of the news file")
-
-;(defvar news-mode-group-string "Starting-Up"
-;  "Mode line group name info is held in this variable")
-(defvar news-list-of-files nil
-  "Global variable in which we store the list of files
-associated with the current newsgroup")
-(defvar news-list-of-files-possibly-bogus nil
-  "variable indicating we only are guessing at which files are available.
-Not currently used.")
-
-;; association list in which we store lists of the form
-;; (pointified-group-name (first last old-last))
-(defvar news-group-article-assoc nil)
-  
-(defvar news-current-message-number 0 "Displayed Article Number")
-(defvar news-total-current-group 0 "Total no of messages in group")
-
-(defvar news-unsubscribe-groups ())
-(defvar news-point-pdl () "List of visited news messages.")
-(defvar news-no-jumps-p t)
-(defvar news-buffer () "Buffer into which news files are read.")
-
-(defmacro news-push (item ref)
-  (list 'setq ref (list 'cons item ref)))
-
-(defmacro news-cadr (x) (list 'car (list 'cdr x)))
-(defmacro news-cdar (x) (list 'cdr (list 'car x)))
-(defmacro news-caddr (x) (list 'car (list 'cdr (list 'cdr x))))
-(defmacro news-cadar (x) (list 'car (list 'cdr (list 'car x))))
-(defmacro news-caadr (x) (list 'car (list 'car (list 'cdr x))))
-(defmacro news-cdadr (x) (list 'cdr (list 'car (list 'cdr x))))
-
-(defmacro news-wins (pfx index)
-  (` (file-exists-p (concat (, pfx) "/" (int-to-string (, index))))))
-
-(defvar news-max-plausible-gap 2
-	"* In an rnews directory, the maximum possible gap size.
-A gap is a sequence of missing messages between two messages that exist.
-An empty file does not contribute to a gap -- it ends one.")
-
-(defun news-find-first-and-last (prefix base)
-  (and (news-wins prefix base)
-       (cons (news-find-first-or-last prefix base -1)
-	     (news-find-first-or-last prefix base 1))))
-
-(defmacro news-/ (a1 a2)
-;; a form of / that guarantees that (/ -1 2) = 0
-  (if (zerop (/ -1 2))
-      (` (/ (, a1) (, a2)))
-    (` (if (< (, a1) 0)
-	   (- (/ (- (, a1)) (, a2)))
-	 (/ (, a1) (, a2))))))
-
-(defun news-find-first-or-last (pfx base dirn)
-  ;; first use powers of two to find a plausible ceiling
-  (let ((original-dir dirn))
-    (while (news-wins pfx (+ base dirn))
-      (setq dirn (* dirn 2)))
-    (setq dirn (news-/ dirn 2))
-    ;; Then use a binary search to find the high water mark
-    (let ((offset (news-/ dirn 2)))
-      (while (/= offset 0)
-	(if (news-wins pfx (+ base dirn offset))
-	    (setq dirn (+ dirn offset)))
-	(setq offset (news-/ offset 2))))
-    ;; If this high-water mark is bogus, recurse.
-    (let ((offset (* news-max-plausible-gap original-dir)))
-      (while (and (/= offset 0) (not (news-wins pfx (+ base dirn offset))))
-	(setq offset (- offset original-dir)))
-      (if (= offset 0)
-	  (+ base dirn)
-	(news-find-first-or-last pfx (+ base dirn offset) original-dir)))))
-
-(defun rnews ()
-"Read USENET news for groups for which you are a member and add or
-delete groups.
-You can reply to articles posted and send articles to any group.
-
-Type \\[describe-mode] once reading news to get a list of rnews commands."
-  (interactive)
-  (let ((last-buffer (buffer-name)))
-    (make-local-variable 'rmail-last-file)
-    (switch-to-buffer (setq news-buffer (get-buffer-create "*news*")))
-    (news-mode)
-    (setq news-buffer-save last-buffer)
-    (setq buffer-read-only nil)
-    (erase-buffer)
-    (setq buffer-read-only t)
-    (set-buffer-modified-p t)
-    (sit-for 0)
-    (message "Getting new USENET news...")
-    (news-set-mode-line)
-    (news-get-certifications)
-    (news-get-new-news)))
-
-(defun news-group-certification (group)
-  (cdr-safe (assoc group news-current-certifications)))
-
-
-(defun news-set-current-certifiable ()
-  ;; Record the date that corresponds to the directory you are about to check
-  (let ((file (concat news-path
-		      (string-subst-char ?/ ?. news-current-news-group))))
-    (setq news-current-certifiable
-	  (nth 5 (file-attributes
-		  (or (file-symlink-p file) file))))))
-
-(defun news-get-certifications ()
-  ;; Read the certified-read file from last session
-  (save-excursion
-    (save-window-excursion
-      (setq news-current-certifications
-	    (car-safe
-	     (condition-case var
-		 (let*
-		     ((file (substitute-in-file-name news-certification-file))
-		      (buf (find-file-noselect file)))
-		   (and (file-exists-p file)
-			(progn
-			  (switch-to-buffer buf 'norecord)
-			  (unwind-protect
-			      (read-from-string (buffer-string))
-			    (kill-buffer buf)))))
-	       (error nil)))))))
-
-(defun news-write-certifications ()
-  ;; Write a certification file.
-  ;; This is an assoc list of group names with doubletons that represent
-  ;; mod times of the directory when group is read completely.
-  (save-excursion
-    (save-window-excursion
-      (with-output-to-temp-buffer
-	  "*CeRtIfIcAtIoNs*"
-	  (print news-current-certifications))
-      (let ((buf (get-buffer "*CeRtIfIcAtIoNs*")))
-	(switch-to-buffer buf)
-	(write-file (substitute-in-file-name news-certification-file))
-	(kill-buffer buf)))))
-
-(defun news-set-current-group-certification ()
-  (let ((cgc (assoc news-current-news-group news-current-certifications)))
-    (if cgc (setcdr cgc news-current-certifiable)
-      (news-push (cons news-current-news-group news-current-certifiable)
-		 news-current-certifications))))
-
-(defun news-set-minor-modes ()
-  "Creates a minor mode list that has group name, total articles,
-and attribute for current article."
-  (setq news-minor-modes (list (cons 'foo
-				     (concat news-current-message-number
-					     "/"
-					     news-total-current-group
-					     (news-get-attribute-string)))))
-  ;; Detect Emacs versions 18.16 and up, which display
-  ;; directly from news-minor-modes by using a list for mode-name.
-  (or (boundp 'minor-mode-alist)
-      (setq minor-modes news-minor-modes)))
-
-(defun news-set-message-counters ()
-  "Scan through current news-groups filelist to figure out how many messages
-are there. Set counters for use with minor mode display."
-    (if (null news-list-of-files)
-	(setq news-current-message-number 0)))
-
-(if news-mode-map
-    nil
-  (setq news-mode-map (make-keymap))
-  (suppress-keymap news-mode-map)
-  (define-key news-mode-map "." 'beginning-of-buffer)
-  (define-key news-mode-map " " 'scroll-up)
-  (define-key news-mode-map "\177" 'scroll-down)
-  (define-key news-mode-map "n" 'news-next-message)
-  (define-key news-mode-map "c" 'news-make-link-to-message)
-  (define-key news-mode-map "p" 'news-previous-message)
-  (define-key news-mode-map "j" 'news-goto-message)
-  (define-key news-mode-map "q" 'news-exit)
-  (define-key news-mode-map "e" 'news-exit)
-  (define-key news-mode-map "\ej" 'news-goto-news-group)
-  (define-key news-mode-map "\en" 'news-next-group)
-  (define-key news-mode-map "\ep" 'news-previous-group)
-  (define-key news-mode-map "l" 'news-list-news-groups)
-  (define-key news-mode-map "?" 'describe-mode)
-  (define-key news-mode-map "g" 'news-get-new-news)
-  (define-key news-mode-map "f" 'news-reply)
-  (define-key news-mode-map "m" 'news-mail-other-window)
-  (define-key news-mode-map "a" 'news-post-news)
-  (define-key news-mode-map "r" 'news-mail-reply)
-  (define-key news-mode-map "o" 'news-save-item-in-file)
-  (define-key news-mode-map "\C-o" 'rmail-output)
-  (define-key news-mode-map "t" 'news-show-all-headers)
-  (define-key news-mode-map "x" 'news-force-update)
-  (define-key news-mode-map "A" 'news-add-news-group)
-  (define-key news-mode-map "u" 'news-unsubscribe-current-group)
-  (define-key news-mode-map "U" 'news-unsubscribe-group)
-  (define-key news-mode-map "\C-c\C-r" 'news-caesar-buffer-body))
-
-(defun news-mode ()
-  "News Mode is used by M-x rnews for reading USENET Newsgroups articles.
-New readers can find additional help in newsgroup: news.announce.newusers .
-All normal editing commands are turned off.
-Instead, these commands are available:
-
-.	move point to front of this news article (same as Meta-<).
-Space	scroll to next screen of this news article.
-Delete  scroll down previous page of this news article.
-n	move to next news article, possibly next group.
-p	move to previous news article, possibly previous group.
-j	jump to news article specified by numeric position.
-M-j     jump to news group.
-M-n     goto next news group.
-M-p     goto previous news group.
-l       list all the news groups with current status.
-?       print this help message.
-C-c C-r caesar rotate all letters by 13 places in the article's body (rot13).
-g       get new USENET news.
-f       post a reply article to USENET.
-a       post an original news article.
-A       add a newsgroup. 
-o	save the current article in the named file (append if file exists).
-C-o	output this message to a Unix-format mail file (append it).
-c       \"copy\" (actually link) current or prefix-arg msg to file.
-	warning: target directory and message file must be on same device
-		(UNIX magic)
-t       show all the headers this news article originally had.
-q	quit reading news after updating .newsrc file.
-e	exit updating .newsrc file.
-m	mail a news article.  Same as C-x 4 m.
-x       update last message seen to be the current message.
-r	mail a reply to this news article.  Like m but initializes some fields.
-u       unsubscribe from current newsgroup.
-U       unsubscribe from specified newsgroup."
-  (interactive)
-  (kill-all-local-variables)
-  (make-local-variable 'news-read-first-time-p)
-  (setq news-read-first-time-p t)
-  (make-local-variable 'news-current-news-group)
-;  (setq news-current-news-group "??")
-  (make-local-variable 'news-current-group-begin)
-  (setq news-current-group-begin 0)
-  (make-local-variable 'news-current-message-number)
-  (setq news-current-message-number 0)
-  (make-local-variable 'news-total-current-group)
-  (make-local-variable 'news-buffer-save)
-  (make-local-variable 'version-control)
-  (setq version-control 'never)
-  (make-local-variable 'news-point-pdl)
-;  This breaks it.  I don't have time to figure out why. -- RMS
-;  (make-local-variable 'news-group-article-assoc)
-  (setq major-mode 'news-mode)
-  (setq mode-line-process '(news-minor-modes))
-  (setq mode-name "NEWS")
-  (news-set-mode-line)
-  (set-syntax-table text-mode-syntax-table)
-  (use-local-map news-mode-map)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (run-hooks 'news-mode-hook))
-
-(defun string-subst-char (new old string)
-  (let (index)
-    (setq old (regexp-quote (char-to-string old))
-	  string (substring string 0))
-    (while (setq index (string-match old string))
-      (aset string index new)))
-  string)
-
-;; update read message number
-(defmacro news-update-message-read (ngroup nno)
-  (list 'setcar
-	(list 'news-cdadr
-	      (list 'assoc ngroup 'news-group-article-assoc))
-	nno))
-
-(defun news-parse-range (number-string)
-  "Parse string representing range of numbers of he form <a>-<b>
-to a list (a . b)"
-  (let ((n (string-match "-" number-string)))
-    (if n
-	(cons (string-to-int (substring number-string 0 n))
-	      (string-to-int (substring number-string (1+ n))))
-      (setq n (string-to-int number-string))
-      (cons n n))))
-
-;(defun is-in (elt lis)
-;  (catch 'foo
-;    (while lis
-;      (if (equal (car lis) elt)
-;	  (throw 'foo t)
-;	(setq lis (cdr lis))))))
-
-(defun news-get-new-news ()
-  "Get new USENET news, if there is any for the current user."
-  (interactive)
-  (if (not (null news-user-group-list))
-      (news-update-newsrc-file))
-  (setq news-group-article-assoc ())
-  (setq news-user-group-list ())
-  (message "Looking up %s file..." news-startup-file)
-  (let ((file (substitute-in-file-name news-startup-file))
-	(temp-user-groups ()))
-    (save-excursion
-      (let ((newsrcbuf (find-file-noselect file))
-	    start end endofline tem)
-	(set-buffer newsrcbuf)
-	(goto-char 0)
-	(while (search-forward ": " nil t)
-	  (setq end (point))
-	  (beginning-of-line)
-	  (setq start (point))
-	  (end-of-line)
-	  (setq endofline (point))
-	  (setq tem (buffer-substring start (- end 2)))
-	  (let ((range (news-parse-range
-			(buffer-substring end endofline))))
-	    (if (assoc tem news-group-article-assoc)
-		(message "You are subscribed twice to %s; I ignore second"
-			 tem)	      
-	      (setq temp-user-groups (cons tem temp-user-groups)
-		    news-group-article-assoc
-		    (cons (list tem (list (car range)
-					  (cdr range)
-					  (cdr range)))
-			  news-group-article-assoc)))))
-	(kill-buffer newsrcbuf)))      
-    (setq temp-user-groups (nreverse temp-user-groups))
-    (message "Prefrobnicating...")
-    (switch-to-buffer news-buffer)
-    (setq news-user-group-list temp-user-groups)
-    (while (and temp-user-groups
-		(not (news-read-files-into-buffer
-		      (car temp-user-groups) nil)))
-      (setq temp-user-groups (cdr temp-user-groups)))
-    (if (null temp-user-groups)
-	(message "No news is good news.")
-      (message ""))))
-
-(defun news-list-news-groups ()
-  "Display all the news groups to which you belong."
-  (interactive)
-  (with-output-to-temp-buffer "*Newsgroups*"
-    (save-excursion
-      (set-buffer standard-output)
-      (insert
-	"News Group        Msg No.       News Group        Msg No.\n")
-      (insert
-	"-------------------------       -------------------------\n")
-      (let ((temp news-user-group-list)
-	    (flag nil))
-	(while temp
-	  (let ((item (assoc (car temp) news-group-article-assoc)))
-	    (insert (car item))
-	    (indent-to (if flag 52 20))
-	    (insert (int-to-string (news-cadr (news-cadr item))))
-	    (if flag
-		(insert "\n")
-	      (indent-to 33))
-	    (setq temp (cdr temp) flag (not flag))))))))
-
-;; Mode line hack
-(defun news-set-mode-line ()
-  "Set mode line string to something useful."
-  (setq mode-line-process
-	(concat " "
-		(if (integerp news-current-message-number)
-		    (int-to-string news-current-message-number)
-		 "??")
-		"/"
-		(if (integerp news-current-group-end)
-		    (int-to-string news-current-group-end)
-		  news-current-group-end)))
-  (setq mode-line-buffer-identification
-	(concat "NEWS: "
-		news-current-news-group
-		;; Enough spaces to pad group name to 17 positions.
-		(substring "                 "
-			   0 (max 0 (- 17 (length news-current-news-group))))))
-  (set-buffer-modified-p t)
-  (sit-for 0))
-
-(defun news-goto-news-group (gp)
-  "Takes a string and goes to that news group."
-  (interactive (list (completing-read "NewsGroup: "
-				      news-group-article-assoc)))
-  (message "Jumping to news group %s..." gp)
-  (news-select-news-group gp)
-  (message "Jumping to news group %s... done." gp))
-
-(defun news-select-news-group (gp)
-  (let ((grp (assoc gp news-group-article-assoc)))
-    (if (null grp)
- 	(error "Group %s not subscribed to" gp)
-      (progn
-	(news-update-message-read news-current-news-group
-				  (news-cdar news-point-pdl))
-	(news-read-files-into-buffer  (car grp) nil)
-	(news-set-mode-line)))))
-
-(defun news-goto-message (arg)
-  "Goes to the article ARG in current newsgroup."
-  (interactive "p")
-  (if (null current-prefix-arg)
-      (setq arg (read-no-blanks-input "Go to article: " "")))
-  (news-select-message arg))
-
-(defun news-select-message (arg)
-  (if (stringp arg) (setq arg (string-to-int arg)))
-  (let ((file (concat news-path
-		      (string-subst-char ?/ ?. news-current-news-group)
-		      "/" arg)))
-    (if (= arg 
-	   (or (news-cadr (memq (news-cdar news-point-pdl) news-list-of-files))
-	       0))
-	(setcdr (car news-point-pdl) arg))
-    (setq news-current-message-number arg)
-    (if (file-exists-p file)
-  	(let ((buffer-read-only nil))
-  	  (news-read-in-file file)
-  	  (news-set-mode-line))
-      (news-set-mode-line)
-      (error "Article %d nonexistent" arg))))
-
-(defun news-force-update ()
-  "updates the position of last article read in the current news group"
-  (interactive)
-  (setcdr (car news-point-pdl) news-current-message-number)
-  (message "Updated to %d" news-current-message-number))
-
-(defun news-next-message (arg)
-  "Move ARG messages forward within one newsgroup.
-Negative ARG moves backward.
-If ARG is 1 or -1, moves to next or previous newsgroup if at end."
-  (interactive "p")
-  (let ((no (+ arg news-current-message-number)))
-    (if (or (< no news-current-group-begin) 
-	    (> no news-current-group-end))
-	(cond ((= arg 1)
-	       (news-set-current-group-certification)
-	       (news-next-group))
-	      ((= arg -1)
-	       (news-previous-group))
-	      (t (error "Article out of range")))
-      (let ((plist (news-get-motion-lists
-		     news-current-message-number
-		     news-list-of-files)))
-	(if (< arg 0)
-	    (news-select-message (nth (1- (- arg)) (car (cdr plist))))
-	  (news-select-message (nth (1- arg) (car plist))))))))
-
-(defun news-previous-message (arg)
-  "Move ARG messages backward in current newsgroup.
-With no arg or arg of 1, move one message
-and move to previous newsgroup if at beginning.
-A negative ARG means move forward."
-  (interactive "p")
-  (news-next-message (- arg)))
-
-(defun news-move-to-group (arg)
-  "Given arg move forward or backward to a new newsgroup."
-  (let ((cg news-current-news-group))
-    (let ((plist (news-get-motion-lists cg news-user-group-list))
-	  ngrp)
-      (if (< arg 0)
-	  (or (setq ngrp (nth (1- (- arg)) (news-cadr plist)))
-	      (error "No previous news groups"))
-	(or (setq ngrp (nth arg (car plist)))
-	    (error "No more news groups")))
-      (news-select-news-group ngrp))))
-
-(defun news-next-group ()
-  "Moves to the next user group."
-  (interactive)
-;  (message "Moving to next group...")
-  (news-move-to-group 0)
-  (while (null news-list-of-files)
-    (news-move-to-group 0)))
-;  (message "Moving to next group... done.")
-
-(defun news-previous-group ()
-  "Moves to the previous user group."
-  (interactive)
-;  (message "Moving to previous group...")
-  (news-move-to-group -1)
-  (while (null news-list-of-files)
-    (news-move-to-group -1)))
-;  (message "Moving to previous group... done.")
-
-(defun news-get-motion-lists (arg listy)
-  "Given a msgnumber/group this will return a list of two lists;
-one for moving forward and one for moving backward."
-  (let ((temp listy)
-	(result ()))
-    (catch 'out
-      (while temp
-	(if (equal (car temp) arg)
-	    (throw 'out (cons (cdr temp) (list result)))
-	  (setq result (nconc (list (car temp)) result))
-	  (setq temp (cdr temp)))))))
-
-;; miscellaneous io routines
-(defun news-read-in-file (filename)
-  (erase-buffer)
-  (let ((start (point)))
-  (insert-file-contents filename)
-  (news-convert-format)
-  ;; Run each hook that applies to the current newsgroup.
-  (let ((hooks news-group-hook-alist))
-    (while hooks
-      (goto-char start)
-      (if (string-match (car (car hooks)) news-group-name)
-	  (funcall (cdr (car hooks))))
-      (setq hooks (cdr hooks))))
-  (goto-char start)
-  (forward-line 1)
-  (if (eobp)
-      (message "(Empty file?)")
-    (goto-char start))))
-
-(defun news-convert-format ()
-  (save-excursion
-    (save-restriction
-      (let* ((start (point))
-	     (end (condition-case ()
-		      (progn (search-forward "\n\n") (point))
-		    (error nil)))
-	     has-from has-date)
-       (cond (end
-	      (narrow-to-region start end)
-	      (goto-char start)
-	      (setq has-from (search-forward "\nFrom:" nil t))
-	      (cond ((and (not has-from) has-date)
-		     (goto-char start)
-		     (search-forward "\nDate:")
-		     (beginning-of-line)
-		     (kill-line) (kill-line)))
-	      (news-delete-headers start)
-	      (goto-char start)))))))
-
-(defun news-show-all-headers ()
-  "Redisplay current news item with all original headers"
-  (interactive)
-  (let (news-ignored-headers
-	(buffer-read-only ()))
-    (erase-buffer)
-    (news-set-mode-line)
-    (news-read-in-file
-     (concat news-path
-	     (string-subst-char ?/ ?. news-current-news-group)
-	     "/" (int-to-string news-current-message-number)))))
-
-(defun news-delete-headers (pos)
-  (goto-char pos)
-  (and (stringp news-ignored-headers)
-       (while (re-search-forward news-ignored-headers nil t)
-	 (beginning-of-line)
-	 (delete-region (point)
-			(progn (re-search-forward "\n[^ \t]")
-			       (forward-char -1)
-			       (point))))))
-
-(defun news-exit ()
-  "Quit news reading session and update the .newsrc file."
-  (interactive)
-  (if (y-or-n-p "Do you really wanna quit reading news ? ")
-      (progn (message "Updating %s..." news-startup-file)
-	     (news-update-newsrc-file)
-	     (news-write-certifications)
-	     (message "Updating %s... done" news-startup-file)
-	     (message "Now do some real work")
-	     (and (fboundp 'bury-buffer) (bury-buffer (current-buffer)))
-	     (switch-to-buffer news-buffer-save)
-	     (setq news-user-group-list ()))
-    (message "")))
-
-(defun news-update-newsrc-file ()
-  "Updates the .newsrc file in the users home dir."
-  (let ((newsrcbuf (find-file-noselect
-		     (substitute-in-file-name news-startup-file)))
-	(tem news-user-group-list)
-	group)
-    (save-excursion
-      (if (not (null news-current-news-group))
-	  (news-update-message-read news-current-news-group
-				    (news-cdar news-point-pdl)))
-      (set-buffer newsrcbuf)
-      (while tem
-	(setq group (assoc (car tem) news-group-article-assoc))
-	(if (= (news-cadr (news-cadr group)) (news-caddr (news-cadr group)))
-	    nil
-	  (goto-char 0)
-	  (if (search-forward (concat (car group) ": ") nil t)
-	      (kill-line nil)
-	    (insert (car group) ": \n") (backward-char 1))
-	  (insert (int-to-string (car (news-cadr group))) "-"
-		  (int-to-string (news-cadr (news-cadr group)))))
-	(setq tem (cdr tem)))
-     (while news-unsubscribe-groups
-       (setq group (assoc (car news-unsubscribe-groups)
-			  news-group-article-assoc))
-       (goto-char 0)
-       (if (search-forward (concat (car group) ": ") nil t)
-	   (progn
-	      (backward-char 2)
-	      (kill-line nil)
-	      (insert "! " (int-to-string (car (news-cadr group)))
-		      "-" (int-to-string (news-cadr (news-cadr group))))))
-       (setq news-unsubscribe-groups (cdr news-unsubscribe-groups)))
-     (save-buffer)
-     (kill-buffer (current-buffer)))))
-
-
-(defun news-unsubscribe-group (group)
-  "Removes you from newgroup GROUP."
-  (interactive (list (completing-read  "Unsubscribe from group: "
-				      news-group-article-assoc)))
-  (news-unsubscribe-internal group))
-
-(defun news-unsubscribe-current-group ()
-  "Removes you from the newsgroup you are now reading."
-  (interactive)
-  (if (y-or-n-p "Do you really want to unsubscribe from this group ? ")
-      (news-unsubscribe-internal news-current-news-group)))
-
-(defun news-unsubscribe-internal (group)
-  (let ((tem (assoc group news-group-article-assoc)))
-    (if tem
-	(progn
-	  (setq news-unsubscribe-groups (cons group news-unsubscribe-groups))
-	  (news-update-message-read group (news-cdar news-point-pdl))
-	  (if (equal group news-current-news-group)
-	      (news-next-group))
-	  (message ""))
-      (error "Not subscribed to group: %s" group))))
-
-(defun news-save-item-in-file (file)
-  "Save the current article that is being read by appending to a file."
-  (interactive "FSave item in file: ")
-  (append-to-file (point-min) (point-max) file))
-
-(defun news-get-pruned-list-of-files (gp-list end-file-no)
-  "Given a news group it finds all files in the news group.
-The arg must be in slashified format.
-Using ls was found to be too slow in a previous version."
-  (let
-      ((answer
-	(and
-	 (not (and end-file-no
-		   (equal (news-set-current-certifiable)
-		     (news-group-certification gp-list))
-		   (setq news-list-of-files nil
-			 news-list-of-files-possibly-bogus t)))
-	 (let* ((file-directory (concat news-path
-					(string-subst-char ?/ ?. gp-list)))
-		tem
-		(last-winner
-		 (and end-file-no
-		      (news-wins file-directory end-file-no)
-		      (news-find-first-or-last file-directory end-file-no 1))))
-	   (setq news-list-of-files-possibly-bogus t news-list-of-files nil)
-	   (if last-winner
-	       (progn
-		 (setq news-list-of-files-possibly-bogus t
-		       news-current-group-end last-winner)
-		 (while (> last-winner end-file-no)
-		   (news-push last-winner news-list-of-files)
-		   (setq last-winner (1- last-winner)))
-		 news-list-of-files)
-	     (if (or (not (file-directory-p file-directory))
-		     (not (file-readable-p file-directory)))
-		 nil
-	       (setq news-list-of-files
-		     (condition-case error
-			 (directory-files file-directory)
-		       (file-error
-			(if (string= (nth 2 error) "permission denied")
-			    (message "Newsgroup %s is read-protected"
-				     gp-list)
-			  (signal 'file-error (cdr error)))
-			nil)))
-	       (setq tem news-list-of-files)
-	       (while tem
-		 (if (or (not (string-match "^[0-9]*$" (car tem)))
-			 ;; don't get confused by directories that look like numbers
-			 (file-directory-p
-			  (concat file-directory "/" (car tem)))
-			 (<= (string-to-int (car tem)) end-file-no))
-		     (setq news-list-of-files
-			   (delq (car tem) news-list-of-files)))
-		 (setq tem (cdr tem)))
-	       (if (null news-list-of-files)
-		   (progn (setq news-current-group-end 0)
-			  nil)
-		 (setq news-list-of-files
-		       (mapcar 'string-to-int news-list-of-files))
-		 (setq news-list-of-files (sort news-list-of-files '<))
-		 (setq news-current-group-end
-		       (elt news-list-of-files
-			    (1- (length news-list-of-files))))
-		 news-list-of-files)))))))
-    (or answer (progn (news-set-current-group-certification) nil))))
-
-(defun news-read-files-into-buffer (group reversep)
-  (let* ((files-start-end (news-cadr (assoc group news-group-article-assoc)))
-	 (start-file-no (car files-start-end))
-	 (end-file-no (news-cadr files-start-end))
-	 (buffer-read-only nil))
-    (setq news-current-news-group group)
-    (setq news-current-message-number nil)
-    (setq news-current-group-end nil)
-    (news-set-mode-line)
-    (news-get-pruned-list-of-files group end-file-no)
-    (news-set-mode-line)
-    ;; @@ should be a lot smarter than this if we have to move
-    ;; @@ around correctly.
-    (setq news-point-pdl (list (cons (car files-start-end)
-				     (news-cadr files-start-end))))
-    (if (null news-list-of-files)
-	(progn (erase-buffer)
-	       (setq news-current-group-end end-file-no)
-	       (setq news-current-group-begin end-file-no)
-	       (setq news-current-message-number end-file-no)
-	       (news-set-mode-line)
-;	       (message "No new articles in " group " group.")
-	       nil)
-      (setq news-current-group-begin (car news-list-of-files))
-      (if reversep
-	  (setq news-current-message-number news-current-group-end)
-	(if (> (car news-list-of-files) end-file-no)
-	    (setcdr (car news-point-pdl) (car news-list-of-files)))
-	(setq news-current-message-number news-current-group-begin))
-      (news-set-message-counters)
-      (news-set-mode-line)
-      (news-read-in-file (concat news-path
-				 (string-subst-char ?/ ?. group)
-				 "/"
-				 (int-to-string
-				   news-current-message-number)))
-      (news-set-message-counters)
-      (news-set-mode-line)
-      t)))
-
-(defun news-add-news-group (gp)
-  "Resubscribe to or add a USENET news group named GROUP (a string)."
-; @@ (completing-read ...)
-; @@ could be based on news library file ../active (slightly fascist)
-; @@ or (expensive to compute) all directories under the news spool directory
-  (interactive "sAdd news group: ")
-  (let ((file-dir (concat news-path (string-subst-char ?/ ?. gp))))
-    (save-excursion
-      (if (null (assoc gp news-group-article-assoc))
-	  (let ((newsrcbuf (find-file-noselect
-			    (substitute-in-file-name news-startup-file))))
-	    (if (file-directory-p file-dir)
-		(progn
-		  (switch-to-buffer newsrcbuf)
-		  (goto-char 0)
-		  (if (search-forward (concat gp "! ") nil t)
-		      (progn
-			(message "Re-subscribing to group %s." gp)
-			;;@@ news-unsubscribe-groups isn't being used
-			;;(setq news-unsubscribe-groups
-			;;    (delq gp news-unsubscribe-groups))
-			(backward-char 2)
-			(delete-char 1)
-			(insert ":"))
-		    (progn
-		      (message
-		       "Added %s to your list of newsgroups." gp)
-		      (end-of-buffer)
-		      (insert gp ": 1-1\n")))
-		  (search-backward gp nil t)
-		  (let (start end endofline tem)
-		    (search-forward ": " nil t)
-		    (setq end (point))
-		    (beginning-of-line)
-		    (setq start (point))
-		    (end-of-line)
-		    (setq endofline (point))
-		    (setq tem (buffer-substring start (- end 2)))
-		    (let ((range (news-parse-range
-				  (buffer-substring end endofline))))
-		      (setq news-group-article-assoc
-			    (cons (list tem (list (car range)
-						  (cdr range)
-						  (cdr range)))
-				  news-group-article-assoc))))
-		  (save-buffer)
-		  (kill-buffer (current-buffer)))
-	      (message "Newsgroup %s doesn't exist." gp)))
-	(message "Already subscribed to group %s." gp)))))
-
-(defun news-make-link-to-message (number newname)
-	"Forges a link to an rnews message numbered number (current if no arg)
-Good for hanging on to a message that might or might not be
-automatically deleted."
-  (interactive "P
-FName to link to message: ")
-  (add-name-to-file
-   (concat news-path
-	   (string-subst-char ?/ ?. news-current-news-group)
-	   "/" (if number
-		   (prefix-numeric-value number)
-		 news-current-message-number))
-   newname))
-
-;;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
-;;; modified by tower@prep Nov 86
-(defun caesar-region (&optional n)
-  "Caesar rotation of region by N, default 13, for decrypting netnews."
-  (interactive (if current-prefix-arg	; Was there a prefix arg?
-		   (list (prefix-numeric-value current-prefix-arg))
-		 (list nil)))
-  (cond ((not (numberp n)) (setq n 13))
-	(t (setq n (mod n 26))))	;canonicalize N
-  (if (not (zerop n))		; no action needed for a rot of 0
-      (progn
-	(if (or (not (boundp 'caesar-translate-table))
-		(/= (aref caesar-translate-table ?a) (+ ?a n)))
-	    (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
-	      (message "Building caesar-translate-table...")
-	      (setq caesar-translate-table (make-vector 256 0))
-	      (while (< i 256)
-		(aset caesar-translate-table i i)
-		(setq i (1+ i)))
-	      (setq lower (concat lower lower) upper (upcase lower) i 0)
-	      (while (< i 26)
-		(aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
-		(aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
-		(setq i (1+ i)))
-	      (message "Building caesar-translate-table... done")))
-	(let ((from (region-beginning))
-	      (to (region-end))
-	      (i 0) str len)
-	  (setq str (buffer-substring from to))
-	  (setq len (length str))
-	  (while (< i len)
-	    (aset str i (aref caesar-translate-table (aref str i)))
-	    (setq i (1+ i)))
-	  (goto-char from)
-	  (kill-region from to)
-	  (insert str)))))
-
-;;; news-caesar-buffer-body written by paul@media-lab.mit.edu  Wed Oct 1, 1986
-;;; hacked further by tower@prep.ai.mit.edu
-(defun news-caesar-buffer-body (&optional rotnum)
-  "Caesar rotates all letters in the current buffer by 13 places.
-Used to encode/decode possibly offensive messages (commonly in net.jokes).
-With prefix arg, specifies the number of places to rotate each letter forward.
-Mail and USENET news headers are not rotated."
-  (interactive (if current-prefix-arg	; Was there a prefix arg?
-		   (list (prefix-numeric-value current-prefix-arg))
-		 (list nil)))
-  (save-excursion
-    (let ((buffer-status buffer-read-only))
-      (setq buffer-read-only nil)
-      ;; setup the region
-      (set-mark (if (progn (goto-char (point-min))
-			    (search-forward
-			     (concat "\n"
-				     (if (equal major-mode 'news-mode)
-					 ""
-				       mail-header-separator)
-				     "\n") nil t))
-		     (point)
-		   (point-min)))
-      (goto-char (point-max))
-      (caesar-region rotnum)
-      (setq buffer-read-only buffer-status))))
-
-(provide 'rnews)
-
-;;; rnews.el ends here
diff --git a/lisp/mail/rnewspost.el b/lisp/mail/rnewspost.el
deleted file mode 100644
index 3d6be2505f0..00000000000
--- a/lisp/mail/rnewspost.el
+++ /dev/null
@@ -1,439 +0,0 @@
-;;; rnewspost.el --- USENET news poster/mailer for GNU Emacs
-
-;; Copyright (C) 1985, 1986, 1987, 1995 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail, news
-
-;; 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.
-
-;;; Change Log:
-
-;; moved posting and mail code from rnews.el
-;;	tower@prep.ai.mit.edu Wed Oct 29 1986
-;; brought posting code almost up to the revision of RFC 850 for News 2.11
-;; - couldn't see handling the special meaning of the Keyword: poster
-;; - not worth the code space to support the old A news Title: (which
-;;   Subject: replaced) and Article-I.D.: (which Message-ID: replaced)
-;;	tower@prep Nov 86
-;; changed C-c C-r key-binding due to rename of news-caesar-buffer-body
-;;	tower@prep 21 Nov 86
-;; added (require 'rnews)	tower@prep 22 Apr 87
-;; restricted call of news-show-all-headers in news-post-news & news-reply
-;;	tower@prep 28 Apr 87
-;; commented out Posting-Front-End to save USENET bytes tower@prep Jul 31 87
-;; commented out -n and -t args in news-inews     tower@prep 15 Oct 87
-
-;Now in paths.el.
-;(defvar news-inews-program "inews"
-;  "Function to post news.")
-
-;; Replying and posting news items are done by these functions.
-;; imported from rmail and modified to work with rnews ...
-;; Mon Mar 25,1985 at 03:07:04 ads@mit-hermes.
-;; this is done so that rnews can operate independently from rmail.el and
-;; sendmail and doesn't have to autoload these functions.
-;;
-;;; >> Nuked by Mly to autoload those functions again, as the duplication of
-;;; >>  code was making maintenance too difficult.
-
-;;; Code:
-
-(require 'sendmail)
-(require 'rnews)
-
-(defvar news-reply-mode-map () "Mode map used by news-reply.")
-
-(or news-reply-mode-map
-    (progn
-      (setq news-reply-mode-map (make-keymap))
-      (define-key news-reply-mode-map "\C-c\C-f\C-d" 'news-reply-distribution)
-      (define-key news-reply-mode-map "\C-c\C-f\C-k" 'news-reply-keywords)
-      (define-key news-reply-mode-map "\C-c\C-f\C-n" 'news-reply-newsgroups)
-      (define-key news-reply-mode-map "\C-c\C-f\C-f" 'news-reply-followup-to)
-      (define-key news-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
-      (define-key news-reply-mode-map "\C-c\C-f\C-a" 'news-reply-summary)
-      (define-key news-reply-mode-map "\C-c\C-t" 'mail-text)
-      (define-key news-reply-mode-map "\C-c\C-r" 'news-caesar-buffer-body)
-      (define-key news-reply-mode-map "\C-c\C-w" 'news-reply-signature)
-      (define-key news-reply-mode-map "\C-c\C-y" 'news-reply-yank-original)
-      (define-key news-reply-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
-      (define-key news-reply-mode-map "\C-c\C-c" 'news-inews)
-      (define-key news-reply-mode-map "\C-c\C-s" 'news-inews)
-      (define-key news-reply-mode-map [menu-bar] (make-sparse-keymap))
-      (define-key news-reply-mode-map [menu-bar fields]
-	(cons "Fields" (make-sparse-keymap "Fields")))
-      (define-key news-reply-mode-map [menu-bar fields news-reply-distribution]
-	'("Distribution" . news-reply-distribution))
-      (define-key news-reply-mode-map [menu-bar fields news-reply-keywords]
-	'("Keywords" . news-reply-keywords))
-      (define-key news-reply-mode-map [menu-bar fields news-reply-newsgroups]
-	'("Newsgroups" . news-reply-newsgroups))
-      (define-key news-reply-mode-map [menu-bar fields news-reply-followup-to]
-	'("Followup-to" . news-reply-followup-to))
-      (define-key news-reply-mode-map [menu-bar fields mail-subject]
-	'("Subject" . mail-subject))
-      (define-key news-reply-mode-map [menu-bar fields news-reply-summary]
-	'("Summary" . news-reply-summary))
-      (define-key news-reply-mode-map [menu-bar fields mail-text]
-	'("Text" . mail-text))
-      (define-key news-reply-mode-map [menu-bar news]
-	(cons "News" (make-sparse-keymap "News")))
-      (define-key news-reply-mode-map [menu-bar news news-caesar-buffer-body]
-	'("Rot13" . news-caesar-buffer-body))
-      (define-key news-reply-mode-map [menu-bar news news-reply-yank-original]
-	'("Yank Original" . news-reply-yank-original))
-      (define-key news-reply-mode-map [menu-bar news mail-fill-yanked-message]
-	'("Fill Yanked Messages" . mail-fill-yanked-message))
-      (define-key news-reply-mode-map [menu-bar news news-inews]
-	'("Send" . news-inews))))
-
-(defun news-reply-mode ()
-  "Major mode for editing news to be posted on USENET.
-First-time posters are asked to please read the articles in newsgroup:
-                                                     news.announce.newusers .
-Like Text Mode but with these additional commands:
-
-C-c C-s  news-inews (post the message)    C-c C-c  news-inews
-C-c C-f	 move to a header field (and create it if there isn't):
-	 C-c C-f C-n  move to Newsgroups:	C-c C-f C-s  move to Subj:
-	 C-c C-f C-f  move to Followup-To:      C-c C-f C-k  move to Keywords:
-	 C-c C-f C-d  move to Distribution:	C-c C-f C-a  move to Summary:
-C-c C-y  news-reply-yank-original (insert current message, in NEWS).
-C-c C-q  mail-fill-yanked-message (fill what was yanked).
-C-c C-r  caesar rotate all letters by 13 places in the article's body (rot13)."
-  (interactive)
-  ;; require...
-  (or (fboundp 'mail-setup) (load "sendmail"))
-  (kill-all-local-variables)
-  (make-local-variable 'mail-reply-buffer)
-  (setq mail-reply-buffer nil)
-  (set-syntax-table text-mode-syntax-table)
-  (use-local-map news-reply-mode-map)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (setq major-mode 'news-reply-mode)
-  (setq mode-name "News Reply")
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start
-	(concat "^" (regexp-quote mail-header-separator) "$\\|"
-		paragraph-start))
-  (setq paragraph-separate
-	(concat "^" (regexp-quote mail-header-separator) "$\\|"
-		paragraph-separate))
-  (run-hooks 'text-mode-hook 'news-reply-mode-hook))
-
-(defvar news-reply-yank-from ""
-  "Save `From:' field for `news-reply-yank-original'.")
-
-(defvar news-reply-yank-message-id ""
-  "Save `Message-Id:' field for `news-reply-yank-original'.")
-
-(defun news-reply-yank-original (arg)
-  "Insert the message being replied to, if any (in Mail mode).
-Puts point before the text and mark after.
-Indents each nonblank line ARG spaces (default 3).
-Just \\[universal-argument] as argument means don't indent
-and don't delete any header fields."
-  (interactive "P")
-  (mail-yank-original arg)
-  (exchange-point-and-mark)
-  (run-hooks 'news-reply-header-hook))
-
-(defvar news-reply-header-hook
-  '(lambda ()
-	 (insert "In article " news-reply-yank-message-id
-			 " " news-reply-yank-from " writes:\n\n"))
-  "Hook for inserting a header at the top of a yanked message.")
-
-(defun news-reply-newsgroups ()
-  "Move point to end of `Newsgroups:' field.
-RFC 850 constrains the `Newsgroups:' field to be a comma-separated list
-of valid newsgroup names at your site.  For example,
-   Newsgroups: news.misc,comp.misc,rec.misc"
-  (interactive)
-  (expand-abbrev)
-  (goto-char (point-min))
-  (mail-position-on-field "Newsgroups"))
-
-(defun news-reply-followup-to ()
-  "Move point to end of `Followup-To:' field.  Create the field if none.
-One usually requests followups to only one newsgroup.
-RFC 850 constrains the `Followup-To:' field to be a comma-separated list
-of valid newsgroups names at your site, and it must be a subset of the
-`Newsgroups:' field.  For example:
-   Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc
-   Followup-To: news.misc,comp.misc,rec.misc"
-  (interactive)
-  (expand-abbrev)
-  (or (mail-position-on-field "Followup-To" t)
-      (progn (mail-position-on-field "newsgroups")
-	     (insert "\nFollowup-To: ")))
-	 ;; @@ could do a completing read based on the Newsgroups: field to
-	 ;; @@ fill in the Followup-To: field
-)
-
-(defun news-reply-distribution ()
-  "Move point to end of `Distribution:' optional field.
-Create the field if none.  Without this field the posting goes to all of
-USENET.  The field is used to restrict the posting to parts of USENET."
-  (interactive)
-  (expand-abbrev)
-  (mail-position-on-field "Distribution")
-  ;; @@could do a completing read based on the news library file:
-  ;; @@    ../distributions  to fill in the field.
-  )
-
-(defun news-reply-keywords ()
-  "Move point to end of `Keywords:' optional field.  Create the field if none.
-Used as an aid to the news reader, it can contain a few, well selected keywords
-identifying the message."
-  (interactive)
-  (expand-abbrev)
-  (mail-position-on-field "Keywords"))
-
-(defun news-reply-summary ()
-  "Move point to end of `Summary:' optional field.  Create the field if none.
-Used as an aid to the news reader, it can contain a succinct
-summary (abstract) of the message."
-  (interactive)
-  (expand-abbrev)
-  (mail-position-on-field "Summary"))
-
-(defun news-reply-signature ()
-  "The inews program appends `~/.signature' automatically."
-  (interactive)
-  (message "Posting news will append your signature automatically."))
-
-(defun news-setup (to subject in-reply-to newsgroups replybuffer)
-  "Set up the news reply or posting buffer with the proper headers and mode."
-  (setq mail-reply-buffer replybuffer)
-  (let ((mail-setup-hook nil)
-	;; Avoid inserting a signature.
-       	(mail-signature))
-    (if (null to)
-	;; this hack is needed so that inews wont be confused by 
-	;; the fcc: and bcc: fields
-	(let ((mail-self-blind nil)
-	      (mail-archive-file-name nil))
-	  (mail-setup to subject in-reply-to nil replybuffer nil)
-	  (beginning-of-line)
-	  (delete-region (point) (progn (forward-line 1) (point)))
-	  (goto-char (point-max)))
-      (mail-setup to subject in-reply-to nil replybuffer nil))
-    ;;;(mail-position-on-field "Posting-Front-End")
-    ;;;(insert (emacs-version))
-    (goto-char (point-max))
-    (if (let ((case-fold-search t))
-	  (re-search-backward "^Subject:" (point-min) t))
-	(progn (beginning-of-line)
-	       (insert "Newsgroups: " (or newsgroups "") "\n")
-	       (if (not newsgroups)
-		   (backward-char 1)
-		 (goto-char (point-max)))))
-    (run-hooks 'news-setup-hook)))
-   
-(defun news-inews ()
-  "Send a news message using inews."
-  (interactive)
-  (let* (newsgroups subject
-		    (case-fold-search nil))
-    (save-excursion
-      (save-restriction
-	(goto-char (point-min))
-	(search-forward (concat "\n" mail-header-separator "\n"))
-	(narrow-to-region (point-min) (point))
-	(setq newsgroups (mail-fetch-field "newsgroups")
-	      subject (mail-fetch-field "subject")))
-      (widen)
-      (goto-char (point-min))
-      (run-hooks 'news-inews-hook)
-      (goto-char (point-min))
-      (search-forward (concat "\n" mail-header-separator "\n"))
-      (replace-match "\n\n")
-      (goto-char (point-max))
-      ;; require a newline at the end for inews to append .signature to
-      (or (= (preceding-char) ?\n)
-	  (insert ?\n))
-      (message "Posting to USENET...")
-      (call-process-region (point-min) (point-max) 
-			   news-inews-program nil 0 nil
-			   "-h")	; take all header lines!
-			   ;@@ setting of subject and newsgroups still needed?
-			   ;"-t" subject
-			   ;"-n" newsgroups
-      (message "Posting to USENET... done")
-      (goto-char (point-min))		;restore internal header separator
-      (search-forward "\n\n")
-      (replace-match (concat "\n" mail-header-separator "\n"))
-      (set-buffer-modified-p nil))
-    (and (fboundp 'bury-buffer) (bury-buffer))))
-
-;@@ shares some code with news-reply and news-post-news
-(defun news-mail-reply ()
-  "Mail a reply to the author of the current article.
-While composing the reply, use \\[news-reply-yank-original] to yank the
-original message into it."
-  (interactive)
-  (let (from cc subject date to reply-to message-id
-	     (buffer (current-buffer)))
-    (save-restriction
-      (narrow-to-region (point-min) (progn (goto-line (point-min))
-					   (search-forward "\n\n")
-					   (- (point) 1)))
-      (setq from (mail-fetch-field "from")
-	    subject (mail-fetch-field "subject")
-	    reply-to (mail-fetch-field "reply-to")
-	    date (mail-fetch-field "date")
-	    message-id (mail-fetch-field "message-id")))
-    (setq to from)
-    (pop-to-buffer "*mail*")
-    (mail nil
-	  (if reply-to reply-to to)
-	  subject
-	  (let ((stop-pos (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
-	    (concat (if stop-pos (substring from 0 stop-pos) from)
-		    "'s message "
-		    (if message-id
-			(concat message-id " of ")
-		      "of ")
-		    date))
-	  nil
-	 buffer)))
-
-;@@ the guts of news-reply and news-post-news should be combined. -tower
-(defun news-reply ()
-  "Compose and post a reply (aka a followup) to the current article on USENET.
-While composing the followup, use \\[news-reply-yank-original] to yank the
-original message into it."
-  (interactive)
-  (if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
-      (let (from cc subject date to followup-to newsgroups message-of
-		 references distribution message-id
-		 (buffer (current-buffer)))
-	(save-restriction
-	  (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
-					;@@	of article file
-	       (equal major-mode 'news-mode) ;@@ if rmail-mode,
-					;@@	should show full headers
-	       (progn
-		 (news-show-all-headers) ;@@ should save/restore header state,
-					;@@	but rnews.el lacks support
-		 (narrow-to-region (point-min) (progn (goto-char (point-min))
-						      (search-forward "\n\n")
-						      (- (point) 1)))))
-	  (setq from (mail-fetch-field "from")
-		news-reply-yank-from from
-		;; @@ not handling old Title: field
-		subject (mail-fetch-field "subject")
-		date (mail-fetch-field "date")
-		followup-to (mail-fetch-field "followup-to")
-		newsgroups (or followup-to
-			       (mail-fetch-field "newsgroups"))
-		references (mail-fetch-field "references")
-		;; @@ not handling old Article-I.D.: field
-		distribution (mail-fetch-field "distribution")
-		message-id (mail-fetch-field "message-id")
-		news-reply-yank-message-id message-id)
-	  (pop-to-buffer "*post-news*")
-	  (news-reply-mode)
-	  (if (and (buffer-modified-p)
-		   (not
-		    (y-or-n-p "Unsent article being composed; erase it? ")))
-	      ()
-	    (progn
-	      (erase-buffer)
-	      (and subject
-		   (progn (if (string-match "\\`Re: " subject)
-			      (while (string-match "\\`Re: " subject)
-				(setq subject (substring subject 4))))
-			  (setq subject (concat "Re: " subject))))
-	      (and from
-		   (progn
-		     (let ((stop-pos
-			    (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
-		       (setq message-of
-			     (concat
-			      (if stop-pos (substring from 0 stop-pos) from)
-			      "'s message "
-			      (if message-id
-				  (concat message-id " of ")
-				"of ")
-			      date)))))
-	      (news-setup
-	       nil
-	       subject
-	       message-of
-	       newsgroups
-	       buffer)
-	      (if followup-to
-		  (progn (news-reply-followup-to)
-			 (insert followup-to)))
-	      (if distribution
-		  (progn
-		    (mail-position-on-field "Distribution")
-		    (insert distribution)))
-	      (mail-position-on-field "References")
-	      (if references
-		  (insert references))
-	      (if (and references message-id)
-		  (insert " "))
-	      (if message-id
-		  (insert message-id))
-	      (goto-char (point-max))))))
-    (message "")))
-
-;@@ the guts of news-reply and news-post-news should be combined. -tower
-;;;###autoload
-(defun news-post-news ()
-  "Begin editing a new USENET news article to be posted.
-Type \\[describe-mode] once editing the article to get a list of commands."
-  (interactive)
-  (if (y-or-n-p "Are you sure you want to post to all of USENET? ")
-      (let ((buffer (current-buffer)))
-	(save-restriction
-	  (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
-					;@@	of article file
-	       (equal major-mode 'news-mode) ;@@ if rmail-mode,
-					;@@	should show full headers
-	       (progn
-		 (news-show-all-headers) ;@@ should save/restore header state,
-					;@@	but rnews.el lacks support
-		 (narrow-to-region (point-min) (progn (goto-char (point-min))
-						      (search-forward "\n\n")
-						      (- (point) 1)))))
-	  (setq news-reply-yank-from (mail-fetch-field "from")
-		;; @@ not handling old Article-I.D.: field
-		news-reply-yank-message-id (mail-fetch-field "message-id")))
-	(pop-to-buffer "*post-news*")
-	(news-reply-mode)
-	(if (and (buffer-modified-p)
-		 (not (y-or-n-p "Unsent article being composed; erase it? ")))
-	    ()				;@@ not saving point from last time
-	  (progn (erase-buffer)
-		 (news-setup () () () () buffer))))
-  (message "")))
-
-(defun news-mail-other-window ()
-  "Send mail in another window.
-While composing the message, use \\[news-reply-yank-original] to yank the
-original message into it."
-  (interactive)
-  (mail-other-window nil nil nil nil nil (current-buffer)))
-
-;;; rnewspost.el ends here
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
deleted file mode 100644
index 0f697450c5a..00000000000
--- a/lisp/mail/sendmail.el
+++ /dev/null
@@ -1,1228 +0,0 @@
-;;; sendmail.el --- mail sending commands for Emacs.
-
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; 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 mode provides mail-sending facilities from within Emacs.  It is
-;; documented in the Emacs user's manual.
-
-;;; Code:
-
-;;;###autoload
-(defvar mail-from-style 'angles "\
-*Specifies how \"From:\" fields look.
-
-If `nil', they contain just the return address like:
-	king@grassland.com
-If `parens', they look like:
-	king@grassland.com (Elvis Parsley)
-If `angles', they look like:
-	Elvis Parsley <king@grassland.com>")
-
-;;;###autoload
-(defvar mail-self-blind nil "\
-*Non-nil means insert BCC to self in messages to be sent.
-This is done when the message is initialized,
-so you can remove or alter the BCC field to override the default.")
-
-;;;###autoload
-(defvar mail-interactive nil "\
-*Non-nil means when sending a message wait for and display errors.
-nil means let mailer mail back a message to report errors.")
-
-;;;###autoload
-(defvar mail-yank-ignored-headers "^via:\\|^mail-from:\\|^origin:\\|^status:\\|^remailed\\|^received:\\|^message-id:\\|^summary-line:\\|^to:\\|^subject:\\|^in-reply-to:\\|^return-path:" "\
-*Delete these headers from old message when it's inserted in a reply.")
-
-;; Useful to set in site-init.el
-;;;###autoload
-(defvar send-mail-function 'sendmail-send-it "\
-Function to call to send the current buffer as mail.
-The headers should be delimited by a line whose contents
-match the variable `mail-header-separator'.")
-
-;;;###autoload
-(defvar mail-header-separator "--text follows this line--" "\
-*Line used to separate headers from text in messages being composed.")
-
-;; Set up mail-header-separator for use as a category text property.
-(put 'mail-header-separator 'rear-nonsticky '(category))
-;;; This was a nice idea, for preventing accidental modification of
-;;; the separator.   But I found it also prevented or obstructed
-;;; certain deliberate operations, such as copying the separator line
-;;; up to the top to send myself a copy of an already sent outgoing message
-;;; and other things.  So I turned it off.  --rms.
-;;;(put 'mail-header-separator 'read-only t)
-
-;;;###autoload
-(defvar mail-archive-file-name nil "\
-*Name of file to write all outgoing messages in, or nil for none.
-This can be an inbox file or an Rmail file.")
-
-;;;###autoload
-(defvar mail-default-reply-to nil
-  "*Address to insert as default Reply-to field of outgoing messages.
-If nil, it will be initialized from the REPLYTO environment variable
-when you first send mail.")
-
-;;;###autoload
-(defvar mail-alias-file nil
-  "*If non-nil, the name of a file to use instead of `/usr/lib/aliases'.
-This file defines aliases to be expanded by the mailer; this is a different
-feature from that of defining aliases in `.mailrc' to be expanded in Emacs.
-This variable has no effect unless your system uses sendmail as its mailer.")
-
-;;;###autoload
-(defvar mail-personal-alias-file "~/.mailrc"
-  "*If non-nil, the name of the user's personal mail alias file.
-This file typically should be in same format as the `.mailrc' file used by
-the `Mail' or `mailx' program.
-This file need not actually exist.")
-
-(defvar mail-setup-hook nil
-  "Normal hook, run each time a new outgoing mail message is initialized.
-The function `mail-setup' runs this hook.")
-
-(defvar mail-aliases t
-  "Alist of mail address aliases,
-or t meaning should be initialized from your mail aliases file.
-\(The file's name is normally `~/.mailrc', but your MAILRC environment
-variable can override that name.)
-The alias definitions in the file have this form:
-    alias ALIAS MEANING")
-
-(defvar mail-alias-modtime nil
-  "The modification time of your mail alias file when it was last examined.")
-
-(defvar mail-yank-prefix nil
-  "*Prefix insert on lines of yanked message being replied to.
-nil means use indentation.")
-(defvar mail-indentation-spaces 3
-  "*Number of spaces to insert at the beginning of each cited line.
-Used by `mail-yank-original' via `mail-indent-citation'.")
-(defvar mail-yank-hooks nil
-  "Obsolete hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between (point) and (mark t).
-And each hook function should leave point and mark around the citation
-text as modified.
-
-This is a normal hook, misnamed for historical reasons.
-It is semi-obsolete and mail agents should no longer use it.")
-
-(defvar mail-citation-hook nil
-  "*Hook for modifying a citation just inserted in the mail buffer.
-Each hook function can find the citation between (point) and (mark t).
-And each hook function should leave point and mark around the citation
-text as modified.
-
-If this hook is entirely empty (nil), a default action is taken
-instead of no action.")
-
-(defvar mail-abbrevs-loaded nil)
-(defvar mail-mode-map nil)
-
-(autoload 'build-mail-aliases "mailalias"
-  "Read mail aliases from user's personal aliases file and set `mail-aliases'."
-  nil)
-
-(autoload 'expand-mail-aliases "mailalias"
-  "Expand all mail aliases in suitable header fields found between BEG and END.
-Suitable header fields are `To', `Cc' and `Bcc' and their `Resent-' variants.
-Optional second arg EXCLUDE may be a regular expression defining text to be
-removed from alias expansions."
-  nil)
-
-;;;###autoload
-(defvar mail-signature nil
-  "*Text inserted at end of mail buffer when a message is initialized.
-If t, it means to insert the contents of the file `mail-signature-file'.")
-
-(defvar mail-signature-file "~/.signature"
-  "*File containing the text inserted at end of mail buffer.")
-
-(defvar mail-reply-action nil)
-(defvar mail-send-actions nil
-  "A list of actions to be performed upon successful sending of a message.")
-(put 'mail-reply-action 'permanent-local t)
-(put 'mail-send-actions 'permanent-local t)
-
-(defvar mail-default-headers nil
-  "*A string containing header lines, to be inserted in outgoing messages.
-It is inserted before you edit the message,
-so you can edit or delete these lines.")
-
-(defvar mail-bury-selects-summary t
-  "*If non-nil, try to show RMAIL summary buffer after returning from mail.
-The functions \\[mail-send-on-exit] or \\[mail-dont-send] select
-the RMAIL summary buffer before returning, if it exists and this variable
-is non-nil.")
-
-;; Note: could use /usr/ucb/mail instead of sendmail;
-;; options -t, and -v if not interactive.
-(defvar mail-mailer-swallows-blank-line
-  (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" system-configuration)
-	   (file-readable-p "/etc/sendmail.cf")
-	   (let ((buffer (get-buffer-create " *temp*")))
-	     (unwind-protect
-		 (save-excursion
-		   (set-buffer buffer)
-		   (insert-file-contents "/etc/sendmail.cf")
-		   (goto-char (point-min))
-		   (let ((case-fold-search nil))
-		     (re-search-forward "^OR\\>" nil t)))
-	       (kill-buffer buffer))))
-      ;; According to RFC822, "The field-name must be composed of printable
-      ;; ASCII characters (i.e. characters that have decimal values between
-      ;; 33 and 126, except colon)", i.e. any chars except ctl chars,
-      ;; space, or colon.
-      '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
-  "Set this non-nil if the system's mailer runs the header and body together.
-\(This problem exists on Sunos 4 when sendmail is run in remote mode.)
-The value should be an expression to test whether the problem will
-actually occur.")
-
-(defvar mail-mode-syntax-table nil
-  "Syntax table used while in mail mode.")
-
-(if (not mail-mode-syntax-table)
-    (progn
-     (setq mail-mode-syntax-table (copy-syntax-table text-mode-syntax-table))
-     (modify-syntax-entry ?% ". " mail-mode-syntax-table)))
-
-(defvar mail-font-lock-keywords
-  (eval-when-compile
-    (let* ((cite-chars "[>|}]")
-	   (cite-prefix "A-Za-z")
-	   (cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
-      (list '("^To:" . font-lock-function-name-face)
-	    '("^B?CC:\\|^Reply-to:" . font-lock-keyword-face)
-	    '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
-	      (1 font-lock-comment-face) (2 font-lock-type-face nil t))
-	    ;; Use EVAL to delay in case `mail-header-separator' gets changed.
-	    '(eval cons (concat "^" (regexp-quote mail-header-separator) "$")
-		   'font-lock-comment-face)
-	    ;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
-	    `(,cite-chars
-	      (,(concat "\\=[ \t]*"
-			"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
-			cite-chars ".*")
-	       (beginning-of-line) (end-of-line)
-	       (0 font-lock-reference-face)))
-	    '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*"
-	      . font-lock-string-face))))
-  "Additional expressions to highlight in Mail mode.")
-
-(defvar mail-send-hook nil
-  "Normal hook run before sending mail, in Mail mode.")
-
-(defun sendmail-sync-aliases ()
-  (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
-    (or (equal mail-alias-modtime modtime)
-	(setq mail-alias-modtime modtime
-	      mail-aliases t))))
-
-(defun mail-setup (to subject in-reply-to cc replybuffer actions)
-  (or mail-default-reply-to
-      (setq mail-default-reply-to (getenv "REPLYTO")))
-  (sendmail-sync-aliases)
-  (if (eq mail-aliases t)
-      (progn
-	(setq mail-aliases nil)
-	(if (file-exists-p mail-personal-alias-file)
-	    (build-mail-aliases))))
-  (setq mail-send-actions actions)
-  (setq mail-reply-action replybuffer)
-  (goto-char (point-min))
-  (insert "To: ")
-  (save-excursion
-    (if to
-	;; Here removed code to extract names from within <...>
-	;; on the assumption that mail-strip-quoted-names
-	;; has been called and has done so.
-	(let ((fill-prefix "\t")
-	      (address-start (point)))
-	  (insert to "\n")
-	  (fill-region-as-paragraph address-start (point-max)))
-      (newline))
-    (if cc
-	(let ((fill-prefix "\t")
-	      (address-start (progn (insert "CC: ") (point))))
-	  (insert cc "\n")
-	  (fill-region-as-paragraph address-start (point-max))))
-    (if in-reply-to
-        (let ((fill-prefix "\t")
-	      (fill-column 78)
-	      (address-start (point)))
-	  (insert "In-reply-to: " in-reply-to "\n")
-	  (fill-region-as-paragraph address-start (point-max))))
-    (insert "Subject: " (or subject "") "\n")
-    (if mail-default-headers
-	(insert mail-default-headers))
-    (if mail-default-reply-to
-	(insert "Reply-to: " mail-default-reply-to "\n"))
-    (if mail-self-blind
-	(insert "BCC: " user-mail-address "\n"))
-    (if mail-archive-file-name
-	(insert "FCC: " mail-archive-file-name "\n"))
-    (put-text-property (point)
-		       (progn
-			 (insert mail-header-separator "\n")
-			 (1- (point)))
-		       'category 'mail-header-separator)
-    ;; Insert the signature.  But remember the beginning of the message.
-    (if to (setq to (point)))
-    (cond ((eq mail-signature t)
-	   (if (file-exists-p mail-signature-file)
-	       (progn
-		 (insert "\n\n-- \n")
-		 (insert-file-contents mail-signature-file))))
-	  (mail-signature
-	   (insert mail-signature)))
-    (goto-char (point-max))
-    (or (bolp) (newline)))
-  (if to (goto-char to))
-  (or to subject in-reply-to
-      (set-buffer-modified-p nil))
-  (run-hooks 'mail-setup-hook))
-
-;;;###autoload
-(defun mail-mode ()
-  "Major mode for editing mail to be sent.
-Like Text Mode but with these additional commands:
-C-c C-s  mail-send (send the message)    C-c C-c  mail-send-and-exit
-C-c C-f  move to a header field (and create it if there isn't):
-	 C-c C-f C-t  move to To:	C-c C-f C-s  move to Subject:
-	 C-c C-f C-c  move to CC:	C-c C-f C-b  move to BCC:
-	 C-c C-f C-f  move to FCC:
-C-c C-t  mail-text (move to beginning of message text).
-C-c C-w  mail-signature (insert `mail-signature-file' file).
-C-c C-y  mail-yank-original (insert current message, in Rmail).
-C-c C-q  mail-fill-yanked-message (fill what was yanked).
-C-c C-v  mail-sent-via (add a Sent-via field for each To or CC)."
-  (interactive)
-  (kill-all-local-variables)
-  (make-local-variable 'mail-reply-action)
-  (make-local-variable 'mail-send-actions)
-  (set-syntax-table mail-mode-syntax-table)
-  (use-local-map mail-mode-map)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (setq major-mode 'mail-mode)
-  (setq mode-name "Mail")
-  (setq buffer-offer-save t)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(mail-font-lock-keywords t))
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'normal-auto-fill-function)
-  (setq normal-auto-fill-function 'mail-mode-auto-fill)
-  (setq fill-paragraph-function 'mail-mode-fill-paragraph)
-  ;; `-- ' precedes the signature.  `-----' appears at the start of the
-  ;; lines that delimit forwarded messages.
-  ;; Lines containing just >= 3 dashes, perhaps after whitespace,
-  ;; are also sometimes used and should be separators.
-  (setq paragraph-start (concat (regexp-quote mail-header-separator)
-				"$\\|[ \t]*[-_][-_][-_]+$\\|-- $\\|-----\\|"
-				paragraph-start))
-  (setq paragraph-separate (concat (regexp-quote mail-header-separator)
-				   "$\\|[ \t]*[-_][-_][-_]+$\\|-- $\\|-----\\|"
-				   paragraph-separate))
-  (run-hooks 'text-mode-hook 'mail-mode-hook))
-
-(defun mail-mode-auto-fill ()
-  "Carry out Auto Fill for Mail mode.
-If within the headers, this makes the new lines into continuation lines."
-  (if (< (point)
-	 (save-excursion
-	   (goto-char (point-min))
-	   (if (search-forward mail-header-separator nil t)
-	       (point)
-	     0)))
-      (let ((old-line-start (save-excursion (beginning-of-line) (point))))
-	(if (do-auto-fill)
-	    (save-excursion
-	      (beginning-of-line)
-	      (while (not (eq (point) old-line-start))
-		(insert "   ")
-		(forward-line -1))
-	      t)))
-    (do-auto-fill)))
-
-(defun mail-mode-fill-paragraph (arg)
-  ;; Do something special only if within the headers.
-  (if (< (point)
-	 (save-excursion
-	   (goto-char (point-min))
-	   (if (search-forward mail-header-separator nil t)
-	       (point)
-	     0)))
-      (let (beg end fieldname) 
-	(re-search-backward "^[-a-zA-Z]+:" nil 'yes)
-	(setq beg (point))
-	(setq fieldname
-	      (downcase (buffer-substring beg (1- (match-end 0)))))
-	(forward-line 1)
-	;; Find continuation lines and get rid of their continuation markers.
-	(while (looking-at "[ \t]")
-	  (delete-horizontal-space)
-	  (forward-line 1))
-	(setq end (point-marker))
-	(goto-char beg)
-	;; If this field contains addresses,
-	;; make sure we can fill after each address.
-	(if (member fieldname
-		    '("to" "cc" "bcc" "from" "reply-to"
-		      "resent-to" "resent-cc" "resent-bcc"
-		      "resent-from" "resent-reply-to"))
-	    (while (search-forward "," end t)
-	      (or (looking-at "[ \t]")
-		  (insert " "))))
-	(fill-region-as-paragraph beg end)
-	;; Mark all lines except the first as continuations.
-	(goto-char beg)
-	(forward-line 1)
-	(while (< (point) end)
-	  (insert "  ")
-	  (forward-line 1))
-	(move-marker end nil)
-	t)))
-
-;;; Set up keymap.
-
-(if mail-mode-map
-    nil
-  (setq mail-mode-map (nconc (make-sparse-keymap) text-mode-map))
-  (define-key mail-mode-map "\M-\t" 'mail-complete)
-  (define-key mail-mode-map "\C-c?" 'describe-mode)
-  (define-key mail-mode-map "\C-c\C-f\C-t" 'mail-to)
-  (define-key mail-mode-map "\C-c\C-f\C-b" 'mail-bcc)
-  (define-key mail-mode-map "\C-c\C-f\C-f" 'mail-fcc)
-  (define-key mail-mode-map "\C-c\C-f\C-c" 'mail-cc)
-  (define-key mail-mode-map "\C-c\C-f\C-s" 'mail-subject)
-  (define-key mail-mode-map "\C-c\C-f\C-r" 'mail-reply-to)
-  (define-key mail-mode-map "\C-c\C-t" 'mail-text)
-  (define-key mail-mode-map "\C-c\C-y" 'mail-yank-original)
-  (define-key mail-mode-map "\C-c\C-r" 'mail-yank-region)
-  (define-key mail-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
-  (define-key mail-mode-map "\C-c\C-w" 'mail-signature)
-  (define-key mail-mode-map "\C-c\C-v" 'mail-sent-via)
-  (define-key mail-mode-map "\C-c\C-c" 'mail-send-and-exit)
-  (define-key mail-mode-map "\C-c\C-s" 'mail-send))
-
-(define-key mail-mode-map [menu-bar mail]
-  (cons "Mail" (make-sparse-keymap "Mail")))
-
-(define-key mail-mode-map [menu-bar mail fill]
-  '("Fill Citation" . mail-fill-yanked-message))
-
-(define-key mail-mode-map [menu-bar mail yank]
-  '("Cite Original" . mail-yank-original))
-
-(define-key mail-mode-map [menu-bar mail signature]
-  '("Insert Signature" . mail-signature))
-
-(define-key mail-mode-map [menu-bar mail cancel]
-  '("Cancel" . mail-dont-send))
-
-(define-key mail-mode-map [menu-bar mail send-stay]
-  '("Send, Keep Editing" . mail-send))
-
-(define-key mail-mode-map [menu-bar mail send]
-  '("Send Message" . mail-send-and-exit))
-
-(define-key mail-mode-map [menu-bar headers]
-  (cons "Headers" (make-sparse-keymap "Move to Header")))
-
-(define-key mail-mode-map [menu-bar headers reply-to]
-  '("Reply-To" . mail-reply-to))
-
-(define-key mail-mode-map [menu-bar headers sent-via]
-  '("Sent Via" . mail-sent-via))
-
-(define-key mail-mode-map [menu-bar headers text]
-  '("Text" . mail-text))
-
-(define-key mail-mode-map [menu-bar headers bcc]
-  '("Bcc" . mail-bcc))
-
-(define-key mail-mode-map [menu-bar headers fcc]
-  '("Fcc" . mail-fcc))
-
-(define-key mail-mode-map [menu-bar headers cc]
-  '("Cc" . mail-cc))
-
-(define-key mail-mode-map [menu-bar headers subject]
-  '("Subject" . mail-subject))
-
-(define-key mail-mode-map [menu-bar headers to]
-  '("To" . mail-to))
-
-;; User-level commands for sending.
-
-(defun mail-send-and-exit (arg)
-  "Send message like `mail-send', then, if no errors, exit from mail buffer.
-Prefix arg means don't delete this window."
-  (interactive "P")
-  (mail-send)
-  (mail-bury arg))
-
-(defun mail-dont-send (arg)
-  "Don't send the message you have been editing.
-Prefix arg means don't delete this window."
-  (interactive "P")
-  (mail-bury arg))
-
-(defun mail-bury (arg)
-  "Bury this mail buffer."
-  (let ((newbuf (other-buffer (current-buffer))))
-    (bury-buffer (current-buffer))
-    (if (and (or (window-dedicated-p (frame-selected-window))
-		 (assq 'mail-dedicated-frame (frame-parameters)))
-	     (not (null (delq (selected-frame) (visible-frame-list)))))
-	(delete-frame (selected-frame))
-      (let (rmail-flag summary-buffer)
-	(and (not arg)
-	     (not (one-window-p))
-	     (save-excursion
-	       (set-buffer (window-buffer (next-window (selected-window) 'not)))
-	       (setq rmail-flag (eq major-mode 'rmail-mode))
-	       (setq summary-buffer
-		     (and mail-bury-selects-summary
-			  (boundp 'rmail-summary-buffer)
-			  rmail-summary-buffer
-			  (buffer-name rmail-summary-buffer)
-			  (not (get-buffer-window rmail-summary-buffer))
-			  rmail-summary-buffer))))
-	(if rmail-flag
-	    ;; If the Rmail buffer has a summary, show that.
-	    (if summary-buffer (switch-to-buffer summary-buffer)
-	      (delete-window))
-	  (switch-to-buffer newbuf))))))
-
-(defun mail-send ()
-  "Send the message in the current buffer.
-If `mail-interactive' is non-nil, wait for success indication
-or error messages, and inform user.
-Otherwise any failure is reported in a message back to
-the user from the mailer."
-  (interactive)
-  (if (if buffer-file-name
-	  (y-or-n-p "Send buffer contents as mail message? ")
-	(or (buffer-modified-p)
-	    (y-or-n-p "Message already sent; resend? ")))
-      (let ((inhibit-read-only t))
-	(run-hooks 'mail-send-hook)
-	(message "Sending...")
-	(funcall send-mail-function)
-	;; Now perform actions on successful sending.
-	(while mail-send-actions
-	  (condition-case nil
-	      (apply (car (car mail-send-actions))
-		     (cdr (car mail-send-actions)))
-	    (error))
-	  (setq mail-send-actions (cdr mail-send-actions)))
-	(message "Sending...done")
-	;; If buffer has no file, mark it as unmodified and delete autosave.
-	(if (not buffer-file-name)
-	    (progn
-	      (set-buffer-modified-p nil)
-	      (delete-auto-save-file-if-necessary t))))))
-
-;; This does the real work of sending a message via sendmail.
-;; It is called via the variable send-mail-function.
-
-(defun sendmail-send-it ()
-  (require 'mail-utils)
-  (let ((errbuf (if mail-interactive
-		    (generate-new-buffer " sendmail errors")
-		  0))
-	(tembuf (generate-new-buffer " sendmail temp"))
-	(case-fold-search nil)
-	resend-to-addresses
-	delimline
-	fcc-was-found
-	(mailbuf (current-buffer)))
-    (unwind-protect
-	(save-excursion
-	  (set-buffer tembuf)
-	  (erase-buffer)
-	  (insert-buffer-substring mailbuf)
-	  (goto-char (point-max))
-	  ;; require one newline at the end.
-	  (or (= (preceding-char) ?\n)
-	      (insert ?\n))
-	  ;; Change header-delimiter to be what sendmail expects.
-	  (goto-char (point-min))
-	  (re-search-forward
-	    (concat "^" (regexp-quote mail-header-separator) "\n"))
-	  (replace-match "\n")
-	  (backward-char 1)
-	  (setq delimline (point-marker))
-	  (sendmail-sync-aliases)
-	  (if mail-aliases
-	      (expand-mail-aliases (point-min) delimline))
-	  (goto-char (point-min))
-	  ;; ignore any blank lines in the header
-	  (while (and (re-search-forward "\n\n\n*" delimline t)
-		      (< (point) delimline))
-	    (replace-match "\n"))
-	  (let ((case-fold-search t))
-	    (goto-char (point-min))
-	    (while (re-search-forward "^Resent-\\(to\\|cc\\|bcc\\):" delimline t)
-	      (setq resend-to-addresses
-		    (save-restriction
-		      (narrow-to-region (point)
-					(save-excursion
-					  (end-of-line)
-					  (point)))
-		      (append (mail-parse-comma-list)
-			      resend-to-addresses)))
-	      ;; Delete Resent-BCC ourselves
-	      (if (save-excursion (beginning-of-line)
-				  (looking-at "resent-bcc"))
-		  (delete-region (save-excursion (beginning-of-line) (point))
-				 (save-excursion (end-of-line) (1+ (point))))))
-;;; Apparently this causes a duplicate Sender.
-;;;	    ;; If the From is different than current user, insert Sender.
-;;;	    (goto-char (point-min))
-;;;	    (and (re-search-forward "^From:"  delimline t)
-;;;		 (progn
-;;;		   (require 'mail-utils)
-;;;		   (not (string-equal
-;;;			 (mail-strip-quoted-names
-;;;			  (save-restriction
-;;;			    (narrow-to-region (point-min) delimline)
-;;;			    (mail-fetch-field "From")))
-;;;			 (user-login-name))))
-;;;		 (progn
-;;;		   (forward-line 1)
-;;;		   (insert "Sender: " (user-login-name) "\n")))
-	    ;; Don't send out a blank subject line
-	    (goto-char (point-min))
-	    (if (re-search-forward "^Subject:\\([ \t]*\n\\)+\\b" delimline t)
-		(replace-match "")
-	      ;; This one matches a Subject just before the header delimiter.
-	      (if (and (re-search-forward "^Subject:\\([ \t]*\n\\)+" delimline t)
-		       (= (match-end 0) delimline))
-		  (replace-match "")))
-	    ;; Put the "From:" field in unless for some odd reason
-	    ;; they put one in themselves.
-	    (goto-char (point-min))
-	    (if (not (re-search-forward "^From:" delimline t))
-		(let* ((login user-mail-address)
-		       (fullname (user-full-name)))
-		  (cond ((eq mail-from-style 'angles)
-			 (insert "From: " fullname)
-			 (let ((fullname-start (+ (point-min) 6))
-			       (fullname-end (point-marker)))
-			   (goto-char fullname-start)
-			   ;; Look for a character that cannot appear unquoted
-			   ;; according to RFC 822.
-			   (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
-						  fullname-end 1)
-			       (progn
-				 ;; Quote fullname, escaping specials.
-				 (goto-char fullname-start)
-				 (insert "\"")
-				 (while (re-search-forward "[\"\\]"
-							   fullname-end 1)
-				   (replace-match "\\\\\\&" t))
-				 (insert "\""))))
-			 (insert " <" login ">\n"))
-			((eq mail-from-style 'parens)
-			 (insert "From: " login " (")
-			 (let ((fullname-start (point)))
-			   (insert fullname)
-			   (let ((fullname-end (point-marker)))
-			     (goto-char fullname-start)
-			     ;; RFC 822 says \ and nonmatching parentheses
-			     ;; must be escaped in comments.
-			     ;; Escape every instance of ()\ ...
-			     (while (re-search-forward "[()\\]" fullname-end 1)
-			       (replace-match "\\\\\\&" t))
-			     ;; ... then undo escaping of matching parentheses,
-			     ;; including matching nested parentheses.
-			     (goto-char fullname-start)
-			     (while (re-search-forward 
-				     "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
-				     fullname-end 1)
-			       (replace-match "\\1(\\3)" t)
-			       (goto-char fullname-start))))
-			 (insert ")\n"))
-			((null mail-from-style)
-			 (insert "From: " login "\n")))))
-	    ;; Insert an extra newline if we need it to work around
-	    ;; Sun's bug that swallows newlines.
-	    (goto-char (1+ delimline))
-	    (if (eval mail-mailer-swallows-blank-line)
-		(newline))
-	    ;; Find and handle any FCC fields.
-	    (goto-char (point-min))
-	    (if (re-search-forward "^FCC:" delimline t)
-		(progn
-		  (setq fcc-was-found t)
-		  (mail-do-fcc delimline)))
-	    (if mail-interactive
-		(save-excursion
-		  (set-buffer errbuf)
-		  (erase-buffer))))
-	  (goto-char (point-min))
-	  (if (let ((case-fold-search t))
-		(re-search-forward "^To:\\|^cc:\\|^bcc:\\|^resent-to:\
-\\|^resent-cc:\\|^resent-bcc:"
-				   delimline t))
-	      (let ((default-directory "/"))
-		(apply 'call-process-region
-		       (append (list (point-min) (point-max)
-				     (if (boundp 'sendmail-program)
-					 sendmail-program
-				       "/usr/lib/sendmail")
-				     nil errbuf nil "-oi")
-			       ;; Always specify who from,
-			       ;; since some systems have broken sendmails.
-			       (list "-f" (user-login-name))
-    ;;;			   ;; Don't say "from root" if running under su.
-    ;;;			   (and (equal (user-real-login-name) "root")
-    ;;;				(list "-f" (user-login-name)))
-			       (and mail-alias-file
-				    (list (concat "-oA" mail-alias-file)))
-			       (if mail-interactive
-				   ;; These mean "report errors to terminal"
-				   ;; and "deliver interactively"
-				   '("-oep" "-odi")
-				 ;; These mean "report errors by mail"
-				 ;; and "deliver in background".
-				 '("-oem" "-odb"))
-			       ;; Get the addresses from the message
-			       ;; unless this is a resend.
-			       ;; We must not do that for a resend
-			       ;; because we would find the original addresses.
-			       ;; For a resend, include the specific addresses.
-			       (or resend-to-addresses
-				   '("-t")))))
-	    (or fcc-was-found
-		(error "No recipients")))
-	  (if mail-interactive
-	      (save-excursion
-		(set-buffer errbuf)
-		(goto-char (point-min))
-		(while (re-search-forward "\n\n* *" nil t)
-		  (replace-match "; "))
-		(if (not (zerop (buffer-size)))
-		    (error "Sending...failed to %s"
-			   (buffer-substring (point-min) (point-max)))))))
-      (kill-buffer tembuf)
-      (if (bufferp errbuf)
-	  (kill-buffer errbuf)))))
-
-(defun mail-do-fcc (header-end)
-  (let (fcc-list
-	(rmailbuf (current-buffer))
-	(time (current-time))
-	(tembuf (generate-new-buffer " rmail output"))
-	(case-fold-search t))
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward "^FCC:[ \t]*" header-end t)
-	(setq fcc-list (cons (buffer-substring (point)
-					       (progn
-						 (end-of-line)
-						 (skip-chars-backward " \t")
-						 (point)))
-			     fcc-list))
-	(delete-region (match-beginning 0)
-		       (progn (forward-line 1) (point))))
-      (set-buffer tembuf)
-      (erase-buffer)
-      ;; This initial newline is written out if the fcc file already exists.
-      (insert "\nFrom " (user-login-name) " "
-	      (current-time-string time) "\n")
-      ;; Insert the time zone before the year.
-      (forward-char -1)
-      (forward-word -1)
-      (require 'mail-utils)
-      (insert (mail-rfc822-time-zone time) " ")
-      (goto-char (point-max))
-      (insert-buffer-substring rmailbuf)
-      ;; Make sure messages are separated.
-      (goto-char (point-max))
-      (insert ?\n)
-      (goto-char 2)
-      ;; ``Quote'' "^From " as ">From "
-      ;;  (note that this isn't really quoting, as there is no requirement
-      ;;   that "^[>]+From " be quoted in the same transparent way.)
-      (let ((case-fold-search nil))
-	(while (search-forward "\nFrom " nil t)
-	  (forward-char -5)
-	  (insert ?>)))
-      (while fcc-list
-	(let* ((buffer (find-buffer-visiting (car fcc-list)))
-	       (curbuf (current-buffer))
-	       (beg (point-min)) (end (point-max))
-	       (beg2 (save-excursion (goto-char (point-min))
-				     (forward-line 2) (point))))
-	  (if buffer
-	      ;; File is present in a buffer => append to that buffer.
-	      (save-excursion
-		(set-buffer buffer)
-		;; Keep the end of the accessible portion at the same place
-		;; unless it is the end of the buffer.
-		(let ((max (if (/= (1+ (buffer-size)) (point-max))
-			       (point-max))))
-		  (unwind-protect
-		      ;; Code below lifted from rmailout.el
-		      ;; function rmail-output-to-rmail-file:
-		      (let ((buffer-read-only nil)
-			    (msg (and (boundp 'rmail-current-message)
-				      rmail-current-message)))
-			;; If MSG is non-nil, buffer is in RMAIL mode.
-			(if msg
-			    (progn
-			      (rmail-maybe-set-message-counters)
-			      (widen)
-			      (narrow-to-region (point-max) (point-max))
-			      (insert "\C-l\n0, unseen,,\n*** EOOH ***\n"
-				      "Date: " (mail-rfc822-date) "\n")
-			      (insert-buffer-substring curbuf beg2 end)
-			      (insert "\n\C-_")
-			      (goto-char (point-min))
-			      (widen)
-			      (search-backward "\n\^_")
-			      (narrow-to-region (point) (point-max))
-			      (rmail-count-new-messages t)
-			      (rmail-show-message msg)
-			      (setq max nil))
-			  ;; Output file not in rmail mode
-			  ;; => just insert at the end.
-			  (narrow-to-region (point-min) (1+ (buffer-size)))
-			  (goto-char (point-max))
-			  (insert-buffer-substring curbuf beg end)))
-		    (if max (narrow-to-region (point-min) max)))))
-	    ;; Else append to the file directly.
-	    (if (and (file-exists-p (car fcc-list))
-		     (mail-file-babyl-p (car fcc-list)))
-		;; If the file is a Babyl file,
-		;; convert the message to Babyl format.
-		(save-excursion
-		  (set-buffer (get-buffer-create " mail-temp"))
-		  (setq buffer-read-only nil)
-		  (erase-buffer)
-		  (insert "\C-l\n0, unseen,,\n*** EOOH ***\n"
-			  "Date: " (mail-rfc822-date) "\n")
-		  (insert-buffer-substring curbuf beg2 end)
-		  (insert "\n\C-_")
-		  (write-region (point-min) (point-max) (car fcc-list) t)
-		  (erase-buffer))
-	      (write-region
-	       (1+ (point-min)) (point-max) (car fcc-list) t))))
-	(setq fcc-list (cdr fcc-list))))
-    (kill-buffer tembuf)))
-
-(defun mail-sent-via ()
-  "Make a Sent-via header line from each To or CC header line."
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    ;; find the header-separator
-    (search-forward (concat "\n" mail-header-separator "\n"))
-    (forward-line -1)
-    ;; put a marker at the end of the header
-    (let ((end (point-marker))
-	  (case-fold-search t)
-	  to-line)
-      (goto-char (point-min))
-      ;; search for the To: lines and make Sent-via: lines from them
-      ;; search for the next To: line
-      (while (re-search-forward "^\\(to\\|cc\\):" end t)
-	;; Grab this line plus all its continuations, sans the `to:'.
-	(let ((to-line
-	       (buffer-substring (point)
-				 (progn
-				   (if (re-search-forward "^[^ \t\n]" end t)
-				       (backward-char 1)
-				     (goto-char end))
-				   (point)))))
-	  ;; Insert a copy, with altered header field name.
-	  (insert-before-markers "Sent-via:" to-line))))))
-
-(defun mail-to ()
-  "Move point to end of To-field."
-  (interactive)
-  (expand-abbrev)
-  (mail-position-on-field "To"))
-
-(defun mail-subject ()
-  "Move point to end of Subject-field."
-  (interactive)
-  (expand-abbrev)
-  (mail-position-on-field "Subject"))
-
-(defun mail-cc ()
-  "Move point to end of CC-field.  Create a CC field if none."
-  (interactive)
-  (expand-abbrev)
-  (or (mail-position-on-field "cc" t)
-      (progn (mail-position-on-field "to")
-	     (insert "\nCC: "))))
-
-(defun mail-bcc ()
-  "Move point to end of BCC-field.  Create a BCC field if none."
-  (interactive)
-  (expand-abbrev)
-  (or (mail-position-on-field "bcc" t)
-      (progn (mail-position-on-field "to")
-	     (insert "\nBCC: "))))
-
-(defun mail-fcc (folder)
-  "Add a new FCC field, with file name completion."
-  (interactive "FFolder carbon copy: ")
-  (expand-abbrev)
-  (or (mail-position-on-field "fcc" t)	;Put new field after exiting FCC.
-      (mail-position-on-field "to"))
-  (insert "\nFCC: " folder))
-
-(defun mail-reply-to ()      
-  "Move point to end of Reply-To-field."
-  (interactive)
-  (expand-abbrev)
-  (mail-position-on-field "Reply-To"))
-
-(defun mail-position-on-field (field &optional soft)
-  (let (end
-	(case-fold-search t))
-    (goto-char (point-min))
-    (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
-    (setq end (match-beginning 0))
-    (goto-char (point-min))
-    (if (re-search-forward (concat "^" (regexp-quote field) ":") end t)
-	(progn
-	  (re-search-forward "^[^ \t]" nil 'move)
-	  (beginning-of-line)
-	  (skip-chars-backward "\n")
-	  t)
-      (or soft
-	  (progn (goto-char end)
-		 (insert field ": \n")
-		 (skip-chars-backward "\n")))
-      nil)))
-
-(defun mail-text ()
-  "Move point to beginning of message text."
-  (interactive)
-  (expand-abbrev)
-  (goto-char (point-min))
-  (search-forward (concat "\n" mail-header-separator "\n")))
-
-(defun mail-signature (atpoint)
-  "Sign letter with contents of the file `mail-signature-file'.
-Prefix arg means put contents at point."
-  (interactive "P")
-  (save-excursion
-    (or atpoint
-	(goto-char (point-max)))
-    (skip-chars-backward " \t\n")
-    (end-of-line)
-    (or atpoint
-	(delete-region (point) (point-max)))
-    (insert "\n\n-- \n")
-    (insert-file-contents (expand-file-name mail-signature-file))))
-
-(defun mail-fill-yanked-message (&optional justifyp)
-  "Fill the paragraphs of a message yanked into this one.
-Numeric argument means justify as well."
-  (interactive "P")
-  (save-excursion
-    (goto-char (point-min))
-    (search-forward (concat "\n" mail-header-separator "\n") nil t)
-    (fill-individual-paragraphs (point)
-				(point-max)
-				justifyp
-				t)))
-
-(defun mail-indent-citation ()
-  "Modify text just inserted from a message to be cited.
-The inserted text should be the region.
-When this function returns, the region is again around the modified text.
-
-Normally, indent each nonblank line `mail-indentation-spaces' spaces.
-However, if `mail-yank-prefix' is non-nil, insert that prefix on each line."
-  (mail-yank-clear-headers (region-beginning) (region-end))
-  (if (null mail-yank-prefix)
-      (indent-rigidly (region-beginning) (region-end)
-		      mail-indentation-spaces)
-    (save-excursion
-      (goto-char (region-beginning))
-      (while (< (point) (region-end))
-	(insert mail-yank-prefix)
-	(forward-line 1)))))
-
-(defun mail-yank-original (arg)
-  "Insert the message being replied to, if any (in rmail).
-Puts point after the text and mark before.
-Normally, indents each nonblank line ARG spaces (default 3).
-However, if `mail-yank-prefix' is non-nil, insert that prefix on each line.
-
-Just \\[universal-argument] as argument means don't indent, insert no prefix,
-and don't delete any header fields."
-  (interactive "P")
-  (if mail-reply-action
-      (let ((start (point))
-	    (original mail-reply-action))
-	(and (consp original) (eq (car original) 'insert-buffer)
-	     (setq original (nth 1 original)))
-	(if (consp original)
-	    (apply (car original) (cdr original))
-	  ;; If the original message is in another window in the same frame,
-	  ;; delete that window to save screen space.
-	  ;; t means don't alter other frames.
-	  (delete-windows-on original t)
-	  (insert-buffer original))
-	(if (consp arg)
-	    nil
-	  (goto-char start)
-	  (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
-					   mail-indentation-spaces)))
-	    (if mail-citation-hook
-		(run-hooks 'mail-citation-hook)
-	      (if mail-yank-hooks
-		  (run-hooks 'mail-yank-hooks)
-		(mail-indent-citation)))))
-	;; This is like exchange-point-and-mark, but doesn't activate the mark.
-	;; It is cleaner to avoid activation, even though the command
-	;; loop would deactivate the mark because we inserted text.
-	(goto-char (prog1 (mark t)
-		     (set-marker (mark-marker) (point) (current-buffer))))
-	(if (not (eolp)) (insert ?\n)))))
-
-(defun mail-yank-clear-headers (start end)
-  (if (< end start)
-      (let (temp)
-	(setq temp start start end end temp)))
-  (if mail-yank-ignored-headers
-      (save-excursion
-	(goto-char start)
-	(if (search-forward "\n\n" end t)
-	    (save-restriction
-	      (narrow-to-region start (point))
-	      (goto-char start)
-	      (while (let ((case-fold-search t))
-		       (re-search-forward mail-yank-ignored-headers nil t))
-		(beginning-of-line)
-		(delete-region (point)
-			       (progn (re-search-forward "\n[^ \t]")
-				      (forward-char -1)
-				      (point)))))))))
-
-(defun mail-yank-region (arg)
-  "Insert the selected region from the message being replied to.
-Puts point after the text and mark before.
-Normally, indents each nonblank line ARG spaces (default 3).
-However, if `mail-yank-prefix' is non-nil, insert that prefix on each line.
-
-Just \\[universal-argument] as argument means don't indent, insert no prefix,
-and don't delete any header fields."
-  (interactive "P")
-  (and (consp mail-reply-action)
-       (eq (car mail-reply-action) 'insert-buffer)
-       (let ((buffer (nth 1 mail-reply-action))
-	     (start (point)))
-	 ;; Insert the citation text.
-	 (insert (with-current-buffer buffer
-		   (buffer-substring (point) (mark))))
-	 (push-mark start)
-	 ;; Indent or otherwise annotate the citation text.
-	 (if (consp arg)
-	     nil
-	   (let ((mail-indentation-spaces (if arg (prefix-numeric-value arg)
-					    mail-indentation-spaces)))
-	     (if mail-citation-hook
-		 (run-hooks 'mail-citation-hook)
-	       (if mail-yank-hooks
-		   (run-hooks 'mail-yank-hooks)
-		 (mail-indent-citation))))))))
-
-;; Put these last, to reduce chance of lossage from quitting in middle of loading the file.
-
-;;;###autoload
-(defun mail (&optional noerase to subject in-reply-to cc replybuffer actions)
-  "Edit a message to be sent.  Prefix arg means resume editing (don't erase).
-When this function returns, the buffer `*mail*' is selected.
-The value is t if the message was newly initialized; otherwise, nil.
-
-Optionally, the signature file `mail-signature-file' can be inserted at the
-end; see the variable `mail-signature'.
-
-\\<mail-mode-map>
-While editing message, type \\[mail-send-and-exit] to send the message and exit.
-
-Various special commands starting with C-c are available in sendmail mode
-to move to message header fields:
-\\{mail-mode-map}
-
-If `mail-self-blind' is non-nil, a BCC to yourself is inserted
-when the message is initialized.
-
-If `mail-default-reply-to' is non-nil, it should be an address (a string);
-a Reply-to: field with that address is inserted.
-
-If `mail-archive-file-name' is non-nil, an FCC field with that file name
-is inserted.
-
-The normal hook `mail-setup-hook' is run after the message is
-initialized.  It can add more default fields to the message.
-
-When calling from a program, the first argument if non-nil says
-not to erase the existing contents of the `*mail*' buffer.
-
-The second through fifth arguments,
- TO, SUBJECT, IN-REPLY-TO and CC, specify if non-nil
- the initial contents of those header fields.
- These arguments should not have final newlines.
-The sixth argument REPLYBUFFER is a buffer which contains an
- original message being replied to, or else an action
- of the form (FUNCTION . ARGS) which says how to insert the original.
- Or it can be nil, if not replying to anything.
-The seventh argument ACTIONS is a list of actions to take
- if/when the message is sent.  Each action looks like (FUNCTION . ARGS);
- when the message is sent, we apply FUNCTION to ARGS.
- This is how Rmail arranges to mark messages `answered'."
-  (interactive "P")
-;;; This is commented out because I found it was confusing in practice.
-;;; It is easy enough to rename *mail* by hand with rename-buffer
-;;; if you want to have multiple mail buffers.
-;;; And then you can control which messages to save. --rms.
-;;;  (let ((index 1)
-;;;	buffer)
-;;;    ;; If requested, look for a mail buffer that is modified and go to it.
-;;;    (if noerase
-;;;	(progn
-;;;	  (while (and (setq buffer
-;;;			    (get-buffer (if (= 1 index) "*mail*"
-;;;					  (format "*mail*<%d>" index))))
-;;;		      (not (buffer-modified-p buffer)))
-;;;	    (setq index (1+ index)))
-;;;	  (if buffer (switch-to-buffer buffer)
-;;;	    ;; If none exists, start a new message.
-;;;	    ;; This will never re-use an existing unmodified mail buffer
-;;;	    ;; (since index is not 1 anymore).  Perhaps it should.
-;;;	    (setq noerase nil))))
-;;;    ;; Unless we found a modified message and are happy, start a new message.
-;;;    (if (not noerase)
-;;;	(progn
-;;;	  ;; Look for existing unmodified mail buffer.
-;;;	  (while (and (setq buffer
-;;;			    (get-buffer (if (= 1 index) "*mail*"
-;;;					  (format "*mail*<%d>" index))))
-;;;		      (buffer-modified-p buffer))
-;;;	    (setq index (1+ index)))
-;;;	  ;; If none, make a new one.
-;;;	  (or buffer
-;;;	      (setq buffer (generate-new-buffer "*mail*")))
-;;;	  ;; Go there and initialize it.
-;;;	  (switch-to-buffer buffer)
-;;;	  (erase-buffer)
-;;;          (setq default-directory (expand-file-name "~/"))
-;;;          (auto-save-mode auto-save-default)
-;;;          (mail-mode)
-;;;          (mail-setup to subject in-reply-to cc replybuffer actions)
-;;;	  (if (and buffer-auto-save-file-name
-;;;		   (file-exists-p buffer-auto-save-file-name))
-;;;	      (message "Auto save file for draft message exists; consider M-x mail-recover"))
-;;;          t))
-  (pop-to-buffer "*mail*")
-  ;; Put the auto-save file in the home dir
-  ;; to avoid any danger that it can't be written.
-  (if (file-exists-p (expand-file-name "~/"))
-      (setq default-directory (expand-file-name "~/")))
-  (auto-save-mode auto-save-default)
-  (mail-mode)
-  ;; Disconnect the buffer from its visited file
-  ;; (in case the user has actually visited a file *mail*).
-;  (set-visited-file-name nil)
-  (let (initialized)
-    (and (not noerase)
-	 (or (not (buffer-modified-p))
-	     (y-or-n-p "Unsent message being composed; erase it? "))
-	 (let ((inhibit-read-only t))
-	   (erase-buffer)
-	   (mail-setup to subject in-reply-to cc replybuffer actions)
-	   (setq initialized t)))
-    (if (and buffer-auto-save-file-name
-	     (file-exists-p buffer-auto-save-file-name))
-	(message "Auto save file for draft message exists; consider M-x mail-recover"))
-    initialized))
-
-(defun mail-recover ()
-  "Reread contents of current buffer from its last auto-save file."
-  (interactive)
-  (let ((file-name (make-auto-save-file-name)))
-    (cond ((save-window-excursion
-	     (if (not (eq system-type 'vax-vms))
-		 (with-output-to-temp-buffer "*Directory*"
-		   (buffer-disable-undo standard-output)
-		   (let ((default-directory "/"))
-		     (call-process
-		      "ls" nil standard-output nil "-l" file-name))))
-	     (yes-or-no-p (format "Recover auto save file %s? " file-name)))
-	   (let ((buffer-read-only nil))
-	     (erase-buffer)
-	     (insert-file-contents file-name nil)))
-	  (t (error "mail-recover cancelled")))))
-
-;;;###autoload
-(defun mail-other-window (&optional noerase to subject in-reply-to cc replybuffer sendactions)
-  "Like `mail' command, but display mail buffer in another window."
-  (interactive "P")
-  (let ((pop-up-windows t)
-	(special-display-buffer-names nil)
-	(special-display-regexps nil)
-	(same-window-buffer-names nil)
-	(same-window-regexps nil))
-    (pop-to-buffer "*mail*"))
-  (mail noerase to subject in-reply-to cc replybuffer sendactions))
-
-;;;###autoload
-(defun mail-other-frame (&optional noerase to subject in-reply-to cc replybuffer sendactions)
-  "Like `mail' command, but display mail buffer in another frame."
-  (interactive "P")
-  (let ((pop-up-frames t)
-	(special-display-buffer-names nil)
-	(special-display-regexps nil)
-	(same-window-buffer-names nil)
-	(same-window-regexps nil))
-    (pop-to-buffer "*mail*"))
-  (mail noerase to subject in-reply-to cc replybuffer sendactions))
-
-;;; Do not execute these when sendmail.el is loaded,
-;;; only in loaddefs.el.
-;;;###autoload (define-key ctl-x-map "m" 'mail)
-;;;###autoload (define-key ctl-x-4-map "m" 'mail-other-window)
-;;;###autoload (define-key ctl-x-5-map "m" 'mail-other-frame)
-
-;;;###autoload (add-hook 'same-window-buffer-names "*mail*")
-
-;;; Do not add anything but external entries on this page.
-
-(provide 'sendmail)
-
-;;; sendmail.el ends here
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
deleted file mode 100644
index 925a6ec2e83..00000000000
--- a/lisp/mail/smtpmail.el
+++ /dev/null
@@ -1,525 +0,0 @@
-;; Simple SMTP protocol (RFC 821) for sending mail
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
-;; Maintainer: Brian D. Carlstrom <bdc@ai.mit.edu>
-;; Keywords: mail
-
-;; 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:
-
-;; Send Mail to smtp host from smtpmail temp buffer.
-
-;; Please add these lines in your .emacs(_emacs).
-;;
-;;(setq send-mail-function 'smtpmail-send-it)
-;;(setq smtpmail-default-smtp-server "YOUR SMTP HOST")
-;;(setq smtpmail-smtp-service "smtp")
-;;(setq smtpmail-local-domain "YOUR DOMAIN NAME")
-;;(setq smtpmail-debug-info t)
-;;(load-library "smtpmail")
-;;(setq smtpmail-code-conv-from nil)
-;;(setq user-full-name "YOUR NAME HERE")
-
-;;; Code:
-
-(require 'sendmail)
-
-;;;
-(defvar smtpmail-default-smtp-server nil
-  "*Specify default SMTP server.")
-
-(defvar smtpmail-smtp-server 
-  (or (getenv "SMTPSERVER") smtpmail-default-smtp-server)
-  "*The name of the host running SMTP server.")
-
-(defvar smtpmail-smtp-service 25
-  "*SMTP service port number. smtp or 25 .")
-
-(defvar smtpmail-local-domain nil
-  "*Local domain name without a host name.
-If the function (system-name) returns the full internet address,
-don't define this value.")
-
-(defvar smtpmail-debug-info nil
-  "*smtpmail debug info printout. messages and process buffer.")
-
-(defvar smtpmail-code-conv-from nil ;; *junet*
-  "*smtpmail code convert from this code to *internal*..for tiny-mime..")
-
-;;;
-;;;
-;;;
-
-(defun smtpmail-send-it ()
-  (require 'mail-utils)
-  (let ((errbuf (if mail-interactive
-		    (generate-new-buffer " smtpmail errors")
-		  0))
-	(tembuf (generate-new-buffer " smtpmail temp"))
-	(case-fold-search nil)
-	resend-to-addresses
-	delimline
-	(mailbuf (current-buffer)))
-    (unwind-protect
-	(save-excursion
-	  (set-buffer tembuf)
-	  (erase-buffer)
-	  (insert-buffer-substring mailbuf)
-	  (goto-char (point-max))
-	  ;; require one newline at the end.
-	  (or (= (preceding-char) ?\n)
-	      (insert ?\n))
-	  ;; Change header-delimiter to be what sendmail expects.
-	  (goto-char (point-min))
-	  (re-search-forward
-	    (concat "^" (regexp-quote mail-header-separator) "\n"))
-	  (replace-match "\n")
-	  (backward-char 1)
-	  (setq delimline (point-marker))
-;;	  (sendmail-synch-aliases)
-	  (if mail-aliases
-	      (expand-mail-aliases (point-min) delimline))
-	  (goto-char (point-min))
-	  ;; ignore any blank lines in the header
-	  (while (and (re-search-forward "\n\n\n*" delimline t)
-		      (< (point) delimline))
-	    (replace-match "\n"))
-	  (let ((case-fold-search t))
-	    (goto-char (point-min))
-	    (goto-char (point-min))
-	    (while (re-search-forward "^Resent-to:" delimline t)
-	      (setq resend-to-addresses
-		    (save-restriction
-		      (narrow-to-region (point)
-					(save-excursion
-					  (end-of-line)
-					  (point)))
-		      (append (mail-parse-comma-list)
-			      resend-to-addresses))))
-;;; Apparently this causes a duplicate Sender.
-;;;	    ;; If the From is different than current user, insert Sender.
-;;;	    (goto-char (point-min))
-;;;	    (and (re-search-forward "^From:"  delimline t)
-;;;		 (progn
-;;;		   (require 'mail-utils)
-;;;		   (not (string-equal
-;;;			 (mail-strip-quoted-names
-;;;			  (save-restriction
-;;;			    (narrow-to-region (point-min) delimline)
-;;;			    (mail-fetch-field "From")))
-;;;			 (user-login-name))))
-;;;		 (progn
-;;;		   (forward-line 1)
-;;;		   (insert "Sender: " (user-login-name) "\n")))
-	    ;; Don't send out a blank subject line
-	    (goto-char (point-min))
-	    (if (re-search-forward "^Subject:[ \t]*\n" delimline t)
-		(replace-match ""))
-	    ;; Put the "From:" field in unless for some odd reason
-	    ;; they put one in themselves.
-	    (goto-char (point-min))
-	    (if (not (re-search-forward "^From:" delimline t))
-		(let* ((login user-mail-address)
-		       (fullname (user-full-name)))
-		  (cond ((eq mail-from-style 'angles)
-			 (insert "From: " fullname)
-			 (let ((fullname-start (+ (point-min) 6))
-			       (fullname-end (point-marker)))
-			   (goto-char fullname-start)
-			   ;; Look for a character that cannot appear unquoted
-			   ;; according to RFC 822.
-			   (if (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]"
-						  fullname-end 1)
-			       (progn
-				 ;; Quote fullname, escaping specials.
-				 (goto-char fullname-start)
-				 (insert "\"")
-				 (while (re-search-forward "[\"\\]"
-							   fullname-end 1)
-				   (replace-match "\\\\\\&" t))
-				 (insert "\""))))
-			 (insert " <" login ">\n"))
-			((eq mail-from-style 'parens)
-			 (insert "From: " login " (")
-			 (let ((fullname-start (point)))
-			   (insert fullname)
-			   (let ((fullname-end (point-marker)))
-			     (goto-char fullname-start)
-			     ;; RFC 822 says \ and nonmatching parentheses
-			     ;; must be escaped in comments.
-			     ;; Escape every instance of ()\ ...
-			     (while (re-search-forward "[()\\]" fullname-end 1)
-			       (replace-match "\\\\\\&" t))
-			     ;; ... then undo escaping of matching parentheses,
-			     ;; including matching nested parentheses.
-			     (goto-char fullname-start)
-			     (while (re-search-forward 
-				     "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
-				     fullname-end 1)
-			       (replace-match "\\1(\\3)" t)
-			       (goto-char fullname-start))))
-			 (insert ")\n"))
-			((null mail-from-style)
-			 (insert "From: " login "\n")))))
-	    ;; Insert an extra newline if we need it to work around
-	    ;; Sun's bug that swallows newlines.
-	    (goto-char (1+ delimline))
-	    (if (eval mail-mailer-swallows-blank-line)
-		(newline))
-	    ;; Find and handle any FCC fields.
-	    (goto-char (point-min))
-	    (if (re-search-forward "^FCC:" delimline t)
-		(mail-do-fcc delimline))
-	    (if mail-interactive
-		(save-excursion
-		  (set-buffer errbuf)
-		  (erase-buffer))))
-	  ;;
-	  ;;
-	  ;;
-	  (setq smtpmail-address-buffer (generate-new-buffer "*smtp-mail*"))
-	  (setq smtpmail-recipient-address-list
-		(or resend-to-addresses
-		    (smtpmail-deduce-address-list tembuf (point-min) delimline)))
-	  (kill-buffer smtpmail-address-buffer)
-
-	  (smtpmail-do-bcc delimline)
-
-	  (if (not (null smtpmail-recipient-address-list))
-	      (if (not (smtpmail-via-smtp smtpmail-recipient-address-list tembuf))
-		  (error "Sending failed; SMTP protocol error"))
-	    (error "Sending failed; no recipients"))
-	  )
-      (kill-buffer tembuf)
-      (if (bufferp errbuf)
-	  (kill-buffer errbuf)))))
-
-
-;(defun smtpmail-via-smtp (host,port,sender,destination,smtpmail-text-buffer)
-
-(defun smtpmail-fqdn ()
-  (if smtpmail-local-domain
-      (concat (system-name) "." smtpmail-local-domain)
-    (system-name)))
-
-(defun smtpmail-via-smtp (recipient smtpmail-text-buffer)
-  (let ((process nil)
-	(host smtpmail-smtp-server)
-	(port smtpmail-smtp-service)
-	response-code
-	greeting
-	process-buffer)
-    (unwind-protect
-	(catch 'done
-	  ;; get or create the trace buffer
-	  (setq process-buffer
-		(get-buffer-create (format "*trace of SMTP session to %s*" host)))
-
-	  ;; clear the trace buffer of old output
-	  (save-excursion
-	    (set-buffer process-buffer)
-	    (erase-buffer))
-
-	  ;; open the connection to the server
-	  (setq process (open-network-stream "SMTP" process-buffer host port))
-	  (and (null process) (throw 'done nil))
-
-	  ;; set the send-filter
-	  (set-process-filter process 'smtpmail-process-filter)
-
-	  (save-excursion
-	    (set-buffer process-buffer)
-	    (make-local-variable 'smtpmail-read-point)
-	    (setq smtpmail-read-point (point-min))
-
-	    
-	    (if (or (null (car (setq greeting (smtpmail-read-response process))))
-		    (not (integerp (car greeting)))
-		    (>= (car greeting) 400))
-		(throw 'done nil)
-	      )
-
-	    ;; HELO
-	    (smtpmail-send-command process (format "HELO %s" (smtpmail-fqdn)))
-
-	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
-		    (not (integerp (car response-code)))
-		    (>= (car response-code) 400))
-		(throw 'done nil)
-	      )
-
-	    ;; MAIL FROM: <sender>
-;	    (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
-	    (smtpmail-send-command process (format "MAIL FROM: <%s>" user-mail-address))
-
-	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
-		    (not (integerp (car response-code)))
-		    (>= (car response-code) 400))
-		(throw 'done nil)
-	      )
-	    
-	    ;; RCPT TO: <recipient>
-	    (let ((n 0))
-	      (while (not (null (nth n recipient)))
-		(smtpmail-send-command process (format "RCPT TO: <%s>" (nth n recipient)))
-		(setq n (1+ n))
-
-		(if (or (null (car (setq response-code (smtpmail-read-response process))))
-			(not (integerp (car response-code)))
-			(>= (car response-code) 400))
-		    (throw 'done nil)
-		  )
-		))
-	    
-	    ;; DATA
-	    (smtpmail-send-command process "DATA")
-
-	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
-		    (not (integerp (car response-code)))
-		    (>= (car response-code) 400))
-		(throw 'done nil)
-	      )
-
-	    ;; Mail contents
-	    (smtpmail-send-data process smtpmail-text-buffer)
-
-	    ;;DATA end "."
-	    (smtpmail-send-command process ".")
-
-	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
-		    (not (integerp (car response-code)))
-		    (>= (car response-code) 400))
-		(throw 'done nil)
-	      )
-
-	    ;;QUIT
-;	    (smtpmail-send-command process "QUIT")
-;	    (and (null (car (smtpmail-read-response process)))
-;		 (throw 'done nil))
-	    t ))
-      (if process
-	  (save-excursion
-	    (set-buffer (process-buffer process))
-	    (smtpmail-send-command process "QUIT")
-	    (smtpmail-read-response process)
-
-;	    (if (or (null (car (setq response-code (smtpmail-read-response process))))
-;		    (not (integerp (car response-code)))
-;		    (>= (car response-code) 400))
-;		(throw 'done nil)
-;	      )
-	    (delete-process process))))))
-
-
-(defun smtpmail-process-filter (process output)
-  (save-excursion
-    (set-buffer (process-buffer process))
-    (goto-char (point-max))
-    (insert output)))
-
-(defun smtpmail-read-response (process)
-  (let ((case-fold-search nil)
-	(response-string nil)
-	(response-continue t)
-	(return-value '(nil ""))
-	match-end)
-
-;    (setq response-string nil)
-;    (setq response-continue t)
-;    (setq return-value '(nil ""))
-
-    (while response-continue
-      (goto-char smtpmail-read-point)
-      (while (not (search-forward "\r\n" nil t))
-	(accept-process-output process)
-	(goto-char smtpmail-read-point))
-
-      (setq match-end (point))
-      (if (null response-string)
-	  (setq response-string
-		(buffer-substring smtpmail-read-point (- match-end 2))))
-	
-      (goto-char smtpmail-read-point)
-      (if (looking-at "[0-9]+ ")
-	  (progn (setq response-continue nil)
-;		 (setq return-value response-string)
-
-		 (if smtpmail-debug-info
-		     (message response-string))
-
-		 (setq smtpmail-read-point match-end)
-		 (setq return-value
-		       (cons (string-to-int 
-			      (buffer-substring (match-beginning 0) (match-end 0))) 
-			     response-string)))
-	
-	(if (looking-at "[0-9]+-")
-	    (progn (setq smtpmail-read-point match-end)
-		   (setq response-continue t))
-	  (progn
-	    (setq smtpmail-read-point match-end)
-	    (setq response-continue nil)
-	    (setq return-value 
-		  (cons nil response-string))
-	    )
-	  )))
-    (setq smtpmail-read-point match-end)
-    return-value))
-
-
-(defun smtpmail-send-command (process command)
-  (goto-char (point-max))
-  (if (= (aref command 0) ?P)
-      (insert "PASS <omitted>\r\n")
-    (insert command "\r\n"))
-  (setq smtpmail-read-point (point))
-  (process-send-string process command)
-  (process-send-string process "\r\n"))
-
-(defun smtpmail-send-data-1 (process data)
-  (goto-char (point-max))
-
-  (if (not (null smtpmail-code-conv-from))
-      (setq data (code-convert-string data smtpmail-code-conv-from *internal*)))
-	
-  (if smtpmail-debug-info
-      (insert data "\r\n"))
-
-  (setq smtpmail-read-point (point))
-  ;; Escape "." at start of a line
-  (if (eq (string-to-char data) ?.)
-      (process-send-string process "."))
-  (process-send-string process data)
-  (process-send-string process "\r\n")
-  )
-
-(defun smtpmail-send-data (process buffer)
-  (let
-      ((data-continue t)
-       (sending-data nil)
-       this-line
-       this-line-end)
-
-    (save-excursion
-      (set-buffer buffer)
-      (goto-char (point-min)))
-
-    (while data-continue
-      (save-excursion
-	(set-buffer buffer)
-	(beginning-of-line)
-	(setq this-line (point))
-	(end-of-line)
-	(setq this-line-end (point))
-	(setq sending-data nil)
-	(setq sending-data (buffer-substring this-line this-line-end))
-	(if (/= (forward-line 1) 0)
-	    (setq data-continue nil)))
-
-      (smtpmail-send-data-1 process sending-data)
-      )
-    )
-  )
-    
-
-(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
-  "Get address list suitable for smtp RCPT TO: <address>."
-  (require 'mail-utils)  ;; pick up mail-strip-quoted-names
-  (let
-      ((case-fold-search t)
-       (simple-address-list "")
-       this-line
-       this-line-end
-       addr-regexp)
-    
-    (unwind-protect
-	(save-excursion
-	  ;;
-	  (set-buffer smtpmail-address-buffer) (erase-buffer)
-	  (insert-buffer-substring smtpmail-text-buffer header-start header-end)
-	  (goto-char (point-min))
-	  ;; RESENT-* fields should stop processing of regular fields.
-	  (save-excursion
-	    (if (re-search-forward "^RESENT-TO:" header-end t)
-		(setq addr-regexp "^\\(RESENT-TO:\\|RESENT-CC:\\|RESENT-BCC:\\)")
-	      (setq addr-regexp  "^\\(TO:\\|CC:\\|BCC:\\)")))
-
-	  (while (re-search-forward addr-regexp header-end t)
-	    (replace-match "")
-	    (setq this-line (match-beginning 0))
-	    (forward-line 1)
-	    ;; get any continuation lines
-	    (while (and (looking-at "^[ \t]+") (< (point) header-end))
-	      (forward-line 1))
-	    (setq this-line-end (point-marker))
-	    (setq simple-address-list
-		  (concat simple-address-list " "
-			  (mail-strip-quoted-names (buffer-substring this-line this-line-end))))
-	    )
-	  (erase-buffer)
-	  (insert-string " ")
-	  (insert-string simple-address-list)
-	  (insert-string "\n")
-	  (subst-char-in-region (point-min) (point-max) 10 ?  t);; newline --> blank
-	  (subst-char-in-region (point-min) (point-max) ?, ?  t);; comma   --> blank
-	  (subst-char-in-region (point-min) (point-max)  9 ?  t);; tab     --> blank
-
-	  (goto-char (point-min))
-	  ;; tidyness in case hook is not robust when it looks at this
-	  (while (re-search-forward "[ \t]+" header-end t) (replace-match " "))
-
-	  (goto-char (point-min))
-	  (let (recipient-address-list)
-	    (while (re-search-forward " \\([^ ]+\\) " (point-max) t)
-	      (backward-char 1)
-	      (setq recipient-address-list (cons (buffer-substring (match-beginning 1) (match-end 1))
-						 recipient-address-list))
-	      )
-	    (setq smtpmail-recipient-address-list recipient-address-list))
-
-	  )
-      )
-    )
-  )
-
-
-(defun smtpmail-do-bcc (header-end)
-  "Delete BCC: and their continuation lines from the header area.
-There may be multiple BCC: lines, and each may have arbitrarily
-many continuation lines."
-  (let ((case-fold-search t))
-	(save-excursion (goto-char (point-min))
-	  ;; iterate over all BCC: lines
-	  (while (re-search-forward "^BCC:" header-end t)
-	        (delete-region (match-beginning 0) (progn (forward-line 1) (point)))
-		;; get rid of any continuation lines
-		(while (and (looking-at "^[ \t].*\n") (< (point) header-end))
-		  (replace-match ""))
-		)
-	  ) ;; save-excursion
-	) ;; let
-  )
-
-
-
-(provide 'smtpmail)
-
-;; smtpmail.el ends here
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
deleted file mode 100644
index 8babd369099..00000000000
--- a/lisp/mail/supercite.el
+++ /dev/null
@@ -1,2020 +0,0 @@
-;;; supercite.el --- minor mode for citing mail and news replies
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: 1993 Barry A. Warsaw, Century Computing, Inc. <bwarsaw@cen.com>
-;; Maintainer:    supercite-help@anthem.nlm.nih.gov
-;; Created:       February 1993
-;; Version:       3.1
-;; Last Modified: 1993/09/22 18:58:46
-;; Keywords: mail, news
-
-;; supercite.el revision: 3.54
-
-;; 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.
-
-;; LCD Archive Entry
-;; supercite|Barry A. Warsaw|supercite-help@anthem.nlm.nih.gov
-;; |Mail and news reply citation package
-;; |1993/09/22 18:58:46|3.1|
-
-;; Code:
-
-
-(require 'regi)
-
-;; start user configuration variables
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-
-(defvar sc-auto-fill-region-p t
-  "*If non-nil, automatically fill each paragraph after it has been cited.")
-
-(defvar sc-blank-lines-after-headers 1
-  "*Number of blank lines to leave after mail headers have been nuked.
-Set to nil, to use whatever blank lines happen to occur naturally.")
-
-(defvar sc-citation-leader "    "
-  "*String comprising first part of a citation.")
-(defvar sc-citation-delimiter ">"
-  "*String comprising third part of a citation.
-This string is used in both nested and non-nested citations.")
-(defvar sc-citation-separator " "
-  "*String comprising fourth and last part of a citation.")
-
-(defvar sc-citation-leader-regexp "[ \t]*"
-  "*Regexp describing citation leader for a cited line.
-This should NOT have a leading `^' character.")
-
-;; Nemacs and Mule users note: please see the texinfo manual for
-;; suggestions on setting these variables.
-(defvar sc-citation-root-regexp "[-._a-zA-Z0-9]*"
-  "*Regexp describing variable root part of a citation for a cited line.
-This should NOT have a leading `^' character.  See also
-`sc-citation-nonnested-root-regexp'.")
-(defvar sc-citation-nonnested-root-regexp "[-._a-zA-Z0-9]+"
-  "*Regexp describing the variable root part of a nested citation.
-This should NOT have a leading `^' character.  This variable is
-related to `sc-citation-root-regexp' but whereas that variable
-describes both nested and non-nested citation roots, this variable
-describes only nested citation roots.")
-(defvar sc-citation-delimiter-regexp "[>]+"
-  "*Regexp describing citation delimiter for a cited line.
-This should NOT have a leading `^' character.")
-(defvar sc-citation-separator-regexp "[ \t]*"
-  "*Regexp describing citation separator for a cited line.
-This should NOT have a leading `^' character.")
-
-(defvar sc-cite-blank-lines-p nil
-  "*If non-nil, put a citation on blank lines.")
-
-(defvar sc-cite-frame-alist '()
-  "*Alist for frame selection during citing.
-Each element of this list has the following form:
-
-   (INFOKEY ((REGEXP . FRAME)
-             (REGEXP . FRAME)
-             (...)))
-
-Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
-expression to match against the INFOKEY's value.  FRAME is a citation
-frame, or a variable containing a citation frame.")
-(defvar sc-uncite-frame-alist '()
-  "*Alist for frame selection during unciting.
-See the variable `sc-cite-frame-alist' for details.")
-(defvar sc-recite-frame-alist '()
-  "*Alist for frame selection during reciting.
-See the variable `sc-cite-frame-alist' for details.")
-
-(defvar sc-default-cite-frame
-  '(;; initialize fill state and temporary variables when entering
-    ;; frame. this makes things run much faster
-    (begin (progn
-	     (sc-fill-if-different)
-	     (setq sc-tmp-nested-regexp (sc-cite-regexp "")
-		   sc-tmp-nonnested-regexp (sc-cite-regexp)
-		   sc-tmp-dumb-regexp
-		   (concat "\\("
-			   (sc-cite-regexp "")
-			   "\\)"
-			   (sc-cite-regexp sc-citation-nonnested-root-regexp))
-		   )))
-    ;; blank lines mean paragraph separators, so fill the last cited
-    ;; paragraph, unless sc-cite-blank-lines-p is non-nil, in which
-    ;; case we treat blank lines just like any other line.
-    ("^[ \t]*$"                 (if sc-cite-blank-lines-p
-				    (sc-cite-line)
-				  (sc-fill-if-different "")))
-    ;; do nothing if looking at a reference tag. make sure that the
-    ;; tag string isn't the empty string since this will match every
-    ;; line.  it cannot be nil.
-    (sc-reference-tag-string    (if (string= sc-reference-tag-string "")
-				    (list 'continue)
-				  nil))
-    ;; this regexp catches nested citations in which the author cited
-    ;; a non-nested citation with a dumb citer.
-    (sc-tmp-dumb-regexp         (sc-cite-coerce-dumb-citer))
-    ;; if we are looking at a nested citation then add a citation level
-    (sc-tmp-nested-regexp       (sc-add-citation-level))
-    ;; if we're looking at a non-nested citation, coerce it to our style
-    (sc-tmp-nonnested-regexp    (sc-cite-coerce-cited-line))
-    ;; we must be looking at an uncited line. if we are in nested
-    ;; citations, just add a citation level
-    (sc-nested-citation-p       (sc-add-citation-level))
-    ;; we're looking at an uncited line and we are in non-nested
-    ;; citations, so cite it with a non-nested citation
-    (t                          (sc-cite-line))
-    ;; be sure when we're done that we fill the last cited paragraph.
-    (end                        (sc-fill-if-different ""))
-    )
-  "*Default REGI frame for citing a region.")
-
-(defvar sc-default-uncite-frame
-  '(;; do nothing on a blank line
-    ("^[ \t]*$"       nil)
-    ;; if the line is cited, uncite it
-    ((sc-cite-regexp) (sc-uncite-line))
-    )
-  "*Default REGI frame for unciting a region.")
-
-(defvar sc-default-recite-frame
-  '(;; initialize fill state when entering frame
-    (begin            (sc-fill-if-different))
-    ;; do nothing on a blank line
-    ("^[ \t]*$"       nil)
-    ;; if we're looking at a cited line, recite it
-    ((sc-cite-regexp) (sc-recite-line (sc-cite-regexp)))
-    ;; otherwise, the line is uncited, so just cite it
-    (t                (sc-cite-line))
-    ;; be sure when we're done that we fill the last cited paragraph.
-    (end              (sc-fill-if-different ""))
-    )
-  "*Default REGI frame for reciting a region.")
-
-(defvar sc-cite-region-limit t
-  "*This variable controls automatic citation of yanked text.
-Legal values are:
-
-non-nil   -- cite the entire region, regardless of its size
-nil       -- do not cite the region at all
-<integer> -- a number indicating the threshold for citation.  When
-	     the number of lines in the region is greater than this
-	     value, a warning message will be printed and the region
-	     will not be cited.  Lines in region are counted with
-	     `count-lines'. 
-
-The gathering of attribution information is not affected by the value
-of this variable.  The number of lines in the region is calculated
-*after* all mail headers are removed.  This variable is only consulted
-during the initial citing via `sc-cite-original'.")
-
-(defvar sc-confirm-always-p t
-  "*If non-nil, always confirm attribution string before citing text body.")
-
-(defvar sc-default-attribution "Anon"
-  "*String used when author's attribution cannot be determined.")
-(defvar sc-default-author-name "Anonymous"
-  "*String used when author's name cannot be determined.")
-
-(defvar sc-downcase-p nil
-  "*Non-nil means downcase the attribution and citation strings.")
-
-(defvar sc-electric-circular-p t
-  "*If non-nil, treat electric references as circular.")
-(defvar sc-electric-mode-hook nil
-  "*Hook for `sc-electric-mode' electric references mode.")
-(defvar sc-electric-references-p nil
-  "*Use electric references if non-nil.")
-
-(defvar sc-fixup-whitespace-p nil
-  "*If non-nil, delete all leading white space before citing.")
-
-(defvar sc-load-hook nil
-  "*Hook which gets run once after Supercite loads.")
-(defvar sc-pre-hook nil
-  "*Hook which gets run before each invocation of `sc-cite-original'.")
-(defvar sc-post-hook nil
-  "*Hook which gets run after each invocation of `sc-cite-original'.")
-
-(defvar sc-mail-warn-if-non-rfc822-p t
-  "*Warn if mail headers don't conform to RFC822.")
-(defvar sc-mumble ""
-  "*Value returned by `sc-mail-field' if field isn't in mail headers.")
-
-(defvar sc-name-filter-alist
-  '(("^\\(Mr\\|Mrs\\|Ms\\|Dr\\)[.]?$" . 0)
-    ("^\\(Jr\\|Sr\\)[.]?$" . last)
-    ("^ASTS$" . 0)
-    ("^[I]+$" . last))
-  "*Name list components which are filtered out as noise.
-This variable contains an association list where each element is of
-the form:  (REGEXP . POSITION).
-
-REGEXP is a regular expression which matches the name list component.
-Match is performed using `string-match'.  POSITION is the position in
-the name list which can match the regular expression, starting at zero
-for the first element.  Use `last' to match the last element in the
-list and `any' to match all elements.")
-
-(defvar sc-nested-citation-p nil
-  "*Controls whether to use nested or non-nested citation style.
-Non-nil uses nested citations, nil uses non-nested citations.")
-
-(defvar sc-nuke-mail-headers 'all
-  "*Controls mail header nuking.
-Used in conjunction with `sc-nuke-mail-header-list'.  Legal values are:
-
-`all'       -- nuke all mail headers
-`none'      -- don't nuke any mail headers
-`specified' -- nuke headers specified in `sc-nuke-mail-header-list'
-`keep'      -- keep headers specified in `sc-nuke-mail-header-list'")
-
-(defvar sc-nuke-mail-header-list nil
-  "*List of mail header regexps to remove or keep in body of reply.
-This list contains regular expressions describing the mail headers to
-keep or nuke, depending on the value of `sc-nuke-mail-headers'.")
-
-(defvar sc-preferred-attribution-list
-  '("sc-lastchoice" "x-attribution" "firstname" "initials" "lastname")
-  "*Specifies what to use as the attribution string.
-Supercite creates a list of possible attributions when it scans the
-mail headers from the original message.  Each attribution choice is
-associated with a key in an attribution alist.  Supercite tries to
-pick a \"preferred\" attribution by matching the attribution alist
-keys against the elements in `sc-preferred-attribution-list' in order.
-The first non-empty string value found is used as the preferred
-attribution.
-
-Note that Supercite now honors the X-Attribution: mail field.  If
-present in the original message, the value of this field should always
-be used to select the most preferred attribution since it reflects how
-the original author would like to be distinguished.  It should be
-considered bad taste to put any attribution preference key before
-\"x-attribution\" in this list, except perhaps for \"sc-lastchoice\"
-\(see below).
-
-Supercite remembers the last attribution used when reciting an already
-cited paragraph.  This attribution will always be saved with the
-\"sc-lastchoice\" key, which can be used in this list.  Note that the
-last choice is always reset after every call of `sc-cite-original'.
-
-Barring error conditions, the following preferences are always present
-in the attribution alist:
-
-\"emailname\"    -- email terminus name
-\"initials\"     -- initials of author
-\"firstname\"    -- first name of author
-\"lastname\"     -- last name of author
-\"middlename-1\" -- first middle name of author
-\"middlename-2\" -- second middle name of author
-...
-
-Middle name indexes can be any positive integer greater than 0,
-although it is unlikely that many authors will supply more than one
-middle name, if that many.  The string of all middle names is
-associated with the key \"middlenames\".")
-
-(defvar sc-attrib-selection-list nil
-  "*An alist for selecting preferred attribution based on mail headers.
-Each element of this list has the following form:
-
-   (INFOKEY ((REGEXP . ATTRIBUTION)
-             (REGEXP . ATTRIBUTION)
-             (...)))
-
-Where INFOKEY is a key for `sc-mail-field', REGEXP is a regular
-expression to match against the INFOKEY's value. ATTRIBUTION can be a
-string or a list.  If its a string, then it is the attribution that is
-selected by `sc-select-attribution'.  If it is a list, it is `eval'd
-and the return value must be a string, which is used as the selected
-attribution.  Note that the variable `sc-preferred-attribution-list'
-must contain an element of the string \"sc-consult\" for this variable
-to be consulted during attribution selection.")
-
-(defvar sc-attribs-preselect-hook nil
-  "*Hook to run before selecting an attribution.")
-(defvar sc-attribs-postselect-hook nil
-  "*Hook to run after selecting an attribution, but before confirmation.")
-
-(defvar sc-pre-cite-hook nil
-  "*Hook to run before citing a region of text.")
-(defvar sc-pre-uncite-hook nil
-  "*Hook to run before unciting a region of text.")
-(defvar sc-pre-recite-hook nil
-  "*Hook to run before reciting a region of text.")
-
-(defvar sc-preferred-header-style 4
-  "*Index into `sc-rewrite-header-list' specifying preferred header style.
-Index zero accesses the first function in the list.")
-
-(defvar sc-reference-tag-string ">>>>> "
-  "*String used at the beginning of built-in reference headers.")
-
-(defvar sc-rewrite-header-list
-  '((sc-no-header)
-    (sc-header-on-said)
-    (sc-header-inarticle-writes)
-    (sc-header-regarding-adds)
-    (sc-header-attributed-writes)
-    (sc-header-author-writes)
-    (sc-header-verbose)
-    (sc-no-blank-line-or-header)
-    )
-  "*List of reference header rewrite functions.
-The variable `sc-preferred-header-style' controls which function in
-this list is chosen for automatic reference header insertions.
-Electric reference mode will cycle through this list of functions.")
-
-(defvar sc-titlecue-regexp "\\s +-+\\s +"
-  "*Regular expression describing the separator between names and titles.
-Set to nil to treat entire field as a name.")
-
-(defvar sc-use-only-preference-p nil
-  "*Controls what happens when the preferred attribution cannot be found.
-If non-nil, then `sc-default-attribution' will be used.  If nil, then
-some secondary scheme will be employed to find a suitable attribution
-string.")
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end user configuration variables
-
-(defconst sc-version "3.1"
-  "Supercite version number.")
-(defconst sc-help-address "supercite-help@anthem.nlm.nih.gov"
-  "Address accepting submissions of bug reports.")
-
-(defvar sc-mail-info nil
-  "Alist of mail header information gleaned from reply buffer.")
-(defvar sc-attributions nil
-  "Alist of attributions for use when citing.")
-
-(defconst sc-emacs-features
-  (let ((version 'v18)
-	(flavor  'GNU))
-    (if (string= (substring emacs-version 0 2) "19")
-	(setq version 'v19))
-    (if (string-match "Lucid" emacs-version)
-	(setq flavor 'Lucid))
-    ;; cobble up list
-    (list version flavor))
-  "A list describing what version of Emacs we're running on.
-Known flavors are:
-
-All GNU18's: (v18 GNU)
-FSF19.x    : (v19 GNU)
-Lucid19.x  : (v19 Lucid)")
-
-
-(defvar sc-tmp-nested-regexp nil
-  "Temporary regepx describing nested citations.")
-(defvar sc-tmp-nonnested-regexp nil
-  "Temporary regexp describing non-nested citations.")
-(defvar sc-tmp-dumb-regexp nil
-  "Temp regexp describing non-nested citation cited with a nesting citer.")
-
-(defvar sc-minor-mode nil
-  "Supercite minor mode on flag.")
-(defvar sc-mode-string " SC"
-  "Supercite minor mode string.")
-
-(make-variable-buffer-local 'sc-mail-info)
-(make-variable-buffer-local 'sc-attributions)
-(make-variable-buffer-local 'sc-minor-mode)
-
-
-;; ======================================================================
-;; supercite keymaps
-
-(defvar sc-mode-map-prefix "\C-c\C-p"
-  "*Key binding to install Supercite keymap.
-If this is nil, Supercite keymap is not installed.")
-
-(defvar sc-T-keymap ()
-  "Keymap for sub-keymap of setting and toggling functions.")
-(if sc-T-keymap
-    ()
-  (setq sc-T-keymap (make-sparse-keymap))
-  (define-key sc-T-keymap "a" 'sc-S-preferred-attribution-list)
-  (define-key sc-T-keymap "b" 'sc-T-mail-nuke-blank-lines)
-  (define-key sc-T-keymap "c" 'sc-T-confirm-always)
-  (define-key sc-T-keymap "d" 'sc-T-downcase)
-  (define-key sc-T-keymap "e" 'sc-T-electric-references)
-  (define-key sc-T-keymap "f" 'sc-T-auto-fill-region)
-  (define-key sc-T-keymap "h" 'sc-T-describe)
-  (define-key sc-T-keymap "l" 'sc-S-cite-region-limit)
-  (define-key sc-T-keymap "n" 'sc-S-mail-nuke-mail-headers)
-  (define-key sc-T-keymap "N" 'sc-S-mail-header-nuke-list)
-  (define-key sc-T-keymap "o" 'sc-T-electric-circular)
-  (define-key sc-T-keymap "p" 'sc-S-preferred-header-style)
-  (define-key sc-T-keymap "s" 'sc-T-nested-citation)
-  (define-key sc-T-keymap "u" 'sc-T-use-only-preferences)
-  (define-key sc-T-keymap "w" 'sc-T-fixup-whitespace)
-  (define-key sc-T-keymap "?" 'sc-T-describe)
-  )
-
-(defvar sc-mode-map ()
-  "Keymap for Supercite quasi-mode.")
-(if sc-mode-map
-    ()
-  (setq sc-mode-map (make-sparse-keymap))
-  (define-key sc-mode-map "c"    'sc-cite-region)
-  (define-key sc-mode-map "f"    'sc-mail-field-query)
-  (define-key sc-mode-map "g"    'sc-mail-process-headers)
-  (define-key sc-mode-map "h"    'sc-describe)
-  (define-key sc-mode-map "i"    'sc-insert-citation)
-  (define-key sc-mode-map "o"    'sc-open-line)
-  (define-key sc-mode-map "r"    'sc-recite-region)
-  (define-key sc-mode-map "\C-p" 'sc-raw-mode-toggle)
-  (define-key sc-mode-map "u"    'sc-uncite-region)
-  (define-key sc-mode-map "v"    'sc-version)
-  (define-key sc-mode-map "w"    'sc-insert-reference)
-  (define-key sc-mode-map "\C-t"  sc-T-keymap)
-  (define-key sc-mode-map "\C-b" 'sc-submit-bug-report)
-  (define-key sc-mode-map "?"    'sc-describe)
-  )
-  
-(defvar sc-electric-mode-map ()
-  "Keymap for `sc-electric-mode' electric references mode.")
-(if sc-electric-mode-map
-    nil
-  (setq sc-electric-mode-map (make-sparse-keymap))
-  (define-key sc-electric-mode-map "p"    'sc-eref-prev)
-  (define-key sc-electric-mode-map "n"    'sc-eref-next)
-  (define-key sc-electric-mode-map "s"    'sc-eref-setn)
-  (define-key sc-electric-mode-map "j"    'sc-eref-jump)
-  (define-key sc-electric-mode-map "x"    'sc-eref-abort)
-  (define-key sc-electric-mode-map "q"    'sc-eref-abort)
-  (define-key sc-electric-mode-map "\r"   'sc-eref-exit)
-  (define-key sc-electric-mode-map "\n"   'sc-eref-exit)
-  (define-key sc-electric-mode-map "g"    'sc-eref-goto)
-  (define-key sc-electric-mode-map "?"    'describe-mode)
-  (define-key sc-electric-mode-map "\C-h" 'describe-mode)
-  (define-key sc-electric-mode-map [f1]   'describe-mode)
-  (define-key sc-electric-mode-map [help] 'describe-mode)
-  )
-
-(defvar sc-minibuffer-local-completion-map nil
-  "Keymap for minibuffer confirmation of attribution strings.")
-(if sc-minibuffer-local-completion-map
-    ()
-  (setq sc-minibuffer-local-completion-map
-	(copy-keymap minibuffer-local-completion-map))
-  (define-key sc-minibuffer-local-completion-map "\C-t" 'sc-toggle-fn)
-  (define-key sc-minibuffer-local-completion-map " "    'self-insert-command))
-
-(defvar sc-minibuffer-local-map nil
-  "Keymap for minibuffer confirmation of attribution strings.")
-(if sc-minibuffer-local-map
-    ()
-  (setq sc-minibuffer-local-map (copy-keymap minibuffer-local-map))
-  (define-key sc-minibuffer-local-map "\C-t" 'sc-toggle-fn))
-
-
-;; ======================================================================
-;; utility functions
-
-(defun sc-completing-read (prompt table &optional predicate require-match
-				  initial-contents history)
-  "Compatibility between Emacs 18 and 19 `completing-read'.
-In version 18, the HISTORY argument is ignored."
-  (if (memq 'v19 sc-emacs-features)
-      (funcall 'completing-read prompt table predicate require-match
-	       initial-contents history)
-    (funcall 'completing-read prompt table predicate require-match
-	     (or (car-safe initial-contents)
-		 initial-contents))))
-
-(defun sc-read-string (prompt &optional initial-contents history)
-  "Compatibility between Emacs 18 and 19 `read-string'.
-In version 18, the HISTORY argument is ignored."
-  (if (memq 'v19 sc-emacs-features)
-      ;; maybe future versions will take a `history' argument:
-      (read-string prompt initial-contents)
-    (read-string prompt initial-contents)))
-
-(if (fboundp 'match-string)
-    (defalias 'sc-submatch 'match-string)
-  (defun sc-submatch (matchnum &optional string)
-    "Returns `match-beginning' and `match-end' sub-expression for MATCHNUM.
-If optional STRING is provided, take sub-expression using `substring'
-of argument, otherwise use `buffer-substring' on current buffer.  Note
-that `match-data' must have already been generated and no error
-checking is performed by this function."
-    (if string
-	(substring string (match-beginning matchnum) (match-end matchnum))
-      (buffer-substring (match-beginning matchnum) (match-end matchnum)))))
-
-(if (fboundp 'member)
-    (defalias 'sc-member 'member)
-  (defun sc-member (elt list)
-    "Like `memq', but uses `equal' instead of `eq'.
-Emacs19 has a builtin function `member' which does exactly this."
-    (catch 'elt-is-member
-      (while list
-	(if (equal elt (car list))
-	    (throw 'elt-is-member list))
-	(setq list (cdr list))))))
-
-;; One day maybe Emacs will have this...
-(if (fboundp 'string-text)
-    (defalias 'sc-string-text 'string-text)
-  (defun sc-string-text (string)
-    "Return STRING with all text properties removed."
-    (let ((string (copy-sequence string)))
-      (set-text-properties 0 (length string) nil string)
-      string)))
-
-(defun sc-ask (alist)
-  "Ask a question in the minibuffer requiring a single character answer.
-This function is kind of an extension of `y-or-n-p' where a single
-letter is used to answer a question.  Question is formed from ALIST
-which has members of the form:  (WORD . LETTER).  WORD is the long
-word form, while LETTER is the letter for selecting that answer.  The
-selected letter is returned, or nil if the question was not answered.
-Note that WORD is a string and LETTER is a character.  All LETTERs in
-the list should be unique."
-  (let* ((prompt (concat
-		  (mapconcat (function (lambda (elt) (car elt))) alist ", ")
-		  "? ("
-		  (mapconcat
-		   (function
-		    (lambda (elt) (char-to-string (cdr elt)))) alist "/")
-		  ") "))
-	 (p prompt)
-	 (event
-	  (if (memq 'Lucid sc-emacs-features)
-	      (allocate-event)
-	    nil)))
-    (while (stringp p)
-      (if (let ((cursor-in-echo-area t)
-		(inhibit-quit t))
-	    (message "%s" p)
-	    ;; lets be good neighbors and be compatible with all emacsen
-	    (cond
-	     ((memq 'v18 sc-emacs-features)
-	      (setq event (read-char)))
-	     ((memq 'Lucid sc-emacs-features)
-	      (next-command-event event))
-	     (t				; must be FSF19
-	      (setq event (read-event))))
-	    (prog1 quit-flag (setq quit-flag nil)))
-	  (progn
-	    (message "%s%s" p (single-key-description event))
-	    (and (memq 'Lucid sc-emacs-features)
-		 (deallocate-event event))
-	    (setq quit-flag nil)
-	    (signal 'quit '())))
-      (let ((char
-	     (if (memq 'Lucid sc-emacs-features)
-		 (let* ((key (and (key-press-event-p event) (event-key event)))
-			(char (and key (event-to-character event))))
-		   char)
-	       event))
-	    elt)
-	(if char (setq char (downcase char)))
-	(cond
-	 ((setq elt (rassq char alist))
-	  (message "%s%s" p (car elt))
-	  (setq p (cdr elt)))
-	 ((and (memq 'Lucid sc-emacs-features)
-	       (button-release-event-p event)) ; ignore them
-	  nil)
-	 (t
-	  (message "%s%s" p (single-key-description event))
-	  (if (memq 'Lucid sc-emacs-features)
-	      (ding nil 'y-or-n-p)
-	    (ding))
-	  (discard-input)
-	  (if (eq p prompt)
-	      (setq p (concat "Try again.  " prompt)))))))
-    (and (memq 'Lucid sc-emacs-features)
-	 (deallocate-event event))
-    p))
-
-(defun sc-scan-info-alist (alist)
-  "Find a match in the info alist that matches a regexp in ALIST."
-  (let ((sc-mumble "")
-	rtnvalue)
-    (while alist
-      (let* ((elem    (car alist))
-	     (infokey (car elem))
-	     (infoval (sc-mail-field infokey))
-	     (mlist   (car (cdr elem))))
-	(while mlist
-	  (let* ((ml-elem (car mlist))
-		 (regexp  (car ml-elem))
-		 (thing   (cdr ml-elem)))
-	    (if (string-match regexp infoval)
-		;; we found a match, time to return
-		(setq rtnvalue thing
-		      mlist nil
-		      alist nil)
-	      ;; else we didn't find a match
-	      (setq mlist (cdr mlist))
-	      )))			;end of mlist loop
-	(setq alist (cdr alist))
-	))				;end of alist loop
-    rtnvalue))
-
-
-;; ======================================================================
-;; extract mail field information from headers in reply buffer
-
-;; holder variables for bc happiness
-(defvar sc-mail-headers-start nil
-  "Start of header fields.")
-(defvar sc-mail-headers-end nil
-  "End of header fields.")
-(defvar sc-mail-field-history nil
-  "For minibuffer completion on mail field queries.")
-(defvar sc-mail-field-modification-history nil
-  "For minibuffer completion on mail field modifications.")
-(defvar sc-mail-glom-frame
-  '((begin                        (setq sc-mail-headers-start (point)))
-    ("^x-attribution:[ \t]+.*$"   (sc-mail-fetch-field t) nil t)
-    ("^\\S +:.*$"                 (sc-mail-fetch-field) nil t)
-    ("^$"                         (list 'abort '(step . 0)))
-    ("^[ \t]+"                    (sc-mail-append-field))
-    (sc-mail-warn-if-non-rfc822-p (sc-mail-error-in-mail-field))
-    (end                          (setq sc-mail-headers-end (point))))
-  "Regi frame for glomming mail header information.")
-
-;; regi functions
-(defun sc-mail-fetch-field (&optional attribs-p)
-  "Insert a key and value into `sc-mail-info' alist.
-If optional ATTRIBS-P is non-nil, the key/value pair is placed in
-`sc-attributions' too."
-  (if (string-match "^\\(\\S *\\)\\s *:\\s +\\(.*\\)$" curline)
-      (let* ((key (downcase (sc-string-text (sc-submatch 1 curline))))
-	     (val (sc-string-text (sc-submatch 2 curline)))
-	     (keyval (cons key val)))
-	(setq sc-mail-info (cons keyval sc-mail-info))
-	(if attribs-p
-	    (setq sc-attributions (cons keyval sc-attributions)))
-	))
-  nil)
-
-(defun sc-mail-append-field ()
-  "Append a continuation line onto the last fetched mail field's info."
-  (let ((keyval (car sc-mail-info)))
-    (if (and keyval (string-match "^\\s *\\(.*\\)$" curline))
-	(setcdr keyval (concat (cdr keyval) " "
-			       (sc-string-text (sc-submatch 1 curline))))))
-  nil)
-
-(defun sc-mail-error-in-mail-field ()
-  "Issue warning that mail headers don't conform to RFC 822."
-  (let* ((len (min (length curline) 10))
-	 (ellipsis (if (< len (length curline)) "..." ""))
-	 (msg "Mail header \"%s%s\" doesn't conform to RFC 822. skipping..."))
-    (message msg (substring curline 0 len) ellipsis))
-  (beep)
-  (sit-for 2)
-  nil)
-
-;; mail header nuking
-(defvar sc-mail-last-header-nuked-p nil
-  "True if the last header was nuked.")
-
-(defun sc-mail-nuke-line ()
-  "Nuke the current mail header line."
-  (delete-region (regi-pos 'bol) (regi-pos 'bonl))
-  '((step . -1)))
-
-(defun sc-mail-nuke-header-line ()
-  "Delete current-line and set up for possible continuation."
-  (setq sc-mail-last-header-nuked-p t)
-  (sc-mail-nuke-line))
-
-(defun sc-mail-nuke-continuation-line ()
-  "Delete a continuation line if the last header line was deleted."
-  (if sc-mail-last-header-nuked-p
-      (sc-mail-nuke-line)))
-
-(defun sc-mail-cleanup-blank-lines ()
-  "Leave some blank lines after original mail headers are nuked.
-The number of lines left is specified by `sc-blank-lines-after-headers'."
-  (if sc-blank-lines-after-headers
-      (save-restriction
-	(widen)
-	(skip-chars-backward " \t\n")
-	(forward-line 1)
-	(delete-blank-lines)
-	(beginning-of-line)
-	(if (looking-at "[ \t]*$")
-	    (delete-region (regi-pos 'bol) (regi-pos 'bonl)))
-	(insert-char ?\n sc-blank-lines-after-headers)))
-  nil)
-
-(defun sc-mail-build-nuke-frame ()
-  "Build the regiframe for nuking mail headers."
-  (let (every-func entry-func nonentry-func)
-    (cond
-     ((eq sc-nuke-mail-headers 'all)
-      (setq every-func '(progn (forward-line -1) (sc-mail-nuke-line))))
-     ((eq sc-nuke-mail-headers 'specified)
-      (setq entry-func    '(sc-mail-nuke-header-line)
-	    nonentry-func '(setq sc-mail-last-header-nuked-p nil)))
-     ((eq sc-nuke-mail-headers 'keep)
-      (setq entry-func    '(setq sc-mail-last-header-nuked-p nil)
-	    nonentry-func '(sc-mail-nuke-header-line)))
-     ;; we never get far enough to interpret a frame if s-n-m-h == 'none
-     ((eq sc-nuke-mail-headers 'none))
-     (t (error "Illegal value for sc-nuke-mail-headers: %s"
-	       sc-nuke-mail-headers))
-     )					; end-cond
-    (append
-     (and entry-func
-	  (regi-mapcar sc-nuke-mail-header-list entry-func nil t))
-     (and nonentry-func (list (list "^\\S +:.*$" nonentry-func)))
-     (and (not every-func)
-	  '(("^[ \t]+" (sc-mail-nuke-continuation-line))))
-     '((begin     (setq sc-mail-last-header-zapped-p nil)))
-     '((end       (sc-mail-cleanup-blank-lines)))
-     (and every-func (list (list 'every every-func)))
-     )))
-
-;; mail processing and zapping. this is the top level entry defun to
-;; all header processing.
-(defun sc-mail-process-headers (start end)
-  "Process original mail message's mail headers.
-After processing, mail headers may be nuked.  Header information is
-stored in `sc-mail-info', and any old information is lost unless an
-error occurs."
-  (interactive "r")
-  (let ((info (copy-alist sc-mail-info))
-	(attribs (copy-alist sc-attributions)))
-    (setq sc-mail-info nil
-	  sc-attributions nil)
-    (regi-interpret sc-mail-glom-frame start end)
-    (if (null sc-mail-info)
-	(progn
-	  (message "No mail headers found! Restoring old information.")
-	  (setq sc-mail-info info
-		sc-attributions attribs))
-      (regi-interpret (sc-mail-build-nuke-frame)
-		      sc-mail-headers-start sc-mail-headers-end)
-      )))
-
-
-;; let the user change mail field information
-(defun sc-mail-field (field)
-  "Return the mail header field value associated with FIELD.
-If there was no mail header with FIELD as its key, return the value of
-`sc-mumble'.  FIELD is case insensitive."
-  (or (cdr (assoc (downcase field) sc-mail-info)) sc-mumble))
-
-(defun sc-mail-field-query (arg)
-  "View the value of a mail field.
-With `\\[universal-argument]', prompts for action on mail field.
-Action can be one of: View, Modify, Add, or Delete."
-  (interactive "P")
-  (let* ((alist '(("view" . ?v) ("modify" . ?m) ("add" . ?a) ("delete" . ?d)))
-	 (action (if (not arg) ?v (sc-ask alist)))
-	 key)
-    (if (not action)
-	()
-      (setq key (sc-completing-read
-		 (concat (car (rassq action alist))
-			      " information key: ")
-		 sc-mail-info nil
-		 (if (eq action ?a) nil 'noexit)
-		 nil 'sc-mail-field-history))
-      (cond
-       ((eq action ?v)
-	(message "%s: %s" key (cdr (assoc key sc-mail-info))))
-       ((eq action ?d)
-	(setq sc-mail-info (delq (assoc key sc-mail-info) sc-mail-info)))
-       ((eq action ?m)
-	(let ((keyval (assoc key sc-mail-info)))
-	  ;; first put initial value onto list if not already there
-	  (if (not (sc-member (cdr keyval)
-			      sc-mail-field-modification-history))
-	      (setq sc-mail-field-modification-history
-		    (cons (cdr keyval) sc-mail-field-modification-history)))
-	  (setcdr keyval (sc-read-string
-			  (concat key ": ") (cdr keyval)
-			  'sc-mail-field-modification-history))))
-       ((eq action ?a)
-	(setq sc-mail-info
-	      (cons (cons key
-			  (sc-read-string (concat key ": "))) sc-mail-info)))
-       ))))
-
-
-;; ======================================================================
-;; attributions
-
-(defvar sc-attribution-confirmation-history nil
-  "History for confirmation of attribution strings.")
-(defvar sc-citation-confirmation-history nil
-  "History for confirmation of attribution prefixes.")
-
-(defun sc-attribs-%@-addresses (from &optional delim)
-  "Extract the author's email terminus from email address FROM.
-Match addresses of the style ``name%[stuff].'' when called with DELIM
-of \"%\" and addresses of the style ``[stuff]name@[stuff]'' when
-called with DELIM \"@\".  If DELIM is nil or not provided, matches
-addresses of the style ``name''."
-  (and (string-match (concat "[-a-zA-Z0-9_.]+" delim) from 0)
-       (substring from
-		  (match-beginning 0)
-		  (- (match-end 0) (if (null delim) 0 1)))))
-
-(defun sc-attribs-!-addresses (from)
-  "Extract the author's email terminus from email address FROM.
-Match addresses of the style ``[stuff]![stuff]...!name[stuff].''"
-  (let ((eos (length from))
-	(mstart (string-match "![-a-zA-Z0-9_.]+\\([^-!a-zA-Z0-9_.]\\|$\\)"
-			      from 0))
-	(mend (match-end 0)))
-    (and mstart
-	 (substring from (1+ mstart) (- mend (if (= mend eos) 0 1)))
-	 )))
-
-(defun sc-attribs-<>-addresses (from)
-  "Extract the author's email terminus from email address FROM.
-Match addresses of the style ``<name[stuff]>.''"
-  (and (string-match "<\\(.*\\)>" from)
-       (sc-submatch 1 from)))
-
-(defun sc-get-address (from author)
-  "Get the full email address path from FROM.
-AUTHOR is the author's name (which is removed from the address)."
-  (let ((eos (length from)))
-    (if (string-match (concat "\\(^\\|^\"\\)" author
-			      "\\(\\s +\\|\"\\s +\\)") from 0)
-	(let ((address (substring from (match-end 0) eos)))
-	  (if (and (= (aref address 0) ?<)
-		   (= (aref address (1- (length address))) ?>))
-	      (substring address 1 (1- (length address)))
-	    address))
-      (if (string-match "[-a-zA-Z0-9!@%._]+" from 0)
-	  (sc-submatch 0 from)
-	"")
-      )))
-
-(defun sc-attribs-emailname (from)
-  "Get the email terminus name from FROM."
-  (or
-   (sc-attribs-%@-addresses from "%")
-   (sc-attribs-%@-addresses from "@")
-   (sc-attribs-!-addresses  from)
-   (sc-attribs-<>-addresses from)
-   (sc-attribs-%@-addresses from)
-   (substring from 0 10)))
-
-(defun sc-name-substring (string start end extend)
-  "Extract the specified substring of STRING from START to END.
-EXTEND is the number of characters on each side to extend the
-substring."
-  (and start
-       (let ((sos (+ start extend))
-	     (eos (- end extend)))
-	 (substring string sos
-		    (or (string-match sc-titlecue-regexp string sos) eos)
-		    ))))
-
-(defun sc-attribs-extract-namestring (from)
-  "Extract the name string from FROM.
-This should be the author's full name minus an optional title."
-  (let ((namestring
-	 (or
-	  ;; If there is a <...> in the name,
-	  ;; treat everything before that as the full name.
-	  ;; Even if it contains parens, use the whole thing.
-	  ;; On the other hand, we do look for quotes in the usual way.
-	  (and (string-match " *<.*>" from 0)
-	       (let ((before-angles
-		      (sc-name-substring from 0 (match-beginning 0) 0)))
-		 (if (string-match "\".*\"" before-angles 0)
-		     (sc-name-substring
-		      before-angles (match-beginning 0) (match-end 0) 1)
-		   before-angles)))
-	  (sc-name-substring
-	   from (string-match "(.*)" from 0) (match-end 0) 1)
-	  (sc-name-substring
-	   from (string-match "\".*\"" from 0) (match-end 0) 1)
-	  (sc-name-substring
-	   from (string-match "\\([-.a-zA-Z0-9_]+\\s +\\)+<" from 0)
-	   (match-end 1) 0)
-	  (sc-attribs-emailname from))))
-    ;; strip off any leading or trailing whitespace
-    (if namestring
-	(let ((bos 0)
-	      (eos (1- (length namestring))))
-	  (while (and (<= bos eos)
-		      (memq (aref namestring bos) '(32 ?\t)))
-	    (setq bos (1+ bos)))
-	  (while (and (> eos bos)
-		      (memq (aref namestring eos) '(32 ?\t)))
-	    (setq eos (1- eos)))
-	  (substring namestring bos (1+ eos))))))
-
-(defun sc-attribs-chop-namestring (namestring)
-  "Convert NAMESTRING to a list of names.
-example: (sc-namestring-to-list \"John Xavier Doe\")
-         => (\"John\" \"Xavier\" \"Doe\")"
-  (if (string-match "\\([ \t]*\\)\\([^ \t._]+\\)\\([ \t]*\\)" namestring)
-      (cons (sc-submatch 2 namestring)
-	    (sc-attribs-chop-namestring (substring namestring (match-end 3)))
-	    )))
-
-(defun sc-attribs-strip-initials (namelist)
-  "Extract the author's initials from the NAMELIST."
-  (mapconcat
-   (function
-    (lambda (name)
-      (if (< 0 (length name))
-	  (substring name 0 1))))
-   namelist ""))
-
-(defun sc-guess-attribution (&optional string)
-  "Guess attribution string on current line.
-If attribution cannot be guessed, nil is returned.  Optional STRING if
-supplied, is used instead of the line point is on in the current buffer."
-  (let ((start 0)
-	(string (or string (buffer-substring (regi-pos 'bol) (regi-pos 'eol))))
-	attribution)
-    (and
-     (= start (or (string-match sc-citation-leader-regexp string start) -1))
-     (setq start (match-end 0))
-     (= start (or (string-match sc-citation-root-regexp string start) 1))
-     (setq attribution (sc-submatch 0 string)
-	   start (match-end 0))
-     (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
-     (setq start (match-end 0))
-     (= start (or (string-match sc-citation-separator-regexp string start) -1))
-     attribution)))
-
-(defun sc-attribs-filter-namelist (namelist)
-  "Filter out noise in NAMELIST according to `sc-name-filter-alist'."
-  (let ((elements (length namelist))
-	(position -1)
-	keepers filtered-list)
-    (mapcar
-     (function
-      (lambda (name)
-	(setq position (1+ position))
-	(let ((keep-p t))
-	  (mapcar
-	   (function
-	    (lambda (filter)
-	      (let ((regexp (car filter))
-		    (pos (cdr filter)))
-		(if (and (string-match regexp name)
-			 (or (and (numberp pos)
-				  (= pos position))
-			     (and (eq pos 'last)
-				  (= position (1- elements)))
-			     (eq pos 'any)))
-		    (setq keep-p nil))
-		)))
-	   sc-name-filter-alist)
-	  (if keep-p
-	      (setq keepers (cons position keepers)))
-	  )))
-     namelist)
-    (mapcar
-     (function
-      (lambda (position)
-	(setq filtered-list (cons (nth position namelist) filtered-list))
-	))
-     keepers)
-    filtered-list))
-
-(defun sc-attribs-chop-address (from)
-  "Extract attribution information from FROM.
-This populates the `sc-attributions' with the list of possible attributions."
-  (if (and (stringp from)
-	   (< 0 (length from)))
-      (let* ((sc-mumble "")	     
-	     (namestring (sc-attribs-extract-namestring from))
-	     (namelist   (sc-attribs-filter-namelist
-			  (sc-attribs-chop-namestring namestring)))
-	     (revnames   (reverse (cdr namelist)))
-	     (firstname  (car namelist))
-	     (midnames   (reverse (cdr revnames)))
-	     (lastname   (car revnames))
-	     (initials   (sc-attribs-strip-initials namelist))
-	     (emailname  (sc-attribs-emailname from))
-	     (n 1)
-	     author middlenames)
-    
-	;; put basic information
-	(setq
-	 ;; put middle names and build sc-author entry
-	 middlenames (mapconcat
-		      (function
-		       (lambda (midname)
-			 (let ((key-attribs (format "middlename-%d" n))
-			       (key-mail    (format "sc-middlename-%d" n)))
-			   (setq
-			    sc-attributions (cons (cons key-attribs midname)
-						  sc-attributions)
-			    sc-mail-info (cons (cons key-mail midname)
-					       sc-mail-info)
-			    n (1+ n))
-			   midname)))
-		      midnames " ")
-
-	 author (concat firstname " " middlenames (and midnames " ") lastname)
-
-	 sc-attributions (append
-			  (list
-			   (cons "firstname"   firstname)
-			   (cons "lastname"    lastname)
-			   (cons "emailname"   emailname)
-			   (cons "initials"    initials))
-			  sc-attributions)
-	 sc-mail-info (append
-		       (list
-			(cons "sc-firstname"   firstname)
-			(cons "sc-middlenames" middlenames)
-			(cons "sc-lastname"    lastname)
-			(cons "sc-emailname"   emailname)
-			(cons "sc-initials"    initials)
-			(cons "sc-author"      author)
-			(cons "sc-from-address" (sc-get-address
-						 (sc-mail-field "from")
-						 namestring))
-			(cons "sc-reply-address" (sc-get-address
-						  (sc-mail-field "reply-to")
-						  namestring))
-			(cons "sc-sender-address" (sc-get-address
-						   (sc-mail-field "sender")
-						   namestring))
-			)
-		       sc-mail-info)
-	 ))
-    ;; from string is empty
-    (setq sc-mail-info (cons (cons "sc-author" sc-default-author-name)
-			     sc-mail-info))))
-
-(defvar sc-attrib-or-cite nil
-  "Used to toggle between attribution input or citation input.")
-
-(defun sc-toggle-fn ()
-  "Toggle between attribution selection and citation selection.
-Only used during confirmation."
-  (interactive)
-  (setq sc-attrib-or-cite (not sc-attrib-or-cite))
-  (throw 'sc-reconfirm t))
-
-(defun sc-select-attribution ()
-  "Select an attribution from `sc-attributions'.
-
-Variables involved in selection process include:
-     `sc-preferred-attribution-list'
-     `sc-use-only-preference-p'
-     `sc-confirm-always-p'
-     `sc-default-attribution'
-     `sc-attrib-selection-list'.
-
-Runs the hook `sc-attribs-preselect-hook' before selecting an
-attribution and the hook `sc-attribs-postselect-hook' after making the
-selection but before querying is performed.  During
-`sc-attribs-postselect-hook' the variable `citation' is bound to the
-auto-selected citation string and the variable `attribution' is bound
-to the auto-selected attribution string."
-  (run-hooks 'sc-attribs-preselect-hook)
-  (let ((query-p sc-confirm-always-p)
-	attribution citation
-	(attriblist sc-preferred-attribution-list))
-
-    ;; first cruise through sc-preferred-attribution-list looking for
-    ;; a match in either sc-attributions or sc-mail-info.  if the
-    ;; element is "sc-consult", then we have to do the alist
-    ;; consultation phase
-    (while attriblist
-      (let* ((preferred (car attriblist)))
-	(cond
-	 ((string= preferred "sc-consult")
-	  ;; we've been told to consult the attribution vs. mail
-	  ;; header key alist.  we do this until we find a match in
-	  ;; the sc-attrib-selection-list.  if we do not find a match,
-	  ;; we continue scanning attriblist
-	  (let ((attrib (sc-scan-info-alist sc-attrib-selection-list)))
-	    (cond
-	     ((not attrib)
-	      (setq attriblist (cdr attriblist)))
-	     ((stringp attrib)
-	      (setq attribution attrib
-		    attriblist nil))
-	     ((listp attrib)
-	      (setq attribution (eval attrib)
-		    attriblist nil))
-	     (t (error "%s did not evaluate to a string or list!"
-		       "sc-attrib-selection-list"))
-	     )))
-	 ((setq attribution (cdr (assoc preferred sc-attributions)))
-	  (setq attriblist nil))
-	 (t
-	  (setq attriblist (cdr attriblist)))
-	 )))
-
-    ;; if preference was not found, we may use a secondary method to
-    ;; find a valid attribution
-    (if (and (not attribution)
-	     (not sc-use-only-preference-p))
-	;; secondary method tries to find a preference in this order
-	;; 1. sc-lastchoice
-	;; 2. x-attribution
-	;; 3. firstname
-	;; 4. lastname
-	;; 5. initials
-	;; 6. first non-empty attribution in alist
-	(setq attribution
-	      (or (cdr (assoc "sc-lastchoice" sc-attributions))
-		  (cdr (assoc "x-attribution" sc-attributions))
-		  (cdr (assoc "firstname" sc-attributions))
-		  (cdr (assoc "lastname" sc-attributions))
-		  (cdr (assoc "initials" sc-attributions))
-		  (cdr (car sc-attributions)))))
-
-    ;; still couldn't find an attribution. we're now limited to using
-    ;; the default attribution, but we'll force a query when this happens
-    (if (not attribution)
-	(setq attribution sc-default-attribution
-	      query-p t))
-
-    ;; create the attribution prefix
-    (setq citation (sc-make-citation attribution))
-
-    ;; run the post selection hook before querying the user
-    (run-hooks 'sc-attribs-postselect-hook)
-
-    ;; query for confirmation
-    (if query-p
-	(let* ((query-alist (mapcar (function (lambda (entry)
-						(list (cdr entry))))
-				    sc-attributions))
-	       (minibuffer-local-completion-map
-		sc-minibuffer-local-completion-map)
-	       (minibuffer-local-map sc-minibuffer-local-map)
-	       (initial attribution)
-	       (completer-disable t)	; in case completer.el is used
-	       choice)
-	  (setq sc-attrib-or-cite nil)	; nil==attribution, t==citation
-	  (while
-	      (catch 'sc-reconfirm
-		(string= "" (setq choice
-				  (if sc-attrib-or-cite
-				      (sc-read-string
-				       "Enter citation prefix: "
-				       citation
-				       'sc-citation-confirmation-history)
-				    (sc-completing-read
-				     "Complete attribution name: "
-				     query-alist nil nil
-				     (cons initial 0)
-				     'sc-attribution-confirmation-history)
-				    )))))
-	  (if sc-attrib-or-cite
-	      ;; since the citation was chosen, we have to guess at
-	      ;; the attribution
-	      (setq citation choice
-		    attribution (or (sc-guess-attribution citation)
-				    citation))
-	    
-	    (setq citation (sc-make-citation choice)
-		  attribution choice))
-	  ))
-
-    ;; its possible that the user wants to downcase the citation and
-    ;; attribution
-    (if sc-downcase-p
-	(setq citation (downcase citation)
-	      attribution (downcase attribution)))
-
-    ;; set up mail info alist
-    (let* ((ckey "sc-citation")
-	   (akey "sc-attribution")
-	   (ckeyval (assoc ckey sc-mail-info))
-	   (akeyval (assoc akey sc-mail-info)))
-      (if ckeyval
-	  (setcdr ckeyval citation)
-	(setq sc-mail-info
-	      (append (list (cons ckey citation)) sc-mail-info)))
-      (if akeyval
-	  (setcdr akeyval attribution)
-	(setq sc-mail-info
-	      (append (list (cons akey attribution)) sc-mail-info))))
-
-    ;; set the sc-lastchoice attribution
-    (let* ((lkey "sc-lastchoice")
-	   (lastchoice (assoc lkey sc-attributions)))
-      (if lastchoice
-	  (setcdr lastchoice attribution)
-	(setq sc-attributions
-	      (cons (cons lkey attribution) sc-attributions))))
-    ))
-
-
-;; ======================================================================
-;; filladapt hooks for supercite 3.1. you shouldn't need anything
-;; extra to make gin-mode understand supercited lines.  Even this
-;; stuff might not be entirely necessary...
-
-(defun sc-cite-regexp (&optional root-regexp)
-  "Return a regexp describing a Supercited line.
-The regexp is the concatenation of `sc-citation-leader-regexp',
-`sc-citation-root-regexp', `sc-citation-delimiter-regexp', and
-`sc-citation-separator-regexp'.  If optional ROOT-REGEXP is supplied,
-use it instead of `sc-citation-root-regexp'."
-  (concat sc-citation-leader-regexp
-	  (or root-regexp sc-citation-root-regexp)
-	  sc-citation-delimiter-regexp
-	  sc-citation-separator-regexp))
-
-(defun sc-make-citation (attribution)
-  "Make a non-nested citation from ATTRIBUTION."
-  (concat sc-citation-leader
-	  attribution
-	  sc-citation-delimiter
-	  sc-citation-separator))
-
-(defun sc-setup-filladapt ()
-  "Setup `filladapt-prefix-table' to handle Supercited paragraphs."
-  (let* ((fa-sc-elt 'filladapt-supercite-included-text)
-	 (elt (rassq fa-sc-elt filladapt-prefix-table)))
-    (if elt (setcar elt (sc-cite-regexp))
-      (message "Filladapt doesn't seem to know about Supercite.")
-      (beep))))
-
-
-;; ======================================================================
-;; citing and unciting regions of text
-
-(defvar sc-fill-begin 1
-  "Buffer position to begin filling.")
-(defvar sc-fill-line-prefix ""
-  "Fill prefix of previous line")
-
-;; filling
-(defun sc-fill-if-different (&optional prefix)
-  "Fill the region bounded by `sc-fill-begin' and point.
-Only fill if optional PREFIX is different than `sc-fill-line-prefix'.
-If `sc-auto-fill-region-p' is nil, do not fill region.  If PREFIX is
-not supplied, initialize fill variables.  This is useful for a regi
-`begin' frame-entry."
-  (if (not prefix)
-      (setq sc-fill-line-prefix ""
-	    sc-fill-begin (regi-pos 'bol))
-    (if (and sc-auto-fill-region-p
-	     (not (string= prefix sc-fill-line-prefix)))
-	(let ((fill-prefix sc-fill-line-prefix))
-	  (if (not (string= fill-prefix ""))
-	      (fill-region sc-fill-begin (regi-pos 'bol)))
-	  (setq sc-fill-line-prefix prefix
-		sc-fill-begin (regi-pos 'bol))))
-    )
-  nil)
-
-(defun sc-cite-coerce-cited-line ()
-  "Coerce a Supercited line to look like our style."
-  (let* ((attribution (sc-guess-attribution))
-	 (regexp (sc-cite-regexp attribution))
-	 (prefix (sc-make-citation attribution)))
-    (if (and attribution
-	     (looking-at regexp))
-	(progn
-	  (delete-region
-	   (match-beginning 0)
-	   (save-excursion
-	     (goto-char (match-end 0))
-	     (if (bolp) (forward-char -1))
-	     (point)))
-	  (insert prefix)
-	  (sc-fill-if-different prefix)))
-    nil))
-
-(defun sc-cite-coerce-dumb-citer ()
-  "Coerce a non-nested citation that's been cited with a dumb nesting citer."
-  (delete-region (match-beginning 1) (match-end 1))
-  (beginning-of-line)
-  (sc-cite-coerce-cited-line))
-
-(defun sc-guess-nesting (&optional string)
-  "Guess the citation nesting on the current line.
-If nesting cannot be guessed, nil is returned.  Optional STRING if
-supplied, is used instead of the line point is on in the current
-buffer."
-  (let ((start 0)
-	(string (or string (buffer-substring (regi-pos 'bol) (regi-pos 'eol))))
-	nesting)
-    (and
-     (= start (or (string-match sc-citation-leader-regexp string start) -1))
-     (setq start (match-end 0))
-     (= start (or (string-match sc-citation-delimiter-regexp string start) -1))
-     (setq nesting (sc-submatch 0 string)
-	   start (match-end 0))
-     (= start (or (string-match sc-citation-separator-regexp string start) -1))
-     nesting)))
-
-(defun sc-add-citation-level ()
-  "Add a citation level for nested citation style w/ coercion."
-  (let* ((nesting (sc-guess-nesting))
-	 (citation (make-string (1+ (length nesting))
-				(string-to-char sc-citation-delimiter)))
-	 (prefix (concat sc-citation-leader citation sc-citation-separator)))
-    (if (looking-at (sc-cite-regexp ""))
-	(delete-region (match-beginning 0) (match-end 0)))
-    (insert prefix)
-    (sc-fill-if-different prefix)))
-
-(defun sc-cite-line (&optional citation)
-  "Cite a single line of uncited text.
-Optional CITATION overrides any citation automatically selected."
-  (if sc-fixup-whitespace-p
-      (fixup-whitespace))
-  (let ((prefix (or citation
-		    (cdr (assoc "sc-citation" sc-mail-info))
-		    sc-default-attribution)))
-    (insert prefix)
-    (sc-fill-if-different prefix))
-  nil)
-
-(defun sc-uncite-line ()
-  "Remove citation from current line."
-  (let ((cited (looking-at (sc-cite-regexp))))
-    (if cited
-	(delete-region (match-beginning 0) (match-end 0))))
-  nil)
-
-(defun sc-recite-line (regexp)
-  "Remove citation matching REGEXP from current line and recite line."
-  (let ((cited (looking-at (concat "^" regexp)))
-	(prefix (cdr (assoc "sc-citation" sc-mail-info))))
-    (if cited
-	(delete-region (match-beginning 0) (match-end 0)))
-    (insert (or prefix sc-default-attribution))
-    (sc-fill-if-different prefix))
-  nil)
-
-;; interactive functions
-(defun sc-cite-region (start end &optional confirm-p)
-  "Cite a region delineated by START and END.
-If optional CONFIRM-P is non-nil, the attribution is confirmed before
-its use in the citation string.  This function first runs
-`sc-pre-cite-hook'."
-  (interactive "r\nP")
-  (undo-boundary)
-  (let ((frame (or (sc-scan-info-alist sc-cite-frame-alist)
-		   sc-default-cite-frame))
-	(sc-confirm-always-p (if confirm-p t sc-confirm-always-p)))
-    (run-hooks 'sc-pre-cite-hook)
-    (if (interactive-p)
-	(sc-select-attribution))
-    (regi-interpret frame start end)))
-
-(defun sc-uncite-region (start end)
-  "Uncite a region delineated by START and END.
-First runs `sc-pre-uncite-hook'."
-  (interactive "r")
-  (undo-boundary)
-  (let ((frame (or (sc-scan-info-alist sc-uncite-frame-alist)
-		   sc-default-uncite-frame)))
-    (run-hooks 'sc-pre-uncite-hook)
-    (regi-interpret frame start end)))
-      
-(defun sc-recite-region (start end)
-  "Recite a region delineated by START and END.
-First runs `sc-pre-recite-hook'."
-  (interactive "r")
-  (let ((sc-confirm-always-p t))
-    (sc-select-attribution))
-  (undo-boundary)
-  (let ((frame (or (sc-scan-info-alist sc-recite-frame-alist)
-		   sc-default-recite-frame)))
-    (run-hooks 'sc-pre-recite-hook)
-    (regi-interpret frame start end)))
-
-
-;; ======================================================================
-;; building headers
-
-(defun sc-hdr (prefix field &optional sep return-nil-p)
-  "Returns a concatenation of PREFIX and FIELD.
-If FIELD is not a string or is the empty string, the empty string will
-be returned.  Optional third argument SEP is concatenated on the end if
-it is a string.  Returns empty string, unless optional RETURN-NIL-P is
-non-nil."
-  (if (and (stringp field)
-	   (not (string= field "")))
-      (concat prefix field (or sep ""))
-    (and (not return-nil-p) "")))
-
-(defun sc-whofrom ()
-  "Return the value of (sc-mail-field \"from\") or nil."
-  (let ((sc-mumble nil))
-    (sc-mail-field "from")))
-
-(defun sc-no-header ()
-  "Does nothing.  Use this instead of nil to get a blank header."
-  ())
-
-(defun sc-no-blank-line-or-header()
-  "Similar to `sc-no-header' except it removes the preceding blank line."
-  (if (not (bobp))
-      (if (and (eolp)
-	       (progn (forward-line -1)
-		      (or (looking-at
-			   (concat "^" (regexp-quote mail-header-separator) "$"))
-			  (and (eq major-mode 'mh-letter-mode)
-			       (mh-in-header-p)))))
-	  (progn (forward-line)
-		 (let ((kill-lines-magic t))
-		   (kill-line))))))
-
-(defun sc-header-on-said ()
-  "\"On <date>, <from> said:\" unless:
-1. the \"from\" field cannot be found, in which case nothing is inserted;
-2. the \"date\" field is missing in which case only the from part is printed."
-  (let ((sc-mumble "")
-	(whofrom (sc-whofrom)))
-    (if whofrom
-	(insert sc-reference-tag-string
-		(sc-hdr "On " (sc-mail-field "date") ", ")
-		whofrom " said:\n"))))
-
-(defun sc-header-inarticle-writes ()
-  "\"In article <message-id>, <from> writes:\"
-Treats \"message-id\" and \"from\" fields similar to `sc-header-on-said'."
-  (let ((sc-mumble "")
-	(whofrom (sc-mail-field "from")))
-    (if whofrom
-	(insert sc-reference-tag-string
-		(sc-hdr "In article " (sc-mail-field "message-id") ", ")
-		whofrom " writes:\n"))))
-
-(defun sc-header-regarding-adds ()
-  "\"Regarding <subject>; <from> adds:\"
-Treats \"subject\" and \"from\" fields similar to `sc-header-on-said'."
-  (let ((sc-mumble "")
-	(whofrom (sc-whofrom)))
-    (if whofrom
-	(insert sc-reference-tag-string
-		(sc-hdr "Regarding " (sc-mail-field "subject") "; ")
-		whofrom " adds:\n"))))
-
-(defun sc-header-attributed-writes ()
-  "\"<sc-attribution>\" == <sc-author> <address> writes:
-Treats these fields in a similar manner to `sc-header-on-said'."
-  (let ((sc-mumble "")
-	(whofrom (sc-whofrom)))
-    (if whofrom
-	(insert sc-reference-tag-string
-		(sc-hdr "\"" (sc-mail-field "sc-attribution") "\" == ")
-		(sc-hdr ""   (sc-mail-field "sc-author") " ")
-		(or (sc-hdr "<" (sc-mail-field "sc-from-address") ">" t)
-		    (sc-hdr "<" (sc-mail-field "sc-reply-address") ">"  t)
-		    "")
-		" writes:\n"))))
-
-(defun sc-header-author-writes ()
-  "<sc-author> writes:"
-  (let ((sc-mumble "")
-	(whofrom (sc-whofrom)))
-    (if whofrom
-	(insert sc-reference-tag-string
-		(sc-hdr "" (sc-mail-field "sc-author"))
-		" writes:\n"))))
-
-(defun sc-header-verbose ()
-  "Very verbose, some say gross."
-  (let ((sc-mumble "")
-	(whofrom (sc-whofrom))
-	(tag sc-reference-tag-string))
-    (if whofrom
-	(insert (sc-hdr (concat tag "On ") (sc-mail-field "date") ",\n")
-		(or (sc-hdr tag (sc-mail-field "sc-author") "\n" t)
-		    (concat tag whofrom "\n"))
-		(sc-hdr (concat tag "from the organization of ")
-			(sc-mail-field "organization") "\n")
-		(let ((rtag (concat tag "who can be reached at: ")))
-		  (or (sc-hdr rtag (sc-mail-field "sc-from-address") "\n" t)
-		      (sc-hdr rtag (sc-mail-field "sc-reply-address")  "\n" t)
-		      ""))
-		(sc-hdr
-		 (concat tag "(whose comments are cited below with \"")
-		 (sc-mail-field "sc-citation") "\"),\n")
-		(sc-hdr (concat tag "had this to say in article ")
-			(sc-mail-field "message-id") "\n")
-		(sc-hdr (concat tag "in newsgroups ")
-			(sc-mail-field "newsgroups") "\n")
-		(sc-hdr (concat tag "concerning the subject of ")
-			(sc-mail-field "subject") "\n")
-		(sc-hdr (concat tag "(see ")
-			(sc-mail-field "references")
-			" for more details)\n")
-		))))
-
-
-;; ======================================================================
-;; header rewrites
-
-(defconst sc-electric-bufname " *sc-erefs* "
-  "Supercite electric reference mode's buffer name.")
-(defvar sc-eref-style 0
-  "Current electric reference style.")
-
-(defun sc-valid-index-p (index)
-  "Returns INDEX if it is a valid index into `sc-rewrite-header-list'.
-Otherwise returns nil."
-    ;; a number, and greater than or equal to zero
-    ;; less than or equal to the last index
-    (and (natnump index)
-	 (< index (length sc-rewrite-header-list))
-	 index))
-
-(defun sc-eref-insert-selected (&optional nomsg)
-  "Insert the selected reference header in the current buffer.
-Optional NOMSG, if non-nil, inhibits printing messages, unless an
-error occurs."
-  (let ((ref (nth sc-eref-style sc-rewrite-header-list)))
-    (condition-case err
-	(progn
-	  (eval ref)
-	  (let ((lines (count-lines (point-min) (point-max))))
-	    (or nomsg (message "Ref header %d [%d line%s]: %s" 
-			       sc-eref-style lines
-			       (if (= lines 1) "" "s")
-			       ref))))
-      (void-function
-       (progn (message
-	       "Symbol's function definition is void: %s (Header %d)"
-	       (car (cdr err)) sc-eref-style)
-	      (beep)
-	      ))
-      )))
-
-(defun sc-electric-mode (&optional arg)
-  "
-Mode for viewing Supercite reference headers.  Commands are:
-\n\\{sc-electric-mode-map}
-
-`sc-electric-mode' is not intended to be run interactively, but rather
-accessed through Supercite's electric reference feature.  See
-`sc-insert-reference' for more details.  Optional ARG is the initial
-header style to use, unless not supplied or invalid, in which case
-`sc-preferred-header-style' is used."
-
-  (let ((info sc-mail-info))
-
-    (setq sc-eref-style
-	  (or (sc-valid-index-p arg)
-	      (sc-valid-index-p sc-preferred-header-style)
-	      0))
-
-    (get-buffer-create sc-electric-bufname)
-    ;; set up buffer and enter command loop
-    (save-excursion
-      (save-window-excursion
-	(pop-to-buffer sc-electric-bufname)
-	(kill-all-local-variables)
-	(let ((sc-mail-info info)
-	      (buffer-read-only t)
-	      (mode-name "SC Electric Refs")
-	      (major-mode 'sc-electric-mode))
-	  (use-local-map sc-electric-mode-map)
-	  (sc-eref-show sc-eref-style)
-	  (run-hooks 'sc-electric-mode-hook)
-	  (recursive-edit)
-	  )))
-
-    (and sc-eref-style
-	 (sc-eref-insert-selected))
-    (kill-buffer sc-electric-bufname)
-    ))
-
-;; functions for electric reference mode
-(defun sc-eref-show (index)
-  "Show reference INDEX in `sc-rewrite-header-list'."
-  (let ((msg "No %ing reference headers in list.")
-	(last (length sc-rewrite-header-list)))
-    (setq sc-eref-style
-	  (cond
-	   ((sc-valid-index-p index) index)
-	   ((< index 0)
-	    (if sc-electric-circular-p
-		(1- last)
-	      (progn (error msg "preced") 0)))
-	   ((>= index last)
-	    (if sc-electric-circular-p
-		0
-	      (progn (error msg "follow") (1- last))))
-	   ))
-    (save-excursion
-     (set-buffer sc-electric-bufname)
-     (let ((buffer-read-only nil))
-       (erase-buffer)
-       (goto-char (point-min))
-       (sc-eref-insert-selected)
-       ;; now shrink the window to just contain the electric reference
-       ;; header.
-       (let ((hdrlines (count-lines (point-min) (point-max)))
-	     (winlines (1- (window-height))))
-	 (if (/= hdrlines winlines)
-	     (if (> hdrlines winlines)
-		 ;; we have to enlarge the window
-		 (enlarge-window (- hdrlines winlines))
-	       ;; we have to shrink the window
-	       (shrink-window (- winlines (max hdrlines window-min-height)))
-	       )))
-       ))))
-
-(defun sc-eref-next ()
-  "Display next reference in other buffer."
-  (interactive)
-  (sc-eref-show (1+ sc-eref-style)))
-
-(defun sc-eref-prev ()
-  "Display previous reference in other buffer."
-  (interactive)
-  (sc-eref-show (1- sc-eref-style)))
-
-(defun sc-eref-setn ()
-  "Set reference header selected as preferred."
-  (interactive)
-  (setq sc-preferred-header-style sc-eref-style)
-  (message "Preferred reference style set to header %d." sc-eref-style))
-
-(defun sc-eref-goto (refnum)
-  "Show reference style indexed by REFNUM.
-If REFNUM is an invalid index, don't go to that reference and return
-nil."
-  (interactive "NGoto Reference: ")
-  (if (sc-valid-index-p refnum)
-      (sc-eref-show refnum)
-    (error "Invalid reference: %d. (Range: [%d .. %d])"
-	   refnum 0 (1- (length sc-rewrite-header-list)))
-    ))
-
-(defun sc-eref-jump ()
-  "Set reference header to preferred header."
-  (interactive)
-  (sc-eref-show sc-preferred-header-style))
-
-(defun sc-eref-abort ()
-  "Exit from electric reference mode without inserting reference."
-  (interactive)
-  (setq sc-eref-style nil)
-  (exit-recursive-edit))
-
-(defun sc-eref-exit ()
-  "Exit from electric reference mode and insert selected reference."
-  (interactive)
-  (exit-recursive-edit))
-
-(defun sc-insert-reference (arg)
-  "Insert, at point, a reference header in the body of the reply.
-Numeric ARG indicates which header style from `sc-rewrite-header-list'
-to use when rewriting the header.  No supplied ARG indicates use of
-`sc-preferred-header-style'.
-
-With just `\\[universal-argument]', electric reference insert mode is
-entered, regardless of the value of `sc-electric-references-p'.  See
-`sc-electric-mode' for more information."
-  (interactive "P")
-  (if (consp arg)
-      (sc-electric-mode)
-    (let ((preference (or (sc-valid-index-p arg)
-			  (sc-valid-index-p sc-preferred-header-style)
-			  sc-preferred-header-style
-			  0)))
-      (if sc-electric-references-p
-	  (sc-electric-mode preference)
-	(sc-eref-insert-selected t)
-	))))
-
-
-;; ======================================================================
-;; variable toggling
-
-(defun sc-raw-mode-toggle ()
-  "Toggle, in one fell swoop, two important SC variables:
-`sc-fixup-whitespace-p' and `sc-auto-fill-region-p'"
-  (interactive)
-  (setq sc-fixup-whitespace-p (not sc-fixup-whitespace-p)
-	sc-auto-fill-region-p (not sc-auto-fill-region-p))
-  (sc-set-mode-string)
-  (force-mode-line-update))
-
-(defun sc-toggle-var (variable)
-  "Boolean toggle VARIABLE's value.
-VARIABLE must be a bound symbol.  Nil values change to t, non-nil
-values are changed to nil."
-  (message "%s changed from %s to %s"
-	   variable (symbol-value variable)
-	   (set-variable variable (not (eval-expression variable))))
-  (sc-set-mode-string))
-
-(defun sc-set-variable (var)
-  "Set the Supercite VARIABLE.
-This function mimics `set-variable', except that the variable to set
-is determined non-interactively.  The value is queried for in the
-minibuffer exactly the same way that `set-variable' does it.
-
-You can see the current value of the variable when the minibuffer is
-querying you by typing `C-h'.  Note that the format is changed
-slightly from that used by `set-variable' -- the current value is
-printed just after the variable's name instead of at the bottom of the
-help window."
-  (let* ((minibuffer-help-form
-	  '(funcall myhelp))
-	 (myhelp
-	  (function
-	   (lambda ()
-	     (with-output-to-temp-buffer "*Help*"
-	       (prin1 var)
-	       (if (boundp var)
-		   (let ((print-length 20))
-		     (princ "\t(Current value: ")
-		     (prin1 (symbol-value var))
-		     (princ ")")))
-	       (princ "\n\nDocumentation:\n")
-	       (princ (substring (documentation-property
-				  var
-				  'variable-documentation)
-				  1))
-	       (save-excursion
-		 (set-buffer standard-output)
-		 (help-mode))
-	       nil)))))
-    (set var (eval-minibuffer (format "Set %s to value: " var))))
-  (sc-set-mode-string))
-
-(defmacro sc-toggle-symbol (rootname)
-  (list 'defun (intern (concat "sc-T-" rootname)) '()
-	(list 'interactive)
-	(list 'sc-toggle-var
-	      (list 'quote (intern (concat "sc-" rootname "-p"))))))
-
-(defmacro sc-setvar-symbol (rootname)
-  (list 'defun (intern (concat "sc-S-" rootname)) '()
-	(list 'interactive)
-	(list 'sc-set-variable
-	      (list 'quote (intern (concat "sc-" rootname))))))
-
-(sc-toggle-symbol "confirm-always")
-(sc-toggle-symbol "downcase")
-(sc-toggle-symbol "electric-references")
-(sc-toggle-symbol "auto-fill-region")
-(sc-toggle-symbol "mail-nuke-blank-lines")
-(sc-toggle-symbol "nested-citation")
-(sc-toggle-symbol "electric-circular")
-(sc-toggle-symbol "use-only-preferences")
-(sc-toggle-symbol "fixup-whitespace")
-
-(sc-setvar-symbol "preferred-attribution-list")
-(sc-setvar-symbol "preferred-header-style")
-(sc-setvar-symbol "mail-nuke-mail-headers")
-(sc-setvar-symbol "mail-header-nuke-list")
-(sc-setvar-symbol "cite-region-limit")
-
-(defun sc-T-describe ()
-  "
-
-Supercite provides a number of key bindings which simplify the process
-of setting or toggling certain variables controlling its operation.
-
-Note on function names in this list: all functions of the form
-`sc-S-<name>' actually call `sc-set-variable' on the corresponding
-`sc-<name>' variable.  All functions of the form `sc-T-<name>' call
-`sc-toggle-var' on the corresponding `sc-<name>-p' variable.
-
-\\{sc-T-keymap}"
-  (interactive)
-  (describe-function 'sc-T-describe))
-
-(defun sc-set-mode-string ()
-  "Update the minor mode string to show state of Supercite."
-  (setq sc-mode-string
-	(concat " SC"
-		(if (or sc-auto-fill-region-p
-			sc-fixup-whitespace-p)
-		    ":" "")
-		(if sc-auto-fill-region-p "f" "")
-		(if sc-fixup-whitespace-p "w" "")
-		)))
-
-
-;; ======================================================================
-;; published interface to mail and news readers
-
-;;;###autoload
-(defun sc-cite-original ()
-  "Workhorse citing function which performs the initial citation.
-This is callable from the various mail and news readers' reply
-function according to the agreed upon standard.  See `\\[sc-describe]'
-for more details.  `sc-cite-original' does not do any yanking of the
-original message but it does require a few things:
-
-     1) The reply buffer is the current buffer.
-
-     2) The original message has been yanked and inserted into the
-        reply buffer.
-
-     3) Verbose mail headers from the original message have been
-        inserted into the reply buffer directly before the text of the
-        original message.
-
-     4) Point is at the beginning of the verbose headers.
-
-     5) Mark is at the end of the body of text to be cited.
-
-For Emacs 19's, the region need not be active (and typically isn't
-when this function is called.  Also, the hook `sc-pre-hook' is run
-before, and `sc-post-hook' is run after the guts of this function."
-  (run-hooks 'sc-pre-hook)
-
-  ;; before we do anything, we want to insert the supercite keymap so
-  ;; we can proceed from here
-  (and sc-mode-map-prefix
-       (local-set-key sc-mode-map-prefix sc-mode-map))
-
-  ;; hack onto the minor mode alist, if it hasn't been done before,
-  ;; then turn on the minor mode. also, set the minor mode string with
-  ;; the values of fill and fixup whitespace variables
-  (if (not (get 'minor-mode-alist 'sc-minor-mode))
-      (progn
-	(put 'minor-mode-alist 'sc-minor-mode 'sc-minor-mode)
-	(setq minor-mode-alist
-	      (cons '(sc-minor-mode sc-mode-string) minor-mode-alist))
-	))
-  (setq sc-minor-mode t)
-  (sc-set-mode-string)
-
-  (undo-boundary)
-
-  ;; grab point and mark since the region is probably not active when
-  ;; this function gets automatically called. we want point to be a
-  ;; mark so any deleting before point works properly
-  (let* ((zmacs-regions nil)		; for Lemacs
-	 (mark-active t)		; for FSFmacs
-	 (point (point-marker))
-	 (mark  (copy-marker (mark-marker))))
-  
-    ;; make sure point comes before mark, not all functions are
-    ;; interactive "r"
-    (if (< mark point)
-	(let ((tmp point))
-	  (setq point mark
-		mark tmp)))
-
-    ;; first process mail headers, and populate sc-mail-info
-    (sc-mail-process-headers point mark)
-
-    ;; now get possible attributions
-    (sc-attribs-chop-address (or (sc-mail-field "from")
-				 (sc-mail-field "reply")
-				 (sc-mail-field "reply-to")
-				 (sc-mail-field "sender")))
-    ;; select the attribution
-    (sc-select-attribution)
-
-    ;; cite the region, but first check the value of sc-cite-region-limit
-    (let ((linecnt (count-lines point mark)))
-      (and sc-cite-region-limit
-	   (if (or (not (numberp sc-cite-region-limit))
-		   (<= linecnt sc-cite-region-limit))
-	       (progn
-		 ;; cite the region and insert the header rewrite
-		 (sc-cite-region point mark)
-		 (goto-char point)
-		 (let ((sc-eref-style (or sc-preferred-header-style 0)))
-		   (if sc-electric-references-p
-		       (sc-electric-mode sc-eref-style)
-		     (sc-eref-insert-selected t))))
-	     (beep)
-	     (message
-	      "Region not cited. %d lines exceeds sc-cite-region-limit: %d"
-	      linecnt sc-cite-region-limit))))
-
-    ;; finally, free the point-marker
-    (set-marker point nil)
-    (set-marker mark nil)
-    )
-  (run-hooks 'sc-post-hook)
-  ;; post hook could have changed the variables
-  (sc-set-mode-string))
-
-
-;; ======================================================================
-;; bug reporting and miscellaneous commands
-
-(defun sc-open-line (arg)
-  "Like `open-line', but insert the citation prefix at the front of the line.
-With numeric ARG, inserts that many new lines."
-  (interactive "p")
-  (save-excursion
-    (let ((start (point))
-	  (prefix (or (progn (beginning-of-line)
-			     (if (looking-at (sc-cite-regexp))
-				 (sc-submatch 0)))
-		      "")))
-      (goto-char start)
-      (open-line arg)
-      (forward-line 1)
-      (while (< 0 arg)
-	(insert prefix)
-	(forward-line 1)
-	(setq arg (1- arg))
-	))))
-
-(defun sc-insert-citation (arg)
-  "Insert citation string at beginning of current line if not already cited.
-With `\\[universal-argument]' insert citation even if line is already
-cited."
-  (interactive "P")
-  (save-excursion
-    (beginning-of-line)
-    (if (or (not (looking-at (sc-cite-regexp)))
-	    (looking-at "^[ \t]*$")
-	    (consp arg))
-	(insert (sc-mail-field "sc-citation"))
-      (error "Line is already cited."))))
-
-(defun sc-version (arg)
-  "Echo the current version of Supercite in the minibuffer.
-With \\[universal-argument] (universal-argument), or if run non-interactively,
-inserts the version string in the current buffer instead."
-  (interactive "P")
-  (let ((verstr (format "Using Supercite.el %s" sc-version)))
-    (if (or (consp arg)
-	    (not (interactive-p)))
-	(insert "`sc-version' says: " verstr)
-      (message verstr))))
-
-(defun sc-describe ()
-  "
-Supercite is a package which provides a flexible mechanism for citing
-email and news replies.  Please see the associated texinfo file for
-more information."
-  (interactive)
-  (describe-function 'sc-describe))
-
-(defun sc-submit-bug-report ()
-  "Submit a bug report on Supercite via mail."
-  (interactive)
-  (require 'reporter)
-  (and
-   (y-or-n-p "Do you want to submit a report on Supercite? ")
-   (reporter-submit-bug-report
-    sc-help-address
-    (concat "Supercite version " sc-version)
-    (list
-     'sc-attrib-selection-list
-     'sc-auto-fill-region-p
-     'sc-blank-lines-after-headers
-     'sc-citation-leader
-     'sc-citation-delimiter
-     'sc-citation-separator
-     'sc-citation-leader-regexp
-     'sc-citation-root-regexp
-     'sc-citation-nonnested-root-regexp
-     'sc-citation-delimiter-regexp
-     'sc-citation-separator-regexp
-     'sc-cite-region-limit
-     'sc-confirm-always-p
-     'sc-default-attribution
-     'sc-default-author-name
-     'sc-downcase-p
-     'sc-electric-circular-p
-     'sc-electric-references-p
-     'sc-fixup-whitespace-p
-     'sc-mail-warn-if-non-rfc822-p
-     'sc-mumble
-     'sc-name-filter-alist
-     'sc-nested-citation-p
-     'sc-nuke-mail-headers
-     'sc-nuke-mail-header-list
-     'sc-preferred-attribution-list
-     'sc-preferred-header-style
-     'sc-reference-tag-string
-     'sc-rewrite-header-list
-     'sc-titlecue-regexp
-     'sc-use-only-preference-p
-     ))))
-
-
-;; useful stuff
-(provide 'supercite)
-(run-hooks 'sc-load-hook)
-
-;;; supercite.el ends here
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
deleted file mode 100644
index 3a3319ec1b5..00000000000
--- a/lisp/mail/undigest.el
+++ /dev/null
@@ -1,184 +0,0 @@
-;;; undigest.el --- digest-cracking support for the RMAIL mail reader
-
-;; Copyright (C) 1985, 1986, 1994, 1996 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: mail
-
-;; 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:
-
-;; See Internet RFC 934
-
-;;; Code:
-
-(require 'rmail)
-
-;;;###autoload
-(defun undigestify-rmail-message ()
-  "Break up a digest message into its constituent messages.
-Leaves original message, deleted, before the undigestified messages."
-  (interactive)
-  (widen)
-  (let ((buffer-read-only nil)
-	(msg-string (buffer-substring (rmail-msgbeg rmail-current-message)
-				      (rmail-msgend rmail-current-message))))
-    (goto-char (rmail-msgend rmail-current-message))
-    (narrow-to-region (point) (point))
-    (insert msg-string)
-    (narrow-to-region (point-min) (1- (point-max))))
-  (let ((error t)
-	(buffer-read-only nil))
-    (unwind-protect
-	(progn
-	  (save-restriction
-	    (goto-char (point-min))
-	    (delete-region (point-min)
-			   (progn (search-forward "\n*** EOOH ***\n")
-				  (point)))
-	    (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
-	    (narrow-to-region (point)
-			      (point-max))
-	    (let* ((fill-prefix "")
-		   (case-fold-search t)
-		   start
-		   (digest-name
-		    (mail-strip-quoted-names
-		     (or (save-restriction
-			   (search-forward "\n\n")
-			   (setq start (point))
-			   (narrow-to-region (point-min) (point))
-			   (goto-char (point-max))
-			   (or (mail-fetch-field "Reply-To")
-			       (mail-fetch-field "To")
-			       (mail-fetch-field "Apparently-To")
-			       (mail-fetch-field "From")))
-			 (error "Message is not a digest--bad header")))))
-	      (save-excursion
-		(goto-char (point-max))
-		(skip-chars-backward " \t\n")
-		(let (found)
-		  ;; compensate for broken un*x digestifiers.  Sigh Sigh.
-		  (while (and (> (point) start) (not found))
-		    (forward-line -1)
-		    (if (looking-at (concat "End of.*Digest.*\n"
-					    (regexp-quote "*********") "*"
-					    "\\(\n------*\\)*"))
-			(setq found t)))
-		  (if (not found)
-		      (error "Message is not a digest--no end line"))))
-	      (re-search-forward (concat "^" (make-string 55 ?-) "-*\n*"))
-	      (replace-match "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
-	      (save-restriction
-		(narrow-to-region (point)
-				  (progn (search-forward "\n\n")
-					 (point)))
-		(if (mail-fetch-field "To") nil
-		  (goto-char (point-min))
-		  (insert "To: " digest-name "\n")))
-	      (while (re-search-forward
-		      (concat "\n\n" (make-string 27 ?-) "-*\n*")
-		      nil t)
-		(replace-match "\n\n\^_\^L\n0, unseen,,\n*** EOOH ***\n")
-		(save-restriction
-		  (if (looking-at "End ")
-		      (insert "To: " digest-name "\n\n")
-		    (narrow-to-region (point)
-				      (progn (search-forward "\n\n"
-							     nil 'move)
-					     (point))))
-		  (if (mail-fetch-field "To")
-		      nil
-		    (goto-char (point-min))
-		    (insert "To: " digest-name "\n")))
-		;; Digestifiers may insert `- ' on lines that start with `-'.
-		;; Undo that.
-		(save-excursion
-		  (goto-char (point-min))
-		  (if (re-search-forward
-		       "\n\n----------------------------*\n*"
-		       nil t)
-		      (let ((end (point-marker)))
-			(goto-char (point-min))
-			(while (re-search-forward "^- " end t)
-			  (delete-char -2)))))
-		)))
-	  (setq error nil)
-	  (message "Message successfully undigestified")
-	  (let ((n rmail-current-message))
-	    (rmail-forget-messages)
-	    (rmail-show-message n)
-	    (rmail-delete-forward)
-	    (if (rmail-summary-exists)
-		(rmail-select-summary
-		 (rmail-update-summary)))))
-      (cond (error
-	     (narrow-to-region (point-min) (1+ (point-max)))
-	     (delete-region (point-min) (point-max))
-	     (rmail-show-message rmail-current-message))))))
-
-;;;###autoload
-(defun unforward-rmail-message ()
-  "Extract a forwarded message from the containing message.
-This puts the forwarded message into a separate rmail message
-following the containing message."
-  (interactive)
-  ;; Don't use save-excursion because we don't want to restore point
-  ;; in the case where we do not switch buffers.
-  (let ((obuf (current-buffer)))
-    (unwind-protect
-	(progn
-	  ;; If we are in a summary buffer, switch to the Rmail buffer.
-	  (if (local-variable-p 'rmail-buffer)
-	      (set-buffer rmail-buffer))
-	  (narrow-to-region (rmail-msgbeg rmail-current-message)
-			    (rmail-msgend rmail-current-message))
-	  (goto-char (point-min))
-	  (let (beg end (buffer-read-only nil) msg-string who-forwarded-it)
-	    (setq who-forwarded-it (mail-fetch-field "From"))
-	    (if (re-search-forward "^----" nil t)
-		nil
-	      (error "No forwarded message"))
-	    (forward-line 1)
-	    (setq beg (point))
-	    (if (re-search-forward "^----" nil t)
-		(setq end (match-beginning 0))
-	      (error "No terminator for forwarded message"))
-	    (widen)
-	    (setq msg-string (buffer-substring beg end))
-	    (goto-char (rmail-msgend rmail-current-message))
-	    (narrow-to-region (point) (point))
-	    (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
-	    (narrow-to-region (point) (point))
-	    (insert "Forwarded-by: " who-forwarded-it "\n")
-	    (insert msg-string)
-	    (goto-char (point-min))
-	    (while (not (eobp))
-	      (if (looking-at "- ")
-		  (delete-region (point) (+ 2 (point))))
-	      (forward-line 1))
-	    (let ((n rmail-current-message))
-	      (rmail-forget-messages)
-	      (rmail-show-message n)
-	      (if (rmail-summary-exists)
-		  (rmail-select-summary
-		   (rmail-update-summary))))))
-      (set-buffer obuf))))
-
-;;; undigest.el ends here
diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
deleted file mode 100644
index 05fe04899af..00000000000
--- a/lisp/mail/unrmail.el
+++ /dev/null
@@ -1,66 +0,0 @@
-;;; unrmail.el --- convert Rmail files to mailbox files.
-
-;;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Keywords: mail
-
-;; 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.
-
-;;; Code:
-
-(defvar command-line-args-left)	;Avoid 'free variable' warning
-
-;;;###autoload
-(defun batch-unrmail ()
-  "Convert Rmail files to system inbox format.
-Specify the input Rmail file names as command line arguments.
-For each Rmail file, the corresponding output file name
-is made by adding `.mail' at the end.
-For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
-  ;; command-line-args-left is what is left of the command line (from startup.el)
-  (if (not noninteractive)
-      (error "`batch-unrmail' is to be used only with -batch"))
-  (let ((error nil))
-    (while command-line-args-left
-      (or (unrmail (car command-line-args-left)
-		   (concat (car command-line-args-left) ".mail"))
-	  (setq error t))
-      (setq command-line-args-left (cdr command-line-args-left)))
-    (message "Done")
-    (kill-emacs (if error 1 0))))
-
-;;;###autoload
-(defun unrmail (file to-file)
-  "Convert Rmail file FILE to system inbox format file TO-FILE."
-  (interactive "fUnrmail (rmail file): \nFUnrmail into (new mailbox file): ")
-  (let ((message-count 0)
-	;; Prevent rmail from making, or switching to, a summary buffer.
-	(rmail-display-summary nil)
-	(rmail-delete-after-output nil))
-    (rmail file)
-    ;; Default the directory of TO-FILE based on where FILE is.
-    (setq to-file (expand-file-name to-file default-directory))
-    (message "Writing messages to %s..." to-file)
-    (while (< message-count rmail-total-messages)
-      (rmail-show-message
-       (setq message-count (1+ message-count)))
-      (rmail-toggle-header)
-      (rmail-output to-file 1 t))
-    (message "Writing messages to %s...done" to-file)))
-
-;;; unrmail.el ends here
diff --git a/lisp/mail/vms-pmail.el b/lisp/mail/vms-pmail.el
deleted file mode 100644
index 3dd2d664e76..00000000000
--- a/lisp/mail/vms-pmail.el
+++ /dev/null
@@ -1,117 +0,0 @@
-;;; vms-pmail.el --- use Emacs as the editor within VMS mail.
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Roland B Roberts <roberts@nsrl31.nsrl.rochester.edu>
-;; Keywords: vms
-
-;; 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.
-
-;;; Code:
-
-;;;
-;;; Quick hack to use emacs as mail editor.  There are a *bunch* of
-;;; changes scattered throughout emacs to make this work, namely:
-;;; (1) mod to sysdep.c to allow emacs to attach to a process other
-;;;     than the one that originally spawned it.
-;;; (2) mod to kepteditor.com to define the logical emacs_parent_pid
-;;;     which is what sysdep.c looks for, and define the logical
-;;;     emacs_command_args which contains the command line
-;;; (3) mod to re-parse command line arguments from emacs_command_args
-;;;     then execute them as though emacs were just starting up.
-;;;
-(defun vms-pmail-save-and-exit ()
-  "Save current buffer and exit emacs.
-If this emacs cannot be suspended, you will be prompted about modified
-buffers other than the mail buffer.  BEWARE --- suspending emacs without
-saving your mail buffer causes mail to abort the send (potentially useful
-since the mail buffer is still here)."
-  (interactive)
-  (basic-save-buffer)
-  (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS")
-      (progn
-        (save-some-buffers)
-        (kill-emacs 1))
-    (kill-buffer (current-buffer))
-    (suspend-emacs)))
-
-(defun vms-pmail-abort ()
-  "Mark buffer as unmodified and exit emacs.
-When the editor is exited without saving its buffer, VMS mail does not
-send a message.  If you have other modified buffers you will be
-prompted for what to do with them."
-  (interactive)
-  (if (not (yes-or-no-p "Really abort mail? "))
-      (ding)
-    (not-modified)
-    (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS")
-        (progn
-          (save-some-buffers)
-          (kill-emacs 1))
-      (kill-buffer (current-buffer))
-      (suspend-emacs))))
-
-(defun vms-pmail-setup ()
-  "Set up file assuming use by VMS MAIL utility.
-The buffer is put into text-mode, auto-save is turned off and the
-following bindings are established.
-
-\\[vms-pmail-save-and-exit]	vms-pmail-save-and-exit
-\\[vms-pmail-abort]	vms-pmail-abort
-
-All other emacs commands are still available."
-  (interactive)
-  (auto-save-mode -1)
-  (text-mode)
-  (let ((default (vms-system-info "LOGICAL" "SYS$SCRATCH"))
-        (directory (file-name-directory (buffer-file-name)))
-        (filename (file-name-nondirectory (buffer-file-name))))
-    (if (string= directory "SYS$SCRATCH:")
-        (progn
-          (cd default)
-          (setq buffer-file-name (concat default filename))))
-    (use-local-map (copy-keymap (current-local-map)))
-    (local-set-key "\C-c\C-c" 'vms-pmail-save-and-exit)
-    (local-set-key "\C-c\C-g" 'vms-pmail-abort)))
-
-(defun indicate-mail-reply-text ()
-  "Prepares received mail for re-sending by placing >'s on each line."
-  (interactive)
-  (goto-char (point-min))
-  (while (not (eobp))
-    (insert ">")
-    (beginning-of-line)
-    (forward-line 1))
-  (set-buffer-modified-p nil)
-  (goto-char (point-min)))
-
-(defun insert-signature ()
-  "Moves to the end of the buffer and inserts a \"signature\" file.
-First try the file indicated by environment variable MAIL$TRAILER.
-If that fails, try the file \"~/.signature\".
-If neither file exists, fails quietly."
-  (interactive)
-  (end-of-buffer)
-  (newline)
-  (if (vms-system-info "LOGICAL" "MAIL$TRAILER")
-      (if (file-attributes (vms-system-info "LOGICAL" "MAIL$TRAILER"))
-	  (insert-file-contents (vms-system-info "LOGICAL" "MAIL$TRAILER"))
-	(if (file-attributes "~/.signature")
-	    (insert-file-contents "~/.signature")))))
-
-;;; vms-pmail.el ends here
diff --git a/lisp/makefile.nt b/lisp/makefile.nt
deleted file mode 100644
index 67699fecf3f..00000000000
--- a/lisp/makefile.nt
+++ /dev/null
@@ -1,42 +0,0 @@
-#  Hacked up Nmake makefile for GNU Emacs
-#   Geoff Voelker (voelker@cs.washington.edu)
-#  Copyright (c) 1994 Free Software Foundation, Inc.
-#
-#  This file is part of GNU Emacs.
-#  
-#  GNU Emacs is free software; you can redistribute it and/or modify
-#  it under the terms of the GNU General Public License as published by
-#  the Free Software Foundation; either version 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.
-#
-
-!include ..\nt\makefile.def
-
-all:
-
-#
-# Assuming INSTALL_DIR is defined, copy the elisp files to it
-#
-install:;	- mkdir $(INSTALL_DIR)\lisp
-		- $(DEL) .\same-dir.tst
-		- $(DEL) $(INSTALL_DIR)\lisp\same-dir.tst
-		echo SameDirTest > $(INSTALL_DIR)\lisp\same-dir.tst
-		if not exist .\same-dir.tst $(CP_DIR) . $(INSTALL_DIR)\lisp
-		- $(DEL) $(INSTALL_DIR)\lisp\same-dir.tst
-		
-
-#
-# Maintenance
-# 
-clean:;		- $(DEL) *~
-		- $(DEL_TREE) deleted
diff --git a/lisp/makesum.el b/lisp/makesum.el
deleted file mode 100644
index 9664513e004..00000000000
--- a/lisp/makesum.el
+++ /dev/null
@@ -1,114 +0,0 @@
-;;; makesum.el --- generate key binding summary for Emacs
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: help
-
-;; 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:
-
-;; Displays a nice human-readable summary of all keybindings in a
-;; two-column format.
-
-;;; Code:
-
-;;;###autoload
-(defun make-command-summary ()
-  "Make a summary of current key bindings in the buffer *Summary*.
-Previous contents of that buffer are killed first."
-  (interactive)
-  (message "Making command summary...")
-  ;; This puts a description of bindings in a buffer called *Help*.
-  (save-window-excursion
-   (describe-bindings))
-  (with-output-to-temp-buffer "*Summary*"
-    (save-excursion
-     (let ((cur-mode mode-name))
-       (set-buffer standard-output)
-       (erase-buffer)
-       (insert-buffer-substring "*Help*")
-       (goto-char (point-min))
-       (delete-region (point) (progn (forward-line 1) (point)))
-       (while (search-forward "         " nil t)
-	 (replace-match "  "))
-       (goto-char (point-min))
-       (while (search-forward "-@ " nil t)
-	 (replace-match "-SP"))
-       (goto-char (point-min))
-       (while (search-forward "  .. ~ " nil t)
-	 (replace-match "SP .. ~"))
-       (goto-char (point-min))
-       (while (search-forward "C-?" nil t)
-	 (replace-match "DEL"))
-       (goto-char (point-min))
-       (while (search-forward "C-i" nil t)
-	 (replace-match "TAB"))
-       (goto-char (point-min))
-       (if (re-search-forward "^Local Bindings:" nil t)
-	   (progn
-	    (forward-char -1)
-	    (insert " for " cur-mode " Mode")
-	    (while (search-forward "??\n" nil t)
-	      (delete-region (point)
-			     (progn
-			      (forward-line -1)
-			      (point))))))
-       (goto-char (point-min))
-       (insert "Emacs command summary, " (substring (current-time-string) 0 10)
-	       ".\n")
-       ;; Delete "key    binding" and underlining of dashes.
-       (delete-region (point) (progn (forward-line 2) (point)))
-       (forward-line 1)			;Skip blank line
-       (while (not (eobp))
-	 (let ((beg (point)))
-	   (or (re-search-forward "^$" nil t)
-	       (goto-char (point-max)))
-	   (double-column beg (point))
-	   (forward-line 1)))
-       (goto-char (point-min)))))
-  (message "Making command summary...done"))
-
-(defun double-column (start end)
-  (interactive "r")
-  (let (half cnt
-        line lines nlines
-	(from-end (- (point-max) end)))
-    (setq nlines (count-lines start end))
-    (if (<= nlines 1)
-	nil
-      (setq half (/ (1+ nlines) 2))
-      (goto-char start)
-      (save-excursion
-       (forward-line half)
-       (while (< half nlines)
-	 (setq half (1+ half))
-	 (setq line (buffer-substring (point) (save-excursion (end-of-line) (point))))
-	 (setq lines (cons line lines))
-	 (delete-region (point) (progn (forward-line 1) (point)))))
-      (setq lines (nreverse lines))
-      (while lines
-	(end-of-line)
-	(indent-to 41)
-	(insert (car lines))
-	(forward-line 1)
-	(setq lines (cdr lines))))
-    (goto-char (- (point-max) from-end))))
-
-;;; makesum.el ends here
diff --git a/lisp/man.el b/lisp/man.el
deleted file mode 100644
index ac535f0deca..00000000000
--- a/lisp/man.el
+++ /dev/null
@@ -1,1062 +0,0 @@
-;;; man.el --- browse UNIX manual pages
-
-;; Copyright (C) 1993, 1994, 1996 Free Software Foundation, Inc.
-
-;; Author:		Barry A. Warsaw <bwarsaw@cen.com>
-;; Keywords:		help
-;; Adapted-By:		ESR, pot
-
-;; 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 code provides a function, `man', with which you can browse
-;; UNIX manual pages.  Formatting is done in background so that you
-;; can continue to use your Emacs while processing is going on.
-;;
-;; The mode also supports hypertext-like following of manual page SEE
-;; ALSO references, and other features.  See below or do `?' in a
-;; manual page buffer for details.
-
-;; ========== Credits and History ========== 
-;; In mid 1991, several people posted some interesting improvements to
-;; man.el from the standard emacs 18.57 distribution.  I liked many of
-;; these, but wanted everything in one single package, so I decided
-;; to incorporate them into a single manual browsing mode.  While
-;; much of the code here has been rewritten, and some features added,
-;; these folks deserve lots of credit for providing the initial
-;; excellent packages on which this one is based.
-
-;; Nick Duffek <duffek@chaos.cs.brandeis.edu>, posted a very nice
-;; improvement which retrieved and cleaned the manpages in a
-;; background process, and which correctly deciphered such options as
-;; man -k.
-
-;; Eric Rose <erose@jessica.stanford.edu>, submitted manual.el which
-;; provided a very nice manual browsing mode.
-
-;; This package was available as `superman.el' from the LCD package
-;; for some time before it was accepted into Emacs 19.  The entry
-;; point and some other names have been changed to make it a drop-in
-;; replacement for the old man.el package.
-
-;; Francesco Potorti` <pot@cnuce.cnr.it> cleaned it up thoroughly,
-;; making it faster, more robust and more tolerant of different
-;; systems' man idiosyncrasies.
-
-;; ========== Features ==========
-;; + Runs "man" in the background and pipes the results through a
-;;   series of sed and awk scripts so that all retrieving and cleaning
-;;   is done in the background. The cleaning commands are configurable.
-;; + Syntax is the same as Un*x man
-;; + Functionality is the same as Un*x man, including "man -k" and
-;;   "man <section>", etc.
-;; + Provides a manual browsing mode with keybindings for traversing
-;;   the sections of a manpage, following references in the SEE ALSO
-;;   section, and more.
-;; + Multiple manpages created with the same man command are put into
-;;   a narrowed buffer circular list.
-
-;; ============= TODO ===========
-;; - Add a command for printing.
-;; - The awk script deletes multiple blank lines.  This behaviour does
-;;   not allow to understand if there was indeed a blank line at the
-;;   end or beginning of a page (after the header, or before the
-;;   footer).  A different algorithm should be used.  It is easy to
-;;   compute how many blank lines there are before and after the page
-;;   headers, and after the page footer.  But it is possible to compute
-;;   the number of blank lines before the page footer by euristhics
-;;   only.  Is it worth doing?
-;; - Allow a user option to mean that all the manpages should go in
-;;   the same buffer, where they can be browsed with M-n and M-p.
-;; - Allow completion on the manpage name when calling man.  This
-;;   requires a reliable list of places where manpages can be found.  The
-;;   drawback would be that if the list is not complete, the user might
-;;   be led to believe that the manpages in the missing directories do
-;;   not exist.
-
-
-;;; Code:
-
-(require 'assoc)
-
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; empty defvars (keep the compiler quiet)
-
-(defvar Man-notify)
-(defvar Man-current-page)
-(defvar Man-page-list)
-(defvar Man-filter-list nil
-  "*Manpage cleaning filter command phrases.
-This variable contains a list of the following form:
-
-'((command-string phrase-string*)*)
-
-Each phrase-string is concatenated onto the command-string to form a
-command filter.  The (standard) output (and standard error) of the Un*x
-man command is piped through each command filter in the order the
-commands appear in the association list.  The final output is placed in
-the manpage buffer.")
-
-(defvar Man-original-frame)
-(defvar Man-arguments)
-(defvar Man-sections-alist)
-(defvar Man-refpages-alist)
-(defvar Man-uses-untabify-flag t
-  "When non-nil use `untabify' instead of Man-untabify-command.")
-(defvar Man-page-mode-string)
-(defvar Man-sed-script nil
-  "Script for sed to nuke backspaces and ANSI codes from manpages.")
-
-;; vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv
-;; user variables
-
-(defvar Man-fontify-manpage-flag t
-  "*Make up the manpage with fonts.")
-
-(defvar Man-overstrike-face 'bold
-  "*Face to use when fontifying overstrike.")
-
-(defvar Man-underline-face 'underline
-  "*Face to use when fontifying underlining.")
-
-;; Use the value of the obsolete user option Man-notify, if set.
-(defvar Man-notify-method (if (boundp 'Man-notify) Man-notify 'friendly)
-  "*Selects the behavior when manpage is ready.
-This variable may have one of the following values, where (sf) means
-that the frames are switched, so the manpage is displayed in the frame
-where the man command was called from:
-
-newframe   -- put the manpage in its own frame (see `Man-frame-parameters')
-pushy      -- make the manpage the current buffer in the current window
-bully      -- make the manpage the current buffer and only window (sf)
-aggressive -- make the manpage the current buffer in the other window (sf)
-friendly   -- display manpage in the other window but don't make current (sf)
-polite     -- don't display manpage, but prints message and beep when ready
-quiet      -- like `polite', but don't beep
-meek       -- make no indication that the manpage is ready
-
-Any other value of `Man-notify-method' is equivalent to `meek'.")
-
-(defvar Man-frame-parameters nil
-  "*Frame parameter list for creating a new frame for a manual page.")
-
-(defvar Man-downcase-section-letters-flag t
-  "*Letters in sections are converted to lower case.
-Some Un*x man commands can't handle uppercase letters in sections, for
-example \"man 2V chmod\", but they are often displayed in the manpage
-with the upper case letter.  When this variable is t, the section
-letter (e.g., \"2V\") is converted to lowercase (e.g., \"2v\") before
-being sent to the man background process.")
-
-(defvar Man-circular-pages-flag t
-  "*If t, the manpage list is treated as circular for traversal.")
-
-(defvar Man-section-translations-alist
-  (list
-   '("3C++" . "3")
-   ;; Some systems have a real 3x man section, so let's comment this.
-   ;; '("3X" . "3")                        ; Xlib man pages
-   '("3X11" . "3")
-   '("1-UCB" . ""))
-  "*Association list of bogus sections to real section numbers.
-Some manpages (e.g. the Sun C++ 2.1 manpages) have section numbers in
-their references which Un*x `man' does not recognize.  This
-association list is used to translate those sections, when found, to
-the associated section number.")
-
-(defvar manual-program "man"
-  "The name of the program that produces man pages.")
-
-(defvar Man-untabify-command "pr"
-  "Command used for untabifying.")
-
-(defvar Man-untabify-command-args (list "-t" "-e")
-  "List of arguments to be passed to Man-untabify-command (which see).")
-
-(defvar Man-sed-command "sed"
-  "Command used for processing sed scripts.")
-
-(defvar Man-awk-command "awk"
-  "Command used for processing awk scripts.")
-
-(defvar Man-mode-line-format
-  '("" mode-line-modified
-       mode-line-buffer-identification "  "
-       global-mode-string
-       " " Man-page-mode-string
-       "  %[(" mode-name mode-line-process minor-mode-alist ")%]----"
-       (-3 . "%p") "-%-")
-  "Mode line format for manual mode buffer.")
-
-(defvar Man-mode-map nil
-  "Keymap for Man mode.")
-
-(defvar Man-mode-hook nil
-  "Hook run when Man mode is enabled.")
-
-(defvar Man-cooked-hook nil
-  "Hook run after removing backspaces but before Man-mode processing.")
-
-(defvar Man-name-regexp "[-a-zA-Z0-9_][-a-zA-Z0-9_.]*"
-  "Regular expression describing the name of a manpage (without section).")
-
-(defvar Man-section-regexp "[0-9][a-zA-Z+]*\\|[LNln]"
-  "Regular expression describing a manpage section within parentheses.")
-
-(defvar Man-page-header-regexp
-  (concat "^[ \t]*\\(" Man-name-regexp
-	  "(\\(" Man-section-regexp "\\))\\).*\\1")
-  "Regular expression describing the heading of a page.")
-
-(defvar Man-heading-regexp "^\\([A-Z][A-Z ]+\\)$"
-  "Regular expression describing a manpage heading entry.")
-
-(defvar Man-see-also-regexp "SEE ALSO"
-  "Regular expression for SEE ALSO heading (or your equivalent).
-This regexp should not start with a `^' character.")
-
-(defvar Man-first-heading-regexp "^[ \t]*NAME$\\|^[ \t]*No manual entry fo.*$"
-  "Regular expression describing first heading on a manpage.
-This regular expression should start with a `^' character.")
-
-(defvar Man-reference-regexp
-  (concat "\\(" Man-name-regexp "\\)(\\(" Man-section-regexp "\\))")
-  "Regular expression describing a reference in the SEE ALSO section.")
-
-(defvar Man-switches ""
-  "Switches passed to the man command, as a single string.")
-
-(defvar Man-specified-section-option
-  (if (string-match "-solaris[0-9.]*$" system-configuration)
-      "-s"
-    "")
-  "Option that indicates a specified a manual section name.")
-
-;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-;; end user variables
-
-;; other variables and keymap initializations
-(make-variable-buffer-local 'Man-sections-alist)
-(make-variable-buffer-local 'Man-refpages-alist)
-(make-variable-buffer-local 'Man-page-list)
-(make-variable-buffer-local 'Man-current-page)
-(make-variable-buffer-local 'Man-page-mode-string)
-(make-variable-buffer-local 'Man-original-frame)
-(make-variable-buffer-local 'Man-arguments)
-
-(setq-default Man-sections-alist nil)
-(setq-default Man-refpages-alist nil)
-(setq-default Man-page-list nil)
-(setq-default Man-current-page 0)
-(setq-default Man-page-mode-string "1 of 1")
-
-(defconst Man-sysv-sed-script "\
-/\b/ {	s/_\b//g
-	s/\b_//g
-        s/o\b+/o/g
-        s/+\bo/o/g
-	:ovstrk
-	s/\\(.\\)\b\\1/\\1/g
-	t ovstrk
-	}
-/\e\\[[0-9][0-9]*m/ s///g"
-  "Script for sysV-like sed to nuke backspaces and ANSI codes from manpages.")
-
-(defconst Man-berkeley-sed-script "\
-/\b/ {	s/_\b//g\\
-	s/\b_//g\\
-        s/o\b+/o/g\\
-        s/+\bo/o/g\\
-	:ovstrk\\
-	s/\\(.\\)\b\\1/\\1/g\\
-	t ovstrk\\
-	}\\
-/\e\\[[0-9][0-9]*m/ s///g"
-  "Script for berkeley-like sed to nuke backspaces and ANSI codes from manpages.")
-
-(if Man-mode-map
-    nil
-  (setq Man-mode-map (make-keymap))
-  (suppress-keymap Man-mode-map)
-  (define-key Man-mode-map " "    'scroll-up)
-  (define-key Man-mode-map "\177" 'scroll-down)
-  (define-key Man-mode-map "n"    'Man-next-section)
-  (define-key Man-mode-map "p"    'Man-previous-section)
-  (define-key Man-mode-map "\en"  'Man-next-manpage)
-  (define-key Man-mode-map "\ep"  'Man-previous-manpage)
-  (define-key Man-mode-map ">"    'end-of-buffer)
-  (define-key Man-mode-map "<"    'beginning-of-buffer)
-  (define-key Man-mode-map "."    'beginning-of-buffer)
-  (define-key Man-mode-map "r"    'Man-follow-manual-reference)
-  (define-key Man-mode-map "g"    'Man-goto-section)
-  (define-key Man-mode-map "s"    'Man-goto-see-also-section)
-  (define-key Man-mode-map "k"    'Man-kill)
-  (define-key Man-mode-map "q"    'Man-quit)
-  (define-key Man-mode-map "m"    'man)
-  (define-key Man-mode-map "?"    'describe-mode)
-  )
-
-
-;; ======================================================================
-;; utilities
-
-(defun Man-init-defvars ()
-  "Used for initialising variables based on the value of window-system.
-This is necessary if one wants to dump man.el with emacs."
-
-  ;; The following is necessary until fonts are implemented on
-  ;; terminals.
-  (setq Man-fontify-manpage-flag (and Man-fontify-manpage-flag
-				      window-system))
-
-  (setq Man-sed-script
-	(cond
-	 (Man-fontify-manpage-flag
-	  nil)
-	 ((= 0 (call-process Man-sed-command nil nil nil Man-sysv-sed-script))
-	  Man-sysv-sed-script)
-	 ((= 0 (call-process Man-sed-command nil nil nil Man-berkeley-sed-script))
-	  Man-berkeley-sed-script)
-	 (t
-	  nil)))
-
-  (setq Man-filter-list
-	(list
-	 (cons
-	  Man-sed-command
-	  (list
-	   (if Man-sed-script
-	       (concat "-e '" Man-sed-script "'")
-	     "")
-	   "-e '/^[\001-\032][\001-\032]*$/d'"
-	   "-e '/\e[789]/s///g'"
-	   "-e '/Reformatting page.  Wait/d'"
-	   "-e '/Reformatting entry.  Wait/d'"
-	   "-e '/^[ \t]*Hewlett-Packard[ \t]Company[ \t]*-[ \t][0-9]*[ \t]-/d'"
-	   "-e '/^[ \t]*Hewlett-Packard[ \t]*-[ \t][0-9]*[ \t]-.*$/d'"
-	   "-e '/^[ \t][ \t]*-[ \t][0-9]*[ \t]-[ \t]*Formatted:.*[0-9]$/d'"
-	   "-e '/^[ \t]*Page[ \t][0-9]*.*(printed[ \t][0-9\\/]*)$/d'"
-	   "-e '/^Printed[ \t][0-9].*[0-9]$/d'"
-	   "-e '/^[ \t]*X[ \t]Version[ \t]1[01].*Release[ \t][0-9]/d'"
-	   "-e '/^[A-za-z].*Last[ \t]change:/d'"
-	   "-e '/^Sun[ \t]Release[ \t][0-9].*[0-9]$/d'"
-	   "-e '/[ \t]*Copyright [0-9]* UNIX System Laboratories, Inc.$/d'"
-	   "-e '/^[ \t]*Rev\\..*Page [0-9][0-9]*$/d'"
-	   ))
-	 (cons
-	  Man-awk-command
-	  (list
-	   "'\n"
-	   "BEGIN { blankline=0; anonblank=0; }\n"
-	   "/^$/ { if (anonblank==0) next; }\n"
-	   "{ anonblank=1; }\n"
-	   "/^$/ { blankline++; next; }\n"
-	   "{ if (blankline>0) { print \"\"; blankline=0; } print $0; }\n"
-	   "'"
-	   ))
-	 (if (not Man-uses-untabify-flag)
-	     (cons
-	      Man-untabify-command
-	      Man-untabify-command-args)
-	   )))
-)
-
-(defsubst Man-match-substring (&optional n string)
-  "Return the substring matched by the last search.
-Optional arg N means return the substring matched by the Nth paren
-grouping.  Optional second arg STRING means return a substring from
-that string instead of from the current buffer."
-  (if (null n) (setq n 0))
-  (if string
-      (substring string (match-beginning n) (match-end n))
-    (buffer-substring (match-beginning n) (match-end n))))
-
-(defsubst Man-make-page-mode-string ()
-  "Formats part of the mode line for Man mode."
-  (format "%s page %d of %d"
-	  (or (nth 2 (nth (1- Man-current-page) Man-page-list))
-	      "")
-	  Man-current-page
-	  (length Man-page-list)))
-
-(defsubst Man-build-man-command ()
-  "Builds the entire background manpage and cleaning command."
-  (let ((command (concat manual-program " " Man-switches " %s 2>/dev/null"))
-	(flist Man-filter-list))
-    (while (and flist (car flist))
-      (let ((pcom (car (car flist)))
-	    (pargs (cdr (car flist))))
-	(setq command
-	      (concat command " | " pcom " "
-		      (mapconcat '(lambda (phrase)
-				    (if (not (stringp phrase))
-					(error "Malformed Man-filter-list"))
-				    phrase)
-				 pargs " ")))
-	(setq flist (cdr flist))))
-    command))
-
-(defun Man-translate-references (ref)
-  "Translates REF from \"chmod(2V)\" to \"2v chmod\" style.
-Leave it as is if already in that style.  Possibly downcase and
-translate the section (see the Man-downcase-section-letters-flag
-and the Man-section-translations-alist variables)."
-  (let ((name "")
-	(section "")
-	(slist Man-section-translations-alist))
-    (cond
-     ;; "chmod(2V)" case ?
-     ((string-match (concat "^" Man-reference-regexp "$") ref)
-      (setq name (Man-match-substring 1 ref)
-	    section (Man-match-substring 2 ref)))
-     ;; "2v chmod" case ?
-     ((string-match (concat "^\\(" Man-section-regexp
-			    "\\) +\\(" Man-name-regexp "\\)$") ref)
-      (setq name (Man-match-substring 2 ref)
-	    section (Man-match-substring 1 ref))))
-    (if (string= name "")
-	ref				; Return the reference as is
-      (if Man-downcase-section-letters-flag
-	  (setq section (downcase section)))
-      (while slist
-	(let ((s1 (car (car slist)))
-	      (s2 (cdr (car slist))))
-	  (setq slist (cdr slist))
-	  (if Man-downcase-section-letters-flag
-	      (setq s1 (downcase s1)))
-	  (if (not (string= s1 section)) nil
-	    (setq section (if Man-downcase-section-letters-flag
-			      (downcase s2)
-			    s2)
-		  slist nil))))
-      (concat Man-specified-section-option section " " name))))
-
-
-;; ======================================================================
-;; default man entry: get word under point
-
-(defsubst Man-default-man-entry ()
-  "Make a guess at a default manual entry.
-This guess is based on the text surrounding the cursor, and the
-default section number is selected from `Man-auto-section-alist'."
-  (let (default-title)
-    (save-excursion
-      
-      ;; Default man entry title is any word the cursor is on, or if
-      ;; cursor not on a word, then nearest preceding word.  Cannot
-      ;; use the current-word function because it skips the dots.
-      (if (not (looking-at "[-a-zA-Z_.]"))
-	  (skip-chars-backward "^a-zA-Z"))
-      (skip-chars-backward "-(a-zA-Z_0-9_.")
-      (if (looking-at "(") (forward-char 1))
-      (setq default-title
-	    (buffer-substring
-	     (point)
-	     (progn (skip-chars-forward "-a-zA-Z0-9_.") (point))))
-      
-      ;; If looking at something like ioctl(2) or brc(1M), include the
-      ;; section number in the returned value.  Remove text properties.
-      (let ((result (concat
-		     default-title
-		     (if (looking-at
-			  (concat "[ \t]*([ \t]*\\("
-				  Man-section-regexp "\\)[ \t]*)"))
-			 (format "(%s)" (Man-match-substring 1))))))
-	(set-text-properties 0 (length result) nil result)
-	result))))
-
-
-;; ======================================================================
-;; Top level command and background process sentinel
-
-;; For compatibility with older versions.
-;;;###autoload
-(defalias 'manual-entry 'man)
-
-;;;###autoload
-(defun man (man-args)
-  "Get a Un*x manual page and put it in a buffer.
-This command is the top-level command in the man package.  It runs a Un*x
-command to retrieve and clean a manpage in the background and places the
-results in a Man mode (manpage browsing) buffer.  See variable
-`Man-notify-method' for what happens when the buffer is ready.
-If a buffer already exists for this man page, it will display immediately."
-  (interactive
-   (list (let* ((default-entry (Man-default-man-entry))
-		(input (read-string
-			(format "Manual entry%s: "
-				(if (string= default-entry "")
-				    ""
-				  (format " (default %s)" default-entry))))))
-	   (if (string= input "")
-	       (if (string= default-entry "")
-		   (error "No man args given")
-		 default-entry)
-	     input))))
-
-  ;; Possibly translate the "subject(section)" syntax into the
-  ;; "section subject" syntax and possibly downcase the section.
-  (setq man-args (Man-translate-references man-args))
-
-  (Man-getpage-in-background man-args))
-
-
-(defun Man-getpage-in-background (topic)
-  "Uses TOPIC to build and fire off the manpage and cleaning command."
-  (let* ((man-args topic)
-	 (bufname (concat "*Man " man-args "*"))
-	 (buffer  (get-buffer bufname)))
-    (if buffer
-	(Man-notify-when-ready buffer)
-      (require 'env)
-      (message "Invoking %s %s in the background" manual-program man-args)
-      (setq buffer (generate-new-buffer bufname))
-      (save-excursion
-	(set-buffer buffer)
-	(setq Man-original-frame (selected-frame))
-	(setq Man-arguments man-args))
-      (let ((process-environment (copy-sequence process-environment)))
-	;; Prevent any attempt to use display terminal fanciness.
-	(setenv "TERM" "dumb")
-	(set-process-sentinel
-	 (start-process manual-program buffer "sh" "-c"
-			(format (Man-build-man-command) man-args))
-	 'Man-bgproc-sentinel)))))
-
-(defun Man-notify-when-ready (man-buffer)
-  "Notify the user when MAN-BUFFER is ready.
-See the variable `Man-notify-method' for the different notification behaviors."
-  (let ((saved-frame (save-excursion
-		       (set-buffer man-buffer)
-		       Man-original-frame)))
-    (cond
-     ((eq Man-notify-method 'newframe)
-      ;; Since we run asynchronously, perhaps while Emacs is waiting
-      ;; for input, we must not leave a different buffer current.  We
-      ;; can't rely on the editor command loop to reselect the
-      ;; selected window's buffer.
-      (save-excursion
-	(set-buffer man-buffer)
-	(make-frame Man-frame-parameters)))
-     ((eq Man-notify-method 'pushy)
-      (switch-to-buffer man-buffer))
-     ((eq Man-notify-method 'bully)
-      (and window-system
-	   (frame-live-p saved-frame)
-	   (select-frame saved-frame))
-      (pop-to-buffer man-buffer)
-      (delete-other-windows))
-     ((eq Man-notify-method 'aggressive)
-      (and window-system
-	   (frame-live-p saved-frame)
-	   (select-frame saved-frame))
-      (pop-to-buffer man-buffer))
-     ((eq Man-notify-method 'friendly)
-      (and window-system
-	   (frame-live-p saved-frame)
-	   (select-frame saved-frame))
-      (display-buffer man-buffer 'not-this-window))
-     ((eq Man-notify-method 'polite)
-      (beep)
-      (message "Manual buffer %s is ready" (buffer-name man-buffer)))
-     ((eq Man-notify-method 'quiet)
-      (message "Manual buffer %s is ready" (buffer-name man-buffer)))
-     ((or (eq Man-notify-method 'meek)
-	  t)
-      (message ""))
-     )))
-
-(defun Man-fontify-manpage ()
-  "Convert overstriking and underlining to the correct fonts.
-Same for the ANSI bold and normal escape sequences."
-  (interactive)
-  (message "Please wait: making up the %s man page..." Man-arguments)
-  (goto-char (point-min))
-  (while (search-forward "\e[1m" nil t)
-    (delete-backward-char 4)
-    (put-text-property (point)
-		       (progn (if (search-forward "\e[0m" nil 'move)
-				  (delete-backward-char 4))
-			      (point))
-		       'face Man-overstrike-face))
-  (goto-char (point-min))
-  (while (search-forward "_\b" nil t)
-    (backward-delete-char 2)
-    (put-text-property (point) (1+ (point)) 'face Man-underline-face))
-  (goto-char (point-min))
-  (while (search-forward "\b_" nil t)
-    (backward-delete-char 2)
-    (put-text-property (1- (point)) (point) 'face Man-underline-face))
-  (goto-char (point-min))
-  (while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
-    (replace-match "\\1")
-    (put-text-property (1- (point)) (point) 'face Man-overstrike-face))
-  (goto-char (point-min))
-  (while (re-search-forward "o\b\\+\\|\\+\bo" nil t)
-    (replace-match "o")
-    (put-text-property (1- (point)) (point) 'face 'bold))
-  (goto-char (point-min))
-  (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t)
-    (replace-match "+")
-    (put-text-property (1- (point)) (point) 'face 'bold))
-  ;; \255 is some kind of dash in Latin-1.
-  (goto-char (point-min))
-  (while (search-forward "\255" nil t) (replace-match "-"))
-  (message "%s man page made up" Man-arguments))
-
-(defun Man-cleanup-manpage ()
-  "Remove overstriking and underlining from the current buffer."
-  (interactive)
-  (message "Please wait: cleaning up the %s man page..."
-	   Man-arguments)
-  (if (or (interactive-p) (not Man-sed-script))
-      (progn
-	(goto-char (point-min))
-	(while (search-forward "_\b" nil t) (backward-delete-char 2))
-	(goto-char (point-min))
-	(while (search-forward "\b_" nil t) (backward-delete-char 2))
-	(goto-char (point-min))
-	(while (re-search-forward "\\(.\\)\\(\b\\1\\)+" nil t)
-	  (replace-match "\\1"))
-	(goto-char (point-min))
-	(while (re-search-forward "\e\\[[0-9]+m" nil t) (replace-match ""))
-	(goto-char (point-min))
-	(while (re-search-forward "o\b\\+\\|\\+\bo" nil t) (replace-match "o"))
-	))
-  (goto-char (point-min))
-  (while (re-search-forward "[-|]\\(\b[-|]\\)+" nil t) (replace-match "+"))
-  ;; \255 is some kind of dash in Latin-1.
-  (goto-char (point-min))
-  (while (search-forward "\255" nil t) (replace-match "-"))
-  (message "%s man page cleaned up" Man-arguments))
-
-(defun Man-bgproc-sentinel (process msg)
-  "Manpage background process sentinel."
-  (let ((Man-buffer (process-buffer process))
-	(delete-buff nil)
-	(err-mess nil))
-
-    (if (null (buffer-name Man-buffer)) ;; deleted buffer
-	(set-process-buffer process nil)
-
-      (save-excursion
-	(set-buffer Man-buffer)
-	(let ((case-fold-search nil))
-	  (goto-char (point-min))
-	  (cond ((or (looking-at "No \\(manual \\)*entry for")
-		     (looking-at "[^\n]*: nothing appropriate$"))
-		 (setq err-mess (buffer-substring (point)
-						  (progn
-						    (end-of-line) (point)))
-		       delete-buff t))
-		((not (and (eq (process-status process) 'exit)
-			   (= (process-exit-status process) 0)))
-		 (setq err-mess
-		       (concat (buffer-name Man-buffer)
-			       ": process "
-			       (let ((eos (1- (length msg))))
-				 (if (= (aref msg eos) ?\n)
-				     (substring msg 0 eos) msg))))
-		 (goto-char (point-max))
-		 (insert (format "\nprocess %s" msg))
-		 )))
-        (if delete-buff
-            (kill-buffer Man-buffer)
-          (if Man-fontify-manpage-flag
-              (Man-fontify-manpage)
-            (Man-cleanup-manpage))
-          (run-hooks 'Man-cooked-hook)
-          (Man-mode)
-          (set-buffer-modified-p nil)
-          )
-	;; Restore case-fold-search before calling
-	;; Man-notify-when-ready because it may switch buffers.
-
-	(if (not delete-buff)
-	    (Man-notify-when-ready Man-buffer))
-
-	(if err-mess
-	    (error err-mess))
-	))))
-
-
-;; ======================================================================
-;; set up manual mode in buffer and build alists
-
-(defun Man-mode ()
-  "A mode for browsing Un*x manual pages.
-
-The following man commands are available in the buffer. Try
-\"\\[describe-key] <key> RET\" for more information:
-
-\\[man]       Prompt to retrieve a new manpage.
-\\[Man-follow-manual-reference]       Retrieve reference in SEE ALSO section.
-\\[Man-next-manpage]   Jump to next manpage in circular list.
-\\[Man-previous-manpage]   Jump to previous manpage in circular list.
-\\[Man-next-section]       Jump to next manpage section.
-\\[Man-previous-section]       Jump to previous manpage section.
-\\[Man-goto-section]       Go to a manpage section.
-\\[Man-goto-see-also-section]       Jumps to the SEE ALSO manpage section.
-\\[Man-quit]       Deletes the manpage window, bury its buffer.
-\\[Man-kill]       Deletes the manpage window, kill its buffer.
-\\[describe-mode]       Prints this help text.
-
-The following variables may be of some use. Try
-\"\\[describe-variable] <variable-name> RET\" for more information:
-
-Man-notify-method               What happens when manpage formatting is done.
-Man-downcase-section-letters-flag  Force section letters to lower case.
-Man-circular-pages-flag         Treat multiple manpage list as circular.
-Man-auto-section-alist          List of major modes and their section numbers.
-Man-section-translations-alist  List of section numbers and their Un*x equiv.
-Man-filter-list                 Background manpage filter command.
-Man-mode-line-format            Mode line format for Man mode buffers.
-Man-mode-map                    Keymap bindings for Man mode buffers.
-Man-mode-hook                   Normal hook run on entry to Man mode.
-Man-section-regexp              Regexp describing manpage section letters.
-Man-heading-regexp              Regexp describing section headers.
-Man-see-also-regexp             Regexp for SEE ALSO section (or your equiv).
-Man-first-heading-regexp        Regexp for first heading on a manpage.
-Man-reference-regexp            Regexp matching a references in SEE ALSO.
-Man-switches			Background `man' command switches.
-
-The following key bindings are currently in effect in the buffer:
-\\{Man-mode-map}"
-  (interactive)
-  (setq major-mode 'Man-mode
-	mode-name "Man"
-	buffer-auto-save-file-name nil
-	mode-line-format Man-mode-line-format
-	truncate-lines t
-	buffer-read-only t)
-  (buffer-disable-undo (current-buffer))
-  (auto-fill-mode -1)
-  (use-local-map Man-mode-map)
-  (Man-build-page-list)
-  (Man-strip-page-headers)
-  (Man-unindent)
-  (Man-goto-page 1)
-  (run-hooks 'Man-mode-hook))
-
-(defsubst Man-build-section-alist ()
-  "Build the association list of manpage sections."
-  (setq Man-sections-alist nil)
-  (goto-char (point-min))
-  (let ((case-fold-search nil))
-    (while (re-search-forward Man-heading-regexp (point-max) t)
-      (aput 'Man-sections-alist (Man-match-substring 1))
-      (forward-line 1))))
-
-(defsubst Man-build-references-alist ()
-  "Build the association list of references (in the SEE ALSO section)."
-  (setq Man-refpages-alist nil)
-  (save-excursion
-    (if (Man-find-section Man-see-also-regexp)
-	(let ((start (progn (forward-line 1) (point)))
-	      (end (progn
-		     (Man-next-section 1)
-		     (point)))
-	      hyphenated
-	      (runningpoint -1))
-	  (save-restriction
-	    (narrow-to-region start end)
-	    (goto-char (point-min))
-	    (back-to-indentation)
-	    (while (and (not (eobp)) (/= (point) runningpoint))
-	      (setq runningpoint (point))
-	      (if (re-search-forward Man-reference-regexp end t)
-		  (let* ((word (Man-match-substring 0))
-			 (len (1- (length word))))
-		    (if hyphenated
-			(setq word (concat hyphenated word)
-			      hyphenated nil))
-		    (if (= (aref word len) ?-)
-			(setq hyphenated (substring word 0 len))
-		      (aput 'Man-refpages-alist word))))
-	      (skip-chars-forward " \t\n,")))))))
-
-(defun Man-build-page-list ()
-  "Build the list of separate manpages in the buffer."
-  (setq Man-page-list nil)
-  (let ((page-start (point-min))
-	(page-end (point-max))
-	(header ""))
-    (goto-char page-start)
-    ;; (switch-to-buffer (current-buffer))(debug)
-    (while (not (eobp))
-      (setq header
-	    (if (looking-at Man-page-header-regexp)
-		(Man-match-substring 1)
-	      nil))
-      ;; Go past both the current and the next Man-first-heading-regexp
-      (if (re-search-forward Man-first-heading-regexp nil 'move 2)
-	  (let ((p (progn (beginning-of-line) (point))))
-	    ;; We assume that the page header is delimited by blank
-	    ;; lines and that it contains at most one blank line.  So
-	    ;; if we back by three blank lines we will be sure to be
-	    ;; before the page header but not before the possible
-	    ;; previous page header.
-	    (search-backward "\n\n" nil t 3)
-	    (if (re-search-forward Man-page-header-regexp p 'move)
-		(beginning-of-line))))
-      (setq page-end (point))
-      (setq Man-page-list (append Man-page-list
-				  (list (list (copy-marker page-start)
-					      (copy-marker page-end)
-					      header))))
-      (setq page-start page-end)
-      )))
-
-(defun Man-strip-page-headers ()
-  "Strip all the page headers but the first from the manpage."
-  (let ((buffer-read-only nil)
-	(case-fold-search nil)
-	(page-list Man-page-list)
-	(page ())
-	(header ""))
-    (while page-list
-      (setq page (car page-list))
-      (and (nth 2 page)
-	   (goto-char (car page))
-	   (re-search-forward Man-first-heading-regexp nil t)
-	   (setq header (buffer-substring (car page) (match-beginning 0)))
-	   ;; Since the awk script collapses all successive blank
-	   ;; lines into one, and since we don't want to get rid of
-	   ;; the fast awk script, one must choose between adding
-	   ;; spare blank lines between pages when there were none and
-	   ;; deleting blank lines at page boundaries when there were
-	   ;; some.  We choose the first, so we comment the following
-	   ;; line.
-	   ;; (setq header (concat "\n" header)))
-	   (while (search-forward header (nth 1 page) t)
-	     (replace-match "")))
-      (setq page-list (cdr page-list)))))
-
-(defun Man-unindent ()
-  "Delete the leading spaces that indent the manpage."
-  (let ((buffer-read-only nil)
-	(case-fold-search nil)
-	(page-list Man-page-list))
-    (while page-list
-      (let ((page (car page-list))
-	    (indent "")
-	    (nindent 0))
-	(narrow-to-region (car page) (car (cdr page)))
-	(if Man-uses-untabify-flag
-	    (untabify (point-min) (point-max)))
-	(if (catch 'unindent
-	      (goto-char (point-min))
-	      (if (not (re-search-forward Man-first-heading-regexp nil t))
-		  (throw 'unindent nil))
-	      (beginning-of-line)
-	      (setq indent (buffer-substring (point)
-					     (progn
-					       (skip-chars-forward " ")
-					       (point))))
-	      (setq nindent (length indent))
-	      (if (zerop nindent)
-		  (throw 'unindent nil))
-	      (setq indent (concat indent "\\|$"))
-	      (goto-char (point-min))
-	      (while (not (eobp))
-		(if (looking-at indent)
-		    (forward-line 1)
-		  (throw 'unindent nil)))
-	      (goto-char (point-min)))
-	    (while (not (eobp))
-	      (or (eolp)
-		  (delete-char nindent))
-	      (forward-line 1)))
-	(setq page-list (cdr page-list))
-	))))
-
-
-;; ======================================================================
-;; Man mode commands
-
-(defun Man-next-section (n)
-  "Move point to Nth next section (default 1)."
-  (interactive "p")
-  (let ((case-fold-search nil))
-    (if (looking-at Man-heading-regexp)
-	(forward-line 1))
-    (if (re-search-forward Man-heading-regexp (point-max) t n)
-	(beginning-of-line)
-      (goto-char (point-max)))))
-
-(defun Man-previous-section (n)
-  "Move point to Nth previous section (default 1)."
-  (interactive "p")
-  (let ((case-fold-search nil))
-    (if (looking-at Man-heading-regexp)
-	(forward-line -1))
-    (if (re-search-backward Man-heading-regexp (point-min) t n)
-	(beginning-of-line)
-      (goto-char (point-min)))))
-
-(defun Man-find-section (section)
-  "Move point to SECTION if it exists, otherwise don't move point.
-Returns t if section is found, nil otherwise."
-  (let ((curpos (point))
-	(case-fold-search nil))
-    (goto-char (point-min))
-    (if (re-search-forward (concat "^" section) (point-max) t)
-	(progn (beginning-of-line) t)
-      (goto-char curpos)
-      nil)
-    ))
-
-(defun Man-goto-section ()
-  "Query for section to move point to."
-  (interactive)
-  (aput 'Man-sections-alist
-	(let* ((default (aheadsym Man-sections-alist))
-	       (completion-ignore-case t)
-	       chosen
-	       (prompt (concat "Go to section: (default " default ") ")))
-	  (setq chosen (completing-read prompt Man-sections-alist))
-	  (if (or (not chosen)
-		  (string= chosen ""))
-	      default
-	    chosen)))
-  (Man-find-section (aheadsym Man-sections-alist)))
-
-(defun Man-goto-see-also-section ()
-  "Move point the the \"SEE ALSO\" section.
-Actually the section moved to is described by `Man-see-also-regexp'."
-  (interactive)
-  (if (not (Man-find-section Man-see-also-regexp))
-      (error (concat "No " Man-see-also-regexp
-		     " section found in the current manpage"))))
-
-(defun Man-follow-manual-reference (reference)
-  "Get one of the manpages referred to in the \"SEE ALSO\" section.
-Specify which reference to use; default is based on word at point."
-  (interactive
-   (if (not Man-refpages-alist)
-       (error "There are no references in the current man page")
-     (list (let* ((default (or
-			     (car (all-completions
-				   (save-excursion
-				     (skip-syntax-backward "w()")
-				     (skip-chars-forward " \t")
-				     (let ((word (current-word)))
-				       ;; strip a trailing '-':
-				       (if (string-match "-$" word)
-					   (substring word 0
-						      (match-beginning 0))
-					 word)))
-				   Man-refpages-alist))
-			     (aheadsym Man-refpages-alist)))
-		   chosen
-		   (prompt (concat "Refer to: (default " default ") ")))
-	      (setq chosen (completing-read prompt Man-refpages-alist nil t))
-	      (if (or (not chosen)
-		      (string= chosen ""))
-		  default
-		chosen)))))
-  (if (not Man-refpages-alist)
-      (error "Can't find any references in the current manpage")
-    (aput 'Man-refpages-alist reference)
-    (Man-getpage-in-background
-     (Man-translate-references (aheadsym Man-refpages-alist)))))
-
-(defun Man-kill ()
-  "Kill the buffer containing the manpage."
-  (interactive)
-  (let ((buff (current-buffer)))
-    (delete-windows-on buff)
-    (kill-buffer buff))
-  (if (and window-system
-	   (or (eq Man-notify-method 'newframe)
-	       (and pop-up-frames
-		    (eq Man-notify-method 'bully))))
-      (delete-frame)))
-
-(defun Man-quit ()
-  "Bury the buffer containing the manpage."
-  (interactive)
-  (let ((buff (current-buffer)))
-    (delete-windows-on buff)
-    (bury-buffer buff))
-  (if (and window-system
-	   (or (eq Man-notify-method 'newframe)
-	       (and pop-up-frames
-		    (eq Man-notify-method 'bully))))
-      (delete-frame)))
-
-(defun Man-goto-page (page)
-  "Go to the manual page on page PAGE."
-  (interactive
-   (if (not Man-page-list)
-       (let ((args Man-arguments))
-	 (kill-buffer (current-buffer))
-	 (error "Can't find the %s manpage" args))
-     (if (= (length Man-page-list) 1)
-	 (error "You're looking at the only manpage in the buffer")
-       (list (read-minibuffer (format "Go to manpage [1-%d]: "
-				      (length Man-page-list)))))))
-  (if (not Man-page-list)
-      (let ((args Man-arguments))
-	(kill-buffer (current-buffer))
-	(error "Can't find the %s manpage" args)))
-  (if (or (< page 1)
-	  (> page (length Man-page-list)))
-      (error "No manpage %d found" page))
-  (let* ((page-range (nth (1- page) Man-page-list))
-	 (page-start (car page-range))
-	 (page-end (car (cdr page-range))))
-    (setq Man-current-page page
-	  Man-page-mode-string (Man-make-page-mode-string))
-    (widen)
-    (goto-char page-start)
-    (narrow-to-region page-start page-end)
-    (Man-build-section-alist)
-    (Man-build-references-alist)
-    (goto-char (point-min))))
-
-
-(defun Man-next-manpage ()
-  "Find the next manpage entry in the buffer."
-  (interactive)
-  (if (= (length Man-page-list) 1)
-      (error "This is the only manpage in the buffer"))
-  (if (< Man-current-page (length Man-page-list))
-      (Man-goto-page (1+ Man-current-page))
-    (if Man-circular-pages-flag
-	(Man-goto-page 1)
-      (error "You're looking at the last manpage in the buffer"))))
-
-(defun Man-previous-manpage ()
-  "Find the previous manpage entry in the buffer."
-  (interactive)
-  (if (= (length Man-page-list) 1)
-      (error "This is the only manpage in the buffer"))
-  (if (> Man-current-page 1)
-      (Man-goto-page (1- Man-current-page))
-    (if Man-circular-pages-flag
-	(Man-goto-page (length Man-page-list))
-      (error "You're looking at the first manpage in the buffer"))))
-
-;; Init the man package variables, if not already done.
-(Man-init-defvars)
-
-(provide 'man)
-
-;;; man.el ends here
diff --git a/lisp/map-ynp.el b/lisp/map-ynp.el
deleted file mode 100644
index bfe2ee7af4c..00000000000
--- a/lisp/map-ynp.el
+++ /dev/null
@@ -1,255 +0,0 @@
-;;; map-ynp.el --- General-purpose boolean question-asker.
-
-;; Copyright (C) 1991, 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
-;; 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
-;; applies 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 (listp last-nonmenu-event)
-	;; Make a list describing a dialog box.
-	(let ((object (capitalize (nth 0 help)))
-	      (objects (capitalize (nth 1 help)))
-	      (action (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))))
-		       (setq char (read-event))
-		       ;; 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))))
-			 ((or (eq def 'quit) (eq def 'exit-prefix))
-			  (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;
-! to %s all remaining %s;
-ESC or `q' to exit;\n"
-					action object object action objects)
-				(mapconcat (function
-					    (lambda (elt)
-					      (format "%c to %s"
-						      (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/menu-bar.el b/lisp/menu-bar.el
deleted file mode 100644
index c670e1ace41..00000000000
--- a/lisp/menu-bar.el
+++ /dev/null
@@ -1,700 +0,0 @@
-;;; menu-bar.el --- define a default menu bar.
-
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: RMS
-;; 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.
-
-;; Avishai Yacobi suggested some menu rearrangements.
-
-;;; Code:
-
-;;; User options:
-
-(defvar buffers-menu-max-size 10
-  "*Maximum number of entries which may appear on the Buffers menu.
-If this is 10, then only the ten most-recently-selected buffers are shown.
-If this is nil, then all buffers are shown.
-A large number or nil slows down menu responsiveness.")
-
-;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
-;; definitions made in loaddefs.el.
-(or (lookup-key global-map [menu-bar])
-    (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
-(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
-
-;; Force Help item to come last, after the major mode's own items.
-;; The symbol used to be called `help', but that gets confused with the
-;; help key.
-(setq menu-bar-final-items '(help-menu))
-
-(define-key global-map [menu-bar help-menu] (cons "Help" menu-bar-help-menu))
-(defvar menu-bar-search-menu (make-sparse-keymap "Search"))
-(define-key global-map [menu-bar search] (cons "Search" menu-bar-search-menu))
-(defvar menu-bar-edit-menu (make-sparse-keymap "Edit"))
-(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
-(defvar menu-bar-tools-menu (make-sparse-keymap "Tools"))
-(define-key global-map [menu-bar tools] (cons "Tools" menu-bar-tools-menu))
-(defvar menu-bar-files-menu (make-sparse-keymap "Files"))
-(define-key global-map [menu-bar files] (cons "Files" menu-bar-files-menu))
-
-;; This alias is for compatibility with 19.28 and before.
-(defvar menu-bar-file-menu menu-bar-files-menu)
-
-(defvar vc-menu-map (make-sparse-keymap "Version Control"))
-
-(define-key menu-bar-tools-menu [gdb] '("Debugger..." . gdb))
-(define-key menu-bar-tools-menu [compile] '("Compile..." . compile))
-(define-key menu-bar-tools-menu [grep] '("Search Files..." . grep))
-
-(define-key menu-bar-tools-menu [separator-1]
-  '("--"))
-
-(define-key menu-bar-tools-menu [calendar] '("Display Calendar" . calendar))
-(define-key menu-bar-tools-menu [rmail] '("Send Mail" . compose-mail))
-(define-key menu-bar-tools-menu [rmail] '("Read Mail" . rmail))
-(define-key menu-bar-tools-menu [gnus] '("Read Net News" . gnus))
-
-(define-key menu-bar-tools-menu [separator-vc]
-  '("--"))
-
-(define-key menu-bar-tools-menu [vc]
-  (cons "Version Control" vc-menu-map))
-
-(define-key menu-bar-tools-menu [separator-compare]
-  '("--"))
-
-(define-key menu-bar-tools-menu [epatch]
-  '("Apply Patch" . menu-bar-epatch-menu))
-(define-key menu-bar-tools-menu [ediff-merge]
-  '("Merge" . menu-bar-ediff-merge-menu))
-(define-key menu-bar-tools-menu [compare]
-  '("Compare" . menu-bar-ediff-menu))
-
-(define-key menu-bar-tools-menu [separator-print]
-  '("--"))
-
-(put 'print-region 'menu-enable 'mark-active)
-(put 'ps-print-region-with-faces 'menu-enable 'mark-active)
-
-(define-key menu-bar-tools-menu [ps-print-region]
-  '("Postscript Print Region" . ps-print-region-with-faces))
-(define-key menu-bar-tools-menu [ps-print-buffer]
-  '("Postscript Print Buffer" . ps-print-buffer-with-faces))
-(define-key menu-bar-tools-menu [print-region]
-  '("Print Region" . print-region))
-(define-key menu-bar-tools-menu [print-buffer]
-  '("Print Buffer" . print-buffer))
-
-(define-key menu-bar-files-menu [exit-emacs]
-  '("Exit Emacs" . save-buffers-kill-emacs))
-
-(define-key menu-bar-files-menu [separator-exit]
-  '("--"))
-
-(define-key menu-bar-files-menu [one-window]
-  '("One Window" . delete-other-windows))
-
-(define-key menu-bar-files-menu [split-window]
-  '("Split Window" . split-window-vertically))
-
-(if (fboundp 'delete-frame)
-    (progn
-      ;; Don't use delete-frame as event name
-      ;; because that is a special event.
-      (define-key menu-bar-files-menu [delete-this-frame]
-	'("Delete Frame" . delete-frame))
-      (define-key menu-bar-files-menu [make-frame-on-display]
-	'("Open New Display..." . make-frame-on-display))
-      (define-key menu-bar-files-menu [make-frame]
-	'("Make New Frame" . make-frame))))
-
-(define-key menu-bar-files-menu [separator-buffers]
-  '("--"))
-
-(define-key menu-bar-files-menu [kill-buffer]
-  '("Kill Current Buffer" . kill-this-buffer))
-(define-key menu-bar-files-menu [insert-file]
-  '("Insert File..." . insert-file))
-(define-key menu-bar-files-menu [revert-buffer]
-  '("Revert Buffer" . revert-buffer))
-(define-key menu-bar-files-menu [write-file]
-  '("Save Buffer As..." . write-file))
-(define-key menu-bar-files-menu [save-buffer] '("Save Buffer" . save-buffer))
-(define-key menu-bar-files-menu [dired] '("Open Directory..." . dired))
-(define-key menu-bar-files-menu [open-file] '("Open File..." . find-file))
-
-
-(defun nonincremental-search-forward (string)
-  "Read a string and search for it nonincrementally."
-  (interactive "sSearch for string: ")
-  (if (equal string "")
-      (search-forward (car search-ring))
-    (isearch-update-ring string nil)
-    (search-forward string)))
-
-(defun nonincremental-search-backward (string)
-  "Read a string and search backward for it nonincrementally."
-  (interactive "sSearch for string: ")
-  (if (equal string "")
-      (search-backward (car search-ring))
-    (isearch-update-ring string nil)
-    (search-backward string)))
-
-(defun nonincremental-re-search-forward (string)
-  "Read a regular expression and search for it nonincrementally."
-  (interactive "sSearch for regexp: ")
-  (if (equal string "")
-      (re-search-forward (car regexp-search-ring))
-    (isearch-update-ring string t)
-    (re-search-forward string)))
-
-(defun nonincremental-re-search-backward (string)
-  "Read a regular expression and search backward for it nonincrementally."
-  (interactive "sSearch for regexp: ")
-  (if (equal string "")
-      (re-search-backward (car regexp-search-ring))
-    (isearch-update-ring string t)
-    (re-search-backward string)))
-
-(defun nonincremental-repeat-search-forward ()
-  "Search forward for the previous search string."
-  (interactive)
-  (search-forward (car search-ring)))
-
-(defun nonincremental-repeat-search-backward ()
-  "Search backward for the previous search string."
-  (interactive)
-  (search-backward (car search-ring)))
-
-(defun nonincremental-repeat-re-search-forward ()
-  "Search forward for the previous regular expression."
-  (interactive)
-  (re-search-forward (car regexp-search-ring)))
-
-(defun nonincremental-repeat-re-search-backward ()
-  "Search backward for the previous regular expression."
-  (interactive)
-  (re-search-backward (car regexp-search-ring)))
-
-(define-key menu-bar-search-menu [query-replace-regexp]
-  '("Query Replace Regexp..." . query-replace-regexp))
-(define-key menu-bar-search-menu [query-replace]
-  '("Query Replace..." . query-replace))
-(define-key menu-bar-search-menu [find-tag]
-  '("Find Tag..." . find-tag))
-(define-key menu-bar-search-menu [bookmark]
-  '("Bookmarks" . menu-bar-bookmark-map))
-
-(define-key menu-bar-search-menu [separator-search]
-  '("--"))
-
-(define-key menu-bar-search-menu [repeat-regexp-back]
-  '("Repeat Regexp Backwards" . nonincremental-repeat-re-search-backward))
-(define-key menu-bar-search-menu [repeat-search-back]
-  '("Repeat Backwards" . nonincremental-repeat-search-backward))
-(define-key menu-bar-search-menu [repeat-regexp-fwd]
-  '("Repeat Regexp" . nonincremental-repeat-re-search-forward))
-(define-key menu-bar-search-menu [repeat-search-fwd]
-  '("Repeat Search" . nonincremental-repeat-search-forward))
-
-(define-key menu-bar-search-menu [separator-repeat]
-  '("--"))
-
-(define-key menu-bar-search-menu [re-search-backward]
-  '("Regexp Search Backwards..." . nonincremental-re-search-backward))
-(define-key menu-bar-search-menu [search-backward]
-  '("Search Backwards..." . nonincremental-search-backward))
-(define-key menu-bar-search-menu [re-search-forward]
-  '("Regexp Search..." . nonincremental-re-search-forward))
-(define-key menu-bar-search-menu [search-forward]
-  '("Search..." . nonincremental-search-forward))
-
-(if (fboundp 'start-process)
-    (define-key menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map)))
-(define-key menu-bar-edit-menu [fill] '("Fill" . fill-region))
-(define-key menu-bar-edit-menu [props] '("Text Properties" . facemenu-menu))
-
-(define-key menu-bar-edit-menu [separator-edit]
-  '("--"))
-
-(define-key menu-bar-edit-menu [clear] '("Clear" . delete-region))
-
-(define-key menu-bar-edit-menu [paste] '("Paste Most Recent" . yank))
-
-(defvar yank-menu (cons "Select Yank" nil))
-(fset 'yank-menu (cons 'keymap yank-menu))
-(define-key menu-bar-edit-menu [select-paste] '("Select and Paste" . yank-menu))
-(define-key menu-bar-edit-menu [copy] '("Copy" . menu-bar-kill-ring-save))
-(define-key menu-bar-edit-menu [cut] '("Cut" . kill-region))
-(define-key menu-bar-edit-menu [undo] '("Undo" . undo))
-
-(defun menu-bar-kill-ring-save (beg end)
-  (interactive "r")
-  (if (mouse-region-match)
-      (message "Select a region with the mouse does `copy' automatically")
-    (kill-ring-save beg end)))
-
-(put 'fill-region 'menu-enable '(and mark-active (not buffer-read-only)))
-(put 'kill-region 'menu-enable '(and mark-active (not buffer-read-only)))
-(put 'menu-bar-kill-ring-save 'menu-enable 'mark-active)
-(put 'yank 'menu-enable '(and (x-selection-exists-p) (not buffer-read-only)))
-(put 'yank-menu 'menu-enable '(and (cdr yank-menu) (not buffer-read-only)))
-(put 'delete-region 'menu-enable '(and mark-active
-				       (not buffer-read-only)
-				       (not (mouse-region-match))))
-(put 'undo 'menu-enable '(and (not buffer-read-only)
-			      (if (eq last-command 'undo)
-				  pending-undo-list
-				(consp buffer-undo-list))))
-(put 'query-replace 'menu-enable '(not buffer-read-only))
-(put 'query-replace-regexp 'menu-enable '(not buffer-read-only))
-
-(autoload 'ispell-menu-map "ispell" nil t 'keymap)
-
-;; These are alternative definitions for the cut, paste and copy
-;; menu items.  Use them if your system expects these to use the clipboard.
-
-(put 'clipboard-kill-region 'menu-enable 'mark-active)
-(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
-(put 'clipboard-yank 'menu-enable
-     '(or (x-selection-exists-p) (x-selection-exists-p 'CLIPBOARD)))
-
-(defun clipboard-yank ()
-  "Reinsert the last stretch of killed text, or the clipboard contents."
-  (interactive)
-  (let ((x-select-enable-clipboard t))
-    (yank)))
-
-(defun clipboard-kill-ring-save (beg end)
-  "Copy region to kill ring, and save in the X clipboard."
-  (interactive "r")
-  (let ((x-select-enable-clipboard t))
-    (kill-ring-save beg end)))
-
-(defun clipboard-kill-region (beg end)
-  "Kill the region, and save it in the X clipboard."
-  (interactive "r")
-  (let ((x-select-enable-clipboard t))
-    (kill-region beg end)))
-
-(defun menu-bar-enable-clipboard ()
-  "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
-Do the same for the keys of the same name."
-  (interactive)
-  ;; We can't use constant list structure here because it becomes pure,
-  ;; and because it gets modified with cache data.
-  (define-key menu-bar-edit-menu [paste]
-    (cons "Paste" 'clipboard-yank))
-  (define-key menu-bar-edit-menu [copy]
-    (cons "Copy" 'clipboard-kill-ring-save))
-  (define-key menu-bar-edit-menu [cut]
-    (cons "Cut" 'clipboard-kill-region))
-
-  (define-key global-map [f20] 'clipboard-kill-region)
-  (define-key global-map [f16] 'clipboard-kill-ring-save)
-  (define-key global-map [f18] 'clipboard-yank)
-  ;; X11R6 versions
-  (define-key global-map [cut] 'clipboard-kill-region)
-  (define-key global-map [copy] 'clipboard-kill-ring-save)
-  (define-key global-map [paste] 'clipboard-yank))
-
-(define-key menu-bar-help-menu [emacs-version]
-  '("Show Version" . emacs-version))
-(define-key menu-bar-help-menu [report-emacs-bug]
-  '("Send Bug Report..." . report-emacs-bug))
-(define-key menu-bar-help-menu [finder-by-keyword]
-  '("Find Lisp Packages..." . finder-by-keyword))
-(define-key menu-bar-help-menu [emacs-tutorial]
-  '("Emacs Tutorial" . help-with-tutorial))
-(define-key menu-bar-help-menu [man]
-  '("Man..." . manual-entry))
-(define-key menu-bar-help-menu [describe-variable]
-  '("Describe Variable..." . describe-variable))
-(define-key menu-bar-help-menu [describe-function]
-  '("Describe Function..." . describe-function))
-(define-key menu-bar-help-menu [describe-key]
-  '("Describe Key..." . describe-key))
-(define-key menu-bar-help-menu [list-keybindings]
-  '("List Keybindings" . describe-bindings))
-(define-key menu-bar-help-menu [command-apropos]
-  '("Command Apropos..." . command-apropos))
-(define-key menu-bar-help-menu [describe-mode]
-  '("Describe Mode" . describe-mode))
-(define-key menu-bar-help-menu [info] '("Browse Manuals" . info))
-(define-key menu-bar-help-menu [emacs-faq] '("Emacs FAQ" . view-emacs-FAQ))
-(define-key menu-bar-help-menu [emacs-news] '("Emacs News" . view-emacs-news))
-
-(defun kill-this-buffer ()	; for the menubar
-  "Kills the current buffer."
-  (interactive)
-  (kill-buffer (current-buffer)))
-
-(defun kill-this-buffer-enabled-p ()
-  (let ((count 0)
-	(buffers (buffer-list)))
-    (while buffers
-      (or (string-match "^ " (buffer-name (car buffers)))
-	  (setq count (1+ count)))
-      (setq buffers (cdr buffers)))
-    (and (not (window-minibuffer-p (frame-selected-window menu-updating-frame)))
-	 (> count 1))))
-
-(put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p))
-
-(put 'save-buffer 'menu-enable
-     '(and (buffer-modified-p)
-	   (not (window-minibuffer-p (frame-selected-window menu-updating-frame)))))
-
-(put 'write-file 'menu-enable
-     '(not (window-minibuffer-p (frame-selected-window menu-updating-frame))))
-
-(put 'find-file 'menu-enable
-     '(not (window-minibuffer-p (frame-selected-window menu-updating-frame))))
-
-(put 'dired 'menu-enable
-     '(not (window-minibuffer-p (frame-selected-window menu-updating-frame))))
-
-(put 'insert-file 'menu-enable
-     '(not (window-minibuffer-p (frame-selected-window menu-updating-frame))))
-
-(put 'revert-buffer 'menu-enable
-     '(or revert-buffer-function revert-buffer-insert-file-contents-function
-	  (and (buffer-file-name)
-	       (or (buffer-modified-p)
-		   (not (verify-visited-file-modtime (current-buffer)))))))
-
-;; Permit deleting frame if it would leave a visible or iconified frame.
-(put 'delete-frame 'menu-enable
-     '(delete-frame-enabled-p))
-
-(defun delete-frame-enabled-p ()
-  "Return non-nil if `delete-frame' should be enabled in the menu bar."
-  (let ((frames (frame-list))
-	(count 0))
-    (while frames
-      (if (frame-visible-p (car frames))
-	  (setq count (1+ count)))
-      (setq frames (cdr frames)))
-    (> count 1)))
-
-(put 'advertised-undo 'menu-enable
-     '(and (not (eq t buffer-undo-list))
-	   (if (eq last-command 'undo)
-	       (and (boundp 'pending-undo-list)
-		    pending-undo-list)
-	     buffer-undo-list)))
-
-(defvar yank-menu-length 20
-  "*Maximum length to display in the yank-menu.")
-
-(defun menu-bar-update-yank-menu (string old)
-  (let ((front (car (cdr yank-menu)))
-	(menu-string (if (<= (length string) yank-menu-length)
-			 string
-		       (concat
-			(substring string 0 (/ yank-menu-length 2))
-			"..."
-			(substring string (- (/ yank-menu-length 2)))))))
-    ;; Don't let the menu string be all dashes
-    ;; because that has a special meaning in a menu.
-    (if (string-match "\\`-+\\'" menu-string)
-	(setq menu-string (concat menu-string " ")))
-    ;; If we're supposed to be extending an existing string, and that
-    ;; string really is at the front of the menu, then update it in place.
-    (if (and old (or (eq old (car front))
-		     (string= old (car front))))
-	(progn
-	  (setcar front string)
-	  (setcar (cdr front) menu-string))
-      (setcdr yank-menu
-	      (cons
-	       (cons string (cons menu-string 'menu-bar-select-yank))
-	       (cdr yank-menu)))))
-  (if (> (length (cdr yank-menu)) kill-ring-max)
-      (setcdr (nthcdr kill-ring-max yank-menu) nil)))
-
-(defun menu-bar-select-yank ()
-  (interactive "*")
-  (push-mark (point))
-  (insert last-command-event))
-
-;; This definition is just to show what this looks like.
-;; It gets overridden below when menu-bar-update-buffers is called.
-(define-key global-map [menu-bar buffer]
-  (cons "Buffers" (make-sparse-keymap "Buffers")))
-
-(defvar list-buffers-directory nil)
-
-(defvar menu-bar-update-buffers-maxbuf)
-
-(defun menu-bar-select-buffer ()
-  (interactive)
-  (switch-to-buffer last-command-event))
-
-(defun menu-bar-select-frame ()
-  (interactive)
-  (make-frame-visible last-command-event)
-  (raise-frame last-command-event)
-  (select-frame last-command-event))
-
-(defun menu-bar-update-buffers-1 (elt)
-  (cons (format
-	 (format "%%%ds  %%s%%s  %%s" menu-bar-update-buffers-maxbuf)
-	 (cdr elt)
-	 (if (buffer-modified-p (car elt))
-	     "*" " ")
-	 (save-excursion
-	   (set-buffer (car elt))
-	   (if buffer-read-only "%" " "))
-	 (let ((file
-		(or (buffer-file-name (car elt))
-		    (save-excursion
-		      (set-buffer (car elt))
-		      list-buffers-directory)
-		    "")))
-	   (setq file (or (file-name-directory file)
-			  ""))
-	   (if (> (length file) 20)
-	       (setq file (concat "..." (substring file -17))))
-	   file))
-	(car elt)))
-
-(defvar menu-bar-buffers-menu-list-buffers-entry nil)
-
-(defun menu-bar-update-buffers ()
-  ;; If user discards the Buffers item, play along.
-  (and (lookup-key (current-global-map) [menu-bar buffer])
-       (frame-or-buffer-changed-p)
-       (let ((buffers (buffer-list))
-	     (frames (frame-list))
-	     (maxlen 0)
-	     buffers-menu frames-menu)
-	 ;; If requested, list only the N most recently selected buffers.
-	 (if (and (integerp buffers-menu-max-size)
-		  (> buffers-menu-max-size 1))
-	     (if (> (length buffers) buffers-menu-max-size)
-		 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
-
-	 ;; Make the menu of buffers proper.
-	 (setq buffers-menu
-	       (cons "Select Buffer"
-		     (let* ((buffer-list
-			     (mapcar 'list buffers))
-			    tail
-			    (menu-bar-update-buffers-maxbuf 0)
-			    alist
-			    head)
-		       ;; Put into each element of buffer-list
-		       ;; the name for actual display,
-		       ;; perhaps truncated in the middle.
-		       (setq tail buffer-list)
-		       (while tail
-			 (let ((name (buffer-name (car (car tail)))))
-			   (setcdr (car tail)
-				   (if (> (length name) 27)
-				       (concat (substring name 0 12)
-					       "..."
-					       (substring name -12))
-				     name)))
-			 (setq tail (cdr tail)))
-		       ;; Compute the maximum length of any name.
-		       (setq tail buffer-list)
-		       (while tail
-			 (or (eq ?\ (aref (cdr (car tail)) 0))
-			     (setq menu-bar-update-buffers-maxbuf
-				   (max menu-bar-update-buffers-maxbuf
-					(length (cdr (car tail))))))
-			 (setq tail (cdr tail)))
-		       ;; Set ALIST to an alist of the form
-		       ;; ITEM-STRING . BUFFER
-		       (setq tail buffer-list)
-		       (while tail
-			 (let ((elt (car tail)))
-			   (or (eq ?\ (aref (cdr elt) 0))
-			       (setq alist (cons
-					    (menu-bar-update-buffers-1 elt)
-					    alist)))
-			   (and alist (> (length (car (car alist))) maxlen)
-				(setq maxlen (length (car (car alist))))))
-			 (setq tail (cdr tail)))
-		       (setq alist (nreverse alist))
-		       ;; Make the menu item for list-buffers
-		       ;; or reuse the one we already have.
-		       ;; The advantage in reusing one
-		       ;; is that it already has the keyboard equivalent
-		       ;; cached, so we save the time to look that up again.
-		       (or menu-bar-buffers-menu-list-buffers-entry
-			   (setq menu-bar-buffers-menu-list-buffers-entry
-				 (cons
-				  'list-buffers
-				  (cons
-				   ""
-				   'list-buffers))))
-		       ;; Update the item string for menu's new width.
-		       (setcar (cdr menu-bar-buffers-menu-list-buffers-entry)
-			       (concat (make-string (max (- (/ maxlen 2) 8) 0)
-						    ?\ )
-				       "List All Buffers"))
-		       ;; Now make the actual list of items,
-		       ;; ending with the list-buffers item.
-		       (nconc (mapcar '(lambda (pair)
-					 ;; This is somewhat risque, to use
-					 ;; the buffer name itself as the event
-					 ;; type to define, but it works.
-					 ;; It would not work to use the buffer
-					 ;; since a buffer as an event has its
-					 ;; own meaning.
-					 (nconc (list (buffer-name (cdr pair))
-						      (car pair)
-						      (cons nil nil))
-						'menu-bar-select-buffer))
-				      alist)
-			      (list menu-bar-buffers-menu-list-buffers-entry)))))
-
-
-	 ;; Make a Frames menu if we have more than one frame.
-	 (if (cdr frames)
-	     (let ((name (concat (make-string (max (- (/ maxlen 2) 3) 0)
-					      ?\ )
-				 "Frames"))
-		   (frames-menu
-		    (cons 'keymap
-			  (cons "Select Frame"
-				(mapcar '(lambda (frame)
-					   (nconc (list frame
-							(cdr (assq 'name
-								   (frame-parameters frame)))
-							(cons nil nil))
-						  'menu-bar-select-frame))
-					frames)))))
-	       ;; Put it underneath the Buffers menu.
-	       (setq buffers-menu (cons (cons 'frames (cons name frames-menu))
-					buffers-menu))))
-	 (if buffers-menu
-	     (setq buffers-menu (cons 'keymap buffers-menu)))
-	 (define-key (current-global-map) [menu-bar buffer]
-	   (cons "Buffers" buffers-menu)))))
-
-(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
-
-(menu-bar-update-buffers)
-
-;; this version is too slow
-;;;(defun format-buffers-menu-line (buffer)
-;;;  "Returns a string to represent the given buffer in the Buffer menu.
-;;;nil means the buffer shouldn't be listed.  You can redefine this."
-;;;  (if (string-match "\\` " (buffer-name buffer))
-;;;      nil
-;;;    (save-excursion
-;;;     (set-buffer buffer)
-;;;     (let ((size (buffer-size)))
-;;;       (format "%s%s %-19s %6s %-15s %s"
-;;;	       (if (buffer-modified-p) "*" " ")
-;;;	       (if buffer-read-only "%" " ")
-;;;	       (buffer-name)
-;;;	       size
-;;;	       mode-name
-;;;	       (or (buffer-file-name) ""))))))
-
-;;; Set up a menu bar menu for the minibuffer.
-
-(mapcar
- (function
-  (lambda (map)
-    (define-key map [menu-bar minibuf]
-      (cons "Minibuf" (make-sparse-keymap "Minibuf")))))
- (list minibuffer-local-ns-map
-       minibuffer-local-must-match-map
-       minibuffer-local-isearch-map
-       minibuffer-local-map
-       minibuffer-local-completion-map))
-
-(mapcar
- (function
-  (lambda (map)
-    (define-key map [menu-bar minibuf ?\?]
-      '("List Completions" . minibuffer-completion-help))
-    (define-key map [menu-bar minibuf space]
-      '("Complete Word" . minibuffer-complete-word))
-    (define-key map [menu-bar minibuf tab]
-      '("Complete" . minibuffer-complete))
-    ))
- (list minibuffer-local-must-match-map
-       minibuffer-local-completion-map))
-
-(mapcar
- (function
-  (lambda (map)
-    (define-key map [menu-bar minibuf quit]
-      '("Quit" . keyboard-escape-quit))
-    (define-key map [menu-bar minibuf return]
-      '("Enter" . exit-minibuffer))
-    ))
- (list minibuffer-local-ns-map
-       minibuffer-local-must-match-map
-       minibuffer-local-isearch-map
-       minibuffer-local-map
-       minibuffer-local-completion-map))
-
-(defvar menu-bar-mode nil)
-
-(defun menu-bar-mode (flag)
-  "Toggle display of a menu bar on each frame.
-This command applies to all frames that exist and frames to be
-created in the future.
-With a numeric argument, if the argument is negative,
-turn off menu bars; otherwise, turn on menu bars."
- (interactive "P")
-
-  ;; Make menu-bar-mode and default-frame-alist consistent.
-  (let ((default (assq 'menu-bar-lines default-frame-alist)))
-    (if default
-	(setq menu-bar-mode (not (eq (cdr default) 0)))
-      (setq default-frame-alist
-	    (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
-		  default-frame-alist))))
-
-  ;; Toggle or set the mode, according to FLAG.
- (setq menu-bar-mode (if (null flag) (not menu-bar-mode)
-		       (> (prefix-numeric-value flag) 0)))
-
- ;; Apply it to default-frame-alist.
- (let ((parameter (assq 'menu-bar-lines default-frame-alist)))
-   (if (consp parameter)
-       (setcdr parameter (if menu-bar-mode 1 0))
-     (setq default-frame-alist
-	   (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
-		 default-frame-alist))))
-
- ;; Apply it to existing frames.
- (let ((frames (frame-list)))
-   (while frames
-     (let ((height (cdr (assq 'height (frame-parameters (car frames))))))
-       (modify-frame-parameters (car frames)
-				(list (cons 'menu-bar-lines
-					  (if menu-bar-mode 1 0))))
-       (modify-frame-parameters (car frames)
-				(list (cons 'height height))))
-     (setq frames (cdr frames)))))
-
-(provide 'menu-bar)
-
-;;; menu-bar.el ends here
diff --git a/lisp/message.el b/lisp/message.el
deleted file mode 100644
index edfe6fbdee7..00000000000
--- a/lisp/message.el
+++ /dev/null
@@ -1,2996 +0,0 @@
-;;; message.el --- composing mail and news messages
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: mail, news
-
-;; 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 mode provides mail-sending facilities from within Emacs.  It
-;; consists mainly of large chunks of code from the sendmail.el,
-;; gnus-msg.el and rnewspost.el files.
-
-;;; Code:
-
-(eval-when-compile 
-  (require 'cl))
-(require 'mailheader)
-(require 'rmail)
-(require 'nnheader)
-(require 'timezone)
-(require 'easymenu)
-(if (string-match "XEmacs\\|Lucid" emacs-version)
-    (require 'mail-abbrevs)
-  (require 'mailabbrev))
-
-(defvar message-directory "~/Mail/"
-  "*Directory from which all other mail file variables are derived.")
-
-(defvar message-max-buffers 10
-  "*How many buffers to keep before starting to kill them off.")
-
-(defvar message-send-rename-function nil
-  "Function called to rename the buffer after sending it.")
-
-;;;###autoload
-(defvar message-fcc-handler-function 'rmail-output
-  "*A function called to save outgoing articles.
-This function will be called with the name of the file to store the
-article in. The default function is `rmail-output' which saves in Unix
-mailbox format.")
-
-;;;###autoload
-(defvar message-courtesy-message
-  "The following message is a courtesy copy of an article\nthat has been posted as well.\n\n"
-  "*This is inserted at the start of a mailed copy of a posted message.
-If this variable is nil, no such courtesy message will be added.")
-
-;;;###autoload
-(defvar message-ignored-bounced-headers "^\\(Received\\|Return-Path\\):"
-  "*Regexp that matches headers to be removed in resent bounced mail.")
-
-;;;###autoload
-(defvar message-from-style 'default
-  "*Specifies how \"From\" headers look.
-
-If `nil', they contain just the return address like:
-	king@grassland.com
-If `parens', they look like:
-	king@grassland.com (Elvis Parsley)
-If `angles', they look like:
-	Elvis Parsley <king@grassland.com>
-
-Otherwise, most addresses look like `angles', but they look like
-`parens' if `angles' would need quoting and `parens' would not.")
-
-;;;###autoload
-(defvar message-syntax-checks nil
-  "Controls what syntax checks should not be performed on outgoing posts.
-To disable checking of long signatures, for instance, add
- `(signature . disabled)' to this list.
-
-Don't touch this variable unless you really know what you're doing.
-
-Checks include subject-cmsg multiple-headers sendsys message-id from
-long-lines control-chars size new-text redirected-followup signature
-approved sender empty empty-headers message-id from subject.")
-
-;;;###autoload
-(defvar message-required-news-headers
-  '(From Newsgroups Subject Date Message-ID 
-	 (optional . Organization) Lines 
-	 (optional . X-Newsreader))
-  "*Headers to be generated or prompted for when posting an article.
-RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
-Message-ID.  Organization, Lines, In-Reply-To, Expires, and
-X-Newsreader are optional.  If don't you want message to insert some
-header, remove it from this list.")
-
-;;;###autoload
-(defvar message-required-mail-headers 
-  '(From Subject Date (optional . In-Reply-To) Message-ID Lines
-	 (optional . X-Mailer))
-  "*Headers to be generated or prompted for when mailing a message.
-RFC822 required that From, Date, To, Subject and Message-ID be
-included.  Organization, Lines and X-Mailer are optional.")
-
-;;;###autoload
-(defvar message-deletable-headers '(Message-ID Date)
-  "*Headers to be deleted if they already exist and were generated by message previously.")
-
-;;;###autoload
-(defvar message-ignored-news-headers 
-  "^NNTP-Posting-Host:\\|^Xref:\\|^Bcc:\\|^Gcc:\\|^Fcc:"
-  "*Regexp of headers to be removed unconditionally before posting.")
-
-;;;###autoload
-(defvar message-ignored-mail-headers "^Gcc:\\|^Fcc:"
-  "*Regexp of headers to be removed unconditionally before mailing.")
-
-;;;###autoload
-(defvar message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|Return-Path:\\|^Supersedes:"
-  "*Header lines matching this regexp will be deleted before posting.
-It's best to delete old Path and Date headers before posting to avoid
-any confusion.")
-
-;;;###autoload
-(defvar message-signature-separator "^-- *$"
-  "Regexp matching the signature separator.")
-
-;;;###autoload
-(defvar message-interactive nil 
-  "Non-nil means when sending a message wait for and display errors.
-nil means let mailer mail back a message to report errors.")
-
-;;;###autoload
-(defvar message-generate-new-buffers t
-  "*Non-nil means that a new message buffer will be created whenever `mail-setup' is called.
-If this is a function, call that function with three parameters:  The type,
-the to address and the group name.  (Any of these may be nil.)  The function
-should return the new buffer name.")
-
-;;;###autoload
-(defvar message-kill-buffer-on-exit nil
-  "*Non-nil means that the message buffer will be killed after sending a message.")
-
-(defvar gnus-local-organization)
-(defvar message-user-organization 
-  (or (and (boundp 'gnus-local-organization)
-	   gnus-local-organization)
-      (getenv "ORGANIZATION")
-      t)
-  "*String to be used as an Organization header.
-If t, use `message-user-organization-file'.")
-
-;;;###autoload
-(defvar message-user-organization-file "/usr/lib/news/organization"
-  "*Local news organization file.")
-
-(defvar message-autosave-directory "~/"
-  ; (concat (file-name-as-directory message-directory) "drafts/")
-  "*Directory where message autosaves buffers.
-If nil, message won't autosave.")
-
-(defvar message-forward-start-separator 
-  "------- Start of forwarded message -------\n"
-  "*Delimiter inserted before forwarded messages.")
-
-(defvar message-forward-end-separator
-  "------- End of forwarded message -------\n"
-  "*Delimiter inserted after forwarded messages.")
-
-;;;###autoload
-(defvar message-signature-before-forwarded-message t
-  "*If non-nil, put the signature before any included forwarded message.")
-
-;;;###autoload
-(defvar message-included-forward-headers 
-  "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-\\|^Message-ID:\\|^References:"
-  "*Regexp matching headers to be included in forwarded messages.")
-
-;;;###autoload
-(defvar message-ignored-resent-headers "^Return-receipt"
-  "*All headers that match this regexp will be deleted when resending a message.")
-
-;;;###autoload
-(defvar message-ignored-cited-headers "."
-  "Delete these headers from the messages you yank.")
-
-;; Useful to set in site-init.el
-;;;###autoload
-(defvar message-send-mail-function 'message-send-mail-with-sendmail
-  "Function to call to send the current buffer as mail.
-The headers should be delimited by a line whose contents match the
-variable `mail-header-separator'.
-
-Legal values include `message-send-mail-with-mh' and
-`message-send-mail-with-sendmail', which is the default.")
-
-;;;###autoload
-(defvar message-send-news-function 'message-send-news
-  "Function to call to send the current buffer as news.
-The headers should be delimited by a line whose contents match the
-variable `mail-header-separator'.")
-
-;;;###autoload
-(defvar message-reply-to-function nil
-  "Function that should return a list of headers.
-This function should pick out addresses from the To, Cc, and From headers
-and respond with new To and Cc headers.")
-
-;;;###autoload
-(defvar message-wide-reply-to-function nil
-  "Function that should return a list of headers.
-This function should pick out addresses from the To, Cc, and From headers
-and respond with new To and Cc headers.")
-
-;;;###autoload
-(defvar message-followup-to-function nil
-  "Function that should return a list of headers.
-This function should pick out addresses from the To, Cc, and From headers
-and respond with new To and Cc headers.")
-
-;;;###autoload
-(defvar message-use-followup-to 'ask
-  "*Specifies what to do with Followup-To header.
-If nil, ignore the header. If it is t, use its value, but query before
-using the \"poster\" value.  If it is the symbol `ask', query the user
-whether to ignore the \"poster\" value.  If it is the symbol `use',
-always use the value.")
-
-(defvar gnus-post-method)
-(defvar gnus-select-method)
-;;;###autoload
-(defvar message-post-method 
-  (cond ((and (boundp 'gnus-post-method)
-	      gnus-post-method)
-	 gnus-post-method)
-	((boundp 'gnus-select-method)
-	 gnus-select-method)
-	(t '(nnspool "")))
-  "Method used to post news.")
-
-;;;###autoload
-(defvar message-generate-headers-first nil
-  "*If non-nil, generate all possible headers before composing.")
-
-(defvar message-setup-hook nil
-  "Normal hook, run each time a new outgoing message is initialized.
-The function `message-setup' runs this hook.")
-
-(defvar message-signature-setup-hook nil
-  "Normal hook, run each time a new outgoing message is initialized.
-It is run after the headers have been inserted and before 
-the signature is inserted.")
-
-(defvar message-mode-hook
-  (if (fboundp 'mail-abbrevs-setup)
-      '(mail-abbrevs-setup)
-    (list (intern "mail-aliases-setup")))
-  "Hook run in message mode buffers.")
-
-(defvar message-header-hook nil
-  "Hook run in a message mode buffer narrowed to the headers.")
-
-(defvar message-header-setup-hook nil
-  "Hook called narrowed to the headers when setting up a message buffer.")
-
-;;;###autoload
-(defvar message-citation-line-function 'message-insert-citation-line
-  "*Function called to insert the \"Whomever writes:\" line.")
-
-;;;###autoload
-(defvar message-yank-prefix "> "
-  "*Prefix inserted on the lines of yanked messages.
-nil means use indentation.")
-
-(defvar message-indentation-spaces 3
-  "*Number of spaces to insert at the beginning of each cited line.
-Used by `message-yank-original' via `message-yank-cite'.")
-
-;;;###autoload
-(defvar message-cite-function 'message-cite-original
-  "*Function for citing an original message.")
-
-;;;###autoload
-(defvar message-indent-citation-function 'message-indent-citation
-  "*Function for modifying a citation just inserted in the mail buffer.
-This can also be a list of functions.  Each function can find the
-citation between (point) and (mark t).  And each function should leave
-point and mark around the citation text as modified.")
-
-(defvar message-abbrevs-loaded nil)
-
-;;;###autoload
-(defvar message-signature t
-  "*String to be inserted at the end of the message buffer.
-If t, the `message-signature-file' file will be inserted instead.
-If a function, the result from the function will be used instead.
-If a form, the result from the form will be used instead.")
-
-;;;###autoload
-(defvar message-signature-file "~/.signature"
-  "*File containing the text inserted at end of message. buffer.")
-
-(defvar message-distribution-function nil
-  "*Function called to return a Distribution header.")
-
-(defvar message-expires 14
-  "*Number of days before your article expires.")
-
-(defvar message-user-path nil
-  "If nil, use the NNTP server name in the Path header.
-If stringp, use this; if non-nil, use no host name (user name only).")
-
-(defvar message-reply-buffer nil)
-(defvar message-reply-headers nil)
-(defvar message-newsreader nil)
-(defvar message-mailer nil)
-(defvar message-sent-message-via nil)
-(defvar message-checksum nil)
-(defvar message-send-actions nil
-  "A list of actions to be performed upon successful sending of a message.")
-(defvar message-exit-actions nil
-  "A list of actions to be performed upon exiting after sending a message.")
-(defvar message-kill-actions nil
-  "A list of actions to be performed before killing a message buffer.")
-(defvar message-postpone-actions nil
-  "A list of actions to be performed after postponing a message.")
-
-;;;###autoload
-(defvar message-default-headers nil
-  "*A string containing header lines to be inserted in outgoing messages.
-It is inserted before you edit the message, so you can edit or delete
-these lines.")
-
-;;;###autoload
-(defvar message-default-mail-headers nil
-  "*A string of header lines to be inserted in outgoing mails.")
-
-;;;###autoload
-(defvar message-default-news-headers nil
-  "*A string of header lines to be inserted in outgoing news articles.")
-
-;; Note: could use /usr/ucb/mail instead of sendmail;
-;; options -t, and -v if not interactive.
-(defvar message-mailer-swallows-blank-line
-  (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)" 
-			 system-configuration)
-	   (file-readable-p "/etc/sendmail.cf")
-	   (let ((buffer (get-buffer-create " *temp*")))
-	     (unwind-protect
-		 (save-excursion
-		   (set-buffer buffer)
-		   (insert-file-contents "/etc/sendmail.cf")
-		   (goto-char (point-min))
-		   (let ((case-fold-search nil))
-		     (re-search-forward "^OR\\>" nil t)))
-	       (kill-buffer buffer))))
-      ;; According to RFC822, "The field-name must be composed of printable
-      ;; ASCII characters (i.e. characters that have decimal values between
-      ;; 33 and 126, except colon)", i.e. any chars except ctl chars,
-      ;; space, or colon.
-      '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
-  "Set this non-nil if the system's mailer runs the header and body together.
-\(This problem exists on Sunos 4 when sendmail is run in remote mode.)
-The value should be an expression to test whether the problem will
-actually occur.")
-
-(defvar message-mode-syntax-table 
-  (let ((table (copy-syntax-table text-mode-syntax-table)))
-    (modify-syntax-entry ?% ". " table)
-    table)
-  "Syntax table used while in Message mode.")
-
-(defvar message-font-lock-keywords
-  (let* ((cite-prefix "A-Za-z") (cite-suffix (concat cite-prefix "0-9_.@-")))
-    (list '("^To:" . font-lock-function-name-face)
-          '("^[GBF]?[Cc][Cc]:\\|^Reply-To:" . font-lock-keyword-face)
-	  '("^\\(Subject:\\)[ \t]*\\(.+\\)?"
-	    (1 font-lock-comment-face) (2 font-lock-type-face nil t))
-	  (list (concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
-		1 'font-lock-comment-face)
-	  (cons (concat "^[ \t]*"
-			"\\([" cite-prefix "]+[" cite-suffix "]*\\)?"
-			"[>|}].*")
-		'font-lock-reference-face)
-	  '("^\\(X-[A-Za-z0-9-]+\\|In-reply-to\\):.*"
-	    . font-lock-string-face)))
-  "Additional expressions to highlight in Message mode.")
-
-(defvar message-face-alist
-  '((bold . bold-region)
-    (underline . underline-region)
-    (default . (lambda (b e) 
-		 (unbold-region b e)
-		 (ununderline-region b e))))
-  "Alist of mail and news faces for facemenu.
-The cdr of ech entry is a function for applying the face to a region.")
-
-(defvar message-send-hook nil
-  "Hook run before sending messages.")
-
-(defvar message-sent-hook nil
-  "Hook run after sending messages.")
-
-;;; Internal variables.
-
-(defvar message-buffer-list nil)
-
-;;; Regexp matching the delimiter of messages in UNIX mail format
-;;; (UNIX From lines), minus the initial ^.  
-(defvar message-unix-mail-delimiter
-  (let ((time-zone-regexp
-	 (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
-		 "\\|[-+]?[0-9][0-9][0-9][0-9]"
-		 "\\|"
-		 "\\) *")))
-    (concat
-     "From "
-
-     ;; Username, perhaps with a quoted section that can contain spaces.
-     "\\("
-     "[^ \n]*"
-     "\\(\\|\".*\"[^ \n]*\\)"
-     "\\|<[^<>\n]+>"
-     "\\)  ?"
-
-     ;; The time the message was sent.
-     "\\([^ \n]*\\) *"			; day of the week
-     "\\([^ ]*\\) *"			; month
-     "\\([0-9]*\\) *"			; day of month
-     "\\([0-9:]*\\) *"			; time of day
-
-     ;; Perhaps a time zone, specified by an abbreviation, or by a
-     ;; numeric offset.
-     time-zone-regexp
-
-     ;; The year.
-     " [0-9][0-9]\\([0-9]*\\) *"
-
-     ;; On some systems the time zone can appear after the year, too.
-     time-zone-regexp
-
-     ;; Old uucp cruft.
-     "\\(remote from .*\\)?"
-
-     "\n")))
-
-(defvar message-unsent-separator
-  (concat "^ *---+ +Unsent message follows +---+ *$\\|"
-	  "^ *---+ +Returned message +---+ *$\\|"
-	  "^Start of returned message$\\|"
-	  "^ *---+ +Original message +---+ *$\\|"
-	  "^ *--+ +begin message +--+ *$\\|"
-	  "^ *---+ +Original message follows +---+ *$\\|"
-	  "^|? *---+ +Message text follows: +---+ *|?$")
-  "A regexp that matches the separator before the text of a failed message.")
-
-(defvar message-header-format-alist 
-  `((Newsgroups)
-    (To . message-fill-address) 
-    (Cc . message-fill-address)
-    (Subject)
-    (In-Reply-To)
-    (Fcc)
-    (Bcc)
-    (Date)
-    (Organization)
-    (Distribution)
-    (Lines)
-    (Expires)
-    (Message-ID)
-    (References . message-fill-header)
-    (X-Mailer)
-    (X-Newsreader))
-  "Alist used for formatting headers.")
-
-(eval-and-compile
-  (autoload 'message-setup-toolbar "messagexmas")
-  (autoload 'mh-send-letter "mh-comp"))
-
-
-
-;;; 
-;;; Utility functions.
-;;;
-
-(defun message-point-at-bol ()
-  "Return point at the beginning of the line."
-  (let ((p (point)))
-    (beginning-of-line)
-    (prog1
-	(point)
-      (goto-char p))))
-
-(defun message-point-at-eol ()
-  "Return point at the end of the line."
-  (let ((p (point)))
-    (end-of-line)
-    (prog1
-	(point)
-      (goto-char p))))
-
-;; Delete the current line (and the next N lines.);
-(defmacro message-delete-line (&optional n)
-  `(delete-region (progn (beginning-of-line) (point))
-		  (progn (forward-line ,(or n 1)) (point))))
-
-(defun message-tokenize-header (header &optional separator)
-  "Split HEADER into a list of header elements.
-\",\" is used as the separator."
-  (let ((regexp (format "[%s]+" (or separator ",")))
-	(beg 1)
-	quoted elems)
-    (save-excursion
-      (message-set-work-buffer)
-      (insert header)
-      (goto-char (point-min))
-      (while (not (eobp))
-	(forward-char 1)
-	(cond ((and (> (point) beg)
-		    (or (eobp)
-			(and (looking-at regexp)
-			     (not quoted))))
-	       (push (buffer-substring beg (point)) elems)
-	       (setq beg (match-end 0)))
-	      ((= (following-char) ?\")
-	       (setq quoted (not quoted)))))
-      (nreverse elems))))
-
-(defun message-fetch-field (header)
-  "The same as `mail-fetch-field', only remove all newlines."
-  (let ((value (mail-fetch-field header)))
-    (when value
-      (nnheader-replace-chars-in-string value ?\n ? ))))
-
-(defun message-fetch-reply-field (header)
-  "Fetch FIELD from the message we're replying to."
-  (when (and message-reply-buffer
-	     (buffer-name message-reply-buffer))
-    (save-excursion
-      (set-buffer message-reply-buffer)
-      (message-fetch-field header))))
-
-(defun message-set-work-buffer ()
-  (if (get-buffer " *message work*")
-      (progn
-	(set-buffer " *message work*")
-	(erase-buffer))
-    (set-buffer (get-buffer-create " *message work*"))
-    (kill-all-local-variables)
-    (buffer-disable-undo (current-buffer))))
-
-(defun message-functionp (form)
-  "Return non-nil if FORM is funcallable."
-  (or (and (symbolp form) (fboundp form))
-      (and (listp form) (eq (car form) 'lambda))))
-
-(defun message-strip-subject-re (subject)
-  "Remove \"Re:\" from subject lines."
-  (if (string-match "^[Rr][Ee]: *" subject)
-      (substring subject (match-end 0))
-    subject))
-
-(defun message-remove-header (header &optional is-regexp first reverse)
-  "Remove HEADER in the narrowed buffer.
-If REGEXP, HEADER is a regular expression.
-If FIRST, only remove the first instance of the header.
-Return the number of headers removed."
-  (goto-char (point-min))
-  (let ((regexp (if is-regexp header (concat "^" header ":")))
-	(number 0)
-	(case-fold-search t)
-	last)
-    (while (and (not (eobp))
-		(not last))
-      (if (if reverse
-	      (not (looking-at regexp))
-	    (looking-at regexp))
-	  (progn
-	    (incf number)
-	    (when first
-	      (setq last t))
-	    (delete-region
-	     (point)
-	     ;; There might be a continuation header, so we have to search
-	     ;; until we find a new non-continuation line.
-	     (progn
-	       (forward-line 1)
-	       (if (re-search-forward "^[^ \t]" nil t)
-		   (goto-char (match-beginning 0))
-		 (point-max)))))
-	(forward-line 1)
-	(if (re-search-forward "^[^ \t]" nil t)
-	    (goto-char (match-beginning 0))
-	  (point-max))))
-    number))
-
-(defun message-narrow-to-headers ()
-  "Narrow the buffer to the head of the message."
-  (widen)
-  (narrow-to-region
-   (goto-char (point-min))
-   (if (re-search-forward
-	(concat "^" (regexp-quote mail-header-separator) "\n") nil t)
-       (match-beginning 0)
-     (point-max)))
-  (goto-char (point-min)))
-
-(defun message-narrow-to-head ()
-  "Narrow the buffer to the head of the message."
-  (widen)
-  (narrow-to-region
-   (goto-char (point-min))
-   (if (search-forward "\n\n" nil 1)
-       (1- (point))
-     (point-max)))
-  (goto-char (point-min)))
-
-(defun message-news-p ()
-  "Say whether the current buffer contains a news message."
-  (save-excursion
-    (save-restriction
-      (message-narrow-to-headers)
-      (message-fetch-field "newsgroups"))))
-
-(defun message-mail-p ()
-  "Say whether the current buffer contains a mail message."
-  (save-excursion
-    (save-restriction
-      (message-narrow-to-headers)
-      (or (message-fetch-field "to")
-	  (message-fetch-field "cc")
-	  (message-fetch-field "bcc")))))
-
-(defun message-next-header ()
-  "Go to the beginning of the next header."
-  (beginning-of-line)
-  (or (eobp) (forward-char 1))
-  (not (if (re-search-forward "^[^ \t]" nil t)
-	   (beginning-of-line)
-	 (goto-char (point-max)))))
-    
-(defun message-sort-headers-1 ()
-  "Sort the buffer as headers using `message-rank' text props."
-  (goto-char (point-min))
-  (sort-subr 
-   nil 'message-next-header 
-   (lambda ()
-     (message-next-header)
-     (unless (bobp)
-       (forward-char -1)))
-   (lambda ()
-     (or (get-text-property (point) 'message-rank)
-	 0))))
-
-(defun message-sort-headers ()
-  "Sort the headers of the current message according to `message-header-format-alist'."
-  (interactive)
-  (save-excursion
-    (save-restriction
-      (let ((max (1+ (length message-header-format-alist)))
-	    rank)
-	(message-narrow-to-headers)
-	(while (re-search-forward "^[^ \n]+:" nil t)
-	  (put-text-property
-	   (match-beginning 0) (1+ (match-beginning 0))
-	   'message-rank
-	   (if (setq rank (length (memq (assq (intern (buffer-substring
-						       (match-beginning 0)
-						       (1- (match-end 0))))
-					      message-header-format-alist)
-					message-header-format-alist)))
-	       (- max rank)
-	     (1+ max)))))
-      (message-sort-headers-1))))
-
-(defmacro message-y-or-n-p (question show &rest text)
-  "Ask QUESTION, displaying the rest of the arguments in a temporary buffer."
-  `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
-
-(defun message-talkative-question (ask question show &rest text)
-  "Call FUNCTION with argument QUESTION, displaying the rest of the arguments in a temporary buffer if SHOW.  
-The following arguments may contain lists of values."
-  (if (and show
-	   (setq text (message-flatten-list text)))
-      (save-window-excursion
-	(save-excursion
-	  (with-output-to-temp-buffer " *MESSAGE information message*"
-	    (set-buffer " *MESSAGE information message*")
-	    (mapcar 'princ text)
-	    (goto-char (point-min))))
-	(funcall ask question))
-    (funcall ask question)))
-
-(defun message-flatten-list (&rest list)
-  (message-flatten-list-1 list))
-
-(defun message-flatten-list-1 (list)
-  (cond ((consp list) 
-	 (apply 'nconc (mapcar 'message-flatten-list-1 list)))
-	(list
-	 (list list))))
-
-
-;;;
-;;; Message mode
-;;;
-
-;;; Set up keymap.
-
-(defvar message-mode-map nil)
-
-(unless message-mode-map
-  (setq message-mode-map (copy-keymap text-mode-map))
-  (define-key message-mode-map "\C-c?" 'describe-mode)
-
-  (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
-  (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
-  (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
-  (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
-  (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
-  (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
-  (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
-  (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
-  (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
-  (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
-  (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
-  (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
-  (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
-
-  (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
-  (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
-  
-  (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
-  (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
-  (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
-  (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
-  (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
-  (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
-
-  (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
-  (define-key message-mode-map "\C-c\C-s" 'message-send)
-  (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
-  (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
-
-  (define-key message-mode-map "\t" 'message-tab))
-
-(easy-menu-define message-mode-menu message-mode-map
-  "Message Menu."
-  '("Message"
-    "Go to Field:"
-    "----"
-    ["To" message-goto-to t]
-    ["Subject" message-goto-subject t]
-    ["Cc" message-goto-cc t]
-    ["Reply-to" message-goto-reply-to t]
-    ["Summary" message-goto-summary t]
-    ["Keywords" message-goto-keywords t]
-    ["Newsgroups" message-goto-newsgroups t]
-    ["Followup-To" message-goto-followup-to t]
-    ["Distribution" message-goto-distribution t]
-    ["Body" message-goto-body t]
-    ["Signature" message-goto-signature t]
-    "----"
-    "Miscellaneous Commands:"
-    "----"
-    ["Sort Headers" message-sort-headers t]
-    ["Yank Original" message-yank-original t]
-    ["Fill Yanked Message" message-fill-yanked-message t]
-    ["Insert Signature" message-insert-signature t]
-    ["Caesar (rot13) Message" message-caesar-buffer-body t]
-    ["Rename buffer" message-rename-buffer t]
-    ["Spellcheck" ispell-message t]
-    "----"
-    ["Send Message" message-send-and-exit t]
-    ["Abort Message" message-dont-send t]))
-
-(defvar facemenu-add-face-function)
-(defvar facemenu-remove-face-function)
-
-;;;###autoload
-(defun message-mode ()
-  "Major mode for editing mail and news to be sent.
-Like Text Mode but with these additional commands:
-C-c C-s  message-send (send the message)    C-c C-c  message-send-and-exit
-C-c C-f  move to a header field (and create it if there isn't):
-	 C-c C-f C-t  move to To	C-c C-f C-s  move to Subject
-	 C-c C-f C-c  move to Cc	C-c C-f C-b  move to Bcc
-	 C-c C-f C-f  move to Fcc	C-c C-f C-r  move to Reply-To
-	 C-c C-f C-u  move to Summary	C-c C-f C-n  move to Newsgroups
-	 C-c C-f C-k  move to Keywords	C-c C-f C-d  move to Distribution
-	 C-c C-f C-o  move to Followup-To
-C-c C-t  message-insert-to (add a To header to a news followup)
-C-c C-n  message-insert-newsgroups (add a Newsgroup header to a news reply)
-C-c C-b  message-goto-body (move to beginning of message text).
-C-c C-i  message-goto-signature (move to the beginning of the signature).
-C-c C-w  message-insert-signature (insert `message-signature-file' file).
-C-c C-y  message-yank-original (insert current message, if any).
-C-c C-q  message-fill-yanked-message (fill what was yanked).
-C-c C-r  message-caesar-buffer-body (rot13 the message body)."
-  (interactive)
-  (kill-all-local-variables)
-  (make-local-variable 'message-reply-buffer)
-  (setq message-reply-buffer nil)
-  (make-local-variable 'message-send-actions)
-  (make-local-variable 'message-exit-actions)
-  (make-local-variable 'message-kill-actions)
-  (make-local-variable 'message-postpone-actions)
-  (set-syntax-table message-mode-syntax-table)
-  (use-local-map message-mode-map)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (setq major-mode 'message-mode)
-  (setq mode-name "Message")
-  (setq buffer-offer-save t)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(message-font-lock-keywords t))
-  (make-local-variable 'facemenu-add-face-function)
-  (make-local-variable 'facemenu-remove-face-function)
-  (setq facemenu-add-face-function
-	(lambda (face end)
-	  (let ((face-fun (cdr (assq face message-face-alist))))
-	    (if face-fun
-		(funcall face-fun (point) end)
-	      (error "Face %s not configured for %s mode" face mode-name)))
-	  "")
-	facemenu-remove-face-function t)
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat (regexp-quote mail-header-separator)
-				"$\\|[ \t]*[-_][-_][-_]+$\\|"
-				"-- $\\|"
-				paragraph-start))
-  (setq paragraph-separate (concat (regexp-quote mail-header-separator)
-				   "$\\|[ \t]*[-_][-_][-_]+$\\|"
-				   "-- $\\|"
-				   paragraph-separate))
-  (make-local-variable 'message-reply-headers)
-  (setq message-reply-headers nil)
-  (make-local-variable 'message-newsreader)
-  (make-local-variable 'message-mailer)
-  (make-local-variable 'message-post-method)
-  (make-local-variable 'message-sent-message-via)
-  (setq message-sent-message-via nil)
-  (make-local-variable 'message-checksum)
-  (setq message-checksum nil)
-  ;;(when (fboundp 'mail-hist-define-keys)
-  ;;  (mail-hist-define-keys))
-  (when (string-match "XEmacs\\|Lucid" emacs-version)
-    (message-setup-toolbar))
-  (easy-menu-add message-mode-menu message-mode-map)
-  (run-hooks 'text-mode-hook 'message-mode-hook))
-
-
-
-;;;
-;;; Message mode commands
-;;;
-
-;;; Movement commands
-
-(defun message-goto-to ()
-  "Move point to the To header."
-  (interactive)
-  (message-position-on-field "To"))
-
-(defun message-goto-subject ()
-  "Move point to the Subject header."
-  (interactive)
-  (message-position-on-field "Subject"))
-
-(defun message-goto-cc ()
-  "Move point to the Cc header."
-  (interactive)
-  (message-position-on-field "Cc" "To"))
-
-(defun message-goto-bcc ()
-  "Move point to the Bcc  header."
-  (interactive)
-  (message-position-on-field "Bcc" "Cc" "To"))
-
-(defun message-goto-fcc ()
-  "Move point to the Fcc header."
-  (interactive)
-  (message-position-on-field "Fcc" "To" "Newsgroups"))
-
-(defun message-goto-reply-to ()
-  "Move point to the Reply-To header."
-  (interactive)
-  (message-position-on-field "Reply-To" "Subject"))
-
-(defun message-goto-newsgroups ()
-  "Move point to the Newsgroups header."
-  (interactive)
-  (message-position-on-field "Newsgroups"))
-
-(defun message-goto-distribution ()
-  "Move point to the Distribution header."
-  (interactive)
-  (message-position-on-field "Distribution"))
-
-(defun message-goto-followup-to ()
-  "Move point to the Followup-To header."
-  (interactive)
-  (message-position-on-field "Followup-To" "Newsgroups"))
-
-(defun message-goto-keywords ()
-  "Move point to the Keywords header."
-  (interactive)
-  (message-position-on-field "Keywords" "Subject"))
-
-(defun message-goto-summary ()
-  "Move point to the Summary header."
-  (interactive)
-  (message-position-on-field "Summary" "Subject"))
-
-(defun message-goto-body ()
-  "Move point to the beginning of the message body."
-  (interactive)
-  (if (looking-at "[ \t]*\n") (expand-abbrev))
-  (goto-char (point-min))
-  (search-forward (concat "\n" mail-header-separator "\n") nil t))
-
-(defun message-goto-signature ()
-  "Move point to the beginning of the message signature."
-  (interactive)
-  (goto-char (point-min))
-  (or (re-search-forward message-signature-separator nil t)
-      (goto-char (point-max))))
-
-
-
-(defun message-insert-to ()
-  "Insert a To header that points to the author of the article being replied to."
-  (interactive)
-  (when (and (message-position-on-field "To")
-	     (mail-fetch-field "to")
-	     (not (string-match "\\` *\\'" (mail-fetch-field "to"))))
-    (insert ", "))
-  (insert (or (message-fetch-reply-field "reply-to")
-	      (message-fetch-reply-field "from") "")))
-
-(defun message-insert-newsgroups ()
-  "Insert the Newsgroups header from the article being replied to."
-  (interactive)
-  (when (and (message-position-on-field "Newsgroups")
-	     (mail-fetch-field "newsgroups")
-	     (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
-    (insert ","))
-  (insert (or (message-fetch-reply-field "newsgroups") "")))
-
-
-
-;;; Various commands
-
-(defun message-insert-signature (&optional force)
-  "Insert a signature.  See documentation for the `message-signature' variable."
-  (interactive (list 0))
-  (let* ((signature 
-	  (cond ((and (null message-signature)
-		      (eq force 0))
-		 (save-excursion
-		   (goto-char (point-max))
-		   (not (re-search-backward
-			 message-signature-separator nil t))))
-		((and (null message-signature)
-		      force)
-		 t)
-		((message-functionp message-signature)
-		 (funcall message-signature))
-		((listp message-signature)
-		 (eval message-signature))
-		(t message-signature)))
-	 (signature
-	  (cond ((stringp signature)
-		 signature)
-		((and (eq t signature)
-		      message-signature-file
-		      (file-exists-p message-signature-file))
-		 signature))))
-    (when signature
-;      ;; Remove blank lines at the end of the message.
-      (goto-char (point-max))
-;      (skip-chars-backward " \t\n")
-;      (delete-region (point) (point-max))
-      ;; Insert the signature.
-      (unless (bolp)
-	(insert "\n"))
-      (insert "\n-- \n")
-      (if (eq signature t)
-	  (insert-file-contents message-signature-file)
-	(insert signature))
-      (goto-char (point-max))
-      (or (bolp) (insert "\n")))))
-
-(defvar message-caesar-translation-table nil)
-
-(defun message-caesar-region (b e &optional n)
-  "Caesar rotation of region by N, default 13, for decrypting netnews."
-  (interactive
-   (list
-    (min (point) (or (mark t) (point)))
-    (max (point) (or (mark t) (point)))
-    (when current-prefix-arg
-      (prefix-numeric-value current-prefix-arg))))
-
-  (setq n (if (numberp n) (mod n 26) 13)) ;canonize N
-  (unless (or (zerop n)			; no action needed for a rot of 0
-	      (= b e))			; no region to rotate
-    ;; We build the table, if necessary.
-    (when (or (not message-caesar-translation-table)
-	      (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
-      (let ((i -1) 
-	    (table (make-string 256 0)))
-	(while (< (incf i) 256)
-	  (aset table i i))
-	(setq table
-	      (concat
-	       (substring table 0 ?A)
-	       (substring table (+ ?A n) (+ ?A n (- 26 n)))
-	       (substring table ?A (+ ?A n))
-	       (substring table (+ ?A 26) ?a)
-	       (substring table (+ ?a n) (+ ?a n (- 26 n)))
-	       (substring table ?a (+ ?a n))
-	       (substring table (+ ?a 26) 255)))
-	(setq message-caesar-translation-table table)))
-    ;; Then we translate the region.  Do it this way to retain 
-    ;; text properties.
-    (while (< b e)
-      (subst-char-in-region 
-       b (1+ b) (char-after b)
-       (aref message-caesar-translation-table (char-after b)))
-      (incf b))))
-
-(defun message-caesar-buffer-body (&optional rotnum)
-  "Caesar rotates all letters in the current buffer by 13 places.
-Used to encode/decode possibly offensive messages (commonly in net.jokes).
-With prefix arg, specifies the number of places to rotate each letter forward.
-Mail and USENET news headers are not rotated."
-  (interactive (if current-prefix-arg
-		   (list (prefix-numeric-value current-prefix-arg))
-		 (list nil)))
-  (save-excursion
-    (save-restriction
-      (when (message-goto-body)
-	(narrow-to-region (point) (point-max)))
-      (message-caesar-region (point-min) (point-max) rotnum))))
-
-(defun message-rename-buffer (&optional enter-string)
-  "Rename the *message* buffer to \"*message* RECIPIENT\".  
-If the function is run with a prefix, it will ask for a new buffer
-name, rather than giving an automatic name."
-  (interactive "Pbuffer name: ")
-  (save-excursion
-    (save-restriction
-      (goto-char (point-min))
-      (narrow-to-region (point) 
-			(search-forward mail-header-separator nil 'end))
-      (let* ((mail-to (if (message-news-p) (message-fetch-field "Newsgroups")
-			(message-fetch-field "To")))
-	     (mail-trimmed-to
-	      (if (string-match "," mail-to)
-		  (concat (substring mail-to 0 (match-beginning 0)) ", ...")
-		mail-to))
-	     (name-default (concat "*message* " mail-trimmed-to))
-	     (name (if enter-string
-		       (read-string "New buffer name: " name-default)
-		     name-default)))
-	(rename-buffer name t)))))
-
-(defun message-fill-yanked-message (&optional justifyp)
-  "Fill the paragraphs of a message yanked into this one.
-Numeric argument means justify as well."
-  (interactive "P")
-  (save-excursion
-    (goto-char (point-min))
-    (search-forward (concat "\n" mail-header-separator "\n") nil t)
-    (let ((fill-prefix message-yank-prefix))
-      (fill-individual-paragraphs (point) (point-max) justifyp t))))
-
-(defun message-indent-citation ()
-  "Modify text just inserted from a message to be cited.
-The inserted text should be the region.
-When this function returns, the region is again around the modified text.
-
-Normally, indent each nonblank line `message-indentation-spaces' spaces.
-However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
-  (let ((start (point)))
-    ;; Remove unwanted headers.
-    (when message-ignored-cited-headers
-      (save-restriction
-	(narrow-to-region 
-	 (goto-char start)
-	 (if (search-forward "\n\n" nil t)
-	     (1- (point))
-	   (point)))
-	(message-remove-header message-ignored-cited-headers t)))
-    ;; Do the indentation.
-    (if (null message-yank-prefix)
-	(indent-rigidly start (mark t) message-indentation-spaces)
-      (save-excursion
-	(goto-char start)
-	(while (< (point) (mark t))
-	  (insert message-yank-prefix)
-	  (forward-line 1)))
-      (goto-char start))))
-
-(defun message-yank-original (&optional arg)
-  "Insert the message being replied to, if any.
-Puts point before the text and mark after.
-Normally indents each nonblank line ARG spaces (default 3).  However,
-if `message-yank-prefix' is non-nil, insert that prefix on each line.
-
-This function uses `message-cite-function' to do the actual citing.
-
-Just \\[universal-argument] as argument means don't indent, insert no
-prefix, and don't delete any headers."
-  (interactive "P")
-  (let ((modified (buffer-modified-p)))
-    (when (and message-reply-buffer
-	       message-cite-function)
-      (delete-windows-on message-reply-buffer t)
-      (insert-buffer message-reply-buffer)
-      (funcall message-cite-function)
-      (message-exchange-point-and-mark)
-      (unless (bolp)
-	(insert ?\n))
-      (unless modified
-	(setq message-checksum (cons (message-checksum) (buffer-size)))))))
-
-(defun message-cite-original ()    
-  (let ((start (point))
-	(functions 
-	 (when message-indent-citation-function
-	   (if (listp message-indent-citation-function)
-	       message-indent-citation-function
-	     (list message-indent-citation-function)))))
-    (goto-char start)
-    (while functions
-      (funcall (pop functions)))
-    (when message-citation-line-function
-      (unless (bolp)
-	(insert "\n"))
-      (funcall message-citation-line-function))))
-
-(defun message-insert-citation-line ()
-  "Function that inserts a simple citation line."
-  (when message-reply-headers
-    (insert (mail-header-from message-reply-headers) " writes:\n\n")))
-
-(defun message-position-on-field (header &rest afters)
-  (let ((case-fold-search t))
-    (save-restriction
-      (narrow-to-region
-       (goto-char (point-min))
-       (progn
-	 (re-search-forward 
-	  (concat "^" (regexp-quote mail-header-separator) "$"))
-	 (match-beginning 0)))
-      (goto-char (point-min))
-      (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t)
-	  (progn
-	    (re-search-forward "^[^ \t]" nil 'move)
-	    (beginning-of-line)
-	    (skip-chars-backward "\n")
-	    t)
-	(while (and afters
-		    (not (re-search-forward 
-			  (concat "^" (regexp-quote (car afters)) ":")
-			  nil t)))
-	  (pop afters))
-	(when afters
-	  (re-search-forward "^[^ \t]" nil 'move)
-	  (beginning-of-line))
-	(insert header ": \n")
-	(forward-char -1)
-	nil))))
-
-(defun message-remove-signature ()
-  "Remove the signature from the text between point and mark.
-The text will also be indented the normal way."
-  (save-excursion
-    (let ((start (point))
-	  mark)
-    (if (not (re-search-forward message-signature-separator (mark t) t))
-	;; No signature here, so we just indent the cited text.
-	(message-indent-citation)
-      ;; Find the last non-empty line.
-      (forward-line -1)
-      (while (looking-at "[ \t]*$")
-	(forward-line -1))
-      (forward-line 1)
-      (setq mark (set-marker (make-marker) (point)))
-      (goto-char start)
-      (message-indent-citation)
-      ;; Enable undoing the deletion.
-      (undo-boundary)
-      (delete-region mark (mark t))
-      (set-marker mark nil)))))
-
-
-
-;;;
-;;; Sending messages
-;;;
-
-(defun message-send-and-exit (&optional arg)
-  "Send message like `message-send', then, if no errors, exit from mail buffer."
-  (interactive "P")
-  (let ((buf (current-buffer))
-	(actions message-exit-actions))
-    (when (and (message-send arg)
-	       (buffer-name buf))
-      (if message-kill-buffer-on-exit
-	  (kill-buffer buf)
-	(bury-buffer buf)
-	(when (eq buf (current-buffer))
-	  (message-bury buf)))
-      (message-do-actions actions))))
-
-(defun message-dont-send ()
-  "Don't send the message you have been editing."
-  (interactive)
-  (message-bury (current-buffer))
-  (message-do-actions message-postpone-actions))
-
-(defun message-kill-buffer ()
-  "Kill the current buffer."
-  (interactive)
-  (let ((actions message-kill-actions))
-    (kill-buffer (current-buffer))
-    (message-do-actions actions)))
-
-(defun message-bury (buffer)
-  "Bury this mail buffer."
-  (let ((newbuf (other-buffer buffer)))
-    (bury-buffer buffer)
-    (if (and (fboundp 'frame-parameters)
-	     (cdr (assq 'dedicated (frame-parameters)))
-	     (not (null (delq (selected-frame) (visible-frame-list)))))
-	(delete-frame (selected-frame))
-      (switch-to-buffer newbuf))))
-
-(defun message-send (&optional arg)
-  "Send the message in the current buffer.
-If `message-interactive' is non-nil, wait for success indication
-or error messages, and inform user.
-Otherwise any failure is reported in a message back to
-the user from the mailer."
-  (interactive "P")
-  (when (if buffer-file-name
-	    (y-or-n-p (format "Send buffer contents as %s message? "
-			      (if (message-mail-p)
-				  (if (message-news-p) "mail and news" "mail")
-				"news")))
-	  (or (buffer-modified-p)
-	      (y-or-n-p "No changes in the buffer; really send? ")))
-    ;; Make it possible to undo the coming changes.
-    (undo-boundary)
-    (let ((inhibit-read-only t))
-      (put-text-property (point-min) (point-max) 'read-only nil))
-    (message-fix-before-sending)
-    (run-hooks 'message-send-hook)
-    (message "Sending...")
-    (when (and (or (not (message-news-p))
-		   (and (or (not (memq 'news message-sent-message-via))
-			    (y-or-n-p
-			     "Already sent message via news; resend? "))
-			(funcall message-send-news-function arg)))
-	       (or (not (message-mail-p))
-		   (and (or (not (memq 'mail message-sent-message-via))
-			    (y-or-n-p
-			     "Already sent message via mail; resend? "))
-			(message-send-mail arg))))
-      (message-do-fcc)
-      ;;(when (fboundp 'mail-hist-put-headers-into-history)
-      ;; (mail-hist-put-headers-into-history))
-      (run-hooks 'message-sent-hook)
-      (message "Sending...done")
-      ;; If buffer has no file, mark it as unmodified and delete autosave.
-      (unless buffer-file-name
-	(set-buffer-modified-p nil)
-	(delete-auto-save-file-if-necessary t))
-      ;; Delete other mail buffers and stuff.
-      (message-do-send-housekeeping)
-      (message-do-actions message-send-actions)
-      ;; Return success.
-      t)))
-
-(defun message-fix-before-sending ()
-  "Do various things to make the message nice before sending it."
-  ;; Make sure there's a newline at the end of the message.
-  (goto-char (point-max))
-  (unless (bolp)
-    (insert "\n")))
-
-(defun message-add-action (action &rest types)
-  "Add ACTION to be performed when doing an exit of type TYPES."
-  (let (var)
-    (while types
-      (set (setq var (intern (format "message-%s-actions" (pop types))))
-	   (nconc (symbol-value var) (list action))))))
-
-(defun message-do-actions (actions)
-  "Perform all actions in ACTIONS."
-  ;; Now perform actions on successful sending.
-  (while actions
-    (condition-case nil
-	(cond 
-	 ;; A simple function.
-	 ((message-functionp (car actions))
-	  (funcall (car actions)))
-	 ;; Something to be evaled.
-	 (t
-	  (eval (car actions))))
-      (error))
-    (pop actions)))
-
-(defun message-send-mail (&optional arg)
-  (require 'mail-utils)
-  (let ((tembuf (generate-new-buffer " message temp"))
-	(case-fold-search nil)
-	(news (message-news-p))
-	(mailbuf (current-buffer)))
-    (save-restriction
-      (message-narrow-to-headers)
-      ;; Insert some headers.
-      (let ((message-deletable-headers
-	     (if news nil message-deletable-headers)))
-	(message-generate-headers message-required-mail-headers))
-      ;; Let the user do all of the above.
-      (run-hooks 'message-header-hook))
-    (unwind-protect
-	(save-excursion
-	  (set-buffer tembuf)
-	  (erase-buffer)
-	  (insert-buffer-substring mailbuf)
-	  ;; Remove some headers.
-	  (save-restriction
-	    (message-narrow-to-headers)
-	    ;; Remove some headers.
-	    (message-remove-header message-ignored-mail-headers t))
-	  (goto-char (point-max))
-	  ;; require one newline at the end.
-	  (or (= (preceding-char) ?\n)
-	      (insert ?\n))
-	  (when (and news
-		     (or (message-fetch-field "cc")
-			 (message-fetch-field "to")))
-	    (message-insert-courtesy-copy))
-	  (funcall message-send-mail-function))
-      (kill-buffer tembuf))
-    (set-buffer mailbuf)
-    (push 'mail message-sent-message-via)))
-
-(defun message-send-mail-with-sendmail ()
-  "Send off the prepared buffer with sendmail."
-  (let ((errbuf (if message-interactive
-		    (generate-new-buffer " sendmail errors")
-		  0))
-	resend-to-addresses delimline)
-    (let ((case-fold-search t))
-      (save-restriction
-	(message-narrow-to-headers)
-	(setq resend-to-addresses (message-fetch-field "resent-to")))
-      ;; Change header-delimiter to be what sendmail expects.
-      (goto-char (point-min))
-      (re-search-forward
-       (concat "^" (regexp-quote mail-header-separator) "\n"))
-      (replace-match "\n")
-      (backward-char 1)
-      (setq delimline (point-marker))
-      ;; Insert an extra newline if we need it to work around
-      ;; Sun's bug that swallows newlines.
-      (goto-char (1+ delimline))
-      (when (eval message-mailer-swallows-blank-line)
-	(newline))
-      (when message-interactive
-	(save-excursion
-	  (set-buffer errbuf)
-	  (erase-buffer))))
-    (let ((default-directory "/"))
-      (apply 'call-process-region
-	     (append (list (point-min) (point-max)
-			   (if (boundp 'sendmail-program)
-			       sendmail-program
-			     "/usr/lib/sendmail")
-			   nil errbuf nil "-oi")
-		     ;; Always specify who from,
-		     ;; since some systems have broken sendmails.
-		     (list "-f" (user-login-name))
-		     ;; These mean "report errors by mail"
-		     ;; and "deliver in background".
-		     (if (null message-interactive) '("-oem" "-odb"))
-		     ;; Get the addresses from the message
-		     ;; unless this is a resend.
-		     ;; We must not do that for a resend
-		     ;; because we would find the original addresses.
-		     ;; For a resend, include the specific addresses.
-		     (if resend-to-addresses
-			 (list resend-to-addresses)
-		       '("-t")))))
-    (when message-interactive
-      (save-excursion
-	(set-buffer errbuf)
-	(goto-char (point-min))
-	(while (re-search-forward "\n\n* *" nil t)
-	  (replace-match "; "))
-	(if (not (zerop (buffer-size)))
-	    (error "Sending...failed to %s"
-		   (buffer-substring (point-min) (point-max)))))
-      (when (bufferp errbuf)
-	(kill-buffer errbuf)))))
-
-(defun message-send-mail-with-mh ()
-  "Send the prepared message buffer with mh."
-  (let ((mh-previous-window-config nil)
-	(name (make-temp-name
-	       (concat (file-name-as-directory message-autosave-directory)
-		       "msg."))))
-    (setq buffer-file-name name)
-    (mh-send-letter)
-    (condition-case ()
-	(delete-file name)
-      (error nil))))
-
-(defun message-send-news (&optional arg)
-  (let ((tembuf (generate-new-buffer " *message temp*"))
-	(case-fold-search nil)
-	(method (if (message-functionp message-post-method)
-		    (funcall message-post-method arg)
-		  message-post-method))
-	(messbuf (current-buffer))
-	(message-syntax-checks
-	 (if arg
-	     (cons '(existing-newsgroups . disabled)
-		   message-syntax-checks)
-	   message-syntax-checks))
-	result)
-    (save-restriction
-      (message-narrow-to-headers)
-      ;; Insert some headers.
-      (message-generate-headers message-required-news-headers)
-      ;; Let the user do all of the above.
-      (run-hooks 'message-header-hook))
-    (message-cleanup-headers)
-    (when (message-check-news-syntax)
-      (unwind-protect
-	  (save-excursion
-	    (set-buffer tembuf)
-	    (buffer-disable-undo (current-buffer))
-	    (erase-buffer) 
-	    (insert-buffer-substring messbuf)
-	    ;; Remove some headers.
-	    (save-restriction
-	      (message-narrow-to-headers)
-	      ;; Remove some headers.
-	      (message-remove-header message-ignored-news-headers t))
-	    (goto-char (point-max))
-	    ;; require one newline at the end.
-	    (or (= (preceding-char) ?\n)
-		(insert ?\n))
-	    (let ((case-fold-search t))
-	      ;; Remove the delimeter.
-	      (goto-char (point-min))
-	      (re-search-forward
-	       (concat "^" (regexp-quote mail-header-separator) "\n"))
-	      (replace-match "\n")
-	      (backward-char 1))
-	    (require (car method))
-	    (funcall (intern (format "%s-open-server" (car method)))
-		     (cadr method) (cddr method))
-	    (setq result
-		  (funcall (intern (format "%s-request-post" (car method))))))
-	(kill-buffer tembuf))
-      (set-buffer messbuf)
-      (if result
-	  (push 'news message-sent-message-via)
-	(message "Couldn't send message via news: %s"
-		 (nnheader-get-report (car method)))
-	nil))))
-
-;;;
-;;; Header generation & syntax checking.
-;;;
-
-(defun message-check-news-syntax ()
-  "Check the syntax of the message."
-  (and 
-   ;; We narrow to the headers and check them first.
-   (save-excursion
-     (save-restriction
-       (message-narrow-to-headers)
-       (and 
-	;; Check for commands in Subject.
-	(or 
-	 (message-check-element 'subject-cmsg)
-	 (save-excursion
-	   (if (string-match "^cmsg " (message-fetch-field "subject"))
-	       (y-or-n-p
-		"The control code \"cmsg \" is in the subject. Really post? ")
-	     t)))
-	;; Check for multiple identical headers.
-	(or (message-check-element 'multiple-headers)
-	    (save-excursion
-	      (let (found)
-		(while (and (not found) 
-			    (re-search-forward "^[^ \t:]+: " nil t))
-		  (save-excursion
-		    (or (re-search-forward 
-			 (concat "^" (setq found
-					   (buffer-substring 
-					    (match-beginning 0) 
-					    (- (match-end 0) 2))))
-			 nil t)
-			(setq found nil))))
-		(if found
-		    (y-or-n-p 
-		     (format "Multiple %s headers. Really post? " found))
-		  t))))
-	;; Check for Version and Sendsys.
-	(or (message-check-element 'sendsys)
-	    (save-excursion
-	      (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
-		  (y-or-n-p
-		   (format "The article contains a %s command. Really post? "
-			   (buffer-substring (match-beginning 0) 
-					     (1- (match-end 0)))))
-		t)))
-	;; See whether we can shorten Followup-To.
-	(or (message-check-element 'shorten-followup-to)
-	    (let ((newsgroups (message-fetch-field "newsgroups"))
-		  (followup-to (message-fetch-field "followup-to"))
-		  to)
-	      (when (and newsgroups (string-match "," newsgroups)
-			 (not followup-to)
-			 (not
-			  (zerop
-			   (length
-			    (setq to (completing-read 
-				      "Followups to: (default all groups) " 
-				      (mapcar (lambda (g) (list g))
-					      (cons "poster" 
-						    (message-tokenize-header 
-						     newsgroups)))))))))
-		(goto-char (point-min))
-		(insert "Followup-To: " to "\n"))
-	      t))
-	;; Check "Shoot me".
-	(or (message-check-element 'shoot)
-	    (save-excursion
-	      (if (re-search-forward
-		   "Message-ID.*.i-have-a-misconfigured-system-so-shoot-me"
-		   nil t)
-		  (y-or-n-p
-		   "You appear to have a misconfigured system.  Really post? ")
-		t)))
-	;; Check for Approved.
-	(or (message-check-element 'approved)
-	    (save-excursion
-	      (if (re-search-forward "^Approved:" nil t)
-		  (y-or-n-p
-		   "The article contains an Approved header. Really post? ")
-		t)))
-	;; Check the Message-Id header.
-	(or (message-check-element 'message-id)
-	    (save-excursion
-	      (let* ((case-fold-search t)
-		     (message-id (message-fetch-field "message-id")))
-		(or (not message-id)
-		    (and (string-match "@" message-id)
-			 (string-match "@[^\\.]*\\." message-id))
-		    (y-or-n-p
-		     (format 
-		      "The Message-ID looks strange: \"%s\". Really post? "
-		      message-id))))))
-	;; Check the Subject header.
-	(or 
-	 (message-check-element 'subject)
-	 (save-excursion
-	   (let* ((case-fold-search t)
-		  (subject (message-fetch-field "subject")))
-	     (or
-	      (and subject
-		   (not (string-match "\\`[ \t]*\\'" subject)))
-	      (progn
-		(message 
-		 "The subject field is empty or missing.  Posting is denied.")
-		nil)))))
-	;; Check the Newsgroups & Followup-To headers.
-	(or
-	 (message-check-element 'existing-newsgroups)
-	 (let* ((case-fold-search t)
-		(newsgroups (message-fetch-field "newsgroups"))
-		(followup-to (message-fetch-field "followup-to"))
-		(groups (message-tokenize-header
-			 (if followup-to
-			     (concat newsgroups "," followup-to)
-			   newsgroups)))
-		(hashtb (and (boundp 'gnus-active-hashtb)
-			     gnus-active-hashtb))
-		errors)
-	   (if (not hashtb)
-	       t
-	     (while groups
-	       (when (and (not (boundp (intern (car groups) hashtb)))
-			  (not (equal (car groups) "poster")))
-		 (push (car groups) errors))
-	       (pop groups))
-	     (if (not errors)
-		 t
-	       (y-or-n-p
-		(format
-		 "Really post to %s unknown group%s: %s "
-		 (if (= (length errors) 1) "this" "these")
-		 (if (= (length errors) 1) "" "s")
-		 (mapconcat 'identity errors ", ")))))))
-	;; Check the Newsgroups & Followup-To headers for syntax errors.
-	(or
-	 (message-check-element 'valid-newsgroups)
-	 (let ((case-fold-search t)
-	       (headers '("Newsgroups" "Followup-To"))
-	       header error)
-	   (while (and headers (not error))
-	     (when (setq header (mail-fetch-field (car headers)))
-	       (if (or
-		    (not 
-		     (string-match
-		      "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-.a-zA-Z0-9]+\\)*\\'"
-		      header))
-		    (memq 
-		     nil (mapcar 
-			  (lambda (g)
-			    (not (string-match "\\.\\'\\|\\.\\." g)))
-			  (message-tokenize-header header ","))))
-		   (setq error t)))
-	     (unless error
-	       (pop headers)))
-	   (if (not error)
-	       t
-	     (y-or-n-p
-	      (format "The %s header looks odd: \"%s\".  Really post? "
-		      (car headers) header)))))
-	;; Check the From header.
-	(or 
-	 (save-excursion
-	   (let* ((case-fold-search t)
-		  (from (message-fetch-field "from")))
-	     (cond
-	      ((not from)
-	       (message "There is no From line.  Posting is denied.")
-	       nil)
-	      ((not (string-match "@[^\\.]*\\." from))
-	       (message
-		"Denied posting -- the From looks strange: \"%s\"." from)
-	       nil)
-	      ((string-match "@[^@]*@" from)
-	       (message 
-		"Denied posting -- two \"@\"'s in the From header: %s." from)
-	       nil)
-	      ((string-match "(.*).*(.*)" from)
-	       (message
-		"Denied posting -- the From header looks strange: \"%s\"." 
-		from)
-	       nil)
-	      (t t))))))))
-   ;; Check for long lines.
-   (or (message-check-element 'long-lines)
-       (save-excursion
-	 (goto-char (point-min))
-	 (re-search-forward
-	  (concat "^" (regexp-quote mail-header-separator) "$"))
-	 (while (and
-		 (progn
-		   (end-of-line)
-		   (< (current-column) 80))
-		 (zerop (forward-line 1))))
-	 (or (bolp)
-	     (eobp)
-	     (y-or-n-p
-	      "You have lines longer than 79 characters.  Really post? "))))
-   ;; Check whether the article is empty.
-   (or (message-check-element 'empty)
-       (save-excursion
-	 (goto-char (point-min))
-	 (re-search-forward
-	  (concat "^" (regexp-quote mail-header-separator) "$"))
-	 (forward-line 1)
-	 (let ((b (point)))
-	   (or (re-search-forward message-signature-separator nil t)
-	       (goto-char (point-max)))
-	   (beginning-of-line)
-	   (or (re-search-backward "[^ \n\t]" b t)
-	       (y-or-n-p "Empty article.  Really post? ")))))
-   ;; Check for control characters.
-   (or (message-check-element 'control-chars)
-       (save-excursion
-	 (if (re-search-forward "[\000-\007\013\015-\037\200-\237]" nil t)
-	     (y-or-n-p 
-	      "The article contains control characters. Really post? ")
-	   t)))
-   ;; Check excessive size.
-   (or (message-check-element 'size)
-       (if (> (buffer-size) 60000)
-	   (y-or-n-p
-	    (format "The article is %d octets long. Really post? "
-		    (buffer-size)))
-	 t))
-   ;; Check whether any new text has been added.
-   (or (message-check-element 'new-text)
-       (not message-checksum)
-       (not (and (eq (message-checksum) (car message-checksum))
-		 (eq (buffer-size) (cdr message-checksum))))
-       (y-or-n-p
-	"It looks like no new text has been added.  Really post? "))
-   ;; Check the length of the signature.
-   (or
-    (message-check-element 'signature)
-    (progn
-      (goto-char (point-max))
-      (if (or (not (re-search-backward "^-- $" nil t))
-	      (search-forward message-forward-end-separator nil t))
-	  t
-	(if (> (count-lines (point) (point-max)) 5)
-	    (y-or-n-p
-	     (format
-	      "Your .sig is %d lines; it should be max 4.  Really post? "
-	      (count-lines (point) (point-max))))
-	  t))))))
-
-(defun message-check-element (type)
-  "Returns non-nil if this type is not to be checked."
-  (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
-      t
-    (let ((able (assq type message-syntax-checks)))
-      (and (consp able)
-	   (eq (cdr able) 'disabled)))))
-
-(defun message-checksum ()
-  "Return a \"checksum\" for the current buffer."
-  (let ((sum 0))
-    (save-excursion
-      (goto-char (point-min))
-      (re-search-forward
-       (concat "^" (regexp-quote mail-header-separator) "$"))
-      (while (not (eobp))
-	(when (not (looking-at "[ \t\n]"))
-	  (setq sum (logxor (ash sum 1) (following-char))))
-	(forward-char 1)))
-    sum))
-
-(defun message-do-fcc ()
-  "Process Fcc headers in the current buffer."
-  (let ((case-fold-search t)
-	(buf (current-buffer))
-	list file)
-    (save-excursion
-      (set-buffer (get-buffer-create " *message temp*"))
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (insert-buffer-substring buf)
-      (save-restriction
-	(message-narrow-to-headers)
-	(while (setq file (message-fetch-field "fcc"))
-	  (push file list)
-	  (message-remove-header "fcc" nil t)))
-      (goto-char (point-min))
-      (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
-      (replace-match "" t t)
-      ;; Process FCC operations.
-      (while list
-	(setq file (pop list))
-	(if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
-	    ;; Pipe the article to the program in question.
-	    (call-process-region (point-min) (point-max) shell-file-name
-				 nil nil nil shell-command-switch
-				 (match-string 1 file))
-	  ;; Save the article.
-	  (setq file (expand-file-name file))
-	  (unless (file-exists-p (file-name-directory file))
-	    (make-directory (file-name-directory file) t))
-	  (if (and message-fcc-handler-function
-		   (not (eq message-fcc-handler-function 'rmail-output)))
-	      (funcall message-fcc-handler-function file)
-	    (if (and (file-readable-p file) (mail-file-babyl-p file))
-		(rmail-output file 1 nil t)
-	      (let ((mail-use-rfc822 t))
-		(rmail-output file 1 t t))))))
-      (kill-buffer (current-buffer)))))
-
-(defun message-cleanup-headers ()
-  "Do various automatic cleanups of the headers."
-  ;; Remove empty lines in the header.
-  (save-restriction
-    (message-narrow-to-headers)
-    (while (re-search-forward "^[ \t]*\n" nil t)
-      (replace-match "" t t)))
-
-  ;; Correct Newsgroups and Followup-To headers: change sequence of
-  ;; spaces to comma and eliminate spaces around commas.  Eliminate
-  ;; embedded line breaks.
-  (goto-char (point-min))
-  (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
-    (save-restriction
-      (narrow-to-region
-       (point)
-       (if (re-search-forward "^[^ \t]" nil t)
-	   (match-beginning 0)
-	 (forward-line 1)
-	 (point)))
-      (goto-char (point-min))
-      (while (re-search-forward "\n[ \t]+" nil t)
-	(replace-match " " t t))	;No line breaks (too confusing)
-      (goto-char (point-min))
-      (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
-	(replace-match "," t t))
-      (goto-char (point-min))
-      ;; Remove trailing commas.
-      (when (re-search-forward ",+$" nil t)
-	(replace-match "" t t)))))
-
-(defun message-make-date ()
-  "Make a valid data header."
-  (let ((now (current-time)))
-    (timezone-make-date-arpa-standard 
-     (current-time-string now) (current-time-zone now))))
-
-(defun message-make-message-id ()
-  "Make a unique Message-ID."
-  (concat "<" (message-unique-id) 
-	  (let ((psubject (save-excursion (message-fetch-field "subject"))))
-	    (if (and message-reply-headers
-		     (mail-header-references message-reply-headers)
-		     (mail-header-subject message-reply-headers)
-		     psubject
-		     (mail-header-subject message-reply-headers)
-		     (not (string= 
-			   (message-strip-subject-re
-			    (mail-header-subject message-reply-headers))
-			   (message-strip-subject-re psubject))))
-		"_-_" ""))
-	  "@" (message-make-fqdn) ">"))
-
-(defvar message-unique-id-char nil)
-
-;; If you ever change this function, make sure the new version
-;; cannot generate IDs that the old version could.
-;; You might for example insert a "." somewhere (not next to another dot
-;; or string boundary), or modify the "fsf" string.
-(defun message-unique-id ()
-  ;; Don't use microseconds from (current-time), they may be unsupported.
-  ;; Instead we use this randomly inited counter.
-  (setq message-unique-id-char
-	(% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20)))))
-	   ;; (current-time) returns 16-bit ints,
-	   ;; and 2^16*25 just fits into 4 digits i base 36.
-	   (* 25 25)))
-  (let ((tm (current-time)))
-    (concat
-     (if (memq system-type '(ms-dos emx vax-vms))
-	 (let ((user (downcase (user-login-name))))
-	   (while (string-match "[^a-z0-9_]" user)
-	     (aset user (match-beginning 0) ?_))
-	   user)
-       (message-number-base36 (user-uid) -1))
-     (message-number-base36 (+ (car   tm) 
-			       (lsh (% message-unique-id-char 25) 16)) 4)
-     (message-number-base36 (+ (nth 1 tm)
-			       (lsh (/ message-unique-id-char 25) 16)) 4)
-     ;; Append the newsreader name, because while the generated
-     ;; ID is unique to this newsreader, other newsreaders might
-     ;; otherwise generate the same ID via another algorithm.
-     ".fsf")))
-
-(defun message-number-base36 (num len)
-  (if (if (< len 0) (<= num 0) (= len 0))
-      ""
-    (concat (message-number-base36 (/ num 36) (1- len))
-	    (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
-				  (% num 36))))))
-
-(defun message-make-organization ()
-  "Make an Organization header."
-  (let* ((organization 
-	  (or (getenv "ORGANIZATION")
-	      (when message-user-organization
-		(if (message-functionp message-user-organization)
-		    (funcall message-user-organization)
-		  message-user-organization)))))
-    (save-excursion
-      (message-set-work-buffer)
-      (cond ((stringp organization)
-	     (insert organization))
-	    ((and (eq t organization)
-		  message-user-organization-file
-		  (file-exists-p message-user-organization-file))
-	     (insert-file-contents message-user-organization-file)))
-      (goto-char (point-min))
-      (while (re-search-forward "[\t\n]+" nil t)
-	(replace-match "" t t))
-      (unless (zerop (buffer-size))
-	(buffer-string)))))
-
-(defun message-make-lines ()
-  "Count the number of lines and return numeric string."
-  (save-excursion
-    (save-restriction
-      (widen)
-      (goto-char (point-min))
-      (re-search-forward 
-       (concat "^" (regexp-quote mail-header-separator) "$"))
-      (forward-line 1)
-      (int-to-string (count-lines (point) (point-max))))))
-
-(defun message-make-in-reply-to ()
-  "Return the In-Reply-To header for this message."
-  (when message-reply-headers
-    (let ((from (mail-header-from message-reply-headers))
-	  (date (mail-header-date message-reply-headers)))
-      (when from
-	(let ((stop-pos 
-	       (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
-	  (concat (if stop-pos (substring from 0 stop-pos) from)
-		  "'s message of " 
-		  (if (or (not date) (string= date ""))
-		      "(unknown date)" date)))))))
-
-(defun message-make-distribution ()
-  "Make a Distribution header."
-  (let ((orig-distribution (message-fetch-reply-field "distribution")))
-    (cond ((message-functionp message-distribution-function)
-	   (funcall message-distribution-function))
-	  (t orig-distribution))))
-
-(defun message-make-expires ()
-  "Return an Expires header based on `message-expires'."
-  (let ((current (current-time))
-	(future (* 1.0 message-expires 60 60 24)))
-    ;; Add the future to current.
-    (setcar current (+ (car current) (round (/ future (expt 2 16)))))
-    (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
-    ;; Return the date in the future in UT.
-    (timezone-make-date-arpa-standard 
-     (current-time-string current) (current-time-zone current) '(0 "UT"))))
-
-(defun message-make-path ()
-  "Return uucp path."
-  (let ((login-name (user-login-name)))
-    (cond ((null message-user-path)
-	   (concat (system-name) "!" login-name))
-	  ((stringp message-user-path)
-	   ;; Support GENERICPATH.  Suggested by vixie@decwrl.dec.com.
-	   (concat message-user-path "!" login-name))
-	  (t login-name))))
-
-(defun message-make-from ()
-  "Make a From header."
-  (let* ((login (message-make-address))
-	 (fullname 
-	  (or (and (boundp 'user-full-name)
-		   user-full-name)
-	      (user-full-name))))
-    (when (string= fullname "&")
-      (setq fullname (user-login-name)))
-    (save-excursion
-      (message-set-work-buffer)
-      (cond 
-       ((or (null message-from-style)
-	    (equal fullname ""))
-	(insert login))
-       ((or (eq message-from-style 'angles)
-	    (and (not (eq message-from-style 'parens))
-		 ;; Use angles if no quoting is needed, or if parens would
-		 ;; need quoting too.
-		 (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname))
-		     (let ((tmp (concat fullname nil)))
-		       (while (string-match "([^()]*)" tmp)
-			 (aset tmp (match-beginning 0) ?-)
-			 (aset tmp (1- (match-end 0)) ?-))
-		       (string-match "[\\()]" tmp)))))
-	(insert fullname)
-	(goto-char (point-min))
-	;; Look for a character that cannot appear unquoted
-	;; according to RFC 822.
-	(when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
-	  ;; Quote fullname, escaping specials.
-	  (goto-char (point-min))
-	  (insert "\"")
-	  (while (re-search-forward "[\"\\]" nil 1)
-	    (replace-match "\\\\\\&" t))
-	  (insert "\""))
-	(insert " <" login ">"))
-       (t				; 'parens or default
-	(insert login " (")
-	(let ((fullname-start (point)))
-	  (insert fullname)
-	  (goto-char fullname-start)
-	  ;; RFC 822 says \ and nonmatching parentheses
-	  ;; must be escaped in comments.
-	  ;; Escape every instance of ()\ ...
-	  (while (re-search-forward "[()\\]" nil 1)
-	    (replace-match "\\\\\\&" t))
-	  ;; ... then undo escaping of matching parentheses,
-	  ;; including matching nested parentheses.
-	  (goto-char fullname-start)
-	  (while (re-search-forward 
-		  "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
-		    nil 1)
-	    (replace-match "\\1(\\3)" t)
-	    (goto-char fullname-start)))
-	(insert ")")))
-      (buffer-string))))
-
-(defun message-make-sender ()
-  "Return the \"real\" user address.
-This function tries to ignore all user modifications, and 
-give as trustworthy answer as possible."
-  (concat (user-login-name) "@" (system-name)))
-
-(defun message-make-address ()
-  "Make the address of the user."
-  (or (message-user-mail-address)
-      (concat (user-login-name) "@" (message-make-domain))))
-
-(defun message-user-mail-address ()
-  "Return the pertinent part of `user-mail-address'."
-  (when user-mail-address
-    (nth 1 (mail-extract-address-components user-mail-address))))
-
-(defun message-make-fqdn ()
-  "Return user's fully qualified domain name."
-  (let ((system-name (system-name))
-	(user-mail (message-user-mail-address)))
-    (cond 
-     ((string-match "[^.]\\.[^.]" system-name)
-      ;; `system-name' returned the right result.
-      system-name)
-     ;; Try `mail-host-address'.
-     ((and (boundp 'mail-host-address)
-	   (stringp mail-host-address)
-	   (string-match "\\." mail-host-address))
-      mail-host-address)
-     ;; We try `user-mail-address' as a backup.
-     ((and (string-match "\\." user-mail)
-	   (string-match "@\\(.*\\)\\'" user-mail))
-      (match-string 1 user-mail))
-     ;; Default to this bogus thing.
-     (t
-      (concat system-name ".i-have-a-misconfigured-system-so-shoot-me")))))
-
-(defun message-make-host-name ()
-  "Return the name of the host."
-  (let ((fqdn (message-make-fqdn)))
-    (string-match "^[^.]+\\." fqdn)
-    (substring fqdn 0 (1- (match-end 0)))))
-
-(defun message-make-domain ()
-  "Return the domain name."
-  (or mail-host-address
-      (message-make-fqdn)))
-
-(defun message-generate-headers (headers)
-  "Prepare article HEADERS.
-Headers already prepared in the buffer are not modified."
-  (save-restriction
-    (message-narrow-to-headers)
-    (let* ((Date (message-make-date))
-	   (Message-ID (message-make-message-id))
-	   (Organization (message-make-organization))
-	   (From (message-make-from))
-	   (Path (message-make-path))
-	   (Subject nil)
-	   (Newsgroups nil)
-	   (In-Reply-To (message-make-in-reply-to))
-	   (To nil)
-	   (Distribution (message-make-distribution))
-	   (Lines (message-make-lines))
-	   (X-Newsreader message-newsreader)
-	   (X-Mailer (and (not (message-fetch-field "X-Newsreader"))
-			  message-mailer))
-	   (Expires (message-make-expires))
-	   (case-fold-search t)
-	   header value elem)
-      ;; First we remove any old generated headers.
-      (let ((headers message-deletable-headers))
-	(while headers
-	  (goto-char (point-min))
-	  (and (re-search-forward 
-		(concat "^" (symbol-name (car headers)) ": *") nil t)
-	       (get-text-property (1+ (match-beginning 0)) 'message-deletable)
-	       (message-delete-line))
-	  (pop headers)))
-      ;; Go through all the required headers and see if they are in the
-      ;; articles already. If they are not, or are empty, they are
-      ;; inserted automatically - except for Subject, Newsgroups and
-      ;; Distribution. 
-      (while headers
-	(goto-char (point-min))
-	(setq elem (pop headers))
-	(if (consp elem)
-	    (if (eq (car elem) 'optional)
-		(setq header (cdr elem))
-	      (setq header (car elem)))
-	  (setq header elem))
-	(when (or (not (re-search-forward 
-			(concat "^" (downcase (symbol-name header)) ":") 
-			nil t))
-		  (progn
-		    ;; The header was found. We insert a space after the
-		    ;; colon, if there is none.
-		    (if (/= (following-char) ? ) (insert " ") (forward-char 1))
-		    ;; Find out whether the header is empty...
-		    (looking-at "[ \t]*$")))
-	  ;; So we find out what value we should insert.
-	  (setq value
-		(cond 
-		 ((and (consp elem) (eq (car elem) 'optional))
-		  ;; This is an optional header.  If the cdr of this
-		  ;; is something that is nil, then we do not insert
-		  ;; this header.
-		  (setq header (cdr elem))
-		  (or (and (fboundp (cdr elem)) (funcall (cdr elem)))
-		      (and (boundp (cdr elem)) (symbol-value (cdr elem)))))
-		 ((consp elem)
-		  ;; The element is a cons.  Either the cdr is a
-		  ;; string to be inserted verbatim, or it is a
-		  ;; function, and we insert the value returned from
-		  ;; this function.
-		  (or (and (stringp (cdr elem)) (cdr elem))
-		      (and (fboundp (cdr elem)) (funcall (cdr elem)))))
-		 ((and (boundp header) (symbol-value header))
-		  ;; The element is a symbol.  We insert the value
-		  ;; of this symbol, if any.
-		  (symbol-value header))
-		 (t
-		  ;; We couldn't generate a value for this header,
-		  ;; so we just ask the user.
-		  (read-from-minibuffer
-		   (format "Empty header for %s; enter value: " header)))))
-	  ;; Finally insert the header.
-	  (when (and value 
-		     (not (equal value "")))
-	    (save-excursion
-	      (if (bolp)
-		  (progn
-		    ;; This header didn't exist, so we insert it.
-		    (goto-char (point-max))
-		    (insert (symbol-name header) ": " value "\n")
-		    (forward-line -1))
-		;; The value of this header was empty, so we clear
-		;; totally and insert the new value.
-		(delete-region (point) (message-point-at-eol))
-		(insert value))
-	      ;; Add the deletable property to the headers that require it.
-	      (and (memq header message-deletable-headers)
-		   (progn (beginning-of-line) (looking-at "[^:]+: "))
-		   (add-text-properties 
-		    (point) (match-end 0)
-		    '(message-deletable t face italic) (current-buffer)))))))
-      ;; Insert new Sender if the From is strange. 
-      (let ((from (message-fetch-field "from"))
-	    (sender (message-fetch-field "sender"))
-	    (secure-sender (message-make-sender)))
-	(when (and from 
-		   (not (message-check-element 'sender))
-		   (not (string=
-			 (downcase
-			  (cadr (mail-extract-address-components from)))
-			 (downcase secure-sender)))
-		   (or (null sender)
-		       (not 
-			(string=
-			 (downcase
-			  (cadr (mail-extract-address-components sender)))
-			 (downcase secure-sender)))))
-	  (goto-char (point-min))    
-	  ;; Rename any old Sender headers to Original-Sender.
-	  (when (re-search-forward "^Sender:" nil t)
-	    (beginning-of-line)
-	    (insert "Original-")
-	    (beginning-of-line))
-	  (insert "Sender: " secure-sender "\n"))))))
-
-(defun message-insert-courtesy-copy ()
-  "Insert a courtesy message in mail copies of combined messages."
-  (save-excursion
-    (save-restriction
-      (message-narrow-to-headers)
-      (let ((newsgroups (message-fetch-field "newsgroups")))
-	(when newsgroups
-	  (goto-char (point-max))
-	  (insert "Posted-To: " newsgroups "\n"))))
-    (forward-line 1)
-    (insert message-courtesy-message)))
-    
-;;;
-;;; Setting up a message buffer
-;;;
-
-(defun message-fill-address (header value)
-  (save-restriction
-    (narrow-to-region (point) (point))
-    (insert (capitalize (symbol-name header))
-	    ": "
-	    (if (consp value) (car value) value)
-	    "\n")
-    (narrow-to-region (point-min) (1- (point-max)))
-    (let (quoted last)
-      (goto-char (point-min))
-      (while (not (eobp))
-	(skip-chars-forward "^,\"" (point-max))
-	(if (or (= (following-char) ?,)
-		(eobp))
-	    (when (not quoted)
-	      (if (and (> (current-column) 78)
-		       last)
-		  (progn
-		    (save-excursion
-		      (goto-char last)
-		      (insert "\n\t"))
-		    (setq last (1+ (point))))
-		(setq last (1+ (point)))))
-	  (setq quoted (not quoted)))
-	(unless (eobp)
-	  (forward-char 1))))
-    (goto-char (point-max))
-    (widen)
-    (forward-line 1)))
-
-(defun message-fill-header (header value)
-  (let ((begin (point))
-	(fill-column 78)
-	(fill-prefix "\t"))
-    (insert (capitalize (symbol-name header))
-	    ": "
-	    (if (consp value) (car value) value)
-	    "\n")
-    (save-restriction
-      (narrow-to-region begin (point))
-      (fill-region-as-paragraph begin (point))
-      ;; Tapdance around looong Message-IDs.
-      (forward-line -1)
-      (when (looking-at "[ \t]*$")
-	(message-delete-line))
-      (goto-char begin)
-      (re-search-forward ":" nil t)
-      (when (looking-at "\n[ \t]+")
-	(replace-match " " t t))
-      (goto-char (point-max)))))
-
-(defun message-position-point ()
-  "Move point to where the user probably wants to find it."
-  (message-narrow-to-headers)
-  (cond 
-   ((re-search-forward "^[^:]+:[ \t]*$" nil t)
-    (search-backward ":" )
-    (widen)
-    (forward-char 1)
-    (if (= (following-char) ? )
-	(forward-char 1)
-      (insert " ")))
-   (t
-    (goto-char (point-max))
-    (widen)
-    (forward-line 1)
-    (unless (looking-at "$")
-      (forward-line 2)))
-   (sit-for 0)))
-
-(defun message-buffer-name (type &optional to group)
-  "Return a new (unique) buffer name based on TYPE and TO."
-  (cond
-   ;; Check whether `message-generate-new-buffers' is a function, 
-   ;; and if so, call it.
-   ((message-functionp message-generate-new-buffers)
-    (funcall message-generate-new-buffers type to group))
-   ;; Generate a new buffer name The Message Way.
-   (message-generate-new-buffers
-    (generate-new-buffer-name
-     (concat "*" type
-	     (if to
-		 (concat " to "
-			 (or (car (mail-extract-address-components to))
-			     to) "")
-	       "")
-	     (if (and group (not (string= group ""))) (concat " on " group) "")
-	     "*")))
-   ;; Use standard name.
-   (t
-    (format "*%s message*" type))))
-
-(defun message-pop-to-buffer (name)
-  "Pop to buffer NAME, and warn if it already exists and is modified."
-  (let ((buffer (get-buffer name)))
-    (if (and buffer
-	     (buffer-name buffer))
-	(progn
-	  (set-buffer (pop-to-buffer buffer))
-	  (when (and (buffer-modified-p)
-		     (not (y-or-n-p
-			   "Message already being composed; erase? ")))
-	    (error "Message being composed")))
-      (set-buffer (pop-to-buffer name))))
-  (erase-buffer)
-  (message-mode))
-
-(defun message-do-send-housekeeping ()
-  "Kill old message buffers."
-  ;; We might have sent this buffer already.  Delete it from the
-  ;; list of buffers.
-  (setq message-buffer-list (delq (current-buffer) message-buffer-list))
-  (when (and message-max-buffers
-	     (>= (length message-buffer-list) message-max-buffers))
-    ;; Kill the oldest buffer -- unless it has been changed.
-    (let ((buffer (pop message-buffer-list)))
-      (when (and (buffer-name buffer)
-		 (not (buffer-modified-p buffer)))
-	(kill-buffer buffer))))
-  ;; Rename the buffer.
-  (if message-send-rename-function
-      (funcall message-send-rename-function)
-    (when (string-match "\\`\\*" (buffer-name))
-      (rename-buffer 
-       (concat "*sent " (substring (buffer-name) (match-end 0))) t)))
-  ;; Push the current buffer onto the list.
-  (when message-max-buffers
-    (setq message-buffer-list 
-	  (nconc message-buffer-list (list (current-buffer))))))
-
-(defvar mc-modes-alist)
-(defun message-setup (headers &optional replybuffer actions)
-  (when (and (boundp 'mc-modes-alist)
-	     (not (assq 'message-mode mc-modes-alist)))
-    (push '(message-mode (encrypt . mc-encrypt-message)
-			 (sign . mc-sign-message))
-	  mc-modes-alist))
-  (when actions
-    (setq message-send-actions actions))
-  (setq message-reply-buffer replybuffer)
-  (goto-char (point-min))
-  ;; Insert all the headers.
-  (mail-header-format 
-   (let ((h headers)
-	 (alist message-header-format-alist))
-     (while h
-       (unless (assq (caar h) message-header-format-alist)
-	 (push (list (caar h)) alist))
-       (pop h))
-     alist)
-   headers)
-  (delete-region (point) (progn (forward-line -1) (point)))
-  (when message-default-headers
-    (insert message-default-headers))
-  (put-text-property
-   (point)
-   (progn
-     (insert mail-header-separator "\n")
-     (1- (point)))
-   'read-only nil)
-  (forward-line -1)
-  (when (message-news-p)
-    (when message-default-news-headers
-      (insert message-default-news-headers))
-    (when message-generate-headers-first
-      (message-generate-headers
-       (delq 'Lines
-	     (delq 'Subject
-		   (copy-sequence message-required-news-headers))))))
-  (when (message-mail-p)
-    (when message-default-mail-headers
-      (insert message-default-mail-headers))
-    (when message-generate-headers-first
-      (message-generate-headers
-       (delq 'Lines
-	     (delq 'Subject
-		   (copy-sequence message-required-mail-headers))))))
-  (run-hooks 'message-signature-setup-hook)
-  (message-insert-signature)
-  (message-set-auto-save-file-name)
-  (save-restriction
-    (message-narrow-to-headers)
-    (run-hooks 'message-header-setup-hook))
-  (set-buffer-modified-p nil)
-  (run-hooks 'message-setup-hook)
-  (message-position-point)
-  (undo-boundary))
-
-(defun message-set-auto-save-file-name ()
-  "Associate the message buffer with a file in the drafts directory."
-  (when message-autosave-directory
-    (unless (file-exists-p message-autosave-directory)
-      (make-directory message-autosave-directory t))
-    (let ((name (make-temp-name
-		 (concat (file-name-as-directory message-autosave-directory)
-			 "msg."))))
-      (setq buffer-auto-save-file-name
-	    (save-excursion
-	      (prog1
-		  (progn
-		    (set-buffer (get-buffer-create " *draft tmp*"))
-		    (setq buffer-file-name name)
-		    (make-auto-save-file-name))
-		(kill-buffer (current-buffer)))))
-      (clear-visited-file-modtime))))
-
-
-
-;;;
-;;; Commands for interfacing with message
-;;;
-
-;;;###autoload
-(defun message-mail (&optional to subject)
-  "Start editing a mail message to be sent."
-  (interactive)
-  (message-pop-to-buffer (message-buffer-name "mail" to))
-  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
-
-;;;###autoload
-(defun message-news (&optional newsgroups subject)
-  "Start editing a news article to be sent."
-  (interactive)
-  (message-pop-to-buffer (message-buffer-name "news" nil newsgroups))
-  (message-setup `((Newsgroups . ,(or newsgroups "")) 
-		   (Subject . ,(or subject "")))))
-
-;;;###autoload
-(defun message-reply (&optional to-address wide ignore-reply-to)
-  "Start editing a reply to the article in the current buffer."
-  (interactive)
-  (let ((cur (current-buffer))
-	from subject date reply-to to cc
-	references message-id follow-to 
-	mct never-mct gnus-warning)
-    (save-restriction
-      (narrow-to-region
-       (goto-char (point-min))
-       (if (search-forward "\n\n" nil t)
-	   (1- (point))
-	 (point-max)))
-      ;; Allow customizations to have their say.
-      (if (not wide)
-	  ;; This is a regular reply.
-	  (if (message-functionp message-reply-to-function)
-	      (setq follow-to (funcall message-reply-to-function)))
-	;; This is a followup.
-	(if (message-functionp message-wide-reply-to-function)
-	    (save-excursion
-	      (setq follow-to
-		    (funcall message-wide-reply-to-function)))))
-      ;; Find all relevant headers we need.
-      (setq from (message-fetch-field "from")
-	    date (message-fetch-field "date") 
-	    subject (or (message-fetch-field "subject") "none")
-	    to (message-fetch-field "to")
-	    cc (message-fetch-field "cc")
-	    mct (message-fetch-field "mail-copies-to")
-	    reply-to (unless ignore-reply-to (message-fetch-field "reply-to"))
-	    references (message-fetch-field "references")
-	    message-id (message-fetch-field "message-id"))
-      ;; Remove any (buggy) Re:'s that are present and make a
-      ;; proper one.
-      (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
-	(setq subject (substring subject (match-end 0))))
-      (setq subject (concat "Re: " subject))
-
-      (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
-		 (string-match "<[^>]+>" gnus-warning))
-	(setq message-id (match-string 0 gnus-warning)))
-	    
-      ;; Handle special values of Mail-Copies-To.
-      (when mct
-	(cond ((equal (downcase mct) "never")
-	       (setq never-mct t)
-	       (setq mct nil))
-	      ((equal (downcase mct) "always")
-	       (setq mct (or reply-to from)))))
-
-      (unless follow-to
-	(if (or (not wide)
-		to-address)
-	    (setq follow-to (list (cons 'To (or to-address reply-to from))))
-	  (let (ccalist)
-	    (save-excursion
-	      (message-set-work-buffer)
-	      (unless never-mct
-		(insert (or reply-to from "")))
-	      (insert 
-	       (if (bolp) "" ", ") (or to "")
-	       (if mct (concat (if (bolp) "" ", ") mct) "")
-	       (if cc (concat (if (bolp) "" ", ") cc) ""))
-	      ;; Remove addresses that match `rmail-dont-reply-to-names'. 
-	      (insert (prog1 (rmail-dont-reply-to (buffer-string))
-			(erase-buffer)))
-	      (goto-char (point-min))
-	      (setq ccalist
-		    (mapcar
-		     (lambda (addr)
-		       (cons (mail-strip-quoted-names addr) addr))
-		     (nreverse (mail-parse-comma-list))))
-	      (let ((s ccalist))
-		(while s
-		  (setq ccalist (delq (assoc (car (pop s)) s) ccalist)))))
-	    (setq follow-to (list (cons 'To (cdr (pop ccalist)))))
-	    (when ccalist
-	      (push (cons 'Cc
-			  (mapconcat (lambda (addr) (cdr addr)) ccalist ", "))
-		    follow-to)))))
-      (widen))
-
-    (message-pop-to-buffer (message-buffer-name
-			    (if wide "wide reply" "reply") from
-			    (if wide to-address nil)))
-
-    (setq message-reply-headers
-	  (vector 0 subject from date message-id references 0 0 ""))
-
-    (message-setup
-     `((Subject . ,subject)
-       ,@follow-to 
-       ,@(if (or references message-id)
-	     `((References . ,(concat (or references "") (and references " ")
-				      (or message-id ""))))
-	   nil))
-     cur)))
-
-;;;###autoload
-(defun message-wide-reply (&optional to-address)
-  (interactive)
-  (message-reply to-address t))
-
-;;;###autoload
-(defun message-followup ()
-  (interactive)
-  (let ((cur (current-buffer))
-	from subject date reply-to mct
-	references message-id follow-to 
-	followup-to distribution newsgroups gnus-warning)
-    (save-restriction
-      (narrow-to-region
-       (goto-char (point-min))
-       (if (search-forward "\n\n" nil t)
-	   (1- (point))
-	 (point-max)))
-      (when (message-functionp message-followup-to-function)
-	(setq follow-to
-	      (funcall message-followup-to-function)))
-      (setq from (message-fetch-field "from")
-	    date (message-fetch-field "date") 
-	    subject (or (message-fetch-field "subject") "none")
-	    references (message-fetch-field "references")
-	    message-id (message-fetch-field "message-id")
-	    followup-to (message-fetch-field "followup-to")
-	    newsgroups (message-fetch-field "newsgroups")
-	    reply-to (message-fetch-field "reply-to")
-	    distribution (message-fetch-field "distribution")
-	    mct (message-fetch-field "mail-copies-to"))
-      (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
-		 (string-match "<[^>]+>" gnus-warning))
-	(setq message-id (match-string 0 gnus-warning)))
-      ;; Remove bogus distribution.
-      (and (stringp distribution)
-	   (string-match "world" distribution)
-	   (setq distribution nil))
-      ;; Remove any (buggy) Re:'s that are present and make a
-      ;; proper one.
-      (when (string-match "^[ \t]*[Rr][Ee]:[ \t]*" subject)
-	(setq subject (substring subject (match-end 0))))
-      (setq subject (concat "Re: " subject))
-      (widen))
-
-    (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
-
-    (message-setup
-     `((Subject . ,subject)
-       ,@(cond 
-	  (follow-to follow-to)
-	  ((and followup-to message-use-followup-to)
-	   (list
-	    (cond 
-	     ((equal (downcase followup-to) "poster")
-	      (if (or (eq message-use-followup-to 'use)
-		      (message-y-or-n-p "Obey Followup-To: poster? " t "\
-You should normally obey the Followup-To: header.
-
-`Followup-To: poster' sends your response via e-mail instead of news.
-
-A typical situation where `Followup-To: poster' is used is when the poster
-does not read the newsgroup, so he wouldn't see any replies sent to it."))
-		  (cons 'To (or reply-to from ""))
-		(cons 'Newsgroups newsgroups)))
-	     (t
-	      (if (or (equal followup-to newsgroups)
-		      (not (eq message-use-followup-to 'ask))
-		      (message-y-or-n-p
-		       (concat "Obey Followup-To: " followup-to "? ") t "\
-You should normally obey the Followup-To: header.
-
-	`Followup-To: " followup-to "'
-directs your response to " (if (string-match "," followup-to)
-			       "the specified newsgroups"
-			     "that newsgroup only") ".
-
-If a message is posted to several newsgroups, Followup-To is often
-used to direct the following discussion to one newsgroup only,
-because discussions that are spread over several newsgroup tend to
-be fragmented and very difficult to follow.
-
-Also, some source/announcment newsgroups are not indented for discussion;
-responses here are directed to other newsgroups."))
-		  (cons 'Newsgroups followup-to)
-		(cons 'Newsgroups newsgroups))))))
-	  (t
-	   `((Newsgroups . ,newsgroups))))
-       ,@(and distribution (list (cons 'Distribution distribution)))
-       (References . ,(concat (or references "") (and references " ")
-			      (or message-id "")))
-       ,@(when (and mct
-		    (not (equal (downcase mct) "never")))
-	   (list (cons 'Cc (if (equal (downcase mct) "always")
-			       (or reply-to from "")
-			     mct)))))
-
-     cur)
-
-    (setq message-reply-headers
-	  (vector 0 subject from date message-id references 0 0 ""))))
-
-
-;;;###autoload
-(defun message-cancel-news ()
-  "Cancel an article you posted."
-  (interactive)
-  (unless (message-news-p)
-    (error "This is not a news article; canceling is impossible"))
-  (when (yes-or-no-p "Do you really want to cancel this article? ")
-    (let (from newsgroups message-id distribution buf)
-      (save-excursion
-	;; Get header info. from original article.
-	(save-restriction
-	  (message-narrow-to-head)
-	  (setq from (message-fetch-field "from")
-		newsgroups (message-fetch-field "newsgroups")
-		message-id (message-fetch-field "message-id")
-		distribution (message-fetch-field "distribution")))
-	;; Make sure that this article was written by the user.
-	(unless (string-equal
-		 (downcase (cadr (mail-extract-address-components from)))
-		 (downcase (message-make-address)))
-	  (error "This article is not yours"))
-	;; Make control message.
-	(setq buf (set-buffer (get-buffer-create " *message cancel*")))
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)
-	(insert "Newsgroups: " newsgroups "\n"
-		"From: " (message-make-from) "\n"
-		"Subject: cmsg cancel " message-id "\n"
-		"Control: cancel " message-id "\n"
-		(if distribution
-		    (concat "Distribution: " distribution "\n")
-		  "")
-		mail-header-separator "\n"
-		"This is a cancel message from " from ".\n")
-	(message "Canceling your article...")
-	(let ((message-syntax-checks 'dont-check-for-anything-just-trust-me))
-	  (funcall message-send-news-function))
-	(message "Canceling your article...done")
-	(kill-buffer buf)))))
-
-;;;###autoload
-(defun message-supersede ()
-  "Start composing a message to supersede the current message.
-This is done simply by taking the old article and adding a Supersedes
-header line with the old Message-ID."
-  (interactive)
-  (let ((cur (current-buffer)))
-    ;; Check whether the user owns the article that is to be superseded. 
-    (unless (string-equal
-	     (downcase (cadr (mail-extract-address-components
-			      (message-fetch-field "from"))))
-	     (downcase (message-make-address)))
-      (error "This article is not yours"))
-    ;; Get a normal message buffer.
-    (message-pop-to-buffer (message-buffer-name "supersede"))
-    (insert-buffer-substring cur)
-    (message-narrow-to-head)
-    ;; Remove unwanted headers.
-    (when message-ignored-supersedes-headers
-      (message-remove-header message-ignored-supersedes-headers t))
-    (goto-char (point-min))
-    (if (not (re-search-forward "^Message-ID: " nil t))
-	(error "No Message-ID in this article")
-      (replace-match "Supersedes: " t t))
-    (goto-char (point-max))
-    (insert mail-header-separator)
-    (widen)
-    (forward-line 1)))
-
-;;;###autoload
-(defun message-recover ()
-  "Reread contents of current buffer from its last auto-save file."
-  (interactive)
-  (let ((file-name (make-auto-save-file-name)))
-    (cond ((save-window-excursion
-	     (if (not (eq system-type 'vax-vms))
-		 (with-output-to-temp-buffer "*Directory*"
-		   (buffer-disable-undo standard-output)
-		   (let ((default-directory "/"))
-		     (call-process
-		      "ls" nil standard-output nil "-l" file-name))))
-	     (yes-or-no-p (format "Recover auto save file %s? " file-name)))
-	   (let ((buffer-read-only nil))
-	     (erase-buffer)
-	     (insert-file-contents file-name nil)))
-	  (t (error "message-recover cancelled")))))
-
-;;; Forwarding messages.
-
-(defun message-make-forward-subject ()
-  "Return a Subject header suitable for the message in the current buffer."
-  (concat "[" (or (message-fetch-field (if (message-news-p) "newsgroups" "from"))
-		  "(nowhere)")
-	  "] " (or (message-fetch-field "Subject") "")))
-
-;;;###autoload
-(defun message-forward (&optional news)
-  "Forward the current message via mail.  
-Optional NEWS will use news to forward instead of mail."
-  (interactive "P")
-  (let ((cur (current-buffer))
-	(subject (message-make-forward-subject)))
-    (if news (message-news nil subject) (message-mail nil subject))
-    ;; Put point where we want it before inserting the forwarded
-    ;; message. 
-    (if message-signature-before-forwarded-message
-	(goto-char (point-max))
-      (message-goto-body))
-    ;; Make sure we're at the start of the line.
-    (unless (eolp)
-      (insert "\n"))
-    ;; Narrow to the area we are to insert.
-    (narrow-to-region (point) (point))
-    ;; Insert the separators and the forwarded buffer.
-    (insert message-forward-start-separator)
-    (insert-buffer-substring cur)
-    (goto-char (point-max))
-    (insert message-forward-end-separator)
-    (set-text-properties (point-min) (point-max) nil)
-    ;; Remove all unwanted headers.
-    (goto-char (point-min))
-    (forward-line 1)
-    (narrow-to-region (point) (if (search-forward "\n\n" nil t)
-				  (1- (point))
-				(point)))
-    (goto-char (point-min))
-    (message-remove-header message-included-forward-headers t nil t)
-    (widen)
-    (message-position-point)))
-
-;;;###autoload
-(defun message-resend (address)
-  "Resend the current article to ADDRESS."
-  (interactive "sResend message to: ")
-  (save-excursion
-    (let ((cur (current-buffer))
-	  beg)
-      ;; We first set up a normal mail buffer.
-      (set-buffer (get-buffer-create " *message resend*"))
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (message-setup `((To . ,address)))
-      ;; Insert our usual headers.
-      (message-generate-headers '(From Date To))
-      (message-narrow-to-headers)
-      ;; Rename them all to "Resent-*".
-      (while (re-search-forward "^[A-Za-z]" nil t)
-	(forward-char -1)
-	(insert "Resent-"))
-      (widen)
-      (forward-line)
-      (delete-region (point) (point-max))
-      (setq beg (point))
-      ;; Insert the message to be resent.
-      (insert-buffer-substring cur)
-      (goto-char (point-min))
-      (search-forward "\n\n")
-      (forward-char -1)
-      (save-restriction
-	(narrow-to-region beg (point))
-	(message-remove-header message-ignored-resent-headers t)
-	(goto-char (point-max)))
-      (insert mail-header-separator)
-      ;; Rename all old ("Also-")Resent headers.
-      (while (re-search-backward "^\\(Also-\\)?Resent-" beg t)
-	(beginning-of-line)
-	(insert "Also-"))
-      ;; Send it.
-      (message-send-mail)
-      (kill-buffer (current-buffer)))))
-
-;;;###autoload
-(defun message-bounce ()
-  "Re-mail the current message.
-This only makes sense if the current message is a bounce message than
-contains some mail you have written which has been bounced back to
-you."
-  (interactive)
-  (let ((cur (current-buffer))
-	boundary)
-    (message-pop-to-buffer (message-buffer-name "bounce"))
-    (insert-buffer-substring cur)
-    (undo-boundary)
-    (message-narrow-to-head)
-    (if (and (message-fetch-field "Mime-Version")
-	     (setq boundary (message-fetch-field "Content-Type")))
-	(if (string-match "boundary=\"\\([^\"]+\\)\"" boundary)
-	    (setq boundary (concat (match-string 1 boundary) " *\n"
-				   "Content-Type: message/rfc822"))
-	  (setq boundary nil)))
-    (widen)
-    (goto-char (point-min))
-    (search-forward "\n\n" nil t)
-    (or (and boundary
-	     (re-search-forward boundary nil t)
-	     (forward-line 2))
-	(and (re-search-forward message-unsent-separator nil t)
-	     (forward-line 1))
-	(and (search-forward "\n\n" nil t)
-	     (re-search-forward "^Return-Path:.*\n" nil t)))
-    ;; We remove everything before the bounced mail.
-    (delete-region 
-     (point-min)
-     (if (re-search-forward "^[^ \n\t]+:" nil t)
-	 (match-beginning 0)
-       (point)))
-    (save-restriction
-      (message-narrow-to-head)
-      (message-remove-header message-ignored-bounced-headers t)
-      (goto-char (point-max))
-      (insert mail-header-separator))
-    (message-position-point)))
-
-;;;
-;;; Interactive entry points for new message buffers.
-;;;
-
-;;;###autoload
-(defun message-mail-other-window (&optional to subject)
-  "Like `message-mail' command, but display mail buffer in another window."
-  (interactive)
-  (let ((pop-up-windows t)
-	(special-display-buffer-names nil)
-	(special-display-regexps nil)
-	(same-window-buffer-names nil)
-	(same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "mail" to)))
-  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
-
-;;;###autoload
-(defun message-mail-other-frame (&optional to subject)
-  "Like `message-mail' command, but display mail buffer in another frame."
-  (interactive)
-  (let ((pop-up-frames t)
-	(special-display-buffer-names nil)
-	(special-display-regexps nil)
-	(same-window-buffer-names nil)
-	(same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "mail" to)))
-  (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))))
-
-;;;###autoload
-(defun message-news-other-window (&optional newsgroups subject)
-  "Start editing a news article to be sent."
-  (interactive)
-  (let ((pop-up-windows t)
-	(special-display-buffer-names nil)
-	(special-display-regexps nil)
-	(same-window-buffer-names nil)
-	(same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
-  (message-setup `((Newsgroups . ,(or newsgroups "")) 
-		   (Subject . ,(or subject "")))))
-
-;;;###autoload
-(defun message-news-other-frame (&optional newsgroups subject)
-  "Start editing a news article to be sent."
-  (interactive)
-  (let ((pop-up-frames t)
-	(special-display-buffer-names nil)
-	(special-display-regexps nil)
-	(same-window-buffer-names nil)
-	(same-window-regexps nil))
-    (message-pop-to-buffer (message-buffer-name "news" nil newsgroups)))
-  (message-setup `((Newsgroups . ,(or newsgroups "")) 
-		   (Subject . ,(or subject "")))))
-
-;;; underline.el
-
-;; This code should be moved to underline.el (from which it is stolen). 
-
-;;;###autoload
-(defun bold-region (start end)
-  "Bold all nonblank characters in the region.
-Works by overstriking characters.
-Called from program, takes two arguments START and END
-which specify the range to operate on."
-  (interactive "r")
-  (save-excursion
-   (let ((end1 (make-marker)))
-     (move-marker end1 (max start end))
-     (goto-char (min start end))
-     (while (< (point) end1)
-       (or (looking-at "[_\^@- ]")
-	   (insert (following-char) "\b"))
-       (forward-char 1)))))
-
-;;;###autoload
-(defun unbold-region (start end)
-  "Remove all boldness (overstruck characters) in the region.
-Called from program, takes two arguments START and END
-which specify the range to operate on."
-  (interactive "r")
-  (save-excursion
-   (let ((end1 (make-marker)))
-     (move-marker end1 (max start end))
-     (goto-char (min start end)) 
-     (while (re-search-forward "\b" end1 t)
-       (if (eq (following-char) (char-after (- (point) 2)))
-	   (delete-char -2))))))
-
-(fset 'message-exchange-point-and-mark 'exchange-point-and-mark)
-
-;; Support for toolbar
-(when (string-match "XEmacs\\|Lucid" emacs-version)
-  (require 'messagexmas))
-
-;;; Group name completion.
-
-(defvar message-newgroups-header-regexp
-  "^\\(Newsgroups\\|Followup-To\\|Posted-To\\):"
-  "Regexp that match headers that lists groups.")
-
-(defun message-tab ()
-  "Expand group names in Newsgroups and Followup-To headers.
-Do a `tab-to-tab-stop' if not in those headers."
-  (interactive)
-  (if (let ((mail-abbrev-mode-regexp message-newgroups-header-regexp))
-	(mail-abbrev-in-expansion-header-p))
-      (message-expand-group)
-    (tab-to-tab-stop)))
-
-(defvar gnus-active-hashtb)
-(defun message-expand-group ()
-  (let* ((b (save-excursion (skip-chars-backward "^, :\t\n") (point)))
-	 (completion-ignore-case t)
-	 (string (buffer-substring b (point)))
-	 (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb))
-	 (completions (all-completions string hashtb))
-	 (cur (current-buffer))
-	 comp)
-    (delete-region b (point))
-    (cond 
-     ((= (length completions) 1)
-      (if (string= (car completions) string)
-	  (progn
-	    (insert string)
-	    (message "Only matching group"))
-	(insert (car completions))))
-     ((and (setq comp (try-completion string hashtb))
-	   (not (string= comp string)))
-      (insert comp))
-     (t
-      (insert string)
-      (if (not comp)
-	  (message "No matching groups")
-	(pop-to-buffer "*Completions*")
-	(buffer-disable-undo (current-buffer))
-	(let ((buffer-read-only nil))
-	  (erase-buffer)
-	  (let ((standard-output (current-buffer)))
-	    (display-completion-list (sort completions 'string<)))
-	  (goto-char (point-min))
-	  (pop-to-buffer cur)))))))
-
-(run-hooks 'message-load-hook)
-
-(provide 'message)
-
-;;; message.el ends here
diff --git a/lisp/misc.el b/lisp/misc.el
deleted file mode 100644
index fa480144074..00000000000
--- a/lisp/misc.el
+++ /dev/null
@@ -1,58 +0,0 @@
-;;; misc.el --- basic editing commands for Emacs
-
-;; Copyright (C) 1989 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.
-
-;;; Code:
-
-(defun copy-from-above-command (&optional arg)
-  "Copy characters from previous nonblank line, starting just above point.
-Copy ARG characters, but not past the end of that line.
-If no argument given, copy the entire rest of the line.
-The characters copied are inserted in the buffer before point."
-  (interactive "P")
-  (let ((cc (current-column))
-	n
-	(string ""))
-    (save-excursion
-      (beginning-of-line)
-      (backward-char 1)
-      (skip-chars-backward "\ \t\n")
-      (move-to-column cc)
-      ;; Default is enough to copy the whole rest of the line.
-      (setq n (if arg (prefix-numeric-value arg) (point-max)))
-      ;; If current column winds up in middle of a tab,
-      ;; copy appropriate number of "virtual" space chars.
-      (if (< cc (current-column))
-	  (if (= (preceding-char) ?\t)
-	      (progn
-		(setq string (make-string (min n (- (current-column) cc)) ?\ ))
-		(setq n (- n (min n (- (current-column) cc)))))
-	    ;; In middle of ctl char => copy that whole char.
-	    (backward-char 1)))
-      (setq string (concat string
-			   (buffer-substring
-			    (point)
-			    (min (save-excursion (end-of-line) (point))
-				 (+ n (point)))))))
-    (insert string)))
-
-;;; misc.el ends here
diff --git a/lisp/mldrag.el b/lisp/mldrag.el
deleted file mode 100644
index 45a10c2e18c..00000000000
--- a/lisp/mldrag.el
+++ /dev/null
@@ -1,228 +0,0 @@
-;;; mldrag.el --- mode line and vertical line dragging to resize windows
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: Kyle E. Jones <kyle@wonderworks.com>
-;; Keywords: mouse
-
-;; 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 lets you drag the modeline, vertical bar and
-;; scrollbar to resize windows.  Suggested bindings are:
-;;
-;;   (global-set-key [mode-line down-mouse-1] 'mldrag-drag-mode-line)
-;;   (global-set-key [vertical-line down-mouse-1] 'mldrag-drag-vertical-line)
-;;   (global-set-key [vertical-scroll-bar S-down-mouse-1]
-;;                   'mldrag-drag-vertical-line)
-;;
-;; Put the bindings and (require 'mldrag) in your .emacs file.
-
-;;; Code:
-
-(provide 'mldrag)
-
-(defun mldrag-drag-mode-line (start-event)
-  "Change the height of the current window with the mouse.
-This command should be bound to a down-mouse- event, and is most
-usefully bound with the `mode-line' prefix.  Holding down a mouse
-button and moving the mouse up and down will make the clicked-on
-window taller or shorter."
-  (interactive "e")
-  (let ((done nil)
-	(echo-keystrokes 0)
-	(start-event-frame (window-frame (car (car (cdr start-event)))))
-	(start-event-window (car (car (cdr start-event))))
-	(start-nwindows (count-windows t))
-	(old-selected-window (selected-window))
-	should-enlarge-minibuffer
-	event mouse minibuffer y top bot edges wconfig params growth)
-    (setq params (frame-parameters))
-    (if (and (not (setq minibuffer (cdr (assq 'minibuffer params))))
-	     (one-window-p t))
-	(error "Attempt to resize sole window"))
-    (unwind-protect
-	(track-mouse
-	  (progn
-	    ;; enlarge-window only works on the selected window, so
-	    ;; we must select the window where the start event originated.
-	    ;; unwind-protect will restore the old selected window later.
-	    (select-window start-event-window)
-	    ;; if this is the bottommost ordinary window, then to
-	    ;; move its modeline the minibuffer must be enlarged.
-	    (setq should-enlarge-minibuffer
-		  (and minibuffer
-		       (not (one-window-p t))
-		       (= (nth 1 (window-edges minibuffer))
-			  (nth 3 (window-edges)))))
-	    ;; loop reading events and sampling the position of
-	    ;; the mouse.
-	    (while (not done)
-	      (setq event (read-event)
-		    mouse (mouse-position))
-	      ;; do nothing if
-	      ;;   - there is a switch-frame event.
-	      ;;   - the mouse isn't in the frame that we started in
-	      ;;   - the mouse isn't in any Emacs frame
-	      ;; drag if
-	      ;;   - there is a mouse-movement event
-	      ;;   - there is a scroll-bar-movement event
-	      ;;     (same as mouse movement for our purposes)
-	      ;; quit if
-	      ;;   - there is a keyboard event or some other unknown event
-	      ;;     unknown event.
-	      (cond ((integerp event)
-		     (setq done t))
-		    ((eq (car event) 'switch-frame)
-		     nil)
-		    ((not (memq (car event)
-				'(mouse-movement scroll-bar-movement)))
-		     (setq done t))
-		    ((not (eq (car mouse) start-event-frame))
-		     nil)
-		    ((null (car (cdr mouse)))
-		     nil)
-		    (t
-		     (setq y (cdr (cdr mouse))
-			   edges (window-edges)
-			   top (nth 1 edges)
-			   bot (nth 3 edges))
-		     ;; scale back a move that would make the
-		     ;; window too short.
-		     (cond ((< (- y top -1) window-min-height)
-			    (setq y (+ top window-min-height -1))))
-		     ;; compute size change needed
-		     (setq growth (- y bot -1)
-			   wconfig (current-window-configuration))
-		     ;; grow/shrink minibuffer?
-		     (if should-enlarge-minibuffer
-			 (progn
-			   ;; yes.  briefly select minibuffer so
-			   ;; enlarge-window will affect the
-			   ;; correct window.
-			   (select-window minibuffer)
-			   ;; scale back shrinkage if it would
-			   ;; make the minibuffer less than 1
-			   ;; line tall.
-			   (if (and (> growth 0)
-				    (< (- (window-height minibuffer)
-					  growth)
-				       1))
-			       (setq growth (1- (window-height minibuffer))))
-			   (enlarge-window (- growth))
-			   (select-window start-event-window))
-		       ;; no.  grow/shrink the selected window
-		       (enlarge-window growth))
-		     ;; if this window's growth caused another
-		     ;; window to be deleted because it was too
-		     ;; short, rescind the change.
-		     ;;
-		     ;; if size change caused space to be stolen
-		     ;; from a window above this one, rescind the
-		     ;; change, but only if we didn't grow/srhink
-		     ;; the minibuffer.  minibuffer size changes
-		     ;; can cause all windows to shrink... no way
-		     ;; around it.
-		     (if (or (/= start-nwindows (count-windows t))
-			     (and (not should-enlarge-minibuffer)
-				  (/= top (nth 1 (window-edges)))))
-			 (set-window-configuration wconfig)))))))
-      ;; restore the old selected window
-      (select-window old-selected-window))))
-
-(defun mldrag-drag-vertical-line (start-event)
-  "Change the width of the current window with the mouse.
-This command should be bound to a down-mouse- event, and is most
-usefully bound with the `vertical-line' or the `vertical-scroll-bar'
-prefix.  Holding down a mouse button and moving the mouse left and
-right will make the clicked-on window thinner or wider."
-  (interactive "e")
-  (let ((done nil)
-	(echo-keystrokes 0)
-	(start-event-frame (window-frame (car (car (cdr start-event)))))
-	(start-event-window (car (car (cdr start-event))))
-	(start-nwindows (count-windows t))
-	(old-selected-window (selected-window))
-	event mouse x left right edges wconfig growth)
-    (if (one-window-p t)
-	(error "Attempt to resize sole ordinary window"))
-    (if (= (nth 2 (window-edges start-event-window))
-	   (frame-width start-event-frame))
-	(error "Attempt to drag rightmost scrollbar"))
-    (unwind-protect
-	(track-mouse
-	  (progn
-	    ;; enlarge-window only works on the selected window, so
-	    ;; we must select the window where the start event originated.
-	    ;; unwind-protect will restore the old selected window later.
-	    (select-window start-event-window)
-	    ;; loop reading events and sampling the position of
-	    ;; the mouse.
-	    (while (not done)
-	      (setq event (read-event)
-		    mouse (mouse-position))
-	      ;; do nothing if
-	      ;;   - there is a switch-frame event.
-	      ;;   - the mouse isn't in the frame that we started in
-	      ;;   - the mouse isn't in any Emacs frame
-	      ;; drag if
-	      ;;   - there is a mouse-movement event
-	      ;;   - there is a scroll-bar-movement event
-	      ;;     (same as mouse movement for our purposes)
-	      ;; quit if
-	      ;;   - there is a keyboard event or some other unknown event
-	      ;;     unknown event.
-	      (cond ((integerp event)
-		     (setq done t))
-		    ((eq (car event) 'switch-frame)
-		     nil)
-		    ((not (memq (car event)
-				'(mouse-movement scroll-bar-movement)))
-		     (setq done t))
-		    ((not (eq (car mouse) start-event-frame))
-		     nil)
-		    ((null (car (cdr mouse)))
-		     nil)
-		    (t
-		     (setq x (car (cdr mouse))
-			   edges (window-edges)
-			   left (nth 0 edges)
-			   right (nth 2 edges))
-		     ;; scale back a move that would make the
-		     ;; window too thin.
-		     (cond ((< (- x left -1) window-min-width)
-			    (setq x (+ left window-min-width -1))))
-		     ;; compute size change needed
-		     (setq growth (- x right -1)
-			   wconfig (current-window-configuration))
-		     (enlarge-window growth t)
-		     ;; if this window's growth caused another
-		     ;; window to be deleted because it was too
-		     ;; thin, rescind the change.
-		     ;;
-		     ;; if size change caused space to be stolen
-		     ;; from a window to the left of this one,
-		     ;; rescind the change.
-		     (if (or (/= start-nwindows (count-windows t))
-			     (/= left (nth 0 (window-edges))))
-			 (set-window-configuration wconfig)))))))
-      ;; restore the old selected window
-      (select-window old-selected-window))))
-
-;; mldrag.el ends here
diff --git a/lisp/mouse-copy.el b/lisp/mouse-copy.el
deleted file mode 100644
index 56043ef3269..00000000000
--- a/lisp/mouse-copy.el
+++ /dev/null
@@ -1,249 +0,0 @@
-;;; mouse-copy.el -- one-click text copy and move
-
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: John Heidemann <johnh@ISI.EDU>
-;; Keywords: mouse
-
-;; 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:
-
-;;; What is ``mouse-copy.el''?
-;;;
-;;; It provides one-click text copy and move.  Rather than the
-;;; standard stroke-out-a-region (down-mouse-1, up-mouse-1) followed
-;;; by a yank (down-mouse-2, up-mouse-2 or C-y), you can now stroke
-;;; out a region and have it automatically pasted at the current
-;;; point.  You can also move text just as easily.  Although the
-;;; difference may not sound like much, it does make mousing text
-;;; around a lot easier, IMHO.
-;;;
-;;; If you like mouse-copy, you should also check out mouse-drag
-;;; for ``one-click scrolling''.
-;;;
-;;; To use mouse-copy, place the following in your .emacs file:
-;;;	(require 'mouse-copy)
-;;;     (global-set-key [M-down-mouse-1] 'mouse-drag-secondary-pasting)
-;;;     (global-set-key [M-S-down-mouse-1] 'mouse-drag-secondary-moving)
-;;;
-;;; (These definitions override the old binding of M-mouse-1 to
-;;; mouse-drag-secondary.  I find I don't use that command much so its
-;;; loss is not important, and it can be made up with a M-mouse-1
-;;; followed by a M-mouse-3.  I personally reserve M-mouse bindings
-;;; for my window manager and bind everything to C-mouse.)
-;;;
-;;;
-;;; History and related work:
-;;;
-;;; One-click copying and moving was inspired by lemacs-19.8.
-;;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's
-;;; mouse-2 scrolling.  The package mouse-scroll.el by Tom Wurgler
-;;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but
-;;; doesn't pass clicks through.
-;;;
-;;; These functions have been tested in emacs version 19.30,
-;;; and this package has run in the past on 19.25-19.29.
-;;;
-;;; Originally mouse-copy was part of a larger package.
-;;; As of 11 July 96 the scrolling functions were split out
-;;; in preparation for incorporation into (the future) emacs-19.32.
-;;;
-;;;
-;;; Known Bugs:
-;;;
-;;; - Highlighting is sub-optimal under 19.29 and XFree86-3.1.1
-;;;   (see \\[mouse-copy-work-around-drag-bug] for details).
-;;; - mouse-drag-secondary-pasting and mouse-drag-secondary-moving
-;;;   require X11R5 (or better) and so fail under older versions
-;;;   of Open Windows (like that present in Solaris/x86 2.1).
-;;;
-;;;
-;;; Future plans:
-;;;
-;;; I read about the chording features of Plan-9's Acme environment at
-;;; <http://swifty.dap.csiro.au/%7Ecameron/wily/auug.html>.  I'd like
-;;; to incorporate some of these ideas into mouse-copy.  The only
-;;; lose is that this is not the current Emacs Way Of Doing Things, so
-;;; there would be a learning curve for existing emacs users.
-;;;
-;;;
-;;; Thanks:
-;;;
-;;; Thanks to Kai Grossjohann
-;;; <grossjoh@dusty.informatik.uni-dortmund.de> for reporting bugs, to
-;;; Tom Wurgler <twurgler@goodyear.com> for reporting bugs and
-;;; suggesting fixes, and to Joel Graber <jgraber@ti.com> for
-;;; prompting me to do drag-scrolling and for an initial
-;;; implementation of horizontal drag-scrolling.
-;;;
-;;;    -johnh, 11-Jul-96
-;;;
-;;;
-;;; Old changes, for reference:
-;;;
-;;; What's new with mouse-copy 2.22?
-;;;
-;;; - copy functions split out from mouse-extras.el
-;;; - support for emacs-19.{29,30,31} (no changes needed for the 31 port!)
-;;;
-;;;
-;;; What's new with mouse-extras 2.21?
-;;;
-;;; - support for emacs-19.{29,30}
-;;; - point now stays on the visible screen during horizontal scrolling
-;;;   (bug identified and fix suggested by Tom Wurgler <twurgler@goodyear.com>)
-;;; - better work-around for lost-mouse-events bug (supports double/triple
-;;;   clicks), see \\[mouse-extras-work-around-drag-bug] for details.
-;;; - work-around for lost-mouse-events bug now is OFF by default;
-;;;   enable it if you have problems
-;;;
-
-
-
-;;; Code:
-
-;;
-;; move/paste code
-;;
-
-(defvar mouse-copy-last-paste-start nil
-  "Internal to `mouse-drag-secondary-pasting'.")
-(defvar mouse-copy-last-paste-end nil
-  "Internal to `mouse-drag-secondary-pasting'.")
-
-(defvar mouse-copy-have-drag-bug nil
-  "Set to enable mouse-copy-work-around-drag-bug.
-See `mouse-copy-work-around-drag-bug' for details.")
-
-(defun mouse-copy-work-around-drag-bug (start-event end-event)
-  "Code to work around a bug in post-19.29 emacs:  it drops mouse-drag events.
-The problem occurs under XFree86-3.1.1 (X11R6pl11) but not under X11R5,
-and under post-19.29 but not early versions of emacs.
-
-19.29 and 19.30 seems to drop mouse drag events
-sometimes. (Reproducable under XFree86-3.1.1 (X11R6pl11) and
-XFree86-3.1.2 under Linux 1.2.x.  Doesn't occur under X11R5 and SunOS
-4.1.1.)
-
-To see if you have the problem:
-Disable this routine (with (setq mouse-copy-have-drag-bug nil))..
-Click and drag for a while.
-If highlighting stops tracking, you have the bug.
-If you have the bug (or the real fix :-), please let me know."
-
-  ;; To work-around, call mouse-set-secondary with a fake
-  ;; drag event to set the overlay,
-  ;; the load the x-selection.
-  (save-excursion
-    (let*
-	((start-posn (event-start start-event))
-	 (end-posn (event-end end-event))
-	 (end-buffer (window-buffer (posn-window end-posn)))
-	 ;; First, figure out the region (left as point/mark).
-	 (range (progn
-		  (set-buffer end-buffer)
-		  (mouse-start-end (posn-point start-posn)
-				 (posn-point end-posn)
-				 (1- (event-click-count start-event)))))
-	 (beg (car range))
-	 (end (car (cdr range))))
-      ;; Second, set the overlay.
-      (if mouse-secondary-overlay
-	  (move-overlay mouse-secondary-overlay beg end)
-	(setq mouse-secondary-overlay (make-overlay beg (posn-point end))))
-      (overlay-put mouse-secondary-overlay 'face 'secondary-selection)
-      ;; Third, set the selection.
-      ;; (setq me-beg beg me-end end me-range range)  ; for debugging
-      (set-buffer end-buffer)
-      (x-set-selection 'SECONDARY (buffer-substring beg end)))))
-
-    
-(defun mouse-drag-secondary-pasting (start-event)
-  "Drag out a secondary selection, then paste it at the current point.
-
-To test this function, evaluate:
-	(global-set-key [M-down-mouse-1] 'mouse-drag-secondary-pasting)
-put the point at one place, then click and drag over some other region."
-  (interactive "e")
-  ;; Work-around: We see and react to each part of a multi-click event
-  ;; as it proceeds.  For a triple-event, this means the double-event
-  ;; has already copied something that the triple-event will re-copy
-  ;; (a Bad Thing).  We therefore undo the prior insertion if we're on
-  ;; a multiple event.
-  (if (and mouse-copy-last-paste-start
-	   (>= (event-click-count start-event) 2))
-      (delete-region mouse-copy-last-paste-start
-		     mouse-copy-last-paste-end))
-
-  ;; HACK: We assume that mouse-drag-secondary returns nil if
-  ;; there's no secondary selection.  This assumption holds as of
-  ;; emacs-19.22 but is not documented.  It's not clear that there's
-  ;; any other way to get this information.
-  (if (mouse-drag-secondary start-event)
-      (progn
-	(if mouse-copy-have-drag-bug
-	    (mouse-copy-work-around-drag-bug start-event last-input-event))
-	;; Remember what we do so we can undo it, if necessary.
-	(setq mouse-copy-last-paste-start (point))
-	(insert (x-get-selection 'SECONDARY))
-	(setq mouse-copy-last-paste-end (point)))
-    (setq mouse-copy-last-paste-start nil)))
-  
-
-(defun mouse-kill-preserving-secondary ()
-  "Kill the text in the secondary selection, but leave the selection set.
-
-This command is like \\[mouse-kill-secondary] (that is, the secondary
-selection is deleted and placed in the kill ring), except that it also
-leaves the secondary buffer active on exit.
-
-This command was derived from mouse-kill-secondary in emacs-19.28
-by johnh@ficus.cs.ucla.edu."
-  (interactive)
-  (let* ((keys (this-command-keys))
-	 (click (elt keys (1- (length keys)))))
-    (or (eq (overlay-buffer mouse-secondary-overlay)
-	    (if (listp click)
-		(window-buffer (posn-window (event-start click)))
-	      (current-buffer)))
-	(error "Select or click on the buffer where the secondary selection is")))
-  (save-excursion
-    (set-buffer (overlay-buffer mouse-secondary-overlay))
-    (kill-region (overlay-start mouse-secondary-overlay)
-		 (overlay-end mouse-secondary-overlay)))
-  ;; (delete-overlay mouse-secondary-overlay)
-  ;; (x-set-selection 'SECONDARY nil)
-  ;; (setq mouse-secondary-overlay nil)
-)
-
-(defun mouse-drag-secondary-moving (start-event)
-  "Sweep out a secondary selection, then move it to the current point."
-  (interactive "e")
-  ;; HACK:  We assume that mouse-drag-secondary returns nil if
-  ;; there's no secondary selection.  This works as of emacs-19.22.
-  ;; It's not clear that there's any other way to get this information.
-  (if (mouse-drag-secondary start-event)
-      (progn
-	(mouse-kill-preserving-secondary)
-	(insert (x-get-selection 'SECONDARY))))
-)
-
-(provide 'mouse-copy)
-
-;;; mouse-copy.el ends here
diff --git a/lisp/mouse-drag.el b/lisp/mouse-drag.el
deleted file mode 100644
index 6a5b7c4d216..00000000000
--- a/lisp/mouse-drag.el
+++ /dev/null
@@ -1,345 +0,0 @@
-;;; mouse-drag.el -- use mouse-2 to do a new style of scrolling
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: John Heidemann <johnh@ISI.EDU>
-;; Keywords: mouse
-
-;; 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:
-
-;;; What is ``mouse-drag.el''?
-;;;
-;;; Doesn't that scroll bar seem far away when you want to scroll?
-;;; This module overloads mouse-2 to do ``throw'' scrolling.  You
-;;; click and drag.  The distance you move from your original click
-;;; turns into a scroll amount.  The scroll amount is scaled
-;;; exponentially to make both large moves and short adjustments easy.
-;;; What this boils down to is that you can easily scroll around the
-;;; buffer without much mouse movement.  Finally, clicks which aren't
-;;; drags are passed off to the old mouse-2 binding, so old mouse-2
-;;; operations (find-file in dired-mode, yanking in most other modes)
-;;; still work.
-;;;
-;;; There is an alternative way to scroll, ``drag'' scrolling.  You
-;;; can click on a character and then drag it around, scrolling the
-;;; buffer with you.  The character always stays under the mouse.
-;;; Compared to throw-scrolling, this approach provides direct
-;;; manipulation (nice) but requires more mouse movement
-;;; (unfortunate).  It is offered as an alternative for those who
-;;; prefer it.
-;;;
-;;; If you like mouse-drag, you should also check out mouse-copy
-;;; for ``one-click text copy and move''.
-;;;
-;;; To use mouse-drag, place the following in your .emacs file:
-;;;	(require 'mouse-drag)
-;;; -and either-
-;;;     (global-set-key [down-mouse-2] 'mouse-drag-throw)
-;;; -or-
-;;;     (global-set-key [down-mouse-2] 'mouse-drag-drag)
-;;;
-;;;
-;;;
-;;; Options:
-;;;
-;;; - reverse the throw-scroll direction with \\[mouse-throw-with-scroll-bar]
-;;; - work around a bug with \\[mouse-extras-work-around-drag-bug]
-;;;
-;;;
-;;; History and related work:
-;;;
-;;; One-click copying and moving was inspired by lemacs-19.8.
-;;; Throw-scrolling was inspired by MacPaint's ``hand'' and by Tk's
-;;; mouse-2 scrolling.  The package mouse-scroll.el by Tom Wurgler
-;;; <twurgler@goodyear.com> is similar to mouse-drag-throw, but
-;;; doesn't pass clicks through.
-;;;
-;;; These functions have been tested in emacs version 19.30,
-;;; and this package has run in the past on 19.25-19.29.
-;;;
-;;; Originally mouse-drag was part of a larger package.
-;;; As of 11 July 96 the scrolling functions were split out
-;;; in preparation for incorporation into (the future) emacs-19.32.
-;;;
-;;;
-;;; Thanks:
-;;;
-;;; Thanks to Kai Grossjohann
-;;; <grossjoh@dusty.informatik.uni-dortmund.de> for reporting bugs, to
-;;; Tom Wurgler <twurgler@goodyear.com> for reporting bugs and
-;;; suggesting fixes, and to Joel Graber <jgraber@ti.com> for
-;;; prompting me to do drag-scrolling and for an initial
-;;; implementation of horizontal drag-scrolling.
-;;;
-;;;    -johnh@isi.edu, 11-Jul-96
-;;;
-;;;
-;;; Old changes, for reference:
-;;;
-;;; What's new with mouse-extras 2.21?
-;;;
-;;; - support for emacs-19.{29,30}
-;;; - point now stays on the visible screen during horizontal scrolling
-;;;   (bug identified and fix suggested by Tom Wurgler <twurgler@goodyear.com>)
-;;; - better work-around for lost-mouse-events bug (supports double/triple
-;;;   clicks), see \\[mouse-extras-work-around-drag-bug] for details.
-;;; - work-around for lost-mouse-events bug now is OFF by default;
-;;;   enable it if you have problems
-;;;
-
-
-
-;;; Code:
-
-;;
-;; scrolling code
-;;
-
-(defun mouse-drag-safe-scroll (row-delta &optional col-delta)
-  "* Scroll down ROW-DELTA lines and right COL-DELTA, ignoring buffer edge errors.
-Keep the cursor on the screen as needed."
-  (if (and row-delta
-	   (/= 0 row-delta))
-      (condition-case nil   ;; catch and ignore movement errors
-	  (scroll-down row-delta)
-	(beginning-of-buffer (message "Beginning of buffer"))
-	(end-of-buffer (message "End of buffer"))))
-  (if (and col-delta
-	   (/= 0 col-delta))
-      (progn
-	(scroll-right col-delta)
-	;; Make sure that the point stays on the visible screen
-	;; (if truncation-lines in set).
-	;; This code mimics the behavior we automatically get 
-	;; when doing vertical scrolling.
-	;; Problem identified and a fix suggested by Tom Wurgler.
-	(cond
-	 ((< (current-column) (window-hscroll))
-	  (move-to-column (window-hscroll))) ; make on left column
-	 ((> (- (current-column) (window-hscroll) (window-width) -2) 0)
-	  (move-to-column (+ (window-width) (window-hscroll) -3)))))))
-
-(defun mouse-drag-repeatedly-safe-scroll (row-delta &optional col-delta)
-  "* Scroll ROW-DELTA rows and COL-DELTA cols until an event happens."
-  (while (sit-for mouse-scroll-delay)
-    (mouse-drag-safe-scroll row-delta col-delta)))
-
-(defun mouse-drag-events-are-point-events-p (start-posn end-posn)
-  "* Determine if START-POSN and END-POSN are \"close\"."
-  (let*
-      ((start-col-row (posn-col-row start-posn))
-       (end-col-row (posn-col-row end-posn)))
-    (and
-;; We no longer exclude things by time.
-;;     (< (- (posn-timestamp end-posn) (posn-timestamp start-posn))
-;;	(if (numberp double-click-time)
-;;	    (* 2 double-click-time)   ;; stretch it a little
-;;	  999999)) ;; non-numeric => check by position alone
-     (= (car start-col-row) (car end-col-row))
-     (= (cdr start-col-row) (cdr end-col-row)))))
-
-(defun mouse-drag-should-do-col-scrolling ()
-  "* Determine if it's wise to enable col-scrolling for the current window."
-  (or truncate-lines
-      (> (window-hscroll (selected-window)) 0)
-      (< (window-width) (screen-width))))
-
-(defvar mouse-throw-with-scroll-bar nil
-  "* Set direction of mouse-throwing.
-If nil, the text moves in the direction the mouse moves.
-If t, the scroll bar moves in the direction the mouse moves.")
-(defconst mouse-throw-magnifier-with-scroll-bar 
-      [-16 -8 -4 -2 -1 0 0 0  1  2  4  8  16])
-(defconst mouse-throw-magnifier-with-mouse-movement
-      [ 16  8  4  2  1 0 0 0 -1 -2 -4 -8 -16])
-(defconst mouse-throw-magnifier-min -6)
-(defconst mouse-throw-magnifier-max 6)
-
-(defun mouse-drag-throw (start-event)
-  "\"Throw\" the page according to a mouse drag.
-
-A \"throw\" is scrolling the page at a speed relative to the distance
-from the original mouse click to the current mouse location.  Try it;
-you'll like it.  It's easier to observe than to explain.
-
-If the mouse is clicked and released in the same place of time we
-assume that the user didn't want to scdebugroll but wanted to whatever
-mouse-2 used to do, so we pass it through.
-
-Throw scrolling was inspired (but is not identical to) the \"hand\"
-option in MacPaint, or the middle button in Tk text widgets.
-
-If `mouse-throw-with-scroll-bar' is non-nil, then this command scrolls
-in the opposite direction.  (Different people have different ideas
-about which direction is natural.  Perhaps it has to do with which
-hemisphere you're in.)
-
-To test this function, evaluate:
-    (global-set-key [down-mouse-2] 'mouse-drag-throw)"
-  (interactive "e")
-  ;; we want to do save-selected-window, but that requires 19.29
-  (let* ((start-posn (event-start start-event))
-	 (start-window (posn-window start-posn))
-	 (start-row (cdr (posn-col-row start-posn)))
-	 (start-col (car (posn-col-row start-posn)))
-	 (old-selected-window (selected-window))
-	 event end row mouse-delta scroll-delta
-	 have-scrolled point-event-p old-binding
-	 window-last-row
-	 col mouse-col-delta window-last-col
-	 (scroll-col-delta 0)
-	 adjusted-mouse-col-delta
-	 adjusted-mouse-delta
-	 ;; be conservative about allowing horizontal scrolling
-	 (col-scrolling-p (mouse-drag-should-do-col-scrolling)))
-    (select-window start-window)
-    (track-mouse
-      (while (progn
-	       (setq event (read-event)
-		     end (event-end event)
-		     row (cdr (posn-col-row end))
-		     col (car (posn-col-row end)))
-	       (or (mouse-movement-p event)
-		   (eq (car-safe event) 'switch-frame)))
-	(if (eq start-window (posn-window end))
-	    (progn
-	      (setq mouse-delta (- start-row row)
-		    adjusted-mouse-delta
-		    (- (cond
-			((<= mouse-delta mouse-throw-magnifier-min)
-			 mouse-throw-magnifier-min)
-			((>= mouse-delta mouse-throw-magnifier-max)
-			 mouse-throw-magnifier-max)
-			(t mouse-delta))
-		       mouse-throw-magnifier-min)
-		    scroll-delta (aref (if mouse-throw-with-scroll-bar
-					   mouse-throw-magnifier-with-scroll-bar
-					 mouse-throw-magnifier-with-mouse-movement)
-				       adjusted-mouse-delta))
-	      (if col-scrolling-p
-		  (setq mouse-col-delta (- start-col col)
-			adjusted-mouse-col-delta
-			(- (cond
-			    ((<= mouse-col-delta mouse-throw-magnifier-min)
-			     mouse-throw-magnifier-min)
-			    ((>= mouse-col-delta mouse-throw-magnifier-max)
-			     mouse-throw-magnifier-max)
-			    (t mouse-col-delta))
-			   mouse-throw-magnifier-min)
-			scroll-col-delta (aref (if mouse-throw-with-scroll-bar
-						   mouse-throw-magnifier-with-scroll-bar
-						 mouse-throw-magnifier-with-mouse-movement)
-					       adjusted-mouse-col-delta)))))
-	(if (or (/= 0 scroll-delta)
-		(/= 0 scroll-col-delta))
-	    (progn
-	      (setq have-scrolled t)
-	      (mouse-drag-safe-scroll scroll-delta scroll-col-delta)
-	      (mouse-drag-repeatedly-safe-scroll scroll-delta scroll-col-delta))))) ;xxx
-    ;; If it was a click and not a drag, prepare to pass the event on.
-    ;; Note:  We must determine the pass-through event before restoring
-    ;; the window, but invoke it after.  Sigh.
-    (if (and (not have-scrolled)
-	     (mouse-drag-events-are-point-events-p start-posn end))
-	(setq point-event-p t
-	      old-binding (key-binding
-			   (vector (event-basic-type start-event)))))
-    ;; Now restore the old window.
-    (select-window old-selected-window)
-    ;; For clicks, call the old function.
-    (if point-event-p
-	(call-interactively old-binding))))
-
-(defun mouse-drag-drag (start-event)
-  "\"Drag\" the page according to a mouse drag.
-
-Drag scrolling moves the page according to the movement of the mouse.
-You \"grab\" the character under the mouse and move it around.
-
-If the mouse is clicked and released in the same place of time we
-assume that the user didn't want to scroll but wanted to whatever
-mouse-2 used to do, so we pass it through.
-
-Drag scrolling is identical to the \"hand\" option in MacPaint, or the
-middle button in Tk text widgets.
-
-To test this function, evaluate:
-    (global-set-key [down-mouse-2] 'mouse-drag-drag)"
-  (interactive "e")
-  ;; we want to do save-selected-window, but that requires 19.29
-  (let* ((start-posn (event-start start-event))
-	 (start-window (posn-window start-posn))
-	 (start-row (cdr (posn-col-row start-posn)))
-	 (start-col (car (posn-col-row start-posn)))
-	 (old-selected-window (selected-window))
-	 event end row mouse-delta scroll-delta
-	 have-scrolled point-event-p old-binding
-	 window-last-row
-	 col mouse-col-delta window-last-col
-	 (scroll-col-delta 0)
-	 ;; be conservative about allowing horizontal scrolling
-	 (col-scrolling-p (mouse-drag-should-do-col-scrolling)))
-    (select-window start-window)
-    (setq window-last-row (- (window-height) 2)
-	  window-last-col (- (window-width) 2))
-    (track-mouse
-      (while (progn
-	       (setq event (read-event)
-		     end (event-end event)
-		     row (cdr (posn-col-row end))
-		     col (car (posn-col-row end)))
-	       (or (mouse-movement-p event)
-		   (eq (car-safe event) 'switch-frame)))
-	;; Scroll if see if we're on the edge.
-	;; NEEDSWORK: should handle mouse-in-other window.
-	(cond
-	 ((not (eq start-window (posn-window end)))
-	  t) ; wait for return to original window
-	 ((<= row 0) (mouse-drag-repeatedly-safe-scroll -1 0))
-	 ((>= row window-last-row) (mouse-drag-repeatedly-safe-scroll 1 0))
-	 ((and col-scrolling-p (<= col 1)) (mouse-drag-repeatedly-safe-scroll 0 -1))
-	 ((and col-scrolling-p (>= col window-last-col)) (mouse-drag-repeatedly-safe-scroll 0 1))
-	 (t
-	  (setq scroll-delta (- row start-row)
-		start-row row)
-	  (if col-scrolling-p
-	      (setq scroll-col-delta (- col start-col)
-		    start-col col))
-	  (if (or (/= 0 scroll-delta)
-		  (/= 0 scroll-col-delta))
-	      (progn
-		(setq have-scrolled t)
-		(mouse-drag-safe-scroll scroll-delta scroll-col-delta)))))))
-    ;; If it was a click and not a drag, prepare to pass the event on.
-    ;; Note:  We must determine the pass-through event before restoring
-    ;; the window, but invoke it after.  Sigh.
-    (if (and (not have-scrolled)
-	     (mouse-drag-events-are-point-events-p start-posn end))
-	(setq point-event-p t
-	      old-binding (key-binding
-			   (vector (event-basic-type start-event)))))
-    ;; Now restore the old window.
-    (select-window old-selected-window)
-    ;; For clicks, call the old function.
-    (if point-event-p
-	(call-interactively old-binding))))
-
-(provide 'mouse-drag)
-
-;;; mouse-drag.el ends here
diff --git a/lisp/mouse-sel.el b/lisp/mouse-sel.el
deleted file mode 100644
index fdcd9a3e623..00000000000
--- a/lisp/mouse-sel.el
+++ /dev/null
@@ -1,646 +0,0 @@
-;;; mouse-sel.el --- Multi-click selection support for Emacs 19
-
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
-;; Keywords: mouse
-
-;; 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 module provides multi-click mouse support for GNU Emacs versions
-;; 19.18 and later.  I've tried to make it behave more like standard X
-;; clients (eg. xterm) than the default Emacs 19 mouse selection handlers.
-;; Basically:
-;;
-;;   * Clicking mouse-1 starts (cancels) selection, dragging extends it.
-;;
-;;   * Clicking or dragging mouse-3 extends the selection as well.
-;;
-;;   * Double-clicking on word constituents selects words.
-;;     Double-clicking on symbol constituents selects symbols.
-;;     Double-clicking on quotes or parentheses selects sexps.
-;;     Double-clicking on whitespace selects whitespace.
-;;     Triple-clicking selects lines.
-;;     Quad-clicking selects paragraphs.
-;;
-;;   * Selecting sets the region & X primary selection, but does NOT affect
-;;     the kill-ring.  Because the mouse handlers set the primary selection
-;;     directly, mouse-sel sets the variables interprogram-cut-function
-;;     and interprogram-paste-function to nil.
-;;
-;;   * Clicking mouse-2 inserts the contents of the primary selection at
-;;     the mouse position (or point, if mouse-yank-at-point is non-nil).
-;;
-;;   * Pressing mouse-2 while selecting or extending copies selection
-;;     to the kill ring.  Pressing mouse-1 or mouse-3 kills it.
-;;     
-;;   * Double-clicking mouse-3 also kills selection.
-;;     
-;;   * M-mouse-1, M-mouse-2 & M-mouse-3 work similarly to mouse-1, mouse-2
-;;     & mouse-3, but operate on the X secondary selection rather than the
-;;     primary selection and region.
-;;
-;; This module requires my thingatpt.el module, which it uses to find the
-;; bounds of words, lines, sexps, etc.
-;;
-;; Thanks to KevinB@bartley.demon.co.uk for his useful input.
-;;
-;;--- Customisation -------------------------------------------------------
-;;
-;; * You may want to use none or more of following:
-;;
-;;      ;; Enable region highlight
-;;      (transient-mark-mode 1)
-;;
-;;      ;; But only in the selected window
-;;      (setq highlight-nonselected-windows nil)
-;;      
-;;      ;; Enable pending-delete
-;;      (delete-selection-mode 1)
-;;
-;; * You can control the way mouse-sel binds its keys by setting the value
-;;   of mouse-sel-default-bindings before loading mouse-sel.
-;;
-;;   (a) If mouse-sel-default-bindings = t (the default)
-;;   
-;;       Mouse sets and insert selection
-;;	   mouse-1		mouse-select
-;;	   mouse-2		mouse-insert-selection
-;; 	   mouse-3		mouse-extend
-;;
-;;       Selection/kill-ring interaction is disabled
-;;         interprogram-cut-function   = nil
-;;         interprogram-paste-function = nil
-;;
-;;   (b) If mouse-sel-default-bindings = 'interprogram-cut-paste
-;;   
-;;       Mouse sets selection, and pastes from kill-ring
-;; 	   mouse-1		mouse-select
-;; 	   mouse-2		mouse-yank-at-click
-;; 	   mouse-3		mouse-extend
-;;  
-;;       Selection/kill-ring interaction is retained
-;;         interprogram-cut-function   = x-select-text
-;;         interprogram-paste-function = x-cut-buffer-or-selection-value
-;;         
-;;       What you lose is the ability to select some text in
-;;       delete-selection-mode and yank over the top of it.
-;;       
-;;   (c) If mouse-sel-default-bindings = nil, no bindings are made.
-;;
-;; * By default, mouse-insert-selection (mouse-2) inserts the selection at
-;;   the mouse position.  You can tell it to insert at point instead with:
-;;
-;;     (setq mouse-yank-at-point t)
-;;
-;; * I like to leave point at the end of the region nearest to where the
-;;   mouse was, even though this makes region highlighting mis-leading (the
-;;   cursor makes it look like one extra character is selected).  You can
-;;   disable this behaviour with:
-;;
-;;     (setq mouse-sel-leave-point-near-mouse nil)
-;;
-;; * By default, mouse-select cycles the click count after 4 clicks.  That
-;;   is, clicking mouse-1 five times has the same effect as clicking it
-;;   once, clicking six times has the same effect as clicking twice, etc.
-;;   Disable this behaviour with:
-;;
-;;     (setq mouse-sel-cycle-clicks nil)
-;;
-;; * The variables mouse-sel-{set,get}-selection-function control how the
-;;   selection is handled.  Under X Windows, these variables default so
-;;   that the X primary selection is used.  Under other windowing systems,
-;;   alternate functions are used, which simply store the selection value
-;;   in a variable.
-;;
-;; * You can change the selection highlight face by altering the properties
-;;   of mouse-drag-overlay, eg.
-;;
-;;     (overlay-put mouse-drag-overlay 'face 'bold)
-
-;;; Code:
-
-(provide 'mouse-sel)
-
-(require 'mouse)
-(require 'thingatpt)
-
-;;=== User Variables ======================================================
-
-(defvar mouse-sel-leave-point-near-mouse t
-  "*Leave point near last mouse position.
-If non-nil, \\[mouse-select] and \\[mouse-extend] will leave point at the end
-of the region nearest to where the mouse last was.
-If nil, point will always be placed at the beginning of the region.")
-
-(defvar mouse-sel-cycle-clicks t
-  "*If non-nil, \\[mouse-select] cycles the click-counts after 4 clicks.")
-
-(defvar mouse-sel-default-bindings t
-  "Set to nil before loading `mouse-sel' to prevent default mouse bindings.")
-
-;;=== Internal Variables/Constants ========================================
-
-(defvar mouse-sel-primary-thing nil 
-  "Type of PRIMARY selection in current buffer.")
-(make-variable-buffer-local 'mouse-sel-primary-thing)
-
-(defvar mouse-sel-secondary-thing nil 
-  "Type of SECONDARY selection in current buffer.")
-(make-variable-buffer-local 'mouse-sel-secondary-thing)
-
-;; Ensure that secondary overlay is defined
-(if (overlayp mouse-secondary-overlay) nil
-  (setq mouse-secondary-overlay (make-overlay 1 1))
-  (overlay-put mouse-secondary-overlay 'face 'secondary-selection))
-
-(defconst mouse-sel-selection-alist
-  '((PRIMARY mouse-drag-overlay mouse-sel-primary-thing)
-    (SECONDARY mouse-secondary-overlay mouse-sel-secondary-thing))
-  "Alist associating selections with variables.  Each element is of
-the form:
-
-   (SELECTION-NAME OVERLAY-SYMBOL SELECTION-THING-SYMBOL)
-
-where   SELECTION-NAME          = name of selection
-        OVERLAY-SYMBOL          = name of variable containing overlay to use
-	SELECTION-THING-SYMBOL 	= name of variable where the current selection
- 				  type for this selection should be stored.")
-    
-(defvar mouse-sel-set-selection-function 
-  (function (lambda (selection value)
-	      (if (eq selection 'PRIMARY)
-		  (x-select-text value)
-		(x-set-selection selection value))))
-  "Function to call to set selection.
-Called with two arguments:
-
-  SELECTION, the name of the selection concerned, and
-  VALUE, the text to store.
-This sets the selection as well as the cut buffer for the older applications.
-Use (setq mouse-sel-set-selection-function 'x-set-selection) if you don't care
-for them.")
-
-(defvar mouse-sel-get-selection-function
-  (function (lambda (selection)
-	      (if (eq selection 'PRIMARY)
-		  (x-cut-buffer-or-selection-value)
-		(x-get-selection selection))))
-  "Function to call to get the selection.
-Called with one argument:
-
-   SELECTION: the name of the selection concerned.")
-
-;;=== Support/access functions ============================================
-
-(defun mouse-sel-determine-selection-thing (nclicks)
-  "Determine what `thing' `mouse-sel' should operate on.
-The first argument is NCLICKS, is the number of consecutive
-mouse clicks at the same position.
-
-Double-clicking on word constituents selects words.
-Double-clicking on symbol constituents selects symbols.
-Double-clicking on quotes or parentheses selects sexps.
-Double-clicking on whitespace selects whitespace.
-Triple-clicking selects lines.
-Quad-clicking selects paragraphs.
-
-Feel free to re-define this function to support your own desired
-multi-click semantics."
-  (let* ((next-char (char-after (point)))
-	 (char-syntax (if next-char (char-syntax next-char))))
-    (if mouse-sel-cycle-clicks 
-	(setq nclicks (1+ (% (1- nclicks) 4))))
-    (cond
-     ((= nclicks 1) nil)
-     ((= nclicks 3) 'line)
-     ((>= nclicks 4) 'paragraph)
-     ((memq char-syntax '(?\( ?\) ?\" ?')) 'sexp)
-     ((memq next-char '(? ?\t ?\n)) 'whitespace)
-     ((eq char-syntax ?_) 'symbol)
-     ((eq char-syntax ?w) 'word))))
-
-(defun mouse-sel-set-selection (selection value)
-  "Set the specified SELECTION to VALUE."
-  (if mouse-sel-set-selection-function
-      (funcall mouse-sel-set-selection-function selection value)
-    (put 'mouse-sel-internal-selection selection value)))
-
-(defun mouse-sel-get-selection (selection)
-  "Get the value of the specified SELECTION."
-  (if mouse-sel-get-selection-function
-      (funcall mouse-sel-get-selection-function selection)
-    (get 'mouse-sel-internal-selection selection)))
-
-(defun mouse-sel-selection-overlay (selection)
-  "Return overlay corresponding to SELECTION."
-  (let ((symbol (nth 1 (assoc selection mouse-sel-selection-alist))))
-    (or symbol (error "No overlay corresponding to %s selection" selection))
-    (symbol-value symbol)))
-
-(defun mouse-sel-selection-thing (selection)
-  "Return overlay corresponding to SELECTION."
-  (let ((symbol (nth 2 (assoc selection mouse-sel-selection-alist))))
-    (or symbol (error "No symbol corresponding to %s selection" selection))
-    symbol))
-
-(defun mouse-sel-region-to-primary (orig-window)
-  "Convert region to PRIMARY overlay and deactivate region.
-Argument ORIG-WINDOW specifies the window the cursor was in when the 
-originating command was issued, and is used to determine whether the 
-region was visible or not."
-  (if transient-mark-mode
-      (let ((overlay (mouse-sel-selection-overlay 'PRIMARY)))
-	(cond
-	 ((and mark-active 
-	       (or highlight-nonselected-windows 
-		   (eq orig-window (selected-window))))
-	  ;; Region was visible, so convert region to overlay
-	  (move-overlay overlay (region-beginning) (region-end) 
-			(current-buffer)))
-	 ((eq orig-window (selected-window))
-	  ;; Point was visible, so set overlay at point
-	  (move-overlay overlay (point) (point) (current-buffer)))
-	 (t
-	  ;; Nothing was visible, so remove overlay
-	  (delete-overlay overlay)))
-	(setq mark-active nil))))
-
-(defun mouse-sel-primary-to-region (&optional direction)
-  "Convert PRIMARY overlay to region.
-Optional argument DIRECTION specifies the mouse drag direction: a value of
-1 indicates that the mouse was dragged left-to-right, otherwise it was
-dragged right-to-left."
-  (let* ((overlay (mouse-sel-selection-overlay 'PRIMARY))
-	 (start (overlay-start overlay))
-	 (end (overlay-end overlay)))
-    (if (eq start end)
-	(progn
-	  (if start (goto-char start))
-	  (deactivate-mark))
-      (if (and mouse-sel-leave-point-near-mouse (eq direction 1))
-	  (progn
-	    (goto-char end)
-	    (push-mark start 'nomsg 'active))
-	(goto-char start)
-	(push-mark end 'nomsg 'active)))
-    (if transient-mark-mode (delete-overlay overlay))))
-
-(defmacro mouse-sel-eval-at-event-end (event &rest forms)
-  "Evaluate forms at mouse position.
-Move to the end position of EVENT, execute FORMS, and restore original
-point and window."
-    (` 
-     (let ((posn (event-end (, event))))
-       (if posn (mouse-minibuffer-check (, event)))
-       (if (and posn (not (windowp (posn-window posn))))
-	   (error "Cursor not in text area of window"))
-       (let (orig-window orig-point-marker)
-	 (setq orig-window (selected-window))
-	 (if posn (select-window (posn-window posn)))
-	 (setq orig-point-marker (point-marker))
-	 (if (and posn (numberp (posn-point posn)))
-	     (goto-char (posn-point posn)))
-	 (unwind-protect
-	     (progn
-	       (,@ forms))
-	   (goto-char (marker-position orig-point-marker))
-	   (move-marker orig-point-marker nil)
-	   (select-window orig-window)
-	   )))))
-
-(put 'mouse-sel-eval-at-event-end 'lisp-indent-hook 1)
-
-;;=== Select ==============================================================
-
-(defun mouse-select (event)
-  "Set region/selection using the mouse.
-
-Click sets point & mark to click position.
-Dragging extends region/selection.
-
-Multi-clicking selects word/lines/paragraphs, as determined by 
-'mouse-sel-determine-selection-thing.
-
-Clicking mouse-2 while selecting copies selected text to the kill-ring.
-Clicking mouse-1 or mouse-3 kills the selected text.
-
-This should be bound to a down-mouse event."
-  (interactive "@e")
-  (let (direction)
-    (unwind-protect
-	(setq direction (mouse-select-internal 'PRIMARY event))
-      (mouse-sel-primary-to-region direction))))
-
-(defun mouse-select-secondary (event)
-   "Set secondary selection using the mouse.
-
-Click sets the start of the secondary selection to click position.
-Dragging extends the secondary selection.
-
-Multi-clicking selects word/lines/paragraphs, as determined by 
-'mouse-sel-determine-selection-thing.
-
-Clicking mouse-2 while selecting copies selected text to the kill-ring.
-Clicking mouse-1 or mouse-3 kills the selected text.
-
-This should be bound to a down-mouse event."
-   (interactive "e")
-  (mouse-select-internal 'SECONDARY event))
-
-(defun mouse-select-internal (selection event)
-  "Set SELECTION using the mouse."
-  (mouse-sel-eval-at-event-end event
-    (let ((thing-symbol (mouse-sel-selection-thing selection))
-	  (overlay (mouse-sel-selection-overlay selection)))
-      (set thing-symbol
-	   (mouse-sel-determine-selection-thing (event-click-count event)))
-      (let ((object-bounds (bounds-of-thing-at-point
-			    (symbol-value thing-symbol))))
-	(if object-bounds
-	    (progn
-	      (move-overlay overlay
-			    (car object-bounds) (cdr object-bounds)
-			    (current-buffer)))
-	  (move-overlay overlay (point) (point) (current-buffer)))))
-    (mouse-extend-internal selection)))
-
-;;=== Extend ==============================================================
-
-(defun mouse-extend (event)
-  "Extend region/selection using the mouse."
-  (interactive "e")
-  (let ((orig-window (selected-window))
-	direction)
-    (select-window (posn-window (event-end event)))
-    (unwind-protect
-	(progn
-	  (mouse-sel-region-to-primary orig-window)
-	  (setq direction (mouse-extend-internal 'PRIMARY event)))
-      (mouse-sel-primary-to-region direction))))
-
-(defun mouse-extend-secondary (event)
-  "Extend secondary selection using the mouse."
-  (interactive "e")
-  (save-window-excursion
-    (mouse-extend-internal 'SECONDARY event)))
-
-(defun mouse-extend-internal (selection &optional initial-event)
-  "Extend specified SELECTION using the mouse.
-Track mouse-motion events, adjusting the SELECTION appropriately.
-Optional argument INITIAL-EVENT specifies an initial down-mouse event to 
-process. 
-
-See documentation for mouse-select-internal for more details."
-  (mouse-sel-eval-at-event-end initial-event
-    (let ((orig-cursor-type 
-	   (cdr (assoc 'cursor-type (frame-parameters (selected-frame))))))
-      (unwind-protect
-
-	  (let* ((thing-symbol (mouse-sel-selection-thing selection))
-		 (overlay (mouse-sel-selection-overlay selection))
-		 (orig-window (selected-window))
-		 (orig-window-frame (window-frame orig-window))
-		 (top (nth 1 (window-edges orig-window)))
-		 (bottom (nth 3 (window-edges orig-window)))
-		 (mark-active nil)	; inhibit normal region highlight
-		 (echo-keystrokes 0)	; don't echo mouse events
-		 min max
-		 direction
-		 event)
-
-	    ;; Get current bounds of overlay
-	    (if (eq (overlay-buffer overlay) (current-buffer))
-		(setq min (overlay-start overlay)
-		      max (overlay-end overlay))
-	      (setq min (point)
-		    max min)
-	      (set thing-symbol nil))
-		    
-
-	    ;; Bar cursor
-	    (if (fboundp 'modify-frame-parameters)
-		(modify-frame-parameters (selected-frame)
-					 '((cursor-type . bar))))
-	    
-	    ;; Handle dragging
-	    (track-mouse
-	    
-	      (while (if initial-event	; Use initial event
-			 (prog1
-			     (setq event initial-event)
-			   (setq initial-event nil))
-		       (setq event (read-event))
-		       (and (consp event)
-			    (memq (car event) '(mouse-movement switch-frame))))
-		
-		(let ((selection-thing (symbol-value thing-symbol))
-		      (end (event-end event)))
-		
-		  (cond
-		     
-		   ;; Ignore any movement outside the frame
-		   ((eq (car-safe event) 'switch-frame) nil)
-		   ((and (posn-window end)
-			 (not (eq (let ((posn-w (posn-window end)))
-				    (if (windowp posn-w)
-					(window-frame posn-w)
-				      posn-w))
-				  (window-frame orig-window)))) nil)
-		     
-		   ;; Different window, same frame
-		   ((not (eq (posn-window end) orig-window))
-		    (let ((end-row (cdr (cdr (mouse-position)))))
-		      (cond
-		       ((and end-row (not (bobp)) (< end-row top))
-			(mouse-scroll-subr orig-window (- end-row top)
-					   overlay max))
-		       ((and end-row (not (eobp)) (>= end-row bottom))
-			(mouse-scroll-subr orig-window (1+ (- end-row bottom))
-					   overlay min))
-		       )))
-		   
-		   ;; On the mode line
-		   ((eq (posn-point end) 'mode-line)
-		    (mouse-scroll-subr orig-window 1 overlay min))
-		   
-		   ;; In original window
-		   (t (goto-char (posn-point end)))
-		   
-		   )
-		  
-		  ;; Determine direction of drag
-		  (cond
-		   ((and (not direction) (not (eq min max)))
-		    (setq direction (if (< (point) (/ (+ min max) 2)) -1 1)))
-		   ((and (not (eq direction -1)) (<= (point) min))
-		    (setq direction -1))
-		   ((and (not (eq direction 1)) (>= (point) max))
-		    (setq direction 1)))
-		  
-		  (if (not selection-thing) nil
-		    
-		    ;; If dragging forward, goal is next character
-		    (if (and (eq direction 1) (not (eobp))) (forward-char 1))
-		    
-		    ;; Move to start/end of selected thing
-		    (let ((goal (point)))
-		      (goto-char (if (eq 1 direction) min max))
-		      (condition-case nil
-			  (progn
-			    (while (> (* direction (- goal (point))) 0)
-			      (forward-thing selection-thing direction))
-			    (let ((end (point)))
-			      (forward-thing selection-thing (- direction))
-			      (goto-char
-			       (if (> (* direction (- goal (point))) 0)
-				   end (point)))))
-			(error))))
-		  
-		  ;; Move overlay
-		  (move-overlay overlay
-				(if (eq 1 direction) min (point))
-				(if (eq -1 direction) max (point))
-				(current-buffer))
-		  
-		  )))			; end track-mouse
-
-	    ;; Finish up after dragging
-	    (let ((overlay-start (overlay-start overlay))
-		  (overlay-end (overlay-end overlay)))
-	      
-	      ;; Set selection
-	      (if (not (eq overlay-start overlay-end))
-		  (mouse-sel-set-selection
-		   selection
-		   (buffer-substring overlay-start overlay-end)))
-	      
-	      ;; Handle copy/kill
-	      (let (this-command)
-		(cond
-		 ((eq (event-basic-type last-input-event) 'mouse-2)
-		  (copy-region-as-kill overlay-start overlay-end)
-		  (read-event) (read-event))
-		 ((and (memq (event-basic-type last-input-event)
-			     '(mouse-1 mouse-3))
-		       (memq 'down (event-modifiers last-input-event)))
-		  (kill-region overlay-start overlay-end)
-		  (move-overlay overlay overlay-start overlay-start)
-		  (read-event) (read-event))
-		 ((and (eq (event-basic-type last-input-event) 'mouse-3)
-		       (memq 'double (event-modifiers last-input-event)))
-		  (kill-region overlay-start overlay-end)
-		  (move-overlay overlay overlay-start overlay-start)))))
-
-	    direction)
-
-	;; Restore cursor
-	(if (fboundp 'modify-frame-parameters)
-	    (modify-frame-parameters 
-	     (selected-frame) (list (cons 'cursor-type orig-cursor-type))))
-	
-	))))
-
-;;=== Paste ===============================================================
-
-(defun mouse-insert-selection (event)
-  "Insert the contents of the PRIMARY selection at mouse click.
-If `mouse-yank-at-point' is non-nil, insert at point instead."
-  (interactive "e")
-  (mouse-insert-selection-internal 'PRIMARY event))
-
-(defun mouse-insert-secondary (event)
-  "Insert the contents of the SECONDARY selection at mouse click.
-If `mouse-yank-at-point' is non-nil, insert at point instead."
-  (interactive "e")
-  (mouse-insert-selection-internal 'SECONDARY event))
-
-(defun mouse-insert-selection-internal (selection event)
-  "Insert the contents of the named SELECTION at mouse click.
-If `mouse-yank-at-point' is non-nil, insert at point instead."
-  (or mouse-yank-at-point 
-      (mouse-set-point event))
-  (if mouse-sel-get-selection-function
-      (progn
-	(push-mark (point) 'nomsg)
-	(insert (or (funcall mouse-sel-get-selection-function selection) "")))))
-
-;;=== Handle loss of selections ===========================================
-
-(defun mouse-sel-lost-selection-hook (selection)
-  "Remove the overlay for a lost selection."
-  (let ((overlay (mouse-sel-selection-overlay selection)))
-    (delete-overlay overlay)))
-
-(add-hook 'x-lost-selection-hooks 'mouse-sel-lost-selection-hook)
-
-;;=== Key bindings ========================================================
-
-(if (not mouse-sel-default-bindings) nil
-  
-  (global-unset-key [mouse-1])
-  (global-unset-key [drag-mouse-1])
-  (global-unset-key [mouse-3])
-  
-  (global-set-key [down-mouse-1]	'mouse-select)
-  (global-set-key [down-mouse-3] 	'mouse-extend)
-
-  (global-unset-key [M-mouse-1])
-  (global-unset-key [M-drag-mouse-1])
-  (global-unset-key [M-mouse-3])
-  
-  (global-set-key [M-down-mouse-1]	'mouse-select-secondary)
-  (global-set-key [M-down-mouse-3] 	'mouse-extend-secondary)
-
-  (if (eq mouse-sel-default-bindings 'interprogram-cut-paste) nil
-    
-    (global-set-key [mouse-2] 		'mouse-insert-selection)
-
-    (setq interprogram-cut-function nil
-	  interprogram-paste-function nil))
-  
-  (global-set-key [M-mouse-2] 		'mouse-insert-secondary)
-    
-  )
-
-;;=== Bug reporting =======================================================
-
-(defconst mouse-sel-maintainer-address "mikew@gopher.dosli.govt.nz")
-
-(defun mouse-sel-submit-bug-report ()
-  "Submit a bug report on mouse-sel.el via mail."
-  (interactive)
-  (require 'reporter)
-  (reporter-submit-bug-report
-   mouse-sel-maintainer-address
-   (concat "mouse-sel.el "
-	    (or (condition-case nil mouse-sel-version (error))
-		"(distributed with Emacs)"))
-   (list 'transient-mark-mode
-	 'delete-selection-mode
-	 'mouse-sel-default-bindings
-	 'mouse-sel-leave-point-near-mouse
-	 'mouse-sel-cycle-clicks
-	 'mouse-sel-selection-alist
-	 'mouse-sel-set-selection-function
-	 'mouse-sel-get-selection-function
-	 'mouse-yank-at-point)))
-
-;; mouse-sel.el ends here.
diff --git a/lisp/mouse.el b/lisp/mouse.el
deleted file mode 100644
index 5613e73c3c1..00000000000
--- a/lisp/mouse.el
+++ /dev/null
@@ -1,1845 +0,0 @@
-;;; mouse.el --- window system-independent mouse support
-
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: hardware
-
-;; 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 provides various useful commands (including help
-;; system access) through the mouse.  All this code assumes that mouse
-;; interpretation has been abstracted into Emacs input events.
-;;
-;; The code is rather X-dependent.
-
-;;; Code:
-
-;;; Utility functions.
-
-;;; Indent track-mouse like progn.
-(put 'track-mouse 'lisp-indent-function 0)
-
-(defvar mouse-yank-at-point nil
-  "*If non-nil, mouse yank commands yank at point instead of at click.")
-
-;; Provide a mode-specific menu on a mouse button.
-
-(defun mouse-major-mode-menu (event prefix)
-  "Pop up a mode-specific menu of mouse commands."
-  ;; Switch to the window clicked on, because otherwise
-  ;; the mode's commands may not make sense.
-  (interactive "@e\nP")
-  (let (;; This is where mouse-major-mode-menu-prefix
-	;; returns the prefix we should use (after menu-bar).
-	;; It is either nil or (SOME-SYMBOL).
-	(mouse-major-mode-menu-prefix nil)
-	;; Make a keymap in which our last command leads to a menu
-	(newmap (make-sparse-keymap (concat mode-name " Mode")))
-	result)
-    ;; Make our menu inherit from the desired keymap
-    ;; which we want to display as the menu now.
-    (set-keymap-parent newmap
-		       (mouse-major-mode-menu-1
-			(and (current-local-map)
-			     (lookup-key (current-local-map) [menu-bar]))))
-    (setq result (x-popup-menu t (list newmap)))
-    (if result
-	(let ((command (key-binding
-			(apply 'vector (append '(menu-bar)
-					       mouse-major-mode-menu-prefix
-					       result)))))
-	  ;; Clear out echoing, which perhaps shows a prefix arg.
-	  (message "")
-	  (if command
-	      (progn
-		(setq prefix-arg prefix)
-		(command-execute command)))))))
-
-;; Compute and cache the equivalent keys in MENU and all its submenus.
-;;;(defun mouse-major-mode-menu-compute-equiv-keys (menu)
-;;;  (and (eq (car menu) 'keymap)
-;;;       (x-popup-menu nil menu))
-;;;  (while menu
-;;;    (and (consp (car menu))
-;;;	 (consp (cdr (car menu)))
-;;;	 (let ((tail (cdr (car menu))))
-;;;	   (while (and (consp tail)
-;;;		       (not (eq (car tail) 'keymap)))
-;;;	     (setq tail (cdr tail)))
-;;;	   (if (consp tail)
-;;;	       (mouse-major-mode-menu-compute-equiv-keys tail))))
-;;;    (setq menu (cdr menu))))
-
-;; Given a mode's menu bar keymap,
-;; if it defines exactly one menu bar menu,
-;; return just that menu.
-;; Otherwise return a menu for all of them.
-(defun mouse-major-mode-menu-1 (menubar)
-  (if menubar
-      (let ((tail menubar)
-	    submap)
-	(while tail
-	  (if (consp (car tail))
-	      (if submap
-		  (setq submap t)
-		(setq submap (car tail))))
-	  (setq tail (cdr tail)))
-	(if (eq submap t)
-	    menubar
-	  (setq mouse-major-mode-menu-prefix (list (car submap)))
-	  (cdr (cdr submap))))))
-
-;; Commands that operate on windows.
-
-(defun mouse-minibuffer-check (event)
-  (let ((w (posn-window (event-start event))))
-    (and (window-minibuffer-p w)
-	 (not (minibuffer-window-active-p w))
-	 (error "Minibuffer window is not active")))
-  ;; Give temporary modes such as isearch a chance to turn off.
-  (run-hooks 'mouse-leave-buffer-hook))
-
-(defun mouse-delete-window (click)
-  "Delete the window you click on.
-This must be bound to a mouse click."
-  (interactive "e")
-  (mouse-minibuffer-check click)
-  (delete-window (posn-window (event-start click))))
-
-(defun mouse-select-window (click)
-  "Select the window clicked on; don't move point."
-  (interactive "e")
-  (mouse-minibuffer-check click)
-  (let ((oframe (selected-frame))
-	(frame (window-frame (posn-window (event-start click)))))
-    (select-window (posn-window (event-start click)))
-    (raise-frame frame)
-    (select-frame frame)
-    (or (eq frame oframe)
-	(set-mouse-position (selected-frame) (1- (frame-width)) 0))))
-
-(defun mouse-tear-off-window (click)
-  "Delete the window clicked on, and create a new frame displaying its buffer."
-  (interactive "e")
-  (mouse-minibuffer-check click)
-  (let* ((window (posn-window (event-start click)))
-	 (buf (window-buffer window))
-	 (frame (make-frame)))
-    (select-frame frame)
-    (switch-to-buffer buf)
-    (delete-window window)))
-
-(defun mouse-delete-other-windows ()
-  "Delete all window except the one you click on."
-  (interactive "@")
-  (delete-other-windows))
-
-(defun mouse-split-window-vertically (click)
-  "Select Emacs window mouse is on, then split it vertically in half.
-The window is split at the line clicked on.
-This command must be bound to a mouse click."
-  (interactive "@e")
-  (mouse-minibuffer-check click)
-  (let ((start (event-start click)))
-    (select-window (posn-window start))
-    (let ((new-height (1+ (cdr (posn-col-row (event-end click)))))
-	  (first-line window-min-height)
-	  (last-line (- (window-height) window-min-height)))
-      (if (< last-line first-line)
-	  (error "Window too short to split")
-	(split-window-vertically
-	 (min (max new-height first-line) last-line))))))
-
-(defun mouse-split-window-horizontally (click)
-  "Select Emacs window mouse is on, then split it horizontally in half.
-The window is split at the column clicked on.
-This command must be bound to a mouse click."
-  (interactive "@e")
-  (mouse-minibuffer-check click)
-  (let ((start (event-start click)))
-    (select-window (posn-window start))
-    (let ((new-width (1+ (car (posn-col-row (event-end click)))))
-	  (first-col window-min-width)
-	  (last-col (- (window-width) window-min-width)))
-      (if (< last-col first-col)
-	  (error "Window too narrow to split")
-	(split-window-horizontally
-	 (min (max new-width first-col) last-col))))))
-
-(defun mouse-drag-mode-line (start-event)
-  "Change the height of a window by dragging on the mode line."
-  (interactive "e")
-  ;; Give temporary modes such as isearch a chance to turn off.
-  (run-hooks 'mouse-leave-buffer-hook)
-  (let ((done nil)
-	(echo-keystrokes 0)
-	(start-event-frame (window-frame (car (car (cdr start-event)))))
-	(start-event-window (car (car (cdr start-event))))
-	(start-nwindows (count-windows t))
-	(old-selected-window (selected-window))
-	should-enlarge-minibuffer
-	event mouse minibuffer y top bot edges wconfig params growth)
-    (setq params (frame-parameters))
-    (setq minibuffer (cdr (assq 'minibuffer params)))
-    (track-mouse
-      (progn
-	;; enlarge-window only works on the selected window, so
-	;; we must select the window where the start event originated.
-	;; unwind-protect will restore the old selected window later.
-	(select-window start-event-window)
-	;; if this is the bottommost ordinary window, then to
-	;; move its modeline the minibuffer must be enlarged.
-	(setq should-enlarge-minibuffer
-	      (and minibuffer
-		   (not (one-window-p t))
-		   (= (nth 1 (window-edges minibuffer))
-		      (nth 3 (window-edges)))))
-	;; loop reading events and sampling the position of
-	;; the mouse.
-	(while (not done)
-	  (setq event (read-event)
-		mouse (mouse-position))
-	  ;; do nothing if
-	  ;;   - there is a switch-frame event.
-	  ;;   - the mouse isn't in the frame that we started in
-	  ;;   - the mouse isn't in any Emacs frame
-	  ;; drag if
-	  ;;   - there is a mouse-movement event
-	  ;;   - there is a scroll-bar-movement event
-	  ;;     (same as mouse movement for our purposes)
-	  ;; quit if
-	  ;;   - there is a keyboard event or some other unknown event
-	  ;;     unknown event.
-	  (cond ((integerp event)
-		 (setq done t))
-		((eq (car event) 'switch-frame)
-		 nil)
-		((not (memq (car event)
-			    '(mouse-movement scroll-bar-movement)))
-		 (if (consp event)
-		     (setq unread-command-events
-			   (cons event unread-command-events)))
-		 (setq done t))
-		((not (eq (car mouse) start-event-frame))
-		 nil)
-		((null (car (cdr mouse)))
-		 nil)
-		(t
-		 (setq y (cdr (cdr mouse))
-		       edges (window-edges)
-		       top (nth 1 edges)
-		       bot (nth 3 edges))
-		 ;; scale back a move that would make the
-		 ;; window too short.
-		 (cond ((< (- y top -1) window-min-height)
-			(setq y (+ top window-min-height -1))))
-		 ;; compute size change needed
-		 (setq growth (- y bot -1)
-		       wconfig (current-window-configuration))
-		 ;; Check for an error case.
-		 (if (and (/= growth 0)
-			  (not minibuffer)
-			  (one-window-p t))
-		     (error "Attempt to resize sole window"))
-		 ;; grow/shrink minibuffer?
-		 (if should-enlarge-minibuffer
-		     (progn
-		       ;; yes.  briefly select minibuffer so
-		       ;; enlarge-window will affect the
-		       ;; correct window.
-		       (select-window minibuffer)
-		       ;; scale back shrinkage if it would
-		       ;; make the minibuffer less than 1
-		       ;; line tall.
-		       (if (and (> growth 0)
-				(< (- (window-height minibuffer)
-				      growth)
-				   1))
-			   (setq growth (1- (window-height minibuffer))))
-		       (enlarge-window (- growth))
-		       (select-window start-event-window))
-		   ;; no.  grow/shrink the selected window
-		   (enlarge-window growth))
-		 ;; if this window's growth caused another
-		 ;; window to be deleted because it was too
-		 ;; short, rescind the change.
-		 ;;
-		 ;; if size change caused space to be stolen
-		 ;; from a window above this one, rescind the
-		 ;; change, but only if we didn't grow/srhink
-		 ;; the minibuffer.  minibuffer size changes
-		 ;; can cause all windows to shrink... no way
-		 ;; around it.
-		 (if (or (/= start-nwindows (count-windows t))
-			 (and (not should-enlarge-minibuffer)
-			      (/= top (nth 1 (window-edges)))))
-		     (set-window-configuration wconfig)))))))))
-
-(defun mouse-drag-vertical-line (start-event)
-  "Change the width of a window by dragging on the vertical line."
-  (interactive "e")
-  ;; Give temporary modes such as isearch a chance to turn off.
-  (run-hooks 'mouse-leave-buffer-hook)
-  (let ((done nil)
-	(echo-keystrokes 0)
-	(start-event-frame (window-frame (car (car (cdr start-event)))))
-	(start-event-window (car (car (cdr start-event))))
-	(start-nwindows (count-windows t))
-	(old-selected-window (selected-window))
-	event mouse x left right edges wconfig growth)
-    (if (one-window-p t)
-	(error "Attempt to resize sole ordinary window"))
-    (if (= (nth 2 (window-edges start-event-window))
-	   (frame-width start-event-frame))
-	(error "Attempt to drag rightmost scrollbar"))
-    (track-mouse
-      (progn
-	;; enlarge-window only works on the selected window, so
-	;; we must select the window where the start event originated.
-	;; unwind-protect will restore the old selected window later.
-	(select-window start-event-window)
-	;; loop reading events and sampling the position of
-	;; the mouse.
-	(while (not done)
-	  (setq event (read-event)
-		mouse (mouse-position))
-	  ;; do nothing if
-	  ;;   - there is a switch-frame event.
-	  ;;   - the mouse isn't in the frame that we started in
-	  ;;   - the mouse isn't in any Emacs frame
-	  ;; drag if
-	  ;;   - there is a mouse-movement event
-	  ;;   - there is a scroll-bar-movement event
-	  ;;     (same as mouse movement for our purposes)
-	  ;; quit if
-	  ;;   - there is a keyboard event or some other unknown event
-	  ;;     unknown event.
-	  (cond ((integerp event)
-		 (setq done t))
-		((eq (car event) 'switch-frame)
-		 nil)
-		((not (memq (car event)
-			    '(mouse-movement scroll-bar-movement)))
-		 (if (consp event)
-		     (setq unread-command-events
-			   (cons event unread-command-events)))
-		 (setq done t))
-		((not (eq (car mouse) start-event-frame))
-		 nil)
-		((null (car (cdr mouse)))
-		 nil)
-		(t
-		 (setq x (car (cdr mouse))
-		       edges (window-edges)
-		       left (nth 0 edges)
-		       right (nth 2 edges))
-		 ;; scale back a move that would make the
-		 ;; window too thin.
-		 (cond ((< (- x left -1) window-min-width)
-			(setq x (+ left window-min-width -1))))
-		 ;; compute size change needed
-		 (setq growth (- x right -1)
-		       wconfig (current-window-configuration))
-		 (enlarge-window growth t)
-		 ;; if this window's growth caused another
-		 ;; window to be deleted because it was too
-		 ;; thin, rescind the change.
-		 ;;
-		 ;; if size change caused space to be stolen
-		 ;; from a window to the left of this one,
-		 ;; rescind the change.
-		 (if (or (/= start-nwindows (count-windows t))
-			 (/= left (nth 0 (window-edges))))
-		     (set-window-configuration wconfig)))))))))
-
-(defun mouse-set-point (event)
-  "Move point to the position clicked on with the mouse.
-This should be bound to a mouse click event type."
-  (interactive "e")
-  (mouse-minibuffer-check event)
-  ;; Use event-end in case called from mouse-drag-region.
-  ;; If EVENT is a click, event-end and event-start give same value.
-  (let ((posn (event-end event)))
-    (if (not (windowp (posn-window posn)))
-	(error "Cursor not in text area of window"))
-    (select-window (posn-window posn))
-    (if (numberp (posn-point posn))
-	(goto-char (posn-point posn)))))
-
-(defvar mouse-last-region-beg nil)
-(defvar mouse-last-region-end nil)
-(defvar mouse-last-region-tick nil)
-
-(defun mouse-region-match ()
-  "Return non-nil if there's an active region that was set with the mouse."
-  (and (mark t) mark-active
-       (eq mouse-last-region-beg (region-beginning))
-       (eq mouse-last-region-end (region-end))
-       (eq mouse-last-region-tick (buffer-modified-tick))))
-
-(defun mouse-set-region (click)
-  "Set the region to the text dragged over, and copy to kill ring.
-This should be bound to a mouse drag event."
-  (interactive "e")
-  (mouse-minibuffer-check click)
-  (let ((posn (event-start click))
-	(end (event-end click)))
-    (select-window (posn-window posn))
-    (if (numberp (posn-point posn))
-	(goto-char (posn-point posn)))
-    ;; If mark is highlighted, no need to bounce the cursor.
-    ;; On X, we highlight while dragging, thus once again no need to bounce.
-    (or transient-mark-mode
-	(memq (framep (selected-frame)) '(x pc w32))
-	(sit-for 1))
-    (push-mark)
-    (set-mark (point))
-    (if (numberp (posn-point end))
-	(goto-char (posn-point end)))
-    ;; Don't set this-command to kill-region, so that a following
-    ;; C-w will not double the text in the kill ring.
-    ;; Ignore last-command so we don't append to a preceding kill.
-    (let (this-command last-command)
-      (copy-region-as-kill (mark) (point)))
-    (mouse-set-region-1)))
-
-(defun mouse-set-region-1 ()
-  (setq mouse-last-region-beg (region-beginning))
-  (setq mouse-last-region-end (region-end))
-  (setq mouse-last-region-tick (buffer-modified-tick)))
-
-(defvar mouse-scroll-delay 0.25
-  "*The pause between scroll steps caused by mouse drags, in seconds.
-If you drag the mouse beyond the edge of a window, Emacs scrolls the
-window to bring the text beyond that edge into view, with a delay of
-this many seconds between scroll steps.  Scrolling stops when you move
-the mouse back into the window, or release the button.
-This variable's value may be non-integral.
-Setting this to zero causes Emacs to scroll as fast as it can.")
-
-(defvar mouse-scroll-min-lines 1
-  "*The minimum number of lines scrolled by dragging mouse out of window.
-Moving the mouse out the top or bottom edge of the window begins
-scrolling repeatedly.  The number of lines scrolled per repetition
-is normally equal to the number of lines beyond the window edge that
-the mouse has moved.  However, it always scrolls at least the number
-of lines specified by this variable.")
-
-(defun mouse-scroll-subr (window jump &optional overlay start)
-  "Scroll the window WINDOW, JUMP lines at a time, until new input arrives.
-If OVERLAY is an overlay, let it stretch from START to the far edge of
-the newly visible text.
-Upon exit, point is at the far edge of the newly visible text."
-  (cond
-   ((and (> jump 0) (< jump mouse-scroll-min-lines))
-    (setq jump mouse-scroll-min-lines))
-   ((and (< jump 0) (< (- jump) mouse-scroll-min-lines))
-    (setq jump (- mouse-scroll-min-lines))))
-  (let ((opoint (point)))
-    (while (progn
-	     (goto-char (window-start window))
-	     (if (not (zerop (vertical-motion jump window)))
-		 (progn
-		   (set-window-start window (point))
-		   (if (natnump jump)
-		       (progn
-			 (goto-char (window-end window))
-			 ;; window-end doesn't reflect the window's new
-			 ;; start position until the next redisplay.  Hurrah.
-			 (vertical-motion (1- jump) window))
-		     (goto-char (window-start window)))
-		   (if overlay
-		       (move-overlay overlay start (point)))
-		   ;; Now that we have scrolled WINDOW properly,
-		   ;; put point back where it was for the redisplay
-		   ;; so that we don't mess up the selected window.
-		   (or (eq window (selected-window))
-		       (goto-char opoint))
-		   (sit-for mouse-scroll-delay)))))
-    (or (eq window (selected-window))
-	(goto-char opoint))))
-
-;; Create an overlay and immediately delete it, to get "overlay in no buffer".
-(defvar mouse-drag-overlay (make-overlay 1 1))
-(delete-overlay mouse-drag-overlay)
-(overlay-put mouse-drag-overlay 'face 'region)
-
-(defvar mouse-selection-click-count 0)
-
-(defvar mouse-selection-click-count-buffer nil)
-
-(defun mouse-drag-region (start-event)
-  "Set the region to the text that the mouse is dragged over.
-Highlight the drag area as you move the mouse.
-This must be bound to a button-down mouse event.
-In Transient Mark mode, the highlighting remains as long as the mark
-remains active.  Otherwise, it remains until the next input event."
-  (interactive "e")
-  (mouse-minibuffer-check start-event)
-  (let* ((echo-keystrokes 0)
-	 (start-posn (event-start start-event))
-	 (start-point (posn-point start-posn))
-	 (start-window (posn-window start-posn))
-	 (start-frame (window-frame start-window))
-	 (bounds (window-edges start-window))
-	 (top (nth 1 bounds))
-	 (bottom (if (window-minibuffer-p start-window)
-		     (nth 3 bounds)
-		   ;; Don't count the mode line.
-		   (1- (nth 3 bounds))))
-	 (click-count (1- (event-click-count start-event))))
-    (setq mouse-selection-click-count click-count)
-    (setq mouse-selection-click-count-buffer (current-buffer))
-    (mouse-set-point start-event)
-    ;; In case the down click is in the middle of some intangible text,
-    ;; use the end of that text, and put it in START-POINT.
-    (if (< (point) start-point)
-	(goto-char start-point))
-    (setq start-point (point))
-    (let ((range (mouse-start-end start-point start-point click-count)))
-      (move-overlay mouse-drag-overlay (car range) (nth 1 range)
-		    (window-buffer start-window)))
-    (deactivate-mark)
-    ;; end-of-range is used only in the single-click case.
-    ;; It is the place where the drag has reached so far
-    ;; (but not outside the window where the drag started).
-    (let (event end end-point last-end-point (end-of-range (point)))
-      (track-mouse
-	(while (progn
-		 (setq event (read-event))
-		 (or (mouse-movement-p event)
-		     (eq (car-safe event) 'switch-frame)))
-	  (if (eq (car-safe event) 'switch-frame)
-	      nil
-	    (setq end (event-end event)
-		  end-point (posn-point end))
-	    (if (numberp end-point)
-		(setq last-end-point end-point))
-
-	    (cond
-	     ;; Are we moving within the original window?
-	     ((and (eq (posn-window end) start-window)
-		   (integer-or-marker-p end-point))
-	      ;; Go to START-POINT first, so that when we move to END-POINT,
-	      ;; if it's in the middle of intangible text,
-	      ;; point jumps in the direction away from START-POINT.
-	      (goto-char start-point)
-	      (goto-char end-point)
-	      (if (zerop (% click-count 3))
-		  (setq end-of-range (point)))
-	      (let ((range (mouse-start-end start-point (point) click-count)))
-		(move-overlay mouse-drag-overlay (car range) (nth 1 range))))
-
-	     (t
-	      (let ((mouse-row (cdr (cdr (mouse-position)))))
-		(cond
-		 ((null mouse-row))
-		 ((< mouse-row top)
-		  (mouse-scroll-subr start-window (- mouse-row top)
-				     mouse-drag-overlay start-point)
-		  ;; Without this, point tends to jump back to the starting
-		  ;; position where the mouse button was pressed down.
-		  (setq end-of-range (overlay-start mouse-drag-overlay)))
-		 ((>= mouse-row bottom)
-		  (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
-				     mouse-drag-overlay start-point)
-		  (setq end-of-range (overlay-end mouse-drag-overlay))))))))))
-      (if (consp event)
-	  (let ((fun (key-binding (vector (car event)))))
-	    ;; Run the binding of the terminating up-event, if possible.
-	    ;; In the case of a multiple click, it gives the wrong results,
-	    ;; because it would fail to set up a region.
-	    (if nil ;; (and (= (mod mouse-selection-click-count 3) 0) (fboundp fun))
-		;; In this case, we can just let the up-event execute normally.
-		(let ((end (event-end event)))
-		  ;; Set the position in the event before we replay it,
-		  ;; because otherwise it may have a position in the wrong
-		  ;; buffer.
-		  (setcar (cdr end) end-of-range)
-		  ;; Delete the overlay before calling the function,
-		  ;; because delete-overlay increases buffer-modified-tick.
-		  (delete-overlay mouse-drag-overlay)
-		  (setq unread-command-events
-			(cons event unread-command-events)))
-	      (if (not (= (overlay-start mouse-drag-overlay)
-			  (overlay-end mouse-drag-overlay)))
-		  (let* ((stop-point
-			  (if (numberp (posn-point (event-end event)))
-			      (posn-point (event-end event))
-			    last-end-point))
-			 ;; The end that comes from where we ended the drag.
-			 ;; Point goes here.
-			 (region-termination
-			  (if (and stop-point (< stop-point start-point))
-			      (overlay-start mouse-drag-overlay)
-			    (overlay-end mouse-drag-overlay)))
-			 ;; The end that comes from where we started the drag.
-			 ;; Mark goes there.
-			 (region-commencement
-			  (- (+ (overlay-end mouse-drag-overlay)
-				(overlay-start mouse-drag-overlay))
-			     region-termination))
-			 last-command this-command)
-		    (push-mark region-commencement t t)
-		    (goto-char region-termination)
-		    (copy-region-as-kill (point) (mark t))
-		    (let ((buffer (current-buffer)))
-		      (mouse-show-mark)
-		      ;; mouse-show-mark can call read-event,
-		      ;; and that means the Emacs server could switch buffers
-		      ;; under us.  If that happened, 
-		      ;; avoid trying to use the region.
-		      (and (mark t) mark-active
-			   (eq buffer (current-buffer))
-			   (mouse-set-region-1))))
-		(goto-char (overlay-end mouse-drag-overlay))
-		(setq this-command 'mouse-set-point)
-		(delete-overlay mouse-drag-overlay))))
-	(delete-overlay mouse-drag-overlay)))))
-
-;; Commands to handle xterm-style multiple clicks.
-
-(defun mouse-skip-word (dir)
-  "Skip over word, over whitespace, or over identical punctuation.
-If DIR is positive skip forward; if negative, skip backward."
-  (let* ((char (following-char))
-	 (syntax (char-to-string (char-syntax char))))
-    (cond ((or (string= syntax "w") (string= syntax " "))
-	   (if (< dir 0)
-	       (skip-syntax-backward syntax)
-	     (skip-syntax-forward syntax)))
-	  ((string= syntax "_")
-	   (if (< dir 0)
-	       (skip-syntax-backward "w_")
-	     (skip-syntax-forward "w_")))
-	  ((< dir 0)
-	   (while (and (not (bobp)) (= (preceding-char) char))
-	     (forward-char -1)))
-	  (t
-	   (while (and (not (eobp)) (= (following-char) char))
-	     (forward-char 1))))))
-
-;; Return a list of region bounds based on START and END according to MODE.
-;; If MODE is 0 then set point to (min START END), mark to (max START END).
-;; If MODE is 1 then set point to start of word at (min START END),
-;; mark to end of word at (max START END).
-;; If MODE is 2 then do the same for lines.
-(defun mouse-start-end (start end mode)
-  (if (> start end)
-      (let ((temp start))
-        (setq start end
-              end temp)))
-  (setq mode (mod mode 3))
-  (cond ((= mode 0)
-	 (list start end))
-        ((and (= mode 1)
-              (= start end)
-	      (char-after start)
-              (= (char-syntax (char-after start)) ?\())
-	 (list start
-	       (save-excursion
-		 (goto-char start)
-		 (forward-sexp 1)
-		 (point))))
-        ((and (= mode 1)
-              (= start end)
-	      (char-after start)
-              (= (char-syntax (char-after start)) ?\)))
-	 (list (save-excursion 
-		 (goto-char (1+ start))
-		 (backward-sexp 1)
-		 (point))
-	       (1+ start)))
-	((and (= mode 1)
-              (= start end)
-	      (char-after start)
-              (= (char-syntax (char-after start)) ?\"))
-	 (let ((open (or (eq start (point-min))
-			 (save-excursion
-			   (goto-char (- start 1))
-			   (looking-at "\\s(\\|\\s \\|\\s>")))))
-	   (if open
-	       (list start
-		     (save-excursion
-		       (condition-case nil
-			   (progn 
-			     (goto-char start)
-			     (forward-sexp 1)
-			     (point))
-			 (error end))))
-	     (list (save-excursion
-		     (condition-case nil
-			 (progn
-			   (goto-char (1+ start))
-			   (backward-sexp 1)
-			   (point))
-		       (error end)))
-		   (1+ start)))))
-        ((= mode 1)
-	 (list (save-excursion
-		 (goto-char start)
-		 (mouse-skip-word -1)
-		 (point))
-	       (save-excursion
-		 (goto-char end)
-		 (mouse-skip-word 1)
-		 (point))))
-        ((= mode 2)
-	 (list (save-excursion
-		 (goto-char start)
-		 (beginning-of-line 1)
-		 (point))
-	       (save-excursion
-		 (goto-char end)
-		 (forward-line 1)
-		 (point))))))
-
-;; Subroutine: set the mark where CLICK happened,
-;; but don't do anything else.
-(defun mouse-set-mark-fast (click)
-  (mouse-minibuffer-check click)
-  (let ((posn (event-start click)))
-    (select-window (posn-window posn))
-    (if (numberp (posn-point posn))
-	(push-mark (posn-point posn) t t))))
-
-(defun mouse-undouble-last-event (events)
-  (let* ((index (1- (length events)))
-	 (last (nthcdr index events))
-	 (event (car last))
-	 (basic (event-basic-type event))
-	 (modifiers (delq 'double (delq 'triple (copy-sequence (event-modifiers event)))))
-	 (new
-	  (if (consp event)
-	      (cons (event-convert-list (nreverse (cons basic modifiers)))
-		    (cdr event))
-	    event)))
-    (setcar last new)
-    (if (key-binding (apply 'vector events))
-	t
-      (setcar last event)
-      nil)))
-
-;; Momentarily show where the mark is, if highlighting doesn't show it. 
-
-(defvar mouse-region-delete-keys '([delete])
-  "List of keys which shall cause the mouse region to be deleted.")
-
-(defun mouse-show-mark ()
-  (if transient-mark-mode
-      (if window-system
-	  (delete-overlay mouse-drag-overlay))
-    (if window-system
-	(let ((inhibit-quit t)
-	      (echo-keystrokes 0)
-	      event events key ignore
-	      x-lost-selection-hooks)
-	  (add-hook 'x-lost-selection-hooks
-		    '(lambda (seltype)
-		       (if (eq seltype 'PRIMARY)
-			   (progn (setq ignore t)
-				  (throw 'mouse-show-mark t)))))
-	  (move-overlay mouse-drag-overlay (point) (mark t))
-	  (catch 'mouse-show-mark
-	    (while (progn (setq event (read-event))
-			  (setq events (append events (list event)))
-			  (setq key (apply 'vector events))
-			  (and (memq 'down (event-modifiers event))
-			       (not (key-binding key))
-			       (not (member key mouse-region-delete-keys))
-			       (not (mouse-undouble-last-event events))))))
-	  ;; If we lost the selection, just turn off the highlighting.
-	  (if ignore
-	      nil
-	    ;; For certain special keys, delete the region.
-	    (if (member key mouse-region-delete-keys)
-		(delete-region (overlay-start mouse-drag-overlay)
-			       (overlay-end mouse-drag-overlay))
-	      ;; Otherwise, unread the key so it gets executed normally.
-	      (setq unread-command-events
-		    (nconc events unread-command-events))))
-	  (setq quit-flag nil)
-	  (delete-overlay mouse-drag-overlay))
-      (save-excursion
-       (goto-char (mark t))
-       (sit-for 1)))))
-
-(defun mouse-set-mark (click)
-  "Set mark at the position clicked on with the mouse.
-Display cursor at that position for a second.
-This must be bound to a mouse click."
-  (interactive "e")
-  (mouse-minibuffer-check click)
-  (select-window (posn-window (event-start click)))
-  ;; We don't use save-excursion because that preserves the mark too.
-  (let ((point-save (point)))
-    (unwind-protect
-	(progn (mouse-set-point click)
-	       (push-mark nil t t)
-	       (or transient-mark-mode
-		   (sit-for 1)))
-      (goto-char point-save))))
-
-(defun mouse-kill (click)
-  "Kill the region between point and the mouse click.
-The text is saved in the kill ring, as with \\[kill-region]."
-  (interactive "e")
-  (mouse-minibuffer-check click)
-  (let* ((posn (event-start click))
-	 (click-posn (posn-point posn)))
-    (select-window (posn-window posn))
-    (if (numberp click-posn)
-	(kill-region (min (point) click-posn)
-		     (max (point) click-posn)))))
-
-(defun mouse-yank-at-click (click arg)
-  "Insert the last stretch of killed text at the position clicked on.
-Also move point to one end of the text thus inserted (normally the end).
-Prefix arguments are interpreted as with \\[yank].
-If `mouse-yank-at-point' is non-nil, insert at point
-regardless of where you click."
-  (interactive "e\nP")
-  ;; Give temporary modes such as isearch a chance to turn off.
-  (run-hooks 'mouse-leave-buffer-hook)
-  (or mouse-yank-at-point (mouse-set-point click))
-  (setq this-command 'yank)
-  (setq mouse-selection-click-count 0)
-  (yank arg))
-
-(defun mouse-kill-ring-save (click)
-  "Copy the region between point and the mouse click in the kill ring.
-This does not delete the region; it acts like \\[kill-ring-save]."
-  (interactive "e")
-  (mouse-set-mark-fast click)
-  (let (this-command last-command)
-    (kill-ring-save (point) (mark t)))
-  (mouse-show-mark))
-
-;;; This function used to delete the text between point and the mouse
-;;; whenever it was equal to the front of the kill ring, but some
-;;; people found that confusing.
-
-;;; A list (TEXT START END), describing the text and position of the last
-;;; invocation of mouse-save-then-kill.
-(defvar mouse-save-then-kill-posn nil)
-
-(defun mouse-save-then-kill-delete-region (beg end)
-  ;; We must make our own undo boundaries
-  ;; because they happen automatically only for the current buffer.
-  (undo-boundary)
-  (if (or (= beg end) (eq buffer-undo-list t))
-      ;; If we have no undo list in this buffer,
-      ;; just delete.
-      (delete-region beg end)
-    ;; Delete, but make the undo-list entry share with the kill ring.
-    ;; First, delete just one char, so in case buffer is being modified
-    ;; for the first time, the undo list records that fact.
-    (let (before-change-function after-change-function
-	  before-change-functions after-change-functions)
-      (delete-region beg
-		     (+ beg (if (> end beg) 1 -1))))
-    (let ((buffer-undo-list buffer-undo-list))
-      ;; Undo that deletion--but don't change the undo list!
-      (let (before-change-function after-change-function
-	    before-change-functions after-change-functions)
-	(primitive-undo 1 buffer-undo-list))
-      ;; Now delete the rest of the specified region,
-      ;; but don't record it.
-      (setq buffer-undo-list t)
-      (if (/= (length (car kill-ring)) (- (max end beg) (min end beg)))
-	  (error "Lossage in mouse-save-then-kill-delete-region"))
-      (delete-region beg end))
-    (let ((tail buffer-undo-list))
-      ;; Search back in buffer-undo-list for the string
-      ;; that came from deleting one character.
-      (while (and tail (not (stringp (car (car tail)))))
-	(setq tail (cdr tail)))
-      ;; Replace it with an entry for the entire deleted text.
-      (and tail
-	   (setcar tail (cons (car kill-ring) (min beg end))))))
-  (undo-boundary))
-
-(defun mouse-save-then-kill (click)
-  "Save text to point in kill ring; the second time, kill the text.
-If the text between point and the mouse is the same as what's
-at the front of the kill ring, this deletes the text.
-Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
-which prepares for a second click to delete the text.
-
-If you have selected words or lines, this command extends the
-selection through the word or line clicked on.  If you do this
-again in a different position, it extends the selection again.
-If you do this twice in the same position, the selection is killed." 
-  (interactive "e")
-  (let ((before-scroll point-before-scroll))
-    (mouse-minibuffer-check click)
-    (let ((click-posn (posn-point (event-start click)))
-	  ;; Don't let a subsequent kill command append to this one:
-	  ;; prevent setting this-command to kill-region.
-	  (this-command this-command))
-      (if (and (save-excursion
-		 (set-buffer (window-buffer (posn-window (event-start click))))
-		 (and (mark t) (> (mod mouse-selection-click-count 3) 0)
-		      ;; Don't be fooled by a recent click in some other buffer.
-		      (eq mouse-selection-click-count-buffer 
-			  (current-buffer)))))
-	  (if (not (and (eq last-command 'mouse-save-then-kill)
-			(equal click-posn
-			       (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
-	      ;; Find both ends of the object selected by this click.
-	      (let* ((range
-		      (mouse-start-end click-posn click-posn
-				       mouse-selection-click-count)))
-		;; Move whichever end is closer to the click.
-		;; That's what xterm does, and it seems reasonable.
-		(if (< (abs (- click-posn (mark t)))
-		       (abs (- click-posn (point))))
-		    (set-mark (car range))
-		  (goto-char (nth 1 range)))
-		;; We have already put the old region in the kill ring.
-		;; Replace it with the extended region.
-		;; (It would be annoying to make a separate entry.)
-		(kill-new (buffer-substring (point) (mark t)) t)
-		(mouse-set-region-1)
-		;; Arrange for a repeated mouse-3 to kill this region.
-		(setq mouse-save-then-kill-posn
-		      (list (car kill-ring) (point) click-posn))
-		(mouse-show-mark))
-	    ;; If we click this button again without moving it,
-	    ;; that time kill.
-	    (mouse-save-then-kill-delete-region (mark) (point))
-	    (setq mouse-selection-click-count 0)
-	    (setq mouse-save-then-kill-posn nil))
-	(if (and (eq last-command 'mouse-save-then-kill)
-		 mouse-save-then-kill-posn
-		 (eq (car mouse-save-then-kill-posn) (car kill-ring))
-		 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
-	    ;; If this is the second time we've called
-	    ;; mouse-save-then-kill, delete the text from the buffer.
-	    (progn
-	      (mouse-save-then-kill-delete-region (point) (mark))
-	      ;; After we kill, another click counts as "the first time".
-	      (setq mouse-save-then-kill-posn nil))
-	  ;; This is not a repetition.
-	  ;; We are adjusting an old selection or creating a new one.
-	  (if (or (and (eq last-command 'mouse-save-then-kill)
-		       mouse-save-then-kill-posn)
-		  (and mark-active transient-mark-mode)
-		  (and (memq last-command
-			     '(mouse-drag-region mouse-set-region))
-		       (or mark-even-if-inactive
-			   (not transient-mark-mode))))
-	      ;; We have a selection or suitable region, so adjust it.
-	      (let* ((posn (event-start click))
-		     (new (posn-point posn)))
-		(select-window (posn-window posn))
-		(if (numberp new)
-		    (progn
-		      ;; Move whichever end of the region is closer to the click.
-		      ;; That is what xterm does, and it seems reasonable.
-		      (if (< (abs (- new (point))) (abs (- new (mark t))))
-			  (goto-char new)
-			(set-mark new))
-		      (setq deactivate-mark nil)))
-		(kill-new (buffer-substring (point) (mark t)) t)
-		(mouse-show-mark))
-	    ;; Set the mark where point is, then move where clicked.
-	    (mouse-set-mark-fast click)
-	    (if before-scroll
-		(goto-char before-scroll))
-	    (exchange-point-and-mark)
-	    (kill-new (buffer-substring (point) (mark t)))
-	    (if window-system
-		(mouse-show-mark)))
-	  (mouse-set-region-1)
-	  (setq mouse-save-then-kill-posn
-		(list (car kill-ring) (point) click-posn)))))))
-
-(global-set-key [M-mouse-1] 'mouse-start-secondary)
-(global-set-key [M-drag-mouse-1] 'mouse-set-secondary)
-(global-set-key [M-down-mouse-1] 'mouse-drag-secondary)
-(global-set-key [M-mouse-3] 'mouse-secondary-save-then-kill)
-(global-set-key [M-mouse-2] 'mouse-yank-secondary)
-
-;; An overlay which records the current secondary selection
-;; or else is deleted when there is no secondary selection.
-;; May be nil.
-(defvar mouse-secondary-overlay nil)
-
-(defvar mouse-secondary-click-count 0)
-
-;; A marker which records the specified first end for a secondary selection.
-;; May be nil.
-(defvar mouse-secondary-start nil)
-
-(defun mouse-start-secondary (click)
-  "Set one end of the secondary selection to the position clicked on.
-Use \\[mouse-secondary-save-then-kill] to set the other end
-and complete the secondary selection."
-  (interactive "e")
-  (mouse-minibuffer-check click)
-  (let ((posn (event-start click)))
-    (save-excursion
-      (set-buffer (window-buffer (posn-window posn)))
-      ;; Cancel any preexisting secondary selection.
-      (if mouse-secondary-overlay
-	  (delete-overlay mouse-secondary-overlay))
-      (if (numberp (posn-point posn))
-	  (progn
-	    (or mouse-secondary-start
-		(setq mouse-secondary-start (make-marker)))
-	    (move-marker mouse-secondary-start (posn-point posn)))))))
-
-(defun mouse-set-secondary (click)
-  "Set the secondary selection to the text that the mouse is dragged over.
-This must be bound to a mouse drag event."
-  (interactive "e")
-  (mouse-minibuffer-check click)
-  (let ((posn (event-start click))
-	beg
-	(end (event-end click)))
-    (save-excursion
-      (set-buffer (window-buffer (posn-window posn)))
-      (if (numberp (posn-point posn))
-	  (setq beg (posn-point posn)))
-      (if mouse-secondary-overlay
-	  (move-overlay mouse-secondary-overlay beg (posn-point end))
-	(setq mouse-secondary-overlay (make-overlay beg (posn-point end))))
-      (overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
-
-(defun mouse-drag-secondary (start-event)
-  "Set the secondary selection to the text that the mouse is dragged over.
-Highlight the drag area as you move the mouse.
-This must be bound to a button-down mouse event.
-The function returns a non-nil value if it creates a secondary selection."
-  (interactive "e")
-  (mouse-minibuffer-check start-event)
-  (let* ((echo-keystrokes 0)
-	 (start-posn (event-start start-event))
-	 (start-point (posn-point start-posn))
-	 (start-window (posn-window start-posn))
-	 (start-frame (window-frame start-window))
-	 (bounds (window-edges start-window))
-	 (top (nth 1 bounds))
-	 (bottom (if (window-minibuffer-p start-window)
-		     (nth 3 bounds)
-		   ;; Don't count the mode line.
-		   (1- (nth 3 bounds))))
-	 (click-count (1- (event-click-count start-event))))
-    (save-excursion
-      (set-buffer (window-buffer start-window))
-      (setq mouse-secondary-click-count click-count)
-      (or mouse-secondary-overlay
-	  (setq mouse-secondary-overlay
-		(make-overlay (point) (point))))
-      (overlay-put mouse-secondary-overlay 'face 'secondary-selection)
-      (if (> (mod click-count 3) 0)
-	  ;; Double or triple press: make an initial selection
-	  ;; of one word or line.
-	  (let ((range (mouse-start-end start-point start-point click-count)))
-	    (set-marker mouse-secondary-start nil)
-	    (move-overlay mouse-secondary-overlay 1 1
-			  (window-buffer start-window))
-	    (move-overlay mouse-secondary-overlay (car range) (nth 1 range)
-			  (window-buffer start-window)))
-	;; Single-press: cancel any preexisting secondary selection.
-	(or mouse-secondary-start
-	    (setq mouse-secondary-start (make-marker)))
-	(set-marker mouse-secondary-start start-point)
-	(delete-overlay mouse-secondary-overlay))
-      (let (event end end-point)
-	(track-mouse
-	  (while (progn
-		   (setq event (read-event))
-		   (or (mouse-movement-p event)
-		       (eq (car-safe event) 'switch-frame)))
-
-	    (if (eq (car-safe event) 'switch-frame)
-		nil
-	      (setq end (event-end event)
-		    end-point (posn-point end))
-	      (cond
-	       ;; Are we moving within the original window?
-	       ((and (eq (posn-window end) start-window)
-		     (integer-or-marker-p end-point))
-		(let ((range (mouse-start-end start-point end-point
-					      click-count)))
-		  (if (or (/= start-point end-point)
-			  (null (marker-position mouse-secondary-start)))
-		      (progn
-			(set-marker mouse-secondary-start nil)
-			(move-overlay mouse-secondary-overlay
-				      (car range) (nth 1 range))))))
-               (t
-                (let ((mouse-row (cdr (cdr (mouse-position)))))
-                  (cond
-                   ((null mouse-row))
-                   ((< mouse-row top)
-                    (mouse-scroll-subr start-window (- mouse-row top)
-				       mouse-secondary-overlay start-point))
-                   ((>= mouse-row bottom)
-                    (mouse-scroll-subr start-window (1+ (- mouse-row bottom))
-                                       mouse-secondary-overlay start-point)))))))))
-
-	(if (consp event)
-	    (if (marker-position mouse-secondary-start)
-		(save-window-excursion
-		  (delete-overlay mouse-secondary-overlay)
-		  (x-set-selection 'SECONDARY nil)
-		  (select-window start-window)
-		  (save-excursion
-		    (goto-char mouse-secondary-start)
-		    (sit-for 1)
-		    nil))
-	      (x-set-selection
-	       'SECONDARY
-	       (buffer-substring (overlay-start mouse-secondary-overlay)
-				 (overlay-end mouse-secondary-overlay)))))))))
-
-(defun mouse-yank-secondary (click)
-  "Insert the secondary selection at the position clicked on.
-Move point to the end of the inserted text.
-If `mouse-yank-at-point' is non-nil, insert at point
-regardless of where you click."
-  (interactive "e")
-  ;; Give temporary modes such as isearch a chance to turn off.
-  (run-hooks 'mouse-leave-buffer-hook)
-  (or mouse-yank-at-point (mouse-set-point click))
-  (insert (x-get-selection 'SECONDARY)))
-
-(defun mouse-kill-secondary ()
-  "Kill the text in the secondary selection.
-This is intended more as a keyboard command than as a mouse command
-but it can work as either one.
-
-The current buffer (in case of keyboard use), or the buffer clicked on,
-must be the one that the secondary selection is in.  This requirement
-is to prevent accidents."
-  (interactive)
-  (let* ((keys (this-command-keys))
-	 (click (elt keys (1- (length keys)))))
-    (or (eq (overlay-buffer mouse-secondary-overlay)
-	    (if (listp click)
-		(window-buffer (posn-window (event-start click)))
-	      (current-buffer)))
-	(error "Select or click on the buffer where the secondary selection is")))
-  (let (this-command)
-    (save-excursion
-      (set-buffer (overlay-buffer mouse-secondary-overlay))
-      (kill-region (overlay-start mouse-secondary-overlay)
-		   (overlay-end mouse-secondary-overlay))))
-  (delete-overlay mouse-secondary-overlay)
-;;;  (x-set-selection 'SECONDARY nil)
-  (setq mouse-secondary-overlay nil))
-
-(defun mouse-secondary-save-then-kill (click)
-  "Save text to point in kill ring; the second time, kill the text.
-You must use this in a buffer where you have recently done \\[mouse-start-secondary].
-If the text between where you did \\[mouse-start-secondary] and where
-you use this command matches the text at the front of the kill ring,
-this command deletes the text.
-Otherwise, it adds the text to the kill ring, like \\[kill-ring-save],
-which prepares for a second click with this command to delete the text.
-
-If you have already made a secondary selection in that buffer,
-this command extends or retracts the selection to where you click.
-If you do this again in a different position, it extends or retracts
-again.  If you do this twice in the same position, it kills the selection."
-  (interactive "e")
-  (mouse-minibuffer-check click)
-  (let ((posn (event-start click))
-	(click-posn (posn-point (event-start click)))
-	;; Don't let a subsequent kill command append to this one:
-	;; prevent setting this-command to kill-region.
-	(this-command this-command))
-    (or (eq (window-buffer (posn-window posn))
-	    (or (and mouse-secondary-overlay
-		     (overlay-buffer mouse-secondary-overlay))
-		(if mouse-secondary-start
-		    (marker-buffer mouse-secondary-start))))
-	(error "Wrong buffer"))
-    (save-excursion
-      (set-buffer (window-buffer (posn-window posn)))
-      (if (> (mod mouse-secondary-click-count 3) 0)
-	  (if (not (and (eq last-command 'mouse-secondary-save-then-kill)
-			(equal click-posn
-			       (car (cdr-safe (cdr-safe mouse-save-then-kill-posn))))))
-	      ;; Find both ends of the object selected by this click.
-	      (let* ((range
-		      (mouse-start-end click-posn click-posn
-				       mouse-secondary-click-count)))
-		;; Move whichever end is closer to the click.
-		;; That's what xterm does, and it seems reasonable.
-		(if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
-		       (abs (- click-posn (overlay-end mouse-secondary-overlay))))
-		    (move-overlay mouse-secondary-overlay (car range)
-				  (overlay-end mouse-secondary-overlay))
-		  (move-overlay mouse-secondary-overlay
-				(overlay-start mouse-secondary-overlay)
-				(nth 1 range)))
-		;; We have already put the old region in the kill ring.
-		;; Replace it with the extended region.
-		;; (It would be annoying to make a separate entry.)
-		(kill-new (buffer-substring
-			   (overlay-start mouse-secondary-overlay)
-			   (overlay-end mouse-secondary-overlay)) t)
-		;; Arrange for a repeated mouse-3 to kill this region.
-		(setq mouse-save-then-kill-posn
-		      (list (car kill-ring) (point) click-posn)))
-	    ;; If we click this button again without moving it,
-	    ;; that time kill.
-	    (progn
-	      (mouse-save-then-kill-delete-region
-	       (overlay-start mouse-secondary-overlay)
-	       (overlay-end mouse-secondary-overlay))
-	      (setq mouse-save-then-kill-posn nil)
-	      (setq mouse-secondary-click-count 0)
-	      (delete-overlay mouse-secondary-overlay)))
-	(if (and (eq last-command 'mouse-secondary-save-then-kill)
-		 mouse-save-then-kill-posn
-		 (eq (car mouse-save-then-kill-posn) (car kill-ring))
-		 (equal (cdr mouse-save-then-kill-posn) (list (point) click-posn)))
-	    ;; If this is the second time we've called
-	    ;; mouse-secondary-save-then-kill, delete the text from the buffer.
-	    (progn
-	      (mouse-save-then-kill-delete-region
-	       (overlay-start mouse-secondary-overlay)
-	       (overlay-end mouse-secondary-overlay))
-	      (setq mouse-save-then-kill-posn nil)
-	      (delete-overlay mouse-secondary-overlay))
-	  (if (overlay-start mouse-secondary-overlay)
-	      ;; We have a selection, so adjust it.
-	      (progn
-		(if (numberp click-posn)
-		    (progn
-		      ;; Move whichever end of the region is closer to the click.
-		      ;; That is what xterm does, and it seems reasonable.
-		      (if (< (abs (- click-posn (overlay-start mouse-secondary-overlay)))
-			     (abs (- click-posn (overlay-end mouse-secondary-overlay))))
-			  (move-overlay mouse-secondary-overlay click-posn
-					(overlay-end mouse-secondary-overlay))
-			(move-overlay mouse-secondary-overlay
-				      (overlay-start mouse-secondary-overlay)
-				      click-posn))
-		      (setq deactivate-mark nil)))
-		(if (eq last-command 'mouse-secondary-save-then-kill)
-		    ;; If the front of the kill ring comes from 
-		    ;; an immediately previous use of this command,
-		    ;; replace it with the extended region.
-		    ;; (It would be annoying to make a separate entry.)
-		    (kill-new (buffer-substring
-			       (overlay-start mouse-secondary-overlay)
-			       (overlay-end mouse-secondary-overlay)) t)
-		  (copy-region-as-kill (overlay-start mouse-secondary-overlay)
-				       (overlay-end mouse-secondary-overlay))))
-	    (if mouse-secondary-start
-		;; All we have is one end of a selection,
-		;; so put the other end here.
-		(let ((start (+ 0 mouse-secondary-start)))
-		  (kill-ring-save start click-posn)
-		  (if mouse-secondary-overlay
-		      (move-overlay mouse-secondary-overlay start click-posn)
-		    (setq mouse-secondary-overlay (make-overlay start click-posn)))
-		  (overlay-put mouse-secondary-overlay 'face 'secondary-selection))))
-	  (setq mouse-save-then-kill-posn
-		(list (car kill-ring) (point) click-posn))))
-      (if (overlay-buffer mouse-secondary-overlay)
-	  (x-set-selection 'SECONDARY
-			   (buffer-substring
-			    (overlay-start mouse-secondary-overlay)
-			    (overlay-end mouse-secondary-overlay)))))))
-
-(defvar mouse-menu-buffer-maxlen 20
-  "*Number of buffers in one pane (submenu) of the buffer menu.
-If we have lots of buffers, divide them into groups of
-`mouse-menu-buffer-maxlen' and make a pane (or submenu) for each one.")
-
-(defun mouse-buffer-menu (event)
-  "Pop up a menu of buffers for selection with the mouse.
-This switches buffers in the window that you clicked on,
-and selects that window."
-  (interactive "e")
-  (mouse-minibuffer-check event)
-  (let* ((buffers
-	  ;; Make an alist of (MENU-ITEM . BUFFER).
-	  (let ((tail (buffer-list))
-		(maxlen 0)
-		head)
-	    (while tail
-	      (or (eq ?\ (aref (buffer-name (car tail)) 0))
-		  (setq maxlen
-			(max maxlen
-			     (length (buffer-name (car tail))))))
-	      (setq tail (cdr tail)))
-	    (setq tail (buffer-list))
-	    (while tail
-	      (let ((elt (car tail)))
-		(if (/= (aref (buffer-name elt) 0) ?\ )
-		    (setq head
-			  (cons
-			   (cons
-			    (format
-			     (format "%%%ds  %%s%%s  %%s" maxlen)
-			     (buffer-name elt)
-			     (if (buffer-modified-p elt) "*" " ")
-			     (save-excursion
-			       (set-buffer elt)
-			       (if buffer-read-only "%" " "))
-			     (or (buffer-file-name elt) 
-				 (save-excursion
-				   (set-buffer elt)
-				   (if list-buffers-directory
-				       (expand-file-name
-					list-buffers-directory)))
-				 ""))
-			    elt)
-			   head))))
-	      (setq tail (cdr tail)))
-	    ;; Compensate for the reversal that the above loop does.
-	    (nreverse head)))
-	 (menu
-	  ;; If we have lots of buffers, divide them into groups of 20
-	  ;; and make a pane (or submenu) for each one.
-	  (if (> (length buffers) (/ (* mouse-menu-buffer-maxlen 3) 2))
-	      (let ((buffers buffers) sublists next
-		    (i 1))
-		(while buffers
-		  ;; Pull off the next mouse-menu-buffer-maxlen buffers
-		  ;; and make them the next element of sublist.
-		  (setq next (nthcdr mouse-menu-buffer-maxlen buffers))
-		  (if next
-		      (setcdr (nthcdr (1- mouse-menu-buffer-maxlen) buffers)
-			      nil))
-		  (setq sublists (cons (cons (format "Buffers %d" i) buffers)
-				       sublists))
-		  (setq i (1+ i))
-		  (setq buffers next))
-		(cons "Buffer Menu" (nreverse sublists)))
-	    ;; Few buffers--put them all in one pane.
-	    (list "Buffer Menu" (cons "Select Buffer" buffers)))))
-    (let ((buf (x-popup-menu event menu))
-	  (window (posn-window (event-start event))))
-      (if buf
-	  (progn
-	    (or (framep window) (select-window window))
-	    (switch-to-buffer buf))))))
-
-;;; These need to be rewritten for the new scroll bar implementation.
-
-;;;!! ;; Commands for the scroll bar.
-;;;!! 
-;;;!! (defun mouse-scroll-down (click)
-;;;!!   (interactive "@e")
-;;;!!   (scroll-down (1+ (cdr (mouse-coords click)))))
-;;;!! 
-;;;!! (defun mouse-scroll-up (click)
-;;;!!   (interactive "@e")
-;;;!!   (scroll-up (1+ (cdr (mouse-coords click)))))
-;;;!! 
-;;;!! (defun mouse-scroll-down-full ()
-;;;!!   (interactive "@")
-;;;!!   (scroll-down nil))
-;;;!! 
-;;;!! (defun mouse-scroll-up-full ()
-;;;!!   (interactive "@")
-;;;!!   (scroll-up nil))
-;;;!! 
-;;;!! (defun mouse-scroll-move-cursor (click)
-;;;!!   (interactive "@e")
-;;;!!   (move-to-window-line (1+ (cdr (mouse-coords click)))))
-;;;!! 
-;;;!! (defun mouse-scroll-absolute (event)
-;;;!!   (interactive "@e")
-;;;!!   (let* ((pos (car event))
-;;;!! 	 (position (car pos))
-;;;!! 	 (length (car (cdr pos))))
-;;;!!     (if (<= length 0) (setq length 1))
-;;;!!     (let* ((scale-factor (max 1 (/ length (/ 8000000 (buffer-size)))))
-;;;!! 	   (newpos (* (/ (* (/ (buffer-size) scale-factor)
-;;;!! 			    position)
-;;;!! 			 length)
-;;;!! 		      scale-factor)))
-;;;!!       (goto-char newpos)
-;;;!!       (recenter '(4)))))
-;;;!! 
-;;;!! (defun mouse-scroll-left (click)
-;;;!!   (interactive "@e")
-;;;!!   (scroll-left (1+ (car (mouse-coords click)))))
-;;;!! 
-;;;!! (defun mouse-scroll-right (click)
-;;;!!   (interactive "@e")
-;;;!!   (scroll-right (1+ (car (mouse-coords click)))))
-;;;!! 
-;;;!! (defun mouse-scroll-left-full ()
-;;;!!   (interactive "@")
-;;;!!   (scroll-left nil))
-;;;!! 
-;;;!! (defun mouse-scroll-right-full ()
-;;;!!   (interactive "@")
-;;;!!   (scroll-right nil))
-;;;!! 
-;;;!! (defun mouse-scroll-move-cursor-horizontally (click)
-;;;!!   (interactive "@e")
-;;;!!   (move-to-column (1+ (car (mouse-coords click)))))
-;;;!! 
-;;;!! (defun mouse-scroll-absolute-horizontally (event)
-;;;!!   (interactive "@e")
-;;;!!   (let* ((pos (car event))
-;;;!! 	 (position (car pos))
-;;;!! 	 (length (car (cdr pos))))
-;;;!!   (set-window-hscroll (selected-window) 33)))
-;;;!! 
-;;;!! (global-set-key [scroll-bar mouse-1] 'mouse-scroll-up)
-;;;!! (global-set-key [scroll-bar mouse-2] 'mouse-scroll-absolute)
-;;;!! (global-set-key [scroll-bar mouse-3] 'mouse-scroll-down)
-;;;!! 
-;;;!! (global-set-key [vertical-slider mouse-1] 'mouse-scroll-move-cursor)
-;;;!! (global-set-key [vertical-slider mouse-2] 'mouse-scroll-move-cursor)
-;;;!! (global-set-key [vertical-slider mouse-3] 'mouse-scroll-move-cursor)
-;;;!! 
-;;;!! (global-set-key [thumbup mouse-1] 'mouse-scroll-up-full)
-;;;!! (global-set-key [thumbup mouse-2] 'mouse-scroll-up-full)
-;;;!! (global-set-key [thumbup mouse-3] 'mouse-scroll-up-full)
-;;;!! 
-;;;!! (global-set-key [thumbdown mouse-1] 'mouse-scroll-down-full)
-;;;!! (global-set-key [thumbdown mouse-2] 'mouse-scroll-down-full)
-;;;!! (global-set-key [thumbdown mouse-3] 'mouse-scroll-down-full)
-;;;!! 
-;;;!! (global-set-key [horizontal-scroll-bar mouse-1] 'mouse-scroll-left)
-;;;!! (global-set-key [horizontal-scroll-bar mouse-2]
-;;;!! 		'mouse-scroll-absolute-horizontally)
-;;;!! (global-set-key [horizontal-scroll-bar mouse-3] 'mouse-scroll-right)
-;;;!! 
-;;;!! (global-set-key [horizontal-slider mouse-1]
-;;;!! 		'mouse-scroll-move-cursor-horizontally)
-;;;!! (global-set-key [horizontal-slider mouse-2]
-;;;!! 		'mouse-scroll-move-cursor-horizontally)
-;;;!! (global-set-key [horizontal-slider mouse-3]
-;;;!! 		'mouse-scroll-move-cursor-horizontally)
-;;;!! 
-;;;!! (global-set-key [thumbleft mouse-1] 'mouse-scroll-left-full)
-;;;!! (global-set-key [thumbleft mouse-2] 'mouse-scroll-left-full)
-;;;!! (global-set-key [thumbleft mouse-3] 'mouse-scroll-left-full)
-;;;!! 
-;;;!! (global-set-key [thumbright mouse-1] 'mouse-scroll-right-full)
-;;;!! (global-set-key [thumbright mouse-2] 'mouse-scroll-right-full)
-;;;!! (global-set-key [thumbright mouse-3] 'mouse-scroll-right-full)
-;;;!! 
-;;;!! (global-set-key [horizontal-scroll-bar S-mouse-2]
-;;;!! 		'mouse-split-window-horizontally)
-;;;!! (global-set-key [mode-line S-mouse-2]
-;;;!! 		'mouse-split-window-horizontally)
-;;;!! (global-set-key [vertical-scroll-bar S-mouse-2]
-;;;!! 		'mouse-split-window)
-
-;;;!! ;;;;
-;;;!! ;;;; Here are experimental things being tested.  Mouse events
-;;;!! ;;;; are of the form:
-;;;!! ;;;;	((x y) window screen-part key-sequence timestamp)
-;;;!! ;;
-;;;!! ;;;;
-;;;!! ;;;; Dynamically track mouse coordinates
-;;;!! ;;;;
-;;;!! ;;
-;;;!! ;;(defun track-mouse (event)
-;;;!! ;;  "Track the coordinates, absolute and relative, of the mouse."
-;;;!! ;;  (interactive "@e")
-;;;!! ;;  (while mouse-grabbed
-;;;!! ;;    (let* ((pos (read-mouse-position (selected-screen)))
-;;;!! ;;	   (abs-x (car pos))
-;;;!! ;;	   (abs-y (cdr pos))
-;;;!! ;;	   (relative-coordinate (coordinates-in-window-p
-;;;!! ;;				 (list (car pos) (cdr pos))
-;;;!! ;;				 (selected-window))))
-;;;!! ;;      (if (consp relative-coordinate)
-;;;!! ;;	  (message "mouse: [%d %d], (%d %d)" abs-x abs-y
-;;;!! ;;		   (car relative-coordinate)
-;;;!! ;;		   (car (cdr relative-coordinate)))
-;;;!! ;;	(message "mouse: [%d %d]" abs-x abs-y)))))
-;;;!! 
-;;;!! ;;
-;;;!! ;; Dynamically put a box around the line indicated by point
-;;;!! ;;
-;;;!! ;;
-;;;!! ;;(require 'backquote)
-;;;!! ;;
-;;;!! ;;(defun mouse-select-buffer-line (event)
-;;;!! ;;  (interactive "@e")
-;;;!! ;;  (let ((relative-coordinate
-;;;!! ;;	 (coordinates-in-window-p (car event) (selected-window)))
-;;;!! ;;	(abs-y (car (cdr (car event)))))
-;;;!! ;;    (if (consp relative-coordinate)
-;;;!! ;;	(progn
-;;;!! ;;	  (save-excursion
-;;;!! ;;	    (move-to-window-line (car (cdr relative-coordinate)))
-;;;!! ;;	    (x-draw-rectangle
-;;;!! ;;	     (selected-screen)
-;;;!! ;;	     abs-y 0
-;;;!! ;;	     (save-excursion
-;;;!! ;;		 (move-to-window-line (car (cdr relative-coordinate)))
-;;;!! ;;		 (end-of-line)
-;;;!! ;;		 (push-mark nil t)
-;;;!! ;;		 (beginning-of-line)
-;;;!! ;;		 (- (region-end) (region-beginning))) 1))
-;;;!! ;;	  (sit-for 1)
-;;;!! ;;	  (x-erase-rectangle (selected-screen))))))
-;;;!! ;;
-;;;!! ;;(defvar last-line-drawn nil)
-;;;!! ;;(defvar begin-delim "[^ \t]")
-;;;!! ;;(defvar end-delim   "[^ \t]")
-;;;!! ;;
-;;;!! ;;(defun mouse-boxing (event)
-;;;!! ;;  (interactive "@e")
-;;;!! ;;  (save-excursion
-;;;!! ;;    (let ((screen (selected-screen)))
-;;;!! ;;      (while (= (x-mouse-events) 0)
-;;;!! ;;	(let* ((pos (read-mouse-position screen))
-;;;!! ;;	       (abs-x (car pos))
-;;;!! ;;	       (abs-y (cdr pos))
-;;;!! ;;	       (relative-coordinate
-;;;!! ;;		(coordinates-in-window-p (` ((, abs-x) (, abs-y)))
-;;;!! ;;					 (selected-window)))
-;;;!! ;;	       (begin-reg nil)
-;;;!! ;;	       (end-reg nil)
-;;;!! ;;	       (end-column nil)
-;;;!! ;;	       (begin-column nil))
-;;;!! ;;	  (if (and (consp relative-coordinate)
-;;;!! ;;		   (or (not last-line-drawn)
-;;;!! ;;		       (not (= last-line-drawn abs-y))))
-;;;!! ;;	      (progn
-;;;!! ;;		(move-to-window-line (car (cdr relative-coordinate)))
-;;;!! ;;		(if (= (following-char) 10)
-;;;!! ;;		    ()
-;;;!! ;;		  (progn
-;;;!! ;;		    (setq begin-reg (1- (re-search-forward end-delim)))
-;;;!! ;;		    (setq begin-column (1- (current-column)))
-;;;!! ;;		    (end-of-line)
-;;;!! ;;		    (setq end-reg (1+ (re-search-backward begin-delim)))
-;;;!! ;;		    (setq end-column (1+ (current-column)))
-;;;!! ;;		    (message "%s" (buffer-substring begin-reg end-reg))
-;;;!! ;;		    (x-draw-rectangle screen
-;;;!! ;;				      (setq last-line-drawn abs-y)
-;;;!! ;;				      begin-column
-;;;!! ;;				      (- end-column begin-column) 1))))))))))
-;;;!! ;;
-;;;!! ;;(defun mouse-erase-box ()
-;;;!! ;;  (interactive)
-;;;!! ;;  (if last-line-drawn
-;;;!! ;;      (progn
-;;;!! ;;	(x-erase-rectangle (selected-screen))
-;;;!! ;;	(setq last-line-drawn nil))))
-;;;!! 
-;;;!! ;;; (defun test-x-rectangle ()
-;;;!! ;;;   (use-local-mouse-map (setq rectangle-test-map (make-sparse-keymap)))
-;;;!! ;;;   (define-key rectangle-test-map mouse-motion-button-left 'mouse-boxing)
-;;;!! ;;;   (define-key rectangle-test-map mouse-button-left-up 'mouse-erase-box))
-;;;!! 
-;;;!! ;;
-;;;!! ;; Here is how to do double clicking in lisp.  About to change.
-;;;!! ;;
-;;;!! 
-;;;!! (defvar double-start nil)
-;;;!! (defconst double-click-interval 300
-;;;!!   "Max ticks between clicks")
-;;;!! 
-;;;!! (defun double-down (event)
-;;;!!   (interactive "@e")
-;;;!!   (if double-start
-;;;!!       (let ((interval (- (nth 4 event) double-start)))
-;;;!! 	(if (< interval double-click-interval)
-;;;!! 	    (progn
-;;;!! 	      (backward-up-list 1)
-;;;!! 	      ;;      (message "Interval %d" interval)
-;;;!! 	      (sleep-for 1)))
-;;;!! 	(setq double-start nil))
-;;;!!     (setq double-start (nth 4 event))))
-;;;!!     
-;;;!! (defun double-up (event)
-;;;!!   (interactive "@e")
-;;;!!   (and double-start
-;;;!!        (> (- (nth 4 event ) double-start) double-click-interval)
-;;;!!        (setq double-start nil)))
-;;;!! 
-;;;!! ;;; (defun x-test-doubleclick ()
-;;;!! ;;;   (use-local-mouse-map (setq doubleclick-test-map (make-sparse-keymap)))
-;;;!! ;;;   (define-key doubleclick-test-map mouse-button-left 'double-down)
-;;;!! ;;;   (define-key doubleclick-test-map mouse-button-left-up 'double-up))
-;;;!! 
-;;;!! ;;
-;;;!! ;; This scrolls while button is depressed.  Use preferable in scroll bar.
-;;;!! ;;
-;;;!! 
-;;;!! (defvar scrolled-lines 0)
-;;;!! (defconst scroll-speed 1)
-;;;!! 
-;;;!! (defun incr-scroll-down (event)
-;;;!!   (interactive "@e")
-;;;!!   (setq scrolled-lines 0)
-;;;!!   (incremental-scroll scroll-speed))
-;;;!! 
-;;;!! (defun incr-scroll-up (event)
-;;;!!   (interactive "@e")
-;;;!!   (setq scrolled-lines 0)
-;;;!!   (incremental-scroll (- scroll-speed)))
-;;;!! 
-;;;!! (defun incremental-scroll (n)
-;;;!!   (while (= (x-mouse-events) 0)
-;;;!!     (setq scrolled-lines (1+ (* scroll-speed scrolled-lines)))
-;;;!!     (scroll-down n)
-;;;!!     (sit-for 300 t)))
-;;;!! 
-;;;!! (defun incr-scroll-stop (event)
-;;;!!   (interactive "@e")
-;;;!!   (message "Scrolled %d lines" scrolled-lines)
-;;;!!   (setq scrolled-lines 0)
-;;;!!   (sleep-for 1))
-;;;!! 
-;;;!! ;;; (defun x-testing-scroll ()
-;;;!! ;;;   (let ((scrolling-map (function mouse-vertical-scroll-bar-prefix)))
-;;;!! ;;;     (define-key scrolling-map mouse-button-left 'incr-scroll-down)
-;;;!! ;;;     (define-key scrolling-map mouse-button-right 'incr-scroll-up)
-;;;!! ;;;     (define-key scrolling-map mouse-button-left-up 'incr-scroll-stop)
-;;;!! ;;;     (define-key scrolling-map mouse-button-right-up 'incr-scroll-stop)))
-;;;!! 
-;;;!! ;;
-;;;!! ;; Some playthings suitable for picture mode?  They need work.
-;;;!! ;;
-;;;!! 
-;;;!! (defun mouse-kill-rectangle (event)
-;;;!!   "Kill the rectangle between point and the mouse cursor."
-;;;!!   (interactive "@e")
-;;;!!   (let ((point-save (point)))
-;;;!!     (save-excursion
-;;;!!       (mouse-set-point event)
-;;;!!       (push-mark nil t)
-;;;!!       (if (> point-save (point))
-;;;!! 	  (kill-rectangle (point) point-save)
-;;;!! 	(kill-rectangle point-save (point))))))
-;;;!! 
-;;;!! (defun mouse-open-rectangle (event)
-;;;!!   "Kill the rectangle between point and the mouse cursor."
-;;;!!   (interactive "@e")
-;;;!!   (let ((point-save (point)))
-;;;!!     (save-excursion
-;;;!!       (mouse-set-point event)
-;;;!!       (push-mark nil t)
-;;;!!       (if (> point-save (point))
-;;;!! 	  (open-rectangle (point) point-save)
-;;;!! 	(open-rectangle point-save (point))))))
-;;;!! 
-;;;!! ;; Must be a better way to do this.
-;;;!! 
-;;;!! (defun mouse-multiple-insert (n char)
-;;;!!   (while (> n 0)
-;;;!!     (insert char)
-;;;!!     (setq n (1- n))))
-;;;!! 
-;;;!! ;; What this could do is not finalize until button was released.
-;;;!! 
-;;;!! (defun mouse-move-text (event)
-;;;!!   "Move text from point to cursor position, inserting spaces."
-;;;!!   (interactive "@e")
-;;;!!   (let* ((relative-coordinate
-;;;!! 	  (coordinates-in-window-p (car event) (selected-window))))
-;;;!!     (if (consp relative-coordinate)
-;;;!! 	(cond ((> (current-column) (car relative-coordinate))
-;;;!! 	       (delete-char
-;;;!! 		(- (car relative-coordinate) (current-column))))
-;;;!! 	      ((< (current-column) (car relative-coordinate))
-;;;!! 	       (mouse-multiple-insert
-;;;!! 		(- (car relative-coordinate) (current-column)) " "))
-;;;!! 	      ((= (current-column) (car relative-coordinate)) (ding))))))
-
-;; Choose a completion with the mouse.
-
-(defun mouse-choose-completion (event)
-  "Click on an alternative in the `*Completions*' buffer to choose it."
-  (interactive "e")
-  ;; Give temporary modes such as isearch a chance to turn off.
-  (run-hooks 'mouse-leave-buffer-hook)
-  (let ((buffer (window-buffer))
-        choice
-	base-size)
-    (save-excursion
-      (set-buffer (window-buffer (posn-window (event-start event))))
-      (if completion-reference-buffer
-	  (setq buffer completion-reference-buffer))
-      (setq base-size completion-base-size)
-      (save-excursion
-	(goto-char (posn-point (event-start event)))
-	(let (beg end)
-	  (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
-	      (setq end (point) beg (1+ (point))))
-	  (if (null beg)
-	      (error "No completion here"))
-	  (setq beg (previous-single-property-change beg 'mouse-face))
-	  (setq end (or (next-single-property-change end 'mouse-face)
-			(point-max)))
-	  (setq choice (buffer-substring beg end)))))
-    (let ((owindow (selected-window)))
-      (select-window (posn-window (event-start event)))
-      (if (and (one-window-p t 'selected-frame)
-	       (window-dedicated-p (selected-window)))
-	  ;; This is a special buffer's frame
-	  (iconify-frame (selected-frame))
-	(or (window-dedicated-p (selected-window))
-	    (bury-buffer)))
-      (select-window owindow))
-    (choose-completion-string choice buffer base-size)))
-
-;; Font selection.
-
-(defun font-menu-add-default ()
-  (let* ((default (cdr (assq 'font (frame-parameters (selected-frame)))))
-	 (font-alist x-fixed-font-alist)
-	 (elt (or (assoc "Misc" font-alist) (nth 1 font-alist))))
-    (if (assoc "Default" elt)
-	(delete (assoc "Default" elt) elt))
-    (setcdr elt
-	    (cons (list "Default"
-			(cdr (assq 'font (frame-parameters (selected-frame)))))
-		  (cdr elt)))))
-
-(defvar x-fixed-font-alist
-  '("Font menu"
-    ("Misc"
-     ;; For these, we specify the pixel height and width.
-     ("fixed" "fixed")
-     ("6x10" "-misc-fixed-medium-r-normal--10-*-*-*-c-60-iso8859-1" "6x10")
-     ("6x12"
-      "-misc-fixed-medium-r-semicondensed--12-*-*-*-c-60-iso8859-1" "6x12")
-     ("6x13"
-      "-misc-fixed-medium-r-semicondensed--13-*-*-*-c-60-iso8859-1" "6x13")
-     ("7x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-70-iso8859-1" "7x13")
-     ("7x14" "-misc-fixed-medium-r-normal--14-*-*-*-c-70-iso8859-1" "7x14")
-     ("8x13" "-misc-fixed-medium-r-normal--13-*-*-*-c-80-iso8859-1" "8x13")
-     ("9x15" "-misc-fixed-medium-r-normal--15-*-*-*-c-90-iso8859-1" "9x15")
-     ("10x20" "-misc-fixed-medium-r-normal--20-*-*-*-c-100-iso8859-1" "10x20")
-     ("11x18" "-misc-fixed-medium-r-normal--18-*-*-*-c-110-iso8859-1" "11x18")
-     ("12x24" "-misc-fixed-medium-r-normal--24-*-*-*-c-120-iso8859-1" "12x24")
-     ("")
-     ("clean 5x8"
-      "-schumacher-clean-medium-r-normal--8-*-*-*-c-50-iso8859-1")
-     ("clean 6x8"
-      "-schumacher-clean-medium-r-normal--8-*-*-*-c-60-iso8859-1")
-     ("clean 8x8"
-      "-schumacher-clean-medium-r-normal--8-*-*-*-c-80-iso8859-1")
-     ("clean 8x10"
-      "-schumacher-clean-medium-r-normal--10-*-*-*-c-80-iso8859-1")
-     ("clean 8x14"
-      "-schumacher-clean-medium-r-normal--14-*-*-*-c-80-iso8859-1")
-     ("clean 8x16"
-      "-schumacher-clean-medium-r-normal--16-*-*-*-c-80-iso8859-1")
-     ("")
-     ("sony 8x16" "-sony-fixed-medium-r-normal--16-*-*-*-c-80-iso8859-1"))
-;;; We don't seem to have these; who knows what they are.
-;;;    ("fg-18" "fg-18")
-;;;    ("fg-25" "fg-25")
-;;;    ("lucidasanstypewriter-12" "lucidasanstypewriter-12")
-;;;    ("lucidasanstypewriter-bold-14" "lucidasanstypewriter-bold-14")
-;;;    ("lucidasanstypewriter-bold-24" "lucidasanstypewriter-bold-24")
-;;;    ("lucidatypewriter-bold-r-24" "-b&h-lucidatypewriter-bold-r-normal-sans-24-240-75-75-m-140-iso8859-1")
-;;;    ("fixed-medium-20" "-misc-fixed-medium-*-*-*-20-*-*-*-*-*-*-*")
-    ("Courier"
-     ;; For these, we specify the point height.
-     ("8" "-adobe-courier-medium-r-normal--*-80-*-*-m-*-iso8859-1")
-     ("10" "-adobe-courier-medium-r-normal--*-100-*-*-m-*-iso8859-1")
-     ("12" "-adobe-courier-medium-r-normal--*-120-*-*-m-*-iso8859-1")
-     ("14" "-adobe-courier-medium-r-normal--*-140-*-*-m-*-iso8859-1")
-     ("18" "-adobe-courier-medium-r-normal--*-180-*-*-m-*-iso8859-1")
-     ("24" "-adobe-courier-medium-r-normal--*-240-*-*-m-*-iso8859-1")
-     ("8 bold" "-adobe-courier-bold-r-normal--*-80-*-*-m-*-iso8859-1")
-     ("10 bold" "-adobe-courier-bold-r-normal--*-100-*-*-m-*-iso8859-1")
-     ("12 bold" "-adobe-courier-bold-r-normal--*-120-*-*-m-*-iso8859-1")
-     ("14 bold" "-adobe-courier-bold-r-normal--*-140-*-*-m-*-iso8859-1")
-     ("18 bold" "-adobe-courier-bold-r-normal--*-180-*-*-m-*-iso8859-1")
-     ("24 bold" "-adobe-courier-bold-r-normal--*-240-*-*-m-*-iso8859-1")
-     ("8 slant" "-adobe-courier-medium-o-normal--*-80-*-*-m-*-iso8859-1")
-     ("10 slant" "-adobe-courier-medium-o-normal--*-100-*-*-m-*-iso8859-1")
-     ("12 slant" "-adobe-courier-medium-o-normal--*-120-*-*-m-*-iso8859-1")
-     ("14 slant" "-adobe-courier-medium-o-normal--*-140-*-*-m-*-iso8859-1")
-     ("18 slant" "-adobe-courier-medium-o-normal--*-180-*-*-m-*-iso8859-1")
-     ("24 slant" "-adobe-courier-medium-o-normal--*-240-*-*-m-*-iso8859-1")
-     ("8 bold slant" "-adobe-courier-bold-o-normal--*-80-*-*-m-*-iso8859-1")
-     ("10 bold slant" "-adobe-courier-bold-o-normal--*-100-*-*-m-*-iso8859-1")
-     ("12 bold slant" "-adobe-courier-bold-o-normal--*-120-*-*-m-*-iso8859-1")
-     ("14 bold slant" "-adobe-courier-bold-o-normal--*-140-*-*-m-*-iso8859-1")
-     ("18 bold slant" "-adobe-courier-bold-o-normal--*-180-*-*-m-*-iso8859-1")
-     ("24 bold slant" "-adobe-courier-bold-o-normal--*-240-*-*-m-*-iso8859-1"))
-    )
-  "X fonts suitable for use in Emacs.")
-
-(defun mouse-set-font (&rest fonts)
-  "Select an emacs font from a list of known good fonts"
-  (interactive
-   (x-popup-menu last-nonmenu-event x-fixed-font-alist))
-  (if fonts
-      (let (font)
-	(while fonts
-	  (condition-case nil
-	      (progn
-		(set-default-font (car fonts))
-		(setq font (car fonts))
-		(setq fonts nil))
-	    (error
-	     (setq fonts (cdr fonts)))))
-	(if (null font)
-	    (error "Font not found")))))
-
-;;; Bindings for mouse commands.
-
-(define-key global-map [down-mouse-1] 'mouse-drag-region)
-(global-set-key [mouse-1]	'mouse-set-point)
-(global-set-key [drag-mouse-1]	'mouse-set-region)
-
-;; These are tested for in mouse-drag-region.
-(global-set-key [double-mouse-1] 'mouse-set-point)
-(global-set-key [triple-mouse-1] 'mouse-set-point)
-
-(global-set-key [mouse-2]	'mouse-yank-at-click)
-(global-set-key [mouse-3]	'mouse-save-then-kill)
-
-;; By binding these to down-going events, we let the user use the up-going
-;; event to make the selection, saving a click.
-(global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
-(if (not (eq system-type 'ms-dos))
-    (global-set-key [S-down-mouse-1] 'mouse-set-font))
-;; C-down-mouse-2 is bound in facemenu.el.
-(global-set-key [C-down-mouse-3] 'mouse-major-mode-menu)
-
-
-;; Replaced with dragging mouse-1
-;; (global-set-key [S-mouse-1]	'mouse-set-mark)
-
-(global-set-key [mode-line mouse-1] 'mouse-select-window)
-(global-set-key [mode-line drag-mouse-1] 'mouse-select-window)
-(global-set-key [mode-line down-mouse-1] 'mouse-drag-mode-line)
-(global-set-key [mode-line mouse-2] 'mouse-delete-other-windows)
-(global-set-key [mode-line mouse-3] 'mouse-delete-window)
-(global-set-key [mode-line C-mouse-2] 'mouse-split-window-horizontally)
-(global-set-key [vertical-scroll-bar C-mouse-2] 'mouse-split-window-vertically)
-(global-set-key [vertical-line C-mouse-2] 'mouse-split-window-vertically)
-(global-set-key [vertical-line down-mouse-1] 'mouse-drag-vertical-line)
-(global-set-key [vertical-line mouse-1] 'mouse-select-window)
-
-(provide 'mouse)
-
-;;; mouse.el ends here
diff --git a/lisp/msb.el b/lisp/msb.el
deleted file mode 100644
index 70361ea5fcd..00000000000
--- a/lisp/msb.el
+++ /dev/null
@@ -1,1002 +0,0 @@
-;;; msb.el --- Customizable buffer-selection with multiple menus.
-
-;; Copyright (C) 1993, 1994, 1995 Lars Lindberg <Lars.Lindberg@sypro.cap.se>
-
-;; Author: Lars Lindberg <Lars.Lindberg@sypro.cap.se>
-;; Created: 8 Oct 1993
-;; Lindberg's last update version: 3.31
-;; Keywords: mouse buffer menu 
-
-;; 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:
-
-;; Purpose of this package:
-;;   1. Offer a function for letting the user choose buffer,
-;;      not necessarily for switching to it.
-;;   2. Make a better mouse-buffer-menu.
-;;
-;; Installation:
-
-;;   1. Byte compile msb first.  It uses things in the cl package that
-;;      are slow if not compiled, but blazingly fast when compiled.  I
-;;      have also had one report that said that msb malfunctioned when
-;;      not compiled.
-;;   2. (require 'msb)
-;;      Note! You now use msb instead of mouse-buffer-menu.
-;;   3. Now try the menu bar Buffers menu.
-;;
-;; Customization:
-;;   Look at the variable `msb-menu-cond' for deciding what menus you
-;;   want.  It's not that hard to customize, despite my not-so-good
-;;   doc-string.  Feel free to send me a better doc-string.
-;;   There are some constants for you to try here:
-;;   msb--few-menus
-;;   msb--very-many-menus (default)
-;;   
-;;   Look at the variable `msb-item-handling-function' for customization
-;;   of the appearance of every menu item.  Try for instance setting
-;;   it to `msb-alon-item-handler'.
-;;   
-;;   Look at the variable `msb-item-sort-function' for customization
-;;   of sorting the menus.  Set it to t for instance, which means no
-;;   sorting - you will get latest used buffer first.
-;;
-;;   Also check out the variable `msb-display-invisible-buffers-p'.
-
-;; Known bugs:
-;; - Files-by-directory
-;;   + No possibility to show client/changed buffers separately.
-;;   + All file buffers only appear in in a file sub-menu, they will
-;;     for instance not appear in the Mail sub-menu.
-
-;; Future enhancements:
-
-;;; Thanks goes to
-;;  Mark Brader <msb@sq.com>
-;;  Jim Berry <m1jhb00@FRB.GOV>
-;;  Hans Chalupsky <hans@cs.Buffalo.EDU>
-;;  Larry Rosenberg <ljr@ictv.com>
-;;  Will Henney <will@astroscu.unam.mx>
-;;  Jari Aalto <jaalto@tre.tele.nokia.fi>
-;;  Michael Kifer <kifer@sbkifer.cs.sunysb.edu>
-;;  Gael Marziou <gael@gnlab030.grenoble.hp.com>
-;;  Dave Gillespie <daveg@thymus.synaptics.com>
-;;  Alon Albert <alon@milcse.rtsg.mot.com>
-;;  Kevin Broadey, <KevinB@bartley.demon.co.uk>
-;;  Ake Stenhof <ake@cadpoint.se>
-;;  Richard Stallman <rms@gnu.ai.mit.edu>
-;;  Steve Fisk <fisk@medved.bowdoin.edu>
-
-;;; Code:
-
-(require 'cl)
-
-;;;
-;;; Some example constants to be used for `msb-menu-cond'.  See that
-;;; variable for more information.  Please note that if the condition
-;;; returns `multi', then the buffer can appear in several menus.
-;;;
-(defconst msb--few-menus
-  '(((and (boundp 'server-buffer-clients)
-	  server-buffer-clients
-	  'multi)
-     3030
-     "Clients (%d)")
-    ((and msb-display-invisible-buffers-p
-	  (msb-invisible-buffer-p)
-	  'multi)
-     3090
-     "Invisible buffers (%d)")
-    ((eq major-mode 'dired-mode)
-     2010
-     "Dired (%d)"
-     msb-dired-item-handler
-     msb-sort-by-directory)
-    ((eq major-mode 'Man-mode)
-     4090
-     "Manuals (%d)")
-    ((eq major-mode 'w3-mode)
-     4020
-     "WWW (%d)")
-    ((or (memq major-mode '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode))
-	 (memq major-mode '(mh-letter-mode
-			    mh-show-mode
-			    mh-folder-mode))	 
-	 (memq major-mode '(gnus-summary-mode
-			    news-reply-mode
-			    gnus-group-mode
-			    gnus-article-mode
-			    gnus-kill-file-mode
-			    gnus-browse-killed-mode)))
-     4010
-     "Mail (%d)")
-    ((not buffer-file-name)
-     4099
-     "Buffers (%d)")
-    ('no-multi
-     1099
-     "Files (%d)")))
-
-(defconst msb--very-many-menus
-  '(((and (boundp 'server-buffer-clients)
-	  server-buffer-clients
-	  'multi)
-     1010
-     "Clients (%d)")
-    ((and (boundp 'vc-mode) vc-mode 'multi)
-     1020
-     "Version Control (%d)")
-    ((and buffer-file-name
-	  (buffer-modified-p)
-	  'multi)
-     1030
-     "Changed files (%d)")
-    ((and (get-buffer-process (current-buffer))
-	  'multi)
-     1040
-     "Processes (%d)")
-    ((and msb-display-invisible-buffers-p
-	  (msb-invisible-buffer-p)
-	  'multi)
-     1090
-     "Invisible buffers (%d)") 
-    ((eq major-mode 'dired-mode)
-     2010
-     "Dired (%d)"
-     ;; Note this different menu-handler
-     msb-dired-item-handler
-     ;; Also note this item-sorter
-     msb-sort-by-directory)
-    ((eq major-mode 'Man-mode)
-     4030
-     "Manuals (%d)")
-    ((eq major-mode 'w3-mode)
-     4020
-     "WWW (%d)")
-    ((or (memq major-mode '(rmail-mode rmail-edit-mode vm-summary-mode vm-mode mail-mode))
-	 (memq major-mode '(mh-letter-mode
-			    mh-show-mode
-			    mh-folder-mode))	 
-	 (memq major-mode '(gnus-summary-mode
-			    news-reply-mode
-			    gnus-group-mode
-			    gnus-article-mode
-			    gnus-kill-file-mode
-			    gnus-browse-killed-mode)))
-     4010
-     "Mail (%d)")
-    ;; Catchup for all non-file buffers
-    ((and (not buffer-file-name)
-	  'no-multi)
-     4099
-     "Other non-file buffers (%d)")
-    ((and (string-match "/\\.[^/]*$" buffer-file-name)
-	  'multi)
-     3090
-     "Hidden Files (%d)")
-    ((memq major-mode '(c-mode c++-mode))
-     3010
-     "C/C++ Files (%d)")
-    ((eq major-mode 'emacs-lisp-mode)
-     3020
-     "Elisp Files (%d)")
-    ((eq major-mode 'latex-mode)
-     3030
-     "LaTex Files (%d)")
-    ('no-multi
-     3099
-     "Other files (%d)")))
-
-;; msb--many-menus is obsolete
-(defvar msb--many-menus msb--very-many-menus)
-
-;;;
-;;; Customizable variables
-;;;
-
-(defvar msb-separator-diff 100
-  "*Non-nil means use separators.
-The separators will appear between all menus that have a sorting key that differs by this value or more.")
-
-(defvar msb-files-by-directory-sort-key 0
-  "*The sort key for files sorted by directory")
-
-(defvar msb-max-menu-items 15
-  "*The maximum number of items in a menu.
-If this variable is set to 15 for instance, then the submenu will be split up in minor parts, 15 items each.
-Nil means no limit.")
-
-(defvar msb-max-file-menu-items 10
-  "*The maximum number of items from different directories.
-
-When the menu is of type `file by directory', this is the maximum
-number of buffers that are clumped together from different
-directories.
-
-Set this to 1 if you want one menu per directory instead of clumping
-them together.
-
-If the value is not a number, then the value 10 is used.")
-
-(defvar msb-most-recently-used-sort-key -1010
-  "*Where should the menu with the most recently used buffers be placed?")
-
-(defvar msb-display-most-recently-used 15
-  "*How many buffers should be in the most-recently-used menu.
- No buffers at all if less than 1 or nil (or any non-number).")
-
-(defvar msb-most-recently-used-title "Most recently used (%d)"
-  "*The title for the most-recently-used menu.")
-  
-(defvar msb-horizontal-shift-function '(lambda () 0)
-  "*Function that specifies a number of pixels by which the top menu should
-be shifted leftwards.")
-
-(defvar msb-display-invisible-buffers-p nil
-  "*Show invisible buffers or not.
-Non-nil means that the buffer menu should include buffers that have
-names that starts with a space character.")
-
-(defvar msb-item-handling-function 'msb-item-handler
-  "*The appearance of a buffer menu.
-
-The default function to call for handling the appearance of a menu
-item.  It should take to arguments, BUFFER and MAX-BUFFER-NAME-LENGTH,
-where the latter is the max length of all buffer names.
-
-The function should return the string to use in the menu.
-
-When the function is called, BUFFER is the current buffer.
-This function is called for items in the variable `msb-menu-cond' that
-have nil as ITEM-HANDLING-FUNCTION.  See `msb-menu-cond' for more
-information.")
-
-(defvar msb-item-sort-function 'msb-sort-by-name
-  "*The order of items in a buffer menu.
-The default function to call for handling the order of items in a menu
-item.  This function is called like a sort function.  The items
-look like (ITEM-NAME . BUFFER).
-ITEM-NAME is the name of the item that will appear in the menu.
-BUFFER is the buffer, this is not necessarily the current buffer.
-
-Set this to nil or t if you don't want any sorting (faster).")
-
-(defvar msb-files-by-directory nil
-  "*Non-nil means that files should be sorted by directory instead of
-the groups in msb-menu-cond.")
-
-(defvar msb-menu-cond msb--very-many-menus
-  "*List of criteria for splitting the mouse buffer menu.
-The elements in the list should be of this type:
- (CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLING-FN ITEM-SORT-FN).
-
-When making the split, the buffers are tested one by one against the
-CONDITION, just like a lisp cond: When hitting a true condition, the
-other criteria are *not* tested and the buffer name will appear in
-the menu with the menu-title corresponding to the true condition.
-
-If the condition returns the symbol `multi', then the buffer will be
-added to this menu *and* tested for other menus too.  If it returns
-`no-multi', then the buffer will only be added if it hasn't been added
-to any other menu.
-
-During this test, the buffer in question is the current buffer, and
-the test is surrounded by calls to `save-excursion' and
-`save-match-data'.
-
-The categories are sorted by MENU-SORT-KEY.  Smaller keys are on
-top.  nil means don't display this menu.
-
-MENU-TITLE is really a format.  If you add %d in it, the %d is replaced
-with the number of items in that menu.
-
-ITEM-HANDLING-FN, is optional.  If it is supplied and is a
-function, than it is used for displaying the items in that particular
-buffer menu, otherwise the function pointed out by
-`msb-item-handling-function' is used.
-
-ITEM-SORT-FN, is also optional.
-If it is not supplied, the function pointed out by
-`msb-item-sort-function' is used.
-If it is nil, then no sort takes place and the buffers are presented
-in least-recently-used order.
-If it is t, then no sort takes place and the buffers are presented in
-most-recently-used order.
-If it is supplied and non-nil and not t than it is used for sorting
-the items in that particular buffer menu.
-
-Note1: There should always be a `catch-all' as last element,
-in this list.  That is an element like (t TITLE ITEM-HANDLING-FUNCTION).
-Note2: A buffer menu appears only if it has at least one buffer in it.
-Note3: If you have a CONDITION that can't be evaluated you will get an
-error every time you do \\[msb].")
-
-(defvar msb-after-load-hooks nil
-  "Hooks to be run after the msb package has been loaded.")
-
-;;;
-;;; Internal variables
-;;;
-
-;; The last calculated menu.
-(defvar msb--last-buffer-menu nil)
-
-;; If this is non-nil, then it is a string that describes the error.
-(defvar msb--error nil)
-
-;;;
-;;; Some example function to be used for `msb-item-handling-function'.
-;;;
-(defun msb-item-handler (buffer &optional maxbuf)
-  "Create one string item, concerning BUFFER, for the buffer menu.
-The item looks like:
-*% <buffer-name>
-The `*' appears only if the buffer is marked as modified.
-The `%' appears only if the buffer is read-only.
-Optional second argument MAXBUF is completely ignored."
-  (let ((name (buffer-name))
-	(modified (if (buffer-modified-p) "*" " "))
-	(read-only (if buffer-read-only "%" " ")))
-    (format "%s%s %s" modified read-only name)))
-
-
-(eval-when-compile (require 'dired))
-
-;; `dired' can be called with a list of the form (directory file1 file2 ...)
-;; which causes `dired-directory' to be in the same form.
-(defun msb--dired-directory ()
-  (cond ((stringp dired-directory)
-	 (abbreviate-file-name (expand-file-name dired-directory)))
-	((consp dired-directory)
-	 (abbreviate-file-name (expand-file-name (car dired-directory))))
-	(t
-	 (error "Unknown type of `dired-directory' in buffer %s"
-		(buffer-name)))))
-
-(defun msb-dired-item-handler (buffer &optional maxbuf)
-  "Create one string item, concerning a dired BUFFER, for the buffer menu.
-The item looks like:
-*% <buffer-name>
-The `*' appears only if the buffer is marked as modified.
-The `%' appears only if the buffer is read-only.
-Optional second argument MAXBUF is completely ignored."
-  (let ((name (msb--dired-directory))
-	(modified (if (buffer-modified-p) "*" " "))
-	(read-only (if buffer-read-only "%" " ")))
-    (format "%s%s %s" modified read-only name)))
-
-(defun msb-alon-item-handler (buffer maxbuf)
-  "Create one string item for the buffer menu.
-The item looks like:
-<buffer-name> *%# <file-name>
-The `*' appears only if the buffer is marked as modified.
-The `%' appears only if the buffer is read-only.
-The `#' appears only version control file (SCCS/RCS)."
-  (format (format "%%%ds  %%s%%s%%s  %%s" maxbuf)
-          (buffer-name buffer)
-          (if (buffer-modified-p) "*" " ")
-          (if buffer-read-only "%" " ")
-          (if (and (boundp 'vc-mode) vc-mode) "#" " ")
-          (or buffer-file-name "")))
-
-;;;
-;;; Some example function to be used for `msb-item-sort-function'.
-;;;
-(defun msb-sort-by-name (item1 item2)
-  "Sorts the items depending on their buffer-name
-An item look like (NAME . BUFFER)."
-  (string-lessp (buffer-name (cdr item1))
-		(buffer-name (cdr item2))))
-
-
-(defun msb-sort-by-directory (item1 item2)
-  "Sorts the items depending on their directory.  Made for dired.
-An item look like (NAME . BUFFER)."
-  (string-lessp (save-excursion (set-buffer (cdr item1)) (msb--dired-directory))
-		(save-excursion (set-buffer (cdr item2)) (msb--dired-directory))))
-
-;;;
-;;; msb
-;;;
-;;; This function can be used instead of (mouse-buffer-menu EVENT)
-;;; function in "mouse.el".
-;;; 
-(defun msb (event)
-  "Pop up several menus of buffers for selection with the mouse.
-This command switches buffers in the window that you clicked on, and
-selects that window.
-
-See the function `mouse-select-buffer' and the variable
-`msb-menu-cond' for more information about how the menus are split."
-  (interactive "e")
-  (let ((old-window (selected-window))
-	(window (posn-window (event-start event))))
-    (unless (framep window) (select-window window))
-    (let ((buffer (mouse-select-buffer event)))
-      (if buffer
-	  (switch-to-buffer buffer)
-	(select-window old-window))))
-  nil)
-
-;;;
-;;; Some supportive functions
-;;;
-(defun msb-invisible-buffer-p (&optional buffer)
-  "Return t if optional BUFFER is an \"invisible\" buffer.
-If the argument is left out or nil, then the current buffer is considered."
-  (and (> (length (buffer-name buffer)) 0)
-       (eq ?\ (aref (buffer-name buffer) 0))))
-
-;; Strip one hierarchy level from the end of PATH.
-(defun msb--strip-path (path)
-  (save-match-data
-    (if (string-match "\\(.+\\)/[^/]+$" path)
-	(substring path (match-beginning 1) (match-end 1))
-      "/")))
-
-;; Create an alist with all buffers from LIST that lies under the same
-;; directory will be in the same item as the directory string as
-;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K BUFFER-K+1...)) ...)
-(defun msb--init-file-alist (list)
-  (let ((buffer-alist
-	 (sort (mapcan
-		(function
-		 (lambda (buffer)
-		   (let ((file-name (buffer-file-name buffer)))
-		     (when file-name
-		       (list (cons (msb--strip-path file-name) buffer))))))
-		list)
-	       (function (lambda (item1 item2)
-			   (string< (car item1) (car item2)))))))
-    ;; Make alist that looks like
-    ;; ((PATH1 . (BUFFER-1 BUFFER-2 ...)) (PATH2 . (BUFFER-K)) ...)
-    (let ((path nil)
-	  (buffers nil)
-	  (result nil))
-      (append
-       (mapcan (function
-	       (lambda (item)
-		 (cond
-		  ((and path
-			(string= path (car item)))
-		   (push (cdr item) buffers)
-		   nil)
-		  (t
-		   (when path
-		     (setq result (cons path buffers)))
-		   (setq path (car item))
-		   (setq buffers (list (cdr item)))
-		   (and result (list result))))))
-	      buffer-alist)
-       (list (cons path buffers))))))
-
-;; Choose file-menu with respect to directory for every buffer in LIST.
-(defun msb--choose-file-menu (list)
-  (let ((buffer-alist (msb--init-file-alist list))
-	(final-list nil)
-	(max-clumped-together (if (numberp msb-max-file-menu-items)
-				  msb-max-file-menu-items
-				10))
-	(top-found-p nil)
-	(last-path nil)
-	first rest path buffers)
-    (setq first (car buffer-alist))
-    (setq rest (cdr buffer-alist))
-    (setq path (car first))
-    (setq buffers (cdr first))
-    (while rest
-      (let ((found-p nil)
-	    (tmp-rest rest)
-	    new-path item)
-	(setq item (car tmp-rest))
-	(while (and tmp-rest
-		    (<= (length buffers) max-clumped-together)
-		    (>= (length (car item)) (length path))
-		    (string= path (substring (car item) 0 (length path))))
-	  (setq found-p t)
-	  (setq buffers (append buffers (cdr item)))
-	  (setq tmp-rest (cdr tmp-rest))
-	  (setq item (car tmp-rest)))
-	(cond
-	 ((> (length buffers) max-clumped-together)
-	  (setq last-path (car first))
-	  (setq first
-		(cons (format (if top-found-p
-				  "%s/... (%d)"
-				"%s (%d)")
-			      (car first)
-			      (length (cdr first)))
-		      (cdr first)))
-	  (setq top-found-p nil)
-	  (push first final-list)
-	  (setq first (car rest)
-		rest (cdr rest))
-	  (setq path (car first)
-		buffers (cdr first)))
-	 (t
-	  (when found-p
-	    (setq top-found-p t)
-	    (setq first (cons path buffers)
-		  rest tmp-rest))
-	  (setq path (msb--strip-path path)
-		buffers (cdr first))
-	  (when (and last-path
-		     (or (and (>= (length path) (length last-path))
-			      (string= last-path
-				       (substring path 0 (length last-path))))
-			 (and (< (length path) (length last-path))
-			      (string= path
-				       (substring last-path 0 (length path))))))
-			 
-	    (setq first
-		  (cons (format (if top-found-p
-				    "%s/... (%d)"
-				  "%s (%d)")
-				(car first)
-				(length (cdr first)))
-			(cdr first)))
-	    (setq top-found-p nil)
-	    (push first final-list)
-	    (setq first (car rest)
-		  rest (cdr rest))
-	    (setq path (car first)
-		buffers (cdr first)))))))
-    (setq first
-	  (cons (format (if top-found-p
-			    "%s/... (%d)"
-			  "%s (%d)")
-			(car first)
-			(length (cdr first)))
-		(cdr first)))
-    (setq top-found-p nil)
-    (push first final-list)
-    (nreverse final-list)))
-
-;; Create a vector as:
-;; [BUFFER-LIST-VARIABLE CONDITION MENU-SORT-KEY MENU-TITLE ITEM-HANDLER SORTER)
-;; from an element in `msb-menu-cond'.  See that variable for a
-;; description of its elements.
-(defun msb--create-function-info (menu-cond-elt)
-  (let* ((list-symbol (make-symbol "-msb-buffer-list"))
-	 (tmp-ih (and (> (length menu-cond-elt) 3)
-		      (nth 3 menu-cond-elt)))
-	 (item-handler (if (and tmp-ih (fboundp tmp-ih))
-			   tmp-ih
-			 msb-item-handling-function))
-	 (tmp-s (if (> (length menu-cond-elt) 4)
-		    (nth 4 menu-cond-elt)
-		  msb-item-sort-function))
-	 (sorter (if (or (fboundp tmp-s)
-			 (null tmp-s)
-			 (eq tmp-s t))
-		    tmp-s
-		   msb-item-sort-function)))
-    (when (< (length menu-cond-elt) 3)
-      (error "Wrong format of msb-menu-cond."))
-    (when (and (> (length menu-cond-elt) 3)
-	       (not (fboundp tmp-ih)))
-      (signal 'invalid-function (list tmp-ih)))
-    (when (and (> (length menu-cond-elt) 4)
-	       tmp-s
-	       (not (fboundp tmp-s))
-	       (not (eq tmp-s t)))
-      (signal 'invalid-function (list tmp-s)))
-    (set list-symbol ())
-    (vector list-symbol			;BUFFER-LIST-VARIABLE
-	    (nth 0 menu-cond-elt)	;CONDITION
-	    (nth 1 menu-cond-elt)	;SORT-KEY
-	    (nth 2 menu-cond-elt)	;MENU-TITLE
-	    item-handler		;ITEM-HANDLER
-	    sorter)			;SORTER
-    ))
-
-;; This defsubst is only used in `msb--choose-menu' below.  It was
-;; pulled out merely to make the code somewhat clearer.  The indention
-;; level was too big.
-(defsubst msb--collect (function-info-vector)
-  (let ((result nil)
-	(multi-flag nil)
-	function-info-list)
-    (setq function-info-list
-	  (loop for fi
-		across function-info-vector
-		if (and (setq result
-			      (eval (aref fi 1))) ;Test CONDITION
-			(not (and (eq result 'no-multi)
-				  multi-flag))
-			(progn (when (eq result 'multi)
-				 (setq multi-flag t))
-			       t))
-		collect fi
-		until (and result
-			   (not (eq result 'multi)))))
-    (when (and (not function-info-list)
-	       (not result))
-      (error "No catch-all in msb-menu-cond!"))
-    function-info-list))
-
-;; Adds BUFFER to the menu depicted by FUNCTION-INFO
-;; All side-effects.  Adds an element of form (BUFFER-TITLE . BUFFER)
-;; to the buffer-list variable in function-info.
-(defun msb--add-to-menu (buffer function-info max-buffer-name-length)
-  (let ((list-symbol (aref function-info 0))) ;BUFFER-LIST-VARIABLE
-    ;; Here comes the hairy side-effect!
-    (set list-symbol
-	 (cons (cons (funcall (aref function-info 4) ;ITEM-HANDLER
-			      buffer
-			      max-buffer-name-length)
-		     buffer)
-	       (eval list-symbol)))))
-  
-;; Selects the appropriate menu for BUFFER.
-;; This is all side-effects, folks!
-;; This should be optimized.
-(defsubst msb--choose-menu (buffer function-info-vector max-buffer-name-length)
-  (unless (and (not msb-display-invisible-buffers-p)
-	       (msb-invisible-buffer-p buffer))
-    (condition-case nil
-	(save-excursion
-	  (set-buffer buffer)
-	  ;; Menu found.  Add to this menu
-	  (mapc (function
-		 (lambda (function-info)
-		   (msb--add-to-menu buffer function-info max-buffer-name-length)))
-		(msb--collect function-info-vector)))
-      (error (unless msb--error
-	       (setq msb--error
-		     (format
-		      "In msb-menu-cond, error for buffer `%s'."
-		      (buffer-name buffer)))
-	       (error "%s" msb--error))))))
-
-;; Return (SORT-KEY TITLE . BUFFER-LIST) or nil if the
-;; buffer-list is empty.
-(defun msb--create-sort-item (function-info)
-  (let ((buffer-list (eval (aref function-info 0))))
-    (when buffer-list
-      (let ((sorter (aref function-info 5)) ;SORTER
-	    (sort-key (aref function-info 2))) ;MENU-SORT-KEY
-	(when sort-key
-	  (cons sort-key	
-		(cons (format (aref function-info 3) ;MENU-TITLE
-			      (length buffer-list))
-		      (cond
-		       ((null sorter)
-			buffer-list)
-		       ((eq sorter t)
-			(nreverse buffer-list))
-		       (t
-			(sort buffer-list sorter))))))))))
-
-;; Returns a list on the form ((TITLE . BUFFER-LIST)) for
-;; the most recently used buffers.
-(defun msb--most-recently-used-menu (max-buffer-name-length)
-  (when (and (numberp msb-display-most-recently-used)
- 	     (> msb-display-most-recently-used 0))
-    (let* ((buffers (cdr (buffer-list)))
-	   (most-recently-used
-	    (loop with n = 0
-		  for buffer in buffers
-		  if (save-excursion
-		       (set-buffer buffer)
-		       (and (not (msb-invisible-buffer-p))
-			    (not (eq major-mode 'dired-mode))))
-		  collect (save-excursion
-			    (set-buffer buffer)
-			    (cons (funcall msb-item-handling-function
-					   buffer
-					   max-buffer-name-length)
-				  buffer))
-		  and do (incf n)
-		  until (>= n msb-display-most-recently-used))))
-      (cons (if (stringp msb-most-recently-used-title)
-		(format msb-most-recently-used-title
-			(length most-recently-used))
-	      (signal 'wrong-type-argument (list msb-most-recently-used-title)))
-	    most-recently-used))))
-
-(defun msb--create-buffer-menu-2 ()
-  (let ((max-buffer-name-length 0)
-	file-buffers
-	function-info-vector)
-    ;; Calculate the longest buffer name.
-    (mapc
-     (function
-      (lambda (buffer)
-	(if (or msb-display-invisible-buffers-p
-		(not (msb-invisible-buffer-p)))
-	    (setq max-buffer-name-length
-		  (max max-buffer-name-length
-		       (length (buffer-name buffer)))))))
-     (buffer-list))
-    ;; Make a list with elements of type
-    ;; (BUFFER-LIST-VARIABLE
-    ;;  CONDITION
-    ;;  MENU-SORT-KEY
-    ;;  MENU-TITLE
-    ;;  ITEM-HANDLER
-    ;;  SORTER)
-    ;; Uses "function-global" variables:
-    ;; function-info-vector
-    (setq function-info-vector
-	  (apply (function vector)
-		 (mapcar (function msb--create-function-info)
-			 msb-menu-cond)))
-    ;; Split the buffer-list into several lists; one list for each
-    ;; criteria.  This is the most critical part with respect to time.
-    (mapc (function (lambda (buffer)
-		      (cond ((and msb-files-by-directory
-				  (buffer-file-name buffer))
-			     (push buffer file-buffers))
-			    (t
-			     (msb--choose-menu buffer
-					       function-info-vector
-					       max-buffer-name-length)))))
-	  (buffer-list))
-    (when file-buffers
-      (setq file-buffers
-	    (mapcar (function
-		     (lambda (buffer-list)
-		       (cons msb-files-by-directory-sort-key
-			     (cons (car buffer-list)
-				   (sort
-				    (mapcar (function
-					     (lambda (buffer)
-					       (cons (save-excursion
-						       (set-buffer buffer)
-						       (funcall msb-item-handling-function
-							      buffer
-							      max-buffer-name-length))
-						     buffer)))
-					    (cdr buffer-list))
-				    (function
-				     (lambda (item1 item2)
-				       (string< (car item1) (car item2)))))))))
-		     (msb--choose-file-menu file-buffers))))
-    ;; Now make the menu - a list of (TITLE . BUFFER-LIST)
-    (let* (menu
-	   (most-recently-used
-	    (msb--most-recently-used-menu max-buffer-name-length))
-	   (others (append file-buffers
-			   (loop for elt
-				 across function-info-vector
-				 for value = (msb--create-sort-item elt)
-				 if value collect value))))
-      (setq menu
-	    (mapcar 'cdr		;Remove the SORT-KEY
-		    ;; Sort the menus - not the items.
-		    (msb--add-separators
-		    (sort
-		     ;; Get a list of (SORT-KEY TITLE . BUFFER-LIST)
-		     ;; Also sorts the items within the menus.
-		     (if (cdr most-recently-used)
-			 (cons
-			  ;; Add most recent used buffers
-			  (cons msb-most-recently-used-sort-key
-				most-recently-used)
-			  others)
-		       others)
-		     (function (lambda (elt1 elt2)
-				 (< (car elt1) (car elt2))))))))
-      ;; Now make it a keymap menu
-      (append
-       '(keymap "Select Buffer")
-       (msb--make-keymap-menu menu)
-       (when msb-separator-diff
-	 (list (list 'separator "---")))
-       (list (cons 'toggle 
-		   (cons
-		   (if msb-files-by-directory
-		       "*Files by type*"
-		     "*Files by directory*")
-		   'msb--toggle-menu-type)))))))
-
-(defun msb--create-buffer-menu  ()
-  (save-match-data
-    (save-excursion
-      (msb--create-buffer-menu-2))))
-
-;;;
-;;; Multi purpose function for selecting a buffer with the mouse.
-;;; 
-(defun msb--toggle-menu-type ()
-  (interactive)
-  (setq msb-files-by-directory (not msb-files-by-directory))
-  (menu-bar-update-buffers t))
-
-(defun mouse-select-buffer (event)
-  "Pop up several menus of buffers, for selection with the mouse.
-Returns the selected buffer or nil if no buffer is selected.
-
-The way the buffers are split is conveniently handled with the
-variable `msb-menu-cond'."
-  ;; Popup the menu and return the selected buffer.
-  (when (or msb--error
-	    (not msb--last-buffer-menu)
-	    (not (fboundp 'frame-or-buffer-changed-p))
-	    (frame-or-buffer-changed-p))
-    (setq msb--error nil)
-    (setq msb--last-buffer-menu (msb--create-buffer-menu)))
-  (let ((position event)
-	choice)
-    (when (and (fboundp 'posn-x-y)
-	       (fboundp 'posn-window))
-      (let ((posX (car (posn-x-y (event-start event))))
-	    (posY (cdr (posn-x-y (event-start event))))
-	    (posWind (posn-window (event-start event))))
-	;; adjust position
-	(setq posX (- posX (funcall msb-horizontal-shift-function))
-	      position (list (list posX posY) posWind))))
-    ;; This `sit-for' magically makes the menu stay up if the mouse
-    ;; button is released within 0.1 second.
-    (sit-for 0 100)
-    ;; Popup the menu
-    (setq choice (x-popup-menu position msb--last-buffer-menu))
-    (cond
-     ((eq (car choice) 'toggle)
-      ;; Bring up the menu again with type toggled.
-      (msb--toggle-menu-type)
-      (mouse-select-buffer event))
-     ((and (numberp (car choice))
-	   (null (cdr choice)))
-      (let ((msb--last-buffer-menu (nthcdr 3 (assq (car choice) msb--last-buffer-menu))))
-	(mouse-select-buffer event)))
-     ((while (numberp (car choice))
-	(setq choice (cdr choice))))
-     ((and (stringp (car choice))
-	   (null (cdr choice)))
-      (car choice))
-     ((null choice)
-      choice)
-     (t
-      (error "Unknown form for buffer: %s" choice)))))
-		    
-;; Add separators
-(defun msb--add-separators (sorted-list)
-  (cond
-   ((or (not msb-separator-diff)
-	(not (numberp msb-separator-diff)))
-    sorted-list)
-   (t
-    (let ((last-key nil))
-      (mapcan
-       (function
-	(lambda (item)
-	  (cond
-	   ((and msb-separator-diff
-		 last-key 
-		 (> (- (car item) last-key)
-		    msb-separator-diff))
-	    (setq last-key (car item))
-	    (list (cons last-key 'separator)
-		  item))
-	   (t
-	    (setq last-key (car item))
-	    (list item)))))
-       sorted-list)))))
-
-(defun msb--split-menus-2 (list mcount result)
-  (cond
-   ((> (length list) msb-max-menu-items)
-    (let ((count 0)
-	  sub-name
-	  (tmp-list nil))
-      (while (< count msb-max-menu-items)
-	(push (pop list) tmp-list)
-	(incf count))
-    (setq tmp-list (nreverse tmp-list))
-    (setq sub-name (concat (car (car tmp-list)) "..."))
-    (push (append (list mcount sub-name
-			'keymap sub-name)
-		  tmp-list)
-	  result))
-    (msb--split-menus-2 list (1+ mcount) result))
-   ((null result)
-    list)
-   (t
-    (let (sub-name)
-      (setq sub-name (concat (car (car list)) "..."))
-      (push (append (list mcount sub-name
-			'keymap sub-name)
-		  list)
-	  result))
-    (nreverse result))))
-    
-(defun msb--split-menus (list)
- (msb--split-menus-2 list 0 nil))
-
-
-(defun msb--make-keymap-menu (raw-menu)
-  (let ((end (cons '(nil) 'menu-bar-select-buffer))
-	(mcount 0))
-    (mapcar
-     (function
-      (lambda (sub-menu)
-	(cond 
-	 ((eq 'separator sub-menu)
-	  (list 'separator "---"))
-	 (t
-	  (let ((buffers (mapcar (function
-				  (lambda (item)
-				    (let ((string (car item))
-					  (buffer (cdr item)))
-				      (cons (buffer-name buffer)
-					    (cons string end)))))
-				 (cdr sub-menu))))
-	    (append (list (incf mcount) (car sub-menu)
-			  'keymap (car sub-menu))
-		    (msb--split-menus buffers)))))))
-     raw-menu)))
-
-(defun menu-bar-update-buffers (&optional arg)
-  ;; If user discards the Buffers item, play along.
-  (when (and (lookup-key (current-global-map) [menu-bar buffer])
-	     (or (not (fboundp 'frame-or-buffer-changed-p))
-		 (frame-or-buffer-changed-p)
-		 arg))
-    (let ((frames (frame-list))
-	  buffers-menu frames-menu)
-      ;; Make the menu of buffers proper.
-      (setq msb--last-buffer-menu (msb--create-buffer-menu))
-      (setq buffers-menu msb--last-buffer-menu)
-      ;; Make a Frames menu if we have more than one frame.
-      (when (cdr frames)
-	(let* ((frame-length (length frames))
-	       (f-title  (format "Frames (%d)" frame-length)))
-	  ;; List only the N most recently selected frames
-	  (when (and (integerp msb-max-menu-items)
-		     (>  msb-max-menu-items 1)
-		     (> frame-length msb-max-menu-items))
-	    (setcdr (nthcdr msb-max-menu-items frames) nil))
-	  (setq frames-menu
-		(nconc
-		 (list 'frame f-title '(nil) 'keymap f-title)
-		 (mapcar
-		  (function
-		   (lambda (frame)
-		     (nconc
-		      (list frame
-			    (cdr (assq 'name
-				       (frame-parameters frame)))
-			    (cons nil nil))
-		      'menu-bar-select-frame)))
-		  frames)))))
-      (define-key (current-global-map) [menu-bar buffer]
-	(cons "Buffers"
-	      (if (and buffers-menu frames-menu)
-		  ;; Combine Frame and Buffers menus with separator between
-		  (nconc (list 'keymap "Buffers and Frames" frames-menu
-			       (and msb-separator-diff '(separator "---")))
-			 (cddr buffers-menu))
-		(or buffers-menu 'undefined)))))))
-
-(unless (or (not (boundp 'menu-bar-update-hook))
-	    (memq 'menu-bar-update-buffers menu-bar-update-hook))
-    (add-hook 'menu-bar-update-hook 'menu-bar-update-buffers))
-
-(and (fboundp 'mouse-buffer-menu)
-     (substitute-key-definition 'mouse-buffer-menu 'msb (current-global-map)))
-
-(provide 'msb)
-(eval-after-load 'msb (run-hooks 'msb-after-load-hooks))
-
-;; Load the cl-extra library now, since we will certainly need it later.
-(mapc 'ignore nil)
-
-;;; msb.el ends here
diff --git a/lisp/nnbabyl.el b/lisp/nnbabyl.el
deleted file mode 100644
index 330fe905744..00000000000
--- a/lisp/nnbabyl.el
+++ /dev/null
@@ -1,625 +0,0 @@
-;;; nnbabyl.el --- rmail mbox access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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:
-
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.  
-
-;;; Code:
-
-(require 'nnheader)
-(require 'rmail)
-(require 'nnmail)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnbabyl)
-
-(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL")
-  "The name of the rmail box file in the users home directory.")
-
-(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
-  "The name of the active file for the rmail box.")
-
-(defvoo nnbabyl-get-new-mail t
-  "If non-nil, nnbabyl will check the incoming mail file and split the mail.")
-
-(defvoo nnbabyl-prepare-save-mail-hook nil
-  "Hook run narrowed to an article before saving.")
-
-
-
-(defvar nnbabyl-mail-delimiter "\^_")
-
-(defconst nnbabyl-version "nnbabyl 1.0"
-  "nnbabyl version.")
-
-(defvoo nnbabyl-mbox-buffer nil)
-(defvoo nnbabyl-current-group nil)
-(defvoo nnbabyl-status-string "")
-(defvoo nnbabyl-group-alist nil)
-(defvoo nnbabyl-active-timestamp nil)
-
-(defvoo nnbabyl-previous-buffer-mode nil)
-
-(eval-and-compile
-  (autoload 'gnus-set-text-properties "gnus-ems"))
-
-
-
-;;; Interface functions
-
-(nnoo-define-basics nnbabyl)
-
-(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (let ((number (length articles))
-	  (count 0)
-	  (delim (concat "^" nnbabyl-mail-delimiter))
-	  article art-string start stop)
-      (nnbabyl-possibly-change-newsgroup group server)
-      (while (setq article (pop articles))
-	(setq art-string (nnbabyl-article-string article))
-	(set-buffer nnbabyl-mbox-buffer)
-	(beginning-of-line)
-	(when (or (search-forward art-string nil t)
-		  (search-backward art-string nil t))
-	  (re-search-backward delim nil t)
-	  (while (and (not (looking-at ".+:"))
-		      (zerop (forward-line 1))))
-	  (setq start (point))
-	  (search-forward "\n\n" nil t)
-	  (setq stop (1- (point)))
-	  (set-buffer nntp-server-buffer)
-	  (insert "221 ")
-	  (princ article (current-buffer))
-	  (insert " Article retrieved.\n")
-	  (insert-buffer-substring nnbabyl-mbox-buffer start stop)
-	  (goto-char (point-max))
-	  (insert ".\n"))
-	(and (numberp nnmail-large-newsgroup)
-	     (> number nnmail-large-newsgroup)
-	     (zerop (% (incf count) 20))
-	     (nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
-			       (/ (* count 100) number))))
-
-      (and (numberp nnmail-large-newsgroup)
-	   (> number nnmail-large-newsgroup)
-	   (nnheader-message 5 "nnbabyl: Receiving headers...done"))
-
-      (set-buffer nntp-server-buffer)
-      (nnheader-fold-continuation-lines)
-      'headers)))
-
-(deffoo nnbabyl-open-server (server &optional defs)
-  (nnoo-change-server 'nnbabyl server defs)
-  (cond 
-   ((not (file-exists-p nnbabyl-mbox-file))
-    (nnbabyl-close-server)
-    (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file))
-   ((file-directory-p nnbabyl-mbox-file)
-    (nnbabyl-close-server)
-    (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file))
-   (t
-    (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server
-		     nnbabyl-mbox-file)
-    t)))
-
-(deffoo nnbabyl-close-server (&optional server)
-  ;; Restore buffer mode.
-  (when (and (nnbabyl-server-opened)
-	     nnbabyl-previous-buffer-mode)
-    (save-excursion
-      (set-buffer nnbabyl-mbox-buffer)
-      (narrow-to-region
-       (caar nnbabyl-previous-buffer-mode)
-       (cdar nnbabyl-previous-buffer-mode))
-      (funcall (cdr nnbabyl-previous-buffer-mode))))
-  (nnoo-close-server 'nnbabyl server)
-  (setq nnbabyl-mbox-buffer nil)
-  t)
-
-(deffoo nnbabyl-server-opened (&optional server)
-  (and (nnoo-current-server-p 'nnbabyl server)
-       nnbabyl-mbox-buffer
-       (buffer-name nnbabyl-mbox-buffer)
-       nntp-server-buffer
-       (buffer-name nntp-server-buffer)))
-
-(deffoo nnbabyl-request-article (article &optional newsgroup server buffer)
-  (nnbabyl-possibly-change-newsgroup newsgroup server)
-  (save-excursion
-    (set-buffer nnbabyl-mbox-buffer)
-    (goto-char (point-min))
-    (when (search-forward (nnbabyl-article-string article) nil t)
-      (let (start stop summary-line)
-	(re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
-	(while (and (not (looking-at ".+:"))
-		    (zerop (forward-line 1))))
-	(setq start (point))
-	(or (and (re-search-forward 
-		  (concat "^" nnbabyl-mail-delimiter) nil t)
-		 (forward-line -1))
-	    (goto-char (point-max)))
-	(setq stop (point))
-	(let ((nntp-server-buffer (or buffer nntp-server-buffer)))
-	  (set-buffer nntp-server-buffer)
-	  (erase-buffer)
-	  (insert-buffer-substring nnbabyl-mbox-buffer start stop)
-	  (goto-char (point-min))
-	  ;; If there is an EOOH header, then we have to remove some
-	  ;; duplicated headers. 
-	  (setq summary-line (looking-at "Summary-line:"))
-	  (when (search-forward "\n*** EOOH ***" nil t)
-	    (if summary-line
-		;; The headers to be deleted are located before the
-		;; EOOH line...
-		(delete-region (point-min) (progn (forward-line 1)
-						  (point)))
-	      ;; ...or after.
-	      (delete-region (progn (beginning-of-line) (point))
-			     (or (search-forward "\n\n" nil t)
-				 (point)))))
-	  (if (numberp article) 
-	      (cons nnbabyl-current-group article)
-	    (nnbabyl-article-group-number)))))))
-
-(deffoo nnbabyl-request-group (group &optional server dont-check)
-  (let ((active (cadr (assoc group nnbabyl-group-alist))))
-    (save-excursion
-      (cond 
-       ((or (null active)
-	    (null (nnbabyl-possibly-change-newsgroup group server)))
-	(nnheader-report 'nnbabyl "No such group: %s" group))
-       (dont-check
-	(nnheader-report 'nnbabyl "Selected group %s" group)
-	(nnheader-insert ""))
-       (t
-	(nnheader-report 'nnbabyl "Selected group %s" group)
-	(nnheader-insert "211 %d %d %d %s\n" 
-			 (1+ (- (cdr active) (car active)))
-			 (car active) (cdr active) group))))))
-
-(deffoo nnbabyl-request-scan (&optional group server)
-  (nnbabyl-read-mbox)
-  (nnmail-get-new-mail 
-   'nnbabyl 
-   (lambda ()
-     (save-excursion
-       (set-buffer nnbabyl-mbox-buffer)
-       (save-buffer)))
-   nnbabyl-mbox-file group
-   (lambda ()
-     (save-excursion
-       (let ((in-buf (current-buffer)))
-	 (goto-char (point-min))
-	 (while (search-forward "\n\^_\n" nil t)
-	   (delete-char -1))
-	 (set-buffer nnbabyl-mbox-buffer)
-	 (goto-char (point-max))
-	 (search-backward "\n\^_" nil t)
-	 (goto-char (match-end 0))
-	 (insert-buffer-substring in-buf)))
-     (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))
-
-(deffoo nnbabyl-close-group (group &optional server)
-  t)
-
-(deffoo nnbabyl-request-create-group (group &optional server) 
-  (nnmail-activate 'nnbabyl)
-  (unless (assoc group nnbabyl-group-alist)
-    (setq nnbabyl-group-alist (cons (list group (cons 1 0))
-				    nnbabyl-group-alist))
-    (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
-  t)
-
-(deffoo nnbabyl-request-list (&optional server)
-  (save-excursion
-    (nnmail-find-file nnbabyl-active-file)
-    (setq nnbabyl-group-alist (nnmail-get-active))))
-
-(deffoo nnbabyl-request-newgroups (date &optional server)
-  (nnbabyl-request-list server))
-
-(deffoo nnbabyl-request-list-newsgroups (&optional server)
-  (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))
-
-(deffoo nnbabyl-request-expire-articles
-  (articles newsgroup &optional server force)
-  (nnbabyl-possibly-change-newsgroup newsgroup server)
-  (let* ((is-old t)
-	 rest)
-    (nnmail-activate 'nnbabyl)
-
-    (save-excursion 
-      (set-buffer nnbabyl-mbox-buffer)
-      (gnus-set-text-properties (point-min) (point-max) nil)
-      (while (and articles is-old)
-	(goto-char (point-min))
-	(if (search-forward (nnbabyl-article-string (car articles)) nil t)
-	    (if (setq is-old
-		      (nnmail-expired-article-p
-		       newsgroup
-		       (buffer-substring 
-			(point) (progn (end-of-line) (point))) force))
-		(progn
-		  (nnheader-message 5 "Deleting article %d in %s..." 
-				    (car articles) newsgroup)
-		  (nnbabyl-delete-mail))
-	      (setq rest (cons (car articles) rest))))
-	(setq articles (cdr articles)))
-      (save-buffer)
-      ;; Find the lowest active article in this group.
-      (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist))))
-	(goto-char (point-min))
-	(while (and (not (search-forward
-			  (nnbabyl-article-string (car active)) nil t))
-		    (<= (car active) (cdr active)))
-	  (setcar active (1+ (car active)))
-	  (goto-char (point-min))))
-      (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
-      (nconc rest articles))))
-
-(deffoo nnbabyl-request-move-article 
-  (article group server accept-form &optional last)
-  (nnbabyl-possibly-change-newsgroup group server)
-  (let ((buf (get-buffer-create " *nnbabyl move*"))
-	result)
-    (and 
-     (nnbabyl-request-article article group server)
-     (save-excursion
-       (set-buffer buf)
-       (insert-buffer-substring nntp-server-buffer)
-       (goto-char (point-min))
-       (if (re-search-forward 
-	    "^X-Gnus-Newsgroup:" 
-	    (save-excursion (search-forward "\n\n" nil t) (point)) t)
-	   (delete-region (progn (beginning-of-line) (point))
-			  (progn (forward-line 1) (point))))
-       (setq result (eval accept-form))
-       (kill-buffer (current-buffer))
-       result)
-     (save-excursion
-       (set-buffer nnbabyl-mbox-buffer)
-       (goto-char (point-min))
-       (if (search-forward (nnbabyl-article-string article) nil t)
-	   (nnbabyl-delete-mail))
-       (and last (save-buffer))))
-    result))
-
-(deffoo nnbabyl-request-accept-article (group &optional server last)
-  (nnbabyl-possibly-change-newsgroup group server)
-  (nnmail-check-syntax)
-  (let ((buf (current-buffer))
-	result beg)
-    (and 
-     (nnmail-activate 'nnbabyl)
-     (save-excursion
-       (goto-char (point-min))
-       (search-forward "\n\n" nil t)
-       (forward-line -1)
-       (save-excursion
-	 (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
-	   (delete-region (point) (progn (forward-line 1) (point)))))
-       (let ((nnmail-split-methods
-	      (if (stringp group) (list (list group "")) 
-		nnmail-split-methods)))
-	 (setq result (car (nnbabyl-save-mail))))
-       (set-buffer nnbabyl-mbox-buffer)
-       (goto-char (point-max))
-       (search-backward "\n\^_")
-       (goto-char (match-end 0))
-       (insert-buffer-substring buf)
-       (when last
-	 (save-buffer)
-	 (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
-       result))))
-
-(deffoo nnbabyl-request-replace-article (article group buffer)
-  (nnbabyl-possibly-change-newsgroup group)
-  (save-excursion
-    (set-buffer nnbabyl-mbox-buffer)
-    (goto-char (point-min))
-    (if (not (search-forward (nnbabyl-article-string article) nil t))
-	nil
-      (nnbabyl-delete-mail t t)
-      (insert-buffer-substring buffer)
-      (save-buffer)
-      t)))
-
-(deffoo nnbabyl-request-delete-group (group &optional force server)
-  (nnbabyl-possibly-change-newsgroup group server)
-  ;; Delete all articles in GROUP.
-  (if (not force)
-      ()				; Don't delete the articles.
-    (save-excursion
-      (set-buffer nnbabyl-mbox-buffer)
-      (goto-char (point-min))
-      ;; Delete all articles in this group.
-      (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
-	    found)
-	(while (search-forward ident nil t)
-	  (setq found t)
-	  (nnbabyl-delete-mail))
-	(and found (save-buffer)))))
-  ;; Remove the group from all structures.
-  (setq nnbabyl-group-alist 
-	(delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist)
-	nnbabyl-current-group nil)
-  ;; Save the active file.
-  (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
-  t)
-
-(deffoo nnbabyl-request-rename-group (group new-name &optional server)
-  (nnbabyl-possibly-change-newsgroup group server)
-  (save-excursion
-    (set-buffer nnbabyl-mbox-buffer)
-    (goto-char (point-min))
-    (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
-	  (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
-	  found)
-      (while (search-forward ident nil t)
-	(replace-match new-ident t t)
-	(setq found t))
-      (and found (save-buffer))))
-  (let ((entry (assoc group nnbabyl-group-alist)))
-    (and entry (setcar entry new-name))
-    (setq nnbabyl-current-group nil)
-    ;; Save the new group alist.
-    (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
-    t))
-
-
-;;; Internal functions.
-
-;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
-;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
-;; delimiter line.
-(defun nnbabyl-delete-mail (&optional force leave-delim)
-  ;; Delete the current X-Gnus-Newsgroup line.
-  (or force
-      (delete-region
-       (progn (beginning-of-line) (point))
-       (progn (forward-line 1) (point))))
-  ;; Beginning of the article.
-  (save-excursion
-    (save-restriction
-      (widen)
-      (narrow-to-region
-       (save-excursion
-	 (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
-	 (if leave-delim (progn (forward-line 1) (point))
-	   (match-beginning 0)))
-       (progn
-	 (forward-line 1)
-	 (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter) 
-				     nil t)
-		  (if (and (not (bobp)) leave-delim)
-		      (progn (forward-line -2) (point))
-		    (match-beginning 0)))
-	     (point-max))))
-      (goto-char (point-min))
-      ;; Only delete the article if no other groups owns it as well.
-      (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
-	  (delete-region (point-min) (point-max))))))
-
-(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server)
-  (when (and server 
-	     (not (nnbabyl-server-opened server)))
-    (nnbabyl-open-server server))
-  (if (or (not nnbabyl-mbox-buffer)
-	  (not (buffer-name nnbabyl-mbox-buffer)))
-      (save-excursion (nnbabyl-read-mbox)))
-  (or nnbabyl-group-alist
-      (nnmail-activate 'nnbabyl))
-  (if newsgroup
-      (if (assoc newsgroup nnbabyl-group-alist)
-	  (setq nnbabyl-current-group newsgroup)
-	(nnheader-report 'nnbabyl "No such group in file"))
-    t))
-
-(defun nnbabyl-article-string (article)
-  (if (numberp article)
-      (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":" 
-	      (int-to-string article) " ")
-    (concat "\nMessage-ID: " article)))
-
-(defun nnbabyl-article-group-number ()
-  (save-excursion
-    (goto-char (point-min))
-    (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
-			    nil t)
-	 (cons (buffer-substring (match-beginning 1) (match-end 1))
-	       (string-to-int
-		(buffer-substring (match-beginning 2) (match-end 2)))))))
-
-(defun nnbabyl-insert-lines ()
-  "Insert how many lines and chars there are in the body of the mail."
-  (let (lines chars)
-    (save-excursion
-      (goto-char (point-min))
-      (when (search-forward "\n\n" nil t) 
-	;; There may be an EOOH line here...
-	(when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
-	  (search-forward "\n\n" nil t))
-	(setq chars (- (point-max) (point))
-	      lines (max (- (count-lines (point) (point-max)) 1) 0))
-	;; Move back to the end of the headers. 
-	(goto-char (point-min))
-	(search-forward "\n\n" nil t)
-	(forward-char -1)
-	(save-excursion
-	  (when (re-search-backward "^Lines: " nil t)
-	    (delete-region (point) (progn (forward-line 1) (point)))))
-	(insert (format "Lines: %d\n" lines))
-	chars))))
-
-(defun nnbabyl-save-mail ()
-  ;; Called narrowed to an article.
-  (let ((group-art (nreverse (nnmail-article-group 'nnbabyl-active-number))))
-    (nnbabyl-insert-lines)
-    (nnmail-insert-xref group-art)
-    (nnbabyl-insert-newsgroup-line group-art)
-    (run-hooks 'nnbabyl-prepare-save-mail-hook)
-    group-art))
-
-(defun nnbabyl-insert-newsgroup-line (group-art)
-  (save-excursion
-    (goto-char (point-min))
-    (while (looking-at "From ")
-      (replace-match "Mail-from: From " t t)
-      (forward-line 1))
-    ;; If there is a C-l at the beginning of the narrowed region, this
-    ;; isn't really a "save", but rather a "scan".
-    (goto-char (point-min))
-    (or (looking-at "\^L")
-	(save-excursion
-	  (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
-	  (goto-char (point-max))
-	  (insert "\^_\n")))
-    (if (search-forward "\n\n" nil t)
-	(progn
-	  (forward-char -1)
-	  (while group-art
-	    (insert (format "X-Gnus-Newsgroup: %s:%d   %s\n" 
-			    (caar group-art) (cdar group-art)
-			    (current-time-string)))
-	    (setq group-art (cdr group-art)))))
-    t))
-
-(defun nnbabyl-active-number (group)
-  ;; Find the next article number in GROUP.
-  (let ((active (cadr (assoc group nnbabyl-group-alist))))
-    (if active
-	(setcdr active (1+ (cdr active)))
-      ;; This group is new, so we create a new entry for it.
-      ;; This might be a bit naughty... creating groups on the drop of
-      ;; a hat, but I don't know...
-      (setq nnbabyl-group-alist (cons (list group (setq active (cons 1 1)))
-				      nnbabyl-group-alist)))
-    (cdr active)))
-
-(defun nnbabyl-read-mbox ()
-  (nnmail-activate 'nnbabyl)
-  (unless (file-exists-p nnbabyl-mbox-file)
-    ;; Create a new, empty RMAIL mbox file.
-    (save-excursion
-      (set-buffer (setq nnbabyl-mbox-buffer
-			(create-file-buffer nnbabyl-mbox-file)))
-      (setq buffer-file-name nnbabyl-mbox-file)
-      (insert "BABYL OPTIONS:\n\n\^_")
-      (write-region (point-min) (point-max) nnbabyl-mbox-file t 'nomesg)))
-
-  (if (and nnbabyl-mbox-buffer
-	   (buffer-name nnbabyl-mbox-buffer)
-	   (save-excursion
-	     (set-buffer nnbabyl-mbox-buffer)
-	     (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
-      () ; This buffer hasn't changed since we read it last.  Possibly.
-    (save-excursion
-      (let ((delim (concat "^" nnbabyl-mail-delimiter))
-	    (alist nnbabyl-group-alist)
-	    start end number)
-	(set-buffer (setq nnbabyl-mbox-buffer 
-			  (nnheader-find-file-noselect 
-			   nnbabyl-mbox-file nil 'raw)))
-	;; Save previous buffer mode.
-	(setq nnbabyl-previous-buffer-mode 
-	      (cons (cons (point-min) (point-max))
-		    major-mode))
-
-	(buffer-disable-undo (current-buffer))
-	(widen)
-	(setq buffer-read-only nil)
-	(fundamental-mode)
-
-	;; Go through the group alist and compare against
-	;; the rmail file.
-	(while alist
-	  (goto-char (point-max))
-	  (when (and (re-search-backward
-		      (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
-			      (caar alist)) nil t)
-		     (> (setq number
-			      (string-to-number 
-			       (buffer-substring
-				(match-beginning 1) (match-end 1))))
-			(cdadar alist)))
-	    (setcdr (cadar alist) (1+ number)))
-	  (setq alist (cdr alist)))
-	
-	;; We go through the mbox and make sure that each and 
-	;; every mail belongs to some group or other.
-	(goto-char (point-min))
-	(re-search-forward delim nil t)
-	(setq start (match-end 0))
-	(while (re-search-forward delim nil t)
-	  (setq end (match-end 0))
-	  (unless (search-backward "\nX-Gnus-Newsgroup: " start t)
-	    (goto-char end)
-	    (save-excursion
-	      (save-restriction
-		(narrow-to-region (goto-char start) end)
-		(nnbabyl-save-mail)
-		(setq end (point-max)))))
-	  (goto-char (setq start end)))
-	(when (buffer-modified-p (current-buffer))
-	  (save-buffer))
-	(nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))
-
-(defun nnbabyl-remove-incoming-delims ()
-  (goto-char (point-min))
-  (while (search-forward "\^_" nil t)
-    (replace-match "?" t t)))
-
-(defun nnbabyl-check-mbox ()
-  "Go through the nnbabyl mbox and make sure that no article numbers are reused."
-  (interactive)
-  (let ((idents (make-vector 1000 0))
-	id)
-    (save-excursion
-      (when (or (not nnbabyl-mbox-buffer)
-		(not (buffer-name nnbabyl-mbox-buffer)))
-	(nnbabyl-read-mbox))
-      (set-buffer nnbabyl-mbox-buffer)
-      (goto-char (point-min))
-      (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) "  nil t)
-	(if (intern-soft (setq id (match-string 1)) idents)
-	    (progn
-	      (delete-region (progn (beginning-of-line) (point))
-			     (progn (forward-line 1) (point)))
-	      (nnheader-message 7 "Moving %s..." id)
-	      (nnbabyl-save-mail))
-	  (intern id idents)))
-      (when (buffer-modified-p (current-buffer))
-	(save-buffer))
-      (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
-      (message ""))))
-
-(provide 'nnbabyl)
-
-;;; nnbabyl.el ends here
diff --git a/lisp/nndb.el b/lisp/nndb.el
deleted file mode 100644
index 15d82ec4f1c..00000000000
--- a/lisp/nndb.el
+++ /dev/null
@@ -1,229 +0,0 @@
-;;; nndb.el --- nndb access for Gnus
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
-;; Keywords: news
-
-;; 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:
-
-;; I have shamelessly snarfed the code of nntp.el from sgnus.
-;;              Kai
-
-
-;;-
-;; Register nndb with known select methods.
-
-(setq gnus-valid-select-methods
-      (cons '("nndb" mail address respool prompt-address)
-            gnus-valid-select-methods))
-
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nntp)
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
-  (unless (fboundp 'open-network-stream)
-    (require 'tcp)))
-
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
-  (autoload 'news-setup "rnewspost")
-  (autoload 'news-reply-mode "rnewspost")
-  (autoload 'cancel-timer "timer")
-  (autoload 'telnet "telnet" nil t)
-  (autoload 'telnet-send-input "telnet" nil t)
-  (autoload 'timezone-parse-date "timezone"))
-
-;; Declare nndb as derived from nntp
-
-(nnoo-declare nndb nntp)
-
-;; Variables specific to nndb
-
-;;- currently not used but just in case...
-(defvoo nndb-deliver-program "nndel"
-  "*The program used to put a message in an NNDB group.")
-
-;; Variables copied from nntp
-
-(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
-  "Like nntp-server-opened-hook."
-  nntp-server-opened-hook)
-
-;(defvoo nndb-rlogin-parameters '("telnet" "${NNDBSERVER:=localhost}" "9000")
-;  "*Parameters to nndb-open-login.  Like nntp-rlogin-parameters."
-;  nntp-rlogin-parameters)
-
-;(defvoo nndb-rlogin-user-name nil
-;  "*User name for rlogin connect method."
-;  nntp-rlogin-user-name)
-
-(defvoo nndb-address "localhost"
-  "*The name of the NNDB server."
-  nntp-address)
-
-(defvoo nndb-port-number 9000
-  "*Port number to connect to."
-  nntp-port-number)
-
-;(defvoo nndb-current-group ""
-;  "Like nntp-current-group."
-;  nntp-current-group)
-
-(defvoo nndb-status-string nil "" nntp-status-string)
-
-
-
-(defconst nndb-version "nndb 0.3"
-  "Version numbers of this version of NNDB.")
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nndb)
-
-;; Import other stuff from nntp as is.
-
-(nnoo-import nndb
-  (nntp))
-
-;;- maybe this should be mail??
-;;-(defun nndb-request-type (group &optional article)
-;;-  'news)
-
-;;------------------------------------------------------------------
-;;- only new stuff below
-
-; nndb-request-update-info does not exist and is not needed
-
-; nndb-request-update-mark does not exist and is not needed
-
-; nndb-request-scan does not exist
-; get new mail from somewhere -- maybe this is not needed?
-; --> todo
-
-(deffoo nndb-request-create-group (group &optional server)
-  "Creates a group if it doesn't exist yet."
-  (nntp-send-command "^[23].*\n" "MKGROUP" group))
-
-; todo -- use some other time than the creation time of the article
-; best is time since article has been marked as expirable
-(deffoo nndb-request-expire-articles
-  (articles &optional group server force)
-  "Expires ARTICLES from GROUP on SERVER.
-If FORCE, delete regardless of exiration date, otherwise use normal
-expiry mechanism."
-  (let (msg art)
-    (nntp-possibly-change-server group server) ;;-
-    (while articles
-      (setq art (pop articles))
-      (nntp-send-command "^\\([23]\\|^423\\).*\n" "DATE" art)
-      (setq msg (nndb-status-message))
-      ;; CCC we shouldn't be using the variable nndb-status-string?
-      (if (string-match "^423" (nnheader-get-report 'nndb))
-          ()
-        (or (string-match "\\([0-9]+\\) \\([0-9]+\\)$" msg)
-            (error "Not a valid response for DATE command: %s"
-                   msg))
-        (if (nnmail-expired-article-p
-             group
-             (list (string-to-int
-                    (substring msg (match-beginning 1) (match-end 1)))
-                   (string-to-int
-                    (substring msg (match-beginning 2) (match-end 2))))
-             force)
-            (nnheader-message 5 "Deleting article %s in %s..."
-                              art group)
-          (nntp-send-command "^[23].*\n" "DELETE" art))))))
-
-(deffoo nndb-request-move-article
-  (article group server accept-form &optional last)
-  "Move ARTICLE (a number) from GROUP on SERVER.
-Evals ACCEPT-FORM in current buffer, where the article is.
-Optional LAST is ignored."
-  (let ((artbuf (get-buffer-create " *nndb move*"))
-	result)
-    (and
-     (nndb-request-article article group server artbuf)
-     (save-excursion
-       (set-buffer artbuf)
-       (setq result (eval accept-form))
-       (kill-buffer (current-buffer))
-       result)
-     (nndb-request-expire-articles (list article)
-                                   group
-                                   server
-                                   t))
-    result))
-  
-(deffoo nndb-request-accept-article (group server &optional last)
-  "The article in the current buffer is put into GROUP."
-  (nntp-possibly-change-server group server) ;;-
-  (let (art statmsg)
-    (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
-      (nnheader-insert "")
-      (nntp-encode-text)
-      (nntp-send-region-to-server (point-min) (point-max))
-      ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
-      ;;  appended to end of the status message.
-      (nntp-wait-for-response "^[23].*\n")
-      (setq statmsg (nntp-status-message))
-      (or (string-match "^\\([0-9]+\\)" statmsg)
-          (error "nndb: %s" statmsg))
-      (setq art (substring statmsg
-                           (match-beginning 1)
-                           (match-end 1)))
-      (message "nndb: accepted %s" art)
-      (list art))))
-
-(deffoo nndb-request-replace-article (article group buffer)
-  "ARTICLE is the number of the article in GROUP to be replaced 
-with the contents of the BUFFER."
-  (set-buffer buffer)
-  (let (art statmsg)
-    (when (nntp-send-command "^[23].*\r?\n" "REPLACE" (int-to-string article))
-      (nnheader-insert "")
-      (nntp-encode-text)
-      (nntp-send-region-to-server (point-min) (point-max))
-      ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
-      ;;  appended to end of the status message.
-      (nntp-wait-for-response "^[23].*\n")
-;      (setq statmsg (nntp-status-message))
-;      (or (string-match "^\\([0-9]+\\)" statmsg)
-;          (error "nndb: %s" statmsg))
-;      (setq art (substring statmsg
-;                           (match-beginning 1)
-;                           (match-end 1)))
-;      (message "nndb: replaced %s" art)
-      (list (int-to-string article)))))
-
-; nndb-request-delete-group does not exist
-; todo -- maybe later
-
-; nndb-request-rename-group does not exist
-; todo -- maybe later
-
-(provide 'nndb)
-
-
diff --git a/lisp/nndir.el b/lisp/nndir.el
deleted file mode 100644
index dd7fa8ade8b..00000000000
--- a/lisp/nndir.el
+++ /dev/null
@@ -1,99 +0,0 @@
-;;; nndir.el --- single directory newsgroup access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'nnheader)
-(require 'nnmh)
-(require 'nnml)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nndir
-  nnml nnmh)
-
-(defvoo nndir-directory nil
-  "Where nndir will look for groups."
-  nnml-current-directory nnmh-current-directory)
-
-(defvoo nndir-nov-is-evil nil
-  "*Non-nil means that nndir will never retrieve NOV headers."
-  nnml-nov-is-evil)
-
-
-
-(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group)
-(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory)
-(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail)
-
-(defvoo nndir-status-string "" nil nnmh-status-string)
-(defconst nndir-version "nndir 1.0")
-
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nndir)
-
-(deffoo nndir-open-server (server &optional defs)
-  (setq nndir-directory
-	(or (cadr (assq 'nndir-directory defs))
-	    server))
-  (unless (assq 'nndir-directory defs)
-    (push `(nndir-directory ,server) defs))
-  (push `(nndir-current-group
-	  ,(file-name-nondirectory (directory-file-name nndir-directory)))
-	defs)
-  (push `(nndir-top-directory
-	  ,(file-name-directory (directory-file-name nndir-directory)))
-	defs)
-  (nnoo-change-server 'nndir server defs)
-  (let (err)
-    (cond 
-     ((not (condition-case arg
-	       (file-exists-p nndir-directory)
-	     (ftp-error (setq err (format "%s" arg)))))
-      (nndir-close-server)
-      (nnheader-report 
-       'nndir (or err "No such file or directory: %s" nndir-directory)))
-     ((not (file-directory-p (file-truename nndir-directory)))
-      (nndir-close-server)
-      (nnheader-report 'nndir "Not a directory: %s" nndir-directory))
-     (t
-      (nnheader-report 'nndir "Opened server %s using directory %s"
-		       server nndir-directory)
-      t))))
-
-(nnoo-map-functions nndir
-  (nnml-retrieve-headers 0 nndir-current-group 0 0)
-  (nnmh-request-article 0 nndir-current-group 0 0)
-  (nnmh-request-group nndir-current-group 0 0)
-  (nnmh-close-group nndir-current-group 0)
-  (nnmh-request-list (nnoo-current-server 'nndir) nndir-directory)
-  (nnmh-request-newsgroups (nnoo-current-server 'nndir) nndir-directory))
-
-(provide 'nndir)
-
-;;; nndir.el ends here
diff --git a/lisp/nndoc.el b/lisp/nndoc.el
deleted file mode 100644
index 72791d0c533..00000000000
--- a/lisp/nndoc.el
+++ /dev/null
@@ -1,482 +0,0 @@
-;;; nndoc.el --- single file access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news
-
-;; 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:
-
-(require 'nnheader)
-(require 'message)
-(require 'nnmail)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nndoc)
-
-(defvoo nndoc-article-type 'guess
-  "*Type of the file.
-One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
-`mime-digest', `standard-digest', `slack-digest', `clari-briefs' or
-`guess'.")
-
-(defvoo nndoc-post-type 'mail
-  "*Whether the nndoc group is `mail' or `post'.")
-
-(defvar nndoc-type-alist 
-  `((mmdf 
-     (article-begin .  "^\^A\^A\^A\^A\n")
-     (body-end .  "^\^A\^A\^A\^A\n"))
-    (news
-     (article-begin . "^Path:"))
-    (rnews
-     (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
-     (body-end-function . nndoc-rnews-body-end))
-    (mbox 
-     (article-begin . "^From \\([^ \n]*\\(\\|\".*\"[^ \n]*\\)\\)  ?\\([^ \n]*\\) *\\([^ ]*\\) *\\([0-9]*\\) *\\([0-9:]*\\) *\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?\\|[-+]?[0-9][0-9][0-9][0-9]\\|\\) * [0-9][0-9]\\([0-9]*\\) *\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?\\|[-+]?[0-9][0-9][0-9][0-9]\\|\\) *\\(remote from .*\\)?\n")
-     (article-begin-function . nndoc-mbox-article-begin)
-     (body-end-function . nndoc-mbox-body-end))
-    (babyl 
-     (article-begin . "\^_\^L *\n")
-     (body-end . "\^_")
-     (body-begin-function . nndoc-babyl-body-begin)
-     (head-begin-function . nndoc-babyl-head-begin))
-    (forward
-     (article-begin . "^-+ Start of forwarded message -+\n+")
-     (body-end . "^-+ End of forwarded message -+$")
-     (prepare-body . nndoc-unquote-dashes))
-    (clari-briefs
-     (article-begin . "^ \\*")
-     (body-end . "^\t------*[ \t]^*\n^ \\*")
-     (body-begin . "^\t")
-     (head-end . "^\t")
-     (generate-head . nndoc-generate-clari-briefs-head)
-     (article-transform . nndoc-transform-clari-briefs))
-    (slack-digest
-     (article-begin . "^------------------------------*[\n \t]+")
-     (head-end . "^ ?$")
-     (body-end-function . nndoc-digest-body-end)
-     (body-begin . "^ ?$")
-     (file-end . "^End of")
-     (prepare-body . nndoc-unquote-dashes))
-    (mime-digest
-     (article-begin . "")
-     (head-end . "^ ?$")
-     (body-end . "")
-     (file-end . ""))
-    (standard-digest
-     (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+"))
-     (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+"))
-     (prepare-body . nndoc-unquote-dashes)
-     (body-end-function . nndoc-digest-body-end)
-     (head-end . "^ ?$")
-     (body-begin . "^ ?\n")
-     (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$"))
-    (guess 
-     (guess . nndoc-guess-type))
-    (digest
-     (guess . nndoc-guess-digest-type))
-    ))
-
-
-
-(defvoo nndoc-file-begin nil)
-(defvoo nndoc-first-article nil)
-(defvoo nndoc-article-end nil)
-(defvoo nndoc-article-begin nil)
-(defvoo nndoc-article-begin-function nil)
-(defvoo nndoc-head-begin nil)
-(defvoo nndoc-head-end nil)
-(defvoo nndoc-file-end nil)
-(defvoo nndoc-body-begin nil)
-(defvoo nndoc-body-end-function nil)
-(defvoo nndoc-body-begin-function nil)
-(defvoo nndoc-head-begin-function nil)
-(defvoo nndoc-body-end nil)
-(defvoo nndoc-dissection-alist nil)
-(defvoo nndoc-prepare-body nil)
-(defvoo nndoc-generate-head nil)
-(defvoo nndoc-article-transform nil)
-
-(defvoo nndoc-status-string "")
-(defvoo nndoc-group-alist nil)
-(defvoo nndoc-current-buffer nil
-  "Current nndoc news buffer.")
-(defvoo nndoc-address nil)
-
-(defconst nndoc-version "nndoc 1.0"
-  "nndoc version.")
-
-
-
-;;; Interface functions
-
-(nnoo-define-basics nndoc)
-
-(deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
-  (when (nndoc-possibly-change-buffer newsgroup server)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (erase-buffer)
-      (let (article entry)
-	(if (stringp (car articles))
-	    'headers
-	  (while articles
-	    (when (setq entry (cdr (assq (setq article (pop articles))
-					 nndoc-dissection-alist)))
-	      (insert (format "221 %d Article retrieved.\n" article))
-	      (if nndoc-generate-head
-		  (funcall nndoc-generate-head article)
-		(insert-buffer-substring
-		 nndoc-current-buffer (car entry) (nth 1 entry)))
-	      (goto-char (point-max))
-	      (or (= (char-after (1- (point))) ?\n) (insert "\n"))
-	      (insert (format "Lines: %d\n" (nth 4 entry)))
-	      (insert ".\n")))
-
-	  (nnheader-fold-continuation-lines)
-	  'headers)))))
-
-(deffoo nndoc-request-article (article &optional newsgroup server buffer)
-  (nndoc-possibly-change-buffer newsgroup server)
-  (save-excursion
-    (let ((buffer (or buffer nntp-server-buffer))
-	  (entry (cdr (assq article nndoc-dissection-alist)))
-	  beg)
-      (set-buffer buffer)
-      (erase-buffer)
-      (if (stringp article)
-	  nil
-	(insert-buffer-substring 
-	 nndoc-current-buffer (car entry) (nth 1 entry))
-	(insert "\n")
-	(setq beg (point))
-	(insert-buffer-substring 
-	 nndoc-current-buffer (nth 2 entry) (nth 3 entry))
-	(goto-char beg)
-	(when nndoc-prepare-body
-	  (funcall nndoc-prepare-body))
-	(when nndoc-article-transform
-	  (funcall nndoc-article-transform article))
-	t))))
-
-(deffoo nndoc-request-group (group &optional server dont-check)
-  "Select news GROUP."
-  (let (number)
-    (cond 
-     ((not (nndoc-possibly-change-buffer group server))
-      (nnheader-report 'nndoc "No such file or buffer: %s"
-		       nndoc-address))
-     (dont-check
-      (nnheader-report 'nndoc "Selected group %s" group)
-      t)
-     ((zerop (setq number (length nndoc-dissection-alist)))
-      (nndoc-close-group group)
-      (nnheader-report 'nndoc "No articles in group %s" group))
-     (t
-      (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
-
-(deffoo nndoc-request-type (group &optional article)
-  (cond ((not article) 'unknown)
-        (nndoc-post-type nndoc-post-type)
-        (t 'unknown)))
-
-(deffoo nndoc-close-group (group &optional server)
-  (nndoc-possibly-change-buffer group server)
-  (and nndoc-current-buffer
-       (buffer-name nndoc-current-buffer)
-       (kill-buffer nndoc-current-buffer))
-  (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
-				nndoc-group-alist))
-  (setq nndoc-current-buffer nil)
-  (nnoo-close-server 'nndoc server)
-  (setq nndoc-dissection-alist nil)
-  t)
-
-(deffoo nndoc-request-list (&optional server)
-  nil)
-
-(deffoo nndoc-request-newgroups (date &optional server)
-  nil)
-
-(deffoo nndoc-request-list-newsgroups (&optional server)
-  nil)
-
-
-;;; Internal functions.
-
-(defun nndoc-possibly-change-buffer (group source)
-  (let (buf)
-    (cond 
-     ;; The current buffer is this group's buffer.
-     ((and nndoc-current-buffer
-	   (buffer-name nndoc-current-buffer)
-	   (eq nndoc-current-buffer 
-	       (setq buf (cdr (assoc group nndoc-group-alist))))))
-     ;; We change buffers by taking an old from the group alist.
-     ;; `source' is either a string (a file name) or a buffer object. 
-     (buf
-      (setq nndoc-current-buffer buf))
-     ;; It's a totally new group.    
-     ((or (and (bufferp nndoc-address)
-	       (buffer-name nndoc-address))
-	  (and (stringp nndoc-address)
-	       (file-exists-p nndoc-address)
-	       (not (file-directory-p nndoc-address))))
-      (push (cons group (setq nndoc-current-buffer 
-			      (get-buffer-create 
-			       (concat " *nndoc " group "*"))))
-	    nndoc-group-alist)
-      (setq nndoc-dissection-alist nil)
-      (save-excursion
-	(set-buffer nndoc-current-buffer)
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)
-	(if (stringp nndoc-address)
-	    (insert-file-contents nndoc-address)
-	  (insert-buffer-substring nndoc-address)))))
-    ;; Initialize the nndoc structures according to this new document.
-    (when (and nndoc-current-buffer
-	       (not nndoc-dissection-alist))
-      (save-excursion
-	(set-buffer nndoc-current-buffer)
-	(nndoc-set-delims)
-	(nndoc-dissect-buffer)))
-    (unless nndoc-current-buffer
-      (nndoc-close-server))
-    ;; Return whether we managed to select a file.
-    nndoc-current-buffer))
-
-;; MIME (RFC 1341) digest hack by Ulrik Dickow <dickow@nbi.dk>.
-(defun nndoc-guess-digest-type ()
-  "Guess what digest type the current document is."
-  (let ((case-fold-search t)		; We match a bit too much, keep it simple.
-	boundary-id b-delimiter entry)
-    (goto-char (point-min))
-    (cond 
-     ;; MIME digest.
-     ((and
-       (re-search-forward
-	(concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
-		"boundary=\"\\([^\"\n]*[^\" \t\n]\\)\"")
-	nil t)
-       (match-beginning 1))
-      (setq boundary-id (match-string 1)
-	    b-delimiter (concat "\n--" boundary-id "[\n \t]+"))
-      (setq entry (assq 'mime-digest nndoc-type-alist))
-      (setcdr entry
-	      (list
-	       (cons 'head-end "^ ?$")
-	       (cons 'body-begin "^ ?\n")
-	       (cons 'article-begin b-delimiter)
-	       (cons 'body-end-function 'nndoc-digest-body-end)
-;	       (cons 'body-end 
-;		     (concat "\n--" boundary-id "\\(--\\)?[\n \t]+"))
-	       (cons 'file-end (concat "\n--" boundary-id "--[ \t]*$"))))
-      'mime-digest)
-     ;; Standard digest.
-     ((and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
-	   (re-search-forward 
-	    (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
-      'standard-digest)
-     ;; Stupid digest.
-     (t
-      'slack-digest))))
-
-(defun nndoc-guess-type ()
-  "Guess what document type is in the current buffer."
-  (goto-char (point-min))
-  (cond 
-   ((looking-at message-unix-mail-delimiter)
-    'mbox)
-   ((looking-at "\^A\^A\^A\^A$")
-    'mmdf)
-   ((looking-at "^Path:.*\n")
-    'news)
-   ((looking-at "#! *rnews")
-    'rnews)
-   ((re-search-forward "\^_\^L *\n" nil t)
-    'babyl)
-   ((save-excursion
-      (and (re-search-forward "^-+ Start of forwarded message -+\n+" nil t)
-	   (not (re-search-forward "^Subject:.*digest" nil t))))
-    'forward)
-   ((let ((case-fold-search nil))
-      (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
-    'clari-briefs)
-   (t 
-    'digest)))
-
-(defun nndoc-set-delims ()
-  "Set the nndoc delimiter variables according to the type of the document."
-  (let ((vars '(nndoc-file-begin 
-		nndoc-first-article 
-		nndoc-article-end nndoc-head-begin nndoc-head-end
-		nndoc-file-end nndoc-article-begin
-		nndoc-body-begin nndoc-body-end-function nndoc-body-end
-		nndoc-prepare-body nndoc-article-transform
-		nndoc-generate-head nndoc-body-begin-function
-		nndoc-head-begin-function nndoc-article-begin-function)))
-    (while vars
-      (set (pop vars) nil)))
-  (let* (defs guess)
-    ;; Guess away until we find the real file type.
-    (while (setq defs (cdr (assq nndoc-article-type nndoc-type-alist))
-		 guess (assq 'guess defs))
-      (setq nndoc-article-type (funcall (cdr guess))))
-    ;; Set the nndoc variables.
-    (while defs
-      (set (intern (format "nndoc-%s" (caar defs)))
-	   (cdr (pop defs))))))
-
-(defun nndoc-search (regexp)
-  (prog1
-      (re-search-forward regexp nil t)
-    (beginning-of-line)))
-
-(defun nndoc-dissect-buffer ()
-  "Go through the document and partition it into heads/bodies/articles."
-  (let ((i 0)
-	(first t)
-	head-begin head-end body-begin body-end)
-    (setq nndoc-dissection-alist nil)
-    (save-excursion
-      (set-buffer nndoc-current-buffer)
-      (goto-char (point-min))
-      ;; Find the beginning of the file.
-      (when nndoc-file-begin
-	(nndoc-search nndoc-file-begin))
-      ;; Go through the file.
-      (while (if (and first nndoc-first-article)
-		 (nndoc-search nndoc-first-article)
-	       (if nndoc-article-begin-function
-		   (funcall nndoc-article-begin-function)
-		 (nndoc-search nndoc-article-begin)))
-	(setq first nil)
-	(cond (nndoc-head-begin-function
-	       (funcall nndoc-head-begin-function))
-	      (nndoc-head-begin 
-	       (nndoc-search nndoc-head-begin)))
- 	(if (and nndoc-file-end
-		 (looking-at nndoc-file-end))
-	    (goto-char (point-max))
-	  (setq head-begin (point))
-	  (nndoc-search (or nndoc-head-end "^$"))
-	  (setq head-end (point))
-	  (if nndoc-body-begin-function
-	      (funcall nndoc-body-begin-function)
-	    (nndoc-search (or nndoc-body-begin "^\n")))
-	  (setq body-begin (point))
-	  (or (and nndoc-body-end-function
-		   (funcall nndoc-body-end-function))
-	      (and nndoc-body-end
-		   (nndoc-search nndoc-body-end))
-	      (if nndoc-article-begin-function
-		  (funcall nndoc-article-begin-function)
-		(nndoc-search nndoc-article-begin))
-	      (progn
-		(goto-char (point-max))
-		(when nndoc-file-end
-		  (and (re-search-backward nndoc-file-end nil t)
-		       (beginning-of-line)))))
-	  (setq body-end (point))
-	  (push (list (incf i) head-begin head-end body-begin body-end
-		      (count-lines body-begin body-end))
-		nndoc-dissection-alist))))))
-
-(defun nndoc-unquote-dashes ()
-  "Unquote quoted non-separators in digests."
-  (while (re-search-forward "^- -"nil t)
-    (replace-match "-" t t)))
-
-(defun nndoc-digest-body-end ()
-  (and (re-search-forward nndoc-article-begin nil t)
-       (goto-char (match-beginning 0))))
-
-(defun nndoc-mbox-article-begin ()
-  (when (re-search-forward nndoc-article-begin nil t)
-    (goto-char (match-beginning 0))))
-
-(defun nndoc-mbox-body-end ()
-  (let ((beg (point))
-	len end)
-    (when
-	(save-excursion
-	  (and (re-search-backward nndoc-article-begin nil t)
-	       (setq end (point))
-	       (search-forward "\n\n" beg t)
-	       (re-search-backward
-		"^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
-	       (setq len (string-to-int (match-string 1)))
-	       (search-forward "\n\n" beg t)
-	       (or (= (setq len (+ (point) len)) (point-max))
-		   (and (< len (point-max))
-			(goto-char len)
-			(looking-at nndoc-article-begin)))))
-      (goto-char len))))
-
-(defun nndoc-rnews-body-end ()
-  (and (re-search-backward nndoc-article-begin nil t)
-       (forward-line 1)
-       (goto-char (+ (point) (string-to-int (match-string 1))))))
-
-(defun nndoc-transform-clari-briefs (article)
-  (goto-char (point-min))
-  (when (looking-at " *\\*\\(.*\\)\n")
-    (replace-match "" t t))
-  (nndoc-generate-clari-briefs-head article))
-
-(defun nndoc-generate-clari-briefs-head (article)
-  (let ((entry (cdr (assq article nndoc-dissection-alist)))
-	subject from)
-    (save-excursion
-      (set-buffer nndoc-current-buffer)
-      (save-restriction
-	(narrow-to-region (car entry) (nth 3 entry))
-	(goto-char (point-min))
-	(when (looking-at " *\\*\\(.*\\)$")
-	  (setq subject (match-string 1))
-	  (when (string-match "[ \t]+$" subject)
-	    (setq subject (substring subject 0 (match-beginning 0)))))
-	(when
-	    (let ((case-fold-search nil))
-	      (re-search-forward
-	       "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t))
-	  (setq from (match-string 1)))))
-    (insert "From: " "clari@clari.net (" (or from "unknown") ")"
-	    "\nSubject: " (or subject "(no subject)") "\n")))
-
-(defun nndoc-babyl-body-begin ()
-  (re-search-forward "^\n" nil t)
-  (when (looking-at "\*\*\* EOOH \*\*\*")
-    (re-search-forward "^\n" nil t)))
-
-(defun nndoc-babyl-head-begin ()
-  (when (re-search-forward "^[0-9].*\n" nil t)
-    (when (looking-at "\*\*\* EOOH \*\*\*")
-      (forward-line 1))
-    t))
-
-(provide 'nndoc)
-
-;;; nndoc.el ends here
diff --git a/lisp/nneething.el b/lisp/nneething.el
deleted file mode 100644
index bcf013fdf8b..00000000000
--- a/lisp/nneething.el
+++ /dev/null
@@ -1,356 +0,0 @@
-;;; nneething.el --- random file access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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:
-
-;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.  
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnmail)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nneething)
-
-(defvoo nneething-map-file-directory "~/.nneething/"
-  "*Where nneething stores the map files.")
-
-(defvoo nneething-map-file ".nneething"
-  "*Name of the map files.")
-
-(defvoo nneething-exclude-files nil
-  "*Regexp saying what files to exclude from the group.
-If this variable is nil, no files will be excluded.")
-
-
-
-;;; Internal variables. 
-
-(defconst nneething-version "nneething 1.0"
-  "nneething version.")
-
-(defvoo nneething-current-directory nil
-  "Current news group directory.")
-
-(defvoo nneething-status-string "")
-(defvoo nneething-group-alist nil)
-
-(defvoo nneething-message-id-number 0)
-(defvoo nneething-work-buffer " *nneething work*")
-
-(defvoo nneething-directory nil)
-(defvoo nneething-group nil)
-(defvoo nneething-map nil)
-(defvoo nneething-read-only nil)
-(defvoo nneething-active nil)
-
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nneething)
-
-(deffoo nneething-retrieve-headers (articles &optional group server fetch-old)
-  (nneething-possibly-change-directory group)
-
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (let* ((number (length articles))
-	   (count 0)
-	   (large (and (numberp nnmail-large-newsgroup)
-		       (> number nnmail-large-newsgroup)))
-	   article file)
-
-      (if (stringp (car articles))
-	  'headers
-
-	(while (setq article (pop articles))
-	  (setq file (nneething-file-name article))
-
-	  (when (and (file-exists-p file)
-		     (or (file-directory-p file)
-			 (not (zerop (nnheader-file-size file)))))
-	    (insert (format "221 %d Article retrieved.\n" article))
-	    (nneething-insert-head file)
-	    (insert ".\n"))
-
-	  (incf count)
-
-	  (and large
-	       (zerop (% count 20))
-	       (message "nneething: Receiving headers... %d%%"
-			(/ (* count 100) number))))
-
-	(when large
-	  (message "nneething: Receiving headers...done"))
-
-	(nnheader-fold-continuation-lines)
-	'headers))))
-
-(deffoo nneething-request-article (id &optional group server buffer)
-  (nneething-possibly-change-directory group)
-  (let ((file (unless (stringp id) (nneething-file-name id)))
-	(nntp-server-buffer (or buffer nntp-server-buffer)))
-    (and (stringp file)			; We did not request by Message-ID.
-	 (file-exists-p file)		; The file exists.
-	 (not (file-directory-p file))	; It's not a dir.
-	 (save-excursion
-	   (nnmail-find-file file)	; Insert the file in the nntp buf.
-	   (or (nnheader-article-p)	; Either it's a real article...
-	       (progn
-		 (goto-char (point-min))
-		 (nneething-make-head file (current-buffer)) ; ... or we fake some headers.
-		 (insert "\n")))
-	   t))))
-
-(deffoo nneething-request-group (group &optional dir dont-check)
-  (nneething-possibly-change-directory group dir)
-  (unless dont-check
-    (nneething-create-mapping)
-    (if (> (car nneething-active) (cdr nneething-active))
-	(nnheader-insert "211 0 1 0 %s\n" group)
-      (nnheader-insert
-       "211 %d %d %d %s\n" 
-       (- (1+ (cdr nneething-active)) (car nneething-active))
-       (car nneething-active) (cdr nneething-active)
-       group)))
-  t)
-
-(deffoo nneething-request-list (&optional server dir)
-  (nnheader-report 'nneething "LIST is not implemented."))
-
-(deffoo nneething-request-newgroups (date &optional server)
-  (nnheader-report 'nneething "NEWSGROUPS is not implemented."))
-
-(deffoo nneething-request-type (group &optional article)
-  'unknown)
-
-(deffoo nneething-close-group (group &optional server)
-  (setq nneething-current-directory nil)
-  t)
-
-
-;;; Internal functions.
-
-(defun nneething-possibly-change-directory (group &optional dir)
-  (when group
-    (if (and nneething-group
-	     (string= group nneething-group))
-	t
-      (let (entry)
-	(if (setq entry (assoc group nneething-group-alist))
-	    (progn
-	      (setq nneething-group group)
-	      (setq nneething-directory (nth 1 entry))
-	      (setq nneething-map (nth 2 entry))
-	      (setq nneething-active (nth 3 entry)))
-	  (setq nneething-group group)
-	  (setq nneething-directory dir)
-	  (setq nneething-map nil)
-	  (setq nneething-active (cons 1 0))
-	  (nneething-create-mapping)
-	  (push (list group dir nneething-map nneething-active)
-		nneething-group-alist))))))
-
-(defun nneething-map-file ()
-  ;; We make sure that the .nneething directory exists. 
-  (unless (file-exists-p nneething-map-file-directory)
-    (make-directory nneething-map-file-directory 'parents))
-  ;; We store it in a special directory under the user's home dir.
-  (concat (file-name-as-directory nneething-map-file-directory)
-	  nneething-group nneething-map-file))
-
-(defun nneething-create-mapping ()
-  ;; Read nneething-active and nneething-map.
-  (let ((map-file (nneething-map-file))
-	(files (directory-files nneething-directory))
-	touched map-files)
-    (if (file-exists-p map-file)
-	(condition-case nil
-	    (load map-file nil t t)
-	  (error nil)))
-    (or nneething-active (setq nneething-active (cons 1 0)))
-    ;; Old nneething had a different map format.
-    (when (and (cdar nneething-map)
-	       (atom (cdar nneething-map)))
-      (setq nneething-map
-	    (mapcar (lambda (n)
-		      (list (cdr n) (car n) 
-			    (nth 5 (file-attributes 
-				    (nneething-file-name (car n))))))
-		    nneething-map)))
-    ;; Remove files matching the exclusion regexp.
-    (when nneething-exclude-files
-      (let ((f files)
-	    prev)
-	(while f
-	  (if (string-match nneething-exclude-files (car f))
-	      (if prev (setcdr prev (cdr f))
-		(setq files (cdr files)))
-	    (setq prev f))
-	  (setq f (cdr f)))))
-    ;; Remove deleted files from the map.
-    (let ((map nneething-map)
-	  prev)
-      (while map
-	(if (and (member (cadar map) files)
-		 ;; We also remove files that have changed mod times.
-		 (equal (nth 5 (file-attributes
-				(nneething-file-name (cadar map))))
-			(caddar map)))
-	    (progn
-	      (push (cadar map) map-files)
-	      (setq prev map))
-	  (setq touched t)
-	  (if prev
-	      (setcdr prev (cdr map))
-	    (setq nneething-map (cdr nneething-map))))
-	(setq map (cdr map))))
-    ;; Find all new files and enter them into the map.
-    (while files
-      (unless (member (car files) map-files) 
-	;; This file is not in the map, so we enter it.
-	(setq touched t)
-	(setcdr nneething-active (1+ (cdr nneething-active)))
-	(push (list (cdr nneething-active) (car files) 
-		    (nth 5 (file-attributes
-			    (nneething-file-name (car files)))))
-	      nneething-map))
-      (setq files (cdr files)))
-    (when (and touched 
-	       (not nneething-read-only))
-      (save-excursion
-	(nnheader-set-temp-buffer " *nneething map*")
-	(insert "(setq nneething-map '" (prin1-to-string nneething-map) ")\n"
-		"(setq nneething-active '" (prin1-to-string nneething-active)
-		")\n")
-	(write-region (point-min) (point-max) map-file nil 'nomesg)
-	(kill-buffer (current-buffer))))))
-
-(defun nneething-insert-head (file)
-  "Insert the head of FILE."
-  (when (nneething-get-head file)
-    (insert-buffer-substring nneething-work-buffer)
-    (goto-char (point-max))))
-
-(defun nneething-make-head (file &optional buffer)
-  "Create a head by looking at the file attributes of FILE."
-  (let ((atts (file-attributes file)))
-    (insert 
-     "Subject: " (file-name-nondirectory file) "\n"
-     "Message-ID: <nneething-" 
-     (int-to-string (incf nneething-message-id-number))
-     "@" (system-name) ">\n"
-     (if (equal '(0 0) (nth 5 atts)) ""
-       (concat "Date: " (current-time-string (nth 5 atts)) "\n"))
-     (or (if buffer
-	     (save-excursion 
-	       (set-buffer buffer)
-	       (if (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t)
-		   (concat "From: " (match-string 0) "\n"))))
-	 (nneething-from-line (nth 2 atts) file))
-     (if (> (string-to-int (int-to-string (nth 7 atts))) 0)
-	 (concat "Chars: " (int-to-string (nth 7 atts)) "\n")
-       "")
-     (if buffer 
-	 (save-excursion
-	   (set-buffer buffer)
-	   (concat "Lines: " (int-to-string 
-			      (count-lines (point-min) (point-max))) "\n"))
-       "")
-     )))
-
-(defun nneething-from-line (uid &optional file)
-  "Return a From header based of UID."
-  (let* ((login (condition-case nil 
-		    (user-login-name uid)
-		  (error 
-		   (cond ((= uid (user-uid)) (user-login-name))
-			 ((zerop uid) "root")
-			 (t (int-to-string uid))))))
-	 (name (condition-case nil 
-		   (user-full-name uid)
-		 (error 
-		  (cond ((= uid (user-uid)) (user-full-name))
-			((zerop uid) "Ms. Root")))))
-	 (host (if  (string-match "\\`/[^/@]*@\\([^:/]+\\):" file)
-		   (prog1
-		       (substring file 
-				  (match-beginning 1) 
-				  (match-end 1))
-		     (if (string-match "/\\(users\\|home\\)/\\([^/]+\\)/" file)
-			 (setq login (substring file
-						(match-beginning 2)
-						(match-end 2))
-			       name nil)))
-		 (system-name))))
-    (concat "From: " login "@" host 
-	    (if name (concat " (" name ")") "") "\n")))
-
-(defun nneething-get-head (file)
-  "Either find the head in FILE or make a head for FILE."
-  (save-excursion
-    (set-buffer (get-buffer-create nneething-work-buffer))
-    (setq case-fold-search nil)
-    (buffer-disable-undo (current-buffer))
-    (erase-buffer)
-    (cond 
-     ((not (file-exists-p file))
-      ;; The file do not exist. 
-      nil)
-     ((or (file-directory-p file)
-	  (file-symlink-p file))
-      ;; It's a dir, so we fudge a head.
-      (nneething-make-head file) t)
-     (t 
-      ;; We examine the file.
-      (nnheader-insert-head file)
-      (if (nnheader-article-p)
-	  (delete-region 
-	   (progn
-	     (goto-char (point-min))
-	     (or (and (search-forward "\n\n" nil t)
-		      (1- (point)))
-		 (point-max)))
-	   (point-max))
-	(goto-char (point-min))
-	(nneething-make-head file (current-buffer))
-	(delete-region (point) (point-max)))
-      t))))
-
-(defun nneething-file-name (article)
-  "Return the file name of ARTICLE."
-  (concat (file-name-as-directory nneething-directory)
-	  (if (numberp article)
-	      (cadr (assq article nneething-map))
-	    article)))
-
-(provide 'nneething)
-
-;;; nneething.el ends here
diff --git a/lisp/nnfolder.el b/lisp/nnfolder.el
deleted file mode 100644
index 775273dbeca..00000000000
--- a/lisp/nnfolder.el
+++ /dev/null
@@ -1,784 +0,0 @@
-;;; nnfolder.el --- mail folder access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Scott Byer <byer@mv.us.adobe.com>
-;;	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: mail
-
-;; 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:
-
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.  
-
-;; Various enhancements by byer@mv.us.adobe.com (Scott Byer).
-
-;;; Code:
-
-(require 'nnheader)
-(require 'message)
-(require 'nnmail)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnfolder)
-
-(defvoo nnfolder-directory (expand-file-name message-directory)
-  "The name of the nnfolder directory.")
-
-(defvoo nnfolder-active-file 
-  (nnheader-concat nnfolder-directory "active")
-  "The name of the active file.")
-
-;; I renamed this variable to something more in keeping with the general GNU
-;; style. -SLB
-
-(defvoo nnfolder-ignore-active-file nil
-  "If non-nil, causes nnfolder to do some extra work in order to determine
-the true active ranges of an mbox file.  Note that the active file is still
-saved, but its values are not used.  This costs some extra time when 
-scanning an mbox when opening it.")
-
-(defvoo nnfolder-distrust-mbox nil
-  "If non-nil, causes nnfolder to not trust the user with respect to
-inserting unaccounted for mail in the middle of an mbox file.  This can greatly
-slow down scans, which now must scan the entire file for unmarked messages.
-When nil, scans occur forward from the last marked message, a huge
-time saver for large mailboxes.")
-
-(defvoo nnfolder-newsgroups-file 
-  (concat (file-name-as-directory nnfolder-directory) "newsgroups")
-  "Mail newsgroups description file.")
-
-(defvoo nnfolder-get-new-mail t
-  "If non-nil, nnfolder will check the incoming mail file and split the mail.")
-
-(defvoo nnfolder-prepare-save-mail-hook nil
-  "Hook run narrowed to an article before saving.")
-
-(defvoo nnfolder-save-buffer-hook nil
-  "Hook run before saving the nnfolder mbox buffer.")
-
-(defvoo nnfolder-inhibit-expiry nil
-  "If non-nil, inhibit expiry.")
-
-
-
-(defconst nnfolder-version "nnfolder 1.0"
-  "nnfolder version.")
-
-(defconst nnfolder-article-marker "X-Gnus-Article-Number: "
-  "String used to demarcate what the article number for a message is.")
-
-(defvoo nnfolder-current-group nil)
-(defvoo nnfolder-current-buffer nil)
-(defvoo nnfolder-status-string "")
-(defvoo nnfolder-group-alist nil)
-(defvoo nnfolder-buffer-alist nil)
-(defvoo nnfolder-scantime-alist nil)
-
-
-
-;;; Interface functions
-
-(nnoo-define-basics nnfolder)
-
-(deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (let ((delim-string (concat "^" message-unix-mail-delimiter))
-	  article art-string start stop)
-      (nnfolder-possibly-change-group group server)
-      (when nnfolder-current-buffer
-	(set-buffer nnfolder-current-buffer)
-	(goto-char (point-min))
-	(if (stringp (car articles))
-	    'headers
-	  (while articles
-	    (setq article (car articles))
-	    (setq art-string (nnfolder-article-string article))
-	    (set-buffer nnfolder-current-buffer)
-	    (if (or (search-forward art-string nil t)
-		    ;; Don't search the whole file twice!  Also, articles
-		    ;; probably have some locality by number, so searching
-		    ;; backwards will be faster.  Especially if we're at the
-		    ;; beginning of the buffer :-). -SLB
-		    (search-backward art-string nil t))
-		(progn
-		  (setq start (or (re-search-backward delim-string nil t)
-				  (point)))
-		  (search-forward "\n\n" nil t)
-		  (setq stop (1- (point)))
-		  (set-buffer nntp-server-buffer)
-		  (insert (format "221 %d Article retrieved.\n" article))
-		  (insert-buffer-substring nnfolder-current-buffer start stop)
-		  (goto-char (point-max))
-		  (insert ".\n")))
-	    (setq articles (cdr articles)))
-
-	  (set-buffer nntp-server-buffer)
-	  (nnheader-fold-continuation-lines)
-	  'headers)))))
-
-(deffoo nnfolder-open-server (server &optional defs)
-  (nnoo-change-server 'nnfolder server defs)
-  (when (not (file-exists-p nnfolder-directory))
-    (condition-case ()
-	(make-directory nnfolder-directory t)
-      (error t)))
-  (cond 
-   ((not (file-exists-p nnfolder-directory))
-    (nnfolder-close-server)
-    (nnheader-report 'nnfolder "Couldn't create directory: %s"
-		     nnfolder-directory))
-   ((not (file-directory-p (file-truename nnfolder-directory)))
-    (nnfolder-close-server)
-    (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory))
-   (t
-    (nnheader-report 'nnfolder "Opened server %s using directory %s"
-		     server nnfolder-directory)
-    t)))
-
-(deffoo nnfolder-request-close ()
-  (let ((alist nnfolder-buffer-alist))
-    (while alist
-      (nnfolder-close-group (caar alist) nil t)
-      (setq alist (cdr alist))))
-  (nnoo-close-server 'nnfolder)
-  (setq nnfolder-buffer-alist nil
-	nnfolder-group-alist nil))
-
-(deffoo nnfolder-request-article (article &optional group server buffer)
-  (nnfolder-possibly-change-group group server)
-  (save-excursion
-    (set-buffer nnfolder-current-buffer)
-    (goto-char (point-min))
-    (if (search-forward (nnfolder-article-string article) nil t)
-	(let (start stop)
-	  (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
-	  (setq start (point))
-	  (forward-line 1)
-	  (or (and (re-search-forward 
-		    (concat "^" message-unix-mail-delimiter) nil t)
-		   (forward-line -1))
-	      (goto-char (point-max)))
-	  (setq stop (point))
-	  (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
-	    (set-buffer nntp-server-buffer)
-	    (erase-buffer)
-	    (insert-buffer-substring nnfolder-current-buffer start stop)
-	    (goto-char (point-min))
-	    (while (looking-at "From ")
-	      (delete-char 5)
-	      (insert "X-From-Line: ")
-	      (forward-line 1))
-	    (if (numberp article) 
-		(cons nnfolder-current-group article)
-	      (goto-char (point-min))
-	      (search-forward (concat "\n" nnfolder-article-marker))
-	      (cons nnfolder-current-group
-		    (string-to-int 
-		     (buffer-substring 
-		      (point) (progn (end-of-line) (point)))))))))))
-
-(deffoo nnfolder-request-group (group &optional server dont-check)
-  (save-excursion
-    (nnmail-activate 'nnfolder)
-    (if (not (assoc group nnfolder-group-alist))
-	(nnheader-report 'nnfolder "No such group: %s" group)
-      (nnfolder-possibly-change-group group server)
-      (if dont-check
-	  (progn 
-	    (nnheader-report 'nnfolder "Selected group %s" group)
-	    t)
-	(let* ((active (assoc group nnfolder-group-alist))
-	       (group (car active))
-	       (range (cadr active)))
-	  (cond 
-	   ((null active)
-	    (nnheader-report 'nnfolder "No such group: %s" group))
-	   ((null nnfolder-current-group)
-	    (nnheader-report 'nnfolder "Empty group: %s" group))
-	   (t
-	    (nnheader-report 'nnfolder "Selected group %s" group)
-	    (nnheader-insert "211 %d %d %d %s\n" 
-			     (1+ (- (cdr range) (car range)))
-			     (car range) (cdr range) group))))))))
-
-(deffoo nnfolder-request-scan (&optional group server)
-  (nnfolder-possibly-change-group group server t)
-  (nnmail-get-new-mail
-   'nnfolder 
-   (lambda ()
-     (let ((bufs nnfolder-buffer-alist))
-       (save-excursion
-	 (while bufs
-	   (if (not (buffer-name (nth 1 (car bufs))))
-	       (setq nnfolder-buffer-alist 
-		     (delq (car bufs) nnfolder-buffer-alist))
-	     (set-buffer (nth 1 (car bufs)))
-	     (nnfolder-save-buffer)
-	     (kill-buffer (current-buffer)))
-	   (setq bufs (cdr bufs))))))
-   nnfolder-directory
-   group))
-
-;; Don't close the buffer if we're not shutting down the server.  This way,
-;; we can keep the buffer in the group buffer cache, and not have to grovel
-;; over the buffer again unless we add new mail to it or modify it in some
-;; way.
-
-(deffoo nnfolder-close-group (group &optional server force)
-  ;; Make sure we _had_ the group open.
-  (when (or (assoc group nnfolder-buffer-alist)
-	    (equal group nnfolder-current-group))
-    (let ((inf (assoc group nnfolder-buffer-alist)))
-      (when inf
-	(when nnfolder-current-group
-	  (push (list nnfolder-current-group nnfolder-current-buffer)
-		nnfolder-buffer-alist))
-	(setq nnfolder-buffer-alist
-	      (delq inf nnfolder-buffer-alist))
-	(setq nnfolder-current-buffer (cadr inf)
-	      nnfolder-current-group (car inf))))
-    (when (and nnfolder-current-buffer
-	       (buffer-name nnfolder-current-buffer))
-      (save-excursion
-	(set-buffer nnfolder-current-buffer)
-	;; If the buffer was modified, write the file out now.
-	(nnfolder-save-buffer)
-	;; If we're shutting the server down, we need to kill the
-	;; buffer and remove it from the open buffer list.  Or, of
-	;; course, if we're trying to minimize our space impact.
-	(kill-buffer (current-buffer))
-	(setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist)
-					  nnfolder-buffer-alist)))))
-  (setq nnfolder-current-group nil
-	nnfolder-current-buffer nil)
-  t)
-
-(deffoo nnfolder-request-create-group (group &optional server) 
-  (nnfolder-possibly-change-group nil server)
-  (nnmail-activate 'nnfolder)
-  (when group 
-    (unless (assoc group nnfolder-group-alist)
-      (push (list group (cons 1 0)) nnfolder-group-alist)
-      (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
-  t)
-
-(deffoo nnfolder-request-list (&optional server)
-  (nnfolder-possibly-change-group nil server)
-  (save-excursion
-    (nnmail-find-file nnfolder-active-file)
-    (setq nnfolder-group-alist (nnmail-get-active))))
-
-(deffoo nnfolder-request-newgroups (date &optional server)
-  (nnfolder-possibly-change-group nil server)
-  (nnfolder-request-list server))
-
-(deffoo nnfolder-request-list-newsgroups (&optional server)
-  (nnfolder-possibly-change-group nil server)
-  (save-excursion
-    (nnmail-find-file nnfolder-newsgroups-file)))
-
-(deffoo nnfolder-request-expire-articles 
-  (articles newsgroup &optional server force)
-  (nnfolder-possibly-change-group newsgroup server)
-  (let* ((is-old t)
-	 rest)
-    (nnmail-activate 'nnfolder)
-
-    (save-excursion 
-      (set-buffer nnfolder-current-buffer)
-      (while (and articles is-old)
-	(goto-char (point-min))
-	(if (search-forward (nnfolder-article-string (car articles)) nil t)
-	    (if (setq is-old
-		      (nnmail-expired-article-p 
-		       newsgroup
-		       (buffer-substring 
-			(point) (progn (end-of-line) (point))) 
-		       force nnfolder-inhibit-expiry))
-		(progn
-		  (nnheader-message 5 "Deleting article %d..." 
-				    (car articles) newsgroup)
-		  (nnfolder-delete-mail))
-	      (setq rest (cons (car articles) rest))))
-	(setq articles (cdr articles)))
-      (nnfolder-save-buffer)
-      ;; Find the lowest active article in this group.
-      (let* ((active (cadr (assoc newsgroup nnfolder-group-alist)))
-	     (marker (concat "\n" nnfolder-article-marker))
-	     (number "[0-9]+")
-	     (activemin (cdr active)))
-	(goto-char (point-min))
-	(while (and (search-forward marker nil t)
-		    (re-search-forward number nil t))
-	  (setq activemin (min activemin
-			       (string-to-number (buffer-substring
-						  (match-beginning 0)
-						  (match-end 0))))))
-	(setcar active activemin))
-      (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
-      (nconc rest articles))))
-
-(deffoo nnfolder-request-move-article
-  (article group server accept-form &optional last)
-  (nnfolder-possibly-change-group group server)
-  (let ((buf (get-buffer-create " *nnfolder move*"))
-	result)
-    (and 
-     (nnfolder-request-article article group server)
-     (save-excursion
-       (set-buffer buf)
-       (buffer-disable-undo (current-buffer))
-       (erase-buffer)
-       (insert-buffer-substring nntp-server-buffer)
-       (goto-char (point-min))
-       (while (re-search-forward 
-	       (concat "^" nnfolder-article-marker)
-	       (save-excursion (search-forward "\n\n" nil t) (point)) t)
-	 (delete-region (progn (beginning-of-line) (point))
-			(progn (forward-line 1) (point))))
-       (setq result (eval accept-form))
-       (kill-buffer buf)
-       result)
-     (save-excursion
-       (nnfolder-possibly-change-group group server)
-       (set-buffer nnfolder-current-buffer)
-       (goto-char (point-min))
-       (if (search-forward (nnfolder-article-string article) nil t)
-	   (nnfolder-delete-mail))
-       (and last (nnfolder-save-buffer))))
-    result))
-
-(deffoo nnfolder-request-accept-article (group &optional server last)
-  (nnfolder-possibly-change-group group server)
-  (nnmail-check-syntax)
-  (and (stringp group) (nnfolder-possibly-change-group group))
-  (let ((buf (current-buffer))
-	result)
-    (goto-char (point-min))
-    (when (looking-at "X-From-Line: ")
-      (replace-match "From "))
-    (and 
-     (nnfolder-request-list)
-     (save-excursion
-       (set-buffer buf)
-       (goto-char (point-min))
-       (search-forward "\n\n" nil t)
-       (forward-line -1)
-       (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
-	 (delete-region (point) (progn (forward-line 1) (point))))
-       (setq result (car (nnfolder-save-mail (and (stringp group) group)))))
-     (save-excursion
-       (set-buffer nnfolder-current-buffer)
-       (and last (nnfolder-save-buffer))))
-    (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
-    (unless result
-      (nnheader-report 'nnfolder "Couldn't store article"))
-    result))
-
-(deffoo nnfolder-request-replace-article (article group buffer)
-  (nnfolder-possibly-change-group group)
-  (save-excursion
-    (set-buffer nnfolder-current-buffer)
-    (goto-char (point-min))
-    (if (not (search-forward (nnfolder-article-string article) nil t))
-	nil
-      (nnfolder-delete-mail t t)
-      (insert-buffer-substring buffer)
-      (nnfolder-save-buffer)
-      t)))
-
-(deffoo nnfolder-request-delete-group (group &optional force server)
-  (nnfolder-close-group group server t)
-  ;; Delete all articles in GROUP.
-  (if (not force)
-      ()				; Don't delete the articles.
-    ;; Delete the file that holds the group.
-    (condition-case nil
-	(delete-file (nnfolder-group-pathname group))
-      (error nil)))
-  ;; Remove the group from all structures.
-  (setq nnfolder-group-alist 
-	(delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
-	nnfolder-current-group nil
-	nnfolder-current-buffer nil)
-  ;; Save the active file.
-  (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
-  t)
-
-(deffoo nnfolder-request-rename-group (group new-name &optional server)
-  (nnfolder-possibly-change-group group server)
-  (save-excursion
-    (set-buffer nnfolder-current-buffer)
-    (and (file-writable-p buffer-file-name)
-	 (condition-case ()
-	     (progn
-	       (rename-file 
-		buffer-file-name
-		(nnfolder-group-pathname new-name))
-	       t)
-	   (error nil))
-	 ;; That went ok, so we change the internal structures.
-	 (let ((entry (assoc group nnfolder-group-alist)))
-	   (and entry (setcar entry new-name))
-	   (setq nnfolder-current-buffer nil
-		 nnfolder-current-group nil)
-	   ;; Save the new group alist.
-	   (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
-	   ;; We kill the buffer instead of renaming it and stuff.
-	   (kill-buffer (current-buffer))
-	   t))))
-
-
-;;; Internal functions.
-
-(defun nnfolder-article-string (article)
-  (if (numberp article)
-      (concat "\n" nnfolder-article-marker (int-to-string article) " ")
-    (concat "\nMessage-ID: " article)))
-
-(defun nnfolder-delete-mail (&optional force leave-delim)
-  "Delete the message that point is in."
-  (save-excursion
-    (delete-region
-     (save-excursion
-       (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
-       (if leave-delim (progn (forward-line 1) (point))
-	 (match-beginning 0)))
-     (progn
-       (forward-line 1)
-       (if (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
-	   (if (and (not (bobp)) leave-delim)
-	       (progn (forward-line -2) (point))
-	     (match-beginning 0))
-	 (point-max))))))
-
-;; When scanning, we're not looking t immediately switch into the group - if
-;; we know our information is up to date, don't even bother reading the file.
-(defun nnfolder-possibly-change-group (group &optional server scanning)
-  (when (and server
-	     (not (nnfolder-server-opened server)))
-    (nnfolder-open-server server))
-  (when (and group (or nnfolder-current-buffer
-		       (not (equal group nnfolder-current-group))))
-    (unless (file-exists-p nnfolder-directory)
-      (make-directory (directory-file-name nnfolder-directory) t))
-    (nnfolder-possibly-activate-groups nil)
-    (or (assoc group nnfolder-group-alist)
-	(not (file-exists-p
-	      (nnfolder-group-pathname group)))
-	(progn
-	  (setq nnfolder-group-alist 
-		(cons (list group (cons 1 0)) nnfolder-group-alist))
-	  (nnmail-save-active nnfolder-group-alist nnfolder-active-file)))
-    (let (inf file)
-      (if (and (equal group nnfolder-current-group)
-	       nnfolder-current-buffer
-	       (buffer-name nnfolder-current-buffer))
-	  ()
-	(setq nnfolder-current-group group)
-
-	;; If we have to change groups, see if we don't already have the mbox
-	;; in memory.  If we do, verify the modtime and destroy the mbox if
-	;; needed so we can rescan it.
-	(if (setq inf (assoc group nnfolder-buffer-alist))
-	    (setq nnfolder-current-buffer (nth 1 inf)))
-
-	;; If the buffer is not live, make sure it isn't in the alist.  If it
-	;; is live, verify that nobody else has touched the file since last
-	;; time.
-	(if (or (not (and nnfolder-current-buffer
-			  (buffer-name nnfolder-current-buffer)))
-		(not (and (bufferp nnfolder-current-buffer)
-			  (verify-visited-file-modtime 
-			   nnfolder-current-buffer))))
-	    (progn
-	      (if (and nnfolder-current-buffer
-		       (buffer-name nnfolder-current-buffer)
-		       (bufferp nnfolder-current-buffer))
-		  (kill-buffer nnfolder-current-buffer))
-	      (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist))
-	      (setq inf nil)))
-      
-	(if inf
-	    ()
-	  (save-excursion
-	    (setq file (nnfolder-group-pathname group))
-	    (if (file-directory-p (file-truename file))
-		()
-	      (unless (file-exists-p file)
-		(unless (file-exists-p (file-name-directory file))
-		  (make-directory (file-name-directory file) t))
-		(write-region 1 1 file t 'nomesg))
-	      (setq nnfolder-current-buffer
-		    (nnfolder-read-folder file scanning))
-	      (if nnfolder-current-buffer 
-		  (progn
-		    (set-buffer nnfolder-current-buffer)
-		    (setq nnfolder-buffer-alist 
-			  (cons (list group nnfolder-current-buffer)
-				nnfolder-buffer-alist)))))))))
-    (setq nnfolder-current-group group)))
-
-(defun nnfolder-save-mail (&optional group)
-  "Called narrowed to an article."
-  (let* ((nnmail-split-methods 
-	  (if group (list (list group "")) nnmail-split-methods))
-	 (group-art-list
-	  (nreverse (nnmail-article-group 'nnfolder-active-number)))
-	 (delim (concat "^" message-unix-mail-delimiter))
-	 save-list group-art)
-    (goto-char (point-min))
-    ;; This might come from somewhere else.
-    (unless (looking-at delim)
-      (insert "From nobody " (current-time-string) "\n")
-      (goto-char (point-min)))
-    ;; Quote all "From " lines in the article.
-    (forward-line 1)
-    (while (re-search-forward delim nil t)
-      (beginning-of-line)
-      (insert "> "))
-    (setq save-list group-art-list)
-    (nnmail-insert-lines)
-    (nnmail-insert-xref group-art-list)
-    (run-hooks 'nnmail-prepare-save-mail-hook)
-    (run-hooks 'nnfolder-prepare-save-mail-hook)
-
-    ;; Insert the mail into each of the destination groups.
-    (while group-art-list
-      (setq group-art (car group-art-list)
-	    group-art-list (cdr group-art-list))
-
-      ;; Kill the previous newsgroup markers.
-      (goto-char (point-min))
-      (search-forward "\n\n" nil t)
-      (forward-line -1)
-      (while (search-backward (concat "\n" nnfolder-article-marker) nil t)
-	(delete-region (1+ (point)) (progn (forward-line 2) (point))))
-
-      (nnfolder-possibly-change-group (car group-art))
-      ;; Insert the new newsgroup marker.
-      (nnfolder-insert-newsgroup-line group-art)
-      (unless nnfolder-current-buffer
-	(nnfolder-close-group (car group-art))
-	(nnfolder-request-create-group (car group-art))
-	(nnfolder-possibly-change-group (car group-art)))
-      (let ((beg (point-min))
-	    (end (point-max))
-	    (obuf (current-buffer)))
-	(set-buffer nnfolder-current-buffer)
-	(goto-char (point-max))
-	(unless (eolp)
-	  (insert "\n"))
-	(insert "\n")
-	(insert-buffer-substring obuf beg end)
-	(set-buffer obuf)))
-
-    ;; Did we save it anywhere?
-    save-list))
-
-(defun nnfolder-insert-newsgroup-line (group-art)
-  (save-excursion
-    (goto-char (point-min))
-    (if (search-forward "\n\n" nil t)
-	(progn
-	  (forward-char -1)
-	  (insert (format (concat nnfolder-article-marker "%d   %s\n")
-			  (cdr group-art) (current-time-string)))))))
-
-(defun nnfolder-possibly-activate-groups (&optional group)
-  (save-excursion
-    ;; If we're looking for the activation of a specific group, find out
-    ;; its real name and switch to it.
-    (if group (nnfolder-possibly-change-group group))
-    ;; If the group alist isn't active, activate it now.
-    (nnmail-activate 'nnfolder)))
-
-(defun nnfolder-active-number (group)
-  (when group
-    (save-excursion 
-      ;; Find the next article number in GROUP.
-      (prog1
-	  (let ((active (cadr (assoc group nnfolder-group-alist))))
-	    (if active
-		(setcdr active (1+ (cdr active)))
-	      ;; This group is new, so we create a new entry for it.
-	      ;; This might be a bit naughty... creating groups on the drop of
-	      ;; a hat, but I don't know...
-	      (setq nnfolder-group-alist 
-		    (cons (list group (setq active (cons 1 1)))
-			  nnfolder-group-alist)))
-	    (cdr active))
-	(nnmail-save-active nnfolder-group-alist nnfolder-active-file)
-	(nnfolder-possibly-activate-groups group)))))
-
-
-;; This method has a problem if you've accidentally let the active list get
-;; out of sync with the files.  This could happen, say, if you've
-;; accidentally gotten new mail with something other than Gnus (but why
-;; would _that_ ever happen? :-).  In that case, we will be in the middle of
-;; processing the file, ready to add new X-Gnus article number markers, and
-;; we'll run across a message with no ID yet - the active list _may_not_ be
-;; ready for us yet.
-
-;; To handle this, I'm modifying this routine to maintain the maximum ID seen
-;; so far, and when we hit a message with no ID, we will _manually_ scan the
-;; rest of the message looking for any more, possibly higher IDs.  We'll
-;; assume the maximum that we find is the highest active.  Note that this
-;; shouldn't cost us much extra time at all, but will be a lot less
-;; vulnerable to glitches between the mbox and the active file.
-
-(defun nnfolder-read-folder (file &optional scanning)
-  ;; This is an attempt at a serious shortcut - don't even read in the file
-  ;; if we know we've seen it since the last time it was touched.
-  (let ((scantime (cadr (assoc nnfolder-current-group 
-			       nnfolder-scantime-alist)))
-	(modtime (nth 5 (or (file-attributes file) '(nil nil nil nil nil)))))
-    (if (and scanning scantime
-	     (eq (car scantime) (car modtime))
-	     (eq (cdr scantime) (cadr modtime)))
-	nil
-      (save-excursion
-	(nnfolder-possibly-activate-groups nil)
-	;; Read in the file.
-	(set-buffer (setq nnfolder-current-buffer 
-			  (nnheader-find-file-noselect file nil 'raw)))
-	(buffer-disable-undo (current-buffer))
-	;; If the file hasn't been touched since the last time we scanned it,
-	;; don't bother doing anything with it.
-	(let ((delim (concat "^" message-unix-mail-delimiter))
-	      (marker (concat "\n" nnfolder-article-marker))
-	      (number "[0-9]+")
-	      (active (or (cadr (assoc nnfolder-current-group 
-				       nnfolder-group-alist))
-			  (cons 1 0)))
-	      (scantime (assoc nnfolder-current-group nnfolder-scantime-alist))
-	      (minid (lsh -1 -1))
-	      maxid start end newscantime)
-
-	  (setq maxid (or (cdr active) 0))
-	  (goto-char (point-min))
-
-	  ;; Anytime the active number is 1 or 0, it is suspect.  In that
-	  ;; case, search the file manually to find the active number.  Or,
-	  ;; of course, if we're being paranoid.  (This would also be the
-	  ;; place to build other lists from the header markers, such as
-	  ;; expunge lists, etc., if we ever desired to abandon the active
-	  ;; file entirely for mboxes.)
-	  (when (or nnfolder-ignore-active-file
-		    (< maxid 2))
-		(while (and (search-forward marker nil t)
-			    (re-search-forward number nil t))
-		  (let ((newnum (string-to-number (match-string 0))))
-		    (setq maxid (max maxid newnum))
-		    (setq minid (min minid newnum))))
-		(setcar active (max 1 (min minid maxid)))
-		(setcdr active (max maxid (cdr active)))
-		(goto-char (point-min)))
-
-	  ;; As long as we trust that the user will only insert unmarked mail
-	  ;; at the end, go to the end and search backwards for the last
-	  ;; marker.  Find the start of that message, and begin to search for
-	  ;; unmarked messages from there.
-	  (if (not (or nnfolder-distrust-mbox
-		       (< maxid 2)))
-	      (progn
-		(goto-char (point-max))
-		(if (not (re-search-backward marker nil t))
-		    (goto-char (point-min))
-		  (if (not (re-search-backward delim nil t))
-		      (goto-char (point-min))))))
-
-	  ;; Keep track of the active number on our own, and insert it back
-	  ;; into the active list when we're done. Also, prime the pump to
-	  ;; cut down on the number of searches we do.
-	  (setq end (point-marker))
-	  (set-marker end (or (and (re-search-forward delim nil t)
-				   (match-beginning 0))
-			      (point-max)))
-	  (while (not (= end (point-max)))
-	    (setq start (marker-position end))
-	    (goto-char end)
-	    ;; There may be more than one "From " line, so we skip past
-	    ;; them.  
-	    (while (looking-at delim) 
-	      (forward-line 1))
-	    (set-marker end (or (and (re-search-forward delim nil t)
-				     (match-beginning 0))
-				(point-max)))
-	    (goto-char start)
-	    (if (not (search-forward marker end t))
-		(progn
-		  (narrow-to-region start end)
-		  (nnmail-insert-lines)
-		  (nnfolder-insert-newsgroup-line
-		   (cons nil (nnfolder-active-number nnfolder-current-group)))
-		  (widen))))
-
-	  ;; Make absolutely sure that the active list reflects reality!
-	  (nnmail-save-active nnfolder-group-alist nnfolder-active-file)
-	  ;; Set the scantime for this group.
-	  (setq newscantime (visited-file-modtime))
-	  (if scantime
-	      (setcdr scantime (list newscantime))
-	    (push (list nnfolder-current-group newscantime) 
-		  nnfolder-scantime-alist))
-	  (current-buffer))))))
-
-;;;###autoload
-(defun nnfolder-generate-active-file ()
-  "Look for mbox folders in the nnfolder directory and make them into groups."
-  (interactive)
-  (nnmail-activate 'nnfolder)
-  (let ((files (directory-files nnfolder-directory))
-	file)
-    (while (setq file (pop files))
-      (when (and (not (backup-file-name-p file))
-		 (nnheader-mail-file-mbox-p file))
-	(nnheader-message 5 "Adding group %s..." file)
-	(push (list file (cons 1 0)) nnfolder-group-alist)
-	(nnfolder-possibly-change-group file)
-;;	(nnfolder-read-folder file)
-	(nnfolder-close-group file))
-      (message ""))))
-
-(defun nnfolder-group-pathname (group)
-  "Make pathname for GROUP."
-  (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
-    ;; If this file exists, we use it directly.
-    (if (or nnmail-use-long-file-names 
-	    (file-exists-p (concat dir group)))
-	(concat dir group)
-      ;; If not, we translate dots into slashes.
-      (concat dir (nnheader-replace-chars-in-string group ?. ?/)))))
-
-(defun nnfolder-save-buffer ()
-  "Save the buffer."
-  (when (buffer-modified-p)
-    (run-hooks 'nnfolder-save-buffer-hook)
-    (save-buffer)))
-
-(provide 'nnfolder)
-
-;;; nnfolder.el ends here
diff --git a/lisp/nnheader.el b/lisp/nnheader.el
deleted file mode 100644
index 1c93816dfb6..00000000000
--- a/lisp/nnheader.el
+++ /dev/null
@@ -1,620 +0,0 @@
-;;; nnheader.el --- header access macros for Gnus and its backends
-;; Copyright (C) 1987,88,89,90,93,94,95,96 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; 	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-;; These macros may look very much like the ones in GNUS 4.1.  They
-;; are, in a way, but you should note that the indices they use have
-;; been changed from the internal GNUS format to the NOV format.  The
-;; makes it possible to read headers from XOVER much faster.
-;;
-;; The format of a header is now:
-;; [number subject from date id references chars lines xref]
-;;
-;; (That last entry is defined as "misc" in the NOV format, but Gnus
-;; uses it for xrefs.)
-
-;;; Code:
-
-(require 'mail-utils)
-(eval-when-compile (require 'cl))
-
-(defvar nnheader-max-head-length 4096
-  "*Max length of the head of articles.")
-
-(defvar nnheader-file-name-translation-alist nil
-  "*Alist that says how to translate characters in file names.
-For instance, if \":\" is illegal as a file character in file names
-on your system, you could say something like:
-
-\(setq nnheader-file-name-translation-alist '((?: . ?_)))")
-
-;;; Header access macros.
-
-(defmacro mail-header-number (header)
-  "Return article number in HEADER."
-  `(aref ,header 0))
-
-(defmacro mail-header-set-number (header number)
-  "Set article number of HEADER to NUMBER."
-  `(aset ,header 0 ,number))
-
-(defmacro mail-header-subject (header)
-  "Return subject string in HEADER."
-  `(aref ,header 1))
-
-(defmacro mail-header-set-subject (header subject)
-  "Set article subject of HEADER to SUBJECT."
-  `(aset ,header 1 ,subject))
-
-(defmacro mail-header-from (header)
-  "Return author string in HEADER."
-  `(aref ,header 2))
-
-(defmacro mail-header-set-from (header from)
-  "Set article author of HEADER to FROM."
-  `(aset ,header 2 ,from))
-
-(defmacro mail-header-date (header)
-  "Return date in HEADER."
-  `(aref ,header 3))
-
-(defmacro mail-header-set-date (header date)
-  "Set article date of HEADER to DATE."
-  `(aset ,header 3 ,date))
-
-(defalias 'mail-header-message-id 'mail-header-id)
-(defmacro mail-header-id (header)
-  "Return Id in HEADER."
-  `(aref ,header 4))
-
-(defalias 'mail-header-set-message-id 'mail-header-set-id)
-(defmacro mail-header-set-id (header id)
-  "Set article Id of HEADER to ID."
-  `(aset ,header 4 ,id))
-
-(defmacro mail-header-references (header)
-  "Return references in HEADER."
-  `(aref ,header 5))
-
-(defmacro mail-header-set-references (header ref)
-  "Set article references of HEADER to REF."
-  `(aset ,header 5 ,ref))
-
-(defmacro mail-header-chars (header)
-  "Return number of chars of article in HEADER."
-  `(aref ,header 6))
-
-(defmacro mail-header-set-chars (header chars)
-  "Set number of chars in article of HEADER to CHARS."
-  `(aset ,header 6 ,chars))
-
-(defmacro mail-header-lines (header)
-  "Return lines in HEADER."
-  `(aref ,header 7))
-
-(defmacro mail-header-set-lines (header lines)
-  "Set article lines of HEADER to LINES."
-  `(aset ,header 7 ,lines))
-
-(defmacro mail-header-xref (header)
-  "Return xref string in HEADER."
-  `(aref ,header 8))
-
-(defmacro mail-header-set-xref (header xref)
-  "Set article xref of HEADER to xref."
-  `(aset ,header 8 ,xref))
-
-(defun make-mail-header (&optional init)
-  "Create a new mail header structure initialized with INIT."
-  (make-vector 9 init))
-
-;; Parsing headers and NOV lines.
-
-(defsubst nnheader-header-value ()
-  (buffer-substring (match-end 0) (gnus-point-at-eol)))
-
-(defvar nnheader-newsgroup-none-id 1)
-
-(defun nnheader-parse-head (&optional naked)
-  (let ((case-fold-search t)
-	(cur (current-buffer))
-	(buffer-read-only nil)
-	end ref in-reply-to lines p)
-    (goto-char (point-min))
-    (when naked
-      (insert "\n"))
-    ;; Search to the beginning of the next header. Error messages
-    ;; do not begin with 2 or 3.
-    (prog1
-	(when (or naked (re-search-forward "^[23][0-9]+ " nil t))
-	  ;; This implementation of this function, with nine
-	  ;; search-forwards instead of the one re-search-forward and
-	  ;; a case (which basically was the old function) is actually
-	  ;; about twice as fast, even though it looks messier.	 You
-	  ;; can't have everything, I guess.  Speed and elegance
-	  ;; doesn't always go hand in hand.
-	  (vector
-	   ;; Number.
-	   (if naked
-	       (progn
-		 (setq p (point-min))
-		 0)
-	     (prog1
-		 (read cur)
-	       (end-of-line)
-	       (setq p (point))
-	       (narrow-to-region (point)
-				 (or (and (search-forward "\n.\n" nil t)
-					  (- (point) 2))
-				     (point)))))
-	   ;; Subject.
-	   (progn
-	     (goto-char p)
-	     (if (search-forward "\nsubject: " nil t)
-		 (nnheader-header-value) "(none)"))
-	   ;; From.
-	   (progn
-	     (goto-char p)
-	     (if (search-forward "\nfrom: " nil t)
-		 (nnheader-header-value) "(nobody)"))
-	   ;; Date.
-	   (progn
-	     (goto-char p)
-	     (if (search-forward "\ndate: " nil t)
-		 (nnheader-header-value) ""))
-	   ;; Message-ID.
-	   (progn
-	     (goto-char p)
-	     (if (search-forward "\nmessage-id: " nil t)
-		 (nnheader-header-value)
-	       ;; If there was no message-id, we just fake one to make
-	       ;; subsequent routines simpler.
-	       (concat "none+"
-		       (int-to-string
-			(incf nnheader-newsgroup-none-id)))))
-	   ;; References.
-	   (progn
-	     (goto-char p)
-	     (if (search-forward "\nreferences: " nil t)
-		 (nnheader-header-value)
-	       ;; Get the references from the in-reply-to header if there
-	       ;; were no references and the in-reply-to header looks
-	       ;; promising.
-	       (if (and (search-forward "\nin-reply-to: " nil t)
-			(setq in-reply-to (nnheader-header-value))
-			(string-match "<[^>]+>" in-reply-to))
-		   (substring in-reply-to (match-beginning 0)
-			      (match-end 0))
-		 "")))
-	   ;; Chars.
-	   0
-	   ;; Lines.
-	   (progn
-	     (goto-char p)
-	     (if (search-forward "\nlines: " nil t)
-		 (if (numberp (setq lines (read cur)))
-		     lines 0)
-	       0))
-	   ;; Xref.
-	   (progn
-	     (goto-char p)
-	     (and (search-forward "\nxref: " nil t)
-		  (nnheader-header-value)))))
-      (when naked
-	(goto-char (point-min))
-	(delete-char 1)))))
-
-(defun nnheader-insert-nov (header)
-  (princ (mail-header-number header) (current-buffer))
-  (insert 
-   "\t"
-   (or (mail-header-subject header) "(none)") "\t"
-   (or (mail-header-from header) "(nobody)") "\t"
-   (or (mail-header-date header) "") "\t"
-   (or (mail-header-id header) 
-       (nnmail-message-id)) "\t"
-   (or (mail-header-references header) "") "\t")
-  (princ (or (mail-header-chars header) 0) (current-buffer))
-  (insert "\t")
-  (princ (or (mail-header-lines header) 0) (current-buffer))
-  (insert "\t")
-  (when (mail-header-xref header) 
-    (insert "Xref: " (mail-header-xref header) "\t"))
-  (insert "\n"))
-
-(defun nnheader-insert-article-line (article)
-  (goto-char (point-min))
-  (insert "220 ")
-  (princ article (current-buffer))
-  (insert " Article retrieved.\n")
-  (search-forward "\n\n" nil 'move)
-  (delete-region (point) (point-max))
-  (forward-char -1)
-  (insert "."))
-
-;; Various cruft the backends and Gnus need to communicate.
-
-(defvar nntp-server-buffer nil)
-(defvar gnus-verbose-backends 7
-  "*A number that says how talkative the Gnus backends should be.")
-(defvar gnus-nov-is-evil nil
-  "If non-nil, Gnus backends will never output headers in the NOV format.")
-(defvar news-reply-yank-from nil)
-(defvar news-reply-yank-message-id nil)
-
-(defvar nnheader-callback-function nil)
-
-(defun nnheader-init-server-buffer ()
-  "Initialize the Gnus-backend communication buffer."
-  (save-excursion
-    (setq nntp-server-buffer (get-buffer-create " *nntpd*"))
-    (set-buffer nntp-server-buffer)
-    (buffer-disable-undo (current-buffer))
-    (erase-buffer)
-    (kill-all-local-variables)
-    (setq case-fold-search t)		;Should ignore case.
-    t))
-
-
-;;; Various functions the backends use.
-
-(defun nnheader-file-error (file)
-  "Return a string that says what is wrong with FILE."
-  (format
-   (cond
-    ((not (file-exists-p file))
-     "%s does not exist")
-    ((file-directory-p file)
-     "%s is a directory")
-    ((not (file-readable-p file))
-     "%s is not readable"))
-   file))
-
-(defun nnheader-insert-head (file)
-  "Insert the head of the article."
-  (when (file-exists-p file)
-    (if (eq nnheader-max-head-length t)
-	;; Just read the entire file.
-	(nnheader-insert-file-contents-literally file)
-      ;; Read 1K blocks until we find a separator.
-      (let ((beg 0)
-	    format-alist 
-	    (chop 1024))
-	(while (and (eq chop (nth 1 (insert-file-contents
-				     file nil beg (incf beg chop))))
-		    (prog1 (not (search-forward "\n\n" nil t)) 
-		      (goto-char (point-max)))
-		    (or (null nnheader-max-head-length)
-			(< beg nnheader-max-head-length))))))
-    t))
-
-(defun nnheader-article-p ()
-  "Say whether the current buffer looks like an article."
-  (goto-char (point-min))
-  (if (not (search-forward "\n\n" nil t))
-      nil
-    (narrow-to-region (point-min) (1- (point)))
-    (goto-char (point-min))
-    (while (looking-at "[A-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
-      (goto-char (match-end 0)))
-    (prog1
-	(eobp)
-      (widen))))    
-
-(defun nnheader-insert-references (references message-id)
-  "Insert a References header based on REFERENCES and MESSAGE-ID."
-  (if (and (not references) (not message-id)) 
-      ()	; This is illegal, but not all articles have Message-IDs.
-    (mail-position-on-field "References")
-    (let ((begin (save-excursion (beginning-of-line) (point)))
-	  (fill-column 78)
-	  (fill-prefix "\t"))
-      (if references (insert references))
-      (if (and references message-id) (insert " "))
-      (if message-id (insert message-id))
-      ;; Fold long References lines to conform to RFC1036 (sort of).
-      ;; The region must end with a newline to fill the region
-      ;; without inserting extra newline.
-      (fill-region-as-paragraph begin (1+ (point))))))
-
-(defun nnheader-replace-header (header new-value)
-  "Remove HEADER and insert the NEW-VALUE."
-  (save-excursion
-    (save-restriction
-      (nnheader-narrow-to-headers)
-      (prog1
-	  (message-remove-header header)
-	(goto-char (point-max))
-	(insert header ": " new-value "\n")))))
-
-(defun nnheader-narrow-to-headers ()
-  "Narrow to the head of an article."
-  (widen)
-  (narrow-to-region
-   (goto-char (point-min))
-   (if (search-forward "\n\n" nil t)
-       (1- (point))
-     (point-max)))
-  (goto-char (point-min)))
-
-(defun nnheader-set-temp-buffer (name)
-  "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
-  (set-buffer (get-buffer-create name))
-  (buffer-disable-undo (current-buffer))
-  (erase-buffer)
-  (current-buffer))
-
-(defmacro nnheader-temp-write (file &rest forms)
-  "Create a new buffer, evaluate FORM there, and write the buffer to FILE."
-  `(save-excursion
-     (let ((nnheader-temp-file ,file)
-	   (nnheader-temp-cur-buffer
-	    (nnheader-set-temp-buffer
-	     (generate-new-buffer-name " *nnheader temp*"))))
-       (when (and nnheader-temp-file 
-		  (not (file-directory-p (file-name-directory 
-					  nnheader-temp-file))))
-	 (make-directory (file-name-directory nnheader-temp-file) t))
-       (unwind-protect
-	   (prog1
-	       (progn
-		 ,@forms)
-	     (when nnheader-temp-file
-	       (set-buffer nnheader-temp-cur-buffer)
-	       (write-region (point-min) (point-max) 
-			     nnheader-temp-file nil 'nomesg)))
-	 (when (buffer-name nnheader-temp-cur-buffer)
-	   (kill-buffer nnheader-temp-cur-buffer))))))
-
-(put 'nnheader-temp-write 'lisp-indent-function 1)
-(put 'nnheader-temp-write 'lisp-indent-hook 1)
-(put 'nnheader-temp-write 'edebug-form-spec '(form body))
-
-(defvar jka-compr-compression-info-list)
-(defvar nnheader-numerical-files
-  (if (boundp 'jka-compr-compression-info-list)
-      (concat "\\([0-9]+\\)\\(" 
-	      (mapconcat (lambda (i) (aref i 0))
-			 jka-compr-compression-info-list "\\|")
-	      "\\)?")
-    "[0-9]+$")
-  "Regexp that match numerical files.")
-
-(defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files)
-  "Regexp that matches numerical file names.")
-
-(defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files)
-  "Regexp that matches numerical full file paths.")
-
-(defsubst nnheader-file-to-number (file)
-  "Take a file name and return the article number."
-  (if (not (boundp 'jka-compr-compression-info-list))
-      (string-to-int file)
-    (string-match nnheader-numerical-short-files file)
-    (string-to-int (match-string 0 file))))
-
-(defun nnheader-directory-files-safe (&rest args)
-  ;; It has been reported numerous times that `directory-files'
-  ;; fails with an alarming frequency on NFS mounted file systems.
-  ;; This function executes that function twice and returns 
-  ;; the longest result.
-  (let ((first (apply 'directory-files args))
-	(second (apply 'directory-files args)))
-    (if (> (length first) (length second))
-	first
-      second)))
-
-(defun nnheader-directory-articles (dir)
-  "Return a list of all article files in a directory."
-  (mapcar 'nnheader-file-to-number
-	  (nnheader-directory-files-safe
-	   dir nil nnheader-numerical-short-files t)))
-
-(defun nnheader-article-to-file-alist (dir)
-  "Return an alist of article/file pairs in DIR."
-  (mapcar (lambda (file) (cons (nnheader-file-to-number file) file))
-	  (nnheader-directory-files-safe
-	   dir nil nnheader-numerical-short-files t)))
-
-(defun nnheader-fold-continuation-lines ()
-  "Fold continuation lines in the current buffer."
-  (goto-char (point-min))
-  (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
-    (replace-match " " t t)))
-
-(defun nnheader-translate-file-chars (file)
-  (if (null nnheader-file-name-translation-alist)
-      ;; No translation is necessary.
-      file 
-    ;; We translate -- but only the file name.  We leave the directory
-    ;; alone.
-    (let* ((i 0)
-	   trans leaf path len)
-      (if (string-match "/[^/]+\\'" file)
-	  ;; This is needed on NT's and stuff.
-	  (setq leaf (substring file (1+ (match-beginning 0)))
-		path (substring file 0 (1+ (match-beginning 0))))
-	;; Fall back on this.
-	(setq leaf (file-name-nondirectory file)
-	      path (file-name-directory file)))
-      (setq len (length leaf))
-      (while (< i len)
-	(when (setq trans (cdr (assq (aref leaf i)
-				     nnheader-file-name-translation-alist)))
-	  (aset leaf i trans))
-	(incf i))
-      (concat path leaf))))
-
-(defun nnheader-report (backend &rest args)
-  "Report an error from the BACKEND.
-The first string in ARGS can be a format string."
-  (set (intern (format "%s-status-string" backend))
-       (if (< (length args) 2)
-	   (car args)
-	 (apply 'format args)))
-  nil)
-
-(defun nnheader-get-report (backend)
-  (message "%s" (symbol-value (intern (format "%s-status-string" backend)))))
-
-(defun nnheader-insert (format &rest args)
-  "Clear the communicaton buffer and insert FORMAT and ARGS into the buffer.
-If FORMAT isn't a format string, it and all ARGS will be inserted
-without formatting."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (if (string-match "%" format)
-	(insert (apply 'format format args))
-      (apply 'insert format args))
-    t))
-
-(defun nnheader-mail-file-mbox-p (file)
-  "Say whether FILE looks like an Unix mbox file."
-  (when (and (file-exists-p file)
-	     (file-readable-p file)
-	     (file-regular-p file))
-    (save-excursion
-      (nnheader-set-temp-buffer " *mail-file-mbox-p*")
-      (nnheader-insert-file-contents-literally file)
-      (goto-char (point-min))
-      (prog1
-	  (looking-at message-unix-mail-delimiter)
-	(kill-buffer (current-buffer))))))
-
-(defun nnheader-replace-chars-in-string (string from to)
-  "Replace characters in STRING from FROM to TO."
-  (let ((string (substring string 0))	;Copy string.
-	(len (length string))
-	(idx 0))
-    ;; Replace all occurrences of FROM with TO.
-    (while (< idx len)
-      (if (= (aref string idx) from)
-	  (aset string idx to))
-      (setq idx (1+ idx)))
-    string))
-
-(defun nnheader-file-to-group (file &optional top)
-  "Return a group name based on FILE and TOP."
-  (nnheader-replace-chars-in-string 
-   (if (not top)
-       file
-     (condition-case ()
-	 (substring (expand-file-name file)
-		    (length 
-		     (expand-file-name
-		      (file-name-as-directory top))))
-       (error "")))
-   ?/ ?.))
-
-(defun nnheader-message (level &rest args)
-  "Message if the Gnus backends are talkative."
-  (if (or (not (numberp gnus-verbose-backends))
-	  (<= level gnus-verbose-backends))
-      (apply 'message args)
-    (apply 'format args)))
-
-(defun nnheader-be-verbose (level)
-  "Return whether the backends should be verbose on LEVEL."
-  (or (not (numberp gnus-verbose-backends))
-      (<= level gnus-verbose-backends)))
-
-(defun nnheader-group-pathname (group dir &optional file)
-  "Make pathname for GROUP."
-  (concat
-   (let ((dir (file-name-as-directory (expand-file-name dir))))
-     ;; If this directory exists, we use it directly.
-     (if (file-directory-p (concat dir group))
-	 (concat dir group "/")
-       ;; If not, we translate dots into slashes.
-       (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/")))
-   (cond ((null file) "")
-	 ((numberp file) (int-to-string file))
-	 (t file))))
-
-(defun nnheader-functionp (form)
-  "Return non-nil if FORM is funcallable."
-  (or (and (symbolp form) (fboundp form))
-      (and (listp form) (eq (car form) 'lambda))))
-
-(defun nnheader-concat (dir file)
-  "Concat DIR as directory to FILE."
-  (concat (file-name-as-directory dir) file))
-
-(defun nnheader-ms-strip-cr ()
-  "Strip ^M from the end of all lines."
-  (save-excursion
-    (goto-char (point-min))
-    (while (re-search-forward "\r$" nil t)
-      (delete-backward-char 1))))
-
-(defun nnheader-file-size (file)
-  "Return the file size of FILE or 0."
-  (or (nth 7 (file-attributes file)) 0))
-
-(defun nnheader-find-etc-directory (package)
-  "Go through the path and find the \".../etc/PACKAGE\" directory."
-  (let ((path load-path)
-	dir result)
-    ;; We try to find the dir by looking at the load path,
-    ;; stripping away the last component and adding "etc/".
-    (while path
-      (if (and (car path)
-	       (file-exists-p
-		(setq dir (concat
-			   (file-name-directory
-			    (directory-file-name (car path)))
-			   "etc/" package "/")))
-	       (file-directory-p dir))
-	  (setq result dir
-		path nil)
-	(setq path (cdr path))))
-    result))
-
-(defvar ange-ftp-path-format)
-(defvar efs-path-regexp)
-(defun nnheader-re-read-dir (path)
-  "Re-read directory PATH if PATH is on a remote system."
-  (if (boundp 'ange-ftp-path-format)
-      (when (string-match (car ange-ftp-path-format) path)
-	(ange-ftp-re-read-dir path))
-    (if (boundp 'efs-path-regexp)
-	(when (string-match efs-path-regexp path)
-	  (efs-re-read-dir path)))))
-
-(fset 'nnheader-run-at-time 'run-at-time)
-(fset 'nnheader-cancel-timer 'cancel-timer)
-(fset 'nnheader-find-file-noselect 'find-file-noselect)
-(fset 'nnheader-insert-file-contents-literally
-      'insert-file-contents-literally)
-
-(when (string-match "XEmacs\\|Lucid" emacs-version)
-  (require 'nnheaderxm))
-
-(run-hooks 'nnheader-load-hook)
-
-(provide 'nnheader)
-
-;;; nnheader.el ends here
diff --git a/lisp/nnheaderems.el b/lisp/nnheaderems.el
deleted file mode 100644
index 14ce490bb17..00000000000
--- a/lisp/nnheaderems.el
+++ /dev/null
@@ -1,201 +0,0 @@
-;;; nnheaderems.el --- making Gnus backends work under different Emacsen
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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 nnheader-xmas-run-at-time (time repeat function &rest args)
-  (start-itimer
-   "nnheader-run-at-time"
-   `(lambda ()
-      (,function ,@args))
-   time repeat))
-
-(defun nnheader-xmas-cancel-timer (timer)
-  (delete-itimer timer))
-
-;; Written by Erik Naggum <erik@naggum.no>.
-;; Saved by Steve Baur <steve@miranova.com>.
-(defun nnheader-xmas-insert-file-contents-literally (filename &optional visit beg end replace)
-  "Like `insert-file-contents', q.v., but only reads in the file.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
-  This function ensures that none of these modifications will take place."
-  (let (                                ; (file-name-handler-alist nil)
-        (format-alist nil)
-        (after-insert-file-functions nil)
-        (find-buffer-file-type-function 
-         (if (fboundp 'find-buffer-file-type)
-             (symbol-function 'find-buffer-file-type)
-           nil)))
-    (unwind-protect
-        (progn
-          (fset 'find-buffer-file-type (lambda (filename) t))
-          (insert-file-contents filename visit beg end replace))
-      (if find-buffer-file-type-function
-          (fset 'find-buffer-file-type find-buffer-file-type-function)
-        (fmakunbound 'find-buffer-file-type)))))
-
-(defun nnheader-xmas-find-file-noselect (filename &optional nowarn rawfile)
-  "Read file FILENAME into a buffer and return the buffer.
-If a buffer exists visiting FILENAME, return that one, but
-verify that the file has not changed since visited or saved.
-The buffer is not selected, just returned to the caller."
-  (setq filename
-	(abbreviate-file-name
-	 (expand-file-name filename)))
-  (if (file-directory-p filename)
-      (if find-file-run-dired
-	  (dired-noselect filename)
-	(error "%s is a directory." filename))
-    (let* ((buf (get-file-buffer filename))
-	   (truename (abbreviate-file-name (file-truename filename)))
-	   (number (nthcdr 10 (file-attributes truename)))
-	   ;; Find any buffer for a file which has same truename.
-	   (other (and (not buf) 
-		       (if (fboundp 'find-buffer-visiting)
-			   (find-buffer-visiting filename)
-			 (get-file-buffer filename))))
-	   error)
-      ;; Let user know if there is a buffer with the same truename.
-      (if other
-	  (progn
-	    (or nowarn
-		(string-equal filename (buffer-file-name other))
-		(message "%s and %s are the same file"
-			 filename (buffer-file-name other)))
-	    ;; Optionally also find that buffer.
-	    (if (or (and (boundp 'find-file-existing-other-name)
-			 find-file-existing-other-name)
-		    find-file-visit-truename)
-		(setq buf other))))
-      (if buf
-	  (or nowarn
-	      (verify-visited-file-modtime buf)
-	      (cond ((not (file-exists-p filename))
-		     (error "File %s no longer exists!" filename))
-		    ((yes-or-no-p
-		      (if (string= (file-name-nondirectory filename)
-				   (buffer-name buf))
-			  (format
-			   (if (buffer-modified-p buf)
-			       "File %s changed on disk.  Discard your edits? "
-			     "File %s changed on disk.  Reread from disk? ")
-			   (file-name-nondirectory filename))
-			(format
-			 (if (buffer-modified-p buf)
-			     "File %s changed on disk.  Discard your edits in %s? "
-			   "File %s changed on disk.  Reread from disk into %s? ")
-			 (file-name-nondirectory filename)
-			 (buffer-name buf))))
-		     (save-excursion
-		       (set-buffer buf)
-		       (revert-buffer t t)))))
-	(save-excursion
-;;; The truename stuff makes this obsolete.
-;;;	  (let* ((link-name (car (file-attributes filename)))
-;;;		 (linked-buf (and (stringp link-name)
-;;;				  (get-file-buffer link-name))))
-;;;	    (if (bufferp linked-buf)
-;;;		(message "Symbolic link to file in buffer %s"
-;;;			 (buffer-name linked-buf))))
-	  (setq buf (create-file-buffer filename))
-	  ;;	  (set-buffer-major-mode buf)
-	  (set-buffer buf)
-	  (erase-buffer)
-	  (if rawfile
-	      (condition-case ()
-		  (nnheader-insert-file-contents-literally filename t)
-		(file-error
-		 ;; Unconditionally set error
-		 (setq error t)))
-	    (condition-case ()
-		(insert-file-contents filename t)
-	      (file-error
-	       ;; Run find-file-not-found-hooks until one returns non-nil.
-	       (or t			; (run-hook-with-args-until-success 'find-file-not-found-hooks)
-		   ;; If they fail too, set error.
-		   (setq error t)))))
-	  ;; Find the file's truename, and maybe use that as visited name.
-	  (setq buffer-file-truename truename)
-	  (setq buffer-file-number number)
-	  ;; On VMS, we may want to remember which directory in a search list
-	  ;; the file was found in.
-	  (and (eq system-type 'vax-vms)
-	       (let (logical)
-		 (if (string-match ":" (file-name-directory filename))
-		     (setq logical (substring (file-name-directory filename)
-					      0 (match-beginning 0))))
-		 (not (member logical find-file-not-true-dirname-list)))
-	       (setq buffer-file-name buffer-file-truename))
-	  (if find-file-visit-truename
-	      (setq buffer-file-name
-		    (setq filename
-			  (expand-file-name buffer-file-truename))))
-	  ;; Set buffer's default directory to that of the file.
-	  (setq default-directory (file-name-directory filename))
-	  ;; Turn off backup files for certain file names.  Since
-	  ;; this is a permanent local, the major mode won't eliminate it.
-	  (and (not (funcall backup-enable-predicate buffer-file-name))
-	       (progn
-		 (make-local-variable 'backup-inhibited)
-		 (setq backup-inhibited t)))
-	  (if rawfile
-	      nil
-	    (after-find-file error (not nowarn)))))
-      buf)))
-
-(defun nnheader-ms-strip-cr ()
-  "Strip ^M from the end of all lines."
-  (save-excursion
-    (goto-char (point-min))
-    (while (re-search-forward "\r$" nil t)
-      (delete-backward-char 1))))
-
-(eval-and-compile
-  (cond 
-   ;; Do XEmacs function bindings.
-   ((string-match "XEmacs\\|Lucid" emacs-version)
-    (fset 'nnheader-run-at-time 'nnheader-xmas-run-at-time)
-    (fset 'nnheader-cancel-timer 'nnheader-xmas-cancel-timer)
-    (fset 'nnheader-find-file-noselect 'nnheader-xmas-find-file-noselect)
-    (fset 'nnheader-insert-file-contents-literally
-	  (if (fboundp 'insert-file-contents-literally)
-	      'insert-file-contents-literally
-	    'nnheader-xmas-insert-file-contents-literally)))
-   ;; Do Emacs function bindings.
-   (t
-    (fset 'nnheader-run-at-time 'run-at-time)
-    (fset 'nnheader-cancel-timer 'cancel-timer)
-    (fset 'nnheader-find-file-noselect 'find-file-noselect)
-    (fset 'nnheader-insert-file-contents-literally
-	  'insert-file-contents-literally)
-    ))
-  (when (memq system-type '(windows-nt))
-    (add-hook 'nnmail-prepare-incoming-hook 'nnheader-ms-strip-cr)))
-
-(provide 'nnheaderems)
-
-;;; nnheaderems.el ends here.
diff --git a/lisp/nnkiboze.el b/lisp/nnkiboze.el
deleted file mode 100644
index b314d58d1a9..00000000000
--- a/lisp/nnkiboze.el
+++ /dev/null
@@ -1,388 +0,0 @@
-;;; nnkiboze.el --- select virtual news access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-;; The other access methods (nntp, nnspool, etc) are general news
-;; access methods. This module relies on Gnus and can not be used
-;; separately.
-
-;;; Code:
-
-(require 'nntp)
-(require 'nnheader)
-(require 'gnus)
-(require 'gnus-score)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnkiboze)
-(defvoo nnkiboze-directory gnus-directory
-  "nnkiboze will put its files in this directory.")
-
-(defvoo nnkiboze-level 9
-  "*The maximum level to be searched for articles.")
-
-(defvoo nnkiboze-remove-read-articles t
-  "*If non-nil, nnkiboze will remove read articles from the kiboze group.")
-
-
-
-(defconst nnkiboze-version "nnkiboze 1.0"
-  "Version numbers of this version of nnkiboze.")
-
-(defvoo nnkiboze-current-group nil)
-(defvoo nnkiboze-current-score-group "")
-(defvoo nnkiboze-status-string "")
-
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nnkiboze)
-
-(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old)
-  (nnkiboze-possibly-change-newsgroups group)
-  (if gnus-nov-is-evil
-      nil
-    (if (stringp (car articles))
-	'headers
-      (let ((first (car articles))
-	    (last (progn (while (cdr articles) (setq articles (cdr articles)))
-			 (car articles)))
-	    (nov (nnkiboze-nov-file-name)))
-	(if (file-exists-p nov)
-	    (save-excursion
-	      (set-buffer nntp-server-buffer)
-	      (erase-buffer)
-	      (insert-file-contents nov)
-	      (goto-char (point-min))
-	      (while (and (not (eobp)) (< first (read (current-buffer))))
-		(forward-line 1))
-	      (beginning-of-line)
-	      (if (not (eobp)) (delete-region 1 (point)))
-	      (while (and (not (eobp)) (>= last (read (current-buffer))))
-		(forward-line 1))
-	      (beginning-of-line)
-	      (if (not (eobp)) (delete-region (point) (point-max)))
-	      'nov))))))
-
-(deffoo nnkiboze-open-server (newsgroups &optional something)
-  (gnus-make-directory nnkiboze-directory)
-  (nnheader-init-server-buffer))
-
-(deffoo nnkiboze-server-opened (&optional server)
-  (and nntp-server-buffer
-       (get-buffer nntp-server-buffer)))
-
-(deffoo nnkiboze-request-article (article &optional newsgroup server buffer)
-  (nnkiboze-possibly-change-newsgroups newsgroup)
-  (if (not (numberp article))
-      ;; This is a real kludge. It might not work at times, but it
-      ;; does no harm I think. The only alternative is to offer no
-      ;; article fetching by message-id at all.
-      (nntp-request-article article newsgroup gnus-nntp-server buffer)
-    (let* ((header (gnus-summary-article-header article))
-	   (xref (mail-header-xref header))
-	   igroup iarticle)
-      (or xref (error "nnkiboze: No xref"))
-      (or (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
-	  (error "nnkiboze: Malformed xref"))
-      (setq igroup (substring xref (match-beginning 1) (match-end 1)))
-      (setq iarticle (string-to-int 
-		      (substring xref (match-beginning 2) (match-end 2))))
-      (and (gnus-request-group igroup t)
-	   (gnus-request-article iarticle igroup buffer)))))
-
-(deffoo nnkiboze-request-group (group &optional server dont-check)
-  "Make GROUP the current newsgroup."
-  (nnkiboze-possibly-change-newsgroups group)
-  (if dont-check
-      ()
-    (let ((nov-file (nnkiboze-nov-file-name))
-	  beg end total)
-      (save-excursion
-	(set-buffer nntp-server-buffer)
-	(erase-buffer)
-	(if (not (file-exists-p nov-file))
-	    (insert (format "211 0 0 0 %s\n" group))
-	  (insert-file-contents nov-file)
-	  (if (zerop (buffer-size))
-	      (insert (format "211 0 0 0 %s\n" group))
-	    (goto-char (point-min))
-	    (and (looking-at "[0-9]+") (setq beg (read (current-buffer))))
-	    (goto-char (point-max))
-	    (and (re-search-backward "^[0-9]" nil t)
-		 (setq end (read (current-buffer))))
-	    (setq total (count-lines (point-min) (point-max)))
-	    (erase-buffer)
-	    (insert (format "211 %d %d %d %s\n" total beg end group)))))))
-  t)
-
-(deffoo nnkiboze-close-group (group &optional server)
-  (nnkiboze-possibly-change-newsgroups group)
-  ;; Remove NOV lines of articles that are marked as read.
-  (when (and (file-exists-p (nnkiboze-nov-file-name))
-	     nnkiboze-remove-read-articles
-	     (eq major-mode 'gnus-summary-mode))
-    (save-excursion
-      (let ((unreads gnus-newsgroup-unreads)
-	    (unselected gnus-newsgroup-unselected)
-            (version-control 'never))
-	(set-buffer (get-buffer-create "*nnkiboze work*"))
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)
-	(let ((cur (current-buffer))
-	      article)
-	  (insert-file-contents (nnkiboze-nov-file-name))
-	  (goto-char (point-min))
-	  (while (looking-at "[0-9]+")
-	    (if (or (memq (setq article (read cur)) unreads)
-		    (memq article unselected))
-		(forward-line 1)
-	      (delete-region (progn (beginning-of-line) (point))
-			     (progn (forward-line 1) (point)))))
-	  (write-file (nnkiboze-nov-file-name))
-	  (kill-buffer (current-buffer)))))
-    (setq nnkiboze-current-group nil)))
-
-(deffoo nnkiboze-request-list (&optional server) 
-  (nnheader-report 'nnkiboze "LIST is not implemented."))
-
-(deffoo nnkiboze-request-newgroups (date &optional server)
-  "List new groups."
-  (nnheader-report 'nnkiboze "NEWGROUPS is not supported."))
-
-(deffoo nnkiboze-request-list-newsgroups (&optional server)
-  (nnheader-report 'nnkiboze "LIST NEWSGROUPS is not implemented."))
-
-(deffoo nnkiboze-request-delete-group (group &optional force server)
-  (nnkiboze-possibly-change-newsgroups group)
-  (when force
-     (let ((files (list (nnkiboze-nov-file-name)
-			(concat nnkiboze-directory group ".newsrc")
-			(nnkiboze-score-file group))))
-       (while files
-	 (and (file-exists-p (car files))
-	      (file-writable-p (car files))
-	      (delete-file (car files)))
-	 (setq files (cdr files)))))
-  (setq nnkiboze-current-group nil))
-
-
-;;; Internal functions.
-
-(defun nnkiboze-possibly-change-newsgroups (group)
-  (setq nnkiboze-current-group group))
-
-(defun nnkiboze-prefixed-name (group)
-  (gnus-group-prefixed-name group '(nnkiboze "")))
-
-;;;###autoload
-(defun nnkiboze-generate-groups ()
-  "Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups
-Finds out what articles are to be part of the nnkiboze groups."
-  (interactive)
-  (let ((nnmail-spool-file nil)
-	(gnus-use-dribble-file nil)
-	(gnus-read-active-file t)
-	(gnus-expert-user t))
-    (gnus))
-  (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist))
-	 (newsrc gnus-newsrc-alist)
-	 gnus-newsrc-hashtb)
-    (gnus-make-hashtable-from-newsrc-alist)
-    ;; We have copied all the newsrc alist info over to local copies
-    ;; so that we can mess all we want with these lists.
-    (while newsrc
-      (if (string-match "nnkiboze" (caar newsrc))
-	  ;; For each kiboze group, we call this function to generate
-	  ;; it.  
-	  (nnkiboze-generate-group (caar newsrc)))
-      (setq newsrc (cdr newsrc)))))
-
-(defun nnkiboze-score-file (group)
-  (list (expand-file-name
-	 (concat (file-name-as-directory gnus-kill-files-directory)
-		 (nnheader-translate-file-chars
-		  (concat nnkiboze-current-score-group 
-			  "." gnus-score-file-suffix))))))
-
-(defun nnkiboze-generate-group (group) 
-  (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
-	 (newsrc-file (concat nnkiboze-directory group ".newsrc"))
-	 (nov-file (concat nnkiboze-directory group ".nov"))
-	 (regexp (nth 1 (nth 4 info)))
-	 (gnus-expert-user t)
-	 (gnus-large-newsgroup nil)
-	 (version-control 'never)
-	 (gnus-score-find-score-files-function 'nnkiboze-score-file)
- 	 gnus-select-group-hook gnus-summary-prepare-hook 
-	 gnus-thread-sort-functions gnus-show-threads 
-	 gnus-visual
-	 method nnkiboze-newsrc nov-buffer gname newsrc active
-	 ginfo lowest glevel)
-    (setq nnkiboze-current-score-group group)
-    (or info (error "No such group: %s" group))
-    ;; Load the kiboze newsrc file for this group.
-    (and (file-exists-p newsrc-file) (load newsrc-file))
-    ;; We also load the nov file for this group.
-    (save-excursion
-      (set-buffer (setq nov-buffer (find-file-noselect nov-file)))
-      (buffer-disable-undo (current-buffer)))
-    ;; Go through the active hashtb and add new all groups that match the 
-    ;; kiboze regexp.
-    (mapatoms
-     (lambda (group)
-       (and (string-match regexp (setq gname (symbol-name group))) ; Match
-	    (not (assoc gname nnkiboze-newsrc)) ; It isn't registered
-	    (numberp (car (symbol-value group))) ; It is active
-	    (or (> nnkiboze-level 7)
-		(and (setq glevel (nth 1 (nth 2 (gnus-gethash
-						 gname gnus-newsrc-hashtb))))
-		     (>= nnkiboze-level glevel)))
-	    (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
-	    (setq nnkiboze-newsrc 
-		  (cons (cons gname (1- (car (symbol-value group))))
-			nnkiboze-newsrc))))
-     gnus-active-hashtb)
-    ;; `newsrc' is set to the list of groups that possibly are
-    ;; component groups to this kiboze group.  This list has elements
-    ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
-    ;; number that has been kibozed in GROUP in this kiboze group.
-    (setq newsrc nnkiboze-newsrc)
-    (while newsrc
-      (if (not (setq active (gnus-gethash 
-			     (caar newsrc) gnus-active-hashtb)))
-	  ;; This group isn't active after all, so we remove it from
-	  ;; the list of component groups.
-	  (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
-	(setq lowest (cdar newsrc))
-	;; Ok, we have a valid component group, so we jump to it. 
-	(switch-to-buffer gnus-group-buffer)
-	(gnus-group-jump-to-group (caar newsrc))
-	;; We set all list of article marks to nil.  Since we operate
-	;; on copies of the real lists, we can destroy anything we
-	;; want here.
-	(and (setq ginfo (nth 2 (gnus-gethash (gnus-group-group-name)
-					      gnus-newsrc-hashtb)))
-	     (nth 3 ginfo)
-	     (setcar (nthcdr 3 ginfo) nil))
-	;; We set the list of read articles to be what we expect for
-	;; this kiboze group -- either nil or `(1 . LOWEST)'. 
-	(and ginfo (setcar (nthcdr 2 ginfo)
-			   (and (not (= lowest 1)) (cons 1 lowest))))
-	(if (not (and (or (not ginfo)
-			  (> (length (gnus-list-of-unread-articles 
-				      (car ginfo))) 0))
-		      (progn
-			(gnus-group-select-group nil)
-			(eq major-mode 'gnus-summary-mode))))
-	    () ; No unread articles, or we couldn't enter this group.
-	  ;; We are now in the group where we want to be.
-	  (setq method (gnus-find-method-for-group gnus-newsgroup-name))
-	  (and (eq method gnus-select-method) (setq method nil))
-	  ;; We go through the list of scored articles.
-	  (while gnus-newsgroup-scored
-	    (if (> (caar gnus-newsgroup-scored) lowest)
-		;; If it has a good score, then we enter this article
-		;; into the kiboze group.
-		(nnkiboze-enter-nov 
-		 nov-buffer
-		 (gnus-summary-article-header 
-		  (caar gnus-newsgroup-scored))
-		 (if method
-		     (gnus-group-prefixed-name gnus-newsgroup-name method)
-		   gnus-newsgroup-name)))
-	    (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
-	  ;; That's it.  We exit this group.
-	  (gnus-summary-exit-no-update)))
-      (setcdr (car newsrc) (car active))
-      (setq newsrc (cdr newsrc)))
-    ;; We save the nov file.
-    (set-buffer nov-buffer)
-    (save-buffer)
-    (kill-buffer (current-buffer))
-    ;; We save the kiboze newsrc for this group.
-    (set-buffer (get-buffer-create "*nnkiboze work*"))
-    (buffer-disable-undo (current-buffer))
-    (erase-buffer)
-    (insert "(setq nnkiboze-newsrc '" (prin1-to-string nnkiboze-newsrc)
-	    ")\n")
-    (write-file newsrc-file)
-    (kill-buffer (current-buffer))
-    (switch-to-buffer gnus-group-buffer)
-    (gnus-group-list-groups 5 nil)))
-    
-(defun nnkiboze-enter-nov (buffer header group)
-  (save-excursion
-    (set-buffer buffer)
-    (goto-char (point-max))
-    (let ((xref (mail-header-xref header))
-	  (prefix (gnus-group-real-prefix group))
-	  (first t)
-	  article)
-      (if (zerop (forward-line -1))
-	  (progn
-	    (setq article (1+ (read (current-buffer))))
-	    (forward-line 1))
-	(setq article 1))
-      (insert (int-to-string article) "\t"
-	      (or (mail-header-subject header) "") "\t"
-	      (or (mail-header-from header) "") "\t"
-	      (or (mail-header-date header) "") "\t"
-	      (or (mail-header-id header) "") "\t"
-	      (or (mail-header-references header) "") "\t"
-	      (int-to-string (or (mail-header-chars header) 0)) "\t"
-	      (int-to-string (or (mail-header-lines header) 0)) "\t")
-      (if (or (not xref) (equal "" xref))
-	  (insert "Xref: " (system-name) " " group ":" 
-		  (int-to-string (mail-header-number header))
-		  "\t\n")
-	(insert (mail-header-xref header) "\t\n")
-	(search-backward "\t" nil t)
-	(search-backward "\t" nil t)
-	(while (re-search-forward 
-		"[^ ]+:[0-9]+"
-		(save-excursion (end-of-line) (point)) t)
-	  (if first
-	      ;; The first xref has to be the group this article
-	      ;; really came for - this is the article nnkiboze
-	      ;; will request when it is asked for the article.
-	      (save-excursion
-		(goto-char (match-beginning 0))
-		(insert prefix group ":" 
-			(int-to-string (mail-header-number header)) " ")
-		(setq first nil)))
-	  (save-excursion
-	    (goto-char (match-beginning 0))
-	    (insert prefix)))))))
-
-(defun nnkiboze-nov-file-name ()
-  (concat (file-name-as-directory nnkiboze-directory)
-	  (nnheader-translate-file-chars
-	   (concat (nnkiboze-prefixed-name nnkiboze-current-group) ".nov"))))
-
-(provide 'nnkiboze)
-
-;;; nnkiboze.el ends here
diff --git a/lisp/nnmail.el b/lisp/nnmail.el
deleted file mode 100644
index d108d590dad..00000000000
--- a/lisp/nnmail.el
+++ /dev/null
@@ -1,1201 +0,0 @@
-;;; nnmail.el --- mail support functions for the Gnus mail backends
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news, mail
-
-;; 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:
-
-(require 'nnheader)
-(require 'timezone)
-(require 'message)
-(eval-when-compile (require 'cl))
-
-(defvar nnmail-split-methods
-  '(("mail.misc" ""))
-  "*Incoming mail will be split according to this variable.
-
-If you'd like, for instance, one mail group for mail from the
-\"4ad-l\" mailing list, one group for junk mail and one for everything
-else, you could do something like this:
-
- (setq nnmail-split-methods
-       '((\"mail.4ad\" \"From:.*4ad\")
-         (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
-         (\"mail.misc\" \"\")))
-
-As you can see, this variable is a list of lists, where the first
-element in each \"rule\" is the name of the group (which, by the way,
-does not have to be called anything beginning with \"mail\",
-\"yonka.zow\" is a fine, fine name), and the second is a regexp that
-nnmail will try to match on the header to find a fit.
-
-The second element can also be a function.  In that case, it will be
-called narrowed to the headers with the first element of the rule as
-the argument.  It should return a non-nil value if it thinks that the
-mail belongs in that group.
-
-The last element should always have \"\" as the regexp.
-
-This variable can also have a function as its value.")
-
-;; Suggested by Erik Selberg <speed@cs.washington.edu>.
-(defvar nnmail-crosspost t
-  "*If non-nil, do crossposting if several split methods match the mail.
-If nil, the first match found will be used.")
-
-;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
-(defvar nnmail-keep-last-article nil
-  "*If non-nil, nnmail will never delete the last expired article in a directory.  
-You may need to set this variable if other programs are putting
-new mail into folder numbers that Gnus has marked as expired.")
-
-(defvar nnmail-use-long-file-names nil
-  "*If non-nil the mail backends will use long file and directory names.
-If nil, groups like \"mail.misc\" will end up in directories like
-\"mail/misc/\".")
-
-(defvar nnmail-expiry-wait 7
-  "*Expirable articles that are older than this will be expired.
-This variable can either be a number (which will be interpreted as a
-number of days) -- this doesn't have to be an integer.  This variable
-can also be `immediate' and `never'.")
-
-(defvar nnmail-expiry-wait-function nil
-  "*Variable that holds function to specify how old articles should be before they are expired.
-  The function will be called with the name of the group that the
-expiry is to be performed in, and it should return an integer that
-says how many days an article can be stored before it is considered
-\"old\".  It can also return the values `never' and `immediate'.
-
-Eg.:
-
-(setq nnmail-expiry-wait-function
-      (lambda (newsgroup)
-        (cond ((string-match \"private\" newsgroup) 31)
-              ((string-match \"junk\" newsgroup) 1)
-	      ((string-match \"important\" newsgroup) 'never)
-	      (t 7))))")
-
-(defvar nnmail-spool-file 
-  (or (getenv "MAIL")
-      (concat "/usr/spool/mail/" (user-login-name)))
-  "Where the mail backends will look for incoming mail.
-This variable is \"/usr/spool/mail/$user\" by default.
-If this variable is nil, no mail backends will read incoming mail.
-If this variable is a list, all files mentioned in this list will be
-used as incoming mailboxes.")
-
-(defvar nnmail-crash-box "~/.gnus-crash-box"
-  "*File where Gnus will store mail while processing it.")
-
-(defvar nnmail-use-procmail nil
-  "*If non-nil, the mail backends will look in `nnmail-procmail-directory' for spool files.
-The file(s) in `nnmail-spool-file' will also be read.")
-
-(defvar nnmail-procmail-directory "~/incoming/"
-  "*When using procmail (and the like), incoming mail is put in this directory.
-The Gnus mail backends will read the mail from this directory.")
-
-(defvar nnmail-procmail-suffix "\\.spool"
-  "*Suffix of files created by procmail (and the like).
-This variable might be a suffix-regexp to match the suffixes of
-several files - eg. \".spool[0-9]*\".")
-
-(defvar nnmail-resplit-incoming nil
-  "*If non-nil, re-split incoming procmail sorted mail.")
-
-(defvar nnmail-delete-file-function 'delete-file
-  "Function called to delete files in some mail backends.")
-
-(defvar nnmail-crosspost-link-function 'add-name-to-file
-  "Function called to create a copy of a file.
-This is `add-name-to-file' by default, which means that crossposts
-will use hard links.  If your file system doesn't allow hard
-links, you could set this variable to `copy-file' instead.")
-
-(defvar nnmail-movemail-program "movemail"
-  "*A command to be executed to move mail from the inbox.
-The default is \"movemail\".")
-
-(defvar nnmail-pop-password-required nil
-  "*Non-nil if a password is required when reading mail using POP.")
-
-(defvar nnmail-read-incoming-hook nil
-  "*Hook that will be run after the incoming mail has been transferred.
-The incoming mail is moved from `nnmail-spool-file' (which normally is
-something like \"/usr/spool/mail/$user\") to the user's home
-directory. This hook is called after the incoming mail box has been
-emptied, and can be used to call any mail box programs you have
-running (\"xwatch\", etc.)
-
-Eg.
-
-\(add-hook 'nnmail-read-incoming-hook 
-	   (lambda () 
-	     (start-process \"mailsend\" nil 
-			    \"/local/bin/mailsend\" \"read\" \"mbox\")))
-
-If you have xwatch running, this will alert it that mail has been
-read.  
-
-If you use `display-time', you could use something like this:
-
-\(add-hook 'nnmail-read-incoming-hook
-	  (lambda ()
-	    ;; Update the displayed time, since that will clear out
-	    ;; the flag that says you have mail.
-	    (if (eq (process-status \"display-time\") 'run)
-		(display-time-filter display-time-process \"\"))))") 
-
-(when (eq system-type 'windows-nt)
-  (add-hook 'nnmail-prepare-incoming-hook 'nnheader-ms-strip-cr))
-
-;; Suggested by Erik Selberg <speed@cs.washington.edu>.
-(defvar nnmail-prepare-incoming-hook nil
-  "*Hook called before treating incoming mail.
-The hook is run in a buffer with all the new, incoming mail.")
-
-(defvar nnmail-pre-get-new-mail-hook nil
-  "Hook called just before starting to handle new incoming mail.")
-
-(defvar nnmail-post-get-new-mail-hook nil
-  "Hook called just after finishing handling new incoming mail.")
-
-;; Suggested by Mejia Pablo J <pjm9806@usl.edu>.
-(defvar nnmail-tmp-directory nil
-  "*If non-nil, use this directory for temporary storage when reading incoming mail.")
-
-(defvar nnmail-large-newsgroup 50
-  "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
-messages will be shown to indicate the current status.")
-
-(defvar nnmail-split-fancy "mail.misc"
-  "*Incoming mail can be split according to this fancy variable.
-To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
-
-The format is this variable is SPLIT, where SPLIT can be one of
-the following:
-
-GROUP: Mail will be stored in GROUP (a string).
-
-\(FIELD VALUE SPLIT): If the message field FIELD (a regexp) contains
-  VALUE (a regexp), store the messages as specified by SPLIT.
-
-\(| SPLIT...): Process each SPLIT expression until one of them matches.
-  A SPLIT expression is said to match if it will cause the mail
-  message to be stored in one or more groups.  
-
-\(& SPLIT...): Process each SPLIT expression.
-
-FIELD must match a complete field name.  VALUE must match a complete
-word according to the `nnmail-split-fancy-syntax-table' syntax table.
-You can use .* in the regexps to match partial field names or words.
-
-FIELD and VALUE can also be lisp symbols, in that case they are expanded
-as specified in `nnmail-split-abbrev-alist'.
-
-Example:
-
-\(setq nnmail-split-methods 'nnmail-split-fancy
-      nnmail-split-fancy
-      ;; Messages from the mailer deamon are not crossposted to any of
-      ;; the ordinary groups.  Warnings are put in a separate group
-      ;; from real errors.
-      '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
-			  \"mail.misc\"))
-	  ;; Non-error messages are crossposted to all relevant
-	  ;; groups, but we don't crosspost between the group for the
-	  ;; (ding) list and the group for other (ding) related mail.
-	  (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
-		(\"subject\" \"ding\" \"ding.misc\"))
-	     ;; Other mailing lists...
-	     (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
-	     (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
-	     ;; People...
-	     (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
-	  ;; Unmatched mail goes to the catch all group.
-	  \"misc.misc\"))")
-
-(defvar nnmail-split-abbrev-alist
-  '((any . "from\\|to\\|cc\\|sender\\|apparently-to")
-    (mail . "mailer-daemon\\|postmaster"))
-  "*Alist of abbreviations allowed in `nnmail-split-fancy'.")
-
-(defvar nnmail-delete-incoming t
-  "*If non-nil, the mail backends will delete incoming files after splitting.")
-
-(defvar nnmail-message-id-cache-length 1000
-  "*The approximate number of Message-IDs nnmail will keep in its cache.
-If this variable is nil, no checking on duplicate messages will be
-performed.")
-
-(defvar nnmail-message-id-cache-file "~/.nnmail-cache"
-  "*The file name of the nnmail Message-ID cache.")
-
-(defvar nnmail-treat-duplicates 'warn
-  "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
-Three values are legal: nil, which means that nnmail is not to keep a
-Message-ID cache; `warn', which means that nnmail should insert extra
-headers to warn the user about the duplication (this is the default);
-and `delete', which means that nnmail will delete duplicated mails.
-
-This variable can also be a function.  It will be called from a buffer
-narrowed to the article in question with the Message-ID as a
-parameter.  It should return nil, `warn' or `delete'.")
-
-;;; Internal variables.
-
-(defvar nnmail-pop-password nil
-  "*Password to use when reading mail from a POP server, if required.")
-
-(defvar nnmail-split-fancy-syntax-table
-  (copy-syntax-table (standard-syntax-table))
-  "Syntax table used by `nnmail-split-fancy'.")
-
-(defvar nnmail-prepare-save-mail-hook nil
-  "Hook called before saving mail.")
-
-(defvar nnmail-moved-inboxes nil
-  "List of inboxes that have been moved.")
-
-(defvar nnmail-internal-password nil)
-
-
-
-(defconst nnmail-version "nnmail 1.0"
-  "nnmail version.")
-
-
-
-(defun nnmail-request-post (&optional server)
-  (mail-send-and-exit nil))
-
-(defun nnmail-find-file (file)
-  "Insert FILE in server buffer safely."
-  (set-buffer nntp-server-buffer)
-  (erase-buffer)
-  (let ((format-alist nil)
-        (after-insert-file-functions nil))
-    (condition-case ()
-	(progn (insert-file-contents file) t)
-      (file-error nil))))
-
-(defun nnmail-group-pathname (group dir &optional file)
-  "Make pathname for GROUP."
-  (concat
-   (let ((dir (file-name-as-directory (expand-file-name dir))))
-     ;; If this directory exists, we use it directly.
-     (if (or nnmail-use-long-file-names 
-	     (file-directory-p (concat dir group)))
-	 (concat dir group "/")
-       ;; If not, we translate dots into slashes.
-       (concat dir (nnheader-replace-chars-in-string group ?. ?/) "/")))
-   (or file "")))
-  
-(defun nnmail-date-to-time (date)
-  "Convert DATE into time."
-  (let* ((d1 (timezone-parse-date date))
-	 (t1 (timezone-parse-time (aref d1 3))))
-    (apply 'encode-time
-	   (mapcar (lambda (el)
-		     (and el (string-to-number el)))
-		   (list
-		    (aref t1 2) (aref t1 1) (aref t1 0)
-		    (aref d1 2) (aref d1 1) (aref d1 0)
-		    (aref d1 4))))))
-
-(defun nnmail-time-less (t1 t2)
-  "Say whether time T1 is less than time T2."
-  (or (< (car t1) (car t2))
-      (and (= (car t1) (car t2))
-	   (< (nth 1 t1) (nth 1 t2)))))
-
-(defun nnmail-days-to-time (days)
-  "Convert DAYS into time."
-  (let* ((seconds (* 1.0 days 60 60 24))
-	 (rest (expt 2 16))
-	 (ms (condition-case nil (round (/ seconds rest)) 
-	       (range-error (expt 2 16)))))
-    (list ms (condition-case nil (round (- seconds (* ms rest)))
-	       (range-error (expt 2 16))))))
-
-(defun nnmail-time-since (time)
-  "Return the time since TIME, which is either an internal time or a date."
-  (when (stringp time)
-    ;; Convert date strings to internal time.
-    (setq time (nnmail-date-to-time time)))
-  (let* ((current (current-time))
-	 (rest (if (< (nth 1 current) (nth 1 time)) (expt 2 16))))
-    (list (- (+ (car current) (if rest -1 0)) (car time))
-	  (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
-
-;; Function rewritten from rmail.el.
-(defun nnmail-move-inbox (inbox)
-  "Move INBOX to `nnmail-crash-box'."
-  (let ((inbox (file-truename
-		(expand-file-name (substitute-in-file-name inbox))))
-	(tofile (file-truename (expand-file-name 
-				(substitute-in-file-name nnmail-crash-box))))
-	movemail popmail errors password)
-    ;; If getting from mail spool directory,
-    ;; use movemail to move rather than just renaming,
-    ;; so as to interlock with the mailer.
-    (unless (setq popmail (string-match "^po:" (file-name-nondirectory inbox)))
-      (setq movemail t))
-    (when popmail 
-      (setq inbox (file-name-nondirectory inbox)))
-    (when (and movemail
-	       ;; On some systems, /usr/spool/mail/foo is a directory
-	       ;; and the actual inbox is /usr/spool/mail/foo/foo.
-	       (file-directory-p inbox))
-      (setq inbox (expand-file-name (user-login-name) inbox)))
-    (if (member inbox nnmail-moved-inboxes)
-	nil
-      (if popmail
-	  (progn
-	    (setq nnmail-internal-password nnmail-pop-password)
-	    (when (and nnmail-pop-password-required (not nnmail-pop-password))
-	      (setq nnmail-internal-password
-		    (nnmail-read-passwd
-		     (format "Password for %s: "
-			     (substring inbox (+ popmail 3))))))
-	    (message "Getting mail from post office ..."))
-	(when (or (and (file-exists-p tofile)
-		       (/= 0 (nnheader-file-size tofile)))
-		  (and (file-exists-p inbox)
-		       (/= 0 (nnheader-file-size inbox))))
-	  (message "Getting mail from %s..." inbox)))
-      ;; Set TOFILE if have not already done so, and
-      ;; rename or copy the file INBOX to TOFILE if and as appropriate.
-      (cond 
-       ((file-exists-p tofile)
-	;; The crash box exists already.
-	t)
-       ((and (not popmail)
-	     (not (file-exists-p inbox)))
-	;; There is no inbox.
-	(setq tofile nil))
-       ((and (not movemail) (not popmail))
-	;; Try copying.  If that fails (perhaps no space),
-	;; rename instead.
-	(condition-case nil
-	    (copy-file inbox tofile nil)
-	  (error
-	   ;; Third arg is t so we can replace existing file TOFILE.
-	   (rename-file inbox tofile t)))
-	(push inbox nnmail-moved-inboxes)
-	;; Make the real inbox file empty.
-	;; Leaving it deleted could cause lossage
-	;; because mailers often won't create the file.
-	(condition-case ()
-	    (write-region (point) (point) inbox)
-	  (file-error nil)))
-       (t
-	;; Use movemail.
-	(unwind-protect
-	    (save-excursion
-	      (setq errors (generate-new-buffer " *nnmail loss*"))
-	      (buffer-disable-undo errors)
-	      (let ((default-directory "/"))
-		(apply 
-		 'call-process
-		 (append
-		  (list
-		   (expand-file-name nnmail-movemail-program exec-directory)
-		   nil errors nil inbox tofile)
-		  (when nnmail-internal-password
-		    (list nnmail-internal-password)))))
-	      (if (not (buffer-modified-p errors))
-		  ;; No output => movemail won
-		  (push inbox nnmail-moved-inboxes)
-		(set-buffer errors)
-		(subst-char-in-region (point-min) (point-max) ?\n ?\  )
-		(goto-char (point-max))
-		(skip-chars-backward " \t")
-		(delete-region (point) (point-max))
-		(goto-char (point-min))
-		(if (looking-at "movemail: ")
-		    (delete-region (point-min) (match-end 0)))
-		(beep t)
-		(message (concat "movemail: "
-				 (buffer-substring (point-min)
-						   (point-max))))
-		(sit-for 3)
-		(setq tofile nil))))))
-      (and errors
-	   (buffer-name errors)
-	   (kill-buffer errors))
-      tofile)))
-
-(defun nnmail-get-active ()
-  "Returns an assoc of group names and active ranges.
-nn*-request-list should have been called before calling this function."
-  (let (group-assoc)
-    ;; Go through all groups from the active list.
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (goto-char (point-min))
-      (while (re-search-forward 
-	      "^\\([^ \t]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)" nil t)
-	;; We create an alist with `(GROUP (LOW . HIGH))' elements.
-	(push (list (match-string 1)
-		    (cons (string-to-int (match-string 3))
-			  (string-to-int (match-string 2))))
-	      group-assoc)))
-    group-assoc))
-
-(defun nnmail-save-active (group-assoc file-name)
-  "Save GROUP-ASSOC in ACTIVE-FILE."
-  (when file-name
-    (let (group)
-      (save-excursion
-	(set-buffer (get-buffer-create " *nnmail active*"))
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)
-	(while group-assoc
-	  (setq group (pop group-assoc))
-	  (insert (format "%s %d %d y\n" (car group) (cdadr group) 
-			  (caadr group))))
-	(unless (file-exists-p (file-name-directory file-name))
-	  (make-directory (file-name-directory file-name) t))
-	(write-region 1 (point-max) (expand-file-name file-name) nil 'nomesg)
-	(kill-buffer (current-buffer))))))
-
-(defun nnmail-get-split-group (file group)
-  (if (or (eq nnmail-spool-file 'procmail)
-	  nnmail-use-procmail)
-      (cond (group group)
-	    ((string-match (concat "^" (expand-file-name
-					(file-name-as-directory
-					 nnmail-procmail-directory))
-				   "\\([^/]*\\)" nnmail-procmail-suffix "$")
-			   (expand-file-name file))
-	     (substring (expand-file-name file)
-			(match-beginning 1) (match-end 1)))
-	    (t
-	     group))
-    group))
-
-(defun nnmail-process-babyl-mail-format (func)
-  (let ((case-fold-search t)
-	start message-id content-length do-search end)
-    (while (not (eobp))
-      (goto-char (point-min))
-      (re-search-forward
-       "\n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
-      (goto-char (match-end 0))
-      (delete-region (match-beginning 0) (match-end 0))
-      (setq start (point))
-      ;; Skip all the headers in case there are more "From "s...
-      (or (search-forward "\n\n" nil t)
-	  (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
-	  (search-forward ""))
-      ;; Find the Message-ID header.
-      (save-excursion
-	(if (re-search-backward "^Message-ID:[ \t]*\\(<[^>]*>\\)" nil t)
-	    (setq message-id (buffer-substring (match-beginning 1)
-					       (match-end 1)))
-	  ;; There is no Message-ID here, so we create one.
-	  (save-excursion
-	    (when (re-search-backward "^Message-ID:" nil t)
-	      (beginning-of-line)
-	      (insert "Original-")))
-	  (forward-line -1)
-	  (insert "Message-ID: " (setq message-id (nnmail-message-id))
-		  "\n")))
-      ;; Look for a Content-Length header.
-      (if (not (save-excursion
-		 (and (re-search-backward 
-		       "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
-		      (setq content-length (string-to-int
-					    (buffer-substring 
-					     (match-beginning 1)
-					     (match-end 1))))
-		      ;; We destroy the header, since none of
-		      ;; the backends ever use it, and we do not
-		      ;; want to confuse other mailers by having
-		      ;; a (possibly) faulty header.
-		      (progn (insert "X-") t))))
-	  (setq do-search t)
-	(if (or (= (+ (point) content-length) (point-max))
-		(save-excursion
-		  (goto-char (+ (point) content-length))
-		  (looking-at "")))
-	    (progn
-	      (goto-char (+ (point) content-length))
-	      (setq do-search nil))
-	  (setq do-search t)))
-      ;; Go to the beginning of the next article - or to the end
-      ;; of the buffer.  
-      (if do-search
-	  (if (re-search-forward "^" nil t)
-	      (goto-char (match-beginning 0))
-	    (goto-char (1- (point-max)))))
-      (delete-char 1)			; delete ^_
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region start (point))
-	  (goto-char (point-min))
-	  (nnmail-check-duplication message-id func)
-	  (setq end (point-max))))
-      (goto-char end))))
-
-(defun nnmail-search-unix-mail-delim ()
-  "Put point at the beginning of the next message."
-  (let ((case-fold-search t)
-	(delim (concat "^" message-unix-mail-delimiter))
-	found)
-    (while (not found)
-      (if (re-search-forward delim nil t)
-	  (when (or (looking-at "[^\n :]+ *:")
-		    (looking-at delim)
-		    (looking-at (concat ">" message-unix-mail-delimiter)))
-	    (forward-line -1)
-	    (setq found 'yes))
-	(setq found 'no)))
-    (eq found 'yes)))
-
-(defun nnmail-process-unix-mail-format (func)
-  (let ((case-fold-search t)
-	(delim (concat "^" message-unix-mail-delimiter))
-	start message-id content-length end skip head-end)
-    (goto-char (point-min))
-    (if (not (and (re-search-forward delim nil t)
-		  (goto-char (match-beginning 0))))
-	;; Possibly wrong format?
-	(error "Error, unknown mail format! (Possibly corrupted.)")
-      ;; Carry on until the bitter end.
-      (while (not (eobp))
-	(setq start (point)
-	      end nil)
-	;; Find the end of the head.
-	(narrow-to-region
-	 start 
-	 (if (search-forward "\n\n" nil t)
-	     (1- (point))
-	   ;; This will never happen, but just to be on the safe side --
-	   ;; if there is no head-body delimiter, we search a bit manually.
-	   (while (and (looking-at "From \\|[^ \t]+:")
-		       (not (eobp)))
-	     (forward-line 1)
-	     (point))))
-	;; Find the Message-ID header.
-	(goto-char (point-min))
-	(if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
-	    (setq message-id (match-string 1))
-	  (save-excursion
-	    (when (re-search-forward "^Message-ID:" nil t)
-	      (beginning-of-line)
-	      (insert "Original-")))
-	  ;; There is no Message-ID here, so we create one.
-	  (forward-line 1)
-	  (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
-	;; Look for a Content-Length header.
-	(goto-char (point-min))
-	(if (not (re-search-forward
-		  "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
-	    (setq content-length nil)
-	  (setq content-length (string-to-int (match-string 1)))
-	  ;; We destroy the header, since none of the backends ever 
-	  ;; use it, and we do not want to confuse other mailers by
-	  ;; having a (possibly) faulty header.
-	  (beginning-of-line)
-	  (insert "X-"))
-	;; Find the end of this article.
-	(goto-char (point-max))
-	(widen)
-	(setq head-end (point))
-	;; We try the Content-Length value.  The idea: skip over the header
-	;; separator, then check what happens content-length bytes into the
-	;; message body.  This should be either the end ot the buffer, the
-	;; message separator or a blank line followed by the separator.
-	;; The blank line should probably be deleted.  If neither of the
-	;; three is met, the content-length header is probably invalid.
-	(when content-length
-	  (forward-line 1)
-	  (setq skip (+ (point) content-length))
-	  (goto-char skip)
-	  (cond ((or (= skip (point-max))
-		     (= (1+ skip) (point-max)))
-		 (setq end (point-max)))
-		((looking-at delim)
-		 (setq end skip))
-		((looking-at
-		  (concat "[ \t]*\n\\(" delim "\\)"))
-		 (setq end (match-beginning 1)))
-		(t (setq end nil))))
-	(if end
-	    (goto-char end)
-	  ;; No Content-Length, so we find the beginning of the next 
-	  ;; article or the end of the buffer.
-	  (goto-char head-end)
-	  (or (nnmail-search-unix-mail-delim)
-	      (goto-char (point-max))))
-	;; Allow the backend to save the article.
-	(save-excursion
-	  (save-restriction
-	    (narrow-to-region start (point))
-	    (goto-char (point-min))
-	    (nnmail-check-duplication message-id func)
-	    (setq end (point-max))))
-	(goto-char end)))))
-
-(defun nnmail-process-mmdf-mail-format (func)
-  (let ((delim "^\^A\^A\^A\^A$")
-	(case-fold-search t)
-	start message-id end)
-    (goto-char (point-min))
-    (if (not (and (re-search-forward delim nil t)
-		  (forward-line 1)))
-	;; Possibly wrong format?
-	(error "Error, unknown mail format! (Possibly corrupted.)")
-      ;; Carry on until the bitter end.
-      (while (not (eobp))
-	(setq start (point))
-	;; Find the end of the head.
-	(narrow-to-region
-	 start 
-	 (if (search-forward "\n\n" nil t)
-	     (1- (point))
-	   ;; This will never happen, but just to be on the safe side --
-	   ;; if there is no head-body delimiter, we search a bit manually.
-	   (while (and (looking-at "From \\|[^ \t]+:")
-		       (not (eobp)))
-	     (forward-line 1)
-	     (point))))
-	;; Find the Message-ID header.
-	(goto-char (point-min))
-	(if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
-	    (setq message-id (match-string 1))
-	  ;; There is no Message-ID here, so we create one.
-	  (save-excursion
-	    (when (re-search-backward "^Message-ID:" nil t)
-	      (beginning-of-line)
-	      (insert "Original-")))
-	  (forward-line 1)
-	  (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
-	;; Find the end of this article.
-	(goto-char (point-max))
-	(widen)
-	(if (re-search-forward delim nil t)
-	    (beginning-of-line)
-	  (goto-char (point-max)))
-	;; Allow the backend to save the article.
-	(save-excursion
-	  (save-restriction
-	    (narrow-to-region start (point))
-	    (goto-char (point-min))
-	    (nnmail-check-duplication message-id func)
-	    (setq end (point-max))))
-	(goto-char end)
-	(forward-line 2)))))
-
-(defun nnmail-split-incoming (incoming func &optional exit-func group)
-  "Go through the entire INCOMING file and pick out each individual mail.
-FUNC will be called with the buffer narrowed to each mail."
-  (let (;; If this is a group-specific split, we bind the split
-	;; methods to just this group.
-	(nnmail-split-methods (if (and group
-				       (or (eq nnmail-spool-file 'procmail)
-					   nnmail-use-procmail)
-				       (not nnmail-resplit-incoming))
-				  (list (list group ""))
-				nnmail-split-methods)))
-    (save-excursion
-      ;; Insert the incoming file.
-      (set-buffer (get-buffer-create " *nnmail incoming*"))
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (nnheader-insert-file-contents-literally incoming)
-      (unless (zerop (buffer-size))
-	(goto-char (point-min))
-	(save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
-	;; Handle both babyl, MMDF and unix mail formats, since movemail will
-	;; use the former when fetching from a mailbox, the latter when
-	;; fetches from a file.
-	(cond ((or (looking-at "\^L")
-		   (looking-at "BABYL OPTIONS:"))
-	       (nnmail-process-babyl-mail-format func))
-	      ((looking-at "\^A\^A\^A\^A")
-	       (nnmail-process-mmdf-mail-format func))
-	      (t
-	       (nnmail-process-unix-mail-format func))))
-      (if exit-func (funcall exit-func))
-      (kill-buffer (current-buffer)))))
-
-;; Mail crossposts suggested by Brian Edmonds <edmonds@cs.ubc.ca>. 
-(defun nnmail-article-group (func)
-  "Look at the headers and return an alist of groups that match.
-FUNC will be called with the group name to determine the article number."
-  (let ((methods nnmail-split-methods)
-	(obuf (current-buffer))
-	(beg (point-min))
-	end group-art method)
-    (if (and (sequencep methods) (= (length methods) 1))
-	;; If there is only just one group to put everything in, we
-	;; just return a list with just this one method in.
-	(setq group-art
-	      (list (cons (caar methods) (funcall func (caar methods)))))
-      ;; We do actual comparison.
-      (save-excursion
-	;; Find headers.
-	(goto-char beg)
-	(setq end (if (search-forward "\n\n" nil t) (point) (point-max)))
-	(set-buffer nntp-server-buffer)
-	(erase-buffer)
-	;; Copy the headers into the work buffer.
-	(insert-buffer-substring obuf beg end)
-	;; Fold continuation lines.
-	(goto-char (point-min))
-	(while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
-	  (replace-match " " t t))
-	(if (and (symbolp nnmail-split-methods)
-		 (fboundp nnmail-split-methods))
-	    ;; `nnmail-split-methods' is a function, so we just call 
-	    ;; this function here and use the result.
-	    (setq group-art
-		  (mapcar
-		   (lambda (group) (cons group (funcall func group)))
-		   (condition-case nil
-		       (or (funcall nnmail-split-methods)
-			   '("bogus"))
-		     (error
-		      (message 
-		       "Error in `nnmail-split-methods'; using `bogus' mail group")
-		      (sit-for 1)
-		      '("bogus")))))
-	  ;; Go through the split methods to find a match.
-	  (while (and methods (or nnmail-crosspost (not group-art)))
-	    (goto-char (point-max))
-	    (setq method (pop methods))
-	    (if (or methods
-		    (not (equal "" (nth 1 method))))
-		(when (and
-		       (condition-case () 
-			   (if (stringp (nth 1 method))
-			       (re-search-backward (cadr method) nil t)
-			     ;; Function to say whether this is a match.
-			     (funcall (nth 1 method) (car method)))
-			 (error nil))
-		       ;; Don't enter the article into the same 
-		       ;; group twice.
-		       (not (assoc (car method) group-art)))
-		  (push (cons (car method) (funcall func (car method))) 
-			group-art))
-	      ;; This is the final group, which is used as a 
-	      ;; catch-all.
-	      (unless group-art
-		(setq group-art 
-		      (list (cons (car method) 
-				  (funcall func (car method)))))))))
-	group-art))))
-
-(defun nnmail-insert-lines ()
-  "Insert how many lines there are in the body of the mail.
-Return the number of characters in the body."
-  (let (lines chars)
-    (save-excursion
-      (goto-char (point-min))
-      (when (search-forward "\n\n" nil t) 
-	(setq chars (- (point-max) (point)))
-	(setq lines (count-lines (point) (point-max)))
-	(forward-char -1)
-	(save-excursion
-	  (when (re-search-backward "^Lines: " nil t)
-	    (delete-region (point) (progn (forward-line 1) (point)))))
-	(beginning-of-line)
-	(insert (format "Lines: %d\n" (max lines 0)))
-	chars))))
-
-(defun nnmail-insert-xref (group-alist)
-  "Insert an Xref line based on the (group . article) alist."
-  (save-excursion
-    (goto-char (point-min))
-    (when (search-forward "\n\n" nil t) 
-      (forward-char -1)
-      (when (re-search-backward "^Xref: " nil t)
-	(delete-region (match-beginning 0) 
-		       (progn (forward-line 1) (point))))
-      (insert (format "Xref: %s" (system-name)))
-      (while group-alist
-	(insert (format " %s:%d" (caar group-alist) (cdar group-alist)))
-	(setq group-alist (cdr group-alist)))
-      (insert "\n"))))
-
-;; Written by byer@mv.us.adobe.com (Scott Byer).
-(defun nnmail-make-complex-temp-name (prefix)
-  (let ((newname (make-temp-name prefix))
-	(newprefix prefix))
-    (while (file-exists-p newname)
-      (setq newprefix (concat newprefix "x"))
-      (setq newname (make-temp-name newprefix)))
-    newname))
-
-;; Written by Per Abrahamsen <amanda@iesd.auc.dk>.
-
-(defun nnmail-split-fancy ()
-  "Fancy splitting method.
-See the documentation for the variable `nnmail-split-fancy' for documentation."
-  (let ((syntab (syntax-table)))
-    (unwind-protect
-	(progn
-	  (set-syntax-table nnmail-split-fancy-syntax-table)
-	  (nnmail-split-it nnmail-split-fancy))
-      (set-syntax-table syntab))))
-
-(defvar nnmail-split-cache nil)
-;; Alist of split expressions their equivalent regexps.
-
-(defun nnmail-split-it (split)
-  ;; Return a list of groups matching SPLIT.
-  (cond ((stringp split)
-	 ;; A group.
-	 (list split))
-	((eq (car split) '&)
-	 (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
-	((eq (car split) '|)
-	 (let (done)
-	   (while (and (not done) (cdr split))
-	     (setq split (cdr split)
-		   done (nnmail-split-it (car split))))
-	   done))
-	((assq split nnmail-split-cache)
-	 ;; A compiled match expression.
-	 (goto-char (point-max))
-	 (if (re-search-backward (cdr (assq split nnmail-split-cache)) nil t)
-	     (nnmail-split-it (nth 2 split))))
-	(t
-	 ;; An uncompiled match.
-	 (let* ((field (nth 0 split))
-		(value (nth 1 split))
-		(regexp (concat "^\\(" 
-				(if (symbolp field)
-				    (cdr (assq field 
-					       nnmail-split-abbrev-alist))
-				  field)
-				"\\):.*\\<\\("
-				(if (symbolp value)
-				    (cdr (assq value
-					       nnmail-split-abbrev-alist))
-				  value)
-				"\\)\\>")))
-	   (setq nnmail-split-cache 
-		 (cons (cons split regexp) nnmail-split-cache))
-	   (goto-char (point-max))
-	   (if (re-search-backward regexp nil t)
-	       (nnmail-split-it (nth 2 split)))))))
-
-;; Get a list of spool files to read.
-(defun nnmail-get-spool-files (&optional group)
-  (if (null nnmail-spool-file)
-      ;; No spool file whatsoever.
-      nil
-    (let* ((procmails 
-	    ;; If procmail is used to get incoming mail, the files
-	    ;; are stored in this directory.
-	    (and (file-exists-p nnmail-procmail-directory)
-		 (or (eq nnmail-spool-file 'procmail)
-		     nnmail-use-procmail)
-		 (directory-files 
-		  nnmail-procmail-directory 
-		  t (concat (if group (concat "^" group) "")
-			    nnmail-procmail-suffix "$") t)))
-	   (p procmails)
-	   (crash (when (and (file-exists-p nnmail-crash-box)
-			     (> (nnheader-file-size
-				 (file-truename nnmail-crash-box)) 0))
-		    (list nnmail-crash-box))))
-      ;; Remove any directories that inadvertantly match the procmail
-      ;; suffix, which might happen if the suffix is "". 
-      (while p
-	(when (file-directory-p (car p))
-	  (setq procmails (delete (car p) procmails)))
-	(setq p (cdr p)))
-      ;; Return the list of spools.
-      (append 
-       crash
-       (cond ((and group
-		   (or (eq nnmail-spool-file 'procmail)
-		       nnmail-use-procmail)
-		   procmails)
-	      procmails)
-	     ((and group
-		   (eq nnmail-spool-file 'procmail))
-	      nil)
-	     ((listp nnmail-spool-file)
-	      (append nnmail-spool-file procmails))
-	     ((stringp nnmail-spool-file)
-	      (cons nnmail-spool-file procmails))
-	     ((eq nnmail-spool-file 'pop)
-	      (cons (format "po:%s" (user-login-name)) procmails))
-	     (t
-	      procmails))))))
-
-;; Activate a backend only if it isn't already activated. 
-;; If FORCE, re-read the active file even if the backend is 
-;; already activated.
-(defun nnmail-activate (backend &optional force)
-  (let (file timestamp file-time)
-    (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
-	    force
-	    (and (setq file (condition-case ()
-				(symbol-value (intern (format "%s-active-file" 
-							      backend)))
-			      (error nil)))
-		 (setq file-time (nth 5 (file-attributes file)))
-		 (or (not
-		      (setq timestamp
-			    (condition-case ()
-				(symbol-value (intern
-					       (format "%s-active-timestamp" 
-						       backend)))
-			      (error 'none))))
-		     (not (consp timestamp))
-		     (equal timestamp '(0 0))
-		     (> (nth 0 file-time) (nth 0 timestamp))
-		     (and (= (nth 0 file-time) (nth 0 timestamp))
-			  (> (nth 1 file-time) (nth 1 timestamp))))))
-	(save-excursion
-	  (or (eq timestamp 'none)
-	      (set (intern (format "%s-active-timestamp" backend)) 
-		   (current-time)))
-	  (funcall (intern (format "%s-request-list" backend)))
-	  (set (intern (format "%s-group-alist" backend)) 
-	       (nnmail-get-active))))
-    t))
-
-(defun nnmail-message-id ()
-  (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
-
-;;;
-;;; nnmail duplicate handling
-;;;
-
-(defvar nnmail-cache-buffer nil)
-
-(defun nnmail-cache-open ()
-  (if (or (not nnmail-treat-duplicates)
-	  (and nnmail-cache-buffer
-	       (buffer-name nnmail-cache-buffer)))
-      ()				; The buffer is open.
-    (save-excursion
-      (set-buffer 
-       (setq nnmail-cache-buffer 
-	     (get-buffer-create " *nnmail message-id cache*")))
-      (buffer-disable-undo (current-buffer))
-      (and (file-exists-p nnmail-message-id-cache-file)
-	   (insert-file-contents nnmail-message-id-cache-file))
-      (set-buffer-modified-p nil)
-      (current-buffer))))
-
-(defun nnmail-cache-close ()
-  (when (and nnmail-cache-buffer
-	     nnmail-treat-duplicates
-	     (buffer-name nnmail-cache-buffer)
-	     (buffer-modified-p nnmail-cache-buffer))
-    (save-excursion
-      (set-buffer nnmail-cache-buffer)
-      ;; Weed out the excess number of Message-IDs.
-      (goto-char (point-max))
-      (and (search-backward "\n" nil t nnmail-message-id-cache-length)
-	   (progn
-	     (beginning-of-line)
-	     (delete-region (point-min) (point))))
-      ;; Save the buffer.
-      (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
-	  (make-directory (file-name-directory nnmail-message-id-cache-file)
-			  t))
-      (write-region (point-min) (point-max)
-		    nnmail-message-id-cache-file nil 'silent)
-      (set-buffer-modified-p nil)
-      (setq nnmail-cache-buffer nil)
-      ;;(kill-buffer (current-buffer))
-      )))
-
-(defun nnmail-cache-insert (id)
-  (when nnmail-treat-duplicates
-    (save-excursion
-      (set-buffer nnmail-cache-buffer)
-      (goto-char (point-max))
-      (insert id "\n"))))
-
-(defun nnmail-cache-id-exists-p (id)
-  (when nnmail-treat-duplicates
-    (save-excursion
-      (set-buffer nnmail-cache-buffer)
-      (goto-char (point-max))
-      (search-backward id nil t))))
-
-(defun nnmail-check-duplication (message-id func)
-  ;; If this is a duplicate message, then we do not save it.
-  (let* ((duplication (nnmail-cache-id-exists-p message-id))
-	 (action (when duplication
-		   (cond
-		    ((memq nnmail-treat-duplicates '(warn delete))
-		     nnmail-treat-duplicates)
-		    ((nnheader-functionp nnmail-treat-duplicates)
-		     (funcall nnmail-treat-duplicates message-id))
-		    (t
-		     nnmail-treat-duplicates)))))
-    (cond
-     ((not duplication)
-      (nnmail-cache-insert message-id)
-      (funcall func))
-     ((eq action 'delete)
-      (delete-region (point-min) (point-max)))
-     ((eq action 'warn)
-      ;; We insert a warning.
-      (let ((case-fold-search t)
-	    (newid (nnmail-message-id)))
-	(goto-char (point-min))
-	(when (re-search-forward "^message-id:" nil t)
-	  (beginning-of-line)
-	  (insert "Original-"))
-	(beginning-of-line)
-	(insert 
-	 "Message-ID: " newid "\n"
-	 "Gnus-Warning: This is a duplicate of message " message-id "\n")
-	(nnmail-cache-insert newid)
-	(funcall func)))
-     (t
-      (funcall func)))))
-
-;;; Get new mail.
-
-(defun nnmail-get-value (&rest args)
-  (let ((sym (intern (apply 'format args))))
-    (when (boundp sym)
-      (symbol-value sym))))
-
-(defun nnmail-get-new-mail (method exit-func temp
-				   &optional group spool-func)
-  "Read new incoming mail."
-  (let* ((spools (nnmail-get-spool-files group))
-	 (group-in group)
-	 incoming incomings spool)
-    (when (and (nnmail-get-value "%s-get-new-mail" method)
-	       nnmail-spool-file)
-      ;; We first activate all the groups.
-      (nnmail-activate method)
-      ;; Allow the user to hook.
-      (run-hooks 'nnmail-pre-get-new-mail-hook)
-      ;; Open the message-id cache.
-      (nnmail-cache-open)
-      ;; The we go through all the existing spool files and split the
-      ;; mail from each.
-      (while spools
-	(setq spool (pop spools))
-	;; We read each spool file if either the spool is a POP-mail
-	;; spool, or the file exists.  We can't check for the
-	;; existance of POPped mail.
-	(when (or (string-match "^po:" spool)
-		  (and (file-exists-p spool)
-		       (> (nnheader-file-size (file-truename spool)) 0)))
-	  (nnheader-message 3 "%s: Reading incoming mail..." method)
-	  (when (and (nnmail-move-inbox spool)
-		     (file-exists-p nnmail-crash-box))
-	    ;; There is new mail.  We first find out if all this mail
-	    ;; is supposed to go to some specific group.
-	    (setq group (nnmail-get-split-group spool group-in))
-	    ;; We split the mail
-	    (nnmail-split-incoming 
-	     nnmail-crash-box (intern (format "%s-save-mail" method)) 
-	     spool-func group)
-	    ;; Check whether the inbox is to be moved to the special tmp dir. 
-	    (setq incoming
-		  (nnmail-make-complex-temp-name 
-		   (expand-file-name 
-		    (if nnmail-tmp-directory
-			(concat 
-			 (file-name-as-directory nnmail-tmp-directory)
-			 (file-name-nondirectory (concat temp "Incoming")))
-		      (concat temp "Incoming")))))
-	    (rename-file nnmail-crash-box incoming t)
-	    (push incoming incomings))))
-      ;; If we did indeed read any incoming spools, we save all info. 
-      (when incomings
-	(nnmail-save-active 
-	 (nnmail-get-value "%s-group-alist" method)
-	 (nnmail-get-value "%s-active-file" method))
-	(when exit-func
-	  (funcall exit-func))
-	(run-hooks 'nnmail-read-incoming-hook)
-	(nnheader-message 3 "%s: Reading incoming mail...done" method))
-      ;; Close the message-id cache.
-      (nnmail-cache-close)
-      ;; Allow the user to hook.
-      (run-hooks 'nnmail-post-get-new-mail-hook)
-      ;; Delete all the temporary files.
-      (while incomings
-	(setq incoming (pop incomings))
-	(and nnmail-delete-incoming
-	     (file-exists-p incoming)
-	     (file-writable-p incoming)
-	     (delete-file incoming))))))
-
-(defun nnmail-expired-article-p (group time force &optional inhibit)
-  "Say whether an article that is TIME old in GROUP should be expired."
-  (if force
-      t
-    (let ((days (or (and nnmail-expiry-wait-function
-			 (funcall nnmail-expiry-wait-function group))
-		    nnmail-expiry-wait)))
-      (cond ((or (eq days 'never)
-		 (and (not force)
-		      inhibit))
-	     ;; This isn't an expirable group.
-	     nil)
-	    ((eq days 'immediate)
-	     ;; We expire all articles on sight.
-	     t)
-	    ((equal time '(0 0))
-	     ;; This is an ange-ftp group, and we don't have any dates.
-	     nil)
-	    ((numberp days)
-	     (setq days (nnmail-days-to-time days))
-	     ;; Compare the time with the current time.
-	     (nnmail-time-less days (nnmail-time-since time)))))))
-
-(defvar nnmail-read-passwd nil)
-(defun nnmail-read-passwd (prompt)
-  (unless nnmail-read-passwd
-    (if (load "passwd" t)
-	(setq nnmail-read-passwd 'read-passwd)
-      (autoload 'ange-ftp-read-passwd "ange-ftp")
-      (setq nnmail-read-passwd 'ange-ftp-read-passwd)))
-  (funcall nnmail-read-passwd prompt))
-
-(defun nnmail-check-syntax ()
-  "Check (and modify) the syntax of the message in the current buffer."
-  (save-restriction
-    (message-narrow-to-head)
-    (let ((case-fold-search t))
-      (unless (re-search-forward "^Message-Id:" nil t)
-	(insert "Message-ID: " (nnmail-message-id) "\n")))))
-
-(run-hooks 'nnmail-load-hook)
-	    
-(provide 'nnmail)
-
-;;; nnmail.el ends here
diff --git a/lisp/nnmbox.el b/lisp/nnmbox.el
deleted file mode 100644
index 9b7957247d4..00000000000
--- a/lisp/nnmbox.el
+++ /dev/null
@@ -1,533 +0,0 @@
-;;; nnmbox.el --- mail mbox access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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:
-
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.  
-
-;;; Code:
-
-(require 'nnheader)
-(require 'message)
-(require 'nnmail)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnmbox)
-
-(defvoo nnmbox-mbox-file (expand-file-name "~/mbox")
-  "The name of the mail box file in the user's home directory.")
-
-(defvoo nnmbox-active-file (expand-file-name "~/.mbox-active")
-  "The name of the active file for the mail box.")
-
-(defvoo nnmbox-get-new-mail t
-  "If non-nil, nnmbox will check the incoming mail file and split the mail.")
-
-(defvoo nnmbox-prepare-save-mail-hook nil
-  "Hook run narrowed to an article before saving.")
-
-
-
-(defconst nnmbox-version "nnmbox 1.0"
-  "nnmbox version.")
-
-(defvoo nnmbox-current-group nil
-  "Current nnmbox news group directory.")
-
-(defconst nnmbox-mbox-buffer nil)
-
-(defvoo nnmbox-status-string "")
-
-(defvoo nnmbox-group-alist nil)
-(defvoo nnmbox-active-timestamp nil)
-
-
-
-;;; Interface functions
-
-(nnoo-define-basics nnmbox)
-
-(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (let ((number (length sequence))
-	  (count 0)
-	  article art-string start stop)
-      (nnmbox-possibly-change-newsgroup newsgroup server)
-      (while sequence
-	(setq article (car sequence))
-	(setq art-string (nnmbox-article-string article))
-	(set-buffer nnmbox-mbox-buffer)
-	(if (or (search-forward art-string nil t)
-		(progn (goto-char (point-min))
-		       (search-forward art-string nil t)))
-	    (progn
-	      (setq start 
-		    (save-excursion
-		      (re-search-backward 
-		       (concat "^" message-unix-mail-delimiter) nil t)
-		      (point)))
-	      (search-forward "\n\n" nil t)
-	      (setq stop (1- (point)))
-	      (set-buffer nntp-server-buffer)
-	      (insert (format "221 %d Article retrieved.\n" article))
-	      (insert-buffer-substring nnmbox-mbox-buffer start stop)
-	      (goto-char (point-max))
-	      (insert ".\n")))
-	(setq sequence (cdr sequence))
-	(setq count (1+ count))
-	(and (numberp nnmail-large-newsgroup)
-	     (> number nnmail-large-newsgroup)
-	     (zerop (% count 20))
-	     (nnheader-message 5 "nnmbox: Receiving headers... %d%%"
-			       (/ (* count 100) number))))
-
-      (and (numberp nnmail-large-newsgroup)
-	   (> number nnmail-large-newsgroup)
-	   (nnheader-message 5 "nnmbox: Receiving headers...done"))
-
-      (set-buffer nntp-server-buffer)
-      (nnheader-fold-continuation-lines)
-      'headers)))
-
-(deffoo nnmbox-open-server (server &optional defs)
-  (nnoo-change-server 'nnmbox server defs)
-  (cond 
-   ((not (file-exists-p nnmbox-mbox-file))
-    (nnmbox-close-server)
-    (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file))
-   ((file-directory-p nnmbox-mbox-file)
-    (nnmbox-close-server)
-    (nnheader-report 'nnmbox "Not a regular file: %s" nnmbox-mbox-file))
-   (t
-    (nnheader-report 'nnmbox "Opened server %s using mbox %s" server
-		     nnmbox-mbox-file)
-    t)))
-
-(deffoo nnmbox-close-server (&optional server)
-  (when (and nnmbox-mbox-buffer
-	     (buffer-name nnmbox-mbox-buffer))
-    (kill-buffer nnmbox-mbox-buffer))
-  (nnoo-close-server 'nnmbox server)
-  t)
-
-(deffoo nnmbox-server-opened (&optional server)
-  (and (nnoo-current-server-p 'nnmbox server)
-       nnmbox-mbox-buffer
-       (buffer-name nnmbox-mbox-buffer)
-       nntp-server-buffer
-       (buffer-name nntp-server-buffer)))
-
-(deffoo nnmbox-request-article (article &optional newsgroup server buffer)
-  (nnmbox-possibly-change-newsgroup newsgroup server)
-  (save-excursion
-    (set-buffer nnmbox-mbox-buffer)
-    (goto-char (point-min))
-    (if (search-forward (nnmbox-article-string article) nil t)
-	(let (start stop)
-	  (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
-	  (setq start (point))
-	  (forward-line 1)
-	  (or (and (re-search-forward 
-		    (concat "^" message-unix-mail-delimiter) nil t)
-		   (forward-line -1))
-	      (goto-char (point-max)))
-	  (setq stop (point))
-	  (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
-	    (set-buffer nntp-server-buffer)
-	    (erase-buffer)
-	    (insert-buffer-substring nnmbox-mbox-buffer start stop)
-	    (goto-char (point-min))
-	    (while (looking-at "From ")
-	      (delete-char 5)
-	      (insert "X-From-Line: ")
-	      (forward-line 1))
-	    (if (numberp article) 
-		(cons nnmbox-current-group article)
-	      (nnmbox-article-group-number)))))))
-
-(deffoo nnmbox-request-group (group &optional server dont-check)
-  (let ((active (cadr (assoc group nnmbox-group-alist))))
-    (cond 
-     ((or (null active)
-	  (null (nnmbox-possibly-change-newsgroup group server)))
-      (nnheader-report 'nnmbox "No such group: %s" group))
-     (dont-check
-      (nnheader-report 'nnmbox "Selected group %s" group)
-      (nnheader-insert ""))
-     (t
-      (nnheader-report 'nnmbox "Selected group %s" group)
-      (nnheader-insert "211 %d %d %d %s\n" 
-		       (1+ (- (cdr active) (car active)))
-		       (car active) (cdr active) group)))))
-
-(deffoo nnmbox-request-scan (&optional group server)
-  (nnmbox-read-mbox)
-  (nnmail-get-new-mail 
-   'nnmbox 
-   (lambda ()
-     (save-excursion
-       (set-buffer nnmbox-mbox-buffer)
-       (save-buffer)))
-   nnmbox-mbox-file group
-   (lambda ()
-     (save-excursion
-       (let ((in-buf (current-buffer)))
-	 (set-buffer nnmbox-mbox-buffer)
-	 (goto-char (point-max))
-	 (insert-buffer-substring in-buf)))
-     (nnmail-save-active nnmbox-group-alist nnmbox-active-file))))
-
-(deffoo nnmbox-close-group (group &optional server)
-  t)
-
-(deffoo nnmbox-request-list (&optional server)
-  (save-excursion
-    (nnmail-find-file nnmbox-active-file)
-    (setq nnmbox-group-alist (nnmail-get-active))))
-
-(deffoo nnmbox-request-newgroups (date &optional server)
-  (nnmbox-request-list server))
-
-(deffoo nnmbox-request-list-newsgroups (&optional server)
-  (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented."))
-
-(deffoo nnmbox-request-expire-articles 
-  (articles newsgroup &optional server force)
-  (nnmbox-possibly-change-newsgroup newsgroup server)
-  (let* ((is-old t)
-	 rest)
-    (nnmail-activate 'nnmbox)
-
-    (save-excursion 
-      (set-buffer nnmbox-mbox-buffer)
-      (while (and articles is-old)
-	(goto-char (point-min))
-	(if (search-forward (nnmbox-article-string (car articles)) nil t)
-	    (if (setq is-old
-		      (nnmail-expired-article-p
-		       newsgroup
-		       (buffer-substring 
-			(point) (progn (end-of-line) (point))) force))
-		(progn
-		  (nnheader-message 5 "Deleting article %d in %s..."
-				    (car articles) newsgroup)
-		  (nnmbox-delete-mail))
-	      (setq rest (cons (car articles) rest))))
-	(setq articles (cdr articles)))
-      (save-buffer)
-      ;; Find the lowest active article in this group.
-      (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist))))
-	(goto-char (point-min))
-	(while (and (not (search-forward
-			  (nnmbox-article-string (car active)) nil t))
-		    (<= (car active) (cdr active)))
-	  (setcar active (1+ (car active)))
-	  (goto-char (point-min))))
-      (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
-      (nconc rest articles))))
-
-(deffoo nnmbox-request-move-article
-  (article group server accept-form &optional last)
-  (nnmbox-possibly-change-newsgroup group server)
-  (let ((buf (get-buffer-create " *nnmbox move*"))
-	result)
-    (and 
-     (nnmbox-request-article article group server)
-     (save-excursion
-       (set-buffer buf)
-       (buffer-disable-undo (current-buffer))
-       (erase-buffer)
-       (insert-buffer-substring nntp-server-buffer)
-       (goto-char (point-min))
-       (while (re-search-forward 
-	       "^X-Gnus-Newsgroup:" 
-	       (save-excursion (search-forward "\n\n" nil t) (point)) t)
-	 (delete-region (progn (beginning-of-line) (point))
-			(progn (forward-line 1) (point))))
-       (setq result (eval accept-form))
-       (kill-buffer buf)
-       result)
-     (save-excursion
-       (set-buffer nnmbox-mbox-buffer)
-       (goto-char (point-min))
-       (if (search-forward (nnmbox-article-string article) nil t)
-	   (nnmbox-delete-mail))
-       (and last (save-buffer))))
-    result))
-
-(deffoo nnmbox-request-accept-article (group &optional server last)
-  (nnmbox-possibly-change-newsgroup group server)
-  (nnmail-check-syntax)
-  (let ((buf (current-buffer))
-	result)
-    (goto-char (point-min))
-    (if (looking-at "X-From-Line: ")
-	(replace-match "From ")
-      (insert "From nobody " (current-time-string) "\n"))
-    (and 
-     (nnmail-activate 'nnmbox)
-     (progn
-       (set-buffer buf)
-       (goto-char (point-min))
-       (search-forward "\n\n" nil t)
-       (forward-line -1)
-       (while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
-	 (delete-region (point) (progn (forward-line 1) (point))))
-       (setq result (nnmbox-save-mail (and (stringp group) group))))
-     (save-excursion
-       (set-buffer nnmbox-mbox-buffer)
-       (goto-char (point-max))
-       (insert-buffer-substring buf)
-       (and last (save-buffer))
-       result)
-     (nnmail-save-active nnmbox-group-alist nnmbox-active-file))
-    (car result)))
-
-(deffoo nnmbox-request-replace-article (article group buffer)
-  (nnmbox-possibly-change-newsgroup group)
-  (save-excursion
-    (set-buffer nnmbox-mbox-buffer)
-    (goto-char (point-min))
-    (if (not (search-forward (nnmbox-article-string article) nil t))
-	nil
-      (nnmbox-delete-mail t t)
-      (insert-buffer-substring buffer)
-      (save-buffer)
-      t)))
-
-(deffoo nnmbox-request-delete-group (group &optional force server)
-  (nnmbox-possibly-change-newsgroup group server)
-  ;; Delete all articles in GROUP.
-  (if (not force)
-      ()				; Don't delete the articles.
-    (save-excursion
-      (set-buffer nnmbox-mbox-buffer)
-      (goto-char (point-min))
-      ;; Delete all articles in this group.
-      (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"))
-	    found)
-	(while (search-forward ident nil t)
-	  (setq found t)
-	  (nnmbox-delete-mail))
-	(and found (save-buffer)))))
-  ;; Remove the group from all structures.
-  (setq nnmbox-group-alist 
-	(delq (assoc group nnmbox-group-alist) nnmbox-group-alist)
-	nnmbox-current-group nil)
-  ;; Save the active file.
-  (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
-  t)
-
-(deffoo nnmbox-request-rename-group (group new-name &optional server)
-  (nnmbox-possibly-change-newsgroup group server)
-  (save-excursion
-    (set-buffer nnmbox-mbox-buffer)
-    (goto-char (point-min))
-    (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"))
-	  (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
-	  found)
-      (while (search-forward ident nil t)
-	(replace-match new-ident t t)
-	(setq found t))
-      (and found (save-buffer))))
-  (let ((entry (assoc group nnmbox-group-alist)))
-    (and entry (setcar entry new-name))
-    (setq nnmbox-current-group nil)
-    ;; Save the new group alist.
-    (nnmail-save-active nnmbox-group-alist nnmbox-active-file)
-    t))
-
-
-;;; Internal functions.
-
-;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
-;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
-;; delimiter line.
-(defun nnmbox-delete-mail (&optional force leave-delim)
-  ;; Delete the current X-Gnus-Newsgroup line.
-  (or force
-      (delete-region
-       (progn (beginning-of-line) (point))
-       (progn (forward-line 1) (point))))
-  ;; Beginning of the article.
-  (save-excursion
-    (save-restriction
-      (narrow-to-region
-       (save-excursion
-	 (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
-	 (if leave-delim (progn (forward-line 1) (point))
-	   (match-beginning 0)))
-       (progn
-	 (forward-line 1)
-	 (or (and (re-search-forward (concat "^" message-unix-mail-delimiter) 
-				     nil t)
-		  (if (and (not (bobp)) leave-delim)
-		      (progn (forward-line -2) (point))
-		    (match-beginning 0)))
-	     (point-max))))
-      (goto-char (point-min))
-      ;; Only delete the article if no other groups owns it as well.
-      (if (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
-	  (delete-region (point-min) (point-max))))))
-
-(defun nnmbox-possibly-change-newsgroup (newsgroup &optional server)
-  (when (and server 
-	     (not (nnmbox-server-opened server)))
-    (nnmbox-open-server server))
-  (if (or (not nnmbox-mbox-buffer)
-	  (not (buffer-name nnmbox-mbox-buffer)))
-      (save-excursion
-	(set-buffer (setq nnmbox-mbox-buffer 
-			  (nnheader-find-file-noselect
-			   nnmbox-mbox-file nil 'raw)))
-	(buffer-disable-undo (current-buffer))))
-  (if (not nnmbox-group-alist)
-      (nnmail-activate 'nnmbox))
-  (if newsgroup
-      (if (assoc newsgroup nnmbox-group-alist)
-	  (setq nnmbox-current-group newsgroup))
-    t))
-
-(defun nnmbox-article-string (article)
-  (if (numberp article)
-      (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":" 
-	      (int-to-string article) " ")
-    (concat "\nMessage-ID: " article)))
-
-(defun nnmbox-article-group-number ()
-  (save-excursion
-    (goto-char (point-min))
-    (and (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
-			    nil t)
-	 (cons (buffer-substring (match-beginning 1) (match-end 1))
-	       (string-to-int
-		(buffer-substring (match-beginning 2) (match-end 2)))))))
-
-(defun nnmbox-save-mail (&optional group)
-  "Called narrowed to an article."
-  (let* ((nnmail-split-methods 
-	  (if group (list (list group "")) nnmail-split-methods))
-	 (group-art (nreverse (nnmail-article-group 'nnmbox-active-number)))
-	 (delim (concat "^" message-unix-mail-delimiter)))
-    (goto-char (point-min))
-    ;; This might come from somewhere else.
-    (unless (looking-at delim)
-      (insert "From nobody " (current-time-string) "\n")
-      (goto-char (point-min)))
-    ;; Quote all "From " lines in the article.
-    (forward-line 1)
-    (while (re-search-forward delim nil t)
-      (beginning-of-line)
-      (insert "> "))
-    (nnmail-insert-lines)
-    (nnmail-insert-xref group-art)
-    (nnmbox-insert-newsgroup-line group-art)
-    (run-hooks 'nnmail-prepare-save-mail-hook)
-    (run-hooks 'nnmbox-prepare-save-mail-hook)
-    group-art))
-
-(defun nnmbox-insert-newsgroup-line (group-art)
-  (save-excursion
-    (goto-char (point-min))
-    (if (search-forward "\n\n" nil t)
-	(progn
-	  (forward-char -1)
-	  (while group-art
-	    (insert (format "X-Gnus-Newsgroup: %s:%d   %s\n" 
-			    (caar group-art) (cdar group-art)
-			    (current-time-string)))
-	    (setq group-art (cdr group-art)))))
-    t))
-
-(defun nnmbox-active-number (group)
-  ;; Find the next article number in GROUP.
-  (let ((active (cadr (assoc group nnmbox-group-alist))))
-    (if active
-	(setcdr active (1+ (cdr active)))
-      ;; This group is new, so we create a new entry for it.
-      ;; This might be a bit naughty... creating groups on the drop of
-      ;; a hat, but I don't know...
-      (setq nnmbox-group-alist (cons (list group (setq active (cons 1 1)))
-				     nnmbox-group-alist)))
-    (cdr active)))
-
-(defun nnmbox-read-mbox ()
-  (nnmail-activate 'nnmbox)
-  (if (not (file-exists-p nnmbox-mbox-file))
-      (write-region 1 1 nnmbox-mbox-file t 'nomesg))
-  (if (and nnmbox-mbox-buffer
-	   (buffer-name nnmbox-mbox-buffer)
-	   (save-excursion
-	     (set-buffer nnmbox-mbox-buffer)
-	     (= (buffer-size) (nnheader-file-size nnmbox-mbox-file))))
-      ()
-    (save-excursion
-      (let ((delim (concat "^" message-unix-mail-delimiter))
-	    (alist nnmbox-group-alist)
-	    start end number)
-	(set-buffer (setq nnmbox-mbox-buffer 
-			  (nnheader-find-file-noselect
-			   nnmbox-mbox-file nil 'raw)))
-	(buffer-disable-undo (current-buffer))
-
-	;; Go through the group alist and compare against
-	;; the mbox file.
-	(while alist
-	  (goto-char (point-max))
-	  (when (and (re-search-backward
-		      (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
-			      (caar alist)) nil t)
-		     (>= (setq number
-			       (string-to-number 
-				(buffer-substring
-				 (match-beginning 1) (match-end 1))))
-			 (cdadar alist)))
-	    (setcdr (cadar alist) (1+ number)))
-	  (setq alist (cdr alist)))
-	
-	(goto-char (point-min))
-	(while (re-search-forward delim nil t)
-	  (setq start (match-beginning 0))
-	  (if (not (search-forward "\nX-Gnus-Newsgroup: " 
-				   (save-excursion 
-				     (setq end
-					   (or
-					    (and
-					     (re-search-forward delim nil t)
-					     (match-beginning 0))
-					    (point-max))))
-				   t))
-	      (save-excursion
-		(save-restriction
-		  (narrow-to-region start end)
-		  (nnmbox-save-mail))))
-	  (goto-char end))))))
-
-(provide 'nnmbox)
-
-;;; nnmbox.el ends here
diff --git a/lisp/nnmh.el b/lisp/nnmh.el
deleted file mode 100644
index cc9adab8996..00000000000
--- a/lisp/nnmh.el
+++ /dev/null
@@ -1,520 +0,0 @@
-;;; nnmh.el --- mhspool access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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:
-
-;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.  
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnmail)
-(require 'gnus)
-(require 'nnoo)
-(eval-and-compile (require 'cl))
-
-(nnoo-declare nnmh)
-
-(defvoo nnmh-directory message-directory
-  "*Mail spool directory.")
-
-(defvoo nnmh-get-new-mail t
-  "*If non-nil, nnmh will check the incoming mail file and split the mail.")
-
-(defvoo nnmh-prepare-save-mail-hook nil
-  "*Hook run narrowed to an article before saving.")
-
-(defvoo nnmh-be-safe nil
-  "*If non-nil, nnmh will check all articles to make sure whether they are new or not.")
-
-
-
-(defconst nnmh-version "nnmh 1.0"
-  "nnmh version.")
-
-(defvoo nnmh-current-directory nil
-  "Current news group directory.")
-
-(defvoo nnmh-status-string "")
-(defvoo nnmh-group-alist nil)
-
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nnmh)
-
-(deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (let* ((file nil)
-	   (number (length articles))
-	   (large (and (numberp nnmail-large-newsgroup)
-		       (> number nnmail-large-newsgroup)))
-	   (count 0)
-	   beg article)
-      (nnmh-possibly-change-directory newsgroup server)
-      ;; We don't support fetching by Message-ID.
-      (if (stringp (car articles))
-	  'headers
-	(while articles
-	  (when (and (file-exists-p 
-		      (setq file (concat (file-name-as-directory 
-					  nnmh-current-directory)
-					 (int-to-string
-					  (setq article (pop articles))))))
-		     (not (file-directory-p file)))
-	    (insert (format "221 %d Article retrieved.\n" article))
-	    (setq beg (point))
-	    (nnheader-insert-head file)
-	    (goto-char beg)
-	    (if (search-forward "\n\n" nil t)
-		(forward-char -1)
-	      (goto-char (point-max))
-	      (insert "\n\n"))
-	    (insert ".\n")
-	    (delete-region (point) (point-max)))
-	  (setq count (1+ count))
-
-	  (and large
-	       (zerop (% count 20))
-	       (message "nnmh: Receiving headers... %d%%"
-			(/ (* count 100) number))))
-
-	(and large (message "nnmh: Receiving headers...done"))
-
-	(nnheader-fold-continuation-lines)
-	'headers))))
-
-(deffoo nnmh-open-server (server &optional defs)
-  (nnoo-change-server 'nnmh server defs)
-  (when (not (file-exists-p nnmh-directory))
-    (condition-case ()
-	(make-directory nnmh-directory t)
-      (error t)))
-  (cond 
-   ((not (file-exists-p nnmh-directory))
-    (nnmh-close-server)
-    (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory))
-   ((not (file-directory-p (file-truename nnmh-directory)))
-    (nnmh-close-server)
-    (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory))
-   (t
-    (nnheader-report 'nnmh "Opened server %s using directory %s"
-		     server nnmh-directory)
-    t)))
-
-(deffoo nnmh-request-article (id &optional newsgroup server buffer)
-  (nnmh-possibly-change-directory newsgroup server)
-  (let ((file (if (stringp id)
-		  nil
-		(concat nnmh-current-directory (int-to-string id))))
-	(nntp-server-buffer (or buffer nntp-server-buffer)))
-    (and (stringp file)
-	 (file-exists-p file)
-	 (not (file-directory-p file))
-	 (save-excursion (nnmail-find-file file))
-	 (string-to-int (file-name-nondirectory file)))))
-
-(deffoo nnmh-request-group (group &optional server dont-check)
-  (let ((pathname (nnmail-group-pathname group nnmh-directory))
-	dir)
-    (cond 
-     ((not (file-directory-p pathname))
-      (nnheader-report 
-       'nnmh "Can't select group (no such directory): %s" group))
-     (t
-      (setq nnmh-current-directory pathname)
-      (and nnmh-get-new-mail 
-	   nnmh-be-safe
-	   (nnmh-update-gnus-unreads group))
-      (cond
-       (dont-check
-	(nnheader-report 'nnmh "Selected group %s" group)
-	t)
-       (t
-	;; Re-scan the directory if it's on a foreign system.
-	(nnheader-re-read-dir pathname)
-	(setq dir 
-	      (sort
-	       (mapcar (lambda (name) (string-to-int name))
-		       (directory-files pathname nil "^[0-9]+$" t))
-	       '<))
-	  (cond 
-	   (dir
-	    (nnheader-report 'nnmh "Selected group %s" group)
-	    (nnheader-insert
-	     "211 %d %d %d %s\n" (length dir) (car dir)
-	     (progn (while (cdr dir) (setq dir (cdr dir))) (car dir))
-	     group))
-	   (t
-	    (nnheader-report 'nnmh "Empty group %s" group)
-	    (nnheader-insert (format "211 0 1 0 %s\n" group))))))))))
-
-(deffoo nnmh-request-scan (&optional group server)
-  (nnmail-get-new-mail 'nnmh nil nnmh-directory group))      
-
-(deffoo nnmh-request-list (&optional server dir)
-  (nnheader-insert "")
-  (let ((nnmh-toplev
-	 (or dir (file-truename (file-name-as-directory nnmh-directory)))))
-    (nnmh-request-list-1 nnmh-toplev))
-  (setq nnmh-group-alist (nnmail-get-active))
-  t)
-
-(defvar nnmh-toplev)
-(defun nnmh-request-list-1 (dir)
-  (setq dir (expand-file-name dir))
-  ;; Recurse down all directories.
-  (let ((dirs (and (file-readable-p dir)
-		   (> (nth 1 (file-attributes (file-chase-links dir))) 2)
-		   (directory-files dir t nil t)))
-	dir)
-    ;; Recurse down directories.
-    (while (setq dir (pop dirs))
-      (when (and (not (member (file-name-nondirectory dir) '("." "..")))
-		 (file-directory-p dir)
-		 (file-readable-p dir))
-	(nnmh-request-list-1 dir))))
-  ;; For each directory, generate an active file line.
-  (unless (string= (expand-file-name nnmh-toplev) dir)
-    (let ((files (mapcar
-		  (lambda (name) (string-to-int name))
-		  (directory-files dir nil "^[0-9]+$" t))))
-      (when files
-	(save-excursion
-	  (set-buffer nntp-server-buffer)
-	  (goto-char (point-max))
-	  (insert 
-	   (format 
-	    "%s %d %d y\n" 
-	    (progn
-	      (string-match 
-	       (regexp-quote
-		(file-truename (file-name-as-directory 
-				(expand-file-name nnmh-toplev)))) dir)
-	      (nnheader-replace-chars-in-string
-	       (substring dir (match-end 0)) ?/ ?.))
-	    (apply 'max files) 
-	    (apply 'min files)))))))
-  t)
-
-(deffoo nnmh-request-newgroups (date &optional server)
-  (nnmh-request-list server))
-
-(deffoo nnmh-request-expire-articles (articles newsgroup &optional server force)
-  (nnmh-possibly-change-directory newsgroup server)
-  (let* ((active-articles 
-	  (mapcar
-	   (function
-	    (lambda (name)
-	      (string-to-int name)))
-	   (directory-files nnmh-current-directory nil "^[0-9]+$" t)))
-	 (is-old t)
-	 article rest mod-time)
-    (nnmail-activate 'nnmh)
-
-    (while (and articles is-old)
-      (setq article (concat nnmh-current-directory 
-			    (int-to-string (car articles))))
-      (if (setq mod-time (nth 5 (file-attributes article)))
-	  (if (and (nnmh-deletable-article-p newsgroup (car articles))
-		   (setq is-old
-			 (nnmail-expired-article-p newsgroup mod-time force)))
-	      (progn
-		(nnheader-message 5 "Deleting article %s in %s..." 
-				  article newsgroup)
-		(condition-case ()
-		    (funcall nnmail-delete-file-function article)
-		  (file-error
-		   (nnheader-message 1 "Couldn't delete article %s in %s"
-				     article newsgroup)
-		   (setq rest (cons (car articles) rest)))))
-	    (setq rest (cons (car articles) rest))))
-      (setq articles (cdr articles)))
-    (message "")
-    (nconc rest articles)))
-
-(deffoo nnmh-close-group (group &optional server)
-  t)
-
-(deffoo nnmh-request-move-article 
-  (article group server accept-form &optional last)
-  (let ((buf (get-buffer-create " *nnmh move*"))
-	result)
-    (and 
-     (nnmh-deletable-article-p group article)
-     (nnmh-request-article article group server)
-     (save-excursion
-       (set-buffer buf)
-       (insert-buffer-substring nntp-server-buffer)
-       (setq result (eval accept-form))
-       (kill-buffer (current-buffer))
-       result)
-     (progn
-       (nnmh-possibly-change-directory group server)
-       (condition-case ()
-	   (funcall nnmail-delete-file-function
-		    (concat nnmh-current-directory (int-to-string article)))
-	 (file-error nil))))
-    result))
-
-(deffoo nnmh-request-accept-article (group &optional server last noinsert)
-  (nnmh-possibly-change-directory group server)
-  (nnmail-check-syntax)
-  (if (stringp group)
-      (and 
-       (nnmail-activate 'nnmh)
-       ;; We trick the choosing function into believing that only one
-       ;; group is available.  
-       (let ((nnmail-split-methods (list (list group ""))))
-	 (car (nnmh-save-mail noinsert))))
-    (and
-     (nnmail-activate 'nnmh)
-     (car (nnmh-save-mail noinsert)))))
-
-(deffoo nnmh-request-replace-article (article group buffer)
-  (nnmh-possibly-change-directory group)
-  (save-excursion
-    (set-buffer buffer)
-    (nnmh-possibly-create-directory group)
-    (condition-case ()
-	(progn
-	  (write-region 
-	   (point-min) (point-max)
-	   (concat nnmh-current-directory (int-to-string article))
-	   nil (if (nnheader-be-verbose 5) nil 'nomesg))
-	  t)
-      (error nil))))
-
-(deffoo nnmh-request-create-group (group &optional server) 
-  (nnmail-activate 'nnmh)
-  (or (assoc group nnmh-group-alist)
-      (let (active)
-	(setq nnmh-group-alist (cons (list group (setq active (cons 1 0)))
-				     nnmh-group-alist))
-	(nnmh-possibly-create-directory group)
-	(nnmh-possibly-change-directory group server)
-	(let ((articles (mapcar
-			 (lambda (file)
-			   (string-to-int file))
-			 (directory-files 
-			  nnmh-current-directory nil "^[0-9]+$"))))
-	  (and articles
-	       (progn
-		 (setcar active (apply 'min articles))
-		 (setcdr active (apply 'max articles)))))))
-  t)
-
-(deffoo nnmh-request-delete-group (group &optional force server)
-  (nnmh-possibly-change-directory group server)
-  ;; Delete all articles in GROUP.
-  (if (not force)
-      ()				; Don't delete the articles.
-    (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$")))
-      (while articles 
-	(and (file-writable-p (car articles))
-	     (progn
-	       (nnheader-message 5 "Deleting article %s in %s..."
-				 (car articles) group)
-	       (funcall nnmail-delete-file-function (car articles))))
-	(setq articles (cdr articles))))
-    ;; Try to delete the directory itself.
-    (condition-case ()
-	(delete-directory nnmh-current-directory)
-      (error nil)))
-  ;; Remove the group from all structures.
-  (setq nnmh-group-alist 
-	(delq (assoc group nnmh-group-alist) nnmh-group-alist)
-	nnmh-current-directory nil)
-  t)
-
-(deffoo nnmh-request-rename-group (group new-name &optional server)
-  (nnmh-possibly-change-directory group server)
-  ;; Rename directory.
-  (and (file-writable-p nnmh-current-directory)
-       (condition-case ()
-	   (progn
-	     (rename-file 
-	      (directory-file-name nnmh-current-directory)
-	      (directory-file-name 
-	       (nnmail-group-pathname new-name nnmh-directory)))
-	     t)
-	 (error nil))
-       ;; That went ok, so we change the internal structures.
-       (let ((entry (assoc group nnmh-group-alist)))
-	 (and entry (setcar entry new-name))
-	 (setq nnmh-current-directory nil)
-	 t)))
-
-
-;;; Internal functions.
-
-(defun nnmh-possibly-change-directory (newsgroup &optional server)
-  (when (and server 
-	     (not (nnmh-server-opened server)))
-    (nnmh-open-server server))
-  (if newsgroup
-      (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory)))
-	(if (file-directory-p pathname)
-	    (setq nnmh-current-directory pathname)
-	  (error "No such newsgroup: %s" newsgroup)))))
-
-(defun nnmh-possibly-create-directory (group)
-  (let (dir dirs)
-    (setq dir (nnmail-group-pathname group nnmh-directory))
-    (while (not (file-directory-p dir))
-      (setq dirs (cons dir dirs))
-      (setq dir (file-name-directory (directory-file-name dir))))
-    (while dirs
-      (if (make-directory (directory-file-name (car dirs)))
-	  (error "Could not create directory %s" (car dirs)))
-      (nnheader-message 5 "Creating mail directory %s" (car dirs))
-      (setq dirs (cdr dirs)))))
-	     
-(defun nnmh-save-mail (&optional noinsert)
-  "Called narrowed to an article."
-  (let ((group-art (nreverse (nnmail-article-group 'nnmh-active-number))))
-    (unless noinsert
-      (nnmail-insert-lines)
-      (nnmail-insert-xref group-art))
-    (run-hooks 'nnmail-prepare-save-mail-hook)
-    (run-hooks 'nnmh-prepare-save-mail-hook)
-    (goto-char (point-min))
-    (while (looking-at "From ")
-      (replace-match "X-From-Line: ")
-      (forward-line 1))
-    ;; We save the article in all the newsgroups it belongs in.
-    (let ((ga group-art)
-	  first)
-      (while ga
-	(nnmh-possibly-create-directory (caar ga))
-	(let ((file (concat (nnmail-group-pathname 
-			     (caar ga) nnmh-directory) 
-			    (int-to-string (cdar ga)))))
-	  (if first
-	      ;; It was already saved, so we just make a hard link.
-	      (funcall nnmail-crosspost-link-function first file t)
-	    ;; Save the article.
-	    (write-region (point-min) (point-max) file nil nil)
-	    (setq first file)))
-	(setq ga (cdr ga))))
-    group-art))
-
-(defun nnmh-active-number (group)
-  "Compute the next article number in GROUP."
-  (let ((active (cadr (assoc group nnmh-group-alist))))
-    ;; The group wasn't known to nnmh, so we just create an active
-    ;; entry for it.   
-    (or active
-	(progn
-	  (setq active (cons 1 0))
-	  (setq nnmh-group-alist (cons (list group active) nnmh-group-alist))))
-    (setcdr active (1+ (cdr active)))
-    (while (file-exists-p
-	    (concat (nnmail-group-pathname group nnmh-directory)
-		    (int-to-string (cdr active))))
-      (setcdr active (1+ (cdr active))))
-    (cdr active)))
-
-(defun nnmh-update-gnus-unreads (group)
-  ;; Go through the .nnmh-articles file and compare with the actual
-  ;; articles in this folder. The articles that are "new" will be
-  ;; marked as unread by Gnus.
-  (let* ((dir nnmh-current-directory)
-	 (files (sort (mapcar (function (lambda (name) (string-to-int name)))
-			      (directory-files nnmh-current-directory 
-					       nil "^[0-9]+$" t)) '<))
-	 (nnmh-file (concat dir ".nnmh-articles"))
-	 new articles)
-    ;; Load the .nnmh-articles file.
-    (if (file-exists-p nnmh-file)
-	(setq articles 
-	      (let (nnmh-newsgroup-articles)
-		(condition-case nil (load nnmh-file nil t t) (error nil))
-		nnmh-newsgroup-articles)))
-    ;; Add all new articles to the `new' list.
-    (let ((art files))
-      (while art
-	(if (not (assq (car art) articles)) (setq new (cons (car art) new)))
-	(setq art (cdr art))))
-    ;; Remove all deleted articles.
-    (let ((art articles))
-      (while art
-	(if (not (memq (caar art) files))
-	    (setq articles (delq (car art) articles)))
-	(setq art (cdr art))))
-    ;; Check whether the highest-numbered articles really are the ones
-    ;; that Gnus thinks they are by looking at the time-stamps.
-    (let ((art articles))
-      (while (and art 
-		  (not (equal 
-			(nth 5 (file-attributes 
-				(concat dir (int-to-string (caar art)))))
-			(cdar art))))
-	(setq articles (delq (car art) articles))
-	(setq new (cons (caar art) new))
-	(setq art (cdr art))))
-    ;; Go through all the new articles and add them, and their
-    ;; time-stamps to the list.
-    (let ((n new))
-      (while n
-	(setq articles 
-	      (cons (cons 
-		     (car n)
-		     (nth 5 (file-attributes 
-			     (concat dir (int-to-string (car n))))))
-		    articles))
-	(setq n (cdr n))))
-    ;; Make Gnus mark all new articles as unread.
-    (or (zerop (length new))
-	(gnus-make-articles-unread 
-	 (gnus-group-prefixed-name group (list 'nnmh ""))
-	 (setq new (sort new '<))))
-    ;; Sort the article list with highest numbers first.
-    (setq articles (sort articles (lambda (art1 art2) 
-				    (> (car art1) (car art2)))))
-    ;; Finally write this list back to the .nnmh-articles file.
-    (save-excursion
-      (set-buffer (get-buffer-create "*nnmh out*"))
-      (insert ";; Gnus article active file for " group "\n\n")
-      (insert "(setq nnmh-newsgroup-articles '")
-      (insert (prin1-to-string articles) ")\n")
-      (write-region (point-min) (point-max) nnmh-file nil 'nomesg)
-      (kill-buffer (current-buffer)))))
-
-(defun nnmh-deletable-article-p (group article)
-  "Say whether ARTICLE in GROUP can be deleted."
-  (let ((path (concat nnmh-current-directory (int-to-string article))))
-    (and (file-writable-p path)
-	 (or (not nnmail-keep-last-article)
-	     (not (eq (cdr (nth 1 (assoc group nnmh-group-alist))) 
-		      article))))))
-
-(provide 'nnmh)
-
-;;; nnmh.el ends here
diff --git a/lisp/nnml.el b/lisp/nnml.el
deleted file mode 100644
index 89c97ee9b95..00000000000
--- a/lisp/nnml.el
+++ /dev/null
@@ -1,764 +0,0 @@
-;;; nnml.el --- mail spool access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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:
-
-;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.  
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnmail)
-(require 'nnoo)
-(require 'cl)
-
-(nnoo-declare nnml)
-
-(defvoo nnml-directory message-directory
-  "Mail spool directory.")
-
-(defvoo nnml-active-file 
-  (concat (file-name-as-directory nnml-directory) "active")
-  "Mail active file.")
-
-(defvoo nnml-newsgroups-file 
-  (concat (file-name-as-directory nnml-directory) "newsgroups")
-  "Mail newsgroups description file.")
-
-(defvoo nnml-get-new-mail t
-  "If non-nil, nnml will check the incoming mail file and split the mail.")
-
-(defvoo nnml-nov-is-evil nil
-  "If non-nil, Gnus will never generate and use nov databases for mail groups.
-Using nov databases will speed up header fetching considerably.
-This variable shouldn't be flipped much. If you have, for some reason,
-set this to t, and want to set it to nil again, you should always run
-the `nnml-generate-nov-databases' command. The function will go
-through all nnml directories and generate nov databases for them
-all. This may very well take some time.")
-
-(defvoo nnml-prepare-save-mail-hook nil
-  "Hook run narrowed to an article before saving.")
-
-(defvoo nnml-inhibit-expiry nil
-  "If non-nil, inhibit expiry.")
-
-
-
-
-(defconst nnml-version "nnml 1.0"
-  "nnml version.")
-
-(defvoo nnml-nov-file-name ".overview")
-
-(defvoo nnml-current-directory nil)
-(defvoo nnml-current-group nil)
-(defvoo nnml-status-string "")
-(defvoo nnml-nov-buffer-alist nil)
-(defvoo nnml-group-alist nil)
-(defvoo nnml-active-timestamp nil)
-(defvoo nnml-article-file-alist nil)
-
-(defvoo nnml-generate-active-function 'nnml-generate-active-info)
-
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nnml)
-
-(deffoo nnml-retrieve-headers (sequence &optional newsgroup server fetch-old)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (let ((file nil)
-	  (number (length sequence))
-	  (count 0)
-	  beg article)
-      (if (stringp (car sequence))
-	  'headers
-	(nnml-possibly-change-directory newsgroup server)
-	(unless nnml-article-file-alist
-	  (setq nnml-article-file-alist
-		(nnheader-article-to-file-alist nnml-current-directory)))
-	(if (nnml-retrieve-headers-with-nov sequence fetch-old)
-	    'nov
-	  (while sequence
-	    (setq article (car sequence))
-	    (setq file 
-		  (concat nnml-current-directory 
-			  (or (cdr (assq article nnml-article-file-alist))
-			      "")))
-	    (if (and (file-exists-p file)
-		     (not (file-directory-p file)))
-		(progn
-		  (insert (format "221 %d Article retrieved.\n" article))
-		  (setq beg (point))
-		  (nnheader-insert-head file)
-		  (goto-char beg)
-		  (if (search-forward "\n\n" nil t)
-		      (forward-char -1)
-		    (goto-char (point-max))
-		    (insert "\n\n"))
-		  (insert ".\n")
-		  (delete-region (point) (point-max))))
-	    (setq sequence (cdr sequence))
-	    (setq count (1+ count))
-	    (and (numberp nnmail-large-newsgroup)
-		 (> number nnmail-large-newsgroup)
-		 (zerop (% count 20))
-		 (nnheader-message 6 "nnml: Receiving headers... %d%%"
-				   (/ (* count 100) number))))
-
-	  (and (numberp nnmail-large-newsgroup)
-	       (> number nnmail-large-newsgroup)
-	       (nnheader-message 6 "nnml: Receiving headers...done"))
-
-	  (nnheader-fold-continuation-lines)
-	  'headers)))))
-
-(deffoo nnml-open-server (server &optional defs)
-  (nnoo-change-server 'nnml server defs)
-  (when (not (file-exists-p nnml-directory))
-    (condition-case ()
-	(make-directory nnml-directory t)
-      (error t)))
-  (cond 
-   ((not (file-exists-p nnml-directory))
-    (nnml-close-server)
-    (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
-   ((not (file-directory-p (file-truename nnml-directory)))
-    (nnml-close-server)
-    (nnheader-report 'nnml "Not a directory: %s" nnml-directory))
-   (t
-    (nnheader-report 'nnml "Opened server %s using directory %s"
-		     server nnml-directory)
-    t)))
-
-(deffoo nnml-request-article (id &optional newsgroup server buffer)
-  (nnml-possibly-change-directory newsgroup server)
-  (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
-	 file path gpath group-num)
-    (if (stringp id)
-	(when (and (setq group-num (nnml-find-group-number id))
-		   (setq file (cdr
-			       (assq (cdr group-num) 
-				     (nnheader-article-to-file-alist
-				      (setq gpath
-					    (nnmail-group-pathname
-					     (car group-num) 
-					     nnml-directory)))))))
-	  (setq path (concat gpath (int-to-string (cdr group-num)))))
-      (unless nnml-article-file-alist
-	(setq nnml-article-file-alist
-	      (nnheader-article-to-file-alist nnml-current-directory)))
-      (when (setq file (cdr (assq id nnml-article-file-alist)))
-	(setq path (concat nnml-current-directory file))))
-    (cond 
-     ((not path)
-      (nnheader-report 'nnml "No such article: %s" id))
-     ((not (file-exists-p path))
-      (nnheader-report 'nnml "No such file: %s" path))
-     ((file-directory-p path)
-      (nnheader-report 'nnml "File is a directory: %s" path))
-     ((not (save-excursion (nnmail-find-file path)))
-      (nnheader-report 'nnml "Couldn't read file: %s" path))
-     (t
-      (nnheader-report 'nnml "Article %s retrieved" id)
-      ;; We return the article number.
-      (cons newsgroup (string-to-int (file-name-nondirectory path)))))))
-
-(deffoo nnml-request-group (group &optional server dont-check)
-  (cond 
-   ((not (nnml-possibly-change-directory group server))
-    (nnheader-report 'nnml "Invalid group (no such directory)"))
-   ((not (file-directory-p nnml-current-directory))
-    (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
-   (dont-check 
-    (nnheader-report 'nnml "Group %s selected" group)
-    t)
-   (t
-    (nnmail-activate 'nnml)
-    (let ((active (nth 1 (assoc group nnml-group-alist))))
-      (if (not active)
-	  (nnheader-report 'nnml "No such group: %s" group)
-	(nnheader-report 'nnml "Selected group %s" group)
-	(nnheader-insert "211 %d %d %d %s\n" 
-			 (max (1+ (- (cdr active) (car active))) 0)
-			 (car active) (cdr active) group))))))
-
-(deffoo nnml-request-scan (&optional group server)
-  (setq nnml-article-file-alist nil)
-  (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
-
-(deffoo nnml-close-group (group &optional server)
-  (setq nnml-article-file-alist nil)
-  t)
-
-(deffoo nnml-request-create-group (group &optional server) 
-  (nnmail-activate 'nnml)
-  (or (assoc group nnml-group-alist)
-      (let (active)
-	(setq nnml-group-alist (cons (list group (setq active (cons 1 0)))
-				     nnml-group-alist))
-	(nnml-possibly-create-directory group)
-	(nnml-possibly-change-directory group server)
-	(let ((articles 
-	       (nnheader-directory-articles nnml-current-directory )))
-	  (and articles
-	       (progn
-		 (setcar active (apply 'min articles))
-		 (setcdr active (apply 'max articles)))))
-	(nnmail-save-active nnml-group-alist nnml-active-file)))
-  t)
-
-(deffoo nnml-request-list (&optional server)
-  (save-excursion
-    (nnmail-find-file nnml-active-file)
-    (setq nnml-group-alist (nnmail-get-active))))
-
-(deffoo nnml-request-newgroups (date &optional server)
-  (nnml-request-list server))
-
-(deffoo nnml-request-list-newsgroups (&optional server)
-  (save-excursion
-    (nnmail-find-file nnml-newsgroups-file)))
-
-(deffoo nnml-request-expire-articles (articles newsgroup &optional server force)
-  (nnml-possibly-change-directory newsgroup server)
-  (let* ((active-articles 
-	  (nnheader-directory-articles nnml-current-directory))
-	 (is-old t)
-	 article rest mod-time number)
-    (nnmail-activate 'nnml)
-
-    (unless nnml-article-file-alist
-      (setq nnml-article-file-alist
-	    (nnheader-article-to-file-alist nnml-current-directory)))
-
-    (while (and articles is-old)
-      (setq article (concat nnml-current-directory 
-			    (int-to-string 
-			     (setq number (pop articles)))))
-      (when (setq mod-time (nth 5 (file-attributes article)))
-	(if (and (nnml-deletable-article-p newsgroup number)
-		 (setq is-old 
-		       (nnmail-expired-article-p newsgroup mod-time force
-						 nnml-inhibit-expiry)))
-	    (progn
-	      (nnheader-message 5 "Deleting article %s in %s..."
-				article newsgroup)
-	      (condition-case ()
-		  (funcall nnmail-delete-file-function article)
-		(file-error
-		 (push number rest)))
-	      (setq active-articles (delq number active-articles))
-	      (nnml-nov-delete-article newsgroup number))
-	  (push number rest))))
-    (let ((active (nth 1 (assoc newsgroup nnml-group-alist))))
-      (when active
-	(setcar active (or (and active-articles
-				(apply 'min active-articles))
-			   (1+ (cdr active)))))
-      (nnmail-save-active nnml-group-alist nnml-active-file))
-    (nnml-save-nov)
-    (message "")
-    (nconc rest articles)))
-
-(deffoo nnml-request-move-article 
-  (article group server accept-form &optional last)
-  (let ((buf (get-buffer-create " *nnml move*"))
-	result)
-    (nnml-possibly-change-directory group server)
-    (unless nnml-article-file-alist
-      (setq nnml-article-file-alist
-	    (nnheader-article-to-file-alist nnml-current-directory)))
-    (and 
-     (nnml-deletable-article-p group article)
-     (nnml-request-article article group server)
-     (save-excursion
-       (set-buffer buf)
-       (insert-buffer-substring nntp-server-buffer)
-       (setq result (eval accept-form))
-       (kill-buffer (current-buffer))
-       result)
-     (progn
-       (nnml-possibly-change-directory group server)
-       (condition-case ()
-	   (funcall nnmail-delete-file-function
-		    (concat nnml-current-directory 
-			    (int-to-string article)))
-	 (file-error nil))
-       (nnml-nov-delete-article group article)
-       (and last (nnml-save-nov))))
-    result))
-
-(deffoo nnml-request-accept-article (group &optional server last)
-  (nnml-possibly-change-directory group server)
-  (nnmail-check-syntax)
-  (let (result)
-    (if (stringp group)
-	(and 
-	 (nnmail-activate 'nnml)
-	 ;; We trick the choosing function into believing that only one
-	 ;; group is available.  
-	 (let ((nnmail-split-methods (list (list group ""))))
-	   (setq result (car (nnml-save-mail))))
-	 (progn
-	   (nnmail-save-active nnml-group-alist nnml-active-file)
-	   (and last (nnml-save-nov))))
-      (and
-       (nnmail-activate 'nnml)
-       (setq result (car (nnml-save-mail)))
-       (progn
-	 (nnmail-save-active nnml-group-alist nnml-active-file)
-	 (and last (nnml-save-nov)))))
-    result))
-
-(deffoo nnml-request-replace-article (article group buffer)
-  (nnml-possibly-change-directory group)
-  (save-excursion
-    (set-buffer buffer)
-    (nnml-possibly-create-directory group)
-    (let ((chars (nnmail-insert-lines))
-	  (art (concat (int-to-string article) "\t"))
-	  headers)
-      (when (condition-case ()
-		(progn
-		  (write-region 
-		   (point-min) (point-max)
-		   (concat nnml-current-directory (int-to-string article))
-		   nil (if (nnheader-be-verbose 5) nil 'nomesg))
-		  t)
-	      (error nil))
-	(setq headers (nnml-parse-head chars article))
-	;; Replace the NOV line in the NOV file.
-	(save-excursion 
-	  (set-buffer (nnml-open-nov group))
-	  (goto-char (point-min))
-	  (if (or (looking-at art)
-		  (search-forward (concat "\n" art) nil t))
-	      ;; Delete the old NOV line.
-	      (delete-region (progn (beginning-of-line) (point))
-			     (progn (forward-line 1) (point)))
-	    ;; The line isn't here, so we have to find out where
-	    ;; we should insert it. (This situation should never
-	    ;; occur, but one likes to make sure...)
-	    (while (and (looking-at "[0-9]+\t")
-			(< (string-to-int 
-			    (buffer-substring 
-			     (match-beginning 0) (match-end 0)))
-			   article)
-			(zerop (forward-line 1)))))
-	  (beginning-of-line)
-	  (nnheader-insert-nov headers)
-	  (nnml-save-nov)
-	  t)))))
-
-(deffoo nnml-request-delete-group (group &optional force server)
-  (nnml-possibly-change-directory group server)
-  (when force
-    ;; Delete all articles in GROUP.
-    (let ((articles 
-	   (directory-files 
-	    nnml-current-directory t
-	    (concat nnheader-numerical-short-files
-		    "\\|" (regexp-quote nnml-nov-file-name) "$")))
-	  article)
-      (while articles 
-	(setq article (pop articles))
-	(when (file-writable-p article)
-	  (nnheader-message 5 "Deleting article %s in %s..." article group)
-	  (funcall nnmail-delete-file-function article))))
-    ;; Try to delete the directory itself.
-    (condition-case ()
-	(delete-directory nnml-current-directory)
-      (error nil)))
-  ;; Remove the group from all structures.
-  (setq nnml-group-alist 
-	(delq (assoc group nnml-group-alist) nnml-group-alist)
-	nnml-current-group nil
-	nnml-current-directory nil)
-  ;; Save the active file.
-  (nnmail-save-active nnml-group-alist nnml-active-file)
-  t)
-
-(deffoo nnml-request-rename-group (group new-name &optional server)
-  (nnml-possibly-change-directory group server)
-  ;; Rename directory.
-  (and (file-writable-p nnml-current-directory)
-       (condition-case ()
-	   (let ((parent 
-		  (file-name-directory
-		   (directory-file-name 
-		    (nnmail-group-pathname new-name nnml-directory)))))
-	     (unless (file-exists-p parent)
-	       (make-directory parent t))
-	     (rename-file 
-	      (directory-file-name nnml-current-directory)
-	      (directory-file-name 
-	       (nnmail-group-pathname new-name nnml-directory)))
-	     t)
-	 (error nil))
-       ;; That went ok, so we change the internal structures.
-       (let ((entry (assoc group nnml-group-alist)))
-	 (and entry (setcar entry new-name))
-	 (setq nnml-current-directory nil
-	       nnml-current-group nil)
-	 ;; Save the new group alist.
-	 (nnmail-save-active nnml-group-alist nnml-active-file)
-	 t)))
-
-
-;;; Internal functions.
-
-(defun nnml-deletable-article-p (group article)
-  "Say whether ARTICLE in GROUP can be deleted."
-  (let (file path)
-    (when (setq file (cdr (assq article nnml-article-file-alist)))
-      (setq path (concat nnml-current-directory file))
-      (and (file-writable-p path)
-	   (or (not nnmail-keep-last-article)
-	       (not (eq (cdr (nth 1 (assoc group nnml-group-alist))) 
-			article)))))))
-
-;; Find an article number in the current group given the Message-ID. 
-(defun nnml-find-group-number (id)
-  (save-excursion
-    (set-buffer (get-buffer-create " *nnml id*"))
-    (buffer-disable-undo (current-buffer))
-    (let ((alist nnml-group-alist)
-	  number)
-      ;; We want to look through all .overview files, but we want to
-      ;; start with the one in the current directory.  It seems most
-      ;; likely that the article we are looking for is in that group. 
-      (if (setq number (nnml-find-id nnml-current-group id))
-	  (cons nnml-current-group number)
-	;; It wasn't there, so we look through the other groups as well.
-	(while (and (not number)
-		    alist)
-	  (or (string= (caar alist) nnml-current-group)
-	      (setq number (nnml-find-id (caar alist) id)))
-	  (or number
-	      (setq alist (cdr alist))))
-	(and number
-	     (cons (caar alist) number))))))
-
-(defun nnml-find-id (group id)
-  (erase-buffer)
-  (let ((nov (concat (nnmail-group-pathname group nnml-directory)
-		     nnml-nov-file-name))
-	number found)
-    (when (file-exists-p nov)
-      (insert-file-contents nov)
-      (while (and (not found) 
-		  (search-forward id nil t)) ; We find the ID.
-	;; And the id is in the fourth field.
-	(if (search-backward 
-	     "\t" (save-excursion (beginning-of-line) (point)) t 4)
-	    (progn
-	      (beginning-of-line)
-	      (setq found t)
-	      ;; We return the article number.
-	      (setq number
-		    (condition-case ()
-			(read (current-buffer))
-		      (error nil))))))
-      number)))
-
-(defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
-  (if (or gnus-nov-is-evil nnml-nov-is-evil)
-      nil
-    (let ((first (car articles))
-	  (last (progn (while (cdr articles) (setq articles (cdr articles)))
-		       (car articles)))
-	  (nov (concat nnml-current-directory nnml-nov-file-name)))
-      (when (file-exists-p nov)
-	(save-excursion
-	  (set-buffer nntp-server-buffer)
-	  (erase-buffer)
-	  (insert-file-contents nov)
-	  (if (and fetch-old
-		   (not (numberp fetch-old)))
-	      t				; Don't remove anything.
-	    (if fetch-old
-		(setq first (max 1 (- first fetch-old))))
-	    (goto-char (point-min))
-	    (while (and (not (eobp)) (> first (read (current-buffer))))
-	      (forward-line 1))
-	    (beginning-of-line)
-	    (if (not (eobp)) (delete-region 1 (point)))
-	    (while (and (not (eobp)) (>= last (read (current-buffer))))
-	      (forward-line 1))
-	    (beginning-of-line)
-	    (if (not (eobp)) (delete-region (point) (point-max)))
-	    t))))))
-
-(defun nnml-possibly-change-directory (group &optional server)
-  (when (and server
-	     (not (nnml-server-opened server)))
-    (nnml-open-server server))
-  (when group
-    (let ((pathname (nnmail-group-pathname group nnml-directory)))
-      (when (not (equal pathname nnml-current-directory))
-	(setq nnml-current-directory pathname
-	      nnml-current-group group
-	      nnml-article-file-alist nil))))
-  t)
-
-(defun nnml-possibly-create-directory (group)
-  (let (dir dirs)
-    (setq dir (nnmail-group-pathname group nnml-directory))
-    (while (not (file-directory-p dir))
-      (setq dirs (cons dir dirs))
-      (setq dir (file-name-directory (directory-file-name dir))))
-    (while dirs
-      (make-directory (directory-file-name (car dirs)))
-      (nnheader-message 5 "Creating mail directory %s" (car dirs))
-      (setq dirs (cdr dirs)))))
-	     
-(defun nnml-save-mail ()
-  "Called narrowed to an article."
-  (let ((group-art (nreverse (nnmail-article-group 'nnml-active-number)))
-	chars headers)
-    (setq chars (nnmail-insert-lines))
-    (nnmail-insert-xref group-art)
-    (run-hooks 'nnmail-prepare-save-mail-hook)
-    (run-hooks 'nnml-prepare-save-mail-hook)
-    (goto-char (point-min))
-    (while (looking-at "From ")
-      (replace-match "X-From-Line: ")
-      (forward-line 1))
-    ;; We save the article in all the newsgroups it belongs in.
-    (let ((ga group-art)
-	  first)
-      (while ga
-	(nnml-possibly-create-directory (caar ga))
-	(let ((file (concat (nnmail-group-pathname 
-			     (caar ga) nnml-directory)
-			    (int-to-string (cdar ga)))))
-	  (if first
-	      ;; It was already saved, so we just make a hard link.
-	      (funcall nnmail-crosspost-link-function first file t)
-	    ;; Save the article.
-	    (write-region (point-min) (point-max) file nil 
-			  (if (nnheader-be-verbose 5) nil 'nomesg))
-	    (setq first file)))
-	(setq ga (cdr ga))))
-    ;; Generate a nov line for this article. We generate the nov
-    ;; line after saving, because nov generation destroys the
-    ;; header. 
-    (setq headers (nnml-parse-head chars))
-    ;; Output the nov line to all nov databases that should have it.
-    (let ((ga group-art))
-      (while ga
-	(nnml-add-nov (caar ga) (cdar ga) headers)
-	(setq ga (cdr ga))))
-    group-art))
-
-(defun nnml-active-number (group)
-  "Compute the next article number in GROUP."
-  (let ((active (cadr (assoc group nnml-group-alist))))
-    ;; The group wasn't known to nnml, so we just create an active
-    ;; entry for it.   
-    (unless active
-      ;; Perhaps the active file was corrupt?  See whether
-      ;; there are any articles in this group.
-      (nnml-possibly-create-directory group)
-      (nnml-possibly-change-directory group)
-      (unless nnml-article-file-alist
-	(setq nnml-article-file-alist
-	      (sort
-	       (nnheader-article-to-file-alist nnml-current-directory)
-	       (lambda (a1 a2) (< (car a1) (car a2))))))
-      (setq active
-	    (if nnml-article-file-alist
-		(cons (caar nnml-article-file-alist)
-		      (caar (last nnml-article-file-alist)))
-	      (cons 1 0)))
-      (setq nnml-group-alist (cons (list group active) nnml-group-alist)))
-    (setcdr active (1+ (cdr active)))
-    (while (file-exists-p
-	    (concat (nnmail-group-pathname group nnml-directory)
-		    (int-to-string (cdr active))))
-      (setcdr active (1+ (cdr active))))
-    (cdr active)))
-
-(defun nnml-add-nov (group article headers)
-  "Add a nov line for the GROUP base."
-  (save-excursion 
-    (set-buffer (nnml-open-nov group))
-    (goto-char (point-max))
-    (mail-header-set-number headers article)
-    (nnheader-insert-nov headers)))
-
-(defsubst nnml-header-value ()
-  (buffer-substring (match-end 0) (progn (end-of-line) (point))))
-
-(defun nnml-parse-head (chars &optional number)
-  "Parse the head of the current buffer."
-  (save-excursion
-    (save-restriction
-      (goto-char (point-min))
-      (narrow-to-region 
-       (point)
-       (1- (or (search-forward "\n\n" nil t) (point-max))))
-      ;; Fold continuation lines.
-      (goto-char (point-min))
-      (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
-	(replace-match " " t t))
-      ;; Remove any tabs; they are too confusing.
-      (subst-char-in-region (point-min) (point-max) ?\t ? )
-      (let ((headers (nnheader-parse-head t)))
-	(mail-header-set-chars headers chars)
-	(mail-header-set-number headers number)
-	headers))))
-
-(defun nnml-open-nov (group)
-  (or (cdr (assoc group nnml-nov-buffer-alist))
-      (let ((buffer (find-file-noselect 
-		     (concat (nnmail-group-pathname group nnml-directory)
-			     nnml-nov-file-name))))
-	(save-excursion
-	  (set-buffer buffer)
-	  (buffer-disable-undo (current-buffer)))
-	(setq nnml-nov-buffer-alist 
-	      (cons (cons group buffer) nnml-nov-buffer-alist))
-	buffer)))
-
-(defun nnml-save-nov ()
-  (save-excursion
-    (while nnml-nov-buffer-alist
-      (when (buffer-name (cdar nnml-nov-buffer-alist))
-	(set-buffer (cdar nnml-nov-buffer-alist))
-	(and (buffer-modified-p)
-	     (write-region 
-	      1 (point-max) (buffer-file-name) nil 'nomesg))
-	(set-buffer-modified-p nil)
-	(kill-buffer (current-buffer)))
-      (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
-
-;;;###autoload
-(defun nnml-generate-nov-databases ()
-  "Generate nov databases in all nnml directories."
-  (interactive)
-  ;; Read the active file to make sure we don't re-use articles 
-  ;; numbers in empty groups.
-  (nnmail-activate 'nnml)
-  (nnml-open-server (or (nnoo-current-server 'nnml) ""))
-  (setq nnml-directory (expand-file-name nnml-directory))
-  ;; Recurse down the directories.
-  (nnml-generate-nov-databases-1 nnml-directory)
-  ;; Save the active file.
-  (nnmail-save-active nnml-group-alist nnml-active-file))
-
-(defun nnml-generate-nov-databases-1 (dir)
-  (setq dir (file-name-as-directory dir))
-  ;; We descend recursively 
-  (let ((dirs (directory-files dir t nil t))
-	dir)
-    (while dirs 
-      (setq dir (pop dirs))
-      (when (and (not (member (file-name-nondirectory dir) '("." "..")))
-		 (file-directory-p dir))
-	(nnml-generate-nov-databases-1 dir))))
-  ;; Do this directory.
-  (let ((files (sort
-		(mapcar
-		 (lambda (name) (string-to-int name))
-		 (directory-files dir nil "^[0-9]+$" t))
-		'<)))
-    (when files
-      (funcall nnml-generate-active-function dir)
-      ;; Generate the nov file.
-      (nnml-generate-nov-file dir files))))
-
-(defvar files)
-(defun nnml-generate-active-info (dir)
-  ;; Update the active info for this group.
-  (let ((group (nnheader-file-to-group 
-		(directory-file-name dir) nnml-directory)))
-    (setq nnml-group-alist
-	  (delq (assoc group nnml-group-alist) nnml-group-alist))
-    (push (list group
-		(cons (car files)
-		      (let ((f files))
-			(while (cdr f) (setq f (cdr f)))
-			(car f))))
-	  nnml-group-alist)))
-
-(defun nnml-generate-nov-file (dir files)
-  (let* ((dir (file-name-as-directory dir))
-	 (nov (concat dir nnml-nov-file-name))
-	 (nov-buffer (get-buffer-create " *nov*"))
-	 nov-line chars file headers)
-    (save-excursion
-      ;; Init the nov buffer.
-      (set-buffer nov-buffer)
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (set-buffer nntp-server-buffer)
-      ;; Delete the old NOV file.
-      (when (file-exists-p nov)
-	(funcall nnmail-delete-file-function nov))
-      (while files
-	(unless (file-directory-p 
-		 (setq file (concat dir (int-to-string (car files)))))
-	  (erase-buffer)
-	  (insert-file-contents file)
-	  (narrow-to-region 
-	   (goto-char (point-min))
-	   (progn
-	     (search-forward "\n\n" nil t)
-	     (setq chars (- (point-max) (point)))
-	     (max 1 (1- (point)))))
-	  (when (and (not (= 0 chars))	; none of them empty files...
-		     (not (= (point-min) (point-max))))
-	    (goto-char (point-min))
-	    (setq headers (nnml-parse-head chars (car files)))
-	    (save-excursion
-	      (set-buffer nov-buffer)
-	      (goto-char (point-max))
-	      (nnheader-insert-nov headers)))
-	  (widen))
-	(setq files (cdr files)))
-      (save-excursion
-	(set-buffer nov-buffer)
-	(write-region 1 (point-max) (expand-file-name nov) nil
-		      'nomesg)
-	(kill-buffer (current-buffer))))))
-
-(defun nnml-nov-delete-article (group article)
-  (save-excursion
-    (set-buffer (nnml-open-nov group))
-    (goto-char (point-min))
-    (if (re-search-forward (concat "^" (int-to-string article) "\t") nil t)
-	(delete-region (match-beginning 0) (progn (forward-line 1) (point))))
-    t))
-
-(provide 'nnml)
-
-;;; nnml.el ends here
diff --git a/lisp/nnoo.el b/lisp/nnoo.el
deleted file mode 100644
index cddba4ae564..00000000000
--- a/lisp/nnoo.el
+++ /dev/null
@@ -1,251 +0,0 @@
-;;; nnoo.el --- OO Gnus Backends
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(eval-when-compile (require 'cl))
-
-(defvar nnoo-definition-alist nil)
-(defvar nnoo-state-alist nil)
-
-(defmacro defvoo (var init &optional doc &rest map)
-  "The same as `defvar', only takes list of variables to MAP to."
-  `(prog1
-       ,(if doc
-	    `(defvar ,var ,init ,doc)
-	  `(defvar ,var ,init))
-     (nnoo-define ',var ',map)))
-(put 'defvoo 'lisp-indent-function 2)
-(put 'defvoo 'lisp-indent-hook 2)
-(put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map))
-
-(defmacro deffoo (func args &rest forms)
-  "The same as `defun', only register FUNC."
-  `(prog1
-       (defun ,func ,args ,@forms)
-     (nnoo-register-function ',func)))
-(put 'deffoo 'lisp-indent-function 2)
-(put 'deffoo 'lisp-indent-hook 2)
-(put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body))
-
-(defun nnoo-register-function (func)
-  (let ((funcs (nthcdr 3 (assoc (nnoo-backend func) 
-				nnoo-definition-alist))))
-    (unless funcs
-      (error "%s belongs to a backend that hasn't been declared" func))
-    (setcar funcs (cons func (car funcs)))))
-
-(defmacro nnoo-declare (backend &rest parents)
-  `(eval-and-compile
-     (push (list ',backend 
-		 (mapcar (lambda (p) (list p)) ',parents)
-		 nil nil)
-	   nnoo-definition-alist)))
-(put 'nnoo-declare 'lisp-indent-function 1)
-(put 'nnoo-declare 'lisp-indent-hook 1)
-
-(defun nnoo-parents (backend)
-  (nth 1 (assoc backend nnoo-definition-alist)))
-
-(defun nnoo-variables (backend)
-  (nth 2 (assoc backend nnoo-definition-alist)))
-
-(defun nnoo-functions (backend)
-  (nth 3 (assoc backend nnoo-definition-alist)))
-
-(defmacro nnoo-import (backend &rest imports)
-  `(nnoo-import-1 ',backend ',imports))
-(put 'nnoo-import 'lisp-indent-function 1)
-(put 'nnoo-import 'lisp-indent-hook 1)
-
-(defun nnoo-import-1 (backend imports)
-  (let ((call-function
-	 (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function))
-	imp functions function)
-    (while (setq imp (pop imports))
-      (setq functions
-	    (or (cdr imp)
-		(nnoo-functions (car imp))))
-      (while functions
-	(unless (fboundp (setq function
-			       (nnoo-symbol backend (nnoo-rest-symbol
-							 (car functions)))))
-	  (eval `(deffoo ,function (&rest args)
-		   (,call-function ',backend ',(car functions) args))))
-	(pop functions)))))
-
-(defun nnoo-parent-function (backend function args)
-  (let* ((pbackend (nnoo-backend function)))
-    (nnoo-change-server pbackend (nnoo-current-server backend)
-			(cdr (assq pbackend (nnoo-parents backend))))
-    (apply function args)))
-
-(defun nnoo-execute (backend function &rest args)
-  "Execute FUNCTION on behalf of BACKEND."
-  (let* ((pbackend (nnoo-backend function)))
-    (nnoo-change-server pbackend (nnoo-current-server backend)
-			(cdr (assq pbackend (nnoo-parents backend))))
-    (apply function args)))
-
-(defmacro nnoo-map-functions (backend &rest maps)
-  `(nnoo-map-functions-1 ',backend ',maps))
-(put 'nnoo-map-functions 'lisp-indent-function 1)
-(put 'nnoo-map-functions 'lisp-indent-hook 1)
-
-(defun nnoo-map-functions-1 (backend maps)
-  (let (m margs i)
-    (while (setq m (pop maps))
-      (setq i 0
-	    margs nil)
-      (while (< i (length (cdr m)))
-	(if (numberp (nth i (cdr m)))
-	    (push `(nth ,i args) margs)
-	  (push (nth i (cdr m)) margs))
-	(incf i))
-      (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
-		 (&rest args)
-	       (nnoo-parent-function ',backend ',(car m) 
-				     ,(cons 'list (nreverse margs))))))))
-  
-(defun nnoo-backend (symbol)
-  (string-match "^[^-]+-" (symbol-name symbol))
-  (intern (substring (symbol-name symbol) 0 (1- (match-end 0)))))
-
-(defun nnoo-rest-symbol (symbol)
-  (string-match "^[^-]+-" (symbol-name symbol))
-  (intern (substring (symbol-name symbol) (match-end 0))))
-
-(defun nnoo-symbol (backend symbol)
-  (intern (format "%s-%s" backend symbol)))
-
-(defun nnoo-define (var map)
-  (let* ((backend (nnoo-backend var))
-	 (def (assq backend nnoo-definition-alist))
-	 (parents (nth 1 def)))
-    (unless def
-      (error "%s belongs to a backend that hasn't been declared." var))
-    (setcar (nthcdr 2 def) 
-	    (delq (assq var (nth 2 def)) (nth 2 def)))
-    (setcar (nthcdr 2 def)
-	    (cons (cons var (symbol-value var))
-		  (nth 2 def)))
-    (while map
-      (nconc (assq (nnoo-backend (car map)) parents)
-	     (list (list (pop map) var))))))
-
-(defun nnoo-change-server (backend server defs)
-  (let* ((bstate (cdr (assq backend nnoo-state-alist)))
-	 (sdefs (assq backend nnoo-definition-alist))
-	 (current (car bstate))
-	 (parents (nnoo-parents backend))
-	 state)
-    (unless bstate
-      (push (setq bstate (list backend nil))
-	    nnoo-state-alist)
-      (pop bstate))
-    (if (equal server current)
-	t
-      (nnoo-push-server backend current)
-      (setq state (or (cdr (assoc server (cddr bstate)))
-		      (nnoo-variables backend)))
-      (while state
-	(set (caar state) (cdar state))
-	(pop state))
-      (setcar bstate server)
-      (unless (cdr (assoc server (cddr bstate)))
-	(while defs
-	  (set (caar defs) (cadar defs))
-	  (pop defs)))
-      (while parents
-	(nnoo-change-server 
-	 (caar parents) server 
-	 (mapcar (lambda (def) (list (car def) (symbol-value (cadr def))))
-		 (cdar parents)))
-	(pop parents))))
-  t)
-
-(defun nnoo-push-server (backend current)
-  (let ((bstate (assq backend nnoo-state-alist))
-	(defs (nnoo-variables backend)))
-    ;; Remove the old definition.
-    (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate)))
-    (let (state)
-      (while defs
-	(push (cons (caar defs) (symbol-value (caar defs)))
-	      state)
-	(pop defs))
-      (nconc bstate (list (cons current state))))))
-
-(defun nnoo-current-server-p (backend server)
-  (equal (nnoo-current-server backend) server))
-
-(defun nnoo-current-server (backend)
-  (nth 1 (assq backend nnoo-state-alist)))
-
-(defun nnoo-close-server (backend &optional server)
-  (unless server
-    (setq server (nnoo-current-server backend)))
-  (when server
-    (let* ((bstate (cdr (assq backend nnoo-state-alist)))
-	   (defs (assoc server (cdr bstate))))
-      (when bstate
-	(setcar bstate nil)
-	(setcdr bstate (delq defs (cdr bstate)))
-	(pop defs)
-	(while defs
-	  (set (car (pop defs)) nil)))))
-  t)
-
-(defun nnoo-close (backend)
-  (setq nnoo-state-alist
-	(delq (assq backend nnoo-state-alist)
-	      nnoo-state-alist))
-  t)
-
-(defun nnoo-status-message (backend server)
-  (nnheader-get-report backend))
-
-(defun nnoo-server-opened (backend server)
-  (and (nnoo-current-server-p backend server)
-       nntp-server-buffer
-       (buffer-name nntp-server-buffer)))
-
-(defmacro nnoo-define-basics (backend)
-  `(eval-and-compile
-     (nnoo-define-basics-1 ',backend)))
-
-(defun nnoo-define-basics-1 (backend)
-  (let ((functions '(close-server server-opened status-message)))
-    (while functions
-      (eval `(deffoo ,(nnoo-symbol backend (car functions)) 
-		 (&optional server)
-	       (,(nnoo-symbol 'nnoo (pop functions)) ',backend server)))))
-  (eval `(deffoo ,(nnoo-symbol backend 'open-server)
-	     (server &optional defs)
-	   (nnoo-change-server ',backend server defs))))
-
-(provide 'nnoo)
-
-;;; nnoo.el ends here.
diff --git a/lisp/nnsoup.el b/lisp/nnsoup.el
deleted file mode 100644
index 03e80fef9ab..00000000000
--- a/lisp/nnsoup.el
+++ /dev/null
@@ -1,747 +0,0 @@
-;;; nnsoup.el --- SOUP access for Gnus
-;; Copyright (C) 1995,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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:
-
-(require 'nnheader)
-(require 'nnmail)
-(require 'gnus-soup)
-(require 'gnus-msg)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnsoup)
-
-(defvoo nnsoup-directory "~/SOUP/"
-  "*SOUP packet directory.")
-
-(defvoo nnsoup-tmp-directory "/tmp/"
-  "*Where nnsoup will store temporary files.")
-
-(defvoo nnsoup-replies-directory (concat nnsoup-directory "replies/")
-  "*Directory where outgoing packets will be composed.")
-
-(defvoo nnsoup-replies-format-type ?n
-  "*Format of the replies packages.")
-
-(defvoo nnsoup-replies-index-type ?n
-  "*Index type of the replies packages.")
-
-(defvoo nnsoup-active-file (concat nnsoup-directory "active")
-  "Active file.")
-
-(defvoo nnsoup-packer "tar cf - %s | gzip > $HOME/Soupin%d.tgz"
-  "Format string command for packing a SOUP packet.
-The SOUP files will be inserted where the %s is in the string.
-This string MUST contain both %s and %d. The file number will be
-inserted where %d appears.")
-
-(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -"
-  "*Format string command for unpacking a SOUP packet.
-The SOUP packet file name will be inserted at the %s.")
-
-(defvoo nnsoup-packet-directory "~/"
-  "*Where nnsoup will look for incoming packets.")
-
-(defvoo nnsoup-packet-regexp "Soupout"
-  "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
-
-
-
-(defconst nnsoup-version "nnsoup 0.0"
-  "nnsoup version.")
-
-(defvoo nnsoup-status-string "")
-(defvoo nnsoup-group-alist nil)
-(defvoo nnsoup-current-prefix 0)
-(defvoo nnsoup-replies-list nil)
-(defvoo nnsoup-buffers nil)
-(defvoo nnsoup-current-group nil)
-(defvoo nnsoup-group-alist-touched nil)
-
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nnsoup)
-
-(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old)
-  (nnsoup-possibly-change-group group)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist)))
-	  (articles sequence)
-	  (use-nov t)
-	  useful-areas this-area-seq msg-buf)
-      (if (stringp (car sequence))
-	  ;; We don't support fetching by Message-ID.
-	  'headers
-	;; We go through all the areas and find which files the
-	;; articles in SEQUENCE come from.
-	(while (and areas sequence)
-	  ;; Peel off areas that are below sequence.
-	  (while (and areas (< (cdaar areas) (car sequence)))
-	    (setq areas (cdr areas)))
-	  (when areas
-	    ;; This is a useful area.
-	    (push (car areas) useful-areas)
-	    (setq this-area-seq nil)
-	    ;; We take note whether this MSG has a corresponding IDX
-	    ;; for later use.
-	    (when (or (= (gnus-soup-encoding-index 
-			  (gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
-		      (not (file-exists-p
-			    (nnsoup-file
-			     (gnus-soup-area-prefix (nth 1 (car areas)))))))
-	      (setq use-nov nil))
-	    ;; We assign the portion of `sequence' that is relevant to
-	    ;; this MSG packet to this packet.
-	    (while (and sequence (<= (car sequence) (cdaar areas)))
-	      (push (car sequence) this-area-seq)
-	      (setq sequence (cdr sequence)))
-	    (setcar useful-areas (cons (nreverse this-area-seq)
-				       (car useful-areas)))))
-
-	;; We now have a list of article numbers and corresponding
-	;; areas. 
-	(setq useful-areas (nreverse useful-areas))
-
-	;; Two different approaches depending on whether all the MSG
-	;; files have corresponding IDX files.  If they all do, we
-	;; simply return the relevant IDX files and let Gnus sort out
-	;; what lines are relevant.  If some of the IDX files are
-	;; missing, we must return HEADs for all the articles.
-	(if use-nov
-	    ;; We have IDX files for all areas.
-	    (progn
-	      (while useful-areas
-		(goto-char (point-max))
-		(let ((b (point))
-		      (number (car (nth 1 (car useful-areas))))
-		      (index-buffer (nnsoup-index-buffer
-				     (gnus-soup-area-prefix
-				      (nth 2 (car useful-areas))))))
-		  (when index-buffer
-		    (insert-buffer-substring index-buffer)
-		    (goto-char b)
-		    ;; We have to remove the index number entires and
-		    ;; insert article numbers instead.
-		    (while (looking-at "[0-9]+")
-		      (replace-match (int-to-string number) t t)
-		      (incf number)
-		      (forward-line 1))))
-		(setq useful-areas (cdr useful-areas)))
-	      'nov)
-	  ;; We insert HEADs.
-	  (while useful-areas
-	    (setq articles (caar useful-areas)
-		  useful-areas (cdr useful-areas))
-	    (while articles
-	      (when (setq msg-buf
-			  (nnsoup-narrow-to-article 
-			   (car articles) (cdar useful-areas) 'head))
-		(goto-char (point-max))
-		(insert (format "221 %d Article retrieved.\n" (car articles)))
-		(insert-buffer-substring msg-buf)
-		(goto-char (point-max))
-		(insert ".\n"))
-	      (setq articles (cdr articles))))
-
-	  (nnheader-fold-continuation-lines)
-	  'headers)))))
-
-(deffoo nnsoup-open-server (server &optional defs)
-  (nnoo-change-server 'nnsoup server defs)
-  (when (not (file-exists-p nnsoup-directory))
-    (condition-case ()
-	(make-directory nnsoup-directory t)
-      (error t)))
-  (cond 
-   ((not (file-exists-p nnsoup-directory))
-    (nnsoup-close-server)
-    (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
-   ((not (file-directory-p (file-truename nnsoup-directory)))
-    (nnsoup-close-server)
-    (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory))
-   (t
-    (nnsoup-read-active-file)
-    (nnheader-report 'nnsoup "Opened server %s using directory %s"
-		     server nnsoup-directory)
-    t)))
-
-(deffoo nnsoup-request-close ()
-  (nnsoup-write-active-file)
-  (nnsoup-write-replies)
-  (gnus-soup-save-areas)
-  ;; Kill all nnsoup buffers.
-  (let (buffer)
-    (while nnsoup-buffers
-      (setq buffer (cdr (pop nnsoup-buffers)))
-      (and buffer
-	   (buffer-name buffer)
-	   (kill-buffer buffer))))
-  (setq nnsoup-group-alist nil
-	nnsoup-group-alist-touched nil
-	nnsoup-current-group nil
-	nnsoup-replies-list nil)
-  (nnoo-close-server 'nnoo)
-  t)
-
-(deffoo nnsoup-request-article (id &optional newsgroup server buffer)
-  (nnsoup-possibly-change-group newsgroup)
-  (let (buf)
-    (save-excursion
-      (set-buffer (or buffer nntp-server-buffer))
-      (erase-buffer)
-      (when (and (not (stringp id))
-		 (setq buf (nnsoup-narrow-to-article id)))
-	(insert-buffer-substring buf)
-	t))))
-
-(deffoo nnsoup-request-group (group &optional server dont-check)
-  (nnsoup-possibly-change-group group)
-  (if dont-check 
-      t
-    (let ((active (cadr (assoc group nnsoup-group-alist))))
-      (if (not active)
-	  (nnheader-report 'nnsoup "No such group: %s" group)
-	(nnheader-insert 
-	 "211 %d %d %d %s\n" 
-	 (max (1+ (- (cdr active) (car active))) 0) 
-	 (car active) (cdr active) group)))))
-
-(deffoo nnsoup-request-type (group &optional article)
-  (nnsoup-possibly-change-group group)
-  (if (not article)
-      'unknown
-    (let ((kind (gnus-soup-encoding-kind 
-		 (gnus-soup-area-encoding
-		  (nth 1 (nnsoup-article-to-area
-			  article nnsoup-current-group))))))
-      (cond ((= kind ?m) 'mail)
-	    ((= kind ?n) 'news)
-	    (t 'unknown)))))
-
-(deffoo nnsoup-close-group (group &optional server)
-  ;; Kill all nnsoup buffers.
-  (let ((buffers nnsoup-buffers)
-	elem)
-    (while buffers
-      (when (equal (car (setq elem (pop buffers))) group)
-	(setq nnsoup-buffers (delq elem nnsoup-buffers))
-	(and (cdr elem) (buffer-name (cdr elem))
-	     (kill-buffer (cdr elem))))))
-  t)
-
-(deffoo nnsoup-request-list (&optional server)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (unless nnsoup-group-alist
-      (nnsoup-read-active-file))
-    (let ((alist nnsoup-group-alist)
-	  (standard-output (current-buffer))
-	  entry)
-      (while (setq entry (pop alist))
-	(insert (car entry) " ")
-	(princ (cdadr entry))
-	(insert " ")
-	(princ (caadr entry))
-	(insert " y\n"))
-      t)))
-
-(deffoo nnsoup-request-scan (group &optional server)
-  (nnsoup-unpack-packets))
-
-(deffoo nnsoup-request-newgroups (date &optional server)
-  (nnsoup-request-list))
-
-(deffoo nnsoup-request-list-newsgroups (&optional server)
-  nil)
-
-(deffoo nnsoup-request-post (&optional server)
-  (nnsoup-store-reply "news")
-  t)
-
-(deffoo nnsoup-request-mail (&optional server)
-  (nnsoup-store-reply "mail")
-  t)
-
-(deffoo nnsoup-request-expire-articles (articles group &optional server force)
-  (nnsoup-possibly-change-group group)
-  (let* ((total-infolist (assoc group nnsoup-group-alist))
-	 (active (cadr total-infolist))
-	 (infolist (cddr total-infolist))
-	 info range-list mod-time prefix)
-    (while infolist
-      (setq info (pop infolist)
-	    range-list (gnus-uncompress-range (car info))
-	    prefix (gnus-soup-area-prefix (nth 1 info)))
-      (when ;; All the articles in this file are marked for expiry.
-	  (and (or (setq mod-time (nth 5 (file-attributes
-					  (nnsoup-file prefix))))
-		   (setq mod-time (nth 5 (file-attributes
-					  (nnsoup-file prefix t)))))
-	       (gnus-sublist-p articles range-list)
-	       ;; This file is old enough. 
-	       (nnmail-expired-article-p group mod-time force))
-	;; Ok, we delete this file.
-	(when (condition-case nil
-		  (progn
-		    (nnheader-message 
-		     5 "Deleting %s in group %s..." (nnsoup-file prefix)
-		     group)
-		    (when (file-exists-p (nnsoup-file prefix))
-		      (delete-file (nnsoup-file prefix)))
-		    (nnheader-message 
-		     5 "Deleting %s in group %s..." (nnsoup-file prefix t)
-		     group)
-		    (when (file-exists-p (nnsoup-file prefix t))
-		      (delete-file (nnsoup-file prefix t)))
-		    t)
-		(error nil))
-	  (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
-	  (setq articles (gnus-sorted-complement articles range-list))))
-      (when (not mod-time)
-	(setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
-    (if (cddr total-infolist)
-	(setcar active (caaadr (cdr total-infolist)))
-      (setcar active (1+ (cdr active))))
-    (nnsoup-write-active-file t)
-    ;; Return the articles that weren't expired.
-    articles))
-
-
-;;; Internal functions
-
-(defun nnsoup-possibly-change-group (group &optional force)
-  (if group
-      (setq nnsoup-current-group group)
-    t))
-
-(defun nnsoup-read-active-file ()
-  (setq nnsoup-group-alist nil)
-  (when (file-exists-p nnsoup-active-file)
-    (condition-case ()
-	(load nnsoup-active-file t t t)
-      (error nil))
-    ;; Be backwards compatible.
-    (when (and nnsoup-group-alist
-	       (not (atom (caadar nnsoup-group-alist))))
-      (let ((alist nnsoup-group-alist)
-	    entry e min max)
-	(while (setq e (cdr (setq entry (pop alist))))
-	  (setq min (caaar e))
-	  (while (cdr e)
-	    (setq e (cdr e)))
-	  (setq max (cdaar e))
-	  (setcdr entry (cons (cons min max) (cdr entry)))))
-      (setq nnsoup-group-alist-touched t))
-    nnsoup-group-alist))
-
-(defun nnsoup-write-active-file (&optional force)
-  (when (and nnsoup-group-alist
-	     (or force 
-		 nnsoup-group-alist-touched))
-    (setq nnsoup-group-alist-touched nil)
-    (nnheader-temp-write nnsoup-active-file
-      (let ((standard-output (current-buffer)))
-	(prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
-	(insert "\n")
-	(prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
-	(insert "\n")))))
-
-(defun nnsoup-next-prefix ()
-  "Return the next free prefix."
-  (let (prefix)
-    (while (or (file-exists-p 
-		(nnsoup-file (setq prefix (int-to-string
-					   nnsoup-current-prefix))))
-	       (file-exists-p (nnsoup-file prefix t)))
-      (incf nnsoup-current-prefix))
-    (incf nnsoup-current-prefix)
-    prefix))
-
-(defun nnsoup-read-areas ()
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (let ((areas (gnus-soup-parse-areas (concat nnsoup-tmp-directory "AREAS")))
-	  entry number area lnum cur-prefix file)
-      ;; Go through all areas in the new AREAS file.
-      (while (setq area (pop areas))
-	;; Change the name to the permanent name and move the files.
-	(setq cur-prefix (nnsoup-next-prefix))
-	(message "Incorporating file %s..." cur-prefix)
-	(when (file-exists-p 
-	       (setq file (concat nnsoup-tmp-directory
-				  (gnus-soup-area-prefix area) ".IDX")))
-	  (rename-file file (nnsoup-file cur-prefix)))
-	(when (file-exists-p 
-	       (setq file (concat nnsoup-tmp-directory 
-				  (gnus-soup-area-prefix area) ".MSG")))
-	  (rename-file file (nnsoup-file cur-prefix t))
-	  (gnus-soup-set-area-prefix area cur-prefix)
-	  ;; Find the number of new articles in this area.
-	  (setq number (nnsoup-number-of-articles area))
-	  (if (not (setq entry (assoc (gnus-soup-area-name area)
-				      nnsoup-group-alist)))
-	      ;; If this is a new area (group), we just add this info to
-	      ;; the group alist. 
-	      (push (list (gnus-soup-area-name area)
-			  (cons 1 number)
-			  (list (cons 1 number) area))
-		    nnsoup-group-alist)
-	    ;; There are already articles in this group, so we add this
-	    ;; info to the end of the entry.
-	    (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry)))
-					   (+ lnum number))
-				     area)))
-	    (setcdr (cadr entry) (+ lnum number))))))
-    (nnsoup-write-active-file t)
-    (delete-file (concat nnsoup-tmp-directory "AREAS"))))
-
-(defun nnsoup-number-of-articles (area)
-  (save-excursion
-    (cond 
-     ;; If the number is in the area info, we just return it.
-     ((gnus-soup-area-number area)
-      (gnus-soup-area-number area))
-     ;; If there is an index file, we just count the lines.
-     ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n)
-      (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
-      (count-lines (point-min) (point-max)))
-     ;; We do it the hard way - re-searching through the message
-     ;; buffer. 
-     (t
-      (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
-      (goto-char (point-min))
-      (let ((regexp (nnsoup-header (gnus-soup-encoding-format 
-				    (gnus-soup-area-encoding area))))
-	    (num 0))
-	(while (re-search-forward regexp nil t)
-	  (setq num (1+ num)))
-	num)))))
-
-(defun nnsoup-index-buffer (prefix &optional message)
-  (let* ((file (concat prefix (if message ".MSG" ".IDX")))
-	 (buffer-name (concat " *nnsoup " file "*")))
-    (or (get-buffer buffer-name)	; File aready loaded.
-	(when (file-exists-p (concat nnsoup-directory file))
-	  (save-excursion			; Load the file.
-	    (set-buffer (get-buffer-create buffer-name))
-	    (buffer-disable-undo (current-buffer))
-	    (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
-	    (insert-file-contents (concat nnsoup-directory file))
-	    (current-buffer))))))
-
-(defun nnsoup-file (prefix &optional message)
-  (expand-file-name
-   (concat nnsoup-directory prefix (if message ".MSG" ".IDX"))))
-
-(defun nnsoup-message-buffer (prefix)
-  (nnsoup-index-buffer prefix 'msg))
-
-(defun nnsoup-unpack-packets ()
-  "Unpack all packets in `nnsoup-packet-directory'."
-  (let ((packets (directory-files
-		  nnsoup-packet-directory t nnsoup-packet-regexp))
-	packet)
-    (while (setq packet (pop packets))
-      (message (format "nnsoup: unpacking %s..." packet))
-      (if (not (gnus-soup-unpack-packet 
-		nnsoup-tmp-directory nnsoup-unpacker packet))
-	  (message "Couldn't unpack %s" packet)
-	(delete-file packet)
-	(nnsoup-read-areas)
-	(message "Unpacking...done")))))
-
-(defun nnsoup-narrow-to-article (article &optional area head)
-  (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
-	 (prefix (and area (gnus-soup-area-prefix (nth 1 area))))
-	 (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg)))
-	 beg end)
-    (when area
-      (save-excursion
-	(cond
-	 ;; There is no MSG file.
-	 ((null msg-buf)
-	  nil)
-       
-	 ;; We use the index file to find out where the article begins and ends. 
-	 ((and (= (gnus-soup-encoding-index 
-		   (gnus-soup-area-encoding (nth 1 area)))
-		  ?c)
-	       (file-exists-p (nnsoup-file prefix)))
-	  (set-buffer (nnsoup-index-buffer prefix))
-	  (widen)
-	  (goto-char (point-min))
-	  (forward-line (- article (caar area)))
-	  (setq beg (read (current-buffer)))
-	  (forward-line 1)
-	  (if (looking-at "[0-9]+")
-	      (progn
-		(setq end (read (current-buffer)))
-		(set-buffer msg-buf)
-		(widen)
-		(let ((format (gnus-soup-encoding-format
-			       (gnus-soup-area-encoding (nth 1 area)))))
-		  (goto-char end)
-		  (if (or (= format ?n) (= format ?m))
-		      (setq end (progn (forward-line -1) (point))))))
-	    (set-buffer msg-buf))
-	  (widen)
-	  (narrow-to-region beg (or end (point-max))))
-	 (t
-	  (set-buffer msg-buf)
-	  (widen)
-	  (goto-char (point-min))
-	  (let ((header (nnsoup-header 
-			 (gnus-soup-encoding-format 
-			  (gnus-soup-area-encoding (nth 1 area))))))
-	    (re-search-forward header nil t (- article (caar area)))
-	    (narrow-to-region
-	     (match-beginning 0)
-	     (if (re-search-forward header nil t)
-		 (match-beginning 0)
-	       (point-max))))))
-	(goto-char (point-min))
-	(if (not head)
-	    ()
-	  (narrow-to-region
-	   (point-min)
-	   (if (search-forward "\n\n" nil t)
-	       (1- (point))
-	     (point-max))))
-	msg-buf))))
-
-(defun nnsoup-header (format)
-  (cond 
-   ((= format ?n)
-    "^#! *rnews +[0-9]+ *$")
-   ((= format ?m)
-    (concat "^" message-unix-mail-delimiter))
-   ((= format ?M)
-    "^\^A\^A\^A\^A\n")
-   (t
-    (error "Unknown format: %c" format))))
-
-;;;###autoload
-(defun nnsoup-pack-replies ()
-  "Make an outbound package of SOUP replies."
-  (interactive)
-  ;; Write all data buffers.
-  (gnus-soup-save-areas)
-  ;; Write the active file.
-  (nnsoup-write-active-file)
-  ;; Write the REPLIES file.
-  (nnsoup-write-replies)
-  ;; Pack all these files into a SOUP packet.
-  (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
-
-(defun nnsoup-write-replies ()
-  "Write the REPLIES file."
-  (when nnsoup-replies-list
-    (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)
-    (setq nnsoup-replies-list nil)))
-
-(defun nnsoup-article-to-area (article group)
-  "Return the area that ARTICLE in GROUP is located in."
-  (let ((areas (cddr (assoc group nnsoup-group-alist))))
-    (while (and areas (< (cdaar areas) article))
-      (setq areas (cdr areas)))
-    (and areas (car areas))))
-
-(defvar nnsoup-old-functions
-  (list message-send-mail-function message-send-news-function))
-
-;;;###autoload
-(defun nnsoup-set-variables ()
-  "Use the SOUP methods for posting news and mailing mail."
-  (interactive)
-  (setq message-send-news-function 'nnsoup-request-post)
-  (setq message-send-mail-function 'nnsoup-request-mail))
-
-;;;###autoload
-(defun nnsoup-revert-variables ()
-  "Revert posting and mailing methods to the standard Emacs methods."
-  (interactive)
-  (setq message-send-mail-function (car nnsoup-old-functions))
-  (setq message-send-news-function (cadr nnsoup-old-functions)))
-
-(defun nnsoup-store-reply (kind)
-  ;; Mostly stolen from `message.el'.
-  (require 'mail-utils)
-  (let ((tembuf (generate-new-buffer " message temp"))
-	(case-fold-search nil)
-	(news (message-news-p))
-	(resend-to-addresses (mail-fetch-field "resent-to"))
-	delimline
-	(mailbuf (current-buffer)))
-    (unwind-protect
-	(save-excursion
-	  (save-restriction
-	    (message-narrow-to-headers)
-	    (if (equal kind "mail")
-		(message-generate-headers message-required-mail-headers)
-	      (message-generate-headers message-required-news-headers)))
-	  (set-buffer tembuf)
-	  (erase-buffer)
-	  (insert-buffer-substring mailbuf)
-	  ;; Remove some headers.
-	  (save-restriction
-	    (message-narrow-to-headers)
-	    ;; Remove some headers.
-	    (message-remove-header message-ignored-mail-headers t))
-	  (goto-char (point-max))
-	  ;; require one newline at the end.
-	  (or (= (preceding-char) ?\n)
-	      (insert ?\n))
-	  (when (and news
-		     (equal kind "mail")
-		     (or (mail-fetch-field "cc")
-			 (mail-fetch-field "to")))
-	    (message-insert-courtesy-copy))
-	  (let ((case-fold-search t))
-	    ;; Change header-delimiter to be what sendmail expects.
-	    (goto-char (point-min))
-	    (re-search-forward
-	     (concat "^" (regexp-quote mail-header-separator) "\n"))
-	    (replace-match "\n")
-	    (backward-char 1)
-	    (setq delimline (point-marker))
-	    ;; Insert an extra newline if we need it to work around
-	    ;; Sun's bug that swallows newlines.
-	    (goto-char (1+ delimline))
-	    (when (eval message-mailer-swallows-blank-line)
-	      (newline))
-	    (let ((msg-buf
-		   (gnus-soup-store 
-		    nnsoup-replies-directory 
-		    (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
-		    nnsoup-replies-index-type))
-		  (num 0))
-	      (when (and msg-buf (bufferp msg-buf))
-		(save-excursion
-		  (set-buffer msg-buf)
-		  (goto-char (point-min))
-		  (while (re-search-forward "^#! *rnews" nil t)
-		    (incf num)))
-		(message "Stored %d messages" num)))
-	    (nnsoup-write-replies)
-	    (kill-buffer tembuf))))))
-
-(defun nnsoup-kind-to-prefix (kind)
-  (unless nnsoup-replies-list
-    (setq nnsoup-replies-list
-	  (gnus-soup-parse-replies 
-	   (concat nnsoup-replies-directory "REPLIES"))))
-  (let ((replies nnsoup-replies-list))
-    (while (and replies 
-		(not (string= kind (gnus-soup-reply-kind (car replies)))))
-      (setq replies (cdr replies)))
-    (if replies
-	(gnus-soup-reply-prefix (car replies))
-      (setq nnsoup-replies-list
-	    (cons (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
-			  kind 
-			  (format "%c%c%c"
-				  nnsoup-replies-format-type
-				  nnsoup-replies-index-type
-				  (if (string= kind "news")
-				      ?n ?m)))
-		  nnsoup-replies-list))
-      (gnus-soup-reply-prefix (car nnsoup-replies-list)))))
-
-(defun nnsoup-make-active ()
-  "(Re-)create the SOUP active file."
-  (interactive)
-  (let ((files (sort (directory-files nnsoup-directory t "IDX$")
-		     (lambda (f1 f2)
-		       (< (progn (string-match "/\\([0-9]+\\)\\." f1)
-				 (string-to-int (match-string 1 f1)))
-			  (progn (string-match "/\\([0-9]+\\)\\." f2)
-				 (string-to-int (match-string 1 f2)))))))
-	active group lines ident elem min)
-    (set-buffer (get-buffer-create " *nnsoup work*"))
-    (buffer-disable-undo (current-buffer))
-    (while files
-      (message "Doing %s..." (car files))
-      (erase-buffer)
-      (insert-file-contents (car files))
-      (goto-char (point-min))
-      (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
-	  (setq group "unknown")
-	(setq group (match-string 2)))
-      (setq lines (count-lines (point-min) (point-max)))
-      (setq ident (progn (string-match
-			  "/\\([0-9]+\\)\\." (car files))
-			 (substring 
-			  (car files) (match-beginning 1)
-			  (match-end 1))))
-      (if (not (setq elem (assoc group active)))
-	  (push (list group (cons 1 lines)
-		      (list (cons 1 lines) 
-			    (vector ident group "ncm" "" lines)))
-		active)
-	(nconc elem
-	       (list
-		(list (cons (1+ (setq min (cdadr elem)))
-			    (+ min lines))
-		      (vector ident group "ncm" "" lines))))
-	(setcdr (cadr elem) (+ min lines)))
-      (setq files (cdr files)))
-    (message "")
-    (setq nnsoup-group-alist active)
-    (nnsoup-write-active-file t)))
-
-(defun nnsoup-delete-unreferenced-message-files ()
-  "Delete any *.MSG and *.IDX files that aren't known by nnsoup."
-  (interactive)
-  (let* ((known (apply 'nconc (mapcar 
-			       (lambda (ga)
-				 (mapcar
-				  (lambda (area)
-				    (gnus-soup-area-prefix (cadr area)))
-				  (cddr ga)))
-			       nnsoup-group-alist)))
-	 (regexp "\\.MSG$\\|\\.IDX$")
-	 (files (directory-files nnsoup-directory nil regexp))
-	 non-files file)
-    ;; Find all files that aren't known by nnsoup.
-    (while (setq file (pop files))
-      (string-match regexp file)
-      (unless (member (substring file 0 (match-beginning 0)) known)
-	(push file non-files)))
-    ;; Sort and delete the files.
-    (setq non-files (sort non-files 'string<))
-    (map-y-or-n-p "Delete file %s? "
-		  (lambda (file) (delete-file (concat nnsoup-directory file)))
-		  non-files)))
-
-(provide 'nnsoup)
-
-;;; nnsoup.el ends here
diff --git a/lisp/nnspool.el b/lisp/nnspool.el
deleted file mode 100644
index f80bf28b7cd..00000000000
--- a/lisp/nnspool.el
+++ /dev/null
@@ -1,511 +0,0 @@
-;;; nnspool.el --- spool access for GNU Emacs
-;; Copyright (C) 1988,89,90,93,94,95,96 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; 	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'nnheader)
-(require 'nntp)
-(require 'timezone)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnspool)
-
-(defvoo nnspool-inews-program news-inews-program
-  "Program to post news.
-This is most commonly `inews' or `injnews'.")
-
-(defvoo nnspool-inews-switches '("-h" "-S")
-  "Switches for nnspool-request-post to pass to `inews' for posting news.
-If you are using Cnews, you probably should set this variable to nil.")
-
-(defvoo nnspool-spool-directory (file-name-as-directory news-path)
-  "Local news spool directory.")
-
-(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/")
-  "Local news nov directory.")
-
-(defvoo nnspool-lib-dir "/usr/lib/news/"
-  "Where the local news library files are stored.")
-
-(defvoo nnspool-active-file (concat nnspool-lib-dir "active")
-  "Local news active file.")
-
-(defvoo nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups")
-  "Local news newsgroups file.")
-
-(defvoo nnspool-distributions-file (concat nnspool-lib-dir "distribs.pat")
-  "Local news distributions file.")
-
-(defvoo nnspool-history-file (concat nnspool-lib-dir "history")
-  "Local news history file.")
-
-(defvoo nnspool-active-times-file (concat nnspool-lib-dir "active.times")
-  "Local news active date file.")
-
-(defvoo nnspool-large-newsgroup 50
-  "The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
-messages will be shown to indicate the current status.")
-
-(defvoo nnspool-nov-is-evil nil
-  "Non-nil means that nnspool will never return NOV lines instead of headers.")
-
-(defconst nnspool-sift-nov-with-sed nil
-  "If non-nil, use sed to get the relevant portion from the overview file.
-If nil, nnspool will load the entire file into a buffer and process it
-there.")
-
-(defvoo nnspool-rejected-article-hook nil
-  "*A hook that will be run when an article has been rejected by the server.")
-
-
-
-(defconst nnspool-version "nnspool 2.0"
-  "Version numbers of this version of NNSPOOL.")
-
-(defvoo nnspool-current-directory nil
-  "Current news group directory.")
-
-(defvoo nnspool-current-group nil)
-(defvoo nnspool-status-string "")
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nnspool)
-
-(deffoo nnspool-retrieve-headers (articles &optional group server fetch-old)
-  "Retrieve the headers of ARTICLES."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (when (nnspool-possibly-change-directory group)
-      (let* ((number (length articles))
-	     (count 0)
-	     (default-directory nnspool-current-directory)
-	     (do-message (and (numberp nnspool-large-newsgroup)
-			      (> number nnspool-large-newsgroup)))
-	     file beg article ag)
-	(if (and (numberp (car articles))
-		 (nnspool-retrieve-headers-with-nov articles fetch-old))
-	    ;; We successfully retrieved the NOV headers.
-	    'nov
-	  ;; No NOV headers here, so we do it the hard way.
-	  (while (setq article (pop articles))
-	    (if (stringp article)
-		;; This is a Message-ID.
-		(setq ag (nnspool-find-id article)
-		      file (and ag (nnspool-article-pathname 
-				    (car ag) (cdr ag)))
-		      article (cdr ag))
-	      ;; This is an article in the current group.
-	      (setq file (int-to-string article)))
-	    ;; Insert the head of the article.
-	    (when (and file
-		       (file-exists-p file))
-	      (insert "221 ")
-	      (princ article (current-buffer))
-	      (insert " Article retrieved.\n")
-	      (setq beg (point))
-	      (inline (nnheader-insert-head file))
-	      (goto-char beg)
-	      (search-forward "\n\n" nil t)
-	      (forward-char -1)
-	      (insert ".\n")
-	      (delete-region (point) (point-max)))
-	    
-	    (and do-message
-		 (zerop (% (incf count) 20))
-		 (message "nnspool: Receiving headers... %d%%"
-			  (/ (* count 100) number))))
-	  
-	  (and do-message
-	       (message "nnspool: Receiving headers...done"))
-	  
-	  ;; Fold continuation lines.
-	  (nnheader-fold-continuation-lines)
-	  'headers)))))
-
-(deffoo nnspool-open-server (server &optional defs)
-  (nnoo-change-server 'nnspool server defs)
-  (cond 
-   ((not (file-exists-p nnspool-spool-directory))
-    (nnspool-close-server)
-    (nnheader-report 'nnspool "Spool directory doesn't exist: %s"
-		     nnspool-spool-directory))
-   ((not (file-directory-p
-	  (directory-file-name
-	   (file-truename nnspool-spool-directory))))
-    (nnspool-close-server)
-    (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory))
-   ((not (file-exists-p nnspool-active-file))
-    (nnheader-report 'nnspool "The active file doesn't exist: %s" 
-		     nnspool-active-file))
-   (t
-    (nnheader-report 'nnspool "Opened server %s using directory %s"
-		     server nnspool-spool-directory)
-    t)))
-
-(deffoo nnspool-request-article (id &optional group server buffer)
-  "Select article by message ID (or number)."
-  (nnspool-possibly-change-directory group)
-  (let ((nntp-server-buffer (or buffer nntp-server-buffer))
-	file ag)
-    (if (stringp id)
-	;; This is a Message-ID.	
-	(when (setq ag (nnspool-find-id id))
-	  (setq file (nnspool-article-pathname (car ag) (cdr ag))))
-      (setq file (nnspool-article-pathname nnspool-current-group id)))
-    (and file
-	 (file-exists-p file)
-	 (not (file-directory-p file))
-	 (save-excursion (nnspool-find-file file))
-	 ;; We return the article number and group name.
-	 (if (numberp id)
-	     (cons nnspool-current-group id)
-	   ag))))
-	    
-(deffoo nnspool-request-body (id &optional group server)
-  "Select article body by message ID (or number)."
-  (nnspool-possibly-change-directory group)
-  (let ((res (nnspool-request-article id)))
-    (when res
-      (save-excursion
-	(set-buffer nntp-server-buffer)
-	(goto-char (point-min))
-	(when (search-forward "\n\n" nil t)
-	  (delete-region (point-min) (point)))
-	res))))
-
-(deffoo nnspool-request-head (id &optional group server)
-  "Select article head by message ID (or number)."
-  (nnspool-possibly-change-directory group)
-  (let ((res (nnspool-request-article id)))
-    (when res
-      (save-excursion
-	(set-buffer nntp-server-buffer)
-	(goto-char (point-min))
-	(when (search-forward "\n\n" nil t)
-	  (delete-region (1- (point)) (point-max)))
-	(nnheader-fold-continuation-lines)))
-    res))
-
-(deffoo nnspool-request-group (group &optional server dont-check)
-  "Select news GROUP."
-  (let ((pathname (nnspool-article-pathname group))
-	dir)
-    (if (not (file-directory-p pathname))
-	(nnheader-report 
-	 'nnspool "Invalid group name (no such directory): %s" group)
-      (setq nnspool-current-directory pathname)
-      (nnheader-report 'nnspool "Selected group %s" group)
-      (if dont-check
-	  (progn
-	    (nnheader-report 'nnspool "Selected group %s" group)
-	    t)
-	;; Yes, completely empty spool directories *are* possible.
-	;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
-	(when (setq dir (directory-files pathname nil "^[0-9]+$" t))
-	  (setq dir 
-		(sort (mapcar (lambda (name) (string-to-int name)) dir) '<)))
-	(if dir
-	    (nnheader-insert
-	     "211 %d %d %d %s\n" (length dir) (car dir)
-	     (progn (while (cdr dir) (setq dir (cdr dir))) (car dir))
-	     group)
-	  (nnheader-report 'nnspool "Empty group %s" group)
-	  (nnheader-insert "211 0 0 0 %s\n" group))))))
-
-(deffoo nnspool-request-type (group &optional article)
-  'news)
-
-(deffoo nnspool-close-group (group &optional server)
-  t)
-
-(deffoo nnspool-request-list (&optional server)
-  "List active newsgroups."
-  (save-excursion
-    (or (nnspool-find-file nnspool-active-file)
-	(nnheader-report 'nnspool (nnheader-file-error nnspool-active-file)))))
-
-(deffoo nnspool-request-list-newsgroups (&optional server)
-  "List newsgroups (defined in NNTP2)."
-  (save-excursion
-    (or (nnspool-find-file nnspool-newsgroups-file)
-	(nnheader-report 'nnspool (nnheader-file-error 
-				   nnspool-newsgroups-file)))))
-
-(deffoo nnspool-request-list-distributions (&optional server)
-  "List distributions (defined in NNTP2)."
-  (save-excursion
-    (or (nnspool-find-file nnspool-distributions-file)
-	(nnheader-report 'nnspool (nnheader-file-error 
-				   nnspool-distributions-file)))))
-
-;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-(deffoo nnspool-request-newgroups (date &optional server)
-  "List groups created after DATE."
-  (if (nnspool-find-file nnspool-active-times-file)
-      (save-excursion
-	;; Find the last valid line.
-	(goto-char (point-max))
-	(while (and (not (looking-at 
-			  "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] "))
-		    (zerop (forward-line -1))))
-	(let ((seconds (nnspool-seconds-since-epoch date))
-	      groups)
-	  ;; Go through lines and add the latest groups to a list.
-	  (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ")
-		      (progn
-			;; We insert a .0 to make the list reader
-			;; interpret the number as a float. It is far
-			;; too big to be stored in a lisp integer. 
-			(goto-char (1- (match-end 0)))
-			(insert ".0")
-			(> (progn
-			     (goto-char (match-end 1))
-			     (read (current-buffer)))
-			   seconds))
-		      (setq groups (cons (buffer-substring
-					  (match-beginning 1) (match-end 1))
-					 groups))
-		      (zerop (forward-line -1))))
-	  (erase-buffer)
-	  (while groups
-	    (insert (car groups) " 0 0 y\n")
-	    (setq groups (cdr groups))))
-	t)
-    nil))
-
-(deffoo nnspool-request-post (&optional server)
-  "Post a new news in current buffer."
-  (save-excursion
-    (let* ((process-connection-type nil) ; t bugs out on Solaris
-	   (inews-buffer (generate-new-buffer " *nnspool post*"))
-	   (proc 
-	    (condition-case err
-		(apply 'start-process "*nnspool inews*" inews-buffer
-		       nnspool-inews-program nnspool-inews-switches)
-	      (error
-	       (nnheader-report 'nnspool "inews error: %S" err)))))
-      (if (not proc)
-	  ;; The inews program failed.
-	  ()
-	(nnheader-report 'nnspool "")
-	(set-process-sentinel proc 'nnspool-inews-sentinel)
-	(process-send-region proc (point-min) (point-max))
-	;; We slap a condition-case around this, because the process may
-	;; have exited already...
-	(condition-case nil
-	    (process-send-eof proc)
-	  (error nil))
-	t))))
-
-
-
-;;; Internal functions.
-
-(defun nnspool-inews-sentinel (proc status)
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    (goto-char (point-min))
-    (if (or (zerop (buffer-size))
-	    (search-forward "spooled" nil t))
-	(kill-buffer (current-buffer))
-      ;; Make status message by folding lines.
-      (while (re-search-forward "[ \t\n]+" nil t)
-	(replace-match " " t t))
-      (nnheader-report 'nnspool "%s" (buffer-string))
-      (message "nnspool: %s" nnspool-status-string)
-      (ding)
-      (run-hooks 'nnspool-rejected-article-hook))))
-
-(defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old)
-  (if (or gnus-nov-is-evil nnspool-nov-is-evil)
-      nil
-    (let ((nov (nnheader-group-pathname 
-		nnspool-current-group nnspool-nov-directory ".overview"))
-	  (arts articles)
-	  last)
-      (if (not (file-exists-p nov))
-	  ()
-	(save-excursion
-	  (set-buffer nntp-server-buffer)
-	  (erase-buffer)
-	  (if nnspool-sift-nov-with-sed
-	      (nnspool-sift-nov-with-sed articles nov)
-	    (insert-file-contents nov)
-	    (if (and fetch-old
-		     (not (numberp fetch-old)))
-		t			; We want all the headers.
-	      (condition-case ()
-		  (progn
-		    ;; First we find the first wanted line.
-		    (nnspool-find-nov-line
-		     (if fetch-old (max 1 (- (car articles) fetch-old))
-		       (car articles)))
-		    (delete-region (point-min) (point))
-		    ;; Then we find the last wanted line. 
-		    (if (nnspool-find-nov-line 
-			 (progn (while (cdr articles)
-				  (setq articles (cdr articles)))
-				(car articles)))
-			(forward-line 1))
-		    (delete-region (point) (point-max))
-		    ;; If the buffer is empty, this wasn't very successful.
-		    (unless (zerop (buffer-size))
-		      ;; We check what the last article number was.  
-		      ;; The NOV file may be out of sync with the articles
-		      ;; in the group.
-		      (forward-line -1)
-		      (setq last (read (current-buffer)))
-		      (if (= last (car articles))
-			  ;; Yup, it's all there.
-			  t
-			;; Perhaps not.  We try to find the missing articles.
-			(while (and arts
-				    (<= last (car arts)))
-			  (pop arts))
-			;; The articles in `arts' are missing from the buffer.
-			(while arts
-			  (nnspool-insert-nov-head (pop arts)))
-			t)))
-		;; The NOV file was corrupted.
-		(error nil)))))))))
-
-(defun nnspool-insert-nov-head (article)
-  "Read the head of ARTICLE, convert to NOV headers, and insert."
-  (save-excursion
-    (let ((cur (current-buffer))
-	  buf)
-      (setq buf (nnheader-set-temp-buffer " *nnspool head*"))
-      (when (nnheader-insert-head
-	     (nnspool-article-pathname nnspool-current-group article))
-	(nnheader-insert-article-line article)
-	(let ((headers (nnheader-parse-head)))
-	  (set-buffer cur)
-	  (goto-char (point-max))
-	  (nnheader-insert-nov headers)))
-      (kill-buffer buf))))
-
-(defun nnspool-find-nov-line (article)
-  (let ((max (point-max))
-	(min (goto-char (point-min)))
-	(cur (current-buffer))
-	(prev (point-min))
-	num found)
-    (while (not found)
-      (goto-char (/ (+ max min) 2))
-      (beginning-of-line)
-      (if (or (= (point) prev)
-	      (eobp))
-	  (setq found t)
-	(setq prev (point))
-	(cond ((> (setq num (read cur)) article)
-	       (setq max (point)))
-	      ((< num article)
-	       (setq min (point)))
-	      (t
-	       (setq found 'yes)))))
-    ;; Now we may have found the article we're looking for, or we
-    ;; may be somewhere near it.
-    (when (and (not (eq found 'yes))
-	       (not (eq num article)))
-      (setq found (point))
-      (while (and (< (point) max)
-		  (or (not (numberp num))
-		      (< num article)))
-	(forward-line 1)
-	(setq found (point))
-	(or (eobp)
-	    (= (setq num (read cur)) article)))
-      (unless (eq num article)
-	(goto-char found)))
-    (beginning-of-line)
-    (eq num article)))
-    
-(defun nnspool-sift-nov-with-sed (articles file)
-  (let ((first (car articles))
-	(last (progn (while (cdr articles) (setq articles (cdr articles)))
-		     (car articles))))
-    (call-process "awk" nil t nil 
-		  (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}"
-			  (1- first) (1+ last))
-		  file)))
-
-;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle). 
-;; Find out what group an article identified by a Message-ID is in.
-(defun nnspool-find-id (id)
-  (save-excursion
-    (set-buffer (get-buffer-create " *nnspool work*"))
-    (buffer-disable-undo (current-buffer))
-    (erase-buffer)
-    (condition-case ()
-	(call-process "grep" nil t nil (regexp-quote id) nnspool-history-file)
-      (error nil))
-    (goto-char (point-min))
-    (prog1
-	(if (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]")
-	    (cons (match-string 1) (string-to-int (match-string 2))))
-      (kill-buffer (current-buffer)))))
-
-(defun nnspool-find-file (file)
-  "Insert FILE in server buffer safely."
-  (set-buffer nntp-server-buffer)
-  (erase-buffer)
-  (condition-case ()
-      (progn (nnheader-insert-file-contents-literally file) t)
-    (file-error nil)))
-
-(defun nnspool-possibly-change-directory (group)
-  (if (not group)
-      t
-    (let ((pathname (nnspool-article-pathname group)))
-      (if (file-directory-p pathname)
-	  (setq nnspool-current-directory pathname
-		nnspool-current-group group)
-	(nnheader-report 'nnspool "No such newsgroup: %s" group)))))
-
-(defun nnspool-article-pathname (group &optional article)
-  "Find the path for GROUP."
-  (nnheader-group-pathname group nnspool-spool-directory article))
-
-(defun nnspool-seconds-since-epoch (date)
-  (let* ((tdate (mapcar (lambda (ti) (and ti (string-to-int ti)))
-			(timezone-parse-date date)))
-	 (ttime (mapcar (lambda (ti) (and ti (string-to-int ti)))
-			(timezone-parse-time
-			 (aref (timezone-parse-date date) 3))))
-	 (unix (encode-time (nth 2 ttime) (nth 1 ttime) (nth 0 ttime)
-			    (nth 2 tdate) (nth 1 tdate) (nth 0 tdate) 
-			    (nth 4 tdate))))
-    (+ (* (car unix) 65536.0)
-       (cadr unix))))
-
-(provide 'nnspool)
-
-;;; nnspool.el ends here
diff --git a/lisp/nntp.el b/lisp/nntp.el
deleted file mode 100644
index 8b34460b108..00000000000
--- a/lisp/nntp.el
+++ /dev/null
@@ -1,1336 +0,0 @@
-;;; nntp.el --- nntp access for Gnus
-;; Copyright (C) 1987,88,89,90,92,93,94,95,96 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; 	Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news
-
-;; 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:
-
-(require 'nnheader)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nntp)
-
-(eval-and-compile
-  (unless (fboundp 'open-network-stream)
-    (require 'tcp)))
-
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
-  (autoload 'cancel-timer "timer")
-  (autoload 'telnet "telnet" nil t)
-  (autoload 'telnet-send-input "telnet" nil t)
-  (autoload 'timezone-parse-date "timezone"))
-
-(defvoo nntp-server-hook nil
-  "*Hooks for the NNTP server.
-If the kanji code of the NNTP server is different from the local kanji
-code, the correct kanji code of the buffer associated with the NNTP
-server must be specified as follows:
-
-\(setq nntp-server-hook
-      (function
-       (lambda ()
-	 ;; Server's Kanji code is EUC (NEmacs hack).
-	 (make-local-variable 'kanji-fileio-code)
-	 (setq kanji-fileio-code 0))))
-
-If you'd like to change something depending on the server in this
-hook, use the variable `nntp-address'.")
-
-(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
-  "*Hook used for sending commands to the server at startup.  
-The default value is `nntp-send-mode-reader', which makes an innd
-server spawn an nnrpd server.  Another useful function to put in this
-hook might be `nntp-send-authinfo', which will prompt for a password
-to allow posting from the server.  Note that this is only necessary to
-do on servers that use strict access control.")  
-(add-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)
-
-(defvoo nntp-server-action-alist 
-  '(("nntpd 1\\.5\\.11t" 
-     (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader)))
-  "Alist of regexps to match on server types and actions to be taken.
-For instance, if you want Gnus to beep every time you connect
-to innd, you could say something like:
-
-\(setq nntp-server-action-alist
-       '((\"innd\" (ding))))
-
-You probably don't want to do that, though.")
-
-(defvoo nntp-open-server-function 'nntp-open-network-stream
-  "*Function used for connecting to a remote system.
-It will be called with the address of the remote system.
-
-Two pre-made functions are `nntp-open-network-stream', which is the
-default, and simply connects to some port or other on the remote
-system (see nntp-port-number).  The other is `nntp-open-rlogin', which
-does an rlogin on the remote system, and then does a telnet to the
-NNTP server available there (see nntp-rlogin-parameters).")
-
-(defvoo nntp-rlogin-parameters '("telnet" "${NNTPSERVER:=localhost}" "nntp")
-  "*Parameters to `nntp-open-login'.
-That function may be used as `nntp-open-server-function'.  In that
-case, this list will be used as the parameter list given to rsh.")
-
-(defvoo nntp-rlogin-user-name nil
-  "*User name on remote system when using the rlogin connect method.")
-
-(defvoo nntp-address nil
-  "*The name of the NNTP server.")
-
-(defvoo nntp-port-number "nntp"
-  "*Port number to connect to.")
-
-(defvoo nntp-end-of-line "\r\n"
-  "String to use on the end of lines when talking to the NNTP server.
-This is \"\\r\\n\" by default, but should be \"\\n\" when
-using rlogin to communicate with the server.")
-
-(defvoo nntp-large-newsgroup 50
-  "*The number of the articles which indicates a large newsgroup.
-If the number of the articles is greater than the value, verbose
-messages will be shown to indicate the current status.")
-
-(defvoo nntp-buggy-select (memq system-type '(fujitsu-uts))
-  "*t if your select routine is buggy.
-If the select routine signals error or fall into infinite loop while
-waiting for the server response, the variable must be set to t.  In
-case of Fujitsu UTS, it is set to T since `accept-process-output'
-doesn't work properly.")
-
-(defvoo nntp-maximum-request 400
-  "*The maximum number of the requests sent to the NNTP server at one time.
-If Emacs hangs up while retrieving headers, set the variable to a
-lower value.")
-
-(defvoo nntp-debug-read 10000
-  "*Display '...' every 10Kbytes of a message being received if it is non-nil.
-If it is a number, dots are displayed per the number.")
-
-(defvoo nntp-nov-is-evil nil
-  "*If non-nil, nntp will never attempt to use XOVER when talking to the server.")
-
-(defvoo nntp-xover-commands '("XOVER" "XOVERVIEW")
-  "*List of strings that are used as commands to fetch NOV lines from a server.
-The strings are tried in turn until a positive response is gotten. If
-none of the commands are successful, nntp will just grab headers one
-by one.")
-
-(defvoo nntp-nov-gap 20
-  "*Maximum allowed gap between two articles.
-If the gap between two consecutive articles is bigger than this
-variable, split the XOVER request into two requests.")
-
-(defvoo nntp-connection-timeout nil
-  "*Number of seconds to wait before an nntp connection times out.
-If this variable is nil, which is the default, no timers are set.")
-
-(defvoo nntp-command-timeout nil
-  "*Number of seconds to wait for a response when sending a command.
-If this variable is nil, which is the default, no timers are set.")
-
-(defvoo nntp-retry-on-break nil
-  "*If non-nil, re-send the command when the user types `C-g'.")
-
-(defvoo nntp-news-default-headers nil
-  "*If non-nil, override `mail-default-headers' when posting news.")
-
-(defvoo nntp-prepare-server-hook nil
-  "*Hook run before a server is opened.
-If can be used to set up a server remotely, for instance.  Say you
-have an account at the machine \"other.machine\".  This machine has
-access to an NNTP server that you can't access locally.  You could
-then use this hook to rsh to the remote machine and start a proxy NNTP
-server there that you can connect to.")
-
-(defvoo nntp-async-number 5
-  "*How many articles should be prefetched when in asynchronous mode.")
-
-(defvoo nntp-warn-about-losing-connection t
-  "*If non-nil, beep when a server closes connection.")
-
-
-
-(defconst nntp-version "nntp 4.0"
-  "Version numbers of this version of NNTP.")
-
-(defvar nntp-server-buffer nil
-  "Buffer associated with the NNTP server process.")
-
-(defvoo nntp-server-process nil
-  "The NNTP server process.
-You'd better not use this variable in NNTP front-end program, but
-instead use `nntp-server-buffer'.")
-
-(defvoo nntp-status-string nil
-  "Save the server response message.")
-
-(defvar nntp-opened-connections nil
-  "All (possibly) opened connections.")
-
-(defvoo nntp-server-xover 'try)
-(defvoo nntp-server-list-active-group 'try)
-(defvoo nntp-current-group "")
-(defvoo nntp-server-type nil)
-
-(defvoo nntp-async-process nil)
-(defvoo nntp-async-buffer nil)
-(defvoo nntp-async-articles nil)
-(defvoo nntp-async-fetched nil)
-(defvoo nntp-async-group-alist nil)
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nntp)
-
-(deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
-  "Retrieve the headers of ARTICLES."
-  (nntp-possibly-change-server group server)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (if (and (not gnus-nov-is-evil) 
-	     (not nntp-nov-is-evil)
-	     (nntp-retrieve-headers-with-xover articles fetch-old))
-	;; We successfully retrieved the headers via XOVER.
-        'nov
-      ;; XOVER didn't work, so we do it the hard, slow and inefficient
-      ;; way.  
-      (let ((number (length articles))
-	    (count 0)
-	    (received 0)
-	    (message-log-max nil)
-	    (last-point (point-min)))
-	;; Send HEAD command.
-	(while articles
-	  (nntp-send-strings-to-server 
-	   "HEAD" (if (numberp (car articles)) 
-		      (int-to-string (car articles))
-		    ;; `articles' is either a list of article numbers
-		    ;; or a list of article IDs.
-		    (car articles)))
-	  (setq articles (cdr articles)
-		count (1+ count))
-	  ;; Every 400 header requests we have to read the stream in
-	  ;; order to avoid deadlocks.
-	  (when (or (null articles)	;All requests have been sent.
-		    (zerop (% count nntp-maximum-request)))
-	    (nntp-accept-response)
-	    (while (progn
-		     (goto-char last-point)
-		     ;; Count replies.
-		     (while (re-search-forward "^[0-9]" nil t)
-		       (setq received (1+ received)))
-		     (setq last-point (point))
-		     (< received count))
-	      ;; If number of headers is greater than 100, give
-	      ;;  informative messages.
-	      (and (numberp nntp-large-newsgroup)
-		   (> number nntp-large-newsgroup)
-		   (zerop (% received 20))
-		   (nnheader-message 7 "NNTP: Receiving headers... %d%%"
-				     (/ (* received 100) number)))
-	      (nntp-accept-response))))
-	;; Wait for text of last command.
-	(goto-char (point-max))
-	(re-search-backward "^[0-9]" nil t)
-	(when (looking-at "^[23]")
-	  (while (progn
-		   (goto-char (- (point-max) 3))
-		   (not (looking-at "^\\.\r?\n")))
-	    (nntp-accept-response)))
-	(and (numberp nntp-large-newsgroup)
-	     (> number nntp-large-newsgroup)
-	     (nnheader-message 7 "NNTP: Receiving headers...done"))
-
-	;; Now all of replies are received.  Fold continuation lines.
-	(nnheader-fold-continuation-lines)
-	;; Remove all "\r"'s.
-	(goto-char (point-min))
-	(while (search-forward "\r" nil t)
-	  (replace-match "" t t))
-	'headers))))
-
-
-(deffoo nntp-retrieve-groups (groups &optional server)
-  "Retrieve group info on GROUPS."
-  (nntp-possibly-change-server nil server)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    ;; The first time this is run, this variable is `try'.  So we
-    ;; try.   
-    (when (eq nntp-server-list-active-group 'try)
-      (nntp-try-list-active (car groups)))
-    (erase-buffer)
-    (let ((count 0)
-	  (received 0)
-	  (last-point (point-min))
-	  (command (if nntp-server-list-active-group "LIST ACTIVE" "GROUP")))
-      (while groups
-	;; Send the command to the server.
-	(nntp-send-strings-to-server command (car groups))
-	(setq groups (cdr groups))
-	(setq count (1+ count))
-	;; Every 400 requests we have to read the stream in
-	;; order to avoid deadlocks.
-	(when (or (null groups)		;All requests have been sent.
-		  (zerop (% count nntp-maximum-request)))
-	  (nntp-accept-response)
-	  (while (progn
-		   (goto-char last-point)
-		   ;; Count replies.
-		   (while (re-search-forward "^[0-9]" nil t)
-		     (setq received (1+ received)))
-		   (setq last-point (point))
-		   (< received count))
-	    (nntp-accept-response))))
-
-      ;; Wait for the reply from the final command.
-      (when nntp-server-list-active-group
-	(goto-char (point-max))
-	(re-search-backward "^[0-9]" nil t)
-	(when (looking-at "^[23]")
-	  (while (progn
-		   (goto-char (- (point-max) 3))
-		   (not (looking-at "^\\.\r?\n")))
-	    (nntp-accept-response))))
-
-      ;; Now all replies are received. We remove CRs.
-      (goto-char (point-min))
-      (while (search-forward "\r" nil t)
-	(replace-match "" t t))
-
-      (if (not nntp-server-list-active-group)
-	  'group
-	;; We have read active entries, so we just delete the
-	;; superfluos gunk.
-	(goto-char (point-min))
-	(while (re-search-forward "^[.2-5]" nil t)
-	  (delete-region (match-beginning 0) 
-			 (progn (forward-line 1) (point))))
-	'active))))
-
-(deffoo nntp-open-server (server &optional defs connectionless)
-  "Open the virtual server SERVER.
-If CONNECTIONLESS is non-nil, don't attempt to connect to any physical
-servers."
-  ;; Called with just a port number as the defs.
-  (when (or (stringp (car defs))
-	    (numberp (car defs)))
-    (setq defs `((nntp-port-number ,(car defs)))))
-  (unless (assq 'nntp-address defs)
-    (setq defs (append defs `((nntp-address ,server)))))
-  (nnoo-change-server 'nntp server defs)
-  (if (nntp-server-opened server)
-      t
-    (or (nntp-server-opened server)
-	connectionless
-	(prog2
-	    (run-hooks 'nntp-prepare-server-hook)
-	    (nntp-open-server-semi-internal nntp-address nntp-port-number)
-	  (nnheader-insert "")))))
-
-(deffoo nntp-close-server (&optional server)
-  "Close connection to SERVER."
-  (nntp-possibly-change-server nil server t)
-  (unwind-protect
-      (progn
-	;; Un-set default sentinel function before closing connection.
-	(and nntp-server-process
-	     (eq 'nntp-default-sentinel
-		 (process-sentinel nntp-server-process))
-	     (set-process-sentinel nntp-server-process nil))
-	;; We cannot send QUIT command unless the process is running.
-	(when (nntp-server-opened server)
-	  (nntp-send-command nil "QUIT")
-	  ;; Give the QUIT time to arrive.
-	  (sleep-for 1)))
-    (nntp-close-server-internal server)))
-
-(deffoo nntp-request-close ()
-  "Close all server connections."
-  (let (proc)
-    (while nntp-opened-connections
-      (when (setq proc (pop nntp-opened-connections))
-	;; Un-set default sentinel function before closing connection.
-	(when (eq 'nntp-default-sentinel (process-sentinel proc))
-	  (set-process-sentinel proc nil))
-	(condition-case ()
-	    (process-send-string proc (concat "QUIT" nntp-end-of-line))
-	  (error nil))
-	;; Give the QUIT time to reach the server before we close
-	;; down the process.
-	(sleep-for 1)
-	(delete-process proc)))
-    (and nntp-async-buffer
-	 (buffer-name nntp-async-buffer)
-	 (kill-buffer nntp-async-buffer))
-    (let ((alist (cddr (assq 'nntp nnoo-state-alist)))
-	  entry)
-      (while (setq entry (pop alist))
-	(and (setq proc (cdr (assq 'nntp-async-buffer entry)))
-	     (buffer-name proc)
-	     (kill-buffer proc))))
-    (nnoo-close-server 'nntp)
-    (setq nntp-async-group-alist nil
-	  nntp-async-articles nil)))
-
-(deffoo nntp-server-opened (&optional server)
-  "Say whether a connection to SERVER has been opened."
-  (and (nnoo-current-server-p 'nntp server)
-       nntp-server-buffer
-       (buffer-name nntp-server-buffer)
-       nntp-server-process
-       (memq (process-status nntp-server-process) '(open run))))
-
-(deffoo nntp-status-message (&optional server)
-  "Return server status as a string."
-  (if (and nntp-status-string
-	   ;; NNN MESSAGE
-	   (string-match "[0-9][0-9][0-9][ \t]+\\([^\r]*\\).*$"
-			 nntp-status-string))
-      (substring nntp-status-string (match-beginning 1) (match-end 1))
-    ;; Empty message if nothing.
-    (or nntp-status-string "")))
-
-(deffoo nntp-request-article (id &optional group server buffer)
-  "Request article ID (Message-ID or number)."
-  (nntp-possibly-change-server group server)
-
-  (let (found)
-
-    ;; First we see whether we can get the article from the async buffer. 
-    (when (and (numberp id)
-	       nntp-async-articles
-	       (memq id nntp-async-fetched))
-      (save-excursion
-	(set-buffer nntp-async-buffer)
-	(let ((opoint (point))
-	      (art (if (numberp id) (int-to-string id) id))
-	      beg end)
-	  (when (and (or (re-search-forward (concat "^2.. +" art) nil t)
-			 (progn
-			   (goto-char (point-min))
-			   (re-search-forward (concat "^2.. +" art) opoint t)))
-		     (progn
-		       (beginning-of-line)
-		       (setq beg (point)
-			     end (re-search-forward "^\\.\r?\n" nil t))))
-	    (setq found t)
-	    (save-excursion
-	      (set-buffer (or buffer nntp-server-buffer))
-	      (erase-buffer)
-	      (insert-buffer-substring nntp-async-buffer beg end)
-	      (let ((nntp-server-buffer (current-buffer)))
-		(nntp-decode-text)))
-	    (delete-region beg end)
-	    (when nntp-async-articles
-	      (nntp-async-fetch-articles id))))))
-
-    (if found 
-	id
-      ;; The article was not in the async buffer, so we fetch it now.
-      (unwind-protect
-	  (progn
-	    (if buffer (set-process-buffer nntp-server-process buffer))
-	    (let ((nntp-server-buffer (or buffer nntp-server-buffer))
-		  (art (or (and (numberp id) (int-to-string id)) id)))
-	      (prog1
-		  (and (nntp-send-command 
-			;; A bit odd regexp to ensure working over rlogin.
-			"^\\.\r?\n" "ARTICLE" art)
-		       (if (numberp id) 
-			   (cons nntp-current-group id)
-			 ;; We find out what the article number was.
-			 (nntp-find-group-and-number)))
-		(nntp-decode-text)
-		(and nntp-async-articles (nntp-async-fetch-articles id)))))
-	(when buffer 
-	  (set-process-buffer nntp-server-process nntp-server-buffer))))))
-
-(deffoo nntp-request-body (id &optional group server)
-  "Request body of article ID (Message-ID or number)."
-  (nntp-possibly-change-server group server)
-  (prog1
-      ;; If NEmacs, end of message may look like: "\256\215" (".^M")
-      (nntp-send-command
-       "^\\.\r?\n" "BODY" (or (and (numberp id) (int-to-string id)) id))
-    (nntp-decode-text)))
-
-(deffoo nntp-request-head (id &optional group server)
-  "Request head of article ID (Message-ID or number)."
-  (nntp-possibly-change-server group server)
-  (prog1
-      (when (nntp-send-command 
-	     "^\\.\r?\n" "HEAD" (if (numberp id) (int-to-string id) id))
-	(if (numberp id) id
-	  ;; We find out what the article number was.
-	  (nntp-find-group-and-number)))
-    (nntp-decode-text)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (nnheader-fold-continuation-lines))))
-
-(deffoo nntp-request-stat (id &optional group server)
-  "Request STAT of article ID (Message-ID or number)."
-  (nntp-possibly-change-server group server)
-  (nntp-send-command 
-   "^[23].*\r?\n" "STAT" (or (and (numberp id) (int-to-string id)) id)))
-
-(deffoo nntp-request-type (group &optional article)
-  'news)
-
-(deffoo nntp-request-group (group &optional server dont-check)
-  "Select GROUP."
-  (nntp-possibly-change-server nil server)
-  (setq nntp-current-group
-	(when (nntp-send-command "^2.*\r?\n" "GROUP" group)
-	  group)))
-
-(deffoo nntp-request-asynchronous (group &optional server articles)
-  "Enable pre-fetch in GROUP."
-  (when nntp-async-articles
-    (nntp-async-request-group group))
-  (when nntp-async-number
-    (if (not (or (nntp-async-server-opened)
-		 (nntp-async-open-server)))
-	;; Couldn't open the second connection
-	(progn
-	  (message "Can't open second connection to %s" nntp-address)
-	  (ding)
-	  (setq nntp-async-articles nil)
-	  (sit-for 2))
-      ;; We opened the second connection (or it was opened already).  
-      (setq nntp-async-articles articles)
-      (setq nntp-async-fetched nil)
-      ;; Clear any old data.
-      (save-excursion
-	(set-buffer nntp-async-buffer)
-	(erase-buffer))
-      ;; Select the correct current group on this server.
-      (nntp-async-send-strings "GROUP" group)
-      t)))
-
-(deffoo nntp-list-active-group (group &optional server)
-  "Return the active info on GROUP (which can be a regexp."
-  (nntp-possibly-change-server group server)
-  (nntp-send-command "^.*\r?\n" "LIST ACTIVE" group))
-
-(deffoo nntp-request-group-description (group &optional server)
-  "Get the description of GROUP."
-  (nntp-possibly-change-server nil server)
-  (prog1
-      (nntp-send-command "^.*\r?\n" "XGTITLE" group)
-    (nntp-decode-text)))
-
-(deffoo nntp-close-group (group &optional server)
-  "Close GROUP."
-  (setq nntp-current-group nil)
-  t)
-
-(deffoo nntp-request-list (&optional server)
-  "List all active groups."
-  (nntp-possibly-change-server nil server)
-  (prog1
-      (nntp-send-command "^\\.\r?\n" "LIST")
-    (nntp-decode-text)))
-
-(deffoo nntp-request-list-newsgroups (&optional server)
-  "Get descriptions on all groups on SERVER."
-  (nntp-possibly-change-server nil server)
-  (prog1
-      (nntp-send-command "^\\.\r?\n" "LIST NEWSGROUPS")
-    (nntp-decode-text)))
-
-(deffoo nntp-request-newgroups (date &optional server)
-  "List groups that have arrived since DATE."
-  (nntp-possibly-change-server nil server)
-  (let* ((date (timezone-parse-date date))
-	 (time-string
-	  (format "%s%02d%02d %s%s%s"
-		  (substring (aref date 0) 2) (string-to-int (aref date 1)) 
-		  (string-to-int (aref date 2)) (substring (aref date 3) 0 2)
-		  (substring 
-		   (aref date 3) 3 5) (substring (aref date 3) 6 8))))
-    (prog1
-	(nntp-send-command "^\\.\r?\n" "NEWGROUPS" time-string)
-      (nntp-decode-text))))
-
-(deffoo nntp-request-list-distributions (&optional server)
-  "List distributions."
-  (nntp-possibly-change-server nil server)
-  (prog1
-      (nntp-send-command "^\\.\r?\n" "LIST DISTRIBUTIONS")
-    (nntp-decode-text)))
-
-(deffoo nntp-request-last (&optional group server)
-  "Decrease the current article pointer."
-  (nntp-possibly-change-server group server)
-  (nntp-send-command "^[23].*\r?\n" "LAST"))
-
-(deffoo nntp-request-next (&optional group server)
-  "Advance the current article pointer."
-  (nntp-possibly-change-server group server)
-  (nntp-send-command "^[23].*\r?\n" "NEXT"))
-
-(deffoo nntp-request-post (&optional server)
-  "Post the current buffer."
-  (nntp-possibly-change-server nil server)
-  (when (nntp-send-command "^[23].*\r?\n" "POST")
-    (nnheader-insert "")
-    (nntp-encode-text)
-    (nntp-send-region-to-server (point-min) (point-max))
-    ;; 1.2a NNTP's post command is buggy. "^M" (\r) is not
-    ;;  appended to end of the status message.
-    (nntp-wait-for-response "^[23].*\n")))
-
-;;; Internal functions.
-
-(defun nntp-send-mode-reader ()
-  "Send the MODE READER command to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will make innd servers spawn an nnrpd process to allow actual article
-reading."
-  (nntp-send-command "^.*\r?\n" "MODE READER"))
-
-(defun nntp-send-nosy-authinfo ()
-  "Send the AUTHINFO to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will prompt for a password."
-  (nntp-send-command "^.*\r?\n" "AUTHINFO USER"
-		     (read-string "NNTP user name: "))
-  (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" 
-		     (read-string "NNTP password: ")))
-
-(defun nntp-send-authinfo ()
-  "Send the AUTHINFO to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will prompt for a password."
-  (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
-  (nntp-send-command "^.*\r?\n" "AUTHINFO PASS" 
-		     (read-string "NNTP password: ")))
-
-(defun nntp-send-authinfo-from-file ()
-  "Send the AUTHINFO to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will prompt for a password."
-  (when (file-exists-p "~/.nntp-authinfo")
-    (save-excursion
-      (set-buffer (get-buffer-create " *authinfo*"))
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (insert-file-contents "~/.nntp-authinfo")
-      (goto-char (point-min))
-      (nntp-send-command "^.*\r?\n" "AUTHINFO USER" (user-login-name))
-      (nntp-send-command 
-       "^.*\r?\n" "AUTHINFO PASS" 
-       (buffer-substring (point) (progn (end-of-line) (point))))
-      (kill-buffer (current-buffer)))))
-
-(defun nntp-default-sentinel (proc status)
-  "Default sentinel function for NNTP server process."
-  (let ((servers (cddr (assq 'nntp nnoo-state-alist)))
-	server)
-    ;; Go through the alist of server names and find the name of the
-    ;; server that the process that sent the signal is connected to.
-    ;; If you get my drift.
-    (if (equal proc nntp-server-process)
-	(setq server nntp-address)
-      (while (and servers 
-		  (not (equal proc (cdr (assq 'nntp-server-process
-					      (car servers))))))
-	(setq servers (cdr servers)))
-      (setq server (caar servers)))
-    (when (and server
-	       nntp-warn-about-losing-connection)
-      (nnheader-message 3 "nntp: Connection closed to server %s" server)
-      (setq nntp-current-group "")
-      (ding))))
-
-(defun nntp-kill-connection (server)
-  "Choke the connection to SERVER."
-  (let ((proc (cdr (assq 'nntp-server-process 
-			 (assoc server (cddr 
-					(assq 'nntp nnoo-state-alist)))))))
-    (when proc 
-      (delete-process (process-name proc)))
-    (nntp-close-server server)
-    (nnheader-report
-     'nntp (message "Connection timed out to server %s" server))
-    (ding)
-    (sit-for 1)))
-
-;; Encoding and decoding of NNTP text.
-
-(defun nntp-decode-text ()
-  "Decode text transmitted by NNTP.
-0. Delete status line.
-1. Delete `^M' at end of line.
-2. Delete `.' at end of buffer (end of text mark).
-3. Delete `.' at beginning of line."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    ;; Insert newline at end of buffer.
-    (goto-char (point-max))
-    (or (bolp) (insert "\n"))
-    ;; Delete status line.
-    (delete-region (goto-char (point-min)) (progn (forward-line 1) (point)))
-    ;; Delete `^M's.
-    (while (search-forward "\r" nil t)
-      (replace-match "" t t))
-    ;; Delete `.' at end of the buffer (end of text mark).
-    (goto-char (point-max))
-    (forward-line -1)
-    (when (looking-at "^\\.\n")
-      (delete-region (point) (progn (forward-line 1) (point))))
-    ;; Replace `..' at beginning of line with `.'.
-    (goto-char (point-min))
-    ;; (replace-regexp "^\\.\\." ".")
-    (while (search-forward "\n.." nil t)
-      (delete-char -1))))
-
-(defun nntp-encode-text ()
-  "Encode text in current buffer for NNTP transmission.
-1. Insert `.' at beginning of line.
-2. Insert `.' at end of buffer (end of text mark)."
-  (save-excursion
-    ;; Replace `.' at beginning of line with `..'.
-    (goto-char (point-min))
-    (while (search-forward "\n." nil t)
-      (insert "."))
-    (goto-char (point-max))
-    ;; Insert newline at end of buffer.
-    (or (bolp) (insert "\n"))
-    ;; Insert `.' at end of buffer (end of text mark).
-    (insert "." nntp-end-of-line)))
-
-
-;;;
-;;; Synchronous Communication with NNTP servers.
-;;;
-
-(defvar nntp-retry-command)
-
-(defun nntp-send-command (response cmd &rest args)
-  "Wait for server RESPONSE after sending CMD and optional ARGS to server."
-  (let ((timer 
-	 (and nntp-command-timeout 
-	      (nnheader-run-at-time
-	       nntp-command-timeout nil 'nntp-kill-command 
-	       (nnoo-current-server 'nntp))))
-	(nntp-retry-command t)
-	result)
-    (unwind-protect
-	(save-excursion
-	  (while nntp-retry-command
-	    (setq nntp-retry-command nil)
-	    ;; Clear communication buffer.
-	    (set-buffer nntp-server-buffer)
-	    (widen)
-	    (erase-buffer)
-	    (if nntp-retry-on-break
-		(condition-case ()
-		    (progn
-		      (apply 'nntp-send-strings-to-server cmd args)
-		      (setq result
-			    (if response
-				(nntp-wait-for-response response)
-			      t)))
-		  (quit (setq nntp-retry-command t)))
-	      (apply 'nntp-send-strings-to-server cmd args)
-	      (setq result
-		    (if response
-			(nntp-wait-for-response response)
-		      t))))
-	  result)
-      (when timer 
-	(nnheader-cancel-timer timer)))))
-
-(defun nntp-kill-command (server)
-  "Kill and restart the connection to SERVER."
-  (let ((proc (cdr (assq 
-		    'nntp-server-process 
-		    (assoc server (cddr (assq 'nntp nnoo-state-alist)))))))
-    (when proc 
-      (delete-process (process-name proc)))
-    (nntp-close-server server)
-    (nntp-open-server server)
-    (when nntp-current-group
-      (nntp-request-group nntp-current-group))
-    (setq nntp-retry-command t)))
-
-(defun nntp-send-command-old (response cmd &rest args)
-  "Wait for server RESPONSE after sending CMD and optional ARGS to server."
-  (save-excursion
-    ;; Clear communication buffer.
-    (set-buffer nntp-server-buffer)
-    (erase-buffer)
-    (apply 'nntp-send-strings-to-server cmd args)
-    (if response
-	(nntp-wait-for-response response)
-      t)))
-
-(defun nntp-wait-for-response (regexp &optional slow)
-  "Wait for server response which matches REGEXP."
-  (save-excursion
-    (let ((status t)
-	  (wait t)
-	  (dotnum 0)			;Number of "." being displayed.
-	  (dotsize			;How often "." displayed.
-	   (if (numberp nntp-debug-read) nntp-debug-read 10000)))
-      (set-buffer nntp-server-buffer)
-      ;; Wait for status response (RFC977).
-      ;; 1xx - Informative message.
-      ;; 2xx - Command ok.
-      ;; 3xx - Command ok so far, send the rest of it.
-      ;; 4xx - Command was correct, but couldn't be performed for some
-      ;;       reason.
-      ;; 5xx - Command unimplemented, or incorrect, or a serious
-      ;;       program error occurred.
-      (nntp-accept-response)
-      (while wait
-	(goto-char (point-min))
-	(if slow
-	    (progn
-	      (cond ((re-search-forward "^[23][0-9][0-9]" nil t)
-		     (setq wait nil))
-		    ((re-search-forward "^[45][0-9][0-9]" nil t)
-		     (setq status nil)
-		     (setq wait nil))
-		    (t (nntp-accept-response)))
-	      (if (not wait) (delete-region (point-min) 
-					    (progn (beginning-of-line)
-						   (point)))))
-	  (cond ((looking-at "[23]")
-		 (setq wait nil))
-		((looking-at "[45]")
-		 (setq status nil)
-		 (setq wait nil))
-		(t (nntp-accept-response)))))
-      ;; Save status message.
-      (end-of-line)
-      (setq nntp-status-string
-	    (nnheader-replace-chars-in-string 
-	     (buffer-substring (point-min) (point)) ?\r ? ))
-      (when status
-	(setq wait t)
-	(while wait
-	  (goto-char (point-max))
-	  (if (bolp) (forward-line -1) (beginning-of-line))
-	  (if (looking-at regexp)
-	      (setq wait nil)
-	    (when nntp-debug-read
-	      (let ((newnum (/ (buffer-size) dotsize))
-		    (message-log-max nil))
-		(unless (= dotnum newnum)
-		  (setq dotnum newnum)
-		  (nnheader-message 7 "NNTP: Reading %s"
-				    (make-string dotnum ?.)))))
-	    (nntp-accept-response)))
-	;; Remove "...".
-	(when (and nntp-debug-read (> dotnum 0))
-	  (message ""))
-	;; Successfully received server response.
-	t))))
-
-
-
-;;;
-;;; Low-Level Interface to NNTP Server.
-;;; 
-
-(defun nntp-find-group-and-number ()
-  (save-excursion
-    (save-restriction
-      (set-buffer nntp-server-buffer)
-      (narrow-to-region (goto-char (point-min))
-			(or (search-forward "\n\n" nil t) (point-max)))
-      (goto-char (point-min))
-      ;; We first find the number by looking at the status line.
-      (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
-			 (string-to-int
-			  (buffer-substring (match-beginning 1)
-					    (match-end 1)))))
-	    group newsgroups xref)
-	(and number (zerop number) (setq number nil))
-	;; Then we find the group name.
-	(setq group
-	      (cond 
-	       ;; If there is only one group in the Newsgroups header,
-	       ;; then it seems quite likely that this article comes
-	       ;; from that group, I'd say.
-	       ((and (setq newsgroups (mail-fetch-field "newsgroups"))
-		     (not (string-match "," newsgroups)))
-		newsgroups)
-	       ;; If there is more than one group in the Newsgroups
-	       ;; header, then the Xref header should be filled out.
-	       ;; We hazard a guess that the group that has this
-	       ;; article number in the Xref header is the one we are
-	       ;; looking for.  This might very well be wrong if this
-	       ;; article happens to have the same number in several
-	       ;; groups, but that's life. 
-	       ((and (setq xref (mail-fetch-field "xref"))
-		     number
-		     (string-match (format "\\([^ :]+\\):%d" number) xref))
-		(substring xref (match-beginning 1) (match-end 1)))
-	       (t "")))
-	(when (string-match "\r" group) 
-	  (setq group (substring group 0 (match-beginning 0))))
-	(cons group number)))))
-
-(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
-  (erase-buffer)
-  (cond 
-
-   ;; This server does not talk NOV.
-   ((not nntp-server-xover)
-    nil)
-
-   ;; We don't care about gaps.
-   ((or (not nntp-nov-gap)
-	fetch-old)
-    (nntp-send-xover-command 
-     (if fetch-old
-	 (if (numberp fetch-old) 
-	     (max 1 (- (car articles) fetch-old)) 
-	   1)
-       (car articles))
-     (nntp-last-element articles) 'wait)
-
-    (goto-char (point-min))
-    (when (looking-at "[1-5][0-9][0-9] ")
-      (delete-region (point) (progn (forward-line 1) (point))))
-    (while (search-forward "\r" nil t)
-      (replace-match "" t t))
-    (goto-char (point-max))
-    (forward-line -1)
-    (when (looking-at "\\.")
-      (delete-region (point) (progn (forward-line 1) (point)))))
-
-   ;; We do it the hard way.  For each gap, an XOVER command is sent
-   ;; to the server.  We do not wait for a reply from the server, we
-   ;; just send them off as fast as we can.  That means that we have
-   ;; to count the number of responses we get back to find out when we
-   ;; have gotten all we asked for.
-   ((numberp nntp-nov-gap)
-    (let ((count 0)
-	  (received 0)
-	  (last-point (point-min))
-	  (buf (current-buffer))
-	  first)
-      ;; We have to check `nntp-server-xover'.  If it gets set to nil,
-      ;; that means that the server does not understand XOVER, but we
-      ;; won't know that until we try.
-      (while (and nntp-server-xover articles)
-	(setq first (car articles))
-	;; Search forward until we find a gap, or until we run out of
-	;; articles. 
-	(while (and (cdr articles) 
-		    (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
-	  (setq articles (cdr articles)))
-
-	(when (nntp-send-xover-command first (car articles))
-	  (setq articles (cdr articles)
-		count (1+ count))
-
-	  ;; Every 400 requests we have to read the stream in
-	  ;; order to avoid deadlocks.
-	  (when (or (null articles)	;All requests have been sent.
-		    (zerop (% count nntp-maximum-request)))
-	    (accept-process-output)
-	    ;; On some Emacs versions the preceding function has
-	    ;; a tendency to change the buffer. Perhaps. It's
-	    ;; quite difficult to reproduce, because it only
-	    ;; seems to happen once in a blue moon. 
-	    (set-buffer buf) 
-	    (while (progn
-		     (goto-char last-point)
-		     ;; Count replies.
-		     (while (re-search-forward "^[0-9][0-9][0-9] " nil t)
-		       (setq received (1+ received)))
-		     (setq last-point (point))
-		     (< received count))
-	      (accept-process-output)
-	      (set-buffer buf)))))
-
-      (when nntp-server-xover
-	;; Wait for the reply from the final command.
-	(goto-char (point-max))
-	(re-search-backward "^[0-9][0-9][0-9] " nil t)
-	(when (looking-at "^[23]")
-	  (while (progn
-		   (goto-char (point-max))
-		   (forward-line -1)
-		   (not (looking-at "^\\.\r?\n")))
-	    (nntp-accept-response)))
-	
-	;; We remove any "." lines and status lines.
-	(goto-char (point-min))
-	(while (search-forward "\r" nil t)
-	  (delete-char -1))
-	(goto-char (point-min))
-	(delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")))))
-
-  nntp-server-xover)
-
-(defun nntp-send-xover-command (beg end &optional wait-for-reply)
-  "Send the XOVER command to the server."
-  (let ((range (format "%d-%d" (or beg 1) (or end beg 1))))
-    (if (stringp nntp-server-xover)
-	;; If `nntp-server-xover' is a string, then we just send this
-	;; command.
-	(if wait-for-reply
-	    (nntp-send-command "^\\.\r?\n" nntp-server-xover range)
-	  ;; We do not wait for the reply.
-	  (nntp-send-strings-to-server nntp-server-xover range))
-      (let ((commands nntp-xover-commands))
-	;; `nntp-xover-commands' is a list of possible XOVER commands.
-	;; We try them all until we get at positive response. 
-	(while (and commands (eq nntp-server-xover 'try))
-	  (nntp-send-command "^\\.\r?\n" (car commands) range)
-	  (save-excursion
-	    (set-buffer nntp-server-buffer)
-	    (goto-char (point-min))
-	    (and (looking-at "[23]") ; No error message.
-		 ;; We also have to look at the lines.  Some buggy
-		 ;; servers give back simple lines with just the
-		 ;; article number.  How... helpful.
-		 (progn
-		   (forward-line 1)
-		   (looking-at "[0-9]+\t...")) ; More text after number.
-		 (setq nntp-server-xover (car commands))))
-	  (setq commands (cdr commands)))
-	;; If none of the commands worked, we disable XOVER.
-	(when (eq nntp-server-xover 'try)
-	  (save-excursion
-	    (set-buffer nntp-server-buffer)
-	    (erase-buffer)
-	    (setq nntp-server-xover nil)))
-	nntp-server-xover))))
-
-(defun nntp-send-strings-to-server (&rest strings)
-  "Send STRINGS to the server."
-  (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line)))
-    ;; We open the nntp server if it is down.
-    (or (nntp-server-opened (nnoo-current-server 'nntp))
-	(nntp-open-server (nnoo-current-server 'nntp))
-	(error (nntp-status-message)))
-    ;; Send the strings.
-    (process-send-string nntp-server-process cmd)
-    t))
-
-(defun nntp-send-region-to-server (begin end)
-  "Send the current buffer region (from BEGIN to END) to the server."
-  (save-excursion
-    (let ((cur (current-buffer)))
-      ;; Copy the buffer over to the send buffer.
-      (nnheader-set-temp-buffer " *nntp send*")
-      (insert-buffer-substring cur begin end)
-      (save-excursion
-	(set-buffer cur)
-	(erase-buffer))
-      ;; `process-send-region' does not work if the text to be sent is very
-      ;; large, so we send it piecemeal.
-      (let ((last (point-min))
-	    (size 100))			;Size of text sent at once.
-	(while (and (/= last (point-max))
-		    (memq (process-status nntp-server-process) '(open run)))
-	  (process-send-region 
-	   nntp-server-process
-	   last (setq last (min (+ last size) (point-max))))
-	  ;; Read any output from the server.  May be unnecessary.
-	  (accept-process-output)))
-      (kill-buffer (current-buffer)))))
-
-(defun nntp-open-server-semi-internal (server &optional service)
-  "Open SERVER.
-If SERVER is nil, use value of environment variable `NNTPSERVER'.
-If SERVICE, this this as the port number."
-  (nnheader-insert "")
-  (let ((server (or server (getenv "NNTPSERVER")))
-	(status nil)
-	(timer 
-	 (and nntp-connection-timeout 
-	      (nnheader-run-at-time nntp-connection-timeout
-				    nil 'nntp-kill-connection server))))
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (setq nntp-status-string "")
-      (nnheader-message 5 "nntp: Connecting to server on %s..." nntp-address)
-      (cond ((and server (nntp-open-server-internal server service))
-	     (setq nntp-address server)
-	     (setq status
-		   (condition-case nil
-		       (nntp-wait-for-response "^[23].*\r?\n" 'slow)
-		     (error nil)
-		     (quit nil)))
-	     (unless status
-	       (nntp-close-server-internal server)
-	       (nnheader-report 
-		'nntp "Couldn't open connection to %s" 
-		(if (and nntp-address
-			 (not (equal nntp-address "")))
-		    nntp-address server)))
-	     (when nntp-server-process
-	       (set-process-sentinel 
-		nntp-server-process 'nntp-default-sentinel)
-	       ;; You can send commands at startup like AUTHINFO here.
-	       ;; Added by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>
-	       (run-hooks 'nntp-server-opened-hook)))
-	    ((null server)
-	     (nnheader-report 'nntp "NNTP server is not specified."))
-	    (t				; We couldn't open the server.
-	     (nnheader-report 
-	      'nntp (buffer-substring (point-min) (point-max)))))
-      (when timer 
-	(nnheader-cancel-timer timer))
-      (message "")
-      (unless status
-	(nnoo-close-server 'nntp server)
-	(setq nntp-async-number nil))
-      status)))
-
-(defvar nntp-default-directories '("~" "/tmp" "/")
-  "Directories to as current directory in the nntp server buffer.")
-
-(defun nntp-open-server-internal (server &optional service)
-  "Open connection to news server on SERVER by SERVICE (default is nntp)."
-  (let (proc)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      ;; Make sure we have a valid current directory for the
-      ;; nntp server buffer.
-      (unless (file-exists-p default-directory)
-	(let ((dirs nntp-default-directories))
-	  (while dirs
-	    (when (file-exists-p (car dirs))
-	      (setq default-directory (car dirs)
-		    dirs nil))
-	    (setq dirs (cdr dirs)))))
-      (cond
-       ((and (setq proc
-		   (condition-case nil
-		       (funcall nntp-open-server-function server)
-		     (error nil)))
-	     (memq (process-status proc) '(open run)))
-	(setq nntp-server-process proc)
-	(setq nntp-address server)
-	;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-	(process-kill-without-query proc)
-	(run-hooks 'nntp-server-hook)
-	(push proc nntp-opened-connections)
-	(condition-case ()
-	    (nntp-read-server-type)
-	  (error 
-	   (nnheader-report 'nntp "Couldn't open server %s" server)
-	   (nntp-close-server)))
-	nntp-server-process)
-       (t
-	(nnheader-report 'nntp "Couldn't open server %s" server))))))
-
-(defun nntp-read-server-type ()
-  "Find out what the name of the server we have connected to is."
-  ;; Wait for the status string to arrive.
-  (nntp-wait-for-response "^.*\n" t)
-  (setq nntp-server-type (buffer-string))
-  (let ((alist nntp-server-action-alist)
-	entry)
-    ;; Run server-specific commmands.
-    (while alist
-      (setq entry (pop alist))
-      (when (string-match (car entry) nntp-server-type)
-	(if (and (listp (cadr entry))
-		 (not (eq 'lambda (caadr entry))))
-	    (eval (cadr entry))
-	  (funcall (cadr entry)))))))
-
-(defun nntp-open-network-stream (server)
-  (open-network-stream 
-   "nntpd" nntp-server-buffer server nntp-port-number))
-
-(defun nntp-open-rlogin (server)
-  (let ((proc (if nntp-rlogin-user-name
-		  (start-process
-		   "nntpd" nntp-server-buffer "rsh"
-		   "-l" nntp-rlogin-user-name server
-		   (mapconcat 'identity
-			      nntp-rlogin-parameters " "))
-		(start-process
-		 "nntpd" nntp-server-buffer "rsh" server
-		 (mapconcat 'identity
-			    nntp-rlogin-parameters " ")))))
-    proc))
-
-(defun nntp-telnet-to-machine ()
-  (let (b)
-    (telnet "localhost")
-    (goto-char (point-min))
-    (while (not (re-search-forward "^login: *" nil t))
-      (sit-for 1)
-      (goto-char (point-min)))
-    (goto-char (point-max))
-    (insert "larsi")
-    (telnet-send-input)
-    (setq b (point))
-    (while (not (re-search-forward ">" nil t))
-      (sit-for 1)
-      (goto-char b))
-    (goto-char (point-max))
-    (insert "ls")
-    (telnet-send-input)))
-
-(defun nntp-close-server-internal (&optional server)
-  "Close connection to news server."
-  (nntp-possibly-change-server nil server)
-  (if nntp-server-process
-      (delete-process nntp-server-process))
-  (setq nntp-server-process nil)
-  (setq nntp-address ""))
-
-(defun nntp-accept-response ()
-  "Read response of server.
-It is well-known that the communication speed will be much improved by
-defining this function as macro."
-  ;; To deal with server process exiting before
-  ;;  accept-process-output is called.
-  ;; Suggested by Jason Venner <jason@violet.berkeley.edu>.
-  ;; This is a copy of `nntp-default-sentinel'.
-  (let ((buf (current-buffer)))
-    (prog1
-	(if (or (not nntp-server-process)
-		(not (memq (process-status nntp-server-process) '(open run))))
-	    (error "nntp: Process connection closed; %s" (nntp-status-message))
-	  (if nntp-buggy-select
-	      (progn
-		;; We cannot use `accept-process-output'.
-		;; Fujitsu UTS requires messages during sleep-for.
-		;; I don't know why.
-		(nnheader-message 5 "NNTP: Reading...")
-		(sleep-for 1)
-		(nnheader-message 5 ""))
-	    (condition-case errorcode
-		(accept-process-output nntp-server-process 1)
-	      (error
-	       (cond ((string-equal "select error: Invalid argument" 
-				    (nth 1 errorcode))
-		      ;; Ignore select error.
-		      nil)
-		     (t
-		      (signal (car errorcode) (cdr errorcode))))))))
-      (set-buffer buf))))
-
-(defun nntp-last-element (list)
-  "Return last element of LIST."
-  (while (cdr list)
-    (setq list (cdr list)))
-  (car list))
-
-(defun nntp-possibly-change-server (newsgroup server &optional connectionless)
-  "Check whether the virtual server needs changing."
-  (when (and server
-	     (not (nntp-server-opened server)))
-    ;; This virtual server isn't open, so we (re)open it here.
-    (nntp-open-server server nil t))
-  (when (and newsgroup 
-	     (not (equal newsgroup nntp-current-group)))
-    ;; Set the proper current group.
-    (nntp-request-group newsgroup server)))
- 
-(defun nntp-try-list-active (group)
-  (nntp-list-active-group group)
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (goto-char (point-min))
-    (cond ((looking-at "5[0-9]+")
-	   (setq nntp-server-list-active-group nil))
-	  (t
-	   (setq nntp-server-list-active-group t)))))
-
-(defun nntp-async-server-opened ()
-  (and nntp-async-process
-       (memq (process-status nntp-async-process) '(open run))))
-
-(defun nntp-async-open-server ()
-  (save-excursion
-    (set-buffer (generate-new-buffer " *async-nntp*"))
-    (setq nntp-async-buffer (current-buffer))
-    (buffer-disable-undo (current-buffer)))
-  (let ((nntp-server-process nil)
-	(nntp-server-buffer nntp-async-buffer))
-    (nntp-open-server-semi-internal nntp-address nntp-port-number)
-    (if (not (setq nntp-async-process nntp-server-process))
-	(progn
-	  (setq nntp-async-number nil))
-      (set-process-buffer nntp-async-process nntp-async-buffer))))
-
-(defun nntp-async-fetch-articles (article)
-  (if (stringp article)
-      ()
-    (let ((articles (cdr (memq (assq article nntp-async-articles)
-			       nntp-async-articles)))
-	  (max (cond ((numberp nntp-async-number)
-		      nntp-async-number) 
-		     ((eq nntp-async-number t)
-		      (length nntp-async-articles))
-		     (t 0)))
-	  nart)
-      (while (and (>= (setq max (1- max)) 0)
-		  articles)
-	(or (memq (setq nart (caar articles)) nntp-async-fetched)
-	    (progn
-	      (nntp-async-send-strings "ARTICLE " (int-to-string nart))
-	      (setq nntp-async-fetched (cons nart nntp-async-fetched))))
-	(setq articles (cdr articles))))))
-
-(defun nntp-async-send-strings (&rest strings)
-  (let ((cmd (concat (mapconcat 'identity strings " ") nntp-end-of-line)))
-    (or (nntp-async-server-opened)
-	(nntp-async-open-server)
-	(error (nntp-status-message)))
-    (process-send-string nntp-async-process cmd)))
-
-(defun nntp-async-request-group (group)
-  (if (equal group nntp-current-group)
-      ()
-    (let ((asyncs (assoc group nntp-async-group-alist)))
-      ;; A new group has been selected, so we push the current state
-      ;; of async articles on an alist, and pull the old state off.
-      (setq nntp-async-group-alist 
-	    (cons (list nntp-current-group
-			nntp-async-articles nntp-async-fetched
-			nntp-async-process)
-		  (delq asyncs nntp-async-group-alist)))
-      (and asyncs
-	   (progn
-	     (setq nntp-async-articles (nth 1 asyncs))
-	     (setq nntp-async-fetched (nth 2 asyncs))
-	     (setq nntp-async-process (nth 3 asyncs)))))))
-
-(provide 'nntp)
-
-;;; nntp.el ends here
diff --git a/lisp/nnvirtual.el b/lisp/nnvirtual.el
deleted file mode 100644
index 47269c0de69..00000000000
--- a/lisp/nnvirtual.el
+++ /dev/null
@@ -1,409 +0,0 @@
-;;; nnvirtual.el --- virtual newsgroups access for Gnus
-;; Copyright (C) 1994,95,96 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 	Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news
-
-;; 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:
-
-;; The other access methods (nntp, nnspool, etc) are general news
-;; access methods. This module relies on Gnus and can not be used
-;; separately.
-
-;;; Code:
-
-(require 'nntp)
-(require 'nnheader)
-(require 'gnus)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnvirtual)
-
-(defvoo nnvirtual-always-rescan nil
-  "*If non-nil, always scan groups for unread articles when entering a group.
-If this variable is nil (which is the default) and you read articles
-in a component group after the virtual group has been activated, the
-read articles from the component group will show up when you enter the
-virtual group.")
-
-(defvoo nnvirtual-component-regexp nil
-  "*Regexp to match component groups.")
-
-
-
-(defconst nnvirtual-version "nnvirtual 1.0")
-
-(defvoo nnvirtual-current-group nil)
-(defvoo nnvirtual-component-groups nil)
-(defvoo nnvirtual-mapping nil)
-
-(defvoo nnvirtual-status-string "")
-
-(eval-and-compile
-  (autoload 'gnus-cache-articles-in-group "gnus-cache"))
-
-
-
-;;; Interface functions.
-
-(nnoo-define-basics nnvirtual)
-
-(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
-					     server fetch-old)
-  (when (nnvirtual-possibly-change-server server)
-    (save-excursion
-      (set-buffer nntp-server-buffer)
-      (erase-buffer)
-      (if (stringp (car articles))
-	  'headers
-	(let ((vbuf (nnheader-set-temp-buffer 
-		     (get-buffer-create " *virtual headers*")))
-	      (unfetched (mapcar (lambda (g) (list g))
-				 nnvirtual-component-groups))
-	      (system-name (system-name))
-	      cgroup article result prefix)
-	  (while articles
-	    (setq article (assq (pop articles) nnvirtual-mapping))
-	    (when (and (setq cgroup (cadr article))
-		       (gnus-check-server
-			(gnus-find-method-for-group cgroup) t)
-		       (gnus-request-group cgroup t))
-	      (setq prefix (gnus-group-real-prefix cgroup))
-	      (when (setq result (gnus-retrieve-headers 
-				  (list (caddr article)) cgroup nil))
-		(set-buffer nntp-server-buffer)
-		(if (zerop (buffer-size))
-		    (nconc (assq cgroup unfetched) (list (caddr article)))
-		  ;; If we got HEAD headers, we convert them into NOV
-		  ;; headers.  This is slow, inefficient and, come to think
-		  ;; of it, downright evil.  So sue me.  I couldn't be
-		  ;; bothered to write a header parse routine that could
-		  ;; parse a mixed HEAD/NOV buffer.
-		  (when (eq result 'headers)
-		    (nnvirtual-convert-headers))
-		  (goto-char (point-min))
-		  (while (not (eobp))
-		    (delete-region 
-		     (point) (progn (read nntp-server-buffer) (point)))
-		    (princ (car article) (current-buffer))
-		    (beginning-of-line)
-		    (looking-at 
-		     "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
-		    (goto-char (match-end 0))
-		    (or (search-forward 
-			 "\t" (save-excursion (end-of-line) (point)) t)
-			(end-of-line))
-		    (while (= (char-after (1- (point))) ? )
-		      (forward-char -1)
-		      (delete-char 1))
-		    (if (eolp)
-			(progn
-			  (end-of-line)
-			  (or (= (char-after (1- (point))) ?\t)
-			      (insert ?\t))
-			  (insert "Xref: " system-name " " cgroup ":")
-			  (princ (caddr article) (current-buffer))
-			  (insert "\t"))
-		      (insert "Xref: " system-name " " cgroup ":")
-		      (princ (caddr article) (current-buffer))
-		      (insert " ")
-		      (if (not (string= "" prefix))
-			  (while (re-search-forward 
-				  "[^ ]+:[0-9]+"
-				  (save-excursion (end-of-line) (point)) t)
-			    (save-excursion
-			      (goto-char (match-beginning 0))
-			      (insert prefix))))
-		      (end-of-line)
-		      (or (= (char-after (1- (point))) ?\t)
-			  (insert ?\t)))
-		    (forward-line 1))
-		  (set-buffer vbuf)
-		  (goto-char (point-max))
-		  (insert-buffer-substring nntp-server-buffer)))))
-	  
-	  ;; In case some of the articles have expired or been
-	  ;; cancelled, we have to mark them as read in the
-	  ;; component group.
-	  (while unfetched
-	    (when (cdar unfetched)
-	      (gnus-group-make-articles-read 
-	       (caar unfetched) (sort (cdar unfetched) '<)))
-	    (setq unfetched (cdr unfetched)))
-
-	  ;; The headers are ready for reading, so they are inserted into
-	  ;; the nntp-server-buffer, which is where Gnus expects to find
-	  ;; them.
-	  (prog1
-	      (save-excursion
-		(set-buffer nntp-server-buffer)
-		(erase-buffer)
-		(insert-buffer-substring vbuf)
-		'nov)
-	    (kill-buffer vbuf)))))))
-
-(deffoo nnvirtual-request-article (article &optional group server buffer)
-  (when (and (nnvirtual-possibly-change-server server)
-	     (numberp article))
-    (let* ((amap (assq article nnvirtual-mapping))
-	   (cgroup (cadr amap)))
-      (cond
-       ((not amap)
-	(nnheader-report 'nnvirtual "No such article: %s" article))
-       ((not (gnus-check-group cgroup))
-	(nnheader-report
-	 'nnvirtual "Can't open server where %s exists" cgroup))
-       ((not (gnus-request-group cgroup t))
-	(nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
-       (t
-	(if buffer 
-	    (save-excursion
-	      (set-buffer buffer)
-	      (gnus-request-article-this-buffer (caddr amap) cgroup))
-	  (gnus-request-article (caddr amap) cgroup)))))))
-
-(deffoo nnvirtual-open-server (server &optional defs)
-  (unless (assq 'nnvirtual-component-regexp defs)
-    (push `(nnvirtual-component-regexp ,server)
-	  defs))
-  (nnoo-change-server 'nnvirtual server defs)
-  (if nnvirtual-component-groups
-      t
-    (setq nnvirtual-mapping nil)
-    ;; Go through the newsrc alist and find all component groups.
-    (let ((newsrc (cdr gnus-newsrc-alist))
-	  group)
-      (while (setq group (car (pop newsrc)))
-	(when (string-match nnvirtual-component-regexp group) ; Match
-	  ;; Add this group to the list of component groups.
-	  (setq nnvirtual-component-groups
-		(cons group (delete group nnvirtual-component-groups))))))
-    (if (not nnvirtual-component-groups)
-	(nnheader-report 'nnvirtual "No component groups: %s" server)
-      t)))
-
-(deffoo nnvirtual-request-group (group &optional server dont-check)
-  (nnvirtual-possibly-change-server server)
-  (setq nnvirtual-component-groups
-	(delete (nnvirtual-current-group) nnvirtual-component-groups))
-  (cond
-   ((null nnvirtual-component-groups)
-    (setq nnvirtual-current-group nil)
-    (nnheader-report 'nnvirtual "No component groups in %s" group))
-   (t
-    (unless dont-check
-      (nnvirtual-create-mapping))
-    (setq nnvirtual-current-group group)
-    (let ((len (length nnvirtual-mapping)))
-      (nnheader-insert "211 %d 1 %d %s\n" len len group)))))
-
-(deffoo nnvirtual-request-type (group &optional article)
-  (if (not article)
-      'unknown
-    (let ((mart (assq article nnvirtual-mapping)))
-      (when mart
-	(gnus-request-type (cadr mart) (car mart))))))
-
-(deffoo nnvirtual-request-update-mark (group article mark)
-  (let* ((nart (assq article nnvirtual-mapping))
-	 (cgroup (cadr nart))
-	 ;; The component group might be a virtual group.
-	 (nmark (gnus-request-update-mark cgroup (caddr nart) mark)))
-    (when (and nart
-	       (= mark nmark)
-	       (gnus-group-auto-expirable-p cgroup))
-      (setq mark gnus-expirable-mark)))
-  mark)
-    
-(deffoo nnvirtual-close-group (group &optional server)
-  (when (nnvirtual-possibly-change-server server)
-    ;; Copy (un)read articles.
-    (nnvirtual-update-reads)
-    ;; We copy the marks from this group to the component
-    ;; groups here.
-    (nnvirtual-update-marked))
-  t)
-    
-(deffoo nnvirtual-request-list (&optional server) 
-  (nnheader-report 'nnvirtual "LIST is not implemented."))
-
-(deffoo nnvirtual-request-newgroups (date &optional server)
-  (nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
-
-(deffoo nnvirtual-request-list-newsgroups (&optional server)
-  (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented."))
-
-(deffoo nnvirtual-request-update-info (group info &optional server)
-  (when (nnvirtual-possibly-change-server server)
-    (let ((map nnvirtual-mapping)
-	  (marks (mapcar (lambda (m) (list (cdr m))) gnus-article-mark-lists))
-	  reads mr m op)
-      ;; Go through the mapping.
-      (while map
-	(unless (nth 3 (setq m (pop map)))
-	  ;; Read article.
-	  (push (car m) reads))
-	;; Copy marks.
-	(when (setq mr (nth 4 m))
-	  (while mr
-	    (setcdr (setq op (assq (pop mr) marks)) (cons (car m) (cdr op))))))
-      ;; Compress the marks and the reads.
-      (setq mr marks)
-      (while mr
-	(setcdr (car mr) (gnus-compress-sequence (sort (cdr (pop mr)) '<))))
-      (setcar (cddr info) (gnus-compress-sequence (nreverse reads)))
-      ;; Remove empty marks lists.
-      (while (and marks (not (cdar marks)))
-	(setq marks (cdr marks)))
-      (setq mr marks)
-      (while (cdr mr)
-	(if (cdadr mr)
-	    (setq mr (cdr mr))
-	  (setcdr mr (cddr mr))))
-
-      ;; Enter these new marks into the info of the group.
-      (if (nthcdr 3 info)
-	  (setcar (nthcdr 3 info) marks)
-	;; Add the marks lists to the end of the info.
-	(when marks
-	  (setcdr (nthcdr 2 info) (list marks))))
-      t)))
-
-(deffoo nnvirtual-catchup-group (group &optional server all)
-  (nnvirtual-possibly-change-server server)
-  (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
-	(gnus-expert-user t))
-    ;; Make sure all groups are activated.
-    (mapcar
-     (lambda (g)
-       (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
-	 (gnus-activate-group g)))
-     nnvirtual-component-groups)
-    (save-excursion
-      (set-buffer gnus-group-buffer)
-      (gnus-group-catchup-current nil all))))
-
-(deffoo nnvirtual-find-group-art (group article)
-  "Return the real group and article for virtual GROUP and ARTICLE."
-  (let ((mart (assq article nnvirtual-mapping)))
-    (when mart
-      (cons (cadr mart) (caddr mart)))))
-
-
-;;; Internal functions.
-
-(defun nnvirtual-convert-headers ()
-  "Convert HEAD headers into NOV headers."
-  (save-excursion
-    (set-buffer nntp-server-buffer)
-    (let* ((dependencies (make-vector 100 0))
-	   (headers (gnus-get-newsgroup-headers dependencies))
-	   header)
-      (erase-buffer)
-      (while (setq header (pop headers))
-	(nnheader-insert-nov header)))))
-
-(defun nnvirtual-possibly-change-server (server)
-  (or (not server)
-      (nnoo-current-server-p 'nnvirtual server)
-      (nnvirtual-open-server server)))
-
-(defun nnvirtual-update-marked ()
-  "Copy marks from the virtual group to the component groups."
-  (let ((mark-lists gnus-article-mark-lists)
-	(marks (gnus-info-marks (gnus-get-info (nnvirtual-current-group))))
-	type list mart cgroups)
-    (while (setq type (cdr (pop mark-lists)))
-      (setq list (gnus-uncompress-range (cdr (assq type marks))))
-      (setq cgroups 
-	    (mapcar (lambda (g) (list g)) nnvirtual-component-groups))
-      (while list
-	(nconc (assoc (cadr (setq mart (assq (pop list) nnvirtual-mapping)))
-		      cgroups)
-	       (list (caddr mart))))
-      (while cgroups
-	(gnus-add-marked-articles 
-	 (caar cgroups) type (cdar cgroups) nil t)
-	(gnus-group-update-group (car (pop cgroups)) t)))))
-
-(defun nnvirtual-update-reads ()
-  "Copy (un)reads from the current group to the component groups."
-  (let ((groups (mapcar (lambda (g) (list g)) nnvirtual-component-groups))
-	(articles (gnus-list-of-unread-articles
-		   (nnvirtual-current-group)))
-	m)
-    (while articles
-      (setq m (assq (pop articles) nnvirtual-mapping))
-      (nconc (assoc (nth 1 m) groups) (list (nth 2 m))))
-    (while groups
-      (gnus-update-read-articles (caar groups) (cdr (pop groups))))))
-
-(defun nnvirtual-current-group ()
-  "Return the prefixed name of the current nnvirtual group."
-  (concat "nnvirtual:" nnvirtual-current-group))
-
-(defsubst nnvirtual-marks (article marks)
-  "Return a list of mark types for ARTICLE."
-  (let (out)
-    (while marks
-      (when (memq article (cdar marks))
-	(push (caar marks) out))
-      (setq marks (cdr marks)))
-    out))
-
-(defun nnvirtual-create-mapping ()
-  "Create an article mapping for the current group."
-  (let* ((div nil)
-	 m marks list article unreads marks active
-	 (map (sort
-	       (apply 
-		'nconc
-		(mapcar
-		 (lambda (g)
-		   (when (and (setq active (gnus-activate-group g))
-			      (> (cdr active) (car active)))
-		     (setq unreads (gnus-list-of-unread-articles g)
-			   marks (gnus-uncompress-marks
-				  (gnus-info-marks (gnus-get-info g))))
-		     (when gnus-use-cache
-		       (push (cons 'cache (gnus-cache-articles-in-group g))
-			     marks))
-		     (setq div (/ (float (car active)) 
-				  (if (zerop (cdr active))
-				      1 (cdr active))))
-		     (mapcar (lambda (n) 
-			       (list (* div (- n (car active)))
-				     g n (and (memq n unreads) t)
-				     (inline (nnvirtual-marks n marks))))
-			     (gnus-uncompress-range active))))
-		 nnvirtual-component-groups))
-	       (lambda (m1 m2)
-		 (< (car m1) (car m2)))))
-	 (i 0))
-    (setq nnvirtual-mapping map)
-    ;; Set the virtual article numbers.
-    (while (setq m (pop map))
-      (setcar m (setq article (incf i))))))
-
-(provide 'nnvirtual)
-
-;;; nnvirtual.el ends here
diff --git a/lisp/novice.el b/lisp/novice.el
deleted file mode 100644
index 424ef693fd1..00000000000
--- a/lisp/novice.el
+++ /dev/null
@@ -1,145 +0,0 @@
-;;; novice.el --- handling of disabled commands ("novice mode") for Emacs.
-
-;; Copyright (C) 1985, 1986, 1987, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: internal, help
-
-;; 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 mode provides a hook which is, by default, attached to various
-;; putatively dangerous commands in a (probably futile) attempt to
-;; prevent lusers from shooting themselves in the feet.
-
-;;; Code:
-
-;; This function is called (by autoloading)
-;; to handle any disabled command.
-;; The command is found in this-command
-;; and the keys are returned by (this-command-keys).
-
-;;;###autoload
-(defvar disabled-command-hook 'disabled-command-hook
-  "Function to call to handle disabled commands.
-If nil, the feature is disabled, i.e., all commands work normally.")
-
-;;;###autoload
-(defun disabled-command-hook (&rest ignore)
-  (let (char)
-    (save-window-excursion
-     (with-output-to-temp-buffer "*Help*"
-       (let ((keys (this-command-keys)))
-	 (if (or (eq (aref keys 0)
-		     (if (stringp keys)
-			 (aref "\M-x" 0)
-		       ?\M-x))
-		 (and (>= (length keys) 2)
-		      (eq (aref keys 0) meta-prefix-char)
-		      (eq (aref keys 1) ?x)))
-	     (princ "You have invoked the disabled command ")
-	   (princ "You have typed ")
-	   (princ (key-description keys))
-	   (princ ", invoking disabled command ")))
-       (princ this-command)
-       (princ ":\n")
-       ;; Print any special message saying why the command is disabled.
-       (if (stringp (get this-command 'disabled))
-	   (princ (get this-command 'disabled)))
-       ;; Keep only the first paragraph of the documentation.
-       (save-excursion
-	 (set-buffer "*Help*")
-	 (goto-char (point-max))
-	 (save-excursion
-	   (princ (or (condition-case ()
-			  (documentation this-command)
-			(error nil))
-		      "<< not documented >>")))
-	 (if (search-forward "\n\n" nil t)
-	     (delete-region (1- (point)) (point-max))
-	   (goto-char (point-max))))
-       (princ "\n\n")
-       (princ "You can now type
-Space to try the command just this once, but leave it disabled,
-Y to try it and enable it (no questions if you use it again),
-! to try it and enable all commands in this session, or
-N to do nothing (command remains disabled).")
-       (save-excursion
-	(set-buffer standard-output)
-	(help-mode)))
-     (message "Type y, n, ! or Space: ")
-     (let ((cursor-in-echo-area t))
-       (while (not (memq (setq char (downcase (read-char)))
-			 '(?! ?  ?y ?n)))
-	 (ding)
-	 (message "Please type y, n, ! or Space: "))))
-    (if (= char ?!)
-	(setq disabled-command-hook nil))
-    (if (= char ?y)
-	(if (and user-init-file
-		 (not (string= "" user-init-file))
-		 (y-or-n-p "Enable command for future editing sessions also? "))
-	    (enable-command this-command)
-	  (put this-command 'disabled nil)))
-    (if (/= char ?n)
-	(call-interactively this-command))))
-
-;;;###autoload
-(defun enable-command (command)
-  "Allow COMMAND to be executed without special confirmation from now on.
-The user's .emacs file is altered so that this will apply
-to future sessions."
-  (interactive "CEnable command: ")
-  (put command 'disabled nil)
-  (save-excursion
-   (set-buffer (find-file-noselect
-		(substitute-in-file-name user-init-file)))
-   (goto-char (point-min))
-   (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
-       (delete-region
-	(progn (beginning-of-line) (point))
-	(progn (forward-line 1) (point))))
-   ;; Explicitly enable, in case this command is disabled by default
-   ;; or in case the code we deleted was actually a comment.
-   (goto-char (point-max))
-   (insert "\n(put '" (symbol-name command) " 'disabled nil)\n")
-   (save-buffer)))
-
-;;;###autoload
-(defun disable-command (command)
-  "Require special confirmation to execute COMMAND from now on.
-The user's .emacs file is altered so that this will apply
-to future sessions."
-  (interactive "CDisable command: ")
-  (if (not (commandp command))
-      (error "Invalid command name `%s'" command))
-  (put command 'disabled t)
-  (save-excursion
-   (set-buffer (find-file-noselect
-		(substitute-in-file-name user-init-file)))
-   (goto-char (point-min))
-   (if (search-forward (concat "(put '" (symbol-name command) " ") nil t)
-       (delete-region
-	(progn (beginning-of-line) (point))
-	(progn (forward-line 1) (point))))
-   (goto-char (point-max))
-   (insert "\n(put '" (symbol-name command) " 'disabled t)\n")
-   (save-buffer)))
-
-;;; novice.el ends here
diff --git a/lisp/options.el b/lisp/options.el
deleted file mode 100644
index 614292ce6e0..00000000000
--- a/lisp/options.el
+++ /dev/null
@@ -1,142 +0,0 @@
-;;; options.el --- edit Options command for Emacs.
-
-;; Copyright (C) 1985 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 code provides functions to list and edit the values of all global
-;; option variables known to loaded Emacs Lisp code.  There are two entry
-;; points, `list-options' and `edit' options'.  The latter enters a major
-;; mode specifically for editing option values.  Do `M-x describe-mode' in
-;; that context for more details.
-
-;;; Code:
-
-;;;###autoload
-(defun list-options ()
-  "Display a list of Emacs user options, with values and documentation."
-  (interactive)
-  (save-excursion
-    (set-buffer (get-buffer-create "*List Options*"))
-    (Edit-options-mode))
-  (with-output-to-temp-buffer "*List Options*"
-    (let (vars)
-      (mapatoms (function (lambda (sym)
-			    (if (user-variable-p sym)
-				(setq vars (cons sym vars))))))
-      (setq vars (sort vars 'string-lessp))
-      (while vars
-	(let ((sym (car vars)))
-	  (princ ";; ")
-	  (prin1 sym)
-	  (princ ":\n\t")
-	  (prin1 (symbol-value sym))
-	  (terpri)
-	  (princ (substitute-command-keys 
-		  (documentation-property sym 'variable-documentation)))
-	  (princ "\n;;\n"))
-	(setq vars (cdr vars)))))
-  (save-excursion
-    (set-buffer "*List Options*")
-    (setq buffer-read-only t)))
-
-;;;###autoload
-(defun edit-options ()
-  "Edit a list of Emacs user option values.
-Selects a buffer containing such a list,
-in which there are commands to set the option values.
-Type \\[describe-mode] in that buffer for a list of commands."
-  (interactive)
-  (list-options)
-  (pop-to-buffer "*List Options*"))
-
-(defvar Edit-options-mode-map
-  (let ((map (make-keymap)))
-    (define-key map "s" 'Edit-options-set)
-    (define-key map "x" 'Edit-options-toggle)
-    (define-key map "1" 'Edit-options-t)
-    (define-key map "0" 'Edit-options-nil)
-    (define-key map "p" 'backward-paragraph)
-    (define-key map " " 'forward-paragraph)
-    (define-key map "n" 'forward-paragraph)
-    map)
-  "")
-
-;; Edit Options mode is suitable only for specially formatted data.
-(put 'Edit-options-mode 'mode-class 'special)
-
-(defun Edit-options-mode ()
-  "\\<Edit-options-mode-map>\
-Major mode for editing Emacs user option settings.
-Special commands are:
-\\[Edit-options-set] -- set variable point points at.  New value read using minibuffer.
-\\[Edit-options-toggle] -- toggle variable, t -> nil, nil -> t.
-\\[Edit-options-t] -- set variable to t.
-\\[Edit-options-nil] -- set variable to nil.
-Changed values made by these commands take effect immediately.
-
-Each variable description is a paragraph.
-For convenience, the characters \\[backward-paragraph] and \\[forward-paragraph] move back and forward by paragraphs."
-  (kill-all-local-variables)
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (use-local-map Edit-options-mode-map)
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate "[^\^@-\^?]")
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start "\t")
-  (setq truncate-lines t)
-  (setq major-mode 'Edit-options-mode)
-  (setq mode-name "Options")
-  (run-hooks 'Edit-options-mode-hook))
-
-(defun Edit-options-set () (interactive)
-  (Edit-options-modify
-   '(lambda (var) (eval-minibuffer (concat "New " (symbol-name var) ": ")))))
-
-(defun Edit-options-toggle () (interactive)
-  (Edit-options-modify '(lambda (var) (not (symbol-value var)))))
-
-(defun Edit-options-t () (interactive)
-  (Edit-options-modify '(lambda (var) t)))
-
-(defun Edit-options-nil () (interactive)
-  (Edit-options-modify '(lambda (var) nil)))
-
-(defun Edit-options-modify (modfun)
-  (save-excursion
-   (let ((buffer-read-only nil) var pos)
-     (re-search-backward "^;; \\|\\`")
-     (forward-char 3)
-     (setq pos (point))
-     (save-restriction
-       (narrow-to-region pos (progn (end-of-line) (1- (point))))
-       (goto-char pos)
-       (setq var (read (current-buffer))))
-     (goto-char pos)
-     (forward-line 1)
-     (forward-char 1)
-     (save-excursion
-       (set var (funcall modfun var)))
-     (kill-sexp 1)
-     (prin1 (symbol-value var) (current-buffer)))))
-
-;;; options.el ends here
diff --git a/lisp/paren.el b/lisp/paren.el
deleted file mode 100644
index 66d27fbb6af..00000000000
--- a/lisp/paren.el
+++ /dev/null
@@ -1,181 +0,0 @@
-;;; paren.el --- highlight matching paren.
-
-;; Copyright (C) 1993, 1996 Free Software Foundation, Inc.
-
-;; Author: rms@gnu.ai.mit.edu
-;; Maintainer: FSF
-;; Keywords: languages, 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:
-
-;; Load this and it will display highlighting on whatever
-;; paren matches the one before or after point.
-
-;;; Code:
-
-;; This is the overlay used to highlight the matching paren.
-(defvar show-paren-overlay nil)
-;; This is the overlay used to highlight the closeparen right before point.
-(defvar show-paren-overlay-1 nil)
-
-(defvar show-paren-mode nil)
-(defvar show-paren-idle-timer nil)
-
-(defvar show-paren-mismatch-face nil)
-
-(defvar show-paren-delay (if (featurep 'lisp-float-type) 0.125 1)
-  "*Time in seconds to delay before showing the matching paren.")
-
-(defvar show-paren-face 'region
-  "*Name of the face to use for showing the matching paren.")
-
-;;;###autoload
-(defun show-paren-mode (&optional arg)
-  "Toggle Show Paren mode.
-With prefix ARG, turn Show Paren mode on if and only if ARG is positive.
-Returns the new status of Show Paren mode (non-nil means on).
-
-When Show Paren mode is enabled, any matching parenthesis is highlighted
-after `show-paren-delay' seconds of Emacs idle time."
-  (interactive "P")
-  (if window-system
-      (let ((on-p (if arg
-		      (> (prefix-numeric-value arg) 0)
-		    (not show-paren-mode))))
-	(setq blink-matching-paren-on-screen (not on-p))
-	(and show-paren-idle-timer (cancel-timer show-paren-idle-timer))
-	(if on-p
-	    (setq show-paren-idle-timer (run-with-idle-timer show-paren-delay t
-					 'show-paren-function))
-	  (and show-paren-overlay (overlay-buffer show-paren-overlay)
-	       (delete-overlay show-paren-overlay))
-	  (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1)
-	       (delete-overlay show-paren-overlay-1)))
-	(setq show-paren-mode on-p))))
-
-;; Find the place to show, if there is one,
-;; and show it until input arrives.
-(defun show-paren-function ()
-  ;; Do nothing if no window system to display results with.
-  ;; Do nothing if executing keyboard macro.
-  ;; Do nothing if input is pending.
-  (if window-system
-      (let (pos dir mismatch (oldpos (point))
-		(face show-paren-face))
-	(cond ((eq (char-syntax (preceding-char)) ?\))
-	       (setq dir -1))
-	      ((eq (char-syntax (following-char)) ?\()
-	       (setq dir 1)))
-	(if dir
-	    (save-excursion
-	      (save-restriction
-		;; Determine the range within which to look for a match.
-		(if blink-matching-paren-distance
-		    (narrow-to-region (max (point-min)
-					   (- (point) blink-matching-paren-distance))
-				      (min (point-max)
-					   (+ (point) blink-matching-paren-distance))))
-		;; Scan across one sexp within that range.
-		;; Errors or nil mean there is a mismatch.
-		(condition-case ()
-		    (setq pos (scan-sexps (point) dir))
-		  (error (setq pos t
-			       mismatch t)))
-		;; If found a "matching" paren, see if it is the right
-		;; kind of paren to match the one we started at.
-		(if (integerp pos)
-		    (let ((beg (min pos oldpos)) (end (max pos oldpos)))
-		      (and (/= (char-syntax (char-after beg)) ?\$)
-			   (setq mismatch
-				 (not (eq (char-after (1- end))
-					  ;; This can give nil.
-					  (matching-paren (char-after beg))))))))
-		;; If they don't properly match, use a different face,
-		;; or print a message.
-		(if mismatch
-		    (progn
-		      (and (null show-paren-mismatch-face)
-			   (x-display-color-p)
-			   (progn
-			     (add-to-list 'facemenu-unlisted-faces 
-					  'paren-mismatch)
-			     (make-face 'paren-mismatch)
-			     (or (face-nontrivial-p 'paren-mismatch t)
-				 (progn
-				   (set-face-background 'paren-mismatch
-							"purple")
-				   (set-face-foreground 'paren-mismatch
-							"white")))
-			     (setq show-paren-mismatch-face 'paren-mismatch)))
-		      (if show-paren-mismatch-face
-			  (setq face show-paren-mismatch-face)
-			(message "Paren mismatch"))))
-		)))
-	(cond (pos
-	       (if (or (= dir -1)
-		       (not (integerp pos)))
-		   ;; If matching backwards, highlight the closeparen
-		   ;; before point as well as its matching open.
-		   ;; If matching forward, and the openparen is unbalanced,
-		   ;; highlight the paren at point to indicate misbalance.
-		   (let ((from (if (= dir 1)
-				   (point)
-				 (1- (point))))
-			 (to (if (= dir 1)
-				 (1+ (point))
-			       (point))))
-		     (if show-paren-overlay-1
-			 (move-overlay show-paren-overlay-1
-				       from to
-				       (current-buffer))
-		       (setq show-paren-overlay-1
-			     (make-overlay from to)))
-		     ;; Always set the overlay face, since it varies.
-		     (overlay-put show-paren-overlay-1 'face face))
-		 ;; Otherwise, turn off any such highlighting.
-		 (and show-paren-overlay-1
-		      (overlay-buffer show-paren-overlay-1)
-		      (delete-overlay show-paren-overlay-1)))
-	       ;; Turn on highlighting for the matching paren, if found.
-	       ;; If it's an unmatched paren, turn off any such highlighting.
-	       (or (and (not (integerp pos))
-			(delete-overlay show-paren-overlay))
-		   (if show-paren-overlay
-		       (move-overlay show-paren-overlay (- pos dir) pos
-				     (current-buffer))
-		     (setq show-paren-overlay
-			   (make-overlay (- pos dir) pos))))
-	       ;; Always set the overlay face, since it varies.
-	       (overlay-put show-paren-overlay 'face face))
-	      (t
-	       ;; If not at a paren that has a match,
-	       ;; turn off any previous paren highlighting.
-	       (and show-paren-overlay (overlay-buffer show-paren-overlay)
-		    (delete-overlay show-paren-overlay))
-	       (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1)
-		    (delete-overlay show-paren-overlay-1)))))))
-
-;;; For back compatibility we turn ourselves on if we're dumped or loaded.
-(add-hook 'window-setup-hook '(lambda () (show-paren-mode t)))
-(show-paren-mode t)
-
-(provide 'paren)
-
-;;; paren.el ends here
diff --git a/lisp/patcomp.el b/lisp/patcomp.el
deleted file mode 100644
index 201c23c911e..00000000000
--- a/lisp/patcomp.el
+++ /dev/null
@@ -1,15 +0,0 @@
-
-;;; This function is used by the patch files to update Emacs releases.
-
-(defun batch-byte-recompile-emacs ()
-  "Recompile the Emacs `lisp' directory.
-This is used after installing the patches for a new version."
-  (let ((load-path (list (expand-file-name "lisp"))))
-    (byte-recompile-directory "lisp")))
-
-(defun batch-byte-compile-emacs ()
-  "Compile new files installed in the Emacs `lisp' directory.
-This is used after installing the patches for a new version.
-It uses the command line arguments to specify the files to compile."
-  (let ((load-path (list (expand-file-name "lisp"))))
-    (batch-byte-compile)))
diff --git a/lisp/paths.el b/lisp/paths.el
deleted file mode 100644
index 96536a1b4a1..00000000000
--- a/lisp/paths.el
+++ /dev/null
@@ -1,155 +0,0 @@
-;;; paths.el --- define pathnames for use by various Emacs commands.
-
-;; Copyright (C) 1986, 1988, 1994 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:
-
-;; These are default settings for names of certain files and directories
-;; that Emacs needs to refer to from time to time.
-
-;; If these settings are not right, override them with `setq'
-;; in site-init.el.  Do not change this file.
-
-;;; Code:
-
-(defvar Info-default-directory-list
-  (let ((start (list "/usr/local/lib/info/"
-		     ;; This comes second so that, if it is the same
-		     ;; as configure-info-directory (which is usually true)
-		     ;; and Emacs has been installed (also usually true)
-		     ;; then the list will end with two copies of this;
-		     ;; which means that the last dir file Info-insert-dir
-		     ;; finds will be the one in this directory.
-		     "/usr/local/info/"))
-	(configdir (file-name-as-directory configure-info-directory)))
-    (setq start (nconc start (list configdir)))
-    start)
-  "Default list of directories to search for Info documentation files.
-They are searched in the order they are given in the list.
-Therefore, the directory of Info files that come with Emacs
-normally should come last (so that local files override standard ones).
-
-Once Info is started, the list of directories to search
-comes from the variable `Info-directory-list'.
-This variable `Info-default-directory-list' is used as the default
-for initializing `Info-directory-list' when Info is started.")
-
-(defvar news-path
-  (if (file-exists-p "/usr/spool/news/")
-      "/usr/spool/news/"
-    "/var/spool/news/")
-  "The root directory below which all news files are stored.")
-
-(defvar news-inews-program
-  (cond ((file-exists-p "/usr/bin/inews") "/usr/bin/inews")
-	((file-exists-p "/usr/local/inews") "/usr/local/inews")
-	((file-exists-p "/usr/local/bin/inews") "/usr/local/bin/inews")
-	((file-exists-p "/usr/contrib/lib/news/inews") "/usr/contrib/lib/news/inews")
-	((file-exists-p "/usr/lib/news/inews") "/usr/lib/news/inews")
-	(t "inews"))
-  "Program to post news.")
-
-(defvar gnus-default-nntp-server ""
-  ;; set this to your local server
-  "The name of the host running an NNTP server.
-The null string means use the local host as the server site.")
-
-(defvar gnus-nntp-service "nntp"
-  "NNTP service name, usually \"nntp\" or 119).
-Go to a local news spool if its value is nil, in which case `gnus-nntp-server'
-should be set to `(system-name)'.")
-
-(defvar gnus-local-organization nil
-  "*The name of your organization, as a string.
-The `ORGANIZATION' environment variable is used instead if defined.")
-
-(defvar gnus-startup-file "~/.newsrc"
-  "The file listing groups to which user is subscribed.
-Will use `gnus-startup-file'-SERVER instead if exists.")
-
-(defvar rmail-file-name "~/RMAIL"
-  "Name of user's primary mail file.")
-
-(defconst rmail-spool-directory
-  (cond ((string-match "^[^-]+-[^-]+-sco3.2v4" system-configuration)
-	 "/usr/spool/mail/")
-	;; On The Bull DPX/2 /usr/spool/mail is used although 
-	;; it is usg-unix-v.
-	((string-match "^m68k-bull-sysv3" system-configuration)
-	 "/usr/spool/mail/")
-	;; SVR4 and recent BSD are said to use this.
-	;; Rather than trying to know precisely which systems use it,
-	;; let's assume this dir is never used for anything else.
-	((file-exists-p "/var/mail")
-	 "/var/mail/")
-	;; Many GNU/Linux systems use this name.
-	((file-exists-p "/var/spool/mail")
-	 "/var/spool/mail/")
-	((memq system-type '(dgux hpux usg-unix-v unisoft-unix rtu irix))
-	 "/usr/mail/")
-	(t "/usr/spool/mail/"))
-  "Name of directory used by system mailer for delivering new mail.
-Its name should end with a slash.")
-
-(defconst sendmail-program
-  (cond
-    ((file-exists-p "/usr/lib/sendmail") "/usr/lib/sendmail")
-    ((file-exists-p "/usr/sbin/sendmail") "/usr/sbin/sendmail")
-    ((file-exists-p "/usr/ucblib/sendmail") "/usr/ucblib/sendmail")
-    (t "fakemail"))			;In ../etc, to interface to /bin/mail.
-  "Program used to send messages.")
-
-(defconst remote-shell-program
-  (cond
-   ;; Some systems use rsh for the remote shell; others use that name for the
-   ;; restricted shell and use remsh for the remote shell.  Let's try to guess
-   ;; based on what we actually find out there.  The restricted shell is
-   ;; almost certainly in /bin or /usr/bin, so it's probably safe to assume
-   ;; that an rsh found elsewhere is the remote shell program.  The converse
-   ;; is not true: /usr/bin/rsh could be either one, so check that last.
-   ((file-exists-p "/usr/ucb/remsh") "/usr/ucb/remsh")
-   ((file-exists-p "/usr/bsd/remsh") "/usr/bsd/remsh")
-   ((file-exists-p "/bin/remsh") "/bin/remsh")
-   ((file-exists-p "/usr/bin/remsh") "/usr/bin/remsh")
-   ((file-exists-p "/usr/local/bin/remsh") "/usr/local/bin/remsh")
-   ((file-exists-p "/usr/ucb/rsh") "/usr/ucb/rsh")
-   ((file-exists-p "/usr/bsd/rsh") "/usr/bsd/rsh")
-   ((file-exists-p "/usr/local/bin/rsh") "/usr/local/bin/rsh")
-   ((file-exists-p "/usr/bin/rcmd") "/usr/bin/rcmd")
-   ((file-exists-p "/bin/rcmd") "/bin/rcmd")
-   ((file-exists-p "/bin/rsh") "/bin/rsh")
-   ((file-exists-p "/usr/bin/rsh") "/usr/bin/rsh")
-   (t "rsh")))
-
-(defconst term-file-prefix (if (eq system-type 'vax-vms) "[.term]" "term/")
-  "If non-nil, Emacs startup does (load (concat term-file-prefix (getenv \"TERM\")))
-You may set this variable to nil in your `.emacs' file if you do not wish
-the terminal-initialization file to be loaded.")
-
-(defconst abbrev-file-name 
-  (if (eq system-type 'vax-vms)
-      "~/abbrev.def"
-    (convert-standard-filename "~/.abbrev_defs"))
-  "*Default name of file to read abbrevs from.")
-
-;;; paths.el ends here
diff --git a/lisp/play/blackbox.el b/lisp/play/blackbox.el
deleted file mode 100644
index 8de46c2f025..00000000000
--- a/lisp/play/blackbox.el
+++ /dev/null
@@ -1,421 +0,0 @@
-;;; blackbox.el --- blackbox game in Emacs Lisp
-
-;; Copyright (C) 1985, 1986, 1987, 1992 Free Software Foundation, Inc.
-
-;; Author: F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
-;; Adapted-By: ESR
-;; Keywords: games
-
-;; 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:
-
-;; by F. Thomas May <uw-nsr!uw-warp!tom@beaver.cs.washington.edu>
-;; doc comment by Root Boy Jim <rbj@dsys.icst.nbs.gov>, 27 Apr 89
-;; interface improvements by ESR, Dec 5 1991.
-
-;; The object of the game is to find four hidden balls by shooting rays
-;; into the black box.  There are four possibilities: 1) the ray will
-;; pass thru the box undisturbed, 2) it will hit a ball and be absorbed,
-;; 3) it will be deflected and exit the box, or 4) be deflected immediately,
-;; not even being allowed entry into the box.
-;; 
-;; The strange part is the method of deflection.  It seems that rays will
-;; not pass next to a ball, and change direction at right angles to avoid it.
-;; 
-;; 		             R   3   
-;; 		 1 - - - - - - - - 1 
-;; 		   - - - - - - - -   
-;; 		   - O - - - - - - 3 
-;; 		 2 - - - - O - O -   
-;; 		 4 - - - - - - - - 
-;; 		 5 - - - - - - - - 5 
-;; 		   - - - - - - - - R 
-;; 		 H - - - - - - - O   
-;; 		   2   H 4       H   
-;; 
-;; Rays which enter and exit are numbered.  You can see that rays 1 & 5 pass
-;; thru the box undisturbed. Ray 2 is deflected by the northwesternmost
-;; ball.  Likewise rays 3 and 4. Rays which hit balls and are absorbed are
-;; marked with H.  The bottom of the left and the right of the bottom hit
-;; the southeastern ball directly.  Rays may also hit balls after being
-;; reflected. Consider the H on the bottom next to the 4.  It bounces off
-;; the NW-ern most ball and hits the central ball.  A ray shot from above
-;; the right side 5 would hit the SE-ern most ball.  The R beneath the 5
-;; is because the ball is returned instantly.  It is not allowed into
-;; the box if it would reflect immediately.  The R on the top is a more
-;; leisurely return.  Both central balls would tend to deflect it east
-;; or west, but it cannot go either way, so it just retreats.
-;;
-;; At the end of the game, if you've placed guesses for as many balls as
-;; there are in the box, the true board position will be revealed.  Each
-;; `x' is an incorrect guess of yours; `o' is the true location of a ball.
-
-;;; Code:
-
-(defvar blackbox-mode-map nil "")
-
-(if blackbox-mode-map
-    ()
-  (setq blackbox-mode-map (make-keymap))
-  (suppress-keymap blackbox-mode-map t)
-  (define-key blackbox-mode-map "\C-f" 'bb-right)
-  (define-key blackbox-mode-map [right] 'bb-right)
-  (define-key blackbox-mode-map "\C-b" 'bb-left)
-  (define-key blackbox-mode-map [left] 'bb-left)
-  (define-key blackbox-mode-map "\C-p" 'bb-up)
-  (define-key blackbox-mode-map [up] 'bb-up)
-  (define-key blackbox-mode-map "\C-n" 'bb-down)
-  (define-key blackbox-mode-map [down] 'bb-down)
-  (define-key blackbox-mode-map "\C-e" 'bb-eol)
-  (define-key blackbox-mode-map "\C-a" 'bb-bol)
-  (define-key blackbox-mode-map " " 'bb-romp)
-  (define-key blackbox-mode-map [insert] 'bb-romp)
-  (define-key blackbox-mode-map "\C-m" 'bb-done)
-  (define-key blackbox-mode-map [kp-enter] 'bb-done))
-
-;; Blackbox mode is suitable only for specially formatted data.
-(put 'blackbox-mode 'mode-class 'special)
-
-(defun blackbox-mode ()
-  "Major mode for playing blackbox.  To learn how to play blackbox,
-see the documentation for function `blackbox'.
-
-The usual mnemonic keys move the cursor around the box.
-\\<blackbox-mode-map>\\[bb-bol] and \\[bb-eol] move to the beginning and end of line, respectively.
-
-\\[bb-romp] -- send in a ray from point, or toggle a ball at point
-\\[bb-done] -- end game and get score
-"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map blackbox-mode-map)
-  (setq truncate-lines t)
-  (setq major-mode 'blackbox-mode)
-  (setq mode-name "Blackbox"))
-
-;;;###autoload
-(defun blackbox (num)
-  "Play blackbox.  Optional prefix argument is the number of balls;
-the default is 4.
-
-What is blackbox?
-
-Blackbox is a game of hide and seek played on an 8 by 8 grid (the
-Blackbox).  Your opponent (Emacs, in this case) has hidden several
-balls (usually 4) within this box.  By shooting rays into the box and
-observing where they emerge it is possible to deduce the positions of
-the hidden balls.  The fewer rays you use to find the balls, the lower
-your score.
-
-Overview of play:
-
-\\<blackbox-mode-map>\
-To play blackbox, type \\[blackbox].  An optional prefix argument
-specifies the number of balls to be hidden in the box; the default is
-four.
-
-The cursor can be moved around the box with the standard cursor
-movement keys.
-
-To shoot a ray, move the cursor to the edge of the box and press SPC.
-The result will be determined and the playfield updated.
-
-You may place or remove balls in the box by moving the cursor into the
-box and pressing \\[bb-romp].
-
-When you think the configuration of balls you have placed is correct,
-press \\[bb-done].  You will be informed whether you are correct or
-not, and be given your score.  Your score is the number of letters and
-numbers around the outside of the box plus five for each incorrectly
-placed ball.  If you placed any balls incorrectly, they will be
-indicated with `x', and their actual positions indicated with `o'.
-
-Details:
-
-There are three possible outcomes for each ray you send into the box:
-
-	Detour: the ray is deflected and emerges somewhere other than
-		where you sent it in.  On the playfield, detours are
-		denoted by matching pairs of numbers -- one where the
-		ray went in, and the other where it came out.
-
-	Reflection: the ray is reflected and emerges in the same place
-		it was sent in.  On the playfield, reflections are
-		denoted by the letter `R'.
-
-	Hit:	the ray strikes a ball directly and is absorbed.  It does
-		not emerge from the box.  On the playfield, hits are
-		denoted by the letter `H'.
-
-The rules for how balls deflect rays are simple and are best shown by
-example.
-
-As a ray approaches a ball it is deflected ninety degrees.  Rays can
-be deflected multiple times.  In the diagrams below, the dashes
-represent empty box locations and the letter `O' represents a ball.
-The entrance and exit points of each ray are marked with numbers as
-described under \"Detour\" above.  Note that the entrance and exit
-points are always interchangeable.  `*' denotes the path taken by the
-ray.
-
-Note carefully the relative positions of the ball and the ninety
-degree deflection it causes.
-
-    1                                            
-  - * - - - - - -         - - - - - - - -         - - - - - - - -       
-  - * - - - - - -         - - - - - - - -         - - - - - - - -       
-1 * * - - - - - -         - - - - - - - -         - O - - - - O -       
-  - - O - - - - -         - - O - - - - -         - - * * * * - -
-  - - - - - - - -         - - - * * * * * 2     3 * * * - - * - -
-  - - - - - - - -         - - - * - - - -         - - - O - * - -      
-  - - - - - - - -         - - - * - - - -         - - - - * * - -       
-  - - - - - - - -         - - - * - - - -         - - - - * - O -       
-                                2                         3
-
-As mentioned above, a reflection occurs when a ray emerges from the same point
-it was sent in.  This can happen in several ways:
-
-                                                                           
-  - - - - - - - -         - - - - - - - -          - - - - - - - -
-  - - - - O - - -         - - O - O - - -          - - - - - - - -
-R * * * * - - - -         - - - * - - - -          O - - - - - - -
-  - - - - O - - -         - - - * - - - -        R - - - - - - - -
-  - - - - - - - -         - - - * - - - -          - - - - - - - -
-  - - - - - - - -         - - - * - - - -          - - - - - - - -
-  - - - - - - - -       R * * * * - - - -          - - - - - - - -
-  - - - - - - - -         - - - - O - - -          - - - - - - - -
-
-In the first example, the ray is deflected downwards by the upper
-ball, then left by the lower ball, and finally retraces its path to
-its point of origin.  The second example is similar.  The third
-example is a bit anomalous but can be rationalized by realizing the
-ray never gets a chance to get into the box.  Alternatively, the ray
-can be thought of as being deflected downwards and immediately
-emerging from the box.
-
-A hit occurs when a ray runs straight into a ball:
-
-  - - - - - - - -         - - - - - - - -          - - - - - - - -
-  - - - - - - - -         - - - - - - - -          - - - - O - - -
-  - - - - - - - -         - - - - O - - -        H * * * * - - - -
-  - - - - - - - -       H * * * * O - - -          - - - * - - - -
-  - - - - - - - -         - - - - O - - -          - - - O - - - -
-H * * * O - - - -         - - - - - - - -          - - - - - - - -
-  - - - - - - - -         - - - - - - - -          - - - - - - - -
-  - - - - - - - -         - - - - - - - -          - - - - - - - -
-
-Be sure to compare the second example of a hit with the first example of
-a reflection."
-  (interactive "P")
-  (switch-to-buffer "*Blackbox*")
-  (blackbox-mode)
-  (setq buffer-read-only t)
-  (buffer-disable-undo (current-buffer))
-  (setq bb-board (bb-init-board (or num 4)))
-  (setq bb-balls-placed nil)
-  (setq bb-x -1)
-  (setq bb-y -1)
-  (setq bb-score 0)
-  (setq bb-detour-count 0)
-  (bb-insert-board)
-  (bb-goto (cons bb-x bb-y)))
-
-(defun bb-init-board (num-balls)
-  (random t)
-  (let (board pos)
-    (while (>= (setq num-balls (1- num-balls)) 0)
-      (while
-	  (progn
-	    (setq pos (cons (random 8) (random 8)))
-	    (bb-member pos board)))
-      (setq board (cons pos board)))
-    board))
-
-(defun bb-insert-board ()
-  (let (i (buffer-read-only nil))
-    (erase-buffer)
-    (insert "                     \n")
-    (setq i 8)
-    (while (>= (setq i (1- i)) 0)
-      (insert "   - - - - - - - -   \n"))
-    (insert "                     \n")
-    (insert (format "\nThere are %d balls in the box" (length bb-board)))
-    ))
-
-(defun bb-right ()
-  (interactive)
-  (if (= bb-x 8)
-      ()
-    (forward-char 2)
-    (setq bb-x (1+ bb-x))))
-
-(defun bb-left ()
-  (interactive)
-  (if (= bb-x -1)
-      ()
-    (backward-char 2)
-    (setq bb-x (1- bb-x))))
-
-(defun bb-up ()
-  (interactive)
-  (if (= bb-y -1)
-      ()
-    (previous-line 1)
-    (setq bb-y (1- bb-y))))
-
-(defun bb-down ()
-  (interactive)
-  (if (= bb-y 8)
-      ()
-    (next-line 1)
-    (setq bb-y (1+ bb-y))))
-
-(defun bb-eol ()
-  (interactive)
-  (setq bb-x 8)
-  (bb-goto (cons bb-x bb-y)))
-
-(defun bb-bol ()
-  (interactive)
-  (setq bb-x -1)
-  (bb-goto (cons bb-x bb-y)))
-
-(defun bb-romp ()
-  (interactive)
-  (cond
-   ((and
-     (or (= bb-x -1) (= bb-x 8))
-     (or (= bb-y -1) (= bb-y 8))))
-   ((bb-outside-box bb-x bb-y)
-    (bb-trace-ray bb-x bb-y))
-   (t
-    (bb-place-ball bb-x bb-y))))
-
-(defun bb-place-ball (x y)
-  (let ((coord (cons x y)))
-    (cond
-     ((bb-member coord bb-balls-placed)
-      (setq bb-balls-placed (bb-delete coord bb-balls-placed))
-      (bb-update-board "-"))
-     (t
-      (setq bb-balls-placed (cons coord bb-balls-placed))
-      (bb-update-board "O")))))
-
-(defun bb-trace-ray (x y)
-  (let ((result (bb-trace-ray-2
-		 t
-		 x
-		 (cond
-		  ((= x -1) 1)
-		  ((= x 8) -1)
-		  (t 0))
-		 y
-		 (cond
-		  ((= y -1) 1)
-		  ((= y 8) -1)
-		  (t 0)))))
-    (cond
-     ((eq result 'hit)
-      (bb-update-board "H")
-      (setq bb-score (1+ bb-score)))
-     ((equal result (cons x y))
-      (bb-update-board "R")
-      (setq bb-score (1+ bb-score)))
-     (t
-      (setq bb-detour-count (1+ bb-detour-count))
-      (bb-update-board (format "%d" bb-detour-count))
-      (save-excursion
-	(bb-goto result)
-	(bb-update-board (format "%d" bb-detour-count)))
-      (setq bb-score (+ bb-score 2))))))
-
-(defun bb-trace-ray-2 (first x dx y dy)
-  (cond
-   ((and (not first)
-	 (bb-outside-box x y))
-    (cons x y))
-   ((bb-member (cons (+ x dx) (+ y dy)) bb-board)
-    'hit)
-   ((bb-member (cons (+ x dx dy) (+ y dy dx)) bb-board)
-    (bb-trace-ray-2 nil x (- dy) y (- dx)))
-   ((bb-member (cons (+ x dx (- dy)) (+ y dy (- dx))) bb-board)
-    (bb-trace-ray-2 nil x dy y dx))
-   (t
-    (bb-trace-ray-2 nil (+ x dx) dx (+ y dy) dy))))
-
-(defun bb-done ()
-  "Finish the game and report score."
-  (interactive)
-  (let (bogus-balls)
-    (cond
-     ((not (= (length bb-balls-placed) (length bb-board)))
-      (message "There %s %d hidden ball%s; you have placed %d."
-	       (if (= (length bb-board) 1) "is" "are")
-	       (length bb-board)
-	       (if (= (length bb-board) 1) "" "s")
-	       (length bb-balls-placed)))
-     (t
-      (setq bogus-balls (bb-show-bogus-balls bb-balls-placed bb-board))
-      (if (= bogus-balls 0)
-	  (message "Right!  Your score is %d." bb-score)
-	(message "Oops!  You missed %d ball%s.  Your score is %d."
-		 bogus-balls
-		 (if (= bogus-balls 1) "" "s")
-		 (+ bb-score (* 5 bogus-balls))))
-      (bb-goto '(-1 . -1))))))
-
-(defun bb-show-bogus-balls (balls-placed board)
-  (bb-show-bogus-balls-2 balls-placed board "x")
-  (bb-show-bogus-balls-2 board balls-placed "o"))
-
-(defun bb-show-bogus-balls-2 (list-1 list-2 c)
-  (cond
-   ((null list-1)
-    0)
-   ((bb-member (car list-1) list-2)
-    (bb-show-bogus-balls-2 (cdr list-1) list-2 c))
-   (t
-    (bb-goto (car list-1))
-    (bb-update-board c)
-    (1+ (bb-show-bogus-balls-2 (cdr list-1) list-2 c)))))
-
-(defun bb-outside-box (x y)
-  (or (= x -1) (= x 8) (= y -1) (= y 8)))
-
-(defun bb-goto (pos)
-  (goto-char (+ (* (car pos) 2) (* (cdr pos) 22) 26)))
-
-(defun bb-update-board (c)
-  (let ((buffer-read-only nil))
-    (backward-char (1- (length c)))
-    (delete-char (length c))
-    (insert c)
-    (backward-char 1)))
-  
-(defun bb-member (elt list)
-  "Returns non-nil if ELT is an element of LIST."
-  (eval (cons 'or (mapcar (function (lambda (x) (equal x elt))) list))))
-
-(defun bb-delete (item list)
-  "Deletes ITEM from LIST and returns a copy."
-  (cond
-   ((equal item (car list)) (cdr list))
-   (t (cons (car list) (bb-delete item (cdr list))))))
-
-;;; blackbox.el ends here
diff --git a/lisp/play/cookie1.el b/lisp/play/cookie1.el
deleted file mode 100644
index 3f8087fa2fa..00000000000
--- a/lisp/play/cookie1.el
+++ /dev/null
@@ -1,165 +0,0 @@
-;;; cookie1.el --- retrieve random phrases from fortune cookie files
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: FSF
-;; Keywords: games
-;; Created: Mon Mar 22 17:06:26 1993
-
-;; 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:
-
-;; Support for random cookie fetches from phrase files, used for such
-;; critical applications as emulating Zippy the Pinhead and confounding
-;; the NSA Trunk Trawler.
-;;
-;; The two entry points are `cookie' and `cookie-insert'.  The helper
-;; function `shuffle-vector' may be of interest to programmers.
-;;
-;; The code expects phrase files to be in one of two formats:
-;;
-;; * ITS-style LINS format (strings terminated by ASCII 0 characters,
-;; leading whitespace ignored).
-;;
-;; * UNIX fortune file format (quotes terminated by %% on a line by itself).
-;;
-;; Everything up to the first delimiter is treated as a comment.  Other
-;; formats could be supported by adding alternates to the regexp
-;; `cookie-delimiter'.
-;;
-;; This code derives from Steve Strassman's 1987 spook.el package, but
-;; has been generalized so that it supports multiple simultaneous
-;; cookie databases and fortune files.  It is intended to be called
-;; from other packages such as yow.el and spook.el.
-;;
-;; TO DO: teach cookie-snarf to auto-detect ITS PINS or UNIX fortune(6)
-;; format and do the right thing.
-
-;;; Code:
-
-; Randomize the seed in the random number generator.
-(random t)
-
-(defconst cookie-delimiter "\n%%\n\\|\0"
-  "Delimiter used to separate cookie file entries.")
-
-(defvar cookie-cache (make-vector 511 0)
-  "Cache of cookie files that have already been snarfed.")
-
-;;;###autoload
-(defun cookie (phrase-file startmsg endmsg)
-  "Return a random phrase from PHRASE-FILE.  When the phrase file
-is read in, display STARTMSG at beginning of load, ENDMSG at end."
-  (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
-    (shuffle-vector cookie-vector)
-    (aref cookie-vector 1)))
-
-;;;###autoload
-(defun cookie-insert (phrase-file &optional count startmsg endmsg)
-  "Insert random phrases from PHRASE-FILE; COUNT of them.  When the phrase file
-is read in, display STARTMSG at beginning of load, ENDMSG at end."
-  (let ((cookie-vector (cookie-snarf phrase-file startmsg endmsg)))
-    (shuffle-vector cookie-vector)
-    (let ((start (point)))
-      (insert ?\n)
-      (cookie1 (min (- (length cookie-vector) 1) (or count 1)) cookie-vector)
-      (insert ?\n)
-      (fill-region-as-paragraph start (point) nil))))
-
-(defun cookie1 (arg cookie-vec)
-  "Inserts a cookie phrase ARG times."
-  (cond ((zerop arg) t)
-	(t (insert (aref cookie-vec arg))
-	   (insert " ")
-	   (cookie1 (1- arg) cookie-vec))))
-
-;;;###autoload
-(defun cookie-snarf (phrase-file startmsg endmsg)
-  "Reads in the PHRASE-FILE, returns it as a vector of strings.
-Emit STARTMSG and ENDMSG before and after.  Caches the result; second
-and subsequent calls on the same file won't go to disk."
-  (let ((sym (intern-soft phrase-file cookie-cache)))
-    (and sym (not (equal (symbol-function sym)
-			 (nth 5 (file-attributes phrase-file))))
-	 (yes-or-no-p (concat phrase-file
-			      " has changed.  Read new contents? "))
-	 (setq sym nil))
-    (if sym
-	(symbol-value sym)
-      (setq sym (intern phrase-file cookie-cache))
-      (message "%s" startmsg)
-      (save-excursion
-	(let ((buf (generate-new-buffer "*cookie*"))
-	      (result nil))
-	  (set-buffer buf)
-	  (fset sym (nth 5 (file-attributes phrase-file)))
-	  (insert-file-contents (expand-file-name phrase-file))
-	  (re-search-forward cookie-delimiter)
-	  (while (progn (skip-chars-forward " \t\n\r\f") (not (eobp)))
-	    (let ((beg (point)))
-	      (re-search-forward cookie-delimiter)
-	      (setq result (cons (buffer-substring beg (1- (point)))
-				 result))))
-	  (kill-buffer buf)
-	  (message "%s" endmsg)
-	  (set sym (apply 'vector result)))))))
-
-(defun read-cookie (prompt phrase-file startmsg endmsg &optional require-match)
-  "Prompt with PROMPT and read with completion among cookies in PHRASE-FILE.
-STARTMSG and ENDMSG are passed along to `cookie-snarf'.
-Optional fifth arg REQUIRE-MATCH non-nil forces a matching cookie."
-  ;; Make sure the cookies are in the cache.
-  (or (intern-soft phrase-file cookie-cache)
-      (cookie-snarf phrase-file startmsg endmsg))
-  (completing-read prompt
-		   (let ((sym (intern phrase-file cookie-cache)))
-		     ;; We cache the alist form of the cookie in a property.
-		     (or (get sym 'completion-alist)
-			 (let* ((alist nil)
-				(vec (cookie-snarf phrase-file
-						   startmsg endmsg))
-				(i (length vec)))
-			   (while (> (setq i (1- i)) 0)
-			     (setq alist (cons (list (aref vec i)) alist)))
-			   (put sym 'completion-alist alist))))
-		   nil require-match nil nil))
-
-; Thanks to Ian G Batten <BattenIG@CS.BHAM.AC.UK>
-; [of the University of Birmingham Computer Science Department]
-; for the iterative version of this shuffle.
-;
-;;;###autoload
-(defun shuffle-vector (vector)
-  "Randomly permute the elements of VECTOR (all permutations equally likely)"
-  (let ((i 0)
-	j
-	temp
-	(len (length vector)))
-    (while (< i len)
-      (setq j (+ i (random (- len i))))
-      (setq temp (aref vector i))
-      (aset vector i (aref vector j))
-      (aset vector j temp)
-      (setq i (1+ i))))
-  vector)
-
-(provide 'cookie1)
-
-;;; cookie1.el ends here
diff --git a/lisp/play/decipher.el b/lisp/play/decipher.el
deleted file mode 100644
index 3e487ff3232..00000000000
--- a/lisp/play/decipher.el
+++ /dev/null
@@ -1,1057 +0,0 @@
-;;; decipher.el --- Cryptanalyze monoalphabetic substitution ciphers
-;;
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-;;
-;; Author: Christopher J. Madsen <ac608@yfn.ysu.edu>
-;; Keywords: games
-;;
-;; 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.
-
-;;; Quick Start:
-;;
-;; To decipher a message, type or load it into a buffer and type
-;; `M-x decipher'.  This will format the buffer and place it into
-;; Decipher mode.  You can save your work to a file with the normal
-;; Emacs save commands; when you reload the file it will automatically
-;; enter Decipher mode.
-;;
-;; I'm not going to discuss how to go about breaking a cipher; try
-;; your local library for a book on cryptanalysis.  One book you might
-;; find is:
-;;   Cryptanalysis:  A study of ciphers and their solution
-;;   Helen Fouche Gaines
-;;   ISBN 0-486-20097-3
-
-;;; Commentary:
-;;
-;; This package is designed to help you crack simple substitution
-;; ciphers where one letter stands for another.  It works for ciphers
-;; with or without word divisions.  (You must set the variable
-;; decipher-ignore-spaces for ciphers without word divisions.)
-;;
-;; First, some quick definitions:
-;;   ciphertext   The encrypted message (what you start with)
-;;   plaintext    The decrypted message (what you are trying to get)
-;;
-;; Decipher mode displays ciphertext in uppercase and plaintext in
-;; lowercase.  You must enter the plaintext in lowercase; uppercase
-;; letters are interpreted as commands.  The ciphertext may be entered
-;; in mixed case; `M-x decipher' will convert it to uppercase.
-;;
-;; Decipher mode depends on special characters in the first column of
-;; each line.  The command `M-x decipher' inserts these characters for
-;; you.  The characters and their meanings are:
-;;   (   The plaintext & ciphertext alphabets on the first line
-;;   )   The ciphertext & plaintext alphabets on the second line
-;;   :   A line of ciphertext (with plaintext below)
-;;   >   A line of plaintext  (with ciphertext above)
-;;   %   A comment
-;; Each line in the buffer MUST begin with one of these characters (or
-;; be left blank).  In addition, comments beginning with `%!' are reserved
-;; for checkpoints; see decipher-make-checkpoint & decipher-restore-checkpoint
-;; for more information.
-;;
-;; While the cipher message may contain digits or punctuation, Decipher
-;; mode will ignore these characters.
-;;
-;; The buffer is made read-only so it can't be modified by normal
-;; Emacs commands.
-;;
-;; Decipher supports Font Lock mode.  To use it, you can also add
-;;     (add-hook 'decipher-mode-hook 'turn-on-font-lock)
-;; See the variable `decipher-font-lock-keywords' if you want to customize
-;; the faces used.  I'd like to thank Simon Marshall for his help in making
-;; Decipher work well with Font Lock.
-
-;;; Things To Do:
-;;
-;; Email me if you have any suggestions or would like to help.
-;; But be aware that I work on Decipher only sporadically.
-;;
-;; 1. The consonant-line shortcut
-;; 2. More functions for analyzing ciphertext
-
-;;;===================================================================
-;;; Variables:
-;;;===================================================================
-
-(eval-when-compile
-  (require 'cl))
-
-(defvar decipher-force-uppercase t
-  "*Non-nil means to convert ciphertext to uppercase.
-Nil means the case of the ciphertext is preserved.
-This variable must be set before typing `\\[decipher]'.")
-
-(defvar decipher-ignore-spaces nil
-  "*Non-nil means to ignore spaces and punctuation when counting digrams.
-You should set this to `nil' if the cipher message is divided into words,
-or `t' if it is not.
-This variable is buffer-local.")
-(make-variable-buffer-local 'decipher-ignore-spaces)
-
-(defvar decipher-undo-limit 5000
-  "The maximum number of entries in the undo list.
-When the undo list exceeds this number, 100 entries are deleted from
-the tail of the list.")
-
-;; End of user modifiable variables
-;;--------------------------------------------------------------------
-
-(defvar decipher-font-lock-keywords
-  '(("^:.*"  . font-lock-keyword-face)
-    ("^>.*"  . font-lock-string-face)
-    ("^%!.*" . font-lock-reference-face)
-    ("^%.*"  . font-lock-comment-face)
-    ("\\`(\\([a-z]+\\) +\\([A-Z]+\\)"
-     (1 font-lock-string-face)
-     (2 font-lock-keyword-face))
-    ("^)\\([A-Z ]+\\)\\([a-z ]+\\)"
-     (1 font-lock-keyword-face)
-     (2 font-lock-string-face)))
-  "Expressions to fontify in Decipher mode.
-
-Ciphertext uses `font-lock-keyword-face', plaintext uses
-`font-lock-string-face', comments use `font-lock-comment-face', and
-checkpoints use `font-lock-reference-face'.  You can customize the
-display by changing these variables.  For best results, I recommend
-that all faces use the same background color.
-
-For example, to display ciphertext in the `bold' face, use
-  (add-hook 'decipher-mode-hook
-            (lambda () (set (make-local-variable 'font-lock-keyword-face)
-                            'bold)))
-in your `.emacs' file.")
-
-(defvar decipher-mode-map nil
-  "Keymap for Decipher mode.")
-(if (not decipher-mode-map)
-    (progn
-      (setq decipher-mode-map (make-keymap))
-      (suppress-keymap decipher-mode-map)
-      (define-key decipher-mode-map "A" 'decipher-show-alphabet)
-      (define-key decipher-mode-map "C" 'decipher-complete-alphabet)
-      (define-key decipher-mode-map "D" 'decipher-digram-list)
-      (define-key decipher-mode-map "F" 'decipher-frequency-count)
-      (define-key decipher-mode-map "M" 'decipher-make-checkpoint)
-      (define-key decipher-mode-map "N" 'decipher-adjacency-list)
-      (define-key decipher-mode-map "R" 'decipher-restore-checkpoint)
-      (define-key decipher-mode-map "U" 'decipher-undo)
-      (define-key decipher-mode-map " " 'decipher-keypress)
-      (substitute-key-definition 'undo  'decipher-undo
-                                 decipher-mode-map global-map)
-      (substitute-key-definition 'advertised-undo  'decipher-undo
-                                 decipher-mode-map global-map)
-      (let ((key ?a))
-        (while (<= key ?z)
-          (define-key decipher-mode-map (vector key) 'decipher-keypress)
-          (incf key)))))
-
-(defvar decipher-stats-mode-map nil
-  "Keymap for Decipher-Stats mode.")
-(if (not decipher-stats-mode-map)
-    (progn
-      (setq decipher-stats-mode-map (make-keymap))
-      (suppress-keymap decipher-stats-mode-map)
-      (define-key decipher-stats-mode-map "D" 'decipher-digram-list)
-      (define-key decipher-stats-mode-map "F" 'decipher-frequency-count)
-      (define-key decipher-stats-mode-map "N" 'decipher-adjacency-list)
-      ))
-
-(defvar decipher-mode-syntax-table nil
-  "Decipher mode syntax table")
-
-(if decipher-mode-syntax-table
-    ()
-  (let ((table (make-syntax-table))
-        (c ?0))
-    (while (<= c ?9)
-      (modify-syntax-entry c "_" table) ;Digits are not part of words
-      (incf c))
-    (setq decipher-mode-syntax-table table)))
-
-(defvar decipher-alphabet nil)
-;; This is an alist containing entries (PLAIN-CHAR . CIPHER-CHAR),
-;; where PLAIN-CHAR runs from ?a to ?z and CIPHER-CHAR is an uppercase
-;; letter or space (which means no mapping is known for that letter).
-;; This *must* contain entries for all lowercase characters.
-(make-variable-buffer-local 'decipher-alphabet)
-
-(defvar decipher-stats-buffer nil
-  "The buffer which displays statistics for this ciphertext.
-Do not access this variable directly, use the function
-`decipher-stats-buffer' instead.")
-(make-variable-buffer-local 'decipher-stats-buffer)
-
-(defvar decipher-undo-list-size 0
-  "The number of entries in the undo list.")
-(make-variable-buffer-local 'decipher-undo-list-size)
-
-(defvar decipher-undo-list nil
-  "The undo list for this buffer.
-Each element is either a cons cell (PLAIN-CHAR . CIPHER-CHAR) or a
-list of such cons cells.")
-(make-variable-buffer-local 'decipher-undo-list)
-
-(defvar decipher-pending-undo-list nil)
-
-;; The following variables are used by the analysis functions
-;; and are defined here to avoid byte-compiler warnings.
-;; Don't mess with them unless you know what you're doing.
-(defvar decipher-char nil
-  "See the functions decipher-loop-with-breaks and decipher-loop-no-breaks.")
-(defvar decipher--prev-char)
-(defvar decipher--digram)
-(defvar decipher--digram-list)
-(defvar decipher--before)
-(defvar decipher--after)
-(defvar decipher--freqs)
-
-;;;===================================================================
-;;; Code:
-;;;===================================================================
-;; Main entry points:
-;;--------------------------------------------------------------------
-
-;;;###autoload
-(defun decipher ()
-  "Format a buffer of ciphertext for cryptanalysis and enter Decipher mode."
-  (interactive)
-  ;; Make sure the buffer ends in a newline:
-  (goto-char (point-max))
-  (or (bolp)
-      (insert "\n"))
-  ;; See if it's already in decipher format:
-  (goto-char (point-min))
-  (if (looking-at "^(abcdefghijklmnopqrstuvwxyz   \
-ABCDEFGHIJKLMNOPQRSTUVWXYZ   -\\*-decipher-\\*-\n)")
-      (message "Buffer is already formatted, entering Decipher mode...")
-    ;; Add the alphabet at the beginning of the file
-    (insert "(abcdefghijklmnopqrstuvwxyz   \
-ABCDEFGHIJKLMNOPQRSTUVWXYZ   -*-decipher-*-\n)\n\n")
-    ;; Add lines for the solution:
-    (let (begin)
-      (while (not (eobp))
-        (if (looking-at "^%")
-            (forward-line)              ;Leave comments alone
-          (delete-horizontal-space)
-          (if (eolp)
-              (forward-line)            ;Just leave blank lines alone
-            (insert ":")                ;Mark ciphertext line
-            (setq begin (point))
-            (forward-line)
-            (if decipher-force-uppercase
-                (upcase-region begin (point))) ;Convert ciphertext to uppercase
-            (insert ">\n")))))          ;Mark plaintext line
-    (delete-blank-lines)                ;Remove any blank lines
-    (delete-blank-lines))               ; at end of buffer
-  (goto-line 4)
-  (decipher-mode))
-
-;;;###autoload
-(defun decipher-mode ()
-  "Major mode for decrypting monoalphabetic substitution ciphers.
-Lower-case letters enter plaintext.
-Upper-case letters are commands.
-
-The buffer is made read-only so that normal Emacs commands cannot
-modify it.
-
-The most useful commands are:
-\\<decipher-mode-map>
-\\[decipher-digram-list]  Display a list of all digrams & their frequency
-\\[decipher-frequency-count]  Display the frequency of each ciphertext letter
-\\[decipher-adjacency-list]\
-  Show adjacency list for current letter (lists letters appearing next to it)
-\\[decipher-make-checkpoint]  Save the current cipher alphabet (checkpoint)
-\\[decipher-restore-checkpoint]  Restore a saved cipher alphabet (checkpoint)"
-  (interactive)
-  (kill-all-local-variables)
-  (setq buffer-undo-list  t             ;Disable undo
-        indent-tabs-mode  nil           ;Do not use tab characters
-        major-mode       'decipher-mode
-        mode-name        "Decipher")
-  (if decipher-force-uppercase
-      (setq case-fold-search nil))      ;Case is significant when searching
-  (use-local-map decipher-mode-map)
-  (set-syntax-table decipher-mode-syntax-table)
-  (decipher-read-alphabet)
-  (set (make-local-variable 'font-lock-defaults)
-       '(decipher-font-lock-keywords t))
-  ;; Make the buffer writable when we exit Decipher mode:
-  (make-local-hook 'change-major-mode-hook)
-  (add-hook 'change-major-mode-hook
-            (lambda () (setq buffer-read-only nil
-                             buffer-undo-list nil))
-            nil t)
-  (run-hooks 'decipher-mode-hook)
-  (setq buffer-read-only t))
-(put 'decipher-mode 'mode-class 'special)
-
-;;--------------------------------------------------------------------
-;; Normal key handling:
-;;--------------------------------------------------------------------
-
-(defmacro decipher-last-command-char ()
-  ;; Return the char which ran this command (for compatibility with XEmacs)
-  (if (fboundp 'event-to-character)
-      '(event-to-character last-command-event)
-    'last-command-event))
-
-(defun decipher-keypress ()
-  "Enter a plaintext or ciphertext character."
-  (interactive)
-  (let ((decipher-function 'decipher-set-map)
-        buffer-read-only)               ;Make buffer writable
-    (save-excursion
-      (or (save-excursion
-            (beginning-of-line)
-            (let ((first-char (following-char)))
-              (cond
-               ((= ?: first-char)
-                t)
-               ((= ?> first-char)
-                nil)
-               ((= ?\( first-char)
-                (setq decipher-function 'decipher-alphabet-keypress)
-                t)
-               ((= ?\) first-char)
-                (setq decipher-function 'decipher-alphabet-keypress)
-                nil)
-               (t
-                (error "Bad location")))))
-          (let (goal-column)
-            (previous-line 1)))
-      (let ((char-a (following-char))
-            (char-b (decipher-last-command-char)))
-        (or (and (not (= ?w (char-syntax char-a)))
-                 (= char-b ?\ )) ;Spacebar just advances on non-letters
-            (funcall decipher-function char-a char-b)))))
-  (forward-char))
-
-(defun decipher-alphabet-keypress (a b)
-  ;; Handle keypresses in the alphabet lines.
-  ;; A is the character in the alphabet row (which starts with '(')
-  ;; B is the character pressed
-  (cond ((and (>= a ?A) (<= a ?Z))
-         ;; If A is uppercase, then it is in the ciphertext alphabet:
-         (decipher-set-map a b))
-        ((and (>= a ?a) (<= a ?z))
-         ;; If A is lowercase, then it is in the plaintext alphabet:
-         (if (= b ?\ )
-             ;; We are clearing the association (if any):
-             (if (/= ?\  (setq b (cdr (assoc a decipher-alphabet))))
-                 (decipher-set-map b ?\ ))
-           ;; Associate the plaintext char with the char pressed:
-           (decipher-set-map b a)))
-        (t
-         ;; If A is not a letter, that's a problem:
-         (error "Bad character"))))
-
-;;--------------------------------------------------------------------
-;; Undo:
-;;--------------------------------------------------------------------
-
-(defun decipher-undo ()
-  "Undo a change in Decipher mode."
-  (interactive)
-  ;; If we don't get all the way thru, make last-command indicate that
-  ;; for the following command.
-  (setq this-command t)
-  (or (eq major-mode 'decipher-mode)
-      (error "This buffer is not in Decipher mode"))
-  (or (eq last-command 'decipher-undo)
-      (setq decipher-pending-undo-list decipher-undo-list))
-  (or decipher-pending-undo-list
-      (error "No further undo information"))
-  (let ((undo-rec (pop decipher-pending-undo-list))
-        buffer-read-only                ;Make buffer writable
-        redo-map redo-rec undo-map)
-    (or (consp (car undo-rec))
-        (setq undo-rec (list undo-rec)))
-    (while (setq undo-map (pop undo-rec))
-      (setq redo-map (decipher-get-undo (cdr undo-map) (car undo-map)))
-      (if redo-map
-          (setq redo-rec
-                (if (consp (car redo-map))
-                    (append redo-map redo-rec)
-                  (cons redo-map redo-rec))))
-      (decipher-set-map (cdr undo-map) (car undo-map) t))
-    (decipher-add-undo redo-rec))
-  (setq this-command 'decipher-undo)
-  (message "Undo!"))
-
-(defun decipher-add-undo (undo-rec)
-  "Add UNDO-REC to the undo list."
-  (if undo-rec
-      (progn
-        (push undo-rec decipher-undo-list)
-        (incf decipher-undo-list-size)
-        (if (> decipher-undo-list-size decipher-undo-limit)
-            (let ((new-size (- decipher-undo-limit 100)))
-              ;; Truncate undo list to NEW-SIZE elements:
-              (setcdr (nthcdr (1- new-size) decipher-undo-list) nil)
-              (setq decipher-undo-list-size new-size))))))
-
-(defun decipher-get-undo-copy (cons)
-  (if cons
-      (cons (car cons) (cdr cons))))
-
-(defun decipher-get-undo (cipher-char plain-char)
-  ;; Return an undo record that will undo the result of
-  ;;   (decipher-set-map CIPHER-CHAR PLAIN-CHAR)
-  ;; We must copy the cons cell because the original cons cells will be
-  ;; modified using setcdr.
-  (let ((cipher-map (decipher-get-undo-copy (rassoc cipher-char decipher-alphabet)))
-        (plain-map  (decipher-get-undo-copy (assoc  plain-char  decipher-alphabet))))
-    (cond ((equal ?\  plain-char)
-           cipher-map)
-          ((equal cipher-char (cdr plain-map))
-           nil)                         ;We aren't changing anything
-          ((equal ?\  (cdr plain-map))
-           (or cipher-map (cons ?\  cipher-char)))
-          (cipher-map
-           (list plain-map cipher-map))
-          (t
-           plain-map))))
-
-;;--------------------------------------------------------------------
-;; Mapping ciphertext and plaintext:
-;;--------------------------------------------------------------------
-
-(defun decipher-set-map (cipher-char plain-char &optional no-undo)
-  ;; Associate a ciphertext letter with a plaintext letter
-  ;; CIPHER-CHAR must be an uppercase or lowercase letter
-  ;; PLAIN-CHAR must be a lowercase letter (or a space)
-  ;; NO-UNDO if non-nil means do not record undo information
-  ;; Any existing associations for CIPHER-CHAR or PLAIN-CHAR will be erased.
-  (setq cipher-char (upcase cipher-char))
-  (or (and (>= cipher-char ?A) (<= cipher-char ?Z))
-      (error "Bad character"))          ;Cipher char must be uppercase letter
-  (or no-undo
-      (decipher-add-undo (decipher-get-undo cipher-char plain-char)))
-  (let ((cipher-string (char-to-string cipher-char))
-        (plain-string  (char-to-string plain-char))
-        case-fold-search                ;Case is significant
-        mapping bound)
-    (save-excursion
-      (goto-char (point-min))
-      (if (setq mapping (rassoc cipher-char decipher-alphabet))
-          (progn
-            (setcdr mapping ?\ )
-            (search-forward-regexp (concat "^([a-z]*"
-                                           (char-to-string (car mapping))))
-            (decipher-insert ?\ )
-            (beginning-of-line)))
-      (if (setq mapping (assoc plain-char decipher-alphabet))
-          (progn
-            (if (/= ?\  (cdr mapping))
-                (decipher-set-map (cdr mapping) ?\  t))
-            (setcdr mapping cipher-char)
-            (search-forward-regexp (concat "^([a-z]*" plain-string))
-            (decipher-insert cipher-char)
-            (beginning-of-line)))
-      (search-forward-regexp (concat "^([a-z]+   [A-Z]*" cipher-string))
-      (decipher-insert plain-char)
-      (setq case-fold-search t          ;Case is not significant
-            cipher-string    (downcase cipher-string))
-      (let ((font-lock-fontify-region-function 'ignore))
-        ;; insert-and-inherit will pick the right face automatically
-        (while (search-forward-regexp "^:" nil t)
-          (setq bound (save-excursion (end-of-line) (point)))
-          (while (search-forward cipher-string bound 'end)
-            (decipher-insert plain-char)))))))
-
-(defun decipher-insert (char)
-  ;; Insert CHAR in the row below point.  It replaces any existing
-  ;; character in that position.
-  (let ((col (1- (current-column))))
-    (save-excursion
-      (forward-line)
-      (or (= ?\> (following-char))
-          (= ?\) (following-char))
-          (error "Bad location"))
-      (move-to-column col t)
-      (or (eolp)
-          (delete-char 1))
-      (insert-and-inherit char))))
-
-;;--------------------------------------------------------------------
-;; Checkpoints:
-;;--------------------------------------------------------------------
-;; A checkpoint is a comment of the form:
-;;   %!ABCDEFGHIJKLMNOPQRSTUVWXYZ! Description
-;; Such comments are usually placed at the end of the buffer following
-;; this header (which is inserted by decipher-make-checkpoint):
-;;   %---------------------------
-;;   % Checkpoints:
-;;   % abcdefghijklmnopqrstuvwxyz
-;; but this is not required; checkpoints can be placed anywhere.
-;;
-;; The description is optional; all that is required is the alphabet.
-
-(defun decipher-make-checkpoint (desc)
-  "Checkpoint the current cipher alphabet.
-This records the current alphabet so you can return to it later.
-You may have any number of checkpoints.
-Type `\\[decipher-restore-checkpoint]' to restore a checkpoint."
-  (interactive "sCheckpoint description: ")
-  (or (stringp desc)
-      (setq desc ""))
-  (let (alphabet
-        buffer-read-only                ;Make buffer writable
-        mapping)
-    (goto-char (point-min))
-    (re-search-forward "^)")
-    (move-to-column 27 t)
-    (setq alphabet (buffer-substring-no-properties (- (point) 26) (point)))
-    (if (re-search-forward "^%![A-Z ]+!" nil 'end)
-       nil ; Add new checkpoint with others
-      (if (re-search-backward "^% *Local Variables:" nil t)
-          ;; Add checkpoints before local variables list:
-          (progn (forward-line -1)
-                 (or (looking-at "^ *$")
-                     (progn (forward-line) (insert ?\n) (forward-line -1)))))
-      (insert "\n%" (make-string 69 ?\-)
-              "\n% Checkpoints:\n% abcdefghijklmnopqrstuvwxyz\n"))
-    (beginning-of-line)
-    (insert "%!" alphabet "! " desc ?\n)))
-
-(defun decipher-restore-checkpoint ()
-  "Restore the cipher alphabet from a checkpoint.
-If point is not on a checkpoint line, moves to the first checkpoint line.
-If point is on a checkpoint, restores that checkpoint.
-
-Type `\\[decipher-make-checkpoint]' to make a checkpoint."
-  (interactive)
-  (beginning-of-line)
-  (if (looking-at "%!\\([A-Z ]+\\)!")
-      ;; Restore this checkpoint:
-      (let ((alphabet (match-string 1))
-            buffer-read-only)           ;Make buffer writable
-        (goto-char (point-min))
-        (re-search-forward "^)")
-        (or (eolp)
-            (delete-region (point) (progn (end-of-line) (point))))
-        (insert alphabet)
-        (decipher-resync))
-    ;; Move to the first checkpoint:
-    (goto-char (point-min))
-    (if (re-search-forward "^%![A-Z ]+!" nil t)
-        (message "Select the checkpoint to restore and type `%s'"
-                 (substitute-command-keys "\\[decipher-restore-checkpoint]"))
-      (error "No checkpoints in this buffer"))))
-
-;;--------------------------------------------------------------------
-;; Miscellaneous commands:
-;;--------------------------------------------------------------------
-
-(defun decipher-complete-alphabet ()
-  "Complete the cipher alphabet.
-This fills any blanks in the cipher alphabet with the unused letters
-in alphabetical order.  Use this when you have a keyword cipher and
-you have determined the keyword."
-  (interactive)
-  (let ((cipher-char ?A)
-        (ptr decipher-alphabet)
-        buffer-read-only                ;Make buffer writable
-        plain-map undo-rec)
-    (while (setq plain-map (pop ptr))
-      (if (equal ?\  (cdr plain-map))
-          (progn
-            (while (rassoc cipher-char decipher-alphabet)
-              ;; Find the next unused letter
-              (incf cipher-char))
-            (push (cons ?\  cipher-char) undo-rec)
-            (decipher-set-map cipher-char (car plain-map) t))))
-    (decipher-add-undo undo-rec)))
-
-(defun decipher-show-alphabet ()
-  "Display the current cipher alphabet in the message line."
-  (interactive)
-  (message
-   (mapconcat (lambda (a)
-                (concat
-                 (char-to-string (car a))
-                 (char-to-string (cdr a))))
-              decipher-alphabet
-              "")))
-
-(defun decipher-resync ()
-  "Reprocess the buffer using the alphabet from the top.
-This regenerates all deciphered plaintext and clears the undo list.
-You should use this if you edit the ciphertext."
-  (interactive)
-  (message "Reprocessing buffer...")
-  (let (alphabet
-        buffer-read-only                ;Make buffer writable
-        mapping)
-    (save-excursion
-      (decipher-read-alphabet)
-      (setq alphabet decipher-alphabet)
-      (goto-char (point-min))
-      (and (re-search-forward "^).+" nil t)
-           (replace-match ")" nil nil))
-      (while (re-search-forward "^>.+" nil t)
-        (replace-match ">" nil nil))
-      (decipher-read-alphabet)
-      (while (setq mapping (pop alphabet))
-        (or (equal ?\  (cdr mapping))
-            (decipher-set-map (cdr mapping) (car mapping))))))
-  (setq decipher-undo-list       nil
-        decipher-undo-list-size  0)
-  (message "Reprocessing buffer...done"))
-
-;;--------------------------------------------------------------------
-;; Miscellaneous functions:
-;;--------------------------------------------------------------------
-
-(defun decipher-read-alphabet ()
-  "Build the decipher-alphabet from the alphabet line in the buffer."
-  (save-excursion
-    (goto-char (point-min))
-    (search-forward-regexp "^)")
-    (move-to-column 27 t)
-    (setq decipher-alphabet nil)
-    (let ((plain-char ?z))
-      (while (>= plain-char ?a)
-        (backward-char)
-        (push (cons plain-char (following-char)) decipher-alphabet)
-        (decf plain-char)))))
-
-;;;===================================================================
-;;; Analyzing ciphertext:
-;;;===================================================================
-
-(defun decipher-frequency-count ()
-  "Display the frequency count in the statistics buffer."
-  (interactive)
-  (decipher-analyze)
-  (decipher-display-regexp "^A" "^[A-Z][A-Z]"))
-
-(defun decipher-digram-list ()
-  "Display the list of digrams in the statistics buffer."
-  (interactive)
-  (decipher-analyze)
-  (decipher-display-regexp "[A-Z][A-Z] +[0-9]" "^$"))
-
-(defun decipher-adjacency-list (cipher-char)
-  "Display the adjacency list for the letter at point.
-The adjacency list shows all letters which come next to CIPHER-CHAR.
-
-An adjacency list (for the letter X) looks like this:
-       1 1         1     1   1       3 2 1             3   8
-X: A B C D E F G H I J K L M N O P Q R S T U V W X Y Z *  11   14   9%
-     1 1                 1       2   1   1     2       5   7
-This says that X comes before D once, and after B once.  X begins 5
-words, and ends 3 words (`*' represents a space).  X comes before 8
-different letters, after 7 differerent letters, and is next to a total
-of 11 different letters.  It occurs 14 times, making up 9% of the
-ciphertext."
-  (interactive (list (upcase (following-char))))
-  (decipher-analyze)
-  (let (start end)
-    (save-excursion
-      (set-buffer (decipher-stats-buffer))
-      (goto-char (point-min))
-      (or (re-search-forward (format "^%c: " cipher-char) nil t)
-          (error "Character `%c' is not used in ciphertext." cipher-char))
-      (forward-line -1)
-      (setq start (point))
-      (forward-line 3)
-      (setq end (point)))
-    (decipher-display-range start end)))
-
-;;--------------------------------------------------------------------
-(defun decipher-analyze ()
-  "Perform frequency analysis on the current buffer if necessary."
-  (cond
-   ;; If this is the statistics buffer, do nothing:
-   ((eq major-mode 'decipher-stats-mode))
-   ;; If this is the Decipher buffer, see if the stats buffer exists:
-   ((eq major-mode 'decipher-mode)
-    (or (and (bufferp decipher-stats-buffer)
-             (buffer-name decipher-stats-buffer))
-        (decipher-analyze-buffer)))
-   ;; Otherwise:
-   (t (error "This buffer is not in Decipher mode"))))
-
-;;--------------------------------------------------------------------
-(defun decipher-display-range (start end)
-  "Display text between START and END in the statistics buffer.
-START and END are positions in the statistics buffer.  Makes the
-statistics buffer visible and sizes the window to just fit the
-displayed text, but leaves the current window selected."
-  (let ((stats-buffer (decipher-stats-buffer))
-        (current-window (selected-window))
-        (pop-up-windows t))
-    (or (eq (current-buffer) stats-buffer)
-        (pop-to-buffer stats-buffer))
-    (goto-char start)
-    (or (one-window-p t)
-        (enlarge-window (- (1+ (count-lines start end)) (window-height))))
-    (recenter 0)
-    (select-window current-window)))
-
-(defun decipher-display-regexp (start-regexp end-regexp)
-  "Display text between two regexps in the statistics buffer.
-
-START-REGEXP matches the first line to display.
-END-REGEXP matches the line after that which ends the display.
-The ending line is included in the display unless it is blank."
-  (let (start end)
-    (save-excursion
-      (set-buffer (decipher-stats-buffer))
-      (goto-char (point-min))
-      (re-search-forward start-regexp)
-      (beginning-of-line)
-      (setq start (point))
-      (re-search-forward end-regexp)
-      (beginning-of-line)
-      (or (looking-at "^ *$")
-          (forward-line 1))
-      (setq end (point)))
-    (decipher-display-range start end)))
-
-;;--------------------------------------------------------------------
-(defun decipher-loop-with-breaks (func)
-  "Loop through ciphertext, calling FUNC once for each letter & word division.
-
-FUNC is called with no arguments, and its return value is unimportant.
-It may examine `decipher-char' to see the current ciphertext
-character.  `decipher-char' contains either an uppercase letter or a space.
-
-FUNC is called exactly once between words, with `decipher-char' set to
-a space.
-
-See `decipher-loop-no-breaks' if you do not care about word divisions."
-  (let ((decipher-char ?\ )
-        (decipher--loop-prev-char ?\ ))
-    (save-excursion
-      (goto-char (point-min))
-      (funcall func)              ;Space marks beginning of first word
-      (while (search-forward-regexp "^:" nil t)
-        (while (not (eolp))
-          (setq decipher-char (upcase (following-char)))
-          (or (and (>= decipher-char ?A) (<= decipher-char ?Z))
-              (setq decipher-char ?\ ))
-          (or (and (equal decipher-char ?\ )
-                   (equal decipher--loop-prev-char ?\ ))
-              (funcall func))
-          (setq decipher--loop-prev-char decipher-char)
-          (forward-char))
-        (or (equal decipher-char ?\ )
-            (progn
-              (setq decipher-char ?\ ;
-                    decipher--loop-prev-char ?\ )
-              (funcall func)))))))
-
-(defun decipher-loop-no-breaks (func)
-  "Loop through ciphertext, calling FUNC once for each letter.
-
-FUNC is called with no arguments, and its return value is unimportant.
-It may examine `decipher-char' to see the current ciphertext letter.
-`decipher-char' contains an uppercase letter.
-
-Punctuation and spacing in the ciphertext are ignored.
-See `decipher-loop-with-breaks' if you care about word divisions."
-  (let (decipher-char)
-    (save-excursion
-      (goto-char (point-min))
-      (while (search-forward-regexp "^:" nil t)
-        (while (not (eolp))
-          (setq decipher-char (upcase (following-char)))
-          (and (>= decipher-char ?A)
-               (<= decipher-char ?Z)
-               (funcall func))
-          (forward-char))))))
-
-;;--------------------------------------------------------------------
-;; Perform the analysis:
-;;--------------------------------------------------------------------
-
-(defun decipher-insert-frequency-counts (freq-list total)
-  "Insert frequency counts in current buffer.
-Each element of FREQ-LIST is a list (LETTER FREQ ...).
-TOTAL is the total number of letters in the ciphertext."
-  (let ((i 4) temp-list)
-    (while (> i 0)
-      (setq temp-list freq-list)
-      (while temp-list
-        (insert (caar temp-list)
-                (format "%4d%3d%%  "
-                        (cadar temp-list)
-                        (/ (* 100 (cadar temp-list)) total)))
-        (setq temp-list (nthcdr 4 temp-list)))
-      (insert ?\n)
-      (setq freq-list (cdr freq-list)
-            i         (1- i)))))
-
-(defun decipher--analyze ()
-  ;; Perform frequency analysis on ciphertext.
-  ;;
-  ;; This function is called repeatedly with decipher-char set to each
-  ;; character of ciphertext.  It uses decipher--prev-char to remember
-  ;; the previous ciphertext character.
-  ;;
-  ;; It builds several data structures, which must be initialized
-  ;; before the first call to decipher--analyze.  The arrays are
-  ;; indexed with A = 0, B = 1, ..., Z = 25, SPC = 26 (if used).
-  ;;   decipher--after: (initialize to zeros)
-  ;;     A vector of 26 vectors of 27 integers.  The first vector
-  ;;     represents the number of times A follows each character, the
-  ;;     second vector represents B, and so on.
-  ;;   decipher--before: (initialize to zeros)
-  ;;     The same as decipher--after, but representing the number of
-  ;;     times the character precedes each other character.
-  ;;   decipher--digram-list: (initialize to nil)
-  ;;     An alist with an entry for each digram (2-character sequence)
-  ;;     encountered.  Each element is a cons cell (DIGRAM . FREQ),
-  ;;     where DIGRAM is a 2 character string and FREQ is the number
-  ;;     of times it occurs.
-  ;;   decipher--freqs: (initialize to zeros)
-  ;;     A vector of 26 integers, counting the number of occurrences
-  ;;     of the corresponding characters.
-  (setq decipher--digram (format "%c%c" decipher--prev-char decipher-char))
-  (incf (cdr (or (assoc decipher--digram decipher--digram-list)
-                 (car (push (cons decipher--digram 0)
-                            decipher--digram-list)))))
-  (and (>= decipher--prev-char ?A)
-       (incf (aref (aref decipher--before (- decipher--prev-char ?A))
-                   (if (equal decipher-char ?\ )
-                       26
-                     (- decipher-char ?A)))))
-  (and (>= decipher-char ?A)
-       (incf (aref decipher--freqs (- decipher-char ?A)))
-       (incf (aref (aref decipher--after (- decipher-char ?A))
-                   (if (equal decipher--prev-char ?\ )
-                       26
-                     (- decipher--prev-char ?A)))))
-  (setq decipher--prev-char decipher-char))
-
-(defun decipher--digram-counts (counts)
-  "Generate the counts for an adjacency list."
-  (let ((total 0))
-    (concat
-     (mapconcat (lambda (x)
-                  (cond ((> x 99) (incf total) "XX")
-                        ((> x 0)  (incf total) (format "%2d" x))
-                        (t        "  ")))
-                counts
-                "")
-     (format "%4d" (if (> (aref counts 26) 0)
-                       (1- total)    ;Don't count space
-                     total)))))
-
-(defun decipher--digram-total (before-count after-count)
-  "Count the number of different letters a letter appears next to."
-  ;; We do not include spaces (word divisions) in this count.
-  (let ((total 0)
-        (i 26))
-    (while (>= (decf i) 0)
-      (if (or (> (aref before-count i) 0)
-              (> (aref after-count  i) 0))
-          (incf total)))
-    total))
-
-(defun decipher-analyze-buffer ()
-  "Perform frequency analysis and store results in statistics buffer.
-Creates the statistics buffer if it doesn't exist."
-  (let ((decipher--prev-char (if decipher-ignore-spaces ?\  ?\*))
-        (decipher--before (make-vector 26 nil))
-        (decipher--after  (make-vector 26 nil))
-        (decipher--freqs   (make-vector 26 0))
-        (total-chars  0)
-        decipher--digram decipher--digram-list freq-list)
-    (message "Scanning buffer...")
-    (let ((i 26))
-      (while (>= (decf i) 0)
-        (aset decipher--before i (make-vector 27 0))
-        (aset decipher--after  i (make-vector 27 0))))
-    (if decipher-ignore-spaces
-        (progn
-          (decipher-loop-no-breaks 'decipher--analyze)
-          ;; The first character of ciphertext was marked as following a space:
-          (let ((i 26))
-            (while (>= (decf i) 0)
-              (aset (aref decipher--after  i) 26 0))))
-      (decipher-loop-with-breaks 'decipher--analyze))
-    (message "Processing results...")
-    (setcdr (last decipher--digram-list 2) nil)   ;Delete the phony "* " digram
-    ;; Sort the digram list by frequency and alphabetical order:
-    (setq decipher--digram-list (sort (sort decipher--digram-list
-                                  (lambda (a b) (string< (car a) (car b))))
-                            (lambda (a b) (> (cdr a) (cdr b)))))
-    ;; Generate the frequency list:
-    ;;   Each element is a list of 3 elements (LETTER FREQ DIFFERENT),
-    ;;   where LETTER is the ciphertext character, FREQ is the number
-    ;;   of times it occurs, and DIFFERENT is the number of different
-    ;;   letters it appears next to.
-    (let ((i 26))
-      (while (>= (decf i) 0)
-        (setq freq-list
-              (cons (list (+ i ?A)
-                          (aref decipher--freqs i)
-                          (decipher--digram-total (aref decipher--before i)
-                                                  (aref decipher--after  i)))
-                    freq-list)
-              total-chars (+ total-chars (aref decipher--freqs i)))))
-    (save-excursion
-      ;; Switch to statistics buffer, creating it if necessary:
-      (set-buffer (decipher-stats-buffer t))
-      ;; This can't happen, but it never hurts to double-check:
-      (or (eq major-mode 'decipher-stats-mode)
-          (error "Buffer %s is not in Decipher-Stats mode" (buffer-name)))
-      (setq buffer-read-only nil)
-      (erase-buffer)
-      ;; Display frequency counts for letters A-Z:
-      (decipher-insert-frequency-counts freq-list total-chars)
-      (insert ?\n)
-      ;; Display frequency counts for letters in order of frequency:
-      (setq freq-list (sort freq-list
-                            (lambda (a b) (> (second a) (second b)))))
-      (decipher-insert-frequency-counts freq-list total-chars)
-      ;; Display letters in order of frequency:
-      (insert ?\n (mapconcat (lambda (a) (char-to-string (car a)))
-                             freq-list nil)
-              "\n\n")
-      ;; Display list of digrams in order of frequency:
-      (let* ((rows (floor (+ (length decipher--digram-list) 9) 10))
-             (i rows)
-             temp-list)
-        (while (> i 0)
-          (setq temp-list decipher--digram-list)
-          (while temp-list
-            (insert (caar temp-list)
-                    (format "%3d   "
-                            (cdar temp-list)))
-            (setq temp-list (nthcdr rows temp-list)))
-          (delete-horizontal-space)
-          (insert ?\n)
-          (setq decipher--digram-list (cdr decipher--digram-list)
-                i           (1- i))))
-      ;; Display adjacency list for each letter, sorted in descending
-      ;; order of the number of adjacent letters:
-      (setq freq-list (sort freq-list
-                            (lambda (a b) (> (third a) (third b)))))
-      (let ((temp-list freq-list)
-            entry i)
-        (while (setq entry (pop temp-list))
-          (if (equal 0 (second entry))
-              nil                       ;This letter was not used
-            (setq i (- (car entry) ?A))
-            (insert ?\n "  "
-                    (decipher--digram-counts (aref decipher--before i)) ?\n
-                    (car entry)
-                    ": A B C D E F G H I J K L M N O P Q R S T U V W X Y Z *"
-                    (format "%4d %4d %3d%%\n  "
-                            (third entry) (second entry)
-                            (/ (* 100 (second entry)) total-chars))
-                    (decipher--digram-counts (aref decipher--after  i)) ?\n))))
-      (setq buffer-read-only t)
-      (set-buffer-modified-p nil)
-      ))
-  (message nil))
-
-;;====================================================================
-;; Statistics Buffer:
-;;====================================================================
-
-(defun decipher-stats-mode ()
-  "Major mode for displaying ciphertext statistics."
-  (interactive)
-  (kill-all-local-variables)
-  (setq buffer-read-only  t
-        buffer-undo-list  t             ;Disable undo
-        case-fold-search  nil           ;Case is significant when searching
-        indent-tabs-mode  nil           ;Do not use tab characters
-        major-mode       'decipher-stats-mode
-        mode-name        "Decipher-Stats")
-  (use-local-map decipher-stats-mode-map)
-  (run-hooks 'decipher-stats-mode-hook))
-(put 'decipher-stats-mode 'mode-class 'special)
-
-;;--------------------------------------------------------------------
-
-(defun decipher-display-stats-buffer ()
-  "Make the statistics buffer visible, but do not select it."
-  (let ((stats-buffer (decipher-stats-buffer))
-        (current-window (selected-window)))
-    (or (eq (current-buffer) stats-buffer)
-        (progn
-          (pop-to-buffer stats-buffer)
-          (select-window current-window)))))
-
-(defun decipher-stats-buffer (&optional create)
-  "Return the buffer used for decipher statistics.
-If CREATE is non-nil, create the buffer if it doesn't exist.
-This is guaranteed to return a buffer in Decipher-Stats mode;
-if it can't, it signals an error."
-  (cond
-   ;; We may already be in the statistics buffer:
-   ((eq major-mode 'decipher-stats-mode)
-    (current-buffer))
-   ;; See if decipher-stats-buffer exists:
-   ((and (bufferp decipher-stats-buffer)
-         (buffer-name decipher-stats-buffer))
-    (or (save-excursion
-          (set-buffer decipher-stats-buffer)
-          (eq major-mode 'decipher-stats-mode))
-        (error "Buffer %s is not in Decipher-Stats mode"
-               (buffer-name decipher-stats-buffer)))
-    decipher-stats-buffer)
-   ;; Create a new buffer if requested:
-   (create
-    (let ((stats-name (concat "*" (buffer-name) "*")))
-      (setq decipher-stats-buffer
-            (if (eq 'decipher-stats-mode
-                    (cdr-safe (assoc 'major-mode
-                                     (buffer-local-variables
-                                      (get-buffer stats-name)))))
-                ;; We just lost track of the statistics buffer:
-                (get-buffer stats-name)
-              (generate-new-buffer stats-name))))
-    (save-excursion
-      (set-buffer decipher-stats-buffer)
-      (decipher-stats-mode))
-    decipher-stats-buffer)
-   ;; Give up:
-   (t (error "No statistics buffer"))))
-
-;;====================================================================
-
-(provide 'decipher)
-
-;;;(defun decipher-show-undo-list ()
-;;;  "Display the undo list (for debugging purposes)."
-;;;  (interactive)
-;;;  (with-output-to-temp-buffer "*Decipher Undo*"
-;;;    (let ((undo-list decipher-undo-list)
-;;;          undo-rec undo-map)
-;;;      (save-excursion
-;;;        (set-buffer "*Decipher Undo*")
-;;;        (while (setq undo-rec (pop undo-list))
-;;;          (or (consp (car undo-rec))
-;;;              (setq undo-rec (list undo-rec)))
-;;;          (insert ?\()
-;;;          (while (setq undo-map (pop undo-rec))
-;;;            (insert (cdr undo-map) (car undo-map) ?\ ))
-;;;          (delete-backward-char 1)
-;;;          (insert ")\n"))))))
-
-;;; decipher.el ends here
diff --git a/lisp/play/dissociate.el b/lisp/play/dissociate.el
deleted file mode 100644
index 93a9f9e79ab..00000000000
--- a/lisp/play/dissociate.el
+++ /dev/null
@@ -1,101 +0,0 @@
-;;; dissociate.el --- scramble text amusingly for Emacs.
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: games
-
-;; 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:
-
-;; The single entry point, `dissociated-press', applies a travesty
-;; generator to the current buffer.  The results can be quite amusing.
-
-;;; Code:
-
-;;;###autoload
-(defun dissociated-press (&optional arg)
-  "Dissociate the text of the current buffer.
-Output goes in buffer named *Dissociation*,
-which is redisplayed each time text is added to it.
-Every so often the user must say whether to continue.
-If ARG is positive, require ARG chars of continuity.
-If ARG is negative, require -ARG words of continuity.
-Default is 2."
-  (interactive "P")
-  (setq arg (if arg (prefix-numeric-value arg) 2))
-  (let* ((inbuf (current-buffer))
-	 (outbuf (get-buffer-create "*Dissociation*"))
-	 (move-function (if (> arg 0) 'forward-char 'forward-word))
-	 (move-amount (if (> arg 0) arg (- arg)))
-	 (search-function (if (> arg 0) 'search-forward 'word-search-forward))
-	 (last-query-point 0))
-    (if (= (point-max) (point-min))
-	(error "The buffer contains no text to start from"))
-    (switch-to-buffer outbuf)
-    (erase-buffer)
-    (while
-      (save-excursion
-	(goto-char last-query-point)
-	(vertical-motion (- (window-height) 4))
-	(or (= (point) (point-max))
-	    (and (progn (goto-char (point-max))
-			(y-or-n-p "Continue dissociation? "))
-		 (progn
-		   (message "")
-		   (recenter 1)
-		   (setq last-query-point (point-max))
-		   t))))
-      (let (start end)
-	(save-excursion
-	 (set-buffer inbuf)
-	 (setq start (point))
-	 (if (eq move-function 'forward-char)
-	     (progn
-	       (setq end (+ start (+ move-amount (random 16))))
-	       (if (> end (point-max))
-		   (setq end (+ 1 move-amount (random 16))))
-	       (goto-char end))
-	   (funcall move-function
-		    (+ move-amount (random 16))))
-	 (setq end (point)))
-	(let ((opoint (point)))
-	  (insert-buffer-substring inbuf start end)
-	  (save-excursion
-	   (goto-char opoint)
-	   (end-of-line)
-	   (and (> (current-column) fill-column)
-		(do-auto-fill)))))
-      (save-excursion
-       (set-buffer inbuf)
-       (if (eobp)
-	   (goto-char (point-min))
-	 (let ((overlap
-		(buffer-substring (prog1 (point)
-					 (funcall move-function
-						  (- move-amount)))
-				  (point))))
-	   (goto-char (1+ (random (1- (point-max)))))
-	   (or (funcall search-function overlap nil t)
-	       (let ((opoint (point)))
-		 (goto-char 1)
-		 (funcall search-function overlap opoint t))))))
-      (sit-for 0))))
-
-;;; dissociate.el ends here
diff --git a/lisp/play/doctor.el b/lisp/play/doctor.el
deleted file mode 100644
index faba5e1cf26..00000000000
--- a/lisp/play/doctor.el
+++ /dev/null
@@ -1,1614 +0,0 @@
-;;; doctor.el --- psychological help for frustrated users.
-;;; (censored version--see below)
-
-;; Copyright (C) 1985, 1987, 1994, 1996 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: games
-
-;; 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:
-
-;; The single entry point `doctor', simulates a Rogerian analyst using
-;; phrase-production techniques similar to the classic ELIZA demonstration
-;; of pseudo-AI.
-
-;; This file has been censored by the Communications Decency Act.
-;; Some of its features were removed.  The law was promoted as a ban
-;; on pornography, but it bans far more than that.  The doctor program
-;; did not contain pornography, but part of it was prohibited
-;; nonetheless.
-
-;; For information on US government censorship of the Internet, and
-;; what you can do to bring back freedom of the press, see the web
-;; site http://www.vtw.org/
-
-;;; Code:
-
-(defun doctor-cadr (x) (car (cdr x)))
-(defun doctor-caddr (x) (car (cdr (cdr x))))
-(defun doctor-cddr (x) (cdr (cdr x)))
-
-(defun // (x) x)
-
-(defmacro $ (what)
-  "quoted arg form of doctor-$"
-  (list 'doctor-$ (list 'quote what)))
-
-(defun doctor-$ (what)
-  "Return the car of a list, rotating the list each time"
-  (let* ((vv (symbol-value what))
-	(first (car vv))
-	(ww (append (cdr vv) (list first))))
-    (set what ww)
-    first))
-
-(defvar doctor-mode-map nil)
-(if doctor-mode-map
-    nil
-  (setq doctor-mode-map (make-sparse-keymap))
-  (define-key doctor-mode-map "\n" 'doctor-read-print)
-  (define-key doctor-mode-map "\r" 'doctor-ret-or-read))
-
-(defun doctor-mode ()
-  "Major mode for running the Doctor (Eliza) program.
-Like Text mode with Auto Fill mode
-except that RET when point is after a newline, or LFD at any time,
-reads the sentence before point, and prints the Doctor's answer."
-  (interactive)
-  (text-mode)
-  (make-doctor-variables)
-  (use-local-map doctor-mode-map)
-  (setq major-mode 'doctor-mode)
-  (setq mode-name "Doctor")
-  (turn-on-auto-fill)
-  (doctor-type '(i am the psychotherapist \.
-		 for your protection, i have been censored according to
-		 the Communications Decency Act \.
-		 ($ please) ($ describe) your ($ problems) \.
-		 each time you are finished talking, type \R\E\T twice \.))
-  (insert "\n"))
-
-(defun make-doctor-variables ()
-  (make-local-variable 'typos)
-  (setq typos
-	(mapcar (function (lambda (x)
-			    (put (car x) 'doctor-correction  (doctor-cadr x))
-			    (put (doctor-cadr x) 'doctor-expansion (doctor-caddr x))
-			    (car x)))
-		'((theyll they\'ll (they will))
-		  (theyre they\'re (they are))
-		  (hes he\'s (he is))
-		  (he7s he\'s (he is))
-		  (im i\'m (you are))
-		  (i7m i\'m (you are))
-		  (isa is\ a (is a))
-		  (thier their (their))
-		  (dont don\'t (do not))
-		  (don7t don\'t (do not))
-		  (you7re you\'re (i am))
-		  (you7ve you\'ve (i have))
-		  (you7ll you\'ll (i will)))))
-  (make-local-variable 'found)
-  (setq found nil)
-  (make-local-variable 'owner)
-  (setq owner nil)
-  (make-local-variable 'history)
-  (setq history nil)
-  (make-local-variable '*debug*)
-  (setq *debug* nil)
-  (make-local-variable 'inter)
-  (setq inter
-	'((well\,)
-	  (hmmm \.\.\.\ so\,)
-	  (so)
-	  (\.\.\.and)
-	  (then)))
-  (make-local-variable 'continue)
-  (setq continue
-	'((continue)
-	  (proceed)
-	  (go on)
-	  (keep going) ))
-  (make-local-variable 'relation)
-  (setq relation
-	'((your relationship with)
-	  (something you remember about)
-	  (your feelings toward)
-	  (some experiences you have had with)
-	  (how you feel about)))
-  (make-local-variable 'fears)
-  (setq fears '( (($ whysay) you are ($ afraidof) (// feared) \?)
-		 (you seem terrified by (// feared) \.)
-		 (when did you first feel ($ afraidof) (// feared) \?) ))
-  (make-local-variable 'sure)
-  (setq sure '((sure)(positive)(certain)(absolutely sure)))
-  (make-local-variable 'afraidof)
-  (setq afraidof '( (afraid of) (frightened by) (scared of) ))
-  (make-local-variable 'areyou)
-  (setq areyou '( (are you)(have you been)(have you been) ))
-  (make-local-variable 'isrelated)
-  (setq isrelated '( (has something to do with)(is related to)
-		     (could be the reason for) (is caused by)(is because of)))
-  (make-local-variable 'arerelated)
-  (setq arerelated '((have something to do with)(are related to)
-		     (could have caused)(could be the reason for) (are caused by)
-		     (are because of)))
-  (make-local-variable 'moods)
-  (setq moods '( (($ areyou)(// found) often \?)
-		 (what causes you to be (// found) \?)
-		 (($ whysay) you are (// found) \?) ))
-  (make-local-variable 'maybe)
-  (setq maybe
-	'((maybe)
-	  (perhaps)
-	  (possibly)))
-  (make-local-variable 'whatwhen)
-  (setq whatwhen
-	'((what happened when)
-	  (what would happen if)))
-  (make-local-variable 'hello)
-  (setq hello
-	'((how do you do \?) (hello \.) (howdy!) (hello \.) (hi \.) (hi there \.)))
-  (make-local-variable 'drnk)
-  (setq drnk
-	'((do you drink a lot of (// found) \?)
-	  (do you get drunk often \?)
-	  (($ describe) your drinking habits \.) )) 
-  (make-local-variable 'drugs)
-  (setq drugs '( (do you use (// found) often \?)(($ areyou)
-						 addicted to (// found) \?)(do you realize that drugs can
-						 be very harmful \?)(($ maybe) you should try to quit using (// found)
-						 \.)))
-  (make-local-variable 'whywant)
-  (setq whywant '( (($ whysay) (// subj) might ($ want) (// obj) \?)
-		   (how does it feel to want \?)
-		   (why should (// subj) get (// obj) \?)
-		   (when did (// subj) first ($ want) (// obj) \?)
-		   (($ areyou) obsessed with (// obj) \?)
-		   (why should i give (// obj) to (// subj) \?)
-		   (have you ever gotten (// obj) \?) ))
-  (make-local-variable 'canyou)
-  (setq canyou '((of course i can \.)
-		 (why should i \?)
-		 (what makes you think i would even want to \?)
-		 (i am the doctor\, i can do anything i damn please \.)
-		 (not really\, it\'s not up to me \.)
-		 (depends\, how important is it \?)
-		 (i could\, but i don\'t think it would be a wise thing to do \.)
-		 (can you \?)
-		 (maybe i can\, maybe i can\'t \.\.\.)
-		 (i don\'t think i should do that \.)))
-  (make-local-variable 'want)
-  (setq want '( (want) (desire) (wish) (want) (hope) ))
-  (make-local-variable 'shortlst)
-  (setq shortlst
-	'((can you elaborate on that \?)
-	  (($ please) continue \.)
-	  (go on\, don\'t be afraid \.)
-	  (i need a little more detail please \.)
-	  (you\'re being a bit brief\, ($ please) go into detail \.)
-	  (can you be more explicit \?)
-	  (and \?)
-	  (($ please) go into more detail \?)
-	  (you aren\'t being very talkative today\!)
-	  (is that all there is to it \?)
-	  (why must you respond so briefly \?)))
-
-  (make-local-variable 'famlst)
-  (setq famlst
-	'((tell me ($ something) about (// owner) family \.)
-	  (you seem to dwell on (// owner) family \.)
-	  (($ areyou) hung up on (// owner) family \?)))
-  (make-local-variable 'huhlst)
-  (setq huhlst
-	'((($ whysay)(// sent) \?)
-	  (is it because of ($ things) that you say (// sent) \?) ))
-  (make-local-variable 'longhuhlst)
-  (setq longhuhlst
-	'((($ whysay) that \?)
-	  (i don\'t understand \.)
-	  (($ thlst))
-	  (($ areyou) ($ afraidof) that \?)))
-  (make-local-variable 'feelings-about)
-  (setq feelings-about
-	'((feelings about)
-	  (apprehensions toward)
-	  (thoughts on)
-	  (emotions toward)))
-  (make-local-variable 'random-adjective)
-  (setq random-adjective
-	'((vivid)
-	  (emotionally stimulating)
-	  (exciting)
-	  (boring)
-	  (interesting)
-	  (recent)
-	  (random)   ;How can we omit this?
-	  (unusual)
-	  (shocking)
-	  (embarrassing)))
-  (make-local-variable 'whysay)
-  (setq whysay
-	'((why do you say)
-	  (what makes you believe)
-	  (are you sure that)
-	  (do you really think)
-	  (what makes you think) ))
-  (make-local-variable 'isee)
-  (setq isee
-	'((i see \.\.\.)
-	  (yes\,)
-	  (i understand \.)
-	  (oh \.) ))
-  (make-local-variable 'please)
-  (setq please 
-	'((please\,)
-	  (i would appreciate it if you would)
-	  (perhaps you could)
-	  (please\,)
-	  (would you please)
-	  (why don\'t you)
-	  (could you)))
-  (make-local-variable 'bye)
-  (setq bye
-	'((my secretary will send you a bill \.)
-	  (bye bye \.)
-	  (see ya \.)
-	  (ok\, talk to you some other time \.)
-	  (talk to you later \.)
-	  (ok\, have fun \.)
-	  (ciao \.)))
-  (make-local-variable 'something)
-  (setq something
-	'((something)
-	  (more)
-	  (how you feel)))
-  (make-local-variable 'things)
-  (setq things 
-	'(;(your interests in computers)   ;; let's make this less computer oriented
-	  ;(the machines you use)
-	  (your plans)
-	  ;(your use of computers)
-	  (your life)
-	  ;(other machines you use)
-	  (the people you hang around with)
-	  ;(computers you like)
-	  (problems at school)
-	  (any hobbies you have)
-	  ;(other computers you use)
-	  (your sex life)
-	  (hangups you have)
-	  (your inhibitions)
-	  (some problems in your childhood)
-	  ;(knowledge of computers)
-	  (some problems at home)))
-  (make-local-variable 'describe)
-  (setq describe
-	'((describe)
-	  (tell me about)
-	  (talk about)
-	  (discuss)
-	  (tell me more about)
-	  (elaborate on)))
-  (make-local-variable 'ibelieve)
-  (setq ibelieve 
-	'((i believe) (i think) (i have a feeling) (it seems to me that)
-	  (it looks like)))
-  (make-local-variable 'problems)
-  (setq problems '( (problems)
-		    (inhibitions)
-		    (hangups)
-		    (difficulties)
-		    (anxieties)
-		    (frustrations) ))
-  (make-local-variable 'bother)
-  (setq bother
-	'((does it bother you that)
-	  (are you annoyed that)
-	  (did you ever regret)
-	  (are you sorry)
-	  (are you satisfied with the fact that)))
-  (make-local-variable 'machlst)
-  (setq machlst 
-	'((you have your mind on (// found) \, it seems \.)
-	  (you think too much about  (// found) \.)
-	  (you should try taking your mind off of (// found)\.)
-	  (are you a computer hacker \?)))
-  (make-local-variable 'qlist)
-  (setq qlist
-	'((what do you think \?)
-	  (i\'ll ask the questions\, if you don\'t mind!)
-	  (i could ask the same thing myself \.)
-	  (($ please) allow me to do the questioning \.)
-	  (i have asked myself that question many times \.)
-	  (($ please) try to answer that question yourself \.)))
-  (make-local-variable 'foullst)
-  (setq foullst
-	'((($ please) watch your tongue!)
-	  (($ please) avoid such unwholesome thoughts \.)
-	  (($ please) get your mind out of the gutter \.)
-	  (such lewdness is not appreciated \.)))
-  (make-local-variable 'deathlst)
-  (setq deathlst
-	'((this is not a healthy way of thinking \.)
-	  (($ bother) you\, too\, may die someday \?)
-	  (i am worried by your obsession with this topic!)
-	  (did you watch a lot of crime and violence on television as a child \?))
-	)
-  (make-local-variable 'sexlst)
-  (setq sexlst 
-	'((($ areyou) ($ afraidof) sex \?)
-	  (($ describe)($ something) about your sexual history \.)
-	  (($ please)($ describe) your sex life \.\.\.)
-	  (($ describe) your ($ feelings-about) your sexual partner \.)
-	  (($ describe) your most ($ random-adjective) sexual experience \.)
-	  (($ areyou) satisfied with (// lover) \.\.\. \?)))
-  (make-local-variable 'neglst)
-  (setq neglst
-	'((why not \?)
-	  (($ bother) i ask that \?)
-	  (why not \?)
-	  (why not \?)
-	  (how come \?)
-	  (($ bother) i ask that \?)))
-  (make-local-variable 'beclst)
-  (setq beclst '(
-		 (is it because (// sent) that you came to me \?)
-		 (($ bother)(// sent) \?)
-		 (when did you first know that (// sent) \?)
-		 (is the fact that (// sent) the real reason \?)
-		 (does the fact that (// sent) explain anything else \?)
-		 (($ areyou)($ sure)(// sent) \? ) ))
-  (make-local-variable 'shortbeclst)
-  (setq shortbeclst '(
-		      (($ bother) i ask you that \?)
-		      (that\'s not much of an answer!)
-		      (($ inter) why won\'t you talk about it \?)
-		      (speak up!)
-		      (($ areyou) ($ afraidof) talking about it \?)
-		      (don\'t be ($ afraidof) elaborating \.)
-		      (($ please) go into more detail \.)))
-  (make-local-variable 'thlst)
-  (setq thlst '(
-		(($ maybe)($ things)($ arerelated) this \.)
-		(is it because of ($ things) that you are going through all this \?)
-		(how do you reconcile ($ things) \? )
-		(($ maybe) this ($ isrelated)($ things) \?) ))
-  (make-local-variable 'remlst)
-  (setq remlst '( (earlier you said ($ history) \?)
-		  (you mentioned that ($ history) \?)
-		  (($ whysay)($ history) \? ) ))
-  (make-local-variable 'toklst)
-  (setq toklst
-	'((is this how you relax \?)
-	  (how long have you been smoking	grass \?)
-	  (($ areyou) ($ afraidof) of being drawn to using harder stuff \?)))
-  (make-local-variable 'states)
-  (setq states
-	'((do you get (// found) often \?)
-	  (do you enjoy being (// found) \?)
-	  (what makes you (// found) \?)
-	  (how often ($ areyou)(// found) \?)
-	  (when were you last (// found) \?)))
-  (make-local-variable 'replist)
-  (setq replist 
-	'((i . (you))
-	  (my . (your))
-	  (me . (you))
-	  (you . (me))
-	  (your . (my))
-	  (mine . (yours))
-	  (yours . (mine))
-	  (our . (your))
-	  (ours . (yours))
-	  (we . (you))
-	  (dunno . (do not know))
-;;	  (yes . ())
-	  (no\, . ())
-	  (yes\, . ())
-	  (ya . (i))
-	  (aint . (am not))
-	  (wanna . (want to))
-	  (gimme . (give me))
-	  (gotta . (have to))
-	  (gonna . (going to))
-	  (never . (not ever))
-	  (doesn\'t . (does not))
-	  (don\'t . (do not))
-	  (aren\'t . (are not))
-	  (isn\'t . (is not))
-	  (won\'t . (will not))
-	  (can\'t . (cannot))
-	  (haven\'t . (have not))
-	  (i\'m . (you are))
-	  (ourselves . (yourselves))
-	  (myself . (yourself))
-	  (yourself . (myself))
-	  (you\'re . (i am))
-	  (you\'ve . (i have))
-	  (i\'ve . (you have))
-	  (i\'ll . (you will))
-	  (you\'ll . (i shall))
-	  (i\'d . (you would))
-	  (you\'d . (i would))
-	  (here . (there))
-	  (please . ())
-	  (eh\, . ())
-	  (eh . ())
-	  (oh\, . ())
-	  (oh . ())
-	  (shouldn\'t . (should not))
-	  (wouldn\'t . (would not))
-	  (won\'t . (will not))
-	  (hasn\'t . (has not))))
-  (make-local-variable 'stallmanlst)
-  (setq stallmanlst '(
-		      (($ describe) your ($ feelings-about) him \.)
-		      (($ areyou) a friend of Stallman \?)
-		      (($ bother) Stallman is ($ random-adjective) \?)
-		      (($ ibelieve) you are ($ afraidof) him \.)))
-  (make-local-variable 'schoollst)
-  (setq schoollst '(
-		    (($ describe) your (// found) \.)
-		    (($ bother) your grades could ($ improve) \?)
-		    (($ areyou) ($ afraidof) (// found) \?)
-		    (($ maybe) this ($ isrelated) to your attitude \.)
-		    (($ areyou) absent often \?)
-		    (($ maybe) you should study ($ something) \.)))
-  (make-local-variable 'improve)
-  (setq improve '((improve) (be better) (be improved) (be higher)))
-  (make-local-variable 'elizalst)
-  (setq elizalst '(
-		   (($ areyou) ($ sure) \?)
-		   (($ ibelieve) you have ($ problems) with (// found) \.)
-		   (($ whysay) (// sent) \?)))
-  (make-local-variable 'sportslst)
-  (setq sportslst '(
-		    (tell me ($ something) about (// found) \.)
-		    (($ describe) ($ relation) (// found) \.)
-		    (do you find (// found) ($ random-adjective) \?)))
-  (make-local-variable 'mathlst)
-  (setq mathlst '(
-		  (($ describe) ($ something) about math \.)
-		  (($ maybe) your ($ problems) ($ arerelated) (// found) \.)
-		  (i do\'nt know much (// found) \, but ($ continue)
-		     anyway \.)))
-  (make-local-variable 'zippylst)
-  (setq zippylst '(
-		   (($ areyou) Zippy \?)
-		   (($ ibelieve) you have some serious ($ problems) \.)
-		   (($ bother) you are a pinhead \?)))
-  (make-local-variable 'chatlst)
-  (setq chatlst '(
-		  (($ maybe) we could chat \.)
-		  (($ please) ($ describe) ($ something) about chat mode \.)
-		  (($ bother) our discussion is so ($ random-adjective) \?)))
-  (make-local-variable 'abuselst)
-  (setq abuselst '(
-		   (($ please) try to be less abusive \.)
-		   (($ describe) why you call me (// found) \.)
-		   (i\'ve had enough of you!)))
-  (make-local-variable 'abusewords)
-  (setq abusewords '(boring bozo clown clumsy cretin dumb dummy
-			    fool foolish gnerd gnurd idiot jerk
-			    lose loser louse lousy luse luser
-			    moron nerd nurd oaf oafish reek
-			    stink stupid tool toolish twit))
-  (make-local-variable 'howareyoulst)
-  (setq howareyoulst  '((how are you) (hows it going) (hows it going eh)
-			(how\'s it going) (how\'s it going eh) (how goes it)
-			(whats up) (whats new) (what\'s up) (what\'s new)
-			(howre you) (how\'re you) (how\'s everything)
-			(how is everything) (how do you do)
-			(how\'s it hanging) (que pasa)
-			(how are you doing) (what do you say)))
-  (make-local-variable 'whereoutp)
-  (setq whereoutp '( huh remem rthing ) )
-  (make-local-variable 'subj)
-  (setq subj nil)
-  (make-local-variable 'verb)
-  (setq verb nil)
-  (make-local-variable 'obj)
-  (setq obj nil)
-  (make-local-variable 'feared)
-  (setq feared nil)
-  (make-local-variable 'repetitive-shortness)
-  (setq repetitive-shortness '(0 . 0))
-  (make-local-variable '**mad**)
-  (setq **mad** nil)
-  (make-local-variable 'rms-flag)
-  (setq rms-flag nil)
-  (make-local-variable 'eliza-flag)
-  (setq eliza-flag nil)
-  (make-local-variable 'zippy-flag)
-  (setq zippy-flag nil)
-  (make-local-variable 'lover)
-  (setq lover '(your partner))
-  (make-local-variable 'bak)
-  (setq bak nil)
-  (make-local-variable 'lincount)
-  (setq lincount 0)
-  (make-local-variable '*print-upcase*)
-  (setq *print-upcase* nil)
-  (make-local-variable '*print-space*)
-  (setq *print-space* nil)
-  (make-local-variable 'howdyflag)
-  (setq howdyflag nil)
-  (make-local-variable 'object)
-  (setq object nil))
-
-;; Define equivalence classes of words that get treated alike.
-
-(defun doctor-meaning (x) (get x 'doctor-meaning))
-
-(defmacro doctor-put-meaning (symb val)
-    "Store the base meaning of a word on the property list."
-    (list 'put (list 'quote symb) ''doctor-meaning val))
-
-(doctor-put-meaning howdy 'howdy)
-(doctor-put-meaning hi 'howdy)
-(doctor-put-meaning greetings 'howdy)
-(doctor-put-meaning hello 'howdy)
-(doctor-put-meaning tops20 'mach)
-(doctor-put-meaning tops-20 'mach)
-(doctor-put-meaning tops 'mach)
-(doctor-put-meaning pdp11 'mach)
-(doctor-put-meaning computer 'mach)
-(doctor-put-meaning unix 'mach)
-(doctor-put-meaning machine 'mach)
-(doctor-put-meaning computers 'mach)
-(doctor-put-meaning machines 'mach)
-(doctor-put-meaning pdp11s 'mach)
-(doctor-put-meaning foo 'mach)
-(doctor-put-meaning foobar 'mach)
-(doctor-put-meaning multics 'mach)
-(doctor-put-meaning macsyma 'mach)
-(doctor-put-meaning teletype 'mach)
-(doctor-put-meaning la36 'mach)
-(doctor-put-meaning vt52 'mach)
-(doctor-put-meaning zork 'mach)
-(doctor-put-meaning trek 'mach)
-(doctor-put-meaning startrek 'mach)
-(doctor-put-meaning advent 'mach)
-(doctor-put-meaning pdp 'mach)
-(doctor-put-meaning dec 'mach)
-(doctor-put-meaning commodore 'mach)
-(doctor-put-meaning vic 'mach)
-(doctor-put-meaning bbs 'mach)
-(doctor-put-meaning modem 'mach)
-(doctor-put-meaning baud 'mach)
-(doctor-put-meaning macintosh 'mach)
-(doctor-put-meaning vax 'mach)
-(doctor-put-meaning vms 'mach)
-(doctor-put-meaning ibm 'mach)
-(doctor-put-meaning pc 'mach)
-(doctor-put-meaning bitching 'foul)
-(doctor-put-meaning bastard 'foul)
-(doctor-put-meaning damn 'foul)
-(doctor-put-meaning damned 'foul)
-(doctor-put-meaning hell 'foul)
-(doctor-put-meaning suck 'foul)
-(doctor-put-meaning sucking 'foul)
-(doctor-put-meaning sux 'foul)
-(doctor-put-meaning ass 'foul)
-(doctor-put-meaning whore 'foul)
-(doctor-put-meaning bitch 'foul)
-(doctor-put-meaning asshole 'foul)
-(doctor-put-meaning shrink 'foul)
-(doctor-put-meaning pot 'toke)
-(doctor-put-meaning grass 'toke)
-(doctor-put-meaning weed 'toke)
-(doctor-put-meaning marijuana 'toke)
-(doctor-put-meaning acapulco 'toke)
-(doctor-put-meaning columbian 'toke)
-(doctor-put-meaning tokin 'toke)
-(doctor-put-meaning joint 'toke)
-(doctor-put-meaning toke 'toke)
-(doctor-put-meaning toking 'toke)
-(doctor-put-meaning tokin\' 'toke)
-(doctor-put-meaning toked 'toke)
-(doctor-put-meaning roach 'toke)
-(doctor-put-meaning pills 'drug)
-(doctor-put-meaning dope 'drug)
-(doctor-put-meaning acid 'drug)
-(doctor-put-meaning lsd 'drug)
-(doctor-put-meaning speed 'drug)
-(doctor-put-meaning heroin 'drug)
-(doctor-put-meaning hash 'drug)
-(doctor-put-meaning cocaine 'drug)
-(doctor-put-meaning uppers 'drug)
-(doctor-put-meaning downers 'drug)
-(doctor-put-meaning loves 'loves)
-(doctor-put-meaning love 'love)
-(doctor-put-meaning loved 'love)
-(doctor-put-meaning hates 'hates)
-(doctor-put-meaning dislikes 'hates)
-(doctor-put-meaning hate 'hate)
-(doctor-put-meaning hated 'hate)
-(doctor-put-meaning dislike 'hate)
-(doctor-put-meaning stoned 'state)
-(doctor-put-meaning drunk 'state)
-(doctor-put-meaning drunken 'state)
-(doctor-put-meaning high 'state)
-(doctor-put-meaning horny 'state)
-(doctor-put-meaning blasted 'state)
-(doctor-put-meaning happy 'state)
-(doctor-put-meaning paranoid 'state)
-(doctor-put-meaning wish 'desire)
-(doctor-put-meaning wishes 'desire)
-(doctor-put-meaning want 'desire)
-(doctor-put-meaning desire 'desire)
-(doctor-put-meaning like 'desire)
-(doctor-put-meaning hope 'desire)
-(doctor-put-meaning hopes 'desire)
-(doctor-put-meaning desires 'desire)
-(doctor-put-meaning wants 'desire)
-(doctor-put-meaning desires 'desire)
-(doctor-put-meaning likes 'desire)
-(doctor-put-meaning needs 'desire)
-(doctor-put-meaning need 'desire)
-(doctor-put-meaning frustrated 'mood)
-(doctor-put-meaning depressed 'mood)
-(doctor-put-meaning annoyed 'mood)
-(doctor-put-meaning upset 'mood)
-(doctor-put-meaning unhappy 'mood)
-(doctor-put-meaning excited 'mood)
-(doctor-put-meaning worried 'mood)
-(doctor-put-meaning lonely 'mood)
-(doctor-put-meaning angry 'mood)
-(doctor-put-meaning mad 'mood)
-(doctor-put-meaning jealous 'mood)
-(doctor-put-meaning afraid 'fear)
-(doctor-put-meaning terrified 'fear)
-(doctor-put-meaning fear 'fear)
-(doctor-put-meaning scared 'fear)
-(doctor-put-meaning frightened 'fear)
-(doctor-put-meaning virginity 'sexnoun)
-(doctor-put-meaning virgins 'sexnoun)
-(doctor-put-meaning virgin 'sexnoun)
-(doctor-put-meaning cock 'sexnoun)
-(doctor-put-meaning cocks 'sexnoun)
-(doctor-put-meaning dick 'sexnoun)
-(doctor-put-meaning dicks 'sexnoun)
-(doctor-put-meaning prostitute 'sexnoun)
-(doctor-put-meaning condom 'sexnoun)
-(doctor-put-meaning sex 'sexnoun)
-(doctor-put-meaning rapes 'sexnoun)
-(doctor-put-meaning wife 'family)
-(doctor-put-meaning family 'family)
-(doctor-put-meaning brothers 'family)
-(doctor-put-meaning sisters 'family)
-(doctor-put-meaning parent 'family)
-(doctor-put-meaning parents 'family)
-(doctor-put-meaning brother 'family)
-(doctor-put-meaning sister 'family)
-(doctor-put-meaning father 'family)
-(doctor-put-meaning mother 'family)
-(doctor-put-meaning husband 'family)
-(doctor-put-meaning siblings 'family)
-(doctor-put-meaning grandmother 'family)
-(doctor-put-meaning grandfather 'family)
-(doctor-put-meaning maternal 'family)
-(doctor-put-meaning paternal 'family)
-(doctor-put-meaning stab 'death)
-(doctor-put-meaning murder 'death)
-(doctor-put-meaning murders 'death)
-(doctor-put-meaning suicide 'death)
-(doctor-put-meaning suicides 'death)
-(doctor-put-meaning kill 'death)
-(doctor-put-meaning kills 'death)
-(doctor-put-meaning die 'death)
-(doctor-put-meaning dies 'death)
-(doctor-put-meaning died 'death)
-(doctor-put-meaning dead 'death)
-(doctor-put-meaning death 'death)
-(doctor-put-meaning deaths 'death)
-(doctor-put-meaning pain 'symptoms)
-(doctor-put-meaning ache 'symptoms)
-(doctor-put-meaning fever 'symptoms)
-(doctor-put-meaning sore 'symptoms)
-(doctor-put-meaning aching 'symptoms)
-(doctor-put-meaning stomachache 'symptoms)
-(doctor-put-meaning headache 'symptoms)
-(doctor-put-meaning hurts 'symptoms)
-(doctor-put-meaning disease 'symptoms)
-(doctor-put-meaning virus 'symptoms)
-(doctor-put-meaning vomit 'symptoms)
-(doctor-put-meaning vomiting 'symptoms)
-(doctor-put-meaning barf 'symptoms)
-(doctor-put-meaning toothache 'symptoms)
-(doctor-put-meaning hurt 'symptoms)
-(doctor-put-meaning rum 'alcohol)
-(doctor-put-meaning gin 'alcohol)
-(doctor-put-meaning vodka 'alcohol)
-(doctor-put-meaning alcohol 'alcohol)
-(doctor-put-meaning bourbon 'alcohol)
-(doctor-put-meaning beer 'alcohol)
-(doctor-put-meaning wine 'alcohol)
-(doctor-put-meaning whiskey 'alcohol)
-(doctor-put-meaning scotch 'alcohol)
-(doctor-put-meaning screw 'sexverb)
-(doctor-put-meaning screwing 'sexverb)
-(doctor-put-meaning rape 'sexverb)
-(doctor-put-meaning raped 'sexverb)
-(doctor-put-meaning kiss 'sexverb)
-(doctor-put-meaning kissing 'sexverb)
-(doctor-put-meaning kisses 'sexverb)
-(doctor-put-meaning screws 'sexverb)
-(doctor-put-meaning because 'conj)
-(doctor-put-meaning but 'conj)
-(doctor-put-meaning however 'conj)
-(doctor-put-meaning besides 'conj)
-(doctor-put-meaning anyway 'conj)
-(doctor-put-meaning that 'conj)
-(doctor-put-meaning except 'conj)
-(doctor-put-meaning why 'conj)
-(doctor-put-meaning how 'conj)
-(doctor-put-meaning until 'when)
-(doctor-put-meaning when 'when)
-(doctor-put-meaning whenever 'when)
-(doctor-put-meaning while 'when)
-(doctor-put-meaning since 'when)
-(doctor-put-meaning rms 'rms)
-(doctor-put-meaning stallman 'rms)
-(doctor-put-meaning school 'school)
-(doctor-put-meaning schools 'school)
-(doctor-put-meaning skool 'school)
-(doctor-put-meaning grade 'school)
-(doctor-put-meaning grades 'school)
-(doctor-put-meaning teacher 'school)
-(doctor-put-meaning teachers 'school)
-(doctor-put-meaning classes 'school)
-(doctor-put-meaning professor 'school)
-(doctor-put-meaning prof 'school)
-(doctor-put-meaning profs 'school)
-(doctor-put-meaning professors 'school)
-(doctor-put-meaning mit 'school)
-(doctor-put-meaning emacs 'eliza)
-(doctor-put-meaning eliza 'eliza)
-(doctor-put-meaning liza 'eliza)
-(doctor-put-meaning elisa 'eliza)
-(doctor-put-meaning weizenbaum 'eliza)
-(doctor-put-meaning doktor 'eliza)
-(doctor-put-meaning athletics 'sports)
-(doctor-put-meaning baseball 'sports)
-(doctor-put-meaning basketball 'sports)
-(doctor-put-meaning football 'sports)
-(doctor-put-meaning frisbee 'sports)
-(doctor-put-meaning gym 'sports)
-(doctor-put-meaning gymnastics 'sports)
-(doctor-put-meaning hockey 'sports)
-(doctor-put-meaning lacrosse 'sports)
-(doctor-put-meaning soccer 'sports)
-(doctor-put-meaning softball 'sports)
-(doctor-put-meaning sports 'sports)
-(doctor-put-meaning swimming 'sports)
-(doctor-put-meaning swim 'sports)
-(doctor-put-meaning tennis 'sports)
-(doctor-put-meaning volleyball 'sports)
-(doctor-put-meaning math 'math)
-(doctor-put-meaning mathematics 'math)
-(doctor-put-meaning mathematical 'math)
-(doctor-put-meaning theorem 'math)
-(doctor-put-meaning axiom 'math)
-(doctor-put-meaning lemma 'math)
-(doctor-put-meaning algebra 'math)
-(doctor-put-meaning algebraic 'math)
-(doctor-put-meaning trig 'math)
-(doctor-put-meaning trigonometry 'math)
-(doctor-put-meaning trigonometric 'math)
-(doctor-put-meaning geometry 'math)
-(doctor-put-meaning geometric 'math)
-(doctor-put-meaning calculus 'math)
-(doctor-put-meaning arithmetic 'math)
-(doctor-put-meaning zippy 'zippy)
-(doctor-put-meaning zippy 'zippy)
-(doctor-put-meaning pinhead 'zippy)
-(doctor-put-meaning chat 'chat)
-
-;;;###autoload
-(defun doctor ()
-  "Switch to *doctor* buffer and start giving psychotherapy."
-  (interactive)
-  (switch-to-buffer "*doctor*")
-  (doctor-mode))
-
-(defun doctor-ret-or-read (arg)
-  "Insert a newline if preceding character is not a newline.
-Otherwise call the Doctor to parse preceding sentence."
-  (interactive "*p")
-  (if (= (preceding-char) ?\n)
-      (doctor-read-print)
-    (newline arg)))
-
-(defun doctor-read-print nil
-  "top level loop"
-  (interactive)
-  (let ((sent (doctor-readin)))
-    (insert "\n")
-    (setq lincount (1+ lincount))
-    (doctor-doc sent)
-    (insert "\n")
-    (setq bak sent)))
-
-(defun doctor-readin nil
-  "Read a sentence.  Return it as a list of words."
-  (let (sentence)
-    (backward-sentence 1)
-    (while (not (eobp))
-      (setq sentence (append sentence (list (doctor-read-token)))))
-    sentence))
-
-(defun doctor-read-token ()
-  "read one word from buffer"
-  (prog1 (intern (downcase (buffer-substring (point)
-					     (progn
-					       (forward-word 1)
-					       (point)))))
-    (re-search-forward "\\Sw*")))
-
-;; Main processing function for sentences that have been read.
-
-(defun doctor-doc (sent)
-  (cond
-   ((equal sent '(foo))
-    (doctor-type '(bar! ($ please)($ continue) \.)))
-   ((member sent howareyoulst)
-    (doctor-type '(i\'m ok \.  ($ describe) yourself \.)))
-   ((or (member sent '((good bye) (see you later) (i quit) (so long)
-		       (go away) (get lost)))
-	(memq (car sent)
-	      '(bye halt break quit done exit goodbye 
-		    bye\, stop pause goodbye\, stop pause)))
-    (doctor-type ($ bye)))
-   ((and (eq (car sent) 'you)
-	 (memq (doctor-cadr sent) abusewords))
-    (setq found (doctor-cadr sent))
-    (doctor-type ($ abuselst)))
-   ((eq (car sent) 'whatmeans)
-    (doctor-def (doctor-cadr sent)))
-   ((equal sent '(parse))
-    (doctor-type (list  'subj '= subj ",  "
-			'verb '= verb "\n"
-			'object 'phrase '= obj ","
-			'noun 'form '=  object "\n"
-			'current 'keyword 'is found
-			", "
-			'most 'recent 'possessive
-			'is owner "\n"
-			'sentence 'used 'was
-			"..."
-			'(// bak))))
-   ;;   ((eq (car sent) 'forget)
-   ;;    (set (doctor-cadr sent) nil)
-   ;;    (doctor-type '(($ isee)($ please)
-   ;;     ($ continue)\.)))
-   (t
-    (if (doctor-defq sent) (doctor-define sent found))
-    (if (> (length sent) 12)(doctor-shorten sent))
-    (setq sent (doctor-correct-spelling (doctor-replace sent replist)))
-    (cond ((and (not (memq 'me sent))(not (memq 'i sent))
-		(memq 'am sent))
-	   (setq sent (doctor-replace sent '((am . (are)))))))
-    (cond ((equal (car sent) 'yow) (doctor-zippy))
-	  ((< (length sent) 2)
-	   (cond ((eq (doctor-meaning (car sent)) 'howdy)
-		  (doctor-howdy))
-		 (t (doctor-short))))
-	  (t
-	   (if (memq 'am sent)
-	       (setq sent (doctor-replace sent '((me . (i))))))
-	   (setq sent (doctor-fixup sent))
-	   (if (and (eq (car sent) 'do) (eq (doctor-cadr sent) 'not))
-	       (cond ((zerop (random 3))
-		      (doctor-type '(are you ($ afraidof) that \?)))
-		     ((zerop (random 2))
-		      (doctor-type '(don\'t tell me what to do \. i am the
-					    psychiatrist here!))
-		      (doctor-rthing))
-		     (t
-		      (doctor-type '(($ whysay) that i shouldn\'t
-				     (doctor-cddr sent)
-				     \?))))
-	     (doctor-go (doctor-wherego sent))))))))
-
-;; Things done to process sentences once read.
-
-(defun doctor-correct-spelling (sent)
-  "Correct the spelling and expand each word in sentence."
-  (if sent
-      (apply 'append (mapcar '(lambda (word)
-				(if (memq word typos)
-				    (get (get word 'doctor-correction) 'doctor-expansion)
-				  (list word)))
-			     sent))))
-
-(defun doctor-shorten (sent)
-  "Make a sentence manageably short using a few hacks."
-  (let (foo
-	retval
-	(temp '(because but however besides anyway until
-		    while that except why how)))
-    (while temp
-	   (setq foo (memq (car temp) sent))
-	   (if (and foo
-		    (> (length foo) 3))
-	       (setq sent foo
-		     sent (doctor-fixup sent)
-		     temp nil
-		     retval t)
-	       (setq temp (cdr temp))))
-    retval))
-
-(defun doctor-define (sent found)
-  (doctor-svo sent found 1 nil)
-  (and
-   (doctor-nounp subj)
-   (not (doctor-pronounp subj))
-   subj
-   (doctor-meaning object)
-   (put subj 'doctor-meaning (doctor-meaning object))
-   t))
-
-(defun doctor-defq (sent)
-  "Set global var FOUND to first keyword found in sentence SENT."
-  (setq found nil)
-  (let ((temp '(means applies mean refers refer related
-		      similar defined associated linked like same)))
-    (while temp
-	   (if (memq (car temp) sent)
-	       (setq found (car temp)
-		     temp nil)
-	       (setq temp (cdr temp)))))
-  found)
-
-(defun doctor-def (x)
-  (progn
-   (doctor-type (list 'the 'word x 'means (doctor-meaning x) 'to 'me)) 
-   nil))
-
-(defun doctor-forget ()
-  "Delete the last element of the history list."
-  (setq history (reverse (cdr (reverse history)))))
-
-(defun doctor-query (x)
-  "Prompt for a line of input from the minibuffer until a noun or verb is seen.
-Put dialogue in buffer."
-  (let (a
-	(prompt (concat (doctor-make-string x)
-			" what \?  "))
-	retval)
-    (while (not retval)
-	   (while (not a)
-	     (insert ?\n
-		     prompt
-		     (read-string prompt)
-		     ?\n)
-	     (setq a (doctor-readin)))
-	   (while (and a (not retval))
-		  (cond ((doctor-nounp (car a))
-			 (setq retval (car a)))
-			((doctor-verbp (car a))
-			 (setq retval (doctor-build
-				       (doctor-build x " ")
-				       (car a))))
-			((setq a (cdr a))))))
-    retval))
-
-(defun doctor-subjsearch (sent key type)
-  "Search for the subject of a sentence SENT, looking for the noun closest
-to and preceding KEY by at least TYPE words.  Set global variable subj to
-the subject noun, and return the portion of the sentence following it."
-  (let ((i (- (length sent) (length (memq key sent)) type)))
-    (while (and (> i -1) (not (doctor-nounp (nth i sent))))
-      (setq i (1- i)))
-    (cond ((> i -1)
-	   (setq subj (nth i sent))
-	   (nthcdr (1+ i) sent))
-	  (t
-	   (setq subj 'you)
-	   nil))))
-
-(defun doctor-nounp (x)
-  "Returns t if the symbol argument is a noun."
-	(or (doctor-pronounp x)
-	    (not (or (doctor-verbp x)
-		     (equal x 'not)
-		     (doctor-prepp x)
-		     (doctor-modifierp x) )) ))
-
-(defun doctor-pronounp (x)
-  "Returns t if the symbol argument is a pronoun."
-  (memq x '(
-	i me mine myself
-	we us ours ourselves ourself
-	you yours yourself yourselves
-	he him himself she hers herself
-	it that those this these things thing
-	they them themselves theirs
-	anybody everybody somebody
-	anyone everyone someone
-	anything something everything)))
-
-(mapcar (function (lambda (x) (put x 'doctor-sentence-type 'verb)))
-	'(abort aborted aborts ask asked asks am
-		applied applies apply are associate
-		associated ate
-		be became become becomes becoming
-		been being believe believed believes
-		bit bite bites bore bored bores boring bought buy buys buying
-		call called calling calls came can caught catch come
-		contract contracted contracts control controlled controls
-		could croak croaks croaked cut cuts
-		dare dared define defines dial dialed dials did die died dies
-		dislike disliked
-		dislikes do does drank drink drinks drinking
-		drive drives driving drove dying
-		eat eating eats expand expanded expands
-		expect expected expects expel expels expelled
-		explain explained explains
-		fart farts feel feels felt fight fights find finds finding
-		forget forgets forgot fought found
-		gave get gets getting give gives go goes going gone got gotten
-		had harm harms has hate hated hates have having
-		hear heard hears hearing help helped helping helps
-		hit hits hope hoped hopes hurt hurts
-		implies imply is
-		join joined joins jump jumped jumps
-		keep keeping keeps kept
-		kill killed killing kills kiss kissed kisses kissing
-		knew know knows
-		laid lay lays let lets lie lied lies like liked likes
-		liking listen listens
-		login look looked looking looks
-		lose losing lost
-		love loved loves loving
-		luse lusing lust lusts
-		made make makes making may mean means meant might
-		move moved moves moving must
-		need needed needs 
-		order ordered orders ought
-		paid pay pays pick picked picking picks 
-		placed placing prefer prefers put puts
-		ran rape raped rapes
-		read reading reads recall receive received receives
-		refer refered referred refers
-		relate related relates remember remembered remembers
-		romp romped romps run running runs
-		said sang sat saw say says
-		screw screwed screwing screws scrod see sees seem seemed
-		seems seen sell selling sells
-		send sendind sends sent shall shoot shot should
-		sing sings sit sits sitting sold studied study
-		take takes taking talk talked talking talks tell tells telling
-		think thinks
-		thought told took tooled touch touched touches touching
-		transfer transferred transfers transmit transmits transmitted
-		type types types typing
-		walk walked walking walks want wanted wants was watch
-		watched watching went were will wish would work worked works
-		write writes writing wrote use used uses using))
-
-(defun doctor-verbp (x) (if (symbolp x)
-			    (eq (get x 'doctor-sentence-type) 'verb)))
-
-(defun doctor-plural (x)
-  "Form the plural of the word argument."
-  (let ((foo (doctor-make-string x)))
-    (cond ((string-equal (substring foo -1) "s")
-	   (cond ((string-equal (substring foo -2 -1) "s")
-		  (intern (concat foo "es")))
-		 (t x)))
-	   ((string-equal (substring foo -1) "y")
-	    (intern (concat (substring foo 0 -1)
-			    "ies")))
-	   (t (intern (concat foo "s"))))))
-
-(defun doctor-setprep (sent key)
-  (let ((val)
-	(foo (memq key sent)))
-    (cond ((doctor-prepp (doctor-cadr foo))
-	   (setq val (doctor-getnoun (doctor-cddr foo)))
-	   (cond (val val)
-		 (t 'something)))
-	  ((doctor-articlep (doctor-cadr foo))
-	   (setq val (doctor-getnoun (doctor-cddr foo)))
-	   (cond (val (doctor-build (doctor-build (doctor-cadr foo) " ") val))
-		 (t 'something)))
-	  (t 'something))))
-
-(defun doctor-getnoun (x)
-  (cond ((null x)(setq object 'something))
-	((atom x)(setq object x))
-	((eq (length x) 1)
-	 (setq object (cond
-		       ((doctor-nounp (setq object (car x))) object)
-		       (t (doctor-query object)))))
-	((eq (car x) 'to)
-	 (doctor-build 'to\  (doctor-getnoun (cdr x))))
-	((doctor-prepp (car x))
-	 (doctor-getnoun (cdr x)))
-	((not (doctor-nounp (car x)))
-	 (doctor-build (doctor-build (cdr (assq (car x)
-						(append
-						 '((a . this)
-						   (some . this)
-						   (one . that))
-						 (list
-						  (cons
-						   (car x) (car x))))))
-				     " ")
-		       (doctor-getnoun (cdr x))))
-	(t (setq object (car x))) ))
-
-(defun doctor-modifierp (x)
-  (or (doctor-adjectivep x)
-      (doctor-adverbp x)
-      (doctor-othermodifierp x)))
-
-(defun doctor-adjectivep (x)
-  (or (numberp x)
-      (doctor-nmbrp x)
-      (doctor-articlep x)
-      (doctor-colorp x)
-      (doctor-sizep x)
-      (doctor-possessivepronounp x)))
-
-(defun doctor-adverbp (xx)
-  (let ((xxstr (doctor-make-string xx)))
-    (and (>= (length xxstr) 2)
-	 (string-equal (substring (doctor-make-string xx) -2) "ly"))))
-
-(defun doctor-articlep (x)
-  (memq x '(the a an)))
-
-(defun doctor-nmbrp (x)
-  (memq x '(one two three four five six seven eight nine ten
-		eleven twelve thirteen fourteen fifteen
-		sixteen seventeen eighteen nineteen
-		twenty thirty forty fifty sixty seventy eighty ninety
-		hundred thousand million billion
-		half quarter
-		first second third fourth fifth
-		sixth seventh eighth ninth tenth)))
-		 
-(defun doctor-colorp (x)
-  (memq x '(beige black blue brown crimson
-		  gray grey green
-		  orange pink purple red tan tawny
-		  violet white yellow)))
-
-(defun doctor-sizep (x)
-  (memq x '(big large tall fat wide thick
-		small petite short thin skinny)))
-
-(defun doctor-possessivepronounp (x)
-  (memq x '(my your his her our their)))
-
-(defun doctor-othermodifierp (x)
-  (memq x '(all also always amusing any anyway associated awesome
-		bad beautiful best better but certain clear
-		ever every fantastic fun funny
-		good great grody gross however if ignorant
-		less linked losing lusing many more much
-		never nice obnoxious often poor pretty real related rich
-		similar some stupid super superb
-		terrible terrific too total tubular ugly very)))
-
-(defun doctor-prepp (x)
-  (memq x '(about above after around as at
-		  before beneath behind beside between by
-		  for from in inside into
-		  like near next of on onto over
-		  same through thru to toward towards
-		  under underneath with without)))
-
-(defun doctor-remember (thing)
-  (cond ((null history)
-	 (setq history (list thing)))
-	(t (setq history (append history (list thing))))))
-
-(defun doctor-type (x)
-  (setq x (doctor-fix-2 x))
-  (doctor-txtype (doctor-assm x)))
-
-(defun doctor-fixup (sent)
-  (setq sent (append
-	      (cdr
-	       (assq (car sent)
-		     (append
-		      '((me  i)
-			(him  he)
-			(her  she)
-			(them  they)
-			(okay)
-			(well)
-			(sigh)
-			(hmm)
-			(hmmm)
-			(hmmmm)
-			(hmmmmm)
-			(gee)
-			(sure)
-			(great)
-			(oh)
-			(fine)
-			(ok)
-			(no))
-		      (list (list (car sent)
-				  (car sent))))))
-	      (cdr sent)))
-  (doctor-fix-2 sent))
-
-(defun doctor-fix-2 (sent)
-  (let ((foo sent))
-    (while foo
-      (if (and (eq (car foo) 'me)
-	       (doctor-verbp (doctor-cadr foo)))
-	  (rplaca foo 'i)
-	(cond ((eq (car foo) 'you)
-	       (cond ((memq (doctor-cadr foo) '(am be been is))
-		      (rplaca (cdr foo) 'are))
-		     ((memq (doctor-cadr foo) '(has))
-		      (rplaca (cdr foo) 'have))
-		     ((memq (doctor-cadr foo) '(was))
-		      (rplaca (cdr foo) 'were))))
-	      ((equal (car foo) 'i)
-	       (cond ((memq (doctor-cadr foo) '(are is be been))
-		      (rplaca (cdr foo) 'am))
-		     ((memq (doctor-cadr foo) '(were))
-		      (rplaca (cdr foo) 'was))
-		     ((memq (doctor-cadr foo) '(has))
-		      (rplaca (cdr foo) 'have))))
-	      ((and (doctor-verbp (car foo))
-		    (eq (doctor-cadr foo) 'i)
-		    (not (doctor-verbp (car (doctor-cddr foo)))))
-	       (rplaca (cdr foo) 'me))
-	      ((and (eq (car foo) 'a)
-		    (doctor-vowelp (string-to-char
-				    (doctor-make-string (doctor-cadr foo)))))
-	       (rplaca foo 'an))
-	      ((and (eq (car foo) 'an)
-		    (not (doctor-vowelp (string-to-char
-					 (doctor-make-string (doctor-cadr foo))))))
-	       (rplaca foo 'a)))
-	(setq foo (cdr foo))))
-    sent))
-
-(defun doctor-vowelp (x)
-  (memq x '(?a ?e ?i ?o ?u)))
-
-(defun doctor-replace (sent rlist)
-  "Replace any element of SENT that is the car of a replacement
-element pair in RLIST."
-  (apply 'append
-	 (mapcar
-	  (function
-	   (lambda (x)
-	     (cdr (or (assq x rlist)   ; either find a replacement
-		      (list x x)))))   ; or fake an identity mapping
-	  sent)))
-
-(defun doctor-wherego (sent)
-  (cond ((null sent)($ whereoutp))
-	((null (doctor-meaning (car sent)))
-	 (doctor-wherego (cond ((zerop (random 2))
-				(reverse (cdr sent)))
-			       (t (cdr sent)))))
-	(t
-	 (setq found (car sent))
-	 (doctor-meaning (car sent)))))
-
-(defun doctor-svo (sent key type mem)
-  "Find subject, verb and object in sentence SENT with focus on word KEY.
-TYPE is number of words preceding KEY to start looking for subject.
-MEM is t if results are to be put on Doctor's memory stack.
-Return in the global variables SUBJ, VERB and OBJECT."
-  (let ((foo (doctor-subjsearch sent key type)))
-    (or foo
-	(setq foo sent
-	      mem nil))
-    (while (and (null (doctor-verbp (car foo))) (cdr foo))
-      (setq foo (cdr foo)))
-    (setq verb (car foo))
-    (setq obj (doctor-getnoun (cdr foo)))
-    (cond ((eq object 'i)(setq object 'me))
-	  ((eq subj 'me)(setq subj 'i)))
-    (cond (mem (doctor-remember (list subj verb obj))))))
-
-(defun doctor-possess (sent key)
-  "Set possessive in SENT for keyword KEY.
-Hack on previous word, setting global variable OWNER to correct result."
-  (let* ((i (- (length sent) (length (memq key sent)) 1))
-	 (prev (if (< i 0) 'your
-		 (nth i sent))))
-    (setq owner (if (or (doctor-possessivepronounp prev)
-			(string-equal "s"
-				      (substring (doctor-make-string prev)
-						 -1)))
-		    prev
-		  'your))))
-
-;; Output of replies.
-
-(defun doctor-txtype (ans)
-  "Output to buffer a list of symbols or strings as a sentence."
-  (setq *print-upcase* t *print-space* nil)
-  (mapcar 'doctor-type-symbol ans)
-  (insert "\n"))
-
-(defun doctor-type-symbol (word)
-  "Output a symbol to the buffer with some fancy case and spacing hacks."
-  (setq word (doctor-make-string word))
-  (if (string-equal word "i") (setq word "I"))
-  (if *print-upcase*
-      (progn
-	(setq word (capitalize word))
-	(if *print-space*
-	    (insert " "))))
-  (cond ((or (string-match "^[.,;:?! ]" word)
-	     (not *print-space*))
-	 (insert word))
-	(t (insert ?\  word)))
-  (and auto-fill-function
-       (> (current-column) fill-column)
-       (apply auto-fill-function nil))
-  (setq *print-upcase* (string-match "[.?!]$" word)
-	*print-space* t))
-
-(defun doctor-build (str1 str2)
-  "Make a symbol out of the concatenation of the two non-list arguments."
-  (cond ((null str1) str2)
-	((null str2) str1)
-	((and (atom str1)
-	      (atom str2))
-	 (intern (concat (doctor-make-string str1)
-			 (doctor-make-string str2))))
-	(t nil)))
-
-(defun doctor-make-string (obj)
-  (cond ((stringp obj) obj)
-	((symbolp obj) (symbol-name obj))
-	((numberp obj) (int-to-string obj))
-	(t "")))
-
-(defun doctor-concat (x y)
-  "Like append, but force atomic arguments to be lists."
-  (append
-   (if (and x (atom x)) (list x) x)
-   (if (and y (atom y)) (list y) y)))
-
-(defun doctor-assm (proto)
-  (cond ((null proto) nil)
-	((atom proto) (list proto))
-	((atom (car proto))
-	 (cons (car proto) (doctor-assm (cdr proto))))
-	(t (doctor-concat (doctor-assm (eval (car proto))) (doctor-assm (cdr proto))))))
-
-;; Functions that handle specific words or meanings when found.
-
-(defun doctor-go (destination)
-  "Call a `doctor-*' function."
-  (funcall (intern (concat "doctor-" (doctor-make-string destination)))))
-
-(defun doctor-desire1 ()
-  (doctor-go ($ whereoutp)))
-
-(defun doctor-huh ()
-  (cond ((< (length sent) 9) (doctor-type ($ huhlst)))
-	(t (doctor-type ($ longhuhlst)))))
-
-(defun doctor-rthing () (doctor-type ($ thlst)))
-
-(defun doctor-remem () (cond ((null history)(doctor-huh))
-			     ((doctor-type ($ remlst)))))
-
-(defun doctor-howdy ()
-  (cond ((not howdyflag)
-	 (doctor-type '(($ hello) what brings you to see me \?))
-	 (setq howdyflag t))
-	(t
-	 (doctor-type '(($ ibelieve) we\'ve introduced ourselves already \.))
-	 (doctor-type '(($ please) ($ describe) ($ things) \.)))))
-
-(defun doctor-when ()
-  (cond ((< (length (memq found sent)) 3)(doctor-short))
-	(t
-	 (setq sent (cdr (memq found sent)))
-	 (setq sent (doctor-fixup sent))
-	 (doctor-type '(($ whatwhen)(// sent) \?)))))
-
-(defun doctor-conj ()
-  (cond ((< (length (memq found sent)) 4)(doctor-short))
-	(t
-	 (setq sent (cdr (memq found sent)))
-	 (setq sent (doctor-fixup sent))
-	 (cond ((eq (car sent) 'of)
-		(doctor-type '(are you ($ sure) that is the real reason \?))
-		(setq things (cons (cdr sent) things)))
-	       (t
-		(doctor-remember sent)
-		(doctor-type ($ beclst)))))))
-
-(defun doctor-short ()
-  (cond ((= (car repetitive-shortness) (1- lincount))
-	 (rplacd repetitive-shortness
-		 (1+ (cdr repetitive-shortness))))
-	(t
-	 (rplacd repetitive-shortness 1)))
-  (rplaca repetitive-shortness lincount)
-  (cond ((> (cdr repetitive-shortness) 6)
-	 (cond ((not **mad**)
-		(doctor-type '(($ areyou)
-			       just trying to see what kind of things
-			       i have in my vocabulary \? please try to
-			       carry on a reasonable conversation!))
-		(setq **mad** t))
-	       (t
-		(doctor-type '(i give up \. you need a lesson in creative
-				 writing \.\.\.))
-		)))
-	(t
-	 (cond ((equal sent (doctor-assm '(yes)))
-		(doctor-type '(($ isee) ($ inter) ($ whysay) this is so \?)))
-	       ((equal sent (doctor-assm '(because)))
-		(doctor-type ($ shortbeclst)))
-	       ((equal sent (doctor-assm '(no)))
-		(doctor-type ($ neglst)))
-	       (t (doctor-type ($ shortlst)))))))
-	   
-(defun doctor-alcohol () (doctor-type ($ drnk)))
-
-(defun doctor-desire ()
-  (let ((foo (memq found sent)))
-    (cond ((< (length foo) 2)
-	   (doctor-go (doctor-build (doctor-meaning found) 1)))
-	  ((memq (doctor-cadr foo) '(a an))
-	   (rplacd foo (append '(to have) (cdr foo)))
-	   (doctor-svo sent found 1 nil)
-	   (doctor-remember (list subj 'would 'like obj))
-	   (doctor-type ($ whywant)))
-	  ((not (eq (doctor-cadr foo) 'to))
-	   (doctor-go (doctor-build (doctor-meaning found) 1)))
-	  (t
-	   (doctor-svo sent found 1 nil)
-	   (doctor-remember (list subj 'would 'like obj))
-	   (doctor-type ($ whywant))))))
-
-(defun doctor-drug ()
-  (doctor-type ($ drugs))
-  (doctor-remember (list 'you 'used found)))
-
-(defun doctor-toke ()
-  (doctor-type ($ toklst)))
-
-(defun doctor-state ()
-  (doctor-type ($ states))(doctor-remember (list 'you 'were found)))
-
-(defun doctor-mood ()
-  (doctor-type ($ moods))(doctor-remember (list 'you 'felt found)))
-
-(defun doctor-fear ()
-  (setq feared (doctor-setprep sent found))
-  (doctor-type ($ fears))
-  (doctor-remember (list 'you 'were 'afraid 'of feared)))
-
-(defun doctor-hate ()
-  (doctor-svo sent found 1 t)
-  (cond ((memq 'not sent) (doctor-forget) (doctor-huh))
-	((equal subj 'you)
-	 (doctor-type '(why do you (// verb)(// obj) \?)))
-	(t (doctor-type '(($ whysay)(list subj verb obj))))))
-
-(defun doctor-symptoms ()
-  (doctor-type '(($ maybe) you should consult a doctor of medicine\,
-		 i am a psychiatrist \.)))
-
-(defun doctor-hates ()
-  (doctor-svo sent found 1 t)
-  (doctor-hates1))
-
-(defun doctor-hates1 ()
-  (doctor-type '(($ whysay)(list subj verb obj))))
-
-(defun doctor-loves ()
-  (doctor-svo sent found 1 t)
-  (doctor-qloves))
-
-(defun doctor-qloves ()
-  (doctor-type '(($ bother)(list subj verb obj) \?)))
-
-(defun doctor-love ()
-  (doctor-svo sent found 1 t)
-  (cond ((memq 'not sent) (doctor-forget) (doctor-huh))
-	((memq 'to sent) (doctor-hates1))
-	(t
-	 (cond ((equal object 'something)
-		(setq object '(this person you love))))
-	 (cond ((equal subj 'you)
-		(setq lover obj)
-		(cond ((equal lover '(this person you love))
-		       (setq lover '(your partner))
-		       (doctor-forget)
-		       (doctor-type '(with whom are you in love \?)))
-		      ((doctor-type '(($ please)
-				      ($ describe)
-				      ($ relation)
-				      (// lover)
-				      \.)))))
-	       ((equal subj 'i)
-		(doctor-txtype '(we were discussing you!)))
-	       (t (doctor-forget)
-		  (setq obj 'someone)
-		  (setq verb (doctor-build verb 's))
-		  (doctor-qloves))))))
-
-(defun doctor-mach ()
-  (setq found (doctor-plural found))
-  (doctor-type ($ machlst)))
-
-(defun doctor-sexnoun () (doctor-sexverb))
-
-(defun doctor-sexverb ()
-  (if (or (memq 'me sent)(memq 'myself sent)(memq 'i sent))
-      (doctor-foul)
-    (doctor-type ($ sexlst))))
-
-(defun doctor-death () (doctor-type ($ deathlst)))
-
-(defun doctor-foul ()
-  (doctor-type ($ foullst)))
-
-(defun doctor-family ()
-  (doctor-possess sent found)
-  (doctor-type ($ famlst)))
-
-;; I did not add this -- rms.
-;; But he might have removed it.  I put it back.  --roland
-(defun doctor-rms ()
-  (cond (rms-flag (doctor-type ($ stallmanlst)))
-	(t (setq rms-flag t) (doctor-type '(do you know Stallman \?)))))
-
-(defun doctor-school nil (doctor-type ($ schoollst)))
-
-(defun doctor-eliza ()
-  (cond (eliza-flag (doctor-type ($ elizalst)))
-	(t (setq eliza-flag t)
-	   (doctor-type '((// found) \? hah !
-			  ($ please) ($ continue) \.)))))
-	   
-(defun doctor-sports ()  (doctor-type ($ sportslst)))
-
-(defun doctor-math () (doctor-type ($ mathlst)))
-
-(defun doctor-zippy ()
-  (cond (zippy-flag (doctor-type ($ zippylst)))
-	(t (setq zippy-flag t)
-	   (doctor-type '(yow! are we interactive yet \?)))))
-
-
-(defun doctor-chat () (doctor-type ($ chatlst)))
-
-(defun doctor-strangelove ()
-  (interactive)
-  (insert "Mein fuehrer!!\n")
-  (doctor-read-print))
-
-;;; doctor.el ends here
diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el
deleted file mode 100644
index 2e6ee21b1c1..00000000000
--- a/lisp/play/dunnet.el
+++ /dev/null
@@ -1,3343 +0,0 @@
-;;; dunnet.el --- Text adventure for Emacs
-
-;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
-
-;; Author: Ron Schnell <ronnie@media.mit.edu>
-;; Created: 25 Jul 1992
-;; Version: 2.0
-;; Keywords: games
-
-;; 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 game can be run in batch mode.  To do this, use:
-;;    emacs -batch -l dunnet
-
-;;; !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 
-;;;  The log file should be set for your system, and it must
-;;;  be writable by all.
-
-
-(defvar dun-log-file "/usr/local/dunnet.score"
-  "Name of file to store score information for dunnet.")
-
-(if nil
-    (eval-and-compile (setq byte-compile-warnings nil)))
-
-(eval-when-compile
- (require 'cl))
-
-;;;; Mode definitions for interactive mode
-
-(defun dun-mode ()
-  "Major mode for running dunnet."
-  (interactive)
-  (text-mode)
-  (make-local-variable 'scroll-step)
-  (setq scroll-step 2)
-  (use-local-map dungeon-mode-map)
-  (setq major-mode 'dungeon-mode)
-  (setq mode-name "Dungeon"))
-
-(defun dun-parse (arg)
-  "Function called when return is pressed in interactive mode to parse line."
-  (interactive "*p")
-  (beginning-of-line)
-  (setq beg (+ (point) 1))
-  (end-of-line)
-  (if (and (not (= beg (point))) (not (< (point) beg))
-	   (string= ">" (buffer-substring (- beg 1) beg)))
-      (progn
-	(setq line (downcase (buffer-substring beg (point))))
-	(princ line)
-	(if (eq (dun-vparse dun-ignore dun-verblist line) -1)
-	    (dun-mprinc "I don't understand that.\n")))
-    (goto-char (point-max))
-    (dun-mprinc "\n"))
-    (dun-messages))
-    
-(defun dun-messages ()
-  (if dun-dead
-      (text-mode)
-    (if (eq dungeon-mode 'dungeon)
-	(progn
-	  (if (not (= room dun-current-room))
-	      (progn
-		(dun-describe-room dun-current-room)
-		(setq room dun-current-room)))
-	  (dun-fix-screen)
-	  (dun-mprinc ">")))))
-
-
-;;;###autoload
-(defun dunnet ()
-  "Switch to *dungeon* buffer and start game."
-  (interactive)
-  (switch-to-buffer "*dungeon*")
-  (insert "This version of Dunnet has been censored for your protection
-in accord with the Communications Decency Act.\n\n")
-  (dun-mode)
-  (setq dun-dead nil)
-  (setq room 0)
-  (dun-messages))
-
-;;;;
-;;;; This section contains all of the verbs and commands.
-;;;;
-
-;;; Give long description of room if haven't been there yet.  Otherwise
-;;; short.  Also give long if we were called with negative room number.
-
-(defun dun-describe-room (room)
-  (if (and (not (member (abs room) dun-light-rooms)) 
-	   (not (member obj-lamp dun-inventory)))
-      (dun-mprincl "It is pitch dark.  You are likely to be eaten by a grue.")
-    (dun-mprincl (cadr (nth (abs room) dun-rooms)))
-    (if (and (and (or (member room dun-visited) 
-		      (string= dun-mode "dun-superb")) (> room 0))
-	     (not (string= dun-mode "long")))
-	nil
-      (dun-mprinc (car (nth (abs room) dun-rooms)))
-    (dun-mprinc "\n"))
-    (if (not (string= dun-mode "long"))
-	(if (not (member (abs room) dun-visited))
-	    (setq dun-visited (append (list (abs room)) dun-visited))))
-    (dolist (xobjs (nth dun-current-room dun-room-objects))
-      (if (= xobjs obj-special)
-	  (dun-special-object)
-	(if (>= xobjs 0)
-	    (dun-mprincl (car (nth xobjs dun-objects)))
-	  (if (not (and (= xobjs obj-bus) dun-inbus))
-	      (progn
-		(dun-mprincl (car (nth (abs xobjs) dun-perm-objects)))))))
-      (if (and (= xobjs obj-jar) dun-jar)
-	  (progn
-	    (dun-mprincl "The jar contains:")
-	    (dolist (x dun-jar)
-	      (dun-mprinc "     ")
-	      (dun-mprincl (car (nth x dun-objects)))))))
-    (if (and (member obj-bus (nth dun-current-room dun-room-objects)) dun-inbus)
-	(dun-mprincl "You are on the bus."))))
-
-;;; There is a special object in the room.  This object's description,
-;;; or lack thereof, depends on certain conditions.
-
-(defun dun-special-object ()
-  (if (= dun-current-room computer-room)
-      (if dun-computer
-	  (dun-mprincl 
-"The panel lights are flashing in a seemingly organized pattern.")
-	(dun-mprincl "The panel lights are steady and motionless.")))
-
-  (if (and (= dun-current-room red-room) 
-	   (not (member obj-towel (nth red-room dun-room-objects))))
-      (dun-mprincl "There is a hole in the floor here."))
-
-  (if (and (= dun-current-room marine-life-area) dun-black)
-      (dun-mprincl 
-"The room is lit by a black light, causing the fish, and some of 
-your objects, to give off an eerie glow."))
-  (if (and (= dun-current-room fourth-vermont-intersection) dun-hole)
-      (progn
-	(if (not dun-inbus)
-	    (progn
-	      (dun-mprincl"You fall into a hole in the ground.")
-	      (setq dun-current-room vermont-station)
-	      (dun-describe-room vermont-station))
-	  (progn
-	    (dun-mprincl 
-"The bus falls down a hole in the ground and explodes.")
-	    (dun-die "burning")))))
-
-  (if (> dun-current-room endgame-computer-room)
-      (progn
-	(if (not dun-correct-answer)
-	    (dun-endgame-question)
-	  (dun-mprincl "Your question is:")
-	  (dun-mprincl dun-endgame-question))))
-
-  (if (= dun-current-room sauna)
-      (progn
-	(dun-mprincl (nth dun-sauna-level '(
-"It is normal room temperature in here."
-"It is luke warm in here."
-"It is comfortably hot in here."
-"It is refreshingly hot in here."
-"You are dead now.")))
-	(if (and (= dun-sauna-level 3) 
-		 (or (member obj-rms dun-inventory)
-		     (member obj-rms (nth dun-current-room dun-room-objects))))
-	    (progn
-	      (dun-mprincl 
-"You notice the wax on your statuette beginning to melt, until it completely
-melts off.  You are left with a beautiful diamond!")
-	      (if (member obj-rms dun-inventory)
-		  (progn
-		    (dun-remove-obj-from-inven obj-rms)
-		    (setq dun-inventory (append dun-inventory 
-						(list obj-diamond))))
-		(dun-remove-obj-from-room dun-current-room obj-rms)
-		(dun-replace dun-room-objects dun-current-room
-			 (append (nth dun-current-room dun-room-objects)
-				 (list obj-diamond))))
-	      (if (member obj-floppy dun-inventory)
-		  (progn
-		    (dun-mprincl
-"You notice your floppy disk beginning to melt.  As you grab for it, the 
-disk bursts into flames, and disintegrates.")
-		    (dun-remove-obj-from-inven obj-floppy)
-		    (dun-remove-obj-from-room dun-current-room obj-floppy)))))
-	)))
-
-(defun dun-die (murderer)
-  (dun-mprinc "\n")
-  (if murderer
-      (dun-mprincl "You are dead."))
-  (dun-do-logfile 'dun-die murderer)
-  (dun-score nil)
-  (setq dun-dead t))
-
-(defun dun-quit (args)
-  (dun-die nil))
-
-;;; Print every object in player's inventory.  Special case for the jar,
-;;; as we must also print what is in it.
-
-(defun dun-inven (args)
-  (dun-mprinc "You currently have:")
-  (dun-mprinc "\n")
-  (dolist (curobj dun-inventory)
-    (if curobj
-	(progn
-	  (dun-mprincl (cadr (nth curobj dun-objects)))
-	  (if (and (= curobj obj-jar) dun-jar)
-	      (progn
-		(dun-mprincl "The jar contains:")
-		(dolist (x dun-jar)
-		  (dun-mprinc "     ")
-		  (dun-mprincl (cadr (nth x dun-objects))))))))))
-
-(defun dun-shake (obj)
-  (let (objnum)
-    (when (setq objnum (dun-objnum-from-args-std obj))
-      (if (member objnum dun-inventory)
-	  (progn
-;;;	If shaking anything will do anything, put here.
-	    (dun-mprinc "Shaking ")
-	    (dun-mprinc (downcase (cadr (nth objnum dun-objects))))
-	    (dun-mprinc " seems to have no effect.")
-	    (dun-mprinc "\n")
-	    )
-	(if (and (not (member objnum (nth dun-current-room dun-room-silents)))
-		 (not (member objnum (nth dun-current-room dun-room-objects))))
-	    (dun-mprincl "I don't see that here.")
-;;;     Shaking trees can be deadly
-	  (if (= objnum obj-tree)
-	      (progn
-		(dun-mprinc
- "You begin to shake a tree, and notice a coconut begin to fall from the air.
-As you try to get your hand up to block it, you feel the impact as it lands
-on your head.")
-		(dun-die "a coconut"))
-	    (if (= objnum obj-bear)
-		(progn
-		  (dun-mprinc
-"As you go up to the bear, it removes your head and places it on the ground.")
-		  (dun-die "a bear"))
-	      (if (< objnum 0)
-		  (dun-mprincl "You cannot shake that.")
-		(dun-mprincl "You don't have that.")))))))))
-
-
-(defun dun-drop (obj)
-  (if dun-inbus
-      (dun-mprincl "You can't drop anything while on the bus.")
-  (let (objnum ptr)
-    (when (setq objnum (dun-objnum-from-args-std obj))
-      (if (not (setq ptr (member objnum dun-inventory)))
-	  (dun-mprincl "You don't have that.")
-	(progn
-	  (dun-remove-obj-from-inven objnum)
-	  (dun-replace dun-room-objects dun-current-room
-		   (append (nth dun-current-room dun-room-objects)
-			   (list objnum)))
-	  (dun-mprincl "Done.")
-	  (if (member objnum (list obj-food obj-weight obj-jar))
-	      (dun-drop-check objnum))))))))
-
-;;; Dropping certain things causes things to happen.
-
-(defun dun-drop-check (objnum)
-  (if (and (= objnum obj-food) (= room bear-hangout)
-	   (member obj-bear (nth bear-hangout dun-room-objects)))
-      (progn
-	(dun-mprincl
-"The bear takes the food and runs away with it. He left something behind.")
-	(dun-remove-obj-from-room dun-current-room obj-bear)
-	(dun-remove-obj-from-room dun-current-room obj-food)
-	(dun-replace dun-room-objects dun-current-room
-		 (append (nth dun-current-room dun-room-objects)
-			 (list obj-key)))))
-
-  (if (and (= objnum obj-jar) (member obj-nitric dun-jar) 
-	   (member obj-glycerine dun-jar))
-      (progn
-	(dun-mprincl 
-	 "As the jar impacts the ground it explodes into many pieces.")
-	(setq dun-jar nil)
-	(dun-remove-obj-from-room dun-current-room obj-jar)
-	(if (= dun-current-room fourth-vermont-intersection)
-	    (progn
-	      (setq dun-hole t)
-	      (setq dun-current-room vermont-station)
-	      (dun-mprincl 
-"The explosion causes a hole to open up in the ground, which you fall
-through.")))))
-
-  (if (and (= objnum obj-weight) (= dun-current-room maze-button-room))
-      (dun-mprincl "A passageway opens.")))
-
-;;; Give long description of current room, or an object.
-      
-(defun dun-examine (obj)
-  (let (objnum)
-    (setq objnum (dun-objnum-from-args obj))
-    (if (eq objnum obj-special)
-	(dun-describe-room (* dun-current-room -1))
-      (if (and (eq objnum obj-computer)
-	       (member obj-pc (nth dun-current-room dun-room-silents)))
-	  (dun-examine '("pc"))
-	(if (eq objnum nil)
-	    (dun-mprincl "I don't know what that is.")
-	  (if (and (not (member objnum 
-				(nth dun-current-room dun-room-objects)))
-		   (not (member objnum 
-				(nth dun-current-room dun-room-silents)))
-		   (not (member objnum dun-inventory)))
-	      (dun-mprincl "I don't see that here.")
-	    (if (>= objnum 0)
-		(if (and (= objnum obj-bone) 
-			 (= dun-current-room marine-life-area) dun-black)
-		    (dun-mprincl 
-"In this light you can see some writing on the bone.  It says:
-For an explosive time, go to Fourth St. and Vermont.")
-		  (if (nth objnum dun-physobj-desc)
-		      (dun-mprincl (nth objnum dun-physobj-desc))
-		    (dun-mprincl "I see nothing special about that.")))
-	      (if (nth (abs objnum) dun-permobj-desc)
-		  (progn
-		    (dun-mprincl (nth (abs objnum) dun-permobj-desc)))
-		(dun-mprincl "I see nothing special about that.")))))))))
-
-(defun dun-take (obj)
-  (if dun-inbus
-      (dun-mprincl "You can't take anything while on the bus.")
-  (setq obj (dun-firstword obj))
-  (if (not obj)
-      (dun-mprincl "You must supply an object.")
-    (if (string= obj "all")
-	(let (gotsome)
-	  (setq gotsome nil)
-	  (dolist (x (nth dun-current-room dun-room-objects))
-	    (if (and (>= x 0) (not (= x obj-special)))
-		(progn
-		  (setq gotsome t)
-		  (dun-mprinc (cadr (nth x dun-objects)))
-		  (dun-mprinc ": ")
-		  (dun-take-object x))))
-	  (if (not gotsome)
-	      (dun-mprincl "Nothing to take.")))
-      (let (objnum)
-	(setq objnum (cdr (assq (intern obj) dun-objnames)))
-	(if (eq objnum nil)
-	    (progn
-	      (dun-mprinc "I don't know what that is.")
-	      (dun-mprinc "\n"))
-	  (dun-take-object objnum)))))))
-
-(defun dun-take-object (objnum)
-  (if (and (member objnum dun-jar) (member obj-jar dun-inventory))
-      (let (newjar)
-	(dun-mprincl "You remove it from the jar.")
-	(setq newjar nil)
-	(dolist (x dun-jar)
-	  (if (not (= x objnum))
-	      (setq newjar (append newjar (list x)))))
-	(setq dun-jar newjar)
-	(setq dun-inventory (append dun-inventory (list objnum))))
-    (if (not (member objnum (nth dun-current-room dun-room-objects)))
-	(if (not (member objnum (nth dun-current-room dun-room-silents)))
-	    (dun-mprinc "I do not see that here.")
-	  (dun-try-take objnum))
-      (if (>= objnum 0)
-	  (progn
-	    (if (and (car dun-inventory) 
-		     (> (+ (dun-inven-weight) (nth objnum dun-object-lbs)) 11))
-		(dun-mprinc "Your load would be too heavy.")
-	      (setq dun-inventory (append dun-inventory (list objnum)))
-	      (dun-remove-obj-from-room dun-current-room objnum)
-	      (dun-mprinc "Taken.  ")
-	      (if (and (= objnum obj-towel) (= dun-current-room red-room))
-		  (dun-mprinc 
-		   "Taking the towel reveals a hole in the floor."))))
-	(dun-try-take objnum)))
-    (dun-mprinc "\n")))
-
-(defun dun-inven-weight ()
-  (let (total)
-    (setq total 0)
-    (dolist (x dun-jar)
-      (setq total (+ total (nth x dun-object-lbs))))
-    (dolist (x dun-inventory)
-      (setq total (+ total (nth x dun-object-lbs)))) total))
-
-;;; We try to take an object that is untakable.  Print a message
-;;; depending on what it is.
-
-(defun dun-try-take (obj)
-  (dun-mprinc "You cannot take that."))
-
-(defun dun-dig (args)
-  (if dun-inbus
-      (dun-mprincl "You can't dig while on the bus.")
-  (if (not (member 0 dun-inventory))
-      (dun-mprincl "You have nothing with which to dig.")
-    (if (not (nth dun-current-room dun-diggables))
-	(dun-mprincl "Digging here reveals nothing.")
-      (dun-mprincl "I think you found something.")
-      (dun-replace dun-room-objects dun-current-room
-	       (append (nth dun-current-room dun-room-objects)
-		       (nth dun-current-room dun-diggables)))
-      (dun-replace dun-diggables dun-current-room nil)))))
-
-(defun dun-climb (obj)
-  (let (objnum)
-    (setq objnum (dun-objnum-from-args obj))
-    (cond ((null objnum)
-	   (dun-mprincl "I don't know that name."))
-	  ((and (not (eq objnum obj-special))
-		(not (member objnum (nth dun-current-room dun-room-objects)))
-		(not (member objnum (nth dun-current-room dun-room-silents)))
-		(not (member objnum dun-inventory)))
-	   (dun-mprincl "I don't see that here."))
-	  ((and (eq objnum obj-special)
-		(not (member obj-tree (nth dun-current-room dun-room-silents))))
-	   (dun-mprincl "There is nothing here to climb."))
-	  ((and (not (eq objnum obj-tree)) (not (eq objnum obj-special)))
-	   (dun-mprincl "You can't climb that."))
-	  (t
-	   (dun-mprincl
-	    "You manage to get about two feet up the tree and fall back down.  You
-notice that the tree is very unsteady.")))))
-
-(defun dun-eat (obj)
-  (let (objnum)
-    (when (setq objnum (dun-objnum-from-args-std obj))
-      (if (not (member objnum dun-inventory))
-	  (dun-mprincl "You don't have that.")
-	(if (not (= objnum obj-food))
-	    (progn
-	      (dun-mprinc "You forcefully shove ")
-	      (dun-mprinc (downcase (cadr (nth objnum dun-objects))))
-	      (dun-mprincl " down your throat, and start choking.")
-	      (dun-die "choking"))
-	  (dun-mprincl "That tasted horrible.")
-	  (dun-remove-obj-from-inven obj-food))))))
-
-(defun dun-put (args)
-  (if dun-inbus
-      (dun-mprincl "You can't do that while on the bus")
-    (let (newargs objnum objnum2 obj)
-      (setq newargs (dun-firstwordl args))
-      (if (not newargs)
-	  (dun-mprincl "You must supply an object")
-	(setq obj (intern (car newargs)))
-	(setq objnum (cdr (assq obj dun-objnames)))
-	(if (not objnum)
-	    (dun-mprincl "I don't know what that object is.")
-	  (if (not (member objnum dun-inventory))
-	      (dun-mprincl "You don't have that.")
-	    (setq newargs (dun-firstwordl (cdr newargs)))
-	    (setq newargs (dun-firstwordl (cdr newargs)))
-	    (if (not newargs)
-		(dun-mprincl "You must supply an indirect object.")
-	      (setq objnum2 (cdr (assq (intern (car newargs)) dun-objnames)))
-	      (if (and (eq objnum2 obj-computer) (= dun-current-room pc-area))
-		  (setq objnum2 obj-pc))
-	      (if (not objnum2)
-		  (dun-mprincl "I don't know what that indirect object is.")
-		(if (and (not (member objnum2 
-				      (nth dun-current-room dun-room-objects)))
-			 (not (member objnum2 
-				      (nth dun-current-room dun-room-silents)))
-			 (not (member objnum2 dun-inventory)))
-		    (dun-mprincl "That indirect object is not here.")
-		  (dun-put-objs objnum objnum2))))))))))
-
-(defun dun-put-objs (obj1 obj2)
-  (if (and (= obj2 obj-drop) (not dun-nomail))
-      (setq obj2 obj-chute))
-
-  (if (= obj2 obj-disposal) (setq obj2 obj-chute))
-
-  (if (and (= obj1 obj-cpu) (= obj2 obj-computer))
-      (progn
-	(dun-remove-obj-from-inven obj-cpu)
-	(setq dun-computer t)
-	(dun-mprincl
-"As you put the CPU board in the computer, it immediately springs to life.
-The lights start flashing, and the fans seem to startup."))
-    (if (and (= obj1 obj-weight) (= obj2 obj-button))
-	(dun-drop '("weight"))
-      (if (= obj2 obj-jar)                 ;; Put something in jar
-	  (if (not (member obj1 (list obj-paper obj-diamond obj-emerald
-				      obj-license obj-coins obj-egg
-				      obj-nitric obj-glycerine)))
-	      (dun-mprincl "That will not fit in the jar.")
-	    (dun-remove-obj-from-inven obj1)
-	    (setq dun-jar (append dun-jar (list obj1)))
-	    (dun-mprincl "Done."))
-	(if (= obj2 obj-chute)                 ;; Put something in chute
-	    (progn
-	      (dun-remove-obj-from-inven obj1)
-	      (dun-mprincl 
-"You hear it slide down the chute and off into the distance.")
-	      (dun-put-objs-in-treas (list obj1)))
-	  (if (= obj2 obj-box)              ;; Put key in key box
-	      (if (= obj1 obj-key)
-		  (progn
-		    (dun-mprincl
-"As you drop the key, the box begins to shake.  Finally it explodes
-with a bang.  The key seems to have vanished!")
-		    (dun-remove-obj-from-inven obj1)
-		    (dun-replace dun-room-objects computer-room (append
-							(nth computer-room
-							     dun-room-objects)
-							(list obj1)))
-		    (dun-remove-obj-from-room dun-current-room obj-box)
-		    (setq dun-key-level (1+ dun-key-level)))
-		(dun-mprincl "You can't put that in the key box!"))
-
-	    (if (and (= obj1 obj-floppy) (= obj2 obj-pc))
-		(progn
-		  (setq dun-floppy t)
-		  (dun-remove-obj-from-inven obj1)
-		  (dun-mprincl "Done."))
-
-	      (if (= obj2 obj-urinal)                   ;; Put object in urinal
-		  (progn
-		    (dun-remove-obj-from-inven obj1)
-		    (dun-replace dun-room-objects urinal (append 
-						  (nth urinal dun-room-objects)
-						   (list obj1)))
-		    (dun-mprincl
-		     "You hear it plop down in some water below."))
-		(if (= obj2 obj-mail)
-		    (dun-mprincl "The mail chute is locked.")
-		  (if (member obj1 dun-inventory)
-		      (dun-mprincl 
-"I don't know how to combine those objects.  Perhaps you should
-just try dropping it.")
-		    (dun-mprincl"You can't put that there.")))))))))))
-
-(defun dun-type (args)
-  (if (not (= dun-current-room computer-room))
-      (dun-mprincl "There is nothing here on which you could type.")
-    (if (not dun-computer)
-	(dun-mprincl 
-"You type on the keyboard, but your characters do not even echo.")
-      (dun-unix-interface))))
-
-;;; Various movement directions
-
-(defun dun-n (args)
-  (dun-move north))
-
-(defun dun-s (args)
-  (dun-move south))
-
-(defun dun-e (args)
-  (dun-move east))
-
-(defun dun-w (args)
-  (dun-move west))
-
-(defun dun-ne (args)
-  (dun-move northeast))
-
-(defun dun-se (args)
-  (dun-move southeast))
-
-(defun dun-nw (args)
-  (dun-move northwest))
-
-(defun dun-sw (args)
-  (dun-move southwest))
-
-(defun dun-up (args)
-  (dun-move up))
-
-(defun dun-down (args)
-  (dun-move down))
-
-(defun dun-in (args)
-  (dun-move in))
-
-(defun dun-out (args)
-  (dun-move out))
-
-(defun dun-go (args)
-  (if (or (not (car args)) 
-	  (eq (dun-doverb dun-ignore dun-verblist (car args) 
-			  (cdr (cdr args))) -1))
-      (dun-mprinc "I don't understand where you want me to go.\n")))
-
-;;; Uses the dungeon-map to figure out where we are going.  If the
-;;; requested direction yields 255, we know something special is
-;;; supposed to happen, or perhaps you can't go that way unless
-;;; certain conditions are met.
-
-(defun dun-move (dir)
-  (if (and (not (member dun-current-room dun-light-rooms)) 
-	   (not (member obj-lamp dun-inventory)))
-      (progn
-	(dun-mprinc 
-"You trip over a grue and fall into a pit and break every bone in your
-body.")
-	(dun-die "a grue"))
-    (let (newroom)
-      (setq newroom (nth dir (nth dun-current-room dungeon-map)))
-      (if (eq newroom -1)
-	  (dun-mprinc "You can't go that way.\n")
-	(if (eq newroom 255)
-	    (dun-special-move dir)
-	  (setq room -1)
-	  (setq dun-lastdir dir)
-	  (if dun-inbus
-	      (progn
-		(if (or (< newroom 58) (> newroom 83))
-		    (dun-mprincl "The bus cannot go this way.")
-		  (dun-mprincl 
-		   "The bus lurches ahead and comes to a screeching halt.")
-		  (dun-remove-obj-from-room dun-current-room obj-bus)
-		  (setq dun-current-room newroom)
-		  (dun-replace dun-room-objects newroom
-			   (append (nth newroom dun-room-objects)
-				   (list obj-bus)))))
-	    (setq dun-current-room newroom)))))))
-
-;;; Movement in this direction causes something special to happen if the
-;;; right conditions exist.  It may be that you can't go this way unless
-;;; you have a key, or a passage has been opened.
-
-;;; coding note: Each check of the current room is on the same 'if' level,
-;;; i.e. there aren't else's.  If two rooms next to each other have
-;;; specials, and they are connected by specials, this could cause
-;;; a problem.  Be careful when adding them to consider this, and
-;;; perhaps use else's.
-
-(defun dun-special-move (dir)
-  (if (= dun-current-room building-front)
-      (if (not (member obj-key dun-inventory))
-	  (dun-mprincl "You don't have a key that can open this door.")
-	(setq dun-current-room old-building-hallway))
-    (if (= dun-current-room north-end-of-cave-passage)
-	(let (combo)
-	  (dun-mprincl 
-"You must type a 3 digit combination code to enter this room.")
-	  (dun-mprinc "Enter it here: ")
-	  (setq combo (dun-read-line))
-	  (if (not dun-batch-mode)
-	      (dun-mprinc "\n"))
-	  (if (string= combo dun-combination)
-	      (setq dun-current-room gamma-computing-center)
-	    (dun-mprincl "Sorry, that combination is incorrect."))))
-
-    (if (= dun-current-room bear-hangout)
-	(if (member obj-bear (nth bear-hangout dun-room-objects))
-	    (progn
-	      (dun-mprinc 
-"The bear is very annoyed that you would be so presumptuous as to try
-and walk right by it.  He tells you so by tearing your head off.
-")
-	      (dun-die "a bear"))
-	  (dun-mprincl "You can't go that way.")))
-
-    (if (= dun-current-room vermont-station)
-	(progn
-	  (dun-mprincl
-"As you board the train it immediately leaves the station.  It is a very
-bumpy ride.  It is shaking from side to side, and up and down.  You
-sit down in one of the chairs in order to be more comfortable.")
-	  (dun-mprincl
-"\nFinally the train comes to a sudden stop, and the doors open, and some
-force throws you out.  The train speeds away.\n")
-	  (setq dun-current-room museum-station)))
-
-    (if (= dun-current-room old-building-hallway)
-	(if (and (member obj-key dun-inventory)
-		 (> dun-key-level 0))
-	    (setq dun-current-room meadow)
-	  (dun-mprincl "You don't have a key that can open this door.")))
-
-    (if (and (= dun-current-room maze-button-room) (= dir northwest))
-	(if (member obj-weight (nth maze-button-room dun-room-objects))
-	    (setq dun-current-room 18)
-	  (dun-mprincl "You can't go that way.")))
-
-    (if (and (= dun-current-room maze-button-room) (= dir up))
-	(if (member obj-weight (nth maze-button-room dun-room-objects))
-	    (dun-mprincl "You can't go that way.")
-	  (setq dun-current-room weight-room)))
-
-    (if (= dun-current-room classroom)
-	(dun-mprincl "The door is locked."))
-
-    (if (or (= dun-current-room lakefront-north) 
-	    (= dun-current-room lakefront-south))
-	(dun-swim nil))
-
-    (if (= dun-current-room reception-area)
-	(if (not (= dun-sauna-level 3))
-	    (setq dun-current-room health-club-front)
-	  (dun-mprincl
-"As you exit the building, you notice some flames coming out of one of the
-windows.  Suddenly, the building explodes in a huge ball of fire.  The flames
-engulf you, and you burn to death.")
-	  (dun-die "burning")))
-
-    (if (= dun-current-room red-room)
-	(if (not (member obj-towel (nth red-room dun-room-objects)))
-	    (setq dun-current-room long-n-s-hallway)
-	  (dun-mprincl "You can't go that way.")))
-
-    (if (and (> dir down) (> dun-current-room gamma-computing-center) 
-	     (< dun-current-room museum-lobby))
-	(if (not (member obj-bus (nth dun-current-room dun-room-objects)))
-	    (dun-mprincl "You can't go that way.")
-	  (if (= dir in)
-	      (if (member obj-license dun-inventory)
-		  (progn
-		    (dun-mprincl 
-		     "You board the bus and get in the driver's seat.")
-		    (setq dun-nomail t)
-		    (setq dun-inbus t))
-		(dun-mprincl "You are not licensed for this type of vehicle."))
-	    (dun-mprincl "You hop off the bus.")
-	    (setq dun-inbus nil)))
-      (if (= dun-current-room fifth-oaktree-intersection)
-	  (if (not dun-inbus)
-	      (progn
-		(dun-mprincl "You fall down the cliff and land on your head.")
-		(dun-die "a cliff"))
-	    (dun-mprincl
-"The bus flies off the cliff, and plunges to the bottom, where it explodes.")
-	    (dun-die "a bus accident")))
-      (if (= dun-current-room main-maple-intersection)
-	  (progn
-	    (if (not dun-inbus)
-		(dun-mprincl "The gate will not open.")
-	      (dun-mprincl
-"As the bus approaches, the gate opens and you drive through.")
-	      (dun-remove-obj-from-room main-maple-intersection obj-bus)
-	      (dun-replace dun-room-objects museum-entrance 
-		       (append (nth museum-entrance dun-room-objects)
-			       (list obj-bus)))
-	      (setq dun-current-room museum-entrance)))))
-    (if (= dun-current-room cave-entrance)
-	(progn
-	  (dun-mprincl
-"As you enter the room you hear a rumbling noise.  You look back to see
-huge rocks sliding down from the ceiling, and blocking your way out.\n")
-	  (setq dun-current-room misty-room)))))
-
-(defun dun-long (args)
-  (setq dun-mode "long"))
-
-(defun dun-turn (obj)
-  (let (objnum direction)
-    (when (setq objnum (dun-objnum-from-args-std obj))
-      (if (not (or (member objnum (nth dun-current-room dun-room-objects))
-		   (member objnum (nth dun-current-room dun-room-silents))))
-	  (dun-mprincl "I don't see that here.")
-	(if (not (= objnum obj-dial))
-	    (dun-mprincl "You can't turn that.")
-	  (setq direction (dun-firstword (cdr obj)))
-	  (if (or (not direction) 
-		  (not (or (string= direction "clockwise")
-			   (string= direction "counterclockwise"))))
-	      (dun-mprincl "You must indicate clockwise or counterclockwise.")
-	    (if (string= direction "clockwise")
-		(setq dun-sauna-level (+ dun-sauna-level 1))
-	      (setq dun-sauna-level (- dun-sauna-level 1)))
-	    
-	    (if (< dun-sauna-level 0)
-		(progn
-		  (dun-mprincl 
-		   "The dial will not turn further in that direction.")
-		  (setq dun-sauna-level 0))
-	      (dun-sauna-heat))))))))
-
-(defun dun-sauna-heat ()
-  (if (= dun-sauna-level 0)
-      (dun-mprincl 
-       "The temperature has returned to normal room temperature."))
-  (if (= dun-sauna-level 1)
-      (dun-mprincl "It is now luke warm in here.  You begin to sweat."))
-  (if (= dun-sauna-level 2)
-      (dun-mprincl "It is pretty hot in here.  It is still very comfortable."))
-  (if (= dun-sauna-level 3)
-      (progn
-	(dun-mprincl 
-"It is now very hot.  There is something very refreshing about this.")
-	(if (or (member obj-rms dun-inventory) 
-		(member obj-rms (nth dun-current-room dun-room-objects)))
-	    (progn
-	      (dun-mprincl 
-"You notice the wax on your statuette beginning to melt, until it completely
-melts off.  You are left with a beautiful diamond!")
-	      (if (member obj-rms dun-inventory)
-		  (progn
-		    (dun-remove-obj-from-inven obj-rms)
-		    (setq dun-inventory (append dun-inventory 
-						(list obj-diamond))))
-		(dun-remove-obj-from-room dun-current-room obj-rms)
-		(dun-replace dun-room-objects dun-current-room
-			 (append (nth dun-current-room dun-room-objects)
-				 (list obj-diamond))))))
-	(if (or (member obj-floppy dun-inventory)
-		(member obj-floppy (nth dun-current-room dun-room-objects)))
-	    (progn
-	      (dun-mprincl
-"You notice your floppy disk beginning to melt.  As you grab for it, the 
-disk bursts into flames, and disintegrates.")
-	      (if (member obj-floppy dun-inventory)
-		  (dun-remove-obj-from-inven obj-floppy)
-		(dun-remove-obj-from-room dun-current-room obj-floppy))))))
-
-  (if (= dun-sauna-level 4)
-      (progn
-	(dun-mprincl 
-"As the dial clicks into place, you immediately burst into flames.")
-	(dun-die "burning"))))
-
-(defun dun-press (obj)
-  (let (objnum)
-    (when (setq objnum (dun-objnum-from-args-std obj))
-      (if (not (or (member objnum (nth dun-current-room dun-room-objects))
-		   (member objnum (nth dun-current-room dun-room-silents))))
-	  (dun-mprincl "I don't see that here.")
-	(if (not (member objnum (list obj-button obj-switch)))
-	    (progn
-	      (dun-mprinc "You can't ")
-	      (dun-mprinc (car line-list))
-	      (dun-mprincl " that."))
-	  (if (= objnum obj-button)
-	      (dun-mprincl
-"As you press the button, you notice a passageway open up, but
-as you release it, the passageway closes."))
-	  (if (= objnum obj-switch)
-	      (if dun-black
-		  (progn
-		    (dun-mprincl "The button is now in the off position.")
-		    (setq dun-black nil))
-		(dun-mprincl "The button is now in the on position.")
-		(setq dun-black t))))))))
-
-(defun dun-swim (args)
-  (if (not (member dun-current-room (list lakefront-north lakefront-south)))
-      (dun-mprincl "I see no water!")
-    (if (not (member obj-life dun-inventory))
-	(progn
-	  (dun-mprincl 
-"You dive in the water, and at first notice it is quite cold.  You then
-start to get used to it as you realize that you never really learned how
-to swim.")
-	  (dun-die "drowning"))
-      (if (= dun-current-room lakefront-north)
-	  (setq dun-current-room lakefront-south)
-	(setq dun-current-room lakefront-north)))))
-
-
-(defun dun-score (args)
-  (if (not dun-endgame)
-      (let (total)
-	(setq total (dun-reg-score))
-	(dun-mprinc "You have scored ")
-	(dun-mprinc total)
-	(dun-mprincl " out of a possible 90 points.") total)
-    (dun-mprinc "You have scored ")
-    (dun-mprinc (dun-endgame-score))
-    (dun-mprincl " endgame points out of a possible 110.")
-    (if (= (dun-endgame-score) 110)
-	(dun-mprincl 
-"\n\nCongratulations.  You have won.  The wizard password is 'moby'"))))
-
-(defun dun-help (args)
-  (dun-mprincl
-"Welcome to dunnet (2.0), by Ron Schnell (ronnie@media.mit.edu).
-Here is some useful information (read carefully because there are one
-or more clues in here):
-- If you have a key that can open a door, you do not need to explicitly
-  open it.  You may just use 'in' or walk in the direction of the door.
-
-- If you have a lamp, it is always lit.
-
-- You will not get any points until you manage to get treasures to a certain
-  place.  Simply finding the treasures is not good enough.  There is more
-  than one way to get a treasure to the special place.  It is also
-  important that the objects get to the special place *unharmed* and
-  *untarnished*.  You can tell if you have successfully transported the
-  object by looking at your score, as it changes immediately.  Note that
-  an object can become harmed even after you have received points for it.
-  If this happens, your score will decrease, and in many cases you can never
-  get credit for it again.
-
-- You can save your game with the 'save' command, and use restore it
-  with the 'restore' command.
-
-- There are no limits on lengths of object names.
-
-- Directions are: north,south,east,west,northeast,southeast,northwest,
-                  southwest,up,down,in,out.
-
-- These can be abbreviated: n,s,e,w,ne,se,nw,sw,u,d,in,out.
-
-- If you go down a hole in the floor without an aid such as a ladder,
-  you probably won't be able to get back up the way you came, if at all.
-
-- To run this game in batch mode (no emacs window), use:
-     emacs -batch -l dunnet
-
-If you have questions or comments, please contact ronnie@media.mit.edu."))
-
-(defun dun-flush (args)
-  (if (not (= dun-current-room bathroom))
-      (dun-mprincl "I see nothing to flush.")
-    (dun-mprincl "Whoooosh!!")
-    (dun-put-objs-in-treas (nth urinal dun-room-objects))
-    (dun-replace dun-room-objects urinal nil)))
-
-(defun dun-urinate (args)
-  (if (not (= dun-current-room bathroom))
-      (dun-mprincl "You can't do that here, don't even bother trying.")
-    (if (not dun-gottago)
-	(dun-mprincl "I'm afraid you don't have to go now.")
-      (dun-mprincl "That was refreshing.")
-      (setq dun-gottago nil)
-      (dun-replace dun-room-objects urinal (append 
-					    (nth urinal dun-room-objects)
-					    (list obj-URINE))))))
-
-
-(defun dun-sleep (args)
-  (if (not (= dun-current-room bedroom))
-      (dun-mprincl
-"You try to go to sleep while standing up here, but can't seem to do it.")
-    (setq dun-gottago t)
-    (dun-mprincl
-"As soon as you start to doze off you begin dreaming.  You see images of
-workers digging caves, slaving in the humid heat.  Then you see yourself
-as one of these workers.  While no one is looking, you leave the group
-and walk into a room.  The room is bare except for a horseshoe
-shaped piece of stone in the center.  You see yourself digging a hole in
-the ground, then putting some kind of treasure in it, and filling the hole
-with dirt again.  After this, you immediately wake up.")))
-
-(defun dun-break (obj)
-  (let (objnum)
-    (if (not (member obj-axe dun-inventory))
-	(dun-mprincl "You have nothing you can use to break things.")
-      (when (setq objnum (dun-objnum-from-args-std obj))
-	(if (member objnum dun-inventory)
-	    (progn
-	      (dun-mprincl
-"You take the object in your hands and swing the axe.  Unfortunately, you miss
-the object and slice off your hand.  You bleed to death.")
-	      (dun-die "an axe"))
-	  (if (not (or (member objnum (nth dun-current-room dun-room-objects))
-		       (member objnum 
-			       (nth dun-current-room dun-room-silents))))
-	      (dun-mprincl "I don't see that here.")
-	    (if (= objnum obj-cable)
-		(progn
-		  (dun-mprincl 
-"As you break the ethernet cable, everything starts to blur.  You collapse
-for a moment, then straighten yourself up.
-")
-		  (dun-replace dun-room-objects gamma-computing-center
-			   (append 
-			    (nth gamma-computing-center dun-room-objects)
-			    dun-inventory))
-		  (if (member obj-key dun-inventory)
-		      (progn
-			(setq dun-inventory (list obj-key))
-			(dun-remove-obj-from-room 
-			 gamma-computing-center obj-key))
-		    (setq dun-inventory nil))
-		  (setq dun-current-room computer-room)
-		  (setq dun-ethernet nil)
-		  (dun-mprincl "Connection closed.")
-		  (dun-unix-interface))
-	      (if (< objnum 0)
-		  (progn
-		    (dun-mprincl "Your axe shatters into a million pieces.")
-		    (dun-remove-obj-from-inven obj-axe))
-		(dun-mprincl "Your axe breaks it into a million pieces.")
-		(dun-remove-obj-from-room dun-current-room objnum)))))))))
-
-(defun dun-drive (args)
-  (if (not dun-inbus)
-      (dun-mprincl "You cannot drive when you aren't in a vehicle.")
-    (dun-mprincl "To drive while you are in the bus, just give a direction.")))
-
-(defun dun-superb (args)
-  (setq dun-mode 'dun-superb))
-
-(defun dun-reg-score ()
-  (let (total)
-    (setq total 0)
-    (dolist (x (nth treasure-room dun-room-objects))
-      (setq total (+ total (nth x dun-object-pts))))
-    (if (member obj-URINE (nth treasure-room dun-room-objects))
-	(setq total 0)) total))
-
-(defun dun-endgame-score ()
-  (let (total)
-    (setq total 0)
-    (dolist (x (nth endgame-treasure-room dun-room-objects))
-      (setq total (+ total (nth x dun-object-pts)))) total))
-
-(defun dun-answer (args)
-  (if (not dun-correct-answer)
-      (dun-mprincl "I don't believe anyone asked you anything.")
-    (setq args (car args))
-    (if (not args)
-	(dun-mprincl "You must give the answer on the same line.")
-      (if (dun-members args dun-correct-answer)
-	  (progn
-	    (dun-mprincl "Correct.")
-	    (if (= dun-lastdir 0)
-		(setq dun-current-room (1+ dun-current-room))
-	      (setq dun-current-room (- dun-current-room 1)))
-	    (setq dun-correct-answer nil))
-	(dun-mprincl "That answer is incorrect.")))))
-
-(defun dun-endgame-question ()
-(if (not dun-endgame-questions)
-    (progn
-      (dun-mprincl "Your question is:")
-      (dun-mprincl "No more questions, just do 'answer foo'.")
-      (setq dun-correct-answer '("foo")))
-  (let (which i newques)
-    (setq i 0)
-    (setq newques nil)
-    (setq which (random (length dun-endgame-questions)))
-    (dun-mprincl "Your question is:")
-    (dun-mprincl (setq dun-endgame-question (car 
-					     (nth which 
-						  dun-endgame-questions))))
-    (setq dun-correct-answer (cdr (nth which dun-endgame-questions)))
-    (while (< i which)
-      (setq newques (append newques (list (nth i dun-endgame-questions))))
-      (setq i (1+ i)))
-    (setq i (1+ which))
-    (while (< i (length dun-endgame-questions))
-      (setq newques (append newques (list (nth i dun-endgame-questions))))
-      (setq i (1+ i)))
-    (setq dun-endgame-questions newques))))
-
-(defun dun-power (args)
-  (if (not (= dun-current-room pc-area))
-      (dun-mprincl "That operation is not applicable here.")
-    (if (not dun-floppy)
-	(dun-dos-no-disk)
-      (dun-dos-interface))))
-
-(defun dun-feed (args)
-  (let (objnum)
-    (when (setq objnum (dun-objnum-from-args-std args))
-      (if (and (= objnum obj-bear) 
-	       (member obj-bear (nth dun-current-room dun-room-objects)))
-	  (progn
-	    (if (not (member obj-food dun-inventory))
-		(dun-mprincl "You have nothing with which to feed it.")
-	      (dun-drop '("food"))))
-	(if (not (or (member objnum (nth dun-current-room dun-room-objects))
-		     (member objnum dun-inventory)
-		     (member objnum (nth dun-current-room dun-room-silents))))
-	    (dun-mprincl "I don't see that here.")
-	  (dun-mprincl "You cannot feed that."))))))
-
-
-;;;;
-;;;;  This section defines various utility functions used
-;;;;  by dunnet.
-;;;;
-
-
-;;; Function which takes a verb and a list of other words.  Calls proper
-;;; function associated with the verb, and passes along the other words.
-
-(defun dun-doverb (dun-ignore dun-verblist verb rest)
-  (if (not verb)
-      nil
-    (if (member (intern verb) dun-ignore)
-	(if (not (car rest)) -1
-	  (dun-doverb dun-ignore dun-verblist (car rest) (cdr rest)))
-      (if (not (cdr (assq (intern verb) dun-verblist))) -1
-	(setq dun-numcmds (1+ dun-numcmds))
-	(eval (list (cdr (assq (intern verb) dun-verblist)) (quote rest)))))))
-
-
-;;; Function to take a string and change it into a list of lowercase words.
-
-(defun dun-listify-string (strin)
-  (let (pos ret-list end-pos)
-    (setq pos 0)
-    (setq ret-list nil)
-    (while (setq end-pos (string-match "[ ,:;]" (substring strin pos)))
-      (setq end-pos (+ end-pos pos))
-      (if (not (= end-pos pos))
-	  (setq ret-list (append ret-list (list 
-					   (downcase
-					    (substring strin pos end-pos))))))
-      (setq pos (+ end-pos 1))) ret-list))
-
-(defun dun-listify-string2 (strin)
-  (let (pos ret-list end-pos)
-    (setq pos 0)
-    (setq ret-list nil)
-    (while (setq end-pos (string-match " " (substring strin pos)))
-      (setq end-pos (+ end-pos pos))
-      (if (not (= end-pos pos))
-	  (setq ret-list (append ret-list (list 
-					   (downcase
-					    (substring strin pos end-pos))))))
-      (setq pos (+ end-pos 1))) ret-list))
-
-(defun dun-replace (list n number)
-  (rplaca (nthcdr n list) number))
-
-
-;;; Get the first non-ignored word from a list.
-
-(defun dun-firstword (list)
-  (if (not (car list))
-      nil
-    (while (and list (member (intern (car list)) dun-ignore))
-      (setq list (cdr list)))
-    (car list)))
-
-(defun dun-firstwordl (list)
-  (if (not (car list))
-      nil
-    (while (and list (member (intern (car list)) dun-ignore))
-      (setq list (cdr list)))
-    list))
-
-;;; parse a line passed in as a string  Call the proper verb with the
-;;; rest of the line passed in as a list.
-
-(defun dun-vparse (dun-ignore dun-verblist line)
-  (dun-mprinc "\n")
-  (setq line-list (dun-listify-string (concat line " ")))
-  (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list)))
-
-(defun dun-parse2 (dun-ignore dun-verblist line)
-  (dun-mprinc "\n")
-  (setq line-list (dun-listify-string2 (concat line " ")))
-  (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list)))
-
-;;; Read a line, in window mode
-
-(defun dun-read-line ()
-  (let (line)
-    (setq line (read-string ""))
-    (dun-mprinc line) line))
-
-;;; Insert something into the window buffer
-
-(defun dun-minsert (string)
-  (if (stringp string)
-      (insert string)
-    (insert (prin1-to-string string))))
-
-;;; Print something out, in window mode
-
-(defun dun-mprinc (string)
-  (if (stringp string)
-      (insert string)
-    (insert (prin1-to-string string))))
-
-;;; In window mode, keep screen from jumping by keeping last line at
-;;; the bottom of the screen.
-
-(defun dun-fix-screen ()
-  (interactive)
-  (forward-line (- 0 (- (window-height) 2 )))
-  (set-window-start (selected-window) (point))
-  (end-of-buffer))
-
-;;; Insert something into the buffer, followed by newline.
-
-(defun dun-minsertl (string)
-  (dun-minsert string)
-  (dun-minsert "\n"))
-
-;;; Print something, followed by a newline.
-
-(defun dun-mprincl (string)
-  (dun-mprinc string)
-  (dun-mprinc "\n"))
-
-;;; Function which will get an object number given the list of
-;;; words in the command, except for the verb.
-
-(defun dun-objnum-from-args (obj)
-  (let (objnum)
-    (setq obj (dun-firstword obj))
-    (if (not obj)
-	obj-special
-      (setq objnum (cdr (assq (intern obj) dun-objnames))))))
-
-(defun dun-objnum-from-args-std (obj)
-  (let (result)
-  (if (eq (setq result (dun-objnum-from-args obj)) obj-special)
-      (dun-mprincl "You must supply an object."))
-  (if (eq result nil)
-      (dun-mprincl "I don't know what that is."))
-  (if (eq result obj-special)
-      nil
-    result)))
-
-;;; Take a short room description, and change spaces and slashes to dashes.
-
-(defun dun-space-to-hyphen (string)
-  (let (space)
-    (if (setq space (string-match "[ /]" string))
-	(progn
-	  (setq string (concat (substring string 0 space) "-"
-			       (substring string (1+ space))))
-	  (dun-space-to-hyphen string))
-      string)))
-
-;;; Given a unix style pathname, build a list of path components (recursive)
-
-(defun dun-get-path (dirstring startlist)
-  (let (slash pos)
-    (if (= (length dirstring) 0)
-	startlist
-      (if (string= (substring dirstring 0 1) "/")
-	  (dun-get-path (substring dirstring 1) (append startlist (list "/")))
-	(if (not (setq slash (string-match "/" dirstring)))
-	    (append startlist (list dirstring))
-	  (dun-get-path (substring dirstring (1+ slash))
-		    (append startlist
-			    (list (substring dirstring 0 slash)))))))))
-
-
-;;; Is a string a member of a string list?
-
-(defun dun-members (string string-list)
-  (let (found)
-    (setq found nil)
-    (dolist (x string-list)
-      (if (string= x string)
-	  (setq found t))) found))
-
-;;; Function to put objects in the treasure room.  Also prints current
-;;; score to let user know he has scored.
-
-(defun dun-put-objs-in-treas (objlist)
-  (let (oscore newscore)
-    (setq oscore (dun-reg-score))
-    (dun-replace dun-room-objects 0 (append (nth 0 dun-room-objects) objlist))
-    (setq newscore (dun-reg-score))
-    (if (not (= oscore newscore))
-	(dun-score nil))))
-
-;;; Load an encrypted file, and eval it.
-
-(defun dun-load-d (filename)
-  (let (old-buffer result)
-    (setq result t)
-    (setq old-buffer (current-buffer))
-    (switch-to-buffer (get-buffer-create "*loadc*"))
-    (erase-buffer)
-    (condition-case nil
-	(insert-file-contents filename)
-      (error (setq result nil)))
-    (unless (not result)
-      (condition-case nil
-	  (dun-rot13)
-	(error (yank)))
-      (eval-current-buffer)
-      (kill-buffer (current-buffer))
-      (switch-to-buffer old-buffer))
-    result))
-
-;;; Functions to remove an object either from a room, or from inventory.
-
-(defun dun-remove-obj-from-room (room objnum)
-  (let (newroom)
-    (setq newroom nil)
-    (dolist (x (nth room dun-room-objects))
-      (if (not (= x objnum))
-	  (setq newroom (append newroom (list x)))))
-    (rplaca (nthcdr room dun-room-objects) newroom)))
-
-(defun dun-remove-obj-from-inven (objnum)
-  (let (new-inven)
-    (setq new-inven nil)
-    (dolist (x dun-inventory)
-      (if (not (= x objnum))
-	  (setq new-inven (append new-inven (list x)))))
-    (setq dun-inventory new-inven)))
-
-
-(let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
-  (setq dun-translate-table (make-vector 256 0))
-  (while (< i 256)
-    (aset dun-translate-table i i)
-    (setq i (1+ i)))
-  (setq lower (concat lower lower))
-  (setq upper (upcase lower))
-  (setq i 0)
-  (while (< i 26)
-    (aset dun-translate-table (+ ?a i) (aref lower (+ i 13)))
-    (aset dun-translate-table (+ ?A i) (aref upper (+ i 13)))
-      (setq i (1+ i))))
-  
-(defun dun-rot13 ()
-  (let (str len (i 0))
-    (setq str (buffer-substring (point-min) (point-max)))
-    (setq len (length str))
-    (while (< i len)
-      (aset str i (aref dun-translate-table (aref str i)))
-      (setq i (1+ i)))
-    (erase-buffer)
-    (insert str)))
-
-;;;;
-;;;; This section defines the globals that are used in dunnet.
-;;;;
-;;;; IMPORTANT
-;;;; All globals which can change must be saved from 'save-game.  Add
-;;;; all new globals to bottom of file.
-
-(setq dun-visited '(27))
-(setq dun-current-room 1)
-(setq dun-exitf nil)
-(setq dun-badcd nil)
-(defvar dungeon-mode-map nil)
-(setq dungeon-mode-map (make-sparse-keymap))
-(define-key dungeon-mode-map "\r" 'dun-parse)
-(defvar dungeon-batch-map (make-keymap))
-(if (string= (substring emacs-version 0 2) "18")
-    (let (n)
-      (setq n 32)
-      (while (< 0 (setq n (- n 1)))
-	(aset dungeon-batch-map n 'dungeon-nil)))
-  (let (n)
-    (setq n 32)
-    (while (< 0 (setq n (- n 1)))
-      (aset (car (cdr dungeon-batch-map)) n 'dungeon-nil))))
-(define-key dungeon-batch-map "\r" 'exit-minibuffer)
-(define-key dungeon-batch-map "\n" 'exit-minibuffer)
-(setq dun-computer nil)
-(setq dun-floppy nil)
-(setq dun-key-level 0)
-(setq dun-hole nil)
-(setq dun-correct-answer nil)
-(setq dun-lastdir 0)
-(setq dun-numsaves 0)
-(setq dun-jar nil)
-(setq dun-dead nil)
-(setq room 0)
-(setq dun-numcmds 0)
-(setq dun-wizard nil)
-(setq dun-endgame-question nil)
-(setq dun-logged-in nil)
-(setq dungeon-mode 'dungeon)
-(setq dun-unix-verbs '((ls . dun-ls) (ftp . dun-ftp) (echo . dun-echo) 
-		       (exit . dun-uexit) (cd . dun-cd) (pwd . dun-pwd)
-		       (rlogin . dun-rlogin) (uncompress . dun-uncompress)
-		       (cat . dun-cat) (zippy . dun-zippy)))
-
-(setq dun-dos-verbs '((dir . dun-dos-dir) (type . dun-dos-type)
-		      (exit . dun-dos-exit) (command . dun-dos-spawn)
-		      (b: . dun-dos-invd) (c: . dun-dos-invd)
-		      (a: . dun-dos-nil)))
-
-
-(setq dun-batch-mode nil)
-
-(setq dun-cdpath "/usr/toukmond")
-(setq dun-cdroom -10)
-(setq dun-uncompressed nil)
-(setq dun-ethernet t)
-(setq dun-restricted 
-      '(dun-room-objects dungeon-map dun-rooms 
-			 dun-room-silents dun-combination))
-(setq dun-ftptype 'ascii)
-(setq dun-endgame nil)
-(setq dun-gottago t)
-(setq dun-black nil)
-
-(setq dun-rooms '(
-	      (
-"You are in the treasure room.  A door leads out to the north."
-               "Treasure room"
-	       )
-	      (
-"You are at a dead end of a dirt road.  The road goes to the east.
-In the distance you can see that it will eventually fork off.  The
-trees here are very tall royal palms, and they are spaced equidistant
-from each other."
-	       "Dead end"
-	       )
-	      (
-"You are on the continuation of a dirt road.  There are more trees on
-both sides of you.  The road continues to the east and west."
-               "E/W Dirt road"
-	       )
-	      (
-"You are at a fork of two passages, one to the northeast, and one to the
-southeast.  The ground here seems very soft. You can also go back west."
-               "Fork"
-	       )
-	      (
-"You are on a northeast/southwest road."
-               "NE/SW road"
-	       )
-	      (
-"You are at the end of the road.  There is a building in front of you
-to the northeast, and the road leads back to the southwest."
-               "Building front"
-	       )
-	      (
-"You are on a southeast/northwest road."
-               "SE/NW road"
-	       )
-	      (
-"You are standing at the end of a road.  A passage leads back to the
-northwest."
-               "Bear hangout"
-	       )
-	      (
-"You are in the hallway of an old building.  There are rooms to the east
-and west, and doors leading out to the north and south."
-               "Old Building hallway"
-	       )
-	      (
-"You are in a mailroom.  There are many bins where the mail is usually
-kept.  The exit is to the west."
-               "Mailroom"
-	       )
-	      (
-"You are in a computer room.  It seems like most of the equipment has
-been removed.  There is a VAX 11/780 in front of you, however, with
-one of the cabinets wide open.  A sign on the front of the machine
-says: This VAX is named 'pokey'.  To type on the console, use the
-'type' command.  The exit is to the east."
-               "Computer room"
-	       )
-	      (
-"You are in a meadow in the back of an old building.  A small path leads
-to the west, and a door leads to the south."
-               "Meadow"
-	       )
-	      (
-"You are in a round, stone room with a door to the east.  There
-is a sign on the wall that reads: 'receiving room'."
-               "Receiving room"
-	       )
-	      (
-"You are at the south end of a hallway that leads to the north.  There
-are rooms to the east and west."
-               "Northbound Hallway"
-	       )
-	      (
-"You are in a sauna.  There is nothing in the room except for a dial
-on the wall.  A door leads out to west."
-               "Sauna"
-               )
-	      (
-"You are at the end of a north/south hallway.  You can go back to the south,
-or off to a room to the east."
-               "End of N/S Hallway"
-	       )
-	      (
-"You are in an old weight room.  All of the equipment is either destroyed
-or completely broken.  There is a door out to the west, and there is a ladder
-leading down a hole in the floor."
-               "Weight room"                 ;16
-	       )
-	      (
-"You are in a maze of twisty little passages, all alike.
-There is a button on the ground here."
-               "Maze button room"
-	       )
-	      (
-"You are in a maze of little twisty passages, all alike."
-               "Maze"
-	       )
-	      (
-"You are in a maze of thirsty little passages, all alike."
-               "Maze"    ;19
-	       )
-	      (
-"You are in a maze of twenty little passages, all alike."
-               "Maze"
-	       )
-	      (
-"You are in a daze of twisty little passages, all alike."
-               "Maze"   ;21
-	       )
-	      (
-"You are in a maze of twisty little cabbages, all alike."
-               "Maze"   ;22
-	       )
-	      (
-"You are in a reception area for a health and fitness center.  The place
-appears to have been recently ransacked, and nothing is left.  There is
-a door out to the south, and a crawlspace to the southeast."
-               "Reception area"
-	       )
-	      (
-"You are outside a large building to the north which used to be a health
-and fitness center.  A road leads to the south."
-               "Health Club front"
-	       )
-	      (
-"You are at the north side of a lake.  On the other side you can see
-a road which leads to a cave.  The water appears very deep."
-               "Lakefront North"
-	       )
-	      (
-"You are at the south side of a lake.  A road goes to the south."
-               "Lakefront South"
-	       )
-	      (
-"You are in a well-hidden area off to the side of a road.  Back to the
-northeast through the brush you can see the bear hangout."
-               "Hidden area"
-	       )
-	      (
-"The entrance to a cave is to the south.  To the north, a road leads
-towards a deep lake.  On the ground nearby there is a chute, with a sign
-that says 'put treasures here for points'."
-               "Cave Entrance"                      ;28
-	       )
-	      (
-"You are in a misty, humid room carved into a mountain.
-To the north is the remains of a rockslide.  To the east, a small
-passage leads away into the darkness."              ;29
-               "Misty Room"
-	       )
-	      (
-"You are in an east/west passageway.  The walls here are made of
-multicolored rock and are quite beautiful."
-               "Cave E/W passage"                   ;30
-	       )
-	      (
-"You are at the junction of two passages. One goes north/south, and
-the other goes west."
-               "N/S/W Junction"                     ;31
-	       )
-	      (
-"You are at the north end of a north/south passageway.  There are stairs
-leading down from here.  There is also a door leading west."
-               "North end of cave passage"         ;32
-	       )
-	      (
-"You are at the south end of a north/south passageway.  There is a hole
-in the floor here, into which you could probably fit."
-               "South end of cave passage"         ;33
-	       )
-	      (
-"You are in what appears to be a worker's bedroom.  There is a queen-
-sized bed in the middle of the room, and a painting hanging on the
-wall.  A door leads to another room to the south, and stairways
-lead up and down."
-               "Bedroom"                          ;34
-	       )
-	      (
-"You are in a bathroom built for workers in the cave.  There is a
-urinal hanging on the wall, and some exposed pipes on the opposite
-wall where a sink used to be.  To the north is a bedroom."
-               "Bathroom"        ;35
-	       )
-	      (
-"This is a marker for the urinal.  User will not see this, but it
-is a room that can contain objects."
-               "Urinal"          ;36
-	       )
-	      (
-"You are at the northeast end of a northeast/southwest passageway.
-Stairs lead up out of sight."
-               "Ne end of ne/sw cave passage"       ;37
-	       )
-	      (
-"You are at the junction of northeast/southwest and east/west passages."
-               "Ne/sw-e/w junction"                      ;38
-	       )
-	      (
-"You are at the southwest end of a northeast/southwest passageway."
-               "Sw end of ne/sw cave passage"        ;39
-	       )
-	      (
-"You are at the east end of an e/w passage.  There are stairs leading up
-to a room above."
-               "East end of e/w cave passage"    ;40
-	       )
-	      (
-"You are at the west end of an e/w passage.  There is a hole on the ground
-which leads down out of sight."
-               "West end of e/w cave passage"    ;41
-	       )
-	      (
-"You are in a room which is bare, except for a horseshoe shaped boulder
-in the center.  Stairs lead down from here."     ;42
-               "Horseshoe boulder room"
-	       )
-	      (
-"You are in a room which is completely empty.  Doors lead out to the north
-and east."
-               "Empty room"                      ;43
-	       )
-	      (
-"You are in an empty room.  Interestingly enough, the stones in this
-room are painted blue.  Doors lead out to the east and south."  ;44
-               "Blue room"
-	       )
-	      (
-"You are in an empty room.  Interestingly enough, the stones in this
-room are painted yellow.  Doors lead out to the south and west."    ;45
-               "Yellow room"
-	       )
-	      (
-"You are in an empty room.  Interestingly enough, the stones in this room
-are painted red.  Doors lead out to the west and north."
-               "Red room"                                 ;46
-	       )
-	      (
-"You are in the middle of a long north/south hallway."     ;47
-               "Long n/s hallway"
-	       )
-	      (
-"You are 3/4 of the way towards the north end of a long north/south hallway."
-               "3/4 north"                                ;48
-	       )
-	      (
-"You are at the north end of a long north/south hallway.  There are stairs
-leading upwards."
-               "North end of long hallway"                 ;49
-	       )
-	      (
-"You are 3/4 of the way towards the south end of a long north/south hallway."
-               "3/4 south"                                 ;50
-	       )
-	      (
-"You are at the south end of a long north/south hallway.  There is a hole
-to the south."
-               "South end of long hallway"                 ;51
-	       )
-	      (
-"You are at a landing in a stairwell which continues up and down."
-               "Stair landing"                             ;52
-	       )
-	      (
-"You are at the continuation of an up/down staircase."
-               "Up/down staircase"                         ;53
-	       )
-	      (
-"You are at the top of a staircase leading down.  A crawlway leads off
-to the northeast."
-               "Top of staircase."                        ;54
-	       )
-	      (
-"You are in a crawlway that leads northeast or southwest."
-               "Ne crawlway"                              ;55
-	       )
-	      (
-"You are in a small crawlspace.  There is a hole in the ground here, and
-a small passage back to the southwest."
-               "Small crawlspace"                         ;56
-	       )
-	      (
-"You are in the Gamma Computing Center.  An IBM 3090/600s is whirring
-away in here.  There is an ethernet cable coming out of one of the units,
-and going through the ceiling.  There is no console here on which you
-could type."
-               "Gamma computing center"                   ;57
-	       )
-	      (
-"You are near the remains of a post office.  There is a mail drop on the
-face of the building, but you cannot see where it leads.  A path leads
-back to the east, and a road leads to the north."
-               "Post office"                             ;58
-	       )
-	      (
-"You are at the intersection of Main Street and Maple Ave.  Main street
-runs north and south, and Maple Ave runs east off into the distance.
-If you look north and east you can see many intersections, but all of
-the buildings that used to stand here are gone.  Nothing remains except
-street signs.
-There is a road to the northwest leading to a gate that guards a building."
-               "Main-Maple intersection"                       ;59
-	       )
-	      (
-"You are at the intersection of Main Street and the west end of Oaktree Ave."
-               "Main-Oaktree intersection"   ;60
-	       )
-	      (
-"You are at the intersection of Main Street and the west end of Vermont Ave."
-               "Main-Vermont intersection"  ;61
-	       )
-	      (
-"You are at the north end of Main Street at the west end of Sycamore Ave." ;62
-               "Main-Sycamore intersection"
-	       )
-	      (
-"You are at the south end of First Street at Maple Ave." ;63
-               "First-Maple intersection"
-	       )
-	      (
-"You are at the intersection of First Street and Oaktree Ave."  ;64
-               "First-Oaktree intersection"
-	       )
-	      (
-"You are at the intersection of First Street and Vermont Ave."  ;65
-               "First-Vermont intersection"
-	       )
-	      (
-"You are at the north end of First Street at Sycamore Ave."  ;66
-               "First-Sycamore intersection"
-	       )
-	      (
-"You are at the south end of Second Street at Maple Ave."  ;67
-               "Second-Maple intersection"
-	       )
-	      (
-"You are at the intersection of Second Street and Oaktree Ave."  ;68
-               "Second-Oaktree intersection"
-	       )
-	      (
-"You are at the intersection of Second Street and Vermont Ave."  ;69
-               "Second-Vermont intersection"
-	       )
-	      (
-"You are at the north end of Second Street at Sycamore Ave."  ;70
-               "Second-Sycamore intersection"
-	       )
-	      (
-"You are at the south end of Third Street at Maple Ave."  ;71
-               "Third-Maple intersection"
-	       )
-	      (
-"You are at the intersection of Third Street and Oaktree Ave."  ;72
-               "Third-Oaktree intersection"
-	       )
-	      (
-"You are at the intersection of Third Street and Vermont Ave."  ;73
-               "Third-Vermont intersection"
-	       )
-	      (
-"You are at the north end of Third Street at Sycamore Ave."  ;74
-               "Third-Sycamore intersection"
-	       )
-	      (
-"You are at the south end of Fourth Street at Maple Ave."  ;75
-               "Fourth-Maple intersection"
-	       )
-	      (
-"You are at the intersection of Fourth Street and Oaktree Ave."  ;76
-               "Fourth-Oaktree intersection"
-	       )
-	      (
-"You are at the intersection of Fourth Street and Vermont Ave."  ;77
-               "Fourth-Vermont intersection"
-	       )
-	      (
-"You are at the north end of Fourth Street at Sycamore Ave."  ;78
-               "Fourth-Sycamore intersection"
-	       )
-	      (
-"You are at the south end of Fifth Street at the east end of Maple Ave."  ;79
-               "Fifth-Maple intersection"
-	       )
-	      (
-"You are at the intersection of Fifth Street and the east end of Oaktree Ave.
-There is a cliff off to the east."
-               "Fifth-Oaktree intersection"  ;80
-	       )
-	      (
-"You are at the intersection of Fifth Street and the east end of Vermont Ave."
-               "Fifth-Vermont intersection"  ;81
-	       )
-	      (
-"You are at the north end of Fifth Street and the east end of Sycamore Ave."
-               "Fifth-Sycamore intersection"  ;82
-	       )
-	      (
-"You are in front of the Museum of Natural History.  A door leads into
-the building to the north, and a road leads to the southeast."
-               "Museum entrance"                  ;83
-	       )
-	      (
-"You are in the main lobby for the Museum of Natural History.  In the center
-of the room is the huge skeleton of a dinosaur.  Doors lead out to the
-south and east." 
-               "Museum lobby"                     ;84
-	       )
-	      (
-"You are in the geological display.  All of the objects that used to
-be on display are missing.  There are rooms to the east, west, and 
-north."
-               "Geological display"               ;85
-	       )
-	      (
-"You are in the marine life area.  The room is filled with fish tanks,
-which are filled with dead fish that have apparently died due to
-starvation.  Doors lead out to the south and east."
-               "Marine life area"                   ;86
-	       )
-	      (
-"You are in some sort of maintenance room for the museum.  There is a
-switch on the wall labeled 'BL'.  There are doors to the west and north."
-               "Maintenance room"                   ;87
-	       )
-	      (
-"You are in a classroom where school children were taught about natural
-history.  On the blackboard is written, 'No children allowed downstairs.'
-There is a door to the east with an 'exit' sign on it.  There is another
-door to the west."
-               "Classroom"                          ;88
-	       )
-	      (
-"You are at the Vermont St. subway station.  A train is sitting here waiting."
-               "Vermont station"                    ;89
-	       )
-	      (
-"You are at the Museum subway stop.  A passage leads off to the north."
-               "Museum station"                     ;90
-	       )
-	      (
-"You are in a north/south tunnel."
-               "N/S tunnel"                          ;91
-	       )
-	      (
-"You are at the north end of a north/south tunnel.  Stairs lead up and
-down from here.  There is a garbage disposal here."
-               "North end of n/s tunnel"             ;92
-               )
-	      (
-"You are at the top of some stairs near the subway station.  There is
-a door to the west."
-               "Top of subway stairs"           ;93
-	       )
-	      (
-"You are at the bottom of some stairs near the subway station.  There is
-a room to the northeast."
-               "Bottom of subway stairs"       ;94
-	       )
-	      (
-"You are in another computer room.  There is a computer in here larger
-than you have ever seen.  It has no manufacturers name on it, but it
-does have a sign that says: This machine's name is 'endgame'.  The
-exit is to the southwest.  There is no console here on which you could
-type."
-               "Endgame computer room"         ;95
-	       )
-	      (
-"You are in a north/south hallway."
-               "Endgame n/s hallway"           ;96
-	       )
-	      (
-"You have reached a question room.  You must answer a question correctly in
-order to get by.  Use the 'answer' command to answer the question."
-               "Question room 1"              ;97
-	       )
-	      (
-"You are in a north/south hallway."
-               "Endgame n/s hallway"           ;98
-	       )
-	      (
-"You are in a second question room."
-               "Question room 2"               ;99
-	       )
-	      (
-"You are in a north/south hallway."
-               "Endgame n/s hallway"           ;100
-	       )
-	      (
-"You are in a third question room."
-               "Question room 3"               ;101
-	       )
-	      (
-"You are in the endgame treasure room.  A door leads out to the north, and
-a hallway leads to the south."
-               "Endgame treasure room"         ;102
-	       )
-	      (
-"You are in the winner's room.  A door leads back to the south."
-               "Winner's room"                 ;103
-	       )
-	      (
-"You have reached a dead end.  There is a PC on the floor here.  Above
-it is a sign that reads:
-          Type the 'reset' command to type on the PC. 
-A hole leads north."
-               "PC area"                       ;104
-               )            
-))
-
-(setq dun-light-rooms '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 24 25 26 27 28 58 59
-		     60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76
-		     77 78 79 80 81 82 83))
-
-(setq dun-verblist '((die . dun-die) (ne . dun-ne) (north . dun-n) 
-		     (south . dun-s) (east . dun-e) (west . dun-w)
-		     (u . dun-up) (d . dun-down) (i . dun-inven)
-		     (inventory . dun-inven) (look . dun-examine) (n . dun-n)
-		     (s . dun-s) (e . dun-e) (w . dun-w) (se . dun-se)
-		     (nw . dun-nw) (sw . dun-sw) (up . dun-up) 
-		     (down . dun-down) (in . dun-in) (out . dun-out)
-		     (go . dun-go) (drop . dun-drop) (southeast . dun-se)
-		     (southwest . dun-sw) (northeast . dun-ne)
-		     (northwest . dun-nw) (save . dun-save-game)
-		     (restore . dun-restore) (long . dun-long) (dig . dun-dig)
-		     (shake . dun-shake) (wave . dun-shake)
-		     (examine . dun-examine) (describe . dun-examine) 
-		     (climb . dun-climb) (eat . dun-eat) (put . dun-put)
-		     (type . dun-type)  (insert . dun-put)
-		     (score . dun-score) (help . dun-help) (quit . dun-quit) 
-		     (read . dun-examine) (verbose . dun-long) 
-		     (urinate . dun-urinate)
-		     (flush . dun-flush) (sleep . dun-sleep) (lie . dun-sleep) 
-		     (x . dun-examine) (break . dun-break) (drive . dun-drive)
-		     (board . dun-in) (enter . dun-in) (turn . dun-turn)
-		     (press . dun-press) (push . dun-press) (swim . dun-swim)
-		     (on . dun-in) (off . dun-out) (chop . dun-break)
-		     (switch . dun-press) (cut . dun-break) (exit . dun-out)
-		     (leave . dun-out) (reset . dun-power) (flick . dun-press)
-		     (superb . dun-superb) (answer . dun-answer)
-		     (throw . dun-drop) (l . dun-examine) (take . dun-take)
-		     (get . dun-take) (feed . dun-feed)))
-
-(setq dun-inbus nil)
-(setq dun-nomail nil)
-(setq dun-ignore '(the to at))
-(setq dun-mode 'moby)
-(setq dun-sauna-level 0)
-
-(defconst north 0)
-(defconst south 1)
-(defconst east 2)
-(defconst west 3)
-(defconst northeast 4)
-(defconst southeast 5)
-(defconst northwest 6)
-(defconst southwest 7)
-(defconst up 8)
-(defconst down 9)
-(defconst in 10)
-(defconst out 11)
-
-(setq dungeon-map '(
-;		      no  so  ea  we  ne  se  nw  sw  up  do  in  ot
-		    ( 96  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;0
-		    ( -1  -1   2  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;1
-		    ( -1  -1   3   1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;2
-		    ( -1  -1  -1   2   4   6  -1  -1  -1  -1  -1  -1 ) ;3
-		    ( -1  -1  -1  -1   5  -1  -1   3  -1  -1  -1  -1 ) ;4
-		    ( -1  -1  -1  -1  255 -1  -1   4  -1  -1  255 -1 ) ;5
-		    ( -1  -1  -1  -1  -1   7   3  -1  -1  -1  -1  -1 ) ;6
-		    ( -1  -1  -1  -1  -1  255  6  27  -1  -1  -1  -1 ) ;7
-		    ( 255  5   9  10  -1  -1  -1   5  -1  -1  -1   5 ) ;8
-		    ( -1  -1  -1   8  -1  -1  -1  -1  -1  -1  -1  -1 ) ;9
-		    ( -1  -1   8  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;10
-		    ( -1   8  -1  58  -1  -1  -1  -1  -1  -1  -1  -1 ) ;11
-		    ( -1  -1  13  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;12
-		    ( 15  -1  14  12  -1  -1  -1  -1  -1  -1  -1  -1 ) ;13
-		    ( -1  -1  -1  13  -1  -1  -1  -1  -1  -1  -1  -1 ) ;14
-		    ( -1  13  16  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;15
-		    ( -1  -1  -1  15  -1  -1  -1  -1  -1  17  16  -1 ) ;16
-		    ( -1  -1  17  17  17  17 255  17 255  17  -1  -1 ) ;17
-		    ( 18  18  18  18  18  -1  18  18  19  18  -1  -1 ) ;18
-		    ( -1  18  18  19  19  20  19  19  -1  18  -1  -1 ) ;19
-		    ( -1  -1  -1  18  -1  -1  -1  -1  -1  21  -1  -1 ) ;20
-		    ( -1  -1  -1  -1  -1  20  22  -1  -1  -1  -1  -1 ) ;21
-		    ( 18  18  18  18  16  18  23  18  18  18  18  18 ) ;22
-		    ( -1 255  -1  -1  -1  19  -1  -1  -1  -1  -1  -1 ) ;23
-		    ( 23  25  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;24
-		    ( 24 255  -1  -1  -1  -1  -1  -1  -1  -1 255  -1 ) ;25
-		    (255  28  -1  -1  -1  -1  -1  -1  -1  -1 255  -1 ) ;26
-		    ( -1  -1  -1  -1   7  -1  -1  -1  -1  -1  -1  -1 ) ;27
-		    ( 26 255  -1  -1  -1  -1  -1  -1  -1  -1  255 -1 ) ;28
-		    ( -1  -1  30  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;29
-		    ( -1  -1  31  29  -1  -1  -1  -1  -1  -1  -1  -1 ) ;30
-		    ( 32  33  -1  30  -1  -1  -1  -1  -1  -1  -1  -1 ) ;31
-		    ( -1  31  -1  255 -1  -1  -1  -1  -1  34  -1  -1 ) ;32
-		    ( 31  -1  -1  -1  -1  -1  -1  -1  -1  35  -1  -1 ) ;33
-		    ( -1  35  -1  -1  -1  -1  -1  -1  32  37  -1  -1 ) ;34
-		    ( 34  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;35
-		    ( -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;36
-		    ( -1  -1  -1  -1  -1  -1  -1  38  34  -1  -1  -1 ) ;37
-		    ( -1  -1  40  41  37  -1  -1  39  -1  -1  -1  -1 ) ;38
-		    ( -1  -1  -1  -1  38  -1  -1  -1  -1  -1  -1  -1 ) ;39
-		    ( -1  -1  -1  38  -1  -1  -1  -1  42  -1  -1  -1 ) ;40
-		    ( -1  -1  38  -1  -1  -1  -1  -1  -1  43  -1  -1 ) ;41
-		    ( -1  -1  -1  -1  -1  -1  -1  -1  -1  40  -1  -1 ) ;42
-		    ( 44  -1  46  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;43
-		    ( -1  43  45  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;44
-		    ( -1  46  -1  44  -1  -1  -1  -1  -1  -1  -1  -1 ) ;45
-		    ( 45  -1  -1  43  -1  -1  -1  -1  -1  255 -1  -1 ) ;46
-		    ( 48  50  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;47
-		    ( 49  47  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;48
-		    ( -1  48  -1  -1  -1  -1  -1  -1  52  -1  -1  -1 ) ;49
-		    ( 47  51  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;50
-		    ( 50  104 -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;51
-		    ( -1  -1  -1  -1  -1  -1  -1  -1  53  49  -1  -1 ) ;52
-		    ( -1  -1  -1  -1  -1  -1  -1  -1  54  52  -1  -1 ) ;53
-		    ( -1  -1  -1  -1  55  -1  -1  -1  -1  53  -1  -1 ) ;54
-		    ( -1  -1  -1  -1  56  -1  -1  54  -1  -1  -1  54 ) ;55
-		    ( -1  -1  -1  -1  -1  -1  -1  55  -1  31  -1  -1 ) ;56
-		    ( -1  -1  32  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;57
-		    ( 59  -1  11  -1  -1  -1  -1  -1  -1  -1  255 255) ;58
-		    ( 60  58  63  -1  -1  -1  255 -1  -1  -1  255 255) ;59
-		    ( 61  59  64  -1  -1  -1  -1  -1  -1  -1  255 255) ;60
-		    ( 62  60  65  -1  -1  -1  -1  -1  -1  -1  255 255) ;61
-		    ( -1  61  66  -1  -1  -1  -1  -1  -1  -1  255 255) ;62
-		    ( 64  -1  67  59  -1  -1  -1  -1  -1  -1  255 255) ;63
-		    ( 65  63  68  60  -1  -1  -1  -1  -1  -1  255 255) ;64
-		    ( 66  64  69  61  -1  -1  -1  -1  -1  -1  255 255) ;65
-		    ( -1  65  70  62  -1  -1  -1  -1  -1  -1  255 255) ;66
-		    ( 68  -1  71  63  -1  -1  -1  -1  -1  -1  255 255) ;67
-		    ( 69  67  72  64  -1  -1  -1  -1  -1  -1  255 255) ;68
-		    ( 70  68  73  65  -1  -1  -1  -1  -1  -1  255 255) ;69
-		    ( -1  69  74  66  -1  -1  -1  -1  -1  -1  255 255) ;70
-		    ( 72  -1  75  67  -1  -1  -1  -1  -1  -1  255 255) ;71
-		    ( 73  71  76  68  -1  -1  -1  -1  -1  -1  255 255) ;72
-		    ( 74  72  77  69  -1  -1  -1  -1  -1  -1  255 255) ;73
-		    ( -1  73  78  70  -1  -1  -1  -1  -1  -1  255 255) ;74
-		    ( 76  -1  79  71  -1  -1  -1  -1  -1  -1  255 255) ;75
-		    ( 77  75  80  72  -1  -1  -1  -1  -1  -1  255 255) ;76
-		    ( 78  76  81  73  -1  -1  -1  -1  -1  -1  255 255) ;77
-		    ( -1  77  82  74  -1  -1  -1  -1  -1  -1  255 255) ;78
-		    ( 80  -1  -1  75  -1  -1  -1  -1  -1  -1  255 255) ;79
-		    ( 81  79  255 76  -1  -1  -1  -1  -1  -1  255 255) ;80
-		    ( 82  80  -1  77  -1  -1  -1  -1  -1  -1  255 255) ;81
-		    ( -1  81  -1  78  -1  -1  -1  -1  -1  -1  255 255) ;82
-		    ( 84  -1  -1  -1  -1  59  -1  -1  -1  -1  255 255) ;83
-		    ( -1  83  85  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;84
-		    ( 86  -1  87  84  -1  -1  -1  -1  -1  -1  -1  -1 ) ;85
-		    ( -1  85  88  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;86
-		    ( 88  -1  -1  85  -1  -1  -1  -1  -1  -1  -1  -1 ) ;87
-		    ( -1  87 255  86  -1  -1  -1  -1  -1  -1  -1  -1 ) ;88
-		    ( -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 255  -1 ) ;89
-		    ( 91  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;90
-		    ( 92  90  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;91
-		    ( -1  91  -1  -1  -1  -1  -1  -1  93  94  -1  -1 ) ;92
-		    ( -1  -1  -1  88  -1  -1  -1  -1  -1  92  -1  -1 ) ;93
-		    ( -1  -1  -1  -1  95  -1  -1  -1  92  -1  -1  -1 ) ;94
-		    ( -1  -1  -1  -1  -1  -1  -1  94  -1  -1  -1  -1 ) ;95
-		    ( 97   0  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;96
-		    ( -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;97
-		    ( 99  97  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;98
-		    ( -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;99
-		    ( 101 99  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;100
-		    ( -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;101
-		    ( 103 101 -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;102
-		    ( -1  102 -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;103
-		    ( 51  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1  -1 ) ;104
-		    )
-;		      no  so  ea  we  ne  se  nw  sw  up  do  in  ot
-)
-
-
-;;; How the user references *all* objects, permanent and regular.
-(setq dun-objnames '(
-		 (shovel . 0) 
-		 (lamp . 1)
-		 (cpu . 2) (board . 2) (card . 2)
-		 (food . 3) 
-		 (key . 4) 
-		 (paper . 5)
-		 (rms . 6) (statue . 6) (statuette . 6)  (stallman . 6)
-		 (diamond . 7)
-		 (weight . 8)
-		 (life . 9) (preserver . 9)
-		 (bracelet . 10) (emerald . 10) 
-		 (gold . 11)
-		 (platinum . 12)
-		 (towel . 13) (beach . 13)
-		 (axe . 14)
-		 (silver . 15)
-		 (license . 16)
-		 (coins . 17)
-		 (egg . 18)
-		 (jar . 19)
-		 (bone . 20)
-		 (acid . 21) (nitric . 21)
-		 (glycerine . 22)
-		 (ruby . 23)
-		 (amethyst . 24) 
-		 (mona . 25)
-		 (bill . 26) 
-		 (floppy . 27) (disk . 27)
-		 
-		 (boulder . -1)
-		 (tree . -2) (trees . -2) (palm . -2) 
-		 (bear . -3)
-		 (bin . -4) (bins . -4)
-		 (cabinet . -5) (computer . -5) (vax . -5) (ibm . -5) 
-		 (protoplasm . -6)
-		 (dial . -7) 
-		 (button . -8) 
-		 (chute . -9) 
-		 (painting . -10)
-		 (bed . -11)
-		 (urinal . -12)
-		 (URINE . -13)
-		 (pipes . -14) (pipe . -14) 
-		 (box . -15) (slit . -15) 
-		 (cable . -16) (ethernet . -16) 
-		 (mail . -17) (drop . -17)
-		 (bus . -18)
-		 (gate . -19)
-		 (cliff . -20) 
-		 (skeleton . -21) (dinosaur . -21)
-		 (fish . -22)
-		 (tanks . -23)
-		 (switch . -24)
-		 (blackboard . -25)
-		 (disposal . -26) (garbage . -26)
-		 (ladder . -27)
-		 (subway . -28) (train . -28) 
-		 (pc . -29) (drive . -29)
-))
-
-(dolist (x dun-objnames)
-  (let (name)
-    (setq name (concat "obj-" (prin1-to-string (car x))))
-    (eval (list 'defconst (intern name) (cdr x)))))
-
-(defconst obj-special 255)
-
-;;; The initial setup of what objects are in each room.
-;;; Regular objects have whole numbers lower than 255.
-;;; Objects that cannot be taken but might move and are
-;;; described during room description are negative.
-;;; Stuff that is described and might change are 255, and are
-;;; handled specially by 'dun-describe-room. 
-
-(setq dun-room-objects (list nil 
-
-        (list obj-shovel)                     ;; treasure-room
-        (list obj-boulder)                    ;; dead-end
-        nil nil nil
-        (list obj-food)                       ;; se-nw-road
-        (list obj-bear)                       ;; bear-hangout
-        nil nil
-        (list obj-special)                    ;; computer-room
-        (list obj-lamp obj-license obj-silver);; meadow
-        nil nil
-        (list obj-special)                    ;; sauna
-        nil 
-        (list obj-weight obj-life)            ;; weight-room
-        nil nil
-        (list obj-rms obj-floppy)             ;; thirsty-maze
-        nil nil nil nil nil nil nil 
-        (list obj-emerald)                    ;; hidden-area
-        nil
-        (list obj-gold)                       ;; misty-room
-        nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-        (list obj-towel obj-special)          ;; red-room
-        nil nil nil nil nil
-        (list obj-box)                        ;; stair-landing
-        nil nil nil
-        (list obj-axe)                        ;; smal-crawlspace
-        nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-        nil nil nil nil nil
-        (list obj-special)                    ;; fourth-vermont-intersection
-        nil nil
-        (list obj-coins)                      ;; fifth-oaktree-intersection
-        nil
-        (list obj-bus)                        ;; fifth-sycamore-intersection
-        nil
-        (list obj-bone)                       ;; museum-lobby
-        nil
-        (list obj-jar obj-special obj-ruby)   ;; marine-life-area
-        (list obj-nitric)                     ;; maintenance-room
-        (list obj-glycerine)                  ;; classroom
-        nil nil nil nil nil
-        (list obj-amethyst)                   ;; bottom-of-subway-stairs
-        nil nil
-        (list obj-special)                    ;; question-room-1
-        nil
-        (list obj-special)                    ;; question-room-2
-        nil
-        (list obj-special)                    ;; question-room-three
-        nil
-        (list obj-mona)                       ;; winner's-room
-nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-nil))
-
-;;; These are objects in a room that are only described in the
-;;; room description.  They are permanent.
-
-(setq dun-room-silents (list nil
-        (list obj-tree)                        ;; dead-end
-        (list obj-tree)                        ;; e-w-dirt-road
-        nil nil nil nil nil nil
-        (list obj-bin)                         ;; mailroom
-        (list obj-computer)                    ;; computer-room
-        nil nil nil
-        (list obj-dial)                        ;; sauna
-        nil
-        (list obj-ladder)                      ;; weight-room
-        (list obj-button obj-ladder)           ;; maze-button-room
-        nil nil nil
-        nil nil nil nil nil nil nil
-        (list obj-chute)                       ;; cave-entrance
-        nil nil nil nil nil
-        (list obj-painting obj-bed)            ;; bedroom
-        (list obj-urinal obj-pipes)            ;; bathroom
-        nil nil nil nil nil nil
-        (list obj-boulder)                     ;; horseshoe-boulder-room
-        nil nil nil nil nil nil nil nil nil nil nil nil nil nil
-        (list obj-computer obj-cable)          ;; gamma-computing-center
-        (list obj-mail)                        ;; post-office
-        (list obj-gate)                        ;; main-maple-intersection
-        nil nil nil nil nil nil nil nil nil nil nil nil nil
-        nil nil nil nil nil nil nil
-        (list obj-cliff)                       ;; fifth-oaktree-intersection
-        nil nil nil
-        (list obj-dinosaur)                    ;; museum-lobby
-        nil
-        (list obj-fish obj-tanks)              ;; marine-life-area
-        (list obj-switch)                      ;; maintenance-room
-        (list obj-blackboard)                  ;; classroom
-        (list obj-train)                       ;; vermont-station
-        nil nil
-        (list obj-disposal)                    ;; north-end-of-n-s-tunnel
-        nil nil
-        (list obj-computer)                    ;; endgame-computer-room
-        nil nil nil nil nil nil nil nil 
-	(list obj-pc)                          ;; pc-area
-	nil nil nil nil nil nil
-))
-(setq dun-inventory '(1))
-
-;;; Descriptions of objects, as they appear in the room description, and
-;;; the inventory.
-
-(setq dun-objects '(
-		("There is a shovel here." "A shovel")                ;0
-		("There is a lamp nearby." "A lamp")                  ;1
-		("There is a CPU card here." "A computer board")      ;2
-		("There is some food here." "Some food")              ;3
-		("There is a shiny brass key here." "A brass key")    ;4
-		("There is a slip of paper here." "A slip of paper")  ;5
-		("There is a wax statuette of Richard Stallman here." ;6
-		 "An RMS statuette")
-		("There is a shimmering diamond here." "A diamond")   ;7
-		("There is a 10 pound weight here." "A weight")       ;8
-		("There is a life preserver here." "A life preserver");9
-		("There is an emerald bracelet here." "A bracelet")   ;10
-		("There is a gold bar here." "A gold bar")            ;11
-		("There is a platinum bar here." "A platinum bar")    ;12
-		("There is a beach towel on the ground here." "A beach towel")
-		("There is an axe here." "An axe") ;14
-		("There is a silver bar here." "A silver bar")  ;15
-		("There is a bus driver's license here." "A license") ;16
-		("There are some valuable coins here." "Some valuable coins")
-		("There is a jewel-encrusted egg here." "A valuable egg") ;18
-		("There is a glass jar here." "A glass jar") ;19
-		("There is a dinosaur bone here." "A bone") ;20
-		("There is a packet of nitric acid here." "Some nitric acid")
-		("There is a packet of glycerine here." "Some glycerine") ;22
-		("There is a valuable ruby here." "A ruby") ;23
-		("There is a valuable amethyst here." "An amethyst") ;24
-		("The Mona Lisa is here." "The Mona Lisa") ;25
-		("There is a 100 dollar bill here." "A $100 bill") ;26
-		("There is a floppy disk here." "A floppy disk") ;27
-	       )
-)
-
-;;; Weight of objects
-
-(setq dun-object-lbs 
-      '(2 1 1 1 1 0 2 2 10 3 1 1 1 0 1 1 0 1 1 1 1 0 0 2 2 1 0 0))
-(setq dun-object-pts 
-      '(0 0 0 0 0 0 0 10 0 0 10 10 10 0 0 10 0 10 10 0 0 0 0 10 10 10 10 0))
-
-
-;;; Unix representation of objects.
-(setq dun-objfiles '(
-		 "shovel.o" "lamp.o" "cpu.o" "food.o" "key.o" "paper.o"
-		 "rms.o" "diamond.o" "weight.o" "preserver.o" "bracelet.o"
-		 "gold.o" "platinum.o" "towel.o" "axe.o" "silver.o" "license.o"
-		 "coins.o" "egg.o" "jar.o" "bone.o" "nitric.o" "glycerine.o"
-		 "ruby.o" "amethyst.o"
-		 ))
-
-;;; These are the descriptions for the negative numbered objects from
-;;; dun-room-objects
-
-(setq dun-perm-objects '(
-		     nil
-		     ("There is a large boulder here.")
-		     nil
-		     ("There is a ferocious bear here!")
-		     nil
-		     nil
-		     ("There is a worthless pile of protoplasm here.")
-		     nil
-		     nil
-		     nil
-		     nil
-		     nil
-		     nil
-		     ("There is a strange smell in this room.")
-		     nil
-		     (
-"There is a box with a slit in it, bolted to the wall here."
-                     )
-		     nil
-		     nil
-		     ("There is a bus here.")
-		     nil
-		     nil
-		     nil
-))
-
-
-;;; These are the descriptions the user gets when regular objects are
-;;; examined.
-
-(setq dun-physobj-desc '(
-"It is a normal shovel with a price tag attached that says $19.99."
-"The lamp is hand-crafted by Geppetto."
-"The CPU board has a VAX chip on it.  It seems to have
-2 Megabytes of RAM onboard."
-"It looks like some kind of meat.  Smells pretty bad."
-nil
-"The paper says: Don't forget to type 'help' for help.  Also, remember
-this word: 'worms'"
-"The statuette is of the likeness of Richard Stallman, the author of the
-famous EMACS editor.  You notice that he is not wearing any shoes."
-nil
-"You observe that the weight is heavy."
-"It says S. S. Minnow."
-nil
-nil
-nil
-"It has a picture of snoopy on it."
-nil
-nil
-"It has your picture on it!"
-"They are old coins from the 19th century."
-"It is a valuable Fabrege egg."
-"It is a a plain glass jar."
-nil
-nil
-nil
-nil
-nil
-                     )
-)
-
-;;; These are the descriptions the user gets when non-regular objects
-;;; are examined.
-
-(setq dun-permobj-desc '(
-		     nil
-"It is just a boulder.  It cannot be moved."
-"They are palm trees with a bountiful supply of coconuts in them."
-"It looks like a grizzly to me."
-"All of the bins are empty.  Looking closely you can see that there
-are names written at the bottom of each bin, but most of them are
-faded away so that you cannot read them.  You can only make out three
-names:
-                   Jeffrey Collier
-                   Robert Toukmond
-                   Thomas Stock
-"
-                      nil
-"It is just a garbled mess."
-"The dial points to a temperature scale which has long since faded away."
-nil
-nil
-"It is a velvet painting of Elvis Presly.  It seems to be nailed to the
-wall, and you cannot move it."
-"It is a queen sized bed, with a very firm mattress."
-"The urinal is very clean compared with everything else in the cave.  There
-isn't even any rust.  Upon close examination you realize that the drain at the
-bottom is missing, and there is just a large hole leading down the
-pipes into nowhere.  The hole is too small for a person to fit in.  The 
-flush handle is so clean that you can see your reflection in it."
-nil
-nil
-"The box has a slit in the top of it, and on it, in sloppy handwriting, is
-written: 'For key upgrade, put key in here.'"
-nil
-"It says 'express mail' on it."
-"It is a 35 passenger bus with the company name 'mobytours' on it."
-"It is a large metal gate that is too big to climb over."
-"It is a HIGH cliff."
-"Unfortunately you do not know enough about dinosaurs to tell very much about
-it.  It is very big, though."
-"The fish look like they were once quite beautiful."
-nil
-nil
-nil
-nil
-"It is a normal ladder that is permanently attached to the hole."
-"It is a passenger train that is ready to go."
-"It is a personal computer that has only one floppy disk drive."
-		    )
-)
-
-(setq dun-diggables 
-      (list nil nil nil (list obj-cpu) nil nil nil nil nil nil nil
-		  nil nil nil nil nil nil nil nil nil nil      ;11-20
-		  nil nil nil nil nil nil nil nil nil nil      ;21-30
-		  nil nil nil nil nil nil nil nil nil nil      ;31-40
-		  nil (list obj-platinum) nil nil nil nil nil nil nil nil))
-
-(setq dun-room-shorts nil)
-(dolist (x dun-rooms)
-  (setq dun-room-shorts  
-		     (append dun-room-shorts (list (downcase 
-						    (dun-space-to-hyphen
-						     (cadr x)))))))
-
-(setq dun-endgame-questions '(
-			  (
-"What is your password on the machine called 'pokey'?" "robert")
-			  (
-"What password did you use during anonymous ftp to gamma?" "foo")
-			  (
-"Excluding the endgame, how many places are there where you can put
-treasures for points?" "4" "four")
-			  (
-"What is your login name on the 'endgame' machine?" "toukmond"
-)
-			  (
-"What is the nearest whole dollar to the price of the shovel?" "20" "twenty")
-			  (
-"What is the name of the bus company serving the town?" "mobytours")
-			  (
-"Give either of the two last names in the mailroom, other than your own."
-"collier" "stock")
-			  (
-"What cartoon character is on the towel?" "snoopy")
-			  (
-"What is the last name of the author of EMACS?" "stallman")
-			  (
-"How many megabytes of memory is on the CPU board for the Vax?" "2")
-			  (
-"Which street in town is named after a U.S. state?" "vermont")
-			  (
-"How many pounds did the weight weigh?" "ten" "10")
-			  (
-"Name the STREET which runs right over the subway stop." "fourth" "4" "4th")
-			  (
-"How many corners are there in town (excluding the one with the Post Office)?"
-                  "24" "twentyfour" "twenty-four")
-			  (
-"What type of bear was hiding your key?" "grizzly")
-			  (
-"Name either of the two objects you found by digging." "cpu" "card" "vax"
-"board" "platinum")
-			  (
-"What network protocol is used between pokey and gamma?" "tcp/ip" "ip" "tcp")
-))
-
-(let (a)
-  (setq a 0)
-  (dolist (x dun-room-shorts)
-    (eval (list 'defconst (intern x) a))
-    (setq a (+ a 1))))
-
-
-
-;;;;
-;;;; This section defines the UNIX emulation functions for dunnet.
-;;;;
-
-(defun dun-unix-parse (args)
-  (interactive "*p")
-  (beginning-of-line)
-  (let (beg esign)
-    (setq beg (+ (point) 2))
-    (end-of-line)
-    (if (and (not (= beg (point)))
-	     (string= "$" (buffer-substring (- beg 2) (- beg 1))))
-	(progn
-	  (setq line (downcase (buffer-substring beg (point))))
-	  (princ line)
-	  (if (eq (dun-parse2 nil dun-unix-verbs line) -1)
-	      (progn
-		(if (setq esign (string-match "=" line))
-		    (dun-doassign line esign)		
-		  (dun-mprinc (car line-list))
-		  (dun-mprincl ": not found.")))))
-      (goto-char (point-max))
-      (dun-mprinc "\n"))
-    (if (eq dungeon-mode 'unix)
-	(progn
-	  (dun-fix-screen)
-	  (dun-mprinc "$ ")))))
-
-(defun dun-doassign (line esign)
-  (if (not dun-wizard)
-      (let (passwd)
-	(dun-mprinc "Enter wizard password: ")
-	(setq passwd (dun-read-line))
-	(if (not dun-batch-mode)
-	    (dun-mprinc "\n"))
-	(if (string= passwd "moby")
-	    (progn
-	      (setq dun-wizard t)
-	      (dun-doassign line esign))
-	  (dun-mprincl "Incorrect.")))
-
-    (let (varname epoint afterq i value)
-      (setq varname (substring line 0 esign))
-      (if (not (setq epoint (string-match ")" line)))
-	  (if (string= (substring line (1+ esign) (+ esign 2))
-		       "\"")
-	      (progn
-		(setq afterq (substring line (+ esign 2)))
-		(setq epoint (+
-			      (string-match "\"" afterq)
-			      (+ esign 3))))
-	    
-	    (if (not (setq epoint (string-match " " line)))
-		(setq epoint (length line))))
-	(setq epoint (1+ epoint))
-	(while (and
-		(not (= epoint (length line)))
-		(setq i (string-match ")" (substring line epoint))))
-	  (setq epoint (+ epoint i 1))))
-      (setq value (substring line (1+ esign) epoint))
-      (dun-eval varname value))))
-
-(defun dun-eval (varname value)
-  (let (eval-error)
-    (switch-to-buffer (get-buffer-create "*dungeon-eval*"))
-    (erase-buffer)
-    (insert "(setq ")
-    (insert varname)
-    (insert " ")
-    (insert value)
-    (insert ")")
-    (setq eval-error nil)
-    (condition-case nil
-	(eval-current-buffer)
-      (error (setq eval-error t)))
-    (kill-buffer (current-buffer))
-    (switch-to-buffer "*dungeon*")
-    (if eval-error
-	(dun-mprincl "Invalid syntax."))))
-  
-
-(defun dun-unix-interface ()
-  (dun-login)
-  (if dun-logged-in
-      (progn
-	(setq dungeon-mode 'unix)
-	(define-key dungeon-mode-map "\r" 'dun-unix-parse)
-	(dun-mprinc "$ "))))
-
-(defun dun-login ()
-  (let (tries username password)
-    (setq tries 4)
-    (while (and (not dun-logged-in) (> (setq tries (- tries 1)) 0))
-      (dun-mprinc "\n\nUNIX System V, Release 2.2 (pokey)\n\nlogin: ")
-      (setq username (dun-read-line))
-      (if (not dun-batch-mode)
-	  (dun-mprinc "\n"))
-      (dun-mprinc "password: ")
-      (setq password (dun-read-line))
-      (if (not dun-batch-mode)
-	  (dun-mprinc "\n"))
-      (if (or (not (string= username "toukmond"))
-	      (not (string= password "robert")))
-	  (dun-mprincl "login incorrect")
-	(setq dun-logged-in t)
-	(dun-mprincl "
-Welcome to Unix\n
-Please clean up your directories.  The filesystem is getting full.
-Our tcp/ip link to gamma is a little flaky, but seems to work.
-The current version of ftp can only send files from the current
-directory, and deletes them after they are sent!  Be careful.
-
-Note: Restricted bourne shell in use.\n")))
-  (setq dungeon-mode 'dungeon)))
-
-(defun dun-ls (args)
-  (if (car args)
-      (let (ocdpath ocdroom)
-	(setq ocdpath dun-cdpath)
-	(setq ocdroom dun-cdroom)
-	(if (not (eq (dun-cd args) -2))
-	    (dun-ls nil))
-	(setq dun-cdpath ocdpath)
-	(setq dun-cdroom ocdroom))
-    (if (= dun-cdroom -10)
-	(dun-ls-inven))
-    (if (= dun-cdroom -2)
-	(dun-ls-rooms))
-    (if (= dun-cdroom -3)
-	(dun-ls-root))
-    (if (= dun-cdroom -4)
-	(dun-ls-usr))
-    (if (> dun-cdroom 0)
-	(dun-ls-room))))
-
-(defun dun-ls-root ()
-  (dun-mprincl "total 4
-drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
-drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
-drwxr-xr-x  3 root     staff          2048 Jan 1 1970 usr
-drwxr-xr-x  3 root     staff          2048 Jan 1 1970 rooms"))
-
-(defun dun-ls-usr ()
-  (dun-mprincl "total 4
-drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
-drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
-drwxr-xr-x  3 toukmond restricted      512 Jan 1 1970 toukmond"))
-
-(defun dun-ls-rooms ()
-  (dun-mprincl "total 16
-drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
-drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..")
-  (dolist (x dun-visited)
-    (dun-mprinc
-"drwxr-xr-x  3 root     staff           512 Jan 1 1970 ")
-    (dun-mprincl (nth x dun-room-shorts))))
-
-(defun dun-ls-room ()
-  (dun-mprincl "total 4
-drwxr-xr-x  3 root     staff           512 Jan 1 1970 .
-drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..
--rwxr-xr-x  3 root     staff          2048 Jan 1 1970 description")
-  (dolist (x (nth dun-cdroom dun-room-objects))
-    (if (and (>= x 0) (not (= x 255)))
-	(progn
-	  (dun-mprinc "-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 ")
-	  (dun-mprincl (nth x dun-objfiles))))))
-
-(defun dun-ls-inven ()
-  (dun-mprinc "total 467
-drwxr-xr-x  3 toukmond restricted      512 Jan 1 1970 .
-drwxr-xr-x  3 root     staff          2048 Jan 1 1970 ..")
-  (dolist (x dun-unix-verbs)
-    (if (not (eq (car x) 'IMPOSSIBLE))
-	(progn
-	  (dun-mprinc"
--rwxr-xr-x  1 toukmond restricted    10423 Jan 1 1970 ")
-	  (dun-mprinc (car x)))))
-  (dun-mprinc "\n")
-  (if (not dun-uncompressed)
-      (dun-mprincl
-"-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 paper.o.Z"))
-  (dolist (x dun-inventory)
-    (dun-mprinc 
-"-rwxr-xr-x  1 toukmond restricted        0 Jan 1 1970 ")
-    (dun-mprincl (nth x dun-objfiles))))
-
-(defun dun-echo (args)
-  (let (nomore var)
-    (setq nomore nil)
-    (dolist (x args)
-	    (if (not nomore)
-		(progn
-		  (if (not (string= (substring x 0 1) "$"))
-		      (progn
-			(dun-mprinc x)
-			(dun-mprinc " "))
-		    (setq var (intern (substring x 1)))
-		    (if (not (boundp var))
-			(dun-mprinc " ")
-		      (if (member var dun-restricted)
-			  (progn
-			    (dun-mprinc var)
-			    (dun-mprinc ": Permission denied")
-			    (setq nomore t))
-			(eval (list 'dun-mprinc var))
-			(dun-mprinc " ")))))))
-	    (dun-mprinc "\n")))
-
-
-(defun dun-ftp (args)
-  (let (host username passwd ident newlist)
-    (if (not (car args))
-	(dun-mprincl "ftp: hostname required on command line.")
-      (setq host (intern (car args)))
-      (if (not (member host '(gamma dun-endgame)))
-	  (dun-mprincl "ftp: Unknown host.")
-	(if (eq host 'dun-endgame)
-	    (dun-mprincl "ftp: connection to endgame not allowed")
-	  (if (not dun-ethernet)
-	      (dun-mprincl "ftp: host not responding.")
-	    (dun-mprincl "Connected to gamma. FTP ver 0.9 00:00:00 01/01/70")
-	    (dun-mprinc "Username: ")
-	    (setq username (dun-read-line))
-	    (if (string= username "toukmond")
-		(if dun-batch-mode
-		    (dun-mprincl "toukmond ftp access not allowed.")
-		  (dun-mprincl "\ntoukmond ftp access not allowed."))
-	      (if (string= username "anonymous")
-		  (if dun-batch-mode
-		      (dun-mprincl
-		       "Guest login okay, send your user ident as password.")
-		    (dun-mprincl 
-		     "\nGuest login okay, send your user ident as password."))
-		(if dun-batch-mode
-		    (dun-mprinc "Password required for ")
-		  (dun-mprinc "\nPassword required for "))
-		(dun-mprincl username))
-	      (dun-mprinc "Password: ")
-	      (setq ident (dun-read-line))
-	      (if (not (string= username "anonymous"))
-		  (if dun-batch-mode
-		      (dun-mprincl "Login failed.")
-		    (dun-mprincl "\nLogin failed."))
-		(if dun-batch-mode
-		   (dun-mprincl 
-		    "Guest login okay, user access restrictions apply.")
-		  (dun-mprincl 
-		   "\nGuest login okay, user access restrictions apply."))
-		(dun-ftp-commands)
-		(setq newlist 
-'("What password did you use during anonymous ftp to gamma?"))
-		(setq newlist (append newlist (list ident)))
-		(rplaca (nthcdr 1 dun-endgame-questions) newlist)))))))))
-  
-(defun dun-ftp-commands ()
-    (setq dun-exitf nil)
-    (let (line)
-      (while (not dun-exitf)
-	(dun-mprinc "ftp> ")
-	(setq line (dun-read-line))
-	(if 
-	    (eq
-	     (dun-parse2 nil 
-		    '((type . dun-ftptype) (binary . dun-bin) (bin . dun-bin)
-		      (send . dun-send) (put . dun-send) (quit . dun-ftpquit)
-		      (help . dun-ftphelp)(ascii . dun-fascii)
-		      ) line)
-	     -1)
-	    (dun-mprincl "No such command.  Try help.")))
-      (setq dun-ftptype 'ascii)))
-
-(defun dun-ftptype (args)
-  (if (not (car args))
-      (dun-mprincl "Usage: type [binary | ascii]")
-    (setq args (intern (car args)))
-    (if (eq args 'binary)
-	(dun-bin nil)
-      (if (eq args 'ascii)
-	  (dun-fascii 'nil)
-	(dun-mprincl "Unknown type.")))))
-
-(defun dun-bin (args)
-  (dun-mprincl "Type set to binary.")
-  (setq dun-ftptype 'binary))
-
-(defun dun-fascii (args)
-  (dun-mprincl "Type set to ascii.")
-  (setq dun-ftptype 'ascii))
-
-(defun dun-ftpquit (args)
-  (setq dun-exitf t))
-
-(defun dun-send (args)
-  (if (not (car args))
-      (dun-mprincl "Usage: send <filename>")
-    (setq args (car args))
-    (let (counter foo)
-      (setq foo nil)
-      (setq counter 0)
-
-;;; User can send commands!  Stupid user.
-
-
-      (if (assq (intern args) dun-unix-verbs)
-	  (progn
-	    (rplaca (assq (intern args) dun-unix-verbs) 'IMPOSSIBLE)
-	    (dun-mprinc "Sending ")
-	    (dun-mprinc dun-ftptype)
-	    (dun-mprinc " file for ")
-	    (dun-mprincl args)
-	    (dun-mprincl "Transfer complete."))
-
-	(dolist (x dun-objfiles)
-	  (if (string= args x)
-	      (progn
-		(if (not (member counter dun-inventory))
-		    (progn
-		      (dun-mprincl "No such file.")
-		      (setq foo t))
-		  (dun-mprinc "Sending ")
-		  (dun-mprinc dun-ftptype)
-		  (dun-mprinc " file for ")
-		  (dun-mprinc (downcase (cadr (nth counter dun-objects))))
-		  (dun-mprincl ", (0 bytes)")
-		  (if (not (eq dun-ftptype 'binary))
-		      (progn
-			(if (not (member obj-protoplasm
-					 (nth receiving-room 
-					      dun-room-objects)))
-			    (dun-replace dun-room-objects receiving-room
-				     (append (nth receiving-room 
-						  dun-room-objects)
-					     (list obj-protoplasm))))
-			(dun-remove-obj-from-inven counter))
-		    (dun-remove-obj-from-inven counter)
-		    (dun-replace dun-room-objects receiving-room
-			     (append (nth receiving-room dun-room-objects)
-				     (list counter))))
-		  (setq foo t)
-		  (dun-mprincl "Transfer complete."))))
-	  (setq counter (+ 1 counter)))
-	(if (not foo)
-	    (dun-mprincl "No such file."))))))
-
-(defun dun-ftphelp (args)
-  (dun-mprincl 
-   "Possible commands are:\nsend    quit    type   ascii  binary   help"))
-
-(defun dun-uexit (args)
-  (setq dungeon-mode 'dungeon)
-  (dun-mprincl "\nYou step back from the console.")
-  (define-key dungeon-mode-map "\r" 'dun-parse)
-  (if (not dun-batch-mode)
-      (dun-messages)))
-
-(defun dun-pwd (args)
-  (dun-mprincl dun-cdpath))
-
-(defun dun-uncompress (args)
-  (if (not (car args))
-      (dun-mprincl "Usage: uncompress <filename>")
-    (setq args (car args))
-    (if (or dun-uncompressed
-	    (and (not (string= args "paper.o"))
-		 (not (string= args "paper.o.z"))))
-	(dun-mprincl "Uncompress command failed.")
-      (setq dun-uncompressed t)
-      (setq dun-inventory (append dun-inventory (list obj-paper))))))
-
-(defun dun-rlogin (args)
-  (let (passwd)
-    (if (not (car args))
-	(dun-mprincl "Usage: rlogin <hostname>")
-      (setq args (car args))
-      (if (string= args "endgame")
-	  (dun-rlogin-endgame)
-	(if (not (string= args "gamma"))
-	    (dun-mprincl "No such host.")
-	  (if (not dun-ethernet)
-	      (dun-mprincl "Host not responding.")
-	    (dun-mprinc "Password: ")
-	    (setq passwd (dun-read-line))
-	    (if (not (string= passwd "worms"))
-		(dun-mprincl "\nlogin incorrect")
-	      (dun-mprinc 
-"\nYou begin to feel strange for a moment, and you lose your items."
-)
-	      (dun-replace dun-room-objects computer-room 
-		       (append (nth computer-room dun-room-objects) 
-			       dun-inventory))
-	      (setq dun-inventory nil)
-	      (setq dun-current-room receiving-room)
-	      (dun-uexit nil))))))))
-  
-(defun dun-cd (args)
-  (let (tcdpath tcdroom path-elements room-check)
-    (if (not (car args))
-	(dun-mprincl "Usage: cd <path>")
-      (setq tcdpath dun-cdpath)
-      (setq tcdroom dun-cdroom)
-      (setq dun-badcd nil)
-      (condition-case nil
-	  (setq path-elements (dun-get-path (car args) nil))
-	(error (dun-mprincl "Invalid path.")
-	       (setq dun-badcd t)))
-      (dolist (pe path-elements)
-	      (unless dun-badcd
-		      (if (not (string= pe "."))
-			  (if (string= pe "..")
-			      (progn
-				(if (> tcdroom 0)                  ;In a room
-				    (progn
-				      (setq tcdpath "/rooms")
-				      (setq tcdroom -2))
-					;In /rooms,/usr,root
-				  (if (or 
-				       (= tcdroom -2) (= tcdroom -4) 
-				       (= tcdroom -3))
-				      (progn
-					(setq tcdpath "/")
-					(setq tcdroom -3))
-				    (if (= tcdroom -10)       ;In /usr/toukmond
-					(progn
-					  (setq tcdpath "/usr")
-					  (setq tcdroom -4))))))
-			    (if (string= pe "/")
-				(progn
-				  (setq tcdpath "/")
-				  (setq tcdroom -3))
-			      (if (= tcdroom -4)
-				  (if (string= pe "toukmond")
-				      (progn
-					(setq tcdpath "/usr/toukmond")
-					(setq tcdroom -10))
-				    (dun-nosuchdir))
-				(if (= tcdroom -10)
-				    (dun-nosuchdir)
-				  (if (> tcdroom 0)
-				      (dun-nosuchdir)
-				    (if (= tcdroom -3)
-					(progn
-					  (if (string= pe "rooms")
-					      (progn
-						(setq tcdpath "/rooms")
-						(setq tcdroom -2))
-					    (if (string= pe "usr")
-						(progn
-						  (setq tcdpath "/usr")
-						  (setq tcdroom -4))
-					      (dun-nosuchdir))))
-				      (if (= tcdroom -2)
-					  (progn
-					    (dolist (x dun-visited)
-						    (setq room-check 
-							  (nth x 
-							      dun-room-shorts))
-						    (if (string= room-check pe)
-							(progn
-							  (setq tcdpath 
-						 (concat "/rooms/" room-check))
-							  (setq tcdroom x))))
-					    (if (= tcdroom -2)
-						(dun-nosuchdir)))))))))))))
-      (if (not dun-badcd)
-	  (progn
-	    (setq dun-cdpath tcdpath)
-	    (setq dun-cdroom tcdroom)
-	    0)
-      -2))))
-
-(defun dun-nosuchdir ()
-  (dun-mprincl "No such directory.")
-  (setq dun-badcd t))
-
-(defun dun-cat (args)
-  (let (doto checklist)
-    (if (not (setq args (car args)))
-	(dun-mprincl "Usage: cat <ascii-file-name>")
-      (if (string-match "/" args)
-	  (dun-mprincl "cat: only files in current directory allowed.")
-	(if (and (> dun-cdroom 0) (string= args "description"))
-	    (dun-mprincl (car (nth dun-cdroom dun-rooms)))
-	  (if (setq doto (string-match "\\.o" args))
-	      (progn
-		(if (= dun-cdroom -10)
-		    (setq checklist dun-inventory)
-		  (setq checklist (nth dun-cdroom dun-room-objects)))
-		(if (not (member (cdr 
-				  (assq (intern 
-					 (substring args 0 doto)) 
-					dun-objnames))
-				 checklist))
-		    (dun-mprincl "File not found.")
-		  (dun-mprincl "Ascii files only.")))
-	    (if (assq (intern args) dun-unix-verbs)
-		(dun-mprincl "Ascii files only.")
-	      (dun-mprincl "File not found."))))))))
-  
-(defun dun-zippy (args)
-  (dun-mprincl (yow)))
-
-(defun dun-rlogin-endgame ()
-  (if (not (= (dun-score nil) 90))
-      (dun-mprincl 
-       "You have not achieved enough points to connect to endgame.")
-    (dun-mprincl"\nWelcome to the endgame.  You are a truly noble adventurer.")
-    (setq dun-current-room treasure-room)
-    (setq dun-endgame t)
-    (dun-replace dun-room-objects endgame-treasure-room (list obj-bill))
-    (dun-uexit nil)))
-
-
-(random t)
-(setq tloc (+ 60 (random 18)))
-(dun-replace dun-room-objects tloc 
-	     (append (nth tloc dun-room-objects) (list 18)))
-
-(setq tcomb (+ 100 (random 899)))
-(setq dun-combination (prin1-to-string tcomb))
-
-;;;;
-;;;; This section defines the DOS emulation functions for dunnet
-;;;;
-
-(defun dun-dos-parse (args)
-  (interactive "*p")
-  (beginning-of-line)
-  (let (beg)
-    (setq beg (+ (point) 3))
-    (end-of-line)
-    (if (not (= beg (point)))
-	(let (line)
-	  (setq line (downcase (buffer-substring beg (point))))
-	  (princ line)
-	  (if (eq (dun-parse2 nil dun-dos-verbs line) -1)
-	      (progn
-		(sleep-for 1)
-		(dun-mprincl "Bad command or file name"))))
-      (goto-char (point-max))
-      (dun-mprinc "\n"))
-    (if (eq dungeon-mode 'dos)
-	(progn
-	  (dun-fix-screen)
-	  (dun-dos-prompt)))))
-
-(defun dun-dos-interface ()
-  (dun-dos-boot-msg)
-  (setq dungeon-mode 'dos)
-  (define-key dungeon-mode-map "\r" 'dun-dos-parse)
-  (dun-dos-prompt))
-
-(defun dun-dos-type (args)
-  (sleep-for 2)
-  (if (setq args (car args))
-      (if (string= args "foo.txt")
-	  (dun-dos-show-combination)
-	(if (string= args "command.com")
-	    (dun-mprincl "Cannot type binary files")
-	  (dun-mprinc "File not found - ")
-	  (dun-mprincl (upcase args))))
-    (dun-mprincl "Must supply file name")))
-
-(defun dun-dos-invd (args)
-  (sleep-for 1)
-  (dun-mprincl "Invalid drive specification"))
-
-(defun dun-dos-dir (args)
-  (sleep-for 1)
-  (if (or (not (setq args (car args))) (string= args "\\"))
-      (dun-mprincl "
- Volume in drive A is FOO        
- Volume Serial Number is 1A16-08C9
- Directory of A:\\
-
-COMMAND  COM     47845 04-09-91   2:00a
-FOO      TXT        40 01-20-93   1:01a
-        2 file(s)      47845 bytes
-                     1065280 bytes free
-")
-    (dun-mprincl "
- Volume in drive A is FOO        
- Volume Serial Number is 1A16-08C9
- Directory of A:\\
-
-File not found")))
-
-
-(defun dun-dos-prompt ()
-  (dun-mprinc "A> "))
-
-(defun dun-dos-boot-msg ()
-  (sleep-for 3)
-  (dun-mprinc "Current time is ")
-  (dun-mprincl (substring (current-time-string) 12 20))
-  (dun-mprinc "Enter new time: ")
-  (dun-read-line)
-  (if (not dun-batch-mode)
-      (dun-mprinc "\n")))
-
-(defun dun-dos-spawn (args)
-  (sleep-for 1)
-  (dun-mprincl "Cannot spawn subshell"))
-
-(defun dun-dos-exit (args)
-  (setq dungeon-mode 'dungeon)
-  (dun-mprincl "\nYou power down the machine and step back.")
-  (define-key dungeon-mode-map "\r" 'dun-parse)
-  (if (not dun-batch-mode)
-      (dun-messages)))
-
-(defun dun-dos-no-disk ()
-  (sleep-for 3)
-  (dun-mprincl "Boot sector not found"))
-
-
-(defun dun-dos-show-combination ()
-  (sleep-for 2)
-  (dun-mprinc "\nThe combination is ")
-  (dun-mprinc dun-combination)
-  (dun-mprinc ".\n"))
-
-(defun dun-dos-nil (args))
-
-
-;;;;
-;;;; This section defines the save and restore game functions for dunnet.
-;;;;
-
-(defun dun-save-game (filename)
-  (if (not (setq filename (car filename)))
-      (dun-mprincl "You must supply a filename for the save.")
-    (if (file-exists-p filename)
-	(delete-file filename))
-    (setq dun-numsaves (1+ dun-numsaves))
-    (dun-make-save-buffer)
-    (dun-save-val "dun-current-room")
-    (dun-save-val "dun-computer")
-    (dun-save-val "dun-combination")
-    (dun-save-val "dun-visited")
-    (dun-save-val "dun-diggables")
-    (dun-save-val "dun-key-level")
-    (dun-save-val "dun-floppy")
-    (dun-save-val "dun-numsaves")
-    (dun-save-val "dun-numcmds")
-    (dun-save-val "dun-logged-in")
-    (dun-save-val "dungeon-mode")
-    (dun-save-val "dun-jar")
-    (dun-save-val "dun-lastdir")
-    (dun-save-val "dun-black")
-    (dun-save-val "dun-nomail")
-    (dun-save-val "dun-unix-verbs")
-    (dun-save-val "dun-hole")
-    (dun-save-val "dun-uncompressed")
-    (dun-save-val "dun-ethernet")
-    (dun-save-val "dun-sauna-level")
-    (dun-save-val "dun-room-objects")
-    (dun-save-val "dun-room-silents")
-    (dun-save-val "dun-inventory")
-    (dun-save-val "dun-endgame-questions")
-    (dun-save-val "dun-endgame")
-    (dun-save-val "dun-cdroom")
-    (dun-save-val "dun-cdpath")
-    (dun-save-val "dun-correct-answer")
-    (dun-save-val "dun-inbus")
-    (if (dun-compile-save-out filename)
-	(dun-mprincl "Error saving to file.")
-      (dun-do-logfile 'save nil)
-      (switch-to-buffer "*dungeon*")
-      (princ "")
-      (dun-mprincl "Done."))))
-
-(defun dun-make-save-buffer ()
-  (switch-to-buffer (get-buffer-create "*save-dungeon*"))
-  (erase-buffer))
-
-(defun dun-compile-save-out (filename)
-  (let (ferror)
-    (setq ferror nil)
-    (condition-case nil
-	(dun-rot13)
-      (error (setq ferror t)))
-    (if (not ferror)
-	(progn
-	  (goto-char (point-min))))
-    (condition-case nil
-        (write-region 1 (point-max) filename nil 1)
-        (error (setq ferror t)))
-    (kill-buffer (current-buffer))
-    ferror))
-    
-
-(defun dun-save-val (varname)
-  (let (value)
-    (setq varname (intern varname))
-    (setq value (eval varname))
-    (dun-minsert "(setq ")
-    (dun-minsert varname)
-    (dun-minsert " ")
-    (if (or (listp value)
-	    (symbolp value))
-	(dun-minsert "'"))
-    (if (stringp value)
-	(dun-minsert "\""))
-    (dun-minsert value)
-    (if (stringp value)
-	(dun-minsert "\""))
-    (dun-minsertl ")")))
-
-
-(defun dun-restore (args)
-  (let (file)
-    (if (not (setq file (car args)))
-	(dun-mprincl "You must supply a filename.")
-      (if (not (dun-load-d file))
-	  (dun-mprincl "Could not load restore file.")
-	(dun-mprincl "Done.")
-	(setq room 0)))))
-
-
-(defun dun-do-logfile (type how)
-  (let (ferror newscore)
-    (setq ferror nil)
-    (switch-to-buffer (get-buffer-create "*score*"))
-    (erase-buffer)
-    (condition-case nil
-	(insert-file-contents dun-log-file)
-      (error (setq ferror t)))
-    (unless ferror
-	    (goto-char (point-max))
-	    (dun-minsert (current-time-string))
-	    (dun-minsert " ")
-	    (dun-minsert (user-login-name))
-	    (dun-minsert " ")
-	    (if (eq type 'save)
-		(dun-minsert "saved ")
-	      (if (= (dun-endgame-score) 110)
-		  (dun-minsert "won ")
-		(if (not how)
-		    (dun-minsert "quit ")
-		  (dun-minsert "killed by ")
-		  (dun-minsert how)
-		  (dun-minsert " "))))
-	    (dun-minsert "at ")
-	    (dun-minsert (cadr (nth (abs room) dun-rooms)))
-	    (dun-minsert ". score: ")
-	    (if (> (dun-endgame-score) 0)
-		(dun-minsert (setq newscore (+ 90 (dun-endgame-score))))
-	      (dun-minsert (setq newscore (dun-reg-score))))
-	    (dun-minsert " saves: ")
-	    (dun-minsert dun-numsaves)
-	    (dun-minsert " commands: ")
-	    (dun-minsert dun-numcmds)
-	    (dun-minsert "\n")
-	    (write-region 1 (point-max) dun-log-file nil 1))
-    (kill-buffer (current-buffer))))
-
-
-;;;;
-;;;; These are functions, and function re-definitions so that dungeon can
-;;;; be run in batch mode.
-
-
-(defun dun-batch-mprinc (arg)
-   (if (stringp arg)
-       (send-string-to-terminal arg)
-     (send-string-to-terminal (prin1-to-string arg))))
-
-
-(defun dun-batch-mprincl (arg)
-   (if (stringp arg)
-       (progn
-           (send-string-to-terminal arg)
-           (send-string-to-terminal "\n"))
-     (send-string-to-terminal (prin1-to-string arg))
-     (send-string-to-terminal "\n")))
-
-(defun dun-batch-parse (dun-ignore dun-verblist line)
-  (setq line-list (dun-listify-string (concat line " ")))
-  (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list)))
-
-(defun dun-batch-parse2 (dun-ignore dun-verblist line)
-  (setq line-list (dun-listify-string2 (concat line " ")))
-  (dun-doverb dun-ignore dun-verblist (car line-list) (cdr line-list)))
-
-(defun dun-batch-read-line ()
-  (read-from-minibuffer "" nil dungeon-batch-map))
-
-
-(defun dun-batch-loop ()
-  (setq dun-dead nil)
-  (setq room 0)
-  (while (not dun-dead)
-    (if (eq dungeon-mode 'dungeon)
-	(progn
-	  (if (not (= room dun-current-room))
-	      (progn
-		(dun-describe-room dun-current-room)
-		(setq room dun-current-room)))
-	  (dun-mprinc ">")
-	  (setq line (downcase (dun-read-line)))
-	  (if (eq (dun-vparse dun-ignore dun-verblist line) -1)
-	      (dun-mprinc "I don't understand that.\n"))))))
-
-(defun dun-batch-dos-interface ()
-  (dun-dos-boot-msg)
-  (setq dungeon-mode 'dos)
-  (while (eq dungeon-mode 'dos)
-    (dun-dos-prompt)
-    (setq line (downcase (dun-read-line)))
-    (if (eq (dun-parse2 nil dun-dos-verbs line) -1)
-	(progn
-	  (sleep-for 1)
-	  (dun-mprincl "Bad command or file name"))))
-  (goto-char (point-max))
-  (dun-mprinc "\n"))
-
-(defun dun-batch-unix-interface ()
-    (dun-login)
-    (if dun-logged-in
-	(progn
-	  (setq dungeon-mode 'unix)
-	  (while (eq dungeon-mode 'unix)
-	    (dun-mprinc "$ ")
-	    (setq line (downcase (dun-read-line)))
-	    (if (eq (dun-parse2 nil dun-unix-verbs line) -1)
-		(let (esign)
-		  (if (setq esign (string-match "=" line))
-		      (dun-doassign line esign)		
-		    (dun-mprinc (car line-list))
-		    (dun-mprincl ": not found.")))))
-	  (goto-char (point-max))
-	  (dun-mprinc "\n"))))
-
-(defun dungeon-nil (arg)
-  "noop"
-  (interactive "*p"))
-
-(defun dun-batch-dungeon ()
-  (load "dun-batch")
-  (setq dun-visited '(27))
-  (dun-mprinc "\n")
-  (dun-batch-loop))
-
-(unless (not noninteractive)
-  (fset 'dun-mprinc 'dun-batch-mprinc)
-  (fset 'dun-mprincl 'dun-batch-mprincl)
-  (fset 'dun-vparse 'dun-batch-parse)
-  (fset 'dun-parse2 'dun-batch-parse2)
-  (fset 'dun-read-line 'dun-batch-read-line)
-  (fset 'dun-dos-interface 'dun-batch-dos-interface)
-  (fset 'dun-unix-interface 'dun-batch-unix-interface)
-  (dun-mprinc "\n")
-  (setq dun-batch-mode t)
-  (dun-batch-loop))
-
-
diff --git a/lisp/play/gomoku.el b/lisp/play/gomoku.el
deleted file mode 100644
index 332d1cedd9c..00000000000
--- a/lisp/play/gomoku.el
+++ /dev/null
@@ -1,1182 +0,0 @@
-;;; gomoku.el --- Gomoku game between you and Emacs
-
-;; Copyright (C) 1988, 1994, 1996 Free Software Foundation, Inc.
-
-;; Author: Philippe Schnoebelen <phs@lifia.imag.fr>
-;; Adapted-By: ESR, Daniel.Pfeiffer@Informatik.START.dbp.de
-;; Keywords: games
-
-;; 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:
-
-;; RULES:
-;;
-;; Gomoku is a game played between two players on a rectangular board.	Each
-;; player, in turn, marks a free square of its choice. The winner is the first
-;; one to mark five contiguous squares in any direction (horizontally,
-;; vertically or diagonally).
-;;
-;; I have been told that, in "The TRUE Gomoku", some restrictions are made
-;; about the squares where one may play, or else there is a known forced win
-;; for the first player. This program has no such restriction, but it does not
-;; know about the forced win, nor do I.	 Furthermore, you probably do not know
-;; it yourself :-).
-
-
-;; There are two main places where you may want to customize the program: key
-;; bindings and board display. These features are commented in the code. Go
-;; and see.
-
-
-;; HOW TO USE:
-;;
-;; The command "M-x gomoku" displays a
-;; board, the size of which depends on the size of the current window. The
-;; size of the board is easily modified by giving numeric arguments to the
-;; gomoku command and/or by customizing the displaying parameters.
-;;
-;; Emacs plays when it is its turn. When it is your turn, just put the cursor
-;; on the square where you want to play and hit RET, or X, or whatever key you
-;; bind to the command gomoku-human-plays. When it is your turn, Emacs is
-;; idle: you may switch buffers, read your mail, ... Just come back to the
-;; *Gomoku* buffer and resume play.
-
-
-;; ALGORITHM:
-;;
-;; The algorithm is briefly described in section "THE SCORE TABLE". Some
-;; parameters may be modified if you want to change the style exhibited by the
-;; program.
-
-;;; Code:
-
-;;;
-;;; GOMOKU MODE AND KEYMAP.
-;;;
-(defvar gomoku-mode-hook nil
-  "If non-nil, its value is called on entry to Gomoku mode.")
-
-(defvar gomoku-mode-map nil
-  "Local keymap to use in Gomoku mode.")
-
-(if gomoku-mode-map nil
-  (setq gomoku-mode-map (make-sparse-keymap))
-
-  ;; Key bindings for cursor motion.
-  (define-key gomoku-mode-map "y" 'gomoku-move-nw)		; y
-  (define-key gomoku-mode-map "u" 'gomoku-move-ne)		; u
-  (define-key gomoku-mode-map "b" 'gomoku-move-sw)		; b
-  (define-key gomoku-mode-map "n" 'gomoku-move-se)		; n
-  (define-key gomoku-mode-map "h" 'backward-char)		; h
-  (define-key gomoku-mode-map "l" 'forward-char)		; l
-  (define-key gomoku-mode-map "j" 'gomoku-move-down)		; j
-  (define-key gomoku-mode-map "k" 'gomoku-move-up)		; k
-
-  (define-key gomoku-mode-map [kp-7] 'gomoku-move-nw)
-  (define-key gomoku-mode-map [kp-9] 'gomoku-move-ne)
-  (define-key gomoku-mode-map [kp-1] 'gomoku-move-sw)
-  (define-key gomoku-mode-map [kp-3] 'gomoku-move-se)
-  (define-key gomoku-mode-map [kp-4] 'backward-char)
-  (define-key gomoku-mode-map [kp-6] 'forward-char)
-  (define-key gomoku-mode-map [kp-2] 'gomoku-move-down)
-  (define-key gomoku-mode-map [kp-8] 'gomoku-move-up)
-
-  (define-key gomoku-mode-map "\C-n" 'gomoku-move-down)		; C-n
-  (define-key gomoku-mode-map "\C-p" 'gomoku-move-up)		; C-p
-
-  ;; Key bindings for entering Human moves.
-  (define-key gomoku-mode-map "X" 'gomoku-human-plays)		; X
-  (define-key gomoku-mode-map "x" 'gomoku-human-plays)		; x
-  (define-key gomoku-mode-map " " 'gomoku-human-plays)		; SPC
-  (define-key gomoku-mode-map "\C-m" 'gomoku-human-plays)	; RET
-  (define-key gomoku-mode-map "\C-c\C-p" 'gomoku-human-plays)	; C-c C-p
-  (define-key gomoku-mode-map "\C-c\C-b" 'gomoku-human-takes-back) ; C-c C-b
-  (define-key gomoku-mode-map "\C-c\C-r" 'gomoku-human-resigns)	; C-c C-r
-  (define-key gomoku-mode-map "\C-c\C-e" 'gomoku-emacs-plays)	; C-c C-e
-
-  (define-key gomoku-mode-map [kp-enter] 'gomoku-human-plays)
-  (define-key gomoku-mode-map [insert] 'gomoku-human-plays)
-  (define-key gomoku-mode-map [down-mouse-1] 'gomoku-click)
-  (define-key gomoku-mode-map [drag-mouse-1] 'gomoku-click)
-  (define-key gomoku-mode-map [mouse-1] 'gomoku-click)
-  (define-key gomoku-mode-map [down-mouse-2] 'gomoku-click)
-  (define-key gomoku-mode-map [mouse-2] 'gomoku-mouse-play)
-  (define-key gomoku-mode-map [drag-mouse-2] 'gomoku-mouse-play)
-
-  (substitute-key-definition 'previous-line 'gomoku-move-up
-			     gomoku-mode-map (current-global-map))
-  (substitute-key-definition 'next-line 'gomoku-move-down
-			     gomoku-mode-map (current-global-map))
-  (substitute-key-definition 'beginning-of-line 'gomoku-beginning-of-line
-			     gomoku-mode-map (current-global-map))
-  (substitute-key-definition 'end-of-line 'gomoku-end-of-line
-			     gomoku-mode-map (current-global-map))
-  (substitute-key-definition 'undo 'gomoku-human-takes-back
-			     gomoku-mode-map (current-global-map))
-  (substitute-key-definition 'advertised-undo 'gomoku-human-takes-back
-			     gomoku-mode-map (current-global-map)))
-
-(defvar gomoku-emacs-won ()
-  "*For making font-lock use the winner's face for the line.")
-
-(defvar gomoku-font-lock-O-face
-  (if window-system
-      (list (facemenu-get-face 'fg:red) 'bold))
-  "*Face to use for Emacs' O.")
-
-(defvar gomoku-font-lock-X-face
-  (if window-system
-      (list (facemenu-get-face 'fg:green) 'bold))
-  "*Face to use for your X.")
-
-(defvar gomoku-font-lock-keywords
-  '(("O" . gomoku-font-lock-O-face)
-    ("X" . gomoku-font-lock-X-face)
-    ("[-|/\\]" 0 (if gomoku-emacs-won
-		     gomoku-font-lock-O-face
-		   gomoku-font-lock-X-face)))
-  "*Font lock rules for Gomoku.")
-
-(put 'gomoku-mode 'front-sticky
-     (put 'gomoku-mode 'rear-nonsticky '(intangible)))
-(put 'gomoku-mode 'intangible 1)
-
-(defun gomoku-mode ()
-  "Major mode for playing Gomoku against Emacs.
-You and Emacs play in turn by marking a free square.  You mark it with X
-and Emacs marks it with O.  The winner is the first to get five contiguous
-marks horizontally, vertically or in diagonal.
-
-You play by moving the cursor over the square you choose and hitting \\[gomoku-human-plays].
-
-Other useful commands:
-\\{gomoku-mode-map}
-Entry to this mode calls the value of `gomoku-mode-hook' if that value
-is non-nil.  One interesting value is `turn-on-font-lock'."
-  (interactive)
-  (setq major-mode 'gomoku-mode
-	mode-name "Gomoku")
-  (gomoku-display-statistics)
-  (use-local-map gomoku-mode-map)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(gomoku-font-lock-keywords t))
-  (toggle-read-only t)
-  (run-hooks 'gomoku-mode-hook))
-
-;;;
-;;; THE BOARD.
-;;;
-
-;; The board is a rectangular grid. We code empty squares with 0, X's with 1
-;; and O's with 6. The rectangle is recorded in a one dimensional vector
-;; containing padding squares (coded with -1). These squares allow us to
-;; detect when we are trying to move out of the board.	We denote a square by
-;; its (X,Y) coords, or by the INDEX corresponding to them in the vector.  The
-;; leftmost topmost square has coords (1,1) and index gomoku-board-width + 2.
-;; Similarly, vectors between squares may be given by two DX, DY coords or by
-;; one DEPL (the difference between indexes).
-
-(defvar gomoku-board-width nil
-  "Number of columns on the Gomoku board.")
-
-(defvar gomoku-board-height nil
-  "Number of lines on the Gomoku board.")
-
-(defvar gomoku-board nil
-  "Vector recording the actual state of the Gomoku board.")
-
-(defvar gomoku-vector-length nil
-  "Length of gomoku-board vector.")
-
-(defvar gomoku-draw-limit nil
-  ;; This is usually set to 70% of the number of squares.
-  "After how many moves will Emacs offer a draw?")
-
-
-(defun gomoku-xy-to-index (x y)
-  "Translate X, Y cartesian coords into the corresponding board index."
-  (+ (* y gomoku-board-width) x y))
-
-(defun gomoku-index-to-x (index)
-  "Return corresponding x-coord of board INDEX."
-  (% index (1+ gomoku-board-width)))
-
-(defun gomoku-index-to-y (index)
-  "Return corresponding y-coord of board INDEX."
-  (/ index (1+ gomoku-board-width)))
-
-(defun gomoku-init-board ()
-  "Create the gomoku-board vector and fill it with initial values."
-  (setq gomoku-board (make-vector gomoku-vector-length 0))
-  ;; Every square is 0 (i.e. empty) except padding squares:
-  (let ((i 0) (ii (1- gomoku-vector-length)))
-    (while (<= i gomoku-board-width)	; The squares in [0..width] and in
-      (aset gomoku-board i  -1)		;    [length - width - 1..length - 1]
-      (aset gomoku-board ii -1)		;    are padding squares.
-      (setq i  (1+ i)
-	    ii (1- ii))))
-  (let ((i 0))
-    (while (< i gomoku-vector-length)
-      (aset gomoku-board i -1)		; and also all k*(width+1)
-      (setq i (+ i gomoku-board-width 1)))))
-
-;;;
-;;; THE SCORE TABLE.
-;;;
-
-;; Every (free) square has a score associated to it, recorded in the
-;; GOMOKU-SCORE-TABLE vector. The program always plays in the square having
-;; the highest score.
-
-(defvar gomoku-score-table nil
-  "Vector recording the actual score of the free squares.")
-
-
-;; The key point point about the algorithm is that, rather than considering
-;; the board as just a set of squares, we prefer to see it as a "space" of
-;; internested 5-tuples of contiguous squares (called qtuples).
-;;
-;; The aim of the program is to fill one qtuple with its O's while preventing
-;; you from filling another one with your X's. To that effect, it computes a
-;; score for every qtuple, with better qtuples having better scores. Of
-;; course, the score of a qtuple (taken in isolation) is just determined by
-;; its contents as a set, i.e. not considering the order of its elements. The
-;; highest score is given to the "OOOO" qtuples because playing in such a
-;; qtuple is winning the game. Just after this comes the "XXXX" qtuple because
-;; not playing in it is just loosing the game, and so on. Note that a
-;; "polluted" qtuple, i.e. one containing at least one X and at least one O,
-;; has score zero because there is no more any point in playing in it, from
-;; both an attacking and a defending point of view.
-;;
-;; Given the score of every qtuple, the score of a given free square on the
-;; board is just the sum of the scores of all the qtuples to which it belongs,
-;; because playing in that square is playing in all its containing qtuples at
-;; once. And it is that function which takes into account the internesting of
-;; the qtuples.
-;;
-;; This algorithm is rather simple but anyway it gives a not so dumb level of
-;; play. It easily extends to "n-dimensional Gomoku", where a win should not
-;; be obtained with as few as 5 contiguous marks: 6 or 7 (depending on n !)
-;; should be preferred.
-
-
-;; Here are the scores of the nine "non-polluted" configurations.  Tuning
-;; these values will change (hopefully improve) the strength of the program
-;; and may change its style (rather aggressive here).
-
-(defconst nil-score	  7  "Score of an empty qtuple.")
-(defconst Xscore	 15  "Score of a qtuple containing one X.")
-(defconst XXscore	400  "Score of a qtuple containing two X's.")
-(defconst XXXscore     1800  "Score of a qtuple containing three X's.")
-(defconst XXXXscore  100000  "Score of a qtuple containing four X's.")
-(defconst Oscore	 35  "Score of a qtuple containing one O.")
-(defconst OOscore	800  "Score of a qtuple containing two O's.")
-(defconst OOOscore    15000  "Score of a qtuple containing three O's.")
-(defconst OOOOscore  800000  "Score of a qtuple containing four O's.")
-
-;; These values are not just random: if, given the following situation:
-;;
-;;			  . . . . . . . O .
-;;			  . X X a . . . X .
-;;			  . . . X . . . X .
-;;			  . . . X . . . X .
-;;			  . . . . . . . b .
-;;
-;; you want Emacs to play in "a" and not in "b", then the parameters must
-;; satisfy the inequality:
-;;
-;;		   6 * XXscore > XXXscore + XXscore
-;;
-;; because "a" mainly belongs to six "XX" qtuples (the others are less
-;; important) while "b" belongs to one "XXX" and one "XX" qtuples.  Other
-;; conditions are required to obtain sensible moves, but the previous example
-;; should illustrate the point. If you manage to improve on these values,
-;; please send me a note. Thanks.
-
-
-;; As we chose values 0, 1 and 6 to denote empty, X and O squares, the
-;; contents of a qtuple are uniquely determined by the sum of its elements and
-;; we just have to set up a translation table.
-
-(defconst gomoku-score-trans-table
-  (vector nil-score Xscore XXscore XXXscore XXXXscore 0
-	  Oscore    0	   0	   0	    0	      0
-	  OOscore   0	   0	   0	    0	      0
-	  OOOscore  0	   0	   0	    0	      0
-	  OOOOscore 0	   0	   0	    0	      0
-	  0)
-  "Vector associating qtuple contents to their score.")
-
-
-;; If you do not modify drastically the previous constants, the only way for a
-;; square to have a score higher than OOOOscore is to belong to a "OOOO"
-;; qtuple, thus to be a winning move. Similarly, the only way for a square to
-;; have a score between XXXXscore and OOOOscore is to belong to a "XXXX"
-;; qtuple. We may use these considerations to detect when a given move is
-;; winning or loosing.
-
-(defconst gomoku-winning-threshold OOOOscore
-  "Threshold score beyond which an Emacs move is winning.")
-
-(defconst gomoku-loosing-threshold XXXXscore
-  "Threshold score beyond which a human move is winning.")
-
-
-(defun gomoku-strongest-square ()
-  "Compute index of free square with highest score, or nil if none."
-  ;; We just have to loop other all squares. However there are two problems:
-  ;; 1/ The SCORE-TABLE only gives correct scores to free squares. To speed
-  ;;	up future searches, we set the score of padding or occupied squares
-  ;;	to -1 whenever we meet them.
-  ;; 2/ We want to choose randomly between equally good moves.
-  (let ((score-max 0)
-	(count	   0)			; Number of equally good moves
-	(square	   (gomoku-xy-to-index 1 1)) ; First square
-	(end	   (gomoku-xy-to-index gomoku-board-width gomoku-board-height))
-	best-square score)
-    (while (<= square end)
-      (cond
-       ;; If score is lower (i.e. most of the time), skip to next:
-       ((< (aref gomoku-score-table square) score-max))
-       ;; If score is better, beware of non free squares:
-       ((> (setq score (aref gomoku-score-table square)) score-max)
-	(if (zerop (aref gomoku-board square)) ; is it free ?
-	    (setq count 1		       ; yes: take it !
-		  best-square square
-		  score-max   score)
-	    (aset gomoku-score-table square -1))) ; no: kill it !
-       ;; If score is equally good, choose randomly. But first check freeness:
-       ((not (zerop (aref gomoku-board square)))
-	(aset gomoku-score-table square -1))
-       ((zerop (random (setq count (1+ count))))
-	(setq best-square square
-	      score-max	  score)))
-      (setq square (1+ square)))	; try next square
-    best-square))
-
-;;;
-;;; INITIALIZING THE SCORE TABLE.
-;;;
-
-;; At initialization the board is empty so that every qtuple amounts for
-;; nil-score. Therefore, the score of any square is nil-score times the number
-;; of qtuples that pass through it. This number is 3 in a corner and 20 if you
-;; are sufficiently far from the sides. As computing the number is time
-;; consuming, we initialize every square with 20*nil-score and then only
-;; consider squares at less than 5 squares from one side. We speed this up by
-;; taking symmetry into account.
-;; Also, as it is likely that successive games will be played on a board with
-;; same size, it is a good idea to save the initial SCORE-TABLE configuration.
-
-(defvar gomoku-saved-score-table nil
-  "Recorded initial value of previous score table.")
-
-(defvar gomoku-saved-board-width nil
-  "Recorded value of previous board width.")
-
-(defvar gomoku-saved-board-height nil
-  "Recorded value of previous board height.")
-
-
-(defun gomoku-init-score-table ()
-  "Create the score table vector and fill it with initial values."
-  (if (and gomoku-saved-score-table	; Has it been stored last time ?
-	   (= gomoku-board-width  gomoku-saved-board-width)
-	   (= gomoku-board-height gomoku-saved-board-height))
-      (setq gomoku-score-table (copy-sequence gomoku-saved-score-table))
-      ;; No, compute it:
-      (setq gomoku-score-table
-	    (make-vector gomoku-vector-length (* 20 nil-score)))
-      (let (i j maxi maxj maxi2 maxj2)
-	(setq maxi  (/ (1+ gomoku-board-width) 2)
-	      maxj  (/ (1+ gomoku-board-height) 2)
-	      maxi2 (min 4 maxi)
-	      maxj2 (min 4 maxj))
-	;; We took symmetry into account and could use it more if the board
-	;; would have been square and not rectangular !
-	;; In our case we deal with all (i,j) in the set [1..maxi2]*[1..maxj] U
-	;; [maxi2+1..maxi]*[1..maxj2]. Maxi2 and maxj2 are used because the
-	;; board may well be less than 8 by 8 !
-	(setq i 1)
-	(while (<= i maxi2)
-	  (setq j 1)
-	  (while (<= j maxj)
-	    (gomoku-init-square-score i j)
-	    (setq j (1+ j)))
-	  (setq i (1+ i)))
-	(while (<= i maxi)
-	  (setq j 1)
-	  (while (<= j maxj2)
-	    (gomoku-init-square-score i j)
-	    (setq j (1+ j)))
-	  (setq i (1+ i))))
-      (setq gomoku-saved-score-table  (copy-sequence gomoku-score-table)
-	    gomoku-saved-board-width  gomoku-board-width
-	    gomoku-saved-board-height gomoku-board-height)))
-
-(defun gomoku-nb-qtuples (i j)
-  "Return the number of qtuples containing square I,J."
-  ;; This function is complicated because we have to deal
-  ;; with ugly cases like 3 by 6 boards, but it works.
-  ;; If you have a simpler (and correct) solution, send it to me. Thanks !
-  (let ((left  (min 4 (1- i)))
-	(right (min 4 (- gomoku-board-width i)))
-	(up    (min 4 (1- j)))
-	(down  (min 4 (- gomoku-board-height j))))
-    (+ -12
-       (min (max (+ left right) 3) 8)
-       (min (max (+ up down) 3) 8)
-       (min (max (+ (min left up) (min right down)) 3) 8)
-       (min (max (+ (min right up) (min left down)) 3) 8))))
-
-(defun gomoku-init-square-score (i j)
-  "Give initial score to square I,J and to its mirror images."
-  (let ((ii (1+ (- gomoku-board-width i)))
-	(jj (1+ (- gomoku-board-height j)))
-	(sc (* (gomoku-nb-qtuples i j) (aref gomoku-score-trans-table 0))))
-    (aset gomoku-score-table (gomoku-xy-to-index i  j)	sc)
-    (aset gomoku-score-table (gomoku-xy-to-index ii j)	sc)
-    (aset gomoku-score-table (gomoku-xy-to-index i  jj) sc)
-    (aset gomoku-score-table (gomoku-xy-to-index ii jj) sc)))
-
-;;;
-;;; MAINTAINING THE SCORE TABLE.
-;;;
-
-;; We do not provide functions for computing the SCORE-TABLE given the
-;; contents of the BOARD. This would involve heavy nested loops, with time
-;; proportional to the size of the board. It is better to update the
-;; SCORE-TABLE after each move. Updating needs not modify more than 36
-;; squares: it is done in constant time.
-
-(defun gomoku-update-score-table (square dval)
-  "Update score table after SQUARE received a DVAL increment."
-  ;; The board has already been updated when this function is called.
-  ;; Updating scores is done by looking for qtuples boundaries in all four
-  ;; directions and then calling update-score-in-direction.
-  ;; Finally all squares received the right increment, and then are up to
-  ;; date, except possibly for SQUARE itself if we are taking a move back for
-  ;; its score had been set to -1 at the time.
-  (let* ((x    (gomoku-index-to-x square))
-	 (y    (gomoku-index-to-y square))
-	 (imin (max -4 (- 1 x)))
-	 (jmin (max -4 (- 1 y)))
-	 (imax (min 0 (- gomoku-board-width x 4)))
-	 (jmax (min 0 (- gomoku-board-height y 4))))
-    (gomoku-update-score-in-direction imin imax
-				      square 1 0 dval)
-    (gomoku-update-score-in-direction jmin jmax
-				      square 0 1 dval)
-    (gomoku-update-score-in-direction (max imin jmin) (min imax jmax)
-				      square 1 1 dval)
-    (gomoku-update-score-in-direction (max (- 1 y) -4
-					   (- x gomoku-board-width))
-				      (min 0 (- x 5)
-					   (- gomoku-board-height y 4))
-				      square -1 1 dval)))
-
-(defun gomoku-update-score-in-direction (left right square dx dy dval)
-  "Update scores for all squares in the qtuples starting between the LEFTth
-square and the RIGHTth after SQUARE, along the DX, DY direction, considering
-that DVAL has been added on SQUARE."
-  ;; We always have LEFT <= 0, RIGHT <= 0 and DEPL > 0 but we may very well
-  ;; have LEFT > RIGHT, indicating that no qtuple contains SQUARE along that
-  ;; DX,DY direction.
-  (cond
-   ((> left right))			; Quit
-   (t					; Else ..
-    (let (depl square0 square1 square2 count delta)
-      (setq depl    (gomoku-xy-to-index dx dy)
-	    square0 (+ square (* left depl))
-	    square1 (+ square (* right depl))
-	    square2 (+ square0 (* 4 depl)))
-      ;; Compute the contents of the first qtuple:
-      (setq square square0
-	    count  0)
-      (while (<= square square2)
-	(setq count  (+ count (aref gomoku-board square))
-	      square (+ square depl)))
-      (while (<= square0 square1)
-	;; Update the squares of the qtuple beginning in SQUARE0 and ending
-	;; in SQUARE2.
-	(setq delta (- (aref gomoku-score-trans-table count)
-		       (aref gomoku-score-trans-table (- count dval))))
-	(cond ((not (zerop delta))	; or else nothing to update
-	       (setq square square0)
-	       (while (<= square square2)
-		 (if (zerop (aref gomoku-board square)) ; only for free squares
-		     (aset gomoku-score-table square
-			   (+ (aref gomoku-score-table square) delta)))
-		 (setq square (+ square depl)))))
-	;; Then shift the qtuple one square along DEPL, this only requires
-	;; modifying SQUARE0 and SQUARE2.
-	(setq square2 (+ square2 depl)
-	      count   (+ count (- (aref gomoku-board square0))
-			 (aref gomoku-board square2))
-	      square0 (+ square0 depl)))))))
-
-;;;
-;;; GAME CONTROL.
-;;;
-
-;; Several variables are used to monitor a game, including a GAME-HISTORY (the
-;; list of all (SQUARE . PREVSCORE) played) that allows to take moves back
-;; (anti-updating the score table) and to compute the table from scratch in
-;; case of an interruption.
-
-(defvar gomoku-game-in-progress nil
-  "Non-nil if a game is in progress.")
-
-(defvar gomoku-game-history nil
-  "A record of all moves that have been played during current game.")
-
-(defvar gomoku-number-of-moves nil
-  "Number of moves already played in current game.")
-
-(defvar gomoku-number-of-human-moves nil
-  "Number of moves already played by human in current game.")
-
-(defvar gomoku-emacs-played-first nil
-  "Non-nil if Emacs played first.")
-
-(defvar gomoku-human-took-back nil
-  "Non-nil if Human took back a move during the game.")
-
-(defvar gomoku-human-refused-draw nil
-  "Non-nil if Human refused Emacs offer of a draw.")
-
-(defvar gomoku-emacs-is-computing nil
-  ;; This is used to detect interruptions. Hopefully, it should not be needed.
-  "Non-nil if Emacs is in the middle of a computation.")
-
-
-(defun gomoku-start-game (n m)
-  "Initialize a new game on an N by M board."
-  (setq gomoku-emacs-is-computing t)	; Raise flag
-  (setq gomoku-game-in-progress t)
-  (setq gomoku-board-width   n
-	gomoku-board-height  m
-	gomoku-vector-length (1+ (* (+ m 2) (1+ n)))
-	gomoku-draw-limit    (/ (* 7 n m) 10))
-  (setq gomoku-emacs-won	     nil
-	gomoku-game-history	     nil
-	gomoku-number-of-moves	     0
-	gomoku-number-of-human-moves 0
-	gomoku-emacs-played-first    nil
-	gomoku-human-took-back	     nil
-	gomoku-human-refused-draw    nil)
-  (gomoku-init-display n m)		; Display first: the rest takes time
-  (gomoku-init-score-table)		; INIT-BOARD requires that the score
-  (gomoku-init-board)			;   table be already created.
-  (setq gomoku-emacs-is-computing nil))
-
-(defun gomoku-play-move (square val &optional dont-update-score)
-  "Go to SQUARE, play VAL and update everything."
-  (setq gomoku-emacs-is-computing t)	; Raise flag
-  (cond ((= 1 val)			; a Human move
-	 (setq gomoku-number-of-human-moves (1+ gomoku-number-of-human-moves)))
-	((zerop gomoku-number-of-moves)	; an Emacs move. Is it first ?
-	 (setq gomoku-emacs-played-first t)))
-  (setq gomoku-game-history
-	(cons (cons square (aref gomoku-score-table square))
-	      gomoku-game-history)
-	gomoku-number-of-moves (1+ gomoku-number-of-moves))
-  (gomoku-plot-square square val)
-  (aset gomoku-board square val)	; *BEFORE* UPDATE-SCORE !
-  (if dont-update-score nil
-      (gomoku-update-score-table square val) ; previous val was 0: dval = val
-      (aset gomoku-score-table square -1))
-  (setq gomoku-emacs-is-computing nil))
-
-(defun gomoku-take-back ()
-  "Take back last move and update everything."
-  (setq gomoku-emacs-is-computing t)
-  (let* ((last-move (car gomoku-game-history))
-	 (square (car last-move))
-	 (oldval (aref gomoku-board square)))
-    (if (= 1 oldval)
-	(setq gomoku-number-of-human-moves (1- gomoku-number-of-human-moves)))
-    (setq gomoku-game-history	 (cdr gomoku-game-history)
-	  gomoku-number-of-moves (1- gomoku-number-of-moves))
-    (gomoku-plot-square square 0)
-    (aset gomoku-board square 0)	; *BEFORE* UPDATE-SCORE !
-    (gomoku-update-score-table square (- oldval))
-    (aset gomoku-score-table square (cdr last-move)))
-  (setq gomoku-emacs-is-computing nil))
-
-;;;
-;;; SESSION CONTROL.
-;;;
-
-(defvar gomoku-number-of-emacs-wins 0
-  "Number of games Emacs won in this session.")
-
-(defvar gomoku-number-of-human-wins 0
-  "Number of games you won in this session.")
-
-(defvar gomoku-number-of-draws 0
-  "Number of games already drawn in this session.")
-
-
-(defun gomoku-terminate-game (result)
-  "Terminate the current game with RESULT."
-  (message
-   (cond
-    ((eq result 'emacs-won)
-     (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins))
-     (cond ((< gomoku-number-of-moves 20)
-	    "This was a REALLY QUICK win.")
-	   (gomoku-human-refused-draw
-	    "I won... Too bad you refused my offer of a draw !")
-	   (gomoku-human-took-back
-	    "I won... Taking moves back will not help you !")
-	   ((not gomoku-emacs-played-first)
-	    "I won... Playing first did not help you much !")
-	   ((and (zerop gomoku-number-of-human-wins)
-		 (zerop gomoku-number-of-draws)
-		 (> gomoku-number-of-emacs-wins 1))
-	    "I'm becoming tired of winning...")
-	   ("I won.")))
-    ((eq result 'human-won)
-     (setq gomoku-number-of-human-wins (1+ gomoku-number-of-human-wins))
-     (concat "OK, you won this one."
-	     (cond
-	      (gomoku-human-took-back
-	       "  I, for one, never take my moves back...")
-	      (gomoku-emacs-played-first
-	       ".. so what ?")
-	      ("  Now, let me play first just once."))))
-    ((eq result 'human-resigned)
-     (setq gomoku-number-of-emacs-wins (1+ gomoku-number-of-emacs-wins))
-     "So you resign.  That's just one more win for me.")
-    ((eq result 'nobody-won)
-     (setq gomoku-number-of-draws (1+ gomoku-number-of-draws))
-     (concat "This is a draw.  "
-	     (cond
-	      (gomoku-human-took-back
-	       "I, for one, never take my moves back...")
-	      (gomoku-emacs-played-first
-	       "Just chance, I guess.")
-	      ("Now, let me play first just once."))))
-    ((eq result 'draw-agreed)
-     (setq gomoku-number-of-draws (1+ gomoku-number-of-draws))
-     (concat "Draw agreed.  "
-	     (cond
-	      (gomoku-human-took-back
-	       "I, for one, never take my moves back...")
-	      (gomoku-emacs-played-first
-	       "You were lucky.")
-	      ("Now, let me play first just once."))))
-    ((eq result 'crash-game)
-     "Sorry, I have been interrupted and cannot resume that game...")))
-  (gomoku-display-statistics)
-  ;;(ding)
-  (setq gomoku-game-in-progress nil))
-
-(defun gomoku-crash-game ()
-  "What to do when Emacs detects it has been interrupted."
-  (setq gomoku-emacs-is-computing nil)
-  (gomoku-terminate-game 'crash-game)
-  (sit-for 4)				; Let's see the message
-  (gomoku-prompt-for-other-game))
-
-;;;
-;;; INTERACTIVE COMMANDS.
-;;;
-
-;;;###autoload
-(defun gomoku (&optional n m)
-  "Start a Gomoku game between you and Emacs.
-If a game is in progress, this command allow you to resume it.
-If optional arguments N and M are given, an N by M board is used.
-If prefix arg is given for N, M is prompted for.
-
-You and Emacs play in turn by marking a free square.  You mark it with X
-and Emacs marks it with O. The winner is the first to get five contiguous
-marks horizontally, vertically or in diagonal.
-
-You play by moving the cursor over the square you choose and hitting
-\\<gomoku-mode-map>\\[gomoku-human-plays].
-Use \\[describe-mode] for more info."
-  (interactive (if current-prefix-arg
-		   (list (prefix-numeric-value current-prefix-arg)
-			 (eval (read-minibuffer "Height: ")))))
-  (gomoku-switch-to-window)
-  (cond
-   (gomoku-emacs-is-computing
-    (gomoku-crash-game))
-   ((or (not gomoku-game-in-progress)
-	(<= gomoku-number-of-moves 2))
-    (let ((max-width (gomoku-max-width))
-	  (max-height (gomoku-max-height)))
-      (or n (setq n max-width))
-      (or m (setq m max-height))
-      (cond ((< n 1)
-	     (error "I need at least 1 column"))
-	    ((< m 1)
-	     (error "I need at least 1 row"))
-	    ((> n max-width)
-	     (error "I cannot display %d columns in that window" n)))
-      (if (and (> m max-height)
-	       (not (eq m gomoku-saved-board-height))
-	       ;; Use EQ because SAVED-BOARD-HEIGHT may be nil
-	       (not (y-or-n-p (format "Do you really want %d rows " m))))
-	  (setq m max-height)))
-    (message "One moment, please...")
-    (gomoku-start-game n m)
-    (if (y-or-n-p "Do you allow me to play first ")
-	(gomoku-emacs-plays)
-	(gomoku-prompt-for-move)))
-   ((y-or-n-p "Shall we continue our game ")
-    (gomoku-prompt-for-move))
-   (t
-    (gomoku-human-resigns))))
-
-(defun gomoku-emacs-plays ()
-  "Compute Emacs next move and play it."
-  (interactive)
-  (gomoku-switch-to-window)
-  (cond
-   (gomoku-emacs-is-computing
-    (gomoku-crash-game))
-   ((not gomoku-game-in-progress)
-    (gomoku-prompt-for-other-game))
-   (t
-    (message "Let me think...")
-    (let (square score)
-      (setq square (gomoku-strongest-square))
-      (cond ((null square)
-	     (gomoku-terminate-game 'nobody-won))
-	    (t
-	     (setq score (aref gomoku-score-table square))
-	     (gomoku-play-move square 6)
-	     (cond ((>= score gomoku-winning-threshold)
-		    (setq gomoku-emacs-won t) ; for font-lock
-		    (gomoku-find-filled-qtuple square 6)
-		    (gomoku-terminate-game 'emacs-won))
-		   ((zerop score)
-		    (gomoku-terminate-game 'nobody-won))
-		   ((and (> gomoku-number-of-moves gomoku-draw-limit)
-			 (not gomoku-human-refused-draw)
-			 (gomoku-offer-a-draw))
-		    (gomoku-terminate-game 'draw-agreed))
-		   (t
-		    (gomoku-prompt-for-move)))))))))
-
-;; For small square dimensions this is approximate, since though measured in
-;; pixels, event's (X . Y) is a character's top-left corner.
-(defun gomoku-click (click)
-  "Position at the square where you click."
-  (interactive "e")
-  (and (windowp (posn-window (setq click (event-end click))))
-       (numberp (posn-point click))
-       (select-window (posn-window click))
-       (setq click (posn-col-row click))
-       (gomoku-goto-xy
-	(min (max (/ (+ (- (car click)
-			   gomoku-x-offset
-			   1)
-			(window-hscroll)
-			gomoku-square-width
-			(% gomoku-square-width 2)
-			(/ gomoku-square-width 2))
-		     gomoku-square-width)
-		  1)
-	     gomoku-board-width)
-	(min (max (/ (+ (- (cdr click)
-			   gomoku-y-offset
-			   1)
-			(let ((inhibit-point-motion-hooks t))
-			  (count-lines 1 (window-start)))
-			gomoku-square-height
-			(% gomoku-square-height 2)
-			(/ gomoku-square-height 2))
-		     gomoku-square-height)
-		  1)
-	     gomoku-board-height))))
-  
-(defun gomoku-mouse-play (click)
-  "Play at the square where you click."
-  (interactive "e")
-  (if (gomoku-click click)
-      (gomoku-human-plays)))
-
-(defun gomoku-human-plays ()
-  "Signal to the Gomoku program that you have played.
-You must have put the cursor on the square where you want to play.
-If the game is finished, this command requests for another game."
-  (interactive)
-  (gomoku-switch-to-window)
-  (cond
-   (gomoku-emacs-is-computing
-    (gomoku-crash-game))
-   ((not gomoku-game-in-progress)
-    (gomoku-prompt-for-other-game))
-   (t
-    (let (square score)
-      (setq square (gomoku-point-square))
-      (cond ((null square)
-	     (error "Your point is not on a square. Retry !"))
-	    ((not (zerop (aref gomoku-board square)))
-	     (error "Your point is not on a free square. Retry !"))
-	    (t
-	     (setq score (aref gomoku-score-table square))
-	     (gomoku-play-move square 1)
-	     (cond ((and (>= score gomoku-loosing-threshold)
-			 ;; Just testing SCORE > THRESHOLD is not enough for
-			 ;; detecting wins, it just gives an indication that
-			 ;; we confirm with GOMOKU-FIND-FILLED-QTUPLE.
-			 (gomoku-find-filled-qtuple square 1))
-		    (gomoku-terminate-game 'human-won))
-		   (t
-		    (gomoku-emacs-plays)))))))))
-
-(defun gomoku-human-takes-back ()
-  "Signal to the Gomoku program that you wish to take back your last move."
-  (interactive)
-  (gomoku-switch-to-window)
-  (cond
-   (gomoku-emacs-is-computing
-    (gomoku-crash-game))
-   ((not gomoku-game-in-progress)
-    (message "Too late for taking back...")
-    (sit-for 4)
-    (gomoku-prompt-for-other-game))
-   ((zerop gomoku-number-of-human-moves)
-    (message "You have not played yet... Your move ?"))
-   (t
-    (message "One moment, please...")
-    ;; It is possible for the user to let Emacs play several consecutive
-    ;; moves, so that the best way to know when to stop taking back moves is
-    ;; to count the number of human moves:
-    (setq gomoku-human-took-back t)
-    (let ((number gomoku-number-of-human-moves))
-      (while (= number gomoku-number-of-human-moves)
-	(gomoku-take-back)))
-    (gomoku-prompt-for-move))))
-
-(defun gomoku-human-resigns ()
-  "Signal to the Gomoku program that you may want to resign."
-  (interactive)
-  (gomoku-switch-to-window)
-  (cond
-   (gomoku-emacs-is-computing
-    (gomoku-crash-game))
-   ((not gomoku-game-in-progress)
-    (message "There is no game in progress"))
-   ((y-or-n-p "You mean, you resign ")
-    (gomoku-terminate-game 'human-resigned))
-   ((y-or-n-p "You mean, we continue ")
-    (gomoku-prompt-for-move))
-   (t
-    (gomoku-terminate-game 'human-resigned)))) ; OK. Accept it
-
-;;;
-;;; PROMPTING THE HUMAN PLAYER.
-;;;
-
-(defun gomoku-prompt-for-move ()
-  "Display a message asking for Human's move."
-  (message (if (zerop gomoku-number-of-human-moves)
-	       "Your move ? (move to a free square and hit X, RET ...)"
-	       "Your move ?"))
-  ;; This may seem silly, but if one omits the following line (or a similar
-  ;; one), the cursor may very well go to some place where POINT is not.
-  (save-excursion (set-buffer (other-buffer))))
-
-(defun gomoku-prompt-for-other-game ()
-  "Ask for another game, and start it."
-  (if (y-or-n-p "Another game ")
-      (gomoku gomoku-board-width gomoku-board-height)
-    (message "Chicken !")))
-
-(defun gomoku-offer-a-draw ()
-  "Offer a draw and return T if Human accepted it."
-  (or (y-or-n-p "I offer you a draw. Do you accept it ")
-      (not (setq gomoku-human-refused-draw t))))
-
-;;;
-;;; DISPLAYING THE BOARD.
-;;;
-
-;; You may change these values if you have a small screen or if the squares
-;; look rectangular, but spacings SHOULD be at least 2 (MUST BE at least 1).
-
-(defconst gomoku-square-width 4
-  "*Horizontal spacing between squares on the Gomoku board.")
-
-(defconst gomoku-square-height 2
-  "*Vertical spacing between squares on the Gomoku board.")
-
-(defconst gomoku-x-offset 3
-  "*Number of columns between the Gomoku board and the side of the window.")
-
-(defconst gomoku-y-offset 1
-  "*Number of lines between the Gomoku board and the top of the window.")
-
-
-(defun gomoku-max-width ()
-  "Largest possible board width for the current window."
-  (1+ (/ (- (window-width (selected-window))
-	    gomoku-x-offset gomoku-x-offset 1)
-	 gomoku-square-width)))
-
-(defun gomoku-max-height ()
-  "Largest possible board height for the current window."
-  (1+ (/ (- (window-height (selected-window))
-	    gomoku-y-offset gomoku-y-offset 2)
-	 ;; 2 instead of 1 because WINDOW-HEIGHT includes the mode line !
-	 gomoku-square-height)))
-
-(defun gomoku-point-y ()
-  "Return the board row where point is."
-  (let ((inhibit-point-motion-hooks t))
-    (1+ (/ (- (count-lines 1 (point)) gomoku-y-offset (if (bolp) 0 1))
-	   gomoku-square-height))))
-
-(defun gomoku-point-square ()
-  "Return the index of the square point is on."
-  (let ((inhibit-point-motion-hooks t))
-    (gomoku-xy-to-index (1+ (/ (- (current-column) gomoku-x-offset)
-			       gomoku-square-width))
-			(gomoku-point-y))))
-
-(defun gomoku-goto-square (index)
-  "Move point to square number INDEX."
-  (gomoku-goto-xy (gomoku-index-to-x index) (gomoku-index-to-y index)))
-
-(defun gomoku-goto-xy (x y)
-  "Move point to square at X, Y coords."
-  (let ((inhibit-point-motion-hooks t))
-    (goto-line (+ 1 gomoku-y-offset (* gomoku-square-height (1- y)))))
-  (move-to-column (+ gomoku-x-offset (* gomoku-square-width (1- x)))))
-
-(defun gomoku-plot-square (square value)
-  "Draw 'X', 'O' or '.' on SQUARE depending on VALUE, leave point there."
-  (or (= value 1)
-      (gomoku-goto-square square))
-  (let ((inhibit-read-only t)
-	(inhibit-point-motion-hooks t))
-    (insert-and-inherit (cond ((= value 1) ?X)
-			      ((= value 6) ?O)
-			      (?.)))
-    (and window-system
-	 (zerop value)
-	 (put-text-property (1- (point)) (point) 'mouse-face 'highlight))
-    (delete-char 1)
-    (backward-char 1))
-  (sit-for 0))	; Display NOW
-
-(defun gomoku-init-display (n m)
-  "Display an N by M Gomoku board."
-  (buffer-disable-undo (current-buffer))
-  (let ((inhibit-read-only t)
-	(point 1) opoint
-	(intangible t)
-	(i m) j x)
-    ;; Try to minimize number of chars (because of text properties)
-    (setq tab-width
-	  (if (zerop (% gomoku-x-offset gomoku-square-width))
-	      gomoku-square-width
-	    (max (/ (+ (% gomoku-x-offset gomoku-square-width)
-		       gomoku-square-width 1) 2) 2)))
-    (erase-buffer)
-    (newline gomoku-y-offset)
-    (while (progn
-	     (setq j n
-		   x (- gomoku-x-offset gomoku-square-width))
-	     (while (>= (setq j (1- j)) 0)
-	       (insert-char ?\t (/ (- (setq x (+ x gomoku-square-width))
-				      (current-column))
-				   tab-width))
-	       (insert-char ?  (- x (current-column)))
-	       (if (setq intangible (not intangible))
-		   (put-text-property point (point) 'intangible 2))
-	       (and (zerop j)
-		    (= i (- m 2))
-		    (progn
-		      (while (>= i 3)
-			(append-to-buffer (current-buffer) opoint (point))
-			(setq i (- i 2)))
-		      (goto-char (point-max))))
-	       (setq point (point))
-	       (insert ?.)
-	       (if window-system
-		   (put-text-property point (point)
-				      'mouse-face 'highlight)))
-	     (> (setq i (1- i)) 0))
-      (if (= i (1- m))
-	  (setq opoint point))
-      (insert-char ?\n gomoku-square-height))
-    (or (eq (char-after 1) ?.)
-	(put-text-property 1 2 'point-entered
-			   (lambda (x x) (if (bobp) (forward-char)))))
-    (or intangible
-	(put-text-property point (point) 'intangible 2))
-    (put-text-property point (point) 'point-entered
-		       (lambda (x x) (if (eobp) (backward-char))))
-    (put-text-property (point-min) (point) 'category 'gomoku-mode))
-  (gomoku-goto-xy (/ (1+ n) 2) (/ (1+ m) 2)) ; center of the board
-  (sit-for 0))				; Display NOW
-
-(defun gomoku-display-statistics ()
-  "Obnoxiously display some statistics about previous games in mode line."
-  ;; We store this string in the mode-line-process local variable.
-  ;; This is certainly not the cleanest way out ...
-  (setq mode-line-process
-	(format ": Won %d, lost %d%s"
-		gomoku-number-of-human-wins
-		gomoku-number-of-emacs-wins
-		(if (zerop gomoku-number-of-draws)
-		    ""
-		  (format ", drew %d" gomoku-number-of-draws))))
-  (force-mode-line-update))
-
-(defun gomoku-switch-to-window ()
-  "Find or create the Gomoku buffer, and display it."
-  (interactive)
-  (let ((buff (get-buffer "*Gomoku*")))
-    (if buff				; Buffer exists:
-	(switch-to-buffer buff)		;   no problem.
-      (if gomoku-game-in-progress
-	  (gomoku-crash-game))		;   buffer has been killed or something
-      (switch-to-buffer "*Gomoku*")	; Anyway, start anew.
-      (gomoku-mode))))
-
-;;;
-;;; CROSSING WINNING QTUPLES.
-;;;
-
-;; When someone succeeds in filling a qtuple, we draw a line over the five
-;; corresponding squares. One problem is that the program does not know which
-;; squares ! It only knows the square where the last move has been played and
-;; who won. The solution is to scan the board along all four directions.
-
-(defun gomoku-find-filled-qtuple (square value)
-  "Return T if SQUARE belongs to a qtuple filled with VALUEs."
-  (or (gomoku-check-filled-qtuple square value 1 0)
-      (gomoku-check-filled-qtuple square value 0 1)
-      (gomoku-check-filled-qtuple square value 1 1)
-      (gomoku-check-filled-qtuple square value -1 1)))
-
-(defun gomoku-check-filled-qtuple (square value dx dy)
-  "Return T if SQUARE belongs to a qtuple filled  with VALUEs along DX, DY."
-  (let ((a 0) (b 0)
-	(left square) (right square)
-	(depl (gomoku-xy-to-index dx dy)))
-    (while (and (> a -4)		; stretch tuple left
-		(= value (aref gomoku-board (setq left (- left depl)))))
-      (setq a (1- a)))
-    (while (and (< b (+ a 4))		; stretch tuple right
-		(= value (aref gomoku-board (setq right (+ right depl)))))
-      (setq b (1+ b)))
-    (cond ((= b (+ a 4))		; tuple length = 5 ?
-	   (gomoku-cross-qtuple (+ square (* a depl)) (+ square (* b depl))
-				dx dy)
-	   t))))
-
-(defun gomoku-cross-qtuple (square1 square2 dx dy)
-  "Cross every square between SQUARE1 and SQUARE2 in the DX, DY direction."
-  (save-excursion			; Not moving point from last square
-    (let ((depl (gomoku-xy-to-index dx dy))
-	  (inhibit-read-only t)
-	  (inhibit-point-motion-hooks t))
-      ;; WARNING: this function assumes DEPL > 0 and SQUARE2 > SQUARE1
-      (while (/= square1 square2)
-	(gomoku-goto-square square1)
-	(setq square1 (+ square1 depl))
-	(cond
-	  ((= dy 0)			; Horizontal
-	   (forward-char 1)
-	   (insert-char ?- (1- gomoku-square-width) t)
-	   (delete-region (point) (progn
-				    (skip-chars-forward " \t")
-				    (point))))
-	  ((= dx 0)			; Vertical
-	   (let ((n 1)
-		 (column (current-column)))
-	     (while (< n gomoku-square-height)
-	       (setq n (1+ n))
-	       (forward-line 1)
-	       (indent-to column)
-	       (insert-and-inherit ?|))))
-	  ((= dx -1)			; 1st Diagonal
-	   (indent-to (prog1 (- (current-column) (/ gomoku-square-width 2))
-			(forward-line (/ gomoku-square-height 2))))
-	   (insert-and-inherit ?/))
-	  (t				; 2nd Diagonal
-	   (indent-to (prog1 (+ (current-column) (/ gomoku-square-width 2))
-			(forward-line (/ gomoku-square-height 2))))
-	   (insert-and-inherit ?\\))))))
-  (sit-for 0))				; Display NOW
-
-;;;
-;;; CURSOR MOTION.
-;;;
-;; previous-line and next-line don't work right with intangible newlines
-(defun gomoku-move-down ()
-  "Move point down one row on the Gomoku board."
-  (interactive)
-  (if (< (gomoku-point-y) gomoku-board-height)
-      (next-line gomoku-square-height)))
-
-(defun gomoku-move-up ()
-  "Move point up one row on the Gomoku board."
-  (interactive)
-  (if (> (gomoku-point-y) 1)
-      (previous-line gomoku-square-height)))
-
-(defun gomoku-move-ne ()
-  "Move point North East on the Gomoku board."
-  (interactive)
-  (gomoku-move-up)
-  (forward-char))
-
-(defun gomoku-move-se ()
-  "Move point South East on the Gomoku board."
-  (interactive)
-  (gomoku-move-down)
-  (forward-char))
-
-(defun gomoku-move-nw ()
-  "Move point North West on the Gomoku board."
-  (interactive)
-  (gomoku-move-up)
-  (backward-char))
-
-(defun gomoku-move-sw ()
-  "Move point South West on the Gomoku board."
-  (interactive)
-  (gomoku-move-down)
-  (backward-char))
-
-(defun gomoku-beginning-of-line ()
-  "Move point to first square on the Gomoku board row."
-  (interactive)
-  (move-to-column gomoku-x-offset))
-
-(defun gomoku-end-of-line ()
-  "Move point to last square on the Gomoku board row."
-  (interactive)
-  (move-to-column (+ gomoku-x-offset
-		     (* gomoku-square-width (1- gomoku-board-width)))))
-
-(provide 'gomoku)
-
-;;; gomoku.el ends here
diff --git a/lisp/play/handwrite.el b/lisp/play/handwrite.el
deleted file mode 100644
index 766ba6a02c6..00000000000
--- a/lisp/play/handwrite.el
+++ /dev/null
@@ -1,1376 +0,0 @@
-;;; handwrite.el --- turns your emacs buffer into a handwritten document.
-;;
-;; (C) Copyright 1996 Free Software Foundation, Inc.
-;;
-;; Author: Danny Roozendaal (danny@tvs.kun.nl)
-;; Created: October 21 1996
-;; Keywords: cursive writing
-;;
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-;;
-;;; Commentary:
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; The function handwrite creates PostScript output containing a
-;; handwritten version of the current buffer..
-;; Other functions that may be useful are
-;;
-;;      handwrite-10pt: sets the font size to 10 and finds corresponding
-;;                      values for the line spacing and the number of lines
-;;                      on a page.
-;;      handwrite-11pt: which is similar
-;;      handwrite-12pt: which is also similar
-;;      handwrite-13pt: which is similar, too
-;;
-;;      handwrite-set-pagenumber: set and unset page numbering
-;;
-;;
-;; If you are not satisfied with the type page there are a number of
-;; variables you may want to set.
-;;
-;;
-;;  Installation
-;;
-;; type at your prompt "emacs -l handwrite.el" or put this file on your
-;; Emacs-Lisp load path,  add the following into your ~/.emacs startup file
-;;
-;;                (require 'handwrite)
-;;
-;; "M-x handwrite"  or "Write by hand"  in the edit menu should work now.
-;;
-;;
-;; I tried to make it `iso_8859_1'-friendly, but there are some exotic
-;; characters missing.
-;;
-;;
-;; Known bugs: -Page feeds do not do their work, but are ignored instead.
-;;             -Tabs are not always properly displayed.
-;;             -Handwrite may create corrupt PostScript if it encounters
-;;              unknown characters.
-;;
-;; Thanks to anyone who emailed me suggestions!
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;;; Code:
-
-
-;; Variables
-
-(defvar handwrite-psindex 0
-  "The index of the PostScript buffer")
-(defvar menu-bar-handwrite-map (make-sparse-keymap "Handwrite functions."))
-(fset 'menu-bar-handwrite-map (symbol-value 'menu-bar-handwrite-map))
-
-
-;; User definable variables
-
-(defvar handwrite-numlines 60
-  "*The number of lines on a page of the PostScript output")
-(defvar handwrite-fontsize 11
-  "*The size of the font for the PostScript output")
-(defvar handwrite-linespace 12
-  "*The spacing for the PostScript output")
-(defvar handwrite-xstart 30
-  "*Translation in the x-direction of the origin in the PostScript output")
-(defvar handwrite-ystart 810
-  "*Translation in the y-direction of the origin in the PostScript output")
-(defvar handwrite-pagenumbering nil
-  "*If t then number each page of the PostScript output")
-(defvar handwrite-10pt-numlines 65
-  "*The number of lines on a page for the function handwrite-10pt")
-(defvar handwrite-11pt-numlines 60
-  "*The number of lines on a page for the function handwrite-11pt")
-(defvar handwrite-12pt-numlines 55
-  "*The number of lines on a page for the function handwrite-12pt")
-(defvar handwrite-13pt-numlines 50
-  "*The number of lines on a page for the function handwrite-13pt")
-
-
-;; Interactive functions
-
-(defun  handwrite ()
-  "Turns the buffer into a handwritten document.
-Variables: handwrite-linespace     (default 12)
-           handwrite-fontsize      (default 11)
-           handwrite-numlines      (default 60)
-           handwrite-pagenumbering (default nil)"
-  (interactive)
-  (let
-      ((pmin)				; thanks, Havard
-       (lastp)
-       (cur-buf (current-buffer))
-       (tpoint (point))	
-       (ps-ypos 63)
-       (lcount 0)
-       (ipage 1)
-       (nlan next-line-add-newlines)	;remember the old value
-       (buf-name (buffer-name) )
-       (textp)
-       (ps-buf-name)			;name of the PostScript buffer
-       )
-    (goto-char (point-min))		;start at beginning
-    (setq handwrite-psindex (1+ handwrite-psindex))
-    (setq ps-buf-name
-	  (format "*handwritten%d.ps*" handwrite-psindex))
-    (setq next-line-add-newlines t)
-    (switch-to-buffer ps-buf-name)
-    (handwrite-insert-header buf-name)
-    (insert "\n(\\nCreated by Gnu Emacs' handwrite version "
-	    emacs-version  "\\n\\n)=print flush\n")
-    (handwrite-insert-preamble)
-    (handwrite-insert-info)
-    (handwrite-insert-font)
-    (setq textp (point))
-    (insert "%%Page: 1 1\n")
-    (insert "Hwjst\n")
-    (insert "/Hwsave save def\n")
-    (if handwrite-pagenumbering (insert "20 30 m\nxym(page 1)a\n"))
-    (insert "44 63 m\n")
-    (insert "xym( )a")
-    (backward-char 3)
-    (switch-to-buffer cur-buf)
-    (goto-char (point-min))		;start at beginning
-    (save-excursion
-      ;;as long as we see a newline the document is not ended.	
-      (while (re-search-forward "\n" nil t)
-	(previous-line 1)
-	(beginning-of-line)
-	(setq pmin (point))
-	(search-forward "\n" nil t)
-	(backward-char 1)
-	(copy-region-as-kill (point) pmin)
-	(forward-char 1)
-	(switch-to-buffer ps-buf-name)
-	(yank)
-	(message "write write write...")
-	(search-forward ")a" nil t)
-	(backward-char 2)
-	(setq lastp (point))
-	(beginning-of-line)
-	(search-forward "(" nil t)
-	(while (re-search-forward "[()\\]" lastp t)
-	  (save-excursion
-	    (setq lastp (+ lastp 1))
-	    (forward-char -1)
-	    (insert "\\")))
-	(setq ps-ypos (+ ps-ypos handwrite-linespace))
-	(end-of-line)
-	(insert "\n")
-	(setq lcount (+ lcount 1))
-	(cond ( (eq lcount handwrite-numlines)
-		(setq ipage (+ ipage 1))
-		(insert "0 0  m\n")
-		(insert "showpage exec Hwsave restore\n")
-		(insert "%%Page: " (number-to-string ipage) " "
-			(number-to-string ipage) "\n")
-		(insert "Hwjst\n")
-		(insert "/Hwsave save def\n")
-		(if handwrite-pagenumbering
-		    (insert "20 30 m\nxym(page "
-			    (number-to-string ipage) ")a\n"))
-		(setq ps-ypos 63)
-		(setq lcount 0)
-		))
-	(insert "44 "(number-to-string ps-ypos) " m\n")
-	(insert "xym( )a")
-	(backward-char 3)
-	(switch-to-buffer cur-buf)
-	))
-    (switch-to-buffer ps-buf-name)
-    (next-line 1)
-    (insert "showpage exec Hwsave restore\n\n")
-    (insert "%%Pages " (number-to-string ipage) " 0\n")
-    (insert "%%EOF\n")
-    (goto-char textp)			;start where the inserted text begins
-    (while (search-forward "ÿ" nil t)
-      (replace-match "\\" nil t) (insert "264"))
-    (goto-char textp)
-    (while (search-forward "á" nil t)
-      (replace-match "\\" nil t) (insert "207"))
-    (goto-char textp)
-    (while (search-forward "à" nil t)
-      (replace-match "\\" nil t) (insert "210"))
-    (goto-char textp)
-    (while (search-forward "â" nil t)
-      (replace-match "\\" nil t) (insert "211"))
-    (goto-char textp)
-    (while (search-forward "ä" nil t)
-      (replace-match "\\" nil t) (insert "212"))
-    (goto-char textp)
-    (while (search-forward "ã" nil t)
-      (replace-match "\\" nil t) (insert "213"))
-    (goto-char textp)
-    (while (search-forward "å" nil t)
-      (replace-match "\\" nil t) (insert "214"))
-    (goto-char textp)
-    (while (search-forward "é" nil t)
-      (replace-match "\\" nil t) (insert "216"))
-    (goto-char textp)
-    (while (search-forward "è" nil t)
-      (replace-match "\\" nil t) (insert "217"))
-    (goto-char textp)
-    (while (search-forward "ê" nil t)
-      (replace-match "\\" nil t) (insert "220"))
-    (goto-char textp)
-    (while (search-forward "ë" nil t)
-      (replace-match "\\" nil t) (insert "221"))
-    (goto-char textp)
-    (while (search-forward "í" nil t)
-      (replace-match "\\" nil t) (insert "222"))
-    (goto-char textp)
-    (while (search-forward "ì" nil t)
-      (replace-match "\\" nil t) (insert "223"))
-    (goto-char textp)
-    (while (search-forward "î" nil t)
-      (replace-match "\\" nil t) (insert "224"))
-    (goto-char textp)
-    (while (search-forward "ï" nil t)
-      (replace-match "\\" nil t) (insert "225"))
-    (goto-char textp)
-    (while (search-forward "ó" nil t)
-      (replace-match "\\" nil t) (insert "227"))
-    (goto-char textp)
-    (while (search-forward "ò" nil t)
-      (replace-match "\\" nil t) (insert "230"))
-    (goto-char textp)
-    (while (search-forward "ô" nil t)
-      (replace-match "\\" nil t) (insert "231"))
-    (goto-char textp)
-    (while (search-forward "ö" nil t)
-      (replace-match "\\" nil t) (insert "232"))
-    (goto-char textp)
-    (while (search-forward "õ" nil t)
-      (replace-match "\\" nil t) (insert "233"))
-    (goto-char textp)
-    (while (search-forward "ú" nil t)
-      (replace-match "\\" nil t) (insert "234"))
-    (goto-char textp)
-    (while (search-forward "ù" nil t)
-      (replace-match "\\" nil t) (insert "235"))
-    (goto-char textp)
-    (while (search-forward "û" nil t)
-      (replace-match "\\" nil t) (insert "236"))
-    (goto-char textp)
-    (while (search-forward "ü" nil t)
-      (replace-match "\\" nil t) (insert "237"))
-    (goto-char textp)
-    (while (search-forward "ß" nil t)
-      (replace-match "\\" nil t) (insert "247"))
-    (goto-char textp)
-    (while (search-forward "°" nil t)
-      (replace-match "\\" nil t) (insert "241"))
-    (goto-char textp)
-    (while (search-forward "®" nil t)
-      (replace-match "\\" nil t) (insert "250"))
-    (goto-char textp)
-    (while (search-forward "©" nil t)
-      (replace-match "\\" nil t) (insert "251"))
-    (goto-char textp)
-    (while (search-forward "ij" nil t)
-      (replace-match "\\" nil t) (insert "264"))
-    (goto-char textp)
-    (while (search-forward "ç" nil t)
-      (replace-match "\\" nil t) (insert "215"))
-    (goto-char textp)
-    (while (search-forward "§" nil t)
-      (replace-match "\\" nil t) (insert "244"))
-    (goto-char textp)
-    (while (search-forward "ñ" nil t)
-      (replace-match "\\" nil t) (insert "226"))
-    (goto-char textp)
-    (while (search-forward "£" nil t)
-      (replace-match "\\" nil t) (insert "243"))
-    ;;To avoid cumbersome code we simply ignore pagefeeds
-    (goto-char textp)
-    (while (search-forward "\f" nil t)
-      (replace-match "" nil t) )
-    (untabify textp (point-max))	; this may result in strange tabs
-    (if (y-or-n-p "Send this to the printer? ")
-	(call-process-region (point-min)
-			     (point-max) lpr-command nil nil nil))
-    (message "")
-    (bury-buffer ())
-    (switch-to-buffer cur-buf)
-    (goto-char tpoint)
-    (setq next-line-add-newlines nlan)
-    ))
-
-
-(defun handwrite-set-pagenumber ()
-  "Toggle the value of handwrite-pagenumbering"
-  (interactive)
-  (if handwrite-pagenumbering
-      (handwrite-set-pagenumber-off)(handwrite-set-pagenumber-on)))
-
-(defun handwrite-10pt ()
-  "Sets the variable `handwrite-fontsize' to 10 and finds correct
-values for `handwrite-linespace' and `handwrite-numlines'"
-  (interactive)
-  (setq handwrite-fontsize 10)
-  (setq handwrite-linespace 11)
-  (setq handwrite-numlines handwrite-10pt-numlines)
-  (define-key menu-bar-handwrite-map [10pt]
-    '("10 pt *" . handwrite-10pt))
-  (define-key menu-bar-handwrite-map [11pt]
-    '("11 pt" . handwrite-11pt))
-  (define-key menu-bar-handwrite-map [12pt]
-    '("12 pt" . handwrite-12pt))
-  (define-key menu-bar-handwrite-map [13pt]
-    '("13 pt" . handwrite-13pt))
-  (message "Joepie set to 10 points"))
-
-
-(defun handwrite-11pt ()
-  "Sets the variable `handwrite-fontsize' to 11 and finds correct
-values for `handwrite-linespace' and `handwrite-numlines'"
-  (interactive)
-  (setq handwrite-fontsize 11)
-  (setq handwrite-linespace 12)
-  (setq handwrite-numlines handwrite-11pt-numlines )
-  (define-key menu-bar-handwrite-map [10pt]
-    '("10 pt" . handwrite-10pt))
-  (define-key menu-bar-handwrite-map [11pt]
-    '("11 pt *" . handwrite-11pt))
-  (define-key menu-bar-handwrite-map [12pt]
-    '("12 pt" . handwrite-12pt))
-  (define-key menu-bar-handwrite-map [13pt]
-    '("13 pt" . handwrite-13pt))
-  (message "Joepie set to 11 points"))
-
-(defun handwrite-12pt ()
-  "Sets the variable `handwrite-fontsize' to 12 and finds correct
-values for `handwrite-linespace' and `handwrite-numlines'"
-  (interactive)
-  (setq handwrite-fontsize 12)
-  (setq handwrite-linespace 13)
-  (setq handwrite-numlines handwrite-12pt-numlines)
-  (define-key menu-bar-handwrite-map [10pt]
-    '("10 pt" . handwrite-10pt))
-  (define-key menu-bar-handwrite-map [11pt]
-    '("11 pt" . handwrite-11pt))
-  (define-key menu-bar-handwrite-map [12pt]
-    '("12 pt *" . handwrite-12pt))
-  (define-key menu-bar-handwrite-map [13pt]
-    '("13 pt" . handwrite-13pt))
-  (message "Joepie set to 12 points"))
-
-(defun handwrite-13pt ()
-  "Sets the variable `handwrite-fontsize' to 13 and finds correct
-values for `handwrite-linespace' and `handwrite-numlines'"
-  (interactive)
-  (setq handwrite-fontsize 13)
-  (setq handwrite-linespace 14)
-  (setq handwrite-numlines handwrite-13pt-numlines)
-  (define-key menu-bar-handwrite-map [10pt]
-    '("10 pt" . handwrite-10pt))
-  (define-key menu-bar-handwrite-map [11pt]
-    '("11 pt" . handwrite-11pt))
-  (define-key menu-bar-handwrite-map [12pt]
-    '("12 pt" . handwrite-12pt))
-  (define-key menu-bar-handwrite-map [13pt]
-    '("13 pt *" . handwrite-13pt))
-  (message "Joepie set to 13 points"))
-
-
-;; Internal Functions
-
-;;The header for the PostScript output. The argument is the name of
-;;the original buffer
-(defun handwrite-insert-header (buf-name)
-  (insert "%!PS-Adobe-2.0\n")
-  (insert "%%Title: " buf-name "\n")
-  (insert "%%CreationDate: " (current-time-string) "\n" )
-  (insert "%%Pages: (atend)\n")
-  (insert "%%For: "  user-mail-address   "\n")
-  (insert "%%EndComments\n"))
-
-;;Some PostScript definitions for using our font.
-(defun handwrite-insert-preamble ()
-  (insert "\n%%BeginPreamble
-/m {moveto} def
-/r {roll} def
-/e {exch} def
-/a {awidthshow} def
-/xym {0.52490 0. 32 0.05249 0.} def
-/HwJdict 80 dict def
-/Hwfdict 80 dict def
-/getsymb {Hwfdict /Jsymb get 3 1 r put} def
-/Chread{
-  {  e begin
-      HwJdict begin %read in character specifications
-        /jnum e def
-        /jnum1 jnum 6 mul def
-        save symbstr jnum1 6 getinterval{
-        }forall
-        /pixvol e def
-        /pixwid e def
-        /charwidth e def
-        /trx e def
-        /try e def
-        /pixf e def
-        .02666667 .02666667  scale
-        /pixwid pixwid 1.042 mul def
-        /pixwidn pixwid trx add def
-        /pixvoln pixvol try add def
-        charwidth 0 trx try pixwidn pixvoln setcachedevice
-        newpath 0 0 m
-        pixf 0 gt{
-          pixf 3 bitshift
-          trx try translate
-          pixwid pixvol scale
-          /pixvol1 {pixvol 4 add true} def
-          /pixvol2 pixvol neg def
-          /pixvol3 pixvol 2 add def
-          pixvol1 pixwid 0 0 pixvol2 0 pixvol3 6 array astore
-          Jsymb jnum get
-          imagemask
-        }if
-        restore
-      end
-    end
-  }def
-}def
-/Hwjst{
-  /Joepie findfont [Hws 0 Hws pop 0 Hws neg 0 0] makefont setfont
-}def
-%%EndPreamble\n"))
-
-;;The the font size for the PostScript output.
-;;Also the x-y-translations of the PostScript stuff.
-(defun handwrite-insert-info ()
-  (insert "\n%%BeginSizeTranslate\n")
-  (insert "/Hws " (number-to-string handwrite-fontsize) " def")
-  (insert "         %The size of the font\n")
-  (insert (number-to-string handwrite-xstart)" "
-	  (number-to-string handwrite-ystart))
-  (insert " translate    %Translate the origin to the current location\n")
-  (insert "1 -1 scale          %Flip the y coordinate\n")
-  (insert "%%EndSizeTranslate\n\n"))
-
-
-;;Bitmap PostScript font for pseudo handwritten documents.
-;;Two years ago, I created the 36 points font for my
-;;Apple Macintosh Classic II resulting in unusual ascii numbers.
-(defun handwrite-insert-font ()
-  (insert "\n%%BeginFont Joepie
-Hwfdict begin
-  /Jsymb 256 array  def
-  /FontType 3 def
-  /FontBBox [0 0 1 1] def
-  /FontMatrix [1 0 0 1 0 0] def
-  /Encoding 256 array def
-end
-<002809000000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000
-FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 002809080000
-FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 002809000000 FF28FFFF0000
-FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000
-FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000
-FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000
-FF28FFFF0000 FF28FFFF0000 002809080000 020A0E08031E 021C0B0E0A0A
-040C09161418 04050A121323 040D0F1C141B 040C141C0F19 021B0B08060D
-02080B0C091E 0208080C0B20 041A0B100F0C 040E09141314 02060B08060B
-0219090C0C03 020C0B080304 04090C120F1F 04080A121017 020C10120514
-040A09121216 040C09121216 02090B120D15 040C0B121015 040A0A12121B
-020209120D1D 040A09121018 04040A12101C 020C0D080412 020408080717
-040B0B141116 040C0B16140B 040B0B141018 020A0D120C1C 04090B1C191F
-040A091A1C1C 0408071A1E20 040A0B1A1A1E 040E0D201E1A 040C0916181C
-040E0916171A 04010B1C1C27 060A0C20201E 040E060E141A 0401070E1327
-040E0A1C1D1A 040C0916181C 060C07262B1C 060C0520261C 04080D1E1C20
-040A05161C1C 040A0B1E1E1E 040A091A1D1E 040C0914171C 040E07161A1A
-060E091E1F1A 040E071A1D1A 060A0B2C2C1E 040808181B20 040409161722
-040C08181A1C 020A080A0A1D 040A0610121E 0208090A0A1F 041C0714160A
-040505161903 021B0C0C060D 040C08141713 040C0916181C 040C08121412
-040D0916181B 040C09141615 0202090C0D26 04040814171B 040A0916181E
-020C090A0D1B 0202090A0C23 040A0814171E 020C080A0D1C 060C09222412
-040C08161910 040C08141611 04000816191C 04020914171B 040A090E1014
-040A09101213 040C090C0F1B 040C09161812 040A09121412 040C09181A10
-040C08121511 04020812151C 040C08101312 040A050A0F1E 020A1114031C
-0208070A0E20 04140A141409 FF28FFFF0000 040A071A1B1C 040A091A181C
-040A0B1A171E 020F0F160E16 040A0F201A1E 04080D1E1A20 040E0B1E1D1A
-040C0814171B 040D0714171B 040D0714171A 040D0814171A 040D0814171B
-040D0814171B 04000912141C 040C0914151C 040C0914161C 040C0914151C
-040C0914151B 020B070A0D1C 020B070A0D1C 020B080A0D1C 020B070A0D1A
-040C0616191A 040B0714171D 040B08141719 040B0814171A 040B08141718
-040B08141718 040B0716191B 040B0716191B 040B0716191C 040B08161919
-040A0912111C 02180C0E090C 04050712141F 040A0816151C 04080A121220
-020F0A120E10 040408181522 04040816191D 040A0D201A1E 040A09201C1C
-06190B24210E 021C0B0C0708 0221090E0D03 040809141415 040C121E1619
-04080F1E1920 04130F1A1309 040C0B141216 04090914141E 040A0914131B
-040209161823 04030A161519 020B0B120E19 0407091A1921 040A0B1E141E
-040C0914140F 0401090C0F25 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000
-FF28FFFF0000 040A0B14121A 04010910101B FF28FFFF0000 040A0614181C
-040A09141618 0407090E1221 040D0A141510 002800160000 04080A141119
-04080614151A 040A0B1E1804 FF28FFFF0000 040A071A1B1D 040A071A191D
-FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 041408141303 061409262404
-041A0B120F0B 021D0B120D0A 021E0E0A050A 021E0B0A060A FF28FFFF0000
-FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 040600060F1C FF28FFFF0000
-020C0A0C0B16 020D080C0C17 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000
-02140B0A0506 02040908060E FF28FFFF0000 0608092A291E FF28FFFF0000
-FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000
-FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000
-040A0B1C181B 060C071E221C FF28FFFF0000 FF28FFFF0000 FF28FFFF0000
-FF28FFFF0000 021D0C0E0C08 021E090E0C06 0421060E1105 FF28FFFF0000
-021F0A0A0506 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000 FF28FFFF0000
-041E09101107>
-Hwfdict begin /symbstr e def end
-255< 00000000 00000000 80018000 60030000 38060000 0E1C0000 03F00000
-01C00000 01800000 00000000 00000000>getsymb
-250< 0000 0000 6000 7800 7800 F800 F800 7000 0000 0000>getsymb
-248< 00000000 00000000 F8000000 3F800000 03F80000 007E0000 00038000
-00000000 00000000 >getsymb
-247< 0000 0000 0030 0060 38E0 7FC0 C300 8000 0000 0000 >getsymb
-246< 0000 0000 0C00 1E00 3F00 3380 60C0 4040 C020 0010 0000 0000
->getsymb
-241< 000000000000 000000000000 008000000000 00C000000000 03C000000000
-038000000000 000000000000 000000000000 000000000000 000000000000
-010000000000 010000000000 010007C00000 03001FE00000 070038700000
-070030300000 0F0060300000 1B00C0700000 3300C0600000 6300C0C0C000
-C300C3818000 030046030000 03007C020000 0300F0060000 0180F00C0000
-018198180000 01C30C300000 00CE06300000 00FC03E00000 007801C00000
-000000000000 000000000000 >getsymb
-240< 00000000 00000000 00004000 0003C000 00038000 000E0000 000C0000
-00080000 00180000 0E187C00 1F98FC00 3FDCFF00 3FFFFF00 7FFFFE00
-7FFFFC00 FFFFF800 FFFFF000 FFFFF000 FFFFF000 FFFFF000 FFFFF000
-FFFFFC00 7FFFFC00 7FFFFF00 3FFFFF00 1FFFFE00 0FFFFE00 07FFF800
-03F3F000 00000000 00000000 >getsymb
-228< 000000000000 000000000000 03C010000000 07C0F0000000 1C7330000000
-383F20000000 303040000000 2030C0000000 6030C0000000 C01080000000
-C01180000000 C03100000000 406300000000 604200000000 60C40E000080
-71843F01E080 3F0CE183B180 1E0880CE1F00 001180FA0600 003100460600
-0023004C0200 0047004C0300 004B004C0300 00B300CC0300 00E300CC0200
-01C1818C0200 03C1830C0600 0380830C0C00 0600FE061800 1C007C03F000
-180000000000 300000000000 000000000000 000000000000 >getsymb
-226< 0000 0000 2000 1800 1800 0C00 0C00 0C00 0C00 0C00 0C00 1800 1000
-3000 6000 8000 0000 0000 >getsymb
-225< 0000 0000 7000 E800 F800 F800 F000 F000 0000 0000 >getsymb
-221< 0000 0000 8000 E000 3000 1C00 0E00 0700 0380 01C0 01C0 00E0 0030
-0030 0030 0060 00C0 0180 0300 0200 0600 0C00 1800 3000 4000 0000 0000
->getsymb
-220< 0000 0000 0060 0040 00C0 0180 0300 0600 0C00 1C00 3000 7000 6000
-C000 4000 6000 3000 3000 1800 1C00 0E00 0600 0300 0100 0000 0000
->getsymb
-218< 00000000 00000000 00020000 00060000 000E0000 000C0000 000C0000
-00180000 00180000 00100000 00300000 00200000 00200000 00400000
-00C00000 00C00000 01800000 01800000 03000000 03000000 06000000
-06000000 0C000000 1C000000 18000000 38000000 30000000 70000000
-60000000 C0000000 00000000 00000000 >getsymb
-213< 0000 0000 2000 1800 0C00 0400 0400 0C00 1800 3000 6000 8000 0000
-0000 >getsymb
-212< 0000 0000 0800 3000 6000 C000 C000 C000 6000 3000 1000 0800 0000
-0000 >getsymb
-211< 0000 0000 0040 1020 0810 0C18 0C18 1818 3010 4030 8060 0040 0000
-0000 >getsymb
-210< 00000000 00000000 00060000 04180000 18300000 30600000 60C00000
-C0C00000 C0C00000 C0C00000 C0400000 40200000 20000000 00000000
-00000000 >getsymb
-209< 000000000000 000000000000 FFF000000000 0FFFC0000000 000FFFFE0000
-000007FFF000 000000000000 000000000000 >getsymb
-208< 00000000 00000000 FFC00000 7FFF8000 007FE000 00000000 00000000
->getsymb
-204< 00000000 00000000 00000200 00038C00 0007F800 001CF000 00380000
-00200000 00000000 00000000 00080000 00060000 00030000 00078000
-0007C000 000CE000 001CF000 00303000 00303E00 003FF800 00FF1800
-00400C00 00C00C00 01800600 01800600 03000300 06000300 1C000380
-30000380 60000380 E0000700 00000000 00000000 >getsymb
-203< 00000000 00000000 00300000 00180000 000E0000 00038000 0003C000
-0000E000 0000F000 00001800 00060800 00030000 00038000 00078000
-000EC000 000C6000 00182000 00302000 00703000 01FC3000 00FFF800
-01807F80 03800E00 07000200 06000200 0E000300 1C000100 38000180
-600000C0 C0000060 C0000060 00000000 00000000 >getsymb
-201< 00000000 00000000 80180600 E03C0700 E07C0700 703C0E00 00000000
-00000000 >getsymb
-200< 00000000 00000000 00100000 00180000 E00C0000 30060000 18060000
-0C070000 0E018000 0E01C000 0780C000 03806000 00E07000 00E03000
-00703800 00303800 00607000 00606000 01C0C000 0180C000 03018000
-06070000 0C060000 380C0000 30080000 00100000 00200000 00600000
-00000000 00000000 >getsymb
-199< 00000000 00000000 00010000 00620000 00C60000 018C0000 03180000
-06180000 0C300000 18600000 10600000 70C00000 60C00000 E1C00000
-61C00000 30E00000 38600000 18300000 1C100000 0E080000 070C0000
-03060000 01C30000 00C30000 00438000 00418000 00008000 00000000
-00000000 >getsymb
-197< 00000000 00000000 00003800 0000F000 0C038000 3F870000 70FE0000
-603C0000 C0000800 80001000 00003000 03802000 0FE06000 38F06000
-701CC000 600F8000 60078000 00030000 00000000 00000000 >getsymb
-196< 00000000 00000000 0001C000 001F8000 00380000 00600000 00600000
-00400000 00400000 00C00000 00C00000 00C00000 00C00000 00CC0000
-00980000 01F00000 0F800000 0D800000 01800000 01800000 01800000
-01800000 01800000 01800000 01800000 01800000 01800000 01800000
-01800000 01800000 03000000 02000000 06000000 8C000000 78000000
-00000000 00000000 >getsymb
-195< 00000000 00000000 00000400 00001800 0003F000 00078000 00060000
-00040000 000C0000 000C0000 600C0000 F00C0000 300C0000 18180000
-18180000 18180000 08100000 08300000 0C300000 0C600000 0C600000
-0C400000 0DC00000 07800000 07000000 02000000 00000000 00000000
->getsymb
-194< 00000000 00000000 03018000 0F07C000 188C6000 10C83000 20701800
-60300C00 40200600 C0200300 C0000300 C0000300 40000300 40000300
-60000300 60000600 20000C00 30000800 10001800 18003000 0C006000
-0C00C000 06018000 03070000 010C0000 00980000 00F00000 00600000
-00400000 00400000 00000000 00000000 >getsymb
-192< 00000000 00000000 00C00000 00E00000 00C00000 00000000 00000000
-00000000 00C00000 00C00000 00600000 00600000 00C00000 01800000
-03000000 06000000 1C000000 38000000 60000000 60040000 C0060000
-C0020000 C0010000 E0030000 70060000 380C0000 1C3C0000 0FF80000
-07E00000 00000000 00000000 >getsymb
-191< 00000000 00000000 06000000 1F000000 318C0000 609F0000 60B38000
-60E18000 40418000 C040C000 C000C000 C000C000 C000C000 C0018000
-40030000 60060000 600C0000 30180000 30100000 18300000 18600000
-08400000 0CC00000 0C800000 05800000 03000000 03000000 02000000
-00000000 00000000 >getsymb
-186< 00000000 00000000 00060000 001C0000 00F80000 01F00000 01800000
-03800000 03800000 07000000 07000000 07000000 07000000 07000000
-07000000 07000000 07000000 07000000 07000000 07000000 07000000
-0F000000 0F000000 0F000000 0F000000 0F000000 0F000000 0F000000
-0E000000 0E000000 0E000000 0E000000 0E000000 0E000000 0E000000
-8C000000 FC000000 F8000000 30000000 00000000 00000000 >getsymb
-185< 00000000 00000000 00004000 7C003000 FF003000 CF806000 CDC0C000
-0CFF0000 0C1F0000 0C030000 0C030000 0C030000 0C030000 0C010000
-0C018000 3800D000 30006000 00000000 00000000 >getsymb
-184< 00000000 00000000 1FC00000 7FFC0000 EE0F0000 83038000 0301C000
-0180C000 01806000 01802000 01803000 01803000 01803000 01803000
-01803000 01803000 01806000 0180E000 0181C000 018F8000 03FC0000
-0FE00000 03000000 03000000 03000000 03000000 06000000 06000000
-06000000 06000000 06000000 06000000 00000000 00000000 >getsymb
-183< 00000000 00000000 000FF800 003FFE00 00F00700 03C00180 0F000080
-07000000 03C00000 01E00000 00780000 001E0000 00070000 0001C000
-0000E000 00007000 0000F800 0001C000 00038000 00060000 000C0000
-00380000 00700000 00E00000 01C00000 03800080 0F000180 1C000180
-38000180 70000300 E0000300 FC000600 7FFC0C00 03FFF800 0003F000
-00000000 00000000 >getsymb
-182< 0000 0000 0F00 3F80 40E0 8070 0038 0018 000C 000C 000C 000C 038C
-0FEC 1C3C 301C 201C 600C 600C 600C 600C 6008 6018 6030 3060 1FC0 0F80
-0000 0000 >getsymb
-181< 00000000 00000000 0600C000 0600C000 0600C000 0600C000 06008000
-06018000 06018000 0E018000 0E018000 0E018000 0E038000 0E038000
-0E038800 1E079800 1B0DF000 19F8E000 10F04000 30000000 30000000
-30000000 30000000 60000000 60000000 40000000 80000000 00000000
-00000000 >getsymb
-180< 00000000 00000000 08000000 0C030000 0C038000 00000000 00000000
-00000000 00000000 04030000 0C030000 0C030000 18030000 38030000
-30030000 70060300 F0060600 301C0C00 301C0C00 303C1800 186C3000
-1C6C6000 0CCC6000 078CC000 030D8000 000F0000 000E0000 003C0000
-007C0000 00CC0000 018C0000 030C0000 030C0000 03180000 03300000
-01E00000 00C00000 00000000 00000000 >getsymb
-179< 00000000 00000000 38000000 0E000000 03800000 00C00000 00600000
-00300000 001C0000 00070000 0003C000 00018000 00030000 00060000
-001C0000 00780000 00C00000 01800000 07000000 0E000000 18000000
-00000000 000FE000 1FFF0000 7FE00000 00000000 00000000 3FFFC000
-FFFF8000 00000000 00000000 >getsymb
-178< 00000000 00000000 00018000 00070000 000C0000 00180000 00700000
-01C00000 07000000 0C000000 38000000 60000000 C0000000 E0000000
-30000000 18000000 0E000000 07000000 01C00000 00E00000 00380000
-001C0000 00070000 00000000 00000000 3FFFF000 0FFFE000 00000000
-00000000 0FE00000 07FF8000 001FE000 00000000 00000000 >getsymb
-177< 00000000 00000000 01000000 03000000 03000000 03000000 03000000
-03000000 03000000 03000000 FFF80000 FFFF0000 03000000 03000000
-03000000 01800000 01800000 01800000 01800000 01800000 00000000
-00000000 FFFFC000 0FFFC000 00000000 00000000 >getsymb
-176< 00000000 00000000 000F0000 003FC000 3C60E000 7EC06000 C1806000
-C180C000 61FF8000 7F1F0000 1E000000 00000000 00000000 >getsymb
-175< 00000000 00000000 00000300 00000600 00000400 001FEC00 00783800
-00E03C00 03806600 06006200 0E004300 0C00C300 0C018180 0C018180
-18030180 18020180 18060180 180C0180 18080180 18180180 18300300
-18700300 18E00200 09800600 0D000C00 0F000800 07003800 0780F000
-0DFFC000 0C7F0000 18000000 30000000 60000000 C0000000 00000000
-00000000 >getsymb
-174< 00000000 00000000 00FF0000 03C1C000 0700E000 1C003000 30001000
-70001800 60001800 60000C00 60000C00 C0000C00 C0000C00 C0000C00
-C0000C00 C0000C00 C0000C00 C0001800 C0001800 C0001000 40003000
-60006000 70004000 3801C000 1C078000 0FFE0000 03F80000 00000000
-00000000 >getsymb
-173< 00000000 00000000 00040000 000C0000 000C0000 000C0000 00180000
-001FF000 07FFC000 3FF80000 78300000 00600000 00600000 00C00000
-00FFE000 3FFFC000 FFC00000 01800000 01800000 03000000 03000000
-06000000 04000000 00000000 00000000 >getsymb
-172< 0000 0000 E038 6038 C030 0000 0000 >getsymb
-171< 0000 0000 0600 1C00 3000 6000 4000 C000 C000 8000 0000 0000
->getsymb
-170< 000000000000 000000000000 000F20000000 01F82C700000 FF803EF80000
-FF00638C0000 6300630C0000 330063040000 130063060000 1B0063060000
-0B00C3060000 0B00C3060000 0B00C3068000 0E0183028000 060101038000
-000000030000 000000000000 000000000000 >getsymb
-169< 00000000 00000000 0000F800 0003FC00 003F1E00 00F80700 03800180
-06000180 1C0000C0 300000C0 3007C0C0 601FF0E0 60301820 60200C30
-C0600430 C0C00030 C0C00030 C0C00030 C0C00030 C0C02030 C0402030
-C0606030 6030C020 603F8060 380E01C0 3C000300 03001E00 03C03C00
-00FFE000 00FF0000 00000000 00000000 >getsymb
-168< 00000000 00000000 00078000 000FC000 000CE000 000C7000 007E1800
-00FC0C00 07C00E00 0F800700 0C060300 1C9F8300 30B0C180 30C0C180
-70C1C180 E0C38080 C0FF00C0 C0FC00C0 C1C800C0 C1CC00C0 C30E01C0
-C3030180 E2038300 6201C300 30000700 30000E00 38003C00 1C007800
-0E00E000 0F03C000 07FF8000 01FC0000 00000000 00000000 >getsymb
-167< 00000000 00000000 00070000 003F8000 0C70C000 1EC04000 1E804000
-1700C000 37018000 36030000 360C0000 661F0000 66018180 C6008300
-0600C600 0600CC00 0600D800 0600F000 0600E000 0600C000 0E038000
-0E0E0000 0C180000 0C200000 0C000000 0C000000 08000000 08000000
-10000000 10000000 10000000 00000000 00000000 >getsymb
-166< 00000000 00000000 00060000 00038000 01F0C000 07AFE000 3FBDF000
-5F5C3000 4FFC3000 5FFC3000 BFFC1000 FFFC1000 7FFC1000 7FFC1800
-7FF81800 7FF81800 FFF81800 FFF80800 7FF80800 7FF80800 3FF80800
-00580800 00180800 00180800 00181800 00181800 00181800 00181000
-00183000 00182000 00186000 00186000 0018C000 001CC000 000F8000
-00078000 00000000 00000000 >getsymb
-165< 0000 0000 3000 4F00 9FC0 FFE0 FFF0 7FF8 FFF8 FFF8 FFF8 FFFC 9FE4
-AFE4 4FD8 7FF0 2700 1E00 0000 0000 >getsymb
-164< 00000000 00000000 00F00000 01FC0000 03060000 06020000 06000000
-07000000 03200000 01C00000 07F00000 1C1C0000 30060000 60030000
-C0018000 C0018000 C0018000 E0070000 700C0000 1E780000 07E00000
-03F00000 06380000 081C0000 000C0000 00060000 00030000 00018000
-0400C000 0400C000 06018000 03038000 01FE0000 00F00000 00000000
-00000000 >getsymb
-163< 00000000 00000000 00018000 0007C000 001C6000 00303000 00601800
-00600800 00400000 00C00000 00C00000 00C00000 00C00000 00C00000
-00C00000 00C00000 1FC00000 03FE0000 01FFC000 01C00000 01800000
-0180E000 03013000 07001800 06001800 0C001000 18002000 3FC0E000
-F07FC000 601F0000 00000000 00000000 >getsymb
-162< 00000000 00000000 00180000 00300000 00200000 00600000 00600000
-00600000 00600000 01F00000 07F80000 0CCC0000 08C40000 18C00000
-30C00000 70800000 F1801000 31803000 31806000 31804000 3180C000
-31818000 19818000 19830000 0D8E0000 07980000 01F00000 01800000
-01000000 01000000 03000000 03000000 02000000 00000000 00000000
->getsymb
-161< 0000 0000 3C00 6600 6300 4180 C180 C080 C080 E180 FF00 4C00 6000
-3000 0000 0000 >getsymb
-160< 00000000 00000000 00C00000 00C00000 00C00000 00C00000 00C00000
-00C00000 00C00000 00C00000 01C00000 E1C00000 FFE00000 07FC0000
-01CF8000 01800000 01800000 01800000 01800000 01800000 01800000
-01800000 01800000 01800000 01800000 01800000 01800000 01800000
-01800000 01000000 00000000 00000000 >getsymb
-159< 00000000 00000000 01000000 0300C000 0300C000 00006000 00000000
-00000000 00000000 00000000 00008000 04008000 0E018000 3B018000
-63010000 43010180 C3030300 02030600 06030400 06030C00 06030C00
-06070800 06059800 060D9800 06189000 03F0F000 01E06000 00000000
-00000000 >getsymb
-158< 00000000 00000000 00100000 00780000 01CE0000 03870000 06018000
-0400C000 08006000 00002000 00000000 00000000 00000000 00004000
-00004000 0C018000 1E018000 33030000 63030180 C3030300 03030600
-06030600 06030400 06070C00 06070C00 06051800 06091800 07191000
-03F1F000 01E0E000 00000000 00000000 >getsymb
-157< 00000000 00000000 01800000 00C00000 00F00000 00300000 00180000
-000C0000 00060000 00000000 00000000 00000000 00008000 00018000
-00018000 3C018000 7E018000 43018180 C3010300 03030600 06030600
-06030C00 06070C00 06070C00 06059800 060D9800 07089000 03F8F000
-01F06000 00000000 00000000 >getsymb
-156< 00000000 00000000 00007000 0001C000 00030000 000E0000 00380000
-00200000 00E00000 00000000 00000000 00004000 0E00C000 1E00C000
-13018000 33018000 63030000 43030180 C3030300 03030600 06030600
-06070C00 06070C00 060F0C00 06099800 06199800 07309000 03E0F000
-01C06000 00000000 00000000 >getsymb
-155< 00000000 00000000 00C0C000 01E38000 11370000 0E1E0000 04000000
-00000000 00000000 00F00000 03FC0000 071E0000 0E070000 38018000
-7801C600 D801EC00 1801B800 18018000 18018000 0C018000 0C018000
-06010000 06030000 03060000 01FC0000 00F00000 00000000 00000000
->getsymb
-154< 00000000 00000000 0C040000 0C0E0000 100E0000 00000000 00000000
-00000000 00000000 00F00000 03FC0000 079E0000 0F070000 3F038000
-7203C600 C6017C00 06013000 06018000 0E018000 0C018000 0C010000
-06030000 06060000 030C0000 01F80000 00F00000 00000000 00000000
->getsymb
-153< 00000000 00000000 00C00000 00600000 00F00000 01BC0000 030E0000
-06070000 18018000 1000E000 00000000 00F00000 03FC0000 079E0000
-1F070000 3C038000 7803C600 D8016C00 18013800 18018000 18018000
-0C018000 0C010000 06030000 06060000 030C0000 01F80000 00F00000
-00000000 00000000 >getsymb
-152< 00000000 00000000 06000000 07000000 01C00000 00780000 003C0000
-00070000 00000000 00000000 00F00000 03FC0000 071E0000 1C030000
-38038000 7801C600 D8016C00 18013800 18018000 18018000 08018000
-0C010000 0C030000 06060000 030C0000 01F80000 00F00000 00000000
-00000000 >getsymb
-151< 00000000 00000000 00010000 00020000 000C0000 00180000 00300000
-00E00000 03800000 00000000 00000000 00000000 00000000 00000000
-00F00000 03FC0000 079C0000 1C060000 38030000 7801C600 D8016C00
-18013800 18018000 18018000 1C018000 0C030000 0C020000 0C060000
-060C0000 07F80000 01F00000 00000000 00000000 >getsymb
-150< 00000000 00000000 00000600 00E00C00 01B83800 010E6000 0603C000
-0C000000 00000000 00000000 00000000 00000000 00000000 0F1C0000
-3FBF0000 31B38000 61E18000 C1C18180 81818180 01818300 01818300
-01818600 03018600 07018400 06018C00 0600CC00 06007800 06003000
-00000000 00000000 >getsymb
-149< 0000 0000 1800 3830 3878 0070 0000 0000 0000 0000 0C00 1800 1800
-3000 3000 7008 F018 B030 3060 3060 30C0 30C0 3180 3180 1B00 1E00 1C00
-0800 0000 0000 >getsymb
-148< 0000 0000 0300 0780 0D80 18C0 3040 2060 2030 4030 0018 0000 0C00
-1800 1800 3000 3000 7008 F018 B030 3060 3060 30C0 30C0 3180 3180 1B00
-1E00 1C00 0800 0000 0000 >getsymb
-147< 0000 0000 8000 E000 7000 1800 0C00 0700 0780 0000 0000 0000 0C00
-1800 1800 3000 3000 7008 F018 B030 3060 3060 30C0 30C0 3180 3180 1B00
-1E00 1C00 0800 0000 0000 >getsymb
-146< 0000 0000 0018 0030 0060 01C0 0300 0E00 1C00 0000 0000 0000 0C00
-1800 1800 3000 3000 7008 F018 B030 3060 3060 30C0 30C0 3180 3180 1B00
-1E00 1C00 0800 0000 0000 >getsymb
-145< 00000000 00000000 301C0000 380C0000 30000000 00000000 00000000
-00000000 00000000 03E00000 0FF00000 1C180000 30180000 60180000
-40300000 C0600000 C0C00000 C7800000 FE001800 F0001000 60003000
-30006000 3000C000 18018000 0C030000 0C060000 061C0000 03F80000
-00E00000 00000000 00000000 >getsymb
-144< 00000000 00000000 03E00000 0FF80000 300E0000 20030000 40010000
-C0000000 00000000 00000000 03E00000 07300000 0C180000 180C0000
-300C0000 200C0000 60380000 60E00000 67C00000 FE001800 60003000
-60006000 3000C000 30018000 10030000 18060000 0C0C0000 06380000
-03F00000 01C00000 00000000 00000000 >getsymb
-143< 00000000 00000000 38000000 0C000000 07000000 01800000 00C00000
-00400000 00000000 00000000 01C00000 07E00000 0C300000 18180000
-30080000 30380000 60E00000 C3800000 CE000000 F8000C00 F0001800
-60003000 30006000 3000C000 18018000 08030000 0C060000 060C0000
-03F80000 01E00000 00000000 00000000 >getsymb
-142< 00000000 00000000 001C0000 00780000 00C00000 00800000 03000000
-02000000 00000000 00000000 07800000 1FC00000 30600000 60300000
-60300000 40600000 C1C00000 C7800000 9E000000 F0000800 C0001800
-C0003000 60006000 2000C000 30018000 18030000 080E0000 0C180000
-07F00000 03C00000 00000000 00000000 >getsymb
-141< 00000000 00000000 03E00000 0FF00000 18180000 30080000 60000000
-60003000 40006000 C000C000 C0008000 C0018000 C0018000 C0030000
-40030000 60020000 30060000 1F0C0000 07F80000 00E00000 00C00000
-00400000 00780000 001C0000 00040000 04060000 06060000 03060000
-030C0000 01F80000 00000000 00000000 >getsymb
-140< 00000000 00000000 00F00000 01F80000 02880000 00880000 00D80000
-00700000 00000000 00000000 01E08000 03F98000 060D8000 0C070000
-18060000 10060000 30060000 70060000 E0060600 E00C0400 600C0C00
-600C1800 201C1000 30163000 30366000 18366000 18624000 0FC3C000
-07818000 00000000 00000000 >getsymb
-139< 00000000 00000000 00004000 00008000 0E030000 339E0000 40F00000
-00000000 00000000 00000000 01E08000 03F98000 060D8000 0C070000
-18060000 10060000 30060000 70060000 E0060600 E00C0400 600C0C00
-600C1800 201C1000 30163000 30366000 18366000 18624000 0FC3C000
-07818000 00000000 00000000 >getsymb
-138< 00000000 00000000 00080000 040C0000 1C0C0000 18000000 00000000
-00000000 00000000 01E08000 03F98000 060D8000 0C070000 18060000
-10060000 30060000 70060000 E0060600 E00C0400 600C0C00 600C1800
-201C1000 30163000 30366000 18366000 18624000 0FC3C000 07818000
-00000000 00000000 >getsymb
-137< 00000000 00000000 00F00000 031C0000 0E060000 18038000 00008000
-00000000 00000000 01E08000 03F98000 060D8000 0C070000 18060000
-10060000 30060000 70060000 E0060600 E00C0400 600C0C00 600C1800
-201C1000 30163000 30366000 18366000 18624000 0FC3C000 07818000
-00000000 00000000 >getsymb
-136< 00000000 00000000 10000000 0C000000 04000000 06000000 03000000
-01800000 00000000 00000000 01E08000 03F98000 060D8000 0C070000
-18060000 10060000 30060000 70060000 E0060600 E00C0400 600C0C00
-600C1800 201C1000 30163000 30366000 18366000 18624000 0FC3C000
-07818000 00000000 00000000 >getsymb
-135< 00000000 00000000 00030000 000E0000 00180000 00300000 00400000
-00000000 00000000 00000000 01E08000 03F98000 060D8000 0C070000
-18060000 10060000 30060000 70060000 E0060600 E00C0400 600C0C00
-600C1800 201C1000 30163000 30366000 18366000 18624000 0FC3C000
-07818000 00000000 00000000 >getsymb
-134< 00000000 00000000 38003800 38003800 30001800 00000000 00000000
-20000000 60001800 60001800 60001800 C0001800 C0001800 C0001800
-C0003000 C0003000 C0006000 C0006000 C000C000 C001C018 C001C030
-C003C060 6006C060 600C60C0 30186180 3C303300 0FE01E00 07C00C00
-00000000 00000000 >getsymb
-133< 00000000 00000000 0F878000 1FCFC000 307CF800 303C3C00 30300C00
-30300600 30300300 30300300 30300300 30300300 30300700 60300E00
-C031FC00 C073F800 C0FF0000 C0FF0000 C0C30000 C0C30000 C0C18000
-C0C0C000 C0C0E000 C0C07000 E0C03000 E0C03800 70C00E00 30C00E00
-30C00300 30C00300 38C00380 1CC00180 0F8000C0 0F000040 00000000
-00000000 >getsymb
-132< 00000000 00000000 0F000100 1F800100 30E00300 30700300 30700300
-30700300 20580300 204C0300 20CC0380 60CC01C0 E0CE00C0 E0C700C0
-C0C300C0 C0C300C0 C0C381C0 C0C1C380 C0C0C300 C0C0C300 C0C0C300
-C0C0C300 C0C06300 C0C06300 C0C03300 C0C03300 C0C03F00 C0C01F00
-C0C00F00 C1C00F00 FF800F00 3F000600 00000000 00000000 >getsymb
-131< 0000 0000 000C 0018 0030 00E0 0380 0000 1FC0 09FC 181C 1000 3000
-2000 7F00 6FE0 E000 C000 C000 8000 C000 F000 3E00 07F0 0000 0000
->getsymb
-130< 00000000 00000000 003FC000 00FFE000 07F03000 0FC03800 1F000C00
-3B000E00 33000000 73000000 63000000 63000000 C3000000 C3000000
-C3000000 C3000000 C3000000 C3000000 C3000000 C3000000 C3000000
-C3000000 C3000000 C3000000 C6000000 CC000200 7C000C00 3C001C00
-07003000 03807000 01FFE000 00FF8000 00000000 00000000 >getsymb
-129< 00000000 00000000 000F0000 001F8000 0030C000 0030C000 0010C000
-001F0000 00000000 00000000 000C0000 000E0000 000E0000 000F0000
-00338000 00338000 0040C000 00C0C000 00FFC000 00FFE000 0101E000
-03003000 04003800 0C003800 10000C00 30000C00 60000E00 60000E00
-C0000600 C0000700 00000000 00000000 >getsymb
-128< 00000000 00000000 00C00000 00E0E000 00E0E000 0070F000 00000000
-00000000 00000000 00000000 00030000 00030000 00038000 0003C000
-000CE000 000CF000 00383000 00303800 0037FC00 003FBC00 00C00C00
-00C00E00 03000700 03000300 0C000380 0C000180 3C0000C0 380000C0
-E0000060 C0000060 00000000 00000000 >getsymb
-126< 00000000 00000000 00001000 00003000 00004000 1C018000 3E030000
-63060000 819C0000 00F00000 00600000 00000000 00000000 >getsymb
-125< 0000 0000 0780 1FE0 3870 0030 0030 0030 0030 0030 0030 0070 0060
-0040 0060 0030 0018 001C 0070 0060 0040 00C0 00C0 00C0 00C0 00C0 00C0
-0060 0020 0030 C030 7060 1DE0 0F80 0000 0000 >getsymb
-124< 0000 0000 6000 6000 6000 6000 6000 6000 6000 6000 6000 6000 6000
-6000 6000 6000 6000 C000 C000 C000 C000 C000 C000 C000 C000 C000 C000
-C000 C000 4000 0000 0000 >getsymb
-123< 00000000 00000000 00F80000 03FC0000 07020000 06000000 0C000000
-0C000000 0C000000 0C000000 0C000000 0C000000 18000000 18000000
-70000000 E0000000 38000000 0C000000 0C000000 0C000000 0C000000
-0C000000 0C000000 0C000000 18000000 18000000 30000000 30000000
-30040000 183C0000 1CF00000 07800000 00000000 00000000 >getsymb
-122< 00000000 00000000 03020000 078E0000 0CFC0000 186C0000 30080000
-30180000 60300000 C0306000 0060C000 0040C000 00C18000 00818000
-01830000 01030000 03060000 078C0000 0CF80000 18300000 00000000
-00000000 >getsymb
-121< 00000000 00000000 0600C000 0600C000 0C00C000 1C00C000 3C018000
-38038000 78038000 D8031800 18031000 18073000 180F2000 181B6000
-1C334000 0E62C000 07C78000 00070000 00060000 000E0000 001E0000
-00360000 00660000 00C60000 01860000 01860000 01840000 018C0000
-00F80000 00700000 00000000 00000000 >getsymb
-120< 00000000 00000000 0C000000 1E030000 1B078000 330C8000 31180000
-61B00000 C1B01800 01A03000 01E02000 00C06000 00C04000 00C0C000
-01C08000 63418000 36670000 3C3E0000 18180000 00000000 00000000
->getsymb
-119< 00000000 00000000 18004000 38084000 6C186000 4C186000 CC186040
-08183980 18183F00 18183600 18183000 18383000 18683000 18682000
-0C4C2000 0ECC6000 0386C000 01838000 00000000 00000000 >getsymb
-118< 00000000 00000000 18180000 3C1C0000 6C0C0000 4E0E0000 C6073000
-0607E000 0606C000 0C020000 0C030000 0C030000 0C030000 0C030000
-0C060000 040C0000 06180000 06300000 03E00000 01800000 00000000
-00000000 >getsymb
-117< 00000000 00000000 00004000 0E00C000 1E00C000 13018000 33018000
-63030000 43030000 C3030300 03030600 06030600 06070C00 06070C00
-060F0C00 06099800 06199800 07309000 03E0F000 01C06000 00000000
-00000000 >getsymb
-116< 00000000 00000000 00100000 00300000 00300000 00700000 00F00000
-01B00000 01300000 03300000 06200000 06200000 0C600000 18600000
-18400000 30400000 60400000 C6460000 0F4C0000 11580000 10F00000
-1FC00000 0CC00000 00800000 00800000 00800000 00800000 00800000
-00800000 00000000 00000000 >getsymb
-115< 00000000 00000000 00C00000 01C00000 07600000 1C600000 30300000
-60304000 C010C000 00198000 00198000 001B0000 000F0000 000E0000
-000C0000 00180000 00300000 00600000 18C00000 0F800000 07000000
-00000000 00000000 >getsymb
-114< 00000000 00000000 0C100000 1E300000 33F00000 31900000 60300000
-60600000 C0410000 80C20000 01860000 030C0000 03180000 03180000
-03300000 06300000 06200000 06600000 06400000 06C00000 07800000
-03000000 00000000 00000000 >getsymb
-113< 00000000 00000000 00004000 00FCC000 03FEC000 0F06C000 3C03C200
-78018600 D8018400 10038C00 30078C00 30058800 300D9800 30099800
-30119800 38333000 18633000 0FC23000 07062000 00066000 00064000
-000CC000 000CC000 000D8000 000D0000 000D0000 000F0000 000E0000
-00060000 00000000 00000000 >getsymb
-112< 00000000 00000000 00380000 0C7C0000 1EC60000 36C20000 67830000
-67030180 C6010300 06018600 06018400 0E018C00 0C008800 0C00D800
-0C007000 0C002000 0C000000 0C000000 0C000000 18000000 18000000
-18000000 18000000 18000000 18000000 18000000 18000000 18000000
-10000000 10000000 00000000 00000000 >getsymb
-111< 00000000 00000000 00F00000 03FC0000 079E0000 1F070000 3C038000
-7803C000 D8016C00 18013800 18018000 18018000 0C018000 0C010000
-06030000 06060000 030C0000 01F80000 00F00000 00000000 00000000
->getsymb
-110< 00000000 00000000 0E0E0000 1F1F0000 33B30000 21A18000 61E18000
-C1C18180 81818180 01818300 03018300 03018600 07018600 06018400
-0E018C00 0C00CC00 0C007800 0C003000 00000000 00000000 >getsymb
-109< 000000000000 000000000000 000000E00000 060001F00000 0F1E01300000
-19BF03180000 31E382180000 31C0C6180000 6180C4180000 C180CC183000
-8180C8186000 0180D8186000 0180F018C000 0180E0198000 0380C0190000
-0300C01B0000 0601800E0000 0601800E0000 060180040000 060180000000
-000000000000 000000000000 >getsymb
-108< 0000 0000 0700 0F80 08C0 18C0 18C0 18C0 30C0 30C0 30C0 3080 3180
-3300 3600 3600 3C00 3800 3008 7018 F030 B020 3060 3040 30C0 30C0 3080
-1980 1F00 0E00 0000 0000 >getsymb
-107< 00000000 00000000 00300000 00F80000 018C0000 018C0000 030C0000
-030C0000 03180000 03300000 03600000 03C00000 03800000 03000000
-07000000 0F000000 1B1E0000 323F0000 66618000 C6C18600 86C30C00
-078E1800 07383000 07E03000 07806000 06C06000 0C60C000 0C20C000
-0C318000 18330000 181E0000 180C0000 00000000 00000000 >getsymb
-106< 0000 0000 0080 0300 0300 0000 0000 0600 0600 0600 0E00 1E00 1600
-3600 6610 C630 8660 06C0 0780 0700 0600 0E00 1E00 3600 6600 6600 C600
-C600 C600 C600 C600 C600 CC00 CC00 CC00 7800 3000 0000 0000 >getsymb
-105< 0000 0000 0600 0600 0200 0000 0000 0000 0000 0000 0000 0C00 1800
-1800 3000 3000 7008 F018 B030 3060 3060 30C0 30C0 3180 3180 1B00 1E00
-1C00 0800 0000 0000 >getsymb
-104< 00000000 00000000 01E00000 03300000 03180000 02180000 06180000
-06180000 06180000 06300000 06200000 06600000 06C00000 07800000
-07000000 0E000000 1E000000 36000000 66000000 C6000300 06380600
-067C0600 06C60C00 07830C00 07030C00 06031800 06031800 06031800
-0C033000 0C033000 1801E000 1800C000 00000000 00000000 >getsymb
-103< 00000000 00000000 00300000 00F88000 038D8000 06070000 0C030000
-18070000 38070000 780F0000 D81B0600 98330C00 18331800 18633000
-0CC36000 0783C000 03078000 000F0000 003B0000 00630000 00C30000
-01830000 03060000 06060000 06060000 060C0000 06180000 03F00000
-01E00000 00000000 00000000 >getsymb
-102< 0000 0000 0380 07C0 0CC0 08C0 18C0 18C0 1980 1980 1900 1B00 1A00
-1C00 1C00 1800 3800 3800 5800 D818 1C70 1FC0 1E00 1B00 1980 18C0 18C0
-1860 1860 1860 1860 1860 1860 1860 1860 18C0 18C0 0C80 0F80 0700 0000
-0000 >getsymb
-101< 00000000 00000000 03E00000 0FF80000 1C1C0000 300C0000 200C0000
-600C0000 60380000 40E00000 C7800000 DE000400 F0000C00 E0001800
-60003000 30006000 3000C000 18018000 08030000 0C060000 079C0000
-03F80000 00E00000 00000000 00000000 >getsymb
-100< 00000000 00000000 00004000 00004000 00004000 0000C000 0000C000
-0000C000 0000C000 00018000 00018000 00018000 01E18000 07F18000
-0C1B8000 181F0000 180F0000 30060000 70060000 F0020300 B0060600
-30060400 300E0C00 300B0C00 101B1800 18319800 0C61B000 07C1F000
-0380E000 00000000 00000000 >getsymb
-99< 00000000 00000000 01F00000 07380000 0E0C0000 0C040000 18000000
-30000000 70000000 F0001000 30003000 30006000 30004000 3000C000
-30018000 18018000 18030000 0E0E0000 07380000 01F00000 00000000
-00000000 >getsymb
-98< 00000000 00000000 00600000 00F00000 01980000 010C0000 030C0000
-030C0000 03180000 02100000 06300000 06600000 07C00000 07000000
-06000000 0E000000 1E000000 36000000 66008000 C600C300 0601FE00
-0601B800 02018000 03018000 03018000 01010000 01830000 00C60000
-007C0000 00380000 00000000 00000000 >getsymb
-97< 00000000 00000000 01E08000 03F98000 060D8000 0C070000 18060000
-10060000 30060000 70060000 E0060600 E00C0400 600C0C00 600C1800
-201C1000 30163000 30366000 18366000 18624000 0FC3C000 07818000
-00000000 00000000 >getsymb
-96< 0000 0000 1800 3000 3000 6000 6000 C000 C000 C000 C000 6000 3000
-1800 0400 0000 0000 >getsymb
-95< 00000000 00000000 FF800000 3FFFFF00 00FFFF80 00000000 00000000
->getsymb
-94< 00000000 00000000 00700000 01F80000 038C0000 06060000 1C030000
-3001C000 6000E000 C0003000 00001800 00000C00 00000000 00000000
->getsymb
-93< 0000 0000 3FC0 FFC0 00C0 00C0 00C0 00C0 00C0 00C0 00C0 00C0 00C0
-00C0 00C0 00C0 00C0 00C0 00C0 00C0 00C0 00C0 00C0 00C0 00C0 00C0 00C0
-00C0 00C0 0180 0180 3F80 7F00 0000 0000 >getsymb
-92< 00000000 00000000 E0000000 70000000 30000000 18000000 18000000
-0C000000 0C000000 0E000000 06000000 06000000 03000000 03000000
-01800000 01800000 00C00000 00C00000 00400000 00600000 00600000
-00200000 00300000 00180000 00180000 00180000 000C0000 000E0000
-00060000 00070000 00038000 0000C000 00000000 00000000 >getsymb
-91< 0000 0000 7800 7F00 63C0 6000 6000 6000 6000 6000 6000 6000 6000
-6000 6000 6000 6000 6000 6000 6000 C000 C000 C000 C000 C000 C000 C000
-C000 E000 7C00 7F00 0000 0000 >getsymb
-90< 00000000 00000000 0C01F000 3E07B000 630C2000 41F86000 8070C000
-00018000 00030000 00060000 00040000 000C0000 00180000 00180000
-00300000 07E00000 00FC0000 00C00000 00800000 01800040 030000C0
-03000180 06000180 06000300 0C780600 09F80600 1B0F0C00 1E039800
-3C00F000 70007000 00000000 00000000 >getsymb
-89< 00000000 00000000 00002000 00002000 20002000 70006000 C8006000
-CC006000 CC00C000 8C00C000 0C00C000 0C00C000 0C00C000 0C00C000
-0C01C000 0C01C000 0403C000 0602C000 0602C600 0604CC00 021CD800
-03F0F000 01C0E000 0001C000 0003C000 0006C000 000CC000 0018C000
-0030C000 00608000 00418000 00C30000 00860000 008C0000 00D80000
-00700000 00000000 00000000 >getsymb
-88< 00000000 00000000 1F000000 31C00C00 30601E00 30303300 30387100
-18186000 0C18C000 000CC000 000C8000 000D8000 000F8000 000F0000
-000F0000 00070000 00060000 00060000 00060000 00060000 00060060
-000600C0 00060080 000F0180 400F0180 C01F0180 C0198100 C0318300
-6030C300 20604200 30C06600 1C803C00 0F801800 03000000 00000000
-00000000 >getsymb
-87< 000000000000 000000000000 100000000000 780000000000 4C0000000000
-8C0000000000 0C0030000000 0C00300000C0 0C00600001A0 0C0060000100
-0C0060000300 0C0060000300 0C00C0000300 0C00C0000300 1800C0000300
-1800C0000300 1001C0000600 3001C0000600 3003C0000C00 3003C0000C30
-3006C0001860 300CC00030C0 3018C00020C0 3018C0006180 3030C000C380
-1830C0018700 1860C0019C00 0CC0C003F800 0F80600FE000 0600703E0000
-00003FF00000 00000FC00000 000000000000 000000000000 >getsymb
-86< 00000000 00000000 30000100 78000380 CC0003F0 8C000360 0C000300
-0C000300 0C000300 0C000300 0C000600 0C000600 0C000600 0C000600
-0C000C00 06000C00 06000C00 06000C00 06001800 06001818 06001070
-060011E0 06003F80 06007C00 0300F000 0187C000 01FF0000 00780000
-00000000 00000000 >getsymb
-85< 000000000000 000000000000 300003000000 780003000000 CC0003000000
-8C0003000000 0C0003000000 0C0003000000 180006000000 180006000000
-180006000000 300006000000 300006000000 300006000000 30000C000000
-30000C000000 300018000000 300018000000 300030000000 300070060000
-3000700C0000 3000F0180000 1801B0180000 180318300000 0C0618600000
-0F0C0CC00000 03F807800000 01F003000000 000000000000 000000000000
->getsymb
-84< 00000000 00000000 0F800100 3FC00200 607E0C00 803FF800 000CE000
-000C0000 000C0000 000C0000 00060000 00060000 00030000 00030000
-00030000 00030000 00030000 00030000 000300C0 00030180 02030300
-02030300 02030600 03030C00 01833800 01C7F000 00FF8000 003C0000
-00000000 00000000 >getsymb
-83< 00000000 00000000 00F00000 01FC0000 031E0000 02030000 06018000
-0600C000 06004000 06004000 06008000 03000000 03800000 00F00000
-003C0000 000F0000 00038000 00018000 0000C600 00006400 00006C00
-00003800 00003000 20007000 70006000 9C00C000 06038000 030F0000
-03FC0000 01F80000 00000000 00000000 >getsymb
-82< 00000000 00000000 020FE000 033FF800 03F80C00 03C00600 07000300
-0F000300 1B000300 3B000300 33000600 33000C00 63003800 6300E000
-43038000 C30F0000 C3FC0000 C3FE0000 C3070018 C6070030 CC038060
-4C01C0C0 7C00C080 7C006180 38006180 38006100 38003300 38003300
-38001E00 38001E00 30000C00 10000000 00000000 00000000 >getsymb
-81< 00000000 00000000 001FE000 007FF000 01C03800 03001C00 06000C00
-0C000C00 0C000C00 18000C00 18000600 10000600 30000300 30000300
-30000300 30000300 60000300 60000200 60000600 C0000600 C000060C
-C000060C C0000C18 C0000C18 C0001830 603C3020 304E7060 3083C040
-1C01E0C0 0E037180 03FE1F00 00FC0E00 00000000 00000000 >getsymb
-80< 00000000 00000000 03FC0000 0FFF0000 3C01C000 7C007000 4C003800
-8C001800 0C000C00 0C000C00 0C000C00 0C000C00 06000C00 06000800
-06001800 06003000 261FE000 1FFF8030 0F800060 060000C0 06000180
-06000300 06000E00 06003800 0600F000 0603C000 0C0F0000 0C3C0000
-0FF00000 1FC00000 00000000 00000000 >getsymb
-79< 00000000 00000000 00FE0000 01FF8000 0700C000 0E00C000 0C006000
-18003000 30003000 30003000 70003000 60001800 40001C00 C0000C00
-C0000C00 C0000C00 C0000600 C0000600 C0000700 C0000730 C00006E0
-C0000600 60000600 60000600 30000400 30000C00 30001800 18003000
-0C006000 0C00C000 06018000 060F0000 03FC0000 00F00000 00000000
-00000000 >getsymb
-78< 000000000000 000000000000 1E0380000000 3F07E0000000 631C38000000
-81B81C000000 00F00C000000 00E006000000 00C002000000 00C003000000
-00C003000000 01C003000000 018003000000 018003000000 030003000000
-030003000000 030003800000 030001800000 030001800400 030001800800
-030001801800 060001803000 060000806000 0C0000C0C000 0C0000C0C000
-0C0000C18000 0C0000C30000 0C0000C60000 0000007C0000 000000380000
-000000000000 000000000000 >getsymb
-77< 000000000000 000000000000 070180000000 1F83C0000000 7186600F0000
-E0C6703F8000 00C43030C000 00CC1860C000 00CC18606000 00C808C06000
-00F80CC02000 00F006803000 00F007803000 00E007803000 00E003803000
-00E003003000 00E003003000 00E003006000 00E003006000 00E003006060
-00E0030060C0 00E0030060C0 00E003006180 00E003006180 00E003006100
-00E003006300 00C001006200 00C001006600 00C001003C00 00C001001800
-000000000000 000000000000 >getsymb
-76< 00000000 00000000 00300000 00780000 004C0000 00CC0000 00CC0000
-00CC0000 00CC0000 00D80000 00F00000 00E00000 01C00000 03C00000
-0EC00000 38C00000 60C00000 C0C00000 00C00000 00C00300 00C00600
-00C00C00 00C00C00 00C01800 0FE01800 1FF03000 31B83000 331C6000
-1E07C000 0C038000 00000000 00000000 >getsymb
-75< 00000000 00000000 18300060 3C7800C0 664C0300 43CC0600 838C1C00
-010C3800 000C6000 000CC000 000F8000 000F0000 00098000 0018C000
-00186000 00186000 00183000 00183000 00183018 00301830 00301830
-00201860 00600C60 20C00CC0 218004C0 330006C0 1E000380 0C000300
-00000000 00000000 >getsymb
-74< 00000000 00000000 00040000 180E0000 3E1B0000 23198000 63318000
-C1B18000 C1E18000 80C18000 80018000 00030000 00030000 00060000
-00060000 00060000 00060000 00062000 00066000 0006C000 00078000
-00070000 00060000 000C0000 001C0000 003C0000 006C0000 00CC0000
-018C0000 030C0000 060C0000 0C0C0000 0C0C0000 0C0C0000 0C0C0000
-0C180000 0C180000 06180000 03980000 03F80000 00F00000 00000000
-00000000 >getsymb
-73< 00000000 00000000 000C0000 1C3C0000 36660000 63C60000 41860000
-80060000 80060000 00060000 00060000 000C0000 000C0000 000C0000
-000C0000 000C0000 000C0000 00180000 00183000 00186000 00186000
-0018C000 80198000 801F0000 C03C0000 60700000 3FC00000 1F800000
-00000000 00000000 >getsymb
-72< 000000000000 000000000000 000001800000 000007C00000 1C100C600000
-3E3808600000 67D818600000 439818600000 801818400000 801818C00000
-001818800000 001819800000 00181F000000 00181C000000 001878000000
-001BF0000000 007E30000000 00F830000000 019830000000 031860030000
-061860060000 0618600C0000 0C18600C0000 181860180000 181860180000
-181060300000 183030300000 186030600000 0FC018600000 070008C00000
-00000F800000 000007000000 000000000000 000000000000 >getsymb
-71< 00000000 00000000 00180000 00FF0000 03C78000 0600E000 0C003000
-18001000 30000000 30000000 60000000 E0000000 C0000000 C0000000
-C0000000 C0000000 C0000000 60008000 60018000 30038030 30078060
-180F80C0 081D8380 0C310700 07E31C00 03C37000 0003C000 001F8000
-007F0000 01E30000 03830000 07030000 06060000 0C060000 0C040000
-0C0C0000 0C180000 0C100000 06300000 03E00000 01C00000 00000000
-00000000 >getsymb
-70< 00000000 00000000 0801FC00 0C0FF800 3FFE0000 FFF00000 8C000000
-0C000000 0C000000 04000000 06000000 06000000 03000000 0303F000
-03FF8000 03FC0000 03000000 02000000 06000000 06000600 04000C00
-0C001800 0C003000 0C00E000 18078000 180F0000 1FF80000 3FE00000
-00000000 00000000 >getsymb
-69< 00000000 00000000 03FC0000 07FF0000 1C038000 3C01C000 3000C000
-30004000 30000000 38000000 1E000000 0E000000 03F00000 01F80000
-03800000 0E000000 18000000 30000000 60000000 60000300 C0000600
-C0000600 C0000C00 C0000C00 C0001800 70003000 3800E000 1E01C000
-07FF0000 01FC0000 00000000 00000000 >getsymb
-68< 00000000 00000000 07FE0000 1FFF8000 3060C000 30C06000 30C03000
-19801800 19800800 0D000C00 07000400 07000600 03000300 03800300
-06C00300 06600300 06300300 061C0300 0C06030C 0C038318 1C01C670
-18007FC0 30003F00 3E001800 3B803000 71F0E000 C03FC000 C01F8000
-00000000 00000000 >getsymb
-67< 00000000 00000000 007F8000 01FFE000 07007000 0C003000 18001800
-38001800 30001800 60003000 60006000 6011C000 C01F0000 C0060000
-C0000000 C0000000 C0000000 C0000000 C0000000 C0000000 C00000C0
-C0000180 C0000180 60000300 60000300 60000600 30000C00 38003800
-1E00E000 0F03C000 01FF0000 00FE0000 00000000 00000000 >getsymb
-66< 00000000 00000000 03FC0000 0FFF0000 1B818000 2300C000 0300C000
-0300C000 0300C000 06018000 06038000 060F0000 041C0000 04700000
-0CF00000 0C1C0000 0C0F0000 0C078000 0C00C000 0C00600C 0C003018
-0C003818 0C001C30 0C000C30 0C000CE0 0C000DC0 18001F00 18001E00
-30003800 30007000 F800C000 7F018000 47FF0000 00FE0000 00000000
-00000000 >getsymb
-65< 00000000 00000000 001E0400 007F0C00 01C1C800 0300E800 06003800
-0C003000 18003000 10003000 30003000 60006000 60006000 60006000
-C0006000 C0006000 C000C000 C000C030 C000C060 C000C0C0 4000C180
-6000C300 2001C300 3001C600 3803C600 1802CC00 0C06CC00 06046C00
-039C7800 00F83000 00000000 00000000 >getsymb
-64< 00000000 00000000 001F0000 00FFE000 07C0F000 0F001800 1C000C00
-18000C00 30000700 70000300 60000180 60000180 400E0180 401F8180
-C030C180 C070C180 C0C04180 C1C0C180 C180C180 8300C180 C301C180
-C3018100 43018300 61018300 2186EE00 30CE7C00 107C0000 18000000
-0C000000 06000000 0300E000 01FFC000 007E0000 00000000 00000000
->getsymb
-63< 0000 0000 1E00 3F00 6180 C0C0 8060 8020 C030 6030 1030 0020 0060
-00C0 0180 0300 0200 0400 0C00 0800 1800 1000 3000 3000 1800 0000 0000
-0000 1800 1C00 0000 0000 >getsymb
-62< 00000000 00000000 C0000000 60000000 30000000 18000000 0C000000
-06000000 03000000 01800000 00C00000 00600000 00380000 001C0000
-00060000 00030000 00070000 001C0000 00700000 01C00000 07000000
-0E000000 38000000 60000000 C0000000 80000000 00000000 00000000
->getsymb
-61< 00000000 00000000 FFE00000 FFFFF000 001FF000 00000000 00000000
-00000000 00000000 00000000 00000000 FFFFC000 FFFFC000 00000000
-00000000 >getsymb
-60< 00000000 00000000 00018000 000F0000 00380000 00E00000 03800000
-06000000 0C000000 10000000 30000000 E0000000 60000000 20000000
-30000000 18000000 0C000000 06000000 03000000 01800000 00E00000
-00380000 000E0000 00038000 00000000 00000000 >getsymb
-59< 0000 0000 1800 3800 3000 2000 0000 0000 0000 0000 0000 0000 0000
-0000 0000 0000 0C00 0600 0600 0600 0600 1C00 3000 E000 8000 0000 0000
->getsymb
-58< 0000 0000 6000 F000 C000 C000 0000 0000 0000 0000 0000 0000 0000
-0000 0000 0000 0000 8000 F000 E000 0000 0000 >getsymb
-57< 00000000 00000000 03F00000 0FFC0000 180E0000 38060000 60020000
-C0030000 C0030000 C0030000 C0030000 C0030000 C0020000 40060000
-60060000 601E0000 30340000 18640000 0FEC0000 078C0000 00080000
-00080000 00180000 00180000 00100000 80300000 C0300000 70600000
-1FC00000 0F000000 00000000 00000000 >getsymb
-56< 00000000 00000000 007C0000 00C60000 01820000 03030000 03010000
-03010000 03010000 03030000 01030000 01030000 03860000 0F8E0000
-18F80000 30700000 60100000 60180000 60080000 C0080000 C0080000
-C0180000 40180000 60300000 3FE00000 0FC00000 00000000 00000000
->getsymb
-55< 0000 0000 0008 3078 78F8 CC98 8798 0710 0030 0030 0020 0060 0040
-00C0 0080 3980 0FE0 03F8 0300 0300 0600 0600 0600 0C00 0800 1800 3000
-6000 6000 4000 4000 0000 0000 >getsymb
-54< 00000000 00000000 00040000 001C0000 00300000 00E00000 01800000
-03000000 06000000 0C000000 08000000 18F00000 33F80000 360E0000
-6C070000 78010000 60018000 60018000 C000C000 C000C000 C000C000
-C0008000 C0018000 60010000 30030000 18060000 1C0C0000 0F180000
-03F00000 00000000 00000000 >getsymb
-53< 00000000 00000000 01FF0000 03FF0000 03000000 03000000 06000000
-06000000 06000000 06000000 06000000 03C00000 00F80000 001C0000
-000E0000 00030000 00030000 00030000 000E0000 E01C0000 70300000
-3FE00000 0F800000 00000000 00000000 >getsymb
-52< 0000 0000 8018 8018 C018 C018 C018 C018 C018 FF18 3FF8 01F8 0030
-0030 0070 0060 0060 0060 00E0 00C0 00C0 0080 0080 0000 0000 >getsymb
-51< 00000000 00000000 01E00000 07F00000 0E180000 0C0C0000 000C0000
-000C0000 00180000 00300000 00600000 00C00000 00780000 001E0000
-00070000 00018000 0001C000 0000C000 8000C000 C0018000 C0070000
-7C0E0000 3FF80000 03F00000 00000000 00000000 >getsymb
-50< 00000000 00000000 07800000 1FC00000 38600000 70300000 C0300000
-80100000 00100000 00100000 00300000 00300000 00200000 00600000
-00C00000 01800000 01000000 03000000 06000000 06000000 0F004000
-1DC08000 307F8000 303E0000 00000000 00000000 >getsymb
-49< 0000 0000 3000 7800 9800 1800 1800 1800 1800 1800 1800 1800 1800
-3000 3000 3000 3000 3000 3000 3000 3000 3000 0000 0000 >getsymb
-48< 00000000 00000000 00E00000 03F80000 0E180000 180C0000 30060000
-30060000 60020000 E0030000 C0030000 C0030000 C0030000 C0030000
-C0030000 C0030000 C0020000 60060000 60060000 20040000 300C0000
-18180000 0C180000 07F00000 01E00000 00000000 00000000 >getsymb
-47< 00000000 00000000 00040000 00060000 000C0000 000C0000 00180000
-00180000 00180000 00300000 00300000 00200000 00600000 00600000
-00C00000 00C00000 01800000 01800000 03000000 03000000 06000000
-06000000 0C000000 0C000000 18000000 18000000 38000000 30000000
-60000000 60000000 60000000 C0000000 80000000 00000000 00000000
->getsymb
-46< 0000 0000 8000 C000 E000 C000 0000 0000 >getsymb
-45< 0000 0000 F000 7FF0 07F0 0000 0000 >getsymb
-44< 0000 0000 1000 1800 0C00 0C00 0C00 0C00 0800 1800 3000 6000 8000
-0000 0000 >getsymb
-43< 00000000 00000000 00100000 00100000 00300000 00300000 00300000
-00300000 00300000 0033E000 3FFFC000 FFFC0000 00300000 00300000
-00300000 00300000 00300000 00300000 00600000 00600000 00400000
-00400000 00000000 00000000 >getsymb
-42< 00000000 00000000 30180000 18300000 0C600000 04C00000 0FFE0000
-3FF80000 EC600000 86200000 06300000 03180000 03000000 01000000
-00000000 00000000 >getsymb
-41< 0000 0000 6000 F000 1C00 0E00 0300 0180 0080 00C0 00C0 00C0 00C0
-00C0 0060 0060 0060 0060 0060 0060 0060 00C0 00C0 00C0 00C0 00C0 0080
-0180 0380 0300 0600 0C00 1800 7000 0000 0000 >getsymb
-40< 0000 0000 0700 0E00 1800 3000 2000 6000 6000 6000 6000 6000 C000
-C000 C000 C000 C000 C000 C000 C000 6000 6000 6000 6000 3000 3000 1800
-1800 0C00 0600 0700 0380 0000 0000 >getsymb
-39< 0000 0000 2000 3000 1800 1800 0C00 0C00 0C00 1800 3000 3000 6000
-4000 8000 0000 0000 >getsymb
-38< 00000000 00000000 0F000000 1F800000 30C00000 20600000 20300000
-30300000 18200000 18400000 0CC00000 05800000 0F000000 1F000000
-19820000 30C20000 60660000 602C0000 C0380000 C0300000 C0300000
-C0780000 60680000 61CC0000 3F0C0000 1E040000 00060000 00000000
-00000000 >getsymb
-37< 00000000 00000000 0E03C000 3FDF8000 61F30000 60C70000 C0C60000
-C0CC0000 618C0000 630C0000 3E180000 0C300000 00300000 00600000
-00600000 00C00000 01C00000 03800000 0307C000 060FE000 0C3C2000
-18F03000 31E03000 37603000 6CC03000 78C06000 E0F0C000 C07FC000
-000F0000 00000000 00000000 >getsymb
-36< 00000000 00000000 01040000 03040000 030C0000 030C0000 030C0000
-037C0000 03DE0000 0F0F0000 0E0D8000 1A0C8000 360C0000 260C0000
-260C0000 1E0C0000 1FCC0000 07FC0000 043C0000 040E0000 8C0F8000
-CC0FC000 7C0C4000 1C0C6000 0E0CE000 0FFFC000 0CFE0000 0C180000
-0C180000 0C180000 0C180000 0C180000 0C100000 08100000 08100000
-08100000 00100000 00000000 00000000 >getsymb
-35< 00000000 00000000 00430000 00430000 00C30000 00C30000 00C30000
-00C30000 00C3F000 00FFF000 1FFF0000 3F870000 018C0000 018C0000
-018C0000 018C0000 030C0000 030FC000 7FFFC000 FFF80000 06180000
-06180000 06180000 0C180000 0C180000 0C100000 00000000 00000000
->getsymb
-34< 0000 0000 8300 6180 30C0 10C0 10C0 10C0 3180 6300 C000 8000 0000
-0000 >getsymb
-33< 0000 0000 4000 6000 6000 6000 6000 6000 6000 6000 6000 6000 6000
-6000 6000 6000 6000 6000 E000 C000 C000 C000 C000 C000 C000 8000 0000
-0000 0000 C000 C000 4000 0000 0000 >getsymb
-Hwfdict begin
-  /BuildChar
-  Chread
-end
-/Joepie Hwfdict definefont
-%%EndFont Joepie\n\n"))
-
-;;Sets page numbering off
-(defun handwrite-set-pagenumber-off ()
-  (setq handwrite-pagenumbering nil)
-  (define-key menu-bar-handwrite-map
-    [numbering]
-    '("Page numbering Off" . handwrite-set-pagenumber))
-  (message "page numbering off"))
-
-;;Sets page numbering on
-(defun handwrite-set-pagenumber-on ()
-  (setq handwrite-pagenumbering t)
-  (define-key menu-bar-handwrite-map
-    [numbering]
-    '("Page numbering On" . handwrite-set-pagenumber))
-  (message "page numbering on" ))
-
-
-;; Key bindings
-
-
-(define-key-after
-  (lookup-key global-map [menu-bar edit])
-  [handwrite]
-  '("Write by hand" . menu-bar-handwrite-map)
-  'spell)
-
-(define-key menu-bar-handwrite-map [numbering]
-  '("Page numbering Off" . handwrite-set-pagenumber))
-
-(define-key menu-bar-handwrite-map [10pt]
-  '("10 pt" . handwrite-10pt))
-
-(define-key menu-bar-handwrite-map [11pt]
-  '("11 pt *" . handwrite-11pt))
-
-(define-key menu-bar-handwrite-map [12pt]
-  '("12 pt" . handwrite-12pt))
-
-(define-key menu-bar-handwrite-map [13pt]
-  '("13 pt" . handwrite-13pt))
-
-(define-key menu-bar-handwrite-map [handwrite]
-  '("Write by hand" . handwrite))
-
-(define-key-after
-  (lookup-key menu-bar-handwrite-map [ ])
-  [handwrite-separator1]
-  '("----" . nil)
-  'handwrite)
-
-(define-key-after
-  (lookup-key menu-bar-handwrite-map [ ])
-  [handwrite-separator2]
-  '("----" . nil)
-  '10pt)
-
-
-(provide 'handwrite)
-
-
-;;; handwrite.el ends here
diff --git a/lisp/play/hanoi.el b/lisp/play/hanoi.el
deleted file mode 100644
index ba74a2ba645..00000000000
--- a/lisp/play/hanoi.el
+++ /dev/null
@@ -1,227 +0,0 @@
-;;; hanoi.el --- towers of hanoi in GNUmacs
-
-;; Author: Damon Anton Permezel
-;; Maintainer: FSF
-;; Keywords: games
-
-; Author (a) 1985, Damon Anton Permezel
-; This is in the public domain
-; since he distributed it without copyright notice in 1985.
-
-;;; Commentary:
-
-;; Solves the Towers of Hanoi puzzle while-U-wait.
-;;
-;; The puzzle: Start with N rings, decreasing in sizes from bottom to
-;; top, stacked around a post.  There are two other posts.  Your mission,
-;; should you choose to accept it, is to shift the pile, stacked in its
-;; original order, to another post.
-;;
-;; The challenge is to do it in the fewest possible moves.  Each move
-;; shifts one ring to a different post.  But there's a rule; you can
-;; only stack a ring on top of a larger one.
-;;
-;; The simplest nontrivial version of this puzzle is N = 3.  Solution
-;; time rises as 2**N, and programs to solve it have long been considered
-;; classic introductory exercises in the use of recursion.
-;;
-;; The puzzle is called `Towers of Hanoi' because an early popular
-;; presentation wove a fanciful legend around it.  According to this
-;; myth (uttered long before the Vietnam War), there is a Buddhist
-;; monastery at Hanoi which contains a large room with three time-worn
-;; posts in it surrounded by 21 golden discs.  Monks, acting out the
-;; command of an ancient prophecy, have been moving these disks, in
-;; accordance with the rules of the puzzle, once every day since the
-;; monastery was founded over a thousand years ago.  They are said
-;; believe that when the last move of the puzzle is completed, the
-;; world will end in a clap of thunder.  Fortunately, they are nowhere
-;; even close to being done...
-
-;;; Code:
-
-;;;
-;;; hanoi-topos - direct cursor addressing
-;;;
-(defun hanoi-topos (row col)
-  (goto-line row)
-  (beginning-of-line)
-  (forward-char col))
-
-;;;
-;;; hanoi - user callable Towers of Hanoi
-;;;
-;;;###autoload
-(defun hanoi (nrings)
-  "Towers of Hanoi diversion.  Argument is number of rings."
-  (interactive "p")
-  (if (<= nrings 1) (setq nrings 7))
-  (let* (floor-row
-	 fly-row
-	 (window-height (1- (window-height (selected-window))))
-	 (window-width (window-width (selected-window)))
-
-	 ;; This is half the spacing to use between poles.
-	 (pole-spacing (/ window-width 6)))
-    (if (not (and (> window-height (1+ nrings))
-		  (> pole-spacing nrings)))
-	(progn
-	  (delete-other-windows)
-	  (if (not (and (> (setq window-height
-				 (1- (window-height (selected-window))))
-			   (1+ nrings))
-			(> (setq pole-spacing (/ window-width 6))
-			   nrings)))
-	      (error "Window is too small (need at least %dx%d)"
-		     (* 6 (1+ nrings)) (+ 2 nrings)))))
-    (setq floor-row (if (> (- window-height 3) (1+ nrings))
-			(- window-height 3) window-height))
-    (let ((fly-row (- floor-row nrings 1))
-	  ;; pole: column . fill height
-	  (pole-1 (cons (1- pole-spacing) floor-row))
-	  (pole-2 (cons (1- (* 3 pole-spacing)) floor-row))
-	  (pole-3 (cons (1- (* 5 pole-spacing)) floor-row))
-	  (rings (make-vector nrings nil)))
-      ;; construct the ring list
-      (let ((i 0))
-	(while (< i nrings)
-	  ;; ring: [pole-number string empty-string]
-	  (aset rings i (vector nil
-				(make-string (+ i i 3) (+ ?0 (% i 10)))
-				(make-string (+ i i 3) ?\  )))
-	  (setq i (1+ i))))
-      ;;
-      ;; init the screen
-      ;;
-      (switch-to-buffer "*Hanoi*")
-      (setq buffer-read-only nil)
-      (buffer-disable-undo (current-buffer))
-      (erase-buffer)
-      (let ((i 0))
-	(while (< i floor-row)
-	  (setq i (1+ i))
-	  (insert-char ?\  (1- window-width))
-	  (insert ?\n)))
-      (insert-char ?= (1- window-width))
-
-      (let ((n 1))
-	(while (< n 6)
-	  (hanoi-topos fly-row (1- (* n pole-spacing)))
-	  (setq n (+ n 2))
-	  (let ((i fly-row))
-	    (while (< i floor-row)
-	      (setq i (1+ i))
-	      (next-line 1)
-	      (insert ?\|)
-	      (delete-char 1)
-	      (backward-char 1)))))
-      ;(sit-for 0)
-      ;;
-      ;; now draw the rings in their initial positions
-      ;;
-      (let ((i 0)
-	    ring)
-	(while (< i nrings)
-	  (setq ring (aref rings (- nrings 1 i)))
-	  (aset ring 0 (- floor-row i))
-	  (hanoi-topos (cdr pole-1)
-		       (- (car pole-1) (- nrings i)))
-	  (hanoi-draw-ring ring t nil)
-	  (setcdr pole-1 (1- (cdr pole-1)))
-	  (setq i (1+ i))))
-      (setq buffer-read-only t)
-      (sit-for 0)
-      ;; Disable display of line and column numbers, for speed.
-      (let ((line-number-mode nil)
-	    (column-number-mode nil))
-	;; do it!
-	(hanoi0 (1- nrings) pole-1 pole-2 pole-3))
-      (goto-char (point-min))
-      (message "Done")
-      (setq buffer-read-only t)
-      (force-mode-line-update)
-      (sit-for 0))))
-
-;;;
-;;; hanoi0 - work horse of hanoi
-;;;
-(defun hanoi0 (n from to work)
-  (cond ((input-pending-p)
-	 (signal 'quit (list "I can tell you've had enough")))
-	((< n 0))
-	(t
-	 (hanoi0 (1- n) from work to)
-	 (hanoi-move-ring n from to)
-	 (hanoi0 (1- n) work to from))))
-
-;;;
-;;; hanoi-move-ring - move ring 'n' from 'from' to 'to'
-;;;
-;;;
-(defun hanoi-move-ring (n from to)
-  (let ((ring (aref rings n))		; ring <- ring: (ring# . row)
-	(buffer-read-only nil))
-    (let ((row (aref ring 0))		; row <- row ring is on
-	  (col (- (car from) n 1))	; col <- left edge of ring
-	  (dst-col (- (car to) n 1))	; dst-col <- dest col for left edge
-	  (dst-row (cdr to)))		; dst-row <- dest row for ring
-      (hanoi-topos row col)
-      (while (> row fly-row)		; move up to the fly row
-	(hanoi-draw-ring ring nil t)	; blank out ring
-	(previous-line 1)		; move up a line
-	(hanoi-draw-ring ring t nil)	; redraw
-	(sit-for 0)
-	(setq row (1- row)))
-      (setcdr from (1+ (cdr from)))	; adjust top row
-      ;;
-      ;; fly the ring over to the right pole
-      ;;
-      (while (not (equal dst-col col))
-	(cond ((> dst-col col)		; dst-col > col: right shift
-	       (end-of-line 1)
-	       (delete-backward-char 2)
-	       (beginning-of-line 1)
-	       (insert ?\  ?\  )
-	       (sit-for 0)
-	       (setq col (1+ (1+ col))))
-	      ((< dst-col col)		; dst-col < col: left shift
-	       (beginning-of-line 1)
-	       (delete-char 2)
-	       (end-of-line 1)
-	       (insert ?\  ?\  )
-	       (sit-for 0)
-	       (setq col (1- (1- col))))))
-      ;;
-      ;; let the ring float down
-      ;;
-      (hanoi-topos fly-row dst-col)
-      (while (< row dst-row)		; move down to the dest row
-	(hanoi-draw-ring ring nil (> row fly-row)) ; blank out ring
-	(next-line 1)			; move down a line
-	(hanoi-draw-ring ring t nil)	; redraw ring
-	(sit-for 0)
-	(setq row (1+ row)))
-      (aset ring 0 dst-row)
-      (setcdr to (1- (cdr to))))))	; adjust top row
-
-;;;
-;;; draw-ring -	draw the ring at point, leave point unchanged
-;;;
-;;; Input:
-;;;	ring
-;;;	f1	-	flag: t -> draw, nil -> erase
-;;;	f2	-	flag: t -> erasing and need to draw ?\|
-;;;
-(defun hanoi-draw-ring (ring f1 f2)
-  (save-excursion
-    (let* ((string (if f1 (aref ring 1) (aref ring 2)))
-	   (len (length string)))
-      (delete-char len)
-      (insert string)
-      (if f2
-	  (progn
-	    (backward-char (/ (+ len 1) 2))
-	    (delete-char 1) (insert ?\|))))))
-
-(provide 'hanoi)
-
-;;; hanoi.el ends here
diff --git a/lisp/play/life.el b/lisp/play/life.el
deleted file mode 100644
index 9645cb398df..00000000000
--- a/lisp/play/life.el
+++ /dev/null
@@ -1,283 +0,0 @@
-;;; life.el --- John Horton Conway's `Life' game for GNU Emacs
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Kyle Jones <talos!kjones@uunet.uu.net>
-;; Keywords: games
-
-;; 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:
-
-;; A demonstrator for John Horton Conway's "Life" cellular automaton
-;; in Emacs Lisp.  Picks a random one of a set of interesting Life
-;; patterns and evolves it according to the familiar rules.
-
-;;; Code:
-
-(defconst life-patterns
-  [("@@@" " @@" "@@@")
-   ("@@@ @@@" "@@  @@ " "@@@ @@@")
-   ("@@@ @@@" "@@   @@" "@@@ @@@")
-   ("@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@")
-   ("@@@@@@@@@@")
-   ("   @@@@@@@@@@       "
-    "     @@@@@@@@@@     "
-    "       @@@@@@@@@@   "
-    "@@@@@@@@@@          "
-    "@@@@@@@@@@          ")
-   ("@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@" "@")
-   ("@               @" "@               @"  "@               @"
-    "@               @" "@               @"  "@               @"
-    "@               @" "@               @"  "@               @"
-    "@               @" "@               @"  "@               @"
-    "@               @" "@               @"  "@               @")
-   ("@@               " " @@              " "  @@             "
-    "   @@            " "    @@           " "     @@          "
-    "      @@         " "       @@        " "        @@       "
-    "         @@      " "          @@     " "           @@    "
-    "            @@   " "             @@  " "              @@ "
-    "               @@")
-   ("@@@@@@@@@" "@   @   @" "@ @@@@@ @" "@ @   @ @" "@@@   @@@" 
-    "@ @   @ @" "@ @@@@@ @" "@   @   @" "@@@@@@@@@")]
-  "Vector of rectangles containing some Life startup patterns.")
-
-;; Macros are used macros for manifest constants instead of variables
-;; because the compiler will convert them to constants, which should
-;; eval faster than symbols.
-;;
-;; Don't change any of the life-* macro constants unless you thoroughly
-;; understand the `life-grim-reaper' function.
-
-(defmacro life-life-char () ?@)
-(defmacro life-death-char () (1+ (life-life-char)))
-(defmacro life-birth-char () 3)
-(defmacro life-void-char () ?\ )
-
-(defmacro life-life-string () (char-to-string (life-life-char)))
-(defmacro life-death-string () (char-to-string (life-death-char)))
-(defmacro life-birth-string () (char-to-string (life-birth-char)))
-(defmacro life-void-string () (char-to-string (life-void-char)))
-(defmacro life-not-void-regexp () (concat "[^" (life-void-string) "\n]"))
-
-(defmacro life-increment (variable) (list 'setq variable (list '1+ variable)))
-
-
-;; list of numbers that tell how many characters to move to get to
-;; each of a cell's eight neighbors.
-(defconst life-neighbor-deltas nil)
-
-;; window display always starts here.  Easier to deal with than
-;; (scroll-up) and (scroll-down) when trying to center the display.
-(defconst life-window-start nil)
-
-;; For mode line
-(defconst life-current-generation nil)
-;; Sadly, mode-line-format won't display numbers.
-(defconst life-generation-string nil)
-
-(defvar life-initialized nil
-  "Non-nil if `life' has been run at least once.")
-
-;;;###autoload
-(defun life (&optional sleeptime)
-  "Run Conway's Life simulation.
-The starting pattern is randomly selected.  Prefix arg (optional first
-arg non-nil from a program) is the number of seconds to sleep between
-generations (this defaults to 1)."
-  (interactive "p")
-  (or life-initialized
-      (random t))
-  (setq life-initialized t)
-  (or sleeptime (setq sleeptime 1))
-  (life-setup)
-  (life-display-generation sleeptime)
-  (catch 'life-exit
-    (while t
-      (let ((inhibit-quit t))
-	(life-grim-reaper)
-	(life-expand-plane-if-needed)
-	(life-increment-generation)
-	(life-display-generation sleeptime)))))
-
-(defalias 'life-mode 'life)
-(put 'life-mode 'mode-class 'special)
-
-(defun life-setup ()
-  (let (n)
-    (switch-to-buffer (get-buffer-create "*Life*") t)
-    (erase-buffer)
-    (kill-all-local-variables)
-    (setq case-fold-search nil
-	  mode-name "Life"
-	  major-mode 'life-mode
-	  truncate-lines t
-	  life-current-generation 0
-	  life-generation-string "0"
-	  mode-line-buffer-identification '("Life: generation "
-					    life-generation-string)
-	  fill-column (1- (window-width))
-	  life-window-start 1)
-    (buffer-disable-undo (current-buffer))
-    ;; stuff in the random pattern
-    (life-insert-random-pattern)
-    ;; make sure (life-life-char) is used throughout
-    (goto-char (point-min))
-    (while (re-search-forward (life-not-void-regexp) nil t)
-      (replace-match (life-life-string) t t))
-    ;; center the pattern horizontally
-    (goto-char (point-min))
-    (setq n (/ (- fill-column (save-excursion (end-of-line) (point))) 2))
-    (while (not (eobp))
-      (indent-to n)
-      (forward-line))
-    ;; center the pattern vertically
-    (setq n (/ (- (1- (window-height))
-		  (count-lines (point-min) (point-max)))
-	       2))
-    (goto-char (point-min))
-    (newline n)
-    (goto-char (point-max))
-    (newline n)
-    ;; pad lines out to fill-column
-    (goto-char (point-min))
-    (while (not (eobp))
-      (end-of-line)
-      (indent-to fill-column)
-      (move-to-column fill-column)
-      (delete-region (point) (progn (end-of-line) (point)))
-      (forward-line))
-    ;; expand tabs to spaces
-    (untabify (point-min) (point-max))
-    ;; before starting be sure the automaton has room to grow
-    (life-expand-plane-if-needed)
-    ;; compute initial neighbor deltas
-    (life-compute-neighbor-deltas)))
-
-(defun life-compute-neighbor-deltas ()
-  (setq life-neighbor-deltas
-	(list -1 (- fill-column)
-	      (- (1+ fill-column)) (- (+ 2 fill-column))
-	      1 fill-column (1+ fill-column)
-	      (+ 2 fill-column))))
-
-(defun life-insert-random-pattern ()
-  (insert-rectangle
-   (elt life-patterns (random (length life-patterns))))
-  (insert ?\n))
-
-(defun life-increment-generation ()
-  (life-increment life-current-generation)
-  (setq life-generation-string (int-to-string life-current-generation)))
-
-(defun life-grim-reaper ()
-  ;; Clear the match information.  Later we check to see if it
-  ;; is still clear, if so then all the cells have died.
-  (store-match-data nil)
-  (goto-char (point-min))
-  ;; For speed declare all local variable outside the loop.
-  (let (point char pivot living-neighbors list)
-    (while (search-forward (life-life-string) nil t)
-      (setq list life-neighbor-deltas
-	    living-neighbors 0
-	    pivot (1- (point)))
-      (while list
-	(setq point (+ pivot (car list))
-	      char (char-after point))
-	(cond ((eq char (life-void-char))
-	       (subst-char-in-region point (1+ point)
-				     (life-void-char) 1 t))
-	      ((< char 3)
-	       (subst-char-in-region point (1+ point) char (1+ char) t))
-	      ((< char 9)
-	       (subst-char-in-region point (1+ point) char 9 t))
-	      ((>= char (life-life-char))
-	       (life-increment living-neighbors)))
-	(setq list (cdr list)))
-      (if (memq living-neighbors '(2 3))
-	  ()
-	(subst-char-in-region pivot (1+ pivot)
-			    (life-life-char) (life-death-char) t))))
-  (if (null (match-beginning 0))
-      (life-extinct-quit))
-  (subst-char-in-region 1 (point-max) 9 (life-void-char) t)
-  (subst-char-in-region 1 (point-max) 1 (life-void-char) t)
-  (subst-char-in-region 1 (point-max) 2 (life-void-char) t)
-  (subst-char-in-region 1 (point-max) (life-birth-char) (life-life-char) t)
-  (subst-char-in-region 1 (point-max) (life-death-char) (life-void-char) t))
-
-(defun life-expand-plane-if-needed ()
-  (catch 'done
-    (goto-char (point-min))
-    (while (not (eobp))
-      ;; check for life at beginning or end of line.  If found at
-      ;; either end, expand at both ends,
-      (cond ((or (eq (following-char) (life-life-char))
-		 (eq (progn (end-of-line) (preceding-char)) (life-life-char)))
-	     (goto-char (point-min))
-	     (while (not (eobp))
-	       (insert (life-void-char))
-	       (end-of-line)
-	       (insert (life-void-char))
-	       (forward-char))
-	   (setq fill-column (+ 2 fill-column))
-	   (scroll-left 1)
-	   (life-compute-neighbor-deltas)
-	   (throw 'done t)))
-      (forward-line)))
-  (goto-char (point-min))
-  ;; check for life within the first two lines of the buffer.
-  ;; If present insert two lifeless lines at the beginning..
-  (cond ((search-forward (life-life-string)
-			 (+ (point) fill-column fill-column 2) t)
-	 (goto-char (point-min))
-	 (insert-char (life-void-char) fill-column)
-	 (insert ?\n)
-	 (insert-char (life-void-char) fill-column)
-	 (insert ?\n)
-	 (setq life-window-start (+ life-window-start fill-column 1))))
-  (goto-char (point-max))
-  ;; check for life within the last two lines of the buffer.
-  ;; If present insert two lifeless lines at the end.
-  (cond ((search-backward (life-life-string)
-			  (- (point) fill-column fill-column 2) t)
-	 (goto-char (point-max))
-	 (insert-char (life-void-char) fill-column)
-	 (insert ?\n)
-	 (insert-char (life-void-char) fill-column)
-	 (insert ?\n)
-	 (setq life-window-start (+ life-window-start fill-column 1)))))
-
-(defun life-display-generation (sleeptime)
-  (goto-char life-window-start)
-  (recenter 0)
-  
-  ;; Redisplay; if the user has hit a key, exit the loop.
-  (or (eq t (sit-for sleeptime))
-      (throw 'life-exit nil)))
-
-(defun life-extinct-quit ()
-  (life-display-generation 0)
-  (signal 'life-extinct nil))
-
-(put 'life-extinct 'error-conditions '(life-extinct quit))
-(put 'life-extinct 'error-message "All life has perished")
-
-(provide 'life)
-
-;;; life.el ends here
diff --git a/lisp/play/meese.el b/lisp/play/meese.el
deleted file mode 100644
index 8a3ad922b8a..00000000000
--- a/lisp/play/meese.el
+++ /dev/null
@@ -1,27 +0,0 @@
-;;; meese.el --- protect the impressionable young minds of America
-
-;; This is in the public domain on account of being distributed since
-;; 1985 or 1986 without a copyright notice.
-
-;; Maintainer: FSF
-;; Keywords: games
-
-;;; Code:
-
-(defun protect-innocence-hook ()
-  (let ((dir (file-name-directory buffer-file-name)))
-    (if (and (equal buffer-file-name (expand-file-name "sex.6" dir))
-	     (file-exists-p buffer-file-name)
-	     (not (y-or-n-p "Are you over 18? ")))
-	(progn
-	  (clear-visited-file-modtime)
-	  (setq buffer-file-name (expand-file-name "celibacy.1" dir))
-	  (let ((inhibit-read-only t))	; otherwise (erase-buffer) may bomb.
-	    (erase-buffer)
-	    (insert-file-contents buffer-file-name t))
-	  (rename-buffer (file-name-nondirectory buffer-file-name))))))
-
-(add-hook 'find-file-hooks 'protect-innocence-hook)
-(provide 'meese)
-
-;;; meese.el ends here
diff --git a/lisp/play/morse.el b/lisp/play/morse.el
deleted file mode 100644
index 5ab461641e5..00000000000
--- a/lisp/play/morse.el
+++ /dev/null
@@ -1,121 +0,0 @@
-;;; morse.el --- Convert text to morse code and back.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: Rick Farnbach <rick_farnbach@MENTORG.COM>
-
-;; 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.
-
-;;; Code:
-
-(defvar morse-code '(("a" . ".-")
-		     ("b" . "-...")
-		     ("c" . "-.-.")
-		     ("d" . "-..")
-		     ("e" . ".")
-		     ("f" . "..-.")
-		     ("g" . "--.")
-		     ("h" . "....")
-		     ("i" . "..")
-		     ("j" . ".---")
-		     ("k" . "-.-")
-		     ("l" . ".-..")
-		     ("m" . "--")
-		     ("n" . "-.")
-		     ("o" . "---")
-		     ("p" . ".--.")
-		     ("q" . "--.-")
-		     ("r" . ".-.")
-		     ("s" . "...")
-		     ("t" . "-")
-		     ("u" . "..-")
-		     ("v" . "...-")
-		     ("w" . ".--")
-		     ("x" . "-..-")
-		     ("y" . "-.--")
-		     ("z" . "--..")
-		     ;; Punctuation
-		     ("=" . "-...-")
-		     ("?" . "..--..")
-		     ("/" . "-..-.")
-		     ("," . "--..--")
-		     ("." . ".-.-.-")
-		     (":" . "---...")
-		     ("'" . ".----.")
-		     ("-" . "-....-")
-		     ("(" . "-.--.-")
-		     (")" . "-.--.-")
-		     ;; Numbers
-		     ("0" . "-----")
-		     ("1" . ".----")
-		     ("2" . "..---")
-		     ("3" . "...--")
-		     ("4" . "....-")
-		     ("5" . ".....")
-		     ("6" . "-....")
-		     ("7" . "--...")
-		     ("8" . "---..")
-		     ("9" . "----."))
-  "Morse code character set.")
-
-(defun morse-region (beg end)
-  "Convert all text in a given region to morse code."
-  (interactive "r")
-  (if (integerp end)
-      (setq end (copy-marker end)))
-  (save-excursion
-    (let ((sep "")
-	  str morse)
-      (goto-char beg)
-      (while (< (point) end)
-	(setq str (downcase (buffer-substring (point) (1+ (point)))))
-	(cond ((looking-at "\\s-+")
-	       (goto-char (match-end 0))
-	       (setq sep ""))
-	      ((setq morse (assoc str morse-code))
-	       (delete-char 1)
-	       (insert sep (cdr morse))
-	       (setq sep "/"))
-	      (t
-	       (forward-char 1)
-	       (setq sep "")))))))
-
-(defun unmorse-region (beg end)
-  "Convert morse coded text in region to ordinary ASCII text."
-  (interactive "r")
-  (if (integerp end)
-      (setq end (copy-marker end)))
-  (save-excursion
-    (let (str paren morse)
-      (goto-char beg)
-      (while (< (point) end)
-	(if (null (looking-at "[-.]+"))
-	    (forward-char 1)
-	  (setq str (buffer-substring (match-beginning 0) (match-end 0)))
-	  (if (null (setq morse (rassoc str morse-code)))
-	      (goto-char (match-end 0))
-	    (replace-match
-		  (if (string-equal "(" (car morse))
-		      (if (setq paren (null paren)) "(" ")")
-		    (car morse)) t)
-	    (if (looking-at "/")
-		(delete-char 1))))))))
-
-(provide 'morse)
-
-;;; morse.el ends here
diff --git a/lisp/play/mpuz.el b/lisp/play/mpuz.el
deleted file mode 100644
index a99182d1689..00000000000
--- a/lisp/play/mpuz.el
+++ /dev/null
@@ -1,443 +0,0 @@
-;;; mpuz.el --- multiplication puzzle for GNU Emacs
-
-;; Copyright (C) 1990 Free Software Foundation, Inc.
-
-;; Author: Philippe Schnoebelen <phs@lifia.imag.fr>
-;; Keywords: games
-
-;; 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:
-
-;; When this package is loaded, `M-x mpuz' generates a random multiplication
-;; puzzle.  This is a multiplication example in which each digit has been
-;; consistently replaced with some letter.  Your job is to reconstruct
-;; the original digits.  Type `?' while the mode is active for detailed help.
-
-;;; Code:
-
-(random t)				; randomize
-
-(defvar mpuz-silent nil
-  "*Set this to T if you don't want dings on inputs.")
-
-(defun mpuz-ding ()
-  "Dings, unless global variable `mpuz-silent' forbids it."
-  (or mpuz-silent (ding t)))
-
-
-;; Mpuz mode and keymaps
-;;----------------------
-(defvar mpuz-mode-hook nil)
-
-(defvar mpuz-mode-map nil
-  "Local keymap to use in Mult Puzzle.")
-
-(if mpuz-mode-map nil
-    (setq mpuz-mode-map (make-sparse-keymap))
-    (define-key mpuz-mode-map "a" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "b" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "c" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "d" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "e" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "f" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "g" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "h" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "i" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "j" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "A" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "B" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "C" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "D" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "E" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "F" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "G" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "H" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "I" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "J" 'mpuz-try-letter)
-    (define-key mpuz-mode-map "\C-g" 'mpuz-offer-abort)
-    (define-key mpuz-mode-map "?" 'describe-mode))
-
-(defun mpuz-mode ()
-  "Multiplication puzzle mode.
-
-You have to guess which letters stand for which digits in the
-multiplication displayed inside the `*Mult Puzzle*' buffer.
-
-You may enter a guess for a letter's value by typing first the letter,
-then the digit.  Thus, to guess that A=3, type A 3.
-
-To leave the game to do other editing work, just switch buffers.
-Then you may resume the game with M-x mpuz.
-You may abort a game by typing \\<mpuz-mode-map>\\[mpuz-offer-abort]."
-  (interactive)
-  (setq major-mode 'mpuz-mode
-	mode-name  "Mult Puzzle")
-  (use-local-map mpuz-mode-map)
-  (run-hooks 'mpuz-mode-hook))
-
-
-;; Some variables for statistics
-;;------------------------------
-(defvar mpuz-nb-errors 0
-  "Number of errors made in current game.")
-
-(defvar mpuz-nb-completed-games 0
-  "Number of games completed.")
-
-(defvar mpuz-nb-cumulated-errors 0
-  "Number of errors made in previous games.")
-
-
-;; Some variables for game tracking
-;;---------------------------------
-(defvar mpuz-in-progress nil
-  "True if a game is currently in progress.")
-
-(defvar mpuz-found-digits (make-vector 10 nil)
-  "A vector recording which digits have been decrypted.")
-
-(defmacro mpuz-digit-solved-p (digit)
-  (list 'aref 'mpuz-found-digits digit))
-
-
-;; A puzzle uses a permutation of [0..9] into itself.
-;; We use both the permutation and its inverse.
-;;---------------------------------------------------
-(defvar mpuz-digit-to-letter (make-vector 10 0)
-  "A permutation from [0..9] to [0..9].")
-
-(defvar mpuz-letter-to-digit (make-vector 10 0)
-  "The inverse of mpuz-digit-to-letter.")
-
-(defmacro mpuz-to-digit (letter)
-  (list 'aref 'mpuz-letter-to-digit letter))
-
-(defmacro mpuz-to-letter (digit)
-  (list 'aref 'mpuz-digit-to-letter digit))
-
-(defun mpuz-build-random-perm ()
-  "Initialize puzzle coding with a random permutation."
-  (let ((letters (list 0 1 2 3 4 5 6 7 8 9)) ; new cons cells, because of delq
-	(index 10)
-	elem)
-    (while letters
-      (setq elem    (nth (random index) letters)
-	    letters (delq elem letters)
-	    index   (1- index))
-      (aset mpuz-digit-to-letter index elem)
-      (aset mpuz-letter-to-digit elem index))))
-
-
-;; A puzzle also uses a board displaying a multiplication.
-;; Every digit appears in the board, crypted or not.
-;;------------------------------------------------------
-(defvar mpuz-board (make-vector 10 nil)
-  "The board associates to any digit the list of squares where it appears.")
-
-(defun mpuz-put-digit-on-board (number square)
-  "Put (last digit of) NUMBER on SQUARE of the puzzle board."
-  ;; i.e. push SQUARE on NUMBER square-list
-  (setq number (% number 10))
-  (aset mpuz-board number (cons square (aref mpuz-board number))))
-
-(defun mpuz-check-all-solved ()
-  "Check whether all digits have been solved. Return t if yes."
-  (catch 'found
-    (let ((digit -1))
-      (while (> 10 (setq digit (1+ digit)))
-	(if (and (not (mpuz-digit-solved-p digit)) ; unsolved
-		 (aref mpuz-board digit)) ; and appearing in the puzzle !
-	    (throw 'found nil))))
-    t))
-
-
-;; To build a puzzle, we take two random numbers and multiply them.
-;; We also take a random permutation for encryption.
-;; The random numbers are only use to see which digit appears in which square
-;; of the board. Everything is stored in individual squares.
-;;---------------------------------------------------------------------------
-(defun mpuz-random-puzzle ()
-  "Draw random values to be multiplied in a puzzle."
-  (mpuz-build-random-perm)
-  (fillarray mpuz-board nil)		; erase the board
-  (let (A B C D E)
-    ;; A,B,C,D & E, are the five rows of our multiplication.
-    ;; Choose random values, discarding uninteresting cases.
-    (while (progn
-	     (setq A (random 1000)
-		   B (random 100)
-		   C (* A (% B 10))
-		   D (* A (/ B 10))
-		   E (* A B))
-	     (or (< C 1000) (< D 1000)))) ; forbid leading zeros in C or D
-    ;; Individual digits are now put on their respective squares.
-    ;; [NB: A square is a pair <row,column> of the screen.]
-    (mpuz-put-digit-on-board A		 '(2 . 9))
-    (mpuz-put-digit-on-board (/ A 10)	 '(2 . 7))
-    (mpuz-put-digit-on-board (/ A 100)	 '(2 . 5))
-    (mpuz-put-digit-on-board B		 '(4 . 9))
-    (mpuz-put-digit-on-board (/ B 10)	 '(4 . 7))
-    (mpuz-put-digit-on-board C		 '(6 . 9))
-    (mpuz-put-digit-on-board (/ C 10)	 '(6 . 7))
-    (mpuz-put-digit-on-board (/ C 100)	 '(6 . 5))
-    (mpuz-put-digit-on-board (/ C 1000)	 '(6 . 3))
-    (mpuz-put-digit-on-board D		 '(8 . 7))
-    (mpuz-put-digit-on-board (/ D 10)	 '(8 . 5))
-    (mpuz-put-digit-on-board (/ D 100)	 '(8 . 3))
-    (mpuz-put-digit-on-board (/ D 1000)	 '(8 . 1))
-    (mpuz-put-digit-on-board E		 '(10 . 9))
-    (mpuz-put-digit-on-board (/ E 10)	 '(10 . 7))
-    (mpuz-put-digit-on-board (/ E 100)	 '(10 . 5))
-    (mpuz-put-digit-on-board (/ E 1000)	 '(10 . 3))
-    (mpuz-put-digit-on-board (/ E 10000) '(10 . 1))))
-
-;; Display
-;;--------
-(defconst mpuz-framework
-  "
-     . . .
-                   Number of errors (this game): 0
-    x  . .
-   -------
-   . . . .
-                        Number of completed games: 0
- . . . .
- ---------              Average number of errors: 0.00
- . . . . ."
-  "The general picture of the puzzle screen, as a string.")
-
-(defun mpuz-create-buffer ()
-  "Create (or recreate) the puzzle buffer. Return it."
-  (let ((buff (get-buffer-create "*Mult Puzzle*")))
-    (save-excursion
-      (set-buffer buff)
-      (let ((buffer-read-only nil))
-	(erase-buffer)
-	(insert mpuz-framework)
-	(mpuz-paint-board)
-	(mpuz-paint-errors)
-	(mpuz-paint-statistics)))
-    buff))
-
-(defun mpuz-paint-errors ()
-  "Paint error count on the puzzle screen."
-  (mpuz-switch-to-window)
-  (let ((buffer-read-only nil))
-    (goto-line 3)
-    (move-to-column 49)
-    (mpuz-delete-line)
-    (insert (prin1-to-string mpuz-nb-errors))))
-
-(defun mpuz-paint-statistics ()
-  "Paint statistics about previous games on the puzzle screen."
-  (let* ((mean (if (zerop mpuz-nb-completed-games) 0
-		   (/ (+ mpuz-nb-completed-games (* 200 mpuz-nb-cumulated-errors))
-		      (* 2 mpuz-nb-completed-games))))
-	 (frac-part (% mean 100)))
-    (let ((buffer-read-only nil))
-      (goto-line 7)
-      (move-to-column 51)
-      (mpuz-delete-line)
-      (insert (prin1-to-string mpuz-nb-completed-games))
-      (goto-line 9)
-      (move-to-column 50)
-      (mpuz-delete-line)
-      (insert (format "%d.%d%d" (/ mean 100) (/ frac-part 10) (% frac-part 10))))))
-
-(defun mpuz-paint-board ()
-  "Paint board situation on the puzzle screen."
-  (mpuz-switch-to-window)
-  (let ((letter -1))
-    (while (> 10 (setq letter (1+ letter)))
-      (mpuz-paint-digit (mpuz-to-digit letter))))
-  (goto-char (point-min)))
-
-(defun mpuz-paint-digit (digit)
-  "Paint all occurrences of DIGIT on the puzzle board."
-  ;; (mpuz-switch-to-window)
-  (let ((char (if (mpuz-digit-solved-p digit)
-		  (+ digit ?0)
-		  (+ (mpuz-to-letter digit) ?A)))
-	(square-l (aref mpuz-board digit)))
-    (let ((buffer-read-only nil))
-      (while square-l
-	(goto-line (car (car square-l)))	; line before column !
-	(move-to-column (cdr (car square-l)))
-	(insert char)
-	(delete-char 1)
-	(backward-char 1)
-	(setq square-l (cdr square-l))))))
-
-(defun mpuz-delete-line ()
-  "Clear from point to next newline."	; & put nothing in the kill ring
-  (while (not (= ?\n (char-after (point))))
-    (delete-char 1)))
-
-(defun mpuz-get-buffer ()
-  "Get the puzzle buffer if it exists."
-  (get-buffer "*Mult Puzzle*"))
-
-(defun mpuz-switch-to-window ()
-  "Find or create the Mult-Puzzle buffer, and display it."
-  (let ((buff (mpuz-get-buffer)))
-    (or buff (setq buff (mpuz-create-buffer)))
-    (switch-to-buffer buff)
-    (or buffer-read-only (toggle-read-only))
-    (mpuz-mode)))
-
-
-;; Game control
-;;-------------
-(defun mpuz-abort-game ()
-  "Abort any puzzle in progress."
-  (message "Mult Puzzle aborted.")
-  (setq mpuz-in-progress nil
-	mpuz-nb-errors 0)
-  (fillarray mpuz-board nil)
-  (let ((buff (mpuz-get-buffer)))
-    (if buff (kill-buffer buff))))
-
-(defun mpuz-start-new-game ()
-  "Start a new puzzle."
-  (message "Here we go...")
-  (setq mpuz-nb-errors 0
-	mpuz-in-progress t)
-  (fillarray mpuz-found-digits nil)	; initialize mpuz-found-digits
-  (mpuz-random-puzzle)
-  (mpuz-switch-to-window)
-  (mpuz-paint-board)
-  (mpuz-paint-errors)
-  (mpuz-ask-for-try))
-
-(defun mpuz-offer-new-game ()
-  "Ask if user wants to start a new puzzle."
-  (if (y-or-n-p "Start a new game ")
-      (mpuz-start-new-game)
-      (message "OK. I won't.")))
-
-;;;###autoload
-(defun mpuz ()
-  "Multiplication puzzle with GNU Emacs."
-  ;; Main entry point
-  (interactive)
-  (mpuz-switch-to-window)
-  (if mpuz-in-progress
-      (mpuz-offer-abort)
-      (mpuz-start-new-game)))
-
-(defun mpuz-offer-abort ()
-  "Ask if user wants to abort current puzzle."
-  (interactive)
-  (if (y-or-n-p "Abort game ")
-      (mpuz-abort-game)
-      (mpuz-ask-for-try)))
-
-(defun mpuz-ask-for-try ()
-  "Ask for user proposal in puzzle."
-  (message "Your try ?"))
-
-(defun mpuz-try-letter ()
-  "Propose a digit for a letter in puzzle."
-  (interactive)
-  (if mpuz-in-progress
-      (let (letter-char digit digit-char message)
-	(setq letter-char (upcase last-command-char)
-	      digit (mpuz-to-digit (- letter-char ?A)))
-	(cond ((mpuz-digit-solved-p digit)
-	       (message "%c already solved." letter-char))
-	      ((null (aref mpuz-board digit))
-	       (message "%c does not appear." letter-char))
-	      ((progn (message "%c = " letter-char)
-		      ;; <char> has been entered.
-		      ;; Print "<char> =" and
-		      ;; read <num> or = <num>
-		      (setq digit-char (read-char))
-		      (if (eq digit-char ?=)
-			  (setq digit-char (read-char)))
-		      (message "%c = %c" letter-char digit-char)
-		      (or (> digit-char ?9) (< digit-char ?0))) ; bad input
-	       (ding t))
-	      (t
-	       (mpuz-try-proposal letter-char digit-char))))
-      (mpuz-offer-new-game)))
-
-(defun mpuz-try-proposal (letter-char digit-char)
-  "Propose LETTER-CHAR as code for DIGIT-CHAR."
-  (let* ((letter (- letter-char ?A))
-	 (digit (- digit-char ?0))
-	 (correct-digit (mpuz-to-digit letter)))
-    (cond ((mpuz-digit-solved-p correct-digit)
-	   (message "%c has already been found."))
-	  ((= digit correct-digit)
-	   (message "%c = %c correct !" letter-char digit-char)
-	   (mpuz-ding)
-	   (mpuz-correct-guess digit))
-	  (t ;;; incorrect guess
-	   (message "%c = %c incorrect !" letter-char digit-char)
-	   (mpuz-ding)
-	   (setq mpuz-nb-errors (1+ mpuz-nb-errors))
-	   (mpuz-paint-errors)))))
-
-(defun mpuz-correct-guess (digit)
-  "Handle correct guessing of DIGIT."
-  (aset mpuz-found-digits digit t)	; Mark digit as solved
-  (mpuz-paint-digit digit)		; Repaint it (now as a digit)
-  (if (mpuz-check-all-solved)
-      (mpuz-close-game)))
-
-(defun mpuz-close-game ()
-  "Housecleaning when puzzle has been solved."
-  (setq mpuz-in-progress nil
-	mpuz-nb-cumulated-errors (+ mpuz-nb-cumulated-errors mpuz-nb-errors)
-	mpuz-nb-completed-games (1+ mpuz-nb-completed-games))
-  (mpuz-paint-statistics)
-  (let ((message (mpuz-congratulate)))
-    (message message)
-    (sit-for 4)
-    (if (y-or-n-p (concat message "  Start a new game "))
-	(mpuz-start-new-game)
-	(message "Good Bye !"))))
-
-(defun mpuz-congratulate ()
-  "Build a congratulation message when puzzle is solved."
-  (format "Puzzle solved with %d errors. %s"
-	   mpuz-nb-errors
-	   (cond ((= mpuz-nb-errors 0)	      "That's perfect !")
-		 ((= mpuz-nb-errors 1)	      "That's very good !")
-		 ((= mpuz-nb-errors 2)	      "That's good.")
-		 ((= mpuz-nb-errors 3)	      "That's not bad.")
-		 ((= mpuz-nb-errors 4)	      "That's not too bad...")
-		 ((and (>= mpuz-nb-errors 5)
-		       (< mpuz-nb-errors 10)) "That's bad !")
-		 ((and (>= mpuz-nb-errors 10)
-		       (< mpuz-nb-errors 15)) "That's awful.")
-		 ((>= mpuz-nb-errors 15)      "That's not serious."))))
-
-(defun mpuz-show-solution ()
-  "Display solution for debugging purposes."
-  (interactive)
-  (mpuz-switch-to-window)
-  (let (digit list)
-    (setq digit -1)
-    (while (> 10 (setq digit (1+ digit)))
-      (or (mpuz-digit-solved-p digit)
-	  (setq list (cons digit list))))
-    (mapcar 'mpuz-correct-guess list)))
-
-;;; mpuz.el ends here
diff --git a/lisp/play/solitaire.el b/lisp/play/solitaire.el
deleted file mode 100644
index 4ce8b7d3ff0..00000000000
--- a/lisp/play/solitaire.el
+++ /dev/null
@@ -1,455 +0,0 @@
-;;; solitaire.el --- game of solitaire in Emacs Lisp
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: Jan Schormann <Jan.Schormann@informatik.uni-oldenburg.de>
-;; Created: Fri afternoon, Jun  3,  1994
-;; Keywords: games
-
-;; 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 mode is for playing a well-known game of solitaire
-;; in which you jump pegs across other pegs.
-
-;; The game itself is somehow self-explanatory.  Read the help text to
-;; solitaire, and try it.
-
-;;; Code:
-
-(defvar solitaire-mode-map nil
-  "Keymap for playing solitaire.")
-
-(if solitaire-mode-map
-    ()
-  (setq solitaire-mode-map (make-sparse-keymap))
-  (suppress-keymap solitaire-mode-map t)
-  (define-key solitaire-mode-map "\C-f" 'solitaire-right)
-  (define-key solitaire-mode-map "\C-b" 'solitaire-left)
-  (define-key solitaire-mode-map "\C-p" 'solitaire-up)
-  (define-key solitaire-mode-map "\C-n" 'solitaire-down)
-  (define-key solitaire-mode-map [return] 'solitaire-move)
-  (substitute-key-definition 'undo 'solitaire-undo
-			     solitaire-mode-map global-map)
-  (define-key solitaire-mode-map " " 'solitaire-do-check)
-  (define-key solitaire-mode-map "q" 'solitaire-quit)
-
-  (define-key solitaire-mode-map [right] 'solitaire-right)
-  (define-key solitaire-mode-map [left] 'solitaire-left)
-  (define-key solitaire-mode-map [up] 'solitaire-up)
-  (define-key solitaire-mode-map [down] 'solitaire-down)
-
-  (define-key solitaire-mode-map [S-right] 'solitaire-move-right)
-  (define-key solitaire-mode-map [S-left]  'solitaire-move-left)
-  (define-key solitaire-mode-map [S-up]    'solitaire-move-up)
-  (define-key solitaire-mode-map [S-down]  'solitaire-move-down)
-
-  (define-key solitaire-mode-map [kp-6] 'solitaire-right)
-  (define-key solitaire-mode-map [kp-4] 'solitaire-left)
-  (define-key solitaire-mode-map [kp-8] 'solitaire-up)
-  (define-key solitaire-mode-map [kp-2] 'solitaire-down)
-  (define-key solitaire-mode-map [kp-5] 'solitaire-center-point)
-
-  (define-key solitaire-mode-map [S-kp-6] 'solitaire-move-right)
-  (define-key solitaire-mode-map [S-kp-4] 'solitaire-move-left) 
-  (define-key solitaire-mode-map [S-kp-8] 'solitaire-move-up)   
-  (define-key solitaire-mode-map [S-kp-2] 'solitaire-move-down) 
-
-  (define-key solitaire-mode-map [kp-enter] 'solitaire-move)
-  (define-key solitaire-mode-map [kp-0] 'solitaire-undo)
-
-  ;; spoil it with s ;)
-  (define-key solitaire-mode-map [?s] 'solitaire-solve)
-
-  ;;  (define-key solitaire-mode-map [kp-0] 'solitaire-hint) - Not yet provided ;)
-  )
-
-;; Solitaire mode is suitable only for specially formatted data.
-(put 'solitaire-mode 'mode-class 'special)
-
-(defun solitaire-mode ()
-  "Major mode for playing solitaire.
-To learn how to play solitaire, see the documentation for function
-`solitaire'.
-\\<solitaire-mode-map>
-The usual mnemonic keys move the cursor around the board; in addition,
-\\[solitaire-move] is a prefix character for actually moving a stone on the board."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map solitaire-mode-map)
-  (setq truncate-lines t)
-  (setq major-mode 'solitaire-mode)
-  (setq mode-name "Solitaire")
-  (run-hooks 'solitaire-mode-hook))
-
-(defvar solitaire-stones 0
-  "Counter for the stones that are still there.")
-
-(defvar solitaire-center nil
-  "Center of the board.")
-
-(defvar solitaire-start nil
-  "Upper left corner of the board.")
-
-(defvar solitaire-start-x nil)
-(defvar solitaire-start-y nil)
-
-(defvar solitaire-end nil
-  "Lower right corner of the board.")
-
-(defvar solitaire-end-x nil)
-(defvar solitaire-end-y nil)
-
-(defvar solitaire-auto-eval t
-  "*Non-nil means check for possible moves after each major change.
-This takes a while, so switch this on if you like to be informed when
-the game is over, or off, if you are working on a slow machine.")
-
-(defconst solitaire-valid-directions
-  '(solitaire-left solitaire-right solitaire-up solitaire-down))
-
-;;;###autoload
-(defun solitaire (arg)
-  "Play Solitaire.
-
-To play Solitaire, type \\[solitaire].
-\\<solitaire-mode-map>
-Move around the board using the cursor keys.
-Move stones using \\[solitaire-move] followed by a direction key.
-Undo moves using \\[solitaire-undo].
-Check for possible moves using \\[solitaire-do-check].
-\(The variable solitaire-auto-eval controls whether to automatically
-check after each move or undo)
-
-What is Solitaire?
-
-I don't know who invented this game, but it seems to be rather old and
-its origin seems be northern Africa.  Here's how to play:
-Initially, the board will look similar to this:
-
-	Le Solitaire             
-	============             
-	
-		o   o   o        
-	
-		o   o   o        
-	
-	o   o   o   o   o   o   o
-	
-	o   o   o   .   o   o   o
-	
-	o   o   o   o   o   o   o
-	
-		o   o   o        
-	
-		o   o   o        
-
-Let's call the o's stones and the .'s holes.  One stone fits into one
-hole.  As you can see, all holes but one are occupied by stones.  The
-aim of the game is to get rid of all but one stone, leaving that last
-one in the middle of the board if you're cool.
-
-A stone can be moved if there is another stone next to it, and a hole
-after that one.  Thus there must be three fields in a row, either
-horizontally or vertically, up, down, left or right, which look like
-this:  o  o  .
-
-Then the first stone is moved to the hole, jumping over the second,
-which therefore is taken away.  The above thus `evaluates' to:  .  .  o
-
-That's all.  Here's the board after two moves:
-
-		o   o   o        
-	
-		.   o   o        
-	
-	o   o   .   o   o   o   o
-	
-	o   .   o   o   o   o   o
-	
-	o   o   o   o   o   o   o
-	
-		o   o   o        
-	
-		o   o   o
-
-Pick your favourite shortcuts:
-
-\\{solitaire-mode-map}"
-
-  (interactive "P")
-  (switch-to-buffer "*Solitaire*")
-  (solitaire-mode)
-  (setq buffer-read-only t)
-  (setq solitaire-stones 32)
-  (solitaire-insert-board)
-  (solitaire-build-modeline)
-  (goto-char (point-max))
-  (setq solitaire-center (search-backward "."))
-  (setq buffer-undo-list (list (point)))
-  (set-buffer-modified-p nil))
-
-(defun solitaire-build-modeline ()
-  (setq mode-line-format
-	(list "" "---" 'mode-line-buffer-identification
-	      (if (< 1 solitaire-stones)
-		  (format "--> There are %d stones left <--" solitaire-stones)
-		"------")
-	      'global-mode-string "   %[(" 'mode-name 'minor-mode-alist "%n"
-	      ")%]-%-"))
-  (force-mode-line-update))
-
-(defun solitaire-insert-board ()
-  (let* ((buffer-read-only nil)
-	 (w (window-width))
-	 (h (window-height))
-	 (hsep (cond ((> w 26) "   ")
-		     ((> w 20) " ")
-		     (t "")))
-	 (vsep (cond ((> h 17) "\n\n")
-		     (t "\n")))
-	 (indent (make-string (/ (- w 7 (* 6 (length hsep))) 2) ?\ )))
-    (erase-buffer)
-    (insert (make-string (/ (- h 7 (if (> h 12) 3 0)
-			       (* 6 (1- (length vsep)))) 2) ?\n))
-    (if (or (string= vsep "\n\n") (> h 12))
-	(progn
-	  (insert (format "%sLe Solitaire\n" indent))
-	  (insert (format "%s============\n\n" indent))))
-    (insert indent)
-    (setq solitaire-start (point))
-    (setq solitaire-start-x (current-column))
-    (setq solitaire-start-y (solitaire-current-line))
-    (insert (format " %s %so%so%so%s" hsep hsep hsep hsep vsep))
-    (insert (format "%s %s %so%so%so%s" indent hsep hsep hsep hsep vsep))
-    (insert (format "%so%so%so%so%so%so%so%s" indent hsep hsep hsep hsep hsep hsep vsep))
-    (insert (format "%so%so%so%s" indent hsep hsep hsep))
-    (setq solitaire-center (point))
-    (insert (format ".%so%so%so%s" hsep hsep hsep vsep))
-    (insert (format "%so%so%so%so%so%so%so%s" indent hsep hsep hsep hsep hsep hsep vsep))
-    (insert (format "%s %s %so%so%so%s" indent hsep hsep hsep hsep vsep))
-    (insert (format "%s %s %so%so%so%s %s " indent hsep hsep hsep hsep hsep hsep))
-    (setq solitaire-end (point))
-    (setq solitaire-end-x (current-column))
-    (setq solitaire-end-y (solitaire-current-line))
-    ))
-
-(defun solitaire-right ()
-  (interactive)
-  (let ((start (point)))
-    (forward-char)
-    (while (= ?\  (following-char))
-      (forward-char))
-    (if (or  (= 0 (following-char))
-	     (= ?\  (following-char))
-	    (= ?\n (following-char)))
-	(goto-char start))))
-
-(defun solitaire-left ()
-  (interactive)
-  (let ((start (point)))
-    (backward-char)
-    (while (= ?\  (following-char))
-      (backward-char))
-    (if (or  (= 0 (preceding-char))
-	     (= ?\  (following-char))
-	    (= ?\n (following-char)))
-	(goto-char start))))
-
-(defun solitaire-up ()
-  (interactive)
-  (let ((start (point))
-	(c (current-column)))
-    (forward-line -1)
-    (move-to-column c)
-    (while (and (= ?\n (following-char))
-		(forward-line -1)
-		(move-to-column c)
-		(not (bolp))))
-    (if (or (= 0 (preceding-char))
-	    (= ?\  (following-char))
-	    (= ?\= (following-char))
-	    (= ?\n (following-char)))
-	(goto-char start)
-	)))
-
-(defun solitaire-down ()
-  (interactive)
-  (let ((start (point))
-	(c (current-column)))
-    (forward-line 1)
-    (move-to-column c)
-    (while (and (= ?\n (following-char))
-		(forward-line 1)
-		(move-to-column c)
-		(not (eolp))))
-    (if (or (= 0 (following-char))
-	    (= ?\  (following-char))
-	    (= ?\n (following-char)))	
-	(goto-char start))))
-
-(defun solitaire-center-point ()
-  (interactive)
-  (goto-char solitaire-center))
-
-(defun solitaire-move-right () (interactive) (solitaire-move '[right]))
-(defun solitaire-move-left () (interactive) (solitaire-move '[left]))
-(defun solitaire-move-up () (interactive) (solitaire-move '[up]))
-(defun solitaire-move-down () (interactive) (solitaire-move '[down]))
-
-(defun solitaire-possible-move (movesymbol)
-  "Check if a move is possible from current point in the specified direction.
-MOVESYMBOL specifies the direction.
-Returns either a string, indicating cause of contraindication, or a
-list containing three numbers: starting field, skipped field (from
-which a stone will be taken away) and target."
-
-  (save-excursion
-    (let (move)
-      (fset 'move movesymbol)
-      (if (memq movesymbol solitaire-valid-directions)
-	  (let ((start (point))
-		(skip (progn (move) (point)))
-		(target (progn (move) (point))))
-	    (if (= skip target)
-		"Off Board!"
-	      (if (or (/= ?o (char-after start))
-		      (/= ?o (char-after skip))
-		      (/= ?. (char-after target)))
-		  "Wrong move!"
-		(list start skip target))))
-	"Not a valid direction"))))
-
-(defun solitaire-move (dir)
-  "Pseudo-prefix command to move a stone in Solitaire."
-  (interactive "kMove where? ")
-  (let* ((class (solitaire-possible-move (lookup-key solitaire-mode-map dir)))
-	 (buffer-read-only nil))
-    (if (stringp class)
-	(error class)
-      (let ((start (car class))
-	    (skip (car (cdr class)))
-	    (target (car (cdr (cdr class)))))	
-	(goto-char start)
-	(delete-char 1)
-	(insert ?.)
-	(goto-char skip)
-	(delete-char 1)
-	(insert ?.)
-	(goto-char target)
-	(delete-char 1)
-	(insert ?o)
-	(goto-char target)
-	(setq solitaire-stones (1- solitaire-stones))
-	(solitaire-build-modeline)
-	(if solitaire-auto-eval (solitaire-do-check))))))
-
-(defun solitaire-undo (arg)
-  "Undo a move in Solitaire."
-  (interactive "P")
-  (let ((buffer-read-only nil))
-    (undo arg))
-  (save-excursion
-    (setq solitaire-stones
-	  (let ((count 0))
-	    (goto-char solitaire-end)
-	    (while (search-backward "o" solitaire-start 'done)
-	      (and (>= (current-column) solitaire-start-x)
-		   (<= (current-column) solitaire-end-x)
-		   (>= (solitaire-current-line) solitaire-start-y)
-		   (<= (solitaire-current-line) solitaire-end-y)
-		   (setq count (1+ count))))
-	    count)))
-  (solitaire-build-modeline)  
-  (if solitaire-auto-eval (solitaire-do-check)))
-
-(defun solitaire-check ()
-  (save-excursion
-    (if (= 1 solitaire-stones)
-	0
-      (goto-char solitaire-end)
-      (let ((count 0))
-	(while (search-backward "o" solitaire-start 'done)
-	  (and (>= (current-column) solitaire-start-x)
-	       (<= (current-column) solitaire-end-x)
-	       (>= (solitaire-current-line) solitaire-start-y)
-	       (<= (solitaire-current-line) solitaire-end-y)
-	       (mapcar
-		(lambda (movesymbol)
-		  (if (listp (solitaire-possible-move movesymbol))
-		      (setq count (1+ count))))
-		solitaire-valid-directions)))
-	count))))
-
-(defun solitaire-do-check (&optional arg)
-  "Check for any possible moves in Solitaire."
-  (interactive "P")
-  (let ((moves (solitaire-check)))
-    (cond ((= 1 solitaire-stones)
-	   (message "Yeah! You made it! Only the King is left!"))
-	  ((zerop moves)
-	   (message "Sorry, no more possible moves."))
-	  ((= 1 moves)
-	   (message "There is one possible move."))
-	  (t (message "There are %d possible moves." moves)))))
-
-(defun solitaire-current-line ()
-  "Return the vertical position of point.
-Seen in info on text lines."
-  (+ (count-lines (point-min) (point))
-     (if (= (current-column) 0) 1 0)
-     -1))
-
-(defun solitaire-quit ()
-  "Quit playing Solitaire."
-  (interactive)
-  (kill-buffer "*Solitaire*"))
-
-;; And here's the spoiler:)
-(defun solitaire-solve ()
-  "Spoil solitaire by solving the game for you - nearly ...
-... stops with five stones left ;)"
-  (interactive)
-  (let ((allmoves [up up S-down up left left S-right up up left S-down
-		      up up right right S-left down down down S-up up
-		      S-down down down down S-up left left down
-		      S-right left left up up S-down right right right
-		      S-left left S-right right right right S-left
-		      right down down S-up down down left left S-right
-		      up up up S-down down S-up up up up S-down up
-		      right right S-left down right right down S-up
-		      left left left S-right right S-left down down
-		      left S-right S-up S-left S-left S-down S-right
-		      up S-right left left])
-	;; down down S-up left S-right
-	;; right S-left
-	(solitaire-auto-eval nil))
-    (solitaire-center-point)
-    (mapcar (lambda (op)
-	      (if (memq op '(S-left S-right S-up S-down))
-		  (sit-for 0.2))
-	      (execute-kbd-macro (vector op))
-	      (if (memq op '(S-left S-right S-up S-down))
-		  (sit-for 0.4)))
-	    allmoves))
-  (solitaire-do-check))
-
-(provide 'solitaire)
-
-;;; solitaire.el ends here
diff --git a/lisp/play/spook.el b/lisp/play/spook.el
deleted file mode 100644
index cf6685af51b..00000000000
--- a/lisp/play/spook.el
+++ /dev/null
@@ -1,69 +0,0 @@
-;;; spook.el --- spook phrase utility for overloading the NSA line eater
-
-;; Copyright (C) 1988, 1993 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: games
-;; Created: May 1987
-
-;; 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:
-
-;; Steve Strassmann <straz@media-lab.media.mit.edu> didn't write
-;; this, and even if he did, he really didn't mean for you to use it
-;; in an anarchistic way.
-;;
-;; To use this:
-;;  Just before sending mail, do M-x spook.
-;;  A number of phrases will be inserted into your buffer, to help
-;;  give your message that extra bit of attractiveness for automated
-;;  keyword scanners.  Help defeat the NSA trunk trawler!
-
-;;; Code:
-
-(require 'cookie1)
-
-; Variables
-(defvar spook-phrases-file (concat data-directory "spook.lines")
-   "Keep your favorite phrases here.")
-
-(defvar spook-phrase-default-count 15
-   "Default number of phrases to insert")
-
-;;;###autoload
-(defun spook ()
-  "Adds that special touch of class to your outgoing mail."
-  (interactive)
-  (cookie-insert spook-phrases-file
-		 spook-phrase-default-count
-		 "Checking authorization..."
-		 "Checking authorization...Approved"))
-
-;;;###autoload
-(defun snarf-spooks ()
-  "Return a vector containing the lines from `spook-phrases-file'."
-  (cookie-snarf spook-phrases-file
-		"Checking authorization..."
-		"Checking authorization...Approved"))
-
-;; Note: the implementation that used to take up most of this file has been
-;; cleaned up, generalized, gratuitously broken by esr, and now resides in
-;; cookie1.el.
-
-;;; spook.el ends here
diff --git a/lisp/play/studly.el b/lisp/play/studly.el
deleted file mode 100644
index b5aafcab09a..00000000000
--- a/lisp/play/studly.el
+++ /dev/null
@@ -1,63 +0,0 @@
-;;; studly.el --- StudlyCaps (tm)(r)(c)(xxx)
-
-;;; This is in the public domain, since it was distributed
-;;; by its author without a copyright notice in 1986.
-
-;; Keywords: games
-
-;;; Commentary:
-
-;; Functions to studlycapsify a region, word, or buffer.  Possibly the
-;; esoteric significance of studlycapsification escapes you; that is,
-;; you suffer from autostudlycapsifibogotification.  Too bad.
-
-;;; Code:
-
-(defun studlify-region (begin end)
-  "Studlify-case the region"
-  (interactive "*r")
-  (save-excursion
-    (goto-char begin)
-    (setq begin (point))
-    (while (and (<= (point) end)
-		(not (looking-at "\\W*\\'")))
-      (forward-word 1)
-      (backward-word 1)
-      (setq begin (max (point) begin))
-      (forward-word 1)
-      (let ((offset 0)
-	    (word-end (min (point) end))
-	    c)
-	(goto-char begin)
-	(while (< (point) word-end)
-	  (setq offset (+ offset (following-char)))
-	  (forward-char 1))
-	(setq offset (+ offset (following-char)))
-	(goto-char begin)
-	(while (< (point) word-end)
-	  (setq c (following-char))
-	  (if (and (= (% (+ c offset) 4) 2)
-		   (let ((ch (following-char)))
-		     (or (and (>= ch ?a) (<= ch ?z))
-			 (and (>= ch ?A) (<= ch ?Z)))))
-	      (progn
-		(delete-char 1)
-		(insert (logxor c ? ))))
-	  (forward-char 1))
-	(setq begin (point))))))
-
-(defun studlify-word (count)
-  "Studlify-case the current word, or COUNT words if given an argument"
-  (interactive "*p")
-  (let ((begin (point)) end rb re)
-    (forward-word count)
-    (setq end (point))
-    (setq rb (min begin end) re (max begin end))
-    (studlify-region rb re)))
-
-(defun studlify-buffer ()
-  "Studlify-case the current buffer"
-  (interactive "*")
-  (studlify-region (point-min) (point-max)))
-
-;;; studly.el ends here
diff --git a/lisp/play/yow.el b/lisp/play/yow.el
deleted file mode 100644
index 501758e94a4..00000000000
--- a/lisp/play/yow.el
+++ /dev/null
@@ -1,130 +0,0 @@
-;;; yow.el --- quote random zippyisms
-
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Author: Richard Mlynarik
-;; Keywords: games
-
-;; 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:
-
-;; Important pinheadery for GNU Emacs.
-;;
-;; See cookie1.el for implementation.  Note --- the `n' argument of yow
-;; from the 18.xx implementation is no longer; we only support *random*
-;; random access now.
-
-;;; Code:
-
-(require 'cookie1)
-
-(defvar yow-file (concat data-directory "yow.lines")
-   "File containing pertinent pinhead phrases.")
-
-(defconst yow-load-message "Am I CONSING yet?...")
-(defconst yow-after-load-message "I have SEEN the CONSING!!")
-
-;;;###autoload
-(defun yow (&optional insert)
-  "Return or display a random Zippy quotation.  With prefix arg, insert it."
-  (interactive "P")
-  (let ((yow (cookie yow-file yow-load-message yow-after-load-message)))
-    (cond (insert
-	   (insert yow))
-	  ((not (interactive-p))
-	   yow)
-	  ((not (string-match "\n" yow))
-	   (delete-windows-on (get-buffer-create "*Help*"))
-	   (message "%s" yow))
-	  (t
-	   (message "Yow!")
-	   (with-output-to-temp-buffer "*Help*"
-	     (princ yow)
-	     (save-excursion
-	       (set-buffer standard-output)
-	       (help-mode)))))))
-
-(defsubst read-zippyism (prompt &optional require-match)
-  "Read a Zippyism from the minibuffer with completion, prompting with PROMPT.
-If optional second arg is non-nil, require input to match a completion."
-  (read-cookie prompt yow-file yow-load-message yow-after-load-message
-	       require-match))
-
-;;;###autoload
-(defun insert-zippyism (&optional zippyism)
-  "Prompt with completion for a known Zippy quotation, and insert it at point."
-  (interactive (list (read-zippyism "Pinhead wisdom: " t)))
-  (insert zippyism))
-
-;;;###autoload
-(defun apropos-zippy (regexp)
-  "Return a list of all Zippy quotes matching REGEXP.
-If called interactively, display a list of matches."
-  (interactive "sApropos Zippy (regexp): ")
-  ;; Make sure yows are loaded
-  (cookie yow-file yow-load-message yow-after-load-message)
-  (let* ((case-fold-search t)
-         (cookie-table-symbol (intern yow-file cookie-cache))
-         (string-table (symbol-value cookie-table-symbol))
-         (matches nil)
-         (len (length string-table))
-         (i 0))
-    (save-match-data
-      (while (< i len)
-        (and (string-match regexp (aref string-table i))
-             (setq matches (cons (aref string-table i) matches)))
-        (setq i (1+ i))))
-    (and matches
-         (setq matches (sort matches 'string-lessp)))
-    (and (interactive-p)
-         (cond ((null matches)
-                (message "No matches found."))
-               (t
-                (let ((l matches))
-                  (with-output-to-temp-buffer "*Zippy Apropos*"
-                    (while l
-                      (princ (car l))
-                      (setq l (cdr l))
-                      (and l (princ "\n\n"))))))))
-    matches))
-
-
-;; Yowza!! Feed zippy quotes to the doctor. Watch results.
-;; fun, fun, fun. Entertainment for hours...
-;;
-;; written by Kayvan Aghaiepour
-
-;;;###autoload
-(defun psychoanalyze-pinhead ()
-  "Zippy goes to the analyst."
-  (interactive)
-  (doctor)				; start the psychotherapy
-  (message "")
-  (switch-to-buffer "*doctor*")
-  (sit-for 0)
-  (while (not (input-pending-p))
-    (insert-string (yow))
-    (sit-for 0)
-    (doctor-ret-or-read 1)
-    (doctor-ret-or-read 1)))
-
-(provide 'yow)
-
-;;; yow.el ends here
diff --git a/lisp/progmodes/ada-mode.el b/lisp/progmodes/ada-mode.el
deleted file mode 100644
index cf74a914ea2..00000000000
--- a/lisp/progmodes/ada-mode.el
+++ /dev/null
@@ -1,3741 +0,0 @@
-;;; ada-mode.el --- An Emacs major-mode for editing Ada source.
-;;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
-
-;;; Authors: Markus Heritsch <Markus.Heritsch@studbox.uni-stuttgart.de>
-;;;          Rolf Ebert      <ebert@inf.enst.fr>
-
-;;; 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.
-
-;;; This mode is a complete rewrite of a major mode for editing Ada 83
-;;; and Ada 95 source code under Emacs-19.  It contains completely new
-;;; indenting code and support for code browsing (see ada-xref).
-
-
-;;; USAGE
-;;; =====
-;;; Emacs should enter ada-mode when you load an ada source (*.ad[abs]).
-;;;
-;;; When you have entered ada-mode, you may get more info by pressing
-;;; C-h m. You may also get online help describing various functions by:
-;;; C-h d <Name of function you want described>
-
-
-;;; HISTORY
-;;; =======
-;;; The first Ada mode for GNU Emacs was written by V. Broman in
-;;; 1985. He based his work on the already existing Modula-2 mode.
-;;; This was distributed as ada.el in versions of Emacs prior to 19.29.
-;;;
-;;; Lynn Slater wrote an extensive Ada mode in 1989. It consisted of
-;;; several files with support for dired commands and other nice
-;;; things. It is currently available from the PAL
-;;; (wuarchive.wustl.edu:/languages/ada) as ada-mode-1.06a.tar.Z.
-;;;
-;;; The probably very first Ada mode (called electric-ada.el) was
-;;; written by Steven D. Litvintchouk and Steven M. Rosen for the
-;;; Gosling Emacs. L. Slater based his development on ada.el and
-;;; electric-ada.el.
-;;;
-;;; The current Ada mode is a complete rewrite by M. Heritsch and
-;;; R. Ebert.  Some ideas from the ada-mode mailing list have been
-;;; added.  Some of the functionality of L. Slater's mode has not
-;;; (yet) been recoded in this new mode.  Perhaps you prefer sticking
-;;; to his version.
-
-
-;;; KNOWN BUGS
-;;; ==========
-;;;
-;;; In the presence of comments and/or incorrect syntax
-;;; ada-format-paramlist produces weird results.
-;;; -------------------
-;;; Indenting of some tasking constructs is still buggy.
-;;; -------------------
-;;; package Test is
-;;;    -- If I hit return on the "type" line it will indent the next line
-;;;    -- in another 3 space instead of heading out to the "(". If I hit
-;;;    -- tab or return it reindents the line correctly but does not initially.
-;;;    type Wait_Return is (Read_Success, Read_Timeout, Wait_Timeout,
-;;;       Nothing_To_Wait_For_In_Wait_List);
-;;; -------------------
-
-
-
-;;; CREDITS
-;;; =======
-;;;
-;;; Many thanks to
-;;;    Philippe Waroquiers (PW) <philippe@cfmu.eurocontrol.be> in particular,
-;;;    woodruff@stc.llnl.gov (John Woodruff)
-;;;    jj@ddci.dk (Jesper Joergensen)
-;;;    gse@ocsystems.com (Scott Evans)
-;;;    comar@LANG8.CS.NYU.EDU (Cyrille Comar)
-;;;    and others for their valuable hints.
-
-;;;--------------------
-;;;    USER OPTIONS
-;;;--------------------
-
-;; ---- configure indentation
-
-(defvar ada-indent 3
-  "*Defines the size of Ada indentation.")
-
-(defvar ada-broken-indent 2
-  "*# of columns to indent the continuation of a broken line.")
-
-(defvar ada-label-indent -4
-  "*# of columns to indent a label.")
-
-(defvar ada-stmt-end-indent 0
-  "*# of columns to indent a statement end keyword in a separate line.
-Examples are 'is', 'loop', 'record', ...")
-
-(defvar ada-when-indent 3
-  "*Defines the indentation for 'when' relative to 'exception' or 'case'.")
-
-(defvar ada-indent-record-rel-type 3
-  "*Defines the indentation for 'record' relative to 'type' or 'use'.")
-
-(defvar ada-indent-comment-as-code t
-  "*If non-nil, comment-lines get indented as Ada code.")
-
-(defvar ada-indent-is-separate t
-  "*If non-nil, 'is separate' or 'is abstract' on a single line are indented.")
-
-(defvar ada-indent-to-open-paren t
-  "*If non-nil, indent according to the innermost open parenthesis.")
-
-(defvar ada-search-paren-char-count-limit 3000
-  "*Search that many characters for an open parenthesis.")
-
-
-;; ---- other user options
-
-(defvar ada-tab-policy 'indent-auto
-  "*Control behaviour of the TAB key.
-Must be one of `indent-rigidly', `indent-auto', `gei', `indent-af'
-or `always-tab'.
-
-`indent-rigidly' : always adds ada-indent blanks at the beginning of the line.
-`indent-auto'    : use indentation functions in this file.
-`gei'            : use David Kågedal's Generic Indentation Engine.
-`indent-af'      : use Gary E. Barnes' ada-format.el
-`always-tab'     : do indent-relative.")
-
-(defvar ada-move-to-declaration nil
-  "*If non-nil, `ada-move-to-start' moves point to the subprog declaration,
-not to 'begin'.")
-
-(defvar ada-spec-suffix ".ads"
-  "*Suffix of Ada specification files.")
-
-(defvar ada-body-suffix ".adb"
-  "*Suffix of Ada body files.")
-
-(defvar ada-language-version 'ada95
-  "*Do we program in `ada83' or `ada95'?")
-
-(defvar ada-case-keyword 'downcase-word
-  "*Function to call to adjust the case of Ada keywords.
-It may be `downcase-word', `upcase-word', `ada-loose-case-word' or 
-`capitalize-word'.")
-
-(defvar ada-case-identifier 'ada-loose-case-word
-  "*Function to call to adjust the case of an Ada identifier.
-It may be `downcase-word', `upcase-word', `ada-loose-case-word' or 
-`capitalize-word'.")
-
-(defvar ada-case-attribute 'capitalize-word
-  "*Function to call to adjust the case of Ada attributes.
-It may be `downcase-word', `upcase-word', `ada-loose-case-word' or 
-`capitalize-word'.")
-
-(defvar ada-auto-case t
-  "*Non-nil automatically changes case of preceding word while typing.
-Casing is done according to `ada-case-keyword', `ada-case-identifier'
-and `ada-cacse-attribute'.")
-
-(defvar ada-clean-buffer-before-saving  nil
-  "*If non-nil, `remove-trailing-spaces' and `untabify' buffer before saving.")
-
-(defvar ada-mode-hook nil
-  "*List of functions to call when Ada Mode is invoked.
-This is a good place to add Ada environment specific bindings.")
-
-(defvar ada-external-pretty-print-program "aimap"
-  "*External pretty printer to call from within Ada Mode.")
-
-(defvar ada-tmp-directory "/tmp/"
-  "*Directory to store the temporary file for the Ada pretty printer.")
-
-(defvar ada-fill-comment-prefix "-- "
-  "*This is inserted in the first columns when filling a comment paragraph.")
-
-(defvar ada-fill-comment-postfix " --"
-  "*This is inserted at the end of each line when filling a comment paragraph.
-with `ada-fill-comment-paragraph-postfix'.")
-
-(defvar ada-krunch-args "0"
-  "*Argument of gnatk8, a string containing the max number of characters.
-Set to 0, if you don't use crunched filenames.")
-
-;;; ---- end of user configurable variables
-
-
-(defvar ada-mode-abbrev-table nil
-  "Abbrev table used in Ada mode.")
-(define-abbrev-table 'ada-mode-abbrev-table ())
-
-(defvar ada-mode-map ()
-  "Local keymap used for Ada Mode.")
-
-(defvar ada-mode-syntax-table nil
-  "Syntax table to be used for editing Ada source code.")
-
-(defvar ada-mode-symbol-syntax-table nil
-  "Syntax table for Ada, where `_' is a word constituent.")
-
-(defconst ada-83-keywords
-  "\\<\\(abort\\|abs\\|accept\\|access\\|all\\|and\\|array\\|\
-at\\|begin\\|body\\|case\\|constant\\|declare\\|delay\\|delta\\|\
-digits\\|do\\|else\\|elsif\\|end\\|entry\\|exception\\|exit\\|for\\|\
-function\\|generic\\|goto\\|if\\|in\\|is\\|limited\\|loop\\|mod\\|\
-new\\|not\\|null\\|of\\|or\\|others\\|out\\|package\\|pragma\\|\
-private\\|procedure\\|raise\\|range\\|record\\|rem\\|renames\\|\
-return\\|reverse\\|select\\|separate\\|subtype\\|task\\|terminate\\|\
-then\\|type\\|use\\|when\\|while\\|with\\|xor\\)\\>"
-;  "\\<\\(a\\(b\\(ort\\|s\\)\\|cce\\(pt\\|ss\\)\\|ll\\|nd\\|rray\\|t\\)\\|\
-;b\\(egin\\|ody\\)\\|c\\(ase\\|onstant\\)\\|\
-;d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|\
-;e\\(ls\\(e\\|if\\)\\|n\\(d\\|try\\)\\|x\\(ception\\|it\\)\\)\\|\
-;f\\(or\\|unction\\)\\|g\\(eneric\\|oto\\)\\|i[fns]\\|l\\(imited\\|oop\\)\\|\
-;mod\\|n\\(ew\\|ot\\|ull\\)\\|o\\([fr]\\|thers\\|ut\\)\\|\
-;p\\(ackage\\|r\\(agma\\|ivate\\|ocedure\\)\\)\\|\
-;r\\(a\\(ise\\|nge\\)\\|e\\(cord\\|m\\|names\\|turn\\|verse\\)\\)\\|\
-;s\\(e\\(lect\\|parate\\)\\|ubtype\\)\\|use\\|
-;t\\(ask\\|erminate\\|hen\\|ype\\)\\|w\\(h\\(en\\|ile\\)\\|ith\\)\\|xor\\)\\>"
-  "regular expression for looking at Ada83 keywords.")
-
-(defconst ada-95-keywords
-  "\\<\\(abort\\|abs\\|abstract\\|accept\\|access\\|aliased\\|\
-all\\|and\\|array\\|at\\|begin\\|body\\|case\\|constant\\|declare\\|\
-delay\\|delta\\|digits\\|do\\|else\\|elsif\\|end\\|entry\\|\
-exception\\|exit\\|for\\|function\\|generic\\|goto\\|if\\|in\\|\
-is\\|limited\\|loop\\|mod\\|new\\|not\\|null\\|of\\|or\\|others\\|\
-out\\|package\\|pragma\\|private\\|procedure\\|protected\\|raise\\|\
-range\\|record\\|rem\\|renames\\|requeue\\|return\\|reverse\\|\
-select\\|separate\\|subtype\\|tagged\\|task\\|terminate\\|then\\|\
-type\\|until\\|use\\|when\\|while\\|with\\|xor\\)\\>"
-  "regular expression for looking at Ada95 keywords.")
-
-(defvar ada-keywords ada-95-keywords
-  "Regular expression for looking at Ada keywords.")
-
-(defvar ada-ret-binding nil
-  "Variable to save key binding of RET when casing is activated.")
-
-(defvar ada-lfd-binding nil
-  "Variable to save key binding of LFD when casing is activated.")
-
-;;; ---- Regexps to find procedures/functions/packages
-
-(defconst ada-ident-re 
-  "[a-zA-Z0-9_\\.]+"
-  "Regexp matching Ada (qualified) identifiers.")
-
-(defvar ada-procedure-start-regexp
-  "^[ \t]*\\(procedure\\|function\\|task\\)[ \t\n]+\\([a-zA-Z0-9_\\.]+\\)"
-  "Regexp used to find Ada procedures/functions.")
-
-(defvar ada-package-start-regexp
-  "^[ \t]*\\(package\\)"
-  "Regexp used to find Ada packages")
-
-
-;;; ---- regexps for indentation functions
-
-(defvar ada-block-start-re
-  "\\<\\(begin\\|select\\|declare\\|private\\|or\\|generic\\|\
-exception\\|loop\\|else\\|\
-\\(\\(limited\\|abstract\\|tagged\\)[ \t]+\\)*record\\)\\>"
-  "Regexp for keywords starting Ada blocks.")
-
-(defvar ada-end-stmt-re
-  "\\(;\\|=>\\|^[ \t]*separate[ \t]+([a-zA-Z0-9_\\.]+)\\|\
-\\<\\(begin\\|else\\|record\\|loop\\|select\\|do\\|\
-declare\\|generic\\|private\\)\\>\\|\
-^[ \t]*\\(package\\|procedure\\|function\\)[ \ta-zA-Z0-9_\\.]+is\\|\
-^[ \t]*exception\\>\\)"
-  "Regexp of possible ends for a non-broken statement.
-A new statement starts after these.")
-
-(defvar ada-loop-start-re
-  "\\<\\(for\\|while\\|loop\\)\\>"
-  "Regexp for the start of a loop.")
-
-(defvar ada-subprog-start-re
-  "\\<\\(procedure\\|protected\\|package\\|function\\|\
-task\\|accept\\|entry\\)\\>"
-  "Regexp for the start of a subprogram.")
-
-
-;; Written by Christian Egli <Christian.Egli@hcsd.hac.com>
-;;
-(defvar ada-imenu-generic-expression
-      '((nil "^\\s-*\\(procedure\\|function\\)\\s-+\\([A-Za-z0-9_]+\\)" 2)
-	("Type Defs" "^\\s-*\\(sub\\)?type\\s-+\\([A-Za-z0-9_]+\\)" 2))
-
-  "Imenu generic expression for Ada mode.  See `imenu-generic-expression'.")
-
-;;;-------------
-;;;  functions
-;;;-------------
-
-(defun ada-xemacs ()
-  (or (string-match "Lucid"  emacs-version)
-      (string-match "XEmacs" emacs-version)))
-
-(defun ada-create-syntax-table ()
-  "Create the syntax table for Ada Mode."
-  ;; There are two different syntax-tables.  The standard one declares
-  ;; `_' as a symbol constituent, in the second one, it is a word
-  ;; constituent.  For some search and replacing routines we
-  ;; temporarily switch between the two.
-  (setq ada-mode-syntax-table (make-syntax-table))
-  (set-syntax-table  ada-mode-syntax-table)
-
-  ;; define string brackets (% is alternative string bracket)
-  (modify-syntax-entry ?%  "\"" ada-mode-syntax-table)
-  (modify-syntax-entry ?\" "\"" ada-mode-syntax-table)
-
-  (modify-syntax-entry ?\#  "$" ada-mode-syntax-table)
-
-  (modify-syntax-entry ?:  "." ada-mode-syntax-table)
-  (modify-syntax-entry ?\; "." ada-mode-syntax-table)
-  (modify-syntax-entry ?&  "." ada-mode-syntax-table)
-  (modify-syntax-entry ?\|  "." ada-mode-syntax-table)
-  (modify-syntax-entry ?+  "." ada-mode-syntax-table)
-  (modify-syntax-entry ?*  "." ada-mode-syntax-table)
-  (modify-syntax-entry ?/  "." ada-mode-syntax-table)
-  (modify-syntax-entry ?=  "." ada-mode-syntax-table)
-  (modify-syntax-entry ?<  "." ada-mode-syntax-table)
-  (modify-syntax-entry ?>  "." ada-mode-syntax-table)
-  (modify-syntax-entry ?$ "." ada-mode-syntax-table)
-  (modify-syntax-entry ?\[ "." ada-mode-syntax-table)
-  (modify-syntax-entry ?\] "." ada-mode-syntax-table)
-  (modify-syntax-entry ?\{ "." ada-mode-syntax-table)
-  (modify-syntax-entry ?\} "." ada-mode-syntax-table)
-  (modify-syntax-entry ?. "." ada-mode-syntax-table)
-  (modify-syntax-entry ?\\ "." ada-mode-syntax-table)
-  (modify-syntax-entry ?\' "." ada-mode-syntax-table)
-
-  ;; a single hyphen is punctuation, but a double hyphen starts a comment
-  (modify-syntax-entry ?-  ". 12" ada-mode-syntax-table)
-
-  ;; and \f and \n end a comment
-  (modify-syntax-entry ?\f  ">   " ada-mode-syntax-table)
-  (modify-syntax-entry ?\n  ">   " ada-mode-syntax-table)
-
-  ;; define what belongs in ada symbols
-  (modify-syntax-entry ?_ "_" ada-mode-syntax-table)
-
-  ;; define parentheses to match
-  (modify-syntax-entry ?\( "()" ada-mode-syntax-table)
-  (modify-syntax-entry ?\) ")(" ada-mode-syntax-table)
-
-  (setq ada-mode-symbol-syntax-table (copy-syntax-table ada-mode-syntax-table))
-  (modify-syntax-entry ?_ "w" ada-mode-symbol-syntax-table)
-  )
-
-
-;;;###autoload
-(defun ada-mode ()
-  "Ada Mode is the major mode for editing Ada code.
-
-Bindings are as follows: (Note: 'LFD' is control-j.)
-
- Indent line                                          '\\[ada-tab]'
- Indent line, insert newline and indent the new line. '\\[newline-and-indent]'
-
- Re-format the parameter-list point is in             '\\[ada-format-paramlist]'
- Indent all lines in region                           '\\[ada-indent-region]'
- Call external pretty printer program                 '\\[ada-call-pretty-printer]'
-
- Adjust case of identifiers and keywords in region    '\\[ada-adjust-case-region]'
- Adjust case of identifiers and keywords in buffer    '\\[ada-adjust-case-buffer]'
-
- Call EXTERNAL pretty printer (if you have one)       '\\[ada-call-pretty-printer]'
-
- Fill comment paragraph                               '\\[ada-fill-comment-paragraph]'
- Fill comment paragraph and justify each line         '\\[ada-fill-comment-paragraph-justify]'
- Fill comment paragraph, justify and append postfix   '\\[ada-fill-comment-paragraph-postfix]'
-
- Next func/proc/task '\\[ada-next-procedure]'    Previous func/proc/task '\\[ada-previous-procedure]'
- Next package        '\\[ada-next-package]'  Previous package        '\\[ada-previous-package]'
-
- Goto matching start of current 'end ...;'            '\\[ada-move-to-start]'
- Goto end of current block                            '\\[ada-move-to-end]'
-
-Comments are handled using standard GNU Emacs conventions, including:
- Start a comment                                      '\\[indent-for-comment]'
- Comment region                                       '\\[comment-region]'
- Uncomment region                                     '\\[ada-uncomment-region]'
- Continue comment on next line                        '\\[indent-new-comment-line]'
-
-If you use imenu.el:
- Display index-menu of functions & procedures         '\\[imenu]'
-
-If you use find-file.el:
- Switch to other file (Body <-> Spec)                 '\\[ff-find-other-file]'
-                                                   or '\\[ff-mouse-find-other-file]
- Switch to other file in other window                 '\\[ada-ff-other-window]'
-                                                   or '\\[ff-mouse-find-other-file-other-window]
- If you use this function in a spec and no body is available, it gets created
- with body stubs.
-
-If you use ada-xref.el:
- Goto declaration:          '\\[ada-point-and-xref]' on the identifier
-                         or '\\[ada-goto-declaration]' with point on the identifier
- Complete identifier:       '\\[ada-complete-identifier]'
- Execute Gnatf:             '\\[ada-gnatf-current]'"
-
-  (interactive)
-  (kill-all-local-variables)
-
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-
-  (make-local-variable 'comment-start)
-  (setq comment-start "-- ")
-
-  ;; comment end must be set because it may hold a wrong value if
-  ;; this buffer had been in another mode before. RE
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-
-  (make-local-variable 'comment-start-skip) ;; used by autofill
-  (setq comment-start-skip "--+[ \t]*")
-
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'ada-indent-current-function)
-
-  (make-local-variable 'fill-column)
-  (setq fill-column 75)
-
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-
-  (make-local-variable 'case-fold-search)
-  (setq case-fold-search t)
-
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'ada-fill-comment-paragraph)
-
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression ada-imenu-generic-expression)
-
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '((ada-font-lock-keywords
-			      ada-font-lock-keywords-1
-			      ada-font-lock-keywords-2)
-			     nil t
-			     ((?\_ . "w"))
-			     beginning-of-line))
-
-  (setq major-mode 'ada-mode)
-  (setq mode-name "Ada")
-
-  (setq blink-matching-paren t)
-
-  (use-local-map ada-mode-map)
-
-  (if ada-mode-syntax-table
-      (set-syntax-table ada-mode-syntax-table)
-    (ada-create-syntax-table))
-
-  (if ada-clean-buffer-before-saving
-      (progn
-	;; remove all spaces at the end of lines in the whole buffer.
-	(add-hook 'local-write-file-hooks 'ada-remove-trailing-spaces)
-	;; convert all tabs to the correct number of spaces.
-	(add-hook 'local-write-file-hooks 'ada-untabify-buffer)))
-
-
-  ;; add menu 'Ada' to the menu bar
-  (ada-add-ada-menu)
-
-  (run-hooks 'ada-mode-hook)
-
-  ;; the following has to be done after running the ada-mode-hook
-  ;; because users might want to set the values of these variable
-  ;; inside the hook (MH)
-
-  (cond ((eq ada-language-version 'ada83)
-         (setq ada-keywords ada-83-keywords))
-        ((eq ada-language-version 'ada95)
-         (setq ada-keywords ada-95-keywords)))
-
-  (if ada-auto-case
-      (ada-activate-keys-for-case)))
-
-
-;;;--------------------------
-;;;  Fill Comment Paragraph
-;;;--------------------------
-
-(defun ada-fill-comment-paragraph-justify ()
-  "Fills current comment paragraph and justifies each line as well."
-  (interactive)
-  (ada-fill-comment-paragraph t))
-
-
-(defun ada-fill-comment-paragraph-postfix ()
-  "Fills current comment paragraph and justifies each line as well.
-Prompts for a postfix to be appended to each line."
-  (interactive)
-  (ada-fill-comment-paragraph t t))
-
-
-(defun ada-fill-comment-paragraph (&optional justify postfix)
-  "Fills the current comment paragraph.
-If JUSTIFY is non-nil, each line is justified as well.
-If POSTFIX and JUSTIFY are  non-nil, `ada-fill-comment-postfix' is appended
-to each filled and justified line.
-If `ada-indent-comment-as-code' is non-nil, the paragraph is idented."
-  (interactive "P")
-  (let ((opos (point-marker))
-        (begin nil)
-        (end nil)
-        (end-2 nil)
-        (indent nil)
-        (ada-fill-comment-old-postfix "")
-        (fill-prefix nil))
-
-    ;; check if inside comment
-    (if (not (ada-in-comment-p))
-        (error "not inside comment"))
-
-    ;; prompt for postfix if wanted
-    (if (and justify
-             postfix)
-        (setq ada-fill-comment-postfix
-              (read-from-minibuffer "enter new postfix string: "
-                                    ada-fill-comment-postfix)))
-
-    ;; prompt for old postfix to remove if necessary
-    (if (and justify
-             postfix)
-        (setq ada-fill-comment-old-postfix
-              (read-from-minibuffer "enter already existing postfix string: "
-                                    ada-fill-comment-postfix)))
-
-    ;;
-    ;; find limits of paragraph
-    ;;
-    (message "filling comment paragraph ...")
-    (save-excursion
-      (back-to-indentation)
-      ;; find end of paragraph
-      (while (and (looking-at "--.*$")
-                  (not (looking-at "--[ \t]*$")))
-        (forward-line 1)
-        (back-to-indentation))
-      (beginning-of-line)
-      (setq end (point-marker))
-      (goto-char opos)
-      ;; find begin of paragraph
-      (back-to-indentation)
-      (while (and (looking-at "--.*$")
-                  (not (looking-at "--[ \t]*$")))
-        (forward-line -1)
-        (back-to-indentation))
-      (forward-line 1)
-      ;; get indentation to calculate width for filling
-      (ada-indent-current)
-      (back-to-indentation)
-      (setq indent (current-column))
-      (setq begin (point-marker)))
-
-    ;; delete old postfix if necessary
-    (if (and justify
-             postfix)
-        (save-excursion
-          (goto-char begin)
-          (while (re-search-forward (concat ada-fill-comment-old-postfix
-                                            "\n")
-                                    end t)
-            (replace-match "\n"))))
-
-    ;; delete leading whitespace and uncomment
-    (save-excursion
-      (goto-char begin)
-      (beginning-of-line)
-      (while (re-search-forward "^[ \t]*--[ \t]*" end t)
-        (replace-match "")))
-
-    ;; calculate fill width
-    (setq fill-column (- fill-column indent
-                         (length ada-fill-comment-prefix)
-                         (if postfix
-                             (length ada-fill-comment-postfix)
-                           0)))
-    ;; fill paragraph
-    (fill-region begin (1- end) justify)
-    (setq fill-column (+ fill-column indent
-                         (length ada-fill-comment-prefix)
-                         (if postfix
-                             (length ada-fill-comment-postfix)
-                           0)))
-   ;; find end of second last line
-    (save-excursion
-      (goto-char end)
-      (forward-line -2)
-      (end-of-line)
-      (setq end-2 (point-marker)))
-
-    ;; re-comment and re-indent region
-    (save-excursion
-      (goto-char begin)
-      (indent-to indent)
-      (insert ada-fill-comment-prefix)
-      (while (re-search-forward "\n" (1- end-2) t)
-        (replace-match (concat "\n" ada-fill-comment-prefix))
-        (beginning-of-line)
-        (indent-to indent)))
-
-    ;; append postfix if wanted
-    (if (and justify
-             postfix
-             ada-fill-comment-postfix)
-        (progn
-          ;; append postfix up to there
-          (save-excursion
-            (goto-char begin)
-            (while (re-search-forward "\n" (1- end-2) t)
-              (replace-match (concat ada-fill-comment-postfix "\n")))
-
-            ;; fill last line and append postfix
-            (end-of-line)
-            (insert-char ?
-                         (- fill-column
-                            (current-column)
-                            (length ada-fill-comment-postfix)))
-            (insert ada-fill-comment-postfix))))
-
-    ;; delete the extra line that gets inserted somehow(??)
-    (save-excursion
-      (goto-char (1- end))
-      (end-of-line)
-      (delete-char 1))
-
-     (message "filling comment paragraph ... done")
-    (goto-char opos))
-  t)
-
-
-;;;--------------------------------;;;
-;;;  Call External Pretty Printer  ;;;
-;;;--------------------------------;;;
-
-(defun ada-call-pretty-printer ()
-  "Calls the external Pretty Printer.
-The name is specified in `ada-external-pretty-print-program'.  Saves the
-current buffer in a directory specified by `ada-tmp-directory',
-starts the pretty printer as external process on that file and then
-reloads the beautified program in the buffer and cleans up
-`ada-tmp-directory'."
-  (interactive)
-  (let ((filename-with-path buffer-file-name)
-        (curbuf (current-buffer))
-        (orgpos (point))
-        (mesgbuf nil) ;; for byte-compiling
-        (file-path (file-name-directory buffer-file-name))
-        (filename-without-path (file-name-nondirectory buffer-file-name))
-        (tmp-file-with-directory
-         (concat ada-tmp-directory
-                 (file-name-nondirectory buffer-file-name))))
-    ;;
-    ;; save buffer in temporary file
-    ;;
-    (message "saving current buffer to temporary file ...")
-    (write-file tmp-file-with-directory)
-    (auto-save-mode nil)
-    (message "saving current buffer to temporary file ... done")
-    ;;
-    ;; call external pretty printer program
-    ;;
-
-    (message "running external pretty printer ...")
-    ;; create a temporary buffer for messages of pretty printer
-    (setq mesgbuf (get-buffer-create "Pretty Printer Messages"))
-    ;; execute pretty printer on temporary file
-    (call-process ada-external-pretty-print-program
-                  nil mesgbuf t
-                  tmp-file-with-directory)
-    ;; display messages if there are some
-    (if (buffer-modified-p mesgbuf)
-        ;; show the message buffer
-        (display-buffer mesgbuf t)
-      ;; kill the message buffer
-      (kill-buffer mesgbuf))
-    (message "running external pretty printer ... done")
-    ;;
-    ;; kill current buffer and load pretty printer output
-    ;; or restore old buffer
-    ;;
-    (if (y-or-n-p
-         "Really replace current buffer with pretty printer output ? ")
-        (progn
-          (set-buffer-modified-p nil)
-          (kill-buffer curbuf)
-          (find-file tmp-file-with-directory))
-      (message "old buffer contents restored"))
-    ;;
-    ;; delete temporary file and restore information of current buffer
-    ;;
-    (delete-file tmp-file-with-directory)
-    (set-visited-file-name filename-with-path)
-    (auto-save-mode t)
-    (goto-char orgpos)))
-
-
-;;;---------------
-;;;  auto-casing
-;;;---------------
-
-;; from Philippe Waroquiers <philippe@cfmu.eurocontrol.be>
-;; modifiedby RE and MH
-
-(defun ada-after-keyword-p ()
-  ;; returns t if cursor is after a keyword.
-  (save-excursion
-    (forward-word -1)
-    (and (save-excursion
-           (or
-            (= (point) (point-min))
-            (backward-char 1))
-           (not (looking-at "_")))     ; (MH)
-         (looking-at (concat ada-keywords "[^_]")))))
-
-(defun ada-after-char-p ()
-  ;; returns t if after ada character "'". This is interpreted as being
-  ;; in a character constant.
-  (save-excursion
-    (if (> (point) 2)
-        (progn
-          (forward-char -2)
-          (looking-at "'"))
-      nil)))
-
-
-(defun ada-adjust-case (&optional force-identifier)
-  "Adjust the case of the word before the just typed character.
-Respect options `ada-case-keyword', `ada-case-identifier', and 
-`ada-case-attribute'.
-If FORCE-IDENTIFIER is non-nil then also adjust keyword as identifier." ; (MH)
-  (forward-char -1)
-  (if (and (> (point) 1) (not (or (ada-in-string-p)
-                                  (ada-in-comment-p)
-                                  (ada-after-char-p))))
-      (if (eq (char-syntax (char-after (1- (point)))) ?w)
-	  (if (save-excursion
-		(forward-word -1)
-		(or (= (point) (point-min))
-		    (backward-char 1))
-		(looking-at "'"))
-	      (funcall ada-case-attribute -1)
-	    (if (and
-		 (not force-identifier) ; (MH)
-		 (ada-after-keyword-p))
-		(funcall ada-case-keyword -1)
-	      (funcall ada-case-identifier -1)))))
-  (forward-char 1))
-
-
-(defun ada-adjust-case-interactive (arg)
-  (interactive "P")
-  (let ((lastk last-command-char))
-    (cond ((or (eq lastk ?\n)
-               (eq lastk ?\r))
-           ;; horrible kludge
-           (insert " ")
-           (ada-adjust-case)
-           ;; horrible dekludge
-           (delete-backward-char 1)
-           ;; some special keys and their bindings
-           (cond
-            ((eq lastk ?\n)
-             (funcall ada-lfd-binding))
-            ((eq lastk ?\r)
-             (funcall ada-ret-binding))))
-          ((eq lastk ?\C-i) (ada-tab))
-          ((self-insert-command (prefix-numeric-value arg))))
-    ;; if there is a keyword in front of the underscore
-    ;; then it should be part of an identifier (MH)
-    (if (eq lastk ?_)
-        (ada-adjust-case t)
-      (ada-adjust-case))))
-
-
-(defun ada-activate-keys-for-case ()
-  ;; save original keybindings to allow swapping ret/lfd
-  ;; when casing is activated
-  ;; the 'or ...' is there to be sure that the value will not
-  ;; be changed again when Ada Mode is called more than once (MH)
-  (or ada-ret-binding
-      (setq ada-ret-binding (key-binding "\C-M")))
-  (or ada-lfd-binding
-      (setq ada-lfd-binding (key-binding "\C-j")))
-  ;; call case modifying function after certain keys.
-  (mapcar (function (lambda(key) (define-key
-                                   ada-mode-map
-                                   (char-to-string key)
-                                   'ada-adjust-case-interactive)))
-          '( ?` ?~ ?! ?@ ?# ?$ ?% ?^ ?& ?* ?( ?)  ?- ?= ?+ ?[ ?{ ?] ?}
-                ?_ ?\\ ?| ?\; ?: ?' ?\" ?< ?, ?. ?> ?? ?/ ?\n 32 ?\r )))
-;; deleted ?\t from above list
-
-;;
-;; added by MH
-;;
-(defun ada-loose-case-word (&optional arg)
-  "Capitalizes the first letter and the letters following `_'.
-ARG is ignored, it's there to fit the standard casing functions' style."
-  (let ((pos (point))
-        (first t))
-    (skip-chars-backward "a-zA-Z0-9_")
-    (while (or first
-               (search-forward "_" pos t))
-      (and first
-           (setq first nil))
-      (insert-char (upcase (following-char)) 1)
-      (delete-char 1))
-    (goto-char pos)))
-
-
-;;
-;; added by MH
-;;
-(defun ada-adjust-case-region (from to)
-  "Adjusts the case of all words in the region.
-Attention: This function might take very long for big regions !"
-  (interactive "*r")
-  (let ((begin nil)
-        (end nil)
-        (keywordp nil)
-        (reldiff nil))
-    (unwind-protect
-	(save-excursion
-	  (set-syntax-table ada-mode-symbol-syntax-table)
-	  (goto-char to)
-	  ;;
-	  ;; loop: look for all identifiers and keywords
-	  ;;
-	  (while (re-search-backward
-		  "[^a-zA-Z0-9_]\\([a-zA-Z0-9_]+\\)[^a-zA-Z0-9_]"
-		  from
-		  t)
-	    ;;
-	    ;; print status message
-	    ;;
-	    (setq reldiff (- (point) from))
-	    (message "adjusting case ... %5d characters left"
-		     (- (point) from))
-	    (forward-char 1)
-	    (or
-	     ;; do nothing if it is a string or comment
-	     (ada-in-string-or-comment-p)
-	     (progn
-	       ;;
-	       ;; get the identifier or keyword
-	       ;;
-	       (setq begin (point))
-	       (setq keywordp (looking-at (concat ada-keywords "[^_]")))
-	       (skip-chars-forward "a-zA-Z0-9_")
-	       ;;
-	       ;; casing according to user-option
-	       ;;
-	       (if keywordp
-		   (funcall ada-case-keyword -1)
-		 (funcall ada-case-identifier -1))
-	       (goto-char begin))))
-	  (message "adjusting case ... done"))
-      (set-syntax-table ada-mode-syntax-table))))
-
-
-;;
-;; added by MH
-;;
-(defun ada-adjust-case-buffer ()
-  "Adjusts the case of all words in the whole buffer.
-ATTENTION: This function might take very long for big buffers !"
-  (interactive "*")
-  (ada-adjust-case-region (point-min) (point-max)))
-
-
-;;;------------------------;;;
-;;; Format Parameter Lists ;;;
-;;;------------------------;;;
-
-(defun ada-format-paramlist ()
-  "Reformats a parameter list.
-ATTENTION:  1) Comments inside the list are killed !
-            2) If the syntax is not correct (especially, if there are
-               semicolons missing), it can get totally confused !
-In such a case, use `undo', correct the syntax and try again."
-
-  (interactive)
-  (let ((begin nil)
-        (end nil)
-        (delend nil)
-        (paramlist nil))
-    (unwind-protect
-	(progn 
-	  (set-syntax-table ada-mode-symbol-syntax-table)
-
-	  ;; check if really inside parameter list
-	  (or (ada-in-paramlist-p)
-	      (error "not in parameter list"))
-	  ;;
-	  ;; find start of current parameter-list
-	  ;;
-	  (ada-search-ignore-string-comment
-           (concat ada-subprog-start-re "\\|\\<body\\>" ) t nil)
-	  (ada-search-ignore-string-comment "(" nil nil t)
-	  (backward-char 1)
-	  (setq begin (point))
-
-	  ;;
-	  ;; find end of parameter-list
-	  ;;
-	  (forward-sexp 1)
-	  (setq delend (point))
-	  (delete-char -1)
-
-	  ;;
-	  ;; find end of last parameter-declaration
-	  ;;
-	  (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
-	  (forward-char 1)
-	  (setq end (point))
-
-	  ;;
-	  ;; build a list of all elements of the parameter-list
-	  ;;
-	  (setq paramlist (ada-scan-paramlist (1+ begin) end))
-
-	  ;;
-	  ;; delete the original parameter-list
-	  ;;
-	  (delete-region begin (1- delend))
-
-	  ;;
-	  ;; insert the new parameter-list
-	  ;;
-	  (goto-char begin)
-	  (ada-insert-paramlist paramlist))
-
-      ;;
-      ;; restore syntax-table
-      ;;
-      (set-syntax-table ada-mode-syntax-table)
-      )))
-
-
-(defun ada-scan-paramlist (begin end)
-  ;; Scans a parameter-list  between BEGIN and END and returns a list
-  ;; of its contents.
-  ;; The list has the following format:
-  ;;
-  ;;   Name of Param  in? out? access?  Name of Type   Default-Exp or nil
-  ;;
-  ;; ( ('Name_Param_1' t   nil    t      Type_Param_1   ':= expression')
-  ;;   ('Name_Param_2' nil nil    t      Type_Param_2    nil) )
-
-  (let ((paramlist (list))
-        (param (list))
-        (notend t)
-        (apos nil)
-        (epos nil)
-        (semipos nil)
-        (match-cons nil))
-
-    (goto-char begin)
-    ;;
-    ;; loop until end of last parameter
-    ;;
-    (while notend
-
-      ;;
-      ;; find first character of parameter-declaration
-      ;;
-      (ada-goto-next-non-ws)
-      (setq apos (point))
-
-      ;;
-      ;; find last character of parameter-declaration
-      ;;
-      (if (setq match-cons
-                (ada-search-ignore-string-comment "[ \t\n]*;" nil end t))
-          (progn
-            (setq epos (car match-cons))
-            (setq semipos (cdr match-cons)))
-        (setq epos end))
-
-      ;;
-      ;; read name(s) of parameter(s)
-      ;;
-      (goto-char apos)
-      (looking-at "\\([a-zA-Z0-9_, \t\n]*[a-zA-Z0-9_]\\)[ \t\n]*:[^=]")
-
-      (setq param (list (buffer-substring (match-beginning 1)
-                                          (match-end 1))))
-      (ada-search-ignore-string-comment ":" nil epos t)
-
-      ;;
-      ;; look for 'in'
-      ;;
-      (setq apos (point))
-      (setq param
-            (append param
-                    (list
-                     (consp
-                      (ada-search-ignore-string-comment "\\<in\\>"
-                                                        nil
-                                                        epos
-                                                        t)))))
-
-      ;;
-      ;; look for 'out'
-      ;;
-      (goto-char apos)
-      (setq param
-            (append param
-                    (list
-                     (consp
-                      (ada-search-ignore-string-comment "\\<out\\>"
-                                                        nil
-                                                        epos
-                                                        t)))))
-
-      ;;
-      ;; look for 'access'
-      ;;
-      (goto-char apos)
-      (setq param
-            (append param
-                    (list
-                     (consp
-                      (ada-search-ignore-string-comment "\\<access\\>"
-                                                        nil
-                                                        epos
-                                                        t)))))
-
-      ;;
-      ;; skip 'in'/'out'/'access'
-      ;;
-      (goto-char apos)
-      (ada-goto-next-non-ws)
-      (while (looking-at "\\<\\(in\\|out\\|access\\)\\>")
-        (forward-word 1)
-        (ada-goto-next-non-ws))
-
-      ;;
-      ;; read type of parameter
-      ;;
-      (looking-at "\\<[a-zA-Z0-9_\\.]+\\>")
-      (setq param
-            (append param
-                    (list
-                     (buffer-substring (match-beginning 0)
-                                       (match-end 0)))))
-
-      ;;
-      ;; read default-expression, if there is one
-      ;;
-      (goto-char (setq apos (match-end 0)))
-      (setq param
-            (append param
-                    (list
-                     (if (setq match-cons
-                               (ada-search-ignore-string-comment ":="
-                                                                 nil
-                                                                 epos
-                                                                 t))
-                         (buffer-substring (car match-cons)
-                                           epos)
-                       nil))))
-      ;;
-      ;; add this parameter-declaration to the list
-      ;;
-      (setq paramlist (append paramlist (list param)))
-
-      ;;
-      ;; check if it was the last parameter
-      ;;
-      (if (eq epos end)
-          (setq notend nil)
-        (goto-char semipos))
-
-      ) ; end of loop
-
-    (reverse paramlist)))
-
-
-(defun ada-insert-paramlist (paramlist)
-  ;; Inserts a formatted PARAMLIST in the buffer.
-  ;; See doc of `ada-scan-paramlist' for the format.
-  (let ((i (length paramlist))
-        (parlen 0)
-        (typlen 0)
-        (temp 0)
-        (inp nil)
-        (outp nil)
-        (accessp nil)
-        (column nil)
-        (orgpoint 0)
-        (firstcol nil))
-
-    ;;
-    ;; loop until last parameter
-    ;;
-    (while (not (zerop i))
-      (setq i (1- i))
-
-      ;;
-      ;; get max length of parameter-name
-      ;;
-      (setq parlen
-            (if (<= parlen (setq temp
-                              (length (nth 0 (nth i paramlist)))))
-                temp
-              parlen))
-
-      ;;
-      ;; get max length of type-name
-      ;;
-      (setq typlen
-            (if (<= typlen (setq temp
-                              (length (nth 4 (nth i paramlist)))))
-                temp
-              typlen))
-
-      ;;
-      ;; is there any 'in' ?
-      ;;
-      (setq inp
-            (or inp
-                (nth 1 (nth i paramlist))))
-
-      ;;
-      ;; is there any 'out' ?
-      ;;
-      (setq outp
-            (or outp
-                (nth 2 (nth i paramlist))))
-
-      ;;
-      ;; is there any 'access' ?
-      ;;
-      (setq accessp
-            (or accessp
-                (nth 3 (nth i paramlist))))) ; end of loop
-
-    ;;
-    ;; does paramlist already start on a separate line ?
-    ;;
-    (if (save-excursion
-          (re-search-backward "^.\\|[^ \t]" nil t)
-          (looking-at "^."))
-        ;; yes => re-indent it
-        (ada-indent-current)
-      ;;
-      ;; no => insert newline and indent it
-      ;;
-      (progn
-        (ada-indent-current)
-        (newline)
-        (delete-horizontal-space)
-        (setq orgpoint (point))
-        (setq column (save-excursion
-                       (funcall (ada-indent-function) orgpoint)))
-        (indent-to column)
-        ))
-
-    (insert "(")
-
-    (setq firstcol (current-column))
-    (setq i (length paramlist))
-
-    ;;
-    ;; loop until last parameter
-    ;;
-    (while (not (zerop i))
-      (setq i (1- i))
-      (setq column firstcol)
-
-      ;;
-      ;; insert parameter-name, space and colon
-      ;;
-      (insert (nth 0 (nth i paramlist)))
-      (indent-to (+ column parlen 1))
-      (insert ": ")
-      (setq column (current-column))
-
-      ;;
-      ;; insert 'in' or space
-      ;;
-      (if (nth 1 (nth i paramlist))
-          (insert "in ")
-        (if (and
-             (or inp
-                 accessp)
-             (not (nth 3 (nth i paramlist))))
-            (insert "   ")))
-
-      ;;
-      ;; insert 'out' or space
-      ;;
-      (if (nth 2 (nth i paramlist))
-          (insert "out ")
-        (if (and
-             (or outp
-                 accessp)
-             (not (nth 3 (nth i paramlist))))
-            (insert "    ")))
-
-      ;;
-      ;; insert 'access'
-      ;;
-      (if (nth 3 (nth i paramlist))
-          (insert "access "))
-
-      (setq column (current-column))
-
-      ;;
-      ;; insert type-name and, if necessary, space and default-expression
-      ;;
-      (insert (nth 4 (nth i paramlist)))
-      (if (nth 5 (nth i paramlist))
-          (progn
-            (indent-to (+ column typlen 1))
-            (insert (nth 5 (nth i paramlist)))))
-
-      ;;
-      ;; check if it was the last parameter
-      ;;
-      (if (not (zerop i))
-          ;; no => insert ';' and newline and indent
-          (progn
-            (insert ";")
-            (newline)
-            (indent-to firstcol))
-        ;; yes
-        (insert ")"))
-
-      ) ; end of loop
-
-    ;;
-    ;; if anything follows, except semicolon:
-    ;; put it in a new line and indent it
-    ;;
-    (if (not (looking-at "[ \t]*[;\n]"))
-        (ada-indent-newline-indent))
-
-    ))
-
-
-;;;----------------------------;;;
-;;; Move To Matching Start/End ;;;
-;;;----------------------------;;;
-
-(defun ada-move-to-start ()
-  "Moves point to the matching start of the current Ada structure."
-  (interactive)
-  (let ((pos (point)))
-    (unwind-protect
-	(progn
-	  (set-syntax-table ada-mode-symbol-syntax-table)
-
-	  (message "searching for block start ...")
-	  (save-excursion
-	    ;;
-	    ;; do nothing if in string or comment or not on 'end ...;'
-	    ;;            or if an error occurs during processing
-	    ;;
-	    (or
-	     (ada-in-string-or-comment-p)
-	     (and (progn
-		    (or (looking-at "[ \t]*\\<end\\>")
-			(backward-word 1))
-		    (or (looking-at "[ \t]*\\<end\\>")
-			(backward-word 1))
-		    (or (looking-at "[ \t]*\\<end\\>")
-			(error "not on end ...;")))
-		  (ada-goto-matching-start 1)
-		  (setq pos (point))
-
-		  ;;
-		  ;; on 'begin' => go on, according to user option
-		  ;;
-		  ada-move-to-declaration
-		  (looking-at "\\<begin\\>")
-		  (ada-goto-matching-decl-start)
-		  (setq pos (point))))
-
-	    ) ; end of save-excursion
-
-	  ;; now really move to the found position
-	  (goto-char pos)
-	  (message "searching for block start ... done"))
-
-      ;;
-      ;; restore syntax-table
-      ;;
-      (set-syntax-table ada-mode-syntax-table))))
-
-
-(defun ada-move-to-end ()
-  "Moves point to the matching end of the current block around point.
-Moves to 'begin' if in a declarative part."
-  (interactive)
-  (let ((pos (point))
-        (decstart nil)
-        (packdecl nil))
-    (unwind-protect
-	(progn
-	  (set-syntax-table ada-mode-symbol-syntax-table)
-
-	  (message "searching for block end ...")
-	  (save-excursion
-
-	    (forward-char 1)
-	    (cond
-	     ;; directly on 'begin'
-	     ((save-excursion
-		(ada-goto-previous-word)
-		(looking-at "\\<begin\\>"))
-	      (ada-goto-matching-end 1))
-	     ;; on first line of defun declaration
-	     ((save-excursion
-		(and (ada-goto-stmt-start)
-		     (looking-at "\\<function\\>\\|\\<procedure\\>" )))
-	      (ada-search-ignore-string-comment "\\<begin\\>"))
-	     ;; on first line of task declaration
-	     ((save-excursion
-		(and (ada-goto-stmt-start)
-		     (looking-at "\\<task\\>" )
-		     (forward-word 1)
-		     (ada-search-ignore-string-comment "[^ \n\t]")
-		     (not (backward-char 1))
-		     (looking-at "\\<body\\>")))
-	      (ada-search-ignore-string-comment "\\<begin\\>"))
-	     ;; accept block start
-	     ((save-excursion
-		(and (ada-goto-stmt-start)
-		     (looking-at "\\<accept\\>" )))
-	      (ada-goto-matching-end 0))
-	     ;; package start
-	     ((save-excursion
-		(and (ada-goto-matching-decl-start t)
-		     (looking-at "\\<package\\>")))
-	      (ada-goto-matching-end 1))
-	     ;; inside a 'begin' ... 'end' block
-	     ((save-excursion
-		(ada-goto-matching-decl-start t))
-	      (ada-search-ignore-string-comment "\\<begin\\>"))
-	     ;; (hopefully ;-) everything else
-	     (t
-	      (ada-goto-matching-end 1)))
-	    (setq pos (point))
-
-	    ) ; end of save-excursion
-
-	  ;; now really move to the found position
-	  (goto-char pos)
-	  (message "searching for block end ... done"))
-      
-      ;;
-      ;; restore syntax-table
-      ;;
-      (set-syntax-table ada-mode-syntax-table))))
-
-
-;;;-----------------------------;;;
-;;;  Functions For Indentation  ;;;
-;;;-----------------------------;;;
-
-;; ---- main functions for indentation
-
-(defun ada-indent-region (beg end)
-  "Indents the region using `ada-indent-current' on each line."
-  (interactive "*r")
-  (goto-char beg)
-  (let ((block-done 0)
-	(lines-remaining (count-lines beg end))
-	(msg (format "indenting %4d lines %%4d lines remaining ..."
-		     (count-lines beg end)))
-        (endmark (copy-marker end)))
-    ;; catch errors while indenting
-    (condition-case err
-        (while (< (point) endmark)
-          (if (> block-done 9)
-              (progn (message msg lines-remaining)
-                     (setq block-done 0)))
-	  (if (looking-at "^$") nil
-	    (ada-indent-current))
-          (forward-line 1)
-	  (setq block-done (1+ block-done))
-	  (setq lines-remaining (1- lines-remaining)))
-      ;; show line number where the error occurred
-      (error
-       (error "line %d: %s" (1+ (count-lines (point-min) (point))) err)))
-    (message "indenting ... done")))
-
-
-(defun ada-indent-newline-indent ()
-  "Indents the current line, inserts a newline and then indents the new line."
-  (interactive "*")
-  (let ((column)
-        (orgpoint))
-
-    (ada-indent-current)
-    (newline)
-    (delete-horizontal-space)
-    (setq orgpoint (point))
-
-    (unwind-protect
-	(progn
-	  (set-syntax-table ada-mode-symbol-syntax-table)
-
-	  (setq column (save-excursion
-			 (funcall (ada-indent-function) orgpoint))))
-
-      ;;
-      ;; restore syntax-table
-      ;;
-      (set-syntax-table ada-mode-syntax-table))
-
-    (indent-to column)
-
-    ;; The following is needed to ensure that indentation will still be
-    ;; correct if something follows behind point when typing LFD
-    ;; For example: Imagine point to be there (*) when LFD is typed:
-    ;;              while cond loop
-    ;;                 null; *end loop;
-    ;; Result without the following statement would be:
-    ;;              while cond loop
-    ;;                 null;
-    ;;                *end loop;
-    ;; You would then have to type TAB to correct it.
-    ;; If that doesn't bother you, you can comment out the following
-    ;; statement to speed up indentation a LITTLE bit.
-
-    (if (not (looking-at "[ \t]*$"))
-        (ada-indent-current))
-    ))
-
-
-(defun ada-indent-current ()
-  "Indents current line as Ada code.
-This works by two steps:
- 1) It moves point to the end of the previous code line.
-    Then it calls the function to calculate the indentation for the
-    following line as if a newline would be inserted there.
-    The calculated column # is saved and the old position of point
-    is restored.
- 2) Then another function is called to calculate the indentation for
-    the current line, based on the previously calculated column #."
-
-  (interactive)
-
-  (unwind-protect
-      (progn
-	(set-syntax-table ada-mode-symbol-syntax-table)
-
-	(let ((line-end)
-	      (orgpoint (point-marker))
-	      (cur-indent)
-	      (prev-indent)
-	      (prevline t))
-
-	  ;;
-	  ;; first step
-	  ;;
-	  (save-excursion
-	    (if (ada-goto-prev-nonblank-line t)
-		;;
-		;; we are not in the first accessible line in the buffer
-		;;
-		(progn
-		  ;;(end-of-line)
-		  ;;(forward-char 1)
-		  ;; we are already at the BOL
-		  (forward-line 1)
-		  (setq line-end (point))
-		  (setq prev-indent
-			(save-excursion
-			  (funcall (ada-indent-function) line-end))))
-              (progn                    ; first line of buffer -> set indent
-                (beginning-of-line)     ; to 0
-                (delete-horizontal-space)
-                (setq prevline nil))))
-
-	  (if prevline
-	      ;;
-	      ;; we are not in the first accessible line in the buffer
-	      ;;
-	      (progn
-		;;
-		;; second step
-		;;
-		(back-to-indentation)
-		(setq cur-indent (ada-get-current-indent prev-indent))
-                ;; only reindent if indentation is different then the current
-                (if (= (current-column) cur-indent)
-                    nil
-		(delete-horizontal-space)
-                  (indent-to cur-indent))
-		;;
-		;; restore position of point
-		;;
-		(goto-char orgpoint)
-		(if (< (current-column) (current-indentation))
-              (back-to-indentation))))))
-
-    ;;
-    ;; restore syntax-table
-    ;;
-    (set-syntax-table ada-mode-syntax-table)))
-
-
-(defun ada-get-current-indent (prev-indent)
-  ;; Returns the column # to indent the current line to.
-  ;; PREV-INDENT is the indentation resulting from the previous lines.
-  (let ((column nil)
-        (pos nil)
-        (match-cons nil))
-
-    (cond
-     ;;
-     ;; in open parenthesis, but not in parameter-list
-     ;;
-     ((and
-       ada-indent-to-open-paren
-       (not (ada-in-paramlist-p))
-       (setq column (ada-in-open-paren-p)))
-      ;; check if we have something like this  (Table_Component_Type =>
-      ;;                                          Source_File_Record,)
-      (save-excursion
-        (if (and (ada-search-ignore-string-comment "[^ \t]" t nil)
-                 (looking-at "\n")
-                 (ada-search-ignore-string-comment "[^ \t\n]" t nil)
-                 (looking-at ">"))
-            (setq column (+ ada-broken-indent column))))
-      column)
-
-     ;;
-     ;; end
-     ;;
-     ((looking-at "\\<end\\>")
-      (save-excursion
-        (ada-goto-matching-start 1)
-
-        ;;
-        ;; found 'loop' => skip back to 'while' or 'for'
-        ;;                 if 'loop' is not on a separate line
-        ;;
-        (if (and
-             (looking-at "\\<loop\\>")
-             (save-excursion
-               (back-to-indentation)
-               (not (looking-at "\\<loop\\>"))))
-            (if (save-excursion
-                  (and
-                   (setq match-cons
-                         (ada-search-ignore-string-comment
-                          ada-loop-start-re t nil))
-                   (not (looking-at "\\<loop\\>"))))
-                (goto-char (car match-cons))))
-
-        (current-indentation)))
-     ;;
-     ;; exception
-     ;;
-     ((looking-at "\\<exception\\>")
-      (save-excursion
-        (ada-goto-matching-start 1)
-        (current-indentation)))
-     ;;
-     ;; when
-     ;;
-     ((looking-at "\\<when\\>")
-      (save-excursion
-        (ada-goto-matching-start 1)
-        (+ (current-indentation) ada-when-indent)))
-     ;;
-     ;; else
-     ;;
-     ((looking-at "\\<else\\>")
-      (if (save-excursion
-            (ada-goto-previous-word)
-            (looking-at "\\<or\\>"))
-          prev-indent
-        (save-excursion
-          (ada-goto-matching-start 1 nil t)
-          (current-indentation))))
-     ;;
-     ;; elsif
-     ;;
-     ((looking-at "\\<elsif\\>")
-      (save-excursion
-        (ada-goto-matching-start 1 nil t)
-        (current-indentation)))
-     ;;
-     ;; then
-     ;;
-     ((looking-at "\\<then\\>")
-      (if (save-excursion
-            (ada-goto-previous-word)
-            (looking-at "\\<and\\>"))
-          prev-indent
-        (save-excursion
-          (ada-search-ignore-string-comment "\\<elsif\\>\\|\\<if\\>" t nil)
-          (+ (current-indentation) ada-stmt-end-indent))))
-     ;;
-     ;; loop
-     ;;
-     ((looking-at "\\<loop\\>")
-      (setq pos (point))
-      (save-excursion
-        (goto-char (match-end 0))
-        (ada-goto-stmt-start)
-        (if (looking-at "\\<loop\\>\\|\\<if\\>")
-            prev-indent
-          (progn
-            (if (not (looking-at ada-loop-start-re))
-                (ada-search-ignore-string-comment ada-loop-start-re
-                                                  nil pos))
-            (if (looking-at "\\<loop\\>")
-                prev-indent
-              (+ (current-indentation) ada-stmt-end-indent))))))
-     ;;
-     ;; begin
-     ;;
-     ((looking-at "\\<begin\\>")
-      (save-excursion
-        (if (ada-goto-matching-decl-start t)
-            (current-indentation)
-          (progn
-            (message "no matching declaration start")
-            prev-indent))))
-     ;;
-     ;; is
-     ;;
-     ((looking-at "\\<is\\>")
-      (if (and
-           ada-indent-is-separate
-           (save-excursion
-             (goto-char (match-end 0))
-             (ada-goto-next-non-ws (save-excursion
-                                     (end-of-line)
-                                     (point)))
-             (looking-at "\\<abstract\\>\\|\\<separate\\>")))
-          (save-excursion
-            (ada-goto-stmt-start)
-            (+ (current-indentation) ada-indent))
-        (save-excursion
-          (ada-goto-stmt-start)
-          (+ (current-indentation) ada-stmt-end-indent))))
-     ;;
-     ;; record
-     ;;
-     ((looking-at "\\<record\\>")
-      (save-excursion
-        (ada-search-ignore-string-comment
-         "\\<\\(type\\|use\\)\\>" t nil)
-        (if (looking-at "\\<use\\>")
-            (ada-search-ignore-string-comment "\\<for\\>" t nil))
-        (+ (current-indentation) ada-indent-record-rel-type)))
-     ;;
-     ;; or as statement-start
-     ;;
-     ((ada-looking-at-semi-or)
-      (save-excursion
-        (ada-goto-matching-start 1)
-        (current-indentation)))
-     ;;
-     ;; private as statement-start
-     ;;
-     ((ada-looking-at-semi-private)
-      (save-excursion
-        (ada-goto-matching-decl-start)
-        (current-indentation)))
-     ;;
-     ;; new/abstract/separate
-     ;;
-     ((looking-at "\\<\\(new\\|abstract\\|separate\\)\\>")
-      (- prev-indent ada-indent (- ada-broken-indent)))
-     ;;
-     ;; return
-     ;;
-     ((looking-at "\\<return\\>")
-      (save-excursion
-        (forward-sexp -1)
-        (if (and (looking-at "(")
-                 (save-excursion
-                   (backward-sexp 2)
-                   (looking-at "\\<function\\>")))
-            (1+ (current-column))
-          prev-indent)))
-     ;;
-     ;; do
-     ;;
-     ((looking-at "\\<do\\>")
-      (save-excursion
-        (ada-goto-stmt-start)
-        (+ (current-indentation) ada-stmt-end-indent)))
-     ;;
-     ;; package/function/procedure
-     ;;
-     ((and (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")
-           (save-excursion
-             (forward-char 1)
-             (ada-goto-stmt-start)
-             (looking-at "\\<\\(package\\|function\\|procedure\\)\\>")))
-      (save-excursion
-        ;; look for 'generic'
-        (if (and (ada-goto-matching-decl-start t)
-                 (looking-at "generic"))
-            (current-column)
-          prev-indent)))
-     ;;
-     ;; label
-     ;;
-     ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*:[^=]")
-      (if (ada-in-decl-p)
-          prev-indent
-        (+ prev-indent ada-label-indent)))
-     ;;
-     ;; identifier and other noindent-statements
-     ;;
-     ((looking-at "\\<[a-zA-Z0-9_]+[ \t\n]*")
-      prev-indent)
-     ;;
-     ;; beginning of a parameter list
-     ;;
-     ((looking-at "(")
-      prev-indent)
-     ;;
-     ;; end of a parameter list
-     ;;
-     ((looking-at ")")
-      (save-excursion
-        (forward-char 1)
-        (backward-sexp 1)
-        (current-column)))
-     ;;
-     ;; comment
-     ;;
-     ((looking-at "--")
-      (if ada-indent-comment-as-code
-          prev-indent
-        (current-indentation)))
-     ;;
-     ;; unknown syntax - maybe this should signal an error ?
-     ;;
-     (t
-      prev-indent))))
-
-
-(defun ada-indent-function (&optional nomove)
-  ;; Returns the function to calculate the indentation for the current
-  ;; line according to the previous statement, ignoring the contents
-  ;; of the current line after point.  Moves point to the beginning of
-  ;; the current statement, if NOMOVE is nil.
-
-  (let ((orgpoint (point))
-        (func nil)
-        (stmt-start nil))
-    ;;
-    ;; inside a parameter-list
-    ;;
-    (if (ada-in-paramlist-p)
-        (setq func 'ada-get-indent-paramlist)
-      (progn
-        ;;
-        ;; move to beginning of current statement
-        ;;
-        (if (not nomove)
-            (setq stmt-start (ada-goto-stmt-start)))
-        ;;
-        ;; no beginning found => don't change indentation
-        ;;
-        (if (and
-             (eq orgpoint (point))
-             (not nomove))
-              (setq func 'ada-get-indent-nochange)
-
-          (cond
-           ;;
-           ((and
-             ada-indent-to-open-paren
-             (ada-in-open-paren-p))
-            (setq func 'ada-get-indent-open-paren))
-           ;;
-           ((looking-at "\\<end\\>")
-            (setq func 'ada-get-indent-end))
-           ;;
-           ((looking-at ada-loop-start-re)
-            (setq func 'ada-get-indent-loop))
-           ;;
-           ((looking-at ada-subprog-start-re)
-            (setq func 'ada-get-indent-subprog))
-           ;;
-           ((looking-at "\\<package\\>")
-            (setq func 'ada-get-indent-subprog)) ; maybe it needs a
-                                                 ; special function
-                                                 ; sometimes ?
-           ;;
-           ((looking-at ada-block-start-re)
-            (setq func 'ada-get-indent-block-start))
-           ;;
-           ((looking-at "\\<type\\>")
-            (setq func 'ada-get-indent-type))
-           ;;
-           ((looking-at "\\<\\(els\\)?if\\>")
-            (setq func 'ada-get-indent-if))
-           ;;
-           ((looking-at "\\<case\\>")
-            (setq func 'ada-get-indent-case))
-           ;;
-           ((looking-at "\\<when\\>")
-            (setq func 'ada-get-indent-when))
-           ;;
-           ((looking-at "--")
-            (setq func 'ada-get-indent-comment))
-           ;;
-           ((looking-at "[a-zA-Z0-9_]+[ \t\n]*:[^=]")
-            (setq func 'ada-get-indent-label))
-           ;;
-	   ((looking-at "\\<separate\\>")
-	    (setq func 'ada-get-indent-nochange))
-           (t
-            (setq func 'ada-get-indent-noindent))))))
-
-    func))
-
-
-;; ---- functions to return indentation for special cases
-
-(defun ada-get-indent-open-paren (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be behind an open parenthesis not yet closed.
-  (ada-in-open-paren-p))
-
-
-(defun ada-get-indent-nochange (orgpoint)
-  ;; Returns the indentation (column #) of the current line.
-  (save-excursion
-    (forward-line -1)
-    (current-indentation)))
-
-
-(defun ada-get-indent-paramlist (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be inside a parameter-list.
-  (save-excursion
-    (ada-search-ignore-string-comment "[^ \t\n]" t nil t)
-    (cond
-     ;;
-     ;; in front of the first parameter
-     ;;
-     ((looking-at "(")
-      (goto-char (match-end 0))
-      (current-column))
-     ;;
-     ;; in front of another parameter
-     ;;
-     ((looking-at ";")
-      (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
-      (ada-goto-next-non-ws)
-      (current-column))
-     ;;
-     ;; inside a parameter declaration
-     ;;
-     (t
-      (goto-char (cdr (ada-search-ignore-string-comment "(\\|;" t nil t)))
-      (ada-goto-next-non-ws)
-      (+ (current-column) ada-broken-indent)))))
-
-
-(defun ada-get-indent-end (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of an end-statement.
-  ;; Therefore it has to find the corresponding start. This can be a little
-  ;; slow, if it has to search through big files with many nested blocks.
-  ;; Signals an error if the corresponding block-start doesn't match.
-  (let ((defun-name nil)
-        (indent nil))
-    ;;
-    ;; is the line already terminated by ';' ?
-    ;;
-    (if (save-excursion
-          (ada-search-ignore-string-comment ";" nil orgpoint))
-        ;;
-        ;; yes, look what's following 'end'
-        ;;
-        (progn
-          (forward-word 1)
-          (ada-goto-next-non-ws)
-          (cond
-           ;;
-           ;; loop/select/if/case/record/select
-           ;;
-           ((looking-at "\\<\\(loop\\|select\\|if\\|case\\|record\\)\\>")
-            (save-excursion
-              (ada-check-matching-start
-               (buffer-substring (match-beginning 0)
-                                 (match-end 0)))
-              (if (looking-at "\\<\\(loop\\|record\\)\\>")
-                  (progn
-                    (forward-word 1)
-                    (ada-goto-stmt-start)))
-              ;; a label ? => skip it
-              (if (looking-at "[a-zA-Z0-9_]+[ \n\t]+:")
-                  (progn
-                    (goto-char (match-end 0))
-                    (ada-goto-next-non-ws)))
-              ;; really looking-at the right thing ?
-              (or (looking-at (concat "\\<\\("
-                                      "loop\\|select\\|if\\|case\\|"
-                                      "record\\|while\\|type\\)\\>"))
-                  (progn
-                    (ada-search-ignore-string-comment
-                     (concat "\\<\\("
-                             "loop\\|select\\|if\\|case\\|"
-                             "record\\|while\\|type\\)\\>")))
-                  (backward-word 1))
-              (current-indentation)))
-           ;;
-           ;; a named block end
-           ;;
-           ((looking-at ada-ident-re)
-            (setq defun-name (buffer-substring (match-beginning 0)
-                                               (match-end 0)))
-            (save-excursion
-              (ada-goto-matching-start 0)
-              (ada-check-defun-name defun-name)
-              (current-indentation)))
-           ;;
-           ;; a block-end without name
-           ;;
-           ((looking-at ";")
-            (save-excursion
-              (ada-goto-matching-start 0)
-              (if (looking-at "\\<begin\\>")
-                  (progn
-                    (setq indent (current-column))
-                    (if (ada-goto-matching-decl-start t)
-                        (current-indentation)
-                      indent)))))
-           ;;
-           ;; anything else - should maybe signal an error ?
-           ;;
-           (t
-            (+ (current-indentation) ada-broken-indent))))
-
-      (+ (current-indentation) ada-broken-indent))))
-
-
-(defun ada-get-indent-case (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of an case-statement.
-  (let ((cur-indent (current-indentation))
-        (match-cons nil)
-        (opos (point)))
-    (cond
-     ;;
-     ;; case..is..when..=>
-     ;;
-     ((save-excursion
-       (setq match-cons (ada-search-ignore-string-comment
-                         "[ \t\n]+=>" nil orgpoint)))
-      (save-excursion
-        (goto-char (car match-cons))
-        (if (not (ada-search-ignore-string-comment "\\<when\\>" t opos))
-            (error "missing 'when' between 'case' and '=>'"))
-        (+ (current-indentation) ada-indent)))
-     ;;
-     ;; case..is..when
-     ;;
-     ((save-excursion
-       (setq match-cons (ada-search-ignore-string-comment
-                         "\\<when\\>" nil orgpoint)))
-      (goto-char (cdr match-cons))
-      (+ (current-indentation) ada-broken-indent))
-     ;;
-     ;; case..is
-     ;;
-     ((save-excursion
-       (setq match-cons (ada-search-ignore-string-comment
-                         "\\<is\\>" nil orgpoint)))
-      (+ (current-indentation) ada-when-indent))
-     ;;
-     ;; incomplete case
-     ;;
-     (t
-      (+ (current-indentation) ada-broken-indent)))))
-
-
-(defun ada-get-indent-when (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of an when-statement.
-  (let ((cur-indent (current-indentation)))
-    (if (ada-search-ignore-string-comment
-         "[ \t\n]+=>" nil orgpoint)
-        (+ cur-indent  ada-indent)
-      (+ cur-indent ada-broken-indent))))
-
-
-(defun ada-get-indent-if (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of an if-statement.
-  (let ((cur-indent (current-indentation))
-        (match-cons nil))
-    ;;
-    ;; if..then ?
-    ;;
-    (if (ada-search-but-not
-         "\\<then\\>" "\\<and\\>[ \t\n]+\\<then\\>" nil orgpoint)
-
-        (progn
-          ;;
-          ;; 'then' first in separate line ?
-          ;; => indent according to 'then'
-          ;;
-          (if (save-excursion
-                (back-to-indentation)
-                (looking-at "\\<then\\>"))
-              (setq cur-indent (current-indentation)))
-          (forward-word 1)
-          ;;
-          ;; something follows 'then' ?
-          ;;
-          (if (setq match-cons
-                    (ada-search-ignore-string-comment
-                     "[^ \t\n]" nil orgpoint))
-              (progn
-                (goto-char (car match-cons))
-                (+ ada-indent
-                   (- cur-indent (current-indentation))
-                   (funcall (ada-indent-function t) orgpoint)))
-
-            (+ cur-indent ada-indent)))
-
-      (+ cur-indent ada-broken-indent))))
-
-
-(defun ada-get-indent-block-start (orgpoint)
-  ;; Returns the indentation (column #) for the new line after
-  ;; ORGPOINT.  Assumes point to be at the beginning of a block start
-  ;; keyword.
-  (let ((cur-indent (current-indentation))
-        (pos nil))
-    (cond
-     ((save-excursion
-        (forward-word 1)
-        (setq pos (car (ada-search-ignore-string-comment
-                        "[^ \t\n]" nil orgpoint))))
-      (goto-char pos)
-      (save-excursion
-        (funcall (ada-indent-function t) orgpoint)))
-     ;;
-     ;; nothing follows the block-start
-     ;;
-     (t
-      (+ (current-indentation) ada-indent)))))
-
-
-(defun ada-get-indent-subprog (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of a subprog-/package-declaration.
-  (let ((match-cons nil)
-        (cur-indent (current-indentation))
-        (foundis nil)
-        (addind 0)
-        (fstart (point)))
-    ;;
-    ;; is there an 'is' in front of point ?
-    ;;
-    (if (save-excursion
-          (setq match-cons
-                (ada-search-ignore-string-comment
-                 "\\<is\\>\\|\\<do\\>" nil orgpoint)))
-        ;;
-        ;; yes, then skip to its end
-        ;;
-        (progn
-          (setq foundis t)
-          (goto-char (cdr match-cons)))
-      ;;
-      ;; no, then goto next non-ws, if there is one in front of point
-      ;;
-      (progn
-        (if (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint)
-            (ada-goto-next-non-ws)
-          (goto-char orgpoint))))
-
-    (cond
-     ;;
-     ;; nothing follows 'is'
-     ;;
-     ((and
-       foundis
-       (save-excursion
-         (not (ada-search-ignore-string-comment
-               "[^ \t\n]" nil orgpoint t))))
-      (+ cur-indent ada-indent))
-     ;;
-     ;; is abstract/separate/new ...
-     ;;
-     ((and
-       foundis
-       (save-excursion
-         (setq match-cons
-               (ada-search-ignore-string-comment
-                "\\<\\(separate\\|new\\|abstract\\)\\>"
-                nil orgpoint))))
-      (goto-char (car match-cons))
-      (ada-search-ignore-string-comment ada-subprog-start-re t)
-      (ada-get-indent-noindent orgpoint))
-     ;;
-     ;; something follows 'is'
-     ;;
-     ((and
-       foundis
-       (save-excursion
-         (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))
-       (ada-goto-next-non-ws)
-      (funcall (ada-indent-function t) orgpoint)))
-     ;;
-     ;; no 'is' but ';'
-     ;;
-     ((save-excursion
-        (ada-search-ignore-string-comment ";" nil orgpoint))
-      cur-indent)
-     ;;
-     ;; no 'is' or ';'
-     ;;
-     (t
-      (+ cur-indent ada-broken-indent)))))
-
-
-(defun ada-get-indent-noindent (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of a 'noindent statement'.
-  (if (save-excursion
-        (ada-search-ignore-string-comment ";" nil orgpoint))
-      (current-indentation)
-    (+ (current-indentation) ada-broken-indent)))
-
-
-(defun ada-get-indent-label (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of a label or variable declaration.
-  ;; Checks the context to decide if it's a label or a variable declaration.
-  ;; This check might be a bit slow.
-  (let ((match-cons nil)
-        (cur-indent (current-indentation)))
-    (goto-char (cdr (ada-search-ignore-string-comment ":")))
-    (cond
-     ;;
-     ;; loop label
-     ;;
-     ((save-excursion
-        (setq match-cons (ada-search-ignore-string-comment
-                          ada-loop-start-re nil orgpoint)))
-      (goto-char (car match-cons))
-      (ada-get-indent-loop orgpoint))
-     ;;
-     ;; declare label
-     ;;
-     ((save-excursion
-        (setq match-cons (ada-search-ignore-string-comment
-                          "\\<declare\\>" nil orgpoint)))
-      (save-excursion
-        (goto-char (car match-cons))
-        (+ (current-indentation) ada-indent)))
-     ;;
-     ;; complete statement following colon
-     ;;
-     ((save-excursion
-        (ada-search-ignore-string-comment ";" nil orgpoint))
-      (if (ada-in-decl-p)
-          cur-indent                      ; variable-declaration
-        (- cur-indent ada-label-indent))) ; label
-     ;;
-     ;; broken statement
-     ;;
-     ((save-excursion
-        (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))
-      (if (ada-in-decl-p)
-          (+ cur-indent ada-broken-indent)
-        (+ cur-indent ada-broken-indent (- ada-label-indent))))
-     ;;
-     ;; nothing follows colon
-     ;;
-     (t
-      (if (ada-in-decl-p)
-          (+ cur-indent ada-broken-indent)   ; variable-declaration
-        (- cur-indent ada-label-indent)))))) ; label
-
-
-(defun ada-get-indent-loop (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of a loop statement
-  ;; or (unfortunately) also a for ... use statement.
-  (let ((match-cons nil)
-        (pos (point)))
-    (cond
-
-     ;;
-     ;; statement complete
-     ;;
-     ((save-excursion
-        (ada-search-ignore-string-comment ";" nil orgpoint))
-      (current-indentation))
-     ;;
-     ;; simple loop
-     ;;
-     ((looking-at "loop\\>")
-      (ada-get-indent-block-start orgpoint))
-
-     ;;
-     ;; 'for'- loop (or also a for ... use statement)
-     ;;
-     ((looking-at "for\\>")
-      (cond
-       ;;
-       ;; for ... use
-       ;;
-       ((save-excursion
-          (and
-           (goto-char (match-end 0))
-           (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint)
-           (not (backward-char 1))
-           (not (zerop (skip-chars-forward "_a-zA-Z0-9'")))
-           (ada-search-ignore-string-comment "[^ /n/t]" nil orgpoint)
-           (not (backward-char 1))
-           (looking-at "\\<use\\>")
-           ;;
-           ;; check if there is a 'record' before point
-           ;;
-           (progn
-             (setq match-cons (ada-search-ignore-string-comment
-                               "\\<record\\>" nil orgpoint))
-             t)))
-        (if match-cons
-            (goto-char (car match-cons)))
-        (+ (current-indentation) ada-indent))
-       ;;
-       ;; for..loop
-       ;;
-       ((save-excursion
-          (setq match-cons (ada-search-ignore-string-comment
-                            "\\<loop\\>" nil orgpoint)))
-        (goto-char (car match-cons))
-        ;;
-        ;; indent according to 'loop', if it's first in the line;
-        ;; otherwise to 'for'
-        ;;
-        (if (not (save-excursion
-                   (back-to-indentation)
-                   (looking-at "\\<loop\\>")))
-            (goto-char pos))
-        (+ (current-indentation) ada-indent))
-       ;;
-       ;; for-statement is broken
-       ;;
-       (t
-        (+ (current-indentation) ada-broken-indent))))
-
-     ;;
-     ;; 'while'-loop
-     ;;
-     ((looking-at "while\\>")
-      ;;
-      ;; while..loop ?
-      ;;
-      (if (save-excursion
-            (setq match-cons (ada-search-ignore-string-comment
-                              "\\<loop\\>" nil orgpoint)))
-
-          (progn
-            (goto-char (car match-cons))
-            ;;
-            ;; indent according to 'loop', if it's first in the line;
-            ;; otherwise to 'while'.
-            ;;
-            (if (not (save-excursion
-                       (back-to-indentation)
-                       (looking-at "\\<loop\\>")))
-                (goto-char pos))
-            (+ (current-indentation) ada-indent))
-
-        (+ (current-indentation) ada-broken-indent))))))
-
-
-(defun ada-get-indent-type (orgpoint)
-  ;; Returns the indentation (column #) for the new line after ORGPOINT.
-  ;; Assumes point to be at the beginning of a type statement.
-  (let ((match-dat nil))
-    (cond
-     ;;
-     ;; complete record declaration
-     ;;
-     ((save-excursion
-        (and
-         (setq match-dat (ada-search-ignore-string-comment "\\<end\\>"
-                                                           nil
-                                                           orgpoint))
-         (ada-goto-next-non-ws)
-         (looking-at "\\<record\\>")
-         (forward-word 1)
-         (ada-goto-next-non-ws)
-         (looking-at ";")))
-      (goto-char (car match-dat))
-      (current-indentation))
-     ;;
-     ;; record type
-     ;;
-     ((save-excursion
-        (setq match-dat (ada-search-ignore-string-comment "\\<record\\>"
-                                                          nil
-                                                          orgpoint)))
-      (goto-char (car match-dat))
-      (+ (current-indentation) ada-indent))
-     ;;
-     ;; complete type declaration
-     ;;
-     ((save-excursion
-        (ada-search-ignore-string-comment ";" nil orgpoint))
-      (current-indentation))
-     ;;
-     ;; "type ... is", but not "type ... is ...", which is broken
-     ;;
-     ((save-excursion
-	(and
-	 (ada-search-ignore-string-comment "\\<is\\>" nil orgpoint)
-	 (not (ada-search-ignore-string-comment "[^ \t\n]" nil orgpoint))))
-      (+ (current-indentation) ada-indent))
-     ;;
-     ;; broken statement
-     ;;
-     (t
-      (+ (current-indentation) ada-broken-indent)))))
-
-
-;;; ---- support-functions for indentation
-
-;;; ---- searching and matching
-
-(defun ada-goto-stmt-start (&optional limit)
-  ;; Moves point to the beginning of the statement that point is in or
-  ;; after.  Returns the new position of point.  Beginnings are found
-  ;; by searching for 'ada-end-stmt-re' and then moving to the
-  ;; following non-ws that is not a comment.  LIMIT is actually not
-  ;; used by the indentation functions.
-  (let ((match-dat nil)
-        (orgpoint (point)))
-
-    (setq match-dat (ada-search-prev-end-stmt limit))
-    (if match-dat
-        ;;
-        ;; found a previous end-statement => check if anything follows
-        ;;
-        (progn
-          (if (not
-               (save-excursion
-                 (goto-char (cdr match-dat))
-                 (ada-search-ignore-string-comment
-                  "[^ \t\n]" nil orgpoint)))
-              ;;
-              ;; nothing follows => it's the end-statement directly in
-              ;;                    front of point => search again
-              ;;
-              (setq match-dat (ada-search-prev-end-stmt limit)))
-          ;;
-          ;; if found the correct end-statement => goto next non-ws
-          ;;
-          (if match-dat
-              (goto-char (cdr match-dat)))
-          (ada-goto-next-non-ws))
-
-      ;;
-      ;; no previous end-statement => we are at the beginning of the
-      ;;                              accessible part of the buffer
-      ;;
-      (progn
-        (goto-char (point-min))
-        ;;
-        ;; skip to the very first statement, if there is one
-        ;;
-        (if (setq match-dat
-                  (ada-search-ignore-string-comment
-                   "[^ \t\n]" nil orgpoint))
-            (goto-char (car match-dat))
-          (goto-char orgpoint))))
-
-
-    (point)))
-
-
-(defun ada-search-prev-end-stmt (&optional limit)
-  ;; Moves point to previous end-statement.  Returns a cons cell whose
-  ;; car is the beginning and whose cdr the end of the match.
-  ;; End-statements are defined by 'ada-end-stmt-re'.  Checks for
-  ;; certain keywords if they follow 'end', which means they are no
-  ;; end-statement there.
-  (interactive) ;; DEBUG
-  (let ((match-dat nil)
-        (pos nil)
-        (found nil))
-    ;;
-    ;; search until found or beginning-of-buffer
-    ;;
-    (while
-        (and
-         (not found)
-         (setq match-dat (ada-search-ignore-string-comment ada-end-stmt-re
-                                                           t
-                                                           limit)))
-
-      (goto-char (car match-dat))
-
-      (if (not (ada-in-open-paren-p))
-          ;;
-          ;; check if there is an 'end' in front of the match
-          ;;
-          (if (not (and
-                    (looking-at "\\<\\(record\\|loop\\|select\\)\\>")
-                    (save-excursion
-                      (ada-goto-previous-word)
-                      (looking-at "\\<end\\>"))))
-              (setq found t)
-
-            (forward-word -1)))) ; end of loop
-
-    (if found
-        match-dat
-      nil)))
-
-
-(defun ada-goto-next-non-ws (&optional limit)
-  ;; Skips whitespaces, newlines and comments to next non-ws
-  ;; character.  Signals an error if there is no more such character
-  ;; and limit is nil.
-  (let ((match-cons nil))
-    (setq match-cons (ada-search-ignore-string-comment
-                      "[^ \t\n]" nil limit t))
-    (if match-cons
-        (goto-char (car match-cons))
-      (if (not limit)
-          (error "no more non-ws")
-        nil))))
-
-
-(defun ada-goto-stmt-end (&optional limit)
-  ;; Moves point to the end of the statement that point is in or
-  ;; before.  Returns the new position of point or nil if not found.
-  (if (ada-search-ignore-string-comment ada-end-stmt-re nil limit)
-      (point)
-    nil))
-
-
-(defun ada-goto-previous-word ()
-  ;; Moves point to the beginning of the previous word of Ada code.
-  ;; Returns the new position of point or nil if not found.
-  (let ((match-cons nil)
-        (orgpoint (point)))
-    (if (setq match-cons
-              (ada-search-ignore-string-comment "[^ \t\n]" t nil t))
-        ;;
-        ;; move to the beginning of the word found
-        ;;
-        (progn
-          (goto-char (cdr match-cons))
-          (skip-chars-backward "_a-zA-Z0-9")
-          (point))
-      ;;
-      ;; if not found, restore old position of point
-      ;;
-      (progn
-        (goto-char orgpoint)
-        'nil))))
-
-
-(defun ada-check-matching-start (keyword)
-  ;; Signals an error if matching block start is not KEYWORD.
-  ;; Moves point to the matching block start.
-  (ada-goto-matching-start 0)
-  (if (not (looking-at (concat "\\<" keyword "\\>")))
-      (error "matching start is not '%s'" keyword)))
-
-
-(defun ada-check-defun-name (defun-name)
-  ;; Checks if the name of the matching defun really is DEFUN-NAME.
-  ;; Assumes point to be already positioned by 'ada-goto-matching-start'.
-  ;; Moves point to the beginning of the declaration.
-
-  ;;
-  ;; 'accept' or 'package' ?
-  ;;
-  (if (not (looking-at "\\<\\(accept\\|package\\|task\\|protected\\)\\>"))
-      (ada-goto-matching-decl-start))
-  ;;
-  ;; 'begin' of 'procedure'/'function'/'task' or 'declare'
-  ;;
-  (save-excursion
-    ;;
-    ;; a named 'declare'-block ?
-    ;;
-    (if (looking-at "\\<declare\\>")
-        (ada-goto-stmt-start)
-      ;;
-      ;; no, => 'procedure'/'function'/'task'/'protected'
-      ;;
-      (progn
-        (forward-word 2)
-        (backward-word 1)
-        ;;
-        ;; skip 'body' 'protected' 'type'
-        ;;
-        (if (looking-at "\\<\\(body\\|type\\)\\>")
-            (forward-word 1))
-        (forward-sexp 1)
-        (backward-sexp 1)))
-    ;;
-    ;; should be looking-at the correct name
-    ;;
-    (if (not (looking-at (concat "\\<" defun-name "\\>")))
-        (error "matching defun has different name: %s"
-	       (buffer-substring (point)
-				 (progn (forward-sexp 1) (point)))))))
-
-
-(defun ada-goto-matching-decl-start (&optional noerror nogeneric)
-  ;; Moves point to the matching declaration start of the current 'begin'.
-  ;; If NOERROR is non-nil, it only returns nil if no match was found.
-  (interactive) ;; DEBUG
-  (let ((nest-count 1)
-        (pos nil)
-        (first t)
-        (flag nil))
-    ;;
-    ;; search backward for interesting keywords
-    ;;
-    (while (and
-            (not (zerop nest-count))
-            (ada-search-ignore-string-comment
-             (concat "\\<\\("
-                     "is\\|separate\\|end\\|declare\\|new\\|begin\\|generic"
-                     "\\)\\>") t))
-      ;;
-      ;; calculate nest-depth
-      ;;
-      (cond
-       ;;
-       ((looking-at "end")
-        (ada-goto-matching-start 1 noerror)
-        (if (looking-at "begin")
-            (setq nest-count (1+ nest-count))))
-       ;;
-       ((looking-at "declare\\|generic")
-        (setq nest-count (1- nest-count))
-        (setq first nil))
-       ;;
-       ((looking-at "is")
-        ;; check if it is only a type definition, but not a protected
-        ;; type definition, which should be handled like a procedure.
-        (if (save-excursion
-              (ada-goto-previous-word)
-              (skip-chars-backward "a-zA-Z0-9_.'")
-              (if (save-excursion
-                    (backward-char 1)
-                    (looking-at ")"))
-                  (progn
-                    (forward-char 1)
-                    (backward-sexp 1)
-                    (skip-chars-backward "a-zA-Z0-9_.'")
-                    ))
-              (ada-goto-previous-word)
-              (and 
-               (looking-at "\\<type\\>")
-               (save-match-data
-                 (ada-goto-previous-word)
-                 (not (looking-at "\\<protected\\>"))))
-              ); end of save-excursion
-            (goto-char (match-beginning 0))
-          (progn
-            (setq nest-count (1- nest-count))
-            (setq first nil))))
-
-       ;;
-       ((looking-at "new")
-        (if (save-excursion
-              (ada-goto-previous-word)
-              (looking-at "is"))
-            (goto-char (match-beginning 0))))
-       ;;
-       ((and first
-             (looking-at "begin"))
-        (setq nest-count 0)
-        (setq flag t))
-       ;;
-       (t
-        (setq nest-count (1+ nest-count))
-        (setq first nil)))
-
-      )  ;; end of loop
-
-    ;; check if declaration-start is really found
-    (if (not
-         (and
-          (zerop nest-count)
-          (not flag)
-          (progn
-            (if (looking-at "is")
-                  (ada-search-ignore-string-comment
-                   ada-subprog-start-re t)
-              (looking-at "declare\\|generic")))))
-        (if noerror nil
-          (error "no matching proc/func/task/declare/package/protected"))
-      t)))
-
-
-(defun ada-goto-matching-start (&optional nest-level noerror gotothen)
-  ;; Moves point to the beginning of a block-start.  Which block
-  ;; depends on the value of NEST-LEVEL, which defaults to zero.  If
-  ;; NOERROR is non-nil, it only returns nil if no matching start was
-  ;; found.  If GOTOTHEN is non-nil, point moves to the 'then'
-  ;; following 'if'.
-  (let ((nest-count (if nest-level nest-level 0))
-        (found nil)
-        (pos nil))
-
-    ;;
-    ;; search backward for interesting keywords
-    ;;
-    (while (and
-            (not found)
-            (ada-search-ignore-string-comment
-             (concat "\\<\\("
-                     "end\\|loop\\|select\\|begin\\|case\\|do\\|"
-                     "if\\|task\\|package\\|record\\|protected\\)\\>")
-             t))
-
-      ;;
-      ;; calculate nest-depth
-      ;;
-      (cond
-       ;; found block end => increase nest depth
-       ((looking-at "end")
-        (setq nest-count (1+ nest-count)))
-       ;; found loop/select/record/case/if => check if it starts or
-       ;; ends a block
-       ((looking-at "loop\\|select\\|record\\|case\\|if")
-        (setq pos (point))
-        (save-excursion
-          ;;
-          ;; check if keyword follows 'end'
-          ;;
-          (ada-goto-previous-word)
-          (if (looking-at "\\<end\\>")
-              ;; it ends a block => increase nest depth
-              (progn
-                (setq nest-count (1+ nest-count))
-                (setq pos (point)))
-            ;; it starts a block => decrease nest depth
-            (setq nest-count (1- nest-count))))
-        (goto-char pos))
-       ;; found package start => check if it really is a block
-       ((looking-at "package")
-        (save-excursion
-          (ada-search-ignore-string-comment "\\<is\\>")
-          (ada-goto-next-non-ws)
-          ;; ignore it if it is only a declaration with 'new'
-          (if (not (looking-at "\\<new\\>"))
-              (setq nest-count (1- nest-count)))))
-       ;; found task start => check if it has a body
-       ((looking-at "task")
-        (save-excursion
-          (forward-word 1)
-          (ada-goto-next-non-ws)
-          ;; ignore it if it has no body
-          (if (not (looking-at "\\<body\\>"))
-              (setq nest-count (1- nest-count)))))
-       ;; all the other block starts
-       (t
-        (setq nest-count (1- nest-count)))) ; end of 'cond'
-
-      ;; match is found, if nest-depth is zero
-      ;;
-      (setq found (zerop nest-count))) ; end of loop
-
-    (if found
-        ;;
-        ;; match found => is there anything else to do ?
-        ;;
-        (progn
-          (cond
-           ;;
-           ;; found 'if' => skip to 'then', if it's on a separate line
-           ;;                               and GOTOTHEN is non-nil
-           ;;
-           ((and
-             gotothen
-             (looking-at "if")
-             (save-excursion
-               (ada-search-ignore-string-comment "\\<then\\>" nil nil)
-               (back-to-indentation)
-               (looking-at "\\<then\\>")))
-            (goto-char (match-beginning 0)))
-           ;;
-           ;; found 'do' => skip back to 'accept'
-           ;;
-           ((looking-at "do")
-            (if (not (ada-search-ignore-string-comment "\\<accept\\>" t nil))
-                (error "missing 'accept' in front of 'do'"))))
-          (point))
-
-      (if noerror
-          nil
-        (error "no matching start")))))
-
-
-(defun ada-goto-matching-end (&optional nest-level noerror)
-  ;; Moves point to the end of a block.  Which block depends on the
-  ;; value of NEST-LEVEL, which defaults to zero.  If NOERROR is
-  ;; non-nil, it only returns nil if found no matching start.
-  (let ((nest-count (if nest-level nest-level 0))
-        (found nil))
-
-    ;;
-    ;; search forward for interesting keywords
-    ;;
-    (while (and
-            (not found)
-            (ada-search-ignore-string-comment
-             (concat "\\<\\(end\\|loop\\|select\\|begin\\|case\\|"
-                     "if\\|task\\|package\\|record\\|do\\)\\>")))
-
-      ;;
-      ;; calculate nest-depth
-      ;;
-      (backward-word 1)
-      (cond
-       ;; found block end => decrease nest depth
-       ((looking-at "\\<end\\>")
-        (setq nest-count (1- nest-count))
-        ;; skip the following keyword
-        (if (progn
-              (skip-chars-forward "end")
-              (ada-goto-next-non-ws)
-              (looking-at "\\<\\(loop\\|select\\|record\\|case\\|if\\)\\>"))
-            (forward-word 1)))
-       ;; found package start => check if it really starts a block
-       ((looking-at "\\<package\\>")
-        (ada-search-ignore-string-comment "\\<is\\>")
-        (ada-goto-next-non-ws)
-        ;; ignore and skip it if it is only a 'new' package
-        (if (not (looking-at "\\<new\\>"))
-            (setq nest-count (1+ nest-count))
-          (skip-chars-forward "new")))
-       ;; all the other block starts
-       (t
-        (setq nest-count (1+ nest-count))
-        (forward-word 1))) ; end of 'cond'
-
-      ;; match is found, if nest-depth is zero
-      ;;
-      (setq found (zerop nest-count))) ; end of loop
-
-    (if (not found)
-        (if noerror
-            nil
-          (error "no matching end"))
-      t)))
-
-
-(defun ada-forward-sexp-ignore-comment ()
-  ;; Skips one sexp forward, ignoring comments.
-  (while (looking-at "[ \t\n]*--")
-    (skip-chars-forward "[ \t\n]")
-    (end-of-line))
-  (forward-sexp 1))
-
-
-(defun ada-search-ignore-string-comment
-  (search-re &optional backward limit paramlists)
-  ;; Regexp-Search for SEARCH-RE, ignoring comments, strings and
-  ;; parameter lists, if PARAMLISTS is nil. Returns a cons cell of
-  ;; begin and end of match data or nil, if not found.
-  (let ((found nil)
-        (begin nil)
-        (end nil)
-        (pos nil)
-        (search-func
-         (if backward 're-search-backward
-           're-search-forward)))
-
-    ;;
-    ;; search until found or end-of-buffer
-    ;;
-    (while (and (not found)
-                (funcall search-func search-re limit 1))
-      (setq begin (match-beginning 0))
-      (setq end (match-end 0))
-
-      (cond
-       ;;
-       ;; found in comment => skip it
-       ;;
-       ((ada-in-comment-p)
-        (if backward
-            (progn
-              (re-search-backward "--" nil 1)
-              (goto-char (match-beginning 0)))
-          (progn
-            (forward-line 1)
-            (beginning-of-line))))
-       ;;
-       ;; found in string => skip it
-       ;;
-       ((ada-in-string-p)
-        (if backward
-            (progn
-              (re-search-backward "\"" nil 1) ; "\"\\|#" don't treat #
-              (goto-char (match-beginning 0))))
-        (re-search-forward "\"" nil 1))
-       ;;
-       ;; found character constant => ignore it
-       ;;
-       ((save-excursion
-          (setq pos (- (point) (if backward 1 2)))
-          (and (char-after pos)
-               (= (char-after pos) ?')
-               (= (char-after (+ pos 2)) ?')))
-        ())
-       ;;
-       ;; found a parameter-list but should ignore it => skip it
-       ;;
-       ((and (not paramlists)
-             (ada-in-paramlist-p))
-        (if backward
-            (ada-search-ignore-string-comment "(" t nil t)))
-       ;;
-       ;; directly in front of a comment => skip it, if searching forward
-       ;;
-       ((save-excursion
-          (goto-char begin)
-          (looking-at "--"))
-        (if (not backward)
-            (progn
-              (forward-line 1)
-              (beginning-of-line))))
-       ;;
-       ;; found what we were looking for
-       ;;
-       (t
-        (setq found t)))) ; end of loop
-
-    (if found
-        (cons begin end)
-      nil)))
-
-
-(defun ada-search-but-not (search-re not-search-re &optional backward limit)
-  ;; Searches SEARCH-RE, ignoring parts of NOT-SEARCH-RE, strings,
-  ;; comments and parameter-lists.
-  (let ((begin nil)
-        (end nil)
-        (begin-not nil)
-        (begin-end nil)
-        (end-not nil)
-        (ret-cons nil)
-        (found nil))
-
-    ;;
-    ;; search until found or end-of-buffer
-    ;;
-    (while (and
-            (not found)
-            (save-excursion
-              (setq ret-cons
-                    (ada-search-ignore-string-comment search-re
-                                                      backward limit))
-              (if (consp ret-cons)
-                  (progn
-                    (setq begin (car ret-cons))
-                    (setq end (cdr ret-cons))
-                    t)
-                nil)))
-
-      (if (or
-           ;;
-           ;; if no NO-SEARCH-RE was found
-           ;;
-           (not
-            (save-excursion
-              (setq ret-cons
-                    (ada-search-ignore-string-comment not-search-re
-                                                      backward nil))
-              (if (consp ret-cons)
-                  (progn
-                    (setq begin-not (car ret-cons))
-                    (setq end-not (cdr ret-cons))
-                    t)
-                nil)))
-           ;;
-           ;;  or this NO-SEARCH-RE is not a part of the SEARCH-RE
-           ;;  found before.
-           ;;
-           (or
-            (<= end-not begin)
-            (>= begin-not end)))
-
-          (setq found t)
-
-        ;;
-        ;; not found the correct match => skip this match
-        ;;
-        (goto-char (if backward
-                       begin
-                     end)))) ; end of loop
-
-    (if found
-        (progn
-          (goto-char begin)
-          (cons begin end))
-      nil)))
-
-
-(defun ada-goto-prev-nonblank-line ( &optional ignore-comment)
-  ;; Moves point to the beginning of previous non-blank line,
-  ;; ignoring comments if IGNORE-COMMENT is non-nil.
-  ;; It returns t if a matching line was found.
-  (let ((notfound t)
-        (newpoint nil))
-
-    (save-excursion
-      ;;
-      ;; backward one line, if there is one
-      ;;
-      (if (zerop (forward-line -1))
-          ;;
-          ;; there is some kind of previous line
-          ;;
-          (progn
-            (beginning-of-line)
-            (setq newpoint (point))
-
-            ;;
-            ;; search until found or beginning-of-buffer
-            ;;
-            (while (and (setq notfound
-                              (or (looking-at "[ \t]*$")
-                                  (and (looking-at "[ \t]*--")
-                                       ignore-comment)))
-                        (not (ada-in-limit-line-p)))
-              (forward-line -1)
-              ;;(beginning-of-line)
-              (setq newpoint (point))) ; end of loop
-
-            )) ; end of if
-
-      ) ; end of save-excursion
-
-    (if notfound nil
-      (progn
-        (goto-char newpoint)
-        t))))
-
-
-(defun ada-goto-next-nonblank-line ( &optional ignore-comment)
-  ;; Moves point to next non-blank line,
-  ;; ignoring comments if IGNORE-COMMENT is non-nil.
-  ;; It returns t if a matching line was found.
-  (let ((notfound t)
-        (newpoint nil))
-
-    (save-excursion
-    ;;
-    ;; forward one line
-    ;;
-      (if (zerop (forward-line 1))
-          ;;
-          ;; there is some kind of previous line
-          ;;
-          (progn
-            (beginning-of-line)
-            (setq newpoint (point))
-
-            ;;
-            ;; search until found or end-of-buffer
-            ;;
-            (while (and (setq notfound
-                              (or (looking-at "[ \t]*$")
-                                  (and (looking-at "[ \t]*--")
-                                       ignore-comment)))
-                        (not (ada-in-limit-line-p)))
-              (forward-line 1)
-              (beginning-of-line)
-              (setq newpoint (point))) ; end of loop
-
-            )) ; end of if
-
-      ) ; end of save-excursion
-
-    (if notfound nil
-      (progn
-        (goto-char newpoint)
-        t))))
-
-
-;; ---- boolean functions for indentation
-
-(defun ada-in-decl-p ()
-  ;; Returns t if point is inside a declarative part.
-  ;; Assumes point to be at the end of a statement.
-  (or
-   (ada-in-paramlist-p)
-   (save-excursion
-     (ada-goto-matching-decl-start t))))
-
-
-(defun ada-looking-at-semi-or ()
-  ;; Returns t if looking-at an 'or' following a semicolon.
-  (save-excursion
-    (and (looking-at "\\<or\\>")
-         (progn
-           (forward-word 1)
-           (ada-goto-stmt-start)
-           (looking-at "\\<or\\>")))))
-
-
-(defun ada-looking-at-semi-private ()
-  ;; Returns t if looking-at an 'private' following a semicolon.
-  (save-excursion
-    (and (looking-at "\\<private\\>")
-         (progn
-           (forward-word 1)
-           (ada-goto-stmt-start)
-           (looking-at "\\<private\\>")))))
-
-
-;;; make a faster??? ada-in-limit-line-p not using count-lines
-(defun ada-in-limit-line-p ()
-  ;; return t if point is in first or last accessible line.
-  (or (save-excursion (beginning-of-line) (= (point-min) (point)))
-      (save-excursion (end-of-line) (= (point-max) (point)))))
-
-
-(defun ada-in-comment-p ()
-  ;; Returns t if inside a comment.
-  ;; (save-excursion (and (re-search-backward "\\(--\\|\n\\)" nil 1)
-  ;;                     (looking-at "-"))))
-  (nth 4 (parse-partial-sexp
-          (save-excursion (beginning-of-line) (point))
-          (point))))
-
-
-
-(defun ada-in-string-p ()
-  ;; Returns t if point is inside a string
-  ;; (Taken from pascal-mode.el, modified by MH).
-  (save-excursion
-    (and
-     (nth 3 (parse-partial-sexp
-             (save-excursion
-               (beginning-of-line)
-               (point)) (point)))
-     ;; check if 'string quote' is only a character constant
-     (progn
-       (re-search-backward "\"" nil t) ; # not a string delimiter anymore
-       (not (= (char-after (1- (point))) ?'))))))
-
-
-(defun ada-in-string-or-comment-p ()
-  ;; Returns t if point is inside a string or a comment.
-  (or (ada-in-comment-p)
-      (ada-in-string-p)))
-
-
-(defun ada-in-paramlist-p ()
-  ;; Returns t if point is inside a parameter-list
-  ;; following 'function'/'procedure'/'package'.
-  (save-excursion
-    (and
-     (re-search-backward "(\\|)" nil t)
-     ;; inside parentheses ?
-     (looking-at "(")
-     (backward-word 2)
-     ;; right keyword before parenthesis ?
-     (looking-at (concat "\\<\\("
-                         "procedure\\|function\\|body\\|package\\|"
-                         "task\\|entry\\|accept\\)\\>"))
-     (re-search-forward ")\\|:" nil t)
-     ;; at least one ':' inside the parentheses ?
-     (not (backward-char 1))
-     (looking-at ":"))))
-
-
-;; not really a boolean function ...
-(defun ada-in-open-paren-p ()
-  ;; If point is somewhere behind an open parenthesis not yet closed,
-  ;; it returns the column # of the first non-ws behind this open
-  ;; parenthesis, otherwise nil."
-
-  (let ((start (if (< (point) ada-search-paren-char-count-limit)
-                   1
-                 (- (point) ada-search-paren-char-count-limit)))
-        parse-result
-        (col nil))
-    (setq parse-result (parse-partial-sexp start (point)))
-    (if (nth 1 parse-result)
-        (save-excursion
-          (goto-char (1+ (nth 1 parse-result)))
-          (if (save-excursion
-                (re-search-forward "[^ \t]" nil 1)
-                (backward-char 1)
-                (and
-                 (not (looking-at "\n"))
-                 (setq col (current-column))))
-              col
-            (current-column)))
-      nil)))
-
-
-
-;;;----------------------;;;
-;;; Behaviour Of TAB Key ;;;
-;;;----------------------;;;
-
-(defun ada-tab ()
-  "Do indenting or tabbing according to `ada-tab-policy'."
-  (interactive)
-  (cond ((eq ada-tab-policy 'indent-and-tab) (error "not implemented"))
-        ;; ada-indent-and-tab
-        ((eq ada-tab-policy 'indent-rigidly) (ada-tab-hard))
-        ((eq ada-tab-policy 'indent-auto) (ada-indent-current))
-        ((eq ada-tab-policy 'gei) (ada-tab-gei))
-        ((eq ada-tab-policy 'indent-af) (af-indent-line)) ; GEB
-        ((eq ada-tab-policy 'always-tab) (error "not implemented"))
-        ))
-
-
-(defun ada-untab (arg)
-  "Delete leading indenting according to `ada-tab-policy'."
-  (interactive "P")
-  (cond ((eq ada-tab-policy 'indent-rigidly) (ada-untab-hard))
-        ((eq ada-tab-policy 'indent-af) (backward-delete-char-untabify ; GEB
-                                         (prefix-numeric-value arg) ; GEB
-                                         arg)) ; GEB
-        ((eq ada-tab-policy 'indent-auto) (error "not implemented"))
-        ((eq ada-tab-policy 'always-tab) (error "not implemented"))
-        ))
-
-
-(defun ada-indent-current-function ()
-  "Ada Mode version of the indent-line-function."
-  (interactive "*")
-  (let ((starting-point (point-marker)))
-    (ada-beginning-of-line)
-    (ada-tab)
-    (if (< (point) starting-point)
-        (goto-char starting-point))
-    (set-marker starting-point nil)
-    ))
-
-
-(defun ada-tab-hard ()
-  "Indent current line to next tab stop."
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (insert-char ?  ada-indent))
-  (if (save-excursion (= (point) (progn (beginning-of-line) (point))))
-      (forward-char ada-indent)))
-
-
-(defun ada-untab-hard ()
-  "indent current line to previous tab stop."
-  (interactive)
-  (let  ((bol (save-excursion (progn (beginning-of-line) (point))))
-        (eol (save-excursion (progn (end-of-line) (point)))))
-    (indent-rigidly bol eol  (- 0 ada-indent))))
-
-
-
-;;;---------------;;;
-;;; Miscellaneous ;;;
-;;;---------------;;;
-
-(defun ada-remove-trailing-spaces  ()
- "remove trailing spaces in the whole buffer."
-  (interactive)
-  (save-match-data
-  (save-excursion
-      (save-restriction
-        (widen)
-    (goto-char (point-min))
-        (while (re-search-forward "[ \t]+$" (point-max) t)
-          (replace-match "" nil nil))))))
-
-
-(defun ada-untabify-buffer ()
-;; change all tabs to spaces
-  (save-excursion
-    (untabify (point-min) (point-max))))
-
-
-(defun ada-uncomment-region (beg end)
-  "delete `comment-start' at the beginning of a line in the region."
-  (interactive "r")
-  (comment-region beg end -1))
-
-
-;; define a function to support find-file.el if loaded
-(defun ada-ff-other-window ()
-  "Find other file in other window using `ff-find-other-file'."
-  (interactive)
-  (and (fboundp 'ff-find-other-file)
-       (ff-find-other-file t)))
-
-
-;;;-------------------------------;;;
-;;; Moving To Procedures/Packages ;;;
-;;;-------------------------------;;;
-
-(defun ada-next-procedure ()
-  "Moves point to next procedure."
-  (interactive)
-  (end-of-line)
-  (if (re-search-forward ada-procedure-start-regexp nil t)
-      (goto-char (match-beginning 1))
-    (error "No more functions/procedures/tasks")))
-
-(defun ada-previous-procedure ()
-  "Moves point to previous procedure."
-  (interactive)
-  (beginning-of-line)
-  (if (re-search-backward ada-procedure-start-regexp nil t)
-      (goto-char (match-beginning 1))
-    (error "No more functions/procedures/tasks")))
-
-(defun ada-next-package ()
-  "Moves point to next package."
-  (interactive)
-  (end-of-line)
-  (if (re-search-forward ada-package-start-regexp nil t)
-      (goto-char (match-beginning 1))
-    (error "No more packages")))
-
-(defun ada-previous-package ()
-  "Moves point to previous package."
-  (interactive)
-  (beginning-of-line)
-  (if (re-search-backward ada-package-start-regexp nil t)
-      (goto-char (match-beginning 1))
-    (error "No more packages")))
-
-
-;;;-----------------------
-;;; define keymap for Ada
-;;;-----------------------
-
-(if (not ada-mode-map)
-    (progn
-      (setq ada-mode-map (make-sparse-keymap))
-
-      ;; Indentation and Formatting
-      (define-key ada-mode-map "\C-j"     'ada-indent-newline-indent)
-      (define-key ada-mode-map "\t"       'ada-tab)
-      (define-key ada-mode-map "\C-c\C-l" 'ada-indent-region)
-      (if (ada-xemacs)
-	  (define-key ada-mode-map '(shift tab)    'ada-untab)
-	(define-key ada-mode-map [S-tab]    'ada-untab))
-      (define-key ada-mode-map "\C-c\C-f" 'ada-format-paramlist)
-      (define-key ada-mode-map "\C-c\C-p" 'ada-call-pretty-printer)
-;;; We don't want to make meta-characters case-specific.
-;;;   (define-key ada-mode-map "\M-Q"     'ada-fill-comment-paragraph-justify)
-      (define-key ada-mode-map "\M-\C-q"  'ada-fill-comment-paragraph-postfix)
-
-      ;; Movement
-;;; It isn't good to redefine these.  What should be done instead?  -- rms.
-;;;   (define-key ada-mode-map "\M-e"     'ada-next-package)
-;;;   (define-key ada-mode-map "\M-a"     'ada-previous-package)
-      (define-key ada-mode-map "\M-\C-e"  'ada-next-procedure)
-      (define-key ada-mode-map "\M-\C-a"  'ada-previous-procedure)
-      (define-key ada-mode-map "\C-c\C-a" 'ada-move-to-start)
-      (define-key ada-mode-map "\C-c\C-e" 'ada-move-to-end)
-
-      ;; Compilation
-      (define-key ada-mode-map "\C-c\C-c" 'compile)
-
-      ;; Casing
-      (define-key ada-mode-map "\C-c\C-r" 'ada-adjust-case-region)
-      (define-key ada-mode-map "\C-c\C-b" 'ada-adjust-case-buffer)
-
-      (define-key ada-mode-map "\177"     'backward-delete-char-untabify)
-
-      ;; Use predefined function of emacs19 for comments (RE)
-      (define-key ada-mode-map "\C-c;"    'comment-region)
-      (define-key ada-mode-map "\C-c:"    'ada-uncomment-region)
-
-      ;; Change basic functionality
-
-      ;; `substitute-key-definition' is not defined equally in GNU Emacs
-      ;; and XEmacs, you cannot put in an optional 4th parameter in
-      ;; XEmacs.  I don't think it's necessary, so I leave it out for
-      ;; GNU Emacs as well.  If you encounter any problems with the
-      ;; following three functions, please tell me. RE
-      (mapcar (function (lambda (pair)
-			  (substitute-key-definition (car pair) (cdr pair)
-						     ada-mode-map)))
-	      '((beginning-of-line      . ada-beginning-of-line)
-		(end-of-line            . ada-end-of-line)
-		(forward-to-indentation . ada-forward-to-indentation)
-		))
-      ;; else GNU Emacs
-      ;;(mapcar (lambda (pair)
-      ;;             (substitute-key-definition (car pair) (cdr pair)
-      ;;				   ada-mode-map global-map))
-
-      ))
-
-
-;;;-------------------
-;;; define menu 'Ada'
-;;;-------------------
-
-(require 'easymenu)
-
-(defun ada-add-ada-menu ()
-  "Adds the menu 'Ada' to the menu bar in Ada Mode."
-  (easy-menu-define ada-mode-menu ada-mode-map "Menu keymap for Ada mode."
-                    '("Ada"
-                      ["Next Package" ada-next-package t]
-                      ["Previous Package" ada-previous-package t]
-                      ["Next Procedure" ada-next-procedure t]
-                      ["Previous Procedure" ada-previous-procedure t]
-                      ["Goto Start" ada-move-to-start t]
-                      ["Goto End" ada-move-to-end t]
-                      ["------------------" nil nil]
-                      ["Indent Current Line (TAB)"
-                       ada-indent-current-function t]
-                      ["Indent Lines in Region" ada-indent-region t]
-                      ["Format Parameter List" ada-format-paramlist t]
-                      ["Pretty Print Buffer" ada-call-pretty-printer t]
-                      ["------------" nil nil]
-                      ["Fill Comment Paragraph"
-                       ada-fill-comment-paragraph t]
-                      ["Justify Comment Paragraph"
-                       ada-fill-comment-paragraph-justify t]
-                      ["Postfix Comment Paragraph"
-                       ada-fill-comment-paragraph-postfix t]
-                      ["------------" nil nil]
-                      ["Adjust Case Region" ada-adjust-case-region t]
-                      ["Adjust Case Buffer" ada-adjust-case-buffer t]
-                      ["----------" nil nil]
-                      ["Comment   Region" comment-region t]
-                      ["Uncomment Region" ada-uncomment-region t]
-                      ["----------------" nil nil]
-                      ["Compile" compile (fboundp 'compile)]
-                      ["Next Error" next-error (fboundp 'next-error)]
-                      ["---------------" nil nil]
-                      ["Index" imenu (fboundp 'imenu)]
-                      ["--------------" nil nil]
-                      ["Other File Other Window" ada-ff-other-window
-                       (fboundp 'ff-find-other-file)]
-                      ["Other File" ff-find-other-file
-                       (fboundp 'ff-find-other-file)]))
-  (if (ada-xemacs) (progn
-                     (easy-menu-add ada-mode-menu)
-                     (setq mode-popup-menu (cons "Ada Mode" ada-mode-menu)))))
-
-
-
-;;;-------------------------------
-;;; Define Some Support Functions
-;;;-------------------------------
-
-(defun ada-beginning-of-line (&optional arg)
-  (interactive "P")
-  (cond
-   ((eq ada-tab-policy 'indent-af) (af-beginning-of-line arg))
-   (t (beginning-of-line arg))
-   ))
-
-(defun ada-end-of-line (&optional arg)
-  (interactive "P")
-  (cond
-   ((eq ada-tab-policy 'indent-af) (af-end-of-line arg))
-   (t (end-of-line arg))
-   ))
-
-(defun ada-current-column ()
-  (cond
-   ((eq ada-tab-policy 'indent-af) (af-current-column))
-   (t (current-column))
-   ))
-
-(defun ada-forward-to-indentation (&optional arg)
-  (interactive "P")
-  (cond
-   ((eq ada-tab-policy 'indent-af) (af-forward-to-indentation arg))
-   (t (forward-to-indentation arg))
-   ))
-
-;;;---------------------------------------------------
-;;; support for find-file
-;;;---------------------------------------------------
-
-
-;;;###autoload
-(defun ada-make-filename-from-adaname (adaname)
-  "Determine the filename of a package/procedure from its own Ada name."
-  ;; this is done simply by calling gkrunch, when we work with GNAT. It
-  ;; must be a more complex function in other compiler environments.
-  (interactive "s")
-
-  ;; things that should really be done by the external process
-  ;; since gnat-2.0, gnatk8 can do these things. If you still use a
-  ;; previous version, just uncomment the following lines.
-  (let (krunch-buf)
-    (setq krunch-buf (generate-new-buffer "*gkrunch*"))
-    (save-excursion
-      (set-buffer krunch-buf)
-;      (insert (downcase adaname))
-;      (goto-char (point-min))
-;      (while (search-forward "." nil t)
-;        (replace-match "-" nil t))
-;      (setq adaname (buffer-substring (point-min)
-;                                      (progn
-;                                        (goto-char (point-min))
-;                                        (end-of-line)
-;                                        (point))))
-;      ;; clean the buffer
-;      (delete-region (point-min) (point-max))
-      ;; send adaname to external process "gnatk8"
-      (call-process "gnatk8" nil krunch-buf nil
-                    adaname ada-krunch-args)
-      ;; fetch output of that process
-      (setq adaname (buffer-substring
-                     (point-min)
-                     (progn
-                       (goto-char (point-min))
-                       (end-of-line)
-                       (point))))
-      (kill-buffer krunch-buf)))
-  (setq adaname adaname) ;; can I avoid this statement?
-  )
-
-
-;;; functions for placing the cursor on the corresponding subprogram
-(defun ada-which-function-are-we-in ()
-  "Determine whether we are on a function definition/declaration.
-If that is the case remember the name of that function."
-
-  (setq ff-function-name nil)
-
-  (save-excursion
-    (if (re-search-backward ada-procedure-start-regexp nil t)
-	(setq ff-function-name (buffer-substring (match-beginning 0)
-						 (match-end 0)))
-      ; we didn't find a procedure start, perhaps there is a package
-      (if (re-search-backward ada-package-start-regexp nil t)
-	  (setq ff-function-name (buffer-substring (match-beginning 0)
-						   (match-end 0)))
-	))))
-
-
-;;;---------------------------------------------------
-;;; support for imenu
-;;;---------------------------------------------------
-
-(defun imenu-create-ada-index (&optional regexp)
-  "Create index alist for Ada files."
-  (let ((index-alist '())
-        prev-pos char)
-    (goto-char (point-min))
-    ;(imenu-progress-message prev-pos 0)
-    ;; Search for functions/procedures
-    (save-match-data
-     (while (re-search-forward
-             (or regexp ada-procedure-start-regexp)
-             nil t)
-       ;(imenu-progress-message prev-pos)
-       ;; do not store forward definitions
-       ;; right now we store them. We want to avoid them only in
-       ;; package bodies, not in the specs!! ???RE???
-       (save-match-data
-;        (if (not (looking-at (concat
-;                              "[ \t\n]*" ; WS
-;                              "\([^)]+\)" ; parameterlist
-;                              "\\([ \n\t]+return[ \n\t]+"; potential return
-;                              "[a-zA-Z0-9_\\.]+\\)?"
-;                              "[ \t]*" ; WS
-;                              ";"  ;; THIS is what we really look for
-;                              )))
-;            ; (push (imenu-example--name-and-position) index-alist)
-            (setq index-alist (cons (imenu-example--name-and-position)
-                        index-alist))
-;          )
-	)
-       ;(imenu-progress-message 100)
-       ))
-    (nreverse index-alist)))
-
-;;;---------------------------------------------------
-;;; support for font-lock
-;;;---------------------------------------------------
-
-;; Strings are a real pain in Ada because both ' and " can appear in a
-;; non-string quote context (the former as an operator, the latter as
-;; a character string).  We follow the least losing solution, in which
-;; only " is a string quote.  Therefore a character string of the form
-;; '"' will throw fontification off on the wrong track.
-
-(defconst ada-font-lock-keywords-1
-  (list
-   ;;
-   ;; accept, entry, function, package (body), protected (body|type),
-   ;; pragma, procedure, task (body) plus name.
-   (list (concat
-	  "\\<\\("
-	  "accept\\|"
-	  "entry\\|"
-          "function\\|"
-          "package[ \t]+body\\|"
-          "package\\|"
-          "pragma\\|"
-          "procedure\\|"
-          "protected[ \t]+body\\|"
-          "protected[ \t]+type\\|"
-          "protected\\|"
-;;	  "p\\(\\(ackage\\|rotected\\)\\(\\|[ \t]+\\(body\\|type\\)\\)\
-;;\\|r\\(agma\\|ocedure\\)\\)\\|"
-	  "task\\|"
-	  "task[ \t]+body\\|"
-	  "task[ \t]+type"
-;;	  "task\\(\\|[ \t]+body\\)"
-	  "\\)\\>[ \t]*"
-	  "\\(\\sw+\\(\\.\\sw*\\)*\\)?")
-    '(1 font-lock-keyword-face) '(2 font-lock-function-name-face nil t)))
-  "Subdued level highlighting for Ada mode.")
-
-(defconst ada-font-lock-keywords-2
-  (append ada-font-lock-keywords-1
-   (list
-    ;;
-    ;; Main keywords, except those treated specially below.
-    (concat "\\<\\("
-;    ("abort" "abs" "abstract" "accept" "access" "aliased" "all"
-;     "and" "array" "at" "begin" "case" "declare" "delay" "delta"
-;     "digits" "do" "else" "elsif" "entry" "exception" "exit" "for"
-;     "generic" "if" "in" "is" "limited" "loop" "mod" "not"
-;     "null" "or" "others" "private" "protected"
-;     "range" "record" "rem" "renames" "requeue" "return" "reverse"
-;     "select" "separate" "tagged" "task" "terminate" "then" "until"
-;     "while" "xor")
-            "a\\(b\\(ort\\|s\\(\\|tract\\)\\)\\|cce\\(pt\\|ss\\)\\|"
-            "l\\(iased\\|l\\)\\|nd\\|rray\\|t\\)\\|begin\\|case\\|"
-            "d\\(e\\(clare\\|l\\(ay\\|ta\\)\\)\\|igits\\|o\\)\\|"
-            "e\\(ls\\(e\\|if\\)\\|ntry\\|x\\(ception\\|it\\)\\)\\|for\\|"
-            "generic\\|i[fns]\\|l\\(imited\\|oop\\)\\|mod\\|n\\(ot\\|ull\\)\\|"
-            "o\\(r\\|thers\\|ut\\)\\|pr\\(ivate\\|otected\\)\\|"
-            "r\\(ange\\|e\\(cord\\|m\\|names\\|queue\\|turn\\|verse\\)\\)\\|"
-            "se\\(lect\\|parate\\)\\|"
-            "t\\(agged\\|erminate\\|hen\\)\\|until\\|" ; task removed
-	    "wh\\(ile\\|en\\)\\|xor" ; "when" added
-            "\\)\\>")
-    ;;
-    ;; Anything following end and not already fontified is a body name.
-    '("\\<\\(end\\)\\>[ \t]+\\([a-zA-Z0-9_\\.]+\\)?"
-      (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-    ;;
-    ;; Variable name plus optional keywords followed by a type name.  Slow.
-;    (list (concat "\\<\\(\\sw+\\)\\>[ \t]*:?[ \t]*"
-;                 "\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)?[ \t]*"
-;                 "\\(\\sw+\\)?")
-;         '(1 font-lock-variable-name-face)
-;         '(2 font-lock-keyword-face nil t) '(3 font-lock-type-face nil t))
-    ;;
-    ;; Optional keywords followed by a type name.
-    (list (concat ; ":[ \t]*"
-                  "\\<\\(access\\|constant\\|in\\|in[ \t]+out\\|out\\)\\>"
-                  "[ \t]*"
-                  "\\(\\sw+\\)?")
-          '(1 font-lock-keyword-face nil t) '(2 font-lock-type-face nil t))
-    ;;
-    ;; Keywords followed by a type or function name.
-    (list (concat "\\<\\("
-                  "new\\|of\\|subtype\\|type"
-                  "\\)\\>[ \t]*\\(\\sw+\\)?[ \t]*\\((\\)?")
-          '(1 font-lock-keyword-face)
-          '(2 (if (match-beginning 4)
-                  font-lock-function-name-face
-                font-lock-type-face) nil t))
-    ;;
-    ;; Keywords followed by a (comma separated list of) reference.
-    (list (concat "\\<\\(goto\\|raise\\|use\\|with\\)\\>" ; "when" removed
-                  ; "[ \t]*\\(\\sw+\\(\\.\\sw*\\)*\\)?") ; RE
-                  "[ \t]*\\([a-zA-Z0-9_\\.\\|, ]+\\)\\W")
-          '(1 font-lock-keyword-face) '(2 font-lock-reference-face nil t))
-    ;;
-    ;; Goto tags.
-    '("<<\\(\\sw+\\)>>" 1 font-lock-reference-face)
-    ))
-  "Gaudy level highlighting for Ada mode.")
-
-(defvar ada-font-lock-keywords ada-font-lock-keywords-2
-  "Default Expressions to highlight in Ada mode.
-See the doc to `font-lock-maximum-decoration' for user configuration.")
-
-;;;
-;;; ????
-;;;
-(defun ada-gen-comment-until-proc ()
-  ;; comment until spec of a procedure or a function.
-  (forward-line 1)
-  (set-mark-command (point))
-  (if (re-search-forward ada-procedure-start-regexp nil t)
-      (progn (goto-char (match-beginning 1))
-             (comment-region (mark) (point)))
-    (error "No more functions/procedures")))
-
-
-(defun ada-gen-treat-proc (match)
-  ;; make dummy body of a procedure/function specification.
-  ;; MATCH is a cons cell containing the start and end location of the
-  ;; last search for ada-procedure-start-regexp. 
-  (goto-char (car match))
-  (let (proc-found func-found procname functype)
-    (cond
-     ((or (setq proc-found (looking-at "^[ \t]*procedure"))
-	  (setq func-found (looking-at "^[ \t]*function")))
-      ;; treat it as a proc/func
-      (forward-word 2) 
-      (forward-word -1)
-      (setq procname (buffer-substring (point) (cdr match))) ; store  proc name
-
-    ;; goto end of procname
-    (goto-char (cdr match))
-
-    ;; skip over parameterlist
-    (forward-sexp)
-    ;; if function, skip over 'return' and result type.
-    (if func-found
-	(progn
-	  (forward-word 1)
-	  (skip-chars-forward " \t\n")
-	  (setq functype (buffer-substring (point)
-					   (progn 
-					     (skip-chars-forward
-					      "a-zA-Z0-9_\.")
-					     (point))))))
-    ;; look for next non WS
-    (cond
-     ((looking-at "[ \t]*;")
-      (delete-region (match-beginning 0) (match-end 0)) ;; delete the ';'
-      (ada-indent-newline-indent)
-      (insert " is")
-      (ada-indent-newline-indent)
-      (if func-found
-	  (progn
-	    (insert "Result : ")
-	    (insert functype)
-	    (insert ";")
-	    (ada-indent-newline-indent)))
-      (insert "begin -- ")
-      (insert procname)
-      (ada-indent-newline-indent)
-      (insert "null;")
-      (ada-indent-newline-indent)
-      (if func-found
-	  (progn
-	    (insert "return Result;")
-	    (ada-indent-newline-indent)))
-      (insert "end ")
-      (insert procname)
-      (insert ";")
-      (ada-indent-newline-indent)	
-      )
-      ;; else
-     ((looking-at "[ \t\n]*is")
-      ;; do nothing
-      )
-     ((looking-at "[ \t\n]*rename")
-      ;; do nothing
-      )
-     (t
-      (message "unknown syntax")))
-    ))))
-
-
-(defun ada-make-body ()
-  "Create an Ada package body in the current buffer.
-The potential old buffer contents is deleted first, then we copy the
-spec buffer in here and modify it to make it a body.
-
-This function typically is to be hooked into `ff-file-created-hooks'."
-  (interactive)
-  (delete-region (point-min) (point-max))
-  (insert-buffer (car (cdr (buffer-list))))
-  (ada-mode)
-
-  (let (found)
-    (if (setq found 
-	      (ada-search-ignore-string-comment ada-package-start-regexp))
-	(progn (goto-char (cdr found))
-	       (insert " body")
-	       ;; (forward-line -1)
-	       ;;(comment-region (point-min) (point))
-	       )
-      (error "No package"))
-    
-    ;; (comment-until-proc)
-    ;;   does not work correctly
-    ;;   must be done by hand
-    
-    (while (setq found
-		 (ada-search-ignore-string-comment ada-procedure-start-regexp))
-      (ada-gen-treat-proc found))))
-
-
-;;; provide ourself
-
-(provide 'ada-mode)
-
-;;; ada-mode.el ends here
diff --git a/lisp/progmodes/asm-mode.el b/lisp/progmodes/asm-mode.el
deleted file mode 100644
index 3a0370bdaaf..00000000000
--- a/lisp/progmodes/asm-mode.el
+++ /dev/null
@@ -1,231 +0,0 @@
-;;; asm-mode.el --- mode for editing assembler code
-
-;; Copyright (C) 1991 Free Software Foundation, Inc.
-
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: FSF
-;; Keywords: tools, languages
-
-;; 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 mode was written by Eric S. Raymond <esr@snark.thyrsus.com>,
-;; inspired by an earlier asm-mode by Martin Neitzel.
-
-;; This minor mode is based on text mode.  It defines a private abbrev table
-;; that can be used to save abbrevs for assembler mnemonics.  It binds just
-;; five keys:
-;;
-;;	TAB		tab to next tab stop
-;;	:		outdent preceding label, tab to tab stop
-;;	comment char	place or move comment
-;;			asm-comment-char specifies which character this is;
-;;			you can use a different character in different
-;;			Asm mode buffers.
-;;	C-j, C-m	newline and tab to tab stop
-;;
-;; Code is indented to the first tab stop level.
-
-;; This mode runs two hooks:
-;;   1) An asm-mode-set-comment-hook before the part of the initialization
-;; depending on asm-comment-char, and
-;;   2) an asm-mode-hook at the end of initialization.
-
-;;; Code:
-
-(defvar asm-comment-char ?;
-  "*The comment-start character assumed by Asm mode.")
-
-(defvar asm-mode-syntax-table nil
-  "Syntax table used while in Asm mode.")
-
-(defvar asm-mode-abbrev-table nil
-  "Abbrev table used while in Asm mode.")
-(define-abbrev-table 'asm-mode-abbrev-table ())
-
-(defvar asm-mode-map nil
-  "Keymap for Asm mode.")
-
-(if asm-mode-map
-    nil
-  (setq asm-mode-map (make-sparse-keymap))
-  ;; Note that the comment character isn't set up until asm-mode is called.
-  (define-key asm-mode-map ":"		'asm-colon)
-  (define-key asm-mode-map "\C-c;"      'comment-region)
-  (define-key asm-mode-map "\C-i"	'tab-to-tab-stop)
-  (define-key asm-mode-map "\C-j"	'asm-newline)
-  (define-key asm-mode-map "\C-m"	'asm-newline)
-  )
-
-(defconst asm-font-lock-keywords
- '(("^\\(\\(\\sw\\|\\s_\\)+\\)\\>:?[ \t]*\\(\\sw+\\)?"
-    (1 font-lock-function-name-face) (3 font-lock-keyword-face nil t))
-   ("^\\s +\\(\\(\\sw\\|\\s_\\)+\\)" 1 font-lock-keyword-face))
- "Additional expressions to highlight in Assembler mode.")
-
-(defvar asm-code-level-empty-comment-pattern nil)
-(defvar asm-flush-left-empty-comment-pattern nil)
-(defvar asm-inline-empty-comment-pattern nil)
-
-;;;###autoload
-(defun asm-mode ()
-  "Major mode for editing typical assembler code.
-Features a private abbrev table and the following bindings:
-
-\\[asm-colon]\toutdent a preceding label, tab to next tab stop.
-\\[tab-to-tab-stop]\ttab to next tab stop.
-\\[asm-newline]\tnewline, then tab to next tab stop.
-\\[asm-comment]\tsmart placement of assembler comments.
-
-The character used for making comments is set by the variable
-`asm-comment-char' (which defaults to `?;').
-
-Alternatively, you may set this variable in `asm-mode-set-comment-hook',
-which is called near the beginning of mode initialization.
-
-Turning on Asm mode runs the hook `asm-mode-hook' at the end of initialization.
-
-Special commands:
-\\{asm-mode-map}
-"
-  (interactive)
-  (kill-all-local-variables)
-  (setq mode-name "Assembler")
-  (setq major-mode 'asm-mode)
-  (setq local-abbrev-table asm-mode-abbrev-table)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(asm-font-lock-keywords))
-  (make-local-variable 'asm-mode-syntax-table)
-  (setq asm-mode-syntax-table (make-syntax-table))
-  (set-syntax-table asm-mode-syntax-table)
-
-  (run-hooks 'asm-mode-set-comment-hook)
-  ;; Make our own local child of asm-mode-map
-  ;; so we can define our own comment character.
-  (use-local-map (nconc (make-sparse-keymap) asm-mode-map))
-  (local-set-key (vector asm-comment-char) 'asm-comment)
-
-  (modify-syntax-entry	asm-comment-char
-			"<" asm-mode-syntax-table)
-  (modify-syntax-entry	?\n
-			 ">" asm-mode-syntax-table)
-  (let ((cs (regexp-quote (char-to-string asm-comment-char))))
-    (make-local-variable 'comment-start)
-    (setq comment-start (concat cs " "))
-    (make-local-variable 'comment-start-skip)
-    (setq comment-start-skip (concat cs "+[ \t]*"))
-    (setq asm-inline-empty-comment-pattern (concat "^.+" cs "+ *$"))
-    (setq asm-code-level-empty-comment-pattern (concat "^[\t ]+" cs cs " *$"))
-    (setq asm-flush-left-empty-comment-pattern (concat "^" cs cs cs " *$"))
-    )
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (setq fill-prefix "\t")
-  (run-hooks 'asm-mode-hook))
-
-(defun asm-colon ()
-  "Insert a colon; if it follows a label, delete the label's indentation."
-  (interactive)
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at "[ \t]+\\(\\sw\\|\\s_\\)+$")
-	(delete-horizontal-space)))
-  (insert ":")
-  (tab-to-tab-stop)
-  )
-
-(defun asm-newline ()
-  "Insert LFD + fill-prefix, to bring us back to code-indent level."
-  (interactive)
-  (if (eolp) (delete-horizontal-space))
-  (insert "\n")
-  (tab-to-tab-stop)
-  )
-
-(defun asm-line-matches (pattern &optional withcomment)
-  (save-excursion
-    (beginning-of-line)
-    (looking-at pattern)))
-
-(defun asm-pop-comment-level ()
-  ;; Delete an empty comment ending current line.  Then set up for a new one,
-  ;; on the current line if it was all comment, otherwise above it
-  (end-of-line)
-  (delete-horizontal-space)
-  (while (= (preceding-char) asm-comment-char)
-    (delete-backward-char 1))
-  (delete-horizontal-space)
-  (if (bolp)
-      nil
-    (beginning-of-line)
-    (open-line 1))
-  )
-
-
-(defun asm-comment ()
-  "Convert an empty comment to a `larger' kind, or start a new one.
-These are the known comment classes:
-
-   1 -- comment to the right of the code (at the comment-column)
-   2 -- comment on its own line, indented like code
-   3 -- comment on its own line, beginning at the left-most column.
-
-Suggested usage:  while writing your code, trigger asm-comment
-repeatedly until you are satisfied with the kind of comment."
-  (interactive)
-  (cond
-
-   ;; Blank line?  Then start comment at code indent level.
-   ((asm-line-matches "^[ \t]*$")
-    (delete-horizontal-space)
-    (tab-to-tab-stop)
-    (insert asm-comment-char comment-start))
-
-   ;; Nonblank line with no comment chars in it?
-   ;; Then start a comment at the current comment column
-   ((asm-line-matches (format "^[^%c\n]+$" asm-comment-char))
-    (indent-for-comment))
-
-   ;; Flush-left comment present?  Just insert character.
-   ((asm-line-matches asm-flush-left-empty-comment-pattern)
-    (insert asm-comment-char))
-
-   ;; Empty code-level comment already present?
-   ;; Then start flush-left comment, on line above if this one is nonempty. 
-   ((asm-line-matches asm-code-level-empty-comment-pattern)
-    (asm-pop-comment-level)
-    (insert asm-comment-char asm-comment-char comment-start))
-
-   ;; Empty comment ends line?
-   ;; Then make code-level comment, on line above if this one is nonempty. 
-   ((asm-line-matches asm-inline-empty-comment-pattern)
-    (asm-pop-comment-level)
-    (tab-to-tab-stop)
-    (insert asm-comment-char comment-start))
-
-   ;; If all else fails, insert character
-   (t
-    (insert asm-comment-char))
-
-   )
-  (end-of-line))
-
-;;; asm-mode.el ends here
diff --git a/lisp/progmodes/awk-mode.el b/lisp/progmodes/awk-mode.el
deleted file mode 100644
index 3ba782bac38..00000000000
--- a/lisp/progmodes/awk-mode.el
+++ /dev/null
@@ -1,153 +0,0 @@
-;;; awk-mode.el --- AWK code editing commands for Emacs
-
-;; Copyright (C) 1988, 1994, 1996 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: unix, languages
-
-;; 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:
-
-;; Sets up C-mode with support for awk-style #-comments and a lightly
-;; hacked syntax table.
-
-;;; Code:
-
-(defvar awk-mode-syntax-table nil
-  "Syntax table in use in Awk-mode buffers.")
-
-(if awk-mode-syntax-table
-    ()
-  (setq awk-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "\\" awk-mode-syntax-table)
-  (modify-syntax-entry ?\n ">   " awk-mode-syntax-table)
-  (modify-syntax-entry ?\f ">   " awk-mode-syntax-table)
-  (modify-syntax-entry ?\# "<   " awk-mode-syntax-table)
-  (modify-syntax-entry ?/ "." awk-mode-syntax-table)
-  (modify-syntax-entry ?* "." awk-mode-syntax-table)
-  (modify-syntax-entry ?+ "." awk-mode-syntax-table)
-  (modify-syntax-entry ?- "." awk-mode-syntax-table)
-  (modify-syntax-entry ?= "." awk-mode-syntax-table)
-  (modify-syntax-entry ?% "." awk-mode-syntax-table)
-  (modify-syntax-entry ?< "." awk-mode-syntax-table)
-  (modify-syntax-entry ?> "." awk-mode-syntax-table)
-  (modify-syntax-entry ?& "." awk-mode-syntax-table)
-  (modify-syntax-entry ?| "." awk-mode-syntax-table)
-  (modify-syntax-entry ?_ "_" awk-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" awk-mode-syntax-table))
-
-(defvar awk-mode-abbrev-table nil
-  "Abbrev table in use in Awk-mode buffers.")
-(define-abbrev-table 'awk-mode-abbrev-table ())
-
-;; Regexps written with help from Peter Galbraith <galbraith@mixing.qc.dfo.ca>.
-(defconst awk-font-lock-keywords
-  (eval-when-compile
-    (list
-     ;;
-     ;; Function names.
-     '("^[ \t]*\\(function\\)\\>[ \t]*\\(\\sw+\\)?" 
-       (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-     ;;
-     ;; Variable names.
-     (cons (concat "\\<\\("
-;		   ("ARGC" "ARGIND" "ARGV" "CONVFMT" "ENVIRON" "ERRNO"
-;		    "FIELDWIDTHS" "FILENAME" "FNR" "FS" "IGNORECASE" "NF" "NR"
-;		    "OFMT" "OFS" "ORS" "RLENGTH" "RS" "RSTART" "SUBSEP")
-		   "ARG\\([CV]\\|IND\\)\\|CONVFMT\\|E\\(NVIRON\\|RRNO\\)\\|"
-		   "F\\(I\\(ELDWIDTHS\\|LENAME\\)\\|NR\\|S\\)\\|IGNORECASE\\|"
-		   "N[FR]\\|O\\(F\\(MT\\|S\\)\\|RS\\)\\|"
-		   "R\\(LENGTH\\|S\\(\\|TART\\)\\)\\|SUBSEP"
-		   "\\)\\>")
-	   'font-lock-variable-name-face)
-     ;;
-     ;; Keywords.
-     (concat "\\<\\("
-;	     ("BEGIN" "END" "break" "continue" "delete" "exit" "for"
-;	      "getline" "if" "next" "print" "printf" "return" "while")
-	     "BEGIN\\|END\\|break\\|continue\\|delete\\|exit\\|for\\|"
-	     "getline\\|if\\|next\\|printf?\\|return\\|while"
-	     "\\)\\>")
-     ;;
-     ;; Builtins.
-     (list (concat "\\<\\("
-;		   ("atan2" "close" "cos" "ctime" "exp" "gsub" "index" "int"
-;		    "length" "log" "match" "rand" "sin" "split" "sprintf"
-;		    "sqrt" "srand" "sub" "substr" "system" "time"
-;		    "tolower" "toupper")
-		   "atan2\\|c\\(lose\\|os\\|time\\)\\|exp\\|gsub\\|"
-		   "in\\(dex\\|t\\)\\|l\\(ength\\|og\\)\\|match\\|rand\\|"
-		   "s\\(in\\|p\\(lit\\|rintf\\)\\|qrt\\|rand\\|"
-		   "ub\\(\\|str\\)\\|ystem\\)\\|"
-		   "t\\(ime\\|o\\(lower\\|upper\\)\\)"
-		   "\\)(")
-	   1 'font-lock-builtin-face)
-     ;;
-     ;; Operators.  Is this too much?
-     (cons (mapconcat 'identity
-		      '("&&" "||" "<=" "<" ">=" ">" "==" "!=" "!~" "~")
-		      "\\|")
-	   'font-lock-reference-face)
-     ))
- "Default expressions to highlight in AWK mode.")
-
-;;;###autoload
-(defun awk-mode ()
-  "Major mode for editing AWK code.
-This is much like C mode except for the syntax of comments.  It uses
-the same keymap as C mode and has the same variables for customizing
-indentation.  It has its own abbrev table and its own syntax table.
-
-Turning on AWK mode calls the value of the variable `awk-mode-hook'
-with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (require 'cc-mode)
-  (use-local-map c-mode-map)
-  (setq major-mode 'awk-mode)
-  (setq mode-name "AWK")
-  (setq local-abbrev-table awk-mode-abbrev-table)
-  (set-syntax-table awk-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'c-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#+ *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'c-comment-indent)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(awk-font-lock-keywords nil nil ((?_ . "w"))))
-  (run-hooks 'awk-mode-hook))
-
-(provide 'awk-mode)
-
-;;; awk-mode.el ends here
diff --git a/lisp/progmodes/c-mode.el b/lisp/progmodes/c-mode.el
deleted file mode 100644
index f3364457e18..00000000000
--- a/lisp/progmodes/c-mode.el
+++ /dev/null
@@ -1,1650 +0,0 @@
-;;; c-mode.el --- C code editing commands for Emacs
-
-;; Copyright (C) 1985, 86, 87, 92, 94, 95 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: c
-
-;; 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:
-
-;; A smart editing mode for C code.  It knows a lot about C syntax and tries
-;; to position the cursor according to C layout conventions.  You can
-;; change the details of the layout style with option variables.  Load it
-;; and do M-x describe-mode for details.
-
-;;; Code:
-
-(defvar c-mode-abbrev-table nil
-  "Abbrev table in use in C mode.")
-(define-abbrev-table 'c-mode-abbrev-table ())
-
-(defvar c-mode-map (make-sparse-keymap)
-  "Keymap used in C mode.")
-
-(define-key c-mode-map "{" 'electric-c-brace)
-(define-key c-mode-map "}" 'electric-c-brace)
-(define-key c-mode-map ";" 'electric-c-semi)
-(define-key c-mode-map "#" 'electric-c-sharp-sign)
-(define-key c-mode-map ":" 'electric-c-terminator)
-(define-key c-mode-map "\e\C-h" 'mark-c-function)
-(define-key c-mode-map "\e\C-q" 'indent-c-exp)
-(define-key c-mode-map "\ea" 'c-beginning-of-statement)
-(define-key c-mode-map "\ee" 'c-end-of-statement)
-(define-key c-mode-map "\C-c\C-n" 'c-forward-conditional)
-(define-key c-mode-map "\C-c\C-p" 'c-backward-conditional)
-(define-key c-mode-map "\C-c\C-u" 'c-up-conditional)
-(define-key c-mode-map "\177" 'backward-delete-char-untabify)
-(define-key c-mode-map "\t" 'c-indent-command)
-
-(define-key c-mode-map [menu-bar] (make-sparse-keymap))
-
-;; "C-mode" is not strictly the right punctuation--it should be "C
-;; mode"--but that would look like two menu items.  "C-mode" is the
-;; best alternative I can think of.
-(define-key c-mode-map [menu-bar c]
-  (cons "C-mode" (make-sparse-keymap "C-mode")))
-
-(define-key c-mode-map [menu-bar c comment-region]
-  '("Comment Out Region" . comment-region))
-(define-key c-mode-map [menu-bar c c-macro-expand]
-  '("Macro Expand Region" . c-macro-expand))
-(define-key c-mode-map [menu-bar c c-backslash-region]
-  '("Backslashify" . c-backslash-region))
-(define-key c-mode-map [menu-bar c indent-exp]
-  '("Indent Expression" . indent-c-exp))
-(define-key c-mode-map [menu-bar c indent-line]
-  '("Indent Line" . c-indent-command))
-(define-key c-mode-map [menu-bar c fill]
-  '("Fill Comment Paragraph" . c-fill-paragraph))
-(define-key c-mode-map [menu-bar c cpp-highlight-buffer]
-  '("Highlight Conditionals" . cpp-highlight-buffer))
-(define-key c-mode-map [menu-bar c up]
-  '("Up Conditional" . c-up-conditional))
-(define-key c-mode-map [menu-bar c backward]
-  '("Backward Conditional" . c-backward-conditional))
-(define-key c-mode-map [menu-bar c forward]
-  '("Forward Conditional" . c-forward-conditional))
-(define-key c-mode-map [menu-bar c backward-stmt]
-  '("Backward Statement" . c-beginning-of-statement))
-(define-key c-mode-map [menu-bar c forward-stmt]
-  '("Forward Statement" . c-end-of-statement))
-
-(put 'comment-region 'menu-enable 'mark-active)
-(put 'c-macro-expand 'menu-enable 'mark-active)
-(put 'c-backslash-region 'menu-enable 'mark-active)
-
-(autoload 'c-macro-expand "cmacexp"
-  "Display the result of expanding all C macros occurring in the region.
-The expansion is entirely correct because it uses the C preprocessor."
-  t)
-
-(defvar c-mode-syntax-table nil
-  "Syntax table in use in C-mode buffers.")
-
-(if c-mode-syntax-table
-    ()
-  (setq c-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "\\" c-mode-syntax-table)
-  (modify-syntax-entry ?/ ". 14" c-mode-syntax-table)
-  (modify-syntax-entry ?* ". 23" c-mode-syntax-table)
-  (modify-syntax-entry ?+ "." c-mode-syntax-table)
-  (modify-syntax-entry ?- "." c-mode-syntax-table)
-  (modify-syntax-entry ?= "." c-mode-syntax-table)
-  (modify-syntax-entry ?% "." c-mode-syntax-table)
-  (modify-syntax-entry ?< "." c-mode-syntax-table)
-  (modify-syntax-entry ?> "." c-mode-syntax-table)
-  (modify-syntax-entry ?& "." c-mode-syntax-table)
-  (modify-syntax-entry ?| "." c-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" c-mode-syntax-table))
-
-(defconst c-indent-level 2
-  "*Indentation of C statements with respect to containing block.")
-(defconst c-brace-imaginary-offset 0
-  "*Imagined indentation of a C open brace that actually follows a statement.")
-(defconst c-brace-offset 0
-  "*Extra indentation for braces, compared with other text in same context.")
-(defconst c-argdecl-indent 5
-  "*Indentation level of declarations of C function arguments.")
-(defconst c-label-offset -2
-  "*Offset of C label lines and case statements relative to usual indentation.")
-(defconst c-continued-statement-offset 2
-  "*Extra indent for lines not starting new statements.")
-(defconst c-continued-brace-offset 0
-  "*Extra indent for substatements that start with open-braces.
-This is in addition to `c-continued-statement-offset'.")
-(defconst c-style-alist
-  '(("GNU"
-     (c-indent-level               .  2)
-     (c-argdecl-indent             .  5)
-     (c-brace-offset               .  0)
-     (c-continued-brace-offset     .  0)
-     (c-label-offset               . -2)
-     (c-continued-statement-offset .  2))
-    ("K&R"
-     (c-indent-level               .  5)
-     (c-argdecl-indent             .  0)
-     (c-brace-offset               .  0)
-     (c-continued-brace-offset     . -5)
-     (c-label-offset               . -5)
-     (c-continued-statement-offset .  5))
-    ("BSD"
-     (c-indent-level               .  4)
-     (c-argdecl-indent             .  4)
-     (c-brace-offset               .  0)
-     (c-continued-brace-offset     . -4)
-     (c-label-offset               . -4)
-     (c-continued-statement-offset .  4))
-    ("C++"
-     (c-indent-level               .  4)
-     (c-argdecl-indent             .  0)
-     (c-brace-offset               .  0)
-     (c-continued-brace-offset     . -4)
-     (c-label-offset               . -4)
-     (c-continued-statement-offset .  4)
-     (c-auto-newline               .  t))
-    ("Whitesmith"
-     (c-indent-level               .  4)
-     (c-argdecl-indent             .  4)
-     (c-brace-offset               .  0)
-     (c-continued-brace-offset     .  0)
-     (c-label-offset               . -4)
-     (c-continued-statement-offset .  4))))
-
-(defconst c-auto-newline nil
-  "*Non-nil means automatically newline before and after braces,
-and after colons and semicolons, inserted in C code.
-If you do not want a leading newline before braces then use:
-  (define-key c-mode-map \"{\" 'electric-c-semi)")
-
-(defconst c-tab-always-indent t
-  "*Non-nil means TAB in C mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used.")
-
-;;; Regular expression used internally to recognize labels in switch
-;;; statements.
-(defconst c-switch-label-regexp "case[ \t'/(]\\|default[ \t]*:")
-
-;; This is actually the expression for C++ mode, but it's used for C too.
-(defvar c-imenu-generic-expression
-  (`
-   ((nil
-     (,
-      (concat
-       "^"				  ; beginning of line is required
-       "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
-       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; type specs; there can be no
-       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; more than 3 tokens, right?
-
-       "\\("				  ; last type spec including */&
-       "[a-zA-Z0-9_:]+"
-       "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)"	  ; either pointer/ref sign or whitespace
-       "\\)?"				  ; if there is a last type spec
-       "\\("			      ; name; take that into the imenu entry
-       "[a-zA-Z0-9_:~]+"		      ; member function, ctor or dtor...
-					; (may not contain * because then
-					; "a::operator char*" would become "char*"!)
-       "\\|"
-       "\\([a-zA-Z0-9_:~]*::\\)?operator"
-       "[^a-zA-Z1-9_][^(]*"	      ; ...or operator
-       " \\)"
-       "[ \t]*([^)]*)[ \t\n]*[^	      ;]" ; require something other than a ; after
-					; the (...) to avoid prototypes.  Can't
-					; catch cases with () inside the parentheses
-					; surrounding the parameters
-					; (like "int foo(int a=bar()) {...}"
-
-       )) 6)
-    ("Class"
-     (, (concat
-	 "^"				   ; beginning of line is required
-	 "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
-	 "class[ \t]+"
-	 "\\([a-zA-Z0-9_]+\\)"                ; this is the string we want to get
-	 "[ \t]*[:{]"
-	 )) 2)
-;; Example of generic expression for finding prototypes, structs, unions, enums.
-;; Uncomment if you want to find these too.  It will be a bit slower gathering
-;; the indexes.
-;    ("Prototypes"
-;     (,
-;      (concat
-;       "^"				  ; beginning of line is required
-;       "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
-;       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; type specs; there can be no
-;       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; more than 3 tokens, right?
-
-;       "\\("				  ; last type spec including */&
-;       "[a-zA-Z0-9_:]+"
-;       "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)"	  ; either pointer/ref sign or whitespace
-;       "\\)?"				  ; if there is a last type spec
-;       "\\("			      ; name; take that into the imenu entry
-;       "[a-zA-Z0-9_:~]+"		      ; member function, ctor or dtor...
-;					; (may not contain * because then
-;					; "a::operator char*" would become "char*"!)
-;       "\\|"
-;       "\\([a-zA-Z0-9_:~]*::\\)?operator"
-;       "[^a-zA-Z1-9_][^(]*"	      ; ...or operator
-;       " \\)"
-;       "[ \t]*([^)]*)[ \t\n]*;" 	; require ';' after
-;					; the (...) Can't
-;					; catch cases with () inside the parentheses
-;					; surrounding the parameters
-;					; (like "int foo(int a=bar());"
-;       )) 6)
-;    ("Struct"
-;     (, (concat
-;	 "^"				; beginning of line is required
-;	 "\\(static[ \t]+\\)?"		; there may be static or const.
-;	 "\\(const[ \t]+\\)?"
-;	 "struct[ \t]+"
-;	 "\\([a-zA-Z0-9_]+\\)"		; this is the string we want to get
-;	 "[ \t]*[{]"
-;	 )) 3)
-;    ("Enum"
-;     (, (concat
-;	 "^"				; beginning of line is required
-;	 "\\(static[ \t]+\\)?"		; there may be static or const.
-;	 "\\(const[ \t]+\\)?"
-;	 "enum[ \t]+"
-;	 "\\([a-zA-Z0-9_]+\\)"		; this is the string we want to get
-;	 "[ \t]*[{]"
-;	 )) 3)
-;    ("Union"
-;     (, (concat
-;	 "^"				; beginning of line is required
-;	 "\\(static[ \t]+\\)?"		; there may be static or const.
-;	 "\\(const[ \t]+\\)?"
-;	 "union[ \t]+"
-;	 "\\([a-zA-Z0-9_]+\\)"		; this is the string we want to get
-;	 "[ \t]*[{]"
-;	 )) 3)
-    ))
-  "Imenu generic expression for C mode.  See `imenu-generic-expression'.")
-
-(defun c-mode ()
-  "Major mode for editing C code.
-Expression and list commands understand all C brackets.
-Tab indents for C code.
-Comments are delimited with /* ... */.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-\\{c-mode-map}
-Variables controlling indentation style:
- c-tab-always-indent
-    Non-nil means TAB in C mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- c-auto-newline
-    Non-nil means automatically newline before and after braces,
-    and after colons and semicolons, inserted in C code.
- c-indent-level
-    Indentation of C statements within surrounding block.
-    The surrounding block's indentation is the indentation
-    of the line on which the open-brace appears.
- c-continued-statement-offset
-    Extra indentation given to a substatement, such as the
-    then-clause of an if or body of a while.
- c-continued-brace-offset
-    Extra indentation given to a brace that starts a substatement.
-    This is in addition to c-continued-statement-offset.
- c-brace-offset
-    Extra indentation for line if it starts with an open brace.
- c-brace-imaginary-offset
-    An open brace following other text is treated as if it were
-    this far to the right of the start of its line.
- c-argdecl-indent
-    Indentation level of declarations of C function arguments.
- c-label-offset
-    Extra indentation for line that is a label, or case or default.
-
-Settings for K&R and BSD indentation styles are
-  c-indent-level                5    8
-  c-continued-statement-offset  5    8
-  c-brace-offset               -5   -8
-  c-argdecl-indent              0    8
-  c-label-offset               -5   -8
-
-Turning on C mode calls the value of the variable c-mode-hook with no args,
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map c-mode-map)
-  (setq major-mode 'c-mode)
-  (setq mode-name "C")
-  (setq local-abbrev-table c-mode-abbrev-table)
-  (set-syntax-table c-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'c-fill-paragraph)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'c-indent-line)
-  (make-local-variable 'indent-region-function)
-  (setq indent-region-function 'c-indent-region)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'outline-regexp)
-  (setq outline-regexp "[^#\n\^M]")
-  (make-local-variable 'outline-level)
-  (setq outline-level 'c-outline-level)
-  (make-local-variable 'comment-start)
-  (setq comment-start "/* ")
-  (make-local-variable 'comment-end)
-  (setq comment-end " */")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "/\\*+ *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'c-comment-indent)
-  (make-local-variable 'comment-multi-line)
-  (setq comment-multi-line t)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression c-imenu-generic-expression)
-  (run-hooks 'c-mode-hook))
-
-(defun c-outline-level ()
-  (save-excursion
-    (skip-chars-forward "\t ")
-    (current-column)))
-
-;; This is used by indent-for-comment
-;; to decide how much to indent a comment in C code
-;; based on its context.
-(defun c-comment-indent ()
-  (if (looking-at "^/\\*")
-      0				;Existing comment at bol stays there.
-    (let ((opoint (point)))
-      (save-excursion
-	(beginning-of-line)
-	(cond ((looking-at "[ \t]*}[ \t]*\\($\\|/\\*\\)")
-	       ;; A comment following a solitary close-brace
-	       ;; should have only one space.
-	       (search-forward "}")
-	       (1+ (current-column)))
-	      ((or (looking-at "^#[ \t]*endif[ \t]*")
-		   (looking-at "^#[ \t]*else[ \t]*"))
-	       7)			;2 spaces after #endif
-	      ((progn
-		 (goto-char opoint)
-		 (skip-chars-backward " \t")
-		 (and (= comment-column 0) (bolp)))
-	       ;; If comment-column is 0, and nothing but space
-	       ;; before the comment, align it at 0 rather than 1.
-	       0)
-	      (t
-	       (max (1+ (current-column))	;Else indent at comment column
-		    comment-column)))))))	; except leave at least one space.
-
-(defun c-fill-paragraph (&optional arg)
-  "Like \\[fill-paragraph] but handle C comments.
-If any of the current line is a comment or within a comment,
-fill the comment or the paragraph of it that point is in,
-preserving the comment indentation or line-starting decorations."
-  (interactive "P")
-  (let* (comment-start-place
-	 (first-line
-	  ;; Check for obvious entry to comment.
-	  (save-excursion
-	    (beginning-of-line)
-	    (skip-chars-forward " \t\n")
-	    (and (looking-at comment-start-skip)
-		 (setq comment-start-place (point))))))
-    (if (and (eq major-mode 'c++-mode)
-	     (save-excursion
-	       (beginning-of-line)
-	       (looking-at ".*//")))
-	(let (fill-prefix
-	      (paragraph-start
-	       ;; Lines containing just a comment start or just an end
-	       ;; should not be filled into paragraphs they are next to.
-	       (concat
-		paragraph-start
-		"\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$"))
-	      (paragraph-separate
-	       (concat
-		paragraph-separate
-		"\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$")))
-	  (save-excursion
-	    (beginning-of-line)
-	    ;; Move up to first line of this comment.
-	    (while (and (not (bobp)) (looking-at "[ \t]*//"))
-	      (forward-line -1))
-	    (if (not (looking-at ".*//"))
-		(forward-line 1))
-	    ;; Find the comment start in this line.
-	    (re-search-forward "[ \t]*//[ \t]*")
-	    ;; Set the fill-prefix to be what all lines except the first
-	    ;; should start with.
-	    (let ((endcol (current-column)))
-	      (skip-chars-backward " \t")
-	      (setq fill-prefix
-		    (concat (make-string (- (current-column) 2) ?\ )
-			    "//"
-			    (make-string (- endcol (current-column)) ?\ ))))
-	    (save-restriction
-	      ;; Narrow down to just the lines of this comment.
-	      (narrow-to-region (point)
-				(save-excursion
-				  (forward-line 1)
-				  (while (looking-at "[ \t]*//")
-				    (forward-line 1))
-				  (point)))
-	      (insert fill-prefix)
-	      (fill-paragraph arg)
-	      (delete-region (point-min)
-			     (+ (point-min) (length fill-prefix))))))
-      (if (or first-line
-	      ;; t if we enter a comment between start of function and this line.
-	      (eq (calculate-c-indent) t)
-	      ;; t if this line contains a comment starter.
-	      (setq first-line
-		    (save-excursion
-		      (beginning-of-line)
-		      (prog1
-			  (re-search-forward comment-start-skip
-					     (save-excursion (end-of-line)
-							     (point))
-					     t)
-			(setq comment-start-place (point))))))
-	  ;; Inside a comment: fill one comment paragraph.
-	  (let ((fill-prefix
-		 ;; The prefix for each line of this paragraph
-		 ;; is the appropriate part of the start of this line,
-		 ;; up to the column at which text should be indented.
-		 (save-excursion
-		   (beginning-of-line)
-		   (if (looking-at "[ \t]*/\\*.*\\*/")
-		       (progn (re-search-forward comment-start-skip)
-			      (make-string (current-column) ?\ ))
-		     (if first-line (forward-line 1))
-
-		     (let ((line-width (progn (end-of-line) (current-column))))
-		       (beginning-of-line)
-		       (prog1
-			   (buffer-substring
-			    (point)
-
-			    ;; How shall we decide where the end of the
-			    ;; fill-prefix is?
-			    ;; calculate-c-indent-within-comment bases its value
-			    ;; on the indentation of previous lines; if they're
-			    ;; indented specially, it could return a column
-			    ;; that's well into the current line's text.  So
-			    ;; we'll take at most that many space, tab, or *
-			    ;; characters, and use that as our fill prefix.
-			    (let ((max-prefix-end
-				   (progn
-				     (move-to-column
-				      (calculate-c-indent-within-comment t)
-				      t)
-				     (point))))
-			      (beginning-of-line)
-			      (skip-chars-forward " \t*" max-prefix-end)
-			      ;; Don't include part of comment terminator
-			      ;; in the fill-prefix.
-			      (and (eq (following-char) ?/)
-				   (eq (preceding-char) ?*)
-				   (backward-char 1))
-			      (point)))
-
-			 ;; If the comment is only one line followed by a blank
-			 ;; line, calling move-to-column above may have added
-			 ;; some spaces and tabs to the end of the line; the
-			 ;; fill-paragraph function will then delete it and the
-			 ;; newline following it, so we'll lose a blank line
-			 ;; when we shouldn't.  So delete anything
-			 ;; move-to-column added to the end of the line.  We
-			 ;; record the line width instead of the position of the
-			 ;; old line end because move-to-column might break a
-			 ;; tab into spaces, and the new characters introduced
-			 ;; there shouldn't be deleted.
-
-			 ;; If you can see a better way to do this, please make
-			 ;; the change.  This seems very messy to me.
-			 (delete-region (progn (move-to-column line-width)
-					       (point))
-					(progn (end-of-line) (point))))))))
-
-		(paragraph-start
-		 ;; Lines containing just a comment start or just an end
-		 ;; should not be filled into paragraphs they are next to.
-		 (concat
-		  paragraph-start
-		  "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$"))
-		(paragraph-separate
-		 (concat
-		  paragraph-separate
-		  "\\|[ \t]*/\\*[ \t]*$\\|[ \t]*\\*/[ \t]*$\\|[ \t/*]*$"))
-		(chars-to-delete 0))
-	    (save-restriction
-	      ;; Don't fill the comment together with the code following it.
-	      ;; So temporarily exclude everything before the comment start,
-	      ;; and everything after the line where the comment ends.
-	      ;; If comment-start-place is non-nil, the comment starter is there.
-	      ;; Otherwise, point is inside the comment.
-	      (narrow-to-region (save-excursion
-				  (if comment-start-place
-				      (goto-char comment-start-place)
-				    (search-backward "/*"))
-				  ;; Protect text before the comment start
-				  ;; by excluding it.  Add spaces to bring back
-				  ;; proper indentation of that point.
-				  (let ((column (current-column)))
-				    (prog1 (point)
-				      (setq chars-to-delete column)
-				      (insert-char ?\  column))))
-				(save-excursion
-				  (if comment-start-place
-				      (goto-char (+ comment-start-place 2)))
-				  (search-forward "*/" nil 'move)
-				  (forward-line 1)
-				  (point)))
-	      (save-excursion
-		(goto-char (point-max))
-		(forward-line -1)
-		;; And comment terminator was on a separate line before,
-		;; keep it that way.
-		;; This also avoids another problem:
-		;; if the fill-prefix ends in a *, it could eat up
-		;; the * of the comment terminator.
-		(if (looking-at "[ \t]*\\*/")
-		    (narrow-to-region (point-min) (point))))
-	      (fill-paragraph arg)
-	      (save-excursion
-		;; Delete the chars we inserted to avoid clobbering
-		;; the stuff before the comment start.
-		(goto-char (point-min))
-		(if (> chars-to-delete 0)
-		    (delete-region (point) (+ (point) chars-to-delete)))
-		;; Find the comment ender (should be on last line of buffer,
-		;; given the narrowing) and don't leave it on its own line.
-		;; Do this with a fill command, so as to preserve sentence
-		;; boundaries.
-		(goto-char (point-max))
-		(forward-line -1)
-		(search-forward "*/" nil 'move)
-		(beginning-of-line)
-		(if (looking-at "[ \t]*\\*/")
-		    (let ((fill-column (+ fill-column 9999)))
-		      (forward-line -1)
-		      (fill-region-as-paragraph (point) (point-max)))))))
-	;; Outside of comments: do ordinary filling.
-	(fill-paragraph arg)))
-    t))
-
-(defun electric-c-brace (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (let (insertpos)
-    (if (and (not arg)
-	     (eolp)
-	     (or (save-excursion
-		   (skip-chars-backward " \t")
-		   (bolp))
-		 (if c-auto-newline (progn (c-indent-line) (newline) t) nil)))
-	(progn
-	  (insert last-command-char)
-	  (c-indent-line)
-	  (if c-auto-newline
-	      (progn
-		(newline)
-		;; (newline) may have done auto-fill
-		(setq insertpos (- (point) 2))
-		(c-indent-line)))
-	  (save-excursion
-	    (if insertpos (goto-char (1+ insertpos)))
-	    (delete-char -1))))
-    (if insertpos
-	(save-excursion
-	  (goto-char insertpos)
-	  (self-insert-command (prefix-numeric-value arg)))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun electric-c-sharp-sign (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (if (save-excursion
-	(skip-chars-backward " \t")
-	(bolp))
-      (let ((c-auto-newline nil))
-	(electric-c-terminator arg))
-    (self-insert-command (prefix-numeric-value arg))))
-
-(defun electric-c-semi (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (if c-auto-newline
-      (electric-c-terminator arg)
-    (self-insert-command (prefix-numeric-value arg))))
-
-(defun electric-c-terminator (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (let (insertpos (end (point)))
-    (if (and (not arg) (eolp)
-	     (not (save-excursion
-		    (beginning-of-line)
-		    (skip-chars-forward " \t")
-		    (or (= (following-char) ?#)
-			;; Colon is special only after a label, or case ....
-			;; So quickly rule out most other uses of colon
-			;; and do no indentation for them.
-			(and (eq last-command-char ?:)
-			     (not (looking-at c-switch-label-regexp))
-			     (save-excursion
-			       (skip-chars-forward "a-zA-Z0-9_$")
-			       (skip-chars-forward " \t")
-			       (< (point) end)))
-			(progn
-			  (beginning-of-defun)
-			  (let ((pps (parse-partial-sexp (point) end)))
-			    (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))))
-	(progn
-	  (insert last-command-char)
-	  (c-indent-line)
-	  (and c-auto-newline
-	       (not (c-inside-parens-p))
-	       (progn
-		 (newline)
-		 ;; (newline) may have done auto-fill
-		 (setq insertpos (- (point) 2))
-		 (c-indent-line)))
-	  (save-excursion
-	    (if insertpos (goto-char (1+ insertpos)))
-	    (delete-char -1))))
-    (if insertpos
-	(save-excursion
-	  (goto-char insertpos)
-	  (self-insert-command (prefix-numeric-value arg)))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun c-inside-parens-p ()
-  (condition-case ()
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region (point)
-			    (progn (beginning-of-defun) (point)))
-	  (goto-char (point-max))
-	  (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
-    (error nil)))
-
-(defun c-indent-command (&optional whole-exp)
-  "Indent current line as C code, or in some cases insert a tab character.
-If `c-tab-always-indent' is non-nil (the default), always indent current line.
-Otherwise, indent the current line only if point is at the left margin or
-in the line's indentation; otherwise insert a tab.
-
-A numeric argument, regardless of its value, means indent rigidly all the
-lines of the expression starting after point so that this line becomes
-properly indented.  The relative indentation among the lines of the
-expression are preserved."
-  (interactive "P")
-  (if whole-exp
-      ;; If arg, always indent this line as C
-      ;; and shift remaining lines of expression the same amount.
-      (let ((shift-amt (c-indent-line))
-	    beg end)
-	(save-excursion
-	  (if c-tab-always-indent
-	      (beginning-of-line))
-	  ;; Find beginning of following line.
-	  (save-excursion
-	    (forward-line 1) (setq beg (point)))
-	  ;; Find first beginning-of-sexp for sexp extending past this line.
-	  (while (< (point) beg)
-	    (forward-sexp 1)
-	    (setq end (point))
-	    (skip-chars-forward " \t\n")))
-	(if (> end beg)
-	    (indent-code-rigidly beg end shift-amt "#")))
-    (if (and (not c-tab-always-indent)
-	     (save-excursion
-	       (skip-chars-backward " \t")
-	       (not (bolp))))
-	(insert-tab)
-      (c-indent-line))))
-
-(defun c-indent-line ()
-  "Indent current line as C code.
-Return the amount the indentation changed by."
-  (let ((indent (calculate-c-indent nil))
-	beg shift-amt
-	(case-fold-search nil)
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((eq indent nil)
-	   (setq indent (current-indentation)))
-	  ((eq indent t)
-	   (setq indent (calculate-c-indent-within-comment)))
-	  ((looking-at "[ \t]*#")
-	   (setq indent 0))
-	  (t
-	   (skip-chars-forward " \t")
-	   (if (listp indent) (setq indent (car indent)))
-	   (cond ((or (looking-at c-switch-label-regexp)
-		      (and (looking-at "[A-Za-z]")
-			   (save-excursion
-			     (forward-sexp 1)
-			     (looking-at ":"))))
-		  (setq indent (max 1 (+ indent c-label-offset))))
-		 ((and (looking-at "else\\b")
-		       (not (looking-at "else\\s_")))
-		  (setq indent (save-excursion
-				 (c-backward-to-start-of-if)
-				 (current-indentation))))
-		 ((and (looking-at "}[ \t]*else\\b")
-		       (not (looking-at "}[ \t]*else\\s_")))
-		  (setq indent (save-excursion
-				 (forward-char)
-				 (backward-sexp)
-				 (c-backward-to-start-of-if)
-				 (current-indentation))))
-		 ((and (looking-at "while\\b")
-		       (not (looking-at "while\\s_"))
-		       (save-excursion
-			 (c-backward-to-start-of-do)))
-		  ;; This is a `while' that ends a do-while.
-		  (setq indent (save-excursion
-				 (c-backward-to-start-of-do)
-				 (current-indentation))))
-		 ((= (following-char) ?})
-		  (setq indent (- indent c-indent-level)))
-		 ((= (following-char) ?{)
-		  (setq indent (+ indent c-brace-offset))))))
-    (skip-chars-forward " \t")
-    (setq shift-amt (- indent (current-column)))
-    (if (zerop shift-amt)
-	(if (> (- (point-max) pos) (point))
-	    (goto-char (- (point-max) pos)))
-      (delete-region beg (point))
-      (indent-to indent)
-      ;; If initial point was within line's indentation,
-      ;; position after the indentation.  Else stay at same point in text.
-      (if (> (- (point-max) pos) (point))
-	  (goto-char (- (point-max) pos))))
-    shift-amt))
-
-(defun calculate-c-indent (&optional parse-start)
-  "Return appropriate indentation for current line as C code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment."
-  (save-excursion
-    (beginning-of-line)
-    (let ((indent-point (point))
-	  (case-fold-search nil)
-	  state
-	  containing-sexp)
-      (if parse-start
-	  (goto-char parse-start)
-	(beginning-of-defun))
-      (while (< (point) indent-point)
-	(setq parse-start (point))
-	(setq state (parse-partial-sexp (point) indent-point 0))
-	(setq containing-sexp (car (cdr state))))
-      (cond ((or (nth 3 state) (nth 4 state))
-	     ;; return nil or t if should not change this line
-	     (nth 4 state))
-	    ((null containing-sexp)
-	     ;; Line is at top level.  May be data or function definition,
-	     ;; or may be function argument declaration.
-	     ;; Indent like the previous top level line
-	     ;; unless that ends in a closeparen without semicolon,
-	     ;; in which case this line is the first argument decl.
-	     (goto-char indent-point)
-	     (skip-chars-forward " \t")
-	     (if (= (following-char) ?{)
-		 0   ; Unless it starts a function body
-	       (c-backward-to-noncomment (or parse-start (point-min)))
-	       ;; Look at previous line that's at column 0
-	       ;; to determine whether we are in top-level decls
-	       ;; or function's arg decls.  Set basic-indent accordingly.
-	       (let ((basic-indent
-		      (save-excursion
-			(re-search-backward "^[^ \^L\t\n#]" nil 'move)
-			(let (comment lim)
-			  ;; Recognize the DEFUN macro in Emacs.
-			  (if (save-excursion
-				;; Move down to the (putative) argnames line.
-				(while (and (not (eobp))
-					    (not (looking-at " *[({}#/]")))
-				  (forward-line 1))
-				;; Go back to the DEFUN, if it is one.
-				(condition-case nil
-				    (backward-sexp 1)
-				  (error))
-				(beginning-of-line)
-				(looking-at "DEFUN\\b"))
-			      c-argdecl-indent
-			    (if (and (looking-at "\\sw\\|\\s_")
-				     ;; This is careful to stop at the first
-				     ;; paren if we have
-				     ;; int foo Proto ((int, int));
-				     (looking-at "[^\"\n=(]*(")
-				     (progn
-				       (goto-char (1- (match-end 0)))
-				       ;; Skip any number of paren-groups.
-				       ;; Consider typedef int (*fcn) (int);
-				       (while (= (following-char) ?\()
-					 (setq lim (point))
-					 (condition-case nil
-					     (forward-sexp 1)
-					   (error))
-					 (skip-chars-forward " \t\f"))
-				       ;; Have we reached something
-				       ;; that shows this isn't a function
-				       ;; definition?
-				       (and (< (point) indent-point)
-					    (not (memq (following-char)
-						       '(?\, ?\;)))))
-				     ;; Make sure the "function decl" we found
-				     ;; is not inside a comment.
-				     (progn
-				       ;; Move back to the `(' starting arglist
-				       (goto-char lim)
-				       (beginning-of-line)
-				       (while (and (not comment)
-						   (search-forward "/*" lim t))
-					 (setq comment
-					       (not (search-forward "*/" lim t))))
-				       (not comment)))
-				c-argdecl-indent 0))))))
-		 basic-indent)))
-
-;; 		 ;; Now add a little if this is a continuation line.
-;; 		 (+ basic-indent (if (or (bobp)
-;; 					 (memq (preceding-char) '(?\) ?\; ?\}))
-;; 					 ;; Line with zero indentation
-;; 					 ;; is probably the return-type
-;; 					 ;; of a function definition,
-;; 					 ;; so following line is function name.
-;; 					 (= (current-indentation) 0))
-;;				     0 c-continued-statement-offset))
-
-	    ((/= (char-after containing-sexp) ?{)
-	     ;; line is expression, not statement:
-	     ;; indent to just after the surrounding open.
-	     (goto-char (1+ containing-sexp))
-	     (current-column))
-	    (t
-	     ;; Statement level.  Is it a continuation or a new statement?
-	     ;; Find previous non-comment character.
-	     (goto-char indent-point)
-	     (c-backward-to-noncomment containing-sexp)
-	     ;; Back up over label lines, since they don't
-	     ;; affect whether our line is a continuation.
-	     (while (or (eq (preceding-char) ?\,)
-			(and (eq (preceding-char) ?:)
-			     (or (eq (char-after (- (point) 2)) ?\')
-				 (memq (char-syntax (char-after (- (point) 2)))
-				       '(?w ?_)))))
-	       (if (eq (preceding-char) ?\,)
-		   (progn (forward-char -1)
-			  (c-backward-to-start-of-continued-exp containing-sexp)))
-	       (beginning-of-line)
-	       (c-backward-to-noncomment containing-sexp))
-	     ;; Check for a preprocessor statement or its continuation lines.
-	     ;; Move back to end of previous non-preprocessor line,
-	     ;; or possibly beginning of buffer.
-	     (let ((found (point)) stop)
-	       (while (not stop)
-		 (beginning-of-line)
-		 (cond ((bobp)
-			(setq found (point)
-			      stop t))
-		       ((save-excursion (forward-char -1)
-					(= (preceding-char) ?\\))
-			(forward-char -1))
-		       ;; This line is not preceded by a backslash.
-		       ;; So either it starts a preprocessor command
-		       ;; or any following continuation lines
-		       ;; should not be skipped.
-		       ((= (following-char) ?#)
-			(forward-char -1)
-			(setq found (point)))
-		       (t (setq stop t))))
-	       (goto-char found))
-	     ;; Now we get the answer.
-	     (if (and (not (memq (preceding-char) '(0 ?\, ?\; ?\} ?\{)))
-		      ;; But don't treat a line with a close-brace
-		      ;; as a continuation.  It is probably the
-		      ;; end of an enum type declaration.
-		      (save-excursion
-			(goto-char indent-point)
-			(skip-chars-forward " \t")
-			(not (= (following-char) ?}))))
-		 ;; This line is continuation of preceding line's statement;
-		 ;; indent  c-continued-statement-offset  more than the
-		 ;; previous line of the statement.
-		 (progn
-		   (c-backward-to-start-of-continued-exp containing-sexp)
-		   (+ c-continued-statement-offset (current-column)
-		      (if (save-excursion (goto-char indent-point)
-					  (skip-chars-forward " \t")
-					  (eq (following-char) ?{))
-			  c-continued-brace-offset 0)))
-	       ;; This line starts a new statement.
-	       ;; Position following last unclosed open.
-	       (goto-char containing-sexp)
-	       ;; Is line first statement after an open-brace?
-	       (or
-		 ;; If no, find that first statement and indent like it.
-		 (save-excursion
-		   (forward-char 1)
-		   (let ((colon-line-end 0))
-		     (while (progn (skip-chars-forward " \t\n")
-				   (looking-at "#\\|/\\*\\|case[ \t\n'/(].*:\\|[a-zA-Z0-9_$]*:"))
-		       ;; Skip over comments and labels following openbrace.
-		       (cond ((= (following-char) ?\#)
-			      (forward-line 1))
-			     ((= (following-char) ?\/)
-			      (forward-char 2)
-			      (search-forward "*/" nil 'move))
-			     ;; case or label:
-			     (t
-			      (save-excursion (end-of-line)
-					      (setq colon-line-end (point)))
-			      (search-forward ":"))))
-		     ;; The first following code counts
-		     ;; if it is before the line we want to indent.
-		     (and (< (point) indent-point)
-			  (-
-			   (if (> colon-line-end (point))
-			       (- (current-indentation) c-label-offset)
-			     (current-column))
-			   ;; If prev stmt starts with open-brace, that
-			   ;; open brace was offset by c-brace-offset.
-			   ;; Compensate to get the column where
-			   ;; an ordinary statement would start.
-			   (if (= (following-char) ?\{) c-brace-offset 0)))))
-		 ;; If no previous statement,
-		 ;; indent it relative to line brace is on.
-		 (calculate-c-indent-after-brace))))))))
-
-(defun calculate-c-indent-after-brace ()
-  "Return the proper C indent for the first line after an open-brace.
-This function is called with point before the brace."
-  ;; For open brace in column zero, don't let statement
-  ;; start there too.  If c-indent-level is zero,
-  ;; use c-brace-offset + c-continued-statement-offset instead.
-  ;; For open-braces not the first thing in a line,
-  ;; add in c-brace-imaginary-offset.
-  (+ (if (and (bolp) (zerop c-indent-level))
-	 (+ c-brace-offset c-continued-statement-offset)
-       c-indent-level)
-     ;; Move back over whitespace before the openbrace.
-     ;; If openbrace is not first nonwhite thing on the line,
-     ;; add the c-brace-imaginary-offset.
-     (progn (skip-chars-backward " \t")
-	    (if (bolp) 0 c-brace-imaginary-offset))
-     ;; If the openbrace is preceded by a parenthesized exp,
-     ;; move to the beginning of that;
-     ;; possibly a different line
-     (progn
-       (if (eq (preceding-char) ?\))
-	   (forward-sexp -1))
-       ;; Get initial indentation of the line we are on.
-       (current-indentation))))
-
-(defun calculate-c-indent-within-comment (&optional after-star)
-  "Return the indentation amount for line inside a block comment.
-Optional arg AFTER-STAR means, if lines in the comment have a leading star,
-return the indentation of the text that would follow this star."
-  (let (end star-start)
-    (save-excursion
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (setq star-start (= (following-char) ?\*))
-      (skip-chars-backward " \t\n")
-      (setq end (point))
-      (beginning-of-line)
-      (skip-chars-forward " \t")
-      (if after-star
-	  (and (looking-at "\\*")
-	       (re-search-forward "\\*[ \t]*")))
-      (and (re-search-forward "/\\*[ \t]*" end t)
-	   star-start
-	   (not after-star)
-	   (goto-char (1+ (match-beginning 0))))
-      (if (and (looking-at "[ \t]*$") (= (preceding-char) ?\*))
-	  (1+ (current-column))
-	(current-column)))))
-
-
-(defun c-backward-to-noncomment (lim)
-  (let (opoint stop)
-    (while (not stop)
-      (skip-chars-backward " \t\n\f" lim)
-      (setq opoint (point))
-      (if (and (>= (point) (+ 2 lim))
-	       (save-excursion
-		 (forward-char -2)
-		 (looking-at "\\*/")))
-	  (search-backward "/*" lim 'move)
-	(setq stop (or (<= (point) lim)
-		       (save-excursion
-			 (beginning-of-line)
-			 (skip-chars-forward " \t")
-			 (not (looking-at "#")))))
-	(or stop (beginning-of-line))))))
-
-(defun c-backward-to-start-of-continued-exp (lim)
-  (if (memq (preceding-char) '(?\) ?\"))
-      (forward-sexp -1))
-  (beginning-of-line)
-  (if (<= (point) lim)
-      (goto-char (1+ lim)))
-  (skip-chars-forward " \t"))
-
-(defun c-backward-to-start-of-if (&optional limit)
-  "Move to the start of the last \"unbalanced\" `if'."
-  (or limit (setq limit (save-excursion (beginning-of-defun) (point))))
-  (let ((if-level 1)
-	(case-fold-search nil))
-    (while (and (not (bobp)) (not (zerop if-level)))
-      (backward-sexp 1)
-      (cond ((and (looking-at "else\\b")
-		  (not (looking-at "else\\s_")))
-	     (setq if-level (1+ if-level)))
-	    ((and (looking-at "if\\b")
-		  (not (looking-at "if\\s_")))
-	     (setq if-level (1- if-level)))
-	    ((< (point) limit)
-	     (setq if-level 0)
-	     (goto-char limit))))))
-
-(defun c-backward-to-start-of-do (&optional limit)
-  "If point follows a `do' statement, move to beginning of it and return t.
-Otherwise return nil and don't move point."
-  (or limit (setq limit (save-excursion (beginning-of-defun) (point))))
-  (let ((first t)
-	(startpos (point))
-	(done nil))
-    (while (not done)
-      (let ((next-start (point)))
-	(condition-case nil
-	    ;; Move back one token or one brace or paren group.
-	    (backward-sexp 1)
-	  ;; If we find an open-brace, we lose.
-	  (error (setq done 'fail)))
-	(if done
-	    nil
-	  ;; If we reached a `do', we win.
-	  (if (looking-at "do\\b")
-	      (setq done 'succeed)
-	    ;; Otherwise, if we skipped a semicolon, we lose.
-	    ;; (Exception: we can skip one semicolon before getting
-	    ;; to a the last token of the statement, unless that token
-	    ;; is a close brace.)
-	    (if (save-excursion
-		  (forward-sexp 1)
-		  (or (and (not first) (= (preceding-char) ?}))
-		      (search-forward ";" next-start t
-				      (if (and first
-					       (/= (preceding-char) ?}))
-					  2 1))))
-		(setq done 'fail)
-	      (setq first nil)
-	      ;; If we go too far back in the buffer, we lose.
-	      (if (< (point) limit)
-		  (setq done 'fail)))))))
-    (if (eq done 'succeed)
-	t
-      (goto-char startpos)
-      nil)))
-
-(defun c-beginning-of-statement (count)
-  "Go to the beginning of the innermost C statement.
-With prefix arg, go back N - 1 statements.  If already at the beginning of a
-statement then go to the beginning of the preceding one.
-If within a string or comment, or next to a comment (only whitespace between),
-move by sentences instead of statements."
-  (interactive "p")
-  (let ((here (point)) state)
-    (save-excursion
-      (beginning-of-defun)
-      (setq state (parse-partial-sexp (point) here nil nil)))
-    (if (or (nth 3 state) (nth 4 state)
-	    (looking-at (concat "[ \t]*" comment-start-skip))
-	    (save-excursion (skip-chars-backward " \t")
-			    (goto-char (- (point) 2))
-			    (looking-at "\\*/")))
-	(forward-sentence (- count))
-      (while (> count 0)
-	(c-beginning-of-statement-1)
-	(setq count (1- count)))
-      (while (< count 0)
-	(c-end-of-statement-1)
-	(setq count (1+ count))))))
-
-(defun c-end-of-statement (count)
-  "Go to the end of the innermost C statement.
-With prefix arg, go forward N - 1 statements.
-Move forward to end of the next statement if already at end.
-If within a string or comment, move by sentences instead of statements."
-  (interactive "p")
-  (c-beginning-of-statement (- count)))
-
-(defun c-beginning-of-statement-1 ()
-  (let ((last-begin (point))
-	(first t))
-    (condition-case ()
-	(progn
-	  (while (and (not (bobp))
-		      (progn
-			(backward-sexp 1)
-			(or first
-			    (not (re-search-forward "[;{}]" last-begin t)))))
-	    (setq last-begin (point) first nil))
-	  (goto-char last-begin))
-      (error (if first (backward-up-list 1) (goto-char last-begin))))))
-
-(defun c-end-of-statement-1 ()
-  (condition-case ()
-      (progn
-	(while (and (not (eobp))
-		    (let ((beg (point)))
-		      (forward-sexp 1)
-		      (let ((end (point)))
-			(save-excursion
-			  (goto-char beg)
-			  (not (re-search-forward "[;{}]" end t)))))))
-	(re-search-backward "[;}]")
-	(forward-char 1))
-    (error
-     (let ((beg (point)))
-       (backward-up-list -1)
-       (let ((end (point)))
-	 (goto-char beg)
-	 (search-forward ";" end 'move))))))
-
-(defun mark-c-function ()
-  "Put mark at end of C function, point at beginning."
-  (interactive)
-  (push-mark (point))
-  (end-of-defun)
-  (push-mark (point) nil t)
-  (beginning-of-defun)
-  (backward-paragraph))
-
-;; Idea of ENDPOS is, indent each line, stopping when
-;; ENDPOS is encountered.  But it's too much of a pain to make that work.
-(defun indent-c-exp (&optional endpos)
-  "Indent each line of the C grouping following point."
-  (interactive)
-  (let* ((indent-stack (list nil))
-	 (opoint (point))  ;; May be altered below.
-	 (contain-stack
-	  (list (if endpos
-		    (let (funbeg)
-		      ;; Find previous fcn-start.
-		      (save-excursion (forward-char 1)
-				      (beginning-of-defun)
-				      (setq funbeg (point)))
-		      (setq opoint funbeg)
-		      ;; Try to find containing open,
-		      ;; but don't scan past that fcn-start.
-		      (save-restriction
-			(narrow-to-region funbeg (point))
-			(condition-case nil
-			    (save-excursion
-			      (backward-up-list 1)
-			      (point))
-			  ;; We gave up: must be between fcns.
-			  ;; Set opoint to beg of prev fcn
-			  ;; since otherwise calculate-c-indent
-			  ;; will get wrong answers.
-			  (error (setq opoint funbeg)
-				 (point)))))
-		  (point))))
-	 (case-fold-search nil)
-	 restart outer-loop-done inner-loop-done state ostate
-	 this-indent last-sexp
-	 at-else at-brace at-while
-	 last-depth this-point
-	 (next-depth 0))
-    ;; If the braces don't match, get an error right away.
-    (save-excursion
-      (forward-sexp 1))
-    ;; Realign the comment on the first line, even though we don't reindent it.
-    (save-excursion
-      (let ((beg (point)))
-	(and (re-search-forward
-	      comment-start-skip
-	      (save-excursion (end-of-line) (point)) t)
-	     ;; Make sure this isn't a comment alone on a line
-	     ;; (which should be indented like code instead).
-	     (save-excursion
-	       (goto-char (match-beginning 0))
-	       (skip-chars-backward " \t")
-	       (not (bolp)))
-	     ;; Make sure the comment starter we found
-	     ;; is not actually in a string or quoted.
-	     (let ((new-state
-		    (parse-partial-sexp beg (point)
-					nil nil state)))
-	       (and (not (nth 3 new-state)) (not (nth 5 new-state))))
-	    (progn (indent-for-comment) (beginning-of-line)))))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (and (not (eobp))
-		  (if endpos (< (point) endpos)
-		    (not outer-loop-done)))
-	(setq last-depth next-depth)
-	;; Compute how depth changes over this line
-	;; plus enough other lines to get to one that
-	;; does not end inside a comment or string.
-	;; Meanwhile, do appropriate indentation on comment lines.
-	(setq inner-loop-done nil)
-	(while (and (not inner-loop-done)
-		    (not (and (eobp) (setq outer-loop-done t))))
-	  (setq ostate state)
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  (if (and (car (cdr (cdr state)))
-		   (>= (car (cdr (cdr state))) 0))
-	      (setq last-sexp (car (cdr (cdr state)))))
-	  ;; If this line started within a comment, indent it as such.
-	  (if (or (nth 4 ostate) (nth 7 ostate))
-	      (c-indent-line))
-	  ;; If it ends outside of comments or strings, exit the inner loop.
-	  ;; Otherwise move on to next line.
-	  (if (or (nth 3 state) (nth 4 state) (nth 7 state))
-	      (forward-line 1)
-	    (setq inner-loop-done t)))
-	(and endpos
-	     (while (< next-depth 0)
-	       (setq indent-stack (append indent-stack (list nil)))
-	       (setq contain-stack (append contain-stack (list nil)))
-	       (setq next-depth (1+ next-depth))
-	       (setq last-depth (1+ last-depth))
-	       (setcar (nthcdr 6 state) (1+ (nth 6 state)))))
-	(setq outer-loop-done (and (not endpos) (<= next-depth 0)))
-	(if outer-loop-done
-	    nil
-	  ;; If this line had ..))) (((.. in it, pop out of the levels
-	  ;; that ended anywhere in this line, even if the final depth
-	  ;; doesn't indicate that they ended.
-	  (while (> last-depth (nth 6 state))
-	    (setq indent-stack (cdr indent-stack)
-		  contain-stack (cdr contain-stack)
-		  last-depth (1- last-depth)))
-	  (if (/= last-depth next-depth)
-	      (setq last-sexp nil))
-	  ;; Add levels for any parens that were started in this line.
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  contain-stack (cons nil contain-stack)
-		  last-depth (1+ last-depth)))
-	  (if (null (car contain-stack))
-	      (setcar contain-stack (or (car (cdr state))
-					(save-excursion (forward-sexp -1)
-							(point)))))
-	  (forward-line 1)
-	  (skip-chars-forward " \t")
-	  ;; Don't really reindent if the line is just whitespace,
-	  ;; or if it is past the endpos.
-	  ;; (The exit test in the outer while
-	  ;; does not exit until we have passed the first line
-	  ;; past the region.)
-	  (if (or (eolp) (and endpos (>= (point) endpos)))
-	      nil
-	    ;; Is this line in a new nesting level?
-	    ;; In other words, is this the first line that
-	    ;; starts in the new level?
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		nil
-	      ;; Yes.
-	      ;; Compute the standard indent for this level.
-	      (let (val)
-		(if (= (char-after (car contain-stack)) ?{)
-		    (save-excursion
-		      (goto-char (car contain-stack))
-		      (setq val (calculate-c-indent-after-brace)))
-		  (setq val (calculate-c-indent
-			     (if (car indent-stack)
-				 (- (car indent-stack))
-			       opoint))))
-		;; t means we are in a block comment and should
-		;; calculate accordingly.
-		(if (eq val t)
-		    (setq val (calculate-c-indent-within-comment)))
-		(setcar indent-stack val)))
-	    ;; Adjust indent of this individual line
-	    ;; based on its predecessor.
-	    ;; Handle continuation lines, if, else, while, and so on.
-	    (if (/= (char-after (car contain-stack)) ?{)
-		(setq this-indent (car indent-stack))
-	      ;; Line is at statement level.
-	      ;; Is it a new statement?  Is it an else?
-	      ;; Find last non-comment character before this line
-	      (save-excursion
-		(setq this-point (point))
-		(setq at-else (and (looking-at "else\\b")
-				   (not (looking-at "else\\s_"))))
-		(setq at-brace (= (following-char) ?{))
-		(setq at-while (and (looking-at "while\\b")
-				    (not (looking-at "while\\s_"))))
-		(if (= (following-char) ?})
-		    (setq this-indent (car indent-stack))
-		  (c-backward-to-noncomment opoint)
-		  (if (not (memq (preceding-char) '(0 ?\, ?\; ?} ?: ?{)))
-		      ;; Preceding line did not end in comma or semi;
-		      ;; indent this line  c-continued-statement-offset
-		      ;; more than previous.
-		      (progn
-			(c-backward-to-start-of-continued-exp (car contain-stack))
-			(setq this-indent
-			      (+ c-continued-statement-offset (current-column)
-				 (if at-brace c-continued-brace-offset 0))))
-		    ;; Preceding line ended in comma or semi;
-		    ;; use the standard indent for this level.
-		    (cond (at-else (progn (c-backward-to-start-of-if opoint)
-					  (setq this-indent
-						(current-indentation))))
-			  ((and at-while (c-backward-to-start-of-do opoint))
-			   (setq this-indent (current-indentation)))
-			  ((eq (preceding-char) ?\,)
-			   (goto-char this-point)
-			   (setq this-indent (calculate-c-indent)))
-			  (t (setq this-indent (car indent-stack))))))))
-	    ;; Adjust line indentation according to its contents
-	    (if (or (looking-at c-switch-label-regexp)
-		    (and (looking-at "[A-Za-z]")
-			 (save-excursion
-			   (forward-sexp 1)
-			   (looking-at ":"))))
-		(setq this-indent (max 1 (+ this-indent c-label-offset))))
-	    (if (= (following-char) ?})
-		(setq this-indent (- this-indent c-indent-level)))
-	    (if (= (following-char) ?{)
-		;; Don't move an open-brace in column 0.
-		;; This is good when constructs such as
-		;; `extern "C" {' surround a function definition
-		;; that should be indented as usual.
-		;; It is also good for nested functions.
-		;; It is bad when an open-brace is indented at column 0
-		;; and you want to fix that, but we can't win 'em all.
-		(if (zerop (current-column))
-		    (setq this-indent 0)
-		  (setq this-indent (+ this-indent c-brace-offset))))
-	    ;; Don't leave indentation in empty lines.
-	    (if (eolp) (setq this-indent 0))
-	    ;; Put chosen indentation into effect.
-	    (or (= (current-column) this-indent)
-		(= (following-char) ?\#)
-		(progn
-		  (delete-region (point) (progn (beginning-of-line) (point)))
-		  (indent-to this-indent)))
-	    ;; Indent any comment following the text.
-	    (or (looking-at comment-start-skip)
-		(save-excursion
-		  (let ((beg (point)))
-		    (and (re-search-forward
-			  comment-start-skip
-			  (save-excursion (end-of-line) (point)) t)
-			 ;; Make sure the comment starter we found
-			 ;; is not actually in a string or quoted.
-			 (let ((new-state
-				(parse-partial-sexp beg (point)
-						    nil nil state)))
-			   (and (not (nth 3 new-state)) (not (nth 5 new-state))))
-			 (indent-for-comment)))))))))))
-
-;; Look at all comment-start strings in the current line after point.
-;; Return t if one of them starts a real comment.
-;; This is not used yet, because indent-for-comment
-;; isn't smart enough to handle the cases this can find.
-(defun indent-c-find-real-comment ()
-  (let (win)
-    (while (and (not win)
-		(re-search-forward comment-start-skip
-				   (save-excursion (end-of-line) (point))
-				   t))
-      ;; Make sure the comment start is not quoted.
-      (let ((state-1
-	     (parse-partial-sexp
-	      (save-excursion (beginning-of-line) (point))
-	      (point) nil nil state)))
-	(setq win (and (null (nth 3 state-1)) (null (nth 5 state-1))))))
-    win))
-
-;; Indent every line whose first char is between START and END inclusive.
-(defun c-indent-region (start end)
-  (save-excursion
-    (goto-char start)
-    ;; Advance to first nonblank line.
-    (skip-chars-forward " \t\n")
-    (beginning-of-line)
-    (let ((endmark (copy-marker end))
-	  (c-tab-always-indent t))
-      (while (and (bolp) (not (eobp)) (< (point) endmark))
-	;; Indent one line as with TAB.
-	(let ((shift-amt (c-indent-line))
-	      nextline sexpbeg sexpend)
-	  (if (save-excursion (beginning-of-line) (looking-at "[ \t]*#"))
-	      (forward-line 1)
-	    (save-excursion
-	      ;; Find beginning of following line.
-	      (save-excursion
-		(forward-line 1) (setq nextline (point)))
-	      ;; Find first beginning-of-sexp for sexp extending past this line.
-	      (beginning-of-line)
-	      (while (< (point) nextline)
-		(condition-case nil
-		    (progn
-		      (forward-sexp 1)
-		      (setq sexpend (point-marker)))
-		  (error (setq sexpend nil)
-			 (goto-char nextline)))
-		(skip-chars-forward " \t\n"))
-	      (if sexpend
-		  (progn
-		    ;; Make sure the sexp we found really starts on the
-		    ;; current line and extends past it.
-		    (goto-char sexpend)
-		    (backward-sexp 1)
-		    (setq sexpbeg (point)))))
-	    ;; If that sexp ends within the region,
-	    ;; indent it all at once, fast.
-	    (if (and sexpend (> sexpend nextline) (<= sexpend endmark)
-		     (< sexpbeg nextline))
-		(progn
-		  (indent-c-exp)
-		  (goto-char sexpend)))
-	    ;; Move to following line and try again.
-	    (and sexpend (set-marker sexpend nil))
-	    (forward-line 1))))
-      (set-marker endmark nil))))
-
-(defun set-c-style (style &optional global)
-  "Set C-mode variables to use one of several different indentation styles.
-The arguments are a string representing the desired style
-and a flag which, if non-nil, means to set the style globally.
-\(Interactively, the flag comes from the prefix argument.)
-Available styles are GNU, K&R, BSD and Whitesmith."
-  (interactive (list (let ((completion-ignore-case t))
-		       (completing-read "Use which C indentation style? "
-					c-style-alist nil t))
-		     current-prefix-arg))
-  (let ((vars (cdr (assoc style c-style-alist))))
-    (or vars
-	(error "Invalid C indentation style `%s'" style))
-    (while vars
-      (or global
-	  (make-local-variable (car (car vars))))
-      (set (car (car vars)) (cdr (car vars)))
-      (setq vars (cdr vars)))))
-
-;;; This page handles insertion and removal of backslashes for C macros.
-
-(defvar c-backslash-column 48
-  "*Minimum column for end-of-line backslashes of macro definitions.")
-
-(defun c-backslash-region (from to delete-flag)
-  "Insert, align, or delete end-of-line backslashes on the lines in the region.
-With no argument, inserts backslashes and aligns existing backslashes.
-With an argument, deletes the backslashes.
-
-This function does not modify the last line of the region if the region ends
-right at the start of the following line; it does not modify blank lines
-at the start of the region.  So you can put the region around an entire macro
-definition and conveniently use this command."
-  (interactive "r\nP")
-  (save-excursion
-    (goto-char from)
-    (let ((column c-backslash-column)
-	  (endmark (make-marker)))
-      (move-marker endmark to)
-      ;; Compute the smallest column number past the ends of all the lines.
-      (if (not delete-flag)
-	  (while (< (point) to)
-	    (end-of-line)
-	    (if (= (preceding-char) ?\\)
-		(progn (forward-char -1)
-		       (skip-chars-backward " \t")))
-	    (setq column (max column (1+ (current-column))))
-	    (forward-line 1)))
-      ;; Adjust upward to a tab column, if that doesn't push past the margin.
-      (if (> (% column tab-width) 0)
-	  (let ((adjusted (* (/ (+ column tab-width -1) tab-width) tab-width)))
-	    (if (< adjusted (window-width))
-		(setq column adjusted))))
-      ;; Don't modify blank lines at start of region.
-      (goto-char from)
-      (while (and (< (point) endmark) (eolp))
-	(forward-line 1))
-      ;; Add or remove backslashes on all the lines.
-      (while (and (< (point) endmark)
-		  ;; Don't backslashify the last line
-		  ;; if the region ends right at the start of the next line.
-		  (save-excursion
-		    (forward-line 1)
-		    (< (point) endmark)))
-	(if (not delete-flag)
-	    (c-append-backslash column)
-	  (c-delete-backslash))
-	(forward-line 1))
-      (move-marker endmark nil))))
-
-(defun c-append-backslash (column)
-  (end-of-line)
-  ;; Note that "\\\\" is needed to get one backslash.
-  (if (= (preceding-char) ?\\)
-      (progn (forward-char -1)
-	     (delete-horizontal-space)
-	     (indent-to column))
-    (indent-to column)
-    (insert "\\")))
-
-(defun c-delete-backslash ()
-  (end-of-line)
-  (or (bolp)
-      (progn
-	(forward-char -1)
-	(if (looking-at "\\\\")
-	    (delete-region (1+ (point))
-			   (progn (skip-chars-backward " \t") (point)))))))
-
-(defun c-up-conditional (count)
-  "Move back to the containing preprocessor conditional, leaving mark behind.
-A prefix argument acts as a repeat count.  With a negative argument,
-move forward to the end of the containing preprocessor conditional.
-When going backwards, `#elif' is treated like `#else' followed by `#if'.
-When going forwards, `#elif' is ignored."
-  (interactive "p")
-  (c-forward-conditional (- count) t))
-
-(defun c-backward-conditional (count &optional up-flag)
-  "Move back across a preprocessor conditional, leaving mark behind.
-A prefix argument acts as a repeat count.  With a negative argument,
-move forward across a preprocessor conditional."
-  (interactive "p")
-  (c-forward-conditional (- count) up-flag))
-
-(defun c-forward-conditional (count &optional up-flag)
-  "Move forward across a preprocessor conditional, leaving mark behind.
-A prefix argument acts as a repeat count.  With a negative argument,
-move backward across a preprocessor conditional."
-  (interactive "p")
-  (let* ((forward (> count 0))
-	 (increment (if forward -1 1))
-	 (search-function (if forward 're-search-forward 're-search-backward))
-	 (opoint (point))
-	 (new))
-    (save-excursion
-      (while (/= count 0)
-	(let ((depth (if up-flag 0 -1)) found)
-	  (save-excursion
-	    ;; Find the "next" significant line in the proper direction.
-	    (while (and (not found)
-			;; Rather than searching for a # sign that comes
-			;; at the beginning of a line aside from whitespace,
-			;; search first for a string starting with # sign.
-			;; Then verify what precedes it.
-			;; This is faster on account of the fastmap feature of
-			;; the regexp matcher.
-			(funcall search-function
-				 "#[ \t]*\\(if\\|elif\\|endif\\)"
-				 nil t))
-	      (beginning-of-line)
-	      ;; Now verify it is really a preproc line.
-	      (if (looking-at "^[ \t]*#[ \t]*\\(if\\|elif\\|endif\\)")
-		  (let ((prev depth))
-		    ;; Update depth according to what we found.
-		    (beginning-of-line)
-		    (cond ((looking-at "[ \t]*#[ \t]*endif")
-			   (setq depth (+ depth increment)))
-			  ((looking-at "[ \t]*#[ \t]*elif")
-			   (if (and forward (= depth 0))
-			       (setq found (point))))
-			  (t (setq depth (- depth increment))))
-		    ;; If we are trying to move across, and we find
-		    ;; an end before we find a beginning, get an error.
-		    (if (and (< prev 0) (< depth prev))
-			(error (if forward
-				   "No following conditional at this level"
-				 "No previous conditional at this level")))
-		    ;; When searching forward, start from next line
-		    ;; so that we don't find the same line again.
-		    (if forward (forward-line 1))
-		    ;; If this line exits a level of conditional, exit inner loop.
-		    (if (< depth 0)
-			(setq found (point))))
-		;; If the line is not really a conditional, skip past it.
-		(if forward (end-of-line)))))
-	  (or found
-	      (error "No containing preprocessor conditional"))
-	  (goto-char (setq new found)))
-	(setq count (+ count increment))))
-    (push-mark)
-    (goto-char new)))
-
-(provide 'c-mode)
-
-;;; c-mode.el ends here
diff --git a/lisp/progmodes/cmacexp.el b/lisp/progmodes/cmacexp.el
deleted file mode 100644
index f030ade3f67..00000000000
--- a/lisp/progmodes/cmacexp.el
+++ /dev/null
@@ -1,371 +0,0 @@
-;;; cmacexp.el --- expand C macros in a region
-
-;; Copyright (C) 1992, 1994, 1996 Free Software Foundation, Inc.
-
-;; Author: Francesco Potorti` <pot@cnuce.cnr.it>
-;; Version: $Id: cmacexp.el,v 1.25 1996/05/21 15:42:13 kwzh Exp rms $
-;; Adapted-By: ESR
-;; Keywords: c
-
-;; 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.
-
-;; USAGE =============================================================
-
-;; In C mode C-C C-e is bound to c-macro-expand.  The result of the
-;; expansion is put in a separate buffer.  A user option allows the
-;; window displaying the buffer to be optimally sized.
-;;
-;; When called with a C-u prefix, c-macro-expand replaces the selected
-;; region with the expansion.  Both the preprocessor name and the
-;; initial flag can be set by the user.  If c-macro-prompt-flag is set
-;; to a non-nil value the user is offered to change the options to the
-;; preprocessor each time c-macro-expand is invoked.  Preprocessor
-;; arguments default to the last ones entered.  If c-macro-prompt-flag
-;; is nil, one must use M-x set-variable to set a different value for
-;; c-macro-cppflags.
-
-;; A c-macro-expansion function is provided for non-interactive use.
-
-;; INSTALLATION ======================================================
-
-;; Put the following in your ~/.emacs file.
-
-;; If you want the *Macroexpansion* window to be not higher than
-;; necessary: 
-;;(setq c-macro-shrink-window-flag t)
-;;
-;; If you use a preprocessor other than /lib/cpp (be careful to set a
-;; -C option or equivalent in order to make the preprocessor not to
-;; strip the comments):
-;;(setq c-macro-preprocessor "gpp -C")
-;;
-;; If you often use a particular set of flags:
-;;(setq c-macro-cppflags "-I /usr/include/local -DDEBUG"
-;;
-;; If you want the "Preprocessor arguments: " prompt:
-;;(setq c-macro-prompt-flag t)
-
-;; BUG REPORTS =======================================================
-
-;; Please report bugs, suggestions, complaints and so on to
-;; pot@cnuce.cnr.it (Francesco Potorti`).
-
-;; IMPROVEMENTS OVER emacs 18.xx cmacexp.el ==========================
-
-;; - A lot of user and programmer visible changes.  See above.
-;; - #line directives are inserted, so __LINE__ and __FILE__ are
-;;   correctly expanded.  Works even with START inside a string, a
-;;   comment or a region #ifdef'd away by cpp. cpp is invoked with -C,
-;;   making comments visible in the expansion.
-;; - All work is done in core memory, no need for temporary files.
-
-;; ACKNOWLEDGEMENTS ==================================================
-
-;; A lot of thanks to Don Maszle who did a great work of testing, bug
-;; reporting and suggestion of new features.  This work has been
-;; partially inspired by Don Maszle and Jonathan Segal's.
-
-;; BUGS ==============================================================
-
-;; If the start point of the region is inside a macro definition the
-;; macro expansion is often inaccurate.
-
-
-(require 'cc-mode)
-
-(provide 'cmacexp)
-
-(defvar c-macro-shrink-window-flag nil
-  "*Non-nil means shrink the *Macroexpansion* window to fit its contents.")
-
-(defvar c-macro-prompt-flag nil
-  "*Non-nil makes `c-macro-expand' prompt for preprocessor arguments.")
-
-(defvar c-macro-preprocessor
-  ;; Cannot rely on standard directory on MS-DOS to find CPP.
-  (cond ((eq system-type 'ms-dos) "cpp -C")
-	;; Solaris has it in an unusual place.
-	((and (string-match "^[^-]*-[^-]*-\\(solaris\\|sunos5\\)"
-			    system-configuration)
-	      (file-exists-p "/opt/SUNWspro/SC3.0.1/bin/acomp"))
-	 "/opt/SUNWspro/SC3.0.1/bin/acomp -C -E")
-	(t "/lib/cpp -C"))
-  "The preprocessor used by the cmacexp package.
-
-If you change this, be sure to preserve the `-C' (don't strip comments)
-option, or to set an equivalent one.")
-
-(defvar c-macro-cppflags ""
-  "*Preprocessor flags used by `c-macro-expand'.")
-
-(defconst c-macro-buffer-name "*Macroexpansion*")
-
-(defun c-macro-expand (start end subst)
-  "Expand C macros in the region, using the C preprocessor.
-Normally display output in temp buffer, but
-prefix arg means replace the region with it.
-
-`c-macro-preprocessor' specifies the preprocessor to use.
-Prompt for arguments to the preprocessor \(e.g. `-DDEBUG -I ./include')
-if the user option `c-macro-prompt-flag' is non-nil.
-
-Noninteractive args are START, END, SUBST.
-For use inside Lisp programs, see also `c-macro-expansion'."
-
-  (interactive "r\nP")
-  (let ((inbuf (current-buffer))
-	(displaybuf (if subst
-			(get-buffer c-macro-buffer-name)
-		      (get-buffer-create c-macro-buffer-name)))
-	(expansion ""))
-    ;; Build the command string.
-    (if c-macro-prompt-flag
-	(setq c-macro-cppflags
-	      (read-string "Preprocessor arguments: "
-			   c-macro-cppflags)))
-    ;; Decide where to display output.
-    (if (and subst
-	     (and buffer-read-only (not inhibit-read-only))
-	     (not (eq inbuf displaybuf)))
-	(progn
-	  (message
-	   "Buffer is read only: displaying expansion in alternate window")
-	  (sit-for 2)
-	  (setq subst nil)
-	  (or displaybuf
-	      (setq displaybuf (get-buffer-create c-macro-buffer-name)))))
-    ;; Expand the macro and output it.
-    (setq expansion (c-macro-expansion start end
-				       (concat c-macro-preprocessor " "
-					       c-macro-cppflags) t))
-    (if subst
-	(let ((exchange (= (point) start)))
-	  (delete-region start end)
-	  (insert expansion)
-	  (if exchange
-	      (exchange-point-and-mark)))
-      (set-buffer displaybuf)
-      (setq buffer-read-only nil)
-      (buffer-disable-undo displaybuf)
-      (erase-buffer)
-      (insert expansion)
-      (set-buffer-modified-p nil)
-      (if (string= "" expansion)
-	  (message "Null expansion")
-	(c-macro-display-buffer))
-      (setq buffer-read-only t)
-      (setq buffer-auto-save-file-name nil)
-      (bury-buffer displaybuf))))
-
-
-;; Display the current buffer in a window which is either just large
-;; enough to contain the entire buffer, or half the size of the
-;; screen, whichever is smaller.  Do not select the new
-;; window.
-;;
-;; Several factors influence window resizing so that the window is
-;; sized optimally if it is created anew, and so that it is messed
-;; with minimally if it has been created by the user.  If the window
-;; chosen for display exists already but contains something else, the
-;; window is not re-sized.  If the window already contains the current
-;; buffer, it is never shrunk, but possibly expanded.  Finally, if the
-;; variable c-macro-shrink-window-flag is nil the window size is *never*
-;; changed.
-(defun c-macro-display-buffer ()
-  (goto-char (point-min))
-  (c-mode)
-  (let ((oldwinheight (window-height))
-	(alreadythere			;the window was already there
-	 (get-buffer-window (current-buffer)))
-	(popped nil))			;the window popped changing the layout 
-    (or alreadythere
-	(progn
-	  (display-buffer (current-buffer) t)
-	  (setq popped (/= oldwinheight (window-height)))))
-    (if (and c-macro-shrink-window-flag	;user wants fancy shrinking :\)
-	     (or alreadythere popped))
-	;; Enlarge up to half screen, or shrink properly.
-	(let ((oldwin (selected-window))
-	      (minheight 0)
-	      (maxheight 0))
-	  (save-excursion
-	    (select-window (get-buffer-window (current-buffer)))
-	    (setq minheight (if alreadythere
-				(window-height)
-			      window-min-height))
-	    (setq maxheight (/ (frame-height) 2))
-	    (enlarge-window (- (min maxheight
-				    (max minheight
-					 (+ 2 (vertical-motion (point-max)))))
-			       (window-height)))
-	    (goto-char (point-min))
-	    (select-window oldwin))))))
-
-
-(defun c-macro-expansion (start end cppcommand &optional display)
-  "Run a preprocessor on region and return the output as a string.
-Expand the region between START and END in the current buffer using
-the shell command CPPCOMMAND (e.g. \"/lib/cpp -C -DDEBUG\").
-Be sure to use a -C (don't strip comments) or equivalent option.
-Optional arg DISPLAY non-nil means show messages in the echo area."
-
-;; Copy the current buffer's contents to a temporary hidden buffer.
-;; Delete from END to end of buffer.  Insert a preprocessor #line
-;; directive at START and after each #endif following START that are
-;; not inside a comment or a string.  Put all the strings thus
-;; inserted (without the "line" substring) in a list named linelist.
-;; If START is inside a comment, prepend "*/" and append "/*" to the
-;; #line directive.  If inside a string, prepend and append "\"".
-;; Preprocess the buffer contents, then look for all the lines stored
-;; in linelist starting from end of buffer.  The last line so found is
-;; where START was, so return the substring from point to end of
-;; buffer. 
-  (let ((inbuf (current-buffer))
-	(outbuf (get-buffer-create " *C Macro Expansion*"))
-	(filename (if (and buffer-file-name
-			   (string-match (regexp-quote default-directory)
-					 buffer-file-name))
-		      (substring buffer-file-name (match-end 0))
-		    (buffer-name)))
-	(mymsg (format "Invoking %s%s%s on region..."
-		       c-macro-preprocessor
-		       (if (string= "" c-macro-cppflags) "" " ")
-		       c-macro-cppflags))
-	(uniquestring "??? !!! ??? start of c-macro expansion ??? !!! ???")
-	(startlinenum 0)
-	(linenum 0)
-	(startstat ())
-	(startmarker "")
-	(exit-status 0)
-	(tempname (make-temp-name (concat
-				   (or (getenv "TMPDIR") (getenv "TEMP")
-				       (getenv "TMP") "/tmp")
-				   "/"))))
-    (unwind-protect
-	(save-excursion
-	  (save-restriction
-	    (widen)
-            (let ((in-syntax-table (syntax-table)))
-              (set-buffer outbuf)
-              (setq buffer-read-only nil)
-              (erase-buffer)
-              (set-syntax-table in-syntax-table))
-	    (insert-buffer-substring inbuf 1 end))
-
-	  ;; We have copied inbuf to outbuf.  Point is at end of
-	  ;; outbuf.  Inset a newline at the end, so cpp can correctly
-	  ;; parse a token ending at END.
-          (insert "\n")
-
-	  ;; Save sexp status and line number at START.
-	  (setq startstat (parse-partial-sexp 1 start))
-	  (setq startlinenum (+ (count-lines 1 (point))
-				(if (bolp) 1 0)))
-
-	  ;; Now we insert the #line directives after all #endif or
-	  ;; #else following START going backward, so the lines we
-	  ;; insert don't change the line numbers.
-	  ;(switch-to-buffer outbuf) (debug)	;debugging instructions
-	  (goto-char (point-max))
-	  (while (re-search-backward "\n#\\(endif\\|else\\)\\>" start 'move)
-	    (if (equal (nthcdr 3 (parse-partial-sexp start (point)
-						     nil nil startstat))
-		       '(nil nil nil 0 nil)) ;neither in string nor in
-					     ;comment nor after quote
-		(progn
-		  (goto-char (match-end 0))
-		  (setq linenum (+ startlinenum
-				   (count-lines start (point))))
-		  (insert (format "\n#line %d \"%s\"\n" linenum filename))
-		  (goto-char (match-beginning 0)))))
-
-	  ;; Now we are at START.  Insert the first #line directive.
-	  ;; This must work even inside a string or comment, or after a
-	  ;; quote.
-	  (let* ((startinstring (nth 3 startstat))
-		 (startincomment (nth 4 startstat))
-		 (startafterquote (nth 5 startstat))
-		 (startinbcomment (nth 7 startstat)))
-	    (insert (if startafterquote " " "")
-		    (cond (startinstring
-			   (char-to-string startinstring))
-			  (startincomment "*/")
-			  (""))
-		    (setq startmarker
-			  (concat "\n" uniquestring
-				  (cond (startinstring
-					 (char-to-string startinstring))
-					(startincomment "/*")
-					(startinbcomment "//"))
-				  (if startafterquote "\\")))
-		    (format "\n#line %d \"%s\"\n" startlinenum filename)))
-
-	  ;; Call the preprocessor.
-	  (if display (message mymsg))
-	  (setq exit-status
-		(call-process-region 1 (point-max)
-				     shell-file-name
-				     t (list t tempname) nil "-c"
-				     cppcommand))
-	  (if display (message (concat mymsg "done")))
-	  (if (= (buffer-size) 0)
-	      ;; Empty output is normal after a fatal error.
-	      (insert "\nPreprocessor produced no output\n")
-	    ;; Find and delete the mark of the start of the expansion.
-	    ;; Look for `# nn "file.c"' lines and delete them.
-	    (goto-char (point-min))
-	    (search-forward startmarker)
-	    (delete-region 1 (point)))
-	  (while (re-search-forward (concat "^# [0-9]+ \""
-					    (regexp-quote filename)
-					    "\"") nil t)
-	    (beginning-of-line)
-	    (let ((beg (point)))
-	      (forward-line 1)
-	      (delete-region beg (point))))
-
-	  ;; If CPP got errors, show them at the beginning.
-	  ;; MS-DOS shells don't return the exit code of their children.
-	  ;; Look at the size of the error message file instead, but
-	  ;; don't punish those MS-DOS users who have a shell that does
-	  ;; return an error code.
-	  (or (and (or (not (boundp 'msdos-shells))
-		       (not (member (file-name-nondirectory shell-file-name)
-				    msdos-shells)))
-		   (eq exit-status 0))
-	      (zerop (nth 7 (file-attributes (expand-file-name tempname))))
-	      (progn
-		(goto-char (point-min))
-		;; Put the messages inside a comment, so they won't get in
-		;; the way of font-lock, highlighting etc.
-		(insert
-		 (format "/* Preprocessor terminated with status %s\n\n   Messages from `%s\':\n\n"
-			 exit-status cppcommand))
-		(goto-char (+ (point)
-			      (nth 1 (insert-file-contents tempname))))
-		(insert "\n\n*/\n")))
-	  (delete-file tempname)
-
-	  ;; Compute the return value, keeping in account the space
-	  ;; inserted at the end of the buffer.
-	  (buffer-substring 1 (max 1 (- (point-max) 1))))
-
-      ;; Cleanup.
-      (kill-buffer outbuf))))
-
-;;; cmacexp.el ends here
diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el
deleted file mode 100644
index 4c9b9c56e76..00000000000
--- a/lisp/progmodes/compile.el
+++ /dev/null
@@ -1,1583 +0,0 @@
-;;; compile.el --- run compiler as inferior of Emacs, parse error messages.
-
-;; Copyright (C) 1985, 86, 87, 93, 94, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Roland McGrath <roland@prep.ai.mit.edu>
-;; Maintainer: FSF
-;; Keywords: tools, processes
-
-;; 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 provides the compile and grep facilities documented in
-;; the Emacs user's manual.
-
-;;; Code:
-
-;;;###autoload
-(defvar compilation-mode-hook nil
-  "*List of hook functions run by `compilation-mode' (see `run-hooks').")
-
-;;;###autoload
-(defvar compilation-window-height nil
-  "*Number of lines in a compilation window.  If nil, use Emacs default.")
-
-(defvar compile-auto-highlight nil
-  "*Specify how many compiler errors to highlight (and parse) initially.
-\(Highlighting applies to ean error message when the mouse is over it.)
-If this is a number N, all compiler error messages in the first N lines
-are highlighted and parsed as soon as they arrive in Emacs.
-If t, highlight and parse the whole compilation output as soon as it arrives.
-If nil, don't highlight or parse any of the buffer until you try to
-move to the error messages.
-
-Those messages which are not parsed and highlighted initially
-will be parsed and highlighted as soon as you try to move to them.")
-
-(defvar compilation-error-list nil
-  "List of error message descriptors for visiting erring functions.
-Each error descriptor is a cons (or nil).  Its car is a marker pointing to
-an error message.  If its cdr is a marker, it points to the text of the
-line the message is about.  If its cdr is a cons, it is a list
-\(\(DIRECTORY . FILE\) LINE [COLUMN]\).  Or its cdr may be nil if that
-error is not interesting.
-
-The value may be t instead of a list; this means that the buffer of
-error messages should be reparsed the next time the list of errors is wanted.
-
-Some other commands (like `diff') use this list to control the error
-message tracking facilities; if you change its structure, you should make
-sure you also change those packages.  Perhaps it is better not to change
-it at all.")
-
-(defvar compilation-old-error-list nil
-  "Value of `compilation-error-list' after errors were parsed.")
-
-(defvar compilation-parse-errors-function 'compilation-parse-errors
-  "Function to call to parse error messages from a compilation.
-It takes args LIMIT-SEARCH and FIND-AT-LEAST.
-If LIMIT-SEARCH is non-nil, don't bother parsing past that location.
-If FIND-AT-LEAST is non-nil, don't bother parsing after finding that
-many new errors.
-It should read in the source files which have errors and set
-`compilation-error-list' to a list with an element for each error message
-found.  See that variable for more info.")
-
-;;;###autoload
-(defvar compilation-buffer-name-function nil
-  "Function to compute the name of a compilation buffer.
-The function receives one argument, the name of the major mode of the
-compilation buffer.  It should return a string.
-nil means compute the name with `(concat \"*\" (downcase major-mode) \"*\")'.")
-
-;;;###autoload
-(defvar compilation-finish-function nil
-  "*Function to call when a compilation process finishes.
-It is called with two arguments: the compilation buffer, and a string
-describing how the process finished.")
-
-;;;###autoload
-(defvar compilation-finish-functions nil
-  "*Functions to call when a compilation process finishes.
-Each function is called with two arguments: the compilation buffer,
-and a string describing how the process finished.")
-
-(defvar compilation-last-buffer nil
-  "The most recent compilation buffer.
-A buffer becomes most recent when its compilation is started
-or when it is used with \\[next-error] or \\[compile-goto-error].")
-
-(defvar compilation-in-progress nil
-  "List of compilation processes now running.")
-(or (assq 'compilation-in-progress minor-mode-alist)
-    (setq minor-mode-alist (cons '(compilation-in-progress " Compiling")
-				 minor-mode-alist)))
-
-(defvar compilation-parsing-end nil
-  "Position of end of buffer when last error messages were parsed.")
-
-(defvar compilation-error-message "No more errors"
-  "Message to print when no more matches are found.")
-
-(defvar compilation-num-errors-found)
-
-(defvar compilation-error-regexp-alist
-  '(
-    ;; NOTE!  See also grep-regexp-alist, below.
-
-    ;; 4.3BSD grep, cc, lint pass 1:
-    ;; 	/usr/src/foo/foo.c(8): warning: w may be used before set
-    ;; or GNU utilities:
-    ;; 	foo.c:8: error message
-    ;; or HP-UX 7.0 fc:
-    ;; 	foo.f          :16    some horrible error message
-    ;; or GNU utilities with column (GNAT 1.82):
-    ;;   foo.adb:2:1: Unit name does not match file name
-    ;;
-    ;; We'll insist that the number be followed by a colon or closing
-    ;; paren, because otherwise this matches just about anything
-    ;; containing a number with spaces around it.
-    ("\n\
-\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\)\\([) \t]\\|\
-:\\([^0-9\n]\\|\\([0-9]+:\\)\\)\\)" 1 2 5)
-
-    ;; Microsoft C/C++:
-    ;;  keyboard.c(537) : warning C4005: 'min' : macro redefinition
-    ;;  d:\tmp\test.c(23) : error C2143: syntax error : missing ';' before 'if'
-    ("\n\\(\\([a-zA-Z]:\\)?[^:( \t\n-]+\\)[:(][ \t]*\\([0-9]+\\)[:) \t]" 1 3)
-
-    ;; Borland C++:
-    ;;  Error ping.c 15: Unable to open include file 'sys/types.h'
-    ;;  Warning ping.c 68: Call to function 'func' with no prototype
-    ("\n\\(Error\\|Warning\\) \\([a-zA-Z]?:?[^:( \t\n]+\\)\
- \\([0-9]+\\)\\([) \t]\\|:[^0-9\n]\\)" 2 3)
-
-    ;; 4.3BSD lint pass 2
-    ;; 	strcmp: variable # of args. llib-lc(359)  ::  /usr/src/foo/foo.c(8)
-    ("[ \t:]\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(](+[ \t]*\\([0-9]+\\))[:) \t]*$"
-     1 2)
-
-    ;; 4.3BSD lint pass 3
-    ;; 	bloofle defined( /users/wolfgang/foo.c(4) ), but never used
-    ;; This used to be
-    ;; ("[ \t(]+\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]+" 1 2)
-    ;; which is regexp Impressionism - it matches almost anything!
-    ("([ \t]*\\([a-zA-Z]?:?[^:( \t\n]+\\)[:(][ \t]*\\([0-9]+\\))" 1 2)
-
-    ;; MIPS lint pass<n>; looks good for SunPro lint also
-    ;;  TrimMask (255) in solomon.c may be indistinguishable from TrimMasks (93) in solomon.c due to truncation
-    ("[^ ]+ (\\([0-9]+\\)) in \\([^ ]+\\)" 2 1)
-    ;;  name defined but never used: LinInt in cmap_calc.c(199)
-    ("in \\([^(]+\\)(\\([0-9]+\\))$" 1 2)
-
-    ;; Ultrix 3.0 f77:
-    ;;  fort: Severe: addstf.f, line 82: Missing operator or delimiter symbol
-    ;; Some SGI cc version:
-    ;;  cfe: Warning 835: foo.c, line 2: something
-    ("\n\\(cfe\\|fort\\): [^:\n]*: \\([^ \n]*\\), line \\([0-9]+\\):" 2 3)
-    ;;  Error on line 3 of t.f: Execution error unclassifiable statement
-    ;; Unknown who does this:
-    ;;  Line 45 of "foo.c": bloofle undefined
-    ;; Absoft FORTRAN 77 Compiler 3.1.3
-    ;;  error on line 19 of fplot.f: spelling error?
-    ;;  warning on line 17 of fplot.f: data type is undefined for variable d
-    ("\\(\n\\|on \\)[Ll]ine[ \t]+\\([0-9]+\\)[ \t]+\
-of[ \t]+\"?\\([a-zA-Z]?:?[^\":\n]+\\)\"?:" 3 2)
-
-    ;; Apollo cc, 4.3BSD fc:
-    ;;	"foo.f", line 3: Error: syntax error near end of statement
-    ;; IBM RS6000:
-    ;;  "vvouch.c", line 19.5: 1506-046 (S) Syntax error.
-    ;; Unknown compiler:
-    ;;  File "foobar.ml", lines 5-8, characters 20-155: blah blah
-    ;; Microtec mcc68k:
-    ;;  "foo.c", line 32 pos 1; (E) syntax error; unexpected symbol: "lossage"
-    ;; GNAT (as of July 94):
-    ;;  "foo.adb", line 2(11): warning: file name does not match ...
-    ;; IBM AIX xlc compiler:
-    ;;  "src/swapping.c", line 30.34: 1506-342 (W) "/*" detected in comment.
-    ("\"\\([^,\" \n\t]+\\)\", lines? \
-\\([0-9]+\\)\\([\(.]\\([0-9]+\\)\)?\\)?[:., (-]" 1 2 4)
-
-    ;; MIPS RISC CC - the one distributed with Ultrix:
-    ;;	ccom: Error: foo.c, line 2: syntax error
-    ;; DEC AXP OSF/1 cc
-    ;;  /usr/lib/cmplrs/cc/cfe: Error: foo.c: 1: blah blah
-    ("rror: \\([^,\" \n\t]+\\)[,:] \\(line \\)?\\([0-9]+\\):" 1 3)
-
-    ;; IBM AIX PS/2 C version 1.1:
-    ;;	****** Error number 140 in line 8 of file errors.c ******
-    ("in line \\([0-9]+\\) of file \\([^ \n]+[^. \n]\\)\\.? " 2 1)
-    ;; IBM AIX lint is too painful to do right this way.  File name
-    ;; prefixes entire sections rather than being on each line.
-
-    ;; Lucid Compiler, lcc 3.x
-    ;; E, file.cc(35,52) Illegal operation on pointers
-    ("\n[EW], \\([^(\n]*\\)(\\([0-9]+\\),[ \t]*\\([0-9]+\\)" 1 2 3)
-
-    ;; GNU messages with program name and optional column number.
-    ("\n[a-zA-Z]?:?[^0-9 \n\t:]+:[ \t]*\\([^ \n\t:]+\\):\
-\\([0-9]+\\):\\(\\([0-9]+\\)[: \t]\\)?" 1 2 4)
-
-    ;; Cray C compiler error messages
-    ("\n\\(cc\\| cft\\)-[0-9]+ c\\(c\\|f77\\): ERROR \\([^,\n]+, \\)* File = \\([^,\n]+\\), Line = \\([0-9]+\\)" 4 5)
-
-    ;; IBM C/C++ Tools 2.01:
-    ;;  foo.c(2:0) : informational EDC0804: Function foo is not referenced.
-    ;;  foo.c(3:8) : warning EDC0833: Implicit return statement encountered.
-    ;;  foo.c(5:5) : error EDC0350: Syntax error.
-    ("\n\\([^( \n\t]+\\)(\\([0-9]+\\):\\([0-9]+\\)) : " 1 2 3)
-
-    ;; Sun ada (VADS, Solaris):
-    ;;  /home3/xdhar/rcds_rc/main.a, line 361, char 6:syntax error: "," inserted
-    ("\n\\([^, ]+\\), line \\([0-9]+\\), char \\([0-9]+\\)[:., \(-]" 1 2 3)
-    )
-  "Alist that specifies how to match errors in compiler output.
-Each elt has the form (REGEXP FILE-IDX LINE-IDX [COLUMN-IDX FILE-FORMAT...])
-If REGEXP matches, the FILE-IDX'th subexpression gives the file name, and
-the LINE-IDX'th subexpression gives the line number.  If COLUMN-IDX is
-given, the COLUMN-IDX'th subexpression gives the column number on that line.
-If any FILE-FORMAT is given, each is a format string to produce a file name to
-try; %s in the string is replaced by the text matching the FILE-IDX'th
-subexpression.")
-
-(defvar compilation-read-command t
-  "If not nil, M-x compile reads the compilation command to use.
-Otherwise, M-x compile just uses the value of `compile-command'.")
-
-(defvar compilation-ask-about-save t
-  "If not nil, M-x compile asks which buffers to save before compiling.
-Otherwise, it saves all modified buffers without asking.")
-
-(defvar grep-regexp-alist
-  '(("^\\([a-zA-Z]?:?[^:( \t\n]+\\)[:( \t]+\\([0-9]+\\)[:) \t]" 1 2))
-  "Regexp used to match grep hits.  See `compilation-error-regexp-alist'.")
-
-(defvar grep-command "grep -n "
-  "Last grep command used in \\[grep]; default for next grep.")
-
-;;;###autoload
-(defvar compilation-search-path '(nil)
-  "*List of directories to search for source files named in error messages.
-Elements should be directory names, not file names of directories.
-nil as an element means to try the default directory.")
-
-(defvar compile-command "make -k "
-  "Last shell command used to do a compilation; default for next compilation.
-
-Sometimes it is useful for files to supply local values for this variable.
-You might also use mode hooks to specify it in certain modes, like this:
-
-    (setq c-mode-hook
-      '(lambda () (or (file-exists-p \"makefile\") (file-exists-p \"Makefile\")
-		      (progn (make-local-variable 'compile-command)
-			     (setq compile-command
-				    (concat \"make -k \"
-					    buffer-file-name))))))")
-
-(defvar compilation-enter-directory-regexp
-  ": Entering directory `\\(.*\\)'$"
-  "Regular expression matching lines that indicate a new current directory.
-This must contain one \\(, \\) pair around the directory name.
-
-The default value matches lines printed by the `-w' option of GNU Make.")
-
-(defvar compilation-leave-directory-regexp
-  ": Leaving directory `\\(.*\\)'$"
-  "Regular expression matching lines that indicate restoring current directory.
-This may contain one \\(, \\) pair around the name of the directory
-being moved from.  If it does not, the last directory entered \(by a
-line matching `compilation-enter-directory-regexp'\) is assumed.
-
-The default value matches lines printed by the `-w' option of GNU Make.")
-
-(defvar compilation-directory-stack nil
-  "Stack of previous directories for `compilation-leave-directory-regexp'.
-The head element is the directory the compilation was started in.")
-
-(defvar compilation-exit-message-function nil "\
-If non-nil, called when a compilation process dies to return a status message.
-This should be a function of three arguments: process status, exit status,
-and exit message; it returns a cons (MESSAGE . MODELINE) of the strings to
-write into the compilation buffer, and to put in its mode line.")
-
-;; History of compile commands.
-(defvar compile-history nil)
-;; History of grep commands.
-(defvar grep-history nil)
-
-(defvar compilation-mode-font-lock-keywords
-  ;; This regexp needs a bit of rewriting.  What is the third grouping for?
-  '(("^\\([a-zA-Z]?:?[^ \n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$"
-     1 font-lock-function-name-face))
-;;;  ("^\\([^\n:]*:\\([0-9]+:\\)+\\)\\(.*\\)$" 0 font-lock-keyword-face keep)
-  "Additional expressions to highlight in Compilation mode.")
-
-;;;###autoload
-(defun compile (command)
-  "Compile the program including the current buffer.  Default: run `make'.
-Runs COMMAND, a shell command, in a separate process asynchronously
-with output going to the buffer `*compilation*'.
-
-You can then use the command \\[next-error] to find the next error message
-and move to the source code that caused it.
-
-Interactively, prompts for the command if `compilation-read-command' is
-non-nil; otherwise uses `compile-command'.  With prefix arg, always prompts.
-
-To run more than one compilation at once, start one and rename the
-\`*compilation*' buffer to some other name with \\[rename-buffer].
-Then start the next one.
-
-The name used for the buffer is actually whatever is returned by
-the function in `compilation-buffer-name-function', so you can set that
-to a function that generates a unique name."
-  (interactive
-   (if (or compilation-read-command current-prefix-arg)
-       (list (read-from-minibuffer "Compile command: "
-                                 compile-command nil nil
-                                 '(compile-history . 1)))
-     (list compile-command)))
-  (setq compile-command command)
-  (save-some-buffers (not compilation-ask-about-save) nil)
-  (compile-internal compile-command "No more errors"))
-
-;;; run compile with the default command line
-(defun recompile ()
-  "Re-compile the program including the current buffer."
-  (interactive)
-  (save-some-buffers (not compilation-ask-about-save) nil)
-  (compile-internal compile-command "No more errors"))
-
-;; The system null device. (Should reference NULL_DEVICE from C.)
-(defvar grep-null-device "/dev/null" "The system null device.")
-
-;;;###autoload
-(defun grep (command-args)
-  "Run grep, with user-specified args, and collect output in a buffer.
-While grep runs asynchronously, you can use the \\[next-error] command
-to find the text that grep hits refer to.
-
-This command uses a special history list for its arguments, so you can
-easily repeat a grep command."
-  (interactive
-   (list (read-from-minibuffer "Run grep (like this): "
-			       grep-command nil nil 'grep-history)))
-  (let ((buf (compile-internal (concat command-args " " grep-null-device)
-			       "No more grep hits" "grep"
-			       ;; Give it a simpler regexp to match.
-			       nil grep-regexp-alist)))
-    (save-excursion
-      (set-buffer buf)
-      (set (make-local-variable 'compilation-exit-message-function)
-	   (lambda (status code msg)
-	     (if (eq status 'exit)
-		 (cond ((zerop code)
-			'("finished (matches found)\n" . "matched"))
-		       ((= code 1)
-			'("finished with no matches found\n" . "no match"))
-		       (t
-			(cons msg code)))
-	       (cons msg code)))))))
-
-(defun compile-internal (command error-message
-				 &optional name-of-mode parser regexp-alist
-				 name-function)
-  "Run compilation command COMMAND (low level interface).
-ERROR-MESSAGE is a string to print if the user asks to see another error
-and there are no more errors.  Third argument NAME-OF-MODE is the name
-to display as the major mode in the compilation buffer.
-
-Fourth arg PARSER is the error parser function (nil means the default).  Fifth
-arg REGEXP-ALIST is the error message regexp alist to use (nil means the
-default).  Sixth arg NAME-FUNCTION is a function called to name the buffer (nil
-means the default).  The defaults for these variables are the global values of
-\`compilation-parse-errors-function', `compilation-error-regexp-alist', and
-\`compilation-buffer-name-function', respectively.
-
-Returns the compilation buffer created."
-  (let (outbuf)
-    (save-excursion
-      (or name-of-mode
-	  (setq name-of-mode "Compilation"))
-      (setq outbuf
-	    (get-buffer-create
-	     (funcall (or name-function compilation-buffer-name-function
-			  (function (lambda (mode)
-				      (concat "*" (downcase mode) "*"))))
-		      name-of-mode)))
-      (set-buffer outbuf)
-      (let ((comp-proc (get-buffer-process (current-buffer))))
-	(if comp-proc
-	    (if (or (not (eq (process-status comp-proc) 'run))
-		    (yes-or-no-p
-		     (format "A %s process is running; kill it? "
-			     name-of-mode)))
-		(condition-case ()
-		    (progn
-		      (interrupt-process comp-proc)
-		      (sit-for 1)
-		      (delete-process comp-proc))
-		  (error nil))
-	      (error "Cannot have two processes in `%s' at once"
-		     (buffer-name))
-	      )))
-      ;; In case the compilation buffer is current, make sure we get the global
-      ;; values of compilation-error-regexp-alist, etc.
-      (kill-all-local-variables))
-    (let ((regexp-alist (or regexp-alist compilation-error-regexp-alist))
-	  (parser (or parser compilation-parse-errors-function))
-	  (thisdir default-directory)
-	  outwin)
-      (save-excursion
-	;; Clear out the compilation buffer and make it writable.
-	;; Change its default-directory to the directory where the compilation
-	;; will happen, and insert a `cd' command to indicate this.
-	(set-buffer outbuf)
-	(setq buffer-read-only nil)
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)
-	(buffer-enable-undo (current-buffer))
-	(setq default-directory thisdir)
-	(insert "cd " thisdir "\n" command "\n")
-	(set-buffer-modified-p nil))
-      ;; If we're already in the compilation buffer, go to the end
-      ;; of the buffer, so point will track the compilation output.
-      (if (eq outbuf (current-buffer))
-	  (goto-char (point-max)))
-      ;; Pop up the compilation buffer.
-      (setq outwin (display-buffer outbuf))
-      (save-excursion
-	(set-buffer outbuf)
-	(compilation-mode)
-	;; (setq buffer-read-only t)  ;;; Non-ergonomic.
-	(set (make-local-variable 'compilation-parse-errors-function) parser)
-	(set (make-local-variable 'compilation-error-message) error-message)
-	(set (make-local-variable 'compilation-error-regexp-alist) regexp-alist)
-	(setq default-directory thisdir
-	      compilation-directory-stack (list default-directory))
-	(set-window-start outwin (point-min))
-	(setq mode-name name-of-mode)
-	(or (eq outwin (selected-window))
-	    (set-window-point outwin (point-min)))
-	(compilation-set-window-height outwin)
-	;; Start the compilation.
-	(if (fboundp 'start-process)
-	    (let* ((process-environment (cons "EMACS=t" process-environment))
-		   (proc (start-process-shell-command (downcase mode-name)
-						      outbuf
-						      command)))
-	      (set-process-sentinel proc 'compilation-sentinel)
-	      (set-process-filter proc 'compilation-filter)
-	      (set-marker (process-mark proc) (point) outbuf)
-	      (setq compilation-in-progress
-		    (cons proc compilation-in-progress)))
-	  ;; No asynchronous processes available.
-	  (message "Executing `%s'..." command)
-	  ;; Fake modeline display as if `start-process' were run.
-	  (setq mode-line-process ":run")
-	  (force-mode-line-update)
-	  (sit-for 0)			; Force redisplay
-	  (let ((status (call-process shell-file-name nil outbuf nil "-c"
-				      command)))
-	    (cond ((numberp status)
-		   (compilation-handle-exit 'exit status
-					    (if (zerop status)
-						"finished\n"
-					      (format "\
-exited abnormally with code %d\n"
-						      status))))
-		  ((stringp status)
-		   (compilation-handle-exit 'signal status
-					    (concat status "\n")))
-		  (t
-		   (compilation-handle-exit 'bizarre status status))))
-	  (message "Executing `%s'...done" command))))
-    ;; Make it so the next C-x ` will use this buffer.
-    (setq compilation-last-buffer outbuf)))
-
-;; Set the height of WINDOW according to compilation-window-height.
-(defun compilation-set-window-height (window)
-  (and compilation-window-height
-       (= (window-width window) (frame-width (window-frame window)))
-       ;; If window is alone in its frame, aside from a minibuffer,
-       ;; don't change its height.
-       (not (eq window (frame-root-window (window-frame window))))
-       ;; This save-excursion prevents us from changing the current buffer,
-       ;; which might not be the same as the selected window's buffer.
-       (save-excursion
-	 (let ((w (selected-window)))
-	   (unwind-protect
-	       (progn
-		 (select-window window)
-		 (enlarge-window (- compilation-window-height
-				    (window-height))))
-	     (select-window w))))))
-
-(defvar compilation-minor-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map [mouse-2] 'compile-mouse-goto-error)
-    (define-key map "\C-c\C-c" 'compile-goto-error)
-    (define-key map "\C-m" 'compile-goto-error)
-    (define-key map "\C-c\C-k" 'kill-compilation)
-    (define-key map "\M-n" 'compilation-next-error)
-    (define-key map "\M-p" 'compilation-previous-error)
-    (define-key map "\M-{" 'compilation-previous-file)
-    (define-key map "\M-}" 'compilation-next-file)
-    map)
-  "Keymap for `compilation-minor-mode'.")
-
-(defvar compilation-mode-map
-  (let ((map (cons 'keymap compilation-minor-mode-map)))
-    (define-key map " " 'scroll-up)
-    (define-key map "\^?" 'scroll-down)
-    ;; Set up the menu-bar
-    (define-key map [menu-bar compilation-menu]
-      (cons "Compile" (make-sparse-keymap "Compile")))
-
-    (define-key map [menu-bar compilation-menu compilation-mode-kill-compilation]
-      '("Stop Compilation" . kill-compilation))
-    (define-key map [menu-bar compilation-menu compilation-mode-separator2]
-      '("----" . nil))
-    (define-key map [menu-bar compilation-menu compilation-mode-first-error]
-      '("First Error" . first-error))
-    (define-key map [menu-bar compilation-menu compilation-mode-previous-error]
-      '("Previous Error" . previous-error))
-    (define-key map [menu-bar compilation-menu compilation-mode-next-error]
-      '("Next Error" . next-error))
-    (define-key map [menu-bar compilation-menu compilation-separator2]
-      '("----" . nil))
-    (define-key map [menu-bar compilation-menu compilation-mode-grep]
-      '("Grep" . grep))
-    (define-key map [menu-bar compilation-menu compilation-mode-recompile]
-      '("Recompile" . recompile))
-    (define-key map [menu-bar compilation-menu compilation-mode-compile]
-      '("Compile" . compile))
-    map)
-  "Keymap for compilation log buffers.
-`compilation-minor-mode-map' is a cdr of this.")
-
-;;;###autoload
-(defun compilation-mode ()
-  "Major mode for compilation log buffers.
-\\<compilation-mode-map>To visit the source for a line-numbered error,
-move point to the error message line and type \\[compile-goto-error].
-To kill the compilation, type \\[kill-compilation].
-
-Runs `compilation-mode-hook' with `run-hooks' (which see)."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map compilation-mode-map)
-  (setq major-mode 'compilation-mode
-	mode-name "Compilation")
-  (compilation-setup)
-  (set (make-local-variable 'font-lock-defaults)
-       '(compilation-mode-font-lock-keywords t))
-  (run-hooks 'compilation-mode-hook))
-
-;; Prepare the buffer for the compilation parsing commands to work.
-(defun compilation-setup ()
-  ;; Make the buffer's mode line show process state.
-  (setq mode-line-process '(":%s"))
-  (set (make-local-variable 'compilation-error-list) nil)
-  (set (make-local-variable 'compilation-old-error-list) nil)
-  (set (make-local-variable 'compilation-parsing-end) 1)
-  (set (make-local-variable 'compilation-directory-stack) nil)
-  (setq compilation-last-buffer (current-buffer)))
-
-(defvar compilation-minor-mode nil
-  "Non-nil when in compilation-minor-mode.
-In this minor mode, all the error-parsing commands of the
-Compilation major mode are available.")
-(make-variable-buffer-local 'compilation-minor-mode)
-
-(or (assq 'compilation-minor-mode minor-mode-alist)
-    (setq minor-mode-alist (cons '(compilation-minor-mode " Compilation")
-				 minor-mode-alist)))
-(or (assq 'compilation-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist (cons (cons 'compilation-minor-mode
-					   compilation-minor-mode-map)
-				     minor-mode-map-alist)))
-
-;;;###autoload
-(defun compilation-minor-mode (&optional arg)
-  "Toggle compilation minor mode.
-With arg, turn compilation mode on if and only if arg is positive.
-See `compilation-mode'.
-Turning the mode on runs the normal hook `compilation-minor-mode-hook'."
-  (interactive "P")
-  (if (setq compilation-minor-mode (if (null arg)
-				       (null compilation-minor-mode)
-				     (> (prefix-numeric-value arg) 0)))
-      (progn
-	(compilation-setup)
-	(run-hooks 'compilation-minor-mode-hook))))
-
-;; Write msg in the current buffer and hack its mode-line-process.
-(defun compilation-handle-exit (process-status exit-status msg)
-  (let ((buffer-read-only nil)
-	(status (if compilation-exit-message-function
-		    (funcall compilation-exit-message-function
-			     process-status exit-status msg)
-		  (cons msg exit-status)))
-	(omax (point-max))
-	(opoint (point)))
-    ;; Record where we put the message, so we can ignore it
-    ;; later on.
-    (goto-char omax)
-    (insert ?\n mode-name " " (car status))
-    (forward-char -1)
-    (insert " at " (substring (current-time-string) 0 19))
-    (forward-char 1)
-    (setq mode-line-process (format ":%s [%s]" process-status (cdr status)))
-    ;; Force mode line redisplay soon.
-    (force-mode-line-update)
-    (if (and opoint (< opoint omax))
-	(goto-char opoint))
-    ;; Automatically parse (and mouse-highlight) error messages:
-    (cond ((eq compile-auto-highlight t)
-	   (compile-reinitialize-errors nil (point-max)))
-	  ((numberp compile-auto-highlight)
-	   (compile-reinitialize-errors nil
-					(save-excursion
-					  (goto-line compile-auto-highlight)
-					  (point)))))
-    (if compilation-finish-function
-	(funcall compilation-finish-function (current-buffer) msg))
-    (let ((functions compilation-finish-functions))
-      (while functions
-	(funcall (car functions) (current-buffer) msg)
-	(setq functions (cdr functions))))))
-
-;; Called when compilation process changes state.
-(defun compilation-sentinel (proc msg)
-  "Sentinel for compilation buffers."
-  (let ((buffer (process-buffer proc)))
-    (if (memq (process-status proc) '(signal exit))
-	(progn
-	  (if (null (buffer-name buffer))
-	      ;; buffer killed
-	      (set-process-buffer proc nil)
-	    (let ((obuf (current-buffer)))
-	      ;; save-excursion isn't the right thing if
-	      ;; process-buffer is current-buffer
-	      (unwind-protect
-		  (progn
-		    ;; Write something in the compilation buffer
-		    ;; and hack its mode line.
-		    (set-buffer buffer)
-		    (compilation-handle-exit (process-status proc)
-					     (process-exit-status proc)
-					     msg)
-		    ;; Since the buffer and mode line will show that the
-		    ;; process is dead, we can delete it now.  Otherwise it
-		    ;; will stay around until M-x list-processes.
-		    (delete-process proc))
-		(set-buffer obuf))))
-	  (setq compilation-in-progress (delq proc compilation-in-progress))
-	  ))))
-
-(defun compilation-filter (proc string)
-  "Process filter for compilation buffers.
-Just inserts the text, but uses `insert-before-markers'."
-  (if (buffer-name (process-buffer proc))
-      (save-excursion
-	(set-buffer (process-buffer proc))
-	(let ((buffer-read-only nil))
-	  (save-excursion
-	    (goto-char (process-mark proc))
-	    (insert-before-markers string)
-	    (run-hooks 'compilation-filter-hook)
-	    (set-marker (process-mark proc) (point)))))))
-
-;; Return the cdr of compilation-old-error-list for the error containing point.
-(defun compile-error-at-point ()
-  (compile-reinitialize-errors nil (point))
-  (let ((errors compilation-old-error-list))
-    (while (and errors
-		(> (point) (car (car errors))))
-      (setq errors (cdr errors)))
-    errors))
-
-(defsubst compilation-buffer-p (buffer)
-  (save-excursion
-    (set-buffer buffer)
-    (or compilation-minor-mode (eq major-mode 'compilation-mode))))
-
-(defun compilation-next-error (n)
-  "Move point to the next error in the compilation buffer.
-Does NOT find the source line like \\[next-error]."
-  (interactive "p")
-  (or (compilation-buffer-p (current-buffer))
-      (error "Not in a compilation buffer."))
-  (setq compilation-last-buffer (current-buffer))
-
-  (let ((errors (compile-error-at-point)))
-
-    ;; Move to the error after the one containing point.
-    (goto-char (car (if (< n 0)
-			(let ((i 0)
-			      (e compilation-old-error-list))
-			  ;; See how many cdrs away ERRORS is from the start.
-			  (while (not (eq e errors))
-			    (setq i (1+ i)
-				  e (cdr e)))
-			  (if (> (- n) i)
-			      (error "Moved back past first error")
-			    (nth (+ i n) compilation-old-error-list)))
-		      (let ((compilation-error-list (cdr errors)))
-			(compile-reinitialize-errors nil nil n)
-			(if compilation-error-list
-			    (nth (1- n) compilation-error-list)
-			  (error "Moved past last error"))))))))
-
-(defun compilation-previous-error (n)
-  "Move point to the previous error in the compilation buffer.
-Does NOT find the source line like \\[next-error]."
-  (interactive "p")
-  (compilation-next-error (- n)))
-
-
-;; Given an elt of `compilation-error-list', return an object representing
-;; the referenced file which is equal to (but not necessarily eq to) what
-;; this function would return for another error in the same file.
-(defsubst compilation-error-filedata (data)
-  (setq data (cdr data))
-  (if (markerp data)
-      (marker-buffer data)
-    (car data)))
-
-;; Return a string describing a value from compilation-error-filedata.
-;; This value is not necessarily useful as a file name, but should be
-;; indicative to the user of what file's errors are being referred to.
-(defsubst compilation-error-filedata-file-name (filedata)
-  (if (bufferp filedata)
-      (buffer-file-name filedata)
-    (car filedata)))
-
-(defun compilation-next-file (n)
-  "Move point to the next error for a different file than the current one."
-  (interactive "p")
-  (or (compilation-buffer-p (current-buffer))
-      (error "Not in a compilation buffer."))
-  (setq compilation-last-buffer (current-buffer))
-
-  (let ((reversed (< n 0))
-	errors filedata)
-
-    (if (not reversed)
-	(setq errors (or (compile-error-at-point)
-			 (error "Moved past last error")))
-
-      ;; Get a reversed list of the errors up through the one containing point.
-      (compile-reinitialize-errors nil (point))
-      (setq errors (reverse compilation-old-error-list)
-	    n (- n))
-
-      ;; Ignore errors after point.  (car ERRORS) will be the error
-      ;; containing point, (cadr ERRORS) the one before it.
-      (while (and errors
-		  (< (point) (car (car errors))))
-	(setq errors (cdr errors))))
-
-    (while (> n 0)
-      (setq filedata (compilation-error-filedata (car errors)))
-
-      ;; Skip past the following errors for this file.
-      (while (equal filedata
-		    (compilation-error-filedata
-		     (car (or errors
-			      (if reversed
-				  (error "%s the first erring file"
-					 (compilation-error-filedata-file-name
-					  filedata))
-				(let ((compilation-error-list nil))
-				  ;; Parse some more.
-				  (compile-reinitialize-errors nil nil 2)
-				  (setq errors compilation-error-list)))
-			      (error "%s is the last erring file"
-				     (compilation-error-filedata-file-name
-				      filedata))))))
-	(setq errors (cdr errors)))
-
-      (setq n (1- n)))
-
-    ;; Move to the following error.
-    (goto-char (car (car (or errors
-			     (if reversed
-				 (error "This is the first erring file")
-			       (let ((compilation-error-list nil))
-				 ;; Parse the last one.
-				 (compile-reinitialize-errors nil nil 1)
-				 compilation-error-list))))))))
-
-(defun compilation-previous-file (n)
-  "Move point to the previous error for a different file than the current one."
-  (interactive "p")
-  (compilation-next-file (- n)))
-
-
-(defun kill-compilation ()
-  "Kill the process made by the \\[compile] command."
-  (interactive)
-  (let ((buffer (compilation-find-buffer)))
-    (if (get-buffer-process buffer)
-	(interrupt-process (get-buffer-process buffer))
-      (error "The compilation process is not running."))))
-
-
-;; Parse any new errors in the compilation buffer,
-;; or reparse from the beginning if the user has asked for that.
-(defun compile-reinitialize-errors (reparse
-				    &optional limit-search find-at-least)
-  (save-excursion
-    (set-buffer compilation-last-buffer)
-    ;; If we are out of errors, or if user says "reparse",
-    ;; discard the info we have, to force reparsing.
-    (if (or (eq compilation-error-list t)
-	    reparse)
-	(compilation-forget-errors))
-    (if (and compilation-error-list
-	     (or (not limit-search)
-		 (> compilation-parsing-end limit-search))
-	     (or (not find-at-least)
-		 (>= (length compilation-error-list) find-at-least)))
-	;; Since compilation-error-list is non-nil, it points to a specific
-	;; error the user wanted.  So don't move it around.
-	nil
-      ;; This was here for a long time (before my rewrite); why? --roland
-      ;;(switch-to-buffer compilation-last-buffer)
-      (set-buffer-modified-p nil)
-      (if (< compilation-parsing-end (point-max))
-	  ;; compilation-error-list might be non-nil if we have a non-nil
-	  ;; LIMIT-SEARCH or FIND-AT-LEAST arg.  In that case its value
-	  ;; records the current position in the error list, and we must
-	  ;; preserve that after reparsing.
-	  (let ((error-list-pos compilation-error-list))
-	    (funcall compilation-parse-errors-function
-		     limit-search
-		     (and find-at-least
-			  ;; We only need enough new parsed errors to reach
-			  ;; FIND-AT-LEAST errors past the current
-			  ;; position.
-			  (- find-at-least (length compilation-error-list))))
-	    ;; Remember the entire list for compilation-forget-errors.  If
-	    ;; this is an incremental parse, append to previous list.  If
-	    ;; we are parsing anew, compilation-forget-errors cleared
-	    ;; compilation-old-error-list above.
-	    (setq compilation-old-error-list
-		  (nconc compilation-old-error-list compilation-error-list))
-	    (if error-list-pos
-		;; We started in the middle of an existing list of parsed
-		;; errors before parsing more; restore that position.
-		(setq compilation-error-list error-list-pos))
-	    ;; Mouse-Highlight (the first line of) each error message when the
-	    ;; mouse pointer moves over it:
-	    (let ((inhibit-read-only t)
-		  (error-list compilation-error-list))
-	      (while error-list
-		(save-excursion
-		  (put-text-property (goto-char (car (car error-list)))
-				     (progn (end-of-line) (point))
-				     'mouse-face 'highlight))
-		(setq error-list (cdr error-list))))
-	    )))))
-
-(defun compile-mouse-goto-error (event)
-  (interactive "e")
-  (save-excursion
-    (set-buffer (window-buffer (posn-window (event-end event))))
-    (goto-char (posn-point (event-end event)))
-
-    (or (compilation-buffer-p (current-buffer))
-	(error "Not in a compilation buffer."))
-    (setq compilation-last-buffer (current-buffer))
-    (compile-reinitialize-errors nil (point))
-
-    ;; Move to bol; the marker for the error on this line will point there.
-    (beginning-of-line)
-
-    ;; Move compilation-error-list to the elt of compilation-old-error-list
-    ;; we want.
-    (setq compilation-error-list compilation-old-error-list)
-    (while (and compilation-error-list
-		(> (point) (car (car compilation-error-list))))
-      (setq compilation-error-list (cdr compilation-error-list)))
-    (or compilation-error-list
-	(error "No error to go to")))
-  (select-window (posn-window (event-end event)))
-  ;; Move to another window, so that next-error's window changes
-  ;; result in the desired setup.
-  (or (one-window-p)
-      (progn
-	(other-window -1)
-	;; other-window changed the selected buffer,
-	;; but we didn't want to do that.
-	(set-buffer compilation-last-buffer)))
-
-  (push-mark)
-  (next-error 1))
-
-(defun compile-goto-error (&optional argp)
-  "Visit the source for the error message point is on.
-Use this command in a compilation log buffer.  Sets the mark at point there.
-\\[universal-argument] as a prefix arg means to reparse the buffer's error messages first;
-other kinds of prefix arguments are ignored."
-  (interactive "P")
-  (or (compilation-buffer-p (current-buffer))
-      (error "Not in a compilation buffer."))
-  (setq compilation-last-buffer (current-buffer))
-  (compile-reinitialize-errors (consp argp) (point))
-
-  ;; Move to bol; the marker for the error on this line will point there.
-  (beginning-of-line)
-
-  ;; Move compilation-error-list to the elt of compilation-old-error-list
-  ;; we want.
-  (setq compilation-error-list compilation-old-error-list)
-  (while (and compilation-error-list
-	      (> (point) (car (car compilation-error-list))))
-    (setq compilation-error-list (cdr compilation-error-list)))
-
-  ;; Move to another window, so that next-error's window changes
-  ;; result in the desired setup.
-  (or (one-window-p)
-      (progn
-	(other-window -1)
-	;; other-window changed the selected buffer,
-	;; but we didn't want to do that.
-	(set-buffer compilation-last-buffer)))
-
-  (push-mark)
-  (next-error 1))
-
-;; Return a compilation buffer.
-;; If the current buffer is a compilation buffer, return it.
-;; If compilation-last-buffer is set to a live buffer, use that.
-;; Otherwise, look for a compilation buffer and signal an error
-;; if there are none.
-(defun compilation-find-buffer (&optional other-buffer)
-  (if (and (not other-buffer)
-	   (compilation-buffer-p (current-buffer)))
-      ;; The current buffer is a compilation buffer.
-      (current-buffer)
-    (if (and compilation-last-buffer (buffer-name compilation-last-buffer)
-	     (compilation-buffer-p compilation-last-buffer)
-	     (or (not other-buffer) (not (eq compilation-last-buffer
-					     (current-buffer)))))
-	compilation-last-buffer
-      (let ((buffers (buffer-list)))
-	(while (and buffers (or (not (compilation-buffer-p (car buffers)))
-				(and other-buffer
-				     (eq (car buffers) (current-buffer)))))
-	  (setq buffers (cdr buffers)))
-	(if buffers
-	    (car buffers)
-	  (or (and other-buffer
-		   (compilation-buffer-p (current-buffer))
-		   ;; The current buffer is a compilation buffer.
-		   (progn
-		     (if other-buffer
-			 (message "This is the only compilation buffer."))
-		     (current-buffer)))
-	      (error "No compilation started!")))))))
-
-;;;###autoload
-(defun next-error (&optional argp)
-  "Visit next compilation error message and corresponding source code.
-This operates on the output from the \\[compile] command.
-If all preparsed error messages have been processed,
-the error message buffer is checked for new ones.
-
-A prefix arg specifies how many error messages to move;
-negative means move back to previous error messages.
-Just C-u as a prefix means reparse the error message buffer
-and start at the first error.
-
-\\[next-error] normally applies to the most recent compilation started,
-but as long as you are in the middle of parsing errors from one compilation
-output buffer, you stay with that compilation output buffer.
-
-Use \\[next-error] in a compilation output buffer to switch to
-processing errors from that compilation.
-
-See variables `compilation-parse-errors-function' and
-\`compilation-error-regexp-alist' for customization ideas."
-  (interactive "P")
-  (setq compilation-last-buffer (compilation-find-buffer))
-  (compilation-goto-locus (compilation-next-error-locus
-			   ;; We want to pass a number here only if
-			   ;; we got a numeric prefix arg, not just C-u.
-			   (and (not (consp argp))
-				(prefix-numeric-value argp))
-			   (consp argp))))
-;;;###autoload (define-key ctl-x-map "`" 'next-error)
-
-(defun previous-error ()
-  "Visit previous compilation error message and corresponding source code.
-This operates on the output from the \\[compile] command."
-  (interactive)
-  (next-error -1))
-
-(defun first-error ()
-  "Reparse the error message buffer and start at the first error
-Visit corresponding source code.
-This operates on the output from the \\[compile] command."
-  (interactive)
-  (next-error '(4)))
-
-(defvar compilation-skip-to-next-location nil
-  "*If non-nil, skip multiple error messages for the same source location.")
-
-(defun compilation-next-error-locus (&optional move reparse silent)
-  "Visit next compilation error and return locus in corresponding source code.
-This operates on the output from the \\[compile] command.
-If all preparsed error messages have been processed,
-the error message buffer is checked for new ones.
-
-Returns a cons (ERROR . SOURCE) of two markers: ERROR is a marker at the
-location of the error message in the compilation buffer, and SOURCE is a
-marker at the location in the source code indicated by the error message.
-
-Optional first arg MOVE says how many error messages to move forwards (or
-backwards, if negative); default is 1.  Optional second arg REPARSE, if
-non-nil, says to reparse the error message buffer and reset to the first
-error (plus MOVE - 1).  If optional third argument SILENT is non-nil, return
-nil instead of raising an error if there are no more errors.
-
-The current buffer should be the desired compilation output buffer."
-  (or move (setq move 1))
-  (compile-reinitialize-errors reparse nil (and (not reparse)
-						(if (< move 1) 0 (1- move))))
-  (let (next-errors next-error)
-    (catch 'no-next-error
-      (save-excursion
-	(set-buffer compilation-last-buffer)
-	;; compilation-error-list points to the "current" error.
-	(setq next-errors
-	      (if (> move 0)
-		  (nthcdr (1- move)
-			  compilation-error-list)
-		;; Zero or negative arg; we need to move back in the list.
-		(let ((n (1- move))
-		      (i 0)
-		      (e compilation-old-error-list))
-		  ;; See how many cdrs away the current error is from the start.
-		  (while (not (eq e compilation-error-list))
-		    (setq i (1+ i)
-			  e (cdr e)))
-		  (if (> (- n) i)
-		      (error "Moved back past first error")
-		    (nthcdr (+ i n) compilation-old-error-list))))
-	      next-error (car next-errors))
-	(while
-	    (if (null next-error)
-		(progn
-		  (and move (/= move 1)
-		       (error (if (> move 0)
-				  "Moved past last error")
-			      "Moved back past first error"))
-		  ;; Forget existing error messages if compilation has finished.
-		  (if (not (and (get-buffer-process (current-buffer))
-				(eq (process-status
-				     (get-buffer-process
-				      (current-buffer)))
-				    'run)))
-		      (compilation-forget-errors))
-		  (if silent
-		      (throw 'no-next-error nil)
-		    (error (concat compilation-error-message
-				   (and (get-buffer-process (current-buffer))
-					(eq (process-status
-					     (get-buffer-process
-					      (current-buffer)))
-					    'run)
-					" yet")))))
-	      (setq compilation-error-list (cdr next-errors))
-	      (if (null (cdr next-error))
-		  ;; This error is boring.  Go to the next.
-		  t
-		(or (markerp (cdr next-error))
-		    ;; This error has a filename/lineno pair.
-		    ;; Find the file and turn it into a marker.
-		    (let* ((fileinfo (car (cdr next-error)))
-			   (buffer (apply 'compilation-find-file
-					  (car next-error) fileinfo)))
-		      (if (null buffer)
-			  ;; We can't find this error's file.
-			  ;; Remove all errors in the same file.
-			  (progn
-			    (setq next-errors compilation-old-error-list)
-			    (while next-errors
-			      (and (consp (cdr (car next-errors)))
-				   (equal (car (cdr (car next-errors)))
-					  fileinfo)
-				   (progn
-				     (set-marker (car (car next-errors)) nil)
-				     (setcdr (car next-errors) nil)))
-			      (setq next-errors (cdr next-errors)))
-			    ;; Look for the next error.
-			    t)
-			;; We found the file.  Get a marker for this error.
-			;; compilation-old-error-list is a buffer-local
-			;; variable, so we must be careful to extract its value
-			;; before switching to the source file buffer.
-			(let ((errors compilation-old-error-list)
-			      (last-line (nth 1 (cdr next-error)))
-			      (column (nth 2 (cdr next-error))))
-			  (set-buffer buffer)
-			  (save-excursion
-			    (save-restriction
-			      (widen)
-			      (goto-line last-line)
-			      (if (and column (> column 0))
-				  ;; Columns in error msgs are 1-origin.
-				  (move-to-column (1- column))
-				(beginning-of-line))
-			      (setcdr next-error (point-marker))
-			      ;; Make all the other error messages referring
-			      ;; to the same file have markers into the buffer.
-			      (while errors
-				(and (consp (cdr (car errors)))
-				     (equal (car (cdr (car errors))) fileinfo)
-				     (let* ((this (nth 1 (cdr (car errors))))
-					    (column (nth 2 (cdr (car errors))))
-					    (lines (- this last-line)))
-				       (if (eq selective-display t)
-					   ;; When selective-display is t,
-					   ;; each C-m is a line boundary,
-					   ;; as well as each newline.
-					   (if (< lines 0)
-					       (re-search-backward "[\n\C-m]"
-								   nil 'end
-								   (- lines))
-					     (re-search-forward "[\n\C-m]"
-								nil 'end
-								lines))
-					 (forward-line lines))
-				       (if (and column (> column 1))
-					   (move-to-column (1- column))
-					 (beginning-of-line))
-				       (setq last-line this)
-				       (setcdr (car errors) (point-marker))))
-				(setq errors (cdr errors)))))))))
-		;; If we didn't get a marker for this error, or this
-		;; marker's buffer was killed, go on to the next one.
-		(or (not (markerp (cdr next-error)))
-		    (not (marker-buffer (cdr next-error))))))
-	  (setq next-errors compilation-error-list
-		next-error (car next-errors)))))
-
-    (if compilation-skip-to-next-location
-	;; Skip over multiple error messages for the same source location,
-	;; so the next C-x ` won't go to an error in the same place.
-	(while (and compilation-error-list
-		    (equal (cdr (car compilation-error-list)) (cdr next-error)))
-	  (setq compilation-error-list (cdr compilation-error-list))))
-
-    ;; We now have a marker for the position of the error source code.
-    ;; NEXT-ERROR is a cons (ERROR . SOURCE) of two markers.
-    next-error))
-
-(defun compilation-goto-locus (next-error)
-  "Jump to an error locus returned by `compilation-next-error-locus'.
-Takes one argument, a cons (ERROR . SOURCE) of two markers.
-Selects a window with point at SOURCE, with another window displaying ERROR."
-  (if (and (window-dedicated-p (selected-window))
-	   (eq (selected-window) (frame-root-window)))
-      (switch-to-buffer-other-frame (marker-buffer (cdr next-error)))
-    (switch-to-buffer (marker-buffer (cdr next-error))))
-  (goto-char (cdr next-error))
-  ;; If narrowing got in the way of
-  ;; going to the right place, widen.
-  (or (= (point) (marker-position (cdr next-error)))
-      (progn
-	(widen)
-	(goto-char (cdr next-error))))
-
-  ;; Show compilation buffer in other window, scrolled to this error.
-  (let* ((pop-up-windows t)
-	 ;; Use an existing window if it is in a visible frame.
-	 (w (or (get-buffer-window (marker-buffer (car next-error)) 'visible)
-		;; Pop up a window.
-		(display-buffer (marker-buffer (car next-error))))))
-    (set-window-point w (car next-error))
-    (set-window-start w (car next-error))
-    (compilation-set-window-height w)))
-
-;; Find a buffer for file FILENAME.
-;; Search the directories in compilation-search-path.
-;; A nil in compilation-search-path means to try the
-;; current directory, which is passed in DIR.
-;; If FILENAME is not found at all, ask the user where to find it.
-;; Pop up the buffer containing MARKER and scroll to MARKER if we ask the user.
-(defun compilation-find-file (marker filename dir &rest formats)
-  (or formats (setq formats '("%s")))
-  (let ((dirs compilation-search-path)
-	buffer thisdir fmts name)
-    (if (file-name-absolute-p filename)
-	;; The file name is absolute.  Use its explicit directory as
-	;; the first in the search path, and strip it from FILENAME.
-	(setq filename (abbreviate-file-name (expand-file-name filename))
-	      dirs (cons (file-name-directory filename) dirs)
-	      filename (file-name-nondirectory filename)))
-    ;; Now search the path.
-    (while (and dirs (null buffer))
-      (setq thisdir (or (car dirs) dir)
-	    fmts formats)
-      ;; For each directory, try each format string.
-      (while (and fmts (null buffer))
-	(setq name (expand-file-name (format (car fmts) filename) thisdir)
-	      buffer (and (file-exists-p name)
-			  (find-file-noselect name))
-	      fmts (cdr fmts)))
-      (setq dirs (cdr dirs)))
-    (or buffer
-	;; The file doesn't exist.
-	;; Ask the user where to find it.
-	;; If he hits C-g, then the next time he does
-	;; next-error, he'll skip past it.
-	(let* ((pop-up-windows t)
-	       (w (display-buffer (marker-buffer marker))))
-	  (set-window-point w marker)
-	  (set-window-start w marker)
-	  (let ((name (expand-file-name
-		       (read-file-name
-			(format "Find this error in: (default %s) "
-				filename)
-			dir filename t))))
-	    (if (file-directory-p name)
-		(setq name (expand-file-name filename name)))
-	    (and (file-exists-p name)
-		 (find-file-noselect name)))))))
-
-;; Set compilation-error-list to nil, and unchain the markers that point to the
-;; error messages and their text, so that they no longer slow down gap motion.
-;; This would happen anyway at the next garbage collection, but it is better to
-;; do it right away.
-(defun compilation-forget-errors ()
-  (while compilation-old-error-list
-    (let ((next-error (car compilation-old-error-list)))
-      (set-marker (car next-error) nil)
-      (if (markerp (cdr next-error))
-	  (set-marker (cdr next-error) nil)))
-    (setq compilation-old-error-list (cdr compilation-old-error-list)))
-  (setq compilation-error-list nil
-	compilation-directory-stack nil
-	compilation-parsing-end 1)
-  ;; Remove the highlighting added by compile-reinitialize-errors:
-  (let ((inhibit-read-only t))
-    (remove-text-properties (point-min) (point-max) '(mouse-face highlight)))
-  )
-
-
-(defun count-regexp-groupings (regexp)
-  "Return the number of \\( ... \\) groupings in REGEXP (a string)."
-  (let ((groupings 0)
-	(len (length regexp))
-	(i 0)
-	c)
-    (while (< i len)
-      (setq c (aref regexp i)
-	    i (1+ i))
-      (cond ((= c ?\[)
-	     ;; Find the end of this [...].
-	     (while (and (< i len)
-			 (not (= (aref regexp i) ?\])))
-	       (setq i (1+ i))))
-	    ((= c ?\\)
-	     (if (< i len)
-		 (progn
-		   (setq c (aref regexp i)
-			 i (1+ i))
-		   (if (= c ?\))
-		       ;; We found the end of a grouping,
-		       ;; so bump our counter.
-		       (setq groupings (1+ groupings))))))))
-    groupings))
-
-(defun compilation-parse-errors (limit-search find-at-least)
-  "Parse the current buffer as grep, cc or lint error messages.
-See variable `compilation-parse-errors-function' for the interface it uses."
-  (setq compilation-error-list nil)
-  (message "Parsing error messages...")
-  (let (text-buffer orig orig-expanded parent-expanded
-	regexp enter-group leave-group error-group
-	alist subexpr error-regexp-groups
-	(found-desired nil)
-	(compilation-num-errors-found 0))
-
-    ;; Don't reparse messages already seen at last parse.
-    (goto-char compilation-parsing-end)
-    ;; Don't parse the first two lines as error messages.
-    ;; This matters for grep.
-    (if (bobp)
-	(progn
-	  (forward-line 2)
-	  ;; Move back so point is before the newline.
-	  ;; This matters because some error regexps use \n instead of ^
-	  ;; to be faster.
-	  (forward-char -1)))
-
-    ;; Compile all the regexps we want to search for into one.
-    (setq regexp (concat "\\(" compilation-enter-directory-regexp "\\)\\|"
-			 "\\(" compilation-leave-directory-regexp "\\)\\|"
-			 "\\(" (mapconcat (function
-					   (lambda (elt)
-					     (concat "\\(" (car elt) "\\)")))
-					  compilation-error-regexp-alist
-					  "\\|") "\\)"))
-
-    ;; Find out how many \(...\) groupings are in each of the regexps, and set
-    ;; *-GROUP to the grouping containing each constituent regexp (whose
-    ;; subgroups will come immediately thereafter) of the big regexp we have
-    ;; just constructed.
-    (setq enter-group 1
-	  leave-group (+ enter-group
-			 (count-regexp-groupings
-			  compilation-enter-directory-regexp)
-			 1)
-	  error-group (+ leave-group
-			 (count-regexp-groupings
-			  compilation-leave-directory-regexp)
-			 1))
-
-    ;; Compile an alist (IDX FILE LINE [COL]), where IDX is the number of
-    ;; the subexpression for an entire error-regexp, and FILE and LINE (and
-    ;; possibly COL) are the numbers for the subexpressions giving the file
-    ;; name and line number (and possibly column number).
-    (setq alist (or compilation-error-regexp-alist
-		    (error "compilation-error-regexp-alist is empty!"))
-	  subexpr (1+ error-group))
-    (while alist
-      (setq error-regexp-groups
-	    (cons (list subexpr
-			(+ subexpr (nth 1 (car alist)))
-			(+ subexpr (nth 2 (car alist)))
-			(and (nth 3 (car alist))
-			     (+ subexpr (nth 3 (car alist)))))
-		  error-regexp-groups))
-      (setq subexpr (+ subexpr 1 (count-regexp-groupings (car (car alist)))))
-      (setq alist (cdr alist)))
-
-    ;; Set up now the expanded, abbreviated directory variables
-    ;; that compile-abbreviate-directory will need, so we can
-    ;; compute them just once here.
-    (setq orig (abbreviate-file-name default-directory)
-	  orig-expanded (abbreviate-file-name
-			 (file-truename default-directory))
-	  parent-expanded (abbreviate-file-name
-			   (expand-file-name "../" orig-expanded)))
-
-    (while (and (not found-desired)
-		;; We don't just pass LIMIT-SEARCH to re-search-forward
-		;; because we want to find matches containing LIMIT-SEARCH
-		;; but which extend past it.
-		(re-search-forward regexp nil t))
-
-      ;; Figure out which constituent regexp matched.
-      (cond ((match-beginning enter-group)
-	     ;; The match was the enter-directory regexp.
-	     (let ((dir
-		    (file-name-as-directory
-		     (expand-file-name
-		      (buffer-substring (match-beginning (+ enter-group 1))
-					(match-end (+ enter-group 1)))))))
-	       ;; The directory name in the "entering" message
-	       ;; is a truename.  Try to convert it to a form
-	       ;; like what the user typed in.
-	       (setq dir
-		     (compile-abbreviate-directory dir orig orig-expanded
-						   parent-expanded))
-	       (setq compilation-directory-stack
-		     (cons dir compilation-directory-stack))
-	       (and (file-directory-p dir)
-		    (setq default-directory dir)))
-
-	     (and limit-search (>= (point) limit-search)
-		  ;; The user wanted a specific error, and we're past it.
-		  ;; We do this check here (and in the leave-group case)
-		  ;; rather than at the end of the loop because if the last
-		  ;; thing seen is an error message, we must carefully
-		  ;; discard the last error when it is the first in a new
-		  ;; file (see below in the error-group case).
-		  (setq found-desired t)))
-
-	    ((match-beginning leave-group)
-	     ;; The match was the leave-directory regexp.
-	     (let ((beg (match-beginning (+ leave-group 1)))
-		   (stack compilation-directory-stack))
-	       (if beg
-		   (let ((dir
-			  (file-name-as-directory
-			   (expand-file-name
-			    (buffer-substring beg
-					      (match-end (+ leave-group
-							    1)))))))
-		     ;; The directory name in the "leaving" message
-		     ;; is a truename.  Try to convert it to a form
-		     ;; like what the user typed in.
-		     (setq dir
-			   (compile-abbreviate-directory dir orig orig-expanded
-							 parent-expanded))
-		     (while (and stack
-				 (not (string-equal (car stack) dir)))
-		       (setq stack (cdr stack)))))
-	       (setq compilation-directory-stack (cdr stack))
-	       (setq stack (car compilation-directory-stack))
-	       (if stack
-		   (setq default-directory stack))
-	       )
-
-	     (and limit-search (>= (point) limit-search)
-		  ;; The user wanted a specific error, and we're past it.
-		  ;; We do this check here (and in the enter-group case)
-		  ;; rather than at the end of the loop because if the last
-		  ;; thing seen is an error message, we must carefully
-		  ;; discard the last error when it is the first in a new
-		  ;; file (see below in the error-group case).
-		  (setq found-desired t)))
-
-	    ((match-beginning error-group)
-	     ;; The match was the composite error regexp.
-	     ;; Find out which individual regexp matched.
-	     (setq alist error-regexp-groups)
-	     (while (and alist
-			 (null (match-beginning (car (car alist)))))
-	       (setq alist (cdr alist)))
-	     (if alist
-		 (setq alist (car alist))
-	       (error "compilation-parse-errors: impossible regexp match!"))
-
-	     ;; Extract the file name and line number from the error message.
-	     (let ((beginning-of-match (match-beginning 0)) ;looking-at nukes
-		   (filename (buffer-substring (match-beginning (nth 1 alist))
-					       (match-end (nth 1 alist))))
-		   (linenum (string-to-int
-			     (buffer-substring
-			      (match-beginning (nth 2 alist))
-			      (match-end (nth 2 alist)))))
-		   (column (and (nth 3 alist)
-				(match-beginning (nth 3 alist))
-				(string-to-int
-				 (buffer-substring
-				  (match-beginning (nth 3 alist))
-				  (match-end (nth 3 alist)))))))
-
-	       ;; Check for a comint-file-name-prefix and prepend it if
-	       ;; appropriate.  (This is very useful for
-	       ;; compilation-minor-mode in an rlogin-mode buffer.)
-	       (and (boundp 'comint-file-name-prefix)
-		    ;; If the file name is relative, default-directory will
-		    ;; already contain the comint-file-name-prefix (done by
-		    ;; compile-abbreviate-directory).
-		    (file-name-absolute-p filename)
-		    (setq filename (concat comint-file-name-prefix filename)))
-
-	       ;; Some compilers (e.g. Sun's java compiler, reportedly)
-	       ;; produce bogus file names like "./bar//foo.c" for the file
-	       ;; "bar/foo.c"; expand-file-name will collapse these into
-	       ;; "/foo.c" and fail to find the appropriate file.  So we look
-	       ;; for doubled slashes in the file name and fix them up in the
-	       ;; buffer.
-	       (setq filename (command-line-normalize-file-name filename))
-	       (setq filename (cons filename (cons default-directory
-						   (nthcdr 4 alist))))
-
-
-	       ;; Locate the erring file and line.
-	       ;; Cons a new elt onto compilation-error-list,
-	       ;; giving a marker for the current compilation buffer
-	       ;; location, and the file and line number of the error.
-	       (save-excursion
-		 ;; Save as the start of the error the beginning of the
-		 ;; line containing the match unless the match starts at a
-		 ;; newline, in which case the beginning of the next line.
-		 (goto-char beginning-of-match)
-		 (forward-line (if (eolp) 1 0))
-		 (let ((this (cons (point-marker)
-				   (list filename linenum column))))
-		   ;; Don't add the same source line more than once.
-		   (if (and compilation-skip-to-next-location
-			    (equal (cdr this)
-				   (cdr (car compilation-error-list))))
-		       nil
-		     (setq compilation-error-list
-			   (cons this
-				 compilation-error-list))
-		     (setq compilation-num-errors-found
-			   (1+ compilation-num-errors-found)))))
-	       (and (or (and find-at-least (> compilation-num-errors-found
-					      find-at-least))
-			(and limit-search (>= (point) limit-search)))
-		    ;; We have found as many new errors as the user wants,
-		    ;; or past the buffer position he indicated.  We
-		    ;; continue to parse until we have seen all the
-		    ;; consecutive errors in the same file, so the error
-		    ;; positions will be recorded as markers in this buffer
-		    ;; that might change.
-		    (cdr compilation-error-list) ; Must check at least two.
-		    (not (equal (car (cdr (nth 0 compilation-error-list)))
-				(car (cdr (nth 1 compilation-error-list)))))
-		    (progn
-		      ;; Discard the error just parsed, so that the next
-		      ;; parsing run can get it and the following errors in
-		      ;; the same file all at once.  If we didn't do this, we
-		      ;; would have the same problem we are trying to avoid
-		      ;; with the test above, just delayed until the next run!
-		      (setq compilation-error-list
-			    (cdr compilation-error-list))
-		      (goto-char beginning-of-match)
-		      (setq found-desired t)))
-	       )
-	     )
-	    (t
-	     (error "compilation-parse-errors: known groups didn't match!")))
-
-      (message "Parsing error messages...%d (%.0f%% of buffer)"
-	       compilation-num-errors-found
-	       ;; Use floating-point because (* 100 (point)) frequently
-	       ;; exceeds the range of Emacs Lisp integers.
-	       (/ (* 100.0 (point)) (point-max)))
-
-      (and limit-search (>= (point) limit-search)
-	   ;; The user wanted a specific error, and we're past it.
-	   (setq found-desired t)))
-    (setq compilation-parsing-end (if found-desired
-				      (point)
-				    ;; We have searched the whole buffer.
-				    (point-max))))
-  (setq compilation-error-list (nreverse compilation-error-list))
-  (message "Parsing error messages...done"))
-
-;; If directory DIR is a subdir of ORIG or of ORIG's parent,
-;; return a relative name for it starting from ORIG or its parent.
-;; ORIG-EXPANDED is an expanded version of ORIG.
-;; PARENT-EXPANDED is an expanded version of ORIG's parent.
-;; Those two args could be computed here, but we run faster by
-;; having the caller compute them just once.
-(defun compile-abbreviate-directory (dir orig orig-expanded parent-expanded)
-  ;; Apply canonical abbreviations to DIR first thing.
-  ;; Those abbreviations are already done in the other arguments passed.
-  (setq dir (abbreviate-file-name dir))
-
-  ;; Check for a comint-file-name-prefix and prepend it if appropriate.
-  ;; (This is very useful for compilation-minor-mode in an rlogin-mode
-  ;; buffer.)
-  (if (boundp 'comint-file-name-prefix)
-      (setq dir (concat comint-file-name-prefix dir)))
-
-  (if (and (> (length dir) (length orig-expanded))
-	   (string= orig-expanded
-		    (substring dir 0 (length orig-expanded))))
-      (setq dir
-	    (concat orig
-		    (substring dir (length orig-expanded)))))
-  (if (and (> (length dir) (length parent-expanded))
-	   (string= parent-expanded
-		    (substring dir 0 (length parent-expanded))))
-    (setq dir
-	  (concat (file-name-directory
-		   (directory-file-name orig))
-		  (substring dir (length parent-expanded)))))
-  dir)
-
-(provide 'compile)
-
-;;; compile.el ends here
diff --git a/lisp/progmodes/cplus-md.el b/lisp/progmodes/cplus-md.el
deleted file mode 100644
index 9848adcf40b..00000000000
--- a/lisp/progmodes/cplus-md.el
+++ /dev/null
@@ -1,1061 +0,0 @@
-;;; cplus-md.el --- C++ code editing commands for Emacs
-
-;; Copyright (C) 1985, 1992, 1994, 1995 Free Software Foundation, Inc.
-
-;; Maintainer: Dave Detlefs <dld@cs.cmu.edu>
-;; Keywords: c
-
-;; 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:
-
-;; 1987 Dave Detlefs  <dld@cs.cmu.edu> 
-;; and  Stewart Clamen <clamen@cs.cmu.edu>.
-;; Done by fairly faithful modification of:
-
-;;; Change Log:
-
-;; Feb, 1990 (Dave Detlefs, dld@cs.cmu.edu)
-;;   Fixed electric-c++-terminator to handle double colons, at the
-;;   request of John Hagerman.
-;; 
-;; Jan, 1990 (Doug Lea, dl@oswego.edu)
-;;   Replaced c++-comment-region and c++-uncomment-region with
-;;     versions from Igor Metz that avoid potential infinite loops.
-;;
-;; Oct, 1989 (Dave Detlefs, dld@cs.cmu.edu)
-;;   Added contribution from Igor Metz <metz@iam.unibe.ch>:
-;;     functions c++-comment-region and c++-uncomment-region and 
-;;     corresponding key-binding.
-;;   Also fixed bug in indentation of second line after an empty
-;;   arglist with empty-arglist non-null.
-;;   
-;; Sept, 1989 (Glen Ditchfield, gjditchfield@violet.uwaterloo.ca):
-;;   Textual changes to more closely imitate Emacs 18.55's c-mode.
-;;   Fixed handling of "default:", where ":" was the last character in the
-;;   buffer.  Fixed indentation of comments starting in column 0, and when
-;;   previous line contained more than one comment start string.  Fixed
-;;   handling of "friend".
-;;
-;; Aug 7, 1989; John Hagerman (hagerman@ece.cmu.edu):
-;;   Changed calculate-c++-indent to handle member initializations
-;;   more flexibly. Two new variables are used to control behavior:
-;;   c++-member-init-indent and c++-continued-member-init-offset.
-;;   Note the assumption that member initializations and argument
-;;   declarations are not mixed in one function definition.
-;;
-;; June 1989 (Dave Detlefs, dld@cs.cmu.edu)
-;;   Fixed calculate-c++-indent to handle continued lines ending in
-;;   {'s.  (I wasn't following C-mode closely enough, or C-mode
-;;   changed.)  Made ' a quote character, at the behest of someone
-;;   whose mail I apparently deleted (if they send me mail I'll credit
-;;   them here in a future revision.)
-;;   Dan Weinreb (dlw@odi.com) pointed out that 'c++-mode successively
-;;   bound c++-indent-exp and c++-indent-defun to ESC-^q.  ESC-^q is
-;;   now bound to c++-indent-exp, while, c++-indent-defun is invoked
-;;   with ESC-^x.
-
-;; February 1989 (Dave Detlefs, dld@cs.cmu.edu)
-;;   Fixed some errors in c++-indent-defun, as pointed out by Sam
-;;   Haradhvala (odi!sam@talcott.harvard.edu).
-;; October 1988 (Dave Detlefs, dld@cs.cmu.edu)
-;;   It turns out I had only *thought* I had made
-;;   beginning(end)-of-defun work.  It should work better now -- you
-;;   can either attempt to match defun headers "strongly," using a
-;;   very complicated regexp, or "weakly," using a simple one.  This
-;;   is settable by a variable; the default is the cheaper weak
-;;   method.  (Stewart Clamen was intimately involved in this, too.)
-;;
-;;   I made "'" *not* be a string delimiter, because that was causing
-;;   comments containing contractions to ("// don't") to mess up paren
-;;   balancing.
-;;
-;;   I also incorporated another slight indentation fix from Glen
-;;   Ditchfield.
-;;
-;;   We hope this is will make into version 19 of gnu-emacs.
-;;
-;; September 1988: incorporated changes from Fred Calm at Schlumberger.
-;;   Also, made beginning(end)-of-defun, indent-defun work.
-;;
-;; August 1987: incorporated changes done by Glen Ditchfield of Waterloo.
-
-;;; Code:
-
-(defvar c++-mode-abbrev-table nil
-  "Abbrev table used in C++ mode.")
-(define-abbrev-table 'c++-mode-abbrev-table ())
-
-(defvar c++-mode-map ()
-  "Keymap used in C++ mode.")
-(if c++-mode-map
-    ()
-  (setq c++-mode-map (make-sparse-keymap))
-  (define-key c++-mode-map "\C-j" 'reindent-then-newline-and-indent)
-  (define-key c++-mode-map "{" 'electric-c++-brace)
-  (define-key c++-mode-map "}" 'electric-c++-brace)
-  (define-key c++-mode-map ";" 'electric-c++-semi)
-  (define-key c++-mode-map "\e\C-h" 'mark-c-function)
-  (define-key c++-mode-map "\e\C-q" 'indent-c++-exp)
-  (define-key c++-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key c++-mode-map "\t" 'c++-indent-command)
-;;   (define-key c++-mode-map "\C-c\C-i" 'c++-insert-header)
-  (define-key c++-mode-map "\C-c\C-\\" 'c-backslash-region))
-;;   (define-key c++-mode-map "\e\C-a" 'c++-beginning-of-defun)
-;;   (define-key c++-mode-map "\e\C-e" 'c++-end-of-defun)
-;;   (define-key c++-mode-map "\e\C-x" 'c++-indent-defun))
-
-(defvar c++-mode-syntax-table nil
-  "Syntax table used in C++ mode.")
-
-(if c++-mode-syntax-table
-    ()
-  (setq c++-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "\\" c++-mode-syntax-table)
-  (modify-syntax-entry ?/ ". 14" c++-mode-syntax-table)
-  (modify-syntax-entry ?* ". 23" c++-mode-syntax-table)
-  (modify-syntax-entry ?+ "." c++-mode-syntax-table)
-  (modify-syntax-entry ?- "." c++-mode-syntax-table)
-  (modify-syntax-entry ?= "." c++-mode-syntax-table)
-  (modify-syntax-entry ?% "." c++-mode-syntax-table)
-  (modify-syntax-entry ?< "." c++-mode-syntax-table)
-  (modify-syntax-entry ?> "." c++-mode-syntax-table)
-  (modify-syntax-entry ?& "." c++-mode-syntax-table)
-  (modify-syntax-entry ?| "." c++-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" c++-mode-syntax-table)
-  (modify-syntax-entry ?* ". 23b" c++-mode-syntax-table)
-  (modify-syntax-entry ?/ ". 124" c++-mode-syntax-table)
-  (modify-syntax-entry ?\n ">" c++-mode-syntax-table)
-  (modify-syntax-entry ?\^m ">" c++-mode-syntax-table))
-
-(defvar c++-continued-member-init-offset nil
-  "*Extra indent for continuation lines of member inits;
-nil means to align with previous initializations rather than
-with the colon on the first line.")
-(defvar c++-member-init-indent 0
-  "*Indentation level of member initializations in function declarations.")
-(defvar c++-friend-offset -4
-  "*Offset of C++ friend declarations relative to member declarations.")
-(defvar c++-electric-colon t
-  "*If t, colon is an electric terminator.")
-(defvar c++-empty-arglist-indent nil
-  "*Indicates how far to indent an line following an empty argument
-list.  Nil indicates to just after the paren.")
-
-(defvar c++-imenu-generic-expression
-  (` 
-   ((nil
-     (, 
-      (concat
-       "^"				  ; beginning of line is required
-       "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
-       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; type specs; there can be no
-       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; more than 3 tokens, right?
-       
-       "\\("				  ; last type spec including */&
-       "[a-zA-Z0-9_:]+"
-       "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)"	  ; either pointer/ref sign or whitespace
-       "\\)?"				  ; if there is a last type spec
-       "\\("			      ; name; take that into the imenu entry
-       "[a-zA-Z0-9_:~]+"		      ; member function, ctor or dtor...
-					; (may not contain * because then 
-					; "a::operator char*" would become "char*"!)
-       "\\|"
-       "\\([a-zA-Z0-9_:~]*::\\)?operator"
-       "[^a-zA-Z1-9_][^(]*"	      ; ...or operator
-       " \\)"
-       "[ \t]*([^)]*)[ \t\n]*[^	      ;]" ; require something other than a ; after
-					; the (...) to avoid prototypes.  Can't
-					; catch cases with () inside the parentheses
-					; surrounding the parameters
-					; (like "int foo(int a=bar()) {...}"
-       
-       )) 6)    
-    ("Class" 
-     (, (concat 
-	 "^"				   ; beginning of line is required
-	 "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
-	 "class[ \t]+"
-	 "\\([a-zA-Z0-9_]+\\)"                ; this is the string we want to get
-	 "[ \t]*[:{]"
-	 )) 2)
-;; Example of generic expression for finding prototypes, structs, unions, enums.
-;; Uncomment if you want to find these too.  It will be a bit slower gathering
-;; the indexes.
-;    ("Prototypes"
-;     (, 
-;      (concat
-;       "^"				  ; beginning of line is required
-;       "\\(template[ \t]*<[^>]+>[ \t]*\\)?" ; there may be a "template <...>"
-;       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; type specs; there can be no
-;       "\\([a-zA-Z0-9_:]+[ \t]+\\)?"	  ; more than 3 tokens, right?
-       
-;       "\\("				  ; last type spec including */&
-;       "[a-zA-Z0-9_:]+"
-;       "\\([ \t]*[*&]+[ \t]*\\|[ \t]+\\)"	  ; either pointer/ref sign or whitespace
-;       "\\)?"				  ; if there is a last type spec
-;       "\\("			      ; name; take that into the imenu entry
-;       "[a-zA-Z0-9_:~]+"		      ; member function, ctor or dtor...
-;					; (may not contain * because then 
-;					; "a::operator char*" would become "char*"!)
-;       "\\|"
-;       "\\([a-zA-Z0-9_:~]*::\\)?operator"
-;       "[^a-zA-Z1-9_][^(]*"	      ; ...or operator
-;       " \\)"
-;       "[ \t]*([^)]*)[ \t\n]*;" 	; require ';' after
-;					; the (...) Can't
-;					; catch cases with () inside the parentheses
-;					; surrounding the parameters
-;					; (like "int foo(int a=bar());"       
-;       )) 6)    
-;    ("Struct"
-;     (, (concat
-;	 "^"				; beginning of line is required
-;	 "\\(static[ \t]+\\)?"		; there may be static or const.
-;	 "\\(const[ \t]+\\)?"
-;	 "struct[ \t]+"
-;	 "\\([a-zA-Z0-9_]+\\)"		; this is the string we want to get
-;	 "[ \t]*[{]"
-;	 )) 3)
-;    ("Enum"
-;     (, (concat
-;	 "^"				; beginning of line is required
-;	 "\\(static[ \t]+\\)?"		; there may be static or const.
-;	 "\\(const[ \t]+\\)?"
-;	 "enum[ \t]+"
-;	 "\\([a-zA-Z0-9_]+\\)"		; this is the string we want to get
-;	 "[ \t]*[{]"
-;	 )) 3)
-;    ("Union"
-;     (, (concat
-;	 "^"				; beginning of line is required
-;	 "\\(static[ \t]+\\)?"		; there may be static or const.
-;	 "\\(const[ \t]+\\)?"
-;	 "union[ \t]+"
-;	 "\\([a-zA-Z0-9_]+\\)"		; this is the string we want to get
-;	 "[ \t]*[{]"
-;	 )) 3)
-    ))
-  "Imenu generic expression for C++ mode.  See `imenu-generic-expression'.")
-
-(defun c++-mode ()
-  "Major mode for editing C++ code.  Very much like editing C code.
-Expression and list commands understand all C++ brackets.
-Tab at left margin indents for C++ code
-Comments are delimited with /* ... */ {or with // ... <newline>}
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-\\{c++-mode-map}
-Variables controlling indentation style:
- c-tab-always-indent
-    Non-nil means TAB in C mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
-    Default is t.
- c-auto-newline
-    Non-nil means automatically newline before and after braces,
-    and after colons and semicolons, inserted in C code.
- c-indent-level
-    Indentation of C statements within surrounding block.
-    The surrounding block's indentation is the indentation
-    of the line on which the open-brace appears.
- c-continued-statement-offset
-    Extra indentation given to a substatement, such as the
-    then-clause of an if or body of a while.
- c-continued-brace-offset
-    Extra indentation given to a brace that starts a substatement.
-    This is in addition to c-continued-statement-offset.
- c-brace-offset
-    Extra indentation for line if it starts with an open brace.
- c-brace-imaginary-offset
-    An open brace following other text is treated as if it were
-    this far to the right of the start of its line.
- c-argdecl-indent
-    Indentation level of declarations of C function arguments.
- c-label-offset
-    Extra indentation for line that is a label, or case or ``default:'', or
-    ``public:'' or ``private:'', or ``protected:''.
- c++-electric-colon
-    If non-nil at invocation of c++-mode (t is the default) colon electrically
-    indents.
- c++-empty-arglist-indent
-    If non-nil, a function declaration or invocation which ends a line with a
-    left paren is indented this many extra spaces, instead of flush with the
-    left paren.
- c++-friend-offset
-    Offset of C++ friend declarations relative to member declarations.
- c++-member-init-indent
-    Indentation level of member initializations in function declarations,
-    if they are on a separate line beginning with a colon.
- c++-continued-member-init-offset
-    Extra indentation for continuation lines of member initializations; NIL
-    means to align with previous initializations rather than with the colon.
-
-Settings for K&R, BSD, and Stroustrup indentation styles are
-  c-indent-level                5    8    4
-  c-continued-statement-offset  5    8    4
-  c-continued-brace-offset                0
-  c-brace-offset               -5   -8    0
-  c-brace-imaginary-offset                0
-  c-argdecl-indent              0    8    4
-  c-label-offset               -5   -8   -4
-  c++-empty-arglist-indent                4
-  c++-friend-offset                       0
-
-Turning on C++ mode calls the value of the variable `c++-mode-hook' with
-no args if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  ;; This code depends on the old C mode.
-  (require 'c-mode)
-  (use-local-map c++-mode-map)
-  (set-syntax-table c++-mode-syntax-table)
-  (setq major-mode 'c++-mode
-	mode-name "C++"
-	comment-column 32
-	local-abbrev-table c++-mode-abbrev-table)
-  (set (make-local-variable 'indent-line-function) 'c++-indent-line)
-  (set (make-local-variable 'comment-start) "// ")
-  (set (make-local-variable 'comment-end) "")
-  (set (make-local-variable 'comment-start-skip) "/\\*+ *\\|// *")
-  (set (make-local-variable 'comment-indent-function) 'c++-comment-indent)
-  (set (make-local-variable 'paragraph-start) (concat "$\\|" page-delimiter))
-  (set (make-local-variable 'paragraph-separate) paragraph-start)
-  (set (make-local-variable 'paragraph-ignore-fill-prefix) t)
-  (set (make-local-variable 'require-final-newline) t)
-  (set (make-local-variable 'parse-sexp-ignore-comments) t)
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression c++-imenu-generic-expression)
-  (run-hooks 'c++-mode-hook)
-  (if c++-electric-colon
-      (define-key c++-mode-map ":" 'electric-c++-terminator)))
-
-;; This is used by indent-for-comment
-;; to decide how much to indent a comment in C++ code
-;; based on its context.
-(defun c++-comment-indent ()
-  (if (looking-at "^\\(/\\*\\|//\\)")
-      0					; Existing comment at bol stays there.
-    (save-excursion
-      (skip-chars-backward " \t")
-      (max
-       ;; Leave at least one space on non-empty lines.
-       (if (zerop (current-column)) 0 (1+ (current-column)))
-       (let ((cur-pt (point)))
-	 (beginning-of-line 0)
-	 ;; If previous line had a comment, use its indentation.
-	 (if (re-search-forward comment-start-skip cur-pt t)
-	     (progn
-	       (goto-char (match-beginning 0))
-	       (current-column))
-	   comment-column))))))		; otherwise indent at comment column.
-
-(defun electric-c++-brace (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (let (insertpos)
-    (if (and (not arg)
-	     (eolp)
-	     (or (save-excursion
-		   (skip-chars-backward " \t")
-		   (bolp))
-		 (if c-auto-newline (progn (c++-indent-line) (newline) t))))
-	(progn
-	  (insert last-command-char)
-	  (c++-indent-line)
-	  (if c-auto-newline
-	      (progn
-		(newline)
-		;; (newline) may have done auto-fill
-		(setq insertpos (- (point) 2))
-		(c++-indent-line)))
-	  (save-excursion
-	    (if insertpos (goto-char (1+ insertpos)))
-	    (delete-char -1))))
-    (if insertpos
-	(save-excursion
-	  (goto-char insertpos)
-	  (self-insert-command (prefix-numeric-value arg)))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun electric-c++-semi (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (if c-auto-newline
-      (electric-c++-terminator arg)
-    (self-insert-command (prefix-numeric-value arg))))
-
-(defun electric-c++-terminator (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (let (insertpos (end (point)))
-    (if (and (not arg) (eolp)
-	     (not (save-excursion
-		    (beginning-of-line)
-		    (skip-chars-forward " \t")
-		    (or (= (following-char) ?#)
-			;; Colon is special only after a label, or
-			;; case, or another colon.
-			;; So quickly rule out most other uses of colon
-			;; and do no indentation for them.
-			(and (eq last-command-char ?:)
-			     (or (not (or (looking-at "case[ \t]")
-					  (save-excursion
-					    (forward-word 1)
-					    (skip-chars-forward " \t")
-					    (>= (point) end))))
-				 ;; Do re-indent double colons
-				 (save-excursion
-				   (end-of-line 1)
-				   (looking-at ":"))))
-			(progn
-			  (beginning-of-defun)
-			  (let ((pps (parse-partial-sexp (point) end)))
-			    (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))))
-	(progn
-	  (insert last-command-char)
-	  (c++-indent-line)
-	  (and c-auto-newline
-	       (not (c-inside-parens-p))
-	       (progn
-		 ;; the new marker object, used to be just an integer
-		 (setq insertpos (make-marker))
-		 ;; changed setq to set-marker
-		 (set-marker insertpos (1- (point)))
-		 ;; do this before the newline, since in auto fill can break
-		 (newline)
-		 (c-indent-line)))
-	  (save-excursion
-	    (if insertpos (goto-char (1+ insertpos)))
-	    (delete-char -1))))
-    (if insertpos
-	(save-excursion
-	  (goto-char insertpos)
-	  (self-insert-command (prefix-numeric-value arg)))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun c++-indent-command (&optional whole-exp)
-  "Indent current line as C++ code, or in some cases insert a tab character.
-If `c-tab-always-indent' is non-nil (the default), always indent current
-line.  Otherwise, indent the current line only if point is at the left
-margin or in the line's indentation; otherwise insert a tab.
-
-A numeric argument, regardless of its value, means indent rigidly all means
-indent rigidly all the lines of the expression starting after point so that
-this line becomes properly indented.  The relative indentation among the
-lines of the expression are preserved."
-  (interactive "P")
-  (if whole-exp
-      ;; If arg, always indent this line as C
-      ;; and shift remaining lines of expression the same amount.
-      (let ((shift-amt (c++-indent-line))
-	    beg end)
-	(save-excursion
-	  (if c-tab-always-indent
-	      (beginning-of-line))
-	  (setq beg (point))
-	  (forward-sexp 1)
-	  (setq end (point))
-	  (goto-char beg)
-	  (forward-line 1)
-	  (setq beg (point)))
-	(if (> end beg)
-	    (indent-code-rigidly beg end shift-amt "#")))
-    (if (and (not c-tab-always-indent)
-	     (save-excursion
-	       (skip-chars-backward " \t")
-	       (not (bolp))))
-	(insert-tab)
-      (c++-indent-line))))
-
-(defun c++-indent-line ()
-  "Indent current line as C++ code.
-Return the amount the indentation changed by."
-  (let ((indent (calculate-c++-indent nil))
-	beg shift-amt
-	(case-fold-search nil)
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((eq indent nil)
-	   (setq indent (current-indentation)))
-	  ((eq indent t)
-	   (setq indent (calculate-c-indent-within-comment)))
-	  ((looking-at "[ \t]*#")
-	   (setq indent 0))
-	  (t
-	   (skip-chars-forward " \t")
-	   (if (listp indent) (setq indent (car indent)))
-	   (cond ((looking-at "\\(default\\|public\\|private\\|protected\\):")
-		  (setq indent (+ indent c-label-offset)))
-		 ((or (looking-at "case\\b")
-		      (and (looking-at "[A-Za-z]")
-			   (save-excursion
-			     (forward-sexp 1)
-			     (looking-at ":[^:]"))))
-		  (setq indent (max 1 (+ indent c-label-offset))))
-		 ((and (looking-at "else\\b")
-		       (not (looking-at "else\\s_")))
-		  (setq indent (save-excursion
-				 (c-backward-to-start-of-if)
-				 (current-indentation))))
-		 ((looking-at "friend\[ \t]")
-		  (setq indent (+ indent c++-friend-offset)))
-		 ((= (following-char) ?})
-		  (setq indent (- indent c-indent-level)))
-		 ((= (following-char) ?{)
-		  (setq indent (+ indent c-brace-offset))))))
-    (skip-chars-forward " \t")
-    (setq shift-amt (- indent (current-column)))
-    (if (zerop shift-amt)
-	(if (> (- (point-max) pos) (point))
-	    (goto-char (- (point-max) pos)))
-      (delete-region beg (point))
-      (indent-to indent)
-      ;; If initial point was within line's indentation,
-      ;; position after the indentation.  Else stay at same point in text.
-      (if (> (- (point-max) pos) (point))
-	  (goto-char (- (point-max) pos))))
-    shift-amt))
-
-(defun calculate-c++-indent (&optional parse-start)
-  "Return appropriate indentation for current line as C++ code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment."
-  (save-excursion
-    (beginning-of-line)
-    (let ((indent-point (point))
-	  (case-fold-search nil)
-	  state
-	  containing-sexp)
-      (if parse-start
-	  (goto-char parse-start)
-	(beginning-of-defun))
-      (while (< (point) indent-point)
-	(setq parse-start (point))
-	(setq state (parse-partial-sexp (point) indent-point 0))
-	(setq containing-sexp (car (cdr state))))
-      (cond ((or (nth 3 state) (nth 4 state))
-	     ;; return nil or t if should not change this line
-	     (nth 4 state))
-	    ((null containing-sexp)
-	     ;; Line is at top level.  May be data or function definition, or
-	     ;; may be function argument declaration or member initialization.
-	     ;; Indent like the previous top level line unless
-	     ;; (1) the previous line ends in a closeparen without semicolon,
-	     ;; in which case this line is the first argument declaration or
-	     ;; member initialization, or
-	     ;; (2) the previous line begins with a colon,
-	     ;; in which case this is the second line of member inits.
-	     ;; It is assumed that arg decls and member inits are not mixed.
-	     (goto-char indent-point)
-	     (skip-chars-forward " \t")
-	     (if (= (following-char) ?{)
-		 0   ; Unless it starts a function body
-	       (c++-backward-to-noncomment (or parse-start (point-min)))
-	       (if (= (preceding-char) ?\))
-		   (progn		; first arg decl or member init
-		     (goto-char indent-point)
-		     (skip-chars-forward " \t")
-		     (if (= (following-char) ?:)
-			 c++-member-init-indent
-		       c-argdecl-indent))
-		 (if (= (preceding-char) ?\;)
-		     (backward-char 1))
-		 (if (= (preceding-char) ?})
-		     0
-		   (if (= (preceding-char) ?\))
-		       (forward-list -1))
-		   (beginning-of-line)	; continued arg decls or member inits
-		   (skip-chars-forward " \t")
-		   (if (= (following-char) ?:)
-		       (if c++-continued-member-init-offset
-			   (+ (current-indentation)
-			      c++-continued-member-init-offset)
-			 (progn
-			   (forward-char 1)
-			   (skip-chars-forward " \t")
-			   (current-column)))
-		     (current-indentation)))
-		 )))
-	    ((/= (char-after containing-sexp) ?{)
-	     ;; line is expression, not statement:
-	     ;; indent to just after the surrounding open -- unless
-	     ;; empty arg list, in which case we do what
-	     ;; c++-empty-arglist-indent says to do.
-	     (if (and c++-empty-arglist-indent
-		      (or (null (nth 2 state))	;; indicates empty arg
-						;; list.
-			  ;; Use a heuristic: if the first
-			  ;; non-whitespace following left paren on
-			  ;; same line is not a comment,
-			  ;; is not an empty arglist.
-			  (save-excursion
-			    (goto-char (1+ containing-sexp))
-			    (not
-			     (looking-at "\\( \\|\t\\)*[^/\n]")))))
-		 (progn
-		   (goto-char containing-sexp)
-		   (beginning-of-line)
-		   (skip-chars-forward " \t")
-		   (goto-char (min (+ (point) c++-empty-arglist-indent)
-				   (1+ containing-sexp)))
-		   (current-column))
-	       ;; In C-mode, we would always indent to one after the
-	       ;; left paren.  Here, though, we may have an
-	       ;; empty-arglist, so we'll indent to the min of that
-	       ;; and the beginning of the first argument.
-	       (goto-char (1+ containing-sexp))
-	       (current-column)))
-	    (t
-	     ;; Statement.  Find previous non-comment character.
-	     (goto-char indent-point)
-	     (c++-backward-to-noncomment containing-sexp)
-	     (if (and (not (memq (preceding-char) '(0 ?\, ?\; ?\} ?\{)))
-		      ;; But don't treat a line with a close-brace
-		      ;; as a continuation.  It is probably the
-		      ;; end of an enum type declaration.
-		      (save-excursion
-			(goto-char indent-point)
-			(skip-chars-forward " \t")
-			(not (= (following-char) ?}))))
-		 ;; This line is continuation of preceding line's statement;
-		 ;; indent  c-continued-statement-offset  more than the
-		 ;; previous line of the statement.
-		 (progn
-		   (c-backward-to-start-of-continued-exp containing-sexp)
-		   (+ c-continued-statement-offset (current-column)
-                      (if (save-excursion (goto-char indent-point)
-					  (skip-chars-forward " \t")
-					  (eq (following-char) ?{))
-			  c-continued-brace-offset 0)))
-	       ;; This line starts a new statement.
-	       ;; Position following last unclosed open.
-	       (goto-char containing-sexp)
-	       ;; Is line first statement after an open-brace?
-	       (or
-		 ;; If no, find that first statement and indent like it.
-		 (save-excursion
-		   (forward-char 1)
-		   (let ((colon-line-end 0))
-		     (while (progn (skip-chars-forward " \t\n")
-				   (looking-at
-				    (concat
-				     "#\\|/\\*\\|//"
-				     "\\|case[ \t]"
-				     "\\|[a-zA-Z0-9_$]*:[^:]"
-				     "\\|friend[ \t]")))
-		       ;; Skip over comments and labels following openbrace.
-		       (cond ((= (following-char) ?\#)
-			      (forward-line 1))
-			     ((looking-at "/\\*")
-			      (search-forward "*/" nil 'move))
-			     ((looking-at "//\\|friend[ \t]")
-			      (forward-line 1))
-			     (t
-			      (save-excursion (end-of-line)
-					      (setq colon-line-end (point)))
-			      (search-forward ":"))))
-		     ;; The first following code counts
-		     ;; if it is before the line we want to indent.
-		     (and (< (point) indent-point)
-			  (- 
-			   (if (> colon-line-end (point))
-			       (- (current-indentation) c-label-offset)
-			     (current-column))
-			   ;; If prev stmt starts with open-brace, that
-			   ;; open brace was offset by c-brace-offset.
-			   ;; Compensate to get the column where
-			   ;; an ordinary statement would start.
-			   (if (= (following-char) ?\{) c-brace-offset 0)))))
-		 ;; If no previous statement,
-		 ;; indent it relative to line brace is on.
-		 ;; For open brace in column zero, don't let statement
-		 ;; start there too.  If c-indent-offset is zero,
-		 ;; use c-brace-offset + c-continued-statement-offset instead.
-		 ;; For open-braces not the first thing in a line,
-		 ;; add in c-brace-imaginary-offset.
-		 (+ (if (and (bolp) (zerop c-indent-level))
-			(+ c-brace-offset c-continued-statement-offset)
-		      c-indent-level)
-		    ;; Move back over whitespace before the openbrace.
-		    ;; If openbrace is not first nonwhite thing on the line,
-		    ;; add the c-brace-imaginary-offset.
-		    (progn (skip-chars-backward " \t")
-			   (if (bolp) 0 c-brace-imaginary-offset))
-		    ;; If the openbrace is preceded by a parenthesized exp,
-		    ;; move to the beginning of that;
-		    ;; possibly a different line
-		    (progn
-		      (if (eq (preceding-char) ?\))
-			  (forward-sexp -1))
-		      ;; Get initial indentation of the line we are on.
-		      (current-indentation))))))))))
-
-(defun c++-backward-to-noncomment (lim)
-  (let (opoint stop)
-    (while (not stop)
-      (skip-chars-backward " \t\n\r\f" lim)
-      (setq opoint (point))
-      (cond ((and (>= (point) (+ 2 lim))
-		  (save-excursion
-		    (forward-char -2)
-		    (looking-at "\\*/")))
-	     (search-backward "/*" lim 'move))
-	    ((and
-	      (search-backward "//" (max (c++-point-bol) lim) 'move)
-	      (not (c++-within-string-p (point) opoint))))
-	    ;; No comment to be found.
-	    ;; If there's a # command on this line,
-	    ;; move back to it.
-	    (t (beginning-of-line)
-	       (skip-chars-forward " \t")
-	       ;; But don't get fooled if we are already before the #.
-	       (if (and (looking-at "#") (< (point) opoint))
-		   (setq stop (<= (point) lim))
-		 (setq stop t)
-		 (goto-char opoint)))))))
-
-(defun indent-c++-exp ()
-  "Indent each line of the C++ grouping following point."
-  (interactive)
-  (let ((indent-stack (list nil))
-	(contain-stack (list (point)))
-	(case-fold-search nil)
-	restart outer-loop-done inner-loop-done state ostate
-	this-indent last-sexp last-depth
-	at-else at-brace
-	(opoint (point))
-	(next-depth 0))
-    (save-excursion
-      (forward-sexp 1))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (and (not (eobp)) (not outer-loop-done))
-	(setq last-depth next-depth)
-	;; Compute how depth changes over this line
-	;; plus enough other lines to get to one that
-	;; does not end inside a comment or string.
-	;; Meanwhile, do appropriate indentation on comment lines.
-	(setq inner-loop-done nil)
-	(while (and (not inner-loop-done)
-		    (not (and (eobp) (setq outer-loop-done t))))
-	  (setq ostate state)
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  (if (and (car (cdr (cdr state)))
-		   (>= (car (cdr (cdr state))) 0))
-	      (setq last-sexp (car (cdr (cdr state)))))
-	  (if (or (nth 4 ostate))
-	      (c++-indent-line))
-	  (if (or (nth 3 state))
-	      (forward-line 1)
-	    (setq inner-loop-done t)))
-	(if (<= next-depth 0)
-	    (setq outer-loop-done t))
-	(if outer-loop-done
-	    nil
-	  ;; If this line had ..))) (((.. in it, pop out of the levels
-	  ;; that ended anywhere in this line, even if the final depth
-	  ;; doesn't indicate that they ended.
-	  (while (> last-depth (nth 6 state))
-	    (setq indent-stack (cdr indent-stack)
-		  contain-stack (cdr contain-stack)
-		  last-depth (1- last-depth)))
-	  (if (/= last-depth next-depth)
-	      (setq last-sexp nil))
-	  ;; Add levels for any parens that were started in this line.
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  contain-stack (cons nil contain-stack)
-		  last-depth (1+ last-depth)))
-	  (if (null (car contain-stack))
-	      (setcar contain-stack (or (car (cdr state))
-					(save-excursion (forward-sexp -1)
-							(point)))))
-	  (forward-line 1)
-	  (skip-chars-forward " \t")
-	  (if (eolp)
-	      nil
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		;; Line is on an existing nesting level.
-		;; Lines inside parens are handled specially.
-		nil
-	      ;; Just started a new nesting level.
-	      ;; Compute the standard indent for this level.
-	      (let (val)
-		(if (= (char-after (car contain-stack)) ?{)
-		    (save-excursion
-		      (goto-char (car contain-stack))
-		      (setq val (calculate-c-indent-after-brace)))
-		  (setq val (calculate-c++-indent
-			     (if (car indent-stack)
-				 (- (car indent-stack))))))
-		(setcar indent-stack val)))
-	    ;; Adjust line indentation according to its predecessor.
-	    (if (/= (char-after (car contain-stack)) ?\{)
-		(setq this-indent (car indent-stack))
-	      ;; Line is at statement level.
-	      ;; Is it a new statement?  Is it an else?
-	      ;; Find last non-comment character before this line
-	      (save-excursion
-		(setq at-else (looking-at "else\\W"))
-		(setq at-brace (= (following-char) ?\{))
-		(c++-backward-to-noncomment opoint)
-		(if (not (memq (preceding-char) '(nil ?\, ?\; ?\} ?: ?\{)))
-		    ;; Preceding line did not end in comma or semi;
-		    ;; indent this line  c-continued-statement-offset
-		    ;; more than previous.
-		    (progn
-		      (c-backward-to-start-of-continued-exp
-		       (car contain-stack))
-		      (setq this-indent
-			    (+ c-continued-statement-offset
-			       (current-column)
-			       (if at-brace c-continued-brace-offset 0))))
-		  ;; Preceding line ended in comma or semi;
-		  ;; use the standard indent for this level.
-		  (if at-else
-		      (progn (c-backward-to-start-of-if opoint)
-			     (setq this-indent (current-indentation)))
-		    (setq this-indent (car indent-stack))))))
-	    ;; Adjust line indentation according to its contents
-	    (if (looking-at "\\(public\\|private\\|protected\\):")
-		(setq this-indent (- this-indent c-indent-level))
-	      (if (or (looking-at "case[ \t]")
-		      (and (looking-at "[A-Za-z]")
-			   (save-excursion
-			     (forward-sexp 1)
-			     (looking-at ":[^:]"))))
-		  (setq this-indent (max 1 (+ this-indent c-label-offset)))))
-	    (if (looking-at "friend[ \t]")
-		(setq this-indent (+ this-indent c++-friend-offset)))
-	    (if (= (following-char) ?\})
-		(setq this-indent (- this-indent c-indent-level)))
-	    (if (= (following-char) ?\{)
-		(setq this-indent (+ this-indent c-brace-offset)))
-	    ;; Put chosen indentation into effect.
-	    (or (= (current-column) this-indent)
-		(= (following-char) ?\#)
-		(progn
-		  (delete-region (point) (progn (beginning-of-line) (point)))
-		  (indent-to this-indent)))
-	    ;; Indent any comment following the text.
-	    (or (looking-at comment-start-skip)
-		(if (re-search-forward comment-start-skip
-				       (save-excursion (end-of-line)
-						       (point)) t)
-		    (progn
-		      (indent-for-comment)
-		      (beginning-of-line))))))))))
-
-(defun fill-c++-comment ()
-  "Fill a comment contained in consecutive lines containing point.
-The fill lines remain a comment."
-  (interactive)
-  (save-excursion
-    (let ((save fill-prefix))
-      (beginning-of-line 1)
-      (save-excursion
-	(re-search-forward comment-start-skip
-			   (save-excursion (end-of-line) (point))
-			   t)
-	(goto-char (match-end 0))
-	(set-fill-prefix))
-      (while (looking-at fill-prefix)
-	(previous-line 1))
-      (next-line 1)
-      (insert-string "\n")
-      (fill-paragraph nil)
-      (delete-char -1)
-      (setq fill-prefix save))))
-
-(defun c++-point-bol ()
-  "Returns the value of the point at the beginning of the current line."
-  (save-excursion
-    (beginning-of-line)
-    (point)))
-
-;; (defun c++-insert-header ()
-;;   "Insert header denoting C++ code at top of buffer."
-;;   (interactive)
-;;   (save-excursion
-;;     (goto-char (point-min))
-;;     (insert "// "
-;; 	    "This may look like C code, but it is really "
-;; 	    "-*- C++ -*-"
-;; 	    "\n\n")))
-
-(defun c++-within-string-p (point1 point2)
-  "Returns true if number of double quotes between two points is odd."
-  (let ((s (buffer-substring point1 point2)))
-    (not (zerop (% (c++-count-char-in-string ?\" s) 2)))))
-
-(defun c++-count-char-in-string (c s)
-  (let ((count 0)
-	(pos 0))
-    (while (< pos (length s))
-      (setq count (+ count (if (\= (aref s pos) c) 1 0)))
-      (setq pos (1+ pos)))
-    count))
-
-;; rms: This page is creeping featurism, and not worth having.
-
-;;; Below are two regular expressions that attempt to match defuns
-;;; "strongly" and "weakly."  The strong one almost reconstructs the
-;;; grammar of C++; the weak one just figures anything id or curly on
-;;; the left begins a defun.  The constant "c++-match-header-strongly"
-;;; determines which to use; the default is the weak one.
-
-;; (defvar c++-match-header-strongly nil
-;;   "*If nil, use `c++-defun-header-weak' to identify beginning of definitions.
-;; If non-nil, use `c++-defun-header-strong'.")
-;; 
-;; (defvar c++-defun-header-strong-struct-equivs "\\(class\\|struct\\|enum\\)"
-;;   "Regexp to match names of structure declaration blocks in C++.")
-;; 
-;; (defconst c++-defun-header-strong
-;;   (let*
-;;       (; valid identifiers
-;;        ;; There's a real weirdness here -- if I switch the below
-;;        (id "\\(\\w\\|_\\)+")
-;;        ;; to be
-;;        ;; (id "\\(_\\|\\w\\)+")
-;;        ;; things no longer work right.  Try it and see!
-;; 
-;;        ; overloadable operators
-;;        (op-sym1
-;; 	 "[-+*/%^&|~!=<>]\\|[-+*/%^&|<>=!]=\\|<<=?\\|>>=?")
-;;        (op-sym2
-;; 	 "&&\\|||\\|\\+\\+\\|--\\|()\\|\\[\\]")	 
-;;        (op-sym (concat "\\(" op-sym1 "\\|" op-sym2 "\\)"))
-;;        ; whitespace
-;;        (middle "[^\\*]*\\(\\*+[^/\\*][^\\*]*\\)*")
-;;        (c-comment (concat "/\\*" middle "\\*+/"))
-;;        (wh (concat "\\(\\s \\|\n\\|//.*$\\|" c-comment "\\)"))
-;;        (wh-opt (concat wh "*"))
-;;        (wh-nec (concat wh "+"))
-;;        (oper (concat "\\(" "operator" "\\("
-;; 		     wh-opt op-sym "\\|" wh-nec id "\\)" "\\)"))
-;;        (dcl-list "([^():]*)")
-;;        (func-name (concat "\\(" oper "\\|" id "::" id "\\|" id "\\)"))
-;;        (inits
-;; 	 (concat "\\(:"
-;; 		 "\\(" wh-opt id "(.*\\()" wh-opt "," "\\)\\)*"
-;; 		 wh-opt id "(.*)" wh-opt "{"
-;; 		 "\\|" wh-opt "{\\)"))
-;;        (type-name (concat
-;; 		    "\\(" c++-defun-header-strong-struct-equivs wh-nec "\\)?"
-;; 		    id))
-;;        (type (concat "\\(const" wh-nec "\\)?"
-;; 		     "\\(" type-name "\\|" type-name wh-opt "\\*+" "\\|"
-;; 		     type-name wh-opt "&" "\\)"))
-;;        (modifier "\\(inline\\|virtual\\|overload\\|auto\\|static\\)")
-;;        (modifiers (concat "\\(" modifier wh-nec "\\)*"))
-;;        (func-header
-;; 	 ;;     type               arg-dcl
-;; 	 (concat modifiers type wh-nec func-name wh-opt dcl-list wh-opt inits))
-;;        (inherit (concat "\\(:" wh-opt "\\(public\\|private\\)?"
-;; 			wh-nec id "\\)"))
-;;        (cs-header (concat
-;; 		    c++-defun-header-strong-struct-equivs
-;; 		    wh-nec id wh-opt inherit "?" wh-opt "{")))
-;;     (concat "^\\(" func-header "\\|" cs-header "\\)"))
-;;   "Strongly-defined regexp to match beginning of structure or function def.")
-;; 
-;; 
-;; ;; This part has to do with recognizing defuns.
-;; 
-;; ;; The weak convention we will use is that a defun begins any time
-;; ;; there is a left curly brace, or some identifier on the left margin,
-;; ;; followed by a left curly somewhere on the line.  (This will also
-;; ;; incorrectly match some continued strings, but this is after all
-;; ;; just a weak heuristic.)  Suggestions for improvement (short of the
-;; ;; strong scheme shown above) are welcomed.
-;; 
-;; (defconst c++-defun-header-weak "^{\\|^[_a-zA-Z].*{"
-;;   "Weakly-defined regexp to match beginning of structure or function def.")
-;; 
-;; (defun c++-beginning-of-defun (arg)
-;;   (interactive "p")
-;;   (let ((c++-defun-header (if c++-match-header-strongly
-;; 			      c++-defun-header-strong
-;; 			    c++-defun-header-weak)))
-;;     (cond ((or (= arg 0) (and (> arg 0) (bobp))) nil)
-;; 	  ((and (not (looking-at c++-defun-header))
-;; 		(let ((curr-pos (point))
-;; 		      (open-pos (if (search-forward "{" nil 'move)
-;; 				    (point)))
-;; 		      (beg-pos
-;; 			(if (re-search-backward c++-defun-header nil 'move)
-;; 			    (match-beginning 0))))
-;; 		  (if (and open-pos beg-pos
-;; 			   (< beg-pos curr-pos)
-;; 			   (> open-pos curr-pos))
-;; 		      (progn
-;; 			(goto-char beg-pos)
-;; 			(if (= arg 1) t nil));; Are we done?
-;; 		    (goto-char curr-pos)
-;; 		    nil))))
-;; 	  (t
-;; 	    (if (and (looking-at c++-defun-header) (not (bobp)))
-;; 		(forward-char (if (< arg 0) 1 -1)))
-;; 	    (and (re-search-backward c++-defun-header nil 'move (or arg 1))
-;; 		 (goto-char (match-beginning 0)))))))
-;; 
-;; 
-;; (defun c++-end-of-defun (arg)
-;;   (interactive "p")
-;;   (let ((c++-defun-header (if c++-match-header-strongly
-;; 			      c++-defun-header-strong
-;; 			    c++-defun-header-weak)))
-;;     (if (and (eobp) (> arg 0))
-;; 	nil
-;;       (if (and (> arg 0) (looking-at c++-defun-header)) (forward-char 1))
-;;       (let ((pos (point)))
-;; 	(c++-beginning-of-defun 
-;; 	  (if (< arg 0)
-;; 	      (- (- arg (if (eobp) 0 1)))
-;; 	    arg))
-;; 	(if (and (< arg 0) (bobp))
-;; 	    t
-;; 	  (if (re-search-forward c++-defun-header nil 'move)
-;; 	      (progn (forward-char -1)
-;; 		     (forward-sexp)
-;; 		     (beginning-of-line 2)))
-;; 	  (if (and (= pos (point)) 
-;; 		   (re-search-forward c++-defun-header nil 'move))
-;; 	      (c++-end-of-defun 1))))
-;;       t)))
-;; 
-;; (defun c++-indent-defun ()
-;;   "Indents the current function definition, struct or class declaration."
-;;   (interactive)
-;;   (let ((restore (point)))
-;;     (c++-end-of-defun 1)
-;;     (beginning-of-line 1)
-;;     (let ((end (point)))
-;;       (c++-beginning-of-defun 1)
-;;       (while (<= (point) end)
-;; 	(c++-indent-line)
-;; 	(next-line 1)
-;; 	(beginning-of-line 1)))
-;;     (goto-char restore)))
-
-;;; cplus-md.el ends here
diff --git a/lisp/progmodes/cpp.el b/lisp/progmodes/cpp.el
deleted file mode 100644
index fa0ed911e2e..00000000000
--- a/lisp/progmodes/cpp.el
+++ /dev/null
@@ -1,782 +0,0 @@
-;;; cpp.el --- Highlight or hide text according to cpp conditionals.
-
-;; Copyright (C) 1994, 1995 Free Software Foundation
-
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Keywords: c, faces, 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:
-
-;; Parse a text for C preprocessor conditionals, and highlight or hide
-;; the text inside the conditionals as you wish.
-
-;; This package is inspired by Jim Coplien's delta editor for SCCS.
-
-;;; Todo:
-
-;; Should parse "#if" and "#elif" expressions and merge the faces
-;; somehow. 
-
-;; Somehow it is sometimes possible to make changes near a read only
-;; area which you can't undo.  Their are other strange effects in that
-;; area.
-
-;; The Edit buffer should -- optionally -- appear in its own frame.
-
-;; Conditionals seem to be rear-sticky.  They shouldn't be.
-
-;; Restore window configurations when exiting CPP Edit buffer.
-
-;;; Code:
-
-;;; Customization:
-
-(defvar cpp-config-file (convert-standard-filename ".cpp.el")
-  "*File name to save cpp configuration.")
-
-(defvar cpp-known-face 'invisible
-  "*Face used for known cpp symbols.")
-
-(defvar cpp-unknown-face 'highlight
-  "*Face used for unknown cpp symbols.")
-
-(defvar cpp-face-type 'light 
-  "*Indicate what background face type you prefer.
-Can be either light or dark for color screens, mono for monochrome
-screens, and none if you don't use a window system.")
-
-(defvar cpp-known-writable t
-  "*Non-nil means you are allowed to modify the known conditionals.")
-
-(defvar cpp-unknown-writable t
-  "*Non-nil means you are allowed to modify the unknown conditionals.")
-
-(defvar cpp-edit-list nil
-  "Alist of cpp macros and information about how they should be displayed.
-Each entry is a list with the following elements:
-0. The name of the macro (a string).
-1. Face used for text that is `ifdef' the macro.
-2. Face used for text that is `ifndef' the macro.
-3. `t', `nil', or `both' depending on what text may be edited.")
-
-(defvar cpp-overlay-list nil)
-;; List of cpp overlays active in the current buffer.
-(make-variable-buffer-local 'cpp-overlay-list)
-
-(defvar cpp-callback-data)
-(defvar cpp-state-stack)
-
-(defconst cpp-face-type-list
-  '(("light color background" . light)
-    ("dark color background" . dark)
-    ("monochrome" . mono)
-    ("tty" . none))
-  "Alist of strings and names of the defined face collections.")
-
-(defconst cpp-writable-list
-  ;; Names used for the writable property.
-  '(("writable" . t)
-    ("read-only" . nil)))
-
-(defvar cpp-button-event nil)
-;; This will be t in the callback for `cpp-make-button'.
-
-(defvar cpp-edit-buffer nil)
-;; Real buffer whose cpp display information we are editing.
-(make-variable-buffer-local 'cpp-edit-buffer)
-
-(defconst cpp-branch-list
-  ;; Alist of branches.
-  '(("false" . nil)
-    ("true" . t)
-    ("both" . both)))
-
-(defvar cpp-face-default-list nil
-  "List of faces you can choose from for cpp conditionals.")
-
-(defvar cpp-face-light-name-list
-  '("light gray" "light blue" "light cyan" "light yellow" "light pink"
-    "pale green" "beige" "orange" "magenta" "violet" "medium purple"
-    "turquoise")
-  "Background colours useful with dark foreground colors.")
-
-(defvar cpp-face-dark-name-list
-  '("dim gray" "blue" "cyan" "yellow" "red"
-    "dark green" "brown" "dark orange" "dark khaki" "dark violet" "purple"
-    "dark turquoise")
-  "Background colours useful with light foreground colors.")
-
-(defvar cpp-face-light-list nil
-  "Alist of names and faces to be used for light backgrounds.")
-
-(defvar cpp-face-dark-list nil
-  "Alist of names and faces to be used for dark backgrounds.")
-
-(defvar cpp-face-mono-list
-  '(("bold" . 'bold)
-    ("bold-italic" . 'bold-italic)
-    ("italic" . 'italic)
-    ("underline" . 'underline))
-  "Alist of names and faces to be used for monochrome screens.")
-
-(defvar cpp-face-none-list
-   '(("default" . default)
-     ("invisible" . invisible))
-   "Alist of names and faces available even if you don't use a window system.")
-
-(defvar cpp-face-all-list
-  (append cpp-face-light-list
-	  cpp-face-dark-list
-	  cpp-face-mono-list
-	  cpp-face-none-list)
-  "All faces used for highlighting text inside cpp conditionals.")
-
-;;; Parse Buffer:
-
-(defvar cpp-parse-symbols nil
-  "List of cpp macros used in the local buffer.")
-(make-variable-buffer-local 'cpp-parse-symbols)
-
-(defconst cpp-parse-regexp
-  ;; Regexp matching all tokens needed to find conditionals.
-  (concat
-   "'\\|\"\\|/\\*\\|//\\|"
-   "\\(^[ \t]*#[ \t]*\\(ifdef\\|ifndef\\|if\\|"
-   "elif\\|else\\|endif\\)\\b\\)"))
-
-;;;###autoload
-(defun cpp-highlight-buffer (arg)
-  "Highlight C code according to preprocessor conditionals.
-This command pops up a buffer which you should edit to specify
-what kind of highlighting to use, and the criteria for highlighting.
-A prefix arg suppresses display of that buffer."
-  (interactive "P")
-  (setq cpp-parse-symbols nil)
-  (cpp-parse-reset)
-  (if (null cpp-edit-list)
-      (cpp-edit-load))
-  (let (cpp-state-stack)
-    (save-excursion
-      (goto-char (point-min))
-      (cpp-progress-message "Parsing...")
-      (while (re-search-forward cpp-parse-regexp nil t)
-	(cpp-progress-message "Parsing...%d%%"
-			  (/ (* 100 (- (point) (point-min))) (buffer-size)))
-	(let ((match (buffer-substring (match-beginning 0) (match-end 0))))
-	  (cond ((or (string-equal match "'")
-		     (string-equal match "\""))
-		 (goto-char (match-beginning 0))
-		 (condition-case nil
-		     (forward-sexp)
-		   (error (cpp-parse-error
-			   "Unterminated string or character"))))
-		((string-equal match "/*")
-		 (or (search-forward "*/" nil t)
-		     (error "Unterminated comment")))
-		((string-equal match "//")
-		 (skip-chars-forward "^\n\r"))
-		(t
-		 (end-of-line 1)
-		 (let ((from (match-beginning 1))
-		       (to (1+ (point)))
-		       (type (buffer-substring (match-beginning 2)
-					       (match-end 2)))
-		       (expr (buffer-substring (match-end 1) (point))))
-		   (cond ((string-equal type "ifdef")
-			  (cpp-parse-open t expr from to))
-			 ((string-equal type "ifndef")
-			  (cpp-parse-open nil expr from to))
-			 ((string-equal type "if")
-			  (cpp-parse-open t expr from to))
-			 ((string-equal type "elif")
-			  (let (cpp-known-face cpp-unknown-face)
-			    (cpp-parse-close from to))
-			  (cpp-parse-open t expr from to))
-			 ((string-equal type "else")
-			  (or cpp-state-stack
-			      (cpp-parse-error "Top level #else"))
-			  (let ((entry (list (not (nth 0 (car cpp-state-stack)))
-					     (nth 1 (car cpp-state-stack))
-					     from to)))
-			    (cpp-parse-close from to)
-			    (setq cpp-state-stack (cons entry cpp-state-stack))))
-			 ((string-equal type "endif")
-			  (cpp-parse-close from to))
-			 (t
-			  (cpp-parse-error "Parser error"))))))))
-      (message "Parsing...done"))
-    (if cpp-state-stack
-      (save-excursion
-	(goto-char (nth 3 (car cpp-state-stack)))
-	(cpp-parse-error "Unclosed conditional"))))
-  (or arg
-      (null cpp-parse-symbols)
-      (cpp-parse-edit)))
-
-(defun cpp-parse-open (branch expr begin end)
-  "Push information about conditional-beginning onto `cpp-state-stack'."
-  ;; Discard comments within this line.
-  (while (string-match "\\b[ \t]*/\\*.*\\*/[ \t]*\\b" expr)
-    (setq expr (concat (substring expr 0 (match-beginning 0))
-		       (substring expr (match-end 0)))))
-  ;; If a comment starts on this line and continues past, discard it.
-  (if (string-match "\\b[ \t]*/\\*" expr)
-      (setq expr (substring expr 0 (match-beginning 0))))
-  ;; Delete any C++ comment from the line.
-  (if (string-match "\\b[ \t]*\\(//.*\\)?$" expr)
-      (setq expr (substring expr 0 (match-beginning 0))))
-  (while (string-match "[ \t]+" expr)
-      (setq expr (concat (substring expr 0 (match-beginning 0))
-			 (substring expr (match-end 0)))))
-  (setq cpp-state-stack (cons (list branch expr begin end) cpp-state-stack))
-  (or (member expr cpp-parse-symbols)
-      (setq cpp-parse-symbols
-	    (cons expr cpp-parse-symbols)))
-  (if (assoc expr cpp-edit-list)
-      (cpp-make-known-overlay begin end)
-    (cpp-make-unknown-overlay begin end)))
-
-(defun cpp-parse-close (from to)
-  ;; Pop top of cpp-state-stack and create overlay.
-  (let ((entry (assoc (nth 1 (car cpp-state-stack)) cpp-edit-list))
-	(branch (nth 0 (car cpp-state-stack)))
-	(begin (nth 2 (car cpp-state-stack)))
-	(end (nth 3 (car cpp-state-stack))))
-    (setq cpp-state-stack (cdr cpp-state-stack))
-    (if entry
-	(let ((face (nth (if branch 1 2) entry))
-	      (read-only (eq (not branch) (nth 3 entry)))
-	      (priority (length cpp-state-stack))
-	      (overlay (make-overlay end from)))
-	  (cpp-make-known-overlay from to)
-	  (setq cpp-overlay-list (cons overlay cpp-overlay-list))
-	  (if priority (overlay-put overlay 'priority priority))
-	  (cond ((eq face 'invisible)
-		 (cpp-make-overlay-hidden overlay))
-		((eq face 'default))
-		(t
-		 (overlay-put overlay 'face face)))
-	  (if read-only
-	      (cpp-make-overlay-read-only overlay)
-	    (cpp-make-overlay-sticky overlay)))
-      (cpp-make-unknown-overlay from to))))
-
-(defun cpp-parse-error (error)
-  ;; Error message issued by the cpp parser.
-  (error "%s at line %d" error (count-lines (point-min) (point))))
-
-(defun cpp-parse-reset ()
-  "Reset display of cpp conditionals to normal."
-  (interactive)
-  (while cpp-overlay-list
-    (delete-overlay (car cpp-overlay-list))
-    (setq cpp-overlay-list (cdr cpp-overlay-list))))
-
-;;;###autoload
-(defun cpp-parse-edit ()
-  "Edit display information for cpp conditionals."
-  (interactive)
-  (or cpp-parse-symbols
-      (cpp-highlight-buffer t))
-  (let ((buffer (current-buffer)))
-    (pop-to-buffer "*CPP Edit*")
-    (cpp-edit-mode)
-    (setq cpp-edit-buffer buffer)
-    (cpp-edit-reset)))
-
-;;; Overlays:
-
-(defun cpp-make-known-overlay (start end)
-  ;; Create an overlay for a known cpp command from START to END.
-  (let ((overlay (make-overlay start end)))
-    (if (eq cpp-known-face 'invisible)
-	(cpp-make-overlay-hidden overlay)
-      (or (eq cpp-known-face 'default)
-	  (overlay-put overlay 'face cpp-known-face))
-      (if cpp-known-writable
-	  ()
-	(overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
-	(overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only))))
-    (setq cpp-overlay-list (cons overlay cpp-overlay-list))))
-
-(defun cpp-make-unknown-overlay (start end)
-  ;; Create an overlay for an unknown cpp command from START to END.
-  (let ((overlay (make-overlay start end)))
-    (cond ((eq cpp-unknown-face 'invisible)
-	   (cpp-make-overlay-hidden overlay))
-	  ((eq cpp-unknown-face 'default))
-	  (t 
-	   (overlay-put overlay 'face cpp-unknown-face)))
-    (if cpp-unknown-writable
-	()
-      (overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
-      (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only)))
-    (setq cpp-overlay-list (cons overlay cpp-overlay-list))))
-
-(defun cpp-make-overlay-hidden (overlay)
-  ;; Make overlay hidden and intangible.
-  (overlay-put overlay 'invisible t)
-  (overlay-put overlay 'intangible t)
-  ;; Unfortunately `intangible' is not implemented for overlays yet,
-  ;; so we make is read-only instead.
-  (overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
-  (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only)))
-
-(defun cpp-make-overlay-read-only (overlay)
-  ;; Make overlay read only.
-  (overlay-put overlay 'modification-hooks '(cpp-signal-read-only))
-  (overlay-put overlay 'insert-in-front-hooks '(cpp-signal-read-only))
-  (overlay-put overlay 'insert-behind-hooks '(cpp-signal-read-only)))
-
-(defun cpp-make-overlay-sticky (overlay)
-  ;; Make OVERLAY grow when you insert text at either end.
-  (overlay-put overlay 'insert-in-front-hooks '(cpp-grow-overlay))
-  (overlay-put overlay 'insert-behind-hooks '(cpp-grow-overlay)))
-
-(defun cpp-signal-read-only (overlay after start end &optional len)
-  ;; Only allow deleting the whole overlay.
-  ;; Trying to change a read-only overlay.
-  (if (and (not after)
-	   (or (< (overlay-start overlay) start)
-	       (> (overlay-end overlay) end)))
-      (error "This text is read only")))
-
-(defun cpp-grow-overlay (overlay after start end &optional len)
-  ;; Make OVERLAY grow to contain range START to END.
-  (if after
-      (move-overlay overlay
-		    (min start (overlay-start overlay))
-		    (max end (overlay-end overlay)))))
-
-;;; Edit Buffer:
-
-(defvar cpp-edit-map nil)
-;; Keymap for `cpp-edit-mode'.
-
-(if cpp-edit-map
-    ()
-  (setq cpp-edit-map (make-keymap))
-  (suppress-keymap cpp-edit-map)
-  (define-key cpp-edit-map [ down-mouse-2 ] 'cpp-push-button)
-  (define-key cpp-edit-map [ mouse-2 ] 'ignore)
-  (define-key cpp-edit-map " " 'scroll-up)
-  (define-key cpp-edit-map "\C-?" 'scroll-down)
-  (define-key cpp-edit-map [ delete ] 'scroll-down)
-  (define-key cpp-edit-map "\C-c\C-c" 'cpp-edit-apply)
-  (define-key cpp-edit-map "a" 'cpp-edit-apply)
-  (define-key cpp-edit-map "A" 'cpp-edit-apply)
-  (define-key cpp-edit-map "r" 'cpp-edit-reset)
-  (define-key cpp-edit-map "R" 'cpp-edit-reset)
-  (define-key cpp-edit-map "s" 'cpp-edit-save)
-  (define-key cpp-edit-map "S" 'cpp-edit-save)
-  (define-key cpp-edit-map "l" 'cpp-edit-load)
-  (define-key cpp-edit-map "L" 'cpp-edit-load)
-  (define-key cpp-edit-map "h" 'cpp-edit-home)
-  (define-key cpp-edit-map "H" 'cpp-edit-home)
-  (define-key cpp-edit-map "b" 'cpp-edit-background)
-  (define-key cpp-edit-map "B" 'cpp-edit-background)
-  (define-key cpp-edit-map "k" 'cpp-edit-known)
-  (define-key cpp-edit-map "K" 'cpp-edit-known)
-  (define-key cpp-edit-map "u" 'cpp-edit-unknown)
-  (define-key cpp-edit-map "u" 'cpp-edit-unknown)
-  (define-key cpp-edit-map "t" 'cpp-edit-true)
-  (define-key cpp-edit-map "T" 'cpp-edit-true)
-  (define-key cpp-edit-map "f" 'cpp-edit-false)
-  (define-key cpp-edit-map "F" 'cpp-edit-false)
-  (define-key cpp-edit-map "w" 'cpp-edit-write)
-  (define-key cpp-edit-map "W" 'cpp-edit-write)
-  (define-key cpp-edit-map "X" 'cpp-edit-toggle-known)
-  (define-key cpp-edit-map "x" 'cpp-edit-toggle-known)
-  (define-key cpp-edit-map "Y" 'cpp-edit-toggle-unknown)
-  (define-key cpp-edit-map "y" 'cpp-edit-toggle-unknown)
-  (define-key cpp-edit-map "q" 'bury-buffer)
-  (define-key cpp-edit-map "Q" 'bury-buffer))
-
-(defvar cpp-edit-symbols nil)
-;; Symbols defined in the edit buffer.
-(make-variable-buffer-local 'cpp-edit-symbols)
-
-(defun cpp-edit-mode ()
-  "Major mode for editing the criteria for highlighting cpp conditionals.
-Click on objects to change them.  
-You can also use the keyboard accelerators indicated like this: [K]ey."
-  (kill-all-local-variables)
-  (buffer-disable-undo)
-  (auto-save-mode -1)
-  (setq buffer-read-only t)
-  (setq major-mode 'cpp-edit-mode)
-  (setq mode-name "CPP Edit")
-  (use-local-map cpp-edit-map))
-
-(defun cpp-edit-apply ()
-  "Apply edited display information to original buffer."
-  (interactive)
-  (cpp-edit-home)
-  (cpp-highlight-buffer t))
-
-(defun cpp-edit-reset ()
-  "Reset display information from original buffer."
-  (interactive)
-  (let ((buffer (current-buffer))
-	(buffer-read-only nil)
-	(start (window-start))
-	(pos (point))
-	symbols)
-    (set-buffer cpp-edit-buffer)
-    (setq symbols cpp-parse-symbols)
-    (set-buffer buffer)
-    (setq cpp-edit-symbols symbols)
-    (erase-buffer)
-    (insert "CPP Display Information for `")
-    (cpp-make-button (buffer-name cpp-edit-buffer) 'cpp-edit-home)
-    (insert "\n\nClick mouse-2 on item you want to change or use\n"
-	    "or switch to this buffer and type the keyboard equivalents.\n"
-	    "Keyboard equivalents are indicated with brackets like [T]his.\n\n")
-    (cpp-make-button "[H]ome (display the C file)" 'cpp-edit-home)
-    (insert "  ")
-    (cpp-make-button "[A]pply new settings" 'cpp-edit-apply)
-    (insert "\n")
-    (cpp-make-button "[S]ave settings" 'cpp-edit-save)
-    (insert "  ")
-    (cpp-make-button "[L]oad settings" 'cpp-edit-load)
-    (insert "\n\n")
-
-    (insert "[B]ackground: ")
-    (cpp-make-button (car (rassq cpp-face-type cpp-face-type-list))
-		     'cpp-edit-background)
-    (insert "\n[K]nown conditionals: ")
-    (cpp-make-button (cpp-face-name cpp-known-face)
-		     'cpp-edit-known nil t)
-    (insert " [X] ")
-    (cpp-make-button (car (rassq cpp-known-writable cpp-writable-list))
-		     'cpp-edit-toggle-known)
-    (insert "\n[U]nknown conditionals: ")
-    (cpp-make-button (cpp-face-name cpp-unknown-face)
-		     'cpp-edit-unknown nil t)
-    (insert " [Y] ")
-    (cpp-make-button (car (rassq cpp-unknown-writable cpp-writable-list))
-		     'cpp-edit-toggle-unknown)
-    (insert (format "\n\n\n%39s: %14s %14s %7s\n\n" "Expression"
-		    "[T]rue Face" "[F]alse Face" "[W]rite"))
-    (while symbols
-      (let*  ((symbol (car symbols))
-	      (entry (assoc symbol cpp-edit-list))
-	      (true (nth 1 entry))
-	      (false (nth 2 entry))
-	      (write (if entry (nth 3 entry) 'both)))
-	(setq symbols (cdr symbols))
-
-	(if (and entry			; Make default entries unknown.
-		 (or (null true) (eq true 'default))
-		 (or (null false) (eq false 'default))
-		 (eq write 'both))
-	    (setq cpp-edit-list (delq entry cpp-edit-list)
-		  entry nil))
-	
-	(if (> (length symbol) 39)
-	    (insert (substring symbol 0 39) ": ")
-	  (insert (format "%39s: " symbol)))
-
-	(cpp-make-button (cpp-face-name true)
-			 'cpp-edit-true symbol t 14)
-	(insert " ")
-	(cpp-make-button (cpp-face-name false)
-			 'cpp-edit-false symbol t 14)
-	(insert " ")
-	(cpp-make-button (car (rassq write cpp-branch-list))
-			 'cpp-edit-write symbol nil 6)
-	(insert "\n")))
-    (insert "\n\n")
-    (set-window-start nil start)
-    (goto-char pos)))
-
-(defun cpp-edit-load ()
-  "Load cpp configuration."
-  (interactive)
-  (cond ((null init-file-user)
-	 ;; If -q was specified, don't load any init files.
-	 nil)
-	((file-readable-p cpp-config-file)
-	 (load-file cpp-config-file))
-	((file-readable-p (concat "~/" cpp-config-file))
-	 (load-file cpp-config-file)))
-  (if (eq major-mode 'cpp-edit-mode)
-      (cpp-edit-reset)))
-
-(defun cpp-edit-save ()
-  "Save the current cpp configuration in a file."
-  (interactive)
-  (require 'pp)
-  (save-excursion
-    (set-buffer cpp-edit-buffer)
-    (let ((buffer (find-file-noselect cpp-config-file)))
-      (set-buffer buffer)
-      (erase-buffer)
-      (pp (list 'setq 'cpp-known-face
-		(list 'quote cpp-known-face)) buffer)
-      (pp (list 'setq 'cpp-unknown-face
-		(list 'quote cpp-unknown-face)) buffer)
-      (pp (list 'setq 'cpp-face-type
-		(list 'quote cpp-face-type)) buffer)
-      (pp (list 'setq 'cpp-known-writable
-		(list 'quote cpp-known-writable)) buffer)
-      (pp (list 'setq 'cpp-unknown-writable
-		(list 'quote cpp-unknown-writable)) buffer)
-      (pp (list 'setq 'cpp-edit-list
-		(list 'quote cpp-edit-list)) buffer)
-      (write-file cpp-config-file))))
-
-(defun cpp-edit-home ()
-  "Switch back to original buffer."
-  (interactive)
-  (if cpp-button-event
-      (read-event))
-  (pop-to-buffer cpp-edit-buffer))
-
-(defun cpp-edit-background ()
-  "Change default face collection."
-  (interactive)
-  (call-interactively 'cpp-choose-default-face)
-  (cpp-edit-reset))
-
-(defun cpp-edit-known ()
-  "Select default for known conditionals."
-  (interactive)
-  (setq cpp-known-face (cpp-choose-face "Known face" cpp-known-face))
-  (cpp-edit-reset))
-
-(defun cpp-edit-unknown ()
-  "Select default for unknown conditionals."
-  (interactive)
-  (setq cpp-unknown-face (cpp-choose-face "Unknown face" cpp-unknown-face))
-  (cpp-edit-reset))
-
-(defun cpp-edit-toggle-known (arg)
-  "Toggle writable status for known conditionals.
-With optional argument ARG, make them writable iff ARG is positive."
-  (interactive "@P")
-  (if (or (and (null arg) cpp-known-writable)
-	  (<= (prefix-numeric-value arg) 0))
-      (setq cpp-known-writable nil)
-    (setq cpp-known-writable t))
-  (cpp-edit-reset))
-
-(defun cpp-edit-toggle-unknown (arg)
-  "Toggle writable status for unknown conditionals.
-With optional argument ARG, make them writable iff ARG is positive."
-  (interactive "@P")
-  (if (or (and (null arg) cpp-unknown-writable)
-	  (<= (prefix-numeric-value arg) 0))
-      (setq cpp-unknown-writable nil)
-    (setq cpp-unknown-writable t))
-  (cpp-edit-reset))
-
-(defun cpp-edit-true (symbol face)
-  "Select SYMBOL's true FACE used for highlighting taken conditionals."
-  (interactive
-   (let ((symbol (cpp-choose-symbol)))
-     (list symbol
-	   (cpp-choose-face "True face"
-			    (nth 1 (assoc symbol cpp-edit-list))))))
-  (setcar (nthcdr 1 (cpp-edit-list-entry-get-or-create symbol)) face)
-  (cpp-edit-reset))
-
-(defun cpp-edit-false (symbol face)
-  "Select SYMBOL's false FACE used for highlighting untaken conditionals."
-  (interactive
-   (let ((symbol (cpp-choose-symbol)))
-     (list symbol
-	   (cpp-choose-face "False face" 
-			    (nth 2 (assoc symbol cpp-edit-list))))))
-  (setcar (nthcdr 2 (cpp-edit-list-entry-get-or-create symbol)) face)
-  (cpp-edit-reset))
-
-(defun cpp-edit-write (symbol branch)
-  "Set which branches of SYMBOL should be writable to BRANCH.
-BRANCH should be either nil (false branch), t (true branch) or 'both."
-  (interactive (list (cpp-choose-symbol) (cpp-choose-branch)))
-  (setcar (nthcdr 3 (cpp-edit-list-entry-get-or-create symbol)) branch)
-  (cpp-edit-reset))
-
-(defun cpp-edit-list-entry-get-or-create (symbol)
-  ;; Return the entry for SYMBOL in `cpp-edit-list'.
-  ;; If it does not exist, create it.
-  (let ((entry (assoc symbol cpp-edit-list)))
-    (or entry
-	(setq entry (list symbol nil nil 'both nil)
-	      cpp-edit-list (cons entry cpp-edit-list)))
-    entry))
-
-;;; Prompts:
-
-(defun cpp-choose-symbol ()
-  ;; Choose a symbol if called from keyboard, otherwise use the one clicked on.
-  (if cpp-button-event
-      cpp-callback-data
-    (completing-read "Symbol: " (mapcar 'list cpp-edit-symbols) nil t)))
-
-(defun cpp-choose-branch ()
-  ;; Choose a branch, either nil, t, or both.
-  (if cpp-button-event
-      (x-popup-menu cpp-button-event
-		    (list "Branch" (cons "Branch" cpp-branch-list)))
-    (cdr (assoc	(completing-read "Branch: " cpp-branch-list nil t)
-		cpp-branch-list))))
-
-(defun cpp-choose-face (prompt default)
-  ;; Choose a face from cpp-face-defalt-list.
-  ;; PROMPT is what to say to the user.
-  ;; DEFAULT is the default face.
-  (or (if cpp-button-event
-	  (x-popup-menu cpp-button-event
-			(list prompt (cons prompt cpp-face-default-list)))
-	(let ((name (car (rassq default cpp-face-default-list))))
-	  (cdr (assoc (completing-read (if name
-					   (concat prompt
-						   " (default " name "): ")
-					 (concat prompt ": "))
-				       cpp-face-default-list nil t)
-		      cpp-face-all-list))))
-      default))
-
-(defun cpp-choose-default-face (type)
-  ;; Choose default face list for screen of TYPE.
-  ;; Type must be one of the types defined in `cpp-face-type-list'.
-  (interactive (list (if cpp-button-event
-			 (x-popup-menu cpp-button-event
-				       (list "Screen type"
-					     (cons "Screen type"
-						   cpp-face-type-list)))
-		       (cdr (assoc (completing-read "Screen type: "
-						    cpp-face-type-list
-						    nil t)
-				   cpp-face-type-list)))))
-  (cond ((null type))
-	((eq type 'light)
-	 (if cpp-face-light-list
-	     ()
-	   (setq cpp-face-light-list
-		 (mapcar 'cpp-create-bg-face cpp-face-light-name-list))
-	   (setq cpp-face-all-list
-		 (append cpp-face-all-list cpp-face-light-list)))
-	 (setq cpp-face-type 'light)
-	 (setq cpp-face-default-list
-	       (append cpp-face-light-list cpp-face-none-list)))
-	((eq type 'dark)
-	 (if cpp-face-dark-list
-	     ()
-	   (setq cpp-face-dark-list
-		 (mapcar 'cpp-create-bg-face cpp-face-dark-name-list))
-	   (setq cpp-face-all-list
-		 (append cpp-face-all-list cpp-face-dark-list)))
-	 (setq cpp-face-type 'dark)
-	 (setq cpp-face-default-list
-	       (append cpp-face-dark-list cpp-face-none-list)))
-	((eq type 'mono)
-	 (setq cpp-face-type 'mono)
-	 (setq cpp-face-default-list
-	       (append cpp-face-mono-list cpp-face-none-list)))
-	(t
-	 (setq cpp-face-type 'none)
-	 (setq cpp-face-default-list cpp-face-none-list))))
-
-;;; Buttons:
-
-(defun cpp-make-button (name callback &optional data face padding)
-  ;; Create a button at point.
-  ;; NAME is the name of the button.
-  ;; CALLBACK is the function to call when the button is pushed.
-  ;; DATA will be made available to CALLBACK
-  ;;in the free variable cpp-callback-data.
-  ;; FACE means that NAME is the name of a face in `cpp-face-all-list'.
-  ;; PADDING means NAME will be right justified at that length.
-  (let ((name (format "%s" name))
-	from to)
-    (cond ((null padding)
-	   (setq from (point))
-	   (insert name))
-	  ((> (length name) padding)
-	   (setq from (point))
-	   (insert (substring name 0 padding)))
-	  (t
-	   (insert (make-string (- padding (length name)) ? ))
-	   (setq from (point))
-	   (insert name)))
-    (setq to (point))
-    (setq face
-	  (if face
-	      (let ((check (cdr (assoc name cpp-face-all-list))))
-		(if (memq check '(default invisible))
-		    'bold
-		  check))
-	    'bold))
-    (add-text-properties from to
-			 (append (list 'face face)
-				 '(mouse-face highlight)
-				 (list 'cpp-callback callback)
-				 (if data (list 'cpp-data data))))))
-
-(defun cpp-push-button (event)
-  ;; Pushed a CPP button.
-  (interactive "@e")
-  (set-buffer (window-buffer (posn-window (event-start event))))
-  (let ((pos (posn-point (event-start event))))
-    (let ((cpp-callback-data (get-text-property pos 'cpp-data))
-	  (fun (get-text-property pos 'cpp-callback))
-	  (cpp-button-event event))
-      (cond (fun
-	     (call-interactively (get-text-property pos 'cpp-callback)))
-	    ((lookup-key global-map [ down-mouse-2])
-	     (call-interactively (lookup-key global-map [ down-mouse-2])))))))
-
-;;; Faces:
-
-(defun cpp-create-bg-face (color)
-  ;; Create entry for face with background COLOR.
-  (let ((name (intern (concat "cpp " color))))
-    (make-face name)
-    (set-face-background name color)
-    (cons color name)))
-
-(cpp-choose-default-face (if window-system cpp-face-type 'none))
-
-(defun cpp-face-name (face)
-  ;; Return the name of FACE from `cpp-face-all-list'.
-  (let ((entry (rassq (if face face 'default) cpp-face-all-list)))
-    (if entry
-	(car entry)
-      (format "<%s>" face))))
-
-;;; Utilities:
-
-(defvar cpp-progress-time 0)
-;; Last time we issued a progress message.
-
-(defun cpp-progress-message (&rest args)
-  ;; Report progress at most once a second.  Take same ARGS as `message'.
-  (let ((time (nth 1 (current-time))))
-    (if (= time cpp-progress-time)
-	()
-      (setq cpp-progress-time time)
-      (apply 'message args))))
-
-(provide 'cpp)
-
-;;; cpp.el ends here
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
deleted file mode 100644
index 80d56df9329..00000000000
--- a/lisp/progmodes/etags.el
+++ /dev/null
@@ -1,1606 +0,0 @@
-;;; etags.el --- etags facility for Emacs
-
-;; Copyright (C) 1985, 1986, 1988, 1989, 1992, 1993, 1994, 1995
-;;	Free Software Foundation, Inc.
-
-;; Author: Roland McGrath <roland@gnu.ai.mit.edu>
-;; Keywords: 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.
-
-;;; Code:
-
-;;;###autoload
-(defvar tags-file-name nil
-  "*File name of tags table.
-To switch to a new tags table, setting this variable is sufficient.
-If you set this variable, do not also set `tags-table-list'.
-Use the `etags' program to make a tags table file.")
-;; Make M-x set-variable tags-file-name like M-x visit-tags-table.
-;;;###autoload (put 'tags-file-name 'variable-interactive "fVisit tags table: ")
-
-;;;###autoload
-;; Use `visit-tags-table-buffer' to cycle through tags tables in this list.
-(defvar tags-table-list nil
-  "*List of file names of tags tables to search.
-An element that is a directory means the file \"TAGS\" in that directory.
-To switch to a new list of tags tables, setting this variable is sufficient.
-If you set this variable, do not also set `tags-file-name'.
-Use the `etags' program to make a tags table file.")
-
-;;;###autoload
-(defvar tags-add-tables 'ask-user
-  "*Control whether to add a new tags table to the current list.
-t means do; nil means don't (always start a new list).
-Any other value means ask the user whether to add a new tags table
-to the current list (as opposed to starting a new list).")
-
-(defvar tags-table-computed-list nil
-  "List of tags tables to search, computed from `tags-table-list'.
-This includes tables implicitly included by other tables.  The list is not
-always complete: the included tables of a table are not known until that
-table is read into core.  An element that is `t' is a placeholder
-indicating that the preceding element is a table that has not been read
-into core and might contain included tables to search.
-See `tags-table-check-computed-list'.")
-
-(defvar tags-table-computed-list-for nil
-  "Value of `tags-table-list' that `tags-table-computed-list' corresponds to.
-If `tags-table-list' changes, `tags-table-computed-list' is thrown away and
-recomputed; see `tags-table-check-computed-list'.")
-
-(defvar tags-table-list-pointer nil
-  "Pointer into `tags-table-computed-list' for the current state of searching.
-Use `visit-tags-table-buffer' to cycle through tags tables in this list.")
-
-(defvar tags-table-list-started-at nil
-  "Pointer into `tags-table-computed-list', where the current search started.")
-
-(defvar tags-table-set-list nil
-  "List of sets of tags table which have been used together in the past.
-Each element is a list of strings which are file names.")
-
-;;;###autoload
-(defvar find-tag-hook nil
-  "*Hook to be run by \\[find-tag] after finding a tag.  See `run-hooks'.
-The value in the buffer in which \\[find-tag] is done is used,
-not the value in the buffer \\[find-tag] goes to.")
-
-;;;###autoload
-(defvar find-tag-default-function nil
-  "*A function of no arguments used by \\[find-tag] to pick a default tag.
-If nil, and the symbol that is the value of `major-mode'
-has a `find-tag-default-function' property (see `put'), that is used.
-Otherwise, `find-tag-default' is used.")
-
-(defvar default-tags-table-function nil
-  "If non-nil, a function to choose a default tags file for a buffer.
-This function receives no arguments and should return the default
-tags table file to use for the current buffer.")
-
-(defvar tags-location-stack nil
-  "List of markers which are locations visited by \\[find-tag].
-Pop back to the last location with \\[negative-argument] \\[find-tag].")
-
-;; Tags table state.
-;; These variables are local in tags table buffers.
-
-(defvar tags-table-files nil
-  "List of file names covered by current tags table.
-nil means it has not yet been computed; use `tags-table-files' to do so.")
-
-(defvar tags-completion-table nil
-  "Alist of tag names defined in current tags table.")
-
-(defvar tags-included-tables nil
-  "List of tags tables included by the current tags table.")
-
-(defvar next-file-list nil
-  "List of files for \\[next-file] to process.")
-
-;; Hooks for file formats.
-
-(defvar tags-table-format-hooks '(etags-recognize-tags-table
-				  recognize-empty-tags-table)
-  "List of functions to be called in a tags table buffer to identify
-the type of tags table.  The functions are called in order, with no arguments,
-until one returns non-nil.  The function should make buffer-local bindings
-of the format-parsing tags function variables if successful.")
-
-(defvar file-of-tag-function nil
-  "Function to do the work of `file-of-tag' (which see).")
-(defvar tags-table-files-function nil
-  "Function to do the work of `tags-table-files' (which see).")
-(defvar tags-completion-table-function nil
-  "Function to build the tags-completion-table.")
-(defvar snarf-tag-function nil
-  "Function to get info about a matched tag for `goto-tag-location-function'.")
-(defvar goto-tag-location-function nil
-  "Function of to go to the location in the buffer specified by a tag.
-One argument, the tag info returned by `snarf-tag-function'.")
-(defvar find-tag-regexp-search-function nil
-  "Search function passed to `find-tag-in-order' for finding a regexp tag.")
-(defvar find-tag-regexp-tag-order nil
-  "Tag order passed to `find-tag-in-order' for finding a regexp tag.")
-(defvar find-tag-regexp-next-line-after-failure-p nil
-  "Flag passed to `find-tag-in-order' for finding a regexp tag.")
-(defvar find-tag-search-function nil
-  "Search function passed to `find-tag-in-order' for finding a tag.")
-(defvar find-tag-tag-order nil
-  "Tag order passed to `find-tag-in-order' for finding a tag.")
-(defvar find-tag-next-line-after-failure-p nil
-  "Flag passed to `find-tag-in-order' for finding a tag.")
-(defvar list-tags-function nil
-  "Function to do the work of `list-tags' (which see).")
-(defvar tags-apropos-function nil
-  "Function to do the work of `tags-apropos' (which see).")
-(defvar tags-included-tables-function nil
-  "Function to do the work of `tags-included-tables' (which see).")
-(defvar verify-tags-table-function nil
-  "Function to return t iff the current buffer contains a valid
-\(already initialized\) tags file.")
-
-;; Initialize the tags table in the current buffer.
-;; Returns non-nil iff it is a valid tags table.  On
-;; non-nil return, the tags table state variable are
-;; made buffer-local and initialized to nil.
-(defun initialize-new-tags-table ()
-  (set (make-local-variable 'tags-table-files) nil)
-  (set (make-local-variable 'tags-completion-table) nil)
-  (set (make-local-variable 'tags-included-tables) nil)
-  ;; Value is t if we have found a valid tags table buffer.
-  (let ((hooks tags-table-format-hooks))
-    (while (and hooks
-		(not (funcall (car hooks))))
-      (setq hooks (cdr hooks)))
-    hooks))
-
-;;;###autoload
-(defun visit-tags-table (file &optional local)
-  "Tell tags commands to use tags table file FILE.
-FILE should be the name of a file created with the `etags' program.
-A directory name is ok too; it means file TAGS in that directory.
-
-Normally \\[visit-tags-table] sets the global value of `tags-file-name'.
-With a prefix arg, set the buffer-local value instead.
-When you find a tag with \\[find-tag], the buffer it finds the tag
-in is given a local value of this variable which is the name of the tags
-file the tag was in."
-  (interactive (list (read-file-name "Visit tags table: (default TAGS) "
-				     default-directory
-				     (expand-file-name "TAGS"
-						       default-directory)
-				     t)
-		     current-prefix-arg))
-  (or (stringp file) (signal 'wrong-type-argument (list 'stringp file)))
-  ;; Bind tags-file-name so we can control below whether the local or
-  ;; global value gets set.  Calling visit-tags-table-buffer will
-  ;; initialize a buffer for the file and set tags-file-name to the
-  ;; Calling visit-tags-table-buffer with tags-file-name set to FILE will
-  ;; initialize a buffer for FILE and set tags-file-name to the
-  ;; fully-expanded name.
-  (let ((tags-file-name file))
-    (save-excursion
-      (or (visit-tags-table-buffer file)
-	  (signal 'file-error (list "Visiting tags table"
-				    "file does not exist"
-				    file)))
-      ;; Set FILE to the expanded name.
-      (setq file tags-file-name)))
-  (if local
-      ;; Set the local value of tags-file-name.
-      (set (make-local-variable 'tags-file-name) file)
-    ;; Set the global value of tags-file-name.
-    (setq-default tags-file-name file)))
-
-(defun tags-table-check-computed-list ()
-  "Compute `tags-table-computed-list' from `tags-table-list' if necessary."
-  (let ((expanded-list (mapcar 'tags-expand-table-name tags-table-list)))
-    (or (equal tags-table-computed-list-for expanded-list)
-	;; The list (or default-directory) has changed since last computed.
-	(let* ((compute-for (mapcar 'copy-sequence expanded-list))
-	       (tables (copy-sequence compute-for)) ;Mutated in the loop.
-	       (computed nil)
-	       table-buffer)
-
-	  (while tables
-	    (setq computed (cons (car tables) computed)
-		  table-buffer (get-file-buffer (car tables)))
-	    (if (and table-buffer
-		     ;; There is a buffer visiting the file.  Now make sure
-		     ;; it is initialized as a tag table buffer.
-		     (save-excursion
-		       (tags-verify-table (buffer-file-name table-buffer))))
-		(save-excursion
-		  (set-buffer table-buffer)
-		  (if (tags-included-tables)
-		      ;; Insert the included tables into the list we
-		      ;; are processing.
-		      (setcdr tables (nconc (mapcar 'tags-expand-table-name
-						    (tags-included-tables))
-					    (cdr tables)))))
-	      ;; This table is not in core yet.  Insert a placeholder
-	      ;; saying we must read it into core to check for included
-	      ;; tables before searching the next table in the list.
-	      (setq computed (cons t computed)))
-	    (setq tables (cdr tables)))
-
-	  ;; Record the tags-table-list value (and the context of the
-	  ;; current directory) we computed from.
-	  (setq tags-table-computed-list-for compute-for
-		tags-table-computed-list (nreverse computed))))))
-
-;; Extend `tags-table-computed-list' to remove the first `t' placeholder.
-;; An element of the list that is `t' is a placeholder indicating that the
-;; preceding element is a table that has not been read into core and might
-;; contain included tables to search.  On return, the first placeholder
-;; element will be gone and the element before it read into core and its
-;; included tables inserted into the list.
-(defun tags-table-extend-computed-list ()
-  (let ((list tags-table-computed-list))
-    (while (not (eq (nth 1 list) t))
-      (setq list (cdr list)))
-    (save-excursion
-      (if (tags-verify-table (car list))
-	  ;; We are now in the buffer visiting (car LIST).  Extract its
-	  ;; list of included tables and insert it into the computed list.
-	  (let ((tables (tags-included-tables))
-		(computed nil)
-		table-buffer)
-	    (while tables
-	      (setq computed (cons (car tables) computed)
-		    table-buffer (get-file-buffer (car tables)))
-	      (if table-buffer
-		  (save-excursion
-		    (set-buffer table-buffer)
-		    (if (tags-included-tables)
-			;; Insert the included tables into the list we
-			;; are processing.
-			(setcdr tables (append (tags-included-tables)
-					       tables))))
-		;; This table is not in core yet.  Insert a placeholder
-		;; saying we must read it into core to check for included
-		;; tables before searching the next table in the list.
-		(setq computed (cons t computed)))
-	      (setq tables (cdr tables)))
-	    (setq computed (nreverse computed))
-	    ;; COMPUTED now contains the list of included tables (and
-	    ;; tables included by them, etc.).  Now splice this into the
-	    ;; current list.
-	    (setcdr list (nconc computed (cdr (cdr list)))))
-	;; It was not a valid table, so just remove the following placeholder.
-	(setcdr list (cdr (cdr list)))))))
-
-;; Expand tags table name FILE into a complete file name.
-(defun tags-expand-table-name (file)
-  (setq file (expand-file-name file))
-  (if (file-directory-p file)
-      (expand-file-name "TAGS" file)
-    file))
-
-;; Like member, but comparison is done after tags-expand-table-name on both
-;; sides and elements of LIST that are t are skipped.
-(defun tags-table-list-member (file list)
-  (setq file (tags-expand-table-name file))
-  (while (and list
-	      (or (eq (car list) t)
-		  (not (string= file (tags-expand-table-name (car list))))))
-    (setq list (cdr list)))
-  list)
-
-(defun tags-verify-table (file)
-  "Read FILE into a buffer and verify that it is a valid tags table.
-Sets the current buffer to one visiting FILE (if it exists).
-Returns non-nil iff it is a valid table."
-  (if (get-file-buffer file)
-      ;; The file is already in a buffer.  Check for the visited file
-      ;; having changed since we last used it.
-      (let (win)
-	(set-buffer (get-file-buffer file))
-	(setq win (or verify-tags-table-function (initialize-new-tags-table)))
-	(if (or (verify-visited-file-modtime (current-buffer))
-		(not (yes-or-no-p
-		      (format "Tags file %s has changed, read new contents? "
-			      file))))
-	    (and win (funcall verify-tags-table-function))
-	  (revert-buffer t t)
-	  (initialize-new-tags-table)))
-    (and (file-exists-p file)
-	 (progn
-	   (set-buffer (find-file-noselect file))
-	   (or (string= file buffer-file-name)
-	       ;; find-file-noselect has changed the file name.
-	       ;; Propagate the change to tags-file-name and tags-table-list.
-	       (let ((tail (member file tags-table-list)))
-		 (if tail
-		     (setcar tail buffer-file-name))
-		 (if (eq file tags-file-name)
-		     (setq tags-file-name buffer-file-name))))
-	   (initialize-new-tags-table)))))
-
-;; Subroutine of visit-tags-table-buffer.  Search the current tags tables
-;; for one that has tags for THIS-FILE (or that includes a table that
-;; does).  Return the name of the first table table listing THIS-FILE; if
-;; the table is one included by another table, it is the master table that
-;; we return.  If CORE-ONLY is non-nil, check only tags tables that are
-;; already in buffers--don't visit any new files.
-(defun tags-table-including (this-file core-only)
-  (let ((tables tags-table-computed-list)
-	(found nil))
-    ;; Loop over the list, looking for a table containing tags for THIS-FILE.
-    (while (and (not found)
-		tables)
-
-      (if core-only
-	  ;; Skip tables not in core.
-	  (while (eq (nth 1 tables) t)
-	    (setq tables (cdr (cdr tables))))
-	(if (eq (nth 1 tables) t)
-	    ;; This table has not been read into core yet.  Read it in now.
-	    (tags-table-extend-computed-list)))
-
-      (if tables
-	  ;; Select the tags table buffer and get the file list up to date.
-	  (let ((tags-file-name (car tables)))
-	    (visit-tags-table-buffer 'same)
-	    (if (member this-file (mapcar 'expand-file-name
-					  (tags-table-files)))
-		;; Found it.
-		(setq found tables))))
-      (setq tables (cdr tables)))
-    (if found
-	;; Now determine if the table we found was one included by another
-	;; table, not explicitly listed.  We do this by checking each
-	;; element of the computed list to see if it appears in the user's
-	;; explicit list; the last element we will check is FOUND itself.
-	;; Then we return the last one which did in fact appear in
-	;; tags-table-list.
-	(let ((could-be nil)
-	      (elt tags-table-computed-list))
-	  (while (not (eq elt (cdr found)))
-	    (if (tags-table-list-member (car elt) tags-table-list)
-		;; This table appears in the user's list, so it could be
-		;; the one which includes the table we found.
-		(setq could-be (car elt)))
-	    (setq elt (cdr elt))
-	    (if (eq t (car elt))
-		(setq elt (cdr elt))))
-	  ;; The last element we found in the computed list before FOUND
-	  ;; that appears in the user's list will be the table that
-	  ;; included the one we found.
-	  could-be))))
-
-;; Subroutine of visit-tags-table-buffer.  Move tags-table-list-pointer
-;; along and set tags-file-name.  Returns nil when out of tables.
-(defun tags-next-table ()
-  ;; If there is a placeholder element next, compute the list to replace it.
-  (while (eq (nth 1 tags-table-list-pointer) t)
-    (tags-table-extend-computed-list))
-
-  ;; Go to the next table in the list.
-  (setq tags-table-list-pointer (cdr tags-table-list-pointer))
-  (or tags-table-list-pointer
-      ;; Wrap around.
-      (setq tags-table-list-pointer tags-table-computed-list))
-
-  (if (eq tags-table-list-pointer tags-table-list-started-at)
-      ;; We have come full circle.  No more tables.
-      (setq tags-table-list-pointer nil)
-    ;; Set tags-file-name to the name from the list.  It is already expanded.
-    (setq tags-file-name (car tags-table-list-pointer))))
-
-(defun visit-tags-table-buffer (&optional cont)
-  "Select the buffer containing the current tags table.
-If optional arg is a string, visit that file as a tags table.
-If optional arg is t, visit the next table in `tags-table-list'.
-If optional arg is the atom `same', don't look for a new table;
- just select the buffer visiting `tags-file-name'.
-If arg is nil or absent, choose a first buffer from information in
- `tags-file-name', `tags-table-list', `tags-table-list-pointer'.
-Returns t if it visits a tags table, or nil if there are no more in the list."
-
-  ;; Set tags-file-name to the tags table file we want to visit.
-  (cond ((eq cont 'same)
-	 ;; Use the ambient value of tags-file-name.
-	 (or tags-file-name
-	     (error "%s"
-		    (substitute-command-keys
-		     (concat "No tags table in use!  "
-			     "Use \\[visit-tags-table] to select one.")))))
-
-	((eq t cont)
-	 ;; Find the next table.
-	 (if (tags-next-table)
-	     ;; Skip over nonexistent files.
-	     (while (and (not (or (get-file-buffer tags-file-name)
-				  (file-exists-p tags-file-name)))
-			 (tags-next-table)))))
-
-	(t
-	 ;; Pick a table out of our hat.
-	 (tags-table-check-computed-list) ;Get it up to date, we might use it.
-	 (setq tags-file-name
-	       (or
-		;; If passed a string, use that.
-		(if (stringp cont)
-		    (prog1 cont
-		      (setq cont nil)))
-		;; First, try a local variable.
-		(cdr (assq 'tags-file-name (buffer-local-variables)))
-		;; Second, try a user-specified function to guess.
-		(and default-tags-table-function
-		     (funcall default-tags-table-function))
-		;; Third, look for a tags table that contains tags for the
-		;; current buffer's file.  If one is found, the lists will
-		;; be frobnicated, and CONT will be set non-nil so we don't
-		;; do it below.
-		(and buffer-file-name
-		     (or
-		      ;; First check only tables already in buffers.
-		      (tags-table-including buffer-file-name t)
-		      ;; Since that didn't find any, now do the
-		      ;; expensive version: reading new files.
-		      (tags-table-including buffer-file-name nil)))
-		;; Fourth, use the user variable tags-file-name, if it is
-		;; not already in the current list.
-		(and tags-file-name
-		     (not (tags-table-list-member tags-file-name
-						  tags-table-computed-list))
-		     tags-file-name)
-		;; Fifth, use the user variable giving the table list.
-		;; Find the first element of the list that actually exists.
-		(let ((list tags-table-list)
-		      file)
-		  (while (and list
-			      (setq file (tags-expand-table-name (car list)))
-			      (not (get-file-buffer file))
-			      (not (file-exists-p file)))
-		    (setq list (cdr list)))
-		  (car list))
-		;; Finally, prompt the user for a file name.
-		(expand-file-name
-		 (read-file-name "Visit tags table: (default TAGS) "
-				 default-directory
-				 "TAGS"
-				 t))))))
-
-  ;; Expand the table name into a full file name.
-  (setq tags-file-name (tags-expand-table-name tags-file-name))
-
-  (if (and (eq cont t)
-	   (null tags-table-list-pointer))
-      ;; All out of tables.
-      nil
-
-    ;; Verify that tags-file-name names a valid tags table.
-    ;; Bind another variable with the value of tags-file-name
-    ;; before we switch buffers, in case tags-file-name is buffer-local.
-    (let ((curbuf (current-buffer))
-	  (local-tags-file-name tags-file-name))
-      (if (tags-verify-table local-tags-file-name)
-
-	  ;; We have a valid tags table.
-	  (progn
-	    ;; Bury the tags table buffer so it
-	    ;; doesn't get in the user's way.
-	    (bury-buffer (current-buffer))
-
-	    ;; If this was a new table selection (CONT is nil), make
-	    ;; sure tags-table-list includes the chosen table, and
-	    ;; update the list pointer variables.
-	    (or cont
-		;; Look in the list for the table we chose.
-		(let ((found (tags-table-list-member
-			      local-tags-file-name
-			      tags-table-computed-list)))
-		  (if found
-		      ;; There it is.  Just switch to it.
-		      (setq tags-table-list-pointer found
-			    tags-table-list-started-at found)
-
-		    ;; The table is not in the current set.
-		    ;; Try to find it in another previously used set.
-		    (let ((sets tags-table-set-list))
-		      (while (and sets
-				  (not (tags-table-list-member
-					local-tags-file-name
-					(car sets))))
-			(setq sets (cdr sets)))
-		      (if sets
-			  ;; Found in some other set.  Switch to that set.
-			  (progn
-			    (or (memq tags-table-list tags-table-set-list)
-				;; Save the current list.
-				(setq tags-table-set-list
-				      (cons tags-table-list
-					    tags-table-set-list)))
-			    (setq tags-table-list (car sets)))
-
-			;; Not found in any existing set.
-			(if (and tags-table-list
-				 (or (eq t tags-add-tables)
-				     (and tags-add-tables
-					  (y-or-n-p
-					   (concat "Keep current list of "
-						   "tags tables also? ")))))
-			    ;; Add it to the current list.
-			    (setq tags-table-list (cons local-tags-file-name
-							tags-table-list))
-
-			  ;; Make a fresh list, and store the old one.
-			  (message "Starting a new list of tags tables")
-			  (or (null tags-table-list)
-			      (memq tags-table-list tags-table-set-list)
-			      (setq tags-table-set-list
-				    (cons tags-table-list
-					  tags-table-set-list)))
-			  (setq tags-table-list (list local-tags-file-name))))
-
-		      ;; Recompute tags-table-computed-list.
-		      (tags-table-check-computed-list)
-		      ;; Set the tags table list state variables to start
-		      ;; over from tags-table-computed-list.
-		      (setq tags-table-list-started-at tags-table-computed-list
-			    tags-table-list-pointer
-			    tags-table-computed-list)))))
-
-	    ;; Return of t says the tags table is valid.
-	    t)
-
-	;; The buffer was not valid.  Don't use it again.
-	(set-buffer curbuf)
-	(kill-local-variable 'tags-file-name)
-	(if (eq local-tags-file-name tags-file-name)
-	    (setq tags-file-name nil))
-	(error "File %s is not a valid tags table" local-tags-file-name)))))
-
-(defun tags-reset-tags-tables ()
-  "Reset tags state to cancel effect of any previous \\[visit-tags-table]
-or \\[find-tag]."
-  (interactive)
-  (setq tags-file-name nil
-	tags-location-stack nil
-	tags-table-list nil
-	tags-table-computed-list nil
-	tags-table-computed-list-for nil
-	tags-table-list-pointer nil
-	tags-table-list-started-at nil
-	tags-table-set-list nil))
-
-(defun file-of-tag ()
-  "Return the file name of the file whose tags point is within.
-Assumes the tags table is the current buffer.
-File name returned is relative to tags table file's directory."
-  (funcall file-of-tag-function))
-
-;;;###autoload
-(defun tags-table-files ()
-  "Return a list of files in the current tags table.
-Assumes the tags table is the current buffer.  The file names are returned
-as they appeared in the `etags' command that created the table, usually
-without directory names."
-  (or tags-table-files
-      (setq tags-table-files
-	    (funcall tags-table-files-function))))
-
-(defun tags-included-tables ()
-  "Return a list of tags tables included by the current table.
-Assumes the tags table is the current buffer."
-  (or tags-included-tables
-      (setq tags-included-tables (funcall tags-included-tables-function))))
-
-;; Build tags-completion-table on demand.  The single current tags table
-;; and its included tags tables (and their included tables, etc.) have
-;; their tags included in the completion table.
-(defun tags-completion-table ()
-  (or tags-completion-table
-      (condition-case ()
-	  (prog2
-	   (message "Making tags completion table for %s..." buffer-file-name)
-	   (let ((included (tags-included-tables))
-		 (table (funcall tags-completion-table-function)))
-	     (save-excursion
-	       ;; Iterate over the list of included tables, and combine each
-	       ;; included table's completion obarray to the parent obarray.
-	       (while included
-		 ;; Visit the buffer.
-		 (let ((tags-file-name (car included)))
-		   (visit-tags-table-buffer 'same))
-		 ;; Recurse in that buffer to compute its completion table.
-		 (if (tags-completion-table)
-		     ;; Combine the tables.
-		     (mapatoms (function
-				(lambda (sym)
-				  (intern (symbol-name sym) table)))
-			       tags-completion-table))
-		 (setq included (cdr included))))
-	     (setq tags-completion-table table))
-	   (message "Making tags completion table for %s...done"
-		    buffer-file-name))
-	(quit (message "Tags completion table construction aborted.")
-	      (setq tags-completion-table nil)))))
-
-;; Completion function for tags.  Does normal try-completion,
-;; but builds tags-completion-table on demand.
-(defun tags-complete-tag (string predicate what)
-  (save-excursion
-    ;; If we need to ask for the tag table, allow that.
-    (let ((enable-recursive-minibuffers t))
-      (visit-tags-table-buffer))
-    (if (eq what t)
-	(all-completions string (tags-completion-table) predicate)
-      (try-completion string (tags-completion-table) predicate))))
-
-;; Return a default tag to search for, based on the text at point.
-(defun find-tag-default ()
-  (save-excursion
-    (while (looking-at "\\sw\\|\\s_")
-      (forward-char 1))
-    (if (or (re-search-backward "\\sw\\|\\s_"
-				(save-excursion (beginning-of-line) (point))
-				t)
-	    (re-search-forward "\\(\\sw\\|\\s_\\)+"
-			       (save-excursion (end-of-line) (point))
-			       t))
-	(progn (goto-char (match-end 0))
-	       (buffer-substring (point)
-				 (progn (forward-sexp -1)
-					(while (looking-at "\\s'")
-					  (forward-char 1))
-					(point))))
-      nil)))
-
-;; Read a tag name from the minibuffer with defaulting and completion.
-(defun find-tag-tag (string)
-  (let* ((default (funcall (or find-tag-default-function
-			       (get major-mode 'find-tag-default-function)
-			       'find-tag-default)))
-	 (spec (completing-read (if default
-				    (format "%s(default %s) " string default)
-				  string)
-				'tags-complete-tag)))
-    (if (equal spec "")
-	(or default (error "There is no default tag"))
-      spec)))
-
-(defvar last-tag nil
-  "Last tag found by \\[find-tag].")
-
-;; Get interactive args for find-tag{-noselect,-other-window,-regexp}.
-(defun find-tag-interactive (prompt &optional no-default)
-  (if current-prefix-arg
-      (list nil (if (< (prefix-numeric-value current-prefix-arg) 0)
-		    '-
-		  t))
-    (list (if no-default
-	      (read-string prompt)
-	    (find-tag-tag prompt)))))
-
-(defvar find-tag-history nil)
-
-;;;###autoload
-(defun find-tag-noselect (tagname &optional next-p regexp-p)
-  "Find tag (in current tags table) whose name contains TAGNAME.
-Returns the buffer containing the tag's definition and moves its point there,
-but does not select the buffer.
-The default for TAGNAME is the expression in the buffer near point.
-
-If second arg NEXT-P is t (interactively, with prefix arg), search for
-another tag that matches the last tagname or regexp used.  When there are
-multiple matches for a tag, more exact matches are found first.  If NEXT-P
-is the atom `-' (interactively, with prefix arg that is a negative number
-or just \\[negative-argument]), pop back to the previous tag gone to.
-
-If third arg REGEXP-P is non-nil, treat TAGNAME as a regexp.
-
-See documentation of variable `tags-file-name'."
-  (interactive (find-tag-interactive "Find tag: "))
-
-  (setq find-tag-history (cons tagname find-tag-history))
-  ;; Save the current buffer's value of `find-tag-hook' before selecting the
-  ;; tags table buffer.
-  (let ((local-find-tag-hook find-tag-hook))
-    (if (eq '- next-p)
-	;; Pop back to a previous location.
-	(if (null tags-location-stack)
-	    (error "No previous tag locations")
-	  (let ((marker (car tags-location-stack)))
-	    ;; Pop the stack.
-	    (setq tags-location-stack (cdr tags-location-stack))
-	    (prog1
-		;; Move to the saved location.
-		(set-buffer (marker-buffer marker))
-	      (goto-char (marker-position marker))
-	      ;; Kill that marker so it doesn't slow down editing.
-	      (set-marker marker nil nil)
-	      ;; Run the user's hook.  Do we really want to do this for pop?
-	      (run-hooks 'local-find-tag-hook))))
-      (if next-p
-	  ;; Find the same table we last used.
-	  (visit-tags-table-buffer 'same)
-	;; Pick a table to use.
-	(visit-tags-table-buffer)
-	;; Record TAGNAME for a future call with NEXT-P non-nil.
-	(setq last-tag tagname))
-      ;; Record the location so we can pop back to it later.
-      (let ((marker (make-marker)))
-	(save-excursion
-	  (set-buffer
-	   ;; find-tag-in-order does the real work.
-	   (find-tag-in-order
-	    (if next-p last-tag tagname)
-	    (if regexp-p
-		find-tag-regexp-search-function
-	      find-tag-search-function)
-	    (if regexp-p
-		find-tag-regexp-tag-order
-	      find-tag-tag-order)
-	    (if regexp-p
-		find-tag-regexp-next-line-after-failure-p
-	      find-tag-next-line-after-failure-p)
-	    (if regexp-p "matching" "containing")
-	    (not next-p)))
-	  (set-marker marker (point))
-	  (run-hooks 'local-find-tag-hook)
-	  (setq tags-location-stack
-		(cons marker tags-location-stack))
-	  (current-buffer))))))
-
-;;;###autoload
-(defun find-tag (tagname &optional next-p regexp-p)
-  "Find tag (in current tags table) whose name contains TAGNAME.
-Select the buffer containing the tag's definition, and move point there.
-The default for TAGNAME is the expression in the buffer around or before point.
-
-If second arg NEXT-P is t (interactively, with prefix arg), search for
-another tag that matches the last tagname or regexp used.  When there are
-multiple matches for a tag, more exact matches are found first.  If NEXT-P
-is the atom `-' (interactively, with prefix arg that is a negative number
-or just \\[negative-argument]), pop back to the previous tag gone to.
-
-See documentation of variable `tags-file-name'."
-  (interactive (find-tag-interactive "Find tag: "))
-  (switch-to-buffer (find-tag-noselect tagname next-p regexp-p)))
-;;;###autoload (define-key esc-map "." 'find-tag)
-
-;;;###autoload
-(defun find-tag-other-window (tagname &optional next-p regexp-p)
-  "Find tag (in current tags table) whose name contains TAGNAME.
-Select the buffer containing the tag's definition in another window, and
-move point there.  The default for TAGNAME is the expression in the buffer
-around or before point.
-
-If second arg NEXT-P is t (interactively, with prefix arg), search for
-another tag that matches the last tagname or regexp used.  When there are
-multiple matches for a tag, more exact matches are found first.  If NEXT-P
-is negative (interactively, with prefix arg that is a negative number or
-just \\[negative-argument]), pop back to the previous tag gone to.
-
-See documentation of variable `tags-file-name'."
-  (interactive (find-tag-interactive "Find tag other window: "))
-
-  ;; This hair is to deal with the case where the tag is found in the
-  ;; selected window's buffer; without the hair, point is moved in both
-  ;; windows.  To prevent this, we save the selected window's point before
-  ;; doing find-tag-noselect, and restore it after.
-  (let* ((window-point (window-point (selected-window)))
-	 (tagbuf (find-tag-noselect tagname next-p regexp-p))
-	 (tagpoint (progn (set-buffer tagbuf) (point))))
-    (set-window-point (prog1
-			  (selected-window)
-			(switch-to-buffer-other-window tagbuf)
-			;; We have to set this new window's point; it
-			;; might already have been displaying a
-			;; different portion of tagbuf, in which case
-			;; switch-to-buffer-other-window doesn't set
-			;; the window's point from the buffer.
-			(set-window-point (selected-window) tagpoint))
-		      window-point)))
-;;;###autoload (define-key ctl-x-4-map "." 'find-tag-other-window)
-
-;;;###autoload
-(defun find-tag-other-frame (tagname &optional next-p)
-  "Find tag (in current tags table) whose name contains TAGNAME.
-Select the buffer containing the tag's definition in another frame, and
-move point there.  The default for TAGNAME is the expression in the buffer
-around or before point.
-
-If second arg NEXT-P is t (interactively, with prefix arg), search for
-another tag that matches the last tagname or regexp used.  When there are
-multiple matches for a tag, more exact matches are found first.  If NEXT-P
-is negative (interactively, with prefix arg that is a negative number or
-just \\[negative-argument]), pop back to the previous tag gone to.
-
-See documentation of variable `tags-file-name'."
-  (interactive (find-tag-interactive "Find tag other frame: "))
-  (let ((pop-up-frames t))
-    (find-tag-other-window tagname next-p)))
-;;;###autoload (define-key ctl-x-5-map "." 'find-tag-other-frame)
-
-;;;###autoload
-(defun find-tag-regexp (regexp &optional next-p other-window)
-  "Find tag (in current tags table) whose name matches REGEXP.
-Select the buffer containing the tag's definition and move point there.
-
-If second arg NEXT-P is t (interactively, with prefix arg), search for
-another tag that matches the last tagname or regexp used.  When there are
-multiple matches for a tag, more exact matches are found first.  If NEXT-P
-is negative (interactively, with prefix arg that is a negative number or
-just \\[negative-argument]), pop back to the previous tag gone to.
-
-If third arg OTHER-WINDOW is non-nil, select the buffer in another window.
-
-See documentation of variable `tags-file-name'."
-  (interactive (find-tag-interactive "Find tag regexp: " t))
-  ;; We go through find-tag-other-window to do all the display hair there.
-  (funcall (if other-window 'find-tag-other-window 'find-tag)
-	   regexp next-p t))
-;;;###autoload (define-key esc-map [?\C-.] 'find-tag-regexp)
-
-;; Internal tag finding function.
-
-;; PATTERN is a string to pass to second arg SEARCH-FORWARD-FUNC, and to
-;; any member of the function list ORDER (third arg).  If ORDER is nil,
-;; use saved state to continue a previous search.
-
-;; Fourth arg MATCHING is a string, an English '-ing' word, to be used in
-;; an error message.
-
-;; Fifth arg NEXT-LINE-AFTER-FAILURE-P is non-nil if after a failed match,
-;; point should be moved to the next line.
-
-;; Algorithm is as follows.  For each qualifier-func in ORDER, go to
-;; beginning of tags file, and perform inner loop: for each naive match for
-;; PATTERN found using SEARCH-FORWARD-FUNC, qualify the naive match using
-;; qualifier-func.  If it qualifies, go to the specified line in the
-;; specified source file and return.  Qualified matches are remembered to
-;; avoid repetition.  State is saved so that the loop can be continued.
-
-(defvar tag-lines-already-matched nil)	;matches remembered here between calls
-
-(defun find-tag-in-order (pattern
-			  search-forward-func
-			  order
-			  next-line-after-failure-p
-			  matching
-			  first-search)
-  (let (file				;name of file containing tag
-	tag-info			;where to find the tag in FILE
-	(first-table t)
-	(tag-order order)
-	(match-marker (make-marker))
-	goto-func
-	)
-    (save-excursion
-
-      (if first-search
-	  ;; This is the start of a search for a fresh tag.
-	  ;; Clear the list of tags matched by the previous search.
-	  ;; find-tag-noselect has already put us in the first tags table
-	  ;; buffer before we got called.
-	  (setq tag-lines-already-matched nil)
-	;; Continuing to search for the tag specified last time.
-	;; tag-lines-already-matched lists locations matched in previous
-	;; calls so we don't visit the same tag twice if it matches twice
-	;; during two passes with different qualification predicates.
-	;; Switch to the current tags table buffer.
-	(visit-tags-table-buffer 'same))
-
-      ;; Get a qualified match.
-      (catch 'qualified-match-found
-
-	;; Iterate over the list of tags tables.
-	(while (or first-table
-		   (visit-tags-table-buffer t))
-
-	  (and first-search first-table
-	       ;; Start at beginning of tags file.
-	       (goto-char (point-min)))
-
-	  (setq first-table nil)
-
-	  ;; Iterate over the list of ordering predicates.
-	  (while order
-	    (while (funcall search-forward-func pattern nil t)
-	      ;; Naive match found.  Qualify the match.
-	      (and (funcall (car order) pattern)
-		   ;; Make sure it is not a previous qualified match.
-		   (not (member (set-marker match-marker (save-excursion
-							   (beginning-of-line)
-							   (point)))
-				tag-lines-already-matched))
-		   (throw 'qualified-match-found nil))
-	      (if next-line-after-failure-p
-		  (forward-line 1)))
-	    ;; Try the next flavor of match.
-	    (setq order (cdr order))
-	    (goto-char (point-min)))
-	  (setq order tag-order))
-	;; We throw out on match, so only get here if there were no matches.
-	;; Clear out the markers we use to avoid duplicate matches so they
-	;; don't slow down editting and are immediately available for GC.
-	(while tag-lines-already-matched
-	  (set-marker (car tag-lines-already-matched) nil nil)
-	  (setq tag-lines-already-matched (cdr tag-lines-already-matched)))
-	(set-marker match-marker nil nil)
-	(error "No %stags %s %s" (if first-search "" "more ")
-	       matching pattern))
-
-      ;; Found a tag; extract location info.
-      (beginning-of-line)
-      (setq tag-lines-already-matched (cons match-marker
-					    tag-lines-already-matched))
-      ;; Expand the filename, using the tags table buffer's default-directory.
-      (setq file (expand-file-name (file-of-tag))
-	    tag-info (funcall snarf-tag-function))
-
-      ;; Get the local value in the tags table buffer before switching buffers.
-      (setq goto-func goto-tag-location-function)
-
-      ;; Find the right line in the specified file.
-      (set-buffer (find-file-noselect file))
-      (widen)
-      (push-mark)
-      (funcall goto-func tag-info)
-
-      ;; Return the buffer where the tag was found.
-      (current-buffer))))
-
-;; `etags' TAGS file format support.
-
-;; If the current buffer is a valid etags TAGS file, give it local values of
-;; the tags table format variables, and return non-nil.
-(defun etags-recognize-tags-table ()
-  (and (etags-verify-tags-table)
-       ;; It is annoying to flash messages on the screen briefly,
-       ;; and this message is not useful.  -- rms
-       ;; (message "%s is an `etags' TAGS file" buffer-file-name)
-       (mapcar (function (lambda (elt)
-			   (set (make-local-variable (car elt)) (cdr elt))))
-	       '((file-of-tag-function . etags-file-of-tag)
-		 (tags-table-files-function . etags-tags-table-files)
-		 (tags-completion-table-function . etags-tags-completion-table)
-		 (snarf-tag-function . etags-snarf-tag)
-		 (goto-tag-location-function . etags-goto-tag-location)
-		 (find-tag-regexp-search-function . re-search-forward)
-		 (find-tag-regexp-tag-order . (tag-re-match-p))
-		 (find-tag-regexp-next-line-after-failure-p . t)
-		 (find-tag-search-function . search-forward)
-		 (find-tag-tag-order . (tag-exact-file-name-match-p
-					tag-exact-match-p
-					tag-symbol-match-p
-					tag-word-match-p
-					tag-any-match-p))
-		 (find-tag-next-line-after-failure-p . nil)
-		 (list-tags-function . etags-list-tags)
-		 (tags-apropos-function . etags-tags-apropos)
-		 (tags-included-tables-function . etags-tags-included-tables)
-		 (verify-tags-table-function . etags-verify-tags-table)
-		 ))))
-
-;; Return non-nil iff the current buffer is a valid etags TAGS file.
-(defun etags-verify-tags-table ()
-  ;; Use eq instead of = in case char-after returns nil.
-  (eq (char-after 1) ?\f))
-
-(defun etags-file-of-tag ()
-  (save-excursion
-    (re-search-backward "\f\n\\([^\n]+\\),[0-9]*\n")
-    (expand-file-name (buffer-substring (match-beginning 1) (match-end 1))
-		      (file-truename default-directory))))
-
-
-(defun etags-tags-completion-table ()
-  (let ((table (make-vector 511 0)))
-    (save-excursion
-      (goto-char (point-min))
-      ;; This monster regexp matches an etags tag line.
-      ;;   \1 is the string to match;
-      ;;   \2 is not interesting;
-      ;;   \3 is the guessed tag name; XXX guess should be better eg DEFUN
-      ;;   \4 is not interesting;
-      ;;   \5 is the explicitly-specified tag name.
-      ;;   \6 is the line to start searching at;
-      ;;   \7 is the char to start searching at.
-      (while (re-search-forward
-	      "^\\(\\([^\177]+[^-a-zA-Z0-9_$\177]+\\)?\\([-a-zA-Z0-9_$?:]+\\)\
-\[^-a-zA-Z0-9_$?:\177]*\\)\177\\(\\([^\n\001]+\\)\001\\)?\
-\\([0-9]+\\)?,\\([0-9]+\\)?\n"
-	      nil t)
-	(intern	(if (match-beginning 5)
-		    ;; There is an explicit tag name.
-		    (buffer-substring (match-beginning 5) (match-end 5))
-		  ;; No explicit tag name.  Best guess.
-		  (buffer-substring (match-beginning 3) (match-end 3)))
-		table)))
-    table))
-
-(defun etags-snarf-tag ()
-  (let (tag-text line startpos)
-    (if (save-excursion
-	  (forward-line -1)
-	  (looking-at "\f\n"))
-	;; The match was for a source file name, not any tag within a file.
-	;; Give text of t, meaning to go exactly to the location we specify,
-	;; the beginning of the file.
-	(setq tag-text t
-	      line nil
-	      startpos 1)
-
-      ;; Find the end of the tag and record the whole tag text.
-      (search-forward "\177")
-      (setq tag-text (buffer-substring (1- (point))
-				       (save-excursion (beginning-of-line)
-						       (point))))
-      ;; Skip explicit tag name if present.
-      (search-forward "\001" (save-excursion (forward-line 1) (point)) t)
-      (if (looking-at "[0-9]")
-	  (setq line (string-to-int (buffer-substring
-				     (point)
-				     (progn (skip-chars-forward "0-9")
-					    (point))))))
-      (search-forward ",")
-      (if (looking-at "[0-9]")
-	  (setq startpos (string-to-int (buffer-substring
-					 (point)
-					 (progn (skip-chars-forward "0-9")
-						(point)))))))
-    ;; Leave point on the next line of the tags file.
-    (forward-line 1)
-    (cons tag-text (cons line startpos))))
-
-;; TAG-INFO is a cons (TEXT LINE . POSITION) where TEXT is the initial part
-;; of a line containing the tag and POSITION is the character position of
-;; TEXT within the file (starting from 1); LINE is the line number.  If
-;; TEXT is t, it means the tag refers to exactly LINE or POSITION
-;; (whichever is present, LINE having preference, no searching.  Either
-;; LINE or POSITION may be nil; POSITION is used if present.  If the tag
-;; isn't exactly at the given position then look around that position using
-;; a search window which expands until it hits the start of file.
-(defun etags-goto-tag-location (tag-info)
-  (let ((startpos (cdr (cdr tag-info)))
-	(line (car (cdr tag-info)))
-	offset found pat)
-    (if (eq (car tag-info) t)
-	;; Direct file tag.
-	(cond (line (goto-line line))
-	      (startpos (goto-char startpos))
-	      (t (error "etags.el BUG: bogus direct file tag")))
-      ;; This constant is 1/2 the initial search window.
-      ;; There is no sense in making it too small,
-      ;; since just going around the loop once probably
-      ;; costs about as much as searching 2000 chars.
-      (setq offset 1000
-	    found nil
-	    pat (concat (if (eq selective-display t)
-			    "\\(^\\|\^m\\)" "^")
-			(regexp-quote (car tag-info))))
-      ;; The character position in the tags table is 0-origin.
-      ;; Convert it to a 1-origin Emacs character position.
-      (if startpos (setq startpos (1+ startpos)))
-      ;; If no char pos was given, try the given line number.
-      (or startpos
-	  (if line
-	      (setq startpos (progn (goto-line line)
-				    (point)))))
-      (or startpos
-	  (setq startpos (point-min)))
-      ;; First see if the tag is right at the specified location.
-      (goto-char startpos)
-      (setq found (looking-at pat))
-      (while (and (not found)
-		  (progn
-		    (goto-char (- startpos offset))
-		    (not (bobp))))
-	(setq found
-	      (re-search-forward pat (+ startpos offset) t)
-	      offset (* 3 offset)))	; expand search window
-      (or found
-	  (re-search-forward pat nil t)
-	  (error "Rerun etags: `%s' not found in %s"
-		 pat buffer-file-name)))
-    ;; Position point at the right place
-    ;; if the search string matched an extra Ctrl-m at the beginning.
-    (and (eq selective-display t)
-	 (looking-at "\^m")
-	 (forward-char 1))
-    (beginning-of-line)))
-
-(defun etags-list-tags (file)
-  (goto-char 1)
-  (if (not (search-forward (concat "\f\n" file ",") nil t))
-      nil
-    (forward-line 1)
-    (while (not (or (eobp) (looking-at "\f")))
-      (let ((tag (buffer-substring (point)
-				   (progn (skip-chars-forward "^\177")
-					  (point)))))
-	(princ (if (looking-at "[^\n]+\001")
-		   ;; There is an explicit tag name; use that.
-		   (buffer-substring (1+ (point)) ;skip \177
-				     (progn (skip-chars-forward "^\001")
-					    (point)))
-		 tag)))
-      (terpri)
-      (forward-line 1))
-    t))
-
-(defun etags-tags-apropos (string)
-  (goto-char 1)
-  (while (re-search-forward string nil t)
-    (beginning-of-line)
-    (princ (buffer-substring (point)
-			     (progn (skip-chars-forward "^\177")
-				    (point))))
-    (terpri)
-    (forward-line 1)))
-
-(defun etags-tags-table-files ()
-  (let ((files nil)
-	beg)
-    (goto-char (point-min))
-    (while (search-forward "\f\n" nil t)
-      (setq beg (point))
-      (end-of-line)
-      (skip-chars-backward "^," beg)
-      (or (looking-at "include$")
-	  (setq files (cons (buffer-substring beg (1- (point))) files))))
-    (nreverse files)))
-
-(defun etags-tags-included-tables ()
-  (let ((files nil)
-	beg)
-    (goto-char (point-min))
-    (while (search-forward "\f\n" nil t)
-      (setq beg (point))
-      (end-of-line)
-      (skip-chars-backward "^," beg)
-      (if (looking-at "include$")
-	  ;; Expand in the default-directory of the tags table buffer.
-	  (setq files (cons (expand-file-name (buffer-substring beg (1- (point))))
-			    files))))
-    (nreverse files)))
-
-;; Empty tags file support.
-
-;; Recognize an empty file and give it local values of the tags table format
-;; variables which do nothing.
-(defun recognize-empty-tags-table ()
-  (and (zerop (buffer-size))
-       (mapcar (function (lambda (sym)
-			   (set (make-local-variable sym) 'ignore)))
-	       '(tags-table-files-function
-		 tags-completion-table-function
-		 find-tag-regexp-search-function
-		 find-tag-search-function
-		 tags-apropos-function
-		 tags-included-tables-function))
-       (set (make-local-variable 'verify-tags-table-function)
-	    (function (lambda ()
-			(zerop (buffer-size)))))))
-
-;;; Match qualifier functions for tagnames.
-;;; XXX these functions assume etags file format.
-
-;; This might be a neat idea, but it's too hairy at the moment.
-;;(defmacro tags-with-syntax (&rest body)
-;;  (` (let ((current (current-buffer))
-;;	   (otable (syntax-table))
-;;	   (buffer (find-file-noselect (file-of-tag)))
-;;	   table)
-;;       (unwind-protect
-;;	   (progn
-;;	     (set-buffer buffer)
-;;	     (setq table (syntax-table))
-;;	     (set-buffer current)
-;;	     (set-syntax-table table)
-;;	     (,@ body))
-;;	 (set-syntax-table otable)))))
-;;(put 'tags-with-syntax 'edebug-form-spec '(&rest form))
-
-;; t if point is at a tag line that matches TAG exactly.
-;; point should be just after a string that matches TAG.
-(defun tag-exact-match-p (tag)
-  ;; The match is really exact if there is an explicit tag name.
-  (or (and (eq (char-after (point)) ?\001)
-	   (eq (char-after (- (point) (length tag) 1)) ?\177))
-      ;; We are not on the explicit tag name, but perhaps it follows.
-      (looking-at (concat "[^\177\n]*\177" (regexp-quote tag) "\001"))))
-
-;; t if point is at a tag line that matches TAG as a symbol.
-;; point should be just after a string that matches TAG.
-(defun tag-symbol-match-p (tag)
-  (and (looking-at "\\Sw.*\177") (looking-at "\\S_.*\177")
-       (save-excursion
-	 (backward-char (1+ (length tag)))
-	 (and (looking-at "\\Sw") (looking-at "\\S_")))))
-
-;; t if point is at a tag line that matches TAG as a word.
-;; point should be just after a string that matches TAG.
-(defun tag-word-match-p (tag)
-  (and (looking-at "\\b.*\177")
-       (save-excursion (backward-char (length tag))
-		       (looking-at "\\b"))))
-
-(defun tag-exact-file-name-match-p (tag)
-  (and (looking-at ",")
-       (save-excursion (backward-char (length tag))
-		       (looking-at "\f\n"))))
-
-;; t if point is in a tag line with a tag containing TAG as a substring.
-(defun tag-any-match-p (tag)
-  (looking-at ".*\177"))
-
-;; t if point is at a tag line that matches RE as a regexp.
-(defun tag-re-match-p (re)
-  (save-excursion
-    (beginning-of-line)
-    (let ((bol (point)))
-      (and (search-forward "\177" (save-excursion (end-of-line) (point)) t)
-	   (re-search-backward re bol t)))))
-
-;;;###autoload
-(defun next-file (&optional initialize novisit)
-  "Select next file among files in current tags table.
-
-A first argument of t (prefix arg, if interactive) initializes to the
-beginning of the list of files in the tags table.  If the argument is
-neither nil nor t, it is evalled to initialize the list of files.
-
-Non-nil second argument NOVISIT means use a temporary buffer
- to save time and avoid uninteresting warnings.
-
-Value is nil if the file was already visited;
-if the file was newly read in, the value is the filename."
-  ;; Make the interactive arg t if there was any prefix arg.
-  (interactive (list (if current-prefix-arg t)))
-  (cond ((not initialize)
-	 ;; Not the first run.
-	 )
-	((eq initialize t)
-	 ;; Initialize the list from the tags table.
-	 (save-excursion
-	   ;; Visit the tags table buffer to get its list of files.
-	   (visit-tags-table-buffer)
-	   ;; Copy the list so we can setcdr below, and expand the file
-	   ;; names while we are at it, in this buffer's default directory.
-	   (setq next-file-list (mapcar 'expand-file-name (tags-table-files)))
-	   ;; Iterate over all the tags table files, collecting
-	   ;; a complete list of referenced file names.
-	   (while (visit-tags-table-buffer t)
-	     ;; Find the tail of the working list and chain on the new
-	     ;; sublist for this tags table.
-	     (let ((tail next-file-list))
-	       (while (cdr tail)
-		 (setq tail (cdr tail)))
-	       ;; Use a copy so the next loop iteration will not modify the
-	       ;; list later returned by (tags-table-files).
-	       (if tail
-		   (setcdr tail (mapcar 'expand-file-name (tags-table-files)))
-		 (setq next-file-list (mapcar 'expand-file-name
-					      (tags-table-files))))))))
-	(t
-	 ;; Initialize the list by evalling the argument.
-	 (setq next-file-list (eval initialize))))
-  (if next-file-list
-      ()
-    (and novisit
-	 (get-buffer " *next-file*")
-	 (kill-buffer " *next-file*"))
-    (error "All files processed."))
-  (let* ((next (car next-file-list))
-	 (new (not (get-file-buffer next))))
-    ;; Advance the list before trying to find the file.
-    ;; If we get an error finding the file, don't get stuck on it.
-    (setq next-file-list (cdr next-file-list))
-    (if (not (and new novisit))
-	(set-buffer (find-file-noselect next novisit))
-      ;; Like find-file, but avoids random warning messages.
-      (set-buffer (get-buffer-create " *next-file*"))
-      (kill-all-local-variables)
-      (erase-buffer)
-      (setq new next)
-      (insert-file-contents new nil))
-    new))
-
-(defvar tags-loop-operate nil
-  "Form for `tags-loop-continue' to eval to change one file.")
-
-(defvar tags-loop-scan
-  '(error "%s"
-	  (substitute-command-keys
-	   "No \\[tags-search] or \\[tags-query-replace] in progress."))
-  "Form for `tags-loop-continue' to eval to scan one file.
-If it returns non-nil, this file needs processing by evalling
-\`tags-loop-operate'.  Otherwise, move on to the next file.")
-
-;;;###autoload
-(defun tags-loop-continue (&optional first-time)
-  "Continue last \\[tags-search] or \\[tags-query-replace] command.
-Used noninteractively with non-nil argument to begin such a command (the
-argument is passed to `next-file', which see).
-
-Two variables control the processing we do on each file: the value of
-`tags-loop-scan' is a form to be executed on each file to see if it is
-interesting (it returns non-nil if so) and `tags-loop-operate' is a form to
-evaluate to operate on an interesting file.  If the latter evaluates to
-nil, we exit; otherwise we scan the next file."
-  (interactive)
-  (let (new
-	(messaged nil))
-    (while
-	(progn
-	  ;; Scan files quickly for the first or next interesting one.
-	  (while (or first-time
-		     (save-restriction
-		       (widen)
-		       (not (eval tags-loop-scan))))
-	    (setq new (next-file first-time t))
-	    ;; If NEW is non-nil, we got a temp buffer,
-	    ;; and NEW is the file name.
-	    (if (or messaged
-		    (and (not first-time)
-			 (> baud-rate search-slow-speed)
-			 (setq messaged t)))
-		(message "Scanning file %s..." (or new buffer-file-name)))
-	    (setq first-time nil)
-	    (goto-char (point-min)))
-
-	  ;; If we visited it in a temp buffer, visit it now for real.
-	  (if new
-	      (let ((pos (point)))
-		(erase-buffer)
-		(set-buffer (find-file-noselect new))
-		(setq new nil)		;No longer in a temp buffer.
-		(widen)
-		(goto-char pos)))
-
-	  (switch-to-buffer (current-buffer))
-
-	  ;; Now operate on the file.
-	  ;; If value is non-nil, continue to scan the next file.
-	  (eval tags-loop-operate)))
-    (and messaged
-	 (null tags-loop-operate)
-	 (message "Scanning file %s...found" buffer-file-name))))
-;;;###autoload (define-key esc-map "," 'tags-loop-continue)
-
-;;;###autoload
-(defun tags-search (regexp &optional file-list-form)
-  "Search through all files listed in tags table for match for REGEXP.
-Stops when a match is found.
-To continue searching for next match, use command \\[tags-loop-continue].
-
-See documentation of variable `tags-file-name'."
-  (interactive "sTags search (regexp): ")
-  (if (and (equal regexp "")
-	   (eq (car tags-loop-scan) 're-search-forward)
-	   (null tags-loop-operate))
-      ;; Continue last tags-search as if by M-,.
-      (tags-loop-continue nil)
-    (setq tags-loop-scan
-	  (list 're-search-forward (list 'quote regexp) nil t)
-	  tags-loop-operate nil)
-    (tags-loop-continue (or file-list-form t))))
-
-;;;###autoload
-(defun tags-query-replace (from to &optional delimited file-list-form)
-  "Query-replace-regexp FROM with TO through all files listed in tags table.
-Third arg DELIMITED (prefix arg) means replace only word-delimited matches.
-If you exit (\\[keyboard-quit] or ESC), you can resume the query-replace
-with the command \\[tags-loop-continue].
-
-See documentation of variable `tags-file-name'."
-  (interactive (query-replace-read-args "Tags query replace (regexp)" t))
-  (setq tags-loop-scan (list 'prog1
-			     (list 'if (list 're-search-forward
-					     (list 'quote from) nil t)
-				   ;; When we find a match, move back
-				   ;; to the beginning of it so perform-replace
-				   ;; will see it.
-				   '(goto-char (match-beginning 0))))
-	tags-loop-operate (list 'perform-replace
-				(list 'quote from) (list 'quote to)
-				t t (list 'quote delimited)))
-  (tags-loop-continue (or file-list-form t)))
-
-(defun tags-complete-tags-table-file (string predicate what)
-  (save-excursion
-    ;; If we need to ask for the tag table, allow that.
-    (let ((enable-recursive-minibuffers t))
-      (visit-tags-table-buffer))
-    (if (eq what t)
-	(all-completions string (mapcar 'list (tags-table-files))
-			 predicate)
-      (try-completion string (mapcar 'list (tags-table-files))
-		      predicate))))
-
-;;;###autoload
-(defun list-tags (file &optional next-match)
-  "Display list of tags in file FILE.
-This searches only the first table in the list, and no included tables.
-FILE should be as it appeared in the `etags' command, usually without a
-directory specification."
-  (interactive (list (completing-read "List tags in file: "
-				      'tags-complete-tags-table-file
-				      nil t nil)))
-  (with-output-to-temp-buffer "*Tags List*"
-    (princ "Tags in file ")
-    (princ file)
-    (terpri)
-    (save-excursion
-      (let ((first-time t)
-	    (gotany nil))
-	(while (visit-tags-table-buffer (not first-time))
-	  (setq first-time nil)
-	  (if (funcall list-tags-function file)
-	      (setq gotany t)))
-	(or gotany
-	    (error "File %s not in current tags tables" file))))))
-
-;;;###autoload
-(defun tags-apropos (regexp)
-  "Display list of all tags in tags table REGEXP matches."
-  (interactive "sTags apropos (regexp): ")
-  (with-output-to-temp-buffer "*Tags List*"
-    (princ "Tags matching regexp ")
-    (prin1 regexp)
-    (terpri)
-    (save-excursion
-      (let ((first-time t))
-	(while (visit-tags-table-buffer (not first-time))
-	  (setq first-time nil)
-	  (funcall tags-apropos-function regexp))))))
-
-;;; XXX Kludge interface.
-
-;; XXX If a file is in multiple tables, selection may get the wrong one.
-;;;###autoload
-(defun select-tags-table ()
-  "Select a tags table file from a menu of those you have already used.
-The list of tags tables to select from is stored in `tags-table-set-list';
-see the doc of that variable if you want to add names to the list."
-  (interactive)
-  (pop-to-buffer "*Tags Table List*")
-  (setq buffer-read-only nil)
-  (erase-buffer)
-  (let ((set-list tags-table-set-list)
-	(desired-point nil))
-    (if tags-table-list
-	(progn
-	  (setq desired-point (point-marker))
-	  (princ tags-table-list (current-buffer))
-	  (insert "\C-m")
-	  (prin1 (car tags-table-list) (current-buffer)) ;invisible
-	  (insert "\n")))
-    (while set-list
-      (if (eq (car set-list) tags-table-list)
-	  ;; Already printed it.
-	  ()
-	(princ (car set-list) (current-buffer))
-	(insert "\C-m")
-	(prin1 (car (car set-list)) (current-buffer)) ;invisible
-	(insert "\n"))
-      (setq set-list (cdr set-list)))
-    (if tags-file-name
-	(progn
-	  (or desired-point
-	      (setq desired-point (point-marker)))
-	  (insert tags-file-name "\C-m")
-	  (prin1 tags-file-name (current-buffer)) ;invisible
-	  (insert "\n")))
-    (setq set-list (delete tags-file-name
-			   (apply 'nconc (cons (copy-sequence tags-table-list)
-					       (mapcar 'copy-sequence
-						       tags-table-set-list)))))
-    (while set-list
-      (insert (car set-list) "\C-m")
-      (prin1 (car set-list) (current-buffer)) ;invisible
-      (insert "\n")
-      (setq set-list (delete (car set-list) set-list)))
-    (goto-char 1)
-    (insert-before-markers
-     "Type `t' to select a tags table or set of tags tables:\n\n")
-    (if desired-point
-	(goto-char desired-point))
-    (set-window-start (selected-window) 1 t))
-  (set-buffer-modified-p nil)
-  (select-tags-table-mode))
-
-(defvar select-tags-table-mode-map)
-(let ((map (make-sparse-keymap)))
-  (define-key map "t" 'select-tags-table-select)
-  (define-key map " " 'next-line)
-  (define-key map "\^?" 'previous-line)
-  (define-key map "n" 'next-line)
-  (define-key map "p" 'previous-line)
-  (define-key map "q" 'select-tags-table-quit)
-  (setq select-tags-table-mode-map map))
-
-(defun select-tags-table-mode ()
-  "Major mode for choosing a current tags table among those already loaded.
-
-\\{select-tags-table-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (setq buffer-read-only t
-	major-mode 'select-tags-table-mode
-	mode-name "Select Tags Table")
-  (use-local-map select-tags-table-mode-map)
-  (setq selective-display t
-	selective-display-ellipses nil))
-
-(defun select-tags-table-select ()
-  "Select the tags table named on this line."
-  (interactive)
-  (search-forward "\C-m")
-  (let ((name (read (current-buffer))))
-    (visit-tags-table name)
-    (select-tags-table-quit)
-    (message "Tags table now %s" name)))
-
-(defun select-tags-table-quit ()
-  "Kill the buffer and delete the selected window."
-  (interactive)
-  (kill-buffer (current-buffer))
-  (or (one-window-p)
-      (delete-window)))
-
-;;; Note, there is another definition of this function in bindings.el.
-;;;###autoload
-(defun complete-tag ()
-  "Perform tags completion on the text around point.
-Completes to the set of names listed in the current tags table.
-The string to complete is chosen in the same way as the default
-for \\[find-tag] (which see)."
-  (interactive)
-  (or tags-table-list
-      tags-file-name
-      (error "%s"
-	     (substitute-command-keys
-	      "No tags table loaded.  Try \\[visit-tags-table].")))
-  (let ((pattern (funcall (or find-tag-default-function
-			      (get major-mode 'find-tag-default-function)
-			      'find-tag-default)))
-	beg
-	completion)
-    (or pattern
-	(error "Nothing to complete"))
-    (search-backward pattern)
-    (setq beg (point))
-    (forward-char (length pattern))
-    (setq completion (try-completion pattern 'tags-complete-tag nil))
-    (cond ((eq completion t))
-	  ((null completion)
-	   (message "Can't find completion for \"%s\"" pattern)
-	   (ding))
-	  ((not (string= pattern completion))
-	   (delete-region beg (point))
-	   (insert completion))
-	  (t
-	   (message "Making completion list...")
-	   (with-output-to-temp-buffer "*Completions*"
-	     (display-completion-list
-	      (all-completions pattern 'tags-complete-tag nil)))
-	   (message "Making completion list...%s" "done")))))
-
-;;;###autoload (define-key esc-map "\t" 'complete-tag)
-
-(provide 'etags)
-
-;;; etags.el ends here
diff --git a/lisp/progmodes/executable.el b/lisp/progmodes/executable.el
deleted file mode 100644
index 62d6f59fbbb..00000000000
--- a/lisp/progmodes/executable.el
+++ /dev/null
@@ -1,235 +0,0 @@
-;;; executable.el --- base functionality for executable interpreter scripts
-
-;; Copyright (C) 1994, 1995, 1996 by Free Software Foundation, Inc.
-
-;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
-;; Keywords: languages, unix
-
-;; 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:
-
-;; executable.el is used by certain major modes to insert a suitable
-;; #! line at the beginning of the file, if the file does not already
-;; have one.
-
-;; Unless it has a magic number, a Unix file with executable mode is passed to
-;; a new instance of the running shell (or to a Bourne shell if a csh is
-;; running and the file starts with `:').  Only a shell can start such a file,
-;; exec() cannot, which is why it is important to have a magic number in every
-;; executable script.  Such a magic number is made up by the characters `#!'
-;; the filename of an interpreter (in COFF, ELF or somesuch format) and one
-;; optional argument.
-
-;; This library is for certain major modes like sh-, awk-, perl-, tcl- or
-;; makefile-mode to insert or update a suitable #! line at the beginning of
-;; the file, if the file does not already have one and the file is not a
-;; default file of that interpreter (like .profile or makefile).  It also
-;; makes the file executable if it wasn't, as soon as it's saved.
-
-;; It also allows debugging scripts, with an adaptation of compile, as far
-;; as interpreters give out meaningful error messages.
-
-;; Modes that use this should nconc `executable-map' to the end of their own
-;; keymap and `executable-font-lock-keywords' to the end of their own font
-;; lock keywords.  Their mode-setting commands should call
-;; `executable-set-magic'.
-
-;;; Code:
-
-(defvar executable-insert t
-  "*Non-nil means offer to add a magic number to a file.
-This takes effect when you switch to certain major modes,
-including Shell-script mode (`sh-mode').
-When you type \\[executable-set-magic], it always offers to add or
-update the magic number.")
-
-(defvar executable-query 'function
-  "*If non-nil, ask user before changing an existing magic number.
-When this is `function', only ask when called non-interactively.")
-
-
-(defvar executable-magicless-file-regexp "/[Mm]akefile$\\|/\\.\\(z?profile\\|bash_profile\\|z?login\\|bash_login\\|z?logout\\|bash_logout\\|.+shrc\\|esrc\\|rcrc\\|[kz]shenv\\)$"
-  "*On files with this kind of name no magic is inserted or changed.")
-
-
-(defvar executable-prefix "#! "
-  "*Interpreter magic number prefix inserted when there was no magic number.")
-
-
-
-(defvar executable-chmod 73
-  "*After saving, if the file is not executable, set this mode.
-This mode passed to `set-file-modes' is taken absolutely when negative, or
-relative to the files existing modes.  Do nothing if this is nil.
-Typical values are 73 (+x) or -493 (rwxr-xr-x).")
-
-
-(defvar executable-command nil)
-
-(defvar executable-self-display "tail"
-  "*Command you use with argument `+2' to make text files self-display.
-Note that the like of `more' doesn't work too well under Emacs  \\[shell].")
-
-
-(defvar executable-font-lock-keywords
-  '(("\\`#!.*/\\([^ \t\n]+\\)" 1 font-lock-keyword-face t))
-  "*Rules for highlighting executable scripts' magic number.
-This can be included in `font-lock-keywords' by modes that call `executable'.")
-
-
-(defvar executable-error-regexp-alist
-  '(;; /bin/xyz: syntax error at line 14: `(' unexpected
-    ;; /bin/xyz[5]: syntax error at line 8 : ``' unmatched
-    ("^\\(.*[^[/]\\)\\(\\[[0-9]+\\]\\)?: .* error .* line \\([0-9]+\\)" 1 3)
-    ;; /bin/xyz[27]: ehco:  not found
-    ("^\\(.*[^/]\\)\\[\\([0-9]+\\)\\]: .*: " 1 2)
-    ;; /bin/xyz: syntax error near unexpected token `)'
-    ;; /bin/xyz: /bin/xyz: line 2: `)'
-    ("^\\(.*[^/]\\): [^0-9\n]+\n\\1: \\1: line \\([0-9]+\\):" 1 2)
-    ;; /usr/bin/awk: syntax error at line 5 of file /bin/xyz
-    (" error .* line \\([0-9]+\\) of file \\(.+\\)$" 2 1)
-    ;; /usr/bin/awk: calling undefined function toto
-    ;;  input record number 3, file awktestdata
-    ;;  source line 4 of file /bin/xyz
-    ("^[^ ].+\n\\( .+\n\\)* line \\([0-9]+\\) of file \\(.+\\)$" 3 2)
-    ;; makefile:1: *** target pattern contains no `%'.  Stop.
-    ("^\\(.+\\):\\([0-9]+\\): " 1 2))
-  "Alist of regexps used to match script errors.
-See `compilation-error-regexp-alist'.")
-
-;; The C function openp slightly modified would do the trick fine
-(defun executable-find (command)
-  "Search for COMMAND in exec-path and return the absolute file name.
-Return nil if COMMAND is not found anywhere in `exec-path'."
-  (let ((list exec-path)
-	file)
-    (while list
-      (setq list (if (and (setq file (expand-file-name command (car list)))
-			  (file-executable-p file)
-			  (not (file-directory-p file)))
-		     nil
-		   (setq file nil)
-		   (cdr list))))
-    file))
-
-
-(defun executable-chmod ()
-  "This gets called after saving a file to assure that it be executable.
-You can set the absolute or relative mode in variable `executable-chmod' for
-non-executable files."
-  (and executable-chmod
-       buffer-file-name
-       (or (file-executable-p buffer-file-name)
-	   (set-file-modes buffer-file-name
-			   (if (< executable-chmod 0)
-			       (- executable-chmod)
-			     (logior executable-chmod
-				     (file-modes buffer-file-name)))))))
-
-
-(defun executable-interpret (command)
-  "Run script with user-specified args, and collect output in a buffer.
-While script runs asynchronously, you can use the \\[next-error] command
-to find the next error."
-  (interactive (list (read-string "Run script: "
-				  (or executable-command
-				      buffer-file-name))))
-  (require 'compile)
-  (save-some-buffers (not compilation-ask-about-save))
-  (make-local-variable 'executable-command)
-  (compile-internal (setq executable-command command)
-		    "No more errors." "Interpretation"
-		    ;; Give it a simpler regexp to match.
-		    nil executable-error-regexp-alist))
-
-
-
-;;;###autoload
-(defun executable-set-magic (interpreter &optional argument
-					 no-query-flag insert-flag)
-  "Set this buffer's interpreter to INTERPRETER with optional ARGUMENT.
-The variables `executable-magicless-file-regexp', `executable-prefix',
-`executable-insert', `executable-query' and `executable-chmod' control
-when and how magic numbers are inserted or replaced and scripts made
-executable."
-  (interactive
-   (let* ((name (read-string "Name or file name of interpreter: "))
-	  (arg (read-string (format "Argument for %s: " name))))
-     (list name arg (eq executable-query 'function) t)))
-  (setq interpreter (if (file-name-absolute-p interpreter)
-			interpreter
-		      (or (executable-find interpreter)
-			  (error "Interpreter %s not recognized" interpreter)))
-	argument (concat interpreter
-			 (and argument (string< "" argument) " ")
-			 argument))
-  (or buffer-read-only
-      (if buffer-file-name
-	  (string-match executable-magicless-file-regexp
-			buffer-file-name))
-      (not (or insert-flag executable-insert))
-      (> (point-min) 1)
-      (save-excursion
-	(let ((point (point-marker))
-	      (buffer-modified-p (buffer-modified-p)))
-	  (goto-char (point-min))
-	  (make-local-hook 'after-save-hook)
-	  (add-hook 'after-save-hook 'executable-chmod nil t)
-	  (if (looking-at "#![ \t]*\\(.*\\)$")
-	      (and (goto-char (match-beginning 1))
-		   ;; If the line ends in a space,
-		   ;; don't offer to change it.
-		   (not (= (char-after (1- (match-end 1))) ?\ ))
-		   (not (string= argument
-				 (buffer-substring (point) (match-end 1))))
-		   (if (or (not executable-query) no-query-flag
-			   (save-window-excursion
-			     ;; Make buffer visible before question.
-			     (switch-to-buffer (current-buffer))
-			     (y-or-n-p (concat "Replace magic number by `"
-					       executable-prefix argument "'? "))))
-		       (progn
-			 (replace-match argument t t nil 1)
-			 (message "Magic number changed to `%s'"
-				  (concat executable-prefix argument)))))
-	    (insert executable-prefix argument ?\n)
-	    (message "Magic number changed to `%s'"
-		     (concat executable-prefix argument)))
-;;;	  (or insert-flag
-;;;	      (eq executable-insert t)
-;;;	      (set-buffer-modified-p buffer-modified-p))
-	  )))
-  interpreter)
-
-
-
-;;;###autoload
-(defun executable-self-display ()
-  "Turn a text file into a self-displaying Un*x command.
-The magic number of such a command displays all lines but itself."
-  (interactive)
-  (if (eq this-command 'executable-self-display)
-      (setq this-command 'executable-set-magic))
-  (executable-set-magic executable-self-display "+2"))
-
-
-
-(provide 'executable)
-
-;; executable.el ends here
diff --git a/lisp/progmodes/f90.el b/lisp/progmodes/f90.el
deleted file mode 100644
index ada277ffc05..00000000000
--- a/lisp/progmodes/f90.el
+++ /dev/null
@@ -1,1697 +0,0 @@
-;;; f90.el --- Fortran-90 mode (free format)
-
-;; Copyright (C) 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Torbj\"orn Einarsson <T.Einarsson@clab.ericsson.se>
-;; Last Change: Oct. 14, 1996
-;; Keywords: fortran, f90, languages
-
-;; 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:
-
-;; Smart mode for editing F90 programs in FREE FORMAT.
-;; Knows about continuation lines, named structured statements, and other
-;; new features in F90 including HPF (High Performance Fortran) structures.
-;; The basic feature is to provide an accurate indentation of F90 programs.
-;; In addition, there are many more features like automatic matching of all
-;; end statements, an auto-fill function to break long lines, a join-lines
-;; function which joins continued lines etc etc.
-;;  To facilitate typing, a fairly complete list of abbreviations is provided.
-;;    For example, `i is short-hand for integer (if abbrev-mode is on).
-
-;; There are two separate features for highlighting the code.
-;;   1) Upcasing or capitalizing of all keywords.
-;;   2) Colors/fonts using font-lock-mode. (only when using X-windows)
-;;  Automatic upcase of downcase of keywords is controlled by the parameter
-;;  f90-auto-keyword-case.
-
-;; The indentations of lines starting with ! is determined by the first of the
-;; following matches (the values in the left column are the default values):
-
-;; start-string/regexp  indent         variable holding start-string/regexp
-;;    !!!                  0
-;;    !hpf\\$ (re)         0              f90-directive-comment-re
-;;    !!$                  0              f90-comment-region
-;;    !      (re)        as code          f90-indented-comment-re
-;;    default            comment-column
-
-;; Ex: Here is the result of 3 different settings of f90-indented-comment-re
-;;     f90-indented-comment-re  !-indentation      !!-indentation
-;;          !                    as code             as code
-;;          !!                   comment-column      as code
-;;          ![^!]                as code             comment-column
-;; Trailing comments are indented to comment-column with indent-for-comment M-;
-;; f90-comment-region (C-c;) toggles insertion of f90-comment-region in region.
-
-;; One common convention for free vs. fixed format is that free-format files
-;; have the ending .f90 while the fixed format files have the ending .f. 
-;; To make f90-mode work, put this file in, for example, your directory
-;;  ~/lisp, and be sure that you have the following in your .emacs-file
-;;     (setq load-path (append load-path '("~/lisp")))
-;;     (autoload 'f90-mode "f90"
-;;       "Major mode for editing Fortran 90 code in free format." t)
-;;     (setq auto-mode-alist (append auto-mode-alist 
-;;                           (list '("\\.f90$" . f90-mode))))
-;; Once you have entered f90-mode, you may get more info by using
-;; the command describe-mode (C-h m). For online help describing various
-;; functions use  C-h f <Name of function you want described>
-
-;; To customize the f90-mode for your taste, use, for example:
-;;    (you don't have to specify values for all the parameters below)
-;;(setq f90-mode-hook
-;;      '(lambda () (setq f90-do-indent 3
-;;                        f90-if-indent 3
-;;                        f90-type-indent 3
-;;                        f90-program-indent 2
-;;                        f90-continuation-indent 5
-;;                        f90-comment-region "!!$"
-;;                        f90-directive-comment-re "!hpf\\$"
-;;                        f90-indented-comment-re "!"
-;;                        f90-break-delimiters "[-+\\*/,><=% \t]"
-;;                        f90-break-before-delimiters t
-;;                        f90-beginning-ampersand t
-;;                        f90-smart-end 'blink
-;;                        f90-auto-keyword-case nil
-;;                        f90-leave-line-no  nil
-;;                        f90-startup-message t
-;;                        indent-tabs-mode nil
-;;                        f90-font-lock-keywords f90-font-lock-keywords-2
-;;                  )
-;;       ;;The rest is not default.
-;;       (abbrev-mode 1)             ; turn on abbreviation mode
-;;       (turn-on-font-lock)         ; for highlighting
-;;       (f90-add-imenu-menu)        ; extra menu with functions etc.
-;;       (if f90-auto-keyword-case   ; change case of all keywords on startup
-;;           (f90-change-keywords f90-auto-keyword-case))
-;;	 ))
-;; in your .emacs file (the shown values are the defaults). You can also
-;; change the values of the lists f90-keywords etc.
-;; The auto-fill and abbreviation minor modes are accessible from the menu,
-;; or by using M-x auto-fill-mode and M-x abbrev-mode, respectively.
-
-;; Remarks
-;; 1) Line numbers are by default left-justified. If f90-leave-line-no is
-;;    non-nil, the line numbers are never touched.
-;; 2) Multi-; statements like > do i=1,20 ; j=j+i ; end do < are not handled
-;;    correctly, but I imagine them to be rare.
-;; 3) Regexps for hilit19 are no longer supported.
-;; 4) For FIXED FORMAT code, use the ordinary fortran mode.
-;; 5) This mode does not work under emacs-18.x.
-;; 6) Preprocessor directives, i.e., lines starting with # are left-justified
-;;    and are untouched by all case-changing commands. There is, at present, no
-;;    mechanism for treating multi-line directives (continued by \ ).
-;; 7) f77 do-loops do 10 i=.. ; ; 10 continue are not correctly indented.
-;;    You are urged to use f90-do loops (with labels if you wish).
-;; 8) The highlighting mode under XEmacs is not as complete as under Emacs.
-
-;; List of user commands
-;;   f90-previous-statement         f90-next-statement
-;;   f90-beginning-of-subprogram    f90-end-of-subprogram   f90-mark-subprogram
-;;   f90-comment-region
-;;   f90-indent-line                f90-indent-new-line
-;;   f90-indent-region    (can be called by calling indent-region)
-;;   f90-indent-subprogram
-;;   f90-break-line                 f90-join-lines
-;;   f90-fill-region
-;;   f90-insert-end
-;;   f90-upcase-keywords            f90-upcase-region-keywords
-;;   f90-downcase-keywords          f90-downcase-region-keywords
-;;   f90-capitalize-keywords        f90-capitalize-region-keywords
-;;   f90-add-imenu-menu
-;;   f90-font-lock-1, f90-font-lock-2, f90-font-lock-3, f90-font-lock-4
-
-;; Thanks to all the people who have tested the mode. Special thanks to Jens
-;; Bloch Helmers for encouraging me to write this code, for creative
-;; suggestions as well as for the lists of hpf-commands.
-;; Also thanks to the authors of the fortran and pascal modes, on which some
-;; of this code is built.
-
-;;; Code:
-
-(defconst bug-f90-mode "T.Einarsson@clab.ericsson.se"
-  "Address of mailing list for F90 mode bugs.")
-
-;; User options
-(defvar f90-do-indent 3
-  "*Extra indentation applied to DO blocks.")
-
-(defvar f90-if-indent 3
-  "*Extra indentation applied to IF, SELECT CASE, WHERE and FORALL blocks.")
-
-(defvar f90-type-indent 3
-  "*Extra indentation applied to TYPE, INTERFACE and BLOCK DATA blocks.")
-
-(defvar f90-program-indent 2
-  "*Extra indentation applied to PROGRAM/MODULE/SUBROUTINE/FUNCTION blocks.")
-
-(defvar f90-continuation-indent 5
-  "*Extra indentation applied to F90 continuation lines.")
-
-(defvar f90-comment-region "!!$"
-  "*String inserted by \\[f90-comment-region]\
- at start of each line in region.")
-
-(defvar f90-indented-comment-re "!"
-  "*Regexp saying which comments to be indented like code.")
-
-(defvar f90-directive-comment-re "!hpf\\$"
-  "*Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented.")
-
-(defvar f90-beginning-ampersand t
-  "*t makes automatic insertion of \& at beginning of continuation line.")
-
-(defvar f90-smart-end 'blink
-  "*From an END statement, check and fill the end using matching block start.
-Allowed values are 'blink, 'no-blink, and nil, which determine
-whether to blink the matching beginning.")
-
-(defvar f90-break-delimiters "[-+\\*/><=,% \t]"
-  "*Regexp holding list of delimiters at which lines may be broken.")
-
-(defvar f90-break-before-delimiters t
-  "*Non-nil causes `f90-do-auto-fill' to break lines before delimiters.")
-
-(defvar f90-auto-keyword-case nil
-  "*Automatic case conversion of keywords.
-  The options are 'downcase-word, 'upcase-word, 'capitalize-word and nil")
-
-(defvar f90-leave-line-no nil
-  "*If nil, left-justify linenumbers.")
-
-(defvar f90-startup-message t
-  "*Non-nil displays a startup message when F90 mode is first called.")
-
-(defconst f90-keywords-re
-  ;;("allocate" "allocatable" "assign" "assignment" "backspace" "block"
-  ;;"call" "case" "character" "close" "common" "complex" "contains"
-  ;;"continue" "cycle" "data" "deallocate" "dimension" "do" "double" "else"
-  ;;"elseif" "elsewhere" "end" "enddo" "endfile" "endif" "entry" "equivalence"
-  ;;"exit" "external" "forall" "format" "function" "goto" "if" "implicit"
-  ;;"include" "inquire" "integer" "intent" "interface" "intrinsic" "logical"
-  ;;"module" "namelist" "none" "nullify" "only" "open" "operator" "optional" "parameter"
-  ;;"pause" "pointer" "precision" "print" "private" "procedure" "program"
-  ;;"public" "read" "real" "recursive" "result" "return" "rewind" "save" "select"
-  ;;"sequence" "stop" "subroutine" "target" "then" "type" "use" "where"
-  ;;"while" "write")
-  (concat
-   "\\<\\(a\\(llocat\\(able\\|e\\)\\|ssign\\(\\|ment\\)\\)\\|b\\(ackspace\\|"
-   "lock\\)\\|c\\(a\\(ll\\|se\\)\\|haracter\\|lose\\|o\\(m\\(mon\\|plex\\)\\|"
-   "nt\\(ains\\|inue\\)\\)\\|ycle\\)\\|d\\(ata\\|eallocate\\|imension\\|"
-   "o\\(\\|uble\\)\\)\\|e\\(lse\\(\\|if\\|where\\)\\|n\\(d\\(\\|do\\|file\\|"
-   "if\\)\\|try\\)\\|quivalence\\|x\\(it\\|ternal\\)\\)\\|f\\(or\\(all\\|"
-   "mat\\)\\|unction\\)\\|goto\\|i\\(f\\|mplicit\\|n\\(clude\\|quire\\|t\\("
-   "e\\(ger\\|nt\\|rface\\)\\|rinsic\\)\\)\\)\\|logical\\|module\\|n\\("
-   "amelist\\|one\\|ullify\\)\\|o\\(nly\\|p\\(en\\|erator\\|tional\\)\\)\\|p\\(a\\("
-   "rameter\\|use\\)\\|ointer\\|r\\(ecision\\|i\\(nt\\|vate\\)\\|o\\("
-   "cedure\\|gram\\)\\)\\|ublic\\)\\|re\\(a[dl]\\|cursive\\|sult\\|turn\\|wind\\)\\|"
-   "s\\(ave\\|e\\(lect\\|quence\\)\\|top\\|ubroutine\\)\\|t\\(arget\\|hen\\|"
-   "ype\\)\\|use\\|w\\(h\\(ere\\|ile\\)\\|rite\\)\\)\\>")
-  "Regexp for F90 keywords.")
-
-(defconst f90-keywords-level-3-re
-  ;; ("allocate" "allocatable" "assign" "assignment" "backspace" "close"
-  ;; "deallocate" "dimension" "endfile" "entry" "equivalence" "external"
-  ;; "inquire" "intent" "intrinsic" "nullify" "only" "open" "operator"
-  ;; "optional" "parameter" "pause" "pointer" "print" "private" "public"
-  ;; "read" "recursive" "result" "rewind" "save" "select" "sequence"
-  ;; "target"  "write")
-  (concat
-   "\\<\\(a\\(llocat\\(able\\|e\\)\\|ssign\\(\\|ment\\)\\)\\|backspace\\|"
-   "close\\|d\\(eallocate\\|imension\\)\\|e\\(n\\(dfile\\|try\\)\\|"
-   "quivalence\\|xternal\\)\\|"
-   "in\\(quire\\|t\\(ent\\|rinsic\\)\\)\\|nullify\\|"
-   "o\\(nly\\|p\\(en\\|erator\\|tional\\)\\)\\|"
-   "p\\(a\\(rameter\\|use\\)\\|ointer\\|ri\\(nt\\|vate\\)\\|ublic\\)\\|re\\("
-   "ad\\|cursive\\|sult\\|wind\\)\\|s\\(ave\\|e\\(lect\\|quence\\)\\)\\|target\\|"
-   "write\\)\\>")
-"Keyword-regexp for font-lock level >= 3.")
-
-
-(defconst f90-procedures-re
-  ;; ("abs" "achar" "acos" "adjustl" "adjustr" "aimag" "aint" "all" "allocated"
-  ;; "anint" "any" "asin" "associated" "atan" "atan2" "bit_size" "btest"
-  ;; "ceiling" "char" "cmplx" "conjg" "cos" "cosh" "count" "cshift"
-  ;; "date_and_time" "dble" "digits" "dim" "dot_product" "dprod" "eoshift"
-  ;; "epsilon" "exp" "exponent" "floor" "fraction" "huge" "iachar" "iand"
-  ;; "ibclr" "ibits" "ibset" "ichar" "ieor" "index" "int" "ior" "ishft"
-  ;; "ishftc" "kind" "lbound" "len" "len_trim" "lge" "lgt" "lle" "llt" "log"
-  ;; "logical" "log10" "matmul" "max" "maxexponent" "maxloc" "maxval" "merge"
-  ;; "min" "minexponent" "minloc" "minval" "mod" "modulo" "mvbits" "nearest"
-  ;; "nint" "not" "pack" "precision" "present" "product" "radix"
-  ;; "random_number" "random_seed" "range" "real" "repeat" "reshape"
-  ;; "rrspacing" "scale" "scan" "selected_int_kind" "selected_real_kind"
-  ;; "set_exponent" "shape" "sign" "sin" "sinh" "size" "spacing" "spread"
-  ;; "sqrt" "sum" "system_clock" "tan" "tanh" "tiny" "transfer" "transpose"
-  ;; "trim" "ubound" "unpack" "verify")
-  ;; A left parenthesis to avoid highlighting non-procedures.
-  ;; Real is taken out here to avoid highlighting declarations.
-  (concat
-   "\\<\\(a\\(bs\\|c\\(har\\|os\\)\\|djust[lr]\\|i\\(mag\\|nt\\)\\|ll\\(\\|"
-   "ocated\\)\\|n\\(int\\|y\\)\\|s\\(in\\|sociated\\)\\|tan2?\\)\\|b\\("
-   "it_size\\|test\\)\\|c\\(eiling\\|har\\|mplx\\|o\\(njg\\|sh?\\|unt\\)\\|"
-   "shift\\)\\|d\\(ate_and_time\\|ble\\|i\\(gits\\|m\\)\\|ot_product\\|prod"
-   "\\)\\|e\\(oshift\\|psilon\\|xp\\(\\|onent\\)\\)\\|f\\(loor\\|"
-   "raction\\)\\|huge\\|i\\(a\\(char\\|nd\\)\\|b\\(clr\\|its\\|set\\)\\|"
-   "char\\|eor\\|n\\(dex\\|t\\)\\|or\\|shftc?\\)\\|kind\\|l\\(bound\\|"
-   "en\\(\\|_trim\\)\\|g[et]\\|l[et]\\|og\\(\\|10\\|ical\\)\\)\\|m\\(a\\("
-   "tmul\\|x\\(\\|exponent\\|loc\\|val\\)\\)\\|erge\\|in\\(\\|exponent\\|"
-   "loc\\|val\\)\\|od\\(\\|ulo\\)\\|vbits\\)\\|n\\(earest\\|int\\|ot\\)\\|"
-   "p\\(ack\\|r\\(e\\(cision\\|sent\\)\\|oduct\\)\\)\\|r\\(a\\(dix\\|n\\("
-   "dom_\\(number\\|seed\\)\\|ge\\)\\)\\|e\\(peat\\|shape\\)\\|rspacing\\)\\|"
-   "s\\(ca\\(le\\|n\\)\\|e\\(lected_\\(int_kind\\|real_kind\\)\\|"
-   "t_exponent\\)\\|hape\\|i\\(gn\\|nh?\\|ze\\)\\|p\\(acing\\|read\\)\\|"
-   "qrt\\|um\\|ystem_clock\\)\\|t\\(anh?\\|iny\\|r\\(ans\\(fer\\|pose\\)\\|"
-   "im\\)\\)\\|u\\(bound\\|npack\\)\\|verify\\)[ \t]*(")
-  "Regexp whose first part matches F90 intrinsic procedures.")
-
-(defconst f90-operators-re
-;; "and" "or" "not" "eqv" "neqv" "eq" "ne" "lt" "le" "gt" "ge" "true" "false"
- (concat
-   "\\.\\(and\\|eqv?\\|false\\|g[et]\\|l[et]\\|n\\(e\\(\\|qv\\)\\|"
-   "ot\\)\\|or\\|true\\)\\.")
-  "Regexp matching intrinsic operators.")
-
-(defconst f90-hpf-keywords-re
-  ;; Intrinsic procedures
-  ;; ("all_prefix" "all_scatter" "all_suffix" "any_prefix" "any_scatter"
-  ;; "any_suffix" "copy_prefix" "copy_scatter" "copy_suffix" "count_prefix"
-  ;; "count_scatter" "count_suffix" "grade_down" "grade_up" "hpf_alignment"
-  ;; "hpf_template" "hpf_distribution" "iall" "iall_prefix" "iall_scatter"
-  ;; "iall_suffix" "iany" "iany_prefix" "iany_scatter" "iany_suffix" "iparity"
-  ;; "iparity_prefix" "iparity_scatter" "iparity_suffix" "leadz"
-  ;; "maxval_prefix" "maxval_scatter" "maxval_suffix" "minval_prefix"
-  ;; "minval_scatter" "minval_suffix" "parity" "parity_prefix"
-  ;; "parity_scatter" "parity_suffix" "popcnt" "poppar" "product_prefix"
-  ;; "product_scatter" "product_suffix" "sum_prefix" "sum_scatter"
-  ;; "sum_suffix" "ilen" "number_of_processors" "processors_shape")
-  ;; Directives
-  ;; ("align" "distribute" "dynamic" "inherit" "template" "processors"
-  ;; "realign" "redistribute" "independent")
-  ;; Keywords
-  ;; ("pure" "extrinsic" "new" "with" "onto" "block" "cyclic")
-  (concat
-   "\\<\\(a\\(l\\(ign\\|l_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|ny_\\("
-   "prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|block\\|c\\(o\\(py_\\(prefix\\|"
-   "s\\(catter\\|uffix\\)\\)\\|unt_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|"
-   "yclic\\)\\|d\\(istribute\\|ynamic\\)\\|extrinsic\\|grade_\\(down\\|"
-   "up\\)\\|hpf_\\(alignment\\|distribution\\|template\\)\\|i\\(a\\(ll\\(\\|"
-   "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|ny\\(\\|_\\(prefix\\|s\\("
-   "catter\\|uffix\\)\\)\\)\\)\\|len\\|n\\(dependent\\|herit\\)\\|parity\\(\\|"
-   "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\)\\|leadz\\|m\\(axval_\\("
-   "prefix\\|s\\(catter\\|uffix\\)\\)\\|inval_\\(prefix\\|s\\(catter\\|"
-   "uffix\\)\\)\\)\\|n\\(ew\\|umber_of_processors\\)\\|onto\\|p\\(arity\\(\\|"
-   "_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|op\\(cnt\\|par\\)\\|ro\\("
-   "cessors\\(\\|_shape\\)\\|duct_\\(prefix\\|s\\(catter\\|uffix\\)\\)\\)\\|"
-   "ure\\)\\|re\\(align\\|distribute\\)\\|sum_\\(prefix\\|s\\(catter\\|"
-   "uffix\\)\\)\\|template\\|with\\)\\>")
-  "Regexp for all HPF keywords, procedures and directives.")
-
-;; Highlighting patterns
-
-(defvar f90-font-lock-keywords-1
-  (list				; Emacs
-   '("\\<\\(end[ \t]*\\(program\\|module\\|function\\|subroutine\\|type\\)\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
-   '("\\<\\(program\\|call\\|module\\|subroutine\\|function\\|use\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-   ;; Special highlighting of "module procedure foo-list"
-   '("\\<\\(module[ \t]*procedure\\)\\>" (1 font-lock-keyword-face t))
-   ;; Highlight definition of new type
-   '("\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)"
-     (1 font-lock-keyword-face) (3 font-lock-function-name-face))
-   "\\<\\(\\(end[ \t]*\\)?\\(interface\\|block[ \t]*data\\)\\|contains\\)\\>")
-  "This does fairly subdued highlighting of comments and function calls.")
-
-(defvar f90-font-lock-keywords-2
-  (append f90-font-lock-keywords-1
-      (list
-       ;; Variable declarations (avoid the real function call)
-       '("^[ \t0-9]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\)\\(.*::\\|[ \t]*(.*)\\)?\\([^!\n]*\\)"
-	 (1 font-lock-type-face) (4 font-lock-variable-name-face))
-       ;; do, if, select, where, and forall constructs
-       '("\\<\\(end[ \t]*\\(do\\|if\\|select\\|forall\\|where\\)\\)\\>\\([ \t]+\\(\\sw+\\)\\)?"
-	 (1 font-lock-keyword-face) (3 font-lock-reference-face nil t))
-       '("^[ \t0-9]*\\(\\(\\sw+\\)[ \t]*:[ \t]*\\)?\\(\\(if\\|do\\([ \t]*while\\)?\\|select[ \t]*case\\|where\\|forall\\)\\)\\>"
-	 (2 font-lock-reference-face nil t) (3 font-lock-keyword-face))
-       ;; implicit declaration
-       '("\\<\\(implicit\\)[ \t]*\\(real\\|integer\\|c\\(haracter\\|omplex\\)\\|logical\\|type[ \t]*(\\sw+)\\|none\\)\\>" (1 font-lock-keyword-face) (2 font-lock-type-face))
-       '("\\<\\(namelist\\|common\\)[ \t]*\/\\(\\sw+\\)?\/" (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
-       "\\<else\\([ \t]*if\\|where\\)?\\>"
-       "\\<\\(then\\|continue\\|format\\|include\\|stop\\|return\\)\\>"
-       '("\\<\\(exit\\|cycle\\)[ \t]*\\(\\sw+\\)?\\>" 
-	 (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
-       '("\\<\\(case\\)[ \t]*\\(default\\|(\\)" . 1)
-       '("\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)"
-	 (1 font-lock-keyword-face) (2 font-lock-reference-face))
-       ;; line numbers (lines whose first character after number is letter)
-       '("^[ \t]*\\([0-9]+\\)[ \t]*[a-z]+" (1 font-lock-reference-face t))))
-  "Highlights declarations, do-loops and other constructions")
-
-(defvar f90-font-lock-keywords-3
-  (append f90-font-lock-keywords-2
-   (list
-    f90-keywords-level-3-re
-    f90-operators-re
-    (if (string-match "XEmacs" emacs-version)
-	(append (list f90-procedures-re) '(1 font-lock-keyword-face t))
-      (list f90-procedures-re '(1 font-lock-keyword-face t)))
-    "\\<real\\>"			; Avoid overwriting real defs.
-    ))
-  "Highlights all F90 keywords and intrinsic procedures.")
-
-(defvar f90-font-lock-keywords-4
-  (append f90-font-lock-keywords-3
-    (list f90-hpf-keywords-re))
-  "Highlights all F90 and HPF keywords.")
-
-(defvar f90-font-lock-keywords
-      f90-font-lock-keywords-2
-  "*Default expressions to highlight in F90 mode.")
-
-;; syntax table
-(defvar f90-mode-syntax-table nil
-  "Syntax table in use in F90 mode buffers.")
-
-(if f90-mode-syntax-table
-    ()
-  (setq f90-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\! "<" f90-mode-syntax-table)  ; beg. comment
-  (modify-syntax-entry ?\n ">" f90-mode-syntax-table)  ; end comment
-  (modify-syntax-entry ?_ "w" f90-mode-syntax-table)   ; underscore in names
-  (modify-syntax-entry ?\' "\"" f90-mode-syntax-table) ; string quote
-  (modify-syntax-entry ?\" "\"" f90-mode-syntax-table) ; string quote
-  (modify-syntax-entry ?\` "w" f90-mode-syntax-table)  ; for abbrevs
-  (modify-syntax-entry ?\r " " f90-mode-syntax-table)  ; return is whitespace
-  (modify-syntax-entry ?+ "." f90-mode-syntax-table)  
-  (modify-syntax-entry ?- "." f90-mode-syntax-table)
-  (modify-syntax-entry ?= "." f90-mode-syntax-table)
-  (modify-syntax-entry ?* "." f90-mode-syntax-table)
-  (modify-syntax-entry ?/ "." f90-mode-syntax-table)
-  (modify-syntax-entry ?\\ "/" f90-mode-syntax-table)) ; escape chars
-
-;; keys
-(defvar f90-mode-map ()
-  "Keymap used in F90 mode.")
-
-(if f90-mode-map
-    ()
-  (setq f90-mode-map (make-sparse-keymap))
-  (define-key f90-mode-map "`"        'f90-abbrev-start)
-  (define-key f90-mode-map "\C-c;"    'f90-comment-region)
-  (define-key f90-mode-map "\C-\M-a"  'f90-beginning-of-subprogram)
-  (define-key f90-mode-map "\C-\M-e"  'f90-end-of-subprogram)
-  (define-key f90-mode-map "\C-\M-h"  'f90-mark-subprogram)
-  (define-key f90-mode-map "\C-\M-q"  'f90-indent-subprogram)
-  (define-key f90-mode-map "\C-j"     'f90-indent-new-line) ; LFD equals C-j
-  (define-key f90-mode-map "\r"       'newline)
-  (define-key f90-mode-map "\C-c\r"   'f90-break-line)
-  ;;  (define-key f90-mode-map [M-return] 'f90-break-line)
-  (define-key f90-mode-map "\C-c\C-d" 'f90-join-lines)
-  (define-key f90-mode-map "\C-c\C-f" 'f90-fill-region)
-  (define-key f90-mode-map "\C-c\C-p" 'f90-previous-statement)
-  (define-key f90-mode-map "\C-c\C-n" 'f90-next-statement)
-  (define-key f90-mode-map "\C-c\C-w" 'f90-insert-end)
-  (define-key f90-mode-map "\t"       'f90-indent-line)
-  (define-key f90-mode-map ","        'f90-electric-insert)
-  (define-key f90-mode-map "+"        'f90-electric-insert)
-  (define-key f90-mode-map "-"        'f90-electric-insert)
-  (define-key f90-mode-map "*"        'f90-electric-insert)
-  (define-key f90-mode-map "/"        'f90-electric-insert))
-
- 
-;; menus
-(if (string-match "XEmacs" emacs-version)
-    (defvar f90-xemacs-menu
-      '("F90"
-	["Indent Subprogram"       f90-indent-subprogram t]
-	["Mark Subprogram"         f90-mark-subprogram t]
-	["Beginning of Subprogram" f90-beginning-of-subprogram t]
-	["End of Subprogram"       f90-end-of-subprogram t]
-	"-----"
-	["(Un)Comment Region"      f90-comment-region t]
-	["Indent Region"           indent-region t]
-	["Fill Region"             f90-fill-region t]
-	"-----"
-	["Break Line at Point"     f90-break-line t]
-	["Join with Next Line"     f90-join-lines t]
-	["Insert Newline"          newline t]
-	["Insert Block End"        f90-insert-end t]
-	"-----"
-	["Upcase Keywords (buffer)"      f90-upcase-keywords t]
-	["Upcase Keywords (region)"      f90-upcase-region-keywords
-	 t]
-	["Capitalize Keywords (buffer)"  f90-capitalize-keywords t]
-	["Capitalize Keywords (region)" 
-	 f90-capitalize-region-keywords t]
-	["Downcase Keywords (buffer)"    f90-downcase-keywords t]
-	["Downcase Keywords (region)"   
-	 f90-downcase-region-keywords t]
-	"-----"
-	["Toggle abbrev-mode"   abbrev-mode             t]
-	["Toggle auto-fill"     auto-fill-mode		t])
-      "XEmacs menu for F90 mode.")
-  ;; Emacs
-
-  (defvar f90-change-case-menu
-    (let ((map (make-sparse-keymap "Change Keyword Case")))
-      
-      (define-key map [dkr] (cons "Downcase Keywords (region)"
-				  'f90-downcase-region-keywords))
-      (put 'f90-downcase-region-keywords 'menu-enable 'mark-active)
-      
-      (define-key map [ckr] (cons "Capitalize Keywords (region)"
-				  'f90-capitalize-region-keywords))
-      (put 'f90-capitalize-region-keywords 'menu-enable 'mark-active)
-      
-      (define-key map [ukr] (cons "Upcase Keywords (region)"
-				  'f90-upcase-region-keywords))
-      (put 'f90-upcase-region-keywords 'menu-enable 'mark-active)
-      
-      (define-key map [line] (list "-----------------"))
-      
-      (define-key map [dkb] (cons "Downcase Keywords (buffer)"
-				  'f90-downcase-keywords))
-      
-      (define-key map [ckb] (cons "Capitalize Keywords (buffer)"
-				  'f90-capitalize-keywords))
-      
-      (define-key map [ukb] (cons "Upcase Keywords (buffer)"
-				  'f90-upcase-keywords))
-      map)
-    "Submenu for change of case.")
-  (defalias 'f90-change-case-menu f90-change-case-menu)
-
-  ;; font-lock-menu and function calls
-  (defalias 'f90-font-lock-on  'font-lock-mode)
-  (defalias 'f90-font-lock-off 'font-lock-mode)
-  (put 'f90-font-lock-on  'menu-enable 'font-lock-mode)
-  (put 'f90-font-lock-off 'menu-enable '(not font-lock-mode))
-  
-  (defun f90-font-lock-1 ()
-    (interactive)
-    "Set font-lock-keywords to f90-font-lock-keywords-1."
-    (font-lock-mode 1)
-    (setq font-lock-keywords f90-font-lock-keywords-1)
-    (font-lock-fontify-buffer))
-    
-  (defun f90-font-lock-2 ()
-    (interactive)
-    "Set font-lock-keywords to f90-font-lock-keywords-2."
-    (font-lock-mode 1)
-    (setq font-lock-keywords f90-font-lock-keywords-2)
-    (font-lock-fontify-buffer))
-    
-  (defun f90-font-lock-3 ()
-    (interactive)
-    "Set font-lock-keywords to f90-font-lock-keywords-3."
-    (font-lock-mode 1)
-    (setq font-lock-keywords f90-font-lock-keywords-3)
-    (font-lock-fontify-buffer))
-    
-  (defun f90-font-lock-4 ()
-    (interactive)
-    "Set font-lock-keywords to f90-font-lock-keywords-4."
-    (font-lock-mode 1)
-    (setq font-lock-keywords f90-font-lock-keywords-4)
-    (font-lock-fontify-buffer))
-    
-  (defvar f90-font-lock-menu
-    (let ((map (make-sparse-keymap "f90-font-lock-menu")))
-      (define-key map [h4] (cons "Maximum highlighting (level 4)"
-				 'f90-font-lock-4))
-      (define-key map [h3] (cons "Heavy highlighting (level 3)"
-				 'f90-font-lock-3))
-      (define-key map [h2] (cons "Default highlighting (level 2)"
-				 'f90-font-lock-2))
-      (define-key map [h1] (cons "Light highlighting (level 1)"
-				 'f90-font-lock-1))
-      (define-key map [line] (list "-----------------"))
-      (define-key map [floff] (cons "Turn off font-lock-mode"
-				    'f90-font-lock-on))
-      (define-key map [flon] (cons "Turn on font-lock-mode"
-				   'f90-font-lock-off))
-      map)
-    "Submenu for highlighting using font-lock-mode.")
-  (defalias 'f90-font-lock-menu f90-font-lock-menu)
-
-  (define-key f90-mode-map [menu-bar] (make-sparse-keymap))
-  (define-key f90-mode-map [menu-bar f90] 
-    (cons "F90" (make-sparse-keymap "f90"))) 
-
-  (define-key f90-mode-map [menu-bar f90 f90-imenu-menu]
-    '("Add imenu Menu" . f90-add-imenu-menu))
-  (define-key f90-mode-map [menu-bar f90 abbrev-mode]
-    '("Toggle abbrev-mode" . abbrev-mode))
-  (define-key f90-mode-map [menu-bar f90 auto-fill-mode]
-    '("Toggle auto-fill" . auto-fill-mode))
-  (define-key f90-mode-map [menu-bar f90 line1]
-    '("----"))
-  (define-key f90-mode-map [menu-bar f90 f90-change-case-menu]
-    (cons "Change Keyword Case" 'f90-change-case-menu))
-  (define-key f90-mode-map [menu-bar f90 f90-font-lock-menu]
-    (cons "Highlighting" 'f90-font-lock-menu))
-  (define-key f90-mode-map [menu-bar f90 line2]
-    '("----"))
-
-  (define-key f90-mode-map [menu-bar f90 f90-insert-end]
-    '("Insert Block End" . f90-insert-end))
-  (define-key f90-mode-map [menu-bar f90 f90-join-lines]
-    '("Join with Next Line" . f90-join-lines))
-  (define-key f90-mode-map [menu-bar f90 f90-break-line]
-    '("Break Line at Point" . f90-break-line))
-  
-  (define-key f90-mode-map [menu-bar f90 line3]
-    '("----"))
-  
-  (define-key f90-mode-map [menu-bar f90 f90-fill-region]
-    '("Fill Region" . f90-fill-region))
-  (put 'f90-fill-region 'menu-enable 'mark-active)
-  
-  (define-key f90-mode-map [menu-bar f90 indent-region]
-    '("Indent Region" . indent-region))
-  
-  (define-key f90-mode-map [menu-bar f90 f90-comment-region]
-    '("(Un)Comment Region" . f90-comment-region))
-  (put 'f90-comment-region 'menu-enable 'mark-active)
-  
-  (define-key f90-mode-map [menu-bar f90 line4]
-    '("----"))
-  
-  (define-key f90-mode-map [menu-bar f90 f90-end-of-subprogram]
-    '("End of Subprogram" . f90-end-of-subprogram))
-  (define-key f90-mode-map [menu-bar f90 f90-beginning-of-subprogram]
-    '("Beginning of Subprogram" . f90-beginning-of-subprogram))
-  (define-key f90-mode-map [menu-bar f90 f90-mark-subprogram]
-    '("Mark Subprogram" . f90-mark-subprogram))
-  (define-key f90-mode-map [menu-bar f90 f90-indent-subprogram]
-    '("Indent Subprogram" . f90-indent-subprogram))
-  )
-
-;; Regexps for finding program structures.
-(defconst f90-blocks-re 
-  "\\(block[ \t]*data\\|do\\|if\\|interface\\|function\\|module\\|\
-program\\|select\\|subroutine\\|type\\|where\\|forall\\)\\>")
-(defconst f90-program-block-re 
-  "\\(program\\|module\\|subroutine\\|function\\)")
-(defconst f90-else-like-re 
-  "\\(else\\([ \t]*if\\|where\\)?\\|case[ \t]*\\(default\\|(\\)\\)")
-(defconst f90-end-if-re 
-  "end[ \t]*\\(if\\|select\\|where\\|forall\\)\\>")
-(defconst f90-end-type-re 
-  "end[ \t]*\\(type\\|interface\\|block[ \t]*data\\)")
-(defconst f90-type-def-re
-  "\\<\\(type\\)[ \t]*\\(,.*::[ \t]*\\|[ \t]+\\)\\(\\sw+\\)")
-(defconst f90-no-break-re  "\\(\\*\\*\\|//\\|=>\\)")
-;; A temporary position to make region operators faster
-(defvar f90-cache-position nil)
-(make-variable-buffer-local 'f90-cache-position)
-;; A flag to tell whether f90-imenu is turned on.
-(defvar f90-imenu nil)
-(make-variable-buffer-local 'f90-imenu)
-
-
-;; Imenu support
-(defvar f90-imenu-generic-expression
-  (let ((good-char "[^!\"\&\n \t]") (not-e "[^e!\n\"\& \t]")
-	(not-n "[^n!\n\"\& \t]") (not-d "[^d!\n\"\& \t]"))
-    (list
-     '(nil "^[ \t0-9]*program[ \t]+\\(\\sw+\\)" 1)
-     '("Modules" "^[ \t0-9]*module[ \t]+\\(\\sw+\\)[ \t]*\\(!\\|$\\)" 1)
-     '("Types" "^[ \t0-9]*type[ \t]+\\(\\sw+\\)" 1)
-     (list
-      "Procedures" 
-      (concat
-       "^[ \t0-9]*"
-       "\\("
-       ;; At least three non-space characters before function/subroutine
-       ;; Check that the last three non-space characters don't spell E N D
-       "[^!\"\&\n]*\\("
-       not-e good-char good-char "\\|"
-       good-char not-n good-char "\\|"
-       good-char good-char not-d "\\)"
-       "\\|"
-       ;; Less than three non-space characters before function/subroutine
-       good-char "?" good-char "?"
-       "\\)"
-       "[ \t]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)")
-    4)))
-  "imenu generic expression for F90 mode.")
-
-(defun f90-add-imenu-menu ()
-  (interactive)
-  "Add an imenu menu to the menubar."
-  (if (not f90-imenu)
-      (progn
-	(imenu-add-to-menubar "F90-imenu")
-	(redraw-frame (selected-frame))
-	(setq f90-imenu t))
-    (message "%s" "F90-imenu already exists.")))
-(put 'f90-add-imenu-menu 'menu-enable '(not f90-imenu))
-
-
-;; When compiling under GNU Emacs, load imenu during compilation.  If
-;; you have 19.22 or earlier, comment this out, or get imenu.
-(and (fboundp 'eval-when-compile)
-     (eval-when-compile
-       (if (not (string-match "XEmacs" emacs-version))
-	   (require 'imenu))
-       ()))
-
-;; abbrevs have generally two letters, except standard types `c, `i, `r, `t
-(defvar f90-mode-abbrev-table nil)
-(if f90-mode-abbrev-table
-    ()
-  (let ((ac abbrevs-changed))
-    (define-abbrev-table 'f90-mode-abbrev-table ())
-    (define-abbrev f90-mode-abbrev-table  "`al"  "allocate" nil)
-    (define-abbrev f90-mode-abbrev-table  "`ab"  "allocatable" nil)
-    (define-abbrev f90-mode-abbrev-table  "`as"  "assignment" nil)
-    (define-abbrev f90-mode-abbrev-table  "`ba"  "backspace" nil)
-    (define-abbrev f90-mode-abbrev-table  "`bd"  "block data" nil)
-    (define-abbrev f90-mode-abbrev-table  "`c"   "character" nil)
-    (define-abbrev f90-mode-abbrev-table  "`cl"  "close" nil)
-    (define-abbrev f90-mode-abbrev-table  "`cm"  "common" nil)
-    (define-abbrev f90-mode-abbrev-table  "`cx"  "complex" nil)
-    (define-abbrev f90-mode-abbrev-table  "`cn"  "contains" nil)
-    (define-abbrev f90-mode-abbrev-table  "`cy"  "cycle" nil)
-    (define-abbrev f90-mode-abbrev-table  "`de"  "deallocate" nil)
-    (define-abbrev f90-mode-abbrev-table  "`df"  "define" nil)
-    (define-abbrev f90-mode-abbrev-table  "`di"  "dimension" nil)
-    (define-abbrev f90-mode-abbrev-table  "`dw"  "do while" nil)
-    (define-abbrev f90-mode-abbrev-table  "`el"  "else" nil)
-    (define-abbrev f90-mode-abbrev-table  "`eli" "else if" nil)
-    (define-abbrev f90-mode-abbrev-table  "`elw" "elsewhere" nil)
-    (define-abbrev f90-mode-abbrev-table  "`eq"  "equivalence" nil)
-    (define-abbrev f90-mode-abbrev-table  "`ex"  "external" nil)
-    (define-abbrev f90-mode-abbrev-table  "`ey"  "entry" nil)
-    (define-abbrev f90-mode-abbrev-table  "`fl"  "forall" nil)
-    (define-abbrev f90-mode-abbrev-table  "`fo"  "format" nil)
-    (define-abbrev f90-mode-abbrev-table  "`fu"  "function" nil)
-    (define-abbrev f90-mode-abbrev-table  "`fa"  ".false." nil)
-    (define-abbrev f90-mode-abbrev-table  "`im"  "implicit none" nil)
-    (define-abbrev f90-mode-abbrev-table  "`in " "include" nil)
-    (define-abbrev f90-mode-abbrev-table  "`i"   "integer" nil)
-    (define-abbrev f90-mode-abbrev-table  "`it"  "intent" nil)
-    (define-abbrev f90-mode-abbrev-table  "`if"  "interface" nil)
-    (define-abbrev f90-mode-abbrev-table  "`lo"  "logical" nil)
-    (define-abbrev f90-mode-abbrev-table  "`mo"  "module" nil)
-    (define-abbrev f90-mode-abbrev-table  "`na"  "namelist" nil)
-    (define-abbrev f90-mode-abbrev-table  "`nu"  "nullify" nil)
-    (define-abbrev f90-mode-abbrev-table  "`op"  "optional" nil)
-    (define-abbrev f90-mode-abbrev-table  "`pa"  "parameter" nil)
-    (define-abbrev f90-mode-abbrev-table  "`po"  "pointer" nil)
-    (define-abbrev f90-mode-abbrev-table  "`pr"  "print" nil)
-    (define-abbrev f90-mode-abbrev-table  "`pi"  "private" nil)
-    (define-abbrev f90-mode-abbrev-table  "`pm"  "program" nil)
-    (define-abbrev f90-mode-abbrev-table  "`pu"  "public" nil)
-    (define-abbrev f90-mode-abbrev-table  "`r"   "real" nil)
-    (define-abbrev f90-mode-abbrev-table  "`rc"  "recursive" nil)
-    (define-abbrev f90-mode-abbrev-table  "`rt"  "return" nil)
-    (define-abbrev f90-mode-abbrev-table  "`rw"  "rewind" nil)
-    (define-abbrev f90-mode-abbrev-table  "`se"  "select" nil)
-    (define-abbrev f90-mode-abbrev-table  "`sq"  "sequence" nil)
-    (define-abbrev f90-mode-abbrev-table  "`su"  "subroutine" nil)
-    (define-abbrev f90-mode-abbrev-table  "`ta"  "target" nil)
-    (define-abbrev f90-mode-abbrev-table  "`tr"  ".true." nil)
-    (define-abbrev f90-mode-abbrev-table  "`t"   "type" nil)
-    (define-abbrev f90-mode-abbrev-table  "`wh"  "where" nil)
-    (define-abbrev f90-mode-abbrev-table  "`wr"  "write" nil)
-    (setq abbrevs-changed ac)))
-
-;;;###autoload
-(defun f90-mode ()
-  "Major mode for editing Fortran 90 code in free format.
-
-\\[f90-indent-new-line] corrects current indentation and creates new\
- indented line.
-\\[f90-indent-line] indents the current line correctly. 
-\\[f90-indent-subprogram] indents the current subprogram. 
-
-Type `? or `\\[help-command] to display a list of built-in\
- abbrevs for F90 keywords.
-
-Key definitions:
-\\{f90-mode-map}
-
-Variables controlling indentation style and extra features:
-
- f90-do-indent
-    Extra indentation within do blocks.  (default 3)
- f90-if-indent
-    Extra indentation within if/select case/where/forall blocks. (default 3)
- f90-type-indent
-    Extra indentation within type/interface/block-data blocks.  (default 3)
- f90-program-indent
-    Extra indentation within program/module/subroutine/function blocks.
-      (default 2)
- f90-continuation-indent
-    Extra indentation applied to continuation lines.  (default 5)
- f90-comment-region
-    String inserted by \\[f90-comment-region] at start of each line in 
-    region.  (default \"!!!$\")
- f90-indented-comment-re
-    Regexp determining the type of comment to be intended like code.
-    (default \"!\")
- f90-directive-comment-re
-    Regexp of comment-like directive like \"!HPF\\\\$\", not to be indented.
-    (default \"!hpf\\\\$\")
- f90-break-delimiters
-    Regexp holding list of delimiters at which lines may be broken.
-    (default \"[-+*/><=,% \\t]\")
- f90-break-before-delimiters
-    Non-nil causes `f90-do-auto-fill' to break lines before delimiters.
-    (default t)
- f90-beginning-ampersand 
-    Automatic insertion of \& at beginning of continuation lines. (default t)
- f90-smart-end 
-    From an END statement, check and fill the end using matching block start.
-    Allowed values are 'blink, 'no-blink, and nil, which determine
-    whether to blink the matching beginning.) (default 'blink)
- f90-auto-keyword-case
-    Automatic change of case of keywords. (default nil)
-    The possibilities are 'downcase-word, 'upcase-word, 'capitalize-word.
- f90-leave-line-no
-    Do not left-justify line numbers. (default nil)
- f90-startup-message
-    Set to nil to inhibit message first time F90 mode is used. (default t)
- f90-keywords-re
-    List of keywords used for highlighting/upcase-keywords etc.
-
-Turning on F90 mode calls the value of the variable `f90-mode-hook'
-with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (setq major-mode 'f90-mode)
-  (setq mode-name "F90")
-  (setq local-abbrev-table f90-mode-abbrev-table)
-  (set-syntax-table f90-mode-syntax-table)
-  (use-local-map f90-mode-map)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'f90-indent-line)
-  (make-local-variable 'indent-region-function)
-  (setq indent-region-function 'f90-indent-region)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "!")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "!+ *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'f90-comment-indent)
-  (make-local-variable 'abbrev-all-caps)
-  (setq abbrev-all-caps t)
-  (make-local-variable 'normal-auto-fill-function)
-  (setq normal-auto-fill-function 'f90-do-auto-fill)
-  (setq indent-tabs-mode nil)
-  ;; Setting up things for font-lock
-  (if (string-match "XEmacs" emacs-version)
-      (progn
-	(put 'f90-mode 'font-lock-keywords-case-fold-search t)
-	(if (and current-menubar
-		 (not (assoc "F90" current-menubar)))
-	    (progn
-	      (set-buffer-menubar (copy-sequence current-menubar))
-	      (add-submenu nil f90-xemacs-menu)))
-	(make-local-variable 'font-lock-keywords)
-	(setq font-lock-keywords f90-font-lock-keywords))
-    ;; Emacs
-    (make-local-variable 'font-lock-defaults)
-    (setq font-lock-defaults '(f90-font-lock-keywords nil t))
-
-    ;; Tell imenu how to handle f90.
-    (make-local-variable 'imenu-generic-expression)
-    (setq imenu-generic-expression f90-imenu-generic-expression))
-  (run-hooks 'f90-mode-hook)
-  (if f90-startup-message
-      (message "Emacs F90 mode; please report bugs to %s" bug-f90-mode))
-  (setq f90-startup-message nil))
-
-;; inline-functions
-(defsubst f90-get-beg-of-line ()
-  (save-excursion (beginning-of-line) (point)))
-
-(defsubst f90-get-end-of-line ()
-  (save-excursion (end-of-line) (point)))
-
-(defsubst f90-in-string ()
-  (let ((beg-pnt
-	 (if (and f90-cache-position (> (point) f90-cache-position))
-	     f90-cache-position
-	   (point-min))))
-    (nth 3 (parse-partial-sexp beg-pnt (point)))))
-	    
-(defsubst f90-in-comment ()
-  (let ((beg-pnt
-	 (if (and f90-cache-position (> (point) f90-cache-position))
-	     f90-cache-position
-	   (point-min))))
-    (nth 4 (parse-partial-sexp beg-pnt (point)))))
-
-(defsubst f90-line-continued ()
-  (save-excursion
-    (let ((bol (f90-get-beg-of-line)))
-      (end-of-line)
-      (while (f90-in-comment)
-	(search-backward "!" bol)
-	(skip-chars-backward "!"))
-      (skip-chars-backward " \t")
-      (= (preceding-char) ?&))))
-
-(defsubst f90-current-indentation ()
-  "Return indentation of current line.
-Line-numbers are considered whitespace characters."
-  (save-excursion
-    (beginning-of-line) (skip-chars-forward " \t0-9")
-    (current-column)))
-
-(defsubst f90-indent-to (col &optional no-line-number)
-  "Indent current line to column COL.
-If no-line-number nil, jump over a possible line-number."
-  (beginning-of-line)
-  (if (not no-line-number)
-      (skip-chars-forward " \t0-9"))
-  (delete-horizontal-space)
-  (if (zerop (current-column))
-      (indent-to col)
-    (indent-to col 1)))
-
-(defsubst f90-match-piece (arg)
-  (if (match-beginning arg)
-      (buffer-substring (match-beginning arg) (match-end arg))))
-
-(defsubst f90-get-present-comment-type ()
-  (save-excursion
-    (let ((type nil) (eol (f90-get-end-of-line)))
-      (if (f90-in-comment)
-	  (progn
-	    (beginning-of-line)
-	    (re-search-forward "[!]+" eol)
-	    (while (f90-in-string)
-	      (re-search-forward "[!]+" eol))
-	    (setq type (buffer-substring (match-beginning 0) (match-end 0)))))
-      type)))
-
-(defsubst f90-equal-symbols (a b)
-  "Compare strings neglecting case and allowing for nil value."
-  (let ((a-local (if a (downcase a) nil))
-	(b-local (if b (downcase b) nil)))
-    (equal a-local b-local)))
-
-;; XEmacs 19.11 & 19.12 gives back a single char when matching an empty regular
-;; expression. Therefore, the next 2 functions are longer than necessary.
-
-(defsubst f90-looking-at-do ()
-  "Return (\"do\" name) if a do statement starts after point.
-Name is nil if the statement has no label."
-  (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(do\\)\\>")
-      (let (label
-	    (struct (f90-match-piece 3)))
-	(if (looking-at "\\(\\sw+\\)[ \t]*\:")
-	    (setq label (f90-match-piece 1)))
-	(list struct label))))
-
-(defsubst f90-looking-at-select-case ()
-  "Return (\"select\" name) if a select-case statement starts after point.
-Name is nil if the statement has no label."
-  (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(select\\)[ \t]*case[ \t]*(")
-      (let (label
-	    (struct (f90-match-piece 3)))
-	(if (looking-at "\\(\\sw+\\)[ \t]*\:")
-	    (setq label (f90-match-piece 1)))
-	(list struct label))))
-
-(defsubst f90-looking-at-if-then ()
-  "Return (\"if\" name) if an if () then statement starts after point.
-Name is nil if the statement has no label."
-  (save-excursion
-    (let (struct (label nil))
-      (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(if\\)\\>")
-	  (progn
-	    (setq struct (f90-match-piece 3))
-	    (if (looking-at "\\(\\sw+\\)[ \t]*\:")
-		(setq label (f90-match-piece 1)))
-	    (goto-char (scan-lists (point) 1 0))
-	    (skip-chars-forward " \t")
-	    (if (or (looking-at "then\\>")
-		    (if (f90-line-continued)
-			(progn
-			  (f90-next-statement)
-			  (skip-chars-forward " \t0-9&")
-			  (looking-at "then\\>"))))
-		(list struct label)))))))
-
-(defsubst f90-looking-at-where-or-forall ()
-  "Return (kind name) if a where or forall statement starts after point.
-Name is nil if the statement has no label."
-  (if (looking-at "\\(\\(\\sw+\\)[ \t]*\:\\)?[ \t]*\\(where\\|forall\\)[ \t]*(")
-      (let (label
-	    (struct (f90-match-piece 3)))
-	(if (looking-at "\\(\\sw+\\)[ \t]*\:")
-	    (setq label (f90-match-piece 1)))
-	(list struct label))))
-
-(defsubst f90-looking-at-type-like ()
-  "Return (kind name) at the start of a type/interface/block-data block.
-Name is non-nil only for type."
-  (cond 
-   ((looking-at f90-type-def-re)
-    (list (f90-match-piece 1) (f90-match-piece 3)))
-   ((looking-at "\\(interface\\|block[\t]*data\\)\\>")
-    (list (f90-match-piece 1) nil))))
-
-(defsubst f90-looking-at-program-block-start ()
-  "Return (kind name) if a program block with name name starts after point."
-  (cond
-   ((looking-at "\\(program\\)[ \t]+\\(\\sw+\\)\\>")
-    (list (f90-match-piece 1) (f90-match-piece 2)))
-   ((and (not (looking-at "module[ \t]*procedure\\>"))
-	 (looking-at "\\(module\\)[ \t]+\\(\\sw+\\)\\>"))
-    (list (f90-match-piece 1) (f90-match-piece 2)))
-   ((and (not (looking-at "end[ \t]*\\(function\\|subroutine\\)"))
-	 (looking-at "[^!\"\&\n]*\\(function\\|subroutine\\)[ \t]+\\(\\sw+\\)"))
-    (list (f90-match-piece 1) (f90-match-piece 2)))))
-
-(defsubst f90-looking-at-program-block-end ()
-  "Return list of type and name of end of block."
-  (if (looking-at (concat "end[ \t]*" f90-blocks-re 
-			  "?\\([ \t]+\\(\\sw+\\)\\)?\\>"))
-      (list (f90-match-piece 1) (f90-match-piece 3))))
-
-(defsubst f90-comment-indent ()
-  (cond ((looking-at "!!!") 0)
-	((and f90-directive-comment-re
-	      (looking-at f90-directive-comment-re)) 0)
-	((looking-at (regexp-quote f90-comment-region)) 0)
-	((looking-at f90-indented-comment-re)
-	 (f90-calculate-indent))
-	(t (skip-chars-backward " \t")
-	   (max (if (bolp) 0 (1+ (current-column))) comment-column))))
-
-(defsubst f90-present-statement-cont ()
-  "Return continuation properties of present statement."
-  (let (pcont cont)
-    (save-excursion
-      (setq pcont (if (f90-previous-statement) (f90-line-continued) nil)))
-    (setq cont (f90-line-continued))
-    (cond ((and (not pcont) (not cont)) 'single)
- 	  ((and (not pcont) cont)       'begin)
- 	  ((and pcont       (not cont)) 'end)
- 	  ((and pcont       cont)       'middle)
- 	  (t (error)))))
-
-(defsubst f90-indent-line-no ()
-  (if f90-leave-line-no
-      ()
-    (if (and (not (zerop (skip-chars-forward " \t")))
-	     (looking-at "[0-9]"))
-	(delete-horizontal-space)))
-  (skip-chars-forward " \t0-9"))
-
-(defsubst f90-no-block-limit ()
-  (let ((eol (f90-get-end-of-line)))
-    (save-excursion
-      (not (or (looking-at "end")
-	       (looking-at "\\(do\\|if\\|else\\(if\\|where\\)?\
-\\|select[ \t]*case\\|case\\|where\\|forall\\)\\>")
-	       (looking-at "\\(program\\|module\\|interface\\|\
-block[ \t]*data\\)\\>")
-	       (looking-at "\\(contains\\|\\sw+[ \t]*:\\)")
-	       (looking-at f90-type-def-re)
-	       (re-search-forward "\\(function\\|subroutine\\)" eol t))))))
-
-(defsubst f90-update-line ()
-  (let (bol eol)
-    (if f90-auto-keyword-case
-	(progn (setq bol (f90-get-beg-of-line)
-		     eol (f90-get-end-of-line))
-	       (if f90-auto-keyword-case
-		   (f90-change-keywords f90-auto-keyword-case bol eol))))))
-
-(defun f90-electric-insert ()
-  (interactive)
-  "Calls f90-do-auto-fill at each operator insertion."
-  (self-insert-command 1)
-  (f90-update-line)
-  (if auto-fill-function (f90-do-auto-fill)))
-
-(defun f90-get-correct-indent ()
-  "Get correct indent for a line starting with line number.
-Does not check type and subprogram indentation."
-  (let ((epnt (f90-get-end-of-line)) icol cont)
-    (save-excursion
-      (while (and (f90-previous-statement)
-		  (or (progn
-			(setq cont (f90-present-statement-cont))
-			(or (eq cont 'end) (eq cont 'middle)))
-		      (looking-at "[ \t]*[0-9]"))))
-      (setq icol (current-indentation))
-      (beginning-of-line)
-      (if (re-search-forward "\\(if\\|do\\|select\\|where\\|forall\\)"
-			     (f90-get-end-of-line) t)
-	  (progn
-	    (beginning-of-line) (skip-chars-forward " \t")
-	    (cond ((f90-looking-at-do)
-		   (setq icol (+ icol f90-do-indent)))
-		  ((or (f90-looking-at-if-then)
-		       (f90-looking-at-where-or-forall)
-		       (f90-looking-at-select-case))
-		   (setq icol (+ icol f90-if-indent))))
-	    (end-of-line)))
-      (while (re-search-forward
-	      "\\(if\\|do\\|select\\|where\\|forall\\)" epnt t)
-	(beginning-of-line) (skip-chars-forward " \t0-9")
-	(cond  ((f90-looking-at-do)
-		(setq icol (+ icol f90-do-indent)))
-	       ((or (f90-looking-at-if-then)
-		    (f90-looking-at-where-or-forall)
-		    (f90-looking-at-select-case))
-		(setq icol (+ icol f90-if-indent)))
-	       ((looking-at f90-end-if-re)
-		(setq icol (- icol f90-if-indent)))
-	       ((looking-at "end[ \t]*do\\>")
-		(setq icol (- icol f90-do-indent))))
-	(end-of-line))
-      icol)))
-	       
-	  
-(defun f90-calculate-indent ()
-  "Calculate the indent column based on previous statements."
-  (interactive)
-  (let (icol cont (case-fold-search t) (pnt (point)))
-    (save-excursion
-      (if (not (f90-previous-statement))
-	  (setq icol 0)
-	(setq cont (f90-present-statement-cont))
-	(if (eq cont 'end)
-	    (while (not (eq 'begin (f90-present-statement-cont)))
-	      (f90-previous-statement)))
-	(cond ((eq cont 'begin)
-	       (setq icol (+ (f90-current-indentation)
-			     f90-continuation-indent)))
-	      ((eq cont 'middle) (setq icol(current-indentation)))
-	      (t (setq icol (f90-current-indentation))
-		 (skip-chars-forward " \t")
-		 (if (looking-at "[0-9]")
-		     (setq icol (f90-get-correct-indent))
-		   (cond ((or (f90-looking-at-if-then)
-			      (f90-looking-at-where-or-forall)
-			      (f90-looking-at-select-case)
-			      (looking-at f90-else-like-re))		       
-			  (setq icol (+ icol f90-if-indent)))
-			 ((f90-looking-at-do)
-			  (setq icol (+ icol f90-do-indent)))
-			 ((f90-looking-at-type-like)
-			  (setq icol (+ icol f90-type-indent)))
-			 ((or (f90-looking-at-program-block-start)
-			      (looking-at "contains[ \t]*\\($\\|!\\)"))
-			  (setq icol (+ icol f90-program-indent)))))
-		 (goto-char pnt)
-		 (beginning-of-line)
-		 (cond ((looking-at "[ \t]*$"))
-		       ((looking-at "[ \t]*#") ; Check for cpp directive.
-			(setq icol 0))
-		       (t
-			(skip-chars-forward " \t0-9")
-			(cond ((or (looking-at f90-else-like-re)
-				   (looking-at f90-end-if-re))
-			       (setq icol (- icol f90-if-indent)))
-			      ((looking-at "end[ \t]*do\\>")
-			       (setq icol (- icol f90-do-indent)))
-			      ((looking-at f90-end-type-re)
-			       (setq icol (- icol f90-type-indent)))
-			      ((or (looking-at "contains[ \t]*\\(!\\|$\\)")
-				   (f90-looking-at-program-block-end))
-			       (setq icol (- icol f90-program-indent))))))
-		 ))))
-    icol))
-
-;; Statement = statement line, a line which is neither blank, nor a comment.
-(defun f90-previous-statement ()
-  "Move point to beginning of the previous F90 statement.
-Return nil if no previous statement is found."
-  (interactive)
-  (let (not-first-statement)
-    (beginning-of-line)
-    (while (and (setq not-first-statement (zerop (forward-line -1)))
-		(looking-at "[ \t0-9]*\\(!\\|$\\|#\\)")))
-    not-first-statement))
-
-(defun f90-next-statement ()
-  "Move point to beginning of the next F90 statement.
-Return nil if no later statement is found."
-  (interactive)
-  (let (not-last-statement)
-    (beginning-of-line)
-    (while (and (setq not-last-statement
-		      (and (zerop (forward-line 1))
-			   (not (eobp))))
- 		(looking-at "[ \t0-9]*\\(!\\|$\\)")))
-    not-last-statement))
-
-(defun f90-beginning-of-subprogram ()
-  "Move point to the beginning of subprogram.
-Return (type name) or nil if not found."
-  (interactive)
-  (let ((count 1) (case-fold-search t) matching-beg)
-    (beginning-of-line) (skip-chars-forward " \t0-9")
-    (if (setq matching-beg (f90-looking-at-program-block-start)) 
-	(setq count (- count 1)))
-    (while (and (not (zerop count))
-		(re-search-backward f90-program-block-re nil 'move))
-      (beginning-of-line) (skip-chars-forward " \t0-9")
-      (cond 
-       ((setq matching-beg (f90-looking-at-program-block-start))
-	(setq count (- count 1)))
-       ((f90-looking-at-program-block-end)
-	(setq count (+ count 1)))))
-    (beginning-of-line)
-    (if (zerop count)
-	matching-beg
-      (message "No beginning-found.")
-      nil)))
-
-(defun f90-end-of-subprogram ()
-  "Move point to the end of subprogram.
-Return (type name) or nil if not found."
-  (interactive)
-  (let ((count 1) (case-fold-search t) matching-end)
-    (beginning-of-line) (skip-chars-forward " \t0-9")
-    (if (setq matching-end (f90-looking-at-program-block-end))
-	(setq count (1- count)))
-    (end-of-line)
-    (while (and (not (zerop count))
-		(re-search-forward f90-program-block-re nil 'move))
-      (beginning-of-line) (skip-chars-forward " \t0-9")
-      (cond ((f90-looking-at-program-block-start)
-	     (setq count (+ count 1)))
-	    ((setq matching-end (f90-looking-at-program-block-end))
-	     (setq count (1- count ))))
-      (end-of-line))
-    (forward-line 1)
-    (if (zerop count)
-	matching-end
-      (message "No end found.")
-      nil)))
-
-(defun f90-mark-subprogram ()
-  "Put mark at end of F90 subprogram, point at beginning.
-Marks are pushed and highlight (grey shadow) is turned on."
-  (interactive)
-  (let ((pos (point)) program)
-    (f90-end-of-subprogram)
-    (push-mark (point) t)
-    (goto-char pos)
-    (setq program (f90-beginning-of-subprogram))
-    ;; The keywords in the preceding lists assume case-insensitivity.
-    (if (string-match "XEmacs" emacs-version)
-	(zmacs-activate-region)
-      (setq mark-active t)
-      (setq deactivate-mark nil))
-    program))
-
-(defun f90-comment-region (beg-region end-region)
-  "Comment/uncomment every line in the region.
-Insert f90-comment-region at the beginning of every line in the region
-or, if already present, remove it."
-  (interactive "*r")
-  (let ((end (make-marker)))
-    (set-marker end end-region)
-    (goto-char beg-region)
-    (beginning-of-line)
-    (if (looking-at (regexp-quote f90-comment-region))
-	(delete-region (point) (match-end 0))
-      (insert f90-comment-region))
-    (while (and  (zerop (forward-line 1))
-		 (< (point) (marker-position end)))
-      (if (looking-at (regexp-quote f90-comment-region))
-	  (delete-region (point) (match-end 0))
-	(insert f90-comment-region)))
-    (set-marker end nil)))
-
-(defun f90-indent-line (&optional no-update)
-  "Indent current line as F90 code."
-  (interactive)
-  (let (indent (no-line-number nil) (pos (make-marker)) (case-fold-search t))
-    (set-marker pos (point))
-    (beginning-of-line)			; Digits after & \n are not line-no
-    (if (save-excursion (and (f90-previous-statement) (f90-line-continued)))
-	(progn (setq no-line-number t) (skip-chars-forward " \t"))
-      (f90-indent-line-no))
-    (if (looking-at "!")
-	(setq indent (f90-comment-indent))
-      (if (and (looking-at "end") f90-smart-end)
-	    (f90-match-end))
-      (setq indent (f90-calculate-indent)))
-    (if (zerop (- indent (current-column)))
-	nil
-      (f90-indent-to indent no-line-number))
-    ;; If initial point was within line's indentation,
-    ;; position after the indentation.  Else stay at same point in text.
-    (if (< (point) (marker-position pos))
-	(goto-char (marker-position pos)))
-    (if (not no-update) (f90-update-line))
-    (if auto-fill-function (f90-do-auto-fill))
-    (set-marker pos nil)))
-
-(defun f90-indent-new-line ()
-  "Reindent the current F90 line, insert a newline and indent the newline.
-An abbrev before point is expanded if `abbrev-mode' is non-nil.
-If run in the middle of a line, the line is not broken."
-  (interactive)
-  (let (string cont (case-fold-search t))
-    (if abbrev-mode (expand-abbrev))
-    (beginning-of-line)			; Reindent where likely to be needed.
-    (f90-indent-line-no)
-    (if (or (looking-at "\\(end\\|else\\|!\\)"))
-	(f90-indent-line 'no-update))
-    (end-of-line)
-    (delete-horizontal-space)		;Destroy trailing whitespace
-    (setq string (f90-in-string))
-    (setq cont (f90-line-continued))
-    (if (and string (not cont)) (insert "&"))
-    (f90-update-line)
-    (newline)
-    (if (or string (and cont f90-beginning-ampersand)) (insert "&"))
-    (f90-indent-line 'no-update)))
-
-
-(defun f90-indent-region (beg-region end-region)
-  "Indent every line in region by forward parsing."
-  (interactive "*r")
-  (let ((end-region-mark (make-marker)) (save-point (point-marker))
-	(block-list nil) ind-lev ind-curr ind-b cont
-	struct beg-struct end-struct)
-    (set-marker end-region-mark end-region)
-    (goto-char beg-region)
-    ;; first find a line which is not a continuation line or comment
-    (beginning-of-line)
-    (while (and (looking-at "[ \t]*[0-9]*\\(!\\|#\\|[ \t]*$\\)")
-		(progn (f90-indent-line 'no-update)
-		       (zerop (forward-line 1)))
-		(< (point) end-region-mark)))
-    (setq cont (f90-present-statement-cont))
-    (while (and (or (eq cont 'middle) (eq cont 'end))
-		(f90-previous-statement))
-      (setq cont (f90-present-statement-cont)))
-    ;; process present line for beginning of block
-    (setq f90-cache-position (point))
-    (f90-indent-line 'no-update)
-    (setq ind-lev (f90-current-indentation))
-    (setq ind-curr ind-lev)
-    (beginning-of-line) (skip-chars-forward " \t0-9")
-    (setq struct nil)
-    (setq ind-b (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
-		      ((or (setq struct (f90-looking-at-if-then))
-			   (setq struct (f90-looking-at-select-case))
-			   (setq struct (f90-looking-at-where-or-forall))
-			   (looking-at f90-else-like-re))
-		       f90-if-indent)
-		      ((setq struct (f90-looking-at-type-like))
-		       f90-type-indent)
-		      ((or(setq struct (f90-looking-at-program-block-start))
-			  (looking-at "contains[ \t]*\\($\\|!\\)"))
-		       f90-program-indent)))
-    (if ind-b (setq ind-lev (+ ind-lev ind-b)))
-    (if struct (setq block-list (cons struct block-list)))
-    (while (and (f90-line-continued) (zerop (forward-line 1))
-		(< (point) end-region-mark))
-      (if (not (zerop (- (current-indentation) 
-			 (+ ind-curr f90-continuation-indent))))
-	  (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no)))
-    ;; process all following lines
-    (while (and  (zerop (forward-line 1)) (< (point) end-region-mark))
-      (beginning-of-line)
-      (f90-indent-line-no)
-      (setq f90-cache-position (point))
-      (cond ((looking-at "[ \t]*$") (setq ind-curr 0))
-	    ((looking-at "[ \t]*#") (setq ind-curr 0))
-	    ((looking-at "!") (setq ind-curr (f90-comment-indent)))
-	    ((f90-no-block-limit) (setq ind-curr ind-lev))
-	    ((looking-at f90-else-like-re) (setq ind-curr
-						 (- ind-lev f90-if-indent)))
-	    ((looking-at "contains[ \t]*\\($\\|!\\)")
-	     (setq ind-curr (- ind-lev f90-program-indent)))
-	    ((setq ind-b
-		   (cond ((setq struct (f90-looking-at-do)) f90-do-indent)
-			 ((or (setq struct (f90-looking-at-if-then))
-			      (setq struct (f90-looking-at-select-case))
-			      (setq struct (f90-looking-at-where-or-forall)))
-			  f90-if-indent)
-			 ((setq struct (f90-looking-at-type-like))
-			  f90-type-indent)
-			 ((setq struct (f90-looking-at-program-block-start))
-			  f90-program-indent)))
-	     (setq ind-curr ind-lev)
-	     (if ind-b (setq ind-lev (+ ind-lev ind-b)))
-	     (setq block-list (cons struct block-list)))
-	    ((setq end-struct (f90-looking-at-program-block-end))
-	     (setq beg-struct (car block-list)
-		   block-list (cdr block-list))
-	     (if f90-smart-end 
-		 (save-excursion
-		   (f90-block-match (car beg-struct)(car (cdr beg-struct))
-				    (car end-struct)(car (cdr end-struct)))))
-	     (setq ind-b
-		   (cond ((looking-at f90-end-if-re) f90-if-indent)
-			 ((looking-at "end[ \t]*do\\>")  f90-do-indent)
-			 ((looking-at f90-end-type-re) f90-type-indent)
-			 ((f90-looking-at-program-block-end)
-			  f90-program-indent)))
-	     (if ind-b (setq ind-lev (- ind-lev ind-b)))
-	     (setq ind-curr ind-lev))
-	    (t (setq ind-curr ind-lev)))
-      ;; do the indentation if necessary
-      (if (not (zerop (- ind-curr (current-column))))
-	  (f90-indent-to ind-curr))
-      (while (and (f90-line-continued) (zerop (forward-line 1))
-		  (< (point) end-region-mark))
-	(if (not (zerop (- (current-indentation) 
-			   (+ ind-curr f90-continuation-indent))))
-	    (f90-indent-to (+ ind-curr f90-continuation-indent) 'no-line-no))))
-    ;; restore point etc
-    (setq f90-cache-position nil)
-    (goto-char save-point)
-    (set-marker end-region-mark nil)
-    (set-marker save-point nil)
-    (if (string-match "XEmacs" emacs-version)
-	(zmacs-deactivate-region)
-      (deactivate-mark))))
-
-(defun f90-indent-subprogram ()
-  "Properly indent the subprogram which contains point."
-  (interactive)
-  (save-excursion
-    (let (program)
-      (setq program (f90-mark-subprogram))
-      (if program
-	  (progn
-	    (message "Indenting %s %s..."
-		     (car program) (car (cdr program)))
-	    (f90-indent-region (point) (mark))
-	    (message "Indenting %s %s...done"
-		     (car program) (car (cdr program))))
-	(message "Indenting the whole file...")
-	(f90-indent-region (point) (mark))
-	(message "Indenting the whole file...done")))))
-
-;; autofill and break-line
-(defun f90-break-line (&optional no-update)
-  "Break line at point, insert continuation marker(s) and indent."
-  (interactive)
-  (let (ctype)
-    (cond ((f90-in-string)
-	   (insert "&") (newline) (insert "&"))
-	  ((f90-in-comment)
-	   (setq ctype (f90-get-present-comment-type))
-	   (newline)
-	   (insert ctype))
-	  (t (insert "&")
-	     (if (not no-update) (f90-update-line))
-	     (newline)
-	     (if f90-beginning-ampersand (insert "&")))))
-  (f90-indent-line))
-  
-(defun f90-find-breakpoint ()
-  "From fill-column, search backward for break-delimiter."
-  (let ((bol (f90-get-beg-of-line)))
-    (re-search-backward f90-break-delimiters bol)
-    (if f90-break-before-delimiters
-	(progn (backward-char)
-	       (if (not (looking-at f90-no-break-re))
-		   (forward-char)))
-      (if (looking-at f90-no-break-re)
-	  (forward-char 2)
-	(forward-char)))))
-
-(defun f90-do-auto-fill ()
-  "Break line if non-white characters beyond fill-column. Also, update line. "
-  (interactive)
-  ;; Break the line before or after the last delimiter (non-word char) if
-  ;; position is beyond fill-column.
-  ;; Will not break **, //, or => (specified by f90-no-break-re).
-  (f90-update-line)
-  (while (> (current-column) fill-column)
-      (let ((pos-mark (point-marker)))
-	(move-to-column fill-column)
-	(if (not (f90-in-string))
-	    (f90-find-breakpoint))
-	(f90-break-line)
-	(goto-char pos-mark)
-	(set-marker pos-mark nil))))
-
-
-(defun f90-join-lines ()
-  "Join present line with next line, if this line ends with \&."
-  (interactive)
-  (let (pos (oldpos (point)))
-    (end-of-line)
-    (skip-chars-backward " \t")
-    (cond ((= (preceding-char) ?&)
-	   (delete-char -1)
-	   (setq pos (point))
-	   (forward-line 1)
-	   (skip-chars-forward " \t")
-	   (if (looking-at "\&") (delete-char 1))
-	   (delete-region pos (point))
-	   (if (not (f90-in-string))
-	       (progn (delete-horizontal-space) (insert " ")))
-	   (if (and auto-fill-function
-		    (> (save-excursion (end-of-line)
-				       (current-column))
-		       fill-column))
-	       (f90-do-auto-fill))
-	   (goto-char oldpos)
-	   t))))
-
-(defun f90-fill-region (beg-region end-region)
-  "Fill every line in region by forward parsing. Join lines if possible."
-  (interactive "*r")
-  (let ((end-region-mark (make-marker))
-	(f90-smart-end nil) (f90-auto-keyword-case nil) (go-on t)
-	(auto-fill-function nil))
-    (set-marker end-region-mark end-region)
-    (goto-char beg-region)
-    (while go-on
-      ;; join as much as possible
-      (while (f90-join-lines))
-      ;; chop the line if necessary
-      (while (> (save-excursion (end-of-line) (current-column))
-		fill-column)
-	(move-to-column fill-column)
-	(f90-find-breakpoint)
-	(f90-break-line 'no-update))
-      (setq go-on (and  (< (point) (marker-position end-region-mark))
-			(zerop (forward-line 1))))
-      (setq f90-cache-position (point)))
-    (setq f90-cache-position nil)
-    (if (string-match "XEmacs" emacs-version)
-	(zmacs-deactivate-region)
-      (deactivate-mark))))
-
-(defun f90-block-match (beg-block beg-name end-block end-name)
-  "Match end-struct with beg-struct and complete end-block if possible.
-Leave point at the end of line."
-  (search-forward "end" (f90-get-end-of-line))
-  (catch 'no-match
-    (if (not (f90-equal-symbols beg-block end-block))
-	(if end-block
-	    (progn
-	      (message "END %s does not match %s." end-block beg-block)
-	      (end-of-line) 
-	      (throw 'no-match nil))
-	  (message "Inserting %s." beg-block)
-	  (insert (concat " " beg-block)))
-      (search-forward end-block))
-    (if (not (f90-equal-symbols beg-name end-name))
-	(cond ((and beg-name (not end-name)) 
-	       (message "Inserting %s." beg-name)
-	       (insert (concat " " beg-name)))
-	      ((and beg-name end-name) 
-	       (message "Replacing %s with %s." end-name beg-name)
-	       (search-forward end-name)
-	       (replace-match beg-name))
-	      ((and (not beg-name) end-name) 
-	       (message "Deleting %s." end-name)
-	       (search-forward end-name)
-	       (replace-match "")))
-      (if end-name (search-forward end-name)))
-    (if (not (looking-at "[ \t]*!")) (delete-horizontal-space))))
-
-(defun f90-match-end ()
-  "From an end foo statement, find the corresponding foo including name."
-  (interactive)
-  (let ((count 1) (top-of-window (window-start)) (matching-beg nil)
-	(end-point (point)) (case-fold-search t)
-	beg-name end-name beg-block end-block end-struct)
-    (if (save-excursion (beginning-of-line) (skip-chars-forward " \t0-9")
-			(setq end-struct (f90-looking-at-program-block-end)))
-	(progn
-	  (setq end-block (car end-struct))
-	  (setq end-name  (car (cdr end-struct)))
-	  (save-excursion
-	    (beginning-of-line)
-	    (while 
-		(and (not (zerop count))
-		     (let ((stop nil) notexist)
-		       (while (not stop)
-			 (setq notexist
-			       (not (re-search-backward 
-				     (concat "\\(" f90-blocks-re "\\)") nil t)))
-			 (if notexist
-			     (setq stop t)
-			   (setq stop
-				 (not (or (f90-in-string)
-					  (f90-in-comment))))))
-		       (not notexist)))
-	      (beginning-of-line) (skip-chars-forward " \t0-9")
-	      (cond ((setq matching-beg
-			   (cond
-			    ((f90-looking-at-do))
-			    ((f90-looking-at-if-then))
-			    ((f90-looking-at-where-or-forall))
-			    ((f90-looking-at-select-case))
-			    ((f90-looking-at-type-like))
-			    ((f90-looking-at-program-block-start))))
-		     (setq count (- count 1)))
-		    ((looking-at (concat "end[ \t]*" f90-blocks-re "\\b"))
-		     (setq count (+ count 1)))))
-	    (if (not (zerop count))
-		(message "No matching beginning.")
-	      (f90-update-line)
-	      (if (eq f90-smart-end 'blink)
-		  (if (< (point) top-of-window)
-		      (message "Matches %s: %s"
-			       (what-line)
-			       (buffer-substring
-				(progn (beginning-of-line) (point))
-				(progn (end-of-line) (point))))
-		    (sit-for 1)))
-	      (setq beg-block (car matching-beg))
-	      (setq beg-name (car (cdr matching-beg)))
-	      (goto-char end-point)
-	      (beginning-of-line)
-	      (f90-block-match beg-block beg-name end-block end-name)))))))
-
-(defun f90-insert-end ()
-  "Inserts an complete end statement matching beginning of present block."
-  (interactive)
-  (let ((f90-smart-end (if f90-smart-end f90-smart-end 'blink)))
-    (insert "end")
-    (f90-indent-new-line)))
-
-;; abbrevs and keywords
-
-(defun f90-abbrev-start ()
-  "Typing `\\[help-command] or `? lists all the F90 abbrevs. 
-Any other key combination is executed normally."
-  (interactive)
-  (let (e c)
-    (insert last-command-char)
-    (if (string-match "XEmacs" emacs-version)
-	(progn
-	  (setq e (next-command-event))
-	  (setq c (event-to-character e)))
-      (setq c (read-event)))
-    ;; insert char if not equal to `?'
-    (if (or (= c ??) (eq c help-char))
-	(f90-abbrev-help)
-      (if (string-match "XEmacs" emacs-version)
-	  (setq unread-command-event e)
-	(setq unread-command-events (list c))))))
-
-(defun f90-abbrev-help ()
-  "List the currently defined abbrevs in F90 mode."
-  (interactive)
-  (message "Listing abbrev table...")
-  (display-buffer (f90-prepare-abbrev-list-buffer))
-  (message "Listing abbrev table...done"))
-
-(defun f90-prepare-abbrev-list-buffer ()
-  (save-excursion
-    (set-buffer (get-buffer-create "*Abbrevs*"))
-    (erase-buffer)
-    (insert-abbrev-table-description 'f90-mode-abbrev-table t)
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    (edit-abbrevs-mode))
-  (get-buffer-create "*Abbrevs*"))
-
-(defun f90-upcase-keywords ()
-  "Upcase all F90 keywords in the buffer."
-  (interactive)
-  (f90-change-keywords 'upcase-word))
-
-(defun f90-capitalize-keywords ()
-  "Capitalize all F90 keywords in the buffer."
-  (interactive)
-  (f90-change-keywords 'capitalize-word))
-
-(defun f90-downcase-keywords ()
-  "Downcase all F90 keywords in the buffer."
-  (interactive)
-  (f90-change-keywords 'downcase-word))
-
-(defun f90-upcase-region-keywords (beg end)
-  "Upcase all F90 keywords in the region."
-  (interactive "*r")
-  (f90-change-keywords 'upcase-word beg end))
-
-(defun f90-capitalize-region-keywords (beg end)
-  "Capitalize all F90 keywords in the region."
-  (interactive "*r")
-  (f90-change-keywords 'capitalize-word beg end))
-
-(defun f90-downcase-region-keywords (beg end)
-  "Downcase all F90 keywords in the region."
-  (interactive "*r")
-  (f90-change-keywords 'downcase-word beg end))
-
-;; Change the keywords according to argument.
-(defun f90-change-keywords (change-word &optional beg end)
-  (save-excursion
-    (setq beg (if beg beg (point-min)))
-    (setq end (if end end (point-max)))
-    (let ((keyword-re 
-	   (concat "\\("
-		   f90-keywords-re "\\|" f90-procedures-re "\\|"
-		   f90-hpf-keywords-re "\\|" f90-operators-re "\\)"))
-	  (ref-point (point-min)) state
-	  (modified (buffer-modified-p)) saveword back-point)
-      (goto-char beg)
-      (unwind-protect
-	  (while (re-search-forward keyword-re end t)
-	    (if (progn
-		  (setq state (parse-partial-sexp ref-point (point)))
-		  (or (nth 3 state) (nth 4 state)
-		      (save-excursion	; Check for cpp directive.
-			(beginning-of-line)
-			(skip-chars-forward " \t0-9")
-			(looking-at "#"))))
-		()
-	      (setq ref-point (point)
-		    back-point (save-excursion (backward-word 1) (point)))
-	      (setq saveword (buffer-substring back-point ref-point))
-	      (funcall change-word -1)
-	      (or (string= saveword (buffer-substring back-point ref-point))
-		  (setq modified t))))
-	(or modified (set-buffer-modified-p nil))))))
-
-(provide 'f90)
-
-;;; f90.el ends here
diff --git a/lisp/progmodes/fortran.el b/lisp/progmodes/fortran.el
deleted file mode 100644
index 1c255b12a8c..00000000000
--- a/lisp/progmodes/fortran.el
+++ /dev/null
@@ -1,1589 +0,0 @@
-;;; fortran.el --- Fortran mode for GNU Emacs
-
-;; Copyright (c) 1986, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Michael D. Prange <prange@erl.mit.edu>
-;; Maintainer: bug-fortran-mode@erl.mit.edu (Steve Gildea and others)
-;; Version 1.30.6 (July 27, 1995)
-;; Keywords: languages
-
-;; 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:
-
-;; Fortran mode has been upgraded and is now maintained by Stephen A. Wood
-;; (saw@cebaf.gov).  It now will use either fixed format continuation line
-;; markers (character in 6th column), or tab format continuation line style
-;; (digit after a TAB character.)  A auto-fill mode has been added to
-;; automatically wrap fortran lines that get too long.
-
-;; We acknowledge many contributions and valuable suggestions by
-;; Lawrence R. Dodd, Ralf Fassel, Ralph Finch, Stephen Gildea,
-;; Dr. Anil Gokhale, Ulrich Mueller, Mark Neale, Eric Prestemon, 
-;; Gary Sabot and Richard Stallman.
-
-;; This file may be used with GNU Emacs version 18.xx if the following
-;; variable and function substitutions are made.
-;;  Replace:
-;;   frame-width                           with screen-width
-;;   auto-fill-function                    with auto-fill-hook
-;;   comment-indent-function               with comment-indent-hook
-;;   (setq unread-command-events (list c)) with (setq unread-command-char c)
-
-;; Bugs to bug-fortran-mode@erl.mit.edu
-
-;;; Code:
-
-(defconst fortran-mode-version "version 1.30.6")
-
-;;;###autoload
-(defvar fortran-tab-mode-default nil
-  "*Default tabbing/carriage control style for empty files in Fortran mode.
-A value of t specifies tab-digit style of continuation control.
-A value of nil specifies that continuation lines are marked
-with a character in column 6.")
-
-;; Buffer local, used to display mode line.
-(defvar fortran-tab-mode-string nil
-  "String to appear in mode line when TAB format mode is on.")
-
-(defvar fortran-do-indent 3
-  "*Extra indentation applied to DO blocks.")
-
-(defvar fortran-if-indent 3
-  "*Extra indentation applied to IF blocks.")
-
-(defvar fortran-structure-indent 3
-  "*Extra indentation applied to STRUCTURE, UNION, MAP and INTERFACE blocks.")
-
-(defvar fortran-continuation-indent 5
-  "*Extra indentation applied to Fortran continuation lines.")
-
-(defvar fortran-comment-indent-style 'fixed
-  "*nil forces comment lines not to be touched,
-'fixed makes fixed comment indentation to `fortran-comment-line-extra-indent'
-columns beyond `fortran-minimum-statement-indent-fixed' (for
-`indent-tabs-mode' of nil) or `fortran-minimum-statement-indent-tab' (for
-`indent-tabs-mode' of t), and 'relative indents to current
-Fortran indentation plus `fortran-comment-line-extra-indent'.")
-
-(defvar fortran-comment-line-extra-indent 0
-  "*Amount of extra indentation for text within full-line comments.")
-
-(defvar comment-line-start nil
-  "*Delimiter inserted to start new full-line comment.")
-
-(defvar comment-line-start-skip nil
-  "*Regexp to match the start of a full-line comment.")
-
-(defvar fortran-minimum-statement-indent-fixed 6
-  "*Minimum statement indentation for fixed format continuation style.")
-
-(defvar fortran-minimum-statement-indent-tab (max tab-width 6)
-  "*Minimum statement indentation for TAB format continuation style.")
-
-;; Note that this is documented in the v18 manuals as being a string
-;; of length one rather than a single character.
-;; The code in this file accepts either format for compatibility.
-(defvar fortran-comment-indent-char " "
-  "*Single-character string inserted for Fortran comment indentation.
-Normally a space.")
-
-(defvar fortran-line-number-indent 1
-  "*Maximum indentation for Fortran line numbers.
-5 means right-justify them within their five-column field.")
-
-(defvar fortran-check-all-num-for-matching-do nil
-  "*Non-nil causes all numbered lines to be treated as possible DO loop ends.")
-
-(defvar fortran-blink-matching-if nil
-  "*Non-nil causes \\[fortran-indent-line] on ENDIF statement to blink on matching IF.
-Also, from an ENDDO statement blink on matching DO [WHILE] statement.")
-
-(defvar fortran-continuation-string "$"
-  "*Single-character string used for Fortran continuation lines.
-In fixed format continuation style, this character is inserted in
-column 6 by \\[fortran-split-line] to begin a continuation line.
-Also, if \\[fortran-indent-line] finds this at the beginning of a line, it will
-convert the line into a continuation line of the appropriate style.
-Normally $.")
-
-(defvar fortran-comment-region "c$$$"
-  "*String inserted by \\[fortran-comment-region]\
- at start of each line in region.")
-
-(defvar fortran-electric-line-number t
-  "*Non-nil causes line number digits to be moved to the correct column as\
- typed.")
-
-(defvar fortran-startup-message t
-  "*Non-nil displays a startup message when Fortran mode is first called.")
-
-(defvar fortran-column-ruler-fixed
-  "0   4 6  10        20        30        40        5\
-\0        60        70\n\
-\[   ]|{   |    |    |    |    |    |    |    |    \
-\|    |    |    |    |}\n"
-  "*String displayed above current line by \\[fortran-column-ruler].
-This variable used in fixed format mode.")
-
-(defvar fortran-column-ruler-tab
-  "0       810        20        30        40        5\
-\0        60        70\n\
-\[   ]|  { |    |    |    |    |    |    |    |    \
-\|    |    |    |    |}\n"
-  "*String displayed above current line by \\[fortran-column-ruler].
-This variable used in TAB format mode.")
-
-(defconst bug-fortran-mode "bug-fortran-mode@erl.mit.edu"
-  "Address of mailing list for Fortran mode bugs.")
-
-(defvar fortran-mode-syntax-table nil
-  "Syntax table in use in Fortran mode buffers.")
-
-(defvar fortran-analyze-depth 100
-  "Number of lines to scan to determine whether to use fixed or TAB format\
- style.")
-
-(defvar fortran-break-before-delimiters t
-  "*Non-nil causes `fortran-fill' to break lines before delimiters.")
-
-(if fortran-mode-syntax-table
-    ()
-  (setq fortran-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\; "w" fortran-mode-syntax-table)
-  (modify-syntax-entry ?\r " " fortran-mode-syntax-table)
-  (modify-syntax-entry ?+ "." fortran-mode-syntax-table)
-  (modify-syntax-entry ?- "." fortran-mode-syntax-table)
-  (modify-syntax-entry ?= "." fortran-mode-syntax-table)
-  (modify-syntax-entry ?* "." fortran-mode-syntax-table)
-  (modify-syntax-entry ?/ "." fortran-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" fortran-mode-syntax-table)
-  (modify-syntax-entry ?\" "\"" fortran-mode-syntax-table)
-  (modify-syntax-entry ?\\ "/" fortran-mode-syntax-table)
-  (modify-syntax-entry ?. "w" fortran-mode-syntax-table)
-  (modify-syntax-entry ?_ "w" fortran-mode-syntax-table)
-  (modify-syntax-entry ?\! "<" fortran-mode-syntax-table)
-  (modify-syntax-entry ?\n ">" fortran-mode-syntax-table))
-
-;; Comments are real pain in Fortran because there is no way to represent the
-;; standard comment syntax in an Emacs syntax table (we can for VAX-style).
-;; Therefore an unmatched quote in a standard comment will throw fontification
-;; off on the wrong track.  So we do syntactic fontification with regexps.
-
-;; Regexps done by simon@gnu with help from Ulrik Dickow <dickow@nbi.dk> and
-;; probably others Si's forgotten about (sorry).
-
-(defconst fortran-font-lock-keywords-1 nil
-  "Subdued level highlighting for Fortran mode.")
-
-(defconst fortran-font-lock-keywords-2 nil
-  "Medium level highlighting for Fortran mode.")
-
-(defconst fortran-font-lock-keywords-3 nil
-  "Gaudy level highlighting for Fortran mode.")
-
-(let ((comment-chars "c!*")
-      (fortran-type-types
-;     (make-regexp
-;      (let ((simple-types '("character" "byte" "integer" "logical"
-;			    "none" "real" "complex"
-;			    "double[ \t]*precision" "double[ \t]*complex"))
-;	    (structured-types '("structure" "union" "map"))
-;	    (other-types '("record" "dimension" "parameter" "common" "save"
-;			   "external" "intrinsic" "data" "equivalence")))
-;	(append
-;	 (mapcar (lambda (x) (concat "implicit[ \t]*" x)) simple-types)
-;	 simple-types
-;	 (mapcar (lambda (x) (concat "end[ \t]*" x)) structured-types)
-;	 structured-types
-;	 other-types)))
-	  (concat "byte\\|c\\(haracter\\|om\\(mon\\|plex\\)\\)\\|"
-                  "d\\(ata\\|imension\\|ouble"
-                  "[ \t]*\\(complex\\|precision\\)\\)\\|"
-                  "e\\(nd[ \t]*\\(map\\|structure\\|union\\)\\|"
-                  "quivalence\\|xternal\\)\\|"
-                  "i\\(mplicit[ \t]*\\(byte\\|"
-                  "c\\(haracter\\|omplex\\)\\|"
-                  "double[ \t]*\\(complex\\|precision\\)\\|"
-                  "integer\\|logical\\|none\\|real\\)\\|"
-                  "nt\\(eger\\|rinsic\\)\\)\\|"
-                  "logical\\|map\\|none\\|parameter\\|re\\(al\\|cord\\)\\|"
-                  "s\\(ave\\|tructure\\)\\|union"))
-	 (fortran-keywords
-;	  ("continue" "format" "end" "enddo" "if" "then" "else" "endif"
-;	   "elseif" "while" "inquire" "stop" "return" "include" "open"
-;	   "close" "read" "write" "format" "print")
-	  (concat "c\\(lose\\|ontinue\\)\\|"
-		  "e\\(lse\\(\\|if\\)\\|nd\\(\\|do\\|if\\)\\)\\|format\\|"
-		  "i\\(f\\|n\\(clude\\|quire\\)\\)\\|open\\|print\\|"
-		  "re\\(ad\\|turn\\)\\|stop\\|then\\|w\\(hile\\|rite\\)"))
-        (fortran-logicals
-;       ("and" "or" "not" "lt" "le" "eq" "ge" "gt" "ne" "true" "false")
-         "and\\|eq\\|false\\|g[et]\\|l[et]\\|n\\(e\\|ot\\)\\|or\\|true"))
-
-  (setq fortran-font-lock-keywords-1
-   (list
-    ;;
-    ;; Fontify syntactically (assuming strings cannot be quoted or span lines).
-    (cons (concat "^[" comment-chars "].*") 'font-lock-comment-face)
-    '(fortran-match-!-comment . font-lock-comment-face)
-    (list (concat "^[^" comment-chars "\t\n]" (make-string 71 ?.) "\\(.*\\)")
-	  '(1 font-lock-comment-face))
-    '("'[^'\n]*'?" . font-lock-string-face)
-    ;;
-    ;; Program, subroutine and function declarations, plus calls.
-    (list (concat "\\<\\(block[ \t]*data\\|call\\|entry\\|function\\|"
-		  "program\\|subroutine\\)\\>[ \t]*\\(\\sw+\\)?")
-	  '(1 font-lock-keyword-face)
-	  '(2 font-lock-function-name-face nil t))))
-
-  (setq fortran-font-lock-keywords-2
-   (append fortran-font-lock-keywords-1
-    (list
-     ;;
-     ;; Fontify all type specifiers (must be first; see below).
-     (cons (concat "\\<\\(" fortran-type-types "\\)\\>") 'font-lock-type-face)
-     ;;
-     ;; Fontify all builtin keywords (except logical, do and goto; see below).
-     (concat "\\<\\(" fortran-keywords "\\)\\>")
-     ;;
-     ;; Fontify all builtin operators.
-     (concat "\\.\\(" fortran-logicals "\\)\\.")
-     ;;
-     ;; Fontify do/goto keywords and targets, and goto tags.
-     (list "\\<\\(do\\|go *to\\)\\>[ \t]*\\([0-9]+\\)?"
-	   '(1 font-lock-keyword-face)
-	   '(2 font-lock-reference-face nil t))
-     (cons "^ *\\([0-9]+\\)" 'font-lock-reference-face))))
-
-  (setq fortran-font-lock-keywords-3
-   (append
-    ;;
-    ;; The list `fortran-font-lock-keywords-1'.
-    fortran-font-lock-keywords-1
-    ;;
-    ;; Fontify all type specifiers plus their declared items.
-    (list
-     (list (concat "\\<\\(" fortran-type-types "\\)\\>[ \t(/]*\\(*\\)?")
-	   ;; Fontify the type specifier.
-	   '(1 font-lock-type-face)
-	   ;; Fontify each declaration item (or just the /.../ block name).
-	   '(font-lock-match-c-style-declaration-item-and-skip-to-next
-	     ;; Start after any *(...) expression.
-	     (and (match-beginning 15) (forward-sexp 1))
-	     ;; No need to clean up.
-	     nil
-	     ;; Fontify as a variable name, functions are fontified elsewhere.
-	     (1 font-lock-variable-name-face nil t))))
-    ;;
-    ;; Things extra to `fortran-font-lock-keywords-3' (must be done first).
-    (list
-     ;;
-     ;; Fontify goto-like `err=label'/`end=label' in read/write statements.
-     '(", *\\(e\\(nd\\|rr\\)\\)\\> *\\(= *\\([0-9]+\\)\\)?"
-       (1 font-lock-keyword-face) (4 font-lock-reference-face nil t))
-     ;;
-     ;; Highlight standard continuation character and in a TAB-formatted line.
-     '("^     \\([^ 0]\\)" 1 font-lock-string-face)
-     '("^\t\\([1-9]\\)" 1 font-lock-string-face))
-    ;;
-    ;; The list `fortran-font-lock-keywords-2' less that for types (see above).
-    (cdr (nthcdr (length fortran-font-lock-keywords-1)
-		 fortran-font-lock-keywords-2))))
-  )
-
-(defvar fortran-font-lock-keywords fortran-font-lock-keywords-1
-  "Default expressions to highlight in Fortran mode.")
-
-
-(defvar fortran-mode-map () 
-  "Keymap used in Fortran mode.")
-(if fortran-mode-map
-    ()
-  (setq fortran-mode-map (make-sparse-keymap))
-  (define-key fortran-mode-map ";" 'fortran-abbrev-start)
-  (define-key fortran-mode-map "\C-c;" 'fortran-comment-region)
-  (define-key fortran-mode-map "\e\C-a" 'beginning-of-fortran-subprogram)
-  (define-key fortran-mode-map "\e\C-e" 'end-of-fortran-subprogram)
-  (define-key fortran-mode-map "\e;" 'fortran-indent-comment)
-  (define-key fortran-mode-map "\e\C-h" 'mark-fortran-subprogram)
-  (define-key fortran-mode-map "\e\n" 'fortran-split-line)
-  (define-key fortran-mode-map "\n" 'fortran-indent-new-line)
-  (define-key fortran-mode-map "\e\C-q" 'fortran-indent-subprogram)
-  (define-key fortran-mode-map "\C-c\C-w" 'fortran-window-create-momentarily)
-  (define-key fortran-mode-map "\C-c\C-r" 'fortran-column-ruler)
-  (define-key fortran-mode-map "\C-c\C-p" 'fortran-previous-statement)
-  (define-key fortran-mode-map "\C-c\C-n" 'fortran-next-statement)
-  (define-key fortran-mode-map "\t" 'fortran-indent-line)
-  (define-key fortran-mode-map "0" 'fortran-electric-line-number)
-  (define-key fortran-mode-map "1" 'fortran-electric-line-number)
-  (define-key fortran-mode-map "2" 'fortran-electric-line-number)
-  (define-key fortran-mode-map "3" 'fortran-electric-line-number)
-  (define-key fortran-mode-map "4" 'fortran-electric-line-number)
-  (define-key fortran-mode-map "5" 'fortran-electric-line-number)
-  (define-key fortran-mode-map "6" 'fortran-electric-line-number)
-  (define-key fortran-mode-map "7" 'fortran-electric-line-number)
-  (define-key fortran-mode-map "8" 'fortran-electric-line-number)
-  (define-key fortran-mode-map "9" 'fortran-electric-line-number))
-
-(defvar fortran-mode-abbrev-table nil)
-(if fortran-mode-abbrev-table
-    ()
-  (let ((ac abbrevs-changed))
-    (define-abbrev-table 'fortran-mode-abbrev-table ())
-    (define-abbrev fortran-mode-abbrev-table  ";au"  "automatic" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";b"   "byte" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";bd"  "block data" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ch"  "character" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";cl"  "close" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";c"   "continue" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";cm"  "common" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";cx"  "complex" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";df"  "define" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";di"  "dimension" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";do"  "double" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";dc"  "double complex" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";dp"  "double precision" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";dw"  "do while" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";e"   "else" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ed"  "enddo" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";el"  "elseif" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";en"  "endif" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";eq"  "equivalence" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ew"  "endwhere" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ex"  "external" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ey"  "entry" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";f"   "format" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";fa"  ".false." nil)
-    (define-abbrev fortran-mode-abbrev-table  ";fu"  "function" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";g"   "goto" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";im"  "implicit" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ib"  "implicit byte" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ic"  "implicit complex" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ich" "implicit character" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ii"  "implicit integer" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";il"  "implicit logical" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ir"  "implicit real" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";inc" "include" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";in"  "integer" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";intr" "intrinsic" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";l"   "logical" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";n"   "namelist" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";o"   "open" nil) ; was ;op
-    (define-abbrev fortran-mode-abbrev-table  ";pa"  "parameter" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";pr"  "program" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ps"  "pause" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";p"   "print" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";rc"  "record" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";re"  "real" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";r"   "read" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";rt"  "return" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";rw"  "rewind" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";s"   "stop" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";sa"  "save" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";st"  "structure" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";sc"  "static" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";su"  "subroutine" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";tr"  ".true." nil)
-    (define-abbrev fortran-mode-abbrev-table  ";ty"  "type" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";vo"  "volatile" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";w"   "write" nil)
-    (define-abbrev fortran-mode-abbrev-table  ";wh"  "where" nil)
-    (setq abbrevs-changed ac)))
-
-;;;###autoload
-(defun fortran-mode ()
-  "Major mode for editing Fortran code.
-\\[fortran-indent-line] indents the current Fortran line correctly. 
-DO statements must not share a common CONTINUE.
-
-Type ;? or ;\\[help-command] to display a list of built-in\
- abbrevs for Fortran keywords.
-
-Key definitions:
-\\{fortran-mode-map}
-
-Variables controlling indentation style and extra features:
-
- comment-start
-    Normally nil in Fortran mode.  If you want to use comments
-    starting with `!', set this to the string \"!\".
- fortran-do-indent
-    Extra indentation within do blocks.  (default 3)
- fortran-if-indent
-    Extra indentation within if blocks.  (default 3)
- fortran-structure-indent
-    Extra indentation within structure, union, map and interface blocks.
-    (default 3)
- fortran-continuation-indent
-    Extra indentation applied to continuation statements.  (default 5)
- fortran-comment-line-extra-indent
-    Amount of extra indentation for text within full-line comments. (default 0)
- fortran-comment-indent-style
-    nil    means don't change indentation of text in full-line comments,
-    fixed  means indent that text at `fortran-comment-line-extra-indent' beyond
-           the value of `fortran-minimum-statement-indent-fixed' (for fixed
-           format continuation style) or `fortran-minimum-statement-indent-tab'
-           (for TAB format continuation style).
-    relative  means indent at `fortran-comment-line-extra-indent' beyond the
- 	      indentation for a line of code.
-    (default 'fixed)
- fortran-comment-indent-char
-    Single-character string to be inserted instead of space for
-    full-line comment indentation.  (default \" \")
- fortran-minimum-statement-indent-fixed
-    Minimum indentation for Fortran statements in fixed format mode. (def.6)
- fortran-minimum-statement-indent-tab
-    Minimum indentation for Fortran statements in TAB format mode. (default 9)
- fortran-line-number-indent
-    Maximum indentation for line numbers.  A line number will get
-    less than this much indentation if necessary to avoid reaching
-    column 5.  (default 1)
- fortran-check-all-num-for-matching-do
-    Non-nil causes all numbered lines to be treated as possible \"continue\"
-    statements.  (default nil)
- fortran-blink-matching-if 
-    Non-nil causes \\[fortran-indent-line] on an ENDIF statement to blink on
-    matching IF.  Also, from an ENDDO statement, blink on matching DO [WHILE]
-    statement.  (default nil)
- fortran-continuation-string
-    Single-character string to be inserted in column 5 of a continuation
-    line.  (default \"$\")
- fortran-comment-region
-    String inserted by \\[fortran-comment-region] at start of each line in 
-    region.  (default \"c$$$\")
- fortran-electric-line-number
-    Non-nil causes line number digits to be moved to the correct column 
-    as typed.  (default t)
- fortran-break-before-delimiters
-    Non-nil causes `fortran-fill' breaks lines before delimiters.
-    (default t)
- fortran-startup-message
-    Set to nil to inhibit message first time Fortran mode is used.
-
-Turning on Fortran mode calls the value of the variable `fortran-mode-hook'
-with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (if fortran-startup-message
-      (message "Emacs Fortran mode %s.  Bugs to %s"
-	       fortran-mode-version bug-fortran-mode))
-  (setq fortran-startup-message nil)
-  (setq local-abbrev-table fortran-mode-abbrev-table)
-  (set-syntax-table fortran-mode-syntax-table)
-  ;; Font Lock mode support.
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '((fortran-font-lock-keywords
-			      fortran-font-lock-keywords-1
-			      fortran-font-lock-keywords-2
-			      fortran-font-lock-keywords-3)
-			     t t ((?/ . "$/"))))
-  (make-local-variable 'fortran-break-before-delimiters)
-  (setq fortran-break-before-delimiters t)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'fortran-indent-line)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'fortran-comment-hook)
-  (make-local-variable 'comment-line-start-skip)
-  (setq comment-line-start-skip
-	"^[Cc*]\\(\\([^ \t\n]\\)\\2\\2*\\)?[ \t]*\\|^#.*")
-  (make-local-variable 'comment-line-start)
-  (setq comment-line-start "c")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "![ \t]*")
-  (make-local-variable 'comment-start)
-  (setq comment-start nil)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'abbrev-all-caps)
-  (setq abbrev-all-caps t)
-  (make-local-variable 'indent-tabs-mode)
-  (setq indent-tabs-mode nil)
-;;;(setq abbrev-mode t) ; ?? (abbrev-mode 1) instead??
-  (setq fill-column 72) ; Already local?
-  (use-local-map fortran-mode-map)
-  (setq mode-name "Fortran")
-  (setq major-mode 'fortran-mode)
-;;;(make-local-variable 'fortran-tab-mode)
-  (make-local-variable 'fortran-comment-line-extra-indent)
-  (make-local-variable 'fortran-minimum-statement-indent-fixed)
-  (make-local-variable 'fortran-minimum-statement-indent-tab)
-  (make-local-variable 'fortran-column-ruler-fixed)
-  (make-local-variable 'fortran-column-ruler-tab)
-  (make-local-variable 'fortran-tab-mode-string)
-  (setq fortran-tab-mode-string " TAB-format")
-  (setq indent-tabs-mode (fortran-analyze-file-format))
-  (run-hooks 'fortran-mode-hook))
-
-(defun fortran-comment-hook ()
-  (save-excursion
-    (skip-chars-backward " \t")
-    (max (+ 1 (current-column))
-	 comment-column)))
-
-(defun fortran-indent-comment ()
-  "Align or create comment on current line.
-Existing comments of all types are recognized and aligned.
-If the line has no comment, a side-by-side comment is inserted and aligned
-if the value of  comment-start  is not nil.
-Otherwise, a separate-line comment is inserted, on this line
-or on a new line inserted before this line if this line is not blank."
-  (interactive)
-  (beginning-of-line)
-  ;; Recognize existing comments of either kind.
-  (cond ((looking-at comment-line-start-skip)
-	 (fortran-indent-line))
-	((fortran-find-comment-start-skip) ; catches any inline comment and
-					; leaves point after comment-start-skip
-	 (if comment-start-skip
-	     (progn (goto-char (match-beginning 0))
-		    (if (not (= (current-column) (fortran-comment-hook)))
-			(progn (delete-horizontal-space)
-			       (indent-to (fortran-comment-hook)))))
-	   (end-of-line)))        ; otherwise goto end of line or sth else?
-	;; No existing comment.
-	;; If side-by-side comments are defined, insert one,
-	;; unless line is now blank.
-	((and comment-start (not (looking-at "^[ \t]*$")))
-	 (end-of-line)
-	 (delete-horizontal-space)
-	 (indent-to (fortran-comment-hook))
-	 (insert comment-start))
-	;; Else insert separate-line comment, making a new line if nec.
-	(t
-	 (if (looking-at "^[ \t]*$")
-	     (delete-horizontal-space)
-	   (beginning-of-line)
-	   (insert "\n")
-	   (forward-char -1))
-	 (insert comment-line-start)
-	 (insert-char (if (stringp fortran-comment-indent-char)
-			  (aref fortran-comment-indent-char 0)
-			fortran-comment-indent-char)
-		      (- (calculate-fortran-indent) (current-column))))))
-
-(defun fortran-comment-region (beg-region end-region arg)
-  "Comments every line in the region.
-Puts fortran-comment-region at the beginning of every line in the region. 
-BEG-REGION and END-REGION are args which specify the region boundaries. 
-With non-nil ARG, uncomments the region."
-  (interactive "*r\nP")
-  (let ((end-region-mark (make-marker)) (save-point (point-marker)))
-    (set-marker end-region-mark end-region)
-    (goto-char beg-region)
-    (beginning-of-line)
-    (if (not arg)			;comment the region
-	(progn (insert fortran-comment-region)
-	       (while (and  (= (forward-line 1) 0)
-			    (< (point) end-region-mark))
-		 (insert fortran-comment-region)))
-      (let ((com (regexp-quote fortran-comment-region))) ;uncomment the region
-	(if (looking-at com)
-	    (delete-region (point) (match-end 0)))
-	(while (and  (= (forward-line 1) 0)
-		     (< (point) end-region-mark))
-	  (if (looking-at com)
-	      (delete-region (point) (match-end 0))))))
-    (goto-char save-point)
-    (set-marker end-region-mark nil)
-    (set-marker save-point nil)))
-
-(defun fortran-abbrev-start ()
-  "Typing ;\\[help-command] or ;? lists all the Fortran abbrevs. 
-Any other key combination is executed normally."
-  (interactive)
-  (let (c)
-    (insert last-command-char)
-    (if (or (eq (setq c (read-event)) ??)    ;insert char if not equal to `?'
-	    (eq c help-char))
-	(fortran-abbrev-help)
-      (setq unread-command-events (list c)))))
-
-(defun fortran-abbrev-help ()
-  "List the currently defined abbrevs in Fortran mode."
-  (interactive)
-  (message "Listing abbrev table...")
-  (display-buffer (fortran-prepare-abbrev-list-buffer))
-  (message "Listing abbrev table...done"))
-
-(defun fortran-prepare-abbrev-list-buffer ()
-  (save-excursion
-    (set-buffer (get-buffer-create "*Abbrevs*"))
-    (erase-buffer)
-    (insert-abbrev-table-description 'fortran-mode-abbrev-table t)
-    (goto-char (point-min))
-    (set-buffer-modified-p nil)
-    (edit-abbrevs-mode))
-  (get-buffer-create "*Abbrevs*"))
-
-(defun fortran-column-ruler ()
-  "Inserts a column ruler momentarily above current line, till next keystroke.
-The ruler is defined by the value of `fortran-column-ruler-fixed' when in fixed
-format mode, and `fortran-column-ruler-tab' when in TAB format mode.
-The key typed is executed unless it is SPC."
-  (interactive)
-  (momentary-string-display 
-   (if indent-tabs-mode
-       fortran-column-ruler-tab
-     fortran-column-ruler-fixed)
-   (save-excursion
-     (beginning-of-line) 
-     (if (eq (window-start (selected-window))
-	     (window-point (selected-window)))
-	 (progn (forward-line) (point))
-       (point)))
-   nil "Type SPC or any command to erase ruler."))
-
-(defun fortran-window-create ()
-  "Makes the window 72 columns wide.
-See also `fortran-window-create-momentarily'."
-  (interactive)
-  (condition-case error
-      (progn
-	(let ((window-min-width 2))
-	  (if (< (window-width) (frame-width))
-	      (enlarge-window-horizontally (- (frame-width)
-					      (window-width) 1)))
-	  (split-window-horizontally 73)
-	  (other-window 1)
-	  (switch-to-buffer " fortran-window-extra" t)
-	  (select-window (previous-window))))
-    (error (message "No room for Fortran window.")
-	   'error)))
-
-(defun fortran-window-create-momentarily (&optional arg)
-  "Momentarily makes the window 72 columns wide.
-Optional ARG non-nil and non-unity disables the momentary feature.
-See also `fortran-window-create'."
-  (interactive "p")
-  (if (or (not arg)
-	  (= arg 1))
-      (save-window-excursion
-	(if (not (equal (fortran-window-create) 'error))
-	    (progn (message "Type SPC to continue editing.")
-		   (let ((char (read-event)))
-		     (or (equal char (string-to-char " "))
-			 (setq unread-command-events (list char)))))))
-    (fortran-window-create)))
-
-(defun fortran-split-line ()
-  "Break line at point and insert continuation marker and alignment."
-  (interactive)
-  (delete-horizontal-space)
-  (if (save-excursion (beginning-of-line) (looking-at comment-line-start-skip))
-      (insert "\n" comment-line-start " ")
-    (if indent-tabs-mode
-	(progn 
-	  (insert "\n\t")
-	  (insert-char (fortran-numerical-continuation-char) 1))
-      (insert "\n " fortran-continuation-string)));Space after \n important
-  (fortran-indent-line))		;when the cont string is C, c or *.
-
-(defun fortran-numerical-continuation-char ()
-  "Return a digit for tab-digit style of continuation lines.
-If, previous line is a tab-digit continuation line, returns that digit
-plus one.  Otherwise return 1.  Zero not allowed."
-  (save-excursion
-    (forward-line -1)
-    (if (looking-at "\t[1-9]")
-	(+ ?1 (% (- (char-after (+ (point) 1)) ?0) 9))
-      ?1)))
-
-(defun delete-horizontal-regexp (chars)
-  "Delete all characters in CHARS around point.
-CHARS is like the inside of a [...] in a regular expression
-except that ] is never special and \ quotes ^, - or \."
-  (interactive "*s")
-  (skip-chars-backward chars)
-  (delete-region (point) (progn (skip-chars-forward chars) (point))))
-
-(defun fortran-electric-line-number (arg)
-  "Self insert, but if part of a Fortran line number indent it automatically.
-Auto-indent does not happen if a numeric arg is used."
-  (interactive "P")
-  (if (or arg (not fortran-electric-line-number))
-      (if arg 
-	  (self-insert-command (prefix-numeric-value arg))
-	(self-insert-command 1))
-    (if (or (and (= 5 (current-column))
-		 (save-excursion
-		   (beginning-of-line)
-		   (looking-at "     ")));In col 5 with only spaces to left.
-	    (and (= (if indent-tabs-mode
-		  fortran-minimum-statement-indent-tab
-		fortran-minimum-statement-indent-fixed) (current-column))
-		 (save-excursion
-		   (beginning-of-line)
-		   (looking-at "\t"));In col 8 with a single tab to the left.
-		 (not (or (eq last-command 'fortran-indent-line)
-			  (eq last-command
-			      'fortran-indent-new-line))))
-	    (save-excursion
-	      (re-search-backward "[^ \t0-9]"
-				  (save-excursion
-				    (beginning-of-line)
-				    (point))
-				  t)) ;not a line number
-	    (looking-at "[0-9]")	;within a line number
-	    )
-	(self-insert-command (prefix-numeric-value arg))
-      (skip-chars-backward " \t")
-      (insert last-command-char)
-      (fortran-indent-line))))
-
-(defun beginning-of-fortran-subprogram ()
-  "Moves point to the beginning of the current Fortran subprogram."
-  (interactive)
-  (let ((case-fold-search t))
-    (beginning-of-line -1)
-    (re-search-backward "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]" nil 'move)
-    (if (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]")
-	(forward-line 1))))
-
-(defun end-of-fortran-subprogram ()
-  "Moves point to the end of the current Fortran subprogram."
-  (interactive)
-  (let ((case-fold-search t))
-    (beginning-of-line 2)
-    (re-search-forward "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]" nil 'move)
-    (goto-char (match-beginning 0))
-    (forward-line 1)))
-
-(defun mark-fortran-subprogram ()
-  "Put mark at end of Fortran subprogram, point at beginning. 
-The marks are pushed."
-  (interactive)
-  (end-of-fortran-subprogram)
-  (push-mark (point))
-  (beginning-of-fortran-subprogram))
-
-(defun fortran-previous-statement ()
-  "Moves point to beginning of the previous Fortran statement.
-Returns `first-statement' if that statement is the first
-non-comment Fortran statement in the file, and nil otherwise."
-  (interactive)
-  (let (not-first-statement continue-test)
-    (beginning-of-line)
-    (setq continue-test
-	  (and
-	   (not (looking-at comment-line-start-skip))
-	   (or (looking-at
-	        (concat "[ \t]*" (regexp-quote fortran-continuation-string)))
-	       (or (looking-at "     [^ 0\n]")
-		   (looking-at "\t[1-9]")))))
-    (while (and (setq not-first-statement (= (forward-line -1) 0))
-		(or (looking-at comment-line-start-skip)
-		    (looking-at "[ \t]*$")
-		    (looking-at "     [^ 0\n]")
-		    (looking-at "\t[1-9]")
-		    (looking-at (concat "[ \t]*"  comment-start-skip)))))
-    (cond ((and continue-test
-		(not not-first-statement))
-	   (message "Incomplete continuation statement."))
-	  (continue-test	
-	   (fortran-previous-statement))
-	  ((not not-first-statement)
-	   'first-statement))))
-
-(defun fortran-next-statement ()
-  "Moves point to beginning of the next Fortran statement.
-Returns `last-statement' if that statement is the last
-non-comment Fortran statement in the file, and nil otherwise."
-  (interactive)
-  (let (not-last-statement)
-    (beginning-of-line)
-    (while (and (setq not-last-statement
-		      (and (= (forward-line 1) 0)
-			   (not (eobp))))
- 		(or (looking-at comment-line-start-skip)
- 		    (looking-at "[ \t]*$")
- 		    (looking-at "     [^ 0\n]")
- 		    (looking-at "\t[1-9]")
- 		    (looking-at (concat "[ \t]*"  comment-start-skip)))))
-    (if (not not-last-statement)
- 	'last-statement)))
-
-(defun fortran-blink-matching-if ()
-  ;; From a Fortran ENDIF statement, blink the matching IF statement.
-  (let ((top-of-window (window-start)) matching-if
-	(endif-point (point)) message)
-    (if (save-excursion (beginning-of-line)
-			(skip-chars-forward " \t0-9")
-			(looking-at "end[ \t]*if\\b"))
-	(progn
-          (if (not (setq matching-if (fortran-beginning-if)))
-              (setq message "No matching if.")
-            (if (< matching-if top-of-window)
-                (save-excursion
-                  (goto-char matching-if)
-                  (beginning-of-line)
-                  (setq message
-                        (concat "Matches "
-                                (buffer-substring
-                                 (point) (progn (end-of-line) (point))))))))
-	  (if message
-	      (message "%s" message)
-	    (goto-char matching-if)
-	    (sit-for 1)
-	    (goto-char endif-point))))))
-
-(defun fortran-blink-matching-do ()
-  ;; From a Fortran ENDDO statement, blink on the matching DO or DO WHILE
-  ;; statement.  This is basically copied from fortran-blink-matching-if.
-  (let ((top-of-window (window-start)) matching-do
-	(enddo-point (point)) message)
-    (if (save-excursion (beginning-of-line)
-			(skip-chars-forward " \t0-9")
-			(looking-at "end[ \t]*do\\b"))
-	(progn
-          (if (not (setq matching-do (fortran-beginning-do)))
-              (setq message "No matching do.")
-            (if (< matching-do top-of-window)
-                (save-excursion
-                  (goto-char matching-do)
-                  (beginning-of-line)
-                  (setq message
-                        (concat "Matches "
-                                (buffer-substring
-                                 (point) (progn (end-of-line) (point))))))))
-	  (if message
-	      (message "%s" message)
-	    (goto-char matching-do)
-	    (sit-for 1)
-	    (goto-char enddo-point))))))
-
-(defun fortran-mark-do ()
-  "Put mark at end of Fortran DO [WHILE]-ENDDO construct, point at beginning. 
-The marks are pushed."
-  (interactive)
-  (let (enddo-point do-point)
-    (if (setq enddo-point (fortran-end-do))
-        (if (not (setq do-point (fortran-beginning-do)))
-            (message "No matching do.")
-          ;; Set mark, move point.
-          (goto-char enddo-point)
-          (push-mark)
-          (goto-char do-point)))))
-
-(defun fortran-end-do ()
-  ;; Search forward for first unmatched ENDDO.  Return point or nil.
-  (if (save-excursion (beginning-of-line)
-                      (skip-chars-forward " \t0-9")
-                      (looking-at "end[ \t]*do\\b"))
-      ;; Sitting on one.
-      (match-beginning 0)
-    ;; Search for one.
-    (save-excursion
-      (let ((count 1))
-        (while (and (not (= count 0))
-                    (not (eq (fortran-next-statement) 'last-statement))
-                    ;; Keep local to subprogram
-                    (not (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]")))
-
-          (skip-chars-forward " \t0-9")
-          (cond ((looking-at "end[ \t]*do\\b")
-                 (setq count (- count 1)))
-                ((looking-at "do[ \t]+[^0-9]")
-                 (setq count (+ count 1)))))
-        (and (= count 0)
-             ;; All pairs accounted for.
-             (point))))))
-
-(defun fortran-beginning-do ()
-  ;; Search backwards for first unmatched DO [WHILE].  Return point or nil.
-  (if (save-excursion (beginning-of-line)
-                      (skip-chars-forward " \t0-9")
-                      (looking-at "do[ \t]+"))
-      ;; Sitting on one.
-      (match-beginning 0)
-    ;; Search for one.
-    (save-excursion
-      (let ((count 1))
-        (while (and (not (= count 0))
-                    (not (eq (fortran-previous-statement) 'first-statement))
-                    ;; Keep local to subprogram
-                    (not (looking-at "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]")))
-
-          (skip-chars-forward " \t0-9")
-          (cond ((looking-at "do[ \t]+[^0-9]")
-                 (setq count (- count 1)))
-                ((looking-at "end[ \t]*do\\b")
-                 (setq count (+ count 1)))))
-
-        (and (= count 0)
-             ;; All pairs accounted for.
-             (point))))))
-
-(defun fortran-mark-if ()
-  "Put mark at end of Fortran IF-ENDIF construct, point at beginning.
-The marks are pushed."
-  (interactive)
-  (let (endif-point if-point)
-    (if (setq endif-point (fortran-end-if))
-        (if (not (setq if-point (fortran-beginning-if)))
-            (message "No matching if.")
-          ;; Set mark, move point.
-          (goto-char endif-point)
-          (push-mark)
-          (goto-char if-point)))))
-
-(defun fortran-end-if ()
-  ;; Search forwards for first unmatched ENDIF.  Return point or nil.
-  (if (save-excursion (beginning-of-line)
-                      (skip-chars-forward " \t0-9")
-                      (looking-at "end[ \t]*if\\b"))
-      ;; Sitting on one.
-      (match-beginning 0)
-    ;; Search for one.  The point has been already been moved to first
-    ;; letter on line but this should not cause troubles.
-    (save-excursion
-      (let ((count 1))
-        (while (and (not (= count 0))
-                    (not (eq (fortran-next-statement) 'last-statement))
-                    ;; Keep local to subprogram.
-                    (not (looking-at
-                          "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]")))
-
-          (skip-chars-forward " \t0-9")
-          (cond ((looking-at "end[ \t]*if\\b")
-                 (setq count (- count 1)))
-
-                ((looking-at "if[ \t]*(")
-                 (save-excursion
-                   (if (or
-                        (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]")
-                        (let (then-test) ; Multi-line if-then.
-                          (while
-                              (and (= (forward-line 1) 0)
-                                   ;; Search forward for then.
-                                   (or (looking-at "     [^ 0\n]")
-                                       (looking-at "\t[1-9]"))
-                                   (not
-                                    (setq then-test
-                                          (looking-at
-                                           ".*then\\b[ \t]*[^ \t(=a-z0-9]")))))
-                          then-test))
-                       (setq count (+ count 1)))))))
-
-        (and (= count 0)
-             ;; All pairs accounted for.
-             (point))))))
-
-(defun fortran-beginning-if ()
-  ;; Search backwards for first unmatched IF-THEN.  Return point or nil.
-  (if (save-excursion
-        ;; May be sitting on multi-line if-then statement, first move to
-        ;; beginning of current statement.  Note: `fortran-previous-statement'
-        ;; moves to previous statement *unless* current statement is first
-        ;; one.  Only move forward if not first-statement.
-        (if (not (eq (fortran-previous-statement) 'first-statement))
-            (fortran-next-statement))
-        (skip-chars-forward " \t0-9")
-        (and
-         (looking-at "if[ \t]*(")
-         (save-match-data
-           (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]")
-               ;; Multi-line if-then.
-               (let (then-test)
-                 (while
-                     (and (= (forward-line 1) 0)
-                          ;; Search forward for then.
-                          (or (looking-at "     [^ 0\n]")
-                              (looking-at "\t[1-9]"))
-                          (not
-                           (setq then-test
-                                 (looking-at
-                                  ".*then\\b[ \t]*[^ \t(=a-z0-9]")))))
-                 then-test)))))
-      ;; Sitting on one.
-      (match-beginning 0)
-    ;; Search for one.
-    (save-excursion
-      (let ((count 1))
-        (while (and (not (= count 0))
-                    (not (eq (fortran-previous-statement) 'first-statement))
-                    ;; Keep local to subprogram.
-                    (not (looking-at
-                          "^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]")))
-
-          (skip-chars-forward " \t0-9")
-          (cond ((looking-at "if[ \t]*(")
-                 (save-excursion
-                   (if (or
-                        (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t(=a-z0-9]")
-                        (let (then-test) ; Multi-line if-then.
-                          (while
-                              (and (= (forward-line 1) 0)
-                                   ;; Search forward for then.
-                                   (or (looking-at "     [^ 0\n]")
-                                       (looking-at "\t[1-9]"))
-                                   (not
-                                    (setq then-test
-                                          (looking-at
-                                           ".*then\\b[ \t]*[^ \t(=a-z0-9]")))))
-                          then-test))
-                       (setq count (- count 1)))))
-                ((looking-at "end[ \t]*if\\b")
-                 (setq count (+ count 1)))))
-
-        (and (= count 0)
-             ;; All pairs accounted for.
-             (point))))))
-
-(defun fortran-indent-line ()
-  "Indents current Fortran line based on its contents and on previous lines."
-  (interactive)
-  (let ((cfi (calculate-fortran-indent)))
-    (save-excursion
-      (beginning-of-line)
-      (if (or (not (= cfi (fortran-current-line-indentation)))
-	      (and (re-search-forward "^[ \t]*[0-9]+" (+ (point) 4) t)
-		   (not (fortran-line-number-indented-correctly-p))))
-	  (fortran-indent-to-column cfi)
-	(beginning-of-line)
-	(if (and (not (looking-at comment-line-start-skip))
-		 (fortran-find-comment-start-skip))
-	    (fortran-indent-comment))))
-    ;; Never leave point in left margin.
-    (if (< (current-column) cfi)
-	(move-to-column cfi))
-    (if (and auto-fill-function
-	     (> (save-excursion (end-of-line) (current-column)) fill-column))
-	(save-excursion
-	  (end-of-line)
-	  (fortran-fill)))
-    (if fortran-blink-matching-if
-	(progn
-	  (fortran-blink-matching-if)
-	  (fortran-blink-matching-do)))))
-
-(defun fortran-indent-new-line ()
-  "Reindent the current Fortran line, insert a newline and indent the newline.
-An abbrev before point is expanded if `abbrev-mode' is non-nil."
-  (interactive)
-  (if abbrev-mode (expand-abbrev))
-  (save-excursion
-    (beginning-of-line)
-    (skip-chars-forward " \t")
-    (if (or (looking-at "[0-9]")	;Reindent only where it is most
-	    (looking-at "end")		;likely to be necessary
-	    (looking-at "else")
-	    (looking-at (regexp-quote fortran-continuation-string)))
-	(fortran-indent-line)))
-  (newline)
-  (fortran-indent-line))
-
-(defun fortran-indent-subprogram ()
-  "Properly indents the Fortran subprogram which contains point."
-  (interactive)
-  (save-excursion
-    (mark-fortran-subprogram)
-    (message "Indenting subprogram...")
-    (indent-region (point) (mark) nil))
-  (message "Indenting subprogram...done."))
-
-(defun calculate-fortran-indent ()
-  "Calculates the Fortran indent column based on previous lines."
-  (let (icol first-statement (case-fold-search t)
-	     (fortran-minimum-statement-indent
-	      (if indent-tabs-mode
-		  fortran-minimum-statement-indent-tab
-		fortran-minimum-statement-indent-fixed)))
-    (save-excursion
-      (setq first-statement (fortran-previous-statement))
-      (if first-statement
-	  (setq icol fortran-minimum-statement-indent)
-	(progn
-	  (if (= (point) (point-min))
-	      (setq icol fortran-minimum-statement-indent)
-	    (setq icol (fortran-current-line-indentation)))
-	  (skip-chars-forward " \t0-9")
-	  (cond ((looking-at "if[ \t]*(")
-		 (if (or (looking-at ".*)[ \t]*then\\b[ \t]*[^ \t_$(=a-z0-9]")
-			 (let (then-test)	;multi-line if-then
-			   (while (and (= (forward-line 1) 0)
-				       ;;search forward for then
-				       (or (looking-at "     [^ 0\n]")
-					   (looking-at "\t[1-9]"))
-				       (not (setq then-test (looking-at
-							     ".*then\\b[ \t]\
-*[^ \t_$(=a-z0-9]")))))
-			   then-test))
-		     (setq icol (+ icol fortran-if-indent))))
-		((looking-at "\\(else\\|elseif\\)\\b")
-		 (setq icol (+ icol fortran-if-indent)))
-		((looking-at "select[ \t]*case[ \t](.*)\\b")
-		 (setq icol (+ icol fortran-if-indent)))
-		((looking-at "case[ \t]*(.*)[ \t]*\n")
-		 (setq icol (+ icol fortran-if-indent)))
-		((looking-at "case[ \t]*default\\b")
-		 (setq icol (+ icol fortran-if-indent)))
-		((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b")
-		 (setq icol (+ icol fortran-if-indent)))
-		((looking-at "where[ \t]*(.*)[ \t]*\n")
-		 (setq icol (+ icol fortran-if-indent)))
-		((looking-at "do\\b")
-		 (setq icol (+ icol fortran-do-indent)))
-		((looking-at
-		  "\\(structure\\|union\\|map\\|interface\\)\\b[ \t]*[^ \t=(a-z]")
-		 (setq icol (+ icol fortran-structure-indent)))
-		((looking-at "end\\b[ \t]*[^ \t=(a-z]")
-		 ;; Previous END resets indent to minimum
-		 (setq icol fortran-minimum-statement-indent))))))
-    (save-excursion
-      (beginning-of-line)
-      (cond ((looking-at "[ \t]*$"))
-	    ((looking-at comment-line-start-skip)
-	     (cond ((eq fortran-comment-indent-style 'relative)
-		    (setq icol (+ icol fortran-comment-line-extra-indent)))
-		   ((eq fortran-comment-indent-style 'fixed)
-		    (setq icol (+ fortran-minimum-statement-indent
-				  fortran-comment-line-extra-indent))))
-	     (setq fortran-minimum-statement-indent 0))
-	    ((or (looking-at (concat "[ \t]*"
-				     (regexp-quote
-				      fortran-continuation-string)))
-		 (looking-at "     [^ 0\n]")
-		 (looking-at "\t[1-9]"))
-	     (setq icol (+ icol fortran-continuation-indent)))
-	    ((looking-at "[ \t]*#")	; Check for cpp directive.
-	     (setq fortran-minimum-statement-indent 0 icol 0))
-	    (first-statement)
-	    ((and fortran-check-all-num-for-matching-do
-		  (looking-at "[ \t]*[0-9]+")
-		  (fortran-check-for-matching-do))
-	     (setq icol (- icol fortran-do-indent)))
-	    (t
-	     (skip-chars-forward " \t0-9")
-	     (cond ((looking-at "end[ \t]*if\\b")
-		    (setq icol (- icol fortran-if-indent)))
-		   ((looking-at "\\(else\\|elseif\\)\\b")
-		    (setq icol (- icol fortran-if-indent)))
-                   ((looking-at "case[ \t]*(.*)[ \t]*\n")
-		    (setq icol (- icol fortran-if-indent)))
-                   ((looking-at "case[ \t]*default\\b")
-		    (setq icol (- icol fortran-if-indent)))
-		   ((looking-at "\\(otherwise\\|else[ \t]*where\\)\\b")
-		    (setq icol (- icol fortran-if-indent)))
-		   ((looking-at "end[ \t]*where\\b")
-		    (setq icol (- icol fortran-if-indent)))
-		   ((and (looking-at "continue\\b")
-			 (fortran-check-for-matching-do))
-		    (setq icol (- icol fortran-do-indent)))
-		   ((looking-at "end[ \t]*do\\b")
-		    (setq icol (- icol fortran-do-indent)))
-		   ((looking-at
-		     "end[ \t]*\
-\\(structure\\|union\\|map\\|interface\\)\\b[ \t]*[^ \t=(a-z]")
-		    (setq icol (- icol fortran-structure-indent)))
-		   ((looking-at
-		     "end[ \t]*select\\b[ \t]*[^ \t=(a-z]")
-		    (setq icol (- icol fortran-if-indent)))
-		   ((and (looking-at "end\\b[ \t]*[^ \t=(a-z]")
-			 (not (= icol fortran-minimum-statement-indent)))
- 		    (message "Warning: `end' not in column %d.  Probably\
- an unclosed block." fortran-minimum-statement-indent))))))
-    (max fortran-minimum-statement-indent icol)))
-
-(defun fortran-current-line-indentation ()
-  "Indentation of current line, ignoring Fortran line number or continuation.
-This is the column position of the first non-whitespace character
-aside from the line number and/or column 5/8 line-continuation character.
-For comment lines, returns indentation of the first
-non-indentation text within the comment."
-  (save-excursion
-    (beginning-of-line)
-    (cond ((looking-at comment-line-start-skip)
-	   (goto-char (match-end 0))
-	   (skip-chars-forward
-	    (if (stringp fortran-comment-indent-char)
-		fortran-comment-indent-char
-	      (char-to-string fortran-comment-indent-char))))
-	  ((or (looking-at "     [^ 0\n]")
-	       (looking-at "\t[1-9]"))
-	   (goto-char (match-end 0)))
-	  (t
-	   ;; Move past line number.
-	   (skip-chars-forward "[ \t0-9]");From Uli
-	   ))
-    ;; Move past whitespace.
-    (skip-chars-forward " \t")
-    (current-column)))
-
-(defun fortran-indent-to-column (col)
-  "Indents current line with spaces to column COL.
-notes: 1) A non-zero/non-blank character in column 5 indicates a continuation
-          line, and this continuation character is retained on indentation;
-       2) If `fortran-continuation-string' is the first non-whitespace
-          character, this is a continuation line;
-       3) A non-continuation line which has a number as the first
-          non-whitespace character is a numbered line.
-       4) A TAB followed by a digit indicates a continuation line."
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at comment-line-start-skip)
-	(if fortran-comment-indent-style
-	    (let ((char (if (stringp fortran-comment-indent-char)
-			    (aref fortran-comment-indent-char 0)
-			  fortran-comment-indent-char)))
-	      (goto-char (match-end 0))
-	      (delete-horizontal-regexp (concat " \t" (char-to-string char)))
-	      (insert-char char (- col (current-column)))))
-      (if (looking-at "\t[1-9]")
-	  (if indent-tabs-mode
-	      (goto-char (match-end 0))
-	    (delete-char 2)
-	    (insert "     ")
-	    (insert fortran-continuation-string))
-	(if (looking-at "     [^ 0\n]")
-	    (if indent-tabs-mode
-		(progn (delete-char 6)
-		       (insert "\t")
-		       (insert-char (fortran-numerical-continuation-char) 1))
-	      (forward-char 6))
-	  (delete-horizontal-space)
-	  ;; Put line number in columns 0-4
-	  ;; or put continuation character in column 5.
-	  (cond ((eobp))
-		((looking-at (regexp-quote fortran-continuation-string))
-		 (if indent-tabs-mode
-		     (progn
-		       (indent-to 
-			(if indent-tabs-mode
-			    fortran-minimum-statement-indent-tab
-			  fortran-minimum-statement-indent-fixed))
-		       (delete-char 1)
-		       (insert-char (fortran-numerical-continuation-char) 1))
-		   (indent-to 5)
-		   (forward-char 1)))
-		((looking-at "[0-9]+")
-		 (let ((extra-space (- 5 (- (match-end 0) (point)))))
-		   (if (< extra-space 0)
-		       (message "Warning: line number exceeds 5-digit limit.")
-		     (indent-to (min fortran-line-number-indent extra-space))))
-		 (skip-chars-forward "0-9")))))
-      ;; Point is now after any continuation character or line number.
-      ;; Put body of statement where specified.
-      (delete-horizontal-space)
-      (indent-to col)
-      ;; Indent any comment following code on the same line.
-      (if (and comment-start-skip
-	       (fortran-find-comment-start-skip))
-	  (progn (goto-char (match-beginning 0))
-		 (if (not (= (current-column) (fortran-comment-hook)))
-		     (progn (delete-horizontal-space)
-			    (indent-to (fortran-comment-hook)))))))))
-
-(defun fortran-line-number-indented-correctly-p ()
-  "Return t if current line's line number is correctly indented.
-Do not call if there is no line number."
-  (save-excursion
-    (beginning-of-line)
-    (skip-chars-forward " \t")
-    (and (<= (current-column) fortran-line-number-indent)
-	 (or (= (current-column) fortran-line-number-indent)
-	     (progn (skip-chars-forward "0-9")
-		    (= (current-column) 5))))))
-
-(defun fortran-check-for-matching-do ()
-  "When called from a numbered statement, returns t if matching DO is found.
-Otherwise return a nil."
-  (let (charnum
-	(case-fold-search t))
-    (save-excursion
-      (beginning-of-line)
-      (if (looking-at "[ \t]*[0-9]+")
-	  (progn
-	    (skip-chars-forward " \t")
-	    (skip-chars-forward "0") ;skip past leading zeros
-	    (setq charnum (buffer-substring (point)
-					    (progn (skip-chars-forward "0-9")
-						   (point))))
-	    (beginning-of-line)
-	    (and (re-search-backward
-		  (concat "\\(^[ \t0-9]*end\\b[ \t]*[^ \t=(a-z]\\)\\|"
-			  "\\(^[ \t0-9]*do[ \t]*0*" charnum "\\b\\)\\|"
-			  "\\(^[ \t]*0*" charnum "\\b\\)")
-		  nil t)
-		 (looking-at (concat "^[ \t0-9]*do[ \t]*0*" charnum))))))))
-
-(defun fortran-find-comment-start-skip ()
-  "Move to past `comment-start-skip' found on current line.
-Return t if `comment-start-skip' found, nil if not."
-;;; In order to move point only if comment-start-skip is found,
-;;; this one uses a lot of save-excursions.  Note that re-search-forward
-;;; moves point even if comment-start-skip is inside a string-constant.
-;;; Some code expects certain values for match-beginning and end
-  (interactive)
-  (if (save-excursion
-	(re-search-forward comment-start-skip
-			   (save-excursion (end-of-line) (point)) t))
-      (let ((save-match-beginning (match-beginning 0))
-	    (save-match-end (match-end 0)))
-	(if (fortran-is-in-string-p (match-beginning 0))
-	    (save-excursion
-	      (goto-char save-match-end)
-	      (fortran-find-comment-start-skip)) ; recurse for rest of line
-	  (goto-char save-match-beginning)
-	  (re-search-forward comment-start-skip
-			     (save-excursion (end-of-line) (point)) t)
-	  (goto-char (match-end 0))
-	  t))
-    nil))
-
-;;;From: simon@gnu (Simon Marshall)
-;;; Find the next ! not in a string.
-(defun fortran-match-!-comment (limit)
-  (let (found)
-    (while (and (setq found (search-forward "!" limit t))
-                (fortran-is-in-string-p (point))))
-    (if (not found)
-	nil
-      ;; Cheaper than `looking-at' "!.*".
-      (store-match-data
-       (list (1- (point)) (progn (end-of-line) (min (point) limit))))
-      t)))
-
-;; The above function is about 10% faster than the below...
-;;(defun fortran-match-!-comment (limit)
-;;  (let (found)
-;;    (while (and (setq found (re-search-forward "!.*" limit t))
-;;                (fortran-is-in-string-p (match-beginning 0))))
-;;    found))
-
-;;;From: ralf@up3aud1.gwdg.de (Ralf Fassel)
-;;; Test if TAB format continuation lines work.
-(defun fortran-is-in-string-p (where)
-  "Return non-nil if POS (a buffer position) is inside a Fortran string,
-nil else."
-  (save-excursion
-    (goto-char where)
-    (cond
-     ((bolp) nil)			; bol is never inside a string
-     ((save-excursion			; comment lines too
-	(beginning-of-line)(looking-at comment-line-start-skip)) nil)
-     (t (let (;; ok, serious now. Init some local vars:
-	      (parse-state '(0 nil nil nil nil nil 0))
-	      (quoted-comment-start (if comment-start
-					(regexp-quote comment-start)))
-	      (not-done t)
-	      parse-limit
-	      end-of-line
-	      )
-	  ;; move to start of current statement
-	  (fortran-next-statement)
-	  (fortran-previous-statement)
-	  ;; now parse up to WHERE
-	  (while not-done
-	    (if (or ;; skip to next line if:
-		 ;; - comment line?
-		 (looking-at comment-line-start-skip)
-		 ;; - at end of line?
-		 (eolp)
-		 ;; - not in a string and after comment-start?
-		 (and (not (nth 3 parse-state))
-		      comment-start
-		      (equal comment-start
-			     (char-to-string (preceding-char)))))
-		;; get around a bug in forward-line in versions <= 18.57
-		(if (or (> (forward-line 1) 0) (eobp))
-		    (setq not-done nil))
-	      ;; else:
-	      ;; if we are at beginning of code line, skip any
-	      ;; whitespace, labels and tab continuation markers.
-	      (if (bolp) (skip-chars-forward " \t0-9"))
-	      ;; if we are in column <= 5 now, check for continuation char
-	      (cond ((= 5 (current-column)) (forward-char 1))
-		    ((and (< (current-column) 5)
-			  (equal fortran-continuation-string
-				 (char-to-string (following-char)))
-			  (forward-char 1))))
-	      ;; find out parse-limit from here
-	      (setq end-of-line (save-excursion (end-of-line)(point)))
-	      (setq parse-limit (min where end-of-line))
-	      ;; parse max up to comment-start, if non-nil and in current line
-	      (if comment-start
-		  (save-excursion
-		    (if (re-search-forward quoted-comment-start end-of-line t)
-			(setq parse-limit (min (point) parse-limit)))))
-	      ;; now parse if still in limits
-	      (if (< (point) where)
-		  (setq parse-state (parse-partial-sexp
-				     (point) parse-limit nil nil parse-state))
-		(setq not-done nil))
-	      ))
-	  ;; result is
-	  (nth 3 parse-state))))))
-
-(defun fortran-auto-fill-mode (arg)
-  "Toggle fortran-auto-fill mode.
-With ARG, turn `fortran-auto-fill' mode on iff ARG is positive.
-In `fortran-auto-fill' mode, inserting a space at a column beyond `fill-column'
-automatically breaks the line at a previous space."
-  (interactive "P")
-  (prog1 (setq auto-fill-function
-	       (if (if (null arg)
-		       (not auto-fill-function)
-		     (> (prefix-numeric-value arg) 0))
-		   'fortran-do-auto-fill
-		 nil))
-    (force-mode-line-update)))
-
-(defun fortran-do-auto-fill ()
-  (if (> (current-column) fill-column)
-      (fortran-indent-line)))
-
-(defun fortran-fill ()
-  (interactive)
-  (let* ((opoint (point))
-	 (bol (save-excursion (beginning-of-line) (point)))
-	 (eol (save-excursion (end-of-line) (point)))
-	 (bos (min eol (+ bol (fortran-current-line-indentation))))
-	 (quote
-	  (save-excursion
-	    (goto-char bol)
-	    (if (looking-at comment-line-start-skip)
-		nil			; OK to break quotes on comment lines.
-	      (move-to-column fill-column)
-	      (cond ((fortran-is-in-string-p (point))
-		     (save-excursion (re-search-backward "[^']'[^']" bol t)
-				     (if fortran-break-before-delimiters
-					 (point)
-				       (1+ (point)))))
-		    (t nil)))))
-	 ;;
-	 ;; decide where to split the line. If a position for a quoted
-	 ;; string was found above then use that, else break the line
-	 ;; before the last delimiter.
-	 ;; Delimiters are whitespace, commas, and operators.
-	 ;; Will break before a pair of *'s.
-	 ;;
-	 (fill-point
-	  (or quote
-	      (save-excursion
-		(move-to-column (1+ fill-column))
-		(skip-chars-backward "^ \t\n,'+-/*=)"
-;;;		 (if fortran-break-before-delimiters
-;;;		     "^ \t\n,'+-/*=" "^ \t\n,'+-/*=)")
-		 )
-		(if (<= (point) (1+ bos))
-		    (progn
-		      (move-to-column (1+ fill-column))
-;;;what is this doing???
-		      (if (not (re-search-forward "[\t\n,'+-/*)=]" eol t))
-			  (goto-char bol))))
-		(if (bolp)
-		    (re-search-forward "[ \t]" opoint t)
-		  (forward-char -1)
-		  (if (looking-at "'")
-		      (forward-char 1)
-		    (skip-chars-backward " \t\*")))
-		(if fortran-break-before-delimiters
-		    (point)
-		  (1+ (point))))))
-	 )
-    ;; if we are in an in-line comment, don't break unless the
-    ;; line of code is longer than it should be. Otherwise
-    ;; break the line at the column computed above.
-    ;;
-    ;; Need to use fortran-find-comment-start-skip to make sure that quoted !'s
-    ;; don't prevent a break.
-    (if (not (or (save-excursion
-		   (if (and (re-search-backward comment-start-skip bol t)
-			    (not (fortran-is-in-string-p (point))))
-		       (progn
-			 (skip-chars-backward " \t")
-			 (< (current-column) (1+ fill-column)))))
-		 (save-excursion
-		   (goto-char fill-point)
-		   (bolp))))
-	(if (> (save-excursion
-		 (goto-char fill-point) (current-column))
-	       (1+ fill-column))
-	    (progn (goto-char fill-point)
-		   (fortran-break-line))
-	  (save-excursion
-	    (if (> (save-excursion
-		     (goto-char fill-point) 
-		     (current-column))
-		   (+ (calculate-fortran-indent) fortran-continuation-indent))
-		(progn
-		  (goto-char fill-point)
-		  (fortran-break-line))))))
-    ))
-(defun fortran-break-line ()
-  (let ((opoint (point))
-	(bol (save-excursion (beginning-of-line) (point)))
-	(eol (save-excursion (end-of-line) (point)))
-	(comment-string nil))
-    
-    (save-excursion
-      (if (and comment-start-skip (fortran-find-comment-start-skip))
-	  (progn
-	    (re-search-backward comment-start-skip bol t)
-	    (setq comment-string (buffer-substring (point) eol))
-	    (delete-region (point) eol))))
-;;; Forward line 1 really needs to go to next non white line
-    (if (save-excursion (forward-line 1)
-			(or (looking-at "     [^ 0\n]")
-			    (looking-at "\t[1-9]")))
-	(progn
-	  (end-of-line)
-	  (delete-region (point) (match-end 0))
-	  (delete-horizontal-space)
-	  (fortran-fill))
-      (fortran-split-line))
-    (if comment-string
-	(save-excursion
-	  (goto-char bol)
-	  (end-of-line)
-	  (delete-horizontal-space)
-	  (indent-to (fortran-comment-hook))
-	  (insert comment-string)))))
-
-(defun fortran-analyze-file-format ()
-  "Returns nil if fixed format is used, t if TAB formatting is used.
-Use `fortran-tab-mode-default' if no non-comment statements are found in the
-file before the end or the first `fortran-analyze-depth' lines."
-  (let ((i 0))
-    (save-excursion
-      (goto-char (point-min))
-      (setq i 0)
-      (while (not (or
-		   (eobp)
-		   (looking-at "\t")
-		   (looking-at "      ")
-		   (> i fortran-analyze-depth)))
-	(forward-line)
-	(setq i (1+ i)))
-      (cond
-       ((looking-at "\t") t)
-       ((looking-at "      ") nil)
-       (fortran-tab-mode-default t)
-       (t nil)))))
-
-(or (assq 'fortran-tab-mode-string minor-mode-alist)
-    (setq minor-mode-alist (cons
-			    '(fortran-tab-mode-string
-			      (indent-tabs-mode fortran-tab-mode-string))
-			    minor-mode-alist)))
-
-(provide 'fortran)
-
-;;; fortran.el ends here
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
deleted file mode 100644
index 5c97d41255e..00000000000
--- a/lisp/progmodes/hideif.el
+++ /dev/null
@@ -1,1048 +0,0 @@
-;;; hide-ifdef-mode.el --- hides selected code within ifdef.
-
-;; Copyright (C) 1988, 1994 Free Software Foundation, Inc.
-
-;; Author: Dan LaLiberte <liberte@a.cs.uiuc.edu>
-;; Maintainer: FSF
-;; Keywords: c, outlines
-
-;; 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:
-
-;; To initialize, toggle the hide-ifdef minor mode with
-;;
-;; M-x hide-ifdef-mode
-;;
-;; This will set up key bindings and call hide-ifdef-mode-hook if it
-;; has a value.  To explicitly hide ifdefs using a buffer-local
-;; define list (default empty), type
-;;
-;; M-x hide-ifdefs  or C-c @ h
-;;
-;; Hide-ifdef suppresses the display of code that the preprocessor wouldn't
-;; pass through.  The support of constant expressions in #if lines is 
-;; limited to identifiers, parens, and the operators: &&, ||, !, and
-;; "defined".  Please extend this.
-;;
-;; The hidden code is marked by ellipses (...).  Be
-;; cautious when editing near ellipses, since the hidden text is
-;; still in the buffer, and you can move the point into it and modify
-;; text unawares.  If you don't want to see the ellipses, set 
-;; selective-display-ellipses to nil.  But this can be dangerous.
-;; You can make your buffer read-only while hide-ifdef-hiding by setting
-;; hide-ifdef-read-only to a non-nil value.  You can toggle this 
-;; variable with hide-ifdef-toggle-read-only (C-c @ C-q).
-;;
-;; You can undo the effect of hide-ifdefs by typing
-;;
-;; M-x show-ifdefs  or C-c @ s
-;;
-;; Use M-x hide-ifdef-define (C-c @ d) to define a symbol.
-;; Use M-x hide-ifdef-undef (C-c @ u) to undefine a symbol.
-;;
-;; If you define or undefine a symbol while hide-ifdef-mode is in effect,
-;; the display will be updated.  Only the define list for the current
-;; buffer will be affected.  You can save changes to the local define
-;; list with hide-ifdef-set-define-alist.  This adds entries 
-;; to hide-ifdef-define-alist.
-;;
-;; If you have defined a hide-ifdef-mode-hook, you can set
-;; up a list of symbols that may be used by hide-ifdefs as in the
-;; following example:
-;;
-;; (setq hide-ifdef-mode-hook
-;;      '(lambda ()
-;;	 (if (not hide-ifdef-define-alist)
-;;	     (setq hide-ifdef-define-alist
-;;		  '((list1 ONE TWO)
-;;		    (list2 TWO THREE)
-;;		    )))
-;;	 (hide-ifdef-use-define-alist 'list2) ; use list2 by default
-;;	 ))
-;;
-;; You can call hide-ifdef-use-define-alist (C-c @ u) at any time to specify
-;; another list to use.
-;;
-;; To cause ifdefs to be hidden as soon as hide-ifdef-mode is called,
-;; set hide-ifdef-initially to non-nil.
-;;
-;; If you set hide-ifdef-lines to t, hide-ifdefs hides all the #ifdef lines.
-;; In the absence of highlighting, that might be a bad idea.  If you set
-;; hide-ifdef-lines to nil (the default), the surrounding preprocessor
-;; lines will be displayed.  That can be confusing in its own
-;; right.  Other variations on display are possible, but not much
-;; better.
-;;
-;; You can explicitly hide or show individual ifdef blocks irrespective
-;; of the define list by using hide-ifdef-block and show-ifdef-block.
-;;
-;; You can move the point between ifdefs with forward-ifdef, backward-ifdef,
-;; up-ifdef, down-ifdef, next-ifdef, and previous-ifdef.
-;;
-;; If you have minor-mode-alist in your mode line (the default) two labels
-;; may appear.  "Ifdef" will appear when hide-ifdef-mode is active.  "Hiding"
-;; will appear when text may be hidden ("hide-ifdef-hiding" is non-nil).
-;;
-;; Written by Brian Marick, at Gould, Computer Systems Division, Urbana IL.
-;; Extensively modified by Daniel LaLiberte (while at Gould).
-;;
-;; You may freely modify and distribute this, but keep a record
-;; of modifications and send comments to:
-;; 	 liberte@a.cs.uiuc.edu  or  ihnp4!uiucdcs!liberte
-;; I will continue to upgrade hide-ifdef-mode
-;; with your contributions.
-
-;;; Code:
-
-(require 'cc-mode)
-
-(defvar hide-ifdef-mode-submap nil
-  "Keymap used with Hide-Ifdef mode.")
-
-(defvar hide-ifdef-mode-map nil
-  "Keymap used with Hide-Ifdef mode.")
-
-(defconst hide-ifdef-mode-prefix-key "\C-c@"
-  "Prefix key for all Hide-Ifdef mode commands.")
-
-;; Set up the submap that goes after the prefix key.
-(if hide-ifdef-mode-submap
-    ()				; Don't redefine it.
-  (setq hide-ifdef-mode-submap (make-sparse-keymap))
-  (define-key hide-ifdef-mode-submap "d" 'hide-ifdef-define)
-  (define-key hide-ifdef-mode-submap "u" 'hide-ifdef-undef)
-  (define-key hide-ifdef-mode-submap "D" 'hide-ifdef-set-define-alist)
-  (define-key hide-ifdef-mode-submap "U" 'hide-ifdef-use-define-alist)
-
-  (define-key hide-ifdef-mode-submap "h" 'hide-ifdefs)
-  (define-key hide-ifdef-mode-submap "s" 'show-ifdefs)
-  (define-key hide-ifdef-mode-submap "\C-d" 'hide-ifdef-block)
-  (define-key hide-ifdef-mode-submap "\C-s" 'show-ifdef-block)
-
-  (define-key hide-ifdef-mode-submap "\C-q" 'hide-ifdef-toggle-read-only)
-  (let ((where (where-is-internal 'toggle-read-only '(keymap) t)))
-    (if where
-	(define-key hide-ifdef-mode-submap
-	  where
-	  'hide-ifdef-toggle-outside-read-only)))
-  )
-
-;; Set up the mode's main map, which leads via the prefix key to the submap.
-(if hide-ifdef-mode-map
-    ()
-  (setq hide-ifdef-mode-map (make-sparse-keymap))
-  (define-key hide-ifdef-mode-map hide-ifdef-mode-prefix-key
-    hide-ifdef-mode-submap))
-
-(defvar hide-ifdef-mode nil
-  "Non-nil when hide-ifdef-mode is activated.")
-
-(defvar hide-ifdef-hiding nil
-  "Non-nil when text may be hidden.")
-
-;; Arrange to use the mode's map when the mode is enabled.
-(or (assq 'hide-ifdef-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-          (cons (cons 'hide-ifdef-mode hide-ifdef-mode-map)
-                minor-mode-map-alist)))
-
-(or (assq 'hide-ifdef-hiding minor-mode-alist)
-    (setq minor-mode-alist
-          (cons '(hide-ifdef-hiding " Hiding")
-                minor-mode-alist)))
-
-(or (assq 'hide-ifdef-mode minor-mode-alist)
-    (setq minor-mode-alist
-          (cons '(hide-ifdef-mode " Ifdef")
-                minor-mode-alist)))
-
-;; fix c-mode syntax table so we can recognize whole symbols.
-(defvar hide-ifdef-syntax-table
-  (copy-syntax-table c-mode-syntax-table)
-  "Syntax table used for tokenizing #if expressions.")
-
-(modify-syntax-entry ?_ "w" hide-ifdef-syntax-table)
-(modify-syntax-entry ?& "." hide-ifdef-syntax-table)
-(modify-syntax-entry ?\| "." hide-ifdef-syntax-table)
-
-;;;###autoload
-(defun hide-ifdef-mode (arg)
-  "Toggle Hide-Ifdef mode.  This is a minor mode, albeit a large one.
-With ARG, turn Hide-Ifdef mode on if arg is positive, off otherwise.
-In Hide-Ifdef mode, code within #ifdef constructs that the C preprocessor
-would eliminate may be hidden from view.  Several variables affect
-how the hiding is done:
-
-hide-ifdef-env
-	An association list of defined and undefined symbols for the
-	current buffer.  Initially, the global value of `hide-ifdef-env'
-	is used.
-
-hide-ifdef-define-alist
-	An association list of defined symbol lists.  
-        Use `hide-ifdef-set-define-alist' to save the current `hide-ifdef-env'
-        and `hide-ifdef-use-define-alist' to set the current `hide-ifdef-env'
-        from one of the lists in `hide-ifdef-define-alist'.
-
-hide-ifdef-lines
-	Set to non-nil to not show #if, #ifdef, #ifndef, #else, and
-	#endif lines when hiding.
-
-hide-ifdef-initially
-	Indicates whether `hide-ifdefs' should be called when Hide-Ifdef mode
-	is activated.
-
-hide-ifdef-read-only
-	Set to non-nil if you want to make buffers read only while hiding.
-	After `show-ifdefs', read-only status is restored to previous value.
-
-\\{hide-ifdef-mode-map}"
-
-  (interactive "P")
-  (make-local-variable 'hide-ifdef-mode)
-  (setq hide-ifdef-mode
-	(if (null arg)
-	    (not hide-ifdef-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  
-  (force-mode-line-update)
-
-  (if hide-ifdef-mode
-      (progn
-	; inherit global values
-	(make-local-variable 'hide-ifdef-env)
-	(setq hide-ifdef-env (default-value 'hide-ifdef-env))
-
-	(make-local-variable 'hide-ifdef-hiding)
-	(setq hide-ifdef-hiding (default-value 'hide-ifdef-hiding))
-
-	(make-local-variable 'hif-outside-read-only)
-	(setq hif-outside-read-only buffer-read-only)
-
-	(run-hooks 'hide-ifdef-mode-hook)
-
-	(if hide-ifdef-initially
-	    (hide-ifdefs)
-	  (show-ifdefs))
-	(message "Enter Hide-Ifdef mode")
-	)
-     ; else end hide-ifdef-mode
-    (if hide-ifdef-hiding
-	(show-ifdefs))
-    (message "Exit Hide-Ifdef mode")
-    ))
-  
-
-;; from outline.el with docstring fixed.
-(defun hif-outline-flag-region (from to flag)
-  "Hides or shows lines from FROM to TO, according to FLAG.
-If FLAG is \\n (newline character) then text is shown, while if FLAG is \\^M
-\(control-M) the text is hidden."
-  (let ((modp (buffer-modified-p)))
-    (unwind-protect (progn
-		      (subst-char-in-region from to
-			      (if (= flag ?\n) ?\^M ?\n)
-			      flag t) )
-      (set-buffer-modified-p modp))
-    ))
-
-(defun hif-show-all ()
-  "Show all of the text in the current buffer."
-  (interactive)
-  (hif-outline-flag-region (point-min) (point-max) ?\n))
-
-;; By putting this on after-revert-hook, we arrange that it only
-;; does anything when revert-buffer avoids turning off the mode.
-;; (That can happen in VC.)
-(defun hif-before-revert-function ()
-  (and hide-ifdef-mode hide-ifdef-hiding
-       (hide-ifdefs t)))
-(add-hook 'after-revert-hook 'hif-before-revert-function)
-
-(defun hide-ifdef-region (start end)
-  "START is the start of a #if or #else form.  END is the ending part.
-Everything including these lines is made invisible."
-  (hif-outline-flag-region start end ?\^M)
-  )
-
-(defun hif-show-ifdef-region (start end)
-  "Everything between START and END is made visible."
-  (hif-outline-flag-region start end ?\n)
-  )
-
-
-
-;===%%SF%% evaluation (Start)  ===
-
-;; It is not useful to set this to anything but `eval'.
-;; In fact, the variable might as well be eliminated.
-(defvar hide-ifdef-evaluator 'eval
-  "The function to use to evaluate a form.
-The evaluator is given a canonical form and returns t if text under
-that form should be displayed.")
-
-(defvar hif-undefined-symbol nil
-  "...is by default considered to be false.")
-
-(defvar hide-ifdef-env nil
-  "An alist of defined symbols and their values.")
-
-
-(defun hif-set-var (var value)
-  "Prepend (var value) pair to hide-ifdef-env."
-  (setq hide-ifdef-env (cons (cons var value) hide-ifdef-env)))
-
-
-(defun hif-lookup (var)
-;  (message "hif-lookup %s" var)
-  (let ((val (assoc var hide-ifdef-env)))
-    (if val
-	(cdr val)
-      hif-undefined-symbol)))
-
-(defun hif-defined (var)
-  (hif-lookup var)
-  ; when #if expressions are fully supported, defined result should be 1
-  ;  (if (assoc var  hide-ifdef-env)
-  ;      1
-  ;    nil)
-)
-
-
-;===%%SF%% evaluation (End)  ===
-
-
-
-;===%%SF%% parsing (Start)  ===
-;;;  The code that understands what ifs and ifdef in files look like.
-
-(defconst hif-cpp-prefix "\\(^\\|\r\\)[ \t]*#[ \t]*")
-(defconst hif-ifndef-regexp (concat hif-cpp-prefix "ifndef"))
-(defconst hif-ifx-regexp (concat hif-cpp-prefix "if\\(n?def\\)?[ \t]+"))
-(defconst hif-else-regexp (concat hif-cpp-prefix "else"))
-(defconst hif-endif-regexp (concat hif-cpp-prefix "endif"))
-(defconst hif-ifx-else-endif-regexp
-  (concat hif-ifx-regexp "\\|" hif-else-regexp "\\|" hif-endif-regexp))
-
-
-(defun hif-infix-to-prefix (token-list)
-  "Convert list of tokens in infix into prefix list"
-;  (message "hif-infix-to-prefix: %s" token-list)
-  (if (= 1 (length token-list))
-      (` (hif-lookup (quote (, (car token-list)))))
-    (hif-parse-if-exp token-list))
-  )
-
-; pattern to match initial identifier, !, &&, ||, (, or ).
-; Added ==, + and -: garyo@avs.com 8/9/94
-(defconst hif-token-regexp "^\\(&&\\|||\\|[!=]=\\|!\\|[()+-]\\|\\w+\\)")
-(defconst hif-end-of-comment "\\*/")
-
-
-(defun hif-tokenize (expr-string)
-  "Separate string into a list of tokens"
-  (let ((token-list nil)
-	(expr-start 0)
-	(expr-length (length expr-string))
-	(current-syntax-table (syntax-table)))
-    (unwind-protect
-	(progn
-	  (set-syntax-table hide-ifdef-syntax-table)
-	  (while (< expr-start expr-length) 
-;	    (message "expr-start = %d" expr-start) (sit-for 1)
-	    (cond
-	     ((string-match "^[ \t]+" expr-string expr-start)
-	      ;; skip whitespace
-	      (setq expr-start (match-end 0))
-	      ;; stick newline in string so ^ matches on the next string-match
-	      (aset expr-string (1- expr-start) ?\n))
-
-	     ((string-match "^/\\*" expr-string expr-start)
-	      (setq expr-start (match-end 0))
-	      (aset expr-string (1- expr-start) ?\n)
-	      (or
-	       (string-match hif-end-of-comment
-			     expr-string expr-start) ; eat comment
-	       (string-match "$" expr-string expr-start)) ; multi-line comment
-	      (setq expr-start (match-end 0))
-	      (aset expr-string (1- expr-start) ?\n))
-
-	     ((string-match "^//" expr-string expr-start)
-	      (string-match "$" expr-string expr-start)
-	      (setq expr-start (match-end 0)))
-
-	     ((string-match hif-token-regexp expr-string expr-start)
-	      (let ((token (substring expr-string expr-start (match-end 0))))
-		(setq expr-start (match-end 0))
-		(aset expr-string (1- expr-start) ?\n)
-;		(message "token: %s" token) (sit-for 1)
-		(setq token-list
-		      (cons
-		       (cond
-			((string-equal token "||") 'or)
-			((string-equal token "&&") 'and)
-			((string-equal token "==") 'equal)
-			((string-equal token "!=") 'hif-notequal)
-			((string-equal token "!")  'not)
-			((string-equal token "defined") 'hif-defined)
-			((string-equal token "(") 'lparen)
-			((string-equal token ")") 'rparen)
-			((string-equal token "+") 'hif-plus)
-			((string-equal token "-") 'hif-minus)
-			(t (intern token)))
-		       token-list))))
-	     (t (error "Bad #if expression: %s" expr-string)))))
-      (set-syntax-table current-syntax-table))
-    (nreverse token-list)))
-
-;;;-----------------------------------------------------------------
-;;; Translate C preprocessor #if expressions using recursive descent.
-;;; This parser is limited to the operators &&, ||, !, and "defined".
-;;; Added ==, !=, +, and -.  Gary Oberbrunner, garyo@avs.com, 8/9/94
-
-(defun hif-parse-if-exp (token-list)
-  "Parse the TOKEN-LIST.  Return translated list in prefix form."
-  (hif-nexttoken)
-  (prog1
-      (hif-expr)
-    (if token ; is there still a token?
-	(error "Error: unexpected token: %s" token))))
-
-(defun hif-nexttoken ()
-  "Pop the next token from token-list into the let variable \"token\"."
-  (setq token (car token-list))
-  (setq token-list (cdr token-list))
-  token)
-
-(defun hif-expr ()
-  "Parse an expression as found in #if.
-       expr : term | expr '||' term."
-  (let ((result (hif-term)))
-    (while (eq  token 'or)
-      (hif-nexttoken)
-      (setq result (list 'or result (hif-term))))
-  result))
-
-(defun hif-term ()
-  "Parse a term : eq-expr | term '&&' eq-expr."
-  (let ((result (hif-eq-expr)))
-    (while (eq token 'and)
-      (hif-nexttoken)
-      (setq result (list 'and result (hif-eq-expr))))
-    result))
-
-(defun hif-eq-expr ()
-  "Parse an eq-expr : math | eq-expr '=='|'!=' math."
-  (let ((result (hif-math))
-	(eq-token nil))
-    (while (or (eq token 'equal) (eq token 'hif-notequal))
-      (setq eq-token token)
-      (hif-nexttoken)
-      (setq result (list eq-token result (hif-math))))
-    result))
-
-(defun hif-math ()
-  "Parse an expression with + or - and simpler things.
-       math : factor | math '+|-' factor."
-  (let ((result (hif-factor))
-	(math-op nil))
-    (while (or (eq  token 'hif-plus) (eq token 'hif-minus))
-      (setq math-op token)
-      (hif-nexttoken)
-      (setq result (list math-op result (hif-factor))))
-  result))
-  
-(defun hif-factor ()
-  "Parse a factor: '!' factor | '(' expr ')' | 'defined(' id ')' | id."
-  (cond
-    ((eq token 'not)
-     (hif-nexttoken)
-     (list 'not (hif-factor)))
-
-    ((eq token 'lparen)
-     (hif-nexttoken)
-     (let ((result (hif-expr)))
-       (if (not (eq token 'rparen))
-	   (error "Bad token in parenthesized expression: %s" token)
-	 (hif-nexttoken)
-	 result)))
-
-    ((eq token 'hif-defined)
-     (hif-nexttoken)
-     (if (not (eq token 'lparen))
-	 (error "Error: expected \"(\" after \"defined\""))
-     (hif-nexttoken)
-     (let ((ident token))
-       (if (memq token '(or and not hif-defined lparen rparen))
-	   (error "Error: unexpected token: %s" token))
-       (hif-nexttoken)
-       (if (not (eq token 'rparen))
-	   (error "Error: expected \")\" after identifier"))
-       (hif-nexttoken)
-       (` (hif-defined (quote (, ident))))
-       ))
-
-    (t ; identifier
-      (let ((ident token))
-	(if (memq ident '(or and))
-	    (error "Error: missing identifier"))
-	(hif-nexttoken)
-	(` (hif-lookup (quote (, ident))))
-	))
-    ))
-
-(defun hif-mathify (val)
-  "Treat VAL as a number: if it's t or nil, use 1 or 0."
-  (cond ((eq val t)
-	 1)
-	((null val)
-	 0)
-	(t val)))
-
-(defun hif-plus (a b)
-  "Like ordinary plus but treat t and nil as 1 and 0."
-  (+ (hif-mathify a) (hif-mathify b)))
-(defun hif-minus (a b)
-  "Like ordinary minus but treat t and nil as 1 and 0."
-  (- (hif-mathify a) (hif-mathify b)))
-(defun hif-notequal (a b)
-  "Like (not (equal A B)) but as one symbol."
-  (not (equal a b)))
-
-;;;----------- end of parser -----------------------
-
-
-(defun hif-canonicalize ()
-  "When at beginning of #ifX, returns a Lisp expression for its condition."
-  (save-excursion
-    (let ((negate (looking-at hif-ifndef-regexp)))
-      (re-search-forward hif-ifx-regexp)
-      (let* ((expr-string
-	      (buffer-substring (point)
-				(progn (skip-chars-forward "^\n\r") (point))))
-	     (expr (hif-infix-to-prefix (hif-tokenize expr-string))))
-;	(message "hif-canonicalized: %s" expr)
-	(if negate
-	    (list 'not expr)
-	  expr)))))
-
-
-(defun hif-find-any-ifX ()
-  "Move to next #if..., or #ifndef, at point or after."
-;  (message "find ifX at %d" (point))
-  (prog1
-      (re-search-forward hif-ifx-regexp (point-max) t)
-    (beginning-of-line)))
-
-
-(defun hif-find-next-relevant ()
-  "Move to next #if..., #else, or #endif, after the current line."
-;  (message "hif-find-next-relevant at %d" (point))
-  (end-of-line)
-  ; avoid infinite recursion by only going to beginning of line if match found
-  (if (re-search-forward hif-ifx-else-endif-regexp (point-max) t)
-      (beginning-of-line)))
-
-(defun hif-find-previous-relevant ()
-  "Move to previous #if..., #else, or #endif, before the current line."
-;  (message "hif-find-previous-relevant at %d" (point))
-  (beginning-of-line)
-  ; avoid infinite recursion by only going to beginning of line if match found
-  (if (re-search-backward hif-ifx-else-endif-regexp (point-min) t)
-     (beginning-of-line)))
-
-
-(defun hif-looking-at-ifX ()		;; Should eventually see #if
-  (looking-at hif-ifx-regexp))
-(defun hif-looking-at-endif ()
-  (looking-at hif-endif-regexp))
-(defun hif-looking-at-else ()
-  (looking-at hif-else-regexp))
-
-
-
-(defun hif-ifdef-to-endif ()
-  "If positioned at #ifX or #else form, skip to corresponding #endif."
-;  (message "hif-ifdef-to-endif at %d" (point)) (sit-for 1)
-  (hif-find-next-relevant)
-  (cond ((hif-looking-at-ifX)
-	 (hif-ifdef-to-endif) ; find endif of nested if
-	 (hif-ifdef-to-endif)) ; find outer endif or else
-	((hif-looking-at-else)
-	 (hif-ifdef-to-endif)) ; find endif following else
-	((hif-looking-at-endif)
-	 'done)
-	(t
-	 (error "Mismatched #ifdef #endif pair"))))
-
-
-(defun hif-endif-to-ifdef ()
-  "If positioned at #endif form, skip backward to corresponding #ifX."
-;  (message "hif-endif-to-ifdef at %d" (point))
-  (let ((start (point)))
-    (hif-find-previous-relevant)
-    (if (= start (point))
-	(error "Mismatched #ifdef #endif pair")))
-  (cond ((hif-looking-at-endif)
-	 (hif-endif-to-ifdef) ; find beginning of nested if
-	 (hif-endif-to-ifdef)) ; find beginning of outer if or else
-	((hif-looking-at-else)
-	 (hif-endif-to-ifdef))
-	((hif-looking-at-ifX)
-	 'done)
-	(t)))			; never gets here
-
-
-(defun forward-ifdef (&optional arg)
-  "Move point to beginning of line of the next ifdef-endif.
-With argument, do this that many times."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (if (< arg 0)
-      (backward-ifdef (- arg)))
-  (while (< 0 arg)
-    (setq arg (- arg))
-    (let ((start (point)))
-      (if (not (hif-looking-at-ifX))
-	  (hif-find-next-relevant))
-      (if (hif-looking-at-ifX)
-	  (hif-ifdef-to-endif)
-	(goto-char start)
-	(error "No following #ifdef")
-	))))
-
-
-(defun backward-ifdef (&optional arg)
-  "Move point to beginning of the previous ifdef-endif.
-With argument, do this that many times."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (if (< arg 0)
-      (forward-ifdef (- arg)))
-  (while (< 0 arg)
-    (setq arg (1- arg))
-    (beginning-of-line)
-    (let ((start (point)))
-      (if (not (hif-looking-at-endif))
-	  (hif-find-previous-relevant))
-      (if (hif-looking-at-endif)
-	  (hif-endif-to-ifdef)
-	(goto-char start)
-	(error "No previous #ifdef")))))
-
-
-(defun down-ifdef ()
-  "Move point to beginning of nested ifdef or else-part."
-    (interactive)
-    (let ((start (point)))
-      (hif-find-next-relevant)
-      (if (or (hif-looking-at-ifX) (hif-looking-at-else))
-	  ()
-	(goto-char start)
-	(error "No following #ifdef"))))
-
-
-(defun up-ifdef ()
-  "Move point to beginning of enclosing ifdef or else-part."
-  (interactive)
-  (beginning-of-line)
-  (let ((start (point)))
-    (if (not (hif-looking-at-endif))
-	(hif-find-previous-relevant))
-    (if (hif-looking-at-endif)
-	(hif-endif-to-ifdef))
-      (if (= start (point))
-	  (error "No previous #ifdef"))))
-
-(defun next-ifdef (&optional arg)
-  "Move to the beginning of the next #ifX, #else, or #endif.
-With argument, do this that many times."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (if (< arg 0)
-      (previous-ifdef (- arg)))
-  (while (< 0 arg)
-    (setq arg (1- arg))
-    (hif-find-next-relevant)
-    (if (eolp)
-	(progn
-	  (beginning-of-line)
-	  (error "No following #ifdefs, #elses, or #endifs")))))
-
-(defun previous-ifdef (&optional arg)
-  "Move to the beginning of the previous #ifX, #else, or #endif.
-With argument, do this that many times."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (if (< arg 0)
-      (next-ifdef (- arg)))
-  (while (< 0 arg)
-    (setq arg (1- arg))
-    (let ((start (point)))
-      (hif-find-previous-relevant)
-      (if (= start (point))
-	  (error "No previous #ifdefs, #elses, or #endifs")
-	))))
-
-
-;===%%SF%% parsing (End)  ===
-
-
-;===%%SF%% hide-ifdef-hiding (Start)  ===
-
-
-;;; A range is a structure with four components:
-;;; ELSE-P	True if there was an else clause for the ifdef.
-;;; START	The start of the range. (beginning of line)
-;;; ELSE	The else marker (beginning of line)
-;;;			Only valid if ELSE-P is true.
-;;; END		The end of the range.  (beginning of line)
-
-(defun hif-make-range (else-p start end &optional else)
-  (list else-p start else end))
-
-(defun hif-range-else-p (range)  (elt range 0))
-(defun hif-range-start (range) (elt range 1))
-(defun hif-range-else (range) (elt range 2))
-(defun hif-range-end (range) (elt range 3))
-
-
-
-;;; Find-Range
-;;; The workhorse, it delimits the #if region.  Reasonably simple:
-;;; Skip until an #else or #endif is found, remembering positions.  If
-;;; an #else was found, skip some more, looking for the true #endif.
-
-(defun hif-find-range ()
-  "Returns a Range structure describing the current #if region.
-Point is left unchanged."
-;  (message "hif-find-range at %d" (point))
-  (save-excursion
-    (beginning-of-line)
-    (let ((start (point))
-	  (else-p nil)
-	  (else nil)
-	  (end nil))
-      ;; Part one.  Look for either #endif or #else.
-      ;; This loop-and-a-half dedicated to E. Dijkstra.
-      (hif-find-next-relevant)
-      (while (hif-looking-at-ifX)		; Skip nested ifdef
-	(hif-ifdef-to-endif)
-	(hif-find-next-relevant))
-      ;; Found either a #else or an #endif.
-      (cond ((hif-looking-at-else)
-	     (setq else-p t)
-	     (setq else (point)))
-	    (t
-	     (setq end (point)) ; (save-excursion (end-of-line) (point))
-	     ))
-      ;; If found #else, look for #endif.
-      (if else-p
-	  (progn
-	    (hif-find-next-relevant)
-	    (while (hif-looking-at-ifX)	; Skip nested ifdef
-	      (hif-ifdef-to-endif)
-	      (hif-find-next-relevant))
-	    (if (hif-looking-at-else)
-		(error "Found two elses in a row?  Broken!"))
-	    (setq end (point))  ; (save-excursion (end-of-line) (point))
-	    ))
-      (hif-make-range else-p start end else))))
-
-	  
-;;; A bit slimy.
-;;; NOTE:  If there's an #ifdef at the beginning of the file, we can't
-;;; hide it.  There's no previous newline to replace.  If we added
-;;; one, we'd throw off all the counts.  Feh.
-
-(defun hif-hide-line (point)
-  "Hide the line containing point.  Does nothing if `hide-ifdef-lines' is nil."
-  (if hide-ifdef-lines
-      (save-excursion
-	(goto-char point)
-	(let ((modp (buffer-modified-p)))
-	  (unwind-protect
-	      (progn
-		(beginning-of-line)
-		(if (not (= (point) 1))
-		    (hide-ifdef-region (1- (point)) (point))))
-	    (set-buffer-modified-p modp))
-	  ))
-    ))
-		  
-
-;;;  Hif-Possibly-Hide
-;;;  There are four cases.  The #ifX expression is "taken" if it
-;;;  the hide-ifdef-evaluator returns T.  Presumably, this means the code
-;;;  inside the #ifdef would be included when the program was
-;;;  compiled.  
-;;;
-;;;  Case 1:  #ifX taken, and there's an #else.
-;;;	The #else part must be hidden.  The #if (then) part must be
-;;;	processed for nested #ifX's.
-;;;  Case 2:  #ifX taken, and there's no #else.
-;;;	The #if part must be processed for nested #ifX's.
-;;;  Case 3:  #ifX not taken, and there's an #else.
-;;;	The #if part must be hidden.  The #else part must be processed
-;;;	for nested #ifs.
-;;;  Case 4:  #ifX not taken, and there's no #else.
-;;;	The #ifX part must be hidden.
-;;;
-;;;  Further processing is done by narrowing to the relevant region
-;;;  and just recursively calling hide-ifdef-guts.
-;;;
-;;;  When hif-possibly-hide returns, point is at the end of the
-;;;  possibly-hidden range.
-
-(defun hif-recurse-on (start end)
-  "Call `hide-ifdef-guts' after narrowing to end of START line and END line."
-  (save-excursion
-    (save-restriction
-      (goto-char start)
-      (end-of-line)
-      (narrow-to-region (point) end)
-      (hide-ifdef-guts))))
-
-(defun hif-possibly-hide ()
-  "Called at #ifX expression, this hides those parts that should be hidden.
-It uses the judgement of `hide-ifdef-evaluator'."
-;  (message "hif-possibly-hide") (sit-for 1)
-    (let ((test (hif-canonicalize))
-	  (range (hif-find-range)))
-;      (message "test = %s" test) (sit-for 1)
-      
-      (hif-hide-line (hif-range-end range))
-      (if (funcall hide-ifdef-evaluator test)
-	  (cond ((hif-range-else-p range) ; case 1
-		 (hif-hide-line (hif-range-else range))
-		 (hide-ifdef-region (hif-range-else range) 
-				    (1- (hif-range-end range)))
-		 (hif-recurse-on (hif-range-start range)
-				 (hif-range-else range)))
-		(t ; case 2
-		 (hif-recurse-on (hif-range-start range)
-				 (hif-range-end range))))
-	(cond ((hif-range-else-p range) ; case 3
-	       (hif-hide-line (hif-range-else range))
-	       (hide-ifdef-region (hif-range-start range)
-				  (1- (hif-range-else range)))
-	       (hif-recurse-on (hif-range-else range)
-			       (hif-range-end range)))
-	      (t ; case 4
-	       (hide-ifdef-region (point)
-				  (1- (hif-range-end range))))
-	      ))
-      (hif-hide-line (hif-range-start range))	; Always hide start.
-      (goto-char (hif-range-end range))
-      (end-of-line)
-      ))
-
-
-
-(defun hide-ifdef-guts ()
-  "Does most of the work of `hide-ifdefs'.
-It does not do the work that's pointless to redo on a recursive entry."
-;  (message "hide-ifdef-guts")
-  (save-excursion
-    (goto-char (point-min))
-    (while (hif-find-any-ifX)
-      (hif-possibly-hide))))
-
-;===%%SF%% hide-ifdef-hiding (End)  ===
-
-
-;===%%SF%% exports (Start)  ===
-
-;;;###autoload
-(defvar hide-ifdef-initially nil
-  "*Non-nil means call `hide-ifdefs' when Hide-Ifdef mode is first activated.")
-
-;;;###autoload
-(defvar hide-ifdef-read-only nil
-  "*Set to non-nil if you want buffer to be read-only while hiding text.")
-
-(defvar hif-outside-read-only nil
-  "Internal variable.  Saves the value of `buffer-read-only' while hiding.")
-
-;;;###autoload
-(defvar hide-ifdef-lines nil
-  "*Non-nil means hide the #ifX, #else, and #endif lines.")
-
-(defun hide-ifdef-toggle-read-only ()
-  "Toggle hide-ifdef-read-only."
-  (interactive)
-  (setq hide-ifdef-read-only (not hide-ifdef-read-only))
-  (message "Hide-Read-Only %s"
-	   (if hide-ifdef-read-only "ON" "OFF"))
-  (if hide-ifdef-hiding
-      (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)))
-  (force-mode-line-update))
-
-(defun hide-ifdef-toggle-outside-read-only ()
-  "Replacement for `toggle-read-only' within Hide-Ifdef mode."
-  (interactive)
-  (setq hif-outside-read-only (not hif-outside-read-only))
-  (message "Read only %s"
-	   (if hif-outside-read-only "ON" "OFF"))
-  (setq buffer-read-only
-	(or (and hide-ifdef-hiding hide-ifdef-read-only)
-	    hif-outside-read-only)
-	)
-  (force-mode-line-update))
-
-      
-(defun hide-ifdef-define (var)
-  "Define a VAR so that #ifdef VAR would be included."
-  (interactive "SDefine what? ")
-  (hif-set-var var 1)
-  (if hide-ifdef-hiding (hide-ifdefs)))
-
-(defun hide-ifdef-undef (var)
-  "Undefine a VAR so that #ifdef VAR would not be included."
-  (interactive "SUndefine what? ")
-  (hif-set-var var nil)
-  (if hide-ifdef-hiding (hide-ifdefs)))
-
-
-(defun hide-ifdefs (&optional nomsg)
-  "Hide the contents of some #ifdefs.  
-Assume that defined symbols have been added to `hide-ifdef-env'.  
-The text hidden is the text that would not be included by the C
-preprocessor if it were given the file with those symbols defined.
-
-Turn off hiding by calling `show-ifdefs'."
-
-  (interactive)
-  (message "Hiding...")
-  (setq hif-outside-read-only buffer-read-only)
-  (if (not hide-ifdef-mode)
-      (hide-ifdef-mode 1)) ; turn on hide-ifdef-mode
-  (if hide-ifdef-hiding
-      (show-ifdefs))			; Otherwise, deep confusion.
-  (let ((inhibit-read-only t))
-    (setq selective-display t)
-    (setq hide-ifdef-hiding t)
-    (hide-ifdef-guts))
-  (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only))
-  (or nomsg
-      (message "Hiding done")))
-
-
-(defun show-ifdefs ()
-  "Cancel the effects of `hide-ifdef': show the contents of all #ifdefs."
-  (interactive)
-  (setq buffer-read-only hif-outside-read-only)
-  (setq selective-display nil)	; defaults
-  (let ((inhibit-read-only t))
-    (hif-show-all))
-  (setq hide-ifdef-hiding nil))
-
-
-(defun hif-find-ifdef-block ()
-  "Utility for hide and show `ifdef-block'.
-Set top and bottom of ifdef block."
-  (let (max-bottom)
-  (save-excursion
-    (beginning-of-line)
-    (if (not (or (hif-looking-at-else) (hif-looking-at-ifX)))
-	(up-ifdef))
-    (setq top (point))
-    (hif-ifdef-to-endif)
-    (setq max-bottom (1- (point))))
-  (save-excursion
-    (beginning-of-line)
-    (if (not (hif-looking-at-endif))
-	(hif-find-next-relevant))
-    (while (hif-looking-at-ifX)
-      (hif-ifdef-to-endif)
-      (hif-find-next-relevant))
-    (setq bottom (min max-bottom (1- (point))))))
-  )
-
-
-(defun hide-ifdef-block ()
-  "Hide the ifdef block (true or false part) enclosing or before the cursor."
-  (interactive)
-  (if (not hide-ifdef-mode)
-      (hide-ifdef-mode 1))
-  (setq selective-display t)
-  (let (top bottom (inhibit-read-only t))
-    (hif-find-ifdef-block) ; set top and bottom - dynamic scoping
-    (hide-ifdef-region top bottom)
-    (if hide-ifdef-lines
-	(progn
-	  (hif-hide-line top)
-	  (hif-hide-line (1+ bottom))))
-    (setq hide-ifdef-hiding t))
-  (setq buffer-read-only (or hide-ifdef-read-only hif-outside-read-only)))
-
-
-(defun show-ifdef-block ()
-  "Show the ifdef block (true or false part) enclosing or before the cursor."
-  (interactive)
-  (let ((inhibit-read-only t))
-    (if hide-ifdef-lines
-	(save-excursion
-	  (beginning-of-line)
-	  (hif-show-ifdef-region (1- (point)) (progn (end-of-line) (point))))
-
-      (let (top bottom)
-	(hif-find-ifdef-block)
-	(hif-show-ifdef-region (1- top) bottom)))))
-
-
-;;;  definition alist support
-
-(defvar hide-ifdef-define-alist nil
-  "A global assoc list of pre-defined symbol lists")
-
-(defun hif-compress-define-list (env)
-  "Compress the define list ENV into a list of defined symbols only."
-  (let ((defs (mapcar '(lambda (arg)
-			 (if (hif-lookup (car arg)) (car arg)))
-		      env))
-	(new-defs nil))
-    (while defs
-      (if (car defs)
-	  (setq new-defs (cons (car defs) new-defs)))
-      (setq defs (cdr defs)))
-    new-defs))
-
-(defun hide-ifdef-set-define-alist (name)
-  "Set the association for NAME to `hide-ifdef-env'."
-  (interactive "SSet define list: ")
-  (setq hide-ifdef-define-alist
-	(cons (cons name (hif-compress-define-list hide-ifdef-env))
-	      hide-ifdef-define-alist)))
-
-(defun hide-ifdef-use-define-alist (name)
-  "Set `hide-ifdef-env' to the define list specified by NAME."
-  (interactive "SUse define list: ")
-  (let ((define-list (assoc name hide-ifdef-define-alist)))
-    (if define-list
-	(setq hide-ifdef-env
-	      (mapcar '(lambda (arg) (cons arg t))
-		      (cdr define-list)))
-      (error "No define list for %s" name))
-    (if hide-ifdef-hiding (hide-ifdefs))))
-
-(provide 'hideif)
-
-;;; hideif.el ends here
-
diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el
deleted file mode 100644
index c49c7ea4da3..00000000000
--- a/lisp/progmodes/hideshow.el
+++ /dev/null
@@ -1,492 +0,0 @@
-;;; hideshow.el --- minor mode cmds to selectively display blocks of code
-
-;; Copyright (C) 1994,1995,1996 Free Software Foundation
-
-;; Author: Thien-Thi Nguyen <ttn@netcom.com>
-;; Version: 3.4
-;; Keywords: C C++ lisp tools editing
-;; Time-of-Day-Author-Most-Likely-to-be-Recalcitrant: early morning
-
-;; 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.
-
-;; LCD Archive Entry:
-;; hideshow|Thien-Thi Nguyen|ttn@netcom.com|
-;; minor mode commands to selectively display blocks of code|
-;; 18-Oct-1994|3.4|~/modes/hideshow.el.Z|
-
-;;; Commentary:
-
-;; This file provides `hs-minor-mode'.  When active, six commands:
-;;   hs-{hide,show}-{all,block}, hs-show-region and hs-minor-mode
-;; are available.  They implement block hiding and showing.  Blocks are
-;; defined in mode-specific way.  In c-mode or c++-mode, they are simply
-;; curly braces, while in lisp-ish modes they are parens.  Multi-line
-;; comments (c-mode) can also be hidden.  The command M-x hs-minor-mode
-;; toggles the minor mode or sets it (similar to outline minor mode).
-;; See documentation for each command for more info.
-;;
-;; The variable `hs-unbalance-handler-method' controls hideshow's behavior
-;; in the case of "unbalanced parentheses".  See doc for more info.
-
-;; Suggested usage:
-
-;; (load-library "hideshow")
-;; (defun my-hs-setup () "enables hideshow and binds some commands"
-;;   (hs-minor-mode 1)
-;;   (define-key hs-minor-mode-map "\C-ch" 'hs-hide-block)
-;;   (define-key hs-minor-mode-map "\C-cs" 'hs-show-block)
-;;   (define-key hs-minro-mode-map "\C-cH" 'hs-hide-all)
-;;   (define-key hs-minro-mode-map "\C-cS" 'hs-show-all)
-;;   (define-key hs-minor-mode-map "\C-cR" 'hs-show-region))
-;; (add-hook 'X-mode-hook 'my-hs-setup t)   ; other modes similarly
-;;
-;; where X = {emacs-lisp,c,c++,perl,...}.  See the doc for the variable
-;; `hs-special-modes-alist' if you'd like to use hideshow w/ other modes.
-
-;; Etc:
-
-;; Bug reports and fixes welcome (comments, too).  Thanks go to
-;;	Dean Andrews <adahome@ix.netcom.com>
-;;	Preston F. Crow <preston.f.crow@dartmouth.edu>
-;;	Gael Marziou <gael@gnlab030.grenoble.hp.com>
-;;	Keith Sheffield <sheff@edcsgw2.cr.usgs.gov>
-;;	Jan Djarv <jan.djarv@sa.erisoft.se>
-;;	Lars Lindberg <qhslali@aom.ericsson.se>
-;;	Alf-Ivar Holm <alfh@ifi.uio.no>
-;; for valuable feedback, code and bug reports.
-
-;;; Code:
-
-
-;;;----------------------------------------------------------------------------
-;;; user-configurable variables
-
-(defvar hs-unbalance-handler-method 'top-level
-  "*Symbol representing how \"unbalanced parentheses\" should be handled.
-This error is usually signaled by `hs-show-block'.  One of four values:
-`top-level', `next-line', `signal' or `ignore'.  Default is `top-level'.
-
-- `top-level' -- Show top-level block containing the currently troublesome
-                 block.
-- `next-line' -- Use the fact that, for an already hidden block, its end
-		 will be on the next line.  Attempt to show this block.
-- `signal' -- Pass the error through, stopping execution.
-- `ignore' -- Ignore the error, continuing execution.
-
-Values other than these four will be interpreted as `signal'.")
-
-(defvar hs-special-modes-alist '((c-mode "{" "}")
-				 (c++-mode "{" "}"))
-  "*Alist of the form (MODE START-RE END-RE FORWARD-SEXP-FUNC).
-If present, hideshow will use these values for the start and end regexps,
-respectively.  Since Algol-ish languages do not have single-character
-block delimiters, the function `forward-sexp' which is used by hideshow
-doesn't work.  In this case, if a similar function is provided, you can
-register it and have hideshow use it instead of `forward-sexp'.  To add
-more values, use
-
-\t(pushnew '(new-mode st-re end-re function-name)
-\t	hs-special-modes-alist :test 'equal)
-
-For example:
-
-\t(pushnew '(simula-mode \"begin\" \"end\" simula-next-statement)
-\t	hs-special-modes-alist :test 'equal)
-
-Note that the regexps should not contain leading or trailing whitespace.")
-
-(defvar hs-hide-hook nil
-  "*Hooks called at the end of `hs-hide-all' and `hs-hide-block'.")
-
-(defvar hs-show-hook nil
-  "*Hooks called at the end of commands to show text.
-These commands include `hs-show-all', `hs-show-block' and `hs-show-region'.")
-
-(defvar hs-minor-mode-prefix "\C-c"
-  "*Prefix key to use for hideshow commands in hideshow minor mode.")
-
-
-;;;----------------------------------------------------------------------------
-;;; internal variables
-
-(defvar hs-minor-mode nil
-  "Non-nil if using hideshow mode as a minor mode of some other mode.
-Use the command `hs-minor-mode' to toggle this variable.")
-
-(defvar hs-minor-mode-map nil
-  "Mode map for hideshow minor mode.")
-
-(defvar hs-menu-bar nil
-  "Menu bar for hideshow minor mode (Xemacs only).")
-
-(defvar hs-c-start-regexp nil
-  "Regexp for beginning of comments.  Buffer-local.
-Differs from mode-specific comment regexps in that surrounding
-whitespace is stripped.")
-
-(defvar hs-c-end-regexp nil
-  "Regexp for end of comments.  Buffer-local.
-See `hs-c-start-regexp'.")
-
-(defvar hs-block-start-regexp nil
-  "Regexp for beginning of block.  Buffer-local.")
-
-(defvar hs-block-end-regexp nil
-  "Regexp for end of block.  Buffer-local.")
-
-(defvar hs-forward-sexp-func 'forward-sexp
-  "Function used to do a forward-sexp.  Should change for Algol-ish modes.
-For single-character block delimiters -- ie, the syntax table regexp for the
-character is either `(' or `)' -- `hs-forward-sexp-func' would just be
-`forward-sexp'.  For other modes such as simula, a more specialized function
-is necessary.")
-
-(defvar hs-emacs-type 'fsf
-  "Used to support both Emacs and XEmacs.")
-
-(eval-when-compile
-  (if (string-match "xemacs\\|lucid" emacs-version)
-      (progn
-	(defvar current-menubar nil "")
-	(defun set-buffer-menubar (arg1))
-	(defun add-menu (arg1 arg2 arg3)))))
-
-
-;;;----------------------------------------------------------------------------
-;;; support funcs
-
-;; snarfed from outline.el, but added buffer-read-only
-(defun hs-flag-region (from to flag)
-  "Hides or shows lines from FROM to TO, according to FLAG.
-If FLAG is `?\\n' (the newline character) then show the text;
-if FLAG is `?\\^M' \(control-M) then hide the text."
-  (let ((modp (buffer-modified-p))
-	buffer-read-only)		; nothing is immune
-    (unwind-protect (progn
-		      (subst-char-in-region
-		       from to
-		       (if (= flag ?\n) ?\C-m ?\n)
-		       flag t))
-      (set-buffer-modified-p modp))))
-
-(defun hs-hide-block-at-point (&optional end)
-  "Hide block iff on block beginning, optional END means reposition at end." 
-  (if (looking-at hs-block-start-regexp)
-      (let* ((p (point))
-	     (q (progn (funcall hs-forward-sexp-func 1) (point))))
-	(forward-line -1) (end-of-line)
-	(if (and (< p (point)) (> (count-lines p q) 1))
-	    (hs-flag-region p (point) ?\C-m))
-	(goto-char (if end q p)))))
-
-(defun hs-show-block-at-point (&optional end)
-  "Show block iff on block beginning.  Optional END means reposition at end."
-  (if (looking-at hs-block-start-regexp)
-      (let* ((p (point))
-	     (q
-	      (condition-case error	; probably unbalanced paren
-		  (progn
-		    (funcall hs-forward-sexp-func 1)
-		    (point))
-		(error
-		 (cond
-		  ((eq hs-unbalance-handler-method 'ignore)
-		   ;; just ignore this block
-		   (point))
-		  ((eq hs-unbalance-handler-method 'top-level)
-		   ;; try to get out of rat's nest and expose the whole func
-		   (if (/= (current-column) 0) (beginning-of-defun))
-		   (setq p (point))
-		   (re-search-forward (concat "^" hs-block-start-regexp)
-				      (point-max) t 2)
-		   (point))
-		  ((eq hs-unbalance-handler-method 'next-line)
-		   ;; assumption is that user knows what s/he's doing
-		   (beginning-of-line) (setq p (point))
-		   (end-of-line 2) (point))
-		  (t
-		   ;; pass error through -- this applies to `signal', too
-		   (signal (car error) (cdr error))))))))
-	(hs-flag-region p q ?\n)
-	(goto-char (if end (1+ (point)) p)))))
-
-(defun hs-safety-is-job-n ()
-  "Warn if `selective-display' or `selective-display-ellipses' is nil."
-  (let ((str ""))
-    (or selective-display
-	(setq str "selective-display nil "))
-    (or selective-display-ellipses
-	(setq str (concat str "selective-display-ellipses nil")))
-    (if (= (length str) 0)
-	nil
-      (message "warning: %s" str)
-      (sit-for 2))))
-
-(defun hs-inside-comment-p ()
-  "Returns non-nil if point is inside a comment, otherwise nil.
-Actually, for multi-line-able comments, returns a list containing
-the buffer position of the start and the end of the comment."
-  ;; is it single-line-only or multi-line-able?
-  (save-excursion
-    (let ((p (point))
-	  q)
-      (if (string= comment-end "")	; single line
-	  (let (found)
-	    (beginning-of-line)
-	    (setq found (re-search-forward hs-c-start-regexp p t))
-	    (and found (not (search-forward "\"" p t))))
-	(re-search-forward hs-c-end-regexp (point-max) 1)
-	(setq q (point))
-	(forward-comment -1)
-	(re-search-forward hs-c-start-regexp (point-max) 1)
-	(if (< (- (point) (length comment-start)) p)
-	    (list (match-beginning 0) q)))))) 
-
-(defun hs-grok-mode-type ()
-  "Setup variables for new buffers where applicable."
-  (if (and (boundp 'comment-start)
-	   (boundp 'comment-end))
-      (progn
-	(setq hs-c-start-regexp (regexp-quote comment-start))
-	(if (string-match " +$" hs-c-start-regexp)
-	    (setq hs-c-start-regexp
-		  (substring hs-c-start-regexp 0 (1- (match-end 0)))))
-	(setq hs-c-end-regexp (if (string= "" comment-end) "\n"
-				(regexp-quote comment-end)))
-	(if (string-match "^ +" hs-c-end-regexp)
-	    (setq hs-c-end-regexp
-		  (substring hs-c-end-regexp (match-end 0))))
-	(let ((lookup (assoc major-mode hs-special-modes-alist)))
-	  (setq hs-block-start-regexp (or (nth 1 lookup) "\\s\(")
-		hs-block-end-regexp (or (nth 2 lookup) "\\s\)")
-		hs-forward-sexp-func (or (nth 3 lookup) 'forward-sexp))))))
-
-(defun hs-find-block-beginning ()
-  "Repositions point at block-start.  Return point, or nil if top-level." 
-  (let (done
-	(here (point))
-	(both-regexps (concat "\\(" hs-block-start-regexp "\\)\\|\\("
-			      hs-block-end-regexp "\\)")))
-    (while (and (not done)
-		(re-search-backward both-regexps (point-min) t))
-      (if (match-beginning 1)		; start of start-regexp
-	  (setq done (match-beginning 1))
-	(goto-char (match-end 2))	; end of end-regexp
-	(funcall hs-forward-sexp-func -1)))
-    (goto-char (or done here))
-    done))
-
-(defmacro hs-life-goes-on (&rest body)
-  "Executes optional BODY iff variable `hs-minor-mode' is non-nil."
-  (list 'if 'hs-minor-mode (cons 'progn body)))
-
-
-;;;----------------------------------------------------------------------------
-;;; commands
-
-;;;###autoload
-(defun hs-hide-all ()
-  "Hides all top-level blocks, displaying only first and last lines.
-It moves point to the beginning of the line, and it runs the normal hook
-`hs-hide-hook'.  See documentation for `run-hooks'."
-  (interactive)
-  (hs-life-goes-on
-   (message "hiding all blocks ...")
-   (save-excursion
-     (hs-flag-region (point-min) (point-max) ?\n) ; eliminate weirdness
-     (goto-char (point-min))
-     (let ((count 0)
-	   (top-level-re (concat "^" hs-block-start-regexp)))
-       (while (progn
-		(forward-comment (buffer-size))
-		(re-search-forward top-level-re (point-max) t))
-	 (goto-char (match-beginning 0))
-	 (hs-hide-block-at-point t)
-	 (message "hiding ... %d" (setq count (1+ count)))))
-     (hs-safety-is-job-n))
-   (beginning-of-line)
-   (message "hiding all blocks ... done")
-   (run-hooks 'hs-hide-hook)))
-
-(defun hs-show-all ()
-  "Shows all top-level blocks.
-This does not change point; it runs the normal hook `hs-show-hook'.
-See documentation for `run-hooks'."
-  (interactive)
-  (hs-life-goes-on
-   (message "showing all blocks ...")
-   (hs-flag-region (point-min) (point-max) ?\n)
-   (message "showing all blocks ... done")
-   (run-hooks 'hs-show-hook)))
-
-;;;###autoload
-(defun hs-hide-block (&optional end)
-  "Selects a block and hides it.  With prefix arg, reposition at end.
-Block is defined as a sexp for lispish modes, mode-specific otherwise.
-Comments are blocks, too.  Upon completion, point is at repositioned and
-the normal hook `hs-hide-hook' is run.  See documentation for `run-hooks'."
-  (interactive "P")
-  (hs-life-goes-on
-   (let ((c-reg (hs-inside-comment-p)))
-     (if c-reg
-	 (cond ((string= comment-end "")
-		(message "can't hide a single-line comment"))
-	       ((< (count-lines (car c-reg) (nth 1 c-reg)) 2)
-		(message "not enough comment lines to hide"))
-	       (t
-		(goto-char (nth 1 c-reg))
-		(forward-line -1)
-		(hs-flag-region (car c-reg) (point) ?\C-m)
-		(goto-char (if end (nth 1 c-reg) (car c-reg)))
-		(hs-safety-is-job-n)
-		(run-hooks 'hs-hide-hook)))
-       (if (or (looking-at hs-block-start-regexp)
-	       (hs-find-block-beginning))
-	   (progn
-	     (hs-hide-block-at-point end)
-	     (hs-safety-is-job-n)
-	     (run-hooks 'hs-hide-hook)))))))
-
-(defun hs-show-block (&optional end)
-  "Selects a block and shows it.  With prefix arg, reposition at end.
-Upon completion, point is repositioned and the normal hook
-`hs-show-hook' is run.  See documentation for `hs-hide-block' and `run-hooks'."
-  (interactive "P")
-  (hs-life-goes-on
-   (let ((c-reg (hs-inside-comment-p)))
-     (if c-reg
-	 (cond ((string= comment-end "")
-		(message "already looking at the entire comment"))
-	       (t
-		(hs-flag-region (car c-reg) (nth 1 c-reg) ?\n)
-		(goto-char (if end (nth 1 c-reg) (car c-reg)))))
-       (if (or (looking-at hs-block-start-regexp)
-	       (hs-find-block-beginning))
-	   (progn
-	     (hs-show-block-at-point end)
-	     (hs-safety-is-job-n)
-	     (run-hooks 'hs-show-hook)))))))
-
-(defun hs-show-region (beg end)
-  "Shows all lines from BEG to END, without doing any block analysis.
-Note:` hs-show-region' is intended for use when when `hs-show-block' signals
-`unbalanced parentheses' and so is an emergency measure only.  You may
-become very confused if you use this command indiscriminately."
-  (interactive "r")
-  (hs-life-goes-on
-   (hs-flag-region beg end ?\n)
-   (hs-safety-is-job-n)
-   (run-hooks 'hs-show-hook)))
-
-;;;###autoload
-(defun hs-minor-mode (&optional arg)
-  "Toggle hideshow minor mode.
-With ARG, turn hideshow minor mode on if ARG is positive, off otherwise.
-When hideshow minor mode is on, the menu bar is augmented with hideshow
-commands and the hideshow commands are enabled.  The variables
-`selective-display' and `selective-display-ellipses' are set to t.
-Last, the normal hook `hs-minor-mode-hook' is run; see the doc for `run-hooks'.
-
-Turning hideshow minor mode off reverts the menu bar and the
-variables to default values and disables the hideshow commands."
-  (interactive "P")
-  (setq hs-minor-mode
-        (if (null arg)
-	    (not hs-minor-mode)
-          (> (prefix-numeric-value arg) 0)))
-  (if hs-minor-mode
-      (progn
- 	(if (eq hs-emacs-type 'lucid)
-	    (progn
-	      (set-buffer-menubar (copy-sequence current-menubar))
-	      (add-menu nil (car hs-menu-bar) (cdr hs-menu-bar))))
-	(setq selective-display t
-	      selective-display-ellipses t)
-	(hs-grok-mode-type)
-	(run-hooks 'hs-minor-mode-hook))
-    (if (eq hs-emacs-type 'lucid)
-	(set-buffer-menubar (delete hs-menu-bar current-menubar)))
-    (kill-local-variable 'selective-display)
-    (kill-local-variable 'selective-display-ellipses)))
-
-
-;;;----------------------------------------------------------------------------
-;;; load-time setup routines
-
-;; which emacs being used?
-(setq hs-emacs-type
-      (if (string-match "xemacs\\|lucid" emacs-version)
-	  'lucid
-	'fsf))
-
-;; keymaps and menus
-(if (not hs-minor-mode-map)
-    (setq hs-minor-mode-map (make-sparse-keymap))
-  (cond
-   ((eq hs-emacs-type 'lucid)
-    (setq hs-menu-bar			; build top down for lucid
-	  '("hideshow"
-	    ["Hide Block" hs-hide-block t]
-	    ["Show Block" hs-show-block t]
-	    ["Hide All" hs-hide-all t]
-	    ["Show All" hs-show-all t]
-	    ["Show Region" hs-show-region t])))
-   (t					; build bottom up for others
-    (define-key hs-minor-mode-map [menu-bar hideshow]
-      (cons "hideshow" (make-sparse-keymap "hideshow")))
-    (define-key hs-minor-mode-map [menu-bar hideshow hs-show-region]
-      '("Show Region" . hs-show-region))
-    (define-key hs-minor-mode-map [menu-bar hideshow hs-show-all]
-      '("Show All" . hs-show-all))
-    (define-key hs-minor-mode-map [menu-bar hideshow hs-hide-all]
-      '("Hide All" . hs-hide-all))
-    (define-key hs-minor-mode-map [menu-bar hideshow hs-show-block]
-      '("Show Block" . hs-show-block))
-    (define-key hs-minor-mode-map [menu-bar hideshow hs-hide-block]
-      '("Hide Block" . hs-hide-block)))))
-
-;; some housekeeping
-(or (assq 'hs-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-          (cons (cons 'hs-minor-mode hs-minor-mode-map)
-                minor-mode-map-alist)))
-(or (assq 'hs-minor-mode minor-mode-alist)
-    (setq minor-mode-alist (append minor-mode-alist
-                                   (list '(hs-minor-mode " hs")))))
-
-;; make some variables buffer-local
-(make-variable-buffer-local 'hs-minor-mode)
-(make-variable-buffer-local 'hs-c-start-regexp)
-(make-variable-buffer-local 'hs-c-end-regexp)
-(make-variable-buffer-local 'hs-block-start-regexp)
-(make-variable-buffer-local 'hs-block-end-regexp)
-(make-variable-buffer-local 'hs-forward-sexp-func)
-(put 'hs-minor-mode 'permanent-local t)
-(put 'hs-c-start-regexp 'permanent-local t)
-(put 'hs-c-end-regexp 'permanent-local t)
-(put 'hs-block-start-regexp 'permanent-local t)
-(put 'hs-block-end-regexp 'permanent-local t)
-(put 'hs-forward-sexp-func 'permanent-local t)
-
-
-;;;----------------------------------------------------------------------------
-;;; that's it
-
-(provide 'hideshow)
-
-;;; hideshow.el ends here
diff --git a/lisp/progmodes/icon.el b/lisp/progmodes/icon.el
deleted file mode 100644
index 85e30a77ade..00000000000
--- a/lisp/progmodes/icon.el
+++ /dev/null
@@ -1,556 +0,0 @@
-;;; icon.el --- mode for editing Icon code
-
-;; Copyright (C) 1989 Free Software Foundation, Inc.
-
-;; Author: Chris Smith <csmith@convex.com>
-;; Created: 15 Feb 89
-;; Keywords: languages
-
-;; 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:
-
-;; A major mode for editing the Icon programming language.
-
-;;; Code:
-
-(defvar icon-mode-abbrev-table nil
-  "Abbrev table in use in Icon-mode buffers.")
-(define-abbrev-table 'icon-mode-abbrev-table ())
-
-(defvar icon-mode-map ()
-  "Keymap used in Icon mode.")
-(if icon-mode-map
-    ()
-  (setq icon-mode-map (make-sparse-keymap))
-  (define-key icon-mode-map "{" 'electric-icon-brace)
-  (define-key icon-mode-map "}" 'electric-icon-brace)
-  (define-key icon-mode-map "\e\C-h" 'mark-icon-function)
-  (define-key icon-mode-map "\e\C-a" 'beginning-of-icon-defun)
-  (define-key icon-mode-map "\e\C-e" 'end-of-icon-defun)
-  (define-key icon-mode-map "\e\C-q" 'indent-icon-exp)
-  (define-key icon-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key icon-mode-map "\t" 'icon-indent-command))
-
-(defvar icon-mode-syntax-table nil
-  "Syntax table in use in Icon-mode buffers.")
-
-(if icon-mode-syntax-table
-    ()
-  (setq icon-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "\\" icon-mode-syntax-table)
-  (modify-syntax-entry ?# "<" icon-mode-syntax-table)
-  (modify-syntax-entry ?\n ">" icon-mode-syntax-table)
-  (modify-syntax-entry ?$ "." icon-mode-syntax-table)
-  (modify-syntax-entry ?/ "." icon-mode-syntax-table)
-  (modify-syntax-entry ?* "." icon-mode-syntax-table)
-  (modify-syntax-entry ?+ "." icon-mode-syntax-table)
-  (modify-syntax-entry ?- "." icon-mode-syntax-table)
-  (modify-syntax-entry ?= "." icon-mode-syntax-table)
-  (modify-syntax-entry ?% "." icon-mode-syntax-table)
-  (modify-syntax-entry ?< "." icon-mode-syntax-table)
-  (modify-syntax-entry ?> "." icon-mode-syntax-table)
-  (modify-syntax-entry ?& "." icon-mode-syntax-table)
-  (modify-syntax-entry ?| "." icon-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" icon-mode-syntax-table))
-
-(defvar icon-indent-level 4
-  "*Indentation of Icon statements with respect to containing block.")
-(defvar icon-brace-imaginary-offset 0
-  "*Imagined indentation of a Icon open brace that actually follows a statement.")
-(defvar icon-brace-offset 0
-  "*Extra indentation for braces, compared with other text in same context.")
-(defvar icon-continued-statement-offset 4
-  "*Extra indent for lines not starting new statements.")
-(defvar icon-continued-brace-offset 0
-  "*Extra indent for substatements that start with open-braces.
-This is in addition to icon-continued-statement-offset.")
-
-(defvar icon-auto-newline nil
-  "*Non-nil means automatically newline before and after braces
-inserted in Icon code.")
-
-(defvar icon-tab-always-indent t
-  "*Non-nil means TAB in Icon mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used.")
-
-;;;###autoload
-(defun icon-mode ()
-  "Major mode for editing Icon code.
-Expression and list commands understand all Icon brackets.
-Tab indents for Icon code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-\\{icon-mode-map}
-Variables controlling indentation style:
- icon-tab-always-indent
-    Non-nil means TAB in Icon mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- icon-auto-newline
-    Non-nil means automatically newline before and after braces
-    inserted in Icon code.
- icon-indent-level
-    Indentation of Icon statements within surrounding block.
-    The surrounding block's indentation is the indentation
-    of the line on which the open-brace appears.
- icon-continued-statement-offset
-    Extra indentation given to a substatement, such as the
-    then-clause of an if or body of a while.
- icon-continued-brace-offset
-    Extra indentation given to a brace that starts a substatement.
-    This is in addition to `icon-continued-statement-offset'.
- icon-brace-offset
-    Extra indentation for line if it starts with an open brace.
- icon-brace-imaginary-offset
-    An open brace following other text is treated as if it were
-    this far to the right of the start of its line.
-
-Turning on Icon mode calls the value of the variable `icon-mode-hook'
-with no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map icon-mode-map)
-  (setq major-mode 'icon-mode)
-  (setq mode-name "Icon")
-  (setq local-abbrev-table icon-mode-abbrev-table)
-  (set-syntax-table icon-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'icon-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "# *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'icon-comment-indent)
-  (run-hooks 'icon-mode-hook))
-
-;; This is used by indent-for-comment to decide how much to
-;; indent a comment in Icon code based on its context.
-(defun icon-comment-indent ()
-  (if (looking-at "^#")
-      0	
-    (save-excursion
-      (skip-chars-backward " \t")
-      (max (if (bolp) 0 (1+ (current-column)))
-	   comment-column))))
-
-(defun electric-icon-brace (arg)
-  "Insert character and correct line's indentation."
-  (interactive "P")
-  (let (insertpos)
-    (if (and (not arg)
-	     (eolp)
-	     (or (save-excursion
-		   (skip-chars-backward " \t")
-		   (bolp))
-		 (if icon-auto-newline
-		     (progn (icon-indent-line) (newline) t)
-		   nil)))
-	(progn
-	  (insert last-command-char)
-	  (icon-indent-line)
-	  (if icon-auto-newline
-	      (progn
-		(newline)
-		;; (newline) may have done auto-fill
-		(setq insertpos (- (point) 2))
-		(icon-indent-line)))
-	  (save-excursion
-	    (if insertpos (goto-char (1+ insertpos)))
-	    (delete-char -1))))
-    (if insertpos
-	(save-excursion
-	  (goto-char insertpos)
-	  (self-insert-command (prefix-numeric-value arg)))
-      (self-insert-command (prefix-numeric-value arg)))))
-
-(defun icon-indent-command (&optional whole-exp)
-  (interactive "P")
-  "Indent current line as Icon code, or in some cases insert a tab character.
-If `icon-tab-always-indent' is non-nil (the default), always indent current
-line.  Otherwise, indent the current line only if point is at the left margin
-or in the line's indentation; otherwise insert a tab.
-
-A numeric argument, regardless of its value, means indent rigidly all the
-lines of the expression starting after point so that this line becomes
-properly indented.  The relative indentation among the lines of the
-expression are preserved."
-  (if whole-exp
-      ;; If arg, always indent this line as Icon
-      ;; and shift remaining lines of expression the same amount.
-      (let ((shift-amt (icon-indent-line))
-	    beg end)
-	(save-excursion
-	  (if icon-tab-always-indent
-	      (beginning-of-line))
-	  (setq beg (point))
-	  (forward-sexp 1)
-	  (setq end (point))
-	  (goto-char beg)
-	  (forward-line 1)
-	  (setq beg (point)))
-	(if (> end beg)
-	    (indent-code-rigidly beg end shift-amt "#")))
-    (if (and (not icon-tab-always-indent)
-	     (save-excursion
-	       (skip-chars-backward " \t")
-	       (not (bolp))))
-	(insert-tab)
-      (icon-indent-line))))
-
-(defun icon-indent-line ()
-  "Indent current line as Icon code.
-Return the amount the indentation changed by."
-  (let ((indent (calculate-icon-indent nil))
-	beg shift-amt
-	(case-fold-search nil)
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((eq indent nil)
-	   (setq indent (current-indentation)))
-	  ((eq indent t)
-	   (setq indent (calculate-icon-indent-within-comment)))
-	  ((looking-at "[ \t]*#")
-	   (setq indent 0))
-	  (t
-	   (skip-chars-forward " \t")
-	   (if (listp indent) (setq indent (car indent)))
-	   (cond ((and (looking-at "else\\b")
-		       (not (looking-at "else\\s_")))
-		  (setq indent (save-excursion
-				 (icon-backward-to-start-of-if)
-				 (current-indentation))))
-		 ((or (= (following-char) ?})
-		      (looking-at "end\\b"))
-		  (setq indent (- indent icon-indent-level)))
-		 ((= (following-char) ?{)
-		  (setq indent (+ indent icon-brace-offset))))))
-    (skip-chars-forward " \t")
-    (setq shift-amt (- indent (current-column)))
-    (if (zerop shift-amt)
-	(if (> (- (point-max) pos) (point))
-	    (goto-char (- (point-max) pos)))
-      (delete-region beg (point))
-      (indent-to indent)
-      ;; If initial point was within line's indentation,
-      ;; position after the indentation.  Else stay at same point in text.
-      (if (> (- (point-max) pos) (point))
-	  (goto-char (- (point-max) pos))))
-    shift-amt))
-
-(defun calculate-icon-indent (&optional parse-start)
-  "Return appropriate indentation for current line as Icon code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment."
-  (save-excursion
-    (beginning-of-line)
-    (let ((indent-point (point))
-	  (case-fold-search nil)
-	  state
-	  containing-sexp
-	  toplevel)
-      (if parse-start
-	  (goto-char parse-start)
-	(setq toplevel (beginning-of-icon-defun)))
-      (while (< (point) indent-point)
-	(setq parse-start (point))
-	(setq state (parse-partial-sexp (point) indent-point 0))
-	(setq containing-sexp (car (cdr state))))
-      (cond ((or (nth 3 state) (nth 4 state))
-	     ;; return nil or t if should not change this line
-	     (nth 4 state))
-	    ((and containing-sexp
-		  (/= (char-after containing-sexp) ?{))
-	     ;; line is expression, not statement:
-	     ;; indent to just after the surrounding open.
-	     (goto-char (1+ containing-sexp))
-	     (current-column))
-	    (t
-	      (if toplevel
-		  ;; Outside any procedures.
-		  (progn (icon-backward-to-noncomment (point-min))
-			 (if (icon-is-continuation-line)
-			     icon-continued-statement-offset 0))
-		;; Statement level.
-		(if (null containing-sexp)
-		    (progn (beginning-of-icon-defun)
-			   (setq containing-sexp (point))))
-		(goto-char indent-point)
-		;; Is it a continuation or a new statement?
-		;; Find previous non-comment character.
-		(icon-backward-to-noncomment containing-sexp)
-		;; Now we get the answer.
-		(if (icon-is-continuation-line)
-		    ;; This line is continuation of preceding line's statement;
-		    ;; indent  icon-continued-statement-offset  more than the
-		    ;; first line of the statement.
-		    (progn
-		      (icon-backward-to-start-of-continued-exp containing-sexp)
-		      (+ icon-continued-statement-offset (current-column)
-			 (if (save-excursion (goto-char indent-point)
-					     (skip-chars-forward " \t")
-					     (eq (following-char) ?{))
-			     icon-continued-brace-offset 0)))
-		  ;; This line starts a new statement.
-		  ;; Position following last unclosed open.
-		  (goto-char containing-sexp)
-		  ;; Is line first statement after an open-brace?
-		  (or
-		    ;; If no, find that first statement and indent like it.
-		    (save-excursion
-		      (if (looking-at "procedure\\s ")
-			  (forward-sexp 3)
-			(forward-char 1))
-		      (while (progn (skip-chars-forward " \t\n")
-				    (looking-at "#"))
-			;; Skip over comments following openbrace.
-			(forward-line 1))
-		      ;; The first following code counts
-		      ;; if it is before the line we want to indent.
-		      (and (< (point) indent-point)
-			   (current-column)))
-		    ;; If no previous statement,
-		    ;; indent it relative to line brace is on.
-		    ;; For open brace in column zero, don't let statement
-		    ;; start there too.  If icon-indent-level is zero,
-		    ;; use icon-brace-offset + icon-continued-statement-offset
-		    ;; instead.
-		    ;; For open-braces not the first thing in a line,
-		    ;; add in icon-brace-imaginary-offset.
-		    (+ (if (and (bolp) (zerop icon-indent-level))
-			   (+ icon-brace-offset
-			      icon-continued-statement-offset)
-			 icon-indent-level)
-		       ;; Move back over whitespace before the openbrace.
-		       ;; If openbrace is not first nonwhite thing on the line,
-		       ;; add the icon-brace-imaginary-offset.
-		       (progn (skip-chars-backward " \t")
-			      (if (bolp) 0 icon-brace-imaginary-offset))
-		       ;; Get initial indentation of the line we are on.
-		       (current-indentation))))))))))
-
-;; List of words to check for as the last thing on a line.
-;; If cdr is t, next line is a continuation of the same statement,
-;; if cdr is nil, next line starts a new (possibly indented) statement.
-
-(defconst icon-resword-alist
-  '(("by" . t) ("case" . t) ("create") ("do") ("dynamic" . t) ("else")
-    ("every" . t) ("if" . t) ("global" . t) ("initial" . t)
-    ("link" . t) ("local" . t) ("of") ("record" . t) ("repeat" . t)
-    ("static" . t) ("then") ("to" . t) ("until" . t) ("while" . t)))
-
-(defun icon-is-continuation-line ()
-  (let* ((ch (preceding-char))
-	 (ch-syntax (char-syntax ch)))
-    (if (eq ch-syntax ?w)
-	(assoc (buffer-substring
-		(progn (forward-word -1) (point))
-		(progn (forward-word 1) (point)))
-	       icon-resword-alist)
-      (not (memq ch '(0 ?\; ?\} ?\{ ?\) ?\] ?\" ?\' ?\n))))))
-
-(defun icon-backward-to-noncomment (lim)
-  (let (opoint stop)
-    (while (not stop)
-      (skip-chars-backward " \t\n\f" lim)
-      (setq opoint (point))
-      (beginning-of-line)
-      (if (and (nth 5 (parse-partial-sexp (point) opoint))
-	       (< lim (point)))
-	  (search-backward "#")
-	(setq stop t)))))
-
-(defun icon-backward-to-start-of-continued-exp (lim)
-  (if (memq (preceding-char) '(?\) ?\]))
-      (forward-sexp -1))
-  (beginning-of-line)
-  (skip-chars-forward " \t")
-  (cond
-   ((<= (point) lim) (goto-char (1+ lim)))
-   ((not (icon-is-continued-line)) 0)
-   ((and (eq (char-syntax (following-char)) ?w)
-	 (cdr
-	  (assoc (buffer-substring (point)
-				   (save-excursion (forward-word 1) (point)))
-		 icon-resword-alist))) 0)
-   (t (end-of-line 0) (icon-backward-to-start-of-continued-exp lim))))
-
-(defun icon-is-continued-line ()
-  (save-excursion
-    (end-of-line 0)
-    (icon-is-continuation-line)))
-
-(defun icon-backward-to-start-of-if (&optional limit)
-  "Move to the start of the last \"unbalanced\" if."
-  (or limit (setq limit (save-excursion (beginning-of-icon-defun) (point))))
-  (let ((if-level 1)
-	(case-fold-search nil))
-    (while (not (zerop if-level))
-      (backward-sexp 1)
-      (cond ((looking-at "else\\b")
-	     (setq if-level (1+ if-level)))
-	    ((looking-at "if\\b")
-	     (setq if-level (1- if-level)))
-	    ((< (point) limit)
-	     (setq if-level 0)
-	     (goto-char limit))))))
-
-(defun mark-icon-function ()
-  "Put mark at end of Icon function, point at beginning."
-  (interactive)
-  (push-mark (point))
-  (end-of-icon-defun)
-  (push-mark (point))
-  (beginning-of-line 0)
-  (beginning-of-icon-defun))
-
-(defun beginning-of-icon-defun ()
-  "Go to the start of the enclosing procedure; return t if at top level."
-  (interactive)
-  (if (re-search-backward "^procedure\\s \\|^end[ \t\n]" (point-min) 'move)
-      (looking-at "e")
-    t))
-
-(defun end-of-icon-defun ()
-  (interactive)
-  (if (not (bobp)) (forward-char -1))
-  (re-search-forward "\\(\\s \\|^\\)end\\(\\s \\|$\\)" (point-max) 'move)
-  (forward-word -1)
-  (forward-line 1))
-
-(defun indent-icon-exp ()
-  "Indent each line of the Icon grouping following point."
-  (interactive)
-  (let ((indent-stack (list nil))
-	(contain-stack (list (point)))
-	(case-fold-search nil)
-	restart outer-loop-done inner-loop-done state ostate
-	this-indent last-sexp
-	at-else at-brace at-do
-	(opoint (point))
-	(next-depth 0))
-    (save-excursion
-      (forward-sexp 1))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (and (not (eobp)) (not outer-loop-done))
-	(setq last-depth next-depth)
-	;; Compute how depth changes over this line
-	;; plus enough other lines to get to one that
-	;; does not end inside a comment or string.
-	;; Meanwhile, do appropriate indentation on comment lines.
-	(setq innerloop-done nil)
-	(while (and (not innerloop-done)
-		    (not (and (eobp) (setq outer-loop-done t))))
-	  (setq ostate state)
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  (if (and (car (cdr (cdr state)))
-		   (>= (car (cdr (cdr state))) 0))
-	      (setq last-sexp (car (cdr (cdr state)))))
-	  (if (or (nth 4 ostate))
-	      (icon-indent-line))
-	  (if (or (nth 3 state))
-	      (forward-line 1)
-	    (setq innerloop-done t)))
-	(if (<= next-depth 0)
-	    (setq outer-loop-done t))
-	(if outer-loop-done
-	    nil
-	  (if (/= last-depth next-depth)
-	      (setq last-sexp nil))
-	  (while (> last-depth next-depth)
-	    (setq indent-stack (cdr indent-stack)
-		  contain-stack (cdr contain-stack)
-		  last-depth (1- last-depth)))
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  contain-stack (cons nil contain-stack)
-		  last-depth (1+ last-depth)))
-	  (if (null (car contain-stack))
-	      (setcar contain-stack (or (car (cdr state))
-					(save-excursion (forward-sexp -1)
-							(point)))))
-	  (forward-line 1)
-	  (skip-chars-forward " \t")
-	  (if (eolp)
-	      nil
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		;; Line is on an existing nesting level.
-		;; Lines inside parens are handled specially.
-		(if (/= (char-after (car contain-stack)) ?{)
-		    (setq this-indent (car indent-stack))
-		  ;; Line is at statement level.
-		  ;; Is it a new statement?  Is it an else?
-		  ;; Find last non-comment character before this line
-		  (save-excursion
-		    (setq at-else (looking-at "else\\W"))
-		    (setq at-brace (= (following-char) ?{))
-		    (icon-backward-to-noncomment opoint)
-		    (if (icon-is-continuation-line)
-			;; Preceding line did not end in comma or semi;
-			;; indent this line  icon-continued-statement-offset
-			;; more than previous.
-			(progn
-			  (icon-backward-to-start-of-continued-exp (car contain-stack))
-			  (setq this-indent
-				(+ icon-continued-statement-offset (current-column)
-				   (if at-brace icon-continued-brace-offset 0))))
-		      ;; Preceding line ended in comma or semi;
-		      ;; use the standard indent for this level.
-		      (if at-else
-			  (progn (icon-backward-to-start-of-if opoint)
-				 (setq this-indent (current-indentation)))
-			(setq this-indent (car indent-stack))))))
-	      ;; Just started a new nesting level.
-	      ;; Compute the standard indent for this level.
-	      (let ((val (calculate-icon-indent
-			   (if (car indent-stack)
-			       (- (car indent-stack))))))
-		(setcar indent-stack
-			(setq this-indent val))))
-	    ;; Adjust line indentation according to its contents
-	    (if (or (= (following-char) ?})
-		    (looking-at "end\\b"))
-		(setq this-indent (- this-indent icon-indent-level)))
-	    (if (= (following-char) ?{)
-		(setq this-indent (+ this-indent icon-brace-offset)))
-	    ;; Put chosen indentation into effect.
-	    (or (= (current-column) this-indent)
-		(progn
-		  (delete-region (point) (progn (beginning-of-line) (point)))
-		  (indent-to this-indent)))
-	    ;; Indent any comment following the text.
-	    (or (looking-at comment-start-skip)
-		(if (re-search-forward comment-start-skip (save-excursion (end-of-line) (point)) t)
-		    (progn (indent-for-comment) (beginning-of-line))))))))))
-
-;;; icon.el ends here
diff --git a/lisp/progmodes/inf-lisp.el b/lisp/progmodes/inf-lisp.el
deleted file mode 100644
index 870d3f944b7..00000000000
--- a/lisp/progmodes/inf-lisp.el
+++ /dev/null
@@ -1,642 +0,0 @@
-;;; inf-lisp.el --- an inferior-lisp mode
-
-;; Copyright (C) 1988, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Olin Shivers <shivers@cs.cmu.edu>
-;; Keywords: processes, lisp
-
-;; 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:
-
-;; Hacked from tea.el by Olin Shivers (shivers@cs.cmu.edu). 8/88
-
-;; This file defines a a lisp-in-a-buffer package (inferior-lisp
-;; mode) built on top of comint mode.  This version is more
-;; featureful, robust, and uniform than the Emacs 18 version.  The
-;; key bindings are also more compatible with the bindings of Hemlock
-;; and Zwei (the Lisp Machine emacs).
-
-;; Since this mode is built on top of the general command-interpreter-in-
-;; a-buffer mode (comint mode), it shares a common base functionality, 
-;; and a common set of bindings, with all modes derived from comint mode.
-;; This makes these modes easier to use.
-
-;; For documentation on the functionality provided by comint mode, and
-;; the hooks available for customising it, see the file comint.el.
-;; For further information on inferior-lisp mode, see the comments below.
-
-;; Needs fixin:
-;; The load-file/compile-file default mechanism could be smarter -- it
-;; doesn't know about the relationship between filename extensions and
-;; whether the file is source or executable. If you compile foo.lisp
-;; with compile-file, then the next load-file should use foo.bin for
-;; the default, not foo.lisp. This is tricky to do right, particularly
-;; because the extension for executable files varies so much (.o, .bin,
-;; .lbin, .mo, .vo, .ao, ...).
-;;
-;; It would be nice if inferior-lisp (and inferior scheme, T, ...) modes
-;; had a verbose minor mode wherein sending or compiling defuns, etc.
-;; would be reflected in the transcript with suitable comments, e.g.
-;; ";;; redefining fact". Several ways to do this. Which is right?
-;;
-;; When sending text from a source file to a subprocess, the process-mark can 
-;; move off the window, so you can lose sight of the process interactions.
-;; Maybe I should ensure the process mark is in the window when I send
-;; text to the process? Switch selectable?
-
-;;; Code:
-
-(require 'comint)
-(require 'lisp-mode)
-
-
-;;;###autoload
-(defvar inferior-lisp-filter-regexp "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'"
-  "*What not to save on inferior Lisp's input history.
-Input matching this regexp is not saved on the input history in Inferior Lisp
-mode.  Default is whitespace followed by 0 or 1 single-letter colon-keyword 
-\(as in :a, :c, etc.)")
-
-(defvar inferior-lisp-mode-map nil)
-(cond ((not inferior-lisp-mode-map)
-       (setq inferior-lisp-mode-map
-	     (copy-keymap comint-mode-map))
-       (setq inferior-lisp-mode-map
-	     (nconc inferior-lisp-mode-map shared-lisp-mode-map))
-       (define-key inferior-lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp)
-       (define-key inferior-lisp-mode-map "\C-c\C-l" 'lisp-load-file)
-       (define-key inferior-lisp-mode-map "\C-c\C-k" 'lisp-compile-file)
-       (define-key inferior-lisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
-       (define-key inferior-lisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
-       (define-key inferior-lisp-mode-map "\C-c\C-f"
-	 'lisp-show-function-documentation)
-       (define-key inferior-lisp-mode-map "\C-c\C-v"
-	 'lisp-show-variable-documentation)))
-
-;;; These commands augment Lisp mode, so you can process Lisp code in
-;;; the source files.
-(define-key lisp-mode-map "\M-\C-x"  'lisp-eval-defun)     ; Gnu convention
-(define-key lisp-mode-map "\C-x\C-e" 'lisp-eval-last-sexp) ; Gnu convention
-(define-key lisp-mode-map "\C-c\C-e" 'lisp-eval-defun)
-(define-key lisp-mode-map "\C-c\C-r" 'lisp-eval-region)
-(define-key lisp-mode-map "\C-c\C-c" 'lisp-compile-defun)
-(define-key lisp-mode-map "\C-c\C-z" 'switch-to-lisp)
-(define-key lisp-mode-map "\C-c\C-l" 'lisp-load-file)
-(define-key lisp-mode-map "\C-c\C-k" 'lisp-compile-file)  ; "kompile" file
-(define-key lisp-mode-map "\C-c\C-a" 'lisp-show-arglist)
-(define-key lisp-mode-map "\C-c\C-d" 'lisp-describe-sym)
-(define-key lisp-mode-map "\C-c\C-f" 'lisp-show-function-documentation)
-(define-key lisp-mode-map "\C-c\C-v" 'lisp-show-variable-documentation)
-
-
-;;; This function exists for backwards compatibility.
-;;; Previous versions of this package bound commands to C-c <letter>
-;;; bindings, which is not allowed by the gnumacs standard.
-
-;;;  "This function binds many inferior-lisp commands to C-c <letter> bindings,
-;;;where they are more accessible. C-c <letter> bindings are reserved for the
-;;;user, so these bindings are non-standard. If you want them, you should
-;;;have this function called by the inferior-lisp-load-hook:
-;;;    (setq inferior-lisp-load-hook '(inferior-lisp-install-letter-bindings))
-;;;You can modify this function to install just the bindings you want."
-(defun inferior-lisp-install-letter-bindings ()
-  (define-key lisp-mode-map "\C-ce" 'lisp-eval-defun-and-go)
-  (define-key lisp-mode-map "\C-cr" 'lisp-eval-region-and-go)
-  (define-key lisp-mode-map "\C-cc" 'lisp-compile-defun-and-go)
-  (define-key lisp-mode-map "\C-cz" 'switch-to-lisp)
-  (define-key lisp-mode-map "\C-cl" 'lisp-load-file)
-  (define-key lisp-mode-map "\C-ck" 'lisp-compile-file)
-  (define-key lisp-mode-map "\C-ca" 'lisp-show-arglist)
-  (define-key lisp-mode-map "\C-cd" 'lisp-describe-sym)
-  (define-key lisp-mode-map "\C-cf" 'lisp-show-function-documentation)
-  (define-key lisp-mode-map "\C-cv" 'lisp-show-variable-documentation)
-  
-  (define-key inferior-lisp-mode-map "\C-cl" 'lisp-load-file)
-  (define-key inferior-lisp-mode-map "\C-ck" 'lisp-compile-file)
-  (define-key inferior-lisp-mode-map "\C-ca" 'lisp-show-arglist)
-  (define-key inferior-lisp-mode-map "\C-cd" 'lisp-describe-sym)
-  (define-key inferior-lisp-mode-map "\C-cf" 'lisp-show-function-documentation)
-  (define-key inferior-lisp-mode-map "\C-cv"
-    'lisp-show-variable-documentation))
-
-
-;;;###autoload
-(defvar inferior-lisp-program "lisp"
-  "*Program name for invoking an inferior Lisp with for Inferior Lisp mode.")
-
-;;;###autoload
-(defvar inferior-lisp-load-command "(load \"%s\")\n"
-  "*Format-string for building a Lisp expression to load a file.
-This format string should use `%s' to substitute a file name
-and should result in a Lisp expression that will command the inferior Lisp
-to load that file.  The default works acceptably on most Lisps.
-The string \"(progn (load \\\"%s\\\" :verbose nil :print t) (values))\\n\"
-produces cosmetically superior output for this application,
-but it works only in Common Lisp.")
-
-;;;###autoload
-(defvar inferior-lisp-prompt "^[^> \n]*>+:? *"
-  "Regexp to recognise prompts in the Inferior Lisp mode.
-Defaults to \"^[^> \\n]*>+:? *\", which works pretty good for Lucid, kcl,
-and franz.  This variable is used to initialize `comint-prompt-regexp' in the 
-Inferior Lisp buffer.
-
-More precise choices:
-Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
-franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
-kcl: \"^>+ *\"
-
-This is a fine thing to set in your .emacs file.")
-
-(defvar inferior-lisp-buffer nil "*The current inferior-lisp process buffer.
-
-MULTIPLE PROCESS SUPPORT
-===========================================================================
-To run multiple Lisp processes, you start the first up
-with \\[inferior-lisp].  It will be in a buffer named `*inferior-lisp*'.
-Rename this buffer with \\[rename-buffer].  You may now start up a new
-process with another \\[inferior-lisp].  It will be in a new buffer,
-named `*inferior-lisp*'.  You can switch between the different process
-buffers with \\[switch-to-buffer].
-
-Commands that send text from source buffers to Lisp processes --
-like `lisp-eval-defun' or `lisp-show-arglist' -- have to choose a process
-to send to, when you have more than one Lisp process around.  This
-is determined by the global variable `inferior-lisp-buffer'.  Suppose you
-have three inferior Lisps running:
-    Buffer              Process
-    foo                 inferior-lisp
-    bar                 inferior-lisp<2>
-    *inferior-lisp*     inferior-lisp<3>
-If you do a \\[lisp-eval-defun] command on some Lisp source code, 
-what process do you send it to?
-
-- If you're in a process buffer (foo, bar, or *inferior-lisp*), 
-  you send it to that process.
-- If you're in some other buffer (e.g., a source file), you
-  send it to the process attached to buffer `inferior-lisp-buffer'.
-This process selection is performed by function `inferior-lisp-proc'.
-
-Whenever \\[inferior-lisp] fires up a new process, it resets
-`inferior-lisp-buffer' to be the new process's buffer.  If you only run
-one process, this does the right thing.  If you run multiple
-processes, you can change `inferior-lisp-buffer' to another process
-buffer with \\[set-variable].")
-
-;;;###autoload
-(defvar inferior-lisp-mode-hook '()
-  "*Hook for customising Inferior Lisp mode.")
-
-(defun inferior-lisp-mode () 
-  "Major mode for interacting with an inferior Lisp process.  
-Runs a Lisp interpreter as a subprocess of Emacs, with Lisp I/O through an
-Emacs buffer.  Variable `inferior-lisp-program' controls which Lisp interpreter
-is run.  Variables `inferior-lisp-prompt', `inferior-lisp-filter-regexp' and
-`inferior-lisp-load-command' can customize this mode for different Lisp
-interpreters.
-
-For information on running multiple processes in multiple buffers, see
-documentation for variable `inferior-lisp-buffer'.
-
-\\{inferior-lisp-mode-map}
-
-Customisation: Entry to this mode runs the hooks on `comint-mode-hook' and
-`inferior-lisp-mode-hook' (in that order).
-
-You can send text to the inferior Lisp process from other buffers containing
-Lisp source.  
-    switch-to-lisp switches the current buffer to the Lisp process buffer.
-    lisp-eval-defun sends the current defun to the Lisp process.
-    lisp-compile-defun compiles the current defun.
-    lisp-eval-region sends the current region to the Lisp process.
-    lisp-compile-region compiles the current region.
-
-    Prefixing the lisp-eval/compile-defun/region commands with
-    a \\[universal-argument] causes a switch to the Lisp process buffer after sending
-    the text.
-
-Commands:
-Return after the end of the process' output sends the text from the 
-    end of process to point.
-Return before the end of the process' output copies the sexp ending at point
-    to the end of the process' output, and sends it.
-Delete converts tabs to spaces as it moves back.
-Tab indents for Lisp; with argument, shifts rest
-    of expression rigidly with the current line.
-C-M-q does Tab on each line starting within following expression.
-Paragraphs are separated only by blank lines.  Semicolons start comments.
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it."
-  (interactive)
-  (comint-mode)
-  (setq comint-prompt-regexp inferior-lisp-prompt)
-  (setq major-mode 'inferior-lisp-mode)
-  (setq mode-name "Inferior Lisp")
-  (setq mode-line-process '(":%s"))
-  (lisp-mode-variables t)
-  (use-local-map inferior-lisp-mode-map)    ;c-c c-k for "kompile" file
-  (setq comint-get-old-input (function lisp-get-old-input))
-  (setq comint-input-filter (function lisp-input-filter))
-  (setq comint-input-sentinel 'ignore)
-  (run-hooks 'inferior-lisp-mode-hook))
-
-(defun lisp-get-old-input ()
-  "Return a string containing the sexp ending at point."
-  (save-excursion
-    (let ((end (point)))
-      (backward-sexp)
-      (buffer-substring (point) end))))
-
-(defun lisp-input-filter (str)
-  "t if STR does not match `inferior-lisp-filter-regexp'."
-  (not (string-match inferior-lisp-filter-regexp str)))
-
-;;;###autoload
-(defun inferior-lisp (cmd)
-  "Run an inferior Lisp process, input and output via buffer `*inferior-lisp*'.
-If there is a process already running in `*inferior-lisp*', just switch
-to that buffer.
-With argument, allows you to edit the command line (default is value
-of `inferior-lisp-program').  Runs the hooks from
-`inferior-lisp-mode-hook' (after the `comint-mode-hook' is run).
-\(Type \\[describe-mode] in the process buffer for a list of commands.)"
-  (interactive (list (if current-prefix-arg
-			 (read-string "Run lisp: " inferior-lisp-program)
-		       inferior-lisp-program)))
-  (if (not (comint-check-proc "*inferior-lisp*"))
-      (let ((cmdlist (inferior-lisp-args-to-list cmd)))
-	(set-buffer (apply (function make-comint)
-			   "inferior-lisp" (car cmdlist) nil (cdr cmdlist)))
-	(inferior-lisp-mode)))
-  (setq inferior-lisp-buffer "*inferior-lisp*")
-  (pop-to-buffer "*inferior-lisp*"))
-;;;###autoload (add-hook 'same-window-buffer-names "*inferior-lisp*")
-
-;;;###autoload
-(defalias 'run-lisp 'inferior-lisp)
-
-;;; Break a string up into a list of arguments.
-;;; This will break if you have an argument with whitespace, as in
-;;; string = "-ab +c -x 'you lose'".
-(defun inferior-lisp-args-to-list (string)
-  (let ((where (string-match "[ \t]" string)))
-    (cond ((null where) (list string))
-	  ((not (= where 0))
-	   (cons (substring string 0 where)
-		 (inferior-lisp-args-to-list (substring string (+ 1 where)
-							(length string)))))
-	  (t (let ((pos (string-match "[^ \t]" string)))
-	       (if (null pos)
-		   nil
-		 (inferior-lisp-args-to-list (substring string pos
-							(length string)))))))))
-
-(defun lisp-eval-region (start end &optional and-go)
-  "Send the current region to the inferior Lisp process.
-Prefix argument means switch to the Lisp buffer afterwards."
-  (interactive "r\nP")
-  (comint-send-region (inferior-lisp-proc) start end)
-  (comint-send-string (inferior-lisp-proc) "\n")
-  (if and-go (switch-to-lisp t)))
-
-(defun lisp-eval-defun (&optional and-go)
-  "Send the current defun to the inferior Lisp process.
-Prefix argument means switch to the Lisp buffer afterwards."
-  (interactive "P")
-  (save-excursion
-    (end-of-defun)
-    (skip-chars-backward " \t\n\r\f") ;  Makes allegro happy
-    (let ((end (point)))
-      (beginning-of-defun)
-      (lisp-eval-region (point) end)))
-  (if and-go (switch-to-lisp t)))
-
-(defun lisp-eval-last-sexp (&optional and-go)
-  "Send the previous sexp to the inferior Lisp process.
-Prefix argument means switch to the Lisp buffer afterwards."
-  (interactive "P")
-  (lisp-eval-region (save-excursion (backward-sexp) (point)) (point) and-go))
-
-;;; Common Lisp COMPILE sux. 
-(defun lisp-compile-region (start end &optional and-go)
-  "Compile the current region in the inferior Lisp process.
-Prefix argument means switch to the Lisp buffer afterwards."
-  (interactive "r\nP")
-  (comint-send-string
-   (inferior-lisp-proc)
-   (format "(funcall (compile nil `(lambda () (progn 'compile %s))))\n"
-	   (buffer-substring start end)))
-  (if and-go (switch-to-lisp t)))
-
-(defun lisp-compile-defun (&optional and-go)
-  "Compile the current defun in the inferior Lisp process.
-Prefix argument means switch to the Lisp buffer afterwards."
-  (interactive "P")
-  (save-excursion
-    (end-of-defun)
-    (skip-chars-backward " \t\n\r\f") ;  Makes allegro happy
-    (let ((e (point)))
-      (beginning-of-defun)
-      (lisp-compile-region (point) e)))
-  (if and-go (switch-to-lisp t)))
-
-(defun switch-to-lisp (eob-p)
-  "Switch to the inferior Lisp process buffer.
-With argument, positions cursor at end of buffer."
-  (interactive "P")
-  (if (get-buffer inferior-lisp-buffer)
-      (let ((pop-up-frames
-	     ;; Be willing to use another frame
-	     ;; that already has the window in it.
-	     (or pop-up-frames
-		 (get-buffer-window inferior-lisp-buffer t))))
-	(pop-to-buffer inferior-lisp-buffer))
-    (error "No current inferior Lisp buffer"))
-  (cond (eob-p
-	 (push-mark)
-	 (goto-char (point-max)))))
-
-
-;;; Now that lisp-compile/eval-defun/region takes an optional prefix arg,
-;;; these commands are redundant. But they are kept around for the user
-;;; to bind if he wishes, for backwards functionality, and because it's
-;;; easier to type C-c e than C-u C-c C-e.
-
-(defun lisp-eval-region-and-go (start end)
-  "Send the current region to the inferior Lisp, and switch to its buffer."
-  (interactive "r")
-  (lisp-eval-region start end t))
-
-(defun lisp-eval-defun-and-go ()
-  "Send the current defun to the inferior Lisp, and switch to its buffer."
-  (interactive)
-  (lisp-eval-defun t))
-
-(defun lisp-compile-region-and-go (start end)
-  "Compile the current region in the inferior Lisp, and switch to its buffer."
-  (interactive "r")
-  (lisp-compile-region start end t))
-
-(defun lisp-compile-defun-and-go ()
-  "Compile the current defun in the inferior Lisp, and switch to its buffer."
-  (interactive)
-  (lisp-compile-defun t))
-
-;;; A version of the form in H. Shevis' soar-mode.el package. Less robust.
-;;; (defun lisp-compile-sexp (start end)
-;;;   "Compile the s-expression bounded by START and END in the inferior lisp.
-;;; If the sexp isn't a DEFUN form, it is evaluated instead."
-;;;   (cond ((looking-at "(defun\\s +")
-;;; 	 (goto-char (match-end 0))
-;;; 	 (let ((name-start (point)))
-;;; 	   (forward-sexp 1)
-;;; 	   (process-send-string "inferior-lisp"
-;;; 				(format "(compile '%s #'(lambda "
-;;; 					(buffer-substring name-start
-;;; 							  (point)))))
-;;; 	 (let ((body-start (point)))
-;;; 	   (goto-char start) (forward-sexp 1) ; Can't use end-of-defun.
-;;; 	   (process-send-region "inferior-lisp"
-;;; 				(buffer-substring body-start (point))))
-;;; 	 (process-send-string "inferior-lisp" ")\n"))
-;;; 	(t (lisp-eval-region start end)))))
-;;; 
-;;; (defun lisp-compile-region (start end)
-;;;   "Each s-expression in the current region is compiled (if a DEFUN)
-;;; or evaluated (if not) in the inferior lisp."
-;;;   (interactive "r")
-;;;   (save-excursion
-;;;     (goto-char start) (end-of-defun) (beginning-of-defun) ; error check
-;;;     (if (< (point) start) (error "region begins in middle of defun"))
-;;;     (goto-char start)
-;;;     (let ((s start))
-;;;       (end-of-defun)
-;;;       (while (<= (point) end) ; Zip through
-;;; 	(lisp-compile-sexp s (point)) ; compiling up defun-sized chunks.
-;;; 	(setq s (point))
-;;; 	(end-of-defun))
-;;;       (if (< s end) (lisp-compile-sexp s end)))))
-;;; 
-;;; End of HS-style code
-
-
-(defvar lisp-prev-l/c-dir/file nil
-  "Record last directory and file used in loading or compiling.
-This holds a cons cell of the form `(DIRECTORY . FILE)'
-describing the last `lisp-load-file' or `lisp-compile-file' command.")
-
-(defvar lisp-source-modes '(lisp-mode)
-  "*Used to determine if a buffer contains Lisp source code.
-If it's loaded into a buffer that is in one of these major modes, it's
-considered a Lisp source file by `lisp-load-file' and `lisp-compile-file'.
-Used by these commands to determine defaults.")
-
-(defun lisp-load-file (file-name)
-  "Load a Lisp file into the inferior Lisp process."
-  (interactive (comint-get-source "Load Lisp file: " lisp-prev-l/c-dir/file
-				  lisp-source-modes nil)) ; NIL because LOAD
-					; doesn't need an exact name
-  (comint-check-source file-name) ; Check to see if buffer needs saved.
-  (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
-				     (file-name-nondirectory file-name)))
-  (comint-send-string (inferior-lisp-proc)
-		      (format inferior-lisp-load-command file-name))
-  (switch-to-lisp t))
-
-
-(defun lisp-compile-file (file-name)
-  "Compile a Lisp file in the inferior Lisp process."
-  (interactive (comint-get-source "Compile Lisp file: " lisp-prev-l/c-dir/file
-				  lisp-source-modes nil)) ; NIL = don't need
-					; suffix .lisp
-  (comint-check-source file-name) ; Check to see if buffer needs saved.
-  (setq lisp-prev-l/c-dir/file (cons (file-name-directory    file-name)
-				     (file-name-nondirectory file-name)))
-  (comint-send-string (inferior-lisp-proc) (concat "(compile-file \""
-						   file-name
-						   "\"\)\n"))
-  (switch-to-lisp t))
-
-
-
-;;; Documentation functions: function doc, var doc, arglist, and
-;;; describe symbol.
-;;; ===========================================================================
-
-;;; Command strings
-;;; ===============
-
-(defvar lisp-function-doc-command
-  "(let ((fn '%s))
-     (format t \"Documentation for ~a:~&~a\"
-	     fn (documentation fn 'function))
-     (values))\n"
-  "Command to query inferior Lisp for a function's documentation.")
-
-(defvar lisp-var-doc-command
-  "(let ((v '%s))
-     (format t \"Documentation for ~a:~&~a\"
-	     v (documentation v 'variable))
-     (values))\n"
-  "Command to query inferior Lisp for a variable's documentation.")
-
-(defvar lisp-arglist-command
-  "(let ((fn '%s))
-     (format t \"Arglist for ~a: ~a\" fn (arglist fn))
-     (values))\n"
-  "Command to query inferior Lisp for a function's arglist.")
-
-(defvar lisp-describe-sym-command
-  "(describe '%s)\n"
-  "Command to query inferior Lisp for a variable's documentation.")
-
-
-;;; Ancillary functions
-;;; ===================
-
-;;; Reads a string from the user.
-(defun lisp-symprompt (prompt default)
-  (list (let* ((prompt (if default
-			   (format "%s (default %s): " prompt default)
-			 (concat prompt ": ")))
-	       (ans (read-string prompt)))
-	  (if (zerop (length ans)) default ans))))
-
-
-;;; Adapted from function-called-at-point in help.el.
-(defun lisp-fn-called-at-pt ()
-  "Returns the name of the function called in the current call.
-The value is nil if it can't find one."
-  (condition-case nil
-      (save-excursion
-	(save-restriction
-	  (narrow-to-region (max (point-min) (- (point) 1000)) (point-max))
-	  (backward-up-list 1)
-	  (forward-char 1)
-	  (let ((obj (read (current-buffer))))
-	    (and (symbolp obj) obj))))
-    (error nil)))
-
-
-;;; Adapted from variable-at-point in help.el.
-(defun lisp-var-at-pt ()
-  (condition-case ()
-      (save-excursion
-	(forward-sexp -1)
-	(skip-chars-forward "'")
-	(let ((obj (read (current-buffer))))
-	  (and (symbolp obj) obj)))
-    (error nil)))
-
-
-;;; Documentation functions: fn and var doc, arglist, and symbol describe.
-;;; ======================================================================
-
-(defun lisp-show-function-documentation (fn)
-  "Send a command to the inferior Lisp to give documentation for function FN.
-See variable `lisp-function-doc-command'."
-  (interactive (lisp-symprompt "Function doc" (lisp-fn-called-at-pt)))
-  (comint-proc-query (inferior-lisp-proc)
-		     (format lisp-function-doc-command fn)))
-
-(defun lisp-show-variable-documentation (var)
-  "Send a command to the inferior Lisp to give documentation for function FN.
-See variable `lisp-var-doc-command'."
-  (interactive (lisp-symprompt "Variable doc" (lisp-var-at-pt)))
-  (comint-proc-query (inferior-lisp-proc) (format lisp-var-doc-command var)))
-
-(defun lisp-show-arglist (fn)
-  "Send a query to the inferior Lisp for the arglist for function FN.
-See variable `lisp-arglist-command'."
-  (interactive (lisp-symprompt "Arglist" (lisp-fn-called-at-pt)))
-  (comint-proc-query (inferior-lisp-proc) (format lisp-arglist-command fn)))
-
-(defun lisp-describe-sym (sym)
-  "Send a command to the inferior Lisp to describe symbol SYM.
-See variable `lisp-describe-sym-command'."
-  (interactive (lisp-symprompt "Describe" (lisp-var-at-pt)))
-  (comint-proc-query (inferior-lisp-proc)
-		     (format lisp-describe-sym-command sym)))
-
-
-;;  "Returns the current inferior Lisp process.
-;; See variable `inferior-lisp-buffer'."
-(defun inferior-lisp-proc ()
-  (let ((proc (get-buffer-process (if (eq major-mode 'inferior-lisp-mode)
-				      (current-buffer)
-				    inferior-lisp-buffer))))
-    (or proc
-	(error "No Lisp subprocess; see variable `inferior-lisp-buffer'"))))
-
-
-;;; Do the user's customisation...
-;;;===============================
-(defvar inferior-lisp-load-hook nil
-  "This hook is run when the library `inf-lisp' is loaded.
-This is a good place to put keybindings.")
-
-(run-hooks 'inferior-lisp-load-hook)
-
-;;; CHANGE LOG
-;;; ===========================================================================
-;;; 7/21/92 Jim Blandy
-;;; - Changed all uses of the cmulisp name or prefix to inferior-lisp;
-;;;   this is now the official inferior lisp package.  Use the global
-;;;   ChangeLog from now on.
-;;; 5/24/90 Olin
-;;; - Split cmulisp and cmushell modes into separate files. 
-;;;   Not only is this a good idea, it's apparently the way it'll be rel 19.
-;;; - Upgraded process sends to use comint-send-string instead of
-;;;   process-send-string.
-;;; - Explicit references to process "cmulisp" have been replaced with
-;;;   (cmulisp-proc). This allows better handling of multiple process bufs.
-;;; - Added process query and var/function/symbol documentation
-;;;   commands. Based on code written by Douglas Roberts.
-;;; - Added lisp-eval-last-sexp, bound to C-x C-e.
-;;;
-;;; 9/20/90 Olin
-;;; Added a save-restriction to lisp-fn-called-at-pt. This bug and fix
-;;; reported by Lennart Staflin.
-;;;
-;;; 3/12/90 Olin
-;;; - lisp-load-file and lisp-compile-file no longer switch-to-lisp.
-;;;   Tale suggested this.
-;;; - Reversed this decision 7/15/91. You need the visual feedback.
-;;;
-;;; 7/25/91 Olin
-;;; Changed all keybindings of the form C-c <letter>. These are
-;;; supposed to be reserved for the user to bind. This affected
-;;; mainly the compile/eval-defun/region[-and-go] commands.
-;;; This was painful, but necessary to adhere to the gnumacs standard.
-;;; For some backwards compatibility, see the 
-;;;     cmulisp-install-letter-bindings
-;;; function.
-;;;
-;;; 8/2/91 Olin
-;;; - The lisp-compile/eval-defun/region commands now take a prefix arg,
-;;;   which means switch-to-lisp after sending the text to the Lisp process.
-;;;   This obsoletes all the -and-go commands. The -and-go commands are
-;;;   kept around for historical reasons, and because the user can bind
-;;;   them to key sequences shorter than C-u C-c C-<letter>.
-;;; - If M-x cmulisp is invoked with a prefix arg, it allows you to
-;;;   edit the command line.
-
-(provide 'inf-lisp)
-
-;;; inf-lisp.el ends here
diff --git a/lisp/progmodes/m4-mode.el b/lisp/progmodes/m4-mode.el
deleted file mode 100644
index a9177ea91e0..00000000000
--- a/lisp/progmodes/m4-mode.el
+++ /dev/null
@@ -1,152 +0,0 @@
-;;; m4-mode.el --- m4 code editing commands for Emacs
-
-;;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Andrew Csillag <drew@staff.prodigy.com>
-;; Maintainer: Andrew Csillag <drew@staff.prodigy.com>
-;; Keywords: languages, 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:
-
-;; A smart editing mode for m4 macro definitions.  It seems to have most of the 
-;; syntax right (sexp motion commands work, but function motion commands don't).
-;; It also sets the font-lock syntax stuff for colorization
-
-;; To Do's:
-
-;; * want to make m4-m4-(buffer|region) look sorta like M-x compile look&feel ?
-;; * sexp motion commands don't seem to work right
-
-;; to autoload m4 lisp code:  
-;; (autoload 'm4-mode "m4-mode" nil t)
-;;
-;; or can use (load "m4-mode") or (require 'm4-mode) to just load it 
-;;
-;; to try to "auto-detect" m4 files:
-;; (setq auto-mode-alist 
-;;	 (cons '(".*\\.m4$" . m4-mode)
-;;	       auto-mode-alist))
-
-;;; Thanks: 
-;;;         to Akim Demaille and Terry Jones for the bug reports
-
-;;; Code:
-
-;;path to the m4 program
-(defvar m4-program "/usr/local/bin/m4")
-
-;;thank god for make-regexp.el!
-(defvar m4-font-lock-keywords
-  `(
-    ("^\\\#.*" . font-lock-comment-face)
-    ("\\\$\\\*" . font-lock-variable-name-face)
-    ("\\\$[0-9]" . font-lock-variable-name-face)
-    ("\\\$\\\#" . font-lock-variable-name-face)
-    ("\\\$\\\@" . font-lock-variable-name-face)
-    ("\\\$\\\*" . font-lock-variable-name-face)
-    ("\\b\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|gnu\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|un\\(d\\(efine\\|ivert\\)\\|ix\\)\\)\\b" . font-lock-keyword-face)
-    ("\\b\\(m4_\\(builtin\\|change\\(com\\|quote\\|word\\)\\|d\\(e\\(bug\\(file\\|mode\\)\\|cr\\|f\\(ine\\|n\\)\\)\\|iv\\(ert\\|num\\)\\|nl\\|umpdef\\)\\|e\\(rrprint\\|syscmd\\|val\\)\\|f\\(ile\\|ormat\\)\\|i\\(f\\(def\\|else\\)\\|n\\(c\\(lude\\|r\\)\\|d\\(ex\\|ir\\)\\)\\)\\|l\\(en\\|ine\\)\\|m\\(4\\(_undefine\\|exit\\|wrap\\)\\|aketemp\\)\\|p\\(atsubst\\|opdef\\|ushdef\\)\\|regexp\\|s\\(hift\\|include\\|ubstr\\|ys\\(cmd\\|val\\)\\)\\|tra\\(ceo\\(ff\\|n\\)\\|nslit\\)\\|undivert\\)\\)\\b" . font-lock-keyword-face)
-    "default font-lock-keywords")
-)
-
-;;this may still need some work
-(defvar m4-mode-syntax-table nil
-  "syntax table used in m4 mode")
-(setq m4-mode-syntax-table (make-syntax-table))
-(modify-syntax-entry ?` "('" m4-mode-syntax-table)
-(modify-syntax-entry ?' ")`" m4-mode-syntax-table)
-(modify-syntax-entry ?# "<\n" m4-mode-syntax-table)
-(modify-syntax-entry ?\n ">#" m4-mode-syntax-table)
-(modify-syntax-entry ?{  "_" m4-mode-syntax-table)
-(modify-syntax-entry ?}  "_" m4-mode-syntax-table)
-(modify-syntax-entry ?*  "w" m4-mode-syntax-table)
-(modify-syntax-entry ?_  "w" m4-mode-syntax-table)
-(modify-syntax-entry ?\"  "w" m4-mode-syntax-table)
-
-(defvar m4-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\C-c\C-b" 'm4-m4-buffer)
-    (define-key map "\C-c\C-r" 'm4-m4-region)
-    (define-key map "\C-c\C-c" 'comment-region)
-    map))
-
-(defun m4-m4-buffer ()
-  "send contents of the current buffer to m4"
-  (interactive)
-  (start-process "m4process" "*m4 output*" m4-program "-e")
-  (process-send-region "m4process" (point-min) (point-max))
-  (process-send-eof "m4process")
-  (switch-to-buffer "*m4 output*")
-)
-
-(defun m4-m4-region ()
-  "send contents of the current region to m4"
-  (interactive)
-  (start-process "m4process" "*m4 output*" m4-program "-e")
-  (process-send-region "m4process" (point) (mark))
-  (process-send-eof "m4process")
-  (switch-to-buffer "*m4 output*")
-)
-
-(defun m4-mode ()
-  "A major-mode to edit m4 macro files
-\\{m4-mode-map}
-"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map m4-mode-map)
-
-  (make-local-variable 'comment-start)
-  (setq comment-start "#")
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-
-
-  (make-local-variable	'font-lock-defaults)  
-  (setq major-mode 'm4-mode
-	mode-name "m4"
-	font-lock-defaults `(m4-font-lock-keywords nil)
-	)
-  (set-syntax-table m4-mode-syntax-table)
-  (run-hooks 'm4-mode-hook))
-
-(provide 'm4-mode)
-;;stuff to play with for debugging
-;(char-to-string (char-syntax ?`))
-
-;;;how I generate the nasty looking regexps at the top
-;;;(make-regexp '("builtin" "changecom" "changequote" "changeword" "debugfile" 
-;;;		  "debugmode" "decr" "define" "defn" "divert" "divnum" "dnl" 
-;;;		  "dumpdef" "errprint" "esyscmd" "eval" "file" "format" "gnu"
-;;;		  "ifdef" "ifelse" "include" "incr" "index" "indir" "len" "line" 
-;;;		  "m4exit" "m4wrap" "maketemp" "patsubst" "popdef" "pushdef" "regexp" 
-;;;		  "shift" "sinclude" "substr" "syscmd" "sysval" "traceoff" "traceon" 
-;;;		  "translit" "undefine" "undivert" "unix"))
-;;;(make-regexp '("m4_builtin" "m4_changecom" "m4_changequote" "m4_changeword" 
-;;;		  "m4_debugfile" "m4_debugmode" "m4_decr" "m4_define" "m4_defn" 
-;;;		  "m4_divert" "m4_divnum" "m4_dnl" "m4_dumpdef" "m4_errprint" 
-;;;		  "m4_esyscmd" "m4_eval" "m4_file" "m4_format" "m4_ifdef" "m4_ifelse" 
-;;;		  "m4_include" "m4_incr" "m4_index" "m4_indir" "m4_len" "m4_line" 
-;;;		  "m4_m4exit" "m4_m4wrap" "m4_maketemp" "m4_patsubst" "m4_popdef" 
-;;;		  "m4_pushdef" "m4_regexp" "m4_shift" "m4_sinclude" "m4_substr" 
-;;;		  "m4_syscmd" "m4_sysval" "m4_traceoff" "m4_traceon" "m4_translit" 
-;;;		  "m4_m4_undefine" "m4_undivert"))
-
-;;; m4.el ends here
diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el
deleted file mode 100644
index 25aaf3b8cf7..00000000000
--- a/lisp/progmodes/make-mode.el
+++ /dev/null
@@ -1,1396 +0,0 @@
-;;; make-mode.el --- makefile editing commands for Emacs
-
-;; Copyright (C) 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Thomas Neumann <tom@smart.bo.open.de>
-;;	Eric S. Raymond <esr@snark.thyrsus.com>
-;; Adapted-By: ESR
-;; Keywords: unix, tools
-
-;; RMS:
-;; This needs work.
-;; Also, the doc strings need fixing: the first line doesn't stand alone,
-;; and other usage is not high quality.  Symbol names don't have `...'.
-
-;; 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:
-
-;; A major mode for editing makefiles.  The mode knows about Makefile
-;; syntax and defines M-n and M-p to move to next and previous productions.
-;;
-;; The keys $, =, : and . are electric; they try to help you fill in a
-;; macro reference, macro definition, ordinary target name, or special
-;; target name, respectively.  Such names are completed using a list of
-;; targets and macro names parsed out of the makefile.  This list is
-;; automatically updated, if necessary, whenever you invoke one of
-;; these commands.  You can force it to be updated with C-c C-p.
-;;
-;; The command C-c C-f adds certain filenames in the current directory
-;; as targets.  You can filter out filenames by setting the variable
-;; makefile-ignored-files-in-pickup-regex.
-;;
-;; The command C-c C-u grinds for a bit, then pops up a report buffer
-;; showing which target names are up-to-date with respect to their
-;; prerequisites, which targets are out-of-date, and which have no
-;; prerequisites.
-;;
-;; The command C-c C-b pops up a browser window listing all target and
-;; macro names.  You can mark or unmark items wit C-c SPC, and insert
-;; all marked items back in the Makefile with C-c TAB.
-;;
-;; The command C-c TAB in the makefile buffer inserts a GNU make builtin.
-;; You will be prompted for the builtin's args.
-;;
-;; There are numerous other customization variables.
-
-;;
-;; To Do:
-;;
-;; * makefile-backslash-region should be given better behavior.
-;; * Consider binding C-c C-c to comment-region (like cc-mode).
-;; * Eliminate electric stuff entirely.
-;; * It might be nice to highlight targets differently depending on
-;;   whether they are up-to-date or not.  Not sure how this would
-;;   interact with font-lock.
-;; * Would be nice to edit the commands in ksh-mode and have
-;;   indentation and slashification done automatically.  Hard.
-;; * Consider removing browser mode.  It seems useless.
-;; * ":" should notice when a new target is made and add it to the
-;;   list (or at least set makefile-need-target-pickup).
-;; * Make browser into a major mode.
-;; * Clean up macro insertion stuff.  It is a mess.
-;; * Browser entry and exit is weird.  Normalize.
-;; * Browser needs to be rewritten.  Right now it is kind of a crock.
-;;   Should at least:
-;;    * Act more like dired/buffer menu/whatever.
-;;    * Highlight as mouse traverses.
-;;    * B2 inserts.
-;; * Update documentation above.
-;; * Update texinfo manual.
-;; * Update files.el.
-
-
-
-;;; Code:
-
-(provide 'makefile)
-
-;; Sadly we need this for a macro.
-(eval-when-compile
-  (require 'imenu))
-
-;;; ------------------------------------------------------------
-;;; Configurable stuff
-;;; ------------------------------------------------------------
-
-(defvar makefile-browser-buffer-name "*Macros and Targets*"
-  "Name of the macro- and target browser buffer.")
-
-(defvar makefile-target-colon ":"
-  "String to append to all target names inserted by `makefile-insert-target'.
-\":\" or \"::\" are common values.")
-
-(defvar makefile-macro-assign " = "
-  "String to append to all macro names inserted by `makefile-insert-macro'.
-The normal value should be \" = \", since this is what
-standard make expects. However, newer makes such as dmake
-allow a larger variety of different macro assignments, so you
-might prefer to use \" += \" or \" := \" .")
-
-(defvar makefile-electric-keys nil
-  "If non-nil, install electric keybindings.
-Default is nil.")
-
-(defvar makefile-use-curly-braces-for-macros-p nil
-  "Controls the style of generated macro references.
-t (actually non-nil) means macro references should use curly braces,
-like `${this}'.
-nil means use parentheses, like `$(this)'.")
-
-(defvar makefile-tab-after-target-colon t
-  "If non-nil, insert a TAB after a target colon.
-Otherwise, a space is inserted.
-The default is t.")
-
-(defvar makefile-browser-leftmost-column 10
-  "Number of blanks to the left of the browser selection mark.")
-
-(defvar makefile-browser-cursor-column 10
-  "Column in which the cursor is positioned when it moves
-up or down in the browser.")
-
-(defvar makefile-backslash-column 48
-  "*Column in which `makefile-backslash-region' inserts backslashes.")
-
-(defvar makefile-browser-selected-mark "+  "
-  "String used to mark selected entries in the browser.")
-
-(defvar makefile-browser-unselected-mark "   "
-  "String used to mark unselected entries in the browser.")
-
-(defvar makefile-browser-auto-advance-after-selection-p t
-  "If non-nil, cursor will move after item is selected in browser.")
-
-(defvar makefile-pickup-everything-picks-up-filenames-p nil
-  "If non-nil, `makefile-pickup-everything' picks up filenames as targets.
-\(i.e. it calls `makefile-find-filenames-as-targets').
-Otherwise filenames are omitted.")
-
-(defvar makefile-cleanup-continuations-p t
-  "If non-nil, automatically clean up continuation lines when saving.
-A line is cleaned up by removing all whitespace following a trailing
-backslash.  This is done silently.
-IMPORTANT: Please note that enabling this option causes makefile-mode
-to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \'it seems necessary\'.")
-
-(defvar makefile-browser-hook '())
-
-;;
-;; Special targets for DMake, Sun's make ...
-;; 
-(defvar makefile-special-targets-list
-  '(("DEFAULT")      ("DONE")        ("ERROR")        ("EXPORT")
-    ("FAILED")       ("GROUPEPILOG") ("GROUPPROLOG")  ("IGNORE")
-    ("IMPORT")       ("INCLUDE")     ("INCLUDEDIRS")  ("INIT")
-    ("KEEP_STATE")   ("MAKEFILES")   ("MAKE_VERSION") ("NO_PARALLEL")
-    ("PARALLEL")     ("PHONY")       ("PRECIOUS")     ("REMOVE")
-    ("SCCS_GET")     ("SILENT")      ("SOURCE")       ("SUFFIXES")
-    ("WAIT")         ("c.o")         ("C.o")          ("m.o")
-    ("el.elc")       ("y.c")         ("s.o"))
-  "List of special targets.
-You will be offered to complete on one of those in the minibuffer whenever
-you enter a \".\" at the beginning of a line in makefile-mode.")
-
-(defvar makefile-runtime-macros-list
-  '(("@") ("&") (">") ("<") ("*") ("^") ("+") ("?") ("%") ("$"))
-  "List of macros that are resolved by make at runtime.
-If you insert a macro reference using makefile-insert-macro-ref, the name
-of the macro is checked against this list. If it can be found its name will
-not be enclosed in { } or ( ).")
-
-;; Note that the first big subexpression is used by font lock.  Note
-;; that if you change this regexp you must fix the imenu index
-;; function defined at the end of the file.
-(defconst makefile-dependency-regex
-  "^ *\\([^\n\t#:]+\\([ \t]+[^ \t\n#:]+\\)*\\)[ \t]*:\\([ \t]*$\\|\\([^=\n].*$\\)\\)"
-  "Regex used to find dependency lines in a makefile.")
-
-;; Note that the first subexpression is used by font lock.  Note that
-;; if you change this regexp you must fix the imenu index function
-;; defined at the end of the file.
-(defconst makefile-macroassign-regex
-  "^ *\\([^\n\t][^:#= \t\n]*\\)[ \t]*[*:+]?:?="
-  "Regex used to find macro assignment lines in a makefile.")
-
-(defconst makefile-ignored-files-in-pickup-regex
-  "\\(^\\..*\\)\\|\\(.*~$\\)\\|\\(.*,v$\\)\\|\\(\\.[chy]\\)"
-  "Regex for filenames that will NOT be included in the target list.")
-
-(if (fboundp 'facemenu-unlisted-faces)
-    (add-to-list 'facemenu-unlisted-faces 'makefile-space-face))
-(defvar makefile-space-face 'makefile-space-face
-  "Face to use for highlighting leading spaces in Font-Lock mode.")
-
-(defconst makefile-font-lock-keywords
-  (list
-   ;; Do macro assignments.  These get the "variable-name" face rather
-   ;; arbitrarily.
-   (list makefile-macroassign-regex 1 'font-lock-variable-name-face)
-   ;;
-   ;; Do dependencies.  These get the function name face.
-   (list makefile-dependency-regex 1 'font-lock-function-name-face)
-   ;;
-   ;; Variable references even in targets/strings/comments:
-   '("\\$[({]\\([-a-zA-Z0-9_.]+\\)[}):]" 1 font-lock-reference-face prepend)
-
-   ;; Highlight lines that contain just whitespace.
-   ;; They can cause trouble, especially if they start with a tab.
-   '("^[ \t]+$" . makefile-space-face)
-
-   ;; Highlight shell comments that Make treats as commands,
-   ;; since these can fool people.
-   '("^\t+#" 0 makefile-space-face t)
-
-   ;; Highlight spaces that precede tabs.
-   ;; They can make a tab fail to be effective.
-   '("^\\( +\\)\t" 1 makefile-space-face)))
-
-;;; ------------------------------------------------------------
-;;; The following configurable variables are used in the
-;;; up-to-date overview .
-;;; The standard configuration assumes that your `make' program
-;;; can be run in question/query mode using the `-q' option, this
-;;; means that the command
-;;;
-;;;    make -q foo
-;;;
-;;; should return an exit status of zero if the target `foo' is
-;;; up to date and a nonzero exit status otherwise.
-;;; Many makes can do this although the docs/manpages do not mention
-;;; it. Try it with your favourite one.  GNU make, System V make, and
-;;; Dennis Vadura's DMake have no problems.
-;;; Set the variable `makefile-brave-make' to the name of the
-;;; make utility that does this on your system.
-;;; To understand what this is all about see the function definition
-;;; of `makefile-query-by-make-minus-q' .
-;;; ------------------------------------------------------------
-
-(defvar makefile-brave-make "make"
-  "A make that can handle the `-q' option.")
-
-(defvar makefile-query-one-target-method 'makefile-query-by-make-minus-q
-  "Function to call to determine whether a make target is up to date.
-The function must satisfy this calling convention:
-
-* As its first argument, it must accept the name of the target to
-  be checked, as a string.
-
-* As its second argument, it may accept the name of a makefile
-  as a string. Depending on what you're going to do you may
-  not need this.
-
-* It must return the integer value 0 (zero) if the given target
-  should be considered up-to-date in the context of the given
-  makefile, any nonzero integer value otherwise.")
-
-(defvar makefile-up-to-date-buffer-name "*Makefile Up-to-date overview*"
-  "Name of the Up-to-date overview buffer.")
-
-;;; --- end of up-to-date-overview configuration ------------------
-
-(defvar makefile-mode-map nil
-  "The keymap that is used in Makefile mode.")
-
-(if makefile-mode-map
-    ()
-  (setq makefile-mode-map (make-sparse-keymap))
-  ;; set up the keymap
-  (define-key makefile-mode-map "\C-c:" 'makefile-insert-target-ref)
-  (if makefile-electric-keys
-      (progn
-	(define-key makefile-mode-map "$" 'makefile-insert-macro-ref)
-	(define-key makefile-mode-map ":" 'makefile-electric-colon)
-	(define-key makefile-mode-map "=" 'makefile-electric-equal)
-	(define-key makefile-mode-map "." 'makefile-electric-dot)))
-  (define-key makefile-mode-map "\C-c\C-f" 'makefile-pickup-filenames-as-targets)
-  (define-key makefile-mode-map "\C-c\C-b" 'makefile-switch-to-browser)
-  (define-key makefile-mode-map "\C-c\C-p" 'makefile-pickup-everything)
-  (define-key makefile-mode-map "\C-c\C-u" 'makefile-create-up-to-date-overview)
-  (define-key makefile-mode-map "\C-c\C-i" 'makefile-insert-gmake-function)
-  (define-key makefile-mode-map "\C-c\C-\\" 'makefile-backslash-region)
-  (define-key makefile-mode-map "\M-p"     'makefile-previous-dependency)
-  (define-key makefile-mode-map "\M-n"     'makefile-next-dependency)
-  (define-key makefile-mode-map "\e\t"     'makefile-complete)
-
-  ;; Make menus.
-  (define-key makefile-mode-map [menu-bar makefile-mode]
-    (cons "Makefile" (make-sparse-keymap "Makefile")))
-
-  (define-key makefile-mode-map [menu-bar makefile-mode browse]
-    '("Pop up Makefile Browser" . makefile-switch-to-browser))
-  (define-key makefile-mode-map [menu-bar makefile-mode complete]
-    '("Complete Target or Macro" . makefile-complete))
-  (define-key makefile-mode-map [menu-bar makefile-mode pickup]
-    '("Find Targets and Macros" . makefile-pickup-everything))
-
-  (define-key makefile-mode-map [menu-bar makefile-mode prev]
-    '("Move to Previous Dependency" . makefile-previous-dependency))
-  (define-key makefile-mode-map [menu-bar makefile-mode next]
-    '("Move to Next Dependency" . makefile-next-dependency)))
-
-(defvar makefile-browser-map nil
-  "The keymap that is used in the macro- and target browser.")
-(if makefile-browser-map
-    ()
-  (setq makefile-browser-map (make-sparse-keymap))
-  (define-key makefile-browser-map "n"    'makefile-browser-next-line)
-  (define-key makefile-browser-map "\C-n" 'makefile-browser-next-line)    
-  (define-key makefile-browser-map "p"    'makefile-browser-previous-line)
-  (define-key makefile-browser-map "\C-p" 'makefile-browser-previous-line)
-  (define-key makefile-browser-map " "    'makefile-browser-toggle)
-  (define-key makefile-browser-map "i"    'makefile-browser-insert-selection)
-  (define-key makefile-browser-map "I"    'makefile-browser-insert-selection-and-quit)  
-  (define-key makefile-browser-map "\C-c\C-m" 'makefile-browser-insert-continuation)
-  (define-key makefile-browser-map "q"    'makefile-browser-quit)
-  ;; disable horizontal movement
-  (define-key makefile-browser-map "\C-b" 'undefined)
-  (define-key makefile-browser-map "\C-f" 'undefined))  
-
-
-(defvar makefile-mode-syntax-table nil)
-(if makefile-mode-syntax-table
-    ()
-  (setq makefile-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\( "()    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\) ")(    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\[ "(]    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\] ")[    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\{ "(}    " makefile-mode-syntax-table)  
-  (modify-syntax-entry ?\} "){    " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"     " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\` "\"     " makefile-mode-syntax-table)
-  (modify-syntax-entry ?#  "<     " makefile-mode-syntax-table)
-  (modify-syntax-entry ?\n ">     " makefile-mode-syntax-table))
-
-
-;;; ------------------------------------------------------------
-;;; Internal variables.
-;;; You don't need to configure below this line.
-;;; ------------------------------------------------------------
-
-(defvar makefile-target-table nil
-  "Table of all target names known for this buffer.")
-
-(defvar makefile-macro-table nil
-  "Table of all macro names known for this buffer.")
-
-(defvar makefile-browser-client
-  "A buffer in Makefile mode that is currently using the browser.")
-
-(defvar makefile-browser-selection-vector nil)
-(defvar makefile-has-prereqs nil)
-(defvar makefile-need-target-pickup t)
-(defvar makefile-need-macro-pickup t)
-
-(defvar makefile-mode-hook '())
-
-;; Each element looks like '("GNU MAKE FUNCTION" "ARG" "ARG" ... )
-;; Each "ARG" is used as a prompt for a required argument.
-(defconst makefile-gnumake-functions-alist
-  '(
-    ;; Text functions
-    ("subst" "From" "To" "In")
-    ("patsubst" "Pattern" "Replacement" "In")
-    ("strip" "Text")
-    ("findstring" "Find what" "In")
-    ("filter" "Pattern" "Text")
-    ("filter-out" "Pattern" "Text")
-    ("sort" "List")
-    ;; Filename functions
-    ("dir" "Names")
-    ("notdir" "Names")
-    ("suffix" "Names")
-    ("basename" "Names")
-    ("addprefix" "Prefix" "Names")
-    ("addsuffix" "Suffix" "Names")
-    ("join" "List 1" "List 2")
-    ("word" "Index" "Text")
-    ("words" "Text")
-    ("firstword" "Text")
-    ("wildcard" "Pattern")
-    ;; Misc functions
-    ("foreach" "Variable" "List" "Text")
-    ("origin" "Variable")
-    ("shell" "Command")))
-
-
-;;; ------------------------------------------------------------
-;;; The mode function itself.
-;;; ------------------------------------------------------------
-
-;;;###autoload
-(defun makefile-mode ()
-  "Major mode for editing Makefiles.
-This function ends by invoking the function(s) `makefile-mode-hook'.
-
-\\{makefile-mode-map}
-
-In the browser, use the following keys:
-
-\\{makefile-browser-map}
-
-Makefile mode can be configured by modifying the following variables:
-
-makefile-browser-buffer-name:
-    Name of the macro- and target browser buffer.
-
-makefile-target-colon:
-    The string that gets appended to all target names
-    inserted by `makefile-insert-target'.
-    \":\" or \"::\" are quite common values.
-
-makefile-macro-assign:
-   The string that gets appended to all macro names
-   inserted by `makefile-insert-macro'.
-   The normal value should be \" = \", since this is what
-   standard make expects. However, newer makes such as dmake
-   allow a larger variety of different macro assignments, so you
-   might prefer to use \" += \" or \" := \" .
-
-makefile-tab-after-target-colon:
-   If you want a TAB (instead of a space) to be appended after the
-   target colon, then set this to a non-nil value.
-
-makefile-browser-leftmost-column:
-   Number of blanks to the left of the browser selection mark.
-
-makefile-browser-cursor-column:
-   Column in which the cursor is positioned when it moves
-   up or down in the browser.
-
-makefile-browser-selected-mark:
-   String used to mark selected entries in the browser.
-
-makefile-browser-unselected-mark:
-   String used to mark unselected entries in the browser.
-
-makefile-browser-auto-advance-after-selection-p:
-   If this variable is set to a non-nil value the cursor
-   will automagically advance to the next line after an item
-   has been selected in the browser.
-
-makefile-pickup-everything-picks-up-filenames-p:
-   If this variable is set to a non-nil value then
-   `makefile-pickup-everything' also picks up filenames as targets
-   (i.e. it calls `makefile-find-filenames-as-targets'), otherwise
-   filenames are omitted.
-
-makefile-cleanup-continuations-p:
-   If this variable is set to a non-nil value then makefile-mode
-   will assure that no line in the file ends with a backslash
-   (the continuation character) followed by any whitespace.
-   This is done by silently removing the trailing whitespace, leaving
-   the backslash itself intact.
-   IMPORTANT: Please note that enabling this option causes makefile-mode
-   to MODIFY A FILE WITHOUT YOUR CONFIRMATION when \"it seems necessary\".
-
-makefile-browser-hook:
-   A function or list of functions to be called just before the
-   browser is entered. This is executed in the makefile buffer.
-
-makefile-special-targets-list:
-   List of special targets. You will be offered to complete
-   on one of those in the minibuffer whenever you enter a `.'.
-   at the beginning of a line in Makefile mode."
-
-  (interactive)
-  (kill-all-local-variables)
-  (make-local-variable 'local-write-file-hooks)
-  (setq local-write-file-hooks
-	'(makefile-cleanup-continuations makefile-warn-suspicious-lines))
-  (make-local-variable 'makefile-target-table)
-  (make-local-variable 'makefile-macro-table)
-  (make-local-variable 'makefile-has-prereqs)
-  (make-local-variable 'makefile-need-target-pickup)
-  (make-local-variable 'makefile-need-macro-pickup)
-
-  ;; Font lock.
-  (if (fboundp 'make-face)
-      (makefile-define-space-face))
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(makefile-font-lock-keywords))
-
-  ;; Add-log.
-  (make-local-variable 'add-log-current-defun-function)
-  (setq add-log-current-defun-function 'makefile-add-log-defun)
-
-  ;; Imenu.
-  (make-local-variable 'imenu-create-index-function)
-  (setq imenu-create-index-function 'makefile-menu-index-function)
-
-  ;; Dabbrev.
-  (make-local-variable 'dabbrev-abbrev-skip-leading-regexp)
-  (setq dabbrev-abbrev-skip-leading-regexp "\\$")
-
-  ;; Comment stuff.
-  (make-local-variable 'comment-start)
-  (setq comment-start "#")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#+[ \t]*")
-
-  ;; become the current major mode
-  (setq major-mode 'makefile-mode)
-  (setq mode-name "Makefile")
-
-  ;; Activate keymap and syntax table.
-  (use-local-map makefile-mode-map)
-  (set-syntax-table makefile-mode-syntax-table)
-
-  ;; Real TABs are important in makefiles
-  (setq indent-tabs-mode t)
-  (run-hooks 'makefile-mode-hook))
-
-
-
-;;; Motion code.
-
-(defun makefile-next-dependency ()
-  "Move point to the beginning of the next dependency line."
-  (interactive)
-  (let ((here (point)))
-    (end-of-line)
-    (if (re-search-forward makefile-dependency-regex (point-max) t)
-	(progn (beginning-of-line) t)	; indicate success
-      (goto-char here) nil)))
-
-(defun makefile-previous-dependency ()
-  "Move point to the beginning of the previous dependency line."
-  (interactive)
-  (let ((here (point)))
-    (beginning-of-line)
-    (if (re-search-backward makefile-dependency-regex (point-min) t)
-	(progn (beginning-of-line) t)	; indicate success
-      (goto-char here) nil)))
-
-
-
-;;; Electric keys.  Blech.
-
-(defun makefile-electric-dot (arg)
-  "Prompt for the name of a special target to insert.
-Only does electric insertion at beginning of line.
-Anywhere else just self-inserts."
-  (interactive "p")
-  (if (bolp)
-      (makefile-insert-special-target)
-    (self-insert-command arg)))
-
-(defun makefile-insert-special-target ()
-  "Prompt for and insert a special target name.
-Uses `makefile-special-targets' list."
-  (interactive)
-  (makefile-pickup-targets)
-  (let ((special-target
-	 (completing-read "Special target: "
-			  makefile-special-targets-list nil nil nil)))
-    (if (zerop (length special-target))
-	()
-      (insert "." special-target ":")
-      (makefile-forward-after-target-colon))))
-
-(defun makefile-electric-equal (arg)
-  "Prompt for name of a macro to insert.
-Only does prompting if point is at beginning of line.
-Anywhere else just self-inserts."
-  (interactive "p")
-  (makefile-pickup-macros)
-  (if (bolp)
-      (call-interactively 'makefile-insert-macro)
-    (self-insert-command arg)))
-
-(defun makefile-insert-macro (macro-name)
-  "Prepare definition of a new macro."
-  (interactive "sMacro Name: ")
-  (makefile-pickup-macros)
-  (if (not (zerop (length macro-name)))
-      (progn
-	(beginning-of-line)
-	(insert macro-name makefile-macro-assign)
-	(setq makefile-need-macro-pickup t)
-	(makefile-remember-macro macro-name))))
-
-(defun makefile-insert-macro-ref (macro-name)
-  "Complete on a list of known macros, then insert complete ref at point."
-  (interactive
-   (list
-    (progn
-      (makefile-pickup-macros)
-      (completing-read "Refer to macro: " makefile-macro-table nil nil nil))))
-  (makefile-do-macro-insertion macro-name))
-
-(defun makefile-insert-target (target-name)
-  "Prepare definition of a new target (dependency line)."
-  (interactive "sTarget: ")
-  (if (not (zerop (length target-name)))
-      (progn
-	(beginning-of-line)
-	(insert target-name makefile-target-colon)
-	(makefile-forward-after-target-colon)
-	(end-of-line)
-	(setq makefile-need-target-pickup t)
-	(makefile-remember-target target-name))))
-
-(defun makefile-insert-target-ref (target-name)
-  "Complete on a list of known targets, then insert target-ref at point."
-  (interactive
-   (list
-    (progn
-     (makefile-pickup-targets)
-     (completing-read "Refer to target: " makefile-target-table nil nil nil))))
-   (if (not (zerop (length target-name)))
-       (insert target-name " ")))
-
-(defun makefile-electric-colon (arg)
-  "Prompt for name of new target.
-Prompting only happens at beginning of line.
-Anywhere else just self-inserts."
-  (interactive "p")
-  (if (bolp)
-      (call-interactively 'makefile-insert-target)
-    (self-insert-command arg)))
-
-
-
-;;; ------------------------------------------------------------
-;;; Extracting targets and macros from an existing makefile
-;;; ------------------------------------------------------------
-
-(defun makefile-pickup-targets ()
-  "Notice names of all target definitions in Makefile."
-  (interactive)
-  (if (not makefile-need-target-pickup)
-      nil
-    (setq makefile-need-target-pickup nil)
-    (setq makefile-target-table nil)
-    (setq makefile-has-prereqs nil)
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward makefile-dependency-regex (point-max) t)
-	(makefile-add-this-line-targets)))
-    (message "Read targets OK.")))
-
-(defun makefile-add-this-line-targets ()
-  (save-excursion
-    (beginning-of-line)
-    (let ((done-with-line nil)
-	  (line-number (1+ (count-lines (point-min) (point)))))
-      (while (not done-with-line)
-	(skip-chars-forward " \t")
-	(if (not (setq done-with-line (or (eolp)
-					  (char-equal (char-after (point)) ?:))))
-	    (progn
-	      (let* ((start-of-target-name (point))
-		     (target-name
-		      (progn
-			(skip-chars-forward "^ \t:#")
-			(buffer-substring start-of-target-name (point))))
-		     (has-prereqs
-		      (not (looking-at ":[ \t]*$"))))
-		(if (makefile-remember-target target-name has-prereqs)
-		    (message "Picked up target \"%s\" from line %d"
-			     target-name line-number)))))))))
-
-(defun makefile-pickup-macros ()
-  "Notice names of all macro definitions in Makefile."
-  (interactive)
-  (if (not makefile-need-macro-pickup)
-      nil
-    (setq makefile-need-macro-pickup nil)
-    (setq makefile-macro-table nil)
-    (save-excursion
-      (goto-char (point-min))
-      (while (re-search-forward makefile-macroassign-regex (point-max) t)
-	(makefile-add-this-line-macro)
-	(forward-line 1)))
-    (message "Read macros OK.")))
-
-(defun makefile-add-this-line-macro ()
-  (save-excursion
-    (beginning-of-line)
-    (skip-chars-forward " \t")
-    (if (not (eolp))
-	(let* ((start-of-macro-name (point))
-	       (line-number (1+ (count-lines (point-min) (point))))
-	       (macro-name (progn
-			     (skip-chars-forward "^ \t:#=*")
-			     (buffer-substring start-of-macro-name (point)))))
-	  (if (makefile-remember-macro macro-name)
-	      (message "Picked up macro \"%s\" from line %d"
-		       macro-name line-number))))))
-
-(defun makefile-pickup-everything (arg)
-  "Notice names of all macros and targets in Makefile.
-Prefix arg means force pickups to be redone."
-  (interactive "P")
-  (if arg
-      (progn
-	(setq makefile-need-target-pickup t)
-	(setq makefile-need-macro-pickup t)))
-  (makefile-pickup-macros)
-  (makefile-pickup-targets)
-  (if makefile-pickup-everything-picks-up-filenames-p
-      (makefile-pickup-filenames-as-targets)))
-
-(defun makefile-pickup-filenames-as-targets ()
-  "Scan the current directory for filenames to use as targets.
-Checks each filename against `makefile-ignored-files-in-pickup-regex'
-and adds all qualifying names to the list of known targets."
-  (interactive)
-  (let* ((dir (file-name-directory (buffer-file-name)))
-	 (raw-filename-list (if dir
-				(file-name-all-completions "" dir)
-			      (file-name-all-completions "" ""))))
-    (mapcar '(lambda (name)
-	       (if (and (not (file-directory-p name))
-			(not (string-match makefile-ignored-files-in-pickup-regex
-					   name)))
-		   (if (makefile-remember-target name)
-		       (message "Picked up file \"%s\" as target" name))))
-	    raw-filename-list)))
-
-
-
-;;; Completion.
-
-(defun makefile-complete ()
-  "Perform completion on Makefile construct preceding point.
-Can complete variable and target names.
-The context determines which are considered."
-  (interactive)
-  (let* ((beg (save-excursion
-		(skip-chars-backward "^$(){}:#= \t\n")
-		(point)))
-	 (try (buffer-substring beg (point)))
-	 (do-macros nil)
-	 (paren nil))
-
-    (save-excursion
-      (goto-char beg)
-      (let ((pc (preceding-char)))
-	(cond
-	 ;; Beginning of line means anything.
-	 ((bolp)
-	  ())
-
-	 ;; Preceding "$" means macros only.
-	 ((= pc ?$)
-	  (setq do-macros t))
-
-	 ;; Preceding "$(" or "${" means macros only.
-	 ((and (or (= pc ?{)
-		   (= pc ?\())
-	       (progn
-		 (setq paren pc)
-		 (backward-char)
-		 (and (not (bolp))
-		      (= (preceding-char) ?$))))
-	  (setq do-macros t)))))
-
-    ;; Try completion.
-    (let* ((table (append (if do-macros
-			      '()
-			    makefile-target-table)
-			  makefile-macro-table))
-	   (completion (try-completion try table)))
-      (cond
-       ;; Exact match, so insert closing paren or colon.
-       ((eq completion t)
-	(insert (if do-macros
-		    (if (eq paren ?{)
-			?}
-		      ?\))
-		  (if (save-excursion
-			(goto-char beg)
-			(bolp))
-		      ":"
-		    " "))))
-
-       ;; No match.
-       ((null completion)
-	(message "Can't find completion for \"%s\"" try)
-	(ding))
-
-       ;; Partial completion.
-       ((not (string= try completion))
-	;; FIXME it would be nice to supply the closing paren if an
-	;; exact, unambiguous match were found.  That is not possible
-	;; right now.  Ditto closing ":" for targets.
-	(delete-region beg (point))
-
-	;; DO-MACROS means doing macros only.  If not that, then check
-	;; to see if this completion is a macro.  Special insertion
-	;; must be done for macros.
-	(if (or do-macros
-		(assoc completion makefile-macro-table))
-	    (let ((makefile-use-curly-braces-for-macros-p
-		   (or (eq paren ?{)
-		       makefile-use-curly-braces-for-macros-p)))
-	      (delete-backward-char 2)
-	      (makefile-do-macro-insertion completion)
-	      (delete-backward-char 1))
-
-	  ;; Just insert targets.
-	  (insert completion)))
-
-       ;; Can't complete any more, so make completion list.  FIXME
-       ;; this doesn't do the right thing when the completion is
-       ;; actually inserted.  I don't think there is an easy way to do
-       ;; that.
-       (t
-	(message "Making completion list...")
-	(let ((list (all-completions try table)))
-	  (with-output-to-temp-buffer "*Completions*"
-	    (display-completion-list list)))
-	(message "Making completion list...done"))))))
-
-
-
-;; Backslashification.  Stolen from cc-mode.el.
-
-(defun makefile-backslashify-current-line (doit)
-  (end-of-line)
-  (if doit
-      (if (not (save-excursion
-		 (forward-char -1)
-		 (eq (char-after (point)) ?\\ )))
-	  (progn
-	    (if (>= (current-column) makefile-backslash-column)
-		(insert " \\")
-	      (while (<= (current-column) makefile-backslash-column)
-		(insert "\t")
-		(end-of-line))
-	      (delete-char -1)
-	      (while (< (current-column) makefile-backslash-column)
-		(insert " ")
-		(end-of-line))
-	      (insert "\\"))))
-    (if (not (bolp))
-	(progn
-	  (forward-char -1)
-	  (if (eq (char-after (point)) ?\\ )
-	      (let ((saved (save-excursion
-			    (end-of-line)
-			    (point))))
-		(skip-chars-backward " \t")
-		(delete-region (point) saved)))))))
-
-(defun makefile-backslash-region (beg end arg)
-  "Insert backslashes at end of every line in region.
-Useful for defining multi-line rules.
-If called with a prefix argument, trailing backslashes are removed."
-  (interactive "r\nP")
-  (save-excursion
-    (let ((do-lastline-p (progn (goto-char end) (not (bolp)))))
-      (save-restriction
-	(narrow-to-region beg end)
-	(goto-char (point-min))
-	(while (not (save-excursion
-		      (forward-line 1)
-		      (eobp)))
-	  (makefile-backslashify-current-line (null arg))
-	  (forward-line 1)))
-      (and do-lastline-p
-	   (progn (goto-char end)
-		  (makefile-backslashify-current-line (null arg)))))))
-
-
-
-;;; ------------------------------------------------------------
-;;; Browser mode.
-;;; ------------------------------------------------------------
-
-(defun makefile-browser-format-target-line (target selected)
-  (format
-   (concat (make-string makefile-browser-leftmost-column ?\ )
-	   (if selected
-	       makefile-browser-selected-mark
-	     makefile-browser-unselected-mark)
-	   "%s%s")
-   target makefile-target-colon))
-
-(defun makefile-browser-format-macro-line (macro selected)
-  (format
-   (concat (make-string makefile-browser-leftmost-column ?\ )
-	   (if selected
-	       makefile-browser-selected-mark
-	     makefile-browser-unselected-mark)
-	   (makefile-format-macro-ref macro))))
-
-(defun makefile-browser-fill (targets macros)
-  (let ((inhibit-read-only t))
-    (goto-char (point-min))
-    (erase-buffer)
-    (mapconcat
-     (function
-      (lambda (item) (insert (makefile-browser-format-target-line (car item) nil) "\n")))
-     targets
-     "")
-    (mapconcat
-     (function
-      (lambda (item) (insert (makefile-browser-format-macro-line (car item) nil) "\n")))
-     macros
-     "")
-    (sort-lines nil (point-min) (point-max))
-    (goto-char (1- (point-max)))
-    (delete-char 1)			; remove unnecessary newline at eob
-    (goto-char (point-min))
-    (forward-char makefile-browser-cursor-column)))
-
-;;;
-;;; Moving up and down in the browser
-;;;
-
-(defun makefile-browser-next-line ()
-  "Move the browser selection cursor to the next line."
-  (interactive)
-  (if (not (makefile-last-line-p))
-      (progn
-	(forward-line 1)
-	(forward-char makefile-browser-cursor-column))))
-
-(defun makefile-browser-previous-line ()
-  "Move the browser selection cursor to the previous line."
-  (interactive)
-  (if (not (makefile-first-line-p))
-      (progn
-	(forward-line -1)
-	(forward-char makefile-browser-cursor-column))))
-
-;;;
-;;; Quitting the browser (returns to client buffer)
-;;;
-
-(defun makefile-browser-quit ()
-  "Leave the browser and return to the makefile buffer."
-  (interactive)
-  (let ((my-client makefile-browser-client))
-    (setq makefile-browser-client nil)	; we quitted, so NO client!
-    (set-buffer-modified-p nil)
-    (kill-buffer (current-buffer))
-    (pop-to-buffer my-client)))
-
-;;;
-;;; Toggle state of a browser item
-;;;
-
-(defun makefile-browser-toggle ()
-  "Toggle the selection state of the browser item at the cursor position."
-  (interactive)
-  (let ((this-line (count-lines (point-min) (point))))
-    (setq this-line (max 1 this-line))
-    (makefile-browser-toggle-state-for-line this-line)
-    (goto-line this-line)
-    (let ((inhibit-read-only t))
-      (beginning-of-line)
-      (if (makefile-browser-on-macro-line-p)
-	  (let ((macro-name (makefile-browser-this-line-macro-name)))
-	    (delete-region (point) (progn (end-of-line) (point)))
-	    (insert
-	     (makefile-browser-format-macro-line
-		macro-name
-		(makefile-browser-get-state-for-line this-line))))
-	(let ((target-name (makefile-browser-this-line-target-name)))
-	  (delete-region (point) (progn (end-of-line) (point)))
-	  (insert
-	   (makefile-browser-format-target-line
-	      target-name
-	      (makefile-browser-get-state-for-line this-line))))))
-    (beginning-of-line)
-    (forward-char makefile-browser-cursor-column)
-    (if makefile-browser-auto-advance-after-selection-p
-	(makefile-browser-next-line))))
-
-;;;
-;;; Making insertions into the client buffer
-;;;
-
-(defun makefile-browser-insert-continuation ()
-  "Insert a makefile continuation.
-In the makefile buffer, go to (end-of-line), insert a \'\\\'
-character, insert a new blank line, go to that line and indent by one TAB.
-This is most useful in the process of creating continued lines when copying
-large dependencies from the browser to the client buffer.
-\(point) advances accordingly in the client buffer."
-  (interactive)
-  (save-excursion
-    (set-buffer makefile-browser-client)
-    (end-of-line)
-    (insert "\\\n\t")))
-
-(defun makefile-browser-insert-selection ()
-  "Insert all selected targets and/or macros in the makefile buffer.
-Insertion takes place at point."
-  (interactive)
-  (save-excursion
-    (goto-line 1)
-    (let ((current-line 1))
-      (while (not (eobp))
-	(if (makefile-browser-get-state-for-line current-line)
-	    (makefile-browser-send-this-line-item))
-	(forward-line 1)
-	(setq current-line (1+ current-line))))))
-
-(defun makefile-browser-insert-selection-and-quit ()
-  (interactive)
-  (makefile-browser-insert-selection)
-  (makefile-browser-quit))
-
-(defun makefile-browser-send-this-line-item ()
-  (if (makefile-browser-on-macro-line-p)
-      (save-excursion
-	(let ((macro-name (makefile-browser-this-line-macro-name)))
-	  (set-buffer makefile-browser-client)
-	  (insert (makefile-format-macro-ref macro-name) " ")))
-    (save-excursion
-      (let ((target-name (makefile-browser-this-line-target-name)))
-	(set-buffer makefile-browser-client)
-	(insert target-name " ")))))
-
-(defun makefile-browser-start-interaction ()
-  (use-local-map makefile-browser-map)
-  (setq buffer-read-only t))
-
-(defun makefile-browse (targets macros)
-  (interactive)
-  (if (zerop (+ (length targets) (length macros)))
-      (progn
-	(beep)
-	(message "No macros or targets to browse! Consider running 'makefile-pickup-everything\'"))
-    (let ((browser-buffer (get-buffer-create makefile-browser-buffer-name)))
-	(pop-to-buffer browser-buffer)
-	(make-variable-buffer-local 'makefile-browser-selection-vector)
-	(makefile-browser-fill targets macros)
-	(shrink-window-if-larger-than-buffer)
-	(setq makefile-browser-selection-vector
-	      (make-vector (+ (length targets) (length macros)) nil))
-	(makefile-browser-start-interaction))))
-
-(defun makefile-switch-to-browser ()
-  (interactive)
-  (run-hooks 'makefile-browser-hook)
-  (setq makefile-browser-client (current-buffer))
-  (makefile-pickup-targets)
-  (makefile-pickup-macros)
-  (makefile-browse makefile-target-table makefile-macro-table))
-
-
-
-;;; ------------------------------------------------------------
-;;; Up-to-date overview buffer
-;;; ------------------------------------------------------------
-
-(defun makefile-create-up-to-date-overview ()
-  "Create a buffer containing an overview of the state of all known targets.
-Known targets are targets that are explicitly defined in that makefile;
-in other words, all targets that appear on the left hand side of a
-dependency in the makefile."
-  (interactive)
-  (if (y-or-n-p "Are you sure that the makefile being edited is consistent? ")
-      ;;
-      ;; The rest of this function operates on a temporary makefile, created by
-      ;; writing the current contents of the makefile buffer.
-      ;;
-      (let ((saved-target-table makefile-target-table)
-	    (this-buffer (current-buffer))
-	    (makefile-up-to-date-buffer
-	     (get-buffer-create makefile-up-to-date-buffer-name))
-	    (filename (makefile-save-temporary))
-	    ;;
-	    ;; Forget the target table because it may contain picked-up filenames
-	    ;; that are not really targets in the current makefile.
-	    ;; We don't want to query these, so get a new target-table with just the
-	    ;; targets that can be found in the makefile buffer.
-	    ;; The 'old' target table will be restored later.
-	    ;;
-	    (real-targets (progn
-			    (makefile-pickup-targets)
-			    makefile-target-table))
-	    (prereqs makefile-has-prereqs)
-	    )
-
-	(set-buffer makefile-up-to-date-buffer)
-	(setq buffer-read-only nil)
-	(erase-buffer)
-	(makefile-query-targets filename real-targets prereqs)
-	(if (zerop (buffer-size))		; if it did not get us anything
-	    (progn
-	      (kill-buffer (current-buffer))
-	      (message "No overview created!")))
-	(set-buffer this-buffer)
-	(setq makefile-target-table saved-target-table)
-	(if (get-buffer makefile-up-to-date-buffer-name)
-	    (progn
-	      (pop-to-buffer (get-buffer makefile-up-to-date-buffer-name))
-	      (shrink-window-if-larger-than-buffer)
-	      (sort-lines nil (point-min) (point-max))
-	      (setq buffer-read-only t))))))
-
-(defun makefile-save-temporary ()
-  "Create a temporary file from the current makefile buffer."
-  (let ((filename (makefile-generate-temporary-filename)))
-    (write-region (point-min) (point-max) filename nil 0)
-    filename))				; return the filename
-
-(defun makefile-generate-temporary-filename ()
-  "Create a filename suitable for use in `makefile-save-temporary'.
-Be careful to allow brain-dead file systems (DOS, SYSV ...) to cope
-with the generated name!"
-  (let ((my-name (user-login-name))
-	(my-uid (int-to-string (user-uid))))
-    (concat "mktmp"
-	  (if (> (length my-name) 3)
-	      (substring my-name 0 3)
-	    my-name)
-	  "."
-	  (if (> (length my-uid) 3)
-	      (substring my-uid 0 3)
-	    my-uid))))
-
-(defun makefile-query-targets (filename target-table prereq-list)
-  "Fill the up-to-date overview buffer.
-Checks each target in TARGET-TABLE using `makefile-query-one-target-method'
-and generates the overview, one line per target name."
-  (insert
-   (mapconcat
-    (function (lambda (item)
-		(let* ((target-name (car item))
-		       (no-prereqs (not (member target-name prereq-list)))
-		       (needs-rebuild (or no-prereqs 
-					  (funcall
-					   makefile-query-one-target-method
-					   target-name
-					   filename))))
-		  (format "\t%s%s"
-			  target-name
-			  (cond (no-prereqs "  .. has no prerequisites")
-				(needs-rebuild "  .. NEEDS REBUILD")
-				(t "  .. is up to date"))))
-		))
-    target-table "\n"))
-  (goto-char (point-min))
-  (delete-file filename))		; remove the tmpfile
-
-(defun makefile-query-by-make-minus-q (target &optional filename)
-  (not (zerop
-	(call-process makefile-brave-make nil nil nil
-		      "-f" filename "-q" target))))
-
-
-
-;;; ------------------------------------------------------------
-;;; Continuation cleanup
-;;; ------------------------------------------------------------
-
-(defun makefile-cleanup-continuations ()
-  (if (eq major-mode 'makefile-mode)
-      (if (and makefile-cleanup-continuations-p
-	       (not buffer-read-only))
-	  (save-excursion
-	    (goto-char (point-min))
-	    (while (re-search-forward "\\\\[ \t]+$" (point-max) t)
-	      (replace-match "\\" t t))))))
-
-
-;;; ------------------------------------------------------------
-;;; Warn of suspicious lines
-;;; ------------------------------------------------------------
-
-(defun makefile-warn-suspicious-lines ()
-  (let ((dont-save nil))
-    (if (eq major-mode 'makefile-mode)
-	(let ((suspicious
-	       (save-excursion
-		 (goto-char (point-min))
-		 (re-search-forward
-		  "\\(^[\t]+$\\)\\|\\(^[ ]+[\t]\\)" (point-max) t))))
-	  (if suspicious
-	      (let ((line-nr (count-lines (point-min) suspicious)))
-		(setq dont-save
-		      (not (y-or-n-p
-			    (format "Suspicious line %d. Save anyway "
-				    line-nr))))))))
-    dont-save))
-	  
-
-
-;;; ------------------------------------------------------------
-;;; GNU make function support
-;;; ------------------------------------------------------------
-
-(defun makefile-insert-gmake-function ()
-  "Insert a GNU make function call.
-Asks for the name of the function to use (with completion).
-Then prompts for all required parameters."
-  (interactive)
-  (let* ((gm-function-name (completing-read
-			     "Function: "
-			     makefile-gnumake-functions-alist
-			     nil t nil))
-	 (gm-function-prompts
-	  (cdr (assoc gm-function-name makefile-gnumake-functions-alist))))
-    (if (not (zerop (length gm-function-name)))
-	(insert (makefile-format-macro-ref
-		 (concat gm-function-name " "
-			 (makefile-prompt-for-gmake-funargs
-			    gm-function-name gm-function-prompts)))
-		" "))))
-
-(defun makefile-prompt-for-gmake-funargs (function-name prompt-list)
-  (mapconcat
-   (function (lambda (one-prompt)
-	       (read-string (format "[%s] %s: " function-name one-prompt)
-			    nil)))
-   prompt-list
-   ","))
-
-
-
-;;; ------------------------------------------------------------
-;;; Utility functions
-;;; ------------------------------------------------------------
-
-(defun makefile-do-macro-insertion (macro-name)
-  "Insert a macro reference."
-  (if (not (zerop (length macro-name)))
-      (if (assoc macro-name makefile-runtime-macros-list)
-	  (insert "$" macro-name)
-	(insert (makefile-format-macro-ref macro-name)))))
-
-(defun makefile-remember-target (target-name &optional has-prereqs)
-  "Remember a given target if it is not already remembered for this buffer."
-  (if (not (zerop (length target-name)))
-      (progn
-      (if (not (assoc target-name makefile-target-table))
-	  (setq makefile-target-table
-		(cons (list target-name) makefile-target-table)))
-      (if has-prereqs
-	  (setq makefile-has-prereqs
-		(cons target-name makefile-has-prereqs))))))
-
-(defun makefile-remember-macro (macro-name)
-  "Remember a given macro if it is not already remembered for this buffer."
-  (if (not (zerop (length macro-name)))
-      (if (not (assoc macro-name makefile-macro-table))
-	  (setq makefile-macro-table
-		(cons (list macro-name) makefile-macro-table)))))
-
-(defun makefile-forward-after-target-colon ()
-  "Move point forward after inserting the terminating colon of a target.
-This acts according to the value of `makefile-tab-after-target-colon'."
-  (if makefile-tab-after-target-colon
-      (insert "\t")
-    (insert " ")))
-
-(defun makefile-browser-on-macro-line-p ()
-  "Determine if point is on a macro line in the browser."
-  (save-excursion
-    (beginning-of-line)
-    (re-search-forward "\\$[{(]" (makefile-end-of-line-point) t)))
-
-(defun makefile-browser-this-line-target-name ()
-  "Extract the target name from a line in the browser."
-  (save-excursion
-    (end-of-line)
-    (skip-chars-backward "^ \t")
-    (buffer-substring (point) (1- (makefile-end-of-line-point)))))
-
-(defun makefile-browser-this-line-macro-name ()
-  "Extract the macro name from a line in the browser."
-  (save-excursion
-    (beginning-of-line)
-    (re-search-forward "\\$[{(]" (makefile-end-of-line-point) t)
-    (let ((macro-start (point)))
-      (skip-chars-forward "^})")
-      (buffer-substring macro-start (point)))))
-
-(defun makefile-format-macro-ref (macro-name)
-  "Format a macro reference.
-Uses `makefile-use-curly-braces-for-macros-p'."
-  (if (or (char-equal ?\( (string-to-char macro-name))
-	  (char-equal ?\{ (string-to-char macro-name)))
-      (format "$%s" macro-name)
-    (if makefile-use-curly-braces-for-macros-p
-	(format "${%s}" macro-name)
-      (format "$(%s)" macro-name))))
-
-(defun makefile-browser-get-state-for-line (n)
-  (aref makefile-browser-selection-vector (1- n)))
-
-(defun makefile-browser-set-state-for-line (n to-state)
-  (aset makefile-browser-selection-vector (1- n) to-state))
-
-(defun makefile-browser-toggle-state-for-line (n)
-  (makefile-browser-set-state-for-line n (not (makefile-browser-get-state-for-line n))))
-
-(defun makefile-beginning-of-line-point ()
-  (save-excursion
-    (beginning-of-line)
-    (point)))
-
-(defun makefile-end-of-line-point ()
-  (save-excursion
-    (end-of-line)
-    (point)))
-
-(defun makefile-last-line-p ()
-  (= (makefile-end-of-line-point) (point-max)))
-
-(defun makefile-first-line-p ()
-  (= (makefile-beginning-of-line-point) (point-min)))
-
-
-
-;;; Support for other packages, like add-log and imenu.
-
-(defun makefile-add-log-defun ()
-  "Return name of target or variable assignment that point is in.
-If it isn't in one, return nil."
-  (save-excursion
-    (let (found)
-      (beginning-of-line)
-      ;; Scan back line by line, noticing when we come to a
-      ;; variable or rule definition, and giving up when we see
-      ;; a line that is not part of either of those.
-      (while (not found)
-	(cond
-	 ((looking-at makefile-macroassign-regex)
-	  (setq found (buffer-substring-no-properties (match-beginning 1)
-							(match-end 1))))
-	 ((looking-at makefile-dependency-regex)
-	  (setq found (buffer-substring-no-properties (match-beginning 1)
-						      (match-end 1))))
-	 ;; Don't keep looking across a blank line or comment.  Give up.
-	 ((looking-at "$\\|#")
-	  (setq found 'bobp))
-	 ((bobp)
-	  (setq found 'bobp)))
-	(or found
-	    (forward-line -1)))
-      (if (stringp found) found))))
-
-;; FIXME it might be nice to have them separated by macro vs target.
-(defun makefile-menu-index-function ()
-  ;; "Generate alist of indices for imenu."
-  (let (alist
-	stupid
-	(re (concat makefile-dependency-regex
-		    "\\|"
-		    makefile-macroassign-regex)))
-    (imenu-progress-message stupid 0)
-    (goto-char (point-min))
-    (while (re-search-forward re nil t)
-      (imenu-progress-message stupid)
-      (let ((n (if (match-beginning 1) 1 5)))
-	(setq alist (cons
-		     (cons (buffer-substring (match-beginning n)
-					     (match-end n))
-			   (match-beginning n))
-		     alist))))
-    (imenu-progress-message stupid 100)
-    (nreverse alist)))
-
-(defun makefile-define-space-face ()
-  (make-face 'makefile-space-face)
-  (or (not (eq window-system 'x))
-      (face-differs-from-default-p 'makefile-space-face)
-      (let* ((params (frame-parameters))
-	     (light-bg (cdr (assq 'background-mode params)))
-	     (bg-color (cond ((eq (cdr (assq 'display-type params)) 'mono)
-			      (if light-bg "black" "white"))
-			     ((eq (cdr (assq 'display-type params)) 'grayscale)
-			      (if light-bg "black" "white"))
-			     (light-bg	; Light color background.
-			      "hotpink")
-			     (t		; Dark color background.
-			      "hotpink"))))
-	(set-face-background 'makefile-space-face bg-color))))
-
-;;; make-mode.el ends here
diff --git a/lisp/progmodes/modula2.el b/lisp/progmodes/modula2.el
deleted file mode 100644
index 12c6befae9d..00000000000
--- a/lisp/progmodes/modula2.el
+++ /dev/null
@@ -1,454 +0,0 @@
-;;; modula2.el --- Modula-2 editing support package
-
-;; Author: Michael Schmidt <michael@pbinfo.UUCP> 
-;;	Tom Perrine <Perrin@LOGICON.ARPA>
-;; Keywords: languages
-
-;; The authors distributed this without a copyright notice
-;; back in 1988, so it is in the public domain.  The original included
-;; the following credit:
-
-;; Author Mick Jordan
-;; amended Peter Robinson
-
-;;; Commentary:
-
-;; A major mode for editing Modula-2 code.  It provides convenient abbrevs
-;; for Modula-2 keywords, knows about the standard layout rules, and supports
-;; a native compile command.
-
-;;; Code:
-
-;;; Added by Tom Perrine (TEP)
-(defvar m2-mode-syntax-table nil
-  "Syntax table in use in Modula-2 buffers.")
-
-(defvar m2-compile-command "m2c"
-  "Command to compile Modula-2 programs")
-
-(defvar m2-link-command "m2l"
-  "Command to link Modula-2 programs")
-
-(defvar m2-link-name nil
-  "Name of the executable.")
-
-
-(if m2-mode-syntax-table
-    ()
-  (let ((table (make-syntax-table)))
-    (modify-syntax-entry ?\\ "\\" table)
-    (modify-syntax-entry ?\( ". 1" table)
-    (modify-syntax-entry ?\) ". 4" table)
-    (modify-syntax-entry ?* ". 23" table)
-    (modify-syntax-entry ?+ "." table)
-    (modify-syntax-entry ?- "." table)
-    (modify-syntax-entry ?= "." table)
-    (modify-syntax-entry ?% "." table)
-    (modify-syntax-entry ?< "." table)
-    (modify-syntax-entry ?> "." table)
-    (modify-syntax-entry ?\' "\"" table)
-    (setq m2-mode-syntax-table table)))
-
-;;; Added by TEP
-(defvar m2-mode-map nil
-  "Keymap used in Modula-2 mode.")
-
-(if m2-mode-map ()
-  (let ((map (make-sparse-keymap)))
-    (define-key map "\^i" 'm2-tab)
-    (define-key map "\C-cb" 'm2-begin)
-    (define-key map "\C-cc" 'm2-case)
-    (define-key map "\C-cd" 'm2-definition)
-    (define-key map "\C-ce" 'm2-else)
-    (define-key map "\C-cf" 'm2-for)
-    (define-key map "\C-ch" 'm2-header)
-    (define-key map "\C-ci" 'm2-if)
-    (define-key map "\C-cm" 'm2-module)
-    (define-key map "\C-cl" 'm2-loop)
-    (define-key map "\C-co" 'm2-or)
-    (define-key map "\C-cp" 'm2-procedure)
-    (define-key map "\C-c\C-w" 'm2-with)
-    (define-key map "\C-cr" 'm2-record)
-    (define-key map "\C-cs" 'm2-stdio)
-    (define-key map "\C-ct" 'm2-type)
-    (define-key map "\C-cu" 'm2-until)
-    (define-key map "\C-cv" 'm2-var)
-    (define-key map "\C-cw" 'm2-while)
-    (define-key map "\C-cx" 'm2-export)
-    (define-key map "\C-cy" 'm2-import)
-    (define-key map "\C-c{" 'm2-begin-comment)
-    (define-key map "\C-c}" 'm2-end-comment)
-    (define-key map "\C-j"  'm2-newline)
-    (define-key map "\C-c\C-z" 'suspend-emacs)
-    (define-key map "\C-c\C-v" 'm2-visit)
-    (define-key map "\C-c\C-t" 'm2-toggle)
-    (define-key map "\C-c\C-l" 'm2-link)
-    (define-key map "\C-c\C-c" 'm2-compile)
-    (setq m2-mode-map map)))
-
-(defvar m2-indent 5 "*This variable gives the indentation in Modula-2-Mode")
-  
-;;;###autoload
-(defun modula-2-mode ()
-  "This is a mode intended to support program development in Modula-2.
-All control constructs of Modula-2 can be reached by typing C-c
-followed by the first character of the construct.
-\\<m2-mode-map>
-  \\[m2-begin] begin         \\[m2-case] case
-  \\[m2-definition] definition    \\[m2-else] else
-  \\[m2-for] for           \\[m2-header] header
-  \\[m2-if] if            \\[m2-module] module
-  \\[m2-loop] loop          \\[m2-or] or
-  \\[m2-procedure] procedure     Control-c Control-w with
-  \\[m2-record] record        \\[m2-stdio] stdio
-  \\[m2-type] type          \\[m2-until] until
-  \\[m2-var] var           \\[m2-while] while
-  \\[m2-export] export        \\[m2-import] import
-  \\[m2-begin-comment] begin-comment \\[m2-end-comment] end-comment
-  \\[suspend-emacs] suspend Emacs     \\[m2-toggle] toggle
-  \\[m2-compile] compile           \\[m2-next-error] next-error
-  \\[m2-link] link
-
-   `m2-indent' controls the number of spaces for each indentation.
-   `m2-compile-command' holds the command to compile a Modula-2 program.
-   `m2-link-command' holds the command to link a Modula-2 program."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map m2-mode-map)
-  (setq major-mode 'modula-2-mode)
-  (setq mode-name "Modula-2")
-  (make-local-variable 'comment-column)
-  (setq comment-column 41)
-  (make-local-variable 'end-comment-column)
-  (setq end-comment-column 75)
-  (set-syntax-table m2-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-;  (make-local-variable 'indent-line-function)
-;  (setq indent-line-function 'c-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "(* ")
-  (make-local-variable 'comment-end)
-  (setq comment-end " *)")
-  (make-local-variable 'comment-column)
-  (setq comment-column 41)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "/\\*+ *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'c-comment-indent)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (run-hooks 'm2-mode-hook))
-
-(defun m2-newline ()
-  "Insert a newline and indent following line like previous line."
-  (interactive)
-  (let ((hpos (current-indentation)))
-    (newline)
-    (indent-to hpos)))
-
-(defun m2-tab ()
-  "Indent to next tab stop."
-  (interactive)
-  (indent-to (* (1+ (/ (current-indentation) m2-indent)) m2-indent)))
-
-(defun m2-begin ()
-  "Insert a BEGIN keyword and indent for the next line."
-  (interactive)
-  (insert "BEGIN")
-  (m2-newline)
-  (m2-tab))
-
-(defun m2-case ()
-  "Build skeleton CASE statement, prompting for the <expression>."
-  (interactive)
-  (let ((name (read-string "Case-Expression: ")))
-    (insert "CASE " name " OF")
-    (m2-newline)
-    (m2-newline)
-    (insert "END (* case " name " *);"))
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-definition ()
-  "Build skeleton DEFINITION MODULE, prompting for the <module name>."
-  (interactive)
-  (insert "DEFINITION MODULE ")
-  (let ((name (read-string "Name: ")))
-    (insert name ";\n\n\n\nEND " name ".\n"))
-  (previous-line 3))
-
-(defun m2-else ()
-  "Insert ELSE keyword and indent for next line."
-  (interactive)
-  (m2-newline)
-  (backward-delete-char-untabify m2-indent ())
-  (insert "ELSE")
-  (m2-newline)
-  (m2-tab))
-
-(defun m2-for ()
-  "Build skeleton FOR loop statement, prompting for the loop parameters."
-  (interactive)
-  (insert "FOR ")
-  (let ((name (read-string "Loop Initialiser: ")) limit by)
-    (insert name " TO ")
-    (setq limit (read-string "Limit: "))
-    (insert limit)
-    (setq by (read-string "Step: "))
-    (if (not (string-equal by ""))
-	(insert " BY " by))
-    (insert " DO")
-    (m2-newline)
-    (m2-newline)
-    (insert "END (* for " name " to " limit " *);"))
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-header ()
-  "Insert a comment block containing the module title, author, etc."
-  (interactive)
-  (insert "(*\n    Title: \t")
-  (insert (read-string "Title: "))
-  (insert "\n    Created:\t")
-  (insert (current-time-string))
-  (insert "\n    Author: \t")
-  (insert (user-full-name))
-  (insert (concat "\n\t\t<" (user-login-name) "@" (system-name) ">\n"))
-  (insert "*)\n\n"))
-
-(defun m2-if ()
-  "Insert skeleton IF statement, prompting for <boolean-expression>."
-  (interactive)
-  (insert "IF ")
-  (let ((thecondition (read-string "<boolean-expression>: ")))
-    (insert thecondition " THEN")
-    (m2-newline)
-    (m2-newline)
-    (insert "END (* if " thecondition " *);"))
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-loop ()
-  "Build skeleton LOOP (with END)."
-  (interactive)
-  (insert "LOOP")
-  (m2-newline)
-  (m2-newline)
-  (insert "END (* loop *);")
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-module ()
-  "Build skeleton IMPLEMENTATION MODULE, prompting for <module-name>."
-  (interactive)
-  (insert "IMPLEMENTATION MODULE ")
-  (let ((name (read-string "Name: ")))
-    (insert name ";\n\n\n\nEND " name ".\n")
-    (previous-line 3)
-    (m2-header)
-    (m2-type)
-    (newline)
-    (m2-var)
-    (newline)
-    (m2-begin)
-    (m2-begin-comment)
-    (insert " Module " name " Initialisation Code "))
-  (m2-end-comment)
-  (newline)
-  (m2-tab))
-
-(defun m2-or ()
-  (interactive)
-  (m2-newline)
-  (backward-delete-char-untabify m2-indent)
-  (insert "|")
-  (m2-newline)
-  (m2-tab))
-
-(defun m2-procedure ()
-  (interactive)
-  (insert "PROCEDURE ")
-  (let ((name (read-string "Name: " ))
-	args)
-    (insert name " (")
-    (insert (read-string "Arguments: ") ")")
-    (setq args (read-string "Result Type: "))
-    (if (not (string-equal args ""))
-	(insert " : " args))
-    (insert ";")
-    (m2-newline)
-    (insert "BEGIN")
-    (m2-newline)
-    (m2-newline)
-    (insert "END ")
-    (insert name)
-    (insert ";")
-    (end-of-line 0)
-    (m2-tab)))
-
-(defun m2-with ()
-  (interactive)
-  (insert "WITH ")
-  (let ((name (read-string "Record-Type: ")))
-    (insert name)
-    (insert " DO")
-    (m2-newline)
-    (m2-newline)
-    (insert "END (* with " name " *);"))
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-record ()
-  (interactive)
-  (insert "RECORD")
-  (m2-newline)
-  (m2-newline)
-  (insert "END (* record *);")
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-stdio ()
-  (interactive)
-  (insert "
-FROM TextIO IMPORT 
-   WriteCHAR, ReadCHAR, WriteINTEGER, ReadINTEGER,
-   WriteCARDINAL, ReadCARDINAL, WriteBOOLEAN, ReadBOOLEAN,
-   WriteREAL, ReadREAL, WriteBITSET, ReadBITSET,
-   WriteBasedCARDINAL, ReadBasedCARDINAL, WriteChars, ReadChars,
-   WriteString, ReadString, WhiteSpace, EndOfLine;
-
-FROM SysStreams IMPORT sysIn, sysOut, sysErr;
-
-"))
-
-(defun m2-type ()
-  (interactive)
-  (insert "TYPE")
-  (m2-newline)
-  (m2-tab))
-
-(defun m2-until ()
-  (interactive)
-  (insert "REPEAT")
-  (m2-newline)
-  (m2-newline)
-  (insert "UNTIL ")
-  (insert (read-string "<boolean-expression>: ") ";")
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-var ()
-  (interactive)
-  (m2-newline)
-  (insert "VAR")
-  (m2-newline)
-  (m2-tab))
-
-(defun m2-while ()
-  (interactive)
-  (insert "WHILE ")
-  (let ((name (read-string "<boolean-expression>: ")))
-    (insert name " DO" )
-    (m2-newline)
-    (m2-newline)
-    (insert "END (* while " name " *);"))
-  (end-of-line 0)
-  (m2-tab))
-
-(defun m2-export ()
-  (interactive)
-  (insert "EXPORT QUALIFIED "))
-
-(defun m2-import ()
-  (interactive)
-  (insert "FROM ")
-  (insert (read-string "Module: "))
-  (insert " IMPORT "))
-
-(defun m2-begin-comment ()
-  (interactive)
-  (if (not (bolp))
-      (indent-to comment-column 0))
-  (insert "(*  "))
-
-(defun m2-end-comment ()
-  (interactive)
-  (if (not (bolp))
-      (indent-to end-comment-column))
-  (insert "*)"))
-
-(defun m2-compile ()
-  (interactive)
-  (setq modulename (buffer-name))
-  (compile (concat m2-compile-command " " modulename)))
-
-(defun m2-link ()
-  (interactive)
-  (setq modulename (buffer-name))
-  (if m2-link-name
-      (compile (concat m2-link-command " " m2-link-name))
-    (compile (concat m2-link-command " "
-		     (setq m2-link-name (read-string "Name of executable: "
-						     modulename))))))
-
-(defun m2-execute-monitor-command (command)
-  (let* ((shell shell-file-name)
-	 (csh (equal (file-name-nondirectory shell) "csh")))
-    (call-process shell nil t t "-cf" (concat "exec " command))))
-
-(defun m2-visit ()
-  (interactive)
-  (let ((deffile nil)
-	(modfile nil)
-	modulename)
-    (save-excursion
-      (setq modulename
-	    (read-string "Module name: "))
-      (switch-to-buffer "*Command Execution*")
-      (m2-execute-monitor-command (concat "m2whereis " modulename))
-      (goto-char (point-min))
-      (condition-case ()
-	  (progn (re-search-forward "\\(.*\\.def\\) *$")
-		 (setq deffile (buffer-substring (match-beginning 1)
-						 (match-end 1))))
-	(search-failed ()))
-      (condition-case ()
-	  (progn (re-search-forward "\\(.*\\.mod\\) *$")
-		 (setq modfile (buffer-substring (match-beginning 1)
-						 (match-end 1))))
-	(search-failed ()))
-      (if (not (or deffile modfile))
-	  (error "I can find neither definition nor implementation of %s"
-		 modulename)))
-    (cond (deffile
-	    (find-file deffile)
-	    (if modfile
-		(save-excursion
-		  (find-file modfile))))
-	  (modfile
-	   (find-file modfile)))))
-
-(defun m2-toggle ()
-  "Toggle between .mod and .def files for the module."
-  (interactive)
-  (cond ((string-equal (substring (buffer-name) -4) ".def")
-	 (find-file-other-window
-	  (concat (substring (buffer-name) 0 -4) ".mod")))
-	((string-equal (substring (buffer-name) -4) ".mod")
-	 (find-file-other-window
-	  (concat (substring (buffer-name) 0 -4)  ".def")))
-	((string-equal (substring (buffer-name) -3) ".mi")
-	 (find-file-other-window
-	  (concat (substring (buffer-name) 0 -3)  ".md")))
-	((string-equal (substring (buffer-name) -3) ".md")
-	 (find-file-other-window
-	  (concat (substring (buffer-name) 0 -3)  ".mi")))))
-
-;;; modula2.el ends here
diff --git a/lisp/progmodes/pascal.el b/lisp/progmodes/pascal.el
deleted file mode 100644
index 1055e692689..00000000000
--- a/lisp/progmodes/pascal.el
+++ /dev/null
@@ -1,1560 +0,0 @@
-;;; pascal.el --- major mode for editing pascal source in Emacs
-
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Espen Skoglund (espensk@stud.cs.uit.no)
-;; Keywords: languages
-
-;; 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:
-
-;; USAGE
-;; =====
-
-;; Emacs should enter Pascal mode when you find a Pascal source file.
-;; When you have entered Pascal mode, you may get more info by pressing
-;; C-h m. You may also get online help describing various functions by:
-;; C-h f <Name of function you want described>
-
-;; If you want to customize Pascal mode to fit you better, you may add
-;; these lines (the values of the variables presented here are the defaults):
-;;
-;; ;; User customization for Pascal mode
-;; (setq pascal-indent-level       3
-;;       pascal-case-indent        2
-;;       pascal-auto-newline       nil
-;;       pascal-tab-always-indent  t
-;;       pascal-auto-endcomments   t
-;;       pascal-auto-lineup        '(all)
-;;       pascal-toggle-completions nil
-;;       pascal-type-keywords      '("array" "file" "packed" "char" 
-;; 				      "integer" "real" "string" "record")
-;;       pascal-start-keywords     '("begin" "end" "function" "procedure"
-;; 				      "repeat" "until" "while" "read" "readln"
-;; 				      "reset" "rewrite" "write" "writeln")
-;;       pascal-separator-keywords '("downto" "else" "mod" "div" "then"))
-
-;; KNOWN BUGS / BUGREPORTS
-;; =======================
-;; As far as I know, there are no bugs in the current version of this
-;; package.  This may not be true however, since I never use this mode
-;; myself and therefore would never notice them anyway.   If you do
-;; find any bugs, you may submit them to: espensk@stud.cs.uit.no
-;; as well as to bug-gnu-emacs@prep.ai.mit.edu.
-
-;;; Code:
-
-(defvar pascal-mode-abbrev-table nil
-  "Abbrev table in use in Pascal-mode buffers.")
-(define-abbrev-table 'pascal-mode-abbrev-table ())
-
-(defvar pascal-mode-map ()
-  "Keymap used in Pascal mode.")
-(if pascal-mode-map
-    ()
-  (setq pascal-mode-map (make-sparse-keymap))
-  (define-key pascal-mode-map ";"        'electric-pascal-semi-or-dot)
-  (define-key pascal-mode-map "."        'electric-pascal-semi-or-dot)
-  (define-key pascal-mode-map ":"        'electric-pascal-colon)
-  (define-key pascal-mode-map "="        'electric-pascal-equal)
-  (define-key pascal-mode-map "#"        'electric-pascal-hash)
-  (define-key pascal-mode-map "\r"       'electric-pascal-terminate-line)
-  (define-key pascal-mode-map "\t"       'electric-pascal-tab)
-  (define-key pascal-mode-map "\M-\t"    'pascal-complete-word)
-  (define-key pascal-mode-map "\M-?"     'pascal-show-completions)
-  (define-key pascal-mode-map "\177"     'backward-delete-char-untabify)
-  (define-key pascal-mode-map "\M-\C-h"  'pascal-mark-defun)
-  (define-key pascal-mode-map "\C-c\C-b" 'pascal-insert-block)
-  (define-key pascal-mode-map "\M-*"     'pascal-star-comment)
-  (define-key pascal-mode-map "\C-c\C-c" 'pascal-comment-area)
-  (define-key pascal-mode-map "\C-c\C-u" 'pascal-uncomment-area)
-  (define-key pascal-mode-map "\M-\C-a"  'pascal-beg-of-defun)
-  (define-key pascal-mode-map "\M-\C-e"  'pascal-end-of-defun)
-  (define-key pascal-mode-map "\C-c\C-d" 'pascal-goto-defun)
-  (define-key pascal-mode-map "\C-c\C-o" 'pascal-outline)
-;;; A command to change the whole buffer won't be used terribly
-;;; often, so no need for a key binding.
-;  (define-key pascal-mode-map "\C-cd"    'pascal-downcase-keywords)
-;  (define-key pascal-mode-map "\C-cu"    'pascal-upcase-keywords)
-;  (define-key pascal-mode-map "\C-cc"    'pascal-capitalize-keywords)
-  )
-
-(defvar pascal-imenu-generic-expression
-  '("^[ \t]*\\(function\\|procedure\\)[ \t\n]+\\([a-zA-Z0-9_.:]+\\)" . (2))
-  "Imenu expression for Pascal-mode.  See `imenu-generic-expression'.")
-  
-(defvar pascal-keywords
-  '("and" "array" "begin" "case" "const" "div" "do" "downto" "else" "end" 
-    "file" "for" "function" "goto" "if" "in" "label" "mod" "nil" "not" "of" 
-    "or" "packed" "procedure" "program" "record" "repeat" "set" "then" "to" 
-    "type" "until" "var" "while" "with"
-    ;; The following are not standard in pascal, but widely used.
-    "get" "put" "input" "output" "read" "readln" "reset" "rewrite" "write"
-    "writeln"))
-
-;;;
-;;; Regular expressions used to calculate indent, etc.
-;;;
-(defconst pascal-symbol-re      "\\<[a-zA-Z_][a-zA-Z_0-9.]*\\>")
-(defconst pascal-beg-block-re   "\\<\\(begin\\|case\\|record\\|repeat\\)\\>")
-(defconst pascal-end-block-re   "\\<\\(end\\|until\\)\\>")
-(defconst pascal-declaration-re "\\<\\(const\\|label\\|type\\|var\\)\\>")
-(defconst pascal-defun-re       "\\<\\(function\\|procedure\\|program\\)\\>")
-(defconst pascal-sub-block-re   "\\<\\(if\\|else\\|for\\|while\\|with\\)\\>")
-(defconst pascal-noindent-re    "\\<\\(begin\\|end\\|until\\|else\\)\\>")
-(defconst pascal-nosemi-re      "\\<\\(begin\\|repeat\\|then\\|do\\|else\\)\\>")
-(defconst pascal-autoindent-lines-re
-  "\\<\\(label\\|var\\|type\\|const\\|until\\|end\\|begin\\|repeat\\|else\\)\\>")
-
-;;; Strings used to mark beginning and end of excluded text
-(defconst pascal-exclude-str-start "{-----\\/----- EXCLUDED -----\\/-----")
-(defconst pascal-exclude-str-end " -----/\\----- EXCLUDED -----/\\-----}")
-
-(defvar pascal-mode-syntax-table nil
-  "Syntax table in use in Pascal-mode buffers.")
-
-(if pascal-mode-syntax-table
-    ()
-  (setq pascal-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\\ "."   pascal-mode-syntax-table)
-  (modify-syntax-entry ?( "()1"  pascal-mode-syntax-table)  
-  (modify-syntax-entry ?) ")(4"  pascal-mode-syntax-table)
-  (modify-syntax-entry ?* ". 23" pascal-mode-syntax-table)
-  (modify-syntax-entry ?{ "<"    pascal-mode-syntax-table)
-  (modify-syntax-entry ?} ">"    pascal-mode-syntax-table)
-  (modify-syntax-entry ?+ "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?- "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?= "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?% "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?< "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?> "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?& "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?| "."    pascal-mode-syntax-table)
-  (modify-syntax-entry ?_ "w"    pascal-mode-syntax-table)
-  (modify-syntax-entry ?\' "\""  pascal-mode-syntax-table))
-
-(defvar pascal-font-lock-keywords
-  (list
-   '("^[ \t]*\\(function\\|pro\\(cedure\\|gram\\)\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-keyword-face) (3 font-lock-function-name-face nil t))
-;   ("type" "const" "real" "integer" "char" "boolean" "var"
-;    "record" "array" "file")
-   (cons (concat "\\<\\(array\\|boolean\\|c\\(har\\|onst\\)\\|file\\|"
-		 "integer\\|re\\(al\\|cord\\)\\|type\\|var\\)\\>")
-	 'font-lock-type-face)
-   '("\\<\\(label\\|external\\|forward\\)\\>" . font-lock-reference-face)
-   '("\\<\\([0-9]+\\)[ \t]*:" 1 font-lock-reference-face)
-;   ("of" "to" "for" "if" "then" "else" "case" "while"
-;    "do" "until" "and" "or" "not" "in" "with" "repeat" "begin" "end")
-   (concat "\\<\\("
-	   "and\\|begin\\|case\\|do\\|e\\(lse\\|nd\\)\\|for\\|i[fn]\\|"
-	   "not\\|o[fr]\\|repeat\\|t\\(hen\\|o\\)\\|until\\|w\\(hile\\|ith\\)"
-	   "\\)\\>")
-   '("\\<\\(goto\\)\\>[ \t]*\\([0-9]+\\)?"
-     (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)))
-  "Additional expressions to highlight in Pascal mode.")
-
-(defvar pascal-indent-level 3
-  "*Indentation of Pascal statements with respect to containing block.")
-
-(defvar pascal-case-indent 2
-  "*Indentation for case statements.")
-
-(defvar pascal-auto-newline nil
-  "*Non-nil means automatically newline after semicolons and the punctuation
-mark after an end.")
-
-(defvar pascal-tab-always-indent t
-  "*Non-nil means TAB in Pascal mode should always reindent the current line,
-regardless of where in the line point is when the TAB command is used.")
-
-(defvar pascal-auto-endcomments t
-  "*Non-nil means a comment { ... } is set after the ends which ends cases and
-functions. The name of the function or case will be set between the braces.")
-
-(defvar pascal-auto-lineup '(all)
-  "*List of contexts where auto lineup of :'s or ='s should be done.
-Elements can be of type: 'paramlist', 'declaration' or 'case', which will
-do auto lineup in parameterlist, declarations or case-statements
-respectively. The word 'all' will do all lineups. '(case paramlist) for
-instance will do lineup in case-statements and parameterlist, while '(all)
-will do all lineups.")
-
-(defvar pascal-toggle-completions nil
-  "*Non-nil means \\<pascal-mode-map>\\[pascal-complete-word] should try all possible completions one by one.
-Repeated use of \\[pascal-complete-word] will show you all of them.
-Normally, when there is more than one possible completion,
-it displays a list of all possible completions.")
-
-(defvar pascal-type-keywords
-  '("array" "file" "packed" "char" "integer" "real" "string" "record")
-  "*Keywords for types used when completing a word in a declaration or parmlist.
-\(eg. integer, real, char.)  The types defined within the Pascal program
-will be completed runtime, and should not be added to this list.")
-
-(defvar pascal-start-keywords
-  '("begin" "end" "function" "procedure" "repeat" "until" "while"
-    "read" "readln" "reset" "rewrite" "write" "writeln")
-  "*Keywords to complete when standing at the first word of a statement.
-\(eg. begin, repeat, until, readln.)
-The procedures and variables defined within the Pascal program
-will be completed runtime and should not be added to this list.")
-
-(defvar pascal-separator-keywords
-  '("downto" "else" "mod" "div" "then")
-  "*Keywords to complete when NOT standing at the first word of a statement.
-\(eg. downto, else, mod, then.) 
-Variables and function names defined within the
-Pascal program are completed runtime and should not be added to this list.")
-
-;;;
-;;;  Macros
-;;;
-
-(defsubst pascal-get-beg-of-line (&optional arg)
-  (save-excursion
-    (beginning-of-line arg)
-    (point)))
-
-(defsubst pascal-get-end-of-line (&optional arg)
-  (save-excursion
-    (end-of-line arg)
-    (point)))
-
-(defun pascal-declaration-end ()
-  (let ((nest 1))
-    (while (and (> nest 0)
-		(re-search-forward 
-		 "[:=]\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" 
-		 (save-excursion (end-of-line 2) (point)) t))
-      (cond ((match-beginning 1) (setq nest (1+ nest)))
-	    ((match-beginning 2) (setq nest (1- nest)))
-	    ((looking-at "[^(\n]+)") (setq nest 0))))))
-
-
-(defun pascal-declaration-beg ()
-  (let ((nest 1))
-    (while (and (> nest 0)
-		(re-search-backward "[:=]\\|\\<\\(type\\|var\\|label\\|const\\)\\>\\|\\(\\<record\\>\\)\\|\\(\\<end\\>\\)" (pascal-get-beg-of-line 0) t))
-      (cond ((match-beginning 1) (setq nest 0))
-	    ((match-beginning 2) (setq nest (1- nest)))
-	    ((match-beginning 3) (setq nest (1+ nest)))))
-    (= nest 0)))
-
-  
-(defsubst pascal-within-string ()
-  (save-excursion
-    (nth 3 (parse-partial-sexp (pascal-get-beg-of-line) (point)))))
-
-
-;;;###autoload
-(defun pascal-mode ()
-  "Major mode for editing Pascal code. \\<pascal-mode-map>
-TAB indents for Pascal code.  Delete converts tabs to spaces as it moves back.
-
-\\[pascal-complete-word] completes the word around current point with respect \
-to position in code
-\\[pascal-show-completions] shows all possible completions at this point.
-
-Other useful functions are:
-
-\\[pascal-mark-defun]\t- Mark function.
-\\[pascal-insert-block]\t- insert begin ... end;
-\\[pascal-star-comment]\t- insert (* ... *)
-\\[pascal-comment-area]\t- Put marked area in a comment, fixing nested comments.
-\\[pascal-uncomment-area]\t- Uncomment an area commented with \
-\\[pascal-comment-area].
-\\[pascal-beg-of-defun]\t- Move to beginning of current function.
-\\[pascal-end-of-defun]\t- Move to end of current function.
-\\[pascal-goto-defun]\t- Goto function prompted for in the minibuffer.
-\\[pascal-outline]\t- Enter pascal-outline-mode (see also pascal-outline).
-
-Variables controlling indentation/edit style:
-
- pascal-indent-level      (default 3)
-    Indentation of Pascal statements with respect to containing block.
- pascal-case-indent       (default 2)
-    Indentation for case statements.
- pascal-auto-newline      (default nil)
-    Non-nil means automatically newline after semicolons and the punctuation
-    mark after an end.
- pascal-tab-always-indent (default t)
-    Non-nil means TAB in Pascal mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- pascal-auto-endcomments  (default t)
-    Non-nil means a comment { ... } is set after the ends which ends cases and
-    functions. The name of the function or case will be set between the braces.
- pascal-auto-lineup       (default t)
-    List of contexts where auto lineup of :'s or ='s hould be done.
-
-See also the user variables pascal-type-keywords, pascal-start-keywords and
-pascal-separator-keywords.
-
-Turning on Pascal mode calls the value of the variable pascal-mode-hook with
-no args, if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map pascal-mode-map)
-  (setq major-mode 'pascal-mode)
-  (setq mode-name "Pascal")
-  (setq local-abbrev-table pascal-mode-abbrev-table)
-  (set-syntax-table pascal-mode-syntax-table)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'pascal-indent-line)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'pascal-indent-comment)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments nil)
-  (make-local-variable 'case-fold-search)
-  (setq case-fold-search t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "{")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "(\\*+ *\\|{ *")
-  (make-local-variable 'comment-end)
-  (setq comment-end "}")
-  ;; Font lock support
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(pascal-font-lock-keywords nil t))
-  ;; Imenu support
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression pascal-imenu-generic-expression)
-  (run-hooks 'pascal-mode-hook))
-
-
-
-;;;
-;;;  Electric functions
-;;;
-(defun electric-pascal-terminate-line ()
-  "Terminate line and indent next line."
-  (interactive)
-  ;; First, check if current line should be indented
-  (save-excursion
-    (beginning-of-line)
-    (skip-chars-forward " \t")
-    (if (looking-at pascal-autoindent-lines-re)
-	(pascal-indent-line)))
-  (delete-horizontal-space) ; Removes trailing whitespaces
-  (newline)
-  ;; Indent next line
-  (pascal-indent-line)
-  ;; Maybe we should set some endcomments
-  (if pascal-auto-endcomments
-      (pascal-set-auto-comments))
-  ;; Check if we shall indent inside comment
-  (let ((setstar nil))
-    (save-excursion
-      (forward-line -1)
-      (skip-chars-forward " \t")
-      (cond ((looking-at "\\*[ \t]+)")
-	     ;; Delete region between `*' and `)' if there is only whitespaces.
-	     (forward-char 1)
-	     (delete-horizontal-space))
-	    ((and (looking-at "(\\*\\|\\*[^)]")
-		  (not (save-excursion
-			 (search-forward "*)" (pascal-get-end-of-line) t))))
-	     (setq setstar t))))
-    ;; If last line was a star comment line then this one shall be too.
-    (if (null setstar)	
-	(pascal-indent-line)
-      (insert "*  "))))
-
-
-(defun electric-pascal-semi-or-dot ()
-  "Insert `;' or `.' character and reindent the line."
-  (interactive)
-  (insert last-command-char)
-  (save-excursion
-    (beginning-of-line)
-    (pascal-indent-line))
-  (if pascal-auto-newline
-      (electric-pascal-terminate-line)))
-
-(defun electric-pascal-colon ()
-  "Insert `:' and do all indentions except line indent on this line."
-  (interactive)
-  (insert last-command-char)
-  ;; Do nothing if within string.
-  (if (pascal-within-string)
-      ()
-    (save-excursion
-      (beginning-of-line)
-      (pascal-indent-line))
-    (let ((pascal-tab-always-indent nil))
-      (pascal-indent-command))))
-
-(defun electric-pascal-equal ()
-  "Insert `=', and do indention if within type declaration."
-  (interactive)
-  (insert last-command-char)
-  (if (eq (car (pascal-calculate-indent)) 'declaration)
-      (let ((pascal-tab-always-indent nil))
-	(pascal-indent-command))))
-
-(defun electric-pascal-hash ()
-  "Insert `#', and indent to column 0 if this is a CPP directive."
-  (interactive)
-  (insert last-command-char)
-  (if (save-excursion (beginning-of-line) (looking-at "^[ \t]*#"))
-      (save-excursion (beginning-of-line)
-		      (delete-horizontal-space))))
-
-(defun electric-pascal-tab ()
-  "Function called when TAB is pressed in Pascal mode."
-  (interactive)
-  ;; Do nothing if within a string or in a CPP directive.
-  (if (or (pascal-within-string)
-	  (and (not (bolp))
-	       (save-excursion (beginning-of-line) (eq (following-char) ?#))))
-      (insert "\t")
-    ;; If pascal-tab-always-indent, indent the beginning of the line.
-    (if pascal-tab-always-indent
-	(save-excursion
-	  (beginning-of-line)
-	  (pascal-indent-line))
-      (if (save-excursion
-	    (skip-chars-backward " \t")
-	    (bolp))
-	  (pascal-indent-line)
-	(insert "\t")))
-    (pascal-indent-command)))
-
-
-
-;;;
-;;; Interactive functions
-;;;
-(defun pascal-insert-block ()
-  "Insert Pascal begin ... end; block in the code with right indentation."
-  (interactive)
-  (pascal-indent-line)
-  (insert "begin")
-  (electric-pascal-terminate-line)
-  (save-excursion
-    (electric-pascal-terminate-line)
-    (insert "end;")
-    (beginning-of-line)
-    (pascal-indent-line)))
-
-(defun pascal-star-comment ()
-  "Insert Pascal star comment at point."
-  (interactive)
-  (pascal-indent-line)
-  (insert "(*")
-  (electric-pascal-terminate-line)
-  (save-excursion
-    (electric-pascal-terminate-line)
-    (delete-horizontal-space)
-    (insert ")"))
-  (insert "  "))
-
-(defun pascal-mark-defun ()
-  "Mark the current pascal function (or procedure).
-This puts the mark at the end, and point at the beginning."
-  (interactive)
-  (push-mark (point))
-  (pascal-end-of-defun)
-  (push-mark (point))
-  (pascal-beg-of-defun)
-  (if (fboundp 'zmacs-activate-region)
-      (zmacs-activate-region)))
-
-(defun pascal-comment-area (start end)
-  "Put the region into a Pascal comment.
-The comments that are in this area are \"deformed\":
-`*)' becomes `!(*' and `}' becomes `!{'.
-These deformed comments are returned to normal if you use
-\\[pascal-uncomment-area] to undo the commenting.
-
-The commented area starts with `pascal-exclude-str-start', and ends with
-`pascal-include-str-end'.  But if you change these variables,
-\\[pascal-uncomment-area] won't recognize the comments."
-  (interactive "r")
-  (save-excursion
-    ;; Insert start and endcomments
-    (goto-char end)
-    (if (and (save-excursion (skip-chars-forward " \t") (eolp))
-	     (not (save-excursion (skip-chars-backward " \t") (bolp))))
-	(forward-line 1)
-      (beginning-of-line))
-    (insert pascal-exclude-str-end)
-    (setq end (point))
-    (newline)
-    (goto-char start)
-    (beginning-of-line)
-    (insert pascal-exclude-str-start)
-    (newline)
-    ;; Replace end-comments within commented area
-    (goto-char end)
-    (save-excursion
-      (while (re-search-backward "\\*)" start t)
-	(replace-match "!(*" t t)))
-    (save-excursion
-      (while (re-search-backward "}" start t)
-	(replace-match "!{" t t)))))
-
-(defun pascal-uncomment-area ()
-  "Uncomment a commented area; change deformed comments back to normal.
-This command does nothing if the pointer is not in a commented
-area.  See also `pascal-comment-area'."
-  (interactive)
-  (save-excursion
-    (let ((start (point))
-	  (end (point)))
-      ;; Find the boundaries of the comment
-      (save-excursion
-	(setq start (progn (search-backward pascal-exclude-str-start nil t)
-			   (point)))
-	(setq end (progn (search-forward pascal-exclude-str-end nil t)
-			 (point))))
-      ;; Check if we're really inside a comment
-      (if (or (equal start (point)) (<= end (point)))
-	  (message "Not standing within commented area.")
-	(progn
-	  ;; Remove endcomment
-	  (goto-char end)
-	  (beginning-of-line)
-	  (let ((pos (point)))
-	    (end-of-line)
-	    (delete-region pos (1+ (point))))
-	  ;; Change comments back to normal
-	  (save-excursion
-	    (while (re-search-backward "!{" start t)
-	      (replace-match "}" t t)))
-	  (save-excursion
-	    (while (re-search-backward "!(\\*" start t)
-	      (replace-match "*)" t t)))
-	  ;; Remove startcomment
-	  (goto-char start)
-	  (beginning-of-line)
-	  (let ((pos (point)))
-	    (end-of-line)
-	    (delete-region pos (1+ (point)))))))))
-
-(defun pascal-beg-of-defun ()
-  "Move backward to the beginning of the current function or procedure."
-  (interactive)
-  (catch 'found
-    (if (not (looking-at (concat "\\s \\|\\s)\\|" pascal-defun-re)))
-	(forward-sexp 1))
-    (let ((nest 0) (max -1) (func 0)
-	  (reg (concat pascal-beg-block-re "\\|" 
-		       pascal-end-block-re "\\|"
-		       pascal-defun-re)))
-      (while (re-search-backward reg nil 'move)
-	(cond ((let ((state (save-excursion
-			      (parse-partial-sexp (point-min) (point)))))
-		 (or (nth 3 state) (nth 4 state))) ; Inside string or comment
-	       ())
-	      ((match-end 1)                       ; begin|case|record|repeat
-	       (if (and (looking-at "\\<record\\>") (>= max 0))
-		   (setq func (1- func)))
-	       (setq nest (1+ nest)
-		     max (max nest max)))
-	      ((match-end 2)                       ; end|until
-	       (if (and (= nest max) (>= max 0))
-		   (setq func (1+ func)))
-	       (setq nest (1- nest)))
-	      ((match-end 3)                       ; function|procedure
-	       (if (= 0 func)
-		   (throw 'found t)
-		 (setq func (1- func)))))))
-    nil))
-
-(defun pascal-end-of-defun ()
-  "Move forward to the end of the current function or procedure."
-  (interactive)
-  (if (looking-at "\\s ")
-      (forward-sexp 1))
-  (if (not (looking-at pascal-defun-re))
-      (pascal-beg-of-defun))
-  (forward-char 1)
-  (let ((nest 0) (func 1)
-	(reg (concat pascal-beg-block-re "\\|" 
-		     pascal-end-block-re "\\|"
-		     pascal-defun-re)))
-    (while (and (/= func 0)
-		(re-search-forward reg nil 'move))
-      (cond ((let ((state (save-excursion
-			      (parse-partial-sexp (point-min) (point)))))
-		 (or (nth 3 state) (nth 4 state))) ; Inside string or comment
-	       ())
-	    ((match-end 1)
-	     (setq nest (1+ nest))
-	     (if (save-excursion
-		   (goto-char (match-beginning 0))
-		   (looking-at "\\<record\\>"))
-		 (setq func (1+ func))))
-	    ((match-end 2)
-	     (setq nest (1- nest))
-	     (if (= nest 0)
-		 (setq func (1- func))))
-	    ((match-end 3)
-	     (setq func (1+ func))))))
-  (forward-line 1))
-
-(defun pascal-end-of-statement ()
-  "Move forward to end of current statement."
-  (interactive)
-  (let ((parse-sexp-ignore-comments t)
-	(nest 0) pos
-	(regexp (concat "\\(" pascal-beg-block-re "\\)\\|\\("
-			pascal-end-block-re "\\)")))
-    (if (not (looking-at "[ \t\n]")) (forward-sexp -1))
-    (or (looking-at pascal-beg-block-re)
-	;; Skip to end of statement
-	(setq pos (catch 'found
-		    (while t
-		      (forward-sexp 1)
-		      (cond ((looking-at "[ \t]*;")
-			     (skip-chars-forward "^;")
-			     (forward-char 1)
-			     (throw 'found (point)))
-			    ((save-excursion
-			       (forward-sexp -1)
-			       (looking-at pascal-beg-block-re))
-			     (goto-char (match-beginning 0))
-			     (throw 'found nil))
-			    ((eobp)
-			     (throw 'found (point))))))))
-    (if (not pos)
-	;; Skip a whole block
-	(catch 'found
-	  (while t
-	    (re-search-forward regexp nil 'move)
-	    (setq nest (if (match-end 1) 
-			   (1+ nest)
-			 (1- nest)))
-	    (cond ((eobp)
-		   (throw 'found (point)))
-		  ((= 0 nest)
-		   (throw 'found (pascal-end-of-statement))))))
-      pos)))
-
-(defun pascal-downcase-keywords ()
-  "Downcase all Pascal keywords in the buffer."
-  (interactive)
-  (pascal-change-keywords 'downcase-word))
-
-(defun pascal-upcase-keywords ()
-  "Upcase all Pascal keywords in the buffer."
-  (interactive)
-  (pascal-change-keywords 'upcase-word))
-
-(defun pascal-capitalize-keywords ()
-  "Capitalize all Pascal keywords in the buffer."
-  (interactive)
-  (pascal-change-keywords 'capitalize-word))
-
-;; Change the keywords according to argument.
-(defun pascal-change-keywords (change-word)
-  (save-excursion
-    (let ((keyword-re (concat "\\<\\("
-			      (mapconcat 'identity pascal-keywords "\\|")
-			      "\\)\\>")))
-      (goto-char (point-min))
-      (while (re-search-forward keyword-re nil t)
-	(funcall change-word -1)))))
-
-
-
-;;;
-;;; Other functions
-;;;
-(defun pascal-set-auto-comments ()
-  "Insert `{ case }' or `{ NAME }' on this line if appropriate.
-Insert `{ case }' if there is an `end' on the line which
-ends a case block.  Insert `{ NAME }' if there is an `end'
-on the line which ends a function or procedure named NAME."
-  (save-excursion
-    (forward-line -1)
-    (skip-chars-forward " \t")
-    (if (and (looking-at "\\<end;")
-	     (not (save-excursion
-		    (end-of-line)
-		    (search-backward "{" (pascal-get-beg-of-line) t))))
-	(let ((type (car (pascal-calculate-indent))))
-	  (if (eq type 'declaration)
-	      ()
-	    (if (eq type 'case)
-		;; This is a case block
-		(progn
-		  (end-of-line)
-		  (delete-horizontal-space)
-		  (insert " { case }"))
-	      (let ((nest 1))
-		;; Check if this is the end of a function
-		(save-excursion
-		  (while (not (or (looking-at pascal-defun-re) (bobp)))
-		    (backward-sexp 1)
-		    (cond ((looking-at pascal-beg-block-re)
-			   (setq nest (1- nest)))
-			  ((looking-at pascal-end-block-re)
-			   (setq nest (1+ nest)))))
-		  (if (bobp)
-		      (setq nest 1)))
-		(if (zerop nest)
-		    (progn
-		      (end-of-line)
-		      (delete-horizontal-space)
-		      (insert " { ")
-		      (let (b e)
-			(save-excursion
-			  (setq b (progn (pascal-beg-of-defun)
-					 (skip-chars-forward "^ \t")
-					 (skip-chars-forward " \t")
-					 (point))
-				e (progn (skip-chars-forward "a-zA-Z0-9_")
-					 (point))))
-			(insert-buffer-substring (current-buffer) b e))
-		      (insert " }"))))))))))
-
-
-
-;;;
-;;; Indentation
-;;;
-(defconst pascal-indent-alist
-  '((block . (+ ind pascal-indent-level))
-    (case . (+ ind pascal-case-indent))
-    (caseblock . ind) (cpp . 0)
-    (declaration . (+ ind pascal-indent-level))
-    (paramlist . (pascal-indent-paramlist t))
-    (comment . (pascal-indent-comment t))
-    (defun . ind) (contexp . ind)
-    (unknown . 0) (string . 0)))
-
-(defun pascal-indent-command ()
-  "Indent for special part of code."
-  (let* ((indent-str (pascal-calculate-indent))
-	 (type (car indent-str))
-	 (ind (car (cdr indent-str))))
-    (cond ((and (eq type 'paramlist)
-		(or (memq 'all pascal-auto-lineup)
-		    (memq 'paramlist pascal-auto-lineup)))
-	   (pascal-indent-paramlist)
-	   (pascal-indent-paramlist))
-	  ((and (eq type 'declaration)
-		(or (memq 'all pascal-auto-lineup)
-		    (memq 'declaration  pascal-auto-lineup)))
-	   (pascal-indent-declaration))
-	  ((and (eq type 'case) (not (looking-at "^[ \t]*$"))
-		(or (memq 'all pascal-auto-lineup)
-		    (memq 'case pascal-auto-lineup)))
-	   (pascal-indent-case)))
-    (if (looking-at "[ \t]+$")
-	(skip-chars-forward " \t"))))
-
-(defun pascal-indent-line ()
-  "Indent current line as a Pascal statement."
-  (let* ((indent-str (pascal-calculate-indent))
-	 (type (car indent-str))
-	 (ind (car (cdr indent-str))))
-    (if (looking-at "^[0-9a-zA-Z]+[ \t]*:[^=]")
-	(search-forward ":" nil t))
-    (delete-horizontal-space)
-    ;; Some things should not be indented
-    (if (or (and (eq type 'declaration) (looking-at pascal-declaration-re))
-	    (eq type 'cpp)
-	    (looking-at pascal-defun-re))
-	()
-      ;; Other things should have no extra indent
-      (if (looking-at pascal-noindent-re)
-	  (indent-to ind)
-	;; But most lines are treated this way:
-	(indent-to (eval (cdr (assoc type pascal-indent-alist))))
-	))))
-
-(defun pascal-calculate-indent ()
-  "Calculate the indent of the current Pascal line.
-Return a list of two elements: (INDENT-TYPE INDENT-LEVEL)."
-  (save-excursion
-    (let* ((parse-sexp-ignore-comments t)
-	   (oldpos (point))
-	   (state (save-excursion (parse-partial-sexp (point-min) (point))))
-	   (nest 0) (par 0) (complete (looking-at "[ \t]*end\\>"))
-	   (elsed (looking-at "[ \t]*else\\>"))
-	   (type (catch 'nesting
-		   ;; Check if inside a string, comment or parenthesis
-		   (cond ((nth 3 state) (throw 'nesting 'string))
-			 ((nth 4 state) (throw 'nesting 'comment))
-			 ((> (car state) 0)
-			  (goto-char (scan-lists (point) -1 (car state)))
-			  (setq par (1+ (current-column))))
-			 ((save-excursion (beginning-of-line)
-					  (eq (following-char) ?#))
-			  (throw 'nesting 'cpp)))
-		   ;; Loop until correct indent is found
-		   (while t
-		     (backward-sexp 1)
-		     (cond (;--Escape from case statements
-			    (and (looking-at "[A-Za-z0-9]+[ \t]*:[^=]")
-				 (not complete)
-				 (save-excursion (skip-chars-backward " \t")
-						 (bolp))
-				 (= (save-excursion
-				      (end-of-line) (backward-sexp) (point))
-				    (point))
-				 (> (save-excursion (goto-char oldpos)
-						    (beginning-of-line)
-						    (point))
-				    (point)))
-			    (throw 'nesting 'caseblock))
-			   (;--Nest block outwards
-			    (looking-at pascal-beg-block-re)
-			    (if (= nest 0)
-				(cond ((looking-at "case\\>")
-				       (throw 'nesting 'case))
-				      ((looking-at "record\\>")
-				       (throw 'nesting 'declaration))
-				      (t (throw 'nesting 'block)))
-			      (setq nest (1- nest))))
-			   (;--Nest block inwards
-			    (looking-at pascal-end-block-re)
-			    (if (and (looking-at "end\\s ")
-				     elsed (not complete))
-				(throw 'nesting 'block))
-			    (setq complete t
-				  nest (1+ nest)))
-			   (;--Defun (or parameter list)
-			    (looking-at pascal-defun-re)
-			    (if (= 0 par)
-				(throw 'nesting 'defun)
-			      (setq par 0)
-			      (let ((n 0))
-				(while (re-search-forward
-					"\\(\\<record\\>\\)\\|\\<end\\>"
-					oldpos t)
-				  (if (match-end 1)
-				      (setq n (1+ n)) (setq n (1- n))))
-				(if (> n 0)
-				    (throw 'nesting 'declaration)
-				  (throw 'nesting 'paramlist)))))
-			   (;--Declaration part
-			    (looking-at pascal-declaration-re)
-			    (if (save-excursion
-				  (goto-char oldpos)
-				  (forward-line -1)
-				  (looking-at "^[ \t]*$"))
-				(throw 'nesting 'unknown)
-			      (throw 'nesting 'declaration)))
-			   (;--If, else or while statement
-			    (and (not complete)
-				 (looking-at pascal-sub-block-re))
-			    (throw 'nesting 'block))
-			   (;--Found complete statement
-			    (save-excursion (forward-sexp 1)
-					    (= (following-char) ?\;))
-			    (setq complete t))
-			   (;--No known statements
-			    (bobp)
-			    (throw 'nesting 'unknown))
-			   )))))
-
-      ;; Return type of block and indent level.
-      (if (> par 0)                               ; Unclosed Parenthesis 
-	  (list 'contexp par)
-	(list type (pascal-indent-level))))))
-
-(defun pascal-indent-level ()
-  "Return the indent-level the current statement has.
-Do not count labels, case-statements or records."
-  (save-excursion
-    (beginning-of-line)
-    (if (looking-at "[ \t]*[0-9a-zA-Z]+[ \t]*:[^=]")
-	(search-forward ":" nil t)
-      (if (looking-at ".*=[ \t]*record\\>")
-	  (search-forward "=" nil t)))
-    (skip-chars-forward " \t")
-    (current-column)))
-
-(defun pascal-indent-comment (&optional arg)
-  "Indent current line as comment.
-If optional arg is non-nil, just return the
-column number the line should be indented to."
-    (let* ((stcol (save-excursion
-		    (re-search-backward "(\\*\\|{" nil t)
-		    (1+ (current-column)))))
-      (if arg stcol
-	(delete-horizontal-space)
-	(indent-to stcol))))
-
-(defun pascal-indent-case ()
-  "Indent within case statements."
-  (let ((savepos (point-marker))
-	(end (prog2
-		 (end-of-line)
-		 (point-marker)
-	       (re-search-backward "\\<case\\>" nil t)))
-	(beg (point)) oldpos
-	(ind 0))
-    ;; Get right indent
-    (while (< (point) (marker-position end))
-      (if (re-search-forward 
-	   "^[ \t]*[^ \t,:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
-	   (marker-position end) 'move)
-	  (forward-char -1))
-      (if (< (point) (marker-position end))
-	  (progn
-	    (delete-horizontal-space)
-	    (if (> (current-column) ind)
-		(setq ind (current-column)))
-	    (pascal-end-of-statement))))
-    (goto-char beg)
-    (setq oldpos (marker-position end))
-    ;; Indent all case statements
-    (while (< (point) (marker-position end))
-      (if (re-search-forward
-	   "^[ \t]*[^][ \t,\\.:]+[ \t]*\\(,[ \t]*[^ \t,:]+[ \t]*\\)*:"
-	   (marker-position end) 'move)
-	  (forward-char -1))
-      (indent-to (1+ ind))
-      (if (/= (following-char) ?:)
-	  ()
-	(forward-char 1)
-	(delete-horizontal-space)
-	(insert " "))
-      (setq oldpos (point))
-      (pascal-end-of-statement))
-    (goto-char savepos)))
-
-(defun pascal-indent-paramlist (&optional arg)
-  "Indent current line in parameterlist.
-If optional arg is non-nil, just return the
-indent of the current line in parameterlist."
-  (save-excursion
-    (let* ((oldpos (point))
-	   (stpos (progn (goto-char (scan-lists (point) -1 1)) (point)))
-	   (stcol (1+ (current-column)))
-	   (edpos (progn (pascal-declaration-end) 
-			 (search-backward ")" (pascal-get-beg-of-line) t)
-			 (point)))
-	   (usevar (re-search-backward "\\<var\\>" stpos t)))
-      (if arg (progn
-		;; If arg, just return indent
-		(goto-char oldpos)
-		(beginning-of-line)
-		(if (or (not usevar) (looking-at "[ \t]*var\\>"))
-		    stcol (+ 4 stcol)))
-	(goto-char stpos)
-	(forward-char 1)
-	(delete-horizontal-space)
-	(if (and usevar (not (looking-at "var\\>")))
-	    (indent-to (+ 4 stcol)))
-	(pascal-indent-declaration nil stpos edpos)))))
-
-(defun pascal-indent-declaration (&optional arg start end)
-  "Indent current lines as declaration, lining up the `:'s or `='s."
-  (let ((pos (point-marker)))
-    (if (and (not (or arg start)) (not (pascal-declaration-beg)))
-	()
-      (let ((lineup (if (or (looking-at "\\<var\\>\\|\\<record\\>") arg start) 
-			":" "="))
-	    (stpos (if start start
-		       (forward-word 2) (backward-word 1) (point)))
-	    (edpos (set-marker (make-marker)
-			       (if end end
-				 (max (progn (pascal-declaration-end)
-					     (point))
-				      pos))))
-	    ind)
-
-	(goto-char stpos)
-	;; Indent lines in record block
-	(if arg
-	    (while (<= (point) (marker-position edpos))
-	      (beginning-of-line)
-	      (delete-horizontal-space)
-	      (if (looking-at "end\\>")
-		  (indent-to arg)
-		(indent-to (+ arg pascal-indent-level)))
-	      (forward-line 1)))
-
-	;; Do lineup
-	(setq ind (pascal-get-lineup-indent stpos edpos lineup))
-	(goto-char stpos)
-	(while (and (<= (point) (marker-position edpos))
-		    (not (eobp)))
-	  (if (search-forward lineup (pascal-get-end-of-line) 'move)
-	      (forward-char -1))
-	  (delete-horizontal-space)
-	  (indent-to ind)
-	  (if (not (looking-at lineup))
-	      (forward-line 1) ; No more indent if there is no : or =
-	    (forward-char 1)
-	    (delete-horizontal-space)
-	    (insert " ")
-	    ;; Indent record block
-	    (if (looking-at "record\\>")
-		(pascal-indent-declaration (current-column)))
-	    (forward-line 1)))))
-
-    ;; If arg - move point
-    (if arg (forward-line -1)
-      (goto-char (marker-position pos)))))
-
-;  "Return the indent level that will line up several lines within the region
-;from b to e nicely. The lineup string is str."
-(defun pascal-get-lineup-indent (b e str)
-  (save-excursion
-    (let ((ind 0)
-	  (reg (concat str "\\|\\(\\<record\\>\\)"))
-	  nest)
-      (goto-char b)
-      ;; Get rightmost position
-      (while (< (point) e)
-	(setq nest 1)
-	(if (re-search-forward reg (min e (pascal-get-end-of-line 2)) 'move)
-	    (progn
-	      ;; Skip record blocks
-	      (if (match-beginning 1)
-		  (pascal-declaration-end)
-		(progn
-		  (goto-char (match-beginning 0))
-		  (skip-chars-backward " \t")
-		  (if (> (current-column) ind)
-		      (setq ind (current-column)))
-		  (goto-char (match-end 0)))))))
-      ;; In case no lineup was found
-      (if (> ind 0)
-	  (1+ ind)
-	;; No lineup-string found
-	(goto-char b)
-	(end-of-line)
-	(skip-chars-backward " \t")
-	(1+ (current-column))))))
-    
-
-
-;;;
-;;; Completion
-;;;
-(defvar pascal-str nil)
-(defvar pascal-all nil)
-(defvar pascal-pred nil)
-(defvar pascal-buffer-to-use nil)
-(defvar pascal-flag nil)
-
-(defun pascal-string-diff (str1 str2)
-  "Return index of first letter where STR1 and STR2 differs."
-  (catch 'done
-    (let ((diff 0))
-      (while t
-	(if (or (> (1+ diff) (length str1))
-		(> (1+ diff) (length str2)))
-	    (throw 'done diff))
-	(or (equal (aref str1 diff) (aref str2 diff))
-	    (throw 'done diff))
-	(setq diff (1+ diff))))))
-
-;; Calculate all possible completions for functions if argument is `function',
-;; completions for procedures if argument is `procedure' or both functions and
-;; procedures otherwise.
-
-(defun pascal-func-completion (type)
-  ;; Build regular expression for function/procedure names
-  (if (string= pascal-str "")
-      (setq pascal-str "[a-zA-Z_]"))
-  (let ((pascal-str (concat (cond
-			     ((eq type 'procedure) "\\<\\(procedure\\)\\s +")
-			     ((eq type 'function) "\\<\\(function\\)\\s +")
-			     (t "\\<\\(function\\|procedure\\)\\s +"))
-			    "\\<\\(" pascal-str "[a-zA-Z0-9_.]*\\)\\>"))
-	match)
-    
-    (if (not (looking-at "\\<\\(function\\|procedure\\)\\>"))
-	(re-search-backward "\\<\\(function\\|procedure\\)\\>" nil t))
-    (forward-char 1)
-
-    ;; Search through all reachable functions
-    (while (pascal-beg-of-defun)
-      (if (re-search-forward pascal-str (pascal-get-end-of-line) t)
-	  (progn (setq match (buffer-substring (match-beginning 2)
-					       (match-end 2)))
-		 (if (or (null pascal-pred)
-			 (funcall pascal-pred match))
-		     (setq pascal-all (cons match pascal-all)))))
-      (goto-char (match-beginning 0)))))
-
-(defun pascal-get-completion-decl ()
-  ;; Macro for searching through current declaration (var, type or const)
-  ;; for matches of `str' and adding the occurrence tp `all'
-  (let ((end (save-excursion (pascal-declaration-end)
-			     (point)))
-	match)
-    ;; Traverse lines
-    (while (< (point) end)
-      (if (re-search-forward "[:=]" (pascal-get-end-of-line) t)
-	  ;; Traverse current line
-	  (while (and (re-search-backward 
-		       (concat "\\((\\|\\<\\(var\\|type\\|const\\)\\>\\)\\|" 
-			       pascal-symbol-re)
-		       (pascal-get-beg-of-line) t)
-		      (not (match-end 1)))
-	    (setq match (buffer-substring (match-beginning 0) (match-end 0)))
-	    (if (string-match (concat "\\<" pascal-str) match)
-		(if (or (null pascal-pred)
-			(funcall pascal-pred match))
-		    (setq pascal-all (cons match pascal-all))))))
-      (if (re-search-forward "\\<record\\>" (pascal-get-end-of-line) t)
-	  (pascal-declaration-end)
-	(forward-line 1)))))
-
-(defun pascal-type-completion ()
-  "Calculate all possible completions for types."
-  (let ((start (point))
-	goon)
-    ;; Search for all reachable type declarations
-    (while (or (pascal-beg-of-defun)
-	       (setq goon (not goon)))
-      (save-excursion
-	(if (and (< start (prog1 (save-excursion (pascal-end-of-defun)
-						 (point))
-			    (forward-char 1)))
-		 (re-search-forward
-		  "\\<type\\>\\|\\<\\(begin\\|function\\|procedure\\)\\>"
-		  start t)
-		 (not (match-end 1)))
-	    ;; Check current type declaration
-	    (pascal-get-completion-decl))))))
-
-(defun pascal-var-completion ()
-  "Calculate all possible completions for variables (or constants)."
-  (let ((start (point))
-	goon twice)
-    ;; Search for all reachable var declarations
-    (while (or (pascal-beg-of-defun)
-	       (setq goon (not goon)))
-      (save-excursion
-	(if (> start (prog1 (save-excursion (pascal-end-of-defun)
-					    (point))))
-	    () ; Declarations not reachable
-	  (if (search-forward "(" (pascal-get-end-of-line) t)
-	      ;; Check parameterlist
-		(pascal-get-completion-decl))
-	  (setq twice 2)
-	  (while (>= (setq twice (1- twice)) 0)
-	    (cond ((and (re-search-forward
-			 (concat "\\<\\(var\\|const\\)\\>\\|"
-				 "\\<\\(begin\\|function\\|procedure\\)\\>")
-			 start t)
-			(not (match-end 2)))
-		   ;; Check var/const declarations
-		   (pascal-get-completion-decl))
-		  ((match-end 2)
-		   (setq twice 0)))))))))
-
-
-(defun pascal-keyword-completion (keyword-list)
-  "Give list of all possible completions of keywords in KEYWORD-LIST."
-  (mapcar '(lambda (s) 
-	     (if (string-match (concat "\\<" pascal-str) s)
-		 (if (or (null pascal-pred)
-			 (funcall pascal-pred s))
-		     (setq pascal-all (cons s pascal-all)))))
-	  keyword-list))
-
-;; Function passed to completing-read, try-completion or
-;; all-completions to get completion on STR. If predicate is non-nil,
-;; it must be a function to be called for every match to check if this
-;; should really be a match. If flag is t, the function returns a list
-;; of all possible completions. If it is nil it returns a string, the
-;; longest possible completion, or t if STR is an exact match. If flag
-;; is 'lambda, the function returns t if STR is an exact match, nil
-;; otherwise.
-
-(defun pascal-completion (pascal-str pascal-pred pascal-flag)
-  (save-excursion
-    (let ((pascal-all nil))
-      ;; Set buffer to use for searching labels. This should be set
-      ;; within functions which use pascal-completions
-      (set-buffer pascal-buffer-to-use)
-
-      ;; Determine what should be completed
-      (let ((state (car (pascal-calculate-indent))))
-	(cond (;--Within a declaration or parameterlist
-	       (or (eq state 'declaration) (eq state 'paramlist)
-		   (and (eq state 'defun)
-			(save-excursion
-			  (re-search-backward ")[ \t]*:"
-					      (pascal-get-beg-of-line) t))))
-	       (if (or (eq state 'paramlist) (eq state 'defun))
-		   (pascal-beg-of-defun))
-	       (pascal-type-completion)
-	       (pascal-keyword-completion pascal-type-keywords))
-	      (;--Starting a new statement
-	       (and (not (eq state 'contexp))
-		    (save-excursion
-		      (skip-chars-backward "a-zA-Z0-9_.")
-		      (backward-sexp 1)
-		      (or (looking-at pascal-nosemi-re)
-			  (progn
-			    (forward-sexp 1)
-			    (looking-at "\\s *\\(;\\|:[^=]\\)")))))
-	       (save-excursion (pascal-var-completion))
-	       (pascal-func-completion 'procedure)
-	       (pascal-keyword-completion pascal-start-keywords))
-	      (t;--Anywhere else
-	       (save-excursion (pascal-var-completion))
-	       (pascal-func-completion 'function)
-	       (pascal-keyword-completion pascal-separator-keywords))))
-      
-      ;; Now we have built a list of all matches. Give response to caller
-      (pascal-completion-response))))
-
-(defun pascal-completion-response ()
-  (cond ((or (equal pascal-flag 'lambda) (null pascal-flag))
-	 ;; This was not called by all-completions
-	 (if (null pascal-all)
-	     ;; Return nil if there was no matching label
-	     nil
-	   ;; Get longest string common in the labels
-	   (let* ((elm (cdr pascal-all))
-		  (match (car pascal-all))
-		  (min (length match))
-		  exact tmp)
-	     (if (string= match pascal-str)
-		 ;; Return t if first match was an exact match
-		 (setq match t)
-	       (while (not (null elm))
-		 ;; Find longest common string
-		 (if (< (setq tmp (pascal-string-diff match (car elm))) min)
-		     (progn
-		       (setq min tmp)
-		       (setq match (substring match 0 min))))
-		 ;; Terminate with match=t if this is an exact match
-		 (if (string= (car elm) pascal-str)
-		     (progn
-		       (setq match t)
-		       (setq elm nil))
-		   (setq elm (cdr elm)))))
-	     ;; If this is a test just for exact match, return nil ot t
-	     (if (and (equal pascal-flag 'lambda) (not (equal match 't)))
-		 nil
-	       match))))
-	;; If flag is t, this was called by all-completions. Return
-	;; list of all possible completions
-	(pascal-flag
-	 pascal-all)))
-
-(defvar pascal-last-word-numb 0)
-(defvar pascal-last-word-shown nil)
-(defvar pascal-last-completions nil)
-
-(defun pascal-complete-word ()
-  "Complete word at current point.
-\(See also `pascal-toggle-completions', `pascal-type-keywords',
-`pascal-start-keywords' and `pascal-separator-keywords'.)"
-  (interactive)
-  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
-	 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
-	 (pascal-str (buffer-substring b e))
-	 ;; The following variable is used in pascal-completion
-	 (pascal-buffer-to-use (current-buffer))
-	 (allcomp (if (and pascal-toggle-completions
-			   (string= pascal-last-word-shown pascal-str))
-		      pascal-last-completions
-		    (all-completions pascal-str 'pascal-completion)))
-	 (match (if pascal-toggle-completions
-		    "" (try-completion
-			pascal-str (mapcar '(lambda (elm)
-					      (cons elm 0)) allcomp)))))
-    ;; Delete old string
-    (delete-region b e)
-
-    ;; Toggle-completions inserts whole labels
-    (if pascal-toggle-completions
-	(progn
-	  ;; Update entry number in list
-	  (setq pascal-last-completions allcomp
-		pascal-last-word-numb 
-		(if (>= pascal-last-word-numb (1- (length allcomp)))
-		    0
-		  (1+ pascal-last-word-numb)))
-	  (setq pascal-last-word-shown (elt allcomp pascal-last-word-numb))
-	  ;; Display next match or same string if no match was found
-	  (if (not (null allcomp))
-	      (insert "" pascal-last-word-shown)
-	    (insert "" pascal-str)
-	    (message "(No match)")))
-      ;; The other form of completion does not necessarily do that.
-
-      ;; Insert match if found, or the original string if no match
-      (if (or (null match) (equal match 't))
-	  (progn (insert "" pascal-str)
-		 (message "(No match)"))
-	(insert "" match))
-      ;; Give message about current status of completion
-      (cond ((equal match 't)
-	     (if (not (null (cdr allcomp)))
-		 (message "(Complete but not unique)")
-	       (message "(Sole completion)")))
-	    ;; Display buffer if the current completion didn't help 
-	    ;; on completing the label.
-	    ((and (not (null (cdr allcomp))) (= (length pascal-str)
-						(length match)))
-	     (with-output-to-temp-buffer "*Completions*"
-	       (display-completion-list allcomp))
-	     ;; Wait for a keypress. Then delete *Completion*  window
-	     (momentary-string-display "" (point))
-	     (delete-window (get-buffer-window (get-buffer "*Completions*")))
-	     )))))
-
-(defun pascal-show-completions ()
-  "Show all possible completions at current point."
-  (interactive)
-  (let* ((b (save-excursion (skip-chars-backward "a-zA-Z0-9_") (point)))
-	 (e (save-excursion (skip-chars-forward "a-zA-Z0-9_") (point)))
-	 (pascal-str (buffer-substring b e))
-	 ;; The following variable is used in pascal-completion
-	 (pascal-buffer-to-use (current-buffer))
-	 (allcomp (if (and pascal-toggle-completions
-			   (string= pascal-last-word-shown pascal-str))
-		      pascal-last-completions
-		    (all-completions pascal-str 'pascal-completion))))
-    ;; Show possible completions in a temporary buffer.
-    (with-output-to-temp-buffer "*Completions*"
-      (display-completion-list allcomp))
-    ;; Wait for a keypress. Then delete *Completion*  window
-    (momentary-string-display "" (point))
-    (delete-window (get-buffer-window (get-buffer "*Completions*")))))
-
-
-(defun pascal-get-default-symbol ()
-  "Return symbol around current point as a string."
-  (save-excursion
-    (buffer-substring (progn
-			(skip-chars-backward " \t")
-			(skip-chars-backward "a-zA-Z0-9_")
-			(point))
-		      (progn
-			(skip-chars-forward "a-zA-Z0-9_")
-			(point)))))
-
-(defun pascal-build-defun-re (str &optional arg)
-  "Return function/procedure starting with STR as regular expression.
-With optional second arg non-nil, STR is the complete name of the instruction."
-  (if arg
-      (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "\\)\\>")
-    (concat "^\\(function\\|procedure\\)[ \t]+\\(" str "[a-zA-Z0-9_]*\\)\\>")))
-
-;; Function passed to completing-read, try-completion or
-;; all-completions to get completion on any function name. If
-;; predicate is non-nil, it must be a function to be called for every
-;; match to check if this should really be a match. If flag is t, the
-;; function returns a list of all possible completions. If it is nil
-;; it returns a string, the longest possible completion, or t if STR
-;; is an exact match. If flag is 'lambda, the function returns t if
-;; STR is an exact match, nil otherwise.
-
-(defun pascal-comp-defun (pascal-str pascal-pred pascal-flag)
-  (save-excursion
-    (let ((pascal-all nil)
-	  match)
-
-      ;; Set buffer to use for searching labels. This should be set
-      ;; within functions which use pascal-completions
-      (set-buffer pascal-buffer-to-use)
-
-      (let ((pascal-str pascal-str))
-	;; Build regular expression for functions
-	(if (string= pascal-str "")
-	    (setq pascal-str (pascal-build-defun-re "[a-zA-Z_]"))
-	  (setq pascal-str (pascal-build-defun-re pascal-str)))
-	(goto-char (point-min))
-      
-	;; Build a list of all possible completions
-	(while (re-search-forward pascal-str nil t)
-	  (setq match (buffer-substring (match-beginning 2) (match-end 2)))
-	  (if (or (null pascal-pred)
-		  (funcall pascal-pred match))
-	      (setq pascal-all (cons match pascal-all)))))
-
-      ;; Now we have built a list of all matches. Give response to caller
-      (pascal-completion-response))))
-
-(defun pascal-goto-defun ()
-  "Move to specified Pascal function/procedure.
-The default is a name found in the buffer around point."
-  (interactive)
-  (let* ((default (pascal-get-default-symbol))
-	 ;; The following variable is used in pascal-comp-function
-	 (pascal-buffer-to-use (current-buffer))
-	 (default (if (pascal-comp-defun default nil 'lambda)
-		      default ""))
-	 (label (if (not (string= default ""))
-		    ;; Do completion with default
-		    (completing-read (concat "Label: (default " default ") ")
-				     'pascal-comp-defun nil t "")
-		  ;; There is no default value. Complete without it
-		  (completing-read "Label: "
-				   'pascal-comp-defun nil t ""))))
-    ;; If there was no response on prompt, use default value
-    (if (string= label "")
-	(setq label default))
-    ;; Goto right place in buffer if label is not an empty string
-    (or (string= label "")
-	(progn
-	  (goto-char (point-min))
-	  (re-search-forward (pascal-build-defun-re label t))
-	  (beginning-of-line)))))
-
-
-
-;;;
-;;; Pascal-outline-mode
-;;;
-(defvar pascal-outline-map nil "Keymap used in Pascal Outline mode.")
-
-(if pascal-outline-map
-    nil
-  (if (boundp 'set-keymap-name)
-      (set-keymap-name pascal-outline-map 'pascal-outline-map))
-  (if (not (boundp 'set-keymap-parent))
-      (setq pascal-outline-map (copy-keymap pascal-mode-map))
-    (setq pascal-outline-map (make-sparse-keymap))
-    (set-keymap-parent pascal-outline-map pascal-mode-map))
-  (define-key pascal-outline-map "\M-\C-a"  'pascal-outline-prev-defun)
-  (define-key pascal-outline-map "\M-\C-e"  'pascal-outline-next-defun)
-  (define-key pascal-outline-map "\C-c\C-d" 'pascal-outline-goto-defun)
-  (define-key pascal-outline-map "\C-c\C-s" 'pascal-show-all)
-  (define-key pascal-outline-map "\C-c\C-h" 'pascal-hide-other-defuns))
-
-(defvar pascal-outline-mode nil "Non-nil while using Pascal Outline mode.")
-(make-variable-buffer-local 'pascal-outline-mode)
-(set-default 'pascal-outline-mode nil)
-(if (not (assoc 'pascal-outline-mode minor-mode-alist))
-    (setq minor-mode-alist (append minor-mode-alist
-				   (list '(pascal-outline-mode " Outl")))))
-
-(defun pascal-outline (&optional arg)
-  "Outline-line minor mode for Pascal mode.
-When in Pascal Outline mode, portions
-of the text being edited may be made invisible. \\<pascal-outline-map>
-
-Pascal Outline mode provides some additional commands.
-
-\\[pascal-outline-prev-defun]\
-\t- Move to previous function/procedure, hiding everything else.
-\\[pascal-outline-next-defun]\
-\t- Move to next function/procedure, hiding everything else.
-\\[pascal-outline-goto-defun]\
-\t- Goto function/procedure prompted for in minibuffer,
-\t  hide all other functions.
-\\[pascal-show-all]\t- Show the whole buffer.
-\\[pascal-hide-other-defuns]\
-\t- Hide everything but the current function (function under the cursor).
-\\[pascal-outline]\t- Leave pascal-outline-mode."
-  (interactive "P")
-  (setq pascal-outline-mode
-	(if (null arg) (not pascal-outline-mode) t))
-  (if (boundp 'redraw-mode-line)
-      (redraw-mode-line))
-  (if pascal-outline-mode
-      (progn
-	(setq selective-display t)
-	(use-local-map pascal-outline-map))
-    (progn
-      (setq selective-display nil)
-      (pascal-show-all)
-      (use-local-map pascal-mode-map))))
-
-(defun pascal-outline-change (b e pascal-flag)
-  (let ((modp (buffer-modified-p)))
-    (unwind-protect
-	(subst-char-in-region b e (if (= pascal-flag ?\n) 
-				      ?\^M ?\n) pascal-flag)
-      (set-buffer-modified-p modp))))
-
-(defun pascal-show-all ()
-  "Show all of the text in the buffer."
-  (interactive)
-  (pascal-outline-change (point-min) (point-max) ?\n))
-
-(defun pascal-hide-other-defuns ()
-  "Show only the current defun."
-  (interactive)
-  (save-excursion
-    (let ((beg (progn (if (not (looking-at "\\(function\\|procedure\\)\\>"))
-			  (pascal-beg-of-defun))
-		      (point)))
-	  (end (progn (pascal-end-of-defun)
-		      (backward-sexp 1)
-		      (search-forward "\n\\|\^M" nil t)
-		      (point)))
-	  (opoint (point-min)))
-      (goto-char (point-min))
-
-      ;; Hide all functions before current function
-      (while (re-search-forward "^\\(function\\|procedure\\)\\>" beg 'move)
-	(pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
-	(setq opoint (point))
-	;; Functions may be nested
-	(if (> (progn (pascal-end-of-defun) (point)) beg)
-	    (goto-char opoint)))
-      (if (> beg opoint)
-	  (pascal-outline-change opoint (1- beg) ?\^M))
-
-      ;; Show current function
-      (pascal-outline-change beg end ?\n)
-      ;; Hide nested functions
-      (forward-char 1)
-      (while (re-search-forward "^\\(function\\|procedure\\)\\>" end 'move)
-	(setq opoint (point))
-	(pascal-end-of-defun)
-	(pascal-outline-change opoint (point) ?\^M))
-
-      (goto-char end)
-      (setq opoint end)
-
-      ;; Hide all function after current function
-      (while (re-search-forward "^\\(function\\|procedure\\)\\>" nil 'move)
-	(pascal-outline-change opoint (1- (match-beginning 0)) ?\^M)
-	(setq opoint (point))
-	(pascal-end-of-defun))
-      (pascal-outline-change opoint (point-max) ?\^M)
-
-      ;; Hide main program
-      (if (< (progn (forward-line -1) (point)) end)
-	  (progn
-	    (goto-char beg)
-	    (pascal-end-of-defun)
-	    (backward-sexp 1)
-	    (pascal-outline-change (point) (point-max) ?\^M))))))
-
-(defun pascal-outline-next-defun ()
-  "Move to next function/procedure, hiding all others."
-  (interactive)
-  (pascal-end-of-defun)
-  (pascal-hide-other-defuns))
-
-(defun pascal-outline-prev-defun ()
-  "Move to previous function/procedure, hiding all others."
-  (interactive)
-  (pascal-beg-of-defun)
-  (pascal-hide-other-defuns))
-
-(defun pascal-outline-goto-defun ()
-  "Move to specified function/procedure, hiding all others."
-  (interactive)
-  (pascal-goto-defun)
-  (pascal-hide-other-defuns))
-
-;;; pascal.el ends here
diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el
deleted file mode 100644
index 67a439da655..00000000000
--- a/lisp/progmodes/perl-mode.el
+++ /dev/null
@@ -1,732 +0,0 @@
-;;; perl-mode.el --- Perl code editing commands for GNU Emacs
-
-;; Copyright (C) 1990, 1994  Free Software Foundation, Inc.
-
-;; Author: William F. Mann
-;; Maintainer: FSF
-;; Adapted-By: ESR
-;; Keywords: languages
-
-;; Adapted from C code editing commands 'c-mode.el', Copyright 1987 by the
-;; Free Software Foundation, under terms of its General Public License.
-
-;; 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:
-
-;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode")
-;; to your .emacs file and change the first line of your perl script to:
-;; #!/usr/bin/perl --	 # -*-Perl-*-
-;; With arguments to perl:
-;; #!/usr/bin/perl -P-	 # -*-Perl-*-
-;; To handle files included with do 'filename.pl';, add something like
-;; (setq auto-mode-alist (append (list (cons "\\.pl\\'" 'perl-mode))
-;;                               auto-mode-alist))
-;; to your .emacs file; otherwise the .pl suffix defaults to prolog-mode.
-
-;; This code is based on the 18.53 version c-mode.el, with extensive
-;; rewriting.  Most of the features of c-mode survived intact.
-
-;; I added a new feature which adds functionality to TAB; it is controlled
-;; by the variable perl-tab-to-comment.  With it enabled, TAB does the
-;; first thing it can from the following list:  change the indentation;
-;; move past leading white space; delete an empty comment; reindent a
-;; comment; move to end of line; create an empty comment; tell you that
-;; the line ends in a quoted string, or has a # which should be a \#.
-
-;; If your machine is slow, you may want to remove some of the bindings
-;; to electric-perl-terminator.  I changed the indenting defaults to be
-;; what Larry Wall uses in perl/lib, but left in all the options.
-
-;; I also tuned a few things:  comments and labels starting in column
-;; zero are left there by indent-perl-exp; perl-beginning-of-function
-;; goes back to the first open brace/paren in column zero, the open brace
-;; in 'sub ... {', or the equal sign in 'format ... ='; indent-perl-exp
-;; (meta-^q) indents from the current line through the close of the next
-;; brace/paren, so you don't need to start exactly at a brace or paren.
-
-;; It may be good style to put a set of redundant braces around your
-;; main program.  This will let you reindent it with meta-^q.
-
-;; Known problems (these are all caused by limitations in the Emacs Lisp
-;; parsing routine (parse-partial-sexp), which was not designed for such
-;; a rich language; writing a more suitable parser would be a big job):
-;; 1)  Regular expression delimiters do not act as quotes, so special
-;;       characters such as `'"#:;[](){} may need to be backslashed
-;;       in regular expressions and in both parts of s/// and tr///.
-;; 2)  The globbing syntax <pattern> is not recognized, so special
-;;       characters in the pattern string must be backslashed.
-;; 3)  The q, qq, and << quoting operators are not recognized; see below.
-;; 4)  \ (backslash) always quotes the next character, so '\' is
-;;       treated as the start of a string.  Use "\\" as a work-around.
-;; 5)  To make variables such a $' and $#array work, perl-mode treats
-;;       $ just like backslash, so '$' is the same as problem 5.
-;; 6)  Unfortunately, treating $ like \ makes ${var} be treated as an
-;;       unmatched }.  See below.
-;; 7)  When ' (quote) is used as a package name separator, perl-mode
-;;       doesn't understand, and thinks it is seeing a quoted string.
-
-;; Here are some ugly tricks to bypass some of these problems:  the perl
-;; expression /`/ (that's a back-tick) usually evaluates harmlessly,
-;; but will trick perl-mode into starting a quoted string, which
-;; can be ended with another /`/.  Assuming you have no embedded
-;; back-ticks, this can used to help solve problem 3:
-;;
-;;     /`/; $ugly = q?"'$?; /`/;
-;;
-;; To solve problem 6, add a /{/; before each use of ${var}:
-;;     /{/; while (<${glob_me}>) ...
-;;
-;; Problem 7 is even worse, but this 'fix' does work :-(
-;;     $DB'stop#'
-;;         [$DB'line#'
-;;          ] =~ s/;9$//;
-
-;;; Code:
-
-(defvar perl-mode-abbrev-table nil
-  "Abbrev table in use in perl-mode buffers.")
-(define-abbrev-table 'perl-mode-abbrev-table ())
-
-(defvar perl-mode-map ()
-  "Keymap used in Perl mode.")
-(if perl-mode-map
-    ()
-  (setq perl-mode-map (make-sparse-keymap))
-  (define-key perl-mode-map "{" 'electric-perl-terminator)
-  (define-key perl-mode-map "}" 'electric-perl-terminator)
-  (define-key perl-mode-map ";" 'electric-perl-terminator)
-  (define-key perl-mode-map ":" 'electric-perl-terminator)
-  (define-key perl-mode-map "\e\C-a" 'perl-beginning-of-function)
-  (define-key perl-mode-map "\e\C-e" 'perl-end-of-function)
-  (define-key perl-mode-map "\e\C-h" 'mark-perl-function)
-  (define-key perl-mode-map "\e\C-q" 'indent-perl-exp)
-  (define-key perl-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key perl-mode-map "\t" 'perl-indent-command))
-
-(autoload 'c-macro-expand "cmacexp"
-  "Display the result of expanding all C macros occurring in the region.
-The expansion is entirely correct because it uses the C preprocessor."
-  t)
-
-(defvar perl-mode-syntax-table nil
-  "Syntax table in use in perl-mode buffers.")
-
-(if perl-mode-syntax-table
-    ()
-  (setq perl-mode-syntax-table (make-syntax-table (standard-syntax-table)))
-  (modify-syntax-entry ?\n ">" perl-mode-syntax-table)
-  (modify-syntax-entry ?# "<" perl-mode-syntax-table)
-  (modify-syntax-entry ?$ "/" perl-mode-syntax-table)
-  (modify-syntax-entry ?% "." perl-mode-syntax-table)
-  (modify-syntax-entry ?& "." perl-mode-syntax-table)
-  (modify-syntax-entry ?\' "\"" perl-mode-syntax-table)
-  (modify-syntax-entry ?* "." perl-mode-syntax-table)
-  (modify-syntax-entry ?+ "." perl-mode-syntax-table)
-  (modify-syntax-entry ?- "." perl-mode-syntax-table)
-  (modify-syntax-entry ?/ "." perl-mode-syntax-table)
-  (modify-syntax-entry ?< "." perl-mode-syntax-table)
-  (modify-syntax-entry ?= "." perl-mode-syntax-table)
-  (modify-syntax-entry ?> "." perl-mode-syntax-table)
-  (modify-syntax-entry ?\\ "\\" perl-mode-syntax-table)
-  (modify-syntax-entry ?` "\"" perl-mode-syntax-table)
-  (modify-syntax-entry ?| "." perl-mode-syntax-table)
-)
-
-(defvar perl-imenu-generic-expression
-  '(
-    ;; Functions
-    (nil "^sub\\s-+\\([-A-Za-z0-9+_:]+\\)\\(\\s-\\|\n\\)*{" 1 )
-    ;;Variables
-    ("Variables" "^\\([$@%][-A-Za-z0-9+_:]+\\)\\s-*=" 1 )
-    ("Packages" "^package\\s-+\\([-A-Za-z0-9+_:]+\\);" 1 )
-    )
-  "Imenu generic expression for Perl mode.  See `imenu-generic-expression'.")
-
-;; Regexps updated with help from Tom Tromey <tromey@cambric.colorado.edu> and
-;; Jim Campbell <jec@murzim.ca.boeing.com>.
-
-(defconst perl-font-lock-keywords-1
-  '(;; What is this for?
-    ;;("\\(--- .* ---\\|=== .* ===\\)" . font-lock-string-face)
-    ;;
-    ;; Fontify preprocessor statements as we do in `c-font-lock-keywords'.
-    ;; Ilya Zakharevich <ilya@math.ohio-state.edu> thinks this is a bad idea.
-    ("^#[ \t]*include[ \t]+\\(<[^>\"\n]+>\\)" 1 font-lock-string-face)
-    ("^#[ \t]*define[ \t]+\\(\\sw+\\)(" 1 font-lock-function-name-face)
-    ("^#[ \t]*if\\>"
-     ("\\<\\(defined\\)\\>[ \t]*(?\\(\\sw+\\)?" nil nil
-      (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t)))
-    ("^#[ \t]*\\(\\sw+\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-reference-face) (2 font-lock-variable-name-face nil t))
-    ;;
-    ;; Fontify function and package names in declarations.
-    ("\\<\\(package\\|sub\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-    ("\\<\\(import\\|no\\|require\\|use\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-keyword-face) (2 font-lock-reference-face nil t)))
-  "Subdued level highlighting for Perl mode.")
-
-(defconst perl-font-lock-keywords-2
-  (append perl-font-lock-keywords-1
-   (list
-    ;;
-    ;; Fontify keywords, except those fontified otherwise.
-;   (make-regexp '("if" "until" "while" "elsif" "else" "unless" "do" "dump"
-;  "for" "foreach" "exit" "die"
-;  "BEGIN" "END" "return" "exec" "eval"))
-    (concat "\\<\\("
-	    "BEGIN\\|END\\|d\\(ie\\|o\\|ump\\)\\|"
-	    "e\\(ls\\(e\\|if\\)\\|val\\|x\\(ec\\|it\\)\\)\\|"
-	    "for\\(\\|each\\)\\|if\\|return\\|un\\(less\\|til\\)\\|while"
-	    "\\)\\>")
-    ;;
-    ;; Fontify local and my keywords as types.
-    '("\\<\\(local\\|my\\)\\>" . font-lock-type-face)
-    ;;
-    ;; Fontify function, variable and file name references.
-    '("&\\(\\sw+\\)" 1 font-lock-function-name-face)
-    ;; Additionally underline non-scalar variables.  Maybe this is a bad idea.
-    ;;'("[$@%*][#{]?\\(\\sw+\\)" 1 font-lock-variable-name-face)
-    '("[$*]{?\\(\\sw+\\)" 1 font-lock-variable-name-face)
-    '("\\([@%]\\|\\$#\\)\\(\\sw+\\)"
-      (2 (cons font-lock-variable-name-face '(underline))))
-    '("<\\(\\sw+\\)>" 1 font-lock-reference-face)
-    ;;
-    ;; Fontify keywords with/and labels as we do in `c++-font-lock-keywords'.
-    '("\\<\\(continue\\|goto\\|last\\|next\\|redo\\)\\>[ \t]*\\(\\sw+\\)?"
-      (1 font-lock-keyword-face) (2 font-lock-reference-face nil t))
-    '("^[ \t]*\\(\\sw+\\)[ \t]*:[^:]" 1 font-lock-reference-face)))
-  "Gaudy level highlighting for Perl mode.")
-
-(defvar perl-font-lock-keywords perl-font-lock-keywords-1
-  "Default expressions to highlight in Perl mode.")
-
-
-(defvar perl-indent-level 4
-  "*Indentation of Perl statements with respect to containing block.")
-(defvar perl-continued-statement-offset 4
-  "*Extra indent for lines not starting new statements.")
-(defvar perl-continued-brace-offset -4
-  "*Extra indent for substatements that start with open-braces.
-This is in addition to `perl-continued-statement-offset'.")
-(defvar perl-brace-offset 0
-  "*Extra indentation for braces, compared with other text in same context.")
-(defvar perl-brace-imaginary-offset 0
-  "*Imagined indentation of an open brace that actually follows a statement.")
-(defvar perl-label-offset -2
-  "*Offset of Perl label lines relative to usual indentation.")
-
-(defvar perl-tab-always-indent t
-  "*Non-nil means TAB in Perl mode always indents the current line.
-Otherwise it inserts a tab character if you type it past the first
-nonwhite character on the line.")
-
-;; I changed the default to nil for consistency with general Emacs
-;; conventions -- rms.
-(defvar perl-tab-to-comment nil
-  "*Non-nil means TAB moves to eol or makes a comment in some cases.
-For lines which don't need indenting, TAB either indents an
-existing comment, moves to end-of-line, or if at end-of-line already,
-create a new comment.")
-
-(defvar perl-nochange ";?#\\|\f\\|\\s(\\|\\(\\w\\|\\s_\\)+:"
-  "*Lines starting with this regular expression are not auto-indented.")
-
-;;;###autoload
-(defun perl-mode ()
-  "Major mode for editing Perl code.
-Expression and list commands understand all Perl brackets.
-Tab indents for Perl code.
-Comments are delimited with # ... \\n.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-\\{perl-mode-map}
-Variables controlling indentation style:
- perl-tab-always-indent
-    Non-nil means TAB in Perl mode should always indent the current line,
-    regardless of where in the line point is when the TAB command is used.
- perl-tab-to-comment
-    Non-nil means that for lines which don't need indenting, TAB will
-    either delete an empty comment, indent an existing comment, move 
-    to end-of-line, or if at end-of-line already, create a new comment.
- perl-nochange
-    Lines starting with this regular expression are not auto-indented.
- perl-indent-level
-    Indentation of Perl statements within surrounding block.
-    The surrounding block's indentation is the indentation
-    of the line on which the open-brace appears.
- perl-continued-statement-offset
-    Extra indentation given to a substatement, such as the
-    then-clause of an if or body of a while.
- perl-continued-brace-offset
-    Extra indentation given to a brace that starts a substatement.
-    This is in addition to `perl-continued-statement-offset'.
- perl-brace-offset
-    Extra indentation for line if it starts with an open brace.
- perl-brace-imaginary-offset
-    An open brace following other text is treated as if it were
-    this far to the right of the start of its line.
- perl-label-offset
-    Extra indentation for line that is a label.
-
-Various indentation styles:       K&R  BSD  BLK  GNU  LW
-  perl-indent-level                5    8    0    2    4
-  perl-continued-statement-offset  5    8    4    2    4
-  perl-continued-brace-offset      0    0    0    0   -4
-  perl-brace-offset               -5   -8    0    0    0
-  perl-brace-imaginary-offset      0    0    4    0    0
-  perl-label-offset               -5   -8   -2   -2   -2
-
-Turning on Perl mode runs the normal hook `perl-mode-hook'."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map perl-mode-map)
-  (setq major-mode 'perl-mode)
-  (setq mode-name "Perl")
-  (setq local-abbrev-table perl-mode-abbrev-table)
-  (set-syntax-table perl-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'perl-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-  (make-local-variable 'comment-column)
-  (setq comment-column 32)
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "\\(^\\|\\s-\\);?#+ *")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'perl-comment-indent)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  ;; Tell font-lock.el how to handle Perl.
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '((perl-font-lock-keywords
-			      perl-font-lock-keywords-1
-			      perl-font-lock-keywords-2)
-			     nil nil ((?\_ . "w"))))
-  ;; Tell imenu how to handle Perl.
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression perl-imenu-generic-expression)
-  (run-hooks 'perl-mode-hook))
-
-;; This is used by indent-for-comment
-;; to decide how much to indent a comment in Perl code
-;; based on its context.
-(defun perl-comment-indent ()
-  (if (and (bolp) (not (eolp)))
-      0					;Existing comment at bol stays there.
-    (save-excursion
-      (skip-chars-backward " \t")
-      (max (if (bolp)			;Else indent at comment column
-	       0			; except leave at least one space if
-	     (1+ (current-column)))	; not at beginning of line.
-	   comment-column))))
-
-(defun electric-perl-terminator (arg)
-  "Insert character and adjust indentation.
-If at end-of-line, and not in a comment or a quote, correct the's indentation."
-  (interactive "P")
-  (let ((insertpos (point)))
-    (and (not arg)			; decide whether to indent
-	 (eolp)
-	 (save-excursion
-	   (beginning-of-line)
-	   (and (not			; eliminate comments quickly
-		 (and comment-start-skip
-		      (re-search-forward comment-start-skip insertpos t)) )
-		(or (/= last-command-char ?:)
-		    ;; Colon is special only after a label ....
-		    (looking-at "\\s-*\\(\\w\\|\\s_\\)+$"))
-		(let ((pps (parse-partial-sexp 
-			    (perl-beginning-of-function) insertpos)))
-		  (not (or (nth 3 pps) (nth 4 pps) (nth 5 pps))))))
-	 (progn				; must insert, indent, delete
-	   (insert-char last-command-char 1)
-	   (perl-indent-line)
-	   (delete-char -1))))
-  (self-insert-command (prefix-numeric-value arg)))
-
-;; not used anymore, but may be useful someday:
-;;(defun perl-inside-parens-p ()
-;;  (condition-case ()
-;;      (save-excursion
-;;	(save-restriction
-;;	  (narrow-to-region (point)
-;;			    (perl-beginning-of-function))
-;;	  (goto-char (point-max))
-;;	  (= (char-after (or (scan-lists (point) -1 1) (point-min))) ?\()))
-;;    (error nil)))
-
-(defun perl-indent-command (&optional arg)
-  "Indent current line as Perl code, or optionally, insert a tab character.
-
-With an argument, indent the current line, regardless of other options.
-
-If `perl-tab-always-indent' is nil and point is not in the indentation
-area at the beginning of the line, simply insert a tab.
-
-Otherwise, indent the current line.  If point was within the indentation
-area it is moved to the end of the indentation area.  If the line was
-already indented properly and point was not within the indentation area,
-and if `perl-tab-to-comment' is non-nil (the default), then do the first
-possible action from the following list:
-
-  1) delete an empty comment
-  2) move forward to start of comment, indenting if necessary
-  3) move forward to end of line
-  4) create an empty comment
-  5) move backward to start of comment, indenting if necessary."
-  (interactive "P")
-  (if arg				; If arg, just indent this line
-      (perl-indent-line "\f")
-    (if (and (not perl-tab-always-indent)
-	     (> (current-column) (current-indentation)))
-	(insert-tab)
-      (let (bof lsexp delta (oldpnt (point)))
-	(beginning-of-line) 
-	(setq lsexp (point))
-	(setq bof (perl-beginning-of-function))
-	(goto-char oldpnt)
-	(setq delta (perl-indent-line "\f\\|;?#" bof))
-	(and perl-tab-to-comment
-	     (= oldpnt (point))		; done if point moved
-	     (if (listp delta)		; if line starts in a quoted string
-		 (setq lsexp (or (nth 2 delta) bof))
-	       (= delta 0))		; done if indenting occurred
-	     (let (eol state)
-	       (end-of-line) 
-	       (setq eol (point))
-	       (if (= (char-after bof) ?=)
-		   (if (= oldpnt eol)
-		       (message "In a format statement"))     
-		 (setq state (parse-partial-sexp lsexp eol))
-		 (if (nth 3 state)
-		     (if (= oldpnt eol)	; already at eol in a string
-			 (message "In a string which starts with a %c."
-				  (nth 3 state)))
-		   (if (not (nth 4 state))
-		       (if (= oldpnt eol) ; no comment, create one?
-			   (indent-for-comment))
-		     (beginning-of-line)
-		     (if (and comment-start-skip
-			      (re-search-forward comment-start-skip eol 'move))
-			 (if (eolp)
-			     (progn	; kill existing comment
-			       (goto-char (match-beginning 0))
-			       (skip-chars-backward " \t")
-			       (kill-region (point) eol))
-			   (if (or (< oldpnt (point)) (= oldpnt eol))
-			       (indent-for-comment) ; indent existing comment
-			     (end-of-line)))
-		       (if (/= oldpnt eol)
-			   (end-of-line)
-			 (message "Use backslash to quote # characters.")
-			 (ding t))))))))))))
-
-(defun perl-indent-line (&optional nochange parse-start)
-  "Indent current line as Perl code.
-Return the amount the indentation 
-changed by, or (parse-state) if line starts in a quoted string."
-  (let ((case-fold-search nil)
-	(pos (- (point-max) (point)))
-	(bof (or parse-start (save-excursion (perl-beginning-of-function))))
-	beg indent shift-amt)
-    (beginning-of-line)
-    (setq beg (point))
-    (setq shift-amt
-	  (cond ((= (char-after bof) ?=) 0)
-		((listp (setq indent (calculate-perl-indent bof))) indent)
-		((looking-at (or nochange perl-nochange)) 0)
-		(t
-		 (skip-chars-forward " \t\f")
-		 (cond ((looking-at "\\(\\w\\|\\s_\\)+:")
-			(setq indent (max 1 (+ indent perl-label-offset))))
-		       ((= (following-char) ?})
-			(setq indent (- indent perl-indent-level)))
-		       ((= (following-char) ?{)
-			(setq indent (+ indent perl-brace-offset))))
-		 (- indent (current-column)))))
-    (skip-chars-forward " \t\f")
-    (if (and (numberp shift-amt) (/= 0 shift-amt))
-	(progn (delete-region beg (point))
-	       (indent-to indent)))
-    ;; If initial point was within line's indentation,
-    ;; position after the indentation.  Else stay at same point in text.
-    (if (> (- (point-max) pos) (point))
-	(goto-char (- (point-max) pos)))
-    shift-amt))
-
-(defun calculate-perl-indent (&optional parse-start)
-  "Return appropriate indentation for current line as Perl code.
-In usual case returns an integer: the column to indent to.
-Returns (parse-state) if line starts inside a string."
-  (save-excursion
-    (beginning-of-line)
-    (let ((indent-point (point))
-	  (case-fold-search nil)
-	  (colon-line-end 0)
-	  state containing-sexp)
-      (if parse-start			;used to avoid searching
-	  (goto-char parse-start)
-	(perl-beginning-of-function))
-      (while (< (point) indent-point)	;repeat until right sexp
-	(setq parse-start (point))
-	(setq state (parse-partial-sexp (point) indent-point 0))
-; state = (depth_in_parens innermost_containing_list last_complete_sexp
-;          string_terminator_or_nil inside_commentp following_quotep
-;          minimum_paren-depth_this_scan)
-; Parsing stops if depth in parentheses becomes equal to third arg.
-	(setq containing-sexp (nth 1 state)))
-      (cond ((nth 3 state) state)	; In a quoted string?
-	    ((null containing-sexp)	; Line is at top level.
-	     (skip-chars-forward " \t\f")
-	     (if (= (following-char) ?{)
-		 0   ; move to beginning of line if it starts a function body
-	       ;; indent a little if this is a continuation line
-	       (perl-backward-to-noncomment)
-	       (if (or (bobp)
-		       (memq (preceding-char) '(?\; ?\})))
-		   0 perl-continued-statement-offset)))
-	    ((/= (char-after containing-sexp) ?{)
-	     ;; line is expression, not statement:
-	     ;; indent to just after the surrounding open.
-	     (goto-char (1+ containing-sexp))
-	     (current-column))
-	    (t
-	     ;; Statement level.  Is it a continuation or a new statement?
-	     ;; Find previous non-comment character.
-	     (perl-backward-to-noncomment)
-	     ;; Back up over label lines, since they don't
-	     ;; affect whether our line is a continuation.
-	     (while (or (eq (preceding-char) ?\,)
-			(and (eq (preceding-char) ?:)
-			     (memq (char-syntax (char-after (- (point) 2)))
-				   '(?w ?_))))
-	       (if (eq (preceding-char) ?\,)
-		   (perl-backward-to-start-of-continued-exp containing-sexp)
-		 (beginning-of-line))
-	       (perl-backward-to-noncomment))
-	     ;; Now we get the answer.
-	     (if (not (memq (preceding-char) '(?\; ?\} ?\{)))
-		 ;; This line is continuation of preceding line's statement;
-		 ;; indent  perl-continued-statement-offset  more than the
-		 ;; previous line of the statement.
-		 (progn
-		   (perl-backward-to-start-of-continued-exp containing-sexp)
-		   (+ perl-continued-statement-offset (current-column)
-		      (if (save-excursion (goto-char indent-point)
-					  (looking-at "[ \t]*{"))
-			  perl-continued-brace-offset 0)))
-	       ;; This line starts a new statement.
-	       ;; Position at last unclosed open.
-	       (goto-char containing-sexp)
-	       (or
-		 ;; If open paren is in col 0, close brace is special
-		 (and (bolp)
-		      (save-excursion (goto-char indent-point)
-				      (looking-at "[ \t]*}"))
-		      perl-indent-level)
-		 ;; Is line first statement after an open-brace?
-		 ;; If no, find that first statement and indent like it.
-		 (save-excursion
-		   (forward-char 1)
-		   ;; Skip over comments and labels following openbrace.
-		   (while (progn
-			    (skip-chars-forward " \t\f\n")
-			    (cond ((looking-at ";?#")
-				   (forward-line 1) t)
-				  ((looking-at "\\(\\w\\|\\s_\\)+:")
-				   (save-excursion 
-				     (end-of-line) 
-				     (setq colon-line-end (point)))
-				   (search-forward ":")))))
-		   ;; The first following code counts
-		   ;; if it is before the line we want to indent.
-		   (and (< (point) indent-point)
-			(if (> colon-line-end (point))
-			    (- (current-indentation) perl-label-offset)
-			  (current-column))))
-		 ;; If no previous statement,
-		 ;; indent it relative to line brace is on.
-		 ;; For open paren in column zero, don't let statement
-		 ;; start there too.  If perl-indent-level is zero,
-		 ;; use perl-brace-offset + perl-continued-statement-offset
-		 ;; For open-braces not the first thing in a line,
-		 ;; add in perl-brace-imaginary-offset.
-		 (+ (if (and (bolp) (zerop perl-indent-level))
-			(+ perl-brace-offset perl-continued-statement-offset)
-		      perl-indent-level)
-		    ;; Move back over whitespace before the openbrace.
-		    ;; If openbrace is not first nonwhite thing on the line,
-		    ;; add the perl-brace-imaginary-offset.
-		    (progn (skip-chars-backward " \t")
-			   (if (bolp) 0 perl-brace-imaginary-offset))
-		    ;; If the openbrace is preceded by a parenthesized exp,
-		    ;; move to the beginning of that;
-		    ;; possibly a different line
-		    (progn
-		      (if (eq (preceding-char) ?\))
-			  (forward-sexp -1))
-		      ;; Get initial indentation of the line we are on.
-		      (current-indentation))))))))))
-
-(defun perl-backward-to-noncomment ()
-  "Move point backward to after the first non-white-space, skipping comments."
-  (interactive)
-  (let (opoint stop)
-    (while (not stop)
-      (setq opoint (point))
-      (beginning-of-line)
-      (if (and comment-start-skip
-	       (re-search-forward comment-start-skip opoint 'move 1))
-	  (progn (goto-char (match-end 1))
-		 (skip-chars-forward ";")))
-      (skip-chars-backward " \t\f")
-      (setq stop (or (bobp)
-		     (not (bolp))
-		     (forward-char -1))))))
-
-(defun perl-backward-to-start-of-continued-exp (lim)
-  (if (= (preceding-char) ?\))
-      (forward-sexp -1))
-  (beginning-of-line)
-  (if (<= (point) lim)
-      (goto-char (1+ lim)))
-  (skip-chars-forward " \t\f"))
-
-;; note: this may be slower than the c-mode version, but I can understand it.
-(defun indent-perl-exp ()
-  "Indent each line of the Perl grouping following point."
-  (interactive)
-  (let* ((case-fold-search nil)
-	 (oldpnt (point-marker))
-	 (bof-mark (save-excursion
-		     (end-of-line 2)
-		     (perl-beginning-of-function)
-		     (point-marker)))
-	 eol last-mark lsexp-mark delta)
-    (if (= (char-after (marker-position bof-mark)) ?=)
-	(message "Can't indent a format statement")
-      (message "Indenting Perl expression...")
-      (save-excursion (end-of-line) (setq eol (point)))
-      (save-excursion			; locate matching close paren
-	(while (and (not (eobp)) (<= (point) eol))
-	  (parse-partial-sexp (point) (point-max) 0))
-	(setq last-mark (point-marker)))
-      (setq lsexp-mark bof-mark)
-      (beginning-of-line)
-      (while (< (point) (marker-position last-mark))
-	(setq delta (perl-indent-line nil (marker-position bof-mark)))
-	(if (numberp delta)		; unquoted start-of-line?
-	    (progn 
-	      (if (eolp)
-		  (delete-horizontal-space))
-	      (setq lsexp-mark (point-marker))))
-	(end-of-line)
-	(setq eol (point))
-	(if (nth 4 (parse-partial-sexp (marker-position lsexp-mark) eol))
-	    (progn			; line ends in a comment
-	      (beginning-of-line)
-	      (if (or (not (looking-at "\\s-*;?#"))
-		      (listp delta)
-		      (and (/= 0 delta)
-			   (= (- (current-indentation) delta) comment-column)))
-		  (if (and comment-start-skip
-			   (re-search-forward comment-start-skip eol t))
-		      (indent-for-comment))))) ; indent existing comment
-	(forward-line 1))
-      (goto-char (marker-position oldpnt))
-      (message "Indenting Perl expression...done"))))
-
-(defun perl-beginning-of-function (&optional arg)
-  "Move backward to next beginning-of-function, or as far as possible.
-With argument, repeat that many times; negative args move forward.
-Returns new value of point in all cases."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (if (< arg 0) (forward-char 1))
-  (and (/= arg 0)
-       (re-search-backward "^\\s(\\|^\\s-*sub\\b[^{]+{\\|^\\s-*format\\b[^=]*=\\|^\\."
-			   nil 'move arg)
-       (goto-char (1- (match-end 0))))
-  (point))
-
-;; note: this routine is adapted directly from emacs lisp.el, end-of-defun;
-;; no bugs have been removed :-)
-(defun perl-end-of-function (&optional arg)
-  "Move forward to next end-of-function.
-The end of a function is found by moving forward from the beginning of one.
-With argument, repeat that many times; negative args move backward."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (let ((first t))
-    (while (and (> arg 0) (< (point) (point-max)))
-      (let ((pos (point)) npos)
-	(while (progn
-		(if (and first
-			 (progn
-			  (forward-char 1)
-			  (perl-beginning-of-function 1)
-			  (not (bobp))))
-		    nil
-		  (or (bobp) (forward-char -1))
-		  (perl-beginning-of-function -1))
-		(setq first nil)
-		(forward-list 1)
-		(skip-chars-forward " \t")
-		(if (looking-at "[#\n]")
-		    (forward-line 1))
-		(<= (point) pos))))
-      (setq arg (1- arg)))
-    (while (< arg 0)
-      (let ((pos (point)))
-	(perl-beginning-of-function 1)
-	(forward-sexp 1)
-	(forward-line 1)
-	(if (>= (point) pos)
-	    (if (progn (perl-beginning-of-function 2) (not (bobp)))
-		(progn
-		  (forward-list 1)
-		  (skip-chars-forward " \t")
-		  (if (looking-at "[#\n]")
-		      (forward-line 1)))
-	      (goto-char (point-min)))))
-      (setq arg (1+ arg)))))
-
-(defun mark-perl-function ()
-  "Put mark at end of Perl function, point at beginning."
-  (interactive)
-  (push-mark (point))
-  (perl-end-of-function)
-  (push-mark (point))
-  (perl-beginning-of-function)
-  (backward-paragraph))
-
-(provide 'perl-mode)
-
-;;; perl-mode.el ends here
diff --git a/lisp/progmodes/prolog.el b/lisp/progmodes/prolog.el
deleted file mode 100644
index 05a3c7ed5ac..00000000000
--- a/lisp/progmodes/prolog.el
+++ /dev/null
@@ -1,273 +0,0 @@
-;;; prolog.el --- major mode for editing and running Prolog under Emacs
-
-;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: languages
-
-;; 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 provides a major mode for editing Prolog.  It knows
-;; about Prolog syntax and comments, and can send regions to an inferior
-;; Prolog interpreter process.
-
-;;; Code:
-
-(defvar prolog-mode-syntax-table nil)
-(defvar prolog-mode-abbrev-table nil)
-(defvar prolog-mode-map nil)
-  
-(defvar prolog-program-name "prolog"
-  "*Program name for invoking an inferior Prolog with `run-prolog'.")
-
-(defvar prolog-consult-string "reconsult(user).\n"
-  "*(Re)Consult mode (for C-Prolog and Quintus Prolog). ")
-
-(defvar prolog-compile-string "compile(user).\n"
-  "*Compile mode (for Quintus Prolog).")
-
-(defvar prolog-eof-string "end_of_file.\n"
-  "*String that represents end of file for prolog.
-nil means send actual operating system end of file.")
-
-(defvar prolog-indent-width 4)
-
-(if prolog-mode-syntax-table
-    ()
-  (let ((table (make-syntax-table)))
-    (modify-syntax-entry ?_ "w" table)
-    (modify-syntax-entry ?\\ "\\" table)
-    (modify-syntax-entry ?/ "." table)
-    (modify-syntax-entry ?* "." table)
-    (modify-syntax-entry ?+ "." table)
-    (modify-syntax-entry ?- "." table)
-    (modify-syntax-entry ?= "." table)
-    (modify-syntax-entry ?% "<" table)
-    (modify-syntax-entry ?\n ">" table)
-    (modify-syntax-entry ?< "." table)
-    (modify-syntax-entry ?> "." table)
-    (modify-syntax-entry ?\' "\"" table)
-    (setq prolog-mode-syntax-table table)))
-
-(define-abbrev-table 'prolog-mode-abbrev-table ())
-
-(defun prolog-mode-variables ()
-  (set-syntax-table prolog-mode-syntax-table)
-  (setq local-abbrev-table prolog-mode-abbrev-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "%%\\|$\\|" page-delimiter)) ;'%%..'
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'prolog-indent-line)
-  (make-local-variable 'comment-start)
-  (setq comment-start "%")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "%+ *")
-  (make-local-variable 'comment-column)
-  (setq comment-column 48)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'prolog-comment-indent))
-
-(defun prolog-mode-commands (map)
-  (define-key map "\t" 'prolog-indent-line)
-  (define-key map "\e\C-x" 'prolog-consult-region))
-
-(if prolog-mode-map
-    nil
-  (setq prolog-mode-map (make-sparse-keymap))
-  (prolog-mode-commands prolog-mode-map))
-
-;;;###autoload
-(defun prolog-mode ()
-  "Major mode for editing Prolog code for Prologs.
-Blank lines and `%%...' separate paragraphs.  `%'s start comments.
-Commands:
-\\{prolog-mode-map}
-Entry to this mode calls the value of `prolog-mode-hook'
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map prolog-mode-map)
-  (setq major-mode 'prolog-mode)
-  (setq mode-name "Prolog")
-  (prolog-mode-variables)
-  (run-hooks 'prolog-mode-hook))
-
-(defun prolog-indent-line (&optional whole-exp)
-  "Indent current line as Prolog code.
-With argument, indent any additional lines of the same clause
-rigidly along with this one (not yet)."
-  (interactive "p")
-  (let ((indent (prolog-indent-level))
-	(pos (- (point-max) (point))) beg)
-    (beginning-of-line)
-    (setq beg (point))
-    (skip-chars-forward " \t")
-    (if (zerop (- indent (current-column)))
-	nil
-      (delete-region beg (point))
-      (indent-to indent))
-    (if (> (- (point-max) pos) (point))
-	(goto-char (- (point-max) pos)))
-    ))
-
-(defun prolog-indent-level ()
-  "Compute prolog indentation level."
-  (save-excursion
-    (beginning-of-line)
-    (skip-chars-forward " \t")
-    (cond
-     ((looking-at "%%%") 0)		;Large comment starts
-     ((looking-at "%[^%]") comment-column) ;Small comment starts
-     ((bobp) 0)				;Beginning of buffer
-     (t
-      (let ((empty t) ind more less)
-	(if (looking-at ")")
-	    (setq less t)		;Find close
-	  (setq less nil))
-	;; See previous indentation
-	(while empty
-	  (forward-line -1)
-	  (beginning-of-line)
- 	  (if (bobp)
- 	      (setq empty nil)
- 	    (skip-chars-forward " \t")
- 	    (if (not (or (looking-at "%[^%]") (looking-at "\n")))
- 		(setq empty nil))))
- 	(if (bobp)
- 	    (setq ind 0)		;Beginning of buffer
-	  (setq ind (current-column)))	;Beginning of clause
-	;; See its beginning
-	(if (looking-at "%%[^%]")
-	    ind
-	  ;; Real prolog code
-	  (if (looking-at "(")
-	      (setq more t)		;Find open
-	    (setq more nil))
-	  ;; See its tail
-	  (end-of-prolog-clause)
-	  (or (bobp) (forward-char -1))
-	  (cond ((looking-at "[,(;>]")
-		 (if (and more (looking-at "[^,]"))
-		     (+ ind prolog-indent-width) ;More indentation
-		   (max tab-width ind))) ;Same indentation
-		((looking-at "-") tab-width) ;TAB
-		((or less (looking-at "[^.]"))
-		 (max (- ind prolog-indent-width) 0)) ;Less indentation
-		(t 0))			;No indentation
-	  )))
-     )))
-
-(defun end-of-prolog-clause ()
-  "Go to end of clause in this line."
-  (beginning-of-line 1)
-  (let* ((eolpos (save-excursion (end-of-line) (point))))
-    (if (re-search-forward comment-start-skip eolpos 'move)
-	(goto-char (match-beginning 0)))
-    (skip-chars-backward " \t")))
-
-(defun prolog-comment-indent ()
-  "Compute prolog comment indentation."
-  (cond ((looking-at "%%%") 0)
-	((looking-at "%%") (prolog-indent-level))
-	(t
-	 (save-excursion
-	       (skip-chars-backward " \t")
-	       ;; Insert one space at least, except at left margin.
-	       (max (+ (current-column) (if (bolp) 0 1))
-		    comment-column)))
-	))
-
-
-;;;
-;;; Inferior prolog mode
-;;;
-(defvar inferior-prolog-mode-map nil)
-
-(defun inferior-prolog-mode ()
-  "Major mode for interacting with an inferior Prolog process.
-
-The following commands are available:
-\\{inferior-prolog-mode-map}
-
-Entry to this mode calls the value of `prolog-mode-hook' with no arguments,
-if that value is non-nil.  Likewise with the value of `comint-mode-hook'.
-`prolog-mode-hook' is called after `comint-mode-hook'.
-
-You can send text to the inferior Prolog from other buffers
-using the commands `send-region', `send-string' and \\[prolog-consult-region].
-
-Commands:
-Tab indents for Prolog; with argument, shifts rest
- of expression rigidly with the current line.
-Paragraphs are separated only by blank lines and '%%'.
-'%'s start comments.
-
-Return at end of buffer sends line as input.
-Return not at end copies rest of line to end and sends it.
-\\[comint-kill-input] and \\[backward-kill-word] are kill commands, imitating normal Unix input editing.
-\\[comint-interrupt-subjob] interrupts the shell or its current subjob if any.
-\\[comint-stop-subjob] stops. \\[comint-quit-subjob] sends quit signal."
-  (interactive)
-  (require 'comint)
-  (comint-mode)
-  (setq major-mode 'inferior-prolog-mode
-	mode-name "Inferior Prolog"
-	comint-prompt-regexp "^| [ ?][- ] *")
-  (prolog-mode-variables)
-  (if inferior-prolog-mode-map nil
-    (setq inferior-prolog-mode-map (copy-keymap comint-mode-map))
-    (prolog-mode-commands inferior-prolog-mode-map))
-  (use-local-map inferior-prolog-mode-map)
-  (run-hooks 'prolog-mode-hook))
-
-;;;###autoload
-(defun run-prolog ()
-  "Run an inferior Prolog process, input and output via buffer *prolog*."
-  (interactive)
-  (require 'comint)
-  (switch-to-buffer (make-comint "prolog" prolog-program-name))
-  (inferior-prolog-mode))
-
-(defun prolog-consult-region (compile beg end)
-  "Send the region to the Prolog process made by \"M-x run-prolog\".
-If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
-  (interactive "P\nr")
-  (save-excursion
-    (if compile
-	(send-string "prolog" prolog-compile-string)
-      (send-string "prolog" prolog-consult-string))
-    (send-region "prolog" beg end)
-    (send-string "prolog" "\n")		;May be unnecessary
-    (if prolog-eof-string
-	(send-string "prolog" prolog-eof-string)
-      (process-send-eof "prolog")))) ;Send eof to prolog process.
-
-(defun prolog-consult-region-and-go (compile beg end)
-  "Send the region to the inferior Prolog, and switch to *prolog* buffer.
-If COMPILE (prefix arg) is not nil, use compile mode rather than consult mode."
-  (interactive "P\nr")
-  (prolog-consult-region compile beg end)
-  (switch-to-buffer "*prolog*"))
-
-;;; prolog.el ends here
diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el
deleted file mode 100644
index a4393df8ee7..00000000000
--- a/lisp/progmodes/scheme.el
+++ /dev/null
@@ -1,515 +0,0 @@
-;;; scheme.el --- Scheme mode, and its idiosyncratic commands.
-
-;; Copyright (C) 1986, 1987, 1988 Free Software Foundation, Inc.
-
-;; Author: Bill Rozas <jinz@prep.ai.mit.edu>
-;; Keywords: languages, lisp
-
-;; 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:
-
-;; Adapted from Lisp mode by Bill Rozas, jinx@prep.
-;; Initially a query replace of Lisp mode, except for the indentation 
-;; of special forms.  Probably the code should be merged at some point 
-;; so that there is sharing between both libraries.
-
-;;; Code:
-
-(defvar scheme-mode-syntax-table nil "")
-(if (not scheme-mode-syntax-table)
-    (let ((i 0))
-      (setq scheme-mode-syntax-table (make-syntax-table))
-      (set-syntax-table scheme-mode-syntax-table)
-
-      ;; Default is atom-constituent.
-      (while (< i 256)
-	(modify-syntax-entry i "_   ")
-	(setq i (1+ i)))
-
-      ;; Word components.
-      (setq i ?0)
-      (while (<= i ?9)
-	(modify-syntax-entry i "w   ")
-	(setq i (1+ i)))
-      (setq i ?A)
-      (while (<= i ?Z)
-	(modify-syntax-entry i "w   ")
-	(setq i (1+ i)))
-      (setq i ?a)
-      (while (<= i ?z)
-	(modify-syntax-entry i "w   ")
-	(setq i (1+ i)))
-
-      ;; Whitespace
-      (modify-syntax-entry ?\t "    ")
-      (modify-syntax-entry ?\n ">   ")
-      (modify-syntax-entry ?\f "    ")
-      (modify-syntax-entry ?\r "    ")
-      (modify-syntax-entry ?  "    ")
-
-      ;; These characters are delimiters but otherwise undefined.
-      ;; Brackets and braces balance for editing convenience.
-      (modify-syntax-entry ?[ "(]  ")
-      (modify-syntax-entry ?] ")[  ")
-      (modify-syntax-entry ?{ "(}  ")
-      (modify-syntax-entry ?} "){  ")
-      (modify-syntax-entry ?\| "  23")
-
-      ;; Other atom delimiters
-      (modify-syntax-entry ?\( "()  ")
-      (modify-syntax-entry ?\) ")(  ")
-      (modify-syntax-entry ?\; "<   ")
-      (modify-syntax-entry ?\" "\"    ")
-      (modify-syntax-entry ?' "  p")
-      (modify-syntax-entry ?` "  p")
-
-      ;; Special characters
-      (modify-syntax-entry ?, "_ p")
-      (modify-syntax-entry ?@ "_ p")
-      (modify-syntax-entry ?# "_ p14")
-      (modify-syntax-entry ?\\ "\\   ")))
-
-(defvar scheme-mode-abbrev-table nil "")
-(define-abbrev-table 'scheme-mode-abbrev-table ())
-
-(defun scheme-mode-variables ()
-  (set-syntax-table scheme-mode-syntax-table)
-  (setq local-abbrev-table scheme-mode-abbrev-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'scheme-indent-line)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (make-local-variable 'comment-start)
-  (setq comment-start ";")
-  (make-local-variable 'comment-start-skip)
-  ;; Look within the line for a ; following an even number of backslashes
-  ;; after either a non-backslash or the line beginning.
-  (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'scheme-comment-indent)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (setq mode-line-process '("" scheme-mode-line-process)))
-
-(defvar scheme-mode-line-process "")
-
-(defun scheme-mode-commands (map)
-  (define-key map "\t" 'scheme-indent-line)
-  (define-key map "\177" 'backward-delete-char-untabify)
-  (define-key map "\e\C-q" 'scheme-indent-sexp))
-
-(defvar scheme-mode-map nil)
-(if (not scheme-mode-map)
-    (progn
-      (setq scheme-mode-map (make-sparse-keymap))
-      (scheme-mode-commands scheme-mode-map)))
-
-;;;###autoload
-(defun scheme-mode ()
-  "Major mode for editing Scheme code.
-Editing commands are similar to those of lisp-mode.
-
-In addition, if an inferior Scheme process is running, some additional
-commands will be defined, for evaluating expressions and controlling
-the interpreter, and the state of the process will be displayed in the
-modeline of all Scheme buffers.  The names of commands that interact
-with the Scheme process start with \"xscheme-\".  For more information
-see the documentation for xscheme-interaction-mode.
-
-Commands:
-Delete converts tabs to spaces as it moves back.
-Blank lines separate paragraphs.  Semicolons start comments.
-\\{scheme-mode-map}
-Entry to this mode calls the value of scheme-mode-hook
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (scheme-mode-initialize)
-  (scheme-mode-variables)
-  (run-hooks 'scheme-mode-hook))
-
-(defun scheme-mode-initialize ()
-  (use-local-map scheme-mode-map)
-  (setq major-mode 'scheme-mode)
-  (setq mode-name "Scheme"))
-
-(defvar scheme-mit-dialect t
-  "If non-nil, scheme mode is specialized for MIT Scheme.
-Set this to nil if you normally use another dialect.")
-
-(defun scheme-comment-indent (&optional pos)
-  (save-excursion
-    (if pos (goto-char pos))
-    (cond ((looking-at ";;;") (current-column))
-	  ((looking-at ";;")
-	   (let ((tem (calculate-scheme-indent)))
-	     (if (listp tem) (car tem) tem)))
-	  (t
-	   (skip-chars-backward " \t")
-	   (max (if (bolp) 0 (1+ (current-column)))
-		comment-column)))))
-
-(defvar scheme-indent-offset nil "")
-(defvar scheme-indent-function 'scheme-indent-function "")
-
-(defun scheme-indent-line (&optional whole-exp)
-  "Indent current line as Scheme code.
-With argument, indent any additional lines of the same expression
-rigidly along with this one."
-  (interactive "P")
-  (let ((indent (calculate-scheme-indent)) shift-amt beg end
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (skip-chars-forward " \t")
-    (if (looking-at "[ \t]*;;;")
-	;; Don't alter indentation of a ;;; comment line.
-	nil
-      (if (listp indent) (setq indent (car indent)))
-      (setq shift-amt (- indent (current-column)))
-      (if (zerop shift-amt)
-	  nil
-	(delete-region beg (point))
-	(indent-to indent))
-      ;; If initial point was within line's indentation,
-      ;; position after the indentation.  Else stay at same point in text.
-      (if (> (- (point-max) pos) (point))
-	  (goto-char (- (point-max) pos)))
-      ;; If desired, shift remaining lines of expression the same amount.
-      (and whole-exp (not (zerop shift-amt))
-	   (save-excursion
-	     (goto-char beg)
-	     (forward-sexp 1)
-	     (setq end (point))
-	     (goto-char beg)
-	     (forward-line 1)
-	     (setq beg (point))
-	     (> end beg))
-	   (indent-code-rigidly beg end shift-amt)))))
-
-(defun calculate-scheme-indent (&optional parse-start)
-  "Return appropriate indentation for current line as scheme code.
-In usual case returns an integer: the column to indent to.
-Can instead return a list, whose car is the column to indent to.
-This means that following lines at the same level of indentation
-should not necessarily be indented the same way.
-The second element of the list is the buffer position
-of the start of the containing expression."
-  (save-excursion
-    (beginning-of-line)
-    (let ((indent-point (point)) state paren-depth desired-indent (retry t)
-	  last-sexp containing-sexp first-sexp-list-p)
-      (if parse-start
-	  (goto-char parse-start)
-	(beginning-of-defun))
-      ;; Find outermost containing sexp
-      (while (< (point) indent-point)
-	(setq state (parse-partial-sexp (point) indent-point 0)))
-      ;; Find innermost containing sexp
-      (while (and retry (setq paren-depth (car state)) (> paren-depth 0))
-	(setq retry nil)
-	(setq last-sexp (nth 2 state))
-	(setq containing-sexp (car (cdr state)))
-	;; Position following last unclosed open.
-	(goto-char (1+ containing-sexp))
-	;; Is there a complete sexp since then?
-	(if (and last-sexp (> last-sexp (point)))
-	    ;; Yes, but is there a containing sexp after that?
-	    (let ((peek (parse-partial-sexp last-sexp indent-point 0)))
-	      (if (setq retry (car (cdr peek))) (setq state peek))))
-	(if (not retry)
-	    ;; Innermost containing sexp found
-	    (progn
-	      (goto-char (1+ containing-sexp))
-	      (if (not last-sexp)
-		  ;; indent-point immediately follows open paren.
-		  ;; Don't call hook.
-		  (setq desired-indent (current-column))
-		;; Move to first sexp after containing open paren
-		(parse-partial-sexp (point) last-sexp 0 t)
-		(setq first-sexp-list-p (looking-at "\\s("))
-		(cond
-		 ((> (save-excursion (forward-line 1) (point))
-		     last-sexp)
-		  ;; Last sexp is on same line as containing sexp.
-		  ;; It's almost certainly a function call.
-		  (parse-partial-sexp (point) last-sexp 0 t)
-		  (if (/= (point) last-sexp)
-		      ;; Indent beneath first argument or, if only one sexp
-		      ;; on line, indent beneath that.
-		      (progn (forward-sexp 1)
-			     (parse-partial-sexp (point) last-sexp 0 t)))
-		  (backward-prefix-chars))
-		 (t
-		  ;; Indent beneath first sexp on same line as last-sexp.
-		  ;; Again, it's almost certainly a function call.
-		  (goto-char last-sexp)
-		  (beginning-of-line)
-		  (parse-partial-sexp (point) last-sexp 0 t)
-		  (backward-prefix-chars)))))))
-      ;; If looking at a list, don't call hook.
-      (if first-sexp-list-p
-	  (setq desired-indent (current-column)))
-      ;; Point is at the point to indent under unless we are inside a string.
-      ;; Call indentation hook except when overridden by scheme-indent-offset
-      ;; or if the desired indentation has already been computed.
-      (cond ((car (nthcdr 3 state))
-	     ;; Inside a string, don't change indentation.
-	     (goto-char indent-point)
-	     (skip-chars-forward " \t")
-	     (setq desired-indent (current-column)))
-	    ((and (integerp scheme-indent-offset) containing-sexp)
-	     ;; Indent by constant offset
-	     (goto-char containing-sexp)
-	     (setq desired-indent (+ scheme-indent-offset (current-column))))
-	    ((not (or desired-indent
-		      (and (boundp 'scheme-indent-function)
-			   scheme-indent-function
-			   (not retry)
-			   (setq desired-indent
-				 (funcall scheme-indent-function
-					  indent-point state)))))
-	     ;; Use default indentation if not computed yet
-	     (setq desired-indent (current-column))))
-      desired-indent)))
-
-(defun scheme-indent-function (indent-point state)
-  (let ((normal-indent (current-column)))
-    (save-excursion
-      (goto-char (1+ (car (cdr state))))
-      (re-search-forward "\\sw\\|\\s_")
-      (if (/= (point) (car (cdr state)))
-	  (let ((function (buffer-substring (progn (forward-char -1) (point))
-					    (progn (forward-sexp 1) (point))))
-		method)
-	    ;; Who cares about this, really?
-	    ;(if (not (string-match "\\\\\\||" function)))
-	    (setq function (downcase function))
-	    (setq method (get (intern-soft function) 'scheme-indent-function))
-	    (cond ((integerp method)
-		   (scheme-indent-specform method state indent-point))
-		  (method
-		   (funcall method state indent-point))
-		  ((and (> (length function) 3)
-			(string-equal (substring function 0 3) "def"))
-		   (scheme-indent-defform state indent-point))))))))
-
-(defvar scheme-body-indent 2 "")
-
-(defun scheme-indent-specform (count state indent-point)
-  (let ((containing-form-start (car (cdr state))) (i count)
-	body-indent containing-form-column)
-    ;; Move to the start of containing form, calculate indentation
-    ;; to use for non-distinguished forms (> count), and move past the
-    ;; function symbol.  scheme-indent-function guarantees that there is at
-    ;; least one word or symbol character following open paren of containing
-    ;; form.
-    (goto-char containing-form-start)
-    (setq containing-form-column (current-column))
-    (setq body-indent (+ scheme-body-indent containing-form-column))
-    (forward-char 1)
-    (forward-sexp 1)
-    ;; Now find the start of the last form.
-    (parse-partial-sexp (point) indent-point 1 t)
-    (while (and (< (point) indent-point)
-		(condition-case nil
-		    (progn
-		      (setq count (1- count))
-		      (forward-sexp 1)
-		      (parse-partial-sexp (point) indent-point 1 t))
-		  (error nil))))
-    ;; Point is sitting on first character of last (or count) sexp.
-    (cond ((> count 0)
-	   ;; A distinguished form.  Use double scheme-body-indent.
-	   (list (+ containing-form-column (* 2 scheme-body-indent))
-		 containing-form-start))
-	  ;; A non-distinguished form. Use body-indent if there are no
-	  ;; distinguished forms and this is the first undistinguished
-	  ;; form, or if this is the first undistinguished form and
-	  ;; the preceding distinguished form has indentation at least
-	  ;; as great as body-indent.
-	  ((and (= count 0)
-		(or (= i 0)
-		    (<= body-indent normal-indent)))
-	   body-indent)
-	  (t
-	   normal-indent))))
-
-(defun scheme-indent-defform (state indent-point)
-  (goto-char (car (cdr state)))
-  (forward-line 1)
-  (if (> (point) (car (cdr (cdr state))))
-      (progn
-	(goto-char (car (cdr state)))
-	(+ scheme-body-indent (current-column)))))
-
-;;; Let is different in Scheme
-
-(defun would-be-symbol (string)
-  (not (string-equal (substring string 0 1) "(")))
-
-(defun next-sexp-as-string ()
-  ;; Assumes that protected by a save-excursion
-  (forward-sexp 1)
-  (let ((the-end (point)))
-    (backward-sexp 1)
-    (buffer-substring (point) the-end)))
-
-;; This is correct but too slow.
-;; The one below works almost always.
-;;(defun scheme-let-indent (state indent-point)
-;;  (if (would-be-symbol (next-sexp-as-string))
-;;      (scheme-indent-specform 2 state indent-point)
-;;      (scheme-indent-specform 1 state indent-point)))
-
-(defun scheme-let-indent (state indent-point)
-  (skip-chars-forward " \t")
-  (if (looking-at "[-a-zA-Z0-9+*/?!@$%^&_:~]")
-      (scheme-indent-specform 2 state indent-point)
-      (scheme-indent-specform 1 state indent-point)))
-
-;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented
-;; like defun if the first form is placed on the next line, otherwise
-;; it is indented like any other form (i.e. forms line up under first).
-
-(put 'begin 'scheme-indent-function 0)
-(put 'case 'scheme-indent-function 1)
-(put 'delay 'scheme-indent-function 0)
-(put 'do 'scheme-indent-function 2)
-(put 'lambda 'scheme-indent-function 1)
-(put 'let 'scheme-indent-function 'scheme-let-indent)
-(put 'let* 'scheme-indent-function 1)
-(put 'letrec 'scheme-indent-function 1)
-(put 'sequence 'scheme-indent-function 0)
-
-(put 'call-with-input-file 'scheme-indent-function 1)
-(put 'with-input-from-file 'scheme-indent-function 1)
-(put 'with-input-from-port 'scheme-indent-function 1)
-(put 'call-with-output-file 'scheme-indent-function 1)
-(put 'with-output-to-file 'scheme-indent-function 1)
-(put 'with-output-to-port 'scheme-indent-function 1)
-
-;;;; MIT Scheme specific indentation.
-
-(if scheme-mit-dialect
-    (progn
-      (put 'fluid-let 'scheme-indent-function 1)
-      (put 'in-package 'scheme-indent-function 1)
-      (put 'let-syntax 'scheme-indent-function 1)
-      (put 'local-declare 'scheme-indent-function 1)
-      (put 'macro 'scheme-indent-function 1)
-      (put 'make-environment 'scheme-indent-function 0)
-      (put 'named-lambda 'scheme-indent-function 1)
-      (put 'using-syntax 'scheme-indent-function 1)
-
-      (put 'with-input-from-string 'scheme-indent-function 1)
-      (put 'with-output-to-string 'scheme-indent-function 0)
-      (put 'with-values 'scheme-indent-function 1)
-
-      (put 'syntax-table-define 'scheme-indent-function 2)
-      (put 'list-transform-positive 'scheme-indent-function 1)
-      (put 'list-transform-negative 'scheme-indent-function 1)
-      (put 'list-search-positive 'scheme-indent-function 1)
-      (put 'list-search-negative 'scheme-indent-function 1)
-
-      (put 'access-components 'scheme-indent-function 1)
-      (put 'assignment-components 'scheme-indent-function 1)
-      (put 'combination-components 'scheme-indent-function 1)
-      (put 'comment-components 'scheme-indent-function 1)
-      (put 'conditional-components 'scheme-indent-function 1)
-      (put 'disjunction-components 'scheme-indent-function 1)
-      (put 'declaration-components 'scheme-indent-function 1)
-      (put 'definition-components 'scheme-indent-function 1)
-      (put 'delay-components 'scheme-indent-function 1)
-      (put 'in-package-components 'scheme-indent-function 1)
-      (put 'lambda-components 'scheme-indent-function 1)
-      (put 'lambda-components* 'scheme-indent-function 1)
-      (put 'lambda-components** 'scheme-indent-function 1)
-      (put 'open-block-components 'scheme-indent-function 1)
-      (put 'pathname-components 'scheme-indent-function 1)
-      (put 'procedure-components 'scheme-indent-function 1)
-      (put 'sequence-components 'scheme-indent-function 1)
-      (put 'unassigned\?-components 'scheme-indent-function 1)
-      (put 'unbound\?-components 'scheme-indent-function 1)
-      (put 'variable-components 'scheme-indent-function 1)))
-
-(defun scheme-indent-sexp ()
-  "Indent each line of the list starting just after point."
-  (interactive)
-  (let ((indent-stack (list nil)) (next-depth 0) bol
-	outer-loop-done inner-loop-done state this-indent)
-    (save-excursion (forward-sexp 1))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (not outer-loop-done)
-	(setq last-depth next-depth
-	      innerloop-done nil)
-	(while (and (not innerloop-done)
-		    (not (setq outer-loop-done (eobp))))
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  (if (car (nthcdr 4 state))
-	      (progn (indent-for-comment)
-		     (end-of-line)
-		     (setcar (nthcdr 4 state) nil)))
-	  (if (car (nthcdr 3 state))
-	      (progn
-		(forward-line 1)
-		(setcar (nthcdr 5 state) nil))
-	    (setq innerloop-done t)))
-	(if (setq outer-loop-done (<= next-depth 0))
-	    nil
-	  (while (> last-depth next-depth)
-	    (setq indent-stack (cdr indent-stack)
-		  last-depth (1- last-depth)))
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  last-depth (1+ last-depth)))
-	  (forward-line 1)
-	  (setq bol (point))
-	  (skip-chars-forward " \t")
-	  (if (or (eobp) (looking-at "[;\n]"))
-	      nil
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		(setq this-indent (car indent-stack))
-	      (let ((val (calculate-scheme-indent
-			  (if (car indent-stack) (- (car indent-stack))))))
-		(if (integerp val)
-		    (setcar indent-stack
-			    (setq this-indent val))
-                  (if (cdr val)
-                      (setcar indent-stack (- (car (cdr val)))))
-		  (setq this-indent (car val)))))
-	    (if (/= (current-column) this-indent)
-		(progn (delete-region bol (point))
-		       (indent-to this-indent)))))))))
-
-(provide 'scheme)
-
-;;; scheme.el ends here
diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el
deleted file mode 100644
index 6ba2856938f..00000000000
--- a/lisp/progmodes/sh-script.el
+++ /dev/null
@@ -1,1388 +0,0 @@
-;;; sh-script.el --- shell-script editing commands for Emacs
-
-;; Copyright (C) 1993, 1994, 1995, 1996 by Free Software Foundation, Inc.
-
-;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
-;; Version: 2.0e
-;; Maintainer: FSF
-;; Keywords: languages, unix
-
-;; 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:
-
-;; Major mode for editing shell scripts.  Bourne, C and rc shells as well
-;; as various derivatives are supported and easily derived from.  Structured
-;; statements can be inserted with one command or abbrev.  Completion is
-;; available for filenames, variables known from the script, the shell and
-;; the environment as well as commands.
-
-;;; Known Bugs:
-
-;; - In Bourne the keyword `in' is not anchored to case, for, select ...
-;; - Variables in `"' strings aren't fontified because there's no way of
-;;   syntactically distinguishing those from `'' strings.
-
-;;; Code:
-
-;; page 1:	variables and settings
-;; page 2:	mode-command and utility functions
-;; page 3:	statement syntax-commands for various shells
-;; page 4:	various other commands
-
-(require 'executable)
-
-(defvar sh-ancestor-alist
-  '((ash . sh)
-    (bash . jsh)
-    (dtksh . ksh)
-    (es . rc)
-    (itcsh . tcsh)
-    (jcsh . csh)
-    (jsh . sh)
-    (ksh . ksh88)
-    (ksh88 . jsh)
-    (oash . sh)
-    (pdksh . ksh88)
-    (posix . sh)
-    (tcsh . csh)
-    (wksh . ksh88)
-    (wsh . sh)
-    (zsh . ksh88))
-  "*Alist showing the direct ancestor of various shells.
-This is the basis for `sh-feature'.  See also `sh-alias-alist'.
-By default we have the following three hierarchies:
-
-csh		C Shell
-  jcsh		C Shell with Job Control
-  tcsh		Toronto C Shell
-    itcsh	? Toronto C Shell
-rc		Plan 9 Shell
-  es		Extensible Shell
-sh		Bourne Shell
-  ash		? Shell
-  jsh		Bourne Shell with Job Control
-    bash	GNU Bourne Again Shell
-    ksh88	Korn Shell '88
-      ksh	Korn Shell '93
-	dtksh	CDE Desktop Korn Shell
-      pdksh	Public Domain Korn Shell
-      wksh	Window Korn Shell
-      zsh	Z Shell
-  oash		SCO OA (curses) Shell
-  posix		IEEE 1003.2 Shell Standard
-  wsh		? Shell")
-
-
-(defvar sh-alias-alist
-  (nconc (if (eq system-type 'gnu/linux)
-	     '((csh . tcsh)
-	       (ksh . pdksh)))
-	 ;; for the time being
-	 '((ksh . ksh88)
-	   (sh5 . sh)))
-  "*Alist for transforming shell names to what they really are.
-Use this where the name of the executable doesn't correspond to the type of
-shell it really is.")
-
-
-(defvar sh-shell-file
-  (or
-   ;; On MSDOS and Windows, collapse $SHELL to lower-case and remove
-   ;; the executable extension, so comparisons with the list of
-   ;; known shells work.
-   (and (memq system-type '(ms-dos windows-nt))
-	(file-name-sans-extension (downcase (getenv "SHELL"))))
-   (getenv "SHELL")
-   "/bin/sh")
-  "*The executable file name for the shell being programmed.")
-
-
-(defvar sh-shell-arg
-  ;; bash does not need any options when run in a shell script,
-  '((bash)
-    (csh . "-f")
-    (pdksh)
-    ;; Bill_Mann@praxisint.com says -p with ksh can do harm.
-    (ksh88)
-    ;; -p means don't initialize functions from the environment.
-    (rc . "-p")
-    ;; Someone proposed -motif, but we don't want to encourage
-    ;; use of a non-free widget set.
-    (wksh)
-    ;; -f means don't run .zshrc.
-    (zsh . "-f"))
-  "*Single argument string for the magic number.  See `sh-feature'.")
-
-(defvar sh-shell-variables nil
-  "Alist of shell variable names that should be included in completion.
-These are used for completion in addition to all the variables named
-in `process-environment'.  Each element looks like (VAR . VAR), where
-the car and cdr are the same symbol.")
-
-(defvar sh-shell-variables-initialized nil
-  "Non-nil if `sh-shell-variables' is initialized.")
-
-(defun sh-canonicalize-shell (shell)
-  "Convert a shell name SHELL to the one we should handle it as."
-  (or (symbolp shell)
-      (setq shell (intern shell)))
-  (or (cdr (assq shell sh-alias-alist))
-      shell))
-
-(defvar sh-shell (sh-canonicalize-shell (file-name-nondirectory sh-shell-file))
-  "The shell being programmed.  This is set by \\[sh-set-shell].")
-
-;;; I turned off this feature because it doesn't permit typing commands
-;;; in the usual way without help.
-;;;(defvar sh-abbrevs
-;;;  '((csh eval sh-abbrevs shell
-;;;	 "switch" 'sh-case
-;;;	 "getopts" 'sh-while-getopts)
-
-;;;    (es eval sh-abbrevs shell
-;;;	"function" 'sh-function)
-
-;;;    (ksh88 eval sh-abbrevs sh
-;;;	   "select" 'sh-select)
-
-;;;    (rc eval sh-abbrevs shell
-;;;	"case" 'sh-case
-;;;	"function" 'sh-function)
-
-;;;    (sh eval sh-abbrevs shell
-;;;	"case" 'sh-case
-;;;	"function" 'sh-function
-;;;	"until" 'sh-until
-;;;	"getopts" 'sh-while-getopts)
-
-;;;    ;; The next entry is only used for defining the others
-;;;    (shell "for" sh-for
-;;;	   "loop" sh-indexed-loop
-;;;	   "if" sh-if
-;;;	   "tmpfile" sh-tmp-file
-;;;	   "while" sh-while)
-
-;;;    (zsh eval sh-abbrevs ksh88
-;;;	 "repeat" 'sh-repeat))
-;;;  "Abbrev-table used in Shell-Script mode.  See `sh-feature'.
-;;;Due to the internal workings of abbrev tables, the shell name symbol is
-;;;actually defined as the table for the like of \\[edit-abbrevs].")
-
-
-
-(defvar sh-mode-syntax-table
-  '((sh eval sh-mode-syntax-table ()
-	?\# "<"
-	?\^l ">#"
-	?\n ">#"
-	?\" "\"\""
-	?\' "\"'"
-	?\` "\"`"
-	?$ "\\"			    ; `escape' so $# doesn't start a comment
-	?! "_"
-	?% "_"
-	?: "_"
-	?. "_"
-	?^ "_"
-	?~ "_")
-    (csh eval identity sh)
-    (rc eval identity sh))
-  "Syntax-table used in Shell-Script mode.  See `sh-feature'.")
-
-
-
-(defvar sh-mode-map
-  (let ((map (make-sparse-keymap))
-	(menu-map (make-sparse-keymap "Insert")))
-    (define-key map "\C-c(" 'sh-function)
-    (define-key map "\C-c\C-w" 'sh-while)
-    (define-key map "\C-c\C-u" 'sh-until)
-    (define-key map "\C-c\C-t" 'sh-tmp-file)
-    (define-key map "\C-c\C-s" 'sh-select)
-    (define-key map "\C-c\C-r" 'sh-repeat)
-    (define-key map "\C-c\C-o" 'sh-while-getopts)
-    (define-key map "\C-c\C-l" 'sh-indexed-loop)
-    (define-key map "\C-c\C-i" 'sh-if)
-    (define-key map "\C-c\C-f" 'sh-for)
-    (define-key map "\C-c\C-c" 'sh-case)
-
-    (define-key map "=" 'sh-assignment)
-    (define-key map "\C-c+" 'sh-add)
-    (define-key map "\C-\M-x" 'sh-execute-region)
-    (define-key map "\C-c\C-x" 'executable-interpret)
-    (define-key map "<" 'sh-maybe-here-document)
-    (define-key map "(" 'skeleton-pair-insert-maybe)
-    (define-key map "{" 'skeleton-pair-insert-maybe)
-    (define-key map "[" 'skeleton-pair-insert-maybe)
-    (define-key map "'" 'skeleton-pair-insert-maybe)
-    (define-key map "`" 'skeleton-pair-insert-maybe)
-    (define-key map "\"" 'skeleton-pair-insert-maybe)
-
-    (define-key map "\t" 'sh-indent-line)
-    (substitute-key-definition 'complete-tag 'comint-dynamic-complete
-			       map (current-global-map))
-    (substitute-key-definition 'newline-and-indent 'sh-newline-and-indent
-			       map (current-global-map))
-    (substitute-key-definition 'delete-backward-char
-			       'backward-delete-char-untabify
-			       map (current-global-map))
-    (define-key map "\C-c:" 'sh-set-shell)
-    (substitute-key-definition 'beginning-of-defun
-			       'sh-beginning-of-compound-command
-			       map (current-global-map))
-    (substitute-key-definition 'backward-sentence 'sh-beginning-of-command
-			       map (current-global-map))
-    (substitute-key-definition 'forward-sentence 'sh-end-of-command
-			       map (current-global-map))
-    (define-key map [menu-bar insert] (cons "Insert" menu-map))
-    (define-key menu-map [sh-while]	'("While Loop" . sh-while))
-    (define-key menu-map [sh-until]	'("Until Loop" . sh-until))
-    (define-key menu-map [sh-tmp-file]	'("Temporary File" . sh-tmp-file))
-    (define-key menu-map [sh-select]	'("Select Statement" . sh-select))
-    (define-key menu-map [sh-repeat]	'("Repeat Loop" . sh-repeat))
-    (define-key menu-map [sh-while-getopts]
-					'("Options Loop" . sh-while-getopts))
-    (define-key menu-map [sh-indexed-loop]
-					'("Indexed Loop" . sh-indexed-loop))
-    (define-key menu-map [sh-if]	'("If Statement" . sh-if))
-    (define-key menu-map [sh-for]	'("For Loop" . sh-for))
-    (define-key menu-map [sh-case]	'("Case Statement" . sh-case))
-    map)
-  "Keymap used in Shell-Script mode.")
-
-
-
-(defvar sh-dynamic-complete-functions
-  '(shell-dynamic-complete-environment-variable
-    shell-dynamic-complete-command
-    comint-dynamic-complete-filename)
-  "*Functions for doing TAB dynamic completion.")
-
-
-(defvar sh-require-final-newline
-  '((csh . t)
-    (pdksh . t)
-    (rc eval . require-final-newline)
-    (sh eval . require-final-newline))
-  "*Value of `require-final-newline' in Shell-Script mode buffers.
-See `sh-feature'.")
-
-
-(defvar sh-assignment-regexp
-  '((csh . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*[-+*/%^]?=")
-    ;; actually spaces are only supported in let/(( ... ))
-    (ksh88 . "\\<\\([a-zA-Z0-9_]+\\)\\(\\[.+\\]\\)?[ \t]*\\([-+*/%&|~^]\\|<<\\|>>\\)?=")
-    (rc . "\\<\\([a-zA-Z0-9_*]+\\)[ \t]*=")
-    (sh . "\\<\\([a-zA-Z0-9_]+\\)="))
-  "*Regexp for the variable name and what may follow in an assignment.
-First grouping matches the variable name.  This is upto and including the `='
-sign.  See `sh-feature'.")
-
-
-(defvar sh-indentation 4
-  "The width for further indentation in Shell-Script mode.")
-
-
-(defvar sh-remember-variable-min 3
-  "*Don't remember variables less than this length for completing reads.")
-
-
-(defvar sh-header-marker nil
-  "When non-`nil' is the end of header for prepending by \\[sh-execute-region].
-That command is also used for setting this variable.")
-
-
-(defvar sh-beginning-of-command
-  "\\([;({`|&]\\|\\`\\|[^\\]\n\\)[ \t]*\\([/~a-zA-Z0-9:]\\)"
-  "*Regexp to determine the beginning of a shell command.
-The actual command starts at the beginning of the second \\(grouping\\).")
-
-
-(defvar sh-end-of-command
-  "\\([/~a-zA-Z0-9:]\\)[ \t]*\\([;#)}`|&]\\|$\\)"
-  "*Regexp to determine the end of a shell command.
-The actual command ends at the end of the first \\(grouping\\).")
-
-
-
-(defvar sh-here-document-word "EOF"
-  "Word to delimit here documents.")
-
-(defvar sh-test
-  '((sh "[  ]" . 3)
-    (ksh88 "[[  ]]" . 4))
-  "Initial input in Bourne if, while and until skeletons.  See `sh-feature'.")
-
-
-(defvar sh-builtins
-  '((bash eval sh-append posix
-	  "alias" "bg" "bind" "builtin" "declare" "dirs" "enable" "fc" "fg"
-	  "help" "history" "jobs" "kill" "let" "local" "popd" "pushd" "source"
-	  "suspend" "typeset" "unalias")
-
-    ;; The next entry is only used for defining the others
-    (bourne eval sh-append shell
-	    "eval" "export" "getopts" "newgrp" "pwd" "read" "readonly"
-	    "times" "ulimit")
-
-    (csh eval sh-append shell
-	 "alias" "chdir" "glob" "history" "limit" "nice" "nohup" "rehash"
-	 "setenv" "source" "time" "unalias" "unhash")
-
-    (dtksh eval identity wksh)
-
-    (es "access" "apids" "cd" "echo" "eval" "false" "let" "limit" "local"
-	"newpgrp" "result" "time" "umask" "var" "vars" "wait" "whatis")
-
-    (jsh eval sh-append sh
-	 "bg" "fg" "jobs" "kill" "stop" "suspend")
-
-    (jcsh eval sh-append csh
-	 "bg" "fg" "jobs" "kill" "notify" "stop" "suspend")
-
-    (ksh88 eval sh-append bourne
-	   "alias" "bg" "false" "fc" "fg" "jobs" "kill" "let" "print" "time"
-	   "typeset" "unalias" "whence")
-
-    (oash eval sh-append sh
-	  "checkwin" "dateline" "error" "form" "menu" "newwin" "oadeinit"
-	  "oaed" "oahelp" "oainit" "pp" "ppfile" "scan" "scrollok" "wattr"
-	  "wclear" "werase" "win" "wmclose" "wmmessage" "wmopen" "wmove"
-	  "wmtitle" "wrefresh")
-
-    (pdksh eval sh-append ksh88
-	   "bind")
-
-    (posix eval sh-append sh
-	   "command")
-
-    (rc "builtin" "cd" "echo" "eval" "limit" "newpgrp" "shift" "umask" "wait"
-	"whatis")
-
-    (sh eval sh-append bourne
-	"hash" "test" "type")
-
-    ;; The next entry is only used for defining the others
-    (shell "cd" "echo" "eval" "set" "shift" "umask" "unset" "wait")
-
-    (wksh eval sh-append ksh88
-	  "Xt[A-Z][A-Za-z]*")
-
-    (zsh eval sh-append ksh88
-	 "autoload" "bindkey" "builtin" "chdir" "compctl" "declare" "dirs"
-	 "disable" "disown" "echotc" "enable" "functions" "getln" "hash"
-	 "history" "integer" "limit" "local" "log" "popd" "pushd" "r"
-	 "readonly" "rehash" "sched" "setopt" "source" "suspend" "true"
-	 "ttyctl" "type" "unfunction" "unhash" "unlimit" "unsetopt" "vared"
-	 "which"))
-  "*List of all shell builtins for completing read and fontification.
-Note that on some systems not all builtins are available or some are
-implemented as aliases.  See `sh-feature'.")
-
-
-
-(defvar sh-leading-keywords
-  '((csh "else")
-
-    (es "true" "unwind-protect" "whatis")
-
-    (rc "else")
-
-    (sh "do" "elif" "else" "if" "then" "trap" "type" "until" "while"))
-  "*List of keywords that may be immediately followed by a builtin or keyword.
-Given some confusion between keywords and builtins depending on shell and
-system, the distinction here has been based on whether they influence the
-flow of control or syntax.  See `sh-feature'.")
-
-
-(defvar sh-other-keywords
-  '((bash eval sh-append bourne
-	  "bye" "logout")
-
-    ;; The next entry is only used for defining the others
-    (bourne eval sh-append sh
-	    "function")
-
-    (csh eval sh-append shell
-	 "breaksw" "default" "end" "endif" "endsw" "foreach" "goto"
-	 "if" "logout" "onintr" "repeat" "switch" "then" "while")
-
-    (es "break" "catch" "exec" "exit" "fn" "for" "forever" "fork" "if"
-	"return" "throw" "while")
-
-    (ksh88 eval sh-append bourne
-	   "select")
-
-    (rc "break" "case" "exec" "exit" "fn" "for" "if" "in" "return" "switch"
-	"while")
-
-    (sh eval sh-append shell
-	"done" "esac" "fi" "for" "in" "return")
-
-    ;; The next entry is only used for defining the others
-    (shell "break" "case" "continue" "exec" "exit")
-
-    (zsh eval sh-append bash
-	 "select"))
-  "*List of keywords not in `sh-leading-keywords'.
-See `sh-feature'.")
-
-
-
-(defvar sh-variables
-  '((bash eval sh-append sh
-	  "allow_null_glob_expansion" "auto_resume" "BASH" "BASH_VERSION"
-	  "cdable_vars" "ENV" "EUID" "FCEDIT" "FIGNORE" "glob_dot_filenames"
-	  "histchars" "HISTFILE" "HISTFILESIZE" "history_control" "HISTSIZE"
-	  "hostname_completion_file" "HOSTTYPE" "IGNOREEOF" "ignoreeof"
-	  "LINENO" "MAIL_WARNING" "noclobber" "nolinks" "notify"
-	  "no_exit_on_failed_exec" "NO_PROMPT_VARS" "OLDPWD" "OPTERR" "PPID"
-	  "PROMPT_COMMAND" "PS4" "pushd_silent" "PWD" "RANDOM" "REPLY"
-	  "SECONDS" "SHLVL" "TMOUT" "UID")
-
-    (csh eval sh-append shell
-	 "argv" "cdpath" "child" "echo" "histchars" "history" "home"
-	 "ignoreeof" "mail" "noclobber" "noglob" "nonomatch" "path" "prompt"
-	 "shell" "status" "time" "verbose")
-
-    (es eval sh-append shell
-	"apid" "cdpath" "CDPATH" "history" "home" "ifs" "noexport" "path"
-	"pid" "prompt" "signals")
-
-    (jcsh eval sh-append csh
-	 "notify")
-
-    (ksh88 eval sh-append sh
-	   "ENV" "ERRNO" "FCEDIT" "FPATH" "HISTFILE" "HISTSIZE" "LINENO"
-	   "OLDPWD" "PPID" "PS3" "PS4" "PWD" "RANDOM" "REPLY" "SECONDS"
-	   "TMOUT")
-
-    (oash eval sh-append sh
-	  "FIELD" "FIELD_MAX" "LAST_KEY" "OALIB" "PP_ITEM" "PP_NUM")
-
-    (rc eval sh-append shell
-	"apid" "apids" "cdpath" "CDPATH" "history" "home" "ifs" "path" "pid"
-	"prompt" "status")
-
-    (sh eval sh-append shell
-	"CDPATH" "IFS" "OPTARG" "OPTIND" "PS1" "PS2")
-
-    ;; The next entry is only used for defining the others
-    (shell "COLUMNS" "EDITOR" "HOME" "HUSHLOGIN" "LANG" "LC_COLLATE"
-	   "LC_CTYPE" "LC_MESSAGES" "LC_MONETARY" "LC_NUMERIC" "LC_TIME"
-	   "LINES" "LOGNAME" "MAIL" "MAILCHECK" "MAILPATH" "PAGER" "PATH"
-	   "SHELL" "TERM" "TERMCAP" "TERMINFO" "VISUAL")
-
-    (tcsh eval sh-append csh
-	  "addsuffix" "ampm" "autocorrect" "autoexpand" "autolist"
-	  "autologout" "chase_symlinks" "correct" "dextract" "edit" "el"
-	  "fignore" "gid" "histlit" "HOST" "HOSTTYPE" "HPATH"
-	  "ignore_symlinks" "listjobs" "listlinks" "listmax" "matchbeep"
-	  "nobeep" "NOREBIND" "oid" "printexitvalue" "prompt2" "prompt3"
-	  "pushdsilent" "pushdtohome" "recexact" "recognize_only_executables"
-	  "rmstar" "savehist" "SHLVL" "showdots" "sl" "SYSTYPE" "tcsh" "term"
-	  "tperiod" "tty" "uid" "version" "visiblebell" "watch" "who"
-	  "wordchars")
-
-    (zsh eval sh-append ksh88
-	 "BAUD" "bindcmds" "cdpath" "DIRSTACKSIZE" "fignore" "FIGNORE" "fpath"
-	 "HISTCHARS" "hostcmds" "hosts" "HOSTS" "LISTMAX" "LITHISTSIZE"
-	 "LOGCHECK" "mailpath" "manpath" "NULLCMD" "optcmds" "path" "POSTEDIT"
-	 "prompt" "PROMPT" "PROMPT2" "PROMPT3" "PROMPT4" "psvar" "PSVAR"
-	 "READNULLCMD" "REPORTTIME" "RPROMPT" "RPS1" "SAVEHIST" "SPROMPT"
-	 "STTY" "TIMEFMT" "TMOUT" "TMPPREFIX" "varcmds" "watch" "WATCH"
-	 "WATCHFMT" "WORDCHARS" "ZDOTDIR"))
-  "List of all shell variables available for completing read.
-See `sh-feature'.")
-
-
-
-(defvar sh-font-lock-keywords
-  '((csh eval sh-append shell
-	 '("\\${?[#?]?\\([A-Za-z_][A-Za-z0-9_]*\\|0\\)" 1
-	   font-lock-variable-name-face))
-
-    (es eval sh-append executable-font-lock-keywords
-	'("\\$#?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\)" 1
-	  font-lock-variable-name-face))
-
-    (rc eval identity es)
-
-    (sh eval sh-append shell
-	'("\\$\\({#?\\)?\\([A-Za-z_][A-Za-z0-9_]*\\|[-#?@!]\\)" 2
-	  font-lock-variable-name-face))
-
-    ;; The next entry is only used for defining the others
-    (shell eval sh-append executable-font-lock-keywords
-	   '("\\\\[^A-Za-z0-9]" 0 font-lock-string-face)
-	   '("\\${?\\([A-Za-z_][A-Za-z0-9_]*\\|[0-9]+\\|[$*_]\\)" 1
-	     font-lock-variable-name-face)))
-  "*Rules for highlighting shell scripts.  See `sh-feature'.")
-
-(defvar sh-font-lock-keywords-1
-  '((sh "[ \t]in\\>"))
-  "*Additional rules for highlighting shell scripts.  See `sh-feature'.")
-
-(defvar sh-font-lock-keywords-2 ()
-  "*Yet more rules for highlighting shell scripts.  See `sh-feature'.")
-
-
-;; mode-command and utility functions
-
-;;;###autoload
-(put 'sh-mode 'mode-class 'special)
-
-;;;###autoload
-(defun sh-mode ()
-  "Major mode for editing shell scripts.
-This mode works for many shells, since they all have roughly the same syntax,
-as far as commands, arguments, variables, pipes, comments etc. are concerned.
-Unless the file's magic number indicates the shell, your usual shell is
-assumed.  Since filenames rarely give a clue, they are not further analyzed.
-
-This mode adapts to the variations between shells (see `sh-set-shell') by
-means of an inheritance based feature lookup (see `sh-feature').  This
-mechanism applies to all variables (including skeletons) that pertain to
-shell-specific features.
-
-The default style of this mode is that of Rosenblatt's Korn shell book.
-The syntax of the statements varies with the shell being used.  The
-following commands are available, based on the current shell's syntax:
-
-\\[sh-case]	 case statement
-\\[sh-for]	 for loop
-\\[sh-function]	 function definition
-\\[sh-if]	 if statement
-\\[sh-indexed-loop]	 indexed loop from 1 to n
-\\[sh-while-getopts]	 while getopts loop
-\\[sh-repeat]	 repeat loop
-\\[sh-select]	 select loop
-\\[sh-until]	 until loop
-\\[sh-while]	 while loop
-
-\\[backward-delete-char-untabify]	 Delete backward one position, even if it was a tab.
-\\[sh-newline-and-indent]	 Delete unquoted space and indent new line same as this one.
-\\[sh-end-of-command]	 Go to end of successive commands.
-\\[sh-beginning-of-command]	 Go to beginning of successive commands.
-\\[sh-set-shell]	 Set this buffer's shell, and maybe its magic number.
-\\[sh-execute-region]	 Have optional header and region be executed in a subshell.
-
-\\[sh-maybe-here-document]	 Without prefix, following an unquoted < inserts here document.
-{, (, [, ', \", `
-	Unless quoted with \\, insert the pairs {}, (), [], or '', \"\", ``.
-
-If you generally program a shell different from your login shell you can
-set `sh-shell-file' accordingly.  If your shell's file name doesn't correctly
-indicate what shell it is use `sh-alias-alist' to translate.
-
-If your shell gives error messages with line numbers, you can use \\[executable-interpret]
-with your script for an edit-interpret-debug cycle."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map sh-mode-map)
-  (make-local-variable 'indent-line-function)
-  (make-local-variable 'indent-region-function)
-  (make-local-variable 'skeleton-end-hook)
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-start-skip)
-  (make-local-variable 'require-final-newline)
-  (make-local-variable 'sh-header-marker)
-  (make-local-variable 'sh-shell-file)
-  (make-local-variable 'sh-shell)
-  (make-local-variable 'skeleton-pair-alist)
-  (make-local-variable 'skeleton-pair-filter)
-  (make-local-variable 'comint-dynamic-complete-functions)
-  (make-local-variable 'comint-prompt-regexp)
-  (make-local-variable 'font-lock-defaults)
-  (make-local-variable 'skeleton-filter)
-  (make-local-variable 'skeleton-newline-indent-rigidly)
-  (make-local-variable 'sh-shell-variables)
-  (make-local-variable 'sh-shell-variables-initialized)
-  (setq major-mode 'sh-mode
-	mode-name "Shell-script"
-	indent-line-function 'sh-indent-line
-	;; not very clever, but enables wrapping skeletons around regions
-	indent-region-function (lambda (b e)
-				 (save-excursion
-				   (goto-char b)
-				   (skip-syntax-backward "-")
-				   (setq b (point))
-				   (goto-char e)
-				   (skip-syntax-backward "-")
-				   (indent-rigidly b (point) sh-indentation)))
-	skeleton-end-hook (lambda ()
-			    (or (eolp) (newline) (indent-relative)))
-	paragraph-start (concat page-delimiter "\\|$")
-	paragraph-separate paragraph-start
-	comment-start "# "
-	comint-dynamic-complete-functions sh-dynamic-complete-functions
-	;; we can't look if previous line ended with `\'
-	comint-prompt-regexp "^[ \t]*"
-	font-lock-defaults
-	  `((sh-font-lock-keywords
-	     sh-font-lock-keywords-1
-	     sh-font-lock-keywords-2)
-	    nil nil
-	    ((?/ . "w") (?~ . "w") (?. . "w") (?- . "w") (?_ . "w")))
-	skeleton-pair-alist '((?` _ ?`))
-	skeleton-pair-filter 'sh-quoted-p
-	skeleton-further-elements '((< '(- (min sh-indentation
-						(current-column)))))
-	skeleton-filter 'sh-feature
-	skeleton-newline-indent-rigidly t)
-  ;; Parse or insert magic number for exec, and set all variables depending
-  ;; on the shell thus determined.
-  (let ((interpreter
-	 (save-excursion
-	   (goto-char (point-min))
-	   (if (looking-at "#![ \t]?\\([^ \t\n]*/bin/env[ \t]\\)?\\([^ \t\n]+\\)")
-	       (buffer-substring (match-beginning 2)
-				 (match-end 2))))))
-    (if interpreter
-	(sh-set-shell interpreter nil nil)))
-  (run-hooks 'sh-mode-hook))
-;;;###autoload
-(defalias 'shell-script-mode 'sh-mode)
-
-
-(defun sh-font-lock-keywords (&optional keywords)
-  "Function to get simple fontification based on `sh-font-lock-keywords'.
-This adds rules for comments and assignments."
-  (sh-feature sh-font-lock-keywords
-	      (lambda (list)
-		`((,(sh-feature sh-assignment-regexp)
-		   1 font-lock-variable-name-face)
-		  ,@keywords
-		  ,@list))))
-
-(defun sh-font-lock-keywords-1 (&optional builtins)
-  "Function to get better fontification including keywords."
-  (let ((keywords (concat "\\([;(){}`|&]\\|^\\)[ \t]*\\(\\(\\("
-			  (mapconcat 'identity
-				     (sh-feature sh-leading-keywords)
-				     "\\|")
-			  "\\)[ \t]+\\)?\\("
-			  (mapconcat 'identity
-				     (append (sh-feature sh-leading-keywords)
-					     (sh-feature sh-other-keywords))
-				     "\\|")
-			  "\\)")))
-    (sh-font-lock-keywords
-     `(,@(if builtins
-	     `((,(concat keywords "[ \t]+\\)?\\("
-			 (mapconcat 'identity (sh-feature sh-builtins) "\\|")
-			 "\\)\\>")
-		(2 font-lock-keyword-face nil t)
-		(6 font-lock-builtin-face))
-	       ,@(sh-feature sh-font-lock-keywords-2)))
-	 (,(concat keywords "\\)\\>")
-	  2 font-lock-keyword-face)
-	 ,@(sh-feature sh-font-lock-keywords-1)))))
-
-(defun sh-font-lock-keywords-2 ()
-  "Function to get better fontification including keywords and builtins."
-  (sh-font-lock-keywords-1 t))
-
-
-(defun sh-set-shell (shell &optional no-query-flag insert-flag)
-  "Set this buffer's shell to SHELL (a string).
-Makes this script executable via `executable-set-magic', and sets up the
-proper starting #!-line, if INSERT-FLAG is non-nil.
-Calls the value of `sh-set-shell-hook' if set."
-  (interactive (list (completing-read "Name or path of shell: "
-				      interpreter-mode-alist
-				      (lambda (x) (eq (cdr x) 'sh-mode)))
-		     (eq executable-query 'function)
-		     t))
-  (setq sh-shell (intern (file-name-nondirectory shell))
-	sh-shell (or (cdr (assq sh-shell sh-alias-alist))
-		     sh-shell))
-  (if insert-flag
-      (setq sh-shell-file
-	    (executable-set-magic shell (sh-feature sh-shell-arg)
-				  no-query-flag insert-flag)))
-  (setq require-final-newline (sh-feature sh-require-final-newline)
-;;;	local-abbrev-table (sh-feature sh-abbrevs)
-	font-lock-keywords nil		; force resetting
-	font-lock-syntax-table nil
-	comment-start-skip "#+[\t ]*"
-	mode-line-process (format "[%s]" sh-shell)
-	sh-shell-variables nil
-	sh-shell-variables-initialized nil
-	shell (sh-feature sh-variables))
-  (set-syntax-table (sh-feature sh-mode-syntax-table))
-  (while shell
-    (sh-remember-variable (car shell))
-    (setq shell (cdr shell)))
-  (and (boundp 'font-lock-mode)
-       font-lock-mode
-       (font-lock-mode (font-lock-mode 0)))
-  (run-hooks 'sh-set-shell-hook))
-
-
-
-(defun sh-feature (list &optional function)
-  "Index ALIST by the current shell.
-If ALIST isn't a list where every element is a cons, it is returned as is.
-Else indexing follows an inheritance logic which works in two ways:
-
-  - Fall back on successive ancestors (see `sh-ancestor-alist') as long as
-    the alist contains no value for the current shell.
-
-  - If the value thus looked up is a list starting with `eval' its `cdr' is
-    first evaluated.  If that is also a list and the first argument is a
-    symbol in ALIST it is not evaluated, but rather recursively looked up in
-    ALIST to allow the function called to define the value for one shell to be
-    derived from another shell.  While calling the function, is the car of the
-    alist element is the current shell.
-    The value thus determined is physically replaced into the alist.
-
-Optional FUNCTION is applied to the determined value and the result is cached
-in ALIST."
-  (or (if (consp list)
-	  (let ((l list))
-	    (while (and l (consp (car l)))
-	      (setq l (cdr l)))
-	    (if l list)))
-      (if function
-	  (cdr (assoc (setq function (cons sh-shell function)) list)))
-      (let ((sh-shell sh-shell)
-	    elt val)
-	(while (and sh-shell
-		    (not (setq elt (assq sh-shell list))))
-	  (setq sh-shell (cdr (assq sh-shell sh-ancestor-alist))))
-	(if (and (consp (setq val (cdr elt)))
-		 (eq (car val) 'eval))
-	    (setcdr elt
-		    (setq val
-			  (eval (if (consp (setq val (cdr val)))
-				    (let ((sh-shell (car (cdr val)))
-					  function)
-				      (if (assq sh-shell list)
-					  (setcar (cdr val)
-						  (list 'quote
-							(sh-feature list))))
-				      val)
-				  val)))))
-	(if function
-	    (nconc list
-		   (list (cons function
-			       (setq sh-shell (car function)
-				     val (funcall (cdr function) val))))))
-	val)))
-
-
-
-;;; I commented this out because nobody calls it -- rms.
-;;;(defun sh-abbrevs (ancestor &rest list)
-;;;  "Iff it isn't, define the current shell as abbrev table and fill that.
-;;;Abbrev table will inherit all abbrevs from ANCESTOR, which is either an abbrev
-;;;table or a list of (NAME1 EXPANSION1 ...).  In addition it will define abbrevs
-;;;according to the remaining arguments NAMEi EXPANSIONi ...
-;;;EXPANSION may be either a string or a skeleton command."
-;;;  (or (if (boundp sh-shell)
-;;;	  (symbol-value sh-shell))
-;;;      (progn
-;;;	(if (listp ancestor)
-;;;	    (nconc list ancestor))
-;;;	(define-abbrev-table sh-shell ())
-;;;	(if (vectorp ancestor)
-;;;	    (mapatoms (lambda (atom)
-;;;			(or (eq atom 0)
-;;;			    (define-abbrev (symbol-value sh-shell)
-;;;			      (symbol-name atom)
-;;;			      (symbol-value atom)
-;;;			      (symbol-function atom))))
-;;;		      ancestor))
-;;;	(while list
-;;;	  (define-abbrev (symbol-value sh-shell)
-;;;	    (car list)
-;;;	    (if (stringp (car (cdr list)))
-;;;		(car (cdr list))
-;;;	      "")
-;;;	    (if (symbolp (car (cdr list)))
-;;;		(car (cdr list))))
-;;;	  (setq list (cdr (cdr list)))))
-;;;      (symbol-value sh-shell)))
-
-
-(defun sh-mode-syntax-table (table &rest list)
-  "Copy TABLE and set syntax for successive CHARs according to strings S."
-  (setq table (copy-syntax-table table))
-  (while list
-    (modify-syntax-entry (car list) (car (cdr list)) table)
-    (setq list (cdr (cdr list))))
-  table)
-
-
-(defun sh-append (ancestor &rest list)
-  "Return list composed of first argument (a list) physically appended to rest."
-  (nconc list ancestor))
-
-
-(defun sh-modify (skeleton &rest list)
-  "Modify a copy of SKELETON by replacing I1 with REPL1, I2 with REPL2 ..."
-  (setq skeleton (copy-sequence skeleton))
-  (while list
-    (setcar (or (nthcdr (car list) skeleton)
-		(error "Index %d out of bounds" (car list)))
-	    (car (cdr list)))
-    (setq list (nthcdr 2 list)))
-  skeleton)
-
-
-(defun sh-indent-line ()
-  "Indent as far as preceding non-empty line, then by steps of `sh-indentation'.
-Lines containing only comments are considered empty."
-  (interactive)
-  (let ((previous (save-excursion
-		    (while (and (not (bobp))
-				(progn
-				  (forward-line -1)
-				  (back-to-indentation)
-				  (or (eolp)
-				      (eq (following-char) ?#)))))
-		    (current-column)))
-	current)
-    (save-excursion
-      (indent-to (if (eq this-command 'newline-and-indent)
-		     previous
-		   (if (< (current-column)
-			  (setq current (progn (back-to-indentation)
-					       (current-column))))
-		       (if (eolp) previous 0)
-		     (delete-region (point)
-				    (progn (beginning-of-line) (point)))
-		     (if (eolp)
-			 (max previous (* (1+ (/ current sh-indentation))
-					  sh-indentation))
-		       (* (1+ (/ current sh-indentation)) sh-indentation))))))
-    (if (< (current-column) (current-indentation))
-	(skip-chars-forward " \t"))))
-
-
-(defun sh-execute-region (start end &optional flag)
-  "Pass optional header and region to a subshell for noninteractive execution.
-The working directory is that of the buffer, and only environment variables
-are already set which is why you can mark a header within the script.
-
-With a positive prefix ARG, instead of sending region, define header from
-beginning of buffer to point.  With a negative prefix ARG, instead of sending
-region, clear header."
-  (interactive "r\nP")
-  (if flag
-      (setq sh-header-marker (if (> (prefix-numeric-value flag) 0)
-				 (point-marker)))
-    (if sh-header-marker
-	(save-excursion
-	  (let (buffer-undo-list)
-	    (goto-char sh-header-marker)
-	    (append-to-buffer (current-buffer) start end)
-	    (shell-command-on-region (point-min)
-				     (setq end (+ sh-header-marker
-						  (- end start)))
-				     sh-shell-file)
-	    (delete-region sh-header-marker end)))
-      (shell-command-on-region start end (concat sh-shell-file " -")))))
-
-
-(defun sh-remember-variable (var)
-  "Make VARIABLE available for future completing reads in this buffer."
-  (or (< (length var) sh-remember-variable-min)
-      (getenv var)
-      (assoc var sh-shell-variables)
-      (setq sh-shell-variables (cons (cons var var) sh-shell-variables)))
-  var)
-
-
-
-(defun sh-quoted-p ()
-  "Is point preceded by an odd number of backslashes?"
-  (eq -1 (% (save-excursion (skip-chars-backward "\\\\")) 2)))
-
-;; statement syntax-commands for various shells
-
-;; You are welcome to add the syntax or even completely new statements as
-;; appropriate for your favorite shell.
-
-(define-skeleton sh-case
-  "Insert a case/switch statement.  See `sh-feature'."
-  (csh "expression: "
-       "switch( " str " )" \n
-       > "case " (read-string "pattern: ") ?: \n
-       > _ \n
-       "breaksw" \n
-       ( "other pattern, %s: "
-	 < "case " str ?: \n
-	 > _ \n
-	 "breaksw" \n)
-       < "default:" \n
-       > _ \n
-       resume:
-       < < "endsw")
-  (es)
-  (rc "expression: "
-      "switch( " str " ) {" \n
-      > "case " (read-string "pattern: ") \n
-      > _ \n
-      ( "other pattern, %s: "
-	< "case " str \n
-	> _ \n)
-      < "case *" \n
-      > _ \n
-      resume:
-      < < ?})
-  (sh "expression: "
-      "case " str " in" \n
-      > (read-string "pattern: ") ?\) \n
-      > _ \n
-      ";;" \n
-      ( "other pattern, %s: "
-	< str ?\) \n
-	> _ \n
-	";;" \n)
-      < "*)" \n
-      > _ \n
-      resume:
-      < < "esac"))
-(put 'sh-case 'menu-enable '(sh-feature sh-case))
-
-
-
-(define-skeleton sh-for
-  "Insert a for loop.  See `sh-feature'."
-  (csh eval sh-modify sh
-       1 "foreach "
-       3 " ( "
-       5 " )"
-       15 "end")
-  (es eval sh-modify rc
-      3 " = ")
-  (rc eval sh-modify sh
-      1 "for( "
-      5 " ) {"
-      15 ?})
-  (sh "Index variable: "
-      "for " str " in " _ "; do" \n
-      > _ | ?$ & (sh-remember-variable str) \n
-      < "done"))
-
-
-
-(define-skeleton sh-indexed-loop
-  "Insert an indexed loop from 1 to n.  See `sh-feature'."
-  (bash eval identity posix)
-  (csh "Index variable: "
-       "@ " str " = 1" \n
-       "while( $" str " <= " (read-string "upper limit: ") " )" \n
-       > _ ?$ str \n
-       "@ " str "++" \n
-       < "end")
-  (es eval sh-modify rc
-      3 " =")
-  (ksh88 "Index variable: "
-	 "integer " str "=0" \n
-	 "while (( ( " str " += 1 ) <= "
-	 (read-string "upper limit: ")
-	 " )); do" \n
-	 > _ ?$ (sh-remember-variable str) \n
-	 < "done")
-  (posix "Index variable: "
-	 str "=1" \n
-	 "while [ $" str " -le "
-	 (read-string "upper limit: ")
-	 " ]; do" \n
-	 > _ ?$ str \n
-	 str ?= (sh-add (sh-remember-variable str) 1) \n
-	 < "done")
-  (rc "Index variable: "
-      "for( " str " in" " `{awk 'BEGIN { for( i=1; i<="
-      (read-string "upper limit: ")
-      "; i++ ) print i }'}) {" \n
-      > _ ?$ (sh-remember-variable str) \n
-      < ?})
-  (sh "Index variable: "
-      "for " str " in `awk 'BEGIN { for( i=1; i<="
-      (read-string "upper limit: ")
-      "; i++ ) print i }'`; do" \n
-      > _ ?$ (sh-remember-variable str) \n
-      < "done"))
-
-
-(defun sh-shell-initialize-variables ()
-  "Scan the buffer for variable assignments.
-Add these variables to `sh-shell-variables'."
-  (message "Scanning buffer `%s' for variable assignments..." (buffer-name))
-  (save-excursion
-    (goto-char (point-min))
-    (setq sh-shell-variables-initialized t)
-    (while (search-forward "=" nil t)
-      (sh-assignment 0)))
-  (message "Scanning buffer `%s' for variable assignments...done"
-	   (buffer-name)))
-
-(defvar sh-add-buffer)
-
-(defun sh-add-completer (string predicate code)
-  "Do completion using `sh-shell-variables', but initialize it first.
-This function is designed for use as the \"completion table\",
-so it takes three arguments:
-  STRING, the current buffer contents;
-  PREDICATE, the predicate for filtering possible matches;
-  CODE, which says what kind of things to do.
-CODE can be nil, t or `lambda'.
-nil means to return the best completion of STRING, or nil if there is none.
-t means to return a list of all possible completions of STRING.
-`lambda' means to return t if STRING is a valid completion as it stands."
-  (let ((sh-shell-variables
-	 (save-excursion
-	   (set-buffer sh-add-buffer)
-	   (or sh-shell-variables-initialized
-	       (sh-shell-initialize-variables))
-	   (nconc (mapcar (lambda (var)
-			    (let ((name
-				   (substring var 0 (string-match "=" var))))
-			      (cons name name)))
-			  process-environment)
-		  sh-shell-variables))))
-    (cond ((null code)
-	   (try-completion string sh-shell-variables predicate))
-	  ((eq code t)
-	   (all-completions string sh-shell-variables predicate))
-	  ((eq code 'lambda)
-	   (assoc string sh-shell-variables)))))
-
-(defun sh-add (var delta)
-  "Insert an addition of VAR and prefix DELTA for Bourne (type) shell."
-  (interactive
-   (let ((sh-add-buffer (current-buffer)))
-     (list (completing-read "Variable: " 'sh-add-completer)
-	   (prefix-numeric-value current-prefix-arg))))
-  (insert (sh-feature '((bash . "$[ ")
-			(ksh88 . "$(( ")
-			(posix . "$(( ")
-			(rc . "`{expr $")
-			(sh . "`expr $")
-			(zsh . "$[ ")))
-	  (sh-remember-variable var)
-	  (if (< delta 0) " - " " + ")
-	  (number-to-string (abs delta))
-	  (sh-feature '((bash . " ]")
-			(ksh88 . " ))")
-			(posix . " ))")
-			(rc . "}")
-			(sh . "`")
-			(zsh . " ]")))))
-
-
-
-(define-skeleton sh-function
-  "Insert a function definition.  See `sh-feature'."
-  (bash eval sh-modify ksh88
-	3 "() {")
-  (ksh88 "name: "
-	 "function " str " {" \n
-	 > _ \n
-	 < "}")
-  (rc eval sh-modify ksh88
-	1 "fn ")
-  (sh ()
-      "() {" \n
-      > _ \n
-      < "}"))
-
-
-
-(define-skeleton sh-if
-  "Insert an if statement.  See `sh-feature'."
-  (csh "condition: "
-       "if( " str " ) then" \n
-       > _ \n
-       ( "other condition, %s: "
-	 < "else if( " str " ) then" \n
-	 > _ \n)
-       < "else" \n
-       > _ \n
-       resume:
-       < "endif")
-  (es "condition: "
-      "if { " str " } {" \n
-       > _ \n
-       ( "other condition, %s: "
-	 < "} { " str " } {" \n
-	 > _ \n)
-       < "} {" \n
-       > _ \n
-       resume:
-       < ?})
-  (rc eval sh-modify csh
-      3 " ) {"
-      8 '( "other condition, %s: "
-	   < "} else if( " str " ) {" \n
-	   > _ \n)
-      10 "} else {"
-      17 ?})
-  (sh "condition: "
-      '(setq input (sh-feature sh-test))
-      "if " str "; then" \n
-      > _ \n
-      ( "other condition, %s: "
-	< "elif " str "; then" \n
-	> _ \n)
-      < "else" \n
-      > _ \n
-      resume:
-      < "fi"))
-
-
-
-(define-skeleton sh-repeat
-  "Insert a repeat loop definition.  See `sh-feature'."
-  (es nil
-      "forever {" \n
-      > _ \n
-      < ?})
-  (zsh "factor: "
-      "repeat " str "; do"\n
-      > _ \n
-      < "done"))
-(put 'sh-repeat 'menu-enable '(sh-feature sh-repeat))
-
-
-
-(define-skeleton sh-select
-  "Insert a select statement.  See `sh-feature'."
-  (ksh88 "Index variable: "
-	 "select " str " in " _ "; do" \n
-	 > ?$ str \n
-	 < "done"))
-(put 'sh-select 'menu-enable '(sh-feature sh-select))
-
-
-
-(define-skeleton sh-tmp-file
-  "Insert code to setup temporary file handling.  See `sh-feature'."
-  (bash eval identity ksh88)
-  (csh (file-name-nondirectory (buffer-file-name))
-       "set tmp = /tmp/" str ".$$" \n
-       "onintr exit" \n _
-       (and (goto-char (point-max))
-	    (not (bolp))
-	    ?\n)
-       "exit:\n"
-       "rm $tmp* >&/dev/null" >)
-  (es (file-name-nondirectory (buffer-file-name))
-      "local( signals = $signals sighup sigint; tmp = /tmp/" str ".$pid ) {" \n
-      > "catch @ e {" \n
-      > "rm $tmp^* >[2]/dev/null" \n
-      "throw $e" \n
-      < "} {" \n
-      > _ \n
-      < ?} \n
-      < ?})
-  (ksh88 eval sh-modify sh
-	 6 "EXIT")
-  (rc (file-name-nondirectory (buffer-file-name))
-       "tmp = /tmp/" str ".$pid" \n
-       "fn sigexit { rm $tmp^* >[2]/dev/null }")
-  (sh (file-name-nondirectory (buffer-file-name))
-      "TMP=/tmp/" str ".$$" \n
-      "trap \"rm $TMP* 2>/dev/null\" " ?0))
-
-
-
-(define-skeleton sh-until
-  "Insert an until loop.  See `sh-feature'."
-  (sh "condition: "
-      '(setq input (sh-feature sh-test))
-      "until " str "; do" \n
-      > _ \n
-      < "done"))
-(put 'sh-until 'menu-enable '(sh-feature sh-until))
-
-
-
-(define-skeleton sh-while
-  "Insert a while loop.  See `sh-feature'."
-  (csh eval sh-modify sh
-       2 "while( "
-       4 " )"
-       10 "end")
-  (es eval sh-modify rc
-      2 "while { "
-      4 " } {")
-  (rc eval sh-modify csh
-      4 " ) {"
-      10 ?})
-  (sh "condition: "
-      '(setq input (sh-feature sh-test))
-      "while " str "; do" \n
-      > _ \n
-      < "done"))
-
-
-
-(define-skeleton sh-while-getopts
-  "Insert a while getopts loop.  See `sh-feature'.
-Prompts for an options string which consists of letters for each recognized
-option followed by a colon `:' if the option accepts an argument."
-  (bash eval sh-modify sh
-	18 "${0##*/}")
-  (csh nil
-       "while( 1 )" \n
-       > "switch( \"$1\" )" \n
-       '(setq input '("- x" . 2))
-       > >
-       ( "option, %s: "
-	 < "case " '(eval str)
-	 '(if (string-match " +" str)
-	      (setq v1 (substring str (match-end 0))
-		    str (substring str 0 (match-beginning 0)))
-	    (setq v1 nil))
-	 str ?: \n
-	 > "set " v1 & " = $2" | -4 & _ \n
-	 (if v1 "shift") & \n
-	 "breaksw" \n)
-       < "case --:" \n
-       > "shift" \n
-       < "default:" \n
-       > "break" \n
-       resume:
-       < < "endsw" \n
-       "shift" \n
-       < "end")
-  (ksh88 eval sh-modify sh
-	 16 "print"
-	 18 "${0##*/}"
-	 36 "OPTIND-1")
-  (posix eval sh-modify sh
-	 18 "$(basename $0)")
-  (sh "optstring: "
-      "while getopts :" str " OPT; do" \n
-      > "case $OPT in" \n
-      > >
-      '(setq v1 (append (vconcat str) nil))
-      ( (prog1 (if v1 (char-to-string (car v1)))
-	  (if (eq (nth 1 v1) ?:)
-	      (setq v1 (nthcdr 2 v1)
-		    v2 "\"$OPTARG\"")
-	    (setq v1 (cdr v1)
-		  v2 nil)))
-	< str "|+" str ?\) \n
-	> _ v2 \n
-	";;" \n)
-      < "*)" \n
-      > "echo" " \"usage: " "`basename $0`"
-      " [+-" '(setq v1 (point)) str
-      '(save-excursion
-	 (while (search-backward ":" v1 t)
-	   (replace-match " ARG] [+-" t t)))
-      (if (eq (preceding-char) ?-) -5)
-      "] [--] ARGS...\"" \n
-      "exit 2" \n
-      < < "esac" \n
-      < "done" \n
-      "shift " (sh-add "OPTIND" -1)))
-(put 'sh-while-getopts 'menu-enable '(sh-feature sh-while-getopts))
-
-
-
-(defun sh-assignment (arg)
-  "Remember preceding identifier for future completion and do self-insert."
-  (interactive "p")
-  (self-insert-command arg)
-  (if (<= arg 1)
-      (sh-remember-variable
-       (save-excursion
-	 (if (re-search-forward (sh-feature sh-assignment-regexp)
-				(prog1 (point)
-				  (beginning-of-line 1))
-				t)
-	     (match-string 1))))))
-
-
-
-(defun sh-maybe-here-document (arg)
-  "Inserts self.  Without prefix, following unquoted `<' inserts here document.
-The document is bounded by `sh-here-document-word'."
-  (interactive "*P")
-  (self-insert-command (prefix-numeric-value arg))
-  (or arg
-      (not (eq (char-after (- (point) 2)) last-command-char))
-      (save-excursion
-	(backward-char 2)
-	(sh-quoted-p))
-      (progn
-	(insert sh-here-document-word)
-	(or (eolp) (looking-at "[ \t]") (insert ? ))
-	(end-of-line 1)
-	(while
-	    (sh-quoted-p)
-	  (end-of-line 2))
-	(newline)
-	(save-excursion (insert ?\n sh-here-document-word)))))
-
-
-;; various other commands
-
-(autoload 'comint-dynamic-complete "comint"
-  "Dynamically perform completion at point." t)
-
-(autoload 'shell-dynamic-complete-command "shell"
-  "Dynamically complete the command at point." t)
-
-(autoload 'comint-dynamic-complete-filename "comint"
-  "Dynamically complete the filename at point." t)
-
-(autoload 'shell-dynamic-complete-environment-variable "shell"
-  "Dynamically complete the environment variable at point." t)
-
-
-
-(defun sh-newline-and-indent ()
-  "Strip unquoted whitespace, insert newline, and indent like current line."
-  (interactive "*")
-  (indent-to (prog1 (current-indentation)
-	       (delete-region (point)
-			      (progn
-				(or (zerop (skip-chars-backward " \t"))
-				    (if (sh-quoted-p)
-					(forward-char)))
-				(point)))
-	       (newline))))
-
-
-
-(defun sh-beginning-of-command ()
-  "Move point to successive beginnings of commands."
-  (interactive)
-  (if (re-search-backward sh-beginning-of-command nil t)
-      (goto-char (match-beginning 2))))
-
-
-(defun sh-end-of-command ()
-  "Move point to successive ends of commands."
-  (interactive)
-  (if (re-search-forward sh-end-of-command nil t)
-      (goto-char (match-end 1))))
-
-(provide 'sh-script)
-;; sh-script.el ends here
diff --git a/lisp/progmodes/simula.el b/lisp/progmodes/simula.el
deleted file mode 100644
index c4de80bfd61..00000000000
--- a/lisp/progmodes/simula.el
+++ /dev/null
@@ -1,1773 +0,0 @@
-;;; simula.el --- SIMULA 87 code editing commands for Emacs
-
-;; Copyright (C) 1992, 1994, 1996 Free Software Foundation, Inc.
-
-;; Author: Hans Henrik Eriksen <hhe@ifi.uio.no>
-;; Maintainer: simula-mode@ifi.uio.no
-;; Adapted-By: ESR
-;; Keywords: languages
-
-;; 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:
-
-;; A major mode for editing the Simula language.  It knows about Simula
-;; syntax and standard indentation commands.  It also provides convenient
-;; abbrevs for Simula keywords.
-;;
-;; Hans Henrik Eriksen (the author) may be reached at:
-;;         Institutt for informatikk,
-;;         Universitetet i Oslo
-
-;;; Code:
-
-
-(defconst simula-tab-always-indent-default nil
-  "Non-nil means TAB in SIMULA mode should always reindent the current line.
-Otherwise TAB indents only when point is within
-the run of whitespace at the beginning of the line.")
-
-(defvar simula-tab-always-indent simula-tab-always-indent-default
-  "*Non-nil means TAB in SIMULA mode should always reindent the current line.
-Otherwise TAB indents only when point is within
-the run of whitespace at the beginning of the line.")
-
-(defconst simula-indent-level-default 3
-  "Indentation of SIMULA statements with respect to containing block.")
-
-(defvar simula-indent-level simula-indent-level-default
-  "*Indentation of SIMULA statements with respect to containing block.")
-
-(defconst simula-substatement-offset-default 3
-  "Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
-
-(defvar simula-substatement-offset simula-substatement-offset-default
-  "*Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.")
-
-(defconst simula-continued-statement-offset-default 3
-  "Extra indentation for lines not starting a statement or substatement.
-If value is a list, each line in a multipleline continued statement
-will have the car of the list extra indentation with respect to
-the previous line of the statement.")
-
-(defvar simula-continued-statement-offset simula-continued-statement-offset-default
-  "*Extra indentation for lines not starting a statement or substatement.
-If value is a list, each line in a multipleline continued statement
-will have the car of the list extra indentation with respect to
-the previous line of the statement.")
-
-(defconst simula-label-offset-default -4711
-  "Offset of SIMULA label lines relative to usual indentation.")
-
-(defvar simula-label-offset simula-label-offset-default
-  "*Offset of SIMULA label lines relative to usual indentation.")
-
-(defconst simula-if-indent-default '(0 . 0)
-  "Extra indentation of THEN and ELSE with respect to the starting IF.
-Value is a cons cell, the car is extra THEN indentation and the cdr
-extra ELSE indentation.  IF after ELSE is indented as the starting IF.")
-
-(defvar simula-if-indent simula-if-indent-default
-  "*Extra indentation of THEN and ELSE with respect to the starting IF.
-Value is a cons cell, the car is extra THEN indentation and the cdr
-extra ELSE indentation.  IF after ELSE is indented as the starting IF.")
-
-(defconst simula-inspect-indent-default '(0 . 0)
-  "Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
-Value is a cons cell, the car is extra WHEN indentation
-and the cdr extra OTHERWISE indentation.")
-
-(defvar simula-inspect-indent simula-inspect-indent-default
-  "*Extra indentation of WHEN and OTHERWISE with respect to the INSPECT.
-Value is a cons cell, the car is extra WHEN indentation
-and the cdr extra OTHERWISE indentation.")
-
-(defconst simula-electric-indent-default nil
-  "Non-nil means `simula-indent-line' function may reindent previous line.")
-
-(defvar simula-electric-indent simula-electric-indent-default
-  "*Non-nil means `simula-indent-line' function may reindent previous line.")
-
-(defconst simula-abbrev-keyword-default 'upcase
-  "Specify how to convert case for SIMULA keywords.
-Value is one of the symbols `upcase', `downcase', `capitalize',
-(as in) `abbrev-table' or nil if they should not be changed.")
-
-(defvar simula-abbrev-keyword simula-abbrev-keyword-default
-  "*Specify how to convert case for SIMULA keywords.
-Value is one of the symbols `upcase', `downcase', `capitalize',
-(as in) `abbrev-table' or nil if they should not be changed.")
-
-(defconst simula-abbrev-stdproc-default 'abbrev-table
-  "Specify how to convert case for standard SIMULA procedure and class names.
-Value is one of the symbols `upcase', `downcase', `capitalize',
-(as in) `abbrev-table', or nil if they should not be changed.")
-
-(defvar simula-abbrev-stdproc simula-abbrev-stdproc-default
-  "*Specify how to convert case for standard SIMULA procedure and class names.
-Value is one of the symbols `upcase', `downcase', `capitalize',
-(as in) `abbrev-table', or nil if they should not be changed.")
-
-(defvar simula-abbrev-file nil
-  "*File with extra abbrev definitions for use in SIMULA mode.
-These are used together with the standard abbrev definitions for SIMULA.
-Please note that the standard definitions are required
-for SIMULA mode to function correctly.")
-
-(defvar simula-mode-syntax-table nil
-  "Syntax table in SIMULA mode buffers.")
-
-;; Regexps written with help from Alf-Ivar Holm <alfh@ifi.uio.no>.
-(defconst simula-font-lock-keywords-1
-  (list
-   ;;
-   ;; Comments and strings.
-   '(simula-match-string-or-comment 0
-     (if (match-beginning 1) font-lock-string-face font-lock-comment-face))
-   ;;
-   ;; Compiler directives.
-   '("^%\\([^ \t\n].*\\)" 1 font-lock-reference-face)
-   ;;
-   ;; Class and procedure names.
-   '("\\<\\(class\\|procedure\\)\\>[ \t]*\\(\\sw+\\)?"
-     (1 font-lock-keyword-face) (2 font-lock-function-name-face nil t))
-   )
-  "Subdued level highlighting for Simula mode.")
-
-(defconst simula-font-lock-keywords-2
-  (append simula-font-lock-keywords-1
-   (list
-    ;;
-    ;; Constants as references.
-    '("\\<\\(false\\|none\\|notext\\|true\\)\\>" . font-lock-reference-face)
-    ;;
-    ;; Keywords.
-    (concat "\\<\\("
-;	    (make-regexp
-;	     '("activate" "after" "and" "at" "before" "begin" "delay" "do"
-;	       "else" "end" "eq" "eqv" "external" "for" "ge" "go" "goto" "gt"
-;	       "hidden" "if" "imp" "in" "inner" "inspect" "is" "label" "le"
-;	       "lt" "ne" "new" "not" "or" "otherwise" "prior" "protected"
-;	       "qua" "reactivate" "step" "switch" "then" "this" "to" "until"
-;	       "virtual" "when" "while"))
-	    "a\\(ctivate\\|fter\\|nd\\|t\\)\\|be\\(fore\\|gin\\)\\|"
-	    "d\\(elay\\|o\\)\\|e\\(lse\\|nd\\|qv?\\|xternal\\)\\|for\\|"
-	    "g\\([eot]\\|oto\\)\\|hidden\\|i\\([fns]\\|mp\\|n\\(ner\\|"
-	    "spect\\)\\)\\|l\\([et]\\|abel\\)\\|n\\(ew?\\|ot\\)\\|"
-	    "o\\(r\\|therwise\\)\\|pr\\(ior\\|otected\\)\\|qua\\|"
-	    "reactivate\\|s\\(tep\\|witch\\)\\|t\\(h\\(en\\|is\\)\\|o\\)\\|"
-	    "until\\|virtual\\|wh\\(en\\|ile\\)"	    
-	    "\\)\\>")
-    ;;
-    ;; Types.
-    (cons (concat "\\<\\(array\\|boolean\\|character\\|integer\\|"
-		  "long\\|name\\|real\\|short\\|text\\|value\\|ref\\)\\>")
-	  'font-lock-type-face)
-    ))
-  "Medium level highlighting for Simula mode.")
-
-(defconst simula-font-lock-keywords-3
-  (append simula-font-lock-keywords-2
-   (list
-    ;;
-    ;; Super-class names and super-slow.
-    '("\\<\\(\\sw+\\)[ \t]+class\\>" 1 font-lock-function-name-face)
-    ;;
-    ;; Types and their declarations.
-    (list (concat "\\<\\(array\\|boolean\\|character\\|integer\\|"
-		  "long\\|name\\|real\\|short\\|text\\|value\\)\\>"
-		  "\\([ \t]+\\sw+\\>\\)*")
-	  '(font-lock-match-c-style-declaration-item-and-skip-to-next
-	    ;; Start with point after all type specifiers.
-	    (goto-char (or (match-beginning 2) (match-end 1)))
-	    ;; Finish with point after first type specifier.
-	    (goto-char (match-end 1))
-	    ;; Fontify as a variable name.
-	    (1 font-lock-variable-name-face)))
-    ;;
-    ;; Object references and their declarations.
-    '("\\<\\(ref\\)\\>[ \t]*\\((\\(\\sw+\\))\\)?"
-      (3 font-lock-function-name-face nil t)
-      (font-lock-match-c-style-declaration-item-and-skip-to-next nil nil
-       (1 font-lock-variable-name-face)))
-    ))
-  "Gaudy level highlighting for Simula mode.")
-
-(defvar simula-font-lock-keywords simula-font-lock-keywords-1
-  "Default expressions to highlight in Simula mode.")
-
-; The following function is taken from cc-mode.el,
-; it determines the flavor of the Emacs running
-(defconst simula-emacs-features
-  (let ((major (and (boundp 'emacs-major-version)
-		    emacs-major-version))
-	(minor (and (boundp 'emacs-minor-version)
-		    emacs-minor-version))
-	flavor comments)
-    ;; figure out version numbers if not already discovered
-    (and (or (not major) (not minor))
-	 (string-match "\\([0-9]+\\).\\([0-9]+\\)" emacs-version)
-	 (setq major (string-to-int (substring emacs-version
-					       (match-beginning 1)
-					       (match-end 1)))
-	       minor (string-to-int (substring emacs-version
-					       (match-beginning 2)
-					       (match-end 2)))))
-    (if (not (and major minor))
-	(error "Cannot figure out the major and minor version numbers."))
-    ;; calculate the major version
-    (cond
-     ((= major 18) (setq major 'v18))	;Emacs 18
-     ((= major 4)  (setq major 'v18))	;Epoch 4
-     ((= major 19) (setq major 'v19	;Emacs 19
-			 flavor (if (string-match "Lucid" emacs-version)
-				    'Lucid 'FSF)))
-     ;; I don't know
-     (t (error "Cannot recognize major version number: %s" major)))
-        (list major flavor comments))
-  "A list of features extant in the Emacs you are using.
-There are many flavors of Emacs out there, each with different
-features supporting those needed by simula-mode.  Here's the current
-supported list, along with the values for this variable:
-
- Emacs 19:                  (v19 FSF 1-bit)
- Vanilla Emacs 18/Epoch 4:  (v18 no-dual-comments)
- Emacs 18/Epoch 4 (patch2): (v18 8-bit)
- Lucid Emacs 19:            (v19 Lucid 8-bit).")
-
-(defvar simula-mode-menu
-  '(["Report Bug"	      simula-submit-bug-report t]
-    ["Indent Line"	      simula-indent-line t]
-    ["Backward Statement"     simula-previous-statement t]
-    ["Forward Statement"      simula-next-statement t]
-    ["Backward Up Level"      simula-backward-up-level t]
-    ["Forward Down Statement" simula-forward-down-level t]
-    )
-  "Lucid Emacs menu for SIMULA mode.")
-
-(if simula-mode-syntax-table
-    ()
-  (setq simula-mode-syntax-table (copy-syntax-table (standard-syntax-table)))
-  (modify-syntax-entry ?!  "<"    simula-mode-syntax-table)
-  (modify-syntax-entry ?$  "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?%  "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?'  "\""   simula-mode-syntax-table)
-  (modify-syntax-entry ?\( "()"   simula-mode-syntax-table)
-  (modify-syntax-entry ?\) ")("   simula-mode-syntax-table)
-  (modify-syntax-entry ?\; ">"    simula-mode-syntax-table)
-  (modify-syntax-entry ?\[ "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?\\ "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?\] "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?_  "_"    simula-mode-syntax-table)
-  (modify-syntax-entry ?\| "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?\{ "."    simula-mode-syntax-table)
-  (modify-syntax-entry ?\} "."    simula-mode-syntax-table))
-
-(defvar simula-mode-map ()
-  "Keymap used in SIMULA mode.")
-
-(if simula-mode-map
-    ()
-  (setq simula-mode-map (make-sparse-keymap))
-  (define-key simula-mode-map "\C-c\C-u"   'simula-backward-up-level)
-  (define-key simula-mode-map "\C-c\C-p"   'simula-previous-statement)
-  (define-key simula-mode-map "\C-c\C-d"   'simula-forward-down-level)
-  (define-key simula-mode-map "\C-c\C-n"   'simula-next-statement)
-  ;(define-key simula-mode-map "\C-c\C-g"   'simula-goto-definition)
-  ;(define-key simula-mode-map "\C-c\C-h"   'simula-standard-help)
-  (define-key simula-mode-map "\177"       'backward-delete-char-untabify)
-  (define-key simula-mode-map ":"          'simula-electric-label)
-  (define-key simula-mode-map "\e\C-q"     'simula-indent-exp)
-  (define-key simula-mode-map "\t"         'simula-indent-command)
-  ;; Emacs 19 defines menus in the mode map
-  (if (memq 'FSF simula-emacs-features)
-      (progn
-	(define-key simula-mode-map [menu-bar] (make-sparse-keymap))
-
-	(define-key simula-mode-map [menu-bar simula]
-	  (cons "SIMULA" (make-sparse-keymap "SIMULA")))
-	(define-key simula-mode-map [menu-bar simula bug-report]
-	  '("Submit Bug Report" . simula-submit-bug-report))
-	(define-key simula-mode-map [menu-bar simula separator-indent]
-	  '("--"))
-	(define-key simula-mode-map [menu-bar simula indent-exp]
-	  '("Indent Expression" . simula-indent-exp))
-	(define-key simula-mode-map [menu-bar simula indent-line]
-	  '("Indent Line" . simula-indent-command))
-	(define-key simula-mode-map [menu-bar simula separator-navigate]
-	  '("--"))
-	(define-key simula-mode-map [menu-bar simula backward-stmt]
-	  '("Previous Statement" . simula-previous-statement))
-	(define-key simula-mode-map [menu-bar simula forward-stmt]
-	  '("Next Statement" . simula-next-statement))
-	(define-key simula-mode-map [menu-bar simula backward-up]
-	  '("Backward Up Level" . simula-backward-up-level))
-	(define-key simula-mode-map [menu-bar simula forward-down]
-	  '("Forward Down Statement" . simula-forward-down-level))
-
-	(put 'simula-next-statement 'menu-enable '(not (eobp)))
-	(put 'simula-previous-statement 'menu-enable '(not (bobp)))
-	(put 'simula-forward-down-level 'menu-enable '(not (eobp)))
-	(put 'simula-backward-up-level 'menu-enable '(not (bobp)))
-	(put 'simula-indent-command 'menu-enable '(not buffer-read-only))
-	(put 'simula-indent-exp 'menu-enable '(not buffer-read-only))))
-
-  ;; RMS: mouse-3 should not select this menu.  mouse-3's global
-  ;; definition is useful in SIMULA mode and we should not interfere
-  ;; with that.  The menu is mainly for beginners, and for them,
-  ;; the menubar requires less memory than a special click.
-  ;; in Lucid Emacs, we want the menu to popup when the 3rd button is
-  ;; hit.  In 19.10 and beyond this is done automatically if we put
-  ;; the menu on mode-popup-menu variable, see c-common-init [cc-mode.el]
-  (if (memq 'Lucid simula-emacs-features)
-      (if (not (boundp 'mode-popup-menu))
-	  (define-key simula-mode-map 'button3 'simula-popup-menu))))
-
-;; menus for Lucid
-(defun simula-popup-menu (e)
-  "Pops up the SIMULA menu."
-  (interactive "@e")
-  (popup-menu (cons (concat mode-name " Mode Commands") simula-mode-menu))
-  (simula-keep-region-active))
-
-;; active regions, and auto-newline/hungry delete key
-(defun simula-keep-region-active ()
-  ;; do whatever is necessary to keep the region active in
-  ;; Lucid. ignore byte-compiler warnings you might see
-  (and (boundp 'zmacs-region-stays)
-       (setq zmacs-region-stays t)))
-
-(defvar simula-mode-abbrev-table nil
-  "Abbrev table in SIMULA mode buffers")
-
-
-;;;###autoload
-(defun simula-mode ()
-  "Major mode for editing SIMULA code.
-\\{simula-mode-map}
-Variables controlling indentation style:
- simula-tab-always-indent
-    Non-nil means TAB in SIMULA mode should always reindent the current line,
-    regardless of where in the line point is when the TAB command is used.
- simula-indent-level
-    Indentation of SIMULA statements with respect to containing block.
- simula-substatement-offset
-    Extra indentation after DO, THEN, ELSE, WHEN and OTHERWISE.
- simula-continued-statement-offset 3
-    Extra indentation for lines not starting a statement or substatement,
-    e.g. a nested FOR-loop.  If value is a list, each line in a multiple-
-    line continued statement will have the car of the list extra indentation
-    with respect to the previous line of the statement.
- simula-label-offset -4711
-    Offset of SIMULA label lines relative to usual indentation.
- simula-if-indent '(0 . 0)
-    Extra indentation of THEN and ELSE with respect to the starting IF.
-    Value is a cons cell, the car is extra THEN indentation and the cdr
-    extra ELSE indentation.  IF after ELSE is indented as the starting IF.
- simula-inspect-indent '(0 . 0)
-    Extra indentation of WHEN and OTHERWISE with respect to the
-    corresponding INSPECT.  Value is a cons cell, the car is
-    extra WHEN indentation and the cdr extra OTHERWISE indentation.
- simula-electric-indent nil
-    If this variable is non-nil, `simula-indent-line'
-    will check the previous line to see if it has to be reindented.
- simula-abbrev-keyword 'upcase
-    Determine how SIMULA keywords will be expanded.  Value is one of
-    the symbols `upcase', `downcase', `capitalize', (as in) `abbrev-table',
-    or nil if they should not be changed.
- simula-abbrev-stdproc 'abbrev-table
-    Determine how standard SIMULA procedure and class names will be
-    expanded.  Value is one of the symbols `upcase', `downcase', `capitalize',
-    (as in) `abbrev-table', or nil if they should not be changed.
-
-Turning on SIMULA mode calls the value of the variable simula-mode-hook
-with no arguments, if that value is non-nil
-
-Warning: simula-mode-hook should not read in an abbrev file without calling
-the function simula-install-standard-abbrevs afterwards, preferably not
-at all."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map simula-mode-map)
-  (setq major-mode 'simula-mode)
-  (setq mode-name "SIMULA")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-;  (make-local-variable 'end-comment-column)
-;  (setq end-comment-column 75)
-  (set-syntax-table simula-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start "[ \t]*$\\|\\f")
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'simula-indent-line)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'comment-start)
-  (setq comment-start "! ")
-  (make-local-variable 'comment-end)
-  (setq comment-end " ;")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "!+ *")
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments nil)
-  (make-local-variable 'comment-multi-line)
-  (setq comment-multi-line t)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults
-	'((simula-font-lock-keywords simula-font-lock-keywords-1
-	   simula-font-lock-keywords-2 simula-font-lock-keywords-3)
-	  t t ((?_ . "w"))))
-  (if simula-mode-abbrev-table
-      ()
-    (if simula-abbrev-file
-	(read-abbrev-file simula-abbrev-file)
-      (define-abbrev-table 'simula-mode-abbrev-table ()))
-    (let (abbrevs-changed)
-      (simula-install-standard-abbrevs)))
-  (setq local-abbrev-table simula-mode-abbrev-table)
-  (abbrev-mode 1)
-  (run-hooks 'simula-mode-hook))
-
-
-(defun simula-indent-exp ()
-  "Indent SIMULA expression following point."
-  (interactive)
-  (let ((here (point))
-	(simula-electric-indent nil)
-	end)
-    (simula-skip-comment-forward)
-    (if (eobp)
-	(goto-char here)
-      (unwind-protect
-	  (progn
-	    (simula-next-statement 1)
-	    (setq end (point-marker))
-	    (simula-previous-statement 1)
-	    (beginning-of-line)
-	    (while (< (point) end)
-	      (if (not (looking-at "[ \t]*$"))
-		  (simula-indent-line))
-	      (forward-line 1)))
-	(and end (set-marker end nil))))))
-      
-
-(defun simula-indent-line ()
-  "Indent this line as SIMULA code.
-If `simula-electric-indent' is non-nil, indent previous line if necessary."
-  (let ((origin (- (point-max) (point)))
-	(indent (simula-calculate-indent))
-	(case-fold-search t))
-    (unwind-protect
-	(if simula-electric-indent
-	    (progn
-	      ;;
-	      ;; manually expand abbrev on last line, if any
-	      ;;
-	      (end-of-line 0)
-	      (expand-abbrev)
-	      ;; now maybe we should reindent that line
-	      (beginning-of-line)
-	      (skip-chars-forward " \t\f")
-	      (if (and
-		   (looking-at
-		    "\\(end\\|if\\|then\\|else\\|when\\|otherwise\\)\\>")
-		   (not (simula-context)))
-		  ;; yes - reindent
-		  (let ((post-indent (simula-calculate-indent)))
-		    (if (eq (current-indentation) post-indent)
-			()
-		      (delete-horizontal-space)
-		      (indent-to post-indent))))))
-      (goto-char (- (point-max) origin))
-      (if (eq (current-indentation) indent)
-	  (back-to-indentation)
-	(delete-horizontal-space)
-	(indent-to indent)))))
-
-
-(defun simula-indent-command (&optional whole-exp)
-  "Indent current line as SIMULA code, or insert TAB character.
-If `simula-tab-always-indent' is non-nil, always indent current line.
-Otherwise, indent only if point is before any non-whitespace
-character on the line.
-
-A numeric argument, regardless of its value, means indent rigidly
-all the lines of the SIMULA statement after point so that this line
-becomes properly indented.
-The relative indentation among the lines of the statement are preserved."
-  (interactive "P")
-  (let ((case-fold-search t))
-    (if (or whole-exp simula-tab-always-indent
-	    (save-excursion
-	      (skip-chars-backward " \t\f")
-	      (bolp)))
-	;; reindent current line
-	(let ((indent (save-excursion
-			(beginning-of-line)
-			(simula-calculate-indent)))
-	      (current (current-indentation))
-	      (origin (- (point-max) (point)))
-	      (bol (save-excursion
-		     (skip-chars-backward " \t\f")
-		     (bolp)))
-	      beg end)
-	  (unwind-protect
-	      (if (eq current indent)
-		  (if (save-excursion
-			(skip-chars-backward " \t\f")
-			(bolp))
-		      (back-to-indentation))
-		(beginning-of-line)
-		(delete-horizontal-space)
-		(indent-to indent))
-	    (if (not bol)
-		(goto-char (- (point-max) origin))))
-	  (setq origin (point))
-	  (if whole-exp
-	      (save-excursion
-		(beginning-of-line 2)
-		(setq beg (point))
-		(goto-char origin)
-		(simula-next-statement 1)
-		(setq end (point))
-		(if (and (> end beg) (not (eq indent current)))
-		    (indent-code-rigidly beg end (- indent current) "%")))))
-      (insert-tab))))
-
-
-(defun simula-context ()
-  "Returns value according to syntactic SIMULA context of point.
-    0    point inside COMMENT comment
-    1    point on SIMULA-compiler directive line
-    2    point inside END comment
-    3    point inside string
-    4    point inside character constant
-  nil    otherwise."
-  ;; first, find out if this is a compiler directive line
-  (if (save-excursion
-	(beginning-of-line)
-	(eq (following-char) ?%))
-      ;; YES - return 1
-      1
-    (save-excursion
-      ;; The current line is NOT a compiler directive line.
-      ;; Now, the strategy is to search backward to find a semicolon
-      ;; that is NOT inside a string. The point after semicolon MUST be
-      ;; outside a comment, since semicolons are comment-ending and
-      ;; comments are non-recursive. We take advantage of the fact
-      ;; that strings MUST end on the same line as they started, so
-      ;; that we can easily decide whether we are inside a string or not.
-      (let (return-value (origin (point)))
-	(skip-chars-backward "^;" (point-min))
-	;; found semicolon or beginning of buffer
-	(let (loopvalue (saved-point origin))
-	  (while (and (not (bobp))
-		      (if (progn
-			    (beginning-of-line)
-			    ;; compiler directive line? If so, cont searching..
-			    (eq (following-char) ?%))
-			  t
-			(while (< (point) saved-point)
-			  (skip-chars-forward "^;\"'")
-			  (forward-char 1)
-			  (cond
-			   ((eq (preceding-char) ?\;)
-			    (setq saved-point (point)))
-			   ((eq (preceding-char) ?\")
-			    (skip-chars-forward "^\";")
-			    (if (eq (following-char) ?\;)
-				(setq saved-point (point) loopvalue t)
-			      (forward-char 1)))
-			   (t
-			    (if (eq (following-char) ?')
-				(forward-char 1))
-			    (skip-chars-forward "^';")
-			    (if (eq (following-char) ?\;)
-				(setq saved-point (point) loopvalue t)
-			      (forward-char 1)))))
-			loopvalue))
-	    (backward-char 1)
-	    (skip-chars-backward "^;")
-	    (setq saved-point (point) loopvalue nil)))
-	;; Now we are CERTAIN that we are outside comments and strings.
-	;; The job now is to search forward again towards the origin
-	;; skipping directives, comments and strings correctly,
-	;; so that we know what context we are in when we find the origin.
-	(while (and
-		(< (point) origin)
-		(re-search-forward
-		 "\\<end\\>\\|!\\|\"\\|'\\|^%\\|\\<comment\\>" origin 'move))
-	  (cond
-	   ((memq (preceding-char) '(?d ?D))
-	    (setq return-value 2)
-	    (while (and (re-search-forward
-			 ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>\\|^%"
-			 origin 'move)
-			;; found another END?
-			(or (memq (preceding-char) '(?d ?D))
-			    ;; if directive, skip line
-			    (and (eq (preceding-char) ?%)
-				 (beginning-of-line 2))
-			    ;; found other keyword, out of END comment
-			    (setq return-value nil))))
-	    (if (and (eq (char-syntax (preceding-char)) ?w)
-		     (eq (char-syntax (following-char)) ?w))
-		(save-excursion
-		  (backward-word 1)
-		  (if (looking-at "end\\>\\|else\\>\\|otherwise\\>\\|when\\>")
-		      (setq return-value nil)))))
-	   ((memq (preceding-char) '(?! ?t ?T))
-	    ; skip comment
-	    (setq return-value 0)
-	    (skip-chars-forward "^%;" origin)
-	    (while (and return-value (< (point) origin))
-	      (if (eq (following-char) ?\;)
-		  (setq return-value nil)
-		(if (bolp)
-		    (beginning-of-line 2)	; skip directive inside comment
-		  (forward-char 1))		; or single '%'
-		(skip-chars-forward "^%;" origin))))
-	   ((eq (preceding-char) ?\")
-	    (if (not (search-forward "\"" origin 'move))
-		(setq return-value 3)))
-	   ((eq (preceding-char) ?\')
-	    (if (or (eq (point) origin) (eobp))
-		(setq return-value 4)
-	      (forward-char 1)
-	      (if (not (search-forward "'" origin 'move))
-		  (setq return-value 4))))
-	   ;; compiler directive line - skip
-	   (t (beginning-of-line 2))))
-	return-value)
-      )))
-
-
-(defun simula-electric-label ()
-  "If this is a label that starts the line, reindent the line."
-  (interactive)
-  (expand-abbrev)
-  (insert ?:)
-  (let ((origin (- (point-max) (point)))
-	(case-fold-search t)
-	;; don't mix a label with an assignment operator := :-
-	;; therefore take a peek at next typed character...
-	(next-char (read-event)))
-    (unwind-protect
-	(setq unread-command-events (append unread-command-events
-					    (list next-char)))
-	;; Problem: find out if character just read is a command char
-	;; that would insert something after ':' making it a label.
-	;; At least \n, \r (and maybe \t) falls into this category.
-	;; This is a real crock, it depends on traditional keymap
-	;; bindings, that is, printing characters doing self-insert,
-	;; and no other command sequence inserting '-' or '='.
-	;; simula-electric-label can be easily fooled...
-	(if (and (not (memq next-char '(?= ?-)))
-		 (or (memq next-char '(?\n ?\r))
-		     (and (eq next-char ?\t)
-			  simula-tab-always-indent)
-		     (not (memq (following-char) '(?= ?-))))
-		 (not (simula-context))
-		 ;; label?
-		 (progn
-		   (backward-char 1)
-		   (skip-chars-backward " \t\f")
-		   (skip-chars-backward "a-zA-Z0-9_")
-		   (if (looking-at "virtual\\>")
-		       nil
-		     (skip-chars-backward " \t\f")
-		     (bolp))))
-	    (let ((amount (simula-calculate-indent)))
-	      (delete-horizontal-space)
-	      (indent-to amount)))
-      (goto-char (- (point-max) origin)))))
-	
-
-(defun simula-backward-up-level (count)
-  "Move backward up COUNT block levels.
-If COUNT is negative, move forward up block level instead."
-  (interactive "p")
-  (let ((origin (point))
-	(case-fold-search t))
-    (condition-case ()
-	(if (> count 0)
-	    (while (> count 0)
-	      (re-search-backward "\\<begin\\>\\|\\<end\\>")
-	      (if (not (simula-context))
-		  (setq count (if (memq (following-char) '(?b ?B))
-				  (1- count)
-				(1+ count)))))
-	  (while (< count 0)
-	    (re-search-forward "\\<begin\\>\\|\\<end\\>")
-	    (backward-word 1)
-	    (if (not (simula-context))
-		(setq count (if (memq (following-char) '(?e ?E))
-				(1+ count)
-			      (1- count))))
-	    (backward-word -1)))
-      ;; If block level not found, jump back to origin and signal an error
-      (error (progn
-	       (goto-char origin)
-	       (error "No higher block level")))
-      (quit (progn
-	      (goto-char origin)
-	      (signal 'quit nil))))))
-
-
-(defun simula-forward-down-level (count)
-  "Move forward down COUNT block levels.
-If COUNT is negative, move backward down block level instead."
-  (interactive "p")
-  ;; When we search for a deeper block level, we must never
-  ;; get out of the block where we started -> count >= start-count
-  (let ((start-count count)
-	(origin (point))
-	(case-fold-search t))
-    (condition-case ()
-	(if (< count 0)
-	    (while (< count 0)
-	      (re-search-backward "\\<begin\\>\\|\\<end\\>")
-	      (if (not (simula-context))
-		  (setq count (if (memq (following-char) '(?e ?E))
-				  (1+ count)
-				(1- count))))
-	      (if (< count start-count) (signal 'error nil)))
-	  (while (> count 0)
-	    (re-search-forward "\\<begin\\>\\|\\<end\\>")
-	    (backward-word 1)
-	    (if (not (simula-context))
-		(setq count (if (memq (following-char) '(?b ?B))
-				(1- count)
-			      (1+ count))))
-	    (backward-word -1)
-	    ;; deeper level has to be found within starting block
-	    (if (> count start-count) (signal 'error nil))))
-      ;; If block level not found, jump back to origin and signal an error
-      (error (progn
-	       (goto-char origin)
-	       (error "No containing block level")))
-      (quit (progn
-	      (goto-char origin)
-	      (signal 'quit nil))))))
-
-     
-(defun simula-previous-statement (count)
-  "Move backward COUNT statements.
-If COUNT is negative, move forward instead."
-  (interactive "p")
-  (if (< count 0)
-      (simula-next-statement (- count))
-    (let (status
-	  (case-fold-search t)
-	  (origin (point)))
-      (condition-case ()
-	  ;; 
-	  (progn
-	    (simula-skip-comment-backward)
-	    (if (memq (preceding-char) '(?n ?N))
-		(progn
-		  (backward-word 1)
-		  (if (not (looking-at "\\<begin\\>"))
-		      (backward-word -1)))
-	      (if (eq (preceding-char) ?\;)
-		  (backward-char 1))
-	      )
-	    (while (and (natnump (setq count (1- count)))
-			(setq status (simula-search-backward
-				      ";\\|\\<begin\\>" nil 'move))))
-	    (if status
-		(progn
-		  (if (eq (following-char) ?\;)
-		      (forward-char 1)
-		    (backward-word -1))))
-	    (simula-skip-comment-forward))
-	(error (progn (goto-char origin)
-		      (error "Incomplete statement (too many ENDs)")))
-	(quit (progn (goto-char origin) (signal 'quit nil)))))))
-
-
-(defun simula-next-statement (count)
-  "Move forward COUNT statements.
-If COUNT is negative, move backward instead."
-  (interactive "p")
-  (if (< count 0)
-      (simula-previous-statement (- count))
-    (let (status
-	  (case-fold-search t)
-	  (origin (point)))
-      (condition-case ()
-	  (progn
-	    (simula-skip-comment-forward)
-	    (if (looking-at "\\<end\\>") (forward-word 1))
-	    (while (and (natnump (setq count (1- count)))
-			(setq status (simula-search-forward
-				      ";\\|\\<end\\>" (point-max) 'move))))
-	    (if (and status (/= (preceding-char) ?\;))
-		(progn
-		  (backward-word 1)
-		  (simula-skip-comment-backward))))
-	(error (progn (goto-char origin)
-		      (error "Incomplete statement (too few ENDs)")))
- 	(quit (progn (goto-char origin) (signal 'quit nil)))))))
-
-
-(defun simula-skip-comment-backward (&optional stop-at-end)
-  "Search towards bob to find first char that is outside a comment."
-  (interactive)
-  (catch 'simula-out
-    (let (context)
-      (while t
-	(skip-chars-backward " \t\n\f")
-	(if (eq (preceding-char) ?\;)
-	    (save-excursion
-	      (backward-char 1)
-	      (setq context (simula-context))
-	      (if (and stop-at-end (eq context 2))
-		  (setq context nil)))
-	  (setq context (simula-context)))
-	(cond
-	 ((memq context '(nil 3 4))
-	  ;; check to see if we found a label
-	  (if (and (eq (preceding-char) ?:)
-		   (not (memq (following-char) '(?- ?=)))
-		   (save-excursion
-		     (skip-chars-backward ": \t\fa-zA-Z0-9_")
-		     (not (looking-at "virtual\\>"))))
-	      (skip-chars-backward ": \t\fa-zA-Z0-9_")
-	    (throw 'simula-out nil)))
-	 ((eq context 0)
-	  ;; since we are inside a comment, it must start somewhere!
-	  (while (and (re-search-backward "!\\|\\<comment\\>")
-		      (memq (simula-context) '(0 1)))))
-	 ((eq context 1)
-	  (beginning-of-line)
-	  (if (bobp)
-	      (throw 'simula-out nil)
-	    (backward-char)))
-	 ((eq context 2)
-	  ;; an END-comment must belong to an END
-	  (re-search-backward "\\<end\\>")
-	  (forward-word 1)
-	  (throw 'simula-out nil))
-	 ;; should be impossible to get here..
-	 )))))
-
-
-(defun simula-skip-comment-forward ()
-  "Search towards eob to find first char that is outside a comment."
-  ;; this function assumes we start with point .outside a comment
-  (interactive)
-  (catch 'simula-out
-    (while t
-      (skip-chars-forward " \t\n\f")
-      ;; BUG: the following (0 2) branches don't take into account intermixing
-      ;; directive lines
-      (cond
-       ((looking-at "!\\|\\<comment\\>")
-	(search-forward ";" nil 'move))
-       ((and (bolp) (eq (following-char) ?%))
-	(beginning-of-line 2))
-       ((and (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]")
-	     (not (looking-at "virtual\\>")))
-	(skip-chars-forward "a-zA-Z0-9_ \t\f:"))
-       (t
-	(throw 'simula-out t))))))
-
-
-(defun simula-forward-up-level ()
-  (let ((continue-loop t)
-	(origin (point))
-	(case-fold-search t)
-	return-value
-	temp)
-    (while continue-loop
-      (if (re-search-backward "\\<begin\\>\\|\\<end\\>" (point-min) 'move)
-	  (setq temp (simula-context)
-	      return-value (and (memq (preceding-char) '(?d ?D))
-				(memq temp '(nil 2)))
-	      continue-loop (and (not return-value)
-				 (simula-forward-up-level)))
-	(setq continue-loop nil)))
-    (if return-value
-	t
-      (goto-char origin)
-      nil)))
-
-
-(defun simula-calculate-indent ()
-  (save-excursion
-    (let ((where (simula-context))
-	  (origin (point))
-	  (indent 0)
-	  continued
-	  start-line
-	  temp
-	  found-end
-	  prev-cont)
-      (cond
-       ((eq where 0)
-	;;
-	;; Comment.
-	;; If comment started on previous non-blank line, indent to the
-	;; column where the comment started, else indent as that line.
-	;;
-	(skip-chars-backward " \t\n\f")
-	(while (and (not (bolp)) (eq (simula-context) 0))
-	  (re-search-backward "^\\|!\\|\\<comment\\>"))
-	(skip-chars-forward " \t\n\f")
-	(prog1
-	    (current-column)
-	  (goto-char origin)))
-       ((eq where 1)
-	;;
-	;; Directive. Always 0.
-	;;
-	0)
-       ;;
-       ;; Detect missing string delimiters
-       ;;
-       ((eq where 3)
-	(error "Inside string"))
-       ((eq where 4)
-	(error "Inside character constant"))
-       ;;
-       ;; check to see if inside ()'s
-       ;;
-       ((setq temp (simula-inside-parens))
-	temp)
-       ;;
-       ;; Calculate non-comment indentation
-       (t
-	;; first, find out if this line starts with something that needs
-	;; special indentation (END/IF/THEN/ELSE/WHEN/OTHERWISE or label)
-	;;
-	(skip-chars-forward " \t\f")
-	(cond
-	 ;;
-	 ;; END
-	 ;;
-	 ((looking-at "end\\>")
-	  (setq indent (- simula-indent-level)
-		found-end t))
-	 ;;
-	 ;; IF/THEN/ELSE
-	 ;;
-	 ((looking-at "if\\>\\|then\\>\\|else\\>")
-	  ;; search for the *starting* IF
-	  (cond
-	   ((memq (following-char) '(?T ?t))
-	    (setq indent (car simula-if-indent)))
-	   ((memq (following-char) '(?E ?e))
-	    (setq indent (cdr simula-if-indent)))
-	   (t
-	    (forward-word 1)
-	    (setq indent 0)))
-	  (simula-find-if))
-	 ;;
-	 ;; WHEN/OTHERWISE
-	 ;;
-	 ((looking-at "when\\>\\|otherwise\\>")
-	  ;; search for corresponding INSPECT
-	  (if (memq (following-char) '(?W ?w))
-	      (setq indent (car simula-inspect-indent))
-	    (setq indent (cdr simula-inspect-indent)))
-	  (simula-find-inspect))
-	 ;;
-	 ;; label:
-	 ;;
-	 ((and (not (looking-at "virtual\\>"))
-	       (looking-at "[a-z0-9_]*[ \t\f]*:[^-=]"))
-	  (setq indent simula-label-offset)))
-	;; find line with non-comment text
-	(simula-skip-comment-backward 'dont-skip-end)
-	(if (and found-end
-		 (not (eq (preceding-char) ?\;))
-		 (if (memq (preceding-char) '(?N ?n))
-		     (save-excursion
-		       (backward-word 1)
-		       (not (looking-at "begin\\>")))
-		   t))
-	    (progn
-	      (simula-previous-statement 1)
-	      (simula-skip-comment-backward)))
-	(setq start-line
-	      (save-excursion (beginning-of-line) (point))
-	      ;; - perhaps this is a continued statement
-	      continued
-	      (save-excursion
-		(and (not (bobp))
-		     ;; (not found-end)
-		     (if (eq (char-syntax (preceding-char)) ?w)
-			 (progn
-			   (backward-word 1)
-			   (not (looking-at
-				 "begin\\|then\\|else\\|when\\|otherwise\\|do"
-				 )))
-		       (not (memq (preceding-char) '(?: ?\;)))))))
-	;;
-	;; MAIN calculation loop - count BEGIN/DO etc.
-	;;
-	(while (not (bolp))
-	  (if (re-search-backward
-	       ";\\|\\<\\(begin\\|end\\|if\\|else\\|then\\|when\\|otherwise\\|do\\)\\>"
-	       start-line 'move)
-	      (if (simula-context)
-		  ();; found something in a comment/string - ignore
-		(setq temp (following-char))
-		(cond
-		 ((eq temp ?\;)
-		  (simula-previous-statement 1))
-		 ((looking-at "begin\\>")
-		  (setq indent (+ indent simula-indent-level)))
-		 ((looking-at "end\\>")
-		  (forward-word 1)
-		  (simula-previous-statement 1))
-		 ((looking-at "do\\>")
-		  (setq indent (+ indent simula-substatement-offset))
-		  (simula-find-do-match))
-		 ((looking-at "\\(if\\|then\\|else\\)\\>")
-		  (if (memq temp '(?I ?i))
-		      (forward-word 1)
-		    (setq indent (+ indent
-				    simula-substatement-offset
-				    (if (memq temp '(?T ?t))
-					(car simula-if-indent)
-				      (cdr simula-if-indent)))))
-		  (simula-find-if))
-		 ((looking-at "\\<when\\>\\|\\<otherwise\\>")
-		  (setq indent (+ indent
-				  simula-substatement-offset
-				  (if (memq temp '(?W ?w))
-				      (car simula-if-indent)
-				    (cdr simula-if-indent))))
-		  (simula-find-inspect)))
-		;; found the start of a [sub]statement
-		;; add indentation for continued statement
-		(if continued
-		    (setq indent
-			  (+ indent
-			     (if (listp simula-continued-statement-offset)
-				 (car simula-continued-statement-offset)
-			       simula-continued-statement-offset))))
-		(setq start-line
-		      (save-excursion (beginning-of-line) (point))
-		      continued nil))
-	    ;; search failed .. point is at beginning of line
-	    ;; determine if we should continue searching
-	    ;; (at or before comment or label)
-	    ;; temp = t means finished
-	    (setq temp
-		  (and (not (simula-context))			
-		       (save-excursion
-			 (skip-chars-forward " \t\f")
-			 (or (looking-at "virtual")
-			     (not
-			      (looking-at
-			       "!\\|comment\\>\\|[a-z0-9_]*[ \t\f]*:[^-=]")))))
-		  prev-cont continued)
-	    ;; if we are finished, find current line's indentation
-	    (if temp
-		(setq indent (+ indent (current-indentation))))
-	    ;; find next line with non-comment SIMULA text
-	    ;; maybe indent extra if statement continues
-	    (simula-skip-comment-backward)
-	    (setq continued
-		  (and (not (bobp))
-		       (if (eq (char-syntax (preceding-char)) ?w)
-			   (save-excursion
-			     (backward-word 1)
-			     (not (looking-at
-				   "begin\\|then\\|else\\|when\\|otherwise\\|do")))
-			 (not (memq (preceding-char) '(?: ?\;))))))
-	    ;; if we the state of the continued-variable
-	    ;; changed, add indentation for continued statement
-	    (if (or (and prev-cont (not continued))
-		    (and continued
-			 (listp simula-continued-statement-offset)))
-		(setq indent
-		      (+ indent
-			 (if (listp simula-continued-statement-offset)
-			     (car simula-continued-statement-offset)
-			   simula-continued-statement-offset))))
-	    ;; while ends if point is at beginning of line at loop test
-	    (if (not temp)
-		(setq start-line (save-excursion (beginning-of-line) (point)))
-	      (beginning-of-line))))
-        ;;
-	;; return indentation
-	;;
-	indent)))))
-
-
-(defun simula-find-if ()
-  "Find starting IF of a IF-THEN[-ELSE[-IF-THEN...]] statement."
-  (catch 'simula-out
-    (while t
-      (if (and (simula-search-backward "\\<if\\>\\|;\\|\\<begin\\>"nil t)
-	       (memq (following-char) '(?I ?i)))
-	  (save-excursion
-	    ;;
-	    ;; find out if this IF was really the start of the IF statement
-	    ;;
-	    (simula-skip-comment-backward)
-	    (if (and (eq (char-syntax (preceding-char)) ?w)
-		     (progn
-		       (backward-word 1)
-		       (looking-at "else\\>")))
-		()
-	      (throw 'simula-out t)))
-	(if (not (looking-at "\\<if\\>"))
-	    (error "Missing IF or misplaced BEGIN or ';' (can't find IF)")
-	  ;;
-	  ;; we were at the starting IF in the first place..
-	  ;;
-	  (throw 'simula-out t))))))
-
-
-(defun simula-find-inspect ()
-  "Find INSPECT matching WHEN or OTHERWISE."
-  (catch 'simula-out
-    (let ((level 0))
-      ;;
-      ;; INSPECTs can be nested, have to find the corresponding one
-      ;;
-      (while t
-	(if (and (simula-search-backward "\\<inspect\\>\\|\\<otherwise\\>\\|;"
-					  nil t)
-		 (/= (following-char) ?\;))
-	    (if (memq (following-char) '(?O ?o))
-		(setq level (1+ level))
-	      (if (zerop level)
-		  (throw 'simula-out t)
-		(setq level (1- level))))
-	  (error "Missing INSPECT or misplaced ';' (can't find INSPECT)"))))))
-
-
-(defun simula-find-do-match ()
-  "Find keyword matching DO: FOR, WHILE, INSPECT or WHEN"
-  (while (and (re-search-backward
-	       "\\<\\(do\\|for\\|while\\|inspect\\|when\\|end\\|begin\\)\\>\\|;"
-	       nil 'move)
-	      (simula-context)))
-  (if (and (looking-at "\\<\\(for\\|while\\|inspect\\|when\\)\\>")
-	   (not (simula-context)))
-      () ;; found match
-    (error "No matching FOR, WHILE or INSPECT for DO, or misplaced ';'")))
-
-
-(defun simula-inside-parens ()
-  "Return position after `(' on line if inside parentheses, nil otherwise."
-  (save-excursion
-    (let ((parlevel 0))
-      (catch 'simula-out
-	(while t
-	  (if (re-search-backward "(\\|)\\|;" nil t)
-	      (if (eq (simula-context) nil)
-		  ;; found something - check it out
-		  (cond
-		   ((eq (following-char) ?\;)
-		    (if (zerop parlevel)
-			(throw 'simula-out nil)
-		      (error "Parenthesis mismatch or misplaced ';'")))
-		   ((eq (following-char) ?\()
-		    (if (zerop parlevel)
-			(throw 'simula-out (1+ (current-column)))
-		      (setq parlevel (1- parlevel))))
-		   (t (setq parlevel (1+ parlevel))))
-		);; nothing - inside comment or string
-	    ;; search failed
-	    (throw 'simula-out nil)))))))
-
-
-(defun simula-goto-definition ()
-  "Goto point of definition of variable, procedure or class."
-  (interactive))
-
-
-(defun simula-expand-stdproc ()
-  (if (or (not simula-abbrev-stdproc) (simula-context))
-      (unexpand-abbrev)
-    (cond
-     ((eq simula-abbrev-stdproc 'upcase) (upcase-word -1))
-     ((eq simula-abbrev-stdproc 'downcase) (downcase-word -1))
-     ((eq simula-abbrev-stdproc 'capitalize) (capitalize-word -1))
-     ((eq simula-abbrev-stdproc 'abbrev-table)
-      ;; If not in lowercase, expansions are always capitalized.
-      ;; We then want to replace with the exact expansion.
-      (if (equal (symbol-name last-abbrev) last-abbrev-text)
-	  ()
-	(downcase-word -1)
-	(expand-abbrev))))))
-
-
-(defun simula-expand-keyword ()
-  (if (or (not simula-abbrev-keyword) (simula-context))
-      (unexpand-abbrev)
-    (cond
-     ((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
-     ((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
-     ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1))
-     ((eq simula-abbrev-stdproc 'abbrev-table)
-      (if (equal (symbol-name last-abbrev) last-abbrev-text)
-	  ()
-	(downcase-word -1)
-	(expand-abbrev))))))
-
-
-(defun simula-electric-keyword ()
-  "Expand SIMULA keyword.  If it starts the line, reindent."
-  ;; redisplay
-  (let ((show-char (eq this-command 'self-insert-command)))
-    ;; If the abbrev expansion results in reindentation, the user may have
-    ;; to wait some time before the character he typed is displayed
-    ;; (the char causing the expansion is inserted AFTER the hook function
-    ;; is called). This is annoying in case of normal characters.
-    ;; However, if the user pressed a key bound to newline, it is better
-    ;; to have the line inserted after the begin-end match.
-    (if show-char
-	(progn
-	  (insert-char last-command-char 1)
-	  (sit-for 0)
-	  (backward-char 1)))
-    (if (let ((where (simula-context))
-	      (case-fold-search t))
-	  (if where
-	      (if (and (eq where 2) (eq (char-syntax (preceding-char)) ?w))
-		  (save-excursion
-		    (backward-word 1)
-		    (not (looking-at "end\\>"))))))
-	(unexpand-abbrev)
-      (cond
-       ((not simula-abbrev-keyword) (unexpand-abbrev))
-       ((eq simula-abbrev-keyword 'upcase) (upcase-word -1))
-       ((eq simula-abbrev-keyword 'downcase) (downcase-word -1))
-       ((eq simula-abbrev-keyword 'capitalize) (capitalize-word -1)))
-      (let ((pos (- (point-max) (point)))
-	    (case-fold-search t)
-	    null)
-	(condition-case null
-	    (progn
-	      ;; check if the expanded word is on the beginning of the line.
-	      (if (and (eq (char-syntax (preceding-char)) ?w)
-		       (progn
-			 (backward-word 1)
-			 (if (looking-at "end\\>")
-			     (save-excursion
-			       (simula-backward-up-level 1)
-			       (if (pos-visible-in-window-p)
-				   (sit-for 1)
-				 (message "Matches %s"
-					  (buffer-substring
-					   (point)
-					   (+ (point) (window-width)))))))
-			 (skip-chars-backward " \t\f")
-			 (bolp)))
-		  (let ((indent (simula-calculate-indent)))
-		    (if (eq indent (current-indentation))
-			()
-		      (delete-horizontal-space)
-		      (indent-to indent)))
-		(skip-chars-forward " \t\f"))
-	      ;; check for END - blow whistles and ring bells
-
-	      (goto-char (- (point-max) pos))
-	      (if show-char
-		  (delete-char 1)))
-	  (quit (goto-char (- (point-max) pos))))))))
-
-
-(defun simula-search-backward (regexp &optional bound noerror)
-  "Search backward from point for regular expression REGEXP, ignoring matches
-found inside SIMULA comments, string literals, and BEGIN..END blocks.
-Set point to the end of the occurrence found, and return point.
-An optional second argument BOUND bounds the search, it is a buffer position.
-The match found must not extend after that position.  Optional third argument
-NOERROR, if t, means if fail just return nil (no error).
-If not nil and not t, move to limit of search and return nil."
-  (let (begin end context (comb-regexp (concat regexp "\\|\\<end\\>"))
-	      match (start-point (point)))
-    (catch 'simula-backward
-      (while (re-search-backward comb-regexp bound 1)
-	;; We have a match, check SIMULA context at match-beginning
-	;; to see if we are outside comments etc.
-	;; Set MATCH to t if we found a true match,
-	;; set MATCH to 'BLOCK if we found a BEGIN..END block,
-	;; else set MATCH to nil.
-	(save-match-data
-	  (setq context (simula-context))
-	  (cond
-	   ((eq context nil)
-	    (setq match (if (looking-at regexp) t 'BLOCK)))
-;;; A comment-ending semicolon is part of the comment, and shouldn't match.
-;;;	     ((eq context 0)
-;;;	      (setq match (if (eq (following-char) ?\;) t nil)))
-	   ((eq context 2)
-	    (setq match (if (and (looking-at regexp)
-				 (looking-at ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>"))
-			    t
-			  (if (looking-at "\\<end\\>") 'BLOCK nil))))
-	   (t (setq match nil))))
-	;; Exit if true match
-	(if (eq match t) (throw 'simula-backward (point)))
-	(if (eq match 'BLOCK)
-	;; We found the END of a block
-	    (let ((level 0))
-	      (while (natnump level)
-		  (if (re-search-backward "\\<begin\\>\\|\\<end\\>" bound 1)
-		      (let ((context (simula-context)))
-			;;    We found a BEGIN -> decrease level count
-			(cond ((and (eq context nil)
-				   (memq (following-char) '(?b ?B)))
-			       (setq level (1- level)))
-			      ;; END -> increase level count
-			      ((and (memq context '(nil 2))
-				    (memq (following-char) '(?e ?E)))
-			       (setq level (1+ level)))))
-		    ;; Block search failed.  Action depends on noerror.
-		    (if (or (not noerror) (eq noerror t))
-			(goto-char start-point))
-		    (if (not noerror)
-			(signal 'search-failed (list regexp)))
-		    (throw 'simula-backward nil))))))
-      ;; Search failed.  Action depends on noerror.
-      (if (or (not noerror) (eq noerror t))
-	  (goto-char start-point))
-      (if noerror
-	  nil
-	(signal 'search-failed (list regexp))))))
-
-
-(defun simula-search-forward (regexp &optional bound noerror)
-  "Search forward from point for regular expression REGEXP, ignoring matches
-found inside SIMULA comments, string literals, and BEGIN..END blocks.
-Set point to the end of the occurrence found, and return point.
-An optional second argument BOUND bounds the search, it is a buffer position.
-The match found must not extend after that position.  Optional third argument
-NOERROR, if t, means if fail just return nil (no error).
-If not nil and not t, move to limit of search and return nil."
-  (let (begin end context (comb-regexp (concat regexp "\\|\\<begin\\>"))
-	      match (start-point (point)))
-    (catch 'simula-forward
-      (while (re-search-forward comb-regexp bound 1)
-	;; We have a match, check SIMULA context at match-beginning
-	;; to see if we are outside comments.
-	;; Set MATCH to t if we found a true match,
-	;; set MATCH to 'BLOCK if we found a BEGIN..END block,
-	;; else set MATCH to nil.
-	(save-match-data
-	  (save-excursion
-	    (goto-char (match-beginning 0))
-	    (setq context (simula-context))
-	    (cond
-	     ((not context)
-	      (setq match (if (looking-at regexp) t 'BLOCK)))
-;;; A comment-ending semicolon is part of the comment, and shouldn't match.
-;;;	     ((eq context 0)
-;;;	      (setq match (if (eq (following-char) ?\;) t nil)))
-	     ((eq context 2)
-	      (setq match (if (and (looking-at regexp)
-				   (looking-at ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>")) t nil)))
-	     (t (setq match nil)))))
-	;; Exit if true match
-	(if (eq match t) (throw 'simula-forward (point)))
-	(if (eq match 'BLOCK)
-	;; We found the BEGINning of a block
-	    (let ((level 0))
-	      (while (natnump level)
-		  (if (re-search-forward "\\<begin\\>\\|\\<end\\>" bound 1)
-		      (let ((context (simula-context)))
-			;;    We found a BEGIN -> increase level count
-			(cond ((eq context nil) (setq level (1+ level)))
-			      ;; END -> decrease level count
-			      ((and (eq context 2)
-				    ;; Don't match BEGIN inside END comment
-				    (memq (preceding-char) '(?d ?D)))
-			       (setq level (1- level)))))
-		    ;; Block search failed.  Action depends on noerror.
-		    (if (or (not noerror) (eq noerror t))
-			(goto-char start-point))
-		    (if (not noerror)
-			(signal 'search-failed (list regexp)))
-		    (throw 'simula-forward nil))))))
-      ;; Search failed.  Action depends on noerror.
-      (if (or (not noerror) (eq noerror t))
-	  (goto-char start-point))
-      (if noerror
-	  nil
-	(signal 'search-failed (list regexp))))))
-
-  
-(defun simula-install-standard-abbrevs ()
-  "Define Simula keywords, procedures and classes in local abbrev table."
-  ;; procedure and class names are as of the SIMULA 87 standard.
-  (interactive)
-  (mapcar (function (lambda (args)
-		      (apply 'define-abbrev simula-mode-abbrev-table args)))
-	  '(("abs" "Abs" simula-expand-stdproc)
-	    ("accum" "Accum" simula-expand-stdproc)
-	    ("activate" "ACTIVATE" simula-expand-keyword)
-	    ("addepsilon" "AddEpsilon" simula-expand-stdproc)
-	    ("after" "AFTER" simula-expand-keyword)
-	    ("and" "AND" simula-expand-keyword)
-	    ("arccos" "ArcCos" simula-expand-stdproc)
-	    ("arcsin" "ArcSin" simula-expand-stdproc)
-	    ("arctan" "ArcTan" simula-expand-stdproc)
-	    ("arctan2" "ArcTan2" simula-expand-stdproc)
-	    ("array" "ARRAY" simula-expand-keyword)
-	    ("at" "AT" simula-expand-keyword)
-	    ("before" "BEFORE" simula-expand-keyword)
-	    ("begin" "BEGIN" simula-expand-keyword)
-	    ("blanks" "Blanks" simula-expand-stdproc)
-	    ("boolean" "BOOLEAN" simula-expand-keyword)
-	    ("breakoutimage" "BreakOutImage" simula-expand-stdproc)
-	    ("bytefile" "ByteFile" simula-expand-stdproc)
-	    ("call" "Call" simula-expand-stdproc)
-	    ("cancel" "Cancel" simula-expand-stdproc)
-	    ("cardinal" "Cardinal" simula-expand-stdproc)
-	    ("char" "Char" simula-expand-stdproc)
-	    ("character" "CHARACTER" simula-expand-keyword)
-	    ("checkpoint" "CheckPoint" simula-expand-stdproc)
-	    ("class" "CLASS" simula-expand-keyword)
-	    ("clear" "Clear" simula-expand-stdproc)
-	    ("clocktime" "ClockTime" simula-expand-stdproc)
-	    ("close" "Close" simula-expand-stdproc)
-	    ("comment" "COMMENT" simula-expand-keyword)
-	    ("constant" "Constant" simula-expand-stdproc)
-	    ("copy" "Copy" simula-expand-stdproc)
-	    ("cos" "Cos" simula-expand-stdproc)
-	    ("cosh" "CosH" simula-expand-stdproc)
-	    ("cotan" "CoTan" simula-expand-stdproc)
-	    ("cputime" "CpuTime" simula-expand-stdproc)
-	    ("current" "Current" simula-expand-stdproc)
-	    ("datetime" "DateTime" simula-expand-stdproc)
-	    ("decimalmark" "DecimalMark" simula-expand-stdproc)
-	    ("delay" "DELAY" simula-expand-keyword)
-	    ("deleteimage" "DeleteImage" simula-expand-stdproc)
-	    ("detach" "Detach" simula-expand-stdproc)
-	    ("digit" "Digit" simula-expand-stdproc)
-	    ("directbytefile" "DirectByteFile" simula-expand-stdproc)
-	    ("directfile" "DirectFile" simula-expand-stdproc)
-	    ("discrete" "Discrete" simula-expand-stdproc)
-	    ("do" "DO" simula-expand-keyword)
-	    ("downcase" "Downcase" simula-expand-stdproc)
-	    ("draw" "Draw" simula-expand-stdproc)
-	    ("eject" "Eject" simula-expand-stdproc)
-	    ("else" "ELSE" simula-electric-keyword)
-	    ("empty" "Empty" simula-expand-stdproc)
-	    ("end" "END" simula-electric-keyword)
-	    ("endfile" "Endfile" simula-expand-stdproc)
-	    ("entier" "Entier" simula-expand-stdproc)
-	    ("eq" "EQ" simula-expand-keyword)
-	    ("eqv" "EQV" simula-expand-keyword)
-	    ("erlang" "Erlang" simula-expand-stdproc)
-	    ("error" "Error" simula-expand-stdproc)
-	    ("evtime" "EvTime" simula-expand-stdproc)
-	    ("exp" "Exp" simula-expand-stdproc)
-	    ("external" "EXTERNAL" simula-expand-keyword)
-	    ("false" "FALSE" simula-expand-keyword)
-	    ("field" "Field" simula-expand-stdproc)
-	    ("file" "File" simula-expand-stdproc)
-	    ("first" "First" simula-expand-stdproc)
-	    ("follow" "Follow" simula-expand-stdproc)
-	    ("for" "FOR" simula-expand-keyword)
-	    ("ge" "GE" simula-expand-keyword)
-	    ("getchar" "GetChar" simula-expand-stdproc)
-	    ("getfrac" "GetFrac" simula-expand-stdproc)
-	    ("getint" "GetInt" simula-expand-stdproc)
-	    ("getreal" "GetReal" simula-expand-stdproc)
-	    ("go" "GO" simula-expand-keyword)
-	    ("goto" "GOTO" simula-expand-keyword)
-	    ("gt" "GT" simula-expand-keyword)
-	    ("head" "Head" simula-expand-stdproc)
-	    ("hidden" "HIDDEN" simula-expand-keyword)
-	    ("histd" "HistD" simula-expand-stdproc)
-	    ("histo" "Histo" simula-expand-stdproc)
-	    ("hold" "Hold" simula-expand-stdproc)
-	    ("idle" "Idle" simula-expand-stdproc)
-	    ("if" "IF" simula-expand-keyword)
-	    ("image" "Image" simula-expand-stdproc)
-	    ("imagefile" "ImageFile" simula-expand-stdproc)
-	    ("imp" "IMP" simula-expand-keyword)
-	    ("in" "IN" simula-expand-keyword)
-	    ("inbyte" "InByte" simula-expand-stdproc)
-	    ("inbytefile" "InByteFile" simula-expand-stdproc)
-	    ("inchar" "InChar" simula-expand-stdproc)
-	    ("infile" "InFile" simula-expand-stdproc)
-	    ("infrac" "InFrac" simula-expand-stdproc)
-	    ("inimage" "InImage" simula-expand-stdproc)
-	    ("inint" "InInt" simula-expand-stdproc)
-	    ("inner" "INNER" simula-expand-keyword)
-	    ("inreal" "InReal" simula-expand-stdproc)
-	    ("inrecord" "InRecord" simula-expand-stdproc)
-	    ("inspect" "INSPECT" simula-expand-keyword)
-	    ("integer" "INTEGER" simula-expand-keyword)
-	    ("intext" "InText" simula-expand-stdproc)
-	    ("into" "Into" simula-expand-stdproc)
-	    ("is" "IS" simula-expand-keyword)
-	    ("isochar" "ISOChar" simula-expand-stdproc)
-	    ("isopen" "IsOpen" simula-expand-stdproc)
-	    ("isorank" "ISORank" simula-expand-stdproc)
-	    ("label" "LABEL" simula-expand-keyword)
-	    ("last" "Last" simula-expand-stdproc)
-	    ("lastitem" "LastItem" simula-expand-stdproc)
-	    ("lastloc" "LastLoc" simula-expand-stdproc)
-	    ("le" "LE" simula-expand-keyword)
-	    ("length" "Length" simula-expand-stdproc)
-	    ("letter" "Letter" simula-expand-stdproc)
-	    ("line" "Line" simula-expand-stdproc)
-	    ("linear" "Linear" simula-expand-stdproc)
-	    ("linesperpage" "LinesPerPage" simula-expand-stdproc)
-	    ("link" "Link" simula-expand-stdproc)
-	    ("linkage" "Linkage" simula-expand-stdproc)
-	    ("ln" "Ln" simula-expand-stdproc)
-	    ("locate" "Locate" simula-expand-stdproc)
-	    ("location" "Location" simula-expand-stdproc)
-	    ("lock" "Lock" simula-expand-stdproc)
-	    ("locked" "Locked" simula-expand-stdproc)
-	    ("log10" "Log10" simula-expand-stdproc)
-	    ("long" "LONG" simula-expand-keyword)
-	    ("lowcase" "LowCase" simula-expand-stdproc)
-	    ("lowerbound" "LowerBound" simula-expand-stdproc)
-	    ("lowten" "LowTen" simula-expand-stdproc)
-	    ("lt" "LT" simula-expand-keyword)
-	    ("main" "Main" simula-expand-stdproc)
-	    ("max" "Max" simula-expand-stdproc)
-	    ("maxint" "MaxInt" simula-expand-stdproc)
-	    ("maxlongreal" "MaxLongReal" simula-expand-stdproc)
-	    ("maxloc" "MaxLoc" simula-expand-stdproc)
-	    ("maxrank" "MaxRank" simula-expand-stdproc)
-	    ("maxreal" "MaxReal" simula-expand-stdproc)
-	    ("min" "Min" simula-expand-stdproc)
-	    ("minint" "MinInt" simula-expand-stdproc)
-	    ("minlongreal" "MinLongReal" simula-expand-stdproc)
-	    ("minrank" "MinRank" simula-expand-stdproc)
-	    ("minreal" "MinReal" simula-expand-stdproc)
-	    ("mod" "Mod" simula-expand-stdproc)
-	    ("more" "More" simula-expand-stdproc)
-	    ("name" "NAME" simula-expand-keyword)
-	    ("ne" "NE" simula-expand-keyword)
-	    ("negexp" "NegExp" simula-expand-stdproc)
-	    ("new" "NEW" simula-expand-keyword)
-	    ("nextev" "NextEv" simula-expand-stdproc)
-	    ("none" "NONE" simula-expand-keyword)
-	    ("normal" "Normal" simula-expand-stdproc)
-	    ("not" "NOT" simula-expand-keyword)
-	    ("notext" "NOTEXT" simula-expand-keyword)
-	    ("open" "Open" simula-expand-stdproc)
-	    ("or" "OR" simula-expand-keyword)
-	    ("otherwise" "OTHERWISE" simula-electric-keyword)
-	    ("out" "Out" simula-expand-stdproc)
-	    ("outbyte" "OutByte" simula-expand-stdproc)
-	    ("outbytefile" "OutByteFile" simula-expand-stdproc)
-	    ("outchar" "OutChar" simula-expand-stdproc)
-	    ("outfile" "OutFile" simula-expand-stdproc)
-	    ("outfix" "OutFix" simula-expand-stdproc)
-	    ("outfrac" "OutFrac" simula-expand-stdproc)
-	    ("outimage" "OutImage" simula-expand-stdproc)
-	    ("outint" "OutInt" simula-expand-stdproc)
-	    ("outreal" "OutReal" simula-expand-stdproc)
-	    ("outrecord" "OutRecord" simula-expand-stdproc)
-	    ("outtext" "OutText" simula-expand-stdproc)
-	    ("page" "Page" simula-expand-stdproc)
-	    ("passivate" "Passivate" simula-expand-stdproc)
-	    ("poisson" "Poisson" simula-expand-stdproc)
-	    ("pos" "Pos" simula-expand-stdproc)
-	    ("precede" "Precede" simula-expand-stdproc)
-	    ("pred" "Pred" simula-expand-stdproc)
-	    ("prev" "Prev" simula-expand-stdproc)
-	    ("printfile" "PrintFile" simula-expand-stdproc)
-	    ("prior" "PRIOR" simula-expand-keyword)
-	    ("procedure" "PROCEDURE" simula-expand-keyword)
-	    ("process" "Process" simula-expand-stdproc)
-	    ("protected" "PROTECTED" simula-expand-keyword)
-	    ("putchar" "PutChar" simula-expand-stdproc)
-	    ("putfix" "PutFix" simula-expand-stdproc)
-	    ("putfrac" "PutFrac" simula-expand-stdproc)
-	    ("putint" "PutInt" simula-expand-stdproc)
-	    ("putreal" "PutReal" simula-expand-stdproc)
-	    ("qua" "QUA" simula-expand-keyword)
-	    ("randint" "RandInt" simula-expand-stdproc)
-	    ("rank" "Rank" simula-expand-stdproc)
-	    ("reactivate" "REACTIVATE" simula-expand-keyword)
-	    ("real" "REAL" simula-expand-keyword)
-	    ("ref" "REF" simula-expand-keyword)
-	    ("resume" "Resume" simula-expand-stdproc)
-	    ("setaccess" "SetAccess" simula-expand-stdproc)
-	    ("setpos" "SetPos" simula-expand-stdproc)
-	    ("short" "SHORT" simula-expand-keyword)
-	    ("sign" "Sign" simula-expand-stdproc)
-	    ("simset" "SimSet" simula-expand-stdproc)
-	    ("simulaid" "SimulaId" simula-expand-stdproc)
-	    ("simulation" "Simulation" simula-expand-stdproc)
-	    ("sin" "Sin" simula-expand-stdproc)
-	    ("sinh" "SinH" simula-expand-stdproc)
-	    ("sourceline" "SourceLine" simula-expand-stdproc)
-	    ("spacing" "Spacing" simula-expand-stdproc)
-	    ("sqrt" "Sqrt" simula-expand-stdproc)
-	    ("start" "Start" simula-expand-stdproc)
-	    ("step" "STEP" simula-expand-keyword)
-	    ("strip" "Strip" simula-expand-stdproc)
-	    ("sub" "Sub" simula-expand-stdproc)
-	    ("subepsilon" "SubEpsilon" simula-expand-stdproc)
-	    ("suc" "Suc" simula-expand-stdproc)
-	    ("switch" "SWITCH" simula-expand-keyword)
-	    ("sysin" "SysIn" simula-expand-stdproc)
-	    ("sysout" "SysOut" simula-expand-stdproc)
-	    ("tan" "Tan" simula-expand-stdproc)
-	    ("tanh" "TanH" simula-expand-stdproc)
-	    ("terminate_program" "Terminate_Program" simula-expand-stdproc)
-	    ("terminated" "Terminated" simula-expand-stdproc)
-	    ("text" "TEXT" simula-expand-keyword)
-	    ("then" "THEN" simula-electric-keyword)
-	    ("this" "THIS" simula-expand-keyword)
-	    ("time" "Time" simula-expand-stdproc)
-	    ("to" "TO" simula-expand-keyword)
-	    ("true" "TRUE" simula-expand-keyword)
-	    ("uniform" "Uniform" simula-expand-stdproc)
-	    ("unlock" "Unlock" simula-expand-stdproc)
-	    ("until" "UNTIL" simula-expand-keyword)
-	    ("upcase" "Upcase" simula-expand-stdproc)
-	    ("upperbound" "UpperBound" simula-expand-stdproc)
-	    ("value" "VALUE" simula-expand-keyword)
-	    ("virtual" "VIRTUAL" simula-expand-keyword)
-	    ("wait" "Wait" simula-expand-stdproc)
-	    ("when" "WHEN" simula-electric-keyword)
-	    ("while" "WHILE" simula-expand-keyword))))
-
-;;; Font Lock mode support.
-(eval-when-compile
-  (require 'cl))
-
-;; SIMULA comments and strings are a mess.  If we rely on the syntax table,
-;; then %-comments may be shown incorrectly (and prematurely) ended by a
-;; semicolon, !-comments by a newline and '-strings may screw up the rest of
-;; the buffer.  And of course we can't do comment- or end-comments using the
-;; syntax table.  We can do everything except end-comments in one fast regexp,
-;; but we aught to do end-comments too, so we need a function.  simon@gnu.
-(defun simula-match-string-or-comment (limit)
-  ;; Return t if there is a string or comment before LIMIT.
-  ;; Matches buffer text so that if (match-string 1) is non-nil, it is the
-  ;; string.  Otherwise, (match-string 0) is non-nil, and is the comment.
-  (when (re-search-forward
-	 (eval-when-compile
-	   (concat "\\(\"[^\"\n]*\"\\|'\\(.\\|![0-9]+!\\)'\\)\\|"
-		   "\\(\\<end[ \t\n]+\\)\\|"
-		   "^%[ \t].*\\|\\(!\\|\\<comment\\>\\)[^;]*;?"))
-	 limit t)
-    (when (match-beginning 3)
-      ;; We've matched an end-comment.  Yuck.  Find the extent of it.
-      (store-match-data
-       (list (point)
-	(if (re-search-forward "\\<\\(end\\|else\\|when\\|otherwise\\)\\>\\|;"
-			       limit 'move)
-	    (match-beginning 0)
-	  (point)))))
-    t))
-
-;;; Hilit mode support.
-(if (and (fboundp 'hilit-set-mode-patterns)
-	 (boundp 'hilit-patterns-alist)
-	 (not (assoc 'simula-mode hilit-patterns-alist)))
-    (hilit-set-mode-patterns
-     'simula-mode
-     '(
-       ("^%\\([ \t\f].*\\)?$" nil comment)
-       ("^%include\\>" nil include)
-       ("\"[^\"\n]*\"\\|'.'\\|'![0-9]+!'" nil string)
-       ("\\<\\(ACTIVATE\\|AFTER\\|AND\\|ARRAY\\|AT\\|BEFORE\\|BEGIN\\|BOOLEAN\\|CHARACTER\\|CLASS\\|DELAY\\|DO\\|ELSE\\|END\\|EQ\\|EQV\\|EXTERNAL\\|FALSE\\|FOR\\|GE\\|GO\\|GOTO\\|GT\\|HIDDEN\\|IF\\|IMP\\|IN\\|INNER\\|INSPECT\\|INTEGER\\|IS\\|LABEL\\|LE\\|LONG\\|LT\\|NAME\\|NE\\|NEW\\|NONE\\|NOT\\|NOTEXT\\|OR\\|OTHERWISE\\|PRIOR\\|PROCEDURE\\|PROTECTED\\|QUA\\|REACTIVATE\\|REAL\\|REF\\|SHORT\\|STEP\\|SWITCH\\|TEXT\\|THEN\\|THIS\\|TO\\|TRUE\\|UNTIL\\|VALUE\\|VIRTUAL\\|WHEN\\|WHILE\\)\\>" nil keyword)
-       ("!\\|\\<COMMENT\\>" ";" comment))
-     nil 'case-insensitive))
-
-;; None of this seems to be used by anything, including hilit19.el.  simon@gnu.
-;(setq simula-find-comment-point -1
-;      simula-find-comment-context nil)
-;
-;;; function used by hilit19
-;(defun simula-find-next-comment-region (param)
-;  "Return region (start end) cons of comment after point, or NIL"
-;  (let (start end)
-;    ;; This function is called repeatedly, check if point is
-;    ;; where we left it in the last call
-;    (if (not (eq simula-find-comment-point (point)))
-;	(setq simula-find-comment-point (point)
-;	      simula-find-comment-context (simula-context)))
-;    ;; loop as long as we haven't found the end of a comment
-;    (if (memq simula-find-comment-context '(0 1 2))
-;	(setq start (point))
-;      (if (re-search-forward "\\<end\\>\\|!\\|\"\\|'\\|^%\\|\\<comment\\>"
-;			     nil 'move)
-;	  (let ((previous-char (preceding-char)))
-;	    (cond
-;	     ((memq previous-char '(?d ?D))
-;	      (setq start (point)
-;		    simula-find-comment-context 2))
-;	     ((memq previous-char '(?t ?T ?\!))
-;	      (setq start (point)
-;		    simula-find-comment-context 0))
-;	     ((eq previous-char ?%)
-;	      (setq start (point)
-;		    simula-find-comment-context 0))))))
-;    ;; BUG: the following (0 2) branches don't take into account intermixing
-;    ;; directive lines
-;    (cond
-;     ((eq simula-find-comment-context 0)
-;      (search-forward ";" nil 'move))
-;     ((eq simula-find-comment-context 1)
-;      (beginning-of-line 2))
-;     ((eq simula-find-comment-context 2)
-;      (re-search-forward ";\\|\\<end\\>\\|\\<else\\>\\|\\<otherwise\\>\\|\\<when\\>\\" (point-max) 'move)))
-;    (if start
-;	(setq end (point)))
-;    ;; save point for later calls to this function
-;    (setq simula-find-comment-point (if end (point) -1))
-;    (and end (cons start end))))
-
-;; defuns for submitting bug reports
-
-(defconst simula-mode-help-address "simula-mode@ifi.uio.no"
-  "Address accepting submission of simula-mode bug reports.")
-
-(defun simula-submit-bug-report ()
-  "Submit via mail a bug report on simula-mode."
-  (interactive)
-  (and
-   (y-or-n-p "Do you want to submit a report on simula-mode? ")
-   (reporter-submit-bug-report
-    simula-mode-help-address
-    (concat "simula-mode from Emacs " emacs-version)
-    (list
-     ;; report only the vars that affect indentation
-     'simula-emacs-features
-     'simula-indent-level
-     'simula-substatement-offset
-     'simula-continued-statement-offset
-     'simula-label-offset
-     'simula-if-indent
-     'simula-inspect-indent
-     'simula-electric-indent
-     'simula-abbrev-keyword
-     'simula-abbrev-stdproc
-     'simula-abbrev-file
-     'simula-tab-always-indent
-     ))))
-
-(provide 'simula-mode)
-
-;;; simula.el ends here
diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el
deleted file mode 100644
index ef8e27b68df..00000000000
--- a/lisp/progmodes/tcl.el
+++ /dev/null
@@ -1,2227 +0,0 @@
-;; tcl.el --- Tcl code editing commands for Emacs
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Maintainer: Tom Tromey <tromey@busco.lanl.gov>
-;; Author: Tom Tromey <tromey@busco.lanl.gov>
-;;    Chris Lindblad <cjl@lcs.mit.edu>
-;; Keywords: languages tcl modes
-;; Version: $Revision: 1.50 $
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 1, or (at your option)
-;; any later version.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;; HOW TO INSTALL:
-;; Put the following forms in your .emacs to enable autoloading of Tcl
-;; mode, and auto-recognition of ".tcl" files.
-;;
-;;   (autoload 'tcl-mode "tcl" "Tcl mode." t)
-;;   (autoload 'inferior-tcl "tcl" "Run inferior Tcl process." t)
-;;   (setq auto-mode-alist (append '(("\\.tcl$" . tcl-mode)) auto-mode-alist))
-;;
-;; If you plan to use the interface to the TclX help files, you must
-;; set the variable tcl-help-directory-list to point to the topmost
-;; directories containing the TclX help files.  Eg:
-;;
-;;   (setq tcl-help-directory-list '("/usr/local/lib/tclx/help"))
-;;
-;; Also you will want to add the following to your .emacs:
-;;
-;;   (autoload 'tcl-help-on-word "tcl" "Help on Tcl commands" t)
-;;
-;; FYI a *very* useful thing to do is nroff all the Tk man pages and
-;; put them in a subdir of the help system.
-;;
-
-;;; Commentary:
-
-;; LCD Archive Entry:
-;; tcl|Tom Tromey|tromey@busco.lanl.gov|
-;; Major mode for editing Tcl|
-;; $Date: 1996/03/23 05:14:50 $|$Revision: 1.50 $|~/modes/tcl.el.Z|
-
-;; CUSTOMIZATION NOTES:
-;; * tcl-proc-list can be used to customize a list of things that
-;; "define" other things.  Eg in my project I put "defvar" in this
-;; list.
-;; * tcl-typeword-list is similar, but uses font-lock-type-face.
-;; * tcl-keyword-list is a list of keywords.  I've generally used this
-;; for flow-control words.  Eg I add "unwind_protect" to this list.
-;; * tcl-type-alist can be used to minimally customize indentation
-;; according to context.
-
-;; Change log:
-;; $Log: tcl.el,v $
-;; Revision 1.50  1996/03/23  05:14:50  tromey
-;; (tcl-using-emacs-19): Work with XEmacs 20.0.  From Ben Wing.
-;;
-;; Revision 1.49  1995/12/07  18:27:47  tromey
-;; (add-log-tcl-defun): Don't use tcl-beginning-of-defun; just go to end
-;; of line before searching.
-;;
-;; Revision 1.48  1995/12/07  18:18:21  tromey
-;; (add-log-tcl-defun): Now uses tcl-beginning-of-defun.
-;;
-;; Revision 1.47  1995/08/22  17:49:45  tromey
-;; (tcl-hilit): New function from "Chris Alfeld" <calfeld@math.utah.edu>
-;; (tcl-mode): Call it
-;;
-;; Revision 1.46  1995/08/07  16:02:01  tromey
-;; (tcl-do-auto-fill): Only fill past fill-column; for 19.29.
-;; (tcl-auto-fill-mode): Use force-mode-line-update.
-;;
-;; Revision 1.45  1995/07/23  23:51:25  tromey
-;; (tcl-word-no-props): New function.
-;; (tcl-figure-type): Use it.
-;; (tcl-current-word): Ditto.
-;;
-;; Revision 1.44  1995/07/23  20:26:47  tromey
-;; Doc fixes.
-;;
-;; Revision 1.43  1995/07/17  19:59:49  tromey
-;; (inferior-tcl-mode): Use modeline-process if it exists.
-;;
-;; Revision 1.42  1995/07/17  19:55:25  tromey
-;; XEmacs currently must use tcl-internal-end-of-defun
-;;
-;; Revision 1.41  1995/07/14  21:54:56  tromey
-;; Changes to make menus work in XEmacs.
-;; From Mike Scheidler <c23mts@kocrsv01.delcoelect.com>
-;;
-;; Revision 1.40  1995/07/11  03:13:15  tromey
-;; (tcl-mode): Customize for new dabbrev.
-;;
-;; Revision 1.39  1995/07/09  21:58:03  tromey
-;; (tcl-do-fill-paragraph): New function.
-;; (tcl-mode): Set up for paragraph filling.
-;;
-;; Revision 1.38  1995/07/09  21:30:32  tromey
-;; (tcl-mode): Fixes to 19.29 paragraph variables.
-;;
-;; Revision 1.37  1995/07/09  18:52:16  tromey
-;; (tcl-do-auto-fill): Set fill-prefix.
-;;
-;; Revision 1.36  1995/07/09  01:07:57  tromey
-;; (tcl-imenu-create-index-function): Work with imenu from Emacs 19.29
-;;
-;; Revision 1.35  1995/06/27  20:12:00  tromey
-;; (tcl-type-alist): More itcl changes.
-;;
-;; Revision 1.34  1995/06/27  20:06:05  tromey
-;; More changes for itcl.
-;; Bug fixes for Emacs 19.29.
-;;
-;; Revision 1.33  1995/06/27  20:01:29  tromey
-;; (tcl-set-proc-regexp): Allow leading spaces.
-;; (tcl-proc-list): Changes for itcl.
-;; (tcl-typeword-list): Ditto.
-;; (tcl-keyword-list): Ditto.
-;;
-;; Revision 1.32  1995/05/11  22:12:49  tromey
-;; (tcl-type-alist): Include entry for "proc".
-;;
-;; Revision 1.31  1995/05/10  23:38:12  tromey
-;; (tcl-add-fsf-menu): Use make-lucid-menu-keymap, not
-;; "make-xemacs-menu-keymap".
-;;
-;; Revision 1.30  1995/05/10  18:22:21  tromey
-;; Bug fix in menu code for XEmacs.
-;;
-;; Revision 1.29  1995/05/09  21:36:53  tromey
-;; Changed "Lucid Emacs" to "XEmacs".
-;; Tcl's popup menu now added to existing one, courtesy
-;; dfarmer@evolving.com (Doug Farmer)
-;;
-;; Revision 1.28  1995/04/08  19:52:50  tromey
-;; (tcl-outline-level): New function
-;; (tcl-mode): Added outline-handling stuff.
-;; From Jesper Pedersen <blackie@imada.ou.dk>
-;;
-;; Revision 1.27  1994/10/11  02:01:27  tromey
-;; (tcl-mode): imenu-create-index-function made buffer local.
-;;
-;; Revision 1.26  1994/09/01  18:06:24  tromey
-;; Added filename completion in inferior tcl mode
-;;
-;; Revision 1.25  1994/08/22  15:56:24  tromey
-;; tcl-load-file default to current buffer.
-;;
-;; Revision 1.24  1994/08/21  20:33:05  tromey
-;; Fixed bug in tcl-guess-application.
-;;
-;; Revision 1.23  1994/08/21  03:54:45  tromey
-;; Keybindings don't overshadown comint bindings.
-;;
-;; Revision 1.22  1994/07/26  00:46:07  tromey
-;; Emacs 18 changes from Carl Witty.
-;;
-;; Revision 1.21  1994/07/14  22:49:21  tromey
-;; Added ";;;###autoload" comments where appropriate.
-;;
-; Revision 1.20  1994/06/05  16:57:22  tromey
-; tcl-current-word does the right thing in inferior-tcl-mode.
-;
-; Revision 1.19  1994/06/03  21:09:19  tromey
-; Another menu fix.
-;
-; Revision 1.18  1994/06/03  20:39:14  tromey
-; Fixed menu bug.
-;
-; Revision 1.17  1994/06/03  00:47:15  tromey
-; Fixed bug in bug-reporting code.
-;
-; Revision 1.16  1994/05/26  05:06:14  tromey
-; Menu items now sensitive as appropriate.
-;
-; Revision 1.15  1994/05/22  20:38:11  tromey
-; Added bug-report keybindings and menu entries.
-;
-; Revision 1.14  1994/05/22  20:18:28  tromey
-; Even more compile stuff.
-;
-; Revision 1.13  1994/05/22  20:17:15  tromey
-; Moved emacs version checking code to very beginning.
-;
-; Revision 1.12  1994/05/22  20:14:59  tromey
-; Compile fixes.
-;
-; Revision 1.11  1994/05/22  20:12:44  tromey
-; Fixed mark-defun for 19.23.
-; More menu fixes.
-;
-; Revision 1.10  1994/05/22  20:02:03  tromey
-; Fixed bug with M-;.
-; Wrote bug-reporting code.
-;
-; Revision 1.9  1994/05/22  05:26:51  tromey
-; Fixes for imenu.
-;
-; Revision 1.8  1994/05/22  03:38:07  tromey
-; Fixed menu support.
-;
-; Revision 1.7  1994/05/03  01:23:42  tromey
-; *** empty log message ***
-;
-; Revision 1.6  1994/04/23  16:23:36  tromey
-; Wrote tcl-indent-for-comment
-;
-;;
-;; 18-Mar-1994		Tom Tromey	Fourth beta release.
-;;    Added {un,}comment-region to menu.  Idea from
-;;    Mike Scheidler <c23mts@kocrsv01.delcoelect.com>
-;; 17-Mar-1994		Tom Tromey	
-;;    Fixed tcl-restart-with-file.  Bug fix attempt in
-;;    tcl-internal-end-of-defun.
-;; 16-Mar-1994		Tom Tromey	Third beta release
-;;    Added support code for menu (from Tcl mode written by
-;;    schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid)).
-;; 12-Mar-1994		Tom Tromey	
-;;    Better documentation for inferior-tcl-buffer.  Wrote
-;;    tcl-restart-with-file.  Wrote Lucid Emacs menu (but no
-;;    code to install it).
-;; 12-Mar-1994		Tom Tromey	
-;;    Wrote tcl-guess-application.  Another stab at making
-;;    tcl-omit-ws-regexp work.
-;; 10-Mar-1994		Tom Tromey	Second beta release
-;;    Last Modified: Thu Mar 10 01:24:25 1994 (Tom Tromey)
-;;    Wrote perl-mode style line indentation command.
-;;    Wrote more documentation.  Added tcl-continued-indent-level.
-;;    Integrated help code.
-;; 8-Mar-1994		Tom Tromey	
-;;    Last Modified: Tue Mar  8 11:58:44 1994 (Tom Tromey)
-;;    Bug fixes.
-;; 6-Mar-1994		Tom Tromey	
-;;    Last Modified: Sun Mar  6 18:55:41 1994 (Tom Tromey)
-;;    Updated auto-newline support.
-;; 6-Mar-1994		Tom Tromey	Beta release
-;;    Last Modified: Sat Mar  5 17:24:32 1994 (Tom Tromey)
-;;    Wrote tcl-hashify-buffer.  Other minor bug fixes.
-;; 5-Mar-1994		Tom Tromey	
-;;    Last Modified: Sat Mar  5 16:11:20 1994 (Tom Tromey)
-;;    Wrote electric-hash code.
-;; 3-Mar-1994		Tom Tromey	
-;;    Last Modified: Thu Mar  3 02:53:40 1994 (Tom Tromey)
-;;    Added code to handle auto-fill in comments.
-;;    Added imenu support code.
-;;    Cleaned up code.
-;;    Better font-lock support.
-;; 28-Feb-1994		Tom Tromey	
-;;    Last Modified: Mon Feb 28 14:08:05 1994 (Tom Tromey)
-;;    Made tcl-figure-type more easily configurable.
-;; 28-Feb-1994		Tom Tromey	
-;;    Last Modified: Mon Feb 28 01:02:58 1994 (Tom Tromey)
-;;    Wrote inferior-tcl mode.
-;; 16-Feb-1994		Tom Tromey	
-;;    Last Modified: Wed Feb 16 17:05:19 1994 (Tom Tromey)
-;;    Added support for font-lock-mode.
-;; 29-Oct-1993		Tom Tromey	
-;;    Last Modified: Sun Oct 24 17:39:14 1993 (Tom Tromey)
-;;    Patches from Guido Bosch to make things work with Lucid Emacs.
-;; 22-Oct-1993		Tom Tromey	
-;;    Last Modified: Fri Oct 22 15:26:46 1993 (Tom Tromey)
-;;    Made many characters have "_" syntax class; suggested by Guido
-;;    Bosch <Guido.Bosch@loria.fr>.  Note that this includes the "$"
-;;    character, which might be a change you'd notice.
-;; 21-Oct-1993		Tom Tromey	
-;;    Last Modified: Thu Oct 21 20:28:40 1993 (Tom Tromey)
-;;    More fixes for tcl-omit-ws-regexp.
-;; 20-Oct-1993		Tom Tromey	
-;;    Started keeping history.  Fixed tcl-{beginning,end}-of-defun.
-;;    Added some code to make things work with Emacs 18.
-
-;; THANKS TO:
-;; Guido Bosch <Guido.Bosch@loria.fr>
-;; pgs1002@esc.cam.ac.uk (Dr P.G. Sjoerdsma)
-;; Mike Scheidler <c23mts@kocrsv01.delcoelect.com>
-;; Matt Newman <men@charney.colorado.edu>
-;; rwhitby@research.canon.oz.au (Rod Whitby)
-;; h9118101@hkuxa.hku.hk (Yip Chi Lap [Beta])
-;; Pertti Tapio Kasanen <ptk@delta.hut.fi>
-;; schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid)
-;; warsaw@nlm.nih.gov (Barry A. Warsaw)
-;; Carl Witty <cwitty@ai.mit.edu>
-;; T. V. Raman <raman@crl.dec.com>
-;; Jesper Pedersen <blackie@imada.ou.dk>
-;; dfarmer@evolving.com (Doug Farmer)
-;; "Chris Alfeld" <calfeld@math.utah.edu>
-;; Ben Wing <wing@666.com>
-
-;; KNOWN BUGS:
-;; * indent-region should skip blank lines.  (It does in v19, so I'm
-;;   not motivated to fix it here).
-;; * In Tcl "#" is not always a comment character.  This can confuse
-;;   tcl.el in certain circumstances.  For now the only workaround is
-;;   to enclose offending hash characters in quotes or precede it with
-;;   a backslash.  Note that using braces won't work -- quotes change
-;;   the syntax class of characters between them, while braces do not.
-;;   The electric-# mode helps alleviate this problem somewhat.
-;; * indent-tcl-exp is untested.
-;; * Doesn't work under Emacs 18 yet.
-;; * There's been a report that font-lock does strange things under
-;;   Lucid Emacs 19.6.  For instance in "proc foobar", the space
-;;   before "foobar" is highlighted.
-
-;; TODO:
-;; * make add-log-tcl-defun smarter.  should notice if we are in the
-;;   middle of a defun, or between defuns.  should notice if point is
-;;   on first line of defun (or maybe even in comments before defun).
-;; * Allow continuation lines to be indented under the first argument
-;;   of the preceeding line, like this:
-;;      [list something \
-;;            something-else]
-;; * There is a request that indentation work like this:
-;;        button .fred -label Fred \
-;;                     -command {puts fred}
-;; * Should have tcl-complete-symbol that queries the inferior process.
-;; * Should have describe-symbol that works by sending the magic
-;;   command to a tclX process.
-;; * Need C-x C-e binding (tcl-eval-last-exp).
-;; * Write indent-region function that is faster than indenting each
-;;   line individually.
-;; * tcl-figure-type should stop at "beginning of line" (only ws
-;;   before point, and no "\" on previous line).  (see tcl-real-command-p).
-;; * overrides some comint keybindings; fix.
-;; * Trailing \ will eat blank lines.  Should deal with this.
-;;   (this would help catch some potential bugs).
-;; * Inferior should display in half the screen, not the whole screen.
-;; * Indentation should deal with "switch".
-;; * Consider writing code to find help files automatically (for
-;;   common cases).
-;; * `#' shouldn't insert `\#' when point is in string.
-
-
-
-;;; Code:
-
-;; I sure wish Emacs had a package that made it easy to extract this
-;; sort of information.  Strange definition works with XEmacs 20.0.
-(defconst tcl-using-emacs-19 (not (string-match "18\\." emacs-version))
-  "Nil unless using Emacs 19 (XEmacs or FSF).")
-
-;; FIXME this will break on Emacs 19.100.
-(defconst tcl-using-emacs-19-23
-  (string-match "19\\.\\(2[3-9]\\|[3-9][0-9]\\)" emacs-version)
-  "Nil unless using Emacs 19-23 or later.")
-
-(defconst tcl-using-xemacs-19 (string-match "XEmacs" emacs-version)
-  "Nil unless using XEmacs).")
-
-(require 'comint)
-
-;; When compiling under GNU Emacs, load imenu during compilation.  If
-;; you have 19.22 or earlier, comment this out, or get imenu.
-(and (fboundp 'eval-when-compile)
-     (eval-when-compile
-       (if (and (string-match "19\\." emacs-version)
-		(not (string-match "XEmacs" emacs-version)))
-	   (require 'imenu))
-       ()))
-
-(defconst tcl-version "$Revision: 1.50 $")
-(defconst tcl-maintainer "Tom Tromey <tromey@drip.colorado.edu>")
-
-;;
-;; User variables.
-;;
-
-(defvar tcl-indent-level 4
-  "*Indentation of Tcl statements with respect to containing block.")
-
-(defvar tcl-continued-indent-level 4
-  "*Indentation of continuation line relative to first line of command.")
-
-(defvar tcl-auto-newline nil
-  "*Non-nil means automatically newline before and after braces
-inserted in Tcl code.")
-
-(defvar tcl-tab-always-indent t
-  "*Control effect of TAB key.
-If t (the default), always indent current line.
-If nil and point is not in the indentation area at the beginning of
-the line, a TAB is inserted.
-Other values cause the first possible action from the following list
-to take place:
-
-  1. Move from beginning of line to correct indentation.
-  2. Delete an empty comment.
-  3. Move forward to start of comment, indenting if necessary.
-  4. Move forward to end of line, indenting if necessary.
-  5. Create an empty comment.
-  6. Move backward to start of comment, indenting if necessary.")
-
-(defvar tcl-use-hairy-comment-detector t
-  "*If not `nil', the the more complicated, but slower, comment
-detecting function is used.  This variable is only used in GNU Emacs
-19 (the fast function is always used elsewhere).")
-
-(defvar tcl-electric-hash-style 'smart
-  "*Style of electric hash insertion to use.
-Possible values are 'backslash, meaning that `\\' quoting should be
-done; 'quote, meaning that `\"' quoting should be done; 'smart,
-meaning that the choice between 'backslash and 'quote should be
-made depending on the number of hashes inserted; or nil, meaning that
-no quoting should be done.  Any other value for this variable is
-taken to mean 'smart.  The default is 'smart.")
-
-(defvar tcl-help-directory-list nil
-  "*List of topmost directories containing TclX help files")
-
-(defvar tcl-use-smart-word-finder t
-  "*If not nil, use a better way of finding the current word when
-looking up help on a Tcl command.")
-
-(defvar tcl-application "wish"
-  "*Name of Tcl application to run in inferior Tcl mode.")
-
-(defvar tcl-command-switches nil
-  "*Switches to supply to `tcl-application'.")
-
-(defvar tcl-prompt-regexp "^\\(% \\|\\)"
-  "*If not nil, a regexp that will match the prompt in the inferior process.
-If nil, the prompt is the name of the application with \">\" appended.
-
-The default is \"^\\(% \\|\\)\", which will match the default primary
-and secondary prompts for tclsh and wish.")
-
-(defvar inferior-tcl-source-command "source %s\n"
-  "*Format-string for building a Tcl command to load a file.
-This format string should use `%s' to substitute a file name
-and should result in a Tcl expression that will command the
-inferior Tcl to load that file.  The filename will be appropriately
-quoted for Tcl.")
-
-;;
-;; Keymaps, abbrevs, syntax tables.
-;;
-
-(defvar tcl-mode-abbrev-table nil
-  "Abbrev table in use in Tcl-mode buffers.")
-(if tcl-mode-abbrev-table
-    ()
-  (define-abbrev-table 'tcl-mode-abbrev-table ()))
-
-(defvar tcl-mode-map ()
-  "Keymap used in Tcl mode.")
-
-(defvar tcl-mode-syntax-table nil
-  "Syntax table in use in Tcl-mode buffers.")
-(if tcl-mode-syntax-table
-    ()
-  (setq tcl-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?%  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?@  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?&  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?*  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?+  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?-  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?.  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?:  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?!  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?$  "_" tcl-mode-syntax-table) ; FIXME use "'"?
-  (modify-syntax-entry ?/  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?~  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?<  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?=  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?>  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?|  "_" tcl-mode-syntax-table)
-  (modify-syntax-entry ?\(  "()" tcl-mode-syntax-table)
-  (modify-syntax-entry ?\)  ")(" tcl-mode-syntax-table)
-  (modify-syntax-entry ?\;  "." tcl-mode-syntax-table)
-  (modify-syntax-entry ?\n ">   " tcl-mode-syntax-table)
-  (modify-syntax-entry ?\f ">   " tcl-mode-syntax-table)
-  (modify-syntax-entry ?# "<   " tcl-mode-syntax-table))
-
-(defvar inferior-tcl-mode-map nil
-  "Keymap used in Inferior Tcl mode.")
-
-;; XEmacs menu.
-(defvar tcl-xemacs-menu
-  '(["Beginning of function" tcl-beginning-of-defun t]
-    ["End of function" tcl-end-of-defun t]
-    ["Mark function" tcl-mark-defun t]
-    ["Indent region" indent-region (tcl-mark)]
-    ["Comment region" comment-region (tcl-mark)]
-    ["Uncomment region" tcl-uncomment-region (tcl-mark)]
-    "----"
-    ["Show Tcl process buffer" inferior-tcl t]
-    ["Send function to Tcl process" tcl-eval-defun
-     (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
-    ["Send region to Tcl process" tcl-eval-region
-     (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
-    ["Send file to Tcl process" tcl-load-file
-     (and inferior-tcl-buffer (get-buffer inferior-tcl-buffer))]
-    ["Restart Tcl process with file" tcl-restart-with-file t]
-    "----"
-    ["Tcl help" tcl-help-on-word tcl-help-directory-list]
-    ["Send bug report" tcl-submit-bug-report t])
-  "XEmacs menu for Tcl mode.")
-
-;; GNU Emacs does menus via keymaps.  Do it in a function in case we
-;; later decide to add it to inferior Tcl mode as well.
-(defun tcl-add-fsf-menu (map)
-  (define-key map [menu-bar] (make-sparse-keymap))
-  ;; This fails in Emacs 19.22 and earlier.
-  (require 'lmenu)
-  (let ((menu (make-lucid-menu-keymap "Tcl" tcl-xemacs-menu)))
-    (define-key map [menu-bar tcl] (cons "Tcl" menu))
-    ;; The following is intended to compute the key sequence
-    ;; information for the menu.  It doesn't work.
-    (x-popup-menu nil menu)))
-
-(defun tcl-fill-mode-map ()
-  (define-key tcl-mode-map "{" 'tcl-electric-char)
-  (define-key tcl-mode-map "}" 'tcl-electric-brace)
-  (define-key tcl-mode-map "[" 'tcl-electric-char)
-  (define-key tcl-mode-map "]" 'tcl-electric-char)
-  (define-key tcl-mode-map ";" 'tcl-electric-char)
-  (define-key tcl-mode-map "#" 'tcl-electric-hash)
-  ;; FIXME.
-  (define-key tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
-  ;; FIXME.
-  (define-key tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
-  ;; FIXME.
-  (define-key tcl-mode-map "\e\C-h" 'tcl-mark-defun)
-  (define-key tcl-mode-map "\e\C-q" 'indent-tcl-exp)
-  (define-key tcl-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key tcl-mode-map "\t" 'tcl-indent-command)
-  (define-key tcl-mode-map "\M-;" 'tcl-indent-for-comment)
-  (define-key tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
-  (define-key tcl-mode-map "\C-c\C-b" 'tcl-submit-bug-report)
-  (and (fboundp 'comment-region)
-       (define-key tcl-mode-map "\C-c\C-c" 'comment-region))
-  (define-key tcl-mode-map "\C-c\C-i" 'tcl-help-on-word)
-  (define-key tcl-mode-map "\C-c\C-v" 'tcl-eval-defun)
-  (define-key tcl-mode-map "\C-c\C-f" 'tcl-load-file)
-  (define-key tcl-mode-map "\C-c\C-t" 'inferior-tcl)
-  (define-key tcl-mode-map "\C-c\C-x" 'tcl-eval-region)
-  (define-key tcl-mode-map "\C-c\C-s" 'switch-to-tcl)
-
-  ;; Make menus.
-  (if (and tcl-using-emacs-19 (not tcl-using-xemacs-19))
-      (progn
-	(tcl-add-fsf-menu tcl-mode-map))))
-
-(defun tcl-fill-inferior-map ()
-  (define-key inferior-tcl-mode-map "\t" 'comint-dynamic-complete)
-  (define-key inferior-tcl-mode-map "\M-?"
-    'comint-dynamic-list-filename-completions)
-  (define-key inferior-tcl-mode-map "\e\C-a" 'tcl-beginning-of-defun)
-  (define-key inferior-tcl-mode-map "\e\C-e" 'tcl-end-of-defun)
-  (define-key inferior-tcl-mode-map "\177" 'backward-delete-char-untabify)
-  (define-key inferior-tcl-mode-map "\M-\C-x" 'tcl-eval-defun)
-  (define-key inferior-tcl-mode-map "\C-c\C-b" 'tcl-submit-bug-report)
-  (define-key inferior-tcl-mode-map "\C-c\C-i" 'tcl-help-on-word)
-  (define-key inferior-tcl-mode-map "\C-c\C-v" 'tcl-eval-defun)
-  (define-key inferior-tcl-mode-map "\C-c\C-f" 'tcl-load-file)
-  (define-key inferior-tcl-mode-map "\C-c\C-t" 'inferior-tcl)
-  (define-key inferior-tcl-mode-map "\C-c\C-x" 'tcl-eval-region)
-  (define-key inferior-tcl-mode-map "\C-c\C-s" 'switch-to-tcl))
-
-(if tcl-mode-map
-    ()
-  (setq tcl-mode-map (make-sparse-keymap))
-  (tcl-fill-mode-map))
-
-(if inferior-tcl-mode-map
-    ()
-  ;; FIXME Use keymap inheritance here?  FIXME we override comint
-  ;; keybindings here.  Maybe someone has a better set?
-  (setq inferior-tcl-mode-map (copy-keymap comint-mode-map))
-  (tcl-fill-inferior-map))
-
-
-(defvar inferior-tcl-buffer nil
-  "*The current inferior-tcl process buffer.
-
-MULTIPLE PROCESS SUPPORT
-===========================================================================
-To run multiple Tcl processes, you start the first up with
-\\[inferior-tcl].  It will be in a buffer named `*inferior-tcl*'.
-Rename this buffer with \\[rename-buffer].  You may now start up a new
-process with another \\[inferior-tcl].  It will be in a new buffer,
-named `*inferior-tcl*'.  You can switch between the different process
-buffers with \\[switch-to-buffer].
-
-Commands that send text from source buffers to Tcl processes -- like
-`tcl-eval-defun' or `tcl-load-file' -- have to choose a process to
-send to, when you have more than one Tcl process around.  This is
-determined by the global variable `inferior-tcl-buffer'.  Suppose you
-have three inferior Lisps running:
-    Buffer              Process
-    foo                 inferior-tcl
-    bar                 inferior-tcl<2>
-    *inferior-tcl*      inferior-tcl<3>
-If you do a \\[tcl-eval-defun] command on some Lisp source code, what
-process do you send it to?
-
-- If you're in a process buffer (foo, bar, or *inferior-tcl*), 
-  you send it to that process.
-- If you're in some other buffer (e.g., a source file), you
-  send it to the process attached to buffer `inferior-tcl-buffer'.
-This process selection is performed by function `inferior-tcl-proc'.
-
-Whenever \\[inferior-tcl] fires up a new process, it resets
-`inferior-tcl-buffer' to be the new process's buffer.  If you only run
-one process, this does the right thing.  If you run multiple
-processes, you can change `inferior-tcl-buffer' to another process
-buffer with \\[set-variable].")
-
-;;
-;; Hooks and other customization.
-;;
-
-(defvar tcl-mode-hook nil
-  "Hook run on entry to Tcl mode.
-
-Several functions exist which are useful to run from your
-`tcl-mode-hook' (see each function's documentation for more
-information):
-
-  tcl-guess-application
-    Guesses a default setting for `tcl-application' based on any
-    \"#!\" line at the top of the file.
-  tcl-hashify-buffer
-    Quotes all \"#\" characters that don't correspond to actual
-    Tcl comments.  (Useful when editing code not originally created
-    with this mode).
-  tcl-auto-fill-mode
-    Auto-filling of Tcl comments.
-
-Emacs 19 users can add functions to the hook with `add-hook':
-
-   (add-hook 'tcl-mode-hook 'tcl-guess-application)
-
-Emacs 18 users must use `setq':
-
-   (setq tcl-mode-hook (cons 'tcl-guess-application tcl-mode-hook))")
-
-
-(defvar inferior-tcl-mode-hook nil
-  "Hook for customizing Inferior Tcl mode.")
-
-(defvar tcl-proc-list
-  '("proc" "method" "itcl_class")
-  "List of commands whose first argument defines something.
-This exists because some people (eg, me) use \"defvar\" et al.
-Call `tcl-set-proc-regexp' and `tcl-set-font-lock-keywords'
-after changing this list.")
-
-(defvar tcl-proc-regexp nil
-  "Regexp to use when matching proc headers.")
-
-(defvar tcl-typeword-list
-  '("global" "upvar" "inherit" "public" "protected" "common")
-  "List of Tcl keywords denoting \"type\".  Used only for highlighting.
-Call `tcl-set-font-lock-keywords' after changing this list.")
-
-;; Generally I've picked control operators to be keywords.
-(defvar tcl-keyword-list
-  '("if" "then" "else" "elseif" "for" "foreach" "break" "continue" "while"
-    "eval" "case" "in" "switch" "default" "exit" "error" "proc" "return"
-    "uplevel" "constructor" "destructor" "itcl_class" "loop" "for_array_keys"
-    "for_recursive_glob" "for_file")
-  "List of Tcl keywords.  Used only for highlighting.
-Default list includes some TclX keywords.
-Call `tcl-set-font-lock-keywords' after changing this list.")
-
-(defvar tcl-font-lock-keywords nil
-  "Keywords to highlight for Tcl.  See variable `font-lock-keywords'.
-This variable is generally set from `tcl-proc-regexp',
-`tcl-typeword-list', and `tcl-keyword-list' by the function
-`tcl-set-font-lock-keywords'.")
-
-;; FIXME need some way to recognize variables because array refs look
-;; like 2 sexps.
-(defvar tcl-type-alist
-  '(
-    ("proc" nil tcl-expr tcl-commands)
-    ("method" nil tcl-expr tcl-commands)
-    ("destructor" tcl-commands)
-    ("constructor" tcl-commands)
-    ("expr" tcl-expr)
-    ("catch" tcl-commands)
-    ("if" tcl-expr "then" tcl-commands)
-    ("elseif" tcl-expr "then" tcl-commands)
-    ("elseif" tcl-expr tcl-commands)
-    ("if" tcl-expr tcl-commands)
-    ("while" tcl-expr tcl-commands)
-    ("for" tcl-commands tcl-expr tcl-commands tcl-commands)
-    ("foreach" nil nil tcl-commands)
-    ("for_file" nil nil tcl-commands)
-    ("for_array_keys" nil nil tcl-commands)
-    ("for_recursive_glob" nil nil nil tcl-commands)
-    ;; Loop handling is not perfect, because the third argument can be
-    ;; either a command or an expr, and there is no real way to look
-    ;; forward.
-    ("loop" nil tcl-expr tcl-expr tcl-commands)
-    ("loop" nil tcl-expr tcl-commands)
-    )
-  "Alist that controls indentation.
-\(Actually, this really only controls what happens on continuation lines).
-Each entry looks like `(KEYWORD TYPE ...)'.
-Each type entry describes a sexp after the keyword, and can be one of:
-* nil, meaning that this sexp has no particular type.
-* tcl-expr, meaning that this sexp is an arithmetic expression.
-* tcl-commands, meaning that this sexp holds Tcl commands.
-* a string, which must exactly match the string at the corresponding
-  position for a match to be made.
-
-For example, the entry for the \"loop\" command is:
-
-   (\"loop\" nil tcl-expr tcl-commands)
-
-This means that the \"loop\" command has three arguments.  The first
-argument is ignored (for indentation purposes).  The second argument
-is a Tcl expression, and the last argument is Tcl commands.")
-
-(defvar tcl-explain-indentation nil
-  "If not `nil', debugging message will be printed during indentation.")
-
-
-
-;;
-;; Work around differences between various versions of Emacs.
-;;
-
-;; We use this because Lemacs 19.9 has what we need.
-(defconst tcl-pps-has-arg-6
-  (or tcl-using-emacs-19
-      (and tcl-using-xemacs-19
-	   (condition-case nil
-	       (progn
-		 (parse-partial-sexp (point) (point) nil nil nil t)
-		 t)
-	     (error nil))))
-  "t if using an emacs which supports sixth (\"commentstop\") argument
-to parse-partial-sexp.")
-
-;; Its pretty bogus to have to do this, but there is no easier way to
-;; say "match not syntax-1 and not syntax-2".  Too bad you can't put
-;; \s in [...].  This sickness is used in Emacs 19 to match a defun
-;; starter.  (It is used for this in v18 as well).
-;;(defconst tcl-omit-ws-regexp
-;;  (concat "^\\(\\s"
-;;	  (mapconcat 'char-to-string "w_.()\"\\$'/" "\\|\\s")
-;;	  "\\)\\S(*")
-;;  "Regular expression that matches everything except space, comment
-;;starter, and comment ender syntax codes.")
-
-;; FIXME?  Instead of using the hairy regexp above, we just use a
-;; simple one.
-;;(defconst tcl-omit-ws-regexp "^[^] \t\n#}]\\S(*"
-;;  "Regular expression used in locating function definitions.")
-
-;; Here's another stab.  I think this one actually works.  Now the
-;; problem seems to be that there is a bug in Emacs 19.22 where
-;; end-of-defun doesn't really use the brace matching the one that
-;; trails defun-prompt-regexp.
-(defconst tcl-omit-ws-regexp "^[^ \t\n#}][^\n}]+}*[ \t]+")
-
-(defun tcl-internal-beginning-of-defun (&optional arg)
-  "Move backward to next beginning-of-defun.
-With argument, do this that many times.
-Returns t unless search stops due to end of buffer."
-  (interactive "p")
-  (if (or (null arg) (= arg 0))
-      (setq arg 1))
-  (let (success)
-    (while (progn
-	     (setq arg (1- arg))
-	     (and (>= arg 0)
-		  (setq success
-			(re-search-backward tcl-omit-ws-regexp nil 'move 1))))
-      (while (and (looking-at "[]#}]")
-		  (setq success
-			(re-search-backward tcl-omit-ws-regexp nil 'move 1)))))
-    (beginning-of-line)
-    (not (null success))))
-
-(defun tcl-internal-end-of-defun (&optional arg)
-  "Move forward to next end of defun.
-An end of a defun is found by moving forward from the beginning of one."
-  (interactive "p")
-  (if (or (null arg) (= arg 0)) (setq arg 1))
-  (let ((start (point)))
-    ;; Was forward-char.  I think this works a little better.
-    (forward-line)
-    (tcl-beginning-of-defun)
-    (while (> arg 0)
-      (while (and (re-search-forward tcl-omit-ws-regexp nil 'move 1)
-		  (progn (beginning-of-line) t)
-		  (looking-at "[]#}]")
-		  (progn (forward-line) t)))
-      (let ((next-line (save-excursion 
-			 (forward-line)
-			 (point))))
-	(while (< (point) next-line)
-	  (forward-sexp)))
-      (forward-line)
-      (if (> (point) start) (setq arg (1- arg))))))
-
-;; In Emacs 19, we can use begining-of-defun as long as we set up a
-;; certain regexp.  In Emacs 18, we need our own function.
-(fset 'tcl-beginning-of-defun
-      (if tcl-using-emacs-19
-	  'beginning-of-defun
-	'tcl-internal-beginning-of-defun))
-
-;; Ditto end-of-defun.
-(fset 'tcl-end-of-defun
-      (if (and tcl-using-emacs-19 (not tcl-using-xemacs-19))
-	  'end-of-defun
-	'tcl-internal-end-of-defun))
-
-;; Internal mark-defun that is used for losing Emacsen.
-(defun tcl-internal-mark-defun ()
-  "Put mark at end of Tcl function, point at beginning."
-  (interactive)
-  (push-mark (point))
-  (tcl-end-of-defun)
-  (if tcl-using-emacs-19
-      (push-mark (point) nil t)
-    (push-mark (point)))
-  (tcl-beginning-of-defun)
-  (backward-paragraph))
-
-;; In GNU Emacs 19-23 and later, mark-defun works as advertised.  I
-;; don't know about XEmacs, so for now it and Emacs 18 just lose.
-(fset 'tcl-mark-defun
-      (if tcl-using-emacs-19-23
-	  'mark-defun
-	'tcl-internal-mark-defun))
-
-;; In GNU Emacs 19, mark takes an additional "force" argument.  I
-;; don't know about XEmacs, so I'm just assuming it is the same.
-;; Emacs 18 doesn't have this argument.
-(defun tcl-mark ()
-  "Return mark, or nil if none."
-  (if tcl-using-emacs-19
-      (mark t)
-    (mark)))
-
-
-
-;;
-;; Some helper functions.
-;;
-
-(defun tcl-set-proc-regexp ()
-  "Set `tcl-proc-regexp' from variable `tcl-proc-list'."
-  (setq tcl-proc-regexp (concat "^\\s-*\\("
-				(mapconcat 'identity tcl-proc-list "\\|")
-				"\\)[ \t]+")))
-
-(defun tcl-set-font-lock-keywords ()
-  "Set `tcl-font-lock-keywords'.
-Uses variables `tcl-proc-regexp' and `tcl-keyword-list'."
-  (setq tcl-font-lock-keywords
-	(list
-	 ;; Names of functions (and other "defining things").
-	 (list (concat tcl-proc-regexp "\\([^ \t\n]+\\)")
-	       2 'font-lock-function-name-face)
-
-	 ;; Names of type-defining things.
-	 (list (concat "\\(\\s-\\|^\\)\\("
-		       ;; FIXME Use 'regexp-quote?
-		       (mapconcat 'identity tcl-typeword-list "\\|")
-		       "\\)\\(\\s-\\|$\\)")
-	       2 'font-lock-type-face)
-
-	 ;; Keywords.  Only recognized if surrounded by whitespace.
-	 ;; FIXME consider using "not word or symbol", not
-	 ;; "whitespace".
-	 (cons (concat "\\(\\s-\\|^\\)\\("
-		       ;; FIXME Use regexp-quote? 
-		       (mapconcat 'identity tcl-keyword-list "\\|")
-		       "\\)\\(\\s-\\|$\\)")
-	       2)
-	 )))
-
-(if tcl-proc-regexp
-    ()
-  (tcl-set-proc-regexp))
-
-(if tcl-font-lock-keywords
-    ()
-  (tcl-set-font-lock-keywords))
-
-
-
-;;
-;; The mode itself.
-;;
-
-;;;###autoload
-(defun tcl-mode ()
-  "Major mode for editing Tcl code.
-Expression and list commands understand all Tcl brackets.
-Tab indents for Tcl code.
-Paragraphs are separated by blank lines only.
-Delete converts tabs to spaces as it moves back.
-
-Variables controlling indentation style:
-  tcl-indent-level
-    Indentation of Tcl statements within surrounding block.
-  tcl-continued-indent-level
-    Indentation of continuation line relative to first line of command.
-
-Variables controlling user interaction with mode (see variable
-documentation for details):
-  tcl-tab-always-indent
-    Controls action of TAB key.
-  tcl-auto-newline
-    Non-nil means automatically newline before and after braces, brackets,
-    and semicolons inserted in Tcl code.
-  tcl-electric-hash-style
-    Controls action of `#' key.
-  tcl-use-hairy-comment-detector
-    If t, use more complicated, but slower, comment detector.
-    This variable is only used in GNU Emacs 19.
-  tcl-use-smart-word-finder
-    If not nil, use a smarter, Tcl-specific way to find the current
-    word when looking up help on a Tcl command.
-
-Turning on Tcl mode calls the value of the variable `tcl-mode-hook'
-with no args, if that value is non-nil.  Read the documentation for
-`tcl-mode-hook' to see what kinds of interesting hook functions
-already exist.
-
-Commands:
-\\{tcl-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map tcl-mode-map)
-  (setq major-mode 'tcl-mode)
-  (setq mode-name "Tcl")
-  (setq local-abbrev-table tcl-mode-abbrev-table)
-  (set-syntax-table tcl-mode-syntax-table)
-
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'paragraph-separate)
-  (if (and tcl-using-emacs-19-23
-	   (>= emacs-minor-version 29))
-      (progn
-	;; In Emacs 19.29, you aren't supposed to start these with a
-	;; ^.
-	(setq paragraph-start "$\\|")
-	(setq paragraph-separate paragraph-start))
-    (setq paragraph-start (concat "^$\\|" page-delimiter))
-    (setq paragraph-separate paragraph-start))
-  (make-local-variable 'paragraph-ignore-fill-prefix)
-  (setq paragraph-ignore-fill-prefix t)
-  (make-local-variable 'fill-paragraph-function)
-  (setq fill-paragraph-function 'tcl-do-fill-paragraph)
-
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'tcl-indent-line)
-  ;; Tcl doesn't require a final newline.
-  ;; (make-local-variable 'require-final-newline)
-  ;; (setq require-final-newline t)
-
-  (make-local-variable 'comment-start)
-  (setq comment-start "# ")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "#+ *")
-  (make-local-variable 'comment-column)
-  (setq comment-column 40)
-  (make-local-variable 'comment-end)
-  (setq comment-end "")
-
-  (make-local-variable 'outline-regexp)
-  (setq outline-regexp "[^\n\^M]")
-  (make-local-variable 'outline-level)
-  (setq outline-level 'tcl-outline-level)
-
-  (make-local-variable 'font-lock-keywords)
-  (setq font-lock-keywords tcl-font-lock-keywords)
-
-  ;; The following only really makes sense under GNU Emacs 19.
-  (make-local-variable 'imenu-create-index-function)
-  (setq imenu-create-index-function 'tcl-imenu-create-index-function)
-  (make-local-variable 'parse-sexp-ignore-comments)
-
-  ;; Settings for new dabbrev code.
-  (make-local-variable 'dabbrev-case-fold-search)
-  (setq dabbrev-case-fold-search nil)
-  (make-local-variable 'dabbrev-case-replace)
-  (setq dabbrev-case-replace nil)
-  (make-local-variable 'dabbrev-abbrev-skip-leading-regexp)
-  (setq dabbrev-abbrev-skip-leading-regexp "[$!]")
-  (make-local-variable 'dabbrev-abbrev-char-regexp)
-  (setq dabbrev-abbrev-char-regexp "\\sw\\|\\s_")
-
-  (if tcl-using-emacs-19
-      (progn
-	;; This can only be set to t in Emacs 19 and XEmacs.
-	;; Emacs 18 and Epoch lose.
-	(setq parse-sexp-ignore-comments t)
-	;; XEmacs has defun-prompt-regexp, but I don't believe
-	;; that it works for end-of-defun -- only for
-	;; beginning-of-defun.
-	(make-local-variable 'defun-prompt-regexp)
-	(setq defun-prompt-regexp tcl-omit-ws-regexp)
-	;; The following doesn't work in Lucid Emacs 19.6, but maybe
-	;; it will appear in later versions.
-	(make-local-variable 'add-log-current-defun-function)
-	(setq add-log-current-defun-function 'add-log-tcl-defun))
-    (setq parse-sexp-ignore-comments nil))
-
-  ;; Put Tcl menu into menubar for XEmacs.  This happens
-  ;; automatically for GNU Emacs.
-  (if (and tcl-using-xemacs-19
-	   current-menubar
-	   (not (assoc "Tcl" current-menubar)))
-      (progn
-	(set-buffer-menubar (copy-sequence current-menubar))
-	(add-menu nil "Tcl" tcl-xemacs-menu)))
-  ;; Append Tcl menu to popup menu for XEmacs.
-  (if (and tcl-using-xemacs-19 (boundp 'mode-popup-menu))
-      (setq mode-popup-menu
-	    (cons (concat mode-name " Mode Commands") tcl-xemacs-menu)))
-
-  ;; If hilit19 is loaded, add our stuff.
-  (if (featurep 'hilit19)
-      (tcl-hilit))
-
-  (run-hooks 'tcl-mode-hook))
-
-
-
-;; This is used for braces, brackets, and semi (except for closing
-;; braces, which are handled specially).
-(defun tcl-electric-char (arg)
-  "Insert character and correct line's indentation."
-  (interactive "p")
-  ;; Indent line first; this looks better if parens blink.
-  (tcl-indent-line)
-  (self-insert-command arg)
-  (if (and tcl-auto-newline (= last-command-char ?\;))
-      (progn
-	(newline)
-	(tcl-indent-line))))
-
-;; This is used for closing braces.  If tcl-auto-newline is set, can
-;; insert a newline both before and after the brace, depending on
-;; context.  FIXME should this be configurable?  Does anyone use this?
-(defun tcl-electric-brace (arg)
-  "Insert character and correct line's indentation."
-  (interactive "p")
-  ;; If auto-newlining and there is stuff on the same line, insert a
-  ;; newline first.
-  (if tcl-auto-newline
-      (progn
-	(if (save-excursion
-	      (skip-chars-backward " \t")
-	      (bolp))
-	    ()
-	  (tcl-indent-line)
-	  (newline))
-	;; In auto-newline case, must insert a newline after each
-	;; brace.  So an explicit loop is needed.
-	(while (> arg 0)
-	  (insert last-command-char)
-	  (tcl-indent-line)
-	  (newline)
-	  (setq arg (1- arg))))
-    (self-insert-command arg))
-  (tcl-indent-line))
-
-
-
-(defun tcl-indent-command (&optional arg)
-  "Indent current line as Tcl code, or in some cases insert a tab character.
-If tcl-tab-always-indent is t (the default), always indent current line.
-If tcl-tab-always-indent is nil and point is not in the indentation
-area at the beginning of the line, a TAB is inserted.
-Other values of tcl-tab-always-indent cause the first possible action
-from the following list to take place:
-
-  1. Move from beginning of line to correct indentation.
-  2. Delete an empty comment.
-  3. Move forward to start of comment, indenting if necessary.
-  4. Move forward to end of line, indenting if necessary.
-  5. Create an empty comment.
-  6. Move backward to start of comment, indenting if necessary."
-  (interactive "p")
-  (cond
-   ((not tcl-tab-always-indent)
-    ;; Indent if in indentation area, otherwise insert TAB.
-    (if (<= (current-column) (current-indentation))
-	(tcl-indent-line)
-      (insert-tab arg)))
-   ((eq tcl-tab-always-indent t)
-    ;; Always indent.
-    (tcl-indent-line))
-   (t
-    ;; "Perl-mode" style TAB command.
-    (let* ((ipoint (point))
-	   (eolpoint (progn
-		       (end-of-line)
-		       (point)))
-	   (comment-p (tcl-in-comment)))
-      (cond
-       ((= ipoint (save-excursion
-		    (beginning-of-line)
-		    (point)))
-	(beginning-of-line)
-	(tcl-indent-line)
-	;; If indenting didn't leave us in column 0, go to the
-	;; indentation.  Otherwise leave point at end of line.  This
-	;; is a hack.
-	(if (= (point) (save-excursion
-			 (beginning-of-line)
-			 (point)))
-	    (end-of-line)
-	  (back-to-indentation)))
-       ((and comment-p (looking-at "[ \t]*$"))
-	;; Empty comment, so delete it.  We also delete any ";"
-	;; characters at the end of the line.  I think this is
-	;; friendlier, but I don't know how other people will feel.
-	(backward-char)
-	(skip-chars-backward " \t;")
-	(delete-region (point) eolpoint))
-       ((and comment-p (< ipoint (point)))
-	;; Before comment, so skip to it.
-	(tcl-indent-line)
-	(indent-for-comment))
-       ((/= ipoint eolpoint)
-	;; Go to end of line (since we're not there yet).
-	(goto-char eolpoint)
-	(tcl-indent-line))
-       ((not comment-p)
-	(tcl-indent-line)
-	(tcl-indent-for-comment))
-       (t
-	;; Go to start of comment.  We don't leave point where it is
-	;; because we want to skip comment-start-skip.
-	(tcl-indent-line)
-	(indent-for-comment)))))))
-
-(defun tcl-indent-line ()
-  "Indent current line as Tcl code.
-Return the amount the indentation changed by."
-  (let ((indent (calculate-tcl-indent nil))
-	beg shift-amt
-	(case-fold-search nil)
-	(pos (- (point-max) (point))))
-    (beginning-of-line)
-    (setq beg (point))
-    (cond ((eq indent nil)
-	   (setq indent (current-indentation)))
-	  (t
-	   (skip-chars-forward " \t")
-	   (if (listp indent) (setq indent (car indent)))
-	   (cond ((= (following-char) ?})
-		  (setq indent (- indent tcl-indent-level)))
-		 ((= (following-char) ?\])
-		  (setq indent (- indent 1))))))
-    (skip-chars-forward " \t")
-    (setq shift-amt (- indent (current-column)))
-    (if (zerop shift-amt)
-	(if (> (- (point-max) pos) (point))
-	    (goto-char (- (point-max) pos)))
-      (delete-region beg (point))
-      (indent-to indent)
-      ;; If initial point was within line's indentation,
-      ;; position after the indentation.  Else stay at same point in text.
-      (if (> (- (point-max) pos) (point))
-	  (goto-char (- (point-max) pos))))
-    shift-amt))
-
-(defun tcl-figure-type ()
-  "Determine type of sexp at point.
-This is either 'tcl-expr, 'tcl-commands, or nil.  Puts point at start
-of sexp that indicates types.
-
-See documentation for variable `tcl-type-alist' for more information."
-  (let ((count 0)
-	result
-	word-stack)
-    (while (and (< count 5)
-		(not result))
-      (condition-case nil
-	  (progn
-	    ;; FIXME should use "tcl-backward-sexp", which would skip
-	    ;; over entire variables, etc.
-	    (backward-sexp)
-	    (if (looking-at "[a-zA-Z_]+")
-		(let ((list tcl-type-alist)
-		      entry)
-		  (setq word-stack (cons (tcl-word-no-props) word-stack))
-		  (while (and list (not result))
-		    (setq entry (car list))
-		    (setq list (cdr list))
-		    (let ((index 0))
-		      (while (and entry (<= index count))
-			;; Abort loop if string does not match word on
-			;; stack.
-			(and (stringp (car entry))
-			     (not (string= (car entry)
-					   (nth index word-stack)))
-			     (setq entry nil))
-			(setq entry (cdr entry))
-			(setq index (1+ index)))
-		      (and (> index count)
-			   (not (stringp (car entry)))
-			   (setq result (car entry)))
-		      )))
-	      (setq word-stack (cons nil word-stack))))
-	(error nil))
-      (setq count (1+ count)))
-    (and tcl-explain-indentation
-	 (message "Indentation type %s" result))
-    result))
-
-(defun calculate-tcl-indent (&optional parse-start)
-  "Return appropriate indentation for current line as Tcl code.
-In usual case returns an integer: the column to indent to.
-Returns nil if line starts inside a string, t if in a comment."
-  (save-excursion
-    (beginning-of-line)
-    (let* ((indent-point (point))
-	   (case-fold-search nil)
-	   (continued-line 
-	    (save-excursion
-	      (if (bobp)
-		  nil
-		(backward-char)
-		(= ?\\ (preceding-char)))))
-	   (continued-indent-value (if continued-line
-				       tcl-continued-indent-level
-				     0))
-	   state
-	   containing-sexp
-	   found-next-line)
-      (if parse-start
-	  (goto-char parse-start)
-	(tcl-beginning-of-defun))
-      (while (< (point) indent-point)
-	(setq parse-start (point))
-	(setq state (parse-partial-sexp (point) indent-point 0))
-	(setq containing-sexp (car (cdr state))))
-      (cond ((or (nth 3 state) (nth 4 state))
-	     ;; Inside comment or string.  Return nil or t if should
-	     ;; not change this line
-	     (nth 4 state))
-	    ((null containing-sexp)
-	     ;; Line is at top level.
-	     continued-indent-value)
-	    (t
-	     ;; Set expr-p if we are looking at the expression part of
-	     ;; an "if", "expr", etc statement.  Set commands-p if we
-	     ;; are looking at the body part of an if, while, etc
-	     ;; statement.  FIXME Should check for "for" loops here.
-	     (goto-char containing-sexp)
-	     (let* ((sexpr-type (tcl-figure-type))
-		    (expr-p (eq sexpr-type 'tcl-expr))
-		    (commands-p (eq sexpr-type 'tcl-commands))
-		    (expr-start (point)))
-	       ;; Find the first statement in the block and indent
-	       ;; like it.  The first statement in the block might be
-	       ;; on the same line, so what we do is skip all
-	       ;; "virtually blank" lines, looking for a non-blank
-	       ;; one.  A line is virtually blank if it only contains
-	       ;; a comment and whitespace.  FIXME continued comments
-	       ;; aren't supported.  They are a wart on Tcl anyway.
-	       ;; We do it this funky way because we want to know if
-	       ;; we've found a statement on some line _after_ the
-	       ;; line holding the sexp opener.
-	       (goto-char containing-sexp)
-	       (forward-char)
-	       (if (and (< (point) indent-point)
-			(looking-at "[ \t]*\\(#.*\\)?$"))
-		   (progn
-		     (forward-line)
-		     (while (and (< (point) indent-point)
-				 (looking-at "[ \t]*\\(#.*\\)?$"))
-		       (setq found-next-line t)
-		       (forward-line))))
-	       (if (or continued-line
-		       (/= (char-after containing-sexp) ?{)
-		       expr-p)
-		   (progn
-		     ;; Line is continuation line, or the sexp opener
-		     ;; is not a curly brace, or we are are looking at
-		     ;; an `expr' expression (which must be split
-		     ;; specially).  So indentation is column of first
-		     ;; good spot after sexp opener (with some added
-		     ;; in the continued-line case).  If there is no
-		     ;; nonempty line before the indentation point, we
-		     ;; use the column of the character after the sexp
-		     ;; opener.
-		     (if (>= (point) indent-point)
-			 (progn
-			   (goto-char containing-sexp)
-			   (forward-char))
-		       (skip-chars-forward " \t"))
-		     (+ (current-column) continued-indent-value))
-		 ;; After a curly brace, and not a continuation line.
-		 ;; So take indentation from first good line after
-		 ;; start of block, unless that line is on the same
-		 ;; line as the opening brace.  In this case use the
-		 ;; indentation of the opening brace's line, plus
-		 ;; another indent step.  If we are in the body part
-		 ;; of an "if" or "while" then the indentation is
-		 ;; taken from the line holding the start of the
-		 ;; statement.
-		 (if (and (< (point) indent-point)
-			  found-next-line)
-		     (current-indentation)
-		   (if commands-p
-		       (goto-char expr-start)
-		     (goto-char containing-sexp))
-		   (+ (current-indentation) tcl-indent-level)))))))))
-
-
-
-(defun indent-tcl-exp ()
-  "Indent each line of the Tcl grouping following point."
-  (interactive)
-  (let ((indent-stack (list nil))
-	(contain-stack (list (point)))
-	(case-fold-search nil)
-	outer-loop-done inner-loop-done state ostate
-	this-indent last-sexp continued-line
-	(next-depth 0)
-	last-depth)
-    (save-excursion
-      (forward-sexp 1))
-    (save-excursion
-      (setq outer-loop-done nil)
-      (while (and (not (eobp)) (not outer-loop-done))
-	(setq last-depth next-depth)
-	;; Compute how depth changes over this line
-	;; plus enough other lines to get to one that
-	;; does not end inside a comment or string.
-	;; Meanwhile, do appropriate indentation on comment lines.
-	(setq inner-loop-done nil)
-	(while (and (not inner-loop-done)
-		    (not (and (eobp) (setq outer-loop-done t))))
-	  (setq ostate state)
-	  (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
-					  nil nil state))
-	  (setq next-depth (car state))
-	  (if (and (car (cdr (cdr state)))
-		   (>= (car (cdr (cdr state))) 0))
-	      (setq last-sexp (car (cdr (cdr state)))))
-	  (if (or (nth 4 ostate))
-	      (tcl-indent-line))
-	  (if (or (nth 3 state))
-	      (forward-line 1)
-	    (setq inner-loop-done t)))
-	(if (<= next-depth 0)
-	    (setq outer-loop-done t))
-	(if outer-loop-done
-	    nil
-	  ;; If this line had ..))) (((.. in it, pop out of the levels
-	  ;; that ended anywhere in this line, even if the final depth
-	  ;; doesn't indicate that they ended.
-	  (while (> last-depth (nth 6 state))
-	    (setq indent-stack (cdr indent-stack)
-		  contain-stack (cdr contain-stack)
-		  last-depth (1- last-depth)))
-	  (if (/= last-depth next-depth)
-	      (setq last-sexp nil))
-	  ;; Add levels for any parens that were started in this line.
-	  (while (< last-depth next-depth)
-	    (setq indent-stack (cons nil indent-stack)
-		  contain-stack (cons nil contain-stack)
-		  last-depth (1+ last-depth)))
-	  (if (null (car contain-stack))
-	      (setcar contain-stack 
-		      (or (car (cdr state))
-			  (save-excursion
-			    (forward-sexp -1)
-			    (point)))))
-	  (forward-line 1)
-	  (setq continued-line 
-		(save-excursion
-		  (backward-char)
-		  (= (preceding-char) ?\\)))
-	  (skip-chars-forward " \t")
-	  (if (eolp)
-	      nil
-	    (if (and (car indent-stack)
-		     (>= (car indent-stack) 0))
-		;; Line is on an existing nesting level.
-		(setq this-indent (car indent-stack))
-	      ;; Just started a new nesting level.
-	      ;; Compute the standard indent for this level.
-	      (let ((val (calculate-tcl-indent
-			  (if (car indent-stack)
-			      (- (car indent-stack))))))
-		(setcar indent-stack
-			(setq this-indent val))
-		(setq continued-line nil)))
-	    (cond ((not (numberp this-indent)))
-		  ((= (following-char) ?})
-		   (setq this-indent (- this-indent tcl-indent-level)))
-		  ((= (following-char) ?\])
-		   (setq this-indent (- this-indent 1))))
-	    ;; Put chosen indentation into effect.
-	    (or (null this-indent)
-		(= (current-column) 
-		   (if continued-line 
-		       (+ this-indent tcl-indent-level)
-		     this-indent))
-		(progn
-		  (delete-region (point) (progn (beginning-of-line) (point)))
-		  (indent-to 
-		   (if continued-line 
-		       (+ this-indent tcl-indent-level)
-		     this-indent)))))))))
-  )
-
-
-
-;;
-;; Interfaces to other packages.
-;;
-
-(defun tcl-imenu-create-index-function ()
-  "Generate alist of indices for imenu."
-  (let ((re (concat tcl-proc-regexp "\\([^ \t\n{]+\\)"))
-	alist prev-pos)
-    (goto-char (point-min))
-    (imenu-progress-message prev-pos 0)
-    (save-match-data
-      (while (re-search-forward re nil t)
-	(imenu-progress-message prev-pos)
-	;; Position on start of proc name, not beginning of line.
-	(setq alist (cons
-		     (cons (buffer-substring (match-beginning 2) (match-end 2))
-			   (match-beginning 2))
-		     alist))))
-    (imenu-progress-message prev-pos 100)
-    (nreverse alist)))
-
-;; FIXME Definition of function is very ad-hoc.  Should use
-;; tcl-beginning-of-defun.  Also has incestuous knowledge about the
-;; format of tcl-proc-regexp.
-(defun add-log-tcl-defun ()
-  "Return name of Tcl function point is in, or nil."
-  (save-excursion
-    (end-of-line)
-    (if (re-search-backward (concat tcl-proc-regexp "\\([^ \t\n{]+\\)") nil t)
-	(buffer-substring (match-beginning 2)
-			  (match-end 2)))))
-
-(defun tcl-outline-level ()
-  (save-excursion
-    (skip-chars-forward " \t")
-    (current-column)))
-
-
-
-;;
-;; Helper functions for inferior Tcl mode.
-;;
-
-;; This exists to let us delete the prompt when commands are sent
-;; directly to the inferior Tcl.  See gud.el for an explanation of how
-;; it all works (I took it from there).  This stuff doesn't really
-;; work as well as I'd like it to.  But I don't believe there is
-;; anything useful that can be done.
-(defvar inferior-tcl-delete-prompt-marker nil)
-
-(defun tcl-filter (proc string)
-  (let ((inhibit-quit t))
-    (save-excursion
-      (set-buffer (process-buffer proc))
-      (goto-char (process-mark proc))
-      ;; Delete prompt if requested.
-      (if (marker-buffer inferior-tcl-delete-prompt-marker)
-	  (progn
-	    (delete-region (point) inferior-tcl-delete-prompt-marker)
-	    (set-marker inferior-tcl-delete-prompt-marker nil)))))
-  (if tcl-using-emacs-19
-      (comint-output-filter proc string)
-    (funcall comint-output-filter string)))
-
-(defun tcl-send-string (proc string)
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    (goto-char (process-mark proc))
-    (beginning-of-line)
-    (if (looking-at comint-prompt-regexp)
-	(set-marker inferior-tcl-delete-prompt-marker (point))))
-  (comint-send-string proc string))
-
-(defun tcl-send-region (proc start end)
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    (goto-char (process-mark proc))
-    (beginning-of-line)
-    (if (looking-at comint-prompt-regexp)
-	(set-marker inferior-tcl-delete-prompt-marker (point))))
-  (comint-send-region proc start end))
-
-(defun switch-to-tcl (eob-p)
-  "Switch to inferior Tcl process buffer.
-With argument, positions cursor at end of buffer."
-  (interactive "P")
-  (if (get-buffer inferior-tcl-buffer)
-      (pop-to-buffer inferior-tcl-buffer)
-    (error "No current inferior Tcl buffer"))
-  (cond (eob-p
-	 (push-mark)
-	 (goto-char (point-max)))))
-
-(defun inferior-tcl-proc ()
-  "Return current inferior Tcl process.
-See variable `inferior-tcl-buffer'."
-  (let ((proc (get-buffer-process (if (eq major-mode 'inferior-tcl-mode)
-				      (current-buffer)
-				    inferior-tcl-buffer))))
-    (or proc
-	(error "No Tcl process; see variable `inferior-tcl-buffer'"))))
-
-(defun tcl-eval-region (start end &optional and-go)
-  "Send the current region to the inferior Tcl process.
-Prefix argument means switch to the Tcl buffer afterwards."
-  (interactive "r\nP")
-  (let ((proc (inferior-tcl-proc)))
-    (tcl-send-region proc start end)
-    (tcl-send-string proc "\n")
-    (if and-go (switch-to-tcl t))))
-
-(defun tcl-eval-defun (&optional and-go)
-  "Send the current defun to the inferior Tcl process.
-Prefix argument means switch to the Tcl buffer afterwards."
-  (interactive "P")
-  (save-excursion
-    (tcl-end-of-defun)
-    (let ((end (point)))
-      (tcl-beginning-of-defun)
-      (tcl-eval-region (point) end)))
-  (if and-go (switch-to-tcl t)))
-
-
-
-;;
-;; Inferior Tcl mode itself.
-;;
-
-(defun inferior-tcl-mode ()
-  "Major mode for interacting with Tcl interpreter.
-
-A Tcl process can be started with M-x inferior-tcl.
-
-Entry to this mode runs the hooks comint-mode-hook and
-inferior-tcl-mode-hook, in that order.
-
-You can send text to the inferior Tcl process from other buffers
-containing Tcl source.
-
-Variables controlling Inferior Tcl mode:
-  tcl-application
-    Name of program to run.
-  tcl-command-switches
-    Command line arguments to `tcl-application'.
-  tcl-prompt-regexp
-    Matches prompt.
-  inferior-tcl-source-command
-    Command to use to read Tcl file in running application.
-  inferior-tcl-buffer
-    The current inferior Tcl process buffer.  See variable
-    documentation for details on multiple-process support.
-
-The following commands are available:
-\\{inferior-tcl-mode-map}"
-  (interactive)
-  (comint-mode)
-  (setq comint-prompt-regexp (or tcl-prompt-regexp
-				 (concat "^"
-					 (regexp-quote tcl-application)
-					 ">")))
-  (setq major-mode 'inferior-tcl-mode)
-  (setq mode-name "Inferior Tcl")
-  (if (boundp 'modeline-process)
-      (setq modeline-process '(": %s"))	; For XEmacs.
-    (setq mode-line-process '(": %s")))
-  (use-local-map inferior-tcl-mode-map)
-  (setq local-abbrev-table tcl-mode-abbrev-table)
-  (set-syntax-table tcl-mode-syntax-table)
-  (if tcl-using-emacs-19
-      (progn
-	(make-local-variable 'defun-prompt-regexp)
-	(setq defun-prompt-regexp tcl-omit-ws-regexp)))
-  (make-local-variable 'inferior-tcl-delete-prompt-marker)
-  (setq inferior-tcl-delete-prompt-marker (make-marker))
-  (set-process-filter (get-buffer-process (current-buffer)) 'tcl-filter)
-  (run-hooks 'inferior-tcl-mode-hook))
-
-;;;###autoload
-(defun inferior-tcl (cmd)
-  "Run inferior Tcl process.
-Prefix arg means enter program name interactively.
-See documentation for function `inferior-tcl-mode' for more information."
-  (interactive
-   (list (if current-prefix-arg
-	     (read-string "Run Tcl: " tcl-application)
-	   tcl-application)))
-  (if (not (comint-check-proc "*inferior-tcl*"))
-      (progn
-	(set-buffer (apply (function make-comint) "inferior-tcl" cmd nil
-			   tcl-command-switches))
-	(inferior-tcl-mode)))
-  (make-local-variable 'tcl-application)
-  (setq tcl-application cmd)
-  (setq inferior-tcl-buffer "*inferior-tcl*")
-  (switch-to-buffer "*inferior-tcl*"))
-
-(and (fboundp 'defalias)
-     (defalias 'run-tcl 'inferior-tcl))
-
-
-
-;;
-;; Auto-fill support.
-;;
-
-(defun tcl-real-command-p ()
-  "Return nil if point is not at the beginning of a command.
-A command is the first word on an otherwise empty line, or the
-first word following a semicolon, opening brace, or opening bracket."
-  (save-excursion
-    (skip-chars-backward " \t")
-    (cond
-     ((bobp) t)
-     ((bolp)
-      (backward-char)
-      ;; Note -- continued comments are not supported here.  I
-      ;; consider those to be a wart on the language.
-      (not (eq ?\\ (preceding-char))))
-     (t
-      (memq (preceding-char) '(?\; ?{ ?\[))))))
-
-;; FIXME doesn't actually return t.  See last case.
-(defun tcl-real-comment-p ()
-  "Return t if point is just after the `#' beginning a real comment.
-Does not check to see if previous char is actually `#'.
-A real comment is either at the beginning of the buffer,
-preceeded only by whitespace on the line, or has a preceeding
-semicolon, opening brace, or opening bracket on the same line."
-  (save-excursion
-    (backward-char)
-    (tcl-real-command-p)))
-
-(defun tcl-hairy-scan-for-comment (state end always-stop)
-  "Determine if point is in a comment.
-Returns a list of the form `(FLAG . STATE)'.  STATE can be used
-as input to future invocations.  FLAG is nil if not in comment,
-t otherwise.  If in comment, leaves point at beginning of comment.
-Only works in Emacs 19.  See also `tcl-simple-scan-for-comment', a
-simpler version that is often right, and works in Emacs 18."
-  (let ((bol (save-excursion
-	       (goto-char end)
-	       (beginning-of-line)
-	       (point)))
-	real-comment
-	last-cstart)
-    (while (and (not last-cstart) (< (point) end))
-      (setq real-comment nil)		;In case we've looped around and it is
-                                        ;set.
-      (setq state (parse-partial-sexp (point) end nil nil state t))
-      (if (nth 4 state)
-	  (progn
-	    ;; If ALWAYS-STOP is set, stop even if we don't have a
-	    ;; real comment, or if the comment isn't on the same line
-	    ;; as the end.
-	    (if always-stop (setq last-cstart (point)))
-	    ;; If we have a real comment, then set the comment
-	    ;; starting point if we are on the same line as the ending
-	    ;; location.
-	    (setq real-comment (tcl-real-comment-p))
-	    (if real-comment
-		(progn
-		  (and (> (point) bol) (setq last-cstart (point)))
-		  ;; NOTE Emacs 19 has a misfeature whereby calling
-		  ;; parse-partial-sexp with COMMENTSTOP set and with
-		  ;; an initial list that says point is in a comment
-		  ;; will cause an immediate return.  So we must skip
-		  ;; over the comment ourselves.
-		  (beginning-of-line 2)))
-	    ;; Frob the state to make it look like we aren't in a
-	    ;; comment.
-	    (setcar (nthcdr 4 state) nil))))
-    (and last-cstart
-	 (goto-char last-cstart))
-    (cons real-comment state)))
-
-(defun tcl-hairy-in-comment ()
-  "Return t if point is in a comment, and leave point at beginning
-of comment."
-  (let ((save (point)))
-    (tcl-beginning-of-defun)
-    (car (tcl-hairy-scan-for-comment nil save nil))))
-
-(defun tcl-simple-in-comment ()
-  "Return t if point is in comment, and leave point at beginning
-of comment.  This is faster that `tcl-hairy-in-comment', but is
-correct less often."
-  (let ((save (point))
-	comment)
-    (beginning-of-line)
-    (while (and (< (point) save) (not comment))
-      (search-forward "#" save 'move)
-      (setq comment (tcl-real-comment-p)))
-    comment))
-
-(defun tcl-in-comment ()
-  "Return t if point is in comment, and leave point at beginning
-of comment."
-  (if (and tcl-pps-has-arg-6
-	   tcl-use-hairy-comment-detector)
-      (tcl-hairy-in-comment)
-    (tcl-simple-in-comment)))
-
-(defun tcl-do-fill-paragraph (ignore)
-  "fill-paragraph function for Tcl mode.  Only fills in a comment."
-  (let (in-comment col where)
-    (save-excursion
-      (end-of-line)
-      (setq in-comment (tcl-in-comment))
-      (if in-comment
-	  (progn
-	    (setq where (1+ (point)))
-	    (setq col (1- (current-column))))))
-    (and in-comment
-	 (save-excursion
-	   (back-to-indentation)
-	   (= col (current-column)))
-	 ;; In a comment.  Set the fill prefix, and find the paragraph
-	 ;; boundaries by searching for lines that look like
-	 ;; comment-only lines.
-	 (let ((fill-prefix (buffer-substring (progn
-						(beginning-of-line)
-						(point))
-					      where))
-	       p-start p-end)
-	   ;; Search backwards.
-	   (save-excursion
-	     (while (looking-at "^[ \t]*#")
-	       (forward-line -1))
-	     (forward-line)
-	     (setq p-start (point)))
-
-	   ;; Search forwards.
-	   (save-excursion
-	     (while (looking-at "^[ \t]*#")
-	       (forward-line))
-	     (setq p-end (point)))
-
-	   ;; Narrow and do the fill.
-	   (save-restriction
-	     (narrow-to-region p-start p-end)
-	     (fill-paragraph ignore)))))
-  t)
-
-(defun tcl-do-auto-fill ()
-  "Auto-fill function for Tcl mode.  Only auto-fills in a comment."
-  (if (> (current-column) fill-column)
-      (let ((fill-prefix "# ")
-	    in-comment col)
-	(save-excursion
-	  (setq in-comment (tcl-in-comment))
-	  (if in-comment
-	      (setq col (1- (current-column)))))
-	(if in-comment
-	    (progn
-	      (do-auto-fill)
-	      (save-excursion
-		(back-to-indentation)
-		(delete-region (point) (save-excursion
-					 (beginning-of-line)
-					 (point)))
-		(indent-to-column col)))))))
-
-
-
-;;
-;; Help-related code.
-;;
-
-(defvar tcl-help-saved-dirs nil
-  "Saved help directories.
-If `tcl-help-directory-list' changes, this allows `tcl-help-on-word'
-to update the alist.")
-
-(defvar tcl-help-alist nil
-  "Alist with command names as keys and filenames as values.")
-
-(defun tcl-help-snarf-commands (dirlist)
-  "Build alist of commands and filenames."
-  (while dirlist
-    (let ((files (directory-files (car dirlist) t)))
-      (while files
-	(if (and (file-directory-p (car files))
-		 (not
-		  (let ((fpart (file-name-nondirectory (car files))))
-		    (or (equal fpart ".")
-			(equal fpart "..")))))
-	    (let ((matches (directory-files (car files) t)))
-	      (while matches
-		(or (file-directory-p (car matches))
-		    (setq tcl-help-alist
-			  (cons
-			   (cons (file-name-nondirectory (car matches))
-				 (car matches))
-			   tcl-help-alist)))
-		(setq matches (cdr matches)))))
-	(setq files (cdr files))))
-    (setq dirlist (cdr dirlist))))
-
-(defun tcl-reread-help-files ()
-  "Set up to re-read files, and then do it."
-  (interactive)
-  (message "Building Tcl help file index...")
-  (setq tcl-help-saved-dirs tcl-help-directory-list)
-  (setq tcl-help-alist nil)
-  (tcl-help-snarf-commands tcl-help-directory-list)
-  (message "Building Tcl help file index...done"))
-
-(defun tcl-word-no-props ()
-  "Like current-word, but strips properties."
-  (let ((word (current-word)))
-    (and (fboundp 'set-text-properties)
-	 (set-text-properties 0 (length word) nil word))
-    word))
-
-(defun tcl-current-word (flag)
-  "Return current command word, or nil.
-If FLAG is nil, just uses `current-word'.
-Otherwise scans backward for most likely Tcl command word."
-  (if (and flag
-	   (memq major-mode '(tcl-mode inferior-tcl-mode)))
-      (condition-case nil
-	  (save-excursion
-	    ;; Look backward for first word actually in alist.
-	    (if (bobp)
-		()
-	      (while (and (not (bobp))
-			  (not (tcl-real-command-p)))
-		(backward-sexp)))
-	    (if (assoc (tcl-word-no-props) tcl-help-alist)
-		(tcl-word-no-props)))
-	(error nil))
-    (tcl-word-no-props)))
-
-;;;###autoload
-(defun tcl-help-on-word (command &optional arg)
-  "Get help on Tcl command.  Default is word at point.
-Prefix argument means invert sense of `tcl-use-smart-word-finder'."
-  (interactive
-   (list
-    (progn
-      (if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
-	  (tcl-reread-help-files))
-      (let ((word (tcl-current-word
-		   (if current-prefix-arg
-		       (not tcl-use-smart-word-finder)
-		     tcl-use-smart-word-finder))))
-	(completing-read
-	 (if (or (null word) (string= word ""))
-	     "Help on Tcl command: "
-	   (format "Help on Tcl command (default %s): " word))
-	 tcl-help-alist nil t)))
-    current-prefix-arg))
-  (if (not (equal tcl-help-directory-list tcl-help-saved-dirs))
-      (tcl-reread-help-files))
-  (if (string= command "")
-      (setq command (tcl-current-word
-		     (if arg
-			 (not tcl-use-smart-word-finder)
-		       tcl-use-smart-word-finder))))
-  (let* ((help (get-buffer-create "*Tcl help*"))
-	 (cell (assoc command tcl-help-alist))
-	 (file (and cell (cdr cell))))
-    (set-buffer help)
-    (delete-region (point-min) (point-max))
-    (if file
-	(progn
-	  (insert "*** " command "\n\n")
-	  (insert-file-contents file))
-      (if (string= command "")
-	  (insert "Magical Pig!")
-	(insert "Tcl command " command " not in help\n")))
-    (set-buffer-modified-p nil)
-    (goto-char (point-min))
-    (display-buffer help)))
-
-
-
-;;
-;; Other interactive stuff.
-;;
-
-(defvar tcl-previous-dir/file nil
-  "Record last directory and file used in loading.
-This holds a cons cell of the form `(DIRECTORY . FILE)'
-describing the last `tcl-load-file' command.")
-
-(defun tcl-load-file (file &optional and-go)
-  "Load a Tcl file into the inferior Tcl process.
-Prefix argument means switch to the Tcl buffer afterwards."
-  (interactive
-   (list
-    ;; car because comint-get-source returns a list holding the
-    ;; filename.
-    (car (comint-get-source "Load Tcl file: "
-			    (or (and
-				 (eq major-mode 'tcl-mode)
-				 (buffer-file-name))
-				tcl-previous-dir/file)
-			    '(tcl-mode) t))
-    current-prefix-arg))
-  (comint-check-source file)
-  (setq tcl-previous-dir/file (cons (file-name-directory file)
-				    (file-name-nondirectory file)))
-  (tcl-send-string (inferior-tcl-proc)
-		   (format inferior-tcl-source-command (tcl-quote file)))
-  (if and-go (switch-to-tcl t)))
-
-(defun tcl-restart-with-file (file &optional and-go)
-  "Restart inferior Tcl with file.
-If an inferior Tcl process exists, it is killed first.
-Prefix argument means switch to the Tcl buffer afterwards."
-  (interactive
-   (list
-    (car (comint-get-source "Restart with Tcl file: "
-			    (or (and
-				 (eq major-mode 'tcl-mode)
-				 (buffer-file-name))
-				tcl-previous-dir/file)
-			    '(tcl-mode) t))
-    current-prefix-arg))
-  (let* ((buf (if (eq major-mode 'inferior-tcl-mode)
-		  (current-buffer)
-		inferior-tcl-buffer))
-	 (proc (and buf (get-process buf))))
-    (cond
-     ((not (and buf (get-buffer buf)))
-      ;; I think this will be ok.
-      (inferior-tcl tcl-application)
-      (tcl-load-file file and-go))
-     ((or
-       (not (comint-check-proc buf))
-       (yes-or-no-p
-	"A Tcl process is running, are you sure you want to reset it? "))
-      (save-excursion
-	(comint-check-source file)
-	(setq tcl-previous-dir/file (cons (file-name-directory file)
-					  (file-name-nondirectory file)))
-	(comint-exec (get-buffer-create buf)
-		     (if proc
-			 (process-name proc)
-		       "inferior-tcl")
-		     tcl-application file tcl-command-switches)
-	(if and-go (switch-to-tcl t)))))))
-
-;; FIXME I imagine you can do this under Emacs 18.  I just don't know
-;; how.
-(defun tcl-auto-fill-mode (&optional arg)
-  "Like `auto-fill-mode', but controls filling of Tcl comments."
-  (interactive "P")
-  (and (not tcl-using-emacs-19)
-       (error "You must use Emacs 19 to get this feature."))
-  ;; Following code taken from "auto-fill-mode" (simple.el).
-  (prog1
-      (setq auto-fill-function
-	    (if (if (null arg)
-		    (not auto-fill-function)
-		  (> (prefix-numeric-value arg) 0))
-		'tcl-do-auto-fill
-	      nil))
-    (force-mode-line-update)))
-
-;; hilit19 support from "Chris Alfeld" <calfeld@math.utah.edu>
-(defun tcl-hilit ()
-  (hilit-set-mode-patterns
-   '(tcl-mode)
-   '(
-     ("\\(^ *\\|\; *\\)#.*$" nil comment)
-     ("[^\\]\\(\\$[A-Za-z0-9\\-\\_./\\(\\)]+\\)" 1 label)
-     ("[^_]\\<\\(append\\|array\\|auto_execok\\|auto_load\\|auto_mkindex\\|auto_reset\\|break\\|case\\|catch\\|cd\\|close\\|concat\\|continue\\|eof\\|error\\|eval\\|exec\\|exit\\|expr\\|file\\|flush\\|for\\|foreach\\|format\\|gets\\|glob\\|global\\|history\\|if\\|incr\\|info\\|join\\|lappend\\|lindex\\|linsert\\|list\\|llength\\|lrange\\|lreplace\\|lsearch\\|lsort\\|open\\|pid\\|proc\\|puts\\|pwd\\|read\\|regexp\\|regsub\\|rename\\|return\\|scan\\|seek\\|set\\|source\\|split\\|string\\|switch\\|tell\\|time\\|trace\\|unknown\\|unset\\|uplevel\\|upvar\\|while\\)\\>[^_]" 1 keyword) ; tcl keywords
-     ("[^_]\\<\\(after\\|bell\\|bind\\|bindtags\\|clipboard\\|destroy\\|fileevent\\|focus\\|grab\\|image\\|lower\\|option\\|pack\\|place\\|raise\\|scale\\|selection\\|send\\|subst\\|tk\\|tk_popup\\|tkwait\\|update\\|winfo\\|wm\\)\\>[^_]" 1 define) ; tk keywords
-     ("[^_]\\<\\(button\\|canvas\\|checkbutton\\|entry\\|frame\\|label\\|listbox\\|menu\\|menubutton\\|message\\|radiobutton\\|scrollbar\\|text\\|toplevel\\)\\>[^_]" 1 decl) ; tk widgets
-     ("[^_]\\<\\(tix\\((ButtonBox\\|Baloon\\|Control\\|DirList\\|ExFileSelectBox\\|ExFileSelectDialog\\|FileEntry\\|HList\\|LabelEntry\\|LabelFrame\\|NoteBook\\|OptionMenu\\|PanedWindow\\|PopupMenu\\|ScrolledHList\\|ScrolledText\\|ScrolledWindow\\|Select\\|StdButtonBox\\)\\)\\>[^_]" 1 defun) ; tix widgets
-     ("[{}\\\"\\(\\)]" nil include) ; misc punctuation
-     )))
-
-(defun tcl-electric-hash (&optional count)
-  "Insert a `#' and quote if it does not start a real comment.
-Prefix arg is number of `#'s to insert.
-See variable `tcl-electric-hash-style' for description of quoting
-styles."
-  (interactive "p")
-  (or count (setq count 1))
-  (if (> count 0)
-      (let ((type
-	     (if (eq tcl-electric-hash-style 'smart)
-		 (if (> count 3)	; FIXME what is "smart"?
-		     'quote
-		   'backslash)
-	       tcl-electric-hash-style))
-	    comment)
-	(if type
-	    (progn
-	      (save-excursion
-		(insert "#")
-		(setq comment (tcl-in-comment)))
-	      (delete-char 1)
-	      (and tcl-explain-indentation (message "comment: %s" comment))
-	      (cond
-	       ((eq type 'quote)
-		(if (not comment)
-		    (insert "\"")))
-	       ((eq type 'backslash)
-		;; The following will set count to 0, so the
-		;; insert-char can still be run.
-		(if (not comment)
-		    (while (> count 0)
-		      (insert "\\#")
-		      (setq count (1- count)))))
-	       (t nil))))
-	(insert-char ?# count))))
-
-(defun tcl-hashify-buffer ()
-  "Quote all `#'s in current buffer that aren't Tcl comments."
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (if (and tcl-pps-has-arg-6 tcl-use-hairy-comment-detector)
-	(let (state
-	      result)
-	  (while (< (point) (point-max))
-	    (setq result (tcl-hairy-scan-for-comment state (point-max) t))
-	    (if (car result)
-		(beginning-of-line 2)
-	      (backward-char)
-	      (if (eq ?# (following-char))
-		  (insert "\\"))
-	      (forward-char))
-	    (setq state (cdr result))))
-      (while (and (< (point) (point-max))
-		  (search-forward "#" nil 'move))
-	(if (tcl-real-comment-p)
-	    (beginning-of-line 2)
-	  ;; There's really no good way for the simple converter to
-	  ;; work.  So we just quote # if it isn't already quoted.
-	  ;; Bogus, but it works.
-	  (backward-char)
-	  (if (not (eq ?\\ (preceding-char)))
-	      (insert "\\"))
-	  (forward-char))))))
-
-(defun tcl-indent-for-comment ()
-  "Indent this line's comment to comment column, or insert an empty comment.
-Is smart about syntax of Tcl comments.
-Parts of this were taken from indent-for-comment (simple.el)."
-  (interactive "*")
-  (end-of-line)
-  (or (tcl-in-comment)
-      (progn
-	;; Not in a comment, so we have to insert one.  Create an
-	;; empty comment (since there isn't one on this line).  If
-	;; line is not blank, make sure we insert a ";" first.
-	(skip-chars-backward " \t")
-	(let ((eolpoint (point)))
-	  (beginning-of-line)
-	  (if (/= (point) eolpoint)
-	      (progn
-		(goto-char eolpoint)
-		(insert
-		 (if (tcl-real-command-p) "" ";")
-		 "# ")
-		(backward-char))))))
-  ;; Point is just after the "#" starting a comment.  Move it as
-  ;; appropriate.
-  (let* ((indent (if comment-indent-hook
-		     (funcall comment-indent-hook)
-		   (funcall comment-indent-function)))
-	 (begpos (progn
-		   (backward-char)
-		   (point))))
-    (if (/= begpos indent)
-	(progn
-	  (skip-chars-backward " \t" (save-excursion
-				       (beginning-of-line)
-				       (point)))
-	  (delete-region (point) begpos)
-	  (indent-to indent)))
-    (looking-at comment-start-skip)	; Always true.
-    (goto-char (match-end 0))
-    ;; I don't like the effect of the next two.
-    ;;(skip-chars-backward " \t" (match-beginning 0))
-    ;;(skip-chars-backward "^ \t" (match-beginning 0))
-    ))
-
-;; The following was inspired by the Tcl editing mode written by
-;; Gregor Schmid <schmid@fb3-s7.math.TU-Berlin.DE>.  His version also
-;; attempts to snarf the command line options from the command line,
-;; but I didn't think that would really be that helpful (doesn't seem
-;; like it owould be right enough.  His version also looks for the
-;; "#!/bin/csh ... exec" hack, but that seemed even less useful.
-;; FIXME should make sure that the application mentioned actually
-;; exists.
-(defun tcl-guess-application ()
-  "Attempt to guess Tcl application by looking at first line.
-The first line is assumed to look like \"#!.../program ...\"."
-  (save-excursion
-    (goto-char (point-min))
-    (if (looking-at "#![^ \t]*/\\([^ \t\n/]+\\)\\([ \t]\\|$\\)")
-	(progn
-	  (make-local-variable 'tcl-application)
-	  (setq tcl-application (buffer-substring (match-beginning 1)
-						  (match-end 1)))))))
-
-;; This only exists to put on the menubar.  I couldn't figure out any
-;; other way to do it.  FIXME should take "number of #-marks"
-;; argument.
-(defun tcl-uncomment-region (beg end)
-  "Uncomment region."
-  (interactive "r")
-  (comment-region beg end -1))
-
-
-
-;;
-;; XEmacs menu support.
-;; Taken from schmid@fb3-s7.math.TU-Berlin.DE (Gregor Schmid),
-;; who wrote a different Tcl mode.
-;; We also have support for menus in FSF.  We do this by
-;; loading the XEmacs menu emulation code.
-;;
-
-(defun tcl-popup-menu (e)
-  (interactive "@e")
-  (and tcl-using-emacs-19
-       (not tcl-using-xemacs-19)
-       (if tcl-using-emacs-19-23
-	   (require 'lmenu)
-	 ;; CAVEATS:
-	 ;; * lmenu.el provides 'menubar, which is bogus.
-	 ;; * lmenu.el causes menubars to be turned on everywhere.
-	 ;;   Doubly bogus!
-	 ;; Both of these problems are fixed in Emacs 19.23.  People
-	 ;; using an Emacs before that just suffer.
-	 (require 'menubar "lmenu")))  ;; This is annoying
-  ;; IMHO popup-menu should be autoloaded in FSF Emacs.  Oh well.
-  (popup-menu tcl-xemacs-menu))
-
-
-
-;;
-;; Quoting and unquoting functions.
-;;
-
-;; This quoting is sufficient to protect eg a filename from any sort
-;; of expansion or splitting.  Tcl quoting sure sucks.
-(defun tcl-quote (string)
-  "Quote STRING according to Tcl rules."
-  (mapconcat (function (lambda (char)
-			 (if (memq char '(?[ ?] ?{ ?} ?\\ ?\" ?$ ?  ?\;))
-			     (concat "\\" (char-to-string char))
-			   (char-to-string char))))
-	     string ""))
-
-
-
-;;
-;; Bug reporting.
-;;
-
-(and (fboundp 'eval-when-compile)
-     (eval-when-compile
-       (require 'reporter)))
-
-(defun tcl-submit-bug-report ()
-  "Submit via mail a bug report on Tcl mode."
-  (interactive)
-  (require 'reporter)
-  (and
-   (y-or-n-p "Do you really want to submit a bug report on Tcl mode? ")
-   (reporter-submit-bug-report
-    tcl-maintainer
-    (concat "Tcl mode " tcl-version)
-    '(tcl-indent-level
-      tcl-continued-indent-level
-      tcl-auto-newline
-      tcl-tab-always-indent
-      tcl-use-hairy-comment-detector
-      tcl-electric-hash-style
-      tcl-help-directory-list
-      tcl-use-smart-word-finder
-      tcl-application
-      tcl-command-switches
-      tcl-prompt-regexp
-      inferior-tcl-source-command
-      tcl-using-emacs-19
-      tcl-using-emacs-19-23
-      tcl-using-xemacs-19
-      tcl-proc-list
-      tcl-proc-regexp
-      tcl-typeword-list
-      tcl-keyword-list
-      tcl-font-lock-keywords
-      tcl-pps-has-arg-6))))
-
-
-
-(provide 'tcl)
-
-;;; tcl.el ends here
diff --git a/lisp/ps-print.el b/lisp/ps-print.el
deleted file mode 100644
index 57e9b378fe3..00000000000
--- a/lisp/ps-print.el
+++ /dev/null
@@ -1,2931 +0,0 @@
-;;; ps-print.el --- Jim's Pretty-Good PostScript Generator for Emacs 19.
-
-;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Jim Thompson <thompson@wg2.waii.com>
-;; Maintainer: duthen@cegelec-red.fr (Jacques Duthen Prestataire)
-;; Keywords: print, PostScript
-
-;; 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.
-
-;; LCD Archive Entry:
-;; ps-print|James C. Thompson|thompson@wg2.waii.com|
-;; Jim's Pretty-Good PostScript Generator for Emacs 19 (ps-print)|
-;; 26-Feb-1994|2.8|~/packages/ps-print.el|
-
-;; 3.03 [jack] Sept 27, 1996 Jacques Duthen <duthen@cegelec-red.fr>
-;; Merge 31 diffs between 19.29 and 19.34
-
-;; 3.02 [jack] June 26, 1996 Jacques Duthen <duthen@cegelec-red.fr>
-;; Add new page dimensions to `ps-page-dimensions-database' for `paper-type'
-;; Improve landscape mode `ps-landscape-mode' and multiple columns
-;; printing `ps-number-of-columns':
-;; The text and the margins are no more scaled.
-;; Simplify the semantics of `ps-inter-column' (space between columns).
-;; Add error checking for negative `ps-print-width' and `ps-print-height'.
-;; Change the semantics of `ps-top-margin' which is now the TOP MARGIN,
-;; and add `ps-header-offset' instead of having `ps-top-margin' split in 2.
-;; Add `ps-header-font-family', `ps-header-font-size' and 
-;; `ps-header-title-font-size' to control the header.
-;; Add `ps-header-line-pad'.
-;; Change the semantics of `ps-font-info-database' to have symbolic
-;; font families.
-;; Add new fonts to `ps-font-info-database': `Courier' `Helvetica'
-;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk'
-;; Make public `ps-font-family' and `ps-font-size' so that the user
-;; can directly control the text font and size without loading ps-print.
-;; Add error checking for unknown font families and a message giving
-;; the exhaustive list of available font families.
-;; Document how to install a new font family.
-;; Add `/ReportAllFontInfo' to get all the font families of the printer.
-;; Add the possibility to make `mixed' font families.
-;; Add `ps-setup' to get the current setup.
-;; Add tools `ps-line-lengths' `ps-nb-pages-buffer' `ps-nb-pages-region'
-;; to help choose the font size.
-;; Split `ps-print-prologue' in two to insert info from header fonts
-;; Replace indexes by macro `ps-page-dimensions-get-width'
-;; to get access to the dimensions list.
-;; Add `ps-select-font' inside `ps-get-page-dimensions'.
-;; Fix the "clumsy" `ps-page-height' management.
-;; Move `ps-get-page-dimensions' to the beginning of `ps-begin-file'
-;; to get early error checking.
-;; Add sample setup `ps-jack-setup'.
-;;
-;; Rewrite a lot of postscript code and add comments inside it
-;; (maybe they should not (or optionally) be included in the generated
-;; Postscript).
-;; Translate the origin to (lm, bm) to simplify the other moves.
-;; Fix bug in `/HeaderOffset' with `/PrintStartY'.
-;; Fix bug in `/SetHeaderLines'.
-;; Change `/ReportFontInfo' for use by `/ReportAllFontInfo'.
-;; 
-
-;; 3.01 [jack] June 4, 1996 Jacques Duthen <duthen@cegelec-red.fr>
-;; Manage float value for every variable representing a size.
-;; Add `ps-font-info-database' `ps-inter-column'
-
-;; 3.00 [jack] May 17, 1996 Jacques Duthen <duthen@cegelec-red.fr>
-;;	based on 2.8 Jim's Pretty-Good version:
-;; Add `ps-landscape-mode' and `ps-number-of-columns'
-;; for dumb multi-column landscape mode.
-
-;; Baseline-version: 2.8.  (Jim's last change version -- this
-;; file may have been edited as part of Emacs without changes to the
-;; version number.  When reporting bugs, please also report the
-;; version of Emacs, if any, that ps-print was distributed with.)
-
-;;; Commentary:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; About ps-print
-;; --------------
-;;
-;; This package provides printing of Emacs buffers on PostScript
-;; printers; the buffer's bold and italic text attributes are
-;; preserved in the printer output.  Ps-print is intended for use with
-;; Emacs 19 or Lucid Emacs, together with a fontifying package such as
-;; font-lock or hilit.
-;;
-;;
-;; Using ps-print
-;; --------------
-;;
-;; The Commands
-;;
-;; Ps-print provides eight commands for generating PostScript images
-;; of Emacs buffers:
-;;
-;;        ps-print-buffer
-;;        ps-print-buffer-with-faces
-;;        ps-print-region
-;;        ps-print-region-with-faces
-;;        ps-spool-buffer
-;;        ps-spool-buffer-with-faces
-;;        ps-spool-region
-;;        ps-spool-region-with-faces
-;;
-;; These commands all perform essentially the same function: they
-;; generate PostScript images suitable for printing on a PostScript
-;; printer or displaying with GhostScript.  These commands are
-;; collectively referred to as "ps-print- commands".
-;;
-;; The word "print" or "spool" in the command name determines when the
-;; PostScript image is sent to the printer:
-;;
-;;        print      - The PostScript image is immediately sent to the
-;;                     printer;
-;;
-;;        spool      - The PostScript image is saved temporarily in an
-;;                     Emacs buffer.  Many images may be spooled locally
-;;                     before printing them.  To send the spooled images
-;;                     to the printer, use the command `ps-despool'.
-;;
-;; The spooling mechanism was designed for printing lots of small
-;; files (mail messages or netnews articles) to save paper that would
-;; otherwise be wasted on banner pages, and to make it easier to find
-;; your output at the printer (it's easier to pick up one 50-page
-;; printout than to find 50 single-page printouts).
-;; 
-;; Ps-print has a hook in the `kill-emacs-hooks' so that you won't
-;; accidentally quit from Emacs while you have unprinted PostScript
-;; waiting in the spool buffer.  If you do attempt to exit with
-;; spooled PostScript, you'll be asked if you want to print it, and if
-;; you decline, you'll be asked to confirm the exit; this is modeled
-;; on the confirmation that Emacs uses for modified buffers.
-;;
-;; The word "buffer" or "region" in the command name determines how
-;; much of the buffer is printed:
-;;
-;;        buffer     - Print the entire buffer.
-;;
-;;        region     - Print just the current region.
-;;
-;; The -with-faces suffix on the command name means that the command
-;; will include font, color, and underline information in the
-;; PostScript image, so the printed image can look as pretty as the
-;; buffer.  The ps-print- commands without the -with-faces suffix
-;; don't include font, color, or underline information; images printed
-;; with these commands aren't as pretty, but are faster to generate.
-;;
-;; Two ps-print- command examples:
-;;
-;;        ps-print-buffer             - print the entire buffer,
-;;                                      without font, color, or
-;;                                      underline information, and
-;;                                      send it immediately to the
-;;                                      printer.
-;;
-;;        ps-spool-region-with-faces  - print just the current region;
-;;                                      include font, color, and
-;;                                      underline information, and
-;;                                      spool the image in Emacs to
-;;                                      send to the printer later.
-;;
-;;
-;; Invoking Ps-Print
-;; -----------------
-;;
-;; To print your buffer, type
-;;
-;;        M-x ps-print-buffer
-;;
-;; or substitute one of the other seven ps-print- commands.  The
-;; command will generate the PostScript image and print or spool it as
-;; specified.  By giving the command a prefix argument
-;;
-;;        C-u M-x ps-print-buffer
-;;
-;; it will save the PostScript image to a file instead of sending it
-;; to the printer; you will be prompted for the name of the file to
-;; save the image to.  The prefix argument is ignored by the commands
-;; that spool their images, but you may save the spooled images to a
-;; file by giving a prefix argument to `ps-despool':
-;;
-;;        C-u M-x ps-despool
-;;
-;; When invoked this way, `ps-despool' will prompt you for the name of
-;; the file to save to.
-;;
-;; Any of the `ps-print-' commands can be bound to keys; I recommend
-;; binding `ps-spool-buffer-with-faces', `ps-spool-region-with-faces',
-;; and `ps-despool'.  Here are the bindings I use on my Sun 4 keyboard:
-;;
-;;   (global-set-key 'f22 'ps-spool-buffer-with-faces) ;f22 is prsc
-;;   (global-set-key '(shift f22) 'ps-spool-region-with-faces)
-;;   (global-set-key '(control f22) 'ps-despool)
-;;
-;;
-;; The Printer Interface
-;; ---------------------
-;;
-;; The variables `ps-lpr-command' and `ps-lpr-switches' determine what
-;; command is used to send the PostScript images to the printer, and
-;; what arguments to give the command.  These are analogous to
-;; `lpr-command' and `lpr-switches'.
-;; Make sure that they contain appropriate values for your system;
-;; see the usage notes below and the documentation of these variables.
-;;
-;; NOTE: `ps-lpr-command' and `ps-lpr-switches' take their initial values
-;;       from the variables `lpr-command' and `lpr-switches'.  If you have
-;;       `lpr-command' set to invoke a pretty-printer such as `enscript',
-;;       then ps-print won't work properly.  `ps-lpr-command' must name
-;;       a program that does not format the files it prints.
-;;
-;;
-;; The Page Layout
-;; ---------------
-;;
-;; All dimensions are floats in PostScript points.
-;; 1 inch  ==       2.54  cm    ==     72       points
-;; 1 cm    ==  (/ 1 2.54) inch  ==  (/ 72 2.54) points
-;;
-;; The variable `ps-paper-type' determines the size of paper ps-print
-;; formats for; it should contain one of the symbols:
-;; `a4' `a3' `letter' `legal' `letter-small' `tabloid'
-;; `ledger' `statement' `executive' `a4small' `b4' `b5'
-;;
-;; The variable `ps-landscape-mode' determines the orientation
-;; of the printing on the page:
-;; nil means `portrait' mode, non-nil means `landscape' mode.
-;; There is no oblique mode yet, though this is easy to do in ps.
-
-;; In landscape mode, the text is NOT scaled: you may print 70 lines
-;; in portrait mode and only 50 lignes in landscape mode.
-;; The margins represent margins in the printed paper:
-;; the top margin is the margin between the top of the page
-;; and the printed header, whatever the orientation is.
-;;
-;; The variable `ps-number-of-columns' determines the number of columns
-;; both in landscape and portrait mode.
-;; You can use:
-;; - (the standard) one column portrait mode
-;; - (my favorite) two columns landscape mode (which spares trees)
-;; but also
-;; - one column landscape mode for files with very long lines.
-;; - multi-column portrait or landscape mode
-;;
-;;
-;; Horizontal layout
-;; -----------------
-;;
-;; The horizontal layout is determined by the variables
-;; `ps-left-margin' `ps-inter-column' `ps-right-margin'
-;; as follows:
-;;
-;;  ------------------------------------------
-;;  |    |      |    |      |    |      |    |
-;;  | lm | text | ic | text | ic | text | rm |
-;;  |    |      |    |      |    |      |    |
-;;  ------------------------------------------
-;;
-;; If `ps-number-of-columns' is 1, `ps-inter-column' is not relevant.
-;; Usually, lm = rm > 0 and ic = lm
-;; If (ic < 0), the text of adjacent columns can overlap.
-;;
-;;
-;; Vertical layout
-;; ---------------
-;;
-;; The vertical layout is determined by the variables
-;; `ps-bottom-margin' `ps-top-margin' `ps-header-offset'
-;; as follows:
-;;
-;; |--------|        |--------|
-;; | tm     |        | tm     |
-;; |--------|        |--------|
-;; | header |        |        |
-;; |--------|        |        |
-;; | ho     |        |        |
-;; |--------|   or   | text   |
-;; |        |        |        |
-;; | text   |        |        |
-;; |        |        |        |
-;; |--------|        |--------|
-;; | bm     |        | bm     |
-;; |--------|        |--------|
-;;
-;; If `ps-print-header' is nil, `ps-header-offset' is not relevant.
-;; The margins represent margins in the printed paper:
-;; the top margin is the margin between the top of the page
-;; and the printed header, whatever the orientation is.
-;;
-;;
-;; Headers
-;; -------
-;;
-;; Ps-print can print headers at the top of each column; the default
-;; headers contain the following four items: on the left, the name of
-;; the buffer and, if the buffer is visiting a file, the file's
-;; directory; on the right, the page number and date of printing.
-;; The default headers look something like this:
-;;
-;;     ps-print.el                                         1/21
-;;     /home/jct/emacs-lisp/ps/new                     94/12/31
-;; 
-;; When printing on duplex printers, left and right are reversed so
-;; that the page numbers are toward the outside (cf. `ps-spool-duplex').
-;;
-;; Headers are configurable:
-;; To turn them off completely, set `ps-print-header' to nil.
-;; To turn off the header's gaudy framing box,
-;; set `ps-print-header-frame' to nil.
-;;
-;; The font family and size of text in the header are determined
-;; by the variables `ps-header-font-family', `ps-header-font-size' and 
-;; `ps-header-title-font-size' (see below).
-;;
-;; The variable `ps-header-line-pad' determines the portion of a header
-;; title line height to insert between the header frame and the text
-;; it contains, both in the vertical and horizontal directions:
-;; .5 means half a line.
-
-;; Page numbers are printed in `n/m' format, indicating page n of m pages;
-;; to omit the total page count and just print the page number,
-;; set `ps-show-n-of-n' to nil.
-;;
-;; The amount of information in the header can be changed by changing
-;; the number of lines.  To show less, set `ps-header-lines' to 1, and
-;; the header will show only the buffer name and page number.  To show
-;; more, set `ps-header-lines' to 3, and the header will show the time of
-;; printing below the date.
-;;
-;; To change the content of the headers, change the variables
-;; `ps-left-header' and `ps-right-header'.
-;; These variables are lists, specifying top-to-bottom the text
-;; to display on the left or right side of the header.
-;; Each element of the list should be a string or a symbol.
-;; Strings are inserted directly into the PostScript arrays,
-;; and should contain the PostScript string delimiters '(' and ')'.
-;;
-;; Symbols in the header format lists can either represent functions
-;; or variables.  Functions are called, and should return a string to
-;; show in the header.  Variables should contain strings to display in
-;; the header.  In either case, function or variable, the PostScript
-;; string delimiters are added by ps-print, and should not be part of
-;; the returned value.
-;;
-;; Here's an example: say we want the left header to display the text
-;;
-;;     Moe
-;;     Larry
-;;     Curly
-;;
-;; where we have a function to return "Moe"
-;;
-;;     (defun moe-func ()
-;;       "Moe")
-;;
-;; a variable specifying "Larry"
-;;
-;;     (setq larry-var "Larry")
-;;
-;; and a literal for "Curly".  Here's how `ps-left-header' should be
-;; set:
-;;
-;;     (setq ps-left-header (list 'moe-func 'larry-var "(Curly)"))
-;;
-;; Note that Curly has the PostScript string delimiters inside his
-;; quotes -- those aren't misplaced lisp delimiters!
-;; Without them, PostScript would attempt to call the undefined
-;; function Curly, which would result in a PostScript error.
-;; Since most printers don't report PostScript errors except by
-;; aborting the print job, this kind of error can be hard to track down.
-;; Consider yourself warned!
-;;
-;;
-;; Duplex Printers
-;; ---------------
-;;
-;; If you have a duplex-capable printer (one that prints both sides of
-;; the paper), set `ps-spool-duplex' to t.
-;; Ps-print will insert blank pages to make sure each buffer starts
-;; on the correct side of the paper.
-;; Don't forget to set `ps-lpr-switches' to select duplex printing
-;; for your printer.
-;;
-;; 
-;; Font managing
-;; -------------
-;;
-;; Ps-print now knows rather precisely some fonts:
-;; the variable `ps-font-info-database' contains information
-;; for a list of font families (currently mainly `Courier' `Helvetica'
-;; `Times' `Palatino' `Helvetica-Narrow' `NewCenturySchlbk').
-;; Each font family contains the font names for standard, bold, italic
-;; and bold-italic characters, a reference size (usually 10) and the
-;; corresponding line height, width of a space and average character width.
-;; 
-;; The variable `ps-font-family' determines which font family
-;; is to be used for ordinary text.
-;; If its value does not correspond to a known font family,
-;; an error message is printed into the `*Messages*' buffer,
-;; which lists the currently available font families.
-;;
-;; The variable `ps-font-size' determines the size (in points)
-;; of the font for ordinary text, when generating Postscript.
-;; Its value is a float.
-;;
-;; Similarly, the variable `ps-header-font-family' determines
-;; which font family is to be used for text in the header.
-;; The variable `ps-header-font-size' determines the font size,
-;; in points, for text in the header.
-;; The variable `ps-header-title-font-size' determines the font size,
-;; in points, for the top line of text in the header.
-;;
-;;
-;; Adding a new font family
-;; ------------------------
-;;
-;; To use a new font family, you MUST first teach ps-print
-;; this font, ie add its information to `ps-font-info-database',
-;; otherwise ps-print cannot correctly place line and page breaks.
-;;
-;; For example, assuming `Helvetica' is unkown,
-;; you first need to do the following ONLY ONCE:
-;;
-;; - create a new buffer
-;; - generate the PostScript image to a file (C-u M-x ps-print-buffer)
-;; - open this file and find the line:
-;;	`% 3 cm 20 cm moveto  10 /Courier ReportFontInfo  showpage'
-;; - delete the leading `%' (which is the Postscript comment character)
-;; - replace in this line `Courier' by the new font (say `Helvetica')
-;;   to get the line:
-;;	`3 cm 20 cm moveto  10 /Helvetica ReportFontInfo  showpage'
-;; - send this file to the printer (or to ghostscript).
-;;   You should read the following on the output page:
-;;
-;;     For Helvetica 10 point, the line height is 11.56, the space width is 2.78
-;;     and a crude estimate of average character width is 5.09243
-;;
-;; - Add these values to the `ps-font-info-database':
-;;   (setq ps-font-info-database
-;;	 (append
-;;	  '((Helvetica ; the family name
-;;	    "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
-;;	    10.0 11.56 2.78 5.09243))
-;;	  ps-font-info-database))
-;; - Now you can use this font family with any size:
-;;	(setq ps-font-family 'Helvetica)
-;; - if you want to use this family in another emacs session, you must
-;;   put into your `~/.emacs':
-;;	(require 'ps-print)
-;;	(setq ps-font-info-database (append ...)))
-;;   if you don't want to load ps-print, you have to copy the whole value:
-;;	(setq ps-font-info-database '(<your stuff> <the standard stuff>))
-;;   or, if you can wait until the `ps-print-hook' is implemented, do:
-;;      (add-hook 'ps-print-hook '(setq ps-font-info-database (append ...)))
-;;      This does not work yet, since there is no `ps-print-hook' yet.
-;;
-;; You can create new `mixed' font families like:
-;;	(my-mixed-family
-;;	 "Courier-Bold" "Helvetica"
-;;	 "Zapf-Chancery-MediumItalic" "NewCenturySchlbk-BoldItalic"
-;;	 10.0 10.55 6.0 6.0)
-;; Now you can use your new font family with any size:
-;;	(setq ps-font-family 'my-mixed-family)
-;;
-;; You can get information on all the fonts resident in YOUR printer
-;; by uncommenting the line:
-;;	% 3 cm 20 cm moveto  ReportAllFontInfo           showpage
-;;
-;; The postscript file should be sent to YOUR postscript printer.
-;; If you send it to ghostscript or to another postscript printer,
-;; you may get slightly different results.
-;; Anyway, as ghostscript fonts are autoload, you won't get
-;; much font info.
-;;
-;;
-;; How Ps-Print Deals With Faces
-;; -----------------------------
-;;
-;; The ps-print-*-with-faces commands attempt to determine which faces
-;; should be printed in bold or italic, but their guesses aren't
-;; always right.  For example, you might want to map colors into faces
-;; so that blue faces print in bold, and red faces in italic.
-;;
-;; It is possible to force ps-print to consider specific faces bold or
-;; italic, no matter what font they are displayed in, by setting the
-;; variables `ps-bold-faces' and `ps-italic-faces'.  These variables
-;; contain lists of faces that ps-print should consider bold or
-;; italic; to set them, put code like the following into your .emacs
-;; file:
-;;
-;; 	(setq ps-bold-faces '(my-blue-face))
-;;      (setq ps-italic-faces '(my-red-face))
-;;
-;; Faces like bold-italic that are both bold and italic should go in
-;; *both* lists.
-;;
-;; Ps-print keeps internal lists of which fonts are bold and which are
-;; italic; these lists are built the first time you invoke ps-print.
-;; For the sake of efficiency, the lists are built only once; the same
-;; lists are referred in later invocations of ps-print.
-;;
-;; Because these lists are built only once, it's possible for them to
-;; get out of sync, if a face changes, or if new faces are added.  To
-;; get the lists back in sync, you can set the variable
-;; `ps-build-face-reference' to t, and the lists will be rebuilt the
-;; next time ps-print is invoked.
-;;
-;;
-;; How Ps-Print Deals With Color
-;; -----------------------------
-;;
-;; Ps-print detects faces with foreground and background colors
-;; defined and embeds color information in the PostScript image.
-;; The default foreground and background colors are defined by the
-;; variables `ps-default-fg' and `ps-default-bg'.
-;; On black-and-white printers, colors are displayed in grayscale.
-;; To turn off color output, set `ps-print-color-p' to nil.
-;;
-;;
-;; Utilities
-;; ---------
-;;
-;; Some tools are provided to help you customize your font setup.
-;;
-;; `ps-setup' returns (some part of) the current setup.
-;;
-;; To avoid wrapping too many lines, you may want to adjust the
-;; left and right margins and the font size.  On UN*X systems, do:
-;; pr -t file | awk '{printf "%3d %s\n", length($0), $0}' | sort -r | head
-;; to determine the longest lines of your file.
-;; Then, the command `ps-line-lengths' will give you the correspondance
-;; between a line length (number of characters) and the maximum font
-;; size which doesn't wrap such a line with the current ps-print setup.
-;;
-;; The commands `ps-nb-pages-buffer' and `ps-nb-pages-region' display
-;; the correspondance between a number of pages and the maximum font
-;; size which allow the number of lines of the current buffer or of
-;; its current region to fit in this number of pages.
-;; Note: line folding is not taken into account in this process
-;; and could change the results.
-;;
-;;
-;; New since version 1.5
-;; ---------------------
-;;
-;; Color output capability.
-;; Automatic detection of font attributes (bold, italic).
-;; Configurable headers with page numbers.
-;; Slightly faster.
-;; Support for different paper sizes.
-;; Better conformance to PostScript Document Structure Conventions.
-;;
-;;
-;; New since version 2.8
-;; ---------------------
-;;
-;; [jack] 960517 Jacques Duthen <duthen@cegelec-red.fr>
-;;
-;; Font familiy and float size for text and header.
-;; Landscape mode.
-;; Multiple columns.
-;; Tools for page setup.
-;;
-;;
-;; Known bugs and limitations of ps-print:
-;; --------------------------------------
-;;
-;; Although color printing will work in XEmacs 19.12, it doesn't work
-;; well; in particular, bold or italic fonts don't print in the right
-;; background color.
-;;
-;; Invisible properties aren't correctly ignored in XEmacs 19.12.
-;;
-;; Automatic font-attribute detection doesn't work well, especially
-;; with hilit19 and older versions of get-create-face.  Users having
-;; problems with auto-font detection should use the lists
-;; `ps-italic-faces' and `ps-bold-faces' and/or turn off automatic
-;; detection by setting `ps-auto-font-detect' to nil.
-;;
-;; Automatic font-attribute detection doesn't work with XEmacs 19.12
-;; in tty mode; use the lists `ps-italic-faces' and `ps-bold-faces'
-;; instead.
-;;
-;; Still too slow; could use some hand-optimization.
-;;
-;; ASCII Control characters other than tab, linefeed and pagefeed are
-;; not handled.
-;;
-;; Default background color isn't working.
-;;
-;; Faces are always treated as opaque.
-;;
-;; Epoch and Emacs 18 not supported.  At all.
-;;
-;; Fixed-pitch fonts work better for line folding, but are not required.  
-;;
-;; `ps-nb-pages-buffer' and `ps-nb-pages-region' don't take care
-;; of folding lines.
-;;
-;;
-;; Things to change:
-;; ----------------
-;;
-;; Add `ps-print-hook' (I don't know how to do that (yet!)).
-;; Add 4-up capability (really needed?).
-;; Add line numbers (should not be too hard).
-;; Add `ps-non-bold-faces' and `ps-non-italic-faces' (should be easy).
-;; Put one header per page over the columns (easy but needed?).
-;; Improve the memory management for big files (hard?).
-;; `ps-nb-pages-buffer' and `ps-nb-pages-region' should take care
-;; of folding lines.
-;;
-;;
-;; Acknowledgements
-;; ----------------
-;; Thanks to Jim Thompson <?@?> for the 2.8 version I started from.
-;; [jack]
-;;
-;; Thanks to Kevin Rodgers <kevinr@ihs.com> for adding support for
-;; color and the invisible property.
-;;
-;; Thanks to Avishai Yacobi, avishaiy@mcil.comm.mot.com, for writing
-;; the initial port to Emacs 19.  His code is no longer part of
-;; ps-print, but his work is still appreciated.
-;;
-;; Thanks to Remi Houdaille and Michel Train, michel@metasoft.fdn.org,
-;; for adding underline support.  Their code also is no longer part of
-;; ps-print, but their efforts are not forgotten.
-;;
-;; Thanks also to all of you who mailed code to add features to
-;; ps-print; although I didn't use your code, I still appreciate your
-;; sharing it with me.
-;;
-;; Thanks to all who mailed comments, encouragement, and criticism.
-;; Thanks also to all who responded to my survey; I had too many
-;; responses to reply to them all, but I greatly appreciate your
-;; interest.
-;;
-;; Jim
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Code:
-
-(defconst ps-print-version "3.01"
-  "ps-print.el,v 3.01 1996/06/13 18:12 jack
-
-Jack's last change version -- this file may have been edited as part of
-Emacs without changes to the version number.  When reporting bugs,
-please also report the version of Emacs, if any, that ps-print was
-distributed with.
-
-Please send all bug fixes and enhancements to
-	Jacques Duthen <duthen@cegelec-red.fr>.
-")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User Variables:
-
-;;; Interface to the command system
-
-(defvar ps-lpr-command lpr-command
-  "*The shell command for printing a PostScript file.")
-
-(defvar ps-lpr-switches lpr-switches
-  "*A list of extra switches to pass to `ps-lpr-command'.")
-
-;;; Page layout
-
-;; All page dimensions are in PostScript points.
-;; 1 inch  ==       2.54  cm    ==     72       points
-;; 1 cm    ==  (/ 1 2.54) inch  ==  (/ 72 2.54) points
-
-;; Letter      8.5   inch x 11.0   inch
-;; Legal       8.5   inch x 14.0   inch
-;; A4          8.26  inch x 11.69  inch = 21.0 cm x 29.7 cm
-
-;; LetterSmall 7.68  inch x 10.16  inch
-;; Tabloid    11.0   inch x 17.0   inch
-;; Ledger     17.0   inch x 11.0   inch
-;; Statement   5.5   inch x  8.5   inch
-;; Executive   7.5   inch x 10.0   inch
-;; A3         11.69  inch x 16.5   inch = 29.7 cm x 42.0 cm
-;; A4Small     7.47  inch x 10.85  inch
-;; B4         10.125 inch x 14.33  inch
-;; B5          7.16  inch x 10.125 inch
-
-(defvar ps-page-dimensions-database
-  (list (list 'a4    (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54))
-	(list 'a3    (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54))
-	(list 'letter       (* 72  8.5)   (* 72 11.0))
-	(list 'legal        (* 72  8.5)   (* 72 14.0))
-	(list 'letter-small (* 72  7.68)  (* 72 10.16))
-	(list 'tabloid      (* 72 11.0)   (* 72 17.0))
-	(list 'ledger       (* 72 17.0)   (* 72 11.0))
-	(list 'statement    (* 72  5.5)   (* 72  8.5))
-	(list 'executive    (* 72  7.5)   (* 72 10.0))
-	(list 'a4small      (* 72  7.47)  (* 72 10.85))
-	(list 'b4           (* 72 10.125) (* 72 14.33))
-	(list 'b5           (* 72  7.16)  (* 72 10.125)))
-  "*List associating a symbolic paper type to its width and height.
-see `ps-paper-type'.")
-
-(defvar ps-paper-type 'letter
-  "*Specifies the size of paper to format for.
-Should be one of the paper types defined in `ps-page-dimensions-database':
-`letter', `legal', `a4'...")
-
-(defvar ps-landscape-mode 'nil
-  "*Non-nil means print in landscape mode.")
-
-(defvar ps-number-of-columns 1
-  "*Specifies the number of columns")
-
-;;; Horizontal layout
-
-;;  ------------------------------------------
-;;  |    |      |    |      |    |      |    |
-;;  | lm | text | ic | text | ic | text | rm |
-;;  |    |      |    |      |    |      |    |
-;;  ------------------------------------------
-
-(defvar ps-left-margin   (/ (* 72  2.0) 2.54) ;   2 cm
-  "*Left margin in points (1/72 inch).")
-
-(defvar ps-right-margin  (/ (* 72  2.0) 2.54) ;   2 cm
-  "*Right margin in points (1/72 inch).")
-
-(defvar ps-inter-column  (/ (* 72  2.0) 2.54) ;   2 cm
-  "*Horizontal space between columns in points (1/72 inch).")
-
-;;; Vertical layout
-
-;; |--------|
-;; | tm     |
-;; |--------|
-;; | header |
-;; |--------|
-;; | ho     |
-;; |--------|
-;; | text   |
-;; |--------|
-;; | bm     |
-;; |--------|
-
-(defvar ps-bottom-margin (/ (* 72  1.5) 2.54) ; 1.5 cm
-  "*Bottom margin in points (1/72 inch).")
-
-(defvar ps-top-margin    (/ (* 72  1.5) 2.54) ; 1.5 cm
-  "*Top margin in points (1/72 inch).")
-
-(defvar ps-header-offset (/ (* 72  1.0) 2.54) ; 1.0 cm
-  "*Vertical space in points (1/72 inch) between the main text and the header.")
-
-(defvar ps-header-line-pad 0.15
-  "*Portion of a header title line height to insert between the header frame
-and the text it contains, both in the vertical and horizontal directions.")
-
-;;; Header setup
-
-(defvar ps-print-header t
-  "*Non-nil means print a header at the top of each page.
-By default, the header displays the buffer name, page number, and, if
-the buffer is visiting a file, the file's directory.  Headers are
-customizable by changing variables `ps-header-left' and
-`ps-header-right'.")
-
-(defvar ps-print-header-frame t
-  "*Non-nil means draw a gaudy frame around the header.")
-
-(defvar ps-header-lines 2
-  "*Number of lines to display in page header, when generating Postscript.")
-(make-variable-buffer-local 'ps-header-lines)
-
-(defvar ps-show-n-of-n t
-  "*Non-nil means show page numbers as N/M, meaning page N of M.
-Note: page numbers are displayed as part of headers, see variable
-`ps-print-headers'.")
-
-(defvar ps-spool-duplex nil		; Not many people have duplex
-					; printers, so default to nil.
-  "*Non-nil indicates spooling is for a two-sided printer.
-For a duplex printer, the `ps-spool-*' commands will insert blank pages
-as needed between print jobs so that the next buffer printed will
-start on the right page.  Also, if headers are turned on, the headers
-will be reversed on duplex printers so that the page numbers fall to
-the left on even-numbered pages.")
-
-;;; Fonts
-
-(defvar ps-font-info-database
-  '((Courier				; the family key
-     "Courier" "Courier-Bold" "Courier-Oblique" "Courier-BoldOblique"
-     10.0 10.55 6.0     6.0)
-    (Helvetica				; the family key
-     "Helvetica" "Helvetica-Bold" "Helvetica-Oblique" "Helvetica-BoldOblique"
-     10.0 11.56 2.78    5.09243)
-    (Times
-     "Times-Roman" "Times-Bold" "Times-Italic" "Times-BoldItalic"
-     10.0 11.0  2.5     4.71432)
-    (Palatino
-     "Palatino-Roman" "Palatino-Bold" "Palatino-Italic" "Palatino-BoldItalic"
-     10.0 12.1  2.5     5.08676)
-    (Helvetica-Narrow
-     "Helvetica-Narrow" "Helvetica-Narrow-Bold"
-     "Helvetica-Narrow-Oblique" "Helvetica-Narrow-BoldOblique"
-     10.0 11.56 2.2796  4.17579)
-    (NewCenturySchlbk
-     "NewCenturySchlbk-Roman" "NewCenturySchlbk-Bold"
-     "NewCenturySchlbk-Italic" "NewCenturySchlbk-BoldItalic"
-     10.0 12.15 2.78    5.31162)
-    ;; got no bold for the next ones
-    (AvantGarde-Book
-     "AvantGarde-Book" "AvantGarde-Book"
-     "AvantGarde-BookOblique" "AvantGarde-BookOblique"
-     10.0 11.77 2.77    5.45189)
-    (AvantGarde-Demi
-     "AvantGarde-Demi" "AvantGarde-Demi"
-     "AvantGarde-DemiOblique" "AvantGarde-DemiOblique"
-     10.0 12.72 2.8     5.51351)
-    (Bookman-Demi
-     "Bookman-Demi" "Bookman-Demi"
-     "Bookman-DemiItalic" "Bookman-DemiItalic"
-     10.0 11.77 3.4     6.05946)
-    (Bookman-Light
-     "Bookman-Light" "Bookman-Light"
-     "Bookman-LightItalic" "Bookman-LightItalic"
-     10.0 11.79 3.2     5.67027)
-    ;; got no bold and no italic for the next ones
-    (Symbol
-     "Symbol" "Symbol" "Symbol" "Symbol"
-     10.0 13.03 2.5     3.24324)
-    (Zapf-Dingbats
-     "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats" "Zapf-Dingbats"
-     10.0  9.63 2.78    2.78)
-    (Zapf-Chancery-MediumItalic
-     "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
-     "Zapf-Chancery-MediumItalic" "Zapf-Chancery-MediumItalic"
-     10.0 11.45 2.2     4.10811)
-)
-  "*Font info database: font family (the key), name, bold, italic, bold-italic,
-reference size, line height, space width, average character width.
-To get the info for another specific font (say Helvetica), do the following:
-- create a new buffer
-- generate the PostScript image to a file (C-u M-x ps-print-buffer)
-- open this file and delete the leading `%' (which is the Postscript
-  comment character) from the line
-	`% 3 cm 20 cm moveto  10 /Courier ReportFontInfo  showpage'
-  to get the line
-	`3 cm 20 cm moveto  10 /Helvetica ReportFontInfo  showpage'
-- add the values to `ps-font-info-database'.
-You can get all the fonts of YOUR printer using `ReportAllFontInfo'.")
-
-(defvar ps-font-family 'Courier
-  "Font family name for ordinary text, when generating Postscript.")
-
-(defvar ps-font-size   8.5
-  "Font size, in points, for ordinary text, when generating Postscript.")
-
-(defvar ps-header-font-family      'Helvetica
-  "Font family name for text in the header, when generating Postscript.")
-
-(defvar ps-header-font-size        12
-  "Font size, in points, for text in the header, when generating Postscript.")
-
-(defvar ps-header-title-font-size  14
-  "Font size, in points, for the top line of text in the header,
-when generating Postscript.")
-
-;;; Colors
-
-(defvar ps-print-color-p (or (fboundp 'x-color-values)    ; Emacs
-			     (fboundp 'pixel-components)) ; XEmacs
-; Printing color requires x-color-values.
-  "*If non-nil, print the buffer's text in color.")
-
-(defvar ps-default-fg '(0.0 0.0 0.0)
-  "*RGB values of the default foreground color.  Defaults to black.")
-
-(defvar ps-default-bg '(1.0 1.0 1.0)
-  "*RGB values of the default background color.  Defaults to white.")
-
-(defvar ps-auto-font-detect t
-  "*Non-nil means automatically detect bold/italic face attributes.
-nil means rely solely on the lists `ps-bold-faces', `ps-italic-faces',
-and `ps-underlined-faces'.")
-
-(defvar ps-bold-faces '()
-  "*A list of the \(non-bold\) faces that should be printed in bold font.
-This applies to generating Postscript.")
-
-(defvar ps-italic-faces '()
-  "*A list of the \(non-italic\) faces that should be printed in italic font.
-This applies to generating Postscript.")
-
-(defvar ps-underlined-faces '()
-  "*A list of the \(non-underlined\) faces that should be printed underlined.
-This applies to generating Postscript.")
-
-(defvar ps-left-header
-  (list 'ps-get-buffer-name 'ps-header-dirpart)
-  "*The items to display (each on a line) on the left part of the page header.
-This applies to generating Postscript.
-
-The value should be a list of strings and symbols, each representing an
-entry in the PostScript array HeaderLinesLeft.
-
-Strings are inserted unchanged into the array; those representing
-PostScript string literals should be delimited with PostScript string
-delimiters '(' and ')'.
-
-For symbols with bound functions, the function is called and should
-return a string to be inserted into the array.  For symbols with bound
-values, the value should be a string to be inserted into the array.
-In either case, function or variable, the string value has PostScript
-string delimiters added to it.")
-(make-variable-buffer-local 'ps-left-header)
-
-(defvar ps-right-header
-  (list "/pagenumberstring load" 'time-stamp-yy/mm/dd 'time-stamp-hh:mm:ss)
-  "*The items to display (each on a line) on the right part of the page header.
-This applies to generating Postscript.
-
-See the variable `ps-left-header' for a description of the format of
-this variable.")
-(make-variable-buffer-local 'ps-right-header)
-
-(defvar ps-razzle-dazzle t
-  "*Non-nil means report progress while formatting buffer.")
-
-(defvar ps-adobe-tag "%!PS-Adobe-1.0\n"
-  "*Contains the header line identifying the output as PostScript.
-By default, `ps-adobe-tag' contains the standard identifier.  Some
-printers require slightly different versions of this line.")
-
-(defvar ps-build-face-reference t
-  "*Non-nil means build the reference face lists.
-
-Ps-print sets this value to nil after it builds its internal reference
-lists of bold and italic faces.  By settings its value back to t, you
-can force ps-print to rebuild the lists the next time you invoke one
-of the ...-with-faces commands.
-
-You should set this value back to t after you change the attributes of
-any face, or create new faces.  Most users shouldn't have to worry
-about its setting, though.")
-
-(defvar ps-always-build-face-reference nil
-  "*Non-nil means always rebuild the reference face lists.
-
-If this variable is non-nil, ps-print will rebuild its internal
-reference lists of bold and italic faces *every* time one of the
--with-faces commands is called.  Most users shouldn't need to set this
-variable.")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; User commands
-
-;;;###autoload
-(defun ps-print-buffer (&optional filename)
-  "Generate and print a PostScript image of the buffer.
-
-When called with a numeric prefix argument (C-u), prompts the user for
-the name of a file to save the PostScript image in, instead of sending
-it to the printer.
-
-More specifically, the FILENAME argument is treated as follows: if it
-is nil, send the image to the printer.  If FILENAME is a string, save
-the PostScript image in a file with that name.  If FILENAME is a
-number, prompt the user for the name of the file to save in."
-
-  (interactive (list (ps-print-preprint current-prefix-arg)))
-  (ps-generate (current-buffer) (point-min) (point-max)
-	       'ps-generate-postscript)
-  (ps-do-despool filename))
-
-
-;;;###autoload
-(defun ps-print-buffer-with-faces (&optional filename)
-  "Generate and print a PostScript image of the buffer.
-Like `ps-print-buffer', but includes font, color, and underline
-information in the generated image.  This command works only if you
-are using a window system, so it has a way to determine color values."
-  (interactive (list (ps-print-preprint current-prefix-arg)))
-  (ps-generate (current-buffer) (point-min) (point-max)
-	       'ps-generate-postscript-with-faces)
-  (ps-do-despool filename))
-
-
-;;;###autoload
-(defun ps-print-region (from to &optional filename)
-  "Generate and print a PostScript image of the region.
-Like `ps-print-buffer', but prints just the current region."
-
-  (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
-  (ps-generate (current-buffer) from to
-	       'ps-generate-postscript)
-  (ps-do-despool filename))
-
-
-;;;###autoload
-(defun ps-print-region-with-faces (from to &optional filename)
-  "Generate and print a PostScript image of the region.
-Like `ps-print-region', but includes font, color, and underline
-information in the generated image.  This command works only if you
-are using a window system, so it has a way to determine color values."
-
-  (interactive (list (point) (mark) (ps-print-preprint current-prefix-arg)))
-  (ps-generate (current-buffer) from to
-	       'ps-generate-postscript-with-faces)
-  (ps-do-despool filename))
-
-
-;;;###autoload
-(defun ps-spool-buffer ()
-  "Generate and spool a PostScript image of the buffer.
-Like `ps-print-buffer' except that the PostScript image is saved in a
-local buffer to be sent to the printer later.
-
-Use the command `ps-despool' to send the spooled images to the printer."
-  (interactive)
-  (ps-generate (current-buffer) (point-min) (point-max)
-	       'ps-generate-postscript))
-
-
-;;;###autoload
-(defun ps-spool-buffer-with-faces ()
-  "Generate and spool a PostScript image of the buffer.
-Like `ps-spool-buffer', but includes font, color, and underline
-information in the generated image.  This command works only if you
-are using a window system, so it has a way to determine color values.
-
-Use the command `ps-despool' to send the spooled images to the printer."
-
-  (interactive)
-  (ps-generate (current-buffer) (point-min) (point-max)
-	       'ps-generate-postscript-with-faces))
-
-
-;;;###autoload
-(defun ps-spool-region (from to)
-  "Generate a PostScript image of the region and spool locally.
-Like `ps-spool-buffer', but spools just the current region.
-
-Use the command `ps-despool' to send the spooled images to the printer."
-  (interactive "r")
-  (ps-generate (current-buffer) from to
-	       'ps-generate-postscript))
-
-
-;;;###autoload
-(defun ps-spool-region-with-faces (from to)
-  "Generate a PostScript image of the region and spool locally.
-Like `ps-spool-region', but includes font, color, and underline
-information in the generated image.  This command works only if you
-are using a window system, so it has a way to determine color values.
-
-Use the command `ps-despool' to send the spooled images to the printer."
-  (interactive "r")
-  (ps-generate (current-buffer) from to
-	       'ps-generate-postscript-with-faces))
-
-;;;###autoload
-(defun ps-despool (&optional filename)
-  "Send the spooled PostScript to the printer.
-
-When called with a numeric prefix argument (C-u), prompt the user for
-the name of a file to save the spooled PostScript in, instead of sending
-it to the printer.
-
-More specifically, the FILENAME argument is treated as follows: if it
-is nil, send the image to the printer.  If FILENAME is a string, save
-the PostScript image in a file with that name.  If FILENAME is a
-number, prompt the user for the name of the file to save in."
-  (interactive (list (ps-print-preprint current-prefix-arg)))
-  (ps-do-despool filename))
-
-;;;###autoload
-(defun ps-line-lengths ()
-  "*Display the correspondance between a line length and a font size,
-using the current ps-print setup.
-Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
-  (interactive)
-  (ps-line-lengths-internal))
-
-;;;###autoload
-(defun ps-nb-pages-buffer (nb-lines)
-  "*Display an approximate correspondance between a font size and the number
-of pages the current buffer would require to print
-using the current ps-print setup."
-  (interactive (list (count-lines (point-min) (point-max))))
-  (ps-nb-pages nb-lines))
-
-;;;###autoload
-(defun ps-nb-pages-region (nb-lines)
-  "*Display an approximate correspondance between a font size and the number
-of pages the current region would require to print
-using the current ps-print setup."
-  (interactive (list (count-lines (mark) (point))))
-  (ps-nb-pages nb-lines))
-
-;;;###autoload
-(defun ps-setup ()
-  "*Return the current setup"
-  (format "
- (setq ps-print-color-p  %s
-      ps-lpr-command    \"%s\"
-      ps-lpr-switches   %s
-
-      ps-paper-type       '%s
-      ps-landscape-mode   %s
-      ps-number-of-columns %s
-
-      ps-left-margin   %s
-      ps-right-margin  %s
-      ps-inter-column  %s
-      ps-bottom-margin %s
-      ps-top-margin    %s
-      ps-header-offset %s
-      ps-header-line-pad    %s
-      ps-print-header       %s
-      ps-print-header-frame %s
-      ps-header-lines       %s
-      ps-show-n-of-n        %s
-      ps-spool-duplex       %s
-
-      ps-font-family             '%s
-      ps-font-size               %s
-      ps-header-font-family      '%s
-      ps-header-font-size        %s
-      ps-header-title-font-size  %s)
-"
-  ps-print-color-p
-  ps-lpr-command
-  ps-lpr-switches
-  ps-paper-type
-  ps-landscape-mode
-  ps-number-of-columns
-  ps-left-margin
-  ps-right-margin
-  ps-inter-column
-  ps-bottom-margin
-  ps-top-margin
-  ps-header-offset
-  ps-header-line-pad
-  ps-print-header
-  ps-print-header-frame
-  ps-header-lines
-  ps-show-n-of-n
-  ps-spool-duplex
-  ps-font-family
-  ps-font-size
-  ps-header-font-family
-  ps-header-font-size
-  ps-header-title-font-size))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Utility functions and variables:
-
-(defvar ps-print-emacs-type
-  (cond ((string-match "XEmacs" emacs-version) 'xemacs)
-	((string-match "Lucid" emacs-version) 'lucid)
-	((string-match "Epoch" emacs-version) 'epoch)
-	(t 'emacs)))
-
-(if (or (eq ps-print-emacs-type 'lucid)
-	(eq ps-print-emacs-type 'xemacs))
-    (if (< emacs-minor-version 12)
-	(setq ps-print-color-p nil))
-  (require 'faces))			; face-font, face-underline-p,
-					; x-font-regexp
-
-(require 'time-stamp)
-
-(defvar ps-font nil
-  "Font family name for ordinary text, when generating Postscript.")
-
-(defvar ps-font-bold nil
-  "Font family name for bold text, when generating Postscript.")
-
-(defvar ps-font-italic nil
-  "Font family name for italic text, when generating Postscript.")
-
-(defvar ps-font-bold-italic nil
-  "Font family name for bold italic text, when generating Postscript.")
-
-(defvar ps-avg-char-width nil
-  "The average width, in points, of a character, for generating Postscript.
-This is the value that ps-print uses to determine the length,
-x-dimension, of the text it has printed, and thus affects the point at
-which long lines wrap around.")
-
-(defvar ps-space-width nil
-  "The width of a space character, for generating Postscript.
-This value is used in expanding tab characters.")
-
-(defvar ps-line-height nil
-  "The height of a line, for generating Postscript.
-This is the value that ps-print uses to determine the height,
-y-dimension, of the lines of text it has printed, and thus affects the
-point at which page-breaks are placed.
-The line-height is *not* the same as the point size of the font.")
-
-(defvar ps-print-prologue-1
-  "% ISOLatin1Encoding stolen from ps_init.ps in GhostScript 2.6.1.4:
-/ISOLatin1Encoding where { pop } {
-% -- The ISO Latin-1 encoding vector isn't known, so define it.
-% -- The first half is the same as the standard encoding,
-% -- except for minus instead of hyphen at code 055.
-/ISOLatin1Encoding
-StandardEncoding 0 45 getinterval aload pop
-    /minus
-StandardEncoding 46 82 getinterval aload pop
-%*** NOTE: the following are missing in the Adobe documentation,
-%*** but appear in the displayed table:
-%*** macron at 0225, dieresis at 0230, cedilla at 0233, space at 0240.
-% 0200 (128)
-    /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
-    /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef /.notdef
-    /dotlessi /grave /acute /circumflex /tilde /macron /breve /dotaccent
-    /dieresis /.notdef /ring /cedilla /.notdef /hungarumlaut /ogonek /caron
-% 0240 (160)
-    /space /exclamdown /cent /sterling
-	/currency /yen /brokenbar /section
-    /dieresis /copyright /ordfeminine /guillemotleft
-	/logicalnot /hyphen /registered /macron
-    /degree /plusminus /twosuperior /threesuperior
-	/acute /mu /paragraph /periodcentered
-    /cedilla /onesuperior /ordmasculine /guillemotright
-	/onequarter /onehalf /threequarters /questiondown
-% 0300 (192)
-    /Agrave /Aacute /Acircumflex /Atilde
-	/Adieresis /Aring /AE /Ccedilla
-    /Egrave /Eacute /Ecircumflex /Edieresis
-	/Igrave /Iacute /Icircumflex /Idieresis
-    /Eth /Ntilde /Ograve /Oacute
-	/Ocircumflex /Otilde /Odieresis /multiply
-    /Oslash /Ugrave /Uacute /Ucircumflex
-	/Udieresis /Yacute /Thorn /germandbls
-% 0340 (224)
-    /agrave /aacute /acircumflex /atilde
-	/adieresis /aring /ae /ccedilla
-    /egrave /eacute /ecircumflex /edieresis
-	/igrave /iacute /icircumflex /idieresis
-    /eth /ntilde /ograve /oacute
-	/ocircumflex /otilde /odieresis /divide
-    /oslash /ugrave /uacute /ucircumflex
-	/udieresis /yacute /thorn /ydieresis
-256 packedarray def
-} ifelse
-
-/reencodeFontISO { %def
-  dup
-  length 5 add dict	% Make a new font (a new dict the same size
-			% as the old one) with room for our new symbols.
-
-  begin			% Make the new font the current dictionary.
-
-
-    { 1 index /FID ne
-      { def } { pop pop } ifelse
-    } forall		% Copy each of the symbols from the old dictionary
-			% to the new one except for the font ID.
-
-    /Encoding ISOLatin1Encoding def	% Override the encoding with
-					% the ISOLatin1 encoding.
-
-    % Use the font's bounding box to determine the ascent, descent,
-    % and overall height; don't forget that these values have to be
-    % transformed using the font's matrix.
-
-%          ^    (x2 y2)
-%          |       |
-%          |       v
-%          |  +----+ - -
-%          |  |    |   ^
-%          |  |    |   | Ascent (usually > 0)
-%          |  |    |   |
-% (0 0) -> +--+----+-------->
-%             |    |   |
-%             |    |   v Descent (usually < 0)
-% (x1 y1) --> +----+ - -
-
-    FontBBox				% -- x1 y1 x2 y2
-    FontMatrix transform /Ascent  exch def pop
-    FontMatrix transform /Descent exch def pop
-    /FontHeight Ascent Descent sub def	% use `sub' because descent < 0
-
-    % Define these in case they're not in the FontInfo
-    % (also, here they're easier to get to.
-    /UnderlinePosition  1 def
-    /UnderlineThickness 1 def
-
-    % Get the underline position and thickness if they're defined.
-    currentdict /FontInfo known {
-      FontInfo
-
-      dup /UnderlinePosition known {
-	dup /UnderlinePosition get
-	0 exch FontMatrix transform exch pop
-	/UnderlinePosition exch def
-      } if
-
-      dup /UnderlineThickness known {
-	/UnderlineThickness get
-	0 exch FontMatrix transform exch pop
-	/UnderlineThickness exch def
-      } if
-
-    } if
-
-    currentdict		% Leave the new font on the stack
-    end			% Stop using the font as the current dictionary.
-    definefont		% Put the font into the font dictionary
-    pop			% Discard the returned font.
-} bind def
-
-/DefFont {				% Font definition
-  findfont exch scalefont reencodeFontISO
-} def
-
-/F {					% Font selection
-  findfont
-  dup /Ascent             get /Ascent             exch def
-  dup /Descent            get /Descent            exch def
-  dup /FontHeight         get /FontHeight         exch def
-  dup /UnderlinePosition  get /UnderlinePosition  exch def
-  dup /UnderlineThickness get /UnderlineThickness exch def
-  setfont
-} def
-
-/FG /setrgbcolor load def
-
-/bg false def
-/BG {
-  dup /bg exch def
-  { mark 4 1 roll ] /bgcolor exch def } if
-} def
-
-%  B    width    C
-%   +-----------+
-%               | Ascent  (usually > 0)
-% A +           +
-%               | Descent (usually < 0)
-%   +-----------+
-%  E    width    D
-
-/dobackground {				% width --
-  currentpoint				% -- width x y
-  gsave
-    newpath
-    moveto				% A (x y)
-    0 Ascent rmoveto			% B
-    dup 0 rlineto			% C
-    0 Descent Ascent sub rlineto	% D
-    neg 0 rlineto			% E
-    closepath
-    bgcolor aload pop setrgbcolor
-    fill
-  grestore
-} def
-
-/dobackgroundstring {			% string --
-  stringwidth pop
-  dobackground
-} def
-
-/dounderline {				% fromx fromy --
-  currentpoint
-  gsave
-    UnderlineThickness setlinewidth
-    4 2 roll
-    UnderlinePosition add moveto
-    UnderlinePosition add lineto
-    stroke
-  grestore
-} def
-
-/eolbg {				% dobackground until right margin
-  PrintWidth				% -- x-eol
-  currentpoint pop			% -- cur-x
-  sub					% -- width until eol
-  dobackground
-} def
-
-/eolul {				% idem for underline
-  PrintWidth				% -- x-eol
-  currentpoint exch pop			% -- x-eol cur-y
-  dounderline
-} def
-
-/SL {					% Soft Linefeed
-  bg { eolbg } if
-  ul { eolul } if
-  0  currentpoint exch pop LineHeight sub  moveto
-} def
-
-/HL /SL load def			% Hard Linefeed
-
-/sp1 { currentpoint 3 -1 roll } def
-
-% Some debug
-/dcp { currentpoint exch 40 string cvs print (, ) print = } def
-/dp { print 2 copy
-   exch 40 string cvs print (, ) print = } def
-
-/S {
-  bg { dup dobackgroundstring } if
-  ul { sp1 } if
-  show
-  ul { dounderline } if
-} def
-
-/W {
-  ul { sp1 } if
-  ( ) stringwidth	% Get the width of a space in the current font.
-  pop			% Discard the Y component.
-  mul			% Multiply the width of a space
-			% by the number of spaces to plot
-  bg { dup dobackground } if
-  0 rmoveto
-  ul { dounderline } if
-} def
-
-/BeginDoc {
-  % ---- save the state of the document (useful for ghostscript!)
-  /docState save def
-  % ---- [jack] Kludge: my ghostscript window is 21x27.7 instead of 21x29.7
-  /JackGhostscript where {
-    pop 1 27.7 29.7 div scale
-  } if
-  LandscapeMode {
-    % ---- translate to bottom-right corner of Portrait page
-    LandscapePageHeight 0 translate
-    90 rotate
-    } if
-  /ColumnWidth PrintWidth InterColumn add def
-  % ---- translate to lower left corner of TEXT
-  LeftMargin BottomMargin translate
-  % ---- define where  printing will start
-  /f0 F					% this installs Ascent
-  /PrintStartY PrintHeight Ascent sub def
-  /ColumnIndex 1 def
-} def
-
-/EndDoc {
-  % ---- on last page but not last column, spit out the page
-  ColumnIndex 1 eq not { showpage } if
-  % ---- restore the state of the document (useful for ghostscript!)
-  docState restore
-} def
-
-/BeginDSCPage {
-  % ---- when 1st column, save the state of the page
-  ColumnIndex 1 eq { /pageState save def } if
-  % ---- save the state of the column
-  /columnState save def
-} def
-
-/BeginPage {
-  PrintHeader {
-    PrintHeaderFrame { HeaderFrame } if
-    HeaderText
-  } if
-  0 PrintStartY moveto			% move to where printing will start
-} def
-
-/EndPage {
-  bg { eolbg } if
-  ul { eolul } if
-} def
-
-/EndDSCPage {
-  ColumnIndex NumberOfColumns eq {
-    % ---- on last column, spit out the page
-    showpage
-    % ---- restore the state of the page
-    pageState restore
-    /ColumnIndex 1 def
-  } { % else
-    % ---- restore the state of the current column
-    columnState restore
-    % ---- and translate to the next column
-    ColumnWidth 0 translate
-    /ColumnIndex ColumnIndex 1 add def
-  } ifelse
-} def
-
-/ul false def
-
-/UL { /ul exch def } def
-
-/SetHeaderLines {			% nb-lines --
-  /HeaderLines exch def
-  % ---- bottom up
-  HeaderPad
-  HeaderLines 1 sub HeaderLineHeight mul add
-  HeaderTitleLineHeight add
-  HeaderPad add
-  /HeaderHeight exch def
-} def
-
-% |---------|
-% |  tm     |
-% |---------|
-% |  header |
-% |-+-------| <-- (x y)
-% |  ho     |
-% |---------|
-% |  text   |
-% |-+-------| <-- (0 0)
-% |  bm     |
-% |---------|
-
-/HeaderFrameStart {			% -- x y
-  0  PrintHeight HeaderOffset add
-} def
-
-/HeaderFramePath {
-  PrintWidth	 0			rlineto
-  0		 HeaderHeight		rlineto
-  PrintWidth neg 0			rlineto
-  0		 HeaderHeight neg	rlineto
-} def
-
-/HeaderFrame {
-  gsave
-    0.4 setlinewidth
-    % ---- fill a black rectangle (the shadow of the next one)
-    HeaderFrameStart moveto
-    1 -1 rmoveto
-    HeaderFramePath
-    0 setgray fill
-    % ---- do the next rectangle ...
-    HeaderFrameStart moveto
-    HeaderFramePath
-    gsave 0.9 setgray fill grestore	% filled with grey
-    gsave 0 setgray stroke grestore	% drawn  with black
-  grestore
-} def
-
-/HeaderStart {
-  HeaderFrameStart
-  exch HeaderPad add exch	% horizontal pad
-  % ---- bottom up
-  HeaderPad add			% vertical   pad
-  HeaderDescent sub
-  HeaderLineHeight HeaderLines 1 sub mul add
-} def
-
-/strcat {
-  dup length 3 -1 roll dup length dup 4 -1 roll add string dup
-  0 5 -1 roll putinterval
-  dup 4 2 roll exch putinterval
-} def
-
-/pagenumberstring {
-  PageNumber 32 string cvs
-  ShowNofN {
-    (/) strcat
-    PageCount 32 string cvs strcat
-  } if
-} def
-
-/HeaderText {
-  HeaderStart moveto
-
-  HeaderLinesRight HeaderLinesLeft	% -- rightLines leftLines
-
-  % ---- hack: `PN 1 and'  ==  `PN 2 modulo'
-
-  % ---- if duplex and even page number, then exchange left and right
-  Duplex PageNumber 1 and 0 eq and { exch } if
-
-  { % ---- process the left lines
-    aload pop
-    exch F
-    gsave
-      dup xcheck { exec } if
-      show
-    grestore
-    0 HeaderLineHeight neg rmoveto
-  } forall
-
-  HeaderStart moveto
-
-  { % ---- process the right lines
-    aload pop
-    exch F
-    gsave
-      dup xcheck { exec } if
-      dup stringwidth pop
-      PrintWidth exch sub HeaderPad 2 mul sub 0 rmoveto
-      show
-    grestore
-    0 HeaderLineHeight neg rmoveto
-  } forall
-} def
-
-/ReportFontInfo {
-  2 copy
-  /t0 3 1 roll DefFont
-  /t0 F
-  /lh FontHeight def
-  /sw ( ) stringwidth pop def
-  /aw (01234567890abcdefghijklmnopqrstuvwxyz) dup length exch
-  stringwidth pop exch div def
-  /t1 12 /Helvetica-Oblique DefFont
-  /t1 F
-  gsave
-    (For ) show
-    128 string cvs show
-    ( ) show
-    32 string cvs show
-    ( point, the line height is ) show
-    lh 32 string cvs show
-    (, the space width is ) show
-    sw 32 string cvs show
-    (,) show
-  grestore
-  0 FontHeight neg rmoveto
-  gsave
-    (and a crude estimate of average character width is ) show
-    aw 32 string cvs show
-    (.) show
-  grestore
-  0 FontHeight neg rmoveto
-} def
-
-/cm { % cm to point
-  72 mul 2.54 div
-} def
-
-/ReportAllFontInfo {
-  FontDirectory
-  { % key = font name  value = font dictionary
-    pop 10 exch ReportFontInfo
-  } forall
-} def
-
-% 3 cm 20 cm moveto  10 /Courier ReportFontInfo  showpage
-% 3 cm 20 cm moveto  ReportAllFontInfo           showpage
-
-")
-
-(defvar ps-print-prologue-2
-  "
-% ---- These lines must be kept together because...
-
-/h0 F
-/HeaderTitleLineHeight FontHeight def
-
-/h1 F
-/HeaderLineHeight FontHeight def
-/HeaderDescent    Descent def
-
-% ---- ...because `F' has a side-effect on `FontHeight' and `Descent'
-
-")
-
-;; Start Editing Here:
-
-(defvar ps-source-buffer nil)
-(defvar ps-spool-buffer-name "*PostScript*")
-(defvar ps-spool-buffer nil)
-
-(defvar ps-output-head nil)
-(defvar ps-output-tail nil)
-
-(defvar ps-page-count 0)
-(defvar ps-showpage-count 0)
-
-(defvar ps-current-font 0)
-(defvar ps-current-underline-p nil)
-(defvar ps-default-color (if ps-print-color-p ps-default-fg)) ; black
-(defvar ps-current-color ps-default-color)
-(defvar ps-current-bg nil)
-
-(defvar ps-razchunk 0)
-
-(defvar ps-color-format
-  (if (eq ps-print-emacs-type 'emacs)
-
-    ;;Emacs understands the %f format; we'll
-    ;;use it to limit color RGB values to
-    ;;three decimals to cut down some on the
-    ;;size of the PostScript output.
-    "%0.3f %0.3f %0.3f"
-
-    ;; Lucid emacsen will have to make do with
-    ;; %s (princ) for floats.
-    "%s %s %s"))
-
-;; These values determine how much print-height to deduct when headers
-;; are turned on.  This is a pretty clumsy way of handling it, but
-;; it'll do for now.
-
-(defvar ps-header-font)
-(defvar ps-header-title-font)
-
-(defvar ps-header-line-height)
-(defvar ps-header-title-line-height)
-(defvar ps-header-pad 0
-  "Vertical and horizontal space in points (1/72 inch) between the header frame
-and the text it contains.")
-
-;; Define accessors to the dimensions list.
-
-(defmacro ps-page-dimensions-get-width  (dims) `(nth 0 ,dims))
-(defmacro ps-page-dimensions-get-height (dims) `(nth 1 ,dims))
-
-(defvar ps-landscape-page-height)
-
-(defvar ps-print-width nil)
-(defvar ps-print-height nil)
-
-(defvar ps-height-remaining)
-(defvar ps-width-remaining)
-
-(defvar ps-ref-bold-faces nil)
-(defvar ps-ref-italic-faces nil)
-(defvar ps-ref-underlined-faces nil)
-
-(defvar ps-print-color-scale nil)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Internal functions
-
-(defun ps-line-lengths-internal ()
-  "Display the correspondance between a line length and a font size,
-using the current ps-print setup.
-Try: pr -t file | awk '{printf \"%3d %s\n\", length($0), $0}' | sort -r | head"
-  (let ((buf (get-buffer-create "*Line-lengths*"))
-	(ifs ps-font-size)		; initial font size
-	(icw ps-avg-char-width)		; initial character width
-	(print-width (progn (ps-get-page-dimensions)
-			    ps-print-width))
-	(ps-setup (ps-setup))		; setup for the current buffer
-	(fs-min 5)			; minimum font size
-	cw-min				; minimum character width
-	nb-cpl-max			; maximum nb of characters per line
-	(fs-max 14)			; maximum font size
-	cw-max				; maximum character width
-	nb-cpl-min			; minimum nb of characters per line
-	fs				; current font size
-	cw				; current character width
-	nb-cpl				; current nb of characters per line
-	)
-    (setq cw-min     (/ (* icw fs-min) ifs)
-	  nb-cpl-max (floor (/ print-width cw-min))
-	  cw-max     (/ (* icw fs-max) ifs)
-	  nb-cpl-min (floor (/ print-width cw-max)))
-    (setq nb-cpl nb-cpl-min)
-    (set-buffer buf)
-    (goto-char (point-max))
-    (if (not (bolp)) (insert "\n"))
-    (insert ps-setup)
-    (insert "nb char per line / font size\n")
-    (while (<= nb-cpl nb-cpl-max)
-      (setq cw     (/ print-width (float nb-cpl))
-	    fs     (/ (* ifs cw) icw))
-      (insert (format "%3s %s\n" nb-cpl fs))
-      (setq nb-cpl (1+ nb-cpl)))
-    (insert "\n")
-    (display-buffer buf 'not-this-window)))
-
-(defun ps-nb-pages (nb-lines)
-  "Display an approximate correspondance between a font size and the number
-of pages the number of lines would require to print
-using the current ps-print setup."
-  (let ((buf (get-buffer-create "*Nb-Pages*"))
-	(ifs ps-font-size)		; initial font size
-	(ilh ps-line-height)		; initial line height
-	(page-height (progn (ps-get-page-dimensions)
-			    ps-print-height))
-	(ps-setup (ps-setup))		; setup for the current buffer
-	(fs-min 4)			; minimum font size
-	lh-min				; minimum line height
-	nb-lpp-max			; maximum nb of lines per page
-	nb-page-min			; minimum nb of pages
-	(fs-max 14)			; maximum font size
-	lh-max				; maximum line height
-	nb-lpp-min			; minimum nb of lines per page
-	nb-page-max			; maximum nb of pages
-	fs				; current font size
-	lh				; current line height
-	nb-lpp				; current nb of lines per page
-	nb-page				; current nb of pages
-	)
-    (setq lh-min      (/ (* ilh fs-min) ifs)
-	  nb-lpp-max  (floor (/ page-height lh-min))
-	  nb-page-min (ceiling (/ (float nb-lines) nb-lpp-max))
-	  lh-max      (/ (* ilh fs-max) ifs)
-	  nb-lpp-min  (floor (/ page-height lh-max))
-	  nb-page-max (ceiling (/ (float nb-lines) nb-lpp-min)))
-    (setq nb-page nb-page-min)
-    (set-buffer buf)
-    (goto-char (point-max))
-    (if (not (bolp)) (insert "\n"))
-    (insert ps-setup)
-    (insert (format "%d lines\n" nb-lines))
-    (insert "nb page / font size\n")
-    (while (<= nb-page nb-page-max)
-      (setq nb-lpp (ceiling (/ nb-lines (float nb-page)))
-	    lh     (/ page-height nb-lpp)
-	    fs     (/ (* ifs lh) ilh))
-      (insert (format "%s %s\n" nb-page fs))
-      (setq nb-page (1+ nb-page)))
-    (insert "\n")
-    (display-buffer buf 'not-this-window)))
-
-(defun ps-select-font ()
-  "Choose the font name and size (scaling data)."
-  (let ((assoc (assq ps-font-family ps-font-info-database))
-	l fn fb fi bi sz lh sw aw)
-    (if (null assoc)
-	(error "Don't have data to scale font %s. Known fonts families are %s"
-	       ps-font-family
-	       (mapcar 'car ps-font-info-database)))
-    (setq l  (cdr assoc)
-	  fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
-	  fb (prog1 (car l) (setq l (cdr l)))
-	  fi (prog1 (car l) (setq l (cdr l)))
-	  bi (prog1 (car l) (setq l (cdr l)))
-	  sz (prog1 (car l) (setq l (cdr l)))
-	  lh (prog1 (car l) (setq l (cdr l)))
-	  sw (prog1 (car l) (setq l (cdr l)))
-	  aw (prog1 (car l) (setq l (cdr l))))
-
-    (setq ps-font             fn)
-    (setq ps-font-bold        fb)
-    (setq ps-font-italic      fi)
-    (setq ps-font-bold-italic bi)
-    ;; These data just need to be rescaled:
-    (setq ps-line-height    (/ (* lh ps-font-size) sz))
-    (setq ps-space-width    (/ (* sw ps-font-size) sz))
-    (setq ps-avg-char-width (/ (* aw ps-font-size) sz))
-    ps-font-family))
-
-(defun ps-select-header-font ()
-  "Choose the font name and size (scaling data) for the header."
-  (let ((assoc (assq ps-header-font-family ps-font-info-database))
-	l fn fb fi bi sz lh sw aw)
-    (if (null assoc)
-	(error "Don't have data to scale font %s. Known fonts families are %s"
-	       ps-font-family
-	       (mapcar 'car ps-font-info-database)))
-    (setq l  (cdr assoc)
-	  fn (prog1 (car l) (setq l (cdr l))) ; need `pop'
-	  fb (prog1 (car l) (setq l (cdr l)))
-	  fi (prog1 (car l) (setq l (cdr l)))
-	  bi (prog1 (car l) (setq l (cdr l)))
-	  sz (prog1 (car l) (setq l (cdr l)))
-	  lh (prog1 (car l) (setq l (cdr l)))
-	  sw (prog1 (car l) (setq l (cdr l)))
-	  aw (prog1 (car l) (setq l (cdr l))))
-
-    ;; Font name
-    (setq ps-header-font             fn)
-    (setq ps-header-title-font       fb)
-    ;; Line height: These data just need to be rescaled:
-    (setq ps-header-title-line-height (/ (* lh ps-header-title-font-size) sz))
-    (setq ps-header-line-height       (/ (* lh ps-header-font-size)       sz))
-    ps-header-font-family))
-
-(defun ps-get-page-dimensions ()
-  (let ((page-dimensions (cdr (assq ps-paper-type ps-page-dimensions-database)))
-	page-width page-height)
-    (cond
-     ((null page-dimensions)
-      (error "`ps-paper-type' must be one of:\n%s"
-	     (mapcar 'car ps-page-dimensions-database)))
-     ((< ps-number-of-columns 1)
-      (error "The number of columns %d should not be negative")))
-
-    (ps-select-font)
-    (ps-select-header-font)
-
-    (setq page-width  (ps-page-dimensions-get-width  page-dimensions)
-	  page-height (ps-page-dimensions-get-height page-dimensions))
-
-    ;; Landscape mode
-    (if ps-landscape-mode
-	;; exchange width and height
-	(setq page-width (prog1 page-height (setq page-height page-width))))
-
-    ;; It is used to get the lower right corner (only in landscape mode)
-    (setq ps-landscape-page-height page-height)
-
-    ;; | lm | text | ic | text | ic | text | rm |
-    ;; page-width == lm  +  n * pw  +  (n - 1) * ic  +  rm
-    ;; => pw == (page-width - lm -rm - (n - 1) * ic) / n
-    (setq ps-print-width
-	  (/ (- page-width
-		ps-left-margin ps-right-margin
-		(* (1- ps-number-of-columns) ps-inter-column))
-	     ps-number-of-columns))
-    (if (<= ps-print-width 0)
-	(error "Bad horizontal layout:
-page-width           == %s
-ps-left-margin       == %s
-ps-right-margin      == %s
-ps-inter-column      == %s
-ps-number-of-columns == %s
-| lm | text | ic | text | ic | text | rm |
-page-width == lm  +  n * print-width  +  (n - 1) * ic  +  rm
-=> print-width == %d !"
-	       page-width
-	       ps-left-margin
-	       ps-right-margin
-	       ps-inter-column
-	       ps-number-of-columns
-	       ps-print-width))
-
-    (setq ps-print-height
-	  (- page-height ps-bottom-margin ps-top-margin))
-    (if (<= ps-print-height 0)
-	(error "Bad vertical layout:
-ps-top-margin    == %s
-ps-bottom-margin == %s
-page-height == bm + print-height + tm
-=> print-height == %d !"
-	       ps-top-margin
-	       ps-bottom-margin
-	       ps-print-height))
-    ;; If headers are turned on, deduct the height of the header from
-    ;; the print height.
-    (cond
-     (ps-print-header
-      (setq ps-header-pad
-	    (* ps-header-line-pad ps-header-title-line-height))
-      (setq ps-print-height
-	    (- ps-print-height
-	       ps-header-offset
-	       ps-header-pad
-	       ps-header-title-line-height
-	       (* ps-header-line-height (- ps-header-lines 1))
-	       ps-header-pad))))
-    (if (<= ps-print-height 0)
-	(error "Bad vertical layout:
-ps-top-margin    == %s
-ps-bottom-margin == %s
-ps-header-offset == %s
-ps-header-pad    == %s
-header-height    == %s
-page-height == bm + print-height + tm - ho - hh
-=> print-height == %d !"
-	       ps-top-margin
-	       ps-bottom-margin
-	       ps-header-offset
-	       ps-header-pad
-	       (+ ps-header-pad
-		  ps-header-title-line-height
-		  (* ps-header-line-height (- ps-header-lines 1))
-		  ps-header-pad)
-	       ps-print-height))))
-
-(defun ps-print-preprint (&optional filename)
-  (if (and filename
-	   (or (numberp filename)
-	       (listp filename)))
-      (let* ((name (concat (buffer-name) ".ps"))
-	     (prompt (format "Save PostScript to file: (default %s) "
-			     name))
-	     (res (read-file-name prompt default-directory name nil)))
-	(if (file-directory-p res)
-	    (expand-file-name name (file-name-as-directory res))
-	  res))))
-
-;; The following functions implement a simple list-buffering scheme so
-;; that ps-print doesn't have to repeatedly switch between buffers
-;; while spooling.  The functions ps-output and ps-output-string build
-;; up the lists; the function ps-flush-output takes the lists and
-;; insert its contents into the spool buffer (*PostScript*).
-
-(defun ps-output-string-prim (string)
-  (insert "(")				;insert start-string delimiter
-  (save-excursion			;insert string
-    (insert string))
-
-  ;; Find and quote special characters as necessary for PS
-  (while (re-search-forward "[()\\]" nil t)
-    (save-excursion
-      (forward-char -1)
-      (insert "\\")))
-
-  (goto-char (point-max))
-  (insert ")"))				;insert end-string delimiter
-
-(defun ps-init-output-queue ()
-  (setq ps-output-head (list ""))
-  (setq ps-output-tail ps-output-head))
-
-(defun ps-output (&rest args)
-  (setcdr ps-output-tail args)
-  (while (cdr ps-output-tail)
-    (setq ps-output-tail (cdr ps-output-tail))))
-
-(defun ps-output-string (string)
-  (ps-output t string))
-
-(defun ps-flush-output ()
-  (save-excursion
-    (set-buffer ps-spool-buffer)
-    (goto-char (point-max))
-    (while ps-output-head
-      (let ((it (car ps-output-head)))
-	(if (not (eq t it))
-	    (insert it)
-	  (setq ps-output-head (cdr ps-output-head))
-	  (ps-output-string-prim (car ps-output-head))))
-      (setq ps-output-head (cdr ps-output-head))))
-  (ps-init-output-queue))
-
-(defun ps-insert-file (fname)
-  (ps-flush-output)
-
-  ;; Check to see that the file exists and is readable; if not, throw
-  ;; and error.
-  (if (not (file-readable-p fname))
-      (error "Could not read file `%s'" fname))
-
-  (save-excursion
-    (set-buffer ps-spool-buffer)
-    (goto-char (point-max))
-    (insert-file fname)))
-    
-;; These functions insert the arrays that define the contents of the
-;; headers.
-
-(defun ps-generate-header-line (fonttag &optional content)
-  (ps-output "  [ " fonttag " ")
-  (cond
-   ;; Literal strings should be output as is -- the string must
-   ;; contain its own PS string delimiters, '(' and ')', if necessary.
-   ((stringp content)
-    (ps-output content))
-
-   ;; Functions are called -- they should return strings; they will be
-   ;; inserted as strings and the PS string delimiters added.
-   ((and (symbolp content) (fboundp content))
-    (ps-output-string (funcall content)))
-
-   ;; Variables will have their contents inserted.  They should
-   ;; contain strings, and will be inserted as strings.
-   ((and (symbolp content) (boundp content))
-    (ps-output-string (symbol-value content)))
-
-   ;; Anything else will get turned into an empty string.
-   (t
-    (ps-output-string "")))
-  (ps-output " ]\n"))
-
-(defun ps-generate-header (name contents)
-  (ps-output "/" name " [\n")
-  (if (> ps-header-lines 0)
-      (let ((count 1))
-	(ps-generate-header-line "/h0" (car contents))
-	(while (and (< count ps-header-lines)
-		    (setq contents (cdr contents)))
-	  (ps-generate-header-line "/h1" (car contents))
-	  (setq count (+ count 1)))
-	(ps-output "] def\n"))))
-
-(defun ps-output-boolean (name bool)
-  (ps-output (format "/%s %s def\n" name (if bool "true" "false"))))
-
-(defun ps-begin-file ()
-  (ps-get-page-dimensions)
-  (setq ps-showpage-count 0)
-
-  (ps-output ps-adobe-tag)
-  (ps-output "%%Title: " (buffer-name) "\n") ;Take job name from name of
-					;first buffer printed
-  (ps-output "%%Creator: " (user-full-name) "\n")
-  (ps-output "%%CreationDate: " 
-	     (time-stamp-hh:mm:ss) " " (time-stamp-mon-dd-yyyy) "\n")
-  (ps-output "%% DocumentFonts: "
-	     ps-font " " ps-font-bold " " ps-font-italic " "
-	     ps-font-bold-italic " "
-	     ps-header-font " " ps-header-title-font "\n")
-  (ps-output "%%Pages: (atend)\n")
-  (ps-output "%%EndComments\n\n")
-
-  (ps-output-boolean "LandscapeMode"             ps-landscape-mode)
-  (ps-output (format "/NumberOfColumns %d def\n" ps-number-of-columns))
-
-  (ps-output (format "/LandscapePageHeight %s def\n" ps-landscape-page-height))
-  (ps-output (format "/PrintWidth   %s def\n" ps-print-width))
-  (ps-output (format "/PrintHeight  %s def\n" ps-print-height))
-
-  (ps-output (format "/LeftMargin   %s def\n" ps-left-margin))
-  (ps-output (format "/RightMargin  %s def\n" ps-right-margin)) ; not used
-  (ps-output (format "/InterColumn  %s def\n" ps-inter-column))
-
-  (ps-output (format "/BottomMargin %s def\n" ps-bottom-margin))
-  (ps-output (format "/TopMargin    %s def\n" ps-top-margin)) ; not used
-  (ps-output (format "/HeaderOffset %s def\n" ps-header-offset))
-  (ps-output (format "/HeaderPad    %s def\n" ps-header-pad))
-  
-  (ps-output-boolean "PrintHeader"      ps-print-header)
-  (ps-output-boolean "PrintHeaderFrame" ps-print-header-frame)
-  (ps-output-boolean "ShowNofN"         ps-show-n-of-n)
-  (ps-output-boolean "Duplex"           ps-spool-duplex)
-
-  (ps-output (format "/LineHeight   %s def\n" ps-line-height))
-
-  (ps-output ps-print-prologue-1)
-
-  ;; Header fonts
-  (ps-output				; /h0 14 /Helvetica-Bold Font
-   (format "/h0 %s /%s DefFont\n" ps-header-title-font-size ps-header-title-font))
-  (ps-output				; /h1 12 /Helvetica Font
-   (format "/h1 %s /%s DefFont\n" ps-header-font-size       ps-header-font))
-
-  (ps-output ps-print-prologue-2)
-
-  ;; Text fonts
-  (ps-output (format "/f0 %s /%s DefFont\n" ps-font-size ps-font))
-  (ps-output (format "/f1 %s /%s DefFont\n" ps-font-size ps-font-bold))
-  (ps-output (format "/f2 %s /%s DefFont\n" ps-font-size ps-font-italic))
-  (ps-output (format "/f3 %s /%s DefFont\n" ps-font-size ps-font-bold-italic))
-
-  (ps-output "\nBeginDoc\n\n")
-  (ps-output "%%EndPrologue\n"))
-
-(defun ps-header-dirpart ()
-  (let ((fname (buffer-file-name)))
-    (if fname
-	(if (string-equal (buffer-name) (file-name-nondirectory fname))
-	    (file-name-directory fname)
-	  fname)
-      "")))
-
-(defun ps-get-buffer-name ()
-  (cond
-   ;; Indulge Jim this little easter egg:
-   ((string= (buffer-name) "ps-print.el")
-    "Hey, Cool!  It's ps-print.el!!!")
-   ;; Indulge Jack this other little easter egg:
-   ((string= (buffer-name) "sokoban.el")
-    "Super! C'est sokoban.el!")
-   (t (buffer-name))))
-
-(defun ps-begin-job ()
-  (setq ps-page-count 0))
-
-(defun ps-end-file ()
-  (ps-output "\nEndDoc\n\n")
-  (ps-output "%%Trailer\n")
-  (ps-output "%%Pages: " (format "%d\n" ps-showpage-count)))
-
-(defun ps-next-page ()
-  (ps-end-page)
-  (ps-flush-output)
-  (ps-begin-page))
-
-(defun ps-begin-page (&optional dummypage)
-  (ps-get-page-dimensions)
-  (setq ps-width-remaining  ps-print-width)
-  (setq ps-height-remaining ps-print-height)
-
-  (setq ps-page-count (+ ps-page-count 1))
-
-  (ps-output "\n%%Page: " 
-	     (format "%d %d\n" ps-page-count (+ 1 ps-showpage-count)))
-  (ps-output "BeginDSCPage\n")
-  (ps-output (format "/PageNumber %d def\n" ps-page-count))
-  (ps-output "/PageCount 0 def\n")
-
-  (if ps-print-header
-      (progn
-	(ps-generate-header "HeaderLinesLeft"    ps-left-header)
-	(ps-generate-header "HeaderLinesRight"   ps-right-header)
-	(ps-output (format "%d SetHeaderLines\n" ps-header-lines))))
-
-  (ps-output "BeginPage\n")
-  (ps-set-font      ps-current-font)
-  (ps-set-bg        ps-current-bg)
-  (ps-set-color     ps-current-color)
-  (ps-set-underline ps-current-underline-p))
-
-(defun ps-end-page ()
-  (setq ps-showpage-count (+ 1 ps-showpage-count))
-  (ps-output "EndPage\n")
-  (ps-output "EndDSCPage\n"))
-
-(defun ps-dummy-page ()
-  (setq ps-showpage-count (+ 1 ps-showpage-count))
-  (ps-output "%%Page: " (format "- %d\n" ps-showpage-count)
-	     "BeginDSCPage
-/PrintHeader false def
-BeginPage
-EndPage
-EndDSCPage\n"))
-	    
-(defun ps-next-line ()
-  (if (< ps-height-remaining ps-line-height)
-      (ps-next-page)
-    (setq ps-width-remaining  ps-print-width)
-    (setq ps-height-remaining (- ps-height-remaining ps-line-height))
-    (ps-hard-lf)))
-
-(defun ps-continue-line ()
-  (if (< ps-height-remaining ps-line-height)
-      (ps-next-page)
-    (setq ps-width-remaining  ps-print-width)
-    (setq ps-height-remaining (- ps-height-remaining ps-line-height))
-    (ps-soft-lf)))
-
-;; [jack] Why hard and soft ?
-
-(defun ps-hard-lf ()
-  (ps-output "HL\n"))
-
-(defun ps-soft-lf ()
-  (ps-output "SL\n"))
-
-(defun ps-find-wrappoint (from to char-width)
-  (let ((avail (truncate (/ ps-width-remaining char-width)))
-	(todo (- to from)))
-    (if (< todo avail)
-	(cons to (* todo char-width))
-      (cons (+ from avail) ps-width-remaining))))
-
-(defun ps-basic-plot-string (from to &optional bg-color)
-  (let* ((wrappoint (ps-find-wrappoint from to ps-avg-char-width))
-	 (to (car wrappoint))
-	 (string (buffer-substring from to)))
-    (ps-output-string string)
-    (ps-output " S\n")
-    wrappoint))
-
-(defun ps-basic-plot-whitespace (from to &optional bg-color)
-  (let* ((wrappoint (ps-find-wrappoint from to ps-space-width))
-	 (to (car wrappoint)))
-
-    (ps-output (format "%d W\n" (- to from)))
-    wrappoint))
-
-(defun ps-plot (plotfunc from to &optional bg-color)
-  (while (< from to)
-    (let* ((wrappoint (funcall plotfunc from to bg-color))
-	   (plotted-to (car wrappoint))
-	   (plotted-width (cdr wrappoint)))
-      (setq from plotted-to)
-      (setq ps-width-remaining (- ps-width-remaining plotted-width))
-      (if (< from to)
-	  (ps-continue-line))))
-  (if ps-razzle-dazzle
-      (let* ((q-todo (- (point-max) (point-min)))
-	     (q-done (- (point) (point-min)))
-	     (chunkfrac (/ q-todo 8))
-	     (chunksize (if (> chunkfrac 1000) 1000 chunkfrac)))
-	(if (> (- q-done ps-razchunk) chunksize)
-	    (let (foo)
-	      (setq ps-razchunk q-done)
-	      (setq foo
-		    (if (< q-todo 100)
-			(/ (* 100 q-done) q-todo)
-		      (/ q-done (/ q-todo 100))))
-	      (message "Formatting...%d%%" foo))))))
-
-(defun ps-set-font (font)
-  (setq ps-current-font font)
-  (ps-output (format "/f%d F\n" ps-current-font)))
-
-(defun ps-set-bg (color)
-  (if (setq ps-current-bg color)
-      (ps-output (format ps-color-format (nth 0 color) (nth 1 color)
-			 (nth 2 color))
-		 " true BG\n")
-    (ps-output "false BG\n")))
-
-(defun ps-set-color (color)
-  (if (setq ps-current-color color)
-      nil
-    (setq ps-current-color ps-default-fg))
-  (ps-output (format ps-color-format (nth 0 ps-current-color)
-		     (nth 1 ps-current-color) (nth 2 ps-current-color))
-	     " FG\n"))
-
-(defun ps-set-underline (underline-p)
-  (ps-output (if underline-p "true" "false") " UL\n")
-  (setq ps-current-underline-p underline-p))
-
-(defun ps-plot-region (from to font fg-color &optional bg-color underline-p)
-
-  (if (not (equal font ps-current-font))
-      (ps-set-font font))
-  
-  ;; Specify a foreground color only if one's specified and it's
-  ;; different than the current.
-  (if (not (equal fg-color ps-current-color))
-      (ps-set-color fg-color))
-  
-  (if (not (equal bg-color ps-current-bg))
-      (ps-set-bg bg-color))
-  
-  ;; Toggle underlining if different.
-  (if (not (equal underline-p ps-current-underline-p))
-      (ps-set-underline underline-p))
-
-  ;; Starting at the beginning of the specified region...
-  (save-excursion
-    (goto-char from)
-
-    ;; ...break the region up into chunks separated by tabs, linefeeds,
-    ;; and pagefeeds, and plot each chunk.
-    (while (< from to)
-      (if (re-search-forward "[\t\n\f]" to t)
-          (let ((match (char-after (match-beginning 0))))
-            (cond
-	     ((= match ?\t)
-	      (let ((linestart
-		     (save-excursion (beginning-of-line) (point))))
-		(ps-plot 'ps-basic-plot-string from (- (point) 1)
-			 bg-color)
-		(forward-char -1)
-		(setq from (+ linestart (current-column)))
-		(if (re-search-forward "[ \t]+" to t)
-		    (ps-plot 'ps-basic-plot-whitespace
-			     from (+ linestart (current-column))
-			     bg-color))))
-
-	     ((= match ?\n)
-	      (ps-plot 'ps-basic-plot-string from (- (point) 1)
-		       bg-color)
-	      (ps-next-line)
-	      )
-
-	     ((= match ?\f)
-	      (ps-plot 'ps-basic-plot-string from (- (point) 1)
-		       bg-color)
-	      (ps-next-page)))
-            (setq from (point)))
-        (ps-plot 'ps-basic-plot-string from to bg-color)
-        (setq from to)))))
-
-(defun ps-color-value (x-color-value)
-  ;; Scale 16-bit X-COLOR-VALUE to PostScript color value in [0, 1] interval.
-  (/ x-color-value ps-print-color-scale))
-
-(defun ps-color-values (x-color)
-  (cond ((fboundp 'x-color-values)
-	 (x-color-values x-color))
-	((fboundp 'pixel-components)
-	 (pixel-components x-color))
-	(t (error "No available function to determine X color values."))))
-
-(defun ps-face-attributes (face)
-  (let ((differs (face-differs-from-default-p face)))
-    (list (memq face ps-ref-bold-faces)
-	  (memq face ps-ref-italic-faces)
-	  (memq face ps-ref-underlined-faces)
-	  (and differs (face-foreground face))
-	  (and differs (face-background face)))))
-
-(defun ps-face-attribute-list (face-or-list)
-  (if (listp face-or-list)
-      (let (bold-p italic-p underline-p foreground background face-attr face)
-	(while face-or-list
-	  (setq face (car face-or-list))
-	  (setq face-attr (ps-face-attributes face))
-	  (setq bold-p (or bold-p (nth 0 face-attr)))
-	  (setq italic-p (or italic-p (nth 1 face-attr)))
-	  (setq underline-p (or underline-p (nth 2 face-attr)))
-	  (if foreground
-	      nil
-	    (setq foreground (nth 3 face-attr)))
-	  (if background
-	      nil
-	    (setq background (nth 4 face-attr)))
-	  (setq face-or-list (cdr face-or-list)))
-	(list bold-p italic-p underline-p foreground background))
-
-    (ps-face-attributes face-or-list)))
-
-(defun ps-plot-with-face (from to face)
-  (if face
-      (let* ((face-attr (ps-face-attribute-list face))
-	     (bold-p (nth 0 face-attr))
-	     (italic-p (nth 1 face-attr))
-	     (underline-p (nth 2 face-attr))
-	     (foreground (nth 3 face-attr))
-	     (background (nth 4 face-attr))
-	     (fg-color (if (and ps-print-color-p foreground)
-			   (mapcar 'ps-color-value
-				   (ps-color-values foreground))
-			 ps-default-color))
-	     (bg-color (if (and ps-print-color-p background)
-			   (mapcar 'ps-color-value
-				   (ps-color-values background)))))
-	(ps-plot-region from to
-			(cond ((and bold-p italic-p) 3)
-			      (italic-p 2)
-			      (bold-p 1)
-			      (t 0))
-;			(or fg-color '(0.0 0.0 0.0))
-			fg-color
-			bg-color underline-p))
-    (goto-char to)))
-
-
-(defun ps-emacs-face-kind-p (face kind kind-regex kind-list)
-  (let ((frame-font (face-font face))
-	(face-defaults (face-font face t)))
-    (or
-     ;; Check FACE defaults:
-     (and (listp face-defaults)
-	  (memq kind face-defaults))
-
-     ;; Check the user's preferences
-     (memq face kind-list))))
-
-(defun ps-xemacs-face-kind-p (face kind kind-regex kind-list)
-  (let* ((frame-font (or (face-font face) (face-font 'default)))
-	 (kind-cons (assq kind (x-font-properties frame-font)))
-	 (kind-spec (cdr-safe kind-cons))
-	 (case-fold-search t))
-
-    (or (and kind-spec (string-match kind-regex kind-spec))
-	;; Kludge-compatible:
-	(memq face kind-list))))
-
-(defun ps-face-bold-p (face)
-  (if (eq ps-print-emacs-type 'emacs)
-      (ps-emacs-face-kind-p face 'bold "-\\(bold\\|demibold\\)-"
-			  ps-bold-faces)
-    (ps-xemacs-face-kind-p face 'WEIGHT_NAME "bold\\|demibold"
-			   ps-bold-faces)))
-
-(defun ps-face-italic-p (face)
-  (if (eq ps-print-emacs-type 'emacs)
-      (ps-emacs-face-kind-p face 'italic "-[io]-" ps-italic-faces)
-    (or
-     (ps-xemacs-face-kind-p face 'ANGLE_NAME "i\\|o" ps-italic-faces)
-     (ps-xemacs-face-kind-p face 'SLANT "i\\|o" ps-italic-faces))))
-
-(defun ps-face-underlined-p (face)
-  (or (face-underline-p face)
-      (memq face ps-underlined-faces)))
-
-;; Ensure that face-list is fbound.
-(or (fboundp 'face-list) (defalias 'face-list 'list-faces))
-
-(defun ps-build-reference-face-lists ()
-  (if ps-auto-font-detect
-      (let ((faces (face-list))
-	    the-face)
-	(setq ps-ref-bold-faces nil
-	      ps-ref-italic-faces nil
-	      ps-ref-underlined-faces nil)
-	(while faces
-	  (setq the-face (car faces))
-	  (if (ps-face-italic-p the-face)
-	      (setq ps-ref-italic-faces
-		    (cons the-face ps-ref-italic-faces)))
-	  (if (ps-face-bold-p the-face)
-	      (setq ps-ref-bold-faces
-		    (cons the-face ps-ref-bold-faces)))
-	  (if (ps-face-underlined-p the-face)
-	      (setq ps-ref-underlined-faces
-		    (cons the-face ps-ref-underlined-faces)))
-	  (setq faces (cdr faces))))
-    (setq ps-ref-bold-faces ps-bold-faces)
-    (setq ps-ref-italic-faces ps-italic-faces)
-    (setq ps-ref-underlined-faces ps-underlined-faces))
-  (setq ps-build-face-reference nil))
-
-(defun ps-mapper (extent list)
-  (nconc list (list (list (extent-start-position extent) 'push extent)
-                    (list (extent-end-position extent) 'pull extent)))
-  nil)
-
-(defun ps-sorter (a b)
-  (< (car a) (car b)))
-
-(defun ps-extent-sorter (a b)
-  (< (extent-priority a) (extent-priority b)))
-
-(defun ps-print-ensure-fontified (start end)
-  (if (and (boundp 'lazy-lock-mode) lazy-lock-mode)
-      (if (fboundp 'lazy-lock-fontify-region)
-          (lazy-lock-fontify-region start end) ; the new
-        (lazy-lock-fontify-buffer))))	       ; the old
-
-(defun ps-generate-postscript-with-faces (from to)
-  ;; Build the reference lists of faces if necessary.
-  (if (or ps-always-build-face-reference
-	  ps-build-face-reference)
-      (progn
-	(message "Collecting face information...")
-	(ps-build-reference-face-lists)))
-  ;; Set the color scale.  We do it here instead of in the defvar so
-  ;; that ps-print can be dumped into emacs.  This expression can't be
-  ;; evaluated at dump-time because X isn't initialized.
-  (setq ps-print-color-scale
-	(if ps-print-color-p
-	    (float (car (ps-color-values "white")))
-	  1.0))
-  ;; Generate some PostScript.
-  (save-restriction
-    (narrow-to-region from to)
-    (let ((face 'default)
-	  (position to))
-      (ps-print-ensure-fontified from to)
-      (cond ((or (eq ps-print-emacs-type 'lucid)
-		 (eq ps-print-emacs-type 'xemacs))
-	   ;; Build the list of extents...
-	   (let ((a (cons 'dummy nil))
-		 record type extent extent-list)
-	     (map-extents 'ps-mapper nil from to a)
-	     (setq a (cdr a))
-	     (setq a (sort a 'ps-sorter))
-	   
-	     (setq extent-list nil)
-	   
-	     ;; Loop through the extents...
-	     (while a
-	       (setq record (car a))
-	     
-	       (setq position (car record))
-	       (setq record (cdr record))
-	     
-	       (setq type (car record))
-	       (setq record (cdr record))
-	     
-	       (setq extent (car record))
-	     
-	       ;; Plot up to this record.
-	       ;; XEmacs 19.12: for some reason, we're getting into a
-	       ;; situation in which some of the records have
-	       ;; positions less than 'from'.  Since we've narrowed
-	       ;; the buffer, this'll generate errors.  This is a
-	       ;; hack, but don't call ps-plot-with-face unless from >
-	       ;; point-min.
-	       (if (and (>= from (point-min))
-			(<= position (point-max)))
-		   (ps-plot-with-face from position face))
-	     
-	       (cond
-		((eq type 'push)
-		 (if (extent-face extent)
-		     (setq   extent-list (sort (cons extent extent-list)
-					       'ps-extent-sorter))))
-	      
-		((eq type 'pull)
-		 (setq extent-list (sort (delq extent extent-list)
-					 'ps-extent-sorter))))
-	     
-	       (setq face
-		     (if extent-list
-			 (extent-face (car extent-list))
-		       'default))
-	     
-	       (setq from position)
-	       (setq a (cdr a)))))
-
-	    ((eq ps-print-emacs-type 'emacs)
-	     (let ((property-change from)
-		   (overlay-change from))
-	       (while (< from to)
-		 (if (< property-change to) ; Don't search for property change
-					; unless previous search succeeded.
-		     (setq property-change
-			   (next-property-change from nil to)))
-		 (if (< overlay-change to) ; Don't search for overlay change
-					; unless previous search succeeded.
-		     (setq overlay-change
-			   (min (next-overlay-change from) to)))
-		 (setq position
-		       (min property-change overlay-change))
-		 ;; The code below is not quite correct,
-		 ;; because a non-nil overlay invisible property
-		 ;; which is inactive according to the current value
-		 ;; of buffer-invisibility-spec nonetheless overrides
-		 ;; a face text property.
-		 (setq face
-		       (cond ((let ((prop (get-text-property from 'invisible)))
-				;; Decide whether this invisible property
-				;; really makes the text invisible.
-				(if (eq buffer-invisibility-spec t)
-				    (not (null prop))
-				  (or (memq prop buffer-invisibility-spec)
-				      (assq prop buffer-invisibility-spec))))
-			      nil)
-			     ((get-text-property from 'face))
-			     (t 'default)))
-		 (let ((overlays (overlays-at from))
-		       (face-priority -1)) ; text-property
-		   (while overlays
-		     (let* ((overlay (car overlays))
-			    (overlay-face (overlay-get overlay 'face))
-			    (overlay-invisible (overlay-get overlay 'invisible))
-			    (overlay-priority (or (overlay-get overlay
-							       'priority)
-						  0)))
-		       (if (and (or overlay-invisible overlay-face)
-				(> overlay-priority face-priority))
-			   (setq face (cond ((if (eq buffer-invisibility-spec t)
-						 (not (null overlay-invisible))
-					       (or (memq overlay-invisible buffer-invisibility-spec)
-						   (assq overlay-invisible buffer-invisibility-spec)))
-					     nil)
-					    ((and face overlay-face)))
-				 face-priority overlay-priority)))
-		     (setq overlays (cdr overlays))))
-		 ;; Plot up to this record.
-		 (ps-plot-with-face from position face)
-		 (setq from position)))))
-      (ps-plot-with-face from to face))))  
-
-(defun ps-generate-postscript (from to)
-  (ps-plot-region from to 0 nil))
-
-(defun ps-generate (buffer from to genfunc)
-  (let ((from (min to from))
-	(to (max to from))
-	;; This avoids trouble if chars with read-only properties
-	;; are copied into ps-spool-buffer.
-	(inhibit-read-only t))
-    (save-restriction
-      (narrow-to-region from to)
-      (if ps-razzle-dazzle
-	  (message "Formatting...%d%%" (setq ps-razchunk 0)))
-      (set-buffer buffer)
-      (setq ps-source-buffer buffer)
-      (setq ps-spool-buffer (get-buffer-create ps-spool-buffer-name))
-      (ps-init-output-queue)
-      (let (safe-marker completed-safely needs-begin-file)
-	(unwind-protect
-	    (progn
-	      (set-buffer ps-spool-buffer)
-	    
-	      ;; Get a marker and make it point to the current end of the
-	      ;; buffer,  If an error occurs, we'll delete everything from
-	      ;; the end of this marker onwards.
-	      (setq safe-marker (make-marker))
-	      (set-marker safe-marker (point-max))
-	    
-	      (goto-char (point-min))
-	      (if (looking-at (regexp-quote "%!PS-Adobe-1.0"))
-		  nil
-		(setq needs-begin-file t))
-	      (save-excursion
-		(set-buffer ps-source-buffer)
-		(if needs-begin-file (ps-begin-file))
-		(ps-begin-job)
-		(ps-begin-page))
-	      (set-buffer ps-source-buffer)
-	      (funcall genfunc from to)
-	      (ps-end-page)
-	    
-	      (if (and ps-spool-duplex
-		       (= (mod ps-page-count 2) 1))
-		  (ps-dummy-page))
-	      (ps-flush-output)
-	    
-	      ;; Back to the PS output buffer to set the page count
-	      (set-buffer ps-spool-buffer)
-	      (goto-char (point-max))
-	      (while (re-search-backward "^/PageCount 0 def$" nil t)
-		(replace-match (format "/PageCount %d def" ps-page-count) t))
-
-	      ;; Setting this variable tells the unwind form that the
-	      ;; the postscript was generated without error.
-	      (setq completed-safely t))
-
-	  ;; Unwind form: If some bad mojo occurred while generating
-	  ;; postscript, delete all the postscript that was generated.
-	  ;; This protects the previously spooled files from getting
-	  ;; corrupted.
-	  (if (and (markerp safe-marker) (not completed-safely))
-	      (progn
-		(set-buffer ps-spool-buffer)
-		(delete-region (marker-position safe-marker) (point-max))))))
-
-      (if ps-razzle-dazzle
-	  (message "Formatting...done")))))
-
-(defun ps-do-despool (filename)
-  (if (or (not (boundp 'ps-spool-buffer))
-	  (not (symbol-value 'ps-spool-buffer)))
-      (message "No spooled PostScript to print")
-    (ps-end-file)
-    (ps-flush-output)
-    (if filename
-	(save-excursion
-	  (if ps-razzle-dazzle
-	      (message "Saving..."))
-	  (set-buffer ps-spool-buffer)
-	  (setq filename (expand-file-name filename))
-	  (write-region (point-min) (point-max) filename)
-	  (if ps-razzle-dazzle
-	      (message "Wrote %s" filename)))
-      ;; Else, spool to the printer
-      (if ps-razzle-dazzle
-	  (message "Printing..."))
-      (save-excursion
-	(set-buffer ps-spool-buffer)
-	(if (and (eq system-type 'ms-dos) (stringp dos-ps-printer))
-	    (write-region (point-min) (point-max) dos-ps-printer t 0)
-	  (let ((binary-process-input t)) ; for MS-DOS
-	    (apply 'call-process-region
-		   (point-min) (point-max) ps-lpr-command nil
-		   (if (fboundp 'start-process) 0 nil)
-		   nil
-		   ps-lpr-switches))))
-      (if ps-razzle-dazzle
-	  (message "Printing...done")))
-    (kill-buffer ps-spool-buffer)))
-
-(defun ps-kill-emacs-check ()
-  (let (ps-buffer)
-    (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
-	     (buffer-modified-p ps-buffer))
-	(if (y-or-n-p "Unprinted PostScript waiting; print now? ")
-	    (ps-despool)))
-    (if (and (setq ps-buffer (get-buffer ps-spool-buffer-name))
-	     (buffer-modified-p ps-buffer))
-	(if (yes-or-no-p "Unprinted PostScript waiting; exit anyway? ")
-	    nil
-	  (error "Unprinted PostScript")))))
-
-(if (fboundp 'add-hook)
-    (funcall 'add-hook 'kill-emacs-hook 'ps-kill-emacs-check)
-  (if kill-emacs-hook
-      (message "Won't override existing kill-emacs-hook")
-    (setq kill-emacs-hook 'ps-kill-emacs-check)))
-
-;;; Sample Setup Code:
-
-;; This stuff is for anybody that's brave enough to look this far,
-;; and able to figure out how to use it.  It isn't really part of ps-
-;; print, but I'll leave it here in hopes it might be useful:
-
-;; WARNING!!! The following code is *sample* code only. Don't use it
-;; unless you understand what it does!
-
-(defmacro ps-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
-			   [f22] ''f22))
-(defmacro ps-c-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
-			     [C-f22]
-			     ''(control f22)))
-(defmacro ps-s-prsc () (list 'if (list 'eq 'ps-print-emacs-type ''emacs)
-			     [S-f22]
-			     ''(shift f22)))
-
-;; Look in an article or mail message for the Subject: line.  To be
-;; placed in ps-left-headers.
-(defun ps-article-subject ()
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward "^Subject:[ \t]+\\(.*\\)$" nil t)
-	(buffer-substring (match-beginning 1) (match-end 1))
-      "Subject ???")))
-
-;; Look in an article or mail message for the From: line.  Sorta-kinda
-;; understands RFC-822 addresses and can pull the real name out where
-;; it's provided.  To be placed in ps-left-headers.
-(defun ps-article-author ()
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward "^From:[ \t]+\\(.*\\)$" nil t)
-	(let ((fromstring (buffer-substring (match-beginning 1) (match-end 1))))
-	  (cond
-
-	   ;; Try first to match addresses that look like
-	   ;; thompson@wg2.waii.com (Jim Thompson)
-	   ((string-match ".*[ \t]+(\\(.*\\))" fromstring)
-	    (substring fromstring (match-beginning 1) (match-end 1)))
-
-	   ;; Next try to match addresses that look like
-	   ;; Jim Thompson <thompson@wg2.waii.com>
-	   ((string-match "\\(.*\\)[ \t]+<.*>" fromstring)
-	    (substring fromstring (match-beginning 1) (match-end 1)))
-
-	   ;; Couldn't find a real name -- show the address instead.
-	   (t fromstring)))
-      "From ???")))
-
-;; A hook to bind to gnus-Article-prepare-hook.  This will set the ps-
-;; left-headers specially for gnus articles.  Unfortunately, gnus-
-;; article-mode-hook is called only once, the first time the *Article*
-;; buffer enters that mode, so it would only work for the first time
-;; we ran gnus.  The second time, this hook wouldn't get set up.  The
-;; only alternative is gnus-article-prepare-hook.
-(defun ps-gnus-article-prepare-hook ()
-  (setq ps-header-lines 3)
-  (setq ps-left-header
-	;; The left headers will display the article's subject, its
-	;; author, and the newsgroup it was in.
-	(list 'ps-article-subject 'ps-article-author 'gnus-newsgroup-name)))
-
-;; A hook to bind to vm-mode-hook to locally bind prsc and set the ps-
-;; left-headers specially for mail messages.  This header setup would
-;; also work, I think, for RMAIL.
-(defun ps-vm-mode-hook ()
-  (local-set-key (ps-prsc) 'ps-vm-print-message-from-summary)
-  (setq ps-header-lines 3)
-  (setq ps-left-header
-	;; The left headers will display the message's subject, its
-	;; author, and the name of the folder it was in.
-	(list 'ps-article-subject 'ps-article-author 'buffer-name)))
-
-;; Every now and then I forget to switch from the *Summary* buffer to
-;; the *Article* before hitting prsc, and a nicely formatted list of
-;; article subjects shows up at the printer.  This function, bound to
-;; prsc for the gnus *Summary* buffer means I don't have to switch
-;; buffers first.
-(defun ps-gnus-print-article-from-summary ()
-  (interactive)
-  (if (get-buffer "*Article*")
-      (save-excursion
-	(set-buffer "*Article*")
-	(ps-spool-buffer-with-faces))))
-
-;; See ps-gnus-print-article-from-summary.  This function does the
-;; same thing for vm.
-(defun ps-vm-print-message-from-summary ()
-  (interactive)
-  (if (and (boundp 'vm-mail-buffer) (symbol-value 'vm-mail-buffer))
-      (save-excursion
-	(set-buffer (symbol-value 'vm-mail-buffer))
-	(ps-spool-buffer-with-faces))))
-
-;; A hook to bind to bind to gnus-summary-setup-buffer to locally bind
-;; prsc.
-(defun ps-gnus-summary-setup ()
-  (local-set-key (ps-prsc) 'ps-gnus-print-article-from-summary))
-
-;; Look in an article or mail message for the Subject: line.  To be
-;; placed in ps-left-headers.
-(defun ps-info-file ()
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward "File:[ \t]+\\([^, \t\n]*\\)" nil t)
-	(buffer-substring (match-beginning 1) (match-end 1))
-      "File ???")))
-
-;; Look in an article or mail message for the Subject: line.  To be
-;; placed in ps-left-headers.
-(defun ps-info-node ()
-  (save-excursion
-    (goto-char (point-min))
-    (if (re-search-forward "Node:[ \t]+\\([^,\t\n]*\\)" nil t)
-	(buffer-substring (match-beginning 1) (match-end 1))
-      "Node ???")))
-
-(defun ps-info-mode-hook ()
-  (setq ps-left-header
-	;; The left headers will display the node name and file name.
-	(list 'ps-info-node 'ps-info-file)))
-
-;; WARNING! The following function is a *sample* only, and is *not*
-;; meant to be used as a whole unless you understand what the effects
-;; will be!  (In fact, this is a copy of Jim's setup for ps-print -- I'd
-;; be very surprised if it was useful to *anybody*, without
-;; modification.)
-
-(defun ps-jts-ps-setup ()
-  (global-set-key (ps-prsc) 'ps-spool-buffer-with-faces) ;f22 is prsc
-  (global-set-key (ps-s-prsc) 'ps-spool-region-with-faces)
-  (global-set-key (ps-c-prsc) 'ps-despool)
-  (add-hook 'gnus-article-prepare-hook 'ps-gnus-article-prepare-hook)
-  (add-hook 'gnus-summary-mode-hook 'ps-gnus-summary-setup)
-  (add-hook 'vm-mode-hook 'ps-vm-mode-hook)
-  (add-hook 'vm-mode-hooks 'ps-vm-mode-hook)
-  (add-hook 'Info-mode-hook 'ps-info-mode-hook)
-  (setq ps-spool-duplex t)
-  (setq ps-print-color-p nil)
-  (setq ps-lpr-command "lpr")
-  (setq ps-lpr-switches '("-Jjct,duplex_long"))
-  'ps-jts-ps-setup)
-
-;; WARNING! The following function is a *sample* only, and is *not*
-;; meant to be used as a whole unless it corresponds to your needs.
-;; (In fact, this is a copy of Jack's setup for ps-print --
-;; I would not be that surprised if it was useful to *anybody*,
-;; without modification.)
-
-(defun ps-jack-setup ()
-  (setq ps-print-color-p  'nil
-	ps-lpr-command    "lpr"
-	ps-lpr-switches   (list)
-
-	ps-paper-type       'a4
-	ps-landscape-mode   't
-	ps-number-of-columns 2
-
-	ps-left-margin   (/ (* 72  1.0) 2.54) ;  1.0 cm
-	ps-right-margin  (/ (* 72  1.0) 2.54) ;  1.0 cm
-	ps-inter-column  (/ (* 72  1.0) 2.54) ;  1.0 cm
-	ps-bottom-margin (/ (* 72  1.5) 2.54) ;  1.5 cm
-	ps-top-margin    (/ (* 72  1.5) 2.54) ;  1.5 cm
-	ps-header-offset (/ (* 72  1.0) 2.54) ;  1.0 cm
-	ps-header-line-pad    .15
-	ps-print-header       t
-	ps-print-header-frame t
-	ps-header-lines       2
-	ps-show-n-of-n        t
-	ps-spool-duplex       nil
-
-	ps-font-family             'Courier
-	ps-font-size               5.5
-	ps-header-font-family      'Helvetica
-	ps-header-font-size        6
-	ps-header-title-font-size  8)
-  'ps-jack-setup)
-
-(provide 'ps-print)
-
-;;; ps-print.el ends here
diff --git a/lisp/rcompile.el b/lisp/rcompile.el
deleted file mode 100644
index c2d5b3f62de..00000000000
--- a/lisp/rcompile.el
+++ /dev/null
@@ -1,163 +0,0 @@
-;;; rcompile.el --- run a compilation on a remote machine
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Albert    <alon@milcse.rtsg.mot.com>
-;; Maintainer: FSF
-;; Created: 1993 Oct 6
-;; Version: 1.1
-;; Keywords: tools, processes
-
-;; 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 is for running a remote compilation and using emacs to parse
-;; the error messages. It works by rsh'ing the compilation to a remote host
-;; and parsing the output. If the file visited at the time remote-compile was
-;; called was loaded remotely (ange-ftp), the host and user name are obtained
-;; by the calling ange-ftp-ftp-name on the current directory. In this case the
-;; next-error command will also ange-ftp the files over. This is achieved
-;; automatically because the compilation-parse-errors function uses
-;; default-directory to build its file names. If however the file visited was
-;; loaded locally, remote-compile prompts for a host and user and assumes the
-;; files mounted locally (otherwise, how was the visited file loaded).
-
-;; See the user defined variables section for more info.
-
-;; I was contemplating redefining "compile" to "remote-compile" automatically
-;; if the file visited was ange-ftp'ed but decided against it for now. If you
-;; feel this is a good idea, let me know and I'll consider it again.
-
-;; Installation:
-
-;; To use rcompile, you also need to give yourself permission to connect to
-;; the remote host.  You do this by putting lines like:
-
-;; monopoly alon
-;; vme33
-;;
-;; in a file named .rhosts in the home directory (of the remote machine).
-;; Be careful what you put in this file. A line like:
-;;
-;; +
-;;
-;; Will allow anyone access to your account without a password. I suggest you
-;; read the rhosts(5) manual page before you edit this file (if you are not
-;; familiar with it already) 
-
-;;; Code:
-
-(provide 'rcompile)
-(require 'compile)
-;;; The following should not be needed.
-;;; (eval-when-compile (require 'ange-ftp))
-
-;;;; user defined variables
-
-(defvar remote-compile-host nil
-  "*Host for remote compilations.")
-
-(defvar remote-compile-user nil
-  "User for remote compilations.
-nil means use the value returned by \\[user-login-name].")
-
-(defvar remote-compile-run-before nil
-  "*Command to run before compilation.
-This can be used for setting up environment variables,
-since rsh does not invoke the shell as a login shell and files like .login
-\(tcsh\) and .bash_profile \(bash\) are not run.
-nil means run no commands.")
-
-(defvar remote-compile-prompt-for-host nil
-  "*Non-nil means prompt for host if not available from filename.")
-
-(defvar remote-compile-prompt-for-user nil
-  "*Non-nil means prompt for user if not available from filename.")
-
-;;;; internal variables
-
-;; History of remote compile hosts and users
-(defvar remote-compile-host-history nil)
-(defvar remote-compile-user-history nil)
-
-
-;;;; entry point
-
-;;;###autoload
-(defun remote-compile (host user command)
-  "Compile the the current buffer's directory on HOST.  Log in as USER.
-See \\[compile]."
-  (interactive
-   (let ((parsed (or (and (featurep 'ange-ftp)
-                          (ange-ftp-ftp-name default-directory))))
-         host user command prompt)
-     (if parsed
-         (setq host (nth 0 parsed)
-               user (nth 1 parsed))
-       (setq prompt (if (stringp remote-compile-host)
-                        (format "Compile on host (default %s): "
-                                remote-compile-host)
-                      "Compile on host: ")
-             host (if (or remote-compile-prompt-for-host
-                          (null remote-compile-host))
-                      (read-from-minibuffer prompt
-                                            "" nil nil
-                                            'remote-compile-host-history)
-                    remote-compile-host)
-             user (if remote-compile-prompt-for-user
-                      (read-from-minibuffer (format
-                                             "Compile by user (default %s)"
-                                             (or remote-compile-user
-                                                 (user-login-name)))
-                                            "" nil nil
-                                            'remote-compile-user-history)
-                    remote-compile-user)))
-     (setq command (read-from-minibuffer "Compile command: "
-                                         compile-command nil nil
-                                         '(compile-history . 1)))
-     (list (if (string= host "") remote-compile-host host)
-           (if (string= user "") remote-compile-user user)
-           command)))
-  (setq compile-command command)
-  (cond (user
-         (setq remote-compile-user user))
-        ((null remote-compile-user)
-         (setq remote-compile-user (user-login-name))))
-  (let* ((parsed (and (featurep 'ange-ftp)
-                      (ange-ftp-ftp-name default-directory)))
-         (compile-command
-          (format "%s %s -l %s \"(%scd %s; %s)\""
-		  remote-shell-program
-                  host
-                  remote-compile-user
-                  (if remote-compile-run-before
-                      (concat remote-compile-run-before "; ")
-                    "")
-                  (if parsed (nth 2 parsed) default-directory)
-                  compile-command)))
-    (setq remote-compile-host host)
-    (save-some-buffers nil nil)
-    (compile-internal compile-command "No more errors")
-    ;; Set comint-file-name-prefix in the compilation buffer so
-    ;; compilation-parse-errors will find referenced files by ange-ftp.
-    (save-excursion
-      (set-buffer compilation-last-buffer)
-      (setq comint-file-name-prefix (concat "/" host ":")))))
-
-;;; rcompile.el ends here
diff --git a/lisp/rect.el b/lisp/rect.el
deleted file mode 100644
index d8e742ce6a1..00000000000
--- a/lisp/rect.el
+++ /dev/null
@@ -1,246 +0,0 @@
-;;; rect.el --- rectangle functions for GNU Emacs.
-
-;; Copyright (C) 1985, 1994 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 package provides the operations on rectangles that are ocumented
-;; in the Emacs manual.
-
-;;; Code:
-
-(defun operate-on-rectangle (function start end coerce-tabs)
-  "Call FUNCTION for each line of rectangle with corners at START, END.
-If COERCE-TABS is non-nil, convert multi-column characters
-that span the starting or ending columns on any line
-to multiple spaces before calling FUNCTION.
-FUNCTION is called with three arguments:
- position of start of segment of this line within the rectangle,
- number of columns that belong to rectangle but are before that position,
- number of columns that belong to rectangle but are after point.
-Point is at the end of the segment of this line within the rectangle."
-  (let (startcol startlinepos endcol endlinepos)
-    (save-excursion
-     (goto-char start)
-     (setq startcol (current-column))
-     (beginning-of-line)
-     (setq startlinepos (point)))
-    (save-excursion
-     (goto-char end)
-     (setq endcol (current-column))
-     (forward-line 1)
-     (setq endlinepos (point-marker)))
-    (if (< endcol startcol)
-	(setq startcol (prog1 endcol (setq endcol startcol))))
-    (save-excursion
-     (goto-char startlinepos)
-     (while (< (point) endlinepos)
-       (let (startpos begextra endextra)
-	 (move-to-column startcol coerce-tabs)
-	 (setq begextra (- (current-column) startcol))
-	 (setq startpos (point))
-	 (move-to-column endcol coerce-tabs)
-	 (setq endextra (- endcol (current-column)))
-	 (if (< begextra 0)
-	     (setq endextra (+ endextra begextra)
-		   begextra 0))
-	 (funcall function startpos begextra endextra))
-       (forward-line 1)))
-    (- endcol startcol)))
-
-(defun delete-rectangle-line (startdelpos ignore ignore)
-  (delete-region startdelpos (point)))
-
-(defun delete-extract-rectangle-line (startdelpos begextra endextra)
-  (save-excursion
-   (extract-rectangle-line startdelpos begextra endextra))
-  (delete-region startdelpos (point)))
-
-(defun extract-rectangle-line (startdelpos begextra endextra)
-  (let ((line (buffer-substring startdelpos (point)))
-	(end (point)))
-    (goto-char startdelpos)
-    (while (search-forward "\t" end t)
-      (let ((width (- (current-column)
-		      (save-excursion (forward-char -1)
-				      (current-column)))))
-	(setq line (concat (substring line 0 (- (point) end 1))
-			   (spaces-string width)
-			   (substring line (+ (length line) (- (point) end)))))))
-    (if (or (> begextra 0) (> endextra 0))
-	(setq line (concat (spaces-string begextra)
-			   line
-			   (spaces-string endextra))))
-    (setq lines (cons line lines))))
-
-(defconst spaces-strings
-  '["" " " "  " "   " "    " "     " "      " "       " "        "])
-
-(defun spaces-string (n)
-  (if (<= n 8) (aref spaces-strings n)
-    (let ((val ""))
-      (while (> n 8)
-	(setq val (concat "        " val)
-	      n (- n 8)))
-      (concat val (aref spaces-strings n)))))
-    
-;;;###autoload
-(defun delete-rectangle (start end)
-  "Delete (don't save) text in rectangle with point and mark as corners.
-The same range of columns is deleted in each line starting with the line
-where the region begins and ending with the line where the region ends."
-  (interactive "r")
-  (operate-on-rectangle 'delete-rectangle-line start end t))
-
-;;;###autoload
-(defun delete-extract-rectangle (start end)
-  "Delete contents of rectangle and return it as a list of strings.
-Arguments START and END are the corners of the rectangle.
-The value is list of strings, one for each line of the rectangle."
-  (let (lines)
-    (operate-on-rectangle 'delete-extract-rectangle-line
-			  start end t)
-    (nreverse lines)))
-
-;;;###autoload
-(defun extract-rectangle (start end)
-  "Return contents of rectangle with corners at START and END.
-Value is list of strings, one for each line of the rectangle."
-  (let (lines)
-    (operate-on-rectangle 'extract-rectangle-line start end nil)
-    (nreverse lines)))
-
-(defvar killed-rectangle nil
-  "Rectangle for yank-rectangle to insert.")
-
-;;;###autoload
-(defun kill-rectangle (start end)
-  "Delete rectangle with corners at point and mark; save as last killed one.
-Calling from program, supply two args START and END, buffer positions.
-But in programs you might prefer to use `delete-extract-rectangle'."
-  (interactive "r")
-  (if buffer-read-only
-      (progn
-	(setq killed-rectangle (extract-rectangle start end))
-	(barf-if-buffer-read-only)))
-  (setq killed-rectangle (delete-extract-rectangle start end)))
-
-;;;###autoload
-(defun yank-rectangle ()
-  "Yank the last killed rectangle with upper left corner at point."
-  (interactive)
-  (insert-rectangle killed-rectangle))
-
-;;;###autoload
-(defun insert-rectangle (rectangle)
-  "Insert text of RECTANGLE with upper left corner at point.
-RECTANGLE's first line is inserted at point, its second
-line is inserted at a point vertically under point, etc.
-RECTANGLE should be a list of strings.
-After this command, the mark is at the upper left corner
-and point is at the lower right corner."
-  (let ((lines rectangle)
-	(insertcolumn (current-column))
-	(first t))
-    (push-mark)
-    (while lines
-      (or first
-	  (progn
-	   (forward-line 1)
-	   (or (bolp) (insert ?\n))
-	   (move-to-column insertcolumn t)))
-      (setq first nil)
-      (insert (car lines))
-      (setq lines (cdr lines)))))
-
-;;;###autoload
-(defun open-rectangle (start end)
-  "Blank out rectangle with corners at point and mark, shifting text right.
-The text previously in the region is not overwritten by the blanks,
-but instead winds up to the right of the rectangle."
-  (interactive "r")
-  (operate-on-rectangle 'open-rectangle-line start end nil)
-  (goto-char start))
-
-(defun open-rectangle-line (startpos begextra endextra)
-  ;; Column where rectangle ends.
-  (let ((endcol (+ (current-column) endextra))
-	whitewidth)
-    (goto-char startpos)
-    ;; Column where rectangle begins.
-    (let ((begcol (- (current-column) begextra)))
-      (skip-chars-forward " \t")
-      ;; Width of whitespace to be deleted and recreated.
-      (setq whitewidth (- (current-column) begcol)))
-    ;; Delete the whitespace following the start column.
-    (delete-region startpos (point))
-    ;; Open the desired width, plus same amount of whitespace we just deleted.
-    (indent-to (+ endcol whitewidth))))
-
-;;;###autoload
-(defun string-rectangle (start end string)
-  "Insert STRING on each line of the region-rectangle, shifting text right.
-The left edge of the rectangle specifies the column for insertion.
-This command does not delete or overwrite any existing text.
-
-Called from a program, takes three args; START, END and STRING."
-  (interactive "r\nsString rectangle: ")
-  (operate-on-rectangle 'string-rectangle-line start end t))
-
-(defun string-rectangle-line (startpos begextra endextra)
-  (let (whitespace)
-    (goto-char startpos)
-    ;; Compute horizontal width of following whitespace.
-    (let ((ocol (current-column)))
-      (skip-chars-forward " \t")
-      (setq whitespace (- (current-column) ocol)))
-    ;; Delete the following whitespace.
-    (delete-region startpos (point))
-    ;; Insert the desired string.
-    (insert string)
-    ;; Insert the same width of whitespace that we had before.
-    (indent-to (+ (current-column) whitespace))))
-
-;;;###autoload
-(defun clear-rectangle (start end)
-  "Blank out rectangle with corners at point and mark.
-The text previously in the region is overwritten by the blanks.
-When called from a program, requires two args which specify the corners."
-  (interactive "r")
-  (operate-on-rectangle 'clear-rectangle-line start end t))
-
-(defun clear-rectangle-line (startpos begextra endextra)
-  ;; Find end of whitespace after the rectangle.
-  (skip-chars-forward " \t")
-  (let ((column (+ (current-column) endextra)))
-    ;; Delete the text in the rectangle, and following whitespace.
-    (delete-region (point)
-                   (progn (goto-char startpos)
-			  (skip-chars-backward " \t")
-			  (point)))
-    ;; Reindent out to same column that we were at.
-    (indent-to column)))
-
-(provide 'rect)
-
-;;; rect.el ends here
diff --git a/lisp/regi.el b/lisp/regi.el
deleted file mode 100644
index 81674d19988..00000000000
--- a/lisp/regi.el
+++ /dev/null
@@ -1,255 +0,0 @@
-;;; 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.
-
-;;; 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/register.el b/lisp/register.el
deleted file mode 100644
index 32cd981bdca..00000000000
--- a/lisp/register.el
+++ /dev/null
@@ -1,272 +0,0 @@
-;;; register.el --- register commands for Emacs.
-
-;; Copyright (C) 1985, 1993, 1994 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 package of functions emulates and somewhat extends the venerable
-;; TECO's `register' feature, which permits you to save various useful
-;; pieces of buffer state to named variables.  The entry points are
-;; documented in the Emacs user's manual.
-
-;;; Code:
-
-(defvar register-alist nil
-  "Alist of elements (NAME . CONTENTS), one for each Emacs register.
-NAME is a character (a number).  CONTENTS is a string, number,
-frame configuration, mark or list.
-A list of strings represents a rectangle.
-A list of the form (file . NAME) represents the file named NAME.
-A list of the form (file-query NAME POSITION) represents position POSITION
- in the file named NAME, but query before visiting it.")
-
-(defun get-register (reg)
-  "Return contents of Emacs register named REG, or nil if none."
-  (cdr (assq reg register-alist)))
-
-(defun set-register (register value)
-  "Set contents of Emacs register named REGISTER to VALUE.  Returns VALUE.
-See the documentation of the variable `register-alist' for possible VALUE."
-  (let ((aelt (assq register register-alist)))
-    (if aelt
-	(setcdr aelt value)
-      (setq aelt (cons register value))
-      (setq register-alist (cons aelt register-alist)))
-    value))
-
-(defun point-to-register (register &optional arg)
-  "Store current location of point in register REGISTER.
-With prefix argument, store current frame configuration.
-Use \\[jump-to-register] to go to that location or restore that configuration.
-Argument is a character, naming the register."
-  (interactive "cPoint to register: \nP")
-  (set-register register
-		(if arg (current-frame-configuration) (point-marker))))
-
-(defun window-configuration-to-register (register &optional arg)
-  "Store the window configuration of the selected frame in register REGISTER.
-Use \\[jump-to-register] to restore the configuration.
-Argument is a character, naming the register."
-  (interactive "cWindow configuration to register: \nP")
-  (set-register register (current-window-configuration)))
-
-(defun frame-configuration-to-register (register &optional arg)
-  "Store the window configuration of all frames in register REGISTER.
-Use \\[jump-to-register] to restore the configuration.
-Argument is a character, naming the register."
-  (interactive "cFrame configuration to register: \nP")
-  (set-register register (current-frame-configuration)))
-
-(defalias 'register-to-point 'jump-to-register)
-(defun jump-to-register (register &optional delete)
-  "Move point to location stored in a register.
-If the register contains a file name, find that file.
- \(To put a file name in a register, you must use `set-register'.)
-If the register contains a window configuration (one frame) or a frame
-configuration (all frames), restore that frame or all frames accordingly.
-First argument is a character, naming the register.
-Optional second arg non-nil (interactively, prefix argument) says to
-delete any existing frames that the frame configuration doesn't mention.
-\(Otherwise, these frames are iconified.)"
-  (interactive "cJump to register: \nP")
-  (let ((val (get-register register)))
-    (cond
-     ((and (fboundp 'frame-configuration-p)
-	   (frame-configuration-p val))
-      (set-frame-configuration val (not delete)))
-     ((window-configuration-p val)
-      (set-window-configuration val))
-     ((markerp val)
-      (or (marker-buffer val)
-	  (error "That register's buffer no longer exists"))
-      (switch-to-buffer (marker-buffer val))
-      (goto-char val))
-     ((and (consp val) (eq (car val) 'file))
-      (find-file (cdr val)))
-     ((and (consp val) (eq (car val) 'file-query))
-      (or (find-buffer-visiting (nth 1 val))
-	  (y-or-n-p (format "Visit file %s again? " (nth 1 val)))
-	  (error "Register access aborted"))
-      (find-file (nth 1 val))
-      (goto-char (nth 2 val)))
-     (t
-      (error "Register doesn't contain a buffer position or configuration")))))
-
-;; Turn markers into file-query references when a buffer is killed.
-(defun register-swap-out ()
-  (and buffer-file-name
-       (let ((tail register-alist))
-	 (while tail
-	   (and (markerp (cdr (car tail)))
-		(eq (marker-buffer (cdr (car tail))) (current-buffer))
-		(setcdr (car tail)
-			(list 'file-query
-			      buffer-file-name
-			      (marker-position (cdr (car tail))))))
-	   (setq tail (cdr tail))))))
-
-(add-hook 'kill-buffer-hook 'register-swap-out)
-
-;(defun number-to-register (arg char)
-;  "Store a number in a register.
-;Two args, NUMBER and REGISTER (a character, naming the register).
-;If NUMBER is nil, digits in the buffer following point are read
-;to get the number to store.
-;Interactively, NUMBER is the prefix arg (none means nil)."
-;  (interactive "P\ncNumber to register: ")
-;  (set-register char 
-;		(if arg
-;		    (prefix-numeric-value arg)
-;		  (if (looking-at "[0-9][0-9]*")
-;		      (save-excursion
-;		       (save-restriction
-;			(narrow-to-region (point)
-;					  (progn (skip-chars-forward "0-9")
-;						 (point)))
-;			(goto-char (point-min))
-;			(read (current-buffer))))
-;		    0))))
-
-;(defun increment-register (arg char)
-;  "Add NUMBER to the contents of register REGISTER.
-;Interactively, NUMBER is the prefix arg (none means nil)." 
-;  (interactive "p\ncNumber to register: ")
-;  (or (integerp (get-register char))
-;      (error "Register does not contain a number"))
-;  (set-register char (+ arg (get-register char))))
-
-(defun view-register (register)
-  "Display what is contained in register named REGISTER.
-The Lisp value REGISTER is a character."
-  (interactive "cView register: ")
-  (let ((val (get-register register)))
-    (if (null val)
-	(message "Register %s is empty" (single-key-description register))
-      (with-output-to-temp-buffer "*Output*"
-	(princ "Register ")
-	(princ (single-key-description register))
-	(princ " contains ")
-	(cond
-	 ((integerp val)
-	  (princ val))
-
-	 ((markerp val)
-	  (let ((buf (marker-buffer val)))
-	    (if (null buf)
-		(princ "a marker in no buffer")
-	      (princ "a buffer position:\nbuffer ")
-	      (princ (buffer-name buf))
-	      (princ ", position ")
-	      (princ (marker-position val)))))
-
-	 ((window-configuration-p val)
-	  (princ "a window configuration."))
-
-	 ((frame-configuration-p val)
-	  (princ "a frame configuration."))
-
-	 ((and (consp val) (eq (car val) 'file))
-	  (princ "the file ")
-	  (prin1 (cdr val))
-	  (princ "."))
-
-	 ((consp val)
-	  (princ "the rectangle:\n")
-	  (while val
-	    (princ (car val))
-	    (terpri)
-	    (setq val (cdr val))))
-
-	 ((stringp val)
-	  (princ "the text:\n")
-	  (princ val))
-
-	 (t
-	  (princ "Garbage:\n")
-	  (prin1 val)))))))
-
-(defun insert-register (register &optional arg)
-  "Insert contents of register REGISTER.  (REGISTER is a character.)
-Normally puts point before and mark after the inserted text.
-If optional second arg is non-nil, puts mark before and point after.
-Interactively, second arg is non-nil if prefix arg is supplied."
-  (interactive "*cInsert register: \nP")
-  (push-mark)
-  (let ((val (get-register register)))
-    (cond
-     ((consp val)
-      (insert-rectangle val))
-     ((stringp val)
-      (insert val))
-     ((integerp val)
-      (princ val (current-buffer)))
-     ((and (markerp val) (marker-position val))
-      (princ (marker-position val) (current-buffer)))
-     (t
-      (error "Register does not contain text"))))
-  (if (not arg) (exchange-point-and-mark)))
-
-(defun copy-to-register (register start end &optional delete-flag)
-  "Copy region into register REGISTER.  With prefix arg, delete as well.
-Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
-START and END are buffer positions indicating what to copy."
-  (interactive "cCopy to register: \nr\nP")
-  (set-register register (buffer-substring start end))
-  (if delete-flag (delete-region start end)))
-
-(defun append-to-register (register start end &optional delete-flag)
-  "Append region to text in register REGISTER.
-With prefix arg, delete as well.
-Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
-START and END are buffer positions indicating what to append."
-  (interactive "cAppend to register: \nr\nP")
-  (or (stringp (get-register register))
-      (error "Register does not contain text"))
-  (set-register register (concat (get-register register)
-			    (buffer-substring start end)))
-  (if delete-flag (delete-region start end)))
-
-(defun prepend-to-register (register start end &optional delete-flag)
-  "Prepend region to text in register REGISTER.
-With prefix arg, delete as well.
-Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
-START and END are buffer positions indicating what to prepend."
-  (interactive "cPrepend to register: \nr\nP")
-  (or (stringp (get-register register))
-      (error "Register does not contain text"))
-  (set-register register (concat (buffer-substring start end)
-			    (get-register register)))
-  (if delete-flag (delete-region start end)))
-
-(defun copy-rectangle-to-register (register start end &optional delete-flag)
-  "Copy rectangular region into register REGISTER.
-With prefix arg, delete as well.
-Called from program, takes four args: REGISTER, START, END and DELETE-FLAG.
-START and END are buffer positions giving two corners of rectangle."
-  (interactive "cCopy rectangle to register: \nr\nP")
-  (set-register register
-		(if delete-flag
-		    (delete-extract-rectangle start end)
-		  (extract-rectangle start end))))
-
-;;; register.el ends here
diff --git a/lisp/replace.el b/lisp/replace.el
deleted file mode 100644
index 95b791aec39..00000000000
--- a/lisp/replace.el
+++ /dev/null
@@ -1,741 +0,0 @@
-;;; replace.el --- replace commands for Emacs.
-
-;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1996 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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 supplies the string and regular-expression replace functions
-;; documented in the Emacs user's manual.
-
-;;; Code:
-
-(defvar case-replace t "\
-*Non-nil means query-replace should preserve case in replacements.")
-
-(defvar query-replace-history nil)
-
-(defvar query-replace-interactive nil
-  "Non-nil means `query-replace' uses the last search string.
-That becomes the \"string to replace\".")
-
-(defun query-replace-read-args (string regexp-flag)
-  (let (from to)
-    (if query-replace-interactive
-	(setq from (car (if regexp-flag regexp-search-ring search-ring)))
-      (setq from (read-from-minibuffer (format "%s: " string)
-				       nil nil nil
-				       'query-replace-history)))
-    (setq to (read-from-minibuffer (format "%s %s with: " string from)
-				   nil nil nil
-				   'query-replace-history))
-    (list from to current-prefix-arg)))
-
-(defun query-replace (from-string to-string &optional arg)
-  "Replace some occurrences of FROM-STRING with TO-STRING.
-As each match is found, the user must type a character saying
-what to do with it.  For directions, type \\[help-command] at that time.
-
-If `query-replace-interactive' is non-nil, the last incremental search
-string is used as FROM-STRING--you don't have to specify it with the
-minibuffer.
-
-Preserves case in each replacement if `case-replace' and `case-fold-search'
-are non-nil and FROM-STRING has no uppercase letters.
-\(Preserving case means that if the string matched is all caps, or capitalized,
-then its replacement is upcased or capitalized.)
-
-Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
-only matches surrounded by word boundaries.
-
-To customize possible responses, change the \"bindings\" in `query-replace-map'."
-  (interactive (query-replace-read-args "Query replace" nil))
-  (perform-replace from-string to-string t nil arg))
-(define-key esc-map "%" 'query-replace)
-
-(defun query-replace-regexp (regexp to-string &optional arg)
-  "Replace some things after point matching REGEXP with TO-STRING.
-As each match is found, the user must type a character saying
-what to do with it.  For directions, type \\[help-command] at that time.
-
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the
-minibuffer.
-
-Preserves case in each replacement if `case-replace' and `case-fold-search'
-are non-nil and REGEXP has no uppercase letters.
-Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
-only matches surrounded by word boundaries.
-In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
-and `\\=\\N' (where N is a digit) stands for
- whatever what matched the Nth `\\(...\\)' in REGEXP."
-  (interactive (query-replace-read-args "Query replace regexp" t))
-  (perform-replace regexp to-string t t arg))
-
-(defun map-query-replace-regexp (regexp to-strings &optional arg)
-  "Replace some matches for REGEXP with various strings, in rotation.
-The second argument TO-STRINGS contains the replacement strings, separated
-by spaces.  This command works like `query-replace-regexp' except
-that each successive replacement uses the next successive replacement string,
-wrapping around from the last such string to the first.
-
-Non-interactively, TO-STRINGS may be a list of replacement strings.
-
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the minibuffer.
-
-A prefix argument N says to use each replacement string N times
-before rotating to the next."
-  (interactive
-   (let (from to)
-     (setq from (if query-replace-interactive
-		    (car regexp-search-ring)
-		  (read-from-minibuffer "Map query replace (regexp): "
-					nil nil nil
-					'query-replace-history)))
-     (setq to (read-from-minibuffer
-	       (format "Query replace %s with (space-separated strings): "
-		       from)
-	       nil nil nil
-	       'query-replace-history))
-     (list from to current-prefix-arg)))
-  (let (replacements)
-    (if (listp to-strings)
-	(setq replacements to-strings)
-      (while (/= (length to-strings) 0)
-	(if (string-match " " to-strings)
-	    (setq replacements
-		  (append replacements
-			  (list (substring to-strings 0
-					   (string-match " " to-strings))))
-		  to-strings (substring to-strings
-				       (1+ (string-match " " to-strings))))
-	  (setq replacements (append replacements (list to-strings))
-		to-strings ""))))
-    (perform-replace regexp replacements t t nil arg)))
-
-(defun replace-string (from-string to-string &optional delimited)
-  "Replace occurrences of FROM-STRING with TO-STRING.
-Preserve case in each match if `case-replace' and `case-fold-search'
-are non-nil and FROM-STRING has no uppercase letters.
-\(Preserving case means that if the string matched is all caps, or capitalized,
-then its replacement is upcased or capitalized.)
-
-Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
-only matches surrounded by word boundaries.
-
-If `query-replace-interactive' is non-nil, the last incremental search
-string is used as FROM-STRING--you don't have to specify it with the
-minibuffer.
-
-This function is usually the wrong thing to use in a Lisp program.
-What you probably want is a loop like this:
-  (while (search-forward FROM-STRING nil t)
-    (replace-match TO-STRING nil t))
-which will run faster and will not set the mark or print anything."
-  (interactive (query-replace-read-args "Replace string" nil))
-  (perform-replace from-string to-string nil nil delimited))
-
-(defun replace-regexp (regexp to-string &optional delimited)
-  "Replace things after point matching REGEXP with TO-STRING.
-Preserve case in each match if `case-replace' and `case-fold-search'
-are non-nil and REGEXP has no uppercase letters.
-Third arg DELIMITED (prefix arg if interactive), if non-nil, means replace
-only matches surrounded by word boundaries.
-In TO-STRING, `\\&' stands for whatever matched the whole of REGEXP,
-and `\\=\\N' (where N is a digit) stands for
- whatever what matched the Nth `\\(...\\)' in REGEXP.
-
-If `query-replace-interactive' is non-nil, the last incremental search
-regexp is used as REGEXP--you don't have to specify it with the minibuffer.
-
-This function is usually the wrong thing to use in a Lisp program.
-What you probably want is a loop like this:
-  (while (re-search-forward REGEXP nil t)
-    (replace-match TO-STRING nil nil))
-which will run faster and will not set the mark or print anything."
-  (interactive (query-replace-read-args "Replace regexp" t))
-  (perform-replace regexp to-string nil t delimited))
-
-(defvar regexp-history nil
-  "History list for some commands that read regular expressions.")
-
-(defalias 'delete-non-matching-lines 'keep-lines)
-(defun keep-lines (regexp)
-  "Delete all lines except those containing matches for REGEXP.
-A match split across lines preserves all the lines it lies in.
-Applies to all lines after point."
-  (interactive (list (read-from-minibuffer
-		      "Keep lines (containing match for regexp): "
-		      nil nil nil 'regexp-history)))
-  (save-excursion
-    (or (bolp) (forward-line 1))
-    (let ((start (point)))
-      (while (not (eobp))
-	;; Start is first char not preserved by previous match.
-	(if (not (re-search-forward regexp nil 'move))
-	    (delete-region start (point-max))
-	  (let ((end (save-excursion (goto-char (match-beginning 0))
-				     (beginning-of-line)
-				     (point))))
-	    ;; Now end is first char preserved by the new match.
-	    (if (< start end)
-		(delete-region start end))))
-	(setq start (save-excursion (forward-line 1)
-				    (point)))
-	;; If the match was empty, avoid matching again at same place.
-	(and (not (eobp)) (= (match-beginning 0) (match-end 0))
-	     (forward-char 1))))))
-
-(defalias 'delete-matching-lines 'flush-lines)
-(defun flush-lines (regexp)
-  "Delete lines containing matches for REGEXP.
-If a match is split across lines, all the lines it lies in are deleted.
-Applies to lines after point."
-  (interactive (list (read-from-minibuffer
-		      "Flush lines (containing match for regexp): "
-		      nil nil nil 'regexp-history)))
-  (save-excursion
-    (while (and (not (eobp))
-		(re-search-forward regexp nil t))
-      (delete-region (save-excursion (goto-char (match-beginning 0))
-				     (beginning-of-line)
-				     (point))
-		     (progn (forward-line 1) (point))))))
-
-(defalias 'count-matches 'how-many)
-(defun how-many (regexp)
-  "Print number of matches for REGEXP following point."
-  (interactive (list (read-from-minibuffer
-		      "How many matches for (regexp): "
-		      nil nil nil 'regexp-history)))
-  (let ((count 0) opoint)
-    (save-excursion
-     (while (and (not (eobp))
-		 (progn (setq opoint (point))
-			(re-search-forward regexp nil t)))
-       (if (= opoint (point))
-	   (forward-char 1)
-	 (setq count (1+ count))))
-     (message "%d occurrences" count))))
-
-(defvar occur-mode-map ())
-(if occur-mode-map
-    ()
-  (setq occur-mode-map (make-sparse-keymap))
-  (define-key occur-mode-map [mouse-2] 'occur-mode-mouse-goto)
-  (define-key occur-mode-map "\C-c\C-c" 'occur-mode-goto-occurrence)
-  (define-key occur-mode-map "\C-m" 'occur-mode-goto-occurrence))
-
-(defvar occur-buffer nil)
-(defvar occur-nlines nil)
-(defvar occur-pos-list nil)
-
-(defun occur-mode ()
-  "Major mode for output from \\[occur].
-\\<occur-mode-map>Move point to one of the items in this buffer, then use
-\\[occur-mode-goto-occurrence] to go to the occurrence that the item refers to.
-Alternatively, click \\[occur-mode-mouse-goto] on an item to go to it.
-
-\\{occur-mode-map}"
-  (kill-all-local-variables)
-  (use-local-map occur-mode-map)
-  (setq major-mode 'occur-mode)
-  (setq mode-name "Occur")
-  (make-local-variable 'occur-buffer)
-  (make-local-variable 'occur-nlines)
-  (make-local-variable 'occur-pos-list)
-  (run-hooks 'occur-mode-hook))
-
-(defun occur-mode-mouse-goto (event)
-  "In Occur mode, go to the occurrence whose line you click on."
-  (interactive "e")
-  (let (buffer pos)
-    (save-excursion
-      (set-buffer (window-buffer (posn-window (event-end event))))
-      (save-excursion
-	(goto-char (posn-point (event-end event)))
-	(setq pos (occur-mode-find-occurrence))
-	(setq buffer occur-buffer)))
-    (pop-to-buffer buffer)
-    (goto-char (marker-position pos))))
-
-(defun occur-mode-find-occurrence ()
-  (if (or (null occur-buffer)
-	  (null (buffer-name occur-buffer)))
-      (progn
-	(setq occur-buffer nil
-	      occur-pos-list nil)
-	(error "Buffer in which occurrences were found is deleted")))
-  (let* ((line-count
-	  (count-lines (point-min)
-		       (save-excursion
-			 (beginning-of-line)
-			 (point))))
-	 (occur-number (save-excursion
-			 (beginning-of-line)
-			 (/ (1- line-count)
-			    (cond ((< occur-nlines 0)
-				   (- 2 occur-nlines))
-				  ((> occur-nlines 0)
-				   (+ 2 (* 2 occur-nlines)))
-				  (t 1)))))
-	 (pos (nth occur-number occur-pos-list)))
-    (if (< line-count 1)
-	(error "No occurrence on this line"))
-    (or pos
-	(error "No occurrence on this line"))
-    pos))
-
-(defun occur-mode-goto-occurrence ()
-  "Go to the occurrence the current line describes."
-  (interactive)
-  (let ((pos (occur-mode-find-occurrence)))
-    (pop-to-buffer occur-buffer)
-    (goto-char (marker-position pos))))
-
-(defvar list-matching-lines-default-context-lines 0
-  "*Default number of context lines to include around a `list-matching-lines'
-match.  A negative number means to include that many lines before the match.
-A positive number means to include that many lines both before and after.")
-
-(defalias 'list-matching-lines 'occur)
-
-(defvar list-matching-lines-face 'bold
-  "*Face used by M-x list-matching-lines to show the text that matches.
-If the value is nil, don't highlight the matching portions specially.")
-
-(defun occur (regexp &optional nlines)
-  "Show all lines in the current buffer containing a match for REGEXP.
-
-If a match spreads across multiple lines, all those lines are shown.
-
-Each line is displayed with NLINES lines before and after, or -NLINES
-before if NLINES is negative.
-NLINES defaults to `list-matching-lines-default-context-lines'.
-Interactively it is the prefix arg.
-
-The lines are shown in a buffer named `*Occur*'.
-It serves as a menu to find any of the occurrences in this buffer.
-\\[describe-mode] in that buffer will explain how."
-  (interactive
-   (list (let* ((default (car regexp-history))
-		(input
-		 (read-from-minibuffer
-		  (if default
-		      (format "List lines matching regexp (default `%s'): "
-			      default)
-		    "List lines matching regexp: ")
-		  nil nil nil 'regexp-history)))
-	   (if (string-equal input "")
-	       default
-	     (set-text-properties 0 (length input) nil input)
-	     input))
-	 current-prefix-arg))
-  (let ((nlines (if nlines
-		    (prefix-numeric-value nlines)
-		  list-matching-lines-default-context-lines))
-	(first t)
-	(buffer (current-buffer))
-	(dir default-directory)
-	(linenum 1)
-	(prevpos (point-min))
-	(final-context-start (make-marker)))
-;;;	(save-excursion
-;;;	  (beginning-of-line)
-;;;	  (setq linenum (1+ (count-lines (point-min) (point))))
-;;;	  (setq prevpos (point)))
-    (save-excursion
-      (goto-char (point-min))
-      ;; Check first whether there are any matches at all.
-      (if (not (re-search-forward regexp nil t))
-	  (message "No matches for `%s'" regexp)
-	;; Back up, so the search loop below will find the first match.
-	(goto-char (match-beginning 0))
-	(with-output-to-temp-buffer "*Occur*"
-	  (save-excursion
-	    (set-buffer standard-output)
-	    (setq default-directory dir)
-	    ;; We will insert the number of lines, and "lines", later.
-	    (insert " matching ")
-	    (let ((print-escape-newlines t))
-	      (prin1 regexp))
-	    (insert " in buffer " (buffer-name buffer) ?. ?\n)
-	    (occur-mode)
-	    (setq occur-buffer buffer)
-	    (setq occur-nlines nlines)
-	    (setq occur-pos-list ()))
-	  (if (eq buffer standard-output)
-	      (goto-char (point-max)))
-	  (save-excursion
-	    ;; Find next match, but give up if prev match was at end of buffer.
-	    (while (and (not (= prevpos (point-max)))
-			(re-search-forward regexp nil t))
-	      (goto-char (match-beginning 0))
-	      (beginning-of-line)
-	      (save-match-data
-		(setq linenum (+ linenum (count-lines prevpos (point)))))
-	      (setq prevpos (point))
-	      (goto-char (match-end 0))
-	      (let* ((start (save-excursion
-			      (goto-char (match-beginning 0))
-			      (forward-line (if (< nlines 0) nlines (- nlines)))
-			      (point)))
-		     (end (save-excursion
-			    (goto-char (match-end 0))
-			    (if (> nlines 0)
-				(forward-line (1+ nlines))
-				(forward-line 1))
-			    (point)))
-		     ;; Record where the actual match 
-		     (match-offset
-		      (save-excursion
-			(goto-char (match-beginning 0))
-			(beginning-of-line)
-			;; +6 to skip over line number
-			(+ 6 (- (match-beginning 0) (point)))))
-		     (match-len (- (match-end 0) (match-beginning 0)))
-		     (tag (format "%5d" linenum))
-		     (empty (make-string (length tag) ?\ ))
-		     tem)
-		(save-excursion
-		  (setq tem (make-marker))
-		  (set-marker tem (point))
-		  (set-buffer standard-output)
-		  (setq occur-pos-list (cons tem occur-pos-list))
-		  (or first (zerop nlines)
-		      (insert "--------\n"))
-		  (setq first nil)
-		  (insert-buffer-substring buffer start end)
-		  (set-marker final-context-start 
-			      (- (point) (- end (match-end 0))))
-		  (backward-char (- end start))
-		  (setq tem nlines)
-		  (while (> tem 0)
-		    (insert empty ?:)
-		    (forward-line 1)
-		    (setq tem (1- tem)))
-		  (let ((this-linenum linenum)
-			line-start)
-		    (while (< (point) final-context-start)
-		      (if (null tag)
-			  (setq tag (format "%5d" this-linenum)))
-		      (insert tag ?:)
-		      (setq line-start
-			    (save-excursion
-			      (beginning-of-line)
-			      (point)))
-		      (put-text-property line-start
-					 (save-excursion
-					   (end-of-line)
-					   (point))
-					 'mouse-face 'highlight)
-		      (if list-matching-lines-face
-			  (put-text-property
-			   (+ line-start match-offset)
-			   (+ line-start match-offset match-len)
-			   'face list-matching-lines-face))
-		      (forward-line 1)
-		      (setq tag nil)
-		      (setq this-linenum (1+ this-linenum)))
-		    (while (<= (point) final-context-start)
-		      (insert empty ?:)
-		      (forward-line 1)
-		      (setq this-linenum (1+ this-linenum))))
-		  (while (< tem nlines)
-		    (insert empty ?:)
-		    (forward-line 1)
-		    (setq tem (1+ tem)))
-		  (goto-char (point-max)))
-		(forward-line 1)))
-	    (set-buffer standard-output)
-	    ;; Put positions in increasing order to go with buffer.
-	    (setq occur-pos-list (nreverse occur-pos-list))
-	    (goto-char (point-min))
-	    (let ((message-string
-		   (if (= (length occur-pos-list) 1)
-		       "1 line"
-		     (format "%d lines" (length occur-pos-list)))))
-	      (insert message-string)
-	      (if (interactive-p)
-		  (message "%s matched" message-string)))))))))
-
-;; It would be nice to use \\[...], but there is no reasonable way
-;; to make that display both SPC and Y.
-(defconst query-replace-help
-  "Type Space or `y' to replace one match, Delete or `n' to skip to next,
-RET or `q' to exit, Period to replace one match and exit,
-Comma to replace but not move point immediately,
-C-r to enter recursive edit (\\[exit-recursive-edit] to get out again),
-C-w to delete match and recursive edit,
-C-l to clear the screen, redisplay, and offer same replacement again,
-! to replace all remaining matches with no more questions,
-^ to move point back to previous match."
-  "Help message while in query-replace")
-
-(defvar query-replace-map (make-sparse-keymap)
-  "Keymap that defines the responses to questions in `query-replace'.
-The \"bindings\" in this map are not commands; they are answers.
-The valid answers include `act', `skip', `act-and-show',
-`exit', `act-and-exit', `edit', `delete-and-edit', `recenter',
-`automatic', `backup', `exit-prefix', and `help'.")
-
-(define-key query-replace-map " " 'act)
-(define-key query-replace-map "\d" 'skip)
-(define-key query-replace-map [delete] 'skip)
-(define-key query-replace-map [backspace] 'skip)
-(define-key query-replace-map "y" 'act)
-(define-key query-replace-map "n" 'skip)
-(define-key query-replace-map "Y" 'act)
-(define-key query-replace-map "N" 'skip)
-(define-key query-replace-map "," 'act-and-show)
-(define-key query-replace-map "q" 'exit)
-(define-key query-replace-map "\r" 'exit)
-(define-key query-replace-map [return] 'exit)
-(define-key query-replace-map "." 'act-and-exit)
-(define-key query-replace-map "\C-r" 'edit)
-(define-key query-replace-map "\C-w" 'delete-and-edit)
-(define-key query-replace-map "\C-l" 'recenter)
-(define-key query-replace-map "!" 'automatic)
-(define-key query-replace-map "^" 'backup)
-(define-key query-replace-map "\C-h" 'help)
-(define-key query-replace-map [f1] 'help)
-(define-key query-replace-map [help] 'help)
-(define-key query-replace-map "?" 'help)
-(define-key query-replace-map "\C-g" 'quit)
-(define-key query-replace-map "\C-]" 'quit)
-(define-key query-replace-map "\e" 'exit-prefix)
-(define-key query-replace-map [escape] 'exit-prefix)
-
-(defun perform-replace (from-string replacements
-		        query-flag regexp-flag delimited-flag
-			&optional repeat-count map)
-  "Subroutine of `query-replace'.  Its complexity handles interactive queries.
-Don't use this in your own program unless you want to query and set the mark
-just as `query-replace' does.  Instead, write a simple loop like this:
-  (while (re-search-forward \"foo[ \t]+bar\" nil t)
-    (replace-match \"foobar\" nil nil))
-which will run faster and probably do exactly what you want."
-  (or map (setq map query-replace-map))
-  (and query-flag minibuffer-auto-raise
-       (raise-frame (window-frame (minibuffer-window))))
-  (let ((nocasify (not (and case-fold-search case-replace
-			    (string-equal from-string
-					  (downcase from-string)))))
-	(literal (not regexp-flag))
-	(search-function (if regexp-flag 're-search-forward 'search-forward))
-	(search-string from-string)
-	(real-match-data nil)		; the match data for the current match
-	(next-replacement nil)
-	(replacement-index 0)
-	(keep-going t)
-	(stack nil)
-	(next-rotate-count 0)
-	(replace-count 0)
-	(lastrepl nil)			;Position after last match considered.
-	(match-again t)
-	(message
-	 (if query-flag
-	     (substitute-command-keys
-	      "Query replacing %s with %s: (\\<query-replace-map>\\[help] for help) "))))
-    (if (stringp replacements)
-	(setq next-replacement replacements)
-      (or repeat-count (setq repeat-count 1)))
-    (if delimited-flag
-	(setq search-function 're-search-forward
-	      search-string (concat "\\b"
-				    (if regexp-flag from-string
-				      (regexp-quote from-string))
-				    "\\b")))
-    (push-mark)
-    (undo-boundary)
-    (unwind-protect
-	;; Loop finding occurrences that perhaps should be replaced.
-	(while (and keep-going
-		    (not (eobp))
-		    (funcall search-function search-string nil t)
-		    ;; If the search string matches immediately after
-		    ;; the previous match, but it did not match there
-		    ;; before the replacement was done, ignore the match.
-		    (if (or (eq lastrepl (point))
-			    (and regexp-flag
-				 (eq lastrepl (match-beginning 0))
-				 (not match-again)))
-			(if (eobp)
-			    nil
-			  ;; Don't replace the null string 
-			  ;; right after end of previous replacement.
-			  (forward-char 1)
-			  (funcall search-function search-string nil t))
-		      t))
-
-	  ;; Save the data associated with the real match.
-	  ;; For speed, use only integers and reuse the list used last time.
-	  (setq real-match-data (match-data t real-match-data))
-
-	  ;; Before we make the replacement, decide whether the search string
-	  ;; can match again just after this match.
-	  (if regexp-flag
-	      (setq match-again (looking-at search-string)))
-	  ;; If time for a change, advance to next replacement string.
-	  (if (and (listp replacements)
-		   (= next-rotate-count replace-count))
-	      (progn
-		(setq next-rotate-count
-		      (+ next-rotate-count repeat-count))
-		(setq next-replacement (nth replacement-index replacements))
-		(setq replacement-index (% (1+ replacement-index) (length replacements)))))
-	  (if (not query-flag)
-	      (progn
-		(store-match-data real-match-data)
-		(replace-match next-replacement nocasify literal)
-		(setq replace-count (1+ replace-count)))
-	    (undo-boundary)
-	    (let (done replaced key def)
-	      ;; Loop reading commands until one of them sets done,
-	      ;; which means it has finished handling this occurrence.
-	      (while (not done)
-		(store-match-data real-match-data)
-		(replace-highlight (match-beginning 0) (match-end 0))
-		;; Bind message-log-max so we don't fill up the message log
-		;; with a bunch of identical messages.
-		(let ((message-log-max nil))
-		  (message message from-string next-replacement))
-		(setq key (read-event))
-		(setq key (vector key))
-		(setq def (lookup-key map key))
-		;; Restore the match data while we process the command.
-		(cond ((eq def 'help)
-		       (with-output-to-temp-buffer "*Help*"
-			 (princ
-			  (concat "Query replacing "
-				  (if regexp-flag "regexp " "")
-				  from-string " with "
-				  next-replacement ".\n\n"
-				  (substitute-command-keys
-				   query-replace-help)))
-			 (save-excursion
-			   (set-buffer standard-output)
-			   (help-mode))))
-		      ((eq def 'exit)
-		       (setq keep-going nil)
-		       (setq done t))
-		      ((eq def 'backup)
-		       (if stack
-			   (let ((elt (car stack)))
-			     (goto-char (car elt))
-			     (setq replaced (eq t (cdr elt)))
-			     (or replaced
-				 (store-match-data (cdr elt)))
-			     (setq stack (cdr stack)))
-			 (message "No previous match")
-			 (ding 'no-terminate)
-			 (sit-for 1)))
-		      ((eq def 'act)
-		       (or replaced
-			   (progn
-			     (replace-match next-replacement nocasify literal)
-			     (setq replace-count (1+ replace-count))))
-		       (setq done t replaced t))
-		      ((eq def 'act-and-exit)
-		       (or replaced
-			   (progn
-			     (replace-match next-replacement nocasify literal)
-			     (setq replace-count (1+ replace-count))))
-		       (setq keep-going nil)
-		       (setq done t replaced t))
-		      ((eq def 'act-and-show)
-		       (if (not replaced)
-			   (progn
-			     (replace-match next-replacement nocasify literal)
-			     (setq replace-count (1+ replace-count))
-			     (setq replaced t))))
-		      ((eq def 'automatic)
-		       (or replaced
-			   (progn
-			     (replace-match next-replacement nocasify literal)
-			     (setq replace-count (1+ replace-count))))
-		       (setq done t query-flag nil replaced t))
-		      ((eq def 'skip)
-		       (setq done t))
-		      ((eq def 'recenter)
-		       (recenter nil))
-		      ((eq def 'edit)
-		       (store-match-data
-			(prog1 (match-data)
-			  (save-excursion (recursive-edit))))
-		       ;; Before we make the replacement,
-		       ;; decide whether the search string
-		       ;; can match again just after this match.
-		       (if regexp-flag
-			   (setq match-again (looking-at search-string))))
-		      ((eq def 'delete-and-edit)
-		       (delete-region (match-beginning 0) (match-end 0))
-		       (store-match-data
-			(prog1 (match-data)
-			  (save-excursion (recursive-edit))))
-		       (setq replaced t))
-		      ;; Note: we do not need to treat `exit-prefix'
-		      ;; specially here, since we reread
-		      ;; any unrecognized character.
-		      (t
-		       (setq this-command 'mode-exited)
-		       (setq keep-going nil)
-		       (setq unread-command-events
-			     (append (listify-key-sequence key)
-				     unread-command-events))
-		       (setq done t))))
-	      ;; Record previous position for ^ when we move on.
-	      ;; Change markers to numbers in the match data
-	      ;; since lots of markers slow down editing.
-	      (setq stack
-		    (cons (cons (point)
-				(or replaced (match-data t)))
-			  stack))))
-	  (setq lastrepl (point)))
-      (replace-dehighlight))
-    (or unread-command-events
-	(message "Replaced %d occurrence%s"
-		 replace-count
-		 (if (= replace-count 1) "" "s")))
-    (and keep-going stack)))
-
-(defvar query-replace-highlight nil
-  "*Non-nil means to highlight words during query replacement.")
-
-(defvar replace-overlay nil)
-
-(defun replace-dehighlight ()
-  (and replace-overlay
-       (progn
-	 (delete-overlay replace-overlay)
-	 (setq replace-overlay nil))))
-
-(defun replace-highlight (start end)
-  (and query-replace-highlight
-       (progn
-	 (or replace-overlay
-	     (progn
-	       (setq replace-overlay (make-overlay start end))
-	       (overlay-put replace-overlay 'face
-			    (if (internal-find-face 'query-replace)
-				'query-replace 'region))))
-	 (move-overlay replace-overlay start end (current-buffer)))))
-
-;;; replace.el ends here
diff --git a/lisp/reposition.el b/lisp/reposition.el
deleted file mode 100644
index cfb6079b93e..00000000000
--- a/lisp/reposition.el
+++ /dev/null
@@ -1,198 +0,0 @@
-;;; reposition.el --- center a Lisp function or comment on the screen
-
-;; Copyright (C) 1991, 1994 Free Software Foundation, Inc.
-
-;; Author: Michael D. Ernst <mernst@theory.lcs.mit.edu>
-;; Created: Jan 1991
-;; 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:
-
-;; Reposition-window makes an entire function definition or comment visible,
-;; or, if it is already visible, places it at the top of the window;
-;; additional invocations toggle the visibility of comments preceding the
-;; code.  For the gory details, see the documentation for reposition-window;
-;; rather than reading that, you may just want to play with it.
-
-;; This tries pretty hard to do the recentering correctly; the precise
-;; action depends on what the buffer looks like.  If you find a situation
-;; where it doesn't behave well, let me know.  This function is modeled
-;; after one of the same name in ZMACS, but the code is all-new and the
-;; behavior in some situations differs.
-
-;;; Code:
-
-;;;###autoload
-(defun reposition-window (&optional arg)
-  "Make the current definition and/or comment visible.
-Further invocations move it to the top of the window or toggle the
-visibility of comments that precede it.
-  Point is left unchanged unless prefix ARG is supplied.
-  If the definition is fully onscreen, it is moved to the top of the
-window.  If it is partly offscreen, the window is scrolled to get the
-definition (or as much as will fit) onscreen, unless point is in a comment
-which is also partly offscreen, in which case the scrolling attempts to get
-as much of the comment onscreen as possible.
-  Initially `reposition-window' attempts to make both the definition and
-preceding comments visible.  Further invocations toggle the visibility of
-the comment lines.
-  If ARG is non-nil, point may move in order to make the whole defun
-visible (if only part could otherwise be made so), to make the defun line
-visible (if point is in code and it could not be made so, or if only
-comments, including the first comment line, are visible), or to make the
-first comment line visible (if point is in a comment)."
-  (interactive "P")
-  (let* (;; (here (save-excursion (beginning-of-line) (point)))
-	 (here (point))
-	 ;; change this name once I've gotten rid of references to ht.
-	 ;; this is actually the number of the last screen line
-	 (ht (- (window-height (selected-window)) 2))
-	 (line (repos-count-screen-lines (window-start) (point)))
-	 (comment-height
-	  ;; The call to max deals with the case of cursor between defuns.
-	  (max 0
-	       (repos-count-screen-lines-signed
-		;; the beginning of the preceding comment
-		(save-excursion
-		  (if (not (eobp)) (forward-char 1))
-		  (end-of-defun -1)
-		  ;; Skip whitespace, newlines, and form feeds.
-		  (if (re-search-forward "[^ \t\n\f]" nil t)
-		      (backward-char 1))
-		  (point))
-		here)))
-	 (defun-height
-	   (repos-count-screen-lines-signed
-	    (save-excursion
-	      (end-of-defun 1) ; so comments associate with following defuns
-	      (beginning-of-defun 1)
-	      (point))
-	    here))
-	 ;; This must be positive, so don't use the signed version.
-	 (defun-depth (repos-count-screen-lines here
-						(save-excursion
-						  (end-of-defun 1)
-						  (point))))
-	 (defun-line-onscreen-p
-	   (and (<= defun-height line)
-		(<= (- line defun-height) ht))))
-    (cond ((or (= comment-height line)
-	       (and (= line ht)
-		    (> comment-height line)
-		    ;; if defun line offscreen, we should be in case 4
-		    defun-line-onscreen-p))
-	   ;; Either first comment line is at top of screen or (point at
-	   ;; bottom of screen, defun line onscreen, and first comment line
-	   ;; off top of screen).  That is, it looks like we just did
-	   ;; recenter-definition, trying to fit as much of the comment
-	   ;; onscreen as possible.  Put defun line at top of screen; that
-	   ;; is, show as much code, and as few comments, as possible.
-
-	   (if (and arg (> defun-depth (1+ ht)))
-	       ;; Can't fit whole defun onscreen without moving point.
-	       (progn (end-of-defun) (beginning-of-defun) (recenter 0))
-	     (recenter (max defun-height 0)))
-	   ;;(repos-debug-macro "1")
-	   )
-
-	  ((or (= defun-height line)
-	       (= line 0)
-	       (and (< line comment-height)
-		    (< defun-height 0)))
-	   ;; Defun line or cursor at top of screen, OR cursor in comment
-	   ;; whose first line is offscreen.
-	   ;; Avoid moving definition up even if defun runs offscreen;
-	   ;; we care more about getting the comment onscreen.
-
-	   (cond ((= line ht)
-		  ;; cursor on last screen line (and so in a comment)
-		  (if arg (progn (end-of-defun) (beginning-of-defun)))
-		  (recenter 0)
-		  ;;(repos-debug-macro "2a")
-		  )
-
-		 ;; This condition, copied from case 4, may not be quite right
-
-		 ((and arg (< ht comment-height))
-		  ;; Can't get first comment line onscreen.
-		  ;; Go there and try again.
-		  (forward-line (- comment-height))
-		  (beginning-of-line)
-		  ;; was (reposition-window)
-		  (recenter 0)
-		  ;;(repos-debug-macro "2b")
-		  )
-		 (t
-		  (recenter (min ht comment-height))
-		  ;;(repos-debug-macro "2c")
-		  ))
-	   ;; (recenter (min ht comment-height))
-	   )
-
-	  ((and (> (+ line defun-depth -1) ht)
-		defun-line-onscreen-p)
-	   ;; Defun runs off the bottom of the screen and the defun line
-	   ;; is onscreen.
-	   ;; Move the defun up.
-	   (recenter (max 0 (1+ (- ht defun-depth)) defun-height))
-	   ;;(repos-debug-macro "3")
-	   )
-
-	  (t
-	   ;; If on the bottom line and comment start is offscreen
-	   ;; then just move all comments offscreen, or at least as
-	   ;; far as they'll go.
-
-	   ;; Try to get as much of the comments onscreen as possible.
-	   (if (and arg (< ht comment-height))
-	       ;; Can't get defun line onscreen; go there and try again.
-	       (progn (forward-line (- defun-height))
-		      (beginning-of-line)
-		      (reposition-window))
-	     (recenter (min ht comment-height)))
-	   ;;(repos-debug-macro "4")
-	   ))))
-
-;;;###autoload (define-key esc-map "\C-l" 'reposition-window)
-
-;;; Auxiliary functions
-
-;; Return number of screen lines between START and END.
-(defun repos-count-screen-lines (start end)
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char (point-min))
-      (vertical-motion (- (point-max) (point-min))))))
-
-;; Return number of screen lines between START and END; returns a negative
-;; number if END precedes START.
-(defun repos-count-screen-lines-signed (start end)
-  (let ((lines (repos-count-screen-lines start end)))
-    (if (< start end)
-	lines
-      (- lines))))
-
-; (defmacro repos-debug-macro (case-no)
-;   (` (message
-;       (concat "Case " (, case-no) ": %s %s %s %s %s")
-;       ht line comment-height defun-height defun-depth)))
-
-;;; reposition.el ends here
diff --git a/lisp/resume.el b/lisp/resume.el
deleted file mode 100644
index 5e14679974d..00000000000
--- a/lisp/resume.el
+++ /dev/null
@@ -1,128 +0,0 @@
-;;; resume.el --- process command line args from within a suspended Emacs job
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Joe Wells <jbw@bucsf.bu.edu>
-;; Adapted-By: ESR
-;; Keywords: processes
-
-;; 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:
-
-;; The purpose of this library is to handle command line arguments
-;; when you resume an existing Emacs job.
-
-;; In order to use it, you must put this code in your .emacs file.
-
-;; (add-hook 'suspend-hook 'resume-suspend-hook)
-;; (add-hook 'suspend-resume-hook 'resume-process-args)
-
-;; You can't get the benefit of this library by using the `emacs' command,
-;; since that always starts a new Emacs job.  Instead you must use a
-;; command called `edit' which knows how to resume an existing Emacs job
-;; if you have one, or start a new Emacs job if you don't have one.
-
-;; To define the `edit' command, run the script etc/emacs.csh (if you use CSH),
-;; or etc/emacs.bash if you use BASH.  You would normally do this in your
-;; login script.
-
-;; Stephan Gildea suggested bug fix (gildea@bbn.com).
-;; Ideas from Michael DeCorte and other people.
-
-;;; Code:
-
-(defvar resume-emacs-args-file (expand-file-name "~/.emacs_args")
-  "*This file is where arguments are placed for a suspended emacs job.")
-
-(defvar resume-emacs-args-buffer " *Command Line Args*"
-  "Buffer that is used by resume-process-args.")
-
-(defun resume-process-args ()
-  "Handler for command line args given when Emacs is resumed."
-  (let ((start-buffer (current-buffer))
-	(args-buffer (get-buffer-create resume-emacs-args-buffer))
-	length args
-	(command-line-default-directory default-directory))
-    (unwind-protect
-	(progn
-	  (set-buffer args-buffer)
-	  (erase-buffer)
-	  ;; get the contents of resume-emacs-args-file
-	  (condition-case ()
-	      (let ((result (insert-file-contents resume-emacs-args-file)))
-		(setq length (car (cdr result))))
-	    ;; the file doesn't exist, ergo no arguments
-	    (file-error
-	      (erase-buffer)
-	      (setq length 0)))
-	  (if (<= length 0)
-	      (setq args nil)
-	    ;; get the arguments from the buffer
-	    (goto-char (point-min))
-	    (while (not (eobp))
-	      (skip-chars-forward " \t\n")
-	      (let ((begin (point)))
-		(skip-chars-forward "^ \t\n")
-		(setq args (cons (buffer-substring begin (point)) args)))
-	      (skip-chars-forward " \t\n"))
-	    ;; arguments are now in reverse order
-	    (setq args (nreverse args))
-	    ;; make sure they're not read again
-	    (erase-buffer))		
-	  (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file)
-	  ;; if nothing was in buffer, args will be null
-	  (or (null args)
-	      (setq command-line-default-directory
-		    (file-name-as-directory (car args))
-		    args (cdr args)))
-	  ;; actually process the arguments
-	  (command-line-1 args))
-      ;; If the command line args don't result in a find-file, the
-      ;; buffer will be left in args-buffer.  So we change back to the
-      ;; original buffer.  The reason I don't just use
-      ;; (let ((default-directory foo))
-      ;;    (command-line-1 args))
-      ;; in the context of the original buffer is because let does not
-      ;; work properly with buffer-local variables.
-      (if (eq (current-buffer) args-buffer)
-	  (set-buffer start-buffer)))))
-
-;;;###autoload
-(defun resume-suspend-hook ()
-  "Clear out the file used for transmitting args when Emacs resumes."
-  (save-excursion
-    (set-buffer (get-buffer-create resume-emacs-args-buffer))
-    (erase-buffer)
-    (resume-write-buffer-to-file (current-buffer) resume-emacs-args-file)))
-
-(defun resume-write-buffer-to-file (buffer file)
-  "Writes the contents of BUFFER into FILE, if permissions allow."
-  (if (not (file-writable-p file))
-      (error "No permission to write file %s" file))
-  (save-excursion
-    (set-buffer buffer)
-    (clear-visited-file-modtime)
-    (save-restriction
-      (widen)
-      (write-region (point-min) (point-max) file nil 'quiet))
-    (set-buffer-modified-p nil)))
-
-(provide 'resume)
-
-;;; resume.el ends here
diff --git a/lisp/rlogin.el b/lisp/rlogin.el
deleted file mode 100644
index a197133d63b..00000000000
--- a/lisp/rlogin.el
+++ /dev/null
@@ -1,335 +0,0 @@
-;;; rlogin.el --- remote login interface
-
-;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Noah Friedman
-;; Maintainer: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Keywords: unix, comm
-
-;; 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.
-
-;; $Id: rlogin.el,v 1.34 1996/06/20 17:30:41 friedman Exp friedman $
-
-;;; Commentary:
-
-;; Support for remote logins using `rlogin'.
-;; This program is layered on top of shell.el; the code here only accounts
-;; for the variations needed to handle a remote process, e.g. directory
-;; tracking and the sending of some special characters.
-
-;; If you wish for rlogin mode to prompt you in the minibuffer for
-;; passwords when a password prompt appears, just enter m-x send-invisible
-;; and type in your line, or add `comint-watch-for-password-prompt' to
-;; `comint-output-filter-functions'.
-
-;;; Code:
-
-(require 'comint)
-(require 'shell)
-
-(defvar rlogin-program "rlogin"
-  "*Name of program to invoke rlogin")
-
-(defvar rlogin-explicit-args nil
-  "*List of arguments to pass to rlogin on the command line.")
-
-(defvar rlogin-mode-hook nil
-  "*Hooks to run after setting current buffer to rlogin-mode.")
-
-(defvar rlogin-process-connection-type nil
-  "*If non-`nil', use a pty for the local rlogin process.
-If `nil', use a pipe (if pipes are supported on the local system).
-
-Generally it is better not to waste ptys on systems which have a static
-number of them.  On the other hand, some implementations of `rlogin' assume
-a pty is being used, and errors will result from using a pipe instead.")
-
-(defvar rlogin-directory-tracking-mode 'local
-  "*Control whether and how to do directory tracking in an rlogin buffer.
-
-nil means don't do directory tracking.
-
-t means do so using an ftp remote file name.
-
-Any other value means do directory tracking using local file names.
-This works only if the remote machine and the local one
-share the same directories (through NFS).  This is the default.
-
-This variable becomes local to a buffer when set in any fashion for it.
-
-It is better to use the function of the same name to change the behavior of
-directory tracking in an rlogin session once it has begun, rather than
-simply setting this variable, since the function does the necessary
-re-synching of directories.")
-
-(make-variable-buffer-local 'rlogin-directory-tracking-mode)
-
-(defvar rlogin-host nil
-  "*The name of the remote host.  This variable is buffer-local.")
-
-(defvar rlogin-remote-user nil
-  "*The username used on the remote host.
-This variable is buffer-local and defaults to your local user name.
-If rlogin is invoked with the `-l' option to specify the remote username,
-this variable is set from that.")
-
-;; Initialize rlogin mode map.
-(defvar rlogin-mode-map '())
-(cond
- ((null rlogin-mode-map)
-  (setq rlogin-mode-map (if (consp shell-mode-map)
-                            (cons 'keymap shell-mode-map)
-                          (copy-keymap shell-mode-map)))
-  (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
-  (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D)
-  (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
-  (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
-  (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)
-  (define-key rlogin-mode-map "\C-i" 'rlogin-tab-or-complete)))
-
-
-;;;###autoload (add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)")
-
-(defvar rlogin-history nil)
-
-;;;###autoload
-(defun rlogin (input-args &optional buffer)
-  "Open a network login connection via `rlogin' with args INPUT-ARGS.
-INPUT-ARGS should start with a host name; it may also contain
-other arguments for `rlogin'.
-
-Input is sent line-at-a-time to the remote connection.
-
-Communication with the remote host is recorded in a buffer `*rlogin-HOST*'
-\(or `*rlogin-USER@HOST*' if the remote username differs\).
-If a prefix argument is given and the buffer `*rlogin-HOST*' already exists,
-a new buffer with a different connection will be made.
-
-When called from a program, if the optional second argument BUFFER is
-a string or buffer, it specifies the buffer to use.
-
-The variable `rlogin-program' contains the name of the actual program to
-run.  It can be a relative or absolute path.
-
-The variable `rlogin-explicit-args' is a list of arguments to give to
-the rlogin when starting.  They are added after any arguments given in
-INPUT-ARGS.
-
-If the default value of `rlogin-directory-tracking-mode' is t, then the
-default directory in that buffer is set to a remote (FTP) file name to
-access your home directory on the remote machine.  Occasionally this causes
-an error, if you cannot access the home directory on that machine.  This
-error is harmless as long as you don't try to use that default directory.
-
-If `rlogin-directory-tracking-mode' is neither t nor nil, then the default
-directory is initially set up to your (local) home directory.
-This is useful if the remote machine and your local machine
-share the same files via NFS.  This is the default.
-
-If you wish to change directory tracking styles during a session, use the
-function `rlogin-directory-tracking-mode' rather than simply setting the
-variable."
-  (interactive (list
-		(read-from-minibuffer "rlogin arguments (hostname first): "
-				      nil nil nil 'rlogin-history)
-		current-prefix-arg))
-
-  (let* ((process-connection-type rlogin-process-connection-type)
-         (args (if rlogin-explicit-args
-                   (append (rlogin-parse-words input-args)
-                           rlogin-explicit-args)
-                 (rlogin-parse-words input-args)))
-	 (host (car args))
-	 (user (or (car (cdr (member "-l" args)))
-                   (user-login-name)))
-         (buffer-name (if (string= user (user-login-name))
-                          (format "*rlogin-%s*" host)
-                        (format "*rlogin-%s@%s*" user host)))
-	 proc)
-
-    (cond ((null buffer))
-	  ((stringp buffer)
-	   (setq buffer-name buffer))
-          ((bufferp buffer)
-           (setq buffer-name (buffer-name buffer)))
-          ((numberp buffer)
-           (setq buffer-name (format "%s<%d>" buffer-name buffer)))
-          (t
-           (setq buffer-name (generate-new-buffer-name buffer-name))))
-
-    (setq buffer (get-buffer-create buffer-name))
-    (pop-to-buffer buffer-name)
-
-    (cond
-     ((comint-check-proc buffer-name))
-     (t
-      (comint-exec buffer buffer-name rlogin-program nil args)
-      (setq proc (get-buffer-process buffer))
-      ;; Set process-mark to point-max in case there is text in the
-      ;; buffer from a previous exited process.
-      (set-marker (process-mark proc) (point-max))
-
-      ;; comint-output-filter-functions is just like a hook, except that the
-      ;; functions in that list are passed arguments.  add-hook serves well
-      ;; enough for modifying it.
-      ;; comint-output-filter-functions should already have a
-      ;; permanent-local property, at least in emacs 19.27 or later.
-      (if (fboundp 'make-local-hook)
-          (make-local-hook 'comint-output-filter-functions)
-        (make-local-variable 'comint-output-filter-functions))
-      (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter)
-
-      (rlogin-mode)
-
-      (make-local-variable 'rlogin-host)
-      (setq rlogin-host host)
-      (make-local-variable 'rlogin-remote-user)
-      (setq rlogin-remote-user user)
-
-      (condition-case ()
-          (cond ((eq rlogin-directory-tracking-mode t)
-                 ;; Do this here, rather than calling the tracking mode
-                 ;; function, to avoid a gratuitous resync check; the default
-                 ;; should be the user's home directory, be it local or remote.
-                 (setq comint-file-name-prefix
-                       (concat "/" rlogin-remote-user "@" rlogin-host ":"))
-                 (cd-absolute comint-file-name-prefix))
-                ((null rlogin-directory-tracking-mode))
-                (t
-                 (cd-absolute (concat comint-file-name-prefix "~/"))))
-        (error nil))))))
-
-(defun rlogin-mode ()
-  "Set major-mode for rlogin sessions.
-If `rlogin-mode-hook' is set, run it."
-  (interactive)
-  (kill-all-local-variables)
-  (shell-mode)
-  (setq major-mode 'rlogin-mode)
-  (setq mode-name "rlogin")
-  (use-local-map rlogin-mode-map)
-  (setq shell-dirtrackp rlogin-directory-tracking-mode)
-  (make-local-variable 'comint-file-name-prefix)
-  (run-hooks 'rlogin-mode-hook))
-
-(defun rlogin-directory-tracking-mode (&optional prefix)
-  "Do remote or local directory tracking, or disable entirely.
-
-If called with no prefix argument or a unspecified prefix argument (just
-``\\[universal-argument]'' with no number) do remote directory tracking via
-ange-ftp.  If called as a function, give it no argument.
-
-If called with a negative prefix argument, disable directory tracking
-entirely.
-
-If called with a positive, numeric prefix argument, e.g.
-``\\[universal-argument] 1 M-x rlogin-directory-tracking-mode\'',
-then do directory tracking but assume the remote filesystem is the same as
-the local system.  This only works in general if the remote machine and the
-local one share the same directories (through NFS)."
-  (interactive "P")
-  (cond
-   ((or (null prefix)
-        (consp prefix))
-    (setq rlogin-directory-tracking-mode t)
-    (setq shell-dirtrackp t)
-    (setq comint-file-name-prefix
-          (concat "/" rlogin-remote-user "@" rlogin-host ":")))
-   ((< prefix 0)
-    (setq rlogin-directory-tracking-mode nil)
-    (setq shell-dirtrackp nil))
-   (t
-    (setq rlogin-directory-tracking-mode 'local)
-    (setq comint-file-name-prefix "")
-    (setq shell-dirtrackp t)))
-  (cond
-   (shell-dirtrackp
-    (let* ((proc (get-buffer-process (current-buffer)))
-           (proc-mark (process-mark proc))
-           (current-input (buffer-substring proc-mark (point-max)))
-           (orig-point (point))
-           (offset (and (>= orig-point proc-mark)
-                        (- (point-max) orig-point))))
-      (unwind-protect
-          (progn
-            (delete-region proc-mark (point-max))
-            (goto-char (point-max))
-            (shell-resync-dirs))
-        (goto-char proc-mark)
-        (insert current-input)
-        (if offset
-            (goto-char (- (point-max) offset))
-          (goto-char orig-point)))))))
-
-
-;; Parse a line into its constituent parts (words separated by
-;; whitespace).  Return a list of the words.
-(defun rlogin-parse-words (line)
-  (let ((list nil)
-	(posn 0)
-        (match-data (match-data)))
-    (while (string-match "[^ \t\n]+" line posn)
-      (setq list (cons (substring line (match-beginning 0) (match-end 0))
-                       list))
-      (setq posn (match-end 0)))
-    (store-match-data (match-data))
-    (nreverse list)))
-
-(defun rlogin-carriage-filter (string)
-  (let* ((point-marker (point-marker))
-         (end (process-mark (get-buffer-process (current-buffer))))
-         (beg (or (and (boundp 'comint-last-output-start)
-                       comint-last-output-start)
-                  (- end (length string)))))
-    (goto-char beg)
-    (while (search-forward "\C-m" end t)
-      (delete-char -1))
-    (goto-char point-marker)))
-
-(defun rlogin-send-Ctrl-C ()
-  (interactive)
-  (send-string nil "\C-c"))
-
-(defun rlogin-send-Ctrl-D ()
-  (interactive)
-  (send-string nil "\C-d"))
-
-(defun rlogin-send-Ctrl-Z ()
-  (interactive)
-  (send-string nil "\C-z"))
-
-(defun rlogin-send-Ctrl-backslash ()
-  (interactive)
-  (send-string nil "\C-\\"))
-
-(defun rlogin-delchar-or-send-Ctrl-D (arg)
-  "\
-Delete ARG characters forward, or send a C-d to process if at end of buffer."
-  (interactive "p")
-  (if (eobp)
-      (rlogin-send-Ctrl-D)
-    (delete-char arg)))
-
-(defun rlogin-tab-or-complete ()
-  "Complete file name if doing directory tracking, or just insert TAB."
-  (interactive)
-  (if rlogin-directory-tracking-mode
-      (comint-dynamic-complete)
-    (insert "\C-i")))
-
-;;; rlogin.el ends here
diff --git a/lisp/rot13.el b/lisp/rot13.el
deleted file mode 100644
index e346c97a5f7..00000000000
--- a/lisp/rot13.el
+++ /dev/null
@@ -1,67 +0,0 @@
-;;; rot13.el --- display a buffer in rot13.
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle:
-;; 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:
-
-;; The single entry point, `rot13-other-window', performs a Caesar cipher
-;; encrypt/decrypt on the current buffer and displays the result in another 
-;; window.  Rot13 encryption is sometimes used on USENET as a read-at-your-
-;; own-risk wrapper for material some might consider offensive, such as
-;; ethnic humor.
-;;
-;; Written by Howard Gayle.
-;; This hack is mainly to show off the char table stuff.
-
-;;; Code:
-
-(defvar rot13-display-table
-  (let ((table (make-display-table))
-	(i 0))
-    (while (< i 26)
-      (aset table (+ i ?a) (vector (+ (% (+ i 13) 26) ?a)))
-      (aset table (+ i ?A) (vector (+ (% (+ i 13) 26) ?A)))
-      (setq i (1+ i)))
-    table)
-  "Char table for rot 13 display.")
-
-;;;###autoload
-(defun rot13-other-window ()
-  "Display current buffer in rot 13 in another window.
-To terminate the rot13 display, delete that window."
-  (interactive)
-  (let ((w (display-buffer (current-buffer) t)))
-    (set-window-display-table w rot13-display-table)))
-
-;;;###autoload
-(defun toggle-rot13-mode ()
-  "Toggle the use of rot 13 encoding for the current window."
-  (interactive)
-  (if (eq (window-display-table (selected-window)) rot13-display-table)
-      (set-window-display-table (selected-window) nil)
-    (if (null (window-display-table (selected-window)))
-	(set-window-display-table (selected-window) rot13-display-table))))
-
-(provide 'rot13)
-
-;;; rot13.el ends here
diff --git a/lisp/rsz-mini.el b/lisp/rsz-mini.el
deleted file mode 100644
index da5f4b478ba..00000000000
--- a/lisp/rsz-mini.el
+++ /dev/null
@@ -1,254 +0,0 @@
-;;; rsz-mini.el --- dynamically resize minibuffer to display entire contents
-
-;; Copyright (C) 1990, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;;         Roland McGrath <roland@prep.ai.mit.edu>
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: minibuffer, window, frame, display
-
-;; 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 allows the entire contents (or as much as possible) of the
-;; minibuffer to be visible at once when typing.  As the end of a line is
-;; reached, the minibuffer will resize itself.  When the user is done
-;; typing, the minibuffer will return to its original size.
-
-;; In window systems where it is possible to have a frame in which the
-;; minibuffer is the only window, the frame itself can be resized.  In
-;; Emacs 19.22 and earlier, the frame may not be properly returned to
-;; its original size after it ceases to be active because
-;; `minibuffer-exit-hook' didn't exist until version 19.23.
-;;
-;; Prior to Emacs 19.26, minibuffer-exit-hook wasn't called after exiting
-;; from the minibuffer by hitting the quit char.  That meant that the
-;; frame size restoration function wasn't being called in that case.  In
-;; 19.26 or later, minibuffer-exit-hook should be called anyway.
-
-;; Note that the minibuffer and echo area are not the same!  They simply
-;; happen to occupy roughly the same place on the frame.  Messages put in
-;; the echo area will not cause any resizing by this package.
-
-;; This package is considered a minor mode but it doesn't put anything in
-;; minor-mode-alist because this mode is specific to the minibuffer, which
-;; has no mode line.
-
-;; To enable or disable this mode, use M-x resize-minibuffer-mode.
-
-;;; Code:
-
-
-;;;###autoload
-(defvar resize-minibuffer-mode nil
-  "*If non-`nil', resize the minibuffer so its entire contents are visible.")
-
-;;;###autoload
-(defvar resize-minibuffer-window-max-height nil
-  "*Maximum size the minibuffer window is allowed to become.
-If less than 1 or not a number, the limit is the height of the frame in
-which the active minibuffer window resides.")
-
-;;;###autoload
-(defvar resize-minibuffer-window-exactly t
-  "*Allow making minibuffer exactly the size to display all its contents.
-If `nil', the minibuffer window can temporarily increase in size but
-never get smaller while it is active.  Any other value allows exact
-resizing.")
-
-;;;###autoload
-(defvar resize-minibuffer-frame nil
-  "*Allow changing the frame height of minibuffer frames.
-If non-`nil' and the active minibuffer is the sole window in its frame,
-allow changing the frame height.")
-
-;;;###autoload
-(defvar resize-minibuffer-frame-max-height nil
-  "*Maximum size the minibuffer frame is allowed to become.
-If less than 1 or not a number, there is no limit.")
-
-;;;###autoload
-(defvar resize-minibuffer-frame-exactly t
-  "*Allow making minibuffer frame exactly the size to display all its contents.
-If `nil', the minibuffer frame can temporarily increase in size but
-never get smaller while it is active.  Any other value allows exact
-resizing.")
-
-;; Variable used to store the height of the minibuffer frame
-;; on entry, so it can be restored on exit.  It is made local before it is
-;; modified.  Do not use it yourself.
-(defvar resize-minibuffer-frame-original-height nil)
-
-
-;;;###autoload
-(defun resize-minibuffer-mode (&optional prefix)
-  "Enable or disable resize-minibuffer mode.
-A negative prefix argument disables this mode.  A positive argument or
-argument of 0 enables it.
-
-When this minor mode is enabled, the minibuffer is dynamically resized to
-contain the entire region of text put in it as you type.
-
-The variable `resize-minibuffer-mode' is set to t or nil depending on
-whether this mode is active or not.
-
-The maximum height to which the minibuffer can grow is controlled by the
-variable `resize-minibuffer-window-max-height'.
-
-The variable `resize-minibuffer-window-exactly' determines whether the
-minibuffer window should ever be shrunk to make it no larger than needed to
-display its contents.
-
-When using a window system, it is possible for a minibuffer to be the sole
-window in a frame.  Since that window is already its maximum size, the only
-way to make more text visible at once is to increase the size of the frame.
-The variable `resize-minibuffer-frame' controls whether this should be
-done.  The variables `resize-minibuffer-frame-max-height' and
-`resize-minibuffer-frame-exactly' are analogous to their window
-counterparts."
-  (interactive "p")
-  (or prefix (setq prefix 0))
-  (cond
-   ((>= prefix 0)
-    (setq resize-minibuffer-mode t))
-   (t
-    (setq resize-minibuffer-mode nil))))
-
-(defun resize-minibuffer-setup ()
-  (cond
-   (resize-minibuffer-mode
-    (cond
-     ((and window-system
-           (eq 'only (cdr (assq 'minibuffer (frame-parameters)))))
-      ;; Checking for resize-minibuffer-frame is done outside the cond
-      ;; predicate because that should always be t if this is a minibuffer
-      ;; frame; it just shouldn't do anything if this flag is nil.
-      (and resize-minibuffer-frame
-           (progn
-             ;; Can't trust the height stored in minibuffer-frame-alist
-             ;; since the frame can be resized by the window manager and
-             ;; that variable isn't updated.
-             (make-local-variable 'resize-minibuffer-frame-original-height)
-             (setq resize-minibuffer-frame-original-height (frame-height))
-
-             (make-local-hook 'post-command-hook)
-             (add-hook 'post-command-hook 'resize-minibuffer-frame 'append t)
-
-             (make-local-hook 'minibuffer-exit-hook)
-             (add-hook 'minibuffer-exit-hook 'resize-minibuffer-frame-restore
-		       nil t)
-
-             (resize-minibuffer-frame))))
-     (t
-      (make-local-variable 'post-command-hook)
-      ;; Copy this because add-hook modifies the list structure.
-      (setq post-command-hook (copy-sequence post-command-hook))
-      (add-hook 'post-command-hook 'resize-minibuffer-window 'append)
-
-      (make-local-variable 'minibuffer-exit-hook)
-      (add-hook 'minibuffer-exit-hook 'resize-minibuffer-window-restore)
-
-      (resize-minibuffer-window))))))
-
-(defun resize-minibuffer-count-window-lines (&optional start end)
-  "Return number of window lines occupied by text in region.
-The number of window lines may be greater than the number of actual lines
-in the buffer if any wrap on the display due to their length.
-
-Optional arguments START and END default to point-min and point-max,
-respectively."
-  (or start (setq start (point-min)))
-  (or end   (setq end   (point-max)))
-  (if (= start end)
-      0
-    (save-excursion
-      (save-restriction
-        (widen)
-	(narrow-to-region start end)
-	(goto-char start)
-        (vertical-motion (buffer-size))))))
-
-
-;; Resize the minibuffer window to contain the minibuffer's contents.
-(defun resize-minibuffer-window ()
-  (and (eq (selected-window) (minibuffer-window))
-       (let ((height (window-height))
-             (lines (1+ (resize-minibuffer-count-window-lines))))
-         (and (numberp resize-minibuffer-window-max-height)
-              (> resize-minibuffer-window-max-height 0)
-              (setq lines (min lines resize-minibuffer-window-max-height)))
-         (or (if resize-minibuffer-window-exactly
-                 (= lines height)
-               (<= lines height))
-             (enlarge-window (- lines height))))))
-
-;; This resizes the minibuffer back to one line as soon as it is exited
-;; (e.g. when the user hits RET).  This way, subsequent messages put in the
-;; echo area aren't cluttered with leftover minibuffer text.
-;; It should be called by minibuffer-exit-hook.
-;;
-;; Note that because it calls sit-for to force a screen update, strange
-;; things may happen in the minibuffer, such as unexpanded partial
-;; completions by complete.el showing their completion.
-;; If this bothers you, just redefine this function to do nothing, in, say,
-;; your after-load-alist.  Perhaps there should be an option variable,
-;; but I don't know if there's really any demand for it.
-;; (Clobbering this definition is harmless because eventually emacs restores
-;; its idea of the minibuffer window size when the minibuffer isn't in use
-;; anyway; this is just a kludge because of the timing for that update).
-(defun resize-minibuffer-window-restore ()
-  (cond
-   ((not (eq (minibuffer-window) (selected-window))))
-   ((> (window-height) 1)
-    (enlarge-window (- 1 (window-height)))
-    (sit-for 0))))
-
-
-;; Resize the minibuffer frame to contain the minibuffer's contents.
-;; The minibuffer frame must be the current frame.
-(defun resize-minibuffer-frame ()
-  (let ((height (frame-height))
-        (lines (1+ (resize-minibuffer-count-window-lines))))
-    (and (numberp resize-minibuffer-frame-max-height)
-         (> resize-minibuffer-frame-max-height 0)
-         (setq lines (min lines resize-minibuffer-frame-max-height)))
-    (cond
-     ((> lines height)
-      (set-frame-size (window-frame (minibuffer-window)) (frame-width) lines))
-     ((and resize-minibuffer-frame-exactly
-           (> height resize-minibuffer-frame-original-height)
-           (< lines height))
-      (set-frame-size (window-frame (minibuffer-window))
-		      (frame-width) lines)))))
-
-;; Restore the original height of the frame.
-;; resize-minibuffer-frame-original-height is set in
-;; resize-minibuffer-setup.
-(defun resize-minibuffer-frame-restore ()
-  (set-frame-size (window-frame (minibuffer-window))
-                  (frame-width)
-                  resize-minibuffer-frame-original-height))
-
-
-(provide 'rsz-mini)
-
-(add-hook 'minibuffer-setup-hook 'resize-minibuffer-setup)
-(resize-minibuffer-mode)
-
-;; rsz-mini.el ends here
diff --git a/lisp/s-region.el b/lisp/s-region.el
deleted file mode 100644
index 81cc0470026..00000000000
--- a/lisp/s-region.el
+++ /dev/null
@@ -1,124 +0,0 @@
-;;; s-region.el --- set region using shift key.
-
-;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Morten Welinder (terra@diku.dk)
-;; Keywords: terminals
-;; Favourite-brand-of-beer: None, I hate beer.
-
-;; 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:
-
-;; Having loaded this code you can set the region by holding down the
-;; shift key and move the cursor to the other end of the region.  The
-;; functionality provided by this code is similar to that provided by
-;; the editors of Borland International's compilers for ms-dos.
-
-;; Currently, s-region-move may be bound only to events that are vectors
-;; of length one and whose last element is a symbol.  Also, the functions
-;; that are given this kind of overlay should be (interactive "p") 
-;; functions.
-
-;; If the following keys are not already bound then...
-;; C-insert is bound to copy-region-as-kill
-;; S-delete is bound to kill-region
-;; S-insert is bound to yank
-
-;;; Code:
-
-(defvar s-region-overlay (make-overlay 1 1))
-(overlay-put s-region-overlay 'face 'region)
-(overlay-put s-region-overlay 'priority 1000000) ; for hilit19
-
-(defun s-region-unshift (key)
-  "Remove shift modifier from last keypress KEY and return that as a key."
-  (if (vectorp key)
-      (let ((last (aref key (1- (length key)))))
-	(if (symbolp last)
-	    (let* ((keyname (symbol-name last))
-		   (pos (string-match "S-" keyname)))
-	      (if pos
-		  ;; We skip all initial parts of the event assuming that
-		  ;; those are setting up the prefix argument to the command.
-		  (vector (intern (concat (substring keyname 0 pos)
-					  (substring keyname (+ 2 pos)))))
-		(error "Non-shifted key: %S" key)))
-	  (error "Key does not end in a symbol: %S" key)))
-    (error "Non-vector key: %S" key)))
-
-(defun s-region-move-p1 (&rest arg)
-  "This is an overlay function to point-moving keys that are interactive \"p\""
-  (interactive "p")
-  (apply (function s-region-move) arg))
-
-(defun s-region-move-p2 (&rest arg)
-  "This is an overlay function to point-moving keys that are interactive \"P\""
-  (interactive "P")
-  (apply (function s-region-move) arg))
-
-(defun s-region-move (&rest arg)
-  (if (if mark-active (not (equal last-command 's-region-move)) t)
-      (set-mark-command nil)
-    (message "")) ; delete the "Mark set" message
-  (setq this-command 's-region-move)
-  (apply (key-binding (s-region-unshift (this-command-keys))) arg)
-  (move-overlay s-region-overlay (mark) (point) (current-buffer))
-  (sit-for 1)
-  (delete-overlay s-region-overlay))
-
-(defun s-region-bind (keylist &optional map)
-  "Bind shifted keys in KEYLIST to s-region-move-p1 or s-region-move-p2.
-Each key in KEYLIST is shifted and bound to one of the s-region-move
-functions provided it is already bound to some command or other.
-Optional third argument MAP specifies keymap to add binding to, defaulting
-to global keymap."
-  (let ((p2 (list 'scroll-up 'scroll-down
-		  'beginning-of-buffer 'end-of-buffer)))
-    (or map (setq map global-map))
-    (while keylist
-      (let* ((key (car keylist))
-	     (binding (key-binding key)))
-	(if (commandp binding)
-	    (define-key
-	      map
-	      (vector (intern (concat "S-" (symbol-name (aref key 0)))))
-	      (cond ((memq binding p2)
-		     's-region-move-p2)
-		    (t 's-region-move-p1)))))
-      (setq keylist (cdr keylist)))))
-
-;; Single keys (plus modifiers) only!
-(s-region-bind
- (list [right] [left] [up] [down]
-       [C-left] [C-right] [C-up] [C-down]
-       [M-left] [M-right] [M-up] [M-down]
-       [next] [previous] [home] [end]
-       [C-next] [C-previous] [C-home] [C-end]
-       [M-next] [M-previous] [M-home] [M-end]))
-
-(or (global-key-binding [C-insert])
-    (global-set-key [C-insert] 'copy-region-as-kill))
-(or (global-key-binding [S-delete])
-    (global-set-key [S-delete] 'kill-region))
-(or (global-key-binding [S-insert])
-    (global-set-key [S-insert] 'yank))
-
-(provide 's-region)
-
-;; s-region.el ends here.
diff --git a/lisp/saveplace.el b/lisp/saveplace.el
deleted file mode 100644
index 364e766dcb0..00000000000
--- a/lisp/saveplace.el
+++ /dev/null
@@ -1,229 +0,0 @@
-;;; saveplace.el --- automatically save place in files.
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Karl Fogel <kfogel@cs.oberlin.edu>
-;; Maintainer: FSF
-;; Created: July, 1993
-;; Keywords: bookmarks, placeholders
-
-;; 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:
-
-;; Automatically save place in files, so that visiting them later
-;; (even during a different Emacs session) automatically moves point
-;; to the saved position, when the file is first found.  Uses the
-;; value of buffer-local variable save-place to determine whether to
-;; save position or not.
-;;
-;; Thanks to Stefan Schoef, who sent a patch with the
-;; `save-place-version-control' stuff in it.
-
-;;; Code:
-
-;; this is what I was using during testing:
-;; (define-key ctl-x-map "p" 'toggle-save-place)
-
-(defvar save-place-alist nil
-  "Alist of saved places to go back to when revisiting files.
-Each element looks like (FILENAME . POSITION);
-visiting file FILENAME goes automatically to position POSITION
-rather than the beginning of the buffer.
-This alist is saved between Emacs sessions.")
-
-(defvar save-place nil
-  "*Non-nil means automatically save place in each file.
-This means when you visit a file, point goes to the last place
-where it was when you previously visited the same file.
-This variable is automatically buffer-local.
-
-If you wish your place in any file to always be automatically saved,
-simply put this in your `~/.emacs' file:
-
-\(setq-default save-place t\)")
-
-(make-variable-buffer-local 'save-place)
-
-(defvar save-place-file (convert-standard-filename "~/.emacs-places")
-  "*Name of the file that records `save-place-alist' value.")
-
-(defvar save-place-version-control 'nospecial
-  "*Controls whether to make numbered backups of master save-place file.
-It can have four values: t, nil, `never', and `nospecial'.  The first
-three have the same meaning that they do for the variable
-`version-control', and the final value `nospecial' means just use the
-value of `version-control'.")
-
-(defvar save-place-loaded nil
-  "Non-nil means that the `save-place-file' has been loaded.")
-
-(defvar save-place-limit nil
-  "Maximum number of entries to retain in the list; nil means no limit.")
-
-(defun toggle-save-place (&optional parg)
-  "Toggle whether to save your place in this file between sessions.
-If this mode is enabled, point is recorded when you kill the buffer
-or exit Emacs.  Visiting this file again will go to that position,
-even in a later Emacs session.
-
-If called with a prefix arg, the mode is enabled if and only if
-the argument is positive.
-
-To save places automatically in all files, put this in your `.emacs' file:
-
-\(setq-default save-place t\)"
-  (interactive "P")
-  (if (not buffer-file-name)
-      (message "Buffer `%s' not visiting a file" (buffer-name))
-    (if (and save-place (or (not parg) (<= parg 0)))
-	(progn
-	  (message "No place will be saved in this file")
-	  (setq save-place nil))
-      (message "Place will be saved")
-      (setq save-place t))))
-
-(defun save-place-to-alist ()
-  ;; put filename and point in a cons box and then cons that onto the
-  ;; front of the save-place-alist, if save-place is non-nil.
-  ;; Otherwise, just delete that file from the alist.
-  ;; first check to make sure alist has been loaded in from the master
-  ;; file.  If not, do so, then feel free to modify the alist.  It
-  ;; will be saved again when Emacs is killed.
-  (or save-place-loaded (load-save-place-alist-from-file))
-  (if buffer-file-name
-      (progn
-        (let ((cell (assoc buffer-file-name save-place-alist)))
-          (if cell
-              (setq save-place-alist (delq cell save-place-alist))))
-        (if save-place
-            (setq save-place-alist
-		  (cons (cons buffer-file-name
-			      (if (not (eq major-mode 'hexl-mode))
-				  (point)
-				(1+ (hexl-current-address))))
-                        save-place-alist))))))
-
-(defun save-place-alist-to-file ()
-  (let ((file (expand-file-name save-place-file)))
-    (save-excursion
-      (message "Saving places to %s..." file)
-      (set-buffer (get-buffer-create " *Saved Places*"))
-      (delete-region (point-min) (point-max))
-      (if (file-readable-p file)
-          (insert-file-contents file))
-      (delete-region (point-min) (point-max))
-      (goto-char (point-min))
-      (print save-place-alist (current-buffer))
-      (let ((version-control
-             (cond
-              ((null save-place-version-control) nil)
-              ((eq 'never save-place-version-control) 'never)
-              ((eq 'nospecial save-place-version-control) version-control)
-              (t
-               t))))
-        (write-file file)
-        (kill-buffer (current-buffer))
-        (message "Saving places to %s...done" file)))))
-
-(defun load-save-place-alist-from-file ()
-  (if (not save-place-loaded)
-      (progn
-        (setq save-place-loaded t)
-        (let ((file (expand-file-name save-place-file)))
-          ;; make sure that the alist does not get overwritten, and then
-          ;; load it if it exists:
-          (if (file-readable-p file)
-              (save-excursion
-                (message "Loading places from %s..." save-place-file)
-                ;; don't want to use find-file because we have been
-                ;; adding hooks to it.
-                (set-buffer (get-buffer-create " *Saved Places*"))
-                (delete-region (point-min) (point-max))
-                (insert-file-contents file)
-                (goto-char (point-min))
-                (setq save-place-alist 
-                      (car (read-from-string
-                            (buffer-substring (point-min) (point-max)))))
-
-                ;; If there is a limit, and we're over it, then we'll
-                ;; have to truncate the end of the list:
-                (if save-place-limit
-                    (if (<= save-place-limit 0)
-                        ;; Zero gets special cased.  I'm not thrilled
-                        ;; with this, but the loop for >= 1 is tight.
-                        (setq save-place-alist nil)
-                      ;; Else the limit is >= 1, so enforce it by
-                      ;; counting and then `setcdr'ing.
-                      (let ((s save-place-alist)
-                            (count 1))
-                        (while s
-                          (if (>= count save-place-limit)
-                              (setcdr s nil)
-                            (setq count (1+ count)))
-                          (setq s (cdr s))))))
-                  
-                (kill-buffer (current-buffer))
-                (message "Loading places from %s...done" file)
-                t)
-            t)
-          nil))))
-
-(defun save-places-to-alist ()
-  ;; go through buffer-list, saving places to alist if save-place is
-  ;; non-nil, deleting them from alist if it is nil.
-  (let ((buf-list (buffer-list)))
-    (while buf-list
-      ;; put this into a save-excursion in case someone is counting on
-      ;; another function in kill-emacs-hook to act on the last buffer
-      ;; they were in:
-      (save-excursion
-	(set-buffer (car buf-list))
-	;; save-place checks buffer-file-name too, but we can avoid
-	;; overhead of function call by checking here too.
-	(and buffer-file-name (save-place-to-alist))
-	(setq buf-list (cdr buf-list))))))
-
-(defun save-place-find-file-hook ()
-  (or save-place-loaded (load-save-place-alist-from-file))
-  (let ((cell (assoc buffer-file-name save-place-alist)))
-    (if cell
-	(progn
-	  (or after-find-file-from-revert-buffer
-	      (goto-char (cdr cell)))
-          ;; and make sure it will be saved again for later
-          (setq save-place t)))))
-
-(defun save-place-kill-emacs-hook ()
-  ;; First update the alist.  This loads the old save-place-file if nec.
-  (save-places-to-alist)
-  ;; Now save the alist in the file, if we have ever loaded the file
-  ;; (including just now).
-  (if save-place-loaded
-      (save-place-alist-to-file)))
-
-(add-hook 'find-file-hooks 'save-place-find-file-hook t)
-
-(add-hook 'kill-emacs-hook 'save-place-kill-emacs-hook)
-
-(add-hook 'kill-buffer-hook 'save-place-to-alist)
-
-(provide 'saveplace) ; why not...
-
-;;; saveplace.el ends here
-
diff --git a/lisp/score-mode.el b/lisp/score-mode.el
deleted file mode 100644
index 8505a93185b..00000000000
--- a/lisp/score-mode.el
+++ /dev/null
@@ -1,110 +0,0 @@
-;;; score-mode.el --- mode for editing Gnus score files
-;; Copyright (C) 1996 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; Keywords: news, mail
-
-;; 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:
-
-(require 'easymenu)
-(require 'timezone)
-(eval-when-compile (require 'cl))
-
-(defvar gnus-score-mode-hook nil
-  "*Hook run in score mode buffers.")
-
-(defvar gnus-score-menu-hook nil
-  "*Hook run after creating the score mode menu.")
-
-(defvar gnus-score-edit-exit-function nil
-  "Function run on exit from the score buffer.")
-
-(defvar gnus-score-mode-map nil)
-(unless gnus-score-mode-map
-  (setq gnus-score-mode-map (copy-keymap emacs-lisp-mode-map))
-  (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit)
-  (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date)
-  (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print))
-
-;;;###autoload
-(defun gnus-score-mode ()
-  "Mode for editing Gnus score files.
-This mode is an extended emacs-lisp mode.
-
-\\{gnus-score-mode-map}"
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map gnus-score-mode-map)
-  (when menu-bar-mode
-    (gnus-score-make-menu-bar))
-  (set-syntax-table emacs-lisp-mode-syntax-table)
-  (setq major-mode 'gnus-score-mode)
-  (setq mode-name "Score")
-  (lisp-mode-variables nil)
-  (make-local-variable 'gnus-score-edit-exit-function)
-  (run-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook))
-
-(defun gnus-score-make-menu-bar ()
-  (unless (boundp 'gnus-score-menu)
-    (easy-menu-define
-     gnus-score-menu gnus-score-mode-map ""
-     '("Score"
-       ["Exit" gnus-score-edit-exit t]
-       ["Insert date" gnus-score-edit-insert-date t]
-       ["Format" gnus-score-pretty-print t]))
-    (run-hooks 'gnus-score-menu-hook)))
-
-(defun gnus-score-edit-insert-date ()
-  "Insert date in numerical format."
-  (interactive)
-  (princ (gnus-score-day-number (current-time)) (current-buffer)))
-
-(defun gnus-score-pretty-print ()
-  "Format the current score file."
-  (interactive)
-  (goto-char (point-min))
-  (let ((form (read (current-buffer))))
-    (erase-buffer)
-    (pp form (current-buffer)))
-  (goto-char (point-min)))
-
-(defun gnus-score-edit-exit ()
-  "Stop editing the score file."
-  (interactive)
-  (unless (file-exists-p (file-name-directory (buffer-file-name)))
-    (make-directory (file-name-directory (buffer-file-name)) t))
-  (save-buffer)
-  (bury-buffer (current-buffer))
-  (let ((buf (current-buffer)))
-    (when gnus-score-edit-exit-function
-      (funcall gnus-score-edit-exit-function))
-    (when (eq buf (current-buffer))
-      (switch-to-buffer (other-buffer (current-buffer))))))
-
-(defun gnus-score-day-number (time)
-  (let ((dat (decode-time time)))
-    (timezone-absolute-from-gregorian
-     (nth 4 dat) (nth 3 dat) (nth 5 dat))))
-
-(provide 'score-mode)
-
-;;; score-mode.el ends here
diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el
deleted file mode 100644
index ec0f7164943..00000000000
--- a/lisp/scroll-bar.el
+++ /dev/null
@@ -1,241 +0,0 @@
-;;; scroll-bar.el --- window system-independent scroll bar support.
-
-;; Copyright (C) 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: hardware
-
-;; 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:
-
-;; Window-system-independent bindings of mouse clicks on the scroll bar.
-;; Presently emulates the scroll-bar behavior of xterm.
-
-;;; Code:
-
-(require 'mouse)
-
-
-;;;; Utilities.
-
-(defun scroll-bar-event-ratio (event)
-  "Given a scroll bar event EVENT, return the scroll bar position as a ratio.
-The value is a cons cell (PORTION . WHOLE) containing two integers
-whose ratio gives the event's vertical position in the scroll bar, with 0
-referring to the top and 1 to the bottom."
-  (nth 2 event))
-
-(defun scroll-bar-scale (num-denom whole)
-  "Given a pair (NUM . DENOM) and WHOLE, return (/ (* NUM WHOLE) DENOM).
-This is handy for scaling a position on a scroll bar into real units,
-like buffer positions.  If SCROLL-BAR-POS is the (PORTION . WHOLE) pair
-from a scroll bar event, then (scroll-bar-scale SCROLL-BAR-POS
-\(buffer-size)) is the position in the current buffer corresponding to
-that scroll bar position."
-  ;; We multiply before we divide to maintain precision.
-  ;; We use floating point because the product of a large buffer size
-  ;; with a large scroll bar portion can easily overflow a lisp int.
-  (truncate (/ (* (float (car num-denom)) whole) (cdr num-denom))))
-
-
-;;;; Helpful functions for enabling and disabling scroll bars.
-
-(defun scroll-bar-mode (flag)
-  "Toggle display of vertical scroll bars on each frame.
-This command applies to all frames that exist and frames to be
-created in the future.
-With a numeric argument, if the argument is negative,
-turn off scroll bars; otherwise, turn on scroll bars."
-  (interactive "P")
-  (if flag (setq flag (prefix-numeric-value flag)))
-
-  ;; Obtain the current setting by looking at default-frame-alist.
-  (let ((scroll-bar-mode
-	 (let ((assq (assq 'vertical-scroll-bars default-frame-alist)))
-	   (if assq (cdr assq) t))))
-
-    ;; Tweedle it according to the argument.
-    (setq scroll-bar-mode (if (null flag) (not scroll-bar-mode)
-			    (or (not (numberp flag)) (>= flag 0))))
-
-    ;; Apply it to default-frame-alist.
-    (mapcar
-     (function
-      (lambda (param-name)
-	(let ((parameter (assq param-name default-frame-alist)))
-	  (if (consp parameter)
-	      (setcdr parameter scroll-bar-mode)
-	    (setq default-frame-alist
-		  (cons (cons param-name scroll-bar-mode)
-			default-frame-alist))))))
-     '(vertical-scroll-bars horizontal-scroll-bars))
-
-    ;; Apply it to existing frames.
-    (let ((frames (frame-list)))
-      (while frames
-	(modify-frame-parameters
-	 (car frames)
-	 (list (cons 'vertical-scroll-bars scroll-bar-mode)
-	       (cons 'horizontal-scroll-bars scroll-bar-mode)))
-	(setq frames (cdr frames))))))
-
-;;;; Buffer navigation using the scroll bar.
-
-;;; This was used for up-events on button 2, but no longer.
-(defun scroll-bar-set-window-start (event)
-  "Set the window start according to where the scroll bar is dragged.
-EVENT should be a scroll bar click or drag event."
-  (interactive "e")
-  (let* ((end-position (event-end event))
-	 (window (nth 0 end-position))
-	 (portion-whole (nth 2 end-position)))
-    (save-excursion
-      (set-buffer (window-buffer window))
-      (save-excursion
-	(goto-char (+ (point-min)
-		      (scroll-bar-scale portion-whole
-					(- (point-max) (point-min)))))
-	(beginning-of-line)
-	(set-window-start window (point))))))
-
-(defun scroll-bar-drag-position (portion-whole)
-  "Calculate new window start for drag event."
-  (save-excursion
-    (goto-char (+ (point-min)
-		  (scroll-bar-scale portion-whole
-				    (- (point-max) (point-min)))))
-    (beginning-of-line)
-    (point)))
-
-(defun scroll-bar-maybe-set-window-start (event)
-  "Set the window start according to where the scroll bar is dragged.
-Only change window start if the new start is substantially different.
-EVENT should be a scroll bar click or drag event."
-  (interactive "e")
-  (let* ((end-position (event-end event))
-	 (window (nth 0 end-position))
-	 (portion-whole (nth 2 end-position))
-	 (next-portion-whole (cons (1+ (car portion-whole))
-				   (cdr portion-whole)))
-	 portion-start
-	 next-portion-start
-	 (current-start (window-start window)))
-    (save-excursion
-      (set-buffer (window-buffer window))
-      (setq portion-start (scroll-bar-drag-position portion-whole))
-      (setq next-portion-start (max
-				(scroll-bar-drag-position next-portion-whole)
-				(1+ portion-start)))
-      (if (or (> current-start next-portion-start)
-	      (< current-start portion-start))
-	  (set-window-start window portion-start)
-	;; Always set window start, to ensure scroll bar position is updated.
-	(set-window-start window current-start)))))
-
-;; Scroll the window to the proper position for EVENT.
-(defun scroll-bar-drag-1 (event)
-  (let* ((start-position (event-start event))
-	 (window (nth 0 start-position))
-	 (portion-whole (nth 2 start-position)))
-    (save-excursion
-      (set-buffer (window-buffer window))
-      ;; Calculate position relative to the accessible part of the buffer.
-      (goto-char (+ (point-min)
-		    (scroll-bar-scale portion-whole
-				      (- (point-max) (point-min)))))
-      (beginning-of-line)
-      (set-window-start window (point)))))
-
-(defun scroll-bar-drag (event)
-  "Scroll the window by dragging the scroll bar slider.
-If you click outside the slider, the window scrolls to bring the slider there."
-  (interactive "e")
-  (let* (done
-	 (echo-keystrokes 0))
-    (or point-before-scroll
-	(setq point-before-scroll (point)))
-    ;; Our scrolling can move point; don't let that clear point-before-scroll.
-    (let (point-before-scroll)
-      (scroll-bar-drag-1 event)
-      (track-mouse
-	(while (not done)
-	  (setq event (read-event))
-	  (if (eq (car-safe event) 'mouse-movement)
-	      (setq event (read-event)))
-	  (cond ((eq (car-safe event) 'scroll-bar-movement)
-		 (scroll-bar-drag-1 event))
-		(t
-		 ;; Exit when we get the drag event; ignore that event.
-		 (setq done t)))))
-      (sit-for 0))))
-
-(defun scroll-bar-scroll-down (event)
-  "Scroll the window's top line down to the location of the scroll bar click.
-EVENT should be a scroll bar click."
-  (interactive "e")
-  (let ((old-selected-window (selected-window)))
-    (unwind-protect
-	(progn
-	  (let* ((end-position (event-end event))
-		 (window (nth 0 end-position))
-		 (portion-whole (nth 2 end-position)))
-	    (let (point-before-scroll)
-	      (select-window window))
-	    (or point-before-scroll
-		(setq point-before-scroll (point)))
-	    (let (point-before-scroll)
-	      (scroll-down
-	       (scroll-bar-scale portion-whole (1- (window-height)))))))
-      (select-window old-selected-window))))
-
-(defun scroll-bar-scroll-up (event)
-  "Scroll the line next to the scroll bar click to the top of the window.
-EVENT should be a scroll bar click."
-  (interactive "e")
-  (let ((old-selected-window (selected-window)))
-    (unwind-protect
-	(progn
-	  (let* ((end-position (event-end event))
-		 (window (nth 0 end-position))
-		 (portion-whole (nth 2 end-position)))
-	    (let (point-before-scroll)
-	      (select-window window))
-	    (or point-before-scroll
-		(setq point-before-scroll (point)))
-	    (let (point-before-scroll)
-	      (scroll-up
-	       (scroll-bar-scale portion-whole (1- (window-height)))))))
-      (select-window old-selected-window))))
-
-
-;;;; Bindings.
-
-;;; For now, we'll set things up to work like xterm.
-(global-set-key [vertical-scroll-bar mouse-1] 'scroll-bar-scroll-up)
-(global-set-key [vertical-scroll-bar drag-mouse-1] 'scroll-bar-scroll-up)
-
-(global-set-key [vertical-scroll-bar down-mouse-2] 'scroll-bar-drag)
-
-(global-set-key [vertical-scroll-bar mouse-3] 'scroll-bar-scroll-down)
-(global-set-key [vertical-scroll-bar drag-mouse-3] 'scroll-bar-scroll-down)
-
-
-(provide 'scroll-bar)
-
-;;; scroll-bar.el ends here
diff --git a/lisp/select.el b/lisp/select.el
deleted file mode 100644
index 8fb51428272..00000000000
--- a/lisp/select.el
+++ /dev/null
@@ -1,310 +0,0 @@
-;;; select.el --- lisp portion of standard selection support.
-
-;; Keywords: internal
-
-;; Copyright (c) 1993, 1994 Free Software Foundation, Inc.
-;; Based partially on earlier release by Lucid.
-
-;; 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.
-
-;;; Code:
-
-;; This is for temporary compatibility with pre-release Emacs 19.
-(defalias 'x-selection 'x-get-selection)
-(defun x-get-selection (&optional type data-type)
-  "Return the value of an X Windows selection.
-The argument TYPE (default `PRIMARY') says which selection, 
-and the argument DATA-TYPE (default `STRING') says how to convert the data."
-  (x-get-selection-internal (or type 'PRIMARY) (or data-type 'STRING)))
-
-(defun x-get-clipboard ()
-  "Return text pasted to the clipboard."
-  (x-get-selection-internal 'CLIPBOARD 'STRING))
-
-(defun x-set-selection (type data)
-  "Make an X Windows selection of type TYPE and value DATA.
-The argument TYPE (default `PRIMARY') says which selection, 
-and DATA specifies the contents.  DATA may be a string,
-a symbol, an integer (or a cons of two integers or list of two integers).
-
-The selection may also be a cons of two markers pointing to the same buffer,
-or an overlay.  In these cases, the selection is considered to be the text 
-between the markers *at whatever time the selection is examined*.
-Thus, editing done in the buffer after you specify the selection
-can alter the effective value of the selection.
-
-The data may also be a vector of valid non-vector selection values.
-
-Interactively, the text of the region is used as the selection value."
-  (interactive (if (not current-prefix-arg)
-		   (list 'PRIMARY (read-string "Set text for pasting: "))
-		 (list 'PRIMARY (substring (region-beginning) (region-end)))))
-  ;; This is for temporary compatibility with pre-release Emacs 19.
-  (if (stringp type)
-      (setq type (intern type)))
-  (or (x-valid-simple-selection-p data)
-      (and (vectorp data)
-	   (let ((valid t)
-		 (i (1- (length data))))
-	     (while (>= i 0)
-	       (or (x-valid-simple-selection-p (aref data i))
-		   (setq valid nil))
-	       (setq i (1- i)))
-	     valid))
-      (signal 'error (list "invalid selection" data)))
-  (or type (setq type 'PRIMARY))
-  (if data
-      (x-own-selection-internal type data)
-    (x-disown-selection-internal type))
-  data)
-
-(defun x-valid-simple-selection-p (data)
-  (or (stringp data)
-      (symbolp data)
-      (integerp data)
-      (and (consp data)
-	   (integerp (car data))
-	   (or (integerp (cdr data))
-	       (and (consp (cdr data))
-		    (integerp (car (cdr data))))))
-      (overlayp data)
-      (and (consp data)
-	   (markerp (car data))
-	   (markerp (cdr data))
-	   (marker-buffer (car data))
-	   (marker-buffer (cdr data))
-	   (eq (marker-buffer (car data))
-	       (marker-buffer (cdr data)))
-	   (buffer-name (marker-buffer (car data)))
-	   (buffer-name (marker-buffer (cdr data))))))
-
-;;; Cut Buffer support
-
-(defun x-get-cut-buffer (&optional which-one)
-  "Returns the value of one of the 8 X server cut-buffers.  Optional arg
-WHICH-ONE should be a number from 0 to 7, defaulting to 0.
-Cut buffers are considered obsolete; you should use selections instead."
-  (x-get-cut-buffer-internal
-   (if which-one
-       (aref [CUT_BUFFER0 CUT_BUFFER1 CUT_BUFFER2 CUT_BUFFER3
-	      CUT_BUFFER4 CUT_BUFFER5 CUT_BUFFER6 CUT_BUFFER7]
-	     which-one)
-     'CUT_BUFFER0)))
-
-(defun x-set-cut-buffer (string &optional push)
-  "Store STRING into the X server's primary cut buffer.
-If PUSH is non-nil, also rotate the cut buffers:
-this means the previous value of the primary cut buffer moves the second
-cut buffer, and the second to the third, and so on (there are 8 buffers.)
-Cut buffers are considered obsolete; you should use selections instead."
-  ;; Check the data type of STRING.
-  (substring string 0 0)
-  (if push
-      (x-rotate-cut-buffers-internal 1))
-  (x-store-cut-buffer-internal 'CUT_BUFFER0 string))
-
-
-;;; Functions to convert the selection into various other selection types.
-;;; Every selection type that Emacs handles is implemented this way, except
-;;; for TIMESTAMP, which is a special case.
-
-(defun xselect-convert-to-string (selection type value)
-  (cond ((stringp value)
-	 value)
-	((overlayp value)
-	 (save-excursion
-	   (or (buffer-name (overlay-buffer value))
-	       (error "selection is in a killed buffer"))
-	   (set-buffer (overlay-buffer value))
-	   (buffer-substring (overlay-start value)
-			     (overlay-end value))))
-	((and (consp value)
-	      (markerp (car value))
-	      (markerp (cdr value)))
-	 (or (eq (marker-buffer (car value)) (marker-buffer (cdr value)))
-	     (signal 'error
-		     (list "markers must be in the same buffer"
-			   (car value) (cdr value))))
-	 (save-excursion
-	   (set-buffer (or (marker-buffer (car value))
-			   (error "selection is in a killed buffer")))
-	   (buffer-substring (car value) (cdr value))))
-	(t nil)))
-
-(defun xselect-convert-to-length (selection type value)
-  (let ((value
-	 (cond ((stringp value)
-		(length value))
-	       ((overlayp value)
-		(abs (- (overlay-end value) (overlay-start value))))
-	       ((and (consp value)
-		     (markerp (car value))
-		     (markerp (cdr value)))
-		(or (eq (marker-buffer (car value))
-			(marker-buffer (cdr value)))
-		    (signal 'error
-			    (list "markers must be in the same buffer"
-				  (car value) (cdr value))))
-		(abs (- (car value) (cdr value)))))))
-    (if value ; force it to be in 32-bit format.
-	(cons (ash value -16) (logand value 65535))
-      nil)))
-
-(defun xselect-convert-to-targets (selection type value)
-  ;; return a vector of atoms, but remove duplicates first.
-  (let* ((all (cons 'TIMESTAMP (mapcar 'car selection-converter-alist)))
-	 (rest all))
-    (while rest
-      (cond ((memq (car rest) (cdr rest))
-	     (setcdr rest (delq (car rest) (cdr rest))))
-	    ((eq (car (cdr rest)) '_EMACS_INTERNAL)  ; shh, it's a secret
-	     (setcdr rest (cdr (cdr rest))))
-	    (t
-	     (setq rest (cdr rest)))))
-    (apply 'vector all)))
-
-(defun xselect-convert-to-delete (selection type value)
-  (x-disown-selection-internal selection)
-  ;; A return value of nil means that we do not know how to do this conversion,
-  ;; and replies with an "error".  A return value of NULL means that we have
-  ;; done the conversion (and any side-effects) but have no value to return.
-  'NULL)
-
-(defun xselect-convert-to-filename (selection type value)
-  (cond ((overlayp value)
-	 (buffer-file-name (or (overlay-buffer value)
-			       (error "selection is in a killed buffer"))))
-	((and (consp value)
-	      (markerp (car value))
-	      (markerp (cdr value)))
-	 (buffer-file-name (or (marker-buffer (car value))
-			       (error "selection is in a killed buffer"))))
-	(t nil)))
-
-(defun xselect-convert-to-charpos (selection type value)
-  (let (a b tmp)
-    (cond ((cond ((overlayp value)
-		  (setq a (overlay-start value)
-			b (overlay-end value)))
-		 ((and (consp value)
-		       (markerp (car value))
-		       (markerp (cdr value)))
-		  (setq a (car value)
-			b (cdr value))))
-	   (setq a (1- a) b (1- b)) ; zero-based
-	   (if (< b a) (setq tmp a a b b tmp))
-	   (cons 'SPAN
-		 (vector (cons (ash a -16) (logand a 65535))
-			 (cons (ash b -16) (logand b 65535))))))))
-
-(defun xselect-convert-to-lineno (selection type value)
-  (let (a b buf tmp)
-    (cond ((cond ((and (consp value)
-		       (markerp (car value))
-		       (markerp (cdr value)))
-		  (setq a (marker-position (car value))
-			b (marker-position (cdr value))
-			buf (marker-buffer (car value))))
-		 ((overlayp value)
-		  (setq buf (overlay-buffer value)
-			a (overlay-start value)
-			b (overlay-end value)))
-		 )
-	   (save-excursion
-	     (set-buffer buf)
-	     (setq a (count-lines 1 a)
-		   b (count-lines 1 b)))
-	   (if (< b a) (setq tmp a a b b tmp))
-	   (cons 'SPAN
-		 (vector (cons (ash a -16) (logand a 65535))
-			 (cons (ash b -16) (logand b 65535))))))))
-
-(defun xselect-convert-to-colno (selection type value)
-  (let (a b buf tmp)
-    (cond ((cond ((and (consp value)
-		       (markerp (car value))
-		       (markerp (cdr value)))
-		  (setq a (car value)
-			b (cdr value)
-			buf (marker-buffer a)))
-		 ((overlayp value)
-		  (setq buf (overlay-buffer value)
-			a (overlay-start value)
-			b (overlay-end value)))
-		 )
-	   (save-excursion
-	     (set-buffer buf)
-	     (goto-char a)
-	     (setq a (current-column))
-	     (goto-char b)
-	     (setq b (current-column)))
-	   (if (< b a) (setq tmp a a b b tmp))
-	   (cons 'SPAN
-		 (vector (cons (ash a -16) (logand a 65535))
-			 (cons (ash b -16) (logand b 65535))))))))
-
-(defun xselect-convert-to-os (selection type size)
-  (symbol-name system-type))
-
-(defun xselect-convert-to-host (selection type size)
-  (system-name))
-
-(defun xselect-convert-to-user (selection type size)
-  (user-full-name))
-
-(defun xselect-convert-to-class (selection type size)
-  "Emacs")
-
-;; We do not try to determine the name Emacs was invoked with,
-;; because it is not clean for a program's behavior to depend on that.
-(defun xselect-convert-to-name (selection type size)
-  "emacs")
-
-(defun xselect-convert-to-integer (selection type value)
-  (and (integerp value)
-       (cons (ash value -16) (logand value 65535))))
-
-(defun xselect-convert-to-atom (selection type value)
-  (and (symbolp value) value))
-
-(defun xselect-convert-to-identity (selection type value) ; used internally
-  (vector value))
-
-(setq selection-converter-alist
-      '((TEXT . xselect-convert-to-string)
-	(STRING . xselect-convert-to-string)
-	(TARGETS . xselect-convert-to-targets)
-	(LENGTH . xselect-convert-to-length)
-	(DELETE . xselect-convert-to-delete)
-	(FILE_NAME . xselect-convert-to-filename)
-	(CHARACTER_POSITION . xselect-convert-to-charpos)
-	(LINE_NUMBER . xselect-convert-to-lineno)
-	(COLUMN_NUMBER . xselect-convert-to-colno)
-	(OWNER_OS . xselect-convert-to-os)
-	(HOST_NAME . xselect-convert-to-host)
-	(USER . xselect-convert-to-user)
-	(CLASS . xselect-convert-to-class)
-	(NAME . xselect-convert-to-name)
-	(ATOM . xselect-convert-to-atom)
-	(INTEGER . xselect-convert-to-integer)
-	(_EMACS_INTERNAL . xselect-convert-to-identity)
-	))
-
-(provide 'select)
-
-;;; select.el ends here.
diff --git a/lisp/server.el b/lisp/server.el
deleted file mode 100644
index 78f10f422df..00000000000
--- a/lisp/server.el
+++ /dev/null
@@ -1,445 +0,0 @@
-;;; server.el --- Lisp code for GNU Emacs running as server process.
-
-;; Copyright (C) 1986, 1987, 1992, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: William Sommerfeld <wesommer@athena.mit.edu>
-;; Keywords: processes
-
-;; Changes by peck@sun.com and by rms.
-
-;; 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 Lisp code is run in Emacs when it is to operate as
-;; a server for other processes.
-
-;; Load this library and do M-x server-edit to enable Emacs as a server.
-;; Emacs runs the program ../arch-lib/emacsserver as a subprocess
-;; for communication with clients.  If there are no client buffers to edit, 
-;; server-edit acts like (switch-to-buffer (other-buffer))
-
-;; When some other program runs "the editor" to edit a file,
-;; "the editor" can be the Emacs client program ../lib-src/emacsclient.
-;; This program transmits the file names to Emacs through
-;; the server subprocess, and Emacs visits them and lets you edit them.
-
-;; Note that any number of clients may dispatch files to emacs to be edited.
-
-;; When you finish editing a Server buffer, again call server-edit
-;; to mark that buffer as done for the client and switch to the next 
-;; Server buffer.  When all the buffers for a client have been edited 
-;; and exited with server-edit, the client "editor" will return
-;; to the program that invoked it.  
-
-;; Your editing commands and Emacs's display output go to and from
-;; the terminal in the usual way.  Thus, server operation is possible
-;; only when Emacs can talk to the terminal at the time you invoke
-;; the client.  This is possible in four cases:
-
-;; 1. On a window system, where Emacs runs in one window and the
-;; program that wants to use "the editor" runs in another.
-
-;; 2. On a multi-terminal system, where Emacs runs on one terminal and the
-;; program that wants to use "the editor" runs on another.
-
-;; 3. When the program that wants to use "the editor" is running
-;; as a subprocess of Emacs.
-
-;; 4. On a system with job control, when Emacs is suspended, the program
-;; that wants to use "the editor" will stop and display
-;; "Waiting for Emacs...".  It can then be suspended, and Emacs can be
-;; brought into the foreground for editing.  When done editing, Emacs is
-;; suspended again, and the client program is brought into the foreground.
-
-;; The buffer local variable "server-buffer-clients" lists 
-;; the clients who are waiting for this buffer to be edited.  
-;; The global variable "server-clients" lists all the waiting clients,
-;; and which files are yet to be edited for each.
-
-;;; Code:
-
-(defvar server-program (expand-file-name "emacsserver" exec-directory)
-  "*The program to use as the edit server.")
-
-(defvar server-visit-hook nil
-  "*List of hooks to call when visiting a file for the Emacs server.")
-
-(defvar server-switch-hook nil
-  "*List of hooks to call when switching to a buffer for the Emacs server.")
-
-(defvar server-done-hook nil
-  "*List of hooks to call when done editing a buffer for the Emacs server.")
-
-(defvar server-process nil 
-  "the current server process")
-
-(defvar server-previous-string "")
-
-(defvar server-clients nil
-  "List of current server clients.
-Each element is (CLIENTID BUFFERS...) where CLIENTID is a string
-that can be given to the server process to identify a client.
-When a buffer is marked as \"done\", it is removed from this list.")
-
-(defvar server-buffer-clients nil
-  "List of clientids for clients requesting editing of current buffer.")
-(make-variable-buffer-local 'server-buffer-clients)
-;; Changing major modes should not erase this local.
-(put 'server-buffer-clients 'permanent-local t)
-
-(defvar server-window nil
-  "*The window to use for selecting Emacs server buffers.
-If nil, use the selected window.
-If it is a frame, use the frame's selected window.")
-
-(defvar server-temp-file-regexp "^/tmp/Re\\|/draft$"
-  "*Regexp which should match filenames of temporary files
-which are deleted and reused after each edit
-by the programs that invoke the emacs server.")
-
-(or (assq 'server-buffer-clients minor-mode-alist)
-    (setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist)))
-
-;; If a *server* buffer exists,
-;; write STRING to it for logging purposes.
-(defun server-log (string)
-  (if (get-buffer "*server*")
-      (save-excursion
-	(set-buffer "*server*")
-	(goto-char (point-max))
-	(insert (current-time-string) " " string)
-	(or (bolp) (newline)))))
-
-(defun server-sentinel (proc msg)
-  (cond ((eq (process-status proc) 'exit)
-	 (server-log (message "Server subprocess exited")))
-	((eq (process-status proc) 'signal)
-	 (server-log (message "Server subprocess killed")))))
-
-;;;###autoload
-(defun server-start (&optional leave-dead)
-  "Allow this Emacs process to be a server for client processes.
-This starts a server communications subprocess through which
-client \"editors\" can send your editing commands to this Emacs job.
-To use the server, set up the program `emacsclient' in the
-Emacs distribution as your standard \"editor\".
-
-Prefix arg means just kill any existing server communications subprocess."
-  (interactive "P")
-  ;; kill it dead!
-  (if server-process
-      (progn
-	(set-process-sentinel server-process nil)
-	(condition-case () (delete-process server-process) (error nil))))
-  ;; Delete the socket files made by previous server invocations.
-  (let* ((sysname (system-name))
-	 (dot-index (string-match "\\." sysname)))
-    (condition-case ()
-	(delete-file (format "~/.emacs-server-%s" sysname))
-      (error nil))
-    (condition-case ()
-	(delete-file (format "/tmp/esrv%d-%s" (user-uid) sysname))
-      (error nil))
-    ;; In case the server file name was made with a domainless hostname,
-    ;; try deleting that name too.
-    (if dot-index
-	(let ((shortname (substring sysname 0 dot-index)))
-	  (condition-case ()
-	      (delete-file (format "~/.emacs-server-%s" shortname))
-	    (error nil))
-	  (condition-case ()
-	      (delete-file (format "/tmp/esrv%d-%s" (user-uid) shortname))
-	    (error nil)))))
-  ;; If this Emacs already had a server, clear out associated status.
-  (while server-clients
-    (let ((buffer (nth 1 (car server-clients))))
-      (server-buffer-done buffer)))
-  (if leave-dead
-      nil
-    (if server-process
-	(server-log (message "Restarting server")))
-    ;; Using a pty is wasteful, and the separate session causes
-    ;; annoyance sometimes (some systems kill idle sessions).
-    (let ((process-connection-type nil))
-      (setq server-process (start-process "server" nil server-program)))
-    (set-process-sentinel server-process 'server-sentinel)
-    (set-process-filter server-process 'server-process-filter)
-    (process-kill-without-query server-process)))
-
-;Process a request from the server to edit some files.
-;Format of STRING is "Client: CLIENTID PATH PATH PATH... \n"
-(defun server-process-filter (proc string)
-  (server-log string)
-  (setq string (concat server-previous-string string))
-  ;; If the input is multiple lines,
-  ;; process each line individually.
-  (while (string-match "\n" string)
-    (let ((request (substring string 0 (match-beginning 0)))
-	  client nowait
-	  (files nil)
-	  (lineno 1))
-      ;; Remove this line from STRING.
-      (setq string (substring string (match-end 0)))	  
-      (if (string-match "^Error: " request)
-	  (message "Server error: %s" (substring request (match-end 0)))
-	(if (string-match "^Client: " request)
-	    (progn
-	      (setq request (substring request (match-end 0)))
-	      (setq client (list (substring request 0 (string-match " " request))))
-	      (setq request (substring request (match-end 0)))
-	      (while (string-match "[^ ]+ " request)
-		(let ((arg
-		       (substring request (match-beginning 0) (1- (match-end 0))))
-		      (pos 0))
-		  (setq request (substring request (match-end 0)))
-		  (if (string-match "\\`-nowait" arg)
-		      (setq nowait t)
-		    (if (string-match "\\`\\+[0-9]+\\'" arg)
-			;; ARG is a line number option.
-			(setq lineno (read (substring arg 1)))
-		      ;; ARG is a file name.
-		      ;; Collapse multiple slashes to single slashes.
-		      (setq arg (command-line-normalize-file-name arg))
-		      ;; Undo the quoting that emacsclient does
-		      ;; for certain special characters.
-		      (while (string-match "&." arg pos)
-			(setq pos (1+ (match-beginning 0)))
-			(let ((nextchar (aref arg pos)))
-			  (cond ((= nextchar ?&)
-				 (setq arg (replace-match "&" t t arg)))
-				((= nextchar ?-)
-				 (setq arg (replace-match "-" t t arg)))
-				(t
-				 (setq arg (replace-match " " t t arg))))))
-		      (setq files
-			    (cons (list arg lineno)
-				  files))
-		      (setq lineno 1)))))
-	      (server-visit-files files client nowait)
-	      ;; CLIENT is now a list (CLIENTNUM BUFFERS...)
-	      (or nowait
-		  (setq server-clients (cons client server-clients)))
-	      (server-switch-buffer (nth 1 client))
-	      (run-hooks 'server-switch-hook)
-	      (message (substitute-command-keys
-			"When done with a buffer, type \\[server-edit]")))))))
-  ;; Save for later any partial line that remains.
-  (setq server-previous-string string))
-
-(defun server-visit-files (files client &optional nowait)
-  "Finds FILES and returns the list CLIENT with the buffers nconc'd.
-FILES is an alist whose elements are (FILENAME LINENUMBER).
-NOWAIT non-nil means this client is not waiting for the results,
-so don't mark these buffers specially, just visit them normally."
-  ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries.
-  (let (client-record (last-nonmenu-event t) (obuf (current-buffer)))
-    ;; Restore the current buffer afterward, but not using save-excursion,
-    ;; because we don't want to save point in this buffer
-    ;; if it happens to be one of those specified by the server.
-    (unwind-protect
-	(while files
-	  ;; If there is an existing buffer modified or the file is modified,
-	  ;; revert it.
-	  ;; If there is an existing buffer with deleted file, offer to write it.
-	  (let* ((filen (car (car files)))
-		 (obuf (get-file-buffer filen)))
-	    (if (and obuf (set-buffer obuf))
-		(if (file-exists-p filen)
-		    (if (or (not (verify-visited-file-modtime obuf))
-			    (buffer-modified-p obuf))
-			(revert-buffer t nil))
-		  (if (y-or-n-p
-		       (concat "File no longer exists: "
-			       filen
-			       ", write buffer to file? "))
-		      (write-file filen)))
-	      (set-buffer (find-file-noselect filen))
-	      (run-hooks 'server-visit-hook)))
-	  (goto-line (nth 1 (car files)))
-	  (if (not nowait)
-	      (setq server-buffer-clients
-		    (cons (car client) server-buffer-clients)))
-	  (setq client-record (cons (current-buffer) client-record))
-	  (setq files (cdr files)))
-      (set-buffer obuf))
-    (nconc client client-record)))
-
-(defun server-buffer-done (buffer)
-  "Mark BUFFER as \"done\" for its client(s).
-This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED).
-NEXT-BUFFER is another server buffer, as a suggestion for what to select next,
-or nil.  KILLED is t if we killed BUFFER (because it was a temp file)."
-  (let ((running (eq (process-status server-process) 'run))
-	(next-buffer nil)
-	(killed nil)
-	(first t)
-	(old-clients server-clients))
-    (while old-clients
-      (let ((client (car old-clients)))
-	(or next-buffer 
-	    (setq next-buffer (nth 1 (memq buffer client))))
-	(delq buffer client)
-	;; Delete all dead buffers from CLIENT.
-	(let ((tail client))
-	  (while tail
-	    (and (bufferp (car tail))
-		 (null (buffer-name (car tail)))
-		 (delq (car tail) client))
-	    (setq tail (cdr tail))))
-	;; If client now has no pending buffers,
-	;; tell it that it is done, and forget it entirely.
-	(if (cdr client) nil
-	  (if running
-	      (progn
-		;; Don't send emacsserver two commands in close succession.
-		;; It cannot handle that.
-		(or first (sit-for 1))
-		(setq first nil)
-		(send-string server-process 
-			     (format "Close: %s Done\n" (car client)))
-		(server-log (format "Close: %s Done\n" (car client)))))
-	  (setq server-clients (delq client server-clients))))
-      (setq old-clients (cdr old-clients)))
-    (if (and (bufferp buffer) (buffer-name buffer))
-	(progn
-	  (save-excursion
-	    (set-buffer buffer)
-	    (setq server-buffer-clients nil)
-	    (run-hooks 'server-done-hook))
-	  (if (server-temp-file-p buffer)
-	      (progn (kill-buffer buffer)
-		     (setq killed t))
-	    (bury-buffer buffer))))
-    (list next-buffer killed)))
-
-(defun server-temp-file-p (buffer)
-  "Return non-nil if BUFFER contains a file considered temporary.
-These are files whose names suggest they are repeatedly
-reused to pass information to another program.
-
-The variable `server-temp-file-regexp' controls which filenames
-are considered temporary."
-  (and (buffer-file-name buffer)
-       (string-match server-temp-file-regexp (buffer-file-name buffer))))
-
-(defun server-done ()
-  "Offer to save current buffer, mark it as \"done\" for clients.
-This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED).
-NEXT-BUFFER is another server buffer, as a suggestion for what to select next,
-or nil.  KILLED is t if we killed the BUFFER (because it was a temp file)."
-  (let ((buffer (current-buffer)))
-    (if server-buffer-clients
-	(progn
- 	  (if (server-temp-file-p buffer)
-	      ;; For a temp file, save, and do make a non-numeric backup
-	      ;; (unless make-backup-files is nil).
-	      (let ((version-control nil)
-		    (buffer-backed-up nil))
-		(save-buffer))
-	    (if (and (buffer-modified-p)
-		     (y-or-n-p (concat "Save file " buffer-file-name "? ")))
-		(save-buffer buffer)))
-	  (server-buffer-done buffer)))))
-
-;; Ask before killing a server buffer.
-;; It was suggested to release its client instead,
-;; but I think that is dangerous--the client would proceed
-;; using whatever is on disk in that file. -- rms.
-(defun server-kill-buffer-query-function ()
-  (or (not server-buffer-clients)
-      (yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
-			   (buffer-name (current-buffer))))))
-
-(add-hook 'kill-buffer-query-functions
- 	  'server-kill-buffer-query-function)
-
-(defun server-kill-emacs-query-function ()
-  (let (live-client
-	(tail server-clients))
-    ;; See if any clients have any buffers that are still alive.
-    (while tail
-      (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail)))))
-	  (setq live-client t))
-      (setq tail (cdr tail)))
-    (or (not live-client)
-	(yes-or-no-p "Server buffers still have clients; exit anyway? "))))
-
-(add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
-
-(defun server-edit (&optional arg)
-  "Switch to next server editing buffer; say \"Done\" for current buffer.
-If a server buffer is current, it is marked \"done\" and optionally saved.
-When all of a client's buffers are marked as \"done\", the client is notified.
-
-Temporary files such as MH <draft> files are always saved and backed up,
-no questions asked.  (The variable `make-backup-files', if nil, still
-inhibits a backup; you can set it locally in a particular buffer to
-prevent a backup for it.)  The variable `server-temp-file-regexp' controls
-which filenames are considered temporary.
-
-If invoked with a prefix argument, or if there is no server process running, 
-starts server process and that is all.  Invoked by \\[server-edit]."
-  (interactive "P")
-  (if (or arg
-	  (not server-process)
-	  (memq (process-status server-process) '(signal exit)))
-      (server-start nil)
-    (apply 'server-switch-buffer (server-done))))
-
-(defun server-switch-buffer (&optional next-buffer killed-one)
-  "Switch to another buffer, preferably one that has a client.
-Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
-  ;; KILLED-ONE is t in a recursive call
-  ;; if we have already killed one temp-file server buffer.
-  ;; This means we should avoid the final "switch to some other buffer"
-  ;; since we've already effectively done that.
-  (cond ((and (windowp server-window)
-	      (window-live-p server-window))
-	 (select-window server-window))
-	((framep server-window)
-	 (if (not (frame-live-p server-window))
-	     (setq server-window (make-frame)))
-	 (select-window (frame-selected-window server-window))))
-  (if (window-minibuffer-p (selected-window))
-      (select-window (next-window nil 'nomini 0)))
-  ;; Move to a non-dedicated window, if we have one.
-  (let ((last-window (previous-window nil 'nomini 0)))
-    (while (and (window-dedicated-p (selected-window))
-		(not (eq last-window (selected-window))))
-      (select-window (next-window nil 'nomini 0))))
-  (set-window-dedicated-p (selected-window) nil)
-  (if next-buffer
-      (if (and (bufferp next-buffer)
-	       (buffer-name next-buffer))
-	  (switch-to-buffer next-buffer)
-	;; If NEXT-BUFFER is a dead buffer,
-	;; remove the server records for it
-	;; and try the next surviving server buffer.
-	(apply 'server-switch-buffer
-	       (server-buffer-done next-buffer)))
-    (if server-clients
-	(server-switch-buffer (nth 1 (car server-clients)) killed-one)
-      (if (not killed-one)
-	  (switch-to-buffer (other-buffer))))))
-
-(global-set-key "\C-x#" 'server-edit)
-
-(provide 'server)
-
-;;; server.el ends here
diff --git a/lisp/shadowfile.el b/lisp/shadowfile.el
deleted file mode 100644
index 13abf4026f0..00000000000
--- a/lisp/shadowfile.el
+++ /dev/null
@@ -1,843 +0,0 @@
-;;; shadowfile.el --- automatic file copying for Emacs 19
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Boris Goldowsky <boris@gnu.ai.mit.edu>
-;; Keywords: comm
-
-;; 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.
-
-;; LCD Archive Entry:
-;; shadowfile|Boris Goldowsky|boris@gnu.ai.mit.edu|
-;; Helps you keep identical copies of files in multiple places.|
-;; $Date: 1996/01/14 07:34:30 $ |$Revision: 1.7 $|~/misc/shadowfile.el.Z|
-
-;; Commentary:
-
-;;  This package helps you to keep identical copies of files in more than one
-;;  place - possibly on different machines.  When you save a file, it checks
-;;  whether it is on the list of files with "shadows", and if so, it tries to
-;;  copy it when you exit emacs (or use the shadow-copy-files command).
-
-;; Installation & Use:
-
-;;  Put (require 'shadowfile) in your .emacs; add clusters (if necessary)
-;;  and file groups with shadow-define-cluster,
-;;  shadow-define-literal-group, and shadow-define-regexp-group (see the
-;;  documentation for these functions for information on how and when to
-;;  use them).  After doing this once, everything should be automatic.
-
-;;  The lists of clusters and shadows are saved in a file called .shadows,
-;;  so that they can be remembered from one emacs session to another, even
-;;  (as much as possible) if the emacs session terminates abnormally.  The
-;;  files needing to be copied are stored in .shadow_todo; if a file cannot
-;;  be copied for any reason, it will stay on the list to be tried again
-;;  next time.  The .shadows file should itself have shadows on all your
-;;  accounts so that the information in it is consistent everywhere, but
-;;  .shadow_todo is local information and should have no shadows.
-
-;;  If you do not want to copy a particular file, you can answer "no" and
-;;  be asked again next time you hit C-x 4 s or exit emacs.  If you do not
-;;  want to be asked again, use shadow-cancel, and you will not be asked
-;;  until you change the file and save it again.  If you do not want to
-;;  shadow that file ever again, you can edit it out of the .shadows
-;;  buffer.  Anytime you edit the .shadows buffer, you must type M-x
-;;  shadow-read-files to load in the new information, or your changes will
-;;  be overwritten!
-
-;; Bugs & Warnings:
-;;
-;;  - It is bad to have two emacses both running shadowfile at the same
-;;  time.  It tries to detect this condition, but is not always successful.
-;;
-;;  - You have to be careful not to edit a file in two locations
-;;  before shadowfile has had a chance to copy it; otherwise
-;;  "updating shadows" will overwrite one of the changed versions.
-;;
-;;  - It ought to check modification times of both files to make sure
-;;  it is doing the right thing.  This will have to wait until
-;;  file-newer-than-file-p works between machines.
-;;
-;;  - It will not make directories for you, it just fails to copy files
-;;  that belong in non-existent directories.
-;;
-;;  Please report any bugs to me (boris@gnu.ai.mit.edu).  Also let me know
-;;  if you have suggestions or would like to be informed of updates.
-
-;;; Code:
-
-(provide 'shadowfile)
-(require 'ange-ftp)
-
-(setq find-file-visit-truename t)	; makes life easier with symbolic links
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Variables
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar shadow-noquery nil
-  "*If t, always copy shadow files without asking.
-If nil \(the default), always ask.  If not nil and not t, ask only if there
-is no buffer currently visiting the file.")
-
-(defvar shadow-inhibit-message nil
-  "*If nonnil, do not display a message when a file needs copying.")
-
-(defvar shadow-inhibit-overload nil
-  "If nonnil, shadowfile won't redefine C-x C-c.
-Normally it overloads the function `save-buffers-kill-emacs' to check
-for files have been changed and need to be copied to other systems.")
-
-(defvar shadow-info-file nil
-  "File to keep shadow information in.  
-The shadow-info-file should be shadowed to all your accounts to
-ensure consistency.  Default: ~/.shadows")
-
-(defvar shadow-todo-file nil
-  "File to store the list of uncopied shadows in.
-This means that if a remote system is down, or for any reason you cannot or
-decide not to copy your shadow files at the end of one emacs session, it will
-remember and ask you again in your next emacs session.
-This file must NOT be shadowed to any other system, it is host-specific.
-Default: ~/.shadow_todo")
-
-;;; The following two variables should in most cases initialize themselves
-;;; correctly.  They are provided as variables in case the defaults are wrong
-;;; on your machine \(and for efficiency).
-
-(defvar shadow-system-name (system-name)
-  "The complete hostname of this machine.")
-
-(defvar shadow-homedir nil
-  "Your home directory on this machine.")
-
-;;;
-;;; Internal variables whose values are stored in the info and todo files:
-;;;
-
-(defvar shadow-clusters nil
-  "List of host clusters \(see shadow-define-cluster).")
-
-(defvar shadow-literal-groups nil
-  "List of files that are shared between hosts.
-This list contains shadow structures with literal filenames, created by
-shadow-define-group.")
-
-(defvar shadow-regexp-groups nil
-  "List of file types that are shared between hosts.
-This list contains shadow structures with regexps matching filenames, 
-created by shadow-define-regexp-group.")
-
-;;;
-;;; Other internal variables:
-;;;
-
-(defvar shadow-files-to-copy nil)	; List of files that need to
-					; be copied to remote hosts.
-
-(defvar shadow-hashtable nil)		; for speed
-
-(defvar shadow-info-buffer nil)		; buf visiting shadow-info-file
-(defvar shadow-todo-buffer nil)		; buf visiting shadow-todo-file
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Syntactic sugar; General list and string manipulation
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro shadow-when (condition &rest body)
-  ;; From cl.el
-  "(shadow-when CONDITION . BODY) => evaluate BODY if CONDITION is true."
-  (` (if (not (, condition))  ()  (,@ body))))
-  
-(defun shadow-union (a b)
-  "Add members of list A to list B
-if they are not equal to items already in B."
-  (if (null a)
-      b
-    (if (member (car a) b)
-	(shadow-union (cdr a) b)
-      (shadow-union (cdr a) (cons (car a) b)))))
-
-(defun shadow-find (func list)
-  "If FUNC applied to some element of LIST is nonnil, 
-return the first such element."
-  (while (and list (not (funcall func (car list))))
-    (setq list (cdr list)))
-  (car list))
-
-(defun shadow-remove-if (func list)
-  "Remove elements satisfying FUNC from LIST.
-Nondestructive; actually returns a copy of the list with the elements removed."
-  (if list
-      (if (funcall func (car list))
-	  (shadow-remove-if func (cdr list))
-	(cons (car list) (shadow-remove-if func (cdr list))))
-    nil))
-
-(defun shadow-join (strings sep)
-  "Concatenate elements of the list of STRINGS with SEP between each."
-  (cond ((null strings) "")
-	((null (cdr strings)) (car strings))
-	((concat (car strings) " " (shadow-join (cdr strings) sep)))))
-
-(defun shadow-regexp-superquote (string)
-  "Like regexp-quote, but includes the ^ and $ 
-to make sure regexp matches nothing but STRING."
-  (concat "^" (regexp-quote string) "$"))
-
-(defun shadow-suffix (prefix string)
-  "If PREFIX begins STRING, return the rest.
-Return value is nonnil if PREFIX and STRING are string= up to the length of
-PREFIX."
-  (let ((lp (length prefix))
-	(ls (length string)))
-    (if (and (>= ls lp)
-	     (string= prefix (substring string 0 lp)))
-	(substring string lp))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Clusters and sites
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; I use the term `site' to refer to a string which may be the name of a
-;;; cluster or a literal hostname.  All user-level commands should accept
-;;; either.
-
-(defun shadow-make-cluster (name primary regexp)
-  "Creates a shadow cluster 
-called NAME, using the PRIMARY hostname, REGEXP matching all hosts in the
-cluster.  The variable shadow-clusters associates the names of clusters to
-these structures. 
-   This function is for program use: to create clusters interactively, use
-shadow-define-cluster instead."
-  (list name primary regexp))
-
-(defmacro shadow-cluster-name (cluster)
-  "Return the name of the CLUSTER."
-  (list 'elt cluster 0))
-
-(defmacro shadow-cluster-primary (cluster)
-  "Return the primary hostname of a CLUSTER."
-  (list 'elt cluster 1))
-
-(defmacro shadow-cluster-regexp (cluster)
-  "Return the regexp matching hosts in a CLUSTER."
-  (list 'elt cluster 2))
-
-(defun shadow-set-cluster (name primary regexp)
-  "Put cluster NAME on the list of clusters,
-replacing old definition if any.  PRIMARY and REGEXP are the
-information defining the cluster.  For interactive use, call
-shadow-define-cluster instead."
-  (let ((rest (shadow-remove-if
-	       (function (lambda (x) (equal name (car x))))
-	       shadow-clusters)))
-    (setq shadow-clusters 
-	  (cons (shadow-make-cluster name primary regexp)
-		rest))))
-
-(defmacro shadow-get-cluster (name)
-  "Return cluster named NAME, or nil."
-  (list 'assoc name 'shadow-clusters))
-
-(defun shadow-site-primary (site)
-  "If SITE is a cluster, return primary host, otherwise return SITE."
-  (let ((c (shadow-get-cluster site)))
-    (if c
-	(shadow-cluster-primary c)
-      site)))
-
-;;; SITES
-
-(defun shadow-site-cluster (site)
-  "Given a SITE \(hostname or cluster name), return the cluster
-that it is in, or nil."
-  (or (assoc site shadow-clusters)
-      (shadow-find
-       (function (lambda (x)
-		   (string-match (shadow-cluster-regexp x)
-				 site)))
-       shadow-clusters)))
-
-(defun shadow-read-site ()
-  "Read a cluster name or hostname from the minibuffer."
-  (let ((ans (completing-read "Host or cluster name [RET when done]: "
-			      shadow-clusters)))
-    (if (equal "" ans)
-	nil
-      ans)))
-
-(defun shadow-site-match (site1 site2)
-  "Nonnil iff SITE1 is or includes SITE2.  
-Each may be a host or cluster name; if they are clusters, regexp of site1 will
-be matched against the primary of site2."
-  (or (string-equal site1 site2) ; quick check
-      (let* ((cluster1 (shadow-get-cluster site1))
-	     (primary2 (shadow-site-primary site2)))
-	(if cluster1
-	    (string-match (shadow-cluster-regexp cluster1) primary2)
-	  (string-equal site1 primary2)))))
-
-(defun shadow-get-user (site)
-  "Returns the default username for a site."
-  (ange-ftp-get-user (shadow-site-primary site)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Filename manipulation
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun shadow-parse-fullpath (fullpath)
-  "Parse PATH into \(site user path) list,
-or leave it alone if it already is one.  Returns nil if the argument is not a
-full ange-ftp pathname."
-  (if (listp fullpath)
-      fullpath
-    (ange-ftp-ftp-name fullpath)))
-
-(defun shadow-parse-path (path)
-  "Parse any PATH into \(site user path) list.
-Argument can be a simple path, full ange-ftp path, or already a hup list."
-  (or (shadow-parse-fullpath path)
-      (list shadow-system-name
-	    (user-login-name)
-	    path)))
-
-(defsubst shadow-make-fullpath (host user path)
-  "Make an ange-ftp style fullpath out of HOST, USER (optional), and PATH.
-This is probably not as general as it ought to be."
-  (concat "/" 
-	  (if user (concat user "@"))
-	  host ":"
-	  path))
-
-(defun shadow-replace-path-component (fullpath newpath)
-  "Return FULLPATH with the pathname component changed to NEWPATH."
-  (let ((hup (shadow-parse-fullpath fullpath)))
-    (shadow-make-fullpath (nth 0 hup) (nth 1 hup) newpath)))
-
-(defun shadow-local-file (file)
-  "If FILENAME is at this site,
-remove /user@host part.  If refers to a different system or a different user on
-this system, return nil."
-  (let ((hup (shadow-parse-fullpath file)))
-    (cond ((null hup) file)
-	  ((and (shadow-site-match (nth 0 hup) shadow-system-name)
-		(string-equal (nth 1 hup) (user-login-name)))
-	   (nth 2 hup))
-	  (t nil))))
-
-(defun shadow-expand-cluster-in-file-name (file)
-  "If hostname part of FILE is a cluster, expand it
-into the cluster's primary hostname.  Will return the pathname bare if it is
-a local file."
-  (let ((hup (shadow-parse-path file))
-	cluster)
-    (cond ((null hup) file)
-	  ((shadow-local-file hup))
-	  ((shadow-make-fullpath (shadow-site-primary (nth 0 hup))
-				 (nth 1 hup)
-				 (nth 2 hup))))))
-
-(defun shadow-expand-file-name (file &optional default)
-  "Expand file name and get file's true name."
-  (file-truename (expand-file-name file default)))
-
-(defun shadow-contract-file-name (file)
-  "Simplify FILENAME
-by replacing (when possible) home directory with ~, and hostname with cluster
-name that includes it.  Filename should be absolute and true."
-  (let* ((hup (shadow-parse-path file))
-	 (homedir (if (shadow-local-file hup)
-		      shadow-homedir
-		    (file-name-as-directory
-		     (nth 2 (shadow-parse-fullpath 
-			     (expand-file-name
-			      (shadow-make-fullpath
-			       (nth 0 hup) (nth 1 hup) "~")))))))
-	 (suffix (shadow-suffix homedir (nth 2 hup)))
-	 (cluster (shadow-site-cluster (nth 0 hup))))
-    (shadow-make-fullpath
-     (if cluster
-	 (shadow-cluster-name cluster)
-       (nth 0 hup))
-     (nth 1 hup)
-     (if suffix 
-	 (concat "~/" suffix)
-       (nth 2 hup)))))
-
-(defun shadow-same-site (pattern file)
-  "True if the site of PATTERN and of FILE are on the same site.
-If usernames are supplied, they must also match exactly.  PATTERN and FILE may
-be lists of host, user, path, or ange-ftp pathnames.  FILE may also be just a
-local filename."
-  (let ((pattern-sup (shadow-parse-fullpath pattern))
-	(file-sup    (shadow-parse-path file)))
-    (and
-     (shadow-site-match (nth 0 pattern-sup) (nth 0 file-sup))
-     (or (null (nth 1 pattern-sup))
-	 (string-equal (nth 1 pattern-sup) (nth 1 file-sup))))))
-
-(defun shadow-file-match (pattern file &optional regexp)
- "Returns t if PATTERN matches FILE.
-If REGEXP is supplied and nonnil, the pathname part of the pattern is a regular
-expression, otherwise it must match exactly.  The sites and usernames must
-match---see shadow-same-site.  The pattern must be in full ange-ftp format, but
-the file can be any valid filename.  This function does not do any filename
-expansion or contraction, you must do that yourself first."
- (let* ((pattern-sup (shadow-parse-fullpath pattern))
-	(file-sup (shadow-parse-path file)))
-   (and (shadow-same-site pattern-sup file-sup)
-	(if regexp 
-	    (string-match (nth 2 pattern-sup) (nth 2 file-sup))
-	  (string-equal (nth 2 pattern-sup) (nth 2 file-sup))))))
- 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; User-level Commands
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun shadow-define-cluster (name)
-  "Edit \(or create) the definition of a cluster.
-This is a group of hosts that share directories, so that copying to or from
-one of them is sufficient to update the file on all of them.  Clusters are
-defined by a name, the network address of a primary host \(the one we copy
-files to), and a regular expression that matches the hostnames of all the sites
-in the cluster."
-  (interactive (list (completing-read "Cluster name: " shadow-clusters () ())))
-  (let* ((old (shadow-get-cluster name))
-	 (primary (read-string "Primary host: "
-			       (if old (shadow-cluster-primary old) 
-				 name)))
-	 (regexp   (let (try-regexp)
-		     (while (not
-			     (string-match 
-			      (setq try-regexp
-				    (read-string 
-				     "Regexp matching all host names: "
-				     (if old (shadow-cluster-regexp old)
-				       (shadow-regexp-superquote primary))))
-			      primary))
-		       (message "Regexp doesn't include the primary host!")
-		       (sit-for 2))
-		     try-regexp))
-;	 (username (read-no-blanks-input 
-;		    (format "Username [default: %s]: " 
-;			    (shadow-get-user primary))
-;		    (if old (or (shadow-cluster-username old) "")
-;		      (user-login-name))))
-	 )
-;    (if (string-equal "" username) (setq username nil))
-    (shadow-set-cluster name primary regexp)))
-
-(defun shadow-define-literal-group ()
-  "Declare a single file to be shared between sites.
-It may have different filenames on each site.  When this file is edited, the
-new version will be copied to each of the other locations.  Sites can be
-specific hostnames, or names of clusters \(see shadow-define-cluster)."
-  (interactive)
-  (let* ((hup (shadow-parse-fullpath 
-	       (shadow-contract-file-name (buffer-file-name))))
-	 (path (nth 2 hup))
-	 user site group)
-    (while (setq site (shadow-read-site))
-      (setq user (read-string (format "Username [default %s]: "
-				      (shadow-get-user site)))
-	    path (read-string "Filename: " path))
-      (setq group (cons (shadow-make-fullpath site 
-					      (if (string-equal "" user)
-						  (shadow-get-user site)
-						user)
-					      path)
-			group)))
-    (setq shadow-literal-groups (cons group shadow-literal-groups)))
-  (shadow-write-info-file))
-
-(defun shadow-define-regexp-group ()
-  "Make each of a group of files be shared between hosts.
-Prompts for regular expression; files matching this are shared between a list
-of sites, which are also prompted for. The filenames must be identical on all
-hosts \(if they aren't, use shadow-define-group instead of this function).
-Each site can be either a hostname or the name of a cluster \(see
-shadow-define-cluster)."
-  (interactive)
-  (let ((regexp (read-string 
-		 "Filename regexp: " 
-		 (if (buffer-file-name)
-		     (shadow-regexp-superquote
-		      (nth 2
-			   (shadow-parse-path
-			    (shadow-contract-file-name
-			     (buffer-file-name))))))))
-	site sites usernames)
-    (while (setq site (shadow-read-site))
-      (setq sites (cons site sites))
-      (setq usernames 
-	    (cons (read-string (format "Username for %s: " site)
-			       (shadow-get-user site))
-		  usernames)))
-    (setq shadow-regexp-groups 
-	  (cons (shadow-make-group regexp sites usernames)
-		shadow-regexp-groups))
-    (shadow-write-info-file)))
-    
-(defun shadow-shadows ()
-  ;; Mostly for debugging.
-  "Interactive function to display shadows of a buffer."
-  (interactive)
-  (let ((msg (shadow-join (mapcar (function cdr)
-				  (shadow-shadows-of (buffer-file-name)))
-			  " ")))
-    (message "%s"
-	     (if (zerop (length msg)) 
-		 "No shadows."
-	       msg))))
-
-(defun shadow-copy-files (&optional arg)
-  "Copy all pending shadow files.
-With prefix argument, copy all pending files without query.
-Pending copies are stored in variable shadow-files-to-copy, and in
-shadow-todo-file if necessary.  This function is invoked by
-shadow-save-buffers-kill-emacs, so it is not usually necessary to
-call it manually."
-  (interactive "P")
-  (if (and (not shadow-files-to-copy) (interactive-p))
-      (message "No files need to be shadowed.")
-    (save-excursion
-      (map-y-or-n-p (function
-		     (lambda (pair)
-		       (or arg shadow-noquery
-			   (format "Copy shadow file %s? " (cdr pair)))))
-		    (function shadow-copy-file)
-		    shadow-files-to-copy
-		    '("shadow" "shadows" "copy"))
-      (shadow-write-todo-file t))))
-
-(defun shadow-cancel ()
-  "Cancel the instruction to copy some files.
-Prompts for which copy operations to cancel.  You will not be asked to copy
-them again, unless you make more changes to the files.  To cancel a shadow
-permanently, remove the group from shadow-literal-groups or
-shadow-regexp-groups."
-  (interactive)
-  (map-y-or-n-p (function (lambda (pair)
-			    (format "Cancel copying %s to %s? " 
-				    (car pair) (cdr pair))))
-		(function (lambda (pair) 
-			    (shadow-remove-from-todo pair)))
-		shadow-files-to-copy
-		'("shadow" "shadows" "cancel copy"))
-  (message "There are %d shadows to be updated." 
-	   (length shadow-files-to-copy))
-  (shadow-write-todo-file))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Internal functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun shadow-make-group (regexp sites usernames)
-  "Makes a description of a file group---
-actually a list of regexp ange-ftp file names---from REGEXP \(name of file to
-be shadowed), list of SITES, and corresponding list of USERNAMES for each
-site."
-  (if sites
-      (cons (shadow-make-fullpath (car sites) (car usernames) regexp)
-	    (shadow-make-group regexp (cdr sites) (cdr usernames)))
-    nil))
-
-(defun shadow-copy-file (s)
-  "Copy one shadow file."
-  (let* ((buffer 
-	  (cond ((get-file-buffer 
-		  (abbreviate-file-name (shadow-expand-file-name (car s)))))
-		((not (file-readable-p (car s)))
-		 (if (y-or-n-p
-		      (format "Cannot find file %s--cancel copy request?"
-			      (car s)))
-		     (shadow-remove-from-todo s))
-		 nil)
-		((or (eq t shadow-noquery)
-		     (y-or-n-p 
-		      (format "No buffer for %s -- update shadow anyway?"
-			      (car s))))
-		 (find-file-noselect (car s)))))
-	 (to (shadow-expand-cluster-in-file-name (cdr s))))
-    (shadow-when buffer
-      (set-buffer buffer)
-      (save-restriction
-	(widen)
-	(condition-case i 
-	    (progn
-	      (write-region (point-min) (point-max) to)
-	      (shadow-remove-from-todo s))
-	  (error (message "Shadow %s not updated!" (cdr s))))))))
-
-(defun shadow-shadows-of (file)
-  "Returns copy operations needed to update FILE.
-Filename should have clusters expanded, but otherwise can have any format.  
-Return value is a list of dotted pairs like \(from . to), where from
-and to are absolute file names."
-  (or (symbol-value (intern-soft file shadow-hashtable))
-      (let* ((absolute-file (shadow-expand-file-name
-			     (or (shadow-local-file file) file)
-			     shadow-homedir))
-	     (canonical-file (shadow-contract-file-name absolute-file))
-	     (shadows 
-	      (mapcar (function (lambda (shadow)
-				  (cons absolute-file shadow)))
-		      (append
-		       (shadow-shadows-of-1
-			canonical-file shadow-literal-groups nil)
-		       (shadow-shadows-of-1
-			canonical-file shadow-regexp-groups t)))))
-	(set (intern file shadow-hashtable) shadows))))
-
-(defun shadow-shadows-of-1 (file groups regexp)
-  "Return list of FILE's shadows in GROUPS, 
-which are considered as regular expressions if third arg REGEXP is true."
-  (if groups
-      (let ((nonmatching
-	     (shadow-remove-if 
-	      (function (lambda (x) (shadow-file-match x file regexp)))
-	      (car groups))))
-	(append (cond ((equal nonmatching (car groups)) nil)
-		      (regexp 
-		       (let ((realpath (nth 2 (shadow-parse-fullpath file))))
-			 (mapcar 
-			  (function 
-			   (lambda (x) 
-			     (shadow-replace-path-component x realpath)))
-			  nonmatching)))
-		      (t nonmatching))
-		(shadow-shadows-of-1 file (cdr groups) regexp)))))
-
-(defun shadow-add-to-todo ()
-  "If current buffer has shadows, add them to the list
-of files needing to be copied."
-  (let ((shadows (shadow-shadows-of 
-		  (shadow-expand-file-name 
-		   (buffer-file-name (current-buffer))))))
-    (shadow-when shadows
-      (setq shadow-files-to-copy
-	    (shadow-union shadows shadow-files-to-copy))
-      (shadow-when (not shadow-inhibit-message)
-	(message "%s" (substitute-command-keys
-		       "Use \\[shadow-copy-files] to update shadows."))
-	(sit-for 1))
-      (shadow-write-todo-file)))
-  nil)     ; Return nil for write-file-hooks
-
-(defun shadow-remove-from-todo (pair)
-  "Remove PAIR from shadow-files-to-copy.
-PAIR must be (eq to) one of the elements of that list."
-  (setq shadow-files-to-copy 
-	(shadow-remove-if (function (lambda (s) (eq s pair)))
-			  shadow-files-to-copy)))
-
-(defun shadow-read-files ()
-  "Visits and loads shadow-info-file and shadow-todo-file,
-thus restoring shadowfile's state from your last emacs session.
-Returns t unless files were locked; then returns nil."
-  (interactive)
-  (if (and (fboundp 'file-locked-p)
-	   (or (stringp (file-locked-p shadow-info-file))
-	       (stringp (file-locked-p shadow-todo-file))))
-      (progn
-	(message "Shadowfile is running in another emacs; can't have two.")
-	(beep)
-	(sit-for 3)
-	nil)
-    (save-excursion
-      (shadow-when shadow-info-file
-	(set-buffer (setq shadow-info-buffer
-			  (find-file-noselect shadow-info-file)))
-	(shadow-when (and (not (buffer-modified-p))
-			  (file-newer-than-file-p (make-auto-save-file-name)
-						  shadow-info-file))
-	  (erase-buffer)
-	  (message "Data recovered from %s." 
-		   (car (insert-file-contents (make-auto-save-file-name))))
-	  (sit-for 1))
-	(eval-current-buffer))
-      (shadow-when shadow-todo-file
-	(set-buffer (setq shadow-todo-buffer 
-			  (find-file-noselect shadow-todo-file)))
-	(shadow-when (and (not (buffer-modified-p))
-			  (file-newer-than-file-p (make-auto-save-file-name)
-						  shadow-todo-file))
-	  (erase-buffer)
-	  (message "Data recovered from %s." 
-		   (car (insert-file-contents (make-auto-save-file-name))))
-	  (sit-for 1))
-	(eval-current-buffer nil))
-      (shadow-invalidate-hashtable))
-    t))
-
-(defun shadow-write-info-file ()
-  "Write out information to shadow-info-file.
-Also clears shadow-hashtable, since when there are new shadows defined, the old
-hashtable info is invalid."
-  (shadow-invalidate-hashtable)
-  (if shadow-info-file
-      (save-excursion
-	(if (not shadow-info-buffer)
-	    (setq shadow-info-buffer (find-file-noselect shadow-info-file)))
-	(set-buffer shadow-info-buffer)
-	(delete-region (point-min) (point-max))
-	(shadow-insert-var 'shadow-clusters)
-	(shadow-insert-var 'shadow-literal-groups)
-	(shadow-insert-var 'shadow-regexp-groups))))
-
-(defun shadow-write-todo-file (&optional save)
-  "Write out information to shadow-todo-file.  
-With nonnil argument also saves the buffer."
-  (save-excursion
-    (if (not shadow-todo-buffer)
-	(setq shadow-todo-buffer (find-file-noselect shadow-todo-file)))
-    (set-buffer shadow-todo-buffer)
-    (delete-region (point-min) (point-max))
-    (shadow-insert-var 'shadow-files-to-copy)
-    (if save (shadow-save-todo-file))))
-
-(defun shadow-save-todo-file ()
-  (if (and shadow-todo-buffer (buffer-modified-p shadow-todo-buffer))
-      (save-excursion
-	(set-buffer shadow-todo-buffer)
-	(condition-case nil		; have to continue even in case of 
-	    (basic-save-buffer)		; error, otherwise kill-emacs might
-	  (error			; not work!
-	   (message "WARNING: Can't save shadow todo file; it is locked!")
-	   (sit-for 1))))))
-
-(defun shadow-invalidate-hashtable ()
-  (setq shadow-hashtable (make-vector 37 0)))
-
-(defun shadow-insert-var (variable)
-  "Prettily insert a setq command for VARIABLE.
-which, when later evaluated, will restore it to its current setting.
-SYMBOL must be the name of a variable whose value is a list."
-  (let ((standard-output (current-buffer)))
-    (insert (format "(setq %s" variable))
-    (cond ((consp (eval variable))
-	   (insert "\n  '(") 
-	   (prin1 (car (eval variable)))
-	   (let ((rest (cdr (eval variable))))
-	     (while rest
-	       (insert "\n    ")
-	       (prin1 (car rest))
-	       (setq rest (cdr rest)))
-	     (insert "))\n\n")))
-	  (t (insert " ")
-	     (prin1 (eval variable))
-	     (insert ")\n\n")))))
-
-(defun shadow-save-buffers-kill-emacs (&optional arg)
-  "Offer to save each buffer and copy shadows, then kill this Emacs process.
-With prefix arg, silently save all file-visiting buffers, then kill.
-
-Extended by shadowfile to automatically save `shadow-todo-file' and
-look for files that have been changed and need to be copied to other systems."
-  ;; This function is necessary because we need to get control and save
-  ;; the todo file /after/ saving other files, but /before/ the warning
-  ;; message about unsaved buffers (because it can get modified by the
-  ;; action of saving other buffers).  `kill-emacs-hook' is no good
-  ;; because it is not called at the correct time, and also because it is
-  ;; called when the terminal is disconnected and we cannot ask whether
-  ;; to copy files.
-  (interactive "P")
-  (shadow-save-todo-file)
-  (save-some-buffers arg t)
-  (shadow-copy-files)
-  (shadow-save-todo-file)
-  (and (or (not (memq t (mapcar (function
-				 (lambda (buf) (and (buffer-file-name buf)
-						    (buffer-modified-p buf))))
-				(buffer-list))))
-	   (yes-or-no-p "Modified buffers exist; exit anyway? "))
-       (or (not (fboundp 'process-list))
-	   ;; process-list is not defined on VMS.
-	   (let ((processes (process-list))
-		 active)
-	     (while processes
-	       (and (memq (process-status (car processes)) '(run stop open))
-		    (let ((val (process-kill-without-query (car processes))))
-		      (process-kill-without-query (car processes) val)
-		      val)
-		    (setq active t))
-	       (setq processes (cdr processes)))
-	     (or (not active)
-		 (yes-or-no-p "Active processes exist; kill them and exit anyway? "))))
-       (kill-emacs)))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Lucid Emacs compatibility 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; This is on hold until someone tells me about a working version of
-;; map-ynp for Lucid Emacs.
-
-;(shadow-when (string-match "Lucid" emacs-version)
-;  (require 'symlink-fix)
-;  (require 'ange-ftp)
-;  (require 'map-ynp)
-;  (if (not (fboundp 'file-truename))
-;      (fset 'shadow-expand-file-name 
-;	    (symbol-function 'symlink-expand-file-name)))
-;  (if (not (fboundp 'ange-ftp-ftp-name))
-;      (fset 'ange-ftp-ftp-name
-;	    (symbol-function 'ange-ftp-ftp-path))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Hook us up
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; File shadowing is activated at load time, unless this this file is
-;;; being preloaded, in which case it is added to after-init-hook.
-;;; Thanks to Richard Caley for this scheme.
-
-(defun shadow-initialize ()
-  (if (null shadow-homedir)
-      (setq shadow-homedir
-	    (file-name-as-directory (shadow-expand-file-name "~"))))
-  (if (null shadow-info-file)
-      (setq shadow-info-file 
-	    (shadow-expand-file-name "~/.shadows")))
-  (if (null shadow-todo-file)
-      (setq shadow-todo-file 
-	    (shadow-expand-file-name "~/.shadow_todo")))
-  (if (not (shadow-read-files))
-      (progn
-	(message "Shadowfile information files not found - aborting")
-	(beep)
-	(sit-for 3))
-    (shadow-when (and (not shadow-inhibit-overload)
-		      (not (fboundp 'shadow-orig-save-buffers-kill-emacs)))
-      (fset 'shadow-orig-save-buffers-kill-emacs 
-	    (symbol-function 'save-buffers-kill-emacs))
-      (fset 'save-buffers-kill-emacs
-	    (symbol-function 'shadow-save-buffers-kill-emacs)))
-    (add-hook 'write-file-hooks 'shadow-add-to-todo)
-    (define-key ctl-x-4-map "s" 'shadow-copy-files)))
-
-(if noninteractive
-    (add-hook 'after-init-hook 'shadow-initialize)
-  (shadow-initialize))
-
-;;;Local Variables:
-;;;eval:(put 'shadow-when 'lisp-indent-hook 1)
-;;;End:
-
-;;; shadowfile.el ends here
diff --git a/lisp/shell.el b/lisp/shell.el
deleted file mode 100644
index 1d4dfcef3c1..00000000000
--- a/lisp/shell.el
+++ /dev/null
@@ -1,853 +0,0 @@
-;;; shell.el --- specialized comint.el for running the shell.
-
-;; Copyright (C) 1988, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Olin Shivers <shivers@cs.cmu.edu>
-;; Maintainer: Simon Marshall <simon@gnu.ai.mit.edu>
-;; Keywords: processes
-
-;; 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:
-
-;; Please send me bug reports, bug fixes, and extensions, so that I can
-;; merge them into the master source.
-;;     - Olin Shivers (shivers@cs.cmu.edu)
-;;     - Simon Marshall (simon@gnu.ai.mit.edu)
-
-;; This file defines a a shell-in-a-buffer package (shell mode) built
-;; on top of comint mode.  This is actually cmushell with things
-;; renamed to replace its counterpart in Emacs 18.  cmushell is more
-;; featureful, robust, and uniform than the Emacs 18 version.
-
-;; Since this mode is built on top of the general command-interpreter-in-
-;; a-buffer mode (comint mode), it shares a common base functionality, 
-;; and a common set of bindings, with all modes derived from comint mode.
-;; This makes these modes easier to use.
-
-;; For documentation on the functionality provided by comint mode, and
-;; the hooks available for customising it, see the file comint.el.
-;; For further information on shell mode, see the comments below.
-
-;; Needs fixin:
-;; When sending text from a source file to a subprocess, the process-mark can 
-;; move off the window, so you can lose sight of the process interactions.
-;; Maybe I should ensure the process mark is in the window when I send
-;; text to the process? Switch selectable?
-
-;; YOUR .EMACS FILE
-;;=============================================================================
-;; Some suggestions for your .emacs file.
-;;
-;; ;; Define M-# to run some strange command:
-;; (eval-after-load "shell"
-;;  '(define-key shell-mode-map "\M-#" 'shells-dynamic-spell))
-
-;; Brief Command Documentation:
-;;============================================================================
-;; Comint Mode Commands: (common to shell and all comint-derived modes)
-;;
-;; m-p	    comint-previous-input    	    Cycle backwards in input history
-;; m-n	    comint-next-input  	    	    Cycle forwards
-;; m-r     comint-previous-matching-input  Previous input matching a regexp
-;; m-s     comint-next-matching-input      Next input that matches
-;; m-c-l   comint-show-output		    Show last batch of process output
-;; return  comint-send-input
-;; c-d	    comint-delchar-or-maybe-eof	    Delete char unless at end of buff.
-;; c-c c-a comint-bol                      Beginning of line; skip prompt
-;; c-c c-u comint-kill-input	    	    ^u
-;; c-c c-w backward-kill-word    	    ^w
-;; c-c c-c comint-interrupt-subjob 	    ^c
-;; c-c c-z comint-stop-subjob	    	    ^z
-;; c-c c-\ comint-quit-subjob	    	    ^\
-;; c-c c-o comint-kill-output		    Delete last batch of process output
-;; c-c c-r comint-show-output		    Show last batch of process output
-;; c-c c-h comint-dynamic-list-input-ring  List input history
-;;         send-invisible                  Read line w/o echo & send to proc
-;;         comint-continue-subjob	    Useful if you accidentally suspend
-;;					        top-level job
-;; comint-mode-hook is the comint mode hook.
-
-;; Shell Mode Commands:
-;;         shell			Fires up the shell process
-;; tab     comint-dynamic-complete	Complete filename/command/history
-;; m-?     comint-dynamic-list-filename-completions
-;;					List completions in help buffer
-;; m-c-f   shell-forward-command	Forward a shell command
-;; m-c-b   shell-backward-command	Backward a shell command
-;; 	    dirs			Resync the buffer's dir stack
-;; 	    dirtrack-toggle		Turn dir tracking on/off
-;;         comint-strip-ctrl-m		Remove trailing ^Ms from output
-;;
-;; The shell mode hook is shell-mode-hook
-;; comint-prompt-regexp is initialised to shell-prompt-pattern, for backwards
-;; compatibility.
-
-;; Read the rest of this file for more information.
-
-;;; Code:
-
-(require 'comint)
-
-;;; Customization and Buffer Variables
-
-;;;###autoload
-(defvar shell-prompt-pattern "^[^#$%>\n]*[#$%>] *"
-  "Regexp to match prompts in the inferior shell.
-Defaults to \"^[^#$%>\\n]*[#$%>] *\", which works pretty well.
-This variable is used to initialise `comint-prompt-regexp' in the 
-shell buffer.
-
-The pattern should probably not match more than one line.  If it does,
-Shell mode may become confused trying to distinguish prompt from input
-on lines which don't start with a prompt.
-
-This is a fine thing to set in your `.emacs' file.")
-
-(defvar shell-completion-fignore nil
-  "*List of suffixes to be disregarded during file/command completion.
-This variable is used to initialize `comint-completion-fignore' in the shell
-buffer.  The default is nil, for compatibility with most shells.
-Some people like (\"~\" \"#\" \"%\").
-
-This is a fine thing to set in your `.emacs' file.")  
-
-(defvar shell-delimiter-argument-list '(?\| ?& ?< ?> ?\( ?\) ?\;)
-  "List of characters to recognise as separate arguments.
-This variable is used to initialize `comint-delimiter-argument-list' in the
-shell buffer.  The value may depend on the operating system or shell.
-
-This is a fine thing to set in your `.emacs' file.")
-
-(defvar shell-file-name-chars
-  (if (memq system-type '(ms-dos windows-nt))
-      "~/A-Za-z0-9_^$!#%&{}@`'.()-"
-    "~/A-Za-z0-9+@:_.$#%,={}-")
-  "String of characters valid in a file name.
-This variable is used to initialize `comint-file-name-chars' in the
-shell buffer.  The value may depend on the operating system or shell.
-
-This is a fine thing to set in your `.emacs' file.")
-
-(defvar shell-file-name-quote-list
-  (if (memq system-type '(ms-dos windows-nt))
-      nil
-    (append shell-delimiter-argument-list '(?\  ?\* ?\! ?\" ?\' ?\`)))
-  "List of characters to quote when in a file name.
-This variable is used to initialize `comint-file-name-quote-list' in the
-shell buffer.  The value may depend on the operating system or shell.
-
-This is a fine thing to set in your `.emacs' file.")
-
-(defvar shell-dynamic-complete-functions
-  '(comint-replace-by-expanded-history
-    shell-dynamic-complete-environment-variable
-    shell-dynamic-complete-command
-    shell-replace-by-expanded-directory
-    comint-dynamic-complete-filename)
-  "List of functions called to perform completion.
-This variable is used to initialise `comint-dynamic-complete-functions' in the
-shell buffer.
-
-This is a fine thing to set in your `.emacs' file.")
-
-(defvar shell-command-regexp "[^;&|\n]+"
-  "*Regexp to match a single command within a pipeline.
-This is used for directory tracking and does not do a perfect job.")
-
-(defvar shell-completion-execonly t
-  "*If non-nil, use executable files only for completion candidates.
-This mirrors the optional behavior of tcsh.
-
-Detecting executability of files may slow command completion considerably.")
-
-(defvar shell-popd-regexp "popd"
-  "*Regexp to match subshell commands equivalent to popd.")
-
-(defvar shell-pushd-regexp "pushd"
-  "*Regexp to match subshell commands equivalent to pushd.")
-
-(defvar shell-pushd-tohome nil
-  "*If non-nil, make pushd with no arg behave as \"pushd ~\" (like cd).
-This mirrors the optional behavior of tcsh.")
-
-(defvar shell-pushd-dextract nil
-  "*If non-nil, make \"pushd +n\" pop the nth dir to the stack top.
-This mirrors the optional behavior of tcsh.")
-
-(defvar shell-pushd-dunique nil
-  "*If non-nil, make pushd only add unique directories to the stack.
-This mirrors the optional behavior of tcsh.")
-
-(defvar shell-cd-regexp "cd"
-  "*Regexp to match subshell commands equivalent to cd.")
-
-(defvar shell-chdrive-regexp
-  (if (memq system-type '(ms-dos windows-nt)) 
-      ; NetWare allows the five chars between upper and lower alphabetics.
-      "[]a-zA-Z^_`\\[\\\\]:"
-    nil)
-  "*If non-nil, is regexp used to track drive changes.")
-
-(defvar explicit-shell-file-name nil
-  "*If non-nil, is file name to use for explicitly requested inferior shell.")
-
-(defvar explicit-csh-args
-  (if (eq system-type 'hpux)
-      ;; -T persuades HP's csh not to think it is smarter
-      ;; than us about what terminal modes to use.
-      '("-i" "-T")
-    '("-i"))
-  "*Args passed to inferior shell by M-x shell, if the shell is csh.
-Value is a list of strings, which may be nil.")
-
-(defvar shell-input-autoexpand 'history
-  "*If non-nil, expand input command history references on completion.
-This mirrors the optional behavior of tcsh (its autoexpand and histlit).
-
-If the value is `input', then the expansion is seen on input.
-If the value is `history', then the expansion is only when inserting
-into the buffer's input ring.  See also `comint-magic-space' and
-`comint-dynamic-complete'.
-
-This variable supplies a default for `comint-input-autoexpand',
-for Shell mode only.")
-
-(defvar shell-dirstack nil
-  "List of directories saved by pushd in this buffer's shell.
-Thus, this does not include the shell's current directory.")
-
-(defvar shell-dirtrackp t
-  "Non-nil in a shell buffer means directory tracking is enabled.")
-
-(defvar shell-last-dir nil
-  "Keep track of last directory for ksh `cd -' command.")
-
-(defvar shell-dirstack-query nil
-  "Command used by `shell-resync-dir' to query the shell.")
-
-(defvar shell-mode-map nil)
-(cond ((not shell-mode-map)
-       (setq shell-mode-map (nconc (make-sparse-keymap) comint-mode-map))
-       (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command)
-       (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command)
-       (define-key shell-mode-map "\t" 'comint-dynamic-complete)
-       (define-key shell-mode-map "\M-?"
-	 'comint-dynamic-list-filename-completions)
-       (define-key shell-mode-map [menu-bar completion]
-	 (copy-keymap (lookup-key comint-mode-map [menu-bar completion])))
-       (define-key-after (lookup-key shell-mode-map [menu-bar completion])
-	 [complete-env-variable] '("Complete Env. Variable Name" .
-				   shell-dynamic-complete-environment-variable)
-	 'complete-file)
-       (define-key-after (lookup-key shell-mode-map [menu-bar completion])
-	 [expand-directory] '("Expand Directory Reference" .
-			      shell-replace-by-expanded-directory)
-	 'complete-expand)))
-
-(defvar shell-mode-hook '()
-  "*Hook for customising Shell mode.")
-
-(defvar shell-font-lock-keywords
-  (list (cons shell-prompt-pattern 'font-lock-keyword-face)
-	'("[ \t]\\([+-][^ \t\n]+\\)" 1 font-lock-comment-face)
-	'("^[^ \t\n]+:.*" . font-lock-string-face)
-	'("^\\[[1-9][0-9]*\\]" . font-lock-string-face))
-  "Additional expressions to highlight in Shell mode.")
-
-;;; Basic Procedures
-
-(defun shell-mode ()
-  "Major mode for interacting with an inferior shell.
-\\[comint-send-input] after the end of the process' output sends the text from
-    the end of process to the end of the current line.
-\\[comint-send-input] before end of process output copies the current line minus the prompt to
-    the end of the buffer and sends it (\\[comint-copy-old-input] just copies the current line).
-\\[send-invisible] reads a line of text without echoing it, and sends it to
-    the shell.  This is useful for entering passwords.  Or, add the function
-    `comint-watch-for-password-prompt' to `comint-output-filter-functions'.
-
-If you want to make multiple shell buffers, rename the `*shell*' buffer
-using \\[rename-buffer] or \\[rename-uniquely] and start a new shell.
-
-If you want to make shell buffers limited in length, add the function
-`comint-truncate-buffer' to `comint-output-filter-functions'.
-
-If you accidentally suspend your process, use \\[comint-continue-subjob]
-to continue it.
-
-`cd', `pushd' and `popd' commands given to the shell are watched by Emacs to
-keep this buffer's default directory the same as the shell's working directory.
-While directory tracking is enabled, the shell's working directory is displayed
-by \\[list-buffers] or \\[mouse-buffer-menu] in the `File' field.
-\\[dirs] queries the shell and resyncs Emacs' idea of what the current 
-    directory stack is.
-\\[dirtrack-toggle] turns directory tracking on and off.
-
-\\{shell-mode-map}
-Customization: Entry to this mode runs the hooks on `comint-mode-hook' and
-`shell-mode-hook' (in that order).  Before each input, the hooks on
-`comint-input-filter-functions' are run.  After each shell output, the hooks
-on `comint-output-filter-functions' are run.
-
-Variables `shell-cd-regexp', `shell-chdrive-regexp', `shell-pushd-regexp' 
-and `shell-popd-regexp' are used to match their respective commands, 
-while `shell-pushd-tohome', `shell-pushd-dextract' and `shell-pushd-dunique' 
-control the behavior of the relevant command.
-
-Variables `comint-completion-autolist', `comint-completion-addsuffix',
-`comint-completion-recexact' and `comint-completion-fignore' control the
-behavior of file name, command name and variable name completion.  Variable
-`shell-completion-execonly' controls the behavior of command name completion.
-Variable `shell-completion-fignore' is used to initialise the value of
-`comint-completion-fignore'.
-
-Variables `comint-input-ring-file-name' and `comint-input-autoexpand' control
-the initialisation of the input ring history, and history expansion.
-
-Variables `comint-output-filter-functions', a hook, and
-`comint-scroll-to-bottom-on-input' and `comint-scroll-to-bottom-on-output'
-control whether input and output cause the window to scroll to the end of the
-buffer."
-  (interactive)
-  (comint-mode)
-  (setq major-mode 'shell-mode)
-  (setq mode-name "Shell")
-  (use-local-map shell-mode-map)
-  (setq comint-prompt-regexp shell-prompt-pattern)
-  (setq comint-completion-fignore shell-completion-fignore)
-  (setq comint-delimiter-argument-list shell-delimiter-argument-list)
-  (setq comint-file-name-chars shell-file-name-chars)
-  (setq comint-file-name-quote-list shell-file-name-quote-list)
-  (setq comint-dynamic-complete-functions shell-dynamic-complete-functions)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start comint-prompt-regexp)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(shell-font-lock-keywords t))
-  (make-local-variable 'shell-dirstack)
-  (setq shell-dirstack nil)
-  (setq shell-last-dir nil)
-  (make-local-variable 'shell-dirtrackp)
-  (setq shell-dirtrackp t)
-  (add-hook 'comint-input-filter-functions 'shell-directory-tracker nil t)
-  (setq comint-input-autoexpand shell-input-autoexpand)
-  (make-local-variable 'list-buffers-directory)
-  (setq list-buffers-directory (expand-file-name default-directory))
-  ;; shell-dependent assignments.
-  (let ((shell (file-name-nondirectory (car
-		 (process-command (get-buffer-process (current-buffer)))))))
-    (setq comint-input-ring-file-name
-	  (or (getenv "HISTFILE")
-	      (cond ((string-equal shell "bash") "~/.bash_history")
-		    ((string-equal shell "ksh") "~/.sh_history")
-		    (t "~/.history"))))
-    (if (or (equal comint-input-ring-file-name "")
-	    (equal (file-truename comint-input-ring-file-name)
-		   (file-truename "/dev/null")))
-	(setq comint-input-ring-file-name nil))
-    (setq shell-dirstack-query
-	  (cond ((string-equal shell "sh") "pwd")
-		((string-equal shell "ksh") "echo $PWD ~-")
-		(t "dirs"))))
-  (run-hooks 'shell-mode-hook)
-  (comint-read-input-ring t))
-
-;;;###autoload
-(defun shell ()
-  "Run an inferior shell, with I/O through buffer *shell*.
-If buffer exists but shell process is not running, make new shell.
-If buffer exists and shell process is running, just switch to buffer `*shell*'.
-Program used comes from variable `explicit-shell-file-name',
- or (if that is nil) from the ESHELL environment variable,
- or else from SHELL if there is no ESHELL.
-If a file `~/.emacs_SHELLNAME' exists, it is given as initial input
- (Note that this may lose due to a timing error if the shell
-  discards input when it starts up.)
-The buffer is put in Shell mode, giving commands for sending input
-and controlling the subjobs of the shell.  See `shell-mode'.
-See also the variable `shell-prompt-pattern'.
-
-The shell file name (sans directories) is used to make a symbol name
-such as `explicit-csh-args'.  If that symbol is a variable,
-its value is used as a list of arguments when invoking the shell.
-Otherwise, one argument `-i' is passed to the shell.
-
-\(Type \\[describe-mode] in the shell buffer for a list of commands.)"
-  (interactive)
-  (if (not (comint-check-proc "*shell*"))
-      (let* ((prog (or explicit-shell-file-name
-		       (getenv "ESHELL")
-		       (getenv "SHELL")
-		       "/bin/sh"))		     
-	     (name (file-name-nondirectory prog))
-	     (startfile (concat "~/.emacs_" name))
-	     (xargs-name (intern-soft (concat "explicit-" name "-args")))
-	     shell-buffer)
-	(save-excursion
-	  (set-buffer (apply 'make-comint "shell" prog
-			     (if (file-exists-p startfile) startfile)
-			     (if (and xargs-name (boundp xargs-name))
-				 (symbol-value xargs-name)
-			       '("-i"))))
-	  (setq shell-buffer (current-buffer))
-	  (shell-mode))
-	(pop-to-buffer shell-buffer))
-    (pop-to-buffer "*shell*")))
-
-;;; Don't do this when shell.el is loaded, only while dumping.
-;;;###autoload (add-hook 'same-window-buffer-names "*shell*")
-
-;;; Directory tracking
-;;;
-;;; This code provides the shell mode input sentinel
-;;;     SHELL-DIRECTORY-TRACKER
-;;; that tracks cd, pushd, and popd commands issued to the shell, and
-;;; changes the current directory of the shell buffer accordingly.
-;;;
-;;; This is basically a fragile hack, although it's more accurate than
-;;; the version in Emacs 18's shell.el. It has the following failings:
-;;; 1. It doesn't know about the cdpath shell variable.
-;;; 2. It cannot infallibly deal with command sequences, though it does well
-;;;    with these and with ignoring commands forked in another shell with ()s.
-;;; 3. More generally, any complex command is going to throw it. Otherwise,
-;;;    you'd have to build an entire shell interpreter in emacs lisp.  Failing
-;;;    that, there's no way to catch shell commands where cd's are buried
-;;;    inside conditional expressions, aliases, and so forth.
-;;;
-;;; The whole approach is a crock. Shell aliases mess it up. File sourcing
-;;; messes it up. You run other processes under the shell; these each have
-;;; separate working directories, and some have commands for manipulating
-;;; their w.d.'s (e.g., the lcd command in ftp). Some of these programs have
-;;; commands that do *not* affect the current w.d. at all, but look like they
-;;; do (e.g., the cd command in ftp).  In shells that allow you job
-;;; control, you can switch between jobs, all having different w.d.'s. So
-;;; simply saying %3 can shift your w.d..
-;;;
-;;; The solution is to relax, not stress out about it, and settle for
-;;; a hack that works pretty well in typical circumstances. Remember
-;;; that a half-assed solution is more in keeping with the spirit of Unix, 
-;;; anyway. Blech.
-;;;
-;;; One good hack not implemented here for users of programmable shells
-;;; is to program up the shell w.d. manipulation commands to output
-;;; a coded command sequence to the tty. Something like
-;;;     ESC | <cwd> |
-;;; where <cwd> is the new current working directory. Then trash the
-;;; directory tracking machinery currently used in this package, and
-;;; replace it with a process filter that watches for and strips out
-;;; these messages.
-
-(defun shell-directory-tracker (str)
-  "Tracks cd, pushd and popd commands issued to the shell.
-This function is called on each input passed to the shell.
-It watches for cd, pushd and popd commands and sets the buffer's
-default directory to track these commands.
-
-You may toggle this tracking on and off with M-x dirtrack-toggle.
-If emacs gets confused, you can resync with the shell with M-x dirs.
-
-See variables `shell-cd-regexp', `shell-chdrive-regexp', `shell-pushd-regexp',
-and  `shell-popd-regexp', while `shell-pushd-tohome', `shell-pushd-dextract', 
-and `shell-pushd-dunique' control the behavior of the relevant command.
-
-Environment variables are expanded, see function `substitute-in-file-name'."
-  (if shell-dirtrackp
-      ;; We fail gracefully if we think the command will fail in the shell.
-      (condition-case chdir-failure
-	  (let ((start (progn (string-match "^[; \t]*" str) ; skip whitespace
-			      (match-end 0)))
-		end cmd arg1)
-	    (while (string-match shell-command-regexp str start)
-	      (setq end (match-end 0)
-		    cmd (comint-arguments (substring str start end) 0 0)
-		    arg1 (comint-arguments (substring str start end) 1 1))
-	      (cond ((string-match (concat "\\`\\(" shell-popd-regexp
-					   "\\)\\($\\|[ \t]\\)")
-				   cmd)
-		     (shell-process-popd (comint-substitute-in-file-name arg1)))
-		    ((string-match (concat "\\`\\(" shell-pushd-regexp
-					   "\\)\\($\\|[ \t]\\)")
-				   cmd)
-		     (shell-process-pushd (comint-substitute-in-file-name arg1)))
-		    ((string-match (concat "\\`\\(" shell-cd-regexp
-					   "\\)\\($\\|[ \t]\\)")
-				   cmd)
-		     (shell-process-cd (comint-substitute-in-file-name arg1)))
-		    ((and shell-chdrive-regexp
-			  (string-match (concat "\\`\\(" shell-chdrive-regexp
-						"\\)\\($\\|[ \t]\\)")
-					cmd))
-		     (shell-process-cd (comint-substitute-in-file-name cmd))))
-	      (setq start (progn (string-match "[; \t]*" str end) ; skip again
-				 (match-end 0)))))
-	(error "Couldn't cd"))))
-
-;;; popd [+n]
-(defun shell-process-popd (arg)
-  (let ((num (or (shell-extract-num arg) 0)))
-    (cond ((and num (= num 0) shell-dirstack)
-	   (shell-cd (car shell-dirstack))
-	   (setq shell-dirstack (cdr shell-dirstack))
-	   (shell-dirstack-message))
-	  ((and num (> num 0) (<= num (length shell-dirstack)))
-	   (let* ((ds (cons nil shell-dirstack))
-		  (cell (nthcdr (1- num) ds)))
-	     (rplacd cell (cdr (cdr cell)))
-	     (setq shell-dirstack (cdr ds))
-	     (shell-dirstack-message)))
-	  (t
-	   (error "Couldn't popd")))))
-
-;; Return DIR prefixed with comint-file-name-prefix as appropriate.
-(defun shell-prefixed-directory-name (dir)
-  (if (= (length comint-file-name-prefix) 0)
-      dir
-    (if (file-name-absolute-p dir)
-	;; The name is absolute, so prepend the prefix.
-	(concat comint-file-name-prefix dir)
-      ;; For relative name we assume default-directory already has the prefix.
-      (expand-file-name dir))))
-
-;;; cd [dir]
-(defun shell-process-cd (arg)
-  (let ((new-dir (cond ((zerop (length arg)) (concat comint-file-name-prefix
-						     "~"))
-		       ((string-equal "-" arg) shell-last-dir)
-		       (t (shell-prefixed-directory-name arg)))))
-    (setq shell-last-dir default-directory)
-    (shell-cd new-dir)
-    (shell-dirstack-message)))
-
-;;; pushd [+n | dir]
-(defun shell-process-pushd (arg)
-  (let ((num (shell-extract-num arg)))
-    (cond ((zerop (length arg))
-	   ;; no arg -- swap pwd and car of stack unless shell-pushd-tohome
-	   (cond (shell-pushd-tohome
-		  (shell-process-pushd (concat comint-file-name-prefix "~")))
-		 (shell-dirstack
-		  (let ((old default-directory))
-		    (shell-cd (car shell-dirstack))
-		    (setq shell-dirstack (cons old (cdr shell-dirstack)))
-		    (shell-dirstack-message)))
-		 (t
-		  (message "Directory stack empty."))))
-	  ((numberp num)
-	   ;; pushd +n
-	   (cond ((> num (length shell-dirstack))
-		  (message "Directory stack not that deep."))
-		 ((= num 0)
-		  (error (message "Couldn't cd.")))
-		 (shell-pushd-dextract
-		  (let ((dir (nth (1- num) shell-dirstack)))
-		    (shell-process-popd arg)
-		    (shell-process-pushd default-directory)
-		    (shell-cd dir)
-		    (shell-dirstack-message)))
-		 (t
-		  (let* ((ds (cons default-directory shell-dirstack))
-			 (dslen (length ds))
-			 (front (nthcdr num ds))
-			 (back (reverse (nthcdr (- dslen num) (reverse ds))))
-			 (new-ds (append front back)))
-		    (shell-cd (car new-ds))
-		    (setq shell-dirstack (cdr new-ds))
-		    (shell-dirstack-message)))))
-	  (t
-	   ;; pushd <dir>
-	   (let ((old-wd default-directory))
-	     (shell-cd (shell-prefixed-directory-name arg))
-	     (if (or (null shell-pushd-dunique)
-		     (not (member old-wd shell-dirstack)))
-		 (setq shell-dirstack (cons old-wd shell-dirstack)))
-	     (shell-dirstack-message))))))
-
-;; If STR is of the form +n, for n>0, return n. Otherwise, nil.
-(defun shell-extract-num (str)
-  (and (string-match "^\\+[1-9][0-9]*$" str)
-       (string-to-int str)))
-
-
-(defun shell-dirtrack-toggle ()
-  "Turn directory tracking on and off in a shell buffer."
-  (interactive)
-  (if (setq shell-dirtrackp (not shell-dirtrackp))
-      (setq list-buffers-directory default-directory)
-    (setq list-buffers-directory nil))
-  (message "Directory tracking %s" (if shell-dirtrackp "ON" "OFF")))
-
-;;; For your typing convenience:
-(defalias 'dirtrack-toggle 'shell-dirtrack-toggle)
-
-(defun shell-cd (dir)
-  "Do normal `cd' to DIR, and set `list-buffers-directory'."
-  (if shell-dirtrackp
-      (setq list-buffers-directory (file-name-as-directory
-				    (expand-file-name dir))))
-  (cd dir))
-
-(defun shell-resync-dirs ()
-  "Resync the buffer's idea of the current directory stack.
-This command queries the shell with the command bound to 
-`shell-dirstack-query' (default \"dirs\"), reads the next
-line output and parses it to form the new directory stack.
-DON'T issue this command unless the buffer is at a shell prompt.
-Also, note that if some other subprocess decides to do output
-immediately after the query, its output will be taken as the
-new directory stack -- you lose. If this happens, just do the
-command again."
-  (interactive)
-  (let* ((proc (get-buffer-process (current-buffer)))
-	 (pmark (process-mark proc)))
-    (goto-char pmark)
-    (insert shell-dirstack-query) (insert "\n")
-    (sit-for 0) ; force redisplay
-    (comint-send-string proc shell-dirstack-query) 
-    (comint-send-string proc "\n")
-    (set-marker pmark (point))
-    (let ((pt (point))) ; wait for 1 line
-      ;; This extra newline prevents the user's pending input from spoofing us.
-      (insert "\n") (backward-char 1)
-      (while (not (looking-at ".+\n"))
-	(accept-process-output proc)
-	(goto-char pt)))
-    (goto-char pmark) (delete-char 1) ; remove the extra newline
-    ;; That's the dirlist. grab it & parse it.
-    (let* ((dl (buffer-substring (match-beginning 0) (1- (match-end 0))))
-	   (dl-len (length dl))
-	   (ds '())			; new dir stack
-	   (i 0))
-      (while (< i dl-len)
-	;; regexp = optional whitespace, (non-whitespace), optional whitespace
-	(string-match "\\s *\\(\\S +\\)\\s *" dl i) ; pick off next dir
-	(setq ds (cons (concat comint-file-name-prefix
-			       (substring dl (match-beginning 1)
-					  (match-end 1)))
-		       ds))
-	(setq i (match-end 0)))
-      (let ((ds (nreverse ds)))
-	(condition-case nil
-	    (progn (shell-cd (car ds))
-		   (setq shell-dirstack (cdr ds)
-			 shell-last-dir (car shell-dirstack))
-		   (shell-dirstack-message))
-	  (error (message "Couldn't cd.")))))))
-
-;;; For your typing convenience:
-(defalias 'dirs 'shell-resync-dirs)
-
-
-;;; Show the current dirstack on the message line.
-;;; Pretty up dirs a bit by changing "/usr/jqr/foo" to "~/foo".
-;;; (This isn't necessary if the dirlisting is generated with a simple "dirs".)
-;;; All the commands that mung the buffer's dirstack finish by calling
-;;; this guy.
-(defun shell-dirstack-message ()
-  (let* ((msg "")
-	 (ds (cons default-directory shell-dirstack))
-	 (home (expand-file-name (concat comint-file-name-prefix "~/")))
-	 (homelen (length home)))
-    (while ds
-      (let ((dir (car ds)))
-	(and (>= (length dir) homelen) (string= home (substring dir 0 homelen))
-	    (setq dir (concat "~/" (substring dir homelen))))
-	;; Strip off comint-file-name-prefix if present.
-	(and comint-file-name-prefix
-	     (>= (length dir) (length comint-file-name-prefix))
-	     (string= comint-file-name-prefix
-		      (substring dir 0 (length comint-file-name-prefix)))
-	     (setq dir (substring dir (length comint-file-name-prefix)))
-	     (setcar ds dir))
-	(setq msg (concat msg (directory-file-name dir) " "))
-	(setq ds (cdr ds))))
-    (message "%s" msg)))
-
-(defun shell-forward-command (&optional arg)
-  "Move forward across ARG shell command(s).  Does not cross lines.
-See `shell-command-regexp'."
-  (interactive "p")
-  (let ((limit (save-excursion (end-of-line nil) (point))))
-    (if (re-search-forward (concat shell-command-regexp "\\([;&|][\t ]*\\)+")
-			   limit 'move arg)
-	(skip-syntax-backward " "))))
-
-
-(defun shell-backward-command (&optional arg)
-  "Move backward across ARG shell command(s).  Does not cross lines.
-See `shell-command-regexp'."
-  (interactive "p")
-  (let ((limit (save-excursion (comint-bol nil) (point))))
-    (if (> limit (point))
-	(save-excursion (beginning-of-line) (setq limit (point))))
-    (skip-syntax-backward " " limit)
-    (if (re-search-backward
-	 (format "[;&|]+[\t ]*\\(%s\\)" shell-command-regexp) limit 'move arg)
-	(progn (goto-char (match-beginning 1))
-	       (skip-chars-forward ";&|")))))
-
-
-(defun shell-dynamic-complete-command ()
-  "Dynamically complete the command at point.
-This function is similar to `comint-dynamic-complete-filename', except that it
-searches `exec-path' (minus the trailing emacs library path) for completion
-candidates.  Note that this may not be the same as the shell's idea of the
-path.
-
-Completion is dependent on the value of `shell-completion-execonly', plus
-those that effect file completion.  See `shell-dynamic-complete-as-command'.
-
-Returns t if successful."
-  (interactive)
-  (let ((filename (comint-match-partial-filename)))
-    (if (and filename
-	     (save-match-data (not (string-match "[~/]" filename)))
-	     (eq (match-beginning 0)
-		 (save-excursion (shell-backward-command 1) (point))))
-	(prog2 (message "Completing command name...")
-	    (shell-dynamic-complete-as-command)))))
-
-
-(defun shell-dynamic-complete-as-command ()
-  "Dynamically complete at point as a command.
-See `shell-dynamic-complete-filename'.  Returns t if successful."
-  (let* ((filename (or (comint-match-partial-filename) ""))
-	 (pathnondir (file-name-nondirectory filename))
-	 (paths (cdr (reverse exec-path)))
-	 (cwd (file-name-as-directory (expand-file-name default-directory)))
-	 (ignored-extensions
-	  (and comint-completion-fignore
-	       (mapconcat (function (lambda (x) (concat (regexp-quote x) "$")))
-			  comint-completion-fignore "\\|")))
-	 (path "") (comps-in-path ()) (file "") (filepath "") (completions ()))
-    ;; Go thru each path in the search path, finding completions.
-    (while paths
-      (setq path (file-name-as-directory (comint-directory (or (car paths) ".")))
-	    comps-in-path (and (file-accessible-directory-p path)
-			       (file-name-all-completions pathnondir path)))
-      ;; Go thru each completion found, to see whether it should be used.
-      (while comps-in-path
-	(setq file (car comps-in-path)
-	      filepath (concat path file))
-	(if (and (not (member file completions))
-		 (not (and ignored-extensions
-			   (string-match ignored-extensions file)))
-		 (or (string-equal path cwd)
-		     (not (file-directory-p filepath)))
-		 (or (null shell-completion-execonly)
-		     (file-executable-p filepath)))
-	    (setq completions (cons file completions)))
-	(setq comps-in-path (cdr comps-in-path)))
-      (setq paths (cdr paths)))
-    ;; OK, we've got a list of completions.
-    (let ((success (let ((comint-completion-addsuffix nil))
-		     (comint-dynamic-simple-complete pathnondir completions))))
-      (if (and (memq success '(sole shortest)) comint-completion-addsuffix
-	       (not (file-directory-p (comint-match-partial-filename))))
-	  (insert " "))
-      success)))
-
-
-(defun shell-match-partial-variable ()
-  "Return the shell variable at point, or nil if none is found."
-  (save-excursion
-    (let ((limit (point)))
-      (if (re-search-backward "[^A-Za-z0-9_{}]" nil 'move)
-	  (or (looking-at "\\$") (forward-char 1)))
-      ;; Anchor the search forwards.
-      (if (or (eolp) (looking-at "[^A-Za-z0-9_{}$]"))
-	  nil
-	(re-search-forward "\\$?{?[A-Za-z0-9_]*}?" limit)
-	(buffer-substring (match-beginning 0) (match-end 0))))))
-
-
-(defun shell-dynamic-complete-environment-variable ()
-  "Dynamically complete the environment variable at point.
-Completes if after a variable, i.e., if it starts with a \"$\".
-See `shell-dynamic-complete-as-environment-variable'.
-
-This function is similar to `comint-dynamic-complete-filename', except that it
-searches `process-environment' for completion candidates.  Note that this may
-not be the same as the interpreter's idea of variable names.  The main problem
-with this type of completion is that `process-environment' is the environment
-which Emacs started with.  Emacs does not track changes to the environment made
-by the interpreter.  Perhaps it would be more accurate if this function was
-called `shell-dynamic-complete-process-environment-variable'.
-
-Returns non-nil if successful."
-  (interactive)
-  (let ((variable (shell-match-partial-variable)))
-    (if (and variable (string-match "^\\$" variable))
-	(prog2 (message "Completing variable name...")
-	    (shell-dynamic-complete-as-environment-variable)))))
-
-
-(defun shell-dynamic-complete-as-environment-variable ()
-  "Dynamically complete at point as an environment variable.
-Used by `shell-dynamic-complete-environment-variable'.
-Uses `comint-dynamic-simple-complete'."
-  (let* ((var (or (shell-match-partial-variable) ""))
-	 (variable (substring var (or (string-match "[^$({]\\|$" var) 0)))
-	 (variables (mapcar (function (lambda (x)
-					(substring x 0 (string-match "=" x))))
-			    process-environment))
-	 (addsuffix comint-completion-addsuffix)
-	 (comint-completion-addsuffix nil)
-	 (success (comint-dynamic-simple-complete variable variables)))
-    (if (memq success '(sole shortest))
-	(let* ((var (shell-match-partial-variable))
-	       (variable (substring var (string-match "[^$({]" var)))
-	       (protection (cond ((string-match "{" var) "}")
-				 ((string-match "(" var) ")")
-				 (t "")))
-	       (suffix (cond ((null addsuffix) "")
-			     ((file-directory-p
-			       (comint-directory (getenv variable))) "/")
-			     (t " "))))
-	  (insert protection suffix)))
-    success))
-
-
-(defun shell-replace-by-expanded-directory ()
-  "Expand directory stack reference before point.
-Directory stack references are of the form \"=digit\" or \"=-\".
-See `default-directory' and `shell-dirstack'.
-
-Returns t if successful."
-  (interactive)
-  (if (comint-match-partial-filename)
-      (save-excursion
-	(goto-char (match-beginning 0))
-	(let ((stack (cons default-directory shell-dirstack))
-	      (index (cond ((looking-at "=-/?")
-			    (length shell-dirstack))
-			   ((looking-at "=\\([0-9]+\\)")
-			    (string-to-number
-			     (buffer-substring
-			      (match-beginning 1) (match-end 1)))))))
-	  (cond ((null index)
-		 nil)
-		((>= index (length stack))
-		 (error "Directory stack not that deep."))
-		(t
-		 (replace-match (file-name-as-directory (nth index stack)) t t)
-		 (message "Directory item: %d" index)
-		 t))))))
-
-(provide 'shell)
-
-;;; shell.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
deleted file mode 100644
index 5fe8f638d62..00000000000
--- a/lisp/simple.el
+++ /dev/null
@@ -1,3269 +0,0 @@
-;;; simple.el --- basic editing commands for Emacs
-
-;; Copyright (C) 1985, 86, 87, 93, 94, 95 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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:
-
-;; A grab-bag of basic Emacs commands not specifically related to some
-;; major mode or to file-handling.
-
-;;; Code:
-
-(defun newline (&optional arg)
-  "Insert a newline, and move to left margin of the new line if it's blank.
-The newline is marked with the text-property `hard'.
-With arg, insert that many newlines.
-In Auto Fill mode, if no numeric arg, break the preceding line if it's long."
-  (interactive "*P")
-  (barf-if-buffer-read-only)
-  ;; Inserting a newline at the end of a line produces better redisplay in
-  ;; try_window_id than inserting at the beginning of a line, and the textual
-  ;; result is the same.  So, if we're at beginning of line, pretend to be at
-  ;; the end of the previous line.
-  (let ((flag (and (not (bobp)) 
-		   (bolp)
-		   ;; Make sure there are no markers here.
-		   (not (buffer-has-markers-at (1- (point))))
-		   ;; Make sure the newline before point isn't intangible.
-		   (not (get-char-property (1- (point)) 'intangible))
-		   ;; Make sure the newline before point isn't read-only.
-		   (not (get-char-property (1- (point)) 'read-only))
-		   ;; Make sure the newline before point isn't invisible.
-		   (not (get-char-property (1- (point)) 'invisible))
-		   ;; Make sure the newline before point has the same
-		   ;; properties as the char before it (if any).
-		   (< (or (previous-property-change (point)) -2) 
-		      (- (point) 2))))
-	(was-page-start (and (bolp)
-			     (looking-at page-delimiter)))
-	(beforepos (point)))
-    (if flag (backward-char 1))
-    ;; Call self-insert so that auto-fill, abbrev expansion etc. happens.
-    ;; Set last-command-char to tell self-insert what to insert.
-    (let ((last-command-char ?\n)
-	  ;; Don't auto-fill if we have a numeric argument.
-	  ;; Also not if flag is true (it would fill wrong line);
-	  ;; there is no need to since we're at BOL.
-	  (auto-fill-function (if (or arg flag) nil auto-fill-function)))
-      (unwind-protect
-	  (self-insert-command (prefix-numeric-value arg))
-	;; If we get an error in self-insert-command, put point at right place.
-	(if flag (forward-char 1))))
-    ;; If we did *not* get an error, cancel that forward-char.
-    (if flag (backward-char 1))
-    ;; Mark the newline(s) `hard'.
-    (if use-hard-newlines
-	(set-hard-newline-properties 
-	 (- (point) (if arg (prefix-numeric-value arg) 1)) (point)))
-    ;; If the newline leaves the previous line blank,
-    ;; and we have a left margin, delete that from the blank line.
-    (or flag
-	(save-excursion
-	  (goto-char beforepos)
-	  (beginning-of-line)
-	  (and (looking-at "[ \t]$")
-	       (> (current-left-margin) 0)
-	       (delete-region (point) (progn (end-of-line) (point))))))
-    (if flag (forward-char 1))
-    ;; Indent the line after the newline, except in one case:
-    ;; when we added the newline at the beginning of a line
-    ;; which starts a page.
-    (or was-page-start
-	(move-to-left-margin nil t)))
-  nil)
-
-(defun set-hard-newline-properties (from to)
-  (let ((sticky (get-text-property from 'rear-nonsticky)))
-    (put-text-property from to 'hard 't)
-    ;; If rear-nonsticky is not "t", add 'hard to rear-nonsticky list
-    (if (and (listp sticky) (not (memq 'hard sticky)))
-	(put-text-property from (point) 'rear-nonsticky
-			   (cons 'hard sticky)))))
-
-(defun open-line (arg)
-  "Insert a newline and leave point before it.
-If there is a fill prefix and/or a left-margin, insert them on the new line
-if the line would have been blank.
-With arg N, insert N newlines."
-  (interactive "*p")
-  (let* ((do-fill-prefix (and fill-prefix (bolp)))
-	 (do-left-margin (and (bolp) (> (current-left-margin) 0)))
-	 (loc (point)))
-    (newline arg)
-    (goto-char loc)
-    (while (> arg 0)
-      (cond ((bolp)
-	     (if do-left-margin (indent-to (current-left-margin)))
-	     (if do-fill-prefix (insert-and-inherit fill-prefix))))
-      (forward-line 1)
-      (setq arg (1- arg)))
-    (goto-char loc)
-    (end-of-line)))
-
-(defun split-line ()
-  "Split current line, moving portion beyond point vertically down."
-  (interactive "*")
-  (skip-chars-forward " \t")
-  (let ((col (current-column))
-	(pos (point)))
-    (newline 1)
-    (indent-to col 0)
-    (goto-char pos)))
-
-(defun quoted-insert (arg)
-  "Read next input character and insert it.
-This is useful for inserting control characters.
-You may also type up to 3 octal digits, to insert a character with that code.
-
-In overwrite mode, this function inserts the character anyway, and
-does not handle octal digits specially.  This means that if you use
-overwrite as your normal editing mode, you can use this function to
-insert characters when necessary.
-
-In binary overwrite mode, this function does overwrite, and octal
-digits are interpreted as a character code.  This is supposed to make
-this function useful in editing binary files."
-  (interactive "*p")
-  (let ((char (if (or (not overwrite-mode)
-		      (eq overwrite-mode 'overwrite-mode-binary))
-		  (read-quoted-char)
-		(read-char))))
-    (if (> arg 0)
-	(if (eq overwrite-mode 'overwrite-mode-binary)
-	    (delete-char arg)))
-    (while (> arg 0)
-      (insert-and-inherit char)
-      (setq arg (1- arg)))))
-
-(defun delete-indentation (&optional arg)
-  "Join this line to previous and fix up whitespace at join.
-If there is a fill prefix, delete it from the beginning of this line.
-With argument, join this line to following line."
-  (interactive "*P")
-  (beginning-of-line)
-  (if arg (forward-line 1))
-  (if (eq (preceding-char) ?\n)
-      (progn
-	(delete-region (point) (1- (point)))
-	;; If the second line started with the fill prefix,
-	;; delete the prefix.
-	(if (and fill-prefix
-		 (<= (+ (point) (length fill-prefix)) (point-max))
-		 (string= fill-prefix
-			  (buffer-substring (point)
-					    (+ (point) (length fill-prefix)))))
-	    (delete-region (point) (+ (point) (length fill-prefix))))
-	(fixup-whitespace))))
-
-(defun fixup-whitespace ()
-  "Fixup white space between objects around point.
-Leave one space or none, according to the context."
-  (interactive "*")
-  (save-excursion
-    (delete-horizontal-space)
-    (if (or (looking-at "^\\|\\s)")
-	    (save-excursion (forward-char -1)
-			    (looking-at "$\\|\\s(\\|\\s'")))
-	nil
-      (insert ?\ ))))
-
-(defun delete-horizontal-space ()
-  "Delete all spaces and tabs around point."
-  (interactive "*")
-  (skip-chars-backward " \t")
-  (delete-region (point) (progn (skip-chars-forward " \t") (point))))
-
-(defun just-one-space ()
-  "Delete all spaces and tabs around point, leaving one space."
-  (interactive "*")
-  (skip-chars-backward " \t")
-  (if (= (following-char) ? )
-      (forward-char 1)
-    (insert ? ))
-  (delete-region (point) (progn (skip-chars-forward " \t") (point))))
-
-(defun delete-blank-lines ()
-  "On blank line, delete all surrounding blank lines, leaving just one.
-On isolated blank line, delete that one.
-On nonblank line, delete any immediately following blank lines."
-  (interactive "*")
-  (let (thisblank singleblank)
-    (save-excursion
-      (beginning-of-line)
-      (setq thisblank (looking-at "[ \t]*$"))
-      ;; Set singleblank if there is just one blank line here.
-      (setq singleblank
-	    (and thisblank
-		 (not (looking-at "[ \t]*\n[ \t]*$"))
-		 (or (bobp)
-		     (progn (forward-line -1)
-			    (not (looking-at "[ \t]*$")))))))
-    ;; Delete preceding blank lines, and this one too if it's the only one.
-    (if thisblank
-	(progn
-	  (beginning-of-line)
-	  (if singleblank (forward-line 1))
-	  (delete-region (point)
-			 (if (re-search-backward "[^ \t\n]" nil t)
-			     (progn (forward-line 1) (point))
-			   (point-min)))))
-    ;; Delete following blank lines, unless the current line is blank
-    ;; and there are no following blank lines.
-    (if (not (and thisblank singleblank))
-	(save-excursion
-	  (end-of-line)
-	  (forward-line 1)
-	  (delete-region (point)
-			 (if (re-search-forward "[^ \t\n]" nil t)
-			     (progn (beginning-of-line) (point))
-			   (point-max)))))
-    ;; Handle the special case where point is followed by newline and eob.
-    ;; Delete the line, leaving point at eob.
-    (if (looking-at "^[ \t]*\n\\'")
-	(delete-region (point) (point-max)))))
-
-(defun back-to-indentation ()
-  "Move point to the first non-whitespace character on this line."
-  (interactive)
-  (beginning-of-line 1)
-  (skip-chars-forward " \t"))
-
-(defun newline-and-indent ()
-  "Insert a newline, then indent according to major mode.
-Indentation is done using the value of `indent-line-function'.
-In programming language modes, this is the same as TAB.
-In some text modes, where TAB inserts a tab, this command indents to the
-column specified by the function `current-left-margin'."
-  (interactive "*")
-  (delete-region (point) (progn (skip-chars-backward " \t") (point)))
-  (newline)
-  (indent-according-to-mode))
-
-(defun reindent-then-newline-and-indent ()
-  "Reindent current line, insert newline, then indent the new line.
-Indentation of both lines is done according to the current major mode,
-which means calling the current value of `indent-line-function'.
-In programming language modes, this is the same as TAB.
-In some text modes, where TAB inserts a tab, this indents to the
-column specified by the function `current-left-margin'."
-  (interactive "*")
-  (save-excursion
-    (delete-region (point) (progn (skip-chars-backward " \t") (point)))
-    (indent-according-to-mode))
-  (newline)
-  (indent-according-to-mode))
-
-;; Internal subroutine of delete-char
-(defun kill-forward-chars (arg)
-  (if (listp arg) (setq arg (car arg)))
-  (if (eq arg '-) (setq arg -1))
-  (kill-region (point) (+ (point) arg)))
-
-;; Internal subroutine of backward-delete-char
-(defun kill-backward-chars (arg)
-  (if (listp arg) (setq arg (car arg)))
-  (if (eq arg '-) (setq arg -1))
-  (kill-region (point) (- (point) arg)))
-
-(defun backward-delete-char-untabify (arg &optional killp)
-  "Delete characters backward, changing tabs into spaces.
-Delete ARG chars, and kill (save in kill ring) if KILLP is non-nil.
-Interactively, ARG is the prefix arg (default 1)
-and KILLP is t if a prefix arg was specified."
-  (interactive "*p\nP")
-  (let ((count arg))
-    (save-excursion
-      (while (and (> count 0) (not (bobp)))
-	(if (= (preceding-char) ?\t)
-	    (let ((col (current-column)))
-	      (forward-char -1)
-	      (setq col (- col (current-column)))
-	      (insert-char ?\ col)
-	      (delete-char 1)))
-	(forward-char -1)
-	(setq count (1- count)))))
-  (delete-backward-char arg killp))
-
-(defun zap-to-char (arg char)
-  "Kill up to and including ARG'th occurrence of CHAR.
-Goes backward if ARG is negative; error if CHAR not found."
-  (interactive "p\ncZap to char: ")
-  (kill-region (point) (progn
-			 (search-forward (char-to-string char) nil nil arg)
-;			 (goto-char (if (> arg 0) (1- (point)) (1+ (point))))
-			 (point))))
-
-(defun beginning-of-buffer (&optional arg)
-  "Move point to the beginning of the buffer; leave mark at previous position.
-With arg N, put point N/10 of the way from the beginning.
-
-If the buffer is narrowed, this command uses the beginning and size
-of the accessible part of the buffer.
-
-Don't use this command in Lisp programs!
-\(goto-char (point-min)) is faster and avoids clobbering the mark."
-  (interactive "P")
-  (push-mark)
-  (let ((size (- (point-max) (point-min))))
-    (goto-char (if arg
-		   (+ (point-min)
-		      (if (> size 10000)
-			  ;; Avoid overflow for large buffer sizes!
-			  (* (prefix-numeric-value arg)
-			     (/ size 10))
-			(/ (+ 10 (* size (prefix-numeric-value arg))) 10)))
-		 (point-min))))
-  (if arg (forward-line 1)))
-
-(defun end-of-buffer (&optional arg)
-  "Move point to the end of the buffer; leave mark at previous position.
-With arg N, put point N/10 of the way from the end.
-
-If the buffer is narrowed, this command uses the beginning and size
-of the accessible part of the buffer.
-
-Don't use this command in Lisp programs!
-\(goto-char (point-max)) is faster and avoids clobbering the mark."
-  (interactive "P")
-  (push-mark)
-  (let ((size (- (point-max) (point-min))))
-    (goto-char (if arg
-		   (- (point-max)
-		      (if (> size 10000)
-			  ;; Avoid overflow for large buffer sizes!
-			  (* (prefix-numeric-value arg)
-			     (/ size 10))
-			(/ (* size (prefix-numeric-value arg)) 10)))
-		 (point-max))))
-  ;; If we went to a place in the middle of the buffer,
-  ;; adjust it to the beginning of a line.
-  (if arg (forward-line 1)
-    ;; If the end of the buffer is not already on the screen,
-    ;; then scroll specially to put it near, but not at, the bottom.
-    (if (let ((old-point (point)))
-	  (save-excursion
-		    (goto-char (window-start))
-		    (vertical-motion (window-height))
-		    (< (point) old-point)))
-	(progn
-	  (overlay-recenter (point))
-	  (recenter -3)))))
-
-(defun mark-whole-buffer ()
-  "Put point at beginning and mark at end of buffer.
-You probably should not use this function in Lisp programs;
-it is usually a mistake for a Lisp function to use any subroutine
-that uses or sets the mark."
-  (interactive)
-  (push-mark (point))
-  (push-mark (point-max) nil t)
-  (goto-char (point-min)))
-
-(defun count-lines-region (start end)
-  "Print number of lines and characters in the region."
-  (interactive "r")
-  (message "Region has %d lines, %d characters"
-	   (count-lines start end) (- end start)))
-
-(defun what-line ()
-  "Print the current buffer line number and narrowed line number of point."
-  (interactive)
-  (let ((opoint (point)) start)
-    (save-excursion
-      (save-restriction
-	(goto-char (point-min))
-	(widen)
-	(beginning-of-line)
-	(setq start (point))
-	(goto-char opoint)
-	(beginning-of-line)
-	(if (/= start 1)
-	    (message "line %d (narrowed line %d)"
-		     (1+ (count-lines 1 (point)))
-		     (1+ (count-lines start (point))))
-	  (message "Line %d" (1+ (count-lines 1 (point)))))))))
-
-
-(defun count-lines (start end)
-  "Return number of lines between START and END.
-This is usually the number of newlines between them,
-but can be one more if START is not equal to END
-and the greater of them is not at the start of a line."
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char (point-min))
-      (if (eq selective-display t)
-	  (save-match-data
-	    (let ((done 0))
-	      (while (re-search-forward "[\n\C-m]" nil t 40)
-		(setq done (+ 40 done)))
-	      (while (re-search-forward "[\n\C-m]" nil t 1)
-		(setq done (+ 1 done)))
-	      (goto-char (point-max))
-	      (if (and (/= start end)
-		       (not (bolp)))
-		  (1+ done)
-		done)))
-	(- (buffer-size) (forward-line (buffer-size)))))))
-
-(defun what-cursor-position ()
-  "Print info on cursor position (on screen and within buffer)."
-  (interactive)
-  (let* ((char (following-char))
-	 (beg (point-min))
-	 (end (point-max))
-         (pos (point))
-	 (total (buffer-size))
-	 (percent (if (> total 50000)
-		      ;; Avoid overflow from multiplying by 100!
-		      (/ (+ (/ total 200) (1- pos)) (max (/ total 100) 1))
-		    (/ (+ (/ total 2) (* 100 (1- pos))) (max total 1))))
-	 (hscroll (if (= (window-hscroll) 0)
-		      ""
-		    (format " Hscroll=%d" (window-hscroll))))
-	 (col (current-column)))
-    (if (= pos end)
-	(if (or (/= beg 1) (/= end (1+ total)))
-	    (message "point=%d of %d(%d%%) <%d - %d>  column %d %s"
-		     pos total percent beg end col hscroll)
-	  (message "point=%d of %d(%d%%)  column %d %s"
-		   pos total percent col hscroll))
-      (if (or (/= beg 1) (/= end (1+ total)))
-	  (message "Char: %s (0%o, %d, 0x%x)  point=%d of %d(%d%%) <%d - %d>  column %d %s"
-		   (single-key-description char) char char char pos total percent beg end col hscroll)
-	(message "Char: %s (0%o, %d, 0x%x)  point=%d of %d(%d%%)  column %d %s"
-		 (single-key-description char) char char char pos total percent col hscroll)))))
-
-(defun fundamental-mode ()
-  "Major mode not specialized for anything in particular.
-Other major modes are defined by comparison with this one."
-  (interactive)
-  (kill-all-local-variables))
-
-(defvar read-expression-map (cons 'keymap minibuffer-local-map)
-  "Minibuffer keymap used for reading Lisp expressions.")
-(define-key read-expression-map "\M-\t" 'lisp-complete-symbol)
-
-(put 'eval-expression 'disabled t)
-
-(defvar read-expression-history nil)
-
-;; We define this, rather than making `eval' interactive,
-;; for the sake of completion of names like eval-region, eval-current-buffer.
-(defun eval-expression (expression)
-  "Evaluate EXPRESSION and print value in minibuffer.
-Value is also consed on to front of the variable `values'."
-  (interactive
-   (list (read-from-minibuffer "Eval: "
-			       nil read-expression-map t
-			       'read-expression-history)))
-  (setq values (cons (eval expression) values))
-  (prin1 (car values) t))
-
-(defun edit-and-eval-command (prompt command)
-  "Prompting with PROMPT, let user edit COMMAND and eval result.
-COMMAND is a Lisp expression.  Let user edit that expression in
-the minibuffer, then read and evaluate the result."
-  (let ((command (read-from-minibuffer prompt
-				       (prin1-to-string command)
-				       read-expression-map t
-				       '(command-history . 1))))
-    ;; If command was added to command-history as a string,
-    ;; get rid of that.  We want only evaluable expressions there.
-    (if (stringp (car command-history))
-	(setq command-history (cdr command-history)))
-
-    ;; If command to be redone does not match front of history,
-    ;; add it to the history.
-    (or (equal command (car command-history))
-	(setq command-history (cons command command-history)))
-    (eval command)))
-
-(defun repeat-complex-command (arg)
-  "Edit and re-evaluate last complex command, or ARGth from last.
-A complex command is one which used the minibuffer.
-The command is placed in the minibuffer as a Lisp form for editing.
-The result is executed, repeating the command as changed.
-If the command has been changed or is not the most recent previous command
-it is added to the front of the command history.
-You can use the minibuffer history commands \\<minibuffer-local-map>\\[next-history-element] and \\[previous-history-element]
-to get different commands to edit and resubmit."
-  (interactive "p")
-  (let ((elt (nth (1- arg) command-history))
-	newcmd)
-    (if elt
-	(progn
-	  (setq newcmd
-		(let ((print-level nil)
-		      (minibuffer-history-position arg)
-		      (minibuffer-history-sexp-flag t))
-		  (read-from-minibuffer
-		   "Redo: " (prin1-to-string elt) read-expression-map t
-		   (cons 'command-history arg))))
-
-	  ;; If command was added to command-history as a string,
-	  ;; get rid of that.  We want only evaluable expressions there.
-	  (if (stringp (car command-history))
-	      (setq command-history (cdr command-history)))
-
-	  ;; If command to be redone does not match front of history,
-	  ;; add it to the history.
-	  (or (equal newcmd (car command-history))
-	      (setq command-history (cons newcmd command-history)))
-	  (eval newcmd))
-      (ding))))
-
-(defvar minibuffer-history nil
-  "Default minibuffer history list.
-This is used for all minibuffer input
-except when an alternate history list is specified.")
-(defvar minibuffer-history-sexp-flag nil
-  "Non-nil when doing history operations on `command-history'.
-More generally, indicates that the history list being acted on
-contains expressions rather than strings.")
-(setq minibuffer-history-variable 'minibuffer-history)
-(setq minibuffer-history-position nil)
-(defvar minibuffer-history-search-history nil)
-
-(mapcar
- (lambda (key-and-command)
-   (mapcar
-    (lambda (keymap-and-completionp)
-      ;; Arg is (KEYMAP-SYMBOL . COMPLETION-MAP-P).
-      ;; If the cdr of KEY-AND-COMMAND (the command) is a cons,
-      ;; its car is used if COMPLETION-MAP-P is nil, its cdr if it is t.
-      (define-key (symbol-value (car keymap-and-completionp))
-	(car key-and-command)
-	(let ((command (cdr key-and-command)))
-	  (if (consp command)
-	      ;; (and ... nil) => ... turns back on the completion-oriented
-	      ;; history commands which rms turned off since they seem to
-	      ;; do things he doesn't like.
-	      (if (and (cdr keymap-and-completionp) nil) ;XXX turned off
-		  (progn (error "EMACS BUG!") (cdr command))
-		(car command))
-	    command))))
-    '((minibuffer-local-map . nil)
-      (minibuffer-local-ns-map . nil)
-      (minibuffer-local-completion-map . t)
-      (minibuffer-local-must-match-map . t)
-      (read-expression-map . nil))))
- '(("\en" . (next-history-element . next-complete-history-element))
-   ([next] . (next-history-element . next-complete-history-element))
-   ("\ep" . (previous-history-element . previous-complete-history-element))
-   ([prior] . (previous-history-element . previous-complete-history-element))
-   ("\er" . previous-matching-history-element)
-   ("\es" . next-matching-history-element)))
-
-(defun previous-matching-history-element (regexp n)
-  "Find the previous history element that matches REGEXP.
-\(Previous history elements refer to earlier actions.)
-With prefix argument N, search for Nth previous match.
-If N is negative, find the next or Nth next match."
-  (interactive
-   (let* ((enable-recursive-minibuffers t)
-	  (minibuffer-history-sexp-flag nil)
-	  (regexp (read-from-minibuffer "Previous element matching (regexp): "
-					nil
-					minibuffer-local-map
-					nil
-					'minibuffer-history-search-history)))
-     ;; Use the last regexp specified, by default, if input is empty.
-     (list (if (string= regexp "")
-	       (if minibuffer-history-search-history
-		   (car minibuffer-history-search-history)
-		 (error "No previous history search regexp"))
-	     regexp)
-	   (prefix-numeric-value current-prefix-arg))))
-  (let ((history (symbol-value minibuffer-history-variable))
-	prevpos
-	(pos minibuffer-history-position))
-    (while (/= n 0)
-      (setq prevpos pos)
-      (setq pos (min (max 1 (+ pos (if (< n 0) -1 1))) (length history)))
-      (if (= pos prevpos)
-	  (error (if (= pos 1)
-		     "No later matching history item"
-		   "No earlier matching history item")))
-      (if (string-match regexp
-			(if minibuffer-history-sexp-flag
-			    (let ((print-level nil))
-			      (prin1-to-string (nth (1- pos) history)))
-			  (nth (1- pos) history)))
-	  (setq n (+ n (if (< n 0) 1 -1)))))
-    (setq minibuffer-history-position pos)
-    (erase-buffer)
-    (let ((elt (nth (1- pos) history)))
-      (insert (if minibuffer-history-sexp-flag
-		  (let ((print-level nil))
-		    (prin1-to-string elt))
-		elt)))
-      (goto-char (point-min)))
-  (if (or (eq (car (car command-history)) 'previous-matching-history-element)
-	  (eq (car (car command-history)) 'next-matching-history-element))
-      (setq command-history (cdr command-history))))
-
-(defun next-matching-history-element (regexp n)
-  "Find the next history element that matches REGEXP.
-\(The next history element refers to a more recent action.)
-With prefix argument N, search for Nth next match.
-If N is negative, find the previous or Nth previous match."
-  (interactive
-   (let* ((enable-recursive-minibuffers t)
-	  (minibuffer-history-sexp-flag nil)
-	  (regexp (read-from-minibuffer "Next element matching (regexp): "
-					nil
-					minibuffer-local-map
-					nil
-					'minibuffer-history-search-history)))
-     ;; Use the last regexp specified, by default, if input is empty.
-     (list (if (string= regexp "")
-	       (setcar minibuffer-history-search-history
-		       (nth 1 minibuffer-history-search-history))
-	     regexp)
-	   (prefix-numeric-value current-prefix-arg))))
-  (previous-matching-history-element regexp (- n)))
-
-(defun next-history-element (n)
-  "Insert the next element of the minibuffer history into the minibuffer."
-  (interactive "p")
-  (or (zerop n)
-      (let ((narg (min (max 1 (- minibuffer-history-position n))
-		       (length (symbol-value minibuffer-history-variable)))))
-	    (if (or (zerop narg)
-		    (= minibuffer-history-position narg))
-		(error (if (if (zerop narg)
-			       (> n 0)
-			     (= minibuffer-history-position 1))
-		       "End of history; no next item"
-		     "Beginning of history; no preceding item"))
-	  (erase-buffer)
-	  (setq minibuffer-history-position narg)
-	  (let ((elt (nth (1- minibuffer-history-position)
-			  (symbol-value minibuffer-history-variable))))
-	    (insert
-	     (if minibuffer-history-sexp-flag
-		 (let ((print-level nil))
-		   (prin1-to-string elt))
-	       elt)))
-	  (goto-char (point-min))))))
-
-(defun previous-history-element (n)
-  "Inserts the previous element of the minibuffer history into the minibuffer."
-  (interactive "p")
-  (next-history-element (- n)))
-
-(defun next-complete-history-element (n)
-  "Get next element of history which is a completion of minibuffer contents."
-  (interactive "p")
-  (let ((point-at-start (point)))
-    (next-matching-history-element
-     (concat "^" (regexp-quote (buffer-substring (point-min) (point)))) n)
-    ;; next-matching-history-element always puts us at (point-min).
-    ;; Move to the position we were at before changing the buffer contents.
-    ;; This is still sensical, because the text before point has not changed.
-    (goto-char point-at-start)))
-
-(defun previous-complete-history-element (n)
-  "\
-Get previous element of history which is a completion of minibuffer contents."
-  (interactive "p")
-  (next-complete-history-element (- n)))
-
-(defun goto-line (arg)
-  "Goto line ARG, counting from line 1 at beginning of buffer."
-  (interactive "NGoto line: ")
-  (setq arg (prefix-numeric-value arg))
-  (save-restriction
-    (widen)
-    (goto-char 1)
-    (if (eq selective-display t)
-	(re-search-forward "[\n\C-m]" nil 'end (1- arg))
-      (forward-line (1- arg)))))
-
-;Put this on C-x u, so we can force that rather than C-_ into startup msg
-(defalias 'advertised-undo 'undo)
-
-(defun undo (&optional arg)
-  "Undo some previous changes.
-Repeat this command to undo more changes.
-A numeric argument serves as a repeat count."
-  (interactive "*p")
-  ;; If we don't get all the way thru, make last-command indicate that
-  ;; for the following command.
-  (setq this-command t)
-  (let ((modified (buffer-modified-p))
-	(recent-save (recent-auto-save-p)))
-    (or (eq (selected-window) (minibuffer-window))
-	(message "Undo!"))
-    (or (eq last-command 'undo)
-	(progn (undo-start)
-	       (undo-more 1)))
-    (undo-more (or arg 1))
-    ;; Don't specify a position in the undo record for the undo command.
-    ;; Instead, undoing this should move point to where the change is.
-    (let ((tail buffer-undo-list)
-	  done)
-      (while (and tail (not done) (not (null (car tail))))
-	(if (integerp (car tail))
-	    (progn
-	      (setq done t)
-	      (setq buffer-undo-list (delq (car tail) buffer-undo-list))))
-	(setq tail (cdr tail))))
-    (and modified (not (buffer-modified-p))
-	 (delete-auto-save-file-if-necessary recent-save)))
-  ;; If we do get all the way thru, make this-command indicate that.
-  (setq this-command 'undo))
-
-(defvar pending-undo-list nil
-  "Within a run of consecutive undo commands, list remaining to be undone.")
-
-(defun undo-start ()
-  "Set `pending-undo-list' to the front of the undo list.
-The next call to `undo-more' will undo the most recently made change."
-  (if (eq buffer-undo-list t)
-      (error "No undo information in this buffer"))
-  (setq pending-undo-list buffer-undo-list))
-
-(defun undo-more (count)
-  "Undo back N undo-boundaries beyond what was already undone recently.
-Call `undo-start' to get ready to undo recent changes,
-then call `undo-more' one or more times to undo them."
-  (or pending-undo-list
-      (error "No further undo information"))
-  (setq pending-undo-list (primitive-undo count pending-undo-list)))
-
-(defvar shell-command-history nil
-  "History list for some commands that read shell commands.")
-
-(defvar shell-command-switch "-c"
-  "Switch used to have the shell execute its command line argument.")
-
-(defun shell-command (command &optional output-buffer)
-  "Execute string COMMAND in inferior shell; display output, if any.
-
-If COMMAND ends in ampersand, execute it asynchronously.
-The output appears in the buffer `*Async Shell Command*'.
-That buffer is in shell mode.
-
-Otherwise, COMMAND is executed synchronously.  The output appears in the
-buffer `*Shell Command Output*'.
-If the output is one line, it is displayed in the echo area *as well*,
-but it is nonetheless available in buffer `*Shell Command Output*',
-even though that buffer is not automatically displayed.
-If there is no output, or if output is inserted in the current buffer,
-then `*Shell Command Output*' is deleted.
-
-The optional second argument OUTPUT-BUFFER, if non-nil,
-says to put the output in some other buffer.
-If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
-If OUTPUT-BUFFER is not a buffer and not nil,
-insert output in current buffer.  (This cannot be done asynchronously.)
-In either case, the output is inserted after point (leaving mark after it)."
-  (interactive (list (read-from-minibuffer "Shell command: "
-					   nil nil nil 'shell-command-history)
-		     current-prefix-arg))
-  ;; Look for a handler in case default-directory is a remote file name.
-  (let ((handler
-	 (find-file-name-handler (directory-file-name default-directory)
-				 'shell-command)))
-    (if handler
-	(funcall handler 'shell-command command output-buffer)
-      (if (and output-buffer
-	       (not (or (bufferp output-buffer)  (stringp output-buffer))))
-	  (progn (barf-if-buffer-read-only)
-		 (push-mark)
-		 ;; We do not use -f for csh; we will not support broken use of
-		 ;; .cshrcs.  Even the BSD csh manual says to use
-		 ;; "if ($?prompt) exit" before things which are not useful
-		 ;; non-interactively.  Besides, if someone wants their other
-		 ;; aliases for shell commands then they can still have them.
-		 (call-process shell-file-name nil t nil
-			       shell-command-switch command)
-		 ;; This is like exchange-point-and-mark, but doesn't
-		 ;; activate the mark.  It is cleaner to avoid activation,
-		 ;; even though the command loop would deactivate the mark
-		 ;; because we inserted text.
-		 (goto-char (prog1 (mark t)
-			      (set-marker (mark-marker) (point)
-					  (current-buffer)))))
-	;; Preserve the match data in case called from a program.
-	(save-match-data
-	  (if (string-match "[ \t]*&[ \t]*$" command)
-	      ;; Command ending with ampersand means asynchronous.
-	      (let ((buffer (get-buffer-create
-			     (or output-buffer "*Async Shell Command*")))
-		    (directory default-directory)
-		    proc)
-		;; Remove the ampersand.
-		(setq command (substring command 0 (match-beginning 0)))
-		;; If will kill a process, query first.
-		(setq proc (get-buffer-process buffer))
-		(if proc
-		    (if (yes-or-no-p "A command is running.  Kill it? ")
-			(kill-process proc)
-		      (error "Shell command in progress")))
-		(save-excursion
-		  (set-buffer buffer)
-		  (setq buffer-read-only nil)
-		  (erase-buffer)
-		  (display-buffer buffer)
-		  (setq default-directory directory)
-		  (setq proc (start-process "Shell" buffer shell-file-name 
-					    shell-command-switch command))
-		  (setq mode-line-process '(":%s"))
-		  (require 'shell) (shell-mode)
-		  (set-process-sentinel proc 'shell-command-sentinel)
-		  ))
-	    (shell-command-on-region (point) (point) command output-buffer)
-	    ))))))
-
-;; We have a sentinel to prevent insertion of a termination message
-;; in the buffer itself.
-(defun shell-command-sentinel (process signal)
-  (if (memq (process-status process) '(exit signal))
-      (message "%s: %s." 
-	       (car (cdr (cdr (process-command process))))
-	       (substring signal 0 -1))))
-
-(defun shell-command-on-region (start end command
-				      &optional output-buffer replace)
-  "Execute string COMMAND in inferior shell with region as input.
-Normally display output (if any) in temp buffer `*Shell Command Output*';
-Prefix arg means replace the region with it.
-
-The noninteractive arguments are START, END, COMMAND, OUTPUT-BUFFER, REPLACE.
-If REPLACE is non-nil, that means insert the output
-in place of text from START to END, putting point and mark around it.
-
-If the output is one line, it is displayed in the echo area,
-but it is nonetheless available in buffer `*Shell Command Output*'
-even though that buffer is not automatically displayed.
-If there is no output, or if output is inserted in the current buffer,
-then `*Shell Command Output*' is deleted.
-
-If the optional fourth argument OUTPUT-BUFFER is non-nil,
-that says to put the output in some other buffer.
-If OUTPUT-BUFFER is a buffer or buffer name, put the output there.
-If OUTPUT-BUFFER is not a buffer and not nil,
-insert output in the current buffer.
-In either case, the output is inserted after point (leaving mark after it)."
-  (interactive (let ((string
-		      ;; Do this before calling region-beginning
-		      ;; and region-end, in case subprocess output
-		      ;; relocates them while we are in the minibuffer.
-		      (read-from-minibuffer "Shell command on region: "
-					    nil nil nil
-					    'shell-command-history)))
-		 ;; call-interactively recognizes region-beginning and
-		 ;; region-end specially, leaving them in the history.
-		 (list (region-beginning) (region-end)
-		       string
-		       current-prefix-arg
-		       current-prefix-arg)))
-  (if (or replace
-	  (and output-buffer
-	       (not (or (bufferp output-buffer) (stringp output-buffer))))
-	  (equal (buffer-name (current-buffer)) "*Shell Command Output*"))
-      ;; Replace specified region with output from command.
-      (let ((swap (and replace (< start end))))
-	;; Don't muck with mark unless REPLACE says we should.
-	(goto-char start)
-	(and replace (push-mark))
-	(call-process-region start end shell-file-name t t nil
-			     shell-command-switch command)
-	(let ((shell-buffer (get-buffer "*Shell Command Output*")))
-	  (and shell-buffer (not (eq shell-buffer (current-buffer)))
-	       (kill-buffer shell-buffer)))
-	;; Don't muck with mark unless REPLACE says we should.
-	(and replace swap (exchange-point-and-mark)))
-    ;; No prefix argument: put the output in a temp buffer,
-    ;; replacing its entire contents.
-    (let ((buffer (get-buffer-create
-		   (or output-buffer "*Shell Command Output*")))
-	  (success nil))
-      (unwind-protect
-	  (if (eq buffer (current-buffer))
-	      ;; If the input is the same buffer as the output,
-	      ;; delete everything but the specified region,
-	      ;; then replace that region with the output.
-	      (progn (setq buffer-read-only nil)
-		     (delete-region (max start end) (point-max))
-		     (delete-region (point-min) (min start end))
-		     (call-process-region (point-min) (point-max)
-					  shell-file-name t t nil
-					  shell-command-switch command)
-		     (setq success t))
-	    ;; Clear the output buffer, then run the command with output there.
-	    (save-excursion
-	      (set-buffer buffer)
-	      (setq buffer-read-only nil)
-	      (erase-buffer))
-	    (call-process-region start end shell-file-name
-				 nil buffer nil
-				 shell-command-switch command)
-	    (setq success t))
-	;; Report the amount of output.
-	(let ((lines (save-excursion
-		       (set-buffer buffer)
-		       (if (= (buffer-size) 0)
-			   0
-			 (count-lines (point-min) (point-max))))))
-	  (cond ((= lines 0)
-		 (if success
-		     (message "(Shell command completed with no output)"))
-		 (kill-buffer buffer))
-		((and success (= lines 1))
-		 (message "%s"
-			  (save-excursion
-			    (set-buffer buffer)
-			    (goto-char (point-min))
-			    (buffer-substring (point)
-					      (progn (end-of-line) (point))))))
-		(t 
-		 (save-excursion
-		   (set-buffer buffer)
-		   (goto-char (point-min)))
-		 (display-buffer buffer))))))))
-       
-(defun shell-command-to-string (command)
-  "Execute shell command COMMAND and return its output as a string."
-  (with-output-to-string
-    (with-current-buffer
-      standard-output
-      (call-process shell-file-name nil t nil shell-command-switch command))))
-
-(defvar universal-argument-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map [t] 'universal-argument-other-key)
-    (define-key map (vector meta-prefix-char t) 'universal-argument-other-key)
-    (define-key map [switch-frame] nil)
-    (define-key map [?\C-u] 'universal-argument-more)
-    (define-key map [?-] 'universal-argument-minus)
-    (define-key map [?0] 'digit-argument)
-    (define-key map [?1] 'digit-argument)
-    (define-key map [?2] 'digit-argument)
-    (define-key map [?3] 'digit-argument)
-    (define-key map [?4] 'digit-argument)
-    (define-key map [?5] 'digit-argument)
-    (define-key map [?6] 'digit-argument)
-    (define-key map [?7] 'digit-argument)
-    (define-key map [?8] 'digit-argument)
-    (define-key map [?9] 'digit-argument)
-    map)
-  "Keymap used while processing \\[universal-argument].")
-
-(defvar universal-argument-num-events nil
-  "Number of argument-specifying events read by `universal-argument'.
-`universal-argument-other-key' uses this to discard those events
-from (this-command-keys), and reread only the final command.")
-
-(defun universal-argument ()
-  "Begin a numeric argument for the following command.
-Digits or minus sign following \\[universal-argument] make up the numeric argument.
-\\[universal-argument] following the digits or minus sign ends the argument.
-\\[universal-argument] without digits or minus sign provides 4 as argument.
-Repeating \\[universal-argument] without digits or minus sign
- multiplies the argument by 4 each time.
-For some commands, just \\[universal-argument] by itself serves as a flag
-which is different in effect from any particular numeric argument.
-These commands include \\[set-mark-command] and \\[start-kbd-macro]."
-  (interactive)
-  (setq prefix-arg (list 4))
-  (setq universal-argument-num-events (length (this-command-keys)))
-  (setq overriding-terminal-local-map universal-argument-map))
-
-;; A subsequent C-u means to multiply the factor by 4 if we've typed
-;; nothing but C-u's; otherwise it means to terminate the prefix arg.
-(defun universal-argument-more (arg)
-  (interactive "P")
-  (if (consp arg)
-      (setq prefix-arg (list (* 4 (car arg))))
-    (setq prefix-arg arg)
-    (setq overriding-terminal-local-map nil))
-  (setq universal-argument-num-events (length (this-command-keys))))
-
-(defun negative-argument (arg)
-  "Begin a negative numeric argument for the next command.
-\\[universal-argument] following digits or minus sign ends the argument."
-  (interactive "P")
-  (cond ((integerp arg)
-	 (setq prefix-arg (- arg)))
-	((eq arg '-)
-	 (setq prefix-arg nil))
-	(t
-	 (setq prefix-arg '-)))
-  (setq universal-argument-num-events (length (this-command-keys)))
-  (setq overriding-terminal-local-map universal-argument-map))
-
-(defun digit-argument (arg)
-  "Part of the numeric argument for the next command.
-\\[universal-argument] following digits or minus sign ends the argument."
-  (interactive "P")
-  (let ((digit (- (logand last-command-char ?\177) ?0)))
-    (cond ((integerp arg)
-	   (setq prefix-arg (+ (* arg 10)
-			       (if (< arg 0) (- digit) digit))))
-	  ((eq arg '-)
-	   ;; Treat -0 as just -, so that -01 will work.
-	   (setq prefix-arg (if (zerop digit) '- (- digit))))
-	  (t
-	   (setq prefix-arg digit))))
-  (setq universal-argument-num-events (length (this-command-keys)))
-  (setq overriding-terminal-local-map universal-argument-map))
-
-;; For backward compatibility, minus with no modifiers is an ordinary
-;; command if digits have already been entered.
-(defun universal-argument-minus (arg)
-  (interactive "P")
-  (if (integerp arg)
-      (universal-argument-other-key arg)
-    (negative-argument arg)))
-
-;; Anything else terminates the argument and is left in the queue to be
-;; executed as a command.
-(defun universal-argument-other-key (arg)
-  (interactive "P")
-  (setq prefix-arg arg)
-  (let* ((key (this-command-keys))
-	 (keylist (listify-key-sequence key)))
-    (setq unread-command-events
-	  (append (nthcdr universal-argument-num-events keylist)
-		  unread-command-events)))
-  (reset-this-command-lengths)
-  (setq overriding-terminal-local-map nil))
-
-(defun forward-to-indentation (arg)
-  "Move forward ARG lines and position at first nonblank character."
-  (interactive "p")
-  (forward-line arg)
-  (skip-chars-forward " \t"))
-
-(defun backward-to-indentation (arg)
-  "Move backward ARG lines and position at first nonblank character."
-  (interactive "p")
-  (forward-line (- arg))
-  (skip-chars-forward " \t"))
-
-(defvar kill-whole-line nil
-  "*If non-nil, `kill-line' with no arg at beg of line kills the whole line.")
-
-(defun kill-line (&optional arg)
-  "Kill the rest of the current line; if no nonblanks there, kill thru newline.
-With prefix argument, kill that many lines from point.
-Negative arguments kill lines backward.
-
-When calling from a program, nil means \"no arg\",
-a number counts as a prefix arg.
-
-If `kill-whole-line' is non-nil, then kill the whole line
-when given no argument at the beginning of a line."
-  (interactive "P")
-  (kill-region (point)
-	       ;; It is better to move point to the other end of the kill
-	       ;; before killing.  That way, in a read-only buffer, point
-	       ;; moves across the text that is copied to the kill ring.
-	       ;; The choice has no effect on undo now that undo records
-	       ;; the value of point from before the command was run.
-	       (progn
-		 (if arg
-		     (forward-line (prefix-numeric-value arg))
-		   (if (eobp)
-		       (signal 'end-of-buffer nil))
-		   (if (or (looking-at "[ \t]*$") (and kill-whole-line (bolp)))
-		       (forward-line 1)
-		     (end-of-line)))
-		 (point))))
-
-;;;; Window system cut and paste hooks.
-
-(defvar interprogram-cut-function nil
-  "Function to call to make a killed region available to other programs.
-
-Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.
-This variable holds a function that Emacs calls whenever text
-is put in the kill ring, to make the new kill available to other
-programs.
-
-The function takes one or two arguments.
-The first argument, TEXT, is a string containing
-the text which should be made available.
-The second, PUSH, if non-nil means this is a \"new\" kill;
-nil means appending to an \"old\" kill.")
-
-(defvar interprogram-paste-function nil
-  "Function to call to get text cut from other programs.
-
-Most window systems provide some sort of facility for cutting and
-pasting text between the windows of different programs.
-This variable holds a function that Emacs calls to obtain
-text that other programs have provided for pasting.
-
-The function should be called with no arguments.  If the function
-returns nil, then no other program has provided such text, and the top
-of the Emacs kill ring should be used.  If the function returns a
-string, that string should be put in the kill ring as the latest kill.
-
-Note that the function should return a string only if a program other
-than Emacs has provided a string for pasting; if Emacs provided the
-most recent string, the function should return nil.  If it is
-difficult to tell whether Emacs or some other program provided the
-current string, it is probably good enough to return nil if the string
-is equal (according to `string=') to the last text Emacs provided.")
-
-
-
-;;;; The kill ring data structure.
-
-(defvar kill-ring nil
-  "List of killed text sequences.
-Since the kill ring is supposed to interact nicely with cut-and-paste
-facilities offered by window systems, use of this variable should
-interact nicely with `interprogram-cut-function' and
-`interprogram-paste-function'.  The functions `kill-new',
-`kill-append', and `current-kill' are supposed to implement this
-interaction; you may want to use them instead of manipulating the kill
-ring directly.")
-
-(defvar kill-ring-max 30
-  "*Maximum length of kill ring before oldest elements are thrown away.")
-
-(defvar kill-ring-yank-pointer nil
-  "The tail of the kill ring whose car is the last thing yanked.")
-
-(defun kill-new (string &optional replace)
-  "Make STRING the latest kill in the kill ring.
-Set the kill-ring-yank pointer to point to it.
-If `interprogram-cut-function' is non-nil, apply it to STRING.
-Optional second argument REPLACE non-nil means that STRING will replace
-the front of the kill ring, rather than being added to the list."
-  (and (fboundp 'menu-bar-update-yank-menu)
-       (menu-bar-update-yank-menu string (and replace (car kill-ring))))
-  (if replace
-      (setcar kill-ring string)
-    (setq kill-ring (cons string kill-ring))
-    (if (> (length kill-ring) kill-ring-max)
-	(setcdr (nthcdr (1- kill-ring-max) kill-ring) nil)))
-  (setq kill-ring-yank-pointer kill-ring)
-  (if interprogram-cut-function
-      (funcall interprogram-cut-function string (not replace))))
-
-(defun kill-append (string before-p)
-  "Append STRING to the end of the latest kill in the kill ring.
-If BEFORE-P is non-nil, prepend STRING to the kill.
-If `interprogram-cut-function' is set, pass the resulting kill to
-it."
-  (kill-new (if before-p
-		(concat string (car kill-ring))
-	      (concat (car kill-ring) string)) t))
-
-(defun current-kill (n &optional do-not-move)
-  "Rotate the yanking point by N places, and then return that kill.
-If N is zero, `interprogram-paste-function' is set, and calling it
-returns a string, then that string is added to the front of the
-kill ring and returned as the latest kill.
-If optional arg DO-NOT-MOVE is non-nil, then don't actually move the 
-yanking point; just return the Nth kill forward."
-  (let ((interprogram-paste (and (= n 0)
-				 interprogram-paste-function
-				 (funcall interprogram-paste-function))))
-    (if interprogram-paste
-	(progn
-	  ;; Disable the interprogram cut function when we add the new
-	  ;; text to the kill ring, so Emacs doesn't try to own the
-	  ;; selection, with identical text.
-	  (let ((interprogram-cut-function nil))
-	    (kill-new interprogram-paste))
-	  interprogram-paste)
-      (or kill-ring (error "Kill ring is empty"))
-      (let ((ARGth-kill-element
-	     (nthcdr (mod (- n (length kill-ring-yank-pointer))
-			  (length kill-ring))
-		     kill-ring)))
-	(or do-not-move
-	    (setq kill-ring-yank-pointer ARGth-kill-element))
-	(car ARGth-kill-element)))))
-
-
-
-;;;; Commands for manipulating the kill ring.
-
-(defvar kill-read-only-ok nil
-  "*Non-nil means don't signal an error for killing read-only text.")
-
-(put 'text-read-only 'error-conditions
-     '(text-read-only buffer-read-only error))
-(put 'text-read-only 'error-message "Text is read-only")
-
-(defun kill-region (beg end)
-  "Kill between point and mark.
-The text is deleted but saved in the kill ring.
-The command \\[yank] can retrieve it from there.
-\(If you want to kill and then yank immediately, use \\[copy-region-as-kill].)
-If the buffer is read-only, Emacs will beep and refrain from deleting
-the text, but put the text in the kill ring anyway.  This means that
-you can use the killing commands to copy text from a read-only buffer.
-
-This is the primitive for programs to kill text (as opposed to deleting it).
-Supply two arguments, character numbers indicating the stretch of text
- to be killed.
-Any command that calls this function is a \"kill command\".
-If the previous command was also a kill command,
-the text killed this time appends to the text killed last time
-to make one entry in the kill ring."
-  (interactive "r")
-  (cond
-
-   ;; If the buffer is read-only, we should beep, in case the person
-   ;; just isn't aware of this.  However, there's no harm in putting
-   ;; the region's text in the kill ring, anyway.
-   ((and (not inhibit-read-only)
-	 (or buffer-read-only
-	     (text-property-not-all beg end 'read-only nil)))
-    (copy-region-as-kill beg end)
-    ;; This should always barf, and give us the correct error.
-    (if kill-read-only-ok
-	(message "Read only text copied to kill ring")
-      (setq this-command 'kill-region)
-      ;; Signal an error if the buffer is read-only.
-      (barf-if-buffer-read-only)
-      ;; If the buffer isn't read-only, the text is.
-      (signal 'text-read-only (list (current-buffer)))))
-
-   ;; In certain cases, we can arrange for the undo list and the kill
-   ;; ring to share the same string object.  This code does that.
-   ((not (or (eq buffer-undo-list t)
-	     (eq last-command 'kill-region)
-	     ;; Use = since positions may be numbers or markers.
-	     (= beg end)))
-    ;; Don't let the undo list be truncated before we can even access it.
-    (let ((undo-strong-limit (+ (- (max beg end) (min beg end)) 100))
-	  (old-list buffer-undo-list)
-	  tail)
-      (delete-region beg end)
-      ;; Search back in buffer-undo-list for this string,
-      ;; in case a change hook made property changes.
-      (setq tail buffer-undo-list)
-      (while (not (stringp (car (car tail))))
-	(setq tail (cdr tail)))
-      ;; Take the same string recorded for undo
-      ;; and put it in the kill-ring.
-      (kill-new (car (car tail)))))
-
-   (t
-    (copy-region-as-kill beg end)
-    (delete-region beg end)))
-  (setq this-command 'kill-region))
-
-;; copy-region-as-kill no longer sets this-command, because it's confusing
-;; to get two copies of the text when the user accidentally types M-w and
-;; then corrects it with the intended C-w.
-(defun copy-region-as-kill (beg end)
-  "Save the region as if killed, but don't kill it.
-If `interprogram-cut-function' is non-nil, also save the text for a window
-system cut and paste."
-  (interactive "r")
-  (if (eq last-command 'kill-region)
-      (kill-append (buffer-substring beg end) (< end beg))
-    (kill-new (buffer-substring beg end)))
-  nil)
-
-(defun kill-ring-save (beg end)
-  "Save the region as if killed, but don't kill it.
-This command is similar to `copy-region-as-kill', except that it gives
-visual feedback indicating the extent of the region being copied.
-If `interprogram-cut-function' is non-nil, also save the text for a window
-system cut and paste."
-  (interactive "r")
-  (copy-region-as-kill beg end)
-  (if (interactive-p)
-      (let ((other-end (if (= (point) beg) end beg))
-	    (opoint (point))
-	    ;; Inhibit quitting so we can make a quit here
-	    ;; look like a C-g typed as a command.
-	    (inhibit-quit t))
-	(if (pos-visible-in-window-p other-end (selected-window))
-	    (progn
-	      ;; Swap point and mark.
-	      (set-marker (mark-marker) (point) (current-buffer))
-	      (goto-char other-end)
-	      (sit-for 1)
-	      ;; Swap back.
-	      (set-marker (mark-marker) other-end (current-buffer))
-	      (goto-char opoint)
-	      ;; If user quit, deactivate the mark
-	      ;; as C-g would as a command.
-	      (and quit-flag mark-active
-		   (deactivate-mark)))
-	  (let* ((killed-text (current-kill 0))
-		 (message-len (min (length killed-text) 40)))
-	    (if (= (point) beg)
-		;; Don't say "killed"; that is misleading.
-		(message "Saved text until \"%s\""
-			(substring killed-text (- message-len)))
-	      (message "Saved text from \"%s\""
-		      (substring killed-text 0 message-len))))))))
-
-(defun append-next-kill ()
-  "Cause following command, if it kills, to append to previous kill."
-  (interactive)
-  (if (interactive-p)
-      (progn
-	(setq this-command 'kill-region)
-	(message "If the next command is a kill, it will append"))
-    (setq last-command 'kill-region)))
-
-(defun yank-pop (arg)
-  "Replace just-yanked stretch of killed text with a different stretch.
-This command is allowed only immediately after a `yank' or a `yank-pop'.
-At such a time, the region contains a stretch of reinserted
-previously-killed text.  `yank-pop' deletes that text and inserts in its
-place a different stretch of killed text.
-
-With no argument, the previous kill is inserted.
-With argument N, insert the Nth previous kill.
-If N is negative, this is a more recent kill.
-
-The sequence of kills wraps around, so that after the oldest one
-comes the newest one."
-  (interactive "*p")
-  (if (not (eq last-command 'yank))
-      (error "Previous command was not a yank"))
-  (setq this-command 'yank)
-  (let ((inhibit-read-only t)
-	(before (< (point) (mark t))))
-    (delete-region (point) (mark t))
-    (set-marker (mark-marker) (point) (current-buffer))
-    (insert (current-kill arg))
-    (if before
-	;; This is like exchange-point-and-mark, but doesn't activate the mark.
-	;; It is cleaner to avoid activation, even though the command
-	;; loop would deactivate the mark because we inserted text.
-	(goto-char (prog1 (mark t)
-		     (set-marker (mark-marker) (point) (current-buffer))))))
-  nil)
-
-(defun yank (&optional arg)
-  "Reinsert the last stretch of killed text.
-More precisely, reinsert the stretch of killed text most recently
-killed OR yanked.  Put point at end, and set mark at beginning.
-With just C-u as argument, same but put point at beginning (and mark at end).
-With argument N, reinsert the Nth most recently killed stretch of killed
-text.
-See also the command \\[yank-pop]."
-  (interactive "*P")
-  ;; If we don't get all the way thru, make last-command indicate that
-  ;; for the following command.
-  (setq this-command t)
-  (push-mark (point))
-  (insert (current-kill (cond
-			 ((listp arg) 0)
-			 ((eq arg '-) -1)
-			 (t (1- arg)))))
-  (if (consp arg)
-      ;; This is like exchange-point-and-mark, but doesn't activate the mark.
-      ;; It is cleaner to avoid activation, even though the command
-      ;; loop would deactivate the mark because we inserted text.
-      (goto-char (prog1 (mark t)
-		   (set-marker (mark-marker) (point) (current-buffer)))))
-  ;; If we do get all the way thru, make this-command indicate that.
-  (setq this-command 'yank)
-  nil)
-
-(defun rotate-yank-pointer (arg)
-  "Rotate the yanking point in the kill ring.
-With argument, rotate that many kills forward (or backward, if negative)."
-  (interactive "p")
-  (current-kill arg))
-
-
-(defun insert-buffer (buffer)
-  "Insert after point the contents of BUFFER.
-Puts mark after the inserted text.
-BUFFER may be a buffer or a buffer name."
-  (interactive
-   (list
-    (progn
-      (barf-if-buffer-read-only)
-      (read-buffer "Insert buffer: "
-		   (if (eq (selected-window) (next-window (selected-window)))
-		       (other-buffer (current-buffer))
-		     (window-buffer (next-window (selected-window))))
-		   t))))
-  (or (bufferp buffer)
-      (setq buffer (get-buffer buffer)))
-  (let (start end newmark)
-    (save-excursion
-      (save-excursion
-	(set-buffer buffer)
-	(setq start (point-min) end (point-max)))
-      (insert-buffer-substring buffer start end)
-      (setq newmark (point)))
-    (push-mark newmark))
-  nil)
-
-(defun append-to-buffer (buffer start end)
-  "Append to specified buffer the text of the region.
-It is inserted into that buffer before its point.
-
-When calling from a program, give three arguments:
-BUFFER (or buffer name), START and END.
-START and END specify the portion of the current buffer to be copied."
-  (interactive
-   (list (read-buffer "Append to buffer: " (other-buffer (current-buffer) t))
-	 (region-beginning) (region-end)))
-  (let ((oldbuf (current-buffer)))
-    (save-excursion
-      (set-buffer (get-buffer-create buffer))
-      (insert-buffer-substring oldbuf start end))))
-
-(defun prepend-to-buffer (buffer start end)
-  "Prepend to specified buffer the text of the region.
-It is inserted into that buffer after its point.
-
-When calling from a program, give three arguments:
-BUFFER (or buffer name), START and END.
-START and END specify the portion of the current buffer to be copied."
-  (interactive "BPrepend to buffer: \nr")
-  (let ((oldbuf (current-buffer)))
-    (save-excursion
-      (set-buffer (get-buffer-create buffer))
-      (save-excursion
-	(insert-buffer-substring oldbuf start end)))))
-
-(defun copy-to-buffer (buffer start end)
-  "Copy to specified buffer the text of the region.
-It is inserted into that buffer, replacing existing text there.
-
-When calling from a program, give three arguments:
-BUFFER (or buffer name), START and END.
-START and END specify the portion of the current buffer to be copied."
-  (interactive "BCopy to buffer: \nr")
-  (let ((oldbuf (current-buffer)))
-    (save-excursion
-      (set-buffer (get-buffer-create buffer))
-      (erase-buffer)
-      (save-excursion
-	(insert-buffer-substring oldbuf start end)))))
-
-(put 'mark-inactive 'error-conditions '(mark-inactive error))
-(put 'mark-inactive 'error-message "The mark is not active now")
-
-(defun mark (&optional force)
-  "Return this buffer's mark value as integer; error if mark inactive.
-If optional argument FORCE is non-nil, access the mark value
-even if the mark is not currently active, and return nil
-if there is no mark at all.
-
-If you are using this in an editing command, you are most likely making
-a mistake; see the documentation of `set-mark'."
-  (if (or force (not transient-mark-mode) mark-active mark-even-if-inactive)
-      (marker-position (mark-marker))
-    (signal 'mark-inactive nil)))
-
-;; Many places set mark-active directly, and several of them failed to also
-;; run deactivate-mark-hook.  This shorthand should simplify.
-(defsubst deactivate-mark ()
-  "Deactivate the mark by setting `mark-active' to nil.
-\(That makes a difference only in Transient Mark mode.)
-Also runs the hook `deactivate-mark-hook'."
-  (if transient-mark-mode
-      (progn
-	(setq mark-active nil)
-	(run-hooks 'deactivate-mark-hook))))
-
-(defun set-mark (pos)
-  "Set this buffer's mark to POS.  Don't use this function!
-That is to say, don't use this function unless you want
-the user to see that the mark has moved, and you want the previous
-mark position to be lost.
-
-Normally, when a new mark is set, the old one should go on the stack.
-This is why most applications should use push-mark, not set-mark.
-
-Novice Emacs Lisp programmers often try to use the mark for the wrong
-purposes.  The mark saves a location for the user's convenience.
-Most editing commands should not alter the mark.
-To remember a location for internal use in the Lisp program,
-store it in a Lisp variable.  Example:
-
-   (let ((beg (point))) (forward-line 1) (delete-region beg (point)))."
-
-  (if pos
-      (progn
-	(setq mark-active t)
-	(run-hooks 'activate-mark-hook)
-	(set-marker (mark-marker) pos (current-buffer)))
-    ;; Normally we never clear mark-active except in Transient Mark mode.
-    ;; But when we actually clear out the mark value too,
-    ;; we must clear mark-active in any mode.
-    (setq mark-active nil)
-    (run-hooks 'deactivate-mark-hook)
-    (set-marker (mark-marker) nil)))
-
-(defvar mark-ring nil
-  "The list of former marks of the current buffer, most recent first.")
-(make-variable-buffer-local 'mark-ring)
-(put 'mark-ring 'permanent-local t)
-
-(defvar mark-ring-max 16
-  "*Maximum size of mark ring.  Start discarding off end if gets this big.")
-
-(defvar global-mark-ring nil
-  "The list of saved global marks, most recent first.")
-
-(defvar global-mark-ring-max 16
-  "*Maximum size of global mark ring.  \
-Start discarding off end if gets this big.")
-
-(defun set-mark-command (arg)
-  "Set mark at where point is, or jump to mark.
-With no prefix argument, set mark, push old mark position on local mark
-ring, and push mark on global mark ring.
-With argument, jump to mark, and pop a new position for mark off the ring
-\(does not affect global mark ring\).
-
-Novice Emacs Lisp programmers often try to use the mark for the wrong
-purposes.  See the documentation of `set-mark' for more information."
-  (interactive "P")
-  (if (null arg)
-      (progn
-	(push-mark nil nil t))
-    (if (null (mark t))
-	(error "No mark set in this buffer")
-      (goto-char (mark t))
-      (pop-mark))))
-
-(defun push-mark (&optional location nomsg activate)
-  "Set mark at LOCATION (point, by default) and push old mark on mark ring.
-If the last global mark pushed was not in the current buffer,
-also push LOCATION on the global mark ring.
-Display `Mark set' unless the optional second arg NOMSG is non-nil.
-In Transient Mark mode, activate mark if optional third arg ACTIVATE non-nil.
-
-Novice Emacs Lisp programmers often try to use the mark for the wrong
-purposes.  See the documentation of `set-mark' for more information.
-
-In Transient Mark mode, this does not activate the mark."
-  (if (null (mark t))
-      nil
-    (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
-    (if (> (length mark-ring) mark-ring-max)
-	(progn
-	  (move-marker (car (nthcdr mark-ring-max mark-ring)) nil)
-	  (setcdr (nthcdr (1- mark-ring-max) mark-ring) nil))))
-  (set-marker (mark-marker) (or location (point)) (current-buffer))
-  ;; Now push the mark on the global mark ring.
-  (if (and global-mark-ring
-	   (eq (marker-buffer (car global-mark-ring)) (current-buffer)))
-      ;; The last global mark pushed was in this same buffer.
-      ;; Don't push another one.
-      nil
-    (setq global-mark-ring (cons (copy-marker (mark-marker)) global-mark-ring))
-    (if (> (length global-mark-ring) global-mark-ring-max)
-	(progn
-	  (move-marker (car (nthcdr global-mark-ring-max global-mark-ring))
-		       nil)
-	  (setcdr (nthcdr (1- global-mark-ring-max) global-mark-ring) nil))))
-  (or nomsg executing-kbd-macro (> (minibuffer-depth) 0)
-      (message "Mark set"))
-  (if (or activate (not transient-mark-mode))
-      (set-mark (mark t)))
-  nil)
-
-(defun pop-mark ()
-  "Pop off mark ring into the buffer's actual mark.
-Does not set point.  Does nothing if mark ring is empty."
-  (if mark-ring
-      (progn
-	(setq mark-ring (nconc mark-ring (list (copy-marker (mark-marker)))))
-	(set-marker (mark-marker) (+ 0 (car mark-ring)) (current-buffer))
-	(deactivate-mark)
-	(move-marker (car mark-ring) nil)
-	(if (null (mark t)) (ding))
-	(setq mark-ring (cdr mark-ring)))))
-
-(defalias 'exchange-dot-and-mark 'exchange-point-and-mark)
-(defun exchange-point-and-mark ()
-  "Put the mark where point is now, and point where the mark is now.
-This command works even when the mark is not active,
-and it reactivates the mark."
-  (interactive nil)
-  (let ((omark (mark t)))
-    (if (null omark)
-	(error "No mark set in this buffer"))
-    (set-mark (point))
-    (goto-char omark)
-    nil))
-
-(defun transient-mark-mode (arg)
-  "Toggle Transient Mark mode.
-With arg, turn Transient Mark mode on if arg is positive, off otherwise.
-
-In Transient Mark mode, when the mark is active, the region is highlighted.
-Changing the buffer \"deactivates\" the mark.
-So do certain other operations that set the mark
-but whose main purpose is something else--for example,
-incremental search, \\[beginning-of-buffer], and \\[end-of-buffer]."
-  (interactive "P")
-  (setq transient-mark-mode
-	(if (null arg)
-	    (not transient-mark-mode)
-	  (> (prefix-numeric-value arg) 0))))
-
-(defun pop-global-mark ()
-  "Pop off global mark ring and jump to the top location."
-  (interactive)
-  ;; Pop entries which refer to non-existent buffers.
-  (while (and global-mark-ring (not (marker-buffer (car global-mark-ring))))
-    (setq global-mark-ring (cdr global-mark-ring)))
-  (or global-mark-ring
-      (error "No global mark set"))
-  (let* ((marker (car global-mark-ring))
-	 (buffer (marker-buffer marker))
-	 (position (marker-position marker)))
-    (setq global-mark-ring (nconc (cdr global-mark-ring)
-				  (list (car global-mark-ring))))
-    (set-buffer buffer)
-    (or (and (>= position (point-min))
-	     (<= position (point-max)))
-	(widen))
-    (goto-char position)
-    (switch-to-buffer buffer)))
-
-(defvar next-line-add-newlines t
-  "*If non-nil, `next-line' inserts newline to avoid `end of buffer' error.")
-
-(defun next-line (arg)
-  "Move cursor vertically down ARG lines.
-If there is no character in the target line exactly under the current column,
-the cursor is positioned after the character in that line which spans this
-column, or at the end of the line if it is not long enough.
-If there is no line in the buffer after this one, behavior depends on the
-value of `next-line-add-newlines'.  If non-nil, it inserts a newline character
-to create a line, and moves the cursor to that line.  Otherwise it moves the
-cursor to the end of the buffer.
-
-The command \\[set-goal-column] can be used to create
-a semipermanent goal column to which this command always moves.
-Then it does not try to move vertically.  This goal column is stored
-in `goal-column', which is nil when there is none.
-
-If you are thinking of using this in a Lisp program, consider
-using `forward-line' instead.  It is usually easier to use
-and more reliable (no dependence on goal column, etc.)."
-  (interactive "p")
-  (if (and next-line-add-newlines (= arg 1))
-      (let ((opoint (point)))
-	(end-of-line)
-	(if (eobp)
-	    (newline 1)
-	  (goto-char opoint)
-	  (line-move arg)))
-    (if (interactive-p)
-	(condition-case nil
-	    (line-move arg)
-	  ((beginning-of-buffer end-of-buffer) (ding)))
-      (line-move arg)))
-  nil)
-
-(defun previous-line (arg)
-  "Move cursor vertically up ARG lines.
-If there is no character in the target line exactly over the current column,
-the cursor is positioned after the character in that line which spans this
-column, or at the end of the line if it is not long enough.
-
-The command \\[set-goal-column] can be used to create
-a semipermanent goal column to which this command always moves.
-Then it does not try to move vertically.
-
-If you are thinking of using this in a Lisp program, consider using
-`forward-line' with a negative argument instead.  It is usually easier
-to use and more reliable (no dependence on goal column, etc.)."
-  (interactive "p")
-  (if (interactive-p)
-      (condition-case nil
-	  (line-move (- arg))
-	((beginning-of-buffer end-of-buffer) (ding)))
-    (line-move (- arg)))
-  nil)
-
-(defvar track-eol nil
-  "*Non-nil means vertical motion starting at end of line keeps to ends of lines.
-This means moving to the end of each line moved onto.
-The beginning of a blank line does not count as the end of a line.")
-
-(defvar goal-column nil
-  "*Semipermanent goal column for vertical motion, as set by \\[set-goal-column], or nil.")
-(make-variable-buffer-local 'goal-column)
-
-(defvar temporary-goal-column 0
-  "Current goal column for vertical motion.
-It is the column where point was
-at the start of current run of vertical motion commands.
-When the `track-eol' feature is doing its job, the value is 9999.")
-
-(defvar line-move-ignore-invisible nil
-  "*Non-nil means \\[next-line] and \\[previous-line] ignore invisible lines.
-Outline mode sets this.")
-
-;; This is the guts of next-line and previous-line.
-;; Arg says how many lines to move.
-(defun line-move (arg)
-  ;; Don't run any point-motion hooks, and disregard intangibility,
-  ;; for intermediate positions.
-  (let ((inhibit-point-motion-hooks t)
-	(opoint (point))
-	new)
-    (unwind-protect
-	(progn
-	  (if (not (or (eq last-command 'next-line)
-		       (eq last-command 'previous-line)))
-	      (setq temporary-goal-column
-		    (if (and track-eol (eolp)
-			     ;; Don't count beg of empty line as end of line
-			     ;; unless we just did explicit end-of-line.
-			     (or (not (bolp)) (eq last-command 'end-of-line)))
-			9999
-		      (current-column))))
-	  (if (and (not (integerp selective-display))
-		   (not line-move-ignore-invisible))
-	      ;; Use just newline characters.
-	      (or (if (> arg 0)
-		      (progn (if (> arg 1) (forward-line (1- arg)))
-			     ;; This way of moving forward ARG lines
-			     ;; verifies that we have a newline after the last one.
-			     ;; It doesn't get confused by intangible text.
-			     (end-of-line)
-			     (zerop (forward-line 1)))
-		    (and (zerop (forward-line arg))
-			 (bolp)))
-		  (signal (if (< arg 0)
-			      'beginning-of-buffer
-			    'end-of-buffer)
-			  nil))
-	    ;; Move by arg lines, but ignore invisible ones.
-	    (while (> arg 0)
-	      (end-of-line)
-	      (and (zerop (vertical-motion 1))
-		   (signal 'end-of-buffer nil))
-	      ;; If the following character is currently invisible,
-	      ;; skip all characters with that same `invisible' property value.
-	      (while (and (not (eobp))
-			  (let ((prop
-				 (get-char-property (point) 'invisible)))
-			    (if (eq buffer-invisibility-spec t)
-				prop
-			      (or (memq prop buffer-invisibility-spec)
-				  (assq prop buffer-invisibility-spec)))))
-		(if (get-text-property (point) 'invisible)
-		    (goto-char (next-single-property-change (point) 'invisible))
-		  (goto-char (next-overlay-change (point)))))
-	      (setq arg (1- arg)))
-	    (while (< arg 0)
-	      (beginning-of-line)
-	      (and (zerop (vertical-motion -1))
-		   (signal 'beginning-of-buffer nil))
-	      (while (and (not (bobp))
-			  (let ((prop
-				 (get-char-property (1- (point)) 'invisible)))
-			    (if (eq buffer-invisibility-spec t)
-				prop
-			      (or (memq prop buffer-invisibility-spec)
-				  (assq prop buffer-invisibility-spec)))))
-		(if (get-text-property (1- (point)) 'invisible)
-		    (goto-char (previous-single-property-change (point) 'invisible))
-		  (goto-char (previous-overlay-change (point)))))
-	      (setq arg (1+ arg))))
-	  (let ((buffer-invisibility-spec nil))
-	    (move-to-column (or goal-column temporary-goal-column))))
-      ;; Remember where we moved to, go back home,
-      ;; then do the motion over again
-      ;; in just one step, with intangibility and point-motion hooks
-      ;; enabled this time.
-      (setq new (point))
-      (goto-char opoint)
-      (setq inhibit-point-motion-hooks nil)
-      (goto-char new)))
-  nil)
-
-;;; Many people have said they rarely use this feature, and often type
-;;; it by accident.  Maybe it shouldn't even be on a key.
-(put 'set-goal-column 'disabled t)
-
-(defun set-goal-column (arg)
-  "Set the current horizontal position as a goal for \\[next-line] and \\[previous-line].
-Those commands will move to this position in the line moved to
-rather than trying to keep the same horizontal position.
-With a non-nil argument, clears out the goal column
-so that \\[next-line] and \\[previous-line] resume vertical motion.
-The goal column is stored in the variable `goal-column'."
-  (interactive "P")
-  (if arg
-      (progn
-        (setq goal-column nil)
-        (message "No goal column"))
-    (setq goal-column (current-column))
-    (message (substitute-command-keys
-	      "Goal column %d (use \\[set-goal-column] with an arg to unset it)")
-	     goal-column))
-  nil)
-
-;;; Partial support for horizontal autoscrolling.  Someday, this feature
-;;; will be built into the C level and all the (hscroll-point-visible) calls
-;;; will go away.
-
-(defvar hscroll-step 0
-   "*The number of columns to try scrolling a window by when point moves out.
-If that fails to bring point back on frame, point is centered instead.
-If this is zero, point is always centered after it moves off frame.")
-
-(defun hscroll-point-visible ()
-  "Scrolls the selected window horizontally to make point visible."
-  (save-excursion
-    (set-buffer (window-buffer))
-    (if (not (or truncate-lines
-		 (> (window-hscroll) 0)
-		 (and truncate-partial-width-windows
-		      (< (window-width) (frame-width)))))
-	;; Point is always visible when lines are wrapped.
-	()
-      ;; If point is on the invisible part of the line before window-start,
-      ;; then hscrolling can't bring it back, so reset window-start first.
-      (and (< (point) (window-start))
-	   (let ((ws-bol (save-excursion
-			   (goto-char (window-start))
-			   (beginning-of-line)
-			   (point))))
-	     (and (>= (point) ws-bol)
-		  (set-window-start nil ws-bol))))
-      (let* ((here (hscroll-window-column))
-	     (left (min (window-hscroll) 1))
-	     (right (1- (window-width))))
-	;; Allow for the truncation glyph, if we're not exactly at eol.
-	(if (not (and (= here right)
-		      (= (following-char) ?\n)))
-	    (setq right (1- right)))
-	(cond
-	 ;; If too far away, just recenter.  But don't show too much
-	 ;; white space off the end of the line.
-	 ((or (< here (- left  hscroll-step))
-	      (> here (+ right hscroll-step)))
-	  (let ((eol (save-excursion (end-of-line) (hscroll-window-column))))
-	    (scroll-left (min (- here (/ (window-width) 2))
-			      (- eol (window-width) -5)))))
-	 ;; Within range.  Scroll by one step (or maybe not at all).
-	 ((< here left)
-	  (scroll-right hscroll-step))
-	 ((> here right)
-	  (scroll-left hscroll-step)))))))
-
-;; This function returns the window's idea of the display column of point,
-;; assuming that the window is already known to be truncated rather than
-;; wrapped, and that we've already handled the case where point is on the
-;; part of the line before window-start.  We ignore window-width; if point
-;; is beyond the right margin, we want to know how far.  The return value
-;; includes the effects of window-hscroll, window-start, and the prompt
-;; string in the minibuffer.  It may be negative due to hscroll.
-(defun hscroll-window-column ()
-  (let* ((hscroll (window-hscroll))
-	 (startpos (save-excursion
-		     (beginning-of-line)
-		     (if (= (point) (save-excursion
-				      (goto-char (window-start))
-				      (beginning-of-line)
-				      (point)))
-			 (goto-char (window-start)))
-		     (point)))
-	 (hpos (+ (if (and (eq (selected-window) (minibuffer-window))
-			   (= 1 (window-start))
-			   (= startpos (point-min)))
-		      (minibuffer-prompt-width)
-		    0)
-		  (min 0 (- 1 hscroll))))
-	 val)
-    (car (cdr (compute-motion startpos (cons hpos 0)
-			      (point) (cons 0 1)
-			      1000000 (cons hscroll 0) nil)))))
-
-  
-;; rms: (1) The definitions of arrow keys should not simply restate
-;; what keys they are.  The arrow keys should run the ordinary commands.
-;; (2) The arrow keys are just one of many common ways of moving point
-;; within a line.  Real horizontal autoscrolling would be a good feature,
-;; but supporting it only for arrow keys is too incomplete to be desirable.
-
-;;;;; Make arrow keys do the right thing for improved terminal support
-;;;;; When we implement true horizontal autoscrolling, right-arrow and
-;;;;; left-arrow can lose the (if truncate-lines ...) clause and become
-;;;;; aliases.  These functions are bound to the corresponding keyboard
-;;;;; events in loaddefs.el.
-
-;;(defun right-arrow (arg)
-;;  "Move right one character on the screen (with prefix ARG, that many chars).
-;;Scroll right if needed to keep point horizontally onscreen."
-;;  (interactive "P")
-;;  (forward-char arg)
-;;  (hscroll-point-visible))
-
-;;(defun left-arrow (arg)
-;;  "Move left one character on the screen (with prefix ARG, that many chars).
-;;Scroll left if needed to keep point horizontally onscreen."
-;;  (interactive "P")
-;;  (backward-char arg)
-;;  (hscroll-point-visible))
-
-(defun scroll-other-window-down (lines)
-  "Scroll the \"other window\" down.
-For more details, see the documentation for `scroll-other-window'."
-  (interactive "P")
-  (scroll-other-window
-   ;; Just invert the argument's meaning.
-   ;; We can do that without knowing which window it will be.
-   (if (eq lines '-) nil
-     (if (null lines) '-
-       (- (prefix-numeric-value lines))))))
-(define-key esc-map [?\C-\S-v] 'scroll-other-window-down)
-
-(defun beginning-of-buffer-other-window (arg)
-  "Move point to the beginning of the buffer in the other window.
-Leave mark at previous position.
-With arg N, put point N/10 of the way from the true beginning."
-  (interactive "P")
-  (let ((orig-window (selected-window))
-	(window (other-window-for-scrolling)))
-    ;; We use unwind-protect rather than save-window-excursion
-    ;; because the latter would preserve the things we want to change.
-    (unwind-protect
-	(progn
-	  (select-window window)
-	  ;; Set point and mark in that window's buffer.
-	  (beginning-of-buffer arg)
-	  ;; Set point accordingly.
-	  (recenter '(t)))
-      (select-window orig-window))))
-
-(defun end-of-buffer-other-window (arg)
-  "Move point to the end of the buffer in the other window.
-Leave mark at previous position.
-With arg N, put point N/10 of the way from the true end."
-  (interactive "P")
-  ;; See beginning-of-buffer-other-window for comments.
-  (let ((orig-window (selected-window))
-	(window (other-window-for-scrolling)))
-    (unwind-protect
-	(progn
-	  (select-window window)
-	  (end-of-buffer arg)
-	  (recenter '(t)))
-      (select-window orig-window))))
-
-(defun transpose-chars (arg)
-  "Interchange characters around point, moving forward one character.
-With prefix arg ARG, effect is to take character before point
-and drag it forward past ARG other characters (backward if ARG negative).
-If no argument and at end of line, the previous two chars are exchanged."
-  (interactive "*P")
-  (and (null arg) (eolp) (forward-char -1))
-  (transpose-subr 'forward-char (prefix-numeric-value arg)))
-
-(defun transpose-words (arg)
-  "Interchange words around point, leaving point at end of them.
-With prefix arg ARG, effect is to take word before or around point
-and drag it forward past ARG other words (backward if ARG negative).
-If ARG is zero, the words around or after point and around or after mark
-are interchanged."
-  (interactive "*p")
-  (transpose-subr 'forward-word arg))
-
-(defun transpose-sexps (arg)
-  "Like \\[transpose-words] but applies to sexps.
-Does not work on a sexp that point is in the middle of
-if it is a list or string."
-  (interactive "*p")
-  (transpose-subr 'forward-sexp arg))
-
-(defun transpose-lines (arg)
-  "Exchange current line and previous line, leaving point after both.
-With argument ARG, takes previous line and moves it past ARG lines.
-With argument 0, interchanges line point is in with line mark is in."
-  (interactive "*p")
-  (transpose-subr (function
-		   (lambda (arg)
-		     (if (= arg 1)
-			 (progn
-			   ;; Move forward over a line,
-			   ;; but create a newline if none exists yet.
-			   (end-of-line)
-			   (if (eobp)
-			       (newline)
-			     (forward-char 1)))
-		       (forward-line arg))))
-		  arg))
-
-(defun transpose-subr (mover arg)
-  (let (start1 end1 start2 end2)
-    (if (= arg 0)
-	(progn
-	  (save-excursion
-	    (funcall mover 1)
-	    (setq end2 (point))
-	    (funcall mover -1)
-	    (setq start2 (point))
-	    (goto-char (mark))
-	    (funcall mover 1)
-	    (setq end1 (point))
-	    (funcall mover -1)
-	    (setq start1 (point))
-	    (transpose-subr-1))
-	  (exchange-point-and-mark)))
-    (while (> arg 0)
-      (funcall mover -1)
-      (setq start1 (point))
-      (funcall mover 1)
-      (setq end1 (point))
-      (funcall mover 1)
-      (setq end2 (point))
-      (funcall mover -1)
-      (setq start2 (point))
-      (transpose-subr-1)
-      (goto-char end2)
-      (setq arg (1- arg)))
-    (while (< arg 0)
-      (funcall mover -1)
-      (setq start2 (point))
-      (funcall mover -1)
-      (setq start1 (point))
-      (funcall mover 1)
-      (setq end1 (point))
-      (funcall mover 1)
-      (setq end2 (point))
-      (transpose-subr-1)
-      (setq arg (1+ arg)))))
-
-(defun transpose-subr-1 ()
-  (if (> (min end1 end2) (max start1 start2))
-      (error "Don't have two things to transpose"))
-  (let ((word1 (buffer-substring start1 end1))
-	(word2 (buffer-substring start2 end2)))
-    (delete-region start2 end2)
-    (goto-char start2)
-    (insert word1)
-    (goto-char (if (< start1 start2) start1
-		 (+ start1 (- (length word1) (length word2)))))
-    (delete-char (length word1))
-    (insert word2)))
-
-(defvar comment-column 32
-  "*Column to indent right-margin comments to.
-Setting this variable automatically makes it local to the current buffer.
-Each mode establishes a different default value for this variable; you
-can set the value for a particular mode using that mode's hook.")
-(make-variable-buffer-local 'comment-column)
-
-(defvar comment-start nil
-  "*String to insert to start a new comment, or nil if no comment syntax.")
-
-(defvar comment-start-skip nil
-  "*Regexp to match the start of a comment plus everything up to its body.
-If there are any \\(...\\) pairs, the comment delimiter text is held to begin
-at the place matched by the close of the first pair.")
-
-(defvar comment-end ""
-  "*String to insert to end a new comment.
-Should be an empty string if comments are terminated by end-of-line.")
-
-(defvar comment-indent-hook nil
-  "Obsolete variable for function to compute desired indentation for a comment.
-This function is called with no args with point at the beginning of
-the comment's starting delimiter.")
-
-(defvar comment-indent-function
-  '(lambda () comment-column)
-  "Function to compute desired indentation for a comment.
-This function is called with no args with point at the beginning of
-the comment's starting delimiter.")
-
-(defvar block-comment-start nil
-  "*String to insert to start a new comment on a line by itself.
-If nil, use `comment-start' instead.
-Note that the regular expression `comment-start-skip' should skip this string
-as well as the `comment-start' string.")
-
-(defvar block-comment-end nil
-  "*String to insert to end a new comment on a line by itself.
-Should be an empty string if comments are terminated by end-of-line.
-If nil, use `comment-end' instead.")
-
-(defun indent-for-comment ()
-  "Indent this line's comment to comment column, or insert an empty comment."
-  (interactive "*")
-  (let* ((empty (save-excursion (beginning-of-line)
-				(looking-at "[ \t]*$")))
-	 (starter (or (and empty block-comment-start) comment-start))
-	 (ender (or (and empty block-comment-end) comment-end)))
-    (if (null starter)
-	(error "No comment syntax defined")
-      (let* ((eolpos (save-excursion (end-of-line) (point)))
-	     cpos indent begpos)
-	(beginning-of-line)
-	(if (re-search-forward comment-start-skip eolpos 'move)
-	    (progn (setq cpos (point-marker))
-		   ;; Find the start of the comment delimiter.
-		   ;; If there were paren-pairs in comment-start-skip,
-		   ;; position at the end of the first pair.
-		   (if (match-end 1)
-		       (goto-char (match-end 1))
-		     ;; If comment-start-skip matched a string with
-		     ;; internal whitespace (not final whitespace) then
-		     ;; the delimiter start at the end of that
-		     ;; whitespace.  Otherwise, it starts at the
-		     ;; beginning of what was matched.
-		     (skip-syntax-backward " " (match-beginning 0))
-		     (skip-syntax-backward "^ " (match-beginning 0)))))
-	(setq begpos (point))
-	;; Compute desired indent.
-	(if (= (current-column)
-	       (setq indent (if comment-indent-hook
-				(funcall comment-indent-hook)
-			      (funcall comment-indent-function))))
-	    (goto-char begpos)
-	  ;; If that's different from current, change it.
-	  (skip-chars-backward " \t")
-	  (delete-region (point) begpos)
-	  (indent-to indent))
-	;; An existing comment?
-	(if cpos 
-	    (progn (goto-char cpos)
-		   (set-marker cpos nil))
-	  ;; No, insert one.
-	  (insert starter)
-	  (save-excursion
-	    (insert ender)))))))
-
-(defun set-comment-column (arg)
-  "Set the comment column based on point.
-With no arg, set the comment column to the current column.
-With just minus as arg, kill any comment on this line.
-With any other arg, set comment column to indentation of the previous comment
- and then align or create a comment on this line at that column."
-  (interactive "P")
-  (if (eq arg '-)
-      (kill-comment nil)
-    (if arg
-	(progn
-	  (save-excursion
-	    (beginning-of-line)
-	    (re-search-backward comment-start-skip)
-	    (beginning-of-line)
-	    (re-search-forward comment-start-skip)
-	    (goto-char (match-beginning 0))
-	    (setq comment-column (current-column))
-	    (message "Comment column set to %d" comment-column))
-	  (indent-for-comment))
-      (setq comment-column (current-column))
-      (message "Comment column set to %d" comment-column))))
-
-(defun kill-comment (arg)
-  "Kill the comment on this line, if any.
-With argument, kill comments on that many lines starting with this one."
-  ;; this function loses in a lot of situations.  it incorrectly recognises
-  ;; comment delimiters sometimes (ergo, inside a string), doesn't work
-  ;; with multi-line comments, can kill extra whitespace if comment wasn't
-  ;; through end-of-line, et cetera.
-  (interactive "P")
-  (or comment-start-skip (error "No comment syntax defined"))
-  (let ((count (prefix-numeric-value arg)) endc)
-    (while (> count 0)
-      (save-excursion
-	(end-of-line)
-	(setq endc (point))
-	(beginning-of-line)
-	(and (string< "" comment-end)
-	     (setq endc
-		   (progn
-		     (re-search-forward (regexp-quote comment-end) endc 'move)
-		     (skip-chars-forward " \t")
-		     (point))))
-	(beginning-of-line)
-	(if (re-search-forward comment-start-skip endc t)
-	    (progn
-	      (goto-char (match-beginning 0))
-	      (skip-chars-backward " \t")
-	      (kill-region (point) endc)
-	      ;; to catch comments a line beginnings
-	      (indent-according-to-mode))))
-      (if arg (forward-line 1))
-      (setq count (1- count)))))
-
-(defun comment-region (beg end &optional arg)
-  "Comment or uncomment each line in the region.
-With just C-u prefix arg, uncomment each line in region.
-Numeric prefix arg ARG means use ARG comment characters.
-If ARG is negative, delete that many comment characters instead.
-Comments are terminated on each line, even for syntax in which newline does
-not end the comment.  Blank lines do not get comments."
-  ;; if someone wants it to only put a comment-start at the beginning and
-  ;; comment-end at the end then typing it, C-x C-x, closing it, C-x C-x
-  ;; is easy enough.  No option is made here for other than commenting
-  ;; every line.
-  (interactive "r\nP")
-  (or comment-start (error "No comment syntax is defined"))
-  (if (> beg end) (let (mid) (setq mid beg beg end end mid)))
-  (save-excursion
-    (save-restriction
-      (let ((cs comment-start) (ce comment-end)
-	    numarg)
-        (if (consp arg) (setq numarg t)
-	  (setq numarg (prefix-numeric-value arg))
-	  ;; For positive arg > 1, replicate the comment delims now,
-	  ;; then insert the replicated strings just once.
-	  (while (> numarg 1)
-	    (setq cs (concat cs comment-start)
-		  ce (concat ce comment-end))
-	    (setq numarg (1- numarg))))
-	;; Loop over all lines from BEG to END.
-        (narrow-to-region beg end)
-        (goto-char beg)
-        (while (not (eobp))
-          (if (or (eq numarg t) (< numarg 0))
-	      (progn
-		;; Delete comment start from beginning of line.
-		(if (eq numarg t)
-		    (while (looking-at (regexp-quote cs))
-		      (delete-char (length cs)))
-		  (let ((count numarg))
-		    (while (and (> 1 (setq count (1+ count)))
-				(looking-at (regexp-quote cs)))
-		      (delete-char (length cs)))))
-		;; Delete comment end from end of line.
-                (if (string= "" ce)
-		    nil
-		  (if (eq numarg t)
-		      (progn
-			(end-of-line)
-			;; This is questionable if comment-end ends in
-			;; whitespace.  That is pretty brain-damaged,
-			;; though.
-			(while (progn (skip-chars-backward " \t")
-				      (and (>= (- (point) (point-min)) (length ce))
-					   (save-excursion
-					     (backward-char (length ce))
-					     (looking-at (regexp-quote ce)))))
-			    (delete-char (- (length ce)))))
-		    (let ((count numarg))
-		      (while (> 1 (setq count (1+ count)))
-			(end-of-line)
-			;; this is questionable if comment-end ends in whitespace
-			;; that is pretty brain-damaged though
-			(skip-chars-backward " \t")
-			(save-excursion
-			  (backward-char (length ce))
-			  (if (looking-at (regexp-quote ce))
-			      (delete-char (length ce))))))))
-		(forward-line 1))
-	    ;; Insert at beginning and at end.
-            (if (looking-at "[ \t]*$") ()
-              (insert cs)
-              (if (string= "" ce) ()
-                (end-of-line)
-                (insert ce)))
-            (search-forward "\n" nil 'move)))))))
-
-(defun backward-word (arg)
-  "Move backward until encountering the end of a word.
-With argument, do this that many times.
-In programs, it is faster to call `forward-word' with negative arg."
-  (interactive "p")
-  (forward-word (- arg)))
-
-(defun mark-word (arg)
-  "Set mark arg words away from point."
-  (interactive "p")
-  (push-mark
-    (save-excursion
-      (forward-word arg)
-      (point))
-    nil t))
-
-(defun kill-word (arg)
-  "Kill characters forward until encountering the end of a word.
-With argument, do this that many times."
-  (interactive "p")
-  (kill-region (point) (progn (forward-word arg) (point))))
-
-(defun backward-kill-word (arg)
-  "Kill characters backward until encountering the end of a word.
-With argument, do this that many times."
-  (interactive "p")
-  (kill-word (- arg)))
-
-(defun current-word (&optional strict)
-  "Return the word point is on (or a nearby word) as a string.
-If optional arg STRICT is non-nil, return nil unless point is within
-or adjacent to a word."
-  (save-excursion
-    (let ((oldpoint (point)) (start (point)) (end (point)))
-      (skip-syntax-backward "w_") (setq start (point))
-      (goto-char oldpoint)
-      (skip-syntax-forward "w_") (setq end (point))
-      (if (and (eq start oldpoint) (eq end oldpoint))
-	  ;; Point is neither within nor adjacent to a word.
-	  (and (not strict)
-	       (progn
-		 ;; Look for preceding word in same line.
-		 (skip-syntax-backward "^w_"
-				       (save-excursion (beginning-of-line)
-						       (point)))
-		 (if (bolp)
-		     ;; No preceding word in same line.
-		     ;; Look for following word in same line.
-		     (progn
-		       (skip-syntax-forward "^w_"
-					    (save-excursion (end-of-line)
-							    (point)))
-		       (setq start (point))
-		       (skip-syntax-forward "w_")
-		       (setq end (point)))
-		   (setq end (point))
-		   (skip-syntax-backward "w_")
-		   (setq start (point)))
-		 (buffer-substring start end)))
-	(buffer-substring start end)))))
-
-(defvar fill-prefix nil
-  "*String for filling to insert at front of new line, or nil for none.
-Setting this variable automatically makes it local to the current buffer.")
-(make-variable-buffer-local 'fill-prefix)
-
-(defvar auto-fill-inhibit-regexp nil
-  "*Regexp to match lines which should not be auto-filled.")
-
-;; This function is the auto-fill-function of a buffer
-;; when Auto-Fill mode is enabled.
-;; It returns t if it really did any work.
-(defun do-auto-fill ()
-  (let (fc justify bol give-up
-	   (fill-prefix fill-prefix))
-    (if (or (not (setq justify (current-justification)))
-	    (null (setq fc (current-fill-column)))
-	    (and (eq justify 'left)
-		 (<= (current-column) fc))
-	    (save-excursion (beginning-of-line) 
-			    (setq bol (point))
-			    (and auto-fill-inhibit-regexp
-				 (looking-at auto-fill-inhibit-regexp))))
-	nil ;; Auto-filling not required
-      (if (memq justify '(full center right))
-	  (save-excursion (unjustify-current-line)))
-
-      ;; Choose a fill-prefix automatically.
-      (if (and adaptive-fill-mode
-	       (or (null fill-prefix) (string= fill-prefix "")))
-	  (let ((prefix
-		 (fill-context-prefix
-		  (save-excursion (backward-paragraph 1) (point))
-		  (save-excursion (forward-paragraph 1) (point))
-		  ;; Don't accept a non-whitespace fill prefix
-		  ;; from the first line of a paragraph.
-		  "^[ \t]*$")))
-	    (and prefix (not (equal prefix ""))
-		 (setq fill-prefix prefix))))
-
-      (while (and (not give-up) (> (current-column) fc))
-	;; Determine where to split the line.
-	(let ((fill-point
-	       (let ((opoint (point))
-		     bounce
-		     (first t)
-		     after-prefix)
-		 (save-excursion
-		   (beginning-of-line)
-		   (setq after-prefix (point))
-		   (and fill-prefix
-			(looking-at (regexp-quote fill-prefix))
-			(setq after-prefix (match-end 0)))
-		   (move-to-column (1+ fc))
-		   ;; Move back to a word boundary.
-		   (while (or first
-			      ;; If this is after period and a single space,
-			      ;; move back once more--we don't want to break
-			      ;; the line there and make it look like a
-			      ;; sentence end.
-			      (and (not (bobp))
-				   (not bounce)
-				   sentence-end-double-space
-				   (save-excursion (forward-char -1)
-						   (and (looking-at "\\. ")
-							(not (looking-at "\\.  "))))))
-		     (setq first nil)
-		     (skip-chars-backward "^ \t\n")
-		     ;; If we find nowhere on the line to break it,
-		     ;; break after one word.  Set bounce to t
-		     ;; so we will not keep going in this while loop.
-		     (if (<= (point) after-prefix)
-			 (progn
-			   (re-search-forward "[ \t]" opoint t)
-			   (setq bounce t)))
-		     (skip-chars-backward " \t"))
-		   ;; Let fill-point be set to the place where we end up.
-		   (point)))))
-	  ;; If that place is not the beginning of the line,
-	  ;; break the line there.
-	  (if (save-excursion
-		(goto-char fill-point)
-		(not (bolp)))
-	      (let ((prev-column (current-column)))
-		;; If point is at the fill-point, do not `save-excursion'.
-		;; Otherwise, if a comment prefix or fill-prefix is inserted,
-		;; point will end up before it rather than after it.
-		(if (save-excursion
-		      (skip-chars-backward " \t")
-		      (= (point) fill-point))
-		    (indent-new-comment-line t)
-		  (save-excursion
-		    (goto-char fill-point)
-		    (indent-new-comment-line t)))
-		;; Now do justification, if required
-		(if (not (eq justify 'left))
-		    (save-excursion 
-		      (end-of-line 0)
-		      (justify-current-line justify nil t)))
-		;; If making the new line didn't reduce the hpos of
-		;; the end of the line, then give up now;
-		;; trying again will not help.
-		(if (>= (current-column) prev-column)
-		    (setq give-up t)))
-	    ;; No place to break => stop trying.
-	    (setq give-up t))))
-      ;; Justify last line.
-      (justify-current-line justify t t)
-      t))) 
-
-(defvar normal-auto-fill-function 'do-auto-fill
-  "The function to use for `auto-fill-function' if Auto Fill mode is turned on.
-Some major modes set this.")
-
-(defun auto-fill-mode (&optional arg)
-  "Toggle Auto Fill mode.
-With arg, turn Auto Fill mode on if and only if arg is positive.
-In Auto Fill mode, inserting a space at a column beyond `current-fill-column'
-automatically breaks the line at a previous space.
-
-The value of `normal-auto-fill-function' specifies the function to use
-for `auto-fill-function' when turning Auto Fill mode on."
-  (interactive "P")
-  (prog1 (setq auto-fill-function
-	       (if (if (null arg)
-		       (not auto-fill-function)
-		       (> (prefix-numeric-value arg) 0))
-		   normal-auto-fill-function
-		   nil))
-    (force-mode-line-update)))
-
-;; This holds a document string used to document auto-fill-mode.
-(defun auto-fill-function ()
-  "Automatically break line at a previous space, in insertion of text."
-  nil)
-
-(defun turn-on-auto-fill ()
-  "Unconditionally turn on Auto Fill mode."
-  (auto-fill-mode 1))
-
-(defun set-fill-column (arg)
-  "Set `fill-column' to specified argument.
-Just \\[universal-argument] as argument means to use the current column."
-  (interactive "P")
-  (cond ((integerp arg)
-	 (setq fill-column arg))
-	((consp arg)
-	 (setq fill-column (current-column)))
-	;; Disallow missing argument; it's probably a typo for C-x C-f.
-	(t
-	 (error "set-fill-column requires an explicit argument")))
-  (message "fill-column set to %d" fill-column))
-
-(defvar comment-multi-line nil
-  "*Non-nil means \\[indent-new-comment-line] should continue same comment
-on new line, with no new terminator or starter.
-This is obsolete because you might as well use \\[newline-and-indent].")
-
-(defun indent-new-comment-line (&optional soft)
-  "Break line at point and indent, continuing comment if within one.
-This indents the body of the continued comment
-under the previous comment line.
-
-This command is intended for styles where you write a comment per line,
-starting a new comment (and terminating it if necessary) on each line.
-If you want to continue one comment across several lines, use \\[newline-and-indent].
-
-If a fill column is specified, it overrides the use of the comment column
-or comment indentation.
-
-The inserted newline is marked hard if `use-hard-newlines' is true, 
-unless optional argument SOFT is non-nil."
-  (interactive)
-  (let (comcol comstart)
-    (skip-chars-backward " \t")
-    (delete-region (point)
-		   (progn (skip-chars-forward " \t")
-			  (point)))
-    (if soft (insert-and-inherit ?\n) (newline 1))
-    (if fill-prefix
-	(progn
-	  (indent-to-left-margin)
-	  (insert-and-inherit fill-prefix))
-      (if (not comment-multi-line)
-	  (save-excursion
-	    (if (and comment-start-skip
-		     (let ((opoint (point)))
-		       (forward-line -1)
-		       (re-search-forward comment-start-skip opoint t)))
-		;; The old line is a comment.
-		;; Set WIN to the pos of the comment-start.
-		;; But if the comment is empty, look at preceding lines
-		;; to find one that has a nonempty comment.
-
-		;; If comment-start-skip contains a \(...\) pair,
-		;; the real comment delimiter starts at the end of that pair.
-		(let ((win (or (match-end 1) (match-beginning 0))))
-		  (while (and (eolp) (not (bobp))
-			      (let (opoint)
-				(beginning-of-line)
-				(setq opoint (point))
-				(forward-line -1)
-				(re-search-forward comment-start-skip opoint t)))
-		    (setq win (or (match-end 1) (match-beginning 0))))
-		  ;; Indent this line like what we found.
-		  (goto-char win)
-		  (setq comcol (current-column))
-		  (setq comstart
-			(buffer-substring (point) (match-end 0)))))))
-      (if comcol
-	  (let ((comment-column comcol)
-		(comment-start comstart)
-		(comment-end comment-end))
-	    (and comment-end (not (equal comment-end ""))
-  ;	       (if (not comment-multi-line)
-		     (progn
-		       (forward-char -1)
-		       (insert comment-end)
-		       (forward-char 1))
-  ;		 (setq comment-column (+ comment-column (length comment-start))
-  ;		       comment-start "")
-  ;		   )
-		 )
-	    (if (not (eolp))
-		(setq comment-end ""))
-	    (insert-and-inherit ?\n)
-	    (forward-char -1)
-	    (indent-for-comment)
-	    (save-excursion
-	      ;; Make sure we delete the newline inserted above.
-	      (end-of-line)
-	      (delete-char 1)))
-	(indent-according-to-mode)))))
-
-(defun set-selective-display (arg)
-  "Set `selective-display' to ARG; clear it if no arg.
-When the value of `selective-display' is a number > 0,
-lines whose indentation is >= that value are not displayed.
-The variable `selective-display' has a separate value for each buffer."
-  (interactive "P")
-  (if (eq selective-display t)
-      (error "selective-display already in use for marked lines"))
-  (let ((current-vpos
-	 (save-restriction
-	   (narrow-to-region (point-min) (point))
-	   (goto-char (window-start))
-	   (vertical-motion (window-height)))))
-    (setq selective-display
-	  (and arg (prefix-numeric-value arg)))
-    (recenter current-vpos))
-  (set-window-start (selected-window) (window-start (selected-window)))
-  (princ "selective-display set to " t)
-  (prin1 selective-display t)
-  (princ "." t))
-
-(defconst overwrite-mode-textual " Ovwrt"
-  "The string displayed in the mode line when in overwrite mode.")
-(defconst overwrite-mode-binary " Bin Ovwrt"
-  "The string displayed in the mode line when in binary overwrite mode.")
-
-(defun overwrite-mode (arg)
-  "Toggle overwrite mode.
-With arg, turn overwrite mode on iff arg is positive.
-In overwrite mode, printing characters typed in replace existing text
-on a one-for-one basis, rather than pushing it to the right.  At the
-end of a line, such characters extend the line.  Before a tab,
-such characters insert until the tab is filled in.
-\\[quoted-insert] still inserts characters in overwrite mode; this
-is supposed to make it easier to insert characters when necessary."
-  (interactive "P")
-  (setq overwrite-mode
-	(if (if (null arg) (not overwrite-mode)
-	      (> (prefix-numeric-value arg) 0))
-	    'overwrite-mode-textual))
-  (force-mode-line-update))
-
-(defun binary-overwrite-mode (arg)
-  "Toggle binary overwrite mode.
-With arg, turn binary overwrite mode on iff arg is positive.
-In binary overwrite mode, printing characters typed in replace
-existing text.  Newlines are not treated specially, so typing at the
-end of a line joins the line to the next, with the typed character
-between them.  Typing before a tab character simply replaces the tab
-with the character typed.
-\\[quoted-insert] replaces the text at the cursor, just as ordinary
-typing characters do.
-
-Note that binary overwrite mode is not its own minor mode; it is a
-specialization of overwrite-mode, entered by setting the
-`overwrite-mode' variable to `overwrite-mode-binary'."
-  (interactive "P")
-  (setq overwrite-mode
-	(if (if (null arg)
-		(not (eq overwrite-mode 'overwrite-mode-binary))
-	      (> (prefix-numeric-value arg) 0))
-	    'overwrite-mode-binary))
-  (force-mode-line-update))
-
-(defvar line-number-mode t
-  "*Non-nil means display line number in mode line.")
-
-(defun line-number-mode (arg)
-  "Toggle Line Number mode.
-With arg, turn Line Number mode on iff arg is positive.
-When Line Number mode is enabled, the line number appears
-in the mode line."
-  (interactive "P")
-  (setq line-number-mode
-	(if (null arg) (not line-number-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (force-mode-line-update))
-
-(defvar column-number-mode nil
-  "*Non-nil means display column number in mode line.")
-
-(defun column-number-mode (arg)
-  "Toggle Column Number mode.
-With arg, turn Column Number mode on iff arg is positive.
-When Column Number mode is enabled, the column number appears
-in the mode line."
-  (interactive "P")
-  (setq column-number-mode
-	(if (null arg) (not column-number-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (force-mode-line-update))
-
-(defvar blink-matching-paren t
-  "*Non-nil means show matching open-paren when close-paren is inserted.")
-
-(defvar blink-matching-paren-on-screen t
-  "*Non-nil means show matching open-paren when it is on screen.
-nil means don't show it (but the open-paren can still be shown
-when it is off screen.")
-
-(defvar blink-matching-paren-distance 12000
-  "*If non-nil, is maximum distance to search for matching open-paren.")
-
-(defvar blink-matching-delay 1
-  "*The number of seconds that `blink-matching-open' will delay at a match.")
-
-(defvar blink-matching-paren-dont-ignore-comments nil
-  "*Non-nil means `blink-matching-paren' should not ignore comments.")
-
-(defun blink-matching-open ()
-  "Move cursor momentarily to the beginning of the sexp before point."
-  (interactive)
-  (and (> (point) (1+ (point-min)))
-       blink-matching-paren
-       ;; Verify an even number of quoting characters precede the close.
-       (= 1 (logand 1 (- (point)
-			 (save-excursion
-			   (forward-char -1)
-			   (skip-syntax-backward "/\\")
-			   (point)))))
-       (let* ((oldpos (point))
-	      (blinkpos)
-	      (mismatch))
-	 (save-excursion
-	   (save-restriction
-	     (if blink-matching-paren-distance
-		 (narrow-to-region (max (point-min)
-					(- (point) blink-matching-paren-distance))
-				   oldpos))
-	     (condition-case ()
-		 (let ((parse-sexp-ignore-comments
-			(and parse-sexp-ignore-comments
-			     (not blink-matching-paren-dont-ignore-comments))))
-		   (setq blinkpos (scan-sexps oldpos -1)))
-	       (error nil)))
-	   (and blinkpos
-		(/= (char-syntax (char-after blinkpos))
-		    ?\$)
-		(setq mismatch
-		      (or (null (matching-paren (char-after blinkpos)))
-			  (/= (char-after (1- oldpos))
-			      (matching-paren (char-after blinkpos))))))
-	   (if mismatch (setq blinkpos nil))
-	   (if blinkpos
-	       (progn
-		(goto-char blinkpos)
-		(if (pos-visible-in-window-p)
-		    (and blink-matching-paren-on-screen
-			 (sit-for blink-matching-delay))
-		  (goto-char blinkpos)
-		  (message
-		   "Matches %s"
-		   ;; Show what precedes the open in its line, if anything.
-		   (if (save-excursion
-			 (skip-chars-backward " \t")
-			 (not (bolp)))
-		       (buffer-substring (progn (beginning-of-line) (point))
-					 (1+ blinkpos))
-		     ;; Show what follows the open in its line, if anything.
-		     (if (save-excursion
-			   (forward-char 1)
-			   (skip-chars-forward " \t")
-			   (not (eolp)))
-			 (buffer-substring blinkpos
-					   (progn (end-of-line) (point)))
-		       ;; Otherwise show the previous nonblank line,
-		       ;; if there is one.
-		       (if (save-excursion
-			     (skip-chars-backward "\n \t")
-			     (not (bobp)))
-			   (concat
-			    (buffer-substring (progn
-					       (skip-chars-backward "\n \t")
-					       (beginning-of-line)
-					       (point))
-					      (progn (end-of-line)
-						     (skip-chars-backward " \t")
-						     (point)))
-			    ;; Replace the newline and other whitespace with `...'.
-			    "..."
-			    (buffer-substring blinkpos (1+ blinkpos)))
-			 ;; There is nothing to show except the char itself.
-			 (buffer-substring blinkpos (1+ blinkpos))))))))
-	     (cond (mismatch
-		    (message "Mismatched parentheses"))
-		   ((not blink-matching-paren-distance)
-		    (message "Unmatched parenthesis"))))))))
-
-;Turned off because it makes dbx bomb out.
-(setq blink-paren-function 'blink-matching-open)
-
-;; This executes C-g typed while Emacs is waiting for a command.
-;; Quitting out of a program does not go through here;
-;; that happens in the QUIT macro at the C code level.
-(defun keyboard-quit ()
-  "Signal a  quit  condition.
-During execution of Lisp code, this character causes a quit directly.
-At top-level, as an editor command, this simply beeps."
-  (interactive)
-  (deactivate-mark)
-  (signal 'quit nil))
-
-(define-key global-map "\C-g" 'keyboard-quit)
-
-(defvar buffer-quit-function nil
-  "Function to call to \"quit\" the current buffer, or nil if none.
-\\[keyboard-escape-quit] calls this function when its more local actions
-\(such as cancelling a prefix argument, minibuffer or region) do not apply.")
-
-(defun keyboard-escape-quit ()
-  "Exit the current \"mode\" (in a generalized sense of the word).
-This command can exit an interactive command such as `query-replace',
-can clear out a prefix argument or a region,
-can get out of the minibuffer or other recursive edit,
-cancel the use of the current buffer (for special-purpose buffers),
-or go back to just one window (by deleting all but the selected window)."
-  (interactive)
-  (cond ((eq last-command 'mode-exited) nil)
-	((> (minibuffer-depth) 0)
-	 (abort-recursive-edit))
-	(current-prefix-arg
-	 nil)
-	((and transient-mark-mode
-	      mark-active)
-	 (deactivate-mark))
-	(buffer-quit-function
-	 (funcall buffer-quit-function))
-	((not (one-window-p t))
-	 (delete-other-windows))))
-
-(define-key global-map "\e\e\e" 'keyboard-escape-quit)
-
-(defvar mail-user-agent 'sendmail-user-agent
-  "*Your preference for a mail composition package.
-Various Emacs Lisp packages (e.g. reporter) require you to compose an
-outgoing email message.  This variable lets you specify which
-mail-sending package you prefer.
-
-Valid values include:
-
-    sendmail-user-agent -- use the default Emacs Mail package
-    mh-e-user-agent     -- use the Emacs interface to the MH mail system
-    message-user-agent  -- use the GNUS mail sending package
-
-Additional valid symbols may be available; check with the author of
-your package for details.")
-
-(defun define-mail-user-agent (symbol composefunc sendfunc
-				      &optional abortfunc hookvar)
-  "Define a symbol to identify a mail-sending package for `mail-user-agent'.
-
-SYMBOL can be any Lisp symbol.  Its function definition and/or
-value as a variable do not matter for this usage; we use only certain
-properties on its property list, to encode the rest of the arguments.
-
-COMPOSEFUNC is program callable function that composes an outgoing
-mail message buffer.  This function should set up the basics of the
-buffer without requiring user interaction.  It should populate the
-standard mail headers, leaving the `to:' and `subject:' headers blank
-by default.
-
-COMPOSEFUNC should accept several optional arguments--the same
-arguments that `compose-mail' takes.  See that function's documentation.
-
-SENDFUNC is the command a user would run to send the message.
-
-Optional ABORTFUNC is the command a user would run to abort the
-message.  For mail packages that don't have a separate abort function,
-this can be `kill-buffer' (the equivalent of omitting this argument).
-
-Optional HOOKVAR is a hook variable that gets run before the message
-is actually sent.  Callers that use the `mail-user-agent' may
-install a hook function temporarily on this hook variable.
-If HOOKVAR is nil, `mail-send-hook' is used.
-
-The properties used on SYMBOL are `composefunc', `sendfunc',
-`abortfunc', and `hookvar'."
-  (put symbol 'composefunc composefunc)
-  (put symbol 'sendfunc sendfunc)
-  (put symbol 'abortfunc (or abortfunc 'kill-buffer))
-  (put symbol 'hookvar (or hookvar 'mail-send-hook)))
-
-(defun assoc-ignore-case (key alist)
-  "Like `assoc', but assumes KEY is a string and ignores case when comparing."
-  (let (element)
-    (while (and alist (not element))
-      (if (equal key (downcase (car (car alist))))
-	  (setq element (car alist)))
-      (setq alist (cdr alist)))
-    element))
-
-(define-mail-user-agent 'sendmail-user-agent
-  '(lambda (&optional to subject other-headers continue
-		      switch-function yank-action send-actions)
-     (if switch-function
-	 (let ((special-display-buffer-names nil)
-	       (special-display-regexps nil)
-	       (same-window-buffer-names nil)
-	       (same-window-regexps nil))
-	   (funcall switch-function "*mail*")))
-     (let ((cc (cdr (assoc-ignore-case "cc" other-headers)))
-	   (in-reply-to (cdr (assoc-ignore-case "in-reply-to" other-headers))))
-       (or (mail continue to subject in-reply-to cc yank-action send-actions)
-	   continue
-	   (error "Message aborted"))))
-  'mail-send-and-exit)
-
-(define-mail-user-agent 'mh-e-user-agent
-  'mh-smail-batch 'mh-send-letter 'mh-fully-kill-draft
-  'mh-before-send-letter-hook)
-
-(defun compose-mail (&optional to subject other-headers continue
-			       switch-function yank-action send-actions)
-  "Start composing a mail message to send.
-This uses the user's chosen mail composition package
-as selected with the variable `mail-user-agent'.
-The optional arguments TO and SUBJECT specify recipients
-and the initial Subject field, respectively.
-
-OTHER-HEADERS is an alist specifying additional
-header fields.  Elements look like (HEADER . VALUE) where both
-HEADER and VALUE are strings.
-
-CONTINUE, if non-nil, says to continue editing a message already
-being composed.
-
-SWITCH-FUNCTION, if non-nil, is a function to use to
-switch to and display the buffer used for mail composition.
-
-YANK-ACTION, if non-nil, is an action to perform, if and when necessary,
-to insert the raw text of the message being replied to.
-It has the form (FUNCTION . ARGS).  The user agent will apply
-FUNCTION to ARGS, to insert the raw text of the original message.
-\(The user agent will also run `mail-citation-hook', *after* the
-original text has been inserted in this way.)
-
-SEND-ACTIONS is a list of actions to call when the message is sent.
-Each action has the form (FUNCTION . ARGS)."
-  (interactive)
-  (let ((function (get mail-user-agent 'composefunc)))
-    (funcall function to subject other-headers continue
-	     switch-function yank-action send-actions)))
-
-(defun set-variable (var val)
-  "Set VARIABLE to VALUE.  VALUE is a Lisp object.
-When using this interactively, supply a Lisp expression for VALUE.
-If you want VALUE to be a string, you must surround it with doublequotes.
-
-If VARIABLE has a `variable-interactive' property, that is used as if
-it were the arg to `interactive' (which see) to interactively read the value."
-  (interactive
-   (let* ((var (read-variable "Set variable: "))
-	  (minibuffer-help-form
-	   '(funcall myhelp))
-	  (myhelp
-	   (function
-	    (lambda ()
-	      (with-output-to-temp-buffer "*Help*"
-		(prin1 var)
-		(princ "\nDocumentation:\n")
-		(princ (substring (documentation-property var 'variable-documentation)
-				  1))
-		(if (boundp var)
-		    (let ((print-length 20))
-		      (princ "\n\nCurrent value: ")
-		      (prin1 (symbol-value var))))
-		(save-excursion
-		  (set-buffer standard-output)
-		  (help-mode))
-		nil)))))
-     (list var
-	   (let ((prop (get var 'variable-interactive)))
-	     (if prop
-		 ;; Use VAR's `variable-interactive' property
-		 ;; as an interactive spec for prompting.
-		 (call-interactively (list 'lambda '(arg)
-					   (list 'interactive prop)
-					   'arg))
-	       (eval-minibuffer (format "Set %s to value: " var)))))))
-  (set var val))
-
-;; Define the major mode for lists of completions.
-
-(defvar completion-list-mode-map nil
-  "Local map for completion list buffers.")
-(or completion-list-mode-map
-    (let ((map (make-sparse-keymap)))
-      (define-key map [mouse-2] 'mouse-choose-completion)
-      (define-key map [down-mouse-2] nil)
-      (define-key map "\C-m" 'choose-completion)
-      (define-key map "\e\e\e" 'delete-completion-window)
-      (define-key map [left] 'previous-completion)
-      (define-key map [right] 'next-completion)
-      (setq completion-list-mode-map map)))
-
-;; Completion mode is suitable only for specially formatted data.
-(put 'completion-list-mode 'mode-class 'special)
-
-(defvar completion-reference-buffer nil
-  "Record the buffer that was current when the completion list was requested.
-This is a local variable in the completion list buffer.
-Initial value is nil to avoid some compiler warnings.")
-
-(defvar completion-base-size nil
-  "Number of chars at beginning of minibuffer not involved in completion.
-This is a local variable in the completion list buffer
-but it talks about the buffer in `completion-reference-buffer'.
-If this is nil, it means to compare text to determine which part
-of the tail end of the buffer's text is involved in completion.")
-
-(defun delete-completion-window ()
-  "Delete the completion list window.
-Go to the window from which completion was requested."
-  (interactive)
-  (let ((buf completion-reference-buffer))
-    (delete-window (selected-window))
-    (if (get-buffer-window buf)
-	(select-window (get-buffer-window buf)))))
-
-(defun previous-completion (n)
-  "Move to the previous item in the completion list."
-  (interactive "p")
-  (next-completion (- n)))
-
-(defun next-completion (n)
-  "Move to the next item in the completion list.
-With prefix argument N, move N items (negative N means move backward)."
-  (interactive "p")
-  (while (and (> n 0) (not (eobp)))
-    (let ((prop (get-text-property (point) 'mouse-face))
-	  (end (point-max)))
-      ;; If in a completion, move to the end of it.
-      (if prop
-	  (goto-char (next-single-property-change (point) 'mouse-face nil end)))
-      ;; Move to start of next one.
-      (goto-char (next-single-property-change (point) 'mouse-face nil end)))
-    (setq n (1- n)))
-  (while (and (< n 0) (not (bobp)))
-    (let ((prop (get-text-property (1- (point)) 'mouse-face))
-	  (end (point-min)))
-      ;; If in a completion, move to the start of it.
-      (if prop
-	  (goto-char (previous-single-property-change
-		      (point) 'mouse-face nil end)))
-      ;; Move to end of the previous completion.
-      (goto-char (previous-single-property-change (point) 'mouse-face nil end))
-      ;; Move to the start of that one.
-      (goto-char (previous-single-property-change (point) 'mouse-face nil end)))
-    (setq n (1+ n))))
-
-(defun choose-completion ()
-  "Choose the completion that point is in or next to."
-  (interactive)
-  (let (beg end completion (buffer completion-reference-buffer)
-	(base-size completion-base-size))
-    (if (and (not (eobp)) (get-text-property (point) 'mouse-face))
-	(setq end (point) beg (1+ (point))))
-    (if (and (not (bobp)) (get-text-property (1- (point)) 'mouse-face))
-	(setq end (1- (point)) beg (point)))
-    (if (null beg)
-	(error "No completion here"))
-    (setq beg (previous-single-property-change beg 'mouse-face))
-    (setq end (or (next-single-property-change end 'mouse-face) (point-max)))
-    (setq completion (buffer-substring beg end))
-    (let ((owindow (selected-window)))
-      (if (and (one-window-p t 'selected-frame)
-	       (window-dedicated-p (selected-window)))
-	  ;; This is a special buffer's frame
-	  (iconify-frame (selected-frame))
-	(or (window-dedicated-p (selected-window))
-	    (bury-buffer)))
-      (select-window owindow))
-    (choose-completion-string completion buffer base-size)))
-
-;; Delete the longest partial match for STRING
-;; that can be found before POINT.
-(defun choose-completion-delete-max-match (string)
-  (let ((opoint (point))
-	(len (min (length string)
-		  (- (point) (point-min)))))
-    (goto-char (- (point) (length string)))
-    (if completion-ignore-case
-	(setq string (downcase string)))
-    (while (and (> len 0)
-		(let ((tail (buffer-substring (point)
-					      (+ (point) len))))
-		  (if completion-ignore-case
-		      (setq tail (downcase tail)))
-		  (not (string= tail (substring string 0 len)))))
-      (setq len (1- len))
-      (forward-char 1))
-    (delete-char len)))
-
-;; Switch to BUFFER and insert the completion choice CHOICE.
-;; BASE-SIZE, if non-nil, says how many characters of BUFFER's text
-;; to keep.  If it is nil, use choose-completion-delete-max-match instead.
-
-;; If BUFFER is the minibuffer, exit the minibuffer
-;; unless it is reading a file name and CHOICE is a directory.
-(defun choose-completion-string (choice &optional buffer base-size)
-  (let ((buffer (or buffer completion-reference-buffer)))
-    ;; If BUFFER is a minibuffer, barf unless it's the currently
-    ;; active minibuffer.
-    (if (and (string-match "\\` \\*Minibuf-[0-9]+\\*\\'" (buffer-name buffer))
-	     (or (not (active-minibuffer-window))
-		 (not (equal buffer
-			     (window-buffer (active-minibuffer-window))))))
-	(error "Minibuffer is not active for completion")
-      ;; Insert the completion into the buffer where completion was requested.
-      (set-buffer buffer)
-      (if base-size
-	  (delete-region (+ base-size (point-min)) (point))
-	(choose-completion-delete-max-match choice))
-      (insert choice)
-      (remove-text-properties (- (point) (length choice)) (point)
-			      '(mouse-face nil))
-      ;; Update point in the window that BUFFER is showing in.
-      (let ((window (get-buffer-window buffer t)))
-	(set-window-point window (point)))
-      ;; If completing for the minibuffer, exit it with this choice.
-      (and (equal buffer (window-buffer (minibuffer-window)))
-	   minibuffer-completion-table
-	   ;; If this is reading a file name, and the file name chosen
-	   ;; is a directory, don't exit the minibuffer.
-	   (if (and (eq minibuffer-completion-table 'read-file-name-internal)
-		    (file-directory-p (buffer-string)))
-	       (select-window (active-minibuffer-window))
-	     (exit-minibuffer))))))
-
-(defun completion-list-mode ()
-  "Major mode for buffers showing lists of possible completions.
-Type \\<completion-list-mode-map>\\[choose-completion] in the completion list\
- to select the completion near point.
-Use \\<completion-list-mode-map>\\[mouse-choose-completion] to select one\
- with the mouse."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map completion-list-mode-map)
-  (setq mode-name "Completion List")
-  (setq major-mode 'completion-list-mode)
-  (make-local-variable 'completion-base-size)
-  (setq completion-base-size nil)
-  (run-hooks 'completion-list-mode-hook))
-
-(defvar completion-fixup-function nil
-  "A function to customize how completions are identified in completion lists.
-`completion-setup-function' calls this function with no arguments
-each time it has found what it thinks is one completion.
-Point is at the end of the completion in the completion list buffer.
-If this function moves point, it can alter the end of that completion.")
-
-;; This function goes in completion-setup-hook, so that it is called
-;; after the text of the completion list buffer is written.
-
-(defun completion-setup-function ()
-  (save-excursion
-    (let ((mainbuf (current-buffer)))
-      (set-buffer standard-output)
-      (completion-list-mode)
-      (make-local-variable 'completion-reference-buffer)
-      (setq completion-reference-buffer mainbuf)
-;;; The value 0 is right in most cases, but not for file name completion.
-;;; so this has to be turned off.
-;;;      (setq completion-base-size 0)
-      (goto-char (point-min))
-      (if window-system
-	  (insert (substitute-command-keys
-		   "Click \\[mouse-choose-completion] on a completion to select it.\n")))
-      (insert (substitute-command-keys
-	       "In this buffer, type \\[choose-completion] to \
-select the completion near point.\n\n"))
-      (forward-line 1)
-      (while (re-search-forward "[^ \t\n]+\\( [^ \t\n]+\\)*" nil t)
-	(let ((beg (match-beginning 0))
-	      (end (point)))
-	  (if completion-fixup-function
-	      (funcall completion-fixup-function))
-	  (put-text-property beg (point) 'mouse-face 'highlight)
-	  (goto-char end))))))
-
-(add-hook 'completion-setup-hook 'completion-setup-function)
-
-(define-key minibuffer-local-completion-map [prior]
-  'switch-to-completions)
-(define-key minibuffer-local-must-match-map [prior]
-  'switch-to-completions)
-(define-key minibuffer-local-completion-map "\M-v"
-  'switch-to-completions)
-(define-key minibuffer-local-must-match-map "\M-v"
-  'switch-to-completions)
-
-(defun switch-to-completions ()
-  "Select the completion list window."
-  (interactive)
-  ;; Make sure we have a completions window.
-  (or (get-buffer-window "*Completions*")
-      (minibuffer-completion-help))
-  (select-window (get-buffer-window "*Completions*"))
-  (goto-char (point-min))
-  (search-forward "\n\n")
-  (forward-line 1))
-
-;; Support keyboard commands to turn on various modifiers.
-
-;; These functions -- which are not commands -- each add one modifier
-;; to the following event.
-
-(defun event-apply-alt-modifier (ignore-prompt)
-  (vector (event-apply-modifier (read-event) 'alt 22 "A-")))
-(defun event-apply-super-modifier (ignore-prompt)
-  (vector (event-apply-modifier (read-event) 'super 23 "s-")))
-(defun event-apply-hyper-modifier (ignore-prompt)
-  (vector (event-apply-modifier (read-event) 'hyper 24 "H-")))
-(defun event-apply-shift-modifier (ignore-prompt)
-  (vector (event-apply-modifier (read-event) 'shift 25 "S-")))
-(defun event-apply-control-modifier (ignore-prompt)
-  (vector (event-apply-modifier (read-event) 'control 26 "C-")))
-(defun event-apply-meta-modifier (ignore-prompt)
-  (vector (event-apply-modifier (read-event) 'meta 27 "M-")))
-
-(defun event-apply-modifier (event symbol lshiftby prefix)
-  "Apply a modifier flag to event EVENT.
-SYMBOL is the name of this modifier, as a symbol.
-LSHIFTBY is the numeric value of this modifier, in keyboard events.
-PREFIX is the string that represents this modifier in an event type symbol."
-  (if (numberp event)
-      (cond ((eq symbol 'control)
-	     (if (and (<= (downcase event) ?z)
-		      (>= (downcase event) ?a))
-		 (- (downcase event) ?a -1)
-	       (if (and (<= (downcase event) ?Z)
-			(>= (downcase event) ?A))
-		   (- (downcase event) ?A -1)
-		 (logior (lsh 1 lshiftby) event))))
-	    ((eq symbol 'shift)
-	     (if (and (<= (downcase event) ?z)
-		      (>= (downcase event) ?a))
-		 (upcase event)
-	       (logior (lsh 1 lshiftby) event)))
-	    (t
-	     (logior (lsh 1 lshiftby) event)))
-    (if (memq symbol (event-modifiers event))
-	event
-      (let ((event-type (if (symbolp event) event (car event))))
-	(setq event-type (intern (concat prefix (symbol-name event-type))))
-	(if (symbolp event)
-	    event-type
-	  (cons event-type (cdr event)))))))
-
-(define-key function-key-map [?\C-x ?@ ?h] 'event-apply-hyper-modifier)
-(define-key function-key-map [?\C-x ?@ ?s] 'event-apply-super-modifier)
-(define-key function-key-map [?\C-x ?@ ?m] 'event-apply-meta-modifier)
-(define-key function-key-map [?\C-x ?@ ?a] 'event-apply-alt-modifier)
-(define-key function-key-map [?\C-x ?@ ?S] 'event-apply-shift-modifier)
-(define-key function-key-map [?\C-x ?@ ?c] 'event-apply-control-modifier)
-
-;;;; Keypad support.
-
-;;; Make the keypad keys act like ordinary typing keys.  If people add
-;;; bindings for the function key symbols, then those bindings will
-;;; override these, so this shouldn't interfere with any existing
-;;; bindings.
-
-;; Also tell read-char how to handle these keys.
-(mapcar
- (lambda (keypad-normal)
-   (let ((keypad (nth 0 keypad-normal))
-	 (normal (nth 1 keypad-normal)))
-     (put keypad 'ascii-character normal)
-     (define-key function-key-map (vector keypad) (vector normal))))
- '((kp-0 ?0) (kp-1 ?1) (kp-2 ?2) (kp-3 ?3) (kp-4 ?4)
-   (kp-5 ?5) (kp-6 ?6) (kp-7 ?7) (kp-8 ?8) (kp-9 ?9)
-   (kp-space ?\ )
-   (kp-tab ?\t)
-   (kp-enter ?\r)
-   (kp-multiply ?*)
-   (kp-add ?+)
-   (kp-separator ?,)
-   (kp-subtract ?-)
-   (kp-decimal ?.)
-   (kp-divide ?/)
-   (kp-equal ?=)))
-
-;;; simple.el ends here
diff --git a/lisp/skeleton.el b/lisp/skeleton.el
deleted file mode 100644
index a5bacfeb1b0..00000000000
--- a/lisp/skeleton.el
+++ /dev/null
@@ -1,592 +0,0 @@
-;;; skeleton.el --- Lisp language extension for writing statement skeletons
-
-;; Copyright (C) 1993, 1994, 1995, 1996 by Free Software Foundation, Inc.
-
-;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
-;; Maintainer: FSF
-;; Keywords: extensions, abbrev, languages, 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:
-
-;; A very concise language extension for writing structured statement
-;; skeleton insertion commands for programming language modes.  This
-;; originated in shell-script mode and was applied to ada-mode's
-;; commands which shrunk to one third.  And these commands are now
-;; user configurable.
-
-;;; Code:
-
-;; page 1:	statement skeleton language definition & interpreter
-;; page 2:	paired insertion
-;; page 3:	mirror-mode, an example for setting up paired insertion
-
-
-(defvar skeleton-transformation nil
-  "*If non-nil, function applied to literal strings before they are inserted.
-It should take strings and characters and return them transformed, or nil
-which means no transformation.
-Typical examples might be `upcase' or `capitalize'.")
-
-; this should be a fourth argument to defvar
-(put 'skeleton-transformation 'variable-interactive
-     "aTransformation function: ")
-
-
-(defvar skeleton-autowrap t
-  "Controls wrapping behaviour of functions created with `define-skeleton'.
-When the region is visible (due to `transient-mark-mode' or marking a region
-with the mouse) and this is non-`nil' and the function was called without an
-explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible
-region.
-
-We will probably delete this variable in a future Emacs version
-unless we get a substantial number of complaints about the auto-wrap
-feature.")
-
-(defvar skeleton-end-hook
-  (lambda ()
-    (or (eolp) (newline-and-indent)))
-  "Hook called at end of skeleton but before going to point of interest.
-By default this moves out anything following to next line.
-The variables `v1' and `v2' are still set when calling this.")
-
-
-;;;###autoload
-(defvar skeleton-filter 'identity
-  "Function for transforming a skeleton proxy's aliases' variable value.")
-
-(defvar skeleton-untabify t
-  "When non-`nil' untabifies when deleting backwards with element -ARG.")
-
-(defvar skeleton-newline-indent-rigidly nil
-  "When non-`nil', indent rigidly under current line for element `\\n'.
-Else use mode's `indent-line-function'.")
-
-(defvar skeleton-further-elements ()
-  "A buffer-local varlist (see `let') of mode specific skeleton elements.
-These variables are bound while interpreting a skeleton.  Their value may
-in turn be any valid skeleton element if they are themselves to be used as
-skeleton elements.")
-(make-variable-buffer-local 'skeleton-further-elements)
-
-
-(defvar skeleton-subprompt
-  (substitute-command-keys
-   "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]")
-  "*Replacement for %s in prompts of recursive subskeletons.")
-
-
-(defvar skeleton-abbrev-cleanup nil
-  "Variable used to delete the character that led to abbrev expansion.")
-
-
-(defvar skeleton-debug nil
-  "*If non-nil `define-skeleton' will override previous definition.")
-
-(defvar skeleton-positions nil
-  "List of positions marked with @, after skeleton insertion.
-The list describes the most recent skeleton insertion, and its elements
-are integer buffer positions in the reverse order of the insertion order.")
-
-;; reduce the number of compiler warnings
-(defvar skeleton)
-(defvar skeleton-modified)
-(defvar skeleton-point)
-(defvar skeleton-regions)
-
-;;;###autoload
-(defmacro define-skeleton (command documentation &rest skeleton)
-  "Define a user-configurable COMMAND that enters a statement skeleton.
-DOCUMENTATION is that of the command, while the variable of the same name,
-which contains the skeleton, has a documentation to that effect.
-INTERACTOR and ELEMENT ... are as defined under `skeleton-insert'."
-  (if skeleton-debug
-      (set command skeleton))
-  `(progn
-     (defun ,command (&optional str arg)
-       ,(concat documentation
-		(if (string-match "\n\\>" documentation)
-		    "" "\n")
-		"\n"
-  "This is a skeleton command (see `skeleton-insert').
-Normally the skeleton text is inserted at point, with nothing \"inside\".
-If there is a highlighted region, the skeleton text is wrapped
-around the region text.
-
-A prefix argument ARG says to wrap the skeleton around the next ARG words.
-A prefix argument of zero says to wrap around zero words---that is, nothing.
-This is a way of overiding the use of a highlighted region.")
-       (interactive "*P\nP")
-       (skeleton-proxy-new ',skeleton str arg))))
-
-;;;###autoload
-(defun skeleton-proxy-new (skeleton &optional str arg)
-  "Insert skeleton defined by variable of same name (see `skeleton-insert').
-Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
-If no ARG was given, but the region is visible, ARG defaults to -1 depending
-on `skeleton-autowrap'.  An ARG of  M-0  will prevent this just for once.
-This command can also be an abbrev expansion (3rd and 4th columns in
-\\[edit-abbrevs]  buffer: \"\"  command-name).
-
-When called as a function, optional first argument STR may also be a string
-which will be the value of `str' whereas the skeleton's interactor is then
-ignored."
-  (interactive "*P\nP")
-  (setq skeleton (funcall skeleton-filter skeleton))
-  (if (not skeleton)
-      (if (memq this-command '(self-insert-command
-			       skeleton-pair-insert-maybe
-			       expand-abbrev))
-	  (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))
-    (skeleton-insert skeleton
-		     (if (setq skeleton-abbrev-cleanup
-			       (or (eq this-command 'self-insert-command)
-				   (eq this-command
-				       'skeleton-pair-insert-maybe)))
-			 ()
-		       ;; Pretend  C-x a e  passed its prefix arg to us
-		       (if (or arg current-prefix-arg)
-			   (prefix-numeric-value (or arg
-						     current-prefix-arg))
-			 (and skeleton-autowrap
-			      (or (eq last-command 'mouse-drag-region)
-				  (and transient-mark-mode mark-active))
-			      -1)))
-		     (if (stringp str)
-			 str))
-    (and skeleton-abbrev-cleanup
-	 (setq skeleton-abbrev-cleanup (point))
-	 (add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t))))
-
-;; This command isn't meant to be called, only its aliases with meaningful
-;; names are.
-;;;###autoload
-(defun skeleton-proxy (&optional str arg)
-  "Insert skeleton defined by variable of same name (see `skeleton-insert').
-Prefix ARG allows wrapping around words or regions (see `skeleton-insert').
-If no ARG was given, but the region is visible, ARG defaults to -1 depending
-on `skeleton-autowrap'.  An ARG of  M-0  will prevent this just for once.
-This command can also be an abbrev expansion (3rd and 4th columns in
-\\[edit-abbrevs]  buffer: \"\"  command-name).
-
-When called as a function, optional first argument STR may also be a string
-which will be the value of `str' whereas the skeleton's interactor is then
-ignored."
-  (interactive "*P\nP")
-  (let ((function (nth 1 (backtrace-frame 1))))
-    (if (eq function 'nth)		; uncompiled Lisp function
-	(setq function (nth 1 (backtrace-frame 5)))
-      (if (eq function 'byte-code)	; tracing byte-compiled function
-	  (setq function (nth 1 (backtrace-frame 2)))))
-    (if (not (setq function (funcall skeleton-filter (symbol-value function))))
-	(if (memq this-command '(self-insert-command
-				 skeleton-pair-insert-maybe
-				 expand-abbrev))
-	    (setq buffer-undo-list (primitive-undo 1 buffer-undo-list)))
-      (skeleton-insert function
-		       (if (setq skeleton-abbrev-cleanup
-				 (or (eq this-command 'self-insert-command)
-				     (eq this-command
-					 'skeleton-pair-insert-maybe)))
-			   ()
-			 ;; Pretend  C-x a e  passed its prefix arg to us
-			 (if (or arg current-prefix-arg)
-			     (prefix-numeric-value (or arg
-						       current-prefix-arg))
-			   (and skeleton-autowrap
-				(or (eq last-command 'mouse-drag-region)
-				    (and transient-mark-mode mark-active))
-				-1)))
-		       (if (stringp str)
-			   str))
-      (and skeleton-abbrev-cleanup
-	   (setq skeleton-abbrev-cleanup (point))
-	   (add-hook 'post-command-hook 'skeleton-abbrev-cleanup nil t)))))
-
-
-(defun skeleton-abbrev-cleanup (&rest list)
-  "Value for `post-command-hook' to remove char that expanded abbrev."
-  (if (integerp skeleton-abbrev-cleanup)
-      (progn
-	(delete-region skeleton-abbrev-cleanup (point))
-	(setq skeleton-abbrev-cleanup)
-	(remove-hook 'post-command-hook 'skeleton-abbrev-cleanup t))))
-
-
-;;;###autoload
-(defun skeleton-insert (skeleton &optional skeleton-regions str)
-  "Insert the complex statement skeleton SKELETON describes very concisely.
-
-With optional third REGIONS wrap first interesting point (`_') in skeleton
-around next REGIONS words, if REGIONS is positive.  If REGIONS is negative,
-wrap REGIONS preceding interregions into first REGIONS interesting positions
-\(successive `_'s) in skeleton.  An interregion is the stretch of text between
-two contiguous marked points.  If you marked A B C [] (where [] is the cursor)
-in alphabetical order, the 3 interregions are simply the last 3 regions.  But
-if you marked B A [] C, the interregions are B-A, A-[], []-C.
-
-Optional fourth STR is the value for the variable `str' within the skeleton.
-When this is non-`nil' the interactor gets ignored, and this should be a valid
-skeleton element.
-
-SKELETON is made up as (INTERACTOR ELEMENT ...).  INTERACTOR may be nil if
-not needed, a prompt-string or an expression for complex read functions.
-
-If ELEMENT is a string or a character it gets inserted (see also
-`skeleton-transformation').  Other possibilities are:
-
-	\\n	go to next line and indent according to mode
-	_	interesting point, interregion here, point after termination
-	>	indent line (or interregion if > _) according to major mode
-	@	add position to `skeleton-positions'
-	&	do next ELEMENT if previous moved point
-	|	do next ELEMENT if previous didn't move point
-	-num	delete num preceding characters (see `skeleton-untabify')
-	resume:	skipped, continue here if quit is signaled
-	nil	skipped
-
-Further elements can be defined via `skeleton-further-elements'.  ELEMENT may
-itself be a SKELETON with an INTERACTOR.  The user is prompted repeatedly for
-different inputs.  The SKELETON is processed as often as the user enters a
-non-empty string.  \\[keyboard-quit] terminates skeleton insertion, but
-continues after `resume:' and positions at `_' if any.  If INTERACTOR in such
-a subskeleton is a prompt-string which contains a \".. %s ..\" it is
-formatted with `skeleton-subprompt'.  Such an INTERACTOR may also a list of
-strings with the subskeleton being repeated once for each string.
-
-Quoted Lisp expressions are evaluated evaluated for their side-effect.
-Other Lisp expressions are evaluated and the value treated as above.
-Note that expressions may not return `t' since this implies an
-endless loop.  Modes can define other symbols by locally setting them
-to any valid skeleton element.  The following local variables are
-available:
-
-	str	first time: read a string according to INTERACTOR
-		then: insert previously read string once more
-	help	help-form during interaction with the user or `nil'
-	input	initial input (string or cons with index) while reading str
-	v1, v2	local variables for memorizing anything you want
-
-When done with skeleton, but before going back to `_'-point call
-`skeleton-end-hook' if that is non-`nil'."
-  (and skeleton-regions
-       (setq skeleton-regions
-	     (if (> skeleton-regions 0)
-		 (list (point-marker)
-		       (save-excursion (forward-word skeleton-regions)
-				       (point-marker)))
-	       (setq skeleton-regions (- skeleton-regions))
-	       ;; copy skeleton-regions - 1 elements from `mark-ring'
-	       (let ((l1 (cons (mark-marker) mark-ring))
-		     (l2 (list (point-marker))))
-		 (while (and l1 (> skeleton-regions 0))
-		   (setq l2 (cons (car l1) l2)
-			 skeleton-regions (1- skeleton-regions)
-			 l1 (cdr l1)))
-		 (sort l2 '<))))
-       (goto-char (car skeleton-regions))
-       (setq skeleton-regions (cdr skeleton-regions)))
-  (let ((beg (point))
-	skeleton-modified skeleton-point resume: help input v1 v2)
-    (setq skeleton-positions nil)
-    (unwind-protect
-	(eval `(let ,skeleton-further-elements
-		 (skeleton-internal-list skeleton str)))
-      (run-hooks 'skeleton-end-hook)
-      (sit-for 0)
-      (or (pos-visible-in-window-p beg)
-	  (progn
-	    (goto-char beg)
-	    (recenter 0)))
-      (if skeleton-point
-	  (goto-char skeleton-point)))))
-
-(defun skeleton-read (str &optional initial-input recursive)
-  "Function for reading a string from the minibuffer within skeletons.
-PROMPT may contain a `%s' which will be replaced by `skeleton-subprompt'.
-If non-`nil' second arg INITIAL-INPUT or variable `input' is a string or
-cons with index to insert before reading.  If third arg RECURSIVE is non-`nil'
-i.e. we are handling the iterator of a subskeleton, returns empty string if
-user didn't modify input.
-While reading, the value of `minibuffer-help-form' is variable `help' if that
-is non-`nil' or a default string."
-  (let ((minibuffer-help-form (or (if (boundp 'help) (symbol-value 'help))
-				  (if recursive "\
-As long as you provide input you will insert another subskeleton.
-
-If you enter the empty string, the loop inserting subskeletons is
-left, and the current one is removed as far as it has been entered.
-
-If you quit, the current subskeleton is removed as far as it has been
-entered.  No more of the skeleton will be inserted, except maybe for a
-syntactically necessary termination."
-					 "\
-You are inserting a skeleton.  Standard text gets inserted into the buffer
-automatically, and you are prompted to fill in the variable parts.")))
-	(eolp (eolp)))
-    ;; since Emacs doesn't show main window's cursor, do something noticeable
-    (or eolp
-	(open-line 1))
-    (unwind-protect
-	(setq str (if (stringp str)
-		      (read-string (format str skeleton-subprompt)
-				   (setq initial-input
-					 (or initial-input
-					     (symbol-value 'input))))
-		    (eval str)))
-      (or eolp
-	  (delete-char 1))))
-  (if (and recursive
-	   (or (null str)
-	       (string= str "")
-	       (equal str initial-input)
-	       (equal str (car-safe initial-input))))
-      (signal 'quit t)
-    str))
-
-(defun skeleton-internal-list (skeleton &optional str recursive)
-  (let* ((start (save-excursion (beginning-of-line) (point)))
-	 (column (current-column))
-	 (line (buffer-substring start
-				 (save-excursion (end-of-line) (point))))
-	 opoint)
-    (or str
-	(setq str `(setq str (skeleton-read ',(car skeleton) nil ,recursive))))
-    (while (setq skeleton-modified (eq opoint (point))
-		 opoint (point)
-		 skeleton (cdr skeleton))
-      (condition-case quit
-	  (skeleton-internal-1 (car skeleton))
-	(quit
-	 (if (eq (cdr quit) 'recursive)
-	     (setq recursive 'quit
-		   skeleton (memq 'resume: skeleton))
-	   ;; remove the subskeleton as far as it has been shown
-	   ;; the subskeleton shouldn't have deleted outside current line
-	   (end-of-line)
-	   (delete-region start (point))
-	   (insert line)
-	   (move-to-column column)
-	   (if (cdr quit)
-	       (setq skeleton ()
-		     recursive nil)
-	     (signal 'quit 'recursive)))))))
-  ;; maybe continue loop or go on to next outer resume: section
-  (if (eq recursive 'quit)
-      (signal 'quit 'recursive)
-    recursive))
-
-
-(defun skeleton-internal-1 (element &optional literal)
-  (cond ((char-or-string-p element)
-	 (if (and (integerp element)	; -num
-		  (< element 0))
-	     (if skeleton-untabify
-		 (backward-delete-char-untabify (- element))
-	       (delete-backward-char (- element)))
-	   (insert-before-markers (if (and skeleton-transformation
-					   (not literal))
-				      (funcall skeleton-transformation element)
-				    element))))
-	((eq element '\n)		; actually (eq '\n 'n)
-	 (if (and skeleton-regions
-		  (eq (nth 1 skeleton) '_))
-	     (progn
-	       (or (eolp)
-		   (newline))
-	       (indent-region (point) (car skeleton-regions) nil))
-	   (if skeleton-newline-indent-rigidly
-	       (indent-to (prog1 (current-indentation)
-			    (newline)))
-	     (newline)
-	     (indent-according-to-mode))))
-	((eq element '>)
-	 (if (and skeleton-regions
-		  (eq (nth 1 skeleton) '_))
-	     (indent-region (point) (car skeleton-regions) nil)
-	   (indent-according-to-mode)))
-	((eq element '_)
-	 (if skeleton-regions
-	     (progn
-	       (goto-char (car skeleton-regions))
-	       (setq skeleton-regions (cdr skeleton-regions))
-	       (and (<= (current-column) (current-indentation))
-		    (eq (nth 1 skeleton) '\n)
-		    (end-of-line 0)))
-	   (or skeleton-point
-	       (setq skeleton-point (point)))))
-	((eq element '&)
-	 (if skeleton-modified
-	     (setq skeleton (cdr skeleton))))
-	((eq element '|)
-	 (or skeleton-modified
-	     (setq skeleton (cdr skeleton))))
-	((eq element '@)
-	 (setq skeleton-positions (cons (point) skeleton-positions)))
-	((eq 'quote (car-safe element))
-	 (eval (nth 1 element)))
-	((or (stringp (car-safe element))
-	     (consp (car-safe element)))
-	 (if (symbolp (car-safe (car element)))
-	     (while (skeleton-internal-list element nil t))
-	   (setq literal (car element))
-	   (while literal
-	     (skeleton-internal-list element (car literal))
-	     (setq literal (cdr literal)))))
-	((null element))
-	((skeleton-internal-1 (eval element) t))))
-
-
-;; Maybe belongs into simple.el or elsewhere
-;; ;###autoload
-;;; (define-skeleton local-variables-section
-;;  "Insert a local variables section.  Use current comment syntax if any."
-;;  (completing-read "Mode: " obarray
-;;		   (lambda (symbol)
-;;		     (if (commandp symbol)
-;;			 (string-match "-mode$" (symbol-name symbol))))
-;;		   t)
-;;  '(save-excursion
-;;     (if (re-search-forward page-delimiter nil t)
-;;	 (error "Not on last page.")))
-;;  comment-start "Local Variables:" comment-end \n
-;;  comment-start "mode: " str
-;;  & -5 | '(kill-line 0) & -1 | comment-end \n
-;;  ( (completing-read (format "Variable, %s: " skeleton-subprompt)
-;;		     obarray
-;;		     (lambda (symbol)
-;;		       (or (eq symbol 'eval)
-;;			   (user-variable-p symbol)))
-;;		     t)
-;;    comment-start str ": "
-;;    (read-from-minibuffer "Expression: " nil read-expression-map nil
-;;			  'read-expression-history) | _
-;;    comment-end \n)
-;;  resume:
-;;  comment-start "End:" comment-end \n)
-
-;; Variables and command for automatically inserting pairs like () or "".
-
-(defvar skeleton-pair nil
-  "*If this is nil pairing is turned off, no matter what else is set.
-Otherwise modes with `skeleton-pair-insert-maybe' on some keys
-will attempt to insert pairs of matching characters.")
-
-
-(defvar skeleton-pair-on-word nil
-  "*If this is nil, paired insertion is inhibited before or inside a word.")
-
-
-(defvar skeleton-pair-filter (lambda ())
-  "Attempt paired insertion if this function returns nil, before inserting.
-This allows for context-sensitive checking whether pairing is appropriate.")
-
-
-(defvar skeleton-pair-alist ()
-  "An override alist of pairing partners matched against `last-command-char'.
-Each alist element, which looks like (ELEMENT ...), is passed to
-`skeleton-insert' with no interactor.  Variable `str' does nothing.
-
-Elements might be (?` ?` _ \"''\"), (?\\( ?  _ \" )\") or (?{ \\n > _ \\n ?} >).")
-
-
-;;;###autoload
-(defun skeleton-pair-insert-maybe (arg)
-  "Insert the character you type ARG times.
-
-With no ARG, if `skeleton-pair' is non-nil, pairing can occur.  If the region
-is visible the pair is wrapped around it depending on `skeleton-autowrap'.
-Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a
-word, and if `skeleton-pair-filter' returns nil, pairing is performed.
-
-If a match is found in `skeleton-pair-alist', that is inserted, else
-the defaults are used.  These are (), [], {}, <> and `' for the
-symmetrical ones, and the same character twice for the others."
-  (interactive "*P")
-  (let ((mark (and skeleton-autowrap
-		   (or (eq last-command 'mouse-drag-region)
-		       (and transient-mark-mode mark-active))))
-	(skeleton-end-hook))
-    (if (or arg
-	    (not skeleton-pair)
-	    (and (not mark)
-		 (or overwrite-mode
-		     (if (not skeleton-pair-on-word) (looking-at "\\w"))
-		     (funcall skeleton-pair-filter))))
-	(self-insert-command (prefix-numeric-value arg))
-      (setq last-command-char (logand last-command-char 255))
-      (or skeleton-abbrev-cleanup
-	  (skeleton-insert
-	   (cons nil (or (assq last-command-char skeleton-pair-alist)
-			 (assq last-command-char '((?( _ ?))
-						   (?[ _ ?])
-						   (?{ _ ?})
-						   (?< _ ?>)
-						   (?` _ ?')))
-			 `(,last-command-char _ ,last-command-char)))
-	   (if mark -1))))))
-
-
-;; A more serious example can be found in sh-script.el
-;;; (defun mirror-mode ()
-;;  "This major mode is an amusing little example of paired insertion.
-;;All printable characters do a paired self insert, while the other commands
-;;work normally."
-;;  (interactive)
-;;  (kill-all-local-variables)
-;;  (make-local-variable 'skeleton-pair)
-;;  (make-local-variable 'skeleton-pair-on-word)
-;;  (make-local-variable 'skeleton-pair-filter)
-;;  (make-local-variable 'skeleton-pair-alist)
-;;  (setq major-mode 'mirror-mode
-;;	mode-name "Mirror"
-;;	skeleton-pair-on-word t
-;;	;; in the middle column insert one or none if odd window-width
-;;	skeleton-pair-filter (lambda ()
-;;			       (if (>= (current-column)
-;;				       (/ (window-width) 2))
-;;				   ;; insert both on next line
-;;				   (next-line 1)
-;;				 ;; insert one or both?
-;;				 (= (* 2 (1+ (current-column)))
-;;				    (window-width))))
-;;	;; mirror these the other way round as well
-;;	skeleton-pair-alist '((?) _ ?()
-;;			      (?] _ ?[)
-;;			      (?} _ ?{)
-;;			      (?> _ ?<)
-;;			      (?/ _ ?\\)
-;;			      (?\\ _ ?/)
-;;			      (?` ?` _ "''")
-;;			      (?' ?' _ "``"))
-;;	;; in this mode we exceptionally ignore the user, else it's no fun
-;;	skeleton-pair t)
-;;  (let ((map (make-vector 256 'skeleton-pair-insert-maybe))
-;;	(i 0))
-;;    (use-local-map `(keymap ,map))
-;;    (while (< i ? )
-;;      (aset map i nil)
-;;      (aset map (+ i 128) nil)
-;;      (setq i (1+ i))))
-;;  (run-hooks 'mirror-mode-hook))
-
-(provide 'skeleton)
-
-;; skeleton.el ends here
diff --git a/lisp/sort.el b/lisp/sort.el
deleted file mode 100644
index fcd8906b1f0..00000000000
--- a/lisp/sort.el
+++ /dev/null
@@ -1,523 +0,0 @@
-;;; sort.el --- commands to sort text in an Emacs buffer.
-
-;; Copyright (C) 1986, 1987, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Howie Kaye
-;; Maintainer: FSF
-;; Keywords: unix
-
-;; 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 provides the sorting facilities documented in the Emacs
-;; user's manual.
-
-;;; Code:
-
-(defvar sort-fold-case nil
-  "*Non-nil if the buffer sort functions should ignore case.")
-
-;;;###autoload
-(defun sort-subr (reverse nextrecfun endrecfun &optional startkeyfun endkeyfun)
-  "General text sorting routine to divide buffer into records and sort them.
-Arguments are REVERSE NEXTRECFUN ENDRECFUN &optional STARTKEYFUN ENDKEYFUN.
-
-We divide the accessible portion of the buffer into disjoint pieces
-called sort records.  A portion of each sort record (perhaps all of
-it) is designated as the sort key.  The records are rearranged in the
-buffer in order by their sort keys.  The records may or may not be
-contiguous.
-
-Usually the records are rearranged in order of ascending sort key.
-If REVERSE is non-nil, they are rearranged in order of descending sort key.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-The next four arguments are functions to be called to move point
-across a sort record.  They will be called many times from within sort-subr.
-
-NEXTRECFUN is called with point at the end of the previous record.
-It moves point to the start of the next record.
-It should move point to the end of the buffer if there are no more records.
-The first record is assumed to start at the position of point when sort-subr
-is called.
-
-ENDRECFUN is called with point within the record.
-It should move point to the end of the record.
-
-STARTKEYFUN moves from the start of the record to the start of the key.
-It may return either a non-nil value to be used as the key, or
-else the key is the substring between the values of point after
-STARTKEYFUN and ENDKEYFUN are called.  If STARTKEYFUN is nil, the key
-starts at the beginning of the record.
-
-ENDKEYFUN moves from the start of the sort key to the end of the sort key.
-ENDKEYFUN may be nil if STARTKEYFUN returns a value or if it would be the
-same as ENDRECFUN."
-  ;; Heuristically try to avoid messages if sorting a small amt of text.
-  (let ((messages (> (- (point-max) (point-min)) 50000)))
-    (save-excursion
-      (if messages (message "Finding sort keys..."))
-      (let* ((sort-lists (sort-build-lists nextrecfun endrecfun
-					   startkeyfun endkeyfun))
-	     (old (reverse sort-lists))
-	     (case-fold-search sort-fold-case))
-	(if (null sort-lists)
-	    ()
-	  (or reverse (setq sort-lists (nreverse sort-lists)))
-	  (if messages (message "Sorting records..."))
-	  (setq sort-lists
-		(if (fboundp 'sortcar)
-		    (sortcar sort-lists
-			     (cond ((numberp (car (car sort-lists)))
-				    ;; This handles both ints and floats.
-				    '<)
-				   ((consp (car (car sort-lists)))
-				    (function
-				     (lambda (a b)
-				       (> 0 (compare-buffer-substrings 
-					     nil (car a) (cdr a)
-					     nil (car b) (cdr b))))))
-				   (t
-				    'string<)))
-		  (sort sort-lists
-			(cond ((numberp (car (car sort-lists)))
-			       'car-less-than-car)
-			      ((consp (car (car sort-lists)))
-			       (function
-				(lambda (a b)
-				  (> 0 (compare-buffer-substrings 
-					nil (car (car a)) (cdr (car a))
-					nil (car (car b)) (cdr (car b)))))))
-			      (t
-			       (function
-				(lambda (a b)
-				  (string< (car a) (car b)))))))))
-	  (if reverse (setq sort-lists (nreverse sort-lists)))
-	  (if messages (message "Reordering buffer..."))
-	  (sort-reorder-buffer sort-lists old)))
-      (if messages (message "Reordering buffer... Done"))))
-  nil)
-
-;; Parse buffer into records using the arguments as Lisp expressions;
-;; return a list of records.  Each record looks like (KEY STARTPOS . ENDPOS)
-;; where KEY is the sort key (a number or string),
-;; and STARTPOS and ENDPOS are the bounds of this record in the buffer.
-
-;; The records appear in the list lastmost first!
-
-(defun sort-build-lists (nextrecfun endrecfun startkeyfun endkeyfun)
-  (let ((sort-lists ())
-	(start-rec nil)
-	done key)
-    ;; Loop over sort records.
-    ;(goto-char (point-min)) -- it is the caller's responsibility to
-    ;arrange this if necessary
-    (while (not (eobp))
-      (setq start-rec (point))		;save record start
-      (setq done nil)
-      ;; Get key value, or move to start of key.
-      (setq key (catch 'key
-		  (or (and startkeyfun (funcall startkeyfun))
-		      ;; If key was not returned as value,
-		      ;; move to end of key and get key from the buffer.
-		      (let ((start (point)))
-			(funcall (or endkeyfun
-				     (prog1 endrecfun (setq done t))))
-			(cons start (point))))))
-      ;; Move to end of this record (start of next one, or end of buffer).
-      (cond ((prog1 done (setq done nil)))
-	    (endrecfun (funcall endrecfun))
-	    (nextrecfun (funcall nextrecfun) (setq done t)))
-      (if key (setq sort-lists (cons
-				 ;; consing optimization in case in which key
-				 ;; is same as record.
-				 (if (and (consp key)
-					  (equal (car key) start-rec)
-					  (equal (cdr key) (point)))
-				     (cons key key)
-				   (cons key (cons start-rec (point))))
-				 sort-lists)))
-      (and (not done) nextrecfun (funcall nextrecfun)))
-    sort-lists))
-
-(defun sort-reorder-buffer (sort-lists old)
-  (let ((inhibit-quit t)
-	(last (point-min))
-	(min (point-min)) (max (point-max)))
-    ;; Make sure insertions done for reordering
-    ;; do not go after any markers at the end of the sorted region,
-    ;; by inserting a space to separate them.
-    (goto-char (point-max))
-    (insert-before-markers " ")
-    (narrow-to-region min (1- (point-max)))
-    (while sort-lists
-      (goto-char (point-max))
-      (insert-buffer-substring (current-buffer)
-			       last
-			       (nth 1 (car old)))
-      (goto-char (point-max))
-      (insert-buffer-substring (current-buffer)
-			       (nth 1 (car sort-lists))
-			       (cdr (cdr (car sort-lists))))
-      (setq last (cdr (cdr (car old)))
-	    sort-lists (cdr sort-lists)
-	    old (cdr old)))
-    (goto-char (point-max))
-    (insert-buffer-substring (current-buffer)
-			     last
-			     max)
-    ;; Delete the original copy of the text.
-    (delete-region min max)
-    ;; Get rid of the separator " ".
-    (goto-char (point-max))
-    (narrow-to-region min (1+ (point)))
-    (delete-region (point) (1+ (point)))))
-
-;;;###autoload
-(defun sort-lines (reverse beg end) 
-  "Sort lines in region alphabetically; argument means descending order.
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort).
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order."
-  (interactive "P\nr")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      (sort-subr reverse 'forward-line 'end-of-line))))
-
-;;;###autoload
-(defun sort-paragraphs (reverse beg end)
-  "Sort paragraphs in region alphabetically; argument means descending order.
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort).
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order."
-  (interactive "P\nr")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      (sort-subr reverse
-		 (function
-		  (lambda ()
-		    (while (and (not (eobp)) (looking-at paragraph-separate))
-		      (forward-line 1))))
-		 'forward-paragraph))))
-
-;;;###autoload
-(defun sort-pages (reverse beg end)
-  "Sort pages in region alphabetically; argument means descending order.
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort).
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order."
-  (interactive "P\nr")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      (sort-subr reverse
-		 (function (lambda () (skip-chars-forward "\n")))
-		 'forward-page))))
-
-(defvar sort-fields-syntax-table nil)
-(if sort-fields-syntax-table nil
-  (let ((table (make-syntax-table))
-	(i 0))
-    (while (< i 256)
-      (modify-syntax-entry i "w" table)
-      (setq i (1+ i)))
-    (modify-syntax-entry ?\  " " table)
-    (modify-syntax-entry ?\t " " table)
-    (modify-syntax-entry ?\n " " table)
-    (modify-syntax-entry ?\. "_" table)	; for floating pt. numbers. -wsr
-    (setq sort-fields-syntax-table table)))
-
-;;;###autoload
-(defun sort-numeric-fields (field beg end)
-  "Sort lines in region numerically by the ARGth field of each line.
-Fields are separated by whitespace and numbered from 1 up.
-Specified field must contain a number in each line of the region.
-With a negative arg, sorts by the ARGth field counted from the right.
-Called from a program, there are three arguments:
-FIELD, BEG and END.  BEG and END specify region to sort."
-  (interactive "p\nr")
-  (sort-fields-1 field beg end
-		 (function (lambda ()
-			     (sort-skip-fields field)
-			     (string-to-number
-			      (buffer-substring
-			        (point)
-				(save-excursion
-				  ;; This is just wrong! Even without floats...
-				  ;; (skip-chars-forward "[0-9]")
-				  (forward-sexp 1)
-				  (point))))))
-		 nil))
-
-;;;;;###autoload
-;;(defun sort-float-fields (field beg end)
-;;  "Sort lines in region numerically by the ARGth field of each line.
-;;Fields are separated by whitespace and numbered from 1 up.  Specified field
-;;must contain a floating point number in each line of the region.  With a
-;;negative arg, sorts by the ARGth field counted from the right.  Called from a
-;;program, there are three arguments: FIELD, BEG and END.  BEG and END specify
-;;region to sort."
-;;  (interactive "p\nr")
-;;  (sort-fields-1 field beg end
-;;		 (function (lambda ()
-;;			     (sort-skip-fields field)
-;;			     (string-to-number
-;;			      (buffer-substring
-;;			       (point)
-;;			       (save-excursion
-;;				 (re-search-forward
-;;				  "[+-]?[0-9]*\.?[0-9]*\\([eE][+-]?[0-9]+\\)?")
-;;				 (point))))))
-;;		 nil))
-
-;;;###autoload
-(defun sort-fields (field beg end)
-  "Sort lines in region lexicographically by the ARGth field of each line.
-Fields are separated by whitespace and numbered from 1 up.
-With a negative arg, sorts by the ARGth field counted from the right.
-Called from a program, there are three arguments:
-FIELD, BEG and END.  BEG and END specify region to sort.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order."
-  (interactive "p\nr")
-  (sort-fields-1 field beg end
-		 (function (lambda ()
-			     (sort-skip-fields field)
-			     nil))
-		 (function (lambda () (skip-chars-forward "^ \t\n")))))
-
-(defun sort-fields-1 (field beg end startkeyfun endkeyfun)
-  (let ((tbl (syntax-table)))
-    (if (zerop field) (setq field 1))
-    (unwind-protect
-	(save-excursion
-	  (save-restriction
-	    (narrow-to-region beg end)
-	    (goto-char (point-min))
-	    (set-syntax-table sort-fields-syntax-table)
-	    (sort-subr nil
-		       'forward-line 'end-of-line
-		       startkeyfun endkeyfun)))
-      (set-syntax-table tbl))))
-
-;; Position at the beginning of field N on the current line,
-;; assuming point is initially at the beginning of the line.
-(defun sort-skip-fields (n)
-  (if (> n 0)
-      ;; Skip across N - 1 fields.
-      (let ((i (1- n)))
-	(while (> i 0)
-	  (skip-chars-forward " \t")
-	  (skip-chars-forward "^ \t\n")
-	  (setq i (1- i)))
-	(skip-chars-forward " \t")
-	(if (eolp)
-	    (error "Line has too few fields: %s"
-		   (buffer-substring
-		    (save-excursion (beginning-of-line) (point))
-		    (save-excursion (end-of-line) (point))))))
-    (end-of-line)
-    ;; Skip back across - N - 1 fields.
-    (let ((i (1- (- n))))
-      (while (> i 0)
-	(skip-chars-backward " \t")
-	(skip-chars-backward "^ \t\n")
-	(setq i (1- i)))
-      (skip-chars-backward " \t"))
-    (if (bolp)
-	(error "Line has too few fields: %s"
-	       (buffer-substring
-		(save-excursion (beginning-of-line) (point))
-		(save-excursion (end-of-line) (point)))))
-    ;; Position at the front of the field
-    ;; even if moving backwards.
-    (skip-chars-backward "^ \t\n")))
-
-(defvar sort-regexp-fields-regexp)
-(defvar sort-regexp-record-end)
-
-;; Move to the beginning of the next match for record-regexp,
-;; and set sort-regexp-record-end to the end of that match.
-;; If the next match is empty and does not advance point,
-;; skip one character and try again.
-(defun sort-regexp-fields-next-record ()
-  (let ((oldpos (point)))
-    (and (re-search-forward sort-regexp-fields-regexp nil 'move)
-	 (setq sort-regexp-record-end (match-end 0))
-	 (if (= sort-regexp-record-end oldpos)
-	     (progn
-	       (forward-char 1)
-	       (re-search-forward sort-regexp-fields-regexp nil 'move)
-	       (setq sort-regexp-record-end (match-end 0)))
-	   t)
-	 (goto-char (match-beginning 0)))))
-
-;;;###autoload
-(defun sort-regexp-fields (reverse record-regexp key-regexp beg end)
-  "Sort the region lexicographically as specified by RECORD-REGEXP and KEY.
-RECORD-REGEXP specifies the textual units which should be sorted.
-  For example, to sort lines RECORD-REGEXP would be \"^.*$\"
-KEY specifies the part of each record (ie each match for RECORD-REGEXP)
-  is to be used for sorting.
-  If it is \"\\\\digit\" then the digit'th \"\\\\(...\\\\)\" match field from
-  RECORD-REGEXP is used.
-  If it is \"\\\\&\" then the whole record is used.
-  Otherwise, it is a regular-expression for which to search within the record.
-If a match for KEY is not found within a record then that record is ignored.
-
-With a negative prefix arg sorts in reverse order.
-
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-For example: to sort lines in the region by the first word on each line
- starting with the letter \"f\",
- RECORD-REGEXP would be \"^.*$\" and KEY would be \"\\\\=\\<f\\\\w*\\\\>\""
-  ;; using negative prefix arg to mean "reverse" is now inconsistent with
-  ;; other sort-.*fields functions but then again this was before, since it
-  ;; didn't use the magnitude of the arg to specify anything.
-  (interactive "P\nsRegexp specifying records to sort: 
-sRegexp specifying key within record: \nr")
-  (cond ((or (equal key-regexp "") (equal key-regexp "\\&"))
-	 (setq key-regexp 0))
-	((string-match "\\`\\\\[1-9]\\'" key-regexp)
-	 (setq key-regexp (- (aref key-regexp 1) ?0))))
-  (save-excursion
-    (save-restriction
-      (narrow-to-region beg end)
-      (goto-char (point-min))
-      (let (sort-regexp-record-end
-	    (sort-regexp-fields-regexp record-regexp))
-	(re-search-forward sort-regexp-fields-regexp)
-	(setq sort-regexp-record-end (point))
-	(goto-char (match-beginning 0))
-	(sort-subr reverse
-		   'sort-regexp-fields-next-record
-		   (function (lambda ()
-			       (goto-char sort-regexp-record-end)))
-		   (function (lambda ()
-			       (let ((n 0))
-				 (cond ((numberp key-regexp)
-					(setq n key-regexp))
-				       ((re-search-forward
-					  key-regexp sort-regexp-record-end t)
-					(setq n 0))
-				       (t (throw 'key nil)))
-				 (condition-case ()
-				     (cons (match-beginning n)
-					   (match-end n))
-				   ;; if there was no such register
-				   (error (throw 'key nil)))))))))))
-
-
-(defvar sort-columns-subprocess t)
-
-;;;###autoload
-(defun sort-columns (reverse &optional beg end)
-  "Sort lines in region alphabetically by a certain range of columns.
-For the purpose of this command, the region includes
-the entire line that point is in and the entire line the mark is in.
-The column positions of point and mark bound the range of columns to sort on.
-A prefix argument means sort into reverse order.
-The variable `sort-fold-case' determines whether alphabetic case affects
-the sort order.
-
-Note that `sort-columns' rejects text that contains tabs,
-because tabs could be split across the specified columns
-and it doesn't know how to handle that.  Also, when possible,
-it uses the `sort' utility program, which doesn't understand tabs.
-Use \\[untabify] to convert tabs to spaces before sorting."
-  (interactive "P\nr")
-  (save-excursion
-    (let (beg1 end1 col-beg1 col-end1 col-start col-end)
-      (goto-char (min beg end))
-      (setq col-beg1 (current-column))
-      (beginning-of-line)
-      (setq beg1 (point))
-      (goto-char (max beg end))
-      (setq col-end1 (current-column))
-      (forward-line)
-      (setq end1 (point))
-      (setq col-start (min col-beg1 col-end1))
-      (setq col-end (max col-beg1 col-end1))
-      (if (search-backward "\t" beg1 t)
-	  (error "sort-columns does not work with tabs.  Use M-x untabify."))
-      (if (not (or (eq system-type 'vax-vms)
-		   (text-properties-at beg1)
-		   (< (next-property-change beg1 nil end1) end1)))
-	  ;; Use the sort utility if we can; it is 4 times as fast.
-	  ;; Do not use it if there are any properties in the region,
-	  ;; since the sort utility would lose the properties.
-	  (call-process-region beg1 end1 "sort" t t nil
-			       (if reverse "-rt\n" "-t\n")
-			       (concat "+0." col-start)
-			       (concat "-0." col-end))
-	;; On VMS, use Emacs's own facilities.
-	(save-excursion
-	  (save-restriction
-	    (narrow-to-region beg1 end1)
-	    (goto-char beg1)
-	    (sort-subr reverse 'forward-line 'end-of-line
-		       (function (lambda () (move-to-column col-start) nil))
-		       (function (lambda () (move-to-column col-end) nil)))))))))
-
-;;;###autoload
-(defun reverse-region (beg end)
-  "Reverse the order of lines in a region.
-From a program takes two point or marker arguments, BEG and END."
-  (interactive "r")
-  (if (> beg end)
-      (let (mid) (setq mid end end beg beg mid)))
-  (save-excursion
-    ;; put beg at the start of a line and end and the end of one --
-    ;; the largest possible region which fits this criteria
-    (goto-char beg)
-    (or (bolp) (forward-line 1))
-    (setq beg (point))
-    (goto-char end)
-    ;; the test for bolp is for those times when end is on an empty line;
-    ;; it is probably not the case that the line should be included in the
-    ;; reversal; it isn't difficult to add it afterward.
-    (or (and (eolp) (not (bolp))) (progn (forward-line -1) (end-of-line)))
-    (setq end (point-marker))
-    ;; the real work.  this thing cranks through memory on large regions.
-    (let (ll (do t))
-      (while do
-	(goto-char beg)
-	(setq ll (cons (buffer-substring (point) (progn (end-of-line) (point)))
-		       ll))
-	(setq do (/= (point) end))
-	(delete-region beg (if do (1+ (point)) (point))))
-      (while (cdr ll)
-	(insert (car ll) "\n")
-	(setq ll (cdr ll)))
-      (insert (car ll)))))
-
-(provide 'sort)
-
-;;; sort.el ends here
diff --git a/lisp/soundex.el b/lisp/soundex.el
deleted file mode 100644
index 5f703228df2..00000000000
--- a/lisp/soundex.el
+++ /dev/null
@@ -1,74 +0,0 @@
-;;; soundex.el --- implement Soundex algorithm
-
-;; Copyright (C) 1993 Free Software Foundation, Inc.
-
-;; Author: Christian Plaunt <chris@bliss.berkeley.edu>
-;; Maintainer: FSF 
-;; Keywords: matching
-;; Created: Sat May 15 14:48:18 1993
-
-;; 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:
-
-;; The Soundex algorithm maps English words into representations of
-;; how they sound.  Words with vaguely similar sound map to the same string.
-
-;;; Code: 
-
-(defvar soundex-alist
-  '((?B . "1") (?F . "1") (?P . "1") (?V . "1")
-    (?C . "2") (?G . "2") (?J . "2") (?K . "2") (?Q . "2") (?S . "2")
-    (?X . "2") (?Z . "2") (?D . "3") (?T . "3") (?L . "4") (?M . "5")
-    (?N . "5") (?R . "6"))
-  "Alist of chars-to-key-code for building Soundex keys.")
-
-(defun soundex (word)
-  "Return a Soundex key for WORD.
-Implemented as described in:
-Knuth, Donald E. \"The Art of Computer Programming, Vol. 3: Sorting
-and Searching\", Addison-Wesley (1973), pp. 391-392."
-  (let* ((word (upcase word)) (length (length word))
-	 (code (cdr (assq (aref word 0) soundex-alist)))
-	 (key (substring word 0 1)) (index 1) (prev-code code))
-    ;; once we have a four char key, we're done
-    (while (and (> 4 (length key)) (< index length))
-      ;; look up the code for each letter in word at index
-      (setq code (cdr (assq (aref word index) soundex-alist))
-	    index (1+ index)
-	    ;; append code to key unless the same codes belong to
-	    ;; adjacent letters in the original string
-	    key (concat key (if (or (null code) (string= code prev-code))
-				()
-			      code))
-	    prev-code code))
-    ;; return a key that is 4 chars long and padded by "0"s if needed
-    (if (> 4 (length key))
-	(substring (concat key "000") 0 4)
-      key)))
-
-;(defvar soundex-test
-;  '("Euler" "Gauss" "Hilbert" "Knuth" "Lloyd" "Lukasiewicz"
-;    "Ellery" "Ghosh" "Heilbronn" "Kant" "Ladd" "Lissajous")
-;  "\n  Knuth's names to demonstrate the Soundex algorithm.")
-;
-;(mapcar 'soundex soundex-test)
-;("E460" "G200" "H416" "K530" "L300" "L222"
-; "E460" "G200" "H416" "K530" "L300" "L222")
-
-;; soundex.el ends here
diff --git a/lisp/startup.el b/lisp/startup.el
deleted file mode 100644
index 68f857cde74..00000000000
--- a/lisp/startup.el
+++ /dev/null
@@ -1,968 +0,0 @@
-;;; startup.el --- process Emacs shell arguments
-
-;; Copyright (C) 1985, 86, 92, 94, 95, 1996 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 parses the command line and gets Emacs running.  Options on
-;; the command line are handled in precedence order.  The order is the
-;; one in the list below; first described means first handled.  Options
-;; within each category (delimited by a bar) are handled in the order
-;; encountered on the command line.
-
-;; -------------------------
-;; -version                  Print Emacs version to stderr, then exit
-;; --version                 successfully right away.
-;;                           This option is handled by emacs.c
-;; -------------------------
-;; -help                     Print a short usage description and exit
-;; --help                    successfully right away.
-;;                           This option is handled by emacs.c
-;; -------------------------
-;; -nl                       Do not use shared memory (for systems that
-;; -no-shared-memory         support this) for the dumped Emacs data.
-;;                           This option is handled by emacs.c
-;;
-;; -map                      For VMS.
-;; --map-data                This option is handled by emacs.c
-;; -------------------------
-;; -t FILE                   Use FILE as the name of the terminal.
-;; --terminal FILE           Using this implies "-nw" also.
-;;                           This option is handled by emacs.c
-;; -------------------------
-;; -d DISPNAME               Use DISPNAME as the name of the X-windows
-;; -display DISPNAME         display for the initial frame.
-;; --display DISPNAME        This option is handled by emacs.c
-;; -------------------------
-;; -nw                       Do not use a windows system (but use the
-;; --no-windows              terminal instead.)
-;;                           This option is handled by emacs.c
-;; -------------------------
-;; -batch                    Execute noninteractively (messages go to stdout,
-;; --batch                   variable noninteractive set to t)
-;;                           This option is handled by emacs.c
-;; -------------------------
-;; -q                        Do not load user's init file and do not load
-;; -no-init-file             "default.el".  Regardless of this switch,
-;; --no-init-file            "site-start" is still loaded.
-;; -------------------------
-;; -no-site-file             Do not load "site-start.el".  (This is the ONLY
-;; --no-site-file            way to prevent loading that file.)
-;; -------------------------
-;; -u USER                   Load USER's init file instead of the init
-;; -user USER                file belonging to the user starting Emacs.
-;; --user USER
-;; -------------------------
-;; -debug-init               Don't catch errors in init files; let the
-;; --debug-init              debugger run.
-;; -------------------------
-;; -i ICONTYPE               Set type of icon using when Emacs is
-;; -itype ICONTYPE           iconified under X-windows.
-;; --icon-type ICONTYPE      This option is passed on to term/x-win.el
-;;
-;; -iconic                   Start Emacs iconified under X-windows.
-;; --iconic                  This option is passed on to term/x-win.el
-;; -------------------------
-;; Various X-windows options for colors/fonts/geometry/title etc.
-;; These options are passed on to term/x-win.el which see.  Certain
-;; of these are also found in term/pc-win.el
-;; -------------------------
-;; FILE                      Visit FILE.
-;;
-;; -L DIRNAME                Add DIRNAME to load-path
-;; -directory DIRNAME
-;; --directory DIRNAME
-;;
-;; -l FILE                   Load and execute the Emacs lisp code
-;; -load FILE                in FILE.
-;; --load FILE
-;;
-;; -f FUNC                   Execute Emacs lisp function FUNC with
-;; -funcall FUNC             no arguments.  The "-e" form is outdated
-;; --funcall FUNC            and should not be used.  (It's a typo
-;; -e FUNC                   promoted to a feature.)
-;;
-;; -eval FORM                Execute Emacs lisp form FORM.
-;; --eval FORM
-;;
-;; -insert FILE              Insert the contents of FILE into buffer.
-;; --insert FILE
-;; -------------------------
-;; -kill                     Kill (exit) Emacs right away.
-;; --kill
-;; -------------------------
-
-;;; Code:
-
-(setq top-level '(normal-top-level))
-
-(defvar command-line-processed nil "t once command line has been processed")
-
-(defvar inhibit-startup-message nil
-  "*Non-nil inhibits the initial startup message.
-This is for use in your personal init file, once you are familiar
-with the contents of the startup message.")
-
-(defvar inhibit-startup-echo-area-message nil
-  "*Non-nil inhibits the initial startup echo area message.
-Inhibition takes effect only if your `.emacs' file contains
-a line of this form:
- (setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\")
-If your `.emacs' file is byte-compiled, use the following form instead:
- (eval '(setq inhibit-startup-echo-area-message \"YOUR-USER-NAME\"))
-Thus, someone else using a copy of your `.emacs' file will see
-the startup message unless he personally acts to inhibit it.")
-
-(defvar inhibit-default-init nil
-  "*Non-nil inhibits loading the `default' library.")
-
-(defvar command-switch-alist nil
-  "Alist of command-line switches.
-Elements look like (SWITCH-STRING . HANDLER-FUNCTION).
-HANDLER-FUNCTION receives switch name as sole arg;
-remaining command-line args are in the variable `command-line-args-left'.")
-
-(defvar command-line-args-left nil
-  "List of command-line args not yet processed.")
-
-(defvar command-line-functions nil    ;; lrs 7/31/89
-  "List of functions to process unrecognized command-line arguments.
-Each function should access the dynamically bound variables
-`argi' (the current argument) and `command-line-args-left' (the remaining
-arguments).  The function should return non-nil only if it recognizes and
-processes `argi'.  If it does so, it may consume successive arguments by
-altering `command-line-args-left' to remove them.")
-
-(defvar command-line-default-directory nil
-  "Default directory to use for command line arguments.
-This is normally copied from `default-directory' when Emacs starts.")
-
-;;; This is here, rather than in x-win.el, so that we can ignore these
-;;; options when we are not using X.
-(defvar command-line-x-option-alist
-  '(("-bw" 1 x-handle-numeric-switch border-width)
-    ("-d" 1 x-handle-display)
-    ("-display" 1 x-handle-display)
-    ("-name" 1 x-handle-name-switch)
-    ("-title" 1 x-handle-switch title)
-    ("-T" 1 x-handle-switch title)
-    ("-r" 0 x-handle-switch reverse t)
-    ("-rv" 0 x-handle-switch reverse t)
-    ("-reverse" 0 x-handle-switch reverse t)
-    ("-reverse-video" 0 x-handle-switch reverse t)
-    ("-fn" 1 x-handle-switch font)
-    ("-font" 1 x-handle-switch font)
-    ("-ib" 1 x-handle-numeric-switch internal-border-width)
-    ("-g" 1 x-handle-geometry)
-    ("-geometry" 1 x-handle-geometry)
-    ("-fg" 1 x-handle-switch foreground-color)
-    ("-foreground" 1 x-handle-switch foreground-color)
-    ("-bg" 1 x-handle-switch background-color)
-    ("-background" 1 x-handle-switch background-color)
-    ("-ms" 1 x-handle-switch mouse-color)
-    ("-itype" 0 x-handle-switch icon-type t)
-    ("-i" 0 x-handle-switch icon-type t)
-    ("-iconic" 0 x-handle-iconic)
-    ("-xrm" 1 x-handle-xrm-switch)
-    ("-cr" 1 x-handle-switch cursor-color)
-    ("-vb" 0 x-handle-switch vertical-scroll-bars t)
-    ("-hb" 0 x-handle-switch horizontal-scroll-bars t)
-    ("-bd" 1 x-handle-switch)
-    ("--border-width" 1 x-handle-numeric-switch border-width)
-    ("--display" 1 x-handle-display)
-    ("--name" 1 x-handle-name-switch)
-    ("--title" 1 x-handle-switch title)
-    ("--reverse-video" 0 x-handle-switch reverse t)
-    ("--font" 1 x-handle-switch font)
-    ("--internal-border" 1 x-handle-numeric-switch internal-border-width)
-    ("--geometry" 1 x-handle-geometry)
-    ("--foreground-color" 1 x-handle-switch foreground-color)
-    ("--background-color" 1 x-handle-switch background-color)
-    ("--mouse-color" 1 x-handle-switch mouse-color)
-    ("--icon-type" 0 x-handle-switch icon-type t)
-    ("--iconic" 0 x-handle-iconic)
-    ("--xrm" 1 x-handle-xrm-switch)
-    ("--cursor-color" 1 x-handle-switch cursor-color)
-    ("--vertical-scroll-bars" 0 x-handle-switch vertical-scroll-bars t)
-    ("--border-color" 1 x-handle-switch border-width))
-  "Alist of X Windows options.
-Each element has the form
-  (NAME NUMARGS HANDLER FRAME-PARAM VALUE)
-where NAME is the option name string, NUMARGS is the number of arguments
-that the option accepts, HANDLER is a function to call to handle the option.
-FRAME-PARAM (optional) is the frame parameter this option specifies,
-and VALUE is the value which is given to that frame parameter
-\(most options use the argument for this, so VALUE is not present).")
-
-(defvar before-init-hook nil
-  "Normal hook run after handling urgent options but before loading init files.")
-
-(defvar after-init-hook nil
-  "Normal hook run after loading the init files, `~/.emacs' and `default.el'.
-There is no `condition-case' around the running of these functions;
-therefore, if you set `debug-on-error' non-nil in `.emacs',
-an error in one of these functions will invoke the debugger.")
-
-(defvar emacs-startup-hook nil
-  "Normal hook run after loading init files and handling the command line.")
-
-(defvar term-setup-hook nil
-  "Normal hook run after loading terminal-specific Lisp code.
-It also follows `emacs-startup-hook'.  This hook exists for users to set,
-so as to override the definitions made by the terminal-specific file.
-Emacs never sets this variable itself.")
-
-(defvar keyboard-type nil
-  "The brand of keyboard you are using.
-This variable is used to define
-the proper function and keypad keys for use under X.  It is used in a
-fashion analogous to the environment value TERM.")
-
-(defvar window-setup-hook nil
-  "Normal hook run to initialize window system display.
-Emacs runs this hook after processing the command line arguments and loading
-the user's init file.")
-
-(defvar initial-major-mode 'lisp-interaction-mode
-  "Major mode command symbol to use for the initial *scratch* buffer.")
-
-(defvar init-file-user nil
-  "Identity of user whose `.emacs' file is or was read.
-The value is nil if `-q' or `--no-init-file' was specified,
-meaning do not load any init file.
-
-Otherwise, the value may be the null string, meaning use the init file
-for the user that originally logged in, or it may be a
-string containing a user's name meaning use that person's init file.
-
-In either of the latter cases, `(concat \"~\" init-file-user \"/\")'
-evaluates to the name of the directory where the `.emacs' file was
-looked for.
-
-Setting `init-file-user' does not prevent Emacs from loading
-`site-start.el'.  The only way to do that is to use `--no-site-file'.")
-
-(defvar site-run-file "site-start"
-  "File containing site-wide run-time initializations.
-This file is loaded at run-time before `~/.emacs'.  It contains inits
-that need to be in place for the entire site, but which, due to their
-higher incidence of change, don't make sense to load into emacs'
-dumped image.  Thus, the run-time load order is: 1. file described in
-this variable, if non-nil; 2. `~/.emacs'; 3. `default.el'.
-
-Don't use the `site-start.el' file for things some users may not like.
-Put them in `default.el' instead, so that users can more easily
-override them.  Users can prevent loading `default.el' with the `-q'
-option or by setting `inhibit-default-init' in their own init files,
-but inhibiting `site-start.el' requires `--no-site-file', which
-is less convenient.")
-
-(defconst iso-8859-1-locale-regexp "8859[-_]?1"
-  "Regexp that specifies when to enable the ISO 8859-1 character set.
-We do that if this regexp matches the locale name
-specified by the LC_ALL, LC_CTYPE and LANG environment variables.")
-
-(defvar mail-host-address nil
-  "*Name of this machine, for purposes of naming users.")
-
-(defvar user-mail-address nil
-  "*Full mailing address of this user.
-This is initialized based on `mail-host-address',
-after your init file is read, in case it sets `mail-host-address'.")
-
-(defvar auto-save-list-file-prefix
-  (if (eq system-type 'ms-dos)
-      "~/_s"  ; MS-DOS cannot have initial dot, and allows only 8.3 names
-    "~/.saves-")
-  "Prefix for generating `auto-save-list-file-name'.
-This is used after reading your `.emacs' file to initialize
-`auto-save-list-file-name', by appending Emacs's pid and the system name,
-if you have not already set `auto-save-list-file-name' yourself.
-Set this to nil if you want to prevent `auto-save-list-file-name'
-from being initialized.")
-
-(defvar init-file-debug nil)
-
-(defvar init-file-had-error nil)
-
-;; This function is called from the subdirs.el file.
-(defun normal-top-level-add-to-load-path (dirs)
-  (let ((tail (member (directory-file-name default-directory) load-path)))
-    (setcdr tail (append (mapcar 'expand-file-name dirs) (cdr tail)))))
-
-(defun normal-top-level ()
-  (if command-line-processed
-      (message "Back to top level.")
-    (setq command-line-processed t)
-    ;; Give *Messages* the same default-directory as *scratch*,
-    ;; just to keep things predictable.
-    (let ((dir default-directory))
-      (save-excursion
-	(set-buffer (get-buffer "*Messages*"))
-	(setq default-directory dir)))
-    ;; Look in each dir in load-path for a subdirs.el file.
-    ;; If we find one, load it, which will add the appropriate subdirs
-    ;; of that dir into load-path,
-    (let ((tail load-path)
-	  new)
-      (while tail
-	(setq new (cons (car tail) new))
-	(let ((default-directory (car tail)))
-	  (load (expand-file-name "subdirs.el" (car tail)) t t t))
-	(setq tail (cdr tail))))
-    (if (not (eq system-type 'vax-vms))
-	(progn
-	  ;; If the PWD environment variable isn't accurate, delete it.
-	  (let ((pwd (getenv "PWD")))
-	    (and (stringp pwd)
-		 ;; Use FOO/., so that if FOO is a symlink, file-attributes
-		 ;; describes the directory linked to, not FOO itself.
-		 (or (equal (file-attributes
-			     (concat (file-name-as-directory pwd) "."))
-			    (file-attributes
-			     (concat (file-name-as-directory default-directory)
-				     ".")))
-		     (setq process-environment
-			   (delete (concat "PWD=" pwd)
-				   process-environment)))))))
-    (setq default-directory (abbreviate-file-name default-directory))
-    (let ((menubar-bindings-done nil))
-      (unwind-protect
-	  (command-line)
-	;; Do this again, in case .emacs defined more abbreviations.
-	(setq default-directory (abbreviate-file-name default-directory))
-	;; Specify the file for recording all the auto save files of this session.
-	;; This is used by recover-session.
-	(or auto-save-list-file-name
-	    (and auto-save-list-file-prefix
-		 (setq auto-save-list-file-name
-		       ;; Under MS-DOS our PID is almost always reused between
-		       ;; Emacs invocations.  We need something more unique.
-		       (if (eq system-type 'ms-dos)
-			   (concat 
-			    (make-temp-name
-			     (expand-file-name auto-save-list-file-prefix))
-			    "~")
-
-			 (expand-file-name (format "%s%d-%s~"
-						   auto-save-list-file-prefix
-						   (emacs-pid)
-						   (system-name)))))))
-	(run-hooks 'emacs-startup-hook)
-	(and term-setup-hook
-	     (run-hooks 'term-setup-hook))
-	;; Modify the initial frame based on what .emacs puts into
-	;; ...-frame-alist.
-	(if (fboundp 'frame-notice-user-settings)
-	    (frame-notice-user-settings))
-	;; Now we know the user's default font, so add it to the menu.
-	(if (fboundp 'font-menu-add-default)
-	    (font-menu-add-default))
-	(and window-setup-hook
-	     (run-hooks 'window-setup-hook))
-	(or menubar-bindings-done
-	    (if (memq window-system '(x w32))
-		(precompute-menubar-bindings)))))))
-
-;; Precompute the keyboard equivalents in the menu bar items.
-(defun precompute-menubar-bindings ()
-  (let ((submap (lookup-key global-map [menu-bar])))
-    (while submap
-      (and (consp (car submap))
-	   (symbolp (car (car submap)))
-	   (stringp (car-safe (cdr (car submap))))
-	   (keymapp (cdr (cdr (car submap))))
-	   (progn
-	     (x-popup-menu nil (cdr (cdr (car submap))))
-	     (if purify-flag
-		 (garbage-collect))))
-      (setq submap (cdr submap))))
-  (setq define-key-rebound-commands t))
-
-(defun command-line ()
-  (setq command-line-default-directory default-directory)
-
-  ;; See if we should import version-control from the environment variable.
-  (let ((vc (getenv "VERSION_CONTROL")))
-    (cond ((eq vc nil))			;don't do anything if not set
-	  ((or (string= vc "t")
-	       (string= vc "numbered"))
-	   (setq version-control t))
-	  ((or (string= vc "nil")
-	       (string= vc "existing"))
-	   (setq version-control nil))
-	  ((or (string= vc "never")
-	       (string= vc "simple"))
-	   (setq version-control 'never))))
-
-  (if (let ((ctype
-	     ;; Use the first of these three envvars that has a nonempty value.
-	     (or (let ((string (getenv "LC_ALL")))
-		   (and (not (equal string "")) string))
-		 (let ((string (getenv "LC_CTYPE")))
-		   (and (not (equal string "")) string))
-		 (let ((string (getenv "LANG")))
-		   (and (not (equal string "")) string)))))
-	(and ctype
-	     (string-match iso-8859-1-locale-regexp ctype)))
-      (progn 
-	(require 'disp-table)
-	(standard-display-european t)
-	(require 'iso-syntax)))
-
-  ;;! This has been commented out; I currently find the behavior when
-  ;;! split-window-keep-point is nil disturbing, but if I can get used
-  ;;! to it, then it would be better to eliminate the option.
-  ;;! ;; Choose a good default value for split-window-keep-point.
-  ;;! (setq split-window-keep-point (> baud-rate 2400))
-
-  ;; Read window system's init file if using a window system.
-  (condition-case error
-      (if (and window-system (not noninteractive))
-	  (load (concat term-file-prefix
-			(symbol-name window-system)
-			"-win")
-		;; Every window system should have a startup file;
-		;; barf if we can't find it.
-		nil t))
-    ;; If we can't read it, print the error message and exit.
-    (error
-     (princ
-      (if (eq (car error) 'error)
-	  (apply 'concat (cdr error))
-	(if (memq 'file-error (get (car error) 'error-conditions))
-	    (format "%s: %s"
-		     (nth 1 error)
-		     (mapconcat '(lambda (obj) (prin1-to-string obj t))
-				(cdr (cdr error)) ", "))
-	  (format "%s: %s"
-		   (get (car error) 'error-message)
-		   (mapconcat '(lambda (obj) (prin1-to-string obj t))
-			      (cdr error) ", "))))
-      'external-debugging-output)
-     (setq window-system nil)
-     (kill-emacs)))
-
-  (let ((done nil)
-	(args (cdr command-line-args)))
-
-    ;; Figure out which user's init file to load,
-    ;; either from the environment or from the options.
-    (setq init-file-user (if noninteractive nil (user-login-name)))
-    ;; If user has not done su, use current $HOME to find .emacs.
-    (and init-file-user (string= init-file-user (user-real-login-name))
-	 (setq init-file-user ""))
-
-    ;; Process the command-line args, and delete the arguments
-    ;; processed.  This is consistent with the way main in emacs.c
-    ;; does things.
-    (while (and (not done) args)
-      (let ((longopts '(("--no-init-file") ("--no-site-file") ("--user")
-			("--debug-init") ("--iconic") ("--icon-type")))
-	    (argi (car args))
-	    (argval nil))
-	;; Handle --OPTION=VALUE format.
-	(if (and (string-match "\\`--" argi)
-		 (string-match "=" argi))
-	    (setq argval (substring argi (match-end 0))
-		  argi (substring argi 0 (match-beginning 0))))
-	(or (equal argi "--")
-	    (let ((completion (try-completion argi longopts)))
-	      (if (eq completion t)
-		  (setq argi (substring argi 1))
-		(if (stringp completion)
-		    (let ((elt (assoc completion longopts)))
-		      (or elt
-			  (error "Option `%s' is ambiguous" argi))
-		      (setq argi (substring (car elt) 1)))
-		  (setq argval nil)))))
-	(cond
-	 ((or (string-equal argi "-q")
-	      (string-equal argi "-no-init-file"))
-	  (setq init-file-user nil
-		args (cdr args)))
-	 ((or (string-equal argi "-u")
-	      (string-equal argi "-user"))
-	  (or argval
-	      (setq args (cdr args)
-		    argval (car args)))
-	  (setq init-file-user argval
-		argval nil
-		args (cdr args)))
-	 ((string-equal argi "-no-site-file")
-	  (setq site-run-file nil
-		args (cdr args)))
-	 ((string-equal argi "-debug-init")
-	  (setq init-file-debug t
-		args (cdr args)))
-	 ((string-equal argi "-iconic")
-	  (setq initial-frame-alist
-		(cons '(visibility . icon) initial-frame-alist))
-	  (setq args (cdr args)))
-	 ((or (string-equal argi "-icon-type")
-	      (string-equal argi "-i")
-	      (string-equal argi "-itype"))
-	  (setq default-frame-alist
-		(cons '(icon-type . t) default-frame-alist))
-	  (setq args (cdr args)))
-	 (t (setq done t)))
-	;; Was argval set but not used?
-	(and argval
-	     (error "Option `%s' doesn't allow an argument" argi))))
-
-    ;; Re-attach the program name to the front of the arg list.
-    (and command-line-args (setcdr command-line-args args)))
-
-  ;; Under X Windows, this creates the X frame and deletes the terminal frame.
-  (if (fboundp 'face-initialize)
-      (face-initialize))
-  (if (fboundp 'frame-initialize)
-      (frame-initialize))
-  ;; If frame was created with a menu bar, set menu-bar-mode on.
-  (if (or (not (memq window-system '(x w32)))
-	  (> (cdr (assq 'menu-bar-lines (frame-parameters))) 0))
-      (menu-bar-mode t))
-
-  (run-hooks 'before-init-hook)
-
-  ;; Run the site-start library if it exists.  The point of this file is
-  ;; that it is run before .emacs.  There is no point in doing this after
-  ;; .emacs; that is useless.
-  (if site-run-file 
-      (load site-run-file t t))
-
-  ;; Sites should not disable this.  Only individuals should disable
-  ;; the startup message.
-  (setq inhibit-startup-message nil)
-
-  ;; Load that user's init file, or the default one, or none.
-  (let (debug-on-error-from-init-file
-	debug-on-error-should-be-set
-	(debug-on-error-initial
-	 (if (eq init-file-debug t) 'startup init-file-debug)))
-    (let ((debug-on-error debug-on-error-initial)
-	  ;; This function actually reads the init files.
-	  (inner
-	   (function
-	    (lambda ()
-	      (if init-file-user
-		  (progn
-		    (setq user-init-file 
-			  (cond 
-			   ((eq system-type 'ms-dos)
-			    (concat "~" init-file-user "/_emacs"))
-			   ((eq system-type 'windows-nt)
-			    (if (file-exists-p "~/.emacs") 
-				"~/.emacs"
-			      "~/_emacs"))
-			   ((eq system-type 'vax-vms) 
-			    "sys$login:.emacs")
-			   (t 
-			    (concat "~" init-file-user "/.emacs"))))
-		    (load user-init-file t t t)
-		    (or inhibit-default-init
-			(let ((inhibit-startup-message nil))
-			  ;; Users are supposed to be told their rights.
-			  ;; (Plus how to get help and how to undo.)
-			  ;; Don't you dare turn this off for anyone
-			  ;; except yourself.
-			  (load "default" t t)))))))))
-      (if init-file-debug
-	  ;; Do this without a condition-case if the user wants to debug.
-	  (funcall inner)
-	(condition-case error
-	    (progn
-	      (funcall inner)
-	      (setq init-file-had-error nil))
-	  (error (message "Error in init file: %s%s%s"
-			  (get (car error) 'error-message)
-			  (if (cdr error) ": " "")
-			  (mapconcat 'prin1-to-string (cdr error) ", "))
-		 (setq init-file-had-error t))))
-      ;; If we can tell that the init file altered debug-on-error,
-      ;; arrange to preserve the value that it set up.
-      (or (eq debug-on-error debug-on-error-initial)
-	  (setq debug-on-error-should-be-set t
-		debug-on-error-from-init-file debug-on-error)))
-    (if debug-on-error-should-be-set
-	(setq debug-on-error debug-on-error-from-init-file)))
-
-  ;; Do this here in case the init file sets mail-host-address.
-  (or user-mail-address
-      (setq user-mail-address (concat (user-login-name) "@"
-				      (or mail-host-address
-					  (system-name)))))
-
-  (run-hooks 'after-init-hook)
-
-  ;; If *scratch* exists and init file didn't change its mode, initialize it.
-  (if (get-buffer "*scratch*")
-      (save-excursion
-	(set-buffer "*scratch*")
-	(if (eq major-mode 'fundamental-mode)
-	    (funcall initial-major-mode))))
-  ;; Load library for our terminal type.
-  ;; User init file can set term-file-prefix to nil to prevent this.
-  (and term-file-prefix (not noninteractive) (not window-system)
-       (let ((term (getenv "TERM"))
-	     hyphend)
-	 (while (and term
-		     (not (load (concat term-file-prefix term) t t)))
-	   ;; Strip off last hyphen and what follows, then try again
-	   (if (setq hyphend (string-match "[-_][^-_]+$" term))
-	       (setq term (substring term 0 hyphend))
-	     (setq term nil)))))
-
-  ;; Process the remaining args.
-  (command-line-1 (cdr command-line-args))
-
-  ;; If -batch, terminate after processing the command options.
-  (if noninteractive (kill-emacs t)))
-
-(defun command-line-1 (command-line-args-left)
-  (or noninteractive (input-pending-p) init-file-had-error
-      (and inhibit-startup-echo-area-message
-	   (let ((buffer (get-buffer-create " *temp*")))
-	     (prog1
-		 (condition-case nil
-		     (save-excursion
-		       (set-buffer buffer)
-		       (insert-file-contents user-init-file)
-		       (re-search-forward
-			(concat
-			 "([ \t\n]*setq[ \t\n]+"
-			 "inhibit-startup-echo-area-message[ \t\n]+"
-			 (regexp-quote
-			  (prin1-to-string
-			   (if (string= init-file-user "")
-			       (user-login-name)
-			     init-file-user)))
-			 "[ \t\n]*)")
-			nil t))
-		   (error nil))
-	       (kill-buffer buffer))))
-      (message (if (eq (key-binding "\C-h\C-p") 'describe-project)
-		   "For information about the GNU Project and its goals, type C-h C-p."
-		 (substitute-command-keys
-		  "For information about the GNU Project and its goals, type \\[describe-project]."))))
-  (if (null command-line-args-left)
-      (cond ((and (not inhibit-startup-message) (not noninteractive)
-		  ;; Don't clobber a non-scratch buffer if init file
-		  ;; has selected it.
-		  (string= (buffer-name) "*scratch*")
-		  (not (input-pending-p)))
-	     ;; If there are no switches to process, we might as well
-	     ;; run this hook now, and there may be some need to do it
-	     ;; before doing any output.
-	     (and term-setup-hook
-		  (run-hooks 'term-setup-hook))
-	     ;; Don't let the hook be run twice.
-	     (setq term-setup-hook nil)
-
-	     ;; It's important to notice the user settings before we
-	     ;; display the startup message; otherwise, the settings
-	     ;; won't take effect until the user gives the first
-	     ;; keystroke, and that's distracting.
-	     (if (fboundp 'frame-notice-user-settings)
-		 (frame-notice-user-settings))
-
-	     (and window-setup-hook
-		  (run-hooks 'window-setup-hook))
-	     (setq window-setup-hook nil)
-	     ;; Do this now to avoid an annoying delay if the user
-	     ;; clicks the menu bar during the sit-for.
-	     (if (memq window-system '(x w32))
-		 (precompute-menubar-bindings))
-	     (setq menubar-bindings-done t)
-	     (unwind-protect
-		 (progn
-		   ;; The convention for this piece of code is that
-		   ;; each piece of output starts with one or two newlines
-		   ;; and does not end with any newlines.
-		   (insert "Welcome to GNU Emacs")
-		   (if (eq system-type 'gnu/linux)
-		       (insert ", one component of a Linux-based GNU system."))
-		   (insert "\n")
-		   ;; If keys have their default meanings,
-		   ;; use precomputed string to save lots of time.
-		   (if (and (eq (key-binding "\C-h") 'help-command)
-			    (eq (key-binding "\C-xu") 'advertised-undo)
-			    (eq (key-binding "\C-x\C-c") 'save-buffers-kill-emacs)
-			    (eq (key-binding "\C-ht") 'help-with-tutorial)
-			    (eq (key-binding "\C-hi") 'info)
-			    (eq (key-binding "\C-h\C-n") 'view-emacs-news))
-		       (insert "
-Get help	   C-h  (Hold down CTRL and press h)
-Undo changes	   C-x u       Exit Emacs		C-x C-c
-Get a tutorial	   C-h t       Use Info to read docs	C-h i")
-		     (insert (substitute-command-keys
-			      (format "\n
-Get help	   %s
-Undo changes	   \\[advertised-undo]
-Exit Emacs	   \\[save-buffers-kill-emacs]
-Get a tutorial	   \\[help-with-tutorial]
-Use Info to read docs	\\[info]"
-				      (let ((where (where-is-internal
-						    'help-command nil t)))
-					(if where
-					    (key-description where)
-					  "M-x help"))))))
-		   ;; Say how to use the menu bar
-		   ;; if that is not with the mouse.
-		   (if (not (assq 'display (frame-parameters)))
-		       (if (and (eq (key-binding "\M-`") 'tmm-menubar)
-				(eq (key-binding [f10]) 'tmm-menubar))
-			   (insert "
-Activate menubar   F10  or  ESC `  or   M-`")
-			 (insert (substitute-command-keys "
-Activate menubar     \\[tmm-menubar]"))))
-
-		   ;; Windows and MSDOS (currently) do not count as
-		   ;; window systems, but do have mouse support.
-		   (if window-system
-		       (insert "
-Mode-specific menu   C-mouse-3 (third button, with CTRL)"))
-		   ;; Many users seem to have problems with these.
-		   (insert "
-\(`C-' means use the CTRL key.  `M-' means use the Meta (or Alt) key.
-If you have no Meta key, you may instead type ESC followed by the character.)")
-		   (and auto-save-list-file-prefix
-			(directory-files
-			 (file-name-directory auto-save-list-file-prefix)
-			 nil
-			 (concat "\\`"
-				 (regexp-quote (file-name-nondirectory
-						auto-save-list-file-prefix)))
-			 t)
-			(insert "\n\nIf an Emacs session crashed recently, "
-				"type M-x recover-session RET\nto recover"
-				" the files you were editing."))
-
-		   (insert "\n\n" (emacs-version)
-			   "
-Copyright (C) 1996 Free Software Foundation, Inc.")
-		   (if (and (eq (key-binding "\C-h\C-c") 'describe-copying)
-			    (eq (key-binding "\C-h\C-d") 'describe-distribution)
-			    (eq (key-binding "\C-h\C-w") 'describe-no-warranty))
-		       (insert 
-			"\n
-GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for full details.
-You may give out copies of Emacs; type C-h C-c to see the conditions.
-Type C-h C-d for information on getting the latest version.")
-		     (insert (substitute-command-keys
-			      "\n
-GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for full details.
-You may give out copies of Emacs; type \\[describe-copying] to see the conditions.
-Type \\[describe-distribution] for information on getting the latest version.")))
-		   (goto-char (point-min))
-
-		   (set-buffer-modified-p nil)
-		   (sit-for 120))
-	       (save-excursion
-		 ;; In case the Emacs server has already selected
-		 ;; another buffer, erase the one our message is in.
-		 (set-buffer (get-buffer "*scratch*"))
-		 (erase-buffer)
-		 (set-buffer-modified-p nil)))))
-    ;; Delay 2 seconds after the init file error message
-    ;; was displayed, so user can read it.
-    (if init-file-had-error
-	(sit-for 2))
-    (let ((dir command-line-default-directory)
-	  (file-count 0)
-	  first-file-buffer
-	  tem
-	  just-files  ;; t if this follows the magic -- option.
-	  ;; This includes our standard options' long versions
-	  ;; and long versions of what's on command-switch-alist.
-	  (longopts
-	   (append '(("--funcall") ("--load") ("--insert") ("--kill")
-		     ("--directory") ("--eval") ("--find-file") ("--visit"))
-		   (mapcar '(lambda (elt)
-			      (list (concat "-" (car elt))))
-			   command-switch-alist)))
-	  (line 0))
-
-      ;; Add the long X options to longopts.
-      (setq tem command-line-x-option-alist)
-      (while tem
-	(if (string-match "^--" (car (car tem)))
-	    (setq longopts (cons (list (car (car tem))) longopts)))
-	(setq tem (cdr tem)))
-
-      ;; Loop, processing options.
-      (while (and command-line-args-left)
-	(let* ((argi (car command-line-args-left))
-	       (orig-argi argi)
-	       argval completion
-	       ;; List of directories specified in -L/--directory,
-	       ;; in reverse of the order specified.
-	       extra-load-path
-	       (initial-load-path load-path))
-	  (setq command-line-args-left (cdr command-line-args-left))
-
-	  ;; Do preliminary decoding of the option.
-	  (if just-files
-	      ;; After --, don't look for options; treat all args as files.
-	      (setq argi "")
-	    ;; Convert long options to ordinary options
-	    ;; and separate out an attached option argument into argval.
-	    (if (string-match "^--[^=]*=" argi)
-		(setq argval (substring argi (match-end 0))
-		      argi (substring argi 0 (1- (match-end 0)))))
-	    (if (equal argi "--")
-		(setq completion nil)
-	      (setq completion (try-completion argi longopts)))
-	    (if (eq completion t)
-		(setq argi (substring argi 1))
-	      (if (stringp completion)
-		  (let ((elt (assoc completion longopts)))
-		    (or elt
-			(error "Option `%s' is ambiguous" argi))
-		    (setq argi (substring (car elt) 1)))
-		(setq argval nil argi orig-argi))))
-
-	  ;; Execute the option.
-	  (cond ((setq tem (assoc argi command-switch-alist))
-		 (if argval
-		     (let ((command-line-args-left
-			    (cons argval command-line-args-left)))
-		       (funcall (cdr tem) argi))
-		   (funcall (cdr tem) argi)))
-		((or (string-equal argi "-f")  ;what the manual claims
-		     (string-equal argi "-funcall")
-		     (string-equal argi "-e")) ; what the source used to say
-		 (if argval
-		     (setq tem (intern argval))
-		   (setq tem (intern (car command-line-args-left)))
-		   (setq command-line-args-left (cdr command-line-args-left)))
-		 (if (arrayp (symbol-function tem))
-		     (command-execute tem)
-		   (funcall tem)))
-		((string-equal argi "-eval")
-		 (if argval
-		     (setq tem argval)
-		   (setq tem (car command-line-args-left))
-		   (setq command-line-args-left (cdr command-line-args-left)))
-		 (eval (read tem)))
-		;; Set the default directory as specified in -L.
-		((or (string-equal argi "-L")
-		     (string-equal argi "-directory"))
-		 (if argval
-		     (setq tem argval)
-		   (setq tem (car command-line-args-left)
-			 command-line-args-left (cdr command-line-args-left)))
-		 (setq tem (command-line-normalize-file-name tem))
-		 (setq extra-load-path
-		       (cons (expand-file-name tem) extra-load-path))
-		 (setq load-path (append (nreverse extra-load-path)
-					 initial-load-path)))
-		((or (string-equal argi "-l")
-		     (string-equal argi "-load"))
-		 (if argval
-		     (setq tem argval)
-		   (setq tem (car command-line-args-left)
-			 command-line-args-left (cdr command-line-args-left)))
-		 (let ((file (command-line-normalize-file-name tem)))
-		   ;; Take file from default dir if it exists there;
-		   ;; otherwise let `load' search for it.
-		   (if (file-exists-p (expand-file-name file))
-		       (setq file (expand-file-name file)))
-		   (load file nil t)))
-		((string-equal argi "-insert")
-		 (if argval
-		     (setq tem argval)
-		   (setq tem (car command-line-args-left)
-			 command-line-args-left (cdr command-line-args-left)))
-		 (or (stringp tem)
-		     (error "File name omitted from `-insert' option"))
-		 (insert-file-contents (command-line-normalize-file-name tem)))
-		((string-equal argi "-kill")
-		 (kill-emacs t))
-		((string-match "^\\+[0-9]+\\'" argi)
-		 (setq line (string-to-int argi)))
-		((setq tem (assoc argi command-line-x-option-alist))
-		 ;; Ignore X-windows options and their args if not using X.
-		 (setq command-line-args-left
-		       (nthcdr (nth 1 tem) command-line-args-left)))
-		((or (string-equal argi "-find-file")
-		     (string-equal argi "-visit"))
-		 ;; An explicit option to specify visiting a file.
-		 (setq file-count (1+ file-count))
-		 (let ((file
-			(expand-file-name
-			 (command-line-normalize-file-name orig-argi)
-			 dir)))
-		   (if (= file-count 1)
-		       (setq first-file-buffer (find-file file))
-		     (find-file-other-window file)))
-		 (or (zerop line)
-		     (goto-line line))
-		 (setq line 0))
-		((equal argi "--")
-		 (setq just-files t))
-		(t
-		 ;; We have almost exhausted our options. See if the
-		 ;; user has made any other command-line options available
-		 (let ((hooks command-line-functions);; lrs 7/31/89
-		       (did-hook nil))
-		   (while (and hooks
-			       (not (setq did-hook (funcall (car hooks)))))
-		     (setq hooks (cdr hooks)))
-		   (if (not did-hook)
-		       ;; Ok, presume that the argument is a file name
-		       (progn
-			 (if (string-match "\\`-" argi)
-			     (error "Unknown option `%s'" argi))
-			 (setq file-count (1+ file-count))
-			 (let ((file
-				(expand-file-name
-				 (command-line-normalize-file-name orig-argi)
-				 dir)))
-			   (if (= file-count 1)
-			       (setq first-file-buffer (find-file file))
-			     (find-file-other-window file)))
-			 (or (zerop line)
-			     (goto-line line))
-			 (setq line 0))))))))
-      ;; If 3 or more files visited, and not all visible,
-      ;; show user what they all are.
-      (and (> file-count 2)
-	   (not noninteractive)
-	   (or (get-buffer-window first-file-buffer)
-	       (progn (other-window 1)
-		      (buffer-menu)))))))
-
-(defun command-line-normalize-file-name (file)
-  "Collapse multiple slashes to one, to handle non-Emacs file names."
-  (save-match-data
-    ;; Use arg 1 so that we don't collapse // at the start of the file name.
-    ;; That is significant on some systems.
-    ;; However, /// at the beginning is supposed to mean just /, not //.
-    (if (string-match "^///+" file)
-	(setq file (replace-match "/" t t file)))
-    (while (string-match "//+" file 1)
-      (setq file (replace-match "/" t t file)))
-    file))
-
-;;; startup.el ends here
diff --git a/lisp/subr.el b/lisp/subr.el
deleted file mode 100644
index 22056046416..00000000000
--- a/lisp/subr.el
+++ /dev/null
@@ -1,975 +0,0 @@
-;;; subr.el --- basic lisp subroutines for Emacs
-
-;; Copyright (C) 1985, 1986, 1992, 1994, 1995 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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.
-
-;;; Code:
-
-
-;;;; Lisp language features.
-
-(defmacro lambda (&rest cdr)
-  "Return a lambda expression.
-A call of the form (lambda ARGS DOCSTRING INTERACTIVE BODY) is
-self-quoting; the result of evaluating the lambda expression is the
-expression itself.  The lambda expression may then be treated as a
-function, i.e., stored as the function value of a symbol, passed to
-funcall or mapcar, etc.
-
-ARGS should take the same form as an argument list for a `defun'.
-DOCSTRING is an optional documentation string.
- If present, it should describe how to call the function.
- But documentation strings are usually not useful in nameless functions.
-INTERACTIVE should be a call to the function `interactive', which see.
-It may also be omitted.
-BODY should be a list of lisp expressions."
-  ;; Note that this definition should not use backquotes; subr.el should not
-  ;; depend on backquote.el.
-  (list 'function (cons 'lambda cdr)))
-
-;;(defmacro defun-inline (name args &rest body)
-;;  "Create an \"inline defun\" (actually a macro).
-;;Use just like `defun'."
-;;  (nconc (list 'defmacro name '(&rest args))
-;;	 (if (stringp (car body))
-;;	     (prog1 (list (car body))
-;;	       (setq body (or (cdr body) body))))
-;;	 (list (list 'cons (list 'quote
-;;				 (cons 'lambda (cons args body)))
-;;		     'args))))
-
-
-;;;; Keymap support.
-
-(defun undefined ()
-  (interactive)
-  (ding))
-
-;Prevent the \{...} documentation construct
-;from mentioning keys that run this command.
-(put 'undefined 'suppress-keymap t)
-
-(defun suppress-keymap (map &optional nodigits)
-  "Make MAP override all normally self-inserting keys to be undefined.
-Normally, as an exception, digits and minus-sign are set to make prefix args,
-but optional second arg NODIGITS non-nil treats them like other chars."
-  (substitute-key-definition 'self-insert-command 'undefined map global-map)
-  (or nodigits
-      (let (loop)
-	(define-key map "-" 'negative-argument)
-	;; Make plain numbers do numeric args.
-	(setq loop ?0)
-	(while (<= loop ?9)
-	  (define-key map (char-to-string loop) 'digit-argument)
-	  (setq loop (1+ loop))))))
-
-;Moved to keymap.c
-;(defun copy-keymap (keymap)
-;  "Return a copy of KEYMAP"  
-;  (while (not (keymapp keymap))
-;    (setq keymap (signal 'wrong-type-argument (list 'keymapp keymap))))
-;  (if (vectorp keymap)
-;      (copy-sequence keymap)
-;      (copy-alist keymap)))
-
-(defvar key-substitution-in-progress nil
- "Used internally by substitute-key-definition.")
-
-(defun substitute-key-definition (olddef newdef keymap &optional oldmap prefix)
-  "Replace OLDDEF with NEWDEF for any keys in KEYMAP now defined as OLDDEF.
-In other words, OLDDEF is replaced with NEWDEF where ever it appears.
-If optional fourth argument OLDMAP is specified, we redefine
-in KEYMAP as NEWDEF those chars which are defined as OLDDEF in OLDMAP."
-  (or prefix (setq prefix ""))
-  (let* ((scan (or oldmap keymap))
-	 (vec1 (vector nil))
-	 (prefix1 (vconcat prefix vec1))
-	 (key-substitution-in-progress
-	  (cons scan key-substitution-in-progress)))
-    ;; Scan OLDMAP, finding each char or event-symbol that
-    ;; has any definition, and act on it with hack-key.
-    (while (consp scan)
-      (if (consp (car scan))
-	  (let ((char (car (car scan)))
-		(defn (cdr (car scan))))
-	    ;; The inside of this let duplicates exactly
-	    ;; the inside of the following let that handles array elements.
-	    (aset vec1 0 char)
-	    (aset prefix1 (length prefix) char)
-	    (let (inner-def skipped)
-	      ;; Skip past menu-prompt.
-	      (while (stringp (car-safe defn))
-		(setq skipped (cons (car defn) skipped))
-		(setq defn (cdr defn)))
-	      ;; Skip past cached key-equivalence data for menu items.
-	      (and (consp defn) (consp (car defn))
-		   (setq defn (cdr defn)))
-	      (setq inner-def defn)
-	      ;; Look past a symbol that names a keymap.
-	      (while (and (symbolp inner-def)
-			  (fboundp inner-def))
-		(setq inner-def (symbol-function inner-def)))
-	      (if (eq defn olddef)
-		  (define-key keymap prefix1 (nconc (nreverse skipped) newdef))
-		(if (and (keymapp defn)
-			 ;; Avoid recursively scanning
-			 ;; where KEYMAP does not have a submap.
-			 (let ((elt (lookup-key keymap prefix1)))
-			   (or (null elt)
-			       (keymapp elt)))
-			 ;; Avoid recursively rescanning keymap being scanned.
-			 (not (memq inner-def
-				    key-substitution-in-progress)))
-		    ;; If this one isn't being scanned already,
-		    ;; scan it now.
-		    (substitute-key-definition olddef newdef keymap
-					       inner-def
-					       prefix1)))))
-	(if (arrayp (car scan))
-	    (let* ((array (car scan))
-		   (len (length array))
-		   (i 0))
-	      (while (< i len)
-		(let ((char i) (defn (aref array i)))
-		  ;; The inside of this let duplicates exactly
-		  ;; the inside of the previous let.
-		  (aset vec1 0 char)
-		  (aset prefix1 (length prefix) char)
-		  (let (inner-def skipped)
-		    ;; Skip past menu-prompt.
-		    (while (stringp (car-safe defn))
-		      (setq skipped (cons (car defn) skipped))
-		      (setq defn (cdr defn)))
-		    (and (consp defn) (consp (car defn))
-			 (setq defn (cdr defn)))
-		    (setq inner-def defn)
-		    (while (and (symbolp inner-def)
-				(fboundp inner-def))
-		      (setq inner-def (symbol-function inner-def)))
-		    (if (eq defn olddef)
-			(define-key keymap prefix1
-			  (nconc (nreverse skipped) newdef))
-		      (if (and (keymapp defn)
-			       (let ((elt (lookup-key keymap prefix1)))
-				 (or (null elt)
-				     (keymapp elt)))
-			       (not (memq inner-def
-					  key-substitution-in-progress)))
-			  (substitute-key-definition olddef newdef keymap
-						     inner-def
-						     prefix1)))))
-		(setq i (1+ i))))))
-      (setq scan (cdr scan)))))
-
-(defun define-key-after (keymap key definition after)
-  "Add binding in KEYMAP for KEY => DEFINITION, right after AFTER's binding.
-This is like `define-key' except that the binding for KEY is placed
-just after the binding for the event AFTER, instead of at the beginning
-of the map.  Note that AFTER must be an event type (like KEY), NOT a command
-\(like DEFINITION).
-
-If AFTER is t, the new binding goes at the end of the keymap.
-
-KEY must contain just one event type--that is to say, it must be
-a string or vector of length 1.
-
-The order of bindings in a keymap matters when it is used as a menu."
-
-  (or (keymapp keymap)
-      (signal 'wrong-type-argument (list 'keymapp keymap)))
-  (if (> (length key) 1)
-      (error "multi-event key specified in `define-key-after'"))
-  (let ((tail keymap) done inserted
-	(first (aref key 0)))
-    (while (and (not done) tail)
-      ;; Delete any earlier bindings for the same key.
-      (if (eq (car-safe (car (cdr tail))) first)
-	  (setcdr tail (cdr (cdr tail))))
-      ;; When we reach AFTER's binding, insert the new binding after.
-      ;; If we reach an inherited keymap, insert just before that.
-      ;; If we reach the end of this keymap, insert at the end.
-      (if (or (and (eq (car-safe (car tail)) after)
-		   (not (eq after t)))
-	      (eq (car (cdr tail)) 'keymap)
-	      (null (cdr tail)))
-	  (progn
-	    ;; Stop the scan only if we find a parent keymap.
-	    ;; Keep going past the inserted element
-	    ;; so we can delete any duplications that come later.
-	    (if (eq (car (cdr tail)) 'keymap)
-		(setq done t))
-	    ;; Don't insert more than once.
-	    (or inserted
-		(setcdr tail (cons (cons (aref key 0) definition) (cdr tail))))
-	    (setq inserted t)))
-      (setq tail (cdr tail)))))
-
-(put 'keyboard-translate-table 'char-table-extra-slots 0)
-
-(defun keyboard-translate (from to)
-  "Translate character FROM to TO at a low level.
-This function creates a `keyboard-translate-table' if necessary
-and then modifies one entry in it."
-  (or (char-table-p keyboard-translate-table)
-      (setq keyboard-translate-table
-	    (make-char-table 'keyboard-translate-table nil)))
-  (aset keyboard-translate-table from to))
-
-
-;;;; The global keymap tree.  
-
-;;; global-map, esc-map, and ctl-x-map have their values set up in
-;;; keymap.c; we just give them docstrings here.
-
-(defvar global-map nil
-  "Default global keymap mapping Emacs keyboard input into commands.
-The value is a keymap which is usually (but not necessarily) Emacs's
-global map.")
-
-(defvar esc-map nil
-  "Default keymap for ESC (meta) commands.
-The normal global definition of the character ESC indirects to this keymap.")
-
-(defvar ctl-x-map nil
-  "Default keymap for C-x commands.
-The normal global definition of the character C-x indirects to this keymap.")
-
-(defvar ctl-x-4-map (make-sparse-keymap)
-  "Keymap for subcommands of C-x 4")
-(defalias 'ctl-x-4-prefix ctl-x-4-map)
-(define-key ctl-x-map "4" 'ctl-x-4-prefix)
-
-(defvar ctl-x-5-map (make-sparse-keymap)
-  "Keymap for frame commands.")
-(defalias 'ctl-x-5-prefix ctl-x-5-map)
-(define-key ctl-x-map "5" 'ctl-x-5-prefix)
-
-
-;;;; Event manipulation functions.
-
-;; The call to `read' is to ensure that the value is computed at load time
-;; and not compiled into the .elc file.  The value is negative on most
-;; machines, but not on all!
-(defconst listify-key-sequence-1 (logior 128 (read "?\\M-\\^@")))
-
-(defun listify-key-sequence (key)
-  "Convert a key sequence to a list of events."
-  (if (vectorp key)
-      (append key nil)
-    (mapcar (function (lambda (c)
-			(if (> c 127)
-			    (logxor c listify-key-sequence-1)
-			  c)))
-	    (append key nil))))
-
-(defsubst eventp (obj)
-  "True if the argument is an event object."
-  (or (integerp obj)
-      (and (symbolp obj)
-	   (get obj 'event-symbol-elements))
-      (and (consp obj)
-	   (symbolp (car obj))
-	   (get (car obj) 'event-symbol-elements))))
-
-(defun event-modifiers (event)
-  "Returns a list of symbols representing the modifier keys in event EVENT.
-The elements of the list may include `meta', `control',
-`shift', `hyper', `super', `alt', `click', `double', `triple', `drag',
-and `down'."
-  (let ((type event))
-    (if (listp type)
-	(setq type (car type)))
-    (if (symbolp type)
-	(cdr (get type 'event-symbol-elements))
-      (let ((list nil))
-	(or (zerop (logand type ?\M-\^@))
-	    (setq list (cons 'meta list)))
-	(or (and (zerop (logand type ?\C-\^@))
-		 (>= (logand type 127) 32))
-	    (setq list (cons 'control list)))
-	(or (and (zerop (logand type ?\S-\^@))
-		 (= (logand type 255) (downcase (logand type 255))))
-	    (setq list (cons 'shift list)))
-	(or (zerop (logand type ?\H-\^@))
-	    (setq list (cons 'hyper list)))
-	(or (zerop (logand type ?\s-\^@))
-	    (setq list (cons 'super list)))
-	(or (zerop (logand type ?\A-\^@))
-	    (setq list (cons 'alt list)))
-	list))))
-
-(defun event-basic-type (event)
-  "Returns the basic type of the given event (all modifiers removed).
-The value is an ASCII printing character (not upper case) or a symbol."
-  (if (consp event)
-      (setq event (car event)))
-  (if (symbolp event)
-      (car (get event 'event-symbol-elements))
-    (let ((base (logand event (1- (lsh 1 18)))))
-      (downcase (if (< base 32) (logior base 64) base)))))
-
-(defsubst mouse-movement-p (object)
-  "Return non-nil if OBJECT is a mouse movement event."
-  (and (consp object)
-       (eq (car object) 'mouse-movement)))
-
-(defsubst event-start (event)
-  "Return the starting position of EVENT.
-If EVENT is a mouse press or a mouse click, this returns the location
-of the event.
-If EVENT is a drag, this returns the drag's starting position.
-The return value is of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-The `posn-' functions access elements of such lists."
-  (nth 1 event))
-
-(defsubst event-end (event)
-  "Return the ending location of EVENT.  EVENT should be a click or drag event.
-If EVENT is a click event, this function is the same as `event-start'.
-The return value is of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-The `posn-' functions access elements of such lists."
-  (nth (if (consp (nth 2 event)) 2 1) event))
-
-(defsubst event-click-count (event)
-  "Return the multi-click count of EVENT, a click or drag event.
-The return value is a positive integer."
-  (if (integerp (nth 2 event)) (nth 2 event) 1))
-
-(defsubst posn-window (position)
-  "Return the window in POSITION.
-POSITION should be a list of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
-  (nth 0 position))
-
-(defsubst posn-point (position)
-  "Return the buffer location in POSITION.
-POSITION should be a list of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
-  (if (consp (nth 1 position))
-      (car (nth 1 position))
-    (nth 1 position)))
-
-(defsubst posn-x-y (position)
-  "Return the x and y coordinates in POSITION.
-POSITION should be a list of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
-  (nth 2 position))
-
-(defun posn-col-row (position)
-  "Return the column and row in POSITION, measured in characters.
-POSITION should be a list of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions.
-For a scroll-bar event, the result column is 0, and the row
-corresponds to the vertical position of the click in the scroll bar."
-  (let ((pair   (nth 2 position))
-	(window (posn-window position)))
-    (if (eq (if (consp (nth 1 position))
-		(car (nth 1 position))
-	      (nth 1 position))
-	    'vertical-scroll-bar)
-	(cons 0 (scroll-bar-scale pair (1- (window-height window))))
-      (if (eq (if (consp (nth 1 position))
-		  (car (nth 1 position))
-		(nth 1 position))
-	      'horizontal-scroll-bar)
-	  (cons (scroll-bar-scale pair (window-width window)) 0)
-	(let* ((frame (if (framep window) window (window-frame window)))
-	       (x (/ (car pair) (frame-char-width frame)))
-	       (y (/ (cdr pair) (frame-char-height frame))))
-	  (cons x y))))))
-
-(defsubst posn-timestamp (position)
-  "Return the timestamp of POSITION.
-POSITION should be a list of the form
-   (WINDOW BUFFER-POSITION (X . Y) TIMESTAMP)
-as returned by the `event-start' and `event-end' functions."
-  (nth 3 position))
-
-
-;;;; Obsolescent names for functions.
-
-(defalias 'dot 'point)
-(defalias 'dot-marker 'point-marker)
-(defalias 'dot-min 'point-min)
-(defalias 'dot-max 'point-max)
-(defalias 'window-dot 'window-point)
-(defalias 'set-window-dot 'set-window-point)
-(defalias 'read-input 'read-string)
-(defalias 'send-string 'process-send-string)
-(defalias 'send-region 'process-send-region)
-(defalias 'show-buffer 'set-window-buffer)
-(defalias 'buffer-flush-undo 'buffer-disable-undo)
-(defalias 'eval-current-buffer 'eval-buffer)
-(defalias 'compiled-function-p 'byte-code-function-p)
-(defalias 'define-function 'defalias)
-
-;; Some programs still use this as a function.
-(defun baud-rate ()
-  "Obsolete function returning the value of the `baud-rate' variable.
-Please convert your programs to use the variable `baud-rate' directly."
-  baud-rate)
-
-(defalias 'focus-frame 'ignore)
-(defalias 'unfocus-frame 'ignore)
-
-;;;; Alternate names for functions - these are not being phased out.
-
-(defalias 'string= 'string-equal)
-(defalias 'string< 'string-lessp)
-(defalias 'move-marker 'set-marker)
-(defalias 'not 'null)
-(defalias 'rplaca 'setcar)
-(defalias 'rplacd 'setcdr)
-(defalias 'beep 'ding) ;preserve lingual purity
-(defalias 'indent-to-column 'indent-to)
-(defalias 'backward-delete-char 'delete-backward-char)
-(defalias 'search-forward-regexp (symbol-function 're-search-forward))
-(defalias 'search-backward-regexp (symbol-function 're-search-backward))
-(defalias 'int-to-string 'number-to-string)
-(defalias 'set-match-data 'store-match-data)
-
-;;; Should this be an obsolete name?  If you decide it should, you get
-;;; to go through all the sources and change them.
-(defalias 'string-to-int 'string-to-number)
-
-;;;; Hook manipulation functions.
-
-(defun make-local-hook (hook)
-  "Make the hook HOOK local to the current buffer.
-When a hook is local, its local and global values
-work in concert: running the hook actually runs all the hook
-functions listed in *either* the local value *or* the global value
-of the hook variable.
-
-This function works by making `t' a member of the buffer-local value,
-which acts as a flag to run the hook functions in the default value as
-well.  This works for all normal hooks, but does not work for most
-non-normal hooks yet.  We will be changing the callers of non-normal
-hooks so that they can handle localness; this has to be done one by
-one.
-
-This function does nothing if HOOK is already local in the current
-buffer.
-
-Do not use `make-local-variable' to make a hook variable buffer-local."
-  (if (local-variable-p hook)
-      nil
-    (or (boundp hook) (set hook nil))
-    (make-local-variable hook)
-    (set hook (list t))))
-
-(defun add-hook (hook function &optional append local)
-  "Add to the value of HOOK the function FUNCTION.
-FUNCTION is not added if already present.
-FUNCTION is added (if necessary) at the beginning of the hook list
-unless the optional argument APPEND is non-nil, in which case
-FUNCTION is added at the end.
-
-The optional fourth argument, LOCAL, if non-nil, says to modify
-the hook's buffer-local value rather than its default value.
-This makes no difference if the hook is not buffer-local.
-To make a hook variable buffer-local, always use
-`make-local-hook', not `make-local-variable'.
-
-HOOK should be a symbol, and FUNCTION may be any valid function.  If
-HOOK is void, it is first set to nil.  If HOOK's value is a single
-function, it is changed to a list of functions."
-  (or (boundp hook) (set hook nil))
-  (or (default-boundp hook) (set-default hook nil))
-  ;; If the hook value is a single function, turn it into a list.
-  (let ((old (symbol-value hook)))
-    (if (or (not (listp old)) (eq (car old) 'lambda))
-	(set hook (list old))))
-  (if (or local
-	  ;; Detect the case where make-local-variable was used on a hook
-	  ;; and do what we used to do.
-	  (and (local-variable-if-set-p hook)
-	       (not (memq t (symbol-value hook)))))
-      ;; Alter the local value only.
-      (or (if (consp function)
-	      (member function (symbol-value hook))
-	    (memq function (symbol-value hook)))
-	  (set hook 
-	       (if append
-		   (append (symbol-value hook) (list function))
-		 (cons function (symbol-value hook)))))
-    ;; Alter the global value (which is also the only value,
-    ;; if the hook doesn't have a local value).
-    (or (if (consp function)
-	    (member function (default-value hook))
-	  (memq function (default-value hook)))
-	(set-default hook 
-		     (if append
-			 (append (default-value hook) (list function))
-		       (cons function (default-value hook)))))))
-
-(defun remove-hook (hook function &optional local)
-  "Remove from the value of HOOK the function FUNCTION.
-HOOK should be a symbol, and FUNCTION may be any valid function.  If
-FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
-list of hooks to run in HOOK, then nothing is done.  See `add-hook'.
-
-The optional third argument, LOCAL, if non-nil, says to modify
-the hook's buffer-local value rather than its default value.
-This makes no difference if the hook is not buffer-local.
-To make a hook variable buffer-local, always use
-`make-local-hook', not `make-local-variable'."
-  (if (or (not (boundp hook))		;unbound symbol, or
-	  (not (default-boundp 'hook))
-	  (null (symbol-value hook))	;value is nil, or
-	  (null function))		;function is nil, then
-      nil				;Do nothing.
-    (if (or local
-	    ;; Detect the case where make-local-variable was used on a hook
-	    ;; and do what we used to do.
-	    (and (local-variable-p hook)
-		 (not (memq t (symbol-value hook)))))
-	(let ((hook-value (symbol-value hook)))
-	  (if (consp hook-value)
-	      (if (member function hook-value)
-		  (setq hook-value (delete function (copy-sequence hook-value))))
-	    (if (equal hook-value function)
-		(setq hook-value nil)))
-	  (set hook hook-value))
-      (let ((hook-value (default-value hook)))
-	(if (consp hook-value)
-	    (if (member function hook-value)
-		(setq hook-value (delete function (copy-sequence hook-value))))
-	  (if (equal hook-value function)
-	      (setq hook-value nil)))
-	(set-default hook hook-value)))))
-
-(defun add-to-list (list-var element)
-  "Add to the value of LIST-VAR the element ELEMENT if it isn't there yet.
-The test for presence of ELEMENT is done with `equal'.
-If you want to use `add-to-list' on a variable that is not defined
-until a certain package is loaded, you should put the call to `add-to-list'
-into a hook function that will be run only after loading the package.
-`eval-after-load' provides one way to do this.  In some cases
-other hooks, such as major mode hooks, can do the job."
-  (or (member element (symbol-value list-var))
-      (set list-var (cons element (symbol-value list-var)))))
-
-;;;; Specifying things to do after certain files are loaded.
-
-(defun eval-after-load (file form)
-  "Arrange that, if FILE is ever loaded, FORM will be run at that time.
-This makes or adds to an entry on `after-load-alist'.
-If FILE is already loaded, evaluate FORM right now.
-It does nothing if FORM is already on the list for FILE.
-FILE should be the name of a library, with no directory name."
-  ;; Make sure there is an element for FILE.
-  (or (assoc file after-load-alist)
-      (setq after-load-alist (cons (list file) after-load-alist)))
-  ;; Add FORM to the element if it isn't there.
-  (let ((elt (assoc file after-load-alist)))
-    (or (member form (cdr elt))
-	(progn
-	  (nconc elt (list form))
-	  ;; If the file has been loaded already, run FORM right away.
-	  (and (assoc file load-history)
-	       (eval form)))))
-  form)
-
-(defun eval-next-after-load (file)
-  "Read the following input sexp, and run it whenever FILE is loaded.
-This makes or adds to an entry on `after-load-alist'.
-FILE should be the name of a library, with no directory name."
-  (eval-after-load file (read)))
-
-
-;;;; Input and display facilities.
-
-(defun read-quoted-char (&optional prompt)
-  "Like `read-char', except that if the first character read is an octal
-digit, we read up to two more octal digits and return the character
-represented by the octal number consisting of those digits.
-Optional argument PROMPT specifies a string to use to prompt the user."
-  (let ((message-log-max nil) (count 0) (code 0) char)
-    (while (< count 3)
-      (let ((inhibit-quit (zerop count))
-	    ;; Don't let C-h get the help message--only help function keys.
-	    (help-char nil)
-	    (help-form
-	     "Type the special character you want to use,
-or three octal digits representing its character code."))
-	(and prompt (message "%s-" prompt))
-	(setq char (read-char))
-	(if inhibit-quit (setq quit-flag nil)))
-      (cond ((null char))
-	    ((and (<= ?0 char) (<= char ?7))
-	     (setq code (+ (* code 8) (- char ?0))
-		   count (1+ count))
-	     (and prompt (setq prompt (message "%s %c" prompt char))))
-	    ((> count 0)
-	     (setq unread-command-events (list char) count 259))
-	    (t (setq code char count 259))))
-    ;; Turn a meta-character into a character with the 0200 bit set.
-    (logior (if (/= (logand code ?\M-\^@) 0) 128 0)
-	    (logand 255 code))))
-
-(defun force-mode-line-update (&optional all)
-  "Force the mode-line of the current buffer to be redisplayed.
-With optional non-nil ALL, force redisplay of all mode-lines."
-  (if all (save-excursion (set-buffer (other-buffer))))
-  (set-buffer-modified-p (buffer-modified-p)))
-
-(defun momentary-string-display (string pos &optional exit-char message) 
-  "Momentarily display STRING in the buffer at POS.
-Display remains until next character is typed.
-If the char is EXIT-CHAR (optional third arg, default is SPC) it is swallowed;
-otherwise it is then available as input (as a command if nothing else).
-Display MESSAGE (optional fourth arg) in the echo area.
-If MESSAGE is nil, instructions to type EXIT-CHAR are displayed there."
-  (or exit-char (setq exit-char ?\ ))
-  (let ((buffer-read-only nil)
-	;; Don't modify the undo list at all.
-	(buffer-undo-list t)
-	(modified (buffer-modified-p))
-	(name buffer-file-name)
-	insert-end)
-    (unwind-protect
-	(progn
-	  (save-excursion
-	    (goto-char pos)
-	    ;; defeat file locking... don't try this at home, kids!
-	    (setq buffer-file-name nil)
-	    (insert-before-markers string)
-	    (setq insert-end (point))
-	    ;; If the message end is off screen, recenter now.
-	    (if (> (window-end) insert-end)
-		(recenter (/ (window-height) 2)))
-	    ;; If that pushed message start off the screen,
-	    ;; scroll to start it at the top of the screen.
-	    (move-to-window-line 0)
-	    (if (> (point) pos)
-		(progn
-		  (goto-char pos)
-		  (recenter 0))))
-	  (message (or message "Type %s to continue editing.")
-		   (single-key-description exit-char))
-	  (let ((char (read-event)))
-	    (or (eq char exit-char)
-		(setq unread-command-events (list char)))))
-      (if insert-end
-	  (save-excursion
-	    (delete-region pos insert-end)))
-      (setq buffer-file-name name)
-      (set-buffer-modified-p modified))))
-
-
-;;;; Miscellanea.
-
-;; A number of major modes set this locally.
-;; Give it a global value to avoid compiler warnings.
-(defvar font-lock-defaults nil)
-
-;; Avoid compiler warnings about this variable,
-;; which has a special meaning on certain system types.
-(defvar buffer-file-type nil
-  "Non-nil if the visited file is a binary file.
-This variable is meaningful on MS-DOG and Windows NT.
-On those systems, it is automatically local in every buffer.
-On other systems, this variable is normally always nil.")
-
-;; This should probably be written in C (i.e., without using `walk-windows').
-(defun get-buffer-window-list (buffer &optional minibuf frame)
-  "Return windows currently displaying BUFFER, or nil if none.
-See `walk-windows' for the meaning of MINIBUF and FRAME."
-  (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
-    (walk-windows (function (lambda (window)
-			      (if (eq (window-buffer window) buffer)
-				  (setq windows (cons window windows)))))
-		  minibuf frame)
-    windows))
-
-(defun ignore (&rest ignore)
-  "Do nothing and return nil.
-This function accepts any number of arguments, but ignores them."
-  (interactive)
-  nil)
-
-(defun error (&rest args)
-  "Signal an error, making error message by passing all args to `format'.
-In Emacs, the convention is that error messages start with a capital
-letter but *do not* end with a period.  Please follow this convention
-for the sake of consistency."
-  (while t
-    (signal 'error (list (apply 'format args)))))
-
-(defalias 'user-original-login-name 'user-login-name)
-
-(defun start-process-shell-command (name buffer &rest args)
-  "Start a program in a subprocess.  Return the process object for it.
-Args are NAME BUFFER COMMAND &rest COMMAND-ARGS.
-NAME is name for process.  It is modified if necessary to make it unique.
-BUFFER is the buffer or (buffer-name) to associate with the process.
- Process output goes at end of that buffer, unless you specify
- an output stream or filter function to handle the output.
- BUFFER may be also nil, meaning that this process is not associated
- with any buffer
-Third arg is command name, the name of a shell command.
-Remaining arguments are the arguments for the command.
-Wildcards and redirection are handled as usual in the shell."
-  (cond
-   ((eq system-type 'vax-vms)
-    (apply 'start-process name buffer args))
-   ;; We used to use `exec' to replace the shell with the command,
-   ;; but that failed to handle (...) and semicolon, etc.
-   (t
-    (start-process name buffer shell-file-name shell-command-switch
-		   (mapconcat 'identity args " ")))))
-
-(defmacro with-current-buffer (buffer &rest body)
-  "Execute the forms in BODY with BUFFER as the current buffer.
-The value returned is the value of the last form in BODY.
-See also `with-temp-buffer'."
-  `(save-current-buffer
-    (set-buffer ,buffer)
-    ,@body))
-
-(defmacro with-temp-file (file &rest forms)
-  "Create a new buffer, evaluate FORMS there, and write the buffer to FILE.
-The value of the last form in FORMS is returned, like `progn'.
-See also `with-temp-buffer'."
-  (let ((temp-file (make-symbol "temp-file"))
-	(temp-buffer (make-symbol "temp-buffer")))
-    `(let ((,temp-file ,file)
-	   (,temp-buffer
-	    (get-buffer-create (generate-new-buffer-name " *temp file*"))))
-       (unwind-protect
-	   (prog1
-	       (with-current-buffer ,temp-buffer
-		 ,@forms)
-	     (with-current-buffer ,temp-buffer
-	       (widen)
-	       (write-region (point-min) (point-max) ,temp-file nil 0)))
-	 (and (buffer-name ,temp-buffer)
-	      (kill-buffer ,temp-buffer))))))
-
-(defmacro with-temp-buffer (&rest forms)
-  "Create a temporary buffer, and evaluate FORMS there like `progn'.
-See also `with-temp-file' and `with-output-to-string'."
-  (let ((temp-buffer (make-symbol "temp-buffer")))
-    `(let ((,temp-buffer
-	    (get-buffer-create (generate-new-buffer-name " *temp*"))))
-       (unwind-protect
-	   (with-current-buffer ,temp-buffer
-	     ,@forms)
-	 (and (buffer-name ,temp-buffer)
-	      (kill-buffer ,temp-buffer))))))
-
-(defmacro with-output-to-string (&rest body)
-  "Execute BODY, return the text it sent to `standard-output', as a string."
-  `(let ((standard-output
-	  (get-buffer-create (generate-new-buffer-name " *string-output*"))))
-     (let ((standard-output standard-output))
-       ,@body)
-     (with-current-buffer standard-output
-       (prog1
-	   (buffer-string)
-	 (kill-buffer nil)))))
-
-(defmacro combine-after-change-calls (&rest body)
-  "Execute BODY, but don't call the after-change functions till the end.
-If BODY makes changes in the buffer, they are recorded
-and the functions on `after-change-functions' are called several times
-when BODY is finished.
-The return value is rthe value of the last form in BODY.
-
-If `before-change-functions' is non-nil, then calls to the after-change
-functions can't be deferred, so in that case this macro has no effect.
-
-Do not alter `after-change-functions' or `before-change-functions'
-in BODY."
-  `(unwind-protect
-       (let ((combine-after-change-calls t))
-	 . ,body)
-     (combine-after-change-execute)))
-
-
-(defvar save-match-data-internal)
-
-;; We use save-match-data-internal as the local variable because
-;; that works ok in practice (people should not use that variable elsewhere).
-;; We used to use an uninterned symbol; the compiler handles that properly
-;; now, but it generates slower code.
-(defmacro save-match-data (&rest body)
-  "Execute the BODY forms, restoring the global value of the match data."
-  `(let ((save-match-data-internal (match-data)))
-       (unwind-protect
-	   (progn ,@body)
-	 (store-match-data save-match-data-internal))))
-
-(defun match-string (num &optional string)
-  "Return string of text matched by last search.
-NUM specifies which parenthesized expression in the last regexp.
- Value is nil if NUMth pair didn't match, or there were less than NUM pairs.
-Zero means the entire text matched by the whole regexp or whole string.
-STRING should be given if the last search was by `string-match' on STRING."
-  (if (match-beginning num)
-      (if string
-	  (substring string (match-beginning num) (match-end num))
-	(buffer-substring (match-beginning num) (match-end num)))))
-
-(defun split-string (string &optional separators)
-  "Splits STRING into substrings where there are matches for SEPARATORS.
-Each match for SEPARATORS is a splitting point.
-The substrings between the splitting points are made into a list
-which is returned.
-If SEPARATORS is absent, it defaults to \"[ \\f\\t\\n\\r\\v]+\"."
-  (let ((rexp (or separators "[ \f\t\n\r\v]+"))
-	(start 0)
-	(list nil))
-    (while (string-match rexp string start)
-      (or (eq (match-beginning 0) 0)
-	  (setq list
-		(cons (substring string start (match-beginning 0))
-		      list)))
-      (setq start (match-end 0)))
-    (or (eq start (length string))
-	(setq list
-	      (cons (substring string start)
-		    list)))
-    (nreverse list)))
-
-(defun shell-quote-argument (argument)
-  "Quote an argument for passing as argument to an inferior shell."
-  (if (eq system-type 'ms-dos)
-      ;; MS-DOS shells don't have quoting, so don't do any.
-      argument
-    (if (eq system-type 'windows-nt)
-	(concat "\"" argument "\"")
-      ;; Quote everything except POSIX filename characters.
-      ;; This should be safe enough even for really weird shells.
-      (let ((result "") (start 0) end)
-	(while (string-match "[^-0-9a-zA-Z_./]" argument start)
-	  (setq end (match-beginning 0)
-		result (concat result (substring argument start end)
-			       "\\" (substring argument end (1+ end)))
-		start (1+ end)))
-	(concat result (substring argument start))))))
-
-(defun make-syntax-table (&optional oldtable)
-  "Return a new syntax table.
-It inherits all letters and control characters from the standard
-syntax table; other characters are copied from the standard syntax table."
-  (if oldtable
-      (copy-syntax-table oldtable)
-    (let ((table (copy-syntax-table))
-	  i)
-      (setq i 0)
-      (while (<= i 31)
-	(aset table i nil)
-	(setq i (1+ i)))
-      (setq i ?A)
-      (while (<= i ?Z)
-	(aset table i nil)
-	(setq i (1+ i)))
-      (setq i ?a)
-      (while (<= i ?z)
-	(aset table i nil)
-	(setq i (1+ i)))
-      (setq i 128)
-      (while (<= i 255)
-	(aset table i nil)
-	(setq i (1+ i)))
-      table)))
-
-(defun global-set-key (key command)
-  "Give KEY a global binding as COMMAND.
-COMMAND is a symbol naming an interactively-callable function.
-KEY is a key sequence (a string or vector of characters or event types).
-Non-ASCII characters with codes above 127 (such as ISO Latin-1)
-can be included if you use a vector.
-Note that if KEY has a local binding in the current buffer
-that local binding will continue to shadow any global binding."
-  (interactive "KSet key globally: \nCSet key %s to command: ")
-  (or (vectorp key) (stringp key)
-      (signal 'wrong-type-argument (list 'arrayp key)))
-  (define-key (current-global-map) key command)
-  nil)
-
-(defun local-set-key (key command)
-  "Give KEY a local binding as COMMAND.
-COMMAND is a symbol naming an interactively-callable function.
-KEY is a key sequence (a string or vector of characters or event types).
-Non-ASCII characters with codes above 127 (such as ISO Latin-1)
-can be included if you use a vector.
-The binding goes in the current buffer's local map,
-which in most cases is shared with all other buffers in the same major mode."
-  (interactive "KSet key locally: \nCSet key %s locally to command: ")
-  (let ((map (current-local-map)))
-    (or map
-	(use-local-map (setq map (make-sparse-keymap))))
-    (or (vectorp key) (stringp key)
-	(signal 'wrong-type-argument (list 'arrayp key)))
-    (define-key map key command))
-  nil)
-
-(defun global-unset-key (key)
-  "Remove global binding of KEY.
-KEY is a string representing a sequence of keystrokes."
-  (interactive "kUnset key globally: ")
-  (global-set-key key nil))
-
-(defun local-unset-key (key)
-  "Remove local binding of KEY.
-KEY is a string representing a sequence of keystrokes."
-  (interactive "kUnset key locally: ")
-  (if (current-local-map)
-      (local-set-key key nil))
-  nil)
-
-;; We put this here instead of in frame.el so that it's defined even on
-;; systems where frame.el isn't loaded.
-(defun frame-configuration-p (object)
-  "Return non-nil if OBJECT seems to be a frame configuration.
-Any list whose car is `frame-configuration' is assumed to be a frame
-configuration."
-  (and (consp object)
-       (eq (car object) 'frame-configuration)))
-
-;; now in fns.c
-;(defun nth (n list)
-;  "Returns the Nth element of LIST.
-;N counts from zero.  If LIST is not that long, nil is returned."
-;  (car (nthcdr n list)))
-;
-;(defun copy-alist (alist)
-;  "Return a copy of ALIST.
-;This is a new alist which represents the same mapping
-;from objects to objects, but does not share the alist structure with ALIST.
-;The objects mapped (cars and cdrs of elements of the alist)
-;are shared, however."
-;  (setq alist (copy-sequence alist))
-;  (let ((tail alist))
-;    (while tail
-;      (if (consp (car tail))
-;	  (setcar tail (cons (car (car tail)) (cdr (car tail)))))
-;      (setq tail (cdr tail))))
-;  alist)
-
-;;; subr.el ends here
-
diff --git a/lisp/sun-curs.el b/lisp/sun-curs.el
deleted file mode 100644
index 4118bd74c7b..00000000000
--- a/lisp/sun-curs.el
+++ /dev/null
@@ -1,217 +0,0 @@
-;;; sun-curs.el --- cursor definitions for Sun windows
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Jeff Peck <peck@sun.com>
-;; Keywords: hardware
-
-;; 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.
-
-;;; Code:
-
-;;;
-;;; Added some more cursors and moved the hot spots
-;;; Cursor defined by 16 pairs of 16-bit numbers
-;;;
-;;; 9-dec-86 Jeff Peck, Sun Microsystems Inc. <peck@sun.com>
-
-(require 'cl)
-
-(defvar sc::cursors nil "List of known cursors")
-
-(defmacro defcursor (name x y string)
-  (if (not (memq name sc::cursors)) 
-      (setq sc::cursors (cons name sc::cursors)))
-  (list 'defconst name (list 'vector x y string)))
-
-;;; push should be defined in common lisp, but if not use this:
-;(defmacro push (v l)
-;  "The ITEM is evaluated and consed onto LIST, a list-valued atom"
-;  (list 'setq l (list 'cons v l)))
-
-;;;
-;;; The standard default cursor
-;;;
-(defcursor sc:right-arrow 15 0
-  (concat '(0 1 0 3 0 7 0 15 0 31 0 63 0 127 0 15
-	      0 27 0 25 0 48 0 48 0 96 0 96 0 192 0 192)))
-
-;;(sc:set-cursor sc:right-arrow)
-
-(defcursor sc:fat-left-arrow 0 8
-  (concat '(1 0 3 0 7 0 15 0 31 0 63 255 127 255 255 255
-	      255 255 127 255 63 255 31 0 15 0 7 0 3 0 1 0)))
-
-(defcursor sc:box 8 8
-  (concat '(15 252 8 4 8 4 8 4 8 4 8 4 8 4 8 4
-	       8 132 8 4 8 4 8 4 8 4 8 4 8 4 15 252)))
-
-(defcursor sc:hourglass 8 8
-  (concat "\177\376\100\002\040\014\032\070"
-	  "\017\360\007\340\003\300\001\200"
-	  "\001\200\002\100\005\040\010\020"
-	  "\021\210\043\304\107\342\177\376"))
-
-(defun sc:set-cursor (icon)
-  "Change the Sun mouse cursor to ICON.
-If ICON is nil, switch to the system default cursor,
-Otherwise, ICON should be a vector or the name of a vector of [x y 32-chars]"
-  (interactive "XIcon Name: ")
-  (if (symbolp icon) (setq icon (symbol-value icon)))
-  (sun-change-cursor-icon icon))
-
-(make-local-variable '*edit-icon*)
-(make-variable-buffer-local 'icon-edit)
-(setq-default icon-edit nil)
-(or (assq 'icon-edit minor-mode-alist)
-    (push '(icon-edit " IconEdit") minor-mode-alist))
-
-(defun sc:edit-cursor (icon)
-  "convert icon to rectangle, edit, and repack"
-  (interactive "XIcon Name: ")
-  (if (not icon) (setq icon (sc::menu-choose-cursor (selected-window) 1 1)))
-  (if (symbolp icon) (setq icon (symbol-value icon)))
-  (if (get-buffer "icon-edit") (kill-buffer "icon-edit"))
-  (switch-to-buffer "icon-edit")
-  (local-set-mouse '(text right) 'sc::menu-function)
-  (local-set-mouse '(text left) '(sc::pic-ins-at-mouse 32))
-  (local-set-mouse '(text middle) '(sc::pic-ins-at-mouse 64))
-  (local-set-mouse '(text left middle) 'sc::hotspot)
-  (sc::display-icon icon)
-  (picture-mode)
-  (setq icon-edit t)	; for mode line display
-)
-
-(defun sc::pic-ins-at-mouse (char)
-  "Picture insert char at mouse location"
-  (mouse-move-point *mouse-window* (min 15 *mouse-x*) (min 15 *mouse-y*))
-  (move-to-column (1+ (min 15 (current-column))) t)
-  (delete-char -1)
-  (insert char)
-  (sc::goto-hotspot))
-    
-(defun sc::menu-function (window x y)
-  (sun-menu-evaluate window (1+ x) y sc::menu))
-
-(defmenu sc::menu
-  ("Cursor Menu")
-  ("Pack & Use" sc::pack-buffer-to-cursor)
-  ("Pack to Icon" sc::pack-buffer-to-icon 
-		  (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
-  ("New Icon" call-interactively 'sc::make-cursor)
-  ("Edit Icon" sc:edit-cursor 
-	       (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
-  ("Set Cursor" sc:set-cursor
-		(sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) 
-  ("Reset Cursor" sc:set-cursor nil)
-  ("Help" sc::edit-icon-help-menu)
-  ("Quit" sc::quit-edit)
-  )
-
-(defun sc::quit-edit ()
-  (interactive)
-  (bury-buffer (current-buffer))
-  (switch-to-buffer (other-buffer) 'no-record))
-
-(defun sc::make-cursor (symbol)
-  (interactive "SIcon Name: ")
-  (eval (list 'defcursor symbol 0 0 ""))
-  (sc::pack-buffer-to-icon (symbol-value symbol)))
-
-(defmenu sc::edit-icon-help-menu
-  ("Simple Icon Editor")
-  ("Left     => CLEAR")
-  ("Middle   => SET")
-  ("L & M    => HOTSPOT")
-  ("Right    => MENU"))
-
-(defun sc::edit-icon-help ()
-  (message "Left=> CLEAR  Middle=> SET  Left+Middle=> HOTSPOT  Right=> MENU"))
-
-(defun sc::pack-buffer-to-cursor ()
-    (sc::pack-buffer-to-icon *edit-icon*)
-    (sc:set-cursor *edit-icon*))
-
-(defun sc::menu-choose-cursor (window x y)
-  "Presents a menu of cursor names, and returns one or nil"
-  (let ((curs sc::cursors) 
-	(items))
-    (while curs
-      (push (sc::menu-item-for-cursor (car curs)) items)
-      (setq curs (cdr curs)))
-    (push (list "Choose Cursor") items)
-    (setq menu (menu-create items))
-    (sun-menu-evaluate window x y menu)))
-
-(defun sc::menu-item-for-cursor (cursor)
-  "apply function to selected cursor"
-  (list (symbol-name cursor) 'quote cursor))
-
-(defun sc::hotspot (window x y)
-  (aset *edit-icon* 0 x)
-  (aset *edit-icon* 1 y)
-  (sc::goto-hotspot))
-
-(defun sc::goto-hotspot ()
-  (goto-line (1+ (aref *edit-icon* 1)))
-  (move-to-column (aref *edit-icon* 0)))
-
-(defun sc::display-icon (icon)
-  (setq *edit-icon* (copy-sequence icon))
-  (let ((string (aref *edit-icon* 2))
-	(index 0))
-    (while (< index 32)
-      (let ((char (aref string index))
-	    (bit 128))
-	(while (> bit 0)
-	  (insert (sc::char-at-bit char bit))
-	  (setq bit (lsh bit -1))))
-      (if (eq 1 (% index 2)) (newline))
-      (setq index (1+ index))))
-  (sc::goto-hotspot))
-
-(defun sc::char-at-bit (char bit)
-  (if (> (logand char bit) 0) "@" " "))
-
-(defun sc::pack-buffer-to-icon (icon)
-  "Pack 16 x 16 field into icon string"
-  (goto-char (point-min))
-  (aset icon 0 (aref *edit-icon* 0))
-  (aset icon 1 (aref *edit-icon* 1))
-  (aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" ""))
-  (sc::goto-hotspot)
-  )
-  
-(defun sc::pack-one-line (dummy)
-  (let* (char chr1 chr2)
-    (setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char)
-    (setq char 0 chr2 (mapconcat 'sc::pack-one-char "12345678" "") chr2 char)
-    (forward-line 1)
-    (concat (char-to-string chr1) (char-to-string chr2))
-    ))
-
-(defun sc::pack-one-char (dummy)
-  "pack following char into char, unless eolp"
-  (if (or (eolp) (char-equal (following-char) 32))
-      (setq char (lsh char 1)) 
-    (setq char (1+ (lsh char 1))))
-  (if (not (eolp))(forward-char)))
-
-(provide 'sm-cursors)
-
-;;; sun-curs.el ends here
diff --git a/lisp/sun-fns.el b/lisp/sun-fns.el
deleted file mode 100644
index 0dce106b845..00000000000
--- a/lisp/sun-fns.el
+++ /dev/null
@@ -1,642 +0,0 @@
-;;; sun-fns.el --- subroutines of Mouse handling for Sun windows
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Jeff Peck <peck@sun.com>
-;; Keywords: hardware
-
-;; 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:
-
-;; Submitted Mar. 1987, Jeff Peck
-;;		 	 Sun Microsystems Inc. <peck@sun.com>
-;; Conceived Nov. 1986, Stan Jefferson,
-;;                      Computer Science Lab, SRI International.
-;; GoodIdeas Feb. 1987, Steve Greenbaum
-;; & UpClicks           Reasoning Systems, Inc.
-;;
-;;
-;; Functions for manipulating via the mouse and mouse-map definitions
-;; for accessing them.  Also definitions of mouse menus.
-;; This file you should freely modify to reflect you personal tastes.
-;;
-;; First half of file defines functions to implement mouse commands,
-;; Don't delete any of those, just add what ever else you need.
-;; Second half of file defines mouse bindings, do whatever you want there.
-
-;;
-;;         Mouse Functions.
-;;
-;; These functions follow the sun-mouse-handler convention of being called
-;; with three arguments: (window x-pos y-pos)
-;; This makes it easy for a mouse executed command to know where the mouse is.
-;; Use the macro "eval-in-window" to execute a function 
-;; in a temporarily selected window.
-;;
-;; If you have a function that must be called with other arguments
-;; bind the mouse button to an s-exp that contains the necessary parameters.
-;; See "minibuffer" bindings for examples.
-;;
-
-;;; Code:
-
-(require 'sun-mouse)
-
-(defconst cursor-pause-milliseconds 300
-  "*Number of milliseconds to display alternate cursor (usually the mark)")
-
-(defun indicate-region (&optional pause)
-  "Bounce cursor to mark for cursor-pause-milliseconds and back again"
-  (or pause (setq pause cursor-pause-milliseconds))
-  (let ((point (point)))
-    (goto-char (mark))
-    (sit-for-millisecs pause)
-    ;(update-display)
-    ;(sleep-for-millisecs pause)
-    (goto-char point)))
-
-
-;;;
-;;; Text buffer operations
-;;;
-(defun mouse-move-point (window x y)
-  "Move point to mouse cursor."
-  (select-window window)
-  (move-to-loc x y)
-  (if (memq last-command	; support the mouse-copy/delete/yank
-	    '(mouse-copy mouse-delete mouse-yank-move))
-      (setq this-command 'mouse-yank-move))
-  )
-
-(defun mouse-set-mark (window x y)
-  "Set mark at mouse cursor."
-  (eval-in-window window	;; use this to get the unwind protect
-    (let ((point (point)))
-      (move-to-loc x y)
-      (set-mark (point))
-      (goto-char point)
-      (indicate-region)))
-  )
-
-(defun mouse-set-mark-and-select (window x y)
-  "Set mark at mouse cursor, and select that window."
-  (select-window window)
-  (mouse-set-mark window x y)
-  )
-
-(defun mouse-set-mark-and-stuff (w x y)
-  "Set mark at mouse cursor, and put region in stuff buffer."
-  (mouse-set-mark-and-select w x y)
-  (sun-select-region (region-beginning) (region-end)))
-
-;;;
-;;; Simple mouse dragging stuff: marking with button up
-;;;
-
-(defvar *mouse-drag-window* nil)
-(defvar *mouse-drag-x* -1)
-(defvar *mouse-drag-y* -1)
-
-(defun mouse-drag-move-point (window x y)
-  "Move point to mouse cursor, and allow dragging."
-  (mouse-move-point window x y)
-  (setq *mouse-drag-window* window
-	*mouse-drag-x* x
-	*mouse-drag-y* y))
-
-(defun mouse-drag-set-mark-stuff (window x y)
-  "The up click handler that goes with mouse-drag-move-point.
-If mouse is in same WINDOW but at different X or Y than when
-mouse-drag-move-point was last executed, set the mark at mouse
-and put the region in the stuff buffer."
-  (if (and (eq *mouse-drag-window* window)
-	   (not (and (equal *mouse-drag-x* x)
-		     (equal *mouse-drag-y* y))))
-      (mouse-set-mark-and-stuff window x y)
-    (setq this-command last-command))	; this was just an upclick no-op.
-  )
-
-(defun mouse-select-or-drag-move-point (window x y)
-  "Select window if not selected, otherwise do mouse-drag-move-point."
-  (if (eq (selected-window) window)
-      (mouse-drag-move-point window x y)
-    (mouse-select-window window x y)))
-
-;;;
-;;; esoterica:
-;;;
-(defun mouse-exch-pt-and-mark (window x y)
-  "Exchange point and mark."
-  (select-window window)
-  (exchange-point-and-mark)
-  )
-
-(defun mouse-call-kbd-macro (window x y)
-  "Invokes last keyboard macro at mouse cursor."
-  (mouse-move-point window x y)
-  (call-last-kbd-macro)
-  )
-
-(defun mouse-mark-thing (window x y)
-  "Set point and mark to text object using syntax table.
-The resulting region is put in the sun-window stuff buffer.
-Left or right Paren syntax marks an s-expression.  
-Clicking at the end of a line marks the line including a trailing newline.  
-If it doesn't recognize one of these it marks the character at point."
-  (mouse-move-point window x y)
-  (if (eobp) (open-line 1))
-  (let* ((char (char-after (point)))
-         (syntax (char-syntax char)))
-    (cond
-     ((eq syntax ?w)			; word.
-      (forward-word 1)
-      (set-mark (point))
-      (forward-word -1))
-     ;; try to include a single following whitespace (is this a good idea?)
-     ;; No, not a good idea since inconsistent.
-     ;;(if (eq (char-syntax (char-after (mark))) ?\ )
-     ;;    (set-mark (1+ (mark))))
-     ((eq syntax ?\( )			; open paren.
-      (mark-sexp 1))
-     ((eq syntax ?\) )			; close paren.
-      (forward-char 1)
-      (mark-sexp -1)
-      (exchange-point-and-mark))
-     ((eolp)				; mark line if at end.
-      (set-mark (1+ (point)))
-      (beginning-of-line 1))
-     (t					; mark character
-      (set-mark (1+ (point)))))
-    (indicate-region))			; display region boundary.
-  (sun-select-region (region-beginning) (region-end))
-  )
-
-(defun mouse-kill-thing (window x y)
-  "Kill thing at mouse, and put point there."
-  (mouse-mark-thing window x y)
-  (kill-region-and-unmark (region-beginning) (region-end))
-  )
-
-(defun mouse-kill-thing-there (window x y)
-  "Kill thing at mouse, leave point where it was.
-See mouse-mark-thing for a description of the objects recognized."
-  (eval-in-window window 
-    (save-excursion
-      (mouse-mark-thing window x y)
-      (kill-region (region-beginning) (region-end))))
-  )
-
-(defun mouse-save-thing (window x y &optional quiet)
-  "Put thing at mouse in kill ring.
-See mouse-mark-thing for a description of the objects recognized."
-  (mouse-mark-thing window x y)
-  (copy-region-as-kill (region-beginning) (region-end))
-  (if (not quiet) (message "Thing saved"))
-  )
-
-(defun mouse-save-thing-there (window x y &optional quiet)
-  "Put thing at mouse in kill ring, leave point as is.
-See mouse-mark-thing for a description of the objects recognized."
-  (eval-in-window window
-    (save-excursion
-      (mouse-save-thing window x y quiet))))
-
-;;;
-;;; Mouse yanking...
-;;;
-(defun mouse-copy-thing (window x y)
-  "Put thing at mouse in kill ring, yank to point.
-See mouse-mark-thing for a description of the objects recognized."
-  (setq last-command 'not-kill)	 ;Avoids appending to previous kills.
-  (mouse-save-thing-there window x y t)
-  (yank)
-  (setq this-command 'yank))
-
-(defun mouse-move-thing (window x y)
-  "Kill thing at mouse, yank it to point.
-See mouse-mark-thing for a description of the objects recognized."
-  (setq last-command 'not-kill)	 ;Avoids appending to previous kills.
-  (mouse-kill-thing-there window x y)
-  (yank)
-  (setq this-command 'yank))
-
-(defun mouse-yank-at-point (&optional window x y)
-  "Yank from kill-ring at point; then cycle thru kill ring."
-  (if (eq last-command 'yank)
-      (let ((before (< (point) (mark))))
-	(delete-region (point) (mark))
-	(insert (current-kill 1))
-	(if before (exchange-point-and-mark)))
-    (yank))
-  (setq this-command 'yank))
-
-(defun mouse-yank-at-mouse (window x y)
-  "Yank from kill-ring at mouse; then cycle thru kill ring."
-  (mouse-move-point window x y)
-  (mouse-yank-at-point window x y))
-
-(defun mouse-save/delete/yank (&optional window x y)
-  "Context sensitive save/delete/yank.
-Consecutive clicks perform as follows:
-    * first click saves region to kill ring,
-    * second click kills region,
-    * third click yanks from kill ring,
-    * subsequent clicks cycle thru kill ring.
-If mouse-move-point is performed after the first or second click,
-the next click will do a yank, etc.  Except for a possible mouse-move-point,
-this command is insensitive to mouse location."
-  (cond
-   ((memq last-command '(mouse-delete yank mouse-yank-move))	; third+ click
-    (mouse-yank-at-point))
-   ((eq last-command 'mouse-copy)	; second click
-    (kill-region (region-beginning) (region-end))
-    (setq this-command 'mouse-delete))
-   (t					; first click
-    (copy-region-as-kill (region-beginning) (region-end))
-    (message "Region saved")
-    (setq this-command 'mouse-copy))
-   ))
-
-
-(defun mouse-split-horizontally (window x y)
-  "Splits the window horizontally at mouse cursor."
-  (eval-in-window window (split-window-horizontally (1+ x))))
-
-(defun mouse-split-vertically (window x y)
-  "Split the window vertically at the mouse cursor."
-  (eval-in-window window (split-window-vertically (1+ y))))
-
-(defun mouse-select-window (window x y)
-  "Selects the window, restoring point."
-  (select-window window))
-
-(defun mouse-delete-other-windows (window x y)
-  "Deletes all windows except the one mouse is in."
-  (delete-other-windows window))
-
-(defun mouse-delete-window (window x y)
-  "Deletes the window mouse is in."
-  (delete-window window))
-
-(defun mouse-undo (window x y)
-  "Invokes undo in the window mouse is in."
-  (eval-in-window window (undo)))
-
-;;;
-;;; Scroll operations
-;;;
-
-;;; The move-to-window-line is used below because otherwise
-;;; scrolling a non-selected process window with the mouse, after
-;;; the process has written text past the bottom of the window,
-;;; gives an "End of buffer" error, and then scrolls.  The
-;;; move-to-window-line seems to force recomputing where things are.
-(defun mouse-scroll-up (window x y)
-  "Scrolls the window upward."
-  (eval-in-window window (move-to-window-line 1) (scroll-up nil)))
-
-(defun mouse-scroll-down (window x y)
-  "Scrolls the window downward."
-  (eval-in-window window (scroll-down nil)))
-
-(defun mouse-scroll-proportional (window x y)
-  "Scrolls the window proportionally corresponding to window
-relative X divided by window width."
-  (eval-in-window window 
-    (if (>= x (1- (window-width)))
-	;; When x is maximum (equal to or 1 less than window width),
-	;; goto end of buffer.  We check for this special case
-	;; because the calculated goto-char often goes short of the
-	;; end due to roundoff error, and we often really want to go
-	;; to the end.
-	(goto-char (point-max))
-      (progn
-	(goto-char (+ (point-min)	; For narrowed regions.
-		      (* x (/ (- (point-max) (point-min))
-			      (1- (window-width))))))
-	(beginning-of-line))
-      )
-    (what-cursor-position)		; Report position.
-    ))
-
-(defun mouse-line-to-top (window x y)
-  "Scrolls the line at the mouse cursor up to the top."
-  (eval-in-window window (scroll-up y)))
-
-(defun mouse-top-to-line (window x y)
-  "Scrolls the top line down to the mouse cursor."
-  (eval-in-window window (scroll-down y)))
-
-(defun mouse-line-to-bottom (window x y)
-  "Scrolls the line at the mouse cursor to the bottom."
-  (eval-in-window window (scroll-up (+ y (- 2 (window-height))))))
-
-(defun mouse-bottom-to-line (window x y)
-  "Scrolls the bottom line up to the mouse cursor."
-  (eval-in-window window (scroll-down (+ y (- 2 (window-height))))))
-
-(defun mouse-line-to-middle (window x y)
-  "Scrolls the line at the mouse cursor to the middle."
-  (eval-in-window window (scroll-up (- y -1 (/ (window-height) 2)))))
-
-(defun mouse-middle-to-line (window x y)
-  "Scrolls the line at the middle to the mouse cursor."
-  (eval-in-window window (scroll-up (- (/ (window-height) 2) y 1))))
-
-
-;;;
-;;; main emacs menu.
-;;;
-(defmenu expand-menu
-  ("Vertically" mouse-expand-vertically *menu-window*)
-  ("Horizontally" mouse-expand-horizontally *menu-window*))
-
-(defmenu delete-window-menu
-  ("This One" delete-window *menu-window*)
-  ("All Others" delete-other-windows *menu-window*))
-
-(defmenu mouse-help-menu
-  ("Text Region"
-   mouse-help-region *menu-window* *menu-x* *menu-y* 'text)
-  ("Scrollbar"
-   mouse-help-region *menu-window* *menu-x* *menu-y* 'scrollbar)
-  ("Modeline"
-   mouse-help-region *menu-window* *menu-x* *menu-y* 'modeline)
-  ("Minibuffer"
-   mouse-help-region *menu-window* *menu-x* *menu-y* 'minibuffer)
-  )
-  
-(defmenu emacs-quit-menu
-  ("Suspend" suspend-emacstool)
-  ("Quit" save-buffers-kill-emacs))
-
-(defmenu emacs-menu
-  ("Emacs Menu")
-  ("Stuff Selection" sun-yank-selection)
-  ("Expand" . expand-menu)
-  ("Delete Window" . delete-window-menu)
-  ("Previous Buffer" mouse-select-previous-buffer *menu-window*)
-  ("Save Buffers" save-some-buffers)
-  ("List Directory" list-directory nil)
-  ("Dired" dired nil)
-  ("Mouse Help" . mouse-help-menu)
-  ("Quit" . emacs-quit-menu))
-
-(defun emacs-menu-eval (window x y)
-  "Pop-up menu of editor commands."
-  (sun-menu-evaluate window (1+ x) (1- y) 'emacs-menu))
-
-(defun mouse-expand-horizontally (window)
-  (eval-in-window window
-    (enlarge-window 4 t)
-    (update-display)		; Try to redisplay, since can get confused.
-    ))
-
-(defun mouse-expand-vertically (window)
-  (eval-in-window window (enlarge-window 4)))
-
-(defun mouse-select-previous-buffer (window)
-  "Switch buffer in mouse window to most recently selected buffer."
-  (eval-in-window window (switch-to-buffer (other-buffer))))
-
-;;;
-;;; minibuffer menu
-;;;
-(defmenu minibuffer-menu 
-  ("Minibuffer" message "Just some miscellaneous minibuffer commands")
-  ("Stuff" sun-yank-selection)
-  ("Do-It" exit-minibuffer)
-  ("Abort" abort-recursive-edit)
-  ("Suspend" suspend-emacs))
-
-(defun minibuffer-menu-eval (window x y)
-  "Pop-up menu of commands."
-  (sun-menu-evaluate window x (1- y) 'minibuffer-menu))
-
-(defun mini-move-point (window x y)
-  ;; -6 is good for most common cases
-  (mouse-move-point window (- x 6) 0))
-
-(defun mini-set-mark-and-stuff (window x y)
-  ;; -6 is good for most common cases
-  (mouse-set-mark-and-stuff window (- x 6) 0))
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
-;;; Buffer-mode Mouse commands
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
-
-(defun Buffer-at-mouse (w x y)
-  "Calls Buffer-menu-buffer from mouse click."
-  (save-window-excursion 
-    (mouse-move-point w x y)
-    (beginning-of-line)
-    (Buffer-menu-buffer t)))
-
-(defun mouse-buffer-bury (w x y)
-  "Bury the indicated buffer."
-  (bury-buffer (Buffer-at-mouse w x y))
-  )
-
-(defun mouse-buffer-select (w x y)
-  "Put the indicated buffer in selected window."
-  (switch-to-buffer (Buffer-at-mouse w x y))
-  (list-buffers)
-  )
-
-(defun mouse-buffer-delete (w x y)
-  "mark indicated buffer for delete"
-  (save-window-excursion
-    (mouse-move-point w x y)
-    (Buffer-menu-delete)
-    ))
-
-(defun mouse-buffer-execute (w x y)
-  "execute buffer-menu selections"
-  (save-window-excursion
-    (mouse-move-point w x y)
-    (Buffer-menu-execute)
-    ))
-  
-(defun enable-mouse-in-buffer-list ()
-  "Call this to enable mouse selections in *Buffer List*
-    LEFT puts the indicated buffer in the selected window.
-    MIDDLE buries the indicated buffer.
-    RIGHT marks the indicated buffer for deletion.
-    MIDDLE-RIGHT deletes the marked buffers.
-To unmark a buffer marked for deletion, select it with LEFT."
-  (save-window-excursion
-    (list-buffers)			; Initialize *Buffer List*
-    (set-buffer "*Buffer List*")
-    (local-set-mouse '(text middle) 'mouse-buffer-bury)
-    (local-set-mouse '(text left) 'mouse-buffer-select)	    
-    (local-set-mouse '(text right) 'mouse-buffer-delete)
-    (local-set-mouse '(text middle right) 'mouse-buffer-execute)
-    )
-  )
-
-
-;;;*******************************************************************
-;;;
-;;;           Global Mouse Bindings.
-;;;
-;;; There is some sense to this mouse binding madness:
-;;; LEFT and RIGHT scrolls are inverses.
-;;; SHIFT makes an opposite meaning in the scroll bar.
-;;; SHIFT is an alternative to DOUBLE (but double chords do not exist).
-;;; META makes the scrollbar functions work in the text region.
-;;; MIDDLE operates the mark
-;;; LEFT operates at point
-
-;;; META commands are generally non-destructive,
-;;; SHIFT is a little more dangerous.
-;;; CONTROL is for the really complicated ones.
-
-;;; CONTROL-META-SHIFT-RIGHT gives help on that region.
-
-;;;
-;;; Text Region mousemap
-;;;
-;; The basics: Point, Mark, Menu, Sun-Select:
-(global-set-mouse '(text        left)	'mouse-drag-move-point)
-(global-set-mouse '(text     up left)	'mouse-drag-set-mark-stuff)
-(global-set-mouse '(text shift  left)	'mouse-exch-pt-and-mark)
-(global-set-mouse '(text double left)	'mouse-exch-pt-and-mark)
-
-(global-set-mouse '(text	middle)	'mouse-set-mark-and-stuff)
-
-(global-set-mouse '(text	right)	'emacs-menu-eval)
-(global-set-mouse '(text shift	right)	'(sun-yank-selection))
-(global-set-mouse '(text double	right)	'(sun-yank-selection))
-
-;; The Slymoblics multi-command for Save, Kill, Copy, Move:
-(global-set-mouse '(text shift	middle)	'mouse-save/delete/yank)
-(global-set-mouse '(text double	middle)	'mouse-save/delete/yank)
-
-;; Save, Kill, Copy, Move Things:
-;; control-left composes with control middle/right to produce copy/move
-(global-set-mouse '(text control middle	    )	'mouse-save-thing-there)
-(global-set-mouse '(text control right      )	'mouse-kill-thing-there)
-(global-set-mouse '(text control 	left)	'mouse-yank-at-point)
-(global-set-mouse '(text control middle	left)	'mouse-copy-thing)
-(global-set-mouse '(text control right	left)	'mouse-move-thing)
-(global-set-mouse '(text control right middle)	'mouse-mark-thing)
-
-;; The Universal mouse help command (press all buttons):
-(global-set-mouse '(text shift  control meta right)	'mouse-help-region)
-(global-set-mouse '(text double control meta right)	'mouse-help-region)
-
-;;; Meta in Text Region is like meta version in scrollbar:
-(global-set-mouse '(text meta        left)	'mouse-line-to-top)
-(global-set-mouse '(text meta shift  left)	'mouse-line-to-bottom)
-(global-set-mouse '(text meta double left)	'mouse-line-to-bottom)
-(global-set-mouse '(text meta         middle)	'mouse-line-to-middle)
-(global-set-mouse '(text meta shift   middle)	'mouse-middle-to-line)
-(global-set-mouse '(text meta double  middle)	'mouse-middle-to-line)
-(global-set-mouse '(text meta control middle)	'mouse-split-vertically)
-(global-set-mouse '(text meta        right)	'mouse-top-to-line)
-(global-set-mouse '(text meta shift  right)	'mouse-bottom-to-line)
-(global-set-mouse '(text meta double right)	'mouse-bottom-to-line)
-
-;; Miscellaneous:
-(global-set-mouse '(text meta control left)	'mouse-call-kbd-macro)
-(global-set-mouse '(text meta control right)	'mouse-undo)
-
-;;;
-;;; Scrollbar mousemap.
-;;; Are available in the Scrollbar Region, or with Meta Text (or Meta Scrollbar)
-;;;
-(global-set-mouse '(scrollbar        left)	'mouse-line-to-top)
-(global-set-mouse '(scrollbar shift  left)	'mouse-line-to-bottom)
-(global-set-mouse '(scrollbar double left)	'mouse-line-to-bottom)
-
-(global-set-mouse '(scrollbar         middle)	'mouse-line-to-middle)
-(global-set-mouse '(scrollbar shift   middle)	'mouse-middle-to-line)
-(global-set-mouse '(scrollbar double  middle)	'mouse-middle-to-line)
-(global-set-mouse '(scrollbar control middle)	'mouse-split-vertically)
-
-(global-set-mouse '(scrollbar        right)	'mouse-top-to-line)
-(global-set-mouse '(scrollbar shift  right)	'mouse-bottom-to-line)
-(global-set-mouse '(scrollbar double right)	'mouse-bottom-to-line)
-
-(global-set-mouse '(scrollbar meta        left)		'mouse-line-to-top)
-(global-set-mouse '(scrollbar meta shift  left)		'mouse-line-to-bottom)
-(global-set-mouse '(scrollbar meta double left)		'mouse-line-to-bottom)
-(global-set-mouse '(scrollbar meta         middle)	'mouse-line-to-middle)
-(global-set-mouse '(scrollbar meta shift   middle)	'mouse-middle-to-line)
-(global-set-mouse '(scrollbar meta double  middle)	'mouse-middle-to-line)
-(global-set-mouse '(scrollbar meta control middle)	'mouse-split-vertically)
-(global-set-mouse '(scrollbar meta        right)	'mouse-top-to-line)
-(global-set-mouse '(scrollbar meta shift  right)	'mouse-bottom-to-line)
-(global-set-mouse '(scrollbar meta double right)	'mouse-bottom-to-line)
-
-;; And the help menu:
-(global-set-mouse '(scrollbar shift  control meta right) 'mouse-help-region)
-(global-set-mouse '(scrollbar double control meta right) 'mouse-help-region)
-
-;;;
-;;; Modeline mousemap.
-;;;
-;;; Note: meta of any single button selects window.
-
-(global-set-mouse '(modeline      left)	'mouse-scroll-up)
-(global-set-mouse '(modeline meta left)	'mouse-select-window)
-
-(global-set-mouse '(modeline         middle)	'mouse-scroll-proportional)
-(global-set-mouse '(modeline meta    middle)	'mouse-select-window)
-(global-set-mouse '(modeline control middle)	'mouse-split-horizontally)
-
-(global-set-mouse '(modeline      right)	'mouse-scroll-down)
-(global-set-mouse '(modeline meta right)	'mouse-select-window)
-
-;;; control-left selects this window, control-right deletes it.
-(global-set-mouse '(modeline control left)	'mouse-delete-other-windows)
-(global-set-mouse '(modeline control right)	'mouse-delete-window)
-
-;; in case of confusion, just select it:
-(global-set-mouse '(modeline control left right)'mouse-select-window)
-
-;; even without confusion (and without the keyboard) select it:
-(global-set-mouse '(modeline left right)	'mouse-select-window)
-
-;; And the help menu:
-(global-set-mouse '(modeline shift  control meta right)	'mouse-help-region)
-(global-set-mouse '(modeline double control meta right)	'mouse-help-region)
-
-;;;
-;;; Minibuffer Mousemap
-;;; Demonstrating some variety:
-;;;
-(global-set-mouse '(minibuffer left)		'mini-move-point)
-
-(global-set-mouse '(minibuffer         middle)	'mini-set-mark-and-stuff)
-
-(global-set-mouse '(minibuffer shift   middle) '(select-previous-complex-command))
-(global-set-mouse '(minibuffer double  middle) '(select-previous-complex-command))
-(global-set-mouse '(minibuffer control middle) '(next-complex-command 1))
-(global-set-mouse '(minibuffer meta    middle) '(previous-complex-command 1))
-
-(global-set-mouse '(minibuffer right)	'minibuffer-menu-eval)
-
-(global-set-mouse '(minibuffer shift  control meta right)  'mouse-help-region)
-(global-set-mouse '(minibuffer double control meta right)  'mouse-help-region)
-
-(provide 'sun-fns)
-
-;;; sun-fns.el ends here
diff --git a/lisp/tabify.el b/lisp/tabify.el
deleted file mode 100644
index c5d76fcc211..00000000000
--- a/lisp/tabify.el
+++ /dev/null
@@ -1,75 +0,0 @@
-;;; tabify.el --- tab conversion commands for Emacs
-
-;; Copyright (C) 1985, 1994 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:
-
-;; Commands to optimize spaces to tabs or expand tabs to spaces in a region
-;; (`tabify' and `untabify').  The variable tab-width does the obvious.
-
-;;; Code:
-
-;;;###autoload
-(defun untabify (start end)
-  "Convert all tabs in region to multiple spaces, preserving columns.
-Called non-interactively, the region is specified by arguments
-START and END, rather than by the position of point and mark.
-The variable `tab-width' controls the spacing of tab stops."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      (narrow-to-region (point-min) end)
-      (goto-char start)
-      (while (search-forward "\t" nil t)	; faster than re-search
-	(let ((tab-beg (point))
-	      (column (current-column))
-	      (indent-tabs-mode nil))
-	  (skip-chars-backward "\t" start)
-	  (delete-region tab-beg (point))
-	  (indent-to column))))))
-
-;;;###autoload
-(defun tabify (start end)
-  "Convert multiple spaces in region to tabs when possible.
-A group of spaces is partially replaced by tabs
-when this can be done without changing the column they end at.
-Called non-interactively, the region is specified by arguments
-START and END, rather than by the position of point and mark.
-The variable `tab-width' controls the spacing of tab stops."
-  (interactive "r")
-  (save-excursion
-    (save-restriction
-      ;; Include the beginning of the line in the narrowing
-      ;; since otherwise it will throw off current-column.
-      (goto-char start)
-      (beginning-of-line)
-      (narrow-to-region (point) end)
-      (goto-char start)
-      (while (re-search-forward "[ \t][ \t][ \t]*" nil t)
-	(let ((column (current-column))
-	      (indent-tabs-mode t))
-	  (delete-region (match-beginning 0) (point))
-	  (indent-to column))))))
-
-(provide 'tabify)
-
-;;; tabify.el ends here
diff --git a/lisp/talk.el b/lisp/talk.el
deleted file mode 100644
index 0baedeb301e..00000000000
--- a/lisp/talk.el
+++ /dev/null
@@ -1,101 +0,0 @@
-;;; talk.el --- Allow several users to talk to each other through Emacs.
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Keywords: comm, frames
-
-;; 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 is a multi-user talk package that runs in Emacs.
-;; Use talk-connect to bring a new person into the conversation.
-
-;;; Code:
-
-(defvar talk-display-alist nil
-  "Alist of displays on which Emacs talk is now running.
-Each element has the form (DISPLAY FRAME BUFFER).")
-
-;;;###autoload
-(defun talk-connect (display)
-  "Connect to display DISPLAY for the Emacs talk group."
-  (interactive "sTalk to display: ")
-  ;; Make sure we have an entry for the current display.
-  (let ((mydisp (cdr (assq 'display (frame-parameters (selected-frame))))))
-    (talk-add-display mydisp))
-  ;; Make sure we have an entry for the specified display.
-  (talk-add-display display)
-  ;; Add the new buffers to all talk frames.
-  (talk-update-buffers))
-
-(defun talk-add-display (display)
-  (let* ((elt (assoc display talk-display-alist))
-	 (name (concat "*talk-" display "*"))
-	 buffer frame)
-    (if (not (and elt (frame-live-p (setq frame (nth 1 elt)))))
-	(setq frame (make-frame-on-display display (list (cons 'name name)))))
-    (if (not (and elt (buffer-name (get-buffer (setq buffer (nth 2 elt))))))
-	(setq buffer (get-buffer-create name)))
-    (setq talk-display-alist
-	  (cons (list display frame buffer) (delq elt talk-display-alist)))))
-
-(defun talk-disconnect ()
-  "Disconnect this display from the Emacs talk group."
-  (interactive)
-  (let* ((mydisp (cdr (assq 'display (frame-parameters (selected-frame)))))
-	 (elt (assoc mydisp talk-display-alist)))
-    (delete-frame (nth 1 elt))
-    (kill-buffer (nth 2 elt))
-    (setq talk-display-alist (delq elt talk-display-alist))
-    (talk-update-buffers)))
-
-(defun talk-update-buffers ()
-  "Update all the talk frames so that each shows all the talk buffers."
-  (let ((tail talk-display-alist))
-    (while tail
-      (let ((frame (nth 1 (car tail)))
-	    (this-buffer (nth 2 (car tail)))
-	    (buffers
-	     (mapcar (function (lambda (elt) (nth 2 elt)))
-		     talk-display-alist)))
-	;; Put this display's own talk buffer
-	;; at the front of the list.
-	(setq buffers (cons this-buffer (delq this-buffer buffers)))
-	(talk-split-up-frame frame buffers))
-      (setq tail (cdr tail)))))
-
-(defun talk-split-up-frame (frame buffers)
-  "Split FRAME into equal-sized windows displaying the buffers in BUFFERS.
-Select the first of these windows, displaying the first of the buffers."
-  (let ((lines-per-buffer (/ (frame-height frame) (length buffers)))
-	(old-frame (selected-frame)))
-    (unwind-protect
-	(progn
-	  (select-frame frame)
-	  (select-window (frame-first-window frame))
-	  (delete-other-windows)
-	  (while (progn
-		   (switch-to-buffer (car buffers))
-		   (setq buffers (cdr buffers)))
-	    (split-window-vertically lines-per-buffer)
-	    (other-window 1))
-	  (select-window (frame-first-window frame)))
-      (select-frame old-frame))))
-
-;;; talk.el ends here
diff --git a/lisp/tar-mode.el b/lisp/tar-mode.el
deleted file mode 100644
index 5776680d6cb..00000000000
--- a/lisp/tar-mode.el
+++ /dev/null
@@ -1,1207 +0,0 @@
-;;; tar-mode.el --- simple editing of tar files from GNU emacs
-
-;; Copyright (C) 1990, 1991, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Jamie Zawinski <jwz@lucid.com>
-;; Created: 04 Apr 1990
-;; Keywords: unix
-
-;; 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 attempts to make dealing with Unix 'tar' archives easier.
-;; When this code is loaded, visiting a file whose name ends in '.tar' will
-;; cause the contents of that archive file to be displayed in a Dired-like
-;; listing.  It is then possible to use the customary Dired keybindings to
-;; extract sub-files from that archive, either by reading them into their own
-;; editor buffers, or by copying them directly to arbitrary files on disk.
-;; It is also possible to delete sub-files from within the tar file and write
-;; the modified archive back to disk, or to edit sub-files within the archive
-;; and re-insert the modified files into the archive.  See the documentation
-;; string of tar-mode for more info.
-
-;; This code now understands the extra fields that GNU tar adds to tar files.
-
-;; This interacts correctly with "uncompress.el" in the Emacs library,
-;; which you get with 
-;;
-;;  (autoload 'uncompress-while-visiting "uncompress")
-;;  (setq auto-mode-alist (cons '("\\.Z$" . uncompress-while-visiting)
-;;			   auto-mode-alist))
-;;
-;; Do not attempt to use tar-mode.el with crypt.el, you will lose.
-
-;;    ***************   TO DO   *************** 
-;;
-;; o  chmod should understand "a+x,og-w".
-;;
-;; o  It's not possible to add a NEW file to a tar archive; not that 
-;;    important, but still...
-;;
-;; o  The code is less efficient that it could be - in a lot of places, I
-;;    pull a 512-character string out of the buffer and parse it, when I could
-;;    be parsing it in place, not garbaging a string.  Should redo that.
-;;
-;; o  I'd like a command that searches for a string/regexp in every subfile
-;;    of an archive, where <esc> would leave you in a subfile-edit buffer.
-;;    (Like the Meta-R command of the Zmacs mail reader.)
-;;
-;; o  Sometimes (but not always) reverting the tar-file buffer does not 
-;;    re-grind the listing, and you are staring at the binary tar data.
-;;    Typing 'g' again immediately after that will always revert and re-grind
-;;    it, though.  I have no idea why this happens.
-;;
-;; o  Tar-mode interacts poorly with crypt.el and zcat.el because the tar
-;;    write-file-hook actually writes the file.  Instead it should remove the
-;;    header (and conspire to put it back afterwards) so that other write-file
-;;    hooks which frob the buffer have a chance to do their dirty work.  There
-;;    might be a problem if the tar write-file-hook does not come *first* on
-;;    the list.
-;;
-;; o  Block files, sparse files, continuation files, and the various header 
-;;    types aren't editable.  Actually I don't know that they work at all.
-
-;; Rationale:
-
-;; Why does tar-mode edit the file itself instead of using tar?
-
-;; That means that you can edit tar files which you don't have room for
-;; on your local disk.
-
-;; I don't know about recent features in gnu tar, but old versions of tar
-;; can't replace a file in the middle of a tar file with a new version.
-;; Tar-mode can.  I don't think tar can do things like chmod the subfiles.
-;; An implementation which involved unpacking and repacking the file into
-;; some scratch directory would be very wasteful, and wouldn't be able to
-;; preserve the file owners.
-
-;;; Code:
-
-(defvar tar-anal-blocksize 20
-  "*The blocksize of tar files written by Emacs, or nil, meaning don't care.
-The blocksize of a tar file is not really the size of the blocks; rather, it is
-the number of blocks written with one system call.  When tarring to a tape, 
-this is the size of the *tape* blocks, but when writing to a file, it doesn't
-matter much.  The only noticeable difference is that if a tar file does not
-have a blocksize of 20, tar will tell you that; all this really controls is
-how many null padding bytes go on the end of the tar file.")
-
-(defvar tar-update-datestamp nil
-  "*Non-nil means tar-mode should play fast and loose with sub-file datestamps.
-If this is true, then editing and saving a tar file entry back into its
-tar file will update its datestamp.  If false, the datestamp is unchanged.
-You may or may not want this - it is good in that you can tell when a file
-in a tar archive has been changed, but it is bad for the same reason that
-editing a file in the tar archive at all is bad - the changed version of 
-the file never exists on disk.")
-
-(defvar tar-mode-show-date nil
-  "*Non-nil means Tar mode should show the date/time of each subfile.
-This information is useful, but it takes screen space away from file names.")
-
-(defvar tar-parse-info nil)
-(defvar tar-header-offset nil)
-(defvar tar-superior-buffer nil)
-(defvar tar-superior-descriptor nil)
-(defvar tar-subfile-mode nil)
-
-(put 'tar-parse-info 'permanent-local t)
-(put 'tar-header-offset 'permanent-local t)
-(put 'tar-superior-buffer 'permanent-local t)
-(put 'tar-superior-descriptor 'permanent-local t)
-
-;;; First, duplicate some Common Lisp functions; I used to just (require 'cl)
-;;; but "cl.el" was messing some people up (also it's really big).
-
-(defmacro tar-setf (form val)
-  "A mind-numbingly simple implementation of setf."
-  (let ((mform (macroexpand form (and (boundp 'byte-compile-macro-environment)
-				      byte-compile-macro-environment))))
-    (cond ((symbolp mform) (list 'setq mform val))
-	  ((not (consp mform)) (error "can't setf %s" form))
-	  ((eq (car mform) 'aref)
-	   (list 'aset (nth 1 mform) (nth 2 mform) val))
-	  ((eq (car mform) 'car)
-	   (list 'setcar (nth 1 mform) val))
-	  ((eq (car mform) 'cdr)
-	   (list 'setcdr (nth 1 mform) val))
-	  (t (error "don't know how to setf %s" form)))))
-
-(defmacro tar-dolist (control &rest body)
-  "syntax: (dolist (var-name list-expr &optional return-value) &body body)"
-  (let ((var (car control))
-	(init (car (cdr control)))
-	(val (car (cdr (cdr control)))))
-    (list 'let (list (list '_dolist_iterator_ init))
-	  (list 'while '_dolist_iterator_
-	    (cons 'let
-	      (cons (list (list var '(car _dolist_iterator_)))
-		    (append body
-			    (list (list 'setq '_dolist_iterator_
-					(list 'cdr '_dolist_iterator_)))))))
-	  val)))
-
-(defmacro tar-dotimes (control &rest body)
-  "syntax: (dolist (var-name count-expr &optional return-value) &body body)"
-  (let ((var (car control))
-	(n (car (cdr control)))
-	(val (car (cdr (cdr control)))))
-    (list 'let (list (list '_dotimes_end_ n)
-		     (list var 0))
-	  (cons 'while
-		(cons (list '< var '_dotimes_end_)
-		      (append body
-			      (list (list 'setq var (list '1+ var))))))
-	  val)))
-
-
-;;; down to business.
-
-(defmacro make-tar-header (name mode uid git size date ck lt ln
-			   magic uname gname devmaj devmin)
-  (list 'vector name mode uid git size date ck lt ln
-	magic uname gname devmaj devmin))
-
-(defmacro tar-header-name (x) (list 'aref x 0))
-(defmacro tar-header-mode (x) (list 'aref x 1))
-(defmacro tar-header-uid  (x) (list 'aref x 2))
-(defmacro tar-header-gid  (x) (list 'aref x 3))
-(defmacro tar-header-size (x) (list 'aref x 4))
-(defmacro tar-header-date (x) (list 'aref x 5))
-(defmacro tar-header-checksum  (x) (list 'aref x 6))
-(defmacro tar-header-link-type (x) (list 'aref x 7))
-(defmacro tar-header-link-name (x) (list 'aref x 8))
-(defmacro tar-header-magic (x) (list 'aref x 9))
-(defmacro tar-header-uname (x) (list 'aref x 10))
-(defmacro tar-header-gname (x) (list 'aref x 11))
-(defmacro tar-header-dmaj (x) (list 'aref x 12))
-(defmacro tar-header-dmin (x) (list 'aref x 13))
-
-(defmacro make-tar-desc (data-start tokens)
-  (list 'cons data-start tokens))
-
-(defmacro tar-desc-data-start (x) (list 'car x))
-(defmacro tar-desc-tokens     (x) (list 'cdr x))
-
-(defconst tar-name-offset 0)
-(defconst tar-mode-offset (+ tar-name-offset 100))
-(defconst tar-uid-offset  (+ tar-mode-offset 8))
-(defconst tar-gid-offset  (+ tar-uid-offset 8))
-(defconst tar-size-offset (+ tar-gid-offset 8))
-(defconst tar-time-offset (+ tar-size-offset 12))
-(defconst tar-chk-offset  (+ tar-time-offset 12))
-(defconst tar-linkp-offset (+ tar-chk-offset 8))
-(defconst tar-link-offset (+ tar-linkp-offset 1))
-;;; GNU-tar specific slots.
-(defconst tar-magic-offset (+ tar-link-offset 100))
-(defconst tar-uname-offset (+ tar-magic-offset 8))
-(defconst tar-gname-offset (+ tar-uname-offset 32))
-(defconst tar-dmaj-offset (+ tar-gname-offset 32))
-(defconst tar-dmin-offset (+ tar-dmaj-offset 8))
-(defconst tar-end-offset (+ tar-dmin-offset 8))
-
-(defun tar-header-block-tokenize (string)
-  "Return a `tar-header' structure.
-This is a list of name, mode, uid, gid, size, 
-write-date, checksum, link-type, and link-name."
-  (cond ((< (length string) 512) nil)
-	(;(some 'plusp string)		 ; <-- oops, massive cycle hog!
-	 (or (not (= 0 (aref string 0))) ; This will do.
-	     (not (= 0 (aref string 101))))
-	 (let* ((name-end (1- tar-mode-offset))
-		(link-end (1- tar-magic-offset))
-		(uname-end (1- tar-gname-offset))
-		(gname-end (1- tar-dmaj-offset))
-		(link-p (aref string tar-linkp-offset))
-		(magic-str (substring string tar-magic-offset (1- tar-uname-offset)))
-		(uname-valid-p (or (string= "ustar  " magic-str) (string= "GNUtar " magic-str)))
-		name
-		(nulsexp   "[^\000]*\000"))
-	   (and (string-match nulsexp string tar-name-offset) (setq name-end (min name-end (1- (match-end 0)))))
-	   (and (string-match nulsexp string tar-link-offset) (setq link-end (min link-end (1- (match-end 0)))))
-	   (and (string-match nulsexp string tar-uname-offset) (setq uname-end (min uname-end (1- (match-end 0)))))
-	   (and (string-match nulsexp string tar-gname-offset) (setq gname-end (min gname-end (1- (match-end 0)))))
-	   (setq name (substring string tar-name-offset name-end)
-		 link-p (if (or (= link-p 0) (= link-p ?0))
-			    nil
-			  (- link-p ?0)))
-	   (if (and (null link-p) (string-match "/$" name)) (setq link-p 5)) ; directory
-	   (make-tar-header
-	     name
-	     (tar-parse-octal-integer string tar-mode-offset (1- tar-uid-offset))
-	     (tar-parse-octal-integer string tar-uid-offset (1- tar-gid-offset))
-	     (tar-parse-octal-integer string tar-gid-offset (1- tar-size-offset))
-	     (tar-parse-octal-integer string tar-size-offset (1- tar-time-offset))
-	     (tar-parse-octal-long-integer string tar-time-offset (1- tar-chk-offset))
-	     (tar-parse-octal-integer string tar-chk-offset (1- tar-linkp-offset))
-	     link-p
-	     (substring string tar-link-offset link-end)
-	     uname-valid-p
-	     (and uname-valid-p (substring string tar-uname-offset uname-end))
-	     (and uname-valid-p (substring string tar-gname-offset gname-end))
-	     (tar-parse-octal-integer string tar-dmaj-offset (1- tar-dmin-offset))
-	     (tar-parse-octal-integer string tar-dmin-offset (1- tar-end-offset))
-	     )))
-	(t 'empty-tar-block)))
-
-
-(defun tar-parse-octal-integer (string &optional start end)
-  (if (null start) (setq start 0))
-  (if (null end) (setq end (length string)))
-  (if (= (aref string start) 0)
-      0
-    (let ((n 0))
-      (while (< start end)
-	(setq n (if (< (aref string start) ?0) n
-		  (+ (* n 8) (- (aref string start) ?0)))
-	      start (1+ start)))
-      n)))
-
-(defun tar-parse-octal-long-integer (string &optional start end)
-  (if (null start) (setq start 0))
-  (if (null end) (setq end (length string)))
-  (if (= (aref string start) 0)
-      (list 0 0)
-    (let ((lo 0)
-	  (hi 0))
-      (while (< start end)
-	(if (>= (aref string start) ?0)
-	    (setq lo (+ (* lo 8) (- (aref string start) ?0))
-		  hi (+ (* hi 8) (ash lo -16))
-		  lo (logand lo 65535)))
-	(setq start (1+ start)))
-      (list hi lo))))
-
-(defun tar-parse-octal-integer-safe (string)
-  (let ((L (length string)))
-    (if (= L 0) (error "empty string"))
-    (tar-dotimes (i L)
-       (if (or (< (aref string i) ?0)
-	       (> (aref string i) ?7))
-	   (error "'%c' is not an octal digit"))))
-  (tar-parse-octal-integer string))
-
-
-(defun tar-header-block-checksum (string)
-  "Compute and return a tar-acceptable checksum for this block."
-  (let* ((chk-field-start tar-chk-offset)
-	 (chk-field-end (+ chk-field-start 8))
-	 (sum 0)
-	 (i 0))
-    ;; Add up all of the characters except the ones in the checksum field.
-    ;; Add that field as if it were filled with spaces.
-    (while (< i chk-field-start)
-      (setq sum (+ sum (aref string i))
-	    i (1+ i)))
-    (setq i chk-field-end)
-    (while (< i 512)
-      (setq sum (+ sum (aref string i))
-	    i (1+ i)))
-    (+ sum (* 32 8))))
-
-(defun tar-header-block-check-checksum (hblock desired-checksum file-name)
-  "Beep and print a warning if the checksum doesn't match."
-  (if (not (= desired-checksum (tar-header-block-checksum hblock)))
-      (progn (beep) (message "Invalid checksum for file %s!" file-name))))
-
-(defun tar-header-block-recompute-checksum (hblock)
-  "Modifies the given string to have a valid checksum field."
-  (let* ((chk (tar-header-block-checksum hblock))
-	 (chk-string (format "%6o" chk))
-	 (l (length chk-string)))
-    (aset hblock 154 0)
-    (aset hblock 155 32)
-    (tar-dotimes (i l) (aset hblock (- 153 i) (aref chk-string (- l i 1)))))
-  hblock)
-
-(defun tar-clip-time-string (time)
-  (let ((str (current-time-string time)))
-    (concat (substring str 4 16) (substring str 19 24))))
-
-(defun tar-grind-file-mode (mode string start)
-  "Store `-rw--r--r--' indicating MODE into STRING beginning at START.
-MODE should be an integer which is a file mode value."
-  (aset string start       (if (zerop (logand 256 mode)) ?- ?r))
-  (aset string (+ start 1) (if (zerop (logand 128 mode)) ?- ?w))
-  (aset string (+ start 2) (if (zerop (logand  64 mode)) ?- ?x)) 
-  (aset string (+ start 3) (if (zerop (logand  32 mode)) ?- ?r))
-  (aset string (+ start 4) (if (zerop (logand  16 mode)) ?- ?w))
-  (aset string (+ start 5) (if (zerop (logand   8 mode)) ?- ?x))
-  (aset string (+ start 6) (if (zerop (logand   4 mode)) ?- ?r))
-  (aset string (+ start 7) (if (zerop (logand   2 mode)) ?- ?w))
-  (aset string (+ start 8) (if (zerop (logand   1 mode)) ?- ?x))
-  (if (zerop (logand 1024 mode)) nil (aset string (+ start 2) ?s))
-  (if (zerop (logand 2048 mode)) nil (aset string (+ start 5) ?s))
-  string)
-
-(defun tar-header-block-summarize (tar-hblock &optional mod-p)
-  "Returns a line similar to the output of `tar -vtf'."
-  (let ((name (tar-header-name tar-hblock))
-	(mode (tar-header-mode tar-hblock))
-	(uid (tar-header-uid tar-hblock))
-	(gid (tar-header-gid tar-hblock))
-	(uname (tar-header-uname tar-hblock))
-	(gname (tar-header-gname tar-hblock))
-	(size (tar-header-size tar-hblock))
-	(time (tar-header-date tar-hblock))
-	(ck (tar-header-checksum tar-hblock))
-	(link-p (tar-header-link-type tar-hblock))
-	(link-name (tar-header-link-name tar-hblock))
-	)
-    (let* ((left 11)
-	   (namew 8)
-	   (groupw 8)
-	   (sizew 8)
-	   (datew (if tar-mode-show-date 18 0))
-	   (slash (1- (+ left namew)))
-	   (lastdigit (+ slash groupw sizew))
-	   (datestart (+ lastdigit 2))
-	   (namestart (+ datestart datew))
-	   (string (make-string (+ namestart (length name) (if link-p (+ 5 (length link-name)) 0)) 32))
-	   (type (tar-header-link-type tar-hblock)))
-      (aset string 0 (if mod-p ?* ? ))
-      (aset string 1
-	    (cond ((or (eq type nil) (eq type 0)) ?-)
-		  ((eq type 1) ?l)  ; link
-		  ((eq type 2) ?s)  ; symlink
-		  ((eq type 3) ?c)  ; char special
-		  ((eq type 4) ?b)  ; block special
-		  ((eq type 5) ?d)  ; directory
-		  ((eq type 6) ?p)  ; FIFO/pipe
-		  ((eq type 20) ?*) ; directory listing
-		  ((eq type 29) ?M) ; multivolume continuation
-		  ((eq type 35) ?S) ; sparse
-		  ((eq type 38) ?V) ; volume header
-		  ))
-      (tar-grind-file-mode mode string 2)
-      (setq uid (if (= 0 (length uname)) (int-to-string uid) uname))
-      (setq gid (if (= 0 (length gname)) (int-to-string gid) gname))
-      (setq size (int-to-string size))
-      (setq time (tar-clip-time-string time))
-      (tar-dotimes (i (min (1- namew) (length uid))) (aset string (- slash i) (aref uid (- (length uid) i 1))))
-      (aset string (1+ slash) ?/)
-      (tar-dotimes (i (min (1- groupw) (length gid))) (aset string (+ (+ slash 2) i) (aref gid i)))
-      (tar-dotimes (i (min sizew (length size))) (aset string (- lastdigit i) (aref size (- (length size) i 1))))
-      (if tar-mode-show-date
-	  (tar-dotimes (i (length time)) (aset string (+ datestart i) (aref time i))))
-      (tar-dotimes (i (length name)) (aset string (+ namestart i) (aref name i)))
-      (if (or (eq link-p 1) (eq link-p 2))
-	  (progn
-	    (tar-dotimes (i 3) (aset string (+ namestart 1 (length name) i) (aref (if (= link-p 1) "==>" "-->") i)))
-	    (tar-dotimes (i (length link-name)) (aset string (+ namestart 5 (length name) i) (aref link-name i)))))
-      (put-text-property namestart (length string)
-			 'mouse-face 'highlight string)
-      string)))
-
-
-(defun tar-summarize-buffer ()
-  "Parse the contents of the tar file in the current buffer.
-Place a dired-like listing on the front;
-then narrow to it, so that only that listing
-is visible (and the real data of the buffer is hidden)."
-  (message "Parsing tar file...")
-  (let* ((result '())
-	 (pos 1)
-	 (bs (max 1 (- (buffer-size) 1024))) ; always 2+ empty blocks at end.
-	 (bs100 (max 1 (/ bs 100)))
-	 tokens)
-    (while (and (<= (+ pos 512) (point-max))
-		(not (eq 'empty-tar-block
-			 (setq tokens
-			       (tar-header-block-tokenize
-				(buffer-substring pos (+ pos 512)))))))
-      (setq pos (+ pos 512))
-      (message "Parsing tar file...%d%%"
-	       ;(/ (* pos 100) bs)   ; this gets round-off lossage
-	       (/ pos bs100)         ; this doesn't
-	       )
-      (if (eq (tar-header-link-type tokens) 20)
-	  ;; Foo.  There's an extra empty block after these.
-	  (setq pos (+ pos 512)))
-      (let ((size (tar-header-size tokens)))
-	(if (< size 0)
-	    (error "%s has size %s - corrupted"
-		   (tar-header-name tokens) size))
-	;
-	; This is just too slow.  Don't really need it anyway....
-	;(tar-header-block-check-checksum
-	;  hblock (tar-header-block-checksum hblock)
-	;  (tar-header-name tokens))
-
-	(setq result (cons (make-tar-desc pos tokens) result))
-
-	(and (null (tar-header-link-type tokens))
-	     (> size 0)
-	     (setq pos
-		   (+ pos 512 (ash (ash (1- size) -9) 9))        ; this works
-		   ;(+ pos (+ size (- 512 (rem (1- size) 512)))) ; this doesn't
-		   ))))
-    (make-local-variable 'tar-parse-info)
-    (setq tar-parse-info (nreverse result))
-    ;; A tar file should end with a block or two of nulls,
-    ;; but let's not get a fatal error if it doesn't.
-    (if (eq tokens 'empty-tar-block)
-	(message "Parsing tar file...done")
-      (message "Warning: premature EOF parsing tar file")))
-  (save-excursion
-    (goto-char (point-min))
-    (let ((buffer-read-only nil)
-	  (summaries nil))
-      ;; Collect summary lines and insert them all at once since tar files
-      ;; can be pretty big.
-      (tar-dolist (tar-desc (reverse tar-parse-info))
-	(setq summaries
-	      (cons (tar-header-block-summarize (tar-desc-tokens tar-desc))
-		    (cons "\n"
-			  summaries))))
-      (insert (apply 'concat summaries))
-      (make-local-variable 'tar-header-offset)
-      (setq tar-header-offset (point))
-      (narrow-to-region 1 tar-header-offset)
-      (set-buffer-modified-p nil))))
-
-(defvar tar-mode-map nil "*Local keymap for Tar mode listings.")
-
-(if tar-mode-map
-    nil
-  (setq tar-mode-map (make-keymap))
-  (suppress-keymap tar-mode-map)
-  (define-key tar-mode-map " " 'tar-next-line)
-  (define-key tar-mode-map "c" 'tar-copy)
-  (define-key tar-mode-map "d" 'tar-flag-deleted)
-  (define-key tar-mode-map "\^D" 'tar-flag-deleted)
-  (define-key tar-mode-map "e" 'tar-extract)
-  (define-key tar-mode-map "f" 'tar-extract)
-  (define-key tar-mode-map "\C-m" 'tar-extract)
-  (define-key tar-mode-map [mouse-2] 'tar-mouse-extract)
-  (define-key tar-mode-map "g" 'revert-buffer)
-  (define-key tar-mode-map "h" 'describe-mode)
-  (define-key tar-mode-map "n" 'tar-next-line)
-  (define-key tar-mode-map "\^N" 'tar-next-line)
-  (define-key tar-mode-map [down] 'tar-next-line)
-  (define-key tar-mode-map "o" 'tar-extract-other-window)
-  (define-key tar-mode-map "p" 'tar-previous-line)
-  (define-key tar-mode-map "\^P" 'tar-previous-line)
-  (define-key tar-mode-map [up] 'tar-previous-line)
-  (define-key tar-mode-map "r" 'tar-rename-entry)
-  (define-key tar-mode-map "u" 'tar-unflag)
-  (define-key tar-mode-map "v" 'tar-view)
-  (define-key tar-mode-map "x" 'tar-expunge)
-  (define-key tar-mode-map "\177" 'tar-unflag-backwards)
-  (define-key tar-mode-map "E" 'tar-extract-other-window)
-  (define-key tar-mode-map "M" 'tar-chmod-entry)
-  (define-key tar-mode-map "G" 'tar-chgrp-entry)
-  (define-key tar-mode-map "O" 'tar-chown-entry)
-  )
-
-;; Make menu bar items.
-
-;; Get rid of the Edit menu bar item to save space.
-(define-key tar-mode-map [menu-bar edit] 'undefined)
-
-(define-key tar-mode-map [menu-bar immediate]
-  (cons "Immediate" (make-sparse-keymap "Immediate")))
-
-(define-key tar-mode-map [menu-bar immediate view]
-  '("View This File" . tar-view))
-(define-key tar-mode-map [menu-bar immediate display]
-  '("Display in Other Window" . tar-display-other-file))
-(define-key tar-mode-map [menu-bar immediate find-file-other-window]
-  '("Find in Other Window" . tar-extract-other-window))
-(define-key tar-mode-map [menu-bar immediate find-file]
-  '("Find This File" . tar-extract))
-
-(define-key tar-mode-map [menu-bar mark]
-  (cons "Mark" (make-sparse-keymap "Mark")))
-
-(define-key tar-mode-map [menu-bar mark unmark-all]
-  '("Unmark All" . tar-clear-modification-flags))
-(define-key tar-mode-map [menu-bar mark deletion]
-  '("Flag" . tar-flag-deleted))
-(define-key tar-mode-map [menu-bar mark unmark]
-  '("Unflag" . tar-unflag))
-
-(define-key tar-mode-map [menu-bar operate]
-  (cons "Operate" (make-sparse-keymap "Operate")))
-
-(define-key tar-mode-map [menu-bar operate chown]
-  '("Change Owner..." . tar-chown-entry))
-(define-key tar-mode-map [menu-bar operate chgrp]
-  '("Change Group..." . tar-chgrp-entry))
-(define-key tar-mode-map [menu-bar operate chmod]
-  '("Change Mode..." . tar-chmod-entry))
-(define-key tar-mode-map [menu-bar operate rename]
-  '("Rename to..." . tar-rename-entry))
-(define-key tar-mode-map [menu-bar operate copy]
-  '("Copy to..." . tar-copy))
-(define-key tar-mode-map [menu-bar operate expunge]
-  '("Expunge Marked Files" . tar-expunge))
-
-;; tar mode is suitable only for specially formatted data.
-(put 'tar-mode 'mode-class 'special)
-(put 'tar-subfile-mode 'mode-class 'special)
-
-;;;###autoload
-(defun tar-mode ()
-  "Major mode for viewing a tar file as a dired-like listing of its contents.
-You can move around using the usual cursor motion commands. 
-Letters no longer insert themselves.
-Type `e' to pull a file out of the tar file and into its own buffer;
-or click mouse-2 on the file's line in the Tar mode buffer.
-Type `c' to copy an entry from the tar file into another file on disk.
-
-If you edit a sub-file of this archive (as with the `e' command) and 
-save it with Control-x Control-s, the contents of that buffer will be 
-saved back into the tar-file buffer; in this way you can edit a file 
-inside of a tar archive without extracting it and re-archiving it.
-
-See also: variables `tar-update-datestamp' and `tar-anal-blocksize'.
-\\{tar-mode-map}"
-  ;; this is not interactive because you shouldn't be turning this
-  ;; mode on and off.  You can corrupt things that way.
-  ;; rms: with permanent locals, it should now be possible to make this work
-  ;; interactively in some reasonable fashion.
-  (kill-all-local-variables)
-  (make-local-variable 'tar-header-offset)
-  (make-local-variable 'tar-parse-info)
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline nil) ; binary data, dude...
-  (make-local-variable 'revert-buffer-function)
-  (setq revert-buffer-function 'tar-mode-revert)
-  (make-local-variable 'enable-local-variables)
-  (setq enable-local-variables nil)
-  (make-local-variable 'next-line-add-newlines)
-  (setq next-line-add-newlines nil)
-  (setq major-mode 'tar-mode)
-  (setq mode-name "Tar")
-  (use-local-map tar-mode-map)
-  (auto-save-mode 0)
-  (make-local-variable 'write-contents-hooks)
-  (setq write-contents-hooks '(tar-mode-write-file))
-  (widen)
-  (if (and (boundp 'tar-header-offset) tar-header-offset)
-      (narrow-to-region 1 tar-header-offset)
-      (tar-summarize-buffer))
-  (run-hooks 'tar-mode-hook)
-  )
-
-
-(defun tar-subfile-mode (p)
-  "Minor mode for editing an element of a tar-file.
-This mode arranges for \"saving\" this buffer to write the data
-into the tar-file buffer that it came from.  The changes will actually
-appear on disk when you save the tar-file's buffer."
-  (interactive "P")
-  (or (and (boundp 'tar-superior-buffer) tar-superior-buffer)
-      (error "This buffer is not an element of a tar file"))
-;;; Don't do this, because it is redundant and wastes mode line space.
-;;;  (or (assq 'tar-subfile-mode minor-mode-alist)
-;;;      (setq minor-mode-alist (append minor-mode-alist
-;;;				     (list '(tar-subfile-mode " TarFile")))))
-  (make-local-variable 'tar-subfile-mode)
-  (setq tar-subfile-mode
-	(if (null p)
-	    (not tar-subfile-mode)
-	    (> (prefix-numeric-value p) 0)))
-  (cond (tar-subfile-mode
-	 (make-local-variable 'local-write-file-hooks)
-	 (setq local-write-file-hooks '(tar-subfile-save-buffer))
-	 ;; turn off auto-save.
-	 (auto-save-mode nil)
-	 (setq buffer-auto-save-file-name nil)
-	 (run-hooks 'tar-subfile-mode-hook))
-	(t
-	 (kill-local-variable 'local-write-file-hooks))))
-
-
-;; Revert the buffer and recompute the dired-like listing.
-(defun tar-mode-revert (&optional no-autosave no-confirm)
-  (let ((revert-buffer-function nil)
-	(old-offset tar-header-offset)
-	success)
-    (setq tar-header-offset nil)
-    (unwind-protect
-	(and (revert-buffer t no-confirm)
-	     (progn (widen)
-		    (setq success t)
-		    (tar-mode)))
-      ;; If the revert was canceled,
-      ;; put back the old value of tar-header-offset.
-      (or success
-	  (setq tar-header-offset old-offset)))))
-
-
-(defun tar-next-line (p)
-  (interactive "p")
-  (forward-line p)
-  (if (eobp) nil (forward-char (if tar-mode-show-date 54 36))))
-
-(defun tar-previous-line (p)
-  (interactive "p")
-  (tar-next-line (- p)))
-
-(defun tar-current-descriptor (&optional noerror)
-  "Return the tar-descriptor of the current line, or signals an error."
-  ;; I wish lines had plists, like in ZMACS...
-  (or (nth (count-lines (point-min)
-			(save-excursion (beginning-of-line) (point)))
-	   tar-parse-info)
-      (if noerror
-	  nil
-	  (error "This line does not describe a tar-file entry"))))
-
-(defun tar-get-descriptor ()
-  (let* ((descriptor (tar-current-descriptor))
-	 (tokens (tar-desc-tokens descriptor))
-	 (size (tar-header-size tokens))
-	 (link-p (tar-header-link-type tokens)))
-    (if link-p
-	(error "This is a %s, not a real file"
-	       (cond ((eq link-p 5) "directory")
-		     ((eq link-p 20) "tar directory header")
-		     ((eq link-p 29) "multivolume-continuation")
-		     ((eq link-p 35) "sparse entry")
-		     ((eq link-p 38) "volume header")
-		     (t "link"))))
-    (if (zerop size) (error "This is a zero-length file"))
-    descriptor))
-
-(defun tar-mouse-extract (event)
-  "Extract a file whose tar directory line you click on."
-  (interactive "e")
-  (save-excursion
-    (set-buffer (window-buffer (posn-window (event-end event))))
-    (save-excursion
-      (goto-char (posn-point (event-end event)))
-      ;; Just make sure this doesn't get an error.
-      (tar-get-descriptor)))
-  (select-window (posn-window (event-end event)))
-  (goto-char (posn-point (event-end event)))
-  (tar-extract))
-
-(defun tar-extract (&optional other-window-p)
-  "In Tar mode, extract this entry of the tar file into its own buffer."
-  (interactive)
-  (let* ((view-p (eq other-window-p 'view))
-	 (descriptor (tar-get-descriptor))
-	 (tokens (tar-desc-tokens descriptor))
-	 (name (tar-header-name tokens))
-	 (size (tar-header-size tokens))
-	 (start (+ (tar-desc-data-start descriptor) tar-header-offset -1))
-	 (end (+ start size)))
-    (let* ((tar-buffer (current-buffer))
-	   (tarname (file-name-nondirectory (buffer-file-name)))
-	   (bufname (concat (file-name-nondirectory name)
-			    " ("
-			    tarname
-			    ")"))
-	   (read-only-p (or buffer-read-only view-p))
-	   (buffer (get-buffer bufname))
-	   (just-created nil))
-      (if buffer
-	  nil
-	(setq buffer (get-buffer-create bufname))
-	(setq just-created t)
-	(unwind-protect
-	    (progn
-	      (widen)
-	      (save-excursion
-		(set-buffer buffer)
-		(insert-buffer-substring tar-buffer start end)
-		(goto-char 0)
-		(setq buffer-file-name
-		      (expand-file-name (concat tarname ":" name)))
-		(setq buffer-file-truename
-		      (abbreviate-file-name buffer-file-name))
-		;; Set the default-directory to the dir of the
-		;; superior buffer. 
-		(setq default-directory
-		      (save-excursion
-			(set-buffer tar-buffer)
-			default-directory))
-		(normal-mode)  ; pick a mode.
-		(rename-buffer bufname)
-		(make-local-variable 'tar-superior-buffer)
-		(make-local-variable 'tar-superior-descriptor)
-		(setq tar-superior-buffer tar-buffer)
-		(setq tar-superior-descriptor descriptor)
-		(setq buffer-read-only read-only-p)		
-		(set-buffer-modified-p nil)
-		(tar-subfile-mode 1))
-	      (set-buffer tar-buffer))
-	  (narrow-to-region 1 tar-header-offset)))
-      (if view-p
-	  (progn
-	    (view-buffer buffer)
-	    (and just-created
-		 ;; This will be created by view.el
-		 (setq view-exit-action 'kill-buffer)))
-	(if (eq other-window-p 'display)
-	    (display-buffer buffer)
-	  (if other-window-p
-	      (switch-to-buffer-other-window buffer)
-	    (switch-to-buffer buffer)))))))
-
-
-(defun tar-extract-other-window ()
-  "*In Tar mode, find this entry of the tar file in another window."
-  (interactive)
-  (tar-extract t))
-
-(defun tar-display-other-window ()
-  "*In Tar mode, display this entry of the tar file in another window."
-  (interactive)
-  (tar-extract 'display))
-
-(defun tar-view ()
-  "*In Tar mode, view the tar file entry on this line."
-  (interactive)
-  (tar-extract 'view))
-
-
-(defun tar-read-file-name (&optional prompt)
-  "Read a file name with this line's entry as the default."
-  (or prompt (setq prompt "Copy to: "))
-  (let* ((default-file (expand-file-name
-			(tar-header-name (tar-desc-tokens
-					  (tar-current-descriptor)))))
-	 (target (expand-file-name
-		  (read-file-name prompt
-				  (file-name-directory default-file)
-				  default-file nil))))
-    (if (or (string= "" (file-name-nondirectory target))
-	    (file-directory-p target))
-	(setq target (concat (if (string-match "/$" target)
-				 (substring target 0 (1- (match-end 0)))
-				 target)
-			     "/"
-			     (file-name-nondirectory default-file))))
-    target))
-
-
-(defun tar-copy (&optional to-file)
-  "*In Tar mode, extract this entry of the tar file into a file on disk.
-If TO-FILE is not supplied, it is prompted for, defaulting to the name of
-the current tar-entry."
-  (interactive (list (tar-read-file-name)))
-  (let* ((descriptor (tar-get-descriptor))
-	 (tokens (tar-desc-tokens descriptor))
-	 (name (tar-header-name tokens))
-	 (size (tar-header-size tokens))
-	 (start (+ (tar-desc-data-start descriptor) tar-header-offset -1))
-	 (end (+ start size))
-	 (inhibit-file-name-handlers inhibit-file-name-handlers)
-	 (inhibit-file-name-operation inhibit-file-name-operation))
-    (save-restriction
-      (widen)
-      ;; Inhibit compressing a subfile again if *both* name and
-      ;; to-file are handled by jka-compr
-      (if (and (eq (find-file-name-handler name 'write-region) 'jka-compr-handler)
-	       (eq (find-file-name-handler to-file 'write-region) 'jka-compr-handler))
-	  (setq inhibit-file-name-handlers
-		(cons 'jka-compr-handler
-		      (and (eq inhibit-file-name-operation 'write-region)
-			   inhibit-file-name-handlers))
-		inhibit-file-name-operation 'write-region))
-      (write-region start end to-file))
-    (message "Copied tar entry %s to %s" name to-file)))
-
-(defun tar-flag-deleted (p &optional unflag)
-  "*In Tar mode, mark this sub-file to be deleted from the tar file.
-With a prefix argument, mark that many files."
-  (interactive "p")
-  (beginning-of-line)
-  (tar-dotimes (i (if (< p 0) (- p) p))
-    (if (tar-current-descriptor unflag) ; barf if we're not on an entry-line.
-	(progn
-	  (delete-char 1)
-	  (insert (if unflag " " "D"))))
-    (forward-line (if (< p 0) -1 1)))
-  (if (eobp) nil (forward-char 36)))
-
-(defun tar-unflag (p)
-  "*In Tar mode, un-mark this sub-file if it is marked to be deleted.
-With a prefix argument, un-mark that many files forward."
-  (interactive "p")
-  (tar-flag-deleted p t))
-
-(defun tar-unflag-backwards (p)
-  "*In Tar mode, un-mark this sub-file if it is marked to be deleted.
-With a prefix argument, un-mark that many files backward."
-  (interactive "p")
-  (tar-flag-deleted (- p) t))
-
-
-(defun tar-expunge-internal ()
-  "Expunge the tar-entry specified by the current line."
-  (let* ((descriptor (tar-current-descriptor))
-	 (tokens (tar-desc-tokens descriptor))
-	 (line (tar-desc-data-start descriptor))
-	 (name (tar-header-name tokens))
-	 (size (tar-header-size tokens))
-	 (link-p (tar-header-link-type tokens))
-	 (start (tar-desc-data-start descriptor))
-	 (following-descs (cdr (memq descriptor tar-parse-info))))
-    (if link-p (setq size 0)) ; size lies for hard-links.
-    ;;
-    ;; delete the current line...
-    (beginning-of-line)
-    (let ((line-start (point)))
-      (end-of-line) (forward-char)
-      (let ((line-len (- (point) line-start)))
-	(delete-region line-start (point))
-	;;
-	;; decrement the header-pointer to be in sync...
-	(setq tar-header-offset (- tar-header-offset line-len))))
-    ;;
-    ;; delete the data pointer...
-    (setq tar-parse-info (delq descriptor tar-parse-info))
-    ;;
-    ;; delete the data from inside the file...
-    (widen)
-    (let* ((data-start (+ start tar-header-offset -513))
-	   (data-end (+ data-start 512 (ash (ash (+ size 511) -9) 9))))
-      (delete-region data-start data-end)
-      ;;
-      ;; and finally, decrement the start-pointers of all following
-      ;; entries in the archive.  This is a pig when deleting a bunch
-      ;; of files at once - we could optimize this to only do the
-      ;; iteration over the files that remain, or only iterate up to
-      ;; the next file to be deleted.
-      (let ((data-length (- data-end data-start)))
-	(tar-dolist (desc following-descs)
-	  (tar-setf (tar-desc-data-start desc)
-		    (- (tar-desc-data-start desc) data-length))))
-      ))
-  (narrow-to-region 1 tar-header-offset))
-
-
-(defun tar-expunge (&optional noconfirm)
-  "*In Tar mode, delete all the archived files flagged for deletion.
-This does not modify the disk image; you must save the tar file itself
-for this to be permanent."
-  (interactive)
-  (if (or noconfirm
-	  (y-or-n-p "Expunge files marked for deletion? "))
-      (let ((n 0))
-	(save-excursion
-	  (goto-char 0)
-	  (while (not (eobp))
-	    (if (looking-at "D")
-		(progn (tar-expunge-internal)
-		       (setq n (1+ n)))
-		(forward-line 1)))
-	  ;; after doing the deletions, add any padding that may be necessary.
-	  (tar-pad-to-blocksize)
-	  (narrow-to-region 1 tar-header-offset)
-	  )
-	(if (zerop n)
-	    (message "Nothing to expunge.")
-	    (message "%s files expunged.  Be sure to save this buffer." n)))))
-
-
-(defun tar-clear-modification-flags ()
-  "Remove the stars at the beginning of each line."
-  (interactive)
-  (save-excursion
-    (goto-char 1)
-    (while (< (point) tar-header-offset)
-      (if (not (eq (following-char) ?\ ))
-	  (progn (delete-char 1) (insert " ")))
-      (forward-line 1))))
-
-
-(defun tar-chown-entry (new-uid)
-  "*Change the user-id associated with this entry in the tar file.
-If this tar file was written by GNU tar, then you will be able to edit
-the user id as a string; otherwise, you must edit it as a number.
-You can force editing as a number by calling this with a prefix arg.
-This does not modify the disk image; you must save the tar file itself
-for this to be permanent."
-  (interactive (list
-		 (let ((tokens (tar-desc-tokens (tar-current-descriptor))))
-		   (if (or current-prefix-arg
-			   (not (tar-header-magic tokens)))
-		       (let (n)
-			 (while (not (numberp (setq n (read-minibuffer
-							"New UID number: "
-							(format "%s" (tar-header-uid tokens)))))))
-			 n)
-		       (read-string "New UID string: " (tar-header-uname tokens))))))
-  (cond ((stringp new-uid)
-	 (tar-setf (tar-header-uname (tar-desc-tokens (tar-current-descriptor)))
-		   new-uid)
-	 (tar-alter-one-field tar-uname-offset (concat new-uid "\000")))
-	(t
-	 (tar-setf (tar-header-uid (tar-desc-tokens (tar-current-descriptor)))
-		   new-uid)
-	 (tar-alter-one-field tar-uid-offset
-	   (concat (substring (format "%6o" new-uid) 0 6) "\000 ")))))
-
-
-(defun tar-chgrp-entry (new-gid)
-  "*Change the group-id associated with this entry in the tar file.
-If this tar file was written by GNU tar, then you will be able to edit
-the group id as a string; otherwise, you must edit it as a number.
-You can force editing as a number by calling this with a prefix arg.
-This does not modify the disk image; you must save the tar file itself
-for this to be permanent."
-  (interactive (list
-		 (let ((tokens (tar-desc-tokens (tar-current-descriptor))))
-		   (if (or current-prefix-arg
-			   (not (tar-header-magic tokens)))
-		       (let (n)
-			 (while (not (numberp (setq n (read-minibuffer
-							"New GID number: "
-							(format "%s" (tar-header-gid tokens)))))))
-			 n)
-		       (read-string "New GID string: " (tar-header-gname tokens))))))
-  (cond ((stringp new-gid)
-	 (tar-setf (tar-header-gname (tar-desc-tokens (tar-current-descriptor)))
-		   new-gid)
-	 (tar-alter-one-field tar-gname-offset
-	   (concat new-gid "\000")))
-	(t
-	 (tar-setf (tar-header-gid (tar-desc-tokens (tar-current-descriptor)))
-		   new-gid)
-	 (tar-alter-one-field tar-gid-offset
-	   (concat (substring (format "%6o" new-gid) 0 6) "\000 ")))))
-
-(defun tar-rename-entry (new-name)
-  "*Change the name associated with this entry in the tar file.
-This does not modify the disk image; you must save the tar file itself
-for this to be permanent."
-  (interactive
-    (list (read-string "New name: "
-	    (tar-header-name (tar-desc-tokens (tar-current-descriptor))))))
-  (if (string= "" new-name) (error "zero length name"))
-  (if (> (length new-name) 98) (error "name too long"))
-  (tar-setf (tar-header-name (tar-desc-tokens (tar-current-descriptor)))
-	    new-name)
-  (tar-alter-one-field 0
-    (substring (concat new-name (make-string 99 0)) 0 99)))
-
-
-(defun tar-chmod-entry (new-mode)
-  "*Change the protection bits associated with this entry in the tar file.
-This does not modify the disk image; you must save the tar file itself
-for this to be permanent."
-  (interactive (list (tar-parse-octal-integer-safe
-		       (read-string "New protection (octal): "))))
-  (tar-setf (tar-header-mode (tar-desc-tokens (tar-current-descriptor)))
-	    new-mode)
-  (tar-alter-one-field tar-mode-offset
-    (concat (substring (format "%6o" new-mode) 0 6) "\000 ")))
-
-
-(defun tar-alter-one-field (data-position new-data-string)
-  (let* ((descriptor (tar-current-descriptor))
-	 (tokens (tar-desc-tokens descriptor)))
-    (unwind-protect
-	(save-excursion
-	  ;;
-	  ;; update the header-line.
-	  (beginning-of-line)
-	  (let ((p (point)))
-	    (forward-line 1)
-	    (delete-region p (point))
-	    (insert (tar-header-block-summarize tokens) "\n")
-	    (setq tar-header-offset (point-max)))
-	  
-	  (widen)
-	  (let* ((start (+ (tar-desc-data-start descriptor) tar-header-offset -513)))
-	    ;;
-	    ;; delete the old field and insert a new one.
-	    (goto-char (+ start data-position))
-	    (delete-region (point) (+ (point) (length new-data-string))) ; <--
-	    (insert new-data-string) ; <--
-	    ;;
-	    ;; compute a new checksum and insert it.
-	    (let ((chk (tar-header-block-checksum
-			(buffer-substring start (+ start 512)))))
-	      (goto-char (+ start tar-chk-offset))
-	      (delete-region (point) (+ (point) 8))
-	      (insert (format "%6o" chk))
-	      (insert 0)
-	      (insert ? )
-	      (tar-setf (tar-header-checksum tokens) chk)
-	      ;;
-	      ;; ok, make sure we didn't botch it.
-	      (tar-header-block-check-checksum
-	        (buffer-substring start (+ start 512))
-	        chk (tar-header-name tokens))
-	      )))
-      (narrow-to-region 1 tar-header-offset))))
-
-
-(defun tar-octal-time (timeval)
-  ;; Format a timestamp as 11 octal digits.  Ghod, I hope this works...
-  (let ((hibits (car timeval)) (lobits (car (cdr timeval))))
-    (insert (format "%05o%01o%05o"
-		    (lsh hibits -2)
-		    (logior (lsh (logand 3 hibits) 1) (> (logand lobits 32768) 0))
-		    (logand 32767 lobits)
-		    ))))
-
-(defun tar-subfile-save-buffer ()
-  "In tar subfile mode, save this buffer into its parent tar-file buffer.
-This doesn't write anything to disk; you must save the parent tar-file buffer
-to make your changes permanent."
-  (interactive)
-  (if (not (and (boundp 'tar-superior-buffer) tar-superior-buffer))
-    (error "This buffer has no superior tar file buffer"))
-  (if (not (and (boundp 'tar-superior-descriptor) tar-superior-descriptor))
-    (error "This buffer doesn't have an index into its superior tar file!"))
-  (save-excursion
-  (let ((subfile (current-buffer))
-	(subfile-size (buffer-size))
-	(descriptor tar-superior-descriptor))
-    (set-buffer tar-superior-buffer)
-    (let* ((tokens (tar-desc-tokens descriptor))
-	   (start (tar-desc-data-start descriptor))
-	   (name (tar-header-name tokens))
-	   (size (tar-header-size tokens))
-	   (size-pad (ash (ash (+ size 511) -9) 9))
-	   (head (memq descriptor tar-parse-info))
-	   (following-descs (cdr head)))
-      (if (not head)
-	(error "Can't find this tar file entry in its parent tar file!"))
-      (unwind-protect
-       (save-excursion
-	(widen)
-	;; delete the old data...
-	(let* ((data-start (+ start tar-header-offset -1))
-	       (data-end (+ data-start (ash (ash (+ size 511) -9) 9))))
-	  (delete-region data-start data-end)
-	  ;; insert the new data...
-	  (goto-char data-start)
-	  (insert-buffer subfile)
-	  ;;
-	  ;; pad the new data out to a multiple of 512...
-	  (let ((subfile-size-pad (ash (ash (+ subfile-size 511) -9) 9)))
-	    (goto-char (+ data-start subfile-size))
-	    (insert (make-string (- subfile-size-pad subfile-size) 0))
-	    ;;
-	    ;; update the data pointer of this and all following files...
-	    (tar-setf (tar-header-size tokens) subfile-size)
-	    (let ((difference (- subfile-size-pad size-pad)))
-	      (tar-dolist (desc following-descs)
-		(tar-setf (tar-desc-data-start desc)
-			  (+ (tar-desc-data-start desc) difference))))
-	    ;;
-	    ;; Update the size field in the header block.
-	    (let ((header-start (- data-start 512)))
-	      (goto-char (+ header-start tar-size-offset))
-	      (delete-region (point) (+ (point) 12))
-	      (insert (format "%11o" subfile-size))
-	      (insert ? )
-	      ;;
-	      ;; Maybe update the datestamp.
-	      (if (not tar-update-datestamp)
-		  nil
-		(goto-char (+ header-start tar-time-offset))
-		(delete-region (point) (+ (point) 12))
-		(insert (tar-octal-time (current-time)))
-		(insert ? ))
-	      ;;
-	      ;; compute a new checksum and insert it.
-	      (let ((chk (tar-header-block-checksum
-			  (buffer-substring header-start data-start))))
-		(goto-char (+ header-start tar-chk-offset))
-		(delete-region (point) (+ (point) 8))
-		(insert (format "%6o" chk))
-		(insert 0)
-		(insert ? )
-		(tar-setf (tar-header-checksum tokens) chk)))
-	    ;;
-	    ;; alter the descriptor-line...
-	    ;;
-	    (let ((position (- (length tar-parse-info) (length head))))
-	      (goto-char 1)
-	      (next-line position)
-	      (beginning-of-line)
-	      (let ((p (point))
-		    after
-		    (m (set-marker (make-marker) tar-header-offset)))
-		(forward-line 1)
-		(setq after (point))
-		;; Insert the new text after the old, before deleting,
-		;; to preserve the window start.
-		(insert-before-markers (tar-header-block-summarize tokens t) "\n")
-		(delete-region p after)
-		(setq tar-header-offset (marker-position m)))
-	      )))
-	;; after doing the insertion, add any final padding that may be necessary.
-	(tar-pad-to-blocksize))
-       (narrow-to-region 1 tar-header-offset)))
-    (set-buffer-modified-p t)   ; mark the tar file as modified
-    (set-buffer subfile)
-    (set-buffer-modified-p nil) ; mark the tar subfile as unmodified
-    (message "Saved into tar-buffer `%s'.  Be sure to save that buffer!"
-	     (buffer-name tar-superior-buffer))
-    ;; Prevent ordinary saving from happening.
-    t)))
-
-
-(defun tar-pad-to-blocksize ()
-  "If we are being anal about tar file blocksizes, fix up the current buffer.
-Leaves the region wide."
-  (if (null tar-anal-blocksize)
-      nil
-    (widen)
-    (let* ((last-desc (nth (1- (length tar-parse-info)) tar-parse-info))
-	   (start (tar-desc-data-start last-desc))
-	   (tokens (tar-desc-tokens last-desc))
-	   (link-p (tar-header-link-type tokens))
-	   (size (if link-p 0 (tar-header-size tokens)))
-	   (data-end (+ start size))
-	   (bbytes (ash tar-anal-blocksize 9))
-	   (pad-to (+ bbytes (* bbytes (/ (1- data-end) bbytes))))
-	   (inhibit-read-only t) ; ##
-	   )
-      ;; If the padding after the last data is too long, delete some;
-      ;; else insert some until we are padded out to the right number of blocks.
-      ;;
-      (goto-char (+ (or tar-header-offset 0) data-end))
-      (if (> (1+ (buffer-size)) (+ (or tar-header-offset 0) pad-to))
-	  (delete-region (+ (or tar-header-offset 0) pad-to) (1+ (buffer-size)))
-	  (insert (make-string (- (+ (or tar-header-offset 0) pad-to)
-				  (1+ (buffer-size)))
-			       0)))
-      )))
-
-
-;; Used in write-file-hook to write tar-files out correctly.
-(defun tar-mode-write-file ()
-  (unwind-protect
-      (save-excursion
-	(widen)
-	;; Doing this here confuses things - the region gets left too wide!
-	;; I suppose this is run in a context where changing the buffer is bad.
-	;; (tar-pad-to-blocksize)
-	(write-region tar-header-offset (point-max) buffer-file-name nil t)
-	(tar-clear-modification-flags)
-	(set-buffer-modified-p nil))
-    (narrow-to-region 1 tar-header-offset))
-  ;; return T because we've written the file.
-  t)
-
-(provide 'tar-mode)
-
-;;; tar-mode.el ends here
diff --git a/lisp/tcp.el b/lisp/tcp.el
deleted file mode 100644
index 2f5b756ab82..00000000000
--- a/lisp/tcp.el
+++ /dev/null
@@ -1,75 +0,0 @@
-;;; tcp.el --- TCP/IP stream emulation for GNU Emacs
-
-;; Copyright (C) 1988, 1989, 1993 Free Software Foundation, Inc.
-
-;; Author: Masanobu Umeda
-;; Maintainer: umerin@mse.kyutech.ac.jp
-
-;; 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:
-
-;; Notes on TCP package:
-;;
-;; This package provides a TCP/IP stream emulation for GNU Emacs. If
-;; the function `open-network-stream' is not defined in Emacs, but
-;; your operating system has a capability of network stream
-;; connection, this tcp package can be used for communicating with
-;; NNTP server.
-;;
-;; The tcp package runs inferior process which actually does the role
-;; of `open-network-stream'.  The program `tcp' provided with this
-;; package can be used for such purpose.  Before loading the package,
-;; compile `tcp.c' and install it as `tcp' in a directory in the emacs
-;; search path. If you modify `tcp.c', please send diffs to the author
-;; of GNUS.  I'll include some of them in the next releases.
-
-;;; Code:
-
-(provide 'tcp)
-
-(defvar tcp-program-name "tcp"
-  "*The name of the program emulating open-network-stream function.")
-
-(defun open-network-stream (name buffer host service)
-  "Open a TCP connection for a service to a host.
-Returns a subprocess-object to represent the connection.
-Input and output work as for subprocesses; `delete-process' closes it.
-Args are NAME BUFFER HOST SERVICE.
-NAME is name for process.  It is modified if necessary to make it unique.
-BUFFER is the buffer (or buffer-name) to associate with the process.
- Process output goes at end of that buffer, unless you specify
- an output stream or filter function to handle the output.
- BUFFER may be also nil, meaning that this process is not associated
- with any buffer
-Third arg is name of the host to connect to.
-Fourth arg SERVICE is name of the service desired, or an integer
- specifying a port number to connect to."
-  (let ((proc (start-process name buffer 
-			     tcp-program-name
-			     host 
-			     (if (stringp service)
-				 service
-			       (int-to-string service))
-			     )))
-    (process-kill-without-query proc)
-    ;; Return process
-    proc
-    ))
-
-;;; tcp.el ends here
diff --git a/lisp/telnet.el b/lisp/telnet.el
deleted file mode 100644
index f5e61fc1dca..00000000000
--- a/lisp/telnet.el
+++ /dev/null
@@ -1,237 +0,0 @@
-;;; telnet.el --- run a telnet session from within an Emacs buffer
-
-;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: William F. Schelter
-;; 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 mode is intended to be used for telnet or rsh to a remode host;
-;; `telnet' and `rsh' are the two entry points.  Multiple telnet or rsh
-;; sessions are supported.
-;;
-;; Normally, input is sent to the remote telnet/rsh line-by-line, as you
-;; type RET or LFD.  C-c C-c sends a C-c to the remote immediately; 
-;; C-c C-z sends C-z immediately.  C-c C-q followed by any character
-;; sends that character immediately.
-;;
-;; All RET characters are filtered out of the output coming back from the
-;; remote system.  The mode tries to do other useful translations based
-;; on what it sees coming back from the other system before the password
-;; query.  It knows about UNIX, ITS, TOPS-20 and Explorer systems.
-
-;;; Code:
-
-;; to do fix software types for lispm:
-;; to eval current expression.  Also to try to send escape keys correctly.
-;; essentially we'll want the rubout-handler off.
-
-;; filter is simplistic but should be okay for typical shell usage.
-;; needs hacking if it is going to deal with asynchronous output in a sane
-;; manner
-
-(require 'comint)
-
-(defvar telnet-new-line "\r")
-(defvar telnet-mode-map nil)
-(defvar telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *")
-(defvar telnet-replace-c-g nil)
-(make-variable-buffer-local
- (defvar telnet-remote-echoes t
-   "True if the telnet process will echo input."))
-(make-variable-buffer-local
- (defvar telnet-interrupt-string "\C-c" "String sent by C-c."))
-
-(defvar telnet-count 0
-  "Number of output strings from telnet process while looking for password.")
-(make-variable-buffer-local 'telnet-count)
-
-(defvar telnet-program "telnet"
-  "Program to run to open a telnet connection.")
-
-(defvar telnet-initial-count -50
-  "Initial value of `telnet-count'.  Should be set to the negative of the
-number of terminal writes telnet will make setting up the host connection.")
-
-(defvar telnet-maximum-count 4
-  "Maximum value `telnet-count' can have.
-After this many passes, we stop looking for initial setup data.
-Should be set to the number of terminal writes telnet will make
-rejecting one login and prompting again for a username and password.")
-
-(defun telnet-interrupt-subjob ()
-  (interactive)
-  "Interrupt the program running through telnet on the remote host."
-  (send-string nil telnet-interrupt-string))
-
-(defun telnet-c-z ()
-  (interactive)
-  (send-string nil "\C-z"))
-
-(defun send-process-next-char ()
-  (interactive)
-  (send-string nil
-	       (char-to-string
-		(let ((inhibit-quit t))
-		  (prog1 (read-char)
-		    (setq quit-flag nil))))))
-
-; initialization on first load.
-(if telnet-mode-map
-    nil
-  (setq telnet-mode-map (nconc (make-sparse-keymap) comint-mode-map))
-  (define-key telnet-mode-map "\C-m" 'telnet-send-input)
-;  (define-key telnet-mode-map "\C-j" 'telnet-send-input)
-  (define-key telnet-mode-map "\C-c\C-q" 'send-process-next-char)
-  (define-key telnet-mode-map "\C-c\C-c" 'telnet-interrupt-subjob) 
-  (define-key telnet-mode-map "\C-c\C-z" 'telnet-c-z))
-
-;;maybe should have a flag for when have found type
-(defun telnet-check-software-type-initialize (string)
-  "Tries to put correct initializations in.  Needs work."
-  (let ((case-fold-search t))
-    (cond ((string-match "unix" string)
-	 (setq telnet-prompt-pattern comint-prompt-regexp)
-	 (setq telnet-new-line "\n"))
-	((string-match "tops-20" string) ;;maybe add telnet-replace-c-g
-	 (setq telnet-prompt-pattern  "[@>]*"))
-	((string-match "its" string)
-	 (setq telnet-prompt-pattern  "^[^*>\n]*[*>] *"))
-	((string-match "explorer" string)  ;;explorer telnet needs work
-	 (setq telnet-replace-c-g ?\n))))
-  (setq comint-prompt-regexp telnet-prompt-pattern))
-
-(defun telnet-initial-filter (proc string)
-  ;For reading up to and including password; also will get machine type.
-  (cond ((string-match "No such host" string)
-	 (kill-buffer (process-buffer proc))
-	 (error "No such host."))
-	((string-match "passw" string)
-	 (telnet-filter proc string)
-	 (setq telnet-count 0)
-	 (send-string proc (concat (comint-read-noecho "Password: " t)
-				   telnet-new-line)))
-	(t (telnet-check-software-type-initialize string)
-	   (telnet-filter proc string)
-	   (cond ((> telnet-count telnet-maximum-count)
-		  (set-process-filter proc 'telnet-filter))
-		 (t (setq telnet-count (1+ telnet-count)))))))
-
-;; Identical to comint-simple-send, except that it sends telnet-new-line
-;; instead of "\n".
-(defun telnet-simple-send (proc string)
-  (comint-send-string proc string)
-  (comint-send-string proc telnet-new-line))
-
-(defun telnet-filter (proc string)
-  (save-excursion
-    (set-buffer (process-buffer proc))
-    (let* ((last-insertion (marker-position (process-mark proc)))
-	   (delta (- (point) last-insertion))
-	   (ie (and comint-last-input-end
-		    (marker-position comint-last-input-end)))
-	   (w (get-buffer-window (current-buffer)))
-	   (ws (and w (window-start w))))
-      (goto-char last-insertion)
-      (insert-before-markers string)
-      (set-marker (process-mark proc) (point))
-      (if ws (set-window-start w ws t))
-      (if ie (set-marker comint-last-input-end ie))
-      (while (progn (skip-chars-backward "^\C-m" last-insertion)
-		    (> (point) last-insertion))
-	(delete-region (1- (point)) (point)))
-      (goto-char (process-mark proc))
-      (and telnet-replace-c-g
-	   (subst-char-in-region last-insertion (point) ?\C-g
-				 telnet-replace-c-g t))
-      ;; If point is after the insertion place, move it
-      ;; along with the text.
-      (if (> delta 0)
-	  (goto-char (+ (process-mark proc) delta))))))
-
-(defun telnet-send-input ()
-  (interactive)
-;  (comint-send-input telnet-new-line telnet-remote-echoes)
-  (comint-send-input)
-  (if telnet-remote-echoes
-      (delete-region comint-last-input-start
-		     comint-last-input-end)))
-
-;;;###autoload (add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
-
-;;;###autoload
-(defun telnet (host)
-  "Open a network login connection to host named HOST (a string).
-Communication with HOST is recorded in a buffer `*telnet-HOST*'.
-Normally input is edited in Emacs and sent a line at a time."
-  (interactive "sOpen telnet connection to host: ")
-  (let* ((comint-delimiter-argument-list '(?\  ?\t))
-         (name (concat "telnet-" (comint-arguments host 0 nil) ))
-	 (buffer (get-buffer (concat "*" name "*")))
-	 process)
-    (if (and buffer (get-buffer-process buffer))
-	(pop-to-buffer (concat "*" name "*"))
-      (pop-to-buffer (make-comint name telnet-program))
-      (setq process (get-buffer-process (current-buffer)))
-      (set-process-filter process 'telnet-initial-filter)
-      ;; Don't send the `open' cmd till telnet is ready for it.
-      (accept-process-output process)
-      (erase-buffer)
-      (send-string process (concat "open " host "\n"))
-      (telnet-mode)
-      (setq comint-input-sender 'telnet-simple-send)
-      (setq telnet-count telnet-initial-count))))
-
-(defun telnet-mode ()
-  "This mode is for using telnet (or rsh) from a buffer to another host.
-It has most of the same commands as comint-mode.
-There is a variable ``telnet-interrupt-string'' which is the character
-sent to try to stop execution of a job on the remote host.
-Data is sent to the remote host when RET is typed.
-
-\\{telnet-mode-map}
-"
-  (interactive)
-  (comint-mode)
-  (setq major-mode 'telnet-mode
-	mode-name "Telnet"
-	comint-prompt-regexp telnet-prompt-pattern)
-  (use-local-map telnet-mode-map)
-  (run-hooks 'telnet-mode-hook))
-
-;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)")
-
-;;;###autoload
-(defun rsh (host)
-  "Open a network login connection to host named HOST (a string).
-Communication with HOST is recorded in a buffer `*rsh-HOST*'.
-Normally input is edited in Emacs and sent a line at a time."
-  (interactive "sOpen rsh connection to host: ")
-  (require 'shell)
-  (let ((name (concat "rsh-" host )))
-    (pop-to-buffer (make-comint name remote-shell-program nil host))
-    (set-process-filter (get-process name) 'telnet-initial-filter)
-    (telnet-mode)
-    (setq telnet-count -16)))
-
-(provide 'telnet)
-
-;;; telnet.el ends here
diff --git a/lisp/tempo.el b/lisp/tempo.el
deleted file mode 100644
index 6ee10096afc..00000000000
--- a/lisp/tempo.el
+++ /dev/null
@@ -1,764 +0,0 @@
-;;; tempo.el --- Flexible template insertion
-
-;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: David K}gedal <davidk@lysator.liu.se >
-;; Created: 16 Feb 1994
-;; K}gedal's last version number: 1.2.4
-;; Keywords: extensions, languages, 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 file provides a simple way to define powerful templates, or
-;; macros, if you wish. It is mainly intended for, but not limited to,
-;; other programmers to be used for creating shortcuts for editing
-;; certain kind of documents. It was originally written to be used by
-;; a HTML editing mode written by Nelson Minar <nelson@santafe.edu>,
-;; and his html-helper-mode.el is probably the best example of how to
-;; use this program.
-
-;; A template is defined as a list of items to be inserted in the
-;; current buffer at point. Some of the items can be simple strings,
-;; while other can control formatting or define special points of
-;; interest in the inserted text.
-
-;; If a template defines a "point of interest" that point is inserted
-;; in a buffer-local list of "points of interest" that the user can
-;; jump between with the commands `tempo-backward-mark' and
-;; `tempo-forward-mark'. If the template definer provides a prompt for
-;; the point, and the variable `tempo-interactive' is non-nil, the
-;; user will be prompted for a string to be inserted in the buffer,
-;; using the minibuffer.
-
-;; The template can also define one point to be replaced with the
-;; current region if the template command is called with a prefix (or
-;; a non-nil argument).
-
-;; More flexible templates can be created by including lisp symbols,
-;; which will be evaluated as variables, or lists, which will will be
-;; evaluated as lisp expressions.
-
-;; See the documentation for tempo-define-template for the different
-;; items that can be used to define a tempo template.
-
-;; One of the more powerful features of tempo templates are automatic
-;; completion. With every template can be assigned a special tag that
-;; should be recognized by `tempo-complete-tag' and expanded to the
-;; complete template. By default the tags are added to a global list
-;; of template tags, and are matched against the last word before
-;; point. But if you assign your tags to a specific list, you can also
-;; specify another method for matching text in the buffer against the
-;; tags. In the HTML mode, for instance, the tags are matched against
-;; the text between the last `<' and point.
-
-;; When defining a template named `foo', a symbol named
-;; `tempo-template-foo' will be created whose value as a variable will
-;; be the template definition, and its function value will be an
-;; interactive function that inserts the template at the point.
-
-;; The latest tempo.el distribution can be fetched from
-;; ftp.lysator.liu.se in the directory /pub/emacs
-
-;; There is also a WWW page at
-;; http://www.lysator.liu.se/~davidk/elisp/ which has some information
-
-;;; Known bugs:
-
-;; If the 'o is the first element in a template, strange things can
-;; happen when the template is inserted at the beginning of a
-;; line. This is due to strange behaviour in open-line. But it should
-;; be easily avoided.
-
-;; The 'o tag is also a problem when including the region. This will
-;; be looked into.
-
-;; Clicking mouse-2 in the completion buffer gives strange results.
-
-;; There is a bug in some emacs versions that prevents completion from
-;; working. If it doesn't work for you, send me a note indicating your
-;; emacs version and your problems.
-
-;;; Contributors:
-
-;; These people have given me important feedback and new ideas for
-;; tempo.el. Thanks.
-
-;; Nelson Minar <nelson@santafe.edu>
-;; Richard Stallman <rms@gnu.ai.mit.edu>
-;; Lars Lindberg <Lars.Lindberg@sypro.cap.se>
-;; Glen Whitney <Glen.Whitney@math.lsa.umich.edu>
-
-;;; Code:
-
-;; (provide 'tempo)
-
-;;; User options
-
-(defvar tempo-interactive nil
-  "*Prompt user for strings in templates.
-If this variable is non-nil, `tempo-insert' prompts the
-user for text to insert in the templates")
-
-(defvar tempo-insert-region nil
-  "*Automatically insert current region when there is a `r' in the template
-If this variable is NIL, `r' elements will be treated just like `p'
-elements, unless the template function is given a prefix (or a non-nil
-argument). If this variable is non-NIL, the behaviour is reversed.
-
-In Transient Mark mode, this option is unused.")
-
-(defvar tempo-show-completion-buffer t
-  "*If non-NIL, show a buffer with possible completions, when only
-a partial completion can be found")
-
-(defvar tempo-leave-completion-buffer nil
-  "*If NIL, a completion buffer generated by \\[tempo-complete-tag]
-disappears at the next keypress; otherwise, it remains forever.")
-
-;;; Internal variables
-
-(defvar tempo-insert-string-functions nil
-  "List of functions to run when inserting a string.
-Each function is called with a single arg, STRING and should return
-another string. This could be used for making all strings upcase by
-setting it to '(upcase), for example.")
-
-(defvar tempo-tags nil
-  "An association list with tags and corresponding templates")
-
-(defvar tempo-local-tags '((tempo-tags . nil))
-  "A list of locally installed tag completion lists.
-It is a association list where the car of every element is a symbol
-whose variable value is a template list. The cdr part, if non-nil, is a
-function or a regexp that defines the string to match. See the
-documentation for the function `tempo-complete-tag' for more info.
-
-`tempo-tags' is always in the last position in this list.")
-
-(defvar tempo-collection nil
-  "A collection of all the tags defined for the current buffer.")
-
-(defvar tempo-dirty-collection t
-  "Indicates if the tag collection needs to be rebuilt.")
-
-(defvar tempo-marks nil
-  "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.")
-
-(defvar tempo-match-finder "\\b\\([^\\b]+\\)\\="
-  "The regexp or function used to find the string to match against tags.
-
-If `tempo-match-finder is a string, it should contain a regular
-expression with at least one \\( \\) pair. When searching for tags,
-`tempo-complete-tag' calls `re-search-backward' with this string, and
-the string between the first \\( and \\) is used for matching against
-each string in the tag list. If one is found, the whole text between
-the first \\( and the point is replaced with the inserted template.
-
-You will probably want to include \\ \= at the end of the regexp to
-make sure that the string is matched only against text adjacent to the
-point.
-
-If `tempo-match-finder' is a symbol, it should be a function that
-returns a pair of the form (STRING . POS), where STRING is the string
-used for matching and POS is the buffer position after which text
-should be replaced with a template.")
-
-(defvar tempo-user-elements nil
-  "Element handlers for user-defined elements.
-A list of symbols which are bound to functions that take one argument.
-This function should return something to be sent to `tempo-insert' if
-it recognizes the argument, and NIL otherwise")
-
-(defvar tempo-named-insertions nil
-  "Temporary storage for named insertions")
-
-(defvar tempo-region-start (make-marker)
-  "Region start when inserting around the region")
-
-(defvar tempo-region-stop (make-marker)
-  "Region stop when inserting around the region")
-
-;; Make some variables local to every buffer
-
-(make-variable-buffer-local 'tempo-marks)
-(make-variable-buffer-local 'tempo-local-tags)
-(make-variable-buffer-local 'tempo-match-finder)
-(make-variable-buffer-local 'tempo-collection)
-(make-variable-buffer-local 'tempo-dirty-collection)
-
-;;; Functions
-
-;;; First some useful functions and macros
-
-(defun tempo-mapc (fun lst)
-  (if (null lst) nil
-    (funcall fun (car lst))
-    (tempo-mapc fun (cdr lst))))
-
-(defmacro tempo-dolist (il &rest forms)
-  (let ((i (car il))
-	(l (car (cdr il))))
-    (list 'tempo-mapc
-	  (list 'function (append (list 'lambda
-					(list i))
-				  forms))
-	  l)))
-(put 'tempo-dolist 'lisp-indent-function 1)
-
-;;
-;; tempo-define-template
-
-(defun tempo-define-template (name elements &optional tag documentation taglist)
-  "Define a template.
-This function creates a template variable `tempo-template-NAME' and an
-interactive function `tempo-template-NAME' that inserts the template
-at the point.  The created function is returned.
-
-NAME is a string that contains the name of the template, ELEMENTS is a
-list of elements in the template, TAG is the tag used for completion,
-DOCUMENTATION is the documentation string for the insertion command
-created, and TAGLIST (a symbol) is the tag list that TAG (if provided)
-should be added to).  If TAGLIST is nil and TAG is non-nil, TAG is
-added to `tempo-tags'
-
-The elements in ELEMENTS can be of several types:
-
- - A string. It is sent to the hooks in `tempo-insert-string-functions',
-   and the result is inserted.
- - The symbol 'p. This position is saved in `tempo-marks'.
- - The symbol 'r. If `tempo-insert' is called with ON-REGION non-nil
-   the current region is placed here. Otherwise it works like 'p.
- - (p PROMPT <NAME> <NOINSERT>) If `tempo-interactive' is non-nil, the
-   user is prompted in the minbuffer with PROMPT for a string to be
-   inserted. If the optional parameter NAME is non-nil, the text is
-   saved for later insertion with the `s' tag. If there already is
-   something saved under NAME that value is used instead and no
-   prompting is made. If NOINSERT is provided and non-nil, nothing is
-   inserted, but text is still saved when a NAME is provided. For
-   clarity, the symbol 'noinsert should be used as argument.
- - (P PROMPT <NAME> <NOINSERT>) Works just like the previous tag, but
-   forces tempo-interactive to be true.
- - (r PROMPT <NAME> <NOINSERT>) like the previous, but if
-   `tempo-interactive' is nil and `tempo-insert' is called with
-   ON-REGION non-nil, the current region is placed here. This usually
-   happens when you call the template function with a prefix argument.
- - (s NAME) Inserts text previously read with the (p ..) construct.
-   Finds the insertion saved under NAME and inserts it. Acts like 'p
-   if tempo-interactive is nil.
- - '& If there is only whitespace between the line start and point,
-   nothing happens. Otherwise a newline is inserted.
- - '% If there is only whitespace between point and end-of-line
-   nothing happens. Otherwise a newline is inserted.
- - 'n inserts a newline.
- - '> The line is indented using `indent-according-to-mode'. Note that
-   you often should place this item after the text you want on the
-   line.
- - 'r> Like r, but it also indents the region.
- - 'n> Inserts a newline and indents line.
- - 'o Like '% but leaves the point before the newline.
- - nil. It is ignored.
- - Anything else. It is evaluated and the result is treated as an
-   element to be inserted. One additional tag is useful for these
-   cases. If an expression returns a list '(l foo bar), the elements
-   after 'l will be inserted according to the usual rules. This makes
-   it possible to return several elements from one expression."
-
-  (let* ((template-name (intern (concat "tempo-template-"
-				       name)))
-	 (command-name template-name))
-    (set template-name elements)
-    (fset command-name (list 'lambda (list '&optional 'arg)
-			     (or documentation 
-				 (concat "Insert a " name "."))
-			     (list 'interactive "*P")
-			     (list 'tempo-insert-template (list 'quote
-								template-name)
-				   (list 'if 'tempo-insert-region
-					 (list 'not 'arg) 'arg))))
-    (and tag
-	 (tempo-add-tag tag template-name taglist))
-    command-name))
-
-;;;
-;;; tempo-insert-template
-
-(defun tempo-insert-template (template on-region)
-  "Insert a template.
-TEMPLATE is the template to be inserted.  If ON-REGION is non-nil the
-`r' elements are replaced with the current region. In Transient Mark
-mode, ON-REGION is ignored and assumed true if the region is active."
-  (unwind-protect
-      (progn
-	(if (or (and (boundp 'transient-mark-mode) ; For Emacs
-		     transient-mark-mode
-		     mark-active)
-		(and (boundp 'zmacs-regions) ; For XEmacs
-		     zmacs-regions (mark)))
-	    (setq on-region t))
-	(and on-region
-	     (set-marker tempo-region-start (min (mark) (point)))
-	     (set-marker tempo-region-stop (max (mark) (point))))
-	(if on-region
-	    (goto-char tempo-region-start))
-	(save-excursion
-	  (tempo-insert-mark (point-marker))
-	  (mapcar (function (lambda (elt)
-			      (tempo-insert elt on-region)))
-		  (symbol-value template))
-	  (tempo-insert-mark (point-marker)))
-	(tempo-forward-mark))
-    (tempo-forget-insertions)
-    ;; Should I check for zmacs here too???
-    (and (boundp 'transient-mark-mode)
-	 transient-mark-mode
-	 (deactivate-mark))))
-
-;;;
-;;; tempo-insert
-
-(defun tempo-insert (element on-region)
-  "Insert a template element.
-Insert one element from a template. If ON-REGION is non-nil the `r'
-elements are replaced with the current region.
-
-See documentation for `tempo-define-template' for the kind of elements
-possible."
-  (cond ((stringp element) (tempo-process-and-insert-string element))
-	((and (consp element)
-	      (eq (car element) 'p)) (tempo-insert-prompt-compat
-				      (cdr element)))
-	((and (consp element)
-	      (eq (car element) 'P)) (let ((tempo-interactive t))
-				       (tempo-insert-prompt-compat
-					(cdr element))))
-;;;	((and (consp element)
-;;;	      (eq (car element) 'v)) (tempo-save-named
-;;;				      (nth 1 element)
-;;;				      nil
-;;;				      (nth 2 element)))
-	((and (consp element)
-	      (eq (car element) 'r)) (if on-region
-					 (goto-char tempo-region-stop)
-				       (tempo-insert-prompt-compat
-					(cdr element))))
-	((and (consp element)
-	      (eq (car element) 's)) (tempo-insert-named (car (cdr element))))
-	((and (consp element)
-	      (eq (car element) 'l)) (mapcar (function
-					      (lambda (elt)
-						(tempo-insert elt on-region)))
-					     (cdr element)))
-	((eq element 'p) (tempo-insert-mark (point-marker)))
-	((eq element 'r) (if on-region
-			     (goto-char tempo-region-stop)
-			   (tempo-insert-mark (point-marker))))
-	((eq element 'r>) (if on-region
-			      (progn
-				(goto-char tempo-region-stop)
-				(indent-region (mark) (point) nil))
-			    (tempo-insert-mark (point-marker))))
-	((eq element '>) (indent-according-to-mode))
-	((eq element '&) (if (not (or (= (current-column) 0)
-				      (save-excursion
-					(re-search-backward
-					 "^\\s-*\\=" nil t))))
-			     (insert "\n")))
-	((eq element '%) (if (not (or (eolp)
-				      (save-excursion
-					(re-search-forward
-					 "\\=\\s-*$" nil t))))
-			     (insert "\n")))
-	((eq element 'n) (insert "\n"))
-	((eq element 'n>) (insert "\n") (indent-according-to-mode))
-	;; Bug: If the 'o is the first element in a template, strange
-	;; things can happen when the template is inserted at the
-	;; beginning of a line.
-	((eq element 'o) (if (not (or on-region
-				      (eolp)
-				      (save-excursion
-					(re-search-forward
-					 "\\=\\s-*$" nil t))))
-			     (open-line 1)))
-	((null element))
-	(t (tempo-insert (or (tempo-is-user-element element)
-			     (eval element))
-			 on-region))))
-
-;;;
-;;; tempo-insert-prompt
-
-(defun tempo-insert-prompt-compat (prompt)
-  "Compatibility hack for tempo-insert-prompt.
-PROMPT can be either a prompt string, or a list of arguments to
-tempo-insert-prompt, or nil."
-  (if (consp prompt)			; not NIL either
-      (apply 'tempo-insert-prompt prompt)
-    (tempo-insert-prompt prompt)))
-
-(defun tempo-insert-prompt (prompt &optional save-name no-insert)
-  "Prompt for a text string and insert it in the current buffer.
-If the variable `tempo-interactive' is non-nil the user is prompted
-for a string in the minibuffer, which is then inserted in the current
-buffer. If `tempo-interactive' is nil, the current point is placed on
-`tempo-mark'.
-
-PROMPT is the prompt string, SAVE-NAME is a name to save the inserted
-text under. If the optional argument NO-INSERT is non-nil, no text i
-inserted. This can be useful when there is a SAVE-NAME.
-
-If there already is a value for SAVE-NAME, it is used and the user is
-never prompted."
-  (let (insertion
-	(previous (and save-name
-		       (tempo-lookup-named save-name))))
-    (cond
-     ;; Insert  previous value, unless no-insert is non-nil
-     ((and previous
-	   (not no-insert))
-      (tempo-insert-named save-name)) ; A double lookup here, but who
-				      ; cares
-     ;; If no-insert is non-nil, don't insert the previous value. Just
-     ;; keep it
-     (previous
-      nil)
-     ;; No previous value. Prompt or insert mark
-     (tempo-interactive
-      (if (not (stringp prompt))
-	  (error "tempo: The prompt (%s) is not a string" prompt))
-      (setq insertion (read-string prompt))
-      (or no-insert
-	  (insert insertion))
-      (if save-name
-	  (tempo-save-named save-name insertion)))
-     (t
-      (tempo-insert-mark (point-marker))))))
-
-;;;
-;;; tempo-is-user-element
-
-(defun tempo-is-user-element (element)
-  "Tries all the user-defined element handlers in
-`tempo-user-elements'"
-  ;; Sigh... I need (some list)
-  (catch 'found
-    (mapcar (function (lambda (handler)
-			(let ((result (funcall handler element)))
-			  (if result (throw 'found result)))))
-	    tempo-user-elements)
-    (throw 'found nil)))
-
-;;;
-;;; tempo-forget-insertions
-
-(defun tempo-forget-insertions ()
-  "Forget all the saved named insertions."
-  (setq tempo-named-insertions nil))
-
-;;;
-;;; tempo-save-named
-
-(defun tempo-save-named (name data)	; Had an optional prompt for 'v
-  "Save some data for later insertion
-The contents of DATA is saved under the name NAME.
-
-The data can later be retrieved with `tempo-lookup-named'.
-
-This function returns nil, so it can be used in a template without
-inserting anything."
-  (setq tempo-named-insertions
-	(cons (cons name data)
-	      tempo-named-insertions))
-  nil)
-
-;;;
-;;; tempo-lookup-named
-
-(defun tempo-lookup-named (name)
-  "Lookup some saved data under the name NAME.
-Returns the data if NAME was found, and nil otherwise."
-  (cdr (assq name tempo-named-insertions)))
-
-;;;
-;;; tempo-insert-named
-
-(defun tempo-insert-named (name)
-  "Insert the previous insertion saved under a named specified in NAME.
-If there is no such name saved, a tempo mark is inserted.
-
-Note that if the data is a string, it will not be run through the string
-processor."
-  (let* ((insertion (tempo-lookup-named name)))
-    (cond ((null insertion)
-	   (tempo-insert-mark (point-marker)))
-	  ((stringp insertion)
-	   (insert insertion))
-	  (t
-	   (tempo-insert insertion nil)))))
-
-
-;;;
-;;; tempo-process-and-insert-string
-
-(defun tempo-process-and-insert-string (string)
-  "Insert a string from a template.
-Run a string through the preprocessors in `tempo-insert-string-functions'
-and insert the results."
-  (cond ((null tempo-insert-string-functions)
-	 nil)
-	((symbolp tempo-insert-string-functions)
-	 (setq string
-	       (funcall tempo-insert-string-functions string)))
-	((listp tempo-insert-string-functions)
-	 (tempo-dolist (fn tempo-insert-string-functions)
-	   (setq string (funcall fn string))))
-	(t
-	 (error "Bogus value in tempo-insert-string-functions: %s"
-		tempo-insert-string-functions)))
-  (insert string))
-
-;;;
-;;; tempo-insert-mark
-
-(defun tempo-insert-mark (mark)
-  "Insert a mark `tempo-marks' while keeping it sorted"
-  (cond ((null tempo-marks) (setq tempo-marks (list mark)))
-	((< mark (car tempo-marks)) (setq tempo-marks (cons mark tempo-marks)))
-	(t (let ((lp tempo-marks))
-	     (while (and (cdr lp)
-			 (<= (car (cdr lp)) mark))
-	       (setq lp (cdr lp)))
-	     (if (not (= mark (car lp)))
-		 (setcdr lp (cons mark (cdr lp))))))))
-	  
-;;;
-;;; tempo-forward-mark
-
-(defun tempo-forward-mark ()
-  "Jump to the next mark in `tempo-forward-mark-list'."
-  (interactive)
-  (let ((next-mark (catch 'found
-		     (mapcar
-		      (function
-		       (lambda (mark)
-			 (if (< (point) mark)
-			     (throw 'found mark))))
-		      tempo-marks)
-		     ;; return nil if not found
-		     nil)))
-    (if next-mark
-	(goto-char next-mark))))
-
-;;;
-;;; tempo-backward-mark
-
-(defun tempo-backward-mark ()
-  "Jump to the previous mark in `tempo-back-mark-list'."
-  (interactive)
-  (let ((prev-mark (catch 'found
-		     (let (last)
-		       (mapcar
-			(function
-			 (lambda (mark)
-			   (if (<= (point) mark)
-			       (throw 'found last))
-			   (setq last mark)))
-			tempo-marks)
-		       last))))
-    (if prev-mark
-	(goto-char prev-mark))))
-	
-;;;
-;;; tempo-add-tag
-
-(defun tempo-add-tag (tag template &optional tag-list)
-  "Add a template tag.
-Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST,
-or to `tempo-tags' if TAG-LIST is nil."
-
-  (interactive "sTag: \nCTemplate: ")
-  (if (null tag-list)
-      (setq tag-list 'tempo-tags))
-  (if (not (assoc tag (symbol-value tag-list)))
-      (set tag-list (cons (cons tag template) (symbol-value tag-list))))
-  (tempo-invalidate-collection))
-
-;;;
-;;; tempo-use-tag-list
-
-(defun tempo-use-tag-list (tag-list &optional completion-function)
-  "Install TAG-LIST to be used for template completion in the current buffer.
-TAG-LIST is a symbol whose variable value is a tag list created with
-`tempo-add-tag'.
-
-COMPLETION-FUNCTION is an obsolete option for specifying an optional
-function or string that is used by `\\[tempo-complete-tag]' to find a
-string to match the tag against. It has the same definition as the
-variable `tempo-match-finder'. In this version, supplying a
-COMPLETION-FUNCTION just sets `tempo-match-finder' locally."
-  (let ((old (assq tag-list tempo-local-tags)))
-    (if old
-	(setcdr old completion-function)
-      (setq tempo-local-tags (cons (cons tag-list completion-function)
-				   tempo-local-tags))))
-  (if completion-function
-      (setq tempo-match-finder completion-function))
-  (tempo-invalidate-collection))
-
-;;;
-;;; tempo-invalidate-collection
-
-(defun tempo-invalidate-collection ()
-  "Marks the tag collection as obsolete.
-Whenever it is needed again it will be rebuilt."
-  (setq tempo-dirty-collection t))
-
-;;;
-;;; tempo-build-collection
-
-(defun tempo-build-collection ()
-  "Build a collection of all the tags and return it.
-If `tempo-dirty-collection' is NIL, the old collection is reused."
-  (prog1
-      (or (and (not tempo-dirty-collection)
-	       tempo-collection)
-	  (setq tempo-collection
-		(apply (function append)
-		       (mapcar (function (lambda (tag-list)
-					; If the format for
-					; tempo-local-tags changes,
-					; change this
-					   (eval (car tag-list))))
-			       tempo-local-tags))))
-    (setq tempo-dirty-collection nil)))
-
-;;;
-;;; tempo-find-match-string
-
-(defun tempo-find-match-string (finder)
-  "Find a string to be matched against a tag list.
-FINDER is a function or a string. Returns (STRING . POS), or nil
-if no reasonable string is found."
-  (cond ((stringp finder)
-	 (let (successful)
-	   (save-excursion
-	     (or (setq successful (re-search-backward finder nil t))
-		 0))
-	   (if successful
-	       (cons (buffer-substring (match-beginning 1)
-				       (match-end 1)) ; This seems to be a
-					; bug in emacs
-		     (match-beginning 1))
-	     nil)))
-	(t
-	 (funcall finder))))
-
-;;;
-;;; tempo-complete-tag
-
-(defun tempo-complete-tag (&optional silent)
-  "Look for a tag and expand it.
-All the tags in the tag lists in `tempo-local-tags'
-\(this includes `tempo-tags') are searched for a match for the text
-before the point.  The way the string to match for is determined can
-be altered with the variable `tempo-match-finder'. If
-`tempo-match-finder' returns nil, then the results are the same as
-no match at all.
-
-If a single match is found, the corresponding template is expanded in
-place of the matching string.
-
-If a partial completion or no match at all is found, and SILENT is
-non-NIL, the function will give a signal.
-
-If a partial completion is found and `tempo-show-completion-buffer' is
-non-NIL, a buffer containing possible completions is displayed."
-
-  ;; This function may look like a hack, but this is how I want it to
-  ;; work.
-  (interactive "*")
-  (let* ((collection (tempo-build-collection))
-	 (match-info (tempo-find-match-string tempo-match-finder))
-	 (match-string (car match-info))
-	 (match-start (cdr match-info))
-	 (exact (assoc match-string collection))
-	 (compl (or (car exact)
-		    (and match-info (try-completion match-string collection)))))
-    (if compl (delete-region match-start (point)))
-    (cond ((null match-info) (or silent (ding)))
-	  ((null compl) (or silent (ding)))
-	  ((eq compl t) (tempo-insert-template
-			 (cdr (assoc match-string
-				     collection))
-			 nil))
-	  (t (if (setq exact (assoc compl collection))
-		 (tempo-insert-template (cdr exact) nil)
-	       (insert compl)
-	       (or silent (ding))
-	       (if tempo-show-completion-buffer
-		   (tempo-display-completions match-string
-					      collection)))))))
-
-
-;;;
-;;; tempo-display-completions
-
-(defun tempo-display-completions (string tag-list)
-  "Show a buffer containing possible completions for STRING."
-  (if tempo-leave-completion-buffer
-      (with-output-to-temp-buffer "*Completions*"
-	(display-completion-list
-	 (all-completions string tag-list)))
-    (save-window-excursion
-      (with-output-to-temp-buffer "*Completions*"
-	(display-completion-list
-	 (all-completions string tag-list)))
-      (sit-for 32767))))
-
-;;;
-;;; tempo-expand-if-complete
-
-(defun tempo-expand-if-complete ()
-  "Expand the tag before point if it is complete.
-Returns non-nil if an expansion was made and nil otherwise.
-
-This could as an example be used in a command that is bound to the
-space bar, and looks something like this:
-
-(defun tempo-space ()
-  (interactive \"*\")
-  (or (tempo-expand-if-complete)
-      (insert \" \")))"
-
-  (interactive "*")
-  (let* ((collection (tempo-build-collection))
-	 (match-info (tempo-find-match-string tempo-match-finder))
-	 (match-string (car match-info))
-	 (match-start (cdr match-info))
-	 (exact (assoc match-string collection)))
-    (if exact
-	(progn
-	  (delete-region match-start (point))
-	  (tempo-insert-template (cdr exact) nil)
-	  t)
-      nil)))
-
-(provide 'tempo)
-
-;;; tempo.el ends here
diff --git a/lisp/term.el b/lisp/term.el
deleted file mode 100644
index 8e266c0e78a..00000000000
--- a/lisp/term.el
+++ /dev/null
@@ -1,3261 +0,0 @@
-;;; term.el --- general command interpreter in a window stuff
-
-;; Copyright (C) 1988, 1990, 1992, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Per Bothner <bothner@cygnus.com>
-;; Based on comint mode written by: Olin Shivers <shivers@cs.cmu.edu>
-;; Keyword: processes
-
-;; 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:
-
-;; The changelog is at the end of this file.
-
-;; Please send me bug reports, bug fixes, and extensions, so that I can
-;; merge them into the master source.
-;;     - Per Bothner (bothner@cygnus.com)
-
-;; This file defines a general command-interpreter-in-a-buffer package
-;; (term mode). The idea is that you can build specific process-in-a-buffer
-;; modes on top of term mode -- e.g., lisp, shell, scheme, T, soar, ....
-;; This way, all these specific packages share a common base functionality, 
-;; and a common set of bindings, which makes them easier to use (and
-;; saves code, implementation time, etc., etc.).
-
-;; For hints on converting existing process modes (e.g., tex-mode,
-;; background, dbx, gdb, kermit, prolog, telnet) to use term-mode
-;; instead of shell-mode, see the notes at the end of this file.
-
-
-;; Brief Command Documentation:
-;;============================================================================
-;; Term Mode Commands: (common to all derived modes, like cmushell & cmulisp
-;; mode)
-;;
-;; m-p	    term-previous-input    	  Cycle backwards in input history
-;; m-n	    term-next-input  	    	  Cycle forwards
-;; m-r     term-previous-matching-input  Previous input matching a regexp
-;; m-s     comint-next-matching-input      Next input that matches
-;; return  term-send-input
-;; c-c c-a term-bol                      Beginning of line; skip prompt.
-;; c-d	    term-delchar-or-maybe-eof     Delete char unless at end of buff.
-;; c-c c-u term-kill-input	    	    ^u
-;; c-c c-w backward-kill-word    	    ^w
-;; c-c c-c term-interrupt-subjob 	    ^c
-;; c-c c-z term-stop-subjob	    	    ^z
-;; c-c c-\ term-quit-subjob	    	    ^\
-;; c-c c-o term-kill-output		    Delete last batch of process output
-;; c-c c-r term-show-output		    Show last batch of process output
-;; c-c c-h term-dynamic-list-input-ring  List input history
-;;
-;; Not bound by default in term-mode
-;; term-send-invisible			Read a line w/o echo, and send to proc
-;; (These are bound in shell-mode)
-;; term-dynamic-complete		Complete filename at point.
-;; term-dynamic-list-completions	List completions in help buffer.
-;; term-replace-by-expanded-filename	Expand and complete filename at point;
-;;					replace with expanded/completed name.
-;; term-kill-subjob			No mercy.
-;; term-show-maximum-output            Show as much output as possible.
-;; term-continue-subjob		Send CONT signal to buffer's process
-;;					group. Useful if you accidentally
-;;					suspend your process (with C-c C-z).
-
-;; term-mode-hook is the term mode hook. Basically for your keybindings.
-;; term-load-hook is run after loading in this package.
-
-;; Code:
-
-;; This is passed to the inferior in the EMACS environment variable,
-;; so it is important to increase it if there are protocol-relevant changes.
-(defconst term-protocol-version "0.95")
-
-(require 'ring)
-(require 'ehelp)
-
-;;; Buffer Local Variables:
-;;;============================================================================
-;;; Term mode buffer local variables:
-;;;     term-prompt-regexp    - string       term-bol uses to match prompt.
-;;;     term-delimiter-argument-list - list  For delimiters and arguments
-;;;     term-last-input-start - marker       Handy if inferior always echoes
-;;;     term-last-input-end   - marker       For term-kill-output command
-;; For the input history mechanism:
-(defvar term-input-ring-size 32 "Size of input history ring.")
-;;;     term-input-ring-size  - integer
-;;;     term-input-ring       - ring
-;;;     term-input-ring-index - number           ...
-;;;     term-input-autoexpand - symbol           ...
-;;;     term-input-ignoredups - boolean          ...
-;;;     term-last-input-match - string           ...
-;;;     term-dynamic-complete-functions - hook   For the completion mechanism
-;;;     term-completion-fignore - list           ...
-;;;     term-get-old-input    - function     Hooks for specific 
-;;;     term-input-filter-functions - hook     process-in-a-buffer
-;;;     term-input-filter     - function         modes.
-;;;     term-input-send	- function
-;;;     term-scroll-to-bottom-on-output - symbol ...
-;;;     term-scroll-show-maximum-output - boolean...
-(defvar term-height) ;; Number of lines in window.
-(defvar term-width) ;; Number of columns in window.
-(defvar term-home-marker) ;; Marks the "home" position for cursor addressing.
-(defvar term-saved-home-marker nil) ;; When using alternate sub-buffer,
-;;		contains saved term-home-marker from original sub-buffer .
-(defvar term-start-line-column 0) ;; (current-column) at start of screen line,
-;;		or nil if unknown.
-(defvar term-current-column 0) ;; If non-nil, is cache for (current-column).
-(defvar term-current-row 0) ;; Current vertical row (relative to home-marker)
-;;		or nil if unknown.
-(defvar term-insert-mode nil)
-(defvar term-vertical-motion)
-(defvar term-terminal-state 0) ;; State of the terminal emulator:
-;;		state 0: Normal state
-;;		state 1: Last character was a graphic in the last column.
-;;		If next char is graphic, first move one column right
-;;		(and line warp) before displaying it.
-;;		This emulates (more or less) the behavior of xterm.
-;;		state 2: seen ESC
-;;		state 3: seen ESC [ (or ESC [ ?)
-;;		state 4: term-terminal-parameter contains pending output.
-(defvar term-kill-echo-list nil) ;; A queue of strings whose echo
-;;		we want suppressed.
-(defvar term-terminal-parameter)
-(defvar term-terminal-previous-parameter)
-(defvar term-current-face 'default)
-(defvar term-scroll-start 0) ;; Top-most line (inclusive) of scrolling region.
-(defvar term-scroll-end) ;; Number of line (zero-based) after scrolling region.
-(defvar term-pager-count nil) ;; If nil, paging is disabled.
-;;		Otherwise, number of lines before we need to page.
-(defvar term-saved-cursor nil)
-(defvar term-command-hook)
-(defvar term-log-buffer nil)
-(defvar term-scroll-with-delete nil) ;; term-scroll-with-delete is t if
-;;		forward scrolling should be implemented by delete to
-;;		top-most line(s); and nil if scrolling should be implemented
-;;		by moving term-home-marker.  It is set to t iff there is a
-;;		(non-default) scroll-region OR the alternate buffer is used.
-(defvar term-pending-delete-marker) ;; New user input in line mode needs to
-;;		be deleted, because it gets echoed by the inferior.
-;;		To reduce flicker, we defer the delete until the next output.
-(defvar term-old-mode-map nil) ;; Saves the old keymap when in char mode.
-(defvar term-old-mode-line-format) ;; Saves old mode-line-format while paging.
-(defvar term-pager-old-local-map nil) ;; Saves old keymap while paging.
-(defvar term-pager-old-filter) ;; Saved process-filter while paging.
-
-(defvar explicit-shell-file-name nil
-  "*If non-nil, is file name to use for explicitly requested inferior shell.")
-
-(defvar term-prompt-regexp "^"
-  "Regexp to recognise prompts in the inferior process.
-Defaults to \"^\", the null string at BOL.
-
-Good choices:
-  Canonical Lisp: \"^[^> \\n]*>+:? *\" (Lucid, franz, kcl, T, cscheme, oaklisp)
-  Lucid Common Lisp: \"^\\\\(>\\\\|\\\\(->\\\\)+\\\\) *\"
-  franz: \"^\\\\(->\\\\|<[0-9]*>:\\\\) *\"
-  kcl: \"^>+ *\"
-  shell: \"^[^#$%>\\n]*[#$%>] *\"
-  T: \"^>+ *\"
-
-This is a good thing to set in mode hooks.")
-
-(defvar term-delimiter-argument-list ()
-  "List of characters to recognise as separate arguments in input.
-Strings comprising a character in this list will separate the arguments
-surrounding them, and also be regarded as arguments in their own right (unlike
-whitespace).  See `term-arguments'.
-Defaults to the empty list.
-
-For shells, a good value is (?\\| ?& ?< ?> ?\\( ?\\) ?;).
-
-This is a good thing to set in mode hooks.")
-
-(defvar term-input-autoexpand nil
-  "*If non-nil, expand input command history references on completion.
-This mirrors the optional behavior of tcsh (its autoexpand and histlit).
-
-If the value is `input', then the expansion is seen on input.
-If the value is `history', then the expansion is only when inserting
-into the buffer's input ring.  See also `term-magic-space' and
-`term-dynamic-complete'.
-
-This variable is buffer-local.")
-
-(defvar term-input-ignoredups nil
-  "*If non-nil, don't add input matching the last on the input ring.
-This mirrors the optional behavior of bash.
-
-This variable is buffer-local.")
-
-(defvar term-input-ring-file-name nil
-  "*If non-nil, name of the file to read/write input history.
-See also `term-read-input-ring' and `term-write-input-ring'.
-
-This variable is buffer-local, and is a good thing to set in mode hooks.")
-
-(defvar term-scroll-to-bottom-on-output nil
-  "*Controls whether interpreter output causes window to scroll.
-If nil, then do not scroll.  If t or `all', scroll all windows showing buffer.
-If `this', scroll only the selected window.
-If `others', scroll only those that are not the selected window.
-
-The default is nil.
-
-See variable `term-scroll-show-maximum-output'.
-This variable is buffer-local.")
-
-(defvar term-scroll-show-maximum-output nil
-  "*Controls how interpreter output causes window to scroll.
-If non-nil, then show the maximum output when the window is scrolled.
-
-See variable `term-scroll-to-bottom-on-output'.
-This variable is buffer-local.")
-
-;; Where gud-display-frame should put the debugging arrow.  This is
-;; set by the marker-filter, which scans the debugger's output for
-;; indications of the current pc.
-(defvar term-pending-frame nil)
-
-;;; Here are the per-interpreter hooks.
-(defvar term-get-old-input (function term-get-old-input-default)
-  "Function that submits old text in term mode.
-This function is called when return is typed while the point is in old text.
-It returns the text to be submitted as process input.  The default is
-term-get-old-input-default, which grabs the current line, and strips off
-leading text matching term-prompt-regexp")
-
-(defvar term-dynamic-complete-functions
-  '(term-replace-by-expanded-history term-dynamic-complete-filename)
-  "List of functions called to perform completion.
-Functions should return non-nil if completion was performed.
-See also `term-dynamic-complete'.
-
-This is a good thing to set in mode hooks.")
-
-(defvar term-input-filter
-  (function (lambda (str) (not (string-match "\\`\\s *\\'" str))))
-  "Predicate for filtering additions to input history.
-Only inputs answering true to this function are saved on the input
-history list. Default is to save anything that isn't all whitespace")
-
-(defvar term-input-filter-functions '()
-  "Functions to call before input is sent to the process.
-These functions get one argument, a string containing the text to send.
-
-This variable is buffer-local.")
-
-(defvar term-input-sender (function term-simple-send)
-  "Function to actually send to PROCESS the STRING submitted by user.
-Usually this is just 'term-simple-send, but if your mode needs to 
-massage the input string, this is your hook. This is called from
-the user command term-send-input. term-simple-send just sends
-the string plus a newline.")
-
-(defvar term-eol-on-send t
-  "*Non-nil means go to the end of the line before sending input.
-See `term-send-input'.")
-
-(defvar term-mode-hook '()
-  "Called upon entry into term-mode
-This is run before the process is cranked up.")
-
-(defvar term-exec-hook '()
-  "Called each time a process is exec'd by term-exec.
-This is called after the process is cranked up.  It is useful for things that
-must be done each time a process is executed in a term-mode buffer (e.g.,
-\(process-kill-without-query)). In contrast, the term-mode-hook is only
-executed once when the buffer is created.")
-
-(defvar term-mode-map nil)
-(defvar term-raw-map nil
-  "Keyboard map for sending characters directly to the inferior process.")
-(defvar term-escape-char nil
-  "Escape character for char-sub-mode of term mode.
-Do not change it directly;  use term-set-escape-char instead.")
-(defvar term-raw-escape-map nil)
-
-(defvar term-pager-break-map nil)
-
-(defvar term-ptyp t
-  "True if communications via pty; false if by pipe.  Buffer local.
-This is to work around a bug in emacs process signaling.")
-
-(defvar term-last-input-match ""
-  "Last string searched for by term input history search, for defaulting.
-Buffer local variable.") 
-
-(defvar term-input-ring nil)
-(defvar term-last-input-start)
-(defvar term-last-input-end)
-(defvar term-input-ring-index nil
-  "Index of last matched history element.")
-(defvar term-matching-input-from-input-string ""
-  "Input previously used to match input history.")
-; This argument to set-process-filter disables reading from the process,
-; assuming this is emacs-19.20 or newer.
-(defvar term-pager-filter t)
-
-(put 'term-replace-by-expanded-history 'menu-enable 'term-input-autoexpand)
-(put 'term-input-ring 'permanent-local t)
-(put 'term-input-ring-index 'permanent-local t)
-(put 'term-input-autoexpand 'permanent-local t)
-(put 'term-input-filter-functions 'permanent-local t)
-(put 'term-scroll-to-bottom-on-output 'permanent-local t)
-(put 'term-scroll-show-maximum-output 'permanent-local t)
-(put 'term-ptyp 'permanent-local t)
-
-;; Do FORMS if running under Emacs-19.
-(defmacro term-if-emacs19 (&rest forms)
-  (if (string-match "^19" emacs-version) (cons 'progn forms)))
-;; True if running under XEmacs (previously Lucid emacs).
-(defmacro term-is-xemacs ()  '(string-match "Lucid" emacs-version))
-;; Do FORM if running under XEmacs (previously Lucid emacs).
-(defmacro term-if-xemacs (&rest forms)
-  (if (term-is-xemacs) (cons 'progn forms)))
-;; Do FORM if NOT running under XEmacs (previously Lucid emacs).
-(defmacro term-ifnot-xemacs (&rest forms)
-  (if (not (term-is-xemacs)) (cons 'progn forms)))
-
-(defmacro term-in-char-mode () '(eq (current-local-map) term-raw-map))
-(defmacro term-in-line-mode () '(not (term-in-char-mode)))
-;; True if currently doing PAGER handling.
-(defmacro term-pager-enabled () 'term-pager-count)
-(defmacro term-handling-pager () 'term-pager-old-local-map)
-(defmacro term-using-alternate-sub-buffer () 'term-saved-home-marker)
-
-(defvar term-signals-menu)
-(defvar term-terminal-menu)
-
-(term-if-xemacs
- (defvar term-terminal-menu
-   '("Terminal"
-     [ "Character mode" term-char-mode (term-in-line-mode)]
-     [ "Line mode" term-line-mode (term-in-char-mode)]
-     [ "Enable paging" term-pager-toggle (not term-pager-count)]
-     [ "Disable paging" term-pager-toggle term-pager-count])))
-
-(defun term-mode ()
-  "Major mode for interacting with an inferior interpreter.
-Interpreter name is same as buffer name, sans the asterisks.
-In line sub-mode, return at end of buffer sends line as input,
-while return not at end copies rest of line to end and sends it.
-In char sub-mode, each character (except `term-escape-char`) is
-set immediately.
-
-This mode is typically customised to create inferior-lisp-mode,
-shell-mode, etc.. This can be done by setting the hooks
-term-input-filter-functions, term-input-filter, term-input-sender and
-term-get-old-input to appropriate functions, and the variable
-term-prompt-regexp to the appropriate regular expression.
-
-An input history is maintained of size `term-input-ring-size', and
-can be accessed with the commands \\[term-next-input], \\[term-previous-input], and \\[term-dynamic-list-input-ring].
-Input ring history expansion can be achieved with the commands
-\\[term-replace-by-expanded-history] or \\[term-magic-space].
-Input ring expansion is controlled by the variable `term-input-autoexpand',
-and addition is controlled by the variable `term-input-ignoredups'.
-
-Input to, and output from, the subprocess can cause the window to scroll to
-the end of the buffer.  See variables `term-scroll-to-bottom-on-input',
-and `term-scroll-to-bottom-on-output'.
-
-If you accidentally suspend your process, use \\[term-continue-subjob]
-to continue it.
-
-\\{term-mode-map}
-
-Entry to this mode runs the hooks on term-mode-hook"
-  (interactive)
-    ;; Do not remove this.  All major modes must do this.
-    (kill-all-local-variables)
-    (setq major-mode 'term-mode)
-    (setq mode-name "Term")
-    (use-local-map term-mode-map)
-    (make-local-variable 'term-home-marker)
-    (setq term-home-marker (copy-marker 0))
-    (make-local-variable 'term-saved-home-marker)
-    (make-local-variable 'term-height)
-    (make-local-variable 'term-width)
-    (setq term-width (1- (window-width)))
-    (setq term-height (1- (window-height)))
-    (make-local-variable 'term-terminal-parameter)
-    (make-local-variable 'term-saved-cursor)
-    (make-local-variable 'term-last-input-start)
-    (setq term-last-input-start (make-marker))
-    (make-local-variable 'term-last-input-end)
-    (setq term-last-input-end (make-marker))
-    (make-local-variable 'term-last-input-match)
-    (setq term-last-input-match "")
-    (make-local-variable 'term-prompt-regexp)        ; Don't set; default
-    (make-local-variable 'term-input-ring-size)      ; ...to global val.
-    (make-local-variable 'term-input-ring)
-    (make-local-variable 'term-input-ring-file-name)
-    (or (and (boundp 'term-input-ring) term-input-ring)
-	(setq term-input-ring (make-ring term-input-ring-size)))
-    (make-local-variable 'term-input-ring-index)
-    (or (and (boundp 'term-input-ring-index) term-input-ring-index)
-	(setq term-input-ring-index nil))
-
-    (make-local-variable 'term-command-hook)
-    (setq term-command-hook (symbol-function 'term-command-hook))
-
-    (make-local-variable 'term-terminal-state)
-    (make-local-variable 'term-kill-echo-list)
-    (make-local-variable 'term-start-line-column)
-    (make-local-variable 'term-current-column)
-    (make-local-variable 'term-current-row)
-    (make-local-variable 'term-log-buffer)
-    (make-local-variable 'term-scroll-start)
-    (make-local-variable 'term-scroll-end)
-    (setq term-scroll-end term-height)
-    (make-local-variable 'term-scroll-with-delete)
-    (make-local-variable 'term-pager-count)
-    (make-local-variable 'term-pager-old-local-map)
-    (make-local-variable 'term-old-mode-map)
-    (make-local-variable 'term-insert-mode)
-    (make-local-variable 'term-dynamic-complete-functions)
-    (make-local-variable 'term-completion-fignore)
-    (make-local-variable 'term-get-old-input)
-    (make-local-variable 'term-matching-input-from-input-string)
-    (make-local-variable 'term-input-autoexpand)
-    (make-local-variable 'term-input-ignoredups)
-    (make-local-variable 'term-delimiter-argument-list)
-    (make-local-variable 'term-input-filter-functions)
-    (make-local-variable 'term-input-filter)  
-    (make-local-variable 'term-input-sender)
-    (make-local-variable 'term-eol-on-send)
-    (make-local-variable 'term-scroll-to-bottom-on-output)
-    (make-local-variable 'term-scroll-show-maximum-output)
-    (make-local-variable 'term-ptyp)
-    (make-local-variable 'term-exec-hook)
-    (make-local-variable 'term-vertical-motion)
-    (make-local-variable 'term-pending-delete-marker)
-    (setq term-pending-delete-marker (make-marker))
-    (make-local-variable 'term-current-face)
-    (make-local-variable 'term-pending-frame)
-    (setq term-pending-frame nil)
-    (run-hooks 'term-mode-hook)
-    (term-if-xemacs
-     (set-buffer-menubar
-      (append current-menubar (list term-terminal-menu))))
-    (or term-input-ring
-	(setq term-input-ring (make-ring term-input-ring-size)))
-    (term-update-mode-line))
-
-(if term-mode-map
-    nil
-  (setq term-mode-map (make-sparse-keymap))
-  (define-key term-mode-map "\ep" 'term-previous-input)
-  (define-key term-mode-map "\en" 'term-next-input)
-  (define-key term-mode-map "\er" 'term-previous-matching-input)
-  (define-key term-mode-map "\es" 'term-next-matching-input)
-  (term-ifnot-xemacs
-   (define-key term-mode-map [?\A-\M-r] 'term-previous-matching-input-from-input)
-   (define-key term-mode-map [?\A-\M-s] 'term-next-matching-input-from-input))
-  (define-key term-mode-map "\e\C-l" 'term-show-output)
-  (define-key term-mode-map "\C-m" 'term-send-input)
-  (define-key term-mode-map "\C-d" 'term-delchar-or-maybe-eof)
-  (define-key term-mode-map "\C-c\C-a" 'term-bol)
-  (define-key term-mode-map "\C-c\C-u" 'term-kill-input)
-  (define-key term-mode-map "\C-c\C-w" 'backward-kill-word)
-  (define-key term-mode-map "\C-c\C-c" 'term-interrupt-subjob)
-  (define-key term-mode-map "\C-c\C-z" 'term-stop-subjob)
-  (define-key term-mode-map "\C-c\C-\\" 'term-quit-subjob)
-  (define-key term-mode-map "\C-c\C-m" 'term-copy-old-input)
-  (define-key term-mode-map "\C-c\C-o" 'term-kill-output)
-  (define-key term-mode-map "\C-c\C-r" 'term-show-output)
-  (define-key term-mode-map "\C-c\C-e" 'term-show-maximum-output)
-  (define-key term-mode-map "\C-c\C-l" 'term-dynamic-list-input-ring)
-  (define-key term-mode-map "\C-c\C-n" 'term-next-prompt)
-  (define-key term-mode-map "\C-c\C-p" 'term-previous-prompt)
-  (define-key term-mode-map "\C-c\C-d" 'term-send-eof)
-  (define-key term-mode-map "\C-c\C-k" 'term-char-mode)
-  (define-key term-mode-map "\C-c\C-j" 'term-line-mode)
-  (define-key term-mode-map "\C-c\C-q" 'term-pager-toggle)
-
-  (copy-face 'default 'term-underline-face)
-  (set-face-underline-p 'term-underline-face t)
-
-;  ;; completion:
-;  (define-key term-mode-map [menu-bar completion] 
-;    (cons "Complete" (make-sparse-keymap "Complete")))
-;  (define-key term-mode-map [menu-bar completion complete-expand]
-;    '("Expand File Name" . term-replace-by-expanded-filename))
-;  (define-key term-mode-map [menu-bar completion complete-listing]
-;    '("File Completion Listing" . term-dynamic-list-filename-completions))
-;  (define-key term-mode-map [menu-bar completion complete-file]
-;    '("Complete File Name" . term-dynamic-complete-filename))
-;  (define-key term-mode-map [menu-bar completion complete]
-;    '("Complete Before Point" . term-dynamic-complete))
-;  ;; Put them in the menu bar:
-;  (setq menu-bar-final-items (append '(terminal completion inout signals)
-;				     menu-bar-final-items))
-  )
-
-;; Menu bars:
-(term-ifnot-xemacs
- (term-if-emacs19
-
-  ;; terminal:
-  (let (newmap)
-    (setq newmap (make-sparse-keymap "Terminal"))
-    (define-key newmap [terminal-pager-enable]
-      '("Enable paging" . term-fake-pager-enable))
-    (define-key newmap [terminal-pager-disable]
-      '("Disable paging" . term-fake-pager-disable))
-    (define-key newmap [terminal-char-mode]
-      '("Character mode" . term-char-mode))
-    (define-key newmap [terminal-line-mode]
-      '("Line mode" . term-line-mode))
-    (setq term-terminal-menu (cons "Terminal" newmap))
-
-    ;; completion:  (line mode only)
-    (defvar term-completion-menu (make-sparse-keymap "Complete"))
-    (define-key term-mode-map [menu-bar completion] 
-      (cons "Complete" term-completion-menu))
-    (define-key term-completion-menu [complete-expand]
-      '("Expand File Name" . term-replace-by-expanded-filename))
-    (define-key term-completion-menu [complete-listing]
-      '("File Completion Listing" . term-dynamic-list-filename-completions))
-    (define-key term-completion-menu [menu-bar completion complete-file]
-      '("Complete File Name" . term-dynamic-complete-filename))
-    (define-key term-completion-menu [menu-bar completion complete]
-      '("Complete Before Point" . term-dynamic-complete))
-
-    ;; Input history: (line mode only)
-    (defvar term-inout-menu (make-sparse-keymap "In/Out"))
-    (define-key term-mode-map [menu-bar inout] 
-      (cons "In/Out" term-inout-menu))
-    (define-key term-inout-menu [kill-output]
-      '("Kill Current Output Group" . term-kill-output))
-    (define-key term-inout-menu [next-prompt]
-      '("Forward Output Group" . term-next-prompt))
-    (define-key term-inout-menu [previous-prompt]
-      '("Backward Output Group" . term-previous-prompt))
-    (define-key term-inout-menu [show-maximum-output]
-      '("Show Maximum Output" . term-show-maximum-output))
-    (define-key term-inout-menu [show-output]
-      '("Show Current Output Group" . term-show-output))
-    (define-key term-inout-menu [kill-input]
-      '("Kill Current Input" . term-kill-input))
-    (define-key term-inout-menu [copy-input]
-      '("Copy Old Input" . term-copy-old-input))
-    (define-key term-inout-menu [forward-matching-history]
-      '("Forward Matching Input..." . term-forward-matching-input))
-    (define-key term-inout-menu [backward-matching-history]
-      '("Backward Matching Input..." . term-backward-matching-input))
-    (define-key term-inout-menu [next-matching-history]
-      '("Next Matching Input..." . term-next-matching-input))
-    (define-key term-inout-menu [previous-matching-history]
-      '("Previous Matching Input..." . term-previous-matching-input))
-    (define-key term-inout-menu [next-matching-history-from-input]
-      '("Next Matching Current Input" . term-next-matching-input-from-input))
-    (define-key term-inout-menu [previous-matching-history-from-input]
-      '("Previous Matching Current Input" . term-previous-matching-input-from-input))
-    (define-key term-inout-menu [next-history]
-      '("Next Input" . term-next-input))
-    (define-key term-inout-menu [previous-history]
-      '("Previous Input" . term-previous-input))
-    (define-key term-inout-menu [list-history]
-      '("List Input History" . term-dynamic-list-input-ring))
-    (define-key term-inout-menu [expand-history]
-      '("Expand History Before Point" . term-replace-by-expanded-history))
-
-    ;; Signals
-    (setq newmap (make-sparse-keymap "Signals"))
-    (define-key newmap [eof] '("EOF" . term-send-eof))
-    (define-key newmap [kill] '("KILL" . term-kill-subjob))
-    (define-key newmap [quit] '("QUIT" . term-quit-subjob))
-    (define-key newmap [cont] '("CONT" . term-continue-subjob))
-    (define-key newmap [stop] '("STOP" . term-stop-subjob))
-    (define-key newmap [] '("BREAK" . term-interrupt-subjob))
-    (define-key term-mode-map [menu-bar signals]
-      (setq term-signals-menu (cons "Signals" newmap)))
-    )))
-
-(defun term-reset-size (height width)
-  (setq term-height height)
-  (setq term-width width)
-  (setq term-start-line-column nil)
-  (setq term-current-row nil)
-  (setq term-current-column nil)
-  (term-scroll-region 0 height))
-
-;; Recursive routine used to check if any string in term-kill-echo-list
-;; matches part of the buffer before point.
-;; If so, delete that matched part of the buffer - this suppresses echo.
-;; Also, remove that string from the term-kill-echo-list.
-;; We *also* remove any older string on the list, as a sanity measure,
-;; in case something gets out of sync.  (Except for type-ahead, there
-;; should only be one element in the list.)
-
-(defun term-check-kill-echo-list ()
-  (let ((cur term-kill-echo-list) (found nil) (save-point (point)))
-    (unwind-protect
-	(progn
-	  (end-of-line)
-	  (while cur
-	    (let* ((str (car cur)) (len (length str)) (start (- (point) len)))
-	      (if (and (>= start (point-min))
-		       (string= str (buffer-substring start (point))))
-		  (progn (delete-backward-char len)
-			 (setq term-kill-echo-list (cdr cur))
-			 (setq term-current-column nil)
-			 (setq term-current-row nil)
-			 (setq term-start-line-column nil)
-			 (setq cur nil found t))
-		(setq cur (cdr cur))))))
-      (if (not found)
-	  (goto-char save-point)))
-    found))
-
-(defun term-check-size (process)
-  (if (or (/= term-height (1- (window-height)))
-	  (/= term-width (1- (window-width))))
-      (progn
-	(term-reset-size (1- (window-height)) (1- (window-width)))
-	(set-process-window-size process term-height term-width))))
-
-(defun term-send-raw-string (chars)
-  (let ((proc (get-buffer-process (current-buffer))))
-    (if (not proc)
-	(error "Current buffer has no process")
-      ;; Note that (term-current-row) must be called *after*
-      ;; (point) has been updated to (process-mark proc).
-      (goto-char (process-mark proc))
-      (if (term-pager-enabled)
-	  (setq term-pager-count (term-current-row)))
-      (process-send-string proc chars))))
-
-(defun term-send-raw ()
-  "Send the last character typed through the terminal-emulator
-without any interpretation." 
-  (interactive)
- ;; Convert `return' to C-m, etc.
-  (if (and (symbolp last-input-char)
-	   (get last-input-char 'ascii-character))
-      (setq last-input-char (get last-input-char 'ascii-character)))
-  (term-send-raw-string (make-string 1 last-input-char)))
-
-(defun term-send-raw-meta ()
-  (interactive)
-  (if (symbolp last-input-char)
-      ;; Convert `return' to C-m, etc.
-      (let ((tmp (get last-input-char 'event-symbol-elements)))
-	(if tmp
-	    (setq last-input-char (car tmp)))
-	(if (symbolp last-input-char)
-	    (progn
-	      (setq tmp (get last-input-char 'ascii-character))
-	      (if tmp (setq last-input-char tmp))))))
-  (term-send-raw-string (if (and (numberp last-input-char)
-				 (> last-input-char 127)
-				 (< last-input-char 256))
-			    (make-string 1 last-input-char)
-			  (format "\e%c" last-input-char))))
-
-(defun term-mouse-paste (click arg)
-  "Insert the last stretch of killed text at the position clicked on."
-  (interactive "e\nP")
-  (term-if-xemacs
-   (term-send-raw-string (or (condition-case () (x-get-selection) (error ()))
-			     (x-get-cutbuffer)
-			     (error "No selection or cut buffer available"))))
-  (term-ifnot-xemacs
-   ;; Give temporary modes such as isearch a chance to turn off.
-   (run-hooks 'mouse-leave-buffer-hook)
-   (setq this-command 'yank)
-   (term-send-raw-string (current-kill (cond
-					((listp arg) 0)
-					((eq arg '-) -1)
-					(t (1- arg)))))))
-
-;; Which would be better:  "\e[A" or "\eOA"? readline accepts either.
-(defun term-send-up    () (interactive) (term-send-raw-string "\e[A"))
-(defun term-send-down  () (interactive) (term-send-raw-string "\e[B"))
-(defun term-send-right () (interactive) (term-send-raw-string "\e[C"))
-(defun term-send-left  () (interactive) (term-send-raw-string "\e[D"))
-
-(defun term-set-escape-char (c)
-  "Change term-escape-char and keymaps that depend on it."
-  (if term-escape-char
-      (define-key term-raw-map term-escape-char 'term-send-raw))
-  (setq c (make-string 1 c))
-  (define-key term-raw-map c term-raw-escape-map)
-  ;; Define standard bindings in term-raw-escape-map
-  (define-key term-raw-escape-map "\C-x"
-    (lookup-key (current-global-map) "\C-x"))
-  (define-key term-raw-escape-map "\C-v"
-    (lookup-key (current-global-map) "\C-v"))
-  (define-key term-raw-escape-map "\C-u"
-    (lookup-key (current-global-map) "\C-u"))
-  (define-key term-raw-escape-map c 'term-send-raw)
-  (define-key term-raw-escape-map "\C-q" 'term-pager-toggle)
-  ;; The keybinding for term-char-mode is needed by the menubar code.
-  (define-key term-raw-escape-map "\C-k" 'term-char-mode)
-  (define-key term-raw-escape-map "\C-j" 'term-line-mode))
-    
-(defun term-char-mode ()
-  "Switch to char (\"raw\") sub-mode of term mode.
-Each character you type is sent directly to the inferior without
-intervention from emacs, except for the escape character (usually C-c)."
-  (interactive)
-  (if (not term-raw-map)
-      (let* ((map (make-keymap))
-	     (esc-map (make-keymap))
-	     (i 0))
-	(while (< i 128)
-	  (define-key map (make-string 1 i) 'term-send-raw)
-	  (define-key esc-map (make-string 1 i) 'term-send-raw-meta)
-	  (setq i (1+ i)))
-	(define-key map "\e" esc-map)
-	(setq term-raw-map map)
-	(setq term-raw-escape-map
-	      (copy-keymap (lookup-key (current-global-map) "\C-x")))
-	(term-if-emacs19
-	 (term-if-xemacs
-	  (define-key term-raw-map [button2] 'term-mouse-paste))
-	 (term-ifnot-xemacs
-	  (define-key term-raw-map [mouse-2] 'term-mouse-paste)
-	  (define-key term-raw-map [menu-bar terminal] term-terminal-menu)
-	  (define-key term-raw-map [menu-bar signals] term-signals-menu))
-	 (define-key term-raw-map [up] 'term-send-up)
-	 (define-key term-raw-map [down] 'term-send-down)
-	 (define-key term-raw-map [right] 'term-send-right)
-	 (define-key term-raw-map [left] 'term-send-left))
-	(term-set-escape-char ?\C-c)))
-  ;; FIXME: Emit message? Cfr ilisp-raw-message
-  (if (term-in-line-mode)
-      (progn
-	(setq term-old-mode-map (current-local-map))
-	(use-local-map term-raw-map)
-
-	;; Send existing partial line to inferior (without newline).
-	(let ((pmark (process-mark (get-buffer-process (current-buffer))))
-	      (save-input-sender term-input-sender))
-	  (if (> (point) pmark)
-	      (unwind-protect
-		  (progn
-		    (setq term-input-sender
-			  (symbol-function 'term-send-string))
-		    (end-of-line)
-		    (term-send-input))
-		(setq term-input-sender save-input-sender))))
-	(term-update-mode-line))))
-
-(defun term-line-mode  ()
-  "Switch to line (\"cooked\") sub-mode of term mode.
-This means that emacs editing commands work as normally, until
-you type \\[term-send-input] which sends the current line to the inferior."
-  (interactive)
-  (if (term-in-char-mode)
-      (progn
-	(use-local-map term-old-mode-map)
-	(term-update-mode-line))))
-
-(defun term-update-mode-line ()
-  (setq mode-line-process
-	(if (term-in-char-mode)
-	    (if (term-pager-enabled) '(": char page %s") '(": char %s"))
-	  (if (term-pager-enabled) '(": line page %s") '(": line %s"))))
-  (force-mode-line-update))
-
-(defun term-check-proc (buffer)
-  "True if there is a process associated w/buffer BUFFER, and
-it is alive (status RUN or STOP). BUFFER can be either a buffer or the
-name of one"
-  (let ((proc (get-buffer-process buffer)))
-    (and proc (memq (process-status proc) '(run stop)))))
-
-;;; Note that this guy, unlike shell.el's make-shell, barfs if you pass it ()
-;;; for the second argument (program).
-;;;###autoload
-(defun make-term (name program &optional startfile &rest switches)
-"Make a term process NAME in a buffer, running PROGRAM.
-The name of the buffer is made by surrounding NAME with `*'s.
-If there is already a running process in that buffer, it is not restarted.
-Optional third arg STARTFILE is the name of a file to send the contents of to 
-the process.  Any more args are arguments to PROGRAM."
-  (let ((buffer (get-buffer-create (concat "*" name "*"))))
-    ;; If no process, or nuked process, crank up a new one and put buffer in
-    ;; term mode. Otherwise, leave buffer and existing process alone.
-    (cond ((not (term-check-proc buffer))
-	   (save-excursion
-	     (set-buffer buffer)
-	     (term-mode)) ; Install local vars, mode, keymap, ...
-	   (term-exec buffer name program startfile switches)))
-    buffer))
-
-;;;###autoload
-(defun term (program)
-  "Start a terminal-emulator in a new buffer."
-  (interactive (list (read-from-minibuffer "Run program: "
-					   (or explicit-shell-file-name
-					       (getenv "ESHELL")
-					       (getenv "SHELL")
-					       "/bin/sh"))))
-  (set-buffer (make-term "terminal" program))
-  (term-mode)
-  (term-char-mode)
-  (switch-to-buffer "*terminal*"))
-
-(defun term-exec (buffer name command startfile switches)
-  "Start up a process in buffer for term modes.
-Blasts any old process running in the buffer. Doesn't set the buffer mode.
-You can use this to cheaply run a series of processes in the same term
-buffer. The hook term-exec-hook is run after each exec."
-  (save-excursion
-    (set-buffer buffer)
-    (let ((proc (get-buffer-process buffer)))	; Blast any old process.
-      (if proc (delete-process proc)))
-    ;; Crank up a new process
-    (let ((proc (term-exec-1 name buffer command switches)))
-      (make-local-variable 'term-ptyp)
-      (setq term-ptyp process-connection-type) ; T if pty, NIL if pipe.
-      ;; Jump to the end, and set the process mark.
-      (goto-char (point-max))
-      (set-marker (process-mark proc) (point))
-      (set-process-filter proc 'term-emulate-terminal)
-      ;; Feed it the startfile.
-      (cond (startfile
-	     ;;This is guaranteed to wait long enough
-	     ;;but has bad results if the term does not prompt at all
-	     ;;	     (while (= size (buffer-size))
-	     ;;	       (sleep-for 1))
-	     ;;I hope 1 second is enough!
-	     (sleep-for 1)
-	     (goto-char (point-max))
-	     (insert-file-contents startfile)
-	     (setq startfile (buffer-substring (point) (point-max)))
-	     (delete-region (point) (point-max))
-	     (term-send-string proc startfile)))
-    (run-hooks 'term-exec-hook)
-    buffer)))
-
-;;; Name to use for TERM.
-;;; Using "emacs" loses, because bash disables editing if TERM == emacs.
-(defvar term-term-name "eterm")
-; Format string, usage: (format term-termcap-string emacs-term-name "TERMCAP=" 24 80)
-(defvar term-termcap-format
-  "%s%s:li#%d:co#%d:cl=\\E[H\\E[J:cd=\\E[J:bs:am:xn:cm=\\E[%%i%%d;%%dH\
-:nd=\\E[C:up=\\E[A:ce=\\E[K:ho=\\E[H:pt\
-:al=\\E[L:dl=\\E[M:DL=\\E[%%dM:AL=\\E[%%dL:cs=\\E[%%i%%d;%%dr:sf=\\n\
-:te=\\E[2J\\E[?47l\\E8:ti=\\E7\\E[?47h\
-:dc=\\E[P:DC=\\E[%%dP:IC=\\E[%%d@:im=\\E[4h:ei=\\E[4l:mi:\
-:so=\\E[7m:se=\\E[m:us=\\E[4m:ue=\\E[m:md=\\E[1m:mr=\\E[7m:me=\\E[m\
-:UP=\\E[%%dA:DO=\\E[%%dB:LE=\\E[%%dD:RI=\\E[%%dC"
-;;; : -undefine ic
-  "termcap capabilities supported")
-
-;;; This auxiliary function cranks up the process for term-exec in
-;;; the appropriate environment.
-
-(defun term-exec-1 (name buffer command switches)
-  ;; We need to do an extra (fork-less) exec to run stty.
-  ;; (This would not be needed if we had suitable emacs primitives.)
-  ;; The 'if ...; then shift; fi' hack is because Bourne shell
-  ;; loses one arg when called with -c, and newer shells (bash,  ksh) don't.
-  ;; Thus we add an extra dummy argument "..", and then remove it.
-  (let ((process-environment
-	 (nconc
-	  (list
-	   (format "TERM=%s" term-term-name)
-	   (if (and (boundp 'system-uses-terminfo) system-uses-terminfo)
-	       (format "TERMINFO=%s" data-directory)
-	    (format term-termcap-format "TERMCAP="
-		    term-term-name term-height term-width))
-	   (format "EMACS=%s (term:%s)" emacs-version term-protocol-version)
-	   (format "LINES=%d" term-height)
-	   (format "COLUMNS=%d" term-width))
-	  process-environment))
-	(process-connection-type t))
-    (apply 'start-process name buffer
-	   "/bin/sh" "-c"
-	   (format "stty -nl echo rows %d columns %d sane 2>/dev/null;\
-if [ $1 = .. ]; then shift; fi; exec \"$@\""
-		   term-height term-width)
-	   ".."
-	   command switches)))
-
-;;; This should be in emacs, but it isn't.
-(defun term-mem (item list &optional elt=)
-  "Test to see if ITEM is equal to an item in LIST.
-Option comparison function ELT= defaults to equal."
-  (let ((elt= (or elt= (function equal)))
-	(done nil))
-    (while (and list (not done))
-      (if (funcall elt= item (car list))
-	  (setq done list)
-	  (setq list (cdr list))))
-    done))
-
-
-;;; Input history processing in a buffer
-;;; ===========================================================================
-;;; Useful input history functions, courtesy of the Ergo group.
-
-;;; Eleven commands:
-;;; term-dynamic-list-input-ring	List history in help buffer.
-;;; term-previous-input		Previous input...
-;;; term-previous-matching-input	...matching a string.
-;;; term-previous-matching-input-from-input ... matching the current input.
-;;; term-next-input			Next input...
-;;; term-next-matching-input		...matching a string.
-;;; term-next-matching-input-from-input     ... matching the current input.
-;;; term-backward-matching-input      Backwards input...
-;;; term-forward-matching-input       ...matching a string.
-;;; term-replace-by-expanded-history	Expand history at point;
-;;;					replace with expanded history.
-;;; term-magic-space			Expand history and insert space.
-;;;
-;;; Three functions:
-;;; term-read-input-ring              Read into term-input-ring...
-;;; term-write-input-ring             Write to term-input-ring-file-name.
-;;; term-replace-by-expanded-history-before-point Workhorse function.
-
-(defun term-read-input-ring (&optional silent)
-  "Sets the buffer's `term-input-ring' from a history file.
-The name of the file is given by the variable `term-input-ring-file-name'.
-The history ring is of size `term-input-ring-size', regardless of file size.
-If `term-input-ring-file-name' is nil this function does nothing.
-
-If the optional argument SILENT is non-nil, we say nothing about a
-failure to read the history file.
-
-This function is useful for major mode commands and mode hooks.
-
-The structure of the history file should be one input command per line,
-with the most recent command last.
-See also `term-input-ignoredups' and `term-write-input-ring'."
-  (cond ((or (null term-input-ring-file-name)
-	     (equal term-input-ring-file-name ""))
-	 nil)
-	((not (file-readable-p term-input-ring-file-name))
-	 (or silent
-	     (message "Cannot read history file %s"
-		      term-input-ring-file-name)))
-	(t
-	 (let ((history-buf (get-buffer-create " *temp*"))
-	       (file term-input-ring-file-name)
-	       (count 0)
-	       (ring (make-ring term-input-ring-size)))
-	   (unwind-protect
-	       (save-excursion
-		 (set-buffer history-buf)
-		 (widen)
-		 (erase-buffer)
-		 (insert-file-contents file)
-		 ;; Save restriction in case file is already visited...
-		 ;; Watch for those date stamps in history files!
-		 (goto-char (point-max))
-		 (while (and (< count term-input-ring-size)
-			     (re-search-backward "^[ \t]*\\([^#\n].*\\)[ \t]*$"
-						 nil t))
-		   (let ((history (buffer-substring (match-beginning 1)
-						    (match-end 1))))
-		     (if (or (null term-input-ignoredups)
-			     (ring-empty-p ring)
-			     (not (string-equal (ring-ref ring 0) history)))
-			 (ring-insert-at-beginning ring history)))
-		   (setq count (1+ count))))
-	     (kill-buffer history-buf))
-	   (setq term-input-ring ring
-		 term-input-ring-index nil)))))
-
-(defun term-write-input-ring ()
-  "Writes the buffer's `term-input-ring' to a history file.
-The name of the file is given by the variable `term-input-ring-file-name'.
-The original contents of the file are lost if `term-input-ring' is not empty.
-If `term-input-ring-file-name' is nil this function does nothing.
-
-Useful within process sentinels.
-
-See also `term-read-input-ring'."
-  (cond ((or (null term-input-ring-file-name)
-	     (equal term-input-ring-file-name "")
-	     (null term-input-ring) (ring-empty-p term-input-ring))
-	 nil)
-	((not (file-writable-p term-input-ring-file-name))
-	 (message "Cannot write history file %s" term-input-ring-file-name))
-	(t
-	 (let* ((history-buf (get-buffer-create " *Temp Input History*"))
-		(ring term-input-ring)
-		(file term-input-ring-file-name)
-		(index (ring-length ring)))
-	   ;; Write it all out into a buffer first.  Much faster, but messier,
-	   ;; than writing it one line at a time.
-	   (save-excursion
-	     (set-buffer history-buf)
-	     (erase-buffer)
-	     (while (> index 0)
-	       (setq index (1- index))
-	       (insert (ring-ref ring index) ?\n))
-	     (write-region (buffer-string) nil file nil 'no-message)
-	     (kill-buffer nil))))))
-
-
-(defun term-dynamic-list-input-ring ()
-  "List in help buffer the buffer's input history."
-  (interactive)
-  (if (or (not (ring-p term-input-ring))
-	  (ring-empty-p term-input-ring))
-      (message "No history")
-    (let ((history nil)
-	  (history-buffer " *Input History*")
-	  (index (1- (ring-length term-input-ring)))
-	  (conf (current-window-configuration)))
-      ;; We have to build up a list ourselves from the ring vector.
-      (while (>= index 0)
-	(setq history (cons (ring-ref term-input-ring index) history)
-	      index (1- index)))
-      ;; Change "completion" to "history reference"
-      ;; to make the display accurate.
-      (with-output-to-temp-buffer history-buffer
-	(display-completion-list history)
-	(set-buffer history-buffer)
-	(forward-line 3)
-	(while (search-backward "completion" nil 'move)
-	  (replace-match "history reference")))
-      (sit-for 0)
-      (message "Hit space to flush")
-      (let ((ch (read-event)))
-	(if (eq ch ?\ )
-	    (set-window-configuration conf)
-	  (setq unread-command-events (list ch)))))))
-
-
-(defun term-regexp-arg (prompt)
-  ;; Return list of regexp and prefix arg using PROMPT.
-  (let* ((minibuffer-history-sexp-flag nil)
-	 ;; Don't clobber this.
-	 (last-command last-command)
-	 (regexp (read-from-minibuffer prompt nil nil nil
-				       'minibuffer-history-search-history)))
-    (list (if (string-equal regexp "")
-	      (setcar minibuffer-history-search-history
-		      (nth 1 minibuffer-history-search-history))
-	    regexp)
-	  (prefix-numeric-value current-prefix-arg))))
-
-(defun term-search-arg (arg)
-  ;; First make sure there is a ring and that we are after the process mark
-  (cond ((not (term-after-pmark-p))
-	 (error "Not at command line"))
-	((or (null term-input-ring)
-	     (ring-empty-p term-input-ring))
-	 (error "Empty input ring"))
-	((zerop arg)
-	 ;; arg of zero resets search from beginning, and uses arg of 1
-	 (setq term-input-ring-index nil)
-	 1)
-	(t
-	 arg)))
-
-(defun term-search-start (arg)
-  ;; Index to start a directional search, starting at term-input-ring-index
-  (if term-input-ring-index
-      ;; If a search is running, offset by 1 in direction of arg
-      (mod (+ term-input-ring-index (if (> arg 0) 1 -1))
-	   (ring-length term-input-ring))
-    ;; For a new search, start from beginning or end, as appropriate
-    (if (>= arg 0)
-	0				       ; First elt for forward search
-      (1- (ring-length term-input-ring)))))  ; Last elt for backward search
-
-(defun term-previous-input-string (arg)
-  "Return the string ARG places along the input ring.
-Moves relative to `term-input-ring-index'."
-  (ring-ref term-input-ring (if term-input-ring-index
-				  (mod (+ arg term-input-ring-index) 
-				       (ring-length term-input-ring))
-				arg)))
-
-(defun term-previous-input (arg)
-  "Cycle backwards through input history."
-  (interactive "*p")
-  (term-previous-matching-input "." arg))
-
-(defun term-next-input (arg)
-  "Cycle forwards through input history."
-  (interactive "*p")
-  (term-previous-input (- arg)))
-
-(defun term-previous-matching-input-string (regexp arg)
-  "Return the string matching REGEXP ARG places along the input ring.
-Moves relative to `term-input-ring-index'."
-  (let* ((pos (term-previous-matching-input-string-position regexp arg)))
-    (if pos (ring-ref term-input-ring pos))))
-
-(defun term-previous-matching-input-string-position (regexp arg &optional start)
-  "Return the index matching REGEXP ARG places along the input ring.
-Moves relative to START, or `term-input-ring-index'."
-  (if (or (not (ring-p term-input-ring))
-	  (ring-empty-p term-input-ring))
-      (error "No history"))
-  (let* ((len (ring-length term-input-ring))
-	 (motion (if (> arg 0) 1 -1))
-	 (n (mod (- (or start (term-search-start arg)) motion) len))
-	 (tried-each-ring-item nil)
-	 (prev nil))
-    ;; Do the whole search as many times as the argument says.
-    (while (and (/= arg 0) (not tried-each-ring-item))
-      ;; Step once.
-      (setq prev n
-	    n (mod (+ n motion) len))
-      ;; If we haven't reached a match, step some more.
-      (while (and (< n len) (not tried-each-ring-item)
-		  (not (string-match regexp (ring-ref term-input-ring n))))
-	(setq n (mod (+ n motion) len)
-	      ;; If we have gone all the way around in this search.
-	      tried-each-ring-item (= n prev)))
-      (setq arg (if (> arg 0) (1- arg) (1+ arg))))
-    ;; Now that we know which ring element to use, if we found it, return that.
-    (if (string-match regexp (ring-ref term-input-ring n))
-	n)))
-
-(defun term-previous-matching-input (regexp arg)
-  "Search backwards through input history for match for REGEXP.
-\(Previous history elements are earlier commands.)
-With prefix argument N, search for Nth previous match.
-If N is negative, find the next or Nth next match."
-  (interactive (term-regexp-arg "Previous input matching (regexp): "))
-  (setq arg (term-search-arg arg))
-  (let ((pos (term-previous-matching-input-string-position regexp arg)))
-    ;; Has a match been found?
-    (if (null pos)
-	(error "Not found")
-      (setq term-input-ring-index pos)
-      (message "History item: %d" (1+ pos))
-      (delete-region 
-       ;; Can't use kill-region as it sets this-command
-       (process-mark (get-buffer-process (current-buffer))) (point))
-      (insert (ring-ref term-input-ring pos)))))
-
-(defun term-next-matching-input (regexp arg)
-  "Search forwards through input history for match for REGEXP.
-\(Later history elements are more recent commands.)
-With prefix argument N, search for Nth following match.
-If N is negative, find the previous or Nth previous match."
-  (interactive (term-regexp-arg "Next input matching (regexp): "))
-  (term-previous-matching-input regexp (- arg)))
-
-(defun term-previous-matching-input-from-input (arg)
-  "Search backwards through input history for match for current input.
-\(Previous history elements are earlier commands.)
-With prefix argument N, search for Nth previous match.
-If N is negative, search forwards for the -Nth following match."
-  (interactive "p")
-  (if (not (memq last-command '(term-previous-matching-input-from-input
-				term-next-matching-input-from-input)))
-      ;; Starting a new search
-      (setq term-matching-input-from-input-string
-	    (buffer-substring 
-	     (process-mark (get-buffer-process (current-buffer))) 
-	     (point))
-	    term-input-ring-index nil))
-  (term-previous-matching-input
-   (concat "^" (regexp-quote term-matching-input-from-input-string))
-   arg))
-
-(defun term-next-matching-input-from-input (arg)
-  "Search forwards through input history for match for current input.
-\(Following history elements are more recent commands.)
-With prefix argument N, search for Nth following match.
-If N is negative, search backwards for the -Nth previous match."
-  (interactive "p")
-  (term-previous-matching-input-from-input (- arg)))
-
-
-(defun term-replace-by-expanded-history (&optional silent)
-  "Expand input command history references before point.
-Expansion is dependent on the value of `term-input-autoexpand'.
-
-This function depends on the buffer's idea of the input history, which may not
-match the command interpreter's idea, assuming it has one.
-
-Assumes history syntax is like typical Un*x shells'.  However, since emacs
-cannot know the interpreter's idea of input line numbers, assuming it has one,
-it cannot expand absolute input line number references.
-
-If the optional argument SILENT is non-nil, never complain
-even if history reference seems erroneous.
-
-See `term-magic-space' and `term-replace-by-expanded-history-before-point'.
-
-Returns t if successful."
-  (interactive)
-  (if (and term-input-autoexpand
-	   (string-match "[!^]" (funcall term-get-old-input))
-	   (save-excursion (beginning-of-line)
-			   (looking-at term-prompt-regexp)))
-      ;; Looks like there might be history references in the command.
-      (let ((previous-modified-tick (buffer-modified-tick)))
-	(message "Expanding history references...")
-	(term-replace-by-expanded-history-before-point silent)
-	(/= previous-modified-tick (buffer-modified-tick)))))
-
-
-(defun term-replace-by-expanded-history-before-point (silent)
-  "Expand directory stack reference before point.
-See `term-replace-by-expanded-history'.  Returns t if successful."
-  (save-excursion
-    (let ((toend (- (save-excursion (end-of-line nil) (point)) (point)))
-	  (start (progn (term-bol nil) (point))))
-      (while (progn
-	       (skip-chars-forward "^!^"
-				   (save-excursion
-				     (end-of-line nil) (- (point) toend)))
-	       (< (point)
-		  (save-excursion
-		    (end-of-line nil) (- (point) toend))))
-	;; This seems a bit complex.  We look for references such as !!, !-num,
-	;; !foo, !?foo, !{bar}, !?{bar}, ^oh, ^my^, ^god^it, ^never^ends^.
-	;; If that wasn't enough, the plings can be suffixed with argument
-	;; range specifiers.
-	;; Argument ranges are complex too, so we hive off the input line,
-	;; referenced with plings, with the range string to `term-args'.
-	(setq term-input-ring-index nil)
-	(cond ((or (= (preceding-char) ?\\)
-		   (term-within-quotes start (point)))
-	       ;; The history is quoted, or we're in quotes.
-	       (goto-char (1+ (point))))
-	      ((looking-at "![0-9]+\\($\\|[^-]\\)")
-	       ;; We cannot know the interpreter's idea of input line numbers.
-	       (goto-char (match-end 0))
-	       (message "Absolute reference cannot be expanded"))
-	      ((looking-at "!-\\([0-9]+\\)\\(:?[0-9^$*-]+\\)?")
-	       ;; Just a number of args from `number' lines backward.
-	       (let ((number (1- (string-to-number
-				  (buffer-substring (match-beginning 1)
-						    (match-end 1))))))
-		 (if (<= number (ring-length term-input-ring))
-		     (progn
-		       (replace-match
-			(term-args (term-previous-input-string number)
-				     (match-beginning 2) (match-end 2))
-			t t)
-		       (setq term-input-ring-index number)
-		       (message "History item: %d" (1+ number)))
-		   (goto-char (match-end 0))
-		   (message "Relative reference exceeds input history size"))))
-	      ((or (looking-at "!!?:?\\([0-9^$*-]+\\)") (looking-at "!!"))
-	       ;; Just a number of args from the previous input line.
-	       (replace-match
-		(term-args (term-previous-input-string 0)
-			     (match-beginning 1) (match-end 1))
-		t t)
-	       (message "History item: previous"))
-	      ((looking-at
-		"!\\??\\({\\(.+\\)}\\|\\(\\sw+\\)\\)\\(:?[0-9^$*-]+\\)?")
-	       ;; Most recent input starting with or containing (possibly
-	       ;; protected) string, maybe just a number of args.  Phew.
-	       (let* ((mb1 (match-beginning 1)) (me1 (match-end 1))
-		      (mb2 (match-beginning 2)) (me2 (match-end 2))
-		      (exp (buffer-substring (or mb2 mb1) (or me2 me1)))
-		      (pref (if (save-match-data (looking-at "!\\?")) "" "^"))
-		      (pos (save-match-data
-			     (term-previous-matching-input-string-position
-			      (concat pref (regexp-quote exp)) 1))))
-		 (if (null pos)
-		     (progn
-		       (goto-char (match-end 0))
-		       (or silent
-			   (progn (message "Not found")
-				  (ding))))
-		   (setq term-input-ring-index pos)
-		   (replace-match
-		    (term-args (ring-ref term-input-ring pos)
-				 (match-beginning 4) (match-end 4))
-		    t t)
-		   (message "History item: %d" (1+ pos)))))
-	      ((looking-at "\\^\\([^^]+\\)\\^?\\([^^]*\\)\\^?")
-	       ;; Quick substitution on the previous input line.
-	       (let ((old (buffer-substring (match-beginning 1) (match-end 1)))
-		     (new (buffer-substring (match-beginning 2) (match-end 2)))
-		     (pos nil))
-		 (replace-match (term-previous-input-string 0) t t)
-		 (setq pos (point))
-		 (goto-char (match-beginning 0))
-		 (if (not (search-forward old pos t))
-		     (or silent
-			 (error "Not found"))
-		   (replace-match new t t)
-		   (message "History item: substituted"))))
-	      (t
-	       (goto-char (match-end 0))))))))
-
-
-(defun term-magic-space (arg)
-  "Expand input history references before point and insert ARG spaces.
-A useful command to bind to SPC.  See `term-replace-by-expanded-history'."
-  (interactive "p")
-  (term-replace-by-expanded-history)
-  (self-insert-command arg))
-
-(defun term-within-quotes (beg end)
-  "Return t if the number of quotes between BEG and END is odd.
-Quotes are single and double."
-  (let ((countsq (term-how-many-region "\\(^\\|[^\\\\]\\)\'" beg end))
-	(countdq (term-how-many-region "\\(^\\|[^\\\\]\\)\"" beg end)))
-    (or (= (mod countsq 2) 1) (= (mod countdq 2) 1))))
-
-(defun term-how-many-region (regexp beg end)
-  "Return number of matches for REGEXP from BEG to END."
-  (let ((count 0))
-    (save-excursion
-      (save-match-data
-	(goto-char beg)
-	(while (re-search-forward regexp end t)
-	  (setq count (1+ count)))))
-    count))
-
-(defun term-args (string begin end)
-  ;; From STRING, return the args depending on the range specified in the text
-  ;; from BEGIN to END.  If BEGIN is nil, assume all args.  Ignore leading `:'.
-  ;; Range can be x-y, x-, -y, where x/y can be [0-9], *, ^, $.
-  (save-match-data
-    (if (null begin)
-	(term-arguments string 0 nil)
-      (let* ((range (buffer-substring
-		     (if (eq (char-after begin) ?:) (1+ begin) begin) end))
-	     (nth (cond ((string-match "^[*^]" range) 1)
-			((string-match "^-" range) 0)
-			((string-equal range "$") nil)
-			(t (string-to-number range))))
-	     (mth (cond ((string-match "[-*$]$" range) nil)
-			((string-match "-" range)
-			 (string-to-number (substring range (match-end 0))))
-			(t nth))))
-	(term-arguments string nth mth)))))
-
-;; Return a list of arguments from ARG.  Break it up at the
-;; delimiters in term-delimiter-argument-list.  Returned list is backwards.
-(defun term-delim-arg (arg)
-  (if (null term-delimiter-argument-list)
-      (list arg)
-    (let ((args nil)
-	  (pos 0)
-	  (len (length arg)))
-      (while (< pos len)
-	(let ((char (aref arg pos))
-	      (start pos))
-	  (if (memq char term-delimiter-argument-list)
-	      (while (and (< pos len) (eq (aref arg pos) char))
-		(setq pos (1+ pos)))
-	    (while (and (< pos len)
-			(not (memq (aref arg pos)
-				   term-delimiter-argument-list)))
-	      (setq pos (1+ pos))))
-	  (setq args (cons (substring arg start pos) args))))
-      args)))
-
-(defun term-arguments (string nth mth)
-  "Return from STRING the NTH to MTH arguments.
-NTH and/or MTH can be nil, which means the last argument.
-Returned arguments are separated by single spaces.
-We assume whitespace separates arguments, except within quotes.
-Also, a run of one or more of a single character
-in `term-delimiter-argument-list' is a separate argument.
-Argument 0 is the command name."
-  (let ((argpart "[^ \n\t\"'`]+\\|\\(\"[^\"]*\"\\|'[^']*'\\|`[^`]*`\\)")
-	(args ()) (pos 0)
-	(count 0)
-	beg str quotes)
-    ;; Build a list of all the args until we have as many as we want.
-    (while (and (or (null mth) (<= count mth))
-		(string-match argpart string pos))
-      (if (and beg (= pos (match-beginning 0)))
-	  ;; It's contiguous, part of the same arg.
-	  (setq pos (match-end 0)
-		quotes (or quotes (match-beginning 1)))
-	;; It's a new separate arg.
-	(if beg
-	    ;; Put the previous arg, if there was one, onto ARGS.
-	    (setq str (substring string beg pos)
-		  args (if quotes (cons str args)
-			 (nconc (term-delim-arg str) args))
-		  count (1+ count)))
-	(setq quotes (match-beginning 1))
-	(setq beg (match-beginning 0))
-	(setq pos (match-end 0))))
-    (if beg
-	(setq str (substring string beg pos)
-	      args (if quotes (cons str args)
-		     (nconc (term-delim-arg str) args))
-	      count (1+ count)))
-    (let ((n (or nth (1- count)))
-	  (m (if mth (1- (- count mth)) 0)))
-      (mapconcat
-       (function (lambda (a) a)) (nthcdr n (nreverse (nthcdr m args))) " "))))
-
-;;;
-;;; Input processing stuff [line mode]
-;;;
-
-(defun term-send-input () 
-  "Send input to process.
-After the process output mark, sends all text from the process mark to
-point as input to the process.  Before the process output mark, calls value
-of variable term-get-old-input to retrieve old input, copies it to the
-process mark, and sends it.  A terminal newline is also inserted into the
-buffer and sent to the process.  The list of function names contained in the
-value of `term-input-filter-functions' is called on the input before sending
-it.  The input is entered into the input history ring, if the value of variable
-term-input-filter returns non-nil when called on the input.
-
-Any history reference may be expanded depending on the value of the variable
-`term-input-autoexpand'.  The list of function names contained in the value
-of `term-input-filter-functions' is called on the input before sending it.
-The input is entered into the input history ring, if the value of variable
-`term-input-filter' returns non-nil when called on the input.
-
-If variable `term-eol-on-send' is non-nil, then point is moved to the
-end of line before sending the input.
-
-The values of `term-get-old-input', `term-input-filter-functions', and
-`term-input-filter' are chosen according to the command interpreter running
-in the buffer.  E.g.,
-
-If the interpreter is the csh,
-    term-get-old-input is the default: take the current line, discard any
-        initial string matching regexp term-prompt-regexp.
-    term-input-filter-functions monitors input for \"cd\", \"pushd\", and
-	\"popd\" commands. When it sees one, it cd's the buffer.
-    term-input-filter is the default: returns T if the input isn't all white
-	space.
-
-If the term is Lucid Common Lisp, 
-    term-get-old-input snarfs the sexp ending at point.
-    term-input-filter-functions does nothing.
-    term-input-filter returns NIL if the input matches input-filter-regexp,
-        which matches (1) all whitespace (2) :a, :c, etc.
-
-Similarly for Soar, Scheme, etc."
-  (interactive)
-  ;; Note that the input string does not include its terminal newline.
-  (let ((proc (get-buffer-process (current-buffer))))
-    (if (not proc) (error "Current buffer has no process")
-      (let* ((pmark (process-mark proc))
-	     (pmark-val (marker-position pmark))
-	     (input-is-new (>= (point) pmark-val))
-	     (intxt (if input-is-new
-			(progn (if term-eol-on-send (end-of-line))
-			       (buffer-substring pmark (point)))
-		      (funcall term-get-old-input)))
-	     (input (if (not (eq term-input-autoexpand 'input))
-			;; Just whatever's already there
-			intxt
-		      ;; Expand and leave it visible in buffer
-		      (term-replace-by-expanded-history t)
-		      (buffer-substring pmark (point))))
-	     (history (if (not (eq term-input-autoexpand 'history))
-			  input
-			;; This is messy 'cos ultimately the original
-			;; functions used do insertion, rather than return
-			;; strings.  We have to expand, then insert back.
-			(term-replace-by-expanded-history t)
-			(let ((copy (buffer-substring pmark (point))))
-			  (delete-region pmark (point))
-			  (insert input)
-			  copy))))
-	(if (term-pager-enabled)
-	    (save-excursion
-	      (goto-char (process-mark proc))
-	      (setq term-pager-count (term-current-row))))
-	(if (and (funcall term-input-filter history)
-		 (or (null term-input-ignoredups)
-		     (not (ring-p term-input-ring))
-		     (ring-empty-p term-input-ring)
-		     (not (string-equal (ring-ref term-input-ring 0)
-					history))))
-	    (ring-insert term-input-ring history))
-	(let ((functions term-input-filter-functions))
-	  (while functions
-	    (funcall (car functions) (concat input "\n"))
-	    (setq functions (cdr functions))))
-	(setq term-input-ring-index nil)
-
-	;; Update the markers before we send the input
-	;; in case we get output amidst sending the input.
-	(set-marker term-last-input-start pmark)
-	(set-marker term-last-input-end (point))
-	(if input-is-new
-	    (progn
-	      ;; Set up to delete, because inferior should echo.
-	      (if (marker-buffer term-pending-delete-marker)
-		  (delete-region term-pending-delete-marker pmark))
-	      (set-marker term-pending-delete-marker pmark-val)
-	      (set-marker (process-mark proc) (point))))
-	(goto-char pmark)
-	(funcall term-input-sender proc input)))))
-
-(defun term-get-old-input-default ()
-  "Default for term-get-old-input.
-Take the current line, and discard any initial text matching
-term-prompt-regexp."
-  (save-excursion
-    (beginning-of-line)
-    (term-skip-prompt)
-    (let ((beg (point)))
-      (end-of-line)
-      (buffer-substring beg (point)))))
-
-(defun term-copy-old-input ()
-  "Insert after prompt old input at point as new input to be edited.
-Calls `term-get-old-input' to get old input."
-  (interactive)
-  (let ((input (funcall term-get-old-input))
- 	(process (get-buffer-process (current-buffer))))
-    (if (not process)
-	(error "Current buffer has no process")
-      (goto-char (process-mark process))
-      (insert input))))
-
-(defun term-skip-prompt ()
-  "Skip past the text matching regexp term-prompt-regexp. 
-If this takes us past the end of the current line, don't skip at all."
-  (let ((eol (save-excursion (end-of-line) (point))))
-    (if (and (looking-at term-prompt-regexp)
-	     (<= (match-end 0) eol))
-	(goto-char (match-end 0)))))
-
-
-(defun term-after-pmark-p ()
-  "Is point after the process output marker?"
-  ;; Since output could come into the buffer after we looked at the point
-  ;; but before we looked at the process marker's value, we explicitly 
-  ;; serialise. This is just because I don't know whether or not emacs
-  ;; services input during execution of lisp commands.
-  (let ((proc-pos (marker-position
-		   (process-mark (get-buffer-process (current-buffer))))))
-    (<= proc-pos (point))))
-
-(defun term-simple-send (proc string)
-  "Default function for sending to PROC input STRING.
-This just sends STRING plus a newline. To override this,
-set the hook TERM-INPUT-SENDER."
-  (term-send-string proc string)
-  (term-send-string proc "\n"))
-
-(defun term-bol (arg)
-  "Goes to the beginning of line, then skips past the prompt, if any.
-If a prefix argument is given (\\[universal-argument]), then no prompt skip 
--- go straight to column 0.
-
-The prompt skip is done by skipping text matching the regular expression
-term-prompt-regexp, a buffer local variable."
-  (interactive "P")
-  (beginning-of-line)
-  (if (null arg) (term-skip-prompt)))
-
-;;; These two functions are for entering text you don't want echoed or
-;;; saved -- typically passwords to ftp, telnet, or somesuch.
-;;; Just enter m-x term-send-invisible and type in your line.
-
-(defun term-read-noecho (prompt &optional stars)
-  "Read a single line of text from user without echoing, and return it. 
-Prompt with argument PROMPT, a string.  Optional argument STARS causes
-input to be echoed with '*' characters on the prompt line.  Input ends with
-RET, LFD, or ESC.  DEL or C-h rubs out.  C-u kills line.  C-g aborts (if
-`inhibit-quit' is set because e.g. this function was called from a process
-filter and C-g is pressed, this function returns nil rather than a string).
-
-Note that the keystrokes comprising the text can still be recovered
-\(temporarily) with \\[view-lossage].  This may be a security bug for some
-applications."
-  (let ((ans "")
-	(c 0)
-	(echo-keystrokes 0)
-	(cursor-in-echo-area t)
-        (done nil))
-    (while (not done)
-      (if stars
-          (message "%s%s" prompt (make-string (length ans) ?*))
-        (message "%s" prompt))
-      (setq c (read-char))
-      (cond ((= c ?\C-g)
-             ;; This function may get called from a process filter, where
-             ;; inhibit-quit is set.  In later versions of emacs read-char
-             ;; may clear quit-flag itself and return C-g.  That would make
-             ;; it impossible to quit this loop in a simple way, so
-             ;; re-enable it here (for backward-compatibility the check for
-             ;; quit-flag below would still be necessary, so this seems
-             ;; like the simplest way to do things).
-             (setq quit-flag t
-                   done t))
-            ((or (= c ?\r) (= c ?\n) (= c ?\e))
-             (setq done t))
-            ((= c ?\C-u)
-             (setq ans ""))
-            ((and (/= c ?\b) (/= c ?\177))
-             (setq ans (concat ans (char-to-string c))))
-            ((> (length ans) 0)
-             (setq ans (substring ans 0 -1)))))
-    (if quit-flag
-        ;; Emulate a true quit, except that we have to return a value.
-        (prog1
-            (setq quit-flag nil)
-          (message "Quit")
-          (beep t))
-      (message "")
-      ans)))
-
-(defun term-send-invisible (str &optional proc)
-  "Read a string without echoing.
-Then send it to the process running in the current buffer. A new-line
-is additionally sent. String is not saved on term input history list.
-Security bug: your string can still be temporarily recovered with
-\\[view-lossage]."
-  (interactive "P") ; Defeat snooping via C-x esc
-  (if (not (stringp str))
-      (setq str (term-read-noecho "Non-echoed text: " t)))
-  (if (not proc)
-      (setq proc (get-buffer-process (current-buffer))))
-  (if (not proc) (error "Current buffer has no process")
-    (setq term-kill-echo-list (nconc term-kill-echo-list
-				     (cons str nil)))
-    (term-send-string proc str)
-    (term-send-string proc "\n")))
-
-
-;;; Low-level process communication
-
-(defvar term-input-chunk-size 512
-  "*Long inputs send to term processes are broken up into chunks of this size.
-If your process is choking on big inputs, try lowering the value.")
-
-(defun term-send-string (proc str)
-  "Send PROCESS the contents of STRING as input.
-This is equivalent to process-send-string, except that long input strings
-are broken up into chunks of size term-input-chunk-size. Processes
-are given a chance to output between chunks. This can help prevent processes
-from hanging when you send them long inputs on some OS's."
-  (let* ((len (length str))
-	 (i (min len term-input-chunk-size)))
-    (process-send-string proc (substring str 0 i))
-    (while (< i len)
-      (let ((next-i (+ i term-input-chunk-size)))
-	(accept-process-output)
-	(process-send-string proc (substring str i (min len next-i)))
-	(setq i next-i)))))
-
-(defun term-send-region (proc start end)
-  "Sends to PROC the region delimited by START and END.
-This is a replacement for process-send-region that tries to keep
-your process from hanging on long inputs. See term-send-string."
-  (term-send-string proc (buffer-substring start end)))
-
-
-;;; Random input hackage
-
-(defun term-kill-output ()
-  "Kill all output from interpreter since last input."
-  (interactive)
-  (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
-    (kill-region term-last-input-end pmark)
-    (goto-char pmark)    
-    (insert "*** output flushed ***\n")
-    (set-marker pmark (point))))
-
-(defun term-show-output ()
-  "Display start of this batch of interpreter output at top of window.
-Sets mark to the value of point when this command is run."
-  (interactive)
-  (goto-char term-last-input-end)
-  (backward-char)
-  (beginning-of-line)
-  (set-window-start (selected-window) (point))
-  (end-of-line))
-
-(defun term-interrupt-subjob ()
-  "Interrupt the current subjob."
-  (interactive)
-  (interrupt-process nil term-ptyp))
-
-(defun term-kill-subjob ()
-  "Send kill signal to the current subjob."
-  (interactive)
-  (kill-process nil term-ptyp))
-
-(defun term-quit-subjob ()
-  "Send quit signal to the current subjob."
-  (interactive)
-  (quit-process nil term-ptyp))
-
-(defun term-stop-subjob ()
-  "Stop the current subjob.
-WARNING: if there is no current subjob, you can end up suspending
-the top-level process running in the buffer. If you accidentally do
-this, use \\[term-continue-subjob] to resume the process. (This
-is not a problem with most shells, since they ignore this signal.)"
-  (interactive)
-  (stop-process nil term-ptyp))
-
-(defun term-continue-subjob ()
-  "Send CONT signal to process buffer's process group.
-Useful if you accidentally suspend the top-level process."
-  (interactive)
-  (continue-process nil term-ptyp))
-
-(defun term-kill-input ()
-  "Kill all text from last stuff output by interpreter to point."
-  (interactive)
-  (let* ((pmark (process-mark (get-buffer-process (current-buffer))))
-	 (p-pos (marker-position pmark)))
-    (if (> (point) p-pos)
-	(kill-region pmark (point)))))
-
-(defun term-delchar-or-maybe-eof (arg)
-  "Delete ARG characters forward, or send an EOF to process if at end of buffer."
-  (interactive "p")
-  (if (eobp)
-      (process-send-eof)
-      (delete-char arg)))
-
-(defun term-send-eof ()
-  "Send an EOF to the current buffer's process."
-  (interactive)
-  (process-send-eof))
-
-(defun term-backward-matching-input (regexp arg)
-  "Search backward through buffer for match for REGEXP.
-Matches are searched for on lines that match `term-prompt-regexp'.
-With prefix argument N, search for Nth previous match.
-If N is negative, find the next or Nth next match."
-  (interactive (term-regexp-arg "Backward input matching (regexp): "))
-  (let* ((re (concat term-prompt-regexp ".*" regexp))
-	 (pos (save-excursion (end-of-line (if (> arg 0) 0 1))
-			      (if (re-search-backward re nil t arg)
-				  (point)))))
-    (if (null pos)
-	(progn (message "Not found")
-	       (ding))
-      (goto-char pos)
-      (term-bol nil))))
-
-(defun term-forward-matching-input (regexp arg)
-  "Search forward through buffer for match for REGEXP.
-Matches are searched for on lines that match `term-prompt-regexp'.
-With prefix argument N, search for Nth following match.
-If N is negative, find the previous or Nth previous match."
-  (interactive (term-regexp-arg "Forward input matching (regexp): "))
-  (term-backward-matching-input regexp (- arg)))
-
-
-(defun term-next-prompt (n)
-  "Move to end of Nth next prompt in the buffer.
-See `term-prompt-regexp'."
-  (interactive "p")
-  (let ((paragraph-start term-prompt-regexp))
-    (end-of-line (if (> n 0) 1 0))
-    (forward-paragraph n)
-    (term-skip-prompt)))
-
-(defun term-previous-prompt (n)
-  "Move to end of Nth previous prompt in the buffer.
-See `term-prompt-regexp'."
-  (interactive "p")
-  (term-next-prompt (- n)))
-
-;;; Support for source-file processing commands.
-;;;============================================================================
-;;; Many command-interpreters (e.g., Lisp, Scheme, Soar) have
-;;; commands that process files of source text (e.g. loading or compiling
-;;; files). So the corresponding process-in-a-buffer modes have commands
-;;; for doing this (e.g., lisp-load-file). The functions below are useful
-;;; for defining these commands.
-;;;
-;;; Alas, these guys don't do exactly the right thing for Lisp, Scheme
-;;; and Soar, in that they don't know anything about file extensions.
-;;; So the compile/load interface gets the wrong default occasionally.
-;;; The load-file/compile-file default mechanism could be smarter -- it
-;;; doesn't know about the relationship between filename extensions and
-;;; whether the file is source or executable. If you compile foo.lisp
-;;; with compile-file, then the next load-file should use foo.bin for
-;;; the default, not foo.lisp. This is tricky to do right, particularly
-;;; because the extension for executable files varies so much (.o, .bin,
-;;; .lbin, .mo, .vo, .ao, ...).
-
-
-;;; TERM-SOURCE-DEFAULT -- determines defaults for source-file processing
-;;; commands.
-;;;
-;;; TERM-CHECK-SOURCE -- if FNAME is in a modified buffer, asks you if you
-;;; want to save the buffer before issuing any process requests to the command
-;;; interpreter.
-;;;
-;;; TERM-GET-SOURCE -- used by the source-file processing commands to prompt
-;;; for the file to process.
-
-;;; (TERM-SOURCE-DEFAULT previous-dir/file source-modes)
-;;;============================================================================
-;;; This function computes the defaults for the load-file and compile-file
-;;; commands for tea, soar, cmulisp, and cmuscheme modes. 
-;;; 
-;;; - PREVIOUS-DIR/FILE is a pair (directory . filename) from the last 
-;;; source-file processing command. NIL if there hasn't been one yet.
-;;; - SOURCE-MODES is a list used to determine what buffers contain source
-;;; files: if the major mode of the buffer is in SOURCE-MODES, it's source.
-;;; Typically, (lisp-mode) or (scheme-mode).
-;;; 
-;;; If the command is given while the cursor is inside a string, *and*
-;;; the string is an existing filename, *and* the filename is not a directory,
-;;; then the string is taken as default. This allows you to just position
-;;; your cursor over a string that's a filename and have it taken as default.
-;;;
-;;; If the command is given in a file buffer whose major mode is in
-;;; SOURCE-MODES, then the the filename is the default file, and the
-;;; file's directory is the default directory.
-;;; 
-;;; If the buffer isn't a source file buffer (e.g., it's the process buffer),
-;;; then the default directory & file are what was used in the last source-file
-;;; processing command (i.e., PREVIOUS-DIR/FILE).  If this is the first time
-;;; the command has been run (PREVIOUS-DIR/FILE is nil), the default directory
-;;; is the cwd, with no default file. (\"no default file\" = nil)
-;;; 
-;;; SOURCE-REGEXP is typically going to be something like (tea-mode)
-;;; for T programs, (lisp-mode) for Lisp programs, (soar-mode lisp-mode)
-;;; for Soar programs, etc.
-;;; 
-;;; The function returns a pair: (default-directory . default-file).
-
-(defun term-source-default (previous-dir/file source-modes)
-  (cond ((and buffer-file-name (memq major-mode source-modes))
-	 (cons (file-name-directory    buffer-file-name)
-	       (file-name-nondirectory buffer-file-name)))
-	(previous-dir/file)
-	(t
-	 (cons default-directory nil))))
-
-
-;;; (TERM-CHECK-SOURCE fname)
-;;;============================================================================
-;;; Prior to loading or compiling (or otherwise processing) a file (in the CMU
-;;; process-in-a-buffer modes), this function can be called on the filename.
-;;; If the file is loaded into a buffer, and the buffer is modified, the user
-;;; is queried to see if he wants to save the buffer before proceeding with
-;;; the load or compile.
-
-(defun term-check-source (fname)
-  (let ((buff (get-file-buffer fname)))
-    (if (and buff
-	     (buffer-modified-p buff)
-	     (y-or-n-p (format "Save buffer %s first? "
-			       (buffer-name buff))))
-	;; save BUFF.
-	(let ((old-buffer (current-buffer)))
-	  (set-buffer buff)
-	  (save-buffer)
-	  (set-buffer old-buffer)))))
-
-
-;;; (TERM-GET-SOURCE prompt prev-dir/file source-modes mustmatch-p)
-;;;============================================================================
-;;; TERM-GET-SOURCE is used to prompt for filenames in command-interpreter
-;;; commands that process source files (like loading or compiling a file).
-;;; It prompts for the filename, provides a default, if there is one,
-;;; and returns the result filename.
-;;; 
-;;; See TERM-SOURCE-DEFAULT for more on determining defaults.
-;;; 
-;;; PROMPT is the prompt string. PREV-DIR/FILE is the (directory . file) pair
-;;; from the last source processing command.  SOURCE-MODES is a list of major
-;;; modes used to determine what file buffers contain source files.  (These
-;;; two arguments are used for determining defaults). If MUSTMATCH-P is true,
-;;; then the filename reader will only accept a file that exists.
-;;; 
-;;; A typical use:
-;;; (interactive (term-get-source "Compile file: " prev-lisp-dir/file
-;;;                                 '(lisp-mode) t))
-
-;;; This is pretty stupid about strings. It decides we're in a string
-;;; if there's a quote on both sides of point on the current line.
-(defun term-extract-string ()
-  "Returns string around POINT that starts the current line or nil." 
-  (save-excursion
-    (let* ((point (point))
-	   (bol (progn (beginning-of-line) (point)))
-	   (eol (progn (end-of-line) (point)))
-	   (start (progn (goto-char point) 
-			 (and (search-backward "\"" bol t) 
-			      (1+ (point)))))
-	   (end (progn (goto-char point)
-		       (and (search-forward "\"" eol t)
-			    (1- (point))))))
-      (and start end
-	   (buffer-substring start end)))))
-
-(defun term-get-source (prompt prev-dir/file source-modes mustmatch-p)
-  (let* ((def (term-source-default prev-dir/file source-modes))
-         (stringfile (term-extract-string))
-	 (sfile-p (and stringfile
-		       (condition-case ()
-			   (file-exists-p stringfile)
-			 (error nil))
-		       (not (file-directory-p stringfile))))
-	 (defdir  (if sfile-p (file-name-directory stringfile)
-                      (car def)))
-	 (deffile (if sfile-p (file-name-nondirectory stringfile)
-                      (cdr def)))
-	 (ans (read-file-name (if deffile (format "%s(default %s) "
-						  prompt    deffile)
-				  prompt)
-			      defdir
-			      (concat defdir deffile)
-			      mustmatch-p)))
-    (list (expand-file-name (substitute-in-file-name ans)))))
-
-;;; I am somewhat divided on this string-default feature. It seems
-;;; to violate the principle-of-least-astonishment, in that it makes
-;;; the default harder to predict, so you actually have to look and see
-;;; what the default really is before choosing it. This can trip you up.
-;;; On the other hand, it can be useful, I guess. I would appreciate feedback
-;;; on this.
-;;;     -Olin
-
-
-;;; Simple process query facility.
-;;; ===========================================================================
-;;; This function is for commands that want to send a query to the process
-;;; and show the response to the user. For example, a command to get the
-;;; arglist for a Common Lisp function might send a "(arglist 'foo)" query
-;;; to an inferior Common Lisp process.
-;;; 
-;;; This simple facility just sends strings to the inferior process and pops
-;;; up a window for the process buffer so you can see what the process
-;;; responds with.  We don't do anything fancy like try to intercept what the
-;;; process responds with and put it in a pop-up window or on the message
-;;; line. We just display the buffer. Low tech. Simple. Works good.
-
-;;; Send to the inferior process PROC the string STR. Pop-up but do not select
-;;; a window for the inferior process so that its response can be seen.
-(defun term-proc-query (proc str)
-  (let* ((proc-buf (process-buffer proc))
-	 (proc-mark (process-mark proc)))
-    (display-buffer proc-buf)
-    (set-buffer proc-buf) ; but it's not the selected *window*
-    (let ((proc-win (get-buffer-window proc-buf))
-	  (proc-pt (marker-position proc-mark)))
-      (term-send-string proc str) ; send the query
-      (accept-process-output proc)  ; wait for some output
-      ;; Try to position the proc window so you can see the answer.
-      ;; This is bogus code. If you delete the (sit-for 0), it breaks.
-      ;; I don't know why. Wizards invited to improve it.
-      (if (not (pos-visible-in-window-p proc-pt proc-win))
-	  (let ((opoint (window-point proc-win)))
-	    (set-window-point proc-win proc-mark) (sit-for 0)
-	    (if (not (pos-visible-in-window-p opoint proc-win))
-		(push-mark opoint)
-		(set-window-point proc-win opoint)))))))
-
-;;; Returns the current column in the current screen line.
-;;; Note: (current-column) yields column in buffer line.
-
-(defun term-horizontal-column ()
-  (- (term-current-column) (term-start-line-column)))
-
-;; Calls either vertical-motion or buffer-vertical-motion
-(defmacro term-vertical-motion (count)
-  (list 'funcall 'term-vertical-motion count))
-
-;; An emulation of vertical-motion that is independent of having a window.
-;; Instead, it uses the term-width variable as the logical window width.
-
-(defun buffer-vertical-motion (count)
-  (cond ((= count 0)
-	 (move-to-column (* term-width (/ (current-column) term-width)))
-	 0)
-	((> count 0)
-	 (let ((H)
-	       (todo (+ count (/ (current-column) term-width))))
-	   (end-of-line)
-	   ;; The loop iterates over buffer lines;
-	   ;; H is the number of screen lines in the current line, i.e.
-	   ;; the ceiling of dividing the buffer line width by term-width.
-	   (while (and (<= (setq H (max (/ (+ (current-column) term-width -1)
-					   term-width)
-					1))
-			   todo)
-		       (not (eobp)))
-	     (setq todo (- todo H))
-	     (forward-char) ;; Move past the ?\n
-	     (end-of-line)) ;; and on to the end of the next line.
-	   (if (and (>= todo H) (> todo 0))
-	       (+ (- count todo) H -1) ;; Hit end of buffer.
-	     (move-to-column (* todo term-width))
-	     count)))
-	(t ;; (< count 0) ;; Similar algorithm, but for upward motion.
-	 (let ((H)
-	       (todo (- count)))
-	   (while (and (<= (setq H (max (/ (+ (current-column) term-width -1)
-					   term-width)
-					1))
-			   todo)
-		       (progn (beginning-of-line)
-			      (not (bobp))))
-	     (setq todo (- todo H))
-	     (backward-char)) ;; Move to end of previous line.
-	   (if (and (>= todo H) (> todo 0))
-	       (+ count todo (- 1 H)) ;; Hit beginning of buffer.
-	     (move-to-column (* (- H todo 1) term-width))
-	     count)))))
-
-;;; The term-start-line-column variable is used as a cache.
-(defun term-start-line-column ()
-  (cond (term-start-line-column)
-	((let ((save-pos (point)))
-	   (term-vertical-motion 0)
-	   (setq term-start-line-column (current-column))
-	   (goto-char save-pos)
-	   term-start-line-column))))
-
-;;; Same as (current-column), but uses term-current-column as a cache.
-(defun term-current-column ()
-  (cond (term-current-column)
-	((setq term-current-column (current-column)))))
-
-;;; Move DELTA column right (or left if delta < 0).
-
-(defun term-move-columns (delta)
-  (setq term-current-column (+ (term-current-column) delta))
-  (move-to-column term-current-column t))
-
-;; Insert COUNT copies of CHAR in the default face.
-(defun term-insert-char (char count)
-  (let ((old-point (point)))
-    (insert-char char count)
-    (put-text-property old-point (point) 'face 'default)))
-
-(defun term-current-row ()
-  (cond (term-current-row)
-	((setq term-current-row
-	       (save-restriction
-		 (save-excursion
-		   (narrow-to-region term-home-marker (point-max))
-		   (- (term-vertical-motion -9999))))))))
-
-(defun term-adjust-current-row-cache (delta)
-  (if term-current-row
-      (setq term-current-row (+ term-current-row delta))))
-
-(defun term-terminal-pos ()
-  (save-excursion ;    save-restriction
-    (let ((save-col (term-current-column))
-	  x y)
-      (term-vertical-motion 0)
-      (setq x (- save-col (current-column)))
-      (setq y (term-vertical-motion term-height))
-      (cons x y))))
-
-;;; Terminal emulation
-;;; This is the standard process filter for term buffers.
-;;; It emulates (most of the features of) a VT100/ANSI-style terminal.
-
-(defun term-emulate-terminal (proc str)
-  (let* ((previous-buffer (current-buffer))
-	 (i 0) char funny count save-point save-marker old-point temp win
-	 (selected (selected-window))
-	 (str-length (length str)))
-    (unwind-protect
-	(progn
-	  (set-buffer (process-buffer proc))
-
-	  (if (marker-buffer term-pending-delete-marker)
-	      (progn
-		;; Delete text following term-pending-delete-marker.
-		(delete-region term-pending-delete-marker (process-mark proc))
-		(set-marker term-pending-delete-marker nil)))
-
-	  (if (eq (window-buffer) (current-buffer))
-	      (progn
-		(setq term-vertical-motion (symbol-function 'vertical-motion))
-		(term-check-size proc))
-	    (setq term-vertical-motion
-		  (symbol-function 'buffer-vertical-motion)))
-
-	  (setq save-marker (copy-marker (process-mark proc)))
-
-	  (if (/= (point) (process-mark proc))
-	      (progn (setq save-point (point-marker))
-		     (goto-char (process-mark proc))))
-
-	  (save-restriction
-	    ;; If the buffer is in line mode, and there is a partial
-	    ;; input line, save the line (by narrowing to leave it
-	    ;; outside the restriction ) until we're done with output.
-	    (if (and (> (point-max) (process-mark proc))
-		     (term-in-line-mode))
-		(narrow-to-region (point-min) (process-mark proc)))
-	    
-	    (if term-log-buffer
-		(princ str term-log-buffer))
-	    (cond ((eq term-terminal-state 4) ;; Have saved pending output.
-		   (setq str (concat term-terminal-parameter str))
-		   (setq term-terminal-parameter nil)
-		   (setq str-length (length str))
-		   (setq term-terminal-state 0)))
-	    
-	    (while (< i str-length)
-	      (setq char (aref str i))
-	      (cond ((< term-terminal-state 2)
-		     ;; Look for prefix of regular chars
-		     (setq funny
-			   (string-match "[\r\n\000\007\033\t\b\032\016\017]"
-					 str i))
-		     (if (not funny) (setq funny str-length))
-		     (cond ((> funny i)
-			    (cond ((eq term-terminal-state 1)
-				   (term-move-columns 1)
-				   (setq term-terminal-state 0)))
-			    (setq count (- funny i))
-			    (setq temp (- (+ (term-horizontal-column) count)
-					  term-width))
-			    (cond ((<= temp 0)) ;; All count chars fit in line.
-				  ((> count temp) ;; Some chars fit.
-				   ;; This iteration, handle only what fits.
-				   (setq count (- count temp))
-				   (setq funny (+ count i)))
-				  ((or (not (or term-pager-count
-						term-scroll-with-delete))
-				       (>  (term-handle-scroll 1) 0))
-				   (term-adjust-current-row-cache 1)
-				   (setq count (min count term-width))
-				   (setq funny (+ count i))
-				   (setq term-start-line-column
-					 term-current-column))
-				  (t ;; Doing PAGER processing.
-				   (setq count 0 funny i)
-				   (setq term-current-column nil)
-				   (setq term-start-line-column nil)))
-			    (setq old-point (point))
-			    ;; In the common case that we're at the end of
-			    ;; the buffer, we can save a little work.
-			    (cond ((/= (point) (point-max))
-				   (if term-insert-mode
-				       ;; Inserting spaces, then deleting them,
-				       ;; then inserting the actual text is
-				       ;; inefficient, but it is simple, and
-				       ;; the actual overhead is miniscule.
-				       (term-insert-spaces count))
-				   (term-move-columns count)
-				   (delete-region old-point (point)))
-	(t (setq term-current-column (+ (term-current-column) count))))
-			    (insert (substring str i funny))
-			    (put-text-property old-point (point)
-					       'face term-current-face)
-			    ;; If the last char was written in last column,
-			    ;; back up one column, but remember we did so.
-			    ;; Thus we emulate xterm/vt100-style line-wrapping.
-			    (cond ((eq temp 0)
-				   (term-move-columns -1)
-				   (setq term-terminal-state 1)))
-			    (setq i (1- funny)))
-			   ((and (setq term-terminal-state 0)
-			    (eq char ?\^I)) ; TAB
-			    ;; FIXME:  Does not handle line wrap!
-			    (setq count (term-current-column))
-			    (setq count (+ count 8 (- (mod count 8))))
-			    (if (< (move-to-column count nil) count)
-				(term-insert-char char 1))
-			    (setq term-current-column count))
-			   ((eq char ?\r)
-			    ;; Optimize CRLF at end of buffer:
-			    (cond ((and (< (setq temp (1+ i)) str-length)
-					(eq (aref str temp) ?\n)
-					(= (point) (point-max))
-					(not (or term-pager-count
-						 term-kill-echo-list
-						 term-scroll-with-delete)))
-				   (insert ?\n)
-				   (term-adjust-current-row-cache 1)
-				   (setq term-start-line-column 0)
-				   (setq term-current-column 0)
-				   (setq i temp))
-				  (t ;; Not followed by LF or can't optimize:
-				   (term-vertical-motion 0)
-				   (setq term-current-column term-start-line-column))))
-			   ((eq char ?\n)
-			    (if (not (and term-kill-echo-list
-					  (term-check-kill-echo-list)))
-				(term-down 1 t)))
-			   ((eq char ?\b)
-			    (term-move-columns -1))
-			   ((eq char ?\033) ; Escape
-			    (setq term-terminal-state 2))
-			   ((eq char 0)) ; NUL: Do nothing
-			   ((eq char ?\016)) ; Shift Out - ignored
-			   ((eq char ?\017)) ; Shift In - ignored
-			   ((eq char ?\^G)
-			    (beep t)) ; Bell
-			   ((eq char ?\032)
-			    (let ((end (string-match "\n" str i)))
-			      (if end
-				  (progn (funcall term-command-hook
-						  (substring str (1+ i) (1- end)))
-					 (setq i end))
-				(setq term-terminal-parameter
-				      (substring str i))
-				(setq term-terminal-state 4)
-				(setq i str-length))))
-			   (t ; insert char FIXME: Should never happen
-			    (term-move-columns 1)
-			    (backward-delete-char 1)
-			    (insert char))))
-		    ((eq term-terminal-state 2) ; Seen Esc
-		     (cond ((eq char ?\133) ;; ?\133 = ?[
-			    (make-local-variable 'term-terminal-parameter)
-			    (make-local-variable 'term-terminal-previous-parameter)
-			    (setq term-terminal-parameter 0)
-			    (setq term-terminal-previous-parameter 0)
-			    (setq term-terminal-state 3))
-			   ((eq char ?D) ;; scroll forward
-			    (term-handle-deferred-scroll)
-			    (term-down 1 t)
-			    (setq term-terminal-state 0))
-			   ((eq char ?M) ;; scroll reversed
-			    (term-insert-lines 1)
-			    (setq term-terminal-state 0))
-			   ((eq char ?7) ;; Save cursor
-			    (term-handle-deferred-scroll)
-			    (setq term-saved-cursor
-				  (cons (term-current-row)
-					(term-horizontal-column)))
-			    (setq term-terminal-state 0))
-			   ((eq char ?8) ;; Restore cursor
-			    (if term-saved-cursor
-				(term-goto (car term-saved-cursor)
-					   (cdr term-saved-cursor)))
-			    (setq term-terminal-state 0))
-			   ((setq term-terminal-state 0))))
-		    ((eq term-terminal-state 3) ; Seen Esc [
-		     (cond ((and (>= char ?0) (<= char ?9))
-			    (setq term-terminal-parameter
-				  (+ (* 10 term-terminal-parameter) (- char ?0))))
-			   ((eq char ?\073 ) ; ?;
-			    (setq term-terminal-previous-parameter
-				  term-terminal-parameter)
-			    (setq term-terminal-parameter 0))
-			   ((eq char ??)) ; Ignore ? 
-			   (t
-			    (term-handle-ansi-escape proc char)
-			    (setq term-terminal-state 0)))))
-	      (if (term-handling-pager)
-		  ;; Finish stuff to get ready to handle PAGER.
-		  (progn
-		    (if (> (% (current-column) term-width) 0)
-			(setq term-terminal-parameter
-			      (substring str i))
-		      ;; We're at column 0.  Goto end of buffer; to compensate,
-		      ;; prepend a ?\r for later.  This looks more consistent.
-		      (if (zerop i)
-			  (setq term-terminal-parameter
-				(concat "\r" (substring str i)))
-			(setq term-terminal-parameter (substring str (1- i)))
-			(aset term-terminal-parameter 0 ?\r))
-		      (goto-char (point-max)))
-		    (setq term-terminal-state 4)
-		    (make-local-variable 'term-pager-old-filter)
-		    (setq term-pager-old-filter (process-filter proc))
-		    (set-process-filter proc term-pager-filter)
-		    (setq i str-length)))
-	      (setq i (1+ i))))
-
-	  (if (>= (term-current-row) term-height)
-	      (term-handle-deferred-scroll))
-
-	  (set-marker (process-mark proc) (point))
-	  (if save-point
-	      (progn (goto-char save-point)
-		     (set-marker save-point nil)))
-
-	  ;; Check for a pending filename-and-line number to display.
-	  ;; We do this before scrolling, because we might create a new window.
-	  (if (and term-pending-frame
-		   (eq (window-buffer selected) (current-buffer)))
-	      (progn (term-display-line (car term-pending-frame)
-					(cdr term-pending-frame))
-		     (setq term-pending-frame nil)
-		 ;; We have created a new window, so check the window size.
-		     (term-check-size proc)))
-
-	  ;; Scroll each window displaying the buffer but (by default)
-	  ;; only if the point matches the process-mark we started with.
-	  (setq win selected)
-	  (while (progn
-		   (setq win (next-window win nil t))
-		   (if (eq (window-buffer win) (process-buffer proc))
-		       (let ((scroll term-scroll-to-bottom-on-output))
-			 (select-window win)
-			 (if (or (= (point) save-marker)
-				 (eq scroll t) (eq scroll 'all)
-				 ;; Maybe user wants point to jump to the end.
-				 (and (eq selected win)
-				      (or (eq scroll 'this) (not save-point)))
-				 (and (eq scroll 'others)
-				      (not (eq selected win))))
-			     (progn
-			       (goto-char term-home-marker)
-			       (recenter 0)
-			       (goto-char (process-mark proc))
-			       (if (not (pos-visible-in-window-p (point) win))
-				   (recenter -1))))
-			 ;; Optionally scroll so that the text
-			 ;; ends at the bottom of the window.
-			 (if (and term-scroll-show-maximum-output
-				  (>= (point) (process-mark proc)))
-			     (save-excursion
-			       (goto-char (point-max))
-			       (recenter -1)))))
-		   (not (eq win selected))))
-
-	  (set-marker save-marker nil))
-      ;; unwind-protect cleanup-forms follow:
-      (set-buffer previous-buffer)
-      (select-window selected))))
-
-(defun term-handle-deferred-scroll ()
-  (let ((count (- (term-current-row) term-height)))
-    (if (>= count 0)
-	(save-excursion
-	  (goto-char term-home-marker)
-	  (term-vertical-motion (1+ count))
-	  (set-marker term-home-marker (point))
-	  (setq term-current-row (1- term-height))))))
-
-;;; Handle a character assuming (eq terminal-state 2) -
-;;; i.e. we have previously seen Escape followed by ?[.
-
-(defun term-handle-ansi-escape (proc char)
-  (cond
-   ((eq char ?H) ; cursor motion
-    (if (<= term-terminal-parameter 0)
-	(setq term-terminal-parameter 1))
-    (if (<= term-terminal-previous-parameter 0)
-	(setq term-terminal-previous-parameter 1))
-    (if (> term-terminal-previous-parameter term-height)
-	(setq term-terminal-previous-parameter term-height))
-    (if (> term-terminal-parameter term-width)
-	(setq term-terminal-parameter term-width))
-    (term-goto
-     (1- term-terminal-previous-parameter)
-     (1- term-terminal-parameter)))
-   ;; \E[A - cursor up
-   ((eq char ?A)
-    (term-handle-deferred-scroll)
-    (term-down (- (max 1 term-terminal-parameter)) t))
-   ;; \E[B - cursor down
-   ((eq char ?B)
-    (term-down (max 1 term-terminal-parameter) t))
-   ;; \E[C - cursor right
-   ((eq char ?C)
-    (term-move-columns (max 1 term-terminal-parameter)))
-   ;; \E[D - cursor left
-   ((eq char ?D)
-    (term-move-columns (- (max 1 term-terminal-parameter))))
-   ;; \E[J - clear to end of screen
-   ((eq char ?J)
-    (term-erase-in-display term-terminal-parameter))
-   ;; \E[K - clear to end of line
-   ((eq char ?K)
-    (term-erase-in-line term-terminal-parameter))
-   ;; \E[L - insert lines
-   ((eq char ?L)
-    (term-insert-lines (max 1 term-terminal-parameter)))
-   ;; \E[M - delete lines
-   ((eq char ?M)
-    (term-delete-lines (max 1 term-terminal-parameter)))
-   ;; \E[P - delete chars
-   ((eq char ?P)
-    (term-delete-chars (max 1 term-terminal-parameter)))
-   ;; \E[@ - insert spaces
-   ((eq char ?@)
-    (term-insert-spaces (max 1 term-terminal-parameter)))
-   ;; \E[?h - DEC Private Mode Set
-   ((eq char ?h)
-    (cond ((eq term-terminal-parameter 4)
-	   (setq term-insert-mode t))
-	  ((eq term-terminal-parameter 47)
-	   (term-switch-to-alternate-sub-buffer t))))
-   ;; \E[?l - DEC Private Mode Reset
-   ((eq char ?l)
-    (cond ((eq term-terminal-parameter 4)
-	   (setq term-insert-mode nil))
-	  ((eq term-terminal-parameter 47)
-	   (term-switch-to-alternate-sub-buffer nil))))
-   ;; \E[m - Set/reset standard mode
-   ((eq char ?m)
-    (cond ((eq term-terminal-parameter 7)
-	   (setq term-current-face 'highlight))
-	  ((eq term-terminal-parameter 4)
-	   (setq term-current-face 'term-underline-face))
-	  ((eq term-terminal-parameter 1)
-	   (setq term-current-face 'bold))
-	  (t (setq term-current-face 'default))))
-   ;; \E[6n - Report cursor position
-   ((eq char ?n)
-    (term-handle-deferred-scroll)
-    (process-send-string proc
-			 (format "\e[%s;%sR"
-				 (1+ (term-current-row))
-				 (1+ (term-horizontal-column)))))
-   ;; \E[r - Set scrolling region
-   ((eq char ?r)
-    (term-scroll-region
-     (1- term-terminal-previous-parameter)
-     term-terminal-parameter))
-   (t)))
-
-(defun term-scroll-region (top bottom)
-  "Set scrolling region.
-TOP is the top-most line (inclusive) of the new scrolling region,
-while BOTTOM is the line following the new scrolling region (e.g. exclusive).
-The top-most line is line 0."
-  (setq term-scroll-start
-	(if (or (< top 0) (>= top term-height))
-	    0
-	  top))
-  (setq term-scroll-end
-	(if (or (<= bottom term-scroll-start) (> bottom term-height))
-	    term-height
-	  bottom))
-  (setq term-scroll-with-delete
-	(or (term-using-alternate-sub-buffer)
-	    (not (and (= term-scroll-start 0)
-		      (= term-scroll-end term-height))))))
-
-(defun term-switch-to-alternate-sub-buffer (set)
-  ;; If asked to switch to (from) the alternate sub-buffer, and already (not)
-  ;; using it, do nothing.  This test is needed for some programs (including
-  ;; emacs) that emit the ti termcap string twice, for unknown reason.
-  (term-handle-deferred-scroll)
-  (if (eq set (not (term-using-alternate-sub-buffer)))
-      (let ((row (term-current-row))
-	    (col (term-horizontal-column)))
-	(cond (set
-	       (goto-char (point-max))
-	       (if (not (eq (preceding-char) ?\n))
-		   (term-insert-char ?\n 1))
-	       (setq term-scroll-with-delete t)
-	       (setq term-saved-home-marker (copy-marker term-home-marker))
-	       (set-marker term-home-marker (point)))
-	      (t
-	       (setq term-scroll-with-delete
-		     (not (and (= term-scroll-start 0)
-			       (= term-scroll-end term-height))))
-	       (set-marker term-home-marker term-saved-home-marker)
-	       (set-marker term-saved-home-marker nil)
-	       (setq term-saved-home-marker nil)
-	       (goto-char term-home-marker)))
-	(setq term-current-column nil)
-	(setq term-current-row 0)
-	(term-goto row col))))
-
-;; Default value for the symbol term-command-hook.
-
-(defun term-command-hook (string)
-  (cond ((= (aref string 0) ?\032)
-	 ;; gdb (when invoked with -fullname) prints:
-	 ;; \032\032FULLFILENAME:LINENUMBER:CHARPOS:BEG_OR_MIDDLE:PC\n
-	 (let* ((first-colon (string-match ":" string 1))
-		(second-colon
-		 (string-match ":" string (1+ first-colon)))
-		(filename (substring string 1 first-colon))
-		(fileline (string-to-int
-			   (substring string (1+ first-colon) second-colon))))
-	   (setq term-pending-frame (cons filename fileline))))
-	((= (aref string 0) ?/)
-	 (cd (substring string 1)))
-	;; Allowing the inferior to call functions in emacs is
-	;; probably too big a security hole.
-	;; ((= (aref string 0) ?!)
-	;; (eval (car (read-from-string string 1))))
-	(t)));; Otherwise ignore it
-
-;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
-;; and that its line LINE is visible.
-;; Put the overlay-arrow on the line LINE in that buffer.
-;; This is mainly used by gdb.
-
-(defun term-display-line (true-file line)
-  (term-display-buffer-line (find-file-noselect true-file) line))
-
-(defun term-display-buffer-line (buffer line)
-  (let* ((window (display-buffer buffer t))
-	 (pos))
-    (save-excursion
-      (set-buffer buffer)
-      (save-restriction
-	(widen)
-	(goto-line line)
-	(setq pos (point))
-	(setq overlay-arrow-string "=>")
-	(or overlay-arrow-position
-	    (setq overlay-arrow-position (make-marker)))
-	(set-marker overlay-arrow-position (point) (current-buffer)))
-      (cond ((or (< pos (point-min)) (> pos (point-max)))
-	     (widen)
-	     (goto-char pos))))
-    (set-window-point window overlay-arrow-position)))
-
-;;; The buffer-local marker term-home-marker defines the "home position"
-;;; (in terms of cursor motion).  However, we move the term-home-marker
-;;; "down" as needed so that is no more that a window-full above (point-max).
-
-(defun term-goto-home ()
-  (term-handle-deferred-scroll)
-  (goto-char term-home-marker)
-  (setq term-current-row 0)
-  (setq term-current-column (current-column))
-  (setq term-start-line-column term-current-column))
-
-(defun term-goto (row col)
-  (term-handle-deferred-scroll)
-  (cond ((and term-current-row (>= row term-current-row))
-	 ;; I assume this is a worthwhile optimization.
-	 (term-vertical-motion 0)
-	 (setq term-current-column term-start-line-column)
-	 (setq row (- row term-current-row)))
-	(t
-	 (term-goto-home)))
-  (term-down row)
-  (term-move-columns col))
-
-; The page is full, so enter "pager" mode, and wait for input.
-
-(defun term-process-pager ()
-  (if (not term-pager-break-map)
-      (let* ((map (make-keymap))
-	     (i 0) tmp)
-;	(while (< i 128)
-;	  (define-key map (make-string 1 i) 'term-send-raw)
-;	  (setq i (1+ i)))
-	(define-key map "\e"
-	  (lookup-key (current-global-map) "\e"))
-	(define-key map "\C-x"
-	  (lookup-key (current-global-map) "\C-x"))
-	(define-key map "\C-u"
-	  (lookup-key (current-global-map) "\C-u"))
-	(define-key map " " 'term-pager-page)
-	(define-key map "\r" 'term-pager-line)
-	(define-key map "?" 'term-pager-help)
-	(define-key map "h" 'term-pager-help)
-	(define-key map "b" 'term-pager-back-page)
-	(define-key map "\177" 'term-pager-back-line)
-	(define-key map "q" 'term-pager-discard)
-	(define-key map "D" 'term-pager-disable)
-	(define-key map "<" 'term-pager-bob)
-	(define-key map ">" 'term-pager-eob)
-
-	;; Add menu bar.
-	(term-if-emacs19
-	 (term-ifnot-xemacs
-	  (define-key map [menu-bar terminal] term-terminal-menu)
-	  (define-key map [menu-bar signals] term-signals-menu)
-	  (setq tmp (make-sparse-keymap "More pages?"))
-	  (define-key tmp [help] '("Help" . term-pager-help))
-	  (define-key tmp [disable]
-	    '("Disable paging" . term-fake-pager-disable))
-	  (define-key tmp [discard]
-	    '("Discard remaining output" . term-pager-discard))
-	  (define-key tmp [eob] '("Goto to end" . term-pager-eob))
-	  (define-key tmp [bob] '("Goto to beginning" . term-pager-bob))
-	  (define-key tmp [line] '("1 line forwards" . term-pager-line))
-	  (define-key tmp [bline] '("1 line backwards" . term-pager-back-line))
-	  (define-key tmp [back] '("1 page backwards" . term-pager-back-page))
-	  (define-key tmp [page] '("1 page forwards" . term-pager-page))
-	  (define-key map [menu-bar page] (cons "More pages?" tmp))
-	  ))
-
-	(setq term-pager-break-map map)))
-;  (let ((process (get-buffer-process (current-buffer))))
-;    (stop-process process))  
-  (setq term-pager-old-local-map (current-local-map))
-  (use-local-map term-pager-break-map)
-  (make-local-variable 'term-old-mode-line-format)
-  (setq term-old-mode-line-format mode-line-format)
-  (setq mode-line-format
-	(list "--  **MORE**  "
-	      mode-line-buffer-identification
-	      " [Type ? for help] "
-	      "%-"))
-  (force-mode-line-update))
-
-(defun term-pager-line (lines)
-  (interactive "p")
-  (let* ((moved (vertical-motion (1+ lines)))
-	 (deficit (- lines moved)))
-    (if (> moved lines)
-	(backward-char))
-    (cond ((<= deficit 0) ;; OK, had enough in the buffer for request.
-	   (recenter (1- term-height)))
-	  ((term-pager-continue deficit)))))
-
-(defun term-pager-page (arg)
-  "Proceed past the **MORE** break, allowing the next page of output to appear"
-  (interactive "p")
-  (term-pager-line (* arg term-height)))
-
-; Pager mode command to go to beginning of buffer
-(defun term-pager-bob ()
-  (interactive)
-  (goto-char (point-min))
-  (if (= (vertical-motion term-height) term-height)
-      (backward-char))
-  (recenter (1- term-height)))
-
-; pager mode command to go to end of buffer
-(defun term-pager-eob ()
-  (interactive)
-  (goto-char term-home-marker)
-  (recenter 0)
-  (goto-char (process-mark (get-buffer-process (current-buffer)))))
-
-(defun term-pager-back-line (lines)
-  (interactive "p")
-  (vertical-motion (- 1 lines))
-  (if (not (bobp))
-      (backward-char)
-    (beep)
-    ;; Move cursor to end of window.
-    (vertical-motion term-height)
-    (backward-char))
-  (recenter (1- term-height)))
-
-(defun term-pager-back-page (arg)
-  (interactive "p")
-  (term-pager-back-line (* arg term-height)))
-
-(defun term-pager-discard ()
-  (interactive)
-  (setq term-terminal-parameter "")
-  (interrupt-process nil t)
-  (term-pager-continue term-height))
-
-; Disable pager processing.
-; Only callable while in pager mode.  (Contrast term-disable-pager.)
-(defun term-pager-disable ()
-  (interactive)
-  (if (term-handling-pager)
-      (term-pager-continue nil)
-    (setq term-pager-count nil))
-  (term-update-mode-line))
-    
-; Enable pager processing.
-(defun term-pager-enable ()
-  (interactive)
-  (or (term-pager-enabled)
-      (setq term-pager-count 0)) ;; Or maybe set to (term-current-row) ??
-  (term-update-mode-line))
-
-(defun term-pager-toggle ()
-  (interactive)
-  (if (term-pager-enabled) (term-pager-disable) (term-pager-enable)))
-
-(term-ifnot-xemacs
- (defalias 'term-fake-pager-enable 'term-pager-toggle)
- (defalias 'term-fake-pager-disable 'term-pager-toggle)
- (put 'term-char-mode 'menu-enable '(term-in-line-mode))
- (put 'term-line-mode 'menu-enable '(term-in-char-mode))
- (put 'term-fake-pager-enable 'menu-enable '(not term-pager-count))
- (put 'term-fake-pager-disable 'menu-enable 'term-pager-count))
-
-(defun term-pager-help ()
-  "Provide help on commands available in a terminal-emulator **MORE** break"
-  (interactive)
-  (message "Terminal-emulator pager break help...")
-  (sit-for 0)
-  (with-electric-help
-    (function (lambda ()
-		(princ (substitute-command-keys
-"\\<term-pager-break-map>\
-Terminal-emulator MORE break.\n\
-Type one of the following keys:\n\n\
-\\[term-pager-page]\t\tMove forward one page.\n\
-\\[term-pager-line]\t\tMove forward one line.\n\
-\\[universal-argument] N \\[term-pager-page]\tMove N pages forward.\n\
-\\[universal-argument] N \\[term-pager-line]\tMove N lines forward.\n\
-\\[universal-argument] N \\[term-pager-back-line]\tMove N lines back.\n\
-\\[universal-argument] N \\[term-pager-back-page]\t\tMove N pages back.\n\
-\\[term-pager-bob]\t\tMove to the beginning of the buffer.\n\
-\\[term-pager-eob]\t\tMove to the end of the buffer.\n\
-\\[term-pager-discard]\t\tKill pending output and kill process.\n\
-\\[term-pager-disable]\t\tDisable PAGER handling.\n\n\
-\\{term-pager-break-map}\n\
-Any other key is passed through to the program
-running under the terminal emulator and disables pager processing until
-all pending output has been dealt with."))
-		nil))))
-
-(defun term-pager-continue (new-count)
-  (let ((process (get-buffer-process (current-buffer))))
-    (use-local-map term-pager-old-local-map)
-    (setq term-pager-old-local-map nil)
-    (setq mode-line-format term-old-mode-line-format)
-    (force-mode-line-update)
-    (setq term-pager-count new-count)
-    (set-process-filter process term-pager-old-filter)
-    (funcall term-pager-old-filter process "")
-    (continue-process process)))
-
-;; Make sure there are DOWN blank lines below the current one.
-;; Return 0 if we're unable (because of PAGER handling), else return DOWN.
-
-(defun term-handle-scroll (down)
-  (let ((scroll-needed
-	 (- (+ (term-current-row) down 1) term-scroll-end)))
-    (if (> scroll-needed 0)
-	(let ((save-point (copy-marker (point))) (save-top))
-	  (goto-char term-home-marker)
-	  (cond (term-scroll-with-delete
-		 ;; delete scroll-needed lines at term-scroll-start
-		 (term-vertical-motion term-scroll-start)
-		 (setq save-top (point))
-		 (term-vertical-motion scroll-needed)
-		 (delete-region save-top (point))
-		 (goto-char save-point)
-		 (term-vertical-motion down)
-		 (term-adjust-current-row-cache (- scroll-needed))
-		 (setq term-current-column nil)
-		 (term-insert-char ?\n scroll-needed))
-		((and (numberp term-pager-count)
-		      (< (setq term-pager-count (- term-pager-count down))
-			 0))
-		 (setq down 0)
-		 (term-process-pager))
-		(t
-		 (term-adjust-current-row-cache (- scroll-needed))
-		 (term-vertical-motion scroll-needed)
-		 (set-marker term-home-marker (point))))
-	  (goto-char save-point)
-	  (set-marker save-point nil))))
-  down)
-
-(defun term-down (down &optional check-for-scroll)
-  "Move down DOWN screen lines vertically."
-  (let ((start-column (term-horizontal-column)))
-    (if (and check-for-scroll (or term-scroll-with-delete term-pager-count))
-	(setq down (term-handle-scroll down)))
-    (term-adjust-current-row-cache down)
-    (if (/= (point) (point-max))
-	(setq down (- down (term-vertical-motion down))))
-    ;; Extend buffer with extra blank lines if needed.
-    (cond ((> down 0)
-	   (term-insert-char ?\n down)
-	   (setq term-current-column 0)
-	   (setq term-start-line-column 0))
-	  (t
-	   (setq term-current-column nil)
-	   (setq term-start-line-column (current-column))))
-    (if start-column
-	(term-move-columns start-column))))
-
-;; Assuming point is at the beginning of a screen line,
-;; if the line above point wraps around, add a ?\n to undo the wrapping.
-;; FIXME:  Probably should be called more than it is.
-(defun term-unwrap-line ()
-  (if (not (bolp)) (insert-before-markers ?\n)))
-
-(defun term-erase-in-line (kind)
-  (if (> kind 1) ;; erase left of point
-      (let ((cols (term-horizontal-column)) (saved-point (point)))
-	(term-vertical-motion 0)
-	(delete-region (point) saved-point)
-	(term-insert-char ?\n cols)))
-  (if (not (eq kind 1)) ;; erase right of point
-      (let ((saved-point (point))
-	    (wrapped (and (zerop (term-horizontal-column))
-			  (not (zerop (term-current-column))))))
-	(term-vertical-motion 1)
-	(delete-region saved-point (point))
-	;; wrapped is true if we're at the beginning of screen line,
-	;; but not a buffer line.  If we delete the current screen line
-	;; that will make the previous line no longer wrap, and (because
-	;; of the way emacs display works) point will be at the end of
-	;; the previous screen line rather then the beginning of the
-	;; current one. To avoid that, we make sure that current line
-	;; contain a space, to force the previous line to continue to wrap.
-	;; We could do this always, but it seems preferable to not add the
-	;; extra space when wrapped is false.
-	(if wrapped
-	    (insert ? ))
-	(insert ?\n)
-	(put-text-property saved-point (point) 'face 'default)
-	(goto-char saved-point))))
-
-(defun term-erase-in-display (kind)
-  "Erases (that is blanks out) part of the window.
-If KIND is 0, erase from (point) to (point-max);
-if KIND is 1, erase from home to point; else erase from home to point-max.
-Should only be called when point is at the start of a screen line."
-  (term-handle-deferred-scroll)
-  (cond ((eq term-terminal-parameter 0)
-	 (delete-region (point) (point-max))
-	 (term-unwrap-line))
-	((let ((row (term-current-row))
-	      (col (term-horizontal-column))
-	      (start-region term-home-marker)
-	      (end-region (if (eq kind 1) (point) (point-max))))
-	   (delete-region start-region end-region)
-	   (term-unwrap-line)
-	   (if (eq kind 1)
-	       (term-insert-char ?\n row))
-	   (setq term-current-column nil)
-	   (setq term-current-row nil)
-	   (term-goto row col)))))
-
-(defun term-delete-chars (count)
-  (let ((save-point (point)))
-    (term-vertical-motion 1)
-    (term-unwrap-line)
-    (goto-char save-point)
-    (move-to-column (+ (term-current-column) count) t)
-    (delete-region save-point (point))))
-
-;;; Insert COUNT spaces after point, but do not change any of
-;;; following screen lines.  Hence we may have to delete characters
-;;; at teh end of this screen line to make room.
-
-(defun term-insert-spaces (count)
-  (let ((save-point (point)) (save-eol))
-    (term-vertical-motion 1)
-    (if (bolp)
-	(backward-char))
-    (setq save-eol (point))
-    (move-to-column (+ (term-start-line-column) (- term-width count)) t)
-    (if (> save-eol (point))
-	(delete-region (point) save-eol))
-    (goto-char save-point)
-    (term-insert-char ?  count)
-    (goto-char save-point)))
-
-(defun term-delete-lines (lines)
-  (let ((start (point))
-	(save-current-column term-current-column)
-	(save-start-line-column term-start-line-column)
-	(save-current-row (term-current-row)))
-    (term-down lines)
-    (delete-region start (point))
-    (term-down (- term-scroll-end save-current-row lines))
-    (term-insert-char ?\n lines)
-    (setq term-current-column save-current-column)
-    (setq term-start-line-column save-start-line-column)
-    (setq term-current-row save-current-row)
-    (goto-char start)))
-
-(defun term-insert-lines (lines)
-  (let ((start (point))
-	(start-deleted)
-	(save-current-column term-current-column)
-	(save-start-line-column term-start-line-column)
-	(save-current-row (term-current-row)))
-    (term-down (- term-scroll-end save-current-row lines))
-    (setq start-deleted (point))
-    (term-down lines)
-    (delete-region start-deleted (point))
-    (goto-char start)
-    (setq term-current-column save-current-column)
-    (setq term-start-line-column save-start-line-column)
-    (setq term-current-row save-current-row)
-    (term-insert-char ?\n lines)
-    (goto-char start)))
-
-(defun term-set-output-log (name)
-  "Record raw inferior process output in a buffer."
-  (interactive (list (if term-log-buffer
-			 nil
-		       (read-buffer "Record output in buffer: "
-				    (format "%s output-log"
-					    (buffer-name (current-buffer)))
-				    nil))))
-  (if (or (null name) (equal name ""))
-      (progn (setq term-log-buffer nil)
-	     (message "Output logging off."))
-    (if (get-buffer name)
-	nil
-      (save-excursion
-	(set-buffer (get-buffer-create name))
-	(fundamental-mode)
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)))
-    (setq term-log-buffer (get-buffer name))
-    (message "Recording terminal emulator output into buffer \"%s\""
-	     (buffer-name term-log-buffer))))
-
-(defun term-stop-photo ()
-  "Discontinue raw inferior process logging."
-  (interactive)
-  (term-set-output-log nil))
-
-(defun term-show-maximum-output ()
-  "Put the end of the buffer at the bottom of the window."
-  (interactive)
-  (goto-char (point-max))
-  (recenter -1))
-
-;;; Do the user's customisation...
-
-(defvar term-load-hook nil
-  "This hook is run when term is loaded in.
-This is a good place to put keybindings.")
-	
-(run-hooks 'term-load-hook)
-
-
-;;; Filename/command/history completion in a buffer
-;;; ===========================================================================
-;;; Useful completion functions, courtesy of the Ergo group.
-
-;;; Six commands:
-;;; term-dynamic-complete		Complete or expand command, filename,
-;;;                                     history at point.
-;;; term-dynamic-complete-filename	Complete filename at point.
-;;; term-dynamic-list-filename-completions List completions in help buffer.
-;;; term-replace-by-expanded-filename	Expand and complete filename at point;
-;;;					replace with expanded/completed name.
-;;; term-dynamic-simple-complete	Complete stub given candidates.
-
-;;; These are not installed in the term-mode keymap. But they are
-;;; available for people who want them. Shell-mode installs them:
-;;; (define-key shell-mode-map "\t" 'term-dynamic-complete)
-;;; (define-key shell-mode-map "\M-?"
-;;;             'term-dynamic-list-filename-completions)))
-;;;
-;;; Commands like this are fine things to put in load hooks if you
-;;; want them present in specific modes.
-
-(defvar term-completion-autolist nil
-  "*If non-nil, automatically list possibilities on partial completion.
-This mirrors the optional behavior of tcsh.")
-
-(defvar term-completion-addsuffix t
-  "*If non-nil, add a `/' to completed directories, ` ' to file names.
-This mirrors the optional behavior of tcsh.")
-
-(defvar term-completion-recexact nil
-  "*If non-nil, use shortest completion if characters cannot be added.
-This mirrors the optional behavior of tcsh.
-
-A non-nil value is useful if `term-completion-autolist' is non-nil too.")
-
-(defvar term-completion-fignore nil
-  "*List of suffixes to be disregarded during file completion.
-This mirrors the optional behavior of bash and tcsh.
-
-Note that this applies to `term-dynamic-complete-filename' only.")
-
-(defvar term-file-name-prefix ""
-  "Prefix prepended to absolute file names taken from process input.
-This is used by term's and shell's completion functions, and by shell's
-directory tracking functions.")
-
-
-(defun term-directory (directory)
-  ;; Return expanded DIRECTORY, with `term-file-name-prefix' if absolute.
-  (expand-file-name (if (file-name-absolute-p directory)
-			(concat term-file-name-prefix directory)
-		      directory)))
-
-
-(defun term-word (word-chars)
-  "Return the word of WORD-CHARS at point, or nil if non is found.
-Word constituents are considered to be those in WORD-CHARS, which is like the
-inside of a \"[...]\" (see `skip-chars-forward')."
-  (save-excursion
-    (let ((limit (point))
-	  (word (concat "[" word-chars "]"))
-	  (non-word (concat "[^" word-chars "]")))
-      (if (re-search-backward non-word nil 'move)
-	  (forward-char 1))
-      ;; Anchor the search forwards.
-      (if (or (eolp) (looking-at non-word))
-	  nil
-	(re-search-forward (concat word "+") limit)
-	(buffer-substring (match-beginning 0) (match-end 0))))))
-
-
-(defun term-match-partial-filename ()
-  "Return the filename at point, or nil if non is found.
-Environment variables are substituted.  See `term-word'."
-  (let ((filename (term-word "~/A-Za-z0-9+@:_.$#,={}-")))
-    (and filename (substitute-in-file-name filename))))
-
-
-(defun term-dynamic-complete ()
-  "Dynamically perform completion at point.
-Calls the functions in `term-dynamic-complete-functions' to perform
-completion until a function returns non-nil, at which point completion is
-assumed to have occurred."
-  (interactive)
-  (let ((functions term-dynamic-complete-functions))
-    (while (and functions (null (funcall (car functions))))
-      (setq functions (cdr functions)))))
-
-
-(defun term-dynamic-complete-filename ()
-  "Dynamically complete the filename at point.
-Completes if after a filename.  See `term-match-partial-filename' and
-`term-dynamic-complete-as-filename'.
-This function is similar to `term-replace-by-expanded-filename', except that
-it won't change parts of the filename already entered in the buffer; it just
-adds completion characters to the end of the filename.  A completions listing
-may be shown in a help buffer if completion is ambiguous.
-
-Completion is dependent on the value of `term-completion-addsuffix',
-`term-completion-recexact' and `term-completion-fignore', and the timing of
-completions listing is dependent on the value of `term-completion-autolist'.
-
-Returns t if successful."
-  (interactive)
-  (if (term-match-partial-filename)
-      (prog2 (or (eq (selected-window) (minibuffer-window))
-		 (message "Completing file name..."))
-	  (term-dynamic-complete-as-filename))))
-
-(defun term-dynamic-complete-as-filename ()
-  "Dynamically complete at point as a filename.
-See `term-dynamic-complete-filename'.  Returns t if successful."
-  (let* ((completion-ignore-case nil)
-	 (completion-ignored-extensions term-completion-fignore)
-	 (success t)
-	 (filename (or (term-match-partial-filename) ""))
-	 (pathdir (file-name-directory filename))
-	 (pathnondir (file-name-nondirectory filename))
-	 (directory (if pathdir (term-directory pathdir) default-directory))
-	 (completion (file-name-completion pathnondir directory))
-	 (mini-flag (eq (selected-window) (minibuffer-window))))
-    (cond ((null completion)
-           (message "No completions of %s" filename)
-	   (setq success nil))
-          ((eq completion t)            ; Means already completed "file".
-           (if term-completion-addsuffix (insert " "))
-           (or mini-flag (message "Sole completion")))
-          ((string-equal completion "") ; Means completion on "directory/".
-           (term-dynamic-list-filename-completions))
-          (t                            ; Completion string returned.
-           (let ((file (concat (file-name-as-directory directory) completion)))
-             (insert (substring (directory-file-name completion)
-                                (length pathnondir)))
-             (cond ((symbolp (file-name-completion completion directory))
-                    ;; We inserted a unique completion.
-                    (if term-completion-addsuffix
-                        (insert (if (file-directory-p file) "/" " ")))
-                    (or mini-flag (message "Completed")))
-                   ((and term-completion-recexact term-completion-addsuffix
-                         (string-equal pathnondir completion)
-                         (file-exists-p file))
-                    ;; It's not unique, but user wants shortest match.
-                    (insert (if (file-directory-p file) "/" " "))
-                    (or mini-flag (message "Completed shortest")))
-                   ((or term-completion-autolist
-                        (string-equal pathnondir completion))
-                    ;; It's not unique, list possible completions.
-                    (term-dynamic-list-filename-completions))
-                   (t
-                    (or mini-flag (message "Partially completed")))))))
-    success))
-
-
-(defun term-replace-by-expanded-filename ()
-  "Dynamically expand and complete the filename at point.
-Replace the filename with an expanded, canonicalised and completed replacement.
-\"Expanded\" means environment variables (e.g., $HOME) and `~'s are replaced
-with the corresponding directories.  \"Canonicalised\" means `..'  and `.' are
-removed, and the filename is made absolute instead of relative.  For expansion
-see `expand-file-name' and `substitute-in-file-name'.  For completion see
-`term-dynamic-complete-filename'."
-  (interactive)
-  (replace-match (expand-file-name (term-match-partial-filename)) t t)
-  (term-dynamic-complete-filename))
-
-
-(defun term-dynamic-simple-complete (stub candidates)
-  "Dynamically complete STUB from CANDIDATES list.
-This function inserts completion characters at point by completing STUB from
-the strings in CANDIDATES.  A completions listing may be shown in a help buffer
-if completion is ambiguous.
-
-Returns nil if no completion was inserted.
-Returns `sole' if completed with the only completion match.
-Returns `shortest' if completed with the shortest of the completion matches.
-Returns `partial' if completed as far as possible with the completion matches.
-Returns `listed' if a completion listing was shown.
-
-See also `term-dynamic-complete-filename'."
-  (let* ((completion-ignore-case nil)
-	 (candidates (mapcar (function (lambda (x) (list x))) candidates))
-	 (completions (all-completions stub candidates)))
-    (cond ((null completions)
- 	   (message "No completions of %s" stub)
-	   nil)
- 	  ((= 1 (length completions))	; Gotcha!
- 	   (let ((completion (car completions)))
- 	     (if (string-equal completion stub)
- 		 (message "Sole completion")
- 	       (insert (substring completion (length stub)))
- 	       (message "Completed"))
-	     (if term-completion-addsuffix (insert " "))
-	     'sole))
- 	  (t				; There's no unique completion.
- 	   (let ((completion (try-completion stub candidates)))
- 	     ;; Insert the longest substring.
- 	     (insert (substring completion (length stub)))
- 	     (cond ((and term-completion-recexact term-completion-addsuffix
- 			 (string-equal stub completion)
- 			 (member completion completions))
- 		    ;; It's not unique, but user wants shortest match.
- 		    (insert " ")
- 		    (message "Completed shortest")
-		    'shortest)
- 		   ((or term-completion-autolist
- 			(string-equal stub completion))
- 		    ;; It's not unique, list possible completions.
- 		    (term-dynamic-list-completions completions)
-		    'listed)
- 		   (t
-		    (message "Partially completed")
-		    'partial)))))))
-
-
-(defun term-dynamic-list-filename-completions ()
-  "List in help buffer possible completions of the filename at point."
-  (interactive)
-  (let* ((completion-ignore-case nil)
-	 (filename (or (term-match-partial-filename) ""))
-	 (pathdir (file-name-directory filename))
-	 (pathnondir (file-name-nondirectory filename))
-	 (directory (if pathdir (term-directory pathdir) default-directory))
-	 (completions (file-name-all-completions pathnondir directory)))
-    (if completions
-	(term-dynamic-list-completions completions)
-      (message "No completions of %s" filename))))
-
-
-(defun term-dynamic-list-completions (completions)
-  "List in help buffer sorted COMPLETIONS.
-Typing SPC flushes the help buffer."
-  (let ((conf (current-window-configuration)))
-    (with-output-to-temp-buffer "*Completions*"
-      (display-completion-list (sort completions 'string-lessp)))
-    (message "Hit space to flush")
-    (let (key first)
-      (if (save-excursion
-	    (set-buffer (get-buffer "*Completions*"))
-	    (setq key (read-key-sequence nil)
-		  first (aref key 0))
-	    (and (consp first)
-		 (eq (window-buffer (posn-window (event-start first)))
-		     (get-buffer "*Completions*"))
-		 (eq (key-binding key) 'mouse-choose-completion)))
-	  ;; If the user does mouse-choose-completion with the mouse,
-	  ;; execute the command, then delete the completion window.
-	  (progn
-	    (mouse-choose-completion first)
-	    (set-window-configuration conf))
-	(if (eq first ?\ )
-	    (set-window-configuration conf)
-	  (setq unread-command-events (listify-key-sequence key)))))))
-
-;;; Converting process modes to use term mode
-;;; ===========================================================================
-;;; Renaming variables
-;;; Most of the work is renaming variables and functions. These are the common
-;;; ones:
-;;; Local variables:
-;;;	last-input-start	term-last-input-start
-;;; 	last-input-end		term-last-input-end
-;;;	shell-prompt-pattern	term-prompt-regexp
-;;;     shell-set-directory-error-hook <no equivalent>
-;;; Miscellaneous:
-;;;	shell-set-directory	<unnecessary>
-;;; 	shell-mode-map		term-mode-map
-;;; Commands:
-;;;	shell-send-input	term-send-input
-;;;	shell-send-eof		term-delchar-or-maybe-eof
-;;; 	kill-shell-input	term-kill-input
-;;;	interrupt-shell-subjob	term-interrupt-subjob
-;;;	stop-shell-subjob	term-stop-subjob
-;;;	quit-shell-subjob	term-quit-subjob
-;;;	kill-shell-subjob	term-kill-subjob
-;;;	kill-output-from-shell	term-kill-output
-;;;	show-output-from-shell	term-show-output
-;;;	copy-last-shell-input	Use term-previous-input/term-next-input
-;;;
-;;; SHELL-SET-DIRECTORY is gone, its functionality taken over by
-;;; SHELL-DIRECTORY-TRACKER, the shell mode's term-input-filter-functions.
-;;; Term mode does not provide functionality equivalent to
-;;; shell-set-directory-error-hook; it is gone.
-;;;
-;;; term-last-input-start is provided for modes which want to munge
-;;; the buffer after input is sent, perhaps because the inferior
-;;; insists on echoing the input.  The LAST-INPUT-START variable in
-;;; the old shell package was used to implement a history mechanism,
-;;; but you should think twice before using term-last-input-start
-;;; for this; the input history ring often does the job better.
-;;; 
-;;; If you are implementing some process-in-a-buffer mode, called foo-mode, do
-;;; *not* create the term-mode local variables in your foo-mode function.
-;;; This is not modular.  Instead, call term-mode, and let *it* create the
-;;; necessary term-specific local variables. Then create the
-;;; foo-mode-specific local variables in foo-mode.  Set the buffer's keymap to
-;;; be foo-mode-map, and its mode to be foo-mode.  Set the term-mode hooks
-;;; (term-{prompt-regexp, input-filter, input-filter-functions,
-;;; get-old-input) that need to be different from the defaults.  Call
-;;; foo-mode-hook, and you're done. Don't run the term-mode hook yourself;
-;;; term-mode will take care of it. The following example, from shell.el,
-;;; is typical:
-;;; 
-;;; (defvar shell-mode-map '())
-;;; (cond ((not shell-mode-map)
-;;;        (setq shell-mode-map (copy-keymap term-mode-map))
-;;;        (define-key shell-mode-map "\C-c\C-f" 'shell-forward-command)
-;;;        (define-key shell-mode-map "\C-c\C-b" 'shell-backward-command)
-;;;        (define-key shell-mode-map "\t" 'term-dynamic-complete)
-;;;        (define-key shell-mode-map "\M-?"
-;;;          'term-dynamic-list-filename-completions)))
-;;;
-;;; (defun shell-mode ()
-;;;   (interactive)
-;;;   (term-mode)
-;;;   (setq term-prompt-regexp shell-prompt-pattern)
-;;;   (setq major-mode 'shell-mode)
-;;;   (setq mode-name "Shell")
-;;;   (use-local-map shell-mode-map)
-;;;   (make-local-variable 'shell-directory-stack)
-;;;   (setq shell-directory-stack nil)
-;;;   (add-hook 'term-input-filter-functions 'shell-directory-tracker)
-;;;   (run-hooks 'shell-mode-hook))
-;;;
-;;;
-;;; Note that make-term is different from make-shell in that it
-;;; doesn't have a default program argument. If you give make-shell
-;;; a program name of NIL, it cleverly chooses one of explicit-shell-name,
-;;; $ESHELL, $SHELL, or /bin/sh. If you give make-term a program argument
-;;; of NIL, it barfs. Adjust your code accordingly...
-;;;
-;;; Completion for term-mode users
-;;; 
-;;; For modes that use term-mode, term-dynamic-complete-functions is the
-;;; hook to add completion functions to.  Functions on this list should return
-;;; non-nil if completion occurs (i.e., further completion should not occur).
-;;; You could use term-dynamic-simple-complete to do the bulk of the
-;;; completion job.
-
-(provide 'term)
-
-;;; term.el ends here
diff --git a/lisp/term/README b/lisp/term/README
deleted file mode 100644
index e672b15dcf7..00000000000
--- a/lisp/term/README
+++ /dev/null
@@ -1,214 +0,0 @@
-   This directory contains files of elisp that customize Emacs for certain
-terminal types.
-
-   When Emacs starts, it checks the TERM environment variable to see what type
-of terminal the user is running on, checks for an elisp file named
-"term/${TERM}.el", and if one exists, loads it.  If that doesn't yield a file
-that exists, the last hyphen and what follows it is stripped.  If that doesn't
-yield a file that exists, the previous hyphen is stripped, and so on until all
-hyphens are gone.  For example, if the terminal type is `aaa-48-foo', Emacs
-will try first `term/aaa-48-foo.el', then `term/aaa-48.el' and finally
-`term/aaa.el'.
-
-   When writing terminal packages, there are some things it is good to keep in
-mind.
-
-   First, about keycap names.  Your terminal package can create any keycap
-cookies it likes, but there are good reasons to stick to the set recognized by
-the X-windows code whenever possible.  The key symbols recognized by Emacs
-are listed in src/term.c; look for the string `keys' in that file.
-
-   For one thing, it means that you'll have the same Emacs key bindings on in
-terminal mode as on an X console.  If there are differences, you can bet
-they'll frustrate you after you've forgotten about them.
-
-   For another, the X keysms provide a standard set of names that Emacs knows
-about.  It tries to bind many of them to useful things at startup, before your
-.emacs is read (so you can override them).  In some ways, the X keysym standard
-is a admittedly poor one; it's incomplete, and not well matched to the set of
-`virtual keys' that UNIX terminfo(3) provides.  But, trust us, the alternatives
-were worse.
-
-   This doesn't mean that if your terminal has a "Cokebottle" key you shouldn't
-define a [cokebottle] keycap.  But if you must define cookies that aren't in
-that set, try to pattern them on the standard terminfo variable names for
-clarity; also, for a fighting chance that your binding may be useful to someone
-else someday.
-
-   For example, if your terminal has a `find' key, observe that terminfo
-supports a key_find capability and call your cookie [key-find].
-
-Here is a complete list, with corresponding X keysyms.
-
------------------------------------------------------------------------------
-Variable name	cap	X Keysym	Description
---------------	---	------------	-------------------------------------
-key_down	kd	down		Sent by terminal down arrow key
-key_up		ku	up		Sent by terminal up arrow key
-key_left	kl	left		Sent by terminal left arrow key
-key_right	kr	right		Sent by terminal right arrow key
-key_home	kh	home		Sent by home key.
-key_backspace	kb			Sent by backspace key
-key_dl		kd	deleteline	Sent by delete line key.
-key_il		kA	insertline	Sent by insert line.
-key_dc		kD			Sent by delete character key.
-key_ic		kI	insertchar (1)	Sent by ins char/enter ins mode key.
-key_eic		KM			Sent by rmir or smir in insert mode.
-key_clear	kC			Sent by clear screen or erase key.
-key_eos		kS			Sent by clear-to-end-of-screen key.
-key_eol		kE			Sent by clear-to-end-of-line key.
-key_sf		kF			Sent by scroll-forward/down key
-key_sr		kR			Sent by scroll-backward/up key
-key_npage	kN	next (2)	Sent by next-page key
-key_ppage	kP	prior (2)	Sent by previous-page key
-key_stab	kT			Sent by set-tab key
-key_ctab	kt			Sent by clear-tab key
-key_catab	ka			Sent by clear-all-tabs key.
-key_enter	@8	kp-enter	Enter/send (unreliable)
-key_print	%9	print		print or copy
-key_ll		kH			Sent by home-down key
-key_a1		K1	kp-1		Upper left of keypad
-key_a3		K3	kp-3		Upper right of keypad
-key_b2		K2	kp-5		Center of keypad
-key_c1		K4	kp-7		Lower left of keypad
-key_c3		K5	kp-9		Lower right of keypad
-key_btab	kB	backtab		Back tab key
-key_beg		@1	begin		beg(inning) key
-key_cancel	@2	cancel		cancel key
-key_close	@3			close key
-key_command	@4	execute (3)	cmd (command) key
-key_copy	@5			copy key
-key_create	@6			create key
-key_end		@7	end		end key
-key_exit	@9			exit key
-key_find	@0			find key
-key_help	%1			help key
-key_mark	%2			mark key
-key_message	%3			message key
-key_move	%4			move key
-key_next	%5	next (2)	next object key
-key_open	%6			open key
-key_options	%7	menu (3)	options key
-key_previous	%8	previous (2)	previous object key
-key_redo	%0	redo		redo key
-key_reference	&1			ref(erence) key
-key_refresh	&2			refresh key
-key_replace	&3			replace key
-key_restart	&4	reset (3)	restart key
-key_resume	&5			resume key
-key_save	&6			save key
-key_sbeg	&9			shifted beginning key
-key_select	*6	select		select key
-key_suspend	&7			suspend key
-key_undo	&8	undo		undo key
-
-key_scancel	&0			shifted cancel key
-key_scommand	*1			shifted command key
-key_scopy	*2			shifted copy key
-key_screate	*3			shifted create key
-key_sdc		*4			shifted delete char key
-key_sdl		*5			shifted delete line key
-key_send	*7			shifted end key
-key_seol	*8			shifted clear line key
-key_sexit	*9			shifted exit key
-key_sf		kF			shifted find key
-key_shelp	#1			shifted help key
-key_shome	#2			shifted home key
-key_sic		#3			shifted input key
-key_sleft	#4			shifted left arrow key
-key_smessage	%a			shifted message key
-key_smove	%b			shifted move key
-key_snext	%c			shifted next key
-key_soptions	%d			shifted options key
-key_sprevious	%e			shifted prev key
-key_sprint	%f			shifted print key
-key_sredo	%g			shifted redo key
-key_sreplace	%h			shifted replace key
-key_sright	%i			shifted right arrow
-key_sresume	%j			shifted resume key
-key_ssave	!1			shifted save key
-key_suspend	!2			shifted suspend key
-key_sundo	!3			shifted undo key
-
-key_f0		k0	f0 (4)		function key 0
-key_f1		k1	f1		function key 1
-key_f2		k2	f2		function key 2
-key_f3		k3	f3		function key 3
-key_f4		k4	f4		function key 4
-key_f5		k5	f5		function key 5
-key_f6		k6	f6		function key 6
-key_f7		k7	f7		function key 7
-key_f8		k8	f8		function key 8
-key_f9		k9	f9		function key 9
-key_f10		k;	f10 (4)		function key 10
-key_f11		F1	f11		function key 11
-  :		:	   :			:
-key_f35		FP	f35		function key 35
-key_f36		FQ			function key 36
-  :		:	   :			:
-key_f64		k1			function key 64
-
-(1) The terminfo documentation says this may be the 'insert character' or
-    `enter insert mode' key.  Accordingly, key_ic is mapped to the `insertchar'
-    keysym if there is also a key_dc key; otherwise it's mapped to `insert'.
-    The presumption is that keyboards with `insert character' keys usually
-    have `delete character' keys paired with them.
-
-(2) If there is no key_next key but there is a key_npage key, key_npage
-    will be bound to the `next' keysym.  If there is no key_previous key but
-    there is a key_ppage key, key_ppage will be bound to the `previous' keysym.
-
-(3) Sorry, these are not exact but they're the best we can do.
-
-(4) The uses of the "k0" capability are inconsistent; sometimes it
-    describes F10, whereas othertimes it describes F0 and "k;" describes F10.
-    Emacs attempts to politely accommodate both systems by testing for
-    "k;", and if it is present, assuming that "k0" denotes F0, otherwise F10.
------------------------------------------------------------------------------
-
-   The following X keysyms do *not* have terminfo equivalents.   These are
-the cookies your terminal package will have to set up itself, if you want them:
-
-	break
-	system
-	user
-	kp-backtab
-	kp-space
-	kp-tab
-	kp-f1
-	kp-f2
-	kp-f3
-	kp-f4
-	kp-multiply
-	kp-add
-	kp-separator
-	kp-subtract
-	kp-decimal
-	kp-divide
-	kp-0
-	kp-2
-	kp-4
-	kp-6
-	kp-8
-	kp-equal
-
-   In general, you should not bind any of the standard keysym names to
-functions in a terminal package.  There's code in loaddefs.el that does that;
-the less people make exceptions to that, the more consistent an interface Emacs
-will have across different keyboards.  Those exceptions should go in your
-.emacs file.
-
-   Finally, if you're using a USL UNIX or a Sun box or anything else with the
-USL version of curses(3) on it, bear in mind that the original curses(3) had
-(and still has) a very much smaller set of keycaps.  In fact, the reliable
-ones were just the arrow keys and the first ten function keys.  If you care
-about making your package portable to older Berkeley machines, don't count on
-the setup code to bind anything else.
-
-   If your terminal's arrow key sequences are so funky that they conflict with
-normal Emacs key bindings, the package should set up a function called
-(enable-foo-arrow-keys), where `foo' becomes the terminal name, and leave
-it up to the user's .emacs file whether to call it.
-
-   Before writing a terminal-support package, it's a good idea to read the
-existing ones and learn the common conventions.
diff --git a/lisp/term/apollo.el b/lisp/term/apollo.el
deleted file mode 100644
index ffe8e6bb1a6..00000000000
--- a/lisp/term/apollo.el
+++ /dev/null
@@ -1 +0,0 @@
-(load "term/vt100" nil t)
diff --git a/lisp/term/bg-mouse.el b/lisp/term/bg-mouse.el
deleted file mode 100644
index dfd81d3fba9..00000000000
--- a/lisp/term/bg-mouse.el
+++ /dev/null
@@ -1,313 +0,0 @@
-;;; bg-mouse.el --- GNU Emacs code for BBN Bitgraph mouse.
-
-;; Copyright (C) Free Software Foundation, Inc. Oct 1985.
-
-;; Author: John Robinson <jr@bbn-unix.arpa>
-;;	Stephen Gildea <gildea@bbn.com>
-;; Maintainer: FSF
-;; Keywords: hardware
-
-;; 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.
-
-;;; Code:
-
-;;;  Original version by John Robinson (jr@bbn-unix.arpa, bbncca!jr), Oct 1985
-;;;  Modularized and enhanced by gildea@bbn.com Nov 1987
-;;;  Time stamp <89/03/21 14:27:08 gildea>
-
-;;;  User customization option:
-
-(defvar bg-mouse-fast-select-window nil
-  "*Non-nil for mouse hits to select new window, then execute; else just select.")
-
-;;; These numbers are summed to make the index into the mouse-map.
-;;; The low three bits correspond to what the mouse actually sends.
-(defconst bg-button-r 1)
-(defconst bg-button-m 2)
-(defconst bg-button-c 2)
-(defconst bg-button-l 4)
-(defconst bg-in-modeline 8)
-(defconst bg-in-scrollbar 16)
-(defconst bg-in-minibuf 24)
-
-;;; semicolon screws up indenting, so use this instead
-(defconst semicolon ?\;)
-
-;;;  Defuns:
-
-(defun bg-mouse-report (prefix-arg)
-  "Read, parse, and execute a BBN BitGraph mouse click.
-
-L-- move point             | These apply for mouse click in a window.
---R set mark               | If bg-mouse-fast-select-window is nil,
-L-R kill region            | these commands on a nonselected window
--C- move point and yank    | just select that window.
-LC- yank-pop		   |
--CR or LCR undo		   | \"Scroll bar\" is right-hand window column.
-
-on modeline:		    on \"scroll bar\":	in minibuffer:
-L-- scroll-up		    line to top		execute-extended-command
---R scroll-down		    line to bottom	eval-expression
--C- proportional goto-char  line to middle	suspend-emacs
-
-To reinitialize the mouse if the terminal is reset, type ESC : RET"
-  (interactive "P")
-  (bg-get-tty-num semicolon)
-  (let*
-      ((screen-mouse-x (min (1- (frame-width))	;don't hit column 86!
-			    (/ (bg-get-tty-num semicolon) 9)))
-       (screen-mouse-y (- (1- (frame-height)) ;assume default font size.
-			  (/ (bg-get-tty-num semicolon) 16))) 
-       (bg-mouse-buttons (% (bg-get-tty-num ?c) 8))
-       (bg-mouse-window (bg-window-from-x-y screen-mouse-x screen-mouse-y))
-       (bg-cursor-window (selected-window))
-       (edges (window-edges bg-mouse-window))
-       (minibuf-p (= screen-mouse-y (1- (screen-height))))
-       (in-modeline-p (and (not minibuf-p)
-			   (= screen-mouse-y (1- (nth 3 edges)))))
-       (in-scrollbar-p (and (not minibuf-p) (not in-modeline-p)
-			    (>= screen-mouse-x (1- (nth 2 edges)))))
-       (same-window-p (eq bg-mouse-window bg-cursor-window))
-       (in-minibuf-p (and minibuf-p
-			  (not bg-mouse-window))) ;minibuf must be inactive
-       (bg-mode-bits (+ (if in-minibuf-p bg-in-minibuf 0)
-			(if in-modeline-p bg-in-modeline 0)
-			(if in-scrollbar-p bg-in-scrollbar 0)))
-       (bg-command
-	 (lookup-key mouse-map
-		     (char-to-string (+ bg-mode-bits bg-mouse-buttons))))
-       (bg-mouse-x (- screen-mouse-x (nth 0 edges)))
-       (bg-mouse-y (- screen-mouse-y (nth 1 edges))))
-    (cond ((or in-modeline-p in-scrollbar-p)
-	   (select-window bg-mouse-window)
-	   (bg-command-execute bg-command)
-	   (select-window bg-cursor-window))
-	  ((or same-window-p in-minibuf-p)
-	   (bg-command-execute bg-command))
-	  (t				;in another window
-	    (select-window bg-mouse-window)
-	    (if bg-mouse-fast-select-window
-		(bg-command-execute bg-command)))
-	  )))
-
-
-;;; Library of commands:
-
-(defun bg-set-point ()
-  "Move point to location of BitGraph mouse."
-  (interactive)
-  (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
-  (setq this-command 'next-line)	;make subsequent line moves work
-  (setq temporary-goal-column bg-mouse-x))
-
-(defun bg-set-mark ()
-  "Set mark at location of BitGraph mouse."
-  (interactive)
-  (push-mark)
-  (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
-  (exchange-point-and-mark))
-
-(defun bg-yank ()
-  "Move point to location of BitGraph mouse and yank."
-  (interactive "*")
-  (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
-  (setq this-command 'yank)
-  (yank))
-
-(defun yank-pop-1 ()
-  (interactive "*")
-  (yank-pop 1))
-
-(defun bg-yank-or-pop ()
-  "Move point to location of BitGraph mouse and yank.  If last command
-was a yank, do a yank-pop."
-  (interactive "*")
-  (if (eql last-command 'yank)
-      (yank-pop 1)
-    (bg-yank)))
-
-;;; In 18.51, Emacs Lisp doesn't provide most-positive-fixnum
-(defconst bg-most-positive-fixnum 8388607)
-
-(defun bg-move-by-percentage ()
-  "Go to location in buffer that is the same percentage of the way
-through the buffer as the BitGraph mouse's X position in the window."
-  (interactive)
-  ;; check carefully for overflow in intermediate calculations
-  (goto-char
-   (cond ((zerop bg-mouse-x)
-	  0)
-	 ((< (buffer-size) (/ bg-most-positive-fixnum bg-mouse-x))
-	  ;; no danger of overflow: compute it exactly
-	  (/ (* bg-mouse-x (buffer-size))
-	     (1- (window-width))))
-	 (t
-	  ;; overflow possible: approximate
-	  (* (/ (buffer-size) (1- (window-width)))
-	     bg-mouse-x))))
-  (beginning-of-line)
-  (what-cursor-position))
-
-(defun bg-mouse-line-to-top ()
-  "Scroll the line pointed to by the BitGraph mouse to the top of the window."
-  (interactive)
-  (scroll-up bg-mouse-y))
-
-(defun bg-mouse-line-to-center ()
-  "Scroll the line pointed to by the BitGraph mouse to the center 
-of the window"
-  (interactive)
-  (scroll-up (/ (+ 2 bg-mouse-y bg-mouse-y (- (window-height))) 2)))
-
-(defun bg-mouse-line-to-bottom ()
-  "Scroll the line pointed to by the mouse to the bottom of the window."
-  (interactive)
-  (scroll-up (+ bg-mouse-y (- 2 (window-height)))))
-
-(defun bg-kill-region ()
-  (interactive "*")
-  (kill-region (region-beginning) (region-end)))
-
-(defun bg-insert-moused-sexp ()
-  "Insert a copy of the word (actually sexp) that the mouse is pointing at.
-Sexp is inserted into the buffer at point (where the text cursor is)."
-  (interactive)
-  (let ((moused-text
-	  (save-excursion
-	    (bg-move-point-to-x-y bg-mouse-x bg-mouse-y)
-	    (if (looking-at "\\s)")
-		(forward-char 1)
-	      (forward-sexp 1))
-	    (buffer-substring (save-excursion (backward-sexp 1) (point))
-			      (point)))))
-    (select-window bg-cursor-window)
-    (delete-horizontal-space)
-    (cond
-     ((bolp)
-      (indent-according-to-mode))
-     ;; In Lisp assume double-quote is closing; in Text assume opening.
-     ;; Why?  Because it does the right thing most often.
-     ((save-excursion (forward-char -1)
-		      (and (not (looking-at "\\s\""))
-			   (looking-at "[`'\"\\]\\|\\s(")))
-      nil)
-     (t
-      (insert-string " ")))
-    (insert-string moused-text)
-    (or (eolp)
-	(looking-at "\\s.\\|\\s)")
-	(and (looking-at "'") (looking-at "\\sw")) ;hack for text mode
-	(save-excursion (insert-string " ")))))
-
-;;; Utility functions:
-
-(defun bg-get-tty-num (term-char)
-  "Read from terminal until TERM-CHAR is read, and return intervening number.
-If non-numeric not matching TERM-CHAR, reprogram the mouse and signal an error."
-  (let
-      ((num 0)
-       (char (- (read-char) 48)))
-    (while (and (>= char 0)
-		(<= char 9))
-      (setq num (+ (* num 10) char))
-      (setq char (- (read-char) 48)))
-    (or (eq term-char (+ char 48))
-	(progn
-	  (bg-program-mouse)
-	  (error
-	    "Invalid data format in bg-mouse command: mouse reinitialized.")))
-    num))
-
-;;; Note that this fails in the minibuf because move-to-column doesn't
-;;; allow for the width of the prompt.
-(defun bg-move-point-to-x-y (x y)
-  "Position cursor in window coordinates.
-X and Y are 0-based character positions in the window."
-  (move-to-window-line y)
-  ;; if not on a wrapped line, zero-column will be 0
-  (let ((zero-column (current-column))
-	(scroll-offset (window-hscroll)))
-    ;; scrolling takes up column 0 to display the $
-    (if (> scroll-offset 0)
-	(setq scroll-offset (1- scroll-offset)))
-    (move-to-column (+ zero-column scroll-offset x))
-    ))
-
-;;; Returns the window that screen position (x, y) is in or nil if none,
-;;; meaning we are in the echo area with a non-active minibuffer.
-;;; If coordinates-in-window-p were not in an X-windows-specific file
-;;; we could use that.  In Emacs 19 can even use locate-window-from-coordinates
-(defun bg-window-from-x-y (x y)
-  "Find window corresponding to screen coordinates.
-X and Y are 0-based character positions on the screen."
-  (let ((edges (window-edges))
-	(window nil))
-    (while (and (not (eq window (selected-window)))
-		(or (<  y (nth 1 edges))
-		    (>= y (nth 3 edges))
-		    (<  x (nth 0 edges))
-		    (>= x (nth 2 edges))))
-      (setq window (next-window window))
-      (setq edges (window-edges window)))
-    (cond ((eq window (selected-window))
-	   nil)				;we've looped: not found
-	  ((not window)
-	   (selected-window))		;just starting: current window
-	  (t
-	    window))
-    ))
-
-(defun bg-command-execute (bg-command)
-  (if (commandp bg-command)
-      (command-execute bg-command)
-    (ding)))
-
-(defun bg-program-mouse ()
-  (send-string-to-terminal "\e:0;7;;;360;512;9;16;9;16c"))
-
-;;; Note that the doc string for mouse-map (as defined in subr.el)
-;;; says it is for the X-window mouse.  This is wrong; that keymap
-;;; should be used for your mouse no matter what terminal you have.
-
-(or (keymapp mouse-map)
-    (setq mouse-map (make-keymap)))
-
-(defun bind-bg-mouse-click (click-code function)
-  "Bind bg-mouse CLICK-CODE to run FUNCTION."
-  (define-key mouse-map (char-to-string click-code) function))
-
-(bind-bg-mouse-click bg-button-l 'bg-set-point) 
-(bind-bg-mouse-click bg-button-m 'bg-yank)
-(bind-bg-mouse-click bg-button-r 'bg-set-mark)
-(bind-bg-mouse-click (+ bg-button-l bg-button-m) 'yank-pop-1)
-(bind-bg-mouse-click (+ bg-button-l bg-button-r) 'bg-kill-region)
-(bind-bg-mouse-click (+ bg-button-m bg-button-r) 'undo)
-(bind-bg-mouse-click (+ bg-button-l bg-button-m bg-button-r) 'undo)
-(bind-bg-mouse-click (+ bg-in-modeline bg-button-l) 'scroll-up)
-(bind-bg-mouse-click (+ bg-in-modeline bg-button-m) 'bg-move-by-percentage)
-(bind-bg-mouse-click (+ bg-in-modeline bg-button-r) 'scroll-down)
-(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-l) 'bg-mouse-line-to-top)
-(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-m) 'bg-mouse-line-to-center)
-(bind-bg-mouse-click (+ bg-in-scrollbar bg-button-r) 'bg-mouse-line-to-bottom)
-(bind-bg-mouse-click (+ bg-in-minibuf bg-button-l) 'execute-extended-command)
-(bind-bg-mouse-click (+ bg-in-minibuf bg-button-m) 'suspend-emacs)
-(bind-bg-mouse-click (+ bg-in-minibuf bg-button-r) 'eval-expression)
-
-(provide 'bg-mouse)
-
-;;; bg-mouse.el ends here
diff --git a/lisp/term/bobcat.el b/lisp/term/bobcat.el
deleted file mode 100644
index f106b8b75c2..00000000000
--- a/lisp/term/bobcat.el
+++ /dev/null
@@ -1,2 +0,0 @@
-;;; HP terminals usually encourage using ^H as the rubout character
-(load "term/keyswap" nil t)
diff --git a/lisp/term/internal.el b/lisp/term/internal.el
deleted file mode 100644
index e9e6c02336d..00000000000
--- a/lisp/term/internal.el
+++ /dev/null
@@ -1,91 +0,0 @@
-;; internal.el -- setup support for PC keyboards and screens, internal terminal
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Morten Welinder <terra@diku.dk>
-;; Version: 1.02
-
-;; 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.
-
-;;; Code:
-
-;; ---------------------------------------------------------------------------
-;; screen setup -- that's easy!
-(standard-display-8bit 127 254)
-;; ---------------------------------------------------------------------------
-;; keyboard setup -- that's simple!
-(set-input-mode nil nil 0)
-(define-key function-key-map [backspace] "\177") ; Normal behaviour for BS
-(define-key function-key-map [delete] "\C-d")    ; ... and Delete
-(define-key function-key-map [tab] [?\t])
-(define-key function-key-map [linefeed] [?\n])
-(define-key function-key-map [clear] [11])
-(define-key function-key-map [return] [13])
-(define-key function-key-map [escape] [?\e])
-(define-key function-key-map [M-backspace] [?\M-\d])
-(define-key function-key-map [M-delete] [?\M-\d])
-(define-key function-key-map [M-tab] [?\M-\t])
-(define-key function-key-map [M-linefeed] [?\M-\n])
-(define-key function-key-map [M-clear] [?\M-\013])
-(define-key function-key-map [M-return] [?\M-\015])
-(define-key function-key-map [M-escape] [?\M-\e])
-(put 'backspace 'ascii-character 127)
-(put 'delete 'ascii-character 127)
-(put 'tab 'ascii-character ?\t)
-(put 'linefeed 'ascii-character ?\n)
-(put 'clear 'ascii-character 12)
-(put 'return 'ascii-character 13)
-(put 'escape 'ascii-character ?\e)
-;; ---------------------------------------------------------------------------
-;; We want to do this when Emacs is started because it depends on the
-;; country code.
-(let* ((i 128)
-      (modify (function
-	       (lambda (ch sy) 
-		 (modify-syntax-entry ch sy text-mode-syntax-table)
-		 (if (boundp 'tex-mode-syntax-table)
-		     (modify-syntax-entry ch sy tex-mode-syntax-table))
-		 (modify-syntax-entry ch sy (standard-syntax-table))
-		 )))
-      (table (standard-case-table))
-      ;; The following are strings of letters, first lower then upper case.
-      ;; This will look funny on terminals which display other code pages.
-      (chars
-       (cond
-	((= dos-codepage 850)
-	 "‡€�š‚�ƒ¶„Ž…·†�ÆÇ µˆÒ‰ÓŠÔ‹ØŒ×�Þ¡Ö‘’“â”™•ã¢à›�–ê£é—ë˜Yìí¡I£é¤¥ÐÑçè")
-	((= dos-codepage 865)
-	 "‡€�š‚�ƒA„Ž…A†�ˆE‰EŠE‹IŒI�I‘’“O”™•O–U£U˜Y›� A¡I¢O£U¤¥")
-	;; default is 437
-	(t "‡€�š‚�ƒA„Ž…A†�ˆE‰EŠE‹IŒI�I‘’“O”™•O–U£U˜Y A¡I¢O£U¤¥"))))
-
-  (while (< i 256)
-    (funcall modify i "_")
-    (setq i (1+ i)))
-
-  (setq i 0)
-  (while (< i (length chars))
-    (let ((ch1 (aref chars i))
-	  (ch2 (aref chars (1+ i))))
-      (if (> ch2 127)
-	  (set-case-syntax-pair ch2 ch1 table))
-      (setq i (+ i 2))))
-  (save-excursion
-    (mapcar (lambda (b) (set-buffer b) (set-case-table table))
-	    (buffer-list)))
-  (set-standard-case-table table))
diff --git a/lisp/term/keyswap.el b/lisp/term/keyswap.el
deleted file mode 100644
index 55ef13fd9b1..00000000000
--- a/lisp/term/keyswap.el
+++ /dev/null
@@ -1,41 +0,0 @@
-;; keyswap.el --- swap BS and DEL keys
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Keywords: terminals
-
-;; 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 is meant to be called by other terminal packages.
-
-;;; Code:
-
-(let ((the-table (make-string 128 0)))
-  (let ((i 0))
-    (while (< i 128)
-      (aset the-table i i)
-      (setq i (1+ i))))
-  ;; Swap ^H and DEL
-  (aset the-table ?\177 ?\^h)
-  (aset the-table ?\^h ?\177)
-  (setq keyboard-translate-table the-table))
-
-;;; keyswap.el ends here
diff --git a/lisp/term/lk201.el b/lisp/term/lk201.el
deleted file mode 100644
index aedf221b4f1..00000000000
--- a/lisp/term/lk201.el
+++ /dev/null
@@ -1,68 +0,0 @@
-;; Define function key sequences for DEC terminals.
-
-;; Termcap or terminfo should set these.
-;; (define-key function-key-map "\e[A" [up])
-;; (define-key function-key-map "\e[B" [down])
-;; (define-key function-key-map "\e[C" [right])
-;; (define-key function-key-map "\e[D" [left])
-
-(define-key function-key-map "\e[1~" [find])
-(define-key function-key-map "\e[2~" [insert])
-(define-key function-key-map "\e[3~" [delete])
-(define-key function-key-map "\e[4~" [select])
-(define-key function-key-map "\e[5~" [prior])
-(define-key function-key-map "\e[6~" [next])
-(define-key function-key-map "\e[11~" [f1])
-(define-key function-key-map "\e[12~" [f2])
-(define-key function-key-map "\e[13~" [f3])
-(define-key function-key-map "\e[14~" [f4])
-(define-key function-key-map "\e[15~" [f5])
-(define-key function-key-map "\e[17~" [f6])
-(define-key function-key-map "\e[18~" [f7])
-(define-key function-key-map "\e[19~" [f8])
-(define-key function-key-map "\e[20~" [f9])
-(define-key function-key-map "\e[21~" [f10])
-;; Customarily F11 is used as the ESC key.
-;; The file that includes this one, takes care of that.
-(define-key function-key-map "\e[23~" [f11])
-(define-key function-key-map "\e[24~" [f12])
-(define-key function-key-map "\e[25~" [f13])
-(define-key function-key-map "\e[26~" [f14])
-(define-key function-key-map "\e[28~" [help])
-(define-key function-key-map "\e[29~" [menu])
-(define-key function-key-map "\e[31~" [f17])
-(define-key function-key-map "\e[32~" [f18])
-(define-key function-key-map "\e[33~" [f19])
-(define-key function-key-map "\e[34~" [f20])
-
-;; Termcap or terminfo should set these.
-;; (define-key function-key-map "\eOA" [up])
-;; (define-key function-key-map "\eOB" [down])
-;; (define-key function-key-map "\eOC" [right])
-;; (define-key function-key-map "\eOD" [left])
-
-;; Termcap or terminfo should set these, but doesn't properly.
-;; Termcap sets these to k1-k4, which get mapped to f1-f4 in term.c
-(define-key function-key-map "\eOP" [kp-f1])
-(define-key function-key-map "\eOQ" [kp-f2])
-(define-key function-key-map "\eOR" [kp-f3])
-(define-key function-key-map "\eOS" [kp-f4])
-
-(define-key function-key-map "\eOI" [kp-tab])
-(define-key function-key-map "\eOj" [kp-multiply])
-(define-key function-key-map "\eOk" [kp-add])
-(define-key function-key-map "\eOl" [kp-separator])
-(define-key function-key-map "\eOM" [kp-enter])
-(define-key function-key-map "\eOm" [kp-subtract])
-(define-key function-key-map "\eOn" [kp-decimal])
-(define-key function-key-map "\eOo" [kp-divide])
-(define-key function-key-map "\eOp" [kp-0])
-(define-key function-key-map "\eOq" [kp-1])
-(define-key function-key-map "\eOr" [kp-2])
-(define-key function-key-map "\eOs" [kp-3])
-(define-key function-key-map "\eOt" [kp-4])
-(define-key function-key-map "\eOu" [kp-5])
-(define-key function-key-map "\eOv" [kp-6])
-(define-key function-key-map "\eOw" [kp-7])
-(define-key function-key-map "\eOx" [kp-8])
-(define-key function-key-map "\eOy" [kp-9])
diff --git a/lisp/term/news.el b/lisp/term/news.el
deleted file mode 100644
index d0939db95ea..00000000000
--- a/lisp/term/news.el
+++ /dev/null
@@ -1,73 +0,0 @@
-;; news.el --- keypad and function key bindings for the Sony NEWS keyboard
-
-;; Copyright (C) 1989, 1993 Free Software Foundation, Inc.
-
-;; Author: FSF
-;; Keywords: terminals
-
-;; 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:
-
-;; Uses the Emacs 19 terminal initialization features --- won't work with 18.
-
-;;; Code:
-
-(if (boundp 'news-fkey-prefix)
-    nil
-  ;; The terminal initialization should already have set up some keys
-  (setq news-fkey-prefix (lookup-key function-key-map "\eO"))
-  (if (not (keymapp news-fkey-prefix))
-      (error "What?  Your news termcap/terminfo has no keycaps in it."))
-
-  ;; Termcap or terminfo will set these
-  ;; (define-key news-fkey-prefix "P" [f1])
-  ;; (define-key news-fkey-prefix "Q" [f2])
-  ;; (define-key news-fkey-prefix "R" [f3])
-  ;; (define-key news-fkey-prefix "S" [f4])
-  ;; (define-key news-fkey-prefix "T" [f5])
-  ;; (define-key news-fkey-prefix "U" [f6])
-  ;; (define-key news-fkey-prefix "V" [f7])
-  ;; (define-key news-fkey-prefix "W" [f8])
-  ;; (define-key news-fkey-prefix "X" [f9])
-  ;; (define-key news-fkey-prefix "Y" [f10])
-
-  ;; Terminfo will set these
-  (define-key news-fkey-prefix "a" [execute])
-  (define-key news-fkey-prefix "b" [select])
-  (define-key news-fkey-prefix "c" [cancel])
-  (define-key news-fkey-prefix "M" [kp-enter])
-  (define-key news-fkey-prefix "q" [kp-1])
-  (define-key news-fkey-prefix "s" [kp-3])
-  (define-key news-fkey-prefix "u" [kp-5])
-  (define-key news-fkey-prefix "w" [kp-7])
-  (define-key news-fkey-prefix "y" [kp-9])
-
-  ;; These aren't in either termcap or terminfo's repertoire
-  (define-key news-fkey-prefix "m" [kp-subtract])
-  (define-key news-fkey-prefix "k" [kp-add])
-  (define-key news-fkey-prefix "l" [kp-separator])
-  (define-key news-fkey-prefix "n" [kp-decimal])
-  (define-key news-fkey-prefix "p" [kp-0])
-  (define-key news-fkey-prefix "r" [kp-2])
-  (define-key news-fkey-prefix "t" [kp-4])
-  (define-key news-fkey-prefix "v" [kp-6])
-  (define-key news-fkey-prefix "x" [kp-8])
-  )
-
-;;; news.el ends here
diff --git a/lisp/term/pc-win.el b/lisp/term/pc-win.el
deleted file mode 100644
index 50d101f9ef5..00000000000
--- a/lisp/term/pc-win.el
+++ /dev/null
@@ -1,329 +0,0 @@
-;; pc-win.el -- setup support for `PC windows' (whatever that is).
-
-;; Copyright (C) 1994, 1996 Free Software Foundation, Inc.
-
-;; Author: Morten Welinder <terra@diku.dk>
-;; 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.
-
-;;; Code:
-
-(load "term/internal" nil t)
-
-;; Color translation -- doesn't really need to be fast.
-;; Colors listed here do not include the "light-",
-;; "medium-" and "dark-" prefixes that are accounted for
-;; by `msdos-color-translate', which see below).
-
-(defvar msdos-color-aliases
-  '(("snow"		. "white")
-    ("ghost white"	. "white")
-    ("ghostwhite"	. "white")
-    ("white smoke"	. "white")
-    ("whitesmoke"	. "white")
-    ("gainsboro"	. "white")
-    ("floral white"	. "white")
-    ("floralwhite"	. "white")
-    ("old lace"		. "white")
-    ("oldlace"		. "white")
-    ("linen"		. "white")
-    ("antique white"	. "white")
-    ("antiquewhite"	. "white")
-    ("papaya whip"	. "white")
-    ("papayawhip"	. "white")
-    ("blanched almond"	. "white")
-    ("blanchedalmond"	. "white")
-    ("bisque"		. "white")
-    ("peach puff"	. "lightred")
-    ("peachpuff"	. "lightred")
-    ("navajo white"	. "lightred")
-    ("navajowhite"	. "lightred")
-    ("moccasin"		. "lightred")
-    ("cornsilk"		. "white")
-    ("ivory"		. "white")
-    ("lemon chiffon"	. "yellow")
-    ("lemonchiffon"	. "yellow")
-    ("seashell"		. "white")
-    ("honeydew"		. "white")
-    ("mint cream"	. "white")
-    ("mintcream"	. "white")
-    ("azure"		. "lightcyan")
-    ("alice blue"	. "lightcyan")
-    ("aliceblue"	. "lightcyan")
-    ("lavender"		. "lightcyan")
-    ("lavender blush"	. "lightcyan")
-    ("lavenderblush"	. "lightcyan")
-    ("misty rose"	. "lightred")
-    ("mistyrose"	. "lightred")
-    ("aquamarine" 	. "blue")
-    ("cadet blue"	. "blue")
-    ("cadetblue"	. "blue")
-    ("cornflower blue"	. "lightblue")
-    ("cornflowerblue"	. "lightblue")
-    ("midnight blue"	. "blue")
-    ("midnightblue"	. "blue")
-    ("navy blue"	. "cyan")
-    ("navyblue"		. "cyan")
-    ("navy"		. "cyan")
-    ("sky blue"		. "lightblue")
-    ("skyblue"		. "lightblue")
-    ("dodger blue"	. "blue")
-    ("dodgerblue"	. "blue")
-    ("powder blue"	. "lightblue")
-    ("powderblue"	. "lightblue")
-    ("slate blue"	. "cyan")
-    ("slateblue"	. "cyan")
-    ("steel blue"	. "blue")
-    ("steelblue"	. "blue")
-    ("coral"		. "lightred")
-    ("firebrick"	. "red")
-    ("gold"		. "yellow")
-    ("goldenrod"	. "yellow")
-    ("pale goldenrod"	. "yellow")
-    ("palegoldenrod"	. "yellow")
-    ("olive green"	. "lightgreen")
-    ("olivegreen"	. "lightgreen")
-    ("olive drab"	. "green")
-    ("olivedrab"	. "green")
-    ("forest green"	. "green")
-    ("forestgreen"	. "green")
-    ("lime green"	. "lightgreen")
-    ("limegreen"	. "lightgreen")
-    ("sea green"	. "lightcyan")
-    ("seagreen"		. "lightcyan")
-    ("spring green"	. "green")
-    ("springgreen"	. "green")
-    ("pale green"	. "lightgreen")
-    ("palegreen"	. "lightgreen")
-    ("lawn green"	. "lightgreen")
-    ("lawngreen"	. "lightgreen")
-    ("chartreuse"	. "yellow")
-    ("yellow green"	. "lightgreen")
-    ("yellowgreen"	. "lightgreen")
-    ("green yellow"	. "lightgreen")
-    ("greenyellow"	. "lightgreen")
-    ("slate grey"	. "lightgray")
-    ("slategrey"	. "lightgray")
-    ("slate gray"	. "lightgray")
-    ("slategray"	. "lightgray")
-    ("dim grey"		. "darkgray")
-    ("dimgrey"		. "darkgray")
-    ("dim gray"		. "darkgray")
-    ("dimgray"		. "darkgray")
-    ("light grey"	. "lightgray")
-    ("lightgrey"	. "lightgray")
-    ("light gray"	. "lightgray")
-    ("gray"		. "darkgray")
-    ("grey"		. "darkgray")
-    ("gray80"		. "darkgray")
-    ("gray50"		. "black")
-    ("gray90"		. "darkgray")
-    ("khaki"		. "green")
-    ("maroon"		. "red")
-    ("orange"		. "brown")
-    ("orchid"		. "brown")
-    ("saddle brown"	. "red")
-    ("saddlebrown"	. "red")
-    ("sienna"		. "red")
-    ("peru"		. "red")
-    ("pink"		. "lightred")
-    ("plum"		. "magenta")
-    ("indian red"	. "red")
-    ("indianred"	. "red")
-    ("violet red"	. "magenta")
-    ("violetred"	. "magenta")
-    ("orange red"	. "red")
-    ("orangered"	. "red")
-    ("salmon"		.  "lightred")
-    ("sienna"		. "lightred")
-    ("tan"		. "lightred")
-    ("thistle"		. "magenta")
-    ("turquoise"	. "lightgreen")
-    ("pale turquoise"	. "cyan")
-    ("paleturquoise"	. "cyan")
-    ("violet"		. "magenta")
-    ("blue violet"	. "lightmagenta")
-    ("blueviolet"	. "lightmagenta")
-    ("wheat"		. "white")
-    ("green yellow"	. "yellow")
-    ("greenyellow"	. "yellow")
-    ("purple"		. "magenta")
-    ("royalblue"	. "blue")
-    ("grey40"		. "darkgray")
-    ("rosybrown"	. "brown")
-    ("rosy brown"	. "brown")
-    ("beige"		. "brown"))
-  "List of alternate names for colors.")
-
-(defun msdos-color-translate (name)
-  (setq name (downcase name))
-  (let* ((len (length name))
-	 (val (- (length x-colors)
-		 (length (member name x-colors))))
-	 (try))
-    (if (or (< val 0) (>= val (length x-colors))) (setq val nil))
-    (or val
-	(and (setq try (cdr (assoc name msdos-color-aliases)))
-	     (msdos-color-translate try))
-	(and (> len 5)
-	     (string= "light" (substring name 0 5))
-	     (setq try (msdos-color-translate (substring name 5)))
-	     (logior try 8))
-	(and (> len 6)
-	     (string= "light " (substring name 0 6))
-	     (setq try (msdos-color-translate (substring name 6)))
-	     (logior try 8))
-	(and (> len 6)
-	     (string= "medium" (substring name 0 6))
-	     (msdos-color-translate (substring name 6)))
-	(and (> len 7)
-	     (string= "medium " (substring name 0 7))
-	     (msdos-color-translate (substring name 7)))
-	(and (> len 4)
-	     (string= "dark" (substring name 0 4))
-	     (msdos-color-translate (substring name 4)))
-	(and (> len 5)
-	     (string= "dark " (substring name 0 5))
-	     (msdos-color-translate (substring name 5))))))
-;; ---------------------------------------------------------------------------
-;; We want to delay setting frame parameters until the faces are setup
-(defvar default-frame-alist nil)
-(modify-frame-parameters terminal-frame default-frame-alist)
-
-(defun msdos-face-setup ()
-  (modify-frame-parameters terminal-frame default-frame-alist)
-
-  (set-face-foreground 'bold "yellow" terminal-frame)
-  (set-face-foreground 'italic "red" terminal-frame)
-  (set-face-foreground 'bold-italic "lightred" terminal-frame)
-  (set-face-foreground 'underline "white" terminal-frame)
-  (set-face-background 'region "green" terminal-frame)
-
-  (make-face 'msdos-menu-active-face)
-  (make-face 'msdos-menu-passive-face)
-  (make-face 'msdos-menu-select-face)
-  (set-face-foreground 'msdos-menu-active-face "white" terminal-frame)
-  (set-face-foreground 'msdos-menu-passive-face "lightgray" terminal-frame)
-  (set-face-background 'msdos-menu-active-face "blue" terminal-frame)
-  (set-face-background 'msdos-menu-passive-face "blue" terminal-frame)
-  (set-face-background 'msdos-menu-select-face "red" terminal-frame))
-
-;; We have only one font, so...
-(add-hook 'before-init-hook 'msdos-face-setup)
-
-;; We create frames as if we were a terminal, but with a twist.
-(defun make-msdos-frame (&optional parameters)
-  (let ((parms
-	 (append initial-frame-alist default-frame-alist parameters nil)))
-    (make-terminal-frame parms)))
-
-(setq frame-creation-function 'make-msdos-frame)
-
-;; ---------------------------------------------------------------------------
-;; More or less useful imitations of certain X-functions.  A lot of the
-;; values returned are questionable, but usually only the form of the
-;; returned value matters.  Also, by the way, recall that `ignore' is
-;; a useful function for returning 'nil regardless of argument.
-
-;; From src/xfns.c
-(defun x-display-color-p (&optional display) 't)
-(defun x-list-fonts (pattern &optional face frame) (list "default"))
-(defun x-color-defined-p (color) (numberp (msdos-color-translate color)))
-(defun x-display-pixel-width (&optional frame) (frame-width frame))
-(defun x-display-pixel-height (&optional frame) (frame-height frame))
-(defun x-display-planes (&optional frame) 4) ; 3 for background, actually
-(defun x-display-color-cells (&optional frame) 16) ; ???
-(defun x-server-max-request-size (&optional frame) 1000000) ; ???
-(defun x-server-vendor (&optional frame) t "GNU")
-(defun x-server-version (&optional frame) '(1 0 0))
-(defun x-display-screens (&optional frame) 1)
-(defun x-display-mm-height (&optional frame) 200) ; Guess the size of my
-(defun x-display-mm-width (&optional frame) 253)  ; monitor, MW...
-(defun x-display-backing-store (&optional frame) 'not-useful)
-(defun x-display-visual-class (&optional frame) 'static-color)
-(fset 'x-display-save-under 'ignore)
-(fset 'x-get-resource 'ignore)
-
-;; From lisp/term/x-win.el
-(setq x-display-name "pc")
-(setq split-window-keep-point t)
-(defvar x-colors '("black"
-		   "blue"
-		   "green"
-		   "cyan"
-		   "red"
-		   "magenta"
-		   "brown"
-		   "lightgray"
-		   "darkgray"
-		   "lightblue"
-		   "lightgreen"
-		   "lightcyan"
-		   "lightred"
-		   "lightmagenta"
-		   "yellow"
-		   "white")
-  "The list of colors available on a PC display under MS-DOS.")
-(defun x-defined-colors (&optional frame)
-  "Return a list of colors supported for a particular frame.
-The argument FRAME specifies which frame to try.
-The value may be different for frames on different X displays."
-  x-colors)
-;
-;; From lisp/select.el
-(defun x-get-selection (&rest rest) "")
-(fset 'x-set-selection 'ignore)
-
-;; From lisp/faces.el: we only have one font, so always return
-;; it, no matter which variety they've asked for.
-(defun x-frob-font-slant (font which)
-  font)
-
-;; From lisp/term/x-win.el: make iconify-or-deiconify-frame a no-op.
-(fset 'iconify-or-deiconify-frame 'ignore)
-
-;; From lisp/frame.el
-(fset 'set-default-font 'ignore)
-(fset 'set-mouse-color 'ignore)		; We cannot, I think.
-(fset 'set-cursor-color 'ignore)	; Hardware determined by char under.
-(fset 'set-border-color 'ignore)	; Not useful.
-;; ---------------------------------------------------------------------------
-;; Handle the X-like command line parameters "-fg" and "-bg"
-(defun msdos-handle-args (args)
-  (let ((rest nil))
-    (while args
-      (let ((this (car args)))
-	(setq args (cdr args))
-	(cond ((or (string= this "-fg") (string= this "-foreground"))
-	       (if args
-		   (setq default-frame-alist
-			 (cons (cons 'foreground-color (car args))
-			       default-frame-alist)
-			 args (cdr args))))
-	      ((or (string= this "-bg") (string= this "-background"))
-	       (if args
-		   (setq default-frame-alist
-			 (cons (cons 'background-color (car args))
-			       default-frame-alist)
-			 args (cdr args))))
-	      (t (setq rest (cons this rest))))))
-    (nreverse rest)))
-
-(setq command-line-args (msdos-handle-args command-line-args))
-;; ---------------------------------------------------------------------------
diff --git a/lisp/term/sun-mouse.el b/lisp/term/sun-mouse.el
deleted file mode 100644
index 7287b59c191..00000000000
--- a/lisp/term/sun-mouse.el
+++ /dev/null
@@ -1,681 +0,0 @@
-;;; sun-mouse.el --- mouse handling for Sun windows
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Jeff Peck
-;; Maintainer: FSF
-;; Keywords: hardware
-
-;; 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:
-
-;; Jeff Peck, Sun Microsystems, Jan 1987.
-;; Original idea by Stan Jefferson
-
-;;     Modeled after the GNUEMACS keymap interface.
-;;
-;; User Functions:
-;;   make-mousemap, copy-mousemap, 
-;;   define-mouse, global-set-mouse, local-set-mouse,
-;;   use-global-mousemap, use-local-mousemap,
-;;   mouse-lookup, describe-mouse-bindings
-;;
-;; Options:
-;;   extra-click-wait, scrollbar-width
-
-;;; Code:
-
-(defvar extra-click-wait 150
-  "*Number of milliseconds to wait for an extra click.
-Set this to zero if you don't want chords or double clicks.")
-
-(defvar scrollbar-width 5
-  "*The character width of the scrollbar.
-The cursor is deemed to be in the right edge scrollbar if it is this near the
-right edge, and more than two chars past the end of the indicated line.
-Setting to nil limits the scrollbar to the edge or vertical dividing bar.")
-
-;;;
-;;; Mousemaps
-;;;
-(defun make-mousemap ()
-  "Returns a new mousemap."
-  (cons 'mousemap nil))
-
-(defun copy-mousemap (mousemap)
-  "Return a copy of mousemap."
-  (copy-alist mousemap))
-
-(defun define-mouse (mousemap mouse-list def)
-  "Args MOUSEMAP, MOUSE-LIST, DEF.  Define MOUSE-LIST in MOUSEMAP as DEF.
-MOUSE-LIST is a list of atoms specifying a mouse hit according to these rules:
-  * One of these atoms specifies the active region of the definition.
-	text, scrollbar, modeline, minibuffer
-  * One or two or these atoms specify the button or button combination.
-        left, middle, right, double
-  * Any combination of these atoms specify the active shift keys.
-        control, shift, meta
-  * With a single unshifted button, you can add
-	up
-    to indicate an up-click.
-The atom `double' is used with a button designator to denote a double click.
-Two button chords are denoted by listing the two buttons.
-See sun-mouse-handler for the treatment of the form DEF."
-  (mousemap-set (mouse-list-to-mouse-code mouse-list) mousemap def))
-
-(defun global-set-mouse (mouse-list def)
-  "Give MOUSE-EVENT-LIST a local definition of DEF.
-See define-mouse for a description of MOUSE-EVENT-LIST and DEF.
-Note that if MOUSE-EVENT-LIST has a local definition in the current buffer,
-that local definition will continue to shadow any global definition."
-  (interactive "xMouse event: \nxDefinition: ")
-  (define-mouse current-global-mousemap mouse-list def))
-
-(defun local-set-mouse (mouse-list def)
-  "Give MOUSE-EVENT-LIST a local definition of DEF.
-See define-mouse for a description of the arguments.
-The definition goes in the current buffer's local mousemap.
-Normally buffers in the same major mode share a local mousemap."
-  (interactive "xMouse event: \nxDefinition: ")
-  (if (null current-local-mousemap)
-      (setq current-local-mousemap (make-mousemap)))
-  (define-mouse current-local-mousemap mouse-list def))
-
-(defun use-global-mousemap (mousemap)
-  "Selects MOUSEMAP as the global mousemap."
-  (setq current-global-mousemap mousemap))
-
-(defun use-local-mousemap (mousemap)
-  "Selects MOUSEMAP as the local mousemap.
-nil for MOUSEMAP means no local mousemap."
-  (setq current-local-mousemap mousemap))
-
-
-;;;
-;;; Interface to the Mouse encoding defined in Emacstool.c
-;;;
-;;; Called when mouse-prefix is sent to emacs, additional
-;;; information is read in as a list (button x y time-delta)
-;;;
-;;; First, some generally useful functions:
-;;;
-
-(defun logtest (x y)
-  "True if any bits set in X are also set in Y.
-Just like the Common Lisp function of the same name."
-  (not (zerop (logand x y))))
-
-
-;;;
-;;; Hit accessors.
-;;;
-
-(defconst sm::ButtonBits 7)		; Lowest 3 bits.
-(defconst sm::ShiftmaskBits 56)		; Second lowest 3 bits (56 = 63 - 7).
-(defconst sm::DoubleBits 64)		; Bit 7.
-(defconst sm::UpBits 128)		; Bit 8.
-
-;;; All the useful code bits
-(defmacro sm::hit-code (hit)
-  (` (nth 0 (, hit))))
-;;; The button, or buttons if a chord.
-(defmacro sm::hit-button (hit)
-  (` (logand sm::ButtonBits (nth 0 (, hit)))))
-;;; The shift, control, and meta flags.
-(defmacro sm::hit-shiftmask (hit)
-  (` (logand sm::ShiftmaskBits (nth 0 (, hit)))))
-;;; Set if a double click (but not a chord).
-(defmacro sm::hit-double (hit)
-  (` (logand sm::DoubleBits (nth 0 (, hit)))))
-;;; Set on button release (as opposed to button press).
-(defmacro sm::hit-up (hit)
-  (` (logand sm::UpBits (nth 0 (, hit)))))
-;;; Screen x position.
-(defmacro sm::hit-x (hit) (list 'nth 1 hit))
-;;; Screen y position.
-(defmacro sm::hit-y (hit) (list 'nth 2 hit))
-;;; Milliseconds since last hit.
-(defmacro sm::hit-delta (hit) (list 'nth 3 hit))
-
-(defmacro sm::hit-up-p (hit)		; A predicate.
-  (` (not (zerop (sm::hit-up (, hit))))))
-
-;;;
-;;; Loc accessors.  for sm::window-xy
-;;;
-(defmacro sm::loc-w (loc) (list 'nth 0 loc))
-(defmacro sm::loc-x (loc) (list 'nth 1 loc))
-(defmacro sm::loc-y (loc) (list 'nth 2 loc))
-
-(defmacro eval-in-buffer (buffer &rest forms)
-  "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer."
-  ;; When you don't need the complete window context of eval-in-window
-  (` (let ((StartBuffer (current-buffer)))
-    (unwind-protect
-	(progn
-	  (set-buffer (, buffer))
-	  (,@ forms))
-    (set-buffer StartBuffer)))))
-
-(put 'eval-in-buffer 'lisp-indent-function 1)
-
-;;; this is used extensively by sun-fns.el
-;;;
-(defmacro eval-in-window (window &rest forms)
-  "Switch to WINDOW, evaluate FORMS, return to original window."
-  (` (let ((OriginallySelectedWindow (selected-window)))
-       (unwind-protect
-	   (progn
-	     (select-window (, window))
-	     (,@ forms))
-	 (select-window OriginallySelectedWindow)))))
-(put 'eval-in-window 'lisp-indent-function 1)
-
-;;;
-;;; handy utility, generalizes window_loop
-;;;
-
-;;; It's a macro (and does not evaluate its arguments).
-(defmacro eval-in-windows (form &optional yesmini)
-  "Switches to each window and evaluates FORM.  Optional argument
-YESMINI says to include the minibuffer as a window.
-This is a macro, and does not evaluate its arguments."
-  (` (let ((OriginallySelectedWindow (selected-window)))
-       (unwind-protect 
-	   (while (progn
-		    (, form)
-		    (not (eq OriginallySelectedWindow
-			     (select-window
-			      (next-window nil (, yesmini)))))))
-	 (select-window OriginallySelectedWindow)))))
-(put 'eval-in-window 'lisp-indent-function 0)
-
-(defun move-to-loc (x y)
-  "Move cursor to window location X, Y.
-Handles wrapped and horizontally scrolled lines correctly."
-  (move-to-window-line y)
-  ;; window-line-end expects this to return the window column it moved to.
-  (let ((cc (current-column))
-	(nc (move-to-column
-	     (if (zerop (window-hscroll))
-		 (+ (current-column)
-		    (min (- (window-width) 2)	; To stay on the line.
-			 x))
-	       (+ (window-hscroll) -1
-		  (min (1- (window-width))	; To stay on the line.
-		       x))))))
-    (- nc cc)))
-
-
-(defun minibuffer-window-p (window)
-  "True iff this WINDOW is minibuffer."
-  (= (frame-height)
-     (nth 3 (window-edges window))	; The bottom edge.
-     ))
-
-
-(defun sun-mouse-handler (&optional hit)
-  "Evaluates the function or list associated with a mouse hit.
-Expecting to read a hit, which is a list: (button x y delta).  
-A form bound to button by define-mouse is found by mouse-lookup. 
-The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound.  
-If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*,
-*mouse-x*, and *mouse-y* as arguments; if the form is a list (listp),
-the form is eval'ed; if the form is neither of these, it is an error.
-Returns nil."
-  (interactive)
-  (if (null hit) (setq hit (sm::combined-hits)))
-  (let ((loc (sm::window-xy (sm::hit-x hit) (sm::hit-y hit))))
-    (let ((*mouse-window* (sm::loc-w loc))
-	  (*mouse-x* (sm::loc-x loc))
-	  (*mouse-y* (sm::loc-y loc))
-	  (mouse-code (mouse-event-code hit loc)))
-      (let ((form (eval-in-buffer (window-buffer *mouse-window*)
-		    (mouse-lookup mouse-code))))
-	(cond ((null form)
-	       (if (not (sm::hit-up-p hit))	; undefined up hits are ok.
-		   (error "Undefined mouse event: %s" 
-			  (prin1-to-string 
-			   (mouse-code-to-mouse-list mouse-code)))))
-	      ((symbolp form)
-	       (setq this-command form)
-	       (funcall form *mouse-window* *mouse-x* *mouse-y*))
-	      ((listp form)
-	       (setq this-command (car form))
-	       (eval form))
-	      (t
-	       (error "Mouse action must be symbol or list, but was: %s"
-		      form))))))
-  ;; Don't let 'sun-mouse-handler get on last-command,
-  ;; since this function should be transparent.
-  (if (eq this-command 'sun-mouse-handler)
-      (setq this-command last-command))
-  ;; (message (prin1-to-string this-command))	; to see what your buttons did
-  nil)
-
-(defun sm::combined-hits ()
-  "Read and return next mouse-hit, include possible double click"
-  (let ((hit1 (mouse-hit-read)))
-    (if (not (sm::hit-up-p hit1))      ; Up hits don't start doubles or chords.
-	(let ((hit2 (mouse-second-hit extra-click-wait)))
-	  (if hit2	; we cons'd it, we can smash it.
-	      ; (setf (sm::hit-code hit1) (logior (sm::hit-code hit1) ...))
-	      (setcar hit1 (logior (sm::hit-code hit1) 
-				   (sm::hit-code hit2)
-				   (if (= (sm::hit-button hit1) 
-					  (sm::hit-button hit2))
-				       sm::DoubleBits 0))))))
-    hit1))
-
-(defun mouse-hit-read ()
-  "Read mouse-hit list from keyboard.  Like (read 'read-char),
-but that uses minibuffer, and mucks up last-command."
-  (let ((char-list nil) (char nil))
-    (while (not (equal 13		; Carriage return.
-		       (prog1 (setq char (read-char)) 
-			 (setq char-list (cons char char-list))))))
-    (read (mapconcat 'char-to-string (nreverse char-list) ""))
-    ))
-
-;;; Second Click Hackery....
-;;; if prefix is not mouse-prefix, need a way to unread the char...
-;;; or else have mouse flush input queue, or else need a peek at next char.
-
-;;; There is no peek, but since one character can be unread, we only
-;;; have to flush the queue when the command after a mouse click
-;;; starts with mouse-prefix1 (see below).
-;;;   Something to do later:  We could buffer the read commands and
-;;; execute them ourselves after doing the mouse command (using
-;;; lookup-key ??).
-
-(defvar mouse-prefix1 24		; C-x
-  "First char of mouse-prefix.  Used to detect double clicks and chords.")
-
-(defvar mouse-prefix2 0			; C-@
-  "Second char of mouse-prefix.  Used to detect double clicks and chords.")
-
-
-(defun mouse-second-hit (hit-wait)
-  "Returns the next mouse hit occurring within HIT-WAIT milliseconds."
-  (if (sit-for-millisecs hit-wait) nil	; No input within hit-wait millisecs.
-    (let ((pc1 (read-char)))
-      (if (or (not (equal pc1 mouse-prefix1))
-	      (sit-for-millisecs 3))	; a mouse prefix will have second char
-	  ;; Can get away with one unread.
-	  (progn (setq unread-command-events (list pc1))
-		 nil)			; Next input not mouse event.
-	(let ((pc2 (read-char)))
-	  (if (not (equal pc2 mouse-prefix2))
-	      (progn (setq unread-command-events (list pc1)) ; put back the ^X
-;;; Too bad can't do two: (setq unread-command-event (list pc1 pc2))
-;;; Well, now we can, but I don't understand this code well enough to fix it...
-		(ding)			; user will have to retype that pc2.
-		nil)			; This input is not a mouse event.
-	    ;; Next input has mouse prefix and is within time limit.
-	    (let ((new-hit (mouse-hit-read))) ; Read the new hit.
-		(if (sm::hit-up-p new-hit)	; Ignore up events when timing.
-		    (mouse-second-hit (- hit-wait (sm::hit-delta new-hit)))
-		  new-hit		; New down hit within limit, return it.
-		  ))))))))
-
-(defun sm::window-xy (x y)
-  "Find window containing screen coordinates X and Y.
-Returns list (window x y) where x and y are relative to window."
-  (or
-   (catch 'found
-     (eval-in-windows 
-      (let ((we (window-edges (selected-window))))
-	(let ((le (nth 0 we))
-	      (te (nth 1 we))
-	      (re (nth 2 we))
-	      (be (nth 3 we)))
-	  (if (= re (frame-width))
-	      ;; include the continuation column with this window
-	      (setq re (1+ re)))
-	  (if (= be (frame-height))
-	      ;; include partial line at bottom of frame with this window
-	      ;; id est, if window is not multiple of char size.
-	      (setq be (1+ be)))
-
-	  (if (and (>= x le) (< x re)
-		   (>= y te) (< y be))
-	      (throw 'found 
-		     (list (selected-window) (- x le) (- y te))))))
-      t))				; include minibuffer in eval-in-windows
-   ;;If x,y from a real mouse click, we shouldn't get here.
-   (list nil x y)
-   ))
-
-(defun sm::window-region (loc)
-  "Parse LOC into a region symbol.
-Returns one of (text scrollbar modeline minibuffer)"
-  (let ((w (sm::loc-w loc))
-	(x (sm::loc-x loc))
-	(y (sm::loc-y loc)))
-    (let ((right (1- (window-width w)))
-	  (bottom (1- (window-height w))))
-      (cond ((minibuffer-window-p w) 'minibuffer)
-	    ((>= y bottom) 'modeline)
-	    ((>= x right) 'scrollbar)
-	    ;; far right column (window separator) is always a scrollbar
-	    ((and scrollbar-width
-		  ;; mouse within scrollbar-width of edge.
-		  (>= x (- right scrollbar-width))
-		  ;; mouse a few chars past the end of line.
-		  (>= x (+ 2 (window-line-end w x y))))
-	     'scrollbar)
-	    (t 'text)))))
-
-(defun window-line-end (w x y)
-  "Return WINDOW column (ignore X) containing end of line Y"
-  (eval-in-window w (save-excursion (move-to-loc (frame-width) y))))
-
-;;;
-;;; The encoding of mouse events into a mousemap.
-;;; These values must agree with coding in emacstool:
-;;;
-(defconst sm::keyword-alist 
-  '((left . 1) (middle . 2) (right . 4)
-    (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128)
-    (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048)
-    ))
-
-(defun mouse-event-code (hit loc)
-  "Maps MOUSE-HIT and LOC into a mouse-code."
-;;;Region is a code for one of text, modeline, scrollbar, or minibuffer.
-  (logior (sm::hit-code hit)
-	  (mouse-region-to-code (sm::window-region loc))))
-
-(defun mouse-region-to-code (region)
-  "Returns partial mouse-code for specified REGION."
-  (cdr (assq region sm::keyword-alist)))
-
-(defun mouse-list-to-mouse-code (mouse-list)
-  "Map a MOUSE-LIST to a mouse-code."
-  (apply 'logior
-	 (mapcar (function (lambda (x)
-			     (cdr (assq x sm::keyword-alist))))
-		  mouse-list)))
-
-(defun mouse-code-to-mouse-list (mouse-code)
-  "Map a MOUSE-CODE to a mouse-list."
-  (apply 'nconc (mapcar
-		 (function (lambda (x)
-			     (if (logtest mouse-code (cdr x))
-				 (list (car x)))))
-		 sm::keyword-alist)))
-
-(defun mousemap-set (code mousemap value)
-  (let* ((alist (cdr mousemap))
-	 (assq-result (assq code alist)))
-    (if assq-result
-	(setcdr assq-result value)
-      (setcdr mousemap (cons (cons code value) alist)))))
-
-(defun mousemap-get (code mousemap)
-  (cdr (assq code (cdr mousemap))))
-
-(defun mouse-lookup (mouse-code)
-  "Look up MOUSE-EVENT and return the definition. nil means undefined."
-  (or (mousemap-get mouse-code current-local-mousemap)
-      (mousemap-get mouse-code current-global-mousemap)))
-
-;;;
-;;; I (jpeck) don't understand the utility of the next four functions
-;;; ask Steven Greenbaum <froud@kestrel>
-;;;
-(defun mouse-mask-lookup (mask list)
-  "Args MASK (a bit mask) and LIST (a list of (code . form) pairs).
-Returns a list of elements of LIST whose code or'ed with MASK is non-zero."
-  (let ((result nil))
-    (while list
-      (if (logtest mask (car (car list)))
-	  (setq result (cons (car list) result)))
-      (setq list (cdr list)))
-    result))
-
-(defun mouse-union (l l-unique)
-  "Return the union of list of mouse (code . form) pairs L and L-UNIQUE,
-where L-UNIQUE is considered to be union'ized already."
-  (let ((result l-unique))
-    (while l
-      (let ((code-form-pair (car l)))
-	(if (not (assq (car code-form-pair) result))
-	    (setq result (cons code-form-pair result))))
-      (setq l (cdr l)))
-    result))
-
-(defun mouse-union-first-preferred (l1 l2)
-  "Return the union of lists of mouse (code . form) pairs L1 and L2,
-based on the code's, with preference going to elements in L1."
-  (mouse-union l2 (mouse-union l1 nil)))
-
-(defun mouse-code-function-pairs-of-region (region)
-  "Return a list of (code . function) pairs, where each code is
-currently set in the REGION."
-  (let ((mask (mouse-region-to-code region)))
-    (mouse-union-first-preferred
-     (mouse-mask-lookup mask (cdr current-local-mousemap))
-     (mouse-mask-lookup mask (cdr current-global-mousemap))
-     )))
-
-;;;
-;;; Functions for DESCRIBE-MOUSE-BINDINGS
-;;; And other mouse documentation functions
-;;; Still need a good procedure to print out a help sheet in readable format.
-;;;
-
-(defun one-line-doc-string (function)
-  "Returns first line of documentation string for FUNCTION.
-If there is no documentation string, then the string
-\"No documentation\" is returned."
-  (while (consp function) (setq function (car function)))
-  (let ((doc (documentation function)))
-    (if (null doc)
-	"No documentation."
-      (string-match "^.*$" doc)
-      (substring doc 0 (match-end 0)))))
-
-(defun print-mouse-format (binding)
-  (princ (car binding))
-  (princ ": ")
-  (mapcar (function
-	   (lambda (mouse-list)
-	     (princ mouse-list)
-	     (princ " ")))
-	  (cdr binding))
-  (terpri)
-  (princ "  ")
-  (princ (one-line-doc-string (car binding)))
-  (terpri)
-  )
-
-(defun print-mouse-bindings (region)
-  "Prints mouse-event bindings for REGION."
-  (mapcar 'print-mouse-format (sm::event-bindings region)))
-
-(defun sm::event-bindings (region)
-  "Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION,
-where each mouse-list is bound to the function in REGION."
-  (let ((mouse-bindings (mouse-code-function-pairs-of-region region))
-	(result nil))
-    (while mouse-bindings
-      (let* ((code-function-pair (car mouse-bindings))
-	     (current-entry (assoc (cdr code-function-pair) result)))
-	(if current-entry
-	    (setcdr current-entry
-		    (cons (mouse-code-to-mouse-list (car code-function-pair))
-			  (cdr current-entry)))
-	  (setq result (cons (cons (cdr code-function-pair)
-				   (list (mouse-code-to-mouse-list
-					  (car code-function-pair))))
-			     result))))
-      (setq mouse-bindings (cdr mouse-bindings))
-      )
-    result))
-
-(defun describe-mouse-bindings ()
-  "Lists all current mouse-event bindings."
-  (interactive)
-  (with-output-to-temp-buffer "*Help*"
-    (princ "Text Region") (terpri)
-    (princ "---- ------") (terpri)
-    (print-mouse-bindings 'text) (terpri)
-    (princ "Modeline Region") (terpri)
-    (princ "-------- ------") (terpri)
-    (print-mouse-bindings 'modeline) (terpri)
-    (princ "Scrollbar Region") (terpri)
-    (princ "--------- ------") (terpri)
-    (print-mouse-bindings 'scrollbar)))
-
-(defun describe-mouse-briefly (mouse-list)
-  "Print a short description of the function bound to MOUSE-LIST."
-  (interactive "xDescribe mouse list briefly: ")
-  (let ((function (mouse-lookup (mouse-list-to-mouse-code mouse-list))))
-    (if function
-	(message "%s runs the command %s" mouse-list function)
-      (message "%s is undefined" mouse-list))))
-
-(defun mouse-help-menu (function-and-binding)
-  (cons (prin1-to-string (car function-and-binding))
-	(menu-create	; Two sub-menu items of form ("String" . nil)
-	 (list (list (one-line-doc-string (car function-and-binding)))
-	       (list (prin1-to-string (cdr function-and-binding)))))))
-
-(defun mouse-help-region (w x y &optional region)
-  "Displays a menu of mouse functions callable in this region."
-  (let* ((region (or region (sm::window-region (list w x y))))
-	 (mlist (mapcar (function mouse-help-menu)
-			(sm::event-bindings region)))
-	 (menu (menu-create (cons (list (symbol-name region)) mlist)))
-	 (item (sun-menu-evaluate w 0 y menu))
-	 )))
-
-;;;
-;;; Menu interface functions
-;;;
-;;; use defmenu, because this interface is subject to change
-;;; really need a menu-p, but we use vectorp and the context...
-;;;
-(defun menu-create (items)
-  "Functional form for defmenu, given a list of ITEMS returns a menu.
-Each ITEM is a (STRING . VALUE) pair."
-  (apply 'vector items)
-  )
-
-(defmacro defmenu (menu &rest itemlist)
-  "Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs.
-See sun-menu-evaluate for interpretation of ITEMS."
-  (list 'defconst menu (funcall 'menu-create itemlist))
-  )
-
-(defun sun-menu-evaluate (*menu-window* *menu-x* *menu-y* menu)
-  "Display a pop-up menu in WINDOW at X Y and evaluate selected item
-of MENU.  MENU (or its symbol-value) should be a menu defined by defmenu.
-  A menu ITEM is a (STRING . FORM) pair;
-the FORM associated with the selected STRING is evaluated,
-and the resulting value is returned.  Generally these FORMs are
-evaluated for their side-effects rather than their values.
-  If the selected form is a menu or a symbol whose value is a menu, 
-then it is displayed and evaluated as a pullright menu item.
-  If the the FORM of the first ITEM is nil, the STRING of the item
-is used as a label for the menu, i.e. it's inverted and not selectable."
-
-  (if (symbolp menu) (setq menu (symbol-value menu)))
-  (eval (sun-menu-internal *menu-window* *menu-x* *menu-y* 4 menu)))
-
-(defun sun-get-frame-data (code)
-  "Sends the tty-sub-window escape sequence CODE to terminal,
-and returns a cons of the two numbers in returned escape sequence.
-That is it returns (cons <car> <cdr>) from \"\\E[n;<car>;<cdr>t\". 
-CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars."
-  (send-string-to-terminal (concat "\033[" (int-to-string code) "t"))
-  (let (char str x y)
-    (while (not (equal 116 (setq char (read-char)))) ; #\t = 116
-      (setq str (cons char str)))
-    (setq str (mapconcat 'char-to-string (nreverse str) ""))
-    (string-match ";[0-9]*" str)
-    (setq y (substring str (1+ (match-beginning 0)) (match-end 0)))
-    (setq str (substring str (match-end 0)))
-    (string-match ";[0-9]*" str)
-    (setq x (substring str (1+ (match-beginning 0)) (match-end 0)))
-    (cons (string-to-int y) (string-to-int x))))
-
-(defun sm::font-size ()
-  "Returns font size in pixels: (cons Ysize Xsize)"
-  (let ((pix (sun-get-frame-data 14))	; returns size in pixels
-	(chr (sun-get-frame-data 18)))	; returns size in chars
-    (cons (/ (car pix) (car chr)) (/ (cdr pix) (cdr chr)))))
-
-(defvar sm::menu-kludge-x nil 
-  "Cached frame-to-window X-Offset for sm::menu-kludge")
-(defvar sm::menu-kludge-y nil 
-  "Cached frame-to-window Y-Offset for sm::menu-kludge")
-
-(defun sm::menu-kludge ()
-  "If sunfns.c uses <Menu_Base_Kludge> this function must be here!"
-  (or sm::menu-kludge-y
-      (let ((fs (sm::font-size)))
-	(setq sm::menu-kludge-y (+ 8 (car fs))	; a title line and borders
-	      sm::menu-kludge-x 4)))	; best values depend on .defaults/Menu
-  (let ((wl (sun-get-frame-data 13)))		; returns frame location
-    (cons (+ (car wl) sm::menu-kludge-y)
-	  (+ (cdr wl) sm::menu-kludge-x))))
-
-;;;
-;;;  Function interface to selection/region
-;;;  primitive functions are defined in sunfns.c
-;;;
-(defun sun-yank-selection ()
-  "Set mark and yank the contents of the current sunwindows selection.
-Insert contents into the current buffer at point."
-  (interactive "*")
-  (set-mark-command nil)
-  (insert-string (sun-get-selection)))
-
-(defun sun-select-region (beg end)
-  "Set the sunwindows selection to the region in the current buffer."
-  (interactive "r")
-  (sun-set-selection (buffer-substring beg end)))
-
-;;;
-;;; Support for emacstool
-;;; This closes the window instead of stopping emacs.
-;;;
-(defun suspend-emacstool (&optional stuffstring)
-  "Suspend emacstool.
-If running under as a detached process emacstool,
-you don't want to suspend  (there is no way to resume), 
-just close the window, and wait for reopening."
-  (interactive)
-  (run-hooks 'suspend-hook)
-  (if stuffstring (send-string-to-terminal stuffstring))
-  (send-string-to-terminal "\033[2t")	; To close EmacsTool window.
-  (run-hooks 'suspend-resume-hook))
-;;;
-;;; initialize mouse maps
-;;;
-
-(make-variable-buffer-local 'current-local-mousemap)
-(setq-default current-local-mousemap nil)
-(defvar current-global-mousemap (make-mousemap))
-
-(provide 'sun-mouse)
-
-;;; sun-mouse.el ends here
diff --git a/lisp/term/sun.el b/lisp/term/sun.el
deleted file mode 100644
index 4d75e524f4e..00000000000
--- a/lisp/term/sun.el
+++ /dev/null
@@ -1,280 +0,0 @@
-;; sun.el --- keybinding for standard default sunterm keys
-
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-
-;; Author: Jeff Peck <peck@sun.com>
-;; Keywords: terminals
-
-;; 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:
-
-;; The function key sequences for the console have been converted for
-;; use with function-key-map, but the *tool stuff hasn't been touched.
-
-;;; Code:
-
-(defun ignore-key ()
-  "interactive version of ignore"
-  (interactive)
-  (ignore))
-
-(defun scroll-down-in-place (n)
-  (interactive "p")
-  (previous-line n)
-  (scroll-down n))
-
-(defun scroll-up-in-place (n)
-  (interactive "p")
-  (next-line n)
-  (scroll-up n))
-
-(defun kill-region-and-unmark (beg end)
-  "Like kill-region, but pops the mark [which equals point, anyway.]"
-  (interactive "r")
-  (kill-region beg end)
-  (setq this-command 'kill-region-and-unmark)
-  (set-mark-command t))
-
-(defun select-previous-complex-command ()
-  "Select Previous-complex-command"
-  (interactive)
-  (if (zerop (minibuffer-depth))
-      (repeat-complex-command 1)
-    (previous-complex-command 1)))
-
-(defun rerun-prev-command ()
-  "Repeat Previous-complex-command."
-  (interactive)
-  (eval (nth 0 command-history)))
-
-(defvar grep-arg nil "Default arg for RE-search")
-(defun grep-arg ()
-  (if (memq last-command '(research-forward research-backward)) grep-arg
-    (let* ((command (car command-history))
-	   (command-name (symbol-name (car command)))
-	   (search-arg (car (cdr command)))
-	   (search-command 
-	    (and command-name (string-match "search" command-name)))
-	   )
-      (if (and search-command (stringp search-arg)) (setq grep-arg search-arg)
-	(setq search-command this-command 
-	      grep-arg (read-string "REsearch: " grep-arg)
-	      this-command search-command)
-	grep-arg))))
-
-(defun research-forward ()
-  "Repeat RE search forward."
-  (interactive)
-  (re-search-forward (grep-arg)))
-
-(defun research-backward ()
-  "Repeat RE search backward."
-  (interactive)
-  (re-search-backward (grep-arg)))
-
-;;;
-;;; handle sun's extra function keys
-;;; this version for those who run with standard .ttyswrc and no emacstool
-;;;
-;;; sunview picks up expose and open on the way UP, 
-;;; so we ignore them on the way down
-;;;
-
-(defvar sun-esc-bracket nil
-  "*If non-nil, rebind ESC [ as prefix for Sun function keys.")
-
-(defvar sun-raw-prefix (make-sparse-keymap))
-(define-key function-key-map "\e[" sun-raw-prefix)
-
-(define-key sun-raw-prefix "210z" [r3])
-(define-key sun-raw-prefix "213z" [r6])
-(define-key sun-raw-prefix "214z" [r7])
-(define-key sun-raw-prefix "216z" [r9])
-(define-key sun-raw-prefix "218z" [r11])
-(define-key sun-raw-prefix "220z" [r13])
-(define-key sun-raw-prefix "222z" [r15])
-(define-key sun-raw-prefix "193z" [redo])
-(define-key sun-raw-prefix "194z" [props])
-(define-key sun-raw-prefix "195z" [undo])
-; (define-key sun-raw-prefix "196z" 'ignore-key)		; Expose-down
-; (define-key sun-raw-prefix "197z" [put])
-; (define-key sun-raw-prefix "198z" 'ignore-key)		; Open-down
-; (define-key sun-raw-prefix "199z" [get])
-(define-key sun-raw-prefix "200z" [find])
-; (define-key sun-raw-prefix "201z" 'kill-region-and-unmark)	; Delete
-(define-key sun-raw-prefix "226z" [t3])
-(define-key sun-raw-prefix "227z" [t4])
-(define-key sun-raw-prefix "229z" [t6])
-(define-key sun-raw-prefix "230z" [t7])
-(define-key sun-raw-prefix "A" [up])			; R8
-(define-key sun-raw-prefix "B" [down])			; R14
-(define-key sun-raw-prefix "C" [right])			; R12
-(define-key sun-raw-prefix "D" [left])			; R10
-
-(global-set-key [r3]	'backward-page)
-(global-set-key [r6]	'forward-page)
-(global-set-key [r7]	'beginning-of-buffer)
-(global-set-key [r9]	'scroll-down)
-(global-set-key [r11]	'recenter)
-(global-set-key [r13]	'end-of-buffer)
-(global-set-key [r15]	'scroll-up)
-(global-set-key [redo]	'redraw-display)
-(global-set-key [props]	'list-buffers)
-(global-set-key [undo]	'undo)
-(global-set-key [put]	'sun-select-region)
-(global-set-key [get]	'sun-yank-selection)
-(global-set-key [find]	'exchange-point-and-mark)
-(global-set-key [t3]	'scroll-down-in-place)
-(global-set-key [t4]	'scroll-up-in-place)
-(global-set-key [t6]	'shrink-window)
-(global-set-key [t7]	'enlarge-window)
-
-
-(if sun-esc-bracket (global-unset-key "\e["))
-
-;;; Since .emacs gets loaded before this file, a hook is supplied
-;;; for you to put your own bindings in.
-
-(defvar sun-raw-prefix-hooks nil
-  "List of forms to evaluate after setting sun-raw-prefix.")
-
-(let ((hooks sun-raw-prefix-hooks))
-  (while hooks
-    (eval (car hooks))
-    (setq hooks (cdr hooks))
-    ))
-
-
-;;; This section adds definitions for the emacstool users
-;;; emacstool event filter converts function keys to C-x*{c}{lrt}
-;;;
-;;; for example the Open key (L7) would be encoded as "\C-x*gl"
-;;; the control, meta, and shift keys modify the character {lrt}
-;;; note that (unshifted) C-l is ",",  C-r is "2", and C-t is "4"
-;;;
-;;; {c} is [a-j] for LEFT, [a-i] for TOP, [a-o] for RIGHT.
-;;; A higher level insists on encoding {h,j,l,n}{r} (the arrow keys)
-;;; as ANSI escape sequences.  Use the shell command 
-;;; % setkeys noarrows
-;;; if you want these to come through for emacstool.
-;;;
-;;; If you are not using EmacsTool, 
-;;; you can also use this by creating a .ttyswrc file to do the conversion.
-;;; but it won't include the CONTROL, META, or SHIFT keys!
-;;;
-;;; Important to define SHIFTed sequence before matching unshifted sequence.
-;;; (talk about bletcherous old uppercase terminal conventions!*$#@&%*&#$%)
-;;;  this is worse than C-S/C-Q flow control anyday!
-;;;  Do *YOU* run in capslock mode?
-;;;
-
-;;; Note:  al, el and gl are trapped by EmacsTool, so they never make it here.
-
-(defvar meta-flag t)
-
-(defvar suntool-map (make-sparse-keymap)
-  "*Keymap for Emacstool bindings.")
-
-(define-key suntool-map "gr" 'beginning-of-buffer)	; r7
-(define-key suntool-map "iR" 'backward-page)		; R9
-(define-key suntool-map "ir" 'scroll-down)		; r9
-(define-key suntool-map "kr" 'recenter)			; r11
-(define-key suntool-map "mr" 'end-of-buffer)		; r13
-(define-key suntool-map "oR" 'forward-page)		; R15
-(define-key suntool-map "or" 'scroll-up)		; r15
-(define-key suntool-map "b\M-L" 'rerun-prev-command)	; M-AGAIN
-(define-key suntool-map "b\M-l" 'prev-complex-command)	; M-Again
-(define-key suntool-map "bl" 'redraw-display)		; Again
-(define-key suntool-map "cl" 'list-buffers)		; Props
-(define-key suntool-map "dl" 'undo)			; Undo
-(define-key suntool-map "el" 'ignore-key)		; Expose-Open
-(define-key suntool-map "fl" 'sun-select-region)	; Put
-(define-key suntool-map "f," 'copy-region-as-kill)	; C-Put
-(define-key suntool-map "gl" 'ignore-key)		; Open-Open
-(define-key suntool-map "hl" 'sun-yank-selection)	; Get
-(define-key suntool-map "h," 'yank)			; C-Get
-(define-key suntool-map "il" 'research-forward)		; Find
-(define-key suntool-map "i," 're-search-forward)	; C-Find
-(define-key suntool-map "i\M-l" 'research-backward)	; M-Find
-(define-key suntool-map "i\M-," 're-search-backward)	; C-M-Find
-
-(define-key suntool-map "jL" 'yank)			; DELETE        
-(define-key suntool-map "jl" 'kill-region-and-unmark)	; Delete
-(define-key suntool-map "j\M-l" 'exchange-point-and-mark); M-Delete
-(define-key suntool-map "j," 
-  '(lambda () (interactive) (pop-mark 1)))		; C-Delete
-
-(define-key suntool-map "fT" 'shrink-window-horizontally)	; T6
-(define-key suntool-map "gT" 'enlarge-window-horizontally)	; T7
-(define-key suntool-map "ft" 'shrink-window)			; t6
-(define-key suntool-map "gt" 'enlarge-window)			; t7
-(define-key suntool-map "cT" '(lambda(n) (interactive "p") (scroll-down n)))
-(define-key suntool-map "dT" '(lambda(n) (interactive "p") (scroll-up n)))
-(define-key suntool-map "ct" 'scroll-down-in-place)		; t3
-(define-key suntool-map "dt" 'scroll-up-in-place)		; t4
-(define-key ctl-x-map "*" suntool-map)
-
-;;; Since .emacs gets loaded before this file, a hook is supplied
-;;; for you to put your own bindings in.
-
-(defvar suntool-map-hooks nil
-  "List of forms to evaluate after setting suntool-map.")
-
-(let ((hooks suntool-map-hooks))
-  (while hooks
-    (eval (car hooks))
-    (setq hooks (cdr hooks))
-    ))
-
-;;;
-;;; If running under emacstool, arrange to call suspend-emacstool
-;;; instead of suspend-emacs.
-;;;
-;;; First mouse blip is a clue that we are in emacstool.
-;;;
-;;; C-x C-@ is the mouse command prefix.
-
-(autoload 'sun-mouse-handler "sun-mouse" 
-	  "Sun Emacstool handler for mouse blips (not loaded)." t)
-
-(defun emacstool-init ()
-  "Set up Emacstool window, if you know you are in an emacstool."
-  ;; Make sure sun-mouse and sun-fns are loaded.
-  (require 'sun-fns)
-  (define-key ctl-x-map "\C-@" 'sun-mouse-handler)
-
-  (if (< (sun-window-init) 0)
-      (message "Not a Sun Window")
-    (progn
-      (substitute-key-definition 'suspend-emacs 'suspend-emacstool global-map)
-      (substitute-key-definition 'suspend-emacs 'suspend-emacstool esc-map)
-      (substitute-key-definition 'suspend-emacs 'suspend-emacstool ctl-x-map))
-      (send-string-to-terminal
-       (concat "\033]lEmacstool - GNU Emacs " emacs-version "\033\\"))
-    ))
-
-(defun sun-mouse-once ()
-  "Converts to emacstool and sun-mouse-handler on first mouse hit."
-  (interactive)
-  (emacstool-init)
-  (sun-mouse-handler)			; Now, execute this mouse blip.
-  )
-(define-key ctl-x-map "\C-@" 'sun-mouse-once)
-
-;;; sun.el ends here
diff --git a/lisp/term/sup-mouse.el b/lisp/term/sup-mouse.el
deleted file mode 100644
index 0075b302526..00000000000
--- a/lisp/term/sup-mouse.el
+++ /dev/null
@@ -1,208 +0,0 @@
-;;; sup-mouse.el --- supdup mouse support for lisp machines
-
-;; Copyright (C) Free Software Foundation 1985, 1986
-
-;; Author: Wolfgang Rupprecht
-;; Maintainer: FSF
-;; Created: 21 Nov 1986
-;; Keywords: hardware
-
-;;     (from code originally written by John Robinson@bbn for the bitgraph)
-
-;; 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.
-
-;;; Code:
-
-;;;  User customization option:
-
-(defvar sup-mouse-fast-select-window nil
-  "*Non-nil for mouse hits to select new window, then execute; else just select.")
-
-(defconst mouse-left 0)
-(defconst mouse-center 1)
-(defconst mouse-right 2)
-
-(defconst mouse-2left 4)
-(defconst mouse-2center 5)
-(defconst mouse-2right 6)
-
-(defconst mouse-3left 8)
-(defconst mouse-3center 9)
-(defconst mouse-3right 10)
-
-;;;  Defuns:
-
-(defun sup-mouse-report ()
-  "This function is called directly by the mouse, it parses and
-executes the mouse commands.
-
- L move point          *  |---- These apply for mouse click in a window.
-2L delete word            |
-3L copy word		  | If sup-mouse-fast-select-window is nil,
- C move point and yank *  | just selects that window.
-2C yank pop		  |
- R set mark            *  |
-2R delete region	  |
-3R copy region		  |
-
-on modeline		    on \"scroll bar\"	in minibuffer
- L scroll-up		    line to top		execute-extended-command
- C proportional goto-char   line to middle	mouse-help
- R scroll-down		    line to bottom	eval-expression"
-  
-  (interactive)
-  (let*
-;; expect a string of <esc>:<buttons>;<x-pos>;<y-pos>c
-      ((buttons (sup-get-tty-num ?\;))
-       (x (sup-get-tty-num ?\;))
-       (y (sup-get-tty-num ?c))
-       (window (sup-pos-to-window x y))
-       (edges (window-edges window))
-       (old-window (selected-window))
-       (in-minibuf-p (eq y (1- (frame-height))))
-       (same-window-p (and (not in-minibuf-p) (eq window old-window)))
-       (in-modeline-p (eq y (1- (nth 3 edges))))
-       (in-scrollbar-p (>= x (1- (nth 2 edges)))))
-    (setq x (- x (nth 0 edges)))
-    (setq y (- y (nth 1 edges)))
-
-;    (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
-
-    (cond (in-modeline-p
-	   (select-window window)
-	   (cond ((= buttons mouse-left)
-		  (scroll-up))
-		 ((= buttons mouse-right)
-		  (scroll-down))
-		 ((= buttons mouse-center)
-		  (goto-char (/ (* x
-				   (- (point-max) (point-min)))
-				(1- (window-width))))
-		  (beginning-of-line)
-		  (what-cursor-position)))
-	   (select-window old-window))
-	  (in-scrollbar-p
-	   (select-window window)
-	   (scroll-up
-	    (cond ((= buttons mouse-left)
-		   y)
-		  ((= buttons mouse-right)
-		   (+ y (- 2 (window-height))))
-		  ((= buttons mouse-center)
-		   (/ (+ 2 y y (- (window-height))) 2))
-		  (t
-		   0)))
-	   (select-window old-window))
-	  (same-window-p
-	   (cond ((= buttons mouse-left)
-		  (sup-move-point-to-x-y x y))
-		 ((= buttons mouse-2left)
-		  (sup-move-point-to-x-y x y)
-		  (kill-word 1))
-		 ((= buttons mouse-3left)
-		  (sup-move-point-to-x-y x y)
-		  (save-excursion
-		    (copy-region-as-kill
-		     (point) (progn (forward-word 1) (point))))
-		  (setq this-command 'yank)
-		  )
-		 ((= buttons mouse-right)
-		  (push-mark)
-		  (sup-move-point-to-x-y x y)
-		  (exchange-point-and-mark))
-		 ((= buttons mouse-2right)
-		  (push-mark)
-		  (sup-move-point-to-x-y x y)
-		  (kill-region (mark) (point)))
-		 ((= buttons mouse-3right)
-		  (push-mark)
-		  (sup-move-point-to-x-y x y)
-		  (copy-region-as-kill (mark) (point))
-		  (setq this-command 'yank))
-		 ((= buttons mouse-center)
-		  (sup-move-point-to-x-y x y)
-		  (setq this-command 'yank)
-		  (yank))
-		 ((= buttons mouse-2center)
-		  (yank-pop 1))
-		 )
-	   )
-	  (in-minibuf-p
-	   (cond ((= buttons mouse-right)
-		  (call-interactively 'eval-expression))
-		 ((= buttons mouse-left)
-		  (call-interactively 'execute-extended-command))
-		 ((= buttons mouse-center)
-		  (describe-function 'sup-mouse-report)); silly self help 
-		 ))
-	  (t				;in another window
-	   (select-window window)
-	   (cond ((not sup-mouse-fast-select-window))
-		 ((= buttons mouse-left)
-		  (sup-move-point-to-x-y x y))
-		 ((= buttons mouse-right)
-		  (push-mark)
-		  (sup-move-point-to-x-y x y)
-		  (exchange-point-and-mark))
-		 ((= buttons mouse-center)
-		  (sup-move-point-to-x-y x y)
-		  (setq this-command 'yank)
-		  (yank))
-		 ))
-	  )))
-
-
-(defun sup-get-tty-num (term-char)
-  "Read from terminal until TERM-CHAR is read, and return intervening number.
-Upon non-numeric not matching TERM-CHAR signal an error."
-  (let
-      ((num 0)
-       (char (read-char)))
-    (while (and (>= char ?0)
-		(<= char ?9))
-      (setq num (+ (* num 10) (- char ?0)))
-      (setq char (read-char)))
-    (or (eq term-char char)
-	(error "Invalid data format in mouse command"))
-    num))
-
-(defun sup-move-point-to-x-y (x y)
-  "Position cursor in window coordinates.
-X and Y are 0-based character positions in the window."
-  (move-to-window-line y)
-  (move-to-column x)
-  )
-
-(defun sup-pos-to-window (x y)
-  "Find window corresponding to frame coordinates.
-X and Y are 0-based character positions on the frame."
-  (let ((edges (window-edges))
-	(window nil))
-    (while (and (not (eq window (selected-window)))
-		(or (<  y (nth 1 edges))
-		    (>= y (nth 3 edges))
-		    (<  x (nth 0 edges))
-		    (>= x (nth 2 edges))))
-      (setq window (next-window window))
-      (setq edges (window-edges window))
-      )
-    (or window (selected-window))
-    )
-  )
-
-;;; sup-mouse.el ends here
diff --git a/lisp/term/tvi970.el b/lisp/term/tvi970.el
deleted file mode 100644
index 200ba315534..00000000000
--- a/lisp/term/tvi970.el
+++ /dev/null
@@ -1,126 +0,0 @@
-;;; tvi970.el --- terminal support for the Televideo 970
-
-;; Author: Jim Blandy <jimb@occs.cs.oberlin.edu>, January 1992
-;; Keywords: terminals
-
-;; Copyright (C) 1992 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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:
-
-;; Uses the Emacs 19 terminal initialization features --- won't work with 18.
-
-;;; Code:
-
-(or (lookup-key function-key-map "\e[")
-    (define-key function-key-map "\e[" (make-keymap)))
-;; (or (lookup-key function-key-map "\eO")
-;;    (define-key function-key-map "\eO" (make-keymap)))
-
-;; Miscellaneous keys
-(mapcar (function (lambda (key-binding)
-		    (define-key function-key-map
-		      (car key-binding) (nth 1 key-binding))))
-	'(
-	  ;; These are set up by termcap or terminfo
-	  ;; ("\eOP"	[kp-f1])
-	  ;; ("\eOQ"	[kp-f2])
-	  ;; ("\eOR"	[kp-f3])
-	  ;; ("\eOS"	[kp-f4])
-
-	  ;; These might br set by terminfo
-	  ("\e[H"	[home])
-	  ("\e[Z"	[backtab])
-	  ("\e[i"	[print])
-	  ("\e[@"	[insert])
-	  ("\e[L"	[insertline])
-	  ("\e[M"	[deleteline])
-	  ("\e[U"	[next])		;; actually the `page' key
-
-	  ;; These won't be set up by either
-	  ("\eOm"	[kp-subtract])
-	  ("\eOl"	[kp-separator])
-	  ("\eOn"	[kp-decimal])
-	  ("\eOM"	[kp-enter])
-
-	  ;; These won't be set up by either either
-	  ("\e[K"	[key_eol])	;; Not an X keysym
-	  ("\e[J"	[key_eos])	;; Not an X keysym
-	  ("\e[2J"	[key_clear])	;; Not an X keysym
-	  ("\e[P"	[key_dc])	;; Not an X keysym
-	  ("\e[g"	[S-tab])	;; Not an X keysym
-	  ("\e[2N"	[clearentry])	;; Not an X keysym
-	  ("\e[2K"	[S-clearentry])	;; Not an X keysym
-	  ("\e[E"	[?\C-j])	;; Not an X keysym
-	  ("\e[g"	[S-backtab])	;; Not an X keysym
-	  ("\e[?1i"	[key_sprint])	;; Not an X keysym
-	  ("\e[4h"	[key_sic])	;; Not an X keysym
-	  ("\e[4l"	[S-delete])	;; Not an X keysym
-	  ("\e[Q"	[S-insertline])	;; Not an X keysym
-	  ("\e[1Q"	[key_sdl])	;; Not an X keysym
-	  ("\e[19l"	[key_seol])	;; Not an X keysym
-	  ("\e[19h"	[S-erasepage])	;; Not an X keysym
-	  ("\e[V"	[S-page])	;; Not an X keysym
-	  ("\eS"	[send])		;; Not an X keysym
-	  ("\e5"	[S-send])	;; Not an X keysym
-	  ))
-
-;; The numeric keypad keys.
-(let ((i 0))
-  (while (< i 10)
-    (define-key function-key-map
-      (format "\eO%c" (+ i ?p))
-      (vector (intern (format "kp-%d" i))))
-    (setq i (1+ i))))
-;; The numbered function keys.
-(let ((i 0))
-  (while (< i 16)
-    (define-key function-key-map
-      (format "\e?%c" (+ i ?a))
-      (vector (intern (format "f%d" (1+ i)))))
-    (define-key function-key-map
-      (format "\e?%c" (+ i ?A))
-      (vector (intern (format "S-f%d" (1+ i)))))
-    (setq i (1+ i))))
-
-
-;;; Should keypad numbers send ordinary digits or distinct escape sequences?
-(defvar tvi970-keypad-numeric nil
-  "The terminal should be in numeric keypad mode iff this variable is non-nil.
-Do not set this variable!  Call the function ``tvi970-set-keypad-mode''.")
-
-(defun tvi970-set-keypad-mode (&optional arg)
-  "Set the current mode of the TVI 970 numeric keypad.
-In ``numeric keypad mode'', the number keys on the keypad act as
-ordinary digits.  In ``alternate keypad mode'', the keys send distinct
-escape sequences, meaning that they can have their own bindings,
-independent of the normal number keys.
-With no argument, toggle between the two possible modes.
-With a positive argument, select alternate keypad mode.
-With a negative argument, select numeric keypad mode."
-  (interactive "P")
-  (setq tvi970-keypad-numeric 
-	(if (null arg)
-	    (not tvi970-keypad-numeric)
-	  (> (prefix-numeric-value arg) 0)))
-  (send-string-to-terminal (if tvi970-keypad-numeric "\e=" "\e>")))
-
-(tvi970-set-keypad-mode 1)
-
-;;; tv970 ends here
diff --git a/lisp/term/vt100.el b/lisp/term/vt100.el
deleted file mode 100644
index 83fcc42d6e1..00000000000
--- a/lisp/term/vt100.el
+++ /dev/null
@@ -1,56 +0,0 @@
-;;; vt100.el --- define VT100 function key sequences in function-key-map
-
-;; Copyright (C) 1989, 1993 Free Software Foundation, Inc.
-
-;; Author: FSF
-;; Keywords: terminals
-
-;; 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:
-
-;; Uses the Emacs 19 terminal initialization features --- won't work with 18.
-
-;; Handles all VT100 clones, including the Apollo terminal.  Also handles
-;; the VT200 --- its PF- and arrow- keys are different, but all those
-;; are really set up by the terminal initialization code, which mines them
-;; out of termcap.  This package is here to define the keypad comma, dash
-;; and period (which aren't in termcap's repertoire) and the function for
-;; changing from 80 to 132 columns & vv.
-
-;;; Code:
-
-;; Set up function-key-map entries that termcap and terminfo don't know.
-(load "term/lk201" nil t)
-
-;;; Controlling the screen width.
-(defconst vt100-wide-mode (= (frame-width) 132)
-  "t if vt100 is in 132-column mode.")
-
-(defun vt100-wide-mode (&optional arg)
-  "Toggle 132/80 column mode for vt100s.
-With positive argument, switch to 132-column mode.
-With negative argument, switch to 80-column mode."
- (interactive "P")
- (setq vt100-wide-mode 
-	(if (null arg) (not vt100-wide-mode)
-	  (> (prefix-numeric-value arg) 0)))
- (send-string-to-terminal (if vt100-wide-mode "\e[?3h" "\e[?3l"))
- (set-frame-width terminal-frame (if vt100-wide-mode 132 80)))
-
-;;; vt100.el ends here
diff --git a/lisp/term/vt200.el b/lisp/term/vt200.el
deleted file mode 100644
index 31f64a0f8b2..00000000000
--- a/lisp/term/vt200.el
+++ /dev/null
@@ -1,6 +0,0 @@
-;; For our purposes we can treat the vt200 and vt100 almost alike.
-;; Most differences are handled by the termcap entry.
-(load "term/vt100" nil t)
-
-;; Make F11 an escape key.
-(define-key function-key-map "\e[23~" [?\e])
diff --git a/lisp/term/vt201.el b/lisp/term/vt201.el
deleted file mode 100644
index c9cb12521dc..00000000000
--- a/lisp/term/vt201.el
+++ /dev/null
@@ -1,7 +0,0 @@
-;; For our purposes we can treat the vt200 and vt100 almost alike.
-;; Most differences are handled by the termcap entry.
-(load "term/vt100" nil t)
-
-;; Make F11 an escape key.
-(define-key function-key-map "\e[23~" [?\e])
-
diff --git a/lisp/term/vt220.el b/lisp/term/vt220.el
deleted file mode 100644
index c9cb12521dc..00000000000
--- a/lisp/term/vt220.el
+++ /dev/null
@@ -1,7 +0,0 @@
-;; For our purposes we can treat the vt200 and vt100 almost alike.
-;; Most differences are handled by the termcap entry.
-(load "term/vt100" nil t)
-
-;; Make F11 an escape key.
-(define-key function-key-map "\e[23~" [?\e])
-
diff --git a/lisp/term/vt240.el b/lisp/term/vt240.el
deleted file mode 100644
index 31f64a0f8b2..00000000000
--- a/lisp/term/vt240.el
+++ /dev/null
@@ -1,6 +0,0 @@
-;; For our purposes we can treat the vt200 and vt100 almost alike.
-;; Most differences are handled by the termcap entry.
-(load "term/vt100" nil t)
-
-;; Make F11 an escape key.
-(define-key function-key-map "\e[23~" [?\e])
diff --git a/lisp/term/w32-win.el b/lisp/term/w32-win.el
deleted file mode 100644
index c295cc39617..00000000000
--- a/lisp/term/w32-win.el
+++ /dev/null
@@ -1,669 +0,0 @@
-;;; win32-win.el --- parse switches controlling interface with win32
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Kevin Gallo
-;; Keywords: terminals
-
-;; 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:
-
-;; win32-win.el:  this file is loaded from ../lisp/startup.el when it recognizes
-;; that win32 windows are to be used.  Command line switches are parsed and those
-;; pertaining to win32 are processed and removed from the command line.  The
-;; win32 display is opened and hooks are set for popping up the initial window.
-
-;; startup.el will then examine startup files, and eventually call the hooks
-;; which create the first window (s).
-
-;;; Code:
-
-
-;; These are the standard X switches from the Xt Initialize.c file of
-;; Release 4.
-
-;; Command line		Resource Manager string
-
-;; +rv			*reverseVideo
-;; +synchronous		*synchronous
-;; -background		*background
-;; -bd			*borderColor
-;; -bg			*background
-;; -bordercolor		*borderColor
-;; -borderwidth		.borderWidth
-;; -bw			.borderWidth
-;; -display		.display
-;; -fg			*foreground
-;; -fn			*font
-;; -font		*font
-;; -foreground		*foreground
-;; -geometry		.geometry
-;; -i			.iconType
-;; -itype		.iconType
-;; -iconic		.iconic
-;; -name		.name
-;; -reverse		*reverseVideo
-;; -rv			*reverseVideo
-;; -selectionTimeout    .selectionTimeout
-;; -synchronous		*synchronous
-;; -xrm
-
-;; An alist of X options and the function which handles them.  See
-;; ../startup.el.
-
-(if (not (eq window-system 'win32))
-    (error "%s: Loading win32-win.el but not compiled for win32" (invocation-name)))
-	 
-(require 'frame)
-(require 'mouse)
-(require 'scroll-bar)
-(require 'faces)
-(require 'select)
-(require 'menu-bar)
-
-;; Because Windows scrollbars look and act quite differently compared
-;; with the standard X scroll-bars, we don't try to use the normal
-;; scroll bar routines.
-
-(defun w32-handle-scroll-bar-event (event)
-  "Handle Win32 scroll bar events to do normal Window style scrolling."
-  (interactive "e")
-  (let ((old-window (selected-window)))
-    (unwind-protect
-	(let* ((position (event-start event))
-	       (window (nth 0 position))
-	       (portion-whole (nth 2 position))
-	       (bar-part (nth 4 position)))
-	  (save-excursion
-	    (select-window window)
-	    (cond
-	     ((eq bar-part 'up)
-	      (scroll-down 1))
-	     ((eq bar-part 'above-handle)
-	      (scroll-down))
-	     ((eq bar-part 'handle)
-	      (scroll-bar-maybe-set-window-start event))
-	     ((eq bar-part 'below-handle)
-	      (scroll-up))
-	     ((eq bar-part 'down)
-	      (scroll-up 1))
-	     )))
-      (select-window old-window))))
-
-;; The following definition is used for debugging.
-;(defun w32-handle-scroll-bar-event (event) (interactive "e") (princ event))
-
-(global-set-key [vertical-scroll-bar mouse-1] 'w32-handle-scroll-bar-event)
-
-;; (scroll-bar-mode nil)
-
-(defvar x-invocation-args)
-
-(defvar x-command-line-resources nil)
-
-(defconst x-option-alist
-  '(("-bw" .	x-handle-numeric-switch)
-    ("-d" .		x-handle-display)
-    ("-display" .	x-handle-display)
-    ("-name" .	x-handle-name-rn-switch)
-    ("-rn" .	x-handle-name-rn-switch)
-    ("-T" .		x-handle-switch)
-    ("-r" .		x-handle-switch)
-    ("-rv" .	x-handle-switch)
-    ("-reverse" .	x-handle-switch)
-    ("-fn" .	x-handle-switch)
-    ("-font" .	x-handle-switch)
-    ("-ib" .	x-handle-numeric-switch)
-    ("-g" .		x-handle-geometry)
-    ("-geometry" .	x-handle-geometry)
-    ("-fg" .	x-handle-switch)
-    ("-foreground".	x-handle-switch)
-    ("-bg" .	x-handle-switch)
-    ("-background".	x-handle-switch)
-    ("-ms" .	x-handle-switch)
-    ("-itype" .	x-handle-switch)
-    ("-i" 	.	x-handle-switch)
-    ("-iconic" .	x-handle-iconic)
-    ("-xrm" .       x-handle-xrm-switch)
-    ("-cr" .	x-handle-switch)
-    ("-vb" .	x-handle-switch)
-    ("-hb" .	x-handle-switch)
-    ("-bd" .	x-handle-switch)))
-
-(defconst x-long-option-alist
-  '(("--border-width" .	"-bw")
-    ("--display" .	"-d")
-    ("--name" .		"-name")
-    ("--title" .	"-T")
-    ("--reverse-video" . "-reverse")
-    ("--font" .		"-font")
-    ("--internal-border" . "-ib")
-    ("--geometry" .	"-geometry")
-    ("--foreground-color" . "-fg")
-    ("--background-color" . "-bg")
-    ("--mouse-color" .	"-ms")
-    ("--icon-type" .	"-itype")
-    ("--iconic" .	"-iconic")
-    ("--xrm" .		"-xrm")
-    ("--cursor-color" .	"-cr")
-    ("--vertical-scroll-bars" . "-vb")
-    ("--border-color" .	"-bd")))
-
-(defconst x-switch-definitions
-  '(("-name" name)
-    ("-T" name)
-    ("-r" reverse t)
-    ("-rv" reverse t)
-    ("-reverse" reverse t)
-    ("-fn" font)
-    ("-font" font)
-    ("-ib" internal-border-width)
-    ("-fg" foreground-color)
-    ("-foreground" foreground-color)
-    ("-bg" background-color)
-    ("-background" background-color)
-    ("-ms" mouse-color)
-    ("-cr" cursor-color)
-    ("-itype" icon-type t)
-    ("-i" icon-type t)
-    ("-vb" vertical-scroll-bars t)
-    ("-hb" horizontal-scroll-bars t)
-    ("-bd" border-color)
-    ("-bw" border-width)))
-
-;; Handler for switches of the form "-switch value" or "-switch".
-(defun x-handle-switch (switch)
-  (let ((aelt (assoc switch x-switch-definitions)))
-    (if aelt
-	(if (nth 2 aelt)
-	    (setq default-frame-alist
-		  (cons (cons (nth 1 aelt) (nth 2 aelt))
-			default-frame-alist))
-	  (setq default-frame-alist
-		(cons (cons (nth 1 aelt)
-			    (car x-invocation-args))
-		      default-frame-alist)
-		x-invocation-args (cdr x-invocation-args))))))
-
-;; Make -iconic apply only to the initial frame!
-(defun x-handle-iconic (switch)
-  (setq initial-frame-alist
-	(cons '(visibility . icon) initial-frame-alist)))
-
-;; Handler for switches of the form "-switch n"
-(defun x-handle-numeric-switch (switch)
-  (let ((aelt (assoc switch x-switch-definitions)))
-    (if aelt
-	(setq default-frame-alist
-	      (cons (cons (nth 1 aelt)
-			  (string-to-int (car x-invocation-args)))
-		    default-frame-alist)
-	      x-invocation-args
-	      (cdr x-invocation-args)))))
-
-;; Handle the -xrm option.
-(defun x-handle-xrm-switch (switch)
-  (or (consp x-invocation-args)
-      (error "%s: missing argument to `%s' option" (invocation-name) switch))
-  (setq x-command-line-resources (car x-invocation-args))
-  (setq x-invocation-args (cdr x-invocation-args)))
-
-;; Handle the geometry option
-(defun x-handle-geometry (switch)
-  (let ((geo (x-parse-geometry (car x-invocation-args))))
-    (setq initial-frame-alist
-	  (append initial-frame-alist
-		  (if (or (assq 'left geo) (assq 'top geo))
-		      '((user-position . t)))
-		  (if (or (assq 'height geo) (assq 'width geo))
-		      '((user-size . t)))
-		  geo)
-	  x-invocation-args (cdr x-invocation-args))))
-
-;; Handle the -name and -rn options.  Set the variable x-resource-name
-;; to the option's operand; if the switch was `-name', set the name of
-;; the initial frame, too.
-(defun x-handle-name-rn-switch (switch)
-  (or (consp x-invocation-args)
-      (error "%s: missing argument to `%s' option" (invocation-name) switch))
-  (setq x-resource-name (car x-invocation-args)
-	x-invocation-args (cdr x-invocation-args))
-  (if (string= switch "-name")
-      (setq initial-frame-alist (cons (cons 'name x-resource-name)
-				      initial-frame-alist))))
-
-(defvar x-display-name nil
-  "The display name specifying server and frame.")
-
-(defun x-handle-display (switch)
-  (setq x-display-name (car x-invocation-args)
-	x-invocation-args (cdr x-invocation-args)))
-
-(defvar x-invocation-args nil)
-
-(defun x-handle-args (args)
-  "Process the X-related command line options in ARGS.
-This is done before the user's startup file is loaded.  They are copied to
-x-invocation args from which the X-related things are extracted, first
-the switch (e.g., \"-fg\") in the following code, and possible values
-\(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
-This returns ARGS with the arguments that have been processed removed."
-  (message "%s" args)
-  (setq x-invocation-args args
-	args nil)
-  (while x-invocation-args
-    (let* ((this-switch (car x-invocation-args))
-	   (orig-this-switch this-switch)
-	   completion argval aelt)
-      (setq x-invocation-args (cdr x-invocation-args))
-      ;; Check for long options with attached arguments
-      ;; and separate out the attached option argument into argval.
-      (if (string-match "^--[^=]*=" this-switch)
-	  (setq argval (substring this-switch (match-end 0))
-		this-switch (substring this-switch 0 (1- (match-end 0)))))
-      (setq completion (try-completion this-switch x-long-option-alist))
-      (if (eq completion t)
-	  ;; Exact match for long option.
-	  (setq this-switch (cdr (assoc this-switch x-long-option-alist)))
-	(if (stringp completion)
-	    (let ((elt (assoc completion x-long-option-alist)))
-	      ;; Check for abbreviated long option.
-	      (or elt
-		  (error "Option `%s' is ambiguous" this-switch))
-	      (setq this-switch (cdr elt)))
-	  ;; Check for a short option.
-	  (setq argval nil this-switch orig-this-switch)))
-      (setq aelt (assoc this-switch x-option-alist))
-      (if aelt
-	  (if argval
-	      (let ((x-invocation-args
-		     (cons argval x-invocation-args)))
-		(funcall (cdr aelt) this-switch))
-	    (funcall (cdr aelt) this-switch))
-	(setq args (cons this-switch args)))))
-  (setq args (nreverse args)))
-
-
-
-;;
-;; Available colors
-;;
-
-(defvar x-colors '("aquamarine"
-		   "Aquamarine"
-		   "medium aquamarine"
-		   "MediumAquamarine"
-		   "black"
-		   "Black"
-		   "blue"
-		   "Blue"
-		   "cadet blue"
-		   "CadetBlue"
-		   "cornflower blue"
-		   "CornflowerBlue"
-		   "dark slate blue"
-		   "DarkSlateBlue"
-		   "light blue"
-		   "LightBlue"
-		   "light steel blue"
-		   "LightSteelBlue"
-		   "medium blue"
-		   "MediumBlue"
-		   "medium slate blue"
-		   "MediumSlateBlue"
-		   "midnight blue"
-		   "MidnightBlue"
-		   "navy blue"
-		   "NavyBlue"
-		   "navy"
-		   "Navy"
-		   "sky blue"
-		   "SkyBlue"
-		   "slate blue"
-		   "SlateBlue"
-		   "steel blue"
-		   "SteelBlue"
-		   "coral"
-		   "Coral"
-		   "cyan"
-		   "Cyan"
-		   "firebrick"
-		   "Firebrick"
-		   "brown"
-		   "Brown"
-		   "gold"
-		   "Gold"
-		   "goldenrod"
-		   "Goldenrod"
-		   "green"
-		   "Green"
-		   "dark green"
-		   "DarkGreen"
-		   "dark olive green"
-		   "DarkOliveGreen"
-		   "forest green"
-		   "ForestGreen"
-		   "lime green"
-		   "LimeGreen"
-		   "medium sea green"
-		   "MediumSeaGreen"
-		   "medium spring green"
-		   "MediumSpringGreen"
-		   "pale green"
-		   "PaleGreen"
-		   "sea green"
-		   "SeaGreen"
-		   "spring green"
-		   "SpringGreen"
-		   "yellow green"
-		   "YellowGreen"
-		   "dark slate grey"
-		   "DarkSlateGrey"
-		   "dark slate gray"
-		   "DarkSlateGray"
-		   "dim grey"
-		   "DimGrey"
-		   "dim gray"
-		   "DimGray"
-		   "light grey"
-		   "LightGrey"
-		   "light gray"
-		   "LightGray"
-		   "gray"
-		   "grey"
-		   "Gray"
-		   "Grey"
-		   "khaki"
-		   "Khaki"
-		   "magenta"
-		   "Magenta"
-		   "maroon"
-		   "Maroon"
-		   "orange"
-		   "Orange"
-		   "orchid"
-		   "Orchid"
-		   "dark orchid"
-		   "DarkOrchid"
-		   "medium orchid"
-		   "MediumOrchid"
-		   "pink"
-		   "Pink"
-		   "plum"
-		   "Plum"
-		   "red"
-		   "Red"
-		   "indian red"
-		   "IndianRed"
-		   "medium violet red"
-		   "MediumVioletRed"
-		   "orange red"
-		   "OrangeRed"
-		   "violet red"
-		   "VioletRed"
-		   "salmon"
-		   "Salmon"
-		   "sienna"
-		   "Sienna"
-		   "tan"
-		   "Tan"
-		   "thistle"
-		   "Thistle"
-		   "turquoise"
-		   "Turquoise"
-		   "dark turquoise"
-		   "DarkTurquoise"
-		   "medium turquoise"
-		   "MediumTurquoise"
-		   "violet"
-		   "Violet"
-		   "blue violet"
-		   "BlueViolet"
-		   "wheat"
-		   "Wheat"
-		   "white"
-		   "White"
-		   "yellow"
-		   "Yellow"
-		   "green yellow"
-		   "GreenYellow")
-  "The full list of X colors from the `rgb.text' file.")
-
-(defun x-defined-colors (&optional frame)
-  "Return a list of colors supported for a particular frame.
-The argument FRAME specifies which frame to try.
-The value may be different for frames on different X displays."
-  (or frame (setq frame (selected-frame)))
-  (let* ((color-map-colors (mapcar (lambda (clr) (car clr)) w32-color-map))
-	 (all-colors (or color-map-colors x-colors))
-	 (this-color nil)
-	 (defined-colors nil))
-    (message "Defining colors...")
-    (while all-colors
-      (setq this-color (car all-colors)
-	    all-colors (cdr all-colors))
-      (and (face-color-supported-p frame this-color t)
-	   (setq defined-colors (cons this-color defined-colors))))
-    defined-colors))
-
-;;;; Function keys
-
-(defun iconify-or-deiconify-frame ()
-  "Iconify the selected frame, or deiconify if it's currently an icon."
-  (interactive)
-  (if (eq (cdr (assq 'visibility (frame-parameters))) t)
-      (iconify-frame)
-    (make-frame-visible)))
-
-(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
-			   global-map)
-
-;; Map certain keypad keys into ASCII characters
-;; that people usually expect.
-(define-key function-key-map [tab] [?\t])
-(define-key function-key-map [linefeed] [?\n])
-(define-key function-key-map [clear] [11])
-(define-key function-key-map [return] [13])
-(define-key function-key-map [escape] [?\e])
-(define-key function-key-map [M-tab] [?\M-\t])
-(define-key function-key-map [M-linefeed] [?\M-\n])
-(define-key function-key-map [M-clear] [?\M-\013])
-(define-key function-key-map [M-return] [?\M-\015])
-(define-key function-key-map [M-escape] [?\M-\e])
-
-;; These don't do the right thing (voelker)
-;(define-key function-key-map [backspace] [127])
-;(define-key function-key-map [delete] [127])
-;(define-key function-key-map [M-backspace] [?\M-\d])
-;(define-key function-key-map [M-delete] [?\M-\d])
-
-;; These tell read-char how to convert
-;; these special chars to ASCII.
-(put 'tab 'ascii-character ?\t)
-(put 'linefeed 'ascii-character ?\n)
-(put 'clear 'ascii-character 12)
-(put 'return 'ascii-character 13)
-(put 'escape 'ascii-character ?\e)
-;; These don't seem to be necessary (voelker)
-;(put 'backspace 'ascii-character 127)
-;(put 'delete 'ascii-character 127)
-
-
-;;;; Selections and cut buffers
-
-;;; We keep track of the last text selected here, so we can check the
-;;; current selection against it, and avoid passing back our own text
-;;; from x-cut-buffer-or-selection-value.
-(defvar x-last-selected-text nil)
-
-;;; It is said that overlarge strings are slow to put into the cut buffer.
-;;; Note this value is overridden below.
-(defvar x-cut-buffer-max 20000
-  "Max number of characters to put in the cut buffer.")
-
-(defvar x-select-enable-clipboard t
-  "Non-nil means cutting and pasting uses the clipboard.
-This is in addition to the primary selection.")
-
-(defun x-select-text (text &optional push)
-  (if x-select-enable-clipboard 
-      (w32-set-clipboard-data text))
-  (setq x-last-selected-text text))
-    
-;;; Return the value of the current selection.
-;;; Consult the selection, then the cut buffer.  Treat empty strings
-;;; as if they were unset.
-(defun x-get-selection-value ()
-  (if x-select-enable-clipboard 
-      (let (text)
-	;; Don't die if x-get-selection signals an error.
-	(condition-case c
-	    (setq text (w32-get-clipboard-data))
-	  (error (message "w32-get-clipboard-data:%s" c)))
-	(if (string= text "") (setq text nil))
-	(cond
-	 ((not text) nil)
-	 ((eq text x-last-selected-text) nil)
-	 ((string= text x-last-selected-text)
-	  ;; Record the newer string, so subsequent calls can use the 'eq' test.
-	  (setq x-last-selected-text text)
-	  nil)
-	 (t
-	  (setq x-last-selected-text text))))))
-
-;;; Do the actual Windows setup here; the above code just defines
-;;; functions and variables that we use now.
-
-(setq command-line-args (x-handle-args command-line-args))
-
-;;; Make sure we have a valid resource name.
-(or (stringp x-resource-name)
-    (let (i)
-      (setq x-resource-name (invocation-name))
-
-      ;; Change any . or * characters in x-resource-name to hyphens,
-      ;; so as not to choke when we use it in X resource queries.
-      (while (setq i (string-match "[.*]" x-resource-name))
-	(aset x-resource-name i ?-))))
-
-;; For the benefit of older Emacses (19.27 and earlier) that are sharing
-;; the same lisp directory, don't pass the third argument unless we seem
-;; to have the multi-display support.
-(if (fboundp 'x-close-connection)
-    (x-open-connection ""
-		       x-command-line-resources
-		       ;; Exit Emacs with fatal error if this fails.
-		       t)
-  (x-open-connection ""
-		     x-command-line-resources))
-
-(setq frame-creation-function 'x-create-frame-with-faces)
-
-(setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100)
-			    x-cut-buffer-max))
-
-;; W32 expects the menu bar cut and paste commands to use the clipboard.
-;; This has ,? to match both on Sunos and on Solaris.
-(menu-bar-enable-clipboard)
-
-;; Apply a geometry resource to the initial frame.  Put it at the end
-;; of the alist, so that anything specified on the command line takes
-;; precedence.
-(let* ((res-geometry (x-get-resource "geometry" "Geometry"))
-       parsed)
-  (if res-geometry
-      (progn
-	(setq parsed (x-parse-geometry res-geometry))
-	;; If the resource specifies a position,
-	;; call the position and size "user-specified".
-	(if (or (assq 'top parsed) (assq 'left parsed))
-	    (setq parsed (cons '(user-position . t)
-			       (cons '(user-size . t) parsed))))
-	;; All geometry parms apply to the initial frame.
-	(setq initial-frame-alist (append initial-frame-alist parsed))
-	;; The size parms apply to all frames.
-	(if (assq 'height parsed)
-	    (setq default-frame-alist
-		  (cons (cons 'height (cdr (assq 'height parsed)))
-			default-frame-alist)))
-	(if (assq 'width parsed)
-	    (setq default-frame-alist
-		  (cons (cons 'width (cdr (assq 'width parsed)))
-			default-frame-alist))))))
-
-;; Check the reverseVideo resource.
-(let ((case-fold-search t))
-  (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
-    (if (and rv
-	     (string-match "^\\(true\\|yes\\|on\\)$" rv))
-	(setq default-frame-alist
-	      (cons '(reverse . t) default-frame-alist)))))
-
-;; Set x-selection-timeout, measured in milliseconds.
-(let ((res-selection-timeout
-       (x-get-resource "selectionTimeout" "SelectionTimeout")))
-  (setq x-selection-timeout 20000)
-  (if res-selection-timeout
-      (setq x-selection-timeout (string-to-number res-selection-timeout))))
-
-(defun x-win-suspend-error ()
-  (error "Suspending an emacs running under Win32 makes no sense"))
-(add-hook 'suspend-hook 'x-win-suspend-error)
-
-;;; Arrange for the kill and yank functions to set and check the clipboard.
-(setq interprogram-cut-function 'x-select-text)
-(setq interprogram-paste-function 'x-get-selection-value)
-
-;;; Turn off window-splitting optimization; w32 is usually fast enough
-;;; that this is only annoying.
-(setq split-window-keep-point t)
-
-;; Don't show the frame name; that's redundant.
-(setq-default mode-line-buffer-identification '("Emacs: %12b"))
-
-;;; Set to a system sound if you want a fancy bell.
-(set-message-beep 'ok)
-
-;; Remap some functions to call w32 common dialogs
-
-(defun internal-face-interactive (what &optional bool)
-  (let* ((fn (intern (concat "face-" what)))
-	 (prompt (concat "Set " what " of face"))
-	 (face (read-face-name (concat prompt ": ")))
-	 (default (if (fboundp fn)
-		      (or (funcall fn face (selected-frame))
-			  (funcall fn 'default (selected-frame)))))
-	 (fn-win (intern (concat (symbol-name window-system) "-select-" what)))
-	 (value 
-	  (if (fboundp fn-win)
-	      (funcall fn-win)
-	    (if bool
-		(y-or-n-p (concat "Should face " (symbol-name face)
-				  " be " bool "? "))
-	      (read-string (concat prompt " " (symbol-name face) " to: ")
-			   default)))))
-	 (list face (if (equal value "") nil value))))
-
-;; Redefine the font selection to use the standard Win32 dialog
-
-(defun mouse-set-font (&rest fonts)
-  (interactive)
-  (set-default-font (w32-select-font)))
-
-;;; win32-win.el ends here
diff --git a/lisp/term/wyse50.el b/lisp/term/wyse50.el
deleted file mode 100644
index 3cb1307bb89..00000000000
--- a/lisp/term/wyse50.el
+++ /dev/null
@@ -1,151 +0,0 @@
-;;; wyse50.el --- terminal support code for Wyse 50
-
-;; Copyright (C) 1989, 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Daniel Pfieffer <pfieffer@cix.cict.fr> January 1991
-;;	Jim Blandy <jimb@occs.cs.oberlin.edu>
-;; Keywords: terminals
-
-;; 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:
-
-;; Uses the Emacs 19 terminal initialization features --- won't work with 18.
-;; Rewritten for Emacs 19 by jimb,  January 1992
-;; Cleaned up for new terminal package conventions by esr, March 1993
-;; Should work well for Televideo TVI 925 although it's overkill.
-;;
-;; The Wyse50 is ergonomically wonderful, but its escape-sequence design sucks
-;; rocks.  The left-arrow key emits a backspace (!) and the down-arrow a line
-;; feed (!!).  Thus, you have to unbind some commonly-used Emacs keys to
-;; enable the arrows.
-
-;;; Code:
-
-(define-key function-key-map "\C-a" (make-keymap))
-(mapcar (function (lambda (key-definition)
-		    (define-key function-key-map
-		      (car key-definition) (nth 1 key-definition))))
-	'(
-	  ;; These might be set up by termcap and terminfo
-	  ("\C-k"	[up])
-	  ("\C-j"	[down])
-	  ("\C-l"	[right])
-	  ("\C-h"	[left])
-	  ("\^a@\^m"	[f1])
-	  ("\^aA\^m"	[f2])
-	  ("\^aB\^m"	[f3])
-	  ("\^aC\^m"	[f4])
-	  ("\^aD\^m"	[f5])
-	  ("\^aE\^m"	[f6])
-	  ("\^aF\^m"	[f7])
-	  ("\^aG\^m"	[f8])
-	  ("\^aH\^m"	[f9])
-
-	  ;; These might be set up by terminfo
-	  ("\eK"	[next])
-	  ("\eT"	[clearline])
-	  ("\^^"	[home])
-	  ("\e\^^"	[end])
-	  ("\eQ"	[insert])
-	  ("\eE"	[insertline])
-	  ("\eR"	[deleteline])
-	  ("\eP"	[print])
-	  ("\er"	[replace])
-	  ("\^aI\^m"	[f10])
-	  ("\^aJ\^m"	[f11])
-	  ("\^aK\^m"	[f12])
-	  ("\^aL\^m"	[f13])
-	  ("\^aM\^m"	[f14])
-	  ("\^aN\^m"	[f15])
-	  ("\^aO\^m"	[f16])
-	  ("\^a`\^m"	[f17])
-	  ("\^aa\^m"	[f18])
-	  ("\^ab\^m"	[f19])
-	  ("\^ac\^m"	[f20])
-	  ("\^ad\^m"	[f21])
-	  ("\^ae\^m"	[f22])
-	  ("\^af\^m"	[f23])
-	  ("\^ag\^m"	[f24])
-	  ("\^ah\^m"	[f25])
-	  ("\^ai\^m"	[f26])
-	  ("\^aj\^m"	[f27])
-	  ("\^ak\^m"	[f28])
-	  ("\^al\^m"	[f29])
-	  ("\^am\^m"	[f30])
-	  ("\^an\^m"	[f31])
-	  ("\^ao\^m"	[f32])
-
-	  ;; Terminfo may know about these, but X won't
-	  ("\eI"	[key-stab])		;; Not an X keysym
-	  ("\eJ"	[key-snext])		;; Not an X keysym
-	  ("\eY"	[key-clear])		;; Not an X keysym
-
-	  ;; These are totally strange :-)
-	  ("\eW"	[?\C-?])	;; Not an X keysym
-	  ("\^a\^k\^m"	[funct-up])	;; Not an X keysym
-	  ("\^a\^j\^m"	[funct-down])	;; Not an X keysym
-	  ("\^a\^l\^m"	[funct-right])	;; Not an X keysym
-	  ("\^a\^h\^m"	[funct-left])	;; Not an X keysym
-	  ("\^a\^m\^m"	[funct-return])	;; Not an X keysym
-	  ("\^a\^i\^m"	[funct-tab])	;; Not an X keysym
-))
-
-(defun enable-arrow-keys ()
-  "To be called by term-setup-hook. Overrides 6 Emacs standard keys
-whose functions are then typed as follows:
-C-a	Funct Left-arrow
-C-h	M-?
-LFD	Funct Return, some modes override down-arrow via LFD
-C-k	CLR Line
-C-l	Scrn CLR
-M-r	M-x move-to-window-line, Funct up-arrow or down-arrow are similar
-"
-  (interactive)
-  (mapcar (function (lambda (key-definition)
-		      (global-set-key (car key-definition)
-				      (nth 1 key-definition))))
-	  ;; By unsetting C-a and then binding it to a prefix, we
-	  ;; allow the rest of the function keys which start with C-a
-	  ;; to be recognized.
-	  '(("\C-a"	nil)
-	    ("\C-k"	nil)
-	    ("\C-j"	nil)
-	    ("\C-l"	nil)
-	    ("\C-h"	nil)
-	    ("\er"	nil)))
-  (fset 'enable-arrow-keys nil))
-
-
-;;; Miscellaneous hacks
-
-;;; This is an ugly hack for a nasty problem:
-;;; Wyse 50 takes one character cell to store video attributes (which seems to
-;;; explain width 79 rather than 80, column 1 is not used!!!).
-;;; On killing (C-x C-c) the end inverse code (on column 1 of line 24)
-;;; of the mode line is overwritten AFTER all the y-or-n questions.
-;;; This causes the attribute to remain in effect until the mode line has
-;;; scrolled of the screen.  Suspending (C-z) does not cause this problem.
-;;; On such terminals, Emacs should sacrifice the first and last character of
-;;; each mode line, rather than a whole screen column!
-(add-hook 'kill-emacs-hook
-	  (function (lambda () (interactive)
-		      (send-string-to-terminal
-		       (concat "\ea23R" (1+ (frame-width)) "C\eG0")))))
-
-;;; wyse50.el ends here
diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el
deleted file mode 100644
index 12a1ec48163..00000000000
--- a/lisp/term/x-win.el
+++ /dev/null
@@ -1,711 +0,0 @@
-;;; x-win.el --- parse switches controlling interface with X window system
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: FSF
-;; Keywords: terminals
-
-;; 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:
-
-;; X-win.el:  this file is loaded from ../lisp/startup.el when it recognizes
-;; that X windows are to be used.  Command line switches are parsed and those
-;; pertaining to X are processed and removed from the command line.  The
-;; X display is opened and hooks are set for popping up the initial window.
-
-;; startup.el will then examine startup files, and eventually call the hooks
-;; which create the first window (s).
-
-;;; Code:
-
-;; These are the standard X switches from the Xt Initialize.c file of
-;; Release 4.
-
-;; Command line		Resource Manager string
-
-;; +rv			*reverseVideo
-;; +synchronous		*synchronous
-;; -background		*background
-;; -bd			*borderColor
-;; -bg			*background
-;; -bordercolor		*borderColor
-;; -borderwidth		.borderWidth
-;; -bw			.borderWidth
-;; -display		.display
-;; -fg			*foreground
-;; -fn			*font
-;; -font		*font
-;; -foreground		*foreground
-;; -geometry		.geometry
-;; -i			.iconType
-;; -itype		.iconType
-;; -iconic		.iconic
-;; -name		.name
-;; -reverse		*reverseVideo
-;; -rv			*reverseVideo
-;; -selectionTimeout    .selectionTimeout
-;; -synchronous		*synchronous
-;; -xrm
-
-;; An alist of X options and the function which handles them.  See
-;; ../startup.el.
-
-(if (not (eq window-system 'x))
-    (error "%s: Loading x-win.el but not compiled for X" (invocation-name)))
-	 
-(require 'frame)
-(require 'mouse)
-(require 'scroll-bar)
-(require 'faces)
-(require 'select)
-(require 'menu-bar)
-
-(defvar x-invocation-args)
-
-(defvar x-command-line-resources nil)
-
-;; Handler for switches of the form "-switch value" or "-switch".
-(defun x-handle-switch (switch)
-  (let ((aelt (assoc switch command-line-x-option-alist)))
-    (if aelt
-	(let ((param (nth 3 aelt))
-	      (value (nth 4 aelt)))
-	  (if value
-	      (setq default-frame-alist
-		    (cons (cons param value)
-			  default-frame-alist))
-	    (setq default-frame-alist
-		  (cons (cons param
-			      (car x-invocation-args))
-			default-frame-alist)
-		  x-invocation-args (cdr x-invocation-args)))))))
-
-;; Handler for switches of the form "-switch n"
-(defun x-handle-numeric-switch (switch)
-  (let ((aelt (assoc switch command-line-x-option-alist)))
-    (if aelt
-	(let ((param (nth 3 aelt)))
-	  (setq default-frame-alist
-		(cons (cons param
-			    (string-to-int (car x-invocation-args)))
-		      default-frame-alist)
-		x-invocation-args
-		(cdr x-invocation-args))))))
-
-;; Make -iconic apply only to the initial frame!
-(defun x-handle-iconic (switch)
-  (setq initial-frame-alist
-	(cons '(visibility . icon) initial-frame-alist)))
-
-;; Handle the -xrm option.
-(defun x-handle-xrm-switch (switch)
-  (or (consp x-invocation-args)
-      (error "%s: missing argument to `%s' option" (invocation-name) switch))
-  (setq x-command-line-resources (car x-invocation-args))
-  (setq x-invocation-args (cdr x-invocation-args)))
-
-;; Handle the geometry option
-(defun x-handle-geometry (switch)
-  (let ((geo (x-parse-geometry (car x-invocation-args))))
-    (setq initial-frame-alist
-	  (append initial-frame-alist
-		  (if (or (assq 'left geo) (assq 'top geo))
-		      '((user-position . t)))
-		  (if (or (assq 'height geo) (assq 'width geo))
-		      '((user-size . t)))
-		  geo)
-	  x-invocation-args (cdr x-invocation-args))))
-
-;; Handle the -name option.  Set the variable x-resource-name
-;; to the option's operand; set the name of
-;; the initial frame, too.
-(defun x-handle-name-switch (switch)
-  (or (consp x-invocation-args)
-      (error "%s: missing argument to `%s' option" (invocation-name) switch))
-  (setq x-resource-name (car x-invocation-args)
-	x-invocation-args (cdr x-invocation-args))
-  (setq initial-frame-alist (cons (cons 'name x-resource-name)
-				  initial-frame-alist)))
-
-(defvar x-display-name nil
-  "The X display name specifying server and X frame.")
-
-(defun x-handle-display (switch)
-  (setq x-display-name (car x-invocation-args)
-	x-invocation-args (cdr x-invocation-args))
-  ;; Make subshell programs see the same DISPLAY value Emacs really uses.
-  ;; Note that this isn't completely correct, since Emacs can use
-  ;; multiple displays.  However, there is no way to tell an already
-  ;; running subshell which display the user is currently typing on.
-  (setenv "DISPLAY" x-display-name))
-
-(defun x-handle-args (args)
-  "Process the X-related command line options in ARGS.
-This is done before the user's startup file is loaded.  They are copied to
-`x-invocation-args', from which the X-related things are extracted, first
-the switch (e.g., \"-fg\") in the following code, and possible values
-\(e.g., \"black\") in the option handler code (e.g., x-handle-switch).
-This function returns ARGS minus the arguments that have been processed."
-  ;; We use ARGS to accumulate the args that we don't handle here, to return.
-  (setq x-invocation-args args
-	args nil)
-  (while (and x-invocation-args
-	      (not (equal (car x-invocation-args) "--")))
-    (let* ((this-switch (car x-invocation-args))
-	   (orig-this-switch this-switch)
-	   completion argval aelt handler)
-      (setq x-invocation-args (cdr x-invocation-args))
-      ;; Check for long options with attached arguments
-      ;; and separate out the attached option argument into argval.
-      (if (string-match "^--[^=]*=" this-switch)
-	  (setq argval (substring this-switch (match-end 0))
-		this-switch (substring this-switch 0 (1- (match-end 0)))))
-      ;; Complete names of long options.
-      (if (string-match "^--" this-switch)
-	  (progn
-	    (setq completion (try-completion this-switch command-line-x-option-alist))
-	    (if (eq completion t)
-		;; Exact match for long option.
-		nil
-	      (if (stringp completion)
-		  (let ((elt (assoc completion command-line-x-option-alist)))
-		    ;; Check for abbreviated long option.
-		    (or elt
-			(error "Option `%s' is ambiguous" this-switch))
-		    (setq this-switch completion))))))
-      (setq aelt (assoc this-switch command-line-x-option-alist))
-      (if aelt (setq handler (nth 2 aelt)))
-      (if handler
-	  (if argval
-	      (let ((x-invocation-args
-		     (cons argval x-invocation-args)))
-		(funcall handler this-switch))
-	    (funcall handler this-switch))
-	(setq args (cons orig-this-switch args)))))
-  (nconc (nreverse args) x-invocation-args))
-
-;;
-;; Standard X cursor shapes, courtesy of Mr. Fox, who wanted ALL of them.
-;;
-
-(defconst x-pointer-X-cursor 0)
-(defconst x-pointer-arrow 2)
-(defconst x-pointer-based-arrow-down 4)
-(defconst x-pointer-based-arrow-up 6)
-(defconst x-pointer-boat 8)
-(defconst x-pointer-bogosity 10)
-(defconst x-pointer-bottom-left-corner 12)
-(defconst x-pointer-bottom-right-corner 14)
-(defconst x-pointer-bottom-side 16)
-(defconst x-pointer-bottom-tee 18)
-(defconst x-pointer-box-spiral 20)
-(defconst x-pointer-center-ptr 22)
-(defconst x-pointer-circle 24)
-(defconst x-pointer-clock 26)
-(defconst x-pointer-coffee-mug 28)
-(defconst x-pointer-cross 30)
-(defconst x-pointer-cross-reverse 32)
-(defconst x-pointer-crosshair 34)
-(defconst x-pointer-diamond-cross 36)
-(defconst x-pointer-dot 38)
-(defconst x-pointer-dotbox 40)
-(defconst x-pointer-double-arrow 42)
-(defconst x-pointer-draft-large 44)
-(defconst x-pointer-draft-small 46)
-(defconst x-pointer-draped-box 48)
-(defconst x-pointer-exchange 50)
-(defconst x-pointer-fleur 52)
-(defconst x-pointer-gobbler 54)
-(defconst x-pointer-gumby 56)
-(defconst x-pointer-hand1 58)
-(defconst x-pointer-hand2 60)
-(defconst x-pointer-heart 62)
-(defconst x-pointer-icon 64)
-(defconst x-pointer-iron-cross 66)
-(defconst x-pointer-left-ptr 68)
-(defconst x-pointer-left-side 70)
-(defconst x-pointer-left-tee 72)
-(defconst x-pointer-leftbutton 74)
-(defconst x-pointer-ll-angle 76)
-(defconst x-pointer-lr-angle 78)
-(defconst x-pointer-man 80)
-(defconst x-pointer-middlebutton 82)
-(defconst x-pointer-mouse 84)
-(defconst x-pointer-pencil 86)
-(defconst x-pointer-pirate 88)
-(defconst x-pointer-plus 90)
-(defconst x-pointer-question-arrow 92)
-(defconst x-pointer-right-ptr 94)
-(defconst x-pointer-right-side 96)
-(defconst x-pointer-right-tee 98)
-(defconst x-pointer-rightbutton 100)
-(defconst x-pointer-rtl-logo 102)
-(defconst x-pointer-sailboat 104)
-(defconst x-pointer-sb-down-arrow 106)
-(defconst x-pointer-sb-h-double-arrow 108)
-(defconst x-pointer-sb-left-arrow 110)
-(defconst x-pointer-sb-right-arrow 112)
-(defconst x-pointer-sb-up-arrow 114)
-(defconst x-pointer-sb-v-double-arrow 116)
-(defconst x-pointer-shuttle 118)
-(defconst x-pointer-sizing 120)
-(defconst x-pointer-spider 122)
-(defconst x-pointer-spraycan 124)
-(defconst x-pointer-star 126)
-(defconst x-pointer-target 128)
-(defconst x-pointer-tcross 130)
-(defconst x-pointer-top-left-arrow 132)
-(defconst x-pointer-top-left-corner 134)
-(defconst x-pointer-top-right-corner 136)
-(defconst x-pointer-top-side 138)
-(defconst x-pointer-top-tee 140)
-(defconst x-pointer-trek 142)
-(defconst x-pointer-ul-angle 144)
-(defconst x-pointer-umbrella 146)
-(defconst x-pointer-ur-angle 148)
-(defconst x-pointer-watch 150)
-(defconst x-pointer-xterm 152)
-
-;;
-;; Available colors
-;;
-
-(defvar x-colors '("aquamarine"
-		   "Aquamarine"
-		   "medium aquamarine"
-		   "MediumAquamarine"
-		   "black"
-		   "Black"
-		   "blue"
-		   "Blue"
-		   "cadet blue"
-		   "CadetBlue"
-		   "cornflower blue"
-		   "CornflowerBlue"
-		   "dark slate blue"
-		   "DarkSlateBlue"
-		   "light blue"
-		   "LightBlue"
-		   "light steel blue"
-		   "LightSteelBlue"
-		   "medium blue"
-		   "MediumBlue"
-		   "medium slate blue"
-		   "MediumSlateBlue"
-		   "midnight blue"
-		   "MidnightBlue"
-		   "navy blue"
-		   "NavyBlue"
-		   "navy"
-		   "Navy"
-		   "sky blue"
-		   "SkyBlue"
-		   "slate blue"
-		   "SlateBlue"
-		   "steel blue"
-		   "SteelBlue"
-		   "coral"
-		   "Coral"
-		   "cyan"
-		   "Cyan"
-		   "firebrick"
-		   "Firebrick"
-		   "brown"
-		   "Brown"
-		   "gold"
-		   "Gold"
-		   "goldenrod"
-		   "Goldenrod"
-		   "green"
-		   "Green"
-		   "dark green"
-		   "DarkGreen"
-		   "dark olive green"
-		   "DarkOliveGreen"
-		   "forest green"
-		   "ForestGreen"
-		   "lime green"
-		   "LimeGreen"
-		   "medium sea green"
-		   "MediumSeaGreen"
-		   "medium spring green"
-		   "MediumSpringGreen"
-		   "pale green"
-		   "PaleGreen"
-		   "sea green"
-		   "SeaGreen"
-		   "spring green"
-		   "SpringGreen"
-		   "yellow green"
-		   "YellowGreen"
-		   "dark slate grey"
-		   "DarkSlateGrey"
-		   "dark slate gray"
-		   "DarkSlateGray"
-		   "dim grey"
-		   "DimGrey"
-		   "dim gray"
-		   "DimGray"
-		   "light grey"
-		   "LightGrey"
-		   "light gray"
-		   "LightGray"
-		   "gray"
-		   "grey"
-		   "Gray"
-		   "Grey"
-		   "khaki"
-		   "Khaki"
-		   "magenta"
-		   "Magenta"
-		   "maroon"
-		   "Maroon"
-		   "orange"
-		   "Orange"
-		   "orchid"
-		   "Orchid"
-		   "dark orchid"
-		   "DarkOrchid"
-		   "medium orchid"
-		   "MediumOrchid"
-		   "pink"
-		   "Pink"
-		   "plum"
-		   "Plum"
-		   "red"
-		   "Red"
-		   "indian red"
-		   "IndianRed"
-		   "medium violet red"
-		   "MediumVioletRed"
-		   "orange red"
-		   "OrangeRed"
-		   "violet red"
-		   "VioletRed"
-		   "salmon"
-		   "Salmon"
-		   "sienna"
-		   "Sienna"
-		   "tan"
-		   "Tan"
-		   "thistle"
-		   "Thistle"
-		   "turquoise"
-		   "Turquoise"
-		   "dark turquoise"
-		   "DarkTurquoise"
-		   "medium turquoise"
-		   "MediumTurquoise"
-		   "violet"
-		   "Violet"
-		   "blue violet"
-		   "BlueViolet"
-		   "wheat"
-		   "Wheat"
-		   "white"
-		   "White"
-		   "yellow"
-		   "Yellow"
-		   "green yellow"
-		   "GreenYellow")
-  "The list of X colors from the `rgb.txt' file.")
-
-(defun x-defined-colors (&optional frame)
-  "Return a list of colors supported for a particular frame.
-The argument FRAME specifies which frame to try.
-The value may be different for frames on different X displays."
-  (or frame (setq frame (selected-frame)))
-  (let ((all-colors x-colors)
-	(this-color nil)
-	(defined-colors nil))
-    (while all-colors
-      (setq this-color (car all-colors)
-	    all-colors (cdr all-colors))
-      (and (face-color-supported-p frame this-color t)
-	   (setq defined-colors (cons this-color defined-colors))))
-    defined-colors))
-
-;;;; Function keys
-
-(defun iconify-or-deiconify-frame ()
-  "Iconify the selected frame, or deiconify if it's currently an icon."
-  (interactive)
-  (if (eq (cdr (assq 'visibility (frame-parameters))) t)
-      (iconify-frame)
-    (make-frame-visible)))
-
-(substitute-key-definition 'suspend-emacs 'iconify-or-deiconify-frame
-			   global-map)
-
-;; Map certain keypad keys into ASCII characters
-;; that people usually expect.
-(define-key function-key-map [backspace] [127])
-(define-key function-key-map [delete] [127])
-(define-key function-key-map [tab] [?\t])
-(define-key function-key-map [linefeed] [?\n])
-(define-key function-key-map [clear] [?\C-l])
-(define-key function-key-map [return] [?\C-m])
-(define-key function-key-map [escape] [?\e])
-(define-key function-key-map [M-backspace] [?\M-\d])
-(define-key function-key-map [M-delete] [?\M-\d])
-(define-key function-key-map [M-tab] [?\M-\t])
-(define-key function-key-map [M-linefeed] [?\M-\n])
-(define-key function-key-map [M-clear] [?\M-\C-l])
-(define-key function-key-map [M-return] [?\M-\C-m])
-(define-key function-key-map [M-escape] [?\M-\e])
-
-;; These tell read-char how to convert
-;; these special chars to ASCII.
-(put 'backspace 'ascii-character 127)
-(put 'delete 'ascii-character 127)
-(put 'tab 'ascii-character ?\t)
-(put 'linefeed 'ascii-character ?\n)
-(put 'clear 'ascii-character 12)
-(put 'return 'ascii-character 13)
-(put 'escape 'ascii-character ?\e)
-
-(defun vendor-specific-keysyms (vendor)
-  "Return the appropriate value of system-key-alist for VENDOR.
-VENDOR is a string containing the name of the X Server's vendor,
-as returned by (x-server-vendor)."
-  (cond ((string-equal vendor "Apollo Computer Inc.")
-	 '((65280 . linedel)
-	   (65281 . chardel)
-	   (65282 . copy)
-	   (65283 . cut)
-	   (65284 . paste)
-	   (65285 . move)
-	   (65286 . grow)
-	   (65287 . cmd)
-	   (65288 . shell)
-	   (65289 . leftbar)
-	   (65290 . rightbar)
-	   (65291 . leftbox)
-	   (65292 . rightbox)
-	   (65293 . upbox)
-	   (65294 . downbox)
-	   (65295 . pop)
-	   (65296 . read)
-	   (65297 . edit)
-	   (65298 . save)
-	   (65299 . exit)
-	   (65300 . repeat)))
-	((or (string-equal vendor "Hewlett-Packard Incorporated")
-	     (string-equal vendor "Hewlett-Packard Company"))
-	 '((  168 . mute-acute)
-	   (  169 . mute-grave)
-	   (  170 . mute-asciicircum)
-	   (  171 . mute-diaeresis)
-	   (  172 . mute-asciitilde)
-	   (  175 . lira)
-	   (  190 . guilder)
-	   (  252 . block)
-	   (  256 . longminus)
-	   (65388 . reset)
-	   (65389 . system)
-	   (65390 . user)
-	   (65391 . clearline)
-	   (65392 . insertline)
-	   (65393 . deleteline)
-	   (65394 . insertchar)
-	   (65395 . deletechar)
-	   (65396 . backtab)
-	   (65397 . kp-backtab)))
-	((or (string-equal vendor "X11/NeWS - Sun Microsystems Inc.")
-	     (string-equal vendor "X Consortium"))
-	 '((392976 . f36)
-	   (392977 . f37)
-	   (393056 . req)
-	   ;; These are for Sun under X11R6
-	   (393072 . props)
-	   (393073 . front)
-	   (393074 . copy)
-	   (393075 . open)
-	   (393076 . paste)
-	   (393077 . cut)))
-	(t
-	 ;; This is used by DEC's X server.
-	 '((65280 . remove)))))
-
-
-;;;; Selections and cut buffers
-
-;;; We keep track of the last text selected here, so we can check the
-;;; current selection against it, and avoid passing back our own text
-;;; from x-cut-buffer-or-selection-value.
-(defvar x-last-selected-text nil)
-
-;;; It is said that overlarge strings are slow to put into the cut buffer.
-;;; Note this value is overridden below.
-(defvar x-cut-buffer-max 20000
-  "Max number of characters to put in the cut buffer.")
-
-(defvar x-select-enable-clipboard nil
-  "Non-nil means cutting and pasting uses the clipboard.
-This is in addition to the primary selection.")
-
-;;; Make TEXT, a string, the primary X selection.
-;;; Also, set the value of X cut buffer 0, for backward compatibility
-;;; with older X applications.
-;;; gildea@lcs.mit.edu says it's not desirable to put kills
-;;; in the clipboard.
-(defun x-select-text (text &optional push)
-  ;; Don't send the cut buffer too much text.
-  ;; It becomes slow, and if really big it causes errors.
-  (if (< (length text) x-cut-buffer-max)
-      (x-set-cut-buffer text push)
-    (x-set-cut-buffer "" push))
-  (x-set-selection 'PRIMARY text)
-  (if x-select-enable-clipboard
-      (x-set-selection 'CLIPBOARD text))
-  (setq x-last-selected-text text))
-
-;;; Return the value of the current X selection.
-;;; Consult the selection, then the cut buffer.  Treat empty strings
-;;; as if they were unset.
-(defun x-cut-buffer-or-selection-value ()
-  (let (text)
-
-    ;; Don't die if x-get-selection signals an error.
-    (condition-case c
-	(setq text (x-get-selection 'PRIMARY))
-      (error nil))
-    (if (string= text "") (setq text nil))
-
-    (if x-select-enable-clipboard
-	(condition-case c
-	    (setq text (x-get-selection 'CLIPBOARD))
-	  (error nil)))
-    (if (string= text "") (setq text nil))
-    (or text (setq text (x-get-cut-buffer 0)))
-    (if (string= text "") (setq text nil))
-
-    (cond
-     ((not text) nil)
-     ((eq text x-last-selected-text) nil)
-     ((string= text x-last-selected-text)
-      ;; Record the newer string, so subsequent calls can use the `eq' test.
-      (setq x-last-selected-text text)
-      nil)
-     (t
-      (setq x-last-selected-text text)))))
-
-
-;;; Do the actual X Windows setup here; the above code just defines
-;;; functions and variables that we use now.
-
-(setq command-line-args (x-handle-args command-line-args))
-
-;;; Make sure we have a valid resource name.
-(or (stringp x-resource-name)
-    (let (i)
-      (setq x-resource-name (invocation-name))
-
-      ;; Change any . or * characters in x-resource-name to hyphens,
-      ;; so as not to choke when we use it in X resource queries.
-      (while (setq i (string-match "[.*]" x-resource-name))
-	(aset x-resource-name i ?-))))
-
-;; For the benefit of older Emacses (19.27 and earlier) that are sharing
-;; the same lisp directory, don't pass the third argument unless we seem
-;; to have the multi-display support.
-(if (fboundp 'x-close-connection)
-    (x-open-connection (or x-display-name
-			   (setq x-display-name (getenv "DISPLAY")))
-		       x-command-line-resources
-		       ;; Exit Emacs with fatal error if this fails.
-		       t)
-  (x-open-connection (or x-display-name
-			 (setq x-display-name (getenv "DISPLAY")))
-		     x-command-line-resources))
-
-(setq frame-creation-function 'x-create-frame-with-faces)
-
-(setq x-cut-buffer-max (min (- (/ (x-server-max-request-size) 2) 100)
-			    x-cut-buffer-max))
-
-;; Sun expects the menu bar cut and paste commands to use the clipboard.
-;; This has ,? to match both on Sunos and on Solaris.
-(if (string-match "Sun Microsystems,? Inc\\."
-		  (x-server-vendor))
-    (menu-bar-enable-clipboard))
-
-;; Apply a geometry resource to the initial frame.  Put it at the end
-;; of the alist, so that anything specified on the command line takes
-;; precedence.
-(let* ((res-geometry (x-get-resource "geometry" "Geometry"))
-       parsed)
-  (if res-geometry
-      (progn
-	(setq parsed (x-parse-geometry res-geometry))
-	;; If the resource specifies a position,
-	;; call the position and size "user-specified".
-	(if (or (assq 'top parsed) (assq 'left parsed))
-	    (setq parsed (cons '(user-position . t)
-			       (cons '(user-size . t) parsed))))
-	;; All geometry parms apply to the initial frame.
-	(setq initial-frame-alist (append initial-frame-alist parsed))
-	;; The size parms apply to all frames.
-	(if (assq 'height parsed)
-	    (setq default-frame-alist
-		  (cons (cons 'height (cdr (assq 'height parsed)))
-			default-frame-alist)))
-	(if (assq 'width parsed)
-	    (setq default-frame-alist
-		  (cons (cons 'width (cdr (assq 'width parsed)))
-			default-frame-alist))))))
-
-;; Check the reverseVideo resource.
-(let ((case-fold-search t))
-  (let ((rv (x-get-resource "reverseVideo" "ReverseVideo")))
-    (if (and rv
-	     (string-match "^\\(true\\|yes\\|on\\)$" rv))
-	(setq default-frame-alist
-	      (cons '(reverse . t) default-frame-alist)))))
-
-;; Set x-selection-timeout, measured in milliseconds.
-(let ((res-selection-timeout
-       (x-get-resource "selectionTimeout" "SelectionTimeout")))
-  (setq x-selection-timeout 20000)
-  (if res-selection-timeout
-      (setq x-selection-timeout (string-to-number res-selection-timeout))))
-
-(defun x-win-suspend-error ()
-  (error "Suspending an emacs running under X makes no sense"))
-(add-hook 'suspend-hook 'x-win-suspend-error)
-
-;;; Arrange for the kill and yank functions to set and check the clipboard.
-(setq interprogram-cut-function 'x-select-text)
-(setq interprogram-paste-function 'x-cut-buffer-or-selection-value)
-
-;;; Turn off window-splitting optimization; X is usually fast enough
-;;; that this is only annoying.
-(setq split-window-keep-point t)
-
-;; Don't show the frame name; that's redundant with X.
-(setq-default mode-line-buffer-identification '("Emacs: %12b"))
-
-;;; Motif direct handling of f10 wasn't working right,
-;;; So temporarily we've turned it off in lwlib-Xm.c
-;;; and turned the Emacs f10 back on.
-;;; ;; Motif normally handles f10 itself, so don't try to handle it a second time.
-;;; (if (featurep 'motif)
-;;;     (global-set-key [f10] 'ignore))
-
-;;; x-win.el ends here
diff --git a/lisp/term/xterm.el b/lisp/term/xterm.el
deleted file mode 100644
index 05b5b7ba0fd..00000000000
--- a/lisp/term/xterm.el
+++ /dev/null
@@ -1,47 +0,0 @@
-;;; xterm.el --- define function key sequences for xterm
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; Author: FSF
-;; Keywords: terminals
-
-;; 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.
-
-;;;; Code:
-
-(define-key function-key-map "\e[A" [up])
-(define-key function-key-map "\e[B" [down])
-(define-key function-key-map "\e[C" [right])
-(define-key function-key-map "\e[D" [left])
-(define-key function-key-map "\e[2~" [insert])
-(define-key function-key-map "\e[4~" [select])
-(define-key function-key-map "\e[5~" [prior])
-(define-key function-key-map "\e[6~" [next])
-(define-key function-key-map "\e[11~" [f1])
-(define-key function-key-map "\e[12~" [f2])
-(define-key function-key-map "\e[13~" [f3])
-(define-key function-key-map "\e[14~" [f4])
-(define-key function-key-map "\e[15~" [f5])
-(define-key function-key-map "\e[17~" [f6])
-(define-key function-key-map "\e[18~" [f7])
-(define-key function-key-map "\e[19~" [f8])
-(define-key function-key-map "\e[20~" [f9])
-(define-key function-key-map "\e[21~" [f10])
-(define-key function-key-map "\e[23~" [f11])
-(define-key function-key-map "\e[24~" [f12])
-(define-key function-key-map "\e[29~" [print])
diff --git a/lisp/terminal.el b/lisp/terminal.el
deleted file mode 100644
index 8f8da8a14f6..00000000000
--- a/lisp/terminal.el
+++ /dev/null
@@ -1,1320 +0,0 @@
-;;; terminal.el --- terminal emulator for GNU Emacs.
-
-;; Copyright (C) 1986,87,88,89,93,94 Free Software Foundation, Inc.
-
-;; Author: Richard Mlynarik <mly@eddie.mit.edu>
-;; Maintainer: FSF
-;; Keywords: comm, terminals
-
-;; 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 has been censored by the Communications Decency Act.
-;;; That law was passed under the guise of a ban on pornography, but
-;;; it bans far more than that.  This file did not contain pornography,
-;;; but it was censored nonetheless.
-
-;;; For information on US government censorship of the Internet, and
-;;; what you can do to bring back freedom of the press, see the web
-;;; site http://www.vtw.org/
-
-;;; Code:
-
-;;>>TODO
-;;>> ** Nothing can be done about emacs' meta-lossage **
-;;>>  (without redoing keymaps `sanely' -- ask Mly for details)
-
-;;>> One probably wants to do setenv MORE -c when running with
-;;>>   more-processing enabled.
-
-(require 'ehelp)
-
-(defvar terminal-escape-char ?\C-^
-  "*All characters except for this are passed verbatim through the
-terminal-emulator.  This character acts as a prefix for commands
-to the emulator program itself.  Type this character twice to send
-it through the emulator.  Type ? after typing it for a list of
-possible commands.
-This variable is local to each terminal-emulator buffer.")
-
-(defvar terminal-scrolling t ;;>> Setting this to T sort-of defeats my whole aim in writing this package...
-  "*If non-nil, the terminal-emulator will losingly `scroll' when output occurs
-past the bottom of the screen.  If nil, output will win and `wrap' to the top
-of the screen.
-This variable is local to each terminal-emulator buffer.")
-
-(defvar terminal-more-processing t
-  "*If non-nil, do more-processing.
-This variable is local to each terminal-emulator buffer.")
-
-;; If you are the sort of loser who uses scrolling without more breaks
-;; and expects to actually see anything, you should probably set this to
-;; around 400
-(defvar terminal-redisplay-interval 5000
-  "*Maximum number of characters which will be processed by the
-terminal-emulator before a screen redisplay is forced.
-Set this to a large value for greater throughput,
-set it smaller for more frequent updates but overall slower
-performance.")
-
-(defvar terminal-more-break-insertion
-  "*** More break -- Press space to continue ***")
-
-(defvar terminal-meta-map nil)
-(if terminal-meta-map
-    nil
-  (let ((map (make-sparse-keymap)))
-    (define-key map [t] 'te-pass-through)
-    (setq terminal-meta-map map)))
-
-(defvar terminal-map nil)
-(if terminal-map
-    nil
-  (let ((map (make-sparse-keymap)))
-    (define-key map [t] 'te-pass-through)
-    (define-key map [switch-frame] 'handle-switch-frame)
-    (define-key map "\e" terminal-meta-map)
-    ;(define-key map "\C-l"
-    ;  '(lambda () (interactive) (te-pass-through) (redraw-display)))
-    (setq terminal-map map)))
-
-(defvar terminal-escape-map nil)
-(if terminal-escape-map
-    nil
-  (let ((map (make-sparse-keymap)))
-    (define-key map [t] 'undefined)
-    (let ((s "0"))
-      (while (<= (aref s 0) ?9)
-	(define-key map s 'digit-argument)
-	(aset s 0 (1+ (aref s 0)))))
-    (define-key map "b" 'switch-to-buffer)
-    (define-key map "o" 'other-window)
-    (define-key map "e" 'te-set-escape-char)
-    (define-key map "\C-l" 'redraw-display)
-    (define-key map "\C-o" 'te-flush-pending-output)
-    (define-key map "m" 'te-toggle-more-processing)
-    (define-key map "x" 'te-escape-extended-command)
-    ;;>> What use is this?  Why is it in the default terminal-emulator map?
-    (define-key map "w" 'te-edit)
-    (define-key map "?" 'te-escape-help)
-    (define-key map (char-to-string help-char) 'te-escape-help)
-    (setq terminal-escape-map map)))
-
-(defvar te-escape-command-alist nil)
-(if te-escape-command-alist
-    nil
-  (setq te-escape-command-alist
-	'(("Set Escape Character" . te-set-escape-char)
-          ;;>> What use is this?  Why is it in the default terminal-emulator map?
-	  ("Edit" . te-edit)
-	  ("Refresh" . redraw-display)
-	  ("Record Output" . te-set-output-log)
-	  ("Photo" . te-set-output-log)
-	  ("Tofu" . te-tofu) ;; confuse the uninitiated
-	  ("Stuff Input" . te-stuff-string)
-	  ("Flush Pending Output" . te-flush-pending-output)
-	  ("Enable More Processing" . te-enable-more-processing)
-	  ("Disable More Processing" . te-disable-more-processing)
-	  ("Scroll at end of page" . te-do-scrolling)
-	  ("Wrap at end of page" . te-do-wrapping)
-	  ("Switch To Buffer" . switch-to-buffer)
-	  ("Other Window" . other-window)
-	  ("Kill Buffer" . kill-buffer)
-	  ("Help" . te-escape-help)
-	  ("Set Redisplay Interval" . te-set-redisplay-interval)
-	  )))
-
-(defvar terminal-more-break-map nil)
-(if terminal-more-break-map
-    nil
-  (let ((map (make-sparse-keymap)))
-    (define-key map [t] 'te-more-break-unread)
-    (define-key map (char-to-string help-char) 'te-more-break-help)
-    (define-key map " " 'te-more-break-resume)
-    (define-key map "\C-l" 'redraw-display)
-    (define-key map "\C-o" 'te-more-break-flush-pending-output)
-    ;;>>> this isn't right
-    ;(define-key map "\^?" 'te-more-break-flush-pending-output) ;DEL
-    (define-key map "\r" 'te-more-break-advance-one-line)
-
-    (setq terminal-more-break-map map)))
-
-
-;;; Pacify the byte compiler
-(defvar te-process nil)
-(defvar te-log-buffer nil)
-(defvar te-height nil)
-(defvar te-width nil)
-(defvar te-more-count nil)
-(defvar te-redisplay-count nil)
-(defvar te-pending-output nil)
-(defvar te-saved-point)
-(defvar te-more-old-point nil)
-(defvar te-more-old-local-map nil)
-(defvar te-more-old-filter nil)
-(defvar te-more-old-mode-line-format nil)
-(defvar te-pending-output-info nil)
-
-;; Required to support terminfo systems
-(defconst te-terminal-name-prefix "emacs-em"
-  "Prefix used for terminal type names for Terminfo.")
-(defconst te-terminfo-directory "/tmp/emacs-terminfo/"
-  "Directory used for run-time terminal definition files for Terminfo.")
-(defvar te-terminal-name nil)
-
-;;;;  escape map
-
-(defun te-escape ()
-  (interactive)
-  (let (s
-        (local (current-local-map))
-        (global (current-global-map)))
-    (unwind-protect
-        (progn
-          (use-global-map terminal-escape-map)
-          (use-local-map terminal-escape-map)
-          (setq s (read-key-sequence
-                    (if current-prefix-arg
-                        (format "Emacs Terminal escape> %d "
-                                (prefix-numeric-value current-prefix-arg))
-                        "Emacs Terminal escape> "))))
-      (use-global-map global)
-      (use-local-map local))
-
-    (message "")
-
-    (cond
-     ;;  Certain keys give vector notation, like [escape] when
-     ;;  you hit esc key...
-     ((and (stringp s)
-	   (string= s (make-string 1 terminal-escape-char)))
-      (setq last-command-char terminal-escape-char)
-      (let ((terminal-escape-char -259))
-	(te-pass-through)))
-
-     ((setq s (lookup-key terminal-escape-map s))
-      (call-interactively s)))
-
-    ))
-
-
-(defun te-escape-help ()
-  "Provide help on commands available after terminal-escape-char is typed."
-  (interactive)
-  (message "Terminal emulator escape help...")
-  (let ((char (single-key-description terminal-escape-char)))
-    (with-electric-help
-      (function (lambda ()
-	 (princ (format "Terminal-emulator escape, invoked by \"%s\"
-Type \"%s\" twice to send a single \"%s\" through.
-
-Other chars following \"%s\" are interpreted as follows:\n"
-			char char char char))
-
-	 (princ (substitute-command-keys "\\{terminal-escape-map}\n"))
-	 (princ (format "\nSubcommands of \"%s\" (%s)\n"
-			(where-is-internal 'te-escape-extended-command
-					   terminal-escape-map t)
-			'te-escape-extended-command))
-	 (let ((l (if (fboundp 'sortcar)
-		      (sortcar (copy-sequence te-escape-command-alist)
-			       'string<)
-		      (sort (copy-sequence te-escape-command-alist)
-			    (function (lambda (a b)
-                              (string< (car a) (car b))))))))
-	   (while l
-	     (let ((doc (or (documentation (cdr (car l)))
-			    "Not documented")))
-	       (if (string-match "\n" doc)
-		   ;; just use first line of documentation
-		   (setq doc (substring doc 0 (match-beginning 0))))
-	       (princ "  \"")
-	       (princ (car (car l)))
-	       (princ "\":\n     ")
-	       (princ doc)
-	       (write-char ?\n))
-	     (setq l (cdr l))))
-	 nil)))))
-
-
-
-(defun te-escape-extended-command ()
-  (interactive)
-  (let ((c (let ((completion-ignore-case t))
-	     (completing-read "terminal command: "
-			      te-escape-command-alist
-			      nil t))))
-    (if c
-	(catch 'foo
-	  (setq c (downcase c))
-	  (let ((l te-escape-command-alist))
-	    (while l
-	      (if (string= c (downcase (car (car l))))
-		  (throw 'foo (call-interactively (cdr (car l))))
-		(setq l (cdr l)))))))))
-
-;; not used.
-(defun te-escape-extended-command-unread ()
-  (interactive)
-  (setq unread-command-events (listify-key-sequence (this-command-keys)))
-  (te-escape-extended-command))
-
-(defun te-set-escape-char (c)
-  "Change the terminal-emulator escape character."
-  (interactive "cSet escape character to: ")
-  (let ((o terminal-escape-char))
-    (message (if (= o c)
-		 "\"%s\" is the escape char"
-	         "\"%s\" is now the escape; \"%s\" passes through")
-	     (single-key-description c)
-	     (single-key-description o))
-    (setq terminal-escape-char c)))
-
-
-(defun te-stuff-string (string)
-  "Read a string to send to through the terminal emulator
-as though that string had been typed on the keyboard.
-
-Very poor man's file transfer protocol."
-  (interactive "sStuff string: ")
-  (process-send-string te-process string))
-
-(defun te-set-output-log (name)
-  "Record output from the terminal emulator in a buffer."
-  (interactive (list (if te-log-buffer
-			 nil
-		       (read-buffer "Record output in buffer: "
-				    (format "%s output-log"
-					    (buffer-name (current-buffer)))
-				    nil))))
-  (if (or (null name) (equal name ""))
-      (progn (setq te-log-buffer nil)
-	     (message "Output logging off."))
-    (if (get-buffer name)
-	nil
-      (save-excursion
-	(set-buffer (get-buffer-create name))
-	(fundamental-mode)
-	(buffer-disable-undo (current-buffer))
-	(erase-buffer)))
-    (setq te-log-buffer (get-buffer name))
-    (message "Recording terminal emulator output into buffer \"%s\""
-	     (buffer-name te-log-buffer))))
-
-(defun te-tofu ()
-  "Discontinue output log."
-  (interactive)
-  (te-set-output-log nil))
-
-
-(defun te-toggle (sym arg)
-  (set sym (cond ((not (numberp arg)) arg)
-		 ((= arg 1) (not (symbol-value sym)))
-		 ((< arg 0) nil)
-		 (t t))))
-
-(defun te-toggle-more-processing (arg)
-  (interactive "p")
-  (message (if (te-toggle 'terminal-more-processing arg)
-	       "More processing on" "More processing off"))
-  (if terminal-more-processing (setq te-more-count -1)))
-
-(defun te-toggle-scrolling (arg)
-  (interactive "p")
-  (message (if (te-toggle 'terminal-scrolling arg)
-	       "Scroll at end of page" "Wrap at end of page")))
-
-(defun te-enable-more-processing ()
-  "Enable ** MORE ** processing"
-  (interactive)
-  (te-toggle-more-processing t))
-
-(defun te-disable-more-processing ()
-  "Disable ** MORE ** processing"
-  (interactive)
-  (te-toggle-more-processing nil))
-
-(defun te-do-scrolling ()
-  "Scroll at end of page (yuck)"
-  (interactive)
-  (te-toggle-scrolling t))
-
-(defun te-do-wrapping ()
-  "Wrap to top of window at end of page"
-  (interactive)
-  (te-toggle-scrolling nil))
-
-
-(defun te-set-redisplay-interval (arg)
-  "Set the maximum interval (in output characters) between screen updates.
-Set this number to large value for greater throughput,
-set it smaller for more frequent updates (but overall slower performance."
-  (interactive "NMax number of output chars between redisplay updates: ")
-  (setq arg (max arg 1))
-  (setq terminal-redisplay-interval arg
-	te-redisplay-count 0))
-
-;;;; more map
-
-;; every command -must- call te-more-break-unwind
-;; or grave lossage will result
-
-(put 'te-more-break-unread 'suppress-keymap t)
-(defun te-more-break-unread ()
-  (interactive)
-  (if (eq last-input-char terminal-escape-char)
-      (call-interactively 'te-escape)
-    (message "Continuing from more break (\"%s\" typed, %d chars output pending...)"
-	     (single-key-description last-input-char)
-	     (te-pending-output-length))
-    (setq te-more-count 259259)
-    (te-more-break-unwind)
-    (let ((terminal-more-processing nil))
-      (te-pass-through))))
-
-(defun te-more-break-resume ()
-  "Proceed past the **MORE** break,
-allowing the next page of output to appear"
-  (interactive)
-  (message "Continuing from more break")
-  (te-more-break-unwind))
-
-(defun te-more-break-help ()
-  "Provide help on commands available in a terminal-emulator **MORE** break"
-  (interactive)
-  (message "Terminal-emulator more break help...")
-  (sit-for 0)
-  (with-electric-help
-    (function (lambda ()
-      (princ "Terminal-emulator more break.\n\n")
-      (princ (format "Type \"%s\" (te-more-break-resume)\n%s\n"
-		     (where-is-internal 'te-more-break-resume
-					terminal-more-break-map t)
-		     (documentation 'te-more-break-resume)))
-      (princ (substitute-command-keys "\\{terminal-more-break-map}\n"))
-      (princ "Any other key is passed through to the program
-running under the terminal emulator and disables more processing until
-all pending output has been dealt with.")
-      nil))))
-
-
-(defun te-more-break-advance-one-line ()
-  "Allow one more line of text to be output before doing another more break."
-  (interactive)
-  (setq te-more-count 1)
-  (te-more-break-unwind))
-
-(defun te-more-break-flush-pending-output ()
-  "Discard any output which has been received by the terminal emulator but
-not yet processed and then proceed from the more break."
-  (interactive)
-  (te-more-break-unwind)
-  (te-flush-pending-output))
-
-(defun te-flush-pending-output ()
-  "Discard any as-yet-unprocessed output which has been received by
-the terminal emulator."
-  (interactive)
-  ;; this could conceivably be confusing in the presence of
-  ;; escape-sequences spanning process-output chunks
-  (if (null (cdr te-pending-output))
-      (message "(There is no output pending)")
-    (let ((length (te-pending-output-length)))
-      (message "Flushing %d chars of pending output" length)
-      (setq te-pending-output
-	    (list 0 (format "\n*** %d chars of pending output flushed ***\n"
-			    length)))
-      (te-update-pending-output-display)
-      (te-process-output nil)
-      (sit-for 0))))
-
-
-(defun te-pass-through ()
-  "Character is passed to the program running under the terminal emulator.
-One characters is treated specially:
-the terminal escape character (normally C-^)
-lets you type a terminal emulator command."
-  (interactive)
-  (cond ((eq last-input-char terminal-escape-char)
-	 (call-interactively 'te-escape))
-	(t
-	 ;; Convert `return' to C-m, etc.
-	 (if (and (symbolp last-input-char)
-		  (get last-input-char 'ascii-character))
-	     (setq last-input-char (get last-input-char 'ascii-character)))
-	 ;; Convert meta characters to 8-bit form for transmission.
-	 (if (and (integerp last-input-char)
-		  (not (zerop (logand last-input-char ?\M-\^@))))
-	     (setq last-input-char (+ 128 (logand last-input-char 127))))
-	 ;; Now ignore all but actual characters.
-	 ;; (It ought to be possible to send through function
-	 ;; keys as character sequences if we add a description
-	 ;; to our termcap entry of what they should look like.)
-	 (if (integerp last-input-char)
-	     (progn
-	       (and terminal-more-processing (null (cdr te-pending-output))
-		    (te-set-more-count nil))
-	       (send-string te-process (make-string 1 last-input-char))
-	       (te-process-output t))
-	   (message "Function key `%s' ignored"
-		    (single-key-description last-input-char))))))
-
-
-(defun te-set-window-start ()
-  (let* ((w (get-buffer-window (current-buffer)))
-	 (h (if w (window-height w))))
-    (cond ((not w)) ; buffer not displayed
-	  ((>= h (/ (- (point) (point-min)) (1+ te-width)))
-	   ;; this is the normal case
-	   (set-window-start w (point-min)))
-	  ;; this happens if some vandal shrinks our window.
-	  ((>= h (/ (- (point-max) (point)) (1+ te-width)))
-	   (set-window-start w (- (point-max) (* h (1+ te-width)) -1)))
-	  ;; I give up.
-	  (t nil))))
-
-(defun te-pending-output-length ()
-  (let ((length (car te-pending-output))
-	(tem (cdr te-pending-output)))
-    (while tem
-      (setq length (+ length (length (car tem))) tem (cdr tem)))
-    length))
-
-;;>> What use is this terminal-edit stuff anyway?
-;;>>  If nothing else, it was written by somebody who didn't
-;;>>  competently understand the terminal-emulator...
-
-(defvar terminal-edit-map nil)
-(if terminal-edit-map
-    nil
-  (setq terminal-edit-map (make-sparse-keymap))
-  (define-key terminal-edit-map "\C-c\C-c" 'terminal-cease-edit))
-
-;; Terminal Edit mode is suitable only for specially formatted data.
-(put 'terminal-edit-mode 'mode-class 'special)
-
-(defun terminal-edit-mode ()
-  "Major mode for editing the contents of a terminal-emulator buffer.
-The editing commands are the same as in Fundamental mode,
-together with a command \\<terminal-edit-map>to return to terminal emulation: \\[terminal-cease-edit]."
-  (use-local-map terminal-edit-map)
-  (setq major-mode 'terminal-edit-mode)
-  (setq mode-name "Terminal Edit")
-  (setq mode-line-modified (default-value 'mode-line-modified))
-  (setq mode-line-process nil)
-  (run-hooks 'terminal-edit-mode-hook))
-
-(defun te-edit ()
-  "Start editing the terminal emulator buffer with ordinary Emacs commands."
-  (interactive)
-  (terminal-edit-mode)
-  (force-mode-line-update)
-  ;; Make mode line update.
-  (if (eq (key-binding "\C-c\C-c") 'terminal-cease-edit)
-      (message "Editing: Type C-c C-c to return to Terminal")
-    (message "%s"
-	     (substitute-command-keys
-	       "Editing: Type \\[terminal-cease-edit] to return to Terminal"))))
-
-(defun terminal-cease-edit ()
-  "Finish editing message; switch back to Terminal proper."
-  (interactive)
-
-  ;;>> emulator will blow out if buffer isn't exactly te-width x te-height
-  (let ((buffer-read-only nil))
-    (widen)
-    (let ((opoint (point-marker))
-          (width te-width)
-          (h (1- te-height)))
-      (goto-char (point-min))
-      (while (>= h 0)
-        (let ((p (point)))
-          (cond ((search-forward "\n" (+ p width) 'move)
-                 (forward-char -1)
-                 (insert-char ?\  (- width (- (point) p)))
-                 (forward-char 1))
-                ((eobp)
-                 (insert-char ?\  (- width (- (point) p))))
-                ((= (following-char) ?\n)
-                 (forward-char 1))
-                (t
-                 (setq p (point))
-                 (if (search-forward "\n" nil t)
-                     (delete-region p (1- (point)))
-                     (delete-region p (point-max))))))
-        (if (= h 0)
-            (if (not (eobp)) (delete-region (point) (point-max)))
-            (if (eobp) (insert ?\n)))
-        (setq h (1- h)))
-      (goto-char opoint)
-      (set-marker opoint nil nil)
-      (setq te-saved-point (point))
-      (setq te-redisplay-count 0)
-      (setq te-more-count -1)))
-
-  (setq mode-line-modified (default-value 'mode-line-modified))
-  (use-local-map terminal-map)
-  (setq major-mode 'terminal-mode)
-  (setq mode-name "terminal")
-  (setq mode-line-process '(":%s")))
-
-;;;; more break hair
-
-(defun te-more-break ()
-  (te-set-more-count t)
-  (make-local-variable 'te-more-old-point)
-  (setq te-more-old-point (point))
-  (make-local-variable 'te-more-old-local-map)
-  (setq te-more-old-local-map (current-local-map))
-  (use-local-map terminal-more-break-map)
-  (make-local-variable 'te-more-old-filter)
-  (setq te-more-old-filter (process-filter te-process))
-  (make-local-variable 'te-more-old-mode-line-format)
-  (setq te-more-old-mode-line-format mode-line-format
-	mode-line-format (list "--   **MORE**  "
-			       mode-line-buffer-identification
-			       "%-"))
-  (set-process-filter te-process
-    (function (lambda (process string)
-		(save-excursion
-		  (set-buffer (process-buffer process))
-		  (setq te-pending-output (nconc te-pending-output
-						 (list string))))
-		  (te-update-pending-output-display))))
-  (te-update-pending-output-display)
-  (if (eq (window-buffer (selected-window)) (current-buffer))
-      (message "More break "))
-  (or (eobp)
-      (null terminal-more-break-insertion)
-      (save-excursion
-	(forward-char 1)
-	(delete-region (point) (+ (point) te-width))
-	(insert terminal-more-break-insertion)))
-  (run-hooks 'terminal-more-break-hook)
-  (sit-for 0) ;get display to update
-  (throw 'te-process-output t))
-
-(defun te-more-break-unwind ()
-  (use-local-map te-more-old-local-map)
-  (set-process-filter te-process te-more-old-filter)
-  (goto-char te-more-old-point)
-  (setq mode-line-format te-more-old-mode-line-format)
-  (force-mode-line-update)
-  (let ((buffer-read-only nil))
-    (cond ((eobp))
-	  (terminal-more-break-insertion
-	   (forward-char 1)
-	   (delete-region (point)
-			  (+ (point) (length terminal-more-break-insertion)))
-	   (insert-char ?\  te-width)
-	   (goto-char te-more-old-point)))
-    (setq te-more-old-point nil)
-    (let ((te-more-count 259259))
-      (te-newline)))
-  ;(sit-for 0)
-  (te-process-output t))
-
-(defun te-set-more-count (newline)
-  (let ((line (/ (- (point) (point-min)) (1+ te-width))))
-    (if newline (setq line (1+ line)))
-    (cond ((= line te-height)
-	   (setq te-more-count te-height))
-	  ;>>>> something is strange.  Investigate this!
-	  ((= line (1- te-height))
-	   (setq te-more-count te-height))
-	  ((or (< line (/ te-height 2))
-	       (> (- te-height line) 10))
-	   ;; break at end of this page
-	   (setq te-more-count (- te-height line)))
-	  (t
-	   ;; migrate back towards top (ie bottom) of screen.
-	   (setq te-more-count (- te-height
-				  (if (> te-height 10) 2 1)))))))
-
-
-;;;; More or less straight-forward terminal escapes
-
-;; ^j, meaning `newline' to non-display programs.
-;; (Who would think of ever writing a system which doesn't understand
-;;  display terminals natively?  Un*x:  The Operating System of the Future.)
-(defun te-newline ()
-  "Move down a line, optionally do more processing, perhaps wrap/scroll,
-move to start of new line, clear to end of line."
-  (end-of-line)
-  (cond ((not terminal-more-processing))
-	((< (setq te-more-count (1- te-more-count)) 0)
-	 (te-set-more-count t))
-	((eql te-more-count 0)
-	 ;; this doesn't return
-	 (te-more-break)))
-  (if (eobp)
-      (progn
-	(delete-region (point-min) (+ (point-min) te-width))
-	(goto-char (point-min))
-	(if terminal-scrolling
-	    (progn (delete-char 1)
-		   (goto-char (point-max))
-		   (insert ?\n))))
-    (forward-char 1)
-    (delete-region (point) (+ (point) te-width)))
-  (insert-char ?\  te-width)
-  (beginning-of-line)
-  (te-set-window-start))
-
-; ^p = x+32 y+32
-(defun te-move-to-position ()
-  ;; must offset by #o40 since cretinous unix won't send a 004 char through
-  (let ((y (- (te-get-char) 32))
-	(x (- (te-get-char) 32)))
-    (if (or (> x te-width)
-	    (> y te-height))
-	()
-      (goto-char (+ (point-min) x (* y (1+ te-width))))
-      ;(te-set-window-start?)
-      ))
-  (setq te-more-count -1))
-
-
-
-;; ^p c
-(defun te-clear-rest-of-line ()
-  (save-excursion
-    (let ((n (- (point) (progn (end-of-line) (point)))))
-      (delete-region (point) (+ (point) n))
-      (insert-char ?\  (- n)))))
-
-
-;; ^p C
-(defun te-clear-rest-of-screen ()
-  (save-excursion
-    (te-clear-rest-of-line)
-    (while (progn (end-of-line) (not (eobp)))
-      (forward-char 1) (end-of-line)
-      (delete-region (- (point) te-width) (point))
-      (insert-char ?\  te-width))))
-
-
-;; ^p ^l
-(defun te-clear-screen ()
-  ;; regenerate buffer to compensate for (nonexistent!!) bugs.
-  (erase-buffer)
-  (let ((i 0))
-    (while (< i te-height)
-      (setq i (1+ i))
-      (insert-char ?\  te-width)
-      (insert ?\n)))
-  (delete-region (1- (point-max)) (point-max))
-  (goto-char (point-min))
-  (setq te-more-count -1))
-
-
-;; ^p ^o count+32
-(defun te-insert-lines ()
-  (if (not (bolp))
-      ();(error "fooI")
-    (save-excursion
-      (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
-	     (n (min (- (te-get-char) ?\ ) line))
-	     (i 0))
-	(delete-region (- (point-max) (* n (1+ te-width))) (point-max))
-	(if (eql (point) (point-max)) (insert ?\n))
-	(while (< i n)
-	  (setq i (1+ i))
-	  (insert-char ?\  te-width)
-	  (or (eql i line) (insert ?\n))))))
-  (setq te-more-count -1))
-
-
-;; ^p ^k count+32
-(defun te-delete-lines ()
-  (if (not (bolp))
-      ();(error "fooD")
-    (let* ((line (- te-height (/ (- (point) (point-min)) (1+ te-width)) -1))
-	   (n (min (- (te-get-char) ?\ ) line))
-	   (i 0))
-      (delete-region (point)
-		     (min (+ (point) (* n (1+ te-width))) (point-max)))
-      (save-excursion
-	(goto-char (point-max))
-	(while (< i n)
-	  (setq i (1+ i))
-	  (insert-char ?\  te-width)
-	  (or (eql i line) (insert ?\n))))))
-  (setq te-more-count -1))
-
-;; ^p ^a
-(defun te-beginning-of-line ()
-  (beginning-of-line))
-
-;; ^p ^b
-(defun te-backward-char ()
-  (if (not (bolp))
-      (backward-char 1)))
-
-;; ^p ^f
-(defun te-forward-char ()
-  (if (not (eolp))
-      (forward-char 1)))
-
-
-;; 0177
-(defun te-delete ()
-  (if (bolp)
-      ()
-    (delete-region (1- (point)) (point))
-    (insert ?\ )
-    (forward-char -1)))
-
-;; ^p ^g
-(defun te-beep ()
-  (beep))
-
-
-;; ^p _ count+32
-(defun te-insert-spaces ()
-  (let* ((p (point))
-	 (n (min (- (te-get-char) 32)
-		 (- (progn (end-of-line) (point)) p))))
-    (if (<= n 0)
-	nil
-      (delete-char (- n))
-      (goto-char p)
-      (insert-char ?\  n))
-    (goto-char p)))
-
-;; ^p d count+32  (should be ^p ^d but cretinous un*x won't send ^d chars!!!)
-(defun te-delete-char ()
-  (let* ((p (point))
-	 (n (min (- (te-get-char) 32)
-		 (- (progn (end-of-line) (point)) p))))
-    (if (<= n 0)
-	nil
-      (insert-char ?\  n)
-      (goto-char p)
-      (delete-char n))
-    (goto-char p)))
-
-
-
-;; disgusting unix-required excrement
-;;  Are we living twenty years in the past yet?
-
-(defun te-losing-unix ()
-  nil)
-
-;; ^i
-(defun te-output-tab ()
-  (let* ((p (point))
-	 (x (- p (progn (beginning-of-line) (point))))
-	 (l (min (- 8 (logand x 7))
-		 (progn (end-of-line) (- (point) p)))))
-    (goto-char (+ p l))))
-
-;; ^p ^j
-;; Handle the `do' or `nl' termcap capability.
-;;>> I am not sure why this broken, obsolete, capability is here.
-;;>> Perhaps it is for VIle.  No comment was made about why it
-;;>> was added (in "Sun Dec  6 01:22:27 1987  Richard Stallman")
-(defun te-down-vertically-or-scroll ()
-  "Move down a line vertically, or scroll at bottom."
-  (let ((column (current-column)))
-    (end-of-line)
-    (if (eobp)
-	(progn
-	  (delete-region (point-min) (+ (point-min) te-width))
-	  (goto-char (point-min))
-	  (delete-char 1)
-	  (goto-char (point-max))
-	  (insert ?\n)
-	  (insert-char ?\  te-width)
-	  (beginning-of-line))
-      (forward-line 1))
-    (move-to-column column))
-  (te-set-window-start))
-
-;; Also:
-;;  ^m => beginning-of-line (for which it -should- be using ^p ^a, right?!!)
-;;  ^g => te-beep (for which it should use ^p ^g)
-;;  ^h => te-backward-char (for which it should use ^p ^b)
-
-
-
-(defun te-filter (process string)
-  (let* ((obuf (current-buffer)))
-    ;; can't use save-excursion, as that preserves point, which we don't want
-    (unwind-protect
-	(progn
-	  (set-buffer (process-buffer process))
-	  (goto-char te-saved-point)
-	  (and (bufferp te-log-buffer)
-	       (if (null (buffer-name te-log-buffer))
-		   ;; killed
-		   (setq te-log-buffer nil)
-		 (set-buffer te-log-buffer)
-		 (goto-char (point-max))
-		 (insert-before-markers string)
-		 (set-buffer (process-buffer process))))
-	  (setq te-pending-output (nconc te-pending-output (list string)))
-	  (te-update-pending-output-display)
-	  (te-process-output (eq (current-buffer)
-				 (window-buffer (selected-window))))
-	  (set-buffer (process-buffer process))
-	  (setq te-saved-point (point)))
-      (set-buffer obuf))))
-
-;; (A version of the following comment which might be distractingly offensive
-;; to some readers has been moved to term-nasty.el.)
-;; unix lacks ITS-style tty control...
-(defun te-process-output (preemptible)
-  ;;>> There seems no good reason to ever disallow preemption
-  (setq preemptible t)
-  (catch 'te-process-output
-    (let ((buffer-read-only nil)
-	  (string nil) ostring start char (matchpos nil))
-      (while (cdr te-pending-output)
-	(setq ostring string
-	      start (car te-pending-output)
-	      string (car (cdr te-pending-output))
-	      char (aref string start))
-	(if (eql (setq start (1+ start)) (length string))
-	    (progn (setq te-pending-output
-			   (cons 0 (cdr (cdr te-pending-output)))
-			 start 0
-			 string (car (cdr te-pending-output)))
-		   (te-update-pending-output-display))
-	    (setcar te-pending-output start))
-	(if (and (> char ?\037) (< char ?\377))
-	    (cond ((eolp)
-		   ;; unread char
-		   (if (eql start 0)
-		       (setq te-pending-output
-			     (cons 0 (cons (make-string 1 char)
-					   (cdr te-pending-output))))
-		       (setcar te-pending-output (1- start)))
-		   (te-newline))
-		  ((null string)
-		   (delete-char 1) (insert char)
-		   (te-redisplay-if-necessary 1))
-		  (t
-		   (let ((end (or (and (eq ostring string) matchpos)
-				  (setq matchpos (string-match
-						   "[\000-\037\177-\377]"
-						   string start))
-				  (length string))))
-		     (delete-char 1) (insert char)
-		     (setq char (point)) (end-of-line)
-		     (setq end (min end (+ start (- (point) char))))
-		     (goto-char char)
-		     (if (eql end matchpos) (setq matchpos nil))
-		     (delete-region (point) (+ (point) (- end start)))
-		     (insert (if (and (eql start 0)
-				      (eql end (length string)))
-				 string
-			         (substring string start end)))
-		     (if (eql end (length string))
-			 (setq te-pending-output
-			       (cons 0 (cdr (cdr te-pending-output))))
-		         (setcar te-pending-output end))
-		     (te-redisplay-if-necessary (1+ (- end start))))))
-	  ;; I suppose if I split the guts of this out into a separate
-	  ;;  function we could trivially emulate different terminals
-	  ;; Who cares in any case?  (Apart from stupid losers using rlogin)
-	  (funcall
-	    (if (eql char ?\^p)
-	        (or (cdr (assq (te-get-char)
-			       '((?= . te-move-to-position)
-				 (?c . te-clear-rest-of-line)
-				 (?C . te-clear-rest-of-screen)
-				 (?\C-o . te-insert-lines)
-				 (?\C-k . te-delete-lines)
-				 ;; not necessary, but help sometimes.
-				 (?\C-a . te-beginning-of-line)
-				 (?\C-b . te-backward-char)
-				 ;; should be C-d, but un*x
-				 ;;  pty's won't send \004 through!
-                                 ;; Can you believe this?
-				 (?d . te-delete-char)
-				 (?_ . te-insert-spaces)
-				 ;; random
-				 (?\C-f . te-forward-char)
-				 (?\C-g . te-beep)
-				 (?\C-j . te-down-vertically-or-scroll)
-				 (?\C-l . te-clear-screen)
-				 )))
-		    'te-losing-unix)
-	        (or (cdr (assq char
-			       '((?\C-j . te-newline)
-				 (?\177 . te-delete)
-				 ;; Did I ask to be sent these characters?
-				 ;; I don't remember doing so, either.
-				 ;; (Perhaps some operating system or
-				 ;; other is completely incompetent...)
-				 (?\C-m . te-beginning-of-line)
-				 (?\C-g . te-beep)
-				 (?\C-h . te-backward-char)
-				 (?\C-i . te-output-tab))))
-		    'te-losing-unix)))
-	  (te-redisplay-if-necessary 1))
-	(and preemptible
-	     (input-pending-p)
-	     ;; preemptible output!  Oh my!!
-	     (throw 'te-process-output t)))))
-  ;; We must update window-point in every window displaying our buffer
-  (let* ((s (selected-window))
-	 (w s))
-    (while (not (eq s (setq w (next-window w))))
-      (if (eq (window-buffer w) (current-buffer))
-	  (set-window-point w (point))))))
-
-(defun te-get-char ()
-  (if (cdr te-pending-output)
-      (let ((start (car te-pending-output))
-	    (string (car (cdr te-pending-output))))
-	(prog1 (aref string start)
-	  (if (eql (setq start (1+ start)) (length string))
-	      (setq te-pending-output (cons 0 (cdr (cdr te-pending-output))))
-	      (setcar te-pending-output start))))
-    (catch 'char
-      (let ((filter (process-filter te-process)))
-	(unwind-protect
-	    (progn
-	      (set-process-filter te-process
-				  (function (lambda (p s)
-                                    (or (eql (length s) 1)
-                                        (setq te-pending-output (list 1 s)))
-                                    (throw 'char (aref s 0)))))
-	      (accept-process-output te-process))
-	  (set-process-filter te-process filter))))))
-
-
-(defun te-redisplay-if-necessary (length)
-  (and (<= (setq te-redisplay-count (- te-redisplay-count length)) 0)
-       (eq (current-buffer) (window-buffer (selected-window)))
-       (waiting-for-user-input-p)
-       (progn (te-update-pending-output-display)
-	      (sit-for 0)
-	      (setq te-redisplay-count terminal-redisplay-interval))))
-
-(defun te-update-pending-output-display ()
-  (if (null (cdr te-pending-output))
-      (setq te-pending-output-info "")
-    (let ((length (te-pending-output-length)))
-      (if (< length 1500)
-	  (setq te-pending-output-info "")
-	(setq te-pending-output-info (format "(%dK chars output pending) "
-					     (/ (+ length 512) 1024))))))
-  (force-mode-line-update))
-
-
-(defun te-sentinel (process message)
-  (cond ((eq (process-status process) 'run))
-	((null (buffer-name (process-buffer process)))) ;deleted
-	(t (let ((b (current-buffer)))
-	     (save-excursion
-	       (set-buffer (process-buffer process))
-	       (setq buffer-read-only nil)
-	       (fundamental-mode)
-	       (goto-char (point-max))
-	       (delete-blank-lines)
-	       (delete-horizontal-space)
-	       (insert "\n*******\n" message "*******\n"))
-	     (if (and (eq b (process-buffer process))
-		      (waiting-for-user-input-p))
-		 (progn (goto-char (point-max))
-			(recenter -1)))))))
-
-(defvar te-stty-string "stty -nl erase '^?' kill '^u' intr '^c' echo pass8"
-  "Shell command to set terminal modes for terminal emulator.")
-;; This used to have `new' in it, but that loses outside BSD
-;; and it's apparently not needed in BSD.
-
-(defvar explicit-shell-file-name nil
-  "*If non-nil, is file name to use for explicitly requested inferior shell.")
-
-;;;###autoload
-(defun terminal-emulator (buffer program args &optional width height)
-  "Under a display-terminal emulator in BUFFER, run PROGRAM on arguments ARGS.
-ARGS is a list of argument-strings.  Remaining arguments are WIDTH and HEIGHT.
-BUFFER's contents are made an image of the display generated by that program,
-and any input typed when BUFFER is the current Emacs buffer is sent to that
-program an keyboard input.
-
-Interactively, BUFFER defaults to \"*terminal*\" and PROGRAM and ARGS
-are parsed from an input-string using your usual shell.
-WIDTH and HEIGHT are determined from the size of the current window
--- WIDTH will be one less than the window's width, HEIGHT will be its height.
-
-To switch buffers and leave the emulator, or to give commands
-to the emulator itself (as opposed to the program running under it),
-type Control-^.  The following character is an emulator command.
-Type Control-^ twice to send it to the subprogram.
-This escape character may be changed using the variable `terminal-escape-char'.
-
-`Meta' characters may not currently be sent through the terminal emulator.
-
-Here is a list of some of the variables which control the behaviour
-of the emulator -- see their documentation for more information:
-terminal-escape-char, terminal-scrolling, terminal-more-processing,
-terminal-redisplay-interval.
-
-This function calls the value of terminal-mode-hook if that exists
-and is non-nil after the terminal buffer has been set up and the
-subprocess started."
-  (interactive
-    (cons (save-excursion
-	    (set-buffer (get-buffer-create "*terminal*"))
-	    (buffer-name (if (or (not (boundp 'te-process))
-				 (null te-process)
-				 (not (eq (process-status te-process)
-					  'run)))
-			     (current-buffer)
-			   (generate-new-buffer "*terminal*"))))
-	  (append
-	    (let* ((default-s
-		     ;; Default shell is same thing M-x shell uses.
-		     (or explicit-shell-file-name
-			 (getenv "ESHELL")
-			 (getenv "SHELL")
-			 "/bin/sh"))
-		   (s (read-string
-		       (format "Run program in emulator: (default %s) "
-			       default-s))))
-	      (if (equal s "")
-		  (list default-s '())
-		(te-parse-program-and-args s))))))
-  (switch-to-buffer buffer)
-  (if (null width) (setq width (- (window-width (selected-window)) 1)))
-  (if (null height) (setq height (- (window-height (selected-window)) 1)))
-  (terminal-mode)
-  (setq te-width width te-height height)
-  (setq te-terminal-name (concat te-terminal-name-prefix te-width
-				 te-height))
-  (setq mode-line-buffer-identification
-	(list (format "Emacs terminal %dx%d: %%b  " te-width te-height)
-	      'te-pending-output-info))
-  (let ((buffer-read-only nil))
-    (te-clear-screen))
-  (let (process)
-    (while (setq process (get-buffer-process (current-buffer)))
-      (if (y-or-n-p (format "Kill process %s? " (process-name process)))
-	  (delete-process process)
-	(error "Process %s not killed" (process-name process)))))
-  (condition-case err
-      (let ((process-environment
-	     (cons (concat "TERM=" te-terminal-name)
-		   (cons (concat "TERMCAP=" (te-create-termcap))
-			 (cons (concat "TERMINFO=" (te-create-terminfo))
-			       process-environment)))))
-	(setq te-process
-	      (start-process "terminal-emulator" (current-buffer)
-			     "/bin/sh" "-c"
-			     ;; Yuck!!! Start a shell to set some terminal
-			     ;; control characteristics.  Then start the
-			     ;; "env" program to setup the terminal type
-			     ;; Then finally start the program we wanted.
-			     (format "%s; exec %s"
-				     te-stty-string
-				     (mapconcat 'te-quote-arg-for-sh
-						(cons program args) " "))))
-	(set-process-filter te-process 'te-filter)
-	(set-process-sentinel te-process 'te-sentinel))
-    (error (fundamental-mode)
-	   (signal (car err) (cdr err))))
-  (setq inhibit-quit t)			;sport death
-  (use-local-map terminal-map)
-  (run-hooks 'terminal-mode-hook)
-  (message "Entering emacs terminal-emulator...  Type %s %s for help"
-	   (single-key-description terminal-escape-char)
-	   (mapconcat 'single-key-description
-		      (where-is-internal 'te-escape-help terminal-escape-map t)
-		      " ")))
-
-
-(defun te-parse-program-and-args (s)
-  (cond ((string-match "\\`\\([-a-zA-Z0-9+=_.@/:]+[ \t]*\\)+\\'" s)
-	 (let ((l ()) (p 0))
-	   (while p
-	     (setq l (cons (if (string-match
-				"\\([-a-zA-Z0-9+=_.@/:]+\\)\\([ \t]+\\)*"
-				s p)
-			       (prog1 (substring s p (match-end 1))
-				 (setq p (match-end 0))
-				 (if (eql p (length s)) (setq p nil)))
-			       (prog1 (substring s p)
-				 (setq p nil)))
-			   l)))
-	   (setq l (nreverse l))
-	   (list (car l) (cdr l))))
-	((and (string-match "[ \t]" s) (not (file-exists-p s)))
-	 (list shell-file-name (list "-c" (concat "exec " s))))
-	(t (list s ()))))
-
-(put 'terminal-mode 'mode-class 'special)
-;; This is only separated out from function terminal-emulator
-;; to keep the latter a little more manageable.
-(defun terminal-mode ()
-  "Set up variables for use with the terminal-emulator.
-One should not call this -- it is an internal function
-of the terminal-emulator"
-  (kill-all-local-variables)
-  (buffer-disable-undo (current-buffer))
-  (setq major-mode 'terminal-mode)
-  (setq mode-name "terminal")
-; (make-local-variable 'Helper-return-blurb)
-; (setq Helper-return-blurb "return to terminal simulator")
-  (setq mode-line-process '(":%s"))
-  (setq buffer-read-only t)
-  (setq truncate-lines t)
-  (make-local-variable 'terminal-escape-char)
-  (setq terminal-escape-char (default-value 'terminal-escape-char))
-  (make-local-variable 'terminal-scrolling)
-  (setq terminal-scrolling (default-value 'terminal-scrolling))
-  (make-local-variable 'terminal-more-processing)
-  (setq terminal-more-processing (default-value 'terminal-more-processing))
-  (make-local-variable 'terminal-redisplay-interval)
-  (setq terminal-redisplay-interval (default-value 'terminal-redisplay-interval))
-  (make-local-variable 'te-width)
-  (make-local-variable 'te-height)
-  (make-local-variable 'te-process)
-  (make-local-variable 'te-pending-output)
-  (setq te-pending-output (list 0))
-  (make-local-variable 'te-saved-point)
-  (setq te-saved-point (point-min))
-  (make-local-variable 'te-pending-output-info) ;for the mode line
-  (setq te-pending-output-info "")
-  (make-local-variable 'inhibit-quit)
-  ;(setq inhibit-quit t)
-  (make-local-variable 'te-log-buffer)
-  (setq te-log-buffer nil)
-  (make-local-variable 'te-more-count)
-  (setq te-more-count -1)
-  (make-local-variable 'te-redisplay-count)
-  (setq te-redisplay-count terminal-redisplay-interval)
-  ;(use-local-map terminal-mode-map)
-  ;; terminal-mode-hook is called above in function terminal-emulator
-  )
-
-;;;; what a complete loss
-
-(defun te-quote-arg-for-sh (string)
-  (cond ((string-match "\\`[-a-zA-Z0-9+=_.@/:]+\\'"
-		       string)
-	 string)
-	((not (string-match "[$]" string))
-	 ;; "[\"\\]" are special to sh and the lisp reader in the same way
-	 (prin1-to-string string))
-	(t
-	 (let ((harder "")
-	       (start 0)
-	       (end 0))
-	   (while (cond ((>= start (length string))
-			 nil)
-			;; this is the set of chars magic with "..." in `sh'
-			((setq end (string-match "[\"\\$]"
-						 string start))
-			 t)
-			(t (setq harder (concat harder
-						(substring string start)))
-			   nil))
-	     (setq harder (concat harder (substring string start end)
-                                  ;; Can't use ?\\ since `concat'
-                                  ;; unfortunately does prin1-to-string
-                                  ;; on fixna.  Amazing.
-				  "\\"
-				  (substring string
-					     end
-					     (1+ end)))
-		   start (1+ end)))
-	   (concat "\"" harder "\"")))))
-
-(defun te-create-terminfo ()
-  "Create and compile a terminfo entry for the virtual terminal. This is kept
-in the directory specified by `te-terminfo-directory'."
-  (if (and system-uses-terminfo
-	   (not (file-exists-p (concat  te-terminfo-directory
-					(substring te-terminal-name-prefix 0 1)
-					"/" te-terminal-name))))
-    (let ( (terminfo
-	    (concat
-	     ;; The first newline avoids trouble with ncurses.
-	     (format "%s,\n\tmir, xon,cols#%d, lines#%d,"
-		     te-terminal-name te-width te-height)
-	     "bel=^P^G, clear=^P\\f, cr=^P^A, cub1=^P^B, cud1=^P\\n,"
-	     "cuf1=^P^F, cup=^P=%p1%'\\s'%+%c%p2%'\\s'%+%c,"
-	     "dch=^Pd%p1%'\\s'%+%c, dch1=^Pd!, dl=^P^K%p1%'\\s'%+%c,"
-	     "dl1=^P^K!, ed=^PC, el=^Pc, home=^P=\\s\\s,"
-	     "ich=^P_%p1%'\\s'%+%c, ich1=^P_!, il=^P^O%p1%'\\s'%+%c,"
-	     "il1=^P^O!, ind=^P\\n, nel=\\n,\n"))
-	   ;; The last newline avoids trouble with ncurses.
-	   (file-name (concat te-terminfo-directory te-terminal-name ".tif")) )
-      (make-directory te-terminfo-directory t)
-      (save-excursion
-	(set-buffer (create-file-buffer file-name))
-	(insert terminfo)
-	(write-file file-name)
-	(kill-buffer nil)
-	)
-      (let ( (process-environment
-	      (cons (concat "TERMINFO="
-			    (directory-file-name te-terminfo-directory))
-		    process-environment)) )
-	(set-process-sentinel (start-process "tic" nil "tic" file-name)
-			      'te-tic-sentinel))))
-    (directory-file-name te-terminfo-directory)
-)
-
-(defun te-create-termcap ()
-  "Create a termcap entry for the virtual terminal"
-  ;; Because of Unix Brain Death(tm), we can't change
-  ;;  the terminal type of a running process, and so
-  ;;  terminal size and scrollability are wired-down
-  ;;  at this point.  ("Detach?  What's that?")
-  (concat (format "%s:co#%d:li#%d:%s"
-		  ;; Sigh.  These can't be dynamically changed.
-		  te-terminal-name te-width te-height (if terminal-scrolling
-					 "" "ns:"))
-	  ;;-- Basic things
-	  ;; cursor-motion, bol, forward/backward char
-	  "cm=^p=%+ %+ :cr=^p^a:le=^p^b:nd=^p^f:"
-	  ;; newline, clear eof/eof, audible bell
-	  "nw=^j:ce=^pc:cd=^pC:cl=^p^l:bl=^p^g:"
-	  ;; insert/delete char/line
-	  "IC=^p_%+ :DC=^pd%+ :AL=^p^o%+ :DL=^p^k%+ :"
-	  ;;-- Not-widely-known (ie nonstandard) flags, which mean
-	  ;; o writing in the last column of the last line
-	  ;;   doesn't cause idiotic scrolling, and
-	  ;; o don't use idiotische c-s/c-q sogenannte
-	  ;;   ``flow control'' auf keinen Fall.
-	  "LP:NF:"
-	  ;;-- For stupid or obsolete programs
-	  "ic=^p_!:dc=^pd!:al=^p^o!:dl=^p^k!:ho=^p=  :"
-	  ;;-- For disgusting programs.
-	  ;; (VI? What losers need these, I wonder?)
-	  "im=:ei=:dm=:ed=:mi:do=^p^j:nl=^p^j:bs:")
-)
-
-(defun te-tic-sentinel (proc state-change)
-  "If tic has finished, delete the .tif file"
-  (if (equal state-change "finished
-")
-      (delete-file (concat te-terminfo-directory te-terminal-name ".tif"))))
-
-(provide 'terminal)
-
-;;; terminal.el ends here
diff --git a/lisp/textmodes/=ispell4.el b/lisp/textmodes/=ispell4.el
deleted file mode 100644
index 1bca6748052..00000000000
--- a/lisp/textmodes/=ispell4.el
+++ /dev/null
@@ -1,1091 +0,0 @@
-;;; ispell4.el --- this is the GNU EMACS interface to GNU ISPELL version 4.
-
-;; Copyright (C) 1990, 1991, 1993 Free Software Foundation, Inc.
-
-;; Keywords: wp
-
-;; 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 provides a graceful interface to ispell, the GNU
-;; spelling checker.
-
-;;; Code:
-
-(defvar ispell-have-new-look t
-  "Non-nil means use the `-r' option when running `look'.")
-
-(defvar ispell-enable-tex-parser nil
-  "Non-nil enables experimental TeX parser in Ispell for TeX-mode buffers.")
-
-(defvar ispell-process nil "The process running Ispell")
-(defvar ispell-next-message nil
-  "An integer: where in `*ispell*' buffer to find next message from Ispell.")
-
-(defvar ispell-command "ispell"
-  "Command for running Ispell.")
-(defvar ispell-command-options nil
-  "*String (or list of strings) to pass to Ispell as command arguments.
-You can specify your private dictionary via the -p <filename> option.
-The -S option is always passed to Ispell as the last parameter,
-and need not be mentioned here.")
-
-(defvar ispell-look-command "look"
-  "*Command for running look.")
-
-;Each marker in this list points to the start of a word that
-;ispell thought was bad last time it did the :file command.
-;Notice that if the user accepts or inserts a word into his
-;private dictionary, then some "good" words will be on the list.
-;We would like to deal with this by looking up the words again just before
-;presenting them to the user, but that is too slow on machines
-;without the select system call.  Therefore, see the variable
-;ispell-recently-accepted.
-(defvar ispell-bad-words nil
-  "A list of markers reflecting the output of the Ispell `:file' command.")
-
-;list of words that the user has accepted, but that might still
-;be on the bad-words list
-(defvar ispell-recently-accepted nil)
-
-;; Non-nil means we have started showing an alternatives window.
-;; This is the window config from before then.
-(defvar ispell-window-configuration nil)
-
-;t when :dump command needed
-(defvar ispell-dump-needed nil)
-
-(defun ispell-flush-bad-words ()
-  (while ispell-bad-words
-    (if (markerp (car ispell-bad-words))
-        (set-marker (car ispell-bad-words) nil))
-    (setq ispell-bad-words (cdr ispell-bad-words)))
-  (setq ispell-recently-accepted nil))
-
-(defun kill-ispell ()
-  "Kill the Ispell process.
-Any changes in your private dictionary
-that have not already been dumped will be lost."
-  (interactive)
-  (if ispell-process
-      (delete-process ispell-process))
-  (setq ispell-process nil)
-  (ispell-flush-bad-words))
-
-(put 'ispell-startup-error 'error-conditions
-     '(ispell-startup-error error))
-(put 'ispell-startup-error 'error-message
-     "Problem starting ispell - see buffer *ispell*")
-
-;; Start an ispell subprocess; check the version; and display the greeting.
-
-(defun start-ispell ()
-  (message "Starting ispell ...")
-  (let ((buf (get-buffer "*ispell*")))
-    (if buf
-	(kill-buffer buf)))
-  (condition-case err
-      (setq ispell-process
-	    (apply 'start-process "ispell" "*ispell*" ispell-command
-		   (append (if (listp ispell-command-options)
-			       ispell-command-options
-			     (list ispell-command-options))
-			   '("-S"))))
-    (file-error (signal 'ispell-startup-error nil)))
-  (process-kill-without-query ispell-process)
-  (buffer-disable-undo (process-buffer ispell-process))
-  (accept-process-output ispell-process)
-  (let (last-char)
-    (save-excursion
-      (set-buffer (process-buffer ispell-process))
-      (bury-buffer (current-buffer))
-      (setq last-char (- (point-max) 1))
-      (while (not (eq (char-after last-char) ?=))
-	(cond ((not (eq (process-status ispell-process) 'run))
-	       (kill-ispell)
-	       (signal 'ispell-startup-error nil)))
-	(accept-process-output ispell-process)
-	(setq last-char (- (point-max) 1)))
-      (goto-char (point-min))
-      (let ((greeting (read (current-buffer))))
-	(if (not (= (car greeting) 1))
-	    (error "Bad ispell version: wanted 1, got %d" (car greeting)))
-	(message "%s" (car (cdr greeting))))
-      (delete-region (point-min) last-char))))
-  
-;; Make sure ispell is ready for a command.
-;; Leaves buffer set to *ispell*, point at '='.
-
-(defun ispell-sync (intr)
-  (if (or (null ispell-process)
-	  (not (eq (process-status ispell-process) 'run)))
-      (start-ispell))
-  (if intr
-      (interrupt-process ispell-process))
-  (let (last-char)
-    (set-buffer (process-buffer ispell-process))
-    (bury-buffer (current-buffer))
-    (setq last-char (- (point-max) 1))
-    (while (not (eq (char-after last-char) ?=))
-      (accept-process-output ispell-process)
-      (setq last-char (- (point-max) 1)))
-    (goto-char last-char)))
-
-;; Send a command to ispell.  Choices are:
-;; 
-;; WORD		Check spelling of WORD.  Result is
-;; 
-;;			 nil			   not found
-;;			 t			   spelled ok
-;;			 list of strings		   near misses
-;; 
-;; :file FILENAME	scan the named file, and print the file offsets of
-;;		 any misspelled words
-;; 
-;; :insert WORD	put word in private dictionary
-;; 
-;; :accept WORD	don't complain about word any more this session
-;; 
-;; :dump		write out the current private dictionary, if necessary.
-;; 
-;; :reload		reread private dictionary (default: `~/ispell.words')
-;; 
-;; :tex
-;; :troff
-;; :generic	set type of parser to use when scanning whole files
-
-(defun ispell-cmd (&rest strings)
-  (save-excursion
-    (ispell-sync t)
-    (set-buffer (process-buffer ispell-process))
-    (bury-buffer (current-buffer))
-    (erase-buffer)
-    (setq ispell-next-message (point-min))
-    (while strings
-      (process-send-string ispell-process (car strings))
-      (setq strings (cdr strings)))
-    (process-send-string ispell-process "\n")
-    (accept-process-output ispell-process)
-    (ispell-sync nil)))
-
-(defun ispell-dump ()
-  (cond (ispell-dump-needed
-	 (setq ispell-dump-needed nil)
-	 (ispell-cmd ":dump"))))
-
-(defun ispell-insert (word)
-  (ispell-cmd ":insert " word)
-  (if ispell-bad-words
-      (setq ispell-recently-accepted (cons word ispell-recently-accepted)))
-  (setq ispell-dump-needed t))
-
-(defun ispell-accept (word)
-  (ispell-cmd ":accept " word)
-  (if ispell-bad-words
-      (setq ispell-recently-accepted (cons word ispell-recently-accepted))))
-
-;; Return the next message sent by the Ispell subprocess.
-
-(defun ispell-next-message ()
-  (save-excursion
-    (set-buffer (process-buffer ispell-process))
-    (bury-buffer (current-buffer))
-    (save-restriction
-      (goto-char ispell-next-message)
-      (narrow-to-region (point)
-                        (progn (forward-sexp 1) (point)))
-      (setq ispell-next-message (point))
-      (goto-char (point-min))
-      (read (current-buffer)))))
-
-(defun ispell-tex-buffer-p ()
-  (memq major-mode '(plain-tex-mode latex-mode slitex-mode)))
-
-(defvar ispell-menu-map (make-sparse-keymap "Spell"))
-(defalias 'ispell-menu-map ispell-menu-map)
-
-(define-key ispell-menu-map [ispell-complete-word-interior-frag]
-  '("Complete Interior Fragment" . ispell-complete-word-interior-frag))
-
-(define-key ispell-menu-map [ispell-complete-word]
-  '("Complete Word" . ispell-complete-word))
-
-(define-key ispell-menu-map [reload-ispell]
-  '("Reload Dictionary" . reload-ispell))
-
-(define-key ispell-menu-map [ispell-next]
-  '("Continue Check" . ispell-next))
-
-(define-key ispell-menu-map [ispell-message]
-  '("Check Message" . ispell-message))
-
-(define-key ispell-menu-map [ispell-word]
-  '("Check Word" . ispell-word))
-
-(define-key ispell-menu-map [ispell-region]
-  '("Check Region" . ispell-region))
-
-(define-key ispell-menu-map [ispell-buffer]
-  '("Check Buffer" . ispell))
-
-;;;autoload
-(defun ispell (&optional buf start end)
-  "Run Ispell over current buffer's visited file.
-First the file is scanned for misspelled words, then Ispell
-enters a loop with the following commands for every misspelled word:
-
-DIGIT	Near miss selector.  If the misspelled word is close to
-	some words in the dictionary, they are offered as near misses.
-r	Replace.  Replace the word with a string you type.  Each word
-	of your new string is also checked.
-i	Insert.  Insert this word in your private dictionary (by default,
-	`$HOME/ispell.words').
-a	Accept.  Accept this word for the rest of this editing session,
- 	but don't put it in your private dictionary.
-l	Lookup.  Look for a word in the dictionary by fast binary
-	search, or search for a regular expression in the dictionary
-	using grep.
-SPACE	Accept the word this time, but complain if it is seen again.
-q, \\[keyboard-quit]	Leave the command loop.  You can come back later with \\[ispell-next]."
-  (interactive)
-  (if (null start)
-      (setq start 0))
-  (if (null end)
-      (setq end 0))
-
-  (if (null buf)
-      (setq buf (current-buffer)))
-  (setq buf (get-buffer buf))
-  (if (null buf)
-      (error "Can't find buffer"))
-  ;; Deactivate the mark, because we'll do it anyway if we change something,
-  ;; and a region highlight while in the Ispell loop is distracting.
-  (deactivate-mark)
-  (save-excursion
-    (set-buffer buf)
-    (let ((filename buffer-file-name)
-	  (delete-temp nil))
-      (unwind-protect
-	  (progn
-	    (cond ((or (null filename)
-		       (find-file-name-handler buffer-file-name nil))
-		   (setq filename (make-temp-name "/usr/tmp/ispell"))
-		   (setq delete-temp t)
-		   (write-region (point-min) (point-max) filename))
-		  ((and (buffer-modified-p buf)
-			(y-or-n-p (format "Save file %s? " filename)))
-		   (save-buffer)))
-	    (message "Ispell scanning file...")
-	    (if (and ispell-enable-tex-parser
-		     (ispell-tex-buffer-p))
-		(ispell-cmd ":tex")
-	      (ispell-cmd ":generic"))
-	    (ispell-cmd (format ":file %s %d %d" filename start end)))
-	(if delete-temp
-	    (condition-case ()
-		(delete-file filename)
-	      (file-error nil)))))
-    (message "Parsing ispell output ...")
-    (ispell-flush-bad-words)
-    (let (pos bad-words)
-      (while (numberp (setq pos (ispell-next-message)))
-	;;ispell may check the words on the line following the end
-	;;of the region - therefore, don't record anything out of range
-	(if (or (= end 0)
-		(< pos end))
-	    (setq bad-words (cons (set-marker (make-marker) (+ pos 1))
-				  bad-words))))
-      (setq bad-words (cons pos bad-words))
-      (setq ispell-bad-words (nreverse bad-words))))
-  (cond ((not (markerp (car ispell-bad-words)))
-	 (setq ispell-bad-words nil)
-	 (message "No misspellings.")
-	 t)
-	(t
-	 (message "Ispell parsing done.")
-	 (ispell-next))))
-
-;;;autoload
-(defalias 'ispell-buffer 'ispell)
-
-(defun ispell-next ()
-  "Resume command loop for most recent Ispell command.
-Return value is t unless exit is due to typing `q'."
-  (interactive)
-  (setq ispell-window-configuration nil)
-  (prog1
-      (unwind-protect
-	  (catch 'ispell-quit
-	    ;; There used to be a save-excursion here,
-	    ;; but that was annoying: it's better if point doesn't move
-	    ;; when you type q.
-	    (let (next)
-	      (while (markerp (setq next (car ispell-bad-words)))
-		(switch-to-buffer (marker-buffer next))
-		(push-mark)
-		(ispell-point next "at saved position.")
-		(setq ispell-bad-words (cdr ispell-bad-words))
-		(set-marker next nil)))
-	    t)
-	(ispell-dehighlight)
-	(if ispell-window-configuration
-	    (set-window-configuration ispell-window-configuration))
-	(cond ((null ispell-bad-words)
-	       (error "Ispell has not yet been run"))
-	      ((markerp (car ispell-bad-words))
-	       (message "%s"
-			(substitute-command-keys
-			   "Type \\[ispell-next] to continue")))
-	      ((eq (car ispell-bad-words) nil)
-	       (setq ispell-bad-words nil)
-	       (message "No more misspellings (but checker was interrupted)"))
-	      ((eq (car ispell-bad-words) t)
-	       (setq ispell-bad-words nil)
-	       (message "Ispell done"))
-	      (t
-	       (setq ispell-bad-words nil)
-	       (message "Bad ispell internal list"))))
-    (ispell-dump)))
-
-;;;autoload
-(defun ispell-word (&optional resume)
-  "Check the spelling of the word under the cursor.
-See the command `ispell' for more information.
-With a prefix argument, resume handling of the previous Ispell command."
-  (interactive "P")
-  (if resume
-      (ispell-next)
-    (condition-case err
-	(unwind-protect
-	    (catch 'ispell-quit
-	      (save-window-excursion
-		(ispell-point (point) "at point."))
-	      (ispell-dump))
-	  (ispell-dehighlight))
-      (ispell-startup-error
-       (cond ((y-or-n-p "Problem starting ispell, use old-style spell instead? ")
-	      (load-library "spell")
-	      (define-key esc-map "$" 'spell-word)
-	      (spell-word)))))))
-
-;;;autoload (define-key esc-map "$" 'ispell-word)
-
-;;;autoload
-(defun ispell-region (start &optional end)
-  "Check the spelling for all of the words in the region."
-  (interactive "r")
-  (ispell (current-buffer) start end))
-
-(defun ispell-letterp (c)
-  (and c
-       (or (and (>= c ?A) (<= c ?Z))
-	   (and (>= c ?a) (<= c ?z))
-	   (>= c 128))))
-
-(defun ispell-letter-or-quotep (c)
-  (and c
-       (or (and (>= c ?A) (<= c ?Z))
-	   (and (>= c ?a) (<= c ?z))
-	   (= c ?')
-	   (>= c 128))))
-
-(defun ispell-find-word-start ()
-  ;;backward to a letter
-  (if (not (ispell-letterp (char-after (point))))
-      (while (and (not (bobp))
-		  (not (ispell-letterp (char-after (- (point) 1)))))
-	(backward-char)))
-  ;;backward to beginning of word
-  (while (ispell-letter-or-quotep (char-after (- (point) 1)))
-    (backward-char))
-  (skip-chars-forward "'"))
-
-(defun ispell-find-word-end ()
-  (while (ispell-letter-or-quotep (char-after (point)))
-    (forward-char))
-  (skip-chars-backward "'"))
-
-(defun ispell-next-word ()
-  (while (and (not (eobp))
-	      (not (ispell-letterp (char-after (point)))))
-    (forward-char)))
-
-;if end is nil, then do one word at start
-;otherwise, do all words from the beginning of the word where
-;start points, to the end of the word where end points
-(defun ispell-point (start message)
-  (let ((wend (make-marker))
-	rescan
-	end)
-    ;; There used to be a save-excursion here,
-    ;; but that was annoying: it's better if point doesn't move
-    ;; when you type q.
-    (goto-char start)
-    (ispell-find-word-start)		;find correct word start
-    (setq start (point-marker))
-    (ispell-find-word-end)		;now find correct end
-    (setq end (point-marker))
-    ;; Do nothing if we don't find a word.
-    (if (< start end)
-	(while (< start end)
-	  (goto-char start)
-	  (ispell-find-word-end)	;find end of current word
-					;could be before 'end' if
-					;user typed replacement
-					;that is more than one word
-	  (set-marker wend (point))
-	  (setq rescan nil)
-	  (setq word (buffer-substring start wend))
-	  (cond ((ispell-still-bad word)
-;;; This just causes confusion. -- rms.
-;;;	     (goto-char start)
-;;;	     (sit-for 0)
-		 (message "Ispell checking %s" word)
-		 (ispell-cmd word)
-		 (let ((message (ispell-next-message)))
-		   (cond ((eq message t)
-			  (message "%s: ok" word))
-			 ((or (null message)
-			      (consp message))
-			  (setq rescan
-				(ispell-command-loop word start wend message)))
-			 (t
-			  (error "unknown ispell response %s" message))))))
-	  (cond ((null rescan)
-		 (goto-char wend)
-		 (ispell-next-word)
-		 (set-marker start (point))))))
-    ;;clear the choices buffer; otherwise it's hard for the user to tell
-    ;;when we get back to the command loop
-    (let ((buf (get-buffer "*ispell choices*")))
-      (cond (buf
-	     (set-buffer buf)
-	     (erase-buffer))))
-    (set-marker start nil)
-    (set-marker end nil)
-    (set-marker wend nil)))
-  
-(defun ispell-still-bad (word)
-  (let ((words ispell-recently-accepted)
-	(ret t)
-	(case-fold-search t))
-    (while words
-      (cond ((eq (string-match (car words) word) 0)
-	     (setq ret nil)
-	     (setq words nil)))
-      (setq words (cdr words)))
-    ret))
-
-(defun ispell-show-choices (word message first-line)
-  ;;if there is only one window on the frame, make the ispell
-  ;;messages winow be small.  otherwise just use the other window
-  (let* ((selwin (selected-window))
-	 (resize (eq selwin (next-window)))
-	 (buf (get-buffer-create "*ispell choices*"))
-	 w)
-    (or ispell-window-configuration
-	(setq ispell-window-configuration (current-window-configuration)))
-    (setq w (display-buffer buf))
-    (buffer-disable-undo buf)
-    (if resize
-	(unwind-protect
-	    (progn
-	      (select-window w)
-	      (enlarge-window (- 6 (window-height w))))
-	  (select-window selwin)))
-    (save-excursion
-      (set-buffer buf)
-      (bury-buffer buf)
-      (set-window-point w (point-min))
-      (set-window-start w (point-min))
-      (erase-buffer)
-      (insert first-line "\n")
-      (insert
-       "SPC skip; A accept; I insert; DIGIT select; R replace; \
-L lookup; Q quit\n")
-      (cond ((not (null message))
-	     (let ((i 0))
-	       (while (< i 3)
-		 (let ((j 0))
-		   (while (< j 3)
-		     (let* ((n (+ (* j 3) i))
-			    (choice (nth n message)))
-		       (cond (choice
-			      (let ((str (format "%d %s" n choice)))
-				(insert str)
-				(insert-char ?  (- 20 (length str)))))))
-		     (setq j (+ j 1))))
-		 (insert "\n")
-		 (setq i (+ i 1)))))))))
-
-(defun ispell-command-loop (word start end message)
-  (let ((flag t)
-	(rescan nil)
-	first-line)
-    (if (null message)
-	(setq first-line (concat "No near misses for '" word "'"))
-      (setq first-line (concat "Near misses for '" word "'")))
-    (ispell-highlight start end)
-    (while flag
-      (ispell-show-choices word message first-line)
-      (message "Ispell command: ")
-      (undo-boundary)
-      (let ((c (downcase (read-char)))
-	    replacement)
-	(cond ((and (>= c ?0)
-		    (<= c ?9)
-		    (setq replacement (nth (- c ?0) message)))
-	       (ispell-replace start end replacement)
-	       (setq flag nil))
-	      ((= c ?q)
-	       (throw 'ispell-quit nil))
-	      ((= c (nth 3 (current-input-mode)))
-	       (keyboard-quit))
-	      ((= c ? )
-	       (setq flag nil))
-	      ((= c ?r)
-	       (ispell-replace start end (read-string "Replacement: "))
-	       (setq rescan t)
-	       (setq flag nil))
-	      ((= c ?i)
-	       (ispell-insert word)
-	       (setq flag nil))
-	      ((= c ?a)
-	       (ispell-accept word)
-	       (setq flag nil))
-	      ((= c ?l)
-	       (let ((val (ispell-do-look word)))
-		 (setq first-line (car val))
-		 (setq message (cdr val))))
-	      ((= c ??)
-	       (message
-		"Type 'C-h d ispell' to the emacs main loop for more help")
-	       (sit-for 2))
-	      (t
-	       (message "Bad ispell command")
-	       (sit-for 2)))))
-    rescan))
-
-(defun ispell-do-look (bad-word)
-  (let (regex buf words)
-    (cond ((null ispell-have-new-look)
-	   (setq regex (read-string "Lookup: ")))
-	  (t
-	   (setq regex (read-string "Lookup (regex): " "^"))))
-    (setq buf (get-buffer-create "*ispell look*"))
-    (save-excursion
-      (set-buffer buf)
-      (delete-region (point-min) (point-max))
-      (if ispell-have-new-look
-	  (call-process ispell-look-command nil buf nil "-r" regex)
-	(call-process ispell-look-command nil buf nil regex))
-      (goto-char (point-min))
-      (forward-line 10)
-      (delete-region (point) (point-max))
-      (goto-char (point-min))
-      (while (not (= (point-min) (point-max)))
-	(end-of-line)
-	(setq words (cons (buffer-substring (point-min) (point)) words))
-	(forward-line)
-	(delete-region (point-min) (point)))
-      (kill-buffer buf)
-      (cons (format "Lookup '%s'" regex)
-	    (reverse words)))))
-    
-(defun ispell-replace (start end new)
-  (goto-char start)
-  (insert new)
-  (delete-region (point) end))
-
-(defun reload-ispell ()
-  "Tell Ispell to re-read your private dictionary."
-  (interactive)
-  (ispell-cmd ":reload"))
-
-(defun batch-make-ispell ()
-  (byte-compile-file "ispell.el")
-  (find-file "ispell.texinfo")
-  (let ((old-dir default-directory)
-	(default-directory "/tmp"))
-    (texinfo-format-buffer))
-  (Info-validate)
-  (if (get-buffer " *problems in info file*")
-      (kill-emacs 1))
-  (write-region (point-min) (point-max) "ispell.info"))
-
-(defvar ispell-highlight t
-  "*Non-nil means to highlight ispell words.")
-
-(defvar ispell-overlay nil)
-
-(defun ispell-dehighlight ()
-  (and ispell-overlay
-       (progn
-	 (delete-overlay ispell-overlay)
-	 (setq ispell-overlay nil))))
-
-(defun ispell-highlight (start end)
-  (and ispell-highlight 
-       window-system
-       (progn
-	 (or ispell-overlay
-	     (progn
-	       (setq ispell-overlay (make-overlay start end))
-	       (overlay-put ispell-overlay 'face
-			    (if (internal-find-face 'ispell)
-				'ispell 'region))))
-	 (move-overlay ispell-overlay start end (current-buffer)))))
-
-;;;; ispell-complete-word
-
-;;; Brief Description:
-;;; Complete word fragment at point using dictionary and replace with full
-;;; word.  Expansion done in current buffer like lisp-complete-symbol.
-;;; Completion of interior word fragments possible with prefix argument.
-
-;;; Known Problem: 
-;;; Does not use private dictionary because GNU `look' does not use it.  It
-;;; would be nice if GNU `look' took standard input; this would allow gzip'ed
-;;; dictionaries to be used.  GNU `look' also has a bug, see
-;;; `ispell-gnu-look-still-broken-p'.
-
-;;; Motivation: 
-;;; The `l', "regular expression look up", keymap option of ispell-word
-;;; (ispell-do-look) can only be run after finding a misspelled word.  So
-;;; ispell-do-look can not be used to look for words starting with `cat' to
-;;; find `catechetical' since `cat' is a correctly spelled word.  Furthermore,
-;;; ispell-do-look does not return the entire list returned by `look'.
-;;;  
-;;; ispell-complete-word allows you to get a completion list from the system
-;;; dictionary and expand a word fragment at the current position in a buffer.
-;;; These examples assume ispell-complete-word is bound to M-TAB as it is in
-;;; text-mode; the `Complete Word' and `Complete Interior Fragment' entries of
-;;; the "Spell" submenu under the "Edit" menu may also be used instead of
-;;; M-TAB and C-u M-TAB, respectively.
-;;;
-;;;   EXAMPLE 1: The word `Saskatchewan' needs to be spelled.  The user may
-;;;   type `Sas' and hit M-TAB and a completion list will be built using the
-;;;   shell command `look' and displayed in the *Completions* buffer:
-;;;
-;;;        Possible completions are:
-;;;        sash                               sashay
-;;;        sashayed                           sashed
-;;;        sashes                             sashimi
-;;;        Saskatchewan                       Saskatoon
-;;;        sass                               sassafras
-;;;        sassier                            sassing
-;;;        sasswood                           sassy
-;;;
-;;;   By viewing this list the user will hopefully be motivated to insert the
-;;;   letter `k' after the `sas'.  When M-TAB is hit again the word `Saskat'
-;;;   will be inserted in place of `sas' (note case) since this is a unique
-;;;   substring completion.  The narrowed completion list can be viewed with
-;;;   another M-TAB
-;;;
-;;;        Possible completions are:
-;;;        Saskatchewan                       Saskatoon
-;;;
-;;;   Inserting the letter `c' and hitting M-TAB will narrow the completion
-;;;   possibilities to just `Saskatchewan' and this will be inserted in the
-;;;   buffer.  At any point the user may click the mouse on a completion to
-;;;   select it.
-;;;
-;;;   EXAMPLE 2: The user has typed `Sasaquane' and M-$ (ispell-word) gives no
-;;;   "near-misses" in which case you back up to `Sas' and hit M-TAB and find
-;;;   the correct word as above.  The `Sas' will be replaced by `Saskatchewan'
-;;;   and the remaining word fragment `aquane' can be deleted.
-;;;
-;;;   EXAMPLE 3: If a version of `look' is used that supports regular
-;;;   expressions, then `ispell-have-new-look' should be t (its default) and
-;;;   interior word fragments may also be used for the search.  The word
-;;;   `pneumonia' needs to be spelled.  The user can only remember the
-;;;   interior fragment `mon' in which case `C-u M-TAB' on `mon' gives a list
-;;;   of all words containing the interior word fragment `mon'.  Typing `p'
-;;;   and M-TAB will narrow this list to all the words starting with `p' and
-;;;   containing `mon' from which `pneumonia' can be found as above.
-
-;;; The user-defined variables are:
-;;;
-;;;  ispell-look-command
-;;;  ispell-look-dictionary
-;;;  ispell-gnu-look-still-broken-p
-
-;;; Algorithm (some similarity to lisp-complete-symbol):
-;;;  
-;;; * call-process on command ispell-look-command (default: "look") to find
-;;;   words in ispell-look-dictionary matching `string' (or `regexp' if 
-;;;   ispell-have-new-look is t).  Parse output and store results in 
-;;;   ispell-lookup-completions-alist.
-;;; 
-;;; * Build completion list using try-completion and `string'
-;;; 
-;;; * Replace `string' in buffer with matched common substring completion.
-;;; 
-;;; * Display completion list only if there is no matched common substring.
-;;; 
-;;; * Rebuild ispell-lookup-completions-alist, on a next call, only when
-;;;   beginning of word fragment has changed.
-;;;  
-;;; * Interior fragments searches are performed similarly with the exception
-;;;   that the entire fragment at point is initially removed from the buffer,
-;;;   the STRING passed to try-completion and all-completions is just "" and
-;;;   not the interior fragment; this allows all completions containing the
-;;;   interior fragment to be shown.  The location in the buffer is stored to
-;;;   decide whether future completion narrowing of the current list should be
-;;;   done or if a new list should be built.  See interior fragment example
-;;;   above.
-;;;
-;;; * Robust searches are done using a `look' with -r (regular expression) 
-;;;   switch if ispell-have-new-look is t.
-
-;;;; User-defined variables.
-
-(defvar ispell-look-dictionary nil
-  "*If non-nil then spelling dictionary as string for `ispell-complete-word'.
-Overrides default dictionary file such as \"/usr/dict/words\" or GNU look's
-\"${prefix}/lib/ispell/ispell.words\"")
-
-(defvar ispell-gnu-look-still-broken-p nil
-  "*t if GNU look -r can give different results with and without trailing `.*'.
-Example: `look -dfr \"^ya\" foo' returns nothing, while `look -dfr \"^ya.*\" foo'
-returns `yacc', where `foo' is a dictionary file containing the three lines
-
-   y
-   y's
-   yacc
-
-Both commands should return `yacc'.  If `ispell-complete-word' erroneously
-states that no completions exist for a string, then setting this variable to t
-will help find those completions.")
-
-;;;; Internal variables.
-
-;;; Possible completions for last word fragment.
-(defvar ispell-lookup-completions-alist nil)
-
-;;; Last word fragment processed by `ispell-complete-word'.
-(defvar ispell-lookup-last-word nil)
-
-;;; Buffer local variables.
-
-;;; Value of interior-frag in last call to `ispell-complete-word'.
-(defvar ispell-lookup-last-interior-p nil)
-(make-variable-buffer-local 'ispell-lookup-last-interior-p)
-(put 'ispell-lookup-last-interior-p 'permanent-local t)
-
-;;; Buffer position in last call to `ispell-complete-word'.
-(defvar ispell-lookup-last-bow nil)
-(make-variable-buffer-local 'ispell-lookup-last-bow)
-(put 'ispell-lookup-last-bow 'permanent-local t)
-
-;;;; Interactive functions.
-;;;autoload
-(defun ispell-complete-word (&optional interior-frag)
-  "Complete word using letters at point to word beginning using `look'.
-With optional argument INTERIOR-FRAG, word fragment at point is assumed to be
-an interior word fragment in which case `ispell-have-new-look' should be t.
-See also `ispell-look-dictionary' and `ispell-gnu-look-still-broken-p'."
-
-  (interactive "P")
-
-  ;; `look' must support regexp expressions in order to perform an interior
-  ;; fragment search.
-  (if (and interior-frag (not ispell-have-new-look))
-      (error (concat "Sorry, `ispell-have-new-look' is nil.  "
-                     "You also will need GNU Ispell's `look'.")))
-
-  (let* ((completion-ignore-case t)
-
-         ;; Get location of beginning of word fragment.
-         (bow (save-excursion (skip-chars-backward "a-zA-Z'") (point)))
-
-         ;; Get the string to look up.
-         (string (buffer-substring bow (point)))
-
-         ;; Get regexp for which we search and, if necessary, an interior word
-         ;; fragment.
-         (regexp (if interior-frag
-                     (concat "^.*" string ".*")
-                   ;; If possible use fast binary search: no trailing `.*'.
-                   (concat "^" string
-                           (if ispell-gnu-look-still-broken-p ".*"))))
-
-         ;; We want all completions for case of interior fragments so set
-         ;; prefix to an empty string.
-         (prefix (if interior-frag "" string))
-
-         ;; Are we continuing from a previous interior fragment search?
-         ;; Check last value of interior-word and if the point has moved.
-         (continuing-an-interior-frag-p
-          (and ispell-lookup-last-interior-p
-               (equal ispell-lookup-last-bow bow)))
-
-         ;; Are we starting a unique word fragment search?  Always t for
-         ;; interior word fragment search.
-         (new-unique-string-p
-          (or interior-frag (null ispell-lookup-last-word)
-              (let ((case-fold-search t))
-                ;; Can we locate last word fragment as a substring of current
-                ;; word fragment?  If the last word fragment is larger than
-                ;; the current string then we will have to rebuild the list
-                ;; later.
-                (not (string-match
-                      (concat "^" ispell-lookup-last-word) string)))))
-
-         completion)
-
-    ;; Check for perfect completion already.  That is, maybe the user has hit
-    ;; M-x ispell-complete-word one too many times?
-    (if (string-equal string "")
-        (if (string-equal (concat ispell-lookup-last-word " ")
-                          (buffer-substring
-                           (save-excursion (forward-word -1) (point)) (point)))
-            (error "Perfect match already")
-          (error "No word fragment at point")))
-
-    ;; Create list of words from system dictionary starting with `string' if
-    ;; new string and not continuing from a previous interior fragment search.
-    (if (and (not continuing-an-interior-frag-p) new-unique-string-p)
-        (setq ispell-lookup-completions-alist
-              (ispell-lookup-build-list string regexp)))
-
-    ;; Check for a completion of `string' in the list and store `string' and
-    ;; other variables for the next call.
-    (setq completion (try-completion prefix ispell-lookup-completions-alist)
-          ispell-lookup-last-word string
-          ispell-lookup-last-interior-p interior-frag
-          ispell-lookup-last-bow bow)
-
-    ;; Test the completion status.
-    (cond
-
-     ;; * Guess is a perfect match.
-     ((eq completion t)
-      (insert " ")
-      (message "Perfect match."))
-
-     ;; * No possibilities.
-     ((null completion)
-      (message "Can't find completion for \"%s\"" string)
-      (beep))
-
-     ;; * Replace string fragment with matched common substring completion.
-     ((and (not (string-equal completion ""))
-           ;; Fold case so a completion list is built when `string' and common
-           ;; substring differ only in case.
-           (let ((case-fold-search t))
-             (not (string-match (concat "^" completion "$") string))))
-      (search-backward string bow)
-      (replace-match completion nil t) ; FIXEDCASE doesn't work? or LITERAL?
-      (message "Proposed unique substring.  Repeat for completions list."))
-
-     ;; * String is a common substring completion already.  Make list.
-     (t
-      (message "Making completion list...")
-      (if (string-equal completion "") (delete-region bow (point)))
-      (let ((list (all-completions prefix ispell-lookup-completions-alist)))
-        (with-output-to-temp-buffer "*Completions*"
-          (display-completion-list list)))
-      (message "Making completion list...done")))))
-
-;;;autoload
-(defun ispell-complete-word-interior-frag ()
-  "Runs `ispell-complete-word' with a non-nil INTERIOR-FRAG.
-A completion list is built for word fragment at point which is assumed to be
-an interior word fragment.  `ispell-have-new-look' should be t."
-  (interactive)
-  (ispell-complete-word t))
-
-;;;; Internal Function.
-
-;;; Build list of words using ispell-look-command from dictionary
-;;; ispell-look-dictionary (if this is a non-nil string).  Look for words
-;;; starting with STRING if ispell-have-new-look is nil or look for REGEXP if
-;;; ispell-have-new-look is t.  Returns result as an alist suitable for use by
-;;; try-completion, all-completions, and completing-read.
-(defun ispell-lookup-build-list (string regexp)
-  (save-excursion
-    (message "Building list...")
-    (set-buffer (get-buffer-create " *ispell look*"))
-    (erase-buffer)
-
-    (if (stringp ispell-look-dictionary)
-        (if ispell-have-new-look
-            (call-process ispell-look-command nil t nil "-fr" regexp
-                          ispell-look-dictionary)
-          (call-process ispell-look-command nil t nil "-f" string
-                        ispell-look-dictionary))
-      (if ispell-have-new-look
-          (call-process ispell-look-command nil t nil "-fr" regexp)
-        (call-process ispell-look-command nil t nil "-f" string)))
-
-    ;; Build list for try-completion and all-completions by storing each line
-    ;; of output starting from bottom of buffer and deleting upwards.
-    (let (list)
-      (goto-char (point-min))
-      (while (not (= (point-min) (point-max)))
-        (end-of-line)
-        (setq list (cons (buffer-substring (point-min) (point)) list))
-        (forward-line)
-        (delete-region (point-min) (point)))
-
-      ;; Clean.
-      (erase-buffer)
-      (message "Building list...done")
-
-      ;; Make the list into an alist and return.
-      (mapcar 'list (nreverse list)))))
-
-;; Return regexp-quote of STRING if STRING is non-empty.
-;; Otherwise return an unmatchable regexp.
-(defun ispell-non-empty-string (string)
-  (if (or (not string) (string-equal string ""))
-      "\\'\\`" ; An unmatchable string if string is null.
-    (regexp-quote string)))
-
-(defvar ispell-message-cite-regexp "^   \\|^\t"
-  "*Regular expression to match lines cited from one message into another.")
-
-(defvar ispell-message-text-end
-  (concat "^\\(" (mapconcat (function identity)
-				'(
-				  ;; Matches postscript files.
-				  "%!PS-Adobe-2.0"
-				  ;; Matches uuencoded text
-				  "begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM"
-				  ;; Matches shell files (esp. auto-decoding)
-				  "#! /bin/sh"
-				  ;; Matches difference listing
-				  "diff -c .*\n\\*\\*\\* .*\n--- "
-				  ;; Matches "--------------------- cut here"
-				  "[-=]+\\s cut here")
-				"\\|")
-	      "\\)")
-  "*End of text which will be checked in ispell-message.
-If it is a string, limit at first occurrence of that regular expression.
-Otherwise, it must be a function which is called to get the limit.")
-
-(defvar ispell-message-limit (* 100 80)
-  "*Ispell-message will check no more than this number of characters.")
-
-;;;autoload
-(defun ispell-message ()
-  "Check the spelling of a mail message or news post.
-Don't check spelling of message headers (except subject) or included messages.
-
-To spell-check whenever a message is sent, include this line in .emacs:
-   (setq news-inews-hook (setq mail-send-hook 'ispell-message))
-
-Or you can bind the function to C-c i in gnus or mail with:
-   (setq mail-mode-hook (setq news-reply-mode-hook
-    (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))))"
-  (interactive)
-  (save-excursion
-    (let (non-internal-message
-	  (old-case-fold-search case-fold-search)
-	  (case-fold-search nil))
-      (goto-char (point-min))
-      ;; Don't spell-check the headers.
-      (if (search-forward mail-header-separator nil t)
-	  ;; Move to first body line.
-	  (forward-line 1)
-	(while (and (looking-at "[a-zA-Z-]+:\\|\t\\| ")
-		    (not (eobp)))
-	  (forward-line 1))
-	(setq non-internal-message t)
-	)
-      (let* ((cite-regexp		;Prefix of inserted text
-	     (cond
-	      ((featurep 'supercite)	; sc 3.0
-	       (concat "\\(" (sc-cite-regexp) "\\)" "\\|"
-		       (ispell-non-empty-string sc-reference-tag-string)))
-	      ((featurep 'sc)		; sc 2.3
-	       (concat "\\(" sc-cite-regexp "\\)" "\\|"
-		       (ispell-non-empty-string sc-reference-tag-string)))
-	      (non-internal-message	; Assume nn sent us this message.
-	       (concat "In [a-zA-Z.]+ you write:" "\\|"
-		       "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|"
-		       " *> *"))
-	      ((equal major-mode 'news-reply-mode) ;Gnus
-	       (concat "In article <" "\\|"
-		       (if mail-yank-prefix
-			   (ispell-non-empty-string mail-yank-prefix)
-			 ispell-message-cite-regexp)))
-	      ((boundp 'vm-included-text-prefix) ; VM mail message
-	       (concat "[^,;&+=]+ writes:" "\\|"
-		       (ispell-non-empty-string vm-included-text-prefix)
-		       ))
-	      ((boundp 'mh-ins-buf-prefix) ; mh mail message
-	       (ispell-non-empty-string mh-ins-buf-prefix))
-	      (mail-yank-prefix			; vanilla mail message.
-	       (ispell-non-empty-string mail-yank-prefix))
-	      (t ispell-message-cite-regexp)))
-	    (continue t)
-	    (limit
-	     (min
-	      (+ (point-min) ispell-message-limit)
-	      (point-max)
-	      (save-excursion
- 		(cond
- 		 ((not ispell-message-text-end) (point-max))
- 		 ((char-or-string-p ispell-message-text-end)
- 		  (if (re-search-forward ispell-message-text-end nil 'end)
- 		      (match-beginning 0)
- 		    (point-max)))
- 		 (t (funcall ispell-message-text-end))))))
-	    (search-limit ; Search limit which won't stop in middle of citation
-	     (+ limit (length cite-regexp)))
-	    )
- 	;; Check the subject
- 	(save-excursion
- 	  (let ((case-fold-search t)
- 		(message-begin (point)))
- 	    (goto-char (point-min))
- 	    ;; "\\s *" matches newline if subject is empty
- 	    (if (and (re-search-forward "^Subject:[\t ]*" message-begin t)
- 		     (not (looking-at "re\\>")))
- 		(setq continue
- 		      (ispell-region (- (point) 1)
- 				     (progn
-				       (end-of-line)
-				       (while (looking-at "\n[ \t]")
-					 (end-of-line 2))
-				       (point))))
- 	      )))
-
-	;; Check the body.
-	(while (and (< (point) limit) continue)
-	  ;; Skip across text cited from other messages.
-	  (while (and (looking-at (concat "^[ \t]*$\\|" cite-regexp))
-		      (< (point) limit))
-	    (forward-line 1))
-	  (if (< (point) limit)
-	      ;; Check the next batch of lines that *aren't* cited.
-	      (let ((start (point)))
-		(if (re-search-forward
-		     (concat "^\\(" cite-regexp "\\)") search-limit 'end)
-		    (beginning-of-line))
-		(if (> (point) limit) (goto-char limit))
-		(let ((case-fold-search old-case-fold-search))
-		  (save-excursion
-		    (setq continue (ispell-region (- start 1) (point))))))))))))
-
-(provide 'ispell)
-
-;;; ispell.el ends here
diff --git a/lisp/textmodes/bib-mode.el b/lisp/textmodes/bib-mode.el
deleted file mode 100644
index 42de7459ee0..00000000000
--- a/lisp/textmodes/bib-mode.el
+++ /dev/null
@@ -1,241 +0,0 @@
-;;; bib-mode.el --- bib-mode, major mode for editing bib files.
-
-;; Copyright (C) 1989 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: bib
-
-;; 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 code to help maintain databases compatible with (troff)
-;;   refer and lookbib.  The file bib-file should be set to your 
-;;   bibliography file.  Keys are automagically inserted as you type,
-;;   and appropriate keys are presented for various kinds of entries.
-
-;;; Code:
-
-(defvar bib-file "~/my-bibliography.bib" 
-   "Default name of file used by `addbib'.")
-
-(defvar unread-bib-file "~/to-be-read.bib"
-   "Default name of file used by `unread-bib' in Bib mode.")
-
-(defvar bib-mode-map (copy-keymap text-mode-map))
-(define-key bib-mode-map "\C-M" 'return-key-bib)
-(define-key bib-mode-map "\C-c\C-u" 'unread-bib)
-(define-key bib-mode-map "\C-c\C-@" 'mark-bib)
-(define-key bib-mode-map "\e`" 'abbrev-mode)
-(defvar bib-mode-abbrev-table nil
-   "Abbrev table used in Bib mode")
-
-(defun addbib ()
-   "Set up editor to add to troff bibliography file specified 
-by global variable `bib-file'.  See description of `bib-mode'."
-   (interactive)
-   (find-file bib-file)
-   (goto-char (point-max))
-   (bib-mode)
-   )
-   
-(defun bib-mode ()
-   "Mode for editing `lookbib' style bibliographies.  
-Hit RETURN to get next % field key.
-If you want to ignore this field, just hit RETURN again.
-Use `text-mode' to turn this feature off.
-
- journal papers:                    A* T D J V N P K W X
- articles in books & proceedings:   A* T D B E* I C P K W X 
- tech reports:                      A* T D R I C K W X
- books:                             A* T D I C K W X
-
-Fields:
-
-A uthor		T itle		D ate  		J ournal
-V olume		N umber		P age		K eywords
-B in book or proceedings	E ditor		C ity & state
-I nstitution, school, or publisher
-R eport number or 'phd thesis' or 'masters thesis' or 'draft' or 
-     'unnumbered' or 'unpublished'
-W here can be found locally (login name, or ailib, etc.)
-X comments (not used in indexing)
-
-\\[unread-bib] appends current entry to a different file (for example,
-a file of papers to be read in the future), given by the value of the
-variable `unread-bib-file'.
-\\[mark-bib] marks current or previous entry.
-Abbreviations are saved in `bib-mode-abbrev-table'.
-Hook can be stored in `bib-mode-hook'.
-Field keys given by variable `bib-assoc'.
-
-Commands:
-\\{bib-mode-map}
-"
-   (interactive)
-   (text-mode)
-   (use-local-map bib-mode-map)
-   (setq mode-name "Bib")
-   (setq major-mode 'bib-mode)
-   (define-abbrev-table 'bib-mode-abbrev-table ())
-   (setq local-abbrev-table bib-mode-abbrev-table)
-   (abbrev-mode 1)
-   (run-hooks 'bib-mode-hook)
-   )
-
-(defconst bib-assoc '(
-		   (" *$" . "%A ")
-		   ("%A ." . "%A ")
-		   ("%A $" . "%T ")
-		   ("%T " . "%D ")
-		   ("%D " . "%J ")
-		   ("%J ." . "%V ")
-		   ("%V " . "%N ")
-		   ("%N " . "%P ")
-		   ("%P " . "%K ")
-		   ("%K " . "%W ")
-		   ("%W " . "%X ")
-		   ("%X " . "")
-		   ("%J $" . "%B ")
-		   ("%B ." . "%E ")
-		   ("%E ." . "%E ")
-		   ("%E $" . "%I ")
-		   ("%I " . "%C ")
-		   ("%C " . "%P ")
-		   ("%B $" . "%R ")
-		   ("%R " . "%I ")
-		   )
-		   
-"Describes bibliographic database format.  A line beginning with
-the car of an entry is followed by one beginning with the cdr.
-")
-
-(defun bib-find-key (slots)
-   (cond
-      ((null slots)
-	 (if (bobp)
-	    ""
-	    (progn (previous-line 1) (bib-find-key bib-assoc))))
-      ((looking-at (car (car slots)))
-	 (cdr (car slots)))
-      (t (bib-find-key (cdr slots)))
-      ))
-
-
-(defvar bib-auto-capitalize t 
-"*True to automatically capitalize appropriate fields in Bib mode.")
-
-(defconst bib-capitalized-fields "%[AETCBIJR]")
-
-(defun return-key-bib ()
-  "Magic when user hits return, used by `bib-mode'."
-  (interactive)
-  (if (eolp)
-    (let (empty new-key beg-current end-current)
-      (beginning-of-line)
-      (setq empty (looking-at "%. $"))
-      (if (not empty)
-	(progn
-	  (end-of-line)
-	  (newline)
-	  (forward-line -1)
-	  ))
-      (end-of-line)
-      (setq end-current (point))
-      (beginning-of-line)
-      (setq beg-current (point))
-      (setq new-key (bib-find-key bib-assoc))
-      (if (and (not empty) bib-auto-capitalize
-	    (looking-at bib-capitalized-fields))
-	(save-excursion
-	  (bib-capitalize-title-region (+ (point) 3) end-current)))
-      (goto-char beg-current)
-      (if empty
-	(kill-line nil)
-	(forward-line 1)
-	)
-      (insert-string new-key))
-    (newline)))
-
-(defun mark-bib ()
-   "Set mark at beginning of current or previous bib entry, point at end."
-   (interactive)
-   (beginning-of-line nil)
-   (if (looking-at "^ *$") (re-search-backward "[^ \n]" nil 2))
-   (re-search-backward "^ *$" nil 2)
-   (re-search-forward "^%")
-   (beginning-of-line nil)
-   (push-mark (point))
-   (re-search-forward "^ *$" nil 2)
-   (next-line 1)
-   (beginning-of-line nil))
-
-(defun unread-bib ()
-   "Append current or previous entry to file of unread papers
-named by variable `unread-bib-file'."
-   (interactive)
-   (mark-bib)
-   (if (get-file-buffer unread-bib-file)
-      (append-to-buffer (get-file-buffer unread-bib-file) (mark) (point))
-      (append-to-file (mark) (point) unread-bib-file)))
-
-
-(defvar bib-capitalize-title-stop-words
-   (concat
-      "the\\|and\\|of\\|is\\|a\\|an\\|of\\|for\\|in\\|to\\|in\\|on\\|at\\|"
-      "by\\|with\\|that\\|its")
-   "Words not to be capitalized in a title (unless the first word).")
-
-(defvar bib-capitalize-title-stop-regexp
-   (concat "\\(" bib-capitalize-title-stop-words "\\)\\(\\b\\|'\\)"))
-
-(defun bib-capitalize-title-region (begin end)
-   "Like `capitalize-region', but don't capitalize stop words, except the first."
-   (interactive "r")
-   (let ((case-fold-search nil) (orig-syntax-table (syntax-table)))
-      (unwind-protect
-	 (save-restriction
-	    (set-syntax-table text-mode-syntax-table)
-	    (narrow-to-region begin end)
-	    (goto-char (point-min))
-	    (if (looking-at "[A-Z][a-z]*[A-Z]")
-	       (forward-word 1)
-	       (capitalize-word 1))
-	    (while (re-search-forward "\\<" nil t)
-	       (if (looking-at "[A-Z][a-z]*[A-Z]")
-		  (forward-word 1)
-		  (if (let ((case-fold-search t))
-			 (looking-at bib-capitalize-title-stop-regexp))
-		     (downcase-word 1)
-		     (capitalize-word 1)))
-	       ))
-	 (set-syntax-table orig-syntax-table))))
-
-
-(defun bib-capitalize-title (s)
-   "Like `capitalize', but don't capitalize stop words, except the first."
-   (save-excursion
-      (set-buffer (get-buffer-create "$$$Scratch$$$"))
-      (erase-buffer)
-      (insert s)
-      (bib-capitalize-title-region (point-min) (point-max))
-      (buffer-string)))
-
-(provide 'bib-mode)
-
-;;; bib-mode.el ends here
diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el
deleted file mode 100644
index f41f48951fe..00000000000
--- a/lisp/textmodes/bibtex.el
+++ /dev/null
@@ -1,2450 +0,0 @@
-;;; bibtex.el --- BibTeX mode for GNU Emacs
-
-;; Copyright (C) 1992, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Stefan Schoef <schoef@offis.uni-oldenburg.de>
-;;      Bengt Martensson <bengt@mathematik.uni-Bremen.de>
-;;	Mark Shapiro <shapiro@corto.inria.fr>
-;;	Mike Newton <newton@gumby.cs.caltech.edu>
-;;	Aaron Larson <alarson@src.honeywell.com>
-;; Maintainer: Stefan Schoef <schoef@offis.uni-oldenburg.de>
-;; Keywords: BibTeX, LaTeX, TeX
-
-;; 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:
-
-;;  Major mode for editing and validating BibTeX files.
-
-;;  Usage:
-;;  See documentation for function bibtex-mode (or type "\M-x describe-mode"
-;;  when you are in bibtex-mode).
-
-;;  Todo:
-;;  Distribute texinfo file.
-
-;;  Known Bugs:
-;;   1. using regular expressions to match the entire BibTeX entry dies
-;;      on long entries (e.g. those containing abstracts) since
-;;      the length of regular expression matches is fairly limited.
-;;   2. Calling bibtex-find-text in a string entry results in the
-;;      error message "Can't find enclosing Bibtex field" instead of
-;;      moving to the empty string. [reported by gernot@cs.unsw.oz.au]
-
-;; (current keeper: schoef@offis.uni-oldenburg.de
-;;  previous: alarson@src.honeywell.com)
-
-;;; Code:
-
-;; User Options:
-
-(defvar bibtex-field-left-delimiter "{"
-  "*Set this to { or \" according to your personal preferences.
-This variable is buffer local.")
-(make-variable-buffer-local 'bibtex-field-left-delimiter)
-
-(defvar bibtex-field-right-delimiter "}"
-  "*Set this to } or \" according to your personal preferences.
-This variable is buffer local.")
-(make-variable-buffer-local 'bibtex-field-right-delimiter)
-
-(defvar bibtex-include-OPTcrossref '("InProceedings" "InCollection")
-  "*All entries listed here will have an OPTcrossref field.")
-
-(defvar bibtex-include-OPTkey t
-  "*If non-nil, all entries will have an OPTkey field.")
-
-(defvar bibtex-include-OPTannote t
-  "*If non-nil, all entries will have an OPTannote field.")
-
-(defvar bibtex-mode-user-optional-fields nil
-  "*List of optional fields the user wants to have always present.
-Entries should be lists of strings with two elements (first element =
-name of the field, second element = comment to appear in the echo area).")
-
-(defvar bibtex-clean-entry-zap-empty-opts t
-  "*If non-nil, bibtex-clean-entry will delete all empty optional fields.")
-
-(defvar bibtex-sort-ignore-string-entries t
-  "*If non-nil, BibTeX @STRING entries are not sort-significant.
-That means they are ignored when determining ordering of the buffer
-(e.g. sorting, locating alphabetical position for new entries, etc.).
-This variable is buffer local.")
-(make-variable-buffer-local 'bibtex-sort-ignore-string-entries)
-
-(defvar bibtex-maintain-sorted-entries nil
-  "*If non-nil, bibtex-mode maintains all BibTeX entries in sorted order.
-Setting this variable to nil will strip off some comfort (e.g. TAB
-completion for reference keys in minibuffer, automatic detection of
-duplicates) from bibtex-mode. See also bibtex-sort-ignore-string-entries.
-This variable is buffer local.")
-(make-variable-buffer-local 'bibtex-maintain-sorted-entries)
-
-(defvar bibtex-parse-keys-timeout auto-save-timeout
-  "*Specifies interval for parsing buffer for keys.
-The buffer is checked every bibtex-parse-keys-timeout seconds if it is
-modified since last parsing and is parsed if necessary. This is needed
-only if buffer is maintained sorted (bibtex-maintain-sorted-entries
-non-nil).")
-
-(defvar bibtex-entry-field-alist
-  '(
-    ("Article" . (((("author" "Author1 [and Author2 ...] [and others]")
-                    ("title" "Title of the article (BibTeX converts it to lowercase)")
-                    ("journal" "Name of the journal (use string, remove braces)")
-                    ("year" "Year of publication"))
-		   (("volume" "Volume of the journal")
-                    ("number" "Number of the journal")
-                    ("month" "Month of the publication as a string (remove braces)")
-                    ("pages" "Pages in the journal")
-                    ("note" "Remarks to be put at the end of the \\bibitem")))
-		  ((("author" "Author1 [and Author2 ...] [and others]")
-                    ("title" "Title of the article (BibTeX converts it to lowercase)"))
-		   (("journal" "Name of the journal (use string, remove braces)") 
-                    ("year" "Year of publication")
-                    ("volume" "Volume of the journal")
-                    ("number" "Number of the journal")
-		    ("month" "Month of the publication as a string (remove braces)")
-                    ("pages" "Pages in the journal")
-                    ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("Book" . (((("author" "Author1 [and Author2 ...] [and others]")
-                 ("title" "Title of the book")
-                 ("publisher" "Publishing company")
-                 ("year" "Year of publication"))
-		(("editor" "Editor1 [and Editor2 ...] [and others]")
-                 ("volume" "Volume of the book in the series")
-                 ("number" "Number of the book in a small series (overwritten by volume)")
-                 ("series" "Series in which the book appeared")
-                 ("address" "Address of the publisher")
-		 ("edition" "Edition of the book as a capitalized English word")
-                 ("month" "Month of the publication as a string (remove braces)")
-                 ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("Booklet" . (((("title" "Title of the booklet (BibTeX converts it to lowercase)"))
-		   (("author" "Author1 [and Author2 ...] [and others]")
-                    ("howpublished" "The way in which the booklet was published")
-                    ("address" "Address of the publisher")
-                    ("year" "Year of publication")
-                    ("month" "Month of the publication as a string (remove braces)")
-                    ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("InBook" . (((("author" "Author1 [and Author2 ...] [and others]")
-                   ("title" "Title of the book")
-                   ("chapter" "Chapter in the book")
-                   ("publisher" "Publishing company")
-                   ("year" "Year of publication"))
-		  (("editor" "Editor1 [and Editor2 ...] [and others]")
-                   ("volume" "Volume of the book in the series")
-                   ("number" "Number of the book in a small series (overwritten by volume)")
-                   ("series" "Series in which the book appeared")
-                   ("address" "Address of the publisher")
-		   ("edition" "Edition of the book as a capitalized English word")
-                   ("month" "Month of the publication as a string (remove braces)")
-                   ("pages" "Pages in the book")
-                   ("type" "Word to use instead of \"chapter\"")
-                   ("note" "Remarks to be put at the end of the \\bibitem")))
-		 ((("author" "Author1 [and Author2 ...] [and others]")
-                   ("title" "Title of the book")
-                   ("chapter" "Chapter in the book"))
-		  (("publisher" "Publishing company")
-                   ("year" "Year of publication")
-                   ("editor" "Editor1 [and Editor2 ...] [and others]")
-                   ("volume" "Volume of the book in the series")
-                   ("number" "Number of the book in a small series (overwritten by volume)")
-		   ("series" "Series in which the book appeared")
-                   ("address" "Address of the publisher")
-                   ("edition" "Edition of the book as a capitalized English word")
-                   ("month" "Month of the publication as a string (remove braces)")
-                   ("pages" "Pages in the book")
-                   ("type" "Word to use instead of \"chapter\"")
-                   ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("InCollection" . (((("author" "Author1 [and Author2 ...] [and others]")
-                         ("title" "Title of the article in book (BibTeX converts it to lowercase)")
-			 ("booktitle" "Name of the book")
-                         ("publisher" "Publishing company")
-                         ("year" "Year of publication"))
-			(("editor" "Editor1 [and Editor2 ...] [and others]")
-                         ("volume" "Volume of the book in the series")
-                         ("number" "Number of the book in a small series (overwritten by volume)")
-                         ("series" "Series in which the book appeared")
-                         ("chapter" "Chapter in the book")
-                         ("type" "Word to use instead of \"chapter\"")
-                         ("address" "Address of the publisher")
-                         ("edition" "Edition of the book as a capitalized English word")
-                         ("month" "Month of the publication as a string (remove braces)")
-			 ("pages" "Pages in the book")
-                         ("note" "Remarks to be put at the end of the \\bibitem")))
-		       ((("author" "Author1 [and Author2 ...] [and others]")
-                         ("title" "Title of the article in book (BibTeX converts it to lowercase)")
-                         ("booktitle" "Name of the book"))
-			(("publisher" "Publishing company")
-                         ("year" "Year of publication")
-			 ("editor" "Editor1 [and Editor2 ...] [and others]")
-                         ("volume" "Volume of the book in the series")
-                         ("number" "Number of the book in a small series (overwritten by volume)")
-                         ("series" "Series in which the book appeared")
-                         ("chapter" "Chapter in the book")
-                         ("type" "Word to use instead of \"chapter\"")
-                         ("address" "Address of the publisher")
-                         ("edition" "Edition of the book as a capitalized English word")
-                         ("month" "Month of the publication as a string (remove braces)")
-			 ("pages" "Pages in the book")
-                         ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("InProceedings" . (((("author" "Author1 [and Author2 ...] [and others]")
-                          ("title" "Title of the article in proceedings (BibTeX converts it to lowercase)")
-                          ("booktitle" "Name of the conference proceedings")
-                          ("year" "Year of publication"))
-			 (("editor" "Editor1 [and Editor2 ...] [and others]")
-                          ("volume" "Volume of the conference proceedings in the series")
-                          ("number" "Number of the conference proceedings in a small series (overwritten by volume)")
-                          ("series" "Series in which the conference proceedings appeared")
-			  ("organization" "Sponsoring organization of the conference")
-                          ("publisher" "Publishing company, its location")
-                          ("address" "Location of the Proceedings")
-                          ("month" "Month of the publication as a string (remove braces)")
-                          ("pages" "Pages in the conference proceedings")
-                          ("note" "Remarks to be put at the end of the \\bibitem")))
-			((("author" "Author1 [and Author2 ...] [and others]")
-                          ("title" "Title of the article in proceedings (BibTeX converts it to lowercase)")
-			  ("booktitle" "Name of the conference proceedings"))
-			 (("editor" "Editor1 [and Editor2 ...] [and others]")
-                          ("volume" "Volume of the conference proceedings in the series")
-                          ("number" "Number of the conference proceedings in a small series (overwritten by volume)")
-                          ("series" "Series in which the conference proceedings appeared")
-                          ("year" "Year of publication")
-			  ("organization" "Sponsoring organization of the conference")
-                          ("publisher" "Publishing company, its location")
-                          ("address" "Location of the Proceedings")
-                          ("month" "Month of the publication as a string (remove braces)")
-                          ("pages" "Pages in the conference proceedings")
-                          ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("Manual" . (((("title" "Title of the manual"))
-		  (("author" "Author1 [and Author2 ...] [and others]")
-                   ("organization" "Publishing organization of the manual")
-                   ("address" "Address of the organization")
-                   ("edition" "Edition of the manual as a capitalized English word")
-                   ("year" "Year of publication")
-		   ("month" "Month of the publication as a string (remove braces)")
-                   ("note" "Remarks to be put at the end of the \\bibitem")))))
-
-    ("MastersThesis" . (((("author" "Author1 [and Author2 ...] [and others]")
-                          ("title" "Title of the master\'s thesis (BibTeX converts it to lowercase)")
-                          ("school" "School where the master\'s thesis was written")
-                          ("year" "Year of publication"))
-			 (("address" "Address of the school (if not part of field \"school\") or country")
-                          ("type" "Type of the master\'s thesis")
-                          ("month" "Month of the publication as a string (remove braces)")
-                          ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("Misc" . ((()
-		(("author" "Author1 [and Author2 ...] [and others]")
-                 ("title" "Title of the reference (BibTeX converts it to lowercase)")
-                 ("howpublished" "The way in which the reference was published")
-                 ("year" "Year of publication")
-                 ("month" "Month of the publication as a string (remove braces)")
-                 ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("PhdThesis" . (((("author" "Author1 [and Author2 ...] [and others]")
-                      ("title" "Title of the PhD. thesis")
-                      ("school" "School where the PhD. thesis was written")
-                      ("year" "Year of publication"))
-		     (("address" "Address of the school (if not part of field \"school\") or country")
-                      ("type" "Type of the PhD. thesis")
-                      ("month" "Month of the publication as a string (remove braces)")
-                      ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("Proceedings" . (((("title" "Title of the conference proceedings")
-                        ("year" "Year of publication"))
-		       (("editor" "Editor1 [and Editor2 ...] [and others]")
-                        ("volume" "Volume of the conference proceedings in the series")
-                        ("number" "Number of the conference proceedings in a small series (overwritten by volume)")
-                        ("series" "Series in which the conference proceedings appeared")
-                        ("publisher" "Publishing company, its location")
-			("organization" "Sponsoring organization of the conference")
-                        ("address" "Location of the Proceedings")
-                        ("month" "Month of the publication as a string (remove braces)")
-                        ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("TechReport" . (((("author" "Author1 [and Author2 ...] [and others]")
-                       ("title" "Title of the technical report (BibTeX converts it to lowercase)")
-                       ("institution" "Sponsoring institution of the report")
-                       ("year" "Year of publication"))
-		      (("type" "Type of the report (if other than \"technical report\")")
-                       ("number" "Number of the technical report")
-                       ("address" "Address of the institution (if not part of field \"institution\") or country")
-                       ("month" "Month of the publication as a string (remove braces)")
-                       ("note" "Remarks to be put at the end of the \\bibitem")))))
-    ("Unpublished" . (((("author" "Author1 [and Author2 ...] [and others]")
-                        ("title" "Title of the unpublished reference (BibTeX converts it to lowercase)")
-                        ("note" "Remarks to be put at the end of the \\bibitem"))
-		       (("year" "Year of publication")
-                        ("month" "Month of the publication as a string (remove braces)")))))
-    )
-
-  "Defines reference types and their associated fields.
-List of
-(entry-name (required optional) (crossref-required crossref-optional))
-triples.
-If the third element is nil, the first pair is always to be used.
-If not, the second pair is to be used in the case of presence of a
-crossref field and the third in the case of absence.
-Required , optional, crossref-required and crossref-optional are lists. 
-Each element of these lists is a list of strings with two elements
-(first element  = name of the field, 
- second element = comment to appear in the echo area).")
-
-(defvar bibtex-predefined-strings
-  '(
-    ("jan") ("feb") ("mar") ("apr") ("may") ("jun") ("jul") ("aug")
-    ("sep") ("oct") ("nov") ("dec")
-    ("acmcs") ("acta") ("cacm") ("ibmjrd") ("ibmsj") ("ieeese")
-    ("ieeetc") ("ieeetcad") ("ipl") ("jacm") ("jcss") ("scp")
-    ("sicomp") ("tcs") ("tocs") ("tods") ("tog") ("toms") ("toois")
-    ("toplas")
-    )
-  "Alist of string definitions.
-Should contain the strings defined in the BibTeX style files. Each
-element is a list with just one element: the string.")
-
-(defvar bibtex-string-files nil
-  "*List of BibTeX files containing string definitions.
-Those files must be specified using pathnames relative to the
-directories specified in $BIBINPUTS. This variable is only evaluated
-when bibtex-mode is entered (i. e. when loading the BibTeX file).")
-
-(defvar bibtex-help-message t
-  "*If not nil print help messages in the echo area on entering a new field.")
-
-(defvar bibtex-autokey-names 1
-  "*Number of names to use for the automatically generated reference key.
-If this is set to anything but a number, all names are used.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-name-change-strings
-  '(("\\\\\\\"a" "ae") ("\\\\\\\"o" "oe") ("\\\\\\\"u" "ue")
-    ("\\\\\\\"s" "ss")
-    ("\\\\\\\"A" "Ae") ("\\\\\\\"O" "Oe") ("\\\\\\\"U" "Ue")
-    ("\\\"a" "ae") ("\\\"o" "oe") ("\\\"u" "ue") ("\\\"s" "ss")
-    ("\\\"A" "Ae") ("\\\"O" "Oe") ("\\\"U" "Ue")
-    ("{" "") ("}" ""))
-  "Alist of (old-regexp new-string) pairs.
-Any part of name matching a old-regexp is replaced by new-string.
-Case of the old-regexp is significant. All regexps are tried in the
-order in which they appear in the list, so be sure to avoid recursion here.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-name-length 'infty
-  "*Number of characters from name to incorporate into key.
-If this is set to anything but a number, all characters are used.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-name-separator ""
-  "*String that comes between any two names in the key.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-year-length 2
-  "*Number of rightmost digits from the year field yo incorporate into key.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-titlewords 5
-  "*Number of title words to use for the automatically generated reference key.
-If this is set to anything but a number, all title words are used.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-title-terminators
-  '("\\." "!"  "\\?" ":" ";" "---")
-  "*Regexp list defining the termination of the main part of the title.
-Case of the regexps is ignored.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-titlewords-stretch 2
-  "*Number of words that can additionally be used from the title.
-These words are used only, if a sentence from the title can be ended then.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-titleword-first-ignore
-  '("a" "an" "on" "the" "eine?" "der" "die" "das")
-  "*Determines words that may begin a title but are not to be used in the key.
-Each item of the list is a regexp. If the first word of the title matchs a
-regexp from that list, it is not included in the title, even if it is
-capitalized. Regexps in the list must be entered using lowercase letters.")
-
-(defvar bibtex-autokey-titleword-abbrevs nil
-  "*Determines exceptions to the usual abbreviation mechanism.
-A list of (old-regexp new-string) pairs. 
-Use all lowercase letters for old-regexp.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-titleword-change-strings
-  '(("\\\\\\\"a" "ae") ("\\\\\\\"o" "oe") ("\\\\\\\"u" "ue")
-    ("\\\\\\\"s" "ss")
-    ("\\\\\\\"A" "Ae") ("\\\\\\\"O" "Oe") ("\\\\\\\"U" "Ue")
-    ("\\\"a" "ae") ("\\\"o" "oe") ("\\\"u" "ue") ("\\\"s" "ss")
-    ("\\\"A" "Ae") ("\\\"O" "Oe") ("\\\"U" "Ue")
-    ("{" "") ("}" ""))
-  "Alist of (old-regexp new-string) pairs.
-Any part of title word matching a old-regexp is replaced by new-string.
-Case of the old-regexp is significant.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-titleword-length 5
-  "*Number of characters from title words to incorporate into key.
-If this is set to anything but a number, all characters are used.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-titleword-separator "_"
-  "*String to be put between the title words.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-name-year-separator ""
-  "*String to be put between name part and year part of key.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-year-title-separator ":_"
-  "*String to be put between name part and year part of key.
-See the documentation of function bibtex-generate-autokey for further detail.")
-
-(defvar bibtex-autokey-edit-before-use t
-  "*If non-nil, user is allowed to edit the generated key before it is used.")
-
-;; bibtex-font-lock-keywords is a user option as well, but since the
-;; patterns used to define this variable are defined in a later
-;; section of this file, its definition comes later.
-
-
-;; Syntax Table, Keybindings and BibTeX Entry List
-(defvar bibtex-mode-syntax-table
-  (let ((st (make-syntax-table)))
-    (modify-syntax-entry ?\" "w" st)
-    ;; this was formerly "\"". Does this cause any problems? 
-    (modify-syntax-entry ?$ "$$  " st)
-    (modify-syntax-entry ?% "<   " st)
-    (modify-syntax-entry ?'  "w   " st)
-    (modify-syntax-entry ?@  "w   " st)
-    (modify-syntax-entry ?\\ "\\" st)
-    (modify-syntax-entry ?\f ">   " st)
-    (modify-syntax-entry ?\n ">   " st)
-    (modify-syntax-entry ?~ " " st)
-    st))
-
-(defvar bibtex-mode-map
-  (let ((km (make-sparse-keymap)))
-    
-    (define-key km "\t" 'bibtex-find-text)
-    (define-key km "\n" 'bibtex-next-field)
-    (define-key km "\M-\t" 'bibtex-complete-string)
-    (define-key km "\C-c\"" 'bibtex-remove-double-quotes-or-braces)
-    (define-key km "\C-c{" 'bibtex-remove-double-quotes-or-braces)
-    (define-key km "\C-c}" 'bibtex-remove-double-quotes-or-braces)
-    (define-key km "\C-c\C-c" 'bibtex-clean-entry)
-    (define-key km "\C-c?" 'bibtex-print-help-message)
-    (define-key km "\C-c\C-p" 'bibtex-pop-previous)
-    (define-key km "\C-c\C-n" 'bibtex-pop-next)
-    (define-key km "\C-c\C-k" 'bibtex-kill-optional-field)
-    (define-key km "\C-c\C-d" 'bibtex-empty-field)
-    (define-key km "\C-c$"   'bibtex-ispell-entry)
-    (define-key km "\M-\C-a"   'bibtex-beginning-of-entry)
-    (define-key km "\M-\C-e"   'bibtex-end-of-entry)
-    (define-key km "\C-c\C-b"   'bibtex-entry)
-    (define-key km "\C-c\C-q" 'bibtex-hide-entry-bodies)
-    (define-key km "\C-c\C-rn" 'bibtex-narrow-to-entry)
-    (define-key km "\C-c\C-rw" 'widen)
-    (define-key km "\C-c\C-o" 'bibtex-remove-OPT)
-
-    (define-key km "\C-c\C-e\C-i" 'bibtex-InProceedings)
-    (define-key km "\C-c\C-ei" 'bibtex-InCollection)
-    (define-key km "\C-c\C-eI" 'bibtex-InBook)
-    (define-key km "\C-c\C-e\C-a" 'bibtex-Article)
-    (define-key km "\C-c\C-e\C-b" 'bibtex-InBook)
-    (define-key km "\C-c\C-eb" 'bibtex-Book)
-    (define-key km "\C-c\C-eB" 'bibtex-Booklet)
-    (define-key km "\C-c\C-e\C-c" 'bibtex-InCollection)
-    (define-key km "\C-c\C-e\C-m" 'bibtex-Manual)
-    (define-key km "\C-c\C-em" 'bibtex-MastersThesis)
-    (define-key km "\C-c\C-eM" 'bibtex-Misc)
-    (define-key km "\C-c\C-e\C-p" 'bibtex-InProceedings)
-    (define-key km "\C-c\C-ep" 'bibtex-Proceedings)
-    (define-key km "\C-c\C-eP" 'bibtex-PhdThesis)
-    (define-key km "\C-c\C-e\M-p" 'bibtex-preamble)
-    (define-key km "\C-c\C-e\C-s" 'bibtex-string)
-    (define-key km "\C-c\C-e\C-t" 'bibtex-TechReport)
-    (define-key km "\C-c\C-e\C-u" 'bibtex-Unpublished)
-    km))
-
-(define-key bibtex-mode-map [menu-bar bibtex-edit]
-  (cons "BibTeX-Edit" (make-sparse-keymap "BibTeX-Edit")))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-print-help-message]
-  '("Help about Current Field" . bibtex-print-help-message))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-complete-string]
-  '("String Complete" . bibtex-complete-string))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-next-field]
-  '("Next Field" . bibtex-next-field))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-find-text]
-  '("End of Field" . bibtex-find-text))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-pop-previous]
-  '("Snatch from Similar Preceding Field" . bibtex-pop-previous))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-pop-next]
-  '("Snatch from Similar Following Field" . bibtex-pop-next))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-remove-OPT]
-  '("Remove OPT" . bibtex-remove-OPT))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-remove-double-quotes-or-braces]
-  '("Remove Quotes or Braces" . bibtex-remove-double-quotes-or-braces))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-clean-entry]
-  '("Clean Up Entry" . bibtex-clean-entry))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-sort-entries]
-  '("Sort Entries" . bibtex-sort-entries))
-(define-key bibtex-mode-map
-  [menu-bar bibtex-edit bibtex-validate-buffer-from-point]
-  '("Validate Entries Starting at Point" .
-    (lambda ()
-      (interactive)
-      (bibtex-validate-buffer t))))
-(define-key bibtex-mode-map [menu-bar bibtex-edit bibtex-validate-buffer]
-  '("Validate Entries" . bibtex-validate-buffer))
-
-(define-key bibtex-mode-map [menu-bar entry-types]
-  (cons "Entry-Types" (make-sparse-keymap "Entry-Types")))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-preamble]
-  '("Preamble" . bibtex-preamble))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-string]
-  '("String" . bibtex-string))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-Misc]
-  '("Miscellaneous" . bibtex-Misc))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-Unpublished]
-  '("Unpublished" . bibtex-Unpublished))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-Manual]
-  '("Technical Manual" . bibtex-Manual))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-TechReport]
-  '("Technical Report" . bibtex-TechReport))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-MastersThesis]
-  '("Master's Thesis" . bibtex-MastersThesis))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-PhdThesis]
-  '("PhD. Thesis" . bibtex-PhdThesis))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-Booklet]
-  '("Booklet (Bound, but no Publisher/Institution)" . bibtex-Booklet))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-Book]
-  '("Book" . bibtex-Book))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-Proceedings]
-  '("Conference Proceedings" . bibtex-Proceedings))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-InBook]
-  '("Chapter or Pages in a Book" . bibtex-InBook))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-InCollection]
-  '("Article in a Collection" . bibtex-InCollection))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-InProceedings]
-  '("Article in Conference Proceedings" . bibtex-InProceedings))
-(define-key bibtex-mode-map [menu-bar entry-types bibtex-Article]
-  '("Article in Journal" . bibtex-Article))
-
-
-;; Bug Reporting
-
-(defconst
-  bibtex-maintainer-address "Stefan Schoef <schoef@offis.uni-oldenburg.de>")
-;; current maintainer
-
-
-;; Internal Variables
-
-(defvar bibtex-pop-previous-search-point nil)
-;; Next point where bibtex-pop-previous starts looking for a similar
-;; entry.
-
-(defvar bibtex-pop-next-search-point nil)
-;; Next point where bibtex-pop-next starts looking for a similar entry.
-
-(defvar bibtex-completion-candidates nil)
-;; Candidates for bibtex-complete-string. Initialized from
-;; bibtex-predefined-strings and bibtex-string-files. This variable is
-;; buffer-local.
-(make-variable-buffer-local 'bibtex-completion-candidates)
-
-(defvar bibtex-keys nil)
-;; Candidates for TAB completion when entering a reference key using
-;; the minibuffer. Initialized in bibtex-mode and updated for each
-;; new entry. This variable is buffer-local.
-(make-variable-buffer-local 'bibtex-keys)
-
-(defvar bibtex-buffer-last-parsed-for-keys-tick nil)
-;; Remembers the value returned by buffer-modified-tick when buffer
-;; was parsed for keys the last time.
-(make-variable-buffer-local 'bibtex-keys)
-
-
-;; Functions to Parse the BibTeX Entries
-
-(defun bibtex-cfield (name text)
-  ;; Create a regexp for a BibTeX field of name NAME and text TEXT.
-  (concat ",[ \t\n]*\\("
-	  name
-	  "\\)[ \t\n]*=[ \t\n]*\\("
-	  text
-	  "\\)"))
-(defconst bibtex-name-in-cfield 1)
-;; The regexp subexpression number of the name part in bibtex-cfield.
-
-(defconst bibtex-text-in-cfield 2)
-;; The regexp subexpression number of the text part in bibtex-cfield.
-
-(defconst bibtex-field-name "[^\"#%'(),={} \t\n0-9][^\"#%'(),={} \t\n]*")
-;; Regexp defining the name part of a BibTeX field.
-
-(defconst bibtex-field-const "[][A-Za-z0-9.:;?!`'()/*@_+=|<>-]+")
-;; Format of a bibtex field constant (same as bibtex-reference-key (see below))
-
-(defconst bibtex-field-string-part-not-braced
-  "[^{}]")
-;; Match field string part without braces
-
-(defconst bibtex-field-string-part-no-inner-braces
-  (concat
-   "{"
-   "\\(" bibtex-field-string-part-not-braced "\\)*"
-   "}"))
-;; Match field string part with no inner braces
-
-(defconst bibtex-field-string-part-1-inner-brace
-  (concat
-   "{"
-   "\\("
-     "\\(" bibtex-field-string-part-not-braced "\\)"
-     "\\|"
-     "\\(" bibtex-field-string-part-no-inner-braces "\\)"
-   "\\)*"
-   "}"))
-;; Match field string part with at most 1 inner brace
-
-(defconst bibtex-field-string-part-2-inner-braces
-  (concat
-   "{"
-   "\\("
-     "\\(" bibtex-field-string-part-not-braced "\\)"
-     "\\|"
-     "\\(" bibtex-field-string-part-no-inner-braces "\\)"
-     "\\|"
-     "\\(" bibtex-field-string-part-1-inner-brace "\\)"
-   "\\)*"
-   "}"))
-;; Match field string part with at most 2 inner braces
-
-(defconst bibtex-field-string-part-3-inner-braces
-  (concat
-   "{"
-   "\\("
-     "\\(" bibtex-field-string-part-not-braced "\\)"
-     "\\|"
-     "\\(" bibtex-field-string-part-no-inner-braces "\\)"
-     "\\|"
-     "\\(" bibtex-field-string-part-1-inner-brace "\\)"
-     "\\|"
-     "\\(" bibtex-field-string-part-2-inner-braces "\\)"
-   "\\)*"
-   "}"))
-;; Match field string part with at most 3 inner braces
-
-(defconst bibtex-field-string-braced
-  bibtex-field-string-part-3-inner-braces)
-;; Match braced field string with inner nesting level of braces at most 3
-
-(defconst bibtex-field-string-quoted
-  (concat
-   "\""
-   "\\("
-     "\\(" "[^\"\\]" "\\)"      ;; every character except quote or backslash
-     "\\|"
-;;     "\\(" "\"[A-Za-z-]" "\\)"  ;; a quote followed by a letter or dash 
-;;     "\\|"
-;; last two lines commented out until lines like
-;;   author = "Stefan Sch"of"
-;; are supported by BibTeX
-     "\\(" "\\\\.\\|\n"  "\\)"  ;; a backslash followed by any character
-   "\\)*"
-   "\""))
-;; Match quoted field string
-
-(defconst bibtex-field-string
-  (concat
-   "\\(" bibtex-field-string-braced "\\)"
-   "\\|"
-   "\\(" bibtex-field-string-quoted "\\)"))
-;; Match a braced or quoted string
-
-(defconst bibtex-field-string-or-const
-  (concat bibtex-field-const "\\|" bibtex-field-string))
-;; Match either bibtex-field-string or bibtex-field-const.
-
-(defconst bibtex-field-text
-  (concat
-    "\\(" bibtex-field-string-or-const "\\)"
-    "\\([ \t\n]+#[ \t\n]+\\(" bibtex-field-string-or-const "\\)\\)*"))
-;; Regexp defining the text part of a BibTeX field: either a string,
-;; or an empty string, or a constant followed by one or more # /
-;; constant pairs.
-
-(defconst bibtex-field
-  (bibtex-cfield bibtex-field-name bibtex-field-text))
-;; Regexp defining the format of a BibTeX field.
-
-(defconst bibtex-name-in-field bibtex-name-in-cfield)
-;; The regexp subexpression number of the name part in BibTeX-field.
-
-(defconst bibtex-text-in-field bibtex-text-in-cfield)
-;; The regexp subexpression number of the text part in BibTeX-field.
-
-(defconst bibtex-reference-type "@[A-Za-z]+")
-;; Regexp defining the type part of a BibTeX reference entry.
-
-(defconst bibtex-reference-key "[][A-Za-z0-9.:;?!`'()/*@_+=|<>-]+")
-;; Regexp defining the label part of a BibTeX reference entry (same as
-;; bibtex-field-const (see above))
-
-(defconst bibtex-reference-head
-  (concat "^[ \t]*\\("
-	  bibtex-reference-type
-	  "\\)[ \t]*[({][ \t]*\\("
-	  bibtex-reference-key
-	  "\\)"))
-;; Regexp defining format of the header line of a BibTeX reference
-;; entry.
-
-(defconst bibtex-reference-maybe-empty-head
-  (concat bibtex-reference-head "?"))
-;; Regexp defining format of the header line of a maybe empty
-;; BibTeX reference entry (without reference key).
-
-(defconst bibtex-type-in-head 1)
-;; The regexp subexpression number of the type part in
-;; bibtex-reference-head.
-
-(defconst bibtex-key-in-head 2)
-;; The regexp subexpression number of the key part in
-;; bibtex-reference-head.
-
-(defconst bibtex-reference
-  (concat bibtex-reference-head
-	  "\\([ \t\n]*" bibtex-field "\\)*"
-	  "[ \t\n]*,?[ \t\n]*[})]"))
-;; Regexp defining the format of a BibTeX reference entry.
-
-(defconst bibtex-type-in-reference bibtex-type-in-head)
-;; The regexp subexpression number of the type part in
-;; bibtex-reference.
-
-(defconst bibtex-key-in-reference bibtex-key-in-head)
-;; The regexp subexpression number of the key part in
-;; bibtex-reference.
-
-(defconst bibtex-string
-  (concat "^[ \t]*@[sS][tT][rR][iI][nN][gG][ \t\n]*[({][ \t\n]*\\("
-	  bibtex-reference-key
-	  "\\)[ \t\n]*=[ \t\n]*\\("
-	  bibtex-field-text
-	  "\\)[ \t\n]*[})]"))
-;; Regexp defining the format of a BibTeX string entry.
-
-(defconst bibtex-key-in-string 1)
-;; The regexp subexpression of the name part in bibtex-string.
-
-(defconst bibtex-text-in-string 2)
-;; The regexp subexpression of the text part in bibtex-string.
-
-(defvar bibtex-font-lock-keywords
-  (list
-   (list bibtex-reference-maybe-empty-head
-         (list bibtex-type-in-head 'font-lock-function-name-face)
-         (list bibtex-key-in-head 'font-lock-reference-face nil t))
-   ;; reference type and reference label
-   (list (concat "^[ \t]*\\(OPT" bibtex-field-name "\\)[ \t]*=")
-         1 'font-lock-comment-face)
-   ;; optional field names (treated as comments)
-   (list (concat "^[ \t]*\\(" bibtex-field-name "\\)[ \t]*=")
-         1 'font-lock-variable-name-face)
-   ;; field names
-   "*Default expressions to highlight in BibTeX mode."))
-;; now all needed patterns are defined
-
-(defconst bibtex-name-alignment 2)
-;; Alignment for the name part in BibTeX fields. Chosen on aesthetic
-;; grounds only.
-
-(defconst bibtex-text-alignment (length "  organization = "))
-;; Alignment for the text part in BibTeX fields. Equal to the space
-;; needed for the longest name part.
-
-
-;; Helper Functions
-
-(defun assoc-ignore-case (string alist)
-  ;; Return non-nil if STRING is `equal' to the car of an element of
-  ;; LIST. Comparison is done with case ignored. The value is actually
-  ;; the element of LIST whose car is `equal' to STRING.
-  (or (assoc string alist)
-      (while (and alist
-		  (not (string-equal
-                        (downcase string)
-                        (downcase (car (car alist))))))
-	(setq alist (cdr alist)))
-      (car alist)))
-
-(defun member-of-regexp (string list)
-  ;; Return non-nil if STRING is exactly matched by an element of
-  ;; LIST. This function is influenced by the actual value of
-  ;; `case-fold-search'. The value is actually the tail of LIST whose
-  ;; car matches STRING.
-  (while
-      (and
-       list
-       (not
-        (string-match
-         (concat "^" (car list) "$")
-         string)))
-    (setq list (cdr list)))
-  list)
-
-(defun assoc-of-regexp (string alist)
-  ;; Return non-nil if STRING is exactly matched by the car of an
-  ;; element of LIST. This function is influenced by the actual value
-  ;; of `case-fold-search'. The value is actually the element of LIST
-  ;; whose car matches STRING.
-  (while
-      (and
-       alist
-       (not
-        (string-match
-         (concat "^" (car (car alist)) "$")
-         string)))
-    (setq alist (cdr alist)))
-  (car alist))
-
-(defun skip-whitespace-and-comments ()
-  (let ((md (match-data)))
-    (unwind-protect
-	(while (cond ((looking-at "\\s>+\\|\\s +")
-		      ;; was whitespace
-		      ;; NOTE: also checked end-comment.  In latex and
-		      ;; lisp modes, newline is an end comment, but it
-		      ;; should also be a whitespace char.
-		      (goto-char (match-end 0)))
-		     ;; If looking at beginning of comment, skip to end.
-		     ((looking-at "\\s<")
-		      (re-search-forward "\\s>"))))		      
-      (store-match-data md))))
-
-(defun map-bibtex-entries (fun)
-  ;; Call FUN for each BibTeX entry starting with the current. Do this
-  ;; to the end of the file. FUN is called with one argument, the key
-  ;; of the entry, and with point inside the entry. If
-  ;; bibtex-sort-ignore-string-entries is non-nil, FUN will not be called
-  ;; for @string entries.
-  (bibtex-beginning-of-entry)
-  (while (re-search-forward bibtex-reference-head nil t)
-    (if (and bibtex-sort-ignore-string-entries
-	     (string-equal "@string"
-                           (downcase (buffer-substring-no-properties
-                                      (match-beginning bibtex-type-in-head)
-                                      (match-end bibtex-type-in-head)))))
-	nil
-      (funcall fun (buffer-substring-no-properties
-                    (match-beginning bibtex-key-in-head)
-                    (match-end bibtex-key-in-head))))))
-
-(defun bibtex-flash-head ()
-  ;; Flash at BibTeX reference head before point, if exists.
-  (let ((flash))
-    (cond ((re-search-backward bibtex-reference-head (point-min) t)
-	   (goto-char (match-beginning bibtex-type-in-head))
-	   (setq flash (match-end bibtex-key-in-reference)))
-	  (t
-	   (end-of-line)
-	   (skip-chars-backward " \t")
-	   (setq flash (point))
-	   (beginning-of-line)
-	   (skip-chars-forward " \t")))
-    (if (pos-visible-in-window-p (point))
-	(sit-for 1)
-      (message "From: %s"
-	       (buffer-substring (point) flash)))))
-
-(defun bibtex-move-outside-of-entry ()
-  ;; Make sure we are outside of a BibTeX entry.
-  (cond ((or
-	  (= (point) (point-max))
-	  (= (point) (point-min))
-	  (looking-at "[ \n]*@")
-	  )
-	 t)
-	(t
-	 (backward-paragraph)
-	 (forward-paragraph)))
-  (re-search-forward "[ \t\n]*" (point-max) t))
-
-(defun beginning-of-first-bibtex-entry ()
-  ;; Go to the beginning of the first BibTeX entry in buffer.
-  (goto-char (point-min))
-   (cond
-    ((re-search-forward "^@" nil 'move)
-     (beginning-of-line))
-    ((and (bobp) (eobp))
-     nil)
-    (t
-     (message "Warning: No BibTeX entries found!"))))
-
-(defun bibtex-inside-field ()
-  ;; Try to avoid point being at end of a BibTeX field.
-  (end-of-line)
-  (skip-chars-backward " \t")
-  (cond ((= (preceding-char) ?,)
-	 (forward-char -2)))
-  (cond ((or
-          (= (preceding-char) ?})
-          (= (preceding-char) ?\"))
-         (forward-char -1))))
-
-(defun bibtex-enclosing-field ()
-  ;; Search for BibTeX field enclosing point. Point moves to end of
-  ;; field; also, use match-beginning and match-end to parse the field.
-  ;; sct@dcs.edinburgh.ac.uk
-  (let ((old-point (point)))
-    (condition-case errname
- 	(bibtex-enclosing-regexp bibtex-field)
-      (search-failed
-       (goto-char old-point)
-       (error "Can't find enclosing BibTeX field.")))))
-
-(defun bibtex-enclosing-reference ()
-  ;; Search for BibTeX reference enclosing point. Point moves to
-  ;; beginning of reference. Beginning/end of reference is given by
-  ;; (match-beginning/match-end 0).
-  (let ((old-point (point)))
-    (if (not
-         (re-search-backward bibtex-reference-head (point-min) t))
-        (progn
-          (error "Can't find enclosing BibTeX reference.")
-          (goto-char old-point)))
-    (goto-char (match-beginning bibtex-type-in-head))
-    (let ((pnt (point)))
-      (if (not
-           (re-search-forward bibtex-reference (point-max) t))
-          (progn
-            (error "Can't find enclosing BibTeX reference.")
-            (goto-char old-point))
-        (goto-char pnt)))))
-
-(defun bibtex-enclosing-reference-maybe-empty-head ()
-  ;; Search for BibTeX reference enclosing point. Point moves to
-  ;; beginning of reference. Beginning/end of reference is given by
-  ;; (match-beginning/match-end 0).
-  (let ((old-point (point)))
-    (if (not
-         (re-search-backward
-          bibtex-reference-maybe-empty-head (point-min) t))
-        (progn
-          (error "Can't find enclosing BibTeX reference.")
-          (goto-char old-point)))
-    (goto-char (match-beginning bibtex-type-in-head))
-    (let ((pnt (point)))
-      (if (not
-           (re-search-forward
-            (concat
-             bibtex-reference-maybe-empty-head
-             "\\([ \t\n]*" bibtex-field "\\)*"
-             "[ \t\n]*,?[ \t\n]*[})]")
-            (point-max) t))
-          (progn
-            (error "Can't find enclosing BibTeX reference.")
-            (goto-char old-point))
-        (goto-char pnt)))))
-
-(defun bibtex-enclosing-regexp (regexp)
-  ;; Search for REGEXP enclosing point. Point moves to end of
-  ;; REGEXP. See also match-beginning and match-end. If an enclosing
-  ;; REGEXP is not found, signals search-failed; point is left in an
-  ;; undefined location.
-  ;; Doesn't something like this exist already?
-  ;; compute reasonable limits for the loop
-  (let* ((initial (point))
-	 (right (if (re-search-forward regexp (point-max) t)
-		    (match-end 0)
-		  (point-max)))
-	 (left
-	  (progn
-	    (goto-char initial)
-	    (if (re-search-backward regexp (point-min) t)
-		(match-beginning 0)
-	      (point-min)))))
-    ; within the prescribed limits, loop until a match is found
-    (goto-char left)
-    (re-search-forward regexp right nil 1)
-    (if (> (match-beginning 0) initial)
-	(signal 'search-failed (list regexp)))	  
-    (while (<= (match-end 0) initial)
-      (re-search-forward regexp right nil 1)
-      (if (> (match-beginning 0) initial)
-	  (signal 'search-failed (list regexp))))
-    ))
-
-(defun bibtex-autokey-change (string change-list)
-  ;; Returns a string where some regexps are changed according to
-  ;; change-list. Every item of change-list is an (old-regexp
-  ;; new-string) pair.
-  (let ((return-string string)
-        case-fold-search
-        (index 0)
-        (len (length change-list))
-        change-item)
-    (while (< index len)
-      (setq change-item (elt change-list index))
-      (while (string-match (car change-item) return-string)
-        (setq
-         return-string
-         (concat (substring return-string 0 (match-beginning 0))
-                 (elt change-item 1)
-                 (substring return-string (match-end 0)))))
-      (setq index (1+ index)))
-    return-string))
-
-(defun bibtex-autokey-abbrev (string len)
-  ;; Returns an abbreviation of string with at least len
-  ;; characters. String is aborted only after a consonant or at the
-  ;; word end. If len is not a number, string is returned unchanged.
-  (let* ((string-length (length string))
-         (len (if (numberp len)
-                  (min len string-length)
-                len))
-         (return-string (if (numberp len)
-                            (substring string 0 len)))
-         (index len)
-         (vowels '(?a ?e ?i ?o ?u ?A ?E ?I ?O ?U)))
-    (if (numberp len)
-        (progn
-          (while (and
-                  (< index string-length) 
-                  (member (elt return-string
-                               (1- (length return-string)))
-                          vowels))
-            (setq return-string (concat return-string
-                                        (substring
-                                         string index (1+ index)))
-                  index (1+ index)))
-          return-string)
-      string)))        
-
-(defun bibtex-generate-autokey ()
-  "Generates automatically a key from the author/editor and the title field.
-The generation algorithm works as follows:
-  1. If there is a non-empty author (preferred) or editor field,
-     use it for the name part of the key.
-  2. Change any substring found in `bibtex-autokey-name-change-strings' 
-     to the corresponding new one (see documentation of this variable
-     for further detail).
-  3. For every of the first `bibtex-autokey-names' names in the
-     \"name\" field, determine the last name.
-  4. From every last name, take at least `bibtex-autokey-name-length'
-     characters (abort only after a consonant or at a word end).
-  5. Build the name part of the key by concatenating all abbreviated last
-     names with the string `bibtex-autokey-name-separator' between
-     any two.
-  6. Build the year part of the key by truncating the contents of the
-     \"year\" field to the rightmost `bibtex-autokey-year-length'
-     digits (useful values are 2 and 4).
-  7. For the title part of the key change the contents of the \"title\"
-     field of the reference according to
-     `bibtex-autokey-titleword-change-strings' to the corresponding
-     new one (see documentation of this variable for further detail).
-  8. Abbreviate the result to the string up to (but not including) the
-     first occurrence of a regexp matched by the items of
-     `bibtex-autokey-title-terminators' and delete the first
-     word if it appears in `bibtex-autokey-titleword-first-ignore'. 
-     Build the title part of the key by using at least the first
-     `bibtex-autokey-titlewords' capitalized words from this
-     abbreviated title. If the abbreviated title ends after maximal
-     `bibtex-autokey-titlewords' + `bibtex-autokey-titlewords-stretch'
-     capitalized words, all capitalized words from the abbreviated title
-     are used. 
-  9. For every used title word that appears in
-     `bibtex-autokey-titleword-abbrevs' use the corresponding abbreviation
-     (see documentation of this variable for further detail).
- 10. From every title word not generated by an abbreviation, take at
-     least `bibtex-autokey-titleword-length' characters (abort only after
-     a consonant or at a word end).
- 11. Build the title part of the key by concatenating all abbreviated
-     title words with the string `bibtex-autokey-titleword-separator'
-     between any two.
- 12. At least, to get the key, concatenate the name part, the year part
-     and the title part with `bibtex-autokey-name-year-separator'
-     between the name and the year if both are non-empty and
-     `bibtex-autokey-year-title-separator' between the year and
-     the title if both are non-empty."
-
-  (let* ((pnt (point))
-         (min
-          (progn
-            (bibtex-beginning-of-entry)
-            (point)))
-         (max
-          (progn
-            (bibtex-end-of-entry)
-            (point)))
-         (namefield
-          (progn
-            (goto-char min)
-            (if (or
-                 (re-search-forward "^[ \t]*author[ \t]*=" max t)
-                 (re-search-forward "^[ \t]*editor[ \t]*=" max t))
-                (let* (bibtex-help-message
-                       (start (progn
-                                (bibtex-find-text t)
-                                (point)))
-                       (end (progn
-                              (bibtex-find-text nil)
-                              (point))))
-                  (bibtex-autokey-change
-                   (buffer-substring-no-properties start end)
-                   bibtex-autokey-name-change-strings))
-              "")))
-         (namelist
-          (mapcar
-           (function
-            (lambda (fullname)
-              (bibtex-autokey-abbrev
-               (if (string-match "," fullname)
-                   (substring fullname 0 (match-beginning 0))
-                 (progn
-                   (if (string-match " [^ ]*$" fullname)
-                       (substring
-                        fullname (1+ (match-beginning 0)))
-                     fullname)))
-               bibtex-autokey-name-length)))
-           ;; Gather all names into a list
-           (let (names
-                 (counter 0))
-             (while (and
-                     (not (equal namefield ""))
-                     (or
-                      (not (numberp bibtex-autokey-names))
-                      (< counter bibtex-autokey-names)))
-               (if (string-match " and " namefield)
-                   (progn
-                     (setq
-                      names
-                      (append names
-                              (list
-                               (downcase
-                                (substring
-                                 namefield 0 (match-beginning 0)))))
-                      namefield
-                      (substring namefield (match-end 0))))
-                 (setq names
-                       (append names (list (downcase namefield)))
-                       namefield ""))
-               (setq counter (1+ counter)))
-             names)))
-         (namepart (mapconcat (function (lambda (name) name))
-                              namelist
-                              bibtex-autokey-name-separator))
-         (yearfield
-          (progn
-            (goto-char min)
-            (if (re-search-forward
-                 "^[ \t]*year[ \t]*=[ \t]*\\([0-9]*\\)" max t)
-                (buffer-substring-no-properties
-                 (match-beginning 1) (match-end 1))
-              "")))
-         (yearpart
-          (if (equal yearfield "")
-              ""
-            (substring yearfield
-                       (- (length yearfield)
-                          bibtex-autokey-year-length))))
-         (titlestring
-          (let ((case-fold-search t)
-                (titlefield
-                 (progn
-                   (goto-char min)
-                   (if (re-search-forward
-                        "^[ \t]*title[ \t]*=" max t)
-                       (let* (bibtex-help-message
-                              (start (progn
-                                       (bibtex-find-text t)
-                                       (point)))
-                              (end (progn
-                                     (bibtex-find-text nil)
-                                     (point))))
-                         (bibtex-autokey-change
-                          (buffer-substring-no-properties start end)
-                          bibtex-autokey-titleword-change-strings))
-                     "")))
-                case-fold-search
-                (index 0)
-                (numberofitems
-                 (length bibtex-autokey-title-terminators)))
-            (while (< index numberofitems)
-              (if (string-match
-                   (elt bibtex-autokey-title-terminators index)
-                   titlefield)
-                  (setq titlefield
-                        (substring titlefield 0 (match-beginning 0))))
-              (setq index (1+ index)))
-            titlefield))
-         (titlelist
-          (mapcar
-           (function
-            (lambda (titleword)
-              (let ((abbrev
-                     (assoc-of-regexp
-                      titleword bibtex-autokey-titleword-abbrevs)))
-                (if abbrev
-                    (elt abbrev 1)
-                  (bibtex-autokey-abbrev
-                   titleword
-                   bibtex-autokey-titleword-length)))))
-           ;; Gather all titlewords into a list
-           (let (titlewords
-                 titlewords-extra
-                 case-fold-search
-                 (counter 0)
-                 (first t))
-             (while (and
-                     (not (equal titlestring ""))
-                     (or
-                      (not (numberp bibtex-autokey-titlewords))
-                      (< counter (+
-                                  bibtex-autokey-titlewords
-                                  bibtex-autokey-titlewords-stretch))))
-               (if (string-match "\\b[A-Z][A-Za-z0-9]*" titlestring)
-                   (let* ((end-match (match-end 0))
-                          (titleword
-                           (downcase (substring titlestring
-                                                (match-beginning 0)
-                                                end-match))))
-                     (if (or
-                          (not (numberp bibtex-autokey-titlewords))
-                          (< counter bibtex-autokey-titlewords))
-                         (if (and
-                              first
-                              (member-of-regexp
-                               titleword
-                               bibtex-autokey-titleword-first-ignore))
-                             (setq counter -1)
-                           (setq titlewords
-                                 (append titlewords (list titleword))))
-                       (setq
-                        titlewords-extra
-                        (append titlewords-extra (list titleword))))
-                     (setq titlestring
-                           (substring titlestring end-match)))
-                 (setq titlestring ""))
-               (setq first nil
-                     counter (1+ counter)))
-             (if (string-match "\\b[A-Z][^ ]*\\b" titlestring)
-                 titlewords
-               (append titlewords titlewords-extra)))))
-         (titlepart (mapconcat (function (lambda (name) name))
-                               titlelist
-                               bibtex-autokey-titleword-separator))
-         (autokey
-          (concat
-           namepart
-           (if (not
-                (or
-                 (equal namepart "")
-                 (equal yearpart "")))
-               bibtex-autokey-name-year-separator)
-           yearpart
-           (if (not
-                (or
-                 (and
-                  (equal namepart "")
-                  (equal yearpart ""))
-                 (equal titlepart "")))
-               bibtex-autokey-year-title-separator)
-           titlepart)))
-    (goto-char pnt)
-    autokey))
-
-(defun bibtex-parse-keys (add &optional abortable)
-  ;; Sets bibtex-keys to the keys used in the whole (possibly
-  ;; restricted) buffer (either as entry keys or as crossref entries).
-  ;; If ADD is non-nil adds the new keys to bibtex-keys instead of
-  ;; simply resetting it. If ABORTABLE is non-nil abort on user input.
-  (if bibtex-maintain-sorted-entries
-      (let ((labels (if add
-                        bibtex-keys))
-            label
-            (case-fold-search t))
-        (save-excursion
-          (goto-char (point-min))
-          (if (not add)
-              (message "Parsing reference keys..."))
-
-          (if (not
-               (catch 'userkey
-                 (while
-                     (re-search-forward
-                      (concat
-                       "\\(" bibtex-reference-head "\\)"
-                       "\\|"
-                       "\\("
-                         "^[ \t]*crossref[ \t\n]*=[ \t\n]*"
-                         "\\("
-                           "\\({"
-                           bibtex-reference-key
-                           ;; every valid crossref entry must have the
-                           ;; form of a reference key, so we need no
-                           ;; nesting of brace etc. here
-                           "}\\)"
-                           "\\|"
-                           "\\(\""
-                           bibtex-reference-key
-                           "\"\\)"
-                         "\\)"
-                         ",?$"
-                       "\\)")
-                      nil t)
-                   (if (and
-                        abortable
-                        (input-pending-p))
-                       (throw 'userkey t))
-                   (if (match-beginning (1+ bibtex-key-in-head))
-                       (setq
-                        label
-                        (buffer-substring-no-properties 
-                         (match-beginning (1+ bibtex-key-in-head))
-                         (match-end (1+ bibtex-key-in-head))))
-                     (setq
-                      label
-                      (buffer-substring-no-properties
-                       (1+ (match-beginning (+ 3 bibtex-key-in-head)))
-                       (1- (match-end (+ 3 bibtex-key-in-head))))))
-                   (if (not (assoc label labels))
-                       (setq labels
-                             (cons (list label) labels))))))
-              (progn
-                (setq
-                 bibtex-buffer-last-parsed-for-keys-tick
-                 (buffer-modified-tick))
-                (if (not add)
-                    (message "Parsing reference keys... done"))
-                (setq bibtex-keys labels)))))))
-
-(defun bibtex-auto-fill-function ()
-  (let ((fill-prefix (make-string (+ bibtex-text-alignment 1) ? )))
-    (do-auto-fill)))
-
-
-;; Interactive Functions:
-
-;;;###autoload
-(defun bibtex-mode () 
-  "Major mode for editing BibTeX files.
-To submit a problem report, enter `\\[bibtex-submit-bug-report]' from a
-bibtex-mode buffer.  This automatically sets up a mail buffer with
-version information already added.  You just need to add a description
-of the problem, including a reproducable test case and send the
-message.
-
-\\{bibtex-mode-map}
-
-A command such as \\[bibtex-Book] will outline the fields for a BibTeX book entry.
-
-The optional fields start with the string OPT, and thus ignored by BibTeX.
-The OPT string may be removed from a field with \\[bibtex-remove-OPT].
-\\[bibtex-kill-optional-field] kills the current optional field entirely.
-\\[bibtex-remove-double-quotes-or-braces] removes the double-quotes or
-braces around the text of the current field.  \\[bibtex-empty-field]
-replaces the text of the current field with the default \"\" or {}.
-
-The command \\[bibtex-clean-entry] cleans the current entry, i.e. (i) removes
-double-quotes or braces from entirely numerical fields, (ii) removes
-OPT from all non-empty optional fields, (iii) removes all empty
-optional fields, and (iv) checks that no non-optional fields are empty.
-
-Use \\[bibtex-find-text] to position the cursor at the end of the current field.
-Use \\[bibtex-next-field] to move to end of the next field.
-
-The following may be of interest as well:
-
-  Functions:
-    bibtex-entry
-    bibtex-print-help-message
-    bibtex-beginning-of-entry
-    bibtex-end-of-entry
-    bibtex-ispell-abstract
-    bibtex-narrow-to-entry
-    bibtex-hide-entry-bodies
-    bibtex-sort-entries
-    bibtex-validate-buffer
-    bibtex-pop-previous
-    bibtex-pop-next
-    bibtex-complete-string
-
-  Variables:
-    bibtex-field-left-delimiter
-    bibtex-field-right-delimiter
-    bibtex-include-OPTcrossref
-    bibtex-include-OPTkey
-    bibtex-include-OPTannote
-    bibtex-mode-user-optional-fields
-    bibtex-clean-entry-zap-empty-opts
-    bibtex-sort-ignore-string-entries
-    bibtex-maintain-sorted-entries
-    bibtex-entry-field-alist
-    bibtex-predefined-strings
-    bibtex-string-files
-
----------------------------------------------------------
-Entry to this mode calls the value of bibtex-mode-hook if that value is
-non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map bibtex-mode-map)
-  (setq major-mode 'bibtex-mode)
-  (setq mode-name "BibTeX")
-  (set-syntax-table bibtex-mode-syntax-table)
-  (setq bibtex-completion-candidates bibtex-predefined-strings)
-  (mapcar
-   (function
-    (lambda (filename)
-      ;; collect pathnames
-      (let* ((bib (getenv "BIBINPUTS"))
-             (path (if bib
-                       bib
-                     "."))
-             (dirs
-              (mapcar
-               (function
-                (lambda (dirname)  ;; strips off trailing slashes
-                  (let ((len (length dirname)))
-                    (if (equal (elt dirname (1- len)) "/")
-                        (substring dirname 0 (1- (1- len)))
-                      dirname))))
-               (let (actdirs)
-                 (while (string-match ":" path)
-                   (setq actdirs
-                         (append actdirs
-                                 (list (substring
-                                        path 0
-                                        (1- (match-end 0)))))
-                         path (substring path (match-end 0))))
-                 (append actdirs (list path)))))
-             (filename (if (string-match "\.bib$" filename)
-                           filename
-                         (concat filename ".bib")))
-             fullfilename
-             (item 0)
-             (size (length dirs)))
-        ;; test filenames
-        (while (and
-                (< item size)
-                (not (file-readable-p
-                      (setq fullfilename
-                            (concat (elt dirs item) "/" filename)))))
-          (setq item (1+ item)))
-        (if (< item size)
-            ;; file was found
-            (let ((curbuf (current-buffer))
-                  (bufname (make-temp-name ""))
-                  (compl bibtex-completion-candidates))
-              (create-file-buffer bufname)
-              (set-buffer bufname)
-              (insert-file-contents fullfilename)
-              (goto-char (point-min))
-              (while (re-search-forward bibtex-string nil t)
-                (setq
-                 compl
-                 (append
-                  compl
-                  (list
-                   (list (buffer-substring-no-properties
-                          (match-beginning bibtex-key-in-string)
-                          (match-end bibtex-key-in-string)))))))
-              (kill-buffer bufname)
-              (set-buffer curbuf)
-              (setq bibtex-completion-candidates compl))
-          (error "File %s not in $BIBINPUTS paths" filename)))))
-   bibtex-string-files)
-  (run-with-idle-timer
-   bibtex-parse-keys-timeout bibtex-parse-keys-timeout 
-   (function
-    (lambda ()
-      (if (and
-           bibtex-maintain-sorted-entries
-           (eq major-mode 'bibtex-mode)
-           (not
-            (eq (buffer-modified-tick)
-                bibtex-buffer-last-parsed-for-keys-tick)))
-          (bibtex-parse-keys nil t)))))
-  (bibtex-parse-keys nil)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start "[ \f\n\t]*$")
-  (make-local-variable 'comment-start)
-  (setq comment-start "%")
-  (make-local-variable 'normal-auto-fill-function)
-  (setq normal-auto-fill-function 'bibtex-auto-fill-function)
-  (set (make-local-variable 'font-lock-defaults)
-       '(bibtex-font-lock-keywords
-         nil t ((?$ . "\"")
-                ;; Mathematical expressions should be fontified as strings
-                (?\" . ".")
-                ;; Quotes are field delimiters and quote-delimited
-                ;; entries should be fontified in the same way as
-                ;; brace-delimited ones
-                )))
-  (run-hooks 'bibtex-mode-hook))
-
-(defun bibtex-submit-bug-report ()
-  "Submit via mail a bug report on bibtex.el."
-  (interactive)
-  (if (y-or-n-p "Do you want to submit a bug report on BibTeX mode? ")
-      (progn
-        (require 'reporter)
-        (let ((reporter-prompt-for-summary-p t))
-          (reporter-submit-bug-report
-           bibtex-maintainer-address
-           "bibtex.el"
-           (list
-            'system-configuration
-            'system-configuration-options
-            'bibtex-sort-ignore-string-entries
-            'bibtex-maintain-sorted-entries
-            'bibtex-field-left-delimiter
-            'bibtex-field-right-delimiter
-            ;; Possible sorting and parsing bugs
-            'bibtex-mode-user-optional-fields
-            ;; Possible format error
-            'bibtex-predefined-strings
-            'bibtex-string-files
-            ;; Possible format error
-            'bibtex-font-lock-keywords
-            ;; Possible bugs regarding fontlocking
-            'bibtex-autokey-names
-            'bibtex-autokey-name-change-strings
-            'bibtex-autokey-name-length
-            'bibtex-autokey-name-separator
-            'bibtex-autokey-year-length
-            'bibtex-autokey-titlewords
-            'bibtex-autokey-title-terminators
-            'bibtex-autokey-titlewords-stretch
-            'bibtex-autokey-titleword-first-ignore
-            'bibtex-autokey-titleword-abbrevs
-            'bibtex-autokey-titleword-change-strings
-            'bibtex-autokey-titleword-length
-            'bibtex-autokey-titleword-separator
-            'bibtex-autokey-name-year-separator
-            'bibtex-autokey-year-title-separator
-            'bibtex-autokey-edit-before-use
-            ;; Possible bugs regarding automatic labels
-            'bibtex-entry-field-alist
-            ;; Possible format error
-            'bibtex-help-message
-            'bibtex-include-OPTcrossref
-            'bibtex-include-OPTkey
-            'bibtex-include-OPTannote
-            'bibtex-clean-entry-zap-empty-opts
-            ;; User variables which shouldn't cause any errors
-            )
-           nil nil
-           (concat "Hi Stefan,
- 
-I want to report a bug on Emacs BibTeX mode.
-I've read the `Bugs' section in the `Emacs' info page, so I know how
-to make a clear and unambiguous report. I have started a fresh Emacs
-via `"invocation-name " --no-init-file --no-site-file', thereafter (in
-case I'm reporting on a version of `bibtex.el' which is not part of
-the standard emacs distribution) I loaded the questionable version
-of `bibtex.el' with `M-x load-file', and then, to produce the buggy
-behaviour, I did the following:")))
-        (message nil))))
-
-(defun bibtex-entry (entry-type &optional required optional)
-  "Inserts a new BibTeX entry.
-Calls the value of bibtex-add-entry-hook if that value is non-nil."
-  (interactive (let* ((completion-ignore-case t)
-		      (e-t (completing-read
-                            "Entry Type: "
-                            bibtex-entry-field-alist
-                            nil t)))
-		 (list e-t)))
-  (if (and (null required) (null optional))
-      (let* ((e (assoc-ignore-case entry-type bibtex-entry-field-alist))
-	     (r-n-o (elt e 1))
-	     (c-ref (elt e 2)))
-	(if (null e)
-            (error "Bibtex entry type %s not defined!" entry-type))
-	(if (and
-             (member entry-type bibtex-include-OPTcrossref)
-             c-ref)
-	    (setq required (elt c-ref 0)
-		  optional (elt c-ref 1))
-	  (setq required (elt r-n-o 0)
-		optional (elt r-n-o 1)))))
-  (let ((key
-         (if bibtex-maintain-sorted-entries
-             (completing-read
-              (format "%s key: " entry-type)
-              bibtex-keys))))
-    (if bibtex-maintain-sorted-entries
-	(bibtex-find-entry-location key)
-      (bibtex-move-outside-of-entry))
-    (insert "@" entry-type "{")
-    (if key
-	(insert key))
-    (save-excursion
-      (mapcar 'bibtex-make-field required)
-      (if (member entry-type bibtex-include-OPTcrossref)
-	  (bibtex-make-optional-field '("crossref")))
-      (if bibtex-include-OPTkey
-	  (bibtex-make-optional-field '("key")))
-      (mapcar 'bibtex-make-optional-field optional)
-      (mapcar 'bibtex-make-optional-field 
-	      bibtex-mode-user-optional-fields)
-      (if bibtex-include-OPTannote
-	  (bibtex-make-optional-field '("annote")))
-      (insert "\n}\n\n"))
-    (bibtex-next-field t)
-    (run-hooks 'bibtex-add-entry-hook)))
-
-(defun bibtex-print-help-message ()
-  "Prints helpful information about current field in current BibTeX entry."
-  (interactive)
-    (let* ((pnt (point))
-         (field-name
-          (progn
-            (beginning-of-line)
-            (condition-case errname
-                (bibtex-enclosing-regexp bibtex-field)
-              (search-failed
-               (goto-char pnt)
-               (error "Not on BibTeX field")))
-            (let ((mb (match-beginning bibtex-name-in-field))
-                  (me (match-end bibtex-name-in-field)))
-              (goto-char mb)
-              (buffer-substring-no-properties
-               (if (looking-at "OPT")
-                   (+ 3 mb)
-                 mb)
-               me))))
-         (reference-type
-          (progn
-            (re-search-backward
-             bibtex-reference-maybe-empty-head nil t)
-            (buffer-substring-no-properties
-             (1+ (match-beginning bibtex-type-in-head))
-             (match-end bibtex-type-in-head))))
-         (entry-list
-          (assoc-ignore-case reference-type
-                               bibtex-entry-field-alist))
-         (c-r-list (elt entry-list 2))
-         (req-opt-list
-          (if (and
-               (member reference-type bibtex-include-OPTcrossref)
-               c-r-list)
-              c-r-list
-            (elt entry-list 1)))
-         (list-of-entries (append
-                           (elt req-opt-list 0)
-                           (elt req-opt-list 1)
-                           bibtex-mode-user-optional-fields
-                           (if (member
-                                reference-type
-                                bibtex-include-OPTcrossref)
-                               '(("crossref"
-                                  "Label of the crossreferenced entry")))
-                           (if bibtex-include-OPTannote
-                               '(("annote"
-                                  "Personal annotation (ignored)")))
-                           (if bibtex-include-OPTkey
-                               '(("key"
-                                  "Key used for label creation if author and editor fields are missing"))))))
-    (goto-char pnt)
-    (let ((comment (assoc-ignore-case field-name list-of-entries)))
-      (if comment
-          (message (elt comment 1))
-        (message "NO COMMENT AVAILABLE")))))
-
-(defun bibtex-make-field (e-t)
-  "Makes a field named E-T in current BibTeX entry."
-  (interactive "sBibTeX field name: ")
-  (let ((name (if (consp e-t)
-                  (elt e-t 0)
-                e-t)))
-    (if (interactive-p)
-        (progn
-          (bibtex-find-text nil)
-          (if (looking-at "[}\"]")
-              (forward-char 1))))
-    (insert ",\n")
-    (indent-to-column bibtex-name-alignment)
-    (insert name " = ")
-    (indent-to-column bibtex-text-alignment)
-    (insert bibtex-field-left-delimiter bibtex-field-right-delimiter)
-    (if (interactive-p)
-        (forward-char -1))))
-
-(defun bibtex-make-optional-field (e-t)
-  "Makes an optional field named E-T in current BibTeX entry."
-  (if (consp e-t)
-      (setq e-t (cons (concat "OPT" (car e-t)) (cdr e-t)))
-    (setq e-t (concat "OPT" e-t)))
-  (bibtex-make-field e-t))
-
-(defun bibtex-beginning-of-entry ()
-  "Move to beginning of BibTeX entry.
-If inside an entry, move to the beginning of it, otherwise move to the
-beginning of the previous entry."
-  (interactive)
-  (if (looking-at "^@")
-      (forward-char))
-  (re-search-backward "^@" nil 'move))
-
-(defun bibtex-end-of-entry ()
-  "Move to end of BibTeX entry.
-If inside an entry, move to the end of it, otherwise move to the end
-of the previous entry."
-  (interactive)
-  (bibtex-beginning-of-entry)
-  (let ((parse-sexp-ignore-comments t))
-    (forward-sexp 2) ;; skip entry type and body
-    ))
-  
-(defun bibtex-ispell-entry ()
-  "Spell whole BibTeX entry."
-  (interactive)
-  (ispell-region (progn (bibtex-beginning-of-entry) (point))
-		 (progn (bibtex-end-of-entry) (point))))
-
-(defun bibtex-ispell-abstract ()
-  "Spell abstract of BibTeX entry."
-  (interactive)
-  (let ((pnt (bibtex-end-of-entry)))
-    (bibtex-beginning-of-entry)
-    (if (null
-         (re-search-forward "^[ \t]*[OPT]*abstract[ \t]*=" pnt))
-        (error "No abstract in entry.")))
-  (ispell-region (point)
-		 (save-excursion (forward-sexp) (point))))
-
-(defun bibtex-narrow-to-entry ()
-  "Narrow buffer to current BibTeX entry."
-  (interactive)
-  (save-excursion
-    (narrow-to-region (progn (bibtex-beginning-of-entry) (point))
-		      (progn (bibtex-end-of-entry) (point)))))
-
-(defun bibtex-hide-entry-bodies (&optional arg)
-  "Hide all lines between first and last BibTeX entries not beginning with @.
-With argument, show all text."
-  (interactive "P")
-  (save-excursion
-    (beginning-of-first-bibtex-entry)
-    ;; subst-char-in-region modifies the buffer, despite what the
-    ;; documentation says...
-    (let ((modifiedp (buffer-modified-p))
-	  (buffer-read-only nil))
-      (if arg
-	  (subst-char-in-region (point) (point-max) ?\r ?\n t)
-	(while (save-excursion (re-search-forward "\n[^@]" (point-max) t))
-	  ;; (save-excursion (replace-regexp "\n\\([^@]\\)" "\r\\1"))
-	  (save-excursion
-	    (while (re-search-forward "\n\\([^@]\\)" nil t)
-	      (replace-match "\r\\1" nil nil)))))
-      (setq selective-display (not arg))
-      (set-buffer-modified-p modifiedp))))
-
-(defun bibtex-sort-entries ()
-  "Sort BibTeX entries alphabetically by key.
-Text outside of BibTeX entries is not affected. If
-bibtex-sort-ignore-string-entries is non-nil, @string entries will be
-ignored."
-  (interactive)
-  (save-restriction
-    (beginning-of-first-bibtex-entry)
-    (narrow-to-region
-     (point)
-     (save-excursion
-       (goto-char (point-max))
-       (bibtex-end-of-entry)
-       (point)))
-    (if bibtex-sort-ignore-string-entries
-        (if (re-search-forward bibtex-reference nil 'move)
-            (goto-char (match-beginning 0))))
-    (sort-subr
-     nil
-     ;; NEXTREC function
-     (function
-      (lambda ()
-        (if bibtex-sort-ignore-string-entries
-            (if (re-search-forward bibtex-reference nil 'move)
-                (goto-char (match-beginning 0)))
-          (if (re-search-forward bibtex-reference-head nil 'move)
-              (goto-char (match-beginning 0))))))
-     ;; ENDREC function
-     'bibtex-end-of-entry
-     ;; STARTKEY function
-     (function
-      (lambda ()
-        (if bibtex-sort-ignore-string-entries
-            (progn
-              (re-search-forward bibtex-reference)
-              (buffer-substring-no-properties
-               (match-beginning bibtex-key-in-reference)
-               (match-end bibtex-key-in-reference)))
-          (re-search-forward bibtex-reference-head)
-          (buffer-substring-no-properties
-           (match-beginning bibtex-key-in-head)
-           (match-end bibtex-key-in-head)))))
-     ;; ENDKEY function
-     nil)))
-  
-(defun bibtex-find-entry-location (entry-name &optional ignore-dups)
-  "Looking for place to put the BibTeX entry named ENTRY-NAME.
-Performs a binary search (therefore, buffer is assumed to be in sorted
-order, without duplicates (see \\[bibtex-validate-buffer]), if it is
-not, bibtex-find-entry-location will fail). If entry-name is already
-used as a reference key, an error is signaled. However, if optional
-variable IGNORE-DUPS is non-nil, no error messages about duplicate
-entries are signaled, but the error handling is assumed to be made in
-the calling function. Nil is returned, if an duplicate entry error
-occurred, and t in all other cases."
-  (let* ((left
-          (progn
-            (beginning-of-first-bibtex-entry)
-            (if bibtex-sort-ignore-string-entries
-                (re-search-forward bibtex-reference nil `move)
-              (bibtex-end-of-entry))
-            (point)))
-         (right
-          (progn
-            (goto-char (point-max))
-            (if bibtex-sort-ignore-string-entries
-                (re-search-backward bibtex-reference nil `move)
-              (bibtex-beginning-of-entry))
-            (point)))
-         actual-point
-         actual-key
-         (done (>= left right))
-         new
-         dup)
-    (while (not done)
-      (setq actual-point (/ (+ left right) 2))
-      (goto-char actual-point)
-      (bibtex-beginning-of-entry)
-      (setq actual-key
-            (if bibtex-sort-ignore-string-entries
-                (progn
-                  (re-search-forward bibtex-reference)
-                  (buffer-substring-no-properties
-                   (match-beginning bibtex-key-in-reference)
-                   (match-end bibtex-key-in-reference)))
-              (re-search-forward bibtex-reference-head)
-              (buffer-substring-no-properties
-               (match-beginning bibtex-key-in-head)
-               (match-end bibtex-key-in-head))))
-      (cond
-       ((string-lessp entry-name actual-key)
-        (setq new (match-beginning 0))
-        (if (equal right new)
-            (setq done t)
-          (setq right new)))
-       ((string-lessp actual-key entry-name)
-        (setq new (match-end 0))
-        (if (equal left new)
-            (setq done t)
-          (setq left new)))
-       ((string-equal actual-key entry-name)
-        (setq dup t
-              done t)
-        (if (not ignore-dups)
-            (error "Entry with key `%s' already exists!" entry-name)))))
-    (if dup
-        nil
-      (goto-char right)
-      (if (re-search-forward bibtex-reference nil t)
-          (progn
-            (setq actual-key
-                  (buffer-substring-no-properties
-                   (match-beginning bibtex-key-in-reference)
-                   (match-end bibtex-key-in-reference)))
-            (if (string-lessp actual-key entry-name)
-                ;; even greater than last entry --> we must append
-                (progn
-                  (goto-char (match-end 0))
-                  (newline (forward-line 2))
-                  (beginning-of-line))
-              (goto-char right))))
-      t)))    
-
-(defun bibtex-validate-buffer (&optional from-point)
-  "Validate if the current BibTeX buffer is syntactically correct.
-Any garbage (e.g. comments) before the first \"@\" is not tested (so
-you can put comments here).
-With non-nil FROM-POINT it starts with entry enclosing point."
-  (interactive "P")
-  (let ((pnt (point))
-        (starting-point
-         (progn
-           (if from-point
-               (bibtex-beginning-of-entry)
-             (beginning-of-first-bibtex-entry))
-           (point))))
-    ;; looking if entries fit syntactical structure
-    (goto-char starting-point)
-    (while (re-search-forward "^@" nil t)
-      (forward-char -1)
-      (let ((p (point)))
-        (if (or
-             (looking-at "@string")
-             (looking-at "@preamble"))
-            (forward-char)
-          (if (not (and
-                    (re-search-forward bibtex-reference nil t)
-                    (equal p (match-beginning 0))))
-              (progn
-                (goto-char p)
-                (error "Bad entry begins here"))))))
-    ;; looking if entries are balanced (a single non-escaped quote
-    ;; inside braces is not detected by the former check, but
-    ;; bibtex-sort-entries stumbles about it
-    (goto-char starting-point)
-    (map-bibtex-entries
-     (function
-      (lambda (current)
-        (bibtex-beginning-of-entry)
-        (forward-sexp 2))))
-    ;; looking for correct sort order and duplicates
-    (if bibtex-maintain-sorted-entries
-        (let (previous
-              point)
-          (goto-char starting-point)
-          (map-bibtex-entries
-           (function
-            (lambda (current)
-              (cond ((or (null previous)
-                         (string< previous current))
-                     (setq previous current
-                           point (point)))
-                    ((string-equal previous current)
-                     (error "Duplicate here with previous!"))
-                    (t
-                     (error "Entries out of order here!"))))))))
-    (goto-char pnt)
-    (if from-point
-        (message "Part of BibTeX buffer starting at point is syntactically correct")
-      (message "BibTeX buffer is syntactically correct"))))
-
-(defun bibtex-next-field (arg)
-  "Finds end of text of next BibTeX field; with arg, to its beginning."
-  (interactive "P")
-  (bibtex-inside-field)
-  (let ((start (point)))
-    (condition-case ()
-	(progn
-	  (bibtex-enclosing-field)
-	  (goto-char (match-end 0))
-	  (forward-char 2))
-      (error
-       (goto-char start)
-       (end-of-line)
-       (forward-char 1))))
-  (bibtex-find-text arg))
-
-(defun bibtex-find-text (arg)
-  "Go to end of text of current field; with arg, go to beginning."
-  (interactive "P")
-  (bibtex-inside-field)
-  (bibtex-enclosing-field)
-  (if arg
-      (progn
-	(goto-char (match-beginning bibtex-text-in-field))
-	(if (looking-at "[{\"]")
-	    (forward-char 1)))
-    (goto-char (match-end bibtex-text-in-field))
-    (if (or
-         (= (preceding-char) ?})
-         (= (preceding-char) ?\"))
-	(forward-char -1)))
-  (if bibtex-help-message
-      (bibtex-print-help-message)))
-
-(defun bibtex-remove-OPT ()
-  "Removes the 'OPT' starting optional arguments and goes to end of text."
-  (interactive)
-  (bibtex-inside-field)
-  (bibtex-enclosing-field)
-  (save-excursion
-    (goto-char (match-beginning bibtex-name-in-field))
-    (if (looking-at "OPT")
-	;; sct@dcs.edinburgh.ac.uk
- 	(progn
- 	  (delete-char (length "OPT"))
- 	  (search-forward "=")
- 	  (delete-horizontal-space)
- 	  (indent-to-column bibtex-text-alignment))))
-  (bibtex-inside-field))
-
-(defun bibtex-remove-double-quotes-or-braces ()
-  "Removes \"\" or {} around string."
-  (interactive)
-  (save-excursion
-    (bibtex-inside-field)
-    (bibtex-enclosing-field)
-    (let ((start (match-beginning bibtex-text-in-field))
-	  (stop (match-end bibtex-text-in-field)))
-      (goto-char start)
-      (while (re-search-forward bibtex-field-string stop t)
-        (let ((beg (match-beginning 0))
-              (end (match-end 0)))
-          (goto-char end)
-          (forward-char -1)
-          (if (looking-at "[}\"]")
-              (delete-char 1))
-          (goto-char beg)
-          (if (looking-at "[{\"]")
-              (delete-char 1)))))))
-
-(defun bibtex-kill-optional-field ()
-  "Kill the entire enclosing optional BibTeX field."
-  (interactive)
-  (bibtex-inside-field)
-  (bibtex-enclosing-field)
-  (goto-char (match-beginning bibtex-name-in-field))
-  (let ((the-end (match-end 0))
-	(the-beginning (match-beginning 0)))
-    (if (looking-at "OPT")
-	(progn
-	  (goto-char the-end)
-	  (skip-chars-forward " \t\n,")
-	  (kill-region the-beginning the-end))
-      (error "Mandatory fields can't be killed"))))
-
-(defun bibtex-empty-field ()
-  "Delete the text part of the current field, replace with empty text."
-  (interactive)
-  (bibtex-inside-field)
-  (bibtex-enclosing-field)
-  (goto-char (match-beginning bibtex-text-in-field))
-  (kill-region (point) (match-end bibtex-text-in-field))
-  (insert (concat bibtex-field-left-delimiter
-                  bibtex-field-right-delimiter)) 
-  (bibtex-find-text t))
-
-(defun bibtex-pop (arg direction)
-  ;; generic function to be used by bibtex-pop-previous and bibtex-pop-next
-  (let (bibtex-help-message)
-    (bibtex-find-text nil))
-  (save-excursion
-    ;; parse current field
-    (bibtex-inside-field)
-    (bibtex-enclosing-field)
-    (let ((start-old-text (match-beginning bibtex-text-in-field))
-	  (stop-old-text  (match-end bibtex-text-in-field))
-	  (start-name (match-beginning bibtex-name-in-field))
-	  (stop-name (match-end bibtex-name-in-field))
-	  (new-text))
-      (goto-char start-name)
-      ;; construct regexp for field with same name as this one,
-      ;; ignoring possible OPT's 
-      (let ((matching-entry
-	     (bibtex-cfield
-	      (buffer-substring-no-properties (if (looking-at "OPT")
-                                                  (+ (point) (length "OPT"))
-                                                (point))
-                                              stop-name)
-	      bibtex-field-text)))
-	;; if executed several times in a row, start each search where
-        ;; the last one was finished
-	(cond ((eq last-command 'bibtex-pop)
-               t
-               )
-	      (t
-	       (bibtex-enclosing-reference-maybe-empty-head)
-	       (setq bibtex-pop-previous-search-point (point))
-	       (setq bibtex-pop-next-search-point (match-end 0))))
-	(if (eq direction 'previous)
-            (goto-char bibtex-pop-previous-search-point)
-          (goto-char bibtex-pop-next-search-point))
-        ;; Now search for arg'th previous/next similar field
-	(cond
-         ((if (eq direction 'previous)
-              (re-search-backward matching-entry (point-min) t arg)
-            (re-search-forward matching-entry (point-max) t arg))
-          ;; Found a matching field. Remember boundaries.
-	  (setq bibtex-pop-previous-search-point (match-beginning 0))
-	  (setq bibtex-pop-next-search-point (match-end 0))
-          (setq new-text
-		(buffer-substring-no-properties
-                 (match-beginning bibtex-text-in-field)
-                 (match-end bibtex-text-in-field)))
-          ;; change delimiters, if any changes needed
-          (let ((start 0)
-                old-open
-                new-open
-                old-close
-                new-close)
-            (if (equal bibtex-field-left-delimiter "{")
-                (setq old-open ?\"
-                      new-open ?\{
-                      old-close ?\"
-                      new-close ?\})
-              (setq old-open ?\{
-                    new-open ?\"
-                    old-close ?\}
-                    new-close ?\"))
-            (while (string-match bibtex-field-string new-text start)
-              (let ((beg (match-beginning 0))
-                    (end (1- (match-end 0))))
-                (if (and
-                     (eq (aref new-text beg) old-open)
-                     (eq (aref new-text end) old-close))
-                    (progn
-                      (aset new-text beg new-open)
-                      (aset new-text end new-close))))
-              (setq start (match-end 0))))
-	  (bibtex-flash-head)
-          ;; Go back to where we started, delete old text, and pop new.
-	  (goto-char stop-old-text)
-	  (delete-region start-old-text stop-old-text)
-	  (insert new-text))
-	 (t
-          ;; search failed
-	  (error (concat "No "
-                         (if (eq direction 'previous)
-                             "previous"
-                           "next")
-                         " matching BibTeX field.")))))))
-  (let (bibtex-help-message)
-    (bibtex-find-text nil))
-  (setq this-command 'bibtex-pop))
-
-(defun bibtex-pop-previous (arg)
-  "Replace text of current field with the text of similar field in previous entry.
-With arg, goes up ARG entries. Repeated, goes up so many times. May be
-intermixed with \\[bibtex-pop-next] (bibtex-pop-next)."
-  (interactive "p")
-  (bibtex-pop arg 'previous))
-
-(defun bibtex-pop-next (arg)
-  "Replace text of current field with the text of similar field in next entry.
-With arg, goes down ARG entries. Repeated, goes down so many times. May be
-intermixed with \\[bibtex-pop-previous] (bibtex-pop-previous)."
-  (interactive "p")
-  (bibtex-pop arg 'next))
-
-(defun bibtex-clean-entry (&optional arg)
-  "Finish editing the current BibTeX entry and clean it up.
-For all optional fields of current BibTeX entry: if empty, kill the
-whole field; otherwise, remove the \"OPT\" string in the name; if text
-numerical, remove double-quotes. For all mandatory fields: if empty,
-signal error. If label of entry is empty or a prefix argument was
-given, calculate a new entry label."
-  (interactive "P")
-  (bibtex-beginning-of-entry)
-  (let ((start (point))
-        crossref-there)
-    (save-restriction
-      (narrow-to-region start (save-excursion (bibtex-end-of-entry) (point)))
-      (while (and
-              (re-search-forward bibtex-field (point-max) t 1)
-              (not crossref-there))
-        ;; determine if reference has crossref entry
-	(let ((begin-name (match-beginning bibtex-name-in-field))
-	      (begin-text (match-beginning bibtex-text-in-field)))
-	  (goto-char begin-name)
-          (if (looking-at "\\(OPTcrossref\\)\\|\\(crossref\\)")
-              (progn
-                (goto-char begin-text)
-                (if (not (looking-at "\\(\"\"\\)\\|\\({}\\)"))
-                    (setq crossref-there t))))))
-      (bibtex-enclosing-reference-maybe-empty-head)
-      (re-search-forward bibtex-reference-type)
-      (let ((begin-type (1+ (match-beginning 0)))
-            (end-type (match-end 0)))
-        (goto-char start)
-        (while (re-search-forward bibtex-field (point-max) t 1)
-          (let ((begin-field (match-beginning 0))
-                (end-field (match-end 0))
-                (begin-name (match-beginning bibtex-name-in-field))
-                (end-name (match-end  bibtex-name-in-field))
-                (begin-text (match-beginning bibtex-text-in-field))
-                (end-text (match-end bibtex-text-in-field))
-                )
-            (goto-char begin-name)
-            (cond ((and
-                    (looking-at "OPT")
-                    bibtex-clean-entry-zap-empty-opts)
-                   (goto-char begin-text)
-                   (if (looking-at "\\(\"\"\\)\\|\\({}\\)")
-                       ;; empty: delete whole field if really optional
-                       ;; (missing crossref handled) or complain
-                       (if (and
-                            (not crossref-there)
-                            (assoc
-                             (downcase
-                              (buffer-substring-no-properties
-                               (+ (length "OPT") begin-name) end-name))
-                             (car (car (cdr
-                                        (assoc-ignore-case
-                                         (buffer-substring-no-properties
-                                          begin-type end-type)
-                                         bibtex-entry-field-alist))))))
-                           ;; field is not really optional
-                           (progn
-                             (goto-char begin-name)
-                             (delete-char (length "OPT"))
-                             ;; make field non-OPT
-                             (search-forward "=")
-                             (delete-horizontal-space)
-                             (indent-to-column bibtex-text-alignment)
-                             (forward-char)
-                             ;; and loop to go through next test
-                             (error "Mandatory field ``%s'' is empty"
-                                    (buffer-substring-no-properties
-                                     begin-name
-                                     end-name)))
-                         ;; field is optional
-                         (delete-region begin-field end-field))
-                     ;; otherwise: not empty, delete "OPT"
-                     (goto-char begin-name)
-                     (delete-char (length "OPT"))
-                     (progn
-                       ;; fixup alignment. [alarson:19920309.2047CST]
-                       (search-forward "=")
-                       (delete-horizontal-space)
-                       (indent-to-column bibtex-text-alignment))
-                     (goto-char begin-field)
-                     ;; and loop to go through next test
-                     ))
-                  (t
-                   (goto-char begin-text)
-                   (cond ((looking-at "\\(\"[0-9]+\"\\)\\|\\({[0-9]+}\\)")
-                          ;; if numerical,
-                          (goto-char end-text)
-                          (delete-char -1)
-                          (goto-char begin-text)
-                          (delete-char 1)
-                          ;; delete enclosing delimiters
-                          (goto-char end-field)
-                          ;; go to end for next search
-                          (forward-char -2)
-                          ;; to compensate for the 2 delimiters deleted
-                          )
-                         ((looking-at "\\(\"\"\\)\\|\\({}\\)")
-                          ;; if empty field, complain
-                          (forward-char 1)
-                          (if (not (or (equal (buffer-substring-no-properties
-                                               begin-name
-                                               (+ begin-name 3))
-                                              "OPT")
-                                       (equal (buffer-substring-no-properties
-                                               begin-name
-                                               (+ begin-name 3))
-                                              "opt")))
-                              (error "Mandatory field ``%s'' is empty"
-                                     (buffer-substring-no-properties
-                                      begin-name end-name))))
-                         (t
-                          (goto-char end-field)))))))))
-    (goto-char start)
-    (bibtex-end-of-entry))
-  (let* ((eob (progn
-                (bibtex-end-of-entry)
-                (point)))
-         (key (progn
-                (bibtex-beginning-of-entry)
-                (if (re-search-forward
-                     bibtex-reference-head eob t)
-                    (buffer-substring-no-properties
-                     (match-beginning bibtex-key-in-head)
-                     (match-end bibtex-key-in-head))))))
-    (if (or
-         arg
-         (not key))
-        (progn
-          (let ((autokey
-                 (if bibtex-autokey-edit-before-use
-                     (read-from-minibuffer "Key to use: "
-                                           (bibtex-generate-autokey))
-                   (bibtex-generate-autokey))))
-            (bibtex-beginning-of-entry)
-            (re-search-forward bibtex-reference-maybe-empty-head)
-            (if (match-beginning bibtex-key-in-head)
-                (delete-region (match-beginning bibtex-key-in-head)
-                               (match-end bibtex-key-in-head)))
-            (insert autokey)
-            (let ((start (progn
-                           (bibtex-beginning-of-entry)
-                           (point)))
-                  (end (progn
-                         (bibtex-end-of-entry)
-                         (re-search-forward "^@" nil 'move)
-                         (beginning-of-line)
-                         (point)))
-                  last-command)
-              (kill-region start end)
-              (let ((success
-                     (or
-                      (not bibtex-maintain-sorted-entries)
-                      (bibtex-find-entry-location autokey t))))
-                (yank)
-                (setq kill-ring (cdr kill-ring))
-                (forward-char -1)
-                (bibtex-beginning-of-entry)
-                (re-search-forward bibtex-reference-head)
-                (if (not success)
-                    (error
-                     "New inserted reference may be a duplicate."))))))))
-  (save-excursion
-    (let ((start (progn (bibtex-beginning-of-entry) (point)))
-          (end (progn (bibtex-end-of-entry) (point))))
-      (save-restriction
-        (narrow-to-region start end)
-        (bibtex-parse-keys t)))))
-
-(defun bibtex-complete-string ()
-  "Complete word fragment before point to longest prefix of a defined string.
-If point is not after the part of a word, all strings are listed."
-  (interactive "*")
-  (let* ((end (point))
-         (beg (save-excursion
-                (re-search-backward "[ \t{\"]")
-                (forward-char 1)
-                (point)))
-         (part-of-word (buffer-substring-no-properties beg end))
-         (string-list (copy-sequence bibtex-completion-candidates))
-         (case-fold-search t)
-         (completion (save-excursion
-                       (while (re-search-backward
-                               bibtex-string (point-min) t)
-                         (setq string-list
-                               (cons
-                                (list
-                                 (buffer-substring-no-properties
-                                  (match-beginning bibtex-key-in-string)
-                                  (match-end bibtex-key-in-string)))
-                                string-list)))
-                       (setq string-list
-                             (sort string-list
-                                   (lambda(x y)
-                                     (string-lessp
-                                      (car x)
-                                      (car y)))))
-                       (try-completion part-of-word string-list))))
-    (cond ((eq completion t)
-           ;; remove double-quotes or braces if field is no concatenation
-           (save-excursion
-             (bibtex-inside-field)
-             (bibtex-enclosing-field)
-             (let ((end (match-end bibtex-text-in-field)))
-               (goto-char (match-beginning bibtex-text-in-field))
-               (if (and
-                    (looking-at bibtex-field-string)
-                    (equal (match-end 0) end))
-                   (bibtex-remove-double-quotes-or-braces)))))
-          ((null completion)
-           (error "Can't find completion for \"%s\"" part-of-word))
-          ((not (string= part-of-word completion))
-           (delete-region beg end)
-           (insert completion)
-           (if (assoc completion string-list)
-               ;; remove double-quotes or braces if field is no concatenation
-               (save-excursion
-                 (bibtex-inside-field)
-                 (bibtex-enclosing-field)
-                 (let ((end (match-end bibtex-text-in-field)))
-                   (goto-char (match-beginning bibtex-text-in-field))
-                   (if (and
-                        (looking-at bibtex-field-string)
-                        (equal (match-end 0) end))
-                       (bibtex-remove-double-quotes-or-braces))))))
-          (t
-           (message "Making completion list...")
-           (let ((list (all-completions part-of-word string-list)))
-             (with-output-to-temp-buffer "*Completions*"
-               (display-completion-list list)))
-           (message "Making completion list...done")))))
-
-(defun bibtex-Article ()
-  (interactive)
-  (bibtex-entry "Article"))
-
-(defun bibtex-Book ()
-  (interactive)
-  (bibtex-entry "Book"))
-
-(defun bibtex-Booklet ()
-  (interactive)
-  (bibtex-entry "Booklet"))
-
-(defun bibtex-InBook ()
-  (interactive)
-  (bibtex-entry "InBook"))
-
-(defun bibtex-InCollection ()
-  (interactive)
-  (bibtex-entry "InCollection"))
-
-(defun bibtex-InProceedings ()
-  (interactive)
-  (bibtex-entry "InProceedings"))
-
-(defun bibtex-Manual ()
-  (interactive)
-  (bibtex-entry "Manual"))
-
-(defun bibtex-MastersThesis ()
-  (interactive)
-  (bibtex-entry "MastersThesis"))
-
-(defun bibtex-Misc ()
-  (interactive)
-  (bibtex-entry "Misc"))
-
-(defun bibtex-PhdThesis ()
-  (interactive)
-  (bibtex-entry "PhdThesis"))
-
-(defun bibtex-Proceedings ()
-  (interactive)
-  (bibtex-entry "Proceedings"))
-
-(defun bibtex-TechReport ()
-  (interactive)
-  (bibtex-entry "TechReport"))
-
-(defun bibtex-Unpublished ()
-  (interactive)
-  (bibtex-entry "Unpublished"))
-
-(defun bibtex-string ()
-  (interactive)
-  (bibtex-move-outside-of-entry)
-  (insert
-   (concat
-    "@string{ = "
-    bibtex-field-left-delimiter
-    bibtex-field-right-delimiter
-    "}\n"))
-  (forward-line -1)
-  (forward-char 8))
-
-(defun bibtex-preamble ()
-  (interactive)
-  (bibtex-move-outside-of-entry)
-  (insert "@Preamble{}\n")
-  (forward-line -1)
-  (forward-char 10))
-
-
-;; Make BibTeX a Feature
-
-(provide 'bibtex)
-
-;;; bibtex.el ends here
diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el
deleted file mode 100644
index 17237a4a235..00000000000
--- a/lisp/textmodes/fill.el
+++ /dev/null
@@ -1,858 +0,0 @@
-;;; fill.el --- fill commands for Emacs
-
-;; Copyright (C) 1985, 86, 92, 94, 95, 1996 Free Software Foundation, Inc.
-
-;; Keywords: wp
-
-;; 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:
-
-;; All the commands for filling text.  These are documented in the Emacs
-;; manual.
-
-;;; Code:
-
-(defvar fill-individual-varying-indent nil
-  "*Controls criterion for a new paragraph in `fill-individual-paragraphs'.
-Non-nil means changing indent doesn't end a paragraph.
-That mode can handle paragraphs with extra indentation on the first line,
-but it requires separator lines between paragraphs.
-A value of nil means that any change in indentation starts a new paragraph.")
-
-(defvar sentence-end-double-space t
-  "*Non-nil means a single space does not end a sentence.")
-
-(defvar colon-double-space nil
-  "*Non-nil means put two spaces after a colon when filling.")
-
-(defvar fill-paragraph-function nil
-  "Mode-specific function to fill a paragraph, or nil if there is none.
-If the function returns nil, then `fill-paragraph' does its normal work.")
-
-(defun set-fill-prefix ()
-  "Set the fill prefix to the current line up to point.
-Filling expects lines to start with the fill prefix and
-reinserts the fill prefix in each resulting line."
-  (interactive)
-  (setq fill-prefix (buffer-substring
-		     (save-excursion (move-to-left-margin) (point))
-		     (point)))
-  (if (equal fill-prefix "")
-      (setq fill-prefix nil))
-  (if fill-prefix
-      (message "fill-prefix: \"%s\"" fill-prefix)
-    (message "fill-prefix cancelled")))
-
-(defvar adaptive-fill-mode t
-  "*Non-nil means determine a paragraph's fill prefix from its text.")
-
-(defvar adaptive-fill-regexp "[ \t]*\\([#;>*]+ +\\)?"
-  "*Regexp to match text at start of line that constitutes indentation.
-If Adaptive Fill mode is enabled, whatever text matches this pattern
-on the second line of a paragraph is used as the standard indentation
-for the paragraph.  If the paragraph has just one line, the indentation
-is taken from that line.")
-
-(defvar adaptive-fill-function nil
-  "*Function to call to choose a fill prefix for a paragraph.
-This function is used when `adaptive-fill-regexp' does not match.")
-
-(defun current-fill-column ()
-  "Return the fill-column to use for this line.
-The fill-column to use for a buffer is stored in the variable `fill-column',
-but can be locally modified by the `right-margin' text property, which is
-subtracted from `fill-column'.
-
-The fill column to use for a line is the first column at which the column
-number equals or exceeds the local fill-column - right-margin difference."
-  (save-excursion
-    (if fill-column
-	(let* ((here (progn (beginning-of-line) (point)))
-	       (here-col 0)
-	       (eol (progn (end-of-line) (point)))
-	       margin fill-col change col)
-	  ;; Look separately at each region of line with a different right-margin.
-	  (while (and (setq margin (get-text-property here 'right-margin)
-			    fill-col (- fill-column (or margin 0))
-			    change (text-property-not-all
-				    here eol 'right-margin margin))
-		      (progn (goto-char (1- change))
-			     (setq col (current-column))
-			     (< col fill-col)))
-	    (setq here change
-		  here-col col))
-	  (max here-col fill-col)))))
-
-(defun canonically-space-region (beg end)
-  "Remove extra spaces between words in region.
-Leave one space between words, two at end of sentences or after colons
-(depending on values of `sentence-end-double-space' and `colon-double-space').
-Remove indentation from each line."
-  (interactive "r")
-  (save-excursion
-    (goto-char beg)
-    ;; Nuke tabs; they get screwed up in a fill.
-    ;; This is quick, but loses when a tab follows the end of a sentence.
-    ;; Actually, it is difficult to tell that from "Mr.\tSmith".
-    ;; Blame the typist.
-    (subst-char-in-region beg end ?\t ?\ )
-    (while (and (< (point) end)
-		(re-search-forward "   *" end t))
-      (delete-region
-       (+ (match-beginning 0)
-	  ;; Determine number of spaces to leave:
-	  (save-excursion
-	    (skip-chars-backward " ]})\"'")
-	    (cond ((and sentence-end-double-space
-			(memq (preceding-char) '(?. ?? ?!)))  2)
-		  ((and colon-double-space
-			(= (preceding-char) ?:))  2)
-		  ((char-equal (preceding-char) ?\n)  0)
-		  (t 1))))
-       (match-end 0)))
-    ;; Make sure sentences ending at end of line get an extra space.
-    ;; loses on split abbrevs ("Mr.\nSmith")
-    (goto-char beg)
-    (while (and (< (point) end)
-		(re-search-forward "[.?!][])}\"']*$" end t))
-      ;; We insert before markers in case a caller such as
-      ;; do-auto-fill has done a save-excursion with point at the end
-      ;; of the line and wants it to stay at the end of the line.
-      (insert-before-markers-and-inherit ? ))))
-
-(defun fill-context-prefix (from to &optional first-line-regexp)
-  "Compute a fill prefix from the text between FROM and TO.
-This uses the variables `adaptive-fill-prefix' and `adaptive-fill-function'.
-If FIRST-LINE-REGEXP is non-nil, then when taking a prefix from the
-first line, insist it must match FIRST-LINE-REGEXP."
-  (save-excursion
-    (goto-char from)
-    (if (eolp) (forward-line 1))
-    ;; Move to the second line unless there is just one.
-    (let ((firstline (point))
-	  ;; Non-nil if we are on the second line.
-	  at-second
-	  result)
-      (forward-line 1)
-      (if (>= (point) to)
-	  (goto-char firstline)
-	(setq at-second t))
-      (move-to-left-margin)
-      (let ((start (point)))
-	(setq result
-	      (if (not (looking-at paragraph-start))
-		  (cond ((and adaptive-fill-regexp (looking-at adaptive-fill-regexp))
-			 (buffer-substring-no-properties start (match-end 0)))
-			(adaptive-fill-function (funcall adaptive-fill-function)))))
-	(and result
-	     (or at-second
-		 (null first-line-regexp)
-		 (string-match first-line-regexp result))
-	     result)))))
-
-(defun fill-region-as-paragraph (from to &optional justify
-				      nosqueeze squeeze-after)
-  "Fill the region as one paragraph.
-It removes any paragraph breaks in the region and extra newlines at the end,
-indents and fills lines between the margins given by the
-`current-left-margin' and `current-fill-column' functions.
-It leaves point at the beginning of the line following the paragraph.
-
-Normally performs justification according to the `current-justification'
-function, but with a prefix arg, does full justification instead.
-
-From a program, optional third arg JUSTIFY can specify any type of
-justification.  Fourth arg NOSQUEEZE non-nil means not to make spaces
-between words canonical before filling.  Fifth arg SQUEEZE-AFTER, if non-nil,
-means don't canonicalize spaces before that position.
-
-If `sentence-end-double-space' is non-nil, then period followed by one
-space does not end a sentence, so don't break a line there."
-  (interactive (list (region-beginning) (region-end)
-		     (if current-prefix-arg 'full)))
-  ;; Arrange for undoing the fill to restore point.
-  (if (and buffer-undo-list (not (eq buffer-undo-list t)))
-      (setq buffer-undo-list (cons (point) buffer-undo-list)))
-
-  ;; Make sure "to" is the endpoint.
-  (goto-char (min from to))
-  (setq to   (max from to))
-  ;; Ignore blank lines at beginning of region.
-  (skip-chars-forward " \t\n")
-
-  (let ((from-plus-indent (point))
-	(oneleft nil))
-
-    (beginning-of-line)
-    (setq from (point))
-  
-    ;; Delete all but one soft newline at end of region.
-    ;; And leave TO before that one.
-    (goto-char to)
-    (while (and (> (point) from) (eq ?\n (char-after (1- (point)))))
-      (if (and oneleft
-	       (not (and use-hard-newlines
-			 (get-text-property (1- (point)) 'hard))))
-	  (delete-backward-char 1)
-	(backward-char 1)
-	(setq oneleft t)))
-    (setq to (point))
-
-    ;; If there was no newline, and there is text in the paragraph, then
-    ;; create a newline.
-    (if (and (not oneleft) (> to from-plus-indent))
-	(newline))
-    (goto-char from-plus-indent))
-
-  (if (not (> to (point)))
-      nil ; There is no paragraph, only whitespace: exit now.
-
-    (or justify (setq justify (current-justification)))
-
-    ;; Don't let Adaptive Fill mode alter the fill prefix permanently.
-    (let ((fill-prefix fill-prefix))
-      ;; Figure out how this paragraph is indented, if desired.
-      (if (and adaptive-fill-mode
-	       (or (null fill-prefix) (string= fill-prefix "")))
-	  (setq fill-prefix (fill-context-prefix from to)))
-
-      (save-restriction
-	(goto-char from)
-	(beginning-of-line)
-	(narrow-to-region (point) to)
-
-	(if (not justify)	    ; filling disabled: just check indentation
-	    (progn
-	      (goto-char from)
-	      (while (not (eobp))
-		(if (and (not (eolp))
-			 (< (current-indentation) (current-left-margin)))
-		    (indent-to-left-margin))
-		(forward-line 1)))
-
-	  (if use-hard-newlines
-	      (remove-text-properties from (point-max) '(hard nil)))
-	  ;; Make sure first line is indented (at least) to left margin...
-	  (if (or (memq justify '(right center))
-		  (< (current-indentation) (current-left-margin)))
-	      (indent-to-left-margin))
-	  ;; Delete the fill prefix from every line except the first.
-	  ;; The first line may not even have a fill prefix.
-	  (goto-char from)
-	  (let ((fpre (and fill-prefix (not (equal fill-prefix ""))
-			   (concat "[ \t]*"
-				   (regexp-quote fill-prefix)
-				   "[ \t]*"))))
-	    (and fpre
-		 (progn
-		   (if (>= (+ (current-left-margin) (length fill-prefix))
-			   (current-fill-column))
-		       (error "fill-prefix too long for specified width"))
-		   (goto-char from)
-		   (forward-line 1)
-		   (while (not (eobp))
-		     (if (looking-at fpre)
-			 (delete-region (point) (match-end 0)))
-		     (forward-line 1))
-		   (goto-char from)
-		   (if (looking-at fpre)
-		       (goto-char (match-end 0)))
-		   (setq from (point)))))
-	  ;; Remove indentation from lines other than the first.
-	  (beginning-of-line 2)
-	  (indent-region (point) (point-max) 0)
-	  (goto-char from)
-
-	  ;; FROM, and point, are now before the text to fill,
-	  ;; but after any fill prefix on the first line.
-
-	  ;; Make sure sentences ending at end of line get an extra space.
-	  ;; loses on split abbrevs ("Mr.\nSmith")
-	  (while (re-search-forward "[.?!][])}\"']*$" nil t)
-	    (or (eobp) (insert-and-inherit ?\ )))
-	  (goto-char from)
-	  (skip-chars-forward " \t")
-	  ;; Then change all newlines to spaces.
-	  (subst-char-in-region from (point-max) ?\n ?\ )
-	  (if (and nosqueeze (not (eq justify 'full)))
-	      nil
-	    (canonically-space-region (or squeeze-after (point)) (point-max))
-	    (goto-char (point-max))
-	    (delete-horizontal-space)
-	    (insert-and-inherit " "))
-	  (goto-char (point-min))
-
-	  ;; This is the actual filling loop.
-	  (let ((prefixcol 0) linebeg)
-	    (while (not (eobp))
-	      (setq linebeg (point))
-	      (move-to-column (1+ (current-fill-column)))
-	      (if (eobp)
-		  (or nosqueeze (delete-horizontal-space))
-		;; Move back to start of word.
-		(skip-chars-backward "^ \n" linebeg)
-		;; Don't break after a period followed by just one space.
-		;; Move back to the previous place to break.
-		;; The reason is that if a period ends up at the end of a line,
-		;; further fills will assume it ends a sentence.
-		;; If we now know it does not end a sentence,
-		;; avoid putting it at the end of the line.
-		(if sentence-end-double-space
-		    (while (and (> (point) (+ linebeg 2))
-				(eq (preceding-char) ?\ )
-				(not (eq (following-char) ?\ ))
-				(eq (char-after (- (point) 2)) ?\.))
-		      (forward-char -2)
-		      (skip-chars-backward "^ \n" linebeg)))
-		;; If the left margin and fill prefix by themselves
-		;; pass the fill-column. or if they are zero
-		;; but we have no room for even one word,
-		;; keep at least one word anyway.
-		;; This handles ALL BUT the first line of the paragraph.
-		(if (if (zerop prefixcol)
-			(save-excursion
-			  (skip-chars-backward " \t" linebeg)
-			  (bolp))
-		      (>= prefixcol (current-column)))
-		    ;; Ok, skip at least one word.
-		    ;; Meanwhile, don't stop at a period followed by one space.
-		    (let ((first t))
-		      (move-to-column prefixcol)
-		      (while (and (not (eobp))
-				  (or first
-				      (and (not (bobp))
-					   sentence-end-double-space
-					   (save-excursion (forward-char -1)
-							   (and (looking-at "\\. ")
-								(not (looking-at "\\.  ")))))))
-			(skip-chars-forward " \t")
-			(skip-chars-forward "^ \n\t")
-			(setq first nil)))
-		  ;; Normally, move back over the single space between the words.
-		  (forward-char -1))
-		;; If the left margin and fill prefix by themselves
-		;; pass the fill-column, keep at least one word.
-		;; This handles the first line of the paragraph.
-		(if (and (zerop prefixcol)
-			 (let ((fill-point (point)) nchars)
-			   (save-excursion
-			     (move-to-left-margin)
-			     (setq nchars (- fill-point (point)))
-			     (or (< nchars 0)
-				 (and fill-prefix
-				      (< nchars (length fill-prefix))
-				      (string= (buffer-substring (point) fill-point)
-					       (substring fill-prefix 0 nchars)))))))
-		    ;; Ok, skip at least one word.  But
-		    ;; don't stop at a period followed by just one space.
-		    (let ((first t))
-		      (while (and (not (eobp))
-				  (or first
-				      (and (not (bobp))
-					   sentence-end-double-space
-					   (save-excursion (forward-char -1)
-							   (and (looking-at "\\. ")
-								(not (looking-at "\\.  ")))))))
-			(skip-chars-forward " \t")
-			(skip-chars-forward "^ \t\n")
-			(setq first nil))))
-		;; Check again to see if we got to the end of the paragraph.
-		(if (save-excursion (skip-chars-forward " \t") (eobp))
-		    (or nosqueeze (delete-horizontal-space))
-		  ;; Replace whitespace here with one newline, then indent to left
-		  ;; margin.
-		  (skip-chars-backward " \t")
-		  (insert ?\n)
-		  ;; Give newline the properties of the space(s) it replaces
-		  (set-text-properties (1- (point)) (point)
-				       (text-properties-at (point)))
-		  (indent-to-left-margin)
-		  ;; Insert the fill prefix after indentation.
-		  ;; Set prefixcol so whitespace in the prefix won't get lost.
-		  (and fill-prefix (not (equal fill-prefix ""))
-		       (progn
-			 (insert-and-inherit fill-prefix)
-			 (setq prefixcol (current-column))))))
-	      ;; Justify the line just ended, if desired.
-	      (if justify
-		  (if (eobp)
-		      (justify-current-line justify t t)
-		    (forward-line -1)
-		    (justify-current-line justify nil t)
-		    (forward-line 1))))))
-	;; Leave point after final newline.
-	(goto-char (point-max)))
-    (forward-char 1))))
-
-(defun fill-paragraph (arg)
-  "Fill paragraph at or after point.  Prefix arg means justify as well.
-If `sentence-end-double-space' is non-nil, then period followed by one
-space does not end a sentence, so don't break a line there.
-
-If `fill-paragraph-function' is non-nil, we call it (passing our
-argument to it), and if it returns non-nil, we simply return its value."
-  (interactive (list (if current-prefix-arg 'full)))
-  (or (and fill-paragraph-function
-	   (let ((function fill-paragraph-function)
-		 fill-paragraph-function)
-	     (funcall function arg)))
-      (let ((before (point)))
-	(save-excursion
-	  (forward-paragraph)
-	  (or (bolp) (newline 1))
-	  (let ((end (point))
-		(beg (progn (backward-paragraph) (point))))
-	    (goto-char before)
-	    (if use-hard-newlines
-		;; Can't use fill-region-as-paragraph, since this paragraph may
-		;; still contain hard newlines.  See fill-region.
-		(fill-region beg end arg)
-	      (fill-region-as-paragraph beg end arg)))))))
-
-(defun fill-region (from to &optional justify nosqueeze to-eop)
-  "Fill each of the paragraphs in the region.
-Prefix arg (non-nil third arg, if called from program) means justify as well.
-
-Noninteractively, fourth arg NOSQUEEZE non-nil means to leave
-whitespace other than line breaks untouched, and fifth arg TO-EOP
-non-nil means to keep filling to the end of the paragraph (or next
-hard newline, if `use-hard-newlines' is on).
-
-If `sentence-end-double-space' is non-nil, then period followed by one
-space does not end a sentence, so don't break a line there."
-  (interactive (list (region-beginning) (region-end)
-		     (if current-prefix-arg 'full)))
-  (let (end beg)
-    (save-restriction
-      (goto-char (max from to))
-      (if to-eop
-	  (progn (skip-chars-backward "\n")
-		 (forward-paragraph)))
-      (setq end (point))
-      (goto-char (setq beg (min from to)))
-      (beginning-of-line)
-      (narrow-to-region (point) end)
-      (while (not (eobp))
-	(let ((initial (point))
-	      end)
-	  ;; If using hard newlines, break at every one for filling
-	  ;; purposes rather than using paragraph breaks. 
-	  (if use-hard-newlines
-	      (progn 
-		(while (and (setq end (text-property-any (point) (point-max)
-							 'hard t))
-			    (not (= ?\n (char-after end)))
-			    (not (= end (point-max))))
-		  (goto-char (1+ end)))
-		(setq end (if end (min (point-max) (1+ end)) (point-max)))
-		(goto-char initial))
-	    (forward-paragraph 1)
-	    (setq end (point))
-	    (forward-paragraph -1))
-	  (if (< (point) beg)
-	      (goto-char beg))
-	  (if (>= (point) initial)
-	      (fill-region-as-paragraph (point) end justify nosqueeze)
-	    (goto-char end)))))))
-
-
-(defvar default-justification 'left
-  "*Method of justifying text not otherwise specified.
-Possible values are `left', `right', `full', `center', or `none'.
-The requested kind of justification is done whenever lines are filled.
-The `justification' text-property  can locally override this variable.
-This variable automatically becomes buffer-local when set in any fashion.")
-(make-variable-buffer-local 'default-justification)
-
-(defun current-justification ()
-  "How should we justify this line?
-This returns the value of the text-property `justification',
-or the variable `default-justification' if there is no text-property.
-However, it returns nil rather than `none' to mean \"don't justify\"."
-  (let ((j (or (get-text-property 
-		;; Make sure we're looking at paragraph body.
-		(save-excursion (skip-chars-forward " \t") 
-				(if (and (eobp) (not (bobp)))
-				    (1- (point)) (point)))
-		'justification)
-	       default-justification)))
-    (if (eq 'none j)
-	nil
-      j)))
-
-(defun set-justification (begin end value &optional whole-par)
-  "Set the region's justification style.
-The kind of justification to use is prompted for.
-If the mark is not active, this command operates on the current paragraph.
-If the mark is active, the region is used.  However, if the beginning and end
-of the region are not at paragraph breaks, they are moved to the beginning and
-end of the paragraphs they are in.
-If `use-hard-newlines' is true, all hard newlines are taken to be paragraph
-breaks.
-
-When calling from a program, operates just on region between BEGIN and END,
-unless optional fourth arg WHOLE-PAR is non-nil.  In that case bounds are
-extended to include entire paragraphs as in the interactive command."
-  (interactive (list (if mark-active (region-beginning) (point))
-		     (if mark-active (region-end) (point))
-		     (let ((s (completing-read
-			       "Set justification to: "
-			       '(("left") ("right") ("full")
-				 ("center") ("none"))
-			       nil t)))
-		       (if (equal s "") (error ""))
-		       (intern s))
-		     t))
-  (save-excursion
-    (save-restriction
-      (if whole-par
-	  (let ((paragraph-start (if use-hard-newlines "." paragraph-start))
-		(paragraph-ignore-fill-prefix (if use-hard-newlines t 
-						paragraph-ignore-fill-prefix)))
-	    (goto-char begin)
-	    (while (and (bolp) (not (eobp))) (forward-char 1))
-	    (backward-paragraph)
-	    (setq begin (point))
-	    (goto-char end)
-	    (skip-chars-backward " \t\n" begin)
-	    (forward-paragraph)
-	    (setq end (point))))
-
-      (narrow-to-region (point-min) end)
-      (unjustify-region begin (point-max))
-      (put-text-property begin (point-max) 'justification value)
-      (fill-region begin (point-max) nil t))))
-
-(defun set-justification-none (b e)
-  "Disable automatic filling for paragraphs in the region.
-If the mark is not active, this applies to the current paragraph."
-  (interactive (list (if mark-active (region-beginning) (point))
-		     (if mark-active (region-end) (point))))
-  (set-justification b e 'none t))
-
-(defun set-justification-left (b e)
-  "Make paragraphs in the region left-justified.
-This is usually the default, but see the variable `default-justification'.
-If the mark is not active, this applies to the current paragraph."
-  (interactive (list (if mark-active (region-beginning) (point))
-		     (if mark-active (region-end) (point))))
-  (set-justification b e 'left t))
-
-(defun set-justification-right (b e)
-  "Make paragraphs in the region right-justified:
-Flush at the right margin and ragged on the left.
-If the mark is not active, this applies to the current paragraph."
-  (interactive (list (if mark-active (region-beginning) (point))
-		     (if mark-active (region-end) (point))))
-  (set-justification b e 'right t))
-
-(defun set-justification-full (b e)
-  "Make paragraphs in the region fully justified:
-This makes lines flush on both margins by inserting spaces between words.
-If the mark is not active, this applies to the current paragraph."
-  (interactive (list (if mark-active (region-beginning) (point))
-		     (if mark-active (region-end) (point))))
-  (set-justification b e 'full t))
-
-(defun set-justification-center (b e)
-  "Make paragraphs in the region centered.
-If the mark is not active, this applies to the current paragraph."
-  (interactive (list (if mark-active (region-beginning) (point))
-		     (if mark-active (region-end) (point))))
-  (set-justification b e 'center t))
-
-;; A line has up to six parts:
-;;
-;;           >>>                    hello.  		       
-;; [Indent-1][FP][    Indent-2     ][text][trailing whitespace][newline]
-;;
-;; "Indent-1" is the left-margin indentation; normally it ends at column
-;;     given by the `current-left-margin' function.
-;; "FP" is the fill-prefix.  It can be any string, including whitespace.
-;; "Indent-2" is added to justify a line if the `current-justification' is
-;;     `center' or `right'.  In `left' and `full' justification regions, any
-;;     whitespace there is part of the line's text, and should not be changed.
-;; Trailing whitespace is not counted as part of the line length when
-;; center- or right-justifying.
-;;
-;; All parts of the line are optional, although the final newline can 
-;;     only be missing on the last line of the buffer.
-
-(defun justify-current-line (&optional how eop nosqueeze)
-  "Do some kind of justification on this line.
-Normally does full justification: adds spaces to the line to make it end at
-the column given by `current-fill-column'.
-Optional first argument HOW specifies alternate type of justification:
-it can be `left', `right', `full', `center', or `none'.  
-If HOW is t, will justify however the `current-justification' function says to.
-If HOW is nil or missing, full justification is done by default.
-Second arg EOP non-nil means that this is the last line of the paragraph, so
-it will not be stretched by full justification.
-Third arg NOSQUEEZE non-nil means to leave interior whitespace unchanged,
-otherwise it is made canonical."
-  (interactive)
-  (if (eq t how) (setq how (or (current-justification) 'none))
-    (if (null how) (setq how 'full)
-      (or (memq how '(none left right center))
-	  (setq how 'full))))
-  (or (memq how '(none left))  ; No action required for these.
-      (let ((fc (current-fill-column))
-	    (pos (point-marker))
-	    fp-end			; point at end of fill prefix
-	    beg				; point at beginning of line's text
-	    end				; point at end of line's text
-	    indent			; column of `beg'
-	    endcol			; column of `end'
-	    ncols)			; new indent point or offset
-	(end-of-line)
-	;; Check if this is the last line of the paragraph.
-	(if (and use-hard-newlines (null eop) 
-		 (get-text-property (point) 'hard))
-	    (setq eop t))
-	(skip-chars-backward " \t")
-	;; Quick exit if it appears to be properly justified already
-	;; or there is no text.
-	(if (or (bolp)
-		(and (memq how '(full right))
-		     (= (current-column) fc)))
-	    nil
-	  (setq end (point))
-	  (beginning-of-line)
-	  (skip-chars-forward " \t")
-	  ;; Skip over fill-prefix.
-	  (if (and fill-prefix 
-		   (not (string-equal fill-prefix ""))
-		   (equal fill-prefix
-			  (buffer-substring 
-			   (point) (min (point-max) (+ (length fill-prefix)
-						       (point))))))
-	      (forward-char (length fill-prefix))
-	    (if (and adaptive-fill-mode 
-		     (looking-at adaptive-fill-regexp))
-		(goto-char (match-end 0))))
-	  (setq fp-end (point))
-	  (skip-chars-forward " \t")
-	  ;; This is beginning of the line's text.
-	  (setq indent (current-column))
-	  (setq beg (point))
-	  (goto-char end)
-	  (setq endcol (current-column))
-
-	  ;; HOW can't be null or left--we would have exited already
-	  (cond ((eq 'right how) 
-		 (setq ncols (- fc endcol))
-		 (if (< ncols 0)
-		     ;; Need to remove some indentation
-		     (delete-region 
-		      (progn (goto-char fp-end)
-			     (if (< (current-column) (+ indent ncols))
-				 (move-to-column (+ indent ncols) t))
-			     (point))
-		      (progn (move-to-column indent) (point)))
-		   ;; Need to add some
-		   (goto-char beg)
-		   (indent-to (+ indent ncols))
-		   ;; If point was at beginning of text, keep it there.
-		   (if (= beg pos) 
-		       (move-marker pos (point)))))
-
-		((eq 'center how)
-		 ;; Figure out how much indentation is needed
-		 (setq ncols (+ (current-left-margin)
-				(/ (- fc (current-left-margin) ;avail. space
-				      (- endcol indent)) ;text width
-				   2)))
-		 (if (< ncols indent)
-		     ;; Have too much indentation - remove some
-		     (delete-region
-		      (progn (goto-char fp-end)
-			     (if (< (current-column) ncols)
-				 (move-to-column ncols t))
-			     (point))
-		      (progn (move-to-column indent) (point)))
-		   ;; Have too little - add some
-		   (goto-char beg)
-		   (indent-to ncols)
-		   ;; If point was at beginning of text, keep it there.
-		   (if (= beg pos)
-		       (move-marker pos (point)))))
-
-		((eq 'full how)
-		 ;; Insert extra spaces between words to justify line
-		 (save-restriction
-		   (narrow-to-region beg end)
-		   (or nosqueeze
-		       (canonically-space-region beg end))
-		   (goto-char (point-max))
-		   (setq ncols (- fc endcol))
-		   ;; Ncols is number of additional spaces needed
-		   (if (> ncols 0)
-		       (if (and (not eop)
-				(search-backward " " nil t))
-			   (while (> ncols 0)
-			     (let ((nmove (+ 3 (random 3))))
-			       (while (> nmove 0)
-				 (or (search-backward " " nil t)
-				     (progn
-				       (goto-char (point-max))
-				       (search-backward " ")))
-				 (skip-chars-backward " ")
-				 (setq nmove (1- nmove))))
-			     (insert-and-inherit " ")
-			     (skip-chars-backward " ")
-			     (setq ncols (1- ncols)))))))
-		(t (error "Unknown justification value"))))
-	(goto-char pos)
-	(move-marker pos nil)))
-  nil)
-
-(defun unjustify-current-line ()
-  "Remove justification whitespace from current line.
-If the line is centered or right-justified, this function removes any
-indentation past the left margin.  If the line is full-justified, it removes
-extra spaces between words.  It does nothing in other justification modes."
-  (let ((justify (current-justification)))
-    (cond ((eq 'left justify) nil)
-	  ((eq  nil  justify) nil)
-	  ((eq 'full justify)		; full justify: remove extra spaces
-	   (beginning-of-line-text)
-	   (canonically-space-region
-	    (point) (save-excursion (end-of-line) (point))))
-	  ((memq justify '(center right))
-	   (save-excursion
-	     (move-to-left-margin nil t)
-	     ;; Position ourselves after any fill-prefix.
-	     (if (and fill-prefix 
-		      (not (string-equal fill-prefix ""))
-		      (equal fill-prefix
-			     (buffer-substring 
-			      (point) (min (point-max) (+ (length fill-prefix)
-							  (point))))))
-		 (forward-char (length fill-prefix)))
-	     (delete-region (point) (progn (skip-chars-forward " \t")
-					   (point))))))))
-
-(defun unjustify-region (&optional begin end)
-  "Remove justification whitespace from region.
-For centered or right-justified regions, this function removes any indentation
-past the left margin from each line.  For full-justified lines, it removes 
-extra spaces between words.  It does nothing in other justification modes.
-Arguments BEGIN and END are optional; default is the whole buffer."
-  (save-excursion
-    (save-restriction
-      (if end (narrow-to-region (point-min) end))
-      (goto-char (or begin (point-min)))
-      (while (not (eobp))
-	(unjustify-current-line)
-	(forward-line 1)))))
-
-
-(defun fill-nonuniform-paragraphs (min max &optional justifyp mailp)
-  "Fill paragraphs within the region, allowing varying indentation within each.
-This command divides the region into \"paragraphs\",
-only at paragraph-separator lines, then fills each paragraph
-using as the fill prefix the smallest indentation of any line
-in the paragraph.
-
-When calling from a program, pass range to fill as first two arguments.
-
-Optional third and fourth arguments JUSTIFY and MAIL-FLAG:
-JUSTIFY to justify paragraphs (prefix arg),
-MAIL-FLAG for a mail message, i. e. don't fill header lines."
-  (interactive (list (region-beginning) (region-end)
-		     (if current-prefix-arg 'full)))
-  (let ((fill-individual-varying-indent t))
-    (fill-individual-paragraphs min max justifyp mailp)))
-
-(defun fill-individual-paragraphs (min max &optional justify mailp)
-  "Fill paragraphs of uniform indentation within the region.
-This command divides the region into \"paragraphs\", 
-treating every change in indentation level as a paragraph boundary,
-then fills each paragraph using its indentation level as the fill prefix.
-
-When calling from a program, pass range to fill as first two arguments.
-
-Optional third and fourth arguments JUSTIFY and MAIL-FLAG:
-JUSTIFY to justify paragraphs (prefix arg),
-MAIL-FLAG for a mail message, i. e. don't fill header lines."
-  (interactive (list (region-beginning) (region-end)
-		     (if current-prefix-arg 'full)))
-  (save-restriction
-    (save-excursion
-      (goto-char min)
-      (beginning-of-line)
-      (narrow-to-region (point) max)
-      (if mailp 
-	  (while (and (not (eobp))
-		      (or (looking-at "[ \t]*[^ \t\n]+:")
-			  (looking-at "[ \t]*$")))
-	    (if (looking-at "[ \t]*[^ \t\n]+:")
-		(search-forward "\n\n" nil 'move)
-	      (forward-line 1))))
-      (narrow-to-region (point) max)
-      ;; Loop over paragraphs.
-      (while (progn (skip-chars-forward " \t\n") (not (eobp)))
-	(move-to-left-margin)
-	(let ((start (point))
-	      fill-prefix fill-prefix-regexp)
-	  ;; Find end of paragraph, and compute the smallest fill-prefix
-	  ;; that fits all the lines in this paragraph.
-	  (while (progn
-		   ;; Update the fill-prefix on the first line
-		   ;; and whenever the prefix good so far is too long.
-		   (if (not (and fill-prefix
-				 (looking-at fill-prefix-regexp)))
-		       (setq fill-prefix
-			     (if (and adaptive-fill-mode adaptive-fill-regexp
-				      (looking-at adaptive-fill-regexp))
-				 (match-string 0)
-			       (buffer-substring 
-				(point)
-				(save-excursion (skip-chars-forward " \t")
-						(point))))
-			     fill-prefix-regexp (regexp-quote fill-prefix)))
-		   (forward-line 1)
-		   (if (bolp)
-		       ;; If forward-line went past a newline,
-		       ;; move further to the left margin.
-		       (move-to-left-margin))
-		   ;; Now stop the loop if end of paragraph.
-		   (and (not (eobp))
-			(if fill-individual-varying-indent
-			    ;; If this line is a separator line, with or
-			    ;; without prefix, end the paragraph.
-			    (and 
-			     (not (looking-at paragraph-separate))
-			     (save-excursion
-			       (not (and (looking-at fill-prefix-regexp)
-					 (progn (forward-char (length fill-prefix))
-						(looking-at paragraph-separate))))))
-			  ;; If this line has more or less indent
-			  ;; than the fill prefix wants, end the paragraph.
-			  (and (looking-at fill-prefix-regexp)
-			       (save-excursion
-				 (not (progn (forward-char (length fill-prefix))
-					     (or (looking-at paragraph-separate)
-						 (looking-at paragraph-start))))))))))
-	  ;; Fill this paragraph, but don't add a newline at the end.
-	  (let ((had-newline (bolp)))
-	    (fill-region-as-paragraph start (point) justify)
-	    (or had-newline (delete-char -1))))))))
-
-;;; fill.el ends here
diff --git a/lisp/textmodes/ispell.el b/lisp/textmodes/ispell.el
deleted file mode 100644
index dd553fa90e7..00000000000
--- a/lisp/textmodes/ispell.el
+++ /dev/null
@@ -1,2412 +0,0 @@
-;;; ispell.el --- spell checking using Ispell
-
-;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
-
-;; Authors         : Ken Stevens <k.stevens@ieee.org>
-;; Last Modified On: Tue Jun 13 12:05:28 EDT 1995
-;; Update Revision : 2.37
-;; Syntax          : emacs-lisp
-;; Status	   : Release with 3.1.12+ ispell.
-;; Version	   : International Ispell Version 3.1 by Geoff Kuenning.
-;; Bug Reports	   : ispell-el-bugs@itcorp.com
-
-;; 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.
-
-;; Note: version numbers and time stamp are not updated
-;;   when this file is edited for release with GNU Emacs.
-
-;;; Commentary:
-
-;; INSTRUCTIONS
-;;
-;;  This code contains a section of user-settable variables that you should
-;; inspect prior to installation.  Look past the end of the history list.
-;; Set them up for your locale and the preferences of the majority of the
-;; users.  Otherwise the users may need to set a number of variables
-;; themselves.
-;;  You particularly may want to change the default dictionary for your
-;; country and language.
-;;
-;;
-;; To fully install this, add this file to your Emacs Lisp directory and
-;; compile it with M-X byte-compile-file.  Then add the following to the
-;; appropriate init file:
-;;
-;;  (autoload 'ispell-word "ispell"
-;;    "Check the spelling of word in buffer." t)
-;;  (global-set-key "\e$" 'ispell-word)
-;;  (autoload 'ispell-region "ispell"
-;;    "Check the spelling of region." t)
-;;  (autoload 'ispell-buffer "ispell"
-;;    "Check the spelling of buffer." t)
-;;  (autoload 'ispell-complete-word "ispell"
-;;    "Look up current word in dictionary and try to complete it." t)
-;;  (autoload 'ispell-change-dictionary "ispell"
-;;    "Change ispell dictionary." t)
-;;  (autoload 'ispell-message "ispell"
-;;    "Check spelling of mail message or news post.")
-;;
-;;  Depending on the mail system you use, you may want to include these:
-;;
-;;  (add-hook 'news-inews-hook 'ispell-message)
-;;  (add-hook 'mail-send-hook  'ispell-message)
-;;  (add-hook 'mh-before-send-letter-hook 'ispell-message)
-;;
-;;
-;; Ispell has a TeX parser and a nroff parser (the default).
-;; The parsing is controlled by the variable ispell-parser.  Currently
-;; it is just a "toggle" between TeX and nroff, but if more parsers are
-;; added it will be updated.  See the variable description for more info.
-;;
-;;
-;; TABLE OF CONTENTS
-;;
-;;   ispell-word
-;;   ispell-region
-;;   ispell-buffer
-;;   ispell-message
-;;   ispell-continue
-;;   ispell-complete-word
-;;   ispell-complete-word-interior-frag
-;;   ispell-change-dictionary
-;;   ispell-kill-ispell
-;;   ispell-pdict-save
-;;
-;;
-;; Commands in ispell-region:
-;; Character replacement: Replace word with choice.  May query-replace.
-;; ' ': Accept word this time.
-;; 'i': Accept word and insert into private dictionary.
-;; 'a': Accept word for this session.
-;; 'A': Accept word and place in buffer-local dictionary.
-;; 'r': Replace word with typed-in value.  Rechecked.
-;; 'R': Replace word with typed-in value. Query-replaced in buffer. Rechecked.
-;; '?': Show these commands
-;; 'x': Exit spelling buffer.  Move cursor to original point.
-;; 'X': Exit spelling buffer.  Leave cursor at the current point.
-;; 'q': Quit spelling session (Kills ispell process).
-;; 'l': Look up typed-in replacement in alternate dictionary.  Wildcards okay.
-;; 'u': Like 'i', but the word is lower-cased first.
-;; 'm': Like 'i', but allows one to include dictionary completion info.
-;; 'C-l': redraws screen
-;; 'C-r': recursive edit
-;; 'C-z': suspend emacs or iconify frame
-;;
-;; Buffer-Local features:
-;; There are a number of buffer-local features that can be used to customize
-;;  ispell for the current buffer.  This includes language dictionaries,
-;;  personal dictionaries, parsing, and local word spellings.  Each of these
-;;  local customizations are done either through local variables, or by
-;;  including the keyword and argument(s) at the end of the buffer (usually
-;;  prefixed by the comment characters).  See the end of this file for
-;;  examples.  The local keywords and variables are:
-;;
-;;  ispell-dictionary-keyword   language-dictionary
-;;      uses local variable ispell-local-dictionary
-;;  ispell-pdict-keyword        personal-dictionary
-;;      uses local variable ispell-local-pdict
-;;  ispell-parsing-keyword      mode-arg extended-char-arg
-;;  ispell-words-keyword        any number of local word spellings
-;;
-;;
-;; BUGS:
-;;  Highlighting in version 19 still doesn't work on tty's.
-;;  On some versions of emacs, growing the minibuffer fails.
-;;
-;; HISTORY
-;;
-;; Revision 2.38  1996/5/30	ethanb@phys.washington.edu
-;; Update ispell-message for gnus 5 (news-inews-hook => message-send-hook;
-;; different header for quoted message).
-;;
-;; Revision 2.37  1995/6/13 12:05:28	stevens
-;; Removed autoload from ispell-dictionary-alist. *choices* mode-line shows
-;; misspelled word.  Block skip for pgp & forwarded messages added.
-;; RMS: the autoload changes had problems and I removed them.
-;;
-;; Revision 2.36  1995/2/6 17:39:38	stevens
-;; Properly adjust screen with different ispell-choices-win-default-height
-;; settings.  Skips SGML entity references.
-;;
-;; Revision 2.35  1995/1/13 14:16:46	stevens
-;; Skips SGML tags, ispell-change-dictionary fix for add-hook, assure personal
-;; dictionary is saved when called from the menu
-;;
-;; Revision 2.34  1994/12/08 13:17:41  stevens
-;; Interaction corrected to function with all 3.1 ispell versions.
-;;
-;; Revision 2.33  1994/11/24 02:31:20  stevens
-;; Repaired bug introduced in 2.32 that corrupts buffers when correcting.
-;; Improved buffer scrolling. Nondestructive buffer selections allowed.
-;;
-;; Revision 2.32  1994/10/31 21:10:08  geoff
-;; Many revisions accepted from RMS/FSF.  I think (though I don't know) that
-;; this represents an 'official' version.
-;;
-;; Revision 2.31  1994/5/31 10:18:17  stevens
-;; Repaired comments.  buffer-local commands executed in `ispell-word' now.
-;; German dictionary described for extended character mode.  Dict messages.
-;;
-;; Revision 2.30  1994/5/20 22:18:36  stevens
-;; Continue ispell from ispell-word, C-z functionality fixed.
-;;
-;; Revision 2.29  1994/5/12 09:44:33  stevens
-;; Restored ispell-use-ptys-p, ispell-message aborts sends with interrupt.
-;; defined fn ispell
-;;
-;; Revision 2.28  1994/4/28 16:24:40  stevens
-;; Window checking when ispell-message put on gnus-inews-article-hook jwz.
-;; prefixed ispell- to highlight functions and horiz-scroll fn.
-;; Try and respect case of word in ispell-complete-word.
-;; Ignore non-char events.  Ispell-use-ptys-p commented out. Lucid menu.
-;; Better interrupt handling.  ispell-message improvements from Ethan.
-;;
-;; Revision 2.27
-;; version 18 explicit C-g handling disabled as it didn't work. Added
-;; ispell-extra-args for ispell customization (jwz)
-;;
-;; Revision 2.26  1994/2/15 16:11:14  stevens
-;; name changes for copyright assignment.  Added word-frags in complete-word.
-;; Horizontal scroll (John Conover). Query-replace matches words now.  bugs.
-;;
-;; Revision 2.25
-;; minor mods, upgraded ispell-message
-;;
-;; Revision 2.24
-;; query-replace more robust, messages, defaults, ispell-change-dict.
-;;
-;; Revision 2.23  1993/11/22 23:47:03  stevens
-;; ispell-message, Fixed highlighting, added menu-bar, fixed ispell-help, ...
-;;
-;; Revision 2.22
-;; Added 'u' command.  Fixed default in ispell-local-dictionary.
-;; fixed affix rules display.  Tib skipping more robust.  Contributions by
-;; Per Abraham (parser selection), Denis Howe, and Eberhard Mattes.
-;;
-;; Revision 2.21  1993/06/30 14:09:04  stevens
-;; minor bugs. (nroff word skipping fixed)
-;;
-;; Revision 2.20  1993/06/30 14:09:04  stevens
-;;
-;; Debugging and contributions by: Boris Aronov, Rik Faith, Chris Moore,
-;;  Kevin Rodgers, Malcolm Davis.
-;; Particular thanks to Michael Lipp, Jamie Zawinski, Phil Queinnec
-;;  and John Heidemann for suggestions and code.
-;; Major update including many tweaks.
-;; Many changes were integrations of suggestions.
-;; lookup-words rehacked to use call-process (Jamie).
-;; ispell-complete-word rehacked to be compatible with the rest of the
-;; system for word searching and to include multiple wildcards,
-;; and its own dictionary.
-;; query-replace capability added.  New options 'X', 'R', and 'A'.
-;; buffer-local modes for dictionary, word-spelling, and formatter-parsing.
-;; Many random bugs, like commented comments being skipped, fix to
-;; keep-choices-win, fix for math mode, added pipe mode choice,
-;; fixed 'q' command, ispell-word checks previous word and leave cursor
-;; in same location.  Fixed tib code which could drop spelling regions.
-;; Cleaned up setq calls for efficiency. Gave more context on window overlays.
-;; Assure context on ispell-command-loop.  Window lossage in look cmd fixed.
-;; Due to pervasive opinion, common-lisp package syntax removed. Display
-;; problem when not highlighting.
-;;
-;; Revision 2.19  1992/01/10  10:54:08  geoff
-;; Make another attempt at fixing the "Bogus, dude" problem.  This one is
-;; less elegant, but has the advantage of working.
-;;
-;; Revision 2.18  1992/01/07  10:04:52  geoff
-;; Fix the "Bogus, Dude" problem in ispell-word.
-;;
-;; Revision 2.17  1991/09/12  00:01:42  geoff
-;; Add some changes to make ispell-complete-word work better, though
-;; still not perfectly.
-;;
-;; Revision 2.16  91/09/04  18:00:52  geoff
-;; More updates from Sebastian, to make the multiple-dictionary support
-;; more flexible.
-;;
-;; Revision 2.15  91/09/04  17:30:02  geoff
-;; Sebastian Kremer's tib support
-;;
-;; Revision 2.14  91/09/04  16:19:37  geoff
-;; Don't do set-window-start if the move-to-window-line moved us
-;; downward, rather than upward.  This prevents getting the buffer all
-;; confused.  Also, don't use the "not-modified" function to clear the
-;; modification flag;  instead use set-buffer-modified-p.  This prevents
-;; extra messages from flashing.
-;;
-;; Revision 2.13  91/09/04  14:35:41  geoff
-;; Fix a spelling error in a comment.  Add code to handshake with the
-;; ispell process before sending anything to it.
-;;
-;; Revision 2.12  91/09/03  20:14:21  geoff
-;; Add Sebastian Kremer's multiple-language support.
-;;
-;;
-;; Walt Buehring
-;; Texas Instruments - Computer Science Center
-;; ARPA:  Buehring%TI-CSL@CSNet-Relay
-;; UUCP:  {smu, texsun, im4u, rice} ! ti-csl ! buehring
-;;
-;; ispell-region and associated routines added by
-;; Perry Smith
-;; pedz@bobkat
-;; Tue Jan 13 20:18:02 CST 1987
-;;
-;; extensively modified by Mark Davies and Andrew Vignaux
-;; {mark,andrew}@vuwcomp
-;; Sun May 10 11:45:04 NZST 1987
-;;
-;; Ken Stevens  ARPA: k.stevens@ieee.org
-;; Tue Jan  3 16:59:07 PST 1989
-;; This file has overgone a major overhaul to be compatible with ispell
-;; version 2.1.  Most of the functions have been totally rewritten, and
-;; many user-accessible variables have been added.  The syntax table has
-;; been removed since it didn't work properly anyway, and a filter is
-;; used rather than a buffer.  Regular expressions are used based on
-;; ispell's internal definition of characters (see ispell(4)).
-;; Some new updates:
-;; - Updated to version 3.0 to include terse processing.
-;; - Added a variable for the look command.
-;; - Fixed a bug in ispell-word when cursor is far away from the word
-;;   that is to be checked.
-;; - Ispell places the incorrect word or guess in the minibuffer now.
-;; - fixed a bug with 'l' option when multiple windows are on the screen.
-;; - lookup-words just didn't work with the process filter.  Fixed.
-;; - Rewrote the process filter to make it cleaner and more robust
-;;   in the event of a continued line not being completed.
-;; - Made ispell-init-process more robust in handling errors.
-;; - Fixed bug in continuation location after a region has been modified by
-;;   correcting a misspelling.
-;; Mon 17 Sept 1990
-;;
-;; Sebastian Kremer <sk@thp.uni-koeln.de>
-;; Wed Aug  7 14:02:17 MET DST 1991
-;; - Ported ispell-complete-word from Ispell 2 to Ispell 3.
-;; - Added ispell-kill-ispell command.
-;; - Added ispell-dictionary and ispell-dictionary-alist variables to
-;;   support other than default language.  See their docstrings and
-;;   command ispell-change-dictionary.
-;; - (ispelled it :-)
-;; - Added ispell-skip-tib variable to support the tib bibliography
-;;   program.
-
-
-;; **********************************************************************
-;; The following variables should be set according to personal preference
-;; and location of binaries:
-;; **********************************************************************
-
-;;  ******* THIS FILE IS WRITTEN FOR ISPELL VERSION 3.1
-
-;;; Code:
-
-(defvar ispell-highlight-p t
-  "*Highlight spelling errors when non-nil.")
-
-(defvar ispell-highlight-face 'highlight
-  "*The face used for Ispell highlighting.  For Emacses with overlays.
-Possible values are `highlight', `modeline', `secondary-selection',
-`region', and `underline'.
-This variable can be set by the user to whatever face they desire.
-It's most convenient if the cursor color and highlight color are
-slightly different.")
-
-(defvar ispell-check-comments t
-  "*If nil, don't check spelling of comments.")
-
-(defvar ispell-query-replace-choices nil
-  "*Corrections made throughout region when non-nil.
-Uses `query-replace' (\\[query-replace]) for corrections.")
-
-(defvar ispell-skip-tib nil
-  "*Does not spell check `tib' bibliography references when non-nil.
-Skips any text between strings matching regular expressions
-`ispell-tib-ref-beginning' and `ispell-tib-ref-end'.
-
-TeX users beware:  Any field starting with [. will skip until a .] -- even
-your whole buffer -- unless you set `ispell-skip-tib' to nil.  That includes
-a [.5mm] type of number....")
-
-(defvar ispell-tib-ref-beginning "[[<]\\."
-  "Regexp matching the beginning of a Tib reference.")
-
-(defvar ispell-tib-ref-end "\\.[]>]"
-  "Regexp matching the end of a Tib reference.")
-
-(defvar ispell-keep-choices-win t
-  "*When not nil, the `*Choices*' window remains for spelling session.
-This minimizes redisplay thrashing.")
-
-(defvar ispell-choices-win-default-height 2
-  "*The default size of the `*Choices*' window, including status line.
-Must be greater than 1.")
-
-(defvar ispell-program-name "ispell"
-  "Program invoked by \\[ispell-word] and \\[ispell-region] commands.")
-
-(defvar ispell-alternate-dictionary
-  (cond ((file-exists-p "/usr/dict/web2") "/usr/dict/web2")
-	((file-exists-p "/usr/share/dict/web2") "/usr/share/dict/web2")
-	((file-exists-p "/usr/dict/words") "/usr/dict/words")
-	((file-exists-p "/usr/lib/dict/words") "/usr/lib/dict/words")
-	((file-exists-p "/usr/share/dict/words") "/usr/share/dict/words")
-	((file-exists-p "/sys/dict") "/sys/dict")
-	(t "/usr/dict/words"))
-  "*Alternate dictionary for spelling help.")
-
-(defvar ispell-complete-word-dict ispell-alternate-dictionary
-  "*Dictionary used for word completion.")
-
-(defvar ispell-grep-command "egrep"
-  "Name of the grep command for search processes.")
-
-(defvar ispell-grep-options "-i"
-  "String of options to use when running the program in `ispell-grep-command'.
-Should probably be \"-i\" or \"-e\".
-Some machines (like the NeXT) don't support \"-i\"")
-
-(defvar ispell-look-command "look"
-  "Name of the look command for search processes.
-This must be an absolute file name.")
-
-(defvar ispell-look-p (file-exists-p ispell-look-command)
-  "*Non-nil means use `look' rather than `grep'.
-Default is based on whether `look' seems to be available.")
-
-(defvar ispell-have-new-look nil
-  "*Non-nil means use the `-r' option (regexp) when running `look'.")
-
-(defvar ispell-look-options (if ispell-have-new-look "-dfr" "-df")
-  "String of command options for `ispell-look-command'.")
-
-(defvar ispell-use-ptys-p nil
-  "When non-nil, Emacs uses ptys to communicate with Ispell.
-When nil, Emacs uses pipes.")
-
-(defvar ispell-following-word nil
-  "*Non-nil means `ispell-word' checks the word around or after point.
-Otherwise `ispell-word' checks the preceding word.")
-
-(defvar ispell-help-in-bufferp nil
-  "*Non-nil means display interactive keymap help in a buffer.
-Otherwise use the minibuffer.")
-
-(defvar ispell-quietly nil
-  "*Non-nil means suppress messages in `ispell-word'.")
-
-(defvar ispell-format-word (function upcase)
-  "*Formatting function for displaying word being spell checked.
-The function must take one string argument and return a string.")
-
-;;;###autoload
-(defvar ispell-personal-dictionary nil
-  "*File name of your personal spelling dictionary, or nil.
-If nil, the default personal dictionary, \"~/.ispell_DICTNAME\" is used,
-where DICTNAME is the name of your default dictionary.")
-
-(defvar ispell-silently-savep nil
-  "*When non-nil, save the personal dictionary without confirmation.")
-
-;;; This variable contains the current dictionary being used if the ispell
-;;; process is running.  Otherwise it contains the global default.
-(defvar ispell-dictionary nil
-  "If non-nil, a dictionary to use instead of the default one.
-This is passed to the ispell process using the `-d' switch and is
-used as key in `ispell-dictionary-alist' (which see).
-
-You should set this variable before your first use of Emacs spell-checking
-commands in the Emacs session, or else use the \\[ispell-change-dictionary]
-command to change it.  Otherwise, this variable only takes effect in a newly
-started Ispell process.")
-
-(defvar ispell-extra-args nil
-  "*If non-nil, a list of extra switches to pass to the Ispell program.
-For example, '(\"-W\" \"3\") to cause it to accept all 1-3 character
-words as correct.  See also `ispell-dictionary-alist', which may be used
-for language-specific arguments.")
-
-;;; The preparation of the menu bar menu must be autoloaded
-;;; because otherwise this file gets autoloaded every time Emacs starts
-;;; so that it can set up the menus and determine keyboard equivalents.
-
-;;;###autoload
-(defvar ispell-dictionary-alist-1	; sk  9-Aug-1991 18:28
-  '((nil				; default (english.aff)
-     "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil)
-    ("english"				; make English explicitly selectable
-     "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B") nil)
-    ("british"				; British version
-     "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B" "-d" "british") nil)
-    ("american"				; American version
-     "[A-Za-z]" "[^A-Za-z]" "[']" nil ("-B" "-d" "american") nil)
-    ("deutsch"				; deutsch.aff
-     "[a-zA-Z\"]" "[^a-zA-Z\"]" "[']" t ("-C") "~tex")
-    ("deutsch8"
-     "[a-zA-Z\304\326\334\344\366\337\374]"
-     "[^a-zA-Z\304\326\334\344\366\337\374]"
-     "[']" t ("-C" "-d" "deutsch") "~latin1")
-    ("nederlands"				; nederlands.aff
-     "[A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]"
-     "[^A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]"
-     "[']" t ("-C") nil)
-    ("nederlands8"				; dutch8.aff
-     "[A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]"
-     "[^A-Za-z\300-\305\307\310-\317\322-\326\331-\334\340-\345\347\350-\357\361\362-\366\371-\374]"
-     "[']" t ("-C") nil)))
-
-;;;###autoload
-(defvar ispell-dictionary-alist-2
-  '(("svenska"				;7 bit swedish mode
-     "[A-Za-z}{|\\133\\135\\\\]" "[^A-Za-z}{|\\133\\135\\\\]"
-     "[']" nil ("-C") nil)
-    ("svenska8"				;8 bit swedish mode
-     "[A-Za-z\345\344\366\305\304\366]"  "[^A-Za-z\345\344\366\305\304\366]"
-     "[']" nil ("-C" "-d" "svenska") "~list") ; Add `"-T" "list"' instead?
-    ("francais7"
-     "[A-Za-z]" "[^A-Za-z]" "[`'^---]" t nil nil)
-    ("francais"				; francais.aff
-     "[A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374]"
-     "[^A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374]"
-     "[---']" t nil "~list")
-    ("francais-tex"			; francais.aff
-     "[A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374\\]"
-     "[^A-Za-z\300\302\306\307\310\311\312\313\316\317\324\331\333\334\340\342\347\350\351\352\353\356\357\364\371\373\374\\]"
-     "[---'^`\"]" t nil "~tex")
-    ("dansk"				; dansk.aff
-     "[A-Z\306\330\305a-z\346\370\345]" "[^A-Z\306\330\305a-z\346\370\345]"
-     "" nil ("-C") nil)
-    ))
-
-
-;;; ispell-dictionary-alist is set up from two subvariables above
-;;; to avoid having very long lines in loaddefs.el.
-;;;###autoload
-(defvar ispell-dictionary-alist
-  (append ispell-dictionary-alist-1 ispell-dictionary-alist-2)
-  "An alist of dictionaries and their associated parameters.
-
-Each element of this list is also a list:
-
-\(DICTIONARY-NAME CASECHARS NOT-CASECHARS OTHERCHARS MANY-OTHERCHARS-P
-        ISPELL-ARGS EXTENDED-CHARACTER-MODE\)
-
-DICTIONARY-NAME is a possible value of variable `ispell-dictionary', nil
-means the default dictionary.
-
-CASECHARS is a regular expression of valid characters that comprise a
-word.
-
-NOT-CASECHARS is the opposite regexp of CASECHARS.
-
-OTHERCHARS is a regular expression of other characters that are valid
-in word constructs.  Otherchars cannot be adjacent to each other in a
-word, nor can they begin or end a word.  This implies we can't check
-\"Stevens'\" as a correct possessive and other correct formations.
-
-Hint: regexp syntax requires the hyphen to be declared first here.
-
-MANY-OTHERCHARS-P is non-nil if many otherchars are to be allowed in a
-word instead of only one.
-
-ISPELL-ARGS is a list of additional arguments passed to the ispell
-subprocess.
-
-EXTENDED-CHARACTER-MODE should be used when dictionaries are used which
-have been configured in an Ispell affix file.  (For example, umlauts
-can be encoded as \\\"a, a\\\", \"a, ...)  Defaults are ~tex and ~nroff
-in English.  This has the same effect as the command-line `-T' option.
-The buffer Major Mode controls Ispell's parsing in tex or nroff mode,
-but the dictionary can control the extended character mode.
-Both defaults can be overruled in a buffer-local fashion. See
-`ispell-parsing-keyword' for details on this.
-
-Note that the CASECHARS and OTHERCHARS slots of the alist should
-contain the same character set as casechars and otherchars in the
-language.aff file \(e.g., english.aff\).")
-
-;;;###autoload
-(defvar ispell-menu-map nil "Key map for ispell menu")
-
-;;;###autoload
-(defvar ispell-menu-lucid nil "Spelling menu for Lucid Emacs.")
-
-;;; Break out lucid menu and split into several calls to avoid having
-;;; long lines in loaddefs.el.  Detect need off following constant.
-
-;;;###autoload
-(defconst ispell-menu-map-needed	; make sure this is not Lucid Emacs
-  (and (not ispell-menu-map)
-;;; This is commented out because it fails in Emacs.
-;;; due to the fact that menu-bar is loaded much later than loaddefs.
-;;;       ;; make sure this isn't Lucid Emacs
-;;;       (featurep 'menu-bar)
-       (not (string-match "Lucid" emacs-version))))
-
-;;; Set up dictionary
-;;;###autoload
-(if ispell-menu-map-needed
-    (let ((dicts (reverse (cons (cons "default" nil) ispell-dictionary-alist)))
-	  name)
-      (setq ispell-menu-map (make-sparse-keymap "Spell"))
-      ;; add the dictionaries to the bottom of the list.
-      (while dicts
-	(setq name (car (car dicts))
-	      dicts (cdr dicts))
-	(if (stringp name)
-	    (define-key ispell-menu-map (vector (intern name))
-	      (cons (concat "Select " (capitalize name))
-		    (list 'lambda () '(interactive)
-			  (list 'ispell-change-dictionary name))))))))
-
-;;; define commands in menu in opposite order you want them to appear.
-;;;###autoload
-(if ispell-menu-map-needed
-    (progn
-      (define-key ispell-menu-map [ispell-change-dictionary]
-	'("Change Dictionary" . ispell-change-dictionary))
-      (define-key ispell-menu-map [ispell-kill-ispell]
-	'("Kill Process" . ispell-kill-ispell))
-      (define-key ispell-menu-map [ispell-pdict-save]
-	'("Save Dictionary" . (lambda () (interactive) (ispell-pdict-save t t))))
-      (define-key ispell-menu-map [ispell-complete-word]
-	'("Complete Word" . ispell-complete-word))
-      (define-key ispell-menu-map [ispell-complete-word-interior-frag]
-	'("Complete Word Frag" . ispell-complete-word-interior-frag))))
-
-;;;###autoload
-(if ispell-menu-map-needed
-    (progn
-      (define-key ispell-menu-map [ispell-continue]
-	'("Continue Check" . ispell-continue))
-      (define-key ispell-menu-map [ispell-word]
-	'("Check Word" . ispell-word))
-      (define-key ispell-menu-map [ispell-region]
-	'("Check Region" . ispell-region))
-      (define-key ispell-menu-map [ispell-buffer]
-	'("Check Buffer" . ispell-buffer))))
-
-;;;###autoload
-(if ispell-menu-map-needed
-    (progn
-      (define-key ispell-menu-map [ispell-message]
-	'("Check Message" . ispell-message))
-      (define-key ispell-menu-map [ispell-help]
-	;; use (x-popup-menu last-nonmenu-event(list "" ispell-help-list)) ?
-	'("Help" . (lambda () (interactive) (describe-function 'ispell-help))))
-      (put 'ispell-region 'menu-enable 'mark-active)
-      (fset 'ispell-menu-map (symbol-value 'ispell-menu-map))))
-
-;;; Xemacs version 19
-(if (and (string-lessp "19" emacs-version)
-	 (string-match "Lucid" emacs-version))
-    (let ((dicts (cons (cons "default" nil) ispell-dictionary-alist))
-	  (current-menubar (or current-menubar default-menubar))
-	  (menu
-	   '(["Help"		(describe-function 'ispell-help) t]
-	     ;;["Help"		(popup-menu ispell-help-list)	t]
-	     ["Check Message"	ispell-message			t]
-	     ["Check Buffer"	ispell-buffer			t]
-	     ["Check Word"	ispell-word			t]
-	     ["Check Region"	ispell-region  (or (not zmacs-regions) (mark))]
-	     ["Continue Check"	ispell-continue			t]
-	     ["Complete Word Frag"ispell-complete-word-interior-frag t]
-	     ["Complete Word"	ispell-complete-word		t]
-	     ["Kill Process"	ispell-kill-ispell		t]
-	     "-"
-	     ["Save Dictionary"	(ispell-pdict-save t t)		t]
-	     ["Change Dictionary" ispell-change-dictionary	t]))
-	  name)
-      (while dicts
-	(setq name (car (car dicts))
-	      dicts (cdr dicts))
-	(if (stringp name)
-	    (setq menu (append menu
-			       (list
-				(vector (concat "Select " (capitalize name))
-					(list 'ispell-change-dictionary name)
-					t))))))
-      (setq ispell-menu-lucid menu)
-      (if current-menubar
-	  (progn
-	    (delete-menu-item '("Edit" "Spell")) ; in case already defined
-	    (add-menu '("Edit") "Spell" ispell-menu-lucid)))))
-
-
-;;; **********************************************************************
-;;; The following are used by ispell, and should not be changed.
-;;; **********************************************************************
-
-
-;;; The version must be 3.1 or greater for this version of ispell.el
-;;; There is an incompatibility between version 3.1.12 and lower versions.
-(defconst ispell-required-version '("3.1." 12)
-  "Ispell versions with which this version of ispell.el is known to work.")
-(defvar ispell-offset 1
-  "Offset that maps protocol differences between ispell 3.1 versions.")
-
-(defun ispell-get-casechars ()
-  (nth 1 (assoc ispell-dictionary ispell-dictionary-alist)))
-(defun ispell-get-not-casechars ()
-  (nth 2 (assoc ispell-dictionary ispell-dictionary-alist)))
-(defun ispell-get-otherchars ()
-  (nth 3 (assoc ispell-dictionary ispell-dictionary-alist)))
-(defun ispell-get-many-otherchars-p ()
-  (nth 4 (assoc ispell-dictionary ispell-dictionary-alist)))
-(defun ispell-get-ispell-args ()
-  (nth 5 (assoc ispell-dictionary ispell-dictionary-alist)))
-(defun ispell-get-extended-character-mode ()
-  (nth 6 (assoc ispell-dictionary ispell-dictionary-alist)))
-
-(defvar ispell-process nil
-  "The process object for Ispell.")
-
-(defvar ispell-pdict-modified-p nil
-  "Non-nil means personal dictionary has modifications to be saved.")
-
-;;; If you want to save the dictionary when quitting, must do so explicitly.
-;;; When non-nil, the spell session is terminated.
-;;; When numeric, contains cursor location in buffer, and cursor remains there.
-(defvar ispell-quit nil)
-
-(defvar ispell-filter nil
-  "Output filter from piped calls to Ispell.")
-
-(defvar ispell-filter-continue nil
-  "Control variable for Ispell filter function.")
-
-(defvar ispell-process-directory nil
-  "The directory where `ispell-process' was started.")
-
-(defvar ispell-query-replace-marker (make-marker)
-  "Marker for `query-replace' processing.")
-
-(defvar ispell-checking-message nil
-  "Non-nil when we're checking a mail message")
-
-(defconst ispell-choices-buffer "*Choices*")
-
-(defvar ispell-overlay nil "Overlay variable for Ispell highlighting.")
-
-;;; *** Buffer Local Definitions ***
-
-;;; This is the local dictionary to use.  When nil the default dictionary will
-;;; be used.  Do not redefine default value or it will override the global!
-(defvar ispell-local-dictionary nil
-  "If non-nil, a dictionary to use for Ispell commands in this buffer.
-The value must be a string dictionary name in `ispell-dictionary-alist'.
-This variable becomes buffer-local when set in any fashion.
-
-Setting ispell-local-dictionary to a value has the same effect as
-calling \\[ispell-change-dictionary] with that value.  This variable
-is automatically set when defined in the file with either
-`ispell-dictionary-keyword' or the Local Variable syntax.")
-
-(make-variable-buffer-local 'ispell-local-dictionary)
-
-;; Use default directory, unless locally set.
-(set-default 'ispell-local-dictionary nil)
-
-(defconst ispell-words-keyword "LocalWords: "				      
-  "The keyword for local oddly-spelled words to accept.
-The keyword will be followed by any number of local word spellings.
-There can be multiple of these keywords in the file.")
-
-(defconst ispell-dictionary-keyword "Local IspellDict: "
-  "The keyword for local dictionary definitions.
-There should be only one dictionary keyword definition per file, and it
-should be followed by a correct dictionary name in `ispell-dictionary-alist'.")
-
-(defconst ispell-parsing-keyword "Local IspellParsing: "
-  "The keyword for overriding default Ispell parsing.
-Determined by the buffer's major mode and extended-character mode as well as
-the default dictionary.
-
-The above keyword string should be followed by `latex-mode' or
-`nroff-mode' to put the current buffer into the desired parsing mode.
-
-Extended character mode can be changed for this buffer by placing
-a `~' followed by an extended-character mode -- such as `~.tex'.")
-
-(defvar ispell-skip-sgml nil
-  "Skips spell checking of SGML tags and entity references when non-nil.
-This variable is set when major-mode is sgml-mode or html-mode.")
-
-(defvar ispell-local-pdict ispell-personal-dictionary
-  "A buffer local variable containing the current personal dictionary.
-If non-nil, the value must be a string, which is a file name.
-
-If you specify a personal dictionary for the current buffer which is
-different from the current personal dictionary, the effect is similar
-to calling \\[ispell-change-dictionary].  This variable is automatically
-set when defined in the file with either `ispell-pdict-keyword' or the
-local variable syntax.")
-
-(make-variable-buffer-local 'ispell-local-pdict)
-
-(defconst ispell-pdict-keyword "Local IspellPersDict: "
-  "The keyword for defining buffer local dictionaries.")
-
-(defvar ispell-buffer-local-name nil
-  "Contains the buffer name if local word definitions were used.
-Ispell is then restarted because the local words could conflict.")
-
-(defvar ispell-parser 'use-mode-name
-   "*Indicates whether ispell should parse the current buffer as TeX Code.
-Special value `use-mode-name' tries to guess using the name of major-mode.
-Default parser is 'nroff.
-Currently the only other valid parser is 'tex.
-
-You can set this variable in hooks in your init file -- eg:
-
-(add-hook 'tex-mode-hook (function (lambda () (setq ispell-parser 'tex))))")
-
-(defvar ispell-region-end (make-marker)
-  "Marker that allows spelling continuations.")
-
-(defvar ispell-check-only nil
-  "If non-nil, `ispell-word' does not try to correct the word.")
-
-
-;;; **********************************************************************
-;;; **********************************************************************
-
-
-(and (string-lessp "19" emacs-version)
-     (not (boundp 'epoch::version))
-     (defalias 'ispell 'ispell-buffer))
-
-;;;###autoload
-(define-key global-map "\M-$" 'ispell-word)
-
-;;;###autoload
-(defun ispell-word (&optional following quietly continue)
-  "Check spelling of word under or before the cursor.
-If the word is not found in dictionary, display possible corrections
-in a window allowing you to choose one.
-
-With a prefix argument (or if CONTINUE is non-nil),
-resume interrupted spell-checking of a buffer or region.
-
-If optional argument FOLLOWING is non-nil or if `ispell-following-word'
-is non-nil when called interactively, then the following word
-\(rather than preceding\) is checked when the cursor is not over a word.
-When the optional argument QUIETLY is non-nil or `ispell-quietly' is non-nil
-when called interactively, non-corrective messages are suppressed.
-
-Word syntax described by `ispell-dictionary-alist' (which see).
-
-This will check or reload the dictionary.  Use \\[ispell-change-dictionary]
-or \\[ispell-region] to update the Ispell process."
-  (interactive (list nil nil current-prefix-arg))
-  (if continue
-      (ispell-continue)
-    (if (interactive-p)
-	(setq following ispell-following-word
-	      quietly ispell-quietly))
-    (ispell-accept-buffer-local-defs)	; use the correct dictionary
-    (let ((cursor-location (point))	; retain cursor location
-	  (word (ispell-get-word following))
-	  start end poss replace)
-      ;; destructure return word info list.
-      (setq start (car (cdr word))
-	    end (car (cdr (cdr word)))
-	    word (car word))
-
-      ;; now check spelling of word.
-      (or quietly
-	  (message "Checking spelling of %s..."
-		   (funcall ispell-format-word word)))
-      (process-send-string ispell-process "%\n") ;put in verbose mode
-      (process-send-string ispell-process (concat "^" word "\n"))
-      ;; wait until ispell has processed word
-      (while (progn
-	       (accept-process-output ispell-process)
-	       (not (string= "" (car ispell-filter)))))
-      ;;(process-send-string ispell-process "!\n") ;back to terse mode.
-      (setq ispell-filter (cdr ispell-filter))
-      (if (listp ispell-filter)
-	  (setq poss (ispell-parse-output (car ispell-filter))))
-      (cond ((eq poss t)
-	     (or quietly
-		 (message "%s is correct" (funcall ispell-format-word word))))
-	    ((stringp poss)
-	     (or quietly
-		 (message "%s is correct because of root %s"
-			  (funcall ispell-format-word word)
-			  (funcall ispell-format-word poss))))
-	    ((null poss) (message "Error in ispell process"))
-	    (ispell-check-only		; called from ispell minor mode.
-	     (beep))
-	    (t				; prompt for correct word.
-	     (save-window-excursion
-	       (setq replace (ispell-command-loop
-			      (car (cdr (cdr poss)))
-			      (car (cdr (cdr (cdr poss))))
-			      (car poss) start end)))
-	     (cond ((equal 0 replace)
-		    (ispell-add-per-file-word-list (car poss)))
-		   (replace
-		    (setq word (if (atom replace) replace (car replace))
-			  cursor-location (+ (- (length word) (- end start))
-					     cursor-location))
-		    (if (not (equal word (car poss)))
-			(progn
-			  (delete-region start end)
-			  (insert word)))
-		    (if (not (atom replace)) ; recheck spelling of replacement
-			(progn
-			  (goto-char cursor-location)
-			  (ispell-word following quietly)))))
-	     (if (get-buffer ispell-choices-buffer)
-		 (kill-buffer ispell-choices-buffer))))
-      (goto-char cursor-location)	; return to original location
-      (ispell-pdict-save ispell-silently-savep)
-      (if ispell-quit (setq ispell-quit nil)))))
-
-
-(defun ispell-get-word (following &optional extra-otherchars)
-  "Return the word for spell-checking according to ispell syntax.
-If optional argument FOLLOWING is non-nil or if `ispell-following-word'
-is non-nil when called interactively, then the following word
-\(rather than preceding\) is checked when the cursor is not over a word.
-Optional second argument contains otherchars that can be included in word
-many times.
-
-Word syntax described by `ispell-dictionary-alist' (which see)."
-  (let* ((ispell-casechars (ispell-get-casechars))
-	 (ispell-not-casechars (ispell-get-not-casechars))
-	 (ispell-otherchars (ispell-get-otherchars))
-	 (ispell-many-otherchars-p (ispell-get-many-otherchars-p))
-	 (word-regexp (concat ispell-casechars
-			      "+\\("
-			      ispell-otherchars
-			      "?"
-			      (if extra-otherchars
-				  (concat extra-otherchars "?"))
-			      ispell-casechars
-			      "+\\)"
-			      (if (or ispell-many-otherchars-p
-				      extra-otherchars)
-				  "*" "?")))
-	 did-it-once
-	 start end word)
-    ;; find the word
-    (if (not (looking-at ispell-casechars))
-	(if following
-	    (re-search-forward ispell-casechars (point-max) t)
-	  (re-search-backward ispell-casechars (point-min) t)))
-    ;; move to front of word
-    (re-search-backward ispell-not-casechars (point-min) 'start)
-    (while (and (or (looking-at ispell-otherchars)
-		    (and extra-otherchars (looking-at extra-otherchars)))
-		(not (bobp))
-		(or (not did-it-once)
-		    ispell-many-otherchars-p))
-      (if (and extra-otherchars (looking-at extra-otherchars))
-	  (progn
-	    (backward-char 1)
-	    (if (looking-at ispell-casechars)
-		(re-search-backward ispell-not-casechars (point-min) 'move)))
-	(setq did-it-once t)
-	(backward-char 1)
-	(if (looking-at ispell-casechars)
-	    (re-search-backward ispell-not-casechars (point-min) 'move)
-	  (backward-char -1))))
-    ;; Now mark the word and save to string.
-    (or (re-search-forward word-regexp (point-max) t)
-	(error "No word found to check!"))
-    (setq start (match-beginning 0)
-	  end (point)
-	  word (buffer-substring start end))
-    (list word start end)))
-
-
-;;; Global ispell-pdict-modified-p is set by ispell-command-loop and
-;;; tracks changes in the dictionary.  The global may either be
-;;; a value or a list, whose value is the state of whether the
-;;; dictionary needs to be saved.
-
-(defun ispell-pdict-save (&optional no-query force-save)
-  "Check to see if the personal dictionary has been modified.
-If so, ask if it needs to be saved."
-  (interactive (list ispell-silently-savep t))
-  (if (and ispell-pdict-modified-p (listp ispell-pdict-modified-p))
-      (setq ispell-pdict-modified-p (car ispell-pdict-modified-p)))
-  (if (or ispell-pdict-modified-p force-save)
-      (if (or no-query (y-or-n-p "Personal dictionary modified.  Save? "))
-	  (progn
-	    (process-send-string ispell-process "#\n")
-	    (message "Personal dictionary saved."))))
-  ;; unassert variable, even if not saved to avoid questioning.
-  (setq ispell-pdict-modified-p nil))
-
-
-(defun ispell-command-loop (miss guess word start end)
-  "Display possible corrections from list MISS.
-GUESS lists possibly valid affix construction of WORD.
-Returns nil to keep word.
-Returns 0 to insert locally into buffer-local dictionary.
-Returns string for new chosen word.
-Returns list for new replacement word (will be rechecked).
-Highlights the word, which is assumed to run from START to END.
-Global `ispell-pdict-modified-p' becomes a list where the only value
-indicates whether the dictionary has been modified when option `a' or `i' is
-used."
-  (let ((textbuf (current-buffer))
-	(count ?0)
-	(line 2)
-	(max-lines (- (window-height) 4)) ; assure 4 context lines.
-	(choices miss)
-	(window-min-height (min window-min-height
-				ispell-choices-win-default-height))
-	(command-characters '( ?  ?i ?a ?A ?r ?R ?? ?x ?X ?q ?l ?u ?m ))
-	(skipped 0)
-	char num result textwin highlighted)
-
-    ;; setup the *Choices* buffer with valid data.
-    (save-excursion
-      (set-buffer (get-buffer-create ispell-choices-buffer))
-      (setq mode-line-format (concat "--  %b  --  word: " word))
-      (erase-buffer)
-      (if guess
-	  (progn
-	    (insert "Affix rules generate and capitalize "
-		    "this word as shown below:\n\t")
-	    (while guess
-	      (if (> (+ 4 (current-column) (length (car guess)))
-		     (window-width))
-		  (progn
-		    (insert "\n\t")
-		    (setq line (1+ line))))
-	      (insert (car guess) "    ")
-	      (setq guess (cdr guess)))
-	    (insert "\nUse option `i' if this is a correct composition"
-		    " from the derivative root.\n")
-	    (setq line (+ line (if choices 3 2)))))
-      (while (and choices
-		  (< (if (> (+ 7 (current-column) (length (car choices))
-			       (if (> count ?~) 3 0))
-			    (window-width))
-			 (progn
-			   (insert "\n")
-			   (setq line (1+ line)))
-		       line)
-		     max-lines))
-	;; not so good if there are over 20 or 30 options, but then, if
-	;; there are that many you don't want to scan them all anyway...
-	(while (memq count command-characters) ; skip command characters.
-	  (setq count (1+ count)
-		skipped (1+ skipped)))
-	(insert "(" count ") " (car choices) "  ")
-	(setq choices (cdr choices)
-	      count (1+ count)))
-      (setq count (- count ?0 skipped)))
-
-    ;; Assure word is visible
-    (if (not (pos-visible-in-window-p end))
-	(sit-for 0))
-    ;; Display choices for misspelled word.
-    (let ((choices-window (get-buffer-window ispell-choices-buffer)))
-      (if choices-window
-	  (if (= line (window-height choices-window))
-	      (select-window choices-window)
-	    ;; *Choices* window changed size.  Adjust the choices window
-	    ;; without scrolling the spelled window when possible
-	    (let ((window-line (- line (window-height choices-window)))
-		  (visible (progn (forward-line -1) (point))))
-	      (if (< line ispell-choices-win-default-height)
-		  (setq window-line (+ window-line
-				       (- ispell-choices-win-default-height
-					  line))))
-	      (move-to-window-line 0)
-	      (forward-line window-line)
-	      (set-window-start (selected-window)
-				(if (> (point) visible) visible (point)))
-	      (goto-char end)
-	      (select-window (previous-window)) ; *Choices* window
-	      (enlarge-window window-line)))
-	;; Overlay *Choices* window when it isn't showing
-	(ispell-overlay-window (max line ispell-choices-win-default-height)))
-      (switch-to-buffer ispell-choices-buffer)
-      (goto-char (point-min)))
-
-    (select-window (setq textwin (next-window)))
-
-    ;; highlight word, protecting current buffer status
-    (unwind-protect
-	(progn
-	  (if ispell-highlight-p
-	      (ispell-highlight-spelling-error start end t))
-	  ;; Loop until a valid choice is made.
-	  (while
-	      (eq
-	       t
-	       (setq
-		result
-		(progn
-		  (undo-boundary)
-		  (message (concat "C-h or ? for more options; SPC to leave "
-				   "unchanged, Character to replace word"))
-		  (let ((inhibit-quit t))
-		    (setq char (if (fboundp 'read-char-exclusive)
-				   (read-char-exclusive)
-				 (read-char))
-			  skipped 0)
-		    (if (or quit-flag (= char ?\C-g)) ; C-g is like typing X
-			(setq char ?X
-			      quit-flag nil)))
-		  ;; Adjust num to array offset skipping command characters.
-		  (let ((com-chars command-characters))
-		    (while com-chars
-		      (if (and (> (car com-chars) ?0) (< (car com-chars) char))
-			  (setq skipped (1+ skipped)))
-		      (setq com-chars (cdr com-chars)))
-		    (setq num (- char ?0 skipped)))
-
-		  (cond
-		   ((= char ? ) nil)	; accept word this time only
-		   ((= char ?i)		; accept and insert word into pers dict
-		    (process-send-string ispell-process (concat "*" word "\n"))
-		    (setq ispell-pdict-modified-p '(t)) ; dictionary modified!
-		    nil)
-		   ((or (= char ?a) (= char ?A)) ; accept word without insert
-		    (process-send-string ispell-process (concat "@" word "\n"))
-		    (if (null ispell-pdict-modified-p)
-			(setq ispell-pdict-modified-p
-			      (list ispell-pdict-modified-p)))
-		    (if (= char ?A) 0))	; return 0 for ispell-add buffer-local
-		   ((or (= char ?r) (= char ?R)) ; type in replacement
-		    (if (or (= char ?R) ispell-query-replace-choices)
-			(list (read-string "Query-replacement for: " word) t)
-		      (cons (read-string "Replacement for: " word) nil)))
-		   ((or (= char ??) (= char help-char) (= char ?\C-h))
-		    (ispell-help)
-		    t)
-		   ;; Quit and move point back.
-		   ((= char ?x)
-		    (ispell-pdict-save ispell-silently-savep)
-		    (message "Exited spell-checking")
-		    (setq ispell-quit t)
-		    nil)
-		   ;; Quit and preserve point.
-		   ((= char ?X)
-		    (ispell-pdict-save ispell-silently-savep)
-		    (message "%s"
-		     (substitute-command-keys
-		      (concat "Spell-checking suspended;"
-			      " use C-u \\[ispell-word] to resume")))
-		    (setq ispell-quit (max (point-min)
-					   (- (point) (length word))))
-		    nil)
-		   ((= char ?q)
-		    (if (y-or-n-p "Really kill Ispell process? ")
-			(progn
-			  (ispell-kill-ispell t) ; terminate process.
-			  (setq ispell-quit (or (not ispell-checking-message)
-						(point))
-				ispell-pdict-modified-p nil))
-		      t))		; continue if they don't quit.
-		   ((= char ?l)
-		    (let ((new-word (read-string
-				     "Lookup string (`*' is wildcard): "
-				     word))
-			  (new-line 2))
-		      (if new-word
-			  (progn
-			    (save-excursion
-			      (set-buffer (get-buffer-create
-					   ispell-choices-buffer))
-			      (erase-buffer)
-			      (setq count ?0
-				    skipped 0
-				    mode-line-format (concat
-						      "--  %b  --  word: "
-						      new-word)
-				    miss (lookup-words new-word)
-				    choices miss)
-			      (while (and choices ; adjust choices window.
-					  (< (if (> (+ 7 (current-column)
-						       (length (car choices))
-						       (if (> count ?~) 3 0))
-						    (window-width))
-						 (progn
-						   (insert "\n")
-						   (setq new-line
-							 (1+ new-line)))
-					       new-line)
-					     max-lines))
-				(while (memq count command-characters)
-				  (setq count (1+ count)
-					skipped (1+ skipped)))
-				(insert "(" count ") " (car choices) "  ")
-				(setq choices (cdr choices)
-				      count (1+ count)))
-			      (setq count (- count ?0 skipped)))
-			    (select-window (previous-window))
-			    (if (and (/= new-line line)
-				     (> (max line new-line)
-					ispell-choices-win-default-height))
-				(let* ((minh ispell-choices-win-default-height)
-				       (gr-bl (if (< line minh) ; blanks
-						  (- minh line)
-						0))
-				       (shr-bl (if (< new-line minh) ; blanks
-						   (- minh new-line)
-						 0)))
-				  (if (> new-line line)
-				      (enlarge-window (- new-line line gr-bl))
-				    (shrink-window (- line new-line shr-bl)))
-				  (setq line new-line)))
-			    (select-window (next-window)))))
-		    t)			; reselect from new choices
-		   ((= char ?u)
-		    (process-send-string ispell-process
-					 (concat "*" (downcase word) "\n"))
-		    (setq ispell-pdict-modified-p '(t)) ; dictionary modified!
-		    nil)
-		   ((= char ?m)		; type in what to insert
-		    (process-send-string
-		     ispell-process (concat "*" (read-string "Insert: " word)
-					    "\n"))
-		    (setq ispell-pdict-modified-p '(t))
-		    (cons word nil))
-		   ((and (>= num 0) (< num count))
-		    (if ispell-query-replace-choices ; Query replace flag
-			(list (nth num miss) 'query-replace)
-		      (nth num miss)))
-		   ((= char ?\C-l)
-		    (redraw-display) t)
-		   ((= char ?\C-r)
-		    (save-window-excursion (recursive-edit)) t)
-		   ((= char ?\C-z)
-		    (funcall (key-binding "\C-z"))
-		    t)
-		   (t (ding) t))))))
-	  result)
-      ;; protected
-      (if ispell-highlight-p		; unhighlight
-	  (save-window-excursion
-	    (select-window textwin)
-	    (ispell-highlight-spelling-error start end))))))
-
-
-;;;###autoload
-(defun ispell-help ()
-  "Display a list of the options available when a misspelling is encountered.
-
-Selections are:
-
-DIGIT: Replace the word with a digit offered in the *Choices* buffer.
-SPC:   Accept word this time.
-`i':   Accept word and insert into private dictionary.
-`a':   Accept word for this session.
-`A':   Accept word and place in `buffer-local dictionary'.
-`r':   Replace word with typed-in value.  Rechecked.
-`R':   Replace word with typed-in value. Query-replaced in buffer. Rechecked.
-`?':   Show these commands.
-`x':   Exit spelling buffer.  Move cursor to original point.
-`X':   Exit spelling buffer.  Leaves cursor at the current point, and permits
-        the aborted check to be completed later.
-`q':   Quit spelling session (Kills ispell process).
-`l':   Look up typed-in replacement in alternate dictionary.  Wildcards okay.
-`u':   Like `i', but the word is lower-cased first.
-`m':   Like `i', but allows one to include dictionary completion information.
-`C-l':  redraws screen
-`C-r':  recursive edit
-`C-z':  suspend emacs or iconify frame"
-
-  (let ((help-1 (concat "[r/R]eplace word; [a/A]ccept for this session; "
-			"[i]nsert into private dictionary"))
-	(help-2 (concat "[l]ook a word up in alternate dictionary;  "
-			"e[x/X]it;  [q]uit session"))
-	(help-3 (concat "[u]ncapitalized insert into dictionary.  "
-			"Type 'C-h d ispell-help' for more help")))
-    (save-window-excursion
-      (if ispell-help-in-bufferp
-	  (progn
-	    (ispell-overlay-window 4)
-	    (switch-to-buffer (get-buffer-create "*Ispell Help*"))
-	    (insert (concat help-1 "\n" help-2 "\n" help-3))
-	    (sit-for 5)
-	    (kill-buffer "*Ispell Help*"))
-	(select-window (minibuffer-window))
-	;;(enlarge-window 2)
-	(erase-buffer)
-	(cond ((string-match "Lucid" emacs-version)
-	       (message help-3)
-	       (enlarge-window 1)
-	       (message help-2)
-	       (enlarge-window 1)
-	       (message help-1)
-	       (goto-char (point-min)))
-	      (t
-	       (if (string-lessp "19" emacs-version)
-		   (message nil))
-	       (enlarge-window 2)
-	       ;; Make sure we display the minibuffer
-	       ;; in this window, not some other.
-	       (set-minibuffer-window (selected-window))
-	       (insert (concat help-1 "\n" help-2 "\n" help-3))))
-	(sit-for 5)
-	(erase-buffer)))))
-
-
-(defun lookup-words (word &optional lookup-dict)
-  "Look up word in word-list dictionary.
-A `*' serves as a wild card.  If no wild cards, `look' is used if it exists.
-Otherwise the variable `ispell-grep-command' contains the command used to
-search for the words (usually egrep).
-
-Optional second argument contains the dictionary to use; the default is
-`ispell-alternate-dictionary'."
-  ;; We don't use the filter for this function, rather the result is written
-  ;; into a buffer.  Hence there is no need to save the filter values.
-  (if (null lookup-dict)
-      (setq lookup-dict ispell-alternate-dictionary))
-
-  (let* ((process-connection-type ispell-use-ptys-p)
-	 (wild-p (string-match "\\*" word))
-	 (look-p (and ispell-look-p	; Only use look for an exact match.
-		      (or ispell-have-new-look (not wild-p))))
-	 (ispell-grep-buffer (get-buffer-create "*Ispell-Temp*")) ; result buf
-	 (prog (if look-p ispell-look-command ispell-grep-command))
-	 (args (if look-p ispell-look-options ispell-grep-options))
-	 status results loc)
-    (unwind-protect
-	(save-window-excursion
-	  (message "Starting \"%s\" process..." (file-name-nondirectory prog))
-	  (set-buffer ispell-grep-buffer)
-	  (if look-p
-	      nil
-	    ;; convert * to .*
-	    (insert "^" word "$")
-	    (while (search-backward "*" nil t) (insert "."))
-	    (setq word (buffer-string))
-	    (erase-buffer))
-	  (setq status (call-process prog nil t nil args word lookup-dict))
-	  ;; grep returns status 1 and no output when word not found, which
-	  ;; is a perfectly normal thing.
-	  (if (stringp status)
-	      (setq results (cons (format "error: %s exited with signal %s"
-					  (file-name-nondirectory prog) status)
-				  results))
-	    ;; else collect words into `results' in FIFO order
-	    (goto-char (point-max))
-	    ;; assure we've ended with \n
-	    (or (bobp) (= (preceding-char) ?\n) (insert ?\n))
-	    (while (not (bobp))
-	      (setq loc (point))
-	      (forward-line -1)
-	      (setq results (cons (buffer-substring (point) (1- loc))
-				  results)))))
-      ;; protected
-      (kill-buffer ispell-grep-buffer)
-      (if (and results (string-match ".+: " (car results)))
-	  (error "%s error: %s" ispell-grep-command (car results))))
-    results))
-
-
-;;; "ispell-filter" is a list of output lines from the generating function.
-;;;   Each full line (ending with \n) is a separate item on the list.
-;;; "output" can contain multiple lines, part of a line, or both.
-;;; "start" and "end" are used to keep bounds on lines when "output" contains
-;;;   multiple lines.
-;;; "ispell-filter-continue" is true when we have received only part of a
-;;;   line as output from a generating function ("output" did not end with \n)
-;;; THIS FUNCTION WILL FAIL IF THE PROCESS OUTPUT DOESN'T END WITH \n!
-;;;   This is the case when a process dies or fails. The default behavior
-;;;   in this case treats the next input received as fresh input.
-
-(defun ispell-filter (process output)
-  "Output filter function for ispell, grep, and look."
-  (let ((start 0)
-	(continue t)
-	end)
-    (while continue
-      (setq end (string-match "\n" output start)) ; get text up to the newline.
-      ;; If we get out of sync and ispell-filter-continue is asserted when we
-      ;; are not continuing, treat the next item as a separate list.  When
-      ;; ispell-filter-continue is asserted, ispell-filter *should* always be a
-      ;; list!
-
-      ;; Continue with same line (item)?
-      (if (and ispell-filter-continue ispell-filter (listp ispell-filter))
-	  ;; Yes.  Add it to the prev item
-	  (setcar ispell-filter
-		  (concat (car ispell-filter) (substring output start end)))
-	;; No. This is a new line and item.
-	(setq ispell-filter
-	      (cons (substring output start end) ispell-filter)))
-      (if (null end)
-	  ;; We've completed reading the output, but didn't finish the line.
-	  (setq ispell-filter-continue t continue nil)
-	;; skip over newline, this line complete.
-	(setq ispell-filter-continue nil end (1+ end))
-	(if (= end (length output))	; No more lines in output
-	    (setq continue nil)		;  so we can exit the filter.
-	  (setq start end))))))		; else move start to next line of input
-
-
-;;; This function destroys the mark location if it is in the word being
-;;; highlighted.
-(defun ispell-highlight-spelling-error-generic (start end &optional highlight)
-  "Highlight the word from START to END with a kludge using `inverse-video'.
-When the optional third arg HIGHLIGHT is set, the word is highlighted;
-otherwise it is displayed normally."
-  (let ((modified (buffer-modified-p))	; don't allow this fn to modify buffer
-	(buffer-read-only nil)		; Allow highlighting read-only buffers.
-	(text (buffer-substring start end)) ; Save highlight region
-	(inhibit-quit t)		; inhibit interrupt processing here.
-	(buffer-undo-list t))		; don't clutter the undo list.
-    (delete-region start end)
-    (insert-char ?  (- end start))	; minimize amount of redisplay
-    (sit-for 0)				; update display
-    (if highlight (setq inverse-video (not inverse-video))) ; toggle video
-    (delete-region start end)		; delete whitespace
-    (insert text)			; insert text in inverse video.
-    (sit-for 0)				; update display showing inverse video.
-    (if highlight (setq inverse-video (not inverse-video))) ; toggle video
-    (set-buffer-modified-p modified)))	; don't modify if flag not set.
-
-
-(defun ispell-highlight-spelling-error-lucid (start end &optional highlight)
-  "Highlight the word from START to END using `isearch-highlight'.
-When the optional third arg HIGHLIGHT is set, the word is highlighted,
-otherwise it is displayed normally."
-  (if highlight
-      (isearch-highlight start end)
-    (isearch-dehighlight t))
-  ;;(sit-for 0)
-  )
-
-
-(defun ispell-highlight-spelling-error-overlay (start end &optional highlight)
-  "Highlight the word from START to END using overlays.
-When the optional third arg HIGHLIGHT is set, the word is highlighted
-otherwise it is displayed normally.
-
-The variable `ispell-highlight-face' selects the face to use for highlighting."
-  (if highlight
-      (progn
-	(setq ispell-overlay (make-overlay start end))
-	(overlay-put ispell-overlay 'face ispell-highlight-face))
-    (delete-overlay ispell-overlay)))
-
-
-(defun ispell-highlight-spelling-error (start end &optional highlight)
-  (cond
-   ((string-match "Lucid" emacs-version)
-    (ispell-highlight-spelling-error-lucid start end highlight))
-   ((and (string-lessp "19" emacs-version)
-	 (featurep 'faces) window-system)
-    (ispell-highlight-spelling-error-overlay start end highlight))
-   (t (ispell-highlight-spelling-error-generic start end highlight))))
-
-
-(defun ispell-overlay-window (height)
-  "Create a window covering the top HEIGHT lines of the current window.
-Ensure that the line above point is still visible but otherwise avoid
-scrolling the current window.  Leave the new window selected."
-  (save-excursion
-    (let ((oldot (save-excursion (forward-line -1) (point)))
-	  (top (save-excursion (move-to-window-line height) (point))))
-      ;; If line above old point (line starting at olddot) would be
-      ;; hidden by new window, scroll it to just below new win
-      ;; otherwise set top line of other win so it doesn't scroll.
-      (if (< oldot top) (setq top oldot))
-      ;; NB: Lemacs 19.9 bug: If a window of size N (N includes the mode
-      ;; line) is demanded, the last line is not visible.
-      ;; At least this happens on AIX 3.2, lemacs w/ Motif, font 9x15.
-      ;; So we increment the height for this case.
-      (if (string-match "19\.9.*Lucid" (emacs-version))
-	  (setq height (1+ height)))
-      (split-window nil height)
-      (set-window-start (next-window) top))))
-
-
-;;; Should we add a compound word match return value?
-(defun ispell-parse-output (output)
-  "Parse the OUTPUT string from Ispell and return:
-1: t for an exact match.
-2: A string containing the root word for a match via suffix removal.
-3: A list of possible correct spellings of the format:
-   '(\"ORIGINAL-WORD\" OFFSET MISS-LIST GUESS-LIST)
-   ORIGINAL-WORD is a string of the possibly misspelled word.
-   OFFSET is an integer giving the line offset of the word.
-   MISS-LIST and GUESS-LIST are possibly null lists of guesses and misses."
-  (cond
-   ((string= output "") t)		; for startup with pipes...
-   ((string= output "*") t)		; exact match
-   ((string= output "-") t)             ; compound word match
-   ((string= (substring output 0 1) "+") ; found cuz of root word
-    (substring output 2))		; return root word
-   (t					; need to process &, ?, and #'s
-    (let ((type (substring output 0 1))	; &, ?, or #
-	  (original-word (substring output 2 (string-match " " output 2)))
-	  (cur-count 0)			; contains number of misses + guesses
-	  count miss-list guess-list offset)
-      (setq output (substring output (match-end 0))) ; skip over misspelling
-      (if (string= type "#")
-	  (setq count 0)		; no misses for type #
-	(setq count (string-to-int output) ; get number of misses.
-	      output (substring output (1+ (string-match " " output 1)))))
-      (setq offset (string-to-int output))
-      (if (string= type "#")		; No miss or guess list.
-	  (setq output nil)
-	(setq output (substring output (1+ (string-match " " output 1)))))
-      (while output
-	(let ((end (string-match ", \\|\\($\\)" output))) ; end of miss/guess.
-	  (setq cur-count (1+ cur-count))
-	  (if (> cur-count count)
-	      (setq guess-list (cons (substring output 0 end) guess-list))
-	    (setq miss-list (cons (substring output 0 end) miss-list)))
-	  (if (match-end 1)		; True only when at end of line.
-	      (setq output nil)		; no more misses or guesses
-	    (setq output (substring output (+ end 2))))))
-      (list original-word offset miss-list guess-list)))))
-
-
-(defun check-ispell-version ()
-  ;; This is a little wasteful as we actually launch ispell twice: once
-  ;; to make sure it's the right version, and once for real.  But people
-  ;; get confused by version mismatches *all* the time (and I've got the
-  ;; email to prove it) so I think this is worthwhile.  And the -v[ersion]
-  ;; option is the only way I can think of to do this that works with
-  ;; all versions, since versions earlier than 3.0.09 didn't identify
-  ;; themselves on startup.
-  (save-excursion
-    (let ((case-fold-search t)
-	  ;; avoid bugs when syntax of `.' changes in various default modes
-	  (default-major-mode 'fundamental-mode)
-	  status)
-      (set-buffer (get-buffer-create " *ispell-tmp*"))
-      (erase-buffer)
-      (setq status (call-process ispell-program-name nil t nil "-v"))
-      (goto-char (point-min))
-      (if (not (memq status '(0 nil)))
-	  (error "%s exited with %s %s" ispell-program-name
-		 (if (stringp status) "signal" "code") status))
-      (if (not (re-search-forward
-		(concat "\\b\\("
-			(regexp-quote (car ispell-required-version))
-			"\\)\\([0-9]*\\)\\b")
-		nil t))
-	  (error
-	   "%s version %s* is required: try renaming ispell4.el to ispell.el"
-	   ispell-program-name (car ispell-required-version))
-	;; check that it is the correct version.
-	(if (< (car (read-from-string (buffer-substring
-				       (match-beginning 2) (match-end 2))))
-	       (car (cdr ispell-required-version)))
-	    (setq ispell-offset 0)))
-      (kill-buffer (current-buffer)))))
-
-
-(defun ispell-init-process ()
-  "Check status of Ispell process and start if necessary."
-  (if (and ispell-process
-	   (eq (process-status ispell-process) 'run)
-	   ;; If we're using a personal dictionary, assure
-	   ;; we're in the same default directory!
-	   (or (not ispell-personal-dictionary)
-	       (equal ispell-process-directory default-directory)))
-      (setq ispell-filter nil ispell-filter-continue nil)
-    ;; may need to restart to select new personal dictionary.
-    (ispell-kill-ispell t)
-    (message "Starting new Ispell process...")
-    (sit-for 0)
-    (check-ispell-version)
-    (setq ispell-process
-	  (let ((process-connection-type ispell-use-ptys-p))
-	    (apply 'start-process
-		   "ispell" nil ispell-program-name
-		   "-a"			; accept single input lines
-		   "-m"			; make root/affix combos not in dict
-		   (let (args)
-		     ;; Local dictionary becomes the global dictionary in use.
-		     (if ispell-local-dictionary
-			 (setq ispell-dictionary ispell-local-dictionary))
-		     (setq args (ispell-get-ispell-args))
-		     (if ispell-dictionary ; use specified dictionary
-			 (setq args
-			       (append (list "-d" ispell-dictionary) args)))
-		     (if ispell-personal-dictionary ; use specified pers dict
-			 (setq args
-			       (append args
-				       (list "-p"
-					     (expand-file-name
-					      ispell-personal-dictionary)))))
-		     (setq args (append args ispell-extra-args))
-		     args)))
-	  ispell-filter nil
-	  ispell-filter-continue nil
-	  ispell-process-directory default-directory)
-    (set-process-filter ispell-process 'ispell-filter)
-    (accept-process-output ispell-process) ; Get version ID line
-    (cond ((null ispell-filter)
-	   (error "%s did not output version line" ispell-program-name))
-	  ((and
-	    (stringp (car ispell-filter))
-	    (if (string-match "warning: " (car ispell-filter))
-		(progn
-		  (accept-process-output ispell-process 5) ; 1st was warn msg.
-		  (stringp (car ispell-filter)))
-	      (null (cdr ispell-filter)))
-	    (string-match "^@(#) " (car ispell-filter)))
-	   ;; got the version line as expected (we already know it's the right
-	   ;; version, so don't bother checking again.)
-	   nil)
-	  (t
-	   ;; Otherwise, it must be an error message.  Show the user.
-	   ;; But first wait to see if some more output is going to arrive.
-	   ;; Otherwise we get cool errors like "Can't open ".
-	   (sleep-for 1)
-	   (accept-process-output)
-	   (error "%s" (mapconcat 'identity ispell-filter "\n"))))
-    (setq ispell-filter nil)		; Discard version ID line
-    (let ((extended-char-mode (ispell-get-extended-character-mode)))
-      (if extended-char-mode
-	  (process-send-string ispell-process
-			       (concat extended-char-mode "\n"))))
-    (process-kill-without-query ispell-process)))
-
-;;;###autoload
-(defun ispell-kill-ispell (&optional no-error)
-  "Kill current Ispell process (so that you may start a fresh one).
-With NO-ERROR, just return non-nil if there was no Ispell running."
-  (interactive)
-  (if (not (and ispell-process
-		(eq (process-status ispell-process) 'run)))
-      (or no-error
-	  (error "There is no ispell process running!"))
-    (kill-process ispell-process)
-    (setq ispell-process nil)
-    (message "Ispell process killed")
-    nil))
-
-
-;;; ispell-change-dictionary is set in some people's hooks.  Maybe this should
-;;;  call ispell-init-process rather than wait for a spell checking command?
-
-;;;###autoload
-(defun ispell-change-dictionary (dict &optional arg)
-  "Change `ispell-dictionary' (q.v.) and kill old Ispell process.
-A new one will be started as soon as necessary.
-
-By just answering RET you can find out what the current dictionary is.
-
-With prefix argument, set the default directory."
-  (interactive
-   (list (completing-read
-	  "Use new dictionary (RET for current, SPC to complete): "
-	  (cons (cons "default" nil) ispell-dictionary-alist) nil t)
-	 current-prefix-arg))
-  (if (equal dict "default") (setq dict nil))
-  ;; This relies on completing-read's bug of returning "" for no match
-  (cond ((equal dict "")
-	 (message "Using %s dictionary"
-		  (or ispell-local-dictionary ispell-dictionary "default")))
-	((and (equal dict ispell-dictionary)
-	      (or (null ispell-local-dictionary)
-		  (equal dict ispell-local-dictionary)))
-	 ;; Specified dictionary is the default already.  No-op
-	 (and (interactive-p)
-	      (message "No change, using %s dictionary" (or dict "default"))))
-	(t				; reset dictionary!
-	 (if (assoc dict ispell-dictionary-alist)
-	     (progn
-	       (if (or arg (null dict))	; set default dictionary
-		   (setq ispell-dictionary dict))
-	       (if (null arg)		; set local dictionary
-		   (setq ispell-local-dictionary dict)))
-	   (error "Illegal dictionary: %s" dict))
-	 (ispell-kill-ispell t)
-	 (message "(Next %sIspell command will use %s dictionary)"
-		  (cond ((equal ispell-local-dictionary ispell-dictionary)
-			 "")
-			(arg "global ")
-			(t "local "))
-		  (or (if (or (equal ispell-local-dictionary ispell-dictionary)
-			      (null arg))
-			  ispell-local-dictionary
-			ispell-dictionary)
-		      "default")))))
-
-
-;;; Spelling of comments are checked when ispell-check-comments is non-nil.
-
-;;;###autoload
-(defun ispell-region (reg-start reg-end)
-  "Interactively check a region for spelling errors."
-  (interactive "r")			; Don't flag errors on read-only bufs.
-  (ispell-accept-buffer-local-defs)	; set up dictionary, local words, etc.
-  (unwind-protect
-      (save-excursion
-	(message "Spell checking %s using %s dictionary..."
-		 (if (and (= reg-start (point-min)) (= reg-end (point-max)))
-		     (buffer-name) "region")
-		 (or ispell-dictionary "default"))
-	;; Returns cursor to original location.
-	(save-window-excursion
-	  (goto-char reg-start)
-	  (let ((transient-mark-mode nil)
-		ref-type)
-	    (while (and (not ispell-quit) (< (point) reg-end))
-	      (let ((start (point))
-		    (offset-change 0)
-		    (end (save-excursion (end-of-line) (min (point) reg-end)))
-		    (ispell-casechars (ispell-get-casechars))
-		    string)
-		(cond			; LOOK AT THIS LINE AND SKIP OR PROCESS
-		 ((eolp)		; END OF LINE, just go to next line.
-		  (forward-char 1))
-		 ((and (null ispell-check-comments) ; SKIPPING COMMENTS
-		       comment-start	; skip comments that start on the line.
-		       (search-forward comment-start end t)) ; or found here.
-		  (if (= (- (point) start) (length comment-start))
-		      ;; comment starts the line.  Skip entire line or region
-		      (if (string= "" comment-end) ; skip to next line
-			  (beginning-of-line 2)	; or jump to comment end.
-			(search-forward comment-end reg-end 'limit))
-		    ;; Comment later in line.  Check spelling before comment.
-		    (let ((limit (- (point) (length comment-start))))
-		      (goto-char (1- limit))
-		      (if (looking-at "\\\\") ; "quoted" comment, don't skip
-			  ;; quoted comment.  Skip over comment-start
-			  (if (= start (1- limit))
-			      (setq limit (+ limit (length comment-start)))
-			    (setq limit (1- limit))))
-		      (goto-char start)
-		      ;; Only check when "casechars" or math before comment
-		      (if (or (re-search-forward ispell-casechars limit t)
-			      (re-search-forward "[][()$]" limit t))
-			  (setq string
-				(concat "^" (buffer-substring start limit)
-					"\n")
-				offset-change (- offset-change ispell-offset)))
-		      (goto-char limit))))
-		 ((looking-at "[---#@*+!%~^]") ; SKIP SPECIAL ISPELL CHARACTERS
-		  (forward-char 1))
-		 ((or (and ispell-skip-tib ; SKIP TIB REFERENCES OR SGML MARKUP
-			   (re-search-forward ispell-tib-ref-beginning end t)
-			   (setq ref-type 'tib))
-		      (and ispell-skip-sgml
-			   (re-search-forward "[<&]" end t)
-			   (setq ref-type 'sgml)))
-		  (if (or (and (eq 'tib ref-type) ; tib tag is 2 chars.
-			       (= (- (point) 2) start))
-			  (and (eq 'sgml ref-type) ; sgml skips 1 char.
-			       (= (- (point) 1) start)))
-		      ;; Skip to end of reference, not necessarily on this line
-		      ;; Return an error if tib/sgml reference not found
-		      (if (or
-			   (and
-			    (eq 'tib ref-type)
-			    (not
-			     (re-search-forward ispell-tib-ref-end reg-end t)))
-			   (and (eq 'sgml ref-type)
-				(not (re-search-forward "[>;]" reg-end t))))
-			  (progn
-			    (ispell-pdict-save ispell-silently-savep)
-			    (ding)
-			    (message
-			     (concat
-			      "Open tib or SGML command.  Fix buffer or set "
-			      (if (eq 'tib ref-type)
-				  "ispell-skip-tib"
-				"ispell-skip-sgml")
-			      " to nil"))
-			    ;; keep cursor at error location
-			    (setq ispell-quit (- (point) 2))))
-		    ;; Check spelling between reference and start of the line.
-		    (let ((limit (- (point) (if (eq 'tib ref-type) 2 1))))
-		      (goto-char start)
-		      (if (or (re-search-forward ispell-casechars limit t)
-			      (re-search-forward "[][()$]" limit t))
-			  (setq string
-				(concat "^" (buffer-substring start limit)
-					"\n")
-				offset-change (- offset-change ispell-offset)))
-		      (goto-char limit))))
-		 ((or (re-search-forward ispell-casechars end t) ; TEXT EXISTS
-		      (re-search-forward "[][()$]" end t)) ; or MATH COMMANDS
-		  (setq string (concat "^" (buffer-substring start end) "\n")
-			offset-change (- offset-change ispell-offset))
-		  (goto-char end))
-		 (t (beginning-of-line 2))) ; EMPTY LINE, skip it.
-
-		(setq end (point))	; "end" tracks end of region to check.
-
-		(if string		; there is something to spell!
-		    (let (poss)
-		      ;; send string to spell process and get input.
-		      (process-send-string ispell-process string)
-		      (while (progn
-			       (accept-process-output ispell-process)
-			       ;; Last item of output contains a blank line.
-			       (not (string= "" (car ispell-filter)))))
-		      ;; parse all inputs from the stream one word at a time.
-		      ;; Place in FIFO order and remove the blank item.
-		      (setq ispell-filter (nreverse (cdr ispell-filter)))
-		      (while (and (not ispell-quit) ispell-filter)
-			(setq poss (ispell-parse-output (car ispell-filter)))
-			(if (listp poss) ; spelling error occurred.
-			    (let* ((word-start (+ start offset-change
-						  (car (cdr poss))))
-				   (word-end (+ word-start
-						(length (car poss))))
-				   replace)
-			      (goto-char word-start)
-			      ;; Adjust the horizontal scroll & point
-			      (ispell-horiz-scroll)
-			      (goto-char word-end)
-			      (ispell-horiz-scroll)
-			      (goto-char word-start)
-			      (ispell-horiz-scroll)
-			      (if (/= word-end
-				      (progn
-					(search-forward (car poss) word-end t)
-					(point)))
-				  ;; This occurs due to filter pipe problems
-				  (error
-				   (concat "Ispell misalignment: word "
-					   "`%s' point %d; please retry")
-				   (car poss) word-start))
-                              (if (not (pos-visible-in-window-p))
-                                  (sit-for 0))
-			      (if ispell-keep-choices-win
-				  (setq replace
-					(ispell-command-loop
-					 (car (cdr (cdr poss)))
-					 (car (cdr (cdr (cdr poss))))
-					 (car poss) word-start word-end))
-				(save-window-excursion
-				  (setq replace
-					(ispell-command-loop
-					 (car (cdr (cdr poss)))
-					 (car (cdr (cdr (cdr poss))))
-					 (car poss) word-start word-end))))
-			      (cond
-			       ((and replace (listp replace))
-				;; REPLACEMENT WORD entered.  Recheck line
-				;; starting with the replacement word.
-				(setq ispell-filter nil
-				      string (buffer-substring word-start
-							       word-end))
-				(let ((change (- (length (car replace))
-						 (length (car poss)))))
-				  ;; adjust regions
-				  (setq reg-end (+ reg-end change)
-					offset-change (+ offset-change
-							 change)))
-				(if (not (equal (car replace) (car poss)))
-				    (progn
-				      (delete-region word-start word-end)
-				      (insert (car replace))))
-				;; I only need to recheck typed-in replacements
-				(if (not (eq 'query-replace
-					     (car (cdr replace))))
-				    (backward-char (length (car replace))))
-				(setq end (point)) ; reposition for recheck
-				;; when second arg exists, query-replace, saving regions
-				(if (car (cdr replace))
-				    (unwind-protect
-					(save-window-excursion
-					  (set-marker
-					   ispell-query-replace-marker reg-end)
-					  ;; Assume case-replace &
-					  ;; case-fold-search correct?
-					  (query-replace string (car replace)
-							 t))
-				      (setq reg-end
-					    (marker-position
-					     ispell-query-replace-marker))
-				      (set-marker ispell-query-replace-marker
-						  nil))))
-			       ((or (null replace)
-				    (equal 0 replace)) ; ACCEPT/INSERT
-				(if (equal 0 replace) ; BUFFER-LOCAL DICT ADD
-				    (setq reg-end
-					  (ispell-add-per-file-word-list
-					   (car poss) reg-end)))
-				;; This avoids pointing out the word that was
-				;; just accepted (via 'i' or 'a') if it follows
-				;; on the same line.
-				;; Redo check following the accepted word.
-				(if (and ispell-pdict-modified-p
-					 (listp ispell-pdict-modified-p))
-				    ;; Word accepted.  Recheck line.
-				    (setq ispell-pdict-modified-p ; update flag
-					  (car ispell-pdict-modified-p)
-					  ispell-filter nil ; discontinue check
-					  end word-start))) ; reposition loc.
-			       (replace	; STRING REPLACEMENT for this word.
-				(delete-region word-start word-end)
-				(insert replace)
-				(let ((change (- (length replace)
-						 (length (car poss)))))
-				  (setq reg-end (+ reg-end change)
-					offset-change (+ offset-change change)
-					end (+ end change)))))
-			      (if (not ispell-quit)
-				  (message "Continuing spelling check using %s dictionary..."
-					   (or ispell-dictionary "default")))
-			      (sit-for 0)))
-			;; finished with line!
-			(setq ispell-filter (cdr ispell-filter)))))
-		(goto-char end)))))
-	(not ispell-quit))
-    ;; protected
-    (if (get-buffer ispell-choices-buffer)
-	(kill-buffer ispell-choices-buffer))
-    (if ispell-quit
-	(progn
-	  ;; preserve or clear the region for ispell-continue.
-	  (if (not (numberp ispell-quit))
-	      (set-marker ispell-region-end nil)
-	    ;; Enable ispell-continue.
-	    (set-marker ispell-region-end reg-end)
-	    (goto-char ispell-quit))
-	  ;; Check for aborting
-	  (if (and ispell-checking-message (numberp ispell-quit))
-	      (progn
-		(setq ispell-quit nil)
-		(error "Message send aborted.")))
-	  (setq ispell-quit nil))
-      (set-marker ispell-region-end nil)
-      ;; Only save if successful exit.
-      (ispell-pdict-save ispell-silently-savep)
-      (message "Spell-checking done"))))
-
-
-
-;;;###autoload
-(defun ispell-buffer ()
-  "Check the current buffer for spelling errors interactively."
-  (interactive)
-  (ispell-region (point-min) (point-max)))
-
-
-;;;###autoload
-(defun ispell-continue ()
-  (interactive)
-  "Continue a spelling session after making some changes."
-  (if (not (marker-position ispell-region-end))
-      (message "No session to continue.  Use 'X' command when checking!")
-    (if (not (equal (marker-buffer ispell-region-end) (current-buffer)))
-	(message "Must continue ispell from buffer %s"
-		 (buffer-name (marker-buffer ispell-region-end)))
-      (ispell-region (point) (marker-position ispell-region-end)))))
-
-
-;;; Horizontal scrolling
-(defun ispell-horiz-scroll ()
-  "Places point within the horizontal visibility of its window area."
-  (if truncate-lines			; display truncating lines?
-      ;; See if display needs to be scrolled.
-      (let ((column (- (current-column) (max (window-hscroll) 1))))
-	(if (and (< column 0) (> (window-hscroll) 0))
-	    (scroll-right (max (- column) 10))
-	  (if (>= column (- (window-width) 2))
-	      (scroll-left (max (- column (window-width) -3) 10)))))))
-
-
-;;; Interactive word completion.
-;;; Forces "previous-word" processing.  Do we want to make this selectable?
-
-;;;###autoload
-(defun ispell-complete-word (&optional interior-frag)
-  "Look up word before or under point in dictionary (see lookup-words command)
-and try to complete it.  If optional INTERIOR-FRAG is non-nil then the word
-may be a character sequence inside of a word.
-
-Standard ispell choices are then available."
-  (interactive "P")
-  (let ((cursor-location (point))
-	case-fold-search
-	(word (ispell-get-word nil "\\*")) ; force "previous-word" processing.
-	start end possibilities replacement)
-    (setq start (car (cdr word))
-	  end (car (cdr (cdr word)))
-	  word (car word)
-	  possibilities
-	  (or (string= word "")		; Will give you every word
-	      (lookup-words (concat (if interior-frag "*") word "*")
-			    ispell-complete-word-dict)))
-    (cond ((eq possibilities t)
-	   (message "No word to complete"))
-	  ((null possibilities)
-	   (message "No match for \"%s\"" word))
-	  (t				; There is a modification...
-	   (cond			; Try and respect case of word.
-	    ((string-match "^[^A-Z]+$" word)
-	     (setq possibilities (mapcar 'downcase possibilities)))
-	    ((string-match "^[^a-z]+$" word)
-	     (setq possibilities (mapcar 'upcase possibilities)))
-	    ((string-match "^[A-Z]" word)
-	     (setq possibilities (mapcar 'capitalize possibilities))))
-	   (save-window-excursion
-	     (setq replacement
-		   (ispell-command-loop possibilities nil word start end)))
-	   (cond
-	    ((equal 0 replacement)	; BUFFER-LOCAL ADDITION
-	     (ispell-add-per-file-word-list word))
-	    (replacement		; REPLACEMENT WORD
-	     (delete-region start end)
-	     (setq word (if (atom replacement) replacement (car replacement))
-		   cursor-location (+ (- (length word) (- end start))
-				      cursor-location))
-	     (insert word)
-	     (if (not (atom replacement)) ; recheck spelling of replacement.
-		 (progn
-		   (goto-char cursor-location)
-		   (ispell-word nil t)))))
-	   (if (get-buffer ispell-choices-buffer)
-	       (kill-buffer ispell-choices-buffer))))
-    (ispell-pdict-save ispell-silently-savep)
-    (goto-char cursor-location)))
-
-
-;;;###autoload
-(defun ispell-complete-word-interior-frag ()
-  "Completes word matching character sequence inside a word."
-  (interactive)
-  (ispell-complete-word t))
-
-
-;;; **********************************************************************
-;;; 			Ispell Minor Mode
-;;; **********************************************************************
-
-(defvar ispell-minor-mode nil
-  "Non-nil if Ispell minor mode is enabled.")
-;; Variable indicating that ispell minor mode is active.
-(make-variable-buffer-local 'ispell-minor-mode)
-
-(or (assq 'ispell-minor-mode minor-mode-alist)
-    (setq minor-mode-alist
-          (cons '(ispell-minor-mode " Spell") minor-mode-alist)))
-
-(defvar ispell-minor-keymap
-  (let ((map (make-sparse-keymap)))
-    (define-key map " " 'ispell-minor-check)
-    (define-key map "\r" 'ispell-minor-check)
-    map)
-  "Keymap used for Ispell minor mode.")
-
-(or (not (boundp 'minor-mode-map-alist))
-    (assoc 'ispell-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-          (cons (cons 'ispell-minor-mode ispell-minor-keymap)
-                minor-mode-map-alist)))
-
-;;;###autoload
-(defun ispell-minor-mode (&optional arg)
-  "Toggle Ispell minor mode.
-With prefix arg, turn Ispell minor mode on iff arg is positive.
- 
-In Ispell minor mode, pressing SPC or RET
-warns you if the previous word is incorrectly spelled."
-  (interactive "P")
-  (setq ispell-minor-mode
-	(not (or (and (null arg) ispell-minor-mode)
-		 (<= (prefix-numeric-value arg) 0))))
-  (force-mode-line-update))
- 
-(defun ispell-minor-check ()
-  ;; Check previous word then continue with the normal binding of this key.
-  (interactive "*")
-  (let ((ispell-minor-mode nil)
-	(ispell-check-only t))
-    (save-restriction
-      (narrow-to-region (point-min) (point))
-      (ispell-word nil t))
-    (call-interactively (key-binding (this-command-keys)))))
-
-
-;;; **********************************************************************
-;;; 			Ispell Message
-;;; **********************************************************************
-;;; Original from D. Quinlan, E. Bradford, A. Albert, and M. Ernst
-
-
-(defvar ispell-message-text-end
-  (mapconcat (function identity)
-	     '(
-	       ;; Matches postscript files.
-	       "^%!PS-Adobe-[123].0"
-	       ;; Matches uuencoded text
-	       "^begin [0-9][0-9][0-9] .*\nM.*\nM.*\nM"
-	       ;; Matches shell files (esp. auto-decoding)
-	       "^#! /bin/[ck]?sh"
-	       ;; Matches context difference listing
-	       "\\(diff -c .*\\)?\n\\*\\*\\* .*\n--- .*\n\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*\\*"
-               ;; Matches reporter.el bug report
-               "^current state:\n==============\n"
-	       ;; Matches "----------------- cut here"
-               ;; and "------- Start of forwarded message",
-	       ;; or either one with "- " in front.
-               "^\\(- \\)?[-=_]+\\s ?\\(cut here\\|\\(Start of \\)?forwarded message\\)")
-	     "\\|")
-  "*End of text which will be checked in ispell-message.
-If it is a string, limit at first occurrence of that regular expression.
-Otherwise, it must be a function which is called to get the limit.")
-
-
-(defvar ispell-message-start-skip
-  (mapconcat (function identity)
-	     '(
-	       ;; Matches forwarded messages
-	       "^---* Forwarded Message"
-	       ;; Matches PGP Public Key block
-	       "^---*BEGIN PGP [A-Z ]*--*"
-	       )
-	     "\\|")
-  "Spelling is skipped inside these start/end groups by ispell-message.
-Assumed that blocks are not mutually inclusive.")
-
-
-(defvar ispell-message-end-skip
-  (mapconcat (function identity)
-	     '(
-	       ;; Matches forwarded messages
-	       "^--- End of Forwarded Message"
-	       ;; Matches PGP Public Key block
-	       "^---*END PGP [A-Z ]*--*"
-	       )
-	     "\\|")
-  "Spelling is skipped inside these start/end groups by ispell-message.
-Assumed that blocks are not mutually inclusive.")
-
-
-;;;###autoload
-(defun ispell-message ()
-  "Check the spelling of a mail message or news post.
-Don't check spelling of message headers except the Subject field.
-Don't check included messages.
-
-To abort spell checking of a message region and send the message anyway,
-use the `x' command.  (Any subsequent regions will be checked.)
-The `X' command aborts the message send so that you can edit the buffer.
-
-To spell-check whenever a message is sent, include the appropriate lines
-in your .emacs file:
-   (add-hook 'message-send-hook 'ispell-message)
-   (add-hook 'mail-send-hook  'ispell-message)
-   (add-hook 'mh-before-send-letter-hook 'ispell-message)
-
-You can bind this to the key C-c i in GNUS or mail by adding to
-`news-reply-mode-hook' or `mail-mode-hook' the following lambda expression:
-   (function (lambda () (local-set-key \"\\C-ci\" 'ispell-message)))"
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (let* ((internal-messagep (save-excursion
-				(re-search-forward
-				 (concat "^"
-					 (regexp-quote mail-header-separator)
-					 "$")
-				 nil t)))
-	   (limit (copy-marker
-		   (cond
-		    ((not ispell-message-text-end) (point-max))
-		    ((char-or-string-p ispell-message-text-end)
-		     (if (re-search-forward ispell-message-text-end nil t)
-			 (match-beginning 0)
-		       (point-max)))
-		    (t (min (point-max) (funcall ispell-message-text-end))))))
-	   (cite-regexp			;Prefix of inserted text
-	    (cond
-	     ((featurep 'supercite)	; sc 3.0
-	      (concat "\\(" (sc-cite-regexp) "\\)" "\\|"
-		      (ispell-non-empty-string sc-reference-tag-string)))
-	     ((featurep 'sc)		; sc 2.3
-	      (concat "\\(" sc-cite-regexp "\\)" "\\|"
-		      (ispell-non-empty-string sc-reference-tag-string)))
-	     ((equal major-mode 'news-reply-mode) ;GNUS 4 & below
-	      (concat "In article <" "\\|"
-		      (if mail-yank-prefix
-			  (ispell-non-empty-string mail-yank-prefix)
-			"^   \\|^\t")))
-	     ((equal major-mode 'message-mode) ;GNUS 5
-	      (concat ".*@.* writes:$" "\\|"
-		      (if mail-yank-prefix
-			  (ispell-non-empty-string mail-yank-prefix)
-			"^   \\|^\t")))
-	     ((equal major-mode 'mh-letter-mode) ; mh mail message
-	      (ispell-non-empty-string mh-ins-buf-prefix))
-	     ((not internal-messagep)	; Assume n sent us this message.
-	      (concat "In [a-zA-Z.]+ you write:" "\\|"
-		      "In <[^,;&+=]+> [^,;&+=]+ writes:" "\\|"
-		      " *> *"))
-	     ((boundp 'vm-included-text-prefix) ; VM mail message
-	      (concat "[^,;&+=]+ writes:" "\\|"
-		      (ispell-non-empty-string vm-included-text-prefix)))
-	     (mail-yank-prefix		; vanilla mail message.
-	      (ispell-non-empty-string mail-yank-prefix))
-	     (t "^   \\|^\t")))
-	   (cite-regexp-start (concat "^[ \t]*$\\|" cite-regexp))
-	   (cite-regexp-end   (concat "^\\(" cite-regexp "\\)"))
-	   (old-case-fold-search case-fold-search)
-	   (case-fold-search t)
-	   (ispell-checking-message t))
-      (goto-char (point-min))
-      ;; Skip header fields except Subject: without Re:'s
-      ;;(search-forward mail-header-separator nil t)
-      (while (if internal-messagep
-		 (< (point) internal-messagep)
-	       (and (looking-at "[a-zA-Z---]+:\\|\t\\| ")
-		    (not (eobp))))
-	(if (looking-at "Subject: *")	; Spell check new subject fields
-	    (progn
-	      (goto-char (match-end 0))
-	      (if (and (not (looking-at ".*Re\\>"))
-		       (not (looking-at "\\[")))
-		  (let ((case-fold-search old-case-fold-search))
-		    (ispell-region (point)
-				   (progn
-				     (end-of-line)
-				     (while (looking-at "\n[ \t]")
-				       (end-of-line 2))
-				     (point)))))))
-	(forward-line 1))
-      (setq case-fold-search nil)
-      ;; Skip mail header, particularly for non-english languages.
-      (if (looking-at (concat (regexp-quote mail-header-separator) "$"))
-	  (forward-line 1))
-      (while (< (point) limit)
-	;; Skip across text cited from other messages.
-	(while (and (looking-at cite-regexp-start)
-		    (< (point) limit)
-		    (zerop (forward-line 1))))
-
-	(if (< (point) limit)
-	    (let* ((start (point))
-		   ;; Check the next batch of lines that *aren't* cited.
-		   (end-c (and (re-search-forward cite-regexp-end limit 'end)
-			       (match-beginning 0)))
-		   ;; Skip a block of included text.
-		   (end-fwd (and (goto-char start)
-				 (re-search-forward ispell-message-start-skip
-						    limit 'end)
-				 (progn (beginning-of-line)
-					(point))))
-		   (end (or (and end-c end-fwd (min end-c end-fwd))
-			    end-c end-fwd
-			    ;; default to limit of text.
-			    (marker-position limit))))
-	      (goto-char start)
-	      (ispell-region start end)
-	      (if (and end-fwd (= end end-fwd))
-		  (progn
-		    (goto-char end)
-		    (re-search-forward ispell-message-end-skip limit 'end))
-		(goto-char end)))))
-      (set-marker limit nil))))
-
-
-(defun ispell-non-empty-string (string)
-  (if (or (not string) (string-equal string ""))
-      "\\'\\`" ; An unmatchable string if string is null.
-    (regexp-quote string)))
-
-
-;;; **********************************************************************
-;;; 			Buffer Local Functions
-;;; **********************************************************************
-
-
-(defun ispell-accept-buffer-local-defs ()
-  "Load all buffer-local information, restarting ispell when necessary."
-  (ispell-buffer-local-dict)		; May kill ispell-process.
-  (ispell-buffer-local-words)		; Will initialize ispell-process.
-  (ispell-buffer-local-parsing))
-
-
-(defun ispell-buffer-local-parsing ()
-  "Place Ispell into parsing mode for this buffer.
-Overrides the default parsing mode.
-Includes latex/nroff modes and extended character mode."
-  ;; (ispell-init-process) must already be called.
-  (process-send-string ispell-process "!\n") ; Put process in terse mode.
-  ;; We assume all major modes with "tex-mode" in them should use latex parsing
-  (if (or (and (eq ispell-parser 'use-mode-name)
-	       (string-match "[Tt][Ee][Xx]-mode" (symbol-name major-mode)))
-	  (eq ispell-parser 'tex))
-      (process-send-string ispell-process "+\n") ; set ispell mode to tex
-    (process-send-string ispell-process "-\n"))	; set mode to normal (nroff)
-  ;; Hard-wire test for SGML & HTML mode.
-  (setq ispell-skip-sgml (memq major-mode '(sgml-mode html-mode)))
-  ;; Set default extended character mode for given buffer, if any.
-  (let ((extended-char-mode (ispell-get-extended-character-mode)))
-    (if extended-char-mode
-	(process-send-string ispell-process (concat extended-char-mode "\n"))))
-  ;; Set buffer-local parsing mode and extended character mode, if specified.
-  (save-excursion
-    (goto-char (point-min))
-    ;; Uses last valid definition
-    (while (search-forward ispell-parsing-keyword nil t)
-      (let ((end (save-excursion (end-of-line) (point)))
-	    (case-fold-search t)
-	    string)
-	(while (re-search-forward " *\\([^ \"]+\\)" end t)
-	  ;; space separated definitions.
-	  (setq string (buffer-substring (match-beginning 1) (match-end 1)))
-	  (cond ((string-match "latex-mode" string)
-		 (process-send-string ispell-process "+\n~tex\n"))
-		((string-match "nroff-mode" string)
-		 (process-send-string ispell-process "-\n~nroff"))
-		((string-match "~" string) ; Set extended character mode.
-		 (process-send-string ispell-process (concat string "\n")))
-		(t (message "Illegal Ispell Parsing argument!")
-		   (sit-for 2))))))))
-
-
-;;; Can kill the current ispell process
-
-(defun ispell-buffer-local-dict ()
-  "Initializes local dictionary.
-When a dictionary is defined in the buffer (see variable
-`ispell-dictionary-keyword'), it will override the local setting
-from \\[ispell-change-dictionary].
-Both should not be used to define a buffer-local dictionary."
-  (save-excursion
-    (goto-char (point-min))
-    (let (end)
-      ;; Override the local variable definition.
-      ;; Uses last valid definition.
-      (while (search-forward ispell-dictionary-keyword nil t)
-	(setq end (save-excursion (end-of-line) (point)))
-	(if (re-search-forward " *\\([^ \"]+\\)" end t)
-	    (setq ispell-local-dictionary
-		  (buffer-substring (match-beginning 1) (match-end 1)))))
-      (goto-char (point-min))
-      (while (search-forward ispell-pdict-keyword nil t)
-	(setq end (save-excursion (end-of-line) (point)))
-	(if (re-search-forward " *\\([^ \"]+\\)" end t)
-	    (setq ispell-local-pdict
-		  (buffer-substring (match-beginning 1) (match-end 1)))))))
-  ;; Reload if new personal dictionary defined.
-  (if (and ispell-local-pdict
-	   (not (equal ispell-local-pdict ispell-personal-dictionary)))
-      (progn
-	(ispell-kill-ispell t)
-	(setq ispell-personal-dictionary ispell-local-pdict)))
-  ;; Reload if new dictionary defined.
-  (if (and ispell-local-dictionary
-	   (not (equal ispell-local-dictionary ispell-dictionary)))
-      (ispell-change-dictionary ispell-local-dictionary)))
-
-
-(defun ispell-buffer-local-words ()
-  "Loads the buffer-local dictionary in the current buffer."
-  (if (and ispell-buffer-local-name
-	   (not (equal ispell-buffer-local-name (buffer-name))))
-      (progn
-	(ispell-kill-ispell t)
-	(setq ispell-buffer-local-name nil)))
-  (ispell-init-process)
-  (save-excursion
-    (goto-char (point-min))
-    (while (search-forward ispell-words-keyword nil t)
-      (or ispell-buffer-local-name
-	  (setq ispell-buffer-local-name (buffer-name)))
-      (let ((end (save-excursion (end-of-line) (point)))
-	    string)
-	;; buffer-local words separated by a space, and can contain
-	;; any character other than a space.
-	(while (re-search-forward " *\\([^ ]+\\)" end t)
-	  (setq string (buffer-substring (match-beginning 1) (match-end 1)))
-	  (process-send-string ispell-process (concat "@" string "\n")))))))
-
-
-;;; returns optionally adjusted region-end-point.
-
-(defun ispell-add-per-file-word-list (word &optional reg-end)
-  "Adds new word to the per-file word list."
-  (or ispell-buffer-local-name
-      (setq ispell-buffer-local-name (buffer-name)))
-  (if (null reg-end)
-      (setq reg-end 0))
-  (save-excursion
-    (goto-char (point-min))
-    (let (case-fold-search line-okay search done string)
-      (while (not done)
-	(setq search (search-forward ispell-words-keyword nil 'move)
-	      line-okay (< (+ (length word) 1 ; 1 for space after word..
-			      (progn (end-of-line) (current-column)))
-			   80))
-	(if (or (and search line-okay)
-		(null search))
-	    (progn
-	      (setq done t)
-	      (if (null search)
-		  (progn
-		    (open-line 1)
-		    (setq string (concat comment-start " "
-					 ispell-words-keyword))
-		    ;; in case the keyword is in the middle of the file....
-		    (if (> reg-end (point))
-			(setq reg-end (+ reg-end (length string))))
-		    (insert string)
-		    (if (and comment-end (not (equal "" comment-end)))
-			(save-excursion
-			  (open-line 1)
-			  (forward-line 1)
-			  (insert comment-end)))))
-	      (if (> reg-end (point))
-		  (setq reg-end (+ 1 reg-end (length word))))
-	      (insert (concat " " word)))))))
-  reg-end)
-
-
-(defconst ispell-version "2.37 -- Tue Jun 13 12:05:28 EDT 1995")
-
-(provide 'ispell)
-
-
-;;; LOCAL VARIABLES AND BUFFER-LOCAL VALUE EXAMPLES.
-
-;;; Local Variable options:
-;;; mode: name(-mode)
-;;; eval: expression
-;;; local-variable: value
-
-;;; The following sets the buffer local dictionary to english!
-
-;;; Local Variables:
-;;; mode: emacs-lisp
-;;; comment-column: 40
-;;; ispell-local-dictionary: "american"
-;;; End:
-
-
-;;; MORE EXAMPLES OF ISPELL BUFFER-LOCAL VALUES
-
-;;; The following places this file in nroff parsing and extended char modes.
-;;; Local IspellParsing: nroff-mode ~nroff
-;;; Change IspellDict to IspellDict: to enable the following line.
-;;; Local IspellDict english
-;;; Change IspellPersDict to IspellPersDict: to enable the following line.
-;;; Local IspellPersDict ~/.ispell_lisp
-;;; The following were automatically generated by ispell using the 'A' command:
-; LocalWords:  ispell ispell-highlight-p ispell-check-comments query-replace
-; LocalWords:  ispell-query-replace-choices ispell-skip-tib non-nil tib
-; LocalWords:  regexps ispell-tib-ref-beginning ispell-tib-ref-end
-
-;; ispell.el ends here
diff --git a/lisp/textmodes/makeinfo.el b/lisp/textmodes/makeinfo.el
deleted file mode 100644
index a649d522156..00000000000
--- a/lisp/textmodes/makeinfo.el
+++ /dev/null
@@ -1,247 +0,0 @@
-;;; makeinfo.el --- run makeinfo conveniently
-
-;; Copyright (C) 1991, 1993 Free Software Foundation, Inc.
-
-;; Author: Robert J. Chassell      
-;; 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:
-
-;;; The Texinfo mode `makeinfo' related commands are:
-
-;; makeinfo-region      to run makeinfo on the current region.
-;; makeinfo-buffer      to run makeinfo on the current buffer, or
-;;                        with optional prefix arg, on current region
-;; kill-compilation     to kill currently running makeinfo job
-;; makeinfo-recenter-makeinfo-buffer  to redisplay *compilation* buffer
-
-;;; Keybindings (defined in `texinfo.el')
-
-;; makeinfo bindings
-; (define-key texinfo-mode-map "\C-c\C-m\C-r" 'makeinfo-region)
-; (define-key texinfo-mode-map "\C-c\C-m\C-b" 'makeinfo-buffer)
-; (define-key texinfo-mode-map "\C-c\C-m\C-k" 'kill-compilation)
-; (define-key texinfo-mode-map "\C-c\C-m\C-l"
-;   'makeinfo-recenter-compilation-buffer)
-
-;;; Code:
-
-;;; Variables used by `makeinfo'
-
-(require 'compile)
-
-(defvar makeinfo-run-command "makeinfo"
-  "*Command used to run `makeinfo' subjob.
-The name of the file is appended to this string, separated by a space.")
-
-(defvar makeinfo-options "--fill-column=70"
-  "*String containing options for running `makeinfo'.  
-Do not include `--footnote-style' or `--paragraph-indent';
-the proper way to specify those is with the Texinfo commands
-`@footnotestyle` and `@paragraphindent'.")
-
-(require 'texinfo)
-
-(defvar makeinfo-compilation-process nil
-  "Process that runs `makeinfo'.  Should start out nil.")
-
-(defvar makeinfo-temp-file nil
-  "Temporary file name used for text being sent as input to `makeinfo'.")
-
-(defvar makeinfo-output-file-name nil
-  "Info file name used for text output by `makeinfo'.")
-
-
-;;; The `makeinfo' function definitions
-
-(defun makeinfo-region (region-beginning region-end)
-  "Make Info file from region of current Texinfo file, and switch to it.
-
-This command does not offer the `next-error' feature since it would
-apply to a temporary file, not the original; use the `makeinfo-buffer'
-command to gain use of `next-error'."
-  
-  (interactive "r")
-  (let (filename-or-header
-        filename-or-header-beginning
-        filename-or-header-end)
-    ;; Cannot use `let' for makeinfo-temp-file or
-    ;; makeinfo-output-file-name since `makeinfo-compilation-sentinel'
-    ;; needs them.
-
-    (setq makeinfo-temp-file
-          (concat
-           (make-temp-name
-            (substring (buffer-file-name)
-                       0 
-                       (or (string-match "\\.tex" (buffer-file-name)) 
-                           (length (buffer-file-name)))))
-           ".texinfo"))
-    
-    (save-excursion
-      (save-restriction
-        (widen)
-        (goto-char (point-min))
-        (let ((search-end (save-excursion (forward-line 100) (point))))
-          ;; Find and record the Info filename,
-          ;; or else explain that a filename is needed.
-          (if (re-search-forward 
-               "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*"
-               search-end t)
-              (setq makeinfo-output-file-name 
-                    (buffer-substring (match-beginning 1) (match-end 1)))
-            (error
-             "The texinfo file needs a line saying: @setfilename <name>"))
-
-          ;; Find header and specify its beginning and end.
-          (goto-char (point-min))
-          (if (and 
-               (prog1 
-                   (search-forward tex-start-of-header search-end t)
-                 (beginning-of-line)
-                 ;; Mark beginning of header.
-                 (setq filename-or-header-beginning (point)))
-               (prog1 
-                   (search-forward tex-end-of-header nil t)
-                 (beginning-of-line)
-                 ;; Mark end of header
-                 (setq filename-or-header-end (point))))
-              
-              ;; Insert the header into the temporary file.
-              (write-region
-               (min filename-or-header-beginning region-beginning)
-               filename-or-header-end
-               makeinfo-temp-file nil nil)
-            
-            ;; Else no header; insert @filename line into temporary file.
-            (goto-char (point-min))
-            (search-forward "@setfilename" search-end t)
-            (beginning-of-line)
-            (setq filename-or-header-beginning (point))
-            (forward-line 1)
-            (setq filename-or-header-end (point))
-            (write-region
-             (min filename-or-header-beginning region-beginning)
-             filename-or-header-end
-             makeinfo-temp-file nil nil))
-          
-          ;; Insert the region into the file.
-          (write-region
-           (max region-beginning filename-or-header-end)
-           region-end
-           makeinfo-temp-file t nil)
-
-          ;; Run the `makeinfo-compile' command in the *compilation* buffer
-          (save-excursion
-            (makeinfo-compile
-             (concat makeinfo-run-command
-                     " "
-                     makeinfo-options
-                     " " 
-                     makeinfo-temp-file)
-             "Use `makeinfo-buffer' to gain use of the `next-error' command"
-	     nil)))))))
-
-;;; Actually run makeinfo.  COMMAND is the command to run.
-;;; ERROR-MESSAGE is what to say when next-error can't find another error.
-;;; If PARSE-ERRORS is non-nil, do try to parse error messages.
-(defun makeinfo-compile (command error-message parse-errors)
-  (let ((buffer
-	 (compile-internal command error-message nil
-			   (and (not parse-errors)
-				;; If we do want to parse errors, pass nil.
-				;; Otherwise, use this function, which won't
-				;; ever find any errors.
-				'(lambda (&rest ignore)
-				   (setq compilation-error-list nil))))))
-    (set-process-sentinel (get-buffer-process buffer)
-			  'makeinfo-compilation-sentinel)))
-
-;; Delete makeinfo-temp-file after processing is finished,
-;; and visit Info file.
-;; This function is called when the compilation process changes state.
-;; Based on `compilation-sentinel' in compile.el
-(defun makeinfo-compilation-sentinel (proc msg)
-  (compilation-sentinel proc msg)
-  (if (and makeinfo-temp-file (file-exists-p makeinfo-temp-file))
-      (delete-file makeinfo-temp-file))
-  ;; Always use the version on disk.
-  (if (get-file-buffer makeinfo-output-file-name)
-      (progn (set-buffer makeinfo-output-file-name)
-	     (revert-buffer t t))
-    (find-file makeinfo-output-file-name))
-  (goto-char (point-min)))
-
-(defun makeinfo-buffer ()
-  "Make Info file from current buffer.
-
-Use the \\[next-error] command to move to the next error 
-\(if there are errors\)."
- 
-  (interactive)
-  (cond ((null buffer-file-name)
-         (error "Buffer not visiting any file"))
-        ((buffer-modified-p)
-         (if (y-or-n-p "Buffer modified; do you want to save it? ")
-             (save-buffer))))
-  
-  ;; Find and record the Info filename,
-  ;; or else explain that a filename is needed.
-  (save-excursion
-    (goto-char (point-min))
-    (let ((search-end (save-excursion (forward-line 100) (point))))
-      (if (re-search-forward 
-           "^@setfilename[ \t]+\\([^ \t\n]+\\)[ \t]*"
-           search-end t)
-          (setq makeinfo-output-file-name 
-                (buffer-substring (match-beginning 1) (match-end 1)))
-        (error
-         "The texinfo file needs a line saying: @setfilename <name>"))))
-  
-  (save-excursion
-    (makeinfo-compile
-     (concat makeinfo-run-command " " makeinfo-options
-             " " buffer-file-name)
-     "No more errors."
-     t)))
-
-(defun makeinfo-recenter-compilation-buffer (linenum)
-  "Redisplay `*compilation*' buffer so most recent output can be seen.
-The last line of the buffer is displayed on
-line LINE of the window, or centered if LINE is nil."
-  (interactive "P")
-  (let ((makeinfo-buffer (get-buffer "*compilation*"))
-	(old-buffer (current-buffer)))
-    (if (null makeinfo-buffer)
-	(message "No *compilation* buffer")
-      (pop-to-buffer makeinfo-buffer)
-      (bury-buffer makeinfo-buffer)
-      (goto-char (point-max))
-      (recenter (if linenum
-		    (prefix-numeric-value linenum)
-		  (/ (window-height) 2)))
-      (pop-to-buffer old-buffer)
-      )))
-
-;;; Place `provide' at end of file.
-(provide 'makeinfo)
-
-;;; makeinfo.el ends here
-
diff --git a/lisp/textmodes/nroff-mode.el b/lisp/textmodes/nroff-mode.el
deleted file mode 100644
index 71ef6c2643e..00000000000
--- a/lisp/textmodes/nroff-mode.el
+++ /dev/null
@@ -1,270 +0,0 @@
-;;; nroff-mode.el --- GNU Emacs major mode for editing nroff source
-
-;; Copyright (C) 1985, 1986, 1994, 1995 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: wp
-
-;; 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 is a major mode for editing nroff source code.  It knows
-;; about various nroff constructs, ms, mm, and me macros, and will fill
-;; and indent paragraphs properly in their presence.  It also includes
-;; a command to count text lines (excluding nroff constructs), a command
-;; to center a line, and movement commands that know how to skip macros.
-
-;; Paragraph filling and line-counting currently don't respect comments,
-;; as they should.
-
-;;; Code:
-
-(defvar nroff-mode-abbrev-table nil
-  "Abbrev table used while in nroff mode.")
-(define-abbrev-table 'nroff-mode-abbrev-table ())
-
-(defvar nroff-mode-map nil
-     "Major mode keymap for nroff mode.")
-(if (not nroff-mode-map)
-    (progn
-      (setq nroff-mode-map (make-sparse-keymap))
-      (define-key nroff-mode-map "\t"  'tab-to-tab-stop)
-      (define-key nroff-mode-map "\es" 'center-line)
-      (define-key nroff-mode-map "\e?" 'count-text-lines)
-      (define-key nroff-mode-map "\n"  'electric-nroff-newline)
-      (define-key nroff-mode-map "\en" 'forward-text-line)
-      (define-key nroff-mode-map "\ep" 'backward-text-line)))
-
-(defvar nroff-mode-syntax-table nil
-  "Syntax table used while in nroff mode.")
-
-(defvar nroff-font-lock-keywords
-  (list
-   ;; Directives are . or ' at start of line, followed by
-   ;; optional whitespace, then command (which my be longer than
-   ;; 2 characters in groff).  Perhaps the arguments should be
-   ;; fontified as well.
-   "^[.']\\s-*\\sw+"
-   ;; There are numerous groff escapes; the following get things
-   ;; like \-, \(em (standard troff) and \f[bar] (groff
-   ;; variants).  This won't currently do groff's \A'foo' and
-   ;; the like properly.  One might expect it to highlight an escape's
-   ;; arguments in common cases, like \f.
-   (concat "\\\\"                     ; backslash
-         "\\("                        ; followed by various possibilities
-         (mapconcat 'identity
-                    '("[f*n]*\\[.+]"  ; some groff extensions
-                      "(.."           ; two chars after (
-                      "[^(\"]"        ; single char escape
-                      ) "\\|")
-         "\\)")
-   )
-  "Font-lock highlighting control in nroff-mode.")
-
-;;;###autoload
-(defun nroff-mode ()
-  "Major mode for editing text intended for nroff to format.
-\\{nroff-mode-map}
-Turning on Nroff mode runs `text-mode-hook', then `nroff-mode-hook'.
-Also, try `nroff-electric-mode', for automatically inserting
-closing requests for requests that are used in matched pairs."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map nroff-mode-map)
-  (setq mode-name "Nroff")
-  (setq major-mode 'nroff-mode)
-  (if nroff-mode-syntax-table
-      ()
-    (setq nroff-mode-syntax-table (copy-syntax-table text-mode-syntax-table))
-    ;; " isn't given string quote syntax in text-mode but it
-    ;; (arguably) should be for use round nroff arguments (with ` and
-    ;; ' used otherwise).
-    (modify-syntax-entry ?\" "\"  2" nroff-mode-syntax-table)
-    ;; Comments are delimited by \" and newline.
-    (modify-syntax-entry ?\\ "\\  1" nroff-mode-syntax-table)
-    (modify-syntax-entry ?\n ">  1" nroff-mode-syntax-table))
-  (set-syntax-table nroff-mode-syntax-table)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(nroff-font-lock-keywords nil t))
-  (setq local-abbrev-table nroff-mode-abbrev-table)
-  (make-local-variable 'nroff-electric-mode)
-  (setq nroff-electric-mode nil)
-  (make-local-variable 'outline-regexp)
-  (setq outline-regexp "\\.H[ ]+[1-7]+ ")
-  (make-local-variable 'outline-level)
-  (setq outline-level 'nroff-outline-level)
-  ;; now define a bunch of variables for use by commands in this mode
-  (make-local-variable 'page-delimiter)
-  (setq page-delimiter "^\\.\\(bp\\|SK\\|OP\\)")
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "[.']\\|" paragraph-start))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate (concat "[.']\\|" paragraph-separate))
-  ;; comment syntax added by mit-erl!gildea 18 Apr 86
-  (make-local-variable 'comment-start)
-  (setq comment-start "\\\" ")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "\\\\\"[ \t]*")
-  (make-local-variable 'comment-column)
-  (setq comment-column 24)
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'nroff-comment-indent)
-  (run-hooks 'text-mode-hook 'nroff-mode-hook))
-
-(defun nroff-outline-level ()
-  (save-excursion
-    (looking-at outline-regexp)
-    (skip-chars-forward ".H ")
-    (string-to-int (buffer-substring (point) (+ 1 (point))))))
-
-;;; Compute how much to indent a comment in nroff/troff source.
-;;; By mit-erl!gildea April 86
-(defun nroff-comment-indent ()
-  "Compute indent for an nroff/troff comment.
-Puts a full-stop before comments on a line by themselves."
-  (let ((pt (point)))
-    (unwind-protect
-	(progn
-	  (skip-chars-backward " \t")
-	  (if (bolp)
-	      (progn
-		(setq pt (1+ pt))
-		(insert ?.)
-		1)
-	    (if (save-excursion
-		  (backward-char 1)
-		  (looking-at "^[.']"))
-		1
-	      (max comment-column
-		   (* 8 (/ (+ (current-column)
-			      9) 8)))))) ; add 9 to ensure at least two blanks
-      (goto-char pt))))
-
-(defun count-text-lines (start end &optional print)
-  "Count lines in region, except for nroff request lines.
-All lines not starting with a period are counted up.
-Interactively, print result in echo area.
-Noninteractively, return number of non-request lines from START to END."
-  (interactive "r\np")
-  (if print
-      (message "Region has %d text lines" (count-text-lines start end))
-    (save-excursion
-      (save-restriction
-	(narrow-to-region start end)
-	(goto-char (point-min))
-	(- (buffer-size) (forward-text-line (buffer-size)))))))
-
-(defun forward-text-line (&optional cnt)
-  "Go forward one nroff text line, skipping lines of nroff requests.
-An argument is a repeat count; if negative, move backward."
-  (interactive "p")
-  (if (not cnt) (setq cnt 1))
-  (while (and (> cnt 0) (not (eobp)))
-    (forward-line 1)
-    (while (and (not (eobp)) (looking-at "[.']."))
-      (forward-line 1))
-    (setq cnt (- cnt 1)))
-  (while (and (< cnt 0) (not (bobp)))
-    (forward-line -1)
-    (while (and (not (bobp))
-		(looking-at "[.']."))
-      (forward-line -1))
-    (setq cnt (+ cnt 1)))
-  cnt)
-
-(defun backward-text-line (&optional cnt)
-  "Go backward one nroff text line, skipping lines of nroff requests.
-An argument is a repeat count; negative means move forward."
-  (interactive "p")
-  (forward-text-line (- cnt)))
-
-(defconst nroff-brace-table
-  '((".(b" . ".)b")
-    (".(l" . ".)l")
-    (".(q" . ".)q")
-    (".(c" . ".)c")
-    (".(x" . ".)x")
-    (".(z" . ".)z")
-    (".(d" . ".)d")
-    (".(f" . ".)f")
-    (".LG" . ".NL")
-    (".SM" . ".NL")
-    (".LD" . ".DE")
-    (".CD" . ".DE")
-    (".BD" . ".DE")
-    (".DS" . ".DE")
-    (".DF" . ".DE")
-    (".FS" . ".FE")
-    (".KS" . ".KE")
-    (".KF" . ".KE")
-    (".LB" . ".LE")
-    (".AL" . ".LE")
-    (".BL" . ".LE")
-    (".DL" . ".LE")
-    (".ML" . ".LE")
-    (".RL" . ".LE")
-    (".VL" . ".LE")
-    (".RS" . ".RE")
-    (".TS" . ".TE")
-    (".EQ" . ".EN")
-    (".PS" . ".PE")
-    (".BS" . ".BE")
-    (".G1" . ".G2")			; grap
-    (".na" . ".ad b")
-    (".nf" . ".fi")
-    (".de" . "..")))
-
-(defun electric-nroff-newline (arg)
-  "Insert newline for nroff mode; special if electric-nroff mode.
-In `electric-nroff-mode', if ending a line containing an nroff opening request,
-automatically inserts the matching closing request after point."
-  (interactive "P")
-  (let ((completion (save-excursion
-		      (beginning-of-line)
-		      (and (null arg)
-			   nroff-electric-mode
-			   (<= (point) (- (point-max) 3))
-			   (cdr (assoc (buffer-substring (point)
-							 (+ 3 (point)))
-				       nroff-brace-table)))))
-	(needs-nl (not (looking-at "[ \t]*$"))))
-    (if (null completion)
-	(newline (prefix-numeric-value arg))
-      (save-excursion
-	(insert "\n\n" completion)
-	(if needs-nl (insert "\n")))
-      (forward-char 1))))
-
-(defun electric-nroff-mode (&optional arg)
-  "Toggle `nroff-electric-newline' minor mode.
-`nroff-electric-newline' forces Emacs to check for an nroff request at the
-beginning of the line, and insert the matching closing request if necessary.
-This command toggles that mode (off->on, on->off), with an argument,
-turns it on iff arg is positive, otherwise off."
-  (interactive "P")
-  (or (eq major-mode 'nroff-mode) (error "Must be in nroff mode"))
-  (or (assq 'nroff-electric-mode minor-mode-alist)
-      (setq minor-mode-alist (append minor-mode-alist
-				     (list '(nroff-electric-mode
-					     " Electric")))))
-  (setq nroff-electric-mode
-	(cond ((null arg) (null nroff-electric-mode))
-	      (t (> (prefix-numeric-value arg) 0)))))
-
-;;; nroff-mode.el ends here
diff --git a/lisp/textmodes/ooutline.el b/lisp/textmodes/ooutline.el
deleted file mode 100644
index af053cc3245..00000000000
--- a/lisp/textmodes/ooutline.el
+++ /dev/null
@@ -1,573 +0,0 @@
-;;; outline.el --- outline mode commands for Emacs
-
-;; Copyright (C) 1986, 1993, 1994 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: outlines
-
-;; 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 is a major mode for editing outline-format documents.
-;; An outline can be `abstracted' to show headers at any given level,
-;; with all stuff below hidden.  See the Emacs manual for details.
-
-;;; Code:
-
-;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
-  
-(defvar outline-regexp nil
-  "*Regular expression to match the beginning of a heading.
-Any line whose beginning matches this regexp is considered to start a heading.
-The recommended way to set this is with a Local Variables: list
-in the file it applies to.  See also outline-heading-end-regexp.")
-
-;; Can't initialize this in the defvar above -- some major modes have
-;; already assigned a local value to it.
-(or (default-value 'outline-regexp)
-    (setq-default outline-regexp "[*\^L]+"))
-  
-(defvar outline-heading-end-regexp "[\n\^M]"
-  "*Regular expression to match the end of a heading line.
-You can assume that point is at the beginning of a heading when this
-regexp is searched for.  The heading ends at the end of the match.
-The recommended way to set this is with a \"Local Variables:\" list
-in the file it applies to.")
-
-(defvar outline-mode-prefix-map nil)
-
-(if outline-mode-prefix-map
-    nil
-  (setq outline-mode-prefix-map (make-sparse-keymap))
-  (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading)
-  (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading)
-  (define-key outline-mode-prefix-map "\C-i" 'show-children)
-  (define-key outline-mode-prefix-map "\C-s" 'show-subtree)
-  (define-key outline-mode-prefix-map "\C-d" 'hide-subtree)
-  (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading)
-  (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level)
-  (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level)
-  (define-key outline-mode-prefix-map "\C-t" 'hide-body)
-  (define-key outline-mode-prefix-map "\C-a" 'show-all)
-  (define-key outline-mode-prefix-map "\C-c" 'hide-entry)
-  (define-key outline-mode-prefix-map "\C-e" 'show-entry)
-  (define-key outline-mode-prefix-map "\C-l" 'hide-leaves)
-  (define-key outline-mode-prefix-map "\C-k" 'show-branches)
-  (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels)
-  (define-key outline-mode-prefix-map "\C-o" 'hide-other))
-
-(defvar outline-mode-menu-bar-map nil)
-(if outline-mode-menu-bar-map
-    nil
-  (setq outline-mode-menu-bar-map (make-sparse-keymap))
-
-  (define-key outline-mode-menu-bar-map [hide]
-    (cons "Hide" (make-sparse-keymap "Hide")))
-
-  (define-key outline-mode-menu-bar-map [hide hide-other]
-    '("Hide Other" . hide-other))
-  (define-key outline-mode-menu-bar-map [hide hide-sublevels]
-    '("Hide Sublevels" . hide-sublevels))
-  (define-key outline-mode-menu-bar-map [hide hide-subtree]
-    '("Hide Subtree" . hide-subtree))
-  (define-key outline-mode-menu-bar-map [hide hide-entry]
-    '("Hide Entry" . hide-entry))
-  (define-key outline-mode-menu-bar-map [hide hide-body]
-    '("Hide Body" . hide-body))
-  (define-key outline-mode-menu-bar-map [hide hide-leaves]
-    '("Hide Leaves" . hide-leaves))
-
-  (define-key outline-mode-menu-bar-map [show]
-    (cons "Show" (make-sparse-keymap "Show")))
-
-  (define-key outline-mode-menu-bar-map [show show-subtree]
-    '("Show Subtree" . show-subtree))
-  (define-key outline-mode-menu-bar-map [show show-children]
-    '("Show Children" . show-children))
-  (define-key outline-mode-menu-bar-map [show show-branches]
-    '("Show Branches" . show-branches))
-  (define-key outline-mode-menu-bar-map [show show-entry]
-    '("Show Entry" . show-entry))
-  (define-key outline-mode-menu-bar-map [show show-all]
-    '("Show All" . show-all))
-
-  (define-key outline-mode-menu-bar-map [headings]
-    (cons "Headings" (make-sparse-keymap "Headings")))
-
-  (define-key outline-mode-menu-bar-map [headings outline-backward-same-level]
-    '("Previous Same Level" . outline-backward-same-level))
-  (define-key outline-mode-menu-bar-map [headings outline-forward-same-level]
-    '("Next Same Level" . outline-forward-same-level))
-  (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading]
-    '("Previous" . outline-previous-visible-heading))
-  (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading]
-    '("Next" . outline-next-visible-heading))
-  (define-key outline-mode-menu-bar-map [headings outline-up-heading]
-    '("Up" . outline-up-heading)))
-
-(defvar outline-mode-map nil "")
-
-(if outline-mode-map
-    nil
-  (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
-  (define-key outline-mode-map "\C-c" outline-mode-prefix-map)
-  (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map))
-
-(defvar outline-minor-mode nil
-  "Non-nil if using Outline mode as a minor mode of some other mode.")
-(make-variable-buffer-local 'outline-minor-mode)
-(put 'outline-minor-mode 'permanent-local t)
-(or (assq 'outline-minor-mode minor-mode-alist)
-    (setq minor-mode-alist (append minor-mode-alist
-				   (list '(outline-minor-mode " Outl")))))
-
-(defvar outline-font-lock-keywords
-  '(;; Highlight headings according to the level.
-    ("^\\([*]+\\)[ \t]*\\([^\n\r]+\\)?[ \t]*[\n\r]"
-     (1 font-lock-string-face)
-     (2 (let ((len (- (match-end 1) (match-beginning 1))))
-	  (or (cdr (assq len '((1 . font-lock-function-name-face)
-			       (2 . font-lock-keyword-face)
-			       (3 . font-lock-comment-face))))
-	      font-lock-variable-name-face))
-	nil t))
-    ;; Highlight citations of the form [1] and [Mar94].
-    ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face))
-  "Additional expressions to highlight in Outline mode.")
-
-;;;###autoload
-(defun outline-mode ()
-  "Set major mode for editing outlines with selective display.
-Headings are lines which start with asterisks: one for major headings,
-two for subheadings, etc.  Lines not starting with asterisks are body lines. 
-
-Body text or subheadings under a heading can be made temporarily
-invisible, or visible again.  Invisible lines are attached to the end 
-of the heading, so they move with it, if the line is killed and yanked
-back.  A heading with text hidden under it is marked with an ellipsis (...).
-
-Commands:\\<outline-mode-map>
-\\[outline-next-visible-heading]   outline-next-visible-heading      move by visible headings
-\\[outline-previous-visible-heading]   outline-previous-visible-heading
-\\[outline-forward-same-level]   outline-forward-same-level        similar but skip subheadings
-\\[outline-backward-same-level]   outline-backward-same-level
-\\[outline-up-heading]   outline-up-heading		    move from subheading to heading
-
-\\[hide-body]	make all text invisible (not headings).
-\\[show-all]	make everything in buffer visible.
-
-The remaining commands are used when point is on a heading line.
-They apply to some of the body or subheadings of that heading.
-\\[hide-subtree]   hide-subtree	make body and subheadings invisible.
-\\[show-subtree]   show-subtree	make body and subheadings visible.
-\\[show-children]   show-children	make direct subheadings visible.
-		 No effect on body, or subheadings 2 or more levels down.
-		 With arg N, affects subheadings N levels down.
-\\[hide-entry]	   make immediately following body invisible.
-\\[show-entry]	   make it visible.
-\\[hide-leaves]	   make body under heading and under its subheadings invisible.
-		     The subheadings remain visible.
-\\[show-branches]  make all subheadings at all levels visible.
-
-The variable `outline-regexp' can be changed to control what is a heading.
-A line is a heading if `outline-regexp' matches something at the
-beginning of the line.  The longer the match, the deeper the level.
-
-Turning on outline mode calls the value of `text-mode-hook' and then of
-`outline-mode-hook', if they are non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (setq selective-display t)
-  (use-local-map outline-mode-map)
-  (setq mode-name "Outline")
-  (setq major-mode 'outline-mode)
-  (define-abbrev-table 'text-mode-abbrev-table ())
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (set-syntax-table text-mode-syntax-table)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat paragraph-start "\\|\\("
-				outline-regexp "\\)"))
-  ;; Inhibit auto-filling of header lines.
-  (make-local-variable 'auto-fill-inhibit-regexp)
-  (setq auto-fill-inhibit-regexp outline-regexp)
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate (concat paragraph-separate "\\|\\("
-				   outline-regexp "\\)"))
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(outline-font-lock-keywords t))
-  (make-local-variable 'change-major-mode-hook)
-  (add-hook 'change-major-mode-hook 'show-all)
-  (run-hooks 'text-mode-hook 'outline-mode-hook))
-
-(defvar outline-minor-mode-prefix "\C-c@"
-  "*Prefix key to use for Outline commands in Outline minor mode.
-The value of this variable is checked as part of loading Outline mode.
-After that, changing the prefix key requires manipulating keymaps.")
-
-(defvar outline-minor-mode-map nil)
-(if outline-minor-mode-map
-    nil
-  (setq outline-minor-mode-map (make-sparse-keymap))
-  (define-key outline-minor-mode-map [menu-bar]
-    outline-mode-menu-bar-map)
-  (define-key outline-minor-mode-map outline-minor-mode-prefix
-    outline-mode-prefix-map))
-
-(or (assq 'outline-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-	  (cons (cons 'outline-minor-mode outline-minor-mode-map)
-		minor-mode-map-alist)))
-
-;;;###autoload
-(defun outline-minor-mode (&optional arg)
-  "Toggle Outline minor mode.
-With arg, turn Outline minor mode on if arg is positive, off otherwise.
-See the command `outline-mode' for more information on this mode."
-  (interactive "P")
-  (setq outline-minor-mode
-	(if (null arg) (not outline-minor-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (if outline-minor-mode
-      (progn
-	(setq selective-display t)
-	(run-hooks 'outline-minor-mode-hook))
-    (setq selective-display nil))
-  ;; When turning off outline mode, get rid of any ^M's.
-  (or outline-minor-mode
-      (outline-flag-region (point-min) (point-max) ?\n))
-  (force-mode-line-update))
-
-(defvar outline-level 'outline-level
-  "Function of no args to compute a header's nesting level in an outline.
-It can assume point is at the beginning of a header line.")
-
-;; This used to count columns rather than characters, but that made ^L
-;; appear to be at level 2 instead of 1.  Columns would be better for
-;; tab handling, but the default regexp doesn't use tabs, and anyone
-;; who changes the regexp can also redefine the outline-level variable
-;; as appropriate.
-(defun outline-level ()
-  "Return the depth to which a statement is nested in the outline.
-Point must be at the beginning of a header line.  This is actually
-the number of characters that `outline-regexp' matches."
-  (save-excursion
-    (looking-at outline-regexp)
-    (- (match-end 0) (match-beginning 0))))
-
-(defun outline-next-preface ()
-  "Skip forward to just before the next heading line.
-If there's no following heading line, stop before the newline
-at the end of the buffer."
-  (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
-			 nil 'move)
-      (goto-char (match-beginning 0)))
-  (if (memq (preceding-char) '(?\n ?\^M))
-      (forward-char -1)))
-
-(defun outline-next-heading ()
-  "Move to the next (possibly invisible) heading line."
-  (interactive)
-  (if (re-search-forward (concat "[\n\^M]\\(" outline-regexp "\\)")
-			 nil 'move)
-      (goto-char (1+ (match-beginning 0)))))
-
-(defun outline-back-to-heading ()
-  "Move to previous heading line, or beg of this line if it's a heading.
-Only visible heading lines are considered."
-  (beginning-of-line)
-  (or (outline-on-heading-p)
-      (re-search-backward (concat "^\\(" outline-regexp "\\)") nil t)
-      (error "before first heading")))
-
-(defun outline-on-heading-p ()
-  "Return t if point is on a (visible) heading line."
-  (save-excursion
-    (beginning-of-line)
-    (and (bolp)
-	 (looking-at outline-regexp))))
-
-(defun outline-end-of-heading ()
-  (if (re-search-forward outline-heading-end-regexp nil 'move)
-      (forward-char -1)))
-
-(defun outline-next-visible-heading (arg)
-  "Move to the next visible heading line.
-With argument, repeats or can move backward if negative.
-A heading line is one that starts with a `*' (or that
-`outline-regexp' matches)."
-  (interactive "p")
-  (if (< arg 0)
-      (beginning-of-line)
-    (end-of-line))
-  (or (re-search-forward (concat "^\\(" outline-regexp "\\)") nil t arg)
-      (error ""))
-  (beginning-of-line))
-
-(defun outline-previous-visible-heading (arg)
-  "Move to the previous heading line.
-With argument, repeats or can move forward if negative.
-A heading line is one that starts with a `*' (or that
-`outline-regexp' matches)."
-  (interactive "p")
-  (outline-next-visible-heading (- arg)))
-
-(defun outline-flag-region (from to flag)
-  "Hides or shows lines from FROM to TO, according to FLAG.
-If FLAG is `\\n' (newline character) then text is shown,
-while if FLAG is `\\^M' (control-M) the text is hidden."
-  (let (buffer-read-only)
-    (subst-char-in-region from to
-			  (if (= flag ?\n) ?\^M ?\n)
-			  flag t)))
-
-(defun hide-entry ()
-  "Hide the body directly following this heading."
-  (interactive)
-  (outline-back-to-heading)
-  (outline-end-of-heading)
-  (save-excursion
-   (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\^M)))
-
-(defun show-entry ()
-  "Show the body directly following this heading."
-  (interactive)
-  (save-excursion
-   (outline-flag-region (point) (progn (outline-next-preface) (point)) ?\n)))
-
-(defun hide-body ()
-  "Hide all of buffer except headings."
-  (interactive)
-  (hide-region-body (point-min) (point-max)))
-
-(defun hide-region-body (start end)
-  "Hide all body lines in the region, but not headings."
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char (point-min))
-      (if (outline-on-heading-p)
-	  (outline-end-of-heading))
-      (while (not (eobp))
-	(outline-flag-region (point)
-			     (progn (outline-next-preface) (point)) ?\^M)
-	(if (not (eobp))
-	    (progn
-	      (forward-char
-	       (if (looking-at "[\n\^M][\n\^M]")
-		   2 1))
-	      (outline-end-of-heading)))))))
-
-(defun show-all ()
-  "Show all of the text in the buffer."
-  (interactive)
-  (outline-flag-region (point-min) (point-max) ?\n))
-
-(defun hide-subtree ()
-  "Hide everything after this heading at deeper levels."
-  (interactive)
-  (outline-flag-subtree ?\^M))
-
-(defun hide-leaves ()
-  "Hide all body after this heading at deeper levels."
-  (interactive)
-  (outline-back-to-heading)
-  (outline-end-of-heading)
-  (hide-region-body (point) (progn (outline-end-of-subtree) (point))))
-
-(defun show-subtree ()
-  "Show everything after this heading at deeper levels."
-  (interactive)
-  (outline-flag-subtree ?\n))
-
-(defun hide-sublevels (levels)
-  "Hide everything but the top LEVELS levels of headers, in whole buffer."
-  (interactive "p")
-  (if (< levels 1)
-      (error "Must keep at least one level of headers"))
-  (setq levels (1- levels))
-  (save-excursion
-    (goto-char (point-min))
-    ;; Keep advancing to the next top-level heading.
-    (while (or (and (bobp) (outline-on-heading-p))
-	       (outline-next-heading))
-      (let ((end (save-excursion (outline-end-of-subtree) (point))))
-	;; Hide everything under that.
-	(outline-flag-region (point) end ?\^M)
-	;; Show the first LEVELS levels under that.
-	(if (> levels 0)
-	    (show-children levels))
-	;; Move to the next, since we already found it.
-	(goto-char end)))))
-
-(defun hide-other ()
-  "Hide everything except for the current body and the parent headings."
-  (interactive)
-  (hide-sublevels 1)
-  (let ((last (point))
-	(pos (point)))
-    (while (save-excursion
-	     (and (re-search-backward "[\n\r]" nil t)
-		  (eq (following-char) ?\r)))
-      (save-excursion
-	(beginning-of-line)
-	(if (eq last (point))
-	    (progn
-	      (outline-next-heading)
-	      (outline-flag-region last (point) ?\n))
-	  (show-children)
-	  (setq last (point)))))))
-
-(defun outline-flag-subtree (flag)
-  (save-excursion
-    (outline-back-to-heading)
-    (outline-end-of-heading)
-    (outline-flag-region (point)
-			  (progn (outline-end-of-subtree) (point))
-			  flag)))
-
-(defun outline-end-of-subtree ()
-  (outline-back-to-heading)
-  (let ((opoint (point))
-	(first t)
-	(level (funcall outline-level)))
-    (while (and (not (eobp))
-		(or first (> (funcall outline-level) level)))
-      (setq first nil)
-      (outline-next-heading))
-    (if (memq (preceding-char) '(?\n ?\^M))
-	(progn
-	  ;; Go to end of line before heading
-	  (forward-char -1)
-	  (if (memq (preceding-char) '(?\n ?\^M))
-	      ;; leave blank line before heading
-	      (forward-char -1))))))
-
-(defun show-branches ()
-  "Show all subheadings of this heading, but not their bodies."
-  (interactive)
-  (show-children 1000))
-
-(defun show-children (&optional level)
-  "Show all direct subheadings of this heading.
-Prefix arg LEVEL is how many levels below the current level should be shown.
-Default is enough to cause the following heading to appear."
-  (interactive "P")
-  (setq level
-	(if level (prefix-numeric-value level)
-	  (save-excursion
-	    (outline-back-to-heading)
-	    (let ((start-level (funcall outline-level)))
-	      (outline-next-heading)
-	      (if (eobp)
-		  1
-		(max 1 (- (funcall outline-level) start-level)))))))
-  (save-excursion
-    (save-restriction
-      (outline-back-to-heading)
-      (setq level (+ level (funcall outline-level)))
-      (narrow-to-region (point)
-			(progn (outline-end-of-subtree)
-			       (if (eobp) (point-max) (1+ (point)))))
-      (goto-char (point-min))
-      (while (and (not (eobp))
-		  (progn
-		    (outline-next-heading)
-		    (not (eobp))))
-	(if (<= (funcall outline-level) level)
-	    (save-excursion
-	      (outline-flag-region (save-excursion
-				     (forward-char -1)
-				     (if (memq (preceding-char) '(?\n ?\^M))
-					 (forward-char -1))
-				     (point))
-				   (progn (outline-end-of-heading) (point))
-				   ?\n)))))))
-
-(defun outline-up-heading (arg)
-  "Move to the heading line of which the present line is a subheading.
-With argument, move up ARG levels."
-  (interactive "p")
-  (outline-back-to-heading)
-  (if (eq (funcall outline-level) 1)
-      (error ""))
-  (while (and (> (funcall outline-level) 1)
-	      (> arg 0)
-	      (not (bobp)))
-    (let ((present-level (funcall outline-level)))
-      (while (not (< (funcall outline-level) present-level))
-	(outline-previous-visible-heading 1))
-      (setq arg (- arg 1)))))
-
-(defun outline-forward-same-level (arg)
-  "Move forward to the ARG'th subheading at same level as this one.
-Stop at the first and last subheadings of a superior heading."
-  (interactive "p")
-  (outline-back-to-heading)
-  (while (> arg 0)
-    (let ((point-to-move-to (save-excursion
-			      (outline-get-next-sibling))))  
-      (if point-to-move-to
-	  (progn
-	    (goto-char point-to-move-to)
-	    (setq arg (1- arg)))
-	(progn
-	  (setq arg 0)
-	  (error ""))))))
-
-(defun outline-get-next-sibling ()
-  "Move to next heading of the same level, and return point or nil if none."
-  (let ((level (funcall outline-level)))
-    (outline-next-visible-heading 1)
-    (while (and (> (funcall outline-level) level)
-		(not (eobp)))
-      (outline-next-visible-heading 1))
-    (if (< (funcall outline-level) level)
-	nil
-      (point))))
-	
-(defun outline-backward-same-level (arg)
-  "Move backward to the ARG'th subheading at same level as this one.
-Stop at the first and last subheadings of a superior heading."
-  (interactive "p")
-  (outline-back-to-heading)
-  (while (> arg 0)
-    (let ((point-to-move-to (save-excursion
-			      (outline-get-last-sibling))))
-      (if point-to-move-to
-	  (progn
-	    (goto-char point-to-move-to)
-	    (setq arg (1- arg)))
-	(progn
-	  (setq arg 0)
-	  (error ""))))))
-
-(defun outline-get-last-sibling ()
-  "Move to next heading of the same level, and return point or nil if none."
-  (let ((level (funcall outline-level)))
-    (outline-previous-visible-heading 1)
-    (while (and (> (funcall outline-level) level)
-		(not (bobp)))
-      (outline-previous-visible-heading 1))
-    (if (< (funcall outline-level) level)
-	nil
-        (point))))
-
-(provide 'outline)
-
-;;; outline.el ends here
diff --git a/lisp/textmodes/outline.el b/lisp/textmodes/outline.el
deleted file mode 100644
index 6116c8116da..00000000000
--- a/lisp/textmodes/outline.el
+++ /dev/null
@@ -1,651 +0,0 @@
-;;; outline.el --- outline mode commands for Emacs
-
-;; Copyright (C) 1986, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: outlines
-
-;; 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 is a major mode for editing outline-format documents.
-;; An outline can be `abstracted' to show headers at any given level,
-;; with all stuff below hidden.  See the Emacs manual for details.
-
-;;; Code:
-
-;; Jan '86, Some new features added by Peter Desnoyers and rewritten by RMS.
-  
-(defvar outline-regexp nil
-  "*Regular expression to match the beginning of a heading.
-Any line whose beginning matches this regexp is considered to start a heading.
-The recommended way to set this is with a Local Variables: list
-in the file it applies to.  See also outline-heading-end-regexp.")
-
-;; Can't initialize this in the defvar above -- some major modes have
-;; already assigned a local value to it.
-(or (default-value 'outline-regexp)
-    (setq-default outline-regexp "[*\^L]+"))
-  
-(defvar outline-heading-end-regexp "\n"
-  "*Regular expression to match the end of a heading line.
-You can assume that point is at the beginning of a heading when this
-regexp is searched for.  The heading ends at the end of the match.
-The recommended way to set this is with a `Local Variables:' list
-in the file it applies to.")
-
-(defvar outline-mode-prefix-map nil)
-
-(if outline-mode-prefix-map
-    nil
-  (setq outline-mode-prefix-map (make-sparse-keymap))
-  (define-key outline-mode-prefix-map "\C-n" 'outline-next-visible-heading)
-  (define-key outline-mode-prefix-map "\C-p" 'outline-previous-visible-heading)
-  (define-key outline-mode-prefix-map "\C-i" 'show-children)
-  (define-key outline-mode-prefix-map "\C-s" 'show-subtree)
-  (define-key outline-mode-prefix-map "\C-d" 'hide-subtree)
-  (define-key outline-mode-prefix-map "\C-u" 'outline-up-heading)
-  (define-key outline-mode-prefix-map "\C-f" 'outline-forward-same-level)
-  (define-key outline-mode-prefix-map "\C-b" 'outline-backward-same-level)
-  (define-key outline-mode-prefix-map "\C-t" 'hide-body)
-  (define-key outline-mode-prefix-map "\C-a" 'show-all)
-  (define-key outline-mode-prefix-map "\C-c" 'hide-entry)
-  (define-key outline-mode-prefix-map "\C-e" 'show-entry)
-  (define-key outline-mode-prefix-map "\C-l" 'hide-leaves)
-  (define-key outline-mode-prefix-map "\C-k" 'show-branches)
-  (define-key outline-mode-prefix-map "\C-q" 'hide-sublevels)
-  (define-key outline-mode-prefix-map "\C-o" 'hide-other))
-
-(defvar outline-mode-menu-bar-map nil)
-(if outline-mode-menu-bar-map
-    nil
-  (setq outline-mode-menu-bar-map (make-sparse-keymap))
-
-  (define-key outline-mode-menu-bar-map [hide]
-    (cons "Hide" (make-sparse-keymap "Hide")))
-
-  (define-key outline-mode-menu-bar-map [hide hide-other]
-    '("Hide Other" . hide-other))
-  (define-key outline-mode-menu-bar-map [hide hide-sublevels]
-    '("Hide Sublevels" . hide-sublevels))
-  (define-key outline-mode-menu-bar-map [hide hide-subtree]
-    '("Hide Subtree" . hide-subtree))
-  (define-key outline-mode-menu-bar-map [hide hide-entry]
-    '("Hide Entry" . hide-entry))
-  (define-key outline-mode-menu-bar-map [hide hide-body]
-    '("Hide Body" . hide-body))
-  (define-key outline-mode-menu-bar-map [hide hide-leaves]
-    '("Hide Leaves" . hide-leaves))
-
-  (define-key outline-mode-menu-bar-map [show]
-    (cons "Show" (make-sparse-keymap "Show")))
-
-  (define-key outline-mode-menu-bar-map [show show-subtree]
-    '("Show Subtree" . show-subtree))
-  (define-key outline-mode-menu-bar-map [show show-children]
-    '("Show Children" . show-children))
-  (define-key outline-mode-menu-bar-map [show show-branches]
-    '("Show Branches" . show-branches))
-  (define-key outline-mode-menu-bar-map [show show-entry]
-    '("Show Entry" . show-entry))
-  (define-key outline-mode-menu-bar-map [show show-all]
-    '("Show All" . show-all))
-
-  (define-key outline-mode-menu-bar-map [headings]
-    (cons "Headings" (make-sparse-keymap "Headings")))
-
-  (define-key outline-mode-menu-bar-map [headings outline-backward-same-level]
-    '("Previous Same Level" . outline-backward-same-level))
-  (define-key outline-mode-menu-bar-map [headings outline-forward-same-level]
-    '("Next Same Level" . outline-forward-same-level))
-  (define-key outline-mode-menu-bar-map [headings outline-previous-visible-heading]
-    '("Previous" . outline-previous-visible-heading))
-  (define-key outline-mode-menu-bar-map [headings outline-next-visible-heading]
-    '("Next" . outline-next-visible-heading))
-  (define-key outline-mode-menu-bar-map [headings outline-up-heading]
-    '("Up" . outline-up-heading)))
-
-(defvar outline-mode-map nil "")
-
-(if outline-mode-map
-    nil
-  (setq outline-mode-map (nconc (make-sparse-keymap) text-mode-map))
-  (define-key outline-mode-map "\C-c" outline-mode-prefix-map)
-  (define-key outline-mode-map [menu-bar] outline-mode-menu-bar-map))
-
-(defvar outline-minor-mode nil
-  "Non-nil if using Outline mode as a minor mode of some other mode.")
-(make-variable-buffer-local 'outline-minor-mode)
-(or (assq 'outline-minor-mode minor-mode-alist)
-    (setq minor-mode-alist (append minor-mode-alist
-				   (list '(outline-minor-mode " Outl")))))
-
-(defvar outline-font-lock-keywords
-  '(;; Highlight headings according to the level.
-    ("^\\(\\*+\\)[ \t]*\\(.+\\)?[ \t]*$"
-     (1 font-lock-string-face)
-     (2 (let ((len (- (match-end 1) (match-beginning 1))))
-	  (or (cdr (assq len '((1 . font-lock-function-name-face)
-			       (2 . font-lock-keyword-face)
-			       (3 . font-lock-comment-face))))
-	      font-lock-variable-name-face))
-	nil t))
-    ;; Highlight citations of the form [1] and [Mar94].
-    ("\\[\\([A-Z][A-Za-z]+\\)*[0-9]+\\]" . font-lock-type-face))
-  "Additional expressions to highlight in Outline mode.")
-
-(defvar outline-view-change-hook nil
-  "Normal hook to be run after outline visibility changes.")
-
-;;;autoload
-(defun outline-mode ()
-  "Set major mode for editing outlines with selective display.
-Headings are lines which start with asterisks: one for major headings,
-two for subheadings, etc.  Lines not starting with asterisks are body lines. 
-
-Body text or subheadings under a heading can be made temporarily
-invisible, or visible again.  Invisible lines are attached to the end 
-of the heading, so they move with it, if the line is killed and yanked
-back.  A heading with text hidden under it is marked with an ellipsis (...).
-
-Commands:\\<outline-mode-map>
-\\[outline-next-visible-heading]   outline-next-visible-heading      move by visible headings
-\\[outline-previous-visible-heading]   outline-previous-visible-heading
-\\[outline-forward-same-level]   outline-forward-same-level        similar but skip subheadings
-\\[outline-backward-same-level]   outline-backward-same-level
-\\[outline-up-heading]   outline-up-heading		    move from subheading to heading
-
-\\[hide-body]	make all text invisible (not headings).
-\\[show-all]	make everything in buffer visible.
-
-The remaining commands are used when point is on a heading line.
-They apply to some of the body or subheadings of that heading.
-\\[hide-subtree]   hide-subtree	make body and subheadings invisible.
-\\[show-subtree]   show-subtree	make body and subheadings visible.
-\\[show-children]   show-children	make direct subheadings visible.
-		 No effect on body, or subheadings 2 or more levels down.
-		 With arg N, affects subheadings N levels down.
-\\[hide-entry]	   make immediately following body invisible.
-\\[show-entry]	   make it visible.
-\\[hide-leaves]	   make body under heading and under its subheadings invisible.
-		     The subheadings remain visible.
-\\[show-branches]  make all subheadings at all levels visible.
-
-The variable `outline-regexp' can be changed to control what is a heading.
-A line is a heading if `outline-regexp' matches something at the
-beginning of the line.  The longer the match, the deeper the level.
-
-Turning on outline mode calls the value of `text-mode-hook' and then of
-`outline-mode-hook', if they are non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map outline-mode-map)
-  (setq mode-name "Outline")
-  (setq major-mode 'outline-mode)
-  (define-abbrev-table 'text-mode-abbrev-table ())
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (set-syntax-table text-mode-syntax-table)
-  (make-local-variable 'line-move-ignore-invisible)
-  (setq line-move-ignore-invisible t)
-  ;; Cause use of ellipses for invisible text.
-  (setq buffer-invisibility-spec '((t . t)))
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat paragraph-start "\\|\\("
-				outline-regexp "\\)"))
-  ;; Inhibit auto-filling of header lines.
-  (make-local-variable 'auto-fill-inhibit-regexp)
-  (setq auto-fill-inhibit-regexp outline-regexp)
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate (concat paragraph-separate "\\|\\("
-				   outline-regexp "\\)"))
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(outline-font-lock-keywords t))
-  (make-local-variable 'change-major-mode-hook)
-  (add-hook 'change-major-mode-hook 'show-all)
-  (run-hooks 'text-mode-hook 'outline-mode-hook))
-
-(defvar outline-minor-mode-prefix "\C-c@"
-  "*Prefix key to use for Outline commands in Outline minor mode.
-The value of this variable is checked as part of loading Outline mode.
-After that, changing the prefix key requires manipulating keymaps.")
-
-(defvar outline-minor-mode-map nil)
-(if outline-minor-mode-map
-    nil
-  (setq outline-minor-mode-map (make-sparse-keymap))
-  (define-key outline-minor-mode-map [menu-bar]
-    outline-mode-menu-bar-map)
-  (define-key outline-minor-mode-map outline-minor-mode-prefix
-    outline-mode-prefix-map))
-
-(or (assq 'outline-minor-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-	  (cons (cons 'outline-minor-mode outline-minor-mode-map)
-		minor-mode-map-alist)))
-
-;;;autoload
-(defun outline-minor-mode (&optional arg)
-  "Toggle Outline minor mode.
-With arg, turn Outline minor mode on if arg is positive, off otherwise.
-See the command `outline-mode' for more information on this mode."
-  (interactive "P")
-  (setq outline-minor-mode
-	(if (null arg) (not outline-minor-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (if outline-minor-mode
-      (progn
-	(make-local-hook 'change-major-mode-hook)
-	;; Turn off this mode if we change major modes.
-	(add-hook 'change-major-mode-hook
-		  '(lambda () (outline-minor-mode -1))
-		  nil t)
-	(make-local-variable 'line-move-ignore-invisible)
-	(setq line-move-ignore-invisible t)
-	;; Cause use of ellipses for invisible text.
-	(setq buffer-invisibility-spec '((t . t)))
-	(run-hooks 'outline-minor-mode-hook))
-    (setq line-move-ignore-invisible nil)
-    ;; Cause use of ellipses for invisible text.
-    (setq buffer-invisibility-spec t))
-  ;; When turning off outline mode, get rid of any outline hiding.
-  (or outline-minor-mode
-      (show-all))
-  (force-mode-line-update))
-
-(defvar outline-level 'outline-level
-  "Function of no args to compute a header's nesting level in an outline.
-It can assume point is at the beginning of a header line.")
-
-;; This used to count columns rather than characters, but that made ^L
-;; appear to be at level 2 instead of 1.  Columns would be better for
-;; tab handling, but the default regexp doesn't use tabs, and anyone
-;; who changes the regexp can also redefine the outline-level variable
-;; as appropriate.
-(defun outline-level ()
-  "Return the depth to which a statement is nested in the outline.
-Point must be at the beginning of a header line.  This is actually
-the number of characters that `outline-regexp' matches."
-  (save-excursion
-    (looking-at outline-regexp)
-    (- (match-end 0) (match-beginning 0))))
-
-(defun outline-next-preface ()
-  "Skip forward to just before the next heading line.
-If there's no following heading line, stop before the newline
-at the end of the buffer."
-  (if (re-search-forward (concat "\n\\(" outline-regexp "\\)")
-			 nil 'move)
-      (goto-char (match-beginning 0)))
-  (if (bolp)
-      (forward-char -1)))
-
-(defun outline-next-heading ()
-  "Move to the next (possibly invisible) heading line."
-  (interactive)
-  (if (re-search-forward (concat "\n\\(" outline-regexp "\\)")
-			 nil 'move)
-      (goto-char (1+ (match-beginning 0)))))
-
-(defsubst outline-visible ()
-  "Non-nil if the character after point is visible."
-  (not (get-char-property (point) 'invisible)))
-
-(defun outline-back-to-heading ()
-  "Move to previous heading line, or beg of this line if it's a heading.
-Only visible heading lines are considered."
-  (beginning-of-line)
-  (or (outline-on-heading-p)
-      (let (found)
-	(save-excursion
-	  (while (not found)
-	    (or (re-search-backward (concat "^\\(" outline-regexp "\\)")
-				    nil t)
-		(error "before first heading"))
-	    (setq found (and (outline-visible) (point)))))
-	(goto-char found)
-	found)))
-
-(defun outline-on-heading-p ()
-  "Return t if point is on a (visible) heading line."
-  (save-excursion
-    (beginning-of-line)
-    (and (bolp) (outline-visible)
-	 (looking-at outline-regexp))))
-
-(defun outline-end-of-heading ()
-  (if (re-search-forward outline-heading-end-regexp nil 'move)
-      (forward-char -1)))
-
-(defun outline-next-visible-heading (arg)
-  "Move to the next visible heading line.
-With argument, repeats or can move backward if negative.
-A heading line is one that starts with a `*' (or that
-`outline-regexp' matches)."
-  (interactive "p")
-  (if (< arg 0)
-      (beginning-of-line)
-    (end-of-line))
-  (while (and (not (bobp)) (< arg 0))
-    (while (and (not (bobp))
-		(re-search-backward (concat "^\\(" outline-regexp "\\)")
-				    nil 'move)
-		(not (outline-visible))))
-    (setq arg (1+ arg)))
-  (while (and (not (eobp)) (> arg 0))
-    (while (and (not (eobp))
-		(re-search-forward (concat "^\\(" outline-regexp "\\)")
-				   nil 'move)
-		(not (outline-visible))))
-    (setq arg (1- arg)))
-  (beginning-of-line))
-
-(defun outline-previous-visible-heading (arg)
-  "Move to the previous heading line.
-With argument, repeats or can move forward if negative.
-A heading line is one that starts with a `*' (or that
-`outline-regexp' matches)."
-  (interactive "p")
-  (outline-next-visible-heading (- arg)))
-
-(defun outline-flag-region (from to flag)
-  "Hides or shows lines from FROM to TO, according to FLAG.
-If FLAG is nil then text is shown, while if FLAG is t the text is hidden."
-  (let ((inhibit-read-only t))
-    (save-excursion
-      (goto-char from)
-      (end-of-line)
-      (outline-discard-overlays (point) to 'outline)
-      (if flag
-	  (let ((o (make-overlay (point) to)))
-	    (overlay-put o 'invisible flag)
-	    (overlay-put o 'outline t)))))
-  (run-hooks 'outline-view-change-hook))
-
-;; Exclude from the region BEG ... END all overlays
-;; with a non-nil PROP property.
-;; Exclude them by shrinking them to exclude BEG ... END,
-;; or even by splitting them if necessary.
-;; Overlays without a non-nil PROP property are not touched.
-(defun outline-discard-overlays (beg end prop)
-  (if (< end beg)
-      (setq beg (prog1 end (setq end beg))))
-  (save-excursion
-    (let ((overlays (overlays-in beg end)))
-      (while overlays
-	(let ((o (car overlays)))
-	  (if (overlay-get o prop)
-	      ;; Either push this overlay outside beg...end
-	      ;; or split it to exclude beg...end
-	      ;; or delete it entirely (if it is contained in beg...end).
-	      (if (< (overlay-start o) beg)
-		  (if (> (overlay-end o) end)
-		      (let ((o1 (outline-copy-overlay o)))
-			(move-overlay o1 (overlay-start o1) beg)
-		    (move-overlay o (overlay-start o) beg)))
-		(if (> (overlay-end o) end)
-		    (move-overlay o end (overlay-end o))
-		  (delete-overlay o)))))
-	(setq overlays (cdr overlays))))))
-
-;; Make a copy of overlay O, with the same beginning, end and properties.
-(defun outline-copy-overlay (o)
-  (let ((o1 (make-overlay (overlay-start o) (overlay-end o)
-			  (overlay-buffer o)))
-	(props (overlay-properties o)))
-    (while props
-      (overlay-put o1 (car props) (nth 1 props))
-      (setq props (cdr (cdr props))))
-    o1))
-
-(defun hide-entry ()
-  "Hide the body directly following this heading."
-  (interactive)
-  (outline-back-to-heading)
-  (outline-end-of-heading)
-  (save-excursion
-   (outline-flag-region (point) (progn (outline-next-preface) (point)) t)))
-
-(defun show-entry ()
-  "Show the body directly following this heading."
-  (interactive)
-  (save-excursion
-   (outline-flag-region (point) (progn (outline-next-preface) (point)) nil)))
-
-(defun hide-body ()
-  "Hide all of buffer except headings."
-  (interactive)
-  (hide-region-body (point-min) (point-max)))
-
-(defun hide-region-body (start end)
-  "Hide all body lines in the region, but not headings."
-  (save-excursion
-    (save-restriction
-      (narrow-to-region start end)
-      (goto-char (point-min))
-      (if (outline-on-heading-p)
-	  (outline-end-of-heading))
-      (while (not (eobp))
-	(outline-flag-region (point)
-			     (progn (outline-next-preface) (point)) t)
-	(if (not (eobp))
-	    (progn
-	      (forward-char
-	       (if (looking-at "\n\n")
-		   2 1))
-	      (outline-end-of-heading)))))))
-
-(defun show-all ()
-  "Show all of the text in the buffer."
-  (interactive)
-  (outline-flag-region (point-min) (point-max) nil))
-
-(defun hide-subtree ()
-  "Hide everything after this heading at deeper levels."
-  (interactive)
-  (outline-flag-subtree t))
-
-(defun hide-leaves ()
-  "Hide all body after this heading at deeper levels."
-  (interactive)
-  (outline-back-to-heading)
-  (outline-end-of-heading)
-  (hide-region-body (point) (progn (outline-end-of-subtree) (point))))
-
-(defun show-subtree ()
-  "Show everything after this heading at deeper levels."
-  (interactive)
-  (outline-flag-subtree nil))
-
-(defun hide-sublevels (levels)
-  "Hide everything but the top LEVELS levels of headers, in whole buffer."
-  (interactive "p")
-  (if (< levels 1)
-      (error "Must keep at least one level of headers"))
-  (setq levels (1- levels))
-  (save-excursion
-    (goto-char (point-min))
-    ;; Keep advancing to the next top-level heading.
-    (while (or (and (bobp) (outline-on-heading-p))
-	       (outline-next-heading))
-      (let ((end (save-excursion (outline-end-of-subtree) (point))))
-	;; Hide everything under that.
-	(outline-flag-region (point) end t)
-	;; Show the first LEVELS levels under that.
-	(if (> levels 0)
-	    (show-children levels))
-	;; Move to the next, since we already found it.
-	(goto-char end)))))
-
-(defun hide-other ()
-  "Hide everything except for the current body and the parent headings."
-  (interactive)
-  (hide-sublevels 1)
-  (let ((last (point))
-	(pos (point)))
-    (while (save-excursion
-	     (and (end-of-line 0)
-		  (not (outline-visible))))
-      (save-excursion
-	(beginning-of-line)
-	(if (eq last (point))
-	    (progn
-	      (outline-next-heading)
-	      (outline-flag-region last (point) nil))
-	  (show-children)
-	  (setq last (point)))))))
-
-(defun outline-flag-subtree (flag)
-  (save-excursion
-    (outline-back-to-heading)
-    (outline-end-of-heading)
-    (outline-flag-region (point)
-			  (progn (outline-end-of-subtree) (point))
-			  flag)))
-
-(defun outline-end-of-subtree ()
-  (outline-back-to-heading)
-  (let ((opoint (point))
-	(first t)
-	(level (funcall outline-level)))
-    (while (and (not (eobp))
-		(or first (> (funcall outline-level) level)))
-      (setq first nil)
-      (outline-next-heading))
-    (if (bolp)
-	(progn
-	  ;; Go to end of line before heading
-	  (forward-char -1)
-	  (if (bolp)
-	      ;; leave blank line before heading
-	      (forward-char -1))))))
-
-(defun show-branches ()
-  "Show all subheadings of this heading, but not their bodies."
-  (interactive)
-  (show-children 1000))
-
-(defun show-children (&optional level)
-  "Show all direct subheadings of this heading.
-Prefix arg LEVEL is how many levels below the current level should be shown.
-Default is enough to cause the following heading to appear."
-  (interactive "P")
-  (setq level
-	(if level (prefix-numeric-value level)
-	  (save-excursion
-	    (outline-back-to-heading)
-	    (let ((start-level (funcall outline-level)))
-	      (outline-next-heading)
-	      (if (eobp)
-		  1
-		(max 1 (- (funcall outline-level) start-level)))))))
-  (save-excursion
-    (save-restriction
-      (outline-back-to-heading)
-      (setq level (+ level (funcall outline-level)))
-      (narrow-to-region (point)
-			(progn (outline-end-of-subtree)
-			       (if (eobp) (point-max) (1+ (point)))))
-      (goto-char (point-min))
-      (while (and (not (eobp))
-		  (progn
-		    (outline-next-heading)
-		    (not (eobp))))
-	(if (<= (funcall outline-level) level)
-	    (save-excursion
-	      (outline-flag-region (save-excursion
-				     (forward-char -1)
-				     (if (bolp)
-					 (forward-char -1))
-				     (point))
-				   (progn (outline-end-of-heading) (point))
-				   nil)))))))
-
-(defun outline-up-heading (arg)
-  "Move to the heading line of which the present line is a subheading.
-With argument, move up ARG levels."
-  (interactive "p")
-  (outline-back-to-heading)
-  (if (eq (funcall outline-level) 1)
-      (error "Already at top level of the outline"))
-  (while (and (> (funcall outline-level) 1)
-	      (> arg 0)
-	      (not (bobp)))
-    (let ((present-level (funcall outline-level)))
-      (while (not (< (funcall outline-level) present-level))
-	(outline-previous-visible-heading 1))
-      (setq arg (- arg 1)))))
-
-(defun outline-forward-same-level (arg)
-  "Move forward to the ARG'th subheading at same level as this one.
-Stop at the first and last subheadings of a superior heading."
-  (interactive "p")
-  (outline-back-to-heading)
-  (while (> arg 0)
-    (let ((point-to-move-to (save-excursion
-			      (outline-get-next-sibling))))  
-      (if point-to-move-to
-	  (progn
-	    (goto-char point-to-move-to)
-	    (setq arg (1- arg)))
-	(progn
-	  (setq arg 0)
-	  (error "No following same-level heading"))))))
-
-(defun outline-get-next-sibling ()
-  "Move to next heading of the same level, and return point or nil if none."
-  (let ((level (funcall outline-level)))
-    (outline-next-visible-heading 1)
-    (while (and (> (funcall outline-level) level)
-		(not (eobp)))
-      (outline-next-visible-heading 1))
-    (if (< (funcall outline-level) level)
-	nil
-      (point))))
-	
-(defun outline-backward-same-level (arg)
-  "Move backward to the ARG'th subheading at same level as this one.
-Stop at the first and last subheadings of a superior heading."
-  (interactive "p")
-  (outline-back-to-heading)
-  (while (> arg 0)
-    (let ((point-to-move-to (save-excursion
-			      (outline-get-last-sibling))))
-      (if point-to-move-to
-	  (progn
-	    (goto-char point-to-move-to)
-	    (setq arg (1- arg)))
-	(progn
-	  (setq arg 0)
-	  (error "No previous same-level heading"))))))
-
-(defun outline-get-last-sibling ()
-  "Move to next heading of the same level, and return point or nil if none."
-  (let ((level (funcall outline-level)))
-    (outline-previous-visible-heading 1)
-    (while (and (> (funcall outline-level) level)
-		(not (bobp)))
-      (outline-previous-visible-heading 1))
-    (if (< (funcall outline-level) level)
-	nil
-        (point))))
-
-(provide 'outline)
-(provide 'noutline)
-
-;;; outline.el ends here
diff --git a/lisp/textmodes/page-ext.el b/lisp/textmodes/page-ext.el
deleted file mode 100644
index bc5e971b141..00000000000
--- a/lisp/textmodes/page-ext.el
+++ /dev/null
@@ -1,772 +0,0 @@
-;;; page-ext.el --- extended page handling commands
-
-;; Copyright (C) 1990, 1991, 1993, 1994 Free Software Foundation
-
-;; Maintainer: Robert J. Chassell <bob@gnu.ai.mit.edu>
-
-;; 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:
-
-;; You may use these commands to handle an address list or other
-;; small data base.
-
-
-;;; Summary
-
-;; The current page commands are:
-
-;;     forward-page         C-x ]
-;;     backward-page        C-x [
-;;     narrow-to-page       C-x p
-;;     count-lines-page     C-x l
-;;     mark-page            C-x C-p  (change this to C-x C-p C-m)
-;;     sort-pages           not bound
-;;     what-page            not bound
-
-;; The new page handling commands all use `C-x C-p' as a prefix.  This
-;; means that the key binding for `mark-page' must be changed.
-;; Otherwise, no other changes are made to the current commands or
-;; their bindings.
-
-;; New page handling commands:
-
-;;     next-page                        C-x C-p C-n
-;;     previous-page                    C-x C-p C-p
-;;     search-pages                     C-x C-p C-s
-;;     add-new-page                     C-x C-p C-a
-;;     sort-pages-buffer                C-x C-p s      
-;;     set-page-delimiter               C-x C-p C-l
-;;     pages-directory                  C-x C-p C-d   
-;;     pages-directory-for-addresses    C-x C-p d
-;;        pages-directory-goto          C-c C-c
-
-
-;;; Using the page commands
- 
-;; The page commands are helpful in several different contexts.  For
-;; example, programmers often divide source files into sections using the
-;; `page-delimiter'; you can use the `pages-directory' command to list
-;; the sections.
-
-;; You may change the buffer local value of the `page-delimiter' with
-;; the `set-page-delimiter' command.  This command is bound to `C-x C-p
-;; C-l' The command prompts you for a new value for the page-delimiter.
-;; Called with a prefix-arg, the command resets the value of the
-;; page-delimiter to its original value.
-
-;; You may set several user options:
-;;
-;;   The `pages-directory-buffer-narrowing-p' variable causes the
-;;   `pages-directory-goto' command to narrow to the destination page.
-;;
-;;   The `pages-directory-for-adding-page-narrowing-p' variable, causes the
-;;   `add-new-page' command to narrow to the new entry.
-;;
-;;   The `pages-directory-for-adding-new-page-before-current-page-p' variable
-;;   causes the `add-new-page' command to insert a new page before current
-;;   page.
-;;
-;; These variables are true by default.
-;;
-;; Additional, addresses-related user options are described in the next page
-;; of this file.
-
-
-;;; Handling an address list or small data base
-
-;; You may use the page commands to handle an address list or other
-;; small data base.  Put each address or entry on its own page.  The
-;; first line of text in each page is a `header line' and is listed by
-;; the `pages-directory' or `pages-directory-for-addresses' command.
-
-;; Specifically:
-;; 
-;;   1. Begin each entry with a `page-delimiter' (which is, by default,
-;;      `^L' at the beginning of the line).
-;; 
-;;   2. The first line of text in each entry is the `heading line'; it
-;;      will appear in the pages-directory-buffer which is constructed
-;;      using the `C-x C-p C-d' (pages-directory) command or the `C-x
-;;      C-p d' (pages-directory-for-addresses) command.
-;; 
-;;      The heading line may be on the same line as the page-delimiter
-;;      or it may follow after.  It is the first non-blank line on the
-;;      page.  Conventionally, the heading line is placed on the line
-;;      immediately following the line containing page-delimiter.
-;;
-;;   3. Follow the heading line with the body of the entry.  The body
-;;      extends up to the next `page-delimiter'.  The body may be of any
-;;      length.  It is conventional to place a blank line after the last
-;;      line of the body.
-
-;; For example, a file might look like this:
-;; 
-;;     FSF
-;;     Free Software Foundation
-;;     59 Temple Place - Suite 330
-;;     Boston, MA 02111-1307  USA.
-;;     (617) 542-5942
-;;     gnu@prep.ai.mit.edu
-;; 
-;;     
-;;     House Subcommittee on Intellectual Property,
-;;     U.S. House of Representatives,
-;;     Washington, DC  20515
-;;     
-;;     Congressional committee concerned with permitting or preventing
-;;     monopolistic restrictions on the use of software technology.
-;; 
-;;     
-;;     George Lakoff
-;;     ``Women, Fire, and Dangerous Things:
-;;     What Categories Reveal about the Mind''
-;;     1987, Univ. of Chicago Press
-;; 
-;;     About philosophy, Whorfian effects, and linguistics.
-;; 
-;;      
-;;     OBI   (On line text collection.)
-;;     Open Book Initiative
-;;     c/o Software Tool & Die
-;;     1330 Beacon St, Brookline, MA 02146 USA
-;;     (617) 739-0202 
-;;     obi@world.std.com
-
-;; In this example, the heading lines are:
-;;
-;;     FSF
-;;     House Subcommittee on Intellectual Property
-;;     George Lakoff
-;;     OBI (On line text collection.)
-
-;; The `C-x C-p s' (sort-pages-buffer) command sorts the entries in the
-;; buffer alphabetically.
-
-;; You may use any of the page commands, including the `next-page',
-;; `previous-page', `add-new-page', `mark-page', and `search-pages'
-;; commands.
-
-;; You may use either the `C-x C-p d' (pages-directory-for-addresses)
-;; or the `C-x C-p C-d' (pages-directory) command to construct and
-;; display a directory of all the heading lines.
-
-;; In the directory, you may position the cursor over a heading line
-;; and type `C-c C-c' (pages-directory-goto) to go to the entry to
-;; which it refers in the pages buffer.
-
-;; You can type `C-c C-p C-a' (add-new-page) to add a new entry in the
-;; pages buffer or address file.  This is the same command you use to
-;; add a new entry when you are in the pages buffer or address file.
-
-;; If you wish, you may create several different directories,
-;; one for each different buffer.
-
-;; `pages-directory-for-addresses' in detail
-
-;; The `pages-directory-for-addresses' assumes a default addresses
-;; file.  You do not need to specify the addresses file but merely type
-;; `C-x C-p d' from any buffer.  The command finds the file, constructs
-;; a directory for it, and switches you to the directory.  If you call
-;; the command with a prefix arg, `C-u C-x C-p d', it prompts you for a
-;; file name.
-
-;; You may customize the addresses commands:
-
-;;   The `pages-addresses-file-name' variable determines the name of
-;;   the addresses file; by default it is "~/addresses".
-
-;;   The `pages-directory-for-addresses-goto-narrowing-p' variable
-;;   determines whether `pages-directory-goto' narrows the addresses
-;;   buffer to the entry, which it does by default.
-
-;;   The `pages-directory-for-addresses-buffer-keep-windows-p' variable
-;;   determines whether `pages-directory-for-addresses' deletes other
-;;   windows to show as many lines as possible on the screen or works
-;;   in the usual Emacs manner and keeps other windows.  Default is to
-;;   keep other windows.
-
-;;   The `pages-directory-for-adding-addresses-narrowing-p' variable
-;;   determines whether `pages-directory-for-addresses' narrows the
-;;   addresses buffer to a new entry when you are adding that entry.
-;;   Default is to narrow to new entry, which means you see a blank
-;;   screen before you write the new entry.
-
-;; `pages-directory' in detail
-
-;; Call the `pages-directory' command from the buffer for which you
-;; want a directory created; it creates a directory for the buffer and
-;; pops you to the directory.
-
-;; The `pages-directory' command has several options:
-
-;;   Called with a prefix arg, `C-u C-x C-p C-d', the `pages-directory'
-;;   prompts you for a regular expression and only lists only those
-;;   header lines that are part of pages that contain matches to the
-;;   regexp.  In the example above, `C-u C-x C-p C-d 617 RET' would
-;;   match the telephone area code of the first and fourth entries, so
-;;   only the header lines of those two entries would appear in the
-;;   pages-directory-buffer.
-;; 
-;;   Called with a numeric argument, the `pages-directory' command
-;;   lists the number of lines in each page.  This is helpful when you
-;;   are printing hardcopy.  
-
-;;   Called with a negative numeric argument, the `pages-directory'
-;;   command lists the lengths of pages whose contents match a regexp.
-
-;;; Code:
-
-
-;;; Customarily customizable variable definitions
-
-(defvar pages-directory-buffer-narrowing-p t
-  "*If non-nil, `pages-directory-goto' narrows pages buffer to entry.")
-
-(defvar pages-directory-for-adding-page-narrowing-p t
-  "*If non-nil, `add-new-page' narrows page buffer to new entry.")
-
-(defvar pages-directory-for-adding-new-page-before-current-page-p t
-  "*If non-nil, `add-new-page' inserts new page before current page.")
-
-
-;;; Addresses related variables
-
-(defvar pages-addresses-file-name "~/addresses"
-  "*Standard name for file of addresses. Entries separated by page-delimiter.
-Used by `pages-directory-for-addresses' function.")
-
-(defvar pages-directory-for-addresses-goto-narrowing-p t
-  "*If non-nil, `pages-directory-goto' narrows addresses buffer to entry.")
-
-(defvar pages-directory-for-addresses-buffer-keep-windows-p t
-  "*If nil, `pages-directory-for-addresses' deletes other windows.")
-
-(defvar pages-directory-for-adding-addresses-narrowing-p t
-  "*If non-nil, `add-new-page' narrows addresses buffer to new entry.")
-
-
-;;; Key bindings for page handling functions
-
-(global-unset-key "\C-x\C-p")
-
-(defvar ctl-x-ctl-p-map (make-sparse-keymap)
-  "Keymap for subcommands of C-x C-p, which are for page handling.")
-
-(define-key ctl-x-map "\C-p" 'ctl-x-ctl-p-prefix)
-(fset 'ctl-x-ctl-p-prefix ctl-x-ctl-p-map)
-
-(define-key ctl-x-ctl-p-map "\C-n" 'next-page)
-(define-key ctl-x-ctl-p-map "\C-p" 'previous-page)
-(define-key ctl-x-ctl-p-map "\C-a" 'add-new-page)
-(define-key ctl-x-ctl-p-map "\C-m" 'mark-page)
-(define-key ctl-x-ctl-p-map "\C-s" 'search-pages)
-(define-key ctl-x-ctl-p-map "s"    'sort-pages-buffer)
-(define-key ctl-x-ctl-p-map "\C-l" 'set-page-delimiter)
-(define-key ctl-x-ctl-p-map "\C-d" 'pages-directory)
-(define-key ctl-x-ctl-p-map "d"    'pages-directory-for-addresses)
-
-
-;;; Page movement function definitions
-
-(defun next-page (&optional count)
-  "Move to the next page bounded by the `page-delimiter' variable.
-With arg (prefix if interactive), move that many pages."
-  (interactive "p")
-  (or count (setq count 1))
-  (widen)
-  ;; Cannot use forward-page because of problems at page boundaries.
-  (while (and (> count 0) (not (eobp)))
-    (if (re-search-forward page-delimiter nil t)
-        nil
-      (goto-char (point-max)))
-    (setq count (1- count)))
-  ;; If COUNT is negative, we want to go back -COUNT + 1 page boundaries.
-  ;; The first page boundary we reach is the top of the current page,
-  ;; which doesn't count.
-  (while (and (< count 1) (not (bobp)))
-    (if (re-search-backward page-delimiter nil t)
-	(goto-char (match-beginning 0))
-      (goto-char (point-min)))
-    (setq count (1+ count)))
-  (narrow-to-page)
-  (goto-char (point-min))
-  (recenter 0))
-
-(defun previous-page (&optional count)
-  "Move to the previous page bounded by the `page-delimiter' variable.
-With arg (prefix if interactive), move that many pages."
-  (interactive "p")
-  (or count (setq count 1))
-  (next-page (- count)))
-
-
-;;; Adding and searching pages
-
-(defun add-new-page (header-line)
-  "Insert new page.  Prompt for header line.
-
-If point is in the pages directory buffer, insert the new page in the
-buffer associated with the directory.
-
-Insert the new page just before current page if
-  pages-directory-for-adding-new-page-before-current-page-p  variable
-is non-nil.  Else insert at exact location of point.
-
-Narrow to new page if
-  pages-directory-for-adding-page-narrowing-p variable
-is non-nil.
-
-Page begins with a `^L' as the default page-delimiter.  
-Use \\[set-page-delimiter] to change the page-delimiter.
-Point is left in the body of page."
-  (interactive "sHeader line: ")
-  (widen)
-  ;; If in pages directory buffer
-  (if (eq major-mode 'pages-directory-mode) 
-      (progn
-        ;; Add new page before or after current page?
-        (if pages-directory-for-adding-new-page-before-current-page-p
-            (pages-directory-goto)
-          (pages-directory-goto)
-          (forward-page)
-          (or (eobp) (forward-line -1)))))
-  (widen)
-  ;; Move point before current delimiter if desired.
-  (and pages-directory-for-adding-new-page-before-current-page-p
-       (if (re-search-backward page-delimiter nil t)
-           (goto-char (match-beginning 0))
-         ;; If going to beginning of file, insert a page-delimiter
-         ;; before current first page.
-         (goto-char (point-min))
-         (insert
-          (format "%s\n"
-                  ;; Remove leading `^' from page-delimiter string
-                  (if (eq '^ (car (read-from-string page-delimiter)))
-                      (substring page-delimiter 1))))         
-         (goto-char (point-min))))
-  ;; Insert page delimiter at beginning of line.
-  (if (not (looking-at "^."))   (forward-line 1))
-  (insert (format "%s\n%s\n\n\n" 
-                  (if (eq '^ (car (read-from-string page-delimiter)))
-                      (substring page-delimiter 1))
-                  header-line))
-  (forward-line -1)
-  (and pages-directory-for-adding-page-narrowing-p (narrow-to-page)))
-
-(defvar pages-last-search nil
-  "Value of last regexp searched for.  Initially, nil.")
-
-(defun search-pages (regexp)
-  "Search for REGEXP, starting from point, and narrow to page it is in."
-  (interactive (list
-                (read-string
-                 (format "Search for `%s' (end with RET): "
-                         (or pages-last-search "regexp")))))
-  (if (equal regexp "")
-      (setq regexp pages-last-search)
-    (setq pages-last-search regexp))
-  (widen)
-  (re-search-forward regexp)
-  (narrow-to-page))
-
-
-;;; Sorting pages
-
-(autoload 'sort-subr "sort" "Primary function for sorting." t nil)
-
-(defun sort-pages-in-region (reverse beg end)
-  "Sort pages in region alphabetically.  Prefix arg means reverse order.  
-
-Called from a program, there are three arguments:
-REVERSE (non-nil means reverse order), BEG and END (region to sort)."
-
-;;; This sort function handles ends of pages differently than
-;;; `sort-pages' and works better with lists of addresses and similar
-;;; files.
-
-  (interactive "P\nr")
-  (save-restriction
-    (narrow-to-region beg end)
-    (goto-char (point-min))
-    ;;; `sort-subr' takes three arguments
-    (sort-subr reverse
-
-               ;; NEXTRECFUN is called with point at the end of the
-               ;; previous record. It moves point to the start of the
-               ;; next record.
-	       (function (lambda ()
-                           (re-search-forward page-delimiter nil t)
-                           (skip-chars-forward " \t\n")
-                           ))
-
-               ;; ENDRECFUN is is called with point within the record.
-               ;; It should move point to the end of the record.
-	       (function (lambda ()
-                           (if (re-search-forward
-                                page-delimiter
-                                nil
-                                t)
-                               (goto-char (match-beginning 0))
-                             (goto-char (point-max))))))))
-
-(defun sort-pages-buffer (&optional reverse)
-  "Sort pages alphabetically in buffer.  Prefix arg means reverse order. 
-\(Non-nil arg if not interactive.\)"
-
-  (interactive "P")
-  (or reverse (setq reverse nil))
-  (widen)
-  (let ((beginning (point-min))
-        (end (point-max)))
-    (sort-pages-in-region reverse beginning end)))
-
-
-;;; Pages directory ancillary definitions
-
-(defvar pages-directory-previous-regexp nil
-  "Value of previous regexp used by `pages-directory'.
-\(This regular expression may be used to select only those pages that
-contain matches to the regexp.\)")
-
-(defvar pages-buffer nil
-  "The buffer for which the pages-directory function creates the directory.")
-
-(defvar pages-directory-prefix "*Directory for:"
-  "Prefix of name of temporary buffer for pages-directory.")
-
-(defvar pages-pos-list nil
-  "List containing the positions of the pages in the pages-buffer.")
-
-(defvar pages-directory-map nil
-  "Keymap for the pages-directory-buffer.")
-
-(if pages-directory-map
-    ()
-  (setq pages-directory-map (make-sparse-keymap))
-  (define-key pages-directory-map "\C-c\C-c"
-    'pages-directory-goto)
-  (define-key pages-directory-map "\C-c\C-p\C-a" 'add-new-page))
-
-(defvar original-page-delimiter "^\f"
-  "Default page delimiter.")
-
-(defun set-page-delimiter (regexp reset-p)
-  "Set buffer local value of page-delimiter to REGEXP.
-Called interactively with a prefix argument, reset `page-delimiter' to
-its original value.
-
-In a program, non-nil second arg causes first arg to be ignored and
-resets the page-delimiter to the original value."
-  
-  (interactive
-   (if current-prefix-arg
-       (list original-page-delimiter "^\f")
-     (list (read-string "Set page-delimiter to regexp: " page-delimiter)
-           nil)))
-  (make-local-variable 'original-page-delimiter)
-  (make-local-variable 'page-delimiter)
-  (setq original-page-delimiter
-        (or original-page-delimiter page-delimiter))
-  (if (not reset-p)
-      (setq page-delimiter regexp)
-    (setq page-delimiter original-page-delimiter))
-  (if (interactive-p)
-      (message "The value of `page-delimiter' is now: %s" page-delimiter)))
-
-
-;;; Pages directory main definitions
-
-(defun pages-directory
-  (pages-list-all-headers-p count-lines-p &optional regexp)
-  "Display a directory of the page headers in a temporary buffer.
-A header is the first non-blank line after the page-delimiter.
-\\[pages-directory-mode]
-You may move point to one of the lines in the temporary buffer,
-then use \\<pages-directory-goto> to go to the same line in the pages buffer.
-
-In interactive use:
-
-    1. With no prefix arg, display all headers.
-
-    2. With prefix arg, display the headers of only those pages that
-       contain matches to a regular expression for which you are
-       prompted.
-
-    3. With numeric prefix arg, for every page, print the number of
-       lines within each page.
-
-    4. With negative numeric prefix arg, for only those pages that
-       match a regular expression, print the number of lines within
-       each page.
-
-When called from a program, non-nil first arg means list all headers;
-non-nil second arg means print numbers of lines in each page; if first
-arg is nil, optional third arg is regular expression.
-
-If the buffer is narrowed, the `pages-directory' command creates a
-directory for only the accessible portion of the buffer."
-  
-  (interactive
-   (cond ((not current-prefix-arg)
-          (list t nil nil))
-         ((listp current-prefix-arg) 
-          (list nil
-                nil
-                (read-string
-                 (format "Select according to `%s' (end with RET): "
-                         (or pages-directory-previous-regexp "regexp")))))
-         ((> (prefix-numeric-value current-prefix-arg) 0)
-          (list t t nil))
-         ((< (prefix-numeric-value current-prefix-arg) 0)          
-          (list nil
-                t
-                (read-string
-                 (format "Select according to `%s' (end with RET): "
-                         (or pages-directory-previous-regexp "regexp")))))))
-  
-  (if (equal regexp "")
-      (setq regexp pages-directory-previous-regexp)
-    (setq pages-directory-previous-regexp regexp))
-  
-  (if (interactive-p)
-      (message "Creating directory for: %s "
-               (buffer-name)))
-  
-  (let ((target-buffer (current-buffer))
-        (pages-directory-buffer
-	 (concat pages-directory-prefix " " (buffer-name)))
-        (linenum 1)
-        (pages-buffer-original-position (point))
-        (pages-buffer-original-page 0))
-    
-    ;; `with-output-to-temp-buffer' binds the value of the variable
-    ;; `standard-output' to the buffer named as its first argument,
-    ;; but does not switch to that buffer.
-    (with-output-to-temp-buffer pages-directory-buffer
-      (save-excursion
-        (set-buffer standard-output)
-        (pages-directory-mode)
-        (insert
-         "==== Pages Directory: use `C-c C-c' to go to page under cursor. ====" ?\n)
-        (setq pages-buffer target-buffer)
-        (setq pages-pos-list nil))
-      
-      (if pages-list-all-headers-p
-          
-          ;; 1. If no prefix argument, list all headers
-          (save-excursion
-            (goto-char (point-min))
-            
-            ;; (a) Point is at beginning of buffer; but the first
-            ;;     page may not begin with a page-delimiter
-            (save-restriction
-              ;; If page delimiter is at beginning of buffer, skip it
-              (if (and (save-excursion
-                         (re-search-forward page-delimiter nil t))
-                       (= 1 (match-beginning 0)))
-                  (goto-char (match-end 0)))
-              (narrow-to-page)
-              (pages-copy-header-and-position count-lines-p))
-            
-            ;; (b) Search within pages buffer for next page-delimiter
-            (while (re-search-forward page-delimiter nil t)
-              (pages-copy-header-and-position count-lines-p)))
-        
-        ;; 2. Else list headers whose pages match regexp.
-        (save-excursion
-          ;; REMOVED  save-restriction  AND  widen  FROM HERE
-          (goto-char (point-min))
-          
-          ;; (a) Handle first page
-          (save-restriction
-            (narrow-to-page)
-            ;; search for selection regexp
-            (if (save-excursion (re-search-forward regexp nil t))
-                (pages-copy-header-and-position count-lines-p)))
-          
-          ;; (b) Search for next page-delimiter
-          (while (re-search-forward page-delimiter nil t)
-            (save-restriction
-              (narrow-to-page)
-              ;; search for selection regexp
-              (if (save-excursion (re-search-forward regexp nil t))
-                  (pages-copy-header-and-position count-lines-p)
-                )))))
-      
-      (set-buffer standard-output)
-      ;; Put positions in increasing order to go with buffer.
-      (setq pages-pos-list (nreverse pages-pos-list))
-      (if (interactive-p)
-          (message "%d matching lines in: %s"
-                   (length pages-pos-list) (buffer-name target-buffer))))
-    (pop-to-buffer pages-directory-buffer)
-    (sit-for 0)  ; otherwise forward-line fails if N > window height.
-    (forward-line (if (= 0 pages-buffer-original-page)
-                      1
-                    pages-buffer-original-page))))
-
-(defun pages-copy-header-and-position (count-lines-p)
-  "Copy page header and its position to the Pages Directory.
-Only arg non-nil, count lines in page and insert before header.
-Used by `pages-directory' function."
-  
-  (let (position line-count)
-
-    (if count-lines-p
-        (save-excursion
-          (save-restriction
-            (narrow-to-page)
-            (setq line-count (count-lines (point-min) (point-max))))))
-
-    ;; Keep track of page for later cursor positioning
-    (if (<= (point) pages-buffer-original-position)
-        (setq pages-buffer-original-page
-              (1+ pages-buffer-original-page)))
-    
-    (save-excursion
-      ;; go to first non-blank char after the page-delimiter
-      (skip-chars-forward " \t\n")     
-      ;; set the marker here; this the place to which the
-      ;; `pages-directory-goto' command will go 
-      (setq position (make-marker))
-      (set-marker position (point))
-      (let ((start (point))
-            (end (save-excursion (end-of-line) (point))))
-        ;; change to directory buffer
-        (set-buffer standard-output)
-        ;; record page position 
-        (setq pages-pos-list (cons position pages-pos-list))
-        ;; insert page header
-        (insert-buffer-substring target-buffer start end))
-      
-      (if count-lines-p
-          (save-excursion
-            (beginning-of-line)
-            (insert (format "%3d: " line-count))))
-      
-      (terpri))
-    (end-of-line 1)))
-
-(defun pages-directory-mode ()
-  "Mode for handling the pages-directory buffer.
-
-Move point to one of the lines in this buffer, then use \\[pages-directory-goto] to go
-to the same line in the pages buffer."
-
-  (kill-all-local-variables)
-  (use-local-map pages-directory-map)
-  (setq major-mode 'pages-directory-mode)
-  (setq mode-name "Pages-Directory")
-  (make-local-variable 'pages-buffer)
-  (make-local-variable 'pages-pos-list)
-  (make-local-variable 'pages-directory-buffer-narrowing-p))
-
-(defun pages-directory-goto ()
-  "Go to the corresponding line in the pages buffer."
-
-;;; This function is mostly a copy of `occur-mode-goto-occurrence'
-
-  (interactive)
-  (if (or (not pages-buffer)
-	  (not (buffer-name pages-buffer)))
-      (progn
-	(setq pages-buffer nil
-	      pages-pos-list nil)
-	(error "Buffer in which pages were found is deleted.")))
-  (beginning-of-line)
-  (let* ((pages-number (1- (count-lines (point-min) (point))))
-	 (pos (nth pages-number pages-pos-list))
-         (end-of-directory-p (eobp))
-         (narrowing-p  pages-directory-buffer-narrowing-p))
-    (pop-to-buffer pages-buffer)  
-    (widen)
-    (if end-of-directory-p
-        (goto-char (point-max))
-      (goto-char (marker-position pos)))
-    (if narrowing-p (narrow-to-page))))
-
-
-;;; The `pages-directory-for-addresses' function and ancillary code
-
-(defun pages-directory-for-addresses (&optional filename)
-  "Find addresses file and display its directory.
-By default, create and display directory of `pages-addresses-file-name'.
-Optional argument is FILENAME.  In interactive use, with prefix
-argument, prompt for file name and provide completion.
-
-Move point to one of the lines in the displayed directory,
-then use \\[pages-directory-goto] to go to the same line
-in the addresses buffer.
-
-If    pages-directory-for-addresses-goto-narrowing-p    is non-nil,
-`pages-directory-goto' narrows addresses buffer to entry.
-
-If    pages-directory-for-addresses-buffer-keep-windows-p     is nil,
-this command deletes other windows when it displays the addresses 
-directory."
-
-  (interactive
-   (list (if current-prefix-arg
-             (read-file-name "Filename: " pages-addresses-file-name))))
-
-  (if (interactive-p)
-      (message "Creating directory for: %s "
-               (or filename pages-addresses-file-name)))
-  (if (file-exists-p (or filename pages-addresses-file-name))
-      (progn
-        (set-buffer
-         (find-file-noselect
-          (expand-file-name
-           (or filename pages-addresses-file-name))))
-        (widen)
-        (pages-directory t nil nil)
-        (pages-directory-address-mode)
-        (setq pages-directory-buffer-narrowing-p
-              pages-directory-for-addresses-goto-narrowing-p)
-        (or pages-directory-for-addresses-buffer-keep-windows-p
-            (delete-other-windows))
-        (save-excursion
-          (goto-char (point-min))
-          (delete-region (point) (save-excursion (end-of-line) (point)))
-          (insert
-           "=== Address List Directory: use `C-c C-c' to go to page under cursor. ===")
-          (set-buffer-modified-p nil)
-          ))
-    (error "No addresses file found!")))
-
-(defun pages-directory-address-mode ()
-  "Mode for handling the Addresses Directory buffer.
-
-Move point to one of the lines in this buffer,
-then use \\[pages-directory-goto] to go
-to the same line in the pages buffer."
-
-  (use-local-map pages-directory-map)
-  (setq major-mode 'pages-directory-address-mode)
-  (setq mode-name "Addresses Directory")
-  (make-local-variable 'pages-buffer)
-  (make-local-variable 'pages-pos-list)
-  (make-local-variable 'pages-directory-buffer-narrowing-p))
-
-
-;;; Place `provide' at end of file.
-(provide 'page-ext)
-
-;;;;;;;;;;;;;;;; end of page-ext.el ;;;;;;;;;;;;;;;;
-
diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el
deleted file mode 100644
index 2cc0533535d..00000000000
--- a/lisp/textmodes/page.el
+++ /dev/null
@@ -1,161 +0,0 @@
-;;; page.el --- page motion commands for emacs.
-
-;; Copyright (C) 1985 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 code provides the page-oriented movement and selection commands
-;; documented in the Emacs manual.
-
-;;; Code:
-
-(defun forward-page (&optional count)
-  "Move forward to page boundary.  With arg, repeat, or go back if negative.
-A page boundary is any line whose beginning matches the regexp
-`page-delimiter'."
-  (interactive "p")
-  (or count (setq count 1))
-  (while (and (> count 0) (not (eobp)))
-    ;; In case the page-delimiter matches the null string,
-    ;; don't find a match without moving.
-    (if (bolp) (forward-char 1))
-    (if (re-search-forward page-delimiter nil t)
-	nil
-      (goto-char (point-max)))
-    (setq count (1- count)))
-  (while (and (< count 0) (not (bobp)))
-    ;; In case the page-delimiter matches the null string,
-    ;; don't find a match without moving.
-    (and (save-excursion (re-search-backward page-delimiter nil t))
-	 (= (match-end 0) (point))
-	 (goto-char (match-beginning 0)))
-    (forward-char -1)
-    (if (re-search-backward page-delimiter nil t)
-	;; We found one--move to the end of it.
-	(goto-char (match-end 0))
-      ;; We found nothing--go to beg of buffer.
-      (goto-char (point-min)))
-    (setq count (1+ count))))
-
-(defun backward-page (&optional count)
-  "Move backward to page boundary.  With arg, repeat, or go fwd if negative.
-A page boundary is any line whose beginning matches the regexp
-`page-delimiter'."
-  (interactive "p")
-  (or count (setq count 1))
-  (forward-page (- count)))
-
-(defun mark-page (&optional arg)
-  "Put mark at end of page, point at beginning.
-A numeric arg specifies to move forward or backward by that many pages,
-thus marking a page other than the one point was originally in."
-  (interactive "P")
-  (setq arg (if arg (prefix-numeric-value arg) 0))
-  (if (> arg 0)
-      (forward-page arg)
-    (if (< arg 0)
-        (forward-page (1- arg))))
-  (forward-page)
-  (push-mark nil t t)
-  (forward-page -1))
-
-(defun narrow-to-page (&optional arg)
-  "Make text outside current page invisible.
-A numeric arg specifies to move forward or backward by that many pages,
-thus showing a page other than the one point was originally in."
-  (interactive "P")
-  (setq arg (if arg (prefix-numeric-value arg) 0))
-  (save-excursion
-    (widen)
-    (if (> arg 0)
-	(forward-page arg)
-      (if (< arg 0)
-	  (let ((adjust 0)
-		(opoint (point)))
-	    ;; If we are not now at the beginning of a page,
-	    ;; move back one extra time, to get to the start of this page.
-	    (save-excursion
-	      (beginning-of-line)
-	      (or (and (looking-at page-delimiter)
-		       (eq (match-end 0) opoint))
-		  (setq adjust 1)))
-	    (forward-page (- arg adjust)))))
-    ;; Find the end of the page.
-    (forward-page)
-    ;; If we stopped due to end of buffer, stay there.
-    ;; If we stopped after a page delimiter, put end of restriction
-    ;; at the beginning of that line.
-    (if (save-excursion
-	  (goto-char (match-beginning 0)) ; was (beginning-of-line)
-	  (looking-at page-delimiter))
-	(beginning-of-line))
-    (narrow-to-region (point)
-		      (progn
-			;; Find the top of the page.
-			(forward-page -1)
-			;; If we found beginning of buffer, stay there.
-			;; If extra text follows page delimiter on same line,
-			;; include it.
-			;; Otherwise, show text starting with following line.
-			(if (and (eolp) (not (bobp)))
-			    (forward-line 1))
-			(point)))))
-(put 'narrow-to-page 'disabled t)
-
-(defun count-lines-page ()
-  "Report number of lines on current page, and how many are before or after point."
-  (interactive)
-  (save-excursion
-    (let ((opoint (point)) beg end
-	  total before after)
-      (forward-page)
-      (beginning-of-line)
-      (or (looking-at page-delimiter)
-	  (end-of-line))
-      (setq end (point))
-      (backward-page)
-      (setq beg (point))
-      (setq total (count-lines beg end)
-	    before (count-lines beg opoint)
-	    after (count-lines opoint end))
-      (message "Page has %d lines (%d + %d)" total before after))))
-
-(defun what-page ()
-  "Print page and line number of point."
-  (interactive)
-  (save-restriction
-    (widen)
-    (save-excursion
-      (beginning-of-line)
-      (let ((count 1)
-	    (opoint (point)))
-	(goto-char 1)
-	(while (re-search-forward page-delimiter opoint t)
-	  (setq count (1+ count)))
-	(message "Page %d, line %d"
-		 count
-		 (1+ (count-lines (point) opoint)))))))
-
-;;; Place `provide' at end of file.
-(provide 'page)
-
-;;; page.el ends here
diff --git a/lisp/textmodes/paragraphs.el b/lisp/textmodes/paragraphs.el
deleted file mode 100644
index cb876d55031..00000000000
--- a/lisp/textmodes/paragraphs.el
+++ /dev/null
@@ -1,389 +0,0 @@
-;;; paragraphs.el --- paragraph and sentence parsing.
-
-;; Copyright (C) 1985, 86, 87, 91, 94, 95, 96 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: wp
-
-;; 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 provides the paragraph-oriented commands documented in the
-;; Emacs manual.
-
-;;; Code:
-
-(defvar use-hard-newlines nil
-    "Non-nil means to distinguish hard and soft newlines.
-See documentation for the `use-hard-newlines' function.")
-(make-variable-buffer-local 'use-hard-newlines)
-
-(defun use-hard-newlines (&optional arg insert)
-  "Minor mode to distinguish hard and soft newlines.
-When active, the functions `newline' and `open-line' add the
-text-property `hard' to newlines that they insert, and a line is
-only considered as a candidate to match `paragraph-start' or
-`paragraph-separate' if it follows a hard newline.
-
-Prefix argument says to turn mode on if positive, off if negative.
-When the mode is turned on, if there are newlines in the buffer but no hard
-newlines, ask the user whether to mark as hard any newlines preceeding a 
-`paragraph-start' line.  From a program, second arg INSERT specifies whether
-to do this; it can be `never' to change nothing, t or `always' to force
-marking, `guess' to try to do the right thing with no questions, nil 
-or anything else to ask the user.
-
-Newlines not marked hard are called \"soft\", and are always internal
-to paragraphs.  The fill functions insert and delete only soft newlines."
-  (interactive (list current-prefix-arg nil))
-  (if (or (<= (prefix-numeric-value arg) 0)
-	  (and use-hard-newlines (null arg)))
-      ;; Turn mode off
-      (setq use-hard-newlines nil)
-    ;; Turn mode on
-    ;; Intuit hard newlines --
-    ;;   mark as hard any newlines preceding a paragraph-start line.
-    (if (or (eq insert t) (eq insert 'always)
-	    (and (not (eq 'never insert))
-		 (not use-hard-newlines)
-		 (not (text-property-any (point-min) (point-max) 'hard t))
-		 (save-excursion
-		   (goto-char (point-min))
-		   (search-forward "\n" nil t))
-		 (or (eq insert 'guess)
-		     (y-or-n-p "Make newlines between paragraphs hard? "))))
-	(save-excursion
-	  (goto-char (point-min))
-	  (while (search-forward "\n" nil t)
-	    (let ((pos (point)))
-	      (move-to-left-margin)
-	      (if (looking-at paragraph-start)
-		  (progn
-		    (set-hard-newline-properties (1- pos) pos)
-		    ;; If paragraph-separate, newline after it is hard too.
-		    (if (looking-at paragraph-separate)
-			(progn
-			  (end-of-line)
-			  (if (not (eobp))
-			      (set-hard-newline-properties
-			       (point) (1+ (point))))))))))))
-    (setq use-hard-newlines t)))
-
-(defvar paragraph-start "[ \t\n\f]" "\
-*Regexp for beginning of a line that starts OR separates paragraphs.
-This regexp should match lines that separate paragraphs
-and should also match lines that start a paragraph
-\(and are part of that paragraph).
-
-This is matched against the text at the left margin, which is not necessarily
-the beginning of the line, so it should never use \"^\" as an anchor.  This
-ensures that the paragraph functions will work equally well within a region
-of text indented by a margin setting.
-
-The variable `paragraph-separate' specifies how to distinguish
-lines that start paragraphs from lines that separate them.
-
-If the variable `use-hard-newlines' is nonnil, then only lines following a
-hard newline are considered to match.")
-
-;; paragraph-start requires a hard newline, but paragraph-separate does not:
-;; It is assumed that paragraph-separate is distinctive enough to be believed
-;; whenever it occurs, while it is reasonable to set paragraph-start to
-;; something very minimal, even including "." (which makes every hard newline
-;; start a new paragraph).
-
-(defvar paragraph-separate "[ \t\f]*$" "\
-*Regexp for beginning of a line that separates paragraphs.
-If you change this, you may have to change paragraph-start also.
-
-This is matched against the text at the left margin, which is not necessarily
-the beginning of the line, so it should not use \"^\" as an anchor.  This
-ensures that the paragraph functions will work equally within a region of
-text indented by a margin setting.")
-
-(defvar sentence-end (purecopy "[.?!][]\"')}]*\\($\\| $\\|\t\\|  \\)[ \t\n]*") "\
-*Regexp describing the end of a sentence.
-All paragraph boundaries also end sentences, regardless.
-
-In order to be recognized as the end of a sentence, the ending period,
-question mark, or exclamation point must be followed by two spaces,
-unless it's inside some sort of quotes or parenthesis.")
-
-(defvar page-delimiter "^\014" "\
-*Regexp describing line-beginnings that separate pages.")
-
-(defvar paragraph-ignore-fill-prefix nil "\
-Non-nil means the paragraph commands are not affected by `fill-prefix'.
-This is desirable in modes where blank lines are the paragraph delimiters.")
-
-(defun forward-paragraph (&optional arg)
-  "Move forward to end of paragraph.
-With argument ARG, do it ARG times;
-a negative argument ARG = -N means move backward N paragraphs.
-
-A line which `paragraph-start' matches either separates paragraphs
-\(if `paragraph-separate' matches it also) or is the first line of a paragraph.
-A paragraph end is the beginning of a line which is not part of the paragraph
-to which the end of the previous line belongs, or the end of the buffer."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (let* ((fill-prefix-regexp
-	  (and fill-prefix (not (equal fill-prefix ""))
-	       (not paragraph-ignore-fill-prefix)
-	       (regexp-quote fill-prefix)))
-	 ;; Remove ^ from paragraph-start and paragraph-sep if they are there.
-	 ;; These regexps shouldn't be anchored, because we look for them
-	 ;; starting at the left-margin.  This allows paragraph commands to
-	 ;; work normally with indented text.
-	 ;; This hack will not find problem cases like "whatever\\|^something".
-	 (paragraph-start (if (and (not (equal "" paragraph-start))
-				   (equal ?^ (aref paragraph-start 0)))
-			      (substring paragraph-start 1)
-			    paragraph-start))
-	 (paragraph-separate (if (and (not (equal "" paragraph-start))
-				      (equal ?^ (aref paragraph-separate 0)))
-			      (substring paragraph-separate 1)
-			    paragraph-separate))
-	 (paragraph-separate
-	  (if fill-prefix-regexp
-	      (concat paragraph-separate "\\|"
-		      fill-prefix-regexp "[ \t]*$")
-	    paragraph-separate))
-	 ;; This is used for searching.
-	 (sp-paragraph-start (concat "^[ \t]*\\(" paragraph-start "\\)"))
-	 start)
-    (while (and (< arg 0) (not (bobp)))
-      (if (and (not (looking-at paragraph-separate))
-	       (re-search-backward "^\n" (max (1- (point)) (point-min)) t)
-	       (looking-at paragraph-separate))
-	  nil
-	(setq start (point))
-	;; Move back over paragraph-separating lines.
-	(forward-char -1) (beginning-of-line)
-	(while (and (not (bobp))
-		    (progn (move-to-left-margin)
-			   (looking-at paragraph-separate)))
-	  (forward-line -1)) 
-	(if (bobp)
-	    nil
-	  ;; Go to end of the previous (non-separating) line.
-	  (end-of-line)
-	  ;; Search back for line that starts or separates paragraphs.
-	  (if (if fill-prefix-regexp
-		  ;; There is a fill prefix; it overrides paragraph-start.
-		  (let (multiple-lines)
-		    (while (and (progn (beginning-of-line) (not (bobp)))
-				(progn (move-to-left-margin)
-				       (not (looking-at paragraph-separate)))
-				(looking-at fill-prefix-regexp))
-		      (if (not (= (point) start))
-			  (setq multiple-lines t))
-		      (forward-line -1))
-		    (move-to-left-margin)
-;;; This deleted code caused a long hanging-indent line
-;;; not to be filled together with the following lines.
-;;;		    ;; Don't move back over a line before the paragraph
-;;;		    ;; which doesn't start with fill-prefix
-;;;		    ;; unless that is the only line we've moved over.
-;;;		    (and (not (looking-at fill-prefix-regexp))
-;;;			 multiple-lines
-;;;			 (forward-line 1))
-		    (not (bobp)))
-		(while (and (re-search-backward sp-paragraph-start nil 1)
-			    ;; Found a candidate, but need to check if it is a
-			    ;; REAL paragraph-start.
-			    (not (bobp))
-			    (progn (setq start (point))
-				   (move-to-left-margin)
-				   (not (looking-at paragraph-separate)))
-			    (or (not (looking-at paragraph-start))
-				(and use-hard-newlines
-				     (not (get-text-property (1- start)
-							     'hard)))))
-		  (goto-char start))
-		(> (point) (point-min)))
-	      ;; Found one.
-	      (progn
-		;; Move forward over paragraph separators.
-		;; We know this cannot reach the place we started
-		;; because we know we moved back over a non-separator.
-		(while (and (not (eobp))
-			    (progn (move-to-left-margin)
-				   (looking-at paragraph-separate)))
-		  (forward-line 1))
-		;; If line before paragraph is just margin, back up to there.
-		(end-of-line 0)
-		(if (> (current-column) (current-left-margin))
-		    (forward-char 1)
-		  (skip-chars-backward " \t")
-		  (if (not (bolp))
-		      (forward-line 1))))
-	    ;; No starter or separator line => use buffer beg.
-	    (goto-char (point-min)))))
-      (setq arg (1+ arg)))
-    (while (and (> arg 0) (not (eobp)))
-      ;; Move forward over separator lines, and one more line.
-      (while (prog1 (and (not (eobp))
-			 (progn (move-to-left-margin) (not (eobp)))
-			 (looking-at paragraph-separate))
-	       (forward-line 1)))
-      (if fill-prefix-regexp
-	  ;; There is a fill prefix; it overrides paragraph-start.
-	  (while (and (not (eobp))
-		      (progn (move-to-left-margin) (not (eobp)))
-		      (not (looking-at paragraph-separate))
-		      (looking-at fill-prefix-regexp))
-	    (forward-line 1))
-	(while (and (re-search-forward sp-paragraph-start nil 1)
-		    (progn (setq start (match-beginning 0))
-			   (goto-char start)
-			   (not (eobp)))
-		    (progn (move-to-left-margin)
-			   (not (looking-at paragraph-separate)))
-		    (or (not (looking-at paragraph-start))
-			(and use-hard-newlines
-			     (not (get-text-property (1- start) 'hard)))))
-	  (forward-char 1))
-	(if (< (point) (point-max))
-	    (goto-char start)))
-      (setq arg (1- arg)))))
-
-(defun backward-paragraph (&optional arg)
-  "Move backward to start of paragraph.
-With argument ARG, do it ARG times;
-a negative argument ARG = -N means move forward N paragraphs.
-
-A paragraph start is the beginning of a line which is a
-`first-line-of-paragraph' or which is ordinary text and follows a
-paragraph-separating line; except: if the first real line of a
-paragraph is preceded by a blank line, the paragraph starts at that
-blank line.
-
-See `forward-paragraph' for more information."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (forward-paragraph (- arg)))
-
-(defun mark-paragraph ()
-  "Put point at beginning of this paragraph, mark at end.
-The paragraph marked is the one that contains point or follows point."
-  (interactive)
-  (forward-paragraph 1)
-  (push-mark nil t t)
-  (backward-paragraph 1))
-
-(defun kill-paragraph (arg)
-  "Kill forward to end of paragraph.
-With arg N, kill forward to Nth end of paragraph;
-negative arg -N means kill backward to Nth start of paragraph."
-  (interactive "p")
-  (kill-region (point) (progn (forward-paragraph arg) (point))))
-
-(defun backward-kill-paragraph (arg)
-  "Kill back to start of paragraph.
-With arg N, kill back to Nth start of paragraph;
-negative arg -N means kill forward to Nth end of paragraph."
-  (interactive "p")
-  (kill-region (point) (progn (backward-paragraph arg) (point))))
-
-(defun transpose-paragraphs (arg)
-  "Interchange this (or next) paragraph with previous one."
-  (interactive "*p")
-  (transpose-subr 'forward-paragraph arg))
-
-(defun start-of-paragraph-text ()
-  (let ((opoint (point)) npoint)
-    (forward-paragraph -1)
-    (setq npoint (point))
-    (skip-chars-forward " \t\n")
-    ;; If the range of blank lines found spans the original start point,
-    ;; try again from the beginning of it.
-    ;; Must be careful to avoid infinite loop
-    ;; when following a single return at start of buffer.
-    (if (and (>= (point) opoint) (< npoint opoint))
-	(progn
-	  (goto-char npoint)
-	  (if (> npoint (point-min))
-	      (start-of-paragraph-text))))))
-
-(defun end-of-paragraph-text ()
-  (let ((opoint (point)))
-    (forward-paragraph 1)
-    (if (eq (preceding-char) ?\n) (forward-char -1))
-    (if (<= (point) opoint)
-	(progn
-	  (forward-char 1)
-	  (if (< (point) (point-max))
-	      (end-of-paragraph-text))))))
-
-(defun forward-sentence (&optional arg)
-  "Move forward to next `sentence-end'.  With argument, repeat.
-With negative argument, move backward repeatedly to `sentence-beginning'.
-
-The variable `sentence-end' is a regular expression that matches ends of
-sentences.  Also, every paragraph boundary terminates sentences as well."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (while (< arg 0)
-    (let ((par-beg (save-excursion (start-of-paragraph-text) (point))))
-      (if (re-search-backward (concat sentence-end "[^ \t\n]") par-beg t)
-	  (goto-char (1- (match-end 0)))
-	(goto-char par-beg)))
-    (setq arg (1+ arg)))
-  (while (> arg 0)
-    (let ((par-end (save-excursion (end-of-paragraph-text) (point))))
-      (if (re-search-forward sentence-end par-end t)
-	  (skip-chars-backward " \t\n")
-	(goto-char par-end)))
-    (setq arg (1- arg))))
-
-(defun backward-sentence (&optional arg)
-  "Move backward to start of sentence.  With arg, do it arg times.
-See `forward-sentence' for more information."
-  (interactive "p")
-  (or arg (setq arg 1))
-  (forward-sentence (- arg)))
-
-(defun kill-sentence (&optional arg)
-  "Kill from point to end of sentence.
-With arg, repeat; negative arg -N means kill back to Nth start of sentence."
-  (interactive "p")
-  (kill-region (point) (progn (forward-sentence arg) (point))))
-
-(defun backward-kill-sentence (&optional arg)
-  "Kill back from point to start of sentence.
-With arg, repeat, or kill forward to Nth end of sentence if negative arg -N."
-  (interactive "p")
-  (kill-region (point) (progn (backward-sentence arg) (point))))
-
-(defun mark-end-of-sentence (arg)
-  "Put mark at end of sentence.  Arg works as in `forward-sentence'."
-  (interactive "p")
-  (push-mark
-    (save-excursion
-      (forward-sentence arg)
-      (point))
-    nil t))
-
-(defun transpose-sentences (arg)
-  "Interchange this (next) and previous sentence."
-  (interactive "*p")
-  (transpose-subr 'forward-sentence arg))
-
-;;; paragraphs.el ends here
diff --git a/lisp/textmodes/picture.el b/lisp/textmodes/picture.el
deleted file mode 100644
index e2cd1897d0a..00000000000
--- a/lisp/textmodes/picture.el
+++ /dev/null
@@ -1,646 +0,0 @@
-;;; picture.el --- "Picture mode" -- editing using quarter-plane screen model.
-
-;; Copyright (C) 1985, 1994 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; 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 code provides the picture-mode commands documented in the Emacs 
-;; manual.  The screen is treated as a semi-infinite quarter-plane with
-;; support for rectangle operations and `etch-a-sketch' character
-;; insertion in any of eight directions.
-
-;;; Code:
-
-(defun move-to-column-force (column)
-  "Move to column COLUMN in current line.
-Differs from `move-to-column' in that it creates or modifies whitespace
-if necessary to attain exactly the specified column."
-  (or (natnump column) (setq column 0))
-  (move-to-column column)
-  (let ((col (current-column)))
-    (if (< col column)
-	(indent-to column)
-      (if (and (/= col column)
-	       (= (preceding-char) ?\t))
-	  (let (indent-tabs-mode)
-	    (delete-char -1)
-            (indent-to col)
-            (move-to-column column))))
-    ;; This call will go away when Emacs gets real horizontal autoscrolling
-    (hscroll-point-visible)))
-
-
-;; Picture Movement Commands
-
-(defun picture-beginning-of-line (&optional arg)
-  "Position point at the beginning of the line.
-With ARG not nil, move forward ARG - 1 lines first.
-If scan reaches end of buffer, stop there without error."
-  (interactive "P")
-  (if arg (forward-line (1- (prefix-numeric-value arg))))
-  (beginning-of-line)
-  ;; This call will go away when Emacs gets real horizontal autoscrolling
-  (hscroll-point-visible))
-
-(defun picture-end-of-line (&optional arg)
-  "Position point after last non-blank character on current line.
-With ARG not nil, move forward ARG - 1 lines first.
-If scan reaches end of buffer, stop there without error."
-  (interactive "P")
-  (if arg (forward-line (1- (prefix-numeric-value arg))))
-  (beginning-of-line)
-  (skip-chars-backward " \t" (prog1 (point) (end-of-line)))
-  ;; This call will go away when Emacs gets real horizontal autoscrolling
-  (hscroll-point-visible))
-
-(defun picture-forward-column (arg)
-  "Move cursor right, making whitespace if necessary.
-With argument, move that many columns."
-  (interactive "p")
-  (let ((target-column (+ (current-column) arg)))
-    (move-to-column-force target-column)
-    ;; Picture mode isn't really suited to multi-column characters,
-    ;; but we might as well let the user move across them.
-    (and (< arg 0)
-	 (> (current-column) target-column)
-	 (forward-char -1))))
-
-(defun picture-backward-column (arg)
-  "Move cursor left, making whitespace if necessary.
-With argument, move that many columns."
-  (interactive "p")
-  (picture-forward-column (- arg)))
-
-(defun picture-move-down (arg)
-  "Move vertically down, making whitespace if necessary.
-With argument, move that many lines."
-  (interactive "p")
-  (let ((col (current-column)))
-    (picture-newline arg)
-    (move-to-column-force col)))
-
-(defconst picture-vertical-step 0
-  "Amount to move vertically after text character in Picture mode.")
-
-(defconst picture-horizontal-step 1
-  "Amount to move horizontally after text character in Picture mode.")
-
-(defun picture-move-up (arg)
-  "Move vertically up, making whitespace if necessary.
-With argument, move that many lines."
-  (interactive "p")
-  (picture-move-down (- arg)))
-
-(defun picture-movement-right ()
-  "Move right after self-inserting character in Picture mode."
-  (interactive)
-  (picture-set-motion 0 1))
-
-(defun picture-movement-left ()
-  "Move left after self-inserting character in Picture mode."
-  (interactive)
-  (picture-set-motion 0 -1))
-
-(defun picture-movement-up ()
-  "Move up after self-inserting character in Picture mode."
-  (interactive)
-  (picture-set-motion -1 0))
-
-(defun picture-movement-down ()
-  "Move down after self-inserting character in Picture mode."
-  (interactive)
-  (picture-set-motion 1 0))
-
-(defun picture-movement-nw ()
-  "Move up and left after self-inserting character in Picture mode."
-  (interactive)
-  (picture-set-motion -1 -1))
-
-(defun picture-movement-ne ()
-  "Move up and right after self-inserting character in Picture mode."
-  (interactive)
-  (picture-set-motion -1 1))
-
-(defun picture-movement-sw ()
-  "Move down and left after self-inserting character in Picture mode."
-  (interactive)
-  (picture-set-motion 1 -1))
-
-(defun picture-movement-se ()
-  "Move down and right after self-inserting character in Picture mode."
-  (interactive)
-  (picture-set-motion 1 1))
-
-(defun picture-set-motion (vert horiz)
-  "Set VERTICAL and HORIZONTAL increments for movement in Picture mode.
-The mode line is updated to reflect the current direction."
-  (setq picture-vertical-step vert
-	picture-horizontal-step horiz)
-  (setq mode-name
-	(format "Picture:%s"
-		(car (nthcdr (+ 1 (% horiz 2) (* 3 (1+ (% vert 2))))
-			     '(nw up ne left none right sw down se)))))
-  (force-mode-line-update)
-  (message ""))
-
-(defun picture-move ()
-  "Move in direction of `picture-vertical-step' and `picture-horizontal-step'."
-  (picture-move-down picture-vertical-step)
-  (picture-forward-column picture-horizontal-step))
-
-(defun picture-motion (arg)
-  "Move point in direction of current picture motion in Picture mode.
-With ARG do it that many times.  Useful for delineating rectangles in
-conjunction with diagonal picture motion.
-Do \\[command-apropos]  picture-movement  to see commands which control motion."
-  (interactive "p")
-  (picture-move-down (* arg picture-vertical-step))
-  (picture-forward-column (* arg picture-horizontal-step)))
-
-(defun picture-motion-reverse (arg)
-  "Move point in direction opposite of current picture motion in Picture mode.
-With ARG do it that many times.  Useful for delineating rectangles in
-conjunction with diagonal picture motion.
-Do \\[command-apropos] `picture-movement' to see commands which control motion."
-  (interactive "p")
-  (picture-motion (- arg)))
-
-
-;; Picture insertion and deletion.
-
-(defun picture-self-insert (arg)
-  "Insert this character in place of character previously at the cursor.
-The cursor then moves in the direction you previously specified
-with the commands `picture-movement-right', `picture-movement-up', etc.
-Do \\[command-apropos] `picture-movement' to see those commands."
-  (interactive "p")
-  (while (> arg 0)
-    (setq arg (1- arg))
-    (move-to-column-force (1+ (current-column)))
-    (delete-char -1)
-    (insert last-command-event)		; Always a character in this case.
-    (forward-char -1)
-    (picture-move)))
-
-(defun picture-clear-column (arg)
-  "Clear out ARG columns after point without moving."
-  (interactive "p")
-  (let* ((opoint (point))
-	 (original-col (current-column))
-	 (target-col (+ original-col arg)))
-    (move-to-column-force target-col)
-    (delete-region opoint (point))
-    (save-excursion
-     (indent-to (max target-col original-col)))))
-
-(defun picture-backward-clear-column (arg)
-  "Clear out ARG columns before point, moving back over them."
-  (interactive "p")
-  (picture-clear-column (- arg)))
-
-(defun picture-clear-line (arg)
-  "Clear out rest of line; if at end of line, advance to next line.
-Cleared-out line text goes into the kill ring, as do newlines that are
-advanced over.  With argument, clear out (and save in kill ring) that
-many lines."
-  (interactive "P")
-  (if arg
-      (progn
-       (setq arg (prefix-numeric-value arg))
-       (kill-line arg)
-       (newline (if (> arg 0) arg (- arg))))
-    (if (looking-at "[ \t]*$")
-	(kill-ring-save (point) (progn (forward-line 1) (point)))
-      (kill-region (point) (progn (end-of-line) (point))))))
-
-(defun picture-newline (arg)
-  "Move to the beginning of the following line.
-With argument, moves that many lines (up, if negative argument);
-always moves to the beginning of a line."
-  (interactive "p")
-  (if (< arg 0)
-      (forward-line arg)
-    (while (> arg 0)
-      (end-of-line)
-      (if (eobp) (newline) (forward-char 1))
-      (setq arg (1- arg))))
-  ;; This call will go away when Emacs gets real horizontal autoscrolling
-  (hscroll-point-visible))
-
-(defun picture-open-line (arg)
-  "Insert an empty line after the current line.
-With positive argument insert that many lines."
-  (interactive "p")
-  (save-excursion
-   (end-of-line)
-   (open-line arg))
-  ;; This call will go away when Emacs gets real horizontal autoscrolling
-  (hscroll-point-visible))
-
-(defun picture-duplicate-line ()
-  "Insert a duplicate of the current line, below it."
-  (interactive)
-  (save-excursion
-   (let ((contents
-	  (buffer-substring
-	   (progn (beginning-of-line) (point))
-	   (progn (picture-newline 1) (point)))))
-     (forward-line -1)
-     (insert contents))))
-
-;; Like replace-match, but overwrites.
-(defun picture-replace-match (newtext fixedcase literal)
-  (let (ocolumn change pos)
-    (goto-char (setq pos (match-end 0)))
-    (setq ocolumn (current-column))
-    ;; Make the replacement and undo it, to see how it changes the length.
-    (let ((buffer-undo-list nil)
-	  list1)
-      (replace-match newtext fixedcase literal)
-      (setq change (- (current-column) ocolumn))
-      (setq list1 buffer-undo-list)
-      (while list1
-	(setq list1 (primitive-undo 1 list1))))
-    (goto-char pos)
-    (if (> change 0)
-	(delete-region (point)
-		       (progn
-			 (move-to-column-force (+ change (current-column)))
-			 (point))))
-    (replace-match newtext fixedcase literal)
-    (if (< change 0)
-	(insert-char ?\ (- change)))))
-
-;; Picture Tabs
-
-(defvar picture-tab-chars "!-~"
-  "*A character set which controls behavior of commands
-\\[picture-set-tab-stops] and \\[picture-tab-search].  It is NOT a
-regular expression, any regexp special characters will be quoted.
-It defines a set of \"interesting characters\" to look for when setting
-\(or searching for) tab stops, initially \"!-~\" (all printing characters).
-For example, suppose that you are editing a table which is formatted thus:
-| foo		| bar + baz | 23  *
-| bubbles	| and + etc | 97  *
-and that `picture-tab-chars' is \"|+*\".  Then invoking
-\\[picture-set-tab-stops] on either of the previous lines would result
-in the following tab stops
-		:     :     :     :
-Another example - \"A-Za-z0-9\" would produce the tab stops
-  :		  :	:     :
-
-Note that if you want the character `-' to be in the set, it must be
-included in a range or else appear in a context where it cannot be
-taken for indicating a range (e.g. \"-A-Z\" declares the set to be the
-letters `A' through `Z' and the character `-').  If you want the
-character `\\' in the set it must be preceded by itself: \"\\\\\".
-
-The command \\[picture-tab-search] is defined to move beneath (or to) a
-character belonging to this set independent of the tab stops list.")
-
-(defun picture-set-tab-stops (&optional arg)
-  "Set value of `tab-stop-list' according to context of this line.
-This controls the behavior of \\[picture-tab].  A tab stop is set at
-every column occupied by an \"interesting character\" that is preceded
-by whitespace.  Interesting characters are defined by the variable
-`picture-tab-chars', see its documentation for an example of usage.
-With ARG, just (re)set `tab-stop-list' to its default value.  The tab
-stops computed are displayed in the minibuffer with `:' at each stop."
-  (interactive "P")
-  (save-excursion
-    (let (tabs)
-      (if arg
-	  (setq tabs (default-value 'tab-stop-list))
-	(let ((regexp (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")))
-	  (beginning-of-line)
-	  (let ((bol (point)))
-	    (end-of-line)
-	    (while (re-search-backward regexp bol t)
-	      (skip-chars-forward " \t")
-	      (setq tabs (cons (current-column) tabs)))
-	    (if (null tabs)
-		(error "No characters in set %s on this line."
-		       (regexp-quote picture-tab-chars))))))
-      (setq tab-stop-list tabs)
-      (let ((blurb (make-string (1+ (nth (1- (length tabs)) tabs)) ?\ )))
-	(while tabs
-	  (aset blurb (car tabs) ?:)
-	  (setq tabs (cdr tabs)))
-	(message blurb)))))
-
-(defun picture-tab-search (&optional arg)
-  "Move to column beneath next interesting char in previous line.
-With ARG move to column occupied by next interesting character in this
-line.  The character must be preceded by whitespace.
-\"interesting characters\" are defined by variable `picture-tab-chars'.
-If no such character is found, move to beginning of line."
-  (interactive "P")
-  (let ((target (current-column)))
-    (save-excursion
-      (if (and (not arg)
-	       (progn
-		 (beginning-of-line)
-		 (skip-chars-backward
-		  (concat "^" (regexp-quote picture-tab-chars))
-		  (point-min))
-		 (not (bobp))))
-	  (move-to-column target))
-      (if (re-search-forward
-	   (concat "[ \t]+[" (regexp-quote picture-tab-chars) "]")
-	   (save-excursion (end-of-line) (point))
-	   'move)
-	  (setq target (1- (current-column)))
-	(setq target nil)))
-    (if target
-	(move-to-column-force target)
-      (beginning-of-line))))
-
-(defun picture-tab (&optional arg)
-  "Tab transparently (just move point) to next tab stop.
-With prefix arg, overwrite the traversed text with spaces.  The tab stop
-list can be changed by \\[picture-set-tab-stops] and \\[edit-tab-stops].
-See also documentation for variable `picture-tab-chars'."
-  (interactive "P")
-  (let* ((opoint (point)))
-    (move-to-tab-stop)
-    (if arg
-	(let (indent-tabs-mode
-	      (column (current-column)))
-	  (delete-region opoint (point))
-	  (indent-to column)))))
-
-;; Picture Rectangles
-
-(defconst picture-killed-rectangle nil
-  "Rectangle killed or copied by \\[picture-clear-rectangle] in Picture mode.
-The contents can be retrieved by \\[picture-yank-rectangle]")
-
-(defun picture-clear-rectangle (start end &optional killp)
-  "Clear and save rectangle delineated by point and mark.
-The rectangle is saved for yanking by \\[picture-yank-rectangle] and replaced
-with whitespace.  The previously saved rectangle, if any, is lost.  With
-prefix argument, the rectangle is actually killed, shifting remaining text."
-  (interactive "r\nP")
-  (setq picture-killed-rectangle (picture-snarf-rectangle start end killp)))
-
-(defun picture-clear-rectangle-to-register (start end register &optional killp)
-  "Clear rectangle delineated by point and mark into REGISTER.
-The rectangle is saved in REGISTER and replaced with whitespace.  With
-prefix argument, the rectangle is actually killed, shifting remaining text."
-  (interactive "r\ncRectangle to register: \nP")
-  (set-register register (picture-snarf-rectangle start end killp)))
-
-(defun picture-snarf-rectangle (start end &optional killp)
-  (let ((column (current-column))
-	(indent-tabs-mode nil))
-    (prog1 (save-excursion
-             (if killp
-                 (delete-extract-rectangle start end)
-               (prog1 (extract-rectangle start end)
-                      (clear-rectangle start end))))
-	   (move-to-column-force column))))
-
-(defun picture-yank-rectangle (&optional insertp)
-  "Overlay rectangle saved by \\[picture-clear-rectangle]
-The rectangle is positioned with upper left corner at point, overwriting
-existing text.  With prefix argument, the rectangle is inserted instead,
-shifting existing text.  Leaves mark at one corner of rectangle and
-point at the other (diagonally opposed) corner."
-  (interactive "P")
-  (if (not (consp picture-killed-rectangle))
-      (error "No rectangle saved.")
-    (picture-insert-rectangle picture-killed-rectangle insertp)))
-
-(defun picture-yank-at-click (click arg)
-  "Insert the last killed rectangle at the position clicked on.
-Also move point to one end of the text thus inserted (normally the end).
-Prefix arguments are interpreted as with \\[yank].
-If `mouse-yank-at-point' is non-nil, insert at point
-regardless of where you click."
-  (interactive "e\nP")
-  (or mouse-yank-at-point (mouse-set-point click))
-  (picture-yank-rectangle arg))
-
-(defun picture-yank-rectangle-from-register (register &optional insertp)
-  "Overlay rectangle saved in REGISTER.
-The rectangle is positioned with upper left corner at point, overwriting
-existing text.  With prefix argument, the rectangle is
-inserted instead, shifting existing text.  Leaves mark at one corner
-of rectangle and point at the other (diagonally opposed) corner."
-  (interactive "cRectangle from register: \nP")
-  (let ((rectangle (get-register register)))
-    (if (not (consp rectangle))
-	(error "Register %c does not contain a rectangle." register)
-      (picture-insert-rectangle rectangle insertp))))
-
-(defun picture-insert-rectangle (rectangle &optional insertp)
-  "Overlay RECTANGLE with upper left corner at point.
-Optional argument INSERTP, if non-nil causes RECTANGLE to be inserted.
-Leaves the region surrounding the rectangle."
-  (let ((indent-tabs-mode nil))
-    (if (not insertp)
-	(save-excursion
-	  (delete-rectangle (point)
-			    (progn
-			      (picture-forward-column (length (car rectangle)))
-			      (picture-move-down (1- (length rectangle)))
-			      (point)))))
-    (push-mark)
-    (insert-rectangle rectangle)))
-
-
-;; Picture Keymap, entry and exit points.
-
-(defconst picture-mode-map nil)
-
-(defun picture-substitute (oldfun newfun)
-  (substitute-key-definition oldfun newfun picture-mode-map global-map))
-
-(if (not picture-mode-map)
-    (progn
-      (setq picture-mode-map (list 'keymap (make-vector 256 nil)))
-      (picture-substitute 'self-insert-command 'picture-self-insert)
-      (picture-substitute 'completion-separator-self-insert-command
-			  'picture-self-insert)
-      (picture-substitute 'completion-separator-self-insert-autofilling
-			  'picture-self-insert)
-      (picture-substitute 'forward-char 'picture-forward-column)
-      (picture-substitute 'backward-char 'picture-backward-column)
-      (picture-substitute 'delete-char 'picture-clear-column)
-      ;; There are two possibilities for what is normally on DEL.
-      (picture-substitute 'backward-delete-char-untabify 'picture-backward-clear-column)
-      (picture-substitute 'delete-backward-char 'picture-backward-clear-column)
-      (picture-substitute 'kill-line 'picture-clear-line)
-      (picture-substitute 'open-line 'picture-open-line)
-      (picture-substitute 'newline 'picture-newline)
-      (picture-substitute 'newline-and-indent 'picture-duplicate-line)
-      (picture-substitute 'next-line 'picture-move-down)
-      (picture-substitute 'previous-line 'picture-move-up)
-      (picture-substitute 'beginning-of-line 'picture-beginning-of-line)
-      (picture-substitute 'end-of-line 'picture-end-of-line)
-
-      (define-key picture-mode-map "\C-c\C-d" 'delete-char)
-      (define-key picture-mode-map "\e\t" 'picture-toggle-tab-state)
-      (define-key picture-mode-map "\t" 'picture-tab)
-      (define-key picture-mode-map "\e\t" 'picture-tab-search)
-      (define-key picture-mode-map "\C-c\t" 'picture-set-tab-stops)
-      (define-key picture-mode-map "\C-c\C-k" 'picture-clear-rectangle)
-      (define-key picture-mode-map "\C-c\C-w" 'picture-clear-rectangle-to-register)
-      (define-key picture-mode-map "\C-c\C-y" 'picture-yank-rectangle)
-      (define-key picture-mode-map "\C-c\C-x" 'picture-yank-rectangle-from-register)
-      (define-key picture-mode-map "\C-c\C-c" 'picture-mode-exit)
-      (define-key picture-mode-map "\C-c\C-f" 'picture-motion)
-      (define-key picture-mode-map "\C-c\C-b" 'picture-motion-reverse)
-      (define-key picture-mode-map "\C-c<" 'picture-movement-left)
-      (define-key picture-mode-map "\C-c>" 'picture-movement-right)
-      (define-key picture-mode-map "\C-c^" 'picture-movement-up)
-      (define-key picture-mode-map "\C-c." 'picture-movement-down)
-      (define-key picture-mode-map "\C-c`" 'picture-movement-nw)
-      (define-key picture-mode-map "\C-c'" 'picture-movement-ne)
-      (define-key picture-mode-map "\C-c/" 'picture-movement-sw)
-      (define-key picture-mode-map "\C-c\\" 'picture-movement-se)))
-
-(defvar picture-mode-hook nil
-  "If non-nil, its value is called on entry to Picture mode.
-Picture mode is invoked by the command \\[picture-mode].")
-
-(defvar picture-mode-old-local-map)
-(defvar picture-mode-old-mode-name)
-(defvar picture-mode-old-major-mode)
-(defvar picture-mode-old-truncate-lines)
-
-;;;###autoload
-(defun picture-mode ()
-  "Switch to Picture mode, in which a quarter-plane screen model is used.
-Printing characters replace instead of inserting themselves with motion
-afterwards settable by these commands:
-  C-c <	  Move left after insertion.
-  C-c >	  Move right after insertion.
-  C-c ^	  Move up after insertion.
-  C-c .	  Move down after insertion.
-  C-c `	  Move northwest (nw) after insertion.
-  C-c '	  Move northeast (ne) after insertion.
-  C-c /	  Move southwest (sw) after insertion.
-  C-c \\   Move southeast (se) after insertion.
-The current direction is displayed in the mode line.  The initial
-direction is right.  Whitespace is inserted and tabs are changed to
-spaces when required by movement.  You can move around in the buffer
-with these commands:
-  \\[picture-move-down]	  Move vertically to SAME column in previous line.
-  \\[picture-move-up]	  Move vertically to SAME column in next line.
-  \\[picture-end-of-line]	  Move to column following last non-whitespace character.
-  \\[picture-forward-column]	  Move right inserting spaces if required.
-  \\[picture-backward-column]	  Move left changing tabs to spaces if required.
-  C-c C-f Move in direction of current picture motion.
-  C-c C-b Move in opposite direction of current picture motion.
-  Return  Move to beginning of next line.
-You can edit tabular text with these commands:
-  M-Tab	  Move to column beneath (or at) next interesting character.
-	    `Indents' relative to a previous line.
-  Tab	  Move to next stop in tab stop list.
-  C-c Tab Set tab stops according to context of this line.
-	    With ARG resets tab stops to default (global) value.
-	    See also documentation of variable	picture-tab-chars
-	    which defines \"interesting character\".  You can manually
-	    change the tab stop list with command \\[edit-tab-stops].
-You can manipulate text with these commands:
-  C-d	  Clear (replace) ARG columns after point without moving.
-  C-c C-d Delete char at point - the command normally assigned to C-d.
-  \\[picture-backward-clear-column]  Clear (replace) ARG columns before point, moving back over them.
-  \\[picture-clear-line]	  Clear ARG lines, advancing over them.	 The cleared
-	    text is saved in the kill ring.
-  \\[picture-open-line]	  Open blank line(s) beneath current line.
-You can manipulate rectangles with these commands:
-  C-c C-k Clear (or kill) a rectangle and save it.
-  C-c C-w Like C-c C-k except rectangle is saved in named register.
-  C-c C-y Overlay (or insert) currently saved rectangle at point.
-  C-c C-x Like C-c C-y except rectangle is taken from named register.
-  \\[copy-rectangle-to-register]   Copies a rectangle to a register.
-  \\[advertised-undo]   Can undo effects of rectangle overlay commands
-	    commands if invoked soon enough.
-You can return to the previous mode with:
-  C-c C-c Which also strips trailing whitespace from every line.
-	    Stripping is suppressed by supplying an argument.
-
-Entry to this mode calls the value of  picture-mode-hook  if non-nil.
-
-Note that Picture mode commands will work outside of Picture mode, but
-they are not defaultly assigned to keys."
-  (interactive)
-  (if (eq major-mode 'picture-mode)
-      (error "You are already editing a picture.")
-    (make-local-variable 'picture-mode-old-local-map)
-    (setq picture-mode-old-local-map (current-local-map))
-    (use-local-map picture-mode-map)
-    (make-local-variable 'picture-mode-old-mode-name)
-    (setq picture-mode-old-mode-name mode-name)
-    (make-local-variable 'picture-mode-old-major-mode)
-    (setq picture-mode-old-major-mode major-mode)
-    (setq major-mode 'picture-mode)
-    (make-local-variable 'picture-killed-rectangle)
-    (setq picture-killed-rectangle nil)
-    (make-local-variable 'tab-stop-list)
-    (setq tab-stop-list (default-value 'tab-stop-list))
-    (make-local-variable 'picture-tab-chars)
-    (setq picture-tab-chars (default-value 'picture-tab-chars))
-    (make-local-variable 'picture-vertical-step)
-    (make-local-variable 'picture-horizontal-step)
-    (make-local-variable 'picture-mode-old-truncate-lines)
-    (setq picture-mode-old-truncate-lines truncate-lines)
-    (setq truncate-lines t)
-    (picture-set-motion 0 1)
-
-    ;; edit-picture-hook is what we used to run, picture-mode-hook is in doc.
-    (run-hooks 'edit-picture-hook 'picture-mode-hook)
-    (message "Type %s in this buffer to return it to %s mode."
-	     (substitute-command-keys "\\[picture-mode-exit]")
-	     picture-mode-old-mode-name)))
-
-;;;###autoload
-(defalias 'edit-picture 'picture-mode)
-
-(defun picture-mode-exit (&optional nostrip)
-  "Undo picture-mode and return to previous major mode.
-With no argument strips whitespace from end of every line in Picture buffer
-  otherwise just return to previous mode."
-  (interactive "P")
-  (if (not (eq major-mode 'picture-mode))
-      (error "You aren't editing a Picture.")
-    (if (not nostrip) (picture-clean))
-    (setq mode-name picture-mode-old-mode-name)
-    (use-local-map picture-mode-old-local-map)
-    (setq major-mode picture-mode-old-major-mode)
-    (kill-local-variable 'tab-stop-list)
-    (setq truncate-lines picture-mode-old-truncate-lines)
-    (force-mode-line-update)))
-
-(defun picture-clean ()
-  "Eliminate whitespace at ends of lines."
-  (save-excursion
-   (goto-char (point-min))
-   (while (re-search-forward "[ \t][ \t]*$" nil t)
-     (delete-region (match-beginning 0) (point)))))
-
-(provide 'picture)
-
-;;; picture.el ends here
diff --git a/lisp/textmodes/refbib.el b/lisp/textmodes/refbib.el
deleted file mode 100644
index ec3039e578d..00000000000
--- a/lisp/textmodes/refbib.el
+++ /dev/null
@@ -1,730 +0,0 @@
-;;; refbib.el --- convert refer-style references to ones usable by Latex bib
-
-;; Copyright (C) 1989 Free Software Foundation, Inc.
-
-;; Author: Henry Kautz <kautz@research.att.com>
-;; Keywords: bib, tex
-
-;; 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:
-
-;; Use: from a buffer containing the refer-style bibliography,
-;;   M-x r2b-convert-buffer
-;; Program will prompt for an output buffer name, and will log
-;; warnings during the conversion process in the buffer *Log*.
-
-;;; Change Log:
-
-;; HISTORY
-;; 9/88, created H.Kautz
-;; modified 1/19/89, allow books with editor but no author;
-;;                   added %O ordering field;
-;;                   appended illegal multiple fields, instead of 
-;;                     discarding;
-;;                   added rule, a tech report whose %R number
-;;                     contains "ISBN" is really a book
-;;                   added rule, anything with an editor is a book
-;;                     or a proceedings
-;;                   added 'manual type, for items with institution
-;;                     but no author or editor
-;;                   fixed bug so trailing blanks are trimmed
-;;                   added 'proceedings type
-;;                   used "organization" field for proceedings
-;; modified 2/16/89, updated help messages
-;; modified 2/23/89, include capitalize stop words in r2b stop words,
-;;                   fixed problems with contractions (e.g. it's),
-;;                   caught multiple stop words in a row
-;; modified 3/1/89,  fixed capitalize-title for first words all caps
-;; modified 3/15/89, allow use of " to delimit fields
-;; modified 4/18/89, properly "quote" special characters on output
-
-;;; Code:
-
-;**********************************************************
-; User Parameters
-
-(defvar r2b-trace-on nil "*trace conversion")
-
-(defvar r2b-journal-abbrevs
-   '(  
-       )
-   "  Abbreviation list for journal names.  
-If the car of an element matches a journal name exactly, it is replaced by
-the cadr when output.  Braces must be included if replacement is a
-{string}, but not if replacement is a bibtex abbreviation.  The cadr
-may be eliminated if is exactly the same as the car.  
-  Because titles are capitalized before matching, the abbreviation
-for the journal name should be listed as beginning with a capital 
-letter, even if it really doesn't.
-  For example, a value of '((\"Aij\" \"{Artificial Intelligence}\")
-\(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string
-\"Artificial Intelligence\", but would replace Ijcai81 with the 
-BibTeX macro \"ijcai7\".")
-
-(defvar r2b-booktitle-abbrevs 
-   '(  
-       )
-   "  Abbreviation list for book and proceedings names.  If the car of
-an element matches a title or booktitle exactly, it is replaced by 
-the cadr when output.  Braces must be included if replacement is 
-a {string}, but not if replacement is a bibtex abbreviation.  The cadr 
-may be eliminated if is exactly the same as the car.  
-  Because titles are capitalized before matching, the abbreviated title
-should be listed as beginning with a capital letter, even if it doesn't.
-  For example, a value of '((\"Aij\" \"{Artificial Intelligence}\")
-\(\"Ijcai81\" \"ijcai7\")) would expand Aij to the text string
-\"Artificial Intelligence\", but would replace Ijcai81 with the 
-BibTeX macro \"ijcai7\".")
-
-(defvar r2b-proceedings-list
-   '()
-   "  Assoc list of books or journals which are really conference proceedings,
-but whose name and whose abbrev expansion (as defined in `r2b-journal-abbrevs'
-and `r2b-booktitle-abbrevs') does not contain the words \"conference\" or
-\"proceedings\".  (Those cases are handled automatically.)
-The entry must match the given data exactly.
-  Because titles are capitalized before matching, the items in this list 
-should begin with a capital letter.
-  For example, suppose the title \"Ijcai81\" is used for the proceedings of
-a conference, and its expansion is the BibTeX macro \"ijcai7\".  Then
-`r2b-proceedings-list' should be '((\"Ijcai81\") ...).  If instead its
-expansion were \"Proceedings of the Seventh International Conference
-on Artificial Intelligence\", then you would NOT need to include Ijcai81
-in `r2b-proceedings-list' (although it wouldn't cause an error).")
-
-(defvar r2b-additional-stop-words
-	 "Some\\|What"
-   "Words not to be used to build the citation key.
-This is in addition to the `r2b-capitalize-title-stop-words'.")
-
-(defvar r2b-delimit-with-quote
-  t
-  "*If true, then use \" to delimit fields, otherwise use braces")
-
-;**********************************************************
-; Utility Functions
-
-(defvar r2b-capitalize-title-stop-words
-   (concat
-      "the\\|and\\|of\\|is\\|a\\|an\\|of\\|for\\|in\\|to\\|in\\|on\\|at\\|"
-      "by\\|with\\|that\\|its")
-   "Words not to be capitalized in a title (unless the first word).")
-
-(defvar r2b-capitalize-title-stop-regexp
-   (concat "\\(" r2b-capitalize-title-stop-words "\\)\\(\\b\\|'\\)"))
-
-(defun r2b-capitalize-title-region (begin end)
-   "Like `capitalize-region', but don't capitalize stop words, except the first."
-   (interactive "r")
-   (let ((case-fold-search nil) (orig-syntax-table (syntax-table)))
-      (unwind-protect
-	 (save-restriction
-	    (set-syntax-table text-mode-syntax-table)
-	    (narrow-to-region begin end)
-	    (goto-char (point-min))
-	    (if (looking-at "[A-Z][a-z]*[A-Z]")
-	       (forward-word 1)
-	       (capitalize-word 1))
-	    (while (re-search-forward "\\<" nil t)
-	       (if (looking-at "[A-Z][a-z]*[A-Z]")
-		  (forward-word 1)
-		  (if (let ((case-fold-search t))
-			 (looking-at r2b-capitalize-title-stop-regexp))
-		     (downcase-word 1)
-		     (capitalize-word 1)))
-	       ))
-	 (set-syntax-table orig-syntax-table))))
-
-
-(defun r2b-capitalize-title (s)
-   "Like `capitalize', but don't capitalize stop words, except the first."
-   (save-excursion
-      (set-buffer (get-buffer-create "$$$Scratch$$$"))
-      (erase-buffer)
-      (insert s)
-      (r2b-capitalize-title-region (point-min) (point-max))
-      (buffer-string)))
-
-;*********************************************************
-(defun r2b-reset ()
-   "Unbind defvars, for debugging."
-   (interactive)
-   (makunbound 'r2b-journal-abbrevs)
-   (makunbound 'r2b-booktitle-abbrevs)
-   (makunbound 'r2b-proceedings-list)
-   (makunbound 'r2b-capitalize-title-stop-words)
-   (makunbound 'r2b-capitalize-title-stop-regexp)
-   (makunbound 'r2b-additional-stop-words)
-   (makunbound 'r2b-stop-regexp))
-
-(defvar r2b-stop-regexp
-   (concat "\\`\\(\\(" 
-      r2b-additional-stop-words "\\|" r2b-capitalize-title-stop-words
-      "\\)\\('\\w*\\)?\\W+\\)*\\([A-Z0-9]+\\)"))
-
-
-(defun r2b-trace (&rest args)
-   (if r2b-trace-on
-      (progn
-	 (apply (function message) args)
-	 (sit-for 0))))
-
-(defun r2b-match (exp)
-   "Returns string matched in current buffer."
-   (buffer-substring (match-beginning exp) (match-end exp)))
-
-(defvar r2b-out-buf-name "*Out*" "*output from refer-to-bibtex" )
-(defvar r2b-log-name "*Log*" "*logs errors from refer-to-bibtex" )
-(defvar r2b-in-buf nil)
-(defvar r2b-out-buf nil)
-(defvar r2b-log nil)
-
-(defvar r2b-error-found nil)
-
-(setq r2b-variables '(
-			r2b-error-found
-			  r2bv-author
-			  r2bv-primary-author
-			  r2bv-date
-			  r2bv-year
-			  r2bv-decade
-			  r2bv-month
-			  r2bv-title
-			  r2bv-title-first-word
-			  r2bv-editor
-			  r2bv-annote
-			  r2bv-tr
-			  r2bv-address
-			  r2bv-institution
-			  r2bv-keywords
-			  r2bv-booktitle
-			  r2bv-journal
-			  r2bv-volume
-			  r2bv-number
-			  r2bv-pages
-			  r2bv-booktitle
-			  r2bv-kn
-			  r2bv-publisher
-			  r2bv-organization
-			  r2bv-school
-			  r2bv-type
-			  r2bv-where
-			  r2bv-note
-			  r2bv-ordering
-			  ))
-
-(defun r2b-clear-variables ()
-   "Set all global vars used by r2b to nil."
-   (let ((vars r2b-variables))
-      (while vars
-	 (set (car vars) nil)
-	 (setq vars (cdr vars)))))
-
-(defun r2b-warning (&rest args)
-   (setq r2b-error-found t)
-   (princ (apply (function format) args) r2b-log)
-   (princ "\n" r2b-log)
-   (princ "\n" r2b-out-buf)
-   (princ "% " r2b-out-buf)
-   (princ (apply (function format) args) r2b-out-buf))
-
-(defun r2b-get-field (var field &optional unique required capitalize)
-   "Set VAR to string value of FIELD, if any.  If none, VAR is set to
-nil.  If multiple fields appear, then separate values with the
-'\\nand\\t\\t', unless UNIQUE is non-nil, in which case log a warning
-and just concatenate the values.  Trim off leading blanks and tabs on
-first line, and trailing blanks and tabs of every line.  Log a warning
-and set VAR to the empty string if REQUIRED is true.  Capitalize as a
-title if CAPITALIZE is true.  Returns value of VAR."
-   (let (item val (not-past-end t))
-      (r2b-trace "snarfing %s" field)
-      (goto-char (point-min))
-      (while (and not-past-end
-		(re-search-forward 
-		   (concat "^" field "\\b[ \t]*\\(.*[^ \t\n]\\)[ \t]*") nil t))
-	 (setq item (r2b-match 1))
-	 (while (and (setq not-past-end (zerop (forward-line 1)))
-		   (not (looking-at "[ \t]*$\\|%")))
-	       (looking-at "\\(.*[^ \t\n]\\)[ \t]*$")
-	       (setq item (concat item "\n" (r2b-match 1)))
-	    )
-	 (if (null val)
-	    (setq val item)
-	    (if unique
-	       (progn
-		  (r2b-warning "*Illegal multiple field %s %s" field item)
-		  (setq val (concat val "\n" item))
-		  )
-	       (setq val (concat val "\n\t\tand " item))
-	       )
-	    )
-	 )
-      (if (and val capitalize)
-	 (setq val (r2b-capitalize-title val)))
-      (set var val)
-      (if (and (null val) required)
-	 (r2b-require var))
-      ))
-
-(defun r2b-set-match (var n regexp string )
-   "Set VAR to the Nth subpattern in REGEXP matched by STRING, or nil if none."
-   (set var
-      (if (and (stringp string) (string-match regexp string))
-	 (substring string (match-beginning n) (match-end n))
-	 nil)
-      )
-   )
-
-(defvar r2b-month-abbrevs
-   '(("jan") ("feb") ("mar") ("apr") ("may") ("jun") ("jul") ("aug")
-       ("sep") ("oct") ("nov") ("dec")))
-
-(defun r2b-convert-month ()
-   "Try to convert `r2bv-month' to a standard 3 letter name."
-   (if r2bv-month
-      (let ((months r2b-month-abbrevs))
-	 (if (string-match "[^0-9]" r2bv-month)
-	    (progn
-	       (while (and months (not (string-match (car (car months)) 
-					  r2bv-month)))
-		  (setq months (cdr months)))
-	       (if months
-		  (setq r2bv-month (car (car months)))))
-	    (progn
-	       (setq months (car (read-from-string r2bv-month)))
-	       (if (and (numberp months)
-		      (> months 0)
-		      (< months 13))
-		  (setq r2bv-month (car (nth months r2b-month-abbrevs)))
-		  (progn
-		     (r2b-warning "* Ridiculous month")
-		     (setq r2bv-month nil))
-		  ))
-	    ))
-      )
-   )
-
-(defun r2b-snarf-input ()
-   "Parse buffer into global variables."
-   (let ((case-fold-search t))
-      (r2b-trace "snarfing...")
-      (sit-for 0)
-      (set-buffer r2b-in-buf)
-      (goto-char (point-min))
-      (princ "    " r2b-log)
-      (princ (buffer-substring (point) (progn (end-of-line) (point))) r2b-log)
-      (terpri r2b-log)
-
-      (r2b-get-field 'r2bv-author "%A")
-      (r2b-get-field 'r2bv-editor "%E")
-      (cond
-	 (r2bv-author
-	    (r2b-set-match 'r2bv-primary-author 1
-	       "\\b\\(\\w+\\)[ \t]*\\($\\|,\\)" r2bv-author)
-	    )
-	 (r2bv-editor
-	    (r2b-set-match 'r2bv-primary-author 1
-	       "\\b\\(\\w+\\)[ \t]*\\($\\|,\\)" r2bv-editor)
-	    )
-	 (t
-	    (setq r2bv-primary-author "")
-	    )
-	 )
-
-      (r2b-get-field 'r2bv-date "%D" t t)
-      (r2b-set-match 'r2bv-year 0 "[12][0-9][0-9][0-9]" r2bv-date)
-      (and (null r2bv-year)
-	 (r2b-set-match 'r2bv-year 1 "[^0-9]\\([0-9][0-9]\\)$" r2bv-date)
-	 (setq r2bv-year (concat "19" r2bv-year)))
-      (r2b-set-match 'r2bv-decade 1 "..\\(..\\)" r2bv-year)
-      (r2b-set-match 'r2bv-month 0
-	 "[0-9]+/\\|[a-zA-Z]+" r2bv-date)
-      (if (and (stringp r2bv-month) (string-match "\\(.*\\)/$" r2bv-month))
-	 (setq r2bv-month (substring r2bv-month 0 (match-end 1))))
-      (r2b-convert-month)
-
-      (r2b-get-field 'r2bv-title "%T" t t t)
-      (r2b-set-match 'r2bv-title-first-word 4
-	 r2b-stop-regexp
-	 r2bv-title)
-      
-      (r2b-get-field 'r2bv-annote "%X" t )
-      (r2b-get-field 'r2bv-tr "%R" t)
-      (r2b-get-field 'r2bv-address "%C" t)
-      (r2b-get-field 'r2bv-institution "%I" t)
-      (r2b-get-field 'r2bv-keywords "%K")
-      (r2b-get-field 'r2bv-booktitle "%B" t nil t)
-      (r2b-get-field 'r2bv-journal "%J" t nil t)
-      (r2b-get-field 'r2bv-volume "%V" t)
-      (r2b-get-field 'r2bv-number "%N" t)
-      (r2b-get-field 'r2bv-pages "%P" t)
-      (r2b-get-field 'r2bv-where "%W" t)
-      (r2b-get-field 'r2bv-ordering "%O" t)
-      )
-   )
-
-
-(defun r2b-put-field (field data &optional abbrevs)
-  "Print bibtex FIELD = {DATA} if DATA not null; precede
-with a comma and newline; if ABBREVS list is given, then
-try to replace the {DATA} with an abbreviation."
-  (if data
-    (let (match nodelim multi-line index)
-      (cond
-	((and abbrevs (setq match (assoc data abbrevs)))
-	  (if (null (cdr match))
-	    (setq data (car match))
-	    (setq data (car (cdr match))))
-	  (setq nodelim t))
-	((and (not (equal data ""))
-		(not (string-match "[^0-9]" data)))
-	  (setq nodelim t))
-	(t
-	  (setq index 0)
-	  (while (string-match "[\\~^]" data index)
-	    (setq data (concat (substring data 0 (match-beginning 0))
-			 "\\verb+"
-			 (substring data (match-beginning 0) (match-end 0))
-			 "+"
-			 (substring data (match-end 0))))
-	    (setq index (+ (match-end 0) 7)))
-	  (setq index 0)
-	  (while (string-match "[$&%#_{}]" data index)
-	    (setq data (concat (substring data 0 (match-beginning 0))
-			 "\\"
-			 (substring data (match-beginning 0))))
-	    (setq index (+ (match-end 0) 1)))
-	  (setq index 0)
-	  (if r2b-delimit-with-quote
-	    (while (string-match "\"" data index)
-	      (setq data (concat (substring data 0 (match-beginning 0))
-			   "{\"}"
-			   (substring data (match-end 0))))
-	      (setq index (+ (match-end 0) 2))))
-	    ))
-      (princ ", \n  ")
-      (princ field)
-      (princ " =\t")
-      (if (not nodelim) 
-	(if r2b-delimit-with-quote
-	  (princ "\"")
-	  (princ "{")))
-      (string-match ".*" data)
-      (if (> (match-end 0) 59)
-	(princ "\n"))
-      (princ data)
-      (if (not nodelim) 
-	(if r2b-delimit-with-quote
-	  (princ "\"")
-	  (princ "}")))
-      )
-    ))
-
-
-(defun r2b-require (vars)
-   "If any of VARS is null, set to empty string and log error."
-   (cond 
-      ((null vars))
-      ((listp vars) (r2b-require (car vars)) (r2b-require (cdr vars)))
-      (t
-	 (if (null (symbol-value vars))
-	    (progn
-	       (r2b-warning "*Missing value for field %s" vars)
-	       (set vars "")
-	       )))
-      )
-   )
-
-
-(defmacro r2b-moveq (new old)
-   "Set NEW to OLD and set OLD to nil."
-   (list 'progn (list 'setq new old) (list 'setq old 'nil)))
-
-(defun r2b-isa-proceedings (name)
-   "Return t if NAME is the name of proceedings."
-   (and
-      name
-      (or
-	 (string-match "proceedings\\|conference" name)
-	 (assoc name r2b-proceedings-list)
-	 (let ((match (assoc name r2b-booktitle-abbrevs)))
-	    (and match
-	       (string-match "proceedings\\|conference" (car (cdr match)))))
-      )))
-
-(defun r2b-isa-university (name)
-   "Return t if NAME is a university or similar organization,
-but not a publisher."
-   (and 
-      name
-      (string-match "university" name)
-      (not (string-match "press" name))
-
-   ))
-
-(defun r2b-barf-output ()
-   "Generate bibtex based on global variables."
-   (let ((standard-output r2b-out-buf) (case-fold-search t) match)
-
-      (r2b-trace "...barfing")
-      (sit-for 0)
-      (set-buffer r2b-out-buf)
-
-      (setq r2bv-kn (concat r2bv-primary-author r2bv-decade
-			r2bv-title-first-word))
-      
-      (setq r2bv-entry-kind
-	 (cond 
-	    ((r2b-isa-proceedings r2bv-journal)
-	       (r2b-moveq r2bv-booktitle r2bv-journal)
-	       (if (r2b-isa-university r2bv-institution)
-		  (r2b-moveq r2bv-organization r2bv-institution)
-		  (r2b-moveq r2bv-publisher r2bv-institution))
-	       (r2b-moveq r2bv-note r2bv-tr)
-	       (r2b-require 'r2bv-author)
-	       'inproceedings)
-	    ((r2b-isa-proceedings r2bv-booktitle)
-	       (if (r2b-isa-university r2bv-institution)
-		  (r2b-moveq r2bv-organization r2bv-institution)
-		  (r2b-moveq r2bv-publisher r2bv-institution))
-	       (r2b-moveq r2bv-note r2bv-tr)
-	       (r2b-require 'r2bv-author)
-	       'inproceedings)
-	    ((and r2bv-tr (string-match "phd" r2bv-tr))
-	       (r2b-moveq r2bv-school r2bv-institution)
-	       (r2b-require 'r2bv-school )
-	       (r2b-require 'r2bv-author)
-	       'phdthesis)
-	    ((and r2bv-tr (string-match "master" r2bv-tr))
-	       (r2b-moveq r2bv-school r2bv-institution)
-	       (r2b-require 'r2bv-school )
-	       (r2b-require 'r2bv-author)
-	       'mastersthesis)
-	    ((and r2bv-tr (string-match "draft\\|unpublish" r2bv-tr))
-	       (r2b-moveq r2bv-note r2bv-institution)
-	       (r2b-require 'r2bv-author)
-	       'unpublished)
-	    (r2bv-journal
-	       (r2b-require 'r2bv-author)
-	       'article)
-	    (r2bv-booktitle
-	       (r2b-moveq r2bv-publisher r2bv-institution)
-	       (r2b-moveq r2bv-note r2bv-tr)
-	       (r2b-require 'r2bv-publisher)
-	       (r2b-require 'r2bv-author)
-	       'incollection)
-	    ((and r2bv-author
-		(null r2bv-editor)
-		(string-match "\\`personal communication\\'" r2bv-title))
-	       'misc)
-	    ((r2b-isa-proceedings r2bv-title)
-	       (if (r2b-isa-university r2bv-institution)
-		  (r2b-moveq r2bv-organization r2bv-institution)
-		  (r2b-moveq r2bv-publisher r2bv-institution))
-	       (r2b-moveq r2bv-note r2bv-tr)
-	       'proceedings)
-	    ((or r2bv-editor
-		(and r2bv-author
-		   (or 
-		      (null r2bv-tr)
-		      (string-match "\\bisbn\\b" r2bv-tr))))
-	       (r2b-moveq r2bv-publisher r2bv-institution)
-	       (r2b-moveq r2bv-note r2bv-tr)
-	       (r2b-require 'r2bv-publisher)
-	       (if (null r2bv-editor)
-		  (r2b-require 'r2bv-author))
-	       'book)
-	    (r2bv-tr
-	       (r2b-require 'r2bv-institution)
-	       (if (string-match 
-		      "\\`\\(\\(.\\|\n\\)+\\)[ \t\n]+\\([^ \t\n]\\)+\\'" 
-		      r2bv-tr)
-		  (progn
-		     (setq r2bv-type (substring r2bv-tr 0 (match-end 1)))
-		     (setq r2bv-number (substring r2bv-tr 
-					  (match-beginning 3)))
-		     (setq r2bv-tr nil))
-		  (r2b-moveq r2bv-number r2bv-tr))
-	       (r2b-require 'r2bv-author)
-	       'techreport)
-	    (r2bv-institution
-	       (r2b-moveq r2bv-organization r2bv-institution)
-	       'manual)
-	    (t
-	       'misc)
-	    ))
-
-      (r2b-require '( r2bv-year))
-
-      (if r2b-error-found
-	 (princ "\n% Warning -- Errors During Conversion Next Entry\n"))
-
-      (princ "\n@")
-      (princ r2bv-entry-kind)
-      (princ "( ")
-      (princ r2bv-kn)
-
-      (r2b-put-field "author" r2bv-author )
-      (r2b-put-field "title" r2bv-title r2b-booktitle-abbrevs)
-      (r2b-put-field "year" r2bv-year )
-
-      (r2b-put-field "month" r2bv-month r2b-month-abbrevs)
-      (r2b-put-field "journal" r2bv-journal r2b-journal-abbrevs)
-      (r2b-put-field "volume" r2bv-volume)
-      (r2b-put-field "type" r2bv-type)
-      (r2b-put-field "number" r2bv-number)
-      (r2b-put-field "booktitle" r2bv-booktitle r2b-booktitle-abbrevs)
-      (r2b-put-field "editor" r2bv-editor)
-      (r2b-put-field "publisher" r2bv-publisher)
-      (r2b-put-field "institution" r2bv-institution)
-      (r2b-put-field "organization" r2bv-organization)
-      (r2b-put-field "school" r2bv-school)
-      (r2b-put-field "pages" r2bv-pages)
-      (r2b-put-field "address" r2bv-address)
-      (r2b-put-field "note" r2bv-note)
-      (r2b-put-field "keywords" r2bv-keywords)
-      (r2b-put-field "where" r2bv-where)
-      (r2b-put-field "ordering" r2bv-ordering)
-      (r2b-put-field "annote" r2bv-annote)
-
-      (princ " )\n")
-      )
-   )
-
-
-(defun r2b-convert-record (output-name)
-   "Transform current bib entry and append to buffer OUTPUT;
-do \"M-x r2b-help\" for more info."
-   (interactive 
-      (list (read-string "Output to buffer: " r2b-out-buf-name)))
-   (let (rec-end rec-begin not-done)
-      (setq r2b-out-buf-name output-name)
-      (setq r2b-out-buf (get-buffer-create output-name))
-      (setq r2b-in-buf (current-buffer))
-      (set-buffer r2b-out-buf)
-      (goto-char (point-max))
-      (setq r2b-log (get-buffer-create r2b-log-name))
-      (set-buffer r2b-log)
-      (goto-char (point-max))
-      (set-buffer r2b-in-buf)
-      (setq not-done (re-search-forward "[^ \t\n]" nil t))
-      (if not-done
-	 (progn
-	    (re-search-backward "^[ \t]*$" nil 2)
-	    (re-search-forward "^%")
-	    (beginning-of-line nil)
-	    (setq rec-begin (point))
-	    (re-search-forward "^[ \t]*$" nil 2)
-	    (setq rec-end (point))
-	    (narrow-to-region rec-begin rec-end)
-	    (r2b-clear-variables)
-	    (r2b-snarf-input)
-	    (r2b-barf-output)
-	    (set-buffer r2b-in-buf)
-	    (widen)
-	    (goto-char rec-end)
-	    t)
-	 nil
-	 )
-      ))
-      
-      
-(defun r2b-convert-buffer (output-name)
-   "Transform current buffer and append to buffer OUTPUT;
-do \"M-x r2b-help\" for more info."
-   (interactive 
-      (list (read-string "Output to buffer: " r2b-out-buf-name)))
-   (save-excursion
-      (setq r2b-log (get-buffer-create r2b-log-name))
-      (set-buffer r2b-log)
-      (erase-buffer))
-   (widen)
-   (goto-char (point-min))
-   (message "Working, please be patient...")
-   (sit-for 0)
-   (while (r2b-convert-record output-name) t)
-   (message "Done, results in %s, errors in %s" 
-      r2b-out-buf-name r2b-log-name)
-   )
-
-(defvar r2b-load-quietly nil "*Don't print help message when loaded")
-
-(defvar r2b-help-message
-"                   Refer to Bibtex Bibliography Conversion
-
-A refer-style database is of the form:
-
-%A Joe Blow
-%T Great Thoughts I've Thought
-%D 1977
-etc.
-
-This utility converts these kind of databases to bibtex form, for
-users of TeX and LaTex.  Instructions:
-1.  Visit the file containing the refer-style database.
-2.  The command
-	M-x r2b-convert-buffer
-    converts the entire buffer, appending its output by default in a
-    buffer named *Out*, and logging progress and errors in a buffer
-    named *Log*.  The original file is never modified.
-	Note that results are appended to *Out*, so if that buffer
-	buffer already exists and contains material you don't want to
- 	save, you should kill it first.
-3.  Switch to the buffer *Out* and save it as a named file.
-4.  To convert a single refer-style entry, simply position the cursor
-    at the entry and enter
-	M-x r2b-convert-record
-    Again output is appended to *Out* and errors are logged in *Log*.
-
-This utility is very robust and pretty smart about determining the
-type of the entry.  It includes facilities for expanding refer macros
-to text, or substituting bibtex macros.  Do M-x describe-variable on
-     r2b-journal-abbrevs
-     r2b-booktitle-abbrevs
-     r2b-proceedings-list
-for information on these features.
-
-If you don't want to see this help message when you load this utility,
-then include the following line in your .emacs file:
-	(setq r2b-load-quietly t)
-To see this message again, perform 
-         M-x r2b-help
-Please send bug reports and suggestions to
-	Henry Kautz
-        kautz@research.att.com
-	allegra!kautz")
-
-
-(defun r2b-help ()
-   "Print help message."
-   (interactive)
-   (with-output-to-temp-buffer "*Help*"
-      (princ r2b-help-message)
-      (save-excursion
-	(set-buffer standard-output)
-	(help-mode))))
-
-(if (not r2b-load-quietly)
-   (r2b-help))
-
-(message "r2b loaded")
-
-(provide 'refer-to-bibtex)
-
-;;; refbib.el ends here
diff --git a/lisp/textmodes/refer.el b/lisp/textmodes/refer.el
deleted file mode 100644
index 3234acf2d02..00000000000
--- a/lisp/textmodes/refer.el
+++ /dev/null
@@ -1,387 +0,0 @@
-;;; refer.el --- look up references in bibliography files.
-
-;; Copyright (C) 1992, 1996 Free Software Foundation, Inc.
-
-;; Author: Ashwin Ram <ashwin@cc.gatech.edu>
-;; Maintainer: Gernot Heiser <gernot@jungfrau.disy.cse.unsw.EDU.AU>
-;; Adapted-By: ESR
-;; Keywords: bib
-
-;; 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:
-
-;; Functions to look up references in bibliography files given lists of
-;; keywords, similar to refer(1).  I don't use tags since tags on .bib files
-;; only picks up the cite key, where as refer-find-entry looks for occurrences
-;; of keywords anywhere in the bibliography entry.
-;;
-;; To use:
-;;      (autoload 'refer-find-entry "refer" nil t)
-;; or   (require 'refer)
-;;
-;;      To look for an article by Knuth about semaphores:
-;;          Invoke refer-find-entry, then in response to the Keywords: prompt,
-;;          say: Knuth semaphores (a blank-separated list of keywords to be used
-;;          as search strings).
-;;
-;;      To continue the previous search, i.e., to search for the next occurrence
-;;      of the keywords, use refer-find-next-entry, or invoke refer-find-entry
-;;      with a prefix argument.
-;;
-;;	Once you've found the entry you want to reference, invoke
-;;	refer-yank-key to insert it at point in the current buffer
-;;	(typically as the argument of a \cite{} command).
-;;
-;;	I use (define-key tex-mode-map    "\C-c\C-y"  'refer-yank-key)
-;;	to bind this often-used function to a key in (la)tex-mode.
-;;
-;;      If the list of bibliography files changes, reinitialize the variable
-;;      refer-bib-files.
-;;
-;; To customize:
-;;      See variables refer-bib-files, refer-cache-bib-files and
-;;      refer-bib-files-regexp.  By default, these are set up so that refer
-;;      looks for the keywords you specify in all the .bib files in the current
-;;      directory.
-;;
-;;      The only assumption I make about bib files is that they contain a bunch
-;;      of entries, one to a paragraph.  refer-find-entry searches paragraph by
-;;      paragraph, looking for a paragraph containing all the keywords
-;;      specified.  So you should be able to use pretty much any bib file with
-;;      this code.  If your bib file does not use paragraphs to separate
-;;      entries, try setting the paragraph-start/separate variables, or changing
-;;      the (forward-paragraph 1) call in refer-find-entry-in-file.
-
-;;; Code:
-
-(provide 'refer)
-
-(defvar refer-bib-directory nil
-  "Directory, or list of directories, to search for \\.bib files. Can
-be set to 'bibinputs or 'texinputs, in which case the environment
-variable BIBINPUTS or TEXINPUTS, respectively, is used to obtain a
-list of directories.  Useful only if refer-bib-files is set to 'dir or
-a list of file names (without directory). A value of nil indicates the
-current working directory.
-
-If refer-bib-directory is 'bibinputs or 'texinputs, it is setq'd to
-the appropriate list of directories when it is first used.
-
-Note that an empty directory is interpreted by BibTeX as indicating
-the default search path. Since Refer does not know that default path,
-it cannot search it. Include that path explicitly in your BIBINPUTS
-environment if you really want it searched (which is not likely to
-happen anyway).")
-
-(defvar refer-bib-files 'dir
-   "*List of \\.bib files to search for references,
-or one of the following special values:
-nil  = prompt for \\.bib file (if visiting a \\.bib file, use it as default)
-auto = read \\.bib file names from appropriate command in buffer (see
-       refer-bib-files-regexp) unless the buffer's mode is bibtex-mode,
-       in which case only the buffer is searched
-dir  = use all \\.bib files in directories referenced by refer-bib-directory.
-
-If a specified file doesn't exist and has no extension, a \\.bib extension
-is automatically tried.
-
-If refer-bib-files is nil, auto or dir, it is setq'd to the appropriate
-list of files when it is first used if refer-cache-bib-files is t.  If
-refer-cache-bib-files is nil, the list of \\.bib files to use is re-read
-each time it is needed.")
-
-(defvar refer-cache-bib-files t
-   "*Variable determining whether the value of refer-bib-files should be cached.
-If t, initialize the value of refer-bib-files the first time it is used.  If
-nil, re-read the list of \\.bib files depending on the value of refer-bib-files
-each time it is needed.")
-
-(defvar refer-bib-files-regexp "\\\\bibliography"
-   "*Regexp matching a bibliography file declaration.
-The current buffer is expected to contain a line such as
-\\bibliography{file1,file2,file3}
-which is read to set up refer-bib-files.  The regexp must specify the command
-(such as \\bibliography) that is used to specify the list of bib files.  The
-command is expected to specify a file name, or a list of comma-separated file
-names, within curly braces.
-If a specified file doesn't exist and has no extension, a \\.bib extension
-is automatically tried.")
-
-(make-variable-buffer-local 'refer-bib-files)
-(make-variable-buffer-local 'refer-cache-bib-files)
-(make-variable-buffer-local 'refer-bib-directory)
-
-;;; Internal variables
-(defvar refer-saved-state nil)
-(defvar refer-previous-keywords nil)
-(defvar refer-saved-pos nil)
-(defvar refer-same-file nil)
-
-(defun refer-find-entry (keywords &optional continue)
-   "Find entry in refer-bib-files containing KEYWORDS.
-If KEYWORDS is nil, prompt user for blank-separated list of keywords.
-If CONTINUE is t, or if called interactively with a prefix arg, look for next
-entry by continuing search from previous point."
-   (interactive (list nil current-prefix-arg))
-   (or keywords (setq keywords (if continue
-                                   refer-previous-keywords
-                                 (read-string "Keywords: "))))
-   (setq refer-previous-keywords keywords)
-   (refer-find-entry-internal keywords continue))
-
-(defun refer-find-next-entry ()
-   "Find next occurrence of entry in refer-bib-files.  See refer-find-entry."
-   (interactive)
-   (refer-find-entry-internal refer-previous-keywords t))
-
-(defun refer-yank-key ()
-  "Inserts at point in current buffer the \"key\" field of the entry
-found on the last refer-find-entry or refer-find-next-entry."
-  (interactive)
-  (let ((old-point (point)))
-    (insert
-     (save-window-excursion
-       (save-excursion
-         (find-file (car refer-saved-state))
-         (if (looking-at
-              "[ \t\n]*@\\s-*[a-zA-Z][a-zA-Z0-9]*\\s-*{\\s-*\\([^ \t\n,]+\\)\\s-*,")
-             (buffer-substring (match-beginning 1) (match-end 1))
-           (error "Cannot find key for entry in file %s."
-                  (car refer-saved-state))))))
-    (if (not (= (point) old-point))
-      (set-mark old-point))))
-
-(defun refer-find-entry-internal (keywords continue)
-   (let ((keywords-list (refer-convert-string-to-list-of-strings keywords))
-         (old-buffer (current-buffer))
-         (old-window (selected-window))
-         (new-window (selected-window))
-         (files (if continue
-                    refer-saved-state
-                  (setq refer-saved-pos nil)
-                  (refer-get-bib-files)))
-         (n 0)
-         (found nil)
-         (file nil))
-     ;; find window in which to display bibliography file.
-     ;; if a bibliography file is already displayed in a window, use
-     ;; that one, otherwise use any window other than the current one
-     (while (not found)
-       (while (and (not (null (setq file (nth n files))))
-                   (setq n (1+ n))
-                   (not (string-equal file
-                                      (buffer-file-name
-                                       (window-buffer new-window))))))
-       (setq found
-             (if (null file)
-                 (eq (setq new-window (next-window new-window 'nomini))
-                     old-window)
-               't)))
-     (if (null file)                     ; didn't find bib file in any window:
-         (progn (if (one-window-p 'nomini)
-                    (setq old-window (split-window)))
-                (setq new-window (next-window old-window 'nomini))))
-     (select-window (if refer-same-file
-                        old-window
-                      new-window))  ; the window in which to show the bib file
-     (catch 'found
-       (while files
-         (let ((file (cond ((file-exists-p (car files)) (car files))
-                           ((file-exists-p (concat (car files) ".bib"))
-                            (concat (car files) ".bib")))))
-           (setq refer-saved-state files)
-           (if file
-               (if (refer-find-entry-in-file keywords-list file refer-saved-pos)
-                   (progn
-                     (setq refer-saved-pos (point))
-                     (recenter 0)
-                     (throw 'found (find-file file)))
-                 (setq refer-saved-pos nil
-                       files (cdr files)))
-             (progn (message "Scanning %s... No such file" (car files) (ding))
-                    (sit-for 1)
-                    (setq files (cdr files))))))
-       (message "Keywords \"%s\" not found in any \.bib file" keywords (ding)))
-     (select-window old-window)))
-
-(defun refer-find-entry-in-file (keywords-list file &optional old-pos)
-   (message "Scanning %s..." file)
-   (expand-file-name file)
-   (set-buffer (find-file-noselect file))
-   (find-file file)
-   (if (not old-pos)
-       (goto-char (point-min))
-     (goto-char old-pos)
-     (forward-paragraph 1))
-   (let ((begin (point))
-         (end 0)
-         (found nil))
-     (while (and (not found)
-                 (not (eobp)))
-       (forward-paragraph 1)
-       (setq end (point))
-       (setq found
-             (refer-every (function (lambda (keyword)
-                                (goto-char begin)
-                                (re-search-forward keyword end t)))
-                    keywords-list))
-       (if (not found)
-           (progn
-             (setq begin end)
-             (goto-char begin))))
-     (if found
-         (progn (goto-char begin)
-                (re-search-forward "\\W" nil t)
-                (message "Scanning %s... found" file))
-       (progn (message "Scanning %s... not found" file)
-              nil))))
-
-(defun refer-every (pred l)
-  (cond ((null l) nil)
-	((funcall pred (car l))
-	 (or (null (cdr l))
-	     (refer-every pred (cdr l))))))
-
-(defun refer-convert-string-to-list-of-strings (s)
-   (let ((current (current-buffer))
-         (temp-buffer (get-buffer-create "*refer-temp*")))
-      (set-buffer temp-buffer)
-      (erase-buffer)
-      (insert (regexp-quote s))
-      (goto-char (point-min))
-      (insert "(\"")
-      (while (re-search-forward "[ \t]+" nil t)
-         (replace-match "\" \"" t t))
-      (goto-char (point-max))
-      (insert "\")")
-      (goto-char (point-min))
-      (prog1 (read temp-buffer)
-         (set-buffer current))))
-
-(defun refer-expand-files (file-list dir-list)
-  (let (file files dir dirs)
-    (while (setq file (car file-list))
-      (setq dirs (copy-alist dir-list))
-      (while (setq dir (car dirs))
-        (if (file-exists-p (expand-file-name file dir))
-            (setq files (append files (list (expand-file-name file dir)))
-                  dirs  nil)
-          (if (file-exists-p (expand-file-name (concat file ".bib") dir))
-              (setq files (append files (list (expand-file-name (concat file ".bib")
-                                                                dir)))
-                    dirs  nil)
-            (setq dirs (cdr dirs)))))
-      (setq file-list (cdr file-list)))
-    files))
-
-(defun refer-get-bib-files ()
-  (let* ((dir-list
-          (cond
-           ((null refer-bib-directory)
-            '("."))
-           ((or (eq refer-bib-directory 'texinputs)
-                (eq refer-bib-directory 'bibinputs))
-            (let ((envvar (getenv (if (eq refer-bib-directory 'texinputs)
-                                      "TEXINPUTS"
-                                    "BIBINPUTS")))
-                  (dirs nil))
-              (if (null envvar)
-                  (setq envvar "."))
-              (while (string-match ":" envvar)
-		(let ((dir (substring envvar 0 (match-beginning 0))))
-		  (if (and (not (string-equal "" dir))
-                           (file-directory-p dir))
-		      (setq dirs (append (list (expand-file-name dir nil))
-                                         dirs))))
-                (setq envvar (substring envvar (match-end 0))))
-	      (if (and (not (string-equal "" envvar))
-                       (file-directory-p envvar))
-		  (setq dirs (append (list envvar) dirs)))
-              (setq dirs (nreverse dirs))))
-	   ((listp refer-bib-directory)
-	    refer-bib-directory)
-           (t
-            (list refer-bib-directory))))
-         (files
-           (cond
-            ((null refer-bib-files) 
-             (list (expand-file-name
-                    (if (eq major-mode 'bibtex-mode)
-                        (read-file-name
-                         (format ".bib file: (default %s) "
-                                 (file-name-nondirectory
-                                  (buffer-file-name)))
-                         (file-name-directory (buffer-file-name))
-                         (file-name-nondirectory (buffer-file-name))
-                         t)
-                      (read-file-name ".bib file: " nil nil t)))))
-            ((eq refer-bib-files 'auto)
-             (let ((files
-                    (save-excursion
-                      (if (setq refer-same-file (eq major-mode 'bibtex-mode))
-                          (list buffer-file-name)
-                        (if (progn
-                              (goto-char (point-min))
-                              (re-search-forward (concat refer-bib-files-regexp
-                                                         "\\s-*\{") nil t))
-                            (let ((files (list (buffer-substring
-                                                (point)
-                                                (progn
-                                                  (re-search-forward "[,\}]"
-                                                                     nil t)
-                                                  (backward-char 1)
-                                                  (point))))))
-                              (while (not (looking-at "\}"))
-                                (setq files (append files
-                                                    (list (buffer-substring
-                                                           (progn (forward-char 1)
-                                                                  (point))
-                                                           (progn (re-search-forward
-                                                                   "[,\}]" nil t)
-                                                                  (backward-char 1)
-                                                                  (point)))))))
-                              files)
-                          (error (concat "No \\\\bibliography command in this "
-                                         "buffer, can't read refer-bib-files")))))))
-               (refer-expand-files files dir-list)))
-            ((eq refer-bib-files 'dir)
-             (let ((dirs (nreverse dir-list))
-                   dir files)
-               (while (setq dir (car dirs))
-                 (setq files
-                       (append (directory-files dir t "\\.bib$")
-                               files))
-                 (setq dirs (cdr dirs)))
-               files))
-            ((and (listp refer-bib-files)
-                  (or (eq refer-bib-directory 'texinputs)
-                      (eq refer-bib-directory 'bibinputs)))
-             (refer-expand-files refer-bib-files dir-list))
-            ((listp refer-bib-files) refer-bib-files)
-            (t (error "Illegal value for refer-bib-files: %s"
-                      refer-bib-files)))))
-    (if (or (eq refer-bib-directory 'texinputs)
-            (eq refer-bib-directory 'bibinputs))
-        (setq refer-bib-directory dir-list))
-    (if refer-cache-bib-files
-        (setq refer-bib-files files))
-    files))
-
-;;; refer.el ends here
-
diff --git a/lisp/textmodes/scribe.el b/lisp/textmodes/scribe.el
deleted file mode 100644
index 2ec4899585a..00000000000
--- a/lisp/textmodes/scribe.el
+++ /dev/null
@@ -1,325 +0,0 @@
-;;; scribe.el --- scribe mode, and its idiosyncratic commands.
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: wp
-
-;; 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:
-
-;; A major mode for editing source in written for the Scribe text formatter.
-;; Knows about Scribe syntax and standard layout rules.  The command to
-;; run Scribe on a buffer is bogus; someone interested should fix it.
-
-;;; Code:
-
-(defvar scribe-mode-syntax-table nil
-  "Syntax table used while in scribe mode.")
-
-(defvar scribe-mode-abbrev-table nil
-  "Abbrev table used while in scribe mode.")
-
-(defvar scribe-fancy-paragraphs nil
-  "*Non-NIL makes Scribe mode use a different style of paragraph separation.")
-
-(defvar scribe-electric-quote nil
-  "*Non-NIL makes insert of double quote use `` or '' depending on context.")
-
-(defvar scribe-electric-parenthesis nil
-  "*Non-NIL makes parenthesis char ( (]}> ) automatically insert its close
-if typed after an @Command form.")
-
-(defconst scribe-open-parentheses "[({<"
-  "Open parenthesis characters for Scribe.")
-
-(defconst scribe-close-parentheses "])}>"
-  "Close parenthesis characters for Scribe.
-These should match up with `scribe-open-parenthesis'.")
-
-(if (null scribe-mode-syntax-table)
-    (let ((st (syntax-table)))
-      (unwind-protect
-       (progn
-	(setq scribe-mode-syntax-table (copy-syntax-table
-					text-mode-syntax-table))
-	(set-syntax-table scribe-mode-syntax-table)
-	(modify-syntax-entry ?\" "    ")
-	(modify-syntax-entry ?\\ "    ")
-	(modify-syntax-entry ?@ "w   ")
-	(modify-syntax-entry ?< "(>  ")
-	(modify-syntax-entry ?> ")<  ")
-	(modify-syntax-entry ?[ "(]  ")
-	(modify-syntax-entry ?] ")[  ")
-	(modify-syntax-entry ?{ "(}  ")
-	(modify-syntax-entry ?} "){  ")
-	(modify-syntax-entry ?' "w   "))
-       (set-syntax-table st))))
-
-(defvar scribe-mode-map nil)
-
-(if scribe-mode-map
-    nil
-  (setq scribe-mode-map (make-sparse-keymap))
-  (define-key scribe-mode-map "\t" 'scribe-tab)
-  (define-key scribe-mode-map "\e\t" 'tab-to-tab-stop)
-  (define-key scribe-mode-map "\es" 'center-line)
-  (define-key scribe-mode-map "\e}" 'up-list)
-  (define-key scribe-mode-map "\eS" 'center-paragraph)
-  (define-key scribe-mode-map "\"" 'scribe-insert-quote)
-  (define-key scribe-mode-map "(" 'scribe-parenthesis)
-  (define-key scribe-mode-map "[" 'scribe-parenthesis)
-  (define-key scribe-mode-map "{" 'scribe-parenthesis)
-  (define-key scribe-mode-map "<" 'scribe-parenthesis)
-  (define-key scribe-mode-map "\C-c\C-c" 'scribe-chapter)
-  (define-key scribe-mode-map "\C-c\C-t" 'scribe-section)
-  (define-key scribe-mode-map "\C-c\C-s" 'scribe-subsection)
-  (define-key scribe-mode-map "\C-c\C-v" 'scribe-insert-environment)
-  (define-key scribe-mode-map "\C-c\C-e" 'scribe-bracket-region-be)
-  (define-key scribe-mode-map "\C-c[" 'scribe-begin)
-  (define-key scribe-mode-map "\C-c]" 'scribe-end)
-  (define-key scribe-mode-map "\C-c\C-i" 'scribe-italicize-word)
-  (define-key scribe-mode-map "\C-c\C-b" 'scribe-bold-word)
-  (define-key scribe-mode-map "\C-c\C-u" 'scribe-underline-word))
-
-;;;###autoload
-(defun scribe-mode ()
-  "Major mode for editing files of Scribe (a text formatter) source.
-Scribe-mode is similar text-mode, with a few extra commands added.
-\\{scribe-mode-map}
-
-Interesting variables:
-
-scribe-fancy-paragraphs
-  Non-nil makes Scribe mode use a different style of paragraph separation.
-
-scribe-electric-quote
-  Non-nil makes insert of double quote use `` or '' depending on context.
-
-scribe-electric-parenthesis
-  Non-nil makes an open-parenthesis char (one of `([<{')
-  automatically insert its close if typed after an @Command form."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map scribe-mode-map)
-  (setq mode-name "Scribe")
-  (setq major-mode 'scribe-mode)
-  (define-abbrev-table 'scribe-mode-abbrev-table ())
-  (setq local-abbrev-table scribe-mode-abbrev-table)
-  (make-local-variable 'comment-start)
-  (setq comment-start "@Comment[")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip (concat "@Comment[" scribe-open-parentheses "]"))
-  (make-local-variable 'comment-column)
-  (setq comment-column 0)
-  (make-local-variable 'comment-end)
-  (setq comment-end "]")
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "\\([\n\f]\\)\\|\\(@\\w+["
-				 scribe-open-parentheses
-				"].*["
-				 scribe-close-parentheses
-				"]$\\)"))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate (if scribe-fancy-paragraphs
-			       paragraph-start "$"))
-  (make-local-variable 'sentence-end)
-  (setq sentence-end "\\([.?!]\\|@:\\)[]\"')}]*\\($\\| $\\|\t\\|  \\)[ \t\n]*")
-  (make-local-variable 'compile-command)
-  (setq compile-command (concat "scribe " (buffer-file-name)))
-  (set-syntax-table scribe-mode-syntax-table)
-  (run-hooks 'text-mode-hook 'scribe-mode-hook))
-
-(defun scribe-tab ()
-  (interactive)
-  (insert "@\\"))
-
-;; This algorithm could probably be improved somewhat.
-;;  Right now, it loses seriously...
-
-(defun scribe ()
-  "Run Scribe on the current buffer."
-  (interactive)
-  (call-interactively 'compile))
-
-(defun scribe-envelop-word (string count)
-  "Surround current word with Scribe construct @STRING[...].
-COUNT specifies how many words to surround.  A negative count means
-to skip backward."
-  (let ((spos (point)) (epos (point)) (ccoun 0) noparens)
-    (if (not (zerop count))
-	(progn (if (= (char-syntax (preceding-char)) ?w)
-		   (forward-sexp (min -1 count)))
-	       (setq spos (point))
-	       (if (looking-at (concat "@\\w[" scribe-open-parentheses "]"))
-		   (forward-char 2)
-		 (goto-char epos)
-		 (skip-chars-backward "\\W")
-		 (forward-char -1))
-	       (forward-sexp (max count 1))
-	       (setq epos (point))))
-    (goto-char spos)
-    (while (and (< ccoun (length scribe-open-parentheses))
-		(save-excursion
-		  (or (search-forward (char-to-string
-				       (aref scribe-open-parentheses ccoun))
-				      epos t)
-		      (search-forward (char-to-string
-				       (aref scribe-close-parentheses ccoun))
-				      epos t)))
-		(setq ccoun (1+ ccoun))))
-    (if (>= ccoun (length scribe-open-parentheses))
-	(progn (goto-char epos)
-	       (insert "@end(" string ")")
-	       (goto-char spos)
-	       (insert "@begin(" string ")"))
-      (goto-char epos)
-      (insert (aref scribe-close-parentheses ccoun))
-      (goto-char spos)
-      (insert "@" string (aref scribe-open-parentheses ccoun))
-      (goto-char epos)
-      (forward-char 3)
-      (skip-chars-forward scribe-close-parentheses))))
-
-(defun scribe-underline-word (count)
-  "Underline COUNT words around point by means of Scribe constructs."
-  (interactive "p")
-  (scribe-envelop-word "u" count))
-
-(defun scribe-bold-word (count)
-  "Boldface COUNT words around point by means of Scribe constructs."
-  (interactive "p")
-  (scribe-envelop-word "b" count))
-
-(defun scribe-italicize-word (count)
-  "Italicize COUNT words around point by means of Scribe constructs."
-  (interactive "p")
-  (scribe-envelop-word "i" count))
-
-(defun scribe-begin ()
-  (interactive)
-  (insert "\n")
-  (forward-char -1)
-  (scribe-envelop-word "Begin" 0)
-  (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-end ()
-  (interactive)
-  (insert "\n")
-  (forward-char -1)
-  (scribe-envelop-word "End" 0)
-  (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-chapter ()
-  (interactive)
-  (insert "\n")
-  (forward-char -1)
-  (scribe-envelop-word "Chapter" 0)
-  (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-section ()
-  (interactive)
-  (insert "\n")
-  (forward-char -1)
-  (scribe-envelop-word "Section" 0)
-  (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-subsection ()
-  (interactive)
-  (insert "\n")
-  (forward-char -1)
-  (scribe-envelop-word "SubSection" 0)
-  (re-search-forward (concat "[" scribe-open-parentheses "]")))
-
-(defun scribe-bracket-region-be (env min max)
-  (interactive "sEnvironment: \nr")
-  (save-excursion
-    (goto-char max)
-    (insert "@end(" env ")\n")
-    (goto-char min)
-    (insert "@begin(" env ")\n")))
-
-(defun scribe-insert-environment (env)
-  (interactive "sEnvironment: ")
-  (scribe-bracket-region-be env (point) (point))
-  (forward-line 1)
-  (insert ?\n)
-  (forward-char -1))
-
-(defun scribe-insert-quote (count)
-  "Insert ``, '' or \" according to preceding character.
-If `scribe-electric-quote' is non-NIL, insert ``, '' or \" according
-to preceding character.  With numeric arg N, always insert N \" characters.
-Else just insert \"."
-  (interactive "P")
-  (if (or count (not scribe-electric-quote))
-      (self-insert-command (prefix-numeric-value count))
-    (let (lastfore lastback lastquote)
-      (insert
-       (cond
-	((= (preceding-char) ?\\) ?\")
-	((bobp) "``")
-	(t
-	 (setq lastfore (save-excursion (and (search-backward
-					      "``" (- (point) 1000) t)
-					     (point)))
-	       lastback (save-excursion (and (search-backward
-					      "''" (- (point) 1000) t)
-					     (point)))
-	       lastquote (save-excursion (and (search-backward
-					       "\"" (- (point) 100) t)
-					      (point))))
-	 (if (not lastquote)
-	     (cond ((not lastfore) "``")
-		   ((not lastback) "''")
-		   ((> lastfore lastback) "''")
-		   (t "``"))
-	   (cond ((and (not lastback) (not lastfore)) "\"")
-		 ((and lastback (not lastfore) (> lastquote lastback)) "\"")
-		 ((and lastback (not lastfore) (> lastback lastquote)) "``")
-		 ((and lastfore (not lastback) (> lastquote lastfore)) "\"")
-		 ((and lastfore (not lastback) (> lastfore lastquote)) "''")
-		 ((and (> lastquote lastfore) (> lastquote lastback)) "\"")
-		 ((> lastfore lastback) "''")
-		 (t "``")))))))))
-
-(defun scribe-parenthesis (count)
-  "If scribe-electric-parenthesis is non-NIL, insertion of an open-parenthesis
-character inserts the following close parenthesis character if the
-preceding text is of the form @Command."
-  (interactive "P")
-  (self-insert-command (prefix-numeric-value count))
-  (let (at-command paren-char point-save)
-    (if (or count (not scribe-electric-parenthesis))
-	nil
-      (save-excursion
-	(forward-char -1)
-	(setq point-save (point))
-	(skip-chars-backward (concat "^ \n\t\f" scribe-open-parentheses))
-	(setq at-command (and (equal (following-char) ?@)
-			      (/= (point) (1- point-save)))))
-      (if (and at-command
-	       (setq paren-char
-		     (string-match (regexp-quote
-				    (char-to-string (preceding-char)))
-				   scribe-open-parentheses)))
-	  (save-excursion
-	    (insert (aref scribe-close-parentheses paren-char)))))))
-
-;;; scribe.el ends here
diff --git a/lisp/textmodes/sgml-mode.el b/lisp/textmodes/sgml-mode.el
deleted file mode 100644
index 234d8c2fba7..00000000000
--- a/lisp/textmodes/sgml-mode.el
+++ /dev/null
@@ -1,1262 +0,0 @@
-;;; sgml-mode.el --- SGML- and HTML-editing modes
-
-;; Copyright (C) 1992, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: James Clark <jjc@clark.com>
-;; Adapted-By: ESR; Daniel.Pfeiffer@Informatik.START.dbp.de
-;; Keywords: wp, hypermedia, comm, languages
-
-;; 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:
-
-;; Configurable major mode for editing document in the SGML standard general
-;; markup language.  As an example contains a mode for editing the derived
-;; HTML hypertext markup language.
-
-;;; Code:
-
-;; As long as Emacs' syntax can't be complemented with predicates to context
-;; sensitively confirm the syntax of characters, we have to live with this
-;; kludgy kind of tradeoff.
-(defvar sgml-specials '(?\")
-  "List of characters that have a special meaning for sgml-mode.
-This list is used when first loading the sgml-mode library.
-The supported characters and potential disadvantages are:
-
-  ?\\\"	Makes \" in text start a string.
-  ?'	Makes ' in text start a string.
-  ?-	Makes -- in text start a comment.
-
-When only one of ?\\\" or ?' are included, \"'\" or '\"' as it can be found in
-DTDs, start a string.  To partially avoid this problem this also makes these
-self insert as named entities depending on `sgml-quick-keys'.
-
-Including ?- has the problem of affecting dashes that have nothing to do
-with comments, so we normally turn it off.")
-
-(defvar sgml-quick-keys nil
-  "Use <, >, &, SPC and `sgml-specials' keys ``electrically'' when non-nil.
-This takes effect when first loading the library.")
-
-
-(defvar sgml-mode-map
-  (let ((map (list 'keymap (make-vector 256 nil)))
-	(menu-map (make-sparse-keymap "SGML")))
-    (define-key map "\t" 'indent-relative-maybe)
-    (define-key map "\C-c\C-i" 'sgml-tags-invisible)
-    (define-key map "/" 'sgml-slash)
-    (define-key map "\C-c\C-n" 'sgml-name-char)
-    (define-key map "\C-c\C-t" 'sgml-tag)
-    (define-key map "\C-c\C-a" 'sgml-attributes)
-    (define-key map "\C-c\C-b" 'sgml-skip-tag-backward)
-    (define-key map [?\C-c left] 'sgml-skip-tag-backward)
-    (define-key map "\C-c\C-f" 'sgml-skip-tag-forward)
-    (define-key map [?\C-c right] 'sgml-skip-tag-forward)
-    (define-key map "\C-c\C-d" 'sgml-delete-tag)
-    (define-key map "\C-c\^?" 'sgml-delete-tag)
-    (define-key map "\C-c?" 'sgml-tag-help)
-    (define-key map "\C-c8" 'sgml-name-8bit-mode)
-    (define-key map "\C-c\C-v" 'sgml-validate)
-    (if sgml-quick-keys
-	(progn
-	  (define-key map "&" 'sgml-name-char)
-	  (define-key map "<" 'sgml-tag)
-	  (define-key map " " 'sgml-auto-attributes)
-	  (define-key map ">" 'sgml-maybe-end-tag)
-	  (if (memq ?\" sgml-specials)
-	      (define-key map "\"" 'sgml-name-self))
-	  (if (memq ?' sgml-specials)
-	      (define-key map "'" 'sgml-name-self))))
-    (let ((c 127)
-	  (map (nth 1 map)))
-      (while (< (setq c (1+ c)) 256)
-	(aset map c 'sgml-maybe-name-self)))
-    (define-key map [menu-bar sgml] (cons "SGML" menu-map))
-    (define-key menu-map [sgml-validate] '("Validate" . sgml-validate))
-    (define-key menu-map [sgml-name-8bit-mode]
-      '("Toggle 8 Bit Insertion" . sgml-name-8bit-mode))
-    (define-key menu-map [sgml-tags-invisible]
-      '("Toggle Tag Visibility" . sgml-tags-invisible))
-    (define-key menu-map [sgml-tag-help]
-      '("Describe Tag" . sgml-tag-help))
-    (define-key menu-map [sgml-delete-tag]
-      '("Delete Tag" . sgml-delete-tag))
-    (define-key menu-map [sgml-skip-tag-forward]
-      '("Forward Tag" . sgml-skip-tag-forward))
-    (define-key menu-map [sgml-skip-tag-backward]
-      '("Backward Tag" . sgml-skip-tag-backward))
-    (define-key menu-map [sgml-attributes]
-      '("Insert Attributes" . sgml-attributes))
-    (define-key menu-map [sgml-tag] '("Insert Tag" . sgml-tag))
-    map)
-  "Keymap for SGML mode.  See also `sgml-specials'.")
-
-
-(defvar sgml-mode-syntax-table
-  (let ((table (copy-syntax-table text-mode-syntax-table)))
-    (modify-syntax-entry ?< "(>" table)
-    (modify-syntax-entry ?> ")<" table)
-    (if (memq ?- sgml-specials)
-	(modify-syntax-entry ?- "_ 1234" table))
-    (if (memq ?\" sgml-specials)
-	(modify-syntax-entry ?\" "\"\"" table))
-    (if (memq ?' sgml-specials)
-	(modify-syntax-entry ?\' "\"'" table))
-    table)
-  "Syntax table used in SGML mode.  See also `sgml-specials'.")
-
-
-(defvar sgml-name-8bit-mode nil
-  "*When non-`nil' insert 8 bit characters with their names.")
-
-(defvar sgml-char-names
-  [nil nil nil nil nil nil nil nil
-   nil nil nil nil nil nil nil nil
-   nil nil nil nil nil nil nil nil
-   nil nil nil nil nil nil nil nil
-   "ensp" "excl" "quot" "num" "dollar" "percnt" "amp" "apos"
-   "lpar" "rpar" "ast" "plus" "comma" "hyphen" "period" "sol"
-   nil nil nil nil nil nil nil nil
-   nil nil "colon" "semi" "lt" "eq" "gt" "quest"
-   "commat" nil nil nil nil nil nil nil
-   nil nil nil nil nil nil nil nil
-   nil nil nil nil nil nil nil nil
-   nil nil nil "lsqb" nil "rsqb" "uarr" "lowbar"
-   "lsquo" nil nil nil nil nil nil nil
-   nil nil nil nil nil nil nil nil
-   nil nil nil nil nil nil nil nil
-   nil nil nil "lcub" "verbar" "rcub" "tilde" nil
-   nil nil nil nil nil nil nil nil
-   nil nil nil nil nil nil nil nil
-   nil nil nil nil nil nil nil nil
-   nil nil nil nil nil nil nil nil
-   "nbsp" "iexcl" "cent" "pound" "curren" "yen" "brvbar" "sect"
-   "uml" "copy" "ordf" "laquo" "not" "shy" "reg" "macr"
-   "ring" "plusmn" "sup2" "sup3" "acute" "micro" "para" "middot"
-   "cedil" "sup1" "ordm" "raquo" "frac14" "half" "frac34" "iquest"
-   "Agrave" "Aacute" "Acirc" "Atilde" "Auml" "Aring" "AElig" "Ccedil"
-   "Egrave" "Eacute" "Ecirc" "Euml" "Igrave" "Iacute" "Icirc" "Iuml"
-   "ETH" "Ntilde" "Ograve" "Oacute" "Ocirc" "Otilde" "Ouml" nil
-   "Oslash" "Ugrave" "Uacute" "Ucirc" "Uuml" "Yacute" "THORN" "szlig"
-   "agrave" "aacute" "acirc" "atilde" "auml" "aring" "aelig" "ccedil"
-   "egrave" "eacute" "ecirc" "euml" "igrave" "iacute" "icirc" "iuml"
-   "eth" "ntilde" "ograve" "oacute" "ocirc" "otilde" "ouml" "divide"
-   "oslash" "ugrave" "uacute" "ucirc" "uuml" "yacute" "thorn" "yuml"]
-  "Vector of symbolic character names without `&' and `;'.")
-
-
-;; sgmls is a free SGML parser available from
-;; ftp.uu.net:pub/text-processing/sgml
-;; Its error messages can be parsed by next-error.
-;; The -s option suppresses output.
-
-(defvar sgml-validate-command "sgmls -s"
-  "*The command to validate an SGML document.
-The file name of current buffer file name will be appended to this,
-separated by a space.")
-
-(defvar sgml-saved-validate-command nil
-  "The command last used to validate in this buffer.")
-
-
-;;; I doubt that null end tags are used much for large elements,
-;;; so use a small distance here.
-(defconst sgml-slash-distance 1000
-  "*If non-nil, is the maximum distance to search for matching /.")
-
-(defconst sgml-start-tag-regex
-  "<[A-Za-z]\\([-.A-Za-z0-9= \n\t]\\|\"[^\"]*\"\\|'[^']*'\\)*"
-  "Regular expression that matches a non-empty start tag.
-Any terminating > or / is not matched.")
-
-
-(defvar sgml-font-lock-keywords
-  '(("<\\([!?][a-z0-9]+\\)" 1 font-lock-keyword-face)
-    ("<\\(/?[a-z0-9]+\\)" 1 font-lock-function-name-face)
-    ("[&%][-.A-Za-z0-9]+;?" . font-lock-variable-name-face)
-    ("<!--[^<>]*-->" . font-lock-comment-face))
-  "*Rules for highlighting SGML code.  See also `sgml-tag-face-alist'.")
-
-;; internal
-(defvar sgml-font-lock-keywords-1 ())
-
-(defvar sgml-face-tag-alist ()
-  "Alist of face and tag name for facemenu.")
-
-(defvar sgml-tag-face-alist ()
-  "Tag names and face or list of faces to fontify with when invisible.
-When `font-lock-maximum-decoration' is 1 this is always used for fontifying.
-When more these are fontified together with `sgml-font-lock-keywords'.")
-
-
-(defvar sgml-display-text ()
-  "Tag names as lowercase symbols, and display string when invisible.")
-
-;; internal
-(defvar sgml-tags-invisible nil)
-
-
-(defvar sgml-tag-alist
-  '(("![" ("ignore" t) ("include" t))
-    ("!attlist")
-    ("!doctype")
-    ("!element")
-    ("!entity"))
-  "*Alist of tag names for completing read and insertion rules.
-This alist is made up as
-
-  ((\"tag\" . TAGRULE)
-   ...)
-
-TAGRULE is a list of optionally `t' (no endtag) or `\\n' (separate endtag by
-newlines) or a skeleton with `nil', `t' or `\\n' in place of the interactor
-followed by an ATTRIBUTERULE (for an always present attribute) or an
-attribute alist.
-
-The attribute alist is made up as
-
-  ((\"attribute\" . ATTRIBUTERULE)
-   ...)
-
-ATTRIBUTERULE is a list of optionally `t' (no value when no input) followed by
-an optional alist of possible values.")
-
-(defvar sgml-tag-help
-  '(("!" . "Empty declaration for comment")
-    ("![" . "Embed declarations with parser directive")
-    ("!attlist" . "Tag attributes declaration")
-    ("!doctype" . "Document type (DTD) declaration")
-    ("!element" . "Tag declaration")
-    ("!entity" . "Entity (macro) declaration"))
-  "*Alist of tag name and short description.")
-
-
-;; put read-only last to enable setting this even when read-only enabled
-(or (get 'sgml-tag 'invisible)
-    (setplist 'sgml-tag
-	      (append '(invisible t
-			rear-nonsticky t
-			point-entered sgml-point-entered
-			read-only t)
-		      (symbol-plist 'sgml-tag))))
-
-
-
-(defun sgml-mode-common (sgml-tag-face-alist sgml-display-text)
-  "Common code for setting up `sgml-mode' and derived modes.
-SGML-TAG-FACE-ALIST is used for calculating `sgml-font-lock-keywords-1'.
-SGML-DISPLAY-TEXT sets up alternate text for when tags are invisible (see
-varables of same name)."
-  (kill-all-local-variables)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (set-syntax-table sgml-mode-syntax-table)
-  (make-local-variable 'indent-line-function)
-  (make-local-variable 'paragraph-start)
-  (make-local-variable 'paragraph-separate)
-  (make-local-variable 'sgml-saved-validate-command)
-  (make-local-variable 'comment-start)
-  (make-local-variable 'comment-end)
-  (make-local-variable 'comment-indent-function)
-  (make-local-variable 'comment-start-skip)
-  (make-local-variable 'comment-indent-function)
-  (make-local-variable 'sgml-tags-invisible)
-  (make-local-variable 'skeleton-transformation)
-  (make-local-variable 'skeleton-further-elements)
-  (make-local-variable 'skeleton-end-hook)
-  (make-local-variable 'font-lock-defaults)
-  (make-local-variable 'sgml-font-lock-keywords-1)
-  (make-local-variable 'facemenu-add-face-function)
-  (make-local-variable 'facemenu-end-add-face)
-  ;;(make-local-variable 'facemenu-remove-face-function)
-  (and sgml-tag-face-alist
-       (not (assq 1 sgml-tag-face-alist))
-       (nconc sgml-tag-face-alist
-	      `((1 (,(concat "<\\("
-			     (mapconcat 'car sgml-tag-face-alist "\\|")
-			     "\\)\\([ \t].+\\)?>\\(.+\\)</\\1>")
-		    3 (cdr (assoc (match-string 1) ',sgml-tag-face-alist)))))))
-  (setq indent-line-function 'indent-relative-maybe
-	;; A start or end tag by itself on a line separates a paragraph.
-	;; This is desirable because SGML discards a newline that appears
-	;; immediately after a start tag or immediately before an end tag.
-	paragraph-start "^[ \t\n]\\|\
-\\(</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$\\)"
-	paragraph-separate "^[ \t\n]*$\\|\
-^</?\\([A-Za-z]\\([-.A-Za-z0-9= \t\n]\\|\"[^\"]*\"\\|'[^']*'\\)*\\)?>$"
-	comment-start "<!-- "
-	comment-end " -->"
-	comment-indent-function 'sgml-comment-indent
-	;; This will allow existing comments within declarations to be
-	;; recognized.
-	comment-start-skip "--[ \t]*"
-	skeleton-transformation 'identity
-	skeleton-further-elements '((completion-ignore-case t))
-	skeleton-end-hook (lambda ()
-			    (or (eolp)
-				(not (or (eq v2 '\n)
-					 (eq (car-safe v2) '\n)))
-				(newline-and-indent)))
-	sgml-font-lock-keywords-1 (cdr (assq 1 sgml-tag-face-alist))
-	font-lock-defaults '((sgml-font-lock-keywords
-			      sgml-font-lock-keywords-1)
-			     nil
-			     t)
-	facemenu-add-face-function
-	  (lambda (face end)
-	    (if (setq face (cdr (assq face sgml-face-tag-alist)))
-		(progn
-		  (setq facemenu-end-add-face (concat "</" face ">"))
-		  (concat "<" face ">"))
-	      (error "Face not configured for %s mode." mode-name))))
-  (while sgml-display-text
-    (put (car (car sgml-display-text)) 'before-string
-	 (cdr (car sgml-display-text)))
-    (setq sgml-display-text (cdr sgml-display-text)))
-  (run-hooks 'text-mode-hook 'sgml-mode-hook))
-
-
-;;;###autoload
-(defun sgml-mode (&optional function)
-  "Major mode for editing SGML documents.
-Makes > match <.  Makes / blink matching /.
-Keys <, &, SPC within <>, \" and ' can be electric depending on
-`sgml-quick-keys'.
-
-Do \\[describe-variable] sgml- SPC to see available variables.
-
-Use \\[sgml-validate] to validate your document with an SGML parser.
-\\{sgml-mode-map}"
-  (interactive)
-  (sgml-mode-common sgml-tag-face-alist sgml-display-text)
-  (use-local-map sgml-mode-map)
-  (setq mode-name "SGML"
-	major-mode 'sgml-mode))
-
-
-
-(defun sgml-comment-indent ()
-  (if (and (looking-at "--")
-	   (not (and (eq (preceding-char) ?!)
-		     (eq (char-after (- (point) 2)) ?<))))
-      (progn
-	(skip-chars-backward " \t")
-	(max comment-column (1+ (current-column))))
-    0))
-
-
-
-(defun sgml-slash (arg)
-  "Insert / and display any previous matching /.
-Two /s are treated as matching if the first / ends a net-enabling
-start tag, and the second / is the corresponding null end tag."
-  (interactive "p")
-  (insert-char ?/ arg)
-  (if (> arg 0)
-      (let ((oldpos (point))
-	    (blinkpos)
-	    (level 0))
-	(save-excursion
-	  (save-restriction
-	    (if sgml-slash-distance
-		(narrow-to-region (max (point-min)
-				       (- (point) sgml-slash-distance))
-				  oldpos))
-	    (if (and (re-search-backward sgml-start-tag-regex (point-min) t)
-		     (eq (match-end 0) (1- oldpos)))
-		()
-	      (goto-char (1- oldpos))
-	      (while (and (not blinkpos)
-			  (search-backward "/" (point-min) t))
-		(let ((tagend (save-excursion
-				(if (re-search-backward sgml-start-tag-regex
-							(point-min) t)
-				    (match-end 0)
-				  nil))))
-		  (if (eq tagend (point))
-		      (if (eq level 0)
-			  (setq blinkpos (point))
-			(setq level (1- level)))
-		    (setq level (1+ level)))))))
-	  (if blinkpos
-	      (progn
-		(goto-char blinkpos)
-		(if (pos-visible-in-window-p)
-		    (sit-for 1)
-		  (message "Matches %s"
-			   (buffer-substring (progn
-					       (beginning-of-line)
-					       (point))
-					     (1+ blinkpos))))))))))
-
-
-(defun sgml-name-char (&optional char)
-  "Insert a symbolic character name according to `sgml-char-names'.
-8 bit chars may be inserted with the meta key as in M-SPC for no break space,
-or M-- for a soft hyphen."
-  (interactive "*")
-  (insert ?&)
-  (or char
-      (setq char (read-quoted-char)))
-  (delete-backward-char 1)
-  (insert char)
-  (undo-boundary)
-  (delete-backward-char 1)
-  (insert ?&
-	  (or (aref sgml-char-names char)
-	      (format "#%d" char))
-	  ?\;))
-
-
-(defun sgml-name-self ()
-  "Insert a symbolic character name according to `sgml-char-names'."
-  (interactive "*")
-  (sgml-name-char last-command-char))
-
-
-(defun sgml-maybe-name-self ()
-  "Insert a symbolic character name according to `sgml-char-names'."
-  (interactive "*")
-  (if sgml-name-8bit-mode
-      (sgml-name-char last-command-char)
-    (self-insert-command 1)))
-
-
-(defun sgml-name-8bit-mode ()
-  "Toggle insertion of 8 bit characters."
-  (interactive)
-  (setq sgml-name-8bit-mode (not sgml-name-8bit-mode)))
-
-
-
-(define-skeleton sgml-tag
-  "Insert a tag you are prompted for, optionally with attributes.
-Completion and configuration is according to `sgml-tag-alist'.
-If you like tags and attributes in uppercase set `skeleton-transformation'
-to `upcase'."
-  (funcall skeleton-transformation
-	   (completing-read "Tag: " sgml-tag-alist))
-  ?< (setq v1 (eval str)) |
-  (("") -1 '(undo-boundary) "&lt;") |
-  (("") '(setq v2 (sgml-attributes v1 t)) ?>
-   (if (string= "![" v1)
-       (prog1 '(("") " [ " _ " ]]")
-	 (backward-char))
-     (if (or (eq v2 t)
-	     (string-match "^[/!?]" v1))
-	 ()
-       (if (symbolp v2)
-	   '(("") v2 _ v2 "</" v1 ?>)
-	 (if (eq (car v2) t)
-	     (cons '("") (cdr v2))
-	   (append '(("") (car v2))
-		   (cdr v2)
-		   '(resume: (car v2) _ "</" v1 ?>))))))))
-
-(autoload 'skeleton-read "skeleton")
-
-(defun sgml-attributes (alist &optional quiet)
-  "When at toplevel of a tag, interactively insert attributes."
-  (interactive (list (save-excursion (sgml-beginning-of-tag t))))
-  (or (stringp alist) (error "Wrong context for adding attribute"))
-  (if alist
-      (let ((completion-ignore-case t)
-	    car attribute i)
-	(setq alist (cdr (assoc (downcase alist) sgml-tag-alist)))
-	(if (or (symbolp (car alist))
-		(symbolp (car (car alist))))
-	    (setq car (car alist)
-		  alist (cdr alist)))
-	(or quiet
-	    (message "No attributes configured."))
-	(if (stringp (car alist))
-	    (progn
-	      (insert (if (eq (preceding-char) ? ) "" ? ) (car alist))
-	      (sgml-value alist))
-	  (setq i (length alist))
-	  (while (> i 0)
-	    (insert ? )
-	    (insert (funcall skeleton-transformation
-			     (setq attribute
-				   (skeleton-read '(completing-read
-						    "[Attribute]: "
-						    alist)))))
-	    (if (string= "" attribute)
-		(setq i 0)
-	      (sgml-value (assoc attribute alist))
-	      (setq i (1- i))))
-	  (if (eq (preceding-char) ? )
-	      (delete-backward-char 1)))
-	car)))
-
-(defun sgml-auto-attributes (arg)
-  "Self insert, except, when at top level of tag, prompt for attributes.
-With prefix ARG only self insert."
-  (interactive "*P")
-  (let ((point (point))
-	tag)
-    (if (or arg
-	    (not sgml-tag-alist)	; no message when nothing configured
-	    (symbolp (setq tag (save-excursion (sgml-beginning-of-tag t))))
-	    (eq (aref tag 0) ?/))
-	(self-insert-command (prefix-numeric-value arg))
-      (sgml-attributes tag)
-      (setq last-command-char ? )
-      (or (> (point) point)
-	  (self-insert-command 1)))))
-
-
-(defun sgml-tag-help (&optional tag)
-  "Display description of optional TAG or tag at point."
-  (interactive)
-  (or tag
-      (save-excursion
-	(if (eq (following-char) ?<)
-	    (forward-char))
-	(setq tag (sgml-beginning-of-tag))))
-  (or (stringp tag)
-      (error "No tag selected"))
-  (setq tag (downcase tag))
-  (message "%s"
-	   (or (cdr (assoc tag sgml-tag-help))
-	       (and (eq (aref tag 0) ?/)
-		    (cdr (assoc (substring tag 1) sgml-tag-help)))
-	       "No description available")))
-
-
-(defun sgml-maybe-end-tag ()
-  "Name self unless in position to end a tag."
-  (interactive)
-  (or (condition-case nil
-	  (save-excursion (up-list -1))
-	(error
-	 (sgml-name-self)
-	 t))
-      (condition-case nil
-	  (progn
-	    (save-excursion (up-list 1))
-	    (sgml-name-self))
-	(error (self-insert-command 1)))))
-
-
-(defun sgml-skip-tag-backward (arg)
-  "Skip to beginning of tag or matching opening tag if present.
-With prefix ARG, repeat that many times."
-  (interactive "p")
-  (while (>= arg 1)
-    (search-backward "<" nil t)
-    (if (looking-at "</\\([^ \n\t>]+\\)")
-	;; end tag, skip any nested pairs
-	(let ((case-fold-search t)
-	      (re (concat "</?" (regexp-quote (match-string 1)))))
-	  (while (and (re-search-backward re nil t)
-		      (eq (char-after (1+ (point))) ?/))
-	    (forward-char 1)
-	    (sgml-skip-tag-backward 1))))
-    (setq arg (1- arg))))
-
-(defun sgml-skip-tag-forward (arg &optional return)
-  "Skip to end of tag or matching closing tag if present.
-With prefix ARG, repeat that many times.
-Return t iff after a closing tag."
-  (interactive "p")
-  (setq return t)
-  (while (>= arg 1)
-    (skip-chars-forward "^<>")
-    (if (eq (following-char) ?>)
-	(up-list -1))
-    (if (looking-at "<\\([^/ \n\t>]+\\)")
-	;; start tag, skip any nested same pairs _and_ closing tag
-	(let ((case-fold-search t)
-	      (re (concat "</?" (regexp-quote (match-string 1))))
-	      point close)
-	  (forward-list 1)
-	  (setq point (point))
-	  (while (and (re-search-forward re nil t)
-		      (not (setq close
-				 (eq (char-after (1+ (match-beginning 0))) ?/)))
-		      (not (up-list -1))
-		      (sgml-skip-tag-forward 1))
-	    (setq close nil))
-	  (if close
-	      (up-list 1)
-	    (goto-char point)
-	    (setq return)))
-      (forward-list 1))
-    (setq arg (1- arg)))
-  return)
-
-(defun sgml-delete-tag (arg)
-  "Delete tag on or after cursor, and matching closing or opening tag.
-With prefix ARG, repeat that many times."
-  (interactive "p")
-  (while (>= arg 1)
-    (save-excursion
-      (let* (close open)
-	(if (looking-at "[ \t\n]*<")
-	    ;; just before tag
-	    (if (eq (char-after (match-end 0)) ?/)
-		;; closing tag
-		(progn
-		  (setq close (point))
-		  (goto-char (match-end 0))))
-	  ;; on tag?
-	  (or (save-excursion (setq close (sgml-beginning-of-tag)
-				    close (and (stringp close)
-					       (eq (aref close 0) ?/)
-					       (point))))
-	      ;; not on closing tag
-	      (let ((point (point)))
-		(sgml-skip-tag-backward 1)
-		(if (or (not (eq (following-char) ?<))
-			(save-excursion
-			  (forward-list 1)
-			  (<= (point) point)))
-		    (error "Not on or before tag")))))
-	(if close
-	    (progn
-	      (sgml-skip-tag-backward 1)
-	      (setq open (point))
-	      (goto-char close)
-	      (kill-sexp 1))
-	  (setq open (point))
-	  (sgml-skip-tag-forward 1)
-	  (backward-list)
-	  (forward-char)
-	  (if (eq (aref (sgml-beginning-of-tag) 0) ?/)
-	      (kill-sexp 1)))
-	(goto-char open)
-	(kill-sexp 1)))
-    (setq arg (1- arg))))
-
-
-
-(defun sgml-tags-invisible (arg)
-  "Toggle visibility of existing tags."
-  (interactive "P")
-  (let ((modified (buffer-modified-p))
-	(inhibit-read-only t)
-	(point (point-min))
-	symbol)
-    (save-excursion
-      (goto-char point)
-      (if (setq sgml-tags-invisible
-		(if arg
-		    (>= (prefix-numeric-value arg) 0)
-		  (not sgml-tags-invisible)))
-	  (while (re-search-forward "<\\([!/?A-Za-z][-A-Za-z0-9]*\\)"
-				    nil t)
-	    (setq symbol (intern-soft (downcase (match-string 1))))
-	    (goto-char (match-beginning 0))
-	    (and (get symbol 'before-string)
-		 (not (overlays-at (point)))
-		 (overlay-put (make-overlay (point)
-					    (match-beginning 1))
-			      'category symbol))
-	    (put-text-property (setq point (point)) (forward-list)
-			       'intangible (point))			
-	    (put-text-property point (point)
-			       'category 'sgml-tag))
-	(while (< (setq point (next-overlay-change point)) (point-max))
-	  (delete-overlay (car (overlays-at point))))
-	(remove-text-properties (point-min) (point-max)
-				'(category sgml-tag intangible t))))
-    (set-buffer-modified-p modified)
-    (run-hooks 'sgml-tags-invisible-hook)
-    (message "")))
-
-(defun sgml-point-entered (x y)
-  ;; Show preceding or following hidden tag, depending of cursor direction.
-  (let ((inhibit-point-motion-hooks t))
-    (save-excursion
-      (message "Invisible tag: %s"
-	       (buffer-substring
-		(point)
-		(if (or (and (> x y)
-			     (not (eq (following-char) ?<)))
-			(and (< x y)
-			     (eq (preceding-char) ?>)))
-		    (backward-list)
-		  (forward-list)))))))
-
-
-(autoload 'compile-internal "compile")
-
-(defun sgml-validate (command)
-  "Validate an SGML document.
-Runs COMMAND, a shell command, in a separate process asynchronously
-with output going to the buffer *compilation*.
-You can then use the command \\[next-error] to find the next error message
-and move to the line in the SGML document that caused it."
-  (interactive
-   (list (read-string "Validate command: "
-		      (or sgml-saved-validate-command
-			  (concat sgml-validate-command
-				  " "
-				  (let ((name (buffer-file-name)))
-				    (and name
-					 (file-name-nondirectory name))))))))
-  (setq sgml-saved-validate-command command)
-  (compile-internal command "No more errors"))
-
-
-(defun sgml-beginning-of-tag (&optional top-level)
-  "Skip to beginning of tag and return its name.
-Else `t'."
-  (or (if top-level
-	  (condition-case nil
-	      (up-list -1)
-	    (error t))
-	(>= (point)
-	    (if (search-backward "<" nil t)
-		(save-excursion
-		  (forward-list)
-		  (point))
-	      0)))
-      (if (looking-at "<[!?/]?[[A-Za-z][A-Za-z0-9]*")
-	  (buffer-substring-no-properties
-	   (1+ (point))
-	   (match-end 0))
-	t)))
-
-(defun sgml-value (alist)
-  (setq alist (cdr alist))
-  (if (stringp (car alist))
-      (insert "=\"" (car alist) ?\")
-    (if (eq (car alist) t)
-	(if (cdr alist)
-	    (progn
-	      (insert "=\"")
-	      (setq alist (skeleton-read '(completing-read
-					   "[Value]: " (cdr alist))))
-	      (if (string< "" alist)
-		  (insert (funcall skeleton-transformation alist) ?\")
-		(delete-backward-char 2))))
-      (insert "=\"")
-      (if alist
-	  (insert (funcall skeleton-transformation
-			   (skeleton-read '(completing-read "Value: " alist)))))
-      (insert ?\"))))
-
-(provide 'sgml-mode)
-
-(defvar html-quick-keys sgml-quick-keys
-  "Use C-c X combinations for quick insertion of frequent tags when non-nil.
-This defaults to `sgml-quick-keys'.
-This takes effect when first loading the library.")
-
-(defvar html-mode-map
-  (let ((map (nconc (make-sparse-keymap) sgml-mode-map))
-	(menu-map (make-sparse-keymap "HTML")))
-    (define-key map "\C-c6" 'html-headline-6)
-    (define-key map "\C-c5" 'html-headline-5)
-    (define-key map "\C-c4" 'html-headline-4)
-    (define-key map "\C-c3" 'html-headline-3)
-    (define-key map "\C-c2" 'html-headline-2)
-    (define-key map "\C-c1" 'html-headline-1)
-    (define-key map "\C-c\r" 'html-paragraph)
-    (define-key map "\C-c\n" 'html-line)
-    (define-key map "\C-c\C-c-" 'html-horizontal-rule)
-    (define-key map "\C-c\C-co" 'html-ordered-list)
-    (define-key map "\C-c\C-cu" 'html-unordered-list)
-    (define-key map "\C-c\C-cr" 'html-radio-buttons)
-    (define-key map "\C-c\C-cc" 'html-checkboxes)
-    (define-key map "\C-c\C-cl" 'html-list-item)
-    (define-key map "\C-c\C-ch" 'html-href-anchor)
-    (define-key map "\C-c\C-cn" 'html-name-anchor)
-    (define-key map "\C-c\C-ci" 'html-image)
-    (if html-quick-keys
-	(progn
-	  (define-key map "\C-c-" 'html-horizontal-rule)
-	  (define-key map "\C-co" 'html-ordered-list)
-	  (define-key map "\C-cu" 'html-unordered-list)
-	  (define-key map "\C-cr" 'html-radio-buttons)
-	  (define-key map "\C-cc" 'html-checkboxes)
-	  (define-key map "\C-cl" 'html-list-item)
-	  (define-key map "\C-ch" 'html-href-anchor)
-	  (define-key map "\C-cn" 'html-name-anchor)
-	  (define-key map "\C-ci" 'html-image)))
-    (define-key map "\C-c\C-s" 'html-autoview-mode)
-    (define-key map "\C-c\C-v" 'browse-url-of-buffer)
-    (define-key map [menu-bar html] (cons "HTML" menu-map))
-    (define-key menu-map [html-autoview-mode]
-      '("Toggle Autoviewing" . html-autoview-mode))
-    (define-key menu-map [browse-url-of-buffer]
-      '("View Buffer Contents" . browse-url-of-buffer))
-    (define-key menu-map [nil] '("--"))
-    ;;(define-key menu-map "6" '("Heading 6" . html-headline-6))
-    ;;(define-key menu-map "5" '("Heading 5" . html-headline-5))
-    ;;(define-key menu-map "4" '("Heading 4" . html-headline-4))
-    (define-key menu-map "3" '("Heading 3" . html-headline-3))
-    (define-key menu-map "2" '("Heading 2" . html-headline-2))
-    (define-key menu-map "1" '("Heading 1" . html-headline-1))
-    (define-key menu-map "l" '("Radio Buttons" . html-radio-buttons))
-    (define-key menu-map "c" '("Checkboxes" . html-checkboxes))
-    (define-key menu-map "l" '("List Item" . html-list-item))
-    (define-key menu-map "u" '("Unordered List" . html-unordered-list))
-    (define-key menu-map "o" '("Ordered List" . html-ordered-list))
-    (define-key menu-map "-" '("Horizontal Rule" . html-horizontal-rule))
-    (define-key menu-map "\n" '("Line Break" . html-line))
-    (define-key menu-map "\r" '("Paragraph" . html-paragraph))
-    (define-key menu-map "i" '("Image" . html-image))
-    (define-key menu-map "h" '("Href Anchor" . html-href-anchor))
-    (define-key menu-map "n" '("Name Anchor" . html-name-anchor))
-    map)
-  "Keymap for commands for use in HTML mode.")
-
-
-(defvar html-face-tag-alist
-  '((bold . "b")
-    (italic . "i")
-    (underline . "u")
-    (modeline . "rev"))
-  "Value of `sgml-face-tag-alist' for HTML mode.")
-
-(defvar html-tag-face-alist
-  '(("b" . bold)
-    ("big" . bold)
-    ("blink" . highlight)
-    ("cite" . italic)
-    ("em" . italic)
-    ("h1" bold underline)
-    ("h2" bold-italic underline)
-    ("h3" italic underline)
-    ("h4" . underline)
-    ("h5" . underline)
-    ("h6" . underline)
-    ("i" . italic)
-    ("rev"  . modeline)
-    ("s" . underline)
-    ("small" . default)
-    ("strong" . bold)
-    ("title" bold underline)
-    ("tt" . default)
-    ("u" . underline)
-    ("var" . italic))
-  "Value of `sgml-tag-face-alist' for HTML mode.")
-
-
-(defvar html-display-text
-  '((img . "[/]")
-    (hr . "----------")
-    (li . "o "))
-  "Value of `sgml-display-text' for HTML mode.")
-
-
-; should code exactly HTML 3 here when that is finished
-(defvar html-tag-alist
-  (let* ((1-9 '(("8") ("9")
-		("1") ("2") ("3") ("4") ("5") ("6") ("7")))
-	 (align '(("align" ("left") ("center") ("right"))))
-	 (valign '(("top") ("middle") ("bottom") ("baseline")))
-	 (rel '(("next") ("previous") ("parent") ("subdocument") ("made")))
-	 (href '("href" ("ftp:") ("file:") ("finger:") ("gopher:") ("http:")
-		 ("mailto:") ("news:") ("rlogin:") ("telnet:") ("tn3270:")
-		 ("wais:") ("/cgi-bin/")))
-	 (name '("name"))
-	 (link `(,href
-		 ("rel" ,@rel)
-		 ("rev" ,@rel)
-		 ("title")))
-	 (list '((nil \n
-		      ( "List item: "
-			"<li>" str \n))
-		 ("type" ("A") ("a") ("I") ("i") ("1"))))
-	 (cell `(t
-		 ,align
-		 ("valign" ,@valign)
-		 ("colspan" ,@1-9)
-		 ("rowspan" ,@1-9)
-		 ("nowrap" t))))
-    ;; put ,-expressions first, else byte-compile chokes (as of V19.29)
-    ;; and like this it's more efficient anyway
-    `(("a" ,name ,@link)
-      ("base" t ,@href)
-      ("dir" ,@list)
-      ("font" ("size" ("-1") ("+1") ("-2") ("+2") ,@(cdr (cdr 1-9))))
-      ("form" (\n _ \n "<input type=\"submit\" value=\"\">")
-       ("action" ,@(cdr href)) ("method" ("get") ("post")))
-      ("h1" ,@align)
-      ("h2" ,@align)
-      ("h3" ,@align)
-      ("h4" ,@align)
-      ("h5" ,@align)
-      ("h6" ,@align)
-      ("hr" t ("size" ,@1-9) ("width") ("noshade" t) ,@align)
-      ("img" t ("align" ,@valign ("texttop") ("absmiddle") ("absbottom"))
-       ("src") ("alt") ("width" "1") ("height" "1")
-       ("border" "1") ("vspace" "1") ("hspace" "1") ("ismap" t))
-      ("input" t ("size" ,@1-9) ("maxlength" ,@1-9) ("checked" t) ,name
-       ("type" ("text") ("password") ("checkbox") ("radio")
-	("submit") ("reset"))
-       ("value"))
-      ("link" t ,@link)
-      ("menu" ,@list)
-      ("ol" ,@list)
-      ("p" t ,@align)
-      ("select" (nil \n
-		     ("Text: "
-		      "<option>" str \n))
-       ,name ("size" ,@1-9) ("multiple" t))
-      ("table" (nil \n
-		    ((completing-read "Cell kind: " '(("td") ("th"))
-				      nil t "t")
-		     "<tr><" str ?> _ \n))
-       ("border" t ,@1-9) ("width" "10") ("cellpadding"))
-      ("td" ,@cell)
-      ("textarea" ,name ("rows" ,@1-9) ("cols" ,@1-9))
-      ("th" ,@cell)
-      ("ul" ,@list)
-
-      ,@sgml-tag-alist
-
-      ("abbrev")
-      ("acronym")
-      ("address")
-      ("array" (nil \n
-		    ("Item: " "<item>" str \n))
-       "align")
-      ("au")
-      ("b")
-      ("big")
-      ("blink")
-      ("blockquote" \n)
-      ("body" \n ("background" ".gif") ("bgcolor" "#") ("text" "#")
-       ("link" "#") ("alink" "#") ("vlink" "#"))
-      ("box" (nil _ "<over>" _))
-      ("br" t ("clear" ("left") ("right")))
-      ("caption" ("valign" ("top") ("bottom")))
-      ("center" \n)
-      ("cite")
-      ("code" \n)
-      ("dd" t)
-      ("del")
-      ("dfn")
-      ("dl" (nil \n
-		 ( "Term: "
-		   "<dt>" str "<dd>" _ \n)))
-      ("dt" (t _ "<dd>"))
-      ("em")
-      ("fn" "id" "fn")
-      ("head" \n)
-      ("html" (\n
-	       "<head>\n"
-	       "<title>" (setq str (read-input "Title: ")) "</title>\n"
-	       "<body>\n<h1>" str "</h1>\n" _
-	       "\n<address>\n<a href=\"mailto:"
-	       user-mail-address
-	       "\">" (user-full-name) "</a>\n</address>"))
-      ("i")
-      ("ins")
-      ("isindex" t ("action") ("prompt"))
-      ("kbd")
-      ("lang")
-      ("li" t)
-      ("math" \n)
-      ("nobr")
-      ("option" t ("value") ("label") ("selected" t))
-      ("over" t)
-      ("person")
-      ("pre" \n)
-      ("q")
-      ("rev")
-      ("s")
-      ("samp")
-      ("small")
-      ("strong")
-      ("sub")
-      ("sup")
-      ("title")
-      ("tr" t)
-      ("tt")
-      ("u")
-      ("var")
-      ("wbr" t)))
-  "*Value of `sgml-tag-alist' for HTML mode.")
-
-(defvar html-tag-help
-  `(,@sgml-tag-help
-    ("a" . "Anchor of point or link elsewhere")
-    ("abbrev" . "?")
-    ("acronym" . "?")
-    ("address" . "Formatted mail address")
-    ("array" . "Math array")
-    ("au" . "?")
-    ("b" . "Bold face")
-    ("base" . "Base address for URLs")
-    ("big" . "Font size")
-    ("blink" . "Blinking text")
-    ("blockquote" . "Indented quotation")
-    ("body" . "Document body")
-    ("box" . "Math fraction")
-    ("br" . "Line break")
-    ("caption" . "Table caption")
-    ("center" . "Centered text")
-    ("changed" . "Change bars")
-    ("cite" . "Citation of a document")
-    ("code" . "Formatted source code")
-    ("dd" . "Definition of term")
-    ("del" . "?")
-    ("dfn" . "?")
-    ("dir" . "Directory list (obsolete)")
-    ("dl" . "Definition list")
-    ("dt" . "Term to be definined")
-    ("em" . "Emphasised") 
-    ("embed" . "Embedded data in foreign format")
-    ("fig" . "Figure")
-    ("figa" . "Figure anchor")
-    ("figd" . "Figure description")
-    ("figt" . "Figure text")
-    ("fn" . "?")
-    ("font" . "Font size")
-    ("form" . "Form with input fields")
-    ("group" . "Document grouping")
-    ("h1" . "Most important section headline")
-    ("h2" . "Important section headline")
-    ("h3" . "Section headline")
-    ("h4" . "Minor section headline")
-    ("h5" . "Unimportant section headline")
-    ("h6" . "Least important section headline")
-    ("head" . "Document header")
-    ("hr" . "Horizontal rule")
-    ("html" . "HTML Document")
-    ("i" . "Italic face")
-    ("img" . "Graphic image")
-    ("input" . "Form input field")
-    ("ins" . "?")
-    ("isindex" . "Input field for index search")
-    ("kbd" . "Keybard example face")
-    ("lang" . "Natural language")
-    ("li" . "List item")
-    ("link" . "Link relationship")
-    ("math" . "Math formula")
-    ("menu" . "Menu list (obsolete)")
-    ("mh" . "Form mail header")
-    ("nextid" . "Allocate new id")
-    ("nobr" . "Text without line break")
-    ("ol" . "Ordered list")
-    ("option" . "Selection list item")
-    ("over" . "Math fraction rule")
-    ("p" . "Paragraph start")
-    ("panel" . "Floating panel")
-    ("person" . "?")
-    ("pre" . "Preformatted fixed width text")
-    ("q" . "?")
-    ("rev" . "Reverse video")
-    ("s" . "?")
-    ("samp" . "Sample text")
-    ("select" . "Selection list")
-    ("small" . "Font size")
-    ("sp" . "Nobreak space")
-    ("strong" . "Standout text")
-    ("sub" . "Subscript")
-    ("sup" . "Superscript")
-    ("table" . "Table with rows and columns")
-    ("tb" . "Table vertical break")
-    ("td" . "Table data cell")
-    ("textarea" . "Form multiline edit area")
-    ("th" . "Table header cell")
-    ("title" . "Document title")
-    ("tr" . "Table row separator")
-    ("tt" . "Typewriter face")
-    ("u" . "Underlined text")
-    ("ul" . "Unordered list")
-    ("var" . "Math variable face")
-    ("wbr" . "Enable <br> within <nobr>"))
-"*Value of `sgml-tag-help' for HTML mode.")
-
-
-
-;;;###autoload
-(defun html-mode ()
-  "Major mode based on SGML mode for editing HTML documents.
-This allows inserting skeleton costructs used in hypertext documents with
-completion.  See below for an introduction to HTML.  Use
-\\[browse-url-of-buffer] to see how this comes out.  See also `sgml-mode' on
-which this is based.
-
-Do \\[describe-variable] html- SPC and \\[describe-variable] sgml- SPC to see available variables.
-
-To write fairly well formatted pages you only need to know few things.  Most
-browsers have a function to read the source code of the page being seen, so
-you can imitate various tricks.  Here's a very short HTML primer which you
-can also view with a browser to see what happens:
-
-<title>A Title Describing Contents</title> should be on every page.  Pages can
-have <h1>Very Major Headlines</h1> through <h6>Very Minor Headlines</h6>
-<hr> Parts can be separated with horizontal rules.
-
-<p>Paragraphs only need an opening tag.  Line breaks and multiple spaces are
-ignored unless the text is <pre>preformatted.</pre>  Text can be marked as
-<b>bold</b>, <i>italic</i> or <u>underlined</u> using the normal  M-g  or
-Edit/Text Properties/Face commands.
-
-Pages can have <a name=\"SOMENAME\">named points</a> and can link other points
-to them with <a href=\"#SOMENAME\">see also somename</a>.  In the same way <a
-href=\"URL\">see also URL</a> where URL is a filename relative to current
-directory or something like http://www.cs.indiana.edu/elisp/w3/docs.html.
-
-Images in many formats can be inlined with <img src=\"URL\">.
-
-If you mainly create your own documents, `sgml-specials' might be interesting.
-But note that some HTML 2 browsers can't handle &apos;.  To work around that
-do:
-
-\(eval-after-load \"sgml-mode\" '(aset sgml-char-names ?' nil))
-\\{html-mode-map}"
-  (interactive)
-  (sgml-mode-common html-tag-face-alist html-display-text)
-  (use-local-map html-mode-map)
-  (make-local-variable 'sgml-tag-alist)
-  (make-local-variable 'sgml-face-tag-alist)
-  (make-local-variable 'sgml-tag-help)
-  (make-local-variable 'outline-regexp)
-  (make-local-variable 'outline-heading-end-regexp)
-  (make-local-variable 'outline-level)
-  (setq mode-name "HTML"
-        major-mode 'html-mode
-	sgml-tag-alist html-tag-alist
-	sgml-face-tag-alist html-face-tag-alist
-	sgml-tag-help html-tag-help
-	outline-regexp "^.*<[Hh][1-6]\\>"
-	outline-heading-end-regexp "</[Hh][1-6]>"
-	outline-level (lambda ()
-			(char-after (1- (match-end 0)))))
-  (run-hooks 'html-mode-hook))
-
-
-(define-skeleton html-href-anchor
-  "HTML anchor tag with href attribute."
-  nil
-  "<a href=\"http:" _ "\"></a>")
-
-(define-skeleton html-name-anchor
-  "HTML anchor tag with name attribute."
-  nil
-  "<a name=\"" _ "\"></a>")
-
-(define-skeleton html-headline-1
-  "HTML level 1 headline tags."
-  nil
-  "<h1>" _ "</h1>")
-
-(define-skeleton html-headline-2
-  "HTML level 2 headline tags."
-  nil
-  "<h2>" _ "</h2>")
-
-(define-skeleton html-headline-3
-  "HTML level 3 headline tags."
-  nil
-  "<h3>" _ "</h3>")
-
-(define-skeleton html-headline-4
-  "HTML level 4 headline tags."
-  nil
-  "<h4>" _ "</h4>")
-
-(define-skeleton html-headline-5
-  "HTML level 5 headline tags."
-  nil
-  "<h5>" _ "</h5>")
-
-(define-skeleton html-headline-6
-  "HTML level 6 headline tags."
-  nil
-  "<h6>" _ "</h6>")
-
-(define-skeleton html-horizontal-rule
-  "HTML horizontal rule tag."
-  nil
-  "<hr>" \n)
-
-(define-skeleton html-image
-  "HTML image tag."
-  nil
-  "<img src=\"http:" _ "\">")
-
-(define-skeleton html-line
-  "HTML line break tag."
-  nil
-  "<br>" \n)
-
-(define-skeleton html-ordered-list
-  "HTML ordered list tags."
-  nil
-  ?< "ol>" \n
-  "<li>" _ \n
-  "</ol>")
-
-(define-skeleton html-unordered-list
-  "HTML unordered list tags."
-  nil
-  ?< "ul>" \n
-  "<li>" _ \n
-  "</ul>")
-
-(define-skeleton html-list-item
-  "HTML list item tag."
-  nil
-  (if (bolp) nil '\n)
-  "<li>")
-
-(define-skeleton html-paragraph
-  "HTML paragraph tag."
-  nil
-  (if (bolp) nil ?\n)
-  \n "<p>")
-
-(define-skeleton html-checkboxes
-  "Group of connected checkbox inputs."
-  nil
-  '(setq v1 (eval str))			; allow passing name as argument
-  ("Value & Text: "
-   "<input type=\"checkbox\" name=\""
-   (or v1 (setq v1 (skeleton-read "Name: ")))
-   "\" value=\"" str ?\"
-   (if v2 "" " checked") ?> str
-   (or v2 (setq v2 (if (y-or-n-p "Newline? ") "<br>" ""))) \n))
-
-(define-skeleton html-radio-buttons
-  "Group of connected radio button inputs."
-  nil
-  '(setq v1 (eval str))			; allow passing name as argument
-  ("Value & Text: "
-   "<input type=\"radio\" name=\""
-   (or v1 (setq v1 (skeleton-read "Name: ")))
-   "\" value=\"" str ?\"
-   (if v2 "" " checked") ?> str
-   (or v2 (setq v2 (if (y-or-n-p "Newline? ") "<br>" ""))) \n))
-
-
-(defun html-autoview-mode (&optional arg)
-  "Toggle automatic viewing via `html-viewer' upon saving buffer.
-With positive prefix ARG always turns viewing on, with negative ARG always off.
-Can be used as a value for `html-mode-hook'."
-  (interactive "P")
-  (if (setq arg (if arg
-		    (< (prefix-numeric-value arg) 0)
-		  (and (boundp 'after-save-hook)
-		       (memq 'browse-url-of-buffer after-save-hook))))
-      (setq after-save-hook (delq 'browse-url-of-buffer after-save-hook))
-    (make-local-hook 'after-save-hook)
-    (add-hook 'after-save-hook 'browse-url-of-buffer nil t))
-  (message "Autoviewing turned %s."
-	   (if arg "off" "on")))
-
-;;; sgml-mode.el ends here
diff --git a/lisp/textmodes/spell.el b/lisp/textmodes/spell.el
deleted file mode 100644
index 65dde5383c7..00000000000
--- a/lisp/textmodes/spell.el
+++ /dev/null
@@ -1,154 +0,0 @@
-;;; spell.el --- spelling correction interface for Emacs.
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: wp, unix
-
-;; 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 mode provides an Emacs interface to the UNIX spell(1) program.
-;; Entry points are `spell-buffer', `spell-word', `spell-region' and
-;; `spell-string'.  These facilities are documented in the Emacs user's
-;; manual.
-
-;;; Code:
-
-(defvar spell-command "spell"
-  "*Command to run the spell program.")
-
-(defvar spell-filter nil
-  "*Filter function to process text before passing it to spell program.
-This function might remove text-processor commands.
-nil means don't alter the text before checking it.")
-
-;;;###autoload
-(put 'spell-filter 'risky-local-variable t)
-
-;;;###autoload
-(defun spell-buffer ()
-  "Check spelling of every word in the buffer.
-For each incorrect word, you are asked for the correct spelling
-and then put into a query-replace to fix some or all occurrences.
-If you do not want to change a word, just give the same word
-as its \"correct\" spelling; then the query replace is skipped."
-  (interactive)
-  (spell-region (point-min) (point-max) "buffer"))
-
-;;;###autoload
-(defun spell-word ()
-  "Check spelling of word at or before point.
-If it is not correct, ask user for the correct spelling
-and `query-replace' the entire buffer to substitute it."
-  (interactive)
-  (let (beg end spell-filter)
-    (save-excursion
-     (if (not (looking-at "\\<"))
-	 (forward-word -1))
-     (setq beg (point))
-     (forward-word 1)
-     (setq end (point)))
-    (spell-region beg end (buffer-substring beg end))))
-
-;;;###autoload
-(defun spell-region (start end &optional description)
-  "Like `spell-buffer' but applies only to region.
-Used in a program, applies from START to END.
-DESCRIPTION is an optional string naming the unit being checked:
-for example, \"word\"."
-  (interactive "r")
-  (let ((filter spell-filter)
-	(buf (get-buffer-create " *temp*")))
-    (save-excursion
-     (set-buffer buf)
-     (widen)
-     (erase-buffer))
-    (message "Checking spelling of %s..." (or description "region"))
-    (if (and (null filter) (= ?\n (char-after (1- end))))
-	(if (string= "spell" spell-command)
-	    (call-process-region start end "spell" nil buf)
-	  (call-process-region start end shell-file-name
-			       nil buf nil "-c" spell-command))
-      (let ((oldbuf (current-buffer)))
-	(save-excursion
-	 (set-buffer buf)
-	 (insert-buffer-substring oldbuf start end)
-	 (or (bolp) (insert ?\n))
-	 (if filter (funcall filter))
-	 (if (string= "spell" spell-command)
-	     (call-process-region (point-min) (point-max) "spell" t buf)
-	   (call-process-region (point-min) (point-max) shell-file-name
-				t buf nil "-c" spell-command)))))
-    (message "Checking spelling of %s...%s"
-	     (or description "region")
-	     (if (save-excursion
-		  (set-buffer buf)
-		  (> (buffer-size) 0))
-		 "not correct"
-	       "correct"))
-    (let (word newword
-	  (case-fold-search t)
-	  (case-replace t))
-      (while (save-excursion
-	      (set-buffer buf)
-	      (> (buffer-size) 0))
-	(save-excursion
-	 (set-buffer buf)
-	 (goto-char (point-min))
-	 (setq word (downcase
-		     (buffer-substring (point)
-				       (progn (end-of-line) (point)))))
-	 (forward-char 1)
-	 (delete-region (point-min) (point))
-	 (setq newword
-	       (read-input (concat "`" word
-				   "' not recognized; edit a replacement: ")
-			   word))
-	 (flush-lines (concat "^" (regexp-quote word) "$")))
-	(if (not (equal word newword))
-	    (progn
-	     (goto-char (point-min))
-	     (query-replace-regexp (concat "\\b" (regexp-quote word) "\\b")
-				   newword)))))))
-
-
-;;;###autoload
-(defun spell-string (string)
-  "Check spelling of string supplied as argument."
-  (interactive "sSpell string: ")
-  (let ((buf (get-buffer-create " *temp*")))
-    (save-excursion
-     (set-buffer buf)
-     (widen)
-     (erase-buffer)
-     (insert string "\n")
-     (if (string= "spell" spell-command)
-	 (call-process-region (point-min) (point-max) "spell"
-			      t t)
-       (call-process-region (point-min) (point-max) shell-file-name
-			    t t nil "-c" spell-command))
-     (if (= 0 (buffer-size))
-	 (message "%s is correct" string)
-       (goto-char (point-min))
-       (while (search-forward "\n" nil t)
-	 (replace-match " "))
-       (message "%sincorrect" (buffer-substring 1 (point-max)))))))
-
-;;; spell.el ends here
diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el
deleted file mode 100644
index f12047153e4..00000000000
--- a/lisp/textmodes/tex-mode.el
+++ /dev/null
@@ -1,1239 +0,0 @@
-;;; tex-mode.el --- TeX, LaTeX, and SliTeX mode commands.
-
-;; Copyright (C) 1985, 86, 89, 92, 94, 95, 96 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: tex
-
-;; Contributions over the years by William F. Schelter, Dick King,
-;; Stephen Gildea, Michael Prange, Jacob Gore, and Edward M. Reingold.
-
-;; 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.
-
-;;; Code:
-
-(require 'shell)
-(require 'compile)
-
-;;;###autoload
-(defvar tex-shell-file-name nil
-  "*If non-nil, the shell file name to run in the subshell used to run TeX.")
-
-;;;###autoload
-(defvar tex-directory "."
-  "*Directory in which temporary files are written.
-You can make this `/tmp' if your TEXINPUTS has no relative directories in it
-and you don't try to apply \\[tex-region] or \\[tex-buffer] when there are
-`\\input' commands with relative directories.")
-
-;;;###autoload
-(defvar tex-first-line-header-regexp nil
-  "Regexp for matching a first line which `tex-region' should include.
-If this is non-nil, it should be a regular expression string;
-if it matches the first line of the file,
-`tex-region' always includes the first line in the TeX run.")
-
-;;;###autoload
-(defvar tex-main-file nil
-  "*The main TeX source file which includes this buffer's file.
-The command `tex-buffer' runs TeX on `tex-main-file'if that is non-nil.")
-
-;;;###autoload
-(defvar tex-offer-save t
-  "*If non-nil, ask about saving modified buffers before \\[tex-file] is run.")
-
-;;;###autoload
-(defvar tex-run-command "tex"
-  "*Command used to run TeX subjob.
-If this string contains an asterisk (`*'), that is replaced by the file name;
-otherwise, the file name, preceded by blank, is added at the end.")
-
-;;;###autoload
-(defvar latex-run-command "latex"
-  "*Command used to run LaTeX subjob.
-If this string contains an asterisk (`*'), that is replaced by the file name;
-otherwise, the file name, preceded by blank, is added at the end.")
-
-(defvar standard-latex-block-names
-      '("abstract"         "array"            "center"       "description"
-        "displaymath"      "document"         "enumerate"    "eqnarray"
-        "eqnarray*"        "equation"         "figure"       "figure*"
-        "flushleft"        "flushright"       "itemize"      "letter"
-        "list"             "minipage"         "picture"      "quotation"
-        "quote"            "slide"            "sloppypar"     "tabbing"
-        "table"            "table*"           "tabular"       "tabular*"
-        "thebibliography"  "theindex*"        "titlepage"     "trivlist"
-        "verbatim"         "verbatim*"        "verse")
-  "Standard LaTeX block names.")
-
-;;;###autoload
-(defvar latex-block-names nil
-  "*User defined LaTeX block names.
-Combined with `standard-latex-block-names' for minibuffer completion.")
-
-;;;###autoload
-(defvar slitex-run-command "slitex"
-  "*Command used to run SliTeX subjob.
-If this string contains an asterisk (`*'), that is replaced by the file name;
-otherwise, the file name, preceded by blank, is added at the end.")
-
-;;;###autoload
-(defvar tex-bibtex-command "bibtex"
-  "*Command used by `tex-bibtex-file' to gather bibliographic data.
-If this string contains an asterisk (`*'), that is replaced by the file name;
-otherwise, the file name, preceded by blank, is added at the end.")
-
-;;;###autoload
-(defvar tex-dvi-print-command "lpr -d"
-  "*Command used by \\[tex-print] to print a .dvi file.
-If this string contains an asterisk (`*'), that is replaced by the file name;
-otherwise, the file name, preceded by blank, is added at the end.")
-
-;;;###autoload
-(defvar tex-alt-dvi-print-command "lpr -d"
-  "*Command used by \\[tex-print] with a prefix arg to print a .dvi file.
-If this string contains an asterisk (`*'), that is replaced by the file name;
-otherwise, the file name, preceded by blank, is added at the end.
-
-If two printers are not enough of a choice, you can set the variable
-`tex-alt-dvi-print-command' to an expression that asks what you want;
-for example,
-
-    (setq tex-alt-dvi-print-command
-         '(format \"lpr -P%s\" (read-string \"Use printer: \")))
-
-would tell \\[tex-print] with a prefix argument to ask you which printer to
-use.")
-
-;;;###autoload
-(defvar tex-dvi-view-command nil
-  "*Command used by \\[tex-view] to display a `.dvi' file.
-If this string contains an asterisk (`*'), that is replaced by the file name;
-otherwise, the file name, preceded by blank, is added at the end.
-
-This can be set conditionally so that the previewer used is suitable for the
-window system being used.  For example,
-
-    (setq tex-dvi-view-command
-          (if (eq window-system 'x) \"xdvi\" \"dvi2tty * | cat -s\"))
-
-would tell \\[tex-view] to use xdvi under X windows and to use dvi2tty
-otherwise.")
-
-;;;###autoload
-(defvar tex-show-queue-command "lpq"
-  "*Command used by \\[tex-show-print-queue] to show the print queue.
-Should show the queue(s) that \\[tex-print] puts jobs on.")
-
-;;;###autoload
-(defvar tex-default-mode 'plain-tex-mode
-  "*Mode to enter for a new file that might be either TeX or LaTeX.
-This variable is used when it can't be determined whether the file
-is plain TeX or LaTeX or what because the file contains no commands.
-Normally set to either `plain-tex-mode' or `latex-mode'.")
-
-;;;###autoload
-(defvar tex-open-quote "``"
-  "*String inserted by typing \\[tex-insert-quote] to open a quotation.")
-
-;;;###autoload
-(defvar tex-close-quote "''"
-  "*String inserted by typing \\[tex-insert-quote] to close a quotation.")
-
-(defvar tex-last-temp-file nil
-  "Latest temporary file generated by \\[tex-region] and \\[tex-buffer].
-Deleted when the \\[tex-region] or \\[tex-buffer] is next run, or when the
-tex shell terminates.")
-
-(defvar tex-command nil
-  "Command to run TeX.
-The name of the file, preceded by a blank, will be added to this string.")
-
-(defvar tex-trailer nil
-  "String appended after the end of a region sent to TeX by \\[tex-region].")
-
-(defvar tex-start-of-header nil
-  "Regular expression used by \\[tex-region] to find start of file's header.")
-
-(defvar tex-end-of-header nil
-  "Regular expression used by \\[tex-region] to find end of file's header.")
-
-(defvar tex-shell-cd-command "cd"
-  "Command to give to shell running TeX to change directory.
-The value of `tex-directory' is appended to this, separated by a space.")
-
-(defvar tex-zap-file nil
-  "Temporary file name used for text being sent as input to TeX.
-Should be a simple file name with no extension or directory specification.")
-
-(defvar tex-last-buffer-texed nil
-  "Buffer which was last TeXed.")
-
-(defvar tex-print-file nil
-  "File name that \\[tex-print] prints.
-Set by \\[tex-region], \\[tex-buffer], and \\[tex-file].")
-
-(defvar tex-mode-syntax-table nil
-  "Syntax table used while in TeX mode.")
-
-(defun latex-imenu-create-index ()
-  "Generates an alist for imenu from a LaTeX buffer."
-  (let (result temp)
-    (goto-char (point-max))
-    (while (re-search-backward "\\\\\\(part\\|chapter\\|\
-\\(sub\\)?\\(\\(sub\\)?section\\|paragraph\\)\\)\\*?[ \t\n]*{\\([^}]*\\)}" nil t)
-      (setq temp
-	    (assoc (buffer-substring-no-properties (match-beginning 1)
-						   (match-end 1)) 
-		   '(("part" . "") ("chapter" . " ")
-		     ("section" . "  ") ("subsection" . "   ")
-		     ("subsubsection" . "    ")
-		     ("paragraph" . "     ") ("subparagraph" . "      "))))
-      (setq result (cons (cons (concat (cdr temp) (match-string 5)) 
-			       (match-beginning 0))
-			 result)))
-    result))
-
-(defun tex-define-common-keys (keymap)
-  "Define the keys that we want defined both in TeX mode and in the TeX shell."
-  (define-key keymap "\C-c\C-k" 'tex-kill-job)
-  (define-key keymap "\C-c\C-l" 'tex-recenter-output-buffer)
-  (define-key keymap "\C-c\C-q" 'tex-show-print-queue)
-  (define-key keymap "\C-c\C-p" 'tex-print)
-  (define-key keymap "\C-c\C-v" 'tex-view)
-
-  (define-key keymap [menu-bar tex] (cons "TeX" (make-sparse-keymap "TeX")))
-
-  (define-key keymap [menu-bar tex tex-kill-job] '("Tex Kill" . tex-kill-job))
-  (define-key keymap [menu-bar tex tex-recenter-output-buffer]
-    '("Tex Recenter" . tex-recenter-output-buffer))
-  (define-key keymap [menu-bar tex tex-show-print-queue]
-    '("Show Print Queue" . tex-show-print-queue))
-  (define-key keymap [menu-bar tex tex-alt-print]
-    '("Tex Print (alt printer)" . tex-alt-print))
-  (define-key keymap [menu-bar tex tex-print] '("Tex Print" . tex-print))
-  (define-key keymap [menu-bar tex tex-view] '("Tex View" . tex-view))
-  )
-
-(defvar tex-mode-map nil "Keymap for TeX mode.")
-
-(if tex-mode-map 
-    nil
-  (setq tex-mode-map (make-sparse-keymap))
-  (tex-define-common-keys tex-mode-map)
-  (define-key tex-mode-map "\"" 'tex-insert-quote)
-  (define-key tex-mode-map "\n" 'tex-terminate-paragraph)
-  (define-key tex-mode-map "\C-c}" 'up-list)
-  (define-key tex-mode-map "\C-c{" 'tex-insert-braces)
-  (define-key tex-mode-map "\C-c\C-r" 'tex-region)
-  (define-key tex-mode-map "\C-c\C-b" 'tex-buffer)
-  (define-key tex-mode-map "\C-c\C-f" 'tex-file)
-  (define-key tex-mode-map "\C-c\C-i" 'tex-bibtex-file)
-  (define-key tex-mode-map "\C-c\C-o" 'tex-latex-block)
-  (define-key tex-mode-map "\C-c\C-e" 'tex-close-latex-block)
-  (define-key tex-mode-map "\C-c\C-u" 'tex-goto-last-unclosed-latex-block)
-  (define-key tex-mode-map [menu-bar tex tex-bibtex-file]
-    '("BibTeX File" . tex-bibtex-file))
-  (define-key tex-mode-map [menu-bar tex tex-validate-region]
-    '("Validate Region" . tex-validate-region))
-  (define-key tex-mode-map [menu-bar tex validate-tex-buffer]
-    '("Validate Buffer" . validate-tex-buffer))
-  (define-key tex-mode-map [menu-bar tex tex-region]
-    '("TeX Region" . tex-region))
-  (define-key tex-mode-map [menu-bar tex tex-buffer]
-    '("TeX Buffer" . tex-buffer))
-  (define-key tex-mode-map [menu-bar tex tex-file] '("TeX File" . tex-file)))
-
-(put 'tex-region 'menu-enable 'mark-active)
-(put 'tex-validate-region 'menu-enable 'mark-active)
-(put 'tex-print 'menu-enable '(stringp tex-print-file))
-(put 'tex-alt-print 'menu-enable '(stringp tex-print-file))
-(put 'tex-view 'menu-enable '(stringp tex-print-file))
-(put 'tex-recenter-output-buffer 'menu-enable '(get-buffer "*tex-shell*"))
-(put 'tex-kill-job 'menu-enable '(tex-shell-running))
-
-
-(defvar tex-shell-map nil
-  "Keymap for the TeX shell.
-Inherits `shell-mode-map' with a few additions.")
-
-(defvar tex-face-alist
-  '((bold . "{\\bf ")
-    (italic . "{\\it ")
-    (bold-italic . "{\\bi ")		; hypothetical
-    (underline . "\\underline{")
-    (default . "{\\rm "))
-  "Alist of face and TeX font name for facemenu.")
-
-(defvar tex-latex-face-alist
-  `((italic . "{\\em ")
-    ,@tex-face-alist)
-  "Alist of face and LaTeX font name for facemenu.")
-
-
-(defvar compare-windows-whitespace)	; Pacify the byte-compiler
-
-;;; This would be a lot simpler if we just used a regexp search,
-;;; but then it would be too slow.
-;;;###autoload
-(defun tex-mode ()
-  "Major mode for editing files of input for TeX, LaTeX, or SliTeX.
-Tries to determine (by looking at the beginning of the file) whether
-this file is for plain TeX, LaTeX, or SliTeX and calls `plain-tex-mode',
-`latex-mode', or `slitex-mode', respectively.  If it cannot be determined,
-such as if there are no commands in the file, the value of `tex-default-mode'
-says which mode to use."
-  (interactive)
-  (let (mode slash comment)
-    (save-excursion
-      (goto-char (point-min))
-      (while (and (setq slash (search-forward "\\" nil t))
-		  (setq comment (let ((search-end (point)))
-				  (save-excursion
-				    (beginning-of-line)
-				    (search-forward "%" search-end t))))))
-      (if (and slash (not comment))
-	  (setq mode (if (looking-at "documentstyle\\|documentclass\\|begin\\b\\|NeedsTeXFormat{LaTeX")
-                         (if (looking-at
-			      "document\\(style\\|class\\)\\(\\[.*\\]\\)?{slides}")
-                             'slitex-mode
-                           'latex-mode)
-		       'plain-tex-mode))))
-    (if mode (funcall mode)
-      (funcall tex-default-mode))))
-
-;;;###autoload
-(defalias 'TeX-mode 'tex-mode)
-;;;###autoload
-(defalias 'LaTeX-mode 'latex-mode)
-
-;;;###autoload
-(defun plain-tex-mode ()
-  "Major mode for editing files of input for plain TeX.
-Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
-
-Use \\[tex-region] to run TeX on the current region, plus a \"header\"
-copied from the top of the file (containing macro definitions, etc.),
-running TeX under a special subshell.  \\[tex-buffer] does the whole buffer.
-\\[tex-file] saves the buffer and then processes the file.
-\\[tex-print] prints the .dvi file made by any of these.
-\\[tex-view] previews the .dvi file made by any of these.
-\\[tex-bibtex-file] runs bibtex on the file of the current buffer.
-
-Use \\[validate-tex-buffer] to check buffer for paragraphs containing
-mismatched $'s or braces.
-
-Special commands:
-\\{tex-mode-map}
-
-Mode variables:
-tex-run-command
-	Command string used by \\[tex-region] or \\[tex-buffer].
-tex-directory
-	Directory in which to create temporary files for TeX jobs
-	run by \\[tex-region] or \\[tex-buffer].
-tex-dvi-print-command
-	Command string used by \\[tex-print] to print a .dvi file.
-tex-alt-dvi-print-command
-	Alternative command string used by \\[tex-print] (when given a prefix
-	argument) to print a .dvi file.
-tex-dvi-view-command
-	Command string used by \\[tex-view] to preview a .dvi file.
-tex-show-queue-command
-	Command string used by \\[tex-show-print-queue] to show the print
-	queue that \\[tex-print] put your job on.
-
-Entering Plain-tex mode runs the hook `text-mode-hook', then the hook
-`tex-mode-hook', and finally the hook `plain-tex-mode-hook'.  When the
-special subshell is initiated, the hook `tex-shell-hook' is run."
-
-  (interactive)
-  (tex-common-initialization)
-  (setq mode-name "TeX")
-  (setq major-mode 'plain-tex-mode)
-  (setq tex-command tex-run-command)
-  (setq tex-start-of-header "%\\*\\*start of header")
-  (setq tex-end-of-header "%\\*\\*end of header")
-  (setq tex-trailer "\\bye\n")
-  (run-hooks 'text-mode-hook 'tex-mode-hook 'plain-tex-mode-hook))
-;;;###autoload
-(defalias 'plain-TeX-mode 'plain-tex-mode)
-
-;;;###autoload
-(defun latex-mode ()
-  "Major mode for editing files of input for LaTeX.
-Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
-
-Use \\[tex-region] to run LaTeX on the current region, plus the preamble
-copied from the top of the file (containing \\documentstyle, etc.),
-running LaTeX under a special subshell.  \\[tex-buffer] does the whole buffer.
-\\[tex-file] saves the buffer and then processes the file.
-\\[tex-print] prints the .dvi file made by any of these.
-\\[tex-view] previews the .dvi file made by any of these.
-\\[tex-bibtex-file] runs bibtex on the file of the current buffer.
-
-Use \\[validate-tex-buffer] to check buffer for paragraphs containing
-mismatched $'s or braces.
-
-Special commands:
-\\{tex-mode-map}
-
-Mode variables:
-latex-run-command
-	Command string used by \\[tex-region] or \\[tex-buffer].
-tex-directory
-	Directory in which to create temporary files for LaTeX jobs
-	run by \\[tex-region] or \\[tex-buffer].
-tex-dvi-print-command
-	Command string used by \\[tex-print] to print a .dvi file.
-tex-alt-dvi-print-command
-	Alternative command string used by \\[tex-print] (when given a prefix
-	argument) to print a .dvi file.
-tex-dvi-view-command
-	Command string used by \\[tex-view] to preview a .dvi file.
-tex-show-queue-command
-	Command string used by \\[tex-show-print-queue] to show the print
-	queue that \\[tex-print] put your job on.
-
-Entering Latex mode runs the hook `text-mode-hook', then 
-`tex-mode-hook', and finally `latex-mode-hook'.  When the special
-subshell is initiated, `tex-shell-hook' is run."
-  (interactive)
-  (tex-common-initialization)
-  (setq mode-name "LaTeX")
-  (setq major-mode 'latex-mode)
-  (setq tex-command latex-run-command)
-  (setq tex-start-of-header "\\\\documentstyle\\|\\\\documentclass")
-  (setq tex-end-of-header "\\\\begin{document}")
-  (setq tex-trailer "\\end{document}\n")
-  ;; A line containing just $$ is treated as a paragraph separator.
-  ;; A line starting with $$ starts a paragraph,
-  ;; but does not separate paragraphs if it has more stuff on it.
-  (setq paragraph-start "[ \t]*$\\|[\f%]\\|[ \t]*\\$\\$\\|\
-\\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\
-\\\\chapter\\>\\|\\\\section\\>\\|\
-\\\\subsection\\>\\|\\\\subsubsection\\>\\|\
-\\\\paragraph\\>\\|\\\\subparagraph\\>\\|\
-\\\\item\\>\\|\\\\bibitem\\>\\|\\\\newline\\>\\|\\\\noindent\\>\\|\
-\\\\[a-z]*space\\>\\|\\\\[a-z]*skip\\>\\|\
-\\\\newpage\\>\\|\\\\[a-z]*page\\|\\\\footnote\\>\\|\
-\\\\marginpar\\>\\|\\\\parbox\\>\\|\\\\caption\\>")
-  (setq paragraph-separate "[ \t]*$\\|[\f%]\\|[ \t]*\\$\\$[ \t]*$\\|\
-\\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\
-\\\\chapter\\>\\|\\\\section\\>\\|\
-\\\\subsection\\>\\|\\\\subsubsection\\>\\|\
-\\\\paragraph\\>\\|\\\\subparagraph\\>\\|\
-\\(\\\\item\\|\\\\bibitem\\|\\\\newline\\|\\\\noindent\\|\
-\\\\[a-z]*space\\|\\\\[a-z]*skip\\|\
-\\\\newpage\\|\\\\[a-z]*page[a-z]*\\|\\\\footnote\\|\
-\\\\marginpar\\|\\\\parbox\\|\\\\caption\\)[ \t]*\\($\\|%\\)")
-  (make-local-variable 'imenu-create-index-function)
-  (setq imenu-create-index-function 'latex-imenu-create-index)
-  (make-local-variable 'tex-face-alist)
-  (setq tex-face-alist tex-latex-face-alist)
-  (run-hooks 'text-mode-hook 'tex-mode-hook 'latex-mode-hook))
-
-;;;###autoload
-(defun slitex-mode ()
-  "Major mode for editing files of input for SliTeX.
-Makes $ and } display the characters they match.
-Makes \" insert `` when it seems to be the beginning of a quotation,
-and '' when it appears to be the end; it inserts \" only after a \\.
-
-Use \\[tex-region] to run SliTeX on the current region, plus the preamble
-copied from the top of the file (containing \\documentstyle, etc.),
-running SliTeX under a special subshell.  \\[tex-buffer] does the whole buffer.
-\\[tex-file] saves the buffer and then processes the file.
-\\[tex-print] prints the .dvi file made by any of these.
-\\[tex-view] previews the .dvi file made by any of these.
-\\[tex-bibtex-file] runs bibtex on the file of the current buffer.
-
-Use \\[validate-tex-buffer] to check buffer for paragraphs containing
-mismatched $'s or braces.
-
-Special commands:
-\\{tex-mode-map}
-
-Mode variables:
-slitex-run-command
-	Command string used by \\[tex-region] or \\[tex-buffer].
-tex-directory
-	Directory in which to create temporary files for SliTeX jobs
-	run by \\[tex-region] or \\[tex-buffer].
-tex-dvi-print-command
-	Command string used by \\[tex-print] to print a .dvi file.
-tex-alt-dvi-print-command
-	Alternative command string used by \\[tex-print] (when given a prefix
-	argument) to print a .dvi file.
-tex-dvi-view-command
-	Command string used by \\[tex-view] to preview a .dvi file.
-tex-show-queue-command
-	Command string used by \\[tex-show-print-queue] to show the print
-	queue that \\[tex-print] put your job on.
-
-Entering SliTeX mode runs the hook `text-mode-hook', then the hook
-`tex-mode-hook', then the hook `latex-mode-hook', and finally the hook
-`slitex-mode-hook'.  When the special subshell is initiated, the hook
-`tex-shell-hook' is run."
-  (interactive)
-  (tex-common-initialization)
-  (setq mode-name "SliTeX")
-  (setq major-mode 'slitex-mode)
-  (setq tex-command slitex-run-command)
-  (setq tex-start-of-header "\\\\documentstyle{slides}\\|\\\\documentclass{slides}")
-  (setq tex-end-of-header "\\\\begin{document}")
-  (setq tex-trailer "\\end{document}\n")
-  ;; A line containing just $$ is treated as a paragraph separator.
-  ;; A line starting with $$ starts a paragraph,
-  ;; but does not separate paragraphs if it has more stuff on it.
-  (setq paragraph-start "[ \t]*$\\|[\f%]\\|[ \t]*\\$\\$\\|\
-\\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\
-\\\\chapter\\>\\|\\\\section\\>\\|\
-\\\\subsection\\>\\|\\\\subsubsection\\>\\|\
-\\\\paragraph\\>\\|\\\\subparagraph\\>\\|\
-\\\\item\\>\\|\\\\bibitem\\>\\|\\\\newline\\>\\|\\\\noindent\\>\\|\
-\\\\[a-z]*space\\>\\|\\\\[a-z]*skip\\>\\|\
-\\\\newpage\\>\\|\\\\[a-z]*page\\|\\\\footnote\\>\\|\
-\\\\marginpar\\>\\|\\\\parbox\\>\\|\\\\caption\\>")
-  (setq paragraph-separate "[ \t]*$\\|[\f%]\\|[ \t]*\\$\\$[ \t]*$\\|\
-\\\\begin\\>\\|\\\\label\\>\\|\\\\end\\>\\|\\\\\\[\\|\\\\\\]\\|\
-\\\\chapter\\>\\|\\\\section\\>\\|\
-\\\\subsection\\>\\|\\\\subsubsection\\>\\|\
-\\\\paragraph\\>\\|\\\\subparagraph\\>\\|\
-\\\\item[ \t]*$\\|\\\\bibitem[ \t]*$\\|\\\\newline[ \t]*$\\|\\\\noindent[ \t]*$\\|\
-\\\\[a-z]*space[ \t]*$\\|\\\\[a-z]*skip[ \t]*$\\|\
-\\\\newpage[ \t]*$\\|\\\\[a-z]*page[a-z]*[ \t]*$\\|\\\\footnote[ \t]*$\\|\
-\\\\marginpar[ \t]*$\\|\\\\parbox[ \t]*$\\|\\\\caption[ \t]*$")
-  (run-hooks
-   'text-mode-hook 'tex-mode-hook 'latex-mode-hook 'slitex-mode-hook))
-
-(defun tex-common-initialization ()
-  (kill-all-local-variables)
-  (use-local-map tex-mode-map)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (if (null tex-mode-syntax-table)
-      (let ((char 0))
-	(setq tex-mode-syntax-table (make-syntax-table))
-	(set-syntax-table tex-mode-syntax-table)
-	(while (< char ? )
-	  (modify-syntax-entry char ".")
-	  (setq char (1+ char)))
-	(modify-syntax-entry ?\C-@ "w")
-	(modify-syntax-entry ?\t " ")
-	(modify-syntax-entry ?\n ">")
-	(modify-syntax-entry ?\f ">")
-	(modify-syntax-entry ?$ "$$")
-	(modify-syntax-entry ?% "<")
-	(modify-syntax-entry ?\\ "/")
-	(modify-syntax-entry ?\" ".")
-	(modify-syntax-entry ?& ".")
-	(modify-syntax-entry ?_ ".")
-	(modify-syntax-entry ?@ "_")
-	(modify-syntax-entry ?~ " ")
-	(modify-syntax-entry ?' "w"))
-    (set-syntax-table tex-mode-syntax-table))
-  (make-local-variable 'paragraph-start)
-  ;; A line containing just $$ is treated as a paragraph separator.
-  (setq paragraph-start "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$")
-  (make-local-variable 'paragraph-separate)
-  ;; A line starting with $$ starts a paragraph,
-  ;; but does not separate paragraphs if it has more stuff on it.
-  (setq paragraph-separate "[ \t]*$\\|[\f\\\\%]\\|[ \t]*\\$\\$[ \t]*$")
-  (make-local-variable 'comment-start)
-  (setq comment-start "%")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "\\(\\(^\\|[^\\]\\)\\(\\\\\\\\\\)*\\)\\(%+ *\\)")
-  (make-local-variable 'comment-indent-function)
-  (setq comment-indent-function 'tex-comment-indent)
-  (make-local-variable 'parse-sexp-ignore-comments)
-  (setq parse-sexp-ignore-comments t)
-  (make-local-variable 'compare-windows-whitespace)
-  (setq compare-windows-whitespace 'tex-categorize-whitespace)
-  (make-local-variable 'skeleton-further-elements)
-  (setq skeleton-further-elements
-	  '((indent-line-function 'indent-relative-maybe)))
-  (make-local-variable 'facemenu-add-face-function)
-  (make-local-variable 'facemenu-end-add-face)
-  (make-local-variable 'facemenu-remove-face-function)
-  (setq facemenu-add-face-function
-	(lambda (face end)
-	  (let ((face-text (cdr (assq face tex-face-alist))))
-	    (if face-text
-		face-text
-	      (error "Face %s not configured for %s mode" face mode-name))))
-	facemenu-end-add-face "}"
-	facemenu-remove-face-function t)
-  (make-local-variable 'tex-command)
-  (make-local-variable 'tex-start-of-header)
-  (make-local-variable 'tex-end-of-header)
-  (make-local-variable 'tex-trailer))
-
-(defun tex-comment-indent ()
-  (if (looking-at "%%%")
-      (current-column)
-    (skip-chars-backward " \t")
-    (max (if (bolp) 0 (1+ (current-column)))
-	 comment-column)))
-
-(defun tex-categorize-whitespace (backward-limit)
-  ;; compare-windows-whitespace is set to this.
-  ;; This is basically a finite-state machine.
-  ;; Returns a symbol telling how TeX would treat
-  ;; the whitespace we are looking at: null, space, or par.
-  (let ((category 'null)
-	(not-finished t))
-    (skip-chars-backward " \t\n\f" backward-limit)
-    (while not-finished
-      (cond ((looking-at "[ \t]+")
-	     (goto-char (match-end 0))
-	     (if (eql category 'null)
-		 (setq category 'space)))
-	    ((looking-at "\n")
-	     (cond ((eql category 'newline)
-		    (setq category 'par)
-		    (setq not-finished nil))
-		   (t
-		    (setq category 'newline) ;a strictly internal state
-		    (goto-char (match-end 0)))))
-	    ((looking-at "\f+")
-	     (setq category 'par)
-	     (setq not-finished nil))
-	    (t
-	     (setq not-finished nil))))
-    (skip-chars-forward " \t\n\f")
-    (if (eql category 'newline)
-	'space				;TeX doesn't distinguish
-      category)))
-
-(defun tex-insert-quote (arg)
-  "Insert the appropriate quote marks for TeX.
-Inserts the value of `tex-open-quote' (normally ``) or `tex-close-quote'
-\(normally '') depending on the context.  With prefix argument, always
-inserts \" characters."
-  (interactive "*P")
-  (if arg
-      (self-insert-command (prefix-numeric-value arg))
-    (insert
-     (cond ((or (bobp)
-		(save-excursion
-		  (forward-char -1)
-		  (looking-at "\\s(\\|\\s \\|\\s>")))
-	    tex-open-quote)
-	   ((= (preceding-char) ?\\)
-	    ?\")
-	   (t
-	    tex-close-quote)))))
-
-(defun validate-tex-buffer ()
-  "Check current buffer for paragraphs containing mismatched $s.
-Their positions are recorded in the buffer `*Occur*'.
-To find a particular invalidity from `*Occur*',
-switch to to that buffer and type C-c C-c on the line
-for the invalidity you want to see."
-  (interactive)
-  (let ((buffer (current-buffer))
-	(prevpos (point-min))
-	(linenum nil))
-    (with-output-to-temp-buffer "*Occur*"
-      (princ "Mismatches:\n")
-      (save-excursion
-	(set-buffer standard-output)
-	(occur-mode)
-	(setq occur-buffer buffer)
-	(setq occur-nlines 0)
-	(setq occur-pos-list nil))
-      (save-excursion
-	(goto-char (point-max))
-	(while (and (not (input-pending-p)) (not (bobp)))
-	  (let ((end (point))
-		prev-end)
-	    ;; Scan the previous paragraph for invalidities.
-	    (if (search-backward "\n\n" nil t)
-		(progn
-		  (setq prev-end (point))
-		  (forward-char 2))
-	      (goto-char (setq prev-end (point-min))))
-	    (or (tex-validate-region (point) end)
-		(let* ((oend end)
-		       (end (save-excursion (forward-line 1) (point)))
-		       start tem)
-		  (beginning-of-line)
-		  (setq start (point))
-		  ;; Keep track of line number as we scan,
-		  ;; in a cumulative fashion.
-		  (if linenum
-		      (setq linenum (- linenum (count-lines prevpos (point))))
-		    (setq linenum (1+ (count-lines 1 start))))
-		  (setq prevpos (point))
-		  ;; Mention this mismatch in *Occur*.  
-		  ;; Since we scan from end of buffer to beginning,
-		  ;; add each mismatch at the beginning of *Occur*
-		  ;; and at the beginning of occur-pos-list.
-		  (save-excursion
-		    (setq tem (point-marker))
-		    (set-buffer standard-output)
-		    (goto-char (point-min))
-		    ;; Skip "Mismatches:" header line.
-		    (forward-line 1)
-		    (setq occur-pos-list (cons tem occur-pos-list))
-		    (insert-buffer-substring buffer start end)
-		    (forward-char (- start end))
-		    (insert (format "%3d: " linenum)))))
-	    (goto-char prev-end))))
-      (save-excursion
-	(set-buffer standard-output)
-	(if (null occur-pos-list)
-	    (insert "None!\n"))
-	(if (interactive-p)
-	    (message "%d mismatches found" (length occur-pos-list)))))))
-
-(defun tex-validate-region (start end)
-  "Check for mismatched braces or $'s in region.
-Returns t if no mismatches.  Returns nil and moves point to suspect
-area if a mismatch is found."
-  (interactive "r")
-  (let ((failure-point nil) (max-possible-sexps (- end start)))
-    (save-excursion
-      (condition-case ()
-	  (save-restriction
-	    (narrow-to-region start end)
-	    (goto-char start)
-	    (while (< 0 (setq max-possible-sexps (1- max-possible-sexps)))
-	      (forward-sexp 1)))
-	(error
-	  (skip-syntax-forward " .>")
-	  (setq failure-point (point)))))
-    (if failure-point
-	(progn
-	  (goto-char failure-point)
-	  nil)
-      t)))
-
-(defun tex-terminate-paragraph (inhibit-validation)
-  "Insert two newlines, breaking a paragraph for TeX.
-Check for mismatched braces or $s in paragraph being terminated.
-A prefix arg inhibits the checking."
-  (interactive "*P")
-  (or inhibit-validation
-      (save-excursion
-	(tex-validate-region
-	  (save-excursion
-	    (search-backward "\n\n" nil 'move)
-	    (point))
-	  (point)))
-      (message "Paragraph being closed appears to contain a mismatch"))
-  (insert "\n\n"))
-
-(defun tex-insert-braces ()
-  "Make a pair of braces and be poised to type inside of them."
-  (interactive "*")
-  (insert ?\{)
-  (save-excursion
-    (insert ?})))
-
-;;; Like tex-insert-braces, but for LaTeX.
-(define-skeleton tex-latex-block
-  "Create a matching pair of lines \\begin[OPT]{NAME} and \\end{NAME} at point.
-Puts point on a blank line between them."
-  (completing-read "LaTeX block name: "
-		   (mapcar 'list
-			   (append standard-latex-block-names
-				   latex-block-names)))
-  "\\begin["
-  (skeleton-read "[options]: ") & ?\] | -1
-  ?\{
-  str
-  ?\} \n
-  _ \n
-  "\\end{" str ?\})
-
-(defun tex-last-unended-begin ()
-  "Leave point at the beginning of the last `\\begin{...}' that is unended."
-  (while (and (re-search-backward "\\(\\\\begin\\s *{\\)\\|\\(\\\\end\\s *{\\)")
-              (looking-at "\\\\end{"))
-    (tex-last-unended-begin)))
-
-(defun tex-goto-last-unclosed-latex-block ()
-  "Move point to the last unclosed \\begin{...}.
-Mark is left at original location."
-  (interactive)
-  (let ((spot))
-    (save-excursion
-      (condition-case nil
-          (tex-last-unended-begin)
-        (error (error "Couldn't find unended \\begin")))
-      (setq spot (point)))
-    (push-mark)
-    (goto-char spot)))
-
-(defun tex-close-latex-block ()
-  "Creates an \\end{...} to match the last unclosed \\begin{...}."
-  (interactive "*")
-  (let ((new-line-needed (bolp))
-	text indentation)
-    (save-excursion
-      (condition-case nil
-          (tex-last-unended-begin)
-        (error (error "Couldn't find unended \\begin")))
-      (setq indentation (current-column))
-      (re-search-forward "\\\\begin\\(\\s *{[^}\n]*}\\)")
-      (setq text (buffer-substring (match-beginning 1) (match-end 1))))
-    (indent-to indentation)
-    (insert "\\end" text)
-    (if new-line-needed (insert ?\n))))
-
-(defun tex-compilation-parse-errors ()
-  "Parse the current buffer as error messages.
-This makes a list of error descriptors, compilation-error-list.
-For each source-file, line-number pair in the buffer,
-the source file is read in, and the text location is saved in
-compilation-error-list.  The function `next-error', assigned to
-\\[next-error], takes the next error off the list and visits its location.
-
-This function works on TeX compilations only.  It is necessary for
-that purpose, since TeX does not put file names on the same line as
-line numbers for the errors."
-  (setq compilation-error-list nil)
-  (message "Parsing error messages...")
-  (modify-syntax-entry ?\{ "_")
-  (modify-syntax-entry ?\} "_")
-  (modify-syntax-entry ?\[ "_")
-  (modify-syntax-entry ?\] "_")
-  (let (text-buffer
-	last-filename last-linenum)
-    ;; Don't reparse messages already seen at last parse.
-    (goto-char compilation-parsing-end)
-    ;; Don't parse the first two lines as error messages.
-    ;; This matters for grep.
-    (if (bobp)
-	(forward-line 2))
-    (while (re-search-forward "^l\.[0-9]+ " nil t)
-      (let (linenum filename
-	    error-marker text-marker)
-	;; Extract file name and line number from error message.
-	;; Line number is 2 away from beginning of line: "l.23"
-	(beginning-of-line)
-	(goto-char (+ (point) 2))
-	(setq linenum (read (current-buffer)))
-	;; The file is the one that was opened last and is still open.
-	;; We need to find the last open parenthesis.
-	(insert ?\))
-	(backward-sexp)
-	(forward-char)
-	(setq filename (current-word))
-	;; Locate the erring file and line.
-	(if (and (equal filename last-filename)
-		 (= linenum last-linenum))
-	    nil
-	  (skip-chars-backward "^(")
-	  (backward-char)
-	  (forward-sexp)
-	  (backward-delete-char 1)
-	  (setq error-marker (point-marker))
-	  ;; text-buffer gets the buffer containing this error's file.
-	  (if (not (equal filename last-filename))
-	      (setq text-buffer
-		    (and (file-exists-p (setq last-filename filename))
-			 (find-file-noselect filename))
-		    last-linenum 0))
-	  (if text-buffer
-	      ;; Go to that buffer and find the erring line.
-	      (save-excursion
-		(set-buffer text-buffer)
-		(if (zerop last-linenum)
-		    (progn
-		      (goto-char 1)
-		      (setq last-linenum 1)))
-		(forward-line (- linenum last-linenum))
-		(setq last-linenum linenum)
-		(setq text-marker (point-marker))
-		(setq compilation-error-list
-		      (cons (list error-marker text-marker)
-			    compilation-error-list)))))
-	(forward-line 1)))
-    (setq compilation-parsing-end (point-max)))
-  (message "Parsing error messages...done")
-  (setq compilation-error-list (nreverse compilation-error-list)))
-
-;;; Invoking TeX in an inferior shell.
-
-;;; Why use a shell instead of running TeX directly?  Because if TeX
-;;; gets stuck, the user can switch to the shell window and type at it.
-
-;;; The utility functions:
-
-;;;###autoload
-(defun tex-start-shell ()
-  (save-excursion
-    (set-buffer
-     (make-comint
-      "tex-shell"
-      (or tex-shell-file-name (getenv "ESHELL") (getenv "SHELL") "/bin/sh")
-      nil))
-    (let ((proc (get-process "tex-shell")))
-      (set-process-sentinel proc 'tex-shell-sentinel)
-      (process-kill-without-query proc)
-      (setq comint-prompt-regexp shell-prompt-pattern)
-      (setq tex-shell-map (nconc (make-sparse-keymap) shell-mode-map))
-      (tex-define-common-keys tex-shell-map)
-      (use-local-map tex-shell-map)
-      (run-hooks 'tex-shell-hook)
-      (while (zerop (buffer-size))
-	(sleep-for 1)))))
-
-(defun tex-display-shell ()
-  "Make the TeX shell buffer visible in a window."
-  (display-buffer (process-buffer (get-process "tex-shell")))
-  (tex-recenter-output-buffer nil))
-
-(defun tex-shell-sentinel (proc msg)
-  (cond ((null (buffer-name (process-buffer proc)))
-	 ;; buffer killed
-	 (set-process-buffer proc nil)
-         (tex-delete-last-temp-files))
-	((memq (process-status proc) '(signal exit))
-         (tex-delete-last-temp-files))))
-
-(defun tex-set-buffer-directory (buffer directory)
-  "Set BUFFER's default directory to be DIRECTORY."
-  (setq directory (file-name-as-directory (expand-file-name directory)))
-  (if (not (file-directory-p directory))
-      (error "%s is not a directory" directory)
-    (save-excursion
-      (set-buffer buffer)
-      (setq default-directory directory))))
-
-(defvar tex-send-command-modified-tick 0)
-(make-variable-buffer-local 'tex-send-command-modified-tick)
-
-(defun tex-send-command (command &optional file background)
-  "Send COMMAND to TeX shell process, substituting optional FILE for *.
-Do this in background if optional BACKGROUND is t.  If COMMAND has no *,
-FILE will be appended, preceded by a blank, to COMMAND.  If FILE is nil, no
-substitution will be made in COMMAND.  COMMAND can be any expression that
-evaluates to a command string."
-  (save-excursion
-    (let* ((cmd (eval command))
-	   (proc (or (get-process "tex-shell") (error "No TeX subprocess")))
-	   (buf (process-buffer proc))
-           (star (string-match "\\*" cmd))
-	   (string
-	    (concat
-	     (if file
-		 (if star (concat (substring cmd 0 star)
-				  file (substring cmd (1+ star)))
-		   (concat cmd " " file))
-	       cmd)
-	     (if background "&" ""))))
-      ;; Switch to buffer before checking for subproc output in it.
-      (set-buffer buf)
-      ;; If text is unchanged since previous tex-send-command,
-      ;; we haven't got any output.  So wait for output now.
-      (if (= (buffer-modified-tick buf) tex-send-command-modified-tick)
-	  (accept-process-output proc))
-      (goto-char (process-mark proc))
-      (insert string)
-      (comint-send-input)
-      (setq tex-send-command-modified-tick (buffer-modified-tick buf)))))
-
-(defun tex-delete-last-temp-files (&optional not-all)
-  "Delete any junk files from last temp file.
-If NOT-ALL is non-nil, save the `.dvi' file."
-  (if tex-last-temp-file
-      (let* ((dir (file-name-directory tex-last-temp-file))
-	     (list (and (file-directory-p dir)
-			(file-name-all-completions
-			 (file-name-nondirectory tex-last-temp-file) dir))))
-	(while list
-	  (if not-all
-	      (and
-	       ;; If arg is non-nil, don't delete the .dvi file.
-	       (not (string-match "\\.dvi$" (car list)))
-	       (delete-file (concat dir (car list))))
-	    (delete-file (concat dir (car list))))
-          (setq list (cdr list))))))
-
-(add-hook 'kill-emacs-hook 'tex-delete-last-temp-files)
-
-;;; The commands:
-
-(defun tex-region (beg end)
-  "Run TeX on the current region, via a temporary file.
-The file's name comes from the variable `tex-zap-file' and the
-variable `tex-directory' says where to put it.
-
-If the buffer has a header, the header is given to TeX before the
-region itself.  The buffer's header is all lines between the strings
-defined by `tex-start-of-header' and `tex-end-of-header' inclusive.
-The header must start in the first 100 lines of the buffer.
-
-The value of `tex-trailer' is given to TeX as input after the region.
-
-The value of `tex-command' specifies the command to use to run TeX."
-  (interactive "r")
-  (if (tex-shell-running)
-      (tex-kill-job)
-    (tex-start-shell))
-  (or tex-zap-file
-      (setq tex-zap-file (tex-generate-zap-file-name)))
-  ;; Temp file will be written and TeX will be run in zap-directory.
-  ;; If the TEXINPUTS file has relative directories or if the region has
-  ;; \input of files, this must be the same directory as the file for
-  ;; TeX to access the correct inputs.  That's why it's safest if
-  ;; tex-directory is ".".
-  (let* ((zap-directory
-          (file-name-as-directory (expand-file-name tex-directory)))
-         (tex-out-file (concat zap-directory tex-zap-file ".tex")))
-    ;; Don't delete temp files if we do the same buffer twice in a row.
-    (or (eq (current-buffer) tex-last-buffer-texed)
-	(tex-delete-last-temp-files t))
-    ;; Write the new temp file.
-    (save-excursion
-      (save-restriction
-	(widen)
-	(goto-char (point-min))
-	(forward-line 100)
-	(let ((search-end (point))
-	      (default-directory zap-directory)
-	      (already-output 0))
-	  (goto-char (point-min))
-
-          ;; Maybe copy first line, such as `\input texinfo', to temp file.
-	  (and tex-first-line-header-regexp
-	       (looking-at tex-first-line-header-regexp)
-	       (write-region (point) 
-			     (progn (forward-line 1)
-				    (setq already-output (point)))
-			     tex-out-file nil nil))
-
-	  ;; Write out the header, if there is one,
-	  ;; and any of the specified region which extends before it.
-	  ;; But don't repeat anything already written.
-	  (if (re-search-forward tex-start-of-header search-end t)
-	      (let (hbeg)
-		(beginning-of-line)
-		(setq hbeg (point))	;mark beginning of header
-		(if (re-search-forward tex-end-of-header nil t)
-		    (let (hend)
-		      (forward-line 1)
-		      (setq hend (point))	;mark end of header
-		      (write-region (max (min hbeg beg) already-output)
-				    hend
-				    tex-out-file
-				    (not (zerop already-output)) nil)
-		      (setq already-output hend)))))
-
-	  ;; Write out the specified region
-	  ;; (but don't repeat anything already written).
-	  (write-region (max beg already-output) end
-			tex-out-file
-			(not (zerop already-output)) nil))
-	;; Write the trailer, if any.
-	;; Precede it with a newline to make sure it
-	;; is not hidden in a comment.
-	(if tex-trailer
-	    (write-region (concat "\n" tex-trailer) nil
-			  tex-out-file t nil))))
-    ;; Record the file name to be deleted afterward.
-    (setq tex-last-temp-file tex-out-file)
-    (tex-send-command tex-shell-cd-command zap-directory)
-    (tex-send-command tex-command tex-out-file)
-    (tex-display-shell)
-    (setq tex-print-file tex-out-file)
-    (setq tex-last-buffer-texed (current-buffer))))
-
-(defun tex-buffer ()
-  "Run TeX on current buffer.  See \\[tex-region] for more information.
-Does not save the buffer, so it's useful for trying experimental versions.
-See \\[tex-file] for an alternative."
-  (interactive)
-  (tex-region (point-min) (point-max)))
-
-(defun tex-file ()
-  "Prompt to save all buffers and run TeX (or LaTeX) on current buffer's file.
-This function is more useful than \\[tex-buffer] when you need the
-`.aux' file of LaTeX to have the correct name."
-  (interactive)
-  (let ((source-file
-	 (or tex-main-file 
-	     (if (buffer-file-name)
-		 (file-name-nondirectory (buffer-file-name))
-	       (error "Buffer does not seem to be associated with any file"))))
-	(file-dir (file-name-directory (buffer-file-name))))
-    (if tex-offer-save
-        (save-some-buffers))
-    (if (tex-shell-running)
-        (tex-kill-job)
-      (tex-start-shell))
-    (tex-send-command tex-shell-cd-command file-dir)
-    (tex-send-command tex-command source-file)
-    (tex-display-shell)
-    (setq tex-last-buffer-texed (current-buffer))
-    (setq tex-print-file source-file)))
-
-(defun tex-generate-zap-file-name ()
-  "Generate a unique name suitable for use as a file name."
-  ;; Include the shell process number and host name
-  ;; in case there are multiple shells (for same or different user).
-  (format "#tz%d%s"
-          (process-id (get-buffer-process "*tex-shell*"))
-	  (tex-strip-dots (system-name))))
-
-(defun tex-strip-dots (s)
-  (setq s (copy-sequence s))
-  (while (string-match "\\." s)
-    (aset s (match-beginning 0) ?-))
-  s)
-
-;; This will perhaps be useful for modifying TEXINPUTS.
-;; Expand each file name, separated by colons, in the string S.
-(defun tex-expand-files (s)
-  (let (elts (start 0))
-    (while (string-match ":" s start)
-      (setq elts (cons (substring s start (match-beginning 0)) elts))
-      (setq start (match-end 0)))
-    (or (= start 0)
-	(setq elts (cons (substring s start) elts)))
-    (mapconcat 'expand-file-name (nreverse elts) ":")))
-
-(defun tex-shell-running ()
-  (and (get-process "tex-shell")
-       (eq (process-status (get-process "tex-shell")) 'run)))
-
-(defun tex-kill-job ()
-  "Kill the currently running TeX job."
-  (interactive)
-  (quit-process (get-process "tex-shell") t))
-
-(defun tex-recenter-output-buffer (linenum)
-  "Redisplay buffer of TeX job output so that most recent output can be seen.
-The last line of the buffer is displayed on
-line LINE of the window, or centered if LINE is nil."
-  (interactive "P")
-  (let ((tex-shell (get-buffer "*tex-shell*"))
-	(old-buffer (current-buffer))
-	(window))
-    (if (null tex-shell)
-	(message "No TeX output buffer")
-      (setq window (display-buffer tex-shell))
-      (save-selected-window
-	(select-window window)
-	(bury-buffer tex-shell)
-	(goto-char (point-max))
-	(recenter (if linenum
-		      (prefix-numeric-value linenum)
-		    (/ (window-height) 2)))))))
-
-(defun tex-print (&optional alt)
-  "Print the .dvi file made by \\[tex-region], \\[tex-buffer] or \\[tex-file].
-Runs the shell command defined by `tex-dvi-print-command'.  If prefix argument
-is provided, use the alternative command, `tex-alt-dvi-print-command'."
-  (interactive "P")
-  (let ((print-file-name-dvi (tex-append tex-print-file ".dvi"))
-	test-name)
-    (if (and (not (equal (current-buffer) tex-last-buffer-texed))
-	     (buffer-file-name)
-	     ;; Check that this buffer's printed file is up to date.
-	     (file-newer-than-file-p
-	      (setq test-name (tex-append (buffer-file-name) ".dvi"))
-	      (buffer-file-name)))
-	(setq print-file-name-dvi test-name))
-    (if (not (file-exists-p print-file-name-dvi))
-        (error "No appropriate `.dvi' file could be found")
-      (tex-send-command
-        (if alt tex-alt-dvi-print-command tex-dvi-print-command)
-        print-file-name-dvi t))))
-
-(defun tex-alt-print ()
-  "Print the .dvi file made by \\[tex-region], \\[tex-buffer] or \\[tex-file].
-Runs the shell command defined by `tex-alt-dvi-print-command'."
-  (interactive)
-  (tex-print t))
-
-(defun tex-view ()
-  "Preview the last `.dvi' file made by running TeX under Emacs.
-This means, made using \\[tex-region], \\[tex-buffer] or \\[tex-file].
-The variable `tex-dvi-view-command' specifies the shell command for preview.
-You must set that variable yourself before using this command,
-because there is no standard value that would generally work."
-  (interactive)
-  (or tex-dvi-view-command
-      (error "You must set `tex-dvi-view-command'"))
-  (let ((tex-dvi-print-command tex-dvi-view-command))
-    (tex-print)))
-
-(defun tex-append (file-name suffix)
-  "Append to FILENAME the suffix SUFFIX, using same algorithm TeX uses.
-Pascal-based TeX scans for the first period, C TeX uses the last.
-No period is retained immediately before SUFFIX,
-so normally SUFFIX starts with one."
-  (if (stringp file-name)
-      (let ((file (file-name-nondirectory file-name))
-	    trial-name)
-	;; Try splitting on last period.
-	;; The first-period split can get fooled when two files
-	;; named a.tex and a.b.tex are both tex'd;
-	;; the last-period split must be right if it matches at all.
-	(setq trial-name
-	      (concat (file-name-directory file-name)
-		      (substring file 0
-				 (string-match "\\.[^.]*$" file))
-		      suffix))
-	(if (or (file-exists-p trial-name)
-		(file-exists-p (concat trial-name ".aux"))) ;for BibTeX files
-	    trial-name
-	  ;; Not found, so split on first period.
-	  (concat (file-name-directory file-name)
-		  (substring file 0
-			     (string-match "\\." file))
-		  suffix)))
-    " "))
-
-(defun tex-show-print-queue ()
-  "Show the print queue that \\[tex-print] put your job on.
-Runs the shell command defined by `tex-show-queue-command'."
-  (interactive)
-  (if (tex-shell-running)
-      (tex-kill-job)
-    (tex-start-shell))
-  (tex-send-command tex-show-queue-command)
-  (tex-display-shell))
-
-(defun tex-bibtex-file ()
-  "Run BibTeX on the current buffer's file."
-  (interactive)
-  (if (tex-shell-running)
-      (tex-kill-job)
-    (tex-start-shell))
-  (let ((tex-out-file
-         (tex-append (file-name-nondirectory (buffer-file-name)) ""))
-	(file-dir (file-name-directory (buffer-file-name))))
-    (tex-send-command tex-shell-cd-command file-dir)
-    (tex-send-command tex-bibtex-command tex-out-file))
-  (tex-display-shell))
-
-(run-hooks 'tex-mode-load-hook)
-
-(provide 'tex-mode)
-
-;;; tex-mode.el ends here
-
diff --git a/lisp/textmodes/texinfmt.el b/lisp/textmodes/texinfmt.el
deleted file mode 100644
index 7e6dcd57c25..00000000000
--- a/lisp/textmodes/texinfmt.el
+++ /dev/null
@@ -1,3058 +0,0 @@
-;;; texinfmt.el --- format Texinfo files into Info files.
-
-;; Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993 Free Software
-;; Foundation, Inc.
-
-;; Maintainer: Robert J. Chassell <bug-texinfo@prep.ai.mit.edu>
-
-;; 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.
-
-;;; Code:
-
-;;; Emacs lisp functions to convert Texinfo files to Info files.
-
-(defvar texinfmt-version "2.32 of 19 November 1993")
-
-;;; Variable definitions
-
-(require 'texinfo)          ; So `texinfo-footnote-style' is defined.
-(require 'texnfo-upd)       ; So `texinfo-section-types-regexp' is defined.
-
-(defvar texinfo-format-syntax-table nil)
-
-(defvar texinfo-vindex)
-(defvar texinfo-findex)
-(defvar texinfo-cindex)
-(defvar texinfo-pindex)
-(defvar texinfo-tindex)
-(defvar texinfo-kindex)
-(defvar texinfo-last-node)
-(defvar texinfo-node-names)
-(defvar texinfo-enclosure-list)
-(defvar texinfo-alias-list)
-
-(defvar texinfo-command-start)
-(defvar texinfo-command-end)
-(defvar texinfo-command-name)
-(defvar texinfo-defun-type)
-(defvar texinfo-last-node-pos)
-(defvar texinfo-stack)
-(defvar texinfo-short-index-cmds-alist)
-(defvar texinfo-short-index-format-cmds-alist)
-(defvar texinfo-format-filename)
-(defvar texinfo-footnote-number)
-(defvar texinfo-start-of-header)
-(defvar texinfo-end-of-header)
-(defvar texinfo-raisesections-alist)
-(defvar texinfo-lowersections-alist)
-
-;;; Syntax table
-
-(if texinfo-format-syntax-table
-    nil
-  (setq texinfo-format-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\" " " texinfo-format-syntax-table)
-  (modify-syntax-entry ?\\ " " texinfo-format-syntax-table)
-  (modify-syntax-entry ?@ "\\" texinfo-format-syntax-table)
-  (modify-syntax-entry ?\^q "\\" texinfo-format-syntax-table)
-  (modify-syntax-entry ?\[ "." texinfo-format-syntax-table)
-  (modify-syntax-entry ?\] "." texinfo-format-syntax-table)
-  (modify-syntax-entry ?\( "." texinfo-format-syntax-table)
-  (modify-syntax-entry ?\) "." texinfo-format-syntax-table)
-  (modify-syntax-entry ?{ "(}" texinfo-format-syntax-table)
-  (modify-syntax-entry ?} "){" texinfo-format-syntax-table)
-  (modify-syntax-entry ?\' "." texinfo-format-syntax-table))
-
-
-;;; Top level buffer and region formatting functions
-
-;;;###autoload
-(defun texinfo-format-buffer (&optional notagify)
-  "Process the current buffer as texinfo code, into an Info file.
-The Info file output is generated in a buffer visiting the Info file
-names specified in the @setfilename command.
-
-Non-nil argument (prefix, if interactive) means don't make tag table
-and don't split the file if large.  You can use Info-tagify and
-Info-split to do these manually."
-  (interactive "P")
-  (let ((lastmessage "Formatting Info file..."))
-    (message lastmessage)
-    (texinfo-format-buffer-1)
-    (if notagify
-        nil
-      (if (> (buffer-size) 30000)
-          (progn
-            (message (setq lastmessage "Making tags table for Info file..."))
-            (Info-tagify)))
-      (if (> (buffer-size) 100000)
-          (progn
-            (message (setq lastmessage "Splitting Info file..."))
-            (Info-split))))
-    (message (concat lastmessage
-                     (if (interactive-p) "done.  Now save it." "done.")))))
-
-(defvar texinfo-region-buffer-name "*Info Region*"
-  "*Name of the temporary buffer used by \\[texinfo-format-region].")
-
-;;;###autoload
-(defun texinfo-format-region (region-beginning region-end)
-  "Convert the current region of the Texinfo file to Info format.
-This lets you see what that part of the file will look like in Info.
-The command is bound to \\[texinfo-format-region].  The text that is
-converted to Info is stored in a temporary buffer."
-  (interactive "r")
-  (message "Converting region to Info format...")
-  (let (texinfo-command-start
-        texinfo-command-end
-        texinfo-command-name
-        texinfo-vindex
-        texinfo-findex
-        texinfo-cindex
-        texinfo-pindex
-        texinfo-tindex
-        texinfo-kindex
-        texinfo-stack
-        (texinfo-format-filename "")
-        texinfo-example-start
-        texinfo-last-node-pos
-        texinfo-last-node
-        texinfo-node-names
-        (texinfo-footnote-number 0)
-        last-input-buffer
-        (fill-column-for-info fill-column)
-        (input-buffer (current-buffer))
-        (input-directory default-directory)
-        (header-text "")
-        (header-beginning 1)
-        (header-end 1))
-    
-;;; Copy lines between beginning and end of header lines, 
-;;;    if any, or else copy the `@setfilename' line, if any.
-    (save-excursion
-        (save-restriction
-          (widen)
-          (goto-char (point-min))
-          (let ((search-end (save-excursion (forward-line 100) (point))))
-            (if (or
-                 ;; Either copy header text.
-                 (and 
-                  (prog1 
-                      (search-forward tex-start-of-header search-end t)
-                    (forward-line 1)
-                    ;; Mark beginning of header.
-                    (setq header-beginning (point)))
-                  (prog1 
-                      (search-forward tex-end-of-header nil t)
-                    (beginning-of-line)
-                    ;; Mark end of header
-                    (setq header-end (point))))
-                 ;; Or copy @filename line.
-                 (prog2
-                  (goto-char (point-min))
-                  (search-forward "@setfilename" search-end t)
-                  (beginning-of-line)
-                  (setq header-beginning (point))
-                  (forward-line 1)
-                  (setq header-end (point))))
-                
-                ;; Copy header  
-                (setq header-text
-                      (buffer-substring
-                       (min header-beginning region-beginning)
-                       header-end))))))
-
-;;; Find a buffer to use.
-    (switch-to-buffer (get-buffer-create texinfo-region-buffer-name))
-    (erase-buffer)
-    ;; Insert the header into the buffer.
-    (insert header-text)
-    ;; Insert the region into the buffer.
-    (insert-buffer-substring
-     input-buffer
-     (max region-beginning header-end)
-     region-end)
-    ;; Make sure region ends in a newline.
-    (or (= (preceding-char) ?\n)
-        (insert "\n"))
-    
-    (goto-char (point-min))
-    (texinfo-mode)
-    (message "Converting region to Info format...")
-    (setq fill-column fill-column-for-info)
-    ;; Install a syntax table useful for scanning command operands.
-    (set-syntax-table texinfo-format-syntax-table)
-
-    ;; Insert @include files so `texinfo-raise-lower-sections' can
-    ;; work on them without losing track of multiple
-    ;; @raise/@lowersections commands. 
-    (while (re-search-forward "^@include" nil t)
-      (setq texinfo-command-end (point))
-      (let ((filename (concat input-directory
-                              (texinfo-parse-line-arg))))
-        (re-search-backward "^@include")
-        (delete-region (point) (save-excursion (forward-line 1) (point)))
-        (message "Reading included file: %s" filename)
-        (save-excursion
-          (save-restriction
-            (narrow-to-region
-             (point)
-             (+ (point) (car (cdr (insert-file-contents filename)))))
-            (goto-char (point-min))
-            ;; Remove `@setfilename' line from included file, if any,
-            ;; so @setfilename command not duplicated.
-            (if (re-search-forward 
-                 "^@setfilename" (save-excursion (forward-line 100) (point)) t)
-                (progn
-                  (beginning-of-line)
-                  (delete-region
-                   (point) (save-excursion (forward-line 1) (point)))))))))
-
-    ;; Raise or lower level of each section, if necessary.
-    (goto-char (point-min))
-    (texinfo-raise-lower-sections)
-    ;; Append @refill to appropriate paragraphs for filling.
-    (goto-char (point-min))
-    (texinfo-append-refill)
-    ;; If the region includes the effective end of the data,
-    ;; discard everything after that.
-    (goto-char (point-max))
-    (if (re-search-backward "^@bye" nil t)
-        (delete-region (point) (point-max)))
-    ;; Make sure buffer ends in a newline.
-    (or (= (preceding-char) ?\n)
-        (insert "\n"))
-    ;; Don't use a previous value of texinfo-enclosure-list.
-    (setq texinfo-enclosure-list nil)
-    (setq texinfo-alias-list nil)
-
-    (goto-char (point-min))
-    (if (looking-at "\\\\input[ \t]+texinfo")
-        (delete-region (point) (save-excursion (forward-line 1) (point))))
-
-    ;; Insert Info region title text.
-    (goto-char (point-min))
-    (if (search-forward 
-         "@setfilename" (save-excursion (forward-line 100) (point)) t)
-        (progn
-          (setq texinfo-command-end (point))
-          (beginning-of-line)
-          (setq texinfo-command-start (point))
-          (let ((arg (texinfo-parse-arg-discard)))
-            (insert " "
-              texinfo-region-buffer-name
-              " buffer for:  `") 
-            (insert (file-name-nondirectory (expand-file-name arg)))
-            (insert "',        -*-Text-*-\n")))
-      ;; Else no `@setfilename' line
-      (insert " "
-              texinfo-region-buffer-name
-              " buffer                       -*-Text-*-\n"))
-    (insert "produced by `texinfo-format-region'\n"
-            "from a region in: "
-            (if (buffer-file-name input-buffer)
-                  (concat "`"
-                          (file-name-sans-versions
-                           (file-name-nondirectory
-                            (buffer-file-name input-buffer)))
-                          "'")
-                (concat "buffer `" (buffer-name input-buffer) "'"))
-              "\nusing `texinfmt.el' version "
-              texinfmt-version
-              ".\n\n")
-
-    ;; Now convert for real.
-    (goto-char (point-min))
-    (texinfo-format-scan)
-    (goto-char (point-min))
-    
-    (message "Done.")))
-
-
-;;; Primary internal formatting function for the whole buffer.
-
-(defun texinfo-format-buffer-1 ()
-  (let (texinfo-format-filename
-        texinfo-example-start
-        texinfo-command-start
-        texinfo-command-end
-        texinfo-command-name
-        texinfo-last-node
-        texinfo-last-node-pos
-        texinfo-vindex
-        texinfo-findex
-        texinfo-cindex
-        texinfo-pindex
-        texinfo-tindex
-        texinfo-kindex
-        texinfo-stack
-        texinfo-node-names
-        (texinfo-footnote-number 0)
-        last-input-buffer
-        outfile
-        (fill-column-for-info fill-column)
-        (input-buffer (current-buffer))
-        (input-directory default-directory))
-    (setq texinfo-enclosure-list nil)
-    (setq texinfo-alias-list nil)
-    (save-excursion
-      (goto-char (point-min))
-      (or (search-forward "@setfilename" nil t)
-          (error "Texinfo file needs an `@setfilename FILENAME' line."))
-      (setq texinfo-command-end (point))
-      (setq outfile (texinfo-parse-line-arg)))
-    (find-file outfile)
-    (texinfo-mode)
-    (setq fill-column fill-column-for-info)
-    (set-syntax-table texinfo-format-syntax-table)
-    (erase-buffer)
-    (insert-buffer-substring input-buffer)
-    (message "Converting %s to Info format..." (buffer-name input-buffer))
-    
-    ;; Insert @include files so `texinfo-raise-lower-sections' can
-    ;; work on them without losing track of multiple
-    ;; @raise/@lowersections commands. 
-    (goto-char (point-min))
-    (while (re-search-forward "^@include" nil t)
-      (setq texinfo-command-end (point))
-      (let ((filename (concat input-directory
-                              (texinfo-parse-line-arg))))
-        (re-search-backward "^@include")
-        (delete-region (point) (save-excursion (forward-line 1) (point)))
-        (message "Reading included file: %s" filename)
-        (save-excursion
-          (save-restriction
-            (narrow-to-region
-             (point)
-             (+ (point) (car (cdr (insert-file-contents filename)))))
-            (goto-char (point-min))
-            ;; Remove `@setfilename' line from included file, if any,
-            ;; so @setfilename command not duplicated.
-            (if (re-search-forward 
-                 "^@setfilename"
-                 (save-excursion (forward-line 100) (point)) t)
-                (progn
-                  (beginning-of-line)
-                  (delete-region
-                   (point) (save-excursion (forward-line 1) (point)))))))))
-    ;; Raise or lower level of each section, if necessary.
-    (goto-char (point-min))
-    (texinfo-raise-lower-sections)
-    ;; Append @refill to appropriate paragraphs
-    (goto-char (point-min))
-    (texinfo-append-refill)
-    (goto-char (point-min))
-    (search-forward "@setfilename")
-    (beginning-of-line)
-    (delete-region (point-min) (point))
-    ;; Remove @bye at end of file, if it is there.
-    (goto-char (point-max))
-    (if (search-backward "@bye" nil t)
-        (delete-region (point) (point-max)))
-    ;; Make sure buffer ends in a newline.
-    (or (= (preceding-char) ?\n)
-        (insert "\n"))
-    ;; Scan the whole buffer, converting to Info format.
-    (texinfo-format-scan)
-    ;; Return data for indices.
-    (goto-char (point-min))
-    (list outfile
-          texinfo-vindex texinfo-findex texinfo-cindex
-          texinfo-pindex texinfo-tindex texinfo-kindex)))
-
-
-;;; Perform non-@-command file conversions: quotes and hyphens
-
-(defun texinfo-format-convert (min max)
-  ;; Convert left and right quotes to typewriter font quotes.
-  (goto-char min)
-  (while (search-forward "``" max t)
-    (replace-match "\""))
-  (goto-char min)
-  (while (search-forward "''" max t)
-    (replace-match "\""))
-  ;; Convert three hyphens in a row to two.
-  (goto-char min)
-  (while (re-search-forward "\\( \\|\\w\\)\\(---\\)\\( \\|\\w\\)" max t)
-    (delete-region (1+ (match-beginning 2)) (+ 2 (match-beginning
-    2)))))
-
-
-;;; Handle paragraph filling
-
-(defvar texinfo-no-refill-regexp
-  "^@\\(example\\|smallexample\\|lisp\\|smalllisp\\|display\\|format\\|flushleft\\|flushright\\|menu\\|titlepage\\|iftex\\|ifhtml\\|tex\\|html\\)"
-  "Regexp specifying environments in which paragraphs are not filled.")
-
-(defvar texinfo-part-of-para-regexp
-  "^@\\(b{\\|bullet{\\|cite{\\|code{\\|emph{\\|equiv{\\|error{\\|expansion{\\|file{\\|i{\\|inforef{\\|kbd{\\|key{\\|lisp{\\|minus{\\|point{\\|print{\\|pxref{\\|r{\\|ref{\\|result{\\|samp{\\|sc{\\|t{\\|TeX{\\|today{\\|var{\\|w{\\|xref{\\)"
-  "Regexp specifying @-commands found within paragraphs.")
-
-(defun texinfo-append-refill ()
-  "Append @refill at end of each paragraph that should be filled.
-Do not append @refill to paragraphs within @example and similar environments.  
-Do not append @refill to paragraphs containing @w{TEXT} or @*."
-
-  ;; It is necessary to append @refill before other processing because
-  ;; the other processing removes information that tells Texinfo
-  ;; whether the text should or should not be filled.
-  
-  (while (< (point) (point-max))
-    (let ((refill-blank-lines "^[ \t\n]*$")
-          (case-fold-search nil))       ; Don't confuse @TeX and @tex....
-      (beginning-of-line)
-      ;; 1. Skip over blank lines;
-      ;;    skip over lines beginning with @-commands, 
-      ;;    but do not skip over lines
-      ;;      that are no-refill environments such as @example or
-      ;;      that begin with within-paragraph @-commands such as @code.
-      (while (and (looking-at (concat "^@\\|^\\\\\\|" refill-blank-lines))
-                  (not (looking-at 
-                        (concat
-                         "\\(" 
-                         texinfo-no-refill-regexp
-                         "\\|" 
-                         texinfo-part-of-para-regexp
-                         "\\)")))
-                  (< (point) (point-max)))
-        (forward-line 1))
-      ;; 2. Skip over @example and similar no-refill environments.
-      (if (looking-at texinfo-no-refill-regexp)
-          (let ((environment
-                 (buffer-substring (match-beginning 1) (match-end 1))))
-            (progn (re-search-forward (concat "^@end " environment) nil t)
-                   (forward-line 1)))
-        ;; 3. Do not refill a paragraph containing @w or @*
-        (if  (or
-              (>= (point) (point-max))
-              (re-search-forward
-               "@w{\\|@\\*" (save-excursion (forward-paragraph) (point)) t))
-            ;; Go to end of paragraph and do nothing.
-            (forward-paragraph) 
-          ;; 4. Else go to end of paragraph and insert @refill
-          (forward-paragraph)
-          (forward-line -1)
-          (end-of-line)
-          (delete-region
-           (point)
-           (save-excursion (skip-chars-backward " \t") (point)))
-          ;; `looking-at-backward' not available in v. 18.57
-          ;; (if (not (looking-at-backward "@refill\\|@bye")) ;)
-          (if (not (re-search-backward
-                    "@refill\\|@bye"
-                    (save-excursion (beginning-of-line) (point))
-                    t))
-              (insert "@refill"))
-          (forward-line 1))))))
-
-
-;;; Handle `@raisesections' and `@lowersections' commands
-
-;; These commands change the hierarchical level of chapter structuring
-;; commands. 
-;;    
-;; @raisesections changes @subsection to @section,
-;;                        @section    to @chapter,
-;;                        etc.
-;;
-;; @lowersections changes @chapter    to @section
-;;                        @subsection to @subsubsection,
-;;                        etc.
-;;
-;; An @raisesections/@lowersections command changes only those
-;; structuring commands that follow the @raisesections/@lowersections
-;; command.
-;;
-;; Repeated @raisesections/@lowersections continue to raise or lower
-;; the heading level.
-;; 
-;; An @lowersections command cancels an @raisesections command, and
-;; vice versa.
-;;
-;; You cannot raise or lower "beyond" chapters or subsubsections, but
-;; trying to do so does not elicit an error---you just get more
-;; headings that mean the same thing as you keep raising or lowering
-;; (for example, after a single @raisesections, both @chapter and
-;; @section produce chapter headings).
-
-(defun texinfo-raise-lower-sections ()
-  "Raise or lower the hierarchical level of chapters, sections, etc. 
-
-This function acts according to `@raisesections' and `@lowersections'
-commands in the Texinfo file.
-
-For example, an `@lowersections' command is useful if you wish to
-include what is written as an outer or standalone Texinfo file in
-another Texinfo file as an inner, included file.  The `@lowersections'
-command changes chapters to sections, sections to subsections and so
-on.
-
-@raisesections changes @subsection to @section,
-                       @section    to @chapter,
-                       @heading    to @chapheading,
-                       etc.
-
-@lowersections changes @chapter    to @section,
-                       @subsection to @subsubsection,
-                       @heading    to @subheading,
-                       etc.
-
-An `@raisesections' or `@lowersections' command changes only those
-structuring commands that follow the `@raisesections' or
-`@lowersections' command.
-
-An `@lowersections' command cancels an `@raisesections' command, and
-vice versa.
-
-Repeated use of the commands continue to raise or lower the hierarchical
-level a step at a time.
-
-An attempt to raise above `chapters' reproduces chapter commands; an
-attempt to lower below subsubsections reproduces subsubsection
-commands."
-  
-  ;; `texinfo-section-types-regexp' is defined in `texnfo-upd.el';
-  ;; it is a regexp matching chapter, section, other headings
-  ;; (but not the top node).
-
-  (let (type (level 0))
-    (while 
-        (re-search-forward
-         (concat
-          "\\(\\(^@\\(raise\\|lower\\)sections\\)\\|\\("
-          texinfo-section-types-regexp
-          "\\)\\)")
-         nil t)
-      (beginning-of-line)
-      (save-excursion (setq type (read (current-buffer))))
-      (cond 
-       
-       ;; 1. Increment level
-       ((eq type '@raisesections)
-        (setq level (1+ level))
-        (delete-region
-         (point) (save-excursion (forward-line 1) (point))))
-       
-       ;; 2. Decrement level
-       ((eq type '@lowersections)
-        (setq level (1- level))
-        (delete-region
-         (point) (save-excursion (forward-line 1) (point))))
-       
-       ;; Now handle structuring commands
-       ((cond
-         
-         ;; 3. Raise level when positive
-         ((> level 0)
-          (let ((count level)
-                (new-level type))
-            (while (> count 0)
-              (setq new-level
-                    (cdr (assq new-level texinfo-raisesections-alist)))
-              (setq count (1- count)))
-            (kill-word 1)
-            (insert (symbol-name new-level))))
-         
-         ;; 4. Do nothing except move point when level is zero
-         ((= level 0) (forward-line 1))
-         
-         ;; 5. Lower level when positive
-         ((< level 0)
-          (let ((count level)
-                (new-level type))
-            (while (< count 0)
-              (setq new-level
-                    (cdr (assq new-level texinfo-lowersections-alist)))
-              (setq count (1+ count)))
-            (kill-word 1)
-            (insert (symbol-name new-level))))))))))
-
-(defvar texinfo-raisesections-alist
-  '((@chapter . @chapter)             ; Cannot go higher
-    (@unnumbered . @unnumbered)
-
-    (@majorheading . @majorheading)
-    (@chapheading . @chapheading)
-    (@appendix . @appendix)
-    
-    (@section . @chapter)
-    (@unnumberedsec . @unnumbered)
-    (@heading . @chapheading)
-    (@appendixsec . @appendix)
-    
-    (@subsection . @section)
-    (@unnumberedsubsec . @unnumberedsec)
-    (@subheading . @heading)
-    (@appendixsubsec . @appendixsec)
-    
-    (@subsubsection . @subsection)
-    (@unnumberedsubsubsec . @unnumberedsubsec)
-    (@subsubheading . @subheading)
-    (@appendixsubsubsec . @appendixsubsec))
-  "*An alist of next higher levels for chapters, sections. etc.
-For example, section to chapter, subsection to section.
-Used by `texinfo-raise-lower-sections'.
-The keys specify types of section; the values correspond to the next
-higher types.")
-
-(defvar texinfo-lowersections-alist
-  '((@chapter . @section)  
-    (@unnumbered . @unnumberedsec)
-    (@majorheading . @heading)
-    (@chapheading . @heading)
-    (@appendix . @appendixsec)
-    
-    (@section . @subsection)
-    (@unnumberedsec . @unnumberedsubsec)
-    (@heading . @subheading)
-    (@appendixsec . @appendixsubsec)
-    
-    (@subsection . @subsubsection)
-    (@unnumberedsubsec . @unnumberedsubsubsec)
-    (@subheading . @subsubheading)
-    (@appendixsubsec . @appendixsubsubsec)
-    
-    (@subsubsection . @subsubsection) ; Cannot go lower.
-    (@unnumberedsubsubsec . @unnumberedsubsubsec)
-    (@subsubheading . @subsubheading)
-    (@appendixsubsubsec . @appendixsubsubsec))
-  "*An alist of next lower levels for chapters, sections. etc.
-For example, chapter to section, section to subsection.
-Used by `texinfo-raise-lower-sections'.
-The keys specify types of section; the values correspond to the next
-lower types.")
-
-
-;;; Perform those texinfo-to-info conversions that apply to the whole input
-;;; uniformly.
-
-(defun texinfo-format-scan ()
-  (texinfo-format-convert (point-min) (point-max))
-  ;; Scan for @-commands.
-  (goto-char (point-min))
-  (while (search-forward "@" nil t)
-    (if (looking-at "[@{}^'` *\"?!]")
-        ;; Handle a few special @-followed-by-one-char commands.
-        (if (= (following-char) ?*)
-            (progn
-              ;; remove command
-              (delete-region (1- (point)) (1+ (point)))
-              ;; insert return if not at end of line;
-              ;; else line is already broken.
-              (if (not (= (following-char) ?\n))
-                  (insert ?\n)))      
-          ;; The other characters are simply quoted.  Delete the @.
-          (delete-char -1)
-          (forward-char 1))
-      ;; @ is followed by a command-word; find the end of the word.
-      (setq texinfo-command-start (1- (point)))
-      (if (= (char-syntax (following-char)) ?w)
-          (forward-word 1)
-        (forward-char 1))
-      (setq texinfo-command-end (point))
-      ;; Handle let aliasing
-      (setq texinfo-command-name
-	    (let (trial
-		  (cmdname 
-		   (buffer-substring
-		    (1+ texinfo-command-start) texinfo-command-end)))
-	      (while (setq trial (assoc cmdname texinfo-alias-list))
-		(setq cmdname (cdr trial)))
-            (intern cmdname)))
-      ;; Call the handler for this command.
-      (let ((enclosure-type
-             (assoc
-              (symbol-name texinfo-command-name)
-              texinfo-enclosure-list)))
-        (if enclosure-type
-            (progn
-              (insert
-               (car (car (cdr enclosure-type))) 
-               (texinfo-parse-arg-discard)
-               (car (cdr (car (cdr enclosure-type)))))
-              (goto-char texinfo-command-start))
-          (let ((cmd (get texinfo-command-name 'texinfo-format)))
-            (if cmd (funcall cmd) (texinfo-unsupported)))))))
-  
-  (cond (texinfo-stack
-         (goto-char (nth 2 (car texinfo-stack)))
-         (error "Unterminated @%s" (car (car texinfo-stack))))))
-
-(put 'begin 'texinfo-format 'texinfo-format-begin)
-(defun texinfo-format-begin ()
-  (texinfo-format-begin-end 'texinfo-format))
-
-(put 'end 'texinfo-format 'texinfo-format-end)
-(defun texinfo-format-end ()
-  (texinfo-format-begin-end 'texinfo-end))
-
-(defun texinfo-format-begin-end (prop)
-  (setq texinfo-command-name (intern (texinfo-parse-line-arg)))
-  (let ((cmd (get texinfo-command-name prop)))
-    (if cmd (funcall cmd)
-      (texinfo-unsupported))))
-
-;;; Parsing functions
-
-(defun texinfo-parse-line-arg ()
-  (goto-char texinfo-command-end)
-  (let ((start (point)))
-    (cond ((looking-at " ")
-           (skip-chars-forward " ")
-           (setq start (point))
-           (end-of-line)
-           (skip-chars-backward " ")
-           (delete-region (point) (progn (end-of-line) (point)))
-           (setq texinfo-command-end (1+ (point))))
-          ((looking-at "{")
-           (setq start (1+ (point)))
-           (forward-list 1)
-           (setq texinfo-command-end (point))
-           (forward-char -1))
-          (t
-           (error "Invalid texinfo command arg format")))
-    (prog1 (buffer-substring start (point))
-           (if (eolp) (forward-char 1)))))
-
-(defun texinfo-parse-expanded-arg ()
-  (goto-char texinfo-command-end)
-  (let ((start (point))
-        marker)
-    (cond ((looking-at " ")
-           (skip-chars-forward " ")
-           (setq start (point))
-           (end-of-line)
-           (setq texinfo-command-end (1+ (point))))
-          ((looking-at "{")
-           (setq start (1+ (point)))
-           (forward-list 1)
-           (setq texinfo-command-end (point))
-           (forward-char -1))
-          (t
-           (error "Invalid texinfo command arg format")))
-    (setq marker (move-marker (make-marker) texinfo-command-end))
-    (texinfo-format-expand-region start (point))
-    (setq texinfo-command-end (marker-position marker))
-    (move-marker marker nil)
-    (prog1 (buffer-substring start (point))
-           (if (eolp) (forward-char 1)))))
-
-(defun texinfo-format-expand-region (start end)
-  (save-restriction
-    (narrow-to-region start end)
-    (let (texinfo-command-start
-          texinfo-command-end
-          texinfo-command-name
-          texinfo-stack)
-      (texinfo-format-scan))
-    (goto-char (point-max))))
-
-(defun texinfo-parse-arg-discard ()
-  (prog1 (texinfo-parse-line-arg)
-         (texinfo-discard-command)))
-
-(defun texinfo-discard-command ()
-  (delete-region texinfo-command-start texinfo-command-end))
-
-(defun texinfo-optional-braces-discard ()
-  "Discard braces following command, if any."
-  (goto-char texinfo-command-end)
-  (let ((start (point)))
-    (cond ((looking-at "[ \t]*\n"))     ; do nothing
-          ((looking-at "{")             ; remove braces, if any
-           (forward-list 1)
-           (setq texinfo-command-end (point)))
-          (t
-           (error
-            "Invalid `texinfo-optional-braces-discard' format \(need braces?\)")))
-    (delete-region texinfo-command-start texinfo-command-end)))
-
-(defun texinfo-format-parse-line-args ()
-  (let ((start (1- (point)))
-        next beg end
-        args)
-    (skip-chars-forward " ")
-    (while (not (eolp))
-      (setq beg (point))
-      (re-search-forward "[\n,]")
-      (setq next (point))
-      (if (bolp) (setq next (1- next)))
-      (forward-char -1)
-      (skip-chars-backward " ")
-      (setq end (point))
-      (setq args (cons (if (> end beg) (buffer-substring beg end))
-                       args))
-      (goto-char next)
-      (skip-chars-forward " "))
-    (if (eolp) (forward-char 1))
-    (setq texinfo-command-end (point))
-    (nreverse args)))
-
-(defun texinfo-format-parse-args ()
-  (let ((start (1- (point)))
-        next beg end
-        args)
-    (search-forward "{")
-    (save-excursion
-      (texinfo-format-expand-region 
-       (point)
-       (save-excursion (up-list 1) (1- (point)))))
-    ;; The following does not handle cross references of the form:
-    ;; `@xref{bullet, , @code{@@bullet}@{@}}.' because the
-    ;; re-search-forward finds the first right brace after the second
-    ;; comma. 
-    (while (/= (preceding-char) ?\})
-      (skip-chars-forward " \t\n")
-      (setq beg (point))
-      (re-search-forward "[},]")
-      (setq next (point))
-      (forward-char -1)
-      (skip-chars-backward " \t\n")
-      (setq end (point))
-      (cond ((< beg end)
-             (goto-char beg)
-             (while (search-forward "\n" end t)
-               (replace-match " "))))
-      (setq args (cons (if (> end beg) (buffer-substring beg end))
-                       args))
-      (goto-char next))
-    (if (eolp) (forward-char 1))
-    (setq texinfo-command-end (point))
-    (nreverse args)))
-
-(defun texinfo-format-parse-defun-args ()
-  (goto-char texinfo-command-end)
-  (let ((start (point)))
-    (end-of-line)
-    (setq texinfo-command-end (1+ (point)))
-    (let ((marker (move-marker (make-marker) texinfo-command-end)))
-      (texinfo-format-expand-region start (point))
-      (setq texinfo-command-end (marker-position marker))
-      (move-marker marker nil))
-    (goto-char start)
-    (let ((args '())
-          beg end)
-      (skip-chars-forward " ")
-      (while (not (eolp))
-        (cond ((looking-at "{")
-               (setq beg (1+ (point)))
-               (forward-list 1)
-               (setq end (1- (point))))
-              (t
-               (setq beg (point))
-               (re-search-forward "[\n ]")
-               (forward-char -1)
-               (setq end (point))))
-        (setq args (cons (buffer-substring beg end) args))
-        (skip-chars-forward " "))
-      (forward-char 1)
-      (nreverse args))))
-
-(defun texinfo-discard-line ()
-  (goto-char texinfo-command-end)
-  (skip-chars-forward " \t")
-  (or (eolp)
-      (error "Extraneous text at end of command line."))
-  (goto-char texinfo-command-start)
-  (or (bolp)
-      (error "Extraneous text at beginning of command line."))
-  (delete-region (point) (progn (forward-line 1) (point))))
-
-(defun texinfo-discard-line-with-args ()
-  (goto-char texinfo-command-start)
-  (delete-region (point) (progn (forward-line 1) (point))))
-
-
-;;; @setfilename
-
-;; Only `texinfo-format-buffer' handles @setfilename with this
-;; definition; `texinfo-format-region' handles @setfilename, if any,
-;; specially. 
-(put 'setfilename 'texinfo-format 'texinfo-format-setfilename)
-(defun texinfo-format-setfilename ()
-  (let ((arg (texinfo-parse-arg-discard)))
-    (message "Formatting Info file: %s" arg)
-    (setq texinfo-format-filename
-          (file-name-nondirectory (expand-file-name arg)))
-    (insert "Info file: "
-            texinfo-format-filename ",    -*-Text-*-\n"
-            "produced by `texinfo-format-buffer'\n"
-            "from file"
-            (if (buffer-file-name input-buffer)
-                (concat " `"
-                        (file-name-sans-versions
-                         (file-name-nondirectory
-                          (buffer-file-name input-buffer)))
-                        "'")
-              (concat "buffer `" (buffer-name input-buffer) "'"))
-            "\nusing `texinfmt.el' version "
-            texinfmt-version
-            ".\n\n")))
-
-;;; @node, @menu
-
-(put 'node 'texinfo-format 'texinfo-format-node)
-(put 'nwnode 'texinfo-format 'texinfo-format-node)
-(defun texinfo-format-node ()
-  (let* ((args (texinfo-format-parse-line-args))
-         (name (nth 0 args))
-         (next (nth 1 args))
-         (prev (nth 2 args))
-         (up (nth 3 args)))
-    (texinfo-discard-command)
-    (setq texinfo-last-node name)
-    (let ((tem (downcase name)))
-      (if (assoc tem texinfo-node-names)
-          (error "Duplicate node name: %s" name)
-        (setq texinfo-node-names (cons (list tem) texinfo-node-names))))
-    (setq texinfo-footnote-number 0)
-    ;; insert "\n\^_" unconditionally since this is what info is looking for
-    (insert "\n\^_\nFile: " texinfo-format-filename
-            ", Node: " name)
-    (if next
-        (insert ", Next: " next))
-    (if prev
-        (insert ", Prev: " prev))
-    (if up
-        (insert ", Up: " up))
-    (insert ?\n)
-    (setq texinfo-last-node-pos (point))))
-
-(put 'menu 'texinfo-format 'texinfo-format-menu)
-(defun texinfo-format-menu ()
-  (texinfo-discard-line)
-  (insert "* Menu:\n\n"))
-
-(put 'menu 'texinfo-end 'texinfo-discard-command)
-
-
-;;; Cross references
-
-; @xref {NODE, FNAME, NAME, FILE, DOCUMENT}
-; -> *Note FNAME: (FILE)NODE
-;   If FILE is missing,
-;    *Note FNAME: NODE
-;   If FNAME is empty and NAME is present
-;    *Note NAME: Node
-;   If both NAME and FNAME are missing
-;    *Note NODE::
-;   texinfo ignores the DOCUMENT argument.
-; -> See section <xref to NODE> [NAME, else NODE], page <xref to NODE>
-;   If FILE is specified, (FILE)NODE is used for xrefs.
-;   If fifth argument DOCUMENT is specified, produces
-;    See section <xref to NODE> [NAME, else NODE], page <xref to NODE>
-;    of DOCUMENT
-
-; @ref             a reference that does not put `See' or `see' in
-;                  the hardcopy and is the same as @xref in Info
-(put 'ref 'texinfo-format 'texinfo-format-xref)
-
-(put 'xref 'texinfo-format 'texinfo-format-xref)
-(defun texinfo-format-xref ()
-  (let ((args (texinfo-format-parse-args)))
-    (texinfo-discard-command)
-    (insert "*Note ")
-    (let ((fname (or (nth 1 args) (nth 2 args))))
-      (if (null (or fname (nth 3 args)))
-          (insert (car args) "::")
-        (insert (or fname (car args)) ": ")
-        (if (nth 3 args)
-            (insert "(" (nth 3 args) ")"))
-        (insert (car args))))))
-
-(put 'pxref 'texinfo-format 'texinfo-format-pxref)
-(defun texinfo-format-pxref ()
-  (texinfo-format-xref)
-  (or (save-excursion
-        (forward-char -2)
-        (looking-at "::"))
-      (insert ".")))
-
-;@inforef{NODE, FNAME, FILE}
-;Like @xref{NODE, FNAME,,FILE} in texinfo.
-;In Tex, generates "See Info file FILE, node NODE"
-(put 'inforef 'texinfo-format 'texinfo-format-inforef)
-(defun texinfo-format-inforef ()
-  (let ((args (texinfo-format-parse-args)))
-    (texinfo-discard-command)
-    (if (nth 1 args)
-        (insert "*Note " (nth 1 args) ": (" (nth 2 args) ")" (car args))
-      (insert "*Note " "(" (nth 2 args) ")" (car args) "::"))))
-
-
-;;; Section headings
-
-(put 'majorheading 'texinfo-format 'texinfo-format-chapter)
-(put 'chapheading 'texinfo-format 'texinfo-format-chapter)
-(put 'ichapter 'texinfo-format 'texinfo-format-chapter)
-(put 'chapter 'texinfo-format 'texinfo-format-chapter)
-(put 'iappendix 'texinfo-format 'texinfo-format-chapter)
-(put 'appendix 'texinfo-format 'texinfo-format-chapter)
-(put 'iunnumbered 'texinfo-format 'texinfo-format-chapter)
-(put 'top 'texinfo-format 'texinfo-format-chapter)
-(put 'unnumbered 'texinfo-format 'texinfo-format-chapter)
-(defun texinfo-format-chapter ()
-  (texinfo-format-chapter-1 ?*))
-
-(put 'heading 'texinfo-format 'texinfo-format-section)
-(put 'isection 'texinfo-format 'texinfo-format-section)
-(put 'section 'texinfo-format 'texinfo-format-section)
-(put 'iappendixsection 'texinfo-format 'texinfo-format-section)
-(put 'appendixsection 'texinfo-format 'texinfo-format-section)
-(put 'iappendixsec 'texinfo-format 'texinfo-format-section)
-(put 'appendixsec 'texinfo-format 'texinfo-format-section)
-(put 'iunnumberedsec 'texinfo-format 'texinfo-format-section)
-(put 'unnumberedsec 'texinfo-format 'texinfo-format-section)
-(defun texinfo-format-section ()
-  (texinfo-format-chapter-1 ?=))
-
-(put 'subheading 'texinfo-format 'texinfo-format-subsection)
-(put 'isubsection 'texinfo-format 'texinfo-format-subsection)
-(put 'subsection 'texinfo-format 'texinfo-format-subsection)
-(put 'iappendixsubsec 'texinfo-format 'texinfo-format-subsection)
-(put 'appendixsubsec 'texinfo-format 'texinfo-format-subsection)
-(put 'iunnumberedsubsec 'texinfo-format 'texinfo-format-subsection)
-(put 'unnumberedsubsec 'texinfo-format 'texinfo-format-subsection)
-(defun texinfo-format-subsection ()
-  (texinfo-format-chapter-1 ?-))
-
-(put 'subsubheading 'texinfo-format 'texinfo-format-subsubsection)
-(put 'isubsubsection 'texinfo-format 'texinfo-format-subsubsection)
-(put 'subsubsection 'texinfo-format 'texinfo-format-subsubsection)
-(put 'iappendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
-(put 'appendixsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
-(put 'iunnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
-(put 'unnumberedsubsubsec 'texinfo-format 'texinfo-format-subsubsection)
-(defun texinfo-format-subsubsection ()
-  (texinfo-format-chapter-1 ?.))
-
-(defun texinfo-format-chapter-1 (belowchar)
-  (let ((arg (texinfo-parse-arg-discard)))
-    (message "Formatting: %s ... " arg)   ; So we can see where we are.
-    (insert ?\n arg ?\n "@SectionPAD " belowchar ?\n)
-    (forward-line -2)))
-
-(put 'SectionPAD 'texinfo-format 'texinfo-format-sectionpad)
-(defun texinfo-format-sectionpad ()
-  (let ((str (texinfo-parse-arg-discard)))
-    (forward-char -1)
-    (let ((column (current-column)))
-      (forward-char 1)
-      (while (> column 0)
-        (insert str)
-        (setq column (1- column))))
-    (insert ?\n)))
-
-
-;;; Space controlling commands:  @. and @:, and the soft hyphen.
-
-(put '\. 'texinfo-format 'texinfo-format-\.)
-(defun texinfo-format-\. ()
-  (texinfo-discard-command)
-  (insert "."))
-
-(put '\: 'texinfo-format 'texinfo-format-\:)
-(defun texinfo-format-\: ()
-  (texinfo-discard-command))
-
-(put '\- 'texinfo-format 'texinfo-format-soft-hyphen)
-(defun texinfo-format-soft-hyphen ()
-  (texinfo-discard-command))
-
-
-;;; @center, @sp, and @br
-
-(put 'center 'texinfo-format 'texinfo-format-center)
-(defun texinfo-format-center ()
-  (let ((arg (texinfo-parse-expanded-arg)))
-    (texinfo-discard-command)
-    (insert arg)
-    (insert ?\n)
-    (save-restriction
-      (goto-char (1- (point)))
-      (let ((indent-tabs-mode nil))
-        (center-line)))))
-
-(put 'sp 'texinfo-format 'texinfo-format-sp)
-(defun texinfo-format-sp ()
-  (let* ((arg (texinfo-parse-arg-discard))
-         (num (read arg)))
-    (insert-char ?\n num)))
-
-(put 'br 'texinfo-format 'texinfo-format-paragraph-break)
-(defun texinfo-format-paragraph-break ()
-  "Force a paragraph break.
-If used within a line, follow `@br' with braces."
-  (texinfo-optional-braces-discard)
-  ;; insert one return if at end of line;
-  ;; else insert two returns, to generate a blank line.
-  (if (= (following-char) ?\n)
-      (insert ?\n)
-    (insert-char ?\n 2)))
-
-
-;;; @footnote  and  @footnotestyle
-
-; In Texinfo, footnotes are created with the `@footnote' command.
-; This command is followed immediately by a left brace, then by the text of
-; the footnote, and then by a terminating right brace.  The
-; template for a footnote is:
-; 
-;      @footnote{TEXT}
-;
-; Info has two footnote styles:
-; 
-;    * In the End of node style, all the footnotes for a single node
-;      are placed at the end of that node.  The footnotes are
-;      separated from the rest of the node by a line of dashes with
-;      the word `Footnotes' within it.
-; 
-;    * In the Separate node style, all the footnotes for a single node
-;      are placed in an automatically constructed node of their own.
-
-; Footnote style is specified by the @footnotestyle command, either
-;    @footnotestyle separate
-; or
-;    @footnotestyle end
-; 
-; The default is  separate
-
-(defvar texinfo-footnote-style "separate" 
-  "Footnote style, either separate or end.")
-
-(put 'footnotestyle 'texinfo-format 'texinfo-footnotestyle)
-(defun texinfo-footnotestyle ()
-  "Specify whether footnotes are at end of node or in separate nodes.
-Argument is either end or separate."
-  (setq texinfo-footnote-style (texinfo-parse-arg-discard)))
-
-(defvar texinfo-footnote-number)
-
-(put 'footnote 'texinfo-format 'texinfo-format-footnote)
-(defun texinfo-format-footnote ()
-  "Format a footnote in either end of node or separate node style.
-The   texinfo-footnote-style  variable controls which style is used."
-  (setq texinfo-footnote-number (1+ texinfo-footnote-number))
-  (cond ((string= texinfo-footnote-style "end")
-         (texinfo-format-end-node))
-        ((string= texinfo-footnote-style "separate")
-         (texinfo-format-separate-node))))
-
-(defun texinfo-format-separate-node ()
-  "Format footnote in Separate node style, with notes in own node.
-The node is constructed automatically."
-  (let* (start
-         (arg (texinfo-parse-line-arg))
-         (node-name-beginning
-          (save-excursion
-            (re-search-backward
-             "^File: \\w+\\(\\w\\|\\s_\\|\\.\\|,\\)*[ \t]+Node:")
-            (match-end 0)))
-         (node-name
-          (save-excursion
-            (buffer-substring
-             (progn (goto-char node-name-beginning) ; skip over node command
-                    (skip-chars-forward " \t")  ; and over spaces
-                    (point))
-             (if (search-forward
-                  ","
-                  (save-excursion (end-of-line) (point)) t) ; bound search
-                 (1- (point))
-               (end-of-line) (point))))))
-    (texinfo-discard-command)  ; remove or insert whitespace, as needed
-    (delete-region (save-excursion (skip-chars-backward " \t\n") (point))
-                   (point))
-    (insert (format " (%d) (*Note %s-Footnotes::)"
-                    texinfo-footnote-number node-name))
-    (fill-paragraph nil)
-    (save-excursion
-    (if (re-search-forward "^@node" nil 'move)
-        (forward-line -1))
-
-    ;; two cases: for the first footnote, we must insert a node header;
-    ;; for the second and subsequent footnotes, we need only insert 
-    ;; the text of the  footnote.
-
-    (if (save-excursion
-         (re-search-backward
-          (concat node-name "-Footnotes, Up: ")
-          node-name-beginning
-          t))
-        (progn   ; already at least one footnote
-          (setq start (point))
-          (insert (format "\n(%d)  %s\n" texinfo-footnote-number arg))
-          (fill-region start (point)))
-      ;; else not yet a footnote
-      (insert "\n\^_\nFile: "  texinfo-format-filename
-              "  Node: " node-name "-Footnotes, Up: " node-name "\n")
-      (setq start (point))
-      (insert (format "\n(%d)  %s\n" texinfo-footnote-number arg))
-      (fill-region start (point))))))
-
-(defun texinfo-format-end-node ()
-  "Format footnote in the End of node style, with notes at end of node."
-  (let (start
-        (arg (texinfo-parse-line-arg)))
-    (texinfo-discard-command)  ; remove or insert whitespace, as needed
-    (delete-region (save-excursion (skip-chars-backward " \t\n") (point))
-                   (point))
-    (insert (format " (%d) " texinfo-footnote-number))
-    (fill-paragraph nil)
-    (save-excursion
-      (if (search-forward "\n--------- Footnotes ---------\n" nil t)
-          (progn ; already have footnote, put new one before end of node
-            (if (re-search-forward "^@node" nil 'move)
-                (forward-line -1))
-            (setq start (point))
-            (insert (format "\n(%d)  %s\n" texinfo-footnote-number arg))
-            (fill-region start (point)))
-        ;; else no prior footnote
-        (if (re-search-forward "^@node" nil 'move)
-            (forward-line -1))
-        (insert "\n--------- Footnotes ---------\n")
-        (setq start (point))
-        (insert (format "\n(%d)  %s\n" texinfo-footnote-number arg))))))
-
-
-;;; @itemize, @enumerate, and similar commands
-
-;; @itemize pushes (itemize "COMMANDS" STARTPOS) on texinfo-stack.
-;; @enumerate pushes (enumerate 0 STARTPOS).
-;; @item dispatches to the texinfo-item prop of the first elt of the list.
-;; For itemize, this puts in and rescans the COMMANDS.
-;; For enumerate, this increments the number and puts it in.
-;; In either case, it puts a Backspace at the front of the line
-;; which marks it not to be indented later.
-;; All other lines get indented by 5 when the @end is reached.
-
-(defvar texinfo-stack-depth 0
-  "Count of number of unpopped texinfo-push-stack calls.
-Used by @refill indenting command to avoid indenting within lists, etc.")
-
-(defun texinfo-push-stack (check arg)
-  (setq texinfo-stack-depth (1+ texinfo-stack-depth))
-  (setq texinfo-stack
-        (cons (list check arg texinfo-command-start)
-              texinfo-stack)))
-
-(defun texinfo-pop-stack (check)
-  (setq texinfo-stack-depth (1- texinfo-stack-depth))
-  (if (null texinfo-stack)
-      (error "Unmatched @end %s" check))
-  (if (not (eq (car (car texinfo-stack)) check))
-      (error "@end %s matches @%s"
-             check (car (car texinfo-stack))))
-  (prog1 (cdr (car texinfo-stack))
-         (setq texinfo-stack (cdr texinfo-stack))))
-
-(put 'itemize 'texinfo-format 'texinfo-itemize)
-(defun texinfo-itemize ()
-  (texinfo-push-stack
-   'itemize
-   (progn (skip-chars-forward " \t")
-          (if (eolp)
-              "@bullet"
-            (texinfo-parse-line-arg))))
-  (texinfo-discard-line-with-args)
-  (setq fill-column (- fill-column 5)))
-
-(put 'itemize 'texinfo-end 'texinfo-end-itemize)
-(defun texinfo-end-itemize ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'itemize)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-(put 'enumerate 'texinfo-format 'texinfo-enumerate)
-(defun texinfo-enumerate ()
-  (texinfo-push-stack
-   'enumerate 
-   (progn (skip-chars-forward " \t")
-          (if (eolp)
-              1
-            (read (current-buffer)))))
-  (if (and (symbolp (car (cdr (car texinfo-stack))))
-           (> 1 (length (symbol-name (car (cdr (car texinfo-stack)))))))
-      (error
-       "@enumerate: Use a number or letter, eg: 1, A, a, 3, B, or d." ))
-  (texinfo-discard-line-with-args)
-  (setq fill-column (- fill-column 5)))
-
-(put 'enumerate 'texinfo-end 'texinfo-end-enumerate)
-(defun texinfo-end-enumerate ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'enumerate)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-;; @alphaenumerate never became a standard part of Texinfo
-(put 'alphaenumerate 'texinfo-format 'texinfo-alphaenumerate)
-(defun texinfo-alphaenumerate ()
-  (texinfo-push-stack 'alphaenumerate (1- ?a))
-  (setq fill-column (- fill-column 5))
-  (texinfo-discard-line))
-
-(put 'alphaenumerate 'texinfo-end 'texinfo-end-alphaenumerate)
-(defun texinfo-end-alphaenumerate ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'alphaenumerate)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-;; @capsenumerate never became a standard part of Texinfo
-(put 'capsenumerate 'texinfo-format 'texinfo-capsenumerate)
-(defun texinfo-capsenumerate ()
-  (texinfo-push-stack 'capsenumerate (1- ?A))
-  (setq fill-column (- fill-column 5))
-  (texinfo-discard-line))
-
-(put 'capsenumerate 'texinfo-end 'texinfo-end-capsenumerate)
-(defun texinfo-end-capsenumerate ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'capsenumerate)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-;; At the @end, indent all the lines within the construct
-;; except those marked with backspace.  FROM says where
-;; construct started.
-(defun texinfo-do-itemize (from)
-  (save-excursion
-   (while (progn (forward-line -1)
-                 (>= (point) from))
-     (if (= (following-char) ?\b)
-         (save-excursion
-           (delete-char 1)
-           (end-of-line)
-           (delete-char 6))
-       (if (not (looking-at "[ \t]*$"))
-           (save-excursion (insert "     ")))))))
-
-(put 'item 'texinfo-format 'texinfo-item)
-(put 'itemx 'texinfo-format 'texinfo-item)
-(defun texinfo-item ()
-  (funcall (get (car (car texinfo-stack)) 'texinfo-item)))
-
-(put 'itemize 'texinfo-item 'texinfo-itemize-item)
-(defun texinfo-itemize-item ()
-  ;; (texinfo-discard-line)   ; Did not handle text on same line as @item.
-  (delete-region (1+ (point)) (save-excursion (beginning-of-line) (point)))
-  (if (looking-at "[ \t]*[^ \t\n]+")
-      ;; Text on same line as @item command.
-      (insert "\b   " (nth 1 (car texinfo-stack)) " \n")
-    ;; Else text on next line.
-    (insert "\b   " (nth 1 (car texinfo-stack)) " "))
-  (forward-line -1))
-
-(put 'enumerate 'texinfo-item 'texinfo-enumerate-item)
-(defun texinfo-enumerate-item ()
-  (texinfo-discard-line)
-  (let (enumerating-symbol)
-    (cond ((integerp (car (cdr (car texinfo-stack))))
-           (setq enumerating-symbol (car (cdr (car texinfo-stack))))
-           (insert ?\b (format "%3d. " enumerating-symbol) ?\n)
-           (setcar (cdr (car texinfo-stack)) (1+ enumerating-symbol)))
-          ((symbolp (car (cdr (car texinfo-stack))))
-           (setq enumerating-symbol
-                 (symbol-name (car (cdr (car texinfo-stack)))))
-           (if (or (equal ?\[ (string-to-char enumerating-symbol))
-                   (equal ?\{ (string-to-char enumerating-symbol)))
-               (error
-                "Too many items in enumerated list; alphabet ends at Z."))
-           (insert ?\b (format "%3s. " enumerating-symbol) ?\n)
-           (setcar (cdr (car texinfo-stack))
-                   (make-symbol
-                    (char-to-string
-                     (1+ 
-                      (string-to-char enumerating-symbol))))))
-          (t
-          (error
-           "@enumerate: Use a number or letter, eg: 1, A, a, 3, B or d." )))
-    (forward-line -1)))
-
-(put 'alphaenumerate 'texinfo-item 'texinfo-alphaenumerate-item)
-(defun texinfo-alphaenumerate-item ()
-  (texinfo-discard-line)
-  (let ((next (1+ (car (cdr (car texinfo-stack))))))
-    (if (> next ?z)
-        (error "More than 26 items in @alphaenumerate; get a bigger alphabet."))
-    (setcar (cdr (car texinfo-stack)) next)
-    (insert "\b  " next ". \n"))
-  (forward-line -1))
-
-(put 'capsenumerate 'texinfo-item 'texinfo-capsenumerate-item)
-(defun texinfo-capsenumerate-item ()
-  (texinfo-discard-line)
-  (let ((next (1+ (car (cdr (car texinfo-stack))))))
-    (if (> next ?Z)
-        (error "More than 26 items in @capsenumerate; get a bigger alphabet."))
-    (setcar (cdr (car texinfo-stack)) next)
-    (insert "\b  " next ". \n"))
-  (forward-line -1))
-
-
-;;; @table
-
-; The `@table' command produces two-column tables.
-
-(put 'table 'texinfo-format 'texinfo-table)
-(defun texinfo-table ()
-  (texinfo-push-stack 
-   'table 
-   (progn (skip-chars-forward " \t")
-          (if (eolp)
-              "@asis"
-            (texinfo-parse-line-arg))))
-  (texinfo-discard-line-with-args)
-  (setq fill-column (- fill-column 5)))
-
-(put 'table 'texinfo-item 'texinfo-table-item)
-(defun texinfo-table-item ()
-  (let ((arg (texinfo-parse-arg-discard))
-        (itemfont (car (cdr (car texinfo-stack)))))
-    (insert ?\b itemfont ?\{ arg "}\n     \n"))
-  (forward-line -2))
-
-(put 'table 'texinfo-end 'texinfo-end-table)
-(defun texinfo-end-table ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'table)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-;; @description appears to be an undocumented variant on @table that
-;; does not require an arg.  It fails in texinfo.tex 2.58 and is not
-;; part of makeinfo.c   The command appears to be a relic of the past.
-(put 'description 'texinfo-end 'texinfo-end-table)
-(put 'description 'texinfo-format 'texinfo-description)
-(defun texinfo-description ()
-  (texinfo-push-stack 'table "@asis")
-  (setq fill-column (- fill-column 5))
-  (texinfo-discard-line))
-
-
-;;; @ftable, @vtable
-
-; The `@ftable' and `@vtable' commands are like the `@table' command
-; but they also insert each entry in the first column of the table
-; into the function or variable index.
-
-;; Handle the @ftable and @vtable commands:
-
-(put 'ftable 'texinfo-format 'texinfo-ftable)
-(put 'vtable 'texinfo-format 'texinfo-vtable)
-
-(defun texinfo-ftable () (texinfo-indextable 'ftable))
-(defun texinfo-vtable () (texinfo-indextable 'vtable))
-
-(defun texinfo-indextable (table-type)
-  (texinfo-push-stack table-type (texinfo-parse-arg-discard))
-  (setq fill-column (- fill-column 5)))
-
-;; Handle the @item commands within ftable and vtable:
-
-(put 'ftable 'texinfo-item 'texinfo-ftable-item)
-(put 'vtable 'texinfo-item 'texinfo-vtable-item)
-
-(defun texinfo-ftable-item () (texinfo-indextable-item 'texinfo-findex))
-(defun texinfo-vtable-item () (texinfo-indextable-item 'texinfo-vindex))
-
-(defun texinfo-indextable-item (index-type)
-  (let ((item (texinfo-parse-arg-discard))
-        (itemfont (car (cdr (car texinfo-stack))))
-        (indexvar index-type))
-    (insert ?\b itemfont ?\{ item "}\n     \n")
-    (set indexvar
-         (cons
-          (list item texinfo-last-node)
-          (symbol-value indexvar)))
-    (forward-line -2)))
-
-;; Handle @end ftable, @end vtable
-
-(put 'ftable 'texinfo-end 'texinfo-end-ftable)
-(put 'vtable 'texinfo-end 'texinfo-end-vtable)
-
-(defun texinfo-end-ftable () (texinfo-end-indextable 'ftable))
-(defun texinfo-end-vtable () (texinfo-end-indextable 'vtable))
-
-(defun texinfo-end-indextable (table-type)
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack table-type)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-
-;;; @ifinfo,  @iftex, @tex, @ifhtml, @html
-
-(put 'ifinfo 'texinfo-format 'texinfo-discard-line)
-(put 'ifinfo 'texinfo-end 'texinfo-discard-command)
-
-(put 'iftex 'texinfo-format 'texinfo-format-iftex)
-(defun texinfo-format-iftex ()
-  (delete-region texinfo-command-start
-                 (progn (re-search-forward "@end iftex[ \t]*\n")
-                        (point))))
-
-(put 'ifhtml 'texinfo-format 'texinfo-format-ifhtml)
-(defun texinfo-format-ifhtml ()
-  (delete-region texinfo-command-start
-                 (progn (re-search-forward "@end ifhtml[ \t]*\n")
-                        (point))))
-
-(put 'tex 'texinfo-format 'texinfo-format-tex)
-(defun texinfo-format-tex ()
-  (delete-region texinfo-command-start
-                 (progn (re-search-forward "@end tex[ \t]*\n")
-                        (point))))
-
-(put 'html 'texinfo-format 'texinfo-format-html)
-(defun texinfo-format-html ()
-  (delete-region texinfo-command-start
-                 (progn (re-search-forward "@end html[ \t]*\n")
-                        (point))))
-
-
-;;; @titlepage
-
-(put 'titlepage 'texinfo-format 'texinfo-format-titlepage)
-(defun texinfo-format-titlepage ()
-  (delete-region texinfo-command-start
-                 (progn (re-search-forward "@end titlepage[ \t]*\n")
-                        (point))))
-
-(put 'endtitlepage 'texinfo-format 'texinfo-discard-line)
-
-; @titlespec         an alternative titling command; ignored by Info
-
-(put 'titlespec 'texinfo-format 'texinfo-format-titlespec)
-(defun texinfo-format-titlespec ()
-  (delete-region texinfo-command-start
-                 (progn (re-search-forward "@end titlespec[ \t]*\n")
-                        (point))))
-
-(put 'endtitlespec 'texinfo-format 'texinfo-discard-line)
-
-
-;;; @today
-
-(put 'today 'texinfo-format 'texinfo-format-today)
-
-; Produces Day Month Year style of output.  eg `1 Jan 1900'
-; The `@today{}' command requires a pair of braces, like `@dots{}'.
-(defun texinfo-format-today ()
-  (texinfo-parse-arg-discard)
-  (insert (format-time-string "%e %b %Y")))
-
-
-;;; @ignore
-
-(put 'ignore 'texinfo-format 'texinfo-format-ignore)
-(defun texinfo-format-ignore ()
-  (delete-region texinfo-command-start
-                 (progn (re-search-forward "@end ignore[ \t]*\n")
-                        (point))))
-
-(put 'endignore 'texinfo-format 'texinfo-discard-line)
-
-
-;;; Define the Info enclosure command: @definfoenclose
-
-; A `@definfoenclose' command may be used to define a highlighting
-; command for Info, but not for TeX.  A command defined using
-; `@definfoenclose' marks text by enclosing it in strings that precede
-; and follow the text.
-; 
-; Presumably, if you define a command with `@definfoenclose` for Info,
-; you will also define the same command in the TeX definitions file,
-; `texinfo.tex' in a manner appropriate for typesetting.
-; 
-; Write a `@definfoenclose' command on a line and follow it with three
-; arguments separated by commas (commas are used as separators in an
-; `@node' line in the same way).  The first argument to
-; `@definfoenclose' is the @-command name \(without the `@'\); the
-; second argument is the Info start delimiter string; and the third
-; argument is the Info end delimiter string.  The latter two arguments
-; enclose the highlighted text in the Info file.  A delimiter string
-; may contain spaces.  Neither the start nor end delimiter is
-; required.  However, if you do not provide a start delimiter, you
-; must follow the command name with two commas in a row; otherwise,
-; the Info formatting commands will misinterpret the end delimiter
-; string as a start delimiter string.
-;
-; If you do a @definfoenclose{} on the name of a pre-defined macro (such
-; as @emph{}, @strong{}, @tt{}, or @i{}) the enclosure definition will
-; override the built-in definition.
-; 
-; An enclosure command defined this way takes one argument in braces.
-;
-; For example, you can write:
-;
-;     @ifinfo
-;     @definfoenclose phoo, //, \\
-;     @end ifinfo
-;
-; near the beginning of a Texinfo file at the beginning of the lines
-; to define `@phoo' as an Info formatting command that inserts `//'
-; before and `\\' after the argument to `@phoo'.  You can then write
-; `@phoo{bar}' wherever you want `//bar\\' highlighted in Info.
-;
-; Also, for TeX formatting, you could write 
-;
-;     @iftex
-;     @global@let@phoo=@i
-;     @end iftex
-;
-; to define `@phoo' as a command that causes TeX to typeset
-; the argument to `@phoo' in italics.
-;
-; Note that each definition applies to its own formatter: one for TeX,
-; the other for texinfo-format-buffer or texinfo-format-region.
-;
-; Here is another example: write
-;
-;     @definfoenclose headword, , :
-;
-; near the beginning of the file, to define `@headword' as an Info
-; formatting command that inserts nothing before and a colon after the
-; argument to `@headword'.
-
-(put 'definfoenclose 'texinfo-format 'texinfo-define-info-enclosure)
-(defun texinfo-define-info-enclosure ()
-  (let* ((args (texinfo-format-parse-line-args))
-         (command-name (nth 0 args))
-         (beginning-delimiter (or (nth 1 args) ""))
-         (end-delimiter (or (nth 2 args) "")))
-    (texinfo-discard-command)
-    (setq texinfo-enclosure-list
-        (cons
-         (list command-name
-               (list
-                beginning-delimiter
-                end-delimiter))
-         texinfo-enclosure-list))))
-
-
-;;; @var, @code and the like
-
-(put 'var 'texinfo-format 'texinfo-format-var)
-;  @sc  a small caps font for TeX; formatted as `var' in Info
-(put 'sc 'texinfo-format 'texinfo-format-var)
-(defun texinfo-format-var ()
-  (insert (upcase (texinfo-parse-arg-discard)))
-  (goto-char texinfo-command-start))
-
-; various noops
-
-(put 'b 'texinfo-format 'texinfo-format-noop)
-(put 'i 'texinfo-format 'texinfo-format-noop)
-(put 'r 'texinfo-format 'texinfo-format-noop)
-(put 't 'texinfo-format 'texinfo-format-noop)
-(put 'w 'texinfo-format 'texinfo-format-noop)
-(put 'asis 'texinfo-format 'texinfo-format-noop)
-(put 'dmn 'texinfo-format 'texinfo-format-noop)
-(put 'key 'texinfo-format 'texinfo-format-noop)
-(put 'math 'texinfo-format 'texinfo-format-noop)
-(put 'titlefont 'texinfo-format 'texinfo-format-noop)
-(defun texinfo-format-noop ()
-  (insert (texinfo-parse-arg-discard))
-  (goto-char texinfo-command-start))
-
-(put 'cite 'texinfo-format 'texinfo-format-code)
-(put 'code 'texinfo-format 'texinfo-format-code)
-(put 'file 'texinfo-format 'texinfo-format-code)
-(put 'kbd 'texinfo-format 'texinfo-format-code)
-(put 'samp 'texinfo-format 'texinfo-format-code)
-(defun texinfo-format-code ()
-  (insert "`" (texinfo-parse-arg-discard) "'")
-  (goto-char texinfo-command-start))
-
-(put 'emph 'texinfo-format 'texinfo-format-emph)
-(put 'strong 'texinfo-format 'texinfo-format-emph)
-(defun texinfo-format-emph ()
-  (insert "*" (texinfo-parse-arg-discard) "*")
-  (goto-char texinfo-command-start))
-
-(put 'dfn 'texinfo-format 'texinfo-format-defn)
-(put 'defn 'texinfo-format 'texinfo-format-defn)
-(defun texinfo-format-defn ()
-  (insert "\"" (texinfo-parse-arg-discard) "\"")
-  (goto-char texinfo-command-start))
-
-(put 'bullet 'texinfo-format 'texinfo-format-bullet)
-(defun texinfo-format-bullet ()
-  "Insert an asterisk.
-If used within a line, follow `@bullet' with braces."
-  (texinfo-optional-braces-discard)
-  (insert "*"))
-
-
-;;; @example, @lisp, @quotation, @display, @smalllisp, @smallexample
-
-(put 'display 'texinfo-format 'texinfo-format-example)
-(put 'example 'texinfo-format 'texinfo-format-example)
-(put 'lisp 'texinfo-format 'texinfo-format-example)
-(put 'quotation 'texinfo-format 'texinfo-format-example)
-(put 'smallexample 'texinfo-format 'texinfo-format-example)
-(put 'smalllisp 'texinfo-format 'texinfo-format-example)
-(defun texinfo-format-example ()
-  (texinfo-push-stack 'example nil)
-  (setq fill-column (- fill-column 5))
-  (texinfo-discard-line))
-
-(put 'example 'texinfo-end 'texinfo-end-example)
-(put 'display 'texinfo-end 'texinfo-end-example)
-(put 'lisp 'texinfo-end 'texinfo-end-example)
-(put 'quotation 'texinfo-end 'texinfo-end-example)
-(put 'smallexample 'texinfo-end 'texinfo-end-example)
-(put 'smalllisp 'texinfo-end 'texinfo-end-example)
-(defun texinfo-end-example ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((stacktop
-         (texinfo-pop-stack 'example)))
-    (texinfo-do-itemize (nth 1 stacktop))))
-
-(put 'exdent 'texinfo-format 'texinfo-format-exdent)
-(defun texinfo-format-exdent ()
-  (texinfo-discard-command)
-  (delete-region (point)
-                 (progn
-                  (skip-chars-forward " ")
-                  (point)))
-  (insert ?\b)
-  ;; Cancel out the deletion that texinfo-do-itemize
-  ;; is going to do at the end of this line.
-  (save-excursion
-    (end-of-line)
-    (insert "\n     ")))
-
-
-;;; @cartouche 
-
-; The @cartouche command is a noop in Info; in a printed manual,
-; it makes a box with rounded corners.
-
-(put 'cartouche 'texinfo-format 'texinfo-discard-line)
-(put 'cartouche 'texinfo-end 'texinfo-discard-command)
-
-
-;;; @flushleft and @format
-
-; The @flushleft command left justifies every line but leaves the
-; right end ragged.  As far as Info is concerned, @flushleft is a
-; `do-nothing' command
-
-; The @format command is similar to @example except that it does not
-; indent; this means that in Info, @format is similar to @flushleft.
-
-(put 'format 'texinfo-format 'texinfo-format-flushleft)
-(put 'flushleft 'texinfo-format 'texinfo-format-flushleft)
-(defun texinfo-format-flushleft ()
-  (texinfo-discard-line))
-
-(put 'format 'texinfo-end 'texinfo-end-flushleft)
-(put 'flushleft 'texinfo-end 'texinfo-end-flushleft)
-(defun texinfo-end-flushleft ()
-  (texinfo-discard-command))
-
-
-;;; @flushright
-
-; The @flushright command right justifies every line but leaves the
-; left end ragged.  Spaces and tabs at the right ends of lines are
-; removed so that visible text lines up on the right side.
-
-(put 'flushright 'texinfo-format 'texinfo-format-flushright)
-(defun texinfo-format-flushright ()
-  (texinfo-push-stack 'flushright nil)
-  (texinfo-discard-line))
-
-(put 'flushright 'texinfo-end 'texinfo-end-flushright)
-(defun texinfo-end-flushright ()
-  (texinfo-discard-command)
-
-  (let ((stacktop
-         (texinfo-pop-stack 'flushright)))
-
-    (texinfo-do-flushright (nth 1 stacktop))))
-
-(defun texinfo-do-flushright (from)
-  (save-excursion
-   (while (progn (forward-line -1)
-                 (>= (point) from))
-
-     (beginning-of-line)
-     (insert
-      (make-string
-       (- fill-column
-          (save-excursion
-            (end-of-line) 
-            (skip-chars-backward " \t")
-            (delete-region (point) (progn (end-of-line) (point)))
-            (current-column)))  
-       ? )))))
-
-
-;;; @ctrl, @TeX, @copyright, @minus, @dots
-
-(put 'ctrl 'texinfo-format 'texinfo-format-ctrl)
-(defun texinfo-format-ctrl ()
-  (let ((str (texinfo-parse-arg-discard)))
-    (insert (logand 31 (aref str 0)))))
-
-(put 'TeX 'texinfo-format 'texinfo-format-TeX)
-(defun texinfo-format-TeX ()
-  (texinfo-parse-arg-discard)
-  (insert "TeX"))
-
-(put 'copyright 'texinfo-format 'texinfo-format-copyright)
-(defun texinfo-format-copyright ()
-  (texinfo-parse-arg-discard)
-  (insert "(C)"))
-
-(put 'minus 'texinfo-format 'texinfo-format-minus)
-(defun texinfo-format-minus ()
-  "Insert a minus sign.
-If used within a line, follow `@minus' with braces."
-  (texinfo-optional-braces-discard)
-  (insert "-"))
-
-(put 'dots 'texinfo-format 'texinfo-format-dots)
-(defun texinfo-format-dots ()
-  (texinfo-parse-arg-discard)
-  (insert "..."))
-
-(put 'enddots 'texinfo-format 'texinfo-format-enddots)
-(defun texinfo-format-enddots ()
-  (texinfo-parse-arg-discard)
-  (insert "...."))
-
-
-;;; Refilling and indenting:  @refill, @paragraphindent, @noindent
-
-;;; Indent only those paragraphs that are refilled as a result of an
-;;; @refill command.  
-
-;    * If the value is `asis', do not change the existing indentation at
-;      the starts of paragraphs.
-
-;    * If the value zero, delete any existing indentation.
-
-;    * If the value is greater than zero, indent each paragraph by that
-;      number of spaces.
-
-;;; But do not refill paragraphs with an @refill command that are
-;;; preceded by @noindent or are part of a table, list, or deffn.
-
-(defvar texinfo-paragraph-indent "asis"
-  "Number of spaces for @refill to indent a paragraph; else to leave as is.")
-
-(put 'paragraphindent 'texinfo-format 'texinfo-paragraphindent)
-
-(defun texinfo-paragraphindent ()
-  "Specify the number of spaces for @refill to indent a paragraph.
-Default is to leave the number of spaces as is."
-  (let ((arg  (texinfo-parse-arg-discard)))
-    (if (string= "asis" arg)
-        (setq texinfo-paragraph-indent "asis")
-      (setq texinfo-paragraph-indent (string-to-int arg)))))
-
-(put 'refill 'texinfo-format 'texinfo-format-refill)
-(defun texinfo-format-refill ()
-  "Refill paragraph. Also, indent first line as set by @paragraphindent.
-Default is to leave paragraph indentation as is."
-  (texinfo-discard-command)
-  (forward-paragraph -1)     
-  (if (looking-at "[ \t\n]*$") (forward-line 1))
-  ;; Do not indent if an entry in a list, table, or deffn,
-  ;; or if paragraph is preceded by @noindent.
-  ;; Otherwise, indent
-  (cond 
-   ;; delete a @noindent line and do not indent paragraph
-   ((save-excursion (forward-line -1)
-                    (looking-at "^@noindent")) 
-    (forward-line -1)
-    (delete-region (point) (progn (forward-line 1) (point))))
-   ;; do nothing if "asis"
-   ((equal texinfo-paragraph-indent "asis"))
-   ;; do no indenting in list, etc.
-   ((> texinfo-stack-depth 0))   
-   ;; otherwise delete existing whitespace and indent
-   (t 
-    (delete-region (point) (progn (skip-chars-forward " \t") (point)))
-    (insert (make-string texinfo-paragraph-indent ? ))))
-  (forward-paragraph 1) 
-  (forward-line -1)
-  (end-of-line)
-  ;; Do not fill a section title line with asterisks, hyphens, etc. that
-  ;; are used to underline it.  This could occur if the line following
-  ;; the underlining is not an index entry and has text within it.
-  (let* ((previous-paragraph-separate paragraph-separate)
-         (paragraph-separate (concat paragraph-separate "\\|[-=*.]+"))
-         (previous-paragraph-start paragraph-start)
-         (paragraph-start (concat paragraph-start "\\|[-=*.]+")))
-    (unwind-protect
-        (fill-paragraph nil)
-      (setq paragraph-separate previous-paragraph-separate)
-      (setq paragraph-start previous-paragraph-start))))
-
-(put 'noindent 'texinfo-format 'texinfo-noindent)
-(defun texinfo-noindent ()  
-  (save-excursion 
-    (forward-paragraph 1)
-    (if (search-backward "@refill"
-                            (save-excursion (forward-line -1) (point)) t)
-        () ; leave @noindent command so @refill command knows not to indent
-      ;; else
-      (texinfo-discard-line))))
-
-
-;;; Index generation
-
-(put 'vindex 'texinfo-format 'texinfo-format-vindex)
-(defun texinfo-format-vindex ()
-  (texinfo-index 'texinfo-vindex))
-
-(put 'cindex 'texinfo-format 'texinfo-format-cindex)
-(defun texinfo-format-cindex ()
-  (texinfo-index 'texinfo-cindex))
-
-(put 'findex 'texinfo-format 'texinfo-format-findex)
-(defun texinfo-format-findex ()
-  (texinfo-index 'texinfo-findex))
-
-(put 'pindex 'texinfo-format 'texinfo-format-pindex)
-(defun texinfo-format-pindex ()
-  (texinfo-index 'texinfo-pindex))
-
-(put 'tindex 'texinfo-format 'texinfo-format-tindex)
-(defun texinfo-format-tindex ()
-  (texinfo-index 'texinfo-tindex))
-
-(put 'kindex 'texinfo-format 'texinfo-format-kindex)
-(defun texinfo-format-kindex ()
-  (texinfo-index 'texinfo-kindex))
-
-(defun texinfo-index (indexvar)
-  (let ((arg (texinfo-parse-expanded-arg)))
-    (texinfo-discard-command)
-    (set indexvar
-         (cons (list arg
-                     texinfo-last-node
-                     ;; Region formatting may not provide last node position.
-                     (if texinfo-last-node-pos
-                         (1+ (count-lines texinfo-last-node-pos (point)))
-                       1))
-               (symbol-value indexvar)))))
-
-(defconst texinfo-indexvar-alist
-  '(("cp" . texinfo-cindex)
-    ("fn" . texinfo-findex)
-    ("vr" . texinfo-vindex)
-    ("tp" . texinfo-tindex)
-    ("pg" . texinfo-pindex)
-    ("ky" . texinfo-kindex)))
-
-
-;;; @defindex   @defcodeindex
-(put 'defindex 'texinfo-format 'texinfo-format-defindex)
-(put 'defcodeindex 'texinfo-format 'texinfo-format-defindex)
-
-(defun texinfo-format-defindex ()
-  (let* ((index-name (texinfo-parse-arg-discard)) ; eg: `aa'
-         (indexing-command (intern (concat index-name "index")))
-         (index-formatting-command      ; eg: `texinfo-format-aaindex'
-          (intern (concat "texinfo-format-" index-name "index")))
-         (index-alist-name              ; eg: `texinfo-aaindex'
-          (intern (concat "texinfo-" index-name "index"))))
-
-    (set index-alist-name nil)
-
-    (put indexing-command               ; eg, aaindex
-         'texinfo-format
-         index-formatting-command)      ; eg, texinfo-format-aaindex
-
-    ;; eg: "aa" . texinfo-aaindex
-    (or (assoc index-name texinfo-indexvar-alist)
-        (setq texinfo-indexvar-alist
-              (cons
-               (cons index-name
-                     index-alist-name)
-               texinfo-indexvar-alist)))
-
-    (fset index-formatting-command
-          (list 'lambda 'nil
-                (list 'texinfo-index 
-                      (list 'quote index-alist-name))))))
-
-
-;;; @synindex   @syncodeindex
-
-(put 'synindex 'texinfo-format 'texinfo-format-synindex)
-(put 'syncodeindex 'texinfo-format 'texinfo-format-synindex)
-
-(defun texinfo-format-synindex ()
-  (let* ((args (texinfo-parse-arg-discard))
-         (second (cdr (read-from-string args)))
-         (joiner (symbol-name (car (read-from-string args))))
-         (joined (symbol-name (car (read-from-string args second)))))
-
-    (if (assoc joiner texinfo-short-index-cmds-alist)
-        (put
-          (cdr (assoc joiner texinfo-short-index-cmds-alist))
-         'texinfo-format
-         (or (cdr (assoc joined texinfo-short-index-format-cmds-alist))
-             (intern (concat "texinfo-format-" joined "index"))))
-      (put
-       (intern (concat joiner "index"))
-       'texinfo-format
-       (or (cdr(assoc joined texinfo-short-index-format-cmds-alist))
-           (intern (concat "texinfo-format-" joined "index")))))))
-
-(defconst texinfo-short-index-cmds-alist
-  '(("cp" . cindex)
-    ("fn" . findex)
-    ("vr" . vindex)
-    ("tp" . tindex)
-    ("pg" . pindex)
-    ("ky" . kindex)))
-
-(defconst texinfo-short-index-format-cmds-alist
-  '(("cp" . texinfo-format-cindex)
-    ("fn" . texinfo-format-findex)
-    ("vr" . texinfo-format-vindex)
-    ("tp" . texinfo-format-tindex)
-    ("pg" . texinfo-format-pindex)
-    ("ky" . texinfo-format-kindex)))
-
-
-;;; Sort and index (for VMS)
-
-;; Sort an index which is in the current buffer between START and END.
-;; Used on VMS, where the `sort' utility is not available.
-(defun texinfo-sort-region (start end)
-  (require 'sort)
-  (save-restriction
-    (narrow-to-region start end)
-    (sort-subr nil 'forward-line 'end-of-line 'texinfo-sort-startkeyfun)))
-
-;; Subroutine for sorting an index.
-;; At start of a line, return a string to sort the line under.
-(defun texinfo-sort-startkeyfun ()
-  (let ((line
-         (buffer-substring (point) (save-excursion (end-of-line) (point)))))
-    ;; Canonicalize whitespace and eliminate funny chars.
-    (while (string-match "[ \t][ \t]+\\|[^a-z0-9 ]+" line)
-      (setq line (concat (substring line 0 (match-beginning 0))
-                         " "
-                         (substring line (match-end 0) (length line)))))
-    line))
-
-
-;;; @printindex
-
-(put 'printindex 'texinfo-format 'texinfo-format-printindex)
-
-(defun texinfo-format-printindex ()
-  (let ((indexelts (symbol-value
-                    (cdr (assoc (texinfo-parse-arg-discard)
-                                texinfo-indexvar-alist))))
-        opoint)
-    (insert "\n* Menu:\n\n")
-    (setq opoint (point))
-    (texinfo-print-index nil indexelts)
-
-    (if (memq system-type '(vax-vms windows-nt ms-dos))
-        (texinfo-sort-region opoint (point))
-      (shell-command-on-region opoint (point) "sort -fd" 1))))
-
-(defun texinfo-print-index (file indexelts)
-  (while indexelts
-    (if (stringp (car (car indexelts)))
-        (progn
-          (insert "* " (car (car indexelts)) ": " )
-          (indent-to 32)
-          (insert
-           (if file (concat "(" file ")") "")
-           (nth 1 (car indexelts)) ".")
-          (indent-to 54)
-          (insert
-           (if (nth 2 (car indexelts))
-               (format "  %d." (nth 2 (car indexelts)))
-             "")
-           "\n"))
-      ;; index entries from @include'd file
-      (texinfo-print-index (nth 1 (car indexelts))
-                           (nth 2 (car indexelts))))
-    (setq indexelts (cdr indexelts))))
-
-
-;;; Glyphs: @equiv, @error, etc
-
-;; @equiv           to show that two expressions are equivalent
-;; @error           to show an error message
-;; @expansion       to show what a macro expands to
-;; @point           to show the location of point in an example
-;; @print           to show what an evaluated expression prints
-;; @result          to indicate the value returned by an expression
-
-(put 'equiv 'texinfo-format 'texinfo-format-equiv)
-(defun texinfo-format-equiv ()
-  (texinfo-parse-arg-discard)
-  (insert "=="))
-
-(put 'error 'texinfo-format 'texinfo-format-error)
-(defun texinfo-format-error ()
-  (texinfo-parse-arg-discard)
-  (insert "error-->"))
-
-(put 'expansion 'texinfo-format 'texinfo-format-expansion)
-(defun texinfo-format-expansion ()
-  (texinfo-parse-arg-discard)
-  (insert "==>"))
-
-(put 'point 'texinfo-format 'texinfo-format-point)
-(defun texinfo-format-point ()
-  (texinfo-parse-arg-discard)
-  (insert "-!-"))
-
-(put 'print 'texinfo-format 'texinfo-format-print)
-(defun texinfo-format-print ()
-  (texinfo-parse-arg-discard)
-  (insert "-|"))
-
-(put 'result 'texinfo-format 'texinfo-format-result)
-(defun texinfo-format-result ()
-  (texinfo-parse-arg-discard)
-  (insert "=>"))
-
-
-;;; Definition formatting: @deffn, @defun, etc
-
-;; What definition formatting produces:
-;;
-;; @deffn category name args...
-;;     In Info, `Category: name ARGS'
-;;     In index: name:  node. line#.
-;;
-;; @defvr category name 
-;;     In Info, `Category: name'
-;;     In index: name:  node. line#.
-;;
-;; @deftp category name attributes...
-;; `category name attributes...'       Note: @deftp args in lower case.
-;;     In index: name:  node. line#.
-;;
-;; Specialized function-like or variable-like entity:
-;;
-;; @defun, @defmac, @defspec, @defvar, @defopt
-;;
-;; @defun name args           In Info, `Function: name ARGS'
-;; @defmac name args          In Info, `Macro: name ARGS'
-;; @defvar name               In Info, `Variable: name'
-;; etc.
-;;     In index: name:  node. line#.
-;;
-;; Generalized typed-function-like or typed-variable-like entity:
-;; @deftypefn category data-type name args...
-;;     In Info, `Category:  data-type name args...'
-;; @deftypevr category data-type name 
-;;     In Info, `Category:  data-type name'
-;;     In index: name:  node. line#.
-;;
-;; Specialized typed-function-like or typed-variable-like entity:
-;; @deftypefun data-type name args...
-;;     In Info, `Function:  data-type name ARGS'
-;;     In index: name:  node. line#.   
-;;
-;; @deftypevar data-type name 
-;;     In Info, `Variable:  data-type name'
-;;     In index: name:  node. line#.   but include args after name!?
-;;
-;; Generalized object oriented entity: 
-;; @defop category class name args...
-;;     In Info, `Category on class: name ARG'
-;;     In index: name on class: node. line#.
-;;
-;; @defcv category class name         
-;;     In Info, `Category of class: name'
-;;     In index: name of class: node. line#.
-;;
-;; Specialized object oriented entity:
-;; @defmethod class name args... 
-;;     In Info, `Method on class: name ARGS'
-;;     In index: name on class: node. line#.
-;;
-;; @defivar class name
-;;     In Info, `Instance variable of class: name'
-;;     In index: name of class: node. line#.
-
-
-;;; The definition formatting functions
-
-(defun texinfo-format-defun ()
-  (texinfo-push-stack 'defun nil)
-  (setq fill-column (- fill-column 5))
-  (texinfo-format-defun-1 t))
-
-(defun texinfo-end-defun ()
-  (setq fill-column (+ fill-column 5))
-  (texinfo-discard-command)
-  (let ((start (nth 1 (texinfo-pop-stack 'defun))))
-    (texinfo-do-itemize start)
-    ;; Delete extra newline inserted after header.
-    (save-excursion
-      (goto-char start)
-      (delete-char -1))))
-
-(defun texinfo-format-defunx ()
-  (texinfo-format-defun-1 nil))
-
-(defun texinfo-format-defun-1 (first-p)
-  (let ((parse-args (texinfo-format-parse-defun-args))
-        (texinfo-defun-type (get texinfo-command-name 'texinfo-defun-type)))
-    (texinfo-discard-command)
-    ;; Delete extra newline inserted after previous header line.
-    (if (not first-p)
-        (delete-char -1))
-    (funcall
-     (get texinfo-command-name 'texinfo-deffn-formatting-property) parse-args)
-    ;; Insert extra newline so that paragraph filling does not mess
-    ;; with header line.
-    (insert "\n\n")
-    (rplaca (cdr (cdr (car texinfo-stack))) (point))
-    (funcall
-     (get texinfo-command-name 'texinfo-defun-indexing-property) parse-args)))
-
-;;; Formatting the first line of a definition
-
-;; @deffn, @defvr, @deftp
-(put 'deffn 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(put 'deffnx 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(put 'defvr 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(put 'defvrx 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(put 'deftp 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(put 'deftpx 'texinfo-deffn-formatting-property 'texinfo-format-deffn)
-(defun texinfo-format-deffn (parsed-args)
-  ;; Generalized function-like, variable-like, or generic data-type entity:
-  ;; @deffn category name args...
-  ;;     In Info, `Category: name ARGS'
-  ;; @deftp category name attributes...
-  ;; `category name attributes...'       Note: @deftp args in lower case.
-  (let ((category (car parsed-args))
-        (name (car (cdr parsed-args)))
-        (args (cdr (cdr parsed-args))))
-    (insert " -- " category ": " name)
-    (while args
-      (insert " "
-              (if (or (= ?& (aref (car args) 0))
-                      (eq (eval (car texinfo-defun-type)) 'deftp-type))
-                  (car args)
-                (upcase (car args))))
-      (setq args (cdr args)))))
-
-;; @defun, @defmac, @defspec, @defvar, @defopt: Specialized, simple
-(put 'defun 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defunx 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defmac 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defmacx 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defspec 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defspecx 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defvar 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defvarx 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defopt 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(put 'defoptx 'texinfo-deffn-formatting-property
-     'texinfo-format-specialized-defun)
-(defun texinfo-format-specialized-defun (parsed-args)
-  ;; Specialized function-like or variable-like entity:
-  ;; @defun name args           In Info, `Function: Name ARGS'
-  ;; @defmac name args          In Info, `Macro: Name ARGS'
-  ;; @defvar name               In Info, `Variable: Name'
-  ;; Use cdr of texinfo-defun-type to determine category:
-  (let ((category (car (cdr texinfo-defun-type)))
-        (name (car parsed-args))
-        (args (cdr parsed-args)))
-    (insert " -- " category ": " name)
-    (while args
-      (insert " "
-              (if (= ?& (aref (car args) 0))
-                  (car args)
-                (upcase (car args))))
-      (setq args (cdr args)))))
-
-;; @deftypefn, @deftypevr: Generalized typed
-(put 'deftypefn 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
-(put 'deftypefnx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
-(put 'deftypevr 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
-(put 'deftypevrx 'texinfo-deffn-formatting-property 'texinfo-format-deftypefn)
-(defun texinfo-format-deftypefn (parsed-args)
-  ;; Generalized typed-function-like or typed-variable-like entity:
-  ;; @deftypefn category data-type name args...
-  ;;     In Info, `Category:  data-type name args...'
-  ;; @deftypevr category data-type name 
-  ;;     In Info, `Category:  data-type name'
-  ;; Note: args in lower case, unless modified in command line.
-  (let ((category (car parsed-args))
-        (data-type (car (cdr parsed-args)))
-        (name (car (cdr (cdr parsed-args))))
-        (args (cdr (cdr (cdr parsed-args)))))
-    (insert " -- " category ": " data-type " " name)
-    (while args
-      (insert " " (car args))
-      (setq args (cdr args)))))
-
-;; @deftypefun, @deftypevar: Specialized typed
-(put 'deftypefun 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun)
-(put 'deftypefunx 'texinfo-deffn-formatting-property
-     'texinfo-format-deftypefun)
-(put 'deftypevar 'texinfo-deffn-formatting-property 'texinfo-format-deftypefun)
-(put 'deftypevarx 'texinfo-deffn-formatting-property
-     'texinfo-format-deftypefun)
-(defun texinfo-format-deftypefun (parsed-args)
-  ;; Specialized typed-function-like or typed-variable-like entity:
-  ;; @deftypefun data-type name args...
-  ;;     In Info, `Function:  data-type name ARGS'
-  ;; @deftypevar data-type name 
-  ;;     In Info, `Variable:  data-type name'
-  ;; Note: args in lower case, unless modified in command line.
-  ;; Use cdr of texinfo-defun-type to determine category:
-  (let ((category (car (cdr texinfo-defun-type)))
-        (data-type (car parsed-args))
-        (name (car (cdr  parsed-args)))
-        (args (cdr (cdr parsed-args))))
-    (insert " -- " category ": " data-type " " name)
-    (while args
-      (insert " " (car args))
-      (setq args (cdr args)))))
-
-;; @defop: Generalized object-oriented
-(put 'defop 'texinfo-deffn-formatting-property 'texinfo-format-defop)
-(put 'defopx 'texinfo-deffn-formatting-property 'texinfo-format-defop)
-(defun texinfo-format-defop (parsed-args)
-  ;; Generalized object oriented entity: 
-  ;; @defop category class name args...
-  ;;     In Info, `Category on class: name ARG'
-  ;; Note: args in upper case; use of `on'
-  (let ((category (car parsed-args))
-        (class (car (cdr parsed-args)))
-        (name (car (cdr (cdr parsed-args))))
-        (args (cdr (cdr (cdr parsed-args)))))
-    (insert " -- " category " on " class ": " name)
-    (while args
-      (insert " " (upcase (car args)))
-      (setq args (cdr args)))))
-
-;; @defcv: Generalized object-oriented
-(put 'defcv 'texinfo-deffn-formatting-property 'texinfo-format-defcv)
-(put 'defcvx 'texinfo-deffn-formatting-property 'texinfo-format-defcv)
-(defun texinfo-format-defcv (parsed-args)
-  ;; Generalized object oriented entity: 
-  ;; @defcv category class name         
-  ;;     In Info, `Category of class: name'
-  ;; Note: args in upper case; use of `of'
-  (let ((category (car parsed-args))
-        (class (car (cdr parsed-args)))
-        (name (car (cdr (cdr parsed-args))))
-        (args (cdr (cdr (cdr parsed-args)))))
-    (insert " -- " category " of " class ": " name)
-    (while args
-      (insert " " (upcase (car args)))
-      (setq args (cdr args)))))
-
-;; @defmethod: Specialized object-oriented
-(put 'defmethod 'texinfo-deffn-formatting-property 'texinfo-format-defmethod)
-(put 'defmethodx 'texinfo-deffn-formatting-property 'texinfo-format-defmethod)
-(defun texinfo-format-defmethod (parsed-args)
-  ;; Specialized object oriented entity:
-  ;; @defmethod class name args... 
-  ;;     In Info, `Method on class: name ARGS'
-  ;; Note: args in upper case; use of `on'
-  ;; Use cdr of texinfo-defun-type to determine category:
-  (let ((category (car (cdr texinfo-defun-type)))
-        (class (car parsed-args))
-        (name (car (cdr  parsed-args)))
-        (args (cdr  (cdr parsed-args))))
-    (insert " -- " category " on " class ": " name)
-    (while args
-      (insert " " (upcase (car args)))
-      (setq args (cdr args)))))
-
-;; @defivar: Specialized object-oriented
-(put 'defivar 'texinfo-deffn-formatting-property 'texinfo-format-defivar)
-(put 'defivarx 'texinfo-deffn-formatting-property 'texinfo-format-defivar)
-(defun texinfo-format-defivar (parsed-args)
-  ;; Specialized object oriented entity:
-  ;; @defivar class name
-  ;;     In Info, `Instance variable of class: name'
-  ;; Note: args in upper case; use of `of'
-  ;; Use cdr of texinfo-defun-type to determine category:
-  (let ((category (car (cdr texinfo-defun-type)))
-        (class (car parsed-args))
-        (name (car (cdr  parsed-args)))
-        (args (cdr  (cdr parsed-args))))
-    (insert " -- " category " of " class ": " name)
-    (while args
-      (insert " " (upcase (car args)))
-      (setq args (cdr args)))))
-
-
-;;; Indexing for definitions
-
-;; An index entry has three parts: the `entry proper', the node name, and the
-;; line number.  Depending on the which command is used, the entry is
-;; formatted differently:
-;;
-;; @defun, 
-;; @defmac, 
-;; @defspec, 
-;; @defvar, 
-;; @defopt          all use their 1st argument as the entry-proper 
-;;
-;; @deffn, 
-;; @defvr, 
-;; @deftp 
-;; @deftypefun
-;; @deftypevar      all use their 2nd argument as the entry-proper
-;;
-;; @deftypefn, 
-;; @deftypevr       both use their 3rd argument as the entry-proper  
-;;
-;; @defmethod       uses its 2nd and 1st arguments as an entry-proper 
-;;                    formatted: NAME on CLASS
-
-;; @defop           uses its 3rd and 2nd arguments as an entry-proper 
-;;                    formatted: NAME on CLASS
-;;        
-;; @defivar         uses its 2nd and 1st arguments as an entry-proper
-;;                    formatted: NAME of CLASS
-;;
-;; @defcv           uses its 3rd and 2nd argument as an entry-proper
-;;                    formatted: NAME of CLASS
-
-(put 'defun 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defunx 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defmac 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defmacx 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defspec 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defspecx 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defvar 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defvarx 'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defopt  'texinfo-defun-indexing-property 'texinfo-index-defun)
-(put 'defoptx  'texinfo-defun-indexing-property 'texinfo-index-defun)
-(defun texinfo-index-defun (parsed-args)
-  ;; use 1st parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons 
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (car parsed-args)
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'deffn 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deffnx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'defvr 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'defvrx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftp 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftpx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftypefun 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftypefunx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftypevar 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(put 'deftypevarx 'texinfo-defun-indexing-property 'texinfo-index-deffn)
-(defun texinfo-index-deffn (parsed-args) 
- ;; use 2nd parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons 
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (car (cdr parsed-args))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'deftypefn 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
-(put 'deftypefnx 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
-(put 'deftypevr 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
-(put 'deftypevrx 'texinfo-defun-indexing-property 'texinfo-index-deftypefn)
-(defun texinfo-index-deftypefn (parsed-args)
-  ;; use 3rd parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons 
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (car (cdr (cdr parsed-args)))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'defmethod 'texinfo-defun-indexing-property 'texinfo-index-defmethod)
-(put 'defmethodx 'texinfo-defun-indexing-property 'texinfo-index-defmethod)
-(defun texinfo-index-defmethod (parsed-args)
-  ;; use 2nd on 1st parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons 
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (format "%s on %s"            
-                   (car (cdr parsed-args))
-                   (car parsed-args))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'defop 'texinfo-defun-indexing-property 'texinfo-index-defop)
-(put 'defopx 'texinfo-defun-indexing-property 'texinfo-index-defop)
-(defun texinfo-index-defop (parsed-args)
-  ;; use 3rd on 2nd parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons 
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (format "%s on %s"            
-                   (car (cdr (cdr parsed-args)))
-                   (car (cdr parsed-args)))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'defivar 'texinfo-defun-indexing-property 'texinfo-index-defivar)
-(put 'defivarx 'texinfo-defun-indexing-property 'texinfo-index-defivar)
-(defun texinfo-index-defivar (parsed-args)
-  ;; use 2nd of 1st parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons 
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (format "%s of %s"            
-                   (car (cdr parsed-args))
-                   (car parsed-args))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-(put 'defcv 'texinfo-defun-indexing-property 'texinfo-index-defcv)
-(put 'defcvx 'texinfo-defun-indexing-property 'texinfo-index-defcv)
-(defun texinfo-index-defcv (parsed-args)
-  ;; use 3rd of 2nd parsed-arg  as entry-proper
-  ;; `index-list' will be texinfo-findex or the like
-  (let ((index-list (get texinfo-command-name 'texinfo-defun-index)))
-    (set index-list
-         (cons 
-          ;; Three elements: entry-proper, node-name, line-number
-          (list
-           (format "%s of %s"            
-                   (car (cdr (cdr parsed-args)))
-                   (car (cdr parsed-args)))
-           texinfo-last-node
-           ;; Region formatting may not provide last node position.
-           (if texinfo-last-node-pos
-               (1+ (count-lines texinfo-last-node-pos (point)))
-             1))
-          (symbol-value index-list)))))
-
-
-;;; Properties for definitions
-
-;; Each definition command has six properties:
-;;
-;; 1. texinfo-deffn-formatting-property      to format definition line
-;; 2. texinfo-defun-indexing-property        to create index entry
-;; 3. texinfo-format                         formatting command
-;; 4. texinfo-end                            end formatting command
-;; 5. texinfo-defun-type                     type of deffn to format
-;; 6. texinfo-defun-index                    type of index to use
-;;
-;; The `x' forms of each definition command are used for the second
-;; and subsequent header lines.
-
-;; The texinfo-deffn-formatting-property and texinfo-defun-indexing-property
-;; are listed just before the appropriate formatting and indexing commands.
-
-(put 'deffn 'texinfo-format 'texinfo-format-defun)
-(put 'deffnx 'texinfo-format 'texinfo-format-defunx)
-(put 'deffn 'texinfo-end 'texinfo-end-defun)
-(put 'deffn 'texinfo-defun-type '('deffn-type nil))
-(put 'deffnx 'texinfo-defun-type '('deffn-type nil))
-(put 'deffn 'texinfo-defun-index 'texinfo-findex)
-(put 'deffnx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defun 'texinfo-format 'texinfo-format-defun)
-(put 'defunx 'texinfo-format 'texinfo-format-defunx)
-(put 'defun 'texinfo-end 'texinfo-end-defun)
-(put 'defun 'texinfo-defun-type '('defun-type "Function"))
-(put 'defunx 'texinfo-defun-type '('defun-type "Function"))
-(put 'defun 'texinfo-defun-index 'texinfo-findex)
-(put 'defunx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defmac 'texinfo-format 'texinfo-format-defun)
-(put 'defmacx 'texinfo-format 'texinfo-format-defunx)
-(put 'defmac 'texinfo-end 'texinfo-end-defun)
-(put 'defmac 'texinfo-defun-type '('defun-type "Macro"))
-(put 'defmacx 'texinfo-defun-type '('defun-type "Macro"))
-(put 'defmac 'texinfo-defun-index 'texinfo-findex)
-(put 'defmacx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defspec 'texinfo-format 'texinfo-format-defun)
-(put 'defspecx 'texinfo-format 'texinfo-format-defunx)
-(put 'defspec 'texinfo-end 'texinfo-end-defun)
-(put 'defspec 'texinfo-defun-type '('defun-type "Special form"))
-(put 'defspecx 'texinfo-defun-type '('defun-type "Special form"))
-(put 'defspec 'texinfo-defun-index 'texinfo-findex)
-(put 'defspecx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defvr 'texinfo-format 'texinfo-format-defun)
-(put 'defvrx 'texinfo-format 'texinfo-format-defunx)
-(put 'defvr 'texinfo-end 'texinfo-end-defun)
-(put 'defvr 'texinfo-defun-type '('deffn-type nil))
-(put 'defvrx 'texinfo-defun-type '('deffn-type nil))
-(put 'defvr 'texinfo-defun-index 'texinfo-vindex)
-(put 'defvrx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'defvar 'texinfo-format 'texinfo-format-defun)
-(put 'defvarx 'texinfo-format 'texinfo-format-defunx)
-(put 'defvar 'texinfo-end 'texinfo-end-defun)
-(put 'defvar 'texinfo-defun-type '('defun-type "Variable"))
-(put 'defvarx 'texinfo-defun-type '('defun-type "Variable"))
-(put 'defvar 'texinfo-defun-index 'texinfo-vindex)
-(put 'defvarx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'defconst 'texinfo-format 'texinfo-format-defun)
-(put 'defconstx 'texinfo-format 'texinfo-format-defunx)
-(put 'defconst 'texinfo-end 'texinfo-end-defun)
-(put 'defconst 'texinfo-defun-type '('defun-type "Constant"))
-(put 'defconstx 'texinfo-defun-type '('defun-type "Constant"))
-(put 'defconst 'texinfo-defun-index 'texinfo-vindex)
-(put 'defconstx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'defcmd 'texinfo-format 'texinfo-format-defun)
-(put 'defcmdx 'texinfo-format 'texinfo-format-defunx)
-(put 'defcmd 'texinfo-end 'texinfo-end-defun)
-(put 'defcmd 'texinfo-defun-type '('defun-type "Command"))
-(put 'defcmdx 'texinfo-defun-type '('defun-type "Command"))
-(put 'defcmd 'texinfo-defun-index 'texinfo-findex)
-(put 'defcmdx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defopt 'texinfo-format 'texinfo-format-defun)
-(put 'defoptx 'texinfo-format 'texinfo-format-defunx)
-(put 'defopt 'texinfo-end 'texinfo-end-defun)
-(put 'defopt 'texinfo-defun-type '('defun-type "User Option"))
-(put 'defoptx 'texinfo-defun-type '('defun-type "User Option"))
-(put 'defopt 'texinfo-defun-index 'texinfo-vindex)
-(put 'defoptx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'deftp 'texinfo-format 'texinfo-format-defun)
-(put 'deftpx 'texinfo-format 'texinfo-format-defunx)
-(put 'deftp 'texinfo-end 'texinfo-end-defun)
-(put 'deftp 'texinfo-defun-type '('deftp-type nil))
-(put 'deftpx 'texinfo-defun-type '('deftp-type nil))
-(put 'deftp 'texinfo-defun-index 'texinfo-tindex)
-(put 'deftpx 'texinfo-defun-index 'texinfo-tindex)
-
-;;; Object-oriented stuff is a little hairier.
-
-(put 'defop 'texinfo-format 'texinfo-format-defun)
-(put 'defopx 'texinfo-format 'texinfo-format-defunx)
-(put 'defop 'texinfo-end 'texinfo-end-defun)
-(put 'defop 'texinfo-defun-type '('defop-type nil))
-(put 'defopx 'texinfo-defun-type '('defop-type nil))
-(put 'defop 'texinfo-defun-index 'texinfo-findex)
-(put 'defopx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defmethod 'texinfo-format 'texinfo-format-defun)
-(put 'defmethodx 'texinfo-format 'texinfo-format-defunx)
-(put 'defmethod 'texinfo-end 'texinfo-end-defun)
-(put 'defmethod 'texinfo-defun-type '('defmethod-type "Method"))
-(put 'defmethodx 'texinfo-defun-type '('defmethod-type "Method"))
-(put 'defmethod 'texinfo-defun-index 'texinfo-findex)
-(put 'defmethodx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'defcv 'texinfo-format 'texinfo-format-defun)
-(put 'defcvx 'texinfo-format 'texinfo-format-defunx)
-(put 'defcv 'texinfo-end 'texinfo-end-defun)
-(put 'defcv 'texinfo-defun-type '('defop-type nil))
-(put 'defcvx 'texinfo-defun-type '('defop-type nil))
-(put 'defcv 'texinfo-defun-index 'texinfo-vindex)
-(put 'defcvx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'defivar 'texinfo-format 'texinfo-format-defun)
-(put 'defivarx 'texinfo-format 'texinfo-format-defunx)
-(put 'defivar 'texinfo-end 'texinfo-end-defun)
-(put 'defivar 'texinfo-defun-type '('defmethod-type "Instance variable"))
-(put 'defivarx 'texinfo-defun-type '('defmethod-type "Instance variable"))
-(put 'defivar 'texinfo-defun-index 'texinfo-vindex)
-(put 'defivarx 'texinfo-defun-index 'texinfo-vindex)
-
-;;; Typed functions and variables
-
-(put 'deftypefn 'texinfo-format 'texinfo-format-defun)
-(put 'deftypefnx 'texinfo-format 'texinfo-format-defunx)
-(put 'deftypefn 'texinfo-end 'texinfo-end-defun)
-(put 'deftypefn 'texinfo-defun-type '('deftypefn-type nil))
-(put 'deftypefnx 'texinfo-defun-type '('deftypefn-type nil))
-(put 'deftypefn 'texinfo-defun-index 'texinfo-findex)
-(put 'deftypefnx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'deftypefun 'texinfo-format 'texinfo-format-defun)
-(put 'deftypefunx 'texinfo-format 'texinfo-format-defunx)
-(put 'deftypefun 'texinfo-end 'texinfo-end-defun)
-(put 'deftypefun 'texinfo-defun-type '('deftypefun-type "Function"))
-(put 'deftypefunx 'texinfo-defun-type '('deftypefun-type "Function"))
-(put 'deftypefun 'texinfo-defun-index 'texinfo-findex)
-(put 'deftypefunx 'texinfo-defun-index 'texinfo-findex)
-
-(put 'deftypevr 'texinfo-format 'texinfo-format-defun)
-(put 'deftypevrx 'texinfo-format 'texinfo-format-defunx)
-(put 'deftypevr 'texinfo-end 'texinfo-end-defun)
-(put 'deftypevr 'texinfo-defun-type '('deftypefn-type nil))
-(put 'deftypevrx 'texinfo-defun-type '('deftypefn-type nil))
-(put 'deftypevr 'texinfo-defun-index 'texinfo-vindex)
-(put 'deftypevrx 'texinfo-defun-index 'texinfo-vindex)
-
-(put 'deftypevar 'texinfo-format 'texinfo-format-defun)
-(put 'deftypevarx 'texinfo-format 'texinfo-format-defunx)
-(put 'deftypevar 'texinfo-end 'texinfo-end-defun)
-(put 'deftypevar 'texinfo-defun-type '('deftypevar-type "Variable"))
-(put 'deftypevarx 'texinfo-defun-type '('deftypevar-type "Variable"))
-(put 'deftypevar 'texinfo-defun-index 'texinfo-vindex)
-(put 'deftypevarx 'texinfo-defun-index 'texinfo-vindex)
-
-
-;;; @set, @clear, @ifset, @ifclear
-
-;; If a flag is set with @set FLAG, then text between @ifset and @end
-;; ifset is formatted normally, but if the flag is is cleared with
-;; @clear FLAG, then the text is not formatted; it is ignored.
-
-;; If a flag is cleared with @clear FLAG, then text between @ifclear
-;; and @end ifclear is formatted normally, but if the flag is is set with
-;; @set FLAG, then the text is not formatted; it is ignored.  @ifclear
-;; is the opposite of @ifset.
-
-;; If a flag is set to a string with @set FLAG, 
-;; replace  @value{FLAG} with the string.
-;; If a flag with a value is cleared, 
-;; @value{FLAG} is invalid, 
-;; as if there had never been any @set FLAG previously.
-
-(put 'clear 'texinfo-format 'texinfo-clear)
-(defun texinfo-clear ()
-  "Clear the value of the flag."
-  (let* ((arg (texinfo-parse-arg-discard))
-         (flag (car (read-from-string arg)))
-         (value (substring arg (cdr (read-from-string arg)))))
-    (put flag 'texinfo-whether-setp 'flag-cleared)
-    (put flag 'texinfo-set-value "")))
-
-(put 'set 'texinfo-format 'texinfo-set)
-(defun texinfo-set ()
-  "Set the value of the flag, optionally to a string.
-The command  `@set foo This is a string.'
-sets flag foo to the value: `This is a string.'
-The command  `@value{foo}'  expands to the value."
-  (let* ((arg (texinfo-parse-arg-discard))
-         (flag (car (read-from-string arg)))
-         (value (substring arg (cdr (read-from-string arg)))))
-    (put flag 'texinfo-whether-setp 'flag-set)
-    (put flag 'texinfo-set-value value)))
-
-(put 'value 'texinfo-format 'texinfo-value)
-(defun texinfo-value ()
-  "Insert the string to which the flag is set.
-The command  `@set foo This is a string.'
-sets flag foo to the value: `This is a string.'
-The command  `@value{foo}'  expands to the value."
-  (let ((arg (texinfo-parse-arg-discard)))
-    (cond ((and
-            (eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-                'flag-set)
-            (get (car (read-from-string arg)) 'texinfo-set-value))
-           (insert (get (car (read-from-string arg)) 'texinfo-set-value)))
-          ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) 
-               'flag-cleared)
-           (insert (format "{No value for \"%s\"}"  arg)))
-          ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp) nil)
-           (insert (format "{No value for \"%s\"}"  arg))))))
-
-(put 'ifset 'texinfo-end 'texinfo-discard-command)
-(put 'ifset 'texinfo-format 'texinfo-if-set)
-(defun texinfo-if-set ()
-  "If set, continue formatting; else do not format region up to @end ifset"
-  (let ((arg (texinfo-parse-arg-discard)))
-    (cond
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          'flag-set)
-      ;; Format the text (i.e., do not remove it); do nothing here.
-      ())
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          'flag-cleared)
-      ;; Clear region (i.e., cause the text to be ignored).
-      (delete-region texinfo-command-start
-                       (progn (re-search-forward "@end ifset[ \t]*\n")
-                              (point))))
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          nil)
-      ;; In this case flag is neither set nor cleared.  
-      ;; Act as if set, i.e. do nothing.
-      ()))))
-
-(put 'ifclear 'texinfo-end 'texinfo-discard-command)
-(put 'ifclear 'texinfo-format 'texinfo-if-clear)
-(defun texinfo-if-clear ()
-  "If clear, continue formatting; if set, do not format up to @end ifset"
-  (let ((arg (texinfo-parse-arg-discard)))
-    (cond
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          'flag-set)
-      ;; Clear region (i.e., cause the text to be ignored).
-      (delete-region texinfo-command-start
-                       (progn (re-search-forward "@end ifclear[ \t]*\n")
-                              (point))))
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          'flag-cleared)
-      ;; Format the text (i.e., do not remove it); do nothing here.
-      ())
-     ((eq (get (car (read-from-string arg)) 'texinfo-whether-setp)
-          nil)
-      ;; In this case flag is neither set nor cleared.  
-      ;; Act as if clear, i.e. do nothing.
-      ()))))
-
-
-;;; Process included files:  `@include' command
-
-;; Updated 19 October 1990
-;; In the original version, include files were ignored by Info but
-;; incorporated in to the printed manual.  To make references to the
-;; included file, the Texinfo source file has to refer to the included
-;; files using the `(filename)nodename' format for referring to other
-;; Info files.  Also, the included files had to be formatted on their
-;; own.  It was just like they were another file.
-
-;; Currently, include files are inserted into the buffer that is
-;; formatted for Info.  If large, the resulting info file is split and
-;; tagified.  For current include files to work, the master menu must
-;; refer to all the nodes, and the highest level nodes in the include
-;; files must have the correct next, prev, and up pointers.
-
-;; The included file may have an @setfilename and even an @settitle,
-;; but not an `\input texinfo' line.
-
-;; Updated 24 March 1993
-;; In order for @raisesections and @lowersections to work, included
-;; files must be inserted into the buffer holding the outer file
-;; before other Info formatting takes place.  So @include is no longer
-;; is treated like other @-commands.
-(put 'include 'texinfo-format  'texinfo-format-noop)
-
-; Original definition:
-; (defun texinfo-format-include ()
-;   (let ((filename (texinfo-parse-arg-discard))
-;       (default-directory input-directory)
-;       subindex)
-;     (setq subindex
-;         (save-excursion
-;           (progn (find-file
-;                   (cond ((file-readable-p (concat filename ".texinfo"))
-;                          (concat filename ".texinfo"))
-;                         ((file-readable-p (concat filename ".texi"))
-;                          (concat filename ".texi"))
-;                         ((file-readable-p (concat filename ".tex"))
-;                          (concat filename ".tex"))
-;                         ((file-readable-p filename)
-;                          filename)
-;                         (t (error "@include'd file %s not found"
-;                                   filename))))
-;                  (texinfo-format-buffer-1))))
-;     (texinfo-subindex 'texinfo-vindex (car subindex) (nth 1 subindex))
-;     (texinfo-subindex 'texinfo-findex (car subindex) (nth 2 subindex))
-;     (texinfo-subindex 'texinfo-cindex (car subindex) (nth 3 subindex))
-;     (texinfo-subindex 'texinfo-pindex (car subindex) (nth 4 subindex))
-;     (texinfo-subindex 'texinfo-tindex (car subindex) (nth 5 subindex))
-;     (texinfo-subindex 'texinfo-kindex (car subindex) (nth 6 subindex))))
-;
-;(defun texinfo-subindex (indexvar file content)
-;  (set indexvar (cons (list 'recurse file content)
-;                      (symbol-value indexvar))))
-
-; Second definition:
-; (put 'include 'texinfo-format 'texinfo-format-include)
-; (defun texinfo-format-include ()
-;   (let ((filename (concat input-directory
-;                           (texinfo-parse-arg-discard)))
-;         (default-directory input-directory))
-;     (message "Reading: %s" filename)
-;     (save-excursion
-;       (save-restriction
-;         (narrow-to-region
-;          (point)
-;          (+ (point) (car (cdr (insert-file-contents filename)))))
-;         (goto-char (point-min))
-;         (texinfo-append-refill)
-;         (texinfo-format-convert (point-min) (point-max))))
-;     (setq last-input-buffer input-buffer)  ; to bypass setfilename
-;     ))
-
-
-;;; Numerous commands do nothing in Texinfo
-
-;; These commands are defined in texinfo.tex for printed output.
-
-(put 'bye 'texinfo-format 'texinfo-discard-line)
-(put 'c 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'comment 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'contents 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'finalout 'texinfo-format 'texinfo-discard-line)
-(put 'group 'texinfo-end 'texinfo-discard-line-with-args)
-(put 'group 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'headings 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'hsize 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'itemindent 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'lispnarrowing 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'need 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'nopara 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'page 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'parindent 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'setchapternewpage 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'setq 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'settitle 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'setx 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'shortcontents 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'smallbook 'texinfo-format 'texinfo-discard-line)
-(put 'summarycontents 'texinfo-format 'texinfo-discard-line-with-args)
-
-
-;;; Some commands cannot be handled
-
-(defun texinfo-unsupported ()
-  (error "%s is not handled by texinfo"
-         (buffer-substring texinfo-command-start texinfo-command-end)))
-
-;;; Batch formatting
-
-(defun batch-texinfo-format ()
-  "Runs  texinfo-format-buffer  on the files remaining on the command line.
-Must be used only with -batch, and kills emacs on completion.
-Each file will be processed even if an error occurred previously.
-For example, invoke
-  \"emacs -batch -funcall batch-texinfo-format $docs/ ~/*.texinfo\"."
-  (if (not noninteractive)
-      (error "batch-texinfo-format may only be used -batch."))
-  (let ((version-control t)
-        (auto-save-default nil)
-        (find-file-run-dired nil)
-        (kept-old-versions 259259)
-        (kept-new-versions 259259))
-    (let ((error 0)
-          file
-          (files ()))
-      (while command-line-args-left
-        (setq file (expand-file-name (car command-line-args-left)))
-        (cond ((not (file-exists-p file))
-               (message ">> %s does not exist!" file)
-               (setq error 1
-                     command-line-args-left (cdr command-line-args-left)))
-              ((file-directory-p file)
-               (setq command-line-args-left
-                     (nconc (directory-files file)
-                            (cdr command-line-args-left))))
-              (t
-               (setq files (cons file files)
-                     command-line-args-left (cdr command-line-args-left)))))
-      (while files
-        (setq file (car files)
-              files (cdr files))
-        (condition-case err
-            (progn
-              (if buffer-file-name (kill-buffer (current-buffer)))
-              (find-file file)
-              (buffer-disable-undo (current-buffer))
-              (set-buffer-modified-p nil)
-              (texinfo-mode)
-              (message "texinfo formatting %s..." file)
-              (texinfo-format-buffer nil)
-              (if (buffer-modified-p)
-                  (progn (message "Saving modified %s" (buffer-file-name))
-                         (save-buffer))))
-          (error
-           (message ">> Error: %s" (prin1-to-string err))
-           (message ">>  point at")
-           (let ((s (buffer-substring (point)
-                                      (min (+ (point) 100)
-                                           (point-max))))
-                 (tem 0))
-             (while (setq tem (string-match "\n+" s tem))
-               (setq s (concat (substring s 0 (match-beginning 0))
-                               "\n>>  "
-                               (substring s (match-end 0)))
-                     tem (1+ tem)))
-             (message ">>  %s" s))
-           (setq error 1))))
-      (kill-emacs error))))
-
-
-;;; Place `provide' at end of file.
-(provide 'texinfmt)
-
-;;; texinfmt.el ends here.
diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el
deleted file mode 100644
index ea16b03a4ae..00000000000
--- a/lisp/textmodes/texinfo.el
+++ /dev/null
@@ -1,752 +0,0 @@
-;;; texinfo.el --- major mode for editing Texinfo files
-
-;; Copyright (C) 1985, 1988, 1989, 1990, 1991, 1992, 1993 Free Software
-;; Foundation, Inc.
-
-;; Author: Robert J. Chassell          
-;; 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.
-
-
-;;; Autoloads:
-
-(autoload 'makeinfo-region
-          "makeinfo"
-  "Make Info file from region of current Texinfo file, and switch to it.
-
-This command does not offer the `next-error' feature since it would
-apply to a temporary file, not the original; use the `makeinfo-buffer'
-command to gain use of `next-error'."
-          t nil)
-
-(autoload 'makeinfo-buffer
-          "makeinfo"
-  "Make Info file from current buffer.
-
-Use the \\[next-error] command to move to the next error 
-\(if there are errors\)."
-          t nil)
-
-(autoload 'kill-compilation
-          "compile"
-  "Kill the process made by the \\[compile] command."
-          t nil)
-
-(autoload 'makeinfo-recenter-compilation-buffer
-          "makeinfo"
-  "Redisplay `*compilation*' buffer so most recent output can be seen.
-The last line of the buffer is displayed on
-line LINE of the window, or centered if LINE is nil."
-          t nil)
-
-(autoload 'texinfo-make-menu
-          "texnfo-upd"
-  "Without any prefix argument, make or update a menu.
-Make the menu for the section enclosing the node found following point.
-
-Non-nil argument (prefix, if interactive) means make or update menus
-for nodes within or part of the marked region.
-
-Whenever a menu exists, and is being updated, the descriptions that
-are associated with node names in the pre-existing menu are
-incorporated into the new menu.  Otherwise, the nodes' section titles
-are inserted as descriptions."
-          t nil)
-
-(autoload 'texinfo-all-menus-update
-          "texnfo-upd"
-  "Update every regular menu in a Texinfo file.
-Remove pre-existing master menu, if there is one.
-
-If called with a non-nil argument, this function first updates all the
-nodes in the buffer before updating the menus."
-          t nil)
-
-(autoload 'texinfo-master-menu
-          "texnfo-upd"
-  "Make a master menu for a whole Texinfo file.
-Non-nil argument (prefix, if interactive) means first update all
-existing nodes and menus.  Remove pre-existing master menu, if there is one.
-
-This function creates a master menu that follows the top node.  The
-master menu includes every entry from all the other menus.  It
-replaces any existing ordinary menu that follows the top node.
-
-If called with a non-nil argument, this function first updates all the
-menus in the buffer (incorporating descriptions from pre-existing
-menus) before it constructs the master menu.
-
-The function removes the detailed part of an already existing master
-menu.  This action depends on the pre-existing master menu using the
-standard `texinfo-master-menu-header'.
-
-The master menu has the following format, which is adapted from the
-recommendation in the Texinfo Manual:
-
-   * The first part contains the major nodes in the Texinfo file: the
-     nodes for the chapters, chapter-like sections, and the major
-     appendices.  This includes the indices, so long as they are in
-     chapter-like sections, such as unnumbered sections.
-
-   * The second and subsequent parts contain a listing of the other,
-     lower level menus, in order.  This way, an inquirer can go
-     directly to a particular node if he or she is searching for
-     specific information.
-
-Each of the menus in the detailed node listing is introduced by the
-title of the section containing the menu."
-          t nil)
-
-(autoload 'texinfo-indent-menu-description
-          "texnfo-upd"
-  "Indent every description in menu following point to COLUMN.  
-Non-nil argument (prefix, if interactive) means indent every
-description in every menu in the region.  Does not indent second and
-subsequent lines of a multi-line description."
-          t nil)
-
-(autoload 'texinfo-insert-node-lines
-          "texnfo-upd"
-  "Insert missing `@node' lines in region of Texinfo file.
-Non-nil argument (prefix, if interactive) means also to insert the
-section titles as node names; and also to insert the section titles as
-node names in pre-existing @node lines that lack names."
-          t nil)
-
-(autoload 'texinfo-start-menu-description
-          "texnfo-upd"
-  "In this menu entry, insert the node's section title as a description. 
-Position point at beginning of description ready for editing.
-Do not insert a title if the line contains an existing description.
-
-You will need to edit the inserted text since a useful description
-complements the node name rather than repeats it as a title does."
-          t nil)
-
-(autoload 'texinfo-multiple-files-update
-          "texnfo-upd"
-  "Update first node pointers in each file included in OUTER-FILE;
-create or update main menu in the outer file that refers to such nodes. 
-This does not create or update menus or pointers within the included files.
-
-With optional MAKE-MASTER-MENU argument (prefix arg, if interactive),
-insert a master menu in OUTER-FILE.  This does not create or update
-menus or pointers within the included files.
-
-With optional UPDATE-EVERYTHING argument (numeric prefix arg, if
-interactive), update all the menus and all the `Next', `Previous', and
-`Up' pointers of all the files included in OUTER-FILE before inserting
-a master menu in OUTER-FILE.
-
-The command also updates the `Top' level node pointers of OUTER-FILE.
-
-Notes: 
-
-  * this command does NOT save any files--you must save the
-    outer file and any modified, included files.
-
-  * except for the `Top' node, this command does NOT handle any
-    pre-existing nodes in the outer file; hence, indices must be
-    enclosed in an included file.
-
-Requirements:
-
-  * each of the included files must contain exactly one highest
-    hierarchical level node, 
-  * this highest node must be the first node in the included file,
-  * each highest hierarchical level node must be of the same type.
-
-Thus, normally, each included file contains one, and only one,
-chapter."
-          t nil)
-
-
-;;; Code:
-
-;;; Don't you dare insert any `require' calls at top level in this file--rms.
-
-;;; Syntax table
-
-(defvar texinfo-mode-syntax-table nil)
-
-(if texinfo-mode-syntax-table
-    nil
-  (setq texinfo-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\" " " texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\\ " " texinfo-mode-syntax-table)
-  (modify-syntax-entry ?@ "\\" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\^q "\\" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\[ "(]" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\] ")[" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?{ "(}" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?} "){" texinfo-mode-syntax-table)
-  (modify-syntax-entry ?\' "w" texinfo-mode-syntax-table))
-
-;; Written by Wolfgang Bangerth <zcg51122@rpool1.rus.uni-stuttgart.de>
-;; To override this example, set either `imenu-generic-expression'
-;; or `imenu-create-index-function'.
-(defvar texinfo-imenu-generic-expression
-  '((nil "^@node[ \t]+\\([^,\n]*\\)" 1)
-    ("Chapters" "^@chapter[ \t]+\\(.*\\)$" 1))
-
-  "Imenu generic expression for TexInfo mode.  See `imenu-generic-expression'.")
-
-(defvar texinfo-font-lock-keywords
-  '(;; All but the first 2 had an OVERRIDE of t.
-    ;; It didn't seem to be any better, and it's slower--simon.
-    ("^\\(@c\\|@comment\\)\\>.*" . font-lock-comment-face) 	;comments
-    ;; Robert J. Chassell <bob@gnu.ai.mit.edu> says remove this line.
-    ;("\\$\\([^$]*\\)\\$" 1 font-lock-string-face t)
-    ("@\\([a-zA-Z]+\\|[^ \t\n]\\)" 1 font-lock-keyword-face)	;commands
-    ("^\\*\\(.*\\)[\t ]*$" 1 font-lock-function-name-face t) 	;menu items
-    ("@\\(emph\\|strong\\|b\\|i\\){\\([^}]+\\)" 2 font-lock-comment-face)
-    ("@\\(file\\|kbd\\|key\\|url\\|email\\){\\([^}]+\\)" 2 font-lock-string-face)
-    ("@\\(samp\\|code\\|var\\|math\\){\\([^}]+\\)"
-     2 font-lock-variable-name-face)
-    ("@\\(cite\\|xref\\|pxref\\){\\([^}]+\\)" 2 font-lock-reference-face)
-    ("@\\(end\\|itemx?\\) +\\(.+\\)" 2 font-lock-function-name-face keep)
-    )
-  "Additional expressions to highlight in TeXinfo mode.")
-
-(defvar texinfo-section-list
-  '(("top" 1)
-    ("majorheading" 1)
-    ("chapter" 2)
-    ("unnumbered" 2)
-    ("appendix" 2)
-    ("chapheading" 2)
-    ("section" 3)
-    ("unnumberedsec" 3)
-    ("appendixsec" 3)
-    ("heading" 3)
-    ("subsection" 4)
-    ("unnumberedsubsec" 4)
-    ("appendixsubsec" 4)
-    ("subheading" 4)
-    ("subsubsection" 5)
-    ("unnumberedsubsubsec" 5)
-    ("appendixsubsubsec" 5)
-    ("subsubheading" 5))
-  "Alist of sectioning commands and their relative level.")
-
-(defun texinfo-outline-level ()
-  ;; Calculate level of current texinfo outline heading.
-  (save-excursion
-    (if (bobp)
-	0
-      (forward-char 1)
-      (let* ((word (buffer-substring-no-properties 
-		    (point) (progn (forward-word 1) (point))))
-	     (entry (assoc word texinfo-section-list)))
-	(if entry
-	    (nth 1 entry)
-	  5)))))
-
-;;; Keybindings
-(defvar texinfo-mode-map nil)
-
-;;; Keys common both to Texinfo mode and to TeX shell.
-
-(defun texinfo-define-common-keys (keymap)
-  "Define the keys both in Texinfo mode and in the texinfo-tex-shell."
-  (define-key keymap "\C-c\C-t\C-k"    'tex-kill-job)
-  (define-key keymap "\C-c\C-t\C-x"    'texinfo-quit-job)
-  (define-key keymap "\C-c\C-t\C-l"    'tex-recenter-output-buffer)
-  (define-key keymap "\C-c\C-t\C-d"    'texinfo-delete-from-print-queue)
-  (define-key keymap "\C-c\C-t\C-q"    'tex-show-print-queue)
-  (define-key keymap "\C-c\C-t\C-p"    'texinfo-tex-print)
-  (define-key keymap "\C-c\C-t\C-v"    'texinfo-tex-view)
-  (define-key keymap "\C-c\C-t\C-i"    'texinfo-texindex)
-
-  (define-key keymap "\C-c\C-t\C-r"    'texinfo-tex-region)
-  (define-key keymap "\C-c\C-t\C-b"    'texinfo-tex-buffer))
-
-;; Mode documentation displays commands in reverse order 
-;; from how they are listed in the texinfo-mode-map.
-
-(if texinfo-mode-map
-    nil
-  (setq texinfo-mode-map (make-sparse-keymap))
-
-  ;; bindings for `texnfo-tex.el'
-  (texinfo-define-common-keys texinfo-mode-map)
-
-  ;; bindings for `makeinfo.el'
-  (define-key texinfo-mode-map "\C-c\C-m\C-k" 'kill-compilation)
-  (define-key texinfo-mode-map "\C-c\C-m\C-l" 
-    'makeinfo-recenter-compilation-buffer)
-  (define-key texinfo-mode-map "\C-c\C-m\C-r" 'makeinfo-region)
-  (define-key texinfo-mode-map "\C-c\C-m\C-b" 'makeinfo-buffer)
-
-  ; Bindings for texinfmt.el.
-  (define-key texinfo-mode-map "\C-c\C-e\C-r"    'texinfo-format-region)
-  (define-key texinfo-mode-map "\C-c\C-e\C-b"    'texinfo-format-buffer)
-
-  ;; bindings for updating nodes and menus
-
-  (define-key texinfo-mode-map "\C-c\C-um"   'texinfo-master-menu)
-
-  (define-key texinfo-mode-map "\C-c\C-u\C-m"   'texinfo-make-menu)
-  (define-key texinfo-mode-map "\C-c\C-u\C-n"   'texinfo-update-node)
-  (define-key texinfo-mode-map "\C-c\C-u\C-e"   'texinfo-every-node-update)
-  (define-key texinfo-mode-map "\C-c\C-u\C-a"   'texinfo-all-menus-update)
-
-  (define-key texinfo-mode-map "\C-c\C-s"     'texinfo-show-structure)
-
-  (define-key texinfo-mode-map "\C-c}"    	'up-list)
-  (define-key texinfo-mode-map "\C-c{"    	'texinfo-insert-braces)
-
-  ;; bindings for inserting strings
-
-  (define-key texinfo-mode-map "\C-c\C-c\C-d" 'texinfo-start-menu-description)
-
-  (define-key texinfo-mode-map "\C-c\C-cv"    'texinfo-insert-@var)
-  (define-key texinfo-mode-map "\C-c\C-ct"    'texinfo-insert-@table)
-  (define-key texinfo-mode-map "\C-c\C-cs"    'texinfo-insert-@samp)
-  (define-key texinfo-mode-map "\C-c\C-co"    'texinfo-insert-@noindent)
-  (define-key texinfo-mode-map "\C-c\C-cn"    'texinfo-insert-@node)
-  (define-key texinfo-mode-map "\C-c\C-ck"    'texinfo-insert-@kbd)
-  (define-key texinfo-mode-map "\C-c\C-ci"    'texinfo-insert-@item)
-  (define-key texinfo-mode-map "\C-c\C-cf"    'texinfo-insert-@file)
-  (define-key texinfo-mode-map "\C-c\C-cx"    'texinfo-insert-@example)
-  (define-key texinfo-mode-map "\C-c\C-ce"    'texinfo-insert-@end)
-  (define-key texinfo-mode-map "\C-c\C-cd"    'texinfo-insert-@dfn)
-  (define-key texinfo-mode-map "\C-c\C-cc"    'texinfo-insert-@code))
-
-
-;;; Texinfo mode
-
-(defvar texinfo-chapter-level-regexp 
-  "chapter\\|unnumbered \\|appendix \\|majorheading\\|chapheading"
-  "Regular expression matching Texinfo chapter-level headings.
-This does not match `@node' and does not match the `@top' command.")
-
-;;;###autoload
-(defun texinfo-mode ()
-  "Major mode for editing Texinfo files.
-
-  It has these extra commands:
-\\{texinfo-mode-map}
-
-  These are files that are used as input for TeX to make printed manuals
-and also to be turned into Info files with \\[makeinfo-buffer] or
-the `makeinfo' program.  These files must be written in a very restricted and
-modified version of TeX input format.
-
-  Editing commands are like text-mode except that the syntax table is
-set up so expression commands skip Texinfo bracket groups.  To see
-what the Info version of a region of the Texinfo file will look like,
-use \\[makeinfo-region], which runs `makeinfo' on the current region.
-
-  You can show the structure of a Texinfo file with \\[texinfo-show-structure].
-This command shows the structure of a Texinfo file by listing the
-lines with the @-sign commands for @chapter, @section, and the like.
-These lines are displayed in another window called the *Occur* window.
-In that window, you can position the cursor over one of the lines and
-use \\[occur-mode-goto-occurrence], to jump to the corresponding spot
-in the Texinfo file.
-
-  In addition, Texinfo mode provides commands that insert various
-frequently used @-sign commands into the buffer.  You can use these
-commands to save keystrokes.  And you can insert balanced braces with
-\\[texinfo-insert-braces] and later use the command \\[up-list] to
-move forward past the closing brace.
-
-Also, Texinfo mode provides functions for automatically creating or
-updating menus and node pointers.  These functions
-
-  * insert the `Next', `Previous' and `Up' pointers of a node,
-  * insert or update the menu for a section, and
-  * create a master menu for a Texinfo source file.
-
-Here are the functions:
-
-    texinfo-update-node                \\[texinfo-update-node]
-    texinfo-every-node-update          \\[texinfo-every-node-update]
-    texinfo-sequential-node-update 
-
-    texinfo-make-menu                  \\[texinfo-make-menu]
-    texinfo-all-menus-update           \\[texinfo-all-menus-update]
-    texinfo-master-menu
-
-    texinfo-indent-menu-description (column &optional region-p)
-
-The `texinfo-column-for-description' variable specifies the column to
-which menu descriptions are indented. 
-
-Passed an argument (a prefix argument, if interactive), the
-`texinfo-update-node' and `texinfo-make-menu' functions do their jobs
-in the region.
-
-To use the updating commands, you must structure your Texinfo file
-hierarchically, such that each `@node' line, with the exception of the
-Top node, is accompanied by some kind of section line, such as an
-`@chapter' or `@section' line.
-
-If the file has a `top' node, it must be called `top' or `Top' and
-be the first node in the file.
-
-Entering Texinfo mode calls the value of text-mode-hook, and then the
-value of texinfo-mode-hook."
-  (interactive)
-  (text-mode)
-  (setq mode-name "Texinfo")
-  (setq major-mode 'texinfo-mode)
-  (use-local-map texinfo-mode-map)
-  (set-syntax-table texinfo-mode-syntax-table)
-  (make-local-variable 'page-delimiter)
-  (setq page-delimiter 
-        (concat 
-         "^@node [ \t]*[Tt]op\\|^@\\(" 
-         texinfo-chapter-level-regexp 
-         "\\)"))
-  (make-local-variable 'require-final-newline)
-  (setq require-final-newline t)
-  (make-local-variable 'indent-tabs-mode)
-  (setq indent-tabs-mode nil)
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-separate))
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "\b\\|@[a-zA-Z]*[ \n]\\|" paragraph-start))
-  (make-local-variable 'fill-column)
-  (setq fill-column 72)
-  (make-local-variable 'comment-start)
-  (setq comment-start "@c ")
-  (make-local-variable 'comment-start-skip)
-  (setq comment-start-skip "@c +")
-  (make-local-variable 'words-include-escapes)
-  (setq words-include-escapes t)
-  (make-local-variable 'imenu-generic-expression)
-  (setq imenu-generic-expression texinfo-imenu-generic-expression)
-  (make-local-variable 'font-lock-defaults)
-  (setq font-lock-defaults '(texinfo-font-lock-keywords t))
-  (make-local-variable 'outline-regexp)
-  (setq outline-regexp 
-	(concat "@\\("
-		(mapconcat 'car texinfo-section-list "\\>\\|")
-		"\\>\\)"))
-  (make-local-variable 'outline-level)
-  (setq outline-level 'texinfo-outline-level)
-  (make-local-variable 'tex-start-of-header)
-  (setq tex-start-of-header "%\\*\\*start")
-  (make-local-variable 'tex-end-of-header)
-  (setq tex-end-of-header "%\\*\\*end")
-  (make-local-variable 'tex-first-line-header-regexp)
-  (setq tex-first-line-header-regexp "^\\\\input")
-  (make-local-variable 'tex-trailer)
-  (setq tex-trailer "@bye\n")
-  (run-hooks 'text-mode-hook 'texinfo-mode-hook))
-
-
-;;; Insert string commands
-
-(defconst texinfo-environment-regexp
-  "^[ \t]*@\\(f?table\\|enumerate\\|itemize\
-\\|ifhtml\\|ifinfo\\|iftex\\|ifset\\|ifclear\
-\\|example\\|quotation\\|lisp\\|smallexample\\|smalllisp\\|display\\|format\
-\\|flushleft\\|flushright\\|ignore\\|group\\|tex\\|html\\|cartouche\\|menu\
-\\|titlepage\\|end\\|def[a-z]*[a-wyz]\\>\\)"
-  "Regexp for environment-like Texinfo list commands.
-Subexpression 1 is what goes into the corresponding `@end' statement.")
-
-(defun texinfo-insert-@end ()
-  "Insert the matching `@end' for the last Texinfo command that needs one."
-  (interactive)
-  (let ((depth 1) string)
-    (save-excursion
-      (while (and (> depth 0)
-		  (re-search-backward texinfo-environment-regexp nil t)
-	(if (looking-at "@end")
-	    (setq depth (1+ depth))
-	  (setq depth (1- depth)))))
-      (looking-at texinfo-environment-regexp)
-      (if (zerop depth)
-	  (setq string
-		(buffer-substring (match-beginning 1)
-				  (match-end 1)))))
-    (insert "@end ")
-    (if string (insert string "\n"))))
-
-;; The following insert commands accept a prefix arg N, which is the
-;; number of words (actually s-exprs) that should be surrounded by
-;; braces.  Thus you can first paste a variable name into a .texinfo
-;; buffer, then say C-u 1 C-c C-c v at the beginning of the just
-;; pasted variable name to put @var{...} *around* the variable name.
-;; Operate on previous word or words with negative arg.
-
-;; These commands use texinfo-insert-@-with-arg
-(defun texinfo-insert-@-with-arg (string &optional arg)
-  (if arg 
-      (progn
-        (setq arg (prefix-numeric-value arg))
-        (if (< arg 0)
-            (progn
-              (skip-chars-backward " \t\n\r\f")
-              (save-excursion
-                (forward-sexp arg)
-                (insert "@" string "{"))
-              (insert "}"))
-          (skip-chars-forward " \t\n\r\f")
-          (insert "@" string "{")
-          (forward-sexp arg)
-          (insert "}")))
-    (insert "@" string "{}")
-    (backward-char)))
-
-(defun texinfo-insert-braces ()
-  "Make a pair of braces and be poised to type inside of them.
-Use \\[up-list] to move forward out of the braces."
-  (interactive)
-  (insert "{}")
-  (backward-char))
-
-(defun texinfo-insert-@code (&optional arg)
-  "Insert a `@code{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "code" arg))
-
-(defun texinfo-insert-@dfn (&optional arg)
-  "Insert a `@dfn{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "dfn" arg))
-
-(defun texinfo-insert-@example ()
-  "Insert the string `@example' in a Texinfo buffer."
-  (interactive)
-  (insert "@example\n"))
-
-(defun texinfo-insert-@file (&optional arg)
-  "Insert a `@file{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "file" arg))
-
-(defun texinfo-insert-@item ()
-  "Insert the string `@item' in a Texinfo buffer."
-  (interactive)
-  (insert "@item")
-  (newline))
-
-(defun texinfo-insert-@kbd (&optional arg)
-  "Insert a `@kbd{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "kbd" arg))
-
-(defun texinfo-insert-@node ()
-  "Insert the string `@node' in a Texinfo buffer.
-This also inserts on the following line a comment indicating
-the order of arguments to @node."
-  (interactive)
-  (insert "@node \n@comment  node-name,  next,  previous,  up")
-  (forward-line -1)
-  (forward-char 6))
-
-(defun texinfo-insert-@noindent ()
-  "Insert the string `@noindent' in a Texinfo buffer."
-  (interactive)
-  (insert "@noindent\n"))
-
-(defun texinfo-insert-@samp (&optional arg)
-  "Insert a `@samp{...}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "samp" arg))
-
-(defun texinfo-insert-@table (&optional arg)
-  "Insert the string `@table' in a Texinfo buffer."
-  (interactive "P")
-  (insert "@table "))
-
-(defun texinfo-insert-@var (&optional arg)
-  "Insert a `@var{}' command in a Texinfo buffer.
-A numeric argument says how many words the braces should surround.
-The default is not to surround any existing words with the braces."
-  (interactive "P")
-  (texinfo-insert-@-with-arg "var" arg))
-
-;;; Texinfo file structure
-
-;; These are defined in tenfo-upd.el.
-(defvar texinfo-section-types-regexp)
-(defvar texinfo-section-level-regexp)
-(defvar texinfo-subsection-level-regexp)
-(defvar texinfo-subsubsection-level-regexp)
-
-(defun texinfo-show-structure (&optional nodes-too) 
-  "Show the structure of a Texinfo file.
-List the lines in the file that begin with the @-sign commands for
-@chapter, @section, and the like.
-
-With optional argument (prefix if interactive), list both the lines
-with @-sign commands for @chapter, @section, and the like, and list
-@node lines.
-
-Lines with structuring commands beginning in them are displayed in
-another buffer named `*Occur*'.  In that buffer, you can move point to
-one of those lines and then use \\<occur-mode-map>\\[occur-mode-goto-occurrence], 
-to jump to the corresponding spot in the Texinfo source file."
-
-  (interactive "P")
-  (require 'texnfo-upd)
-  (save-excursion 
-    (goto-char (point-min))
-    (if nodes-too
-        (occur (concat "\\(^@node\\)\\|" texinfo-section-types-regexp))
-      (occur texinfo-section-types-regexp)))
-  (pop-to-buffer "*Occur*")
-  (goto-char (point-min))
-  (flush-lines "-----")
-  ;; Now format the "*Occur*" buffer to show the structure.
-  ;; Thanks to ceder@signum.se (Per Cederqvist)
-  (goto-char (point-max))
-  (let ((margin 5))
-    (while (re-search-backward "^ *[0-9]*:" nil 0)
-      (re-search-forward ":")
-      (setq margin
-            (cond
-             ((looking-at
-               (concat "@\\(" texinfo-chapter-level-regexp "\\)")) 5)
-             ;; ((looking-at "@chapter ") 5)
-             ;; ((looking-at "@unnumbered ") 5)
-             ;; ((looking-at "@appendix ") 5)
-             ;; ((looking-at "@majorheading ") 5)
-             ;; ((looking-at "@chapheading ") 5)
-
-             ((looking-at
-               (concat "@\\(" texinfo-section-level-regexp "\\)")) 9)
-             ;; ((looking-at "@section ") 9)
-             ;; ((looking-at "@unnumberedsec ") 9)
-             ;; ((looking-at "@appendixsec ") 9)
-             ;; ((looking-at "@heading ") 9)
-
-             ((looking-at 
-               (concat "@\\(" texinfo-subsection-level-regexp "\\)")) 13)
-             ;; ((looking-at "@subsection ") 13)
-             ;; ((looking-at "@unnumberedsubsec ") 13)
-             ;; ((looking-at "@appendixsubsec ") 13)
-             ;; ((looking-at "@subheading ") 13)
-
-             ((looking-at 
-               (concat "@\\(" texinfo-subsubsection-level-regexp "\\)")) 17)
-             ;; ((looking-at "@subsubsection ") 17)
-             ;; ((looking-at "@unnumberedsubsubsec ") 17)
-             ;; ((looking-at "@appendixsubsubsec ") 17)
-             ;; ((looking-at "@subsubheading ") 17)
-             (t margin)))
-      (indent-to-column margin)
-      (beginning-of-line))))
-
-;;; The  tex  and  print  function definitions:
-
-(defvar texinfo-texi2dvi-command "texi2dvi"
-  "*Command used by `texinfo-tex-buffer' to run TeX and texindex on a buffer.")
-
-(defvar texinfo-tex-command "tex"
-  "*Command used by `texinfo-tex-region' to run TeX on a region.")
-
-(defvar texinfo-texindex-command "texindex"
-  "*Command used by `texinfo-texindex' to sort unsorted index files.")
-
-(defvar texinfo-delete-from-print-queue-command "lprm"
-  "*Command string used to delete a job from the line printer queue.
-Command is used by \\[texinfo-delete-from-print-queue] based on
-number provided by a previous \\[tex-show-print-queue]
-command.")
-
-(defvar texinfo-tex-trailer "@bye"
-  "String appended after a region sent to TeX by `texinfo-tex-region'.")
-
-(defun texinfo-tex-region (beg end)
-  "Run TeX on the current region.
-This works by writing a temporary file (`tex-zap-file') in the directory
-that is the value of `tex-directory', then running TeX on that file.
-
-The first line of the buffer is copied to the
-temporary file; and if the buffer has a header, it is written to the
-temporary file before the region itself.  The buffer's header is all lines
-between the strings defined by `tex-start-of-header' and `tex-end-of-header'
-inclusive.  The header must start in the first 100 lines.
-
-The value of `texinfo-tex-trailer' is appended to the temporary file after the region."
-  (interactive "r")
-  (require 'tex-mode)
-  (let ((tex-command texinfo-tex-command)
-	(tex-trailer "@bye\n"))
-    (tex-region beg end)))
-
-(defun texinfo-tex-buffer ()
-  "Run TeX on visited file, once or twice, to make a correct `.dvi' file."
-  (interactive)
-  (require 'tex-mode)
-  (let ((tex-command texinfo-texi2dvi-command))
-    (tex-buffer)))
-
-(defun texinfo-texindex ()
-  "Run `texindex' on unsorted index files.
-The index files are made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
-This runs the shell command defined by `texinfo-texindex-command'."
-  (interactive)
-  (require 'tex-mode)
-  (tex-send-command texinfo-texindex-command (concat tex-zap-file ".??"))
-  (tex-recenter-output-buffer nil))
-
-(defun texinfo-tex-print ()
-  "Print `.dvi' file made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
-This runs the shell command defined by `tex-dvi-print-command'."
-  (interactive)
-  (require 'tex-mode)
-  (tex-print))
-
-(defun texinfo-tex-view ()
-  "View `.dvi' file made by \\[texinfo-tex-region] or \\[texinfo-tex-buffer].
-This runs the shell command defined by `tex-dvi-view-command'."
-  (interactive)
-  (require 'tex-mode)
-  (tex-view))
-
-(defun texinfo-quit-job ()
-  "Quit currently running TeX job, by sending an `x' to it."
-  (interactive)
-  (if (not (get-process "tex-shell"))
-      (error "No TeX shell running"))
-  (tex-send-command "x"))
-
-(defun texinfo-delete-from-print-queue (job-number)
-  "Delete job from the line printer spooling queue.
-You are prompted for the job number (use a number shown by a previous
-\\[texinfo-show-print-queue] command)."
-  (interactive "nPrinter job number for deletion: ")
-  (require 'tex-mode)
-  (if (tex-shell-running)
-      (tex-kill-job)
-    (tex-start-shell))
-  (tex-send-command texinfo-delete-from-print-queue-command job-number)
-  (tex-recenter-output-buffer nil))
-
-(provide 'texinfo)
-
-;;; texinfo.el ends here
diff --git a/lisp/textmodes/texnfo-upd.el b/lisp/textmodes/texnfo-upd.el
deleted file mode 100644
index e44ef6ba8db..00000000000
--- a/lisp/textmodes/texnfo-upd.el
+++ /dev/null
@@ -1,2049 +0,0 @@
-;;; texnfo-upd.el --- utilities for updating nodes and menus in Texinfo files
-
-;; Copyright (C) 1989, 1990, 1991, 1992 Free Software Foundation, Inc.
-
-;; Author: Robert J. Chassell      
-;; Maintainer: bug-texinfo@prep.ai.mit.edu
-;; Keywords: maint, tex, docs
-
-;; 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:
-
-;; Known bug: update commands fail to ignore @ignore.
-
-;; Summary: how to use the updating commands
-
-;; The node and menu updating functions automatically
-
-;;   * insert missing `@node' lines,
-;;   * insert the `Next', `Previous' and `Up' pointers of a node,
-;;   * insert or update the menu for a section, 
-;;   * create a master menu for a Texinfo source file.
-;;
-;; Passed an argument, the `texinfo-update-node' and
-;; `texinfo-make-menu' functions do their jobs in the region.
-;;
-;; In brief, the functions for creating or updating nodes and menus, are:
-;; 
-;;     texinfo-update-node (&optional region-p)            
-;;     texinfo-every-node-update ()                        
-;;     texinfo-sequential-node-update (&optional region-p)
-;; 
-;;     texinfo-make-menu (&optional region-p)              
-;;     texinfo-all-menus-update ()                         
-;;     texinfo-master-menu ()
-;;
-;;     texinfo-insert-node-lines  (&optional title-p)
-;; 
-;;     texinfo-indent-menu-description (column &optional region-p)
-
-;; The `texinfo-column-for-description' variable specifies the column to
-;; which menu descriptions are indented. 
-
-;; Texinfo file structure
-;; ----------------------
-
-;; To use the updating commands, you must structure your Texinfo file
-;; hierarchically.  Each `@node' line, with the exception of the top
-;; node, must be accompanied by some kind of section line, such as an
-;; `@chapter' or `@section' line.  Each node-line/section-line
-;; combination must look like this:
-
-;;      @node    Lists and Tables, Cross References, Structuring, Top
-;;      @comment node-name,        next,             previous,    up
-;;      @chapter Making Lists and Tables
-
-;; or like this (without the `@comment' line):
-
-;;      @node    Lists and Tables, Cross References, Structuring, Top
-;;      @chapter Making Lists and Tables
-
-;; If the file has a `top' node, it must be called `top' or `Top' and
-;; be the first node in the file.
-
-
-;;; The update node functions described in detail
-
-;; The `texinfo-update-node' function without an argument inserts
-;; the correct next, previous and up pointers for the node in which
-;; point is located (i.e., for the node preceding point).
-
-;; With an argument, the `texinfo-update-node' function inserts the
-;; correct next, previous and up pointers for the nodes inside the
-;; region.
-
-;; It does not matter whether the  `@node' line has pre-existing
-;; `Next', `Previous', or `Up' pointers in it.  They are removed.
-
-;; The `texinfo-every-node-update' function runs `texinfo-update-node'
-;; on the whole buffer.
-
-;; The `texinfo-sequential-node-update' function inserts the
-;; immediately following and preceding node into the `Next' or
-;; `Previous' pointers regardless of their hierarchical level.  This is
-;; only useful for certain kinds of text, like a novel, which you go
-;; through sequentially.
-
-
-;;; The menu making functions described in detail
-
-;; The `texinfo-make-menu' function without an argument creates or
-;; updates a menu for the section encompassing the node that follows
-;; point.  With an argument, it makes or updates menus for the nodes
-;; within or part of the marked region.
-
-;; Whenever an existing menu is updated, the descriptions from
-;; that menu are incorporated into the new menu.  This is done by copying
-;; descriptions from the existing menu to the entries in the new menu
-;; that have the same node names.  If the node names are different, the
-;; descriptions are not copied to the new menu.
-
-;; Menu entries that refer to other Info files are removed since they
-;; are not a node within current buffer.  This is a deficiency.
-
-;; The `texinfo-all-menus-update' function runs `texinfo-make-menu'
-;; on the whole buffer.
-
-;; The `texinfo-master-menu' function creates an extended menu located
-;; after the top node.  (The file must have a top node.)  The function
-;; first updates all the regular menus in the buffer (incorporating the
-;; descriptions from pre-existing menus), and then constructs a master
-;; menu that includes every entry from every other menu.  (However, the
-;; function cannot update an already existing master menu; if one
-;; exists, it must be removed before calling the function.)
-
-;; The `texinfo-indent-menu-description' function indents every
-;; description in the menu following point, to the specified column.
-;; Non-nil argument (prefix, if interactive) means indent every
-;; description in every menu in the region.  This function does not
-;; indent second and subsequent lines of a multi-line description.
-
-;; The `texinfo-insert-node-lines' function inserts `@node' before the
-;; `@chapter', `@section', and such like lines of a region in a Texinfo
-;; file where the `@node' lines are missing.
-;; 
-;; With a non-nil argument (prefix, if interactive), the function not
-;; only inserts `@node' lines but also inserts the chapter or section
-;; titles as the names of the corresponding nodes; and inserts titles
-;; as node names in pre-existing `@node' lines that lack names.
-;; 
-;; Since node names should be more concise than section or chapter
-;; titles, node names so inserted will need to be edited manually.
-
- 
-;;; Code:
-
-;;; The menu making functions
-
-(defun texinfo-make-menu (&optional region-p)
-  "Without any prefix argument, make or update a menu.
-Make the menu for the section enclosing the node found following point.
-
-Non-nil argument (prefix, if interactive) means make or update menus
-for nodes within or part of the marked region.
-
-Whenever a menu exists, and is being updated, the descriptions that
-are associated with node names in the pre-existing menu are
-incorporated into the new menu.  Otherwise, the nodes' section titles
-are inserted as descriptions."
-  
-  (interactive "P")
-  (if (not region-p)
-      (let ((level (texinfo-hierarchic-level)))
-        (texinfo-make-one-menu level)
-        (message "Done...updated the menu.  You may save the buffer."))
-    ;; else
-    (message "Making or updating menus in %s... " (buffer-name))
-    (let ((beginning (region-beginning))
-	  (region-end (region-end))
-          (level (progn         ; find section type following point
-                   (goto-char (region-beginning))
-                   (texinfo-hierarchic-level))))
-      (if (= region-end beginning)
-          (error "Please mark a region!"))
-      (save-excursion
-        (save-restriction
-          (widen)
-          
-          (while  (texinfo-find-lower-level-node level region-end)
-            (setq level (texinfo-hierarchic-level)) ; new, lower level
-            (texinfo-make-one-menu level))
-          
-          (while (and (< (point) region-end)
-                      (texinfo-find-higher-level-node level region-end))
-            (setq level (texinfo-hierarchic-level))
-            (while (texinfo-find-lower-level-node level region-end)
-              (setq level (texinfo-hierarchic-level)) ; new, lower level
-              (texinfo-make-one-menu level))))))
-    (message "Done...updated menus.  You may save the buffer.")))
-
-(defun texinfo-make-one-menu (level)
-  "Make a menu of all the appropriate nodes in this section.
-`Appropriate nodes' are those associated with sections that are 
-at the level specified by LEVEL.  Point is left at the end of menu."
-  (let*
-      ((case-fold-search t)
-       (beginning
-	(save-excursion
-	  (goto-char (texinfo-update-menu-region-beginning level))
-	  (end-of-line)
-	  (point)))
-       (end (texinfo-update-menu-region-end level))
-       (first (texinfo-menu-first-node beginning end))
-       (node-name (progn
-                    (goto-char beginning)
-                    (beginning-of-line)
-                    (texinfo-copy-node-name)))
-       (new-menu-list (texinfo-make-menu-list beginning end level)))
-    (if (texinfo-old-menu-p beginning first)
-        (progn
-          (texinfo-incorporate-descriptions new-menu-list)
-          (texinfo-incorporate-menu-entry-names new-menu-list)
-          (texinfo-delete-old-menu beginning first)))
-    (texinfo-insert-menu new-menu-list node-name)))
-
-(defun texinfo-all-menus-update (&optional update-all-nodes-p)
-  "Update every regular menu in a Texinfo file.
-Update pre-existing master menu, if there is one.
-
-If called with a non-nil argument, this function first updates all the
-nodes in the buffer before updating the menus."
-  (interactive "P")
-  (let ((case-fold-search t)
-        master-menu-p)
-    (save-excursion
-      (push-mark (point-max) t)
-      (goto-char (point-min))
-      (message "Checking for a master menu in %s ... "(buffer-name))
-      (save-excursion
-        (if (re-search-forward texinfo-master-menu-header nil t)
-            ;; Remove detailed master menu listing
-            (progn
-              (setq master-menu-p t)
-              (goto-char (match-beginning 0))
-              (let ((end-of-detailed-menu-descriptions
-                     (save-excursion     ; beginning of end menu line
-                       (goto-char (texinfo-menu-end))
-                       (beginning-of-line) (forward-char -1)
-                       (point))))
-                (delete-region (point) end-of-detailed-menu-descriptions)))))
-      
-      (if update-all-nodes-p
-          (progn
-            (message "Updating all nodes in %s ... " (buffer-name))
-            (sleep-for 2)
-            (push-mark (point-max) t)
-            (goto-char (point-min))
-	    ;; Using the mark to pass bounds this way
-	    ;; is kludgy, but it's not worth fixing. -- rms.
-	    (let ((mark-active t))
-	      (texinfo-update-node t))))
-      
-      (message "Updating all menus in %s ... " (buffer-name))        
-      (sleep-for 2)
-      (push-mark (point-max) t)
-      (goto-char (point-min))
-      ;; Using the mark to pass bounds this way
-      ;; is kludgy, but it's not worth fixing. -- rms.
-      (let ((mark-active t))
-	(texinfo-make-menu t))
-      
-      (if master-menu-p
-          (progn
-            (message "Updating the master menu in %s... " (buffer-name))
-            (sleep-for 2)
-            (texinfo-master-menu nil))))
-    
-    (message "Done...updated all the menus.  You may save the buffer.")))
-
-(defun texinfo-find-lower-level-node (level region-end)
-  "Search forward from point for node at any level lower than LEVEL.
-Search is limited to the end of the marked region, REGION-END, 
-and to the end of the menu region for the level.
-
-Return t if the node is found, else nil.  Leave point at the beginning
-of the node if one is found; else do not move point."
-  (let ((case-fold-search t))
-    (if (and (< (point) region-end)
-             (re-search-forward
-              (concat
-               "\\(^@node\\).*\n"         ; match node line
-               "\\(\\(\\(^@c\\).*\n\\)"   ; match comment line, if any
-               "\\|"                      ; or
-               "\\(^@ifinfo[ ]*\n\\)\\)?" ; ifinfo line, if any
-               (eval (cdr (assoc level texinfo-update-menu-lower-regexps))))
-              ;; the next higher level node marks the end of this
-              ;; section, and no lower level node will be found beyond
-              ;; this position even if region-end is farther off
-              (texinfo-update-menu-region-end level) 
-              t))
-        (goto-char (match-beginning 1)))))
-
-(defun texinfo-find-higher-level-node (level region-end)
-  "Search forward from point for node at any higher level than argument LEVEL.
-Search is limited to the end of the marked region, REGION-END.
-
-Return t if the node is found, else nil.  Leave point at the beginning
-of the node if one is found; else do not move point."
-  (let ((case-fold-search t))
-    (cond
-     ((or (string-equal "top" level) (string-equal "chapter" level))
-      (if (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" region-end t)
-          (progn (beginning-of-line) t)))
-     (t
-      (if (re-search-forward
-           (concat
-            "\\(^@node\\).*\n"              ; match node line
-            "\\(\\(\\(^@c\\).*\n\\)"        ; match comment line, if any
-            "\\|"                           ; or
-            "\\(^@ifinfo[ ]*\n\\)\\)?"      ; ifinfo line, if any
-            (eval (cdr (assoc level texinfo-update-menu-higher-regexps))))
-           region-end t)
-          (progn (beginning-of-line) t))))))
-
-
-;;; Making the list of new menu entries
-
-(defun texinfo-make-menu-list (beginning end level)
-  "Make a list of node names and their descriptions.
-Point is left at the end of the menu region, but the menu is not inserted.
-
-First argument is position from which to start making menu list; 
-second argument is end of region in which to try to locate entries;
-third argument is the level of the nodes that are the entries.
-
-Node names and descriptions are dotted pairs of strings.  Each pair is
-an element of the list.  If the description does not exist, the
-element consists only of the node name."
-  (goto-char beginning)
-  (let (new-menu-list)
-    (while (texinfo-menu-locate-entry-p level end)
-      (setq new-menu-list 
-            (cons (cons 
-                   (texinfo-copy-node-name)
-                   (prog1 "" (forward-line 1)))
-                   ;; Use following to insert section titles automatically.
-                   ;; (texinfo-copy-section-title))
-                  new-menu-list)))
-    (reverse new-menu-list)))
-
-(defun texinfo-menu-locate-entry-p (level search-end)
-  "Find a node that will be part of menu for this section.
-First argument is a string such as \"section\" specifying the general
-hierarchical level of the menu; second argument is a position
-specifying the end of the search.
-
-The function returns t if the node is found, else nil.  It searches
-forward from point, and leaves point at the beginning of the node.
-
-The function finds entries of the same type.  Thus `subsections' and
-`unnumberedsubsecs' will appear in the same menu."
-  (let ((case-fold-search t))
-    (if (re-search-forward
-         (concat
-          "\\(^@node\\).*\n"              ; match node line
-          "\\(\\(\\(^@c\\).*\n\\)"        ; match comment line, if any
-          "\\|"                           ; or
-          "\\(^@ifinfo[ ]*\n\\)\\)?"      ; ifinfo line, if any
-          (eval
-           (cdr (assoc level texinfo-update-menu-same-level-regexps))))
-         search-end
-         t)
-        (goto-char (match-beginning 1)))))
-
-(defun texinfo-copy-node-name ()
-  "Return the node name as a string.
-
-Start with point at the beginning of the node line; copy the text
-after the node command up to the first comma on the line, if any, and
-return the text as a string.  Leaves point at the beginning of the
-line.  If there is no node name, returns an empty string."
-  
-  (save-excursion
-    (buffer-substring
-     (progn (forward-word 1)              ; skip over node command
-            (skip-chars-forward " \t")    ; and over spaces
-            (point))
-     (if (search-forward
-          ","
-          (save-excursion (end-of-line) (point)) t) ; bound search
-         (1- (point))
-       (end-of-line) (point)))))
-
-(defun texinfo-copy-section-title ()
-  "Return the title of the section as a string.
-The title is used as a description line in the menu when one does not
-already exist.
-
-Move point to the beginning of the appropriate section line by going
-to the start of the text matched by last regexp searched for, which
-must have been done by `texinfo-menu-locate-entry-p'."
-
-  ;; could use the same re-search as in `texinfo-menu-locate-entry-p'
-  ;; instead of using `match-beginning'; such a variation would be
-  ;; more general, but would waste information already collected
-
-  (goto-char (match-beginning 7))       ; match section name 
-
-  (buffer-substring
-   (progn (forward-word 1)              ; skip over section type
-          (skip-chars-forward " \t")    ; and over spaces
-          (point))
-   (progn (end-of-line) (point))))
-
-
-;;; Handling the old menu
-
-(defun texinfo-old-menu-p (beginning first)
-  "Move point to the beginning of the menu for this section, if any.
-Otherwise move point to the end of the first node of this section.
-Return t if a menu is found, nil otherwise.
-
-First argument is the position of the beginning of the section in which
-the menu will be located; second argument is the position of the first
-node within the section.
-
-If no menu is found, the function inserts two newlines just before the
-end of the section, and leaves point there where a menu ought to be."
-  (goto-char beginning)
-  (if (not (re-search-forward "^@menu" first 'goto-end))
-      (progn (insert "\n\n") (forward-line -2) nil)
-    t))
-
-(defun texinfo-incorporate-descriptions (new-menu-list)
-  "Copy the old menu line descriptions that exist to the new menu.
-
-Point must be at beginning of old menu.
-
-If the node-name of the new menu is found in the old menu, insert the
-old description into the new entry.
-
-For this function, the new menu is a list made up of lists of dotted
-pairs in which the first element of the pair is the node name and the
-second element the description.  The new menu is changed destructively.
-The old menu is the menu as it appears in the texinfo file."
-  
-  (let ((new-menu-list-pointer new-menu-list)
-        (end-of-menu (texinfo-menu-end)))
-    (while new-menu-list
-      (save-excursion                   ; keep point at beginning of menu 
-        (if (re-search-forward
-             ;; Existing nodes can have the form
-             ;;     * NODE NAME:: DESCRIPTION
-             ;; or
-             ;;     * MENU ITEM: NODE NAME.     DESCRIPTION.
-             ;; 
-             ;; Recognize both when looking for the description.
-             (concat "\\* \\("              ; so only menu entries are found
-                     (car (car new-menu-list)) "::"
-                     "\\|"
-                     ".*: " (car (car new-menu-list)) "[.,\t\n]"
-                     "\\)"
-                     )               ; so only complete entries are found
-             end-of-menu
-             t) 
-            (setcdr (car new-menu-list) 
-                    (texinfo-menu-copy-old-description end-of-menu))))
-      (setq new-menu-list (cdr new-menu-list))) 
-    (setq new-menu-list new-menu-list-pointer)))
-
-(defun texinfo-incorporate-menu-entry-names (new-menu-list)
-  "Copy any old menu entry names to the new menu.
-
-Point must be at beginning of old menu.
-
-If the node-name of the new menu entry cannot be found in the old
-menu, do nothing.
-
-For this function, the new menu is a list made up of lists of dotted
-pairs in which the first element of the pair is the node name and the
-second element is the description (or nil).
-
-If we find an existing menu entry name, we change the first element of
-the pair to be another dotted pair in which the car is the menu entry
-name and the cdr is the node name.
-
-NEW-MENU-LIST is changed destructively.  The old menu is the menu as it
-appears in the texinfo file."
-  
-  (let ((new-menu-list-pointer new-menu-list)
-        (end-of-menu (texinfo-menu-end)))
-    (while new-menu-list
-      (save-excursion                   ; keep point at beginning of menu 
-        (if (re-search-forward
-             ;; Existing nodes can have the form
-             ;;     * NODE NAME:: DESCRIPTION
-             ;; or
-             ;;     * MENU ITEM: NODE NAME.     DESCRIPTION.
-             ;; 
-             ;; We're interested in the second case.
-             (concat "\\* "              ; so only menu entries are found
-                     "\\(.*\\): " (car (car new-menu-list))  "[.,\t\n]")
-             end-of-menu
-             t)
-            (setcar
-              (car new-menu-list)  ; replace the node name
-              (cons (buffer-substring (match-beginning 1) (match-end 1))
-                    (car (car new-menu-list)))))
-      (setq new-menu-list (cdr new-menu-list))))
-    (setq new-menu-list new-menu-list-pointer)))
-
-(defun texinfo-menu-copy-old-description (end-of-menu)
-  "Return description field of old menu line as string.
-Point must be located just after the node name.  Point left before description.
-Single argument, END-OF-MENU, is position limiting search."
-  (skip-chars-forward "[:.,\t\n ]+")
-  ;; don't copy a carriage return at line beginning with asterisk!
-  ;; do copy a description that begins with an `@'!
-  ;; !! Known bug: does not copy descriptions starting with ^|\{?* etc.
-  (if (and (looking-at "\\(\\w+\\|@\\)")    
-           (not (looking-at "\\(^\\* \\|^@end menu\\)")))  
-      (buffer-substring
-       (point)
-       (save-excursion
-         (re-search-forward "\\(^\\* \\|^@end menu\\)" end-of-menu t)
-         (forward-line -1)
-         (end-of-line)                  ; go to end of last description line
-         (point)))
-    ""))
-
-(defun texinfo-menu-end ()
-  "Return position of end of menu. Does not change location of point.
-Signal an error if not end of menu."
-  (save-excursion
-    (if (re-search-forward "^@end menu" nil t)
-        (point)
-      (error "Menu does not have an end."))))
-
-(defun texinfo-delete-old-menu (beginning first)
-  "Delete the old menu.  Point must be in or after menu.
-First argument is position of the beginning of the section in which
-the menu will be located; second argument is the position of the first
-node within the section."
-  ;; No third arg to search, so error if search fails.
-  (re-search-backward "^@menu" beginning)
-  (delete-region (point)
-                 (save-excursion
-                   (re-search-forward "^@end menu" first)
-                   (point))))
-
-
-;;; Inserting new menu
-
-;; try 32, but perhaps 24 is better
-(defvar texinfo-column-for-description 32
-  "*Column at which descriptions start in a Texinfo menu.")
-
-(defun texinfo-insert-menu (menu-list node-name)
-  "Insert formatted menu at point.
-Indents the first line of the description, if any, to the value of
-texinfo-column-for-description.
-
-MENU-LIST has form:
-
-    \(\(\"node-name1\" . \"description\"\) 
-    \(\"node-name2\" . \"description\"\) ... \)
-
-However, the description field might be nil.
-
-Also, the node-name field might itself be a dotted pair (call it P) of
-strings instead of just a string.  In that case, the car of P
-is the menu entry name, and the cdr of P is the node name."
-  
-  (insert "@menu\n")
-  (while menu-list
-    ;; Every menu entry starts with a star and a space.
-    (insert "* ")
-    
-    ;; Insert the node name (and menu entry name, if present).
-    (let ((node-part (car (car menu-list))))
-      (if (stringp node-part)
-          ;; "Double colon" entry line; menu entry and node name are the same,
-          (insert (format "%s::" node-part))  
-        ;; "Single colon" entry line; menu entry and node name are different.
-        (insert (format "%s: %s." (car node-part) (cdr node-part)))))
-    
-    ;; Insert the description, if present.
-    (if (cdr (car menu-list))
-        (progn
-          ;; Move to right place.
-          (indent-to texinfo-column-for-description 2) 
-          ;; Insert description.
-          (insert (format "%s" (cdr (car menu-list))))))  
-
-    (insert "\n") ; end this menu entry
-    (setq menu-list (cdr menu-list)))
-  (insert "@end menu")
-  (message 
-   "Updated \"%s\" level menu following node: %s ... " level node-name))
-
-
-;;; Starting menu descriptions by inserting titles
-
-(defun texinfo-start-menu-description ()
-  "In this menu entry, insert the node's section title as a description. 
-Position point at beginning of description ready for editing.
-Do not insert a title if the line contains an existing description.
-
-You will need to edit the inserted text since a useful description
-complements the node name rather than repeats it as a title does."
-  
-  (interactive)
-  (let (beginning end node-name title)
-    (save-excursion
-    (beginning-of-line)  
-      (if (search-forward "* " (save-excursion (end-of-line) (point)) t)
-          (progn (skip-chars-forward " \t")
-                 (setq beginning (point)))
-        (error "This is not a line in a menu!"))
-      
-      (cond
-        ;; "Double colon" entry line; menu entry and node name are the same,
-       ((search-forward "::" (save-excursion (end-of-line) (point)) t)
-        (if (looking-at "[ \t]*[^ \t\n]+")
-            (error "Descriptive text already exists."))
-        (skip-chars-backward ": \t")
-        (setq node-name (buffer-substring beginning (point))))
-       
-       ;; "Single colon" entry line; menu entry and node name are different.
-       ((search-forward ":" (save-excursion (end-of-line) (point)) t)
-        (skip-chars-forward " \t")
-        (setq beginning (point))
-        ;; Menu entry line ends in a period, comma, or tab. 
-        (if (re-search-forward "[.,\t]"
-                               (save-excursion (forward-line 1) (point)) t)
-            (progn
-              (if (looking-at "[ \t]*[^ \t\n]+")
-                  (error "Descriptive text already exists."))
-              (skip-chars-backward "., \t")
-              (setq node-name (buffer-substring beginning (point))))
-          ;; Menu entry line ends in a return.
-          (re-search-forward ".*\n"
-                           (save-excursion (forward-line 1) (point)) t)
-          (skip-chars-backward " \t\n")
-          (setq node-name (buffer-substring beginning (point)))
-          (if (= 0 (length node-name))
-              (error "No node name on this line.")
-            (insert "."))))
-       (t (error "No node name on this line.")))
-      ;; Search for node that matches node name, and copy the section title.
-      (if (re-search-forward
-           (concat 
-            "^@node[ \t]+"
-            node-name
-            ".*\n"                             ; match node line
-            "\\("
-            "\\(\\(^@c \\|^@comment\\).*\n\\)" ; match comment line, if any
-            "\\|"                              ; or
-            "\\(^@ifinfo[ ]*\n\\)"             ; ifinfo line, if any
-            "\\)?")
-           nil t)
-          (progn
-            (setq title
-                  (buffer-substring
-                   ;; skip over section type
-                   (progn (forward-word 1) 
-                          ;; and over spaces
-                          (skip-chars-forward " \t") 
-                          (point))
-                   (progn (end-of-line)
-                          (skip-chars-backward " \t")
-                          (point)))))
-        (error "Cannot find node to match node name in menu entry.")))
-    ;; Return point to the menu and insert the title.
-    (end-of-line)
-    (delete-region
-     (point)
-     (save-excursion (skip-chars-backward " \t") (point)))
-    (indent-to texinfo-column-for-description 2)
-    (save-excursion (insert title))))
-
-
-;;; Handling description indentation
-
-; Since the make-menu functions indent descriptions, these functions
-; are useful primarily for indenting a single menu specially.
-
-(defun texinfo-indent-menu-description (column &optional region-p)
-  "Indent every description in menu following point to COLUMN.  
-Non-nil argument (prefix, if interactive) means indent every
-description in every menu in the region.  Does not indent second and
-subsequent lines of a multi-line description."
-  
-  (interactive
-   "nIndent menu descriptions to (column number): \nP")
-  (save-excursion
-    (save-restriction
-      (widen)
-      (if (not region-p)
-          (progn
-            (re-search-forward "^@menu")
-            (texinfo-menu-indent-description column)
-            (message
-             "Indented descriptions in menu.  You may save the buffer."))
-        ;;else
-        (message "Indenting every menu description in region... ")
-        (goto-char (region-beginning))
-        (while (and (< (point) (region-end))
-                    (texinfo-locate-menu-p))
-          (forward-line 1)
-          (texinfo-menu-indent-description column))
-        (message "Indenting done.  You may save the buffer.")))))
-
-(defun texinfo-menu-indent-description (to-column-number)
-  "Indent the Texinfo file menu description to TO-COLUMN-NUMBER.
-Start with point just after the word `menu' in the `@menu' line and
-leave point on the line before the `@end menu' line.  Does not indent
-second and subsequent lines of a multi-line description."
-  (let* ((beginning-of-next-line (point)))
-    (while (< beginning-of-next-line
-              (save-excursion     ; beginning of end menu line
-                (goto-char (texinfo-menu-end))
-                (beginning-of-line)
-                (point)))
-
-      (if (re-search-forward  "\\* \\(.*::\\|.*: [^.,\t\n]+[.,\t]\\)" 
-           (texinfo-menu-end) 
-           t)
-          (progn
-            (let ((beginning-white-space (point)))
-              (skip-chars-forward " \t")  ; skip over spaces
-              (if (looking-at "\\(@\\|\\w\\)+") ; if there is text
-                  (progn
-                    ;; remove pre-existing indentation
-                    (delete-region beginning-white-space (point))
-                    (indent-to-column to-column-number))))))
-      ;; position point at beginning of next line
-      (forward-line 1)                  
-      (setq beginning-of-next-line (point)))))
-
-
-;;; Making the master menu
-
-(defun texinfo-master-menu (update-all-nodes-menus-p)
-  "Make a master menu for a whole Texinfo file.
-Non-nil argument (prefix, if interactive) means first update all
-existing nodes and menus.  Remove pre-existing master menu, if there is one.
-
-This function creates a master menu that follows the top node.  The
-master menu includes every entry from all the other menus.  It
-replaces any existing ordinary menu that follows the top node.
-
-If called with a non-nil argument, this function first updates all the
-menus in the buffer (incorporating descriptions from pre-existing
-menus) before it constructs the master menu.
-
-The function removes the detailed part of an already existing master
-menu.  This action depends on the pre-existing master menu using the
-standard `texinfo-master-menu-header'.
-
-The master menu has the following format, which is adapted from the
-recommendation in the Texinfo Manual:
-
-   * The first part contains the major nodes in the Texinfo file: the
-     nodes for the chapters, chapter-like sections, and the major
-     appendices.  This includes the indices, so long as they are in
-     chapter-like sections, such as unnumbered sections.
-
-   * The second and subsequent parts contain a listing of the other,
-     lower level menus, in order.  This way, an inquirer can go
-     directly to a particular node if he or she is searching for
-     specific information.
-
-Each of the menus in the detailed node listing is introduced by the
-title of the section containing the menu."
-  
-  (interactive "P")
-  (let ((case-fold-search t))
-    (widen)
-    (goto-char (point-min))
-    
-    ;; Move point to location after `top'.
-    (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t))
-        (error "This buffer needs a Top node!"))
-    
-    (let ((first-chapter                  
-           (save-excursion
-             (or (re-search-forward "^@node" nil t)
-                 (error "Too few nodes for a master menu!"))
-             (point))))
-      (if (re-search-forward texinfo-master-menu-header first-chapter t)
-          ;; Remove detailed master menu listing
-          (progn
-            (goto-char (match-beginning 0))
-            (let ((end-of-detailed-menu-descriptions
-                   (save-excursion     ; beginning of end menu line
-                     (goto-char (texinfo-menu-end))
-                     (beginning-of-line) (forward-char -1)
-                     (point))))
-              (delete-region (point) end-of-detailed-menu-descriptions)))))
-    
-    (if update-all-nodes-menus-p
-        (progn
-          (message "Making a master menu in %s ...first updating all nodes... "
-                   (buffer-name))
-          (sleep-for 2)
-          (push-mark (point-max) t)
-          (goto-char (point-min))
-          (texinfo-update-node t)
-          
-          (message "Updating all menus in %s ... " (buffer-name))        
-          (sleep-for 2)
-          (push-mark (point-max) t)
-          (goto-char (point-min))
-          (texinfo-make-menu t)))
-    
-    (message "Now making the master menu in %s... " (buffer-name))
-    (sleep-for 2)
-    (goto-char (point-min))
-    (texinfo-insert-master-menu-list
-     (texinfo-master-menu-list))
-    
-    ;; Remove extra newlines that texinfo-insert-master-menu-list
-    ;; may have inserted.
-    
-    (save-excursion
-      (goto-char (point-min))
-      
-      (if (re-search-forward texinfo-master-menu-header nil t)
-          (progn
-            (goto-char (match-beginning 0))
-            (insert "\n")
-            (delete-blank-lines)
-            (goto-char (point-min))))
-
-      (re-search-forward "^@menu")
-      (forward-line -1)
-      (delete-blank-lines)
-      
-      (re-search-forward "^@end menu")
-      (forward-line 1)
-      (delete-blank-lines))
-    
-    (message
-     "Done...completed making master menu.  You may save the buffer.")))
-
-(defun texinfo-master-menu-list ()
-  "Return a list of menu entries and header lines for the master menu.
-
-Start with the menu for chapters and indices and then find each
-following menu and the title of the node preceding that menu.
-
-The master menu list has this form:
-
-    \(\(\(... \"entry-1-2\"  \"entry-1\"\) \"title-1\"\)
-      \(\(... \"entry-2-2\"  \"entry-2-1\"\) \"title-2\"\)
-      ...\)
-
-However, there does not need to be a title field."
-
-  (let (master-menu-list)
-    (while (texinfo-locate-menu-p)
-      (setq master-menu-list 
-            (cons (list
-                   (texinfo-copy-menu)
-                   (texinfo-copy-menu-title))
-                  master-menu-list)))
-    (reverse master-menu-list)))
-
-(defun texinfo-insert-master-menu-list (master-menu-list)
-  "Format and insert the master menu in the current buffer."
-  (goto-char (point-min))
-  ;; Insert a master menu only after `Top' node and before next node
-  ;; \(or include file if there is no next node\).
-  (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t))
-      (error "This buffer needs a Top node!"))
-  (let ((first-chapter
-         (save-excursion (re-search-forward "^@node\\|^@include") (point))))
-    (if (not (re-search-forward "^@menu" first-chapter t))
-        (error
-         "Buffer lacks ordinary `Top' menu in which to insert master.")))
-  (beginning-of-line)
-  (delete-region      ; buffer must have ordinary top menu
-   (point)   
-   (save-excursion (re-search-forward "^@end menu") (point)))
-  
-  (save-excursion                       ; leave point at beginning of menu
-    ;; Handle top of menu
-    (insert "\n@menu\n")
-    ;; Insert chapter menu entries
-    (setq this-very-menu-list (reverse (car (car master-menu-list))))
-    ;; Tell user what is going on.
-    (message "Inserting chapter menu entry: %s ... " this-very-menu-list)
-    (while this-very-menu-list
-      (insert "* " (car this-very-menu-list) "\n")
-      (setq this-very-menu-list (cdr this-very-menu-list)))
-    
-    (setq master-menu-list (cdr master-menu-list))
-    
-    ;; Only insert detailed master menu if there is one....
-    (if (car (car master-menu-list))
-        (insert texinfo-master-menu-header))
-    
-    ;; Now, insert all the other menus
-    
-    ;; The menu master-menu-list has a form like this:
-    ;; ((("beta"  "alpha") "title-A")
-    ;;  (("delta" "gamma") "title-B"))
-    
-    (while master-menu-list
-      
-      (message
-       "Inserting menu for %s .... " (car (cdr (car master-menu-list))))
-      ;; insert title of menu section
-      (insert "\n" (car (cdr (car master-menu-list))) "\n\n")
-      
-      ;; insert each menu entry
-      (setq this-very-menu-list (reverse (car (car master-menu-list))))
-      (while this-very-menu-list
-        (insert "* " (car this-very-menu-list) "\n")
-        (setq this-very-menu-list (cdr this-very-menu-list)))
-      
-      (setq master-menu-list (cdr master-menu-list)))
-    
-    ;; Finish menu
-    (insert "@end menu\n\n")))
-
-(defvar texinfo-master-menu-header
-  "\n --- The Detailed Node Listing ---\n"
-  "String inserted before lower level entries in Texinfo master menu.
-It comes after the chapter-level menu entries.")
-
-(defun texinfo-locate-menu-p ()
-  "Find the next menu in the texinfo file.
-If found, leave point after word `menu' on the `@menu' line, and return t.
-If a menu is not found, do not move point and return nil."
-  (re-search-forward "\\(^@menu\\)" nil t))
-
-(defun texinfo-copy-menu-title  ()
-  "Return the title of the section preceding the menu as a string.
-If such a title cannot be found, return an empty string.  Do not move
-point."
-  (let ((case-fold-search t))
-    (save-excursion
-      (if (re-search-backward
-           (concat
-            "\\(^@top"
-            "\\|"                         ; or
-            texinfo-section-types-regexp  ; all other section types
-            "\\)")
-           nil
-           t)
-          (progn
-            (beginning-of-line)
-            (forward-word 1)              ; skip over section type
-            (skip-chars-forward " \t")    ; and over spaces
-            (buffer-substring
-             (point)
-             (progn (end-of-line) (point))))
-        ""))))
-
-(defun texinfo-copy-menu ()
-  "Return the entries of an existing menu as a list.
-Start with point just after the word `menu' in the `@menu' line
-and leave point on the line before the `@end menu' line."
-  (let* (this-menu-list
-         (end-of-menu (texinfo-menu-end)) ; position of end of `@end menu'
-         (last-entry (save-excursion      ; position of beginning of
-                                          ; last `* ' entry
-                      (goto-char end-of-menu)
-                      ;; handle multi-line description
-                      (if (not (re-search-backward "^\\* " nil t))
-                          (error "No entries in menu."))
-                      (point))))
-    (while (< (point) last-entry)
-      (if (re-search-forward  "^\\* " end-of-menu t)
-          (progn
-            (setq this-menu-list
-                  (cons
-                   (buffer-substring 
-                    (point)
-                    ;; copy multi-line descriptions
-                    (save-excursion
-                      (re-search-forward "\\(^\\* \\|^@e\\)" nil t)
-                      (- (point) 3)))
-                   this-menu-list)))))
-    this-menu-list))
-
-
-;;; Determining the hierarchical level in the texinfo file
-
-(defun texinfo-specific-section-type () 
-  "Return the specific type of next section, as a string.
-For example, \"unnumberedsubsec\".  Return \"top\" for top node.
-
-Searches forward for a section.  Hence, point must be before the
-section whose type will be found.  Does not move point.  Signal an
-error if the node is not the top node and a section is not found."
-  (let ((case-fold-search t))
-    (save-excursion
-      (cond
-       ((re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
-;;; Following search limit by cph but causes a bug
-;;;			 (save-excursion
-;;;			   (end-of-line)
-;;;			   (point))
-                           nil
-                           t)
-        "top")
-       ((re-search-forward texinfo-section-types-regexp nil t)
-        (buffer-substring-no-properties
-	 (progn (beginning-of-line) ; copy its name
-		(1+ (point)))
-	 (progn (forward-word 1)
-		(point))))
-       (t
-        (error
-         "texinfo-specific-section-type: Chapter or section not found."))))))
-
-(defun texinfo-hierarchic-level ()
-  "Return the general hierarchal level of the next node in a texinfo file.
-Thus, a subheading or appendixsubsec is of type subsection."
-  (let ((case-fold-search t))
-    (cdr (assoc
-          (texinfo-specific-section-type)
-          texinfo-section-to-generic-alist))))
-
-
-;;; Locating the major positions
-
-(defun texinfo-update-menu-region-beginning (level)  
-  "Locate beginning of higher level section this section is within.
-Return position of the beginning of the node line; do not move point.
-Thus, if this level is subsection, searches backwards for section node.
-Only argument is a string of the general type of section."
-  (let ((case-fold-search t))
-    ;; !! Known bug: if section immediately follows top node, this
-    ;; returns the beginning of the buffer as the beginning of the
-    ;; higher level section.
-    (cond
-     ((or (string-equal "top" level)
-          (string-equal "chapter" level))
-      (save-excursion
-        (goto-char (point-min))
-        (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t)
-        (beginning-of-line)
-        (point)))
-     (t
-      (save-excursion
-        (re-search-backward
-         (concat
-          "\\(^@node\\).*\n"              ; match node line
-          "\\(\\(\\(^@c\\).*\n\\)"        ; match comment line, if any
-          "\\|"                           ; or
-          "\\(^@ifinfo[ ]*\n\\)\\)?"      ; ifinfo line, if any
-          (eval
-           (cdr (assoc level texinfo-update-menu-higher-regexps))))
-         nil
-         'goto-beginning)
-        (point))))))
-
-(defun texinfo-update-menu-region-end (level)  
-  "Locate end of higher level section this section is within.
-Return position; do not move point.  Thus, if this level is a
-subsection, find the node for the section this subsection is within.
-If level is top or chapter, returns end of file.  Only argument is a
-string of the general type of section."
-  (let ((case-fold-search t))
-    (save-excursion
-      (if (re-search-forward
-           (concat
-            "\\(^@node\\).*\n"            ; match node line
-            "\\(\\(\\(^@c\\).*\n\\)"      ; match comment line, if any
-            "\\|"                         ; or
-            "\\(^@ifinfo[ ]*\n\\)\\)?"    ; ifinfo line, if any
-            (eval
-             ;; Never finds end of level above chapter so goes to end.
-             (cdr (assoc level texinfo-update-menu-higher-regexps))))
-           nil
-           'goto-end)
-          (match-beginning 1)
-        (point-max)))))
-
-(defun texinfo-menu-first-node (beginning end)
-  "Locate first node of the section the menu will be placed in.  
-Return position; do not move point.
-The menu will be located just before this position.  
-
-First argument is the position of the beginning of the section in
-which the menu will be located; second argument is the position of the
-end of that region; it limits the search."
-  
-  (save-excursion
-    (goto-char beginning)
-    (forward-line 1)
-    (re-search-forward "^@node" end t)
-    (beginning-of-line)
-    (point)))
-
-
-;;; Alists and regular expressions for defining hierarchical levels
-
-(defvar texinfo-section-to-generic-alist
-  '(("top" . "top")
-
-    ("chapter" . "chapter")
-    ("unnumbered" . "chapter")
-    ("majorheading" . "chapter")
-    ("chapheading" . "chapter")
-    ("appendix" . "chapter")
-    
-    ("section" . "section")
-    ("unnumberedsec" . "section")
-    ("heading" . "section")
-    ("appendixsec" . "section")
-    
-    ("subsection" . "subsection")
-    ("unnumberedsubsec" . "subsection")
-    ("subheading" . "subsection")
-    ("appendixsubsec" . "subsection")
-    
-    ("subsubsection" . "subsubsection")
-    ("unnumberedsubsubsec" . "subsubsection")
-    ("subsubheading" . "subsubsection")
-    ("appendixsubsubsec" . "subsubsection"))
-  "*An alist of specific and corresponding generic Texinfo section types.
-The keys are strings specifying specific types of section; the values
-are strings of their corresponding general types.")
-
-;; We used to look for just sub, but that found @subtitle.
-(defvar texinfo-section-types-regexp
-  "^@\\(chapter \\|sect\\|subs\\|subh\\|unnum\\|major\\|chapheading \\|heading \\|appendix\\)"
-  "Regexp matching chapter, section, other headings (but not the top node).")
-
-(defvar texinfo-chapter-level-regexp 
-  "chapter\\|unnumbered \\|appendix \\|majorheading\\|chapheading"
-  "Regular expression matching just the Texinfo chapter level headings.")
-
-(defvar texinfo-section-level-regexp 
-  "section\\|unnumberedsec\\|heading \\|appendixsec"
-  "Regular expression matching just the Texinfo section level headings.")
-
-(defvar texinfo-subsection-level-regexp 
-  "subsection\\|unnumberedsubsec\\|subheading\\|appendixsubsec"
-  "Regular expression matching just the Texinfo subsection level headings.")
-
-(defvar texinfo-subsubsection-level-regexp
-  "subsubsection\\|unnumberedsubsubsec\\|subsubheading\\|appendixsubsubsec"
-  "Regular expression matching just the Texinfo subsubsection level headings.")
-
-(defvar texinfo-update-menu-same-level-regexps
-  '(("top" . "top[ \t]+")
-    ("chapter" . 
-     (concat "\\(^@\\)\\(" texinfo-chapter-level-regexp "\\)[ \t]*"))
-    ("section" . 
-     (concat "\\(^@\\)\\(" texinfo-section-level-regexp "\\)[ \t]*"))
-    ("subsection" .  
-     (concat "\\(^@\\)\\(" texinfo-subsection-level-regexp "\\)[ \t]+"))
-    ("subsubsection" . 
-     (concat "\\(^@\\)\\(" texinfo-subsubsection-level-regexp "\\)[ \t]+")))
-  "*Regexps for searching for same level sections in a Texinfo file.
-The keys are strings specifying the general hierarchical level in the
-document; the values are regular expressions.")
-
-(defvar texinfo-update-menu-higher-regexps
-  '(("top" . "^@node [ \t]*DIR") 
-    ("chapter" . "^@node [ \t]*top[ \t]*\\(,\\|$\\)")
-    ("section" .
-     (concat 
-      "\\(^@\\("
-      texinfo-chapter-level-regexp
-      "\\)[ \t]*\\)"))
-    ("subsection" .
-     (concat 
-      "\\(^@\\("
-      texinfo-section-level-regexp
-      "\\|"
-      texinfo-chapter-level-regexp
-      "\\)[ \t]*\\)"))
-    ("subsubsection" .
-     (concat 
-      "\\(^@\\("
-      texinfo-subsection-level-regexp
-      "\\|"
-      texinfo-section-level-regexp
-      "\\|"
-      texinfo-chapter-level-regexp
-      "\\)[ \t]*\\)")))
-  "*Regexps for searching for higher level sections in a Texinfo file.
-The keys are strings specifying the general hierarchical level in the
-document; the values are regular expressions.")
-
-(defvar texinfo-update-menu-lower-regexps
-  '(("top" . 
-     (concat 
-      "\\(^@\\("
-      texinfo-chapter-level-regexp
-      "\\|"
-      texinfo-section-level-regexp
-      "\\|"
-      texinfo-subsection-level-regexp
-      "\\|"
-      texinfo-subsubsection-level-regexp
-      "\\)[ \t]*\\)"))
-    ("chapter" . 
-     (concat 
-      "\\(^@\\("
-      texinfo-section-level-regexp
-      "\\|"
-      texinfo-subsection-level-regexp
-      "\\|"
-      texinfo-subsubsection-level-regexp
-      "\\)[ \t]*\\)"))
-    ("section" .
-     (concat 
-      "\\(^@\\("
-      texinfo-subsection-level-regexp
-      "\\|"
-      texinfo-subsubsection-level-regexp
-      "\\)[ \t]+\\)"))
-    ("subsection" .
-     (concat 
-      "\\(^@\\("
-      texinfo-subsubsection-level-regexp
-      "\\)[ \t]+\\)"))
-    ("subsubsection" . "nothing lower"))
-  "*Regexps for searching for lower level sections in a Texinfo file.
-The keys are strings specifying the general hierarchical level in the
-document; the values are regular expressions.")
-
-
-;;; Updating a node
-
-;;;###autoload
-(defun texinfo-update-node (&optional region-p)
-  "Without any prefix argument, update the node in which point is located.
-Non-nil argument (prefix, if interactive) means update the nodes in the
-marked region.
-
-The functions for creating or updating nodes and menus, and their
-keybindings, are:
-
-    texinfo-update-node (&optional region-p)    \\[texinfo-update-node]
-    texinfo-every-node-update ()                \\[texinfo-every-node-update]
-    texinfo-sequential-node-update (&optional region-p)
-
-    texinfo-make-menu (&optional region-p)      \\[texinfo-make-menu]
-    texinfo-all-menus-update ()                 \\[texinfo-all-menus-update]
-    texinfo-master-menu ()
-
-    texinfo-indent-menu-description (column &optional region-p)
-
-The `texinfo-column-for-description' variable specifies the column to
-which menu descriptions are indented. Its default value is 32."
-  
-  (interactive "P")
-  (if (not region-p)
-      ;; update a single node
-      (let ((auto-fill-function nil) (auto-fill-hook nil))
-        (if (not (re-search-backward "^@node" (point-min) t))
-            (error "Node line not found before this position."))
-        (texinfo-update-the-node)
-        (message "Done...updated the node.  You may save the buffer."))
-    ;; else
-    (let ((auto-fill-function nil)
-	  (auto-fill-hook nil)
-          (beginning (region-beginning))
-	  (end (region-end)))
-      (if (= end beginning)
-          (error "Please mark a region!"))
-      (save-restriction
-	(narrow-to-region beginning end)
-	(goto-char beginning)
-        (push-mark (point) t)
-	(while (re-search-forward "^@node" (point-max) t)
-          (beginning-of-line)            
-          (texinfo-update-the-node))
-        (message "Done...updated nodes in region.  You may save the buffer.")))))
-
-;;;###autoload
-(defun texinfo-every-node-update ()
-  "Update every node in a Texinfo file."
-  (interactive)
-  (save-excursion
-    (push-mark (point-max) t)
-    (goto-char (point-min))
-    ;; Using the mark to pass bounds this way
-    ;; is kludgy, but it's not worth fixing. -- rms.
-    (let ((mark-active t))
-      (texinfo-update-node t))
-    (message "Done...updated every node.       You may save the buffer.")))
-
-(defun texinfo-update-the-node ()
-  "Update one node.  Point must be at the beginning of node line.  
-Leave point at the end of the node line."
-  (texinfo-check-for-node-name)
-  (texinfo-delete-existing-pointers)
-  (message "Updating node: %s ... " (texinfo-copy-node-name))
-  (save-restriction
-    (widen)
-    (let*
-        ((case-fold-search t)
-         (level (texinfo-hierarchic-level))
-         (beginning (texinfo-update-menu-region-beginning level))
-         (end (texinfo-update-menu-region-end level)))
-      (if (string-equal level "top")
-          (texinfo-top-pointer-case)
-        ;; else
-        (texinfo-insert-pointer beginning end level 'next)
-        (texinfo-insert-pointer beginning end level 'previous)
-        (texinfo-insert-pointer beginning end level 'up)
-        (texinfo-clean-up-node-line)))))
-
-(defun texinfo-top-pointer-case ()
-  "Insert pointers in the Top node.  This is a special case.
-
-The `Next' pointer is a pointer to a chapter or section at a lower
-hierarchical level in the file.  The `Previous' and `Up' pointers are
-to `(dir)'.  Point must be at the beginning of the node line, and is
-left at the end of the node line."
-
-  (texinfo-clean-up-node-line)
-  (insert ", " 
-          (save-excursion
-            ;; There may be an @chapter or other such command between
-            ;; the top node line and the next node line, as a title
-            ;; for an `ifinfo' section. This @chapter command must
-            ;; must be skipped.  So the procedure is to search for
-            ;; the next `@node' line, and then copy its name.
-            (if (re-search-forward "^@node" nil t)
-                (progn
-                  (beginning-of-line)
-                  (texinfo-copy-node-name))
-              " "))
-          ", (dir), (dir)"))
-
-(defun texinfo-check-for-node-name ()
-  "Determine whether the node has a node name.  Prompt for one if not.
-Point must be at beginning of node line.  Does not move point."
-  (save-excursion
-    (let ((initial (texinfo-copy-next-section-title)))
-      ;; This is not clean.  Use `interactive' to read the arg.
-      (forward-word 1)                    ; skip over node command
-      (skip-chars-forward " \t")          ; and over spaces
-      (if (not (looking-at "[^,\t\n ]+")) ; regexp based on what Info looks for
-                                          ; alternatively, use "[a-zA-Z]+"
-        (let ((node-name
-               (read-from-minibuffer
-                "Node name (use no @, commas, colons, or apostrophes): "
-                initial)))
-          (insert " " node-name))))))
-
-(defun texinfo-delete-existing-pointers ()
-  "Delete `Next', `Previous', and `Up' pointers.  
-Starts from the current position of the cursor, and searches forward
-on the line for a comma and if one is found, deletes the rest of the
-line, including the comma.  Leaves point at beginning of line."
-  (let ((eol-point (save-excursion (end-of-line) (point))))
-    (if (search-forward "," eol-point t)
-        (delete-region (1- (point)) eol-point)))
-  (beginning-of-line))
-
-(defun texinfo-find-pointer (beginning end level direction)
-  "Move point to section associated with next, previous, or up pointer.
-Return type of pointer (either 'normal or 'no-pointer).
-
-The first and second arguments bound the search for a pointer to the
-beginning and end, respectively, of the enclosing higher level
-section.  The third argument is a string specifying the general kind
-of section such as \"chapter\" or \"section\".  When looking for the
-`Next' pointer, the section found will be at the same hierarchical
-level in the Texinfo file; when looking for the `Previous' pointer,
-the section found will be at the same or higher hierarchical level in
-the Texinfo file; when looking for the `Up' pointer, the section found
-will be at some level higher in the Texinfo file.  The fourth argument
-\(one of 'next, 'previous, or 'up\) specifies whether to find the
-`Next', `Previous', or `Up' pointer."
-  (let ((case-fold-search t))
-    (cond ((eq direction 'next)
-           (forward-line 3)             ; skip over current node
-           ;; Search for section commands accompanied by node lines;
-           ;; ignore section commands in the middle of nodes.
-           (if (re-search-forward
-                ;; A `Top' node is never a next pointer, so won't find it.
-                (concat
-                 ;; Match node line.
-                 "\\(^@node\\).*\n"         
-                 ;; Match comment or ifinfo line, if any
-                 "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?" 
-                 (eval
-                  (cdr (assoc level texinfo-update-menu-same-level-regexps))))
-                end
-                t)
-               'normal
-             'no-pointer))
-          ((eq direction 'previous)
-           (if (re-search-backward
-                (concat
-                 "\\("
-                 ;; Match node line.
-                 "\\(^@node\\).*\n"         
-                 ;; Match comment or ifinfo line, if any
-                 "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?" 
-                 (eval
-                  (cdr (assoc level texinfo-update-menu-same-level-regexps)))
-                 "\\|"
-                 ;; Match node line.
-                 "\\(^@node\\).*\n"         
-                 ;; Match comment or ifinfo line, if any
-                 "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?" 
-                 (eval
-                  (cdr (assoc level texinfo-update-menu-higher-regexps)))
-                 "\\|"
-                 ;; Handle `Top' node specially.
-                 "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
-                 "\\)")
-                beginning
-                t)
-               'normal
-             'no-pointer))
-          ((eq direction 'up)
-           (if (re-search-backward
-                (concat
-                 "\\("
-                 ;; Match node line.
-                 "\\(^@node\\).*\n"         
-                 ;; Match comment or ifinfo line, if any
-                 "\\(\\(\\(^@c\\).*\n\\)\\|\\(^@ifinfo[ ]*\n\\)\\)?" 
-                 (eval (cdr (assoc level texinfo-update-menu-higher-regexps)))
-                 "\\|"
-                 ;; Handle `Top' node specially.
-                 "^@node [ \t]*top[ \t]*\\(,\\|$\\)"
-                 "\\)")
-                (save-excursion
-                  (goto-char beginning)
-                  (beginning-of-line)
-                  (point))
-                t)
-               'normal
-             'no-pointer))
-          (t
-           (error "texinfo-find-pointer: lack proper arguments")))))
-
-(defun texinfo-pointer-name (kind)
-  "Return the node name preceding the section command.
-The argument is the kind of section, either normal or no-pointer."
-  (let (name)
-    (cond ((eq kind 'normal)
-           (end-of-line)                ; this handles prev node top case
-           (re-search-backward          ; when point is already 
-            "^@node"                    ; at the beginning of @node line
-            (save-excursion (forward-line -3))
-            t)
-           (setq name (texinfo-copy-node-name)))
-	  ((eq kind 'no-pointer)
-	   (setq name " ")))	; put a blank in the pointer slot
-    name))
-
-(defun texinfo-insert-pointer (beginning end level direction)
-  "Insert the `Next', `Previous' or `Up' node name at point.
-Move point forward.  
-
-The first and second arguments bound the search for a pointer to the
-beginning and end, respectively, of the enclosing higher level
-section.  The third argument is the hierarchical level of the Texinfo
-file, a string such as \"section\".  The fourth argument is direction
-towards which the pointer is directed, one of `next, `previous, or
-'up."
-
-  (end-of-line)
-  (insert
-   ", "
-   (save-excursion
-     (texinfo-pointer-name
-      (texinfo-find-pointer beginning end level direction)))))
-
-(defun texinfo-clean-up-node-line ()
-  "Remove extra commas, if any, at end of node line."
-  (end-of-line)
-  (skip-chars-backward ", ")
-  (delete-region (point) (save-excursion (end-of-line) (point))))
-
-
-;;; Updating nodes sequentially
-; These sequential update functions insert `Next' or `Previous'
-; pointers that point to the following or preceding nodes even if they
-; are at higher or lower hierarchical levels.  This means that if a
-; section contains one or more subsections, the section's `Next'
-; pointer will point to the subsection and not the following section.
-; (The subsection to which `Next' points will most likely be the first
-; item on the section's menu.)
-
-;;;###autoload
-(defun texinfo-sequential-node-update (&optional region-p)
-  "Update one node (or many) in a Texinfo file with sequential pointers.
-
-This function causes the `Next' or `Previous' pointer to point to the
-immediately preceding or following node, even if it is at a higher or
-lower hierarchical level in the document.  Continually pressing `n' or
-`p' takes you straight through the file.
-
-Without any prefix argument, update the node in which point is located.
-Non-nil argument (prefix, if interactive) means update the nodes in the
-marked region.
-
-This command makes it awkward to navigate among sections and
-subsections; it should be used only for those documents that are meant
-to be read like a novel rather than a reference, and for which the
-Info `g*' command is inadequate."
-  
-  (interactive "P")
-  (if (not region-p)
-      ;; update a single node
-      (let ((auto-fill-function nil) (auto-fill-hook nil))
-        (if (not (re-search-backward "^@node" (point-min) t))
-            (error "Node line not found before this position."))
-        (texinfo-sequentially-update-the-node)
-        (message 
-         "Done...sequentially updated the node .  You may save the buffer."))
-    ;; else
-    (let ((auto-fill-function nil)
-	  (auto-fill-hook nil)
-          (beginning (region-beginning))
-          (end (region-end)))
-      (if (= end beginning)
-          (error "Please mark a region!"))
-      (save-restriction
-        (narrow-to-region beginning end)
-        (goto-char beginning)
-        (push-mark (point) t)
-        (while (re-search-forward "^@node" (point-max) t)
-          (beginning-of-line)            
-          (texinfo-sequentially-update-the-node))
-        (message 
-         "Done...updated the nodes in sequence.  You may save the buffer.")))))
-
-(defun texinfo-sequentially-update-the-node ()
-  "Update one node such that the pointers are sequential. 
-A `Next' or `Previous' pointer points to any preceding or following node,
-regardless of its hierarchical level."
-
-        (texinfo-check-for-node-name)
-        (texinfo-delete-existing-pointers)
-        (message 
-         "Sequentially updating node: %s ... " (texinfo-copy-node-name))
-        (save-restriction
-          (widen)
-          (let*
-              ((case-fold-search t)
-               (level (texinfo-hierarchic-level)))
-            (if (string-equal level "top")
-                (texinfo-top-pointer-case)
-              ;; else
-              (texinfo-sequentially-insert-pointer level 'next)
-              (texinfo-sequentially-insert-pointer level 'previous)
-              (texinfo-sequentially-insert-pointer level 'up)
-              (texinfo-clean-up-node-line)))))
-
-(defun texinfo-sequentially-find-pointer (level direction)
-  "Find next or previous pointer sequentially in Texinfo file, or up pointer.
-Move point to section associated with the pointer.  Find point even if
-it is in a different section.
-
-Return type of pointer (either 'normal or 'no-pointer).
-
-The first argument is a string specifying the general kind of section
-such as \"chapter\" or \"section\".  The section found will be at the
-same hierarchical level in the Texinfo file, or, in the case of the up
-pointer, some level higher.  The second argument (one of 'next,
-'previous, or 'up) specifies whether to find the `Next', `Previous',
-or `Up' pointer."
-  (let ((case-fold-search t))  
-    (cond ((eq direction 'next)
-           (forward-line 3)             ; skip over current node
-           (if (re-search-forward 
-                texinfo-section-types-regexp
-                (point-max)
-                t)
-               'normal
-             'no-pointer))
-          ((eq direction 'previous)
-           (if (re-search-backward 
-                texinfo-section-types-regexp
-                (point-min)
-                t)
-               'normal
-             'no-pointer))
-          ((eq direction 'up)
-           (if (re-search-backward
-                (eval (cdr (assoc level texinfo-update-menu-higher-regexps)))
-                beginning
-                t)
-               'normal
-             'no-pointer))
-          (t
-           (error "texinfo-sequential-find-pointer: lack proper arguments")))))
-
-(defun texinfo-sequentially-insert-pointer (level direction)
-  "Insert the `Next', `Previous' or `Up' node name at point.
-Move point forward.  
-
-The first argument is the hierarchical level of the Texinfo file, a
-string such as \"section\".  The second argument is direction, one of
-`next, `previous, or 'up."
-
-  (end-of-line)
-  (insert
-   ", "
-   (save-excursion
-     (texinfo-pointer-name
-      (texinfo-sequentially-find-pointer level direction)))))
-
-
-;;; Inserting `@node' lines
-; The `texinfo-insert-node-lines' function inserts `@node' lines as needed
-; before the `@chapter', `@section', and such like lines of a region
-; in a Texinfo file.
-
-(defun texinfo-insert-node-lines (beginning end &optional title-p)
-  "Insert missing `@node' lines in region of Texinfo file.
-Non-nil argument (prefix, if interactive) means also to insert the
-section titles as node names; and also to insert the section titles as
-node names in pre-existing @node lines that lack names."
-  (interactive "r\nP")
-
-  ;; Use marker; after inserting node lines, leave point at end of
-  ;; region and mark at beginning.
-
-  (let (beginning-marker end-marker title last-section-position)
-
-    ;; Save current position on mark ring and set mark to end.
-    (push-mark end t)                   
-    (setq end-marker (mark-marker))        
-
-    (goto-char beginning)
-    (while (re-search-forward
-            texinfo-section-types-regexp 
-            end-marker
-            'end)
-      ;; Copy title if desired.
-      (if title-p
-          (progn 
-            (beginning-of-line)
-            (forward-word 1)
-            (skip-chars-forward " \t")
-            (setq title (buffer-substring
-                         (point)
-                         (save-excursion (end-of-line) (point))))))
-      ;; Insert node line if necessary.
-      (if (re-search-backward
-           "^@node" 
-           ;; Avoid finding previous node line if node lines are close.
-           (or last-section-position    
-               (save-excursion (forward-line -2) (point))) t)
-          ;;  @node is present, and point at beginning of that line
-          (forward-word 1)          ; Leave point just after @node.
-        ;; Else @node missing; insert one.
-        (beginning-of-line)         ; Beginning of `@section' line.
-        (insert "@node\n")
-        (backward-char 1))          ; Leave point just after `@node'.
-      ;; Insert title if desired.
-      (if title-p
-          (progn
-            (skip-chars-forward " \t")
-            ;; Use regexp based on what info looks for
-            ;; (alternatively, use "[a-zA-Z]+");
-            ;; this means we only insert a title if none exists.
-            (if (not (looking-at "[^,\t\n ]+")) 
-                (progn
-                  (beginning-of-line) 
-                  (forward-word 1)
-                  (insert " " title)
-                  (message "Inserted title %s ... " title)))))
-      ;; Go forward beyond current section title.
-      (re-search-forward texinfo-section-types-regexp 
-                         (save-excursion (forward-line 3) (point)) t)
-      (setq last-section-position (point))
-      (forward-line 1))
-
-    ;; Leave point at end of region, mark at beginning.
-    (set-mark beginning)
-
-    (if title-p
-      (message
-       "Done inserting node lines and titles.  You may save the buffer.")
-    (message "Done inserting node lines.  You may save the buffer."))))
-
-
-;;; Update and create menus for multi-file Texinfo sources
-
-;;  1. M-x texinfo-multiple-files-update 
-;;
-;;     Read the include file list of an outer Texinfo file and
-;;     update all highest level nodes in the files listed and insert a
-;;     main menu in the outer file after its top node.
-
-;;  2. C-u M-x texinfo-multiple-files-update 
-;;
-;;     Same as 1, but insert a master menu.  (Saves reupdating lower
-;;     level menus and nodes.)  This command simply reads every menu,
-;;     so if the menus are wrong, the master menu will be wrong.
-;;     Similarly, if the lower level node pointers are wrong, they
-;;     will stay wrong.
-
-;;  3. C-u 2 M-x texinfo-multiple-files-update 
-;;
-;;     Read the include file list of an outer Texinfo file and
-;;     update all nodes and menus in the files listed and insert a
-;;     master menu in the outer file after its top node.
-
-;;; Note: these functions:
-;;;
-;;;   * Do not save or delete any buffers.  You may fill up your memory.
-;;;   * Do not handle any pre-existing nodes in outer file.  
-;;;     Hence, you may need a file for indices.
-
-
-;;; Auxiliary functions for multiple file updating
-
-(defun texinfo-multi-file-included-list (outer-file)
-  "Return a list of the included files in OUTER-FILE."
-  (let ((included-file-list (list outer-file))
-        start)
-    (save-excursion
-      (switch-to-buffer (find-file-noselect outer-file))
-      (widen)
-      (goto-char (point-min))
-      (while (re-search-forward "^@include" nil t)
-        (skip-chars-forward " \t")
-        (setq start (point))
-        (end-of-line)
-        (skip-chars-backward " \t")   
-        (setq included-file-list
-              (cons (buffer-substring start (point))
-                    included-file-list)))
-      (nreverse included-file-list))))
-
-(defun texinfo-copy-next-section-title ()
-  "Return the name of the immediately following section as a string.
-
-Start with point at the beginning of the node line.  Leave point at the
-same place.  If there is no title, returns an empty string."
-
-  (save-excursion
-    (end-of-line)
-    (let ((node-end (or 
-                        (save-excursion
-                          (if (re-search-forward "\\(^@node\\)" nil t)
-                              (match-beginning 0)))
-                        (point-max))))
-      (if (re-search-forward texinfo-section-types-regexp node-end t)
-          (progn
-            (beginning-of-line)
-            ;; copy title
-            (let ((title
-                   (buffer-substring
-                    (progn (forward-word 1)           ; skip over section type
-                           (skip-chars-forward " \t") ; and over spaces
-                           (point))
-                    (progn (end-of-line) (point)))))
-              title))
-        ""))))
-
-(defun texinfo-multi-file-update (files &optional update-everything)
-  "Update first node pointers in each file in FILES.
-Return a list of the node names.
-
-The first file in the list is an outer file; the remaining are
-files included in the outer file with `@include' commands.
-
-If optional arg UPDATE-EVERYTHING non-nil, update every menu and
-pointer in each of the included files.
-
-Also update the `Top' level node pointers of the outer file.
-
-Requirements:
-
-  * the first file in the FILES list must be the outer file,
-  * each of the included files must contain exactly one highest
-    hierarchical level node, 
-  * this node must be the first node in the included file,
-  * each highest hierarchical level node must be of the same type.
-
-Thus, normally, each included file contains one, and only one,
-chapter."
-
-; The menu-list has the form:
-; 
-;     \(\(\"node-name1\" . \"title1\"\) 
-;       \(\"node-name2\" . \"title2\"\) ... \)
-; 
-; However, there does not need to be a title field and this function
-; does not fill it; however a comment tells you how to do so.
-; You would use the title field if you wanted to insert titles in the
-; description slot of a menu as a description.
-  
-  (let ((case-fold-search t)
-        menu-list)
-    
-    ;; Find the name of the first node of the first included file.
-    (switch-to-buffer (find-file-noselect (car (cdr files))))
-    (widen)
-    (goto-char (point-min))
-    (if (not (re-search-forward "^@node" nil t))
-        (error "No `@node' line found in %s !" (buffer-name)))
-    (beginning-of-line)
-    (texinfo-check-for-node-name)
-    (setq next-node-name (texinfo-copy-node-name))
-    
-    (setq menu-list
-          (cons (cons 
-                 next-node-name
-                 (prog1 "" (forward-line 1)))
-                ;; Use following to insert section titles automatically.
-                ;; (texinfo-copy-next-section-title)
-                menu-list))
-
-    ;; Go to outer file
-    (switch-to-buffer (find-file-noselect (car files)))
-    (goto-char (point-min))
-    (if (not (re-search-forward "^@node [ \t]*top[ \t]*\\(,\\|$\\)" nil t))
-        (error "This buffer needs a Top node!"))
-    (beginning-of-line)
-    (texinfo-delete-existing-pointers)
-    (end-of-line)
-    (insert ", " next-node-name ", (dir), (dir)")
-    (beginning-of-line)
-    (setq previous-node-name "Top")
-    (setq files (cdr files))
-    
-    (while files
-      
-      (if (not (cdr files))
-          ;; No next file
-          (setq next-node-name "")
-        ;; Else,
-        ;; find the name of the first node in the next file.
-        (switch-to-buffer (find-file-noselect (car (cdr files))))
-        (widen)
-        (goto-char (point-min))
-        (if (not (re-search-forward "^@node" nil t))
-            (error "No `@node' line found in %s !" (buffer-name)))
-        (beginning-of-line)
-        (texinfo-check-for-node-name)
-        (setq next-node-name (texinfo-copy-node-name))
-        (setq menu-list
-              (cons (cons 
-                     next-node-name
-                     (prog1 "" (forward-line 1)))
-                    ;; Use following to insert section titles automatically.
-                    ;; (texinfo-copy-next-section-title)
-                    menu-list)))
-
-      ;; Go to node to be updated.
-      (switch-to-buffer (find-file-noselect (car files)))
-      (goto-char (point-min))
-      (if (not (re-search-forward "^@node" nil t))
-          (error "No `@node' line found in %s !" (buffer-name)))
-      (beginning-of-line)
-      
-      ;; Update other menus and nodes if requested.
-      (if update-everything (texinfo-all-menus-update t))
-
-      (beginning-of-line)
-      (texinfo-delete-existing-pointers)
-      (end-of-line)
-      (insert ", " next-node-name ", " previous-node-name ", " up-node-name)
-      
-      (beginning-of-line)
-      (setq previous-node-name (texinfo-copy-node-name))
-      
-      (setq files (cdr files)))
-    (nreverse menu-list)))
-
-(defun texinfo-multi-files-insert-main-menu (menu-list)
-  "Insert formatted main menu at point.
-Indents the first line of the description, if any, to the value of
-texinfo-column-for-description."
-
-  (insert "@menu\n")
-  (while menu-list
-    ;; Every menu entry starts with a star and a space.
-    (insert "* ")
-    
-    ;; Insert the node name (and menu entry name, if present).
-    (let ((node-part (car (car menu-list))))
-      (if (stringp node-part)
-          ;; "Double colon" entry line; menu entry and node name are the same,
-          (insert (format "%s::" node-part))  
-        ;; "Single colon" entry line; menu entry and node name are different.
-        (insert (format "%s: %s." (car node-part) (cdr node-part)))))
-    
-    ;; Insert the description, if present.
-    (if (cdr (car menu-list))
-        (progn
-          ;; Move to right place.
-          (indent-to texinfo-column-for-description 2) 
-          ;; Insert description.
-          (insert (format "%s" (cdr (car menu-list))))))  
-
-    (insert "\n") ; end this menu entry
-    (setq menu-list (cdr menu-list)))
-  (insert "@end menu"))
-
-(defun texinfo-multi-file-master-menu-list (files-list)
-  "Return master menu list from files in FILES-LIST.
-Menu entries in each file collected using `texinfo-master-menu-list'.
-
-The first file in FILES-LIST must be the outer file; the others must
-be the files included within it.  A main menu must already exist."
-  (save-excursion
-    (let (master-menu-list)
-      (while files-list
-        (switch-to-buffer (find-file-noselect (car files-list)))
-        (message "Working on: %s " (current-buffer))
-        (goto-char (point-min))
-        (setq master-menu-list
-              (append master-menu-list (texinfo-master-menu-list)))
-        (setq files-list (cdr files-list)))
-      master-menu-list)))
-
-
-;;; The multiple-file update function
-
-(defun texinfo-multiple-files-update
-  (outer-file &optional update-everything make-master-menu)
-  "Update first node pointers in each file included in OUTER-FILE;
-create or update the `Top' level node pointers and the main menu in
-the outer file that refers to such nodes.  This does not create or
-update menus or pointers within the included files.
-
-With optional MAKE-MASTER-MENU argument (prefix arg, if interactive),
-insert a master menu in OUTER-FILE in addition to creating or updating
-pointers in the first @node line in each included file and creating or
-updating the `Top' level node pointers of the outer file.  This does
-not create or update other menus and pointers within the included
-files.
-
-With optional UPDATE-EVERYTHING argument (numeric prefix arg, if
-interactive), update all the menus and all the `Next', `Previous', and
-`Up' pointers of all the files included in OUTER-FILE before inserting
-a master menu in OUTER-FILE.  Also, update the `Top' level node
-pointers of OUTER-FILE.
-
-Notes: 
-
-  * this command does NOT save any files--you must save the
-    outer file and any modified, included files.
-
-  * except for the `Top' node, this command does NOT handle any
-    pre-existing nodes in the outer file; hence, indices must be
-    enclosed in an included file.
-
-Requirements:
-
-  * each of the included files must contain exactly one highest
-    hierarchical level node, 
-  * this highest node must be the first node in the included file,
-  * each highest hierarchical level node must be of the same type.
-
-Thus, normally, each included file contains one, and only one,
-chapter."
-  
-  (interactive (cons
-                (read-string
-                 "Name of outer `include' file: "
-                 (buffer-file-name))
-                (cond ((not current-prefix-arg)
-                       '(nil nil))
-                      ((listp current-prefix-arg)
-                       '(t nil))   ; make-master-menu 
-                      ((numberp current-prefix-arg)
-                       '(t t))     ; update-everything
-                      )))
-
-  (let* ((included-file-list (texinfo-multi-file-included-list outer-file))
-         (files included-file-list)
-         main-menu-list
-         next-node-name
-         previous-node-name
-         (up-node-name "Top"))
-
-;;; Update the pointers 
-;;; and collect the names of the nodes and titles
-    (setq main-menu-list (texinfo-multi-file-update files update-everything))
-
-;;; Insert main menu
-
-  ;; Go to outer file
-  (switch-to-buffer (find-file-noselect (car included-file-list)))
-  (if (texinfo-old-menu-p
-       (point-min)
-       (save-excursion
-         (re-search-forward "^@include")
-         (beginning-of-line)
-         (point)))
-
-      ;; If found, leave point after word `menu' on the `@menu' line.
-      (progn
-        (texinfo-incorporate-descriptions main-menu-list)
-        ;; Delete existing menu.
-        (beginning-of-line)
-        (delete-region
-         (point)
-         (save-excursion (re-search-forward "^@end menu") (point)))
-        ;; Insert main menu
-        (texinfo-multi-files-insert-main-menu main-menu-list))
-
-    ;; Else no current menu; insert it before `@include'
-    (texinfo-multi-files-insert-main-menu main-menu-list))
-
-;;; Insert master menu
-
-  (if make-master-menu
-      (progn
-        ;; First, removing detailed part of any pre-existing master menu
-        (goto-char (point-min))
-        (if (re-search-forward texinfo-master-menu-header nil t)
-            ;; Remove detailed master menu listing
-            (progn
-              (goto-char (match-beginning 0))
-              (let ((end-of-detailed-menu-descriptions
-                     (save-excursion     ; beginning of end menu line
-                       (goto-char (texinfo-menu-end))
-                       (beginning-of-line) (forward-char -1)
-                       (point))))
-                (delete-region (point) end-of-detailed-menu-descriptions))))
-
-        ;; Create a master menu and insert it
-        (texinfo-insert-master-menu-list 
-         (texinfo-multi-file-master-menu-list
-          included-file-list)))))
-
-  ;; Remove unwanted extra lines.
-  (save-excursion
-    (goto-char (point-min))
-      
-    (re-search-forward "^@menu")
-    (forward-line -1)
-    (insert  "\n") ; Ensure at least one blank line.
-    (delete-blank-lines)
-      
-    (re-search-forward "^@end menu")
-    (forward-line 1)
-    (insert  "\n") ; Ensure at least one blank line.
-    (delete-blank-lines))
-
-  (message "Multiple files updated."))
-
-
-;;; Place `provide' at end of file.
-(provide 'texnfo-upd)
-
-;;; texnfo-upd.el ends here
diff --git a/lisp/textmodes/text-mode.el b/lisp/textmodes/text-mode.el
deleted file mode 100644
index ab8895e9872..00000000000
--- a/lisp/textmodes/text-mode.el
+++ /dev/null
@@ -1,172 +0,0 @@
-;;; text-mode.el --- text mode, and its idiosyncratic commands.
-
-;; Copyright (C) 1985, 1992, 1994 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 provides the fundamental text mode documented in the
-;; Emacs user's manual.
-
-;;; Code:
-
-(defvar text-mode-syntax-table nil
-  "Syntax table used while in text mode.")
-
-(defvar text-mode-abbrev-table nil
-  "Abbrev table used while in text mode.")
-(define-abbrev-table 'text-mode-abbrev-table ())
-
-(if text-mode-syntax-table
-    ()
-  (setq text-mode-syntax-table (make-syntax-table))
-  (modify-syntax-entry ?\" ".   " text-mode-syntax-table)
-  (modify-syntax-entry ?\\ ".   " text-mode-syntax-table)
-  (modify-syntax-entry ?' "w   " text-mode-syntax-table))
-
-(defvar text-mode-map nil
-  "Keymap for Text mode.
-Many other modes, such as Mail mode, Outline mode and Indented Text mode,
-inherit all the commands defined in this map.")
-
-(if text-mode-map
-    ()
-  (setq text-mode-map (make-sparse-keymap))
-  (define-key text-mode-map "\e\t" 'ispell-complete-word)
-  (define-key text-mode-map "\t" 'tab-to-tab-stop)
-  (define-key text-mode-map "\es" 'center-line)
-  (define-key text-mode-map "\eS" 'center-paragraph))
-
-
-;(defun non-saved-text-mode ()
-;  "Like text-mode, but delete auto save file when file is saved for real."
-;  (text-mode)
-;  (make-local-variable 'delete-auto-save-files)
-;  (setq delete-auto-save-files t))
-
-(defun text-mode ()
-  "Major mode for editing text intended for humans to read.
-Special commands:
-\\{text-mode-map}
-Turning on Text mode calls the value of the variable `text-mode-hook',
-if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map text-mode-map)
-  (setq mode-name "Text")
-  (setq major-mode 'text-mode)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (set-syntax-table text-mode-syntax-table)
-  (run-hooks 'text-mode-hook))
-
-(defvar indented-text-mode-map ()
-  "Keymap for Indented Text mode.
-All the commands defined in Text mode are inherited unless overridden.")
-
-(if indented-text-mode-map
-    ()
-  ;; Make different definition for TAB before the one in text-mode-map, but
-  ;; share the rest.
-  (let ((newmap (make-sparse-keymap)))
-    (define-key newmap "\t" 'indent-relative)
-    (setq indented-text-mode-map (nconc newmap text-mode-map))))
-
-(defun indented-text-mode ()
-  "Major mode for editing text with indented paragraphs.
-In this mode, paragraphs are delimited only by blank lines.
-You can thus get the benefit of adaptive filling
- (see the variable `adaptive-fill-mode').
-\\{indented-text-mode-map}
-Turning on `indented-text-mode' calls the value of the variable
-`text-mode-hook', if that value is non-nil."
-  (interactive)
-  (kill-all-local-variables)
-  (use-local-map text-mode-map)
-  (define-abbrev-table 'text-mode-abbrev-table ())
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (set-syntax-table text-mode-syntax-table)
-  (make-local-variable 'indent-line-function)
-  (setq indent-line-function 'indent-relative-maybe)
-  (make-local-variable 'paragraph-start)
-  (setq paragraph-start (concat "$\\|" page-delimiter))
-  (make-local-variable 'paragraph-separate)
-  (setq paragraph-separate paragraph-start)
-  (use-local-map indented-text-mode-map)
-  (setq mode-name "Indented Text")
-  (setq major-mode 'indented-text-mode)
-  (run-hooks 'text-mode-hook 'indented-text-mode-hook))
-
-(defun center-paragraph ()
-  "Center each nonblank line in the paragraph at or after point.
-See `center-line' for more info."
-  (interactive)
-  (save-excursion
-    (forward-paragraph)
-    (or (bolp) (newline 1))
-    (let ((end (point)))
-      (backward-paragraph)
-      (center-region (point) end))))
-
-(defun center-region (from to)
-  "Center each nonblank line starting in the region.
-See `center-line' for more info."
-  (interactive "r")
-  (if (> from to)
-      (let ((tem to))
-	(setq to from from tem)))
-  (save-excursion
-    (save-restriction
-      (narrow-to-region from to)
-      (goto-char from)
-      (while (not (eobp))
-	(or (save-excursion (skip-chars-forward " \t") (eolp))
-	    (center-line))
-	(forward-line 1)))))
-
-(defun center-line (&optional nlines)
-  "Center the line point is on, within the width specified by `fill-column'.
-This means adjusting the indentation so that it equals
-the distance between the end of the text and `fill-column'.
-The argument NLINES says how many lines to center."
-  (interactive "P")
-  (if nlines (setq nlines (prefix-numeric-value nlines)))
-  (while (not (eq nlines 0))
-    (save-excursion
-      (let ((lm (current-left-margin))
-	    line-length)
-	(beginning-of-line)
-	(delete-horizontal-space)
-	(end-of-line)
-	(delete-horizontal-space)
-	(setq line-length (current-column))
-	(if (> (- fill-column lm line-length) 0)
-	    (indent-line-to 
-	     (+ lm (/ (- fill-column lm line-length) 2))))))
-    (cond ((null nlines)
-	   (setq nlines 0))
-	  ((> nlines 0)
-	   (setq nlines (1- nlines))
-	   (forward-line 1))
-	  ((< nlines 0)
-	   (setq nlines (1+ nlines))
-	   (forward-line -1)))))
-
-;;; text-mode.el ends here
diff --git a/lisp/textmodes/two-column.el b/lisp/textmodes/two-column.el
deleted file mode 100644
index 1fa8474c9b9..00000000000
--- a/lisp/textmodes/two-column.el
+++ /dev/null
@@ -1,624 +0,0 @@
-;;; two-column.el --- minor mode for editing of two-column text
-
-;; Copyright (C) 1992, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: Daniel.Pfeiffer@Informatik.START.dbp.de, fax (+49 69) 7588-2389
-;; Adapted-By: ESR, Daniel Pfeiffer
-
-;; Esperanto:				 English:
-
-;; ^Ci dosiero estas ero de GNU Emacs.	 This file is part of GNU Emacs.
-
-;; GNU  Emacs estas libera  programaro;	 GNU Emacs is free software; you can
-;; vi povas disdoni ^gin kaj/a^u modifi	 redistribute it and/or modify it
-;; ^gin sub  la  kondi^coj  de  la  GNU	 under the terms of the GNU General
-;; ^Generala  Publika Licenco kiel pub-	 Public License as published by the
-;; likigita far la Liberprogramara Fon-	 Free Software Foundation; either
-;; da^jo; a^u eldono 2a,  a^u (la^u via	 version 2, or (at your option) any
-;; elekto) ajna posta eldono.		 later version.
-
-;; GNU  Emacs  estas  disdonata  en  la	 GNU Emacs is distributed in the hope
-;; espero ke  ^gi estos utila,  sed SEN	 that it will be useful, but WITHOUT
-;; IA  GARANTIO;  sen e^c  la implicita	 ANY WARRANTY; without even the
-;; garantio  de VENDEBLECO  a^u PRETECO	 implied warranty of MERCHANTABILITY
-;; POR  DETERMINITA CELO.  Vidu la  GNU	 or FITNESS FOR A PARTICULAR PURPOSE.
-;; ^Generala Publika Licenco por plenaj	 See the GNU General Public License
-;; detaloj.				 for more details.
-
-;; Vi devus ricevinti kopion de la  GNU	 You should have received a copy of
-;; ^Generala  Publika  Licenco kune kun	 the GNU General Public License along
-;; GNU Emacs; vidu la dosieron COPYING.	 with GNU Emacs; see the file
-;; Alikaze skribu al la			 COPYING.  If not, write to the
-
-;; Free Software Foundation, 59 Temple Place - Suite 330
-;; Boston, MA 02111-1307, USA.
-
-
-;;; Komentario:				 Commentary:
-
-;; Tiu  programaro ebligas  vin redakti	 This package gives you the ability
-;; dukolumnan tekston.			 to edit text in a two-column format.
-
-
-;; Vi  havas  tri eblecojn por eki tiun	 You have three ways to start up this
-;; mal^cefan modalon.  ^Ciu donas al vi	 minor mode.  Each gives you a
-;; horizontale disigatan fenestron, si-	 horizontally split window similar to
-;; milan al fina apareco de via teksto:	 the final outcome of your text:
-
-
-;; f2 2	    asocias  novan  bufron  nomatan  associates a new  buffer called
-;; C-x 6 2  same, sed kun 2C/ anta^u.	     the   same,    but   with   2C/
-;;					     prepended.
-
-;; f2 b	    asocias alian bufron.  Vi povas  associates    another   buffer.
-;; C-x 6 b  anka^u asocii  dataron,   se vi  This can be used to associate a
-;;	    ^jus anta^ue faris C-x C-f.	     file if you just did C-x C-f.
-
-;; f2 s	    disigas  jam dukolumnan tekston  splits a  two-column  text into
-;; C-x 6 s  en  du   bufroj  ekde  la  nuna  two  buffers from  the  current
-;;	    linio,  kaj je la nuna kolumno.  line and at the current column.
-;;	    La    anta^uaj   signoj   (ofte  The preceding characters (often
-;;	    tabeligilo  a^u  |)  estas   la  tab   or  |)  are   the  column
-;;	    kolumna disiganto.  Linioj kiuj  separator.   Lines  that  don't
-;;	    ne   enhavas   ilin   ne  estas  have them  won't  be separated.
-;;	    disigitaj.   Kiel  la kvara kaj  Like the  fourth and fifth line
-;;	    la   kvina  linio se vi disigas  if  you split this  file from
-;;	    ^ci dataron ekde la unua  angla  the first english word.
-;;	    vorto.
-
-;; Se  vi  volas  meti  longajn liniojn	 If you include long lines, i.e which
-;; (ekz. programerojn) en la  kunigotan	 will span both columns  (eg.  source
-;; tekston,   ili  devas  esti  en   la	 code), they should  be  in what will
-;; estonte unua kolumno.  La alia devas	 be the    first column,    with  the
-;; havi vakajn linion apud ili.		 associated buffer having empty lines
-;;					 next to them.
-
-;; Averto: en Emacs kiam vi ^san^gas la	 Attention:  in Emacs when you change
-;; ^cefan modalon, la mal^cefaj modaloj	 the major mode,  the minor modes are
-;; estas  anka^u  elmemorigitaj.   Tiu-	 also  purged  from  memory.  In that
-;; okaze  vi devas religi la du bufrojn	 case you   must  reassociate the two
-;; per iu  C-x 6-ordono,  ekz. C-x 6 b.	 buffers with any C-x 6-command, e.g.
-;;					 C-x 6 b.
-
-;; Kiam   vi   estos  kontenta   de  la	 When you have edited both buffers to
-;; rezulto, vi kunmetos la du kolumnojn	 your  content,  you merge them  with
-;; per  C-x 6 1.   Se  vi  poste  vidas	 C-x 6 1.  If you then see a problem,
-;; problemon, vi  neniigu   la kunmeton	 you undo the  merge with  C-x u  and
-;; per C-x u  kaj  plue  modifu  la  du	 continue   to  edit the two buffers.
-;; bufrojn.  Kiam vi ne plu volas tajpi	 When you  no longer  want to edit in
-;; dukolumne,  vi  eliru el la mal^cefa	 two  columns, you turn off the minor
-;; modalo per C-x 6 d.			 mode with C-x 6 d.
-
-
-;; Aldone al dukolumna  redaktado,  ek-	 In addition to two-column editing of
-;; zemple por  skribi dulingvan tekston	 text, for example for writing a
-;; flank-al-flanke kiel ^ci tiu,  aliaj	 bilingual text side-by-side as shown
-;; interesaj uzoj trovitas por tiu mal-	 here, other interesting uses have
-;; ^cefa modalo:			 been found for this minor mode:
-
-;; Vi povas  disigi la  kolumnojn per {+} You can separate the columns with
-;; ajna   pla^ca   ^ceno   starigante {+} any string that pleases you, by
-;; `2C-separator'.   Ekzemple  "{+} " {+} setting `2C-separator'.  For example
-;; por  amuzi^gi.  f2 s  a^u  C-x 6 s {+} "{+} " if you'd like to have fun.
-;; traktas   tiujn    kun    prefiksa {+} f2 s or C-x 6 s handles these with a
-;; argumento  kiu  signifas la longon {+} prefix argument that means the
-;; de tia ^ceno.		      {+} desired length of such a string.
-
-
-;; Programistoj eble ^satus la  eblecon  Programmers might like the ability
-;; forspliti la komentarian kolumnon de  to split off the comment column of a
-;; dosiero  kiel la sekvanta.  Vi povas  file that looks like the following.
-;; rearan^gigi  la paragrafon.  La pro-  You can fill-paragraph the comment.
-;; blemo  estas  ke  koda^jo tuj   lar-  The problem is, code quickly gets
-;; ^gi^gas,  tiel  ke vi  bezonas   pli  rather wide, so you need to use a
-;; mallar^gan   komentarian   kolumnon.  narrower comment column.  Code lines
-;; Koda^jaj linioj tra `comment-column'  that reach beyond `comment-column'
-;; ne problemas,  krom  ke vi ne  vidos  are no problem, except that you
-;; iliajn finojn dum redaktado.		 won't see their end during editing.
-
-
-;; BEGIN				-- This is just some meaningless
-;;     FOR i IN 1..10 LOOP		-- code in Ada, that runs foobar
-;;	   foobar( i );			-- once for each argument from one
-;;     END LOOP;			-- to ten, and then we're already
-;; END;					-- through with it.
-
-;; Pli bone ankora^u, vi povas  pozici-	 Better yet, you can put the point
-;; i^gi anta^u "This",  tajpi  M-3 f2 s	 before "This", type  M-3 f2 s
-;; kiu  igas "-- " la separigilon inter	 which makes "-- " the separator
-;; senkomentaria  Ada  bufro  kaj  nur-	 between a no-comments Ada buffer,
-;; teksta  komentaria  bufro.   Kiam vi	 and a plain text comment buffer.
-;; denove  kuni^gos ilin,  ^ciu  nevaka	 When you put them back together,
-;; linio  de  l'  dua  kolumno   denove	 every non-empty line of the 2nd
-;; anta^uhavos "-- ".			 column will again be preceded by
-;;					 "-- ".
-
-
-;;; Code:
-
-
-;; Lucid patch
-(or (fboundp 'frame-width)
-    (fset 'frame-width 'screen-width))
-
-
-;;;;; Set up keymap ;;;;;
-
-(defvar 2C-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "2" '2C-two-columns)
-    (define-key map [f2] '2C-two-columns)
-    (define-key map "b" '2C-associate-buffer)
-    (define-key map "s" '2C-split)
-    map)
-  "Keymap for commands for setting up two-column mode.")
-
-
-
-;;;###autoload (autoload '2C-command "two-column" () t 'keymap)
-(fset '2C-command 2C-mode-map)
-
-;;;###autoload
-;; This one is for historical reasons and simple keyboards, it is not
-;; at all mnemonic.  All usual sequences containing 2 were used, and
-;; f2 could not be set up in a standard way under Emacs 18.
-(global-set-key "\C-x6" '2C-command)
-
-
-;;;###autoload
-(global-set-key [f2] '2C-command)
-
-
-(defvar 2C-minor-mode-map
-  (let ((map (make-sparse-keymap)))
-    (define-key map "1" '2C-merge)
-    (define-key map "d" '2C-dissociate)
-    (define-key map "o" '2C-associated-buffer)
-    (define-key map "\^m" '2C-newline)
-    (define-key map "|" '2C-toggle-autoscroll)
-    (define-key map "{" '2C-shrink-window-horizontally)
-    (define-key map "}" '2C-enlarge-window-horizontally)
-    map)
-  "Keymap for commands for use in two-column mode.")
-
-
-(setq minor-mode-map-alist
-      (cons (cons '2C-mode
-		  (let ((map (make-sparse-keymap)))
-		    (substitute-key-definition '2C-command 2C-minor-mode-map
-					       map (current-global-map))
-		    (substitute-key-definition 'enlarge-window-horizontally
-					       '2C-enlarge-window-horizontally
-					       map (current-global-map))
-		    (substitute-key-definition 'shrink-window-horizontally
-					       '2C-shrink-window-horizontally
-					       map (current-global-map))
-		    map))
-	    minor-mode-map-alist))
-
-;;;;; variable declarations ;;;;;
-
-;; Markers seem to be the only buffer-id not affected by renaming a buffer.
-;; This nevertheless loses when a buffer is killed.  The variable-name is
-;; required by `describe-mode'.
-(defvar 2C-mode nil
-  "Marker to the associated buffer, if non-nil.")
-(make-variable-buffer-local '2C-mode)
-(put '2C-mode 'permanent-local t)
-
-
-
-(setq minor-mode-alist (cons '(2C-mode " 2C") minor-mode-alist))
-
-
-
-;; rearranged, so that the pertinent info will show in 40 columns
-(defvar 2C-mode-line-format
-	'("-%*- %15b --"  (-3 . "%p")  "--%[("  mode-name
-	  minor-mode-alist  "%n"  mode-line-process  ")%]%-")
-  "*Value of mode-line-format for a buffer in two-column minor mode.")
-
-
-(defvar 2C-other-buffer-hook 'text-mode
-  "*Hook run in new buffer when it is associated with current one.")
-
-
-(defvar 2C-separator ""
-  "*A string inserted between the two columns when merging.
-This gets set locally by \\[2C-split].")
-(put '2C-separator 'permanent-local t)
-
-
-
-(defvar 2C-window-width 40
-  "*The width of the first column.  (Must be at least `window-min-width')
-This value is local for every buffer that sets it.")
-(make-variable-buffer-local '2C-window-width)
-(put '2C-window-width 'permanent-local t)
-
-
-
-(defvar 2C-beyond-fill-column 4
-  "*Base for calculating `fill-column' for a buffer in two-column minor mode.
-The value of `fill-column' becomes `2C-window-width' for this buffer
-minus this value.")
-
-
-
-(defvar 2C-autoscroll t
-  "If non-nil, Emacs attempts to keep the two column's buffers aligned.")
-
-
-
-(defvar 2C-autoscroll-start nil)
-(make-variable-buffer-local '2C-autoscroll-start)
-
-;;;;; base functions ;;;;;
-
-;; The access method for the other buffer.  This tries to remedy against
-;; lost local variables and lost buffers.
-(defun 2C-other (&optional req)
-  (or (if 2C-mode
-	  (or (prog1
-		  (marker-buffer 2C-mode)
-		(setq mode-line-format 2C-mode-line-format))
-	      ;; The associated buffer somehow got killed.
-	      (progn
-		;; The other variables may later be useful if the user
-		;; reestablishes the association.
-		(kill-local-variable '2C-mode)
-		(kill-local-variable 'mode-line-format)
-		nil)))
-      (if req (error "You must first set two-column minor mode."))))
-
-
-
-;; function for setting up two-column minor mode in a buffer associated
-;; with the buffer pointed to by the marker other.
-(defun 2C-mode (other)
-  "Minor mode for independently editing two columns.
-This is set up for two associated buffers by the three commands bound
-to  \\[2C-two-columns] ,  \\[2C-associate-buffer]  and  \\[2C-split].
-Turning on two-column mode calls the value of the variable `2C-mode-hook',
-if that value is non-nil.
-
-These buffers can be edited separately, for example with `fill-paragraph'.
-If you want to disable parallel scrolling temporarily, use  \\[2C-toggle-autoscroll] .
-
-If you include long lines, i.e which will span both columns (eg.
-source code), they should be in what will be the first column, with
-the associated buffer having empty lines next to them.
-
-Potential uses are writing bilingual texts, or editing the comments of a
-source code.  See the file lisp/two-column.el for detailed examples.
-
-You have the following commands at your disposal:
-
-\\[2C-two-columns]   Rearrange screen with current buffer first
-\\[2C-associate-buffer]   Reassociate buffer after changing major mode
-\\[shrink-window-horizontally], \\[enlarge-window-horizontally]   Shrink, enlarge current column
-\\[2C-associated-buffer]   Switch to associated buffer at same point
-\\[2C-newline] Insert newline(s) in both buffers at same point
-\\[2C-merge]   Merge both buffers
-\\[2C-dissociate]   Dissociate the two buffers
-
-These keybindings can be customized in your ~/.emacs by `2C-mode-map',
-`2C-minor-mode-map' and by binding `2C-command' to some prefix.
-
-The appearance of the screen can be customized by the variables
-`2C-window-width', `2C-beyond-fill-column', `2C-mode-line-format' and
-`truncate-partial-width-windows'."
-  (make-local-hook 'post-command-hook)
-  (add-hook 'post-command-hook '2C-autoscroll nil t)
-  (setq fill-column (- 2C-window-width
-		       2C-beyond-fill-column)
-	mode-line-format 2C-mode-line-format
-	2C-mode other)
-  (run-hooks '2C-mode-hook))
-
-
-
-;;;###autoload
-(defun 2C-two-columns (&optional buffer)
-  "Split current window vertically for two-column editing.
-When called the first time, associates a buffer with the current
-buffer in two-column minor mode (see  \\[describe-mode] ).
-Runs `2C-other-buffer-hook' in the new buffer.
-When called again, restores the screen layout with the current buffer
-first and the associated buffer to its right."
-  (interactive "P")
-  ;; first go to full width, so that we can certainly split into two windows
-  (if (< (window-width) (frame-width))
-      (enlarge-window 99999 t))
-  (split-window-horizontally
-   (max window-min-width (min 2C-window-width
-			      (- (frame-width) window-min-width))))
-  (if (2C-other)
-      (progn
-	(other-window 1)
-	(switch-to-buffer (2C-other))
-	(other-window -1)
-	(if 2C-autoscroll
-	    (2C-toggle-autoscroll t)))
-
-    (2C-mode (prog1 (point-marker)
-	       (other-window 1)
-	       (switch-to-buffer
-		(or buffer
-		    (generate-new-buffer (concat "2C/" (buffer-name)))))
-	       (or buffer
-		   (run-hooks '2C-other-buffer-hook))))
-    
-    (2C-mode (prog1 (point-marker)
-	       (other-window -1)))))
-
-
-
-;;;###autoload
-(defun 2C-associate-buffer ()
-  "Associate another buffer with this one in two-column minor mode.
-Can also be used to associate a just previously visited file, by
-accepting the proposed default buffer.
-
-\(See  \\[describe-mode] .)"
-  (interactive)
-  (let ((b1 (current-buffer))
-	(b2 (or (2C-other)
-		(read-buffer "Associate buffer: " (other-buffer)))))
-    (save-excursion
-      (setq 2C-mode nil)
-      (set-buffer b2)
-      (and (2C-other)
-	   (not (eq b1 (2C-other)))
-	   (error "Buffer already associated with buffer `%s'."
-		  (buffer-name (2C-other))))
-      (setq b1 (and (assq '2C-window-width (buffer-local-variables))
-		    2C-window-width)))
-    ; if other buffer has a local width, adjust here too
-    (if b1 (setq 2C-window-width (- (frame-width) b1)))
-    (2C-two-columns b2)))
-
-
-
-;;;###autoload
-(defun 2C-split (arg)
-  "Split a two-column text at point, into two buffers in two-column minor mode.
-Point becomes the local value of `2C-window-width'.  Only lines that
-have the ARG same preceding characters at that column get split.  The
-ARG preceding characters without any leading whitespace become the local
-value for `2C-separator'.  This way lines that continue across both
-columns remain untouched in the first buffer.
-
-This function can be used with a prototype line, to set up things.  You
-write the first line of each column and then split that line.  E.g.:
-
-First column's text    sSs  Second column's text
-		       \\___/\\
-			/    \\
-   5 character Separator      You type  M-5 \\[2C-split]  with the point here.
-
-\(See  \\[describe-mode] .)"
-  (interactive "*p")
-  (and (2C-other)
-       (if (y-or-n-p (concat "Overwrite associated buffer `"
-			     (buffer-name (2C-other))
-			     "'? "))
-	   (save-excursion
-	     (set-buffer (2C-other))
-	     (erase-buffer))
-	 (signal 'quit nil)))
-  (let ((point (point))
-	; make next-line always come back to same column
-	(goal-column (current-column))
-	; a counter for empty lines in other buffer
-	(n (1- (count-lines (point-min) (point))))
-	chars other)
-    (save-excursion
-      (backward-char arg)
-      (setq chars (buffer-substring (point) point))
-      (skip-chars-forward " \t" point)
-      (make-local-variable '2C-separator)
-      (setq 2C-separator (buffer-substring (point) point)
-	    2C-window-width (current-column)))
-    (2C-two-columns)
-    (setq other (2C-other))
-    ; now we're ready to actually split
-    (save-excursion
-      (while (not (eobp))
-	(if (not (and (= (current-column) goal-column)
-		      (string= chars
-			       (buffer-substring (point)
-						 (save-excursion
-						   (backward-char arg)
-						   (point))))))
-	    (setq n (1+ n))
-	  (setq point (point))
-	  (backward-char arg)
-	  (skip-chars-backward " \t")
-	  (delete-region point (point))
-	  (setq point (point))
-	  (insert-char ?\n n)
-	  (append-to-buffer other point (progn (end-of-line)
-					       (if (eobp)
-						   (point)
-						 (1+ (point)))))
-	  (delete-region point (point))
-	  (setq n 0))
-	(next-line 1)))))
-
-
-
-
-(defun 2C-dissociate ()
-  "Turn off two-column minor mode in current and associated buffer.
-If the associated buffer is unmodified and empty, it is killed."
-  (interactive)
-  (let ((buffer (current-buffer)))
-    (save-excursion
-      (and (2C-other)
-	   (set-buffer (2C-other))
-	   (or (not (2C-other))
-	       (eq buffer (2C-other)))
-	   (if (and (not (buffer-modified-p))
-		    (eobp) (bobp))
-	       (kill-buffer nil)
-	     (kill-local-variable '2C-mode)
-	     (kill-local-variable '2C-window-width)
-	     (kill-local-variable '2C-separator)
-	     (kill-local-variable 'mode-line-format)
-	     (kill-local-variable 'fill-column))))
-    (kill-local-variable '2C-mode)
-    (kill-local-variable '2C-window-width)
-    (kill-local-variable '2C-separator)
-    (kill-local-variable 'mode-line-format)
-    (kill-local-variable 'fill-column)))
-
-
-
-;; this doesn't use yank-rectangle, so that the first column can
-;; contain long lines
-(defun 2C-merge ()
-  "Merges the associated buffer with the current buffer.
-They get merged at the column, which is the value of `2C-window-width',
-i.e. usually at the vertical window separator.  This separator gets
-replaced with white space.  Beyond that the value of `2C-separator' gets
-inserted on merged lines.  The two columns are thus pasted side by side,
-in a single text.  If the other buffer is not displayed to the left of
-this one, then this one becomes the left column.
-
-If you want `2C-separator' on empty lines in the second column,
-you should put just one space in them.  In the final result, you can strip
-off trailing spaces with \\[beginning-of-buffer] \\[replace-regexp] [ SPC TAB ] + $ RET RET"
-  (interactive)
-  (and (> (car (window-edges)) 0)	; not touching left edge of screen
-       (eq (window-buffer (previous-window))
-	   (2C-other t))
-       (other-window -1))
-  (save-excursion
-    (let ((b1 (current-buffer))
-	  (b2 (2C-other t))
-	  string)
-      (goto-char (point-min))
-      (set-buffer b2)
-      (goto-char (point-min))
-      (while (not (eobp))
-	(setq string (buffer-substring (point)
-				       (progn (end-of-line) (point))))
-	(or (eobp)
-	    (forward-char))		; next line
-	(set-buffer b1)
-	(if (string= string "")
-	    ()
-	  (end-of-line)
-	  (indent-to-column 2C-window-width)
-	  (insert 2C-separator string))
-	(next-line 1)			; add one if necessary
-	(set-buffer b2))))
-  (if (< (window-width) (frame-width))
-      (enlarge-window 99999 t)))
-
-;;;;; utility functions ;;;;;
-
-(defun 2C-associated-buffer ()
-  "Switch to associated buffer."
-  (interactive)
-  (let ((line (+ (count-lines (point-min) (point))
-		 (if (bolp) 1 0)))
-	(col (if (eolp) (if (bolp) 0) (current-column))))
-    (if (get-buffer-window (2C-other t))
-	(select-window (get-buffer-window (2C-other)))
-      (switch-to-buffer (2C-other)))
-    (newline (goto-line line))
-    (if col
-	(move-to-column col)
-      (end-of-line 1))))
-
-(defun 2C-newline (arg)
-  "Insert ARG newlines in both buffers."
-  (interactive "P")
-  (save-window-excursion
-    (2C-associated-buffer)
-    (newline arg))
-  (newline arg))
-
-(defun 2C-toggle-autoscroll (arg)
-  "Toggle autoscrolling, or set it iff prefix ARG is non-nil and positive.
-When autoscrolling is turned on, this also realigns the two buffers."
-  (interactive "P")
-  ;(sit-for 0)
-  (setq 2C-autoscroll-start (window-start))
-  (if (setq 2C-autoscroll (if arg
-			      (>= (prefix-numeric-value arg) 0)
-			    (not 2C-autoscroll)))
-      (select-window
-       (prog1 (selected-window)
-	 (message "Autoscrolling is on.")
-	 (setq arg (count-lines (point-min) (window-start)))
-	 (if (get-buffer-window (2C-other t))
-	     (progn
-	       (select-window (get-buffer-window (2C-other)))
-	       (setq arg (- arg (count-lines (point-min) (window-start))))
-	       ;; make sure that other buffer has enough lines
-	       (save-excursion
-		 (insert-char ?\n
-			      (- arg (count-lines (window-start)
-						  (goto-char (point-max)))
-				 -1)))
-	       (scroll-up arg)))))
-    (message "Autoscrolling is off.")))
-
-
-
-(defun 2C-autoscroll ()
-  (if 2C-autoscroll
-      ;; catch a mouse scroll on non-selected scrollbar
-      (select-window
-       (prog1 (selected-window)
-	 (and (consp last-command-char)
-	      (not (eq (selected-window)
-		       (car (car (cdr last-command-char)))))
-	      (select-window (car (car (cdr last-command-char)))))
-	 ;; In some cases scrolling causes an error, but post-command-hook
-	 ;; shouldn't, and should always stay in the original window
-	 (condition-case ()
-	     (and (or 2C-autoscroll-start (2C-toggle-autoscroll t) nil)
-		  (/= (window-start) 2C-autoscroll-start)
-		  (2C-other)
-		  (get-buffer-window (2C-other))
-		  (let ((lines (count-lines (window-start)
-					    2C-autoscroll-start)))
-		    (if (< (window-start) 2C-autoscroll-start)
-			(setq lines (- lines)))
-		    (setq 2C-autoscroll-start (window-start))
-		    (select-window (get-buffer-window (2C-other)))
-		    ;; make sure that other buffer has enough lines
-		    (save-excursion
-		      (insert-char
-		       ?\n (- lines (count-lines (window-start)
-						 (goto-char (point-max)))
-			      -1)))
-		    (scroll-up lines)
-		    (setq 2C-autoscroll-start (window-start))))
-	   (error))))))
-
-
-
-(defun 2C-enlarge-window-horizontally (arg)
-  "Make current window ARG columns wider."
-  (interactive "p")
-  (enlarge-window arg t)
-  (and (2C-other)
-       (setq 2C-window-width (+ 2C-window-width arg))
-       (set-buffer (2C-other))
-       (setq 2C-window-width (- 2C-window-width arg))))
-
-(defun 2C-shrink-window-horizontally (arg)
-  "Make current window ARG columns narrower."
-  (interactive "p")
-  (2C-enlarge-window-horizontally (- arg)))
-
-
-
-(provide 'two-column)
-
-;;; two-column.el ends here
diff --git a/lisp/textmodes/underline.el b/lisp/textmodes/underline.el
deleted file mode 100644
index 91dc0b2c2f8..00000000000
--- a/lisp/textmodes/underline.el
+++ /dev/null
@@ -1,63 +0,0 @@
-;;; underline.el --- insert/remove underlining (done by overstriking) in Emacs.
-
-;; Copyright (C) 1985 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: wp
-
-;; 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 deals with the primitive form of underlining
-;; consisting of prefixing each character with "_\^h".  The entry
-;; point `underline-region' performs such underlining on a region.
-;; The entry point `ununderline-region' removes it.
-
-;;; Code:
-
-;;;###autoload
-(defun underline-region (start end)
-  "Underline all nonblank characters in the region.
-Works by overstriking underscores.
-Called from program, takes two arguments START and END
-which specify the range to operate on."
-  (interactive "r")
-  (save-excursion
-   (let ((end1 (make-marker)))
-     (move-marker end1 (max start end))
-     (goto-char (min start end))
-     (while (< (point) end1)
-       (or (looking-at "[_\^@- ]")
-	   (insert "_\b"))
-       (forward-char 1)))))
-
-;;;###autoload
-(defun ununderline-region (start end)
-  "Remove all underlining (overstruck underscores) in the region.
-Called from program, takes two arguments START and END
-which specify the range to operate on."
-  (interactive "r")
-  (save-excursion
-   (let ((end1 (make-marker)))
-     (move-marker end1 (max start end))
-     (goto-char (min start end))
-     (while (re-search-forward "_\b\\|\b_" end1 t)
-       (delete-char -2)))))
-
-;;; underline.el ends here
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
deleted file mode 100644
index fda31632aa1..00000000000
--- a/lisp/thingatpt.el
+++ /dev/null
@@ -1,256 +0,0 @@
-;;; thingatpt.el --- Get the `thing' at point
-
-;; Copyright (C) 1991,92,93,94,95,1996 Free Software Foundation, Inc.
-
-;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
-;; Keywords: extensions, matching, mouse
-;; Created: Thu Mar 28 13:48:23 1991
-
-;; 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.
-
-;;; Commentary:
-
-;; This file provides routines for getting the "thing" at the location of
-;; point, whatever that "thing" happens to be.  The "thing" is defined by
-;; its beginning and end positions in the buffer.
-;;
-;; The function bounds-of-thing-at-point finds the beginning and end
-;; positions by moving first forward to the end of the "thing", and then
-;; backwards to the beginning.  By default, it uses the corresponding
-;; forward-"thing" operator (eg. forward-word, forward-line).
-;;
-;; Special cases are allowed for using properties associated with the named
-;; "thing": 
-;;
-;;   forward-op		Function to call to skip forward over a "thing" (or
-;;                      with a negative argument, backward).
-;;                      
-;;   beginning-op	Function to call to skip to the beginning of a "thing".
-;;   end-op		Function to call to skip to the end of a "thing".
-;;
-;; Reliance on existing operators means that many `things' can be accessed
-;; without further code:  eg.
-;;     (thing-at-point 'line)
-;;     (thing-at-point 'page)
-
-;;; Code:
-
-(provide 'thingatpt)
-
-;; Basic movement
-
-;;;###autoload
-(defun forward-thing (thing &optional n)
-  "Move forward to the end of the next THING."
-  (let ((forward-op (or (get thing 'forward-op)
-			(intern-soft (format "forward-%s" thing)))))
-    (if (fboundp forward-op)
-	(funcall forward-op (or n 1))
-      (error "Can't determine how to move over a %s" thing))))
-
-;; General routines
-
-;;;###autoload
-(defun bounds-of-thing-at-point (thing)
-  "Determine the start and end buffer locations for the THING at point.
-THING is a symbol which specifies the kind of syntactic entity you want.
-Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
-`word', `sentence', `whitespace', `line', `page' and others.
-
-See the file `thingatpt.el' for documentation on how to define
-a symbol as a valid THING.
-
-The value is a cons cell (START . END) giving the start and end positions
-of the textual entity that was found."
-  (let ((orig (point)))
-    (condition-case nil
-	(save-excursion
-	  (let ((end (progn 
-		       (funcall 
-			(or (get thing 'end-op) 
-			    (function (lambda () (forward-thing thing 1)))))
-		       (point)))
-		(beg (progn 
-		       (funcall 
-			(or (get thing 'beginning-op) 
-			    (function (lambda () (forward-thing thing -1)))))
-		       (point))))
-	    (if (and beg end (<= beg orig) (<= orig end))
-		(cons beg end)
-	      ;; Try a second time, moving backward first and forward after,
-	      ;; so that we can find a thing that ends at ORIG.
-	      (let ((beg (progn 
-			   (funcall 
-			    (or (get thing 'beginning-op) 
-				(function (lambda () (forward-thing thing -1)))))
-			   (point)))
-		    (end (progn 
-			   (funcall 
-			    (or (get thing 'end-op) 
-				(function (lambda () (forward-thing thing 1)))))
-			   (point))))
-		(if (and beg end (<= beg orig) (<= orig end))
-		    (cons beg end))))))
-      (error nil))))
-
-;;;###autoload
-(defun thing-at-point (thing)
-  "Return the THING at point.
-THING is a symbol which specifies the kind of syntactic entity you want.
-Possibilities include `symbol', `list', `sexp', `defun', `filename', `url',
-`word', `sentence', `whitespace', `line', `page' and others.
-
-See the file `thingatpt.el' for documentation on how to define
-a symbol as a valid THING."
-  (let ((bounds (bounds-of-thing-at-point thing)))
-    (if bounds 
-	(buffer-substring (car bounds) (cdr bounds)))))
-
-;; Go to beginning/end
-
-(defun beginning-of-thing (thing)
-  (let ((bounds (bounds-of-thing-at-point thing)))
-    (or bounds (error "No %s here" thing))
-    (goto-char (car bounds))))
-
-(defun end-of-thing (thing)
-  (let ((bounds (bounds-of-thing-at-point thing)))
-    (or bounds (error "No %s here" thing))
-    (goto-char (cdr bounds))))
-
-;;  Special cases 
-
-;;  Lines 
-
-;; bolp will be false when you click on the last line in the buffer
-;; and it has no final newline.
-
-(put 'line 'beginning-op
-     (function (lambda () (if (bolp) (forward-line -1) (beginning-of-line)))))
-
-;;  Sexps 
-
-(defun in-string-p ()
-  (let ((orig (point)))
-    (save-excursion
-      (beginning-of-defun)
-      (nth 3 (parse-partial-sexp (point) orig)))))
-
-(defun end-of-sexp ()
-  (let ((char-syntax (char-syntax (char-after (point)))))
-    (if (or (eq char-syntax ?\))
-	    (and (eq char-syntax ?\") (in-string-p)))
-	(forward-char 1)
-      (forward-sexp 1))))
-
-(put 'sexp 'end-op 'end-of-sexp)
-
-;;  Lists 
-
-(put 'list 'end-op (function (lambda () (up-list 1))))
-(put 'list 'beginning-op 'backward-sexp)
-
-;;  Filenames and URLs
-
-(defvar thing-at-point-file-name-chars "~/A-Za-z0-9---_.${}#%,:"
-  "Characters allowable in filenames.")
-
-(put 'filename 'end-op    
-     '(lambda () (skip-chars-forward thing-at-point-file-name-chars)))
-(put 'filename 'beginning-op
-     '(lambda () (skip-chars-backward thing-at-point-file-name-chars)))
-
-(defvar thing-at-point-url-chars "~/A-Za-z0-9---_@$%&=.,"
-  "Characters allowable in a URL.")
-
-(put 'url 'end-op    
-     '(lambda () (skip-chars-forward (concat ":" thing-at-point-url-chars))
-	(skip-chars-backward ".,:")))
-(put 'url 'beginning-op
-     '(lambda ()
-	(skip-chars-backward thing-at-point-url-chars)
-	(or (= (preceding-char) ?:)
-	    (error "No URL here"))
-	(forward-char -1)
-	(skip-chars-backward "a-zA-Z")))
-
-;;  Whitespace 
-
-(defun forward-whitespace (arg)
-  (interactive "p")
-  (if (natnump arg) 
-      (re-search-forward "[ \t]+\\|\n" nil nil arg)
-    (while (< arg 0)
-      (if (re-search-backward "[ \t]+\\|\n" nil nil)
-	  (or (eq (char-after (match-beginning 0)) 10)
-	      (skip-chars-backward " \t")))
-      (setq arg (1+ arg)))))
-
-;;  Buffer 
-
-(put 'buffer 'end-op 'end-of-buffer)
-(put 'buffer 'beginning-op 'beginning-of-buffer)
-
-;;  Symbols 
-
-(defun forward-symbol (arg)
-  (interactive "p")
-  (if (natnump arg) 
-      (re-search-forward "\\(\\sw\\|\\s_\\)+" nil nil arg)
-    (while (< arg 0)
-      (if (re-search-backward "\\(\\sw\\|\\s_\\)+" nil nil)
-	  (skip-syntax-backward "w_"))
-      (setq arg (1+ arg)))))
-
-;;  Syntax blocks 
-
-(defun forward-same-syntax (&optional arg)
-  (interactive "p")
-  (while (< arg 0)
-    (skip-syntax-backward 
-     (char-to-string (char-syntax (char-after (1- (point))))))
-    (setq arg (1+ arg)))
-  (while (> arg 0)
-    (skip-syntax-forward (char-to-string (char-syntax (char-after (point)))))
-    (setq arg (1- arg))))
-
-;;  Aliases 
-
-(defun word-at-point () (thing-at-point 'word))
-(defun sentence-at-point () (thing-at-point 'sentence))
-
-(defun read-from-whole-string (str)
-  "Read a lisp expression from STR.
-Signal an error if the entire string was not used."
-  (let* ((read-data (read-from-string str))
-	 (more-left 
-	  (condition-case nil
-	      (progn (read-from-string (substring str (cdr read-data)))
-		     t)
-	    (end-of-file nil))))
-    (if more-left
-	(error "Can't read whole string")
-      (car read-data))))
-
-(defun form-at-point (&optional thing pred) 
-  (let ((sexp (condition-case nil 
-		  (read-from-whole-string (thing-at-point (or thing 'sexp)))
-		(error nil))))
-    (if (or (not pred) (funcall pred sexp)) sexp)))
-
-(defun sexp-at-point ()   (form-at-point 'sexp))
-(defun symbol-at-point () (form-at-point 'sexp 'symbolp))
-(defun number-at-point () (form-at-point 'sexp 'numberp))
-(defun list-at-point ()   (form-at-point 'list 'listp))
-
-;; thingatpt.el ends here.
diff --git a/lisp/time-stamp.el b/lisp/time-stamp.el
deleted file mode 100644
index 85351d741f8..00000000000
--- a/lisp/time-stamp.el
+++ /dev/null
@@ -1,346 +0,0 @@
-;;; time-stamp.el --- Maintain last change time stamps in files edited by Emacs
-
-;; Copyright 1989, 1993, 1994, 1995 Free Software Foundation, Inc.
-
-;; Maintainer's Time-stamp: <1996-08-13 14:03:17 gildea>
-;; Maintainer: Stephen Gildea <gildea@lcs.mit.edu>
-;; Keywords: tools
-
-;; This file 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.
-
-;; This file 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:
-
-;; A template in a file can be updated with a new time stamp when
-;; you save the file.  For example:
-;;     static char *ts = "sdmain.c Time-stamp: <1996-08-13 10:20:51 gildea>";
-;; See the top of `time-stamp.el' for another example.
-
-;; To use time-stamping, add this line to your .emacs file:
-;;     (add-hook 'write-file-hooks 'time-stamp)
-;; Now any time-stamp templates in your files will be updated automatically.
-
-;; See the documentation for the functions `time-stamp'
-;; and `time-stamp-toggle-active' for details.
-
-;;; Change Log:
-
-;; Originally based on the 19 Dec 88 version of
-;;   date.el by John Sturdy <mcvax!harlqn.co.uk!jcgs@uunet.uu.net>
-;; Version 2, January 1995: replaced functions with %-escapes
-;; $Id: time-stamp.el,v 1.23 1996/12/17 00:19:01 rms Exp rms $
-
-;;; Code:
-
-(defvar time-stamp-active t
-  "*Non-nil to enable time-stamping of buffers by \\[time-stamp].
-Can be toggled by \\[time-stamp-toggle-active].
-See also the variable `time-stamp-warn-inactive'.")
-
-(defvar time-stamp-warn-inactive t
-  "Non-nil to have \\[time-stamp] warn if a buffer did not get time-stamped.
-A warning is printed if `time-stamp-active' is nil and the buffer contains
-a time stamp template that would otherwise have been updated.")
-
-(defvar time-stamp-old-format-warn 'ask
-  "Action to take if `time-stamp-format' is an old-style list.
-If `error', the format is not used.  If `ask', the user is queried about
-using the time-stamp-format.  If `warn', a warning is displayed.
-If nil, no notification is given.")
-
-(defvar time-stamp-format "%Y-%m-%d %H:%M:%S %u"
-  "*Format of the string inserted by \\[time-stamp].
-The value may be a string or a list.  Lists are supported only for
-backward compatibility; see variable `time-stamp-old-format-warn'.
-
-A string is used with `format-time-string'.
-For example, to get the format used by the `date' command,
-use \"%3a %3b %2d %H:%M:%S %Z %y\".
-
-In addition to the features of `format-time-string',
-you can use the following %-constructs:
-
-%f  file name without directory
-%F  full file name
-%h  mail host name
-%s  system name
-%u  user's login name")
-
-;;; Do not change time-stamp-line-limit, time-stamp-start, or
-;;; time-stamp-end in your .emacs or you will be incompatible
-;;; with other people's files!  If you must change them,
-;;; do so only in the local variables section of the file itself.
-
-
-(defvar time-stamp-line-limit 8	    ;Do not change!
-  "Lines of a file searched; positive counts from start, negative from end.
-The patterns `time-stamp-start' and `time-stamp-end' must be found on one
-of the first (last) `time-stamp-line-limit' lines of the file for the
-file to be time-stamped by \\[time-stamp].
-
-Do not change `time-stamp-line-limit', `time-stamp-start', or
-`time-stamp-end' for yourself or you will be incompatible
-with other people's files!  If you must change them for some application,
-do so in the local variables section of the time-stamped file itself.")
-
-
-(defvar time-stamp-start "Time-stamp:[ \t]+\\\\?[\"<]+"    ;Do not change!
-  "Regexp after which the time stamp is written by \\[time-stamp].
-See also the variables `time-stamp-end' and `time-stamp-line-limit'.
-
-Do not change `time-stamp-line-limit', `time-stamp-start', or
-`time-stamp-end' for yourself or you will be incompatible
-with other people's files!  If you must change them for some application,
-do so in the local variables section of the time-stamped file itself.")
-
-
-(defvar time-stamp-end "\\\\?[\">]"    ;Do not change!
-  "Regexp marking the text after the time stamp.
-\\[time-stamp] deletes the text between the first match of `time-stamp-start'
-and the following match of `time-stamp-end' on the same line,
-then writes the time stamp specified by `time-stamp-format' between them.
-
-Do not change `time-stamp-line-limit', `time-stamp-start', or
-`time-stamp-end' for yourself or you will be incompatible
-with other people's files!  If you must change them for some application,
-do so in the local variables section of the time-stamped file itself.")
-
-
-
-;;;###autoload
-(defun time-stamp ()
-  "Update the time stamp string in the buffer.
-A template in a file can be automatically updated with a new time stamp
-every time you save the file.  Add this line to your .emacs file:
-    (add-hook 'write-file-hooks 'time-stamp)
-Normally the template must appear in the first 8 lines of a file and
-look like one of the following:
-      Time-stamp: <>
-      Time-stamp: \" \"
-The time stamp is written between the brackets or quotes:
-      Time-stamp: <1996-07-18 10:20:51 gildea>
-Only updates the time stamp if the variable `time-stamp-active' is non-nil.
-The format of the time stamp is set by the variable `time-stamp-format'.
-The variables `time-stamp-line-limit', `time-stamp-start',
-and `time-stamp-end' control finding the template."
-  (interactive)
-  (let ((case-fold-search nil)
-	(start nil)
-	(end nil)
-	search-limit)
-	(save-excursion
-	  (save-restriction
-	    (widen)
-	    (cond ((> time-stamp-line-limit 0)
-		   (goto-char (setq start (point-min)))
-		   (forward-line time-stamp-line-limit)
-		   (setq search-limit (point)))
-		  (t
-		   (goto-char (setq search-limit (point-max)))
-		   (forward-line time-stamp-line-limit)
-		   (setq start (point))))
-	    (goto-char start)
-	    (while (and (< (point) search-limit)
-			(not end)
-			(re-search-forward time-stamp-start search-limit 'move))
-	      (setq start (point))
-	      (end-of-line)
-	      (let ((line-end (point)))
-		(goto-char start)
-		(if (re-search-forward time-stamp-end line-end 'move)
-		    (setq end (match-beginning 0)))))))
-	(if end
-	    (progn
-	      ;; do all warnings outside save-excursion
-	      (cond
-	       ((not time-stamp-active)
-		(if time-stamp-warn-inactive
-		    ;; don't signal an error in a write-file-hook
-		    (progn
-		      (message "Warning: time-stamp-active is off; did not time-stamp buffer.")
-		      (sit-for 1))))
-	       ((not (and (stringp time-stamp-start)
-			  (stringp time-stamp-end)))
-		(message "time-stamp-start or time-stamp-end is not a string")
-		(sit-for 1))
-	       (t
-		(let ((new-time-stamp (time-stamp-string)))
-		  (if (stringp new-time-stamp)
-		      (save-excursion
-			(save-restriction
-			  (widen)
-			  (delete-region start end)
-			  (goto-char start)
-			  (insert new-time-stamp)
-			  (setq end (point))
-			  ;; remove any tabs used to format time stamp
-			  (goto-char start)
-			  (if (search-forward "\t" end t)
-			      (untabify start end)))))))))))
-  ;; be sure to return nil so can be used on write-file-hooks
-  nil)
-
-;;;###autoload
-(defun time-stamp-toggle-active (&optional arg)
-  "Toggle `time-stamp-active', setting whether \\[time-stamp] updates a buffer.
-With arg, turn time stamping on if and only if arg is positive."
-  (interactive "P")
-  (setq time-stamp-active
-	(if (null arg)
-	    (not time-stamp-active)
-	  (> (prefix-numeric-value arg) 0)))
-    (message "time-stamp is now %s." (if time-stamp-active "active" "off")))
-
-(defconst time-stamp-no-file "(no file)"
-  "String to use when the buffer is not associated with a file.")
-
-(defun time-stamp-string-preprocess (format)
-  "Process occurrences in FORMAT of %f, %F, %h, %s and %u.
-These are replaced with the file name (nondirectory part),
-full file name, host name for mail, system name, and user name.
-Do not alter other %-combinations, and do detect %%."
-  (let ((result "") (pos 0) (case-fold-search nil)
-	(file (or buffer-file-name "(no file)")))
-    (while (string-match "%[%uhfFs]" format pos)
-      (setq result (concat result (substring format pos (match-beginning 0))))
-      (let ((char (aref format (1+ (match-beginning 0)))))
-	(cond ((= char ?%)
-	       (setq result (concat result "%%")))
-	      ((= char ?u)
-	       (setq result (concat result (user-login-name))))
-	      ((= char ?f)
-	       (setq result (concat result (file-name-nondirectory file))))
-	      ((= char ?f)
-	       (setq result (concat result file)))
-	      ((= char ?s)
-	       (setq result (concat result (system-name))))
-	      ((= char ?h)
-	       (setq result (concat result (time-stamp-mail-host-name))))))
-      (setq pos (match-end 0)))
-    (concat result (substring format pos))))
-
-(defun time-stamp-string ()
-  "Generate the new string to be inserted by \\[time-stamp]."
-  (if (stringp time-stamp-format)
-      (format-time-string (time-stamp-string-preprocess time-stamp-format)
-			  (current-time))
-    ;; handle version 1 compatibility
-    (cond ((or (eq time-stamp-old-format-warn 'error)
-	       (and (eq time-stamp-old-format-warn 'ask)
-		    (not (y-or-n-p "Use non-string time-stamp-format? "))))
-	   (message "Warning: no time-stamp: time-stamp-format not a string")
-	   (sit-for 1)
-	   nil)
-	  (t
-	   (cond ((eq time-stamp-old-format-warn 'warn)
-		  (message "Obsolescent time-stamp-format type; should be string")
-		  (sit-for 1)))
-	   (time-stamp-fconcat time-stamp-format " ")))))
-
-(defconst time-stamp-no-file "(no file)"
-  "String to use when the buffer is not associated with a file.")
-
-(defun time-stamp-mail-host-name ()
-  "Return the name of the host where the user receives mail.
-This is the value of `mail-host-address' if bound and a string,
-otherwise the value of the function system-name."
-  (or (and (boundp 'mail-host-address)
-	   (stringp mail-host-address)
-	   mail-host-address)
-      (system-name)))
-
-;;; the rest of this file is for version 1 compatibility
-
-(defun time-stamp-fconcat (list sep)
-  "Similar to (mapconcat 'funcall LIST SEP) but LIST allows literals.
-If an element of LIST is a symbol, it is funcalled to get the string to use;
-the separator SEP is used between two strings obtained by funcalling a
-symbol.  Otherwise the element itself is inserted; no separator is used
-around literals."
-  (let ((return-string "")
-	(insert-sep-p nil))
-    (while list
-      (cond ((symbolp (car list))
-	     (if insert-sep-p
-		 (setq return-string (concat return-string sep)))
-	     (setq return-string (concat return-string (funcall (car list))))
-	     (setq insert-sep-p t))
-	    (t
-	     (setq return-string (concat return-string (car list)))
-	     (setq insert-sep-p nil)))
-      (setq list (cdr list)))
-    return-string))
-
-;;; Some functions used in time-stamp-format
-
-;;; Could generate most of a message-id with
-;;; '(time-stamp-yymmdd "" time-stamp-hhmm "@" time-stamp-mail-host-name)
-
-;;; pretty form, suitable for a title page
-
-(defun time-stamp-month-dd-yyyy ()
-  "Return the current date as a string in \"Month DD, YYYY\" form."
-  (format-time-string "%B %e, %Y"))
-
-(defun time-stamp-dd/mm/yyyy ()
-  "Return the current date as a string in \"DD/MM/YYYY\" form."
-  (format-time-string "%d/%m/%Y"))
-
-;;; same as __DATE__ in ANSI C
-
-(defun time-stamp-mon-dd-yyyy ()
-  "Return the current date as a string in \"Mon DD YYYY\" form.
-The first character of DD is space if the value is less than 10."
-  (format-time-string "%b %d %Y"))
-
-;;; RFC 822 date
-
-(defun time-stamp-dd-mon-yy ()
-  "Return the current date as a string in \"DD Mon YY\" form."
-  (format-time-string "%d %b %y"))
-
-;;; RCS 3 date
-
-(defun time-stamp-yy/mm/dd ()
-  "Return the current date as a string in \"YY/MM/DD\" form."
-  (format-time-string "%y/%m/%d"))
-
-;;; RCS 5 date
-
-(defun time-stamp-yyyy/mm/dd ()
-  "Return the current date as a string in \"YYYY/MM/DD\" form."
-  (format-time-string "%Y/%m/%d"))
-
-;;; ISO 8601 date
-
-(defun time-stamp-yyyy-mm-dd ()
-  "Return the current date as a string in \"YYYY-MM-DD\" form."
-  (format-time-string "%Y-%m-%d"))
-
-(defun time-stamp-yymmdd ()
-  "Return the current date as a string in \"YYMMDD\" form."
-  (format-time-string "%y%m%d"))
-
-(defun time-stamp-hh:mm:ss ()
-  "Return the current time as a string in \"HH:MM:SS\" form."
-  (format-time-string "%T"))
-
-(defun time-stamp-hhmm ()
-  "Return the current time as a string in \"HHMM\" form."
-  (format-time-string "%H%M"))
-
-(provide 'time-stamp)
-
-;;; time-stamp.el ends here
diff --git a/lisp/time.el b/lisp/time.el
deleted file mode 100644
index 8f798fa08a2..00000000000
--- a/lisp/time.el
+++ /dev/null
@@ -1,220 +0,0 @@
-;;; time.el --- display time and load in mode line of Emacs.
-
-;; Copyright (C) 1985, 86, 87, 93, 94, 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:
-
-;; Facilities to display current time/date and a new-mail indicator
-;; in the Emacs mode line.  The single entry point is `display-time'.
-
-;;; Code:
-
-(defvar display-time-mail-file nil
-  "*File name of mail inbox file, for indicating existence of new mail.
-Non-nil and not a string means don't check for mail.  nil means use
-default, which is system-dependent, and is the same as used by Rmail.")
-
-;;;###autoload
-(defvar display-time-day-and-date nil "\
-*Non-nil means \\[display-time] should display day and date as well as time.")
-
-(defvar display-time-timer nil)
-
-(defvar display-time-interval 60
-  "*Seconds between updates of time in the mode line.")
-
-(defvar display-time-24hr-format nil
-  "*Non-nil indicates time should be displayed as hh:mm, 0 <= hh <= 23.
-Nil means 1 <= hh <= 12, and an AM/PM suffix is used.")
-
-(defvar display-time-string nil)
-
-(defvar display-time-hook nil
-  "* List of functions to be called when the time is updated on the mode line.")
-
-(defvar display-time-server-down-time nil
-   "Time when mail file's file system was recorded to be down.
-If that file system seems to be up, the value is nil.")
-
-;;;###autoload
-(defun display-time ()
-  "Enable display of time, load level, and mail flag in mode lines.
-This display updates automatically every minute.
-If `display-time-day-and-date' is non-nil, the current day and date
-are displayed as well.
-This runs the normal hook `display-time-hook' after each update."
-  (interactive)
-  (display-time-mode 1))
-
-;;;###autoload
-(defun display-time-mode (arg)
-  "Toggle display of time, load level, and mail flag in mode lines.
-With a numeric arg, enable this display if arg is positive.
-
-When this display is enabled, it updates automatically every minute.
-If `display-time-day-and-date' is non-nil, the current day and date
-are displayed as well.
-This runs the normal hook `display-time-hook' after each update."
-  (interactive "P")
-  (let ((on (if (null arg)
-		(not display-time-timer)
-	      (> (prefix-numeric-value arg) 0))))
-    (and display-time-timer (cancel-timer display-time-timer))
-    (setq display-time-timer nil)
-    (setq display-time-string "")
-    (or global-mode-string (setq global-mode-string '("")))
-    (if on
-	(progn
-	  (or (memq 'display-time-string global-mode-string)
-	      (setq global-mode-string
-		    (append global-mode-string '(display-time-string))))
-	  ;; Set up the time timer.
-	  (setq display-time-timer
-		(run-at-time t display-time-interval
-			     'display-time-event-handler))
-	  ;; Make the time appear right away.
-	  (display-time-update)
-	  ;; When you get new mail, clear "Mail" from the mode line.
-	  (add-hook 'rmail-after-get-new-mail-hook
-		    'display-time-event-handler))
-      (remove-hook 'rmail-after-get-new-mail-hook
-		   'display-time-event-handler))))
-
-
-(defvar display-time-format
-  (concat 
-   (if display-time-day-and-date
-       "%a %b %e" "")
-   (if display-time-24hr-format "%H:%m" "%-I:%M%p"))
-  "*A string specifying the format for displaying the time in the mode line.
-See the function `format-time-string' for an explanation of
-how to write this string.")
-
-(defvar display-time-string-forms
-  '((format-time-string display-time-format now)
-    load
-    (if mail " Mail" ""))
-  "*A list of expressions governing display of the time in the mode line.
-For most purposes, you can control the time format using `display-time-format'
-which is a more standard interface.
-
-This expression is a list of expressions that can involve the keywords
-`load', `day', `month', and `year', `12-hours', `24-hours', `minutes',
-`seconds', all numbers in string form, and `monthname', `dayname', `am-pm',
-and `time-zone' all alphabetic strings, and `mail' a true/nil value.
-
-For example, the form
-
-  '((substring year -2) \"/\" month \"/\" day
-    \" \" 24-hours \":\" minutes \":\" seconds
-    (if time-zone \" (\") time-zone (if time-zone \")\")
-    (if mail \" Mail\" \"\"))
-
-would give mode line times like `94/12/30 21:07:48 (UTC)'.")
-
-(defun display-time-event-handler ()
-  (display-time-update)
-  ;; Do redisplay right now, if no input pending.
-  (sit-for 0)
-  (let* ((current (current-time))
-	 (timer display-time-timer)
-	 ;; Compute the time when this timer will run again, next.
-	 (next-time (timer-relative-time
-		     (list (aref timer 1) (aref timer 2) (aref timer 3))
-		     (* 5 (aref timer 4)) 0)))
-    ;; If the activation time is far in the past,
-    ;; skip executions until we reach a time in the future.
-    ;; This avoids a long pause if Emacs has been suspended for hours.
-    (or (> (nth 0 next-time) (nth 0 current))
-	(and (= (nth 0 next-time) (nth 0 current))
-	     (> (nth 1 next-time) (nth 1 current)))
-	(and (= (nth 0 next-time) (nth 0 current))
-	     (= (nth 1 next-time) (nth 1 current))
-	     (> (nth 2 next-time) (nth 2 current)))
-	(progn
-	  (timer-set-time timer (timer-next-integral-multiple-of-time
-				 current display-time-interval)
-			  display-time-interval)
-	  (timer-activate timer)))))
-
-;; Update the display-time info for the mode line
-;; but don't redisplay right now.  This is used for
-;; things like Rmail `g' that want to force an update
-;; which can wait for the next redisplay.
-(defun display-time-update ()
-  (let* ((now (current-time))
-	 (time (current-time-string now))
-         (load (condition-case ()
-                   (if (zerop (car (load-average))) ""
-                     (let ((str (format " %03d" (car (load-average)))))
-                       (concat (substring str 0 -2) "." (substring str -2))))
-                 (error "")))
-         (mail-spool-file (or display-time-mail-file
-                              (getenv "MAIL")
-                              (concat rmail-spool-directory
-                                      (user-login-name))))
-	 (mail (and (stringp mail-spool-file)
-		    (or (null display-time-server-down-time)
-			;; If have been down for 20 min, try again.
-			(> (- (nth 1 (current-time))
-			      display-time-server-down-time)
-			   1200))
-		    (let ((start-time (current-time)))
-		      (prog1
-			  (display-time-file-nonempty-p mail-spool-file)
-			(if (> (- (nth 1 (current-time)) (nth 1 start-time))
-			       20)
-			    ;; Record that mail file is not accessible.
-			    (setq display-time-server-down-time 
-				  (nth 1 (current-time)))
-			  ;; Record that mail file is accessible.
-			  (setq display-time-server-down-time nil))))))
-         (24-hours (substring time 11 13))
-         (hour (string-to-int 24-hours))
-         (12-hours (int-to-string (1+ (% (+ hour 11) 12))))
-         (am-pm (if (>= hour 12) "pm" "am"))
-         (minutes (substring time 14 16))
-         (seconds (substring time 17 19))
-         (time-zone (car (cdr (current-time-zone now))))
-         (day (substring time 8 10))
-         (year (substring time 20 24))
-         (monthname (substring time 4 7))
-         (month
-          (cdr
-           (assoc
-            monthname
-            '(("Jan" . "1") ("Feb" . "2") ("Mar" . "3") ("Apr" . "4")
-              ("May" . "5") ("Jun" . "6") ("Jul" . "7") ("Aug" . "8")
-              ("Sep" . "9") ("Oct" . "10") ("Nov" . "11") ("Dec" . "12")))))
-         (dayname (substring time 0 3)))
-    (setq display-time-string
-          (mapconcat 'eval display-time-string-forms ""))
-    ;; This is inside the let binding, but we are not going to document
-    ;; what variables are available.
-    (run-hooks 'display-time-hook))
-  (force-mode-line-update))
-
-(defun display-time-file-nonempty-p (file)
-  (and (file-exists-p file)
-       (< 0 (nth 7 (file-attributes (file-chase-links file))))))
-
-;;; time.el ends here
diff --git a/lisp/timer.el b/lisp/timer.el
deleted file mode 100644
index 1a343755661..00000000000
--- a/lisp/timer.el
+++ /dev/null
@@ -1,453 +0,0 @@
-;;; 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 non-zero integer, 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
-    (setq low (+ low (/ micro 1000000)))
-    (setq micro (mod micro 1000000))
-    (setq high (+ high (/ low 65536)))
-    (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."
-  (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.
-TIME must be in the internal format returned by, e.g., `current-time'.
-If optional third argument DELTA is a non-zero integer, 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 usecs)
-  (aset timer 4 (and (numberp delta) (> delta 0) delta))
-  timer)
-
-(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)
-  "Arrange to activate TIMER whenever Emacs is next 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 t)
-	(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)))))
-
-;; Set up the common handler for all timer events.  Since the event has
-;; the timer as parameter we can still distinguish.  Note that using
-;; special-event-map ensures that event timer events that arrive in the
-;; middle of a key sequence being entered are still handled correctly.
-(define-key special-event-map [timer-event] 'timer-event-handler)
-
-;; Record the last few events, for debugging.
-(defvar timer-event-last-2 nil)
-(defvar timer-event-last-1 nil)
-(defvar timer-event-last nil)
-
-(defun timer-event-handler (event)
-  "Call the handler for the timer in the event EVENT."
-  (interactive "e")
-  (setq timer-event-last-2 timer-event-last-1)
-  (setq timer-event-last-1 timer-event-last)
-  (setq timer-event-last (cons event (copy-sequence event)))
-  (let ((inhibit-quit t)
-	(timer (car-safe (cdr-safe event))))
-    (if (timerp timer)
-	(progn
-	  ;; Delete from queue.
-	  (cancel-timer timer)
-	  ;; Run handler
-	  (condition-case nil
-	      (apply (aref timer 5) (aref timer 6))
-	    (error nil))
-	  ;; 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)
-		(timer-activate timer))))
-      (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.
-If REPEAT is non-nil, do this each time Emacs is idle for SECS seconds.
-SECS may be an integer or a 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
-   (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/timezone.el b/lisp/timezone.el
deleted file mode 100644
index b4619488960..00000000000
--- a/lisp/timezone.el
+++ /dev/null
@@ -1,397 +0,0 @@
-;;; timezone.el --- time zone package for GNU Emacs
-
-;; Copyright (C) 1990, 1991, 1992, 1993, 1996 Free Software Foundation, Inc.
-
-;; Author: Masanobu Umeda
-;; Maintainer: umerin@mse.kyutech.ac.jp
-;; Keywords: news
-
-;; 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.
-
-;;; Code:
-
-(provide 'timezone)
-
-(defvar timezone-world-timezones
-  '(("PST" .  -800)
-    ("PDT" .  -700)
-    ("MST" .  -700)
-    ("MDT" .  -600)
-    ("CST" .  -600)
-    ("CDT" .  -500)
-    ("EST" .  -500)
-    ("EDT" .  -400)
-    ("AST" .  -400)			;by <clamen@CS.CMU.EDU>
-    ("NST" .  -330)			;by <clamen@CS.CMU.EDU>
-    ("UT"  .  +000)
-    ("GMT" .  +000)
-    ("BST" .  +100)
-    ("MET" .  +100)
-    ("EET" .  +200)
-    ("JST" .  +900)
-    ("GMT+1"  .  +100) ("GMT+2"  .  +200) ("GMT+3"  .  +300)
-    ("GMT+4"  .  +400) ("GMT+5"  .  +500) ("GMT+6"  .  +600)
-    ("GMT+7"  .  +700) ("GMT+8"  .  +800) ("GMT+9"  .  +900)
-    ("GMT+10" . +1000) ("GMT+11" . +1100) ("GMT+12" . +1200) ("GMT+13" . +1300)
-    ("GMT-1"  .  -100) ("GMT-2"  .  -200) ("GMT-3"  .  -300)
-    ("GMT-4"  .  -400) ("GMT-5"  .  -500) ("GMT-6"  .  -600)
-    ("GMT-7"  .  -700) ("GMT-8"  .  -800) ("GMT-9"  .  -900)
-    ("GMT-10" . -1000) ("GMT-11" . -1100) ("GMT-12" . -1200))
-  "*Time differentials of timezone from GMT in +-HHMM form.
-This list is obsolescent, and is present only for backwards compatibility,
-because time zone names are ambiguous in practice.
-Use `current-time-zone' instead.")
-
-(defvar timezone-months-assoc
-  '(("JAN" .  1)("FEB" .  2)("MAR" .  3)
-    ("APR" .  4)("MAY" .  5)("JUN" .  6)
-    ("JUL" .  7)("AUG" .  8)("SEP" .  9)
-    ("OCT" . 10)("NOV" . 11)("DEC" . 12))
-  "Alist of first three letters of a month and its numerical representation.")
-
-(defun timezone-make-date-arpa-standard (date &optional local timezone)
-  "Convert DATE to an arpanet standard date.
-Optional 1st argument LOCAL specifies the default local timezone of the DATE;
-if nil, GMT is assumed.
-Optional 2nd argument TIMEZONE specifies a time zone to be represented in;
-if nil, the local time zone is assumed."
-  (let ((new (timezone-fix-time date local timezone)))
-    (timezone-make-arpa-date (aref new 0) (aref new 1) (aref new 2)
-			     (timezone-make-time-string
-			      (aref new 3) (aref new 4) (aref new 5))
-			     (aref new 6))
-    ))
-
-(defun timezone-make-date-sortable (date &optional local timezone)
-  "Convert DATE to a sortable date string.
-Optional 1st argument LOCAL specifies the default local timezone of the DATE;
-if nil, GMT is assumed.
-Optional 2nd argument TIMEZONE specifies a timezone to be represented in;
-if nil, the local time zone is assumed."
-  (let ((new (timezone-fix-time date local timezone)))
-    (timezone-make-sortable-date (aref new 0) (aref new 1) (aref new 2)
-				 (timezone-make-time-string
-				  (aref new 3) (aref new 4) (aref new 5)))
-    ))
-
-
-;;
-;; Parsers and Constructors of Date and Time
-;;
-
-(defun timezone-make-arpa-date (year month day time &optional timezone)
-  "Make arpanet standard date string from YEAR, MONTH, DAY, and TIME.
-Optional argument TIMEZONE specifies a time zone."
-  (let ((zone
-	 (if (listp timezone)
-	     (let* ((m (timezone-zone-to-minute timezone))
-		    (absm (if (< m 0) (- m) m)))
-	       (format "%c%02d%02d"
-		       (if (< m 0) ?- ?+) (/ absm 60) (% absm 60)))
-	   timezone)))
-    (format "%02d %s %04d %s %s"
-	    day
-	    (capitalize (car (rassq month timezone-months-assoc)))
-	    year
-	    time
-	    zone)))
-
-(defun timezone-make-sortable-date (year month day time)
-  "Make sortable date string from YEAR, MONTH, DAY, and TIME."
-  (format "%4d%02d%02d%s"
-	  year month day time))
-
-(defun timezone-make-time-string (hour minute second)
-  "Make time string from HOUR, MINUTE, and SECOND."
-  (format "%02d:%02d:%02d" hour minute second))
-
-(defun timezone-parse-date (date)
-  "Parse DATE and return a vector [YEAR MONTH DAY TIME TIMEZONE].
-19 is prepended to year if necessary.  Timezone may be nil if nothing.
-Understands the following styles:
- (1) 14 Apr 89 03:20[:12] [GMT]
- (2) Fri, 17 Mar 89 4:01[:33] [GMT]
- (3) Mon Jan 16 16:12[:37] [GMT] 1989
- (4) 6 May 1992 1641-JST (Wednesday)
- (5) 22-AUG-1993 10:59:12.82
- (6) Thu, 11 Apr 16:17:12 91 [MET]
- (7) Mon, 6  Jul 16:47:20 T 1992 [MET]
- (8) 1996-06-24 21:13:12 [GMT]"
- ;; Get rid of any text properties.
-  (and (stringp date)
-       (or (text-properties-at 0 date)
-	   (next-property-change 0 date))
-       (setq date (copy-sequence date))
-       (set-text-properties 0 (length date) nil date))
-  (let ((date (or date ""))
-	(year nil)
-	(month nil)
-	(day nil)
-	(time nil)
-	(zone nil))			;This may be nil.
-    (cond ((string-match
-	    "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\'" date)
-	   ;; Styles: (6) and (7) without timezone
-	   (setq year 6 month 3 day 2 time 4 zone nil))
-	  ((string-match
-	    "\\([^ \t,]+\\),[ \t]+\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\(T[ \t]+\\|\\)\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
-	   ;; Styles: (6) and (7) with timezone and buggy timezone
-	   (setq year 6 month 3 day 2 time 4 zone 7))
-	  ((string-match
-	    "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\'" date)
-	   ;; Styles: (1) and (2) without timezone
-	   (setq year 3 month 2 day 1 time 4 zone nil))
-	  ((string-match
-	    "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
-	   ;; Styles: (1) and (2) with timezone and buggy timezone
-	   (setq year 3 month 2 day 1 time 4 zone 5))
-	  ((string-match
-	    "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([0-9]+\\)" date)
-	   ;; Styles: (3) without timezone
-	   (setq year 4 month 1 day 2 time 3 zone nil))
-	  ((string-match
-	    "\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9:]+\\)[ \t]+\\([-+a-zA-Z0-9]+\\)[ \t]+\\([0-9]+\\)" date)
-	   ;; Styles: (3) with timezone
-	   (setq year 5 month 1 day 2 time 3 zone 4))
-	  ((string-match
-	    "\\([0-9]+\\)[ \t]+\\([^ \t,]+\\)[ \t]+\\([0-9]+\\)[ \t]+\\([0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
-	   ;; Styles: (4) with timezone
-	   (setq year 3 month 2 day 1 time 4 zone 5))
-	  ((string-match
-	    "\\([0-9]+\\)-\\([A-Za-z]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)\\.[0-9]+" date)
-	   ;; Styles: (5) without timezone.
-	   (setq year 3 month 2 day 1 time 4 zone nil))
-	  ((string-match
-	    "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)[ \t]*\\([-+a-zA-Z0-9]+\\)" date)
-	   ;; Styles: (8) with timezone.
-	   (setq year 1 month 2 day 3 time 4 zone 5))
-	  ((string-match
-	    "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)[ \t]+\\([0-9]+:[0-9]+:[0-9]+\\)" date)
-	   ;; Styles: (8) without timezone.
-	   (setq year 1 month 2 day 3 time 4 zone nil))
-	  )
-    (if year
-	(progn
-	  (setq year
-		(substring date (match-beginning year) (match-end year)))
-	  ;; It is now Dec 1992.  8 years before the end of the World.
-	  (if (< (length year) 4)
-	      (setq year (concat "19" (substring year -2 nil))))
-          (setq month
-		(if (= (aref date (+ (match-beginning month) 2)) ?-)
-		    ;; Handle numeric months, spanning exactly two digits.
-		    (substring date
-			       (match-beginning month)
-			       (+ (match-beginning month) 2))
- 	          (let ((string (substring date
-				 (match-beginning month)
-				 (+ (match-beginning month) 3))))
-		    (int-to-string
-		     (cdr (assoc (upcase string) timezone-months-assoc))))))
-	  (setq day
-		(substring date (match-beginning day) (match-end day)))
-	  (setq time
-		(substring date (match-beginning time) (match-end time)))))
-    (if zone
-	(setq zone
-	      (substring date (match-beginning zone) (match-end zone))))
-    ;; Return a vector.
-    (if year
-	(vector year month day time zone)
-      (vector "0" "0" "0" "0" nil))
-    ))
-
-(defun timezone-parse-time (time)
-  "Parse TIME (HH:MM:SS) and return a vector [hour minute second].
-Recognize HH:MM:SS, HH:MM, HHMMSS, HHMM."
-  (let ((time (or time ""))
-	(hour nil)
-	(minute nil)
-	(second nil))
-    (cond ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\):\\([0-9]+\\)\\'" time)
-	   ;; HH:MM:SS
-	   (setq hour 1 minute 2 second 3))
-	  ((string-match "\\`\\([0-9]+\\):\\([0-9]+\\)\\'" time)
-	   ;; HH:MM
-	   (setq hour 1 minute 2 second nil))
-	  ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time)
-	   ;; HHMMSS
-	   (setq hour 1 minute 2 second 3))
-	  ((string-match "\\`\\([0-9][0-9]\\)\\([0-9][0-9]\\)\\'" time)
-	   ;; HHMM
-	   (setq hour 1 minute 2 second nil))
-	  )
-    ;; Return [hour minute second]
-    (vector
-     (if hour
-	 (substring time (match-beginning hour) (match-end hour)) "0")
-     (if minute
-	 (substring time (match-beginning minute) (match-end minute)) "0")
-     (if second
-	 (substring time (match-beginning second) (match-end second)) "0"))
-    ))
-
-
-;; Miscellaneous
-
-(defun timezone-zone-to-minute (timezone)
-  "Translate TIMEZONE to an integer minute offset from GMT.
-TIMEZONE can be a cons cell containing the output of current-time-zone,
-or an integer of the form +-HHMM, or a time zone name."
-  (cond
-     ((consp timezone)
-      (/ (car timezone) 60))
-     (timezone
-      (progn
-	(setq timezone
-	      (or (cdr (assoc (upcase timezone) timezone-world-timezones))
-		  ;; +900
-		  timezone))
-	(if (stringp timezone)
-	    (setq timezone (string-to-int timezone)))
-	;; Taking account of minute in timezone.
-	;; HHMM -> MM
-	(let* ((abszone (abs timezone))
- 	       (minutes (+ (* 60 (/ abszone 100)) (% abszone 100))))
- 	  (if (< timezone 0) (- minutes) minutes))))
-     (t 0)))
-
-(defun timezone-time-from-absolute (date seconds)
-  "Compute the UTC time equivalent to DATE at time SECONDS after midnight.
-Return a list suitable as an argument to current-time-zone,
-or nil if the date cannot be thus represented.
-DATE is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-  (let* ((current-time-origin 719163)
-	    ;; (timezone-absolute-from-gregorian 1 1 1970)
-	 (days (- date current-time-origin))
-	 (seconds-per-day (float 86400))
-	 (seconds (+ seconds (* days seconds-per-day)))
-	 (current-time-arithmetic-base (float 65536))
-	 (hi (floor (/ seconds current-time-arithmetic-base)))
-	 (hibase (* hi current-time-arithmetic-base))
-	 (lo (floor (- seconds hibase))))
-     (and (< (abs (- seconds (+ hibase lo))) 2) ;; Check for integer overflow.
-	  (cons hi lo))))
-
-(defun timezone-time-zone-from-absolute (date seconds)
-  "Compute the local time zone for DATE at time SECONDS after midnight.
-Return a list in the same format as current-time-zone's result,
-or nil if the local time zone could not be computed.
-DATE is the number of days elapsed since the (imaginary)
-Gregorian date Sunday, December 31, 1 BC."
-   (and (fboundp 'current-time-zone)
-	(let ((utc-time (timezone-time-from-absolute date seconds)))
-	  (and utc-time
-	       (let ((zone (current-time-zone utc-time)))
-		 (and (car zone) zone))))))
-
-(defun timezone-fix-time (date local timezone)
-  "Convert DATE (default timezone LOCAL) to YYYY-MM-DD-HH-MM-SS-ZONE vector.
-If LOCAL is nil, it is assumed to be GMT.
-If TIMEZONE is nil, use the local time zone."
-  (let* ((date   (timezone-parse-date date))
-	 (year   (string-to-int (aref date 0)))
-	 (year	 (cond ((< year 50)
-			(+ year 2000))
-		       ((< year 100)
-			(+ year 1900))
-		       (t year)))
-	 (month  (string-to-int (aref date 1)))
-	 (day    (string-to-int (aref date 2)))
-	 (time   (timezone-parse-time (aref date 3)))
-	 (hour   (string-to-int (aref time 0)))
-	 (minute (string-to-int (aref time 1)))
-	 (second (string-to-int (aref time 2)))
-	 (local  (or (aref date 4) local)) ;Use original if defined
-	 (timezone
-	  (or timezone
-	      (timezone-time-zone-from-absolute
-	       (timezone-absolute-from-gregorian month day year)
-	       (+ second (* 60 (+ minute (* 60 hour)))))))
-	 (diff   (- (timezone-zone-to-minute timezone)
-		    (timezone-zone-to-minute local)))
-	 (minute (+ minute diff))
-	 (hour-fix (floor minute 60)))
-    (setq hour (+ hour hour-fix))
-    (setq minute (- minute (* 60 hour-fix)))
-    ;; HOUR may be larger than 24 or smaller than 0.
-    (cond ((<= 24 hour)			;24 -> 00
-	   (setq hour (- hour 24))
-	   (setq day  (1+ day))
-	   (if (< (timezone-last-day-of-month month year) day)
-	       (progn
-		 (setq month (1+ month))
-		 (setq day 1)
-		 (if (< 12 month)
-		     (progn
-		       (setq month 1)
-		       (setq year (1+ year))
-		       ))
-		 )))
-	  ((> 0 hour)
-	   (setq hour (+ hour 24))
-	   (setq day  (1- day))
-	   (if (> 1 day)
-	       (progn
-		 (setq month (1- month))
-		 (if (> 1 month)
-		     (progn
-		       (setq month 12)
-		       (setq year (1- year))
-		       ))
-		 (setq day (timezone-last-day-of-month month year))
-		 )))
-	  )
-    (vector year month day hour minute second timezone)))
-
-;; Partly copied from Calendar program by Edward M. Reingold.
-;; Thanks a lot.
-
-(defun timezone-last-day-of-month (month year)
-  "The last day in MONTH during YEAR."
-  (if (and (= month 2) (timezone-leap-year-p year))
-      29
-    (aref [31 28 31 30 31 30 31 31 30 31 30 31] (1- month))))
-
-(defun timezone-leap-year-p (year)
-  "Returns t if YEAR is a Gregorian leap year."
-  (or (and (zerop  (% year 4))
-	   (not (zerop (% year 100))))
-      (zerop (% year 400))))
-
-(defun timezone-day-number (month day year)
-  "Return the day number within the year of the date month/day/year."
-  (let ((day-of-year (+ day (* 31 (1- month)))))
-    (if (> month 2)
-	(progn
-	  (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
-	  (if (timezone-leap-year-p year)
-	      (setq day-of-year (1+ day-of-year)))))
-    day-of-year))
-
-(defun timezone-absolute-from-gregorian (month day year)
-  "The number of days between the Gregorian date 12/31/1 BC and month/day/year.
-The Gregorian date Sunday, December 31, 1 BC is imaginary."
-  (+ (timezone-day-number month day year);; Days this year
-     (* 365 (1- year));;	+ Days in prior years
-     (/ (1- year) 4);;		+ Julian leap years
-     (- (/ (1- year) 100));;	- century years
-     (/ (1- year) 400)));;	+ Gregorian leap years
-
-;;; timezone.el ends here
diff --git a/lisp/tmm.el b/lisp/tmm.el
deleted file mode 100644
index b016e8231bf..00000000000
--- a/lisp/tmm.el
+++ /dev/null
@@ -1,471 +0,0 @@
-;;; tmm.el --- text mode access to menu-bar
-
-;; Copyright (C) 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author: Ilya Zakharevich <ilya@math.mps.ohio-state.edu>
-;; 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:
-
-;; To use this package add 
-
-;; (autoload 'tmm-menubar 'tmm "Text mode substitute for menubar" t) 
-;; (global-set-key [f10] 'tmm-menubar)
-;; to your .emacs file. You can also add your own access to different
-;; menus available in Window System Emacs modeling definition after
-;; tmm-menubar.
-
-;;; Code:
-
-(require 'electric)
-
-;;; The following will be localized, added only to pacify the compiler.
-(defvar tmm-short-cuts)
-(defvar tmm-old-mb-map nil)
-(defvar tmm-old-comp-map)
-(defvar tmm-c-prompt)
-(defvar tmm-km-list)
-(defvar tmm-next-shortcut-digit)
-(defvar tmm-table-undef)
-
-;;;###autoload (define-key global-map "\M-`" 'tmm-menubar)
-;;;###autoload (define-key global-map [f10] 'tmm-menubar)
-;;;###autoload (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse)
-
-;;;###autoload
-(defun tmm-menubar (&optional x-position)
-  "Text-mode emulation of looking and choosing from a menubar.
-See the documentation for `tmm-prompt'.
-X-POSITION, if non-nil, specifies a horizontal position within the menu bar;
-we make that menu bar item (the one at that position) the default choice."
-  (interactive)
-  (run-hooks 'menu-bar-update-hook)
-  ;; Obey menu-bar-final-items; put those items last.
-  (let ((menu-bar (tmm-get-keybind [menu-bar]))
-	menu-bar-item)
-    (let ((list menu-bar-final-items))
-      (while list
-	(let ((item (car list)))
-	  ;; ITEM is the name of an item that we want to put last.
-	  ;; Find it in MENU-BAR and move it to the end.
-	  (let ((this-one (assq item menu-bar)))
-	    (setq menu-bar (append (delq this-one menu-bar)
-				   (list this-one)))))
-	(setq list (cdr list))))
-    (if x-position
-	(let ((tail menu-bar)
-	      this-one
-	      (column 0))
-	  (while (and tail (< column x-position))
-	    (setq this-one (car tail))
-	    (if (and (consp (car tail))
-		     (consp (cdr (car tail)))
-		     (stringp (nth 1 (car tail))))
-		(setq column (+ column
-				(length (nth 1 (car tail)))
-				1)))
-	    (setq tail (cdr tail)))
-	  (setq menu-bar-item (car this-one))))
-    (tmm-prompt menu-bar nil menu-bar-item)))
-
-;;;###autoload
-(defun tmm-menubar-mouse (event)
-  "Text-mode emulation of looking and choosing from a menubar.
-This command is used when you click the mouse in the menubar
-on a console which has no window system but does have a mouse.
-See the documentation for `tmm-prompt'."
-  (interactive "e")
-  (tmm-menubar (car (posn-x-y (event-start event)))))
-
-(defvar tmm-mid-prompt "==>"
-  "*String to insert between shortcut and menu item. 
-If nil, there will be no shortcuts. It should not consist only of spaces,
-or else the correct item might not be found in the `*Completions*' buffer.")
-
-(defvar tmm-mb-map nil
-  "A place to store minibuffer map.")
-
-(defvar tmm-completion-prompt 
-  "Press PageUp Key to reach this buffer from the minibuffer.
-Alternatively, you can use Up/Down keys (or your History keys) to change
-the item in the minibuffer, and press RET when you are done, or press the 
-marked letters to pick up your choice.  Type C-g or ESC ESC ESC to cancel.
-"
-  "*Help text to insert on the top of the completion buffer.
-To save space, you can set this to nil,
-in which case the standard introduction text is deleted too.")
-
-(defvar tmm-shortcut-style '(downcase upcase)
-  "*What letters to use as menu shortcuts. 
-Must be either one of the symbols `downcase' or `upcase', 
-or else a list of the two in the order you prefer.")
-
-(defvar tmm-shortcut-words 2
-  "*How many successive words to try for shortcuts, nil means all.
-If you use only one of `downcase' or `upcase' for `tmm-shortcut-style', 
-specify nil for this variable.")
-
-;;;###autoload
-(defun tmm-prompt (menu &optional in-popup default-item)
-  "Text-mode emulation of calling the bindings in keymap.
-Creates a text-mode menu of possible choices.  You can access the elements
-in the menu in two ways:
-   *)  via history mechanism from minibuffer;
-   *)  Or via completion-buffer that is automatically shown.
-The last alternative is currently a hack, you cannot use mouse reliably.
-
-MENU is like the MENU argument to `x-popup-menu': either a
-keymap or an alist of alists.
-DEFAULT-ITEM, if non-nil, specifies an initial default choice.
-Its value should be an event that has a binding in MENU."
-  ;; If the optional argument IN-POPUP is t,
-  ;; then MENU is an alist of elements of the form (STRING . VALUE).
-  ;; That is used for recursive calls only.
-  (let ((gl-str "Menu bar")  ;; The menu bar itself is not a menu keymap
-					; so it doesn't have a name.
-	tmm-km-list out history history-len tmm-table-undef tmm-c-prompt
-	tmm-old-mb-map tmm-old-comp-map tmm-short-cuts
-	chosen-string choice
-	(not-menu (not (keymapp menu))))
-    (run-hooks 'activate-menubar-hook)
-    ;; Compute tmm-km-list from MENU.
-    ;; tmm-km-list is an alist of (STRING . MEANING).
-    ;; It has no other elements.
-    ;; The order of elements in tmm-km-list is the order of the menu bar.
-    (mapcar (function (lambda (elt)
-			(if (stringp elt)
-			    (setq gl-str elt)
-			  (and (listp elt) (tmm-get-keymap elt not-menu)))))
-	    menu)
-    ;; Choose an element of tmm-km-list; put it in choice.
-    (if (and not-menu (= 1 (length tmm-km-list)))
-	;; If this is the top-level of an x-popup-menu menu,
-	;; and there is just one pane, choose that one silently.
-	;; This way we only ask the user one question,
-	;; for which element of that pane.
-	(setq choice (cdr (car tmm-km-list)))
-      (and tmm-km-list
-	   (let ((index-of-default 0))
-	     (if tmm-mid-prompt
-		 (setq tmm-km-list (tmm-add-shortcuts tmm-km-list))
-	       t)
-	     ;; Find the default item's index within the menu bar.
-	     ;; We use this to decide the initial minibuffer contents
-	     ;; and initial history position.
-	     (if default-item
-		 (let ((tail menu))
-		   (while (and tail
-			       (not (eq (car-safe (car tail)) default-item)))
-		     ;; Be careful to count only the elements of MENU
-		     ;; that actually constitute menu bar items.
-		     (if (and (consp (car tail))
-			      (stringp (car-safe (cdr (car tail)))))
-			 (setq index-of-default (1+ index-of-default)))
-		     (setq tail (cdr tail)))))
-	     (setq history (reverse (mapcar 'car tmm-km-list)))
-	     (setq history-len (length history))
-	     (setq history (append history history history history))
-	     (setq tmm-c-prompt (nth (- history-len 1 index-of-default) history))
-	     (add-hook 'minibuffer-setup-hook 'tmm-add-prompt)
-	     (unwind-protect
-		 (setq out
-		       (completing-read
-			(concat gl-str " (up/down to change, PgUp to menu): ")
-			tmm-km-list nil t nil
-			(cons 'history (- (* 2 history-len) index-of-default))))
-	       (save-excursion
-		 (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
-		 (if (get-buffer "*Completions*")
-		     (progn
-		       (set-buffer "*Completions*")
-		       (use-local-map tmm-old-comp-map)
-		       (bury-buffer (current-buffer)))))
-	       )))
-      (setq choice (cdr (assoc out tmm-km-list)))
-      (and (null choice)
-	   (> (length out) (length tmm-c-prompt))
-	   (string= (substring out 0 (length tmm-c-prompt)) tmm-c-prompt)
-	   (setq out (substring out (length tmm-c-prompt))
-		 choice (cdr (assoc out tmm-km-list))))
-      (and (null choice)
-	   (setq out (try-completion out tmm-km-list)
-		 choice (cdr (assoc  out tmm-km-list)))))
-    ;; CHOICE is now (STRING . MEANING).  Separate the two parts.
-    (setq chosen-string (car choice))
-    (setq choice (cdr choice))
-    (cond (in-popup
-	   ;; We just did the inner level of a -popup menu.
-	   choice)
-	  ;; We just did the outer level.  Do the inner level now.
-	  (not-menu (tmm-prompt choice t)) 
-	  ;; We just handled a menu keymap and found another keymap.
-	  ((keymapp choice)
-	   (if (symbolp choice)
-	       (setq choice (indirect-function choice)))
-	   (condition-case nil
-	       (require 'mouse)
-	     (error nil))
-	   (condition-case nil
-	       (x-popup-menu nil choice) ; Get the shortcuts
-	     (error nil))
-	   (tmm-prompt choice))
-	  ;; We just handled a menu keymap and found a command.
-	  (choice
-	   (if chosen-string
-	       (progn
-		 (setq last-command-event chosen-string)
-		 (call-interactively choice))
-	     choice)))))
-
-(defun tmm-add-shortcuts (list)
-  "Adds shortcuts to cars of elements of the list.
-Takes a list of lists with a string as car, returns list with
-shortcuts added to these cars.
-Stores a list of all the shortcuts in the free variable `tmm-short-cuts'."
-  (let ((tmm-next-shortcut-digit ?0))
-    (mapcar 'tmm-add-one-shortcut (reverse list))))
-
-(defsubst tmm-add-one-shortcut (elt)
-;; uses the free vars tmm-next-shortcut-digit and tmm-short-cuts
-  (let* ((str (car elt))
-        (paren (string-match "(" str))  
-        (pos 0) (word 0) char)
-    (catch 'done                        ; ??? is this slow?
-      (while (and (or (not tmm-shortcut-words) ; no limit on words
-                      (< word tmm-shortcut-words)) ; try n words
-                  (setq pos (string-match "\\w+" str pos)) ; get next word
-                  (not (and paren (> pos paren)))) ; don't go past "(binding.."
-        (if (or (= pos 0)
-                (/= (aref str (1- pos)) ?.)) ; avoid file extensions
-            (let ((shortcut-style                 
-                   (if (listp tmm-shortcut-style) ; convert to list
-                       tmm-shortcut-style
-                     (list tmm-shortcut-style))))
-              (while shortcut-style     ; try upcase and downcase variants
-                (setq char (funcall (car shortcut-style) (aref str pos)))
-                (if (not (memq char tmm-short-cuts)) (throw 'done char))
-                (setq shortcut-style (cdr shortcut-style)))))
-        (setq word (1+ word))
-        (setq pos (match-end 0)))
-      (while (<= tmm-next-shortcut-digit ?9) ; no letter shortcut, pick a digit
-        (setq char tmm-next-shortcut-digit)
-        (setq tmm-next-shortcut-digit (1+ tmm-next-shortcut-digit))
-        (if (not (memq char tmm-short-cuts)) (throw 'done char)))
-      (setq char nil))
-    (if char (setq tmm-short-cuts (cons char tmm-short-cuts)))
-    (cons (concat (if char (concat (char-to-string char) tmm-mid-prompt)
-                    ;; keep them lined up in columns
-                    (make-string (1+ (length tmm-mid-prompt)) ?\ ))
-                  str)
-          (cdr elt))))
-
-;; This returns the old map.
-(defun tmm-define-keys (minibuffer)
-  (let ((map (make-sparse-keymap)))
-    (suppress-keymap map t)
-    (mapcar
-     (function
-      (lambda (c)
-        (if (listp tmm-shortcut-style)
-            (define-key map (char-to-string c) 'tmm-shortcut)
-          ;; only one kind of letters are shortcuts, so map both upcase and
-          ;; downcase input to the same
-          (define-key map (char-to-string (downcase c)) 'tmm-shortcut)
-          (define-key map (char-to-string (upcase c)) 'tmm-shortcut))))
-     tmm-short-cuts)
-    (if minibuffer
-	(progn
-          (define-key map [pageup] 'tmm-goto-completions)
-          (define-key map [prior] 'tmm-goto-completions)
-          (define-key map "\ev" 'tmm-goto-completions)
-          (define-key map "\C-n" 'next-history-element)
-          (define-key map "\C-p" 'previous-history-element)))
-    (prog1 (current-local-map)
-      (use-local-map (append map (current-local-map))))))
-
-(defun tmm-completion-delete-prompt ()
-  (set-buffer standard-output)
-  (goto-char 1)
-  (delete-region 1 (search-forward "Possible completions are:\n")))
-
-(defun tmm-add-prompt ()
-  (remove-hook 'minibuffer-setup-hook 'tmm-add-prompt)
-  (make-local-hook 'minibuffer-exit-hook)
-  (add-hook 'minibuffer-exit-hook 'tmm-delete-map nil t)
-  (let ((win (selected-window)))
-    (setq tmm-old-mb-map (tmm-define-keys t))
-    ;; Get window and hide it for electric mode to get correct size
-    (save-window-excursion 
-      (let ((completions
-	     (mapcar 'car minibuffer-completion-table)))
-        (or tmm-completion-prompt
-            (add-hook 'completion-setup-hook
-                      'tmm-completion-delete-prompt 'append))
-	(with-output-to-temp-buffer "*Completions*"
-	  (display-completion-list completions))
-        (remove-hook 'completion-setup-hook 'tmm-completion-delete-prompt))
-      (if tmm-completion-prompt
-          (progn
-      (set-buffer "*Completions*")
-      (goto-char 1)
-            (insert tmm-completion-prompt)))
-      )
-    (save-excursion
-      (other-window 1)			; Electric-pop-up-window does
-					; not work in minibuffer
-      (set-buffer (window-buffer (Electric-pop-up-window "*Completions*")))
-
-      (setq tmm-old-comp-map (tmm-define-keys nil))
-
-      (select-window win)		; Cannot use
-					; save-window-excursion, since
-					; it restores the size
-      )
-    (insert tmm-c-prompt)))
-
-(defun tmm-delete-map ()
-  (remove-hook 'minibuffer-exit-hook 'tmm-delete-map t)
-  (if tmm-old-mb-map
-      (use-local-map tmm-old-mb-map)))
-
-(defun tmm-shortcut ()
-  "Choose the shortcut that the user typed."
-  (interactive)
-  (let ((c last-command-char) s)
-    (if (symbolp tmm-shortcut-style)
-        (setq c (funcall tmm-shortcut-style c)))
-    (if (memq c tmm-short-cuts)
-	(if (equal (buffer-name) "*Completions*")
-	    (progn
-	      (beginning-of-buffer)
-	      (re-search-forward
-	       (concat "\\(^\\|[ \t]\\)" (char-to-string c) tmm-mid-prompt))
-	      (choose-completion))
-	  (erase-buffer)		; In minibuffer
-	  (mapcar (lambda (elt)
-		    (if (string=
-			 (substring (car elt) 0 
-				    (min (1+ (length tmm-mid-prompt))
-					 (length (car elt))))
-			 (concat (char-to-string c) tmm-mid-prompt))
-			(setq s (car elt))))
-		  tmm-km-list)
-	  (insert s)
-	  (exit-minibuffer)))))
-
-(defun tmm-goto-completions ()
-  (interactive)
-  (setq tmm-c-prompt (buffer-string))
-  (erase-buffer)
-  (switch-to-buffer-other-window "*Completions*")
-  (search-forward tmm-c-prompt)
-  (search-backward tmm-c-prompt))
-
-(defun tmm-get-keymap (elt &optional in-x-menu) 
-  "Prepends (DOCSTRING EVENT BINDING) to free variable `tmm-km-list'.
-The values are deduced from the argument ELT, that should be an
-element of keymap, an `x-popup-menu' argument, or an element of
-`x-popup-menu' argument (when IN-X-MENU is not-nil).
-This function adds the element only if it is not already present.
-It uses the free variable `tmm-table-undef' to keep undefined keys."
-  (let (km str cache (event (car elt)))
-    (setq elt (cdr elt))
-    (if (eq elt 'undefined)
-	(setq tmm-table-undef (cons (cons event nil) tmm-table-undef))
-      (or
-       (assoc event tmm-table-undef)
-       (and (if (listp elt)
-		(keymapp elt)
-	      (fboundp elt))
-	    (setq km elt))
-       (and (if (listp (cdr-safe elt))
-		(keymapp (cdr-safe elt))
-	      (fboundp (cdr-safe elt)))
-	    (setq km (cdr elt))
-	    (and (stringp (car elt)) (setq str (car elt))))
-       (and (if (listp (cdr-safe (cdr-safe elt)))
-		(keymapp (cdr-safe (cdr-safe elt)))
-	      (fboundp (cdr-safe (cdr-safe elt))))
-	    (setq km (cdr (cdr elt)))
-	    (and (stringp (car elt)) (setq str (car elt)))
-	    (or (and str
-		     (stringp (cdr (car (cdr elt)))) ; keyseq cache
-		     (setq cache (cdr (car (cdr elt))))
-		     cache (setq str (concat str cache))) str))
-       (and (if (listp (cdr-safe (cdr-safe (cdr-safe elt))))
-		(keymapp (cdr-safe (cdr-safe (cdr-safe elt))))
-	      (fboundp (cdr-safe (cdr-safe (cdr-safe elt)))))
-					; New style of easy-menu
-	    (setq km (cdr (cdr (cdr elt))))
-	    (and (stringp (car elt)) (setq str (car elt)))
-	    (or (and str
-		     (stringp (cdr (car (cdr (cdr elt))))) ; keyseq cache
-		     (setq cache (cdr (car (cdr (cdr elt)))))
-		     cache (setq str (concat str cache)))
-		str))
-	    (and (stringp event)	; x-popup or x-popup element
-		 (if (or in-x-menu (stringp (car-safe elt)))
-		     (setq str event event nil km elt)
-		   (setq str event event nil km (cons 'keymap elt))
-		   )))
-      (and km (stringp km) (setq str km))
-      (and km str
-	   (or (assoc str tmm-km-list)
-	       (setq tmm-km-list 
-		     (cons (cons str (cons event km)) tmm-km-list)))
-	   ))))
-
-(defun tmm-get-keybind (keyseq)
-  "Return the current binding of KEYSEQ, merging prefix definitions.
-If KEYSEQ is a prefix key that has local and global bindings,
-we merge them into a single keymap which shows the proper order of the menu.
-However, for the menu bar itself, the value does not take account
-of `menu-bar-final-items'."
-  (let (allbind bind)
-    (setq bind (key-binding keyseq))
-    ;; If KEYSEQ is a prefix key, then BIND is either nil
-    ;; or a symbol defined as a keymap (which satisfies keymapp).
-    (if (keymapp bind)
-	(setq bind nil))
-    ;; If we have a non-keymap definition, return that.
-    (or bind
-	(progn
-	  ;; Otherwise, it is a prefix, so make a list of the subcommands.
-	  ;; Make a list of all the bindings in all the keymaps.
-	  (setq allbind (mapcar 'cdr (minor-mode-key-binding keyseq))) 
-	  (setq allbind (cons (local-key-binding keyseq) allbind))
-	  (setq allbind (cons (global-key-binding keyseq) allbind))
-	  ;; Merge all the elements of ALLBIND into one keymap.
-	  (mapcar (lambda (in)
-		    (if (and (symbolp in) (keymapp in))
-			(setq in (symbol-function in)))
-		    (and in (keymapp in)
-			 (if (keymapp bind)
-			     (setq bind (nconc bind (copy-sequence (cdr in))))
-			   (setq bind (copy-sequence in)))))
-		  allbind)
-	  ;; Return that keymap.
-	  bind))))
-
-(add-hook 'calendar-load-hook (lambda () (require 'cal-menu)))
-
-(provide 'tmm)
-
-;;; tmm.el ends here
diff --git a/lisp/type-break.el b/lisp/type-break.el
deleted file mode 100644
index 690f0842a39..00000000000
--- a/lisp/type-break.el
+++ /dev/null
@@ -1,688 +0,0 @@
-;;; type-break.el --- encourage rests from typing at appropriate intervals
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: extensions, timers
-;; Status: known to work in GNU Emacs 19.25 or later.
-;; Created: 1994-07-13
-;; $Id$
-
-;; 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, 675 Mass Ave, Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; The docstring for the function `type-break-mode' summarizes most of the
-;;; details of the interface.
-
-;;; This package relies on the assumption that you live entirely in emacs,
-;;; as the author does.  If that's not the case for you (e.g. you often
-;;; suspend emacs or work in other windows) then this won't help very much;
-;;; it will depend on just how often you switch back to emacs.  At the very
-;;; least, you will want to turn off the keystroke thresholds and rest
-;;; interval tracking.
-
-;;; This package was inspired by Roland McGrath's hanoi-break.el.
-;;; Thanks to both Roland McGrath <roland@gnu.ai.mit.edu> and Mark Ashton
-;;; <mpashton@gnu.ai.mit.edu> for feedback and ideas.
-
-;;; Code:
-
-
-(require 'timer)
-
-;; Make this nil initially so that the call to type-break-mode at the end
-;; will cause scheduling and so forth to happen.
-;;;###autoload
-(defvar type-break-mode nil
-  "*Non-`nil' means typing break mode is enabled.
-See the docstring for the `type-break-mode' command for more information.")
-
-;;;###autoload
-(defvar type-break-interval (* 60 60)
-  "*Number of seconds between scheduled typing breaks.")
-
-;;;###autoload
-(defvar type-break-good-rest-interval (/ type-break-interval 6)
-  "*Number of seconds of idle time considered to be an adequate typing rest.
-
-When this variable is non-`nil', emacs checks the idle time between
-keystrokes.  If this idle time is long enough to be considered a \"good\"
-rest from typing, then the next typing break is simply rescheduled for later.
-
-If a break is interrupted before this much time elapses, the user will be
-asked whether or not really to interrupt the break.")
-
-;;;###autoload
-(defvar type-break-keystroke-threshold
-  ;; Assuming typing speed is 35wpm (on the average, do you really
-  ;; type more than that in a minute?  I spend a lot of time reading mail
-  ;; and simply studying code in buffers) and average word length is
-  ;; about 5 letters, default upper threshold to the average number of
-  ;; keystrokes one is likely to type in a break interval.  That way if the
-  ;; user goes through a furious burst of typing activity, cause a typing
-  ;; break to be required sooner than originally scheduled.
-  ;; Conversely, the minimum threshold should be about a fifth of this.
-  (let* ((wpm 35)
-         (avg-word-length 5)
-         (upper (* wpm avg-word-length (/ type-break-interval 60)))
-         (lower (/ upper 5)))
-    (cons lower upper))
-  "*Upper and lower bound on number of keystrokes for considering typing break.
-This structure is a pair of numbers.
-
-The first number is the minimum number of keystrokes that must have been
-entered since the last typing break before considering another one, even if
-the scheduled time has elapsed; the break is simply rescheduled until later
-if the minimum threshold hasn't been reached.  If this first value is nil,
-then there is no minimum threshold; as soon as the scheduled time has
-elapsed, the user will always be queried.
-
-The second number is the maximum number of keystrokes that can be entered
-before a typing break is requested immediately, pre-empting the originally
-scheduled break.  If this second value is nil, then no pre-emptive breaks
-will occur; only scheduled ones will.
-
-Keys with bucky bits (shift, control, meta, etc) are counted as only one
-keystroke even though they really require multiple keys to generate them.")
-
-(defvar type-break-time-warning-intervals '(300 120 60 30)
-  "*List of time intervals for warnings about upcoming typing break.
-At each of the intervals (specified in seconds) away from a scheduled
-typing break, print a warning in the echo area.")
-
-(defvar type-break-keystroke-warning-intervals '(300 200 100 50)
-  "*List of keystroke measurements for warnings about upcoming typing break.
-At each of the intervals (specified in keystrokes) away from the upper
-keystroke threshold, print a warning in the echo area.
-If either this variable or the upper threshold is set, then no warnings
-Will occur.")
-
-(defvar type-break-query-interval 60
-  "*Number of seconds between queries to take a break, if put off.
-The user will continue to be prompted at this interval until he or she
-finally submits to taking a typing break.")
-
-(defvar type-break-warning-repeat 40
-  "*Number of keystrokes for which warnings should be repeated.
-That is, for each of this many keystrokes the warning is redisplayed
-in the echo area to make sure it's really seen.")
-
-(defvar type-break-query-function 'yes-or-no-p
-  "Function to use for making query for a typing break.
-It should take a string as an argument, the prompt.
-Usually this should be set to `yes-or-no-p' or `y-or-n-p'.")
-
-(defvar type-break-demo-functions
-  '(type-break-demo-boring type-break-demo-life type-break-demo-hanoi)
-  "*List of functions to consider running as demos during typing breaks.
-When a typing break begins, one of these functions is selected randomly
-to have emacs do something interesting.
-
-Any function in this list should start a demo which ceases as soon as a
-key is pressed.")
-
-(defvar type-break-post-command-hook nil
-  "Hook run indirectly by post-command-hook for typing break functions.")
-
-;; These are internal variables.  Do not set them yourself.
-
-(defvar type-break-alarm-p nil)
-(defvar type-break-keystroke-count 0)
-(defvar type-break-time-last-break nil)
-(defvar type-break-time-next-break nil)
-(defvar type-break-time-last-command (current-time))
-(defvar type-break-current-time-warning-interval nil)
-(defvar type-break-current-keystroke-warning-interval nil)
-(defvar type-break-time-warning-count 0)
-(defvar type-break-keystroke-warning-count 0)
-
-
-;;;###autoload
-(defun type-break-mode (&optional prefix)
-  "Enable or disable typing-break mode.
-This is a minor mode, but it is global to all buffers by default.
-
-When this mode is enabled, the user is encouraged to take typing breaks at
-appropriate intervals; either after a specified amount of time or when the
-user has exceeded a keystroke threshold.  When the time arrives, the user
-is asked to take a break.  If the user refuses at that time, emacs will ask
-again in a short period of time.  The idea is to give the user enough time
-to find a good breaking point in his or her work, but be sufficiently
-annoying to discourage putting typing breaks off indefinitely.
-
-A negative prefix argument disables this mode.
-No argument or any non-negative argument enables it.
-
-The user may enable or disable this mode by setting the variable of the
-same name, though setting it in that way doesn't reschedule a break or
-reset the keystroke counter.
-
-If the mode was previously disabled and is enabled as a consequence of
-calling this function, it schedules a break with `type-break-schedule' to
-make sure one occurs (the user can call that command to reschedule the
-break at any time).  It also initializes the keystroke counter.
-
-The variable `type-break-interval' specifies the number of seconds to
-schedule between regular typing breaks.  This variable doesn't directly
-affect the time schedule; it simply provides a default for the
-`type-break-schedule' command.
-
-If set, the variable `type-break-good-rest-interval' specifies the minimum
-amount of time which is considered a reasonable typing break.  Whenever
-that time has elapsed, typing breaks are automatically rescheduled for
-later even if emacs didn't prompt you to take one first.  Also, if a break
-is ended before this much time has elapsed, the user will be asked whether
-or not to continue.
-
-The variable `type-break-keystroke-threshold' is used to determine the
-thresholds at which typing breaks should be considered.  You can use
-the command `type-break-guestimate-keystroke-threshold' to try to
-approximate good values for this.
-
-Finally, the command `type-break-statistics' prints interesting things."
-  (interactive "P")
-  ;; make sure it's there.
-  (add-hook 'post-command-hook 'type-break-run-tb-post-command-hook 'append)
-  (add-hook 'type-break-post-command-hook 'type-break-check)
-
-  (let ((already-enabled type-break-mode))
-    (setq type-break-mode (>= (prefix-numeric-value prefix) 0))
-
-    (cond
-     ((and already-enabled type-break-mode)
-      (and (interactive-p)
-           (message "type-break-mode is enabled")))
-     (type-break-mode
-      (type-break-keystroke-reset)
-      (type-break-schedule)
-      (and (interactive-p)
-           (message "type-break-mode is enabled and reset")))
-     ((interactive-p)
-      (message "type-break-mode is disabled"))))
-  type-break-mode)
-
-;;;###autoload
-(defun type-break ()
-  "Take a typing break.
-
-During the break, a demo selected from the functions listed in
-`type-break-demo-functions' is run.
-
-After the typing break is finished, the next break is scheduled
-as per the function `type-break-schedule'."
-  (interactive)
-  (type-break-cancel-schedule)
-  (let ((continue t)
-        (start-time (current-time)))
-    (setq type-break-time-last-break start-time)
-    (while continue
-      (save-window-excursion
-        ;; Eat the screen.
-        (and (eq (selected-window) (minibuffer-window))
-             (other-window 1))
-        (delete-other-windows)
-        (scroll-right (window-width))
-        (message "Press any key to resume from typing break.")
-
-        (random t)
-        (let* ((len (length type-break-demo-functions))
-               (idx (random len))
-               (fn (nth idx type-break-demo-functions)))
-          (condition-case ()
-              (funcall fn)
-            (error nil))))
-
-      (cond
-       (type-break-good-rest-interval
-        (let ((break-secs (type-break-time-difference
-                           start-time (current-time))))
-          (cond
-           ((>= break-secs type-break-good-rest-interval)
-            (setq continue nil))
-           ;; Don't be pedantic; if user's rest was only a minute short,
-           ;; why bother?
-           ((> 60 (abs (- break-secs type-break-good-rest-interval)))
-            (setq continue nil))
-           ((funcall
-             type-break-query-function
-             (format "You really ought to rest %s more.  Continue break? "
-                     (type-break-format-time (- type-break-good-rest-interval
-                                                break-secs)))))
-           (t
-            (setq continue nil)))))
-       (t (setq continue nil)))))
-
-  (type-break-keystroke-reset)
-  (type-break-schedule))
-
-
-(defun type-break-schedule (&optional time)
-  "Schedule a typing break for TIME seconds from now.
-If time is not specified, default to `type-break-interval'."
-  (interactive (list (and current-prefix-arg
-                          (prefix-numeric-value current-prefix-arg))))
-  (or time (setq time type-break-interval))
-  (type-break-cancel-schedule)
-  (type-break-time-warning-schedule time 'reset)
-  (run-at-time time nil 'type-break-alarm)
-  (setq type-break-time-next-break
-        (type-break-time-sum (current-time) time)))
-
-(defun type-break-cancel-schedule ()
-  (type-break-cancel-time-warning-schedule)
-  (let ((timer-dont-exit t))
-    (cancel-function-timers 'type-break-alarm))
-  (setq type-break-alarm-p nil)
-  (setq type-break-time-next-break nil))
-
-(defun type-break-time-warning-schedule (&optional time resetp)
-  (let (type-break-current-time-warning-interval)
-    (type-break-cancel-time-warning-schedule))
-  (cond
-   (type-break-time-warning-intervals
-    (and resetp
-         (setq type-break-current-time-warning-interval
-               type-break-time-warning-intervals))
-
-    (or time
-        (setq time (type-break-time-difference (current-time)
-                                               type-break-time-next-break)))
-
-    (while (and type-break-current-time-warning-interval
-                (> (car type-break-current-time-warning-interval) time))
-      (setq type-break-current-time-warning-interval
-            (cdr type-break-current-time-warning-interval)))
-
-    (cond
-     (type-break-current-time-warning-interval
-      (setq time (- time (car type-break-current-time-warning-interval)))
-      (setq type-break-current-time-warning-interval
-            (cdr type-break-current-time-warning-interval))
-
-      (let (type-break-current-time-warning-interval)
-        (type-break-cancel-time-warning-schedule))
-      (run-at-time time nil 'type-break-time-warning-alarm))))))
-
-(defun type-break-cancel-time-warning-schedule ()
-  (let ((timer-dont-exit t))
-    (cancel-function-timers 'type-break-time-warning-alarm))
-  (remove-hook 'type-break-post-command-hook 'type-break-time-warning)
-  (setq type-break-current-time-warning-interval
-        type-break-time-warning-intervals))
-
-(defun type-break-alarm ()
-  (setq type-break-alarm-p t))
-
-(defun type-break-time-warning-alarm ()
-  (type-break-time-warning-schedule)
-  (setq type-break-time-warning-count type-break-warning-repeat)
-  (add-hook 'type-break-post-command-hook 'type-break-time-warning 'append))
-
-
-(defun type-break-run-tb-post-command-hook ()
-  (and type-break-mode
-       (run-hooks 'type-break-post-command-hook)))
-
-(defun type-break-check ()
-  "Ask to take a typing break if appropriate.
-This may be the case either because the scheduled time has come \(and the
-minimum keystroke threshold has been reached\) or because the maximum
-keystroke threshold has been exceeded."
-  (let* ((min-threshold (car type-break-keystroke-threshold))
-         (max-threshold (cdr type-break-keystroke-threshold)))
-    (and type-break-good-rest-interval
-         (progn
-           (and (> (type-break-time-difference
-                    type-break-time-last-command (current-time))
-                   type-break-good-rest-interval)
-                (progn
-                  (type-break-keystroke-reset)
-                  (setq type-break-time-last-break (current-time))
-                  (type-break-schedule)))
-           (setq type-break-time-last-command (current-time))))
-
-    (and type-break-keystroke-threshold
-         (setq type-break-keystroke-count
-               (+ type-break-keystroke-count (length (this-command-keys)))))
-
-    ;; This has been optimized for speed; calls to input-pending-p and
-    ;; checking for the minibuffer window are only done if it would
-    ;; matter for the sake of querying user.
-    (cond
-     (type-break-alarm-p
-      (cond
-       ((input-pending-p))
-       ((eq (selected-window) (minibuffer-window)))
-       ((and min-threshold
-             (< type-break-keystroke-count min-threshold))
-        (type-break-schedule))
-       (t
-        ;; If keystroke count is within min-threshold of
-        ;; max-threshold, lower it to reduce the liklihood of an
-        ;; immediate subsequent query.
-        (and max-threshold
-             min-threshold
-             (< (- max-threshold type-break-keystroke-count) min-threshold)
-             (progn
-               (type-break-keystroke-reset)
-               (setq type-break-keystroke-count min-threshold)))
-        (type-break-query))))
-     ((and type-break-keystroke-warning-intervals
-           max-threshold
-           (= type-break-keystroke-warning-count 0)
-           (type-break-check-keystroke-warning)))
-     ((and max-threshold
-           (> type-break-keystroke-count max-threshold)
-           (not (input-pending-p))
-           (not (eq (selected-window) (minibuffer-window))))
-      (type-break-keystroke-reset)
-      (setq type-break-keystroke-count (or min-threshold 0))
-      (type-break-query)))))
-
-;; This should return t if warnings were enabled, nil otherwise.
-(defsubst type-break-check-keystroke-warning ()
-  (let ((left (- (cdr type-break-keystroke-threshold)
-                 type-break-keystroke-count)))
-    (cond
-     ((null (car type-break-current-keystroke-warning-interval))
-      nil)
-     ((> left (car type-break-current-keystroke-warning-interval))
-      nil)
-     (t
-      (while (and (car type-break-current-keystroke-warning-interval)
-                  (< left (car type-break-current-keystroke-warning-interval)))
-        (setq type-break-current-keystroke-warning-interval
-              (cdr type-break-current-keystroke-warning-interval)))
-      (setq type-break-keystroke-warning-count type-break-warning-repeat)
-      (add-hook 'type-break-post-command-hook 'type-break-keystroke-warning)
-      t))))
-
-(defun type-break-query ()
-  (condition-case ()
-      (cond
-       ((let ((type-break-mode nil))
-          (funcall type-break-query-function "Take a break from typing now? "))
-        (type-break))
-       (t
-        (type-break-schedule type-break-query-interval)))
-    (quit
-     (type-break-schedule type-break-query-interval))))
-
-(defun type-break-time-warning ()
-  (cond
-   ((and (car type-break-keystroke-threshold)
-         (< type-break-keystroke-count (car type-break-keystroke-threshold))))
-   ((> type-break-time-warning-count 0)
-    (cond
-     ((eq (selected-window) (minibuffer-window)))
-     (t
-      ;; Pause for a moment so previous messages can be seen.
-      (sit-for 2)
-      (message "Warning: typing break due in %s."
-               (type-break-format-time
-                (type-break-time-difference (current-time)
-                                            type-break-time-next-break)))
-      (setq type-break-time-warning-count
-            (1- type-break-time-warning-count)))))
-   (t
-    (remove-hook 'type-break-post-command-hook 'type-break-time-warning))))
-
-(defun type-break-keystroke-warning ()
-  (cond
-   ((> type-break-keystroke-warning-count 0)
-    (cond
-     ((eq (selected-window) (minibuffer-window)))
-     (t
-      (sit-for 2)
-      (message "Warning: typing break due in %s keystrokes."
-               (- (cdr type-break-keystroke-threshold)
-                  type-break-keystroke-count))
-      (setq type-break-keystroke-warning-count
-            (1- type-break-keystroke-warning-count)))))
-   (t
-    (remove-hook 'type-break-post-command-hook
-                 'type-break-keystroke-warning))))
-
-
-;;;###autoload
-(defun type-break-statistics ()
-  "Print statistics about typing breaks in a temporary buffer.
-This includes the last time a typing break was taken, when the next one is
-scheduled, the keystroke thresholds and the current keystroke count, etc."
-  (interactive)
-  (with-output-to-temp-buffer "*Typing Break Statistics*"
-    (princ (format "Typing break statistics\n-----------------------\n
-Last typing break           : %s
-Next scheduled typing break : %s\n
-Minimum keystroke threshold : %s
-Maximum keystroke threshold : %s
-Current keystroke count     : %s"
-                   (if type-break-time-last-break
-                       (current-time-string type-break-time-last-break)
-                     "never")
-                   (if (and type-break-mode type-break-time-next-break)
-                       (format "%s\t(%s from now)"
-                               (current-time-string type-break-time-next-break)
-                               (type-break-format-time
-                                (type-break-time-difference
-                                (current-time)
-                                type-break-time-next-break)))
-                     "none scheduled")
-                   (or (car type-break-keystroke-threshold) "none")
-                   (or (cdr type-break-keystroke-threshold) "none")
-                   type-break-keystroke-count))))
-
-;;;###autoload
-(defun type-break-guestimate-keystroke-threshold (wpm &optional wordlen frac)
-  "Guess values for the minimum/maximum keystroke threshold for typing breaks.
-If called interactively, the user is prompted for their guess as to how
-many words per minute they usually type.  From that, the command sets the
-values in `type-break-keystroke-threshold' based on a fairly simple
-algorithm involving assumptions about the average length of words (5).
-For the minimum threshold, it uses about a quarter of the computed maximum
-threshold.
-
-When called from lisp programs, the optional args WORDLEN and FRAC can be
-used to override the default assumption about average word length and the
-fraction of the maximum threshold to which to set the minimum threshold.
-FRAC should be the inverse of the fractional value; for example, a value of
-2 would mean to use one half, a value of 4 would mean to use one quarter, etc."
-  (interactive "NHow many words per minute do you type? ")
-  (let* ((upper (* wpm (or wordlen 5) (/ type-break-interval 60)))
-         (lower (/ upper (or frac 5))))
-    (or type-break-keystroke-threshold
-        (setq type-break-keystroke-threshold (cons nil nil)))
-    (setcar type-break-keystroke-threshold lower)
-    (setcdr type-break-keystroke-threshold upper)
-    (if (interactive-p)
-        (message "min threshold: %d\tmax threshold: %d" lower upper)
-      type-break-keystroke-threshold)))
-
-
-;;; misc functions
-
-;; Compute the difference, in seconds, between a and b, two structures
-;; similar to those returned by `current-time'.
-;; Use addition rather than logand since that is more robust; the low 16
-;; bits of the seconds might have been incremented, making it more than 16
-;; bits wide.
-(defsubst type-break-time-difference (a b)
-  (+ (lsh (- (car b) (car a)) 16)
-     (- (car (cdr b)) (car (cdr a)))))
-
-;; Return (in a new list the same in structure to that returned by
-;; `current-time') the sum of the arguments.  Each argument may be a time
-;; list or a single integer, a number of seconds.
-;; This function keeps the high and low 16 bits of the seconds properly
-;; balanced so that the lower value never exceeds 16 bits.  Otherwise, when
-;; the result is passed to `current-time-string' it will toss some of the
-;; "low" bits and return the wrong value.
-(defun type-break-time-sum (&rest tmlist)
-  (let ((high 0)
-        (low 0)
-        (micro 0)
-        tem)
-    (while tmlist
-      (setq tem (car tmlist))
-      (setq tmlist (cdr tmlist))
-      (cond
-       ((numberp tem)
-        (setq low (+ low tem)))
-       (t
-        (setq high  (+ high  (or (car tem) 0)))
-        (setq low   (+ low   (or (car (cdr tem)) 0)))
-        (setq micro (+ micro (or (car (cdr (cdr tem))) 0))))))
-
-    (and (>= micro 1000000)
-         (progn
-           (setq tem (/ micro 1000000))
-           (setq low (+ low tem))
-           (setq micro (- micro (* tem 1000000)))))
-
-    (setq tem (lsh low -16))
-    (and (> tem 0)
-         (progn
-           (setq low (logand low 65535))
-           (setq high (+ high tem))))
-
-    (list high low micro)))
-
-(defsubst type-break-format-time (secs)
-  (let ((mins (/ secs 60)))
-    (cond
-     ((= mins 1) (format "%d minute" mins))
-     ((> mins 0) (format "%d minutes" mins))
-     ((= secs 1) (format "%d second" secs))
-     (t (format "%d seconds" secs)))))
-
-(defun type-break-keystroke-reset ()
-  (setq type-break-keystroke-count 0)
-  (setq type-break-keystroke-warning-count 0)
-  (setq type-break-current-keystroke-warning-interval
-        type-break-keystroke-warning-intervals)
-  (remove-hook 'type-break-post-command-hook 'type-break-keystroke-warning))
-
-
-;;; Demo wrappers
-
-;; This is a wrapper around hanoi that calls it with an arg large enough to
-;; make the largest discs possible that will fit in the window.
-;; Also, clean up the *Hanoi* buffer after we're done.
-(defun type-break-demo-hanoi ()
-  "Take a hanoiing typing break."
-  (and (get-buffer "*Hanoi*")
-       (kill-buffer "*Hanoi*"))
-  (condition-case ()
-      (progn
-        (hanoi (/ (window-width) 8))
-        ;; Wait for user to come back.
-        (read-char)
-        (kill-buffer "*Hanoi*"))
-    (quit
-     ;; eat char
-     (read-char)
-     (and (get-buffer "*Hanoi*")
-          (kill-buffer "*Hanoi*")))))
-
-;; This is a wrapper around life that calls it with a `sleep' arg to make
-;; it run a little more leisurely.
-;; Also, clean up the *Life* buffer after we're done.
-(defun type-break-demo-life ()
-  "Take a typing break and get a life."
-  (let ((continue t))
-    (while continue
-      (setq continue nil)
-      (and (get-buffer "*Life*")
-           (kill-buffer "*Life*"))
-      (condition-case ()
-          (progn
-            (life 3)
-            ;; wait for user to return
-            (read-char)
-            (kill-buffer "*Life*"))
-        (life-extinct
-         (message (get 'life-extinct 'error-message))
-         (sit-for 3)
-         ;; restart demo
-         (setq continue t))
-        (quit
-         (and (get-buffer "*Life*")
-              (kill-buffer "*Life*")))))))
-
-;; Boring demo, but doesn't use many cycles
-(defun type-break-demo-boring ()
-  "Boring typing break demo."
-  (let ((rmsg "Press any key to resume from typing break")
-        (buffer-name "*Typing Break Buffer*")
-        line col pos
-        elapsed timeleft tmsg)
-    (condition-case ()
-        (progn
-          (switch-to-buffer (get-buffer-create buffer-name))
-          (buffer-disable-undo (current-buffer))
-          (erase-buffer)
-          (setq line (1+ (/ (window-height) 2)))
-          (setq col (/ (- (window-width) (length rmsg)) 2))
-          (insert (make-string line ?\C-j)
-                  (make-string col ?\ )
-                  rmsg)
-          (forward-line -1)
-          (beginning-of-line)
-          (setq pos (point))
-          (while (not (input-pending-p))
-            (delete-region pos (progn
-                                 (goto-char pos)
-                                 (end-of-line)
-                                 (point)))
-            (setq elapsed (type-break-time-difference
-                           type-break-time-last-break
-                           (current-time)))
-            (cond
-             (type-break-good-rest-interval
-              (setq timeleft (- type-break-good-rest-interval elapsed))
-              (if (> timeleft 0)
-                  (setq tmsg (format "You should rest for %s more"
-                                     (type-break-format-time timeleft)))
-                (setq tmsg (format "Typing break has lasted %s"
-                                   (type-break-format-time elapsed)))))
-             (t
-              (setq tmsg (format "Typing break has lasted %s"
-                                 (type-break-format-time elapsed)))))
-            (setq col (/ (- (window-width) (length tmsg)) 2))
-            (insert (make-string col ?\ ) tmsg)
-            (goto-char (point-min))
-            (sit-for 60))
-          (read-char)
-          (kill-buffer buffer-name))
-      (quit
-       (and (get-buffer buffer-name)
-            (kill-buffer buffer-name))))))
-
-
-(provide 'type-break)
-
-;; Do not do this at load time because it makes it impossible to load this
-;; file into temacs and then dump it.
-;(type-break-mode t)
-
-;; local variables:
-;; vc-make-backup-files: t
-;; end:
-
-;;; type-break.el ends here
diff --git a/lisp/uncompress.el b/lisp/uncompress.el
deleted file mode 100644
index cdfa1882d38..00000000000
--- a/lisp/uncompress.el
+++ /dev/null
@@ -1,97 +0,0 @@
-;;; uncompress.el --- auto-decompression hook for visiting .Z files
-
-;; Copyright (C) 1992, 1994 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 can be used to arrange for automatic uncompress of
-;; files packed with the UNIX compress(1) utility when they are visited.
-;; All that's necessary is to load it.  This can conveniently be done from
-;; your .emacs file.
-
-;;; Code:
-
-;; When we are about to make a backup file,
-;; uncompress the file we visited
-;; so that making the backup can work properly.
-;; This is used as a write-file-hook.
-
-(defvar uncompress-program "gunzip"
-  "Program to use for uncompression.")
-
-(defun uncompress-backup-file ()
-  (and buffer-file-name make-backup-files (not buffer-backed-up)
-       (not (file-exists-p buffer-file-name))
-       (call-process uncompress-program nil nil nil buffer-file-name))
-  nil)
-
-(or (assoc "\\.Z$" auto-mode-alist)
-    (setq auto-mode-alist
-	  (cons '("\\.Z$" . uncompress-while-visiting) auto-mode-alist)))
-(or (assoc "\\.gz$" auto-mode-alist)
-    (setq auto-mode-alist
-	  (cons '("\\.gz$" . uncompress-while-visiting) auto-mode-alist)))
-
-(defun uncompress-while-visiting ()
-  "Temporary \"major mode\" used for .Z and .gz files, to uncompress them.
-It then selects a major mode from the uncompressed file name and contents."
-  (if (and (not (null buffer-file-name))
-	   (string-match "\\.Z$" buffer-file-name))
-      (set-visited-file-name
-       (substring buffer-file-name 0 (match-beginning 0)))
-    (if (and (not (null buffer-file-name))
-	     (string-match "\\.gz$" buffer-file-name))
-	(set-visited-file-name
-	 (substring buffer-file-name 0 (match-beginning 0)))))
-  (message "Uncompressing...")
-  (let ((buffer-read-only nil))
-    (shell-command-on-region (point-min) (point-max) uncompress-program t))
-  (message "Uncompressing...done")
-  (set-buffer-modified-p nil)
-  (make-local-variable 'write-file-hooks)
-  (or (memq 'uncompress-backup-file write-file-hooks)
-      (setq write-file-hooks (cons 'uncompress-backup-file write-file-hooks)))
-  (normal-mode))
-
-(or (memq 'find-compressed-version find-file-not-found-hooks)
-    (setq find-file-not-found-hooks
-	  (cons 'find-compressed-version find-file-not-found-hooks)))
-
-(defun find-compressed-version ()
-  "Hook to read and uncompress the compressed version of a file."
-  ;; Just pretend we had visited the compressed file,
-  ;; and uncompress-while-visiting will do the rest.
-  (let (name)
-    (if (file-exists-p (setq name (concat buffer-file-name ".Z")))
-	(setq buffer-file-name name)
-      (if (file-exists-p (setq name (concat buffer-file-name ".gz")))
-	  (setq buffer-file-name name)))
-    (if (eq name buffer-file-name)
-	(progn
-	  (insert-file-contents buffer-file-name t)
-	  (goto-char (point-min))
-	  (setq error nil)
-	  t))))
-
-(provide 'uncompress)
-
-;;; uncompress.el ends here
diff --git a/lisp/uniquify.el b/lisp/uniquify.el
deleted file mode 100644
index 0152721dad0..00000000000
--- a/lisp/uniquify.el
+++ /dev/null
@@ -1,384 +0,0 @@
-;;; uniquify.el --- unique buffer names dependent on file name
-
-;; Copyright (c) 1989, 1995 Free Software Foundation, Inc.
-
-;; Author: Dick King <king@reasoning.com>
-;; Maintainer: Michael Ernst <mernst@theory.lcs.mit.edu>
-;; Created: 15 May 86
-
-;; 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:
-
-;; Emacs's standard method for making buffer names unique adds <2>, <3>,
-;; etc. to the end of (all but one of) the buffers.  This file replaces
-;; that behavior, for buffers visiting files and dired buffers, with a
-;; uniquification that adds parts of the file name until the buffer names
-;; are unique.  For instance, buffers visiting /u/mernst/tmp/Makefile and
-;; /usr/projects/zaphod/Makefile would be named Makefile|tmp and
-;; Makefile|zaphod, respectively (instead of Makefile and Makefile<2>).
-;; Other buffer name styles are also available.
-
-;; To use this file, just load it.
-;; To disable it after loading, set variable uniquify-buffer-name-style to nil.
-;; For other options, see "User-visible variables", below.
-
-;; A version of uniquify.el that works under Emacs 18, Emacs 19, XEmacs,
-;; and InfoDock is available from the maintainer.
-
-;;; Change Log:
-
-;; Originally by Dick King <king@reasoning.com> 15 May 86
-;; Converted for Emacs 18 by Stephen Gildea <gildea@lcs.mit.edu>
-;; Make uniquify-min-dir-content 0 truly non-invasive.  gildea 23 May 89
-;; Some cleanup.  uniquify-min-dir-content default 0.  gildea 01 Jun 89
-;; Don't rename to "".  Michael Ernst <mernst@theory.lcs.mit.edu> 15 Jun 94
-;; Add kill-buffer-hook.  Kenneth Manheimer <ken.manheimer@nist.gov> 09 May 95
-;; Add advice for rename-buffer and create-file-buffer, handle dired buffers,
-;;  kill-buffer-rationalize-buffer-names-p, documentation.  mernst 24 May 95
-;; Remove free variables, fix typos.  mernst 5 Jun 95
-;; Efficiently support Emacs 19.27 & earlier.  ken.manheimer, mernst 10 Jun 95
-;; Rename user options to "uniquify-...", add uniquify-reverse-dir-content-p,
-;;  add uniquify-ask-about-buffer-names-p.  king, mernst 13 Jun 95
-;; Prefix functions by "uniquify-..."; rename mnemonic-buffer-names to
-;;  uniquify-buffer-name-style; add 'forward and 'post-forward-angle-brackets
-;;  styles; remove uniquify-reverse-dir-content-p; add
-;;  uniquify-trailing-separator-p.  mernst 4 Aug 95
-
-;; Valuable feedback was provided by
-;; Paul Smith <psmith@baynetworks.com>,
-;; Alastair Burt <burt@dfki.uni-kl.de>,
-;; Bob Weiner <weiner@footloose.sps.mot.com>,
-;; Albert L. Ting <alt@vlibs.com>,
-;; gyro@reasoning.com.
-
-
-;;; Code:
-
-(provide 'uniquify)
-
-;;; User-visible variables
-
-(defvar uniquify-buffer-name-style 'post-forward
-  "*If non-nil, buffer names are uniquified with parts of directory name.
-The value determines the buffer name style and is one of `forward',
-`reverse', `post-forward' (the default), or `post-forward-angle-brackets'.
-For example, files `/foo/bar/mumble/name' and `/baz/quux/mumble/name'
-would have the following buffer names in the various styles:
-  forward        bar/mumble/name  quux/mumble/name
-  reverse        name\\mumble\\bar  name\\mumble\\quux
-  post-forward   name|bar/mumble  name|quux/mumble
-  post-forward-angle-brackets   name<bar/mumble>  name<quux/mumble>
-  nil            name  name<2>")
-
-(defvar uniquify-after-kill-buffer-p nil
-  "*If non-nil, rerationalize buffer names after a buffer has been killed.
-This can be dangerous if Emacs Lisp code is keeping track of buffers by their
-names (rather than keeping pointers to the buffers themselves).")
-
-(defconst uniquify-ask-about-buffer-names-p nil
-  "*If non-nil, permit user to choose names for buffers with same base file.
-If the user chooses to name a buffer, uniquification is preempted and no
-other buffer names are changed.")
-
-(defvar uniquify-min-dir-content 0
-  "*Minimum parts of directory name included in buffer name.")
-
-(defvar uniquify-separator nil
-  "*String separator for buffer name components.
-When `uniquify-buffer-name-style' is `post-forward', separates
-base file name from directory part in buffer names (default \"|\").
-When `uniquify-buffer-name-style' is `reverse', separates all
-file name components (default \"\\\").")
-
-(defvar uniquify-trailing-separator-p nil
-  "*If non-nil, add a file name separator to dired buffer names.
-If `uniquify-buffer-name-style' is `forward', add the separator at the end;
-if it is `reverse', add the separator at the beginning; otherwise, this
-variable is ignored.")
-
-
-;;; Utilities
-
-(defmacro uniquify-push (item list)
-  (` (setq (, list) (cons (, item) (, list)))))
-
-(defmacro uniquify-fix-list-base (a)
-  (` (car (, a))))
-
-(defmacro uniquify-fix-list-filename (a)
-  (` (car (cdr (, a)))))
-
-(defmacro uniquify-fix-list-buffer (a)
-  (` (car (cdr (cdr (, a))))))
-
-(defmacro uniquify-cadddr (a)
-  (` (car (cdr (cdr (cdr (, a)))))))
-
-;; Internal variables used free
-(defvar uniquify-non-file-buffer-names nil)
-(defvar uniquify-possibly-resolvable nil)
-
-;;; Main entry point.
-
-(defun uniquify-rationalize-file-buffer-names (&optional newbuffile newbuf)
-  "Makes file buffer names unique by adding segments from file name.
-If `uniquify-min-dir-content' > 0, always pulls that many
-file name elements.  Arguments cause only a subset of buffers to be renamed."
-  (interactive)
-  (let (fix-list
-	uniquify-non-file-buffer-names
-	(depth uniquify-min-dir-content))
-    (let ((buffers (buffer-list)))
-      (while buffers
-	(let* ((buffer (car buffers))
-	       (bfn (if (eq buffer newbuf)
-			(and newbuffile
-			     (expand-file-name newbuffile))
-		      (uniquify-buffer-file-name buffer)))
-	       (rawname (and bfn (file-name-nondirectory bfn)))
-	       (deserving (and rawname
-			       (or (not newbuffile)
-				   (equal rawname
-					  (file-name-nondirectory newbuffile))))))
-	  (if deserving
-	      (uniquify-push (list rawname bfn buffer nil) fix-list)
-	    (uniquify-push (list (buffer-name buffer))
-			   uniquify-non-file-buffer-names)))
-	(setq buffers (cdr buffers))))
-    ;; selects buffers whose names may need changing, and others that
-    ;; may conflict.
-    (setq fix-list
-	  (sort fix-list 'uniquify-fix-list-filename-lessp))
-    ;; bringing conflicting names together
-    (uniquify-rationalize-a-list fix-list depth)
-    (mapcar 'uniquify-unrationalized-buffer fix-list)))
-
-;; uniquify's version of buffer-file-name
-(defun uniquify-buffer-file-name (buffer)
-  "Return name of file BUFFER is visiting, or nil if none.
-Works on dired buffers as well as ordinary file-visiting buffers."
-  (or (buffer-file-name buffer)
-      (save-excursion
-	(set-buffer buffer)
-	list-buffers-directory)))
-
-(defun uniquify-fix-list-filename-lessp (fixlist1 fixlist2)
-  (uniquify-filename-lessp
-   (uniquify-fix-list-filename fixlist1) (uniquify-fix-list-filename fixlist2)))
-
-;; This examines the filename components in reverse order.
-(defun uniquify-filename-lessp (s1 s2)
-  (let ((s1f (file-name-nondirectory s1))
-	(s2f (file-name-nondirectory s2)))
-    (and (not (equal s2f ""))
-	 (or (string-lessp s1f s2f)
-	     (and (equal s1f s2f)
-		  (let ((s1d (file-name-directory s1))
-			(s2d (file-name-directory s2)))
-		    (and (not (<= (length s2d) 1))
-			 (or (<= (length s1d) 1)
-			     (uniquify-filename-lessp
-			      (substring s1d 0 -1)
-			      (substring s2d 0 -1))))))))))
-
-;; Was named do-the-buffers-you-couldnt-rationalize
-(defun uniquify-unrationalized-buffer (item)
-  (or (uniquify-cadddr item) nil))	;maybe better in the future
-
-(defun uniquify-rationalize-a-list (fix-list depth)
-  (let (conflicting-sublist
-	(old-name "")
-	proposed-name uniquify-possibly-resolvable)
-    (while fix-list
-      (let ((item (car fix-list)))
-	(setq proposed-name (uniquify-get-proposed-name item depth))
-	(if (not (equal proposed-name old-name))
-	    (progn
-	      (uniquify-rationalize-conflicting-sublist
-	       conflicting-sublist old-name depth)
-	      (setq conflicting-sublist nil)))
-	(uniquify-push item conflicting-sublist)
-	(setq old-name proposed-name))
-      (setq fix-list (cdr fix-list)))
-    (uniquify-rationalize-conflicting-sublist
-     conflicting-sublist old-name depth)))
-
-(defun uniquify-get-proposed-name (item depth)
-  (let (index
-	(extra-string "")
-	(n depth)
-	(base (uniquify-fix-list-base item))
-	(fn (uniquify-fix-list-filename item)))
-    (while (and (> n 0)
-		(setq index (string-match
-			     (concat "\\(^\\|/[^/]*\\)/"
-				     (regexp-quote extra-string)
-				     (regexp-quote base)
-				     "\\'")
-			     fn)))
-      (setq extra-string (substring fn
-				    (if (zerop index) 0 (1+ index))
-				    ;; (- (length base)) fails for base = "".
-				    ;; Equivalently, we could have used
-				    ;; (apply 'substring ...
-				    ;;        (and (not (string= "" base))
-				    ;;             (list (- (length base)))))
-				    (- (length fn) (length base)))
-	    n (1- n)))
-    (if (zerop n) (setq uniquify-possibly-resolvable t))
-
-
-    ;; Distinguish directories by adding extra separator.
-    (if (and uniquify-trailing-separator-p
-	     (file-directory-p fn)
-	     (not (string-equal base "")))
-	(cond ((eq uniquify-buffer-name-style 'forward)
-	       (setq base (concat base "/")))
-	      ((eq uniquify-buffer-name-style 'reverse)
-	       (setq base (concat (or uniquify-separator "\\") base)))))
-
-    ;; Trim trailing separator on directory part
-    (if (and (not (string-equal extra-string ""))
-	     (or (eq uniquify-buffer-name-style 'post-forward)
-		 (eq uniquify-buffer-name-style 'post-forward-angle-brackets)))
-	(setq extra-string (substring extra-string 0
-				      (- (length extra-string) 1))))
-
-    (cond ((string-equal extra-string "")
-	   base)
-	  ((string-equal base "")
-	   extra-string)
-	  ((eq uniquify-buffer-name-style 'forward)
-	   (concat extra-string base))
-	  ((eq uniquify-buffer-name-style 'reverse)
-	   (concat base (uniquify-reverse-components extra-string)))
-	  ((eq uniquify-buffer-name-style 'post-forward)
-	   (concat base (or uniquify-separator "|") extra-string))
-	  ((eq uniquify-buffer-name-style 'post-forward-angle-brackets)
-	   (concat base "<" extra-string ">"))
-	  (t (error "Bad value for uniquify-buffer-name-style: %s"
-		    uniquify-buffer-name-style)))))
-
-
-;; Deal with conflicting-sublist, which is set by uniquify-rationalize-a-list.
-;; This is only called by uniquify-rationalize-a-list.
-(defun uniquify-rationalize-conflicting-sublist (conflicting-sublist old-name depth)
-  (or (null conflicting-sublist)
-      (and (null (cdr conflicting-sublist))
-	   (not (assoc old-name uniquify-non-file-buffer-names))
-	   (or (and (not (string= old-name ""))
-		    (uniquify-rename-buffer (car conflicting-sublist) old-name))
-	       t))
-      (if uniquify-possibly-resolvable
-	  (uniquify-rationalize-a-list conflicting-sublist (1+ depth)))))
-
-(defun uniquify-rename-buffer (item newname)
-  (let ((buffer (uniquify-fix-list-buffer item)))
-    (if (not (equal newname (buffer-name buffer)))
-	(let ((unset (current-buffer))
-	      ;; avoid hooks on rename-buffer
-	      (uniquify-buffer-name-style nil))
-	  (set-buffer buffer)
-	  (rename-buffer newname)
-	  (set-buffer unset))))
-  (rplaca (nthcdr 3 item) t))
-
-(defun uniquify-reverse-components (instring)
-  (let ((sofar '())
-	(cursor 0)
-	(len (length instring))
-	(sep (or uniquify-separator "\\")))
-    (while (< cursor len)
-      (if (= (aref instring cursor) ?/)
-          (setq sofar (cons sep sofar)
-                cursor (1+ cursor))
-        (let ((first-slash (or (string-match "/" instring cursor) len)))
-          (setq sofar (cons (substring instring cursor first-slash) sofar)
-                cursor first-slash))))
-    (apply (function concat) sofar)))
-
-
-;;; Hooks from the rest of Emacs
-
-;; Emacs 19 (Emacs or XEmacs)
-
-;; The logical place to put all this code is in generate-new-buffer-name.
-;; It's written in C, so we would add a generate-new-buffer-name-function
-;; which, if non-nil, would be called instead of the C.  One problem with
-;; that is that generate-new-buffer-name takes a potential buffer name as
-;; its argument -- not other information, such as what file the buffer will
-;; visit.
-
-;; The below solution works because generate-new-buffer-name is called
-;; only by rename-buffer (which, as of 19.29, is never called from C) and
-;; generate-new-buffer, which is called only by Lisp functions
-;; create-file-buffer and rename-uniquely.  Rename-uniquely generally
-;; isn't used for buffers visiting files, so it's sufficient to hook
-;; rename-buffer and create-file-buffer.  (Setting find-file-hooks isn't
-;; sufficient.)
-
-(defadvice rename-buffer (after rename-buffer-uniquify activate)
-  "Uniquify buffer names with parts of directory name."
-  (if (and uniquify-buffer-name-style
-	   ;; UNIQUE argument
-	   (ad-get-arg 1))
-      (progn
-	(if uniquify-after-kill-buffer-p
-	    ;; call with no argument; rationalize vs. old name as well as new
-	    (uniquify-rationalize-file-buffer-names)
-	  ;; call with argument: rationalize vs. new name only
-	  (uniquify-rationalize-file-buffer-names
-	   (uniquify-buffer-file-name (current-buffer)) (current-buffer)))
-	(setq ad-return-value (buffer-name (current-buffer))))))
-
-(defadvice create-file-buffer (after create-file-buffer-uniquify activate)
-  "Uniquify buffer names with parts of directory name."
-  (if uniquify-buffer-name-style
-      (uniquify-rationalize-file-buffer-names (ad-get-arg 0) ad-return-value)))
-
-;; Buffer deletion
-;; Rerationalize after a buffer is killed, to reduce coinciding buffer names.
-;; This mechanism uses `kill-buffer-hook', which runs *before* deletion.
-;; That means that the kill-buffer-hook function cannot just delete the
-;; buffer -- it has to set something to do the rationalization *later*.
-;; It actually puts another function on `post-command-hook'.  This other
-;; function runs the rationalization and then removes itself from the hook.
-;; Is there a better way to accomplish this?
-;; (This ought to set some global variables so the work is done only for
-;; buffers with names similar to the deleted buffer.  -MDE)
-
-(defun delay-uniquify-rationalize-file-buffer-names ()
-  "Add `delayed-uniquify-rationalize-file-buffer-names' to `post-command-hook'.
-For use on, eg, `kill-buffer-hook', to rationalize *after* buffer deletion."
-  (if (and uniquify-buffer-name-style
-	   uniquify-after-kill-buffer-p)
-      (add-hook 'post-command-hook
-		'delayed-uniquify-rationalize-file-buffer-names)))
-
-(defun delayed-uniquify-rationalize-file-buffer-names ()
-  "Rerationalize buffer names and remove self from `post-command-hook'.
-See also `delay-rationalize-file-buffer-names' for hook setter."
-  (uniquify-rationalize-file-buffer-names)
-  (remove-hook 'post-command-hook
-	       'delayed-uniquify-rationalize-file-buffer-names))
-
-(add-hook 'kill-buffer-hook 'delay-uniquify-rationalize-file-buffer-names)
-
-;;; uniquify.el ends here
-
diff --git a/lisp/unused.el b/lisp/unused.el
deleted file mode 100644
index 1cb956b213f..00000000000
--- a/lisp/unused.el
+++ /dev/null
@@ -1,44 +0,0 @@
-;;; unused.el --- editing commands in GNU Emacs that turned out not to be used.
-;;; This file is in the public domain, as it was distributed in
-;;; 1985 or 1986 without a copyright notice.  Written by RMS.
-
-;; Maintainer: FSF
-;; Keywords: emulations
-
-;;; Commentary:
-
-;; These were added with an eye to making possible a more CCA-compatible
-;; command set; but that turned out not to be interesting.
-
-;;; Code:
-
-(defun mark-beginning-of-buffer ()
-  "Set mark at the beginning of the buffer."
-  (interactive)
-  (push-mark (point-min)))
-
-(defun mark-end-of-buffer ()
-  "Set mark at the end of the buffer."
-  (interactive)
-  (push-mark (point-max)))
-
-(defun upcase-char (arg)
-  "Uppercasify ARG chars starting from point.  Point doesn't move"
-  (interactive "p")
-  (save-excursion
-    (upcase-region (point) (progn (forward-char arg) (point)))))
-
-(defun forward-to-word (arg)
-  "Move forward until encountering the beginning of a word.
-With argument, do this that many times."
-  (interactive "p")
-  (or (re-search-forward (if (> arg 0) "\\W\\b" "\\b\\W") nil t arg)
-      (goto-char (if (> arg 0) (point-max) (point-min)))))
-
-(defun backward-to-word (arg)
-  "Move backward until encountering the end of a word.
-With argument, do this that many times."
-  (interactive "p")
-  (forward-to-word (- arg)))
-
-;;; unused.el ends here
diff --git a/lisp/userlock.el b/lisp/userlock.el
deleted file mode 100644
index 7844f4544bf..00000000000
--- a/lisp/userlock.el
+++ /dev/null
@@ -1,149 +0,0 @@
-;;; userlock.el --- handle file access contention between multiple users
-
-;; Copyright (C) 1985, 1986 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 is autoloaded to handle certain conditions
-;; detected by the file-locking code within Emacs.
-;; The two entry points are `ask-user-about-lock' and
-;; `ask-user-about-supersession-threat'.
-
-;;; Code:
-
-(put 'file-locked 'error-conditions '(file-locked file-error error))
-
-;;;###autoload
-(defun ask-user-about-lock (fn opponent)
-  "Ask user what to do when he wants to edit FILE but it is locked by USER.
-This function has a choice of three things to do:
-  do (signal 'buffer-file-locked (list FILE USER))
-    to refrain from editing the file
-  return t (grab the lock on the file)
-  return nil (edit the file even though it is locked).
-You can rewrite it to use any criterion you like to choose which one to do."
-  (discard-input)
-  (save-window-excursion
-    (let (answer)
-      (while (null answer)
-	(message "%s is locking %s: action (s, q, p, ?)? " opponent fn)
-	(let ((tem (let ((inhibit-quit t)
-			 (cursor-in-echo-area t))
-		     (prog1 (downcase (read-char))
-		            (setq quit-flag nil)))))
-	  (if (= tem help-char)
-	      (ask-user-about-lock-help)
-	    (setq answer (assoc tem '((?s . t)
-				      (?q . yield)
-				      (?\C-g . yield)
-				      (?p . nil)
-				      (?? . help))))
-	    (cond ((null answer)
-		   (beep)
-		   (message "Please type q, s, or p; or ? for help")
-		   (sit-for 3))
-		  ((eq (cdr answer) 'help)
-		   (ask-user-about-lock-help)
-		   (setq answer nil))
-		  ((eq (cdr answer) 'yield)
-		   (signal 'file-locked (list "File is locked" fn opponent)))))))
-      (cdr answer))))
-
-(defun ask-user-about-lock-help ()
-  (with-output-to-temp-buffer "*Help*"
-    (princ "It has been detected that you want to modify a file that someone else has
-already started modifying in EMACS.
-
-You can <s>teal the file; The other user becomes the
-  intruder if (s)he ever unmodifies the file and then changes it again.
-You can <p>roceed; you edit at your own (and the other user's) risk.
-You can <q>uit; don't modify this file.")
-    (save-excursion
-      (set-buffer standard-output)
-      (help-mode))))
-
-(put
- 'file-supersession 'error-conditions '(file-supersession file-error error))
-
-;;;###autoload
-(defun ask-user-about-supersession-threat (fn)
-  "Ask a user who is about to modify an obsolete buffer what to do.
-This function has two choices: it can return, in which case the modification
-of the buffer will proceed, or it can (signal 'file-supersession (file)),
-in which case the proposed buffer modification will not be made.
-
-You can rewrite this to use any criterion you like to choose which one to do.
-The buffer in question is current when this function is called."
-  (discard-input)
-  (save-window-excursion
-    (let (answer)
-      (while (null answer)
-	(message "%s changed on disk; really edit the buffer? (y, n, r or C-h) "
-		 (file-name-nondirectory fn))
-	(let ((tem (downcase (let ((cursor-in-echo-area t))
-			       (read-char)))))
-	  (setq answer
-		(if (= tem help-char)
-		    'help
-		  (cdr (assoc tem '((?n . yield)
-				    (?\C-g . yield)
-				    (?y . proceed)
-				    (?r . revert)
-				    (?? . help))))))
-	  (cond ((null answer)
-		 (beep)
-		 (message "Please type y, n or r; or ? for help")
-		 (sit-for 3))
-		((eq answer 'help)
-		 (ask-user-about-supersession-help)
-		 (setq answer nil))
-		((eq answer 'revert)
-		 (revert-buffer nil (not (buffer-modified-p)))
-					; ask confirmation iff buffer modified
-		 (signal 'file-supersession
-			 (list "File reverted" fn)))
-		((eq answer 'yield)
-		 (signal 'file-supersession
-			 (list "File changed on disk" fn))))))
-      (message
-        "File on disk now will become a backup file if you save these changes.")
-      (setq buffer-backed-up nil))))
-
-(defun ask-user-about-supersession-help ()
-  (with-output-to-temp-buffer "*Help*"
-    (princ "You want to modify a buffer whose disk file has changed
-since you last read it in or saved it with this buffer.
-
-If you say `y' to go ahead and modify this buffer,
-you risk ruining the work of whoever rewrote the file.
-If you say `r' to revert, the contents of the buffer are refreshed
-from the file on disk.
-If you say `n', the change you started to make will be aborted.
-
-Usually, you should type `n' and then `M-x revert-buffer',
-to get the latest version of the file, then make the change again.")
-    (save-excursion
-      (set-buffer standard-output)
-      (help-mode))))
-
-;;; userlock.el ends here
diff --git a/lisp/vc-hooks.el b/lisp/vc-hooks.el
deleted file mode 100644
index ffcb5930de7..00000000000
--- a/lisp/vc-hooks.el
+++ /dev/null
@@ -1,1075 +0,0 @@
-;;; vc-hooks.el --- resident support for version-control
-
-;; Copyright (C) 1992, 1993, 1994, 1995, 1996 Free Software Foundation, Inc.
-
-;; Author:     Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
-
-;; 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 is the always-loaded portion of VC.
-;; It takes care VC-related activities that are done when you visit a file,
-;; so that vc.el itself is loaded only when you use a VC command.
-;; See the commentary of vc.el.
-
-;;; Code:
-
-;; Customization Variables (the rest is in vc.el)
-
-(defvar vc-default-back-end nil
-  "*Back-end actually used by this interface; may be SCCS or RCS.
-The value is only computed when needed to avoid an expensive search.")
-
-(defvar vc-handle-cvs t
-  "*If non-nil, use VC for files managed with CVS.
-If it is nil, don't use VC for those files.")
-
-(defvar vc-rcsdiff-knows-brief nil
-  "*Indicates whether rcsdiff understands the --brief option.
-The value is either `yes', `no', or nil.  If it is nil, VC tries
-to use --brief and sets this variable to remember whether it worked.")
-
-(defvar vc-path
-  (if (file-directory-p "/usr/sccs")
-      '("/usr/sccs")
-    nil)
-  "*List of extra directories to search for version control commands.")
-
-(defvar vc-master-templates
-  '(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS)
-    ("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS)
-    vc-find-cvs-master)
-  "*Where to look for version-control master files.
-The first pair corresponding to a given back end is used as a template
-when creating new masters.")
-
-(defvar vc-make-backup-files nil
-  "*If non-nil, backups of registered files are made as with other files.
-If nil (the default), files covered by version control don't get backups.")
-
-(defvar vc-follow-symlinks 'ask
-  "*Indicates what to do if you visit a symbolic link to a file
-that is under version control.  Editing such a file through the
-link bypasses the version control system, which is dangerous and
-probably not what you want.  
-  If this variable is t, VC follows the link and visits the real file,
-telling you about it in the echo area.  If it is `ask', VC asks for
-confirmation whether it should follow the link.  If nil, the link is
-visited and a warning displayed.")
-
-(defvar vc-display-status t
-  "*If non-nil, display revision number and lock status in modeline.
-Otherwise, not displayed.")
-
-(defvar vc-consult-headers t
-  "*If non-nil, identify work files by searching for version headers.")
-
-(defvar vc-keep-workfiles t
-  "*If non-nil, don't delete working files after registering changes.
-If the back-end is CVS, workfiles are always kept, regardless of the
-value of this flag.")
-
-(defvar vc-mistrust-permissions nil
-  "*If non-nil, don't assume that permissions and ownership track 
-version-control status.  If nil, do rely on the permissions.
-See also variable `vc-consult-headers'.")
-
-(defun vc-mistrust-permissions (file)
-  ;; Access function to the above.
-  (or (eq vc-mistrust-permissions 't)
-      (and vc-mistrust-permissions
-	   (funcall vc-mistrust-permissions 
-		    (vc-backend-subdirectory-name file)))))
-
-;; Tell Emacs about this new kind of minor mode
-(if (not (assoc 'vc-mode minor-mode-alist))
-    (setq minor-mode-alist (cons '(vc-mode vc-mode)
-				 minor-mode-alist)))
-
-(make-variable-buffer-local 'vc-mode)
-(put 'vc-mode 'permanent-local t)
-
-;; We need a notion of per-file properties because the version
-;; control state of a file is expensive to derive --- we compute
-;; them when the file is initially found, keep them up to date 
-;; during any subsequent VC operations, and forget them when
-;; the buffer is killed.
-
-(defmacro vc-error-occurred (&rest body)
-  (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
-
-(defvar vc-file-prop-obarray [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
-  "Obarray for per-file properties.")
-
-(defvar vc-buffer-backend t)
-(make-variable-buffer-local 'vc-buffer-backend)
-
-(defun vc-file-setprop (file property value)
-  ;; set per-file property
-  (put (intern file vc-file-prop-obarray) property value))
-
-(defun vc-file-getprop (file property)
-  ;; get per-file property
-  (get (intern file vc-file-prop-obarray) property))
-
-(defun vc-file-clearprops (file)
-  ;; clear all properties of a given file
-  (setplist (intern file vc-file-prop-obarray) nil))
-
-;;; Functions that determine property values, by examining the 
-;;; working file, the master file, or log program output
-
-(defun vc-match-substring (bn)
-  (buffer-substring (match-beginning bn) (match-end bn)))
-
-(defun vc-lock-file (file)
-  ;; Generate lock file name corresponding to FILE
-  (let ((master (vc-name file)))
-    (and
-     master
-     (string-match "\\(.*/\\)s\\.\\(.*\\)" master)
-     (concat
-      (substring master (match-beginning 1) (match-end 1))
-      "p."
-      (substring master (match-beginning 2) (match-end 2))))))
-
-(defun vc-parse-buffer (patterns &optional file properties)
-  ;; Use PATTERNS to parse information out of the current buffer.
-  ;; Each element of PATTERNS is a list of 2 to 3 elements. The first element
-  ;; is the pattern to be matched, and the second (an integer) is the 
-  ;; number of the subexpression that should be returned. If there's
-  ;; a third element (also the number of a subexpression), that 
-  ;; subexpression is assumed to be a date field and we want the most
-  ;; recent entry matching the template.
-  ;; If FILE and PROPERTIES are given, the latter must be a list of
-  ;; properties of the same length as PATTERNS; each property is assigned 
-  ;; the corresponding value.
-  (mapcar (function (lambda (p)
-	    (goto-char (point-min))
-	    (cond 
-	     ((eq (length p) 2)  ;; search for first entry
-	      (let ((value nil))
-		(if (re-search-forward (car p) nil t)
-		    (setq value (vc-match-substring (elt p 1))))
-		(if file
-		    (progn (vc-file-setprop file (car properties) value)
-			   (setq properties (cdr properties))))
-		value))
-	     ((eq (length p) 3)  ;; search for latest entry
-	      (let ((latest-date "") (latest-val))
-		(while (re-search-forward (car p) nil t)
-		  (let ((date (vc-match-substring (elt p 2))))
-		    (if (string< latest-date date)
-			(progn
-			  (setq latest-date date)
-			  (setq latest-val
-				(vc-match-substring (elt p 1)))))))
-		(if file
-		    (progn (vc-file-setprop file (car properties) latest-val)
-			   (setq properties (cdr properties))))
-		latest-val)))))
-	  patterns)
-  )
-
-(defun vc-insert-file (file &optional limit blocksize)
-  ;; Insert the contents of FILE into the current buffer.
-  ;; Optional argument LIMIT is a regexp. If present,
-  ;; the file is inserted in chunks of size BLOCKSIZE
-  ;; (default 8 kByte), until the first occurrence of
-  ;; LIMIT is found. The function returns nil if FILE 
-  ;; doesn't exist.
-  (erase-buffer)
-  (cond ((file-exists-p file)
-	 (cond (limit
-		(if (not blocksize) (setq blocksize 8192))
-		(let (found s)
-		  (while (not found)
-		    (setq s (buffer-size))
-		    (goto-char (1+ s))
-		    (setq found 
-			  (or (zerop (car (cdr 
-			      (insert-file-contents file nil s 
-			       (+ s blocksize)))))
-			      (progn (beginning-of-line)
-				     (re-search-forward limit nil t)))))))
-	       (t (insert-file-contents file)))
-	 (set-buffer-modified-p nil)
-	 (auto-save-mode nil)
-	 t)
-	(t nil)))
-
-(defun vc-parse-locks (file locks)
-  ;; Parse RCS or SCCS locks.
-  ;; The result is a list of the form ((VERSION USER) (VERSION USER) ...),
-  ;; which is returned and stored into the property `vc-master-locks'.
-  (if (not locks) 
-      (vc-file-setprop file 'vc-master-locks 'none)
-    (let ((found t) (index 0) master-locks version user)
-      (cond ((eq (vc-backend file) 'SCCS)
-	     (while (string-match "^\\([0-9.]+\\) [0-9.]+ \\([^ ]+\\) .*\n?"
-				   locks index)
-	       (setq version (substring locks 
-					(match-beginning 1) (match-end 1)))
-	       (setq user (substring locks 
-				     (match-beginning 2) (match-end 2)))
-	       (setq master-locks (append master-locks 
-					  (list (cons version user))))
-	       (setq index (match-end 0))))
-	    ((eq (vc-backend file) 'RCS)
-	     (while (string-match "[ \t\n]*\\([^:]+\\):\\([0-9.]+\\)"
-				  locks index)
-	       (setq version (substring locks 
-					(match-beginning 2) (match-end 2)))
-	       (setq user (substring locks 
-				     (match-beginning 1) (match-end 1)))
-	       (setq master-locks (append master-locks 
-					  (list (cons version user))))
-	       (setq index (match-end 0)))
-	     (if (string-match ";[ \t\n]+strict;" locks index)
-		 (vc-file-setprop file 'vc-checkout-model 'manual)
-	       (vc-file-setprop file 'vc-checkout-model 'implicit))))
-      (vc-file-setprop file 'vc-master-locks (or master-locks 'none)))))
-
-(defun vc-simple-command (okstatus command file &rest args)
-  ;; Simple version of vc-do-command, for use in vc-hooks only.
-  ;; Don't switch to the *vc-info* buffer before running the
-  ;; command, because that would change its default directory
-  (save-excursion (set-buffer (get-buffer-create "*vc-info*"))
-		  (erase-buffer))
-  (let ((exec-path (append vc-path exec-path)) exec-status
-	;; Add vc-path to PATH for the execution of this command.
-	(process-environment
-	 (cons (concat "PATH=" (getenv "PATH")
-		       path-separator 
-		       (mapconcat 'identity vc-path path-separator))
-	       process-environment)))
-    (setq exec-status 
-	  (apply 'call-process command nil "*vc-info*" nil 
-		 (append args (list file))))
-    (cond ((> exec-status okstatus)
-	   (switch-to-buffer (get-file-buffer file))
-	   (shrink-window-if-larger-than-buffer
-	    (display-buffer "*vc-info*"))
-	   (error "Couldn't find version control information")))
-    exec-status))
-
-(defun vc-fetch-master-properties (file)
-  ;; Fetch those properties of FILE that are stored in the master file.
-  ;; For an RCS file, we don't get vc-latest-version vc-your-latest-version
-  ;; here because that is slow.
-  ;; That gets done if/when the functions vc-latest-version
-  ;; and vc-your-latest-version get called.
-  (save-excursion
-    (cond
-     ((eq (vc-backend file) 'SCCS)
-      (set-buffer (get-buffer-create "*vc-info*"))
-      (if (vc-insert-file (vc-lock-file file))
-	  (vc-parse-locks file (buffer-string))
-	(vc-file-setprop file 'vc-master-locks 'none))
-      (vc-insert-file (vc-name file) "^\001e")
-      (vc-parse-buffer 
-       (list '("^\001d D \\([^ ]+\\)" 1)
-	     (list (concat "^\001d D \\([^ ]+\\) .* " 
-			   (regexp-quote (vc-user-login-name)) " ") 1))
-       file
-       '(vc-latest-version vc-your-latest-version)))
-
-     ((eq (vc-backend file) 'RCS)
-      (set-buffer (get-buffer-create "*vc-info*"))
-      (vc-insert-file (vc-name file) "^[0-9]")
-      (vc-parse-buffer 
-       (list '("^head[ \t\n]+\\([^;]+\\);" 1)
-	     '("^branch[ \t\n]+\\([^;]+\\);" 1)
-	     '("^locks[ \t\n]*\\([^;]*;\\([ \t\n]*strict;\\)?\\)" 1))
-       file
-       '(vc-head-version
-	 vc-default-branch
-	 vc-master-locks))
-      ;; determine vc-master-workfile-version: it is either the head
-      ;; of the trunk, the head of the default branch, or the 
-      ;; "default branch" itself, if that is a full revision number.
-      (let ((default-branch (vc-file-getprop file 'vc-default-branch)))
-	(cond 
-	 ;; no default branch
-	 ((or (not default-branch) (string= "" default-branch))
-	  (vc-file-setprop file 'vc-master-workfile-version 
-			   (vc-file-getprop file 'vc-head-version)))
-	 ;; default branch is actually a revision
-	 ((string-match "^[0-9]+\\.[0-9]+\\(\\.[0-9]+\\.[0-9]+\\)*$" 
-			default-branch)
-	  (vc-file-setprop file 'vc-master-workfile-version default-branch))
-	 ;; else, search for the head of the default branch
-	 (t (vc-insert-file (vc-name file) "^desc")
-	    (vc-parse-buffer (list (list 
-	       (concat "^\\(" 
-		       (regexp-quote default-branch)
-		       "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2))
-			 file '(vc-master-workfile-version)))))
-      ;; translate the locks
-      (vc-parse-locks file (vc-file-getprop file 'vc-master-locks)))
-
-     ((eq (vc-backend file) 'CVS)
-      (save-excursion
-        ;; Call "cvs status" in the right directory, passing only the
-        ;; nondirectory part of the file name -- otherwise CVS might 
-        ;; silently give a wrong result.
-        (let ((default-directory (file-name-directory file)))
-          (vc-simple-command 0 "cvs" (file-name-nondirectory file) "status"))
-	(set-buffer (get-buffer "*vc-info*"))
-	(vc-parse-buffer     
-	 ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:",
-	 ;; and CVS 1.4a1 says "Repository revision:".
-	 '(("\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)" 2)
-	   ("^File: [^ \t]+[ \t]+Status: \\(.*\\)" 1))
-	 file
-	 '(vc-latest-version vc-cvs-status))
-	;; Translate those status values that we understand into symbols.
-	;; Any other value is converted to nil.
-	(let ((status (vc-file-getprop file 'vc-cvs-status)))
-	 (cond 
-	  ((string-match "Up-to-date" status)
-	   (vc-file-setprop file 'vc-cvs-status 'up-to-date)
-	   (vc-file-setprop file 'vc-checkout-time 
-			    (nth 5 (file-attributes file))))
-	  ((vc-file-setprop file 'vc-cvs-status
-	    (cond 
-	     ((string-match "Locally Modified"    status) 'locally-modified)
-	     ((string-match "Needs Merge"         status) 'needs-merge)
-	     ((string-match "Needs \\(Checkout\\|Patch\\)" status) 
-                                                          'needs-checkout)
-	     ((string-match "Unresolved Conflict" status) 'unresolved-conflict)
-	     ((string-match "Locally Added"       status) 'locally-added)
-	     (t 'unknown)
-	     ))))))))
-    (if (get-buffer "*vc-info*")
-	(kill-buffer (get-buffer "*vc-info*")))))
-
-;;; Functions that determine property values, by examining the 
-;;; working file, the master file, or log program output
-
-(defun vc-consult-rcs-headers (file)
-  ;; Search for RCS headers in FILE, and set properties
-  ;; accordingly.  This function can be disabled by setting
-  ;; vc-consult-headers to nil.  
-  ;; Returns: nil            if no headers were found 
-  ;;                         (or if the feature is disabled,
-  ;;                         or if there is currently no buffer 
-  ;;                         visiting FILE)
-  ;;          'rev           if a workfile revision was found
-  ;;          'rev-and-lock  if revision and lock info was found 
-  (cond
-   ((or (not vc-consult-headers) 
-	(not (get-file-buffer file))) nil)
-   ((let (status version locking-user)
-     (save-excursion
-      (set-buffer (get-file-buffer file))
-      (goto-char (point-min))
-      (cond  
-       ;; search for $Id or $Header
-       ;; -------------------------
-       ((or (and (search-forward "$Id: " nil t)
-		 (looking-at "[^ ]+ \\([0-9.]+\\) "))
-	    (and (progn (goto-char (point-min))
-			(search-forward "$Header: " nil t))
-		 (looking-at "[^ ]+ \\([0-9.]+\\) ")))
-	(goto-char (match-end 0))
-	;; if found, store the revision number ...
-	(setq version (buffer-substring-no-properties (match-beginning 1)
-						      (match-end 1)))
-	;; ... and check for the locking state
-	(cond 
-	 ((looking-at
-	   (concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] "             ; date
-	    "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time
-	           "[^ ]+ [^ ]+ "))                       ; author & state
-	  (goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds
-	  (cond 
-	   ;; unlocked revision
-	   ((looking-at "\\$")
-	    (setq locking-user 'none)
-	    (setq status 'rev-and-lock))
-	   ;; revision is locked by some user
-	   ((looking-at "\\([^ ]+\\) \\$")
-	    (setq locking-user
-		  (buffer-substring-no-properties (match-beginning 1)
-						  (match-end 1)))
-	    (setq status 'rev-and-lock))
-	   ;; everything else: false
-	   (nil)))
-	 ;; unexpected information in
-	 ;; keyword string --> quit
-	 (nil)))
-       ;; search for $Revision
-       ;; --------------------
-       ((re-search-forward (concat "\\$" 
-				   "Revision: \\([0-9.]+\\) \\$")
-			   nil t)
-	;; if found, store the revision number ...
-	(setq version (buffer-substring-no-properties (match-beginning 1)
-						      (match-end 1)))
-	;; and see if there's any lock information
-	(goto-char (point-min))
-	(if (re-search-forward (concat "\\$" "Locker:") nil t)
-	    (cond ((looking-at " \\([^ ]+\\) \\$")
-		   (setq locking-user (buffer-substring-no-properties
-				       (match-beginning 1)
-				       (match-end 1)))
-		   (setq status 'rev-and-lock))
-		  ((looking-at " *\\$") 
-		   (setq locking-user 'none)
-		   (setq status 'rev-and-lock))
-		  (t 
-		   (setq locking-user 'none)
-		   (setq status 'rev-and-lock)))
-	  (setq status 'rev)))
-       ;; else: nothing found
-       ;; -------------------
-       (t nil)))
-     (if status (vc-file-setprop file 'vc-workfile-version version))
-     (and (eq status 'rev-and-lock)
-	  (eq (vc-backend file) 'RCS)
-	  (vc-file-setprop file 'vc-locking-user locking-user)
-	  ;; If the file has headers, we don't want to query the master file,
-	  ;; because that would eliminate all the performance gain the headers
-	  ;; brought us.  We therefore use a heuristic for the checkout model 
-	  ;; now:  If we trust the file permissions, and the file is not 
-          ;; locked, then if the file is read-only the checkout model is 
-	  ;; `manual', otherwise `implicit'.
-	  (not (vc-mistrust-permissions file))
-	  (not (vc-locking-user file))
-	  (if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
-	      (vc-file-setprop file 'vc-checkout-model 'manual)
-	    (vc-file-setprop file 'vc-checkout-model 'implicit)))
-     status))))
-
-;;; Access functions to file properties
-;;; (Properties should be _set_ using vc-file-setprop, but
-;;; _retrieved_ only through these functions, which decide
-;;; if the property is already known or not. A property should
-;;; only be retrieved by vc-file-getprop if there is no 
-;;; access function.)
-
-;;; properties indicating the backend 
-;;; being used for FILE
-
-(defun vc-backend-subdirectory-name (&optional file)
-  ;; Where the master and lock files for the current directory are kept
-  (symbol-name
-   (or
-    (and file (vc-backend file))
-    vc-default-back-end
-    (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))))
-
-(defun vc-name (file)
-  "Return the master name of a file, nil if it is not registered.
-For CVS, the full name of CVS/Entries is returned."
-  (or (vc-file-getprop file 'vc-name)
-      (let ((name-and-type (vc-registered file)))
-	(if name-and-type
-	    (progn
-	      (vc-file-setprop file 'vc-backend (cdr name-and-type))
-	      (vc-file-setprop file 'vc-name (car name-and-type)))))))
-
-(defun vc-backend (file)
-  "Return the version-control type of a file, nil if it is not registered."
-  (and file
-       (or (vc-file-getprop file 'vc-backend)
-	   (let ((name-and-type (vc-registered file)))
-	     (if name-and-type
-		 (progn
-		   (vc-file-setprop file 'vc-name (car name-and-type))
-		   (vc-file-setprop file 'vc-backend (cdr name-and-type))))))))
-
-(defun vc-checkout-model (file)
-  ;; Return `manual' if the user has to type C-x C-q to check out FILE.
-  ;; Return `implicit' if the file can be modified without locking it first.
-  (or
-   (vc-file-getprop file 'vc-checkout-model)
-   (cond 
-    ((eq (vc-backend file) 'SCCS)
-     (vc-file-setprop file 'vc-checkout-model 'manual))
-    ((eq (vc-backend file) 'RCS) 
-     (vc-consult-rcs-headers file)
-     (or (vc-file-getprop file 'vc-checkout-model)
-	 (progn (vc-fetch-master-properties file)
-		(vc-file-getprop file 'vc-checkout-model))))
-    ((eq (vc-backend file) 'CVS)
-     (vc-file-setprop file 'vc-checkout-model
-		      (if (getenv "CVSREAD") 'manual 'implicit))))))
-
-;;; properties indicating the locking state
-
-(defun vc-cvs-status (file)
-  ;; Return the cvs status of FILE
-  ;; (Status field in output of "cvs status")
-  (cond ((vc-file-getprop file 'vc-cvs-status))
-	(t (vc-fetch-master-properties file)
-	   (vc-file-getprop file 'vc-cvs-status))))
-
-(defun vc-master-locks (file)
-  ;; Return the lock entries in the master of FILE.
-  ;; Return 'none if there are no such entries, and a list
-  ;; of the form ((VERSION USER) (VERSION USER) ...) otherwise.
-  (cond ((vc-file-getprop file 'vc-master-locks))
-	(t (vc-fetch-master-properties file)
-	   (vc-file-getprop file 'vc-master-locks))))
-
-(defun vc-master-locking-user (file)
-  ;; Return the master file's idea of who is locking 
-  ;; the current workfile version of FILE.  
-  ;; Return 'none if it is not locked.
-  (let ((master-locks (vc-master-locks file)) lock)
-    (if (eq master-locks 'none) 'none
-      ;; search for a lock on the current workfile version
-      (setq lock (assoc (vc-workfile-version file) master-locks))
-      (cond (lock (cdr lock))
-	    ('none)))))
-
-(defun vc-lock-from-permissions (file)
-  ;; If the permissions can be trusted for this file, determine the
-  ;; locking state from them.  Returns (user-login-name), `none', or nil.
-   ;;   This implementation assumes that any file which is under version
-  ;; control and has -rw-r--r-- is locked by its owner.  This is true
-  ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--.
-  ;; We have to be careful not to exclude files with execute bits on;
-  ;; scripts can be under version control too.  Also, we must ignore the
-  ;; group-read and other-read bits, since paranoid users turn them off.
-  ;;   This hack wins because calls to the somewhat expensive 
-  ;; `vc-fetch-master-properties' function only have to be made if 
-  ;; (a) the file is locked by someone other than the current user, 
-  ;; or (b) some untoward manipulation behind vc's back has changed 
-  ;; the owner or the `group' or `other' write bits.
-  (let ((attributes (file-attributes file)))
-    (if (not (vc-mistrust-permissions file))
-	(cond ((string-match ".r-..-..-." (nth 8 attributes))
-	       (vc-file-setprop file 'vc-locking-user 'none))
-	      ((and (= (nth 2 attributes) (user-uid))
-		    (string-match ".rw..-..-." (nth 8 attributes)))
-	       (vc-file-setprop file 'vc-locking-user (vc-user-login-name)))
-	      (nil)))))
-
-(defun vc-user-login-name (&optional uid)
-  ;; Return the name under which the user is logged in, as a string.
-  ;; (With optional argument UID, return the name of that user.)
-  ;; This function does the same as `user-login-name', but unlike
-  ;; that, it never returns nil.  If a UID cannot be resolved, that
-  ;; UID is returned as a string.
-  (or (user-login-name uid)
-      (and uid (number-to-string uid))
-      (number-to-string (user-uid))))
-
-(defun vc-file-owner (file)
-  ;; Return who owns FILE (user name, as a string).
-  (vc-user-login-name (nth 2 (file-attributes file))))
-
-(defun vc-rcs-lock-from-diff (file)
-  ;; Diff the file against the master version.  If differences are found,
-  ;; mark the file locked.  This is only used for RCS with non-strict
-  ;; locking.  (If "rcsdiff" doesn't understand --brief, we do a double-take
-  ;; and remember the fact for the future.)
-  (let* ((version (concat "-r" (vc-workfile-version file)))
-         (status (if (eq vc-rcsdiff-knows-brief 'no)
-                     (vc-simple-command 1 "rcsdiff" file version)
-                   (vc-simple-command 2 "rcsdiff" file "--brief" version))))
-    (if (eq status 2)
-        (if (not vc-rcsdiff-knows-brief)
-            (setq vc-rcsdiff-knows-brief 'no
-                  status (vc-simple-command 1 "rcsdiff" file version))
-          (error "rcsdiff failed."))
-      (if (not vc-rcsdiff-knows-brief) (setq vc-rcsdiff-knows-brief 'yes)))
-    (if (zerop status)
-        (vc-file-setprop file 'vc-locking-user 'none)
-      (vc-file-setprop file 'vc-locking-user (vc-file-owner file)))))
-
-(defun vc-locking-user (file)
-  ;; Return the name of the person currently holding a lock on FILE.
-  ;; Return nil if there is no such person.
-  ;;   Under CVS, a file is considered locked if it has been modified since
-  ;; it was checked out.
-  ;;   The property is cached.  It is only looked up if it is currently nil.
-  ;; Note that, for a file that is not locked, the actual property value
-  ;; is `none', to distinguish it from an unknown locking state.  That value
-  ;; is converted to nil by this function, and returned to the caller.
-  (let ((locking-user (vc-file-getprop file 'vc-locking-user)))
-    (if locking-user
-	;; if we already know the property, return it
-	(if (eq locking-user 'none) nil locking-user)
-
-      ;; otherwise, infer the property...
-      (cond
-       ((eq (vc-backend file) 'CVS)
-	(or (and (eq (vc-checkout-model file) 'manual)
-		 (vc-lock-from-permissions file))
-	    (and (equal (vc-file-getprop file 'vc-checkout-time)
-			(nth 5 (file-attributes file)))
-		 (vc-file-setprop file 'vc-locking-user 'none))
-	    (vc-file-setprop file 'vc-locking-user (vc-file-owner file))))
-
-       ((eq (vc-backend file) 'RCS)
-	(let (p-lock)
-
-	  ;; Check for RCS headers first
-	  (or (eq (vc-consult-rcs-headers file) 'rev-and-lock)
-
-	      ;; If there are no headers, try to learn it 
-	      ;; from the permissions.
-	      (and (setq p-lock (vc-lock-from-permissions file))
-		   (if (eq p-lock 'none)
-
-		       ;; If the permissions say "not locked", we know
-		       ;; that the checkout model must be `manual'.
-		       (vc-file-setprop file 'vc-checkout-model 'manual)
-
-		     ;; If the permissions say "locked", we can only trust
-		     ;; this *if* the checkout model is `manual'.
-		     (eq (vc-checkout-model file) 'manual)))
-
-	      ;; Otherwise, use lock information from the master file.
-	      (vc-file-setprop file 'vc-locking-user
-			       (vc-master-locking-user file)))
-
-	  ;; Finally, if the file is not explicitly locked
-	  ;; it might still be locked implicitly.
-	  (and (eq (vc-file-getprop file 'vc-locking-user) 'none)
-	       (eq (vc-checkout-model file) 'implicit)
-	       (vc-rcs-lock-from-diff file))))
-
-      ((eq (vc-backend file) 'SCCS)
-       (or (vc-lock-from-permissions file)
-	   (vc-file-setprop file 'vc-locking-user 
-			    (vc-master-locking-user file)))))
-  
-      ;; convert a possible 'none value
-      (setq locking-user (vc-file-getprop file 'vc-locking-user))
-      (if (eq locking-user 'none) nil locking-user))))
-
-;;; properties to store current and recent version numbers
-
-(defun vc-latest-version (file)
-  ;; Return version level of the latest version of FILE
-  (cond ((vc-file-getprop file 'vc-latest-version))
-	(t (vc-fetch-properties file)
-	   (vc-file-getprop file 'vc-latest-version))))
-
-(defun vc-your-latest-version (file)
-  ;; Return version level of the latest version of FILE checked in by you
-  (cond ((vc-file-getprop file 'vc-your-latest-version))
-	(t (vc-fetch-properties file)
-	   (vc-file-getprop file 'vc-your-latest-version))))
-
-(defun vc-master-workfile-version (file)
-  ;; Return the master file's idea of what is the current workfile version.
-  ;; This property is defined for RCS only.
-  (cond ((vc-file-getprop file 'vc-master-workfile-version))
-	(t (vc-fetch-master-properties file)
-	   (vc-file-getprop file 'vc-master-workfile-version))))
-
-(defun vc-fetch-properties (file)
-  ;; Fetch vc-latest-version and vc-your-latest-version
-  ;; if that wasn't already done.
-  (cond
-   ((eq (vc-backend file) 'RCS)
-    (save-excursion
-      (set-buffer (get-buffer-create "*vc-info*"))
-      (vc-insert-file (vc-name file) "^desc")
-      (vc-parse-buffer 
-       (list '("^\\([0-9]+\\.[0-9.]+\\)\ndate[ \t]+\\([0-9.]+\\);" 1 2)
-	     (list (concat "^\\([0-9]+\\.[0-9.]+\\)\n"
-			   "date[ \t]+\\([0-9.]+\\);[ \t]+"
-			   "author[ \t]+"
-			   (regexp-quote (vc-user-login-name)) ";") 1 2))
-       file
-       '(vc-latest-version vc-your-latest-version))
-      (if (get-buffer "*vc-info*")
-	  (kill-buffer (get-buffer "*vc-info*")))))
-   (t (vc-fetch-master-properties file))
-   ))
-
-(defun vc-workfile-version (file)
-  ;; Return version level of the current workfile FILE
-  ;; This is attempted by first looking at the RCS keywords.
-  ;; If there are no keywords in the working file, 
-  ;; vc-master-workfile-version is taken.
-  ;; Note that this property is cached, that is, it is only 
-  ;; looked up if it is nil.
-  ;; For SCCS, this property is equivalent to vc-latest-version.
-  (cond ((vc-file-getprop file 'vc-workfile-version))
-	((eq (vc-backend file) 'SCCS) (vc-latest-version file))
-	((eq (vc-backend file) 'RCS)
-	 (if (vc-consult-rcs-headers file)
-	     (vc-file-getprop file 'vc-workfile-version)
-	   (let ((rev (cond ((vc-master-workfile-version file))
-			    ((vc-latest-version file)))))
-	     (vc-file-setprop file 'vc-workfile-version rev)
-	     rev)))
-	((eq (vc-backend file) 'CVS)
-	 (if (vc-consult-rcs-headers file)   ;; CVS
-	     (vc-file-getprop file 'vc-workfile-version)
-	   (catch 'found
-	     (vc-find-cvs-master (file-name-directory file)
-				 (file-name-nondirectory file)))
-	   (vc-file-getprop file 'vc-workfile-version)))))
-
-;;; actual version-control code starts here
-
-(defun vc-registered (file)
-  (let (handler handlers)
-    (if (boundp 'file-name-handler-alist)
-	(setq handler (find-file-name-handler file 'vc-registered)))
-    (if handler
-	(funcall handler 'vc-registered file)
-      ;; Search for a master corresponding to the given file
-      (let ((dirname (or (file-name-directory file) ""))
-	    (basename (file-name-nondirectory file)))
-	(catch 'found
-	  (mapcar
-	   (function (lambda (s)
-	      (if (atom s)
-		  (funcall s dirname basename)
-		(let ((trial (format (car s) dirname basename)))
-		  (if (and (file-exists-p trial)
-			   ;; Make sure the file we found with name
-			   ;; TRIAL is not the source file itself.
-			   ;; That can happen with RCS-style names
-			   ;; if the file name is truncated
-			   ;; (e.g. to 14 chars).  See if either
-			   ;; directory or attributes differ.
-			   (or (not (string= dirname
-					     (file-name-directory trial)))
-			       (not (equal
-				     (file-attributes file)
-				     (file-attributes trial)))))
-		      (throw 'found (cons trial (cdr s))))))))
-	   vc-master-templates)
-	  nil)))))
-
-(defun vc-find-cvs-master (dirname basename)
-  ;; Check if DIRNAME/BASENAME is handled by CVS.
-  ;; If it is, do a (throw 'found (cons MASTER 'CVS)).
-  ;; Note: This function throws the name of CVS/Entries
-  ;; NOT that of the RCS master file (because we wouldn't be able
-  ;; to access it under remote CVS).
-  ;; The function returns nil if DIRNAME/BASENAME is not handled by CVS.
-  (if (and vc-handle-cvs
-	   (file-directory-p (concat dirname "CVS/"))
-	   (file-readable-p (concat dirname "CVS/Entries")))
-      (let (buffer time (fold case-fold-search)
-	    (file (concat dirname basename)))
-	(unwind-protect
-	    (save-excursion
-	      (setq buffer (set-buffer (get-buffer-create "*vc-info*")))
-	      (vc-insert-file (concat dirname "CVS/Entries"))
-	      (goto-char (point-min))
-	      ;; make sure the file name is searched 
-	      ;; case-sensitively
-	      (setq case-fold-search nil)
-	      (cond
-	       ;; normal entry
-	       ((re-search-forward
-		 (concat "^/" (regexp-quote basename) 
-			 "/\\([^/]*\\)/[^ /]* \\([A-Z][a-z][a-z]\\) *\\([0-9]*\\) \\([0-9]*\\):\\([0-9]*\\):\\([0-9]*\\) \\([0-9]*\\)")
-		 nil t)
-		(setq case-fold-search fold)  ;; restore the old value
-		;; We found it.  Store away version number now that we 
-		;; are anyhow so close to finding it.
-		(vc-file-setprop file
-				 'vc-workfile-version
-				 (match-string 1))
-		;; If the file hasn't been modified since checkout,
-		;; store the checkout-time.
-		(let ((mtime (nth 5 (file-attributes file)))
-		      (second (string-to-number (match-string 6)))
-		      (minute (string-to-number (match-string 5)))
-		      (hour (string-to-number (match-string 4)))
-		      (day (string-to-number (match-string 3)))
-		      (year (string-to-number (match-string 7))))
-		  (if (equal mtime
-			     (encode-time
-			      second minute hour day
-			      (/ (string-match
-				  (match-string 2)
-				  "xxxJanFebMarAprMayJunJulAugSepOctNovDec")
-				 3)
-			      year 0))
-		      (vc-file-setprop file 'vc-checkout-time mtime)
-		    (vc-file-setprop file 'vc-checkout-time 0)))
-		(throw 'found (cons (concat dirname "CVS/Entries") 'CVS)))
-	       ;; entry for a "locally added" file (not yet committed)
-	       ((re-search-forward
-		 (concat "^/" (regexp-quote basename) "/0/Initial ") nil t)
-		(setq case-fold-search fold) ;; restore the old value
-		(vc-file-setprop file 'vc-checkout-time 0)
-		(vc-file-setprop file 'vc-workfile-version "0")
-		(throw 'found (cons (concat dirname "CVS/Entries") 'CVS)))
-	       (t (setq case-fold-search fold)  ;; restore the old value
-		  nil)))
-	  (kill-buffer buffer)))))
-
-(defun vc-buffer-backend ()
-  "Return the version-control type of the visited file, or nil if none."
-  (if (eq vc-buffer-backend t)
-      (setq vc-buffer-backend (vc-backend (buffer-file-name)))
-    vc-buffer-backend))
-
-(defun vc-toggle-read-only (&optional verbose)
-  "Change read-only status of current buffer, perhaps via version control.
-If the buffer is visiting a file registered with version control,
-then check the file in or out.  Otherwise, just change the read-only flag
-of the buffer.  With prefix argument, ask for version number."
-  (interactive "P")
-  (if (vc-backend (buffer-file-name))
-      (vc-next-action verbose)
-    (toggle-read-only)))
-(define-key global-map "\C-x\C-q" 'vc-toggle-read-only)
-
-(defun vc-after-save ()
-  ;; Function to be called by basic-save-buffer (in files.el).
-  ;; If the file in the current buffer is under version control,
-  ;; not locked, and the checkout model for it is `implicit',
-  ;; mark it "locked" and redisplay the mode line.
-  (let ((file (buffer-file-name)))
-    (and (vc-file-getprop file 'vc-backend)
-	 ;; ...check the property directly, not through the function of the
-	 ;; same name.  Otherwise Emacs would check for a master file
-	 ;; each time a non-version-controlled buffer is saved.
-	 ;; The property is computed when the file is visited, so if it
-	 ;; is `nil' now, it is certain that the file is NOT 
-	 ;; version-controlled.
-	 (or (and (equal (vc-file-getprop file 'vc-checkout-time)
-			 (nth 5 (file-attributes file)))
-		  ;; File has been saved in the same second in which
-		  ;; it was checked out.  Clear the checkout-time
-		  ;; to avoid confusion.
-		  (vc-file-setprop file 'vc-checkout-time nil))
-	     t)
-	 (not (vc-locking-user file))
-	 (eq (vc-checkout-model file) 'implicit)
-	 (vc-file-setprop file 'vc-locking-user (vc-user-login-name))
-	 (or (and (eq (vc-backend file) 'CVS) 
-		  (vc-file-setprop file 'vc-cvs-status nil))
-	     t)
-	 (vc-mode-line file))))
-
-(defun vc-mode-line (file &optional label)
-  "Set `vc-mode' to display type of version control for FILE.
-The value is set in the current buffer, which should be the buffer
-visiting FILE.  Second optional arg LABEL is put in place of version
-control system name."
-  (interactive (list buffer-file-name nil))
-  (let ((vc-type (vc-backend file)))
-    (setq vc-mode
-	  (and vc-type
-	       (concat " " (or label (symbol-name vc-type)) 
-		       (and vc-display-status (vc-status file)))))
-    ;; If the file is locked by some other user, make
-    ;; the buffer read-only.  Like this, even root
-    ;; cannot modify a file that someone else has locked.
-    (and vc-type 
-	 (equal file (buffer-file-name))
-	 (vc-locking-user file)
-	 (not (string= (vc-user-login-name) (vc-locking-user file)))
-	 (setq buffer-read-only t))
-    ;; If the user is root, and the file is not owner-writable,
-    ;; then pretend that we can't write it
-    ;; even though we can (because root can write anything).
-    ;; This way, even root cannot modify a file that isn't locked.
-    (and vc-type
-	 (equal file (buffer-file-name))
-	 (not buffer-read-only)
-	 (zerop (user-real-uid))
-	 (zerop (logand (file-modes (buffer-file-name)) 128))
-	 (setq buffer-read-only t))
-    (force-mode-line-update)
-    ;;(set-buffer-modified-p (buffer-modified-p)) ;;use this if Emacs 18
-    vc-type))
-
-(defun vc-status (file)
-  ;; Return string for placement in modeline by `vc-mode-line'.
-  ;; Format:
-  ;;
-  ;;   "-REV"        if the revision is not locked
-  ;;   ":REV"        if the revision is locked by the user
-  ;;   ":LOCKER:REV" if the revision is locked by somebody else
-  ;;   " @@"         for a CVS file that is added, but not yet committed
-  ;;
-  ;; In the CVS case, a "locked" working file is a 
-  ;; working file that is modified with respect to the master.
-  ;; The file is "locked" from the moment when the user saves
-  ;; the modified buffer.
-  ;; 
-  ;; This function assumes that the file is registered.
-
-  (let ((locker (vc-locking-user file))
-	(rev (vc-workfile-version file)))
-    (cond ((string= "0" rev)
-	   " @@")
-	  ((not locker)
-	   (concat "-" rev))
-	  ((string= locker (vc-user-login-name))
-	   (concat ":" rev))
-	  (t 
-	   (concat ":" locker ":" rev)))))
-
-(defun vc-follow-link ()
-  ;; If the current buffer visits a symbolic link, this function makes it
-  ;; visit the real file instead.  If the real file is already visited in 
-  ;; another buffer, make that buffer current, and kill the buffer 
-  ;; that visits the link.
-  (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name)))
-         (true-buffer (find-buffer-visiting truename))
-	 (this-buffer (current-buffer)))
-    (if (eq true-buffer this-buffer)
-	(progn
-	  (kill-buffer this-buffer)
-	  ;; In principle, we could do something like set-visited-file-name.
-	  ;; However, it can't be exactly the same as set-visited-file-name.
-	  ;; I'm not going to work out the details right now. -- rms.
-	  (set-buffer (find-file-noselect truename)))
-      (set-buffer true-buffer)
-      (kill-buffer this-buffer))))
-
-;;; install a call to the above as a find-file hook
-(defun vc-find-file-hook ()
-  ;; Recompute whether file is version controlled,
-  ;; if user has killed the buffer and revisited.
-  (cond 
-   (buffer-file-name
-    (vc-file-clearprops buffer-file-name)
-    (cond
-     ((vc-backend buffer-file-name)
-      (vc-mode-line buffer-file-name)
-      (cond ((not vc-make-backup-files)
-	     ;; Use this variable, not make-backup-files,
-	     ;; because this is for things that depend on the file name.
-	     (make-local-variable 'backup-inhibited)
-	     (setq backup-inhibited t))))
-     ((let* ((link (file-symlink-p buffer-file-name))
-	     (link-type (and link (vc-backend (file-chase-links link)))))
-	(if link-type
-            (cond ((eq vc-follow-symlinks nil)
-                   (message
-        "Warning: symbolic link to %s-controlled source file" link-type))
-                  ((or (not (eq vc-follow-symlinks 'ask))
-		       ;; If we already visited this file by following
-		       ;; the link, don't ask again if we try to visit
-		       ;; it again.  GUD does that, and repeated questions
-		       ;; are painful.
-		       (get-file-buffer
-			(abbreviate-file-name (file-chase-links buffer-file-name))))
-		       
-		   (vc-follow-link)
-		   (message "Followed link to %s" buffer-file-name)
-		   (vc-find-file-hook))
-                  (t
-                   (if (yes-or-no-p (format
-        "Symbolic link to %s-controlled source file; follow link? " link-type))
-                       (progn (vc-follow-link)
-                              (message "Followed link to %s" buffer-file-name)
-                              (vc-find-file-hook))
-                     (message 
-        "Warning: editing through the link bypasses version control")
-                     ))))))))))
-
-(add-hook 'find-file-hooks 'vc-find-file-hook)
-
-;;; more hooks, this time for file-not-found
-(defun vc-file-not-found-hook ()
-  "When file is not found, try to check it out from RCS or SCCS.
-Returns t if checkout was successful, nil otherwise."
-  (if (vc-backend buffer-file-name)
-      (save-excursion
-	(require 'vc)
-	(setq default-directory (file-name-directory (buffer-file-name)))
-	(not (vc-error-occurred (vc-checkout buffer-file-name))))))
-
-(add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook)
-
-;; Discard info about a file when we kill its buffer.
-(defun vc-kill-buffer-hook ()
-  (if (stringp (buffer-file-name))
-      (progn
-	(vc-file-clearprops (buffer-file-name))
-	(kill-local-variable 'vc-buffer-backend))))
-
-;;;(add-hook 'kill-buffer-hook 'vc-kill-buffer-hook)
-
-;;; Now arrange for bindings and autoloading of the main package.
-;;; Bindings for this have to go in the global map, as we'll often
-;;; want to call them from random buffers.
-
-(setq vc-prefix-map (lookup-key global-map "\C-xv"))
-(if (not (keymapp vc-prefix-map))
-    (progn
-      (setq vc-prefix-map (make-sparse-keymap))
-      (define-key global-map "\C-xv" vc-prefix-map)
-      (define-key vc-prefix-map "a" 'vc-update-change-log)
-      (define-key vc-prefix-map "c" 'vc-cancel-version)
-      (define-key vc-prefix-map "d" 'vc-directory)
-      (define-key vc-prefix-map "h" 'vc-insert-headers)
-      (define-key vc-prefix-map "i" 'vc-register)
-      (define-key vc-prefix-map "l" 'vc-print-log)
-      (define-key vc-prefix-map "r" 'vc-retrieve-snapshot)
-      (define-key vc-prefix-map "s" 'vc-create-snapshot)
-      (define-key vc-prefix-map "u" 'vc-revert-buffer)
-      (define-key vc-prefix-map "v" 'vc-next-action)
-      (define-key vc-prefix-map "=" 'vc-diff)
-      (define-key vc-prefix-map "~" 'vc-version-other-window)))
-
-(if (not (boundp 'vc-menu-map))
-    ;; Don't do the menu bindings if menu-bar.el wasn't loaded to defvar
-    ;; vc-menu-map.
-    ()
-  ;;(define-key vc-menu-map [show-files]
-  ;;  '("Show Files under VC" . (vc-directory t)))
-  (define-key vc-menu-map [vc-directory] '("Show Locked Files" . vc-directory))
-  (define-key vc-menu-map [separator1] '("----"))
-  (define-key vc-menu-map [vc-rename-file] '("Rename File" . vc-rename-file))
-  (define-key vc-menu-map [vc-version-other-window]
-    '("Show Other Version" . vc-version-other-window))
-  (define-key vc-menu-map [vc-diff] '("Compare with Last Version" . vc-diff))
-  (define-key vc-menu-map [vc-update-change-log]
-    '("Update ChangeLog" . vc-update-change-log))
-  (define-key vc-menu-map [vc-print-log] '("Show History" . vc-print-log))
-  (define-key vc-menu-map [separator2] '("----"))
-  (define-key vc-menu-map [undo] '("Undo Last Check-In" . vc-cancel-version))
-  (define-key vc-menu-map [vc-revert-buffer]
-    '("Revert to Last Version" . vc-revert-buffer))
-  (define-key vc-menu-map [vc-insert-header]
-    '("Insert Header" . vc-insert-headers))
-  (define-key vc-menu-map [vc-menu-check-in] '("Check In" . vc-next-action))
-  (define-key vc-menu-map [vc-check-out] '("Check Out" . vc-toggle-read-only))
-  (define-key vc-menu-map [vc-register] '("Register" . vc-register)))
-
-(put 'vc-rename-file 'menu-enable 'vc-mode)
-(put 'vc-version-other-window 'menu-enable 'vc-mode)
-(put 'vc-diff 'menu-enable 'vc-mode)
-(put 'vc-update-change-log 'menu-enable
-     '(eq (vc-buffer-backend) 'RCS))
-(put 'vc-print-log 'menu-enable 'vc-mode)
-(put 'vc-cancel-version 'menu-enable 'vc-mode)
-(put 'vc-revert-buffer 'menu-enable 'vc-mode)
-(put 'vc-insert-headers 'menu-enable 'vc-mode)
-(put 'vc-next-action 'menu-enable 'vc-mode)
-(put 'vc-toggle-read-only 'menu-enable 'vc-mode)
-(put 'vc-register 'menu-enable '(and buffer-file-name (not vc-mode)))
-
-(provide 'vc-hooks)
-
-;;; vc-hooks.el ends here
diff --git a/lisp/vc.el b/lisp/vc.el
deleted file mode 100644
index 9e1e4d5fabb..00000000000
--- a/lisp/vc.el
+++ /dev/null
@@ -1,2792 +0,0 @@
-;;; vc.el --- drive a version-control system from within Emacs
-
-;; Copyright (C) 1992, 93, 94, 95, 96 Free Software Foundation, Inc.
-
-;; Author:     Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: Andre Spiegel <spiegel@inf.fu-berlin.de>
-
-;; 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 mode is fully documented in the Emacs user's manual.
-;;
-;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>.
-;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
-;; and Richard Stallman contributed valuable criticism, support, and testing.
-;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se>
-;; in Jan-Feb 1994.  Further enhancements came from ttn.netcom.com and
-;; Andre Spiegel <spiegel@inf.fu-berlin.de>.
-;;
-;; Supported version-control systems presently include SCCS, RCS, and CVS.
-;;
-;; Some features will not work with old RCS versions.  Where
-;; appropriate, VC finds out which version you have, and allows or
-;; disallows those features (stealing locks, for example, works only 
-;; from 5.6.2 onwards).
-;; Even initial checkins will fail if your RCS version is so old that ci
-;; doesn't understand -t-; this has been known to happen to people running
-;; NExTSTEP 3.0. 
-;;
-;; You can support the RCS -x option by adding pairs to the 
-;; vc-master-templates list.
-;;
-;; Proper function of the SCCS diff commands requires the shellscript vcdiff
-;; to be installed somewhere on Emacs's path for executables.
-;;
-;; If your site uses the ChangeLog convention supported by Emacs, the
-;; function vc-comment-to-change-log should prove a useful checkin hook.
-;;
-;; This code depends on call-process passing back the subprocess exit
-;; status.  Thus, you need Emacs 18.58 or later to run it.  For the
-;; vc-directory command to work properly as documented, you need 19.
-;; You also need Emacs 19's ring.el.
-;;
-;; The vc code maintains some internal state in order to reduce expensive
-;; version-control operations to a minimum.  Some names are only computed
-;; once.  If you perform version control operations with RCS/SCCS/CVS while
-;; vc's back is turned, or move/rename master files while vc is running,
-;; vc may get seriously confused.  Don't do these things!
-;;
-;; Developer's notes on some concurrency issues are included at the end of
-;; the file.
-
-;;; Code:
-
-(require 'vc-hooks)
-(require 'ring)
-(eval-when-compile (require 'dired))	; for dired-map-over-marks macro
-
-(if (not (assoc 'vc-parent-buffer minor-mode-alist))
-    (setq minor-mode-alist
-	  (cons '(vc-parent-buffer vc-parent-buffer-name)
-		minor-mode-alist)))
-
-;; To implement support for a new version-control system, add another
-;; branch to the vc-backend-dispatch macro and fill it in in each
-;; call.  The variable vc-master-templates in vc-hooks.el will also
-;; have to change.
-
-(defmacro vc-backend-dispatch (f s r c)
-  "Execute FORM1, FORM2 or FORM3 for SCCS, RCS or CVS respectively.
-If FORM3 is `RCS', use FORM2 for CVS as well as RCS.
-\(CVS shares some code with RCS)."
-  (list 'let (list (list 'type (list 'vc-backend f)))
-	(list 'cond
-	      (list (list 'eq 'type (quote 'SCCS)) s)	;; SCCS
-	      (list (list 'eq 'type (quote 'RCS)) r)	;; RCS
-	      (list (list 'eq 'type (quote 'CVS)) 	;; CVS
-		    (if (eq c 'RCS) r c))
-	      )))
-
-;; General customization
-
-(defvar vc-suppress-confirm nil
-  "*If non-nil, treat user as expert; suppress yes-no prompts on some things.")
-(defvar vc-initial-comment nil
-  "*If non-nil, prompt for initial comment when a file is registered.")
-(defvar vc-command-messages nil
-  "*If non-nil, display run messages from back-end commands.")
-(defvar vc-register-switches nil
-  "*A string or list of strings specifying extra switches passed 
-to the register program by \\[vc-register].")
-(defvar vc-checkin-switches nil
-  "*A string or list of strings specifying extra switches passed 
-to the checkin program by \\[vc-checkin].")
-(defvar vc-checkout-switches nil
-  "*A string or list of strings specifying extra switches passed 
-to the checkout program by \\[vc-checkout].")
-(defvar vc-directory-exclusion-list '("SCCS" "RCS" "CVS")
-  "*A list of directory names ignored by functions that recursively 
-walk file trees.")
-
-(defconst vc-maximum-comment-ring-size 32
-  "Maximum number of saved comments in the comment ring.")
-
-;;; This is duplicated in diff.el.
-(defvar diff-switches "-c"
-  "*A string or list of strings specifying switches to be be passed to diff.")
-
-;;;###autoload
-(defvar vc-checkin-hook nil
-  "*List of functions called after a checkin is done.  See `run-hooks'.")
-
-;; Header-insertion hair
-
-(defvar vc-header-alist
-  '((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$"))
-  "*Header keywords to be inserted by `vc-insert-headers'.
-Must be a list of two-element lists, the first element of each must
-be `RCS', `CVS', or `SCCS'.  The second element is the string to
-be inserted for this particular backend.")
-(defvar vc-static-header-alist
-  '(("\\.c$" .
-     "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
-  "*Associate static header string templates with file types.  A \%s in the
-template is replaced with the first string associated with the file's
-version-control type in `vc-header-alist'.")
-
-(defvar vc-comment-alist
-  '((nroff-mode ".\\\"" ""))
-  "*Special comment delimiters to be used in generating vc headers only.
-Add an entry in this list if you need to override the normal comment-start
-and comment-end variables.  This will only be necessary if the mode language
-is sensitive to blank lines.")
-
-;; Default is to be extra careful for super-user.
-(defvar vc-checkout-carefully (= (user-uid) 0)
-  "*Non-nil means be extra-careful in checkout.
-Verify that the file really is not locked
-and that its contents match what the master file says.")
-
-(defvar vc-rcs-release nil
-  "*The release number of your RCS installation, as a string.
-If nil, VC itself computes this value when it is first needed.")
-
-(defvar vc-sccs-release nil
-  "*The release number of your SCCS installation, as a string.
-If nil, VC itself computes this value when it is first needed.")
-
-(defvar vc-cvs-release nil
-  "*The release number of your CVS installation, as a string.
-If nil, VC itself computes this value when it is first needed.")
-
-;; Variables the user doesn't need to know about.
-(defvar vc-log-entry-mode nil)
-(defvar vc-log-operation nil)
-(defvar vc-log-after-operation-hook nil)
-(defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer)
-;; In a log entry buffer, this is a local variable
-;; that points to the buffer for which it was made
-;; (either a file, or a VC dired buffer).
-(defvar vc-parent-buffer nil)
-(defvar vc-parent-buffer-name nil)
-
-(defvar vc-log-file)
-(defvar vc-log-version)
-
-(defconst vc-name-assoc-file "VC-names")
-
-(defvar vc-dired-mode nil)
-(make-variable-buffer-local 'vc-dired-mode)
-
-(defvar vc-comment-ring (make-ring vc-maximum-comment-ring-size))
-(defvar vc-comment-ring-index nil)
-(defvar vc-last-comment-match nil)
-
-;; Back-portability to Emacs 18
-
-(defun file-executable-p-18 (f)
-  (let ((modes (file-modes f)))
-    (and modes (not (zerop (logand 292))))))
-
-(defun file-regular-p-18 (f)
-  (let ((attributes (file-attributes f)))
-    (and attributes (not (car attributes)))))
-
-; Conditionally rebind some things for Emacs 18 compatibility
-(if (not (boundp 'minor-mode-map-alist))
-    (progn
-      (setq compilation-old-error-list nil)
-      (fset 'file-executable-p 'file-executable-p-18)
-      (fset 'shrink-window-if-larger-than-buffer 'beginning-of-buffer)
-      ))
-
-(if (not (fboundp 'file-regular-p))
-    (fset 'file-regular-p 'file-regular-p-18))
-
-;;; Find and compare backend releases
-
-(defun vc-backend-release (backend)
-  ;; Returns which backend release is installed on this system.
-  (cond
-   ((eq backend 'RCS)
-    (or vc-rcs-release
-	(and (zerop (vc-do-command nil 2 "rcs" nil nil "-V"))
-	     (save-excursion
-	       (set-buffer (get-buffer "*vc*"))
-	       (setq vc-rcs-release
-		     (car (vc-parse-buffer
-			   '(("^RCS version \\([0-9.]+ *.*\\)" 1)))))))
-	(setq vc-rcs-release 'unknown)))
-   ((eq backend 'CVS)
-    (or vc-cvs-release
-	(and (zerop (vc-do-command nil 1 "cvs" nil nil "-v"))
-	     (save-excursion
-	       (set-buffer (get-buffer "*vc*"))
-	       (setq vc-cvs-release
-		     (car (vc-parse-buffer
-			   '(("^Concurrent Versions System (CVS) \\([0-9.]+\\)"
-			      1)))))))
-	(setq vc-cvs-release 'unknown)))
-     ((eq backend 'SCCS)
-      vc-sccs-release)))
-
-(defun vc-release-greater-or-equal (r1 r2)
-  ;; Compare release numbers, represented as strings.
-  ;; Release components are assumed cardinal numbers, not decimal
-  ;; fractions (5.10 is a higher release than 5.9).  Omitted fields
-  ;; are considered lower (5.6.7 is earlier than 5.6.7.1).
-  ;; Comparison runs till the end of the string is found, or a
-  ;; non-numeric component shows up (5.6.7 is earlier than "5.6.7 beta",
-  ;; which is probably not what you want in some cases).
-  ;;   This code is suitable for existing RCS release numbers.  
-  ;; CVS releases are handled reasonably, too (1.3 < 1.4* < 1.5).
-  (let (v1 v2 i1 i2)
-    (catch 'done
-      (or (and (string-match "^\\.?\\([0-9]+\\)" r1)
-	       (setq i1 (match-end 0))
-	       (setq v1 (string-to-number (match-string 1 r1)))
-	       (or (and (string-match "^\\.?\\([0-9]+\\)" r2)
-			(setq i2 (match-end 0))
-			(setq v2 (string-to-number (match-string 1 r2)))
-			(if (> v1 v2) (throw 'done t)
-			  (if (< v1 v2) (throw 'done nil)
-			    (throw 'done
-				   (vc-release-greater-or-equal
-				    (substring r1 i1)
-				    (substring r2 i2)))))))
-		   (throw 'done t)))
-	  (or (and (string-match "^\\.?\\([0-9]+\\)" r2)
-		   (throw 'done nil))
-	      (throw 'done t)))))
-
-(defun vc-backend-release-p (backend release)
-  ;; Return t if we have RELEASE of BACKEND or better
-  (let (i r (ri 0) (ii 0) is rs (installation (vc-backend-release backend)))
-    (if (not (eq installation 'unknown))
-	(cond
-	 ((or (eq backend 'RCS) (eq backend 'CVS))
-	  (vc-release-greater-or-equal installation release))))))
-
-;;; functions that operate on RCS revision numbers
-
-(defun vc-trunk-p (rev)
-  ;; return t if REV is a revision on the trunk
-  (not (eq nil (string-match "\\`[0-9]+\\.[0-9]+\\'" rev))))
-
-(defun vc-branch-part (rev)
-  ;; return the branch part of a revision number REV
-  (substring rev 0 (string-match "\\.[0-9]+\\'" rev)))
-
-;; File property caching
-
-(defun vc-clear-context ()
-  "Clear all cached file properties and the comment ring."
-  (interactive)
-  (fillarray vc-file-prop-obarray nil)
-  ;; Note: there is potential for minor lossage here if there is an open
-  ;; log buffer with a nonzero local value of vc-comment-ring-index.
-  (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
-
-(defun vc-file-clear-masterprops (file)
-  ;; clear all properties of FILE that were retrieved
-  ;; from the master file
-  (vc-file-setprop file 'vc-latest-version nil)
-  (vc-file-setprop file 'vc-your-latest-version nil)
-  (vc-backend-dispatch file
-     (progn   ;; SCCS
-       (vc-file-setprop file 'vc-master-locks nil))
-     (progn   ;; RCS
-       (vc-file-setprop file 'vc-default-branch nil)
-       (vc-file-setprop file 'vc-head-version nil)
-       (vc-file-setprop file 'vc-master-workfile-version nil)
-       (vc-file-setprop file 'vc-master-locks nil))
-     (progn
-       (vc-file-setprop file 'vc-cvs-status nil))))
-
-(defun vc-head-version (file)
-  ;; Return the RCS head version of FILE 
-  (cond ((vc-file-getprop file 'vc-head-version))
-	(t (vc-fetch-master-properties file)
-	   (vc-file-getprop file 'vc-head-version))))
-
-;; Random helper functions
-
-(defun vc-latest-on-branch-p (file)
-  ;; return t iff the current workfile version of FILE is
-  ;; the latest on its branch.
-  (vc-backend-dispatch file
-     ;; SCCS
-     (string= (vc-workfile-version file) (vc-latest-version file)) 
-     ;; RCS
-     (let ((workfile-version (vc-workfile-version file)) tip-version)
-       (if (vc-trunk-p workfile-version) 
-	   (progn 
-	     ;; Re-fetch the head version number.  This is to make
-             ;; sure that no-one has checked in a new version behind
-	     ;; our back.
-	     (vc-fetch-master-properties file)
-	     (string= (vc-file-getprop file 'vc-head-version)
-		      workfile-version))
-	 ;; If we are not on the trunk, we need to examine the
-	 ;; whole current branch.  (vc-master-workfile-version 
-         ;; is not what we need.)
-	 (save-excursion
-	   (set-buffer (get-buffer-create "*vc-info*"))
-	   (vc-insert-file (vc-name file) "^desc")
-	   (setq tip-version (car (vc-parse-buffer (list (list 
-             (concat "^\\(" (regexp-quote (vc-branch-part workfile-version))
-		     "\\.[0-9]+\\)\ndate[ \t]+\\([0-9.]+\\);") 1 2)))))
-	   (if (get-buffer "*vc-info*") 
-	       (kill-buffer (get-buffer "*vc-info*")))
-	   (string= tip-version workfile-version))))
-     ;; CVS
-     t))
-
-(defun vc-registration-error (file)
-  (if file
-      (error "File %s is not under version control" file)
-    (error "Buffer %s is not associated with a file" (buffer-name))))
-
-(defvar vc-binary-assoc nil)
-
-(defun vc-find-binary (name)
-  "Look for a command anywhere on the subprocess-command search path."
-  (or (cdr (assoc name vc-binary-assoc))
-      (catch 'found
-	(mapcar
-	 (function 
-	  (lambda (s)
-	    (if s
-		(let ((full (concat s "/" name)))
-		  (if (file-executable-p full)
-		      (progn
-			(setq vc-binary-assoc
-			      (cons (cons name full) vc-binary-assoc))
-			(throw 'found full)))))))
-	 exec-path)
-	nil)))
-
-(defun vc-do-command (buffer okstatus command file last &rest flags)
-  "Execute a version-control command, notifying user and checking for errors.
-Output from COMMAND goes to BUFFER, or *vc* if BUFFER is nil.  
-The command is successful if its exit status does not exceed OKSTATUS.
-The last argument of the command is the master name of FILE if LAST is 
-`MASTER', or the workfile of FILE if LAST is `WORKFILE'; this is appended 
-to an optional list of FLAGS."
-  (and file (setq file (expand-file-name file)))
-  (if (not buffer) (setq buffer "*vc*"))
-  (if vc-command-messages
-      (message "Running %s on %s..." command file))
-  (let ((obuf (current-buffer)) (camefrom (current-buffer))
-	(squeezed nil)
-	(vc-file (and file (vc-name file)))
-	(olddir default-directory)
-	status)
-    (set-buffer (get-buffer-create buffer))
-    (set (make-local-variable 'vc-parent-buffer) camefrom)
-    (set (make-local-variable 'vc-parent-buffer-name)
-	 (concat " from " (buffer-name camefrom)))
-    (setq default-directory olddir)
-    
-    (erase-buffer)
-
-    (mapcar
-     (function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
-     flags)
-    (if (and vc-file (eq last 'MASTER))
-	(setq squeezed (append squeezed (list vc-file))))
-    (if (eq last 'WORKFILE)
-	(progn
-	  (let* ((pwd (expand-file-name default-directory))
-		 (preflen (length pwd)))
-	    (if (string= (substring file 0 preflen) pwd)
-		(setq file (substring file preflen))))
-	  (setq squeezed (append squeezed (list file)))))
-    (let ((exec-path (append vc-path exec-path))
-	  ;; Add vc-path to PATH for the execution of this command.
-	  (process-environment
-	   (cons (concat "PATH=" (getenv "PATH")
-			 path-separator
-			 (mapconcat 'identity vc-path path-separator))
-		 process-environment))
-	  (w32-quote-process-args t))
-      (setq status (apply 'call-process command nil t nil squeezed)))
-    (goto-char (point-max))
-    (set-buffer-modified-p nil)
-    (forward-line -1)
-    (if (or (not (integerp status)) (< okstatus status))
-	(progn
-	  (pop-to-buffer buffer)
-	  (goto-char (point-min))
-	  (shrink-window-if-larger-than-buffer)
-	  (error "Running %s...FAILED (%s)" command
-		 (if (integerp status)
-		     (format "status %d" status)
-		   status))
-	  )
-      (if vc-command-messages
-	  (message "Running %s...OK" command))
-      )
-    (set-buffer obuf)
-    status)
-  )
-
-;;; Save a bit of the text around POSN in the current buffer, to help
-;;; us find the corresponding position again later.  This works even
-;;; if all markers are destroyed or corrupted.
-;;; A lot of this was shamelessly lifted from Sebastian Kremer's rcs.el mode.
-(defun vc-position-context (posn)
-  (list posn
-	(buffer-size)
-	(buffer-substring posn
-			  (min (point-max) (+ posn 100)))))
-
-;;; Return the position of CONTEXT in the current buffer, or nil if we
-;;; couldn't find it.
-(defun vc-find-position-by-context (context)
-  (let ((context-string (nth 2 context)))
-    (if (equal "" context-string)
-	(point-max)
-      (save-excursion
-	(let ((diff (- (nth 1 context) (buffer-size))))
-	  (if (< diff 0) (setq diff (- diff)))
-	  (goto-char (nth 0 context))
-	  (if (or (search-forward context-string nil t)
-		  ;; Can't use search-backward since the match may continue
-		  ;; after point.
-		  (progn (goto-char (- (point) diff (length context-string)))
-			 ;; goto-char doesn't signal an error at
-			 ;; beginning of buffer like backward-char would
-			 (search-forward context-string nil t)))
-	      ;; to beginning of OSTRING
-	      (- (point) (length context-string))))))))
-
-(defun vc-buffer-context ()
-  ;; Return a list '(point-context mark-context reparse); from which
-  ;; vc-restore-buffer-context can later restore the context.
-  (let ((point-context (vc-position-context (point)))
-	;; Use mark-marker to avoid confusion in transient-mark-mode.
-	(mark-context  (if (eq (marker-buffer (mark-marker)) (current-buffer))
-			   (vc-position-context (mark-marker))))
-	;; Make the right thing happen in transient-mark-mode.
-	(mark-active nil)
-	;; We may want to reparse the compilation buffer after revert
-	(reparse (and (boundp 'compilation-error-list) ;compile loaded
-		      (let ((curbuf (current-buffer)))
-			;; Construct a list; each elt is nil or a buffer
-			;; iff that buffer is a compilation output buffer
-			;; that contains markers into the current buffer.
-			(save-excursion
-			  (mapcar (function
-				   (lambda (buffer)
-				    (set-buffer buffer)
-				    (let ((errors (or
-						   compilation-old-error-list
-						   compilation-error-list))
-					  (buffer-error-marked-p nil))
-				      (while (and (consp errors)
-						  (not buffer-error-marked-p))
-					(and (markerp (cdr (car errors)))
-					     (eq buffer
-						 (marker-buffer
-						  (cdr (car errors))))
-					     (setq buffer-error-marked-p t))
-					(setq errors (cdr errors)))
-				      (if buffer-error-marked-p buffer))))
-				  (buffer-list)))))))
-    (list point-context mark-context reparse)))
-
-(defun vc-restore-buffer-context (context)
-  ;; Restore point/mark, and reparse any affected compilation buffers.
-  ;; CONTEXT is that which vc-buffer-context returns.
-  (let ((point-context (nth 0 context))
-	(mark-context (nth 1 context))
-	(reparse (nth 2 context)))
-    ;; Reparse affected compilation buffers.
-    (while reparse
-      (if (car reparse)
-	  (save-excursion
-	    (set-buffer (car reparse))
-	    (let ((compilation-last-buffer (current-buffer)) ;select buffer
-		  ;; Record the position in the compilation buffer of
-		  ;; the last error next-error went to.
-		  (error-pos (marker-position
-			      (car (car-safe compilation-error-list)))))
-	      ;; Reparse the error messages as far as they were parsed before.
-	      (compile-reinitialize-errors '(4) compilation-parsing-end)
-	      ;; Move the pointer up to find the error we were at before
-	      ;; reparsing.  Now next-error should properly go to the next one.
-	      (while (and compilation-error-list
-			  (/= error-pos (car (car compilation-error-list))))
-		(setq compilation-error-list (cdr compilation-error-list))))))
-      (setq reparse (cdr reparse)))
-
-    ;; Restore point and mark
-    (let ((new-point (vc-find-position-by-context point-context)))
-      (if new-point (goto-char new-point)))
-    (if mark-context
-	(let ((new-mark (vc-find-position-by-context mark-context)))
-	  (if new-mark (set-mark new-mark))))))
-
-(defun vc-revert-buffer1 (&optional arg no-confirm)
-  ;; Revert buffer, try to keep point and mark where user expects them in spite
-  ;; of changes because of expanded version-control key words.
-  ;; This is quite important since otherwise typeahead won't work as expected.
-  (interactive "P")
-  (widen)
-  (let ((context (vc-buffer-context)))
-    ;; t means don't call normal-mode; that's to preserve various minor modes.
-    (revert-buffer arg no-confirm t)
-    (vc-restore-buffer-context context)))
-
-
-(defun vc-buffer-sync (&optional not-urgent)
-  ;; Make sure the current buffer and its working file are in sync
-  ;; NOT-URGENT means it is ok to continue if the user says not to save.
-  (if (buffer-modified-p)
-      (if (or vc-suppress-confirm
-	      (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
-	  (save-buffer)
-	(if not-urgent
-	    nil
-	  (error "Aborted")))))
-
-
-(defun vc-workfile-unchanged-p (file &optional want-differences-if-changed)
-  ;; Has the given workfile changed since last checkout?
-  (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
-	(lastmod (nth 5 (file-attributes file))))
-    (or (equal checkout-time lastmod)
-	(and (or (not checkout-time) want-differences-if-changed)
-	     (let ((unchanged (zerop (vc-backend-diff file nil nil
-					  (not want-differences-if-changed)))))
-	       ;; 0 stands for an unknown time; it can't match any mod time.
-	       (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
-	       unchanged)))))
-
-(defun vc-next-action-on-file (file verbose &optional comment)
-  ;;; If comment is specified, it will be used as an admin or checkin comment.
-  (let ((vc-file (vc-name file))
-	(vc-type (vc-backend file))
-	owner version buffer)
-    (cond
-
-     ;; if there is no master file corresponding, create one
-     ((not vc-file)
-      (vc-register verbose comment)
-      (if vc-initial-comment
-	  (setq vc-log-after-operation-hook
-		'vc-checkout-writable-buffer-hook)
-	(vc-checkout-writable-buffer file)))
-
-     ;; CVS: changes to the master file need to be 
-     ;; merged back into the working file
-     ((and (eq vc-type 'CVS)
-	   (or (eq (vc-cvs-status file) 'needs-checkout)
-	       (eq (vc-cvs-status file) 'needs-merge)))
-      (if (or vc-dired-mode
-	      (yes-or-no-p 
-	       (format "%s is not up-to-date.  Merge in changes now? "
-		       (buffer-name))))
-	  (progn
-	    (if vc-dired-mode
-		(and (setq buffer (get-file-buffer file))
-		     (buffer-modified-p buffer)
-		     (switch-to-buffer-other-window buffer)
-		     (vc-buffer-sync t))
-	      (setq buffer (current-buffer))
-	      (vc-buffer-sync t))
-	    (if (and buffer (buffer-modified-p buffer)
-		     (not (yes-or-no-p 
-			   (format 
-			    "Buffer %s modified; merge file on disc anyhow? " 
-			    (buffer-name buffer)))))
-		(error "Merge aborted"))
-	    (if (not (zerop (vc-backend-merge-news file)))
-		;; Overlaps detected - what now?  Should use some
-		;; fancy RCS conflict resolving package, or maybe
-		;; emerge, but for now, simply warn the user with a
-		;; message.
-		(message "Conflicts detected!"))
-	    (and buffer
-		 (vc-resynch-buffer file t (not (buffer-modified-p buffer)))))
-	(error "%s needs update" (buffer-name))))
-
-     ;; if there is no lock on the file, assert one and get it
-     ((not (setq owner (vc-locking-user file)))
-      (if (and vc-checkout-carefully
-	       (not (vc-workfile-unchanged-p file t)))
-	  (if (save-window-excursion
-		(pop-to-buffer "*vc-diff*")
-		(goto-char (point-min))
-		(insert-string (format "Changes to %s since last lock:\n\n"
-				       file))
-		(not (beep))
-		(yes-or-no-p
-		      (concat "File has unlocked changes, "
-		       "claim lock retaining changes? ")))
-	      (progn (vc-backend-steal file)
-		     (vc-mode-line file))
-	    (if (not (yes-or-no-p "Revert to checked-in version, instead? "))
-		(error "Checkout aborted")
-	      (vc-revert-buffer1 t t)
-	      (vc-checkout-writable-buffer file))
-	    )
-	(if verbose 
-	    (if (not (eq vc-type 'SCCS))
-		(vc-checkout file nil 
-		   (read-string "Branch or version to move to: "))
-	      (error "Sorry, this is not implemented for SCCS"))
-	  (if (vc-latest-on-branch-p file)
-	      (vc-checkout-writable-buffer file)
-	    (if (yes-or-no-p 
-		 "This is not the latest version.  Really lock it?  ")
-		(vc-checkout-writable-buffer file)
-	      (if (yes-or-no-p "Lock the latest version instead? ")
-		  (vc-checkout-writable-buffer file
-		     (if (vc-trunk-p (vc-workfile-version file)) 
-                         ""  ;; this means check out latest on trunk
-                       (vc-branch-part (vc-workfile-version file)))))))
-	  )))
-
-     ;; a checked-out version exists, but the user may not own the lock
-     ((and (not (eq vc-type 'CVS))
-	   (not (string-equal owner (vc-user-login-name))))
-      (if comment
-	  (error "Sorry, you can't steal the lock on %s this way" file))
-      (and (eq vc-type 'RCS)
-	   (not (vc-backend-release-p 'RCS "5.6.2"))
-	   (error "File is locked by %s" owner))
-      (vc-steal-lock
-       file
-       (if verbose (read-string "Version to steal: ")
-	 (vc-workfile-version file))
-       owner))
-
-     ;; OK, user owns the lock on the file
-     (t
-	  (if vc-dired-mode 
-	      (find-file-other-window file) 
-	    (find-file file))
-
-	  ;; give luser a chance to save before checking in.
-	  (vc-buffer-sync)
-
-	  ;; Revert if file is unchanged and buffer is too.
-	  ;; If buffer is modified, that means the user just said no
-	  ;; to saving it; in that case, don't revert,
-	  ;; because the user might intend to save
-	  ;; after finishing the log entry.
-	  (if (and (vc-workfile-unchanged-p file) 
-		   (not (buffer-modified-p)))
-	       ;; DO NOT revert the file without asking the user!
-	      (cond 
-	       ((yes-or-no-p "Revert to master version? ")
-		(vc-backend-revert file)
-		(vc-resynch-window file t t)))
-
-	    ;; user may want to set nonstandard parameters
-	    (if verbose
-		(setq version (read-string "New version level: ")))
-
-	    ;; OK, let's do the checkin
-	    (vc-checkin file version comment)
-	    )))))
-
-(defun vc-next-action-dired (file rev comment)
-  ;; Do a vc-next-action-on-file on all the marked files, possibly 
-  ;; passing on the log comment we've just entered.
-  (let ((configuration (current-window-configuration))
-	(dired-buffer (current-buffer))
-	(dired-dir default-directory))
-    (dired-map-over-marks
-     (let ((file (dired-get-filename)) p
-	   (default-directory default-directory))
-       (message "Processing %s..." file)
-       ;; Adjust the default directory so that checkouts
-       ;; go to the right place.
-       (setq default-directory (file-name-directory file))
-       (vc-next-action-on-file file nil comment)
-       (set-buffer dired-buffer)
-       (setq default-directory dired-dir)
-       (vc-dired-update-line file)
-       (set-window-configuration configuration)
-       (message "Processing %s...done" file))
-    nil t)))
-
-;; Here's the major entry point.
-
-;;;###autoload
-(defun vc-next-action (verbose)
-  "Do the next logical checkin or checkout operation on the current file.
-   If you call this from within a VC dired buffer with no files marked,
-it will operate on the file in the current line.
-   If you call this from within a VC dired buffer, and one or more
-files are marked, it will accept a log message and then operate on
-each one.  The log message will be used as a comment for any register
-or checkin operations, but ignored when doing checkouts.  Attempted
-lock steals will raise an error.
-   A prefix argument lets you specify the version number to use.
-
-For RCS and SCCS files:
-   If the file is not already registered, this registers it for version
-control and then retrieves a writable, locked copy for editing.
-   If the file is registered and not locked by anyone, this checks out
-a writable and locked file ready for editing.
-   If the file is checked out and locked by the calling user, this
-first checks to see if the file has changed since checkout.  If not,
-it performs a revert.
-   If the file has been changed, this pops up a buffer for entry
-of a log message; when the message has been entered, it checks in the
-resulting changes along with the log message as change commentary.  If
-the variable `vc-keep-workfiles' is non-nil (which is its default), a
-read-only copy of the changed file is left in place afterwards.
-   If the file is registered and locked by someone else, you are given
-the option to steal the lock.
-
-For CVS files:
-   If the file is not already registered, this registers it for version
-control.  This does a \"cvs add\", but no \"cvs commit\".
-   If the file is added but not committed, it is committed.
-   If your working file is changed, but the repository file is
-unchanged, this pops up a buffer for entry of a log message; when the
-message has been entered, it checks in the resulting changes along
-with the logmessage as change commentary.  A writable file is retained.
-   If the repository file is changed, you are asked if you want to
-merge in the changes into your working copy."
-
-  (interactive "P")
-  (catch 'nogo
-    (if vc-dired-mode
-	(let ((files (dired-get-marked-files)))
-	  (if (string= "" 
-		 (mapconcat
-	             (function (lambda (f)
-			 (if (eq (vc-backend f) 'CVS)
-			     (if (or (eq (vc-cvs-status f) 'locally-modified)
-				     (eq (vc-cvs-status f) 'locally-added))
-				 "@" "")
-			   (if (vc-locking-user f) "@" ""))))
-		     files ""))
-		(vc-next-action-dired nil nil "dummy")
-	      (vc-start-entry nil nil nil
-			      "Enter a change comment for the marked files."
-			      'vc-next-action-dired))
-	    (throw 'nogo nil)))
-    (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
-    (if buffer-file-name
-	(vc-next-action-on-file buffer-file-name verbose)
-      (vc-registration-error nil))))
-
-;;; These functions help the vc-next-action entry point
-
-(defun vc-checkout-writable-buffer (&optional file rev)
-  "Retrieve a writable copy of the latest version of the current buffer's file."
-  (vc-checkout (or file (buffer-file-name)) t rev)
-  )
-
-;;;###autoload
-(defun vc-register (&optional override comment)
-  "Register the current file into your version-control system."
-  (interactive "P")
-  (or buffer-file-name
-      (error "No visited file"))
-  (let ((master (vc-name buffer-file-name)))
-    (and master (file-exists-p master)
-	 (error "This file is already registered"))
-    (and master
-	 (not (y-or-n-p "Previous master file has vanished.  Make a new one? "))
-	 (error "This file is already registered")))
-  ;; Watch out for new buffers of size 0: the corresponding file
-  ;; does not exist yet, even though buffer-modified-p is nil.
-  (if (and (not (buffer-modified-p))
-	   (zerop (buffer-size))
-	   (not (file-exists-p buffer-file-name)))
-      (set-buffer-modified-p t))
-  (vc-buffer-sync)
-  (cond ((not vc-make-backup-files)
-	 ;; inhibit backup for this buffer
-	 (make-local-variable 'backup-inhibited)
-	 (setq backup-inhibited t)))
-  (vc-admin
-   buffer-file-name
-   (and override
-	(read-string
-	 (format "Initial version level for %s: " buffer-file-name))))
-  )
-
-(defun vc-resynch-window (file &optional keep noquery)
-  ;; If the given file is in the current buffer,
-  ;; either revert on it so we see expanded keywords,
-  ;; or unvisit it (depending on vc-keep-workfiles)
-  ;; NOQUERY if non-nil inhibits confirmation for reverting.
-  ;; NOQUERY should be t *only* if it is known the only difference
-  ;; between the buffer and the file is due to RCS rather than user editing!
-  (and (string= buffer-file-name file)
-       (if keep
-	   (progn
-	     ;; temporarily remove vc-find-file-hook, so that
-             ;; we don't lose the properties
-	     (remove-hook 'find-file-hooks 'vc-find-file-hook)
-	     (vc-revert-buffer1 t noquery)
-	     (add-hook 'find-file-hooks 'vc-find-file-hook)
-	     (vc-mode-line buffer-file-name))
-	 (kill-buffer (current-buffer)))))
-
-(defun vc-resynch-buffer (file &optional keep noquery)
-  ;; if FILE is currently visited, resynch its buffer
-  (let ((buffer (get-file-buffer file)))
-    (if buffer
-	(save-excursion
-	  (set-buffer buffer)
-	  (vc-resynch-window file keep noquery)))))
-
-(defun vc-start-entry (file rev comment msg action &optional after-hook)
-  ;; Accept a comment for an operation on FILE revision REV.  If COMMENT
-  ;; is nil, pop up a VC-log buffer, emit MSG, and set the
-  ;; action on close to ACTION; otherwise, do action immediately.
-  ;; Remember the file's buffer in vc-parent-buffer (current one if no file).
-  ;; AFTER-HOOK specifies the local value for vc-log-operation-hook.
-  (let ((parent (if file (find-file-noselect file) (current-buffer))))
-    (if comment
-	(set-buffer (get-buffer-create "*VC-log*"))
-      (pop-to-buffer (get-buffer-create "*VC-log*")))
-    (set (make-local-variable 'vc-parent-buffer) parent)
-    (set (make-local-variable 'vc-parent-buffer-name)
-	 (concat " from " (buffer-name vc-parent-buffer)))
-    (if file (vc-mode-line file))
-    (vc-log-mode)
-    (make-local-variable 'vc-log-after-operation-hook)
-    (if after-hook
-	(setq vc-log-after-operation-hook after-hook))
-    (setq vc-log-operation action)
-    (setq vc-log-file file)
-    (setq vc-log-version rev)
-    (if comment
-	(progn
-	  (erase-buffer)
-	  (if (eq comment t)
-	      (vc-finish-logentry t)
-	    (insert comment)
-	    (vc-finish-logentry nil)))
-      (message "%s  Type C-c C-c when done." msg))))
-
-(defun vc-admin (file rev &optional comment)
-  "Check a file into your version-control system.
-FILE is the unmodified name of the file.  REV should be the base version
-level to check it in under.  COMMENT, if specified, is the checkin comment."
-  (vc-start-entry file rev
-		  (or comment (not vc-initial-comment))
-		  "Enter initial comment." 'vc-backend-admin
-		  nil))
-
-(defun vc-checkout (file &optional writable rev)
-  "Retrieve a copy of the latest version of the given file."
-  ;; If ftp is on this system and the name matches the ange-ftp format
-  ;; for a remote file, the user is trying something that won't work.
-  (if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp"))
-      (error "Sorry, you can't check out files over FTP"))
-  (vc-backend-checkout file writable rev)
-  (vc-resynch-buffer file t t))
-
-(defun vc-steal-lock (file rev &optional owner)
-  "Steal the lock on the current workfile."
-  (let (file-description)
-    (if (not owner)
-	(setq owner (vc-locking-user file)))
-    (if rev
-	(setq file-description (format "%s:%s" file rev))
-      (setq file-description file))
-    (if (not (y-or-n-p (format "Take the lock on %s from %s? "
-			       file-description owner)))
-	(error "Steal cancelled"))
-    (pop-to-buffer (get-buffer-create "*VC-mail*"))
-    (setq default-directory (expand-file-name "~/"))
-    (auto-save-mode auto-save-default)
-    (mail-mode)
-    (erase-buffer)
-    (mail-setup owner (format "Stolen lock on %s" file-description) nil nil nil
-		(list (list 'vc-finish-steal file rev)))
-    (goto-char (point-max))
-    (insert
-     (format "I stole the lock on %s, " file-description)
-     (current-time-string)
-     ".\n")
-    (message "Please explain why you stole the lock.  Type C-c C-c when done.")))
-
-;; This is called when the notification has been sent.
-(defun vc-finish-steal (file version)
-  (vc-backend-steal file version)
-  (if (get-file-buffer file)
-      (save-excursion
-	(set-buffer (get-file-buffer file))
-	(vc-resynch-window file t t))))
-
-(defun vc-checkin (file &optional rev comment)
-  "Check in the file specified by FILE.
-The optional argument REV may be a string specifying the new version level
-\(if nil increment the current level).  The file is either retained with write
-permissions zeroed, or deleted (according to the value of `vc-keep-workfiles').
-If the back-end is CVS, a writable workfile is always kept.
-COMMENT is a comment string; if omitted, a buffer is
-popped up to accept a comment."
-  (vc-start-entry file rev comment
-		  "Enter a change comment." 'vc-backend-checkin
-		  'vc-checkin-hook))
-
-;;; Here is a checkin hook that may prove useful to sites using the
-;;; ChangeLog facility supported by Emacs.
-(defun vc-comment-to-change-log (&optional whoami file-name)
-  "Enter last VC comment into change log file for current buffer's file.
-Optional arg (interactive prefix) non-nil means prompt for user name and site.
-Second arg is file name of change log.  \
-If nil, uses `change-log-default-name'."
-  (interactive (if current-prefix-arg
-		   (list current-prefix-arg
-			 (prompt-for-change-log-name))))
-  ;; Make sure the defvar for add-log-current-defun-function has been executed
-  ;; before binding it.
-  (require 'add-log)
-  (let (;; Extract the comment first so we get any error before doing anything.
-	(comment (ring-ref vc-comment-ring 0))
-	;; Don't let add-change-log-entry insert a defun name.
-	(add-log-current-defun-function 'ignore)
-	end)
-    ;; Call add-log to do half the work.
-    (add-change-log-entry whoami file-name t t)
-    ;; Insert the VC comment, leaving point before it.
-    (setq end (save-excursion (insert comment) (point-marker)))
-    (if (looking-at "\\s *\\s(")
-	;; It starts with an open-paren, as in "(foo): Frobbed."
-	;; So remove the ": " add-log inserted.
-	(delete-char -2))
-    ;; Canonicalize the white space between the file name and comment.
-    (just-one-space)
-    ;; Indent rest of the text the same way add-log indented the first line.
-    (let ((indentation (current-indentation)))
-      (save-excursion
-	(while (< (point) end)
-	  (forward-line 1)
-	  (indent-to indentation))
-	(setq end (point))))
-    ;; Fill the inserted text, preserving open-parens at bol.
-    (let ((paragraph-separate (concat paragraph-separate "\\|\\s *\\s("))
-	  (paragraph-start (concat paragraph-start "\\|\\s *\\s(")))
-      (beginning-of-line)
-      (fill-region (point) end))
-    ;; Canonicalize the white space at the end of the entry so it is
-    ;; separated from the next entry by a single blank line.
-    (skip-syntax-forward " " end)
-    (delete-char (- (skip-syntax-backward " ")))
-    (or (eobp) (looking-at "\n\n")
-	(insert "\n"))))
-
-
-(defun vc-finish-logentry (&optional nocomment)
-  "Complete the operation implied by the current log entry."
-  (interactive)
-  ;; Check and record the comment, if any.
-  (if (not nocomment)
-      (progn
-	(goto-char (point-max))
-	(if (not (bolp))
-	    (newline))
-	;; Comment too long?
-	(vc-backend-logentry-check vc-log-file)
-	;; Record the comment in the comment ring
-	(ring-insert vc-comment-ring (buffer-string))
-	))
-  ;; Sync parent buffer in case the user modified it while editing the comment.
-  ;; But not if it is a vc-dired buffer.
-  (save-excursion
-    (set-buffer vc-parent-buffer)
-    (or vc-dired-mode
-	(vc-buffer-sync)))
-  (if (not vc-log-operation) (error "No log operation is pending"))
-  ;; save the parameters held in buffer-local variables
-  (let ((log-operation vc-log-operation)
-	(log-file vc-log-file)
-	(log-version vc-log-version)
-	(log-entry (buffer-string))
-	(after-hook vc-log-after-operation-hook))
-    ;; Return to "parent" buffer of this checkin and remove checkin window
-    (pop-to-buffer vc-parent-buffer)
-    (let ((logbuf (get-buffer "*VC-log*")))
-      (delete-windows-on logbuf)
-      (kill-buffer logbuf))
-    ;; OK, do it to it
-    (save-excursion
-      (funcall log-operation 
-	       log-file
-	       log-version
-	       log-entry))
-    ;; Now make sure we see the expanded headers
-    (if buffer-file-name
-	(vc-resynch-window buffer-file-name vc-keep-workfiles t))
-    (run-hooks after-hook)))
-
-;; Code for access to the comment ring
-
-(defun vc-previous-comment (arg)
-  "Cycle backwards through comment history."
-  (interactive "*p")
-  (let ((len (ring-length vc-comment-ring)))
-    (cond ((<= len 0)
-	   (message "Empty comment ring")
-	   (ding))
-	  (t
-	   (erase-buffer)
-	   ;; Initialize the index on the first use of this command
-	   ;; so that the first M-p gets index 0, and the first M-n gets
-	   ;; index -1.
-	   (if (null vc-comment-ring-index)
-	       (setq vc-comment-ring-index
-		     (if (> arg 0) -1
-			 (if (< arg 0) 1 0))))
-	   (setq vc-comment-ring-index
-		 (mod (+ vc-comment-ring-index arg) len))
-	   (message "%d" (1+ vc-comment-ring-index))
-	   (insert (ring-ref vc-comment-ring vc-comment-ring-index))))))
-
-(defun vc-next-comment (arg)
-  "Cycle forwards through comment history."
-  (interactive "*p")
-  (vc-previous-comment (- arg)))
-
-(defun vc-comment-search-reverse (str)
-  "Searches backwards through comment history for substring match."
-  (interactive "sComment substring: ")
-  (if (string= str "")
-      (setq str vc-last-comment-match)
-    (setq vc-last-comment-match str))
-  (if (null vc-comment-ring-index)
-      (setq vc-comment-ring-index -1))
-  (let ((str (regexp-quote str))
-        (len (ring-length vc-comment-ring))
-	(n (1+ vc-comment-ring-index)))
-    (while (and (< n len) (not (string-match str (ring-ref vc-comment-ring n))))
-      (setq n (+ n 1)))
-    (cond ((< n len)
-	   (vc-previous-comment (- n vc-comment-ring-index)))
-	  (t (error "Not found")))))
-
-(defun vc-comment-search-forward (str)
-  "Searches forwards through comment history for substring match."
-  (interactive "sComment substring: ")
-  (if (string= str "")
-      (setq str vc-last-comment-match)
-    (setq vc-last-comment-match str))
-  (if (null vc-comment-ring-index)
-      (setq vc-comment-ring-index 0))
-  (let ((str (regexp-quote str))
-        (len (ring-length vc-comment-ring))
-	(n vc-comment-ring-index))
-    (while (and (>= n 0) (not (string-match str (ring-ref vc-comment-ring n))))
-      (setq n (- n 1)))
-    (cond ((>= n 0)
-	   (vc-next-comment (- n vc-comment-ring-index)))
-	  (t (error "Not found")))))
-
-;; Additional entry points for examining version histories
-
-;;;###autoload
-(defun vc-diff (historic &optional not-urgent)
-  "Display diffs between file versions.
-Normally this compares the current file and buffer with the most recent 
-checked in version of that file.  This uses no arguments.
-With a prefix argument, it reads the file name to use
-and two version designators specifying which versions to compare."
-  (interactive (list current-prefix-arg t))
-  (if vc-dired-mode
-      (set-buffer (find-file-noselect (dired-get-filename))))
-  (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
-  (if historic
-      (call-interactively 'vc-version-diff)
-    (if (or (null buffer-file-name) (null (vc-name buffer-file-name)))
-	(error
-	 "There is no version-control master associated with this buffer"))
-    (let ((file buffer-file-name)
-	  unchanged)
-      (or (and file (vc-name file))
-	  (vc-registration-error file))
-      (vc-buffer-sync not-urgent)
-      (setq unchanged (vc-workfile-unchanged-p buffer-file-name))
-      (if unchanged
-	  (message "No changes to %s since latest version" file)
-	(vc-backend-diff file)
-	;; Ideally, we'd like at this point to parse the diff so that
-	;; the buffer effectively goes into compilation mode and we
-	;; can visit the old and new change locations via next-error.
-	;; Unfortunately, this is just too painful to do.  The basic
-	;; problem is that the `old' file doesn't exist to be
-	;; visited.  This plays hell with numerous assumptions in
-	;; the diff.el and compile.el machinery.
-	(set-buffer "*vc-diff*")
-	(setq default-directory (file-name-directory file))
-	(if (= 0 (buffer-size))
-	    (progn
-	      (setq unchanged t)
-	      (message "No changes to %s since latest version" file))
-          (pop-to-buffer "*vc-diff*")
-	  (goto-char (point-min))
-	  (shrink-window-if-larger-than-buffer)))
-      (not unchanged))))
-
-(defun vc-version-diff (file rel1 rel2)
-  "For FILE, report diffs between two stored versions REL1 and REL2 of it.
-If FILE is a directory, generate diffs between versions for all registered
-files in or below it."
-  (interactive "FFile or directory to diff: \nsOlder version: \nsNewer version: ")
-  (if (string-equal rel1 "") (setq rel1 nil))
-  (if (string-equal rel2 "") (setq rel2 nil))
-  (if (file-directory-p file)
-      (let ((camefrom (current-buffer)))
-	(set-buffer (get-buffer-create "*vc-status*"))
-	(set (make-local-variable 'vc-parent-buffer) camefrom)
-	(set (make-local-variable 'vc-parent-buffer-name)
-	     (concat " from " (buffer-name camefrom)))
-	(erase-buffer)
-	(insert "Diffs between "
-		(or rel1 "last version checked in")
-		" and "
-		(or rel2 "current workfile(s)")
-		":\n\n")
-	(set-buffer (get-buffer-create "*vc-diff*"))
-	(cd file)
-	(vc-file-tree-walk
-	 default-directory
-	 (function (lambda (f)
-		     (message "Looking at %s" f)
-		     (and
-		      (not (file-directory-p f))
-		      (vc-registered f)
-		      (vc-backend-diff f rel1 rel2)
-		      (append-to-buffer "*vc-status*" (point-min) (point-max)))
-		     )))
-	(pop-to-buffer "*vc-status*")
-	(insert "\nEnd of diffs.\n")
-	(goto-char (point-min))
-	(set-buffer-modified-p nil)
-	)
-    (if (zerop (vc-backend-diff file rel1 rel2))
-	(message "No changes to %s between %s and %s." file rel1 rel2)
-      (pop-to-buffer "*vc-diff*"))))
-
-;;;###autoload
-(defun vc-version-other-window (rev)
-  "Visit version REV of the current buffer in another window.
-If the current buffer is named `F', the version is named `F.~REV~'.
-If `F.~REV~' already exists, it is used instead of being re-created."
-  (interactive "sVersion to visit (default is latest version): ")
-  (if vc-dired-mode
-      (set-buffer (find-file-noselect (dired-get-filename))))
-  (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
-  (if (and buffer-file-name (vc-name buffer-file-name))
-      (let* ((version (if (string-equal rev "")
-			  (vc-latest-version buffer-file-name)
-			rev))
-	     (filename (concat buffer-file-name ".~" version "~")))
-	 (or (file-exists-p filename)
-	     (vc-backend-checkout buffer-file-name nil version filename))
-	 (find-file-other-window filename))
-    (vc-registration-error buffer-file-name)))
-
-;; Header-insertion code
-
-;;;###autoload
-(defun vc-insert-headers ()
-  "Insert headers in a file for use with your version-control system.
-Headers desired are inserted at the start of the buffer, and are pulled from
-the variable `vc-header-alist'."
-  (interactive)
-  (if vc-dired-mode
-      (find-file-other-window (dired-get-filename)))
-  (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
-  (save-excursion
-    (save-restriction
-      (widen)
-      (if (or (not (vc-check-headers))
-	      (y-or-n-p "Version headers already exist.  Insert another set? "))
-	  (progn
-	    (let* ((delims (cdr (assq major-mode vc-comment-alist)))
-		   (comment-start-vc (or (car delims) comment-start "#"))
-		   (comment-end-vc (or (car (cdr delims)) comment-end ""))
-		   (hdstrings (cdr (assoc (vc-backend (buffer-file-name)) vc-header-alist))))
-	      (mapcar (function (lambda (s)
-				  (insert comment-start-vc "\t" s "\t"
-					  comment-end-vc "\n")))
-		      hdstrings)
-	      (if vc-static-header-alist
-		  (mapcar (function (lambda (f)
-				      (if (string-match (car f) buffer-file-name)
-					  (insert (format (cdr f) (car hdstrings))))))
-			  vc-static-header-alist))
-	      )
-	    )))))
-
-(defun vc-clear-headers ()
-  ;; Clear all version headers in the current buffer, i.e. reset them 
-  ;; to the nonexpanded form.  Only implemented for RCS, yet.
-  ;; Don't lose point and mark during this.
-  (let ((context (vc-buffer-context)))
-    (goto-char (point-min))
-    (while (re-search-forward "\\$\\([A-Za-z]+\\): [^\\$]+\\$" nil t)
-      (replace-match "$\\1$"))
-    (vc-restore-buffer-context context)))
-
-;; The VC directory major mode.  Coopt Dired for this.
-;; All VC commands get mapped into logical equivalents.
-
-(define-derived-mode vc-dired-mode dired-mode "Dired under VC"
-  "The major mode used in VC directory buffers.  It is derived from Dired.
-All Dired commands operate normally.  Users currently locking listed files
-are listed in place of the file's owner and group.
-Keystrokes bound to VC commands will execute as though they had been called
-on a buffer attached to the file named in the current Dired buffer line."
-  (setq vc-dired-mode t))
-
-(define-key vc-dired-mode-map "\C-xv" vc-prefix-map)
-(define-key vc-dired-mode-map "g" 'vc-dired-update)
-(define-key vc-dired-mode-map "=" 'vc-diff)
-
-(defun vc-dired-state-info (file)
-  ;; Return the string that indicates the version control status
-  ;; on a VC dired line.
-  (let ((cvs-state (and (eq (vc-backend file) 'CVS)
-			(vc-cvs-status file))))
-    (if cvs-state
-	(cond ((eq cvs-state 'up-to-date) nil)
-	      ((eq cvs-state 'needs-checkout)      "patch")
-	      ((eq cvs-state 'locally-modified)    "modified")
-	      ((eq cvs-state 'needs-merge)         "merge")
-	      ((eq cvs-state 'unresolved-conflict) "conflict")
-	      ((eq cvs-state 'locally-added)       "added"))
-      (vc-locking-user file))))
-
-(defun vc-dired-reformat-line (x)
-  ;; Hack a directory-listing line, plugging in locking-user info in
-  ;; place of the user and group info.  Should have the beneficial
-  ;; side-effect of shortening the listing line.  Each call starts with
-  ;; point immediately following the dired mark area on the line to be
-  ;; hacked.
-  ;;
-  ;; Simplest possible one:
-  ;; (insert (concat x "\t")))
-  ;;
-  ;; This code, like dired, assumes UNIX -l format.
-  (let ((pos (point)) limit perm owner date-and-file)
-    (end-of-line)
-    (setq limit (point))
-    (goto-char pos)
-    (cond
-     ((or
-       (re-search-forward  ;; owner and group
-"\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[^ ]+ +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
-	  limit t)       
-       (re-search-forward  ;; only owner displayed
-"\\([drwxlts-]+ \\) *[0-9]+ \\([^ ]+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)" 
-	  limit t))
-      (setq perm          (match-string 1)
-	    owner         (match-string 2)
-	    date-and-file (match-string 3)))
-     ((re-search-forward  ;; OS/2 -l format, no links, owner, group
-"\\([drwxlts-]+ \\) *[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)"
-         limit t)
-      (setq perm          (match-string 1)
-	    date-and-file (match-string 2))))
-    (if x (setq x (concat "(" x ")")))
-    (let ((rep (substring (concat x "                 ") 0 10)))
-      (replace-match (concat perm rep date-and-file)))))
-       
-(defun vc-dired-update-line (file)
-  ;; Update the vc-dired listing line of file -- it is assumed 
-  ;; that point is already on this line.  Don't use dired-do-redisplay
-  ;; for this, because it cannot handle the way vc-dired deals with 
-  ;; subdirectories.
-  (beginning-of-line)
-  (forward-char 2)
-  (let ((start (point)))
-    (forward-line 1)
-    (beginning-of-line)
-    (delete-region start (point))
-    (insert-directory file dired-listing-switches)
-    (forward-line -1)
-    (end-of-line)
-    (delete-char (- (length file)))
-    (insert (substring file (length (expand-file-name default-directory))))
-    (goto-char start))
-  (vc-dired-reformat-line (vc-dired-state-info file)))
-
-(defun vc-dired-update (verbose)
-  (interactive "P")
-  (vc-directory default-directory verbose))
-
-;;; Note in Emacs 18 the following defun gets overridden
-;;; with the symbol 'vc-directory-18.  See below.
-;;;###autoload
-(defun vc-directory (dirname verbose)
-  "Show version-control status of the current directory and subdirectories.
-Normally it creates a Dired buffer that lists only the locked files
-in all these directories.  With a prefix argument, it lists all files."
-  (interactive "DDired under VC (directory): \nP")
-  (require 'dired)
-  (setq dirname (expand-file-name dirname))
-  ;; force a trailing slash
-  (if (not (eq (elt dirname (1- (length dirname))) ?/))
-      (setq dirname (concat dirname "/")))
-  (let (nonempty
-	(dl (length dirname))
-	(filelist nil) (statelist nil)
-	(old-dir default-directory)
-	dired-buf
-	dired-buf-mod-count)
-    (vc-file-tree-walk
-     dirname
-     (function 
-      (lambda (f)
-	(if (vc-registered f)
-	    (let ((state (vc-dired-state-info f)))
-	      (and (or verbose state)
-		   (setq filelist (cons (substring f dl) filelist))
-		   (setq statelist (cons state statelist))))))))
-    (save-window-excursion
-      (save-excursion
-	;; This uses a semi-documented feature of dired; giving a switch
-	;; argument forces the buffer to refresh each time.
-	(setq dired-buf
-	      (dired-internal-noselect
-	       (cons dirname (nreverse filelist))
-	       dired-listing-switches 'vc-dired-mode))
-	(setq nonempty (not (eq 0 (length filelist))))))
-    (switch-to-buffer dired-buf)
-    ;; Make a few modifications to the header
-    (setq buffer-read-only nil)
-    (goto-char (point-min))
-    (forward-line 1)	      ;; Skip header line
-    (let ((start (point)))    ;; Erase (but don't remove) the 
-      (end-of-line)           ;; "wildcard" line.
-      (delete-region start (point)))
-    (beginning-of-line)
-    (if nonempty
-	(progn
-	  ;; Plug the version information into the individual lines
-	  (mapcar
-	   (function
-	    (lambda (x)
-	     (forward-char 2)	;; skip dired's mark area
-	     (vc-dired-reformat-line x)
-	     (forward-line 1)))	;; go to next line
-	   (nreverse statelist))
-	  (setq buffer-read-only t)
-	  (goto-char (point-min))
-	  (dired-next-line 2)
-	  )
-      (dired-next-line 1) 
-      (insert "  ")
-      (setq buffer-read-only t)
-      (message "No files are currently %s under %s"
-	       (if verbose "registered" "locked") dirname))
-    ))
-
-;; Emacs 18 version
-(defun vc-directory-18 (verbose)
-  "Show version-control status of all files under the current directory."
-  (interactive "P")
-  (let (nonempty (dir default-directory))
-    (save-excursion
-      (set-buffer (get-buffer-create "*vc-status*"))
-      (erase-buffer)
-      (cd dir)
-      (vc-file-tree-walk
-       default-directory
-       (function (lambda (f)
-		   (if (vc-registered f)
-		       (let ((user (vc-locking-user f)))
-			 (if (or user verbose)
-			     (insert (format
-				      "%s	%s\n"
-				      (concat user) f))))))))
-      (setq nonempty (not (zerop (buffer-size)))))
-
-    (if nonempty
-	(progn
-	  (pop-to-buffer "*vc-status*" t)
-	  (goto-char (point-min))
-	  (shrink-window-if-larger-than-buffer)))
-      (message "No files are currently %s under %s"
-	       (if verbose "registered" "locked") default-directory))
-    )
-
-(or (boundp 'minor-mode-map-alist)
-    (fset 'vc-directory 'vc-directory-18))
-
-;; Named-configuration support for SCCS
-
-(defun vc-add-triple (name file rev)
-  (save-excursion
-    (find-file (expand-file-name
-		vc-name-assoc-file
-		(file-name-as-directory
-		 (expand-file-name (vc-backend-subdirectory-name file) 
-				   (file-name-directory file)))))
-    (goto-char (point-max))
-    (insert name "\t:\t" file "\t" rev "\n")
-    (basic-save-buffer)
-    (kill-buffer (current-buffer))
-    ))
-
-(defun vc-record-rename (file newname)
-  (save-excursion
-    (find-file
-     (expand-file-name
-      vc-name-assoc-file
-      (file-name-as-directory
-       (expand-file-name (vc-backend-subdirectory-name file) 
-			 (file-name-directory file)))))
-    (goto-char (point-min))
-    ;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname))
-    (while (re-search-forward (concat ":" (regexp-quote file) "$") nil t)
-      (replace-match (concat ":" newname) nil nil))
-    (basic-save-buffer)
-    (kill-buffer (current-buffer))
-    ))
-
-(defun vc-lookup-triple (file name)
-  ;; Return the numeric version corresponding to a named snapshot of file
-  ;; If name is nil or a version number string it's just passed through
-  (cond ((null name) name)
-	((let ((firstchar (aref name 0)))
-	   (and (>= firstchar ?0) (<= firstchar ?9)))
-	 name)
-	(t
-	 (save-excursion
-	   (set-buffer (get-buffer-create "*vc-info*"))
-	   (vc-insert-file
-	    (expand-file-name
-	     vc-name-assoc-file
-	     (file-name-as-directory
-	      (expand-file-name (vc-backend-subdirectory-name file) 
-				(file-name-directory file)))))
-	   (prog1
-	       (car (vc-parse-buffer
-		     (list (list (concat name "\t:\t" file "\t\\(.+\\)") 1))))
-	     (kill-buffer "*vc-info*"))))
-	 ))
-
-;; Named-configuration entry points
-
-(defun vc-snapshot-precondition ()
-  ;; Scan the tree below the current directory.
-  ;; If any files are locked, return the name of the first such file.
-  ;; (This means, neither snapshot creation nor retrieval is allowed.)
-  ;; If one or more of the files are currently visited, return `visited'.
-  ;; Otherwise, return nil.
-  (let ((status nil))
-    (catch 'vc-locked-example
-      (vc-file-tree-walk
-       default-directory
-       (function (lambda (f)
-		   (and (vc-registered f)
-			(if (vc-locking-user f) (throw 'vc-locked-example f)
-			  (if (get-file-buffer f) (setq status 'visited)))))))
-      status)))
-
-;;;###autoload
-(defun vc-create-snapshot (name)
-  "Make a snapshot called NAME.
-The snapshot is made from all registered files at or below the current
-directory.  For each file, the version level of its latest
-version becomes part of the named configuration."
-  (interactive "sNew snapshot name: ")
-  (let ((result (vc-snapshot-precondition)))
-    (if (stringp result)
-	(error "File %s is locked" result)
-      (vc-file-tree-walk
-       default-directory
-       (function (lambda (f) (and
-			      (vc-name f)
-			      (vc-backend-assign-name f name)))))
-      )))
-
-;;;###autoload
-(defun vc-retrieve-snapshot (name)
-  "Retrieve the snapshot called NAME.
-This function fails if any files are locked at or below the current directory
-Otherwise, all registered files are checked out (unlocked) at their version
-levels in the snapshot."
-  (interactive "sSnapshot name to retrieve: ")
-  (let ((result (vc-snapshot-precondition))
-	(update nil))
-    (if (stringp result)
-	(error "File %s is locked" result)
-      (if (eq result 'visited)
-	  (setq update (yes-or-no-p "Update the affected buffers? ")))
-      (vc-file-tree-walk
-       default-directory
-       (function (lambda (f) (and
-			      (vc-name f)
-			      (vc-error-occurred
-			       (vc-backend-checkout f nil name)
-			       (if update (vc-resynch-buffer f t t)))))))
-      )))
-
-;; Miscellaneous other entry points
-
-;;;###autoload
-(defun vc-print-log ()
-  "List the change log of the current buffer in a window."
-  (interactive)
-  (if vc-dired-mode
-      (set-buffer (find-file-noselect (dired-get-filename))))
-  (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
-  (if (and buffer-file-name (vc-name buffer-file-name))
-      (let ((file buffer-file-name))
-	(vc-backend-print-log file)
-	(pop-to-buffer (get-buffer-create "*vc*"))
-	(setq default-directory (file-name-directory file))
-	(goto-char (point-max)) (forward-line -1)
-	(while (looking-at "=*\n")
-	  (delete-char (- (match-end 0) (match-beginning 0)))
-	  (forward-line -1))
-	(goto-char (point-min))
-	(if (looking-at "[\b\t\n\v\f\r ]+")
-	    (delete-char (- (match-end 0) (match-beginning 0))))
-	(shrink-window-if-larger-than-buffer)
-	;; move point to the log entry for the current version
-	(and (not (eq (vc-backend file) 'SCCS))
-	     (re-search-forward
-	      ;; also match some context, for safety
-	      (concat "----\nrevision " (vc-workfile-version file)
-		      "\\(\tlocked by:.*\n\\|\n\\)date: ") nil t)
-	     ;; set the display window so that 
-	     ;; the whole log entry is displayed
-	     (let (start end lines)
-	       (beginning-of-line) (forward-line -1) (setq start (point))
-	       (if (not (re-search-forward "^----*\nrevision" nil t))
-		   (setq end (point-max))
-		 (beginning-of-line) (forward-line -1) (setq end (point)))
-	       (setq lines (count-lines start end))
-	       (cond
-		;; if the global information and this log entry fit
-		;; into the window, display from the beginning
-		((< (count-lines (point-min) end) (window-height))
-		 (goto-char (point-min))
-		 (recenter 0)
-		 (goto-char start))
-		;; if the whole entry fits into the window,
-		;; display it centered
-		((< (1+ lines) (window-height))
-		 (goto-char start)
-		 (recenter (1- (- (/ (window-height) 2) (/ lines 2)))))
-		;; otherwise (the entry is too large for the window),
-		;; display from the start
-		(t
-		 (goto-char start)
-		 (recenter 0)))))
-	)
-    (vc-registration-error buffer-file-name)
-    )
-  )
-
-;;;###autoload
-(defun vc-revert-buffer ()
-  "Revert the current buffer's file back to the latest checked-in version.
-This asks for confirmation if the buffer contents are not identical
-to that version.
-If the back-end is CVS, this will give you the most recent revision of
-the file on the branch you are editing."
-  (interactive)
-  (if vc-dired-mode
-      (find-file-other-window (dired-get-filename)))
-  (while vc-parent-buffer
-      (pop-to-buffer vc-parent-buffer))
-  (let ((file buffer-file-name)
-	;; This operation should always ask for confirmation.
-	(vc-suppress-confirm nil)
-	(obuf (current-buffer)) (changed (vc-diff nil t)))
-    (if (and changed (not (yes-or-no-p "Discard changes? ")))
-	(progn
-	  (if (and (window-dedicated-p (selected-window))
-		   (one-window-p t 'selected-frame))
-	      (make-frame-invisible (selected-frame))
-	    (delete-window))
-	  (error "Revert cancelled"))
-      (set-buffer obuf))
-    (if changed
-	(if (and (window-dedicated-p (selected-window))
-		 (one-window-p t 'selected-frame))
-	    (make-frame-invisible (selected-frame))
-	  (delete-window)))
-    (vc-backend-revert file)
-    (vc-resynch-window file t t)
-    )
-  )
-
-;;;###autoload
-(defun vc-cancel-version (norevert)
-  "Get rid of most recently checked in version of this file.
-A prefix argument means do not revert the buffer afterwards."
-  (interactive "P")
-  (if vc-dired-mode
-      (find-file-other-window (dired-get-filename)))
-  (while vc-parent-buffer
-    (pop-to-buffer vc-parent-buffer))
-  (cond 
-   ((not (vc-registered (buffer-file-name)))
-    (vc-registration-error (buffer-file-name)))
-   ((eq (vc-backend (buffer-file-name)) 'CVS)
-    (error "Unchecking files under CVS is dangerous and not supported in VC"))
-   ((vc-locking-user (buffer-file-name))
-    (error "This version is locked; use vc-revert-buffer to discard changes"))
-   ((not (vc-latest-on-branch-p (buffer-file-name)))
-    (error "This is not the latest version--VC cannot cancel it")))
-  (let* ((target (vc-workfile-version (buffer-file-name)))
-         (recent (if (vc-trunk-p target) "" (vc-branch-part target)))
-         (config (current-window-configuration)) done)
-    (if (null (yes-or-no-p (format "Remove version %s from master? " target)))
-	nil
-      (setq norevert (or norevert (not 
-           (yes-or-no-p "Revert buffer to most recent remaining version? "))))
-      (vc-backend-uncheck (buffer-file-name) target)
-      ;; Check out the most recent remaining version.  If it fails, because
-      ;; the whole branch got deleted, do a double-take and check out the
-      ;; version where the branch started.
-      (while (not done)
-        (condition-case err
-            (progn
-              (if norevert
-                  ;; Check out locked, but only to disc, and keep 
-                  ;; modifications in the buffer.
-                  (vc-backend-checkout (buffer-file-name) t recent)
-                ;; Check out unlocked, and revert buffer.
-                (vc-checkout (buffer-file-name) nil recent))
-              (setq done t))
-          ;; If the checkout fails, vc-do-command signals an error.
-          ;; We catch this error, check the reason, correct the
-          ;; version number, and try a second time.
-          (error (set-buffer "*vc*")
-                 (goto-char (point-min))
-                 (if (search-forward "no side branches present for" nil t)
-                     (progn (setq recent (vc-branch-part recent))
-                            ;; vc-do-command popped up a window with
-                            ;; the error message.  Get rid of it, by
-                            ;; restoring the old window configuration.
-                            (set-window-configuration config))
-                   ;; No, it was some other error: re-signal it.
-                   (signal (car err) (cdr err))))))
-      ;; If norevert, clear version headers and mark the buffer modified.
-      (if norevert
-          (progn
-            (set-visited-file-name (buffer-file-name))
-            (if (not vc-make-backup-files)
-                ;; inhibit backup for this buffer
-                (progn (make-local-variable 'backup-inhibited)
-                       (setq backup-inhibited t)))
-            (if (eq (vc-backend (buffer-file-name)) 'RCS)
-                (progn (setq buffer-read-only nil)
-                       (vc-clear-headers)))
-            (vc-mode-line (buffer-file-name))))
-      (message "Version %s has been removed from the master" target)
-      )))
-
-;;;###autoload
-(defun vc-rename-file (old new)
-  "Rename file OLD to NEW, and rename its master file likewise."
-  (interactive "fVC rename file: \nFRename to: ")
-  ;; There are several ways of renaming files under CVS 1.3, but they all
-  ;; have serious disadvantages.  See the FAQ (available from think.com in
-  ;; pub/cvs/).  I'd rather send the user an error, than do something he might
-  ;; consider to be wrong.  When the famous, long-awaited rename database is
-  ;; implemented things might change for the better.  This is unlikely to occur
-  ;; until CVS 2.0 is released.  --ceder 1994-01-23 21:27:51
-  (if (eq (vc-backend old) 'CVS)
-      (error "Renaming files under CVS is dangerous and not supported in VC"))
-  (let ((oldbuf (get-file-buffer old)))
-    (if (and oldbuf (buffer-modified-p oldbuf))
-	(error "Please save files before moving them"))
-    (if (get-file-buffer new)
-	(error "Already editing new file name"))
-    (if (file-exists-p new)
-	(error "New file already exists"))
-    (let ((oldmaster (vc-name old)))
-      (if oldmaster
-	  (progn
-	    (if (vc-locking-user old)
-		(error "Please check in files before moving them"))
-	    (if (or (file-symlink-p oldmaster)
-		    ;; This had FILE, I changed it to OLD. -- rms.
-		    (file-symlink-p (vc-backend-subdirectory-name old)))
-		(error "This is not a safe thing to do in the presence of symbolic links"))
-	    (rename-file
-	     oldmaster
-	     (let ((backend (vc-backend old))
-		   (newdir (or (file-name-directory new) ""))
-		   (newbase (file-name-nondirectory new)))
-	       (catch 'found
-		 (mapcar
-		  (function
-		   (lambda (s)
-		     (if (eq backend (cdr s))
-			 (let* ((newmaster (format (car s) newdir newbase))
-				(newmasterdir (file-name-directory newmaster)))
-			   (if (or (not newmasterdir)
-				   (file-directory-p newmasterdir))
-			       (throw 'found newmaster))))))
-		  vc-master-templates)
-		 (error "New file lacks a version control directory"))))))
-      (if (or (not oldmaster) (file-exists-p old))
-	  (rename-file old new)))
-; ?? Renaming a file might change its contents due to keyword expansion.
-; We should really check out a new copy if the old copy was precisely equal
-; to some checked in version.  However, testing for this is tricky....
-    (if oldbuf
-	(save-excursion
-	  (set-buffer oldbuf)
-	  (let ((buffer-read-only buffer-read-only))
-	    (set-visited-file-name new))
-	  (vc-backend new)
-	  (vc-mode-line new)
-	  (set-buffer-modified-p nil))))
-  ;; This had FILE, I changed it to OLD. -- rms.
-  (vc-backend-dispatch old
-		       (vc-record-rename old new) ;SCCS
-		       nil		;RCS
-		       nil		;CVS
-		       )
-  )
-
-;;;###autoload
-(defun vc-update-change-log (&rest args)
-  "Find change log file and add entries from recent RCS/CVS logs.
-Normally, find log entries for all registered files in the default
-directory using `rcs2log', which finds CVS logs preferentially.
-The mark is left at the end of the text prepended to the change log.
-
-With prefix arg of C-u, only find log entries for the current buffer's file.
-
-With any numeric prefix arg, find log entries for all currently visited
-files that are under version control.  This puts all the entries in the
-log for the default directory, which may not be appropriate.
-
-From a program, any arguments are assumed to be filenames and are
-passed to the `rcs2log' script after massaging to be relative to the
-default directory."
-  (interactive
-   (cond ((consp current-prefix-arg)	;C-u
-	  (list buffer-file-name))
-	 (current-prefix-arg		;Numeric argument.
-	  (let ((files nil)
-		(buffers (buffer-list))
-		file)
-	    (while buffers
-	      (setq file (buffer-file-name (car buffers)))
-	      (and file (vc-backend file)
-		   (setq files (cons file files)))
-	      (setq buffers (cdr buffers)))
-	    files))
-	 (t
-	  ;; `rcs2log' will find the relevant RCS or CVS files
-	  ;; relative to the curent directory if none supplied.
-	  nil)))
-  (let ((odefault default-directory)
-	(full-name (or add-log-full-name
-		       (user-full-name)
-		       (user-login-name)
-		       (format "uid%d" (number-to-string (user-uid)))))
-	(mailing-address (or add-log-mailing-address
-			     user-mail-address)))
-    (find-file-other-window (find-change-log))
-    (barf-if-buffer-read-only)
-    (vc-buffer-sync)
-    (undo-boundary)
-    (goto-char (point-min))
-    (push-mark)
-    (message "Computing change log entries...")
-    (message "Computing change log entries... %s"
-	     (if (eq 0 (apply 'call-process "rcs2log" nil '(t nil) nil
-			      "-u"
-			      (concat (vc-user-login-name)
-				      "\t"
-				      full-name
-				      "\t"
-				      mailing-address)
-			      (mapcar (function
-				       (lambda (f)
-					 (file-relative-name
-					  (if (file-name-absolute-p f)
-					      f
-					    (concat odefault f)))))
-				      args)))
-		 "done" "failed"))))
-
-;; Collect back-end-dependent stuff here
-
-(defun vc-backend-admin (file &optional rev comment)
-  ;; Register a file into the version-control system
-  ;; Automatically retrieves a read-only version of the file with
-  ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
-  ;; it deletes the workfile.
-  (vc-file-clearprops file)
-  (or vc-default-back-end
-      (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))
-  (message "Registering %s..." file)
-  (let ((switches
-         (if (stringp vc-register-switches)
-             (list vc-register-switches)
-           vc-register-switches))
-        (backend
-	 (cond
-	  ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end)
-	  ((file-exists-p "RCS") 'RCS)
-	  ((file-exists-p "SCCS") 'SCCS)
-	  ((file-exists-p "CVS") 'CVS)
-	  (t vc-default-back-end))))
-    (cond ((eq backend 'SCCS)
-	   (apply 'vc-do-command nil 0 "admin" file 'MASTER	;; SCCS
-                                 (and rev (concat "-r" rev))
-                                 "-fb"
-                                 (concat "-i" file)
-                                 (and comment (concat "-y" comment))
-                                 (format
-                                  (car (rassq 'SCCS vc-master-templates))
-                                  (or (file-name-directory file) "")
-                                  (file-name-nondirectory file))
-                                 switches)
-	   (delete-file file)
-	   (if vc-keep-workfiles
-	       (vc-do-command nil 0 "get" file 'MASTER)))
-	  ((eq backend 'RCS)
-	   (apply 'vc-do-command nil 0 "ci" file 'WORKFILE	;; RCS
-                                 ;; if available, use the secure registering option
-                                 (and (vc-backend-release-p 'RCS "5.6.4") "-i")
-                                 (concat (if vc-keep-workfiles "-u" "-r") rev)
-                                 (and comment (concat "-t-" comment))
-                                 switches))
-	  ((eq backend 'CVS)
-	   (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE ;; CVS
-                                 "add"
-                                 (and comment (string-match "[^\t\n ]" comment)
-                                      (concat "-m" comment))
-                                 switches)
-	   )))
-  (message "Registering %s...done" file)
-  )
-
-(defun vc-backend-checkout (file &optional writable rev workfile)
-  ;; Retrieve a copy of a saved version into a workfile
-  (let ((filename (or workfile file))
-	(file-buffer (get-file-buffer file))
-	switches)
-    (message "Checking out %s..." filename)
-    (save-excursion
-      ;; Change buffers to get local value of vc-checkout-switches.
-      (if file-buffer (set-buffer file-buffer))
-      (setq switches (if (stringp vc-checkout-switches)
-			 (list vc-checkout-switches)
-		       vc-checkout-switches))
-      ;; Save this buffer's default-directory
-      ;; and use save-excursion to make sure it is restored
-      ;; in the same buffer it was saved in.
-      (let ((default-directory default-directory))
-	(save-excursion
-	  ;; Adjust the default-directory so that the check-out creates 
-	  ;; the file in the right place.
-	  (setq default-directory (file-name-directory filename))
-	  (vc-backend-dispatch file
-	    (progn  ;; SCCS
-	      (and rev (string= rev "") (setq rev nil))
-	      (if workfile  
-		  ;; Some SCCS implementations allow checking out directly to a
-		  ;; file using the -G option, but then some don't so use the
-		  ;; least common denominator approach and use the -p option
-		  ;; ala RCS.
-		  (let ((vc-modes (logior (file-modes (vc-name file))
-					  (if writable 128 0)))
-			(failed t))
-		    (unwind-protect
-			(progn
-			  (apply 'vc-do-command
-				 nil 0 "/bin/sh" file 'MASTER "-c"
-				 ;; Some shells make the "" dummy argument into $0
-				 ;; while others use the shell's name as $0 and
-				 ;; use the "" as $1.  The if-statement
-				 ;; converts the latter case to the former.
-				 (format "if [ x\"$1\" = x ]; then shift; fi; \
-			       umask %o; exec >\"$1\" || exit; \
-			       shift; umask %o; exec get \"$@\""
-				       (logand 511 (lognot vc-modes))
-				       (logand 511 (lognot (default-file-modes))))
-				 ""		; dummy argument for shell's $0
-				 filename 
-				 (if writable "-e")
-				 "-p" 
-				 (and rev
-				      (concat "-r" (vc-lookup-triple file rev)))
-				 switches)
-			  (setq failed nil))
-		      (and failed (file-exists-p filename) 
-			   (delete-file filename))))
-		(apply 'vc-do-command nil 0 "get" file 'MASTER   ;; SCCS
-		       (if writable "-e")
-		       (and rev (concat "-r" (vc-lookup-triple file rev)))
-		       switches)
-		(vc-file-setprop file 'vc-workfile-version nil)))
-	    (if workfile  ;; RCS
-		;; RCS doesn't let us check out into arbitrary file names directly.
-		;; Use `co -p' and make stdout point to the correct file.
-		(let ((vc-modes (logior (file-modes (vc-name file))
-					(if writable 128 0)))
-		      (failed t))
-		  (unwind-protect
-		      (progn
-			(apply 'vc-do-command
-			       nil 0 "/bin/sh" file 'MASTER "-c"
-			       ;; See the SCCS case, above, regarding the
-			       ;; if-statement.
-			       (format "if [ x\"$1\" = x ]; then shift; fi; \
-			       umask %o; exec >\"$1\" || exit; \
-			       shift; umask %o; exec co \"$@\""
-				       (logand 511 (lognot vc-modes))
-				       (logand 511 (lognot (default-file-modes))))
-			       ""		; dummy argument for shell's $0
-			       filename
-			       (if writable "-l")
-			       (concat "-p" rev)
-			       switches)
-			(setq failed nil))
-		    (and failed (file-exists-p filename) (delete-file filename))))
-	      (let (new-version)
-		;; if we should go to the head of the trunk, 
-		;; clear the default branch first
-		(and rev (string= rev "") 
-		     (vc-do-command nil 0 "rcs" file 'MASTER "-b"))
-		;; now do the checkout
-		(apply 'vc-do-command
-		       nil 0 "co" file 'MASTER
-		       ;; If locking is not strict, force to overwrite
-		       ;; the writable workfile.
-		       (if (eq (vc-checkout-model file) 'implicit) "-f")
-		       (if writable "-l")
-		       (if rev (concat "-r" rev)
-			 ;; if no explicit revision was specified,
-			 ;; check out that of the working file
-			 (let ((workrev (vc-workfile-version file)))
-			   (if workrev (concat "-r" workrev)
-			     nil)))
-		       switches)
-		;; determine the new workfile version
-		(save-excursion
-		  (set-buffer "*vc*")
-		  (goto-char (point-min))
-		  (setq new-version 
-			(if (re-search-forward "^revision \\([0-9.]+\\).*\n" nil t)
-			    (buffer-substring (match-beginning 1) (match-end 1)))))
-		(vc-file-setprop file 'vc-workfile-version new-version)
-		;; if necessary, adjust the default branch
-		(and rev (not (string= rev ""))
-		     (vc-do-command nil 0 "rcs" file 'MASTER 
-			(concat "-b" (if (vc-latest-on-branch-p file)
-					 (if (vc-trunk-p new-version) nil
-					   (vc-branch-part new-version))
-				       new-version))))))
-	    (if workfile  ;; CVS
-		;; CVS is much like RCS
-		(let ((failed t))
-		  (unwind-protect
-		      (progn
-			(apply 'vc-do-command
-			       nil 0 "/bin/sh" file 'WORKFILE "-c"
-			       "exec >\"$1\" || exit; shift; exec cvs update \"$@\""
-			       ""		; dummy argument for shell's $0
-			       workfile
-			       (concat "-r" rev)
-			       "-p"
-			       switches)
-			(setq failed nil))
-		    (and failed (file-exists-p filename) (delete-file filename))))
-	      ;; default for verbose checkout: clear the sticky tag
-	      ;; so that the actual update will get the head of the trunk
-	      (and rev (string= rev "")
-		   (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
-	      ;; If a revision was specified, check that out.
-	      (if rev
-		  (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE 
-			 (and writable (eq (vc-checkout-model file) 'manual) "-w")
-			 "update"
-			 (and rev (not (string= rev ""))
-			      (concat "-r" rev))
-			 switches)
-		;; If no revision was specified, simply make the file writable.
-		(and writable 
-		     (or (eq (vc-checkout-model file) 'manual)
-			 (zerop (logand 128 (file-modes file))))
-		     (set-file-modes file (logior 128 (file-modes file)))))
-	      (if rev (vc-file-setprop file 'vc-workfile-version nil))))
-	  (cond 
-	   ((not workfile)
-	    (vc-file-clear-masterprops file)
-	    (if writable 
-		(vc-file-setprop file 'vc-locking-user (vc-user-login-name)))
-	    (vc-file-setprop file
-			     'vc-checkout-time (nth 5 (file-attributes file)))))
-	  (message "Checking out %s...done" filename))))))
-
-(defun vc-backend-logentry-check (file)
-  (vc-backend-dispatch file
-   (if (>= (buffer-size) 512)	;; SCCS
-       (progn
-	 (goto-char 512)
-	 (error
-	  "Log must be less than 512 characters; point is now at pos 512")))
-   nil    ;; RCS
-   nil)   ;; CVS
-  )
-
-(defun vc-backend-checkin (file rev comment)
-  ;; Register changes to FILE as level REV with explanatory COMMENT.
-  ;; Automatically retrieves a read-only version of the file with
-  ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
-  ;; it deletes the workfile.
-  ;;   Adaptation for RCS branch support: if this is an explicit checkin,
-  ;; or if the checkin creates a new branch, set the master file branch
-  ;; accordingly.
-  (message "Checking in %s..." file)
-  ;; "This log message intentionally left almost blank".
-  ;; RCS 5.7 gripes about white-space-only comments too.
-  (or (and comment (string-match "[^\t\n ]" comment))
-      (setq comment "*** empty log message ***"))
-  (save-excursion
-    ;; Change buffers to get local value of vc-checkin-switches.
-    (set-buffer (or (get-file-buffer file) (current-buffer)))
-    (let ((switches
-	   (if (stringp vc-checkin-switches)
-	       (list vc-checkin-switches)
-	     vc-checkin-switches)))
-      ;; Clear the master-properties.  Do that here, not at the
-      ;; end, because if the check-in fails we want them to get
-      ;; re-computed before the next try.
-      (vc-file-clear-masterprops file)
-      (vc-backend-dispatch file
-	;; SCCS
-	(progn
-	  (apply 'vc-do-command nil 0 "delta" file 'MASTER
-		 (if rev (concat "-r" rev))
-		 (concat "-y" comment)
-		 switches)
-	  (vc-file-setprop file 'vc-locking-user 'none)
-	  (vc-file-setprop file 'vc-workfile-version nil)
-	  (if vc-keep-workfiles
-	      (vc-do-command nil 0 "get" file 'MASTER))
-	  )
-	;; RCS
-	(let ((old-version (vc-workfile-version file)) new-version)
-	  (apply 'vc-do-command nil 0 "ci" file 'MASTER
-		 ;; if available, use the secure check-in option
-		 (and (vc-backend-release-p 'RCS "5.6.4") "-j")
-		 (concat (if vc-keep-workfiles "-u" "-r") rev)
-		 (concat "-m" comment)
-		 switches)
-	  (vc-file-setprop file 'vc-locking-user 'none)
-	  (vc-file-setprop file 'vc-workfile-version nil)
-
-	  ;; determine the new workfile version
-	  (set-buffer "*vc*")
-	  (goto-char (point-min))
-	  (if (or (re-search-forward 
-		   "new revision: \\([0-9.]+\\);" nil t)
-		  (re-search-forward 
-		   "reverting to previous revision \\([0-9.]+\\)" nil t))
-	      (progn (setq new-version (buffer-substring (match-beginning 1)
-							 (match-end 1)))
-		     (vc-file-setprop file 'vc-workfile-version new-version)))
-
-	  ;; if we got to a different branch, adjust the default
-	  ;; branch accordingly
-	  (cond 
-	   ((and old-version new-version
-		 (not (string= (vc-branch-part old-version)
-			       (vc-branch-part new-version))))
-	    (vc-do-command nil 0 "rcs" file 'MASTER 
-			   (if (vc-trunk-p new-version) "-b"
-			     (concat "-b" (vc-branch-part new-version))))
-	    ;; If this is an old RCS release, we might have 
-	    ;; to remove a remaining lock.
-	    (if (not (vc-backend-release-p 'RCS "5.6.2"))
-		;; exit status of 1 is also accepted.
-		;; It means that the lock was removed before.
-		(vc-do-command nil 1 "rcs" file 'MASTER 
-			       (concat "-u" old-version))))))
-	;; CVS
-	(progn
-	  ;; explicit check-in to the trunk requires a 
-	  ;; double check-in (first unexplicit) (CVS-1.3)
-	  (condition-case nil
-	      (progn
-		(if (and rev (vc-trunk-p rev))
-		    (apply 'vc-do-command nil 0 "cvs" file 'WORKFILE 
-			   "ci" "-m" "intermediate"
-			   switches))
-		(apply 'vc-do-command nil 0 "cvs" file 'WORKFILE 
-		       "ci" (if rev (concat "-r" rev))
-		       (concat "-m" comment)
-		       switches))
-	    (error (if (eq (vc-cvs-status file) 'needs-merge)
-		       ;; The CVS output will be on top of this message.
-		       (error "Type C-x 0 C-x C-q to merge in changes")
-		     (error "Check-in failed"))))
-	  ;; determine and store the new workfile version
-	  (set-buffer "*vc*")
-	  (goto-char (point-min))
-	  (if (re-search-forward 
-	       "^\\(new\\|initial\\) revision: \\([0-9.]+\\)" nil t)
-	      (vc-file-setprop file 'vc-workfile-version 
-			       (buffer-substring (match-beginning 2)
-						 (match-end 2)))
-	    (vc-file-setprop file 'vc-workfile-version nil))
-	  ;; if this was an explicit check-in, remove the sticky tag
-	  (if rev
-	      (vc-do-command nil 0 "cvs" file 'WORKFILE "update" "-A"))
-	  (vc-file-setprop file 'vc-locking-user 'none)
-	  (vc-file-setprop file 'vc-checkout-time 
-			   (nth 5 (file-attributes file)))))))
-  (message "Checking in %s...done" file))
-
-(defun vc-backend-revert (file)
-  ;; Revert file to latest checked-in version.
-  ;; (for RCS, to workfile version)
-  (message "Reverting %s..." file)
-  (vc-file-clear-masterprops file)
-  (vc-backend-dispatch
-   file
-   ;; SCCS
-   (progn
-     (vc-do-command nil 0 "unget" file 'MASTER nil)
-     (vc-do-command nil 0 "get" file 'MASTER nil))
-   ;; RCS
-   (vc-do-command nil 0 "co" file 'MASTER
-		  "-f" (concat "-u" (vc-workfile-version file)))
-   ;; CVS
-   (progn
-     (delete-file file)
-     (vc-do-command nil 0 "cvs" file 'WORKFILE "update")))
-  (vc-file-setprop file 'vc-locking-user 'none)
-  (vc-file-setprop file 'vc-checkout-time (nth 5 (file-attributes file)))
-  (message "Reverting %s...done" file)
-  )
-
-(defun vc-backend-steal (file &optional rev)
-  ;; Steal the lock on the current workfile.  Needs RCS 5.6.2 or later for -M.
-  (message "Stealing lock on %s..." file)
-  (vc-backend-dispatch file
-   (progn				;SCCS
-     (vc-do-command nil 0 "unget" file 'MASTER "-n" (if rev (concat "-r" rev)))
-     (vc-do-command nil 0 "get" file 'MASTER "-g" (if rev (concat "-r" rev)))
-     )
-   (vc-do-command nil 0 "rcs" file 'MASTER	;RCS
-		  "-M" (concat "-u" rev) (concat "-l" rev))
-   (error "You cannot steal a CVS lock; there are no CVS locks to steal") ;CVS
-   )
-  (vc-file-setprop file 'vc-locking-user (vc-user-login-name))
-  (message "Stealing lock on %s...done" file)
-  )  
-
-(defun vc-backend-uncheck (file target)
-  ;; Undo the latest checkin.
-  (message "Removing last change from %s..." file)
-  (vc-backend-dispatch file
-   (vc-do-command nil 0 "rmdel" file 'MASTER (concat "-r" target))
-   (vc-do-command nil 0 "rcs" file 'MASTER (concat "-o" target))
-   nil  ;; this is never reached under CVS
-   )
-  (message "Removing last change from %s...done" file)
-  )
-
-(defun vc-backend-print-log (file)
-  ;; Get change log associated with FILE.
-  (vc-backend-dispatch 
-   file
-   (vc-do-command nil 0 "prs" file 'MASTER)
-   (vc-do-command nil 0 "rlog" file 'MASTER)
-   (vc-do-command nil 0 "cvs" file 'WORKFILE "log")))
-
-(defun vc-backend-assign-name (file name)
-  ;; Assign to a FILE's latest version a given NAME.
-  (vc-backend-dispatch file
-   (vc-add-triple name file (vc-latest-version file))              ;; SCCS
-   (vc-do-command nil 0 "rcs" file 'MASTER (concat "-n" name ":")) ;; RCS
-   (vc-do-command nil 0 "cvs" file 'WORKFILE "tag" name)	   ;; CVS
-   )
-  )
-
-(defun vc-backend-diff (file &optional oldvers newvers cmp)
-  ;; Get a difference report between two versions of FILE.
-  ;; Get only a brief comparison report if CMP, a difference report otherwise.
-  (let ((backend (vc-backend file)))
-    (cond
-     ((eq backend 'SCCS)
-      (setq oldvers (vc-lookup-triple file oldvers))
-      (setq newvers (vc-lookup-triple file newvers)))
-     ((eq backend 'RCS)
-      (if (not oldvers) (setq oldvers (vc-workfile-version file)))
-      ;; If we know that --brief is not supported, don't try it.
-      (setq cmp (and cmp (not (eq vc-rcsdiff-knows-brief 'no))))))
-     ;; SCCS and RCS shares a lot of code.
-    (cond
-     ((or (eq backend 'SCCS) (eq backend 'RCS))
-      (let* ((command (if (eq backend 'SCCS) "vcdiff" "rcsdiff"))
-	     (mode (if (eq backend 'RCS) 'WORKFILE 'MASTER))
-	     (options (append (list (and cmp "--brief")
-				    "-q"
-				    (and oldvers (concat "-r" oldvers))
-				    (and newvers (concat "-r" newvers)))
-			      (and (not cmp)
-				   (if (listp diff-switches)
-				       diff-switches
-				     (list diff-switches)))))
-	     (status (apply 'vc-do-command "*vc-diff*" 2 
-			    command file mode options)))
-	;; If --brief didn't work, do a double-take and remember it 
-        ;; for the future.
-	(if (eq status 2)
-            (prog1
-                (apply 'vc-do-command "*vc-diff*" 1 command file 'WORKFILE
-                       (if cmp (cdr options) options))
-              (if cmp (setq vc-rcsdiff-knows-brief 'no)))
-          ;; If --brief DID work, remember that, too.
-	  (and cmp (not vc-rcsdiff-knows-brief)
-               (setq vc-rcsdiff-knows-brief 'yes))
-          status)))
-     ;; CVS is different.  
-     ((eq backend 'CVS)
-      (if (string= (vc-workfile-version file) "0") ;CVS
-	  ;; This file is added but not yet committed; there is no master file.
-	  (if (or oldvers newvers)
-	      (error "No revisions of %s exist" file)
-	    (if cmp 1 ;; file is added but not committed, 
-	              ;; we regard this as "changed".
-	      ;; diff it against /dev/null.
-	      (apply 'vc-do-command
-		     "*vc-diff*" 1 "diff" file 'WORKFILE
-		     (append (if (listp diff-switches) 
-				 diff-switches
-			       (list diff-switches)) '("/dev/null")))))
-	;; cmp is not yet implemented -- we always do a full diff.
-	(apply 'vc-do-command
-	       "*vc-diff*" 1 "cvs" file 'WORKFILE "diff"
-	       (and oldvers (concat "-r" oldvers))
-	       (and newvers (concat "-r" newvers))
-	       (if (listp diff-switches)
-		   diff-switches
-		 (list diff-switches)))))
-     (t
-      (vc-registration-error file)))))
-
-(defun vc-backend-merge-news (file)
-  ;; Merge in any new changes made to FILE.
-  (message "Merging changes into %s..." file)
-  (prog1
-      (vc-backend-dispatch 
-       file
-       (error "vc-backend-merge-news not meaningful for SCCS files") ;SCCS
-       (error "vc-backend-merge-news not meaningful for RCS files")	;RCS
-       (save-excursion  ; CVS
-	 (vc-file-clear-masterprops file)
-	 (vc-file-setprop file 'vc-workfile-version nil)
-	 (vc-file-setprop file 'vc-locking-user nil)
-	 (vc-do-command nil 0 "cvs" file 'WORKFILE "update")
-	 ;; CVS doesn't return an error code if conflicts are detected.
-	 ;; Since we want to warn the user about it (and possibly start
-	 ;; emerge later), scan the output and see if this occurred.
-	 (set-buffer (get-buffer "*vc*"))
-	 (goto-char (point-min))
-	 (if (re-search-forward "^cvs update: conflicts found in .*" nil t)
-	     1  ;; error code for caller
-	   0  ;; no conflict detected
-	   )))
-    (message "Merging changes into %s...done" file)))
-
-(defun vc-check-headers ()
-  "Check if the current file has any headers in it."
-  (interactive)
-  (save-excursion
-    (goto-char (point-min))
-    (vc-backend-dispatch buffer-file-name
-     (re-search-forward  "%[MIRLBSDHTEGUYFPQCZWA]%" nil t)	;; SCCS
-     (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t)		;; RCS
-     'RCS				;; CVS works like RCS in this regard.
-     )
-    ))
-
-;; Back-end-dependent stuff ends here.
-
-;; Set up key bindings for use while editing log messages
-
-(defun vc-log-mode ()
-  "Minor mode for driving version-control tools.
-These bindings are added to the global keymap when you enter this mode:
-\\[vc-next-action]		perform next logical version-control operation on current file
-\\[vc-register]			register current file
-\\[vc-toggle-read-only]		like next-action, but won't register files
-\\[vc-insert-headers]		insert version-control headers in current file
-\\[vc-print-log]		display change history of current file
-\\[vc-revert-buffer]		revert buffer to latest version
-\\[vc-cancel-version]		undo latest checkin
-\\[vc-diff]		show diffs between file versions
-\\[vc-version-other-window]		visit old version in another window
-\\[vc-directory]		show all files locked by any user in or below .
-\\[vc-update-change-log]		add change log entry from recent checkins
-
-While you are entering a change log message for a version, the following
-additional bindings will be in effect.
-
-\\[vc-finish-logentry]	proceed with check in, ending log message entry
-
-Whenever you do a checkin, your log comment is added to a ring of
-saved comments.  These can be recalled as follows:
-
-\\[vc-next-comment]	replace region with next message in comment ring
-\\[vc-previous-comment]	replace region with previous message in comment ring
-\\[vc-comment-search-reverse]	search backward for regexp in the comment ring
-\\[vc-comment-search-forward]	search backward for regexp in the comment ring
-
-Entry to the change-log submode calls the value of text-mode-hook, then
-the value of vc-log-mode-hook.
-
-Global user options:
-	vc-initial-comment	If non-nil, require user to enter a change
-				comment upon first checkin of the file.
-
-	vc-keep-workfiles	Non-nil value prevents workfiles from being
-				deleted when changes are checked in
-
-        vc-suppress-confirm     Suppresses some confirmation prompts,
-				notably for reversions.
-
-	vc-header-alist		Which keywords to insert when adding headers
-				with \\[vc-insert-headers].  Defaults to
-				'(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under 
-				RCS and CVS.
-
-	vc-static-header-alist	By default, version headers inserted in C files
-				get stuffed in a static string area so that
-				ident(RCS/CVS) or what(SCCS) can see them in
-				the compiled object code.  You can override
-				this by setting this variable to nil, or change
-				the header template by changing it.
-
-	vc-command-messages	if non-nil, display run messages from the
-				actual version-control utilities (this is
-				intended primarily for people hacking vc
-				itself).
-"
-  (interactive)
-  (set-syntax-table text-mode-syntax-table)
-  (use-local-map vc-log-entry-mode)
-  (setq local-abbrev-table text-mode-abbrev-table)
-  (setq major-mode 'vc-log-mode)
-  (setq mode-name "VC-Log")
-  (make-local-variable 'vc-log-file)
-  (make-local-variable 'vc-log-version)
-  (make-local-variable 'vc-comment-ring-index)
-  (set-buffer-modified-p nil)
-  (setq buffer-file-name nil)
-  (run-hooks 'text-mode-hook 'vc-log-mode-hook)
-)
-
-;; Initialization code, to be done just once at load-time
-(if vc-log-entry-mode
-    nil
-  (setq vc-log-entry-mode (make-sparse-keymap))
-  (define-key vc-log-entry-mode "\M-n" 'vc-next-comment)
-  (define-key vc-log-entry-mode "\M-p" 'vc-previous-comment)
-  (define-key vc-log-entry-mode "\M-r" 'vc-comment-search-reverse)
-  (define-key vc-log-entry-mode "\M-s" 'vc-comment-search-forward)
-  (define-key vc-log-entry-mode "\C-c\C-c" 'vc-finish-logentry)
-  )
-
-;;; These things should probably be generally available
-
-(defun vc-file-tree-walk (dirname func &rest args)
-  "Walk recursively through DIRNAME.
-Invoke FUNC f ARGS on each non-directory file f underneath it."
-  (vc-file-tree-walk-internal (expand-file-name dirname) func args)
-  (message "Traversing directory %s...done" dirname))
-
-(defun vc-file-tree-walk-internal (file func args)
-  (if (not (file-directory-p file))
-      (apply func file args)
-    (message "Traversing directory %s..." (abbreviate-file-name file))
-    (let ((dir (file-name-as-directory file)))
-      (mapcar
-       (function
-	(lambda (f) (or
-		     (string-equal f ".")
-		     (string-equal f "..")
-		     (member f vc-directory-exclusion-list)
-		     (let ((dirf (concat dir f)))
-			(or
-			 (file-symlink-p dirf) ;; Avoid possible loops
-			 (vc-file-tree-walk-internal dirf func args))))))
-       (directory-files dir)))))
-
-(provide 'vc)
-
-;;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
-;;;
-;;; These may be useful to anyone who has to debug or extend the package.
-;;; (Note that this information corresponds to versions 5.x. Some of it
-;;; might have been invalidated by the additions to support branching
-;;; and RCS keyword lookup. AS, 1995/03/24)
-;;; 
-;;; A fundamental problem in VC is that there are time windows between
-;;; vc-next-action's computations of the file's version-control state and
-;;; the actions that change it.  This is a window open to lossage in a
-;;; multi-user environment; someone else could nip in and change the state
-;;; of the master during it.
-;;; 
-;;; The performance problem is that rlog/prs calls are very expensive; we want
-;;; to avoid them as much as possible.
-;;; 
-;;; ANALYSIS:
-;;; 
-;;; The performance problem, it turns out, simplifies in practice to the
-;;; problem of making vc-locking-user fast.  The two other functions that call
-;;; prs/rlog will not be so commonly used that the slowdown is a problem; one
-;;; makes snapshots, the other deletes the calling user's last change in the
-;;; master.
-;;; 
-;;; The race condition implies that we have to either (a) lock the master
-;;; during the entire execution of vc-next-action, or (b) detect and
-;;; recover from errors resulting from dispatch on an out-of-date state.
-;;; 
-;;; Alternative (a) appears to be infeasible.  The problem is that we can't
-;;; guarantee that the lock will ever be removed.  Suppose a user starts a
-;;; checkin, the change message buffer pops up, and the user, having wandered
-;;; off to do something else, simply forgets about it?
-;;; 
-;;; Alternative (b), on the other hand, works well with a cheap way to speed up
-;;; vc-locking-user.  Usually, if a file is registered, we can read its locked/
-;;; unlocked state and its current owner from its permissions.
-;;; 
-;;; This shortcut will fail if someone has manually changed the workfile's
-;;; permissions; also if developers are munging the workfile in several
-;;; directories, with symlinks to a master (in this latter case, the
-;;; permissions shortcut will fail to detect a lock asserted from another
-;;; directory).
-;;; 
-;;; Note that these cases correspond exactly to the errors which could happen
-;;; because of a competing checkin/checkout race in between two instances of
-;;; vc-next-action.
-;;; 
-;;; For VC's purposes, a workfile/master pair may have the following states:
-;;; 
-;;; A. Unregistered.  There is a workfile, there is no master.
-;;; 
-;;; B. Registered and not locked by anyone.
-;;; 
-;;; C. Locked by calling user and unchanged.
-;;; 
-;;; D. Locked by the calling user and changed.
-;;; 
-;;; E. Locked by someone other than the calling user.
-;;; 
-;;; This makes for 25 states and 20 error conditions.  Here's the matrix:
-;;; 
-;;; VC's idea of state
-;;;  |
-;;;  V  Actual state   RCS action              SCCS action          Effect
-;;;    A  B  C  D  E
-;;;  A .  1  2  3  4   ci -u -t-          admin -fb -i<file>      initial admin
-;;;  B 5  .  6  7  8   co -l              get -e                  checkout
-;;;  C 9  10 .  11 12  co -u              unget; get              revert
-;;;  D 13 14 15 .  16  ci -u -m<comment>  delta -y<comment>; get  checkin
-;;;  E 17 18 19 20 .   rcs -u -M -l       unget -n ; get -g       steal lock
-;;; 
-;;; All commands take the master file name as a last argument (not shown).
-;;; 
-;;; In the discussion below, a "self-race" is a pathological situation in
-;;; which VC operations are being attempted simultaneously by two or more
-;;; Emacsen running under the same username.
-;;; 
-;;; The vc-next-action code has the following windows:
-;;; 
-;;; Window P:
-;;;    Between the check for existence of a master file and the call to
-;;; admin/checkin in vc-buffer-admin (apparent state A).  This window may
-;;; never close if the initial-comment feature is on.
-;;; 
-;;; Window Q:
-;;;    Between the call to vc-workfile-unchanged-p in and the immediately
-;;; following revert (apparent state C).
-;;; 
-;;; Window R:
-;;;    Between the call to vc-workfile-unchanged-p in and the following
-;;; checkin (apparent state D).  This window may never close.
-;;; 
-;;; Window S:
-;;;    Between the unlock and the immediately following checkout during a
-;;; revert operation (apparent state C).  Included in window Q.
-;;; 
-;;; Window T:
-;;;    Between vc-locking-user and the following checkout (apparent state B).
-;;; 
-;;; Window U:
-;;;    Between vc-locking-user and the following revert (apparent state C).
-;;; Includes windows Q and S.
-;;; 
-;;; Window V:
-;;;    Between vc-locking-user and the following checkin (apparent state
-;;; D).  This window may never be closed if the user fails to complete the
-;;; checkin message.  Includes window R.
-;;; 
-;;; Window W:
-;;;    Between vc-locking-user and the following steal-lock (apparent
-;;; state E).  This window may never close if the user fails to complete
-;;; the steal-lock message.  Includes window X.
-;;; 
-;;; Window X:
-;;;    Between the unlock and the immediately following re-lock during a
-;;; steal-lock operation (apparent state E).  This window may never cloce
-;;; if the user fails to complete the steal-lock message.
-;;; 
-;;; Errors:
-;;; 
-;;; Apparent state A ---
-;;;
-;;; 1. File looked unregistered but is actually registered and not locked.
-;;; 
-;;;    Potential cause: someone else's admin during window P, with
-;;; caller's admin happening before their checkout.
-;;; 
-;;;    RCS: Prior to version 5.6.4, ci fails with message
-;;;         "no lock set by <user>".  From 5.6.4 onwards, VC uses the new
-;;;         ci -i option and the message is "<file>,v: already exists".
-;;;    SCCS: admin will fail with error (ad19).
-;;; 
-;;;    We can let these errors be passed up to the user.
-;;; 
-;;; 2. File looked unregistered but is actually locked by caller, unchanged.
-;;; 
-;;;    Potential cause: self-race during window P.
-;;; 
-;;;    RCS: Prior to version 5.6.4, reverts the file to the last saved
-;;;         version and unlocks it.  From 5.6.4 onwards, VC uses the new
-;;;         ci -i option, failing with message "<file>,v: already exists".
-;;;    SCCS: will fail with error (ad19).
-;;; 
-;;;    Either of these consequences is acceptable.
-;;; 
-;;; 3. File looked unregistered but is actually locked by caller, changed.
-;;; 
-;;;    Potential cause: self-race during window P.
-;;; 
-;;;    RCS: Prior to version 5.6.4, VC registers the caller's workfile as 
-;;;         a delta with a null change comment (the -t- switch will be 
-;;;         ignored). From 5.6.4 onwards, VC uses the new ci -i option,
-;;;         failing with message "<file>,v: already exists".
-;;;    SCCS: will fail with error (ad19).
-;;; 
-;;; 4. File looked unregistered but is locked by someone else.
-;;; 
-;;;    Potential cause: someone else's admin during window P, with
-;;; caller's admin happening *after* their checkout.
-;;; 
-;;;    RCS: Prior to version 5.6.4, ci fails with a 
-;;;         "no lock set by <user>" message.  From 5.6.4 onwards, 
-;;;         VC uses the new ci -i option, failing with message 
-;;;         "<file>,v: already exists".
-;;;    SCCS: will fail with error (ad19).
-;;; 
-;;;    We can let these errors be passed up to the user.
-;;; 
-;;; Apparent state B ---
-;;;
-;;; 5. File looked registered and not locked, but is actually unregistered.
-;;; 
-;;;    Potential cause: master file got nuked during window P.
-;;; 
-;;;    RCS: will fail with "RCS/<file>: No such file or directory"
-;;;    SCCS: will fail with error ut4.
-;;; 
-;;;    We can let these errors be passed up to the user.
-;;; 
-;;; 6. File looked registered and not locked, but is actually locked by the
-;;; calling user and unchanged.
-;;; 
-;;;    Potential cause: self-race during window T.
-;;; 
-;;;    RCS: in the same directory as the previous workfile, co -l will fail
-;;; with "co error: writable foo exists; checkout aborted".  In any other
-;;; directory, checkout will succeed.
-;;;    SCCS: will fail with ge17.
-;;; 
-;;;    Either of these consequences is acceptable.
-;;; 
-;;; 7. File looked registered and not locked, but is actually locked by the
-;;; calling user and changed.
-;;; 
-;;;    As case 6.
-;;; 
-;;; 8. File looked registered and not locked, but is actually locked by another
-;;; user.
-;;; 
-;;;    Potential cause: someone else checks it out during window T.
-;;; 
-;;;    RCS: co error: revision 1.3 already locked by <user>
-;;;    SCCS: fails with ge4 (in directory) or ut7 (outside it).
-;;; 
-;;;    We can let these errors be passed up to the user.
-;;; 
-;;; Apparent state C ---
-;;;
-;;; 9. File looks locked by calling user and unchanged, but is unregistered.
-;;; 
-;;;    As case 5.
-;;; 
-;;; 10. File looks locked by calling user and unchanged, but is actually not
-;;; locked.
-;;; 
-;;;    Potential cause: a self-race in window U, or by the revert's
-;;; landing during window X of some other user's steal-lock or window S
-;;; of another user's revert.
-;;; 
-;;;    RCS: succeeds, refreshing the file from the identical version in
-;;; the master.
-;;;    SCCS: fails with error ut4 (p file nonexistent).
-;;;
-;;;    Either of these consequences is acceptable.
-;;; 
-;;; 11. File is locked by calling user.  It looks unchanged, but is actually
-;;; changed.
-;;; 
-;;;    Potential cause: the file would have to be touched by a self-race
-;;; during window Q.
-;;; 
-;;;    The revert will succeed, removing whatever changes came with
-;;; the touch.  It is theoretically possible that work could be lost.
-;;; 
-;;; 12. File looks like it's locked by the calling user and unchanged, but
-;;; it's actually locked by someone else.
-;;; 
-;;;    Potential cause: a steal-lock in window V.
-;;; 
-;;;    RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u
-;;;    SCCS: fails with error un2
-;;; 
-;;;    We can pass these errors up to the user.
-;;; 
-;;; Apparent state D ---
-;;;
-;;; 13. File looks like it's locked by the calling user and changed, but it's
-;;; actually unregistered.
-;;; 
-;;;    Potential cause: master file got nuked during window P.
-;;; 
-;;;    RCS: Prior to version 5.6.4, checks in the user's version as an 
-;;;         initial delta.  From 5.6.4 onwards, VC uses the new ci -j
-;;;         option, failing with message "no such file or directory".
-;;;    SCCS: will fail with error ut4.
-;;;
-;;;    This case is kind of nasty.  Under RCS prior to version 5.6.4,
-;;; VC may fail to detect the loss of previous version information.
-;;; 
-;;; 14. File looks like it's locked by the calling user and changed, but it's
-;;; actually unlocked.
-;;; 
-;;;    Potential cause: self-race in window V, or the checkin happening
-;;; during the window X of someone else's steal-lock or window S of
-;;; someone else's revert.
-;;; 
-;;;    RCS: ci will fail with "no lock set by <user>".
-;;;    SCCS: delta will fail with error ut4.
-;;; 
-;;; 15. File looks like it's locked by the calling user and changed, but it's
-;;; actually locked by the calling user and unchanged.
-;;; 
-;;;    Potential cause: another self-race --- a whole checkin/checkout
-;;; sequence by the calling user would have to land in window R.
-;;; 
-;;;    SCCS: checks in a redundant delta and leaves the file unlocked as usual.
-;;;    RCS: reverts to the file state as of the second user's checkin, leaving
-;;; the file unlocked.
-;;;
-;;;    It is theoretically possible that work could be lost under RCS.
-;;; 
-;;; 16. File looks like it's locked by the calling user and changed, but it's
-;;; actually locked by a different user.
-;;; 
-;;;    RCS: ci error: no lock set by <user>
-;;;    SCCS: unget will fail with error un2
-;;; 
-;;;    We can pass these errors up to the user.
-;;; 
-;;; Apparent state E ---
-;;;
-;;; 17. File looks like it's locked by some other user, but it's actually
-;;; unregistered.
-;;; 
-;;;    As case 13.
-;;; 
-;;; 18. File looks like it's locked by some other user, but it's actually
-;;; unlocked.
-;;; 
-;;;    Potential cause: someone released a lock during window W.
-;;; 
-;;;    RCS: The calling user will get the lock on the file.
-;;;    SCCS: unget -n will fail with cm4.
-;;; 
-;;;    Either of these consequences will be OK.
-;;; 
-;;; 19. File looks like it's locked by some other user, but it's actually
-;;; locked by the calling user and unchanged.
-;;; 
-;;;    Potential cause: the other user relinquishing a lock followed by
-;;; a self-race, both in window W.
-;;; 
-;;;     Under both RCS and SCCS, both unlock and lock will succeed, making
-;;; the sequence a no-op.
-;;; 
-;;; 20. File looks like it's locked by some other user, but it's actually
-;;; locked by the calling user and changed.
-;;; 
-;;;     As case 19.
-;;; 
-;;; PROBLEM CASES:
-;;; 
-;;;    In order of decreasing severity:
-;;; 
-;;;    Cases 11 and 15 are the only ones that potentially lose work.
-;;; They would require a self-race for this to happen.
-;;; 
-;;;    Case 13 in RCS loses information about previous deltas, retaining
-;;; only the information in the current workfile.  This can only happen
-;;; if the master file gets nuked in window P.
-;;; 
-;;;    Case 3 in RCS and case 15 under SCCS insert a redundant delta with
-;;; no change comment in the master.  This would require a self-race in
-;;; window P or R respectively.
-;;; 
-;;;    Cases 2, 10, 19 and 20 do extra work, but make no changes.
-;;; 
-;;;    Unfortunately, it appears to me that no recovery is possible in these
-;;; cases.  They don't yield error messages, so there's no way to tell that
-;;; a race condition has occurred.
-;;; 
-;;;    All other cases don't change either the workfile or the master, and
-;;; trigger command errors which the user will see.
-;;; 
-;;;    Thus, there is no explicit recovery code.
-
-;;; vc.el ends here
diff --git a/lisp/view.el b/lisp/view.el
deleted file mode 100644
index bbc168b6f9c..00000000000
--- a/lisp/view.el
+++ /dev/null
@@ -1,469 +0,0 @@
-;;; view.el --- peruse file or buffer without editing.
-
-;; Copyright (C) 1985, 1989, 1994, 1995 Free Software Foundation, Inc.
-
-;; Author: K. Shane Hartman
-;; 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 provides the `view' minor mode documented in the Emacs
-;; user's manual.
-
-;;; Code:
-
-;;;###autoload
-(defvar view-highlight-face 'highlight
-   "*The overlay face used for highlighting the match found by View mode search.")
-
-(defvar view-mode nil "Non-nil if View mode is enabled.")
-(make-variable-buffer-local 'view-mode)
-
-(defvar view-mode-auto-exit nil
-  "Non-nil means scrolling past the end of buffer exits View mode.
-Some commands, such as \\[view-file], set this to t locally;
-the only way to override that is to set it to nil using `view-mode-hook'.")
-
-(make-variable-buffer-local 'view-mode-auto-exit)
-
-(defvar view-old-buffer-read-only nil)
-(make-variable-buffer-local 'view-old-buffer-read-only)
-(defvar view-old-Helper-return-blurb)
-(make-variable-buffer-local 'view-old-Helper-return-blurb)
-
-(defvar view-scroll-size nil)
-(make-variable-buffer-local 'view-scroll-size)
-
-(defvar view-last-regexp nil)
-(make-variable-buffer-local 'view-last-regexp)
-
-(defvar view-exit-action nil)
-(make-variable-buffer-local 'view-exit-action)
-(defvar view-return-here nil)
-(make-variable-buffer-local 'view-return-here)
-(defvar view-exit-position nil)
-(make-variable-buffer-local 'view-exit-position)
-
-(defvar view-overlay nil
-  "Overlay used to display where a search operation found its match.
-This is local in each buffer, once it is used.")
-(make-variable-buffer-local 'view-overlay)
-
-(or (assq 'view-mode minor-mode-alist)
-    (setq minor-mode-alist
-	  (cons '(view-mode " View") minor-mode-alist)))
-
-(defvar view-mode-map nil)
-(if view-mode-map
-    nil
-  (setq view-mode-map (make-keymap))
-  ;; We used to call suppress-keymap here, but that isn't good in a minor mode.
-  ;; Self-inserting characters will beep anyway, since the buffer is read-only,
-  ;; and we should not interfere with letters that serve as useful commands.
-  (define-key view-mode-map "q" 'view-exit)
-  (define-key view-mode-map "<" 'beginning-of-buffer)
-  (define-key view-mode-map ">" 'end-of-buffer)
-  (define-key view-mode-map "\ev" 'View-scroll-lines-backward)
-  (define-key view-mode-map "\C-v" 'View-scroll-lines-forward)
-  (define-key view-mode-map " " 'View-scroll-lines-forward)
-  (define-key view-mode-map "\C-?" 'View-scroll-lines-backward)
-  (define-key view-mode-map "\n" 'View-scroll-one-more-line)
-  (define-key view-mode-map "\r" 'View-scroll-one-more-line)
-  (define-key view-mode-map "z" 'View-scroll-lines-forward-set-scroll-size)
-  (define-key view-mode-map "g" 'View-goto-line)
-  (define-key view-mode-map "=" 'what-line)
-  (define-key view-mode-map "." 'set-mark-command)
-  (define-key view-mode-map "'" 'View-back-to-mark)
-  (define-key view-mode-map "@" 'View-back-to-mark)  
-  (define-key view-mode-map "x" 'exchange-point-and-mark)
-  (define-key view-mode-map "h" 'describe-mode)
-  (define-key view-mode-map "?" 'describe-mode)
-  (define-key view-mode-map "s" 'isearch-forward)
-  (define-key view-mode-map "r" 'isearch-backward)
-  (define-key view-mode-map "/" 'View-search-regexp-forward)
-  (define-key view-mode-map "\\" 'View-search-regexp-backward)
-  ;; This conflicts with the standard binding of isearch-regexp-forward
-  (define-key view-mode-map "\e\C-s" 'View-search-regexp-forward)
-  (define-key view-mode-map "\e\C-r" 'View-search-regexp-backward)  
-  (define-key view-mode-map "n" 'View-search-last-regexp-forward)
-  (define-key view-mode-map "p" 'View-search-last-regexp-backward)
-  )
-
-(or (assq 'view-mode minor-mode-map-alist)
-    (setq minor-mode-map-alist
-	  (cons (cons 'view-mode view-mode-map) minor-mode-map-alist)))
-
-
-;;;###autoload
-(defun view-file (file-name)
-  "View FILE in View mode, returning to previous buffer when done.
-The usual Emacs commands are not available; instead,
-a special set of commands (mostly letters and punctuation)
-are defined for moving around in the buffer.
-Space scrolls forward, Delete scrolls backward.
-For list of all View commands, type ? or h while viewing.
-
-This command runs the normal hook `view-mode-hook'."
-  (interactive "fView file: ")
-  (let ((old-buf (current-buffer))
-	(had-a-buf (get-file-buffer file-name))
-	(buf-to-view (find-file-noselect file-name)))
-    ;; This used to pass t as second argument,
-    ;; but then the buffer did not show up in the Buffers menu.
-    (switch-to-buffer buf-to-view had-a-buf)
-    (view-mode-enter old-buf
-		     (and (not had-a-buf) (not (buffer-modified-p buf-to-view))
-			  'kill-buffer))))
-
-;;;###autoload
-(defun view-file-other-window (file-name)
-  "View FILE in View mode in other window.
-Return to previous buffer when done.
-The usual Emacs commands are not available; instead,
-a special set of commands (mostly letters and punctuation)
-are defined for moving around in the buffer.
-Space scrolls forward, Delete scrolls backward.
-For list of all View commands, type ? or h while viewing.
-
-This command runs the normal hook `view-mode-hook'."
-  (interactive "fView file: ")
-  (let ((old-arrangement (current-window-configuration))
-	(had-a-buf (get-file-buffer file-name))
-	(buf-to-view (find-file-noselect file-name)))
-    (switch-to-buffer-other-window buf-to-view)
-    (view-mode-enter old-arrangement
-		     (and (not had-a-buf) (not (buffer-modified-p buf-to-view))
-			  'kill-buffer))))
-
-;;;###autoload
-(defun view-buffer (buffer-name)
-  "View BUFFER in View mode, returning to previous buffer when done.
-The usual Emacs commands are not available; instead,
-a special set of commands (mostly letters and punctuation)
-are defined for moving around in the buffer.
-Space scrolls forward, Delete scrolls backward.
-For list of all View commands, type ? or h while viewing.
-
-This command runs the normal hook `view-mode-hook'."
-  (interactive "bView buffer: ")
-  (let ((old-buf (current-buffer)))
-    (switch-to-buffer buffer-name t)
-    (view-mode-enter old-buf nil)))
-
-;;;###autoload
-(defun view-buffer-other-window (buffer-name not-return)
-  "View BUFFER in View mode in another window.
-Return to previous buffer when done, unless NOT-RETURN is non-nil.
-
-The usual Emacs commands are not available in View mode; instead,
-a special set of commands (mostly letters and punctuation)
-are defined for moving around in the buffer.
-Space scrolls forward, Delete scrolls backward.
-For list of all View commands, type ? or h while viewing.
-
-This command runs the normal hook `view-mode-hook'."
-  (interactive "bView buffer:\nP")
-  (let ((return-to (and not-return (current-window-configuration))))
-    (switch-to-buffer-other-window buffer-name)
-    (view-mode-enter return-to)))
-
-;;;###autoload
-(defun view-mode (&optional arg)
-  "Toggle View mode.
-With a prefix argument, turn View mode on if the argument is >= zero
-and off if it is not.
-
-If you use this function to turn on View mode, then subsequently
-\"exiting\" View mode does nothing except turn View mode off.  The
-other way to turn View mode on is by calling `view-mode-enter';
-that is what Lisp programs usually use.
-
-Letters do not insert themselves.  Instead these commands are provided.
-Most commands take prefix arguments.  Commands dealing with lines
-default to \"scroll size\" lines (initially size of window).
-Search commands default to a repeat count of one.
-
-M-< or <	move to beginning of buffer.
-M-> or >	move to end of buffer.
-C-v or Space	scroll forward lines.
-M-v or DEL	scroll backward lines.
-CR or LF	scroll forward one line (backward with prefix argument).
-z		like Space except set number of lines for further
-		   scrolling commands to scroll by.
-C-u and Digits	provide prefix arguments.  `-' denotes negative argument.
-=		prints the current line number.
-g		goes to line given by prefix argument.
-/ or M-C-s	searches forward for regular expression
-\\ or M-C-r	searches backward for regular expression.
-n		searches forward for last regular expression.
-p		searches backward for last regular expression.
-C-@ or .	set the mark.
-x		exchanges point and mark.
-C-s or s	do forward incremental search.
-C-r or r	do reverse incremental search.
-@ or '		return to mark and pops mark ring.
-		  Mark ring is pushed at start of every
-		  successful search and when jump to line to occurs.
-		  The mark is set on jump to buffer start or end.
-? or h		provide help message (list of commands).
-\\[help-command]		provides help (list of commands or description of a command).
-C-n		moves down lines vertically.
-C-p		moves upward lines vertically.
-C-l		recenters the screen.
-q		exit view-mode and return to previous buffer."
-  (interactive "P")
-  (setq view-mode
-	(if (null arg)
-	    (not view-mode)
-	  (> (prefix-numeric-value arg) 0)))
-  (force-mode-line-update))
-
-(defun view-mode-enter (&optional prev-buffer action)
-  "Enter View mode, a Minor mode for viewing text but not editing it.
-See the function `view-mode' for more details.
-
-This function runs the normal hook `view-mode-hook'.
-
-\\{view-mode-map}"
-;  Not interactive because dangerous things happen
-;  if you call it without passing a buffer as argument
-;  and they are not easy to fix.
-;  (interactive)
-  (setq view-old-buffer-read-only buffer-read-only)
-  (setq view-old-Helper-return-blurb
-	(and (boundp 'Helper-return-blurb) Helper-return-blurb))
-
-  ;; Enable view-exit to make use of the data we just saved
-  ;; and to perform the exit action.
-  (setq view-mode-auto-exit t)
-
-  (setq buffer-read-only t)
-  (setq view-mode t)
-  (setq Helper-return-blurb
-	(format "continue viewing %s"
-		(if (buffer-file-name)
-		    (file-name-nondirectory (buffer-file-name))
-		    (buffer-name))))
-
-  (setq view-exit-action action)
-  (setq view-return-here prev-buffer)
-  (setq view-exit-position (point-marker))
-
-  (beginning-of-line)
-  (setq goal-column nil)
-
-  (run-hooks 'view-mode-hook)
-  (message "%s"
-     (substitute-command-keys
-      "Type \\[help-command] for help, \\[describe-mode] for commands, \\[view-exit] to quit.")))
-
-(defun view-exit ()
-  "Exit from view-mode.
-If you viewed an existing buffer, that buffer returns to its previous mode.
-If you viewed a file that was not present in Emacs, its buffer is killed."
-  (interactive)
-  (setq view-mode nil)
-  (and view-overlay (delete-overlay view-overlay))
-  (force-mode-line-update)
-  (cond (view-mode-auto-exit
-	 (setq buffer-read-only view-old-buffer-read-only)
-	 (setq view-mode-auto-exit nil)
-
-	 (goto-char view-exit-position)
-	 (set-marker view-exit-position nil)
-
-	 ;; Now do something to the buffer that we were viewing
-	 ;; (such as kill it).
-	 (let ((viewed-buffer (current-buffer))
-	       (action view-exit-action))
-	   (cond
-	    ((bufferp view-return-here)
-	     (switch-to-buffer view-return-here))
-	    ((window-configuration-p view-return-here)
-	     (set-window-configuration view-return-here)))
-	   (if action (funcall action viewed-buffer))))))
-
-(defun view-window-size () (1- (window-height)))
-
-(defun view-scroll-size ()
-  (min (view-window-size) (or view-scroll-size (view-window-size))))
-
-(defvar view-mode-hook nil
-  "Normal hook run when starting to view a buffer or file.")
-
-;(defun view-last-command (&optional who what)
-;  (setq view-last-command-entry this-command)
-;  (setq view-last-command who)
-;  (setq view-last-command-argument what))
-
-;(defun View-repeat-last-command ()
-;  "Repeat last command issued in View mode."
-;  (interactive)
-;  (if (and view-last-command
-;	   (eq view-last-command-entry last-command))
-;      (funcall view-last-command view-last-command-argument))
-;  (setq this-command view-last-command-entry))
-
-(defun View-goto-line (line)
-  "Move to line LINE in View mode.
-Display is centered at LINE.  Sets mark at starting position and pushes
-mark ring."
-  (interactive "p")
-  (push-mark)
-  (goto-line line)
-  (recenter (/ (view-window-size) 2)))
-
-(defun View-scroll-lines-forward (&optional lines)
-  "Scroll forward in View mode, or exit if end of text is visible.
-No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size].
-Arg is number of lines to scroll."
-  (interactive "P")
-  (setq lines
-	(if lines (prefix-numeric-value lines)
-	  (view-scroll-size)))
-  (if (and (pos-visible-in-window-p (point-max))
-	   ;; Allow scrolling backward at the end of the buffer.
-	   (> lines 0)
-	   view-mode-auto-exit)
-      (view-exit)
-    ;; (view-last-command 'View-scroll-lines-forward lines)
-    (if (>= lines (view-window-size))
-	(scroll-up nil)
-      (if (>= (- lines) (view-window-size))
-	  (scroll-down nil)
-	(scroll-up lines)))
-    (cond ((pos-visible-in-window-p (point-max))
-	   (goto-char (point-max))
-	   (message "%s"
-		    (substitute-command-keys
-		     "End.  Type \\[view-exit] to quit viewing."))))
-    (move-to-window-line -1)
-    (beginning-of-line)))
-
-(defun View-scroll-lines-forward-set-scroll-size (&optional lines)
-  "Scroll forward LINES lines in View mode, setting the \"scroll size\".
-This is the number of lines which \\[View-scroll-lines-forward] and \\[View-scroll-lines-backward] scroll by default.
-The absolute value of LINES is used, so this command can be used to scroll
-backwards (but \"scroll size\" is always positive).  If LINES is greater than
-window height or omitted, then window height is assumed.  If LINES is less
-than window height then scrolling context is provided from previous screen."
-  (interactive "P")
-  (if (not lines)
-      (setq view-scroll-size (view-window-size))
-    (setq lines (prefix-numeric-value lines))
-    (setq view-scroll-size
-	  (min (if (> lines 0) lines (- lines)) (view-window-size))))
-  (View-scroll-lines-forward lines))
-
-(defun View-scroll-one-more-line (&optional arg)
-  "Scroll one more line up in View mode.
-With ARG scroll one line down."
-  (interactive "P")
-  (View-scroll-lines-forward (if (not arg) 1 -1)))
-
-(defun View-scroll-lines-backward (&optional lines)
-  "Scroll backward in View mode.
-No arg means whole window full, or number of lines set by \\[View-scroll-lines-forward-set-scroll-size].
-Arg is number of lines to scroll."
-  (interactive "P")
-  (View-scroll-lines-forward (if lines
-				 (- (prefix-numeric-value lines))
-			       (- (view-scroll-size)))))
-  
-(defun View-search-regexp-forward (n regexp)
-  "Search forward for Nth occurrence of REGEXP.
-Displays line found at center of window.  REGEXP is remembered for
-searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward].  Sets mark at starting position and pushes mark ring.
-
-The variable `view-highlight-face' controls the face that is used
-for highlighting the match that is found."
-  (interactive "p\nsSearch forward (regexp): ")
-;;;(view-last-command 'View-search-last-regexp-forward n)
-  (view-search n (if (equal regexp "") view-last-regexp regexp)))
-
-(defun View-search-regexp-backward (n regexp)
-  "Search backward from window start for Nth instance of REGEXP.
-Displays line found at center of window.  REGEXP is remembered for
-searching with \\[View-search-last-regexp-forward] and \\[View-search-last-regexp-backward].  Sets mark at starting position and pushes mark ring.
-
-The variable `view-highlight-face' controls the face that is used
-for highlighting the match that is found."
-  (interactive "p\nsSearch backward (regexp): ")
-  (View-search-regexp-forward (- n)
-			      (if (equal regexp "") view-last-regexp regexp)))
-
-(defun View-search-last-regexp-forward (n)
-  "Search forward from window end for Nth instance of last regexp.
-Displays line found at center of window.  Sets mark at starting position
-and pushes mark ring.
-
-The variable `view-highlight-face' controls the face that is used
-for highlighting the match that is found."
-  (interactive "p")
-  (if view-last-regexp
-      (View-search-regexp-forward n view-last-regexp)
-    (error "No previous View-mode search")))
-
-(defun View-search-last-regexp-backward (n)
-  "Search backward from window start for Nth instance of last regexp.
-Displays line found at center of window.  Sets mark at starting position and
-pushes mark ring.
-
-The variable `view-highlight-face' controls the face that is used
-for highlighting the match that is found."
-  (interactive "p")
-  (if view-last-regexp
-      (View-search-regexp-backward n view-last-regexp)
-    (error "No previous View-mode search")))
-
-(defun View-back-to-mark (&optional ignore)
-  "Return to last mark set in View mode, else beginning of file.
-Displays line at center of window.  Pops mark ring so successive
-invocations return to earlier marks."
-  (interactive)
-  (goto-char (or (mark t) (point-min)))
-  (pop-mark)
-  (recenter (/ (view-window-size) 2)))
-	     
-(defun view-search (times regexp)
-  (setq view-last-regexp regexp)
-  (let (where)
-    (save-excursion
-      (move-to-window-line (if (< times 0) 0 -1))
-      (if (re-search-forward regexp nil t times)
-	  (setq where (point))))
-    (if where
-	(progn
-	  (push-mark)
-	  (goto-char where)
-	  (if view-overlay
-	      (move-overlay view-overlay (match-beginning 0) (match-end 0))
-	    (setq view-overlay
-		  (make-overlay (match-beginning 0) (match-end 0))))
-	  (overlay-put view-overlay 'face view-highlight-face)
-	  (beginning-of-line)
-	  (recenter (/ (view-window-size) 2)))
-      (message "Can't find occurrence %d of %s" times regexp)
-      (sit-for 4))))
-
-
-(provide 'view)
-
-;;; view.el ends here
diff --git a/lisp/vms-patch.el b/lisp/vms-patch.el
deleted file mode 100644
index 41dcd99fbcb..00000000000
--- a/lisp/vms-patch.el
+++ /dev/null
@@ -1,192 +0,0 @@
-;;; vms-patch.el --- override parts of files.el for VMS.
-
-;; Copyright (C) 1986, 1992 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: vms
-
-;; 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.
-
-;;; Code:
-
-;;; Functions that need redefinition
-
-;;; VMS file names are upper case, but buffer names are more
-;;; convenient in lower case.
-
-(defun create-file-buffer (filename)
-  "Create a suitably named buffer for visiting FILENAME, and return it.
-FILENAME (sans directory) is used unchanged if that name is free;
-otherwise a string <2> or <3> or ... is appended to get an unused name."
-  (generate-new-buffer (downcase (file-name-nondirectory filename))))
-
-;;; Given a string FN, return a similar name which is a legal VMS filename.
-;;; This is used to avoid invalid auto save file names.
-(defun make-legal-file-name (fn)
-  (setq fn (copy-sequence fn))
-  (let ((dot nil) (indx 0) (len (length fn)) chr)
-    (while (< indx len)
-      (setq chr (aref fn indx))
-      (cond
-       ((eq chr ?.) (if dot (aset fn indx ?_) (setq dot t)))
-       ((not (or (and (>= chr ?a) (<= chr ?z)) (and (>= chr ?A) (<= chr ?Z))
-		 (and (>= chr ?0) (<= chr ?9))
-		 (eq chr ?$) (eq chr ?_) (and (eq chr ?-) (> indx 0))))
-	(aset fn indx ?_)))
-      (setq indx (1+ indx))))
-  fn)
-
-;;; Auto save filesnames start with _$ and end with $.
-
-(defun make-auto-save-file-name ()
-  "Return file name to use for auto-saves of current buffer.
-This function does not consider `auto-save-visited-file-name';
-the caller should check that before calling this function.
-This is a separate function so that your `.emacs' file or the site's
-`site-init.el' can redefine it.
-See also `auto-save-file-name-p'."
-  (if buffer-file-name
-      (concat (file-name-directory buffer-file-name)
-	      "_$"
-	      (file-name-nondirectory buffer-file-name)
-	      "$")
-    (expand-file-name (concat "_$_" (make-legal-file-name (buffer-name)) "$"))))
-
-(defun auto-save-file-name-p (filename)
-  "Return t if FILENAME can be yielded by `make-auto-save-file-name'.
-FILENAME should lack slashes.
-This is a separate function so that your `.emacs' file or the site's
-`site-init.el' can redefine it."
-  (string-match "^_\\$.*\\$" filename))
-
-;;;
-;;; This goes along with kepteditor.com which defines these logicals
-;;; If EMACS_COMMAND_ARGS is defined, it supersedes EMACS_FILE_NAME,
-;;;   which is probably set up incorrectly anyway.
-;;; The function command-line-again is a kludge, but it does the job.
-;;;
-(defun vms-suspend-resume-hook ()
-  "When resuming suspended Emacs, check for file to be found.
-If the logical name `EMACS_FILE_NAME' is defined, `find-file' that file."
-  (let ((file (vms-system-info "LOGICAL" "EMACS_FILE_NAME"))
-	(args (vms-system-info "LOGICAL" "EMACS_COMMAND_ARGS"))
-	(line (vms-system-info "LOGICAL" "EMACS_FILE_LINE")))
-    (if (not args)
-	(if file
-	    (progn (find-file file)
-		   (if line (goto-line (string-to-int line)))))
-      (cd (file-name-directory file))
-      (vms-command-line-again))))
-
-(setq suspend-resume-hook 'vms-suspend-resume-hook)
-
-(defun vms-suspend-hook ()
-  "Don't allow suspending if logical name `DONT_SUSPEND_EMACS' is defined."
-  (if (vms-system-info "LOGICAL" "DONT_SUSPEND_EMACS")
-      (error "Can't suspend this emacs"))
-  nil)
-
-(setq suspend-hook 'vms-suspend-hook)
-
-;;;
-;;; A kludge that allows reprocessing of the command line.  This is mostly
-;;;   to allow a spawned VMS mail process to do something reasonable when
-;;;   used in conjunction with the modifications to sysdep.c that allow
-;;;   Emacs to attach to a "foster" parent.
-;;;
-(defun vms-command-line-again ()
-  "Reprocess command line arguments.  VMS specific.
-Command line arguments are initialized from the logical EMACS_COMMAND_ARGS
-which is defined by kepteditor.com.  On VMS this allows attaching to a
-spawned Emacs and doing things like \"emacs -l myfile.el -f doit\""
-  (let* ((args (downcase (vms-system-info "LOGICAL" "EMACS_COMMAND_ARGS")))
-	 (command-line-args (list "emacs"))
-	 (beg 0)
-	 (end 0)
-	 (len (length args))
-	 this-char)
-    (if args
-	(progn
-;;; replace non-printable stuff with spaces
-	  (while (< beg (length args))
-	    (if (or (> 33 (setq this-char (aref args beg)))
-		    (< 127 this-char))
-		(aset args beg 32))
-	    (setq beg (1+ beg)))
-	  (setq beg (1- (length args)))
-	  (while (= 32 (aref args beg)) (setq beg (1- beg)))
-	  (setq args (substring args 0 (1+ beg)))
-	  (setq beg 0)
-;;; now start parsing args
-	  (while (< beg (length args))
-	    (while (and (< beg (length args))
-			(or (> 33 (setq this-char (aref args beg)))
-			    (< 127 this-char))
-			(setq beg (1+ beg))))
-	    (setq end (1+ beg))
-	    (while (and (< end (length args))
-			(< 32 (setq this-char (aref args end)))
-			(> 127 this-char))
-	      (setq end (1+ end)))
-	    (setq command-line-args (append 
-				     command-line-args
-				     (list (substring args beg end))))
-	    (setq beg (1+ end)))
-	  (command-line)))))
-
-(defun vms-read-directory (dirname switches buffer)
-  (save-excursion
-    (set-buffer buffer)
-    (subprocess-command-to-buffer
-     (concat "DIRECTORY " switches " " dirname)
-     buffer)
-    (goto-char (point-min))
-    ;; Remove all the trailing blanks.
-    (while (search-forward " \n")
-      (forward-char -1)
-      (delete-horizontal-space))
-    (goto-char (point-min))))
-
-(setq dired-listing-switches
-      "/SIZE/DATE/OWNER/WIDTH=(FILENAME=32,SIZE=5)")
-
-(setq print-region-function
-      '(lambda (start end command ign1 ign2 ign3 &rest switches)
-	 (write-region start end "sys$login:delete-me.txt")
-	 (send-command-to-subprocess
-	  1
-	  (concat command
-		  " sys$login:delete-me.txt/name=\"GNUprintbuffer\" "
-		  (mapconcat 'identity switches " "))
-	  nil nil nil)))
-
-;;;
-;;; Fuctions for using Emacs as a VMS Mail editor
-;;;
-(autoload 'vms-pmail-setup "vms-pmail"
-  "Set up file assuming use by VMS Mail utility.
-The buffer is put into text-mode, auto-save is turned off and the
-following bindings are established.
-
-\\[vms-pmail-save-and-exit]	vms-pmail-save-and-exit
-\\[vms-pmail-abort]	vms-pmail-abort
-
-All other Emacs commands are still available."
-  t)
-
-;;; vms-patch.el ends here
diff --git a/lisp/vmsproc.el b/lisp/vmsproc.el
deleted file mode 100644
index 020dcb304d0..00000000000
--- a/lisp/vmsproc.el
+++ /dev/null
@@ -1,146 +0,0 @@
-;;; vmsproc.el --- run asynchronous VMS subprocesses under Emacs
-
-;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; Author: Mukesh Prasad
-;; Maintainer: FSF
-;; Keywords: vms
-
-;; 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.
-
-;;; Code:
-
-(defvar display-subprocess-window nil
-  "If non-nil, the subprocess window is displayed whenever input is received.")
-
-(defvar command-prefix-string "$ "
-  "String to insert to distinguish commands entered by user.")
-
-(defvar subprocess-running nil)
-(defvar command-mode-map nil)
-
-(if command-mode-map
-    nil
-  (setq command-mode-map (make-sparse-keymap))
-  (define-key command-mode-map "\C-m" 'command-send-input)
-  (define-key command-mode-map "\C-u" 'command-kill-line))
-
-(defun subprocess-input (name str)
-  "Handles input from a subprocess.  Called by Emacs."
-  (if display-subprocess-window
-      (display-buffer subprocess-buf))
-  (let ((old-buffer (current-buffer)))
-    (set-buffer subprocess-buf)
-    (goto-char (point-max))
-    (insert str)
-    (insert ?\n)
-    (set-buffer old-buffer)))
-
-(defun subprocess-exit (name)
-  "Called by Emacs upon subprocess exit."
-  (setq subprocess-running nil))
-
-(defun start-subprocess ()
-  "Spawns an asynchronous subprocess with output redirected to
-the buffer *COMMAND*.  Within this buffer, use C-m to send
-the last line to the subprocess or to bring another line to
-the end."
-  (if subprocess-running
-      (return t))
-  (setq subprocess-buf (get-buffer-create "*COMMAND*"))
-  (save-excursion
-    (set-buffer subprocess-buf)
-    (use-local-map command-mode-map))
-  (setq subprocess-running (spawn-subprocess 1 'subprocess-input
-					     'subprocess-exit))
-  ;; Initialize subprocess so it doesn't panic and die upon
-  ;; encountering the first error.
-  (and subprocess-running
-       (send-command-to-subprocess 1 "ON SEVERE_ERROR THEN CONTINUE")))
-
-(defun subprocess-command-to-buffer (command buffer)
-  "Execute COMMAND and redirect output into BUFFER."
-  (let (cmd args)
-    (setq cmd (substring command 0 (string-match " " command)))
-    (setq args (substring command (string-match " " command)))
-    (call-process cmd nil buffer nil "*dcl*" args)))
-;BUGS: only the output up to the end of the first image activation is trapped.
-;  (if (not subprocess-running)
-;      (start-subprocess))
-;  (save-excursion
-;    (set-buffer buffer)
-;    (let ((output-filename (concat "SYS$SCRATCH:OUTPUT-FOR-"
-;				   (getenv "USER") ".LISTING")))
-;      (while (file-exists-p output-filename)
-;	(delete-file output-filename))
-;      (define-logical-name "SYS$OUTPUT" (concat output-filename "-NEW"))
-;      (send-command-to-subprocess 1 command)
-;      (send-command-to-subprocess 1 (concat
-;				     "RENAME " output-filename
-;				     "-NEW " output-filename))
-;      (while (not (file-exists-p output-filename))
-;	(sleep-for 1))
-;      (define-logical-name "SYS$OUTPUT" nil)
-;      (insert-file output-filename)
-;      (delete-file output-filename))))
-
-(defun subprocess-command ()
-  "Starts asynchronous subprocess if not running and switches to its window."
-  (interactive)
-  (if (not subprocess-running)
-      (start-subprocess))
-  (and subprocess-running
-       (progn (pop-to-buffer subprocess-buf) (goto-char (point-max)))))
-
-(defun command-send-input ()
-  "If at last line of buffer, sends the current line to
-the spawned subprocess.  Otherwise brings back current
-line to the last line for resubmission."
-  (interactive)
-  (beginning-of-line)
-  (let ((current-line (buffer-substring (point)
-                                        (progn (end-of-line) (point)))))
-    (if (eobp)
-	(progn
-	  (if (not subprocess-running)
-	      (start-subprocess))
-	  (if subprocess-running
-	      (progn
-		(beginning-of-line)
-		(send-command-to-subprocess 1 current-line)
-		(if command-prefix-string
-		    (progn (beginning-of-line) (insert command-prefix-string)))
-		(next-line 1))))
-      ;; else -- if not at last line in buffer
-      (end-of-buffer)
-      (backward-char)
-      (next-line 1)
-      (if (string-equal command-prefix-string
-			(substring current-line 0 (length command-prefix-string)))
-	  (insert (substring current-line (length command-prefix-string)))
-	(insert current-line)))))
-
-(defun command-kill-line()
-  "Kills the current line.  Used in command mode."
-  (interactive)
-  (beginning-of-line)
-  (kill-line))
-
-(define-key esc-map "$" 'subprocess-command)
-
-;;; vmsproc.el ends here
diff --git a/lisp/vt-control.el b/lisp/vt-control.el
deleted file mode 100644
index 23ccb957988..00000000000
--- a/lisp/vt-control.el
+++ /dev/null
@@ -1,107 +0,0 @@
-;;; vt-control.el --- Common VTxxx control functions
-
-;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
-
-;; Author: Rob Riepel <riepel@networking.stanford.edu>
-;; Maintainer: Rob Riepel <riepel@networking.stanford.edu>
-;; Keywords: terminals
-
-;; 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:
-
-;;  The functions contained in this file send various VT control codes
-;;  to the terminal where emacs is running.  The following functions are
-;;  available.
-
-;;    Function           Action
-
-;;    vt-wide            set wide screen (132 characters)
-;;    vt-narrow          set narrow screen (80 characters)
-;;    vt-toggle-screen   toggle wide/narrow screen
-;;    vt-keypad-on       set applications keypad on
-;;    vt-keypad-off      set applications keypad off
-;;    vt-numlock         toggle applications keypad on/off
-
-;;; Usage:
-
-;;  To use enable these functions, simply load this file.
-
-;;  Note: vt-control makes no effort to determine how the terminal is
-;;        initially set.  It assumes the terminal starts with a width
-;;        of 80 characters and the applications keypad enabled.  Nor
-;;        does vt-control try to restore the terminal when emacs is
-;;        killed or suspended.
-
-;;; Code:
-
-
-;;;  Global variables
-
-(defvar vt-applications-keypad-p t
-  "If non-nil, keypad is in applications mode.")
-
-(defvar vt-wide-p nil
-  "If non-nil, the screen is 132 characters wide.")
-
-
-;;;  Screen width functions.
-
-(defun vt-wide nil
-  "Set the screen 132 characters wide."
-  (interactive)
-  (send-string-to-terminal "\e[?3h")
-  (set-screen-width 132)
-  (setq vt-wide-p t))
-
-(defun vt-narrow nil
-  "Set the screen 80 characters wide."
-  (interactive)
-  (send-string-to-terminal "\e[?3l")
-  (set-screen-width 80)
-  (setq vt-wide-p nil))
-
-(defun vt-toggle-screen nil
-  "Toggle between 80 and 132 character screen width."
-  (interactive)
-  (if vt-wide-p (vt-narrow) (vt-wide)))
-
-
-;;;  Applications keypad functions.
-
-(defun vt-keypad-on (&optional tell)
-  "Turn on the VT applications keypad."
-  (interactive)
-  (send-string-to-terminal "\e=")
-  (setq vt-applications-keypad-p t)
-  (if (or tell (interactive-p)) (message "Applications keypad enabled.")))
-
-(defun vt-keypad-off (&optional tell)
-  "Turn off the VT applications keypad."
-  (interactive "p")
-  (send-string-to-terminal "\e>")
-  (setq vt-applications-keypad-p nil)
-  (if (or tell (interactive-p)) (message "Applications keypad disabled.")))
-
-(defun vt-numlock nil
-  "Toggle VT application keypad on and off."
-  (interactive)
-  (if vt-applications-keypad-p (vt-keypad-off (interactive-p))
-    (vt-keypad-on (interactive-p))))
-
-;;; vt-control.el ends here
diff --git a/lisp/vt100-led.el b/lisp/vt100-led.el
deleted file mode 100644
index 17d3e3a53e7..00000000000
--- a/lisp/vt100-led.el
+++ /dev/null
@@ -1,68 +0,0 @@
-;;; vt100-led.el --- functions for LED control on VT-100 terminals & clones.
-
-;; Copyright (C) 1988 Free Software Foundation, Inc.
-
-;; Author: Howard Gayle
-;; Maintainer: FSF
-;; Keywords: hardware
-
-;; 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.
-
-;;; Code:
-
-(defvar led-state (make-vector 5 nil)
-   "The internal state of the LEDs.  Choices are nil, t, `flash.
-Element 0 is not used.")
-
-(defun led-flash (l)
-  "Flash LED l."
-  (aset led-state l 'flash)
-  (led-update))
-
-(defun led-off (&optional l)
-  "Turn off vt100 led number L.  With no argument, turn them all off."
-  (interactive "P")
-  (if l
-      (aset led-state (prefix-numeric-value l) nil)
-    (fillarray led-state nil))
-  (led-update))
-
-(defun led-on (l)
-  "Turn on LED l."
-  (aset led-state l t)
-  (led-update))
-
-(defun led-update ()
-  "Update the terminal's LEDs to reflect the internal state."
-  (let ((f "\e[?0")			; String to flash.
-	(o "\e[0")			; String for steady on.
-	(l 1))				; Current LED number.
-    (while (/= l 5)
-      (let ((s (aref led-state l)))
-	(cond
-	 ((eq s 'flash)
-	  (setq f (concat f ";" (int-to-string l))))
-	 (s
-	  (setq o (concat o ";" (int-to-string l))))))
-      (setq l (1+ l)))
-    (setq o (concat o "q" f "t"))
-    (send-string-to-terminal o)))
-
-(provide 'vt100-led)
-
-;;; vt100-led.el ends here
diff --git a/lisp/w32-fns.el b/lisp/w32-fns.el
deleted file mode 100644
index 720fbed211b..00000000000
--- a/lisp/w32-fns.el
+++ /dev/null
@@ -1,88 +0,0 @@
-;;; w32-fns.el --- Lisp routines for Windows NT.
-
-;; Copyright (C) 1994 Free Software Foundation, Inc.
-
-;; Author: Geoff Voelker (voelker@cs.washington.edu)
-
-;; 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:
-
-;; (August 12, 1993)
-;; Created.
-
-;; (November 21, 1994)
-;; [C-M-backspace] defined.
-;; mode-line-format defined to show buffer file type.
-;; audio bell initialized.
-
-;;; Code:
-
-;; Map delete and backspace
-(define-key function-key-map [backspace] "\177")
-(define-key function-key-map [delete] "\C-d")
-(define-key function-key-map [M-backspace] [?\M-\177])
-(define-key function-key-map [C-M-backspace] [\C-\M-delete])
-
-;; Ignore case on file-name completion
-(setq completion-ignore-case t)
-
-;; The cmd.exe shell uses the "/c" switch instead of the "-c" switch
-;; for executing its command line argument (from simple.el).
-(setq shell-command-switch "/c")
-
-;; For appending suffixes to directories and files in shell completions.
-(add-hook 'shell-mode-hook 
-	  '(lambda () (setq comint-completion-addsuffix '("\\" . " "))))
-
-;;; Avoid creating auto-save file names containing invalid characters
-;;; (primarily "*", eg. for the *mail* buffer).
-(fset 'original-make-auto-save-file-name
-      (symbol-function 'make-auto-save-file-name))
-
-(defun make-auto-save-file-name ()
-  "Return file name to use for auto-saves of current buffer.
-Does not consider `auto-save-visited-file-name' as that variable is checked
-before calling this function.  You can redefine this for customization.
-See also `auto-save-file-name-p'."
-  (let ((name (original-make-auto-save-file-name))
-	(start 0))
-    ;; destructively replace occurences of * or ? with $
-    (while (string-match "[?*]" name start)
-      (aset name (match-beginning 0) ?$)
-      (setq start (1+ (match-end 0))))
-    name))
-
-;;; Fix interface to (X-specific) mouse.el
-(defun x-set-selection (type data)
-  (or type (setq type 'PRIMARY))
-  (put 'x-selections type data))
-
-(defun x-get-selection (&optional type data-type)
-  (or type (setq type 'PRIMARY))
-  (get 'x-selections type))
-
-(fmakunbound 'font-menu-add-default)
-(global-unset-key [C-down-mouse-1])
-(global-unset-key [C-down-mouse-2])
-(global-unset-key [C-down-mouse-3])
-
-;;; Set to a system sound if you want a fancy bell.
-(set-message-beep nil)
-
-;;; w32-fns.el ends here
diff --git a/lisp/webjump.el b/lisp/webjump.el
deleted file mode 100644
index 7812cce6fea..00000000000
--- a/lisp/webjump.el
+++ /dev/null
@@ -1,427 +0,0 @@
-;;; webjump.el --- programmable Web hotlist
-     
-;; Copyright (C) 1996 Free Software Foundation
-
-;; Author:    Neil W. Van Dyke <nwv@acm.org>
-;; Created:   Fri 09 Aug 1996
-;; Keywords:  comm www
-;; X-URL:     http://www.cs.brown.edu/people/nwv/
-
-;; 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:
-
-;; WebJump provides a sort of ``programmable hotlist'' of Web sites that can
-;; quickly be invoked in your Web browser.  Each Web site in the hotlist has a
-;; name, and you select the desired site name via a completing string prompt in
-;; the minibuffer.  The URL for each Web site is defined as a static string or
-;; a built-in or custom function, allowing interactive prompting for
-;; site-specific queries and options.
-
-;; Note that WebJump was originally intended to complement your conventional
-;; browser-based hotlist, not replace it.  (Though there's no reason you
-;; couldn't use WebJump for your entire hotlist if you were so inclined.)
-
-;; The `webjump-sites' variable, which defines the hotlist, defaults to some
-;; example sites.  You'll probably want to override it with your own favorite
-;; sites.  The documentation for the variable describes the syntax.
-
-;; You may wish to add something like the following to your `.emacs' file:
-;;
-;;   (load "webjump")
-;;   (global-set-key "\C-cj" 'webjump)
-;;   (setq webjump-sites
-;;         (append '(
-;;                   ("My Home Page" . "www.someisp.net/users/joebobjr/")
-;;                   ("Pop's Site"   . "www.joebob-and-son.com/")
-;;                   )
-;;                 webjump-sample-sites))
-;;
-;; The above loads this package, binds `C-c j' to invoke WebJump, and adds
-;; your personal favorite sites to the hotlist.
-
-;; The `webjump-sample-sites' constant mostly contains sites that are expected
-;; to be generally useful to Emacs users or that have some sort of query which
-;; can be coded in WebJump.  There are two main goals of this sample site list:
-;; (1) demonstrate WebJump capabilities and usage; (2) provide definitions for
-;; many popular sites so that people don't have to reinvent the wheel.  A few
-;; assorted other sites have been thrown in on a whim.  No commercial sites are
-;; included unless they provide a free, generally-useful service.  Inclusion of
-;; a site does not represent an endorsement.  Please contact the maintainer
-;; with change requests.
-
-;; The `browse-url' package is used to submit URLs to the browser, so any
-;; browser-specific configuration should be done there.
-
-;; WebJump inherits a small amount code from my `altavista.el' package, and is
-;; intended to obsolete that package.
-
-;;; Code:
-
-;;-------------------------------------------------------- Package Dependencies
-
-(require 'browse-url)
-
-;;------------------------------------------------------------------- Constants
-
-(defvar webjump-sample-sites
-  '(("AltaVista" . 
-     [simple-query
-      "www.altavista.digital.com"
-      "www.altavista.digital.com/cgi-bin/query?pg=aq&what=web&fmt=.&q="
-      "&r=&d0=&d1="])
-    ("Archie" .
-     [simple-query "http://hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl"
-		   "http://hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl?query=" ""])
-    ("Bastard Operator from Hell" . "www.replay.com/bofh/")
-    ("Brown University" .
-     [simple-query "www.brown.edu" "www.brown.edu/cgi-local/bsearch?" ""])
-    ("Computer Professionals for Social Responsibility" . "www.cpsr.org/dox/")
-    ("Digital Espresso" .
-     [simple-query "www.io.org/~mentor/DigitalEspresso.html"
-		   "www.jars.com/cgi-bin/aglimpse/01?query="
-		   "&case=on&whole=on&errors=0&maxfiles=100&maxlines=30"])
-    ("Dilbert" . "www.unitedmedia.com/comics/dilbert/")
-    ("Electronic Frontier Foundation" . "www.eff.org")
-    ("Emacs Lisp Archive" .
-     "ftp://archive.cis.ohio-state.edu/pub/gnu/emacs/elisp-archive/")
-    ("Free Software Foundation" . "www.fsf.org")
-    ("GNU FTP Archive". [mirrors
-                         "ftp://prep.ai.mit.edu/pub/gnu/"
-                         ;; ASIA:
-                         "ftp://ftp.cs.titech.ac.jp"
-                         "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/prep"
-                         "ftp://cair-archive.kaist.ac.kr/pub/gnu"
-                         "ftp://ftp.nectec.or.th/pub/mirrors/gnu"
-                         ;; AUSTRALIA:
-                         "ftp://archie.au/gnu"
-                         "ftp://archie.oz/gnu"
-                         "ftp://archie.oz.au/gnu"
-                         ;; AFRICA:
-                         "ftp://ftp.sun.ac.za/pub/gnu"
-                         ;; MIDDLE-EAST:
-                         "ftp://ftp.technion.ac.il/pub/unsupported/gnu"
-                         ;; EUROPE:
-                         "ftp://irisa.irisa.fr/pub/gnu"
-                         "ftp://ftp.univ-lyon1.fr/pub/gnu"
-                         "ftp://ftp.mcc.ac.uk"
-                         "ftp://unix.hensa.ac.uk/mirrors/uunet/systems/gnu"
-                         "ftp://src.doc.ic.ac.uk/gnu"
-                         "ftp://ftp.ieunet.ie/pub/gnu"
-                         "ftp://ftp.eunet.ch"
-                         "ftp://nic.switch.ch/mirror/gnu"
-                         "ftp://ftp.informatik.rwth-aachen.de/pub/gnu"
-                         "ftp://ftp.informatik.tu-muenchen.de"
-                         "ftp://ftp.win.tue.nl/pub/gnu"
-                         "ftp://ftp.nl.net"
-                         "ftp://ftp.etsimo.uniovi.es/pub/gnu"
-                         "ftp://ftp.funet.fi/pub/gnu"
-                         "ftp://ftp.denet.dk"
-                         "ftp://ftp.stacken.kth.se"
-                         "ftp://isy.liu.se"
-                         "ftp://ftp.luth.se/pub/unix/gnu"
-                         "ftp://ftp.sunet.se/pub/gnu"
-                         "ftp://archive.eu.net"
-                         ;; SOUTH AMERICA: 
-                         "ftp://ftp.inf.utfsm.cl/pub/gnu"
-                         "ftp://ftp.unicamp.br/pub/gnu"
-                         ;; WESTERN CANADA:
-                         "ftp://ftp.cs.ubc.ca/mirror2/gnu"
-                         ;; USA:
-                         "ftp://wuarchive.wustl.edu/systems/gnu"
-                         "ftp://labrea.stanford.edu"
-                         "ftp://ftp.digex.net/pub/gnu"
-                         "ftp://ftp.kpc.com/pub/mirror/gnu"
-                         "ftp://f.ms.uky.edu/pub3/gnu"
-                         "ftp://jaguar.utah.edu/gnustuff"
-                         "ftp://ftp.hawaii.edu/mirrors/gnu"
-                         "ftp://uiarchive.cso.uiuc.edu/pub/gnu"
-                         "ftp://ftp.cs.columbia.edu/archives/gnu/prep"
-                         "ftp://gatekeeper.dec.com/pub/GNU"
-                         "ftp://ftp.uu.net/systems/gnu"
-                         ])
-    ("Insidious Big Brother Database" . "home.netscape.com/people/jwz/bbdb/")
-    ("Interactive Weather Information Network" . webjump-to-iwin)
-    ("Java API" . webjump-to-javaapi)
-    ("Lycos" .
-     [simple-query "www.lycos.com" "www.lycos.com/cgi-bin/pursuit?query=" ""])
-    ("Mailcrypt" . "cag-www.lcs.mit.edu/mailcrypt/")
-    ("Pretty Good Privacy" . "web.mit.edu/network/pgp.html")
-    ("Playboy" . (if (webjump-adult-p) "www.playboy.com" "www.whitehouse.gov"))
-    ("Usenet FAQs" . 
-     [simple-query "www.cis.ohio-state.edu/hypertext/faq/usenet/FAQ-List.html"
-		   "www.cis.ohio-state.edu/htbin/search-usenet-faqs/form?find="
-		   ""])
-    ("Risks Digest" . webjump-to-risks)
-    ("RTFM Usenet FAQs by Group" .
-     "ftp://rtfm.mit.edu/pub/usenet-by-group/")
-    ("RTFM Usenet FAQs by Hierachy" .
-     "ftp://rtfm.mit.edu/pub/usenet-by-hierarchy/")
-    ("Webster" . 
-     [simple-query "c.gp.cs.cmu.edu:5103/prog/webster"
-		   "gs213.sp.cs.cmu.edu/prog/webster?" ""])
-    ("X Consortium Archive". "ftp.x.org")
-    ("Yahoo" . 
-     [simple-query "www.yahoo.com" "search.yahoo.com/bin/search?p=" ""])
-    ("Yahoo Emacs" .
-     "www.yahoo.com/Computers_and_Internet/Software/Editors/Emacs/")
-    ("Yahoo Reference" "www.yahoo.com/Reference/")
-    )
-  "Sample hotlist for WebJump.")
-
-(defvar webjump-state-to-postal-alist
-  '(("Alabama" . "al") ("Alaska" . "ak") ("Arizona" . "az") ("Arkansas" . "ar")
-    ("California" . "ca") ("Colorado" . "co") ("Connecticut" . "ct")
-    ("Delaware" . "de") ("Florida" . "fl") ("Georgia" . "ga") ("Hawaii" . "hi")
-    ("Idaho" . "id") ("Illinois" . "il") ("Indiana" . "in") ("Iowa" . "ia")
-    ("Kansas" . "ks") ("Kentucky" . "ky") ("Louisiana" . "la") ("Maine" . "me")
-    ("Maryland" . "md") ("Massachusetts" . "ma") ("Michigan" . "mi")
-    ("Minnesota" . "mn") ("Mississippi" . "ms") ("Missouri" . "mo")
-    ("Montana" . "mt") ("Nebraska" . "ne") ("Nevada" . "nv")
-    ("New Hampshire" . "nh") ("New Jersey" . "nj") ("New Mexico" . "nm")
-    ("New York" . "ny") ("North Carolina" . "nc") ("North Dakota" . "nd")
-    ("Ohio" . "oh") ("Oklahoma" . "ok") ("Oregon" . "or")
-    ("Pennsylvania" . "pa") ("Rhode Island" . "ri") ("South Carolina" . "sc")
-    ("South Dakota" . "sd") ("Tennessee" . "tn") ("Texas" . "tx")
-    ("Utah" . "ut") ("Vermont" . "vt") ("Virginia" . "va")
-    ("Washington" . "wa") ("West Virginia" . "wv") ("Wisconsin" . "wi")
-    ("Wyoming" . "wy")))
-
-;;------------------------------------------------------------ Option Variables
-
-(defvar webjump-sites
-  webjump-sample-sites
-  "*Hotlist for WebJump.
-
-The hotlist is represented as an association list, with the CAR of each cell
-being the name of the Web site, and the CDR being the definition for the URL of
-that site.  The URL definition can be a string (the URL), a vector (specifying
-a special \"builtin\" which returns a URL), a symbol (name of a function which
-returns a URL), or a list (which when `eval'ed yields a URL).
-
-If the URL definition is a vector, then a \"builtin\" is used.  A builtin has a
-Lisp-like syntax, with the name as the first element of the vector, and any
-arguments as the following elements.  The three current builtins are `name',
-which returns the name of the site as the URL, `simple-query', which
-returns a URL that is a function of a query entered by the user, and `mirrors',
-which allows the user to select from among multiple mirror sites for the same
-content.
-
-The first argument to the `simple-query' builtin is a static URL to use if the
-user enters a blank query.  The second and third arguments are the prefix and
-suffix, respectively, to add to the encoded query the user enters.  This
-builtin covers Web sites that have single-string searches with the query
-embedded in the URL.
-
-The arguments to the `mirrors' builtin are URLs of mirror sites.
-
-If the symbol of a function is given, then the function will be called with the
-Web site name (the one you specified in the CAR of the alist cell) as a
-parameter.  This might come in handy for various kludges.
-
-For convenience, if the `http://', `ftp://', or `file://' prefix is missing
-from a URL, WebJump will make a guess at what you wanted and prepend it before
-submitting the URL.")
-
-;;------------------------------------------------------- Sample Site Functions
-
-(defun webjump-to-iwin (name)
-  (let ((prefix "http://iwin.nws.noaa.gov/")
-        (state (webjump-read-choice name "state"
-                                    (append '(("Puerto Rico" . "pr"))
-                                            webjump-state-to-postal-alist))))
-    (if state
-        (concat prefix "iwin/" state "/"
-                (webjump-read-choice name "option"
-                                     '(("Hourly Report" . "hourly")
-                                       ("State Forecast" . "state")
-                                       ("Local Forecast" . "local")
-                                       ("Zone Forecast" . "zone")
-                                       ("Short-Term Forecast" . "shortterm")
-                                       ("Weather Summary" . "summary")
-                                       ("Public Information" . "public")
-                                       ("Climatic Data" . "climate")
-                                       ("Aviation Products" . "aviation")
-                                       ("Hydro Products" . "hydro")
-                                       ("Special Weather" . "special")
-                                       ("Watches and Warnings" . "warnings"))
-                                     "zone")
-                ".html")
-      prefix)))
-
-(defun webjump-to-javaapi (name)
-  (let* ((prefix "http://www.javasoft.com/products/JDK/CurrentRelease/api/")
-	 (packages '(("java.applet") ("java.awt") ("java.awt.image")
-		     ("java.awt.peer") ("java.io") ("java.lang") ("java.net")
-		     ("java.util") ("sun.tools.debug")))
-	 (completion-ignore-case t)
-	 (package (completing-read (concat name " package: ") packages nil t)))
-    (if (webjump-null-or-blank-string-p package)
-        (concat prefix "packages.html")
-      (concat prefix "Package-" package ".html"))))
-
-(defun webjump-to-risks (name)
-  (let (issue volume)
-    (if (and (setq volume (webjump-read-number (concat name " volume")))
-	     (setq issue  (webjump-read-number (concat name " issue"))))
-	(format "catless.ncl.ac.uk/Risks/%d.%02d.html" volume issue)
-      "catless.ncl.ac.uk/Risks/")))
-
-;;-------------------------------------------------------------- Core Functions
-
-;;;###autoload
-(defun webjump ()
-  "Jumps to a Web site from a programmable hotlist.
-
-See the documentation for the `webjump-sites' variable for how to customize the
-hotlist.
-
-Feedback on WebJump can be sent to the author, Neil W. Van Dyke <nwv@acm.org>,
-or submitted via `\\[webjump-submit-bug-report]'.  The latest version can be
-gotten from `http://www.cs.brown.edu/people/nwv/'."
-  (interactive)
-  (let* ((completion-ignore-case t)
-	 (item (assoc (completing-read "WebJump to site: " webjump-sites nil t)
-		      webjump-sites))
-	 (name (car item))
-	 (expr (cdr item)))
-    (funcall browse-url-browser-function
-	     (webjump-url-fix
-	      (cond ((not expr) "")
-		    ((stringp expr) expr)
-		    ((vectorp expr) (webjump-builtin expr name))
-		    ((listp expr) (eval expr))
-		    ((symbolp expr)
-		     (if (fboundp expr)
-			 (funcall expr name)
-		       (error "WebJump URL function \"%s\" undefined." expr)))
-		    (t (error "WebJump URL expression for \"%s\" invalid."
-			      name)))))))
-
-(defun webjump-adult-p ()
-  (and (boundp 'age) (integerp age) (>= age 21)))
-
-(defun webjump-builtin (expr name)
-  (if (< (length expr) 1)
-      (error "WebJump URL builtin for \"%s\" empty." name))
-  (let ((builtin (aref expr 0)))
-    (cond
-     ((eq builtin 'mirrors)
-      (if (= (length expr) 1)
-          (error
-           "WebJump URL builtin \"mirrors\" for \"%s\" needs at least 1 arg."))
-      (webjump-choose-mirror name (cdr (append expr nil))))
-     ((eq builtin 'name)
-      name)
-     ((eq builtin 'simple-query)
-      (webjump-builtin-check-args expr name 3)
-      (webjump-do-simple-query name (aref expr 1) (aref expr 2) (aref expr 3)))
-     (t (error "WebJump URL builtin \"%s\" for \"%s\" invalid."
-	       builtin name)))))
-
-(defun webjump-builtin-check-args (expr name count)
-  (or (= (length expr) (1+ count))
-      (error "WebJump URL builtin \"%s\" for \"%s\" needs %d args."
-	     (aref expr 0) name count)))
-
-(defun webjump-choose-mirror (name urls)
-  (webjump-read-url-choice (concat name " mirror")
-                           urls
-                           (webjump-mirror-default urls)))
-
-(defun webjump-do-simple-query (name noquery-url query-prefix query-suffix)
-  (let ((query (webjump-read-string (concat name " query"))))
-    (if query
-	(concat query-prefix (webjump-url-encode query) query-suffix)
-      noquery-url)))
-
-(defun webjump-mirror-default (urls)
-  ;; Note: This should be modified to apply some simple kludges/heuristics to
-  ;; pick a site which is likely "close".  As a tie-breaker among candidates
-  ;; judged equally desirable, randomness should be used.
-  (car urls))
-
-(defun webjump-read-choice (name what choices &optional default)
-  (let* ((completion-ignore-case t)
-         (choice (completing-read (concat name " " what ": ") choices nil t)))
-    (if (webjump-null-or-blank-string-p choice)
-        default
-      (cdr (assoc choice choices)))))
-
-(defun webjump-read-number (prompt)
-  ;; Note: I should make this more robust someday.
-  (let ((input (webjump-read-string prompt)))
-    (if input (string-to-number input))))
-  
-(defun webjump-read-string (prompt)
-  (let ((input (read-string (concat prompt ": "))))
-    (if (webjump-null-or-blank-string-p input) nil input)))
-  
-(defun webjump-read-url-choice (what urls &optional default)
-  ;; Note: Convert this to use `webjump-read-choice' someday.
-  (let* ((completions (mapcar (function (lambda (n) (cons n n)))
-                              urls))
-	 (input (completing-read (concat what
-                                         ;;(if default " (RET for default)" "")
-                                         ": ")
-                                 completions
-                                 nil
-                                 t)))
-    (if (webjump-null-or-blank-string-p input)
-        default
-      (car (assoc input completions)))))
-
-(defun webjump-null-or-blank-string-p (str)
-  (or (null str) (string-match "^[ \t]*$" str)))
-
-(defun webjump-url-encode (str)
-  (mapconcat '(lambda (c)
-		(cond ((= c 32) "+")
-		      ((or (and (>= c ?a) (<= c ?z))
-			   (and (>= c ?A) (<= c ?Z))
-			   (and (>= c ?0) (<= c ?9)))
-		       (char-to-string c))
-		      (t (upcase (format "%%%02x" c)))))
-	     str
-	     ""))
-
-(defun webjump-url-fix (url)
-  (if (webjump-null-or-blank-string-p url)
-      ""
-    (webjump-url-fix-trailing-slash
-     (cond
-      ((string-match "^[a-zA-Z]+:" url) url)
-      ((string-match "^/" url) (concat "file://" url))
-      ((string-match "^\\([^\\./]+\\)" url)
-       (concat (if (string= (downcase (match-string 1 url)) "ftp")
-		   "ftp"
-		 "http")
-	       "://"
-	       url))
-      (t url)))))
-
-(defun webjump-url-fix-trailing-slash (url)
-  (if (string-match "^[a-zA-Z]+://[^/]+$" url)
-      (concat url "/")
-    url))
-
-;;-----------------------------------------------------------------------------
-
-(provide 'webjump)
-
-;; webjump.el ends here
diff --git a/lisp/window.el b/lisp/window.el
deleted file mode 100644
index 0b55ccbe9a3..00000000000
--- a/lisp/window.el
+++ /dev/null
@@ -1,298 +0,0 @@
-;;; window.el --- GNU Emacs window commands aside from those written in C.
-
-;; Copyright (C) 1985, 1989, 1992, 1993, 1994 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.
-
-;;; Code:
-
-;;;; Window tree functions.
-
-(defun one-window-p (&optional nomini all-frames)
-  "Returns non-nil if the selected window is the only window (in its frame).
-Optional arg NOMINI non-nil means don't count the minibuffer
-even if it is active.
-
-The optional arg ALL-FRAMES t means count windows on all frames.
-If it is `visible', count windows on all visible frames.
-ALL-FRAMES nil or omitted means count only the selected frame, 
-plus the minibuffer it uses (which may be on another frame).
-If ALL-FRAMES is neither nil nor t, count only the selected frame."
-  (let ((base-window (selected-window)))
-    (if (and nomini (eq base-window (minibuffer-window)))
-	(setq base-window (next-window base-window)))
-    (eq base-window
-	(next-window base-window (if nomini 'arg) all-frames))))
-
-(defun walk-windows (proc &optional minibuf all-frames)
-  "Cycle through all visible windows, calling PROC for each one.
-PROC is called with a window as argument.
-
-Optional second arg MINIBUF t means count the minibuffer window even
-if not active.  MINIBUF nil or omitted means count the minibuffer iff
-it is active.  MINIBUF neither t nor nil means not to count the
-minibuffer even if it is active.
-
-Several frames may share a single minibuffer; if the minibuffer
-counts, all windows on all frames that share that minibuffer count
-too.  Therefore, if you are using a separate minibuffer frame
-and the minibuffer is active and MINIBUF says it counts,
-`walk-windows' includes the windows in the frame from which you
-entered the minibuffer, as well as the minibuffer window.
-
-ALL-FRAMES is the optional third argument.
-ALL-FRAMES nil or omitted means cycle within the frames as specified above.
-ALL-FRAMES = `visible' means include windows on all visible frames.
-ALL-FRAMES = 0 means include windows on all visible and iconified frames.
-ALL-FRAMES = t means include windows on all frames including invisible frames.
-Anything else means restrict to the selected frame."
-  ;; If we start from the minibuffer window, don't fail to come back to it.
-  (if (window-minibuffer-p (selected-window))
-      (setq minibuf t))
-  (let* ((walk-windows-start (selected-window))
-	 (walk-windows-current walk-windows-start))
-    (while (progn
-	     (setq walk-windows-current
-		   (next-window walk-windows-current minibuf all-frames))
-	     (funcall proc walk-windows-current)
-	     (not (eq walk-windows-current walk-windows-start))))))
-
-(defun minibuffer-window-active-p (window)
-  "Return t if WINDOW (a minibuffer window) is now active."
-  (eq window (active-minibuffer-window)))
-
-(defmacro save-selected-window (&rest body)
-  "Execute BODY, then select the window that was selected before BODY."
-  (list 'let
-	'((save-selected-window-window (selected-window)))
-	(list 'unwind-protect
-	      (cons 'progn body)
-	      (list 'select-window 'save-selected-window-window)))) 
-
-(defun count-windows (&optional minibuf)
-   "Returns the number of visible windows.
-Optional arg MINIBUF non-nil means count the minibuffer
-even if it is inactive."
-   (let ((count 0))
-     (walk-windows (function (lambda (w)
-			       (setq count (+ count 1))))
-		   minibuf)
-     count))
-
-(defun balance-windows ()
-  "Makes all visible windows the same height (approximately)."
-  (interactive)
-  (let ((count -1) levels newsizes size
-	;; Don't count the lines that are above the uppermost windows.
-	;; (These are the menu bar lines, if any.)
-	(mbl (nth 1 (window-edges (frame-first-window (selected-frame))))))
-    ;; Find all the different vpos's at which windows start,
-    ;; then count them.  But ignore levels that differ by only 1.
-    (save-window-excursion
-      (let (tops (prev-top -2))
-	(walk-windows (function (lambda (w)
-				  (setq tops (cons (nth 1 (window-edges w))
-						   tops))))
-		      'nomini)
-	(setq tops (sort tops '<))
-	(while tops
-	  (if (> (car tops) (1+ prev-top))
-	      (setq prev-top (car tops)
-		    count (1+ count)))
-	  (setq levels (cons (cons (car tops) count) levels))
-	  (setq tops (cdr tops)))
-	(setq count (1+ count))))
-    ;; Subdivide the frame into that many vertical levels.
-    (setq size (/ (- (frame-height) mbl) count))
-    (walk-windows (function
-		   (lambda (w)
-		     (select-window w)
-		     (let ((newtop (cdr (assq (nth 1 (window-edges))
-					      levels)))
-			   (newbot (or (cdr (assq (+ (window-height)
-						     (nth 1 (window-edges)))
-						  levels))
-				       count)))
-		       (setq newsizes
-			     (cons (cons w (* size (- newbot newtop)))
-				   newsizes)))))
-		  'nomini)
-    (walk-windows (function (lambda (w)
-			      (select-window w)
-			      (let ((newsize (cdr (assq w newsizes))))
-				(enlarge-window (- newsize
-						   (window-height))))))
-		  'nomini)))
-
-;;; I think this should be the default; I think people will prefer it--rms.
-(defvar split-window-keep-point t
-  "*If non-nil, split windows keeps the original point in both children.
-This is often more convenient for editing.
-If nil, adjust point in each of the two windows to minimize redisplay.
-This is convenient on slow terminals, but point can move strangely.")
-
-(defun split-window-vertically (&optional arg)
-  "Split current window into two windows, one above the other.
-The uppermost window gets ARG lines and the other gets the rest.
-Negative arg means select the size of the lowermost window instead.
-With no argument, split equally or close to it.
-Both windows display the same buffer now current.
-
-If the variable split-window-keep-point is non-nil, both new windows
-will get the same value of point as the current window.  This is often
-more convenient for editing.
-
-Otherwise, we chose window starts so as to minimize the amount of
-redisplay; this is convenient on slow terminals.  The new selected
-window is the one that the current value of point appears in.  The
-value of point can change if the text around point is hidden by the
-new mode line."
-  (interactive "P")
-  (let ((old-w (selected-window))
-	(old-point (point))
-	(size (and arg (prefix-numeric-value arg)))
-        (window-full-p nil)
-	new-w bottom switch moved)
-    (and size (< size 0) (setq size (+ (window-height) size)))
-    (setq new-w (split-window nil size))
-    (or split-window-keep-point
-	(progn
-	  (save-excursion
-	    (set-buffer (window-buffer))
-	    (goto-char (window-start))
-            (setq moved (vertical-motion (window-height)))
-	    (set-window-start new-w (point))
-	    (if (> (point) (window-point new-w))
-		(set-window-point new-w (point)))
-            (and (= moved (window-height))
-                 (progn
-                   (setq window-full-p t)
-                   (vertical-motion -1)))
-            (setq bottom (point)))
-          (and window-full-p
-               (<= bottom (point))
-               (set-window-point old-w (1- bottom)))
-	  (and window-full-p
-               (<= (window-start new-w) old-point)
-               (progn
-                 (set-window-point new-w old-point)
-                 (select-window new-w)))))
-    new-w))
-
-(defun split-window-horizontally (&optional arg)
-  "Split current window into two windows side by side.
-This window becomes the leftmost of the two, and gets ARG columns.
-Negative arg means select the size of the rightmost window instead.
-No arg means split equally."
-  (interactive "P")
-  (let ((size (and arg (prefix-numeric-value arg))))
-    (and size (< size 0)
-	 (setq size (+ (window-width) size)))
-    (split-window nil size t)))
-
-(defun enlarge-window-horizontally (arg)
-  "Make current window ARG columns wider."
-  (interactive "p")
-  (enlarge-window arg t))
-
-(defun shrink-window-horizontally (arg)
-  "Make current window ARG columns narrower."
-  (interactive "p")
-  (shrink-window arg t))
-
-(defun shrink-window-if-larger-than-buffer (&optional window)
-  "Shrink the WINDOW to be as small as possible to display its contents.
-Do not shrink to less than `window-min-height' lines.
-Do nothing if the buffer contains more lines than the present window height,
-or if some of the window's contents are scrolled out of view,
-or if the window is not the full width of the frame,
-or if the window is the only window of its frame."
-  (interactive)
-  (or window (setq window (selected-window)))
-  (save-excursion
-    (set-buffer (window-buffer window))
-    (let* ((w (selected-window))	;save-window-excursion can't win
-	   (buffer-file-name buffer-file-name)
-	   (p (point))
-	   (n 0)
-	   (ignore-final-newline
-	    ;; If buffer ends with a newline, ignore it when counting height
-	    ;; unless point is after it.
-	    (and (not (eobp))
-		 (eq ?\n (char-after (1- (point-max))))))
-	   (buffer-read-only nil)
-	   (modified (buffer-modified-p))
-	   (buffer (current-buffer))
-	   (params (frame-parameters (window-frame window)))
-	   (mini (cdr (assq 'minibuffer params)))
-	   (edges (window-edges (selected-window))))
-      (if (and (< 1 (let ((frame (selected-frame)))
-		      (select-frame (window-frame window))
-		      (unwind-protect
-			  (count-windows)
-			(select-frame frame))))
-	       (= (window-width window) (frame-width (window-frame window)))
-	       (pos-visible-in-window-p (point-min) window)
-	       (not (eq mini 'only))
-	       (or (not mini)
-		   (< (nth 3 edges)
-		      (nth 1 (window-edges mini)))
-		   (> (nth 1 edges)
-		      (cdr (assq 'menu-bar-lines params)))))
-	  (unwind-protect
-	      (progn
-		(select-window (or window w))
-		(goto-char (point-min))
-		(while (pos-visible-in-window-p
-			(- (point-max)
-			   (if ignore-final-newline 1 0)))
-		  ;; defeat file locking... don't try this at home, kids!
-		  (setq buffer-file-name nil)
-		  (insert ?\n) (setq n (1+ n)))
-		(if (> n 0)
-		    (shrink-window (min (1- n)
-					(- (window-height)
-					   window-min-height)))))
-	    (delete-region (point-min) (point))
-	    (set-buffer-modified-p modified)
-	    (goto-char p)
-	    (select-window w)
-	    ;; Make sure we unbind buffer-read-only
-	    ;; with the proper current buffer.
-	    (set-buffer buffer))))))
-
-(defun kill-buffer-and-window ()
-  "Kill the current buffer and delete the selected window."
-  (interactive)
-  (if (yes-or-no-p (format "Kill buffer `%s'? " (buffer-name)))
-      (let ((buffer (current-buffer)))
-	(delete-window (selected-window))
-	(kill-buffer buffer))
-    (error "Aborted")))
-
-(define-key ctl-x-map "2" 'split-window-vertically)
-(define-key ctl-x-map "3" 'split-window-horizontally)
-(define-key ctl-x-map "}" 'enlarge-window-horizontally)
-(define-key ctl-x-map "{" 'shrink-window-horizontally)
-(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
-(define-key ctl-x-map "+" 'balance-windows)
-(define-key ctl-x-4-map "0" 'kill-buffer-and-window)
-
-;;; windows.el ends here
diff --git a/lisp/x-apollo.el b/lisp/x-apollo.el
deleted file mode 100644
index e86b7f2eee0..00000000000
--- a/lisp/x-apollo.el
+++ /dev/null
@@ -1,90 +0,0 @@
-;;; x-apollo.el --- Apollo support functions
-
-;; Copyright (C) 1995 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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.
-
-;;; Code:
-
-(defun apollo-kill-entire-line ()
-  "Kill the entire line containing point."
-  (interactive)
-  (beginning-of-line)
-  (kill-line 1))
-
-(defun apollo-scroll-window-right ()
-  "Scroll window to right ten columns."
-  (interactive)
-  (scroll-left 10))
-
-(defun apollo-scroll-window-left ()
-  "Scroll window to left ten columns."
-  (interactive)
-  (scroll-right 10))
-
-(defun apollo-scroll-window-forward-line ()
-  "Move window forward one line leaving cursor at position in window."
-  (interactive)
-  (scroll-up 1))
-
-(defun apollo-scroll-window-backward-line ()
-  "Move window backward one line leaving cursor at position in window."
-  (interactive)
-  (scroll-down 1))
-
-;;; Define and Enable the Function Key Bindings.
-
-(global-set-key [S-tab] "\C-i")	;Shift TAB
-(global-set-key [C-tab] "\C-i")	;Control TAB
-(global-set-key [S-return] "\C-m") ;Shift RET
-(global-set-key [C-return] "\C-m") ;Control RET
-(global-set-key [linedel] 'apollo-kill-entire-line) ;LINE DEL
-(global-set-key [chardel] 'delete-char) ;CHAR DEL
-(global-set-key [leftbar] 'beginning-of-line) ;LEFT BAR ARROW
-(global-set-key [rightbar] 'end-of-line) ;RIGHT BAR ARROW
-(global-set-key [leftbox] 'apollo-scroll-window-left) ;LEFT BOX ARROW
-(global-set-key [rightbox] 'apollo-scroll-window-right) ;RIGHT BOX ARROW
-(global-set-key [S-up] 'apollo-scroll-window-backward-line) ;Shift UP ARROW
-(global-set-key [S-down] 'apollo-scroll-window-forward-line) ;Shift DOWN ARROW
-(global-set-key [select] 'set-mark-command) ;MARK
-(global-set-key [S-insert] 'overwrite-mode) ;INS MODE
-(global-set-key [S-linedel] 'yank) ;Shift LINE DEL
-(global-set-key [S-chardel] 'delete-char)	;Shift CHAR DEL
-(global-set-key [copy] 'copy-region-as-kill) ;COPY
-(global-set-key [S-cut] 'kill-region) ;CUT
-(global-set-key [paste] 'yank) ;PASTE
-(global-set-key [S-undo] 'undo)	;UNDO
-(global-set-key [S-left] 'backward-word) ;Shift LEFT ARROW
-(global-set-key [S-right] 'forward-word) ;Shift RIGHT ARROW
-(global-set-key [upbox] 'scroll-down) ;UP BOX ARROW
-(global-set-key [S-upbox] 'beginning-of-buffer) ;Shift UP BOX ARROW
-(global-set-key [downbox] 'scroll-up) ;DOWN BOX ARROW
-(global-set-key [S-downbox] 'end-of-buffer) ;Shift DOWN BOX ARROW
-(global-set-key [S-redo] 'toggle-read-only) ;Shift AGAIN
-(global-set-key [exit] 'save-buffer) ;EXIT
-(global-set-key [S-cancel] 'kill-buffer) ;ABORT
-(global-set-key [S-save] 'save-buffer) ;SAVE
-(global-set-key [S-leftbar] 'beginning-of-buffer) ;Shift LEFT BAR ARROW
-(global-set-key [cmd] 'execute-extended-command) ;CMD
-(global-set-key [S-rightbar] 'end-of-buffer) ;Shift RIGHT BAR ARROW
-(global-set-key [next] 'other-window) ;NEXT WNDW
-(global-set-key [S-next] 'delete-window) ;Shift NEXT WNDW
-(global-set-key [read] 'find-file-read-only) ;READ
-(global-set-key [edit] 'find-file) ;EDIT
-(global-set-key [S-shell] 'shell) ;SHELL
-(global-set-key [S-help] 'manual-entry) ;HELP
diff --git a/lisp/x-menu.el b/lisp/x-menu.el
deleted file mode 100644
index 4863ceec9ac..00000000000
--- a/lisp/x-menu.el
+++ /dev/null
@@ -1,145 +0,0 @@
-;;; x-menu.el --- menu support for X 
-
-;; Copyright (C) 1986 Free Software Foundation, Inc.
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is free software; you can redistribute it and/or modify
-;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 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.
-
-;;; Code:
-
-(defun x-menu-mode ()
-  "Major mode for creating permanent menus for use with X.
-These menus are implemented entirely in Lisp; popup menus, implemented
-with x-popup-menu, are implemented using XMenu primitives."
-  (make-local-variable 'x-menu-items-per-line)
-  (make-local-variable 'x-menu-item-width)
-  (make-local-variable 'x-menu-items-alist)
-  (make-local-variable 'x-process-mouse-hook)
-  (make-local-variable 'x-menu-assoc-buffer)
-  (setq buffer-read-only t)
-  (setq truncate-lines t)
-  (setq x-process-mouse-hook 'x-menu-pick-entry)
-  (setq mode-line-buffer-identification '("MENU: %32b")))
-
-(defvar x-menu-max-width 0)
-(defvar x-menu-items-per-line 0)
-(defvar x-menu-item-width 0)
-(defvar x-menu-items-alist nil)
-(defvar x-menu-assoc-buffer nil)
-
-(defvar x-menu-item-spacing 1
-  "*Minimum horizontal spacing between objects in a permanent X menu.")
-
-(defun x-menu-create-menu (name)
-  "Create a permanent X menu.
-Returns an item which should be used as a
-menu object whenever referring to the menu."
-  (let ((old (current-buffer))
-	(buf (get-buffer-create name)))
-    (set-buffer buf)
-    (x-menu-mode)
-    (setq x-menu-assoc-buffer old)
-    (set-buffer old)
-    buf))
-
-(defun x-menu-change-associated-buffer (menu buffer)
-  "Change associated buffer of MENU to BUFFER.
-BUFFER should be a buffer object."
-  (let ((old (current-buffer)))
-    (set-buffer menu)
-    (setq x-menu-assoc-buffer buffer)
-    (set-buffer old)))
-
-(defun x-menu-add-item (menu item binding)
-  "Add to MENU an item with name ITEM, associated with BINDING.
-Following a sequence of calls to x-menu-add-item, a call to x-menu-compute
-should be performed before the menu will be made available to the user.
-
-BINDING should be a function of one argument, which is the numerical
-button/key code as defined in x-menu.el."
-  (let ((old (current-buffer))
-	elt)
-    (set-buffer menu)
-    (if (setq elt (assoc item x-menu-items-alist))
-	(rplacd elt binding)
-      (setq x-menu-items-alist (append x-menu-items-alist
-				       (list (cons item binding)))))
-    (set-buffer old)
-    item))
-
-(defun x-menu-delete-item (menu item)
-  "Delete from MENU the item named ITEM.
-Call `x-menu-compute' before making the menu available to the user."
-  (let ((old (current-buffer))
-	elt)
-    (set-buffer menu)
-    (if (setq elt (assoc item x-menu-items-alist))
-	(rplaca elt nil))
-    (set-buffer old)
-    item))
-
-(defun x-menu-activate (menu)
-  "Compute all necessary parameters for MENU.
-This must be called whenever a menu is modified before it is made
-available to the user.  This also creates the menu itself."
-  (let ((buf (current-buffer)))
-    (pop-to-buffer menu)
-    (let (buffer-read-only)
-      (setq x-menu-max-width (1- (frame-width)))
-      (setq x-menu-item-width 0)
-      (let (items-head
-	    (items-tail x-menu-items-alist))
-	(while items-tail
-	  (if (car (car items-tail))
-	      (progn (setq items-head (cons (car items-tail) items-head))
-		     (setq x-menu-item-width
-			   (max x-menu-item-width
-				(length (car (car items-tail)))))))
-	  (setq items-tail (cdr items-tail)))
-	(setq x-menu-items-alist (reverse items-head)))
-      (setq x-menu-item-width (+ x-menu-item-spacing x-menu-item-width))
-      (setq x-menu-items-per-line
-	    (max 1 (/ x-menu-max-width x-menu-item-width)))
-      (erase-buffer)
-      (let ((items-head x-menu-items-alist))
-	(while items-head
-	  (let ((items 0))
-	    (while (and items-head
-			(<= (setq items (1+ items)) x-menu-items-per-line))
-	      (insert (format (concat "%"
-				      (int-to-string x-menu-item-width) "s")
-			      (car (car items-head))))
-	      (setq items-head (cdr items-head))))
-	  (insert ?\n)))
-      (shrink-window (max 0
-			  (- (window-height)
-			     (1+ (count-lines (point-min) (point-max))))))
-      (goto-char (point-min)))
-    (pop-to-buffer buf)))
-
-(defun x-menu-pick-entry (position event)
-  "Internal function for dispatching on mouse/menu events"
-  (let*	((x (min (1- x-menu-items-per-line)
-		 (/ (current-column) x-menu-item-width)))
-	 (y (- (count-lines (point-min) (point))
-	       (if (zerop (current-column)) 0 1)))
-	 (item (+ x (* y x-menu-items-per-line)))
-	 (litem (cdr (nth item x-menu-items-alist))))
-    (and litem (funcall litem event)))
-  (pop-to-buffer x-menu-assoc-buffer))
-
-;;; x-menu.el ends here
diff --git a/lisp/xscheme.el b/lisp/xscheme.el
deleted file mode 100644
index 05792774684..00000000000
--- a/lisp/xscheme.el
+++ /dev/null
@@ -1,878 +0,0 @@
-;;; xscheme.el --- run Scheme under Emacs
-
-;; Copyright (C) 1986, 1987, 1989, 1990 Free Software Foundation, Inc.
-
-;; Maintainer: FSF
-;; Keywords: languages, lisp
-
-;; 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:
-
-;; A major mode for editing Scheme and interacting with MIT's C-Scheme.
-;;
-;; Requires C-Scheme release 5 or later
-;; Changes to Control-G handler require runtime version 13.85 or later
-
-;;; Code:
-
-(require 'scheme)
-
-(defvar scheme-program-name "scheme"
-  "*Program invoked by the `run-scheme' command.")
-
-(defvar scheme-band-name nil
-  "*Band loaded by the `run-scheme' command.")
-
-(defvar scheme-program-arguments nil
-  "*Arguments passed to the Scheme program by the `run-scheme' command.")
-
-(defvar xscheme-allow-pipelined-evaluation t
-  "If non-nil, an expression may be transmitted while another is evaluating.
-Otherwise, attempting to evaluate an expression before the previous expression
-has finished evaluating will signal an error.")
-
-(defvar xscheme-startup-message
-  "This is the Scheme process buffer.
-Type \\[advertised-xscheme-send-previous-expression] to evaluate the expression before point.
-Type \\[xscheme-send-control-g-interrupt] to abort evaluation.
-Type \\[describe-mode] for more information.
-
-"
-  "String to insert into Scheme process buffer first time it is started.
-Is processed with `substitute-command-keys' first.")
-
-(defvar xscheme-signal-death-message nil
-  "If non-nil, causes a message to be generated when the Scheme process dies.")
-
-(defun xscheme-evaluation-commands (keymap)
-  (define-key keymap "\e\C-x" 'xscheme-send-definition)
-  (define-key keymap "\C-x\C-e" 'advertised-xscheme-send-previous-expression)
-  (define-key keymap "\eo" 'xscheme-send-buffer)
-  (define-key keymap "\ez" 'xscheme-send-definition)
-  (define-key keymap "\e\C-m" 'xscheme-send-previous-expression)
-  (define-key keymap "\e\C-z" 'xscheme-send-region))
-
-(defun xscheme-interrupt-commands (keymap)
-  (define-key keymap "\C-c\C-s" 'xscheme-select-process-buffer)
-  (define-key keymap "\C-c\C-b" 'xscheme-send-breakpoint-interrupt)
-  (define-key keymap "\C-c\C-c" 'xscheme-send-control-g-interrupt)
-  (define-key keymap "\C-c\C-u" 'xscheme-send-control-u-interrupt)
-  (define-key keymap "\C-c\C-x" 'xscheme-send-control-x-interrupt))
-
-(xscheme-evaluation-commands scheme-mode-map)
-(xscheme-interrupt-commands scheme-mode-map)
-
-(defun run-scheme (command-line)
-  "Run MIT Scheme in an inferior process.
-Output goes to the buffer `*scheme*'.
-With argument, asks for a command line."
-  (interactive
-   (list (let ((default
-		 (or xscheme-process-command-line
-		     (xscheme-default-command-line))))
-	   (if current-prefix-arg
-	       (read-string "Run Scheme: " default)
-	       default))))
-  (setq xscheme-process-command-line command-line)
-  (pop-to-buffer (xscheme-start-process command-line)))
-
-(defun reset-scheme ()
-  "Reset the Scheme process."
-  (interactive)
-  (let ((process (get-process "scheme")))
-    (cond ((or (not process)
-	       (not (eq (process-status process) 'run))
-	       (yes-or-no-p
-"The Scheme process is running, are you SURE you want to reset it? "))
-	   (message "Resetting Scheme process...")
-	   (if process (kill-process process t))
-	   (xscheme-start-process xscheme-process-command-line)
-	   (message "Resetting Scheme process...done")))))
-
-(defun xscheme-default-command-line ()
-  (concat scheme-program-name " -emacs"
-	  (if scheme-program-arguments
-	      (concat " " scheme-program-arguments)
-	      "")
-	  (if scheme-band-name
-	      (concat " -band " scheme-band-name)
-	      "")))
-
-;;;; Interaction Mode
-
-(defun scheme-interaction-mode ()
-  "Major mode for interacting with the inferior Scheme process.
-Like  scheme-mode  except that:
-
-\\[advertised-xscheme-send-previous-expression] sends the expression before point to the Scheme process as input
-\\[xscheme-yank-previous-send] yanks the expression most recently sent to Scheme
-
-All output from the Scheme process is written in the Scheme process
-buffer, which is initially named \"*scheme*\".  The result of
-evaluating a Scheme expression is also printed in the process buffer,
-preceded by the string \";Value: \" to highlight it.  If the process
-buffer is not visible at that time, the value will also be displayed
-in the minibuffer.  If an error occurs, the process buffer will
-automatically pop up to show you the error message.
-
-While the Scheme process is running, the modelines of all buffers in
-scheme-mode are modified to show the state of the process.  The
-possible states and their meanings are:
-
-input		waiting for input
-run		evaluating
-gc		garbage collecting
-
-The process buffer's modeline contains additional information where
-the buffer's name is normally displayed: the command interpreter level
-and type.
-
-Scheme maintains a stack of command interpreters.  Every time an error
-or breakpoint occurs, the current command interpreter is pushed on the
-command interpreter stack, and a new command interpreter is started.
-One example of why this is done is so that an error that occurs while
-you are debugging another error will not destroy the state of the
-initial error, allowing you to return to it after the second error has
-been fixed.
-
-The command interpreter level indicates how many interpreters are in
-the command interpreter stack.  It is initially set to one, and it is
-incremented every time that stack is pushed, and decremented every
-time it is popped.  The following commands are useful for manipulating
-the command interpreter stack:
-
-\\[xscheme-send-breakpoint-interrupt]	pushes the stack once
-\\[xscheme-send-control-u-interrupt]	pops the stack once
-\\[xscheme-send-control-g-interrupt]	pops everything off
-\\[xscheme-send-control-x-interrupt]	aborts evaluation, doesn't affect stack
-
-Some possible command interpreter types and their meanings are:
-
-[Evaluator]	read-eval-print loop for evaluating expressions
-[Debugger]	single character commands for debugging errors
-[Where]		single character commands for examining environments
-
-Starting with release 6.2 of Scheme, the latter two types of command
-interpreters will change the major mode of the Scheme process buffer
-to scheme-debugger-mode , in which the evaluation commands are
-disabled, and the keys which normally self insert instead send
-themselves to the Scheme process.  The command character ? will list
-the available commands.
-
-For older releases of Scheme, the major mode will be be
-scheme-interaction-mode , and the command characters must be sent as
-if they were expressions.
-
-Commands:
-Delete converts tabs to spaces as it moves back.
-Blank lines separate paragraphs.  Semicolons start comments.
-\\{scheme-interaction-mode-map}
-
-Entry to this mode calls the value of scheme-interaction-mode-hook
-with no args, if that value is non-nil.
- Likewise with the value of scheme-mode-hook.
- scheme-interaction-mode-hook is called after scheme-mode-hook."
-  (interactive)
-  (kill-all-local-variables)
-  (scheme-interaction-mode-initialize)
-  (scheme-mode-variables)
-  (make-local-variable 'xscheme-previous-send)
-  (run-hooks 'scheme-mode-hook 'scheme-interaction-mode-hook))
-
-(defun scheme-interaction-mode-initialize ()
-  (use-local-map scheme-interaction-mode-map)
-  (setq major-mode 'scheme-interaction-mode)
-  (setq mode-name "Scheme Interaction"))
-
-(defun scheme-interaction-mode-commands (keymap)
-  (define-key keymap "\C-c\C-m" 'xscheme-send-current-line)
-  (define-key keymap "\C-c\C-p" 'xscheme-send-proceed)
-  (define-key keymap "\C-c\C-y" 'xscheme-yank-previous-send))
-
-(defvar scheme-interaction-mode-map nil)
-(if (not scheme-interaction-mode-map)
-    (progn
-      (setq scheme-interaction-mode-map (make-keymap))
-      (scheme-mode-commands scheme-interaction-mode-map)
-      (xscheme-interrupt-commands scheme-interaction-mode-map)
-      (xscheme-evaluation-commands scheme-interaction-mode-map)
-      (scheme-interaction-mode-commands scheme-interaction-mode-map)))
-
-(defun xscheme-enter-interaction-mode ()
-  (save-excursion
-    (set-buffer (xscheme-process-buffer))
-    (if (not (eq major-mode 'scheme-interaction-mode))
-	(if (eq major-mode 'scheme-debugger-mode)
-	    (scheme-interaction-mode-initialize)
-	    (scheme-interaction-mode)))))
-
-(fset 'advertised-xscheme-send-previous-expression
-      'xscheme-send-previous-expression)
-
-;;;; Debugger Mode
-
-(defun scheme-debugger-mode ()
-  "Major mode for executing the Scheme debugger.
-Like  scheme-mode  except that the evaluation commands
-are disabled, and characters that would normally be self inserting are
-sent to the Scheme process instead.  Typing ?  will show you which
-characters perform useful functions.
-
-Commands:
-\\{scheme-debugger-mode-map}"
-  (error "Illegal entry to scheme-debugger-mode"))
-
-(defun scheme-debugger-mode-initialize ()
-  (use-local-map scheme-debugger-mode-map)
-  (setq major-mode 'scheme-debugger-mode)
-  (setq mode-name "Scheme Debugger"))
-
-(defun scheme-debugger-mode-commands (keymap)
-  (let ((char ? ))
-    (while (< char 127)
-      (define-key keymap (char-to-string char) 'scheme-debugger-self-insert)
-      (setq char (1+ char)))))
-
-(defvar scheme-debugger-mode-map nil)
-(if (not scheme-debugger-mode-map)
-    (progn
-      (setq scheme-debugger-mode-map (make-keymap))
-      (scheme-mode-commands scheme-debugger-mode-map)
-      (xscheme-interrupt-commands scheme-debugger-mode-map)
-      (scheme-debugger-mode-commands scheme-debugger-mode-map)))
-
-(defun scheme-debugger-self-insert ()
-  "Transmit this character to the Scheme process."
-  (interactive)
-  (xscheme-send-char last-command-char))
-
-(defun xscheme-enter-debugger-mode (prompt-string)
-  (save-excursion
-    (set-buffer (xscheme-process-buffer))
-    (if (not (eq major-mode 'scheme-debugger-mode))
-	(progn
-	  (if (not (eq major-mode 'scheme-interaction-mode))
-	      (scheme-interaction-mode))
-	  (scheme-debugger-mode-initialize)))))
-
-(defun xscheme-debugger-mode-p ()
-  (let ((buffer (xscheme-process-buffer)))
-    (and buffer
-	 (save-excursion
-	   (set-buffer buffer)
-	   (eq major-mode 'scheme-debugger-mode)))))
-
-;;;; Evaluation Commands
-
-(defun xscheme-send-string (&rest strings)
-  "Send the string arguments to the Scheme process.
-The strings are concatenated and terminated by a newline."
-  (cond ((not (xscheme-process-running-p))
-	 (if (yes-or-no-p "The Scheme process has died.  Reset it? ")
-	     (progn
-	       (reset-scheme)
-	       (xscheme-wait-for-process)
-	       (goto-char (point-max))
-	       (apply 'insert-before-markers strings)
-	       (xscheme-send-string-1 strings))))
-	((xscheme-debugger-mode-p) (error "No sends allowed in debugger mode"))
-	((and (not xscheme-allow-pipelined-evaluation)
-	      xscheme-running-p)
-	 (error "No sends allowed while Scheme running"))
-	(t (xscheme-send-string-1 strings))))
-
-(defun xscheme-send-string-1 (strings)
-  (let ((string (apply 'concat strings)))
-    (xscheme-send-string-2 string)
-    (if (eq major-mode 'scheme-interaction-mode)
-	(setq xscheme-previous-send string))))
-
-(defun xscheme-send-string-2 (string)
-  (let ((process (get-process "scheme")))
-    (send-string process (concat string "\n"))
-    (if (xscheme-process-buffer-current-p)
-	(set-marker (process-mark process) (point)))))
-
-(defun xscheme-yank-previous-send ()
-  "Insert the most recent expression at point."
-  (interactive)
-  (push-mark)
-  (insert xscheme-previous-send))
-
-(defun xscheme-select-process-buffer ()
-  "Select the Scheme process buffer and move to its output point."
-  (interactive)
-  (let ((process (or (get-process "scheme") (error "No scheme process"))))
-    (let ((buffer (or (process-buffer process) (error "No process buffer"))))
-      (let ((window (get-buffer-window buffer)))
-	(if window
-	    (select-window window)
-	    (switch-to-buffer buffer))
-	(goto-char (process-mark process))))))
-
-(defun xscheme-send-region (start end)
-  "Send the current region to the Scheme process.
-The region is sent terminated by a newline."
-  (interactive "r")
-  (if (xscheme-process-buffer-current-p)
-      (progn (goto-char end)
-	     (set-marker (process-mark (get-process "scheme")) end)))
-  (xscheme-send-string (buffer-substring start end)))
-
-(defun xscheme-send-definition ()
-  "Send the current definition to the Scheme process.
-If the current line begins with a non-whitespace character,
-parse an expression from the beginning of the line and send that instead."
-  (interactive)
-  (let ((start nil) (end nil))
-    (save-excursion
-      (end-of-defun)
-      (setq end (point))
-      (if (re-search-backward "^\\s(" nil t)
-	  (setq start (point))
-	  (error "Can't find definition")))
-    (xscheme-send-region start end)))
-
-(defun xscheme-send-next-expression ()
-  "Send the expression to the right of `point' to the Scheme process."
-  (interactive)
-  (let ((start (point)))
-    (xscheme-send-region start (save-excursion (forward-sexp) (point)))))
-
-(defun xscheme-send-previous-expression ()
-  "Send the expression to the left of `point' to the Scheme process."
-  (interactive)
-  (let ((end (point)))
-    (xscheme-send-region (save-excursion (backward-sexp) (point)) end)))
-
-(defun xscheme-send-current-line ()
-  "Send the current line to the Scheme process.
-Useful for working with debugging Scheme under adb."
-  (interactive)
-  (let ((line
-	 (save-excursion
-	   (beginning-of-line)
-	   (let ((start (point)))
-	     (end-of-line)
-	     (buffer-substring start (point))))))
-    (end-of-line)
-    (insert ?\n)
-    (xscheme-send-string-2 line)))
-
-(defun xscheme-send-buffer ()
-  "Send the current buffer to the Scheme process."
-  (interactive)
-  (if (xscheme-process-buffer-current-p)
-      (error "Not allowed to send this buffer's contents to Scheme"))
-  (xscheme-send-region (point-min) (point-max)))
-
-(defun xscheme-send-char (char)
-  "Prompt for a character and send it to the Scheme process."
-  (interactive "cCharacter to send: ")
-  (send-string "scheme" (char-to-string char)))
-
-;;;; Interrupts
-
-(defun xscheme-send-breakpoint-interrupt ()
-  "Cause the Scheme process to enter a breakpoint."
-  (interactive)
-  (xscheme-send-interrupt ?b nil))
-
-(defun xscheme-send-proceed ()
-  "Cause the Scheme process to proceed from a breakpoint."
-  (interactive)
-  (send-string "scheme" "(proceed)\n"))
-
-(defun xscheme-send-control-g-interrupt ()
-  "Cause the Scheme processor to halt and flush input.
-Control returns to the top level rep loop."
-  (interactive)
-  (let ((inhibit-quit t))
-    (cond ((not xscheme-control-g-synchronization-p)
-	   (interrupt-process "scheme"))
-	  (xscheme-control-g-disabled-p
-	   (message "Relax..."))
-	  (t
-	   (setq xscheme-control-g-disabled-p t)
-	   (message "Sending C-G interrupt to Scheme...")
-	   (interrupt-process "scheme")
-	   (send-string "scheme" (char-to-string 0))))))
-
-(defun xscheme-send-control-u-interrupt ()
-  "Cause the Scheme process to halt, returning to previous rep loop."
-  (interactive)
-  (xscheme-send-interrupt ?u t))
-
-(defun xscheme-send-control-x-interrupt ()
-  "Cause the Scheme process to halt, returning to current rep loop."
-  (interactive)
-  (xscheme-send-interrupt ?x t))
-
-;;; This doesn't really work right -- Scheme just gobbles the first
-;;; character in the input.  There is no way for us to guarantee that
-;;; the argument to this procedure is the first char unless we put
-;;; some kind of marker in the input stream.
-
-(defun xscheme-send-interrupt (char mark-p)
-  "Send a ^A type interrupt to the Scheme process."
-  (interactive "cInterrupt character to send: ")
-  (quit-process "scheme")
-  (send-string "scheme" (char-to-string char))
-  (if (and mark-p xscheme-control-g-synchronization-p)
-      (send-string "scheme" (char-to-string 0))))
-
-;;;; Internal Variables
-
-(defvar xscheme-process-command-line nil
-  "Command used to start the most recent Scheme process.")
-
-(defvar xscheme-previous-send ""
-  "Most recent expression transmitted to the Scheme process.")
-
-(defvar xscheme-process-filter-state 'idle
-  "State of scheme process escape reader state machine:
-idle                   waiting for an escape sequence
-reading-type           received an altmode but nothing else
-reading-string         reading prompt string")
-
-(defvar xscheme-running-p nil
-  "This variable, if nil, indicates that the scheme process is
-waiting for input.  Otherwise, it is busy evaluating something.")
-
-(defconst xscheme-control-g-synchronization-p t
-  "If non-nil, insert markers in the scheme input stream to indicate when
-control-g interrupts were signaled.  Do not allow more control-g's to be
-signaled until the scheme process acknowledges receipt.")
-
-(defvar xscheme-control-g-disabled-p nil
-  "This variable, if non-nil, indicates that a control-g is being processed
-by the scheme process, so additional control-g's are to be ignored.")
-
-(defvar xscheme-allow-output-p t
-  "This variable, if nil, prevents output from the scheme process
-from being inserted into the process-buffer.")
-
-(defvar xscheme-prompt ""
-  "The current scheme prompt string.")
-
-(defvar xscheme-string-accumulator ""
-  "Accumulator for the string being received from the scheme process.")
-
-(defvar xscheme-string-receiver nil
-  "Procedure to send the string argument from the scheme process.")
-
-(defvar xscheme-start-hook nil
-  "If non-nil, a procedure to call when the Scheme process is started.
-When called, the current buffer will be the Scheme process-buffer.")
-
-(defvar xscheme-runlight-string nil)
-(defvar xscheme-mode-string nil)
-(defvar xscheme-filter-input nil)
-
-;;;; Basic Process Control
-
-(defun xscheme-start-process (command-line)
-  (let ((buffer (get-buffer-create "*scheme*")))
-    (let ((process (get-buffer-process buffer)))
-      (save-excursion
-	(set-buffer buffer)
-	(if (and process (memq (process-status process) '(run stop)))
-	    (set-marker (process-mark process) (point-max))
-	    (progn (if process (delete-process process))
-		   (goto-char (point-max))
-		   (scheme-interaction-mode)
-		   (if (bobp)
-		       (insert-before-markers
-			(substitute-command-keys xscheme-startup-message)))
-		   (setq process
-			 (let ((process-connection-type nil))
-			   (apply 'start-process
-				  (cons "scheme"
-					(cons buffer
-					      (xscheme-parse-command-line
-					       command-line))))))
-		   (set-marker (process-mark process) (point-max))
-		   (xscheme-process-filter-initialize t)
-		   (xscheme-modeline-initialize)
-		   (set-process-sentinel process 'xscheme-process-sentinel)
-		   (set-process-filter process 'xscheme-process-filter)
-		   (run-hooks 'xscheme-start-hook)))))
-    buffer))
-
-(defun xscheme-parse-command-line (string)
-  (setq string (substitute-in-file-name string))
-  (let ((start 0)
-	(result '()))
-    (while start
-      (let ((index (string-match "[ \t]" string start)))
-	(setq start
-	      (cond ((not index)
-		     (setq result
-			   (cons (substring string start)
-				 result))
-		     nil)
-		    ((= index start)
-		     (string-match "[^ \t]" string start))
-		    (t
-		     (setq result
-			   (cons (substring string start index)
-				 result))
-		     (1+ index))))))
-    (nreverse result)))
-
-(defun xscheme-wait-for-process ()
-  (sleep-for 2)
-  (while xscheme-running-p
-    (sleep-for 1)))
-
-(defun xscheme-process-running-p ()
-  "True iff there is a Scheme process whose status is `run'."
-  (let ((process (get-process "scheme")))
-    (and process
-	 (eq (process-status process) 'run))))
-
-(defun xscheme-process-buffer ()
-  (let ((process (get-process "scheme")))
-    (and process (process-buffer process))))
-
-(defun xscheme-process-buffer-window ()
-  (let ((buffer (xscheme-process-buffer)))
-    (and buffer (get-buffer-window buffer))))
-
-(defun xscheme-process-buffer-current-p ()
-  "True iff the current buffer is the Scheme process buffer."
-  (eq (xscheme-process-buffer) (current-buffer)))
-
-;;;; Process Filter
-
-(defun xscheme-process-sentinel (proc reason)
-  (xscheme-process-filter-initialize (eq reason 'run))
-  (if (eq reason 'run)
-      (xscheme-modeline-initialize)
-      (progn
-       (setq scheme-mode-line-process "")
-       (setq xscheme-mode-string "no process")))
-  (if (and (not (memq reason '(run stop)))
-	   xscheme-signal-death-message)
-      (progn (beep)
-	     (message
-"The Scheme process has died!  Do M-x reset-scheme to restart it"))))
-
-(defun xscheme-process-filter-initialize (running-p)
-  (setq xscheme-process-filter-state 'idle)
-  (setq xscheme-running-p running-p)
-  (setq xscheme-control-g-disabled-p nil)
-  (setq xscheme-allow-output-p t)
-  (setq xscheme-prompt "")
-  (setq scheme-mode-line-process '(": " xscheme-runlight-string)))
-
-(defun xscheme-process-filter (proc string)
-  (let ((xscheme-filter-input string))
-    (while xscheme-filter-input
-      (cond ((eq xscheme-process-filter-state 'idle)
-	     (let ((start (string-match "\e" xscheme-filter-input)))
-	       (if start
-		   (progn
-		     (xscheme-process-filter-output
-		      (substring xscheme-filter-input 0 start))
-		     (setq xscheme-filter-input
-			   (substring xscheme-filter-input (1+ start)))
-		     (setq xscheme-process-filter-state 'reading-type))
-		   (let ((string xscheme-filter-input))
-		     (setq xscheme-filter-input nil)
-		     (xscheme-process-filter-output string)))))
-	    ((eq xscheme-process-filter-state 'reading-type)
-	     (if (zerop (length xscheme-filter-input))
-		 (setq xscheme-filter-input nil)
-		 (let ((char (aref xscheme-filter-input 0)))
-		   (setq xscheme-filter-input
-			 (substring xscheme-filter-input 1))
-		   (let ((entry (assoc char xscheme-process-filter-alist)))
-		     (if entry
-			 (funcall (nth 2 entry) (nth 1 entry))
-			 (progn
-			   (xscheme-process-filter-output ?\e char)
-			   (setq xscheme-process-filter-state 'idle)))))))
-	    ((eq xscheme-process-filter-state 'reading-string)
-	     (let ((start (string-match "\e" xscheme-filter-input)))
-	       (if start
-		   (let ((string
-			  (concat xscheme-string-accumulator
-				  (substring xscheme-filter-input 0 start))))
-		     (setq xscheme-filter-input
-			   (substring xscheme-filter-input (1+ start)))
-		     (setq xscheme-process-filter-state 'idle)
-		     (funcall xscheme-string-receiver string))
-		   (progn
-		     (setq xscheme-string-accumulator
-			   (concat xscheme-string-accumulator
-				   xscheme-filter-input))
-		     (setq xscheme-filter-input nil)))))
-	    (t
-	     (error "Scheme process filter -- bad state"))))))
-
-;;;; Process Filter Output
-
-(defun xscheme-process-filter-output (&rest args)
-  (if xscheme-allow-output-p
-      (let ((string (apply 'concat args)))
-	(save-excursion
-	  (xscheme-goto-output-point)
-	  (while (string-match "\\(\007\\|\f\\)" string)
-	    (let ((start (match-beginning 0))
-		  (end (match-end 0)))
-	      (insert-before-markers (substring string 0 start))
-	      (if (= ?\f (aref string start))
-		  (progn
-		    (if (not (bolp))
-			(insert-before-markers ?\n))
-		    (insert-before-markers ?\f))
-		  (beep))
-	      (setq string (substring string (1+ start)))))
-	  (insert-before-markers string)))))
-
-(defun xscheme-guarantee-newlines (n)
-  (if xscheme-allow-output-p
-      (save-excursion
-	(xscheme-goto-output-point)
-	(let ((stop nil))
-	  (while (and (not stop)
-		      (bolp))
-	    (setq n (1- n))
-	    (if (bobp)
-		(setq stop t)
-		(backward-char))))
-	(xscheme-goto-output-point)
-	(while (> n 0)
-	  (insert-before-markers ?\n)
-	  (setq n (1- n))))))
-
-(defun xscheme-goto-output-point ()
-  (let ((process (get-process "scheme")))
-    (set-buffer (process-buffer process))
-    (goto-char (process-mark process))))
-
-(defun xscheme-modeline-initialize ()
-  (setq xscheme-runlight-string "")
-  (setq xscheme-mode-string "")
-  (setq mode-line-buffer-identification '("Scheme: " xscheme-mode-string)))
-
-(defun xscheme-set-runlight (runlight)
-  (setq xscheme-runlight-string runlight)
-  (force-mode-line-update t))
-
-;;;; Process Filter Operations
-
-(defvar xscheme-process-filter-alist
-  '((?D xscheme-enter-debugger-mode
-	xscheme-process-filter:string-action)
-    (?E xscheme-eval
-	xscheme-process-filter:string-action)
-    (?P xscheme-set-prompt-variable
-	xscheme-process-filter:string-action)
-    (?R xscheme-enter-interaction-mode
-	xscheme-process-filter:simple-action)
-    (?b xscheme-start-gc
-	xscheme-process-filter:simple-action)
-    (?e xscheme-finish-gc
-	xscheme-process-filter:simple-action)
-    (?f xscheme-exit-input-wait
-	xscheme-process-filter:simple-action)
-    (?g xscheme-enable-control-g
-	xscheme-process-filter:simple-action)
-    (?i xscheme-prompt-for-expression
-	xscheme-process-filter:string-action)
-    (?m xscheme-message
-	xscheme-process-filter:string-action)
-    (?n xscheme-prompt-for-confirmation
-	xscheme-process-filter:string-action)
-    (?o xscheme-output-goto
-	xscheme-process-filter:simple-action)
-    (?p xscheme-set-prompt
-	xscheme-process-filter:string-action)
-    (?s xscheme-enter-input-wait
-	xscheme-process-filter:simple-action)
-    (?v xscheme-write-value
-	xscheme-process-filter:string-action)
-    (?w xscheme-cd
-	xscheme-process-filter:string-action)
-    (?z xscheme-display-process-buffer
-	xscheme-process-filter:simple-action)
-    (?c xscheme-unsolicited-read-char
-	xscheme-process-filter:simple-action))
-  "Table used to decide how to handle process filter commands.
-Value is a list of entries, each entry is a list of three items.
-
-The first item is the character that the process filter dispatches on.
-The second item is the action to be taken, a function.
-The third item is the handler for the entry, a function.
-
-When the process filter sees a command whose character matches a
-particular entry, it calls the handler with two arguments: the action
-and the string containing the rest of the process filter's input
-stream.  It is the responsibility of the handler to invoke the action
-with the appropriate arguments, and to reenter the process filter with
-the remaining input.")
-
-(defun xscheme-process-filter:simple-action (action)
-  (setq xscheme-process-filter-state 'idle)
-  (funcall action))
-
-(defun xscheme-process-filter:string-action (action)
-  (setq xscheme-string-receiver action)
-  (setq xscheme-string-accumulator "")
-  (setq xscheme-process-filter-state 'reading-string))
-
-(defconst xscheme-runlight:running "run"
-  "The character displayed when the Scheme process is running.")
-
-(defconst xscheme-runlight:input "input"
-  "The character displayed when the Scheme process is waiting for input.")
-
-(defconst xscheme-runlight:gc "gc"
-  "The character displayed when the Scheme process is garbage collecting.")
-
-(defun xscheme-start-gc ()
-  (xscheme-set-runlight xscheme-runlight:gc))
-
-(defun xscheme-finish-gc ()
-  (xscheme-set-runlight
-   (if xscheme-running-p xscheme-runlight:running xscheme-runlight:input)))
-
-(defun xscheme-enter-input-wait ()
-  (xscheme-set-runlight xscheme-runlight:input)
-  (setq xscheme-running-p nil))
-
-(defun xscheme-exit-input-wait ()
-  (xscheme-set-runlight xscheme-runlight:running)
-  (setq xscheme-running-p t))
-
-(defun xscheme-enable-control-g ()
-  (setq xscheme-control-g-disabled-p nil))
-
-(defun xscheme-display-process-buffer ()
-  (let ((window (or (xscheme-process-buffer-window)
-		    (display-buffer (xscheme-process-buffer)))))
-    (save-window-excursion
-      (select-window window)
-      (xscheme-goto-output-point)
-      (if (xscheme-debugger-mode-p)
-	  (xscheme-enter-interaction-mode)))))
-
-(defun xscheme-unsolicited-read-char ()
-  nil)
-
-(defun xscheme-eval (string)
-  (eval (car (read-from-string string))))
-
-(defun xscheme-message (string)
-  (if (not (zerop (length string)))
-      (xscheme-write-message-1 string (format ";%s" string))))
-
-(defun xscheme-write-value (string)
-  (if (zerop (length string))
-      (xscheme-write-message-1 "(no value)" ";No value")
-      (xscheme-write-message-1 string (format ";Value: %s" string))))
-
-(defun xscheme-write-message-1 (message-string output-string)
-  (let* ((process (get-process "scheme"))
-	 (window (get-buffer-window (process-buffer process))))
-    (if (or (not window)
-	    (not (pos-visible-in-window-p (process-mark process)
-					  window)))
-	(message "%s" message-string)))
-  (xscheme-guarantee-newlines 1)
-  (xscheme-process-filter-output output-string))
-
-(defun xscheme-set-prompt-variable (string)
-  (setq xscheme-prompt string))
-
-(defun xscheme-set-prompt (string)
-  (setq xscheme-prompt string)
-  (xscheme-guarantee-newlines 2)
-  (setq xscheme-mode-string (xscheme-coerce-prompt string))
-  (force-mode-line-update t))
-
-(defun xscheme-output-goto ()
-  (xscheme-goto-output-point)
-  (xscheme-guarantee-newlines 2))
-
-(defun xscheme-coerce-prompt (string)
-  (if (string-match "^[0-9]+ " string)
-      (let ((end (match-end 0)))
-	(concat (substring string 0 end)
-		(let ((prompt (substring string end)))
-		  (let ((entry (assoc prompt xscheme-prompt-alist)))
-		    (if entry
-			(cdr entry)
-			prompt)))))
-      string))
-
-(defvar xscheme-prompt-alist
-  '(("[Normal REPL]" . "[Evaluator]")
-    ("[Error REPL]" . "[Evaluator]")
-    ("[Breakpoint REPL]" . "[Evaluator]")
-    ("[Debugger REPL]" . "[Evaluator]")
-    ("[Visiting environment]" . "[Evaluator]")
-    ("[Environment Inspector]" . "[Where]"))
-  "An alist which maps the Scheme command interpreter type to a print string.")
-
-(defun xscheme-cd (directory-string)
-  (save-excursion
-    (set-buffer (xscheme-process-buffer))
-    (cd directory-string)))
-
-(defun xscheme-prompt-for-confirmation (prompt-string)
-  (xscheme-send-char (if (y-or-n-p prompt-string) ?y ?n)))
-
-(defun xscheme-prompt-for-expression (prompt-string)
-  (xscheme-send-string-2
-   (read-from-minibuffer prompt-string nil xscheme-prompt-for-expression-map)))
-
-(defvar xscheme-prompt-for-expression-map nil)
-(if (not xscheme-prompt-for-expression-map)
-    (progn
-      (setq xscheme-prompt-for-expression-map
-	    (copy-keymap minibuffer-local-map))
-      (substitute-key-definition 'exit-minibuffer
-				 'xscheme-prompt-for-expression-exit
-				 xscheme-prompt-for-expression-map)))
-
-(defun xscheme-prompt-for-expression-exit ()
-  (interactive)
-  (if (eq (xscheme-region-expression-p (point-min) (point-max)) 'one)
-      (exit-minibuffer)
-      (error "input must be a single, complete expression")))
-
-(defun xscheme-region-expression-p (start end)
-  (save-excursion
-    (let ((old-syntax-table (syntax-table)))
-      (unwind-protect
-	  (progn
-	    (set-syntax-table scheme-mode-syntax-table)
-	    (let ((state (parse-partial-sexp start end)))
-	      (and (zerop (car state))	;depth = 0
-		   (nth 2 state)	;last-sexp exists, i.e. >= 1 sexps
-		   (let ((state (parse-partial-sexp start (nth 2 state))))
-		     (if (nth 2 state) 'many 'one)))))
-	(set-syntax-table old-syntax-table)))))
-
-(provide 'xscheme)
-
-;;; xscheme.el ends here
diff --git a/lisp/xt-mouse.el b/lisp/xt-mouse.el
deleted file mode 100644
index 1564034cc7f..00000000000
--- a/lisp/xt-mouse.el
+++ /dev/null
@@ -1,190 +0,0 @@
-;;; xt-mouse.el --- Support the mouse when emacs run in an xterm.
-
-;; Copyright (C) 1994 Free Software Foundation
-
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Keywords: mouse, terminals
-
-;; 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.
-
-;;; Comments:
-
-;; Enable mouse support when running inside an xterm or Linux console.
-
-;; This is actually useful when you are running X11 locally, but is
-;; working on remote machine over a modem line or through a gateway.
-
-;; It works by translating xterm escape codes into generic emacs mouse
-;; events so it should work with any package that uses the mouse.
-
-;; The xterm mouse escape codes are supposedly also supported by the
-;; Linux console, but I have not been able to verify this.
-
-;; You don't have to turn off xterm mode to use the normal xterm mouse
-;; functionality, it is still available by holding down the SHIFT key
-;; when you press the mouse button.
-
-;;; Todo:
-
-;; Support multi-click -- somehow.
-
-;; Clicking on the mode-line does not work, although it should.
-
-;;; Code: 
-
-(define-key function-key-map "\e[M" 'xterm-mouse-translate)
-
-(defvar xterm-mouse-last)
-
-(defun xterm-mouse-translate (event)
-  ;; Read a click and release event from XTerm.
-  (save-excursion
-    (save-window-excursion
-      (deactivate-mark)
-      (let* ((xterm-mouse-last)
-	     (down (xterm-mouse-event))
-	     (down-command (nth 0 down))
-	     (down-data (nth 1 down))
-	     (down-where (nth 1 down-data))
-	     (down-binding (key-binding (if (symbolp down-where)
-					    (vector down-where down-command)
-					  (vector down-command)))))
-	(or (and (eq (read-char) ?\e)
-		 (eq (read-char) ?\[)
-		 (eq (read-char) ?M))
-	    (error "Unexpected escape sequence from XTerm"))
-	(let* ((click (xterm-mouse-event))
-	       (click-command (nth 0 click))
-	       (click-data (nth 1 click))
-	       (click-where (nth 1 click-data)))
-	  (if (memq down-binding '(nil ignore))
-	      (if (and (symbolp click-where)
-		       (not (eq 'menu-bar click-where)))
-		  (vector (list click-where click-data) click)
-		(vector click))
-	    (setq unread-command-events
-		  (if (eq down-where click-where)
-		      (list click)
-		    (list
-		     ;; Cheat `mouse-drag-region' with move event.
-		     (list 'mouse-movement click-data)
-		     ;; Generate a drag event.
-		     (if (symbolp down-where)
-			 0
-		       (list (intern (concat "drag-mouse-" (+ 1 xterm-mouse-last)))
-			     down-data click-data))
-		     )))
-	    (if (and (symbolp down-where)
-		     (not (eq 'menu-bar down-where)))
-		(vector (list down-where down-data) down)
-	      (vector down))))))))
-
-(defvar xterm-mouse-x 0
-  "Position of last xterm mouse event relative to the frame.")
-
-(defvar xterm-mouse-y 0
-  "Position of last xterm mouse event relative to the frame.")
-
-(defadvice mouse-position (around xterm-mouse activate)
-  "Use last key from xterm-mouse-mode if available."
-  (let ((answer ad-do-it))
-    (setq ad-return-value
-	  (if xterm-mouse-mode
-	      (cons (car answer) (cons xterm-mouse-x xterm-mouse-y))
-	    answer))))
-
-(defun xterm-mouse-event ()
-  ;; Convert XTerm mouse event to Emacs mouse event.
-  (let* ((type (- (read-char) ? ))
-	 (x (- (read-char) ?  1))
-	 (y (- (read-char) ?  1))
-	 (point (cons x y))
-	 (window (window-at x y))
-	 (where (if window 
-		    (coordinates-in-window-p point window)
-		  'menu-bar))
-	 (pos (if (consp where)
-		  (progn
-		    (select-window window)
-		    (goto-char (window-start window))
-		    (move-to-window-line  (cdr where))
-		    (move-to-column (+ (car where) (current-column)
-				       (if (string-match "\\` \\*Minibuf"
-							 (buffer-name))
-					   (- (minibuffer-prompt-width))
-					 0)
-				       (max 0 (1- (window-hscroll)))))
-		    (point))
-		where))
-	 (mouse (intern (if (eq type 3)
-			    (concat "mouse-" (+ 1 xterm-mouse-last))
-			  (setq xterm-mouse-last type)
-			  (concat "down-mouse-" (+ 1 type))))))
-    (setq xterm-mouse-x x
-	  xterm-mouse-y y)
-    (list mouse
-	  (list window pos point
-		(/ (nth 2 (current-time)) 1000)))))
-
-;; Indicator for the xterm-mouse mode.
-(defvar xterm-mouse-mode nil)
-
-(or (assq 'xterm-mouse-mode minor-mode-alist)
-    (setq minor-mode-alist
-	  (cons '(xterm-mouse-mode (" Mouse")) minor-mode-alist)))
-
-;;;###autoload
-(defun xterm-mouse-mode (arg)
-  "Toggle XTerm mouse mode.
-With prefix arg, turn XTerm mouse mode on iff arg is positive.
-
-Turn it on to use emacs mouse commands, and off to use xterm mouse commands."
-  (interactive "P")
-  (if (or (and (null arg) xterm-mouse-mode)
-	  (<= (prefix-numeric-value arg) 0))
-      ;; Turn it off
-      (if xterm-mouse-mode
-	  (progn
-	    (turn-off-xterm-mouse-tracking)
-	    (setq xterm-mouse-mode nil)
-	    (set-buffer-modified-p (buffer-modified-p))))
-    ;;Turn it on
-    (if xterm-mouse-mode
-	()
-      (setq xterm-mouse-mode t)
-      (turn-on-xterm-mouse-tracking)
-      (set-buffer-modified-p (buffer-modified-p)))))
-
-(defun turn-on-xterm-mouse-tracking ()
-  ;; Enable emacs mouse tracking in xterm.
-  (if xterm-mouse-mode
-      (send-string-to-terminal "\e[?1000h")))
-
-(defun turn-off-xterm-mouse-tracking ()
-  ;; Disable disable emacs mouse tracking in xterm.
-  (if xterm-mouse-mode
-      (send-string-to-terminal "\e[?1000l")))
-
-;; Restore normal mouse behaviour outside Emacs.
-(add-hook 'suspend-hook 'turn-off-xterm-mouse-tracking)
-(add-hook 'suspend-resume-hook 'turn-on-xterm-mouse-tracking)
-(add-hook 'kill-emacs-hook 'turn-off-xterm-mouse-tracking)
-
-(provide 'xt-mouse)
-
-;;; xt-mouse.el ends here